From 7b33b773c814dfa15dd15d718b7707c92928a237 Mon Sep 17 00:00:00 2001 From: Daniel Trierweiler Date: Mon, 27 Jul 2026 21:35:12 +0200 Subject: [PATCH] Update bundled JCL library for Delphi 13 compatibility Updates the vendored 3rdParty/JCL sources to a newer JCL revision so the library compiles under Delphi 13. --- 3rdParty/JCL/source/common/Jcl8087.pas | 678 +- .../source/common/JclAbstractContainers.pas | 2958 ++ 3rdParty/JCL/source/common/JclAlgorithms.pas | 4331 +++ 3rdParty/JCL/source/common/JclAnsiStrings.pas | 8542 ++-- 3rdParty/JCL/source/common/JclArrayLists.pas | 12057 ++++++ 3rdParty/JCL/source/common/JclArraySets.pas | 2388 ++ 3rdParty/JCL/source/common/JclBase.pas | 1293 +- 3rdParty/JCL/source/common/JclBinaryTrees.pas | 21387 ++++++++++ 3rdParty/JCL/source/common/JclCharsets.pas | 1144 +- .../JCL/source/common/JclCompilerUtils.pas | 1508 + 3rdParty/JCL/source/common/JclComplex.pas | 1584 + 3rdParty/JCL/source/common/JclCompression.pas | 10068 +++++ .../JCL/source/common/JclContainerIntf.pas | 4941 +++ 3rdParty/JCL/source/common/JclCounter.pas | 251 + 3rdParty/JCL/source/common/JclDateTime.pas | 2898 +- .../source/common/JclDevToolsResources.pas | 192 + 3rdParty/JCL/source/common/JclExprEval.pas | 4693 +++ 3rdParty/JCL/source/common/JclFileUtils.pas | 14136 +++---- 3rdParty/JCL/source/common/JclHashMaps.pas | 31315 +++++++++++++++ 3rdParty/JCL/source/common/JclHashSets.pas | 14141 +++++++ 3rdParty/JCL/source/common/JclIDEUtils.pas | 5419 +++ 3rdParty/JCL/source/common/JclIniFiles.pas | 382 +- 3rdParty/JCL/source/common/JclLinkedLists.pas | 17713 +++++++++ 3rdParty/JCL/source/common/JclLogic.pas | 4854 +-- 3rdParty/JCL/source/common/JclMIDI.pas | 830 + 3rdParty/JCL/source/common/JclMath.pas | 9752 ++--- 3rdParty/JCL/source/common/JclMime.pas | 939 + 3rdParty/JCL/source/common/JclNotify.pas | 450 + 3rdParty/JCL/source/common/JclPCRE.pas | 2676 +- .../JclPreProcessorAlgorithmsTemplates.pas | 483 + .../JclPreProcessorArrayListsTemplates.pas | 207 + .../JclPreProcessorArraySetsTemplates.pas | 152 + .../JclPreProcessorBinaryTreesTemplates.pas | 300 + .../JclPreProcessorContainer1DTemplates.pas | 531 + .../JclPreProcessorContainer2DTemplates.pas | 767 + .../JclPreProcessorContainerIntfTemplates.pas | 659 + .../JclPreProcessorContainerKnownMaps.pas | 1105 + .../JclPreProcessorContainerKnownTypes.pas | 1517 + .../JclPreProcessorContainerTemplates.pas | 703 + .../common/JclPreProcessorContainerTypes.pas | 471 + .../common/JclPreProcessorExcDlgTemplates.pas | 265 + .../JclPreProcessorHashMapsTemplates.pas | 268 + .../JclPreProcessorHashSetsTemplates.pas | 223 + .../source/common/JclPreProcessorLexer.pas | 449 + .../JclPreProcessorLinkedListsTemplates.pas | 260 + .../source/common/JclPreProcessorParser.pas | 1584 + .../common/JclPreProcessorQueuesTemplates.pas | 147 + .../JclPreProcessorSortedMapsTemplates.pas | 237 + .../common/JclPreProcessorStacksTemplates.pas | 146 + .../common/JclPreProcessorTemplates.pas | 145 + .../common/JclPreProcessorTreesTemplates.pas | 264 + .../JclPreProcessorVectorsTemplates.pas | 207 + 3rdParty/JCL/source/common/JclQueues.pas | 4722 +++ 3rdParty/JCL/source/common/JclRTTI.pas | 2983 ++ 3rdParty/JCL/source/common/JclResources.pas | 4213 +- 3rdParty/JCL/source/common/JclSchedule.pas | 1310 + 3rdParty/JCL/source/common/JclSimpleXml.pas | 8892 ++--- 3rdParty/JCL/source/common/JclSortedMaps.pas | 31820 +++++++++++++++ 3rdParty/JCL/source/common/JclStacks.pas | 3017 ++ 3rdParty/JCL/source/common/JclStatistics.pas | 507 + 3rdParty/JCL/source/common/JclStrHashMap.pas | 735 + 3rdParty/JCL/source/common/JclStreams.pas | 6258 +-- .../source/common/JclStringConversions.pas | 7770 ++-- 3rdParty/JCL/source/common/JclStringLists.pas | 2890 +- 3rdParty/JCL/source/common/JclStrings.pas | 10836 +++--- 3rdParty/JCL/source/common/JclSynch.pas | 3556 +- 3rdParty/JCL/source/common/JclSysInfo.pas | 20 +- 3rdParty/JCL/source/common/JclTrees.pas | 20332 ++++++++++ 3rdParty/JCL/source/common/JclUnicode.pas | 16390 ++++---- 3rdParty/JCL/source/common/JclUnicode.rc | 12126 +++--- 3rdParty/JCL/source/common/JclUnicodeBzip2.rc | 5434 +-- 3rdParty/JCL/source/common/JclUnicodeZLib.rc | 5344 +-- 3rdParty/JCL/source/common/JclUnitConv.pas | 1007 + .../JCL/source/common/JclUnitVersioning.pas | 744 + .../common/JclUnitVersioningProviders.pas | 440 + 3rdParty/JCL/source/common/JclUsesUtils.pas | 944 + 3rdParty/JCL/source/common/JclValidation.pas | 193 + 3rdParty/JCL/source/common/JclVectors.pas | 12002 ++++++ 3rdParty/JCL/source/common/JclWideStrings.pas | 4636 +-- 3rdParty/JCL/source/common/bzip2.pas | 524 + 3rdParty/JCL/source/common/dirinfo.txt | 1 + 3rdParty/JCL/source/common/pcre.pas | 5737 ++- 3rdParty/JCL/source/common/zconf.h | 428 + 3rdParty/JCL/source/common/zlib.h | 1613 + 3rdParty/JCL/source/common/zlibh.pas | 2509 ++ 3rdParty/JCL/source/include/crossplatform.inc | 68 +- 3rdParty/JCL/source/include/jcl.inc | 18 + 3rdParty/JCL/source/include/jcl.template.inc | 282 +- 3rdParty/JCL/source/include/jcld29win32.inc | 26 +- 3rdParty/JCL/source/include/jcld29win64.inc | 26 +- 3rdParty/JCL/source/include/jcld37win32.inc | 141 + 3rdParty/JCL/source/include/jcld37win64.inc | 141 + 3rdParty/JCL/source/include/jedi/jedi.inc | 4347 ++- 3rdParty/JCL/source/include/jedi/kylix.inc | 60 +- 3rdParty/JCL/source/include/unixonly.inc | 102 +- 3rdParty/JCL/source/include/windowsonly.inc | 108 +- 3rdParty/JCL/source/prototypes/Hardlinks.pas | 925 + .../JCL/source/prototypes/JclAlgorithms.pas | 1060 + .../JCL/source/prototypes/JclArrayLists.pas | 262 + .../JCL/source/prototypes/JclArraySets.pas | 260 + .../JCL/source/prototypes/JclBinaryTrees.pas | 267 + .../source/prototypes/JclContainerIntf.pas | 792 + .../JCL/source/prototypes/JclGraphUtils.pas | 2577 ++ .../JCL/source/prototypes/JclGraphics.pas | 5814 +++ .../JCL/source/prototypes/JclHashMaps.pas | 481 + .../JCL/source/prototypes/JclHashSets.pas | 275 + .../JCL/source/prototypes/JclLinkedLists.pas | 249 + 3rdParty/JCL/source/prototypes/JclQueues.pas | 223 + .../JCL/source/prototypes/JclSortedMaps.pas | 411 + 3rdParty/JCL/source/prototypes/JclStacks.pas | 226 + 3rdParty/JCL/source/prototypes/JclTrees.pas | 245 + 3rdParty/JCL/source/prototypes/JclVectors.pas | 246 + 3rdParty/JCL/source/prototypes/JclWin32.pas | 325 + 3rdParty/JCL/source/prototypes/Makefile.mak | 122 + .../prototypes/containers/JclAlgorithms.imp | 303 + .../prototypes/containers/JclAlgorithms.int | 53 + .../prototypes/containers/JclArrayLists.imp | 602 + .../prototypes/containers/JclArrayLists.int | 82 + .../prototypes/containers/JclArraySets.imp | 96 + .../prototypes/containers/JclArraySets.int | 23 + .../prototypes/containers/JclBinaryTrees.imp | 1194 + .../prototypes/containers/JclBinaryTrees.int | 138 + .../containers/JclContainerCommon.imp | 60 + .../containers/JclContainerIntf.int | 225 + .../prototypes/containers/JclHashMaps.imp | 402 + .../prototypes/containers/JclHashMaps.int | 50 + .../prototypes/containers/JclHashSets.imp | 815 + .../prototypes/containers/JclHashSets.int | 85 + .../prototypes/containers/JclLinkedLists.imp | 968 + .../prototypes/containers/JclLinkedLists.int | 88 + .../prototypes/containers/JclQueues.imp | 204 + .../prototypes/containers/JclQueues.int | 31 + .../prototypes/containers/JclSortedMaps.imp | 386 + .../prototypes/containers/JclSortedMaps.int | 47 + .../prototypes/containers/JclStacks.imp | 122 + .../prototypes/containers/JclStacks.int | 25 + .../source/prototypes/containers/JclTrees.imp | 1058 + .../source/prototypes/containers/JclTrees.int | 133 + .../prototypes/containers/JclVectors.imp | 597 + .../prototypes/containers/JclVectors.int | 87 + .../supplement/create_JCL_Hardlinks.pas.cmd | 13 + .../create_nonJCL_Hardlinks.pas.cmd | 4 + .../source/prototypes/supplement/simple_pp.pl | 60 + .../JCL/source/prototypes/win32api/AclApi.imp | 22 + .../JCL/source/prototypes/win32api/AclApi.int | 10 + .../source/prototypes/win32api/DelayImp.int | 47 + .../source/prototypes/win32api/ImageHlp.imp | 149 + .../source/prototypes/win32api/ImageHlp.int | 412 + .../source/prototypes/win32api/ImgGuids.int | 9 + .../JCL/source/prototypes/win32api/IoAPI.imp | 14 + .../JCL/source/prototypes/win32api/IoAPI.int | 8 + .../source/prototypes/win32api/LmAccess.imp | 378 + .../source/prototypes/win32api/LmAccess.int | 470 + .../source/prototypes/win32api/LmApiBuf.imp | 15 + .../source/prototypes/win32api/LmApiBuf.int | 4 + .../JCL/source/prototypes/win32api/LmCons.int | 278 + .../JCL/source/prototypes/win32api/LmErr.int | 891 + .../source/prototypes/win32api/Lmwksta.imp | 15 + .../source/prototypes/win32api/Lmwksta.int | 20 + .../source/prototypes/win32api/MsiDefs.int | 12 + .../JCL/source/prototypes/win32api/Nb30.imp | 14 + .../JCL/source/prototypes/win32api/Nb30.int | 436 + .../source/prototypes/win32api/NtSecApi.imp | 77 + .../source/prototypes/win32api/NtSecApi.int | 172 + .../source/prototypes/win32api/ObjBase.imp | 38 + .../source/prototypes/win32api/ObjBase.int | 44 + .../source/prototypes/win32api/PropIdl.imp | 12 + .../source/prototypes/win32api/PropIdl.int | 138 + .../JCL/source/prototypes/win32api/RasDlg.int | 18 + .../JCL/source/prototypes/win32api/Reason.int | 125 + .../source/prototypes/win32api/ShlGuid.int | 192 + .../JCL/source/prototypes/win32api/ShlObj.int | 174 + .../source/prototypes/win32api/ShlWApi.int | 22 + .../source/prototypes/win32api/TlHelp32.imp | 39 + .../source/prototypes/win32api/TlHelp32.int | 71 + .../source/prototypes/win32api/WinBase.imp | 309 + .../source/prototypes/win32api/WinBase.int | 185 + .../JCL/source/prototypes/win32api/WinDef.int | 11 + .../source/prototypes/win32api/WinError.int | 228 + .../source/prototypes/win32api/WinIoctl.int | 601 + .../JCL/source/prototypes/win32api/WinNLS.imp | 45 + .../JCL/source/prototypes/win32api/WinNLS.int | 137 + .../JCL/source/prototypes/win32api/WinNT.imp | 115 + .../JCL/source/prototypes/win32api/WinNT.int | 2823 ++ .../source/prototypes/win32api/WinUser.imp | 24 + .../source/prototypes/win32api/WinUser.int | 103 + .../source/prototypes/win32api/Winternl.imp | 19 + .../source/prototypes/win32api/Winternl.int | 84 + .../source/prototypes/win32api/dirinfo.txt | 12 + .../source/prototypes/win32api/powrprof.imp | 50 + .../source/prototypes/win32api/powrprof.int | 4 + 3rdParty/JCL/source/unix/dirinfo.txt | 1 + 3rdParty/JCL/source/vcl/JclFont.pas | 116 + 3rdParty/JCL/source/vcl/JclGraphUtils.pas | 2710 ++ 3rdParty/JCL/source/vcl/JclGraphics.pas | 5713 +++ 3rdParty/JCL/source/vcl/JclOpenDialog.rc | 5 + 3rdParty/JCL/source/vcl/JclOpenDialog.res | Bin 0 -> 144 bytes .../JCL/source/vcl/JclOpenDialogFavorites.pas | 581 + .../JCL/source/vcl/JclOpenDialogHooks.pas | 603 + 3rdParty/JCL/source/vcl/JclPrint.pas | 1644 + 3rdParty/JCL/source/vcl/JclVclResources.pas | 226 + 3rdParty/JCL/source/vcl/JclVersionControl.pas | 863 + .../JCL/source/vcl/JclVersionCtrlCVSImpl.pas | 327 + .../JCL/source/vcl/JclVersionCtrlGITImpl.pas | 386 + .../JCL/source/vcl/JclVersionCtrlSVNImpl.pas | 683 + 3rdParty/JCL/source/vcl/dirinfo.txt | 1 + 3rdParty/JCL/source/windows/Hardlinks.pas | 722 + 3rdParty/JCL/source/windows/JclAppInst.pas | 998 + 3rdParty/JCL/source/windows/JclCIL.pas | 1032 + 3rdParty/JCL/source/windows/JclCLR.pas | 1781 + 3rdParty/JCL/source/windows/JclCOM.pas | 686 + .../source/windows/JclCommCtrlAdmin.manifest | 28 + .../JCL/source/windows/JclCommCtrlAdmin.rc | 7 + .../JCL/source/windows/JclCommCtrlAdmin.res | Bin 0 -> 920 bytes .../windows/JclCommCtrlAsInvoker.manifest | 28 + .../source/windows/JclCommCtrlAsInvoker.rc | 7 + .../source/windows/JclCommCtrlAsInvoker.res | Bin 0 -> 908 bytes 3rdParty/JCL/source/windows/JclConsole.pas | 3112 +- .../JCL/source/windows/JclCppException.pas | 777 + 3rdParty/JCL/source/windows/JclDebug.pas | 26 +- .../source/windows/JclDebugSerialization.pas | 765 + .../windows/JclDebugXMLDeserializer.pas | 102 + .../source/windows/JclDebugXMLSerializer.pas | 126 + 3rdParty/JCL/source/windows/JclDotNet.pas | 1415 + 3rdParty/JCL/source/windows/JclHelpUtils.pas | 543 + 3rdParty/JCL/source/windows/JclHookExcept.pas | 1728 +- 3rdParty/JCL/source/windows/JclLANMan.pas | 475 + 3rdParty/JCL/source/windows/JclLocales.pas | 1037 + 3rdParty/JCL/source/windows/JclMapi.pas | 1451 + 3rdParty/JCL/source/windows/JclMetadata.pas | 4860 +++ 3rdParty/JCL/source/windows/JclMiscel.pas | 539 + 3rdParty/JCL/source/windows/JclMsBuild.pas | 2739 ++ 3rdParty/JCL/source/windows/JclMsdosSys.pas | 663 + 3rdParty/JCL/source/windows/JclMultimedia.pas | 1355 + 3rdParty/JCL/source/windows/JclNTFS.pas | 2519 ++ .../JCL/source/windows/JclNoDepAdmin.manifest | 17 + 3rdParty/JCL/source/windows/JclNoDepAdmin.rc | 7 + 3rdParty/JCL/source/windows/JclNoDepAdmin.res | Bin 0 -> 612 bytes .../source/windows/JclNoDepAsInvoker.manifest | 17 + .../JCL/source/windows/JclNoDepAsInvoker.rc | 7 + .../JCL/source/windows/JclNoDepAsInvoker.res | Bin 0 -> 600 bytes 3rdParty/JCL/source/windows/JclPeImage.pas | 48 +- 3rdParty/JCL/source/windows/JclRegistry.pas | 4312 +- 3rdParty/JCL/source/windows/JclSecurity.pas | 1694 +- 3rdParty/JCL/source/windows/JclShell.pas | 3268 +- .../JCL/source/windows/JclStructStorage.pas | 808 + 3rdParty/JCL/source/windows/JclSvcCtrl.pas | 1554 + 3rdParty/JCL/source/windows/JclTask.pas | 973 + 3rdParty/JCL/source/windows/JclTimeZones.pas | 833 + 3rdParty/JCL/source/windows/JclWin32.pas | 18666 ++++----- 3rdParty/JCL/source/windows/JclWin32Ex.pas | 409 + 3rdParty/JCL/source/windows/JclWinMIDI.pas | 305 + .../JCL/source/windows/MSHelpServices_TLB.pas | 1667 + 3rdParty/JCL/source/windows/MSTask.pas | 699 + 3rdParty/JCL/source/windows/Snmp.pas | 1892 +- 3rdParty/JCL/source/windows/dirinfo.txt | 1 + 3rdParty/JCL/source/windows/mscoree_TLB.pas | 497 + 3rdParty/JCL/source/windows/mscorlib_TLB.pas | 32373 ++++++++++++++++ .../windows/obj/bzip2/win32/blocksort.obj | Bin 0 -> 12751 bytes .../source/windows/obj/bzip2/win32/bzlib.obj | Bin 0 -> 13305 bytes .../windows/obj/bzip2/win32/compress.obj | Bin 0 -> 15065 bytes .../windows/obj/bzip2/win32/crctable.obj | Bin 0 -> 6749 bytes .../windows/obj/bzip2/win32/decompress.obj | Bin 0 -> 17163 bytes .../windows/obj/bzip2/win32/dirinfo.txt | 1 + .../windows/obj/bzip2/win32/huffman.obj | Bin 0 -> 7215 bytes .../windows/obj/bzip2/win32/makefile.mak | 106 + .../windows/obj/bzip2/win32/randtable.obj | Bin 0 -> 7778 bytes .../windows/obj/bzip2/win64/blocksort.obj | Bin 0 -> 61519 bytes .../source/windows/obj/bzip2/win64/bzlib.obj | Bin 0 -> 64665 bytes .../windows/obj/bzip2/win64/compress.obj | Bin 0 -> 66475 bytes .../windows/obj/bzip2/win64/crctable.obj | Bin 0 -> 31876 bytes .../windows/obj/bzip2/win64/decompress.obj | Bin 0 -> 71540 bytes .../windows/obj/bzip2/win64/dirinfo.txt | 1 + .../windows/obj/bzip2/win64/huffman.obj | Bin 0 -> 36491 bytes .../windows/obj/bzip2/win64/makefile.mak | 59 + .../windows/obj/bzip2/win64/randtable.obj | Bin 0 -> 32891 bytes .../source/windows/obj/pcre/win32/dirinfo.txt | 1 + .../windows/obj/pcre/win32/makefile.mak | 141 + .../obj/pcre/win32/pcre16_chartables.obj | Bin 0 -> 3398 bytes .../windows/obj/pcre/win32/pcre16_compile.obj | Bin 0 -> 42891 bytes .../windows/obj/pcre/win32/pcre16_config.obj | Bin 0 -> 2584 bytes .../obj/pcre/win32/pcre16_dfa_exec.obj | Bin 0 -> 31387 bytes .../windows/obj/pcre/win32/pcre16_exec.obj | Bin 0 -> 54670 bytes .../obj/pcre/win32/pcre16_fullinfo.obj | Bin 0 -> 2992 bytes .../windows/obj/pcre/win32/pcre16_get.obj | Bin 0 -> 4280 bytes .../obj/pcre/win32/pcre16_jit_compile.obj | Bin 0 -> 108828 bytes .../obj/pcre/win32/pcre16_maketables.obj | Bin 0 -> 3298 bytes .../windows/obj/pcre/win32/pcre16_newline.obj | Bin 0 -> 2842 bytes .../obj/pcre/win32/pcre16_ord2utf16.obj | Bin 0 -> 2303 bytes .../obj/pcre/win32/pcre16_refcount.obj | Bin 0 -> 2408 bytes .../obj/pcre/win32/pcre16_string_utils.obj | Bin 0 -> 2655 bytes .../windows/obj/pcre/win32/pcre16_study.obj | Bin 0 -> 7268 bytes .../windows/obj/pcre/win32/pcre16_tables.obj | Bin 0 -> 4688 bytes .../windows/obj/pcre/win32/pcre16_ucd.obj | Bin 0 -> 65661 bytes .../obj/pcre/win32/pcre16_valid_utf16.obj | Bin 0 -> 2429 bytes .../windows/obj/pcre/win32/pcre16_version.obj | Bin 0 -> 2389 bytes .../windows/obj/pcre/win32/pcre16_xclass.obj | Bin 0 -> 3501 bytes .../obj/pcre/win32/pcre_chartables.obj | Bin 0 -> 3318 bytes .../windows/obj/pcre/win32/pcre_compile.obj | Bin 0 -> 45270 bytes .../windows/obj/pcre/win32/pcre_config.obj | Bin 0 -> 2504 bytes .../windows/obj/pcre/win32/pcre_dfa_exec.obj | Bin 0 -> 34347 bytes .../windows/obj/pcre/win32/pcre_exec.obj | Bin 0 -> 74526 bytes .../windows/obj/pcre/win32/pcre_fullinfo.obj | Bin 0 -> 2906 bytes .../windows/obj/pcre/win32/pcre_get.obj | Bin 0 -> 4220 bytes .../obj/pcre/win32/pcre_jit_compile.obj | Bin 0 -> 111318 bytes .../obj/pcre/win32/pcre_maketables.obj | Bin 0 -> 3214 bytes .../windows/obj/pcre/win32/pcre_newline.obj | Bin 0 -> 3281 bytes .../windows/obj/pcre/win32/pcre_ord2utf8.obj | Bin 0 -> 2398 bytes .../windows/obj/pcre/win32/pcre_refcount.obj | Bin 0 -> 2328 bytes .../windows/obj/pcre/win32/pcre_study.obj | Bin 0 -> 8018 bytes .../windows/obj/pcre/win32/pcre_tables.obj | Bin 0 -> 4887 bytes .../windows/obj/pcre/win32/pcre_ucd.obj | Bin 0 -> 65584 bytes .../obj/pcre/win32/pcre_valid_utf8.obj | Bin 0 -> 3145 bytes .../windows/obj/pcre/win32/pcre_version.obj | Bin 0 -> 2310 bytes .../windows/obj/pcre/win32/pcre_xclass.obj | Bin 0 -> 4077 bytes .../source/windows/obj/pcre/win64/dirinfo.txt | 1 + .../windows/obj/pcre/win64/makefile.mak | 107 + .../obj/pcre/win64/pcre16_chartables.obj | Bin 0 -> 6520 bytes .../windows/obj/pcre/win64/pcre16_compile.obj | Bin 0 -> 153009 bytes .../windows/obj/pcre/win64/pcre16_config.obj | Bin 0 -> 7534 bytes .../obj/pcre/win64/pcre16_dfa_exec.obj | Bin 0 -> 93458 bytes .../windows/obj/pcre/win64/pcre16_exec.obj | Bin 0 -> 164627 bytes .../obj/pcre/win64/pcre16_fullinfo.obj | Bin 0 -> 10616 bytes .../windows/obj/pcre/win64/pcre16_get.obj | Bin 0 -> 16941 bytes .../obj/pcre/win64/pcre16_jit_compile.obj | Bin 0 -> 367149 bytes .../obj/pcre/win64/pcre16_maketables.obj | Bin 0 -> 8661 bytes .../windows/obj/pcre/win64/pcre16_newline.obj | Bin 0 -> 7700 bytes .../obj/pcre/win64/pcre16_ord2utf16.obj | Bin 0 -> 5778 bytes .../obj/pcre/win64/pcre16_refcount.obj | Bin 0 -> 6774 bytes .../obj/pcre/win64/pcre16_string_utils.obj | Bin 0 -> 9100 bytes .../windows/obj/pcre/win64/pcre16_study.obj | Bin 0 -> 37734 bytes .../windows/obj/pcre/win64/pcre16_tables.obj | Bin 0 -> 14209 bytes .../windows/obj/pcre/win64/pcre16_ucd.obj | Bin 0 -> 68787 bytes .../obj/pcre/win64/pcre16_valid_utf16.obj | Bin 0 -> 6519 bytes .../windows/obj/pcre/win64/pcre16_version.obj | Bin 0 -> 6128 bytes .../windows/obj/pcre/win64/pcre16_xclass.obj | Bin 0 -> 11107 bytes .../obj/pcre/win64/pcre_chartables.obj | Bin 0 -> 6434 bytes .../windows/obj/pcre/win64/pcre_compile.obj | Bin 0 -> 157078 bytes .../windows/obj/pcre/win64/pcre_config.obj | Bin 0 -> 7440 bytes .../windows/obj/pcre/win64/pcre_dfa_exec.obj | Bin 0 -> 96780 bytes .../windows/obj/pcre/win64/pcre_exec.obj | Bin 0 -> 204928 bytes .../windows/obj/pcre/win64/pcre_fullinfo.obj | Bin 0 -> 10492 bytes .../windows/obj/pcre/win64/pcre_get.obj | Bin 0 -> 16714 bytes .../obj/pcre/win64/pcre_jit_compile.obj | Bin 0 -> 374011 bytes .../obj/pcre/win64/pcre_maketables.obj | Bin 0 -> 8563 bytes .../windows/obj/pcre/win64/pcre_newline.obj | Bin 0 -> 8356 bytes .../windows/obj/pcre/win64/pcre_ord2utf8.obj | Bin 0 -> 6503 bytes .../windows/obj/pcre/win64/pcre_refcount.obj | Bin 0 -> 6662 bytes .../windows/obj/pcre/win64/pcre_study.obj | Bin 0 -> 39598 bytes .../windows/obj/pcre/win64/pcre_tables.obj | Bin 0 -> 14730 bytes .../windows/obj/pcre/win64/pcre_ucd.obj | Bin 0 -> 68693 bytes .../obj/pcre/win64/pcre_valid_utf8.obj | Bin 0 -> 8362 bytes .../windows/obj/pcre/win64/pcre_version.obj | Bin 0 -> 6032 bytes .../windows/obj/pcre/win64/pcre_xclass.obj | Bin 0 -> 12373 bytes .../source/windows/obj/zlib/win32/adler32.obj | Bin 0 -> 2732 bytes .../windows/obj/zlib/win32/compress.obj | Bin 0 -> 1386 bytes .../source/windows/obj/zlib/win32/crc32.obj | Bin 0 -> 12936 bytes .../source/windows/obj/zlib/win32/deflate.obj | Bin 0 -> 12820 bytes .../source/windows/obj/zlib/win32/dirinfo.txt | 1 + .../source/windows/obj/zlib/win32/infback.obj | Bin 0 -> 8900 bytes .../source/windows/obj/zlib/win32/inffast.obj | Bin 0 -> 3436 bytes .../source/windows/obj/zlib/win32/inflate.obj | Bin 0 -> 13367 bytes .../windows/obj/zlib/win32/inftrees.obj | Bin 0 -> 3376 bytes .../windows/obj/zlib/win32/makefile.mak | 109 + .../source/windows/obj/zlib/win32/trees.obj | Bin 0 -> 12365 bytes .../source/windows/obj/zlib/win32/uncompr.obj | Bin 0 -> 1317 bytes .../source/windows/obj/zlib/win32/zutil.obj | Bin 0 -> 2839 bytes .../source/windows/obj/zlib/win64/adler32.obj | Bin 0 -> 7800 bytes .../windows/obj/zlib/win64/compress.obj | Bin 0 -> 5909 bytes .../source/windows/obj/zlib/win64/crc32.obj | Bin 0 -> 22270 bytes .../source/windows/obj/zlib/win64/deflate.obj | Bin 0 -> 52273 bytes .../source/windows/obj/zlib/win64/dirinfo.txt | 1 + .../source/windows/obj/zlib/win64/infback.obj | Bin 0 -> 23184 bytes .../source/windows/obj/zlib/win64/inffast.obj | Bin 0 -> 11554 bytes .../source/windows/obj/zlib/win64/inflate.obj | Bin 0 -> 44333 bytes .../windows/obj/zlib/win64/inftrees.obj | Bin 0 -> 8533 bytes .../windows/obj/zlib/win64/makefile.mak | 60 + .../source/windows/obj/zlib/win64/trees.obj | Bin 0 -> 42217 bytes .../source/windows/obj/zlib/win64/uncompr.obj | Bin 0 -> 4996 bytes .../source/windows/obj/zlib/win64/zutil.obj | Bin 0 -> 8784 bytes 3rdParty/JCL/source/windows/sevenzip.pas | 770 + 381 files changed, 436393 insertions(+), 90041 deletions(-) create mode 100644 3rdParty/JCL/source/common/JclAbstractContainers.pas create mode 100644 3rdParty/JCL/source/common/JclAlgorithms.pas create mode 100644 3rdParty/JCL/source/common/JclArrayLists.pas create mode 100644 3rdParty/JCL/source/common/JclArraySets.pas create mode 100644 3rdParty/JCL/source/common/JclBinaryTrees.pas create mode 100644 3rdParty/JCL/source/common/JclCompilerUtils.pas create mode 100644 3rdParty/JCL/source/common/JclComplex.pas create mode 100644 3rdParty/JCL/source/common/JclCompression.pas create mode 100644 3rdParty/JCL/source/common/JclContainerIntf.pas create mode 100644 3rdParty/JCL/source/common/JclCounter.pas create mode 100644 3rdParty/JCL/source/common/JclDevToolsResources.pas create mode 100644 3rdParty/JCL/source/common/JclExprEval.pas create mode 100644 3rdParty/JCL/source/common/JclHashMaps.pas create mode 100644 3rdParty/JCL/source/common/JclHashSets.pas create mode 100644 3rdParty/JCL/source/common/JclIDEUtils.pas create mode 100644 3rdParty/JCL/source/common/JclLinkedLists.pas create mode 100644 3rdParty/JCL/source/common/JclMIDI.pas create mode 100644 3rdParty/JCL/source/common/JclMime.pas create mode 100644 3rdParty/JCL/source/common/JclNotify.pas create mode 100644 3rdParty/JCL/source/common/JclPreProcessorAlgorithmsTemplates.pas create mode 100644 3rdParty/JCL/source/common/JclPreProcessorArrayListsTemplates.pas create mode 100644 3rdParty/JCL/source/common/JclPreProcessorArraySetsTemplates.pas create mode 100644 3rdParty/JCL/source/common/JclPreProcessorBinaryTreesTemplates.pas create mode 100644 3rdParty/JCL/source/common/JclPreProcessorContainer1DTemplates.pas create mode 100644 3rdParty/JCL/source/common/JclPreProcessorContainer2DTemplates.pas create mode 100644 3rdParty/JCL/source/common/JclPreProcessorContainerIntfTemplates.pas create mode 100644 3rdParty/JCL/source/common/JclPreProcessorContainerKnownMaps.pas create mode 100644 3rdParty/JCL/source/common/JclPreProcessorContainerKnownTypes.pas create mode 100644 3rdParty/JCL/source/common/JclPreProcessorContainerTemplates.pas create mode 100644 3rdParty/JCL/source/common/JclPreProcessorContainerTypes.pas create mode 100644 3rdParty/JCL/source/common/JclPreProcessorExcDlgTemplates.pas create mode 100644 3rdParty/JCL/source/common/JclPreProcessorHashMapsTemplates.pas create mode 100644 3rdParty/JCL/source/common/JclPreProcessorHashSetsTemplates.pas create mode 100644 3rdParty/JCL/source/common/JclPreProcessorLexer.pas create mode 100644 3rdParty/JCL/source/common/JclPreProcessorLinkedListsTemplates.pas create mode 100644 3rdParty/JCL/source/common/JclPreProcessorParser.pas create mode 100644 3rdParty/JCL/source/common/JclPreProcessorQueuesTemplates.pas create mode 100644 3rdParty/JCL/source/common/JclPreProcessorSortedMapsTemplates.pas create mode 100644 3rdParty/JCL/source/common/JclPreProcessorStacksTemplates.pas create mode 100644 3rdParty/JCL/source/common/JclPreProcessorTemplates.pas create mode 100644 3rdParty/JCL/source/common/JclPreProcessorTreesTemplates.pas create mode 100644 3rdParty/JCL/source/common/JclPreProcessorVectorsTemplates.pas create mode 100644 3rdParty/JCL/source/common/JclQueues.pas create mode 100644 3rdParty/JCL/source/common/JclRTTI.pas create mode 100644 3rdParty/JCL/source/common/JclSchedule.pas create mode 100644 3rdParty/JCL/source/common/JclSortedMaps.pas create mode 100644 3rdParty/JCL/source/common/JclStacks.pas create mode 100644 3rdParty/JCL/source/common/JclStatistics.pas create mode 100644 3rdParty/JCL/source/common/JclStrHashMap.pas create mode 100644 3rdParty/JCL/source/common/JclTrees.pas create mode 100644 3rdParty/JCL/source/common/JclUnitConv.pas create mode 100644 3rdParty/JCL/source/common/JclUnitVersioning.pas create mode 100644 3rdParty/JCL/source/common/JclUnitVersioningProviders.pas create mode 100644 3rdParty/JCL/source/common/JclUsesUtils.pas create mode 100644 3rdParty/JCL/source/common/JclValidation.pas create mode 100644 3rdParty/JCL/source/common/JclVectors.pas create mode 100644 3rdParty/JCL/source/common/bzip2.pas create mode 100644 3rdParty/JCL/source/common/dirinfo.txt create mode 100644 3rdParty/JCL/source/common/zconf.h create mode 100644 3rdParty/JCL/source/common/zlib.h create mode 100644 3rdParty/JCL/source/common/zlibh.pas create mode 100644 3rdParty/JCL/source/include/jcld37win32.inc create mode 100644 3rdParty/JCL/source/include/jcld37win64.inc create mode 100644 3rdParty/JCL/source/prototypes/Hardlinks.pas create mode 100644 3rdParty/JCL/source/prototypes/JclAlgorithms.pas create mode 100644 3rdParty/JCL/source/prototypes/JclArrayLists.pas create mode 100644 3rdParty/JCL/source/prototypes/JclArraySets.pas create mode 100644 3rdParty/JCL/source/prototypes/JclBinaryTrees.pas create mode 100644 3rdParty/JCL/source/prototypes/JclContainerIntf.pas create mode 100644 3rdParty/JCL/source/prototypes/JclGraphUtils.pas create mode 100644 3rdParty/JCL/source/prototypes/JclGraphics.pas create mode 100644 3rdParty/JCL/source/prototypes/JclHashMaps.pas create mode 100644 3rdParty/JCL/source/prototypes/JclHashSets.pas create mode 100644 3rdParty/JCL/source/prototypes/JclLinkedLists.pas create mode 100644 3rdParty/JCL/source/prototypes/JclQueues.pas create mode 100644 3rdParty/JCL/source/prototypes/JclSortedMaps.pas create mode 100644 3rdParty/JCL/source/prototypes/JclStacks.pas create mode 100644 3rdParty/JCL/source/prototypes/JclTrees.pas create mode 100644 3rdParty/JCL/source/prototypes/JclVectors.pas create mode 100644 3rdParty/JCL/source/prototypes/JclWin32.pas create mode 100644 3rdParty/JCL/source/prototypes/Makefile.mak create mode 100644 3rdParty/JCL/source/prototypes/containers/JclAlgorithms.imp create mode 100644 3rdParty/JCL/source/prototypes/containers/JclAlgorithms.int create mode 100644 3rdParty/JCL/source/prototypes/containers/JclArrayLists.imp create mode 100644 3rdParty/JCL/source/prototypes/containers/JclArrayLists.int create mode 100644 3rdParty/JCL/source/prototypes/containers/JclArraySets.imp create mode 100644 3rdParty/JCL/source/prototypes/containers/JclArraySets.int create mode 100644 3rdParty/JCL/source/prototypes/containers/JclBinaryTrees.imp create mode 100644 3rdParty/JCL/source/prototypes/containers/JclBinaryTrees.int create mode 100644 3rdParty/JCL/source/prototypes/containers/JclContainerCommon.imp create mode 100644 3rdParty/JCL/source/prototypes/containers/JclContainerIntf.int create mode 100644 3rdParty/JCL/source/prototypes/containers/JclHashMaps.imp create mode 100644 3rdParty/JCL/source/prototypes/containers/JclHashMaps.int create mode 100644 3rdParty/JCL/source/prototypes/containers/JclHashSets.imp create mode 100644 3rdParty/JCL/source/prototypes/containers/JclHashSets.int create mode 100644 3rdParty/JCL/source/prototypes/containers/JclLinkedLists.imp create mode 100644 3rdParty/JCL/source/prototypes/containers/JclLinkedLists.int create mode 100644 3rdParty/JCL/source/prototypes/containers/JclQueues.imp create mode 100644 3rdParty/JCL/source/prototypes/containers/JclQueues.int create mode 100644 3rdParty/JCL/source/prototypes/containers/JclSortedMaps.imp create mode 100644 3rdParty/JCL/source/prototypes/containers/JclSortedMaps.int create mode 100644 3rdParty/JCL/source/prototypes/containers/JclStacks.imp create mode 100644 3rdParty/JCL/source/prototypes/containers/JclStacks.int create mode 100644 3rdParty/JCL/source/prototypes/containers/JclTrees.imp create mode 100644 3rdParty/JCL/source/prototypes/containers/JclTrees.int create mode 100644 3rdParty/JCL/source/prototypes/containers/JclVectors.imp create mode 100644 3rdParty/JCL/source/prototypes/containers/JclVectors.int create mode 100644 3rdParty/JCL/source/prototypes/supplement/create_JCL_Hardlinks.pas.cmd create mode 100644 3rdParty/JCL/source/prototypes/supplement/create_nonJCL_Hardlinks.pas.cmd create mode 100644 3rdParty/JCL/source/prototypes/supplement/simple_pp.pl create mode 100644 3rdParty/JCL/source/prototypes/win32api/AclApi.imp create mode 100644 3rdParty/JCL/source/prototypes/win32api/AclApi.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/DelayImp.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/ImageHlp.imp create mode 100644 3rdParty/JCL/source/prototypes/win32api/ImageHlp.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/ImgGuids.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/IoAPI.imp create mode 100644 3rdParty/JCL/source/prototypes/win32api/IoAPI.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/LmAccess.imp create mode 100644 3rdParty/JCL/source/prototypes/win32api/LmAccess.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/LmApiBuf.imp create mode 100644 3rdParty/JCL/source/prototypes/win32api/LmApiBuf.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/LmCons.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/LmErr.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/Lmwksta.imp create mode 100644 3rdParty/JCL/source/prototypes/win32api/Lmwksta.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/MsiDefs.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/Nb30.imp create mode 100644 3rdParty/JCL/source/prototypes/win32api/Nb30.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/NtSecApi.imp create mode 100644 3rdParty/JCL/source/prototypes/win32api/NtSecApi.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/ObjBase.imp create mode 100644 3rdParty/JCL/source/prototypes/win32api/ObjBase.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/PropIdl.imp create mode 100644 3rdParty/JCL/source/prototypes/win32api/PropIdl.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/RasDlg.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/Reason.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/ShlGuid.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/ShlObj.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/ShlWApi.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/TlHelp32.imp create mode 100644 3rdParty/JCL/source/prototypes/win32api/TlHelp32.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/WinBase.imp create mode 100644 3rdParty/JCL/source/prototypes/win32api/WinBase.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/WinDef.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/WinError.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/WinIoctl.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/WinNLS.imp create mode 100644 3rdParty/JCL/source/prototypes/win32api/WinNLS.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/WinNT.imp create mode 100644 3rdParty/JCL/source/prototypes/win32api/WinNT.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/WinUser.imp create mode 100644 3rdParty/JCL/source/prototypes/win32api/WinUser.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/Winternl.imp create mode 100644 3rdParty/JCL/source/prototypes/win32api/Winternl.int create mode 100644 3rdParty/JCL/source/prototypes/win32api/dirinfo.txt create mode 100644 3rdParty/JCL/source/prototypes/win32api/powrprof.imp create mode 100644 3rdParty/JCL/source/prototypes/win32api/powrprof.int create mode 100644 3rdParty/JCL/source/unix/dirinfo.txt create mode 100644 3rdParty/JCL/source/vcl/JclFont.pas create mode 100644 3rdParty/JCL/source/vcl/JclGraphUtils.pas create mode 100644 3rdParty/JCL/source/vcl/JclGraphics.pas create mode 100644 3rdParty/JCL/source/vcl/JclOpenDialog.rc create mode 100644 3rdParty/JCL/source/vcl/JclOpenDialog.res create mode 100644 3rdParty/JCL/source/vcl/JclOpenDialogFavorites.pas create mode 100644 3rdParty/JCL/source/vcl/JclOpenDialogHooks.pas create mode 100644 3rdParty/JCL/source/vcl/JclPrint.pas create mode 100644 3rdParty/JCL/source/vcl/JclVclResources.pas create mode 100644 3rdParty/JCL/source/vcl/JclVersionControl.pas create mode 100644 3rdParty/JCL/source/vcl/JclVersionCtrlCVSImpl.pas create mode 100644 3rdParty/JCL/source/vcl/JclVersionCtrlGITImpl.pas create mode 100644 3rdParty/JCL/source/vcl/JclVersionCtrlSVNImpl.pas create mode 100644 3rdParty/JCL/source/vcl/dirinfo.txt create mode 100644 3rdParty/JCL/source/windows/Hardlinks.pas create mode 100644 3rdParty/JCL/source/windows/JclAppInst.pas create mode 100644 3rdParty/JCL/source/windows/JclCIL.pas create mode 100644 3rdParty/JCL/source/windows/JclCLR.pas create mode 100644 3rdParty/JCL/source/windows/JclCOM.pas create mode 100644 3rdParty/JCL/source/windows/JclCommCtrlAdmin.manifest create mode 100644 3rdParty/JCL/source/windows/JclCommCtrlAdmin.rc create mode 100644 3rdParty/JCL/source/windows/JclCommCtrlAdmin.res create mode 100644 3rdParty/JCL/source/windows/JclCommCtrlAsInvoker.manifest create mode 100644 3rdParty/JCL/source/windows/JclCommCtrlAsInvoker.rc create mode 100644 3rdParty/JCL/source/windows/JclCommCtrlAsInvoker.res create mode 100644 3rdParty/JCL/source/windows/JclCppException.pas create mode 100644 3rdParty/JCL/source/windows/JclDebugSerialization.pas create mode 100644 3rdParty/JCL/source/windows/JclDebugXMLDeserializer.pas create mode 100644 3rdParty/JCL/source/windows/JclDebugXMLSerializer.pas create mode 100644 3rdParty/JCL/source/windows/JclDotNet.pas create mode 100644 3rdParty/JCL/source/windows/JclHelpUtils.pas create mode 100644 3rdParty/JCL/source/windows/JclLANMan.pas create mode 100644 3rdParty/JCL/source/windows/JclLocales.pas create mode 100644 3rdParty/JCL/source/windows/JclMapi.pas create mode 100644 3rdParty/JCL/source/windows/JclMetadata.pas create mode 100644 3rdParty/JCL/source/windows/JclMiscel.pas create mode 100644 3rdParty/JCL/source/windows/JclMsBuild.pas create mode 100644 3rdParty/JCL/source/windows/JclMsdosSys.pas create mode 100644 3rdParty/JCL/source/windows/JclMultimedia.pas create mode 100644 3rdParty/JCL/source/windows/JclNTFS.pas create mode 100644 3rdParty/JCL/source/windows/JclNoDepAdmin.manifest create mode 100644 3rdParty/JCL/source/windows/JclNoDepAdmin.rc create mode 100644 3rdParty/JCL/source/windows/JclNoDepAdmin.res create mode 100644 3rdParty/JCL/source/windows/JclNoDepAsInvoker.manifest create mode 100644 3rdParty/JCL/source/windows/JclNoDepAsInvoker.rc create mode 100644 3rdParty/JCL/source/windows/JclNoDepAsInvoker.res create mode 100644 3rdParty/JCL/source/windows/JclStructStorage.pas create mode 100644 3rdParty/JCL/source/windows/JclSvcCtrl.pas create mode 100644 3rdParty/JCL/source/windows/JclTask.pas create mode 100644 3rdParty/JCL/source/windows/JclTimeZones.pas create mode 100644 3rdParty/JCL/source/windows/JclWin32Ex.pas create mode 100644 3rdParty/JCL/source/windows/JclWinMIDI.pas create mode 100644 3rdParty/JCL/source/windows/MSHelpServices_TLB.pas create mode 100644 3rdParty/JCL/source/windows/MSTask.pas create mode 100644 3rdParty/JCL/source/windows/dirinfo.txt create mode 100644 3rdParty/JCL/source/windows/mscoree_TLB.pas create mode 100644 3rdParty/JCL/source/windows/mscorlib_TLB.pas create mode 100644 3rdParty/JCL/source/windows/obj/bzip2/win32/blocksort.obj create mode 100644 3rdParty/JCL/source/windows/obj/bzip2/win32/bzlib.obj create mode 100644 3rdParty/JCL/source/windows/obj/bzip2/win32/compress.obj create mode 100644 3rdParty/JCL/source/windows/obj/bzip2/win32/crctable.obj create mode 100644 3rdParty/JCL/source/windows/obj/bzip2/win32/decompress.obj create mode 100644 3rdParty/JCL/source/windows/obj/bzip2/win32/dirinfo.txt create mode 100644 3rdParty/JCL/source/windows/obj/bzip2/win32/huffman.obj create mode 100644 3rdParty/JCL/source/windows/obj/bzip2/win32/makefile.mak create mode 100644 3rdParty/JCL/source/windows/obj/bzip2/win32/randtable.obj create mode 100644 3rdParty/JCL/source/windows/obj/bzip2/win64/blocksort.obj create mode 100644 3rdParty/JCL/source/windows/obj/bzip2/win64/bzlib.obj create mode 100644 3rdParty/JCL/source/windows/obj/bzip2/win64/compress.obj create mode 100644 3rdParty/JCL/source/windows/obj/bzip2/win64/crctable.obj create mode 100644 3rdParty/JCL/source/windows/obj/bzip2/win64/decompress.obj create mode 100644 3rdParty/JCL/source/windows/obj/bzip2/win64/dirinfo.txt create mode 100644 3rdParty/JCL/source/windows/obj/bzip2/win64/huffman.obj create mode 100644 3rdParty/JCL/source/windows/obj/bzip2/win64/makefile.mak create mode 100644 3rdParty/JCL/source/windows/obj/bzip2/win64/randtable.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/dirinfo.txt create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/makefile.mak create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_chartables.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_compile.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_config.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_dfa_exec.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_exec.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_fullinfo.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_get.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_jit_compile.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_maketables.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_newline.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_ord2utf16.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_refcount.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_string_utils.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_study.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_tables.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_ucd.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_valid_utf16.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_version.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_xclass.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre_chartables.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre_compile.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre_config.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre_dfa_exec.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre_exec.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre_fullinfo.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre_get.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre_jit_compile.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre_maketables.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre_newline.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre_ord2utf8.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre_refcount.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre_study.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre_tables.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre_ucd.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre_valid_utf8.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre_version.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win32/pcre_xclass.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/dirinfo.txt create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/makefile.mak create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_chartables.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_compile.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_config.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_dfa_exec.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_exec.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_fullinfo.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_get.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_jit_compile.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_maketables.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_newline.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_ord2utf16.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_refcount.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_string_utils.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_study.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_tables.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_ucd.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_valid_utf16.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_version.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_xclass.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre_chartables.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre_compile.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre_config.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre_dfa_exec.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre_exec.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre_fullinfo.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre_get.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre_jit_compile.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre_maketables.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre_newline.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre_ord2utf8.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre_refcount.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre_study.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre_tables.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre_ucd.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre_valid_utf8.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre_version.obj create mode 100644 3rdParty/JCL/source/windows/obj/pcre/win64/pcre_xclass.obj create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win32/adler32.obj create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win32/compress.obj create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win32/crc32.obj create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win32/deflate.obj create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win32/dirinfo.txt create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win32/infback.obj create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win32/inffast.obj create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win32/inflate.obj create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win32/inftrees.obj create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win32/makefile.mak create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win32/trees.obj create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win32/uncompr.obj create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win32/zutil.obj create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win64/adler32.obj create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win64/compress.obj create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win64/crc32.obj create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win64/deflate.obj create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win64/dirinfo.txt create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win64/infback.obj create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win64/inffast.obj create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win64/inflate.obj create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win64/inftrees.obj create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win64/makefile.mak create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win64/trees.obj create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win64/uncompr.obj create mode 100644 3rdParty/JCL/source/windows/obj/zlib/win64/zutil.obj create mode 100644 3rdParty/JCL/source/windows/sevenzip.pas diff --git a/3rdParty/JCL/source/common/Jcl8087.pas b/3rdParty/JCL/source/common/Jcl8087.pas index 544f32b8..d8c5f186 100644 --- a/3rdParty/JCL/source/common/Jcl8087.pas +++ b/3rdParty/JCL/source/common/Jcl8087.pas @@ -1,339 +1,339 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is Jcl8087.pas } -{ } -{ The Initial Developer of the Original Code is Marcel van Brakel. } -{ Portions created by Marcel van Brakel are Copyright Marcel van Brakel. All rights reserved. } -{ } -{ Contributor(s): } -{ Marcel van Brakel } -{ ESB Consultancy } -{ Robert Marquardt (marquardt) } -{ Robert Rossmair (rrossmair) } -{ Matthias Thoma (mthoma) } -{ Petr Vones } -{ } -{**************************************************************************************************} -{ } -{ This unit contains various routine for manipulating the math coprocessor. This includes such } -{ things as querying and setting the rounding precision of floating point operations and } -{ retrieving the coprocessor's status word. } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -unit Jcl8087; - -{$I jcl.inc} - -interface - -{$IFDEF UNITVERSIONING} -uses - JclUnitVersioning; -{$ENDIF UNITVERSIONING} - -type - T8087Precision = (pcSingle, pcReserved, pcDouble, pcExtended); - T8087Rounding = (rcNearestOrEven, rcDownInfinity, rcUpInfinity, rcChopOrTruncate); - T8087Infinity = (icProjective, icAffine); - T8087Exception = (emInvalidOp, emDenormalizedOperand, emZeroDivide, emOverflow, - emUnderflow, emPrecision); - T8087Exceptions = set of T8087Exception; - -const - All8087Exceptions = [Low(T8087Exception)..High(T8087Exception)]; - -function Get8087ControlWord: Word; -function Get8087Infinity: T8087Infinity; -function Get8087Precision: T8087Precision; -function Get8087Rounding: T8087Rounding; -function Get8087StatusWord(ClearExceptions: Boolean): Word; - -function Set8087Infinity(const Infinity: T8087Infinity): T8087Infinity; -function Set8087Precision(const Precision: T8087Precision): T8087Precision; -function Set8087Rounding(const Rounding: T8087Rounding): T8087Rounding; -function Set8087ControlWord(const Control: Word): Word; - -function ClearPending8087Exceptions: T8087Exceptions; -function GetPending8087Exceptions: T8087Exceptions; -function GetMasked8087Exceptions: T8087Exceptions; -function SetMasked8087Exceptions(Exceptions: T8087Exceptions; ClearBefore: Boolean = True): T8087Exceptions; -function Mask8087Exceptions(Exceptions: T8087Exceptions): T8087Exceptions; -function Unmask8087Exceptions(Exceptions: T8087Exceptions; ClearBefore: Boolean = True): T8087Exceptions; - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\common'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -const - X87ExceptBits = $3F; - -function Get8087ControlWord: Word; -asm - FSTCW Result - FWAIT -end; - -function Get8087Infinity: T8087Infinity; -begin - Result := T8087Infinity((Get8087ControlWord and $1000) shr 12); -end; - -function Get8087Precision: T8087Precision; -begin - Result := T8087Precision((Get8087ControlWord and $0300) shr 8); -end; - -function Get8087Rounding: T8087Rounding; -begin - Result := T8087Rounding((Get8087ControlWord and $0C00) shr 10); -end; - -{$IFDEF CPU64} -function Get8087StatusWord(ClearExceptions: Boolean): Word; -asm - TEST ClearExceptions, ClearExceptions - JZ @@Without - FSTSW Result // get status word (clears exceptions) - JMP @@Leave -@@Without: - FNSTSW Result // get status word (without clearing exceptions) -@@Leave: -end; -{$ELSE} -function Get8087StatusWord(ClearExceptions: Boolean): Word; -begin - if ClearExceptions then - asm - FSTSW Result // get status word (clears exceptions) - end - else - asm - FNSTSW Result // get status word (without clearing exceptions) - end; -end; -{$ENDIF CPU64} - -function Set8087Infinity(const Infinity: T8087Infinity): T8087Infinity; -var - CW: Word; -begin - CW := Get8087ControlWord; - Result := T8087Infinity((CW and $1000) shr 12); - Set8087ControlWord((CW and $EFFF) or (Word(Infinity) shl 12)); -end; - -function Set8087Precision(const Precision: T8087Precision): T8087Precision; -var - CW: Word; -begin - CW := Get8087ControlWord; - Result := T8087Precision((CW and $0300) shr 8); - Set8087ControlWord((CW and $FCFF) or (Word(Precision) shl 8)); -end; - -function Set8087Rounding(const Rounding: T8087Rounding): T8087Rounding; -var - CW: Word; -begin - CW := Get8087ControlWord; - Result := T8087Rounding((CW and $0C00) shr 10); - Set8087ControlWord((CW and $F3FF) or (Word(Rounding) shl 10)); -end; - -function Set8087ControlWord(const Control: Word): Word; -var - StackControl: Word; -asm - MOV StackControl, Control - FNCLEX - FSTCW Result // save the old control word - FLDCW StackControl // load the new control word -end; - -function ClearPending8087Exceptions: T8087Exceptions; - - function GetSW: Word; - asm - FNSTSW Result - AND Result, X87ExceptBits - FNCLEX - end; - -var - SW: Word; -begin - SW := GetSW; - - Result := []; - if (SW and $01) <> 0 then - Include(Result, emInvalidOp); - if (SW and $02) <> 0 then - Include(Result, emDenormalizedOperand); - if (SW and $04) <> 0 then - Include(Result, emZeroDivide); - if (SW and $08) <> 0 then - Include(Result, emOverflow); - if (SW and $10) <> 0 then - Include(Result, emUnderflow); - if (SW and $20) <> 0 then - Include(Result, emPrecision); -end; - -function GetPending8087Exceptions: T8087Exceptions; - - function GetSW: Word; - asm - FNSTSW Result - AND Result, X87ExceptBits - end; - -var - SW: Word; -begin - SW := GetSW; - Result := []; - if (SW and $01) <> 0 then - Include(Result, emInvalidOp); - if (SW and $02) <> 0 then - Include(Result, emDenormalizedOperand); - if (SW and $04) <> 0 then - Include(Result, emZeroDivide); - if (SW and $08) <> 0 then - Include(Result, emOverflow); - if (SW and $10) <> 0 then - Include(Result, emUnderflow); - if (SW and $20) <> 0 then - Include(Result, emPrecision); -end; - -function GetMasked8087Exceptions: T8087Exceptions; - - function GetCW: Word; - asm - FSTCW Result - AND Result, X87ExceptBits - end; - -var - CW: Word; -begin - CW := GetCW; - Result := []; - if (CW and $01) <> 0 then - Include(Result, emInvalidOp); - if (CW and $02) <> 0 then - Include(Result, emDenormalizedOperand); - if (CW and $04) <> 0 then - Include(Result, emZeroDivide); - if (CW and $08) <> 0 then - Include(Result, emOverflow); - if (CW and $10) <> 0 then - Include(Result, emUnderflow); - if (CW and $20) <> 0 then - Include(Result, emPrecision); -end; - -function SetMasked8087Exceptions(Exceptions: T8087Exceptions; ClearBefore: Boolean): T8087Exceptions; - - function ClearPendingExceptions: Word; - asm - FNCLEX // clear pending exceptions - end; - - function SetCW(NewCW: Word): Word; - var - StackNewCW: Word; - asm - FSTCW Result - FWAIT - MOV StackNewCW, NewCW - MOV AX, Result - AND AX, NOT X87ExceptBits // mask exception mask bits 0..5 - OR StackNewCW, AX - FLDCW StackNewCW - end; - -var - OldCW, NewCW: Word; -begin - if ClearBefore then - ClearPendingExceptions; - NewCW := 0; - if emInvalidOp in Exceptions then - NewCW := NewCW or $01; - if emDenormalizedOperand in Exceptions then - NewCW := NewCW or $02; - if emZeroDivide in Exceptions then - NewCW := NewCW or $04; - if emOverflow in Exceptions then - NewCW := NewCW or $08; - if emUnderflow in Exceptions then - NewCW := NewCW or $10; - if emPrecision in Exceptions then - NewCW := NewCW or $20; - OldCW := SetCW(NewCW); - Result := []; - if (OldCW and $01) <> 0 then - Include(Result, emInvalidOp); - if (OldCW and $02) <> 0 then - Include(Result, emDenormalizedOperand); - if (OldCW and $04) <> 0 then - Include(Result, emZeroDivide); - if (OldCW and $08) <> 0 then - Include(Result, emOverflow); - if (OldCW and $10) <> 0 then - Include(Result, emUnderflow); - if (OldCW and $20) <> 0 then - Include(Result, emPrecision); -end; - -function Mask8087Exceptions(Exceptions: T8087Exceptions): T8087Exceptions; -begin - Result := GetMasked8087Exceptions; - Exceptions := Exceptions + Result; - SetMasked8087Exceptions(Exceptions, False); -end; - -function Unmask8087Exceptions(Exceptions: T8087Exceptions; ClearBefore: Boolean): T8087Exceptions; -begin - Result := GetMasked8087Exceptions; - Exceptions := Result - Exceptions; - SetMasked8087Exceptions(Exceptions, ClearBefore); -end; - -{$IFDEF UNITVERSIONING} -initialization - RegisterUnitVersion(HInstance, UnitVersioning); - -finalization - UnregisterUnitVersion(HInstance); -{$ENDIF UNITVERSIONING} - -end. +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is Jcl8087.pas } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. } +{ Portions created by Marcel van Brakel are Copyright Marcel van Brakel. All rights reserved. } +{ } +{ Contributor(s): } +{ Marcel van Brakel } +{ ESB Consultancy } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Matthias Thoma (mthoma) } +{ Petr Vones } +{ } +{**************************************************************************************************} +{ } +{ This unit contains various routine for manipulating the math coprocessor. This includes such } +{ things as querying and setting the rounding precision of floating point operations and } +{ retrieving the coprocessor's status word. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit Jcl8087; + +{$I jcl.inc} + +interface + +{$IFDEF UNITVERSIONING} +uses + JclUnitVersioning; +{$ENDIF UNITVERSIONING} + +type + T8087Precision = (pcSingle, pcReserved, pcDouble, pcExtended); + T8087Rounding = (rcNearestOrEven, rcDownInfinity, rcUpInfinity, rcChopOrTruncate); + T8087Infinity = (icProjective, icAffine); + T8087Exception = (emInvalidOp, emDenormalizedOperand, emZeroDivide, emOverflow, + emUnderflow, emPrecision); + T8087Exceptions = set of T8087Exception; + +const + All8087Exceptions = [Low(T8087Exception)..High(T8087Exception)]; + +function Get8087ControlWord: Word; +function Get8087Infinity: T8087Infinity; +function Get8087Precision: T8087Precision; +function Get8087Rounding: T8087Rounding; +function Get8087StatusWord(ClearExceptions: Boolean): Word; + +function Set8087Infinity(const Infinity: T8087Infinity): T8087Infinity; +function Set8087Precision(const Precision: T8087Precision): T8087Precision; +function Set8087Rounding(const Rounding: T8087Rounding): T8087Rounding; +function Set8087ControlWord(const Control: Word): Word; + +function ClearPending8087Exceptions: T8087Exceptions; +function GetPending8087Exceptions: T8087Exceptions; +function GetMasked8087Exceptions: T8087Exceptions; +function SetMasked8087Exceptions(Exceptions: T8087Exceptions; ClearBefore: Boolean = True): T8087Exceptions; +function Mask8087Exceptions(Exceptions: T8087Exceptions): T8087Exceptions; +function Unmask8087Exceptions(Exceptions: T8087Exceptions; ClearBefore: Boolean = True): T8087Exceptions; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +const + X87ExceptBits = $3F; + +function Get8087ControlWord: Word; +asm + FSTCW Result + FWAIT +end; + +function Get8087Infinity: T8087Infinity; +begin + Result := T8087Infinity((Get8087ControlWord and $1000) shr 12); +end; + +function Get8087Precision: T8087Precision; +begin + Result := T8087Precision((Get8087ControlWord and $0300) shr 8); +end; + +function Get8087Rounding: T8087Rounding; +begin + Result := T8087Rounding((Get8087ControlWord and $0C00) shr 10); +end; + +{$IFDEF CPU64} +function Get8087StatusWord(ClearExceptions: Boolean): Word; +asm + TEST ClearExceptions, ClearExceptions + JZ @@Without + FSTSW Result // get status word (clears exceptions) + JMP @@Leave +@@Without: + FNSTSW Result // get status word (without clearing exceptions) +@@Leave: +end; +{$ELSE} +function Get8087StatusWord(ClearExceptions: Boolean): Word; +begin + if ClearExceptions then + asm + FSTSW Result // get status word (clears exceptions) + end + else + asm + FNSTSW Result // get status word (without clearing exceptions) + end; +end; +{$ENDIF CPU64} + +function Set8087Infinity(const Infinity: T8087Infinity): T8087Infinity; +var + CW: Word; +begin + CW := Get8087ControlWord; + Result := T8087Infinity((CW and $1000) shr 12); + Set8087ControlWord((CW and $EFFF) or (Word(Infinity) shl 12)); +end; + +function Set8087Precision(const Precision: T8087Precision): T8087Precision; +var + CW: Word; +begin + CW := Get8087ControlWord; + Result := T8087Precision((CW and $0300) shr 8); + Set8087ControlWord((CW and $FCFF) or (Word(Precision) shl 8)); +end; + +function Set8087Rounding(const Rounding: T8087Rounding): T8087Rounding; +var + CW: Word; +begin + CW := Get8087ControlWord; + Result := T8087Rounding((CW and $0C00) shr 10); + Set8087ControlWord((CW and $F3FF) or (Word(Rounding) shl 10)); +end; + +function Set8087ControlWord(const Control: Word): Word; +var + StackControl: Word; +asm + MOV StackControl, Control + FNCLEX + FSTCW Result // save the old control word + FLDCW StackControl // load the new control word +end; + +function ClearPending8087Exceptions: T8087Exceptions; + + function GetSW: Word; + asm + FNSTSW Result + AND Result, X87ExceptBits + FNCLEX + end; + +var + SW: Word; +begin + SW := GetSW; + + Result := []; + if (SW and $01) <> 0 then + Include(Result, emInvalidOp); + if (SW and $02) <> 0 then + Include(Result, emDenormalizedOperand); + if (SW and $04) <> 0 then + Include(Result, emZeroDivide); + if (SW and $08) <> 0 then + Include(Result, emOverflow); + if (SW and $10) <> 0 then + Include(Result, emUnderflow); + if (SW and $20) <> 0 then + Include(Result, emPrecision); +end; + +function GetPending8087Exceptions: T8087Exceptions; + + function GetSW: Word; + asm + FNSTSW Result + AND Result, X87ExceptBits + end; + +var + SW: Word; +begin + SW := GetSW; + Result := []; + if (SW and $01) <> 0 then + Include(Result, emInvalidOp); + if (SW and $02) <> 0 then + Include(Result, emDenormalizedOperand); + if (SW and $04) <> 0 then + Include(Result, emZeroDivide); + if (SW and $08) <> 0 then + Include(Result, emOverflow); + if (SW and $10) <> 0 then + Include(Result, emUnderflow); + if (SW and $20) <> 0 then + Include(Result, emPrecision); +end; + +function GetMasked8087Exceptions: T8087Exceptions; + + function GetCW: Word; + asm + FSTCW Result + AND Result, X87ExceptBits + end; + +var + CW: Word; +begin + CW := GetCW; + Result := []; + if (CW and $01) <> 0 then + Include(Result, emInvalidOp); + if (CW and $02) <> 0 then + Include(Result, emDenormalizedOperand); + if (CW and $04) <> 0 then + Include(Result, emZeroDivide); + if (CW and $08) <> 0 then + Include(Result, emOverflow); + if (CW and $10) <> 0 then + Include(Result, emUnderflow); + if (CW and $20) <> 0 then + Include(Result, emPrecision); +end; + +function SetMasked8087Exceptions(Exceptions: T8087Exceptions; ClearBefore: Boolean): T8087Exceptions; + + function ClearPendingExceptions: Word; + asm + FNCLEX // clear pending exceptions + end; + + function SetCW(NewCW: Word): Word; + var + StackNewCW: Word; + asm + FSTCW Result + FWAIT + MOV StackNewCW, NewCW + MOV AX, Result + AND AX, NOT X87ExceptBits // mask exception mask bits 0..5 + OR StackNewCW, AX + FLDCW StackNewCW + end; + +var + OldCW, NewCW: Word; +begin + if ClearBefore then + ClearPendingExceptions; + NewCW := 0; + if emInvalidOp in Exceptions then + NewCW := NewCW or $01; + if emDenormalizedOperand in Exceptions then + NewCW := NewCW or $02; + if emZeroDivide in Exceptions then + NewCW := NewCW or $04; + if emOverflow in Exceptions then + NewCW := NewCW or $08; + if emUnderflow in Exceptions then + NewCW := NewCW or $10; + if emPrecision in Exceptions then + NewCW := NewCW or $20; + OldCW := SetCW(NewCW); + Result := []; + if (OldCW and $01) <> 0 then + Include(Result, emInvalidOp); + if (OldCW and $02) <> 0 then + Include(Result, emDenormalizedOperand); + if (OldCW and $04) <> 0 then + Include(Result, emZeroDivide); + if (OldCW and $08) <> 0 then + Include(Result, emOverflow); + if (OldCW and $10) <> 0 then + Include(Result, emUnderflow); + if (OldCW and $20) <> 0 then + Include(Result, emPrecision); +end; + +function Mask8087Exceptions(Exceptions: T8087Exceptions): T8087Exceptions; +begin + Result := GetMasked8087Exceptions; + Exceptions := Exceptions + Result; + SetMasked8087Exceptions(Exceptions, False); +end; + +function Unmask8087Exceptions(Exceptions: T8087Exceptions; ClearBefore: Boolean): T8087Exceptions; +begin + Result := GetMasked8087Exceptions; + Exceptions := Result - Exceptions; + SetMasked8087Exceptions(Exceptions, ClearBefore); +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclAbstractContainers.pas b/3rdParty/JCL/source/common/JclAbstractContainers.pas new file mode 100644 index 00000000..38a46bda --- /dev/null +++ b/3rdParty/JCL/source/common/JclAbstractContainers.pas @@ -0,0 +1,2958 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is AbstractContainer.pas and DCL_Util.pas. } +{ } +{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } +{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } +{ All rights reserved. } +{ } +{ Contributors: } +{ Daniele Teti (dade2004) } +{ Robert Marquardt (marquardt) } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclAbstractContainers; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + {$IFDEF HAS_UNITSCOPE} + System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Classes, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclContainerIntf, JclSynch, JclSysUtils, + JclWideStrings, + JclAnsiStrings; + +type + // (OF) was moved to JclSysUtils + // TJclIntfCriticalSection = JclSysUtils.TJclIntfCriticalSection; + + TJclAbstractLockable = class(TInterfacedObject {$IFDEF THREADSAFE}, IJclLockable {$ENDIF THREADSAFE}) + {$IFDEF THREADSAFE} + protected + FThreadSafe: Boolean; + FSyncReaderWriter: TJclMultiReadExclusiveWrite; + public + constructor Create; + destructor Destroy; override; + property SyncReaderWriter: TJclMultiReadExclusiveWrite read FSyncReaderWriter; + { IJclLockable } + procedure ReadLock; + procedure ReadUnlock; + procedure WriteLock; + procedure WriteUnlock; + {$ENDIF THREADSAFE} + end; + + TJclAbstractContainerBase = class(TJclAbstractLockable, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclCloneable, IJclIntfCloneable, IJclBaseContainer) + protected + FAllowDefaultElements: Boolean; + FDuplicates: TDuplicates; + FRemoveSingleElement: Boolean; + FReturnDefaultElements: Boolean; + FReadOnly: Boolean; + FCapacity: Integer; + FSize: Integer; + FAutoGrowParameter: Integer; + FAutoGrowStrategy: TJclAutoGrowStrategy; + FAutoPackParameter: Integer; + FAutoPackStrategy: TJclAutoPackStrategy; + procedure AutoGrow; virtual; + procedure AutoPack; virtual; + function CheckDuplicate: Boolean; + function CreateEmptyContainer: TJclAbstractContainerBase; virtual; abstract; + procedure AssignDataTo(Dest: TJclAbstractContainerBase); virtual; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); virtual; + {$IFDEF SUPPORTS_GENERICS} + procedure FreeAndNilIfObject(var Value: T); + {$ENDIF SUPPORTS_GENERICS} + public + constructor Create; + { IJclBaseContainer } + procedure Assign(const Source: IJclBaseContainer); + procedure AssignTo(const Dest: IJclBaseContainer); + function GetAllowDefaultElements: Boolean; virtual; + function GetContainerReference: TObject; + function GetDuplicates: TDuplicates; virtual; + function GetReadOnly: Boolean; virtual; + function GetRemoveSingleElement: Boolean; virtual; + function GetReturnDefaultElements: Boolean; virtual; + function GetThreadSafe: Boolean; virtual; + procedure SetAllowDefaultElements(Value: Boolean); virtual; + procedure SetDuplicates(Value: TDuplicates); virtual; + procedure SetReadOnly(Value: Boolean); virtual; + procedure SetRemoveSingleElement(Value: Boolean); virtual; + procedure SetReturnDefaultElements(Value: Boolean); virtual; + procedure SetThreadSafe(Value: Boolean); virtual; + property AllowDefaultElements: Boolean read GetAllowDefaultElements write SetAllowDefaultElements; + property Duplicates: TDuplicates read GetDuplicates write SetDuplicates; + property ReadOnly: Boolean read GetReadOnly write SetReadOnly; + property RemoveSingleElement: Boolean read GetRemoveSingleElement write SetRemoveSingleElement; + property ReturnDefaultElements: Boolean read GetReturnDefaultElements write SetReturnDefaultElements; + property ThreadSafe: Boolean read GetThreadSafe write SetThreadSafe; + { IJclCloneable } + function ObjectClone: TObject; + { IJclIntfCloneable } + function IntfClone: IInterface; + // IJclGrowable is not in interface list because some descendants won't use this code + { IJclGrowable } + function CalcGrowCapacity(ACapacity, ASize: Integer): Integer; virtual; + function GetAutoGrowParameter: Integer; virtual; + function GetAutoGrowStrategy: TJclAutoGrowStrategy; virtual; + procedure Grow; virtual; + procedure SetAutoGrowParameter(Value: Integer); virtual; + procedure SetAutoGrowStrategy(Value: TJclAutoGrowStrategy); virtual; + property AutoGrowParameter: Integer read GetAutoGrowParameter write SetAutoGrowParameter; + property AutoGrowStrategy: TJclAutoGrowStrategy read GetAutoGrowStrategy write SetAutoGrowStrategy; + // IJclPackable is not in interface list because some descendants won't use this code + { IJclPackable } + function CalcPackCapacity(ACapacity, ASize: Integer): Integer; virtual; + function GetAutoPackParameter: Integer; virtual; + function GetAutoPackStrategy: TJclAutoPackStrategy; virtual; + function GetCapacity: Integer; virtual; + procedure Pack; virtual; + procedure SetAutoPackParameter(Value: Integer); virtual; + procedure SetAutoPackStrategy(Value: TJclAutoPackStrategy); virtual; + procedure SetCapacity(Value: Integer); virtual; + property AutoPackParameter: Integer read GetAutoPackParameter write SetAutoPackParameter; + property AutoPackStrategy: TJclAutoPackStrategy read GetAutoPackStrategy write SetAutoPackStrategy; + end; + + TJclAbstractIterator = class(TJclAbstractLockable, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclCloneable, IJclIntfCloneable, IJclAbstractIterator) + private + FValid: Boolean; + protected + procedure CheckValid; + function CreateEmptyIterator: TJclAbstractIterator; virtual; abstract; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); virtual; + public + constructor Create(AValid: Boolean); + property Valid: Boolean read FValid write FValid; + { IJclAbstractIterator } + procedure Assign(const Source: IJclAbstractIterator); + procedure AssignTo(const Dest: IJclAbstractIterator); + function GetIteratorReference: TObject; + { IJclCloneable } + function ObjectClone: TObject; + { IJclIntfCloneable } + function IntfClone: IInterface; + end; + + TJclIntfAbstractContainer = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclCloneable, IJclIntfCloneable, IJclBaseContainer, IJclIntfContainer, + IJclIntfOwner, IJclIntfEqualityComparer, IJclIntfComparer, IJclIntfHashConverter) + protected + FEqualityCompare: TIntfEqualityCompare; + FCompare: TIntfCompare; + FHashConvert: TIntfHashConvert; + FOnFreeObject: TFreeIntfEvent; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + { IJclIntfOwner } + function GetOnFreeObject: TFreeIntfEvent; + function FreeObject(var AInterface: IInterface): IInterface; virtual; + procedure SetOnFreeObject(Value: TFreeIntfEvent); + property OnFreeObject: TFreeIntfEvent read GetOnFreeObject write SetOnFreeObject; + { IJclIntfEqualityComparer } + function GetEqualityCompare: TIntfEqualityCompare; virtual; + procedure SetEqualityCompare(Value: TIntfEqualityCompare); virtual; + function ItemsEqual(const A, B: IInterface): Boolean; virtual; + property EqualityCompare: TIntfEqualityCompare read GetEqualityCompare write SetEqualityCompare; + { IJclIntfComparer } + function GetCompare: TIntfCompare; virtual; + procedure SetCompare(Value: TIntfCompare); virtual; + function ItemsCompare(const A, B: IInterface): Integer; virtual; + property Compare: TIntfCompare read GetCompare write SetCompare; + { IJclIntfHashConverter } + function GetHashConvert: TIntfHashConvert; virtual; + procedure SetHashConvert(Value: TIntfHashConvert); virtual; + function Hash(const AInterface: IInterface): Integer; virtual; + property HashConvert: TIntfHashConvert read GetHashConvert write SetHashConvert; + end; + + TJclStrAbstractContainer = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclCloneable, IJclIntfCloneable, IJclBaseContainer, IJclStrBaseContainer) + protected + FCaseSensitive: Boolean; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + { IJclStrBaseContainer } + function GetCaseSensitive: Boolean; virtual; + procedure SetCaseSensitive(Value: Boolean); virtual; + property CaseSensitive: Boolean read GetCaseSensitive write SetCaseSensitive; + end; + + TJclAnsiStrAbstractContainer = class(TJclStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclCloneable, IJclIntfCloneable, IJclBaseContainer, IJclStrBaseContainer, IJclAnsiStrContainer, + IJclAnsiStrOwner, IJclAnsiStrEqualityComparer, IJclAnsiStrComparer, IJclAnsiStrHashConverter) + protected + FEncoding: TJclAnsiStrEncoding; + FEqualityCompare: TAnsiStrEqualityCompare; + FCompare: TAnsiStrCompare; + FHashConvert: TAnsiStrHashConvert; + FOnFreeString: TFreeAnsiStrEvent; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + { IJclAnsiStrOwner } + function GetOnFreeString: TFreeAnsiStrEvent; + function FreeString(var AString: AnsiString): AnsiString; virtual; + procedure SetOnFreeString(Value: TFreeAnsiStrEvent); + property OnFreeString: TFreeAnsiStrEvent read GetOnFreeString write SetOnFreeString; + { IJclAnsiStrContainer } + function GetEncoding: TJclAnsiStrEncoding; virtual; + procedure SetEncoding(Value: TJclAnsiStrEncoding); virtual; + property Encoding: TJclAnsiStrEncoding read GetEncoding write SetEncoding; + { IJclAnsiStrEqualityComparer } + function GetEqualityCompare: TAnsiStrEqualityCompare; virtual; + procedure SetEqualityCompare(Value: TAnsiStrEqualityCompare); virtual; + function ItemsEqual(const A, B: AnsiString): Boolean; virtual; + property EqualityCompare: TAnsiStrEqualityCompare read GetEqualityCompare write SetEqualityCompare; + { IJclAnsiStrComparer } + function GetCompare: TAnsiStrCompare; virtual; + procedure SetCompare(Value: TAnsiStrCompare); virtual; + function ItemsCompare(const A, B: AnsiString): Integer; virtual; + property Compare: TAnsiStrCompare read GetCompare write SetCompare; + { IJclAnsiStrHashConverter } + function GetHashConvert: TAnsiStrHashConvert; virtual; + procedure SetHashConvert(Value: TAnsiStrHashConvert); virtual; + function Hash(const AString: AnsiString): Integer; virtual; + property HashConvert: TAnsiStrHashConvert read GetHashConvert write SetHashConvert; + end; + + TJclWideStrAbstractContainer = class(TJclStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclCloneable, IJclIntfCloneable, IJclBaseContainer, IJclStrBaseContainer, IJclWideStrContainer, + IJclWideStrOwner, IJclWideStrEqualityComparer, IJclWideStrComparer, IJclWideStrHashConverter) + protected + FEncoding: TJclWideStrEncoding; + FEqualityCompare: TWideStrEqualityCompare; + FCompare: TWideStrCompare; + FHashConvert: TWideStrHashConvert; + FOnFreeString: TFreeWideStrEvent; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + { IJclWideStrOwner } + function GetOnFreeString: TFreeWideStrEvent; + function FreeString(var AString: WideString): WideString; virtual; + procedure SetOnFreeString(Value: TFreeWideStrEvent); + property OnFreeString: TFreeWideStrEvent read GetOnFreeString write SetOnFreeString; + { IJclWideStrContainer } + function GetEncoding: TJclWideStrEncoding; virtual; + procedure SetEncoding(Value: TJclWideStrEncoding); virtual; + property Encoding: TJclWideStrEncoding read GetEncoding write SetEncoding; + { IJclWideStrEqualityComparer } + function GetEqualityCompare: TWideStrEqualityCompare; virtual; + procedure SetEqualityCompare(Value: TWideStrEqualityCompare); virtual; + function ItemsEqual(const A, B: WideString): Boolean; virtual; + property EqualityCompare: TWideStrEqualityCompare read GetEqualityCompare write SetEqualityCompare; + { IJclWideStrComparer } + function GetCompare: TWideStrCompare; virtual; + procedure SetCompare(Value: TWideStrCompare); virtual; + function ItemsCompare(const A, B: WideString): Integer; virtual; + property Compare: TWideStrCompare read GetCompare write SetCompare; + { IJclWideStrHashConverter } + function GetHashConvert: TWideStrHashConvert; virtual; + procedure SetHashConvert(Value: TWideStrHashConvert); virtual; + function Hash(const AString: WideString): Integer; virtual; + property HashConvert: TWideStrHashConvert read GetHashConvert write SetHashConvert; + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclUnicodeStrAbstractContainer = class(TJclStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclCloneable, IJclIntfCloneable, IJclBaseContainer, IJclStrBaseContainer, IJclUnicodeStrContainer, + IJclUnicodeStrOwner, IJclUnicodeStrEqualityComparer, IJclUnicodeStrComparer, IJclUnicodeStrHashConverter) + protected + FEqualityCompare: TUnicodeStrEqualityCompare; + FCompare: TUnicodeStrCompare; + FHashConvert: TUnicodeStrHashConvert; + FOnFreeString: TFreeUnicodeStrEvent; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + { IJclUnicodeStrOwner } + function GetOnFreeString: TFreeUnicodeStrEvent; + function FreeString(var AString: UnicodeString): UnicodeString; virtual; + procedure SetOnFreeString(Value: TFreeUnicodeStrEvent); + property OnFreeString: TFreeUnicodeStrEvent read GetOnFreeString write SetOnFreeString; + { IJclUnicodeStrEqualityComparer } + function GetEqualityCompare: TUnicodeStrEqualityCompare; virtual; + procedure SetEqualityCompare(Value: TUnicodeStrEqualityCompare); virtual; + function ItemsEqual(const A, B: UnicodeString): Boolean; virtual; + property EqualityCompare: TUnicodeStrEqualityCompare read GetEqualityCompare write SetEqualityCompare; + { IJclUnicodeStrComparer } + function GetCompare: TUnicodeStrCompare; virtual; + procedure SetCompare(Value: TUnicodeStrCompare); virtual; + function ItemsCompare(const A, B: UnicodeString): Integer; virtual; + property Compare: TUnicodeStrCompare read GetCompare write SetCompare; + { IJclUnicodeStrHashConverter } + function GetHashConvert: TUnicodeStrHashConvert; virtual; + procedure SetHashConvert(Value: TUnicodeStrHashConvert); virtual; + function Hash(const AString: UnicodeString): Integer; virtual; + property HashConvert: TUnicodeStrHashConvert read GetHashConvert write SetHashConvert; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + TJclSingleAbstractContainer = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclCloneable, IJclIntfCloneable, IJclBaseContainer, IJclSingleContainer, + IJclSingleOwner, IJclSingleEqualityComparer, IJclSingleComparer, IJclSingleHashConverter) + protected + FPrecision: Single; + FEqualityCompare: TSingleEqualityCompare; + FCompare: TSingleCompare; + FHashConvert: TSingleHashConvert; + FOnFreeSingle: TFreeSingleEvent; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + { IJclSingleOwner } + function GetOnFreeSingle: TFreeSingleEvent; + function FreeSingle(var AValue: Single): Single; virtual; + procedure SetOnFreeSingle(Value: TFreeSingleEvent); + property OnFreeSingle: TFreeSingleEvent read GetOnFreeSingle write SetOnFreeSingle; + { IJclSingleContainer } + function GetPrecision: Single; virtual; + procedure SetPrecision(const Value: Single); virtual; + property Precision: Single read GetPrecision write SetPrecision; + { IJclSingleEqualityComparer } + function GetEqualityCompare: TSingleEqualityCompare; virtual; + procedure SetEqualityCompare(Value: TSingleEqualityCompare); virtual; + function ItemsEqual(const A, B: Single): Boolean; virtual; + property EqualityCompare: TSingleEqualityCompare read GetEqualityCompare write SetEqualityCompare; + { IJclSingleComparer } + function GetCompare: TSingleCompare; virtual; + procedure SetCompare(Value: TSingleCompare); virtual; + function ItemsCompare(const A, B: Single): Integer; virtual; + property Compare: TSingleCompare read GetCompare write SetCompare; + { IJclSingleHashConverter } + function GetHashConvert: TSingleHashConvert; virtual; + procedure SetHashConvert(Value: TSingleHashConvert); virtual; + function Hash(const AValue: Single): Integer; virtual; + property HashConvert: TSingleHashConvert read GetHashConvert write SetHashConvert; + end; + + TJclDoubleAbstractContainer = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclCloneable, IJclIntfCloneable, IJclBaseContainer, IJclDoubleContainer, + IJclDoubleOwner, IJclDoubleEqualityComparer, IJclDoubleComparer, IJclDoubleHashConverter) + protected + FPrecision: Double; + FEqualityCompare: TDoubleEqualityCompare; + FCompare: TDoubleCompare; + FHashConvert: TDoubleHashConvert; + FOnFreeDouble: TFreeDoubleEvent; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + { IJclDoubleOwner } + function GetOnFreeDouble: TFreeDoubleEvent; + function FreeDouble(var AValue: Double): Double; virtual; + procedure SetOnFreeDouble(Value: TFreeDoubleEvent); + property OnFreeDouble: TFreeDoubleEvent read GetOnFreeDouble write SetOnFreeDouble; + { IJclDoubleContainer } + function GetPrecision: Double; virtual; + procedure SetPrecision(const Value: Double); virtual; + property Precision: Double read GetPrecision write SetPrecision; + { IJclDoubleEqualityComparer } + function GetEqualityCompare: TDoubleEqualityCompare; virtual; + procedure SetEqualityCompare(Value: TDoubleEqualityCompare); virtual; + function ItemsEqual(const A, B: Double): Boolean; virtual; + property EqualityCompare: TDoubleEqualityCompare read GetEqualityCompare write SetEqualityCompare; + { IJclDoubleComparer } + function GetCompare: TDoubleCompare; virtual; + procedure SetCompare(Value: TDoubleCompare); virtual; + function ItemsCompare(const A, B: Double): Integer; virtual; + property Compare: TDoubleCompare read GetCompare write SetCompare; + { IJclDoubleHashConverter } + function GetHashConvert: TDoubleHashConvert; virtual; + procedure SetHashConvert(Value: TDoubleHashConvert); virtual; + function Hash(const AValue: Double): Integer; virtual; + property HashConvert: TDoubleHashConvert read GetHashConvert write SetHashConvert; + end; + + TJclExtendedAbstractContainer = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclCloneable, IJclIntfCloneable, IJclBaseContainer, IJclExtendedContainer, + IJclExtendedOwner, IJclExtendedEqualityComparer, IJclExtendedComparer, IJclExtendedHashConverter) + protected + FPrecision: Extended; + FEqualityCompare: TExtendedEqualityCompare; + FCompare: TExtendedCompare; + FHashConvert: TExtendedHashConvert; + FOnFreeExtended: TFreeExtendedEvent; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + { IJclExtendedOwner } + function GetOnFreeExtended: TFreeExtendedEvent; + function FreeExtended(var AValue: Extended): Extended; virtual; + procedure SetOnFreeExtended(Value: TFreeExtendedEvent); + property OnFreeExtended: TFreeExtendedEvent read GetOnFreeExtended write SetOnFreeExtended; + { IJclExtendedContainer } + function GetPrecision: Extended; virtual; + procedure SetPrecision(const Value: Extended); virtual; + property Precision: Extended read GetPrecision write SetPrecision; + { IJclExtendedEqualityComparer } + function GetEqualityCompare: TExtendedEqualityCompare; virtual; + procedure SetEqualityCompare(Value: TExtendedEqualityCompare); virtual; + function ItemsEqual(const A, B: Extended): Boolean; virtual; + property EqualityCompare: TExtendedEqualityCompare read GetEqualityCompare write SetEqualityCompare; + { IJclExtendedComparer } + function GetCompare: TExtendedCompare; virtual; + procedure SetCompare(Value: TExtendedCompare); virtual; + function ItemsCompare(const A, B: Extended): Integer; virtual; + property Compare: TExtendedCompare read GetCompare write SetCompare; + { IJclExtendedHashConverter } + function GetHashConvert: TExtendedHashConvert; virtual; + procedure SetHashConvert(Value: TExtendedHashConvert); virtual; + function Hash(const AValue: Extended): Integer; virtual; + property HashConvert: TExtendedHashConvert read GetHashConvert write SetHashConvert; + end; + + TJclIntegerAbstractContainer = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclCloneable, IJclIntfCloneable, IJclBaseContainer, IJclIntegerContainer, + IJclIntegerOwner, IJclIntegerEqualityComparer, IJclIntegerComparer, IJclIntegerHashConverter) + protected + FEqualityCompare: TIntegerEqualityCompare; + FCompare: TIntegerCompare; + FHashConvert: TIntegerHashConvert; + FOnFreeInteger: TFreeIntegerEvent; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + { IJclIntegerOwner } + function GetOnFreeInteger: TFreeIntegerEvent; + function FreeInteger(var AValue: Integer): Integer; virtual; + procedure SetOnFreeInteger(Value: TFreeIntegerEvent); + property OnFreeInteger: TFreeIntegerEvent read GetOnFreeInteger write SetOnFreeInteger; + { IJclIntegerEqualityComparer } + function GetEqualityCompare: TIntegerEqualityCompare; virtual; + procedure SetEqualityCompare(Value: TIntegerEqualityCompare); virtual; + function ItemsEqual(A, B: Integer): Boolean; virtual; + property EqualityCompare: TIntegerEqualityCompare read GetEqualityCompare write SetEqualityCompare; + { IJclIntegerComparer } + function GetCompare: TIntegerCompare; virtual; + procedure SetCompare(Value: TIntegerCompare); virtual; + function ItemsCompare(A, B: Integer): Integer; virtual; + property Compare: TIntegerCompare read GetCompare write SetCompare; + { IJclIntegerHashConverter } + function GetHashConvert: TIntegerHashConvert; virtual; + procedure SetHashConvert(Value: TIntegerHashConvert); virtual; + function Hash(AValue: Integer): Integer; virtual; + property HashConvert: TIntegerHashConvert read GetHashConvert write SetHashConvert; + end; + + TJclCardinalAbstractContainer = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclCloneable, IJclIntfCloneable, IJclBaseContainer, IJclCardinalContainer, + IJclCardinalOwner, IJclCardinalEqualityComparer, IJclCardinalComparer, IJclCardinalHashConverter) + protected + FEqualityCompare: TCardinalEqualityCompare; + FCompare: TCardinalCompare; + FHashConvert: TCardinalHashConvert; + FOnFreeCardinal: TFreeCardinalEvent; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + { IJclCardinalOwner } + function GetOnFreeCardinal: TFreeCardinalEvent; + function FreeCardinal(var AValue: Cardinal): Cardinal; virtual; + procedure SetOnFreeCardinal(Value: TFreeCardinalEvent); + property OnFreeCardinal: TFreeCardinalEvent read GetOnFreeCardinal write SetOnFreeCardinal; + { IJclCardinalEqualityComparer } + function GetEqualityCompare: TCardinalEqualityCompare; virtual; + procedure SetEqualityCompare(Value: TCardinalEqualityCompare); virtual; + function ItemsEqual(A, B: Cardinal): Boolean; virtual; + property EqualityCompare: TCardinalEqualityCompare read GetEqualityCompare write SetEqualityCompare; + { IJclCardinalComparer } + function GetCompare: TCardinalCompare; virtual; + procedure SetCompare(Value: TCardinalCompare); virtual; + function ItemsCompare(A, B: Cardinal): Integer; virtual; + property Compare: TCardinalCompare read GetCompare write SetCompare; + { IJclCardinalHashConverter } + function GetHashConvert: TCardinalHashConvert; virtual; + procedure SetHashConvert(Value: TCardinalHashConvert); virtual; + function Hash(AValue: Cardinal): Integer; virtual; + property HashConvert: TCardinalHashConvert read GetHashConvert write SetHashConvert; + end; + + TJclInt64AbstractContainer = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclCloneable, IJclIntfCloneable, IJclBaseContainer, IJclInt64Container, + IJclInt64Owner, IJclInt64EqualityComparer, IJclInt64Comparer, IJclInt64HashConverter) + protected + FEqualityCompare: TInt64EqualityCompare; + FCompare: TInt64Compare; + FHashConvert: TInt64HashConvert; + FOnFreeInt64: TFreeInt64Event; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + { IJclInt64Owner } + function GetOnFreeInt64: TFreeInt64Event; + function FreeInt64(var AValue: Int64): Int64; virtual; + procedure SetOnFreeInt64(Value: TFreeInt64Event); + property OnFreeInt64: TFreeInt64Event read GetOnFreeInt64 write SetOnFreeInt64; + { IJclInt64EqualityComparer } + function GetEqualityCompare: TInt64EqualityCompare; virtual; + procedure SetEqualityCompare(Value: TInt64EqualityCompare); virtual; + function ItemsEqual(const A, B: Int64): Boolean; virtual; + property EqualityCompare: TInt64EqualityCompare read GetEqualityCompare write SetEqualityCompare; + { IJclInt64Comparer } + function GetCompare: TInt64Compare; virtual; + procedure SetCompare(Value: TInt64Compare); virtual; + function ItemsCompare(const A, B: Int64): Integer; virtual; + property Compare: TInt64Compare read GetCompare write SetCompare; + { IJclInt64HashConverter } + function GetHashConvert: TInt64HashConvert; virtual; + procedure SetHashConvert(Value: TInt64HashConvert); virtual; + function Hash(const AValue: Int64): Integer; virtual; + property HashConvert: TInt64HashConvert read GetHashConvert write SetHashConvert; + end; + + TJclPtrAbstractContainer = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclCloneable, IJclIntfCloneable, IJclBaseContainer, IJclPtrContainer, + IJclPtrOwner, IJclPtrEqualityComparer, IJclPtrComparer, IJclPtrHashConverter) + protected + FEqualityCompare: TPtrEqualityCompare; + FCompare: TPtrCompare; + FHashConvert: TPtrHashConvert; + FOnFreePointer: TFreePtrEvent; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + { IJclPtrOwner } + function GetOnFreePointer: TFreePtrEvent; + function FreePointer(var APtr: Pointer): Pointer; virtual; + procedure SetOnFreePointer(Value: TFreePtrEvent); + property OnFreePointer: TFreePtrEvent read GetOnFreePointer write SetOnFreePointer; + { IJclPtrEqualityComparer } + function GetEqualityCompare: TPtrEqualityCompare; virtual; + procedure SetEqualityCompare(Value: TPtrEqualityCompare); virtual; + function ItemsEqual(A, B: Pointer): Boolean; virtual; + property EqualityCompare: TPtrEqualityCompare read GetEqualityCompare write SetEqualityCompare; + { IJclPtrComparer } + function GetCompare: TPtrCompare; virtual; + procedure SetCompare(Value: TPtrCompare); virtual; + function ItemsCompare(A, B: Pointer): Integer; virtual; + property Compare: TPtrCompare read GetCompare write SetCompare; + { IJclPtrHashConverter } + function GetHashConvert: TPtrHashConvert; virtual; + procedure SetHashConvert(Value: TPtrHashConvert); virtual; + function Hash(APtr: Pointer): Integer; virtual; + property HashConvert: TPtrHashConvert read GetHashConvert write SetHashConvert; + end; + + TJclAbstractContainer = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclCloneable, IJclIntfCloneable, IJclBaseContainer, IJclContainer, + IJclObjectOwner, IJclEqualityComparer, IJclComparer, IJclHashConverter) + protected + FOwnsObjects: Boolean; + FEqualityCompare: TEqualityCompare; + FCompare: TCompare; + FHashConvert: THashConvert; + FOnFreeObject: TFreeObjectEvent; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(AOwnsObjects: Boolean); + { IJclObjectOwner } + function GetOnFreeObject: TFreeObjectEvent; + function FreeObject(var AObject: TObject): TObject; virtual; + procedure SetOnFreeObject(Value: TFreeObjectEvent); + property OnFreeObject: TFreeObjectEvent read GetOnFreeObject write SetOnFreeObject; + function GetOwnsObjects: Boolean; virtual; + property OwnsObjects: Boolean read GetOwnsObjects; + { IJclEqualityComparer } + function GetEqualityCompare: TEqualityCompare; virtual; + procedure SetEqualityCompare(Value: TEqualityCompare); virtual; + function ItemsEqual(A, B: TObject): Boolean; virtual; + property EqualityCompare: TEqualityCompare read GetEqualityCompare write SetEqualityCompare; + { IJclComparer } + function GetCompare: TCompare; virtual; + procedure SetCompare(Value: TCompare); virtual; + function ItemsCompare(A, B: TObject): Integer; virtual; + property Compare: TCompare read GetCompare write SetCompare; + { IJclHashConverter } + function GetHashConvert: THashConvert; virtual; + procedure SetHashConvert(Value: THashConvert); virtual; + function Hash(AObject: TObject): Integer; virtual; + property HashConvert: THashConvert read GetHashConvert write SetHashConvert; + end; + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + + TJclAbstractContainer = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclCloneable, IJclIntfCloneable, IJclBaseContainer, IJclContainer, + IJclItemOwner, IJclEqualityComparer, IJclComparer, IJclHashConverter) + protected + FOwnsItems: Boolean; + FEqualityCompare: TEqualityCompare; + FCompare: TCompare; + FHashConvert: THashConvert; + FOnFreeItem: TFreeItemEvent; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(AOwnsItems: Boolean); + { IJclItemOwner } + function GetOnFreeItem: TFreeItemEvent; + function FreeItem(var AItem: T): T; virtual; + procedure SetOnFreeItem(Value: TFreeItemEvent); + property OnFreeItem: TFreeItemEvent read GetOnFreeItem write SetOnFreeItem; + function GetOwnsItems: Boolean; virtual; + property OwnsItems: Boolean read GetOwnsItems; + { IJclEqualityComparer } + function GetEqualityCompare: TEqualityCompare; virtual; + procedure SetEqualityCompare(Value: TEqualityCompare); virtual; + function ItemsEqual(const A, B: T): Boolean; virtual; + property EqualityCompare: TEqualityCompare read GetEqualityCompare write SetEqualityCompare; + { IJclComparer } + function GetCompare: TCompare; virtual; + procedure SetCompare(Value: TCompare); virtual; + function ItemsCompare(const A, B: T): Integer; virtual; + property Compare: TCompare read GetCompare write SetCompare; + { IJclHashConverter } + function GetHashConvert: THashConvert; virtual; + procedure SetHashConvert(Value: THashConvert); virtual; + function Hash(const AItem: T): Integer; virtual; + property HashConvert: THashConvert read GetHashConvert write SetHashConvert; + end; + + TJclAbstractContainerBase_PObject = ^TObject; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + TJclAnsiStrAbstractCollection = class(TJclAnsiStrAbstractContainer, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclCloneable, IJclIntfCloneable, IJclBaseContainer, + IJclStrBaseContainer, IJclAnsiStrContainer, IJclAnsiStrFlatContainer, IJclAnsiStrCollection, + IJclAnsiStrEqualityComparer, IJclAnsiStrComparer) + public + { IJclAnsiStrCollection } + function Add(const AString: AnsiString): Boolean; virtual; abstract; + function AddAll(const ACollection: IJclAnsiStrCollection): Boolean; virtual; abstract; + procedure Clear; virtual; abstract; + function Contains(const AString: AnsiString): Boolean; virtual; abstract; + function ContainsAll(const ACollection: IJclAnsiStrCollection): Boolean; virtual; abstract; + function CollectionEquals(const ACollection: IJclAnsiStrCollection): Boolean; virtual; abstract; + function Extract(const AString: AnsiString): Boolean; virtual; abstract; + function ExtractAll(const ACollection: IJclAnsiStrCollection): Boolean; virtual; abstract; + function First: IJclAnsiStrIterator; virtual; abstract; + function IsEmpty: Boolean; virtual; abstract; + function Last: IJclAnsiStrIterator; virtual; abstract; + function Remove(const AString: AnsiString): Boolean; virtual; abstract; + function RemoveAll(const ACollection: IJclAnsiStrCollection): Boolean; virtual; abstract; + function RetainAll(const ACollection: IJclAnsiStrCollection): Boolean; virtual; abstract; + function Size: Integer; virtual; abstract; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclAnsistrIterator; virtual; abstract; + {$ENDIF SUPPORTS_FOR_IN} + { IJclAnsiStrFlatContainer } + procedure LoadFromStrings(Strings: TJclAnsiStrings); + procedure SaveToStrings(Strings: TJclAnsiStrings); + procedure AppendToStrings(Strings: TJclAnsiStrings); + procedure AppendFromStrings(Strings: TJclAnsiStrings); + function GetAsStrings: TJclAnsiStrings; + function GetAsDelimited(const Separator: AnsiString = AnsiLineBreak): AnsiString; + procedure AppendDelimited(const AString: AnsiString; const Separator: AnsiString = AnsiLineBreak); + procedure LoadDelimited(const AString: AnsiString; const Separator: AnsiString = AnsiLineBreak); + end; + + TJclWideStrAbstractCollection = class(TJclWideStrAbstractContainer, + {$IFDEF THREADSAFE}IJclLockable,{$ENDIF THREADSAFE} IJclCloneable, IJclIntfCloneable, IJclBaseContainer, + IJclStrBaseContainer, IJclWideStrContainer, IJclWideStrFlatContainer, IJclWideStrCollection, + IJclWideStrEqualityComparer, IJclWideStrComparer) + public + { IJclWideStrCollection } + function Add(const AString: WideString): Boolean; virtual; abstract; + function AddAll(const ACollection: IJclWideStrCollection): Boolean; virtual; abstract; + procedure Clear; virtual; abstract; + function Contains(const AString: WideString): Boolean; virtual; abstract; + function ContainsAll(const ACollection: IJclWideStrCollection): Boolean; virtual; abstract; + function CollectionEquals(const ACollection: IJclWideStrCollection): Boolean; virtual; abstract; + function Extract(const AString: WideString): Boolean; virtual; abstract; + function ExtractAll(const ACollection: IJclWideStrCollection): Boolean; virtual; abstract; + function First: IJclWideStrIterator; virtual; abstract; + function IsEmpty: Boolean; virtual; abstract; + function Last: IJclWideStrIterator; virtual; abstract; + function Remove(const AString: WideString): Boolean; virtual; abstract; + function RemoveAll(const ACollection: IJclWideStrCollection): Boolean; virtual; abstract; + function RetainAll(const ACollection: IJclWideStrCollection): Boolean; virtual; abstract; + function Size: Integer; virtual; abstract; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclWideStrIterator; virtual; abstract; + {$ENDIF SUPPORTS_FOR_IN} + { IJclWideStrFlatContainer } + procedure LoadFromStrings(Strings: TJclWideStrings); + procedure SaveToStrings(Strings: TJclWideStrings); + procedure AppendToStrings(Strings: TJclWideStrings); + procedure AppendFromStrings(Strings: TJclWideStrings); + function GetAsStrings: TJclWideStrings; + function GetAsDelimited(const Separator: WideString = WideLineBreak): WideString; + procedure AppendDelimited(const AString: WideString; const Separator: WideString = WideLineBreak); + procedure LoadDelimited(const AString: WideString; const Separator: WideString = WideLineBreak); + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclUnicodeStrAbstractCollection = class(TJclUnicodeStrAbstractContainer, + {$IFDEF THREADSAFE}IJclLockable,{$ENDIF THREADSAFE} IJclCloneable, IJclIntfCloneable, IJclBaseContainer, + IJclStrBaseContainer, IJclUnicodeStrContainer, IJclUnicodeStrFlatContainer, IJclUnicodeStrCollection, + IJclUnicodeStrEqualityComparer, IJclUnicodeStrComparer) + public + { IJclUnicodeStrCollection } + function Add(const AString: UnicodeString): Boolean; virtual; abstract; + function AddAll(const ACollection: IJclUnicodeStrCollection): Boolean; virtual; abstract; + procedure Clear; virtual; abstract; + function Contains(const AString: UnicodeString): Boolean; virtual; abstract; + function ContainsAll(const ACollection: IJclUnicodeStrCollection): Boolean; virtual; abstract; + function CollectionEquals(const ACollection: IJclUnicodeStrCollection): Boolean; virtual; abstract; + function Extract(const AString: UnicodeString): Boolean; virtual; abstract; + function ExtractAll(const ACollection: IJclUnicodeStrCollection): Boolean; virtual; abstract; + function First: IJclUnicodeStrIterator; virtual; abstract; + function IsEmpty: Boolean; virtual; abstract; + function Last: IJclUnicodeStrIterator; virtual; abstract; + function Remove(const AString: UnicodeString): Boolean; virtual; abstract; + function RemoveAll(const ACollection: IJclUnicodeStrCollection): Boolean; virtual; abstract; + function RetainAll(const ACollection: IJclUnicodeStrCollection): Boolean; virtual; abstract; + function Size: Integer; virtual; abstract; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclUnicodeStrIterator; virtual; abstract; + {$ENDIF SUPPORTS_FOR_IN} + { IJclUnicodeStrFlatContainer } + procedure LoadFromStrings(Strings: TJclUnicodeStrings); + procedure SaveToStrings(Strings: TJclUnicodeStrings); + procedure AppendToStrings(Strings: TJclUnicodeStrings); + procedure AppendFromStrings(Strings: TJclUnicodeStrings); + function GetAsStrings: TJclUnicodeStrings; + function GetAsDelimited(const Separator: UnicodeString = WideLineBreak): UnicodeString; + procedure AppendDelimited(const AString: UnicodeString; const Separator: UnicodeString = WideLineBreak); + procedure LoadDelimited(const AString: UnicodeString; const Separator: UnicodeString = WideLineBreak); + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + +const + // table of byte permutations without inner loop + BytePermTable: array [Byte] of Byte = + ( 22, 133, 0, 244, 194, 193, 4, 164, 69, 211, 166, 235, 75, 110, 9, 140, + 125, 84, 64, 209, 57, 47, 197, 76, 237, 48, 189, 87, 221, 254, 20, 132, + 25, 162, 203, 225, 186, 165, 72, 228, 61, 208, 158, 185, 114, 173, 1, 66, + 202, 46, 198, 214, 27, 161, 178, 238, 8, 68, 97, 17, 199, 210, 96, 196, + 85, 240, 233, 71, 232, 142, 148, 70, 184, 152, 90, 206, 139, 182, 34, 101, + 104, 12, 143, 227, 24, 247, 175, 150, 39, 31, 36, 123, 62, 119, 236, 28, + 117, 100, 230, 223, 30, 154, 18, 153, 127, 192, 176, 19, 174, 134, 2, 216, + 218, 91, 45, 7, 128, 138, 126, 40, 16, 54, 207, 181, 11, 137, 60, 191, + 51, 231, 121, 213, 86, 111, 141, 172, 98, 226, 179, 249, 136, 58, 88, 93, + 201, 195, 118, 144, 146, 113, 212, 32, 21, 131, 177, 33, 151, 130, 205, 171, + 92, 251, 168, 29, 156, 124, 224, 200, 3, 187, 105, 52, 239, 147, 82, 94, + 26, 102, 243, 242, 145, 163, 49, 135, 43, 78, 112, 83, 63, 35, 170, 167, + 250, 159, 73, 37, 6, 79, 106, 215, 129, 74, 109, 42, 41, 120, 23, 160, + 107, 180, 103, 77, 53, 169, 89, 149, 44, 38, 81, 246, 188, 67, 15, 80, + 155, 99, 95, 5, 229, 108, 13, 255, 59, 241, 252, 245, 222, 248, 115, 55, + 217, 56, 65, 219, 204, 190, 10, 50, 253, 183, 234, 116, 122, 220, 14, 157); + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + {$IFDEF HAS_UNIT_ANSISTRINGS} + System.AnsiStrings, + {$ENDIF HAS_UNIT_ANSISTRINGS} + System.SysUtils, System.TypInfo, + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF HAS_UNIT_ANSISTRINGS} + AnsiStrings, + {$ENDIF HAS_UNIT_ANSISTRINGS} + SysUtils, TypInfo, + {$ENDIF ~HAS_UNITSCOPE} + JclStringConversions, JclUnicode, JclAlgorithms; + +//=== { TJclAbstractLockable } =============================================== + +{$IFDEF THREADSAFE} + +constructor TJclAbstractLockable.Create; +begin + inherited Create; + FThreadSafe := True; + FSyncReaderWriter := TJclMultiReadExclusiveWrite.Create(mpReaders); +end; + +destructor TJclAbstractLockable.Destroy; +begin + FSyncReaderWriter.Free; + inherited Destroy; +end; + +procedure TJclAbstractLockable.ReadLock; +begin + if FThreadSafe then + SyncReaderWriter.BeginRead; +end; + +procedure TJclAbstractLockable.ReadUnlock; +begin + if FThreadSafe then + SyncReaderWriter.EndRead; +end; + +procedure TJclAbstractLockable.WriteLock; +begin + if FThreadSafe then + SyncReaderWriter.BeginWrite; +end; + +procedure TJclAbstractLockable.WriteUnlock; +begin + if FThreadSafe then + SyncReaderWriter.EndWrite; +end; +{$ENDIF THREADSAFE} + +//=== { TJclAbstractContainerBase } ========================================== + +constructor TJclAbstractContainerBase.Create; +begin + inherited Create; + + FAllowDefaultElements := True; + FDuplicates := dupAccept; + FRemoveSingleElement := True; + FReturnDefaultElements := True; + FAutoGrowStrategy := agsProportional; + FAutoGrowParameter := 4; + FAutoPackStrategy := apsDisabled; + FAutoPackParameter := 4; +end; + +procedure TJclAbstractContainerBase.Assign(const Source: IJclBaseContainer); +begin + Source.AssignTo(Self); +end; + +procedure TJclAbstractContainerBase.AssignDataTo(Dest: TJclAbstractContainerBase); +begin + // override to customize + if Dest.ReadOnly then + raise EJclReadOnlyError.Create; +end; + +procedure TJclAbstractContainerBase.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + // override to customize + Dest.AllowDefaultElements := AllowDefaultElements; + Dest.Duplicates := Duplicates; + Dest.RemoveSingleElement := RemoveSingleElement; + Dest.ReturnDefaultElements := ReturnDefaultElements; + Dest.AutoGrowParameter := AutoGrowParameter; + Dest.AutoGrowStrategy := AutoGrowStrategy; + Dest.AutoPackParameter := AutoPackParameter; + Dest.AutoPackStrategy := AutoPackStrategy; +end; + +procedure TJclAbstractContainerBase.AssignTo(const Dest: IJclBaseContainer); +var + DestObject: TObject; +begin + DestObject := Dest.GetContainerReference; + if DestObject is TJclAbstractContainerBase then + begin + AssignPropertiesTo(TJclAbstractContainerBase(DestObject)); + AssignDataTo(TJclAbstractContainerBase(DestObject)); + end + else + raise EJclAssignError.Create; +end; + +procedure TJclAbstractContainerBase.AutoGrow; +begin + SetCapacity(CalcGrowCapacity(FCapacity, FSize)); +end; + +procedure TJclAbstractContainerBase.AutoPack; +begin + SetCapacity(CalcPackCapacity(FCapacity, FSize)); +end; + +function TJclAbstractContainerBase.CalcGrowCapacity(ACapacity, ASize: Integer): Integer; +var + Increment: Integer; +begin + Result := ACapacity; + if ASize = ACapacity then + begin + case FAutoGrowStrategy of + agsDisabled: ; + agsAgressive: + Result := ACapacity + 1; + agsProportional: + begin + Increment := ACapacity div FAutoGrowParameter; + if Increment = 0 then + Increment := 1; + Result := ACapacity + Increment; + end; + agsIncremental: + Result := ACapacity + FAutoGrowParameter; + end; + end; +end; + +function TJclAbstractContainerBase.CalcPackCapacity(ACapacity, ASize: Integer): Integer; +var + Decrement: Integer; +begin + Result := ACapacity; + if ASize < ACapacity then + begin + case FAutoPackStrategy of + apsDisabled: + Decrement := 0; + apsAgressive: + Decrement := 1; + apsProportional: + Decrement := ACapacity div FAutoPackParameter; + apsIncremental: + Decrement := FAutoPackParameter; + else + Decrement := 0; + end; + if (Decrement > 0) and ((ASize + Decrement) <= ACapacity) then + Result := ASize; + end; +end; + +function TJclAbstractContainerBase.CheckDuplicate: Boolean; +begin + case FDuplicates of + dupIgnore: + Result := False; + dupAccept: + Result := True; + //dupError: ; + else + raise EJclDuplicateElementError.Create; + end; +end; + +function TJclAbstractContainerBase.ObjectClone: TObject; +var + NewContainer: TJclAbstractContainerBase; +begin + {$IFDEF THREADSAFE} + ReadLock; + try + {$ENDIF THREADSAFE} + NewContainer := CreateEmptyContainer; + AssignDataTo(NewContainer); + Result := NewContainer; + {$IFDEF THREADSAFE} + finally + ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAbstractContainerBase.GetAllowDefaultElements: Boolean; +begin + Result := FAllowDefaultElements; +end; + +function TJclAbstractContainerBase.GetAutoGrowParameter: Integer; +begin + Result := FAutoGrowParameter; +end; + +function TJclAbstractContainerBase.GetAutoGrowStrategy: TJclAutoGrowStrategy; +begin + Result := FAutoGrowStrategy; +end; + +function TJclAbstractContainerBase.GetAutoPackParameter: Integer; +begin + Result := FAutoPackParameter; +end; + +function TJclAbstractContainerBase.GetAutoPackStrategy: TJclAutoPackStrategy; +begin + Result := FAutoPackStrategy; +end; + +function TJclAbstractContainerBase.GetCapacity: Integer; +begin + Result := FCapacity; +end; + +function TJclAbstractContainerBase.GetContainerReference: TObject; +begin + Result := Self; +end; + +function TJclAbstractContainerBase.GetDuplicates: TDuplicates; +begin + Result := FDuplicates; +end; + +function TJclAbstractContainerBase.GetReadOnly: Boolean; +begin + Result := FReadOnly; +end; + +function TJclAbstractContainerBase.GetRemoveSingleElement: Boolean; +begin + Result := FRemoveSingleElement; +end; + +function TJclAbstractContainerBase.GetReturnDefaultElements: Boolean; +begin + Result := FReturnDefaultElements; +end; + +function TJclAbstractContainerBase.GetThreadSafe: Boolean; +begin + {$IFDEF THREADSAFE} + Result := FThreadSafe; + {$ELSE ~THREADSAFE} + Result := False; + {$ENDIF ~THREADSAFE} +end; + +procedure TJclAbstractContainerBase.Grow; +begin + // override to customize + SetCapacity(CalcGrowCapacity(FCapacity, FSize)); +end; + +function TJclAbstractContainerBase.IntfClone: IInterface; +var + NewContainer: TJclAbstractContainerBase; +begin + {$IFDEF THREADSAFE} + ReadLock; + try + {$ENDIF THREADSAFE} + NewContainer := CreateEmptyContainer; + AssignDataTo(NewContainer); + Result := NewContainer; + {$IFDEF THREADSAFE} + finally + ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAbstractContainerBase.Pack; +begin + // override to customize + SetCapacity(CalcPackCapacity(FCapacity, FSize)); +end; + +procedure TJclAbstractContainerBase.SetAllowDefaultElements(Value: Boolean); +begin + FAllowDefaultElements := Value; +end; + +procedure TJclAbstractContainerBase.SetAutoGrowParameter(Value: Integer); +begin + FAutoGrowParameter := Value; +end; + +procedure TJclAbstractContainerBase.SetAutoGrowStrategy(Value: TJclAutoGrowStrategy); +begin + FAutoGrowStrategy := Value; +end; + +procedure TJclAbstractContainerBase.SetAutoPackParameter(Value: Integer); +begin + FAutoPackParameter := Value; +end; + +procedure TJclAbstractContainerBase.SetAutoPackStrategy(Value: TJclAutoPackStrategy); +begin + FAutoPackStrategy := Value; +end; + +procedure TJclAbstractContainerBase.SetCapacity(Value: Integer); +begin + FCapacity := Value; +end; + +procedure TJclAbstractContainerBase.SetDuplicates(Value: TDuplicates); +begin + FDuplicates := Value; +end; + +procedure TJclAbstractContainerBase.SetReadOnly(Value: Boolean); +begin + FReadOnly := Value; +end; + +procedure TJclAbstractContainerBase.SetRemoveSingleElement(Value: Boolean); +begin + FRemoveSingleElement := Value; +end; + +procedure TJclAbstractContainerBase.SetReturnDefaultElements(Value: Boolean); +begin + FReturnDefaultElements := Value; +end; + +procedure TJclAbstractContainerBase.SetThreadSafe(Value: Boolean); +begin + {$IFDEF THREADSAFE} + FThreadSafe := Value; + {$ELSE ~THREADSAFE} + if Value then + raise EJclOperationNotSupportedError.Create; + {$ENDIF ~THREADSAFE} +end; + +{$IFDEF SUPPORTS_GENERICS} +procedure TJclAbstractContainerBase.FreeAndNilIfObject(var Value: T); +{$IFNDEF RTL280_UP} +var + Info: PTypeInfo; +{$ENDIF ~RTL280_UP} +begin + {$IFDEF RTL280_UP} + if GetTypeKind(T) = tkClass then + {$ELSE ~RTL280_UP} + Info := TypeInfo(T); + if Assigned(Info) and (Info.Kind = tkClass) then + {$ENDIF ~RTL280_UP} + FreeAndNil(TJclAbstractContainerBase_PObject(@Value)^) + else + Value := Default(T); +end; +{$ENDIF SUPPORTS_GENERICS} + +//=== { TJclAbstractIterator } =============================================== + +constructor TJclAbstractIterator.Create(AValid: Boolean); +begin + inherited Create; + FValid := AValid; +end; + +procedure TJclAbstractIterator.Assign(const Source: IJclAbstractIterator); +begin + Source.AssignTo(Self); +end; + +procedure TJclAbstractIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +begin + Dest.FValid := FValid; +end; + +procedure TJclAbstractIterator.AssignTo(const Dest: IJclAbstractIterator); +var + DestObject: TObject; +begin + DestObject := Dest.GetIteratorReference; + if DestObject is TJclAbstractIterator then + AssignPropertiesTo(TJclAbstractIterator(DestObject)) + else + raise EJclAssignError.Create; +end; + +procedure TJclAbstractIterator.CheckValid; +begin + if not Valid then + raise EJclIllegalStateOperationError.Create; +end; + +function TJclAbstractIterator.ObjectClone: TObject; +begin + {$IFDEF THREADSAFE} + ReadLock; + try + {$ENDIF THREADSAFE} + Result := CreateEmptyIterator; + {$IFDEF THREADSAFE} + finally + ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAbstractIterator.GetIteratorReference: TObject; +begin + Result := Self; +end; + +function TJclAbstractIterator.IntfClone: IInterface; +begin + {$IFDEF THREADSAFE} + ReadLock; + try + {$ENDIF THREADSAFE} + Result := CreateEmptyIterator; + {$IFDEF THREADSAFE} + finally + ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclIntfAbstractContainer } ========================================== + +procedure TJclIntfAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclIntfAbstractContainer; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclIntfAbstractContainer then + begin + ADest := TJclIntfAbstractContainer(Dest); + ADest.EqualityCompare := EqualityCompare; + ADest.Compare := Compare; + ADest.HashConvert := HashConvert; + end; +end; + +function TJclIntfAbstractContainer.FreeObject(var AInterface: IInterface): IInterface; +begin + if Assigned(FOnFreeObject) then + Result := FOnFreeObject(AInterface) + else + begin + Result := AInterface; + AInterface := nil; + end; +end; + +function TJclIntfAbstractContainer.GetCompare: TIntfCompare; +begin + Result := FCompare; +end; + +function TJclIntfAbstractContainer.GetEqualityCompare: TIntfEqualityCompare; +begin + Result := FEqualityCompare; +end; + +function TJclIntfAbstractContainer.GetHashConvert: TIntfHashConvert; +begin + Result := FHashConvert; +end; + +function TJclIntfAbstractContainer.GetOnFreeObject: TFreeIntfEvent; +begin + Result := FOnFreeObject; +end; + +function TJclIntfAbstractContainer.Hash(const AInterface: IInterface): Integer; +begin + if Assigned(FHashConvert) then + Result := FHashConvert(AInterface) + else + Result := IntfSimpleHashConvert(AInterface); +end; + +function TJclIntfAbstractContainer.ItemsCompare(const A, B: IInterface): Integer; +begin + if Assigned(FCompare) then + Result := FCompare(A, B) + else + Result := IntfSimpleCompare(A, B); +end; + +function TJclIntfAbstractContainer.ItemsEqual(const A, B: IInterface): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + Result := IntfSimpleEqualityCompare(A, B); +end; + +procedure TJclIntfAbstractContainer.SetCompare(Value: TIntfCompare); +begin + FCompare := Value; +end; + +procedure TJclIntfAbstractContainer.SetEqualityCompare(Value: TIntfEqualityCompare); +begin + FEqualityCompare := Value; +end; + +procedure TJclIntfAbstractContainer.SetHashConvert(Value: TIntfHashConvert); +begin + FHashConvert := Value; +end; + +procedure TJclIntfAbstractContainer.SetOnFreeObject(Value: TFreeIntfEvent); +begin + FOnFreeObject := Value; +end; + +//=== { TJclStrAbstractContainer } =========================================== + +procedure TJclStrAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclStrAbstractContainer then + TJclStrAbstractContainer(Dest).SetCaseSensitive(GetCaseSensitive); +end; + +function TJclStrAbstractContainer.GetCaseSensitive: Boolean; +begin + Result := FCaseSensitive; +end; + +procedure TJclStrAbstractContainer.SetCaseSensitive(Value: Boolean); +begin + FCaseSensitive := Value; +end; + +//=== { TJclAnsiStrAbstractContainer } ======================================= + +procedure TJclAnsiStrAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclAnsiStrAbstractContainer; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclAnsiStrAbstractContainer then + begin + ADest := TJclAnsiStrAbstractContainer(Dest); + ADest.Encoding := Encoding; + ADest.EqualityCompare := EqualityCompare; + ADest.Compare := Compare; + ADest.HashConvert := HashConvert; + end; +end; + +function TJclAnsiStrAbstractContainer.FreeString(var AString: AnsiString): AnsiString; +begin + if Assigned(FOnFreeString) then + Result := FOnFreeString(AString) + else + begin + Result := AString; + AString := ''; + end; +end; + +function TJclAnsiStrAbstractContainer.GetCompare: TAnsiStrCompare; +begin + Result := FCompare; +end; + +function TJclAnsiStrAbstractContainer.GetEncoding: TJclAnsiStrEncoding; +begin + Result := FEncoding; +end; + +function TJclAnsiStrAbstractContainer.GetEqualityCompare: TAnsiStrEqualityCompare; +begin + Result := FEqualityCompare; +end; + +function TJclAnsiStrAbstractContainer.GetHashConvert: TAnsiStrHashConvert; +begin + Result := FHashConvert; +end; + +function TJclAnsiStrAbstractContainer.GetOnFreeString: TFreeAnsiStrEvent; +begin + Result := FOnFreeString; +end; + +function TJclAnsiStrAbstractContainer.Hash(const AString: AnsiString): Integer; +begin + if Assigned(FHashConvert) then + Result := FHashConvert(AString) + else + begin + case FEncoding of + seISO: + if FCaseSensitive then + Result := AnsiStrSimpleHashConvert(AString) + else + Result := AnsiStrSimpleHashConvertI(AString); + seUTF8: + if FCaseSensitive then + Result := AnsiStrSimpleHashConvertU(AString) + else + Result := AnsiStrSimpleHashConvertUI(AString); + else + raise EJclOperationNotSupportedError.Create; + end; + end; +end; + +function TJclAnsiStrAbstractContainer.ItemsCompare(const A, B: AnsiString): Integer; +begin + if Assigned(FCompare) then + Result := FCompare(A, B) + else + begin + case FEncoding of + seISO, seUTF8: + if FCaseSensitive then + Result := AnsiStrSimpleCompare(A, B) + else + Result := AnsiStrSimpleCompareI(A, B); + else + raise EJclOperationNotSupportedError.Create; + end; + end; +end; + +function TJclAnsiStrAbstractContainer.ItemsEqual(const A, B: AnsiString): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + begin + case FEncoding of + seISO, seUTF8: + if FCaseSensitive then + Result := AnsiStrSimpleEqualityCompare(A, B) + else + Result := AnsiStrSimpleEqualityCompareI(A, B); + else + raise EJclOperationNotSupportedError.Create; + end; + end; +end; + +procedure TJclAnsiStrAbstractContainer.SetCompare(Value: TAnsiStrCompare); +begin + FCompare := Value; +end; + +procedure TJclAnsiStrAbstractContainer.SetEncoding(Value: TJclAnsiStrEncoding); +begin + FEncoding := Value; +end; + +procedure TJclAnsiStrAbstractContainer.SetEqualityCompare(Value: TAnsiStrEqualityCompare); +begin + FEqualityCompare := Value; +end; + +procedure TJclAnsiStrAbstractContainer.SetHashConvert(Value: TAnsiStrHashConvert); +begin + FHashConvert := Value; +end; + +procedure TJclAnsiStrAbstractContainer.SetOnFreeString( + Value: TFreeAnsiStrEvent); +begin + FOnFreeString := Value; +end; + +//=== { TJclWideStrContainer } =============================================== + +procedure TJclWideStrAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclWideStrAbstractContainer; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclWideStrAbstractContainer then + begin + ADest := TJclWideStrAbstractContainer(Dest); + ADest.Encoding := Encoding; + ADest.EqualityCompare := EqualityCompare; + ADest.Compare := Compare; + ADest.HashConvert := HashConvert; + end; +end; + +function TJclWideStrAbstractContainer.FreeString(var AString: WideString): WideString; +begin + if Assigned(FOnFreeString) then + Result := FOnFreeString(AString) + else + begin + Result := AString; + AString := ''; + end; +end; + +function TJclWideStrAbstractContainer.GetCompare: TWideStrCompare; +begin + Result := FCompare; +end; + +function TJclWideStrAbstractContainer.GetEncoding: TJclWideStrEncoding; +begin + Result := FEncoding; +end; + +function TJclWideStrAbstractContainer.GetEqualityCompare: TWideStrEqualityCompare; +begin + Result := FEqualityCompare; +end; + +function TJclWideStrAbstractContainer.GetHashConvert: TWideStrHashConvert; +begin + Result := FHashConvert; +end; + +function TJclWideStrAbstractContainer.GetOnFreeString: TFreeWideStrEvent; +begin + Result := FOnFreeString; +end; + +function TJclWideStrAbstractContainer.Hash(const AString: WideString): Integer; +begin + if Assigned(FHashConvert) then + Result := FHashConvert(AString) + else + begin + case FEncoding of + seUTF16: + if FCaseSensitive then + Result := WideStrSimpleHashConvert(AString) + else + Result := WideStrSimpleHashConvertI(AString); + else + raise EJclOperationNotSupportedError.Create; + end; + end; +end; + +function TJclWideStrAbstractContainer.ItemsCompare(const A, B: WideString): Integer; +begin + if Assigned(FCompare) then + Result := FCompare(A, B) + else + begin + case FEncoding of + seUTF16: + if FCaseSensitive then + Result := WideStrSimpleCompare(A, B) + else + Result := WideStrSimpleCompareI(A, B); + else + raise EJclOperationNotSupportedError.Create; + end; + end; +end; + +function TJclWideStrAbstractContainer.ItemsEqual(const A, B: WideString): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + begin + case FEncoding of + seUTF16: + if FCaseSensitive then + Result := WideStrSimpleEqualityCompare(A, B) + else + Result := WideStrSimpleEqualityCompareI(A, B); + else + raise EJclOperationNotSupportedError.Create; + end; + end; +end; + +procedure TJclWideStrAbstractContainer.SetCompare(Value: TWideStrCompare); +begin + FCompare := Value; +end; + +procedure TJclWideStrAbstractContainer.SetEncoding(Value: TJclWideStrEncoding); +begin + FEncoding := Value; +end; + +procedure TJclWideStrAbstractContainer.SetEqualityCompare(Value: TWideStrEqualityCompare); +begin + FEqualityCompare := Value; +end; + +procedure TJclWideStrAbstractContainer.SetHashConvert(Value: TWideStrHashConvert); +begin + FHashConvert := Value; +end; + +procedure TJclWideStrAbstractContainer.SetOnFreeString( + Value: TFreeWideStrEvent); +begin + FOnFreeString := Value; +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrContainer } =============================================== + +procedure TJclUnicodeStrAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclUnicodeStrAbstractContainer; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclUnicodeStrAbstractContainer then + begin + ADest := TJclUnicodeStrAbstractContainer(Dest); + ADest.EqualityCompare := EqualityCompare; + ADest.Compare := Compare; + ADest.HashConvert := HashConvert; + end; +end; + +function TJclUnicodeStrAbstractContainer.FreeString(var AString: UnicodeString): UnicodeString; +begin + if Assigned(FOnFreeString) then + Result := FOnFreeString(AString) + else + begin + Result := AString; + AString := ''; + end; +end; + +function TJclUnicodeStrAbstractContainer.GetCompare: TUnicodeStrCompare; +begin + Result := FCompare; +end; + +function TJclUnicodeStrAbstractContainer.GetEqualityCompare: TUnicodeStrEqualityCompare; +begin + Result := FEqualityCompare; +end; + +function TJclUnicodeStrAbstractContainer.GetHashConvert: TUnicodeStrHashConvert; +begin + Result := FHashConvert; +end; + +function TJclUnicodeStrAbstractContainer.GetOnFreeString: TFreeUnicodeStrEvent; +begin + Result := FOnFreeString; +end; + +function TJclUnicodeStrAbstractContainer.Hash(const AString: UnicodeString): Integer; +begin + if Assigned(FHashConvert) then + Result := FHashConvert(AString) + else + if FCaseSensitive then + Result := UnicodeStrSimpleHashConvert(AString) + else + Result := UnicodeStrSimpleHashConvertI(AString); +end; + +function TJclUnicodeStrAbstractContainer.ItemsCompare(const A, B: UnicodeString): Integer; +begin + if Assigned(FCompare) then + Result := FCompare(A, B) + else + if FCaseSensitive then + Result := UnicodeStrSimpleCompare(A, B) + else + Result := UnicodeStrSimpleCompareI(A, B); +end; + +function TJclUnicodeStrAbstractContainer.ItemsEqual(const A, B: UnicodeString): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + if FCaseSensitive then + Result := UnicodeStrSimpleEqualityCompare(A, B) + else + Result := UnicodeStrSimpleEqualityCompareI(A, B); +end; + +procedure TJclUnicodeStrAbstractContainer.SetCompare(Value: TUnicodeStrCompare); +begin + FCompare := Value; +end; + +procedure TJclUnicodeStrAbstractContainer.SetEqualityCompare(Value: TUnicodeStrEqualityCompare); +begin + FEqualityCompare := Value; +end; + +procedure TJclUnicodeStrAbstractContainer.SetHashConvert(Value: TUnicodeStrHashConvert); +begin + FHashConvert := Value; +end; + +procedure TJclUnicodeStrAbstractContainer.SetOnFreeString(Value: TFreeUnicodeStrEvent); +begin + FOnFreeString := Value; +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +//=== { TJclSingleAbstractContainer } ======================================== + +procedure TJclSingleAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclSingleAbstractContainer; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclSingleAbstractContainer then + begin + ADest := TJclSingleAbstractContainer(Dest); + ADest.Precision := Precision; + ADest.EqualityCompare := EqualityCompare; + ADest.Compare := Compare; + ADest.HashConvert := HashConvert; + end; +end; + +function TJclSingleAbstractContainer.FreeSingle(var AValue: Single): Single; +begin + if Assigned(FOnFreeSingle) then + Result := FOnFreeSingle(AValue) + else + begin + Result := AValue; + AValue := 0.0; + end; +end; + +function TJclSingleAbstractContainer.GetCompare: TSingleCompare; +begin + Result := FCompare; +end; + +function TJclSingleAbstractContainer.GetEqualityCompare: TSingleEqualityCompare; +begin + Result := FEqualityCompare; +end; + +function TJclSingleAbstractContainer.GetHashConvert: TSingleHashConvert; +begin + Result := FHashConvert; +end; + +function TJclSingleAbstractContainer.GetOnFreeSingle: TFreeSingleEvent; +begin + Result := FOnFreeSingle; +end; + +function TJclSingleAbstractContainer.GetPrecision: Single; +begin + Result := FPrecision; +end; + +function TJclSingleAbstractContainer.Hash(const AValue: Single): Integer; +begin + if Assigned(FHashConvert) then + Result := FHashConvert(AValue) + else + Result := SingleSimpleHashConvert(AValue); +end; + +function TJclSingleAbstractContainer.ItemsCompare(const A, B: Single): Integer; +begin + if Assigned(FCompare) then + Result := FCompare(A, B) + else + if Abs(A - B) <= FPrecision then + Result := 0 + else + if A > B then + Result := 1 + else + Result := -1; +end; + +function TJclSingleAbstractContainer.ItemsEqual(const A, B: Single): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + Result := Abs(A - B) <= FPrecision; +end; + +procedure TJclSingleAbstractContainer.SetCompare(Value: TSingleCompare); +begin + FCompare := Value; +end; + +procedure TJclSingleAbstractContainer.SetEqualityCompare(Value: TSingleEqualityCompare); +begin + FEqualityCompare := Value; +end; + +procedure TJclSingleAbstractContainer.SetHashConvert(Value: TSingleHashConvert); +begin + FHashConvert := Value; +end; + +procedure TJclSingleAbstractContainer.SetOnFreeSingle(Value: TFreeSingleEvent); +begin + FOnFreeSingle := Value; +end; + +procedure TJclSingleAbstractContainer.SetPrecision(const Value: Single); +begin + FPrecision := Value; +end; + +//=== { TJclDoubleAbstractContainer } ======================================== + +procedure TJclDoubleAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclDoubleAbstractContainer; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclDoubleAbstractContainer then + begin + ADest := TJclDoubleAbstractContainer(Dest); + ADest.Precision := Precision; + ADest.Compare := Compare; + ADest.EqualityCompare := EqualityCompare; + ADest.HashConvert := HashConvert; + end; +end; + +function TJclDoubleAbstractContainer.FreeDouble(var AValue: Double): Double; +begin + if Assigned(FOnFreeDouble) then + Result := FOnFreeDouble(AValue) + else + begin + Result := AValue; + AValue := 0.0; + end; +end; + +function TJclDoubleAbstractContainer.GetCompare: TDoubleCompare; +begin + Result := FCompare; +end; + +function TJclDoubleAbstractContainer.GetEqualityCompare: TDoubleEqualityCompare; +begin + Result := FEqualityCompare; +end; + +function TJclDoubleAbstractContainer.GetHashConvert: TDoubleHashConvert; +begin + Result := FHashConvert; +end; + +function TJclDoubleAbstractContainer.GetOnFreeDouble: TFreeDoubleEvent; +begin + Result := FOnFreeDouble; +end; + +function TJclDoubleAbstractContainer.GetPrecision: Double; +begin + Result := FPrecision; +end; + +function TJclDoubleAbstractContainer.Hash(const AValue: Double): Integer; +begin + if Assigned(FHashConvert) then + Result := FHashConvert(AValue) + else + Result := DoubleSimpleHashConvert(AValue); +end; + +function TJclDoubleAbstractContainer.ItemsCompare(const A, B: Double): Integer; +begin + if Assigned(FCompare) then + Result := FCompare(A, B) + else + if Abs(A - B) <= FPrecision then + Result := 0 + else + if A > B then + Result := 1 + else + Result := -1; +end; + +function TJclDoubleAbstractContainer.ItemsEqual(const A, B: Double): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + Result := Abs(A - B) <= FPrecision; +end; + +procedure TJclDoubleAbstractContainer.SetCompare(Value: TDoubleCompare); +begin + FCompare := Value; +end; + +procedure TJclDoubleAbstractContainer.SetEqualityCompare(Value: TDoubleEqualityCompare); +begin + FEqualityCompare := Value; +end; + +procedure TJclDoubleAbstractContainer.SetHashConvert(Value: TDoubleHashConvert); +begin + FHashConvert := Value; +end; + +procedure TJclDoubleAbstractContainer.SetOnFreeDouble(Value: TFreeDoubleEvent); +begin + FOnFreeDouble := Value; +end; + +procedure TJclDoubleAbstractContainer.SetPrecision(const Value: Double); +begin + FPrecision := Value; +end; + +//=== { TJclExtendedAbstractContainer } ====================================== + +procedure TJclExtendedAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclExtendedAbstractContainer; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclExtendedAbstractContainer then + begin + ADest := TJclExtendedAbstractContainer(Dest); + ADest.Precision := Precision; + ADest.EqualityCompare := EqualityCompare; + ADest.Compare := Compare; + ADest.HashConvert := HashConvert; + end; +end; + +function TJclExtendedAbstractContainer.FreeExtended(var AValue: Extended): Extended; +begin + if Assigned(FOnFreeExtended) then + Result := FOnFreeExtended(AValue) + else + begin + Result := AValue; + AValue := 0.0; + end; +end; + +function TJclExtendedAbstractContainer.GetCompare: TExtendedCompare; +begin + Result := FCompare; +end; + +function TJclExtendedAbstractContainer.GetEqualityCompare: TExtendedEqualityCompare; +begin + Result := FEqualityCompare; +end; + +function TJclExtendedAbstractContainer.GetHashConvert: TExtendedHashConvert; +begin + Result := FHashConvert; +end; + +function TJclExtendedAbstractContainer.GetOnFreeExtended: TFreeExtendedEvent; +begin + Result := FOnFreeExtended; +end; + +function TJclExtendedAbstractContainer.GetPrecision: Extended; +begin + Result := FPrecision; +end; + +function TJclExtendedAbstractContainer.Hash(const AValue: Extended): Integer; +begin + if Assigned(FHashConvert) then + Result := FHashConvert(AValue) + else + Result := ExtendedSimpleHashConvert(AValue); +end; + +function TJclExtendedAbstractContainer.ItemsCompare(const A, B: Extended): Integer; +begin + if Assigned(FCompare) then + Result := FCompare(A, B) + else + if Abs(A - B) <= FPrecision then + Result := 0 + else + if A > B then + Result := 1 + else + Result := -1; +end; + +function TJclExtendedAbstractContainer.ItemsEqual(const A, B: Extended): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + Result := Abs(A - B) <= FPrecision; +end; + +procedure TJclExtendedAbstractContainer.SetCompare(Value: TExtendedCompare); +begin + FCompare := Value; +end; + +procedure TJclExtendedAbstractContainer.SetEqualityCompare(Value: TExtendedEqualityCompare); +begin + FEqualityCompare := Value; +end; + +procedure TJclExtendedAbstractContainer.SetHashConvert(Value: TExtendedHashConvert); +begin + FHashConvert := Value; +end; + +procedure TJclExtendedAbstractContainer.SetOnFreeExtended( + Value: TFreeExtendedEvent); +begin + FOnFreeExtended := Value; +end; + +procedure TJclExtendedAbstractContainer.SetPrecision(const Value: Extended); +begin + FPrecision := Value; +end; + +//=== { TJclIntegerAbstractContainer } ======================================= + +procedure TJclIntegerAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclIntegerAbstractContainer; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclIntegerAbstractContainer then + begin + ADest := TJclIntegerAbstractContainer(Dest); + ADest.EqualityCompare := EqualityCompare; + ADest.Compare := Compare; + ADest.HashConvert := HashConvert; + end; +end; + +function TJclIntegerAbstractContainer.FreeInteger(var AValue: Integer): Integer; +begin + if Assigned(FOnFreeInteger) then + Result := FOnFreeInteger(AValue) + else + begin + Result := AValue; + AValue := 0; + end; +end; + +function TJclIntegerAbstractContainer.GetCompare: TIntegerCompare; +begin + Result := FCompare; +end; + +function TJclIntegerAbstractContainer.GetEqualityCompare: TIntegerEqualityCompare; +begin + Result := FEqualityCompare; +end; + +function TJclIntegerAbstractContainer.GetHashConvert: TIntegerHashConvert; +begin + Result := FHashConvert; +end; + +function TJclIntegerAbstractContainer.GetOnFreeInteger: TFreeIntegerEvent; +begin + Result := FOnFreeInteger; +end; + +function TJclIntegerAbstractContainer.Hash(AValue: Integer): Integer; +begin + if Assigned(FHashConvert) then + Result := FHashConvert(AValue) + else + Result := IntegerSimpleHashConvert(AValue); +end; + +function TJclIntegerAbstractContainer.ItemsCompare(A, B: Integer): Integer; +begin + if Assigned(FCompare) then + Result := FCompare(A, B) + else + Result := IntegerSimpleCompare(A, B); +end; + +function TJclIntegerAbstractContainer.ItemsEqual(A, B: Integer): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + Result := IntegerSimpleEqualityCompare(A, B); +end; + +procedure TJclIntegerAbstractContainer.SetCompare(Value: TIntegerCompare); +begin + FCompare := Value; +end; + +procedure TJclIntegerAbstractContainer.SetEqualityCompare(Value: TIntegerEqualityCompare); +begin + FEqualityCompare := Value; +end; + +procedure TJclIntegerAbstractContainer.SetHashConvert(Value: TIntegerHashConvert); +begin + FHashConvert := Value; +end; + +procedure TJclIntegerAbstractContainer.SetOnFreeInteger( + Value: TFreeIntegerEvent); +begin + FOnFreeInteger := Value; +end; + +//=== { TJclCardinalAbstractContainer } ====================================== + +procedure TJclCardinalAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclCardinalAbstractContainer; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclCardinalAbstractContainer then + begin + ADest := TJclCardinalAbstractContainer(Dest); + ADest.EqualityCompare := EqualityCompare; + ADest.Compare := Compare; + ADest.HashConvert := HashConvert; + end; +end; + +function TJclCardinalAbstractContainer.FreeCardinal(var AValue: Cardinal): Cardinal; +begin + if Assigned(FOnFreeCardinal) then + Result := FOnFreeCardinal(AValue) + else + begin + Result := AValue; + AValue := 0; + end; +end; + +function TJclCardinalAbstractContainer.GetCompare: TCardinalCompare; +begin + Result := FCompare; +end; + +function TJclCardinalAbstractContainer.GetEqualityCompare: TCardinalEqualityCompare; +begin + Result := FEqualityCompare; +end; + +function TJclCardinalAbstractContainer.GetHashConvert: TCardinalHashConvert; +begin + Result := FHashConvert; +end; + +function TJclCardinalAbstractContainer.GetOnFreeCardinal: TFreeCardinalEvent; +begin + Result := FOnFreeCardinal; +end; + +function TJclCardinalAbstractContainer.Hash(AValue: Cardinal): Integer; +begin + if Assigned(FHashConvert) then + Result := FHashConvert(AValue) + else + Result := CardinalSimpleHashConvert(AValue); +end; + +function TJclCardinalAbstractContainer.ItemsCompare(A, B: Cardinal): Integer; +begin + if Assigned(FCompare) then + Result := FCompare(A, B) + else + Result := CardinalSimpleCompare(A, B); +end; + +function TJclCardinalAbstractContainer.ItemsEqual(A, B: Cardinal): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + Result := CardinalSimpleEqualityCompare(A, B); +end; + +procedure TJclCardinalAbstractContainer.SetCompare(Value: TCardinalCompare); +begin + FCompare := Value; +end; + +procedure TJclCardinalAbstractContainer.SetEqualityCompare(Value: TCardinalEqualityCompare); +begin + FEqualityCompare := Value; +end; + +procedure TJclCardinalAbstractContainer.SetHashConvert(Value: TCardinalHashConvert); +begin + FHashConvert := Value; +end; + +procedure TJclCardinalAbstractContainer.SetOnFreeCardinal( + Value: TFreeCardinalEvent); +begin + FOnFreeCardinal := Value; +end; + +//=== { TJclInt64AbstractContainer } ========================================= + +procedure TJclInt64AbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclInt64AbstractContainer; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclInt64AbstractContainer then + begin + ADest := TJclInt64AbstractContainer(Dest); + ADest.EqualityCompare := EqualityCompare; + ADest.Compare := Compare; + ADest.HashConvert := HashConvert; + end; +end; + +function TJclInt64AbstractContainer.FreeInt64(var AValue: Int64): Int64; +begin + if Assigned(FOnFreeInt64) then + Result := FOnFreeInt64(AValue) + else + begin + Result := AValue; + AValue := 0; + end; +end; + +function TJclInt64AbstractContainer.GetCompare: TInt64Compare; +begin + Result := FCompare; +end; + +function TJclInt64AbstractContainer.GetEqualityCompare: TInt64EqualityCompare; +begin + Result := FEqualityCompare; +end; + +function TJclInt64AbstractContainer.GetHashConvert: TInt64HashConvert; +begin + Result := FHashConvert; +end; + +function TJclInt64AbstractContainer.GetOnFreeInt64: TFreeInt64Event; +begin + Result := FOnFreeInt64; +end; + +function TJclInt64AbstractContainer.Hash(const AValue: Int64): Integer; +begin + if Assigned(FHashConvert) then + Result := FHashConvert(AValue) + else + Result := Int64SimpleHashConvert(AValue); +end; + +function TJclInt64AbstractContainer.ItemsCompare(const A, B: Int64): Integer; +begin + if Assigned(FCompare) then + Result := FCompare(A, B) + else + Result := Int64SimpleCompare(A, B); +end; + +function TJclInt64AbstractContainer.ItemsEqual(const A, B: Int64): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + Result := Int64SimpleEqualityCompare(A, B); +end; + +procedure TJclInt64AbstractContainer.SetCompare(Value: TInt64Compare); +begin + FCompare := Value; +end; + +procedure TJclInt64AbstractContainer.SetEqualityCompare(Value: TInt64EqualityCompare); +begin + FEqualityCompare := Value; +end; + +procedure TJclInt64AbstractContainer.SetHashConvert(Value: TInt64HashConvert); +begin + FHashConvert := Value; +end; + +procedure TJclInt64AbstractContainer.SetOnFreeInt64(Value: TFreeInt64Event); +begin + FOnFreeInt64 := Value; +end; + +//=== { TJclPtrAbstractContainer } =========================================== + +procedure TJclPtrAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclPtrAbstractContainer; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclPtrAbstractContainer then + begin + ADest := TJclPtrAbstractContainer(Dest); + ADest.EqualityCompare := EqualityCompare; + ADest.Compare := Compare; + ADest.HashConvert := HashConvert; + end; +end; + +function TJclPtrAbstractContainer.FreePointer(var APtr: Pointer): Pointer; +begin + if Assigned(FOnFreePointer) then + Result := FOnFreePointer(APtr) + else + begin + Result := APtr; + APtr := nil; + end; +end; + +function TJclPtrAbstractContainer.GetCompare: TPtrCompare; +begin + Result := FCompare; +end; + +function TJclPtrAbstractContainer.GetEqualityCompare: TPtrEqualityCompare; +begin + Result := FEqualityCompare; +end; + +function TJclPtrAbstractContainer.GetHashConvert: TPtrHashConvert; +begin + Result := FHashConvert; +end; + +function TJclPtrAbstractContainer.GetOnFreePointer: TFreePtrEvent; +begin + Result := FOnFreePointer; +end; + +function TJclPtrAbstractContainer.Hash(APtr: Pointer): Integer; +begin + if Assigned(FHashConvert) then + Result := FHashConvert(APtr) + else + Result := PtrSimpleHashConvert(APtr); +end; + +function TJclPtrAbstractContainer.ItemsCompare(A, B: Pointer): Integer; +begin + if Assigned(FCompare) then + Result := FCompare(A, B) + else + Result := PtrSimpleCompare(A, B); +end; + +function TJclPtrAbstractContainer.ItemsEqual(A, B: Pointer): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + Result := PtrSimpleEqualityCompare(A, B); +end; +procedure TJclPtrAbstractContainer.SetCompare(Value: TPtrCompare); +begin + FCompare := Value; +end; + +procedure TJclPtrAbstractContainer.SetEqualityCompare(Value: TPtrEqualityCompare); +begin + FEqualityCompare := Value; +end; + +procedure TJclPtrAbstractContainer.SetHashConvert(Value: TPtrHashConvert); +begin + FHashConvert := Value; +end; + +procedure TJclPtrAbstractContainer.SetOnFreePointer(Value: TFreePtrEvent); +begin + FOnFreePointer := Value; +end; + +//=== { TJclAbstractContainer } ============================================== + +constructor TJclAbstractContainer.Create(AOwnsObjects: Boolean); +begin + inherited Create; + FOwnsObjects := AOwnsObjects; +end; + +procedure TJclAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclAbstractContainer; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclAbstractContainer then + begin + ADest := TJclAbstractContainer(Dest); + ADest.EqualityCompare := EqualityCompare; + ADest.Compare := Compare; + ADest.HashConvert := HashConvert; + end; +end; + +function TJclAbstractContainer.FreeObject(var AObject: TObject): TObject; +begin + if Assigned(FOnFreeObject) then + Result := FOnFreeObject(AObject) + else + if FOwnsObjects then + begin + Result := nil; + FreeAndNil(AObject); + end + else + begin + Result := AObject; + AObject := nil; + end; +end; + +function TJclAbstractContainer.GetCompare: TCompare; +begin + Result := FCompare; +end; + +function TJclAbstractContainer.GetEqualityCompare: TEqualityCompare; +begin + Result := FEqualityCompare; +end; + +function TJclAbstractContainer.GetHashConvert: THashConvert; +begin + Result := FHashConvert; +end; + +function TJclAbstractContainer.GetOnFreeObject: TFreeObjectEvent; +begin + Result := FOnFreeObject; +end; + +function TJclAbstractContainer.GetOwnsObjects: Boolean; +begin + Result := FOwnsObjects; +end; + +function TJclAbstractContainer.Hash(AObject: TObject): Integer; +begin + if Assigned(FHashConvert) then + Result := FHashConvert(AObject) + else + Result := SimpleHashConvert(AObject); +end; + +function TJclAbstractContainer.ItemsCompare(A, B: TObject): Integer; +begin + if Assigned(FCompare) then + Result := FCompare(A, B) + else + Result := SimpleCompare(A, B); +end; + +function TJclAbstractContainer.ItemsEqual(A, B: TObject): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + Result := SimpleEqualityCompare(A, B); +end; + +procedure TJclAbstractContainer.SetCompare(Value: TCompare); +begin + FCompare := Value; +end; + +procedure TJclAbstractContainer.SetEqualityCompare(Value: TEqualityCompare); +begin + FEqualityCompare := Value; +end; + +procedure TJclAbstractContainer.SetHashConvert(Value: THashConvert); +begin + FHashConvert := Value; +end; + +procedure TJclAbstractContainer.SetOnFreeObject(Value: TFreeObjectEvent); +begin + FOnFreeObject := Value; +end; + +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +//=== { TJclAbstractContainer } =========================================== + +constructor TJclAbstractContainer.Create(AOwnsItems: Boolean); +begin + inherited Create; + FOwnsItems := AOwnsItems; +end; + +procedure TJclAbstractContainer.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclAbstractContainer; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclAbstractContainer then + begin + ADest := TJclAbstractContainer(Dest); + ADest.EqualityCompare := EqualityCompare; + ADest.Compare := Compare; + ADest.HashConvert := HashConvert; + end; +end; + +function TJclAbstractContainer.FreeItem(var AItem: T): T; +begin + if Assigned(FOnFreeItem) then + Result := FOnFreeItem(AItem) + else + if FOwnsItems then + begin + Result := Default(T); + FreeAndNilIfObject(AItem); + end + else + begin + Result := AItem; + AItem := Default(T); + end; +end; + +function TJclAbstractContainer.GetCompare: TCompare; +begin + Result := FCompare; +end; + +function TJclAbstractContainer.GetEqualityCompare: TEqualityCompare; +begin + Result := FEqualityCompare; +end; + +function TJclAbstractContainer.GetHashConvert: THashConvert; +begin + Result := FHashConvert; +end; + +function TJclAbstractContainer.GetOnFreeItem: TFreeItemEvent; +begin + Result := FOnFreeItem; +end; + +function TJclAbstractContainer.GetOwnsItems: Boolean; +begin + Result := FOwnsItems; +end; + +function TJclAbstractContainer.Hash(const AItem: T): Integer; +begin + if Assigned(FHashConvert) then + Result := FHashConvert(AItem) + else + raise EJclOperationNotSupportedError.Create; +end; + +function TJclAbstractContainer.ItemsCompare(const A, B: T): Integer; +begin + if Assigned(FCompare) then + Result := FCompare(A, B) + else + raise EJclOperationNotSupportedError.Create; +end; + +function TJclAbstractContainer.ItemsEqual(const A, B: T): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclAbstractContainer.SetCompare(Value: TCompare); +begin + FCompare := Value; +end; + +procedure TJclAbstractContainer.SetEqualityCompare(Value: TEqualityCompare); +begin + FEqualityCompare := Value; +end; + +procedure TJclAbstractContainer.SetHashConvert(Value: THashConvert); +begin + FHashConvert := Value; +end; + +procedure TJclAbstractContainer.SetOnFreeItem(Value: TFreeItemEvent); +begin + FOnFreeItem := Value; +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +//=== { TJclAnsiStrAbstractCollection } ====================================== + +// TODO: common implementation, need a function to search for a string starting from +// a predefined index +procedure TJclAnsiStrAbstractCollection.AppendDelimited(const AString, Separator: AnsiString); +var + Item: AnsiString; + SepLen: Integer; + PString, PSep, PPos: PAnsiChar; +begin + PString := PAnsiChar(AString); + PSep := PAnsiChar(Separator); + PPos := StrPosA(PString, PSep); + if PPos <> nil then + begin + SepLen := StrLenA(PSep); + repeat + //SetLength(Item, PPos - PString + 1); + SetLength(Item, PPos - PString); + Move(PString^, Item[1], (PPos - PString) * SizeOf(AnsiChar)); + //Item[PPos - PString + 1] := #0; + Add(Item); + PString := PPos + SepLen; + PPos := StrPosA(PString, PSep); + until PPos = nil; + if StrLenA(PString) > 0 then //ex. hello#world + Add(PString); + end + else //There isnt a Separator in AString + Add(AString); +end; + +procedure TJclAnsiStrAbstractCollection.AppendFromStrings(Strings: TJclAnsiStrings); +var + I: Integer; +begin + for I := 0 to Strings.Count - 1 do + Add(Strings[I]); +end; + +procedure TJclAnsiStrAbstractCollection.AppendToStrings(Strings: TJclAnsiStrings); +var + It: IJclAnsiStrIterator; +begin + It := First; + Strings.BeginUpdate; + try + while It.HasNext do + Strings.Add(It.Next); + finally + Strings.EndUpdate; + end; +end; + +function TJclAnsiStrAbstractCollection.GetAsDelimited(const Separator: AnsiString): AnsiString; +var + It: IJclAnsiStrIterator; +begin + It := First; + Result := ''; + if It.HasNext then + Result := It.Next; + while It.HasNext do + Result := Result + Separator + It.Next; +end; + +function TJclAnsiStrAbstractCollection.GetAsStrings: TJclAnsiStrings; +begin + Result := TJclAnsiStringList.Create; + try + AppendToStrings(Result); + except + Result.Free; + raise; + end; +end; + +procedure TJclAnsiStrAbstractCollection.LoadDelimited(const AString, Separator: AnsiString); +begin + Clear; + AppendDelimited(AString, Separator); +end; + +procedure TJclAnsiStrAbstractCollection.LoadFromStrings(Strings: TJclAnsiStrings); +begin + Clear; + AppendFromStrings(Strings); +end; + +procedure TJclAnsiStrAbstractCollection.SaveToStrings(Strings: TJclAnsiStrings); +begin + Strings.Clear; + AppendToStrings(Strings); +end; + +//=== { TJclWideStrAbstractCollection } ====================================== + +// TODO: common implementation, need a function to search for a string starting from +// a predefined index +procedure TJclWideStrAbstractCollection.AppendDelimited(const AString, Separator: WideString); +var + Item: WideString; + SepLen: Integer; + PString, PSep, PPos: PWideChar; +begin + PString := PWideChar(AString); + PSep := PWideChar(Separator); + PPos := StrPosW(PString, PSep); + if PPos <> nil then + begin + SepLen := StrLenW(PSep); + repeat + //SetLength(Item, PPos - PString + 1); + SetLength(Item, PPos - PString); + Move(PString^, Item[1], (PPos - PString) * SizeOf(WideChar)); + //Item[PPos - PString + 1] := #0; + Add(Item); + PString := PPos + SepLen; + PPos := StrPosW(PString, PSep); + until PPos = nil; + if StrLenW(PString) > 0 then //ex. hello#world + Add(PString); + end + else //There isnt a Separator in AString + Add(AString); +end; + +procedure TJclWideStrAbstractCollection.AppendFromStrings(Strings: TJclWideStrings); +var + I: Integer; +begin + for I := 0 to Strings.Count - 1 do + Add(Strings[I]); +end; + +procedure TJclWideStrAbstractCollection.AppendToStrings(Strings: TJclWideStrings); +var + It: IJclWideStrIterator; +begin + It := First; + Strings.BeginUpdate; + try + while It.HasNext do + Strings.Add(It.Next); + finally + Strings.EndUpdate; + end; +end; + +function TJclWideStrAbstractCollection.GetAsDelimited(const Separator: WideString): WideString; +var + It: IJclWideStrIterator; +begin + It := First; + Result := ''; + if It.HasNext then + Result := It.Next; + while It.HasNext do + Result := Result + Separator + It.Next; +end; + +function TJclWideStrAbstractCollection.GetAsStrings: TJclWideStrings; +begin + Result := TJclWideStringList.Create; + try + AppendToStrings(Result); + except + Result.Free; + raise; + end; +end; + +procedure TJclWideStrAbstractCollection.LoadDelimited(const AString, Separator: WideString); +begin + Clear; + AppendDelimited(AString, Separator); +end; + +procedure TJclWideStrAbstractCollection.LoadFromStrings(Strings: TJclWideStrings); +begin + Clear; + AppendFromStrings(Strings); +end; + +procedure TJclWideStrAbstractCollection.SaveToStrings(Strings: TJclWideStrings); +begin + Strings.Clear; + AppendToStrings(Strings); +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrAbstractCollection } =================================== + +// TODO: common implementation, need a function to search for a string starting from +// a predefined index +procedure TJclUnicodeStrAbstractCollection.AppendDelimited(const AString, Separator: UnicodeString); +var + Item: UnicodeString; + SepLen: Integer; + PString, PSep, PPos: PWideChar; +begin + PString := PWideChar(AString); + PSep := PWideChar(Separator); + PPos := StrPos(PString, PSep); + if PPos <> nil then + begin + SepLen := StrLen(PSep); + repeat + //SetLength(Item, PPos - PString + 1); + SetLength(Item, PPos - PString); + Move(PString^, Item[1], (PPos - PString) * SizeOf(WideChar)); + //Item[PPos - PString + 1] := #0; + Add(Item); + PString := PPos + SepLen; + PPos := StrPos(PString, PSep); + until PPos = nil; + if StrLen(PString) > 0 then //ex. hello#world + Add(PString); + end + else //There isnt a Separator in AString + Add(AString); +end; + +procedure TJclUnicodeStrAbstractCollection.AppendFromStrings(Strings: TJclUnicodeStrings); +var + I: Integer; +begin + for I := 0 to Strings.Count - 1 do + Add(Strings[I]); +end; + +procedure TJclUnicodeStrAbstractCollection.AppendToStrings(Strings: TJclUnicodeStrings); +var + It: IJclUnicodeStrIterator; +begin + It := First; + Strings.BeginUpdate; + try + while It.HasNext do + Strings.Add(It.Next); + finally + Strings.EndUpdate; + end; +end; + +function TJclUnicodeStrAbstractCollection.GetAsDelimited(const Separator: UnicodeString): UnicodeString; +var + It: IJclUnicodeStrIterator; +begin + It := First; + Result := ''; + if It.HasNext then + Result := It.Next; + while It.HasNext do + Result := Result + Separator + It.Next; +end; + +function TJclUnicodeStrAbstractCollection.GetAsStrings: TJclUnicodeStrings; +begin + Result := TJclUnicodeStringList.Create; + try + AppendToStrings(Result); + except + Result.Free; + raise; + end; +end; + +procedure TJclUnicodeStrAbstractCollection.LoadDelimited(const AString, Separator: UnicodeString); +begin + Clear; + AppendDelimited(AString, Separator); +end; + +procedure TJclUnicodeStrAbstractCollection.LoadFromStrings(Strings: TJclUnicodeStrings); +begin + Clear; + AppendFromStrings(Strings); +end; + +procedure TJclUnicodeStrAbstractCollection.SaveToStrings(Strings: TJclUnicodeStrings); +begin + Strings.Clear; + AppendToStrings(Strings); +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclAlgorithms.pas b/3rdParty/JCL/source/common/JclAlgorithms.pas new file mode 100644 index 00000000..d192b8df --- /dev/null +++ b/3rdParty/JCL/source/common/JclAlgorithms.pas @@ -0,0 +1,4331 @@ +{**************************************************************************************************} +{ WARNING: JEDI preprocessor generated unit. Do not edit. } +{**************************************************************************************************} + +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is Algorithms.pas. } +{ } +{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } +{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } +{ All rights reserved. } +{ } +{ Contributors: } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclAlgorithms; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclBase, JclContainerIntf; + +// Compare functions +function IntfSimpleCompare(const Obj1, Obj2: IInterface): Integer; +function AnsiStrSimpleCompare(const Obj1, Obj2: AnsiString): Integer; +function WideStrSimpleCompare(const Obj1, Obj2: WideString): Integer; +{$IFDEF SUPPORTS_UNICODE_STRING} +function UnicodeStrSimpleCompare(const Obj1, Obj2: UnicodeString): Integer; +{$ENDIF SUPPORTS_UNICODE_STRING} +function StrSimpleCompare(const Obj1, Obj2: string): Integer; +function SingleSimpleCompare(const Obj1, Obj2: Single): Integer; +function DoubleSimpleCompare(const Obj1, Obj2: Double): Integer; +function ExtendedSimpleCompare(const Obj1, Obj2: Extended): Integer; +function FloatSimpleCompare(const Obj1, Obj2: Float): Integer; +function IntegerSimpleCompare(Obj1, Obj2: Integer): Integer; +function CardinalSimpleCompare(Obj1, Obj2: Cardinal): Integer; +function Int64SimpleCompare(const Obj1, Obj2: Int64): Integer; +function PtrSimpleCompare(Obj1, Obj2: Pointer): Integer; +function SimpleCompare(Obj1, Obj2: TObject): Integer; + +function IntegerCompare(Obj1, Obj2: TObject): Integer; + +function AnsiStrSimpleCompareI(const Obj1, Obj2: AnsiString): Integer; +function WideStrSimpleCompareI(const Obj1, Obj2: WideString): Integer; +{$IFDEF SUPPORTS_UNICODE_STRING} +function UnicodeStrSimpleCompareI(const Obj1, Obj2: UnicodeString): Integer; +{$ENDIF SUPPORTS_UNICODE_STRING} +function StrSimpleCompareI(const Obj1, Obj2: string): Integer; + +// Compare functions for equality +function IntfSimpleEqualityCompare(const Obj1, Obj2: IInterface): Boolean; +function AnsiStrSimpleEqualityCompare(const Obj1, Obj2: AnsiString): Boolean; +function WideStrSimpleEqualityCompare(const Obj1, Obj2: WideString): Boolean; +{$IFDEF SUPPORTS_UNICODE_STRING} +function UnicodeStrSimpleEqualityCompare(const Obj1, Obj2: UnicodeString): Boolean; +{$ENDIF SUPPORTS_UNICODE_STRING} +function StrSimpleEqualityCompare(const Obj1, Obj2: string): Boolean; +function SingleSimpleEqualityCompare(const Obj1, Obj2: Single): Boolean; +function DoubleSimpleEqualityCompare(const Obj1, Obj2: Double): Boolean; +function ExtendedSimpleEqualityCompare(const Obj1, Obj2: Extended): Boolean; +function FloatSimpleEqualityCompare(const Obj1, Obj2: Float): Boolean; +function IntegerSimpleEqualityCompare(Obj1, Obj2: Integer): Boolean; +function CardinalSimpleEqualityCompare(Obj1, Obj2: Cardinal): Boolean; +function Int64SimpleEqualityCompare(const Obj1, Obj2: Int64): Boolean; +function PtrSimpleEqualityCompare(Obj1, Obj2: Pointer): Boolean; +function SimpleEqualityCompare(Obj1, Obj2: TObject): Boolean; + +function AnsiStrSimpleEqualityCompareI(const Obj1, Obj2: AnsiString): Boolean; +function WideStrSimpleEqualityCompareI(const Obj1, Obj2: WideString): Boolean; +{$IFDEF SUPPORTS_UNICODE_STRING} +function UnicodeStrSimpleEqualityCompareI(const Obj1, Obj2: UnicodeString): Boolean; +{$ENDIF SUPPORTS_UNICODE_STRING} +function StrSimpleEqualityCompareI(const Obj1, Obj2: string): Boolean; + +// Hash conversion functions +function IntfSimpleHashConvert(const AInterface: IInterface): Integer; +function AnsiStrSimpleHashConvert(const AString: AnsiString): Integer; +function WideStrSimpleHashConvert(const AString: WideString): Integer; +{$IFDEF SUPPORTS_UNICODE_STRING} +function UnicodeStrSimpleHashConvert(const AString: UnicodeString): Integer; +{$ENDIF SUPPORTS_UNICODE_STRING} +function StrSimpleHashConvert(const AString: string): Integer; +function SingleSimpleHashConvert(const AValue: Single): Integer; +function DoubleSimpleHashConvert(const AValue: Double): Integer; +function ExtendedSimpleHashConvert(const AValue: Extended): Integer; +function FloatSimpleHashConvert(const AValue: Float): Integer; +function IntegerSimpleHashConvert(AValue: Integer): Integer; +function CardinalSimpleHashConvert(AValue: Cardinal): Integer; +function Int64SimpleHashConvert(const AValue: Int64): Integer; +function PtrSimpleHashConvert(APtr: Pointer): Integer; +function SimpleHashConvert(AObject: TObject): Integer; + +function AnsiStrSimpleHashConvertI(const AString: AnsiString): Integer; +function AnsiStrSimpleHashConvertU(const AString: AnsiString): Integer; +function AnsiStrSimpleHashConvertUI(const AString: AnsiString): Integer; +function WideStrSimpleHashConvertI(const AString: WideString): Integer; +{$IFDEF SUPPORTS_UNICODE_STRING} +function UnicodeStrSimpleHashConvertI(const AString: UnicodeString): Integer; +{$ENDIF SUPPORTS_UNICODE_STRING} +function StrSimpleHashConvertI(const AString: string): Integer; + +type + // Hash Function + // Result must be in 0..Range-1 + TJclHashToRangeFunction = function(Key, Range: Integer): Integer; + +function JclSimpleHashToRange(Key, Range: Integer): Integer; + +// move array algorithms +procedure FinalizeArrayBeforeMove(var List: TDynIInterfaceArray; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure InitializeArray(var List: TDynIInterfaceArray; FromIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure InitializeArrayAfterMove(var List: TDynIInterfaceArray; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + +procedure MoveArray(var List: TDynIInterfaceArray; FromIndex, ToIndex, Count: SizeInt); overload; +procedure FinalizeArrayBeforeMove(var List: TDynAnsiStringArray; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure InitializeArray(var List: TDynAnsiStringArray; FromIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure InitializeArrayAfterMove(var List: TDynAnsiStringArray; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + +procedure MoveArray(var List: TDynAnsiStringArray; FromIndex, ToIndex, Count: SizeInt); overload; +procedure FinalizeArrayBeforeMove(var List: TDynWideStringArray; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure InitializeArray(var List: TDynWideStringArray; FromIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure InitializeArrayAfterMove(var List: TDynWideStringArray; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + +procedure MoveArray(var List: TDynWideStringArray; FromIndex, ToIndex, Count: SizeInt); overload; +{$IFDEF SUPPORTS_UNICODE_STRING} + +procedure FinalizeArrayBeforeMove(var List: TDynUnicodeStringArray; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure InitializeArray(var List: TDynUnicodeStringArray; FromIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure InitializeArrayAfterMove(var List: TDynUnicodeStringArray; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + +procedure MoveArray(var List: TDynUnicodeStringArray; FromIndex, ToIndex, Count: SizeInt); overload; +{$ENDIF SUPPORTS_UNICODE_STRING} +procedure InitializeArrayAfterMove(var List: TDynSingleArray; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure MoveArray(var List: TDynSingleArray; FromIndex, ToIndex, Count: SizeInt); overload; +procedure InitializeArrayAfterMove(var List: TDynDoubleArray; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure MoveArray(var List: TDynDoubleArray; FromIndex, ToIndex, Count: SizeInt); overload; +procedure InitializeArrayAfterMove(var List: TDynExtendedArray; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure MoveArray(var List: TDynExtendedArray; FromIndex, ToIndex, Count: SizeInt); overload; +procedure InitializeArrayAfterMove(var List: TDynIntegerArray; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure MoveArray(var List: TDynIntegerArray; FromIndex, ToIndex, Count: SizeInt); overload; +procedure InitializeArrayAfterMove(var List: TDynCardinalArray; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure MoveArray(var List: TDynCardinalArray; FromIndex, ToIndex, Count: SizeInt); overload; +procedure InitializeArrayAfterMove(var List: TDynInt64Array; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure MoveArray(var List: TDynInt64Array; FromIndex, ToIndex, Count: SizeInt); overload; +procedure InitializeArrayAfterMove(var List: TDynPointerArray; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure MoveArray(var List: TDynPointerArray; FromIndex, ToIndex, Count: SizeInt); overload; +procedure InitializeArrayAfterMove(var List: TDynObjectArray; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure MoveArray(var List: TDynObjectArray; FromIndex, ToIndex, Count: SizeInt); overload; + +{$IFDEF GENERIC} +procedure MoveArray(var List: TDynSizeIntArray; FromIndex, ToIndex, Count: SizeInt); overload; +{$ELSE ~GENERIC} +{$IFDEF REFCOUNTED} +procedure FinalizeArrayBeforeMove(var List: TDynSizeIntArray; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure InitializeArray(var List: TDynSizeIntArray; FromIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure InitializeArrayAfterMove(var List: TDynSizeIntArray; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +{$ELSE ~REFCOUNTED} +{$IFDEF ZEROINIT} +procedure InitializeArrayAfterMove(var List: TDynSizeIntArray; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +{$ENDIF ZEROINIT} +{$ENDIF ~REFCOUNTED} +procedure MoveArray(var List: TDynSizeIntArray; FromIndex, ToIndex, Count: SizeInt); overload;{$ENDIF ~GENERIC} +{$IFNDEF FPC} +{$IFDEF GENERIC} +procedure MoveArray(var List: TDynStringArray; FromIndex, ToIndex, Count: SizeInt); overload; +{$ELSE ~GENERIC} +{$IFDEF REFCOUNTED} +procedure FinalizeArrayBeforeMove(var List: TDynStringArray; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure InitializeArray(var List: TDynStringArray; FromIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure InitializeArrayAfterMove(var List: TDynStringArray; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +{$ELSE ~REFCOUNTED} +{$IFDEF ZEROINIT} +procedure InitializeArrayAfterMove(var List: TDynStringArray; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +{$ENDIF ZEROINIT} +{$ENDIF ~REFCOUNTED} +procedure MoveArray(var List: TDynStringArray; FromIndex, ToIndex, Count: SizeInt); overload;{$ENDIF ~GENERIC} +{$IFDEF GENERIC} +procedure MoveArray(var List: TDynFloatArray; FromIndex, ToIndex, Count: SizeInt); overload; +{$ELSE ~GENERIC} +{$IFDEF REFCOUNTED} +procedure FinalizeArrayBeforeMove(var List: TDynFloatArray; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure InitializeArray(var List: TDynFloatArray; FromIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure InitializeArrayAfterMove(var List: TDynFloatArray; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +{$ELSE ~REFCOUNTED} +{$IFDEF ZEROINIT} +procedure InitializeArrayAfterMove(var List: TDynFloatArray; FromIndex, ToIndex, Count: SizeInt); overload; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +{$ENDIF ZEROINIT} +{$ENDIF ~REFCOUNTED} +procedure MoveArray(var List: TDynFloatArray; FromIndex, ToIndex, Count: SizeInt); overload;{$ENDIF ~GENERIC} +{$ENDIF ~FPC} + +// Iterate algorithms +procedure Iterate(const First: IJclIntfIterator; Count: Integer; F: TIntfIterateProcedure); overload; +procedure Iterate(const First: IJclAnsiStrIterator; Count: Integer; F: TAnsiStrIterateProcedure); overload; +procedure Iterate(const First: IJclWideStrIterator; Count: Integer; F: TWideStrIterateProcedure); overload; +{$IFDEF SUPPORTS_UNICODE_STRING} +procedure Iterate(const First: IJclUnicodeStrIterator; Count: Integer; F: TUnicodeStrIterateProcedure); overload; +{$ENDIF SUPPORTS_UNICODE_STRING} +procedure Iterate(const First: IJclSingleIterator; Count: Integer; F: TSingleIterateProcedure); overload; +procedure Iterate(const First: IJclDoubleIterator; Count: Integer; F: TDoubleIterateProcedure); overload; +procedure Iterate(const First: IJclExtendedIterator; Count: Integer; F: TExtendedIterateProcedure); overload; +procedure Iterate(const First: IJclIntegerIterator; Count: Integer; F: TIntegerIterateProcedure); overload; +procedure Iterate(const First: IJclCardinalIterator; Count: Integer; F: TCardinalIterateProcedure); overload; +procedure Iterate(const First: IJclInt64Iterator; Count: Integer; F: TInt64IterateProcedure); overload; +procedure Iterate(const First: IJclPtrIterator; Count: Integer; F: TPtrIterateProcedure); overload; +procedure Iterate(const First: IJclIterator; Count: Integer; F: TIterateProcedure); overload; + + +// Apply algorithms +procedure Apply(const First: IJclIntfIterator; Count: Integer; F: TIntfApplyFunction); overload; +procedure Apply(const First: IJclAnsiStrIterator; Count: Integer; F: TAnsiStrApplyFunction); overload; +procedure Apply(const First: IJclWideStrIterator; Count: Integer; F: TWideStrApplyFunction); overload; +{$IFDEF SUPPORTS_UNICODE_STRING} +procedure Apply(const First: IJclUnicodeStrIterator; Count: Integer; F: TUnicodeStrApplyFunction); overload; +{$ENDIF SUPPORTS_UNICODE_STRING} +procedure Apply(const First: IJclSingleIterator; Count: Integer; F: TSingleApplyFunction); overload; +procedure Apply(const First: IJclDoubleIterator; Count: Integer; F: TDoubleApplyFunction); overload; +procedure Apply(const First: IJclExtendedIterator; Count: Integer; F: TExtendedApplyFunction); overload; +procedure Apply(const First: IJclIntegerIterator; Count: Integer; F: TIntegerApplyFunction); overload; +procedure Apply(const First: IJclCardinalIterator; Count: Integer; F: TCardinalApplyFunction); overload; +procedure Apply(const First: IJclInt64Iterator; Count: Integer; F: TInt64ApplyFunction); overload; +procedure Apply(const First: IJclPtrIterator; Count: Integer; F: TPtrApplyFunction); overload; +procedure Apply(const First: IJclIterator; Count: Integer; F: TApplyFunction); overload; + + +// Find algorithms +function Find(const First: IJclIntfIterator; Count: Integer; const AInterface: IInterface; + AComparator: TIntfCompare): IJclIntfIterator; overload; +function Find(const First: IJclIntfIterator; Count: Integer; const AInterface: IInterface; + AEqualityComparator: TIntfEqualityCompare): IJclIntfIterator; overload; +function Find(const First: IJclAnsiStrIterator; Count: Integer; const AString: AnsiString; + AComparator: TAnsiStrCompare): IJclAnsiStrIterator; overload; +function Find(const First: IJclAnsiStrIterator; Count: Integer; const AString: AnsiString; + AEqualityComparator: TAnsiStrEqualityCompare): IJclAnsiStrIterator; overload; +function Find(const First: IJclWideStrIterator; Count: Integer; const AString: WideString; + AComparator: TWideStrCompare): IJclWideStrIterator; overload; +function Find(const First: IJclWideStrIterator; Count: Integer; const AString: WideString; + AEqualityComparator: TWideStrEqualityCompare): IJclWideStrIterator; overload; +{$IFDEF SUPPORTS_UNICODE_STRING} +function Find(const First: IJclUnicodeStrIterator; Count: Integer; const AString: UnicodeString; + AComparator: TUnicodeStrCompare): IJclUnicodeStrIterator; overload; +{$ENDIF SUPPORTS_UNICODE_STRING} +{$IFDEF SUPPORTS_UNICODE_STRING} +function Find(const First: IJclUnicodeStrIterator; Count: Integer; const AString: UnicodeString; + AEqualityComparator: TUnicodeStrEqualityCompare): IJclUnicodeStrIterator; overload; +{$ENDIF SUPPORTS_UNICODE_STRING} +function Find(const First: IJclSingleIterator; Count: Integer; const AValue: Single; + AComparator: TSingleCompare): IJclSingleIterator; overload; +function Find(const First: IJclSingleIterator; Count: Integer; const AValue: Single; + AEqualityComparator: TSingleEqualityCompare): IJclSingleIterator; overload; +function Find(const First: IJclDoubleIterator; Count: Integer; const AValue: Double; + AComparator: TDoubleCompare): IJclDoubleIterator; overload; +function Find(const First: IJclDoubleIterator; Count: Integer; const AValue: Double; + AEqualityComparator: TDoubleEqualityCompare): IJclDoubleIterator; overload; +function Find(const First: IJclExtendedIterator; Count: Integer; const AValue: Extended; + AComparator: TExtendedCompare): IJclExtendedIterator; overload; +function Find(const First: IJclExtendedIterator; Count: Integer; const AValue: Extended; + AEqualityComparator: TExtendedEqualityCompare): IJclExtendedIterator; overload; +function Find(const First: IJclIntegerIterator; Count: Integer; AValue: Integer; + AComparator: TIntegerCompare): IJclIntegerIterator; overload; +function Find(const First: IJclIntegerIterator; Count: Integer; AValue: Integer; + AEqualityComparator: TIntegerEqualityCompare): IJclIntegerIterator; overload; +function Find(const First: IJclCardinalIterator; Count: Integer; AValue: Cardinal; + AComparator: TCardinalCompare): IJclCardinalIterator; overload; +function Find(const First: IJclCardinalIterator; Count: Integer; AValue: Cardinal; + AEqualityComparator: TCardinalEqualityCompare): IJclCardinalIterator; overload; +function Find(const First: IJclInt64Iterator; Count: Integer; const AValue: Int64; + AComparator: TInt64Compare): IJclInt64Iterator; overload; +function Find(const First: IJclInt64Iterator; Count: Integer; const AValue: Int64; + AEqualityComparator: TInt64EqualityCompare): IJclInt64Iterator; overload; +function Find(const First: IJclPtrIterator; Count: Integer; APtr: Pointer; + AComparator: TPtrCompare): IJclPtrIterator; overload; +function Find(const First: IJclPtrIterator; Count: Integer; APtr: Pointer; + AEqualityComparator: TPtrEqualityCompare): IJclPtrIterator; overload; +function Find(const First: IJclIterator; Count: Integer; AObject: TObject; + AComparator: TCompare): IJclIterator; overload; +function Find(const First: IJclIterator; Count: Integer; AObject: TObject; + AEqualityComparator: TEqualityCompare): IJclIterator; overload; + + +// CountObject algorithms +function CountObject(const First: IJclIntfIterator; Count: Integer; + const AInterface: IInterface; AComparator: TIntfCompare): Integer; overload; +function CountObject(const First: IJclIntfIterator; Count: Integer; + const AInterface: IInterface; AEqualityComparator: TIntfEqualityCompare): Integer; overload; +function CountObject(const First: IJclAnsiStrIterator; Count: Integer; + const AString: AnsiString; AComparator: TAnsiStrCompare): Integer; overload; +function CountObject(const First: IJclAnsiStrIterator; Count: Integer; + const AString: AnsiString; AEqualityComparator: TAnsiStrEqualityCompare): Integer; overload; +function CountObject(const First: IJclWideStrIterator; Count: Integer; + const AString: WideString; AComparator: TWideStrCompare): Integer; overload; +function CountObject(const First: IJclWideStrIterator; Count: Integer; + const AString: WideString; AEqualityComparator: TWideStrEqualityCompare): Integer; overload; +{$IFDEF SUPPORTS_UNICODE_STRING} +function CountObject(const First: IJclUnicodeStrIterator; Count: Integer; + const AString: UnicodeString; AComparator: TUnicodeStrCompare): Integer; overload; +{$ENDIF SUPPORTS_UNICODE_STRING} +{$IFDEF SUPPORTS_UNICODE_STRING} +function CountObject(const First: IJclUnicodeStrIterator; Count: Integer; + const AString: UnicodeString; AEqualityComparator: TUnicodeStrEqualityCompare): Integer; overload; +{$ENDIF SUPPORTS_UNICODE_STRING} +function CountObject(const First: IJclSingleIterator; Count: Integer; + const AValue: Single; AComparator: TSingleCompare): Integer; overload; +function CountObject(const First: IJclSingleIterator; Count: Integer; + const AValue: Single; AEqualityComparator: TSingleEqualityCompare): Integer; overload; +function CountObject(const First: IJclDoubleIterator; Count: Integer; + const AValue: Double; AComparator: TDoubleCompare): Integer; overload; +function CountObject(const First: IJclDoubleIterator; Count: Integer; + const AValue: Double; AEqualityComparator: TDoubleEqualityCompare): Integer; overload; +function CountObject(const First: IJclExtendedIterator; Count: Integer; + const AValue: Extended; AComparator: TExtendedCompare): Integer; overload; +function CountObject(const First: IJclExtendedIterator; Count: Integer; + const AValue: Extended; AEqualityComparator: TExtendedEqualityCompare): Integer; overload; +function CountObject(const First: IJclIntegerIterator; Count: Integer; + AValue: Integer; AComparator: TIntegerCompare): Integer; overload; +function CountObject(const First: IJclIntegerIterator; Count: Integer; + AValue: Integer; AEqualityComparator: TIntegerEqualityCompare): Integer; overload; +function CountObject(const First: IJclCardinalIterator; Count: Integer; + AValue: Cardinal; AComparator: TCardinalCompare): Integer; overload; +function CountObject(const First: IJclCardinalIterator; Count: Integer; + AValue: Cardinal; AEqualityComparator: TCardinalEqualityCompare): Integer; overload; +function CountObject(const First: IJclInt64Iterator; Count: Integer; + const AValue: Int64; AComparator: TInt64Compare): Integer; overload; +function CountObject(const First: IJclInt64Iterator; Count: Integer; + const AValue: Int64; AEqualityComparator: TInt64EqualityCompare): Integer; overload; +function CountObject(const First: IJclPtrIterator; Count: Integer; + APtr: Pointer; AComparator: TPtrCompare): Integer; overload; +function CountObject(const First: IJclPtrIterator; Count: Integer; + APtr: Pointer; AEqualityComparator: TPtrEqualityCompare): Integer; overload; +function CountObject(const First: IJclIterator; Count: Integer; + AObject: TObject; AComparator: TCompare): Integer; overload; +function CountObject(const First: IJclIterator; Count: Integer; + AObject: TObject; AEqualityComparator: TEqualityCompare): Integer; overload; + + +// Copy algorithms +procedure Copy(const First: IJclIntfIterator; Count: Integer; + const Output: IJclIntfIterator); overload; +procedure Copy(const First: IJclAnsiStrIterator; Count: Integer; + const Output: IJclAnsiStrIterator); overload; +procedure Copy(const First: IJclWideStrIterator; Count: Integer; + const Output: IJclWideStrIterator); overload; +{$IFDEF SUPPORTS_UNICODE_STRING} +procedure Copy(const First: IJclUnicodeStrIterator; Count: Integer; + const Output: IJclUnicodeStrIterator); overload; +{$ENDIF SUPPORTS_UNICODE_STRING} +procedure Copy(const First: IJclSingleIterator; Count: Integer; + const Output: IJclSingleIterator); overload; +procedure Copy(const First: IJclDoubleIterator; Count: Integer; + const Output: IJclDoubleIterator); overload; +procedure Copy(const First: IJclExtendedIterator; Count: Integer; + const Output: IJclExtendedIterator); overload; +procedure Copy(const First: IJclIntegerIterator; Count: Integer; + const Output: IJclIntegerIterator); overload; +procedure Copy(const First: IJclCardinalIterator; Count: Integer; + const Output: IJclCardinalIterator); overload; +procedure Copy(const First: IJclInt64Iterator; Count: Integer; + const Output: IJclInt64Iterator); overload; +procedure Copy(const First: IJclPtrIterator; Count: Integer; + const Output: IJclPtrIterator); overload; +procedure Copy(const First: IJclIterator; Count: Integer; + const Output: IJclIterator); overload; + + +// Generate algorithms +procedure Generate(const List: IJclIntfList; Count: Integer; const AInterface: IInterface); overload; +procedure Generate(const List: IJclAnsiStrList; Count: Integer; const AString: AnsiString); overload; +procedure Generate(const List: IJclWideStrList; Count: Integer; const AString: WideString); overload; +{$IFDEF SUPPORTS_UNICODE_STRING} +procedure Generate(const List: IJclUnicodeStrList; Count: Integer; const AString: UnicodeString); overload; +{$ENDIF SUPPORTS_UNICODE_STRING} +procedure Generate(const List: IJclSingleList; Count: Integer; const AValue: Single); overload; +procedure Generate(const List: IJclDoubleList; Count: Integer; const AValue: Double); overload; +procedure Generate(const List: IJclExtendedList; Count: Integer; const AValue: Extended); overload; +procedure Generate(const List: IJclIntegerList; Count: Integer; AValue: Integer); overload; +procedure Generate(const List: IJclCardinalList; Count: Integer; AValue: Cardinal); overload; +procedure Generate(const List: IJclInt64List; Count: Integer; const AValue: Int64); overload; +procedure Generate(const List: IJclPtrList; Count: Integer; APtr: Pointer); overload; +procedure Generate(const List: IJclList; Count: Integer; AObject: TObject); overload; + + +// Fill algorithms +procedure Fill(const First: IJclIntfIterator; Count: Integer; const AInterface: IInterface); overload; +procedure Fill(const First: IJclAnsiStrIterator; Count: Integer; const AString: AnsiString); overload; +procedure Fill(const First: IJclWideStrIterator; Count: Integer; const AString: WideString); overload; +{$IFDEF SUPPORTS_UNICODE_STRING} +procedure Fill(const First: IJclUnicodeStrIterator; Count: Integer; const AString: UnicodeString); overload; +{$ENDIF SUPPORTS_UNICODE_STRING} +procedure Fill(const First: IJclSingleIterator; Count: Integer; const AValue: Single); overload; +procedure Fill(const First: IJclDoubleIterator; Count: Integer; const AValue: Double); overload; +procedure Fill(const First: IJclExtendedIterator; Count: Integer; const AValue: Extended); overload; +procedure Fill(const First: IJclIntegerIterator; Count: Integer; AValue: Integer); overload; +procedure Fill(const First: IJclCardinalIterator; Count: Integer; AValue: Cardinal); overload; +procedure Fill(const First: IJclInt64Iterator; Count: Integer; const AValue: Int64); overload; +procedure Fill(const First: IJclPtrIterator; Count: Integer; APtr: Pointer); overload; +procedure Fill(const First: IJclIterator; Count: Integer; AObject: TObject); overload; + + +// Reverse algorithms +procedure Reverse(const First, Last: IJclIntfIterator); overload; +procedure Reverse(const First, Last: IJclAnsiStrIterator); overload; +procedure Reverse(const First, Last: IJclWideStrIterator); overload; +{$IFDEF SUPPORTS_UNICODE_STRING} +procedure Reverse(const First, Last: IJclUnicodeStrIterator); overload; +{$ENDIF SUPPORTS_UNICODE_STRING} +procedure Reverse(const First, Last: IJclSingleIterator); overload; +procedure Reverse(const First, Last: IJclDoubleIterator); overload; +procedure Reverse(const First, Last: IJclExtendedIterator); overload; +procedure Reverse(const First, Last: IJclIntegerIterator); overload; +procedure Reverse(const First, Last: IJclCardinalIterator); overload; +procedure Reverse(const First, Last: IJclInt64Iterator); overload; +procedure Reverse(const First, Last: IJclPtrIterator); overload; +procedure Reverse(const First, Last: IJclIterator); overload; + + +procedure QuickSort(const AList: IJclIntfList; L, R: Integer; AComparator: TIntfCompare); overload; +procedure QuickSort(const AList: IJclAnsiStrList; L, R: Integer; AComparator: TAnsiStrCompare); overload; +procedure QuickSort(const AList: IJclWideStrList; L, R: Integer; AComparator: TWideStrCompare); overload; +{$IFDEF SUPPORTS_UNICODE_STRING} +procedure QuickSort(const AList: IJclUnicodeStrList; L, R: Integer; AComparator: TUnicodeStrCompare); overload; +{$ENDIF SUPPORTS_UNICODE_STRING} +procedure QuickSort(const AList: IJclSingleList; L, R: Integer; AComparator: TSingleCompare); overload; +procedure QuickSort(const AList: IJclDoubleList; L, R: Integer; AComparator: TDoubleCompare); overload; +procedure QuickSort(const AList: IJclExtendedList; L, R: Integer; AComparator: TExtendedCompare); overload; +procedure QuickSort(const AList: IJclIntegerList; L, R: Integer; AComparator: TIntegerCompare); overload; +procedure QuickSort(const AList: IJclCardinalList; L, R: Integer; AComparator: TCardinalCompare); overload; +procedure QuickSort(const AList: IJclInt64List; L, R: Integer; AComparator: TInt64Compare); overload; +procedure QuickSort(const AList: IJclPtrList; L, R: Integer; AComparator: TPtrCompare); overload; +procedure QuickSort(const AList: IJclList; L, R: Integer; AComparator: TCompare); overload; + + +var + IntfSortProc: TIntfSortProc = QuickSort; + AnsiStrSortProc: TAnsiStrSortProc = QuickSort; + WideStrSortProc: TWideStrSortProc = QuickSort; + {$IFDEF SUPPORTS_UNICODE_STRING} + UnicodeStrSortProc: TUnicodeStrSortProc = QuickSort; + {$ENDIF SUPPORTS_UNICODE_STRING} + SingleSortProc: TSingleSortProc = QuickSort; + DoubleSortProc: TDoubleSortProc = QuickSort; + ExtendedSortProc: TExtendedSortProc = QuickSort; + IntegerSortProc: TIntegerSortProc = QuickSort; + CardinalSortProc: TCardinalSortProc = QuickSort; + Int64SortProc: TInt64SortProc = QuickSort; + PtrSortProc: TPtrSortProc = QuickSort; + SortProc: TSortProc = QuickSort; + +// Sort algorithms +procedure Sort(const AList: IJclIntfList; First, Last: Integer; AComparator: TIntfCompare); overload; +procedure Sort(const AList: IJclAnsiStrList; First, Last: Integer; AComparator: TAnsiStrCompare); overload; +procedure Sort(const AList: IJclWideStrList; First, Last: Integer; AComparator: TWideStrCompare); overload; +{$IFDEF SUPPORTS_UNICODE_STRING} +procedure Sort(const AList: IJclUnicodeStrList; First, Last: Integer; AComparator: TUnicodeStrCompare); overload; +{$ENDIF SUPPORTS_UNICODE_STRING} +procedure Sort(const AList: IJclSingleList; First, Last: Integer; AComparator: TSingleCompare); overload; +procedure Sort(const AList: IJclDoubleList; First, Last: Integer; AComparator: TDoubleCompare); overload; +procedure Sort(const AList: IJclExtendedList; First, Last: Integer; AComparator: TExtendedCompare); overload; +procedure Sort(const AList: IJclIntegerList; First, Last: Integer; AComparator: TIntegerCompare); overload; +procedure Sort(const AList: IJclCardinalList; First, Last: Integer; AComparator: TCardinalCompare); overload; +procedure Sort(const AList: IJclInt64List; First, Last: Integer; AComparator: TInt64Compare); overload; +procedure Sort(const AList: IJclPtrList; First, Last: Integer; AComparator: TPtrCompare); overload; +procedure Sort(const AList: IJclList; First, Last: Integer; AComparator: TCompare); overload; + + +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +type + // cannot implement generic global functions + TJclAlgorithms = class + private + //FSortProc: TSortProc; + public + class procedure Iterate(const First: IJclIterator; Count: Integer; F: TIterateProcedure); + class procedure Apply(const First: IJclIterator; Count: Integer; F: TApplyFunction); + class function Find(const First: IJclIterator; Count: Integer; const AItem: T; + AComparator: TCompare): IJclIterator; overload; + class function Find(const First: IJclIterator; Count: Integer; const AItem: T; + AEqualityComparator: TEqualityCompare): IJclIterator; overload; + class function CountObject(const First: IJclIterator; Count: Integer; + const AItem: T; AComparator: TCompare): Integer; overload; + class function CountObject(const First: IJclIterator; Count: Integer; + const AItem: T; AEqualityComparator: TEqualityCompare): Integer; overload; + class procedure Copy(const First: IJclIterator; Count: Integer; + const Output: IJclIterator); + class procedure Generate(const List: IJclList; Count: Integer; const AItem: T); + class procedure Fill(const First: IJclIterator; Count: Integer; const AItem: T); + class procedure Reverse(const First, Last: IJclIterator); + class procedure QuickSort(const AList: IJclList; L, R: Integer; AComparator: TCompare); + class procedure Sort(const AList: IJclList; First, Last: Integer; AComparator: TCompare); + //class property SortProc: TSortProc read FSortProc write FSortProc; + end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +const + // table of byte permutations without inner loop + BytePermTable: array [Byte] of Byte = + ( 22, 133, 0, 244, 194, 193, 4, 164, 69, 211, 166, 235, 75, 110, 9, 140, + 125, 84, 64, 209, 57, 47, 197, 76, 237, 48, 189, 87, 221, 254, 20, 132, + 25, 162, 203, 225, 186, 165, 72, 228, 61, 208, 158, 185, 114, 173, 1, 66, + 202, 46, 198, 214, 27, 161, 178, 238, 8, 68, 97, 17, 199, 210, 96, 196, + 85, 240, 233, 71, 232, 142, 148, 70, 184, 152, 90, 206, 139, 182, 34, 101, + 104, 12, 143, 227, 24, 247, 175, 150, 39, 31, 36, 123, 62, 119, 236, 28, + 117, 100, 230, 223, 30, 154, 18, 153, 127, 192, 176, 19, 174, 134, 2, 216, + 218, 91, 45, 7, 128, 138, 126, 40, 16, 54, 207, 181, 11, 137, 60, 191, + 51, 231, 121, 213, 86, 111, 141, 172, 98, 226, 179, 249, 136, 58, 88, 93, + 201, 195, 118, 144, 146, 113, 212, 32, 21, 131, 177, 33, 151, 130, 205, 171, + 92, 251, 168, 29, 156, 124, 224, 200, 3, 187, 105, 52, 239, 147, 82, 94, + 26, 102, 243, 242, 145, 163, 49, 135, 43, 78, 112, 83, 63, 35, 170, 167, + 250, 159, 73, 37, 6, 79, 106, 215, 129, 74, 109, 42, 41, 120, 23, 160, + 107, 180, 103, 77, 53, 169, 89, 149, 44, 38, 81, 246, 188, 67, 15, 80, + 155, 99, 95, 5, 229, 108, 13, 255, 59, 241, 252, 245, 222, 248, 115, 55, + 217, 56, 65, 219, 204, 190, 10, 50, 253, 183, 234, 116, 122, 220, 14, 157); + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + {$IFDEF COMPILER11_UP} + Winapi.Windows, + {$ENDIF COMPILER11_UP} + {$IFDEF HAS_UNIT_ANSISTRINGS} + System.AnsiStrings, + {$ENDIF HAS_UNIT_ANSISTRINGS} + {$IFDEF UNICODE_RTL_DATABASE} + System.Character, + {$ENDIF UNICODE_RTL_DATABASE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF COMPILER11_UP} + Windows, + {$ENDIF COMPILER11_UP} + {$IFDEF HAS_UNIT_ANSISTRINGS} + AnsiStrings, + {$ENDIF HAS_UNIT_ANSISTRINGS} + {$IFDEF UNICODE_RTL_DATABASE} + Character, + {$ENDIF UNICODE_RTL_DATABASE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclAnsiStrings, JclStringConversions, JclUnicode; + +function IntfSimpleCompare(const Obj1, Obj2: IInterface): Integer; +begin + if SizeInt(Obj1) < SizeInt(Obj2) then + Result := -1 + else + if SizeInt(Obj1) > SizeInt(Obj2) then + Result := 1 + else + Result := 0; +end; + +// default is case-sensitive +function AnsiStrSimpleCompare(const Obj1, Obj2: AnsiString): Integer; +begin + Result := CompareStr(Obj1, Obj2); +end; + +// case-insensitive +function AnsiStrSimpleCompareI(const Obj1, Obj2: AnsiString): Integer; +begin + Result := CompareText(Obj1, Obj2); +end; + +// default is case-sensitive +function WideStrSimpleCompare(const Obj1, Obj2: WideString): Integer; +begin + Result := WideCompareStr(Obj1, Obj2); +end; + +// case-insensitive +function WideStrSimpleCompareI(const Obj1, Obj2: WideString): Integer; +begin + Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.WideCompareText(Obj1, Obj2); +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +// default is case-sensitive +function UnicodeStrSimpleCompare(const Obj1, Obj2: UnicodeString): Integer; +begin + Result := CompareStr(Obj1, Obj2); +end; + +// case-insensitive +function UnicodeStrSimpleCompareI(const Obj1, Obj2: UnicodeString): Integer; +begin + Result := CompareText(Obj1, Obj2); +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +function StrSimpleCompare(const Obj1, Obj2: string): Integer; +begin + case SizeOf(Obj1[1]) of + SizeOf(AnsiChar): + Result := CompareStr(Obj1, Obj2); + SizeOf(WideChar): + {$IFDEF SUPPORTS_UNICODE} + Result := CompareStr(Obj1, Obj2); + {$ELSE ~SUPPORTS_UNICODE} + Result := WideCompareStr(Obj1, Obj2); + {$ENDIF ~SUPPORTS_UNICODE} + else + raise EJclOperationNotSupportedError.Create; + end; +end; + +function StrSimpleCompareI(const Obj1, Obj2: string): Integer; +begin + case SizeOf(Obj1[1]) of + SizeOf(AnsiChar): + Result := CompareText(Obj1, Obj2); + SizeOf(WideChar): + {$IFDEF SUPPORTS_UNICODE} + Result := CompareText(Obj1, Obj2); + {$ELSE ~SUPPORTS_UNICODE} + {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.WideCompareText(Obj1, Obj2); + {$ENDIF ~SUPPORTS_UNICODE} + else + raise EJclOperationNotSupportedError.Create; + end; +end; + +function SingleSimpleCompare(const Obj1, Obj2: Single): Integer; +begin + if Obj1 < Obj2 then + Result := -1 + else + if Obj1 > Obj2 then + Result := 1 + else + Result := 0; +end; + +function DoubleSimpleCompare(const Obj1, Obj2: Double): Integer; +begin + if Obj1 < Obj2 then + Result := -1 + else + if Obj1 > Obj2 then + Result := 1 + else + Result := 0; +end; + +function ExtendedSimpleCompare(const Obj1, Obj2: Extended): Integer; +begin + if Obj1 < Obj2 then + Result := -1 + else + if Obj1 > Obj2 then + Result := 1 + else + Result := 0; +end; + +function FloatSimpleCompare(const Obj1, Obj2: Float): Integer; +begin + if Obj1 < Obj2 then + Result := -1 + else + if Obj1 > Obj2 then + Result := 1 + else + Result := 0; +end; + +function IntegerSimpleCompare(Obj1, Obj2: Integer): Integer; +begin + if Obj1 < Obj2 then + Result := -1 + else + if Obj1 > Obj2 then + Result := 1 + else + Result := 0; +end; + +function CardinalSimpleCompare(Obj1, Obj2: Cardinal): Integer; +begin + if Obj1 < Obj2 then + Result := -1 + else + if Obj1 > Obj2 then + Result := 1 + else + Result := 0; +end; + +function Int64SimpleCompare(const Obj1, Obj2: Int64): Integer; +begin + if Obj1 < Obj2 then + Result := -1 + else + if Obj1 > Obj2 then + Result := 1 + else + Result := 0; +end; + +function PtrSimpleCompare(Obj1, Obj2: Pointer): Integer; +begin + if SizeInt(Obj1) < SizeInt(Obj2) then + Result := -1 + else + if SizeInt(Obj1) > SizeInt(Obj2) then + Result := 1 + else + Result := 0; +end; + +function SimpleCompare(Obj1, Obj2: TObject): Integer; +begin + if SizeInt(Obj1) < SizeInt(Obj2) then + Result := -1 + else + if SizeInt(Obj1) > SizeInt(Obj2) then + Result := 1 + else + Result := 0; +end; + +function IntegerCompare(Obj1, Obj2: TObject): Integer; +begin + if SizeInt(Obj1) < SizeInt(Obj2) then + Result := -1 + else + if SizeInt(Obj1) > SizeInt(Obj2) then + Result := 1 + else + Result := 0; +end; + +function IntfSimpleEqualityCompare(const Obj1, Obj2: IInterface): Boolean; +begin + Result := SizeInt(Obj1) = SizeInt(Obj2); +end; + +// default is case-sensitive +function AnsiStrSimpleEqualityCompare(const Obj1, Obj2: AnsiString): Boolean; +begin + Result := CompareStr(Obj1, Obj2) = 0; +end; + +// case-insensitive +function AnsiStrSimpleEqualityCompareI(const Obj1, Obj2: AnsiString): Boolean; +begin + Result := CompareText(Obj1, Obj2) = 0; +end; + +// default is case-sensitive +function WideStrSimpleEqualityCompare(const Obj1, Obj2: WideString): Boolean; +begin + Result := WideCompareStr(Obj1, Obj2) = 0; +end; + +// case-insensitive +function WideStrSimpleEqualityCompareI(const Obj1, Obj2: WideString): Boolean; +begin + Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.WideCompareText(Obj1, Obj2) = 0; +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +// default is case-sensitive +function UnicodeStrSimpleEqualityCompare(const Obj1, Obj2: UnicodeString): Boolean; +begin + Result := CompareStr(Obj1, Obj2) = 0; +end; + +// case-insensitive +function UnicodeStrSimpleEqualityCompareI(const Obj1, Obj2: UnicodeString): Boolean; +begin + Result := CompareText(Obj1, Obj2) = 0; +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +function StrSimpleEqualityCompare(const Obj1, Obj2: string): Boolean; +begin + case SizeOf(Obj1[1]) of + SizeOf(AnsiChar): + Result := CompareStr(Obj1, Obj2) = 0; + SizeOf(WideChar): + Result := WideCompareStr(Obj1, Obj2) = 0; + else + raise EJclOperationNotSupportedError.Create; + end; +end; + +function StrSimpleEqualityCompareI(const Obj1, Obj2: string): Boolean; +begin + case SizeOf(Obj1[1]) of + SizeOf(AnsiChar): + Result := CompareText(Obj1, Obj2) = 0; + SizeOf(WideChar): + Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.WideCompareText(Obj1, Obj2) = 0; + else + raise EJclOperationNotSupportedError.Create; + end; +end; + +function SingleSimpleEqualityCompare(const Obj1, Obj2: Single): Boolean; +begin + Result := Obj1 = Obj2; +end; + +function DoubleSimpleEqualityCompare(const Obj1, Obj2: Double): Boolean; +begin + Result := Obj1 = Obj2; +end; + +function ExtendedSimpleEqualityCompare(const Obj1, Obj2: Extended): Boolean; +begin + Result := Obj1 = Obj2; +end; + +function FloatSimpleEqualityCompare(const Obj1, Obj2: Float): Boolean; +begin + Result := Obj1 = Obj2; +end; + +function IntegerSimpleEqualityCompare(Obj1, Obj2: Integer): Boolean; +begin + Result := Obj1 = Obj2; +end; + +function CardinalSimpleEqualityCompare(Obj1, Obj2: Cardinal): Boolean; +begin + Result := Obj1 = Obj2; +end; + +function Int64SimpleEqualityCompare(const Obj1, Obj2: Int64): Boolean; +begin + Result := Obj1 = Obj2; +end; + +function PtrSimpleEqualityCompare(Obj1, Obj2: Pointer): Boolean; +begin + Result := SizeInt(Obj1) = SizeInt(Obj2); +end; + +function SimpleEqualityCompare(Obj1, Obj2: TObject): Boolean; +begin + Result := SizeInt(Obj1) = SizeInt(Obj2); +end; + +function IntfSimpleHashConvert(const AInterface: IInterface): Integer; +begin + {$IFDEF CPU32} + Result := SizeInt(AInterface) and MaxInt; + {$ELSE ~CPU32} + Result := (SizeInt(AInterface) xor (SizeInt(AInterface) shr 32)) and MaxInt; + {$ENDIF ~CPU32} +end; + +// from "Fast Hashing of Variable-Length Text Strings", Peter K. Pearson, 1990 +// http://portal.acm.org/citation.cfm?id=78978 +type + TIntegerHash = packed record + case Byte of + 0: (H1, H2, H3, H4: Byte); + 1: (H: Integer); + 2: (C: UCS4); + end; + +// default is case-sensitive and ISO-encoded +function AnsiStrSimpleHashConvert(const AString: AnsiString): Integer; +var + I: Integer; + C: Byte; + IntegerHash: TIntegerHash; +begin + IntegerHash.H1 := 0; + IntegerHash.H2 := 1; + IntegerHash.H3 := 2; + IntegerHash.H4 := 3; + for I := 1 to Length(AString) do + begin + C := Ord(AString[I]); + IntegerHash.H1 := BytePermTable[IntegerHash.H1 xor C]; + IntegerHash.H2 := BytePermTable[IntegerHash.H2 xor C]; + IntegerHash.H3 := BytePermTable[IntegerHash.H3 xor C]; + IntegerHash.H4 := BytePermTable[IntegerHash.H4 xor C]; + end; + Result := IntegerHash.H and MaxInt; +end; + +// case-insensitive and ISO-encoded +function AnsiStrSimpleHashConvertI(const AString: AnsiString): Integer; +var + I: Integer; + C: Byte; + IntegerHash: TIntegerHash; +begin + IntegerHash.H1 := 0; + IntegerHash.H2 := 1; + IntegerHash.H3 := 2; + IntegerHash.H4 := 3; + for I := 1 to Length(AString) do + begin + C := Ord(JclAnsiStrings.CharUpper(AString[I])); + IntegerHash.H1 := BytePermTable[IntegerHash.H1 xor C]; + IntegerHash.H2 := BytePermTable[IntegerHash.H2 xor C]; + IntegerHash.H3 := BytePermTable[IntegerHash.H3 xor C]; + IntegerHash.H4 := BytePermTable[IntegerHash.H4 xor C]; + end; + Result := IntegerHash.H and MaxInt; +end; + +// case-sensitive and UTF8-encoded +function AnsiStrSimpleHashConvertU(const AString: AnsiString): Integer; +var + I: SizeInt; + C, IntegerHash: TIntegerHash; +begin + IntegerHash.H1 := 0; + IntegerHash.H2 := 1; + IntegerHash.H3 := 2; + IntegerHash.H4 := 3; + I := 1; + while I < Length(AString) do + begin + C.C := UTF8GetNextChar(AString, I); + if I = -1 then + raise EJclUnexpectedEOSequenceError.Create; + IntegerHash.H1 := BytePermTable[IntegerHash.H1 xor C.H1]; + IntegerHash.H2 := BytePermTable[IntegerHash.H2 xor C.H2]; + IntegerHash.H3 := BytePermTable[IntegerHash.H3 xor C.H3]; + IntegerHash.H4 := BytePermTable[IntegerHash.H4 xor C.H4]; + end; + Result := IntegerHash.H and MaxInt; +end; + +// case-insensitive and UTF8-encoded +function AnsiStrSimpleHashConvertUI(const AString: AnsiString): Integer; +var + I: SizeInt; + J: Integer; + C, IntegerHash: TIntegerHash; + CA: TUCS4Array; +begin + IntegerHash.H1 := 0; + IntegerHash.H2 := 1; + IntegerHash.H3 := 2; + IntegerHash.H4 := 3; + I := 1; + {$IFDEF UNICODE_RTL_DATABASE} + SetLength(CA, 1); + {$ELSE ~UNICODE_RTL_DATABASE} + SetLength(CA, 0); + {$ENDIF ~UNICODE_RTL_DATABASE} + while I < Length(AString) do + begin + C.C := UTF8GetNextChar(AString, I); + {$IFDEF UNICODE_RTL_DATABASE} + CA[0] := Ord(TCharacter.ToLower(Chr(C.C))); + {$ELSE ~UNICODE_RTL_DATABASE} + CA := UnicodeCaseFold(C.C); + {$ENDIF ~UNICODE_RTL_DATABASE} + for J := Low(CA) to High(CA) do + begin + C.C := CA[J]; + if I = -1 then + raise EJclUnexpectedEOSequenceError.Create; + IntegerHash.H1 := BytePermTable[IntegerHash.H1 xor C.H1]; + IntegerHash.H2 := BytePermTable[IntegerHash.H2 xor C.H2]; + IntegerHash.H3 := BytePermTable[IntegerHash.H3 xor C.H3]; + IntegerHash.H4 := BytePermTable[IntegerHash.H4 xor C.H4]; + end; + end; + Result := IntegerHash.H and MaxInt; +end; + +// default is case-sensitive +function WideStrSimpleHashConvert(const AString: WideString): Integer; +var + I: SizeInt; + C, IntegerHash: TIntegerHash; +begin + IntegerHash.H1 := 0; + IntegerHash.H2 := 1; + IntegerHash.H3 := 2; + IntegerHash.H4 := 3; + I := 1; + while I < Length(AString) do + begin + C.C := UTF16GetNextChar(AString, I); + if I = -1 then + raise EJclUnexpectedEOSequenceError.Create; + IntegerHash.H1 := BytePermTable[IntegerHash.H1 xor C.H1]; + IntegerHash.H2 := BytePermTable[IntegerHash.H2 xor C.H2]; + IntegerHash.H3 := BytePermTable[IntegerHash.H3 xor C.H3]; + IntegerHash.H4 := BytePermTable[IntegerHash.H4 xor C.H4]; + end; + Result := IntegerHash.H and MaxInt; +end; + +// case-insensitive +function WideStrSimpleHashConvertI(const AString: WideString): Integer; +var + I: SizeInt; + J: Integer; + C, IntegerHash: TIntegerHash; + CA: TUCS4Array; +begin + IntegerHash.H1 := 0; + IntegerHash.H2 := 1; + IntegerHash.H3 := 2; + IntegerHash.H4 := 3; + {$IFDEF UNICODE_RTL_DATABASE} + SetLength(CA, 1); + {$ELSE ~UNICODE_RTL_DATABASE} + SetLength(CA, 0); + {$ENDIF ~UNICODE_RTL_DATABASE} + I := 1; + while I < Length(AString) do + begin + C.C := UTF16GetNextChar(AString, I); + {$IFDEF UNICODE_RTL_DATABASE} + CA[0] := Ord(TCharacter.ToLower(Chr(C.C))); + {$ELSE ~UNICODE_RTL_DATABASE} + CA := UnicodeCaseFold(C.C); + {$ENDIF ~UNICODE_RTL_DATABASE} + for J := Low(CA) to High(CA) do + begin + C.C := CA[J]; + if I = -1 then + raise EJclUnexpectedEOSequenceError.Create; + IntegerHash.H1 := BytePermTable[IntegerHash.H1 xor C.H1]; + IntegerHash.H2 := BytePermTable[IntegerHash.H2 xor C.H2]; + IntegerHash.H3 := BytePermTable[IntegerHash.H3 xor C.H3]; + IntegerHash.H4 := BytePermTable[IntegerHash.H4 xor C.H4]; + end; + end; + Result := IntegerHash.H and MaxInt; +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +// default is case-sensitive +function UnicodeStrSimpleHashConvert(const AString: UnicodeString): Integer; +var + I: SizeInt; + C, IntegerHash: TIntegerHash; +begin + IntegerHash.H1 := 0; + IntegerHash.H2 := 1; + IntegerHash.H3 := 2; + IntegerHash.H4 := 3; + I := 1; + while I < Length(AString) do + begin + C.C := UTF16GetNextChar(AString, I); + if I = -1 then + raise EJclUnexpectedEOSequenceError.Create; + IntegerHash.H1 := BytePermTable[IntegerHash.H1 xor C.H1]; + IntegerHash.H2 := BytePermTable[IntegerHash.H2 xor C.H2]; + IntegerHash.H3 := BytePermTable[IntegerHash.H3 xor C.H3]; + IntegerHash.H4 := BytePermTable[IntegerHash.H4 xor C.H4]; + end; + Result := IntegerHash.H and MaxInt; +end; + +// case-insensitive +function UnicodeStrSimpleHashConvertI(const AString: UnicodeString): Integer; +var + I: SizeInt; + J: Integer; + C, IntegerHash: TIntegerHash; + CA: TUCS4Array; +begin + IntegerHash.H1 := 0; + IntegerHash.H2 := 1; + IntegerHash.H3 := 2; + IntegerHash.H4 := 3; + {$IFDEF UNICODE_RTL_DATABASE} + SetLength(CA, 1); + {$ELSE ~UNICODE_RTL_DATABASE} + SetLength(CA, 0); + {$ENDIF ~UNICODE_RTL_DATABASE} + I := 1; + while I < Length(AString) do + begin + C.C := UTF16GetNextChar(AString, I); + {$IFDEF UNICODE_RTL_DATABASE} + CA[0] := Ord(TCharacter.ToLower(Chr(C.C))); + {$ELSE ~UNICODE_RTL_DATABASE} + CA := UnicodeCaseFold(C.C); + {$ENDIF ~UNICODE_RTL_DATABASE} + for J := Low(CA) to High(CA) do + begin + C.C := CA[J]; + if I = -1 then + raise EJclUnexpectedEOSequenceError.Create; + IntegerHash.H1 := BytePermTable[IntegerHash.H1 xor C.H1]; + IntegerHash.H2 := BytePermTable[IntegerHash.H2 xor C.H2]; + IntegerHash.H3 := BytePermTable[IntegerHash.H3 xor C.H3]; + IntegerHash.H4 := BytePermTable[IntegerHash.H4 xor C.H4]; + end; + end; + Result := IntegerHash.H and MaxInt; +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +function StrSimpleHashConvert(const AString: string): Integer; +begin + {$IFDEF SUPPORTS_UNICODE} + {$IFDEF SUPPORTS_UNICODE_STRING} + Result := UnicodeStrSimpleHashConvert(AString); + {$ELSE ~SUPPORTS_UNICODE_STRING} + Result := WideStrSimpleHashConvert(AString); + {$ENDIF ~SUPPORTS_UNICODE_STRING} + {$ELSE ~SUPPORTS_UNICODE} + Result := AnsiStrSimpleHashConvert(AString); + {$ENDIF ~SUPPORTS_UNICODE} +end; + +function StrSimpleHashConvertI(const AString: string): Integer; +begin + {$IFDEF SUPPORTS_UNICODE} + {$IFDEF SUPPORTS_UNICODE_STRING} + Result := UnicodeStrSimpleHashConvertI(AString); + {$ELSE ~SUPPORTS_UNICODE_STRING} + Result := WideStrSimpleHashConvertI(AString); + {$ENDIF ~SUPPORTS_UNICODE_STRING} + {$ELSE ~SUPPORTS_UNICODE} + Result := AnsiStrSimpleHashConvertI(AString); + {$ENDIF ~SUPPORTS_UNICODE} +end; + +function SingleSimpleHashConvert(const AValue: Single): Integer; +const + A = 0.6180339887; // (sqrt(5) - 1) / 2 +begin + Result := Round(MaxInt * Frac(AValue * A)); +end; + +function DoubleSimpleHashConvert(const AValue: Double): Integer; +const + A = 0.6180339887; // (sqrt(5) - 1) / 2 +begin + Result := Round(MaxInt * Frac(AValue * A)); +end; + +function ExtendedSimpleHashConvert(const AValue: Extended): Integer; +const + A = 0.6180339887; // (sqrt(5) - 1) / 2 +begin + Result := Round(MaxInt * Frac(AValue * A)); +end; + +function FloatSimpleHashConvert(const AValue: Float): Integer; +const + A = 0.6180339887; // (sqrt(5) - 1) / 2 +begin + Result := Round(MaxInt * Frac(AValue * A)); +end; + +function IntegerSimpleHashConvert(AValue: Integer): Integer; +begin + Result := AValue and MaxInt; +end; + +function CardinalSimpleHashConvert(AValue: Cardinal): Integer; +begin + Result := AValue and MaxInt; +end; + +function Int64SimpleHashConvert(const AValue: Int64): Integer; +begin + Result := (AValue xor (AValue shr 32)) and MaxInt; +end; + +function PtrSimpleHashConvert(APtr: Pointer): Integer; +begin + Result := SizeInt(APtr) and MaxInt; +end; + +function SimpleHashConvert(AObject: TObject): Integer; +begin + Result := SizeInt(AObject) and MaxInt; +end; + +function JclSimpleHashToRange(Key, Range: Integer): Integer; +// return a value between 0 and (Range-1) based on integer-hash Key +const + A = 0.6180339887; // (sqrt(5) - 1) / 2 +begin + Result := Trunc(Range * (Frac(Abs(Key * A)))); +end; + +procedure FinalizeArrayBeforeMove(var List: TDynIInterfaceArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure InitializeArray(var List: TDynIInterfaceArray; FromIndex, Count: SizeInt); overload; +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure InitializeArrayAfterMove(var List: TDynIInterfaceArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure MoveArray(var List: TDynIInterfaceArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure FinalizeArrayBeforeMove(var List: TDynAnsiStringArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure InitializeArray(var List: TDynAnsiStringArray; FromIndex, Count: SizeInt); overload; +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure InitializeArrayAfterMove(var List: TDynAnsiStringArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure MoveArray(var List: TDynAnsiStringArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure FinalizeArrayBeforeMove(var List: TDynWideStringArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure InitializeArray(var List: TDynWideStringArray; FromIndex, Count: SizeInt); overload; +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure InitializeArrayAfterMove(var List: TDynWideStringArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure MoveArray(var List: TDynWideStringArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} + +procedure FinalizeArrayBeforeMove(var List: TDynUnicodeStringArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure InitializeArray(var List: TDynUnicodeStringArray; FromIndex, Count: SizeInt); overload; +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure InitializeArrayAfterMove(var List: TDynUnicodeStringArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure MoveArray(var List: TDynUnicodeStringArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +procedure InitializeArrayAfterMove(var List: TDynSingleArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure MoveArray(var List: TDynSingleArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure InitializeArrayAfterMove(var List: TDynDoubleArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure MoveArray(var List: TDynDoubleArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure InitializeArrayAfterMove(var List: TDynExtendedArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure MoveArray(var List: TDynExtendedArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure InitializeArrayAfterMove(var List: TDynIntegerArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure MoveArray(var List: TDynIntegerArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure InitializeArrayAfterMove(var List: TDynCardinalArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure MoveArray(var List: TDynCardinalArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure InitializeArrayAfterMove(var List: TDynInt64Array; FromIndex, ToIndex, Count: SizeInt); overload; +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure MoveArray(var List: TDynInt64Array; FromIndex, ToIndex, Count: SizeInt); overload; +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure InitializeArrayAfterMove(var List: TDynPointerArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure MoveArray(var List: TDynPointerArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure InitializeArrayAfterMove(var List: TDynObjectArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure MoveArray(var List: TDynObjectArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + + +procedure InitializeArrayAfterMove(var List: TDynSizeIntArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure MoveArray(var List: TDynSizeIntArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +{$IFNDEF FPC} +procedure FinalizeArrayBeforeMove(var List: TDynStringArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure InitializeArray(var List: TDynStringArray; FromIndex, Count: SizeInt); overload; +begin + + Initialize(List[FromIndex], Count); +end; + +procedure InitializeArrayAfterMove(var List: TDynStringArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure MoveArray(var List: TDynStringArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure InitializeArrayAfterMove(var List: TDynFloatArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure MoveArray(var List: TDynFloatArray; FromIndex, ToIndex, Count: SizeInt); overload; +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; +{$ENDIF ~FPC} + +procedure Iterate(const First: IJclIntfIterator; Count: Integer; F: TIntfIterateProcedure); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + F(First.Next) + else + Break; +end; + +procedure Iterate(const First: IJclAnsiStrIterator; Count: Integer; F: TAnsiStrIterateProcedure); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + F(First.Next) + else + Break; +end; + +procedure Iterate(const First: IJclWideStrIterator; Count: Integer; F: TWideStrIterateProcedure); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + F(First.Next) + else + Break; +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +procedure Iterate(const First: IJclUnicodeStrIterator; Count: Integer; F: TUnicodeStrIterateProcedure); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + F(First.Next) + else + Break; +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +procedure Iterate(const First: IJclSingleIterator; Count: Integer; F: TSingleIterateProcedure); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + F(First.Next) + else + Break; +end; + +procedure Iterate(const First: IJclDoubleIterator; Count: Integer; F: TDoubleIterateProcedure); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + F(First.Next) + else + Break; +end; + +procedure Iterate(const First: IJclExtendedIterator; Count: Integer; F: TExtendedIterateProcedure); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + F(First.Next) + else + Break; +end; + +procedure Iterate(const First: IJclIntegerIterator; Count: Integer; F: TIntegerIterateProcedure); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + F(First.Next) + else + Break; +end; + +procedure Iterate(const First: IJclCardinalIterator; Count: Integer; F: TCardinalIterateProcedure); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + F(First.Next) + else + Break; +end; + +procedure Iterate(const First: IJclInt64Iterator; Count: Integer; F: TInt64IterateProcedure); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + F(First.Next) + else + Break; +end; + +procedure Iterate(const First: IJclPtrIterator; Count: Integer; F: TPtrIterateProcedure); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + F(First.Next) + else + Break; +end; + +procedure Iterate(const First: IJclIterator; Count: Integer; F: TIterateProcedure); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + F(First.Next) + else + Break; +end; + + +procedure Apply(const First: IJclIntfIterator; Count: Integer; F: TIntfApplyFunction); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + First.SetObject(F(First.Next)) + else + Break; +end; + +procedure Apply(const First: IJclAnsiStrIterator; Count: Integer; F: TAnsiStrApplyFunction); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + First.SetString(F(First.Next)) + else + Break; +end; + +procedure Apply(const First: IJclWideStrIterator; Count: Integer; F: TWideStrApplyFunction); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + First.SetString(F(First.Next)) + else + Break; +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +procedure Apply(const First: IJclUnicodeStrIterator; Count: Integer; F: TUnicodeStrApplyFunction); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + First.SetString(F(First.Next)) + else + Break; +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +procedure Apply(const First: IJclSingleIterator; Count: Integer; F: TSingleApplyFunction); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + First.SetValue(F(First.Next)) + else + Break; +end; + +procedure Apply(const First: IJclDoubleIterator; Count: Integer; F: TDoubleApplyFunction); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + First.SetValue(F(First.Next)) + else + Break; +end; + +procedure Apply(const First: IJclExtendedIterator; Count: Integer; F: TExtendedApplyFunction); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + First.SetValue(F(First.Next)) + else + Break; +end; + +procedure Apply(const First: IJclIntegerIterator; Count: Integer; F: TIntegerApplyFunction); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + First.SetValue(F(First.Next)) + else + Break; +end; + +procedure Apply(const First: IJclCardinalIterator; Count: Integer; F: TCardinalApplyFunction); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + First.SetValue(F(First.Next)) + else + Break; +end; + +procedure Apply(const First: IJclInt64Iterator; Count: Integer; F: TInt64ApplyFunction); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + First.SetValue(F(First.Next)) + else + Break; +end; + +procedure Apply(const First: IJclPtrIterator; Count: Integer; F: TPtrApplyFunction); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + First.SetPointer(F(First.Next)) + else + Break; +end; + +procedure Apply(const First: IJclIterator; Count: Integer; F: TApplyFunction); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + First.SetObject(F(First.Next)) + else + Break; +end; + + +function Find(const First: IJclIntfIterator; Count: Integer; + const AInterface: IInterface; AComparator: TIntfCompare): IJclIntfIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AComparator(First.Next, AInterface) = 0 then + begin + Result := First; + Break; + end; + end + else + Break; +end; + +function Find(const First: IJclIntfIterator; Count: Integer; + const AInterface: IInterface; AEqualityComparator: TIntfEqualityCompare): IJclIntfIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AEqualityComparator(First.Next, AInterface) then + begin + Result := First; + Break; + end; + end + else + Break; +end; + +function Find(const First: IJclAnsiStrIterator; Count: Integer; + const AString: AnsiString; AComparator: TAnsiStrCompare): IJclAnsiStrIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AComparator(First.Next, AString) = 0 then + begin + Result := First; + Break; + end; + end + else + Break; +end; + +function Find(const First: IJclAnsiStrIterator; Count: Integer; + const AString: AnsiString; AEqualityComparator: TAnsiStrEqualityCompare): IJclAnsiStrIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AEqualityComparator(First.Next, AString) then + begin + Result := First; + Break; + end; + end + else + Break; +end; + +function Find(const First: IJclWideStrIterator; Count: Integer; + const AString: WideString; AComparator: TWideStrCompare): IJclWideStrIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AComparator(First.Next, AString) = 0 then + begin + Result := First; + Break; + end; + end + else + Break; +end; + +function Find(const First: IJclWideStrIterator; Count: Integer; + const AString: WideString; AEqualityComparator: TWideStrEqualityCompare): IJclWideStrIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AEqualityComparator(First.Next, AString) then + begin + Result := First; + Break; + end; + end + else + Break; +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +function Find(const First: IJclUnicodeStrIterator; Count: Integer; + const AString: UnicodeString; AComparator: TUnicodeStrCompare): IJclUnicodeStrIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AComparator(First.Next, AString) = 0 then + begin + Result := First; + Break; + end; + end + else + Break; +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +{$IFDEF SUPPORTS_UNICODE_STRING} +function Find(const First: IJclUnicodeStrIterator; Count: Integer; + const AString: UnicodeString; AEqualityComparator: TUnicodeStrEqualityCompare): IJclUnicodeStrIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AEqualityComparator(First.Next, AString) then + begin + Result := First; + Break; + end; + end + else + Break; +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +function Find(const First: IJclSingleIterator; Count: Integer; + const AValue: Single; AComparator: TSingleCompare): IJclSingleIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AComparator(First.Next, AValue) = 0 then + begin + Result := First; + Break; + end; + end + else + Break; +end; + +function Find(const First: IJclSingleIterator; Count: Integer; + const AValue: Single; AEqualityComparator: TSingleEqualityCompare): IJclSingleIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AEqualityComparator(First.Next, AValue) then + begin + Result := First; + Break; + end; + end + else + Break; +end; + +function Find(const First: IJclDoubleIterator; Count: Integer; + const AValue: Double; AComparator: TDoubleCompare): IJclDoubleIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AComparator(First.Next, AValue) = 0 then + begin + Result := First; + Break; + end; + end + else + Break; +end; + +function Find(const First: IJclDoubleIterator; Count: Integer; + const AValue: Double; AEqualityComparator: TDoubleEqualityCompare): IJclDoubleIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AEqualityComparator(First.Next, AValue) then + begin + Result := First; + Break; + end; + end + else + Break; +end; + +function Find(const First: IJclExtendedIterator; Count: Integer; + const AValue: Extended; AComparator: TExtendedCompare): IJclExtendedIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AComparator(First.Next, AValue) = 0 then + begin + Result := First; + Break; + end; + end + else + Break; +end; + +function Find(const First: IJclExtendedIterator; Count: Integer; + const AValue: Extended; AEqualityComparator: TExtendedEqualityCompare): IJclExtendedIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AEqualityComparator(First.Next, AValue) then + begin + Result := First; + Break; + end; + end + else + Break; +end; + +function Find(const First: IJclIntegerIterator; Count: Integer; + AValue: Integer; AComparator: TIntegerCompare): IJclIntegerIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AComparator(First.Next, AValue) = 0 then + begin + Result := First; + Break; + end; + end + else + Break; +end; + +function Find(const First: IJclIntegerIterator; Count: Integer; + AValue: Integer; AEqualityComparator: TIntegerEqualityCompare): IJclIntegerIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AEqualityComparator(First.Next, AValue) then + begin + Result := First; + Break; + end; + end + else + Break; +end; + +function Find(const First: IJclCardinalIterator; Count: Integer; + AValue: Cardinal; AComparator: TCardinalCompare): IJclCardinalIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AComparator(First.Next, AValue) = 0 then + begin + Result := First; + Break; + end; + end + else + Break; +end; + +function Find(const First: IJclCardinalIterator; Count: Integer; + AValue: Cardinal; AEqualityComparator: TCardinalEqualityCompare): IJclCardinalIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AEqualityComparator(First.Next, AValue) then + begin + Result := First; + Break; + end; + end + else + Break; +end; + +function Find(const First: IJclInt64Iterator; Count: Integer; + const AValue: Int64; AComparator: TInt64Compare): IJclInt64Iterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AComparator(First.Next, AValue) = 0 then + begin + Result := First; + Break; + end; + end + else + Break; +end; + +function Find(const First: IJclInt64Iterator; Count: Integer; + const AValue: Int64; AEqualityComparator: TInt64EqualityCompare): IJclInt64Iterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AEqualityComparator(First.Next, AValue) then + begin + Result := First; + Break; + end; + end + else + Break; +end; + +function Find(const First: IJclPtrIterator; Count: Integer; + APtr: Pointer; AComparator: TPtrCompare): IJclPtrIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AComparator(First.Next, APtr) = 0 then + begin + Result := First; + Break; + end; + end + else + Break; +end; + +function Find(const First: IJclPtrIterator; Count: Integer; + APtr: Pointer; AEqualityComparator: TPtrEqualityCompare): IJclPtrIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AEqualityComparator(First.Next, APtr) then + begin + Result := First; + Break; + end; + end + else + Break; +end; + +function Find(const First: IJclIterator; Count: Integer; + AObject: TObject; AComparator: TCompare): IJclIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AComparator(First.Next, AObject) = 0 then + begin + Result := First; + Break; + end; + end + else + Break; +end; + +function Find(const First: IJclIterator; Count: Integer; + AObject: TObject; AEqualityComparator: TEqualityCompare): IJclIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AEqualityComparator(First.Next, AObject) then + begin + Result := First; + Break; + end; + end + else + Break; +end; + + +function CountObject(const First: IJclIntfIterator; Count: Integer; + const AInterface: IInterface; AComparator: TIntfCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AComparator(First.Next, AInterface) = 0)) + else + Break; +end; + +function CountObject(const First: IJclIntfIterator; Count: Integer; + const AInterface: IInterface; AEqualityComparator: TIntfEqualityCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AEqualityComparator(First.Next, AInterface))) + else + Break; +end; + +function CountObject(const First: IJclAnsiStrIterator; Count: Integer; + const AString: AnsiString; AComparator: TAnsiStrCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AComparator(First.Next, AString) = 0)) + else + Break; +end; + +function CountObject(const First: IJclAnsiStrIterator; Count: Integer; + const AString: AnsiString; AEqualityComparator: TAnsiStrEqualityCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AEqualityComparator(First.Next, AString))) + else + Break; +end; + +function CountObject(const First: IJclWideStrIterator; Count: Integer; + const AString: WideString; AComparator: TWideStrCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AComparator(First.Next, AString) = 0)) + else + Break; +end; + +function CountObject(const First: IJclWideStrIterator; Count: Integer; + const AString: WideString; AEqualityComparator: TWideStrEqualityCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AEqualityComparator(First.Next, AString))) + else + Break; +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +function CountObject(const First: IJclUnicodeStrIterator; Count: Integer; + const AString: UnicodeString; AComparator: TUnicodeStrCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AComparator(First.Next, AString) = 0)) + else + Break; +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +{$IFDEF SUPPORTS_UNICODE_STRING} +function CountObject(const First: IJclUnicodeStrIterator; Count: Integer; + const AString: UnicodeString; AEqualityComparator: TUnicodeStrEqualityCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AEqualityComparator(First.Next, AString))) + else + Break; +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +function CountObject(const First: IJclSingleIterator; Count: Integer; + const AValue: Single; AComparator: TSingleCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AComparator(First.Next, AValue) = 0)) + else + Break; +end; + +function CountObject(const First: IJclSingleIterator; Count: Integer; + const AValue: Single; AEqualityComparator: TSingleEqualityCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AEqualityComparator(First.Next, AValue))) + else + Break; +end; + +function CountObject(const First: IJclDoubleIterator; Count: Integer; + const AValue: Double; AComparator: TDoubleCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AComparator(First.Next, AValue) = 0)) + else + Break; +end; + +function CountObject(const First: IJclDoubleIterator; Count: Integer; + const AValue: Double; AEqualityComparator: TDoubleEqualityCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AEqualityComparator(First.Next, AValue))) + else + Break; +end; + +function CountObject(const First: IJclExtendedIterator; Count: Integer; + const AValue: Extended; AComparator: TExtendedCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AComparator(First.Next, AValue) = 0)) + else + Break; +end; + +function CountObject(const First: IJclExtendedIterator; Count: Integer; + const AValue: Extended; AEqualityComparator: TExtendedEqualityCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AEqualityComparator(First.Next, AValue))) + else + Break; +end; + +function CountObject(const First: IJclIntegerIterator; Count: Integer; + AValue: Integer; AComparator: TIntegerCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AComparator(First.Next, AValue) = 0)) + else + Break; +end; + +function CountObject(const First: IJclIntegerIterator; Count: Integer; + AValue: Integer; AEqualityComparator: TIntegerEqualityCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AEqualityComparator(First.Next, AValue))) + else + Break; +end; + +function CountObject(const First: IJclCardinalIterator; Count: Integer; + AValue: Cardinal; AComparator: TCardinalCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AComparator(First.Next, AValue) = 0)) + else + Break; +end; + +function CountObject(const First: IJclCardinalIterator; Count: Integer; + AValue: Cardinal; AEqualityComparator: TCardinalEqualityCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AEqualityComparator(First.Next, AValue))) + else + Break; +end; + +function CountObject(const First: IJclInt64Iterator; Count: Integer; + const AValue: Int64; AComparator: TInt64Compare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AComparator(First.Next, AValue) = 0)) + else + Break; +end; + +function CountObject(const First: IJclInt64Iterator; Count: Integer; + const AValue: Int64; AEqualityComparator: TInt64EqualityCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AEqualityComparator(First.Next, AValue))) + else + Break; +end; + +function CountObject(const First: IJclPtrIterator; Count: Integer; + APtr: Pointer; AComparator: TPtrCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AComparator(First.Next, APtr) = 0)) + else + Break; +end; + +function CountObject(const First: IJclPtrIterator; Count: Integer; + APtr: Pointer; AEqualityComparator: TPtrEqualityCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AEqualityComparator(First.Next, APtr))) + else + Break; +end; + +function CountObject(const First: IJclIterator; Count: Integer; + AObject: TObject; AComparator: TCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AComparator(First.Next, AObject) = 0)) + else + Break; +end; + +function CountObject(const First: IJclIterator; Count: Integer; + AObject: TObject; AEqualityComparator: TEqualityCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AEqualityComparator(First.Next, AObject))) + else + Break; +end; + + +procedure Copy(const First: IJclIntfIterator; Count: Integer; + const Output: IJclIntfIterator); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if Output.HasNext and First.HasNext then + begin + Output.Next; + Output.SetObject(First.Next); + end + else + Break; +end; + +procedure Copy(const First: IJclAnsiStrIterator; Count: Integer; + const Output: IJclAnsiStrIterator); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if Output.HasNext and First.HasNext then + begin + Output.Next; + Output.SetString(First.Next); + end + else + Break; +end; + +procedure Copy(const First: IJclWideStrIterator; Count: Integer; + const Output: IJclWideStrIterator); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if Output.HasNext and First.HasNext then + begin + Output.Next; + Output.SetString(First.Next); + end + else + Break; +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +procedure Copy(const First: IJclUnicodeStrIterator; Count: Integer; + const Output: IJclUnicodeStrIterator); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if Output.HasNext and First.HasNext then + begin + Output.Next; + Output.SetString(First.Next); + end + else + Break; +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +procedure Copy(const First: IJclSingleIterator; Count: Integer; + const Output: IJclSingleIterator); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if Output.HasNext and First.HasNext then + begin + Output.Next; + Output.SetValue(First.Next); + end + else + Break; +end; + +procedure Copy(const First: IJclDoubleIterator; Count: Integer; + const Output: IJclDoubleIterator); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if Output.HasNext and First.HasNext then + begin + Output.Next; + Output.SetValue(First.Next); + end + else + Break; +end; + +procedure Copy(const First: IJclExtendedIterator; Count: Integer; + const Output: IJclExtendedIterator); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if Output.HasNext and First.HasNext then + begin + Output.Next; + Output.SetValue(First.Next); + end + else + Break; +end; + +procedure Copy(const First: IJclIntegerIterator; Count: Integer; + const Output: IJclIntegerIterator); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if Output.HasNext and First.HasNext then + begin + Output.Next; + Output.SetValue(First.Next); + end + else + Break; +end; + +procedure Copy(const First: IJclCardinalIterator; Count: Integer; + const Output: IJclCardinalIterator); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if Output.HasNext and First.HasNext then + begin + Output.Next; + Output.SetValue(First.Next); + end + else + Break; +end; + +procedure Copy(const First: IJclInt64Iterator; Count: Integer; + const Output: IJclInt64Iterator); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if Output.HasNext and First.HasNext then + begin + Output.Next; + Output.SetValue(First.Next); + end + else + Break; +end; + +procedure Copy(const First: IJclPtrIterator; Count: Integer; + const Output: IJclPtrIterator); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if Output.HasNext and First.HasNext then + begin + Output.Next; + Output.SetPointer(First.Next); + end + else + Break; +end; + +procedure Copy(const First: IJclIterator; Count: Integer; + const Output: IJclIterator); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if Output.HasNext and First.HasNext then + begin + Output.Next; + Output.SetObject(First.Next); + end + else + Break; +end; + + +procedure Generate(const List: IJclIntfList; Count: Integer; + const AInterface: IInterface); +var + I: Integer; +begin + List.Clear; + for I := 0 to Count - 1 do + List.Add(AInterface); +end; + +procedure Generate(const List: IJclAnsiStrList; Count: Integer; + const AString: AnsiString); +var + I: Integer; +begin + List.Clear; + for I := 0 to Count - 1 do + List.Add(AString); +end; + +procedure Generate(const List: IJclWideStrList; Count: Integer; + const AString: WideString); +var + I: Integer; +begin + List.Clear; + for I := 0 to Count - 1 do + List.Add(AString); +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +procedure Generate(const List: IJclUnicodeStrList; Count: Integer; + const AString: UnicodeString); +var + I: Integer; +begin + List.Clear; + for I := 0 to Count - 1 do + List.Add(AString); +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +procedure Generate(const List: IJclSingleList; Count: Integer; + const AValue: Single); +var + I: Integer; +begin + List.Clear; + for I := 0 to Count - 1 do + List.Add(AValue); +end; + +procedure Generate(const List: IJclDoubleList; Count: Integer; + const AValue: Double); +var + I: Integer; +begin + List.Clear; + for I := 0 to Count - 1 do + List.Add(AValue); +end; + +procedure Generate(const List: IJclExtendedList; Count: Integer; + const AValue: Extended); +var + I: Integer; +begin + List.Clear; + for I := 0 to Count - 1 do + List.Add(AValue); +end; + +procedure Generate(const List: IJclIntegerList; Count: Integer; + AValue: Integer); +var + I: Integer; +begin + List.Clear; + for I := 0 to Count - 1 do + List.Add(AValue); +end; + +procedure Generate(const List: IJclCardinalList; Count: Integer; + AValue: Cardinal); +var + I: Integer; +begin + List.Clear; + for I := 0 to Count - 1 do + List.Add(AValue); +end; + +procedure Generate(const List: IJclInt64List; Count: Integer; + const AValue: Int64); +var + I: Integer; +begin + List.Clear; + for I := 0 to Count - 1 do + List.Add(AValue); +end; + +procedure Generate(const List: IJclPtrList; Count: Integer; + APtr: Pointer); +var + I: Integer; +begin + List.Clear; + for I := 0 to Count - 1 do + List.Add(APtr); +end; + +procedure Generate(const List: IJclList; Count: Integer; + AObject: TObject); +var + I: Integer; +begin + List.Clear; + for I := 0 to Count - 1 do + List.Add(AObject); +end; + + +procedure Fill(const First: IJclIntfIterator; Count: Integer; + const AInterface: IInterface); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + begin + First.Next; + First.SetObject(AInterface); + end + else + Break; +end; + +procedure Fill(const First: IJclAnsiStrIterator; Count: Integer; + const AString: AnsiString); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + begin + First.Next; + First.SetString(AString); + end + else + Break; +end; + +procedure Fill(const First: IJclWideStrIterator; Count: Integer; + const AString: WideString); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + begin + First.Next; + First.SetString(AString); + end + else + Break; +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +procedure Fill(const First: IJclUnicodeStrIterator; Count: Integer; + const AString: UnicodeString); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + begin + First.Next; + First.SetString(AString); + end + else + Break; +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +procedure Fill(const First: IJclSingleIterator; Count: Integer; + const AValue: Single); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + begin + First.Next; + First.SetValue(AValue); + end + else + Break; +end; + +procedure Fill(const First: IJclDoubleIterator; Count: Integer; + const AValue: Double); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + begin + First.Next; + First.SetValue(AValue); + end + else + Break; +end; + +procedure Fill(const First: IJclExtendedIterator; Count: Integer; + const AValue: Extended); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + begin + First.Next; + First.SetValue(AValue); + end + else + Break; +end; + +procedure Fill(const First: IJclIntegerIterator; Count: Integer; + AValue: Integer); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + begin + First.Next; + First.SetValue(AValue); + end + else + Break; +end; + +procedure Fill(const First: IJclCardinalIterator; Count: Integer; + AValue: Cardinal); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + begin + First.Next; + First.SetValue(AValue); + end + else + Break; +end; + +procedure Fill(const First: IJclInt64Iterator; Count: Integer; + const AValue: Int64); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + begin + First.Next; + First.SetValue(AValue); + end + else + Break; +end; + +procedure Fill(const First: IJclPtrIterator; Count: Integer; + APtr: Pointer); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + begin + First.Next; + First.SetPointer(APtr); + end + else + Break; +end; + +procedure Fill(const First: IJclIterator; Count: Integer; + AObject: TObject); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + begin + First.Next; + First.SetObject(AObject); + end + else + Break; +end; + + +procedure Reverse(const First, Last: IJclIntfIterator); +var + Obj: IInterface; +begin + if not First.HasNext then + Exit; + if not Last.HasPrevious then + Exit; + while First.NextIndex < Last.PreviousIndex do + begin + Obj := First.Next; + Last.Previous; + First.SetObject(Last.GetObject); + Last.SetObject(Obj); + end; +end; + +procedure Reverse(const First, Last: IJclAnsiStrIterator); +var + Obj: AnsiString; +begin + if not First.HasNext then + Exit; + if not Last.HasPrevious then + Exit; + while First.NextIndex < Last.PreviousIndex do + begin + Obj := First.Next; + Last.Previous; + First.SetString(Last.GetString); + Last.SetString(Obj); + end; +end; + +procedure Reverse(const First, Last: IJclWideStrIterator); +var + Obj: WideString; +begin + if not First.HasNext then + Exit; + if not Last.HasPrevious then + Exit; + while First.NextIndex < Last.PreviousIndex do + begin + Obj := First.Next; + Last.Previous; + First.SetString(Last.GetString); + Last.SetString(Obj); + end; +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +procedure Reverse(const First, Last: IJclUnicodeStrIterator); +var + Obj: UnicodeString; +begin + if not First.HasNext then + Exit; + if not Last.HasPrevious then + Exit; + while First.NextIndex < Last.PreviousIndex do + begin + Obj := First.Next; + Last.Previous; + First.SetString(Last.GetString); + Last.SetString(Obj); + end; +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +procedure Reverse(const First, Last: IJclSingleIterator); +var + Obj: Single; +begin + if not First.HasNext then + Exit; + if not Last.HasPrevious then + Exit; + while First.NextIndex < Last.PreviousIndex do + begin + Obj := First.Next; + Last.Previous; + First.SetValue(Last.GetValue); + Last.SetValue(Obj); + end; +end; + +procedure Reverse(const First, Last: IJclDoubleIterator); +var + Obj: Double; +begin + if not First.HasNext then + Exit; + if not Last.HasPrevious then + Exit; + while First.NextIndex < Last.PreviousIndex do + begin + Obj := First.Next; + Last.Previous; + First.SetValue(Last.GetValue); + Last.SetValue(Obj); + end; +end; + +procedure Reverse(const First, Last: IJclExtendedIterator); +var + Obj: Extended; +begin + if not First.HasNext then + Exit; + if not Last.HasPrevious then + Exit; + while First.NextIndex < Last.PreviousIndex do + begin + Obj := First.Next; + Last.Previous; + First.SetValue(Last.GetValue); + Last.SetValue(Obj); + end; +end; + +procedure Reverse(const First, Last: IJclIntegerIterator); +var + Obj: Integer; +begin + if not First.HasNext then + Exit; + if not Last.HasPrevious then + Exit; + while First.NextIndex < Last.PreviousIndex do + begin + Obj := First.Next; + Last.Previous; + First.SetValue(Last.GetValue); + Last.SetValue(Obj); + end; +end; + +procedure Reverse(const First, Last: IJclCardinalIterator); +var + Obj: Cardinal; +begin + if not First.HasNext then + Exit; + if not Last.HasPrevious then + Exit; + while First.NextIndex < Last.PreviousIndex do + begin + Obj := First.Next; + Last.Previous; + First.SetValue(Last.GetValue); + Last.SetValue(Obj); + end; +end; + +procedure Reverse(const First, Last: IJclInt64Iterator); +var + Obj: Int64; +begin + if not First.HasNext then + Exit; + if not Last.HasPrevious then + Exit; + while First.NextIndex < Last.PreviousIndex do + begin + Obj := First.Next; + Last.Previous; + First.SetValue(Last.GetValue); + Last.SetValue(Obj); + end; +end; + +procedure Reverse(const First, Last: IJclPtrIterator); +var + Obj: Pointer; +begin + if not First.HasNext then + Exit; + if not Last.HasPrevious then + Exit; + while First.NextIndex < Last.PreviousIndex do + begin + Obj := First.Next; + Last.Previous; + First.SetPointer(Last.GetPointer); + Last.SetPointer(Obj); + end; +end; + +procedure Reverse(const First, Last: IJclIterator); +var + Obj: TObject; +begin + if not First.HasNext then + Exit; + if not Last.HasPrevious then + Exit; + while First.NextIndex < Last.PreviousIndex do + begin + Obj := First.Next; + Last.Previous; + First.SetObject(Last.GetObject); + Last.SetObject(Obj); + end; +end; + + +procedure QuickSort(const AList: IJclIntfList; L, R: Integer; + AComparator: TIntfCompare); +var + I, J, P: Integer; + Obj: IInterface; +begin + repeat + I := L; + J := R; + P := (L + R) shr 1; + repeat + Obj := AList.GetObject(P); + while AComparator(AList.GetObject(I), Obj) < 0 do + Inc(I); + while AComparator(AList.GetObject(J), Obj) > 0 do + Dec(J); + if I <= J then + begin + if I <> J then + begin + Obj := AList.GetObject(I); + AList.SetObject(I, AList.GetObject(J)); + AList.SetObject(J, Obj); + end; + if P = I then + P := J + else + if P = J then + P := I; + Inc(I); + Dec(J); + end; + until I > J; + if L < J then + QuickSort(AList, L, J, AComparator); + L := I; + until I >= R; +end; + +procedure QuickSort(const AList: IJclAnsiStrList; L, R: Integer; + AComparator: TAnsiStrCompare); +var + I, J, P: Integer; + Obj: AnsiString; +begin + repeat + I := L; + J := R; + P := (L + R) shr 1; + repeat + Obj := AList.GetString(P); + while AComparator(AList.GetString(I), Obj) < 0 do + Inc(I); + while AComparator(AList.GetString(J), Obj) > 0 do + Dec(J); + if I <= J then + begin + if I <> J then + begin + Obj := AList.GetString(I); + AList.SetString(I, AList.GetString(J)); + AList.SetString(J, Obj); + end; + if P = I then + P := J + else + if P = J then + P := I; + Inc(I); + Dec(J); + end; + until I > J; + if L < J then + QuickSort(AList, L, J, AComparator); + L := I; + until I >= R; +end; + +procedure QuickSort(const AList: IJclWideStrList; L, R: Integer; + AComparator: TWideStrCompare); +var + I, J, P: Integer; + Obj: WideString; +begin + repeat + I := L; + J := R; + P := (L + R) shr 1; + repeat + Obj := AList.GetString(P); + while AComparator(AList.GetString(I), Obj) < 0 do + Inc(I); + while AComparator(AList.GetString(J), Obj) > 0 do + Dec(J); + if I <= J then + begin + if I <> J then + begin + Obj := AList.GetString(I); + AList.SetString(I, AList.GetString(J)); + AList.SetString(J, Obj); + end; + if P = I then + P := J + else + if P = J then + P := I; + Inc(I); + Dec(J); + end; + until I > J; + if L < J then + QuickSort(AList, L, J, AComparator); + L := I; + until I >= R; +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +procedure QuickSort(const AList: IJclUnicodeStrList; L, R: Integer; + AComparator: TUnicodeStrCompare); +var + I, J, P: Integer; + Obj: UnicodeString; +begin + repeat + I := L; + J := R; + P := (L + R) shr 1; + repeat + Obj := AList.GetString(P); + while AComparator(AList.GetString(I), Obj) < 0 do + Inc(I); + while AComparator(AList.GetString(J), Obj) > 0 do + Dec(J); + if I <= J then + begin + if I <> J then + begin + Obj := AList.GetString(I); + AList.SetString(I, AList.GetString(J)); + AList.SetString(J, Obj); + end; + if P = I then + P := J + else + if P = J then + P := I; + Inc(I); + Dec(J); + end; + until I > J; + if L < J then + QuickSort(AList, L, J, AComparator); + L := I; + until I >= R; +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +procedure QuickSort(const AList: IJclSingleList; L, R: Integer; + AComparator: TSingleCompare); +var + I, J, P: Integer; + Obj: Single; +begin + repeat + I := L; + J := R; + P := (L + R) shr 1; + repeat + Obj := AList.GetValue(P); + while AComparator(AList.GetValue(I), Obj) < 0 do + Inc(I); + while AComparator(AList.GetValue(J), Obj) > 0 do + Dec(J); + if I <= J then + begin + if I <> J then + begin + Obj := AList.GetValue(I); + AList.SetValue(I, AList.GetValue(J)); + AList.SetValue(J, Obj); + end; + if P = I then + P := J + else + if P = J then + P := I; + Inc(I); + Dec(J); + end; + until I > J; + if L < J then + QuickSort(AList, L, J, AComparator); + L := I; + until I >= R; +end; + +procedure QuickSort(const AList: IJclDoubleList; L, R: Integer; + AComparator: TDoubleCompare); +var + I, J, P: Integer; + Obj: Double; +begin + repeat + I := L; + J := R; + P := (L + R) shr 1; + repeat + Obj := AList.GetValue(P); + while AComparator(AList.GetValue(I), Obj) < 0 do + Inc(I); + while AComparator(AList.GetValue(J), Obj) > 0 do + Dec(J); + if I <= J then + begin + if I <> J then + begin + Obj := AList.GetValue(I); + AList.SetValue(I, AList.GetValue(J)); + AList.SetValue(J, Obj); + end; + if P = I then + P := J + else + if P = J then + P := I; + Inc(I); + Dec(J); + end; + until I > J; + if L < J then + QuickSort(AList, L, J, AComparator); + L := I; + until I >= R; +end; + +procedure QuickSort(const AList: IJclExtendedList; L, R: Integer; + AComparator: TExtendedCompare); +var + I, J, P: Integer; + Obj: Extended; +begin + repeat + I := L; + J := R; + P := (L + R) shr 1; + repeat + Obj := AList.GetValue(P); + while AComparator(AList.GetValue(I), Obj) < 0 do + Inc(I); + while AComparator(AList.GetValue(J), Obj) > 0 do + Dec(J); + if I <= J then + begin + if I <> J then + begin + Obj := AList.GetValue(I); + AList.SetValue(I, AList.GetValue(J)); + AList.SetValue(J, Obj); + end; + if P = I then + P := J + else + if P = J then + P := I; + Inc(I); + Dec(J); + end; + until I > J; + if L < J then + QuickSort(AList, L, J, AComparator); + L := I; + until I >= R; +end; + +procedure QuickSort(const AList: IJclIntegerList; L, R: Integer; + AComparator: TIntegerCompare); +var + I, J, P: Integer; + Obj: Integer; +begin + repeat + I := L; + J := R; + P := (L + R) shr 1; + repeat + Obj := AList.GetValue(P); + while AComparator(AList.GetValue(I), Obj) < 0 do + Inc(I); + while AComparator(AList.GetValue(J), Obj) > 0 do + Dec(J); + if I <= J then + begin + if I <> J then + begin + Obj := AList.GetValue(I); + AList.SetValue(I, AList.GetValue(J)); + AList.SetValue(J, Obj); + end; + if P = I then + P := J + else + if P = J then + P := I; + Inc(I); + Dec(J); + end; + until I > J; + if L < J then + QuickSort(AList, L, J, AComparator); + L := I; + until I >= R; +end; + +procedure QuickSort(const AList: IJclCardinalList; L, R: Integer; + AComparator: TCardinalCompare); +var + I, J, P: Integer; + Obj: Cardinal; +begin + repeat + I := L; + J := R; + P := (L + R) shr 1; + repeat + Obj := AList.GetValue(P); + while AComparator(AList.GetValue(I), Obj) < 0 do + Inc(I); + while AComparator(AList.GetValue(J), Obj) > 0 do + Dec(J); + if I <= J then + begin + if I <> J then + begin + Obj := AList.GetValue(I); + AList.SetValue(I, AList.GetValue(J)); + AList.SetValue(J, Obj); + end; + if P = I then + P := J + else + if P = J then + P := I; + Inc(I); + Dec(J); + end; + until I > J; + if L < J then + QuickSort(AList, L, J, AComparator); + L := I; + until I >= R; +end; + +procedure QuickSort(const AList: IJclInt64List; L, R: Integer; + AComparator: TInt64Compare); +var + I, J, P: Integer; + Obj: Int64; +begin + repeat + I := L; + J := R; + P := (L + R) shr 1; + repeat + Obj := AList.GetValue(P); + while AComparator(AList.GetValue(I), Obj) < 0 do + Inc(I); + while AComparator(AList.GetValue(J), Obj) > 0 do + Dec(J); + if I <= J then + begin + if I <> J then + begin + Obj := AList.GetValue(I); + AList.SetValue(I, AList.GetValue(J)); + AList.SetValue(J, Obj); + end; + if P = I then + P := J + else + if P = J then + P := I; + Inc(I); + Dec(J); + end; + until I > J; + if L < J then + QuickSort(AList, L, J, AComparator); + L := I; + until I >= R; +end; + +procedure QuickSort(const AList: IJclPtrList; L, R: Integer; + AComparator: TPtrCompare); +var + I, J, P: Integer; + Obj: Pointer; +begin + repeat + I := L; + J := R; + P := (L + R) shr 1; + repeat + Obj := AList.GetPointer(P); + while AComparator(AList.GetPointer(I), Obj) < 0 do + Inc(I); + while AComparator(AList.GetPointer(J), Obj) > 0 do + Dec(J); + if I <= J then + begin + if I <> J then + begin + Obj := AList.GetPointer(I); + AList.SetPointer(I, AList.GetPointer(J)); + AList.SetPointer(J, Obj); + end; + if P = I then + P := J + else + if P = J then + P := I; + Inc(I); + Dec(J); + end; + until I > J; + if L < J then + QuickSort(AList, L, J, AComparator); + L := I; + until I >= R; +end; + +procedure QuickSort(const AList: IJclList; L, R: Integer; + AComparator: TCompare); +var + I, J, P: Integer; + Obj: TObject; +begin + repeat + I := L; + J := R; + P := (L + R) shr 1; + repeat + Obj := AList.GetObject(P); + while AComparator(AList.GetObject(I), Obj) < 0 do + Inc(I); + while AComparator(AList.GetObject(J), Obj) > 0 do + Dec(J); + if I <= J then + begin + if I <> J then + begin + Obj := AList.GetObject(I); + AList.SetObject(I, AList.GetObject(J)); + AList.SetObject(J, Obj); + end; + if P = I then + P := J + else + if P = J then + P := I; + Inc(I); + Dec(J); + end; + until I > J; + if L < J then + QuickSort(AList, L, J, AComparator); + L := I; + until I >= R; +end; + + +procedure Sort(const AList: IJclIntfList; First, Last: Integer; AComparator: TIntfCompare); +begin + IntfSortProc(AList, First, Last, AComparator); +end; + +procedure Sort(const AList: IJclAnsiStrList; First, Last: Integer; AComparator: TAnsiStrCompare); +begin + AnsiStrSortProc(AList, First, Last, AComparator); +end; + +procedure Sort(const AList: IJclWideStrList; First, Last: Integer; AComparator: TWideStrCompare); +begin + WideStrSortProc(AList, First, Last, AComparator); +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +procedure Sort(const AList: IJclUnicodeStrList; First, Last: Integer; AComparator: TUnicodeStrCompare); +begin + UnicodeStrSortProc(AList, First, Last, AComparator); +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +procedure Sort(const AList: IJclSingleList; First, Last: Integer; AComparator: TSingleCompare); +begin + SingleSortProc(AList, First, Last, AComparator); +end; + +procedure Sort(const AList: IJclDoubleList; First, Last: Integer; AComparator: TDoubleCompare); +begin + DoubleSortProc(AList, First, Last, AComparator); +end; + +procedure Sort(const AList: IJclExtendedList; First, Last: Integer; AComparator: TExtendedCompare); +begin + ExtendedSortProc(AList, First, Last, AComparator); +end; + +procedure Sort(const AList: IJclIntegerList; First, Last: Integer; AComparator: TIntegerCompare); +begin + IntegerSortProc(AList, First, Last, AComparator); +end; + +procedure Sort(const AList: IJclCardinalList; First, Last: Integer; AComparator: TCardinalCompare); +begin + CardinalSortProc(AList, First, Last, AComparator); +end; + +procedure Sort(const AList: IJclInt64List; First, Last: Integer; AComparator: TInt64Compare); +begin + Int64SortProc(AList, First, Last, AComparator); +end; + +procedure Sort(const AList: IJclPtrList; First, Last: Integer; AComparator: TPtrCompare); +begin + PtrSortProc(AList, First, Last, AComparator); +end; + +procedure Sort(const AList: IJclList; First, Last: Integer; AComparator: TCompare); +begin + SortProc(AList, First, Last, AComparator); +end; + +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +class procedure TJclAlgorithms.Iterate(const First: IJclIterator; Count: Integer; F: TIterateProcedure); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + F(First.Next) + else + Break; +end; + +class procedure TJclAlgorithms.Apply(const First: IJclIterator; Count: Integer; F: TApplyFunction); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + First.SetItem(F(First.Next)) + else + Break; +end; + +class function TJclAlgorithms.Find(const First: IJclIterator; Count: Integer; + const AItem: T; AComparator: TCompare): IJclIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AComparator(First.Next, AItem) = 0 then + begin + Result := First; + Break; + end; + end + else + Break; +end; + +class function TJclAlgorithms.Find(const First: IJclIterator; Count: Integer; + const AItem: T; AEqualityComparator: TEqualityCompare): IJclIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AEqualityComparator(First.Next, AItem) then + begin + Result := First; + Break; + end; + end + else + Break; +end; + +class function TJclAlgorithms.CountObject(const First: IJclIterator; Count: Integer; + const AItem: T; AComparator: TCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AComparator(First.Next, AItem) = 0)) + else + Break; +end; + +class function TJclAlgorithms.CountObject(const First: IJclIterator; Count: Integer; + const AItem: T; AEqualityComparator: TEqualityCompare): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AEqualityComparator(First.Next, AItem))) + else + Break; +end; + +class procedure TJclAlgorithms.Copy(const First: IJclIterator; Count: Integer; + const Output: IJclIterator); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if Output.HasNext and First.HasNext then + begin + Output.Next; + Output.SetItem(First.Next); + end + else + Break; +end; + +class procedure TJclAlgorithms.Generate(const List: IJclList; Count: Integer; + const AItem: T); +var + I: Integer; +begin + List.Clear; + for I := 0 to Count - 1 do + List.Add(AItem); +end; + +class procedure TJclAlgorithms.Fill(const First: IJclIterator; Count: Integer; + const AItem: T); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + begin + First.Next; + First.SetItem(AItem); + end + else + Break; +end; + +class procedure TJclAlgorithms.Reverse(const First, Last: IJclIterator); +var + Obj: T; +begin + if not First.HasNext then + Exit; + if not Last.HasPrevious then + Exit; + while First.NextIndex < Last.PreviousIndex do + begin + Obj := First.Next; + Last.Previous; + First.SetItem(Last.GetItem); + Last.SetItem(Obj); + end; +end; + +class procedure TJclAlgorithms.QuickSort(const AList: IJclList; L, R: Integer; + AComparator: TCompare); +var + I, J, P: Integer; + Obj: T; +begin + repeat + I := L; + J := R; + P := (L + R) shr 1; + repeat + Obj := AList.GetItem(P); + while AComparator(AList.GetItem(I), Obj) < 0 do + Inc(I); + while AComparator(AList.GetItem(J), Obj) > 0 do + Dec(J); + if I <= J then + begin + if I <> J then + begin + Obj := AList.GetItem(I); + AList.SetItem(I, AList.GetItem(J)); + AList.SetItem(J, Obj); + end; + if P = I then + P := J + else + if P = J then + P := I; + Inc(I); + Dec(J); + end; + until I > J; + if L < J then + TJclAlgorithms.QuickSort(AList, L, J, AComparator); + L := I; + until I >= R; +end; + +class procedure TJclAlgorithms.Sort(const AList: IJclList; First, Last: Integer; + AComparator: TCompare); +begin + TJclAlgorithms.QuickSort(AList, First, Last, AComparator); +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. \ No newline at end of file diff --git a/3rdParty/JCL/source/common/JclAnsiStrings.pas b/3rdParty/JCL/source/common/JclAnsiStrings.pas index a1987928..d5cc88cc 100644 --- a/3rdParty/JCL/source/common/JclAnsiStrings.pas +++ b/3rdParty/JCL/source/common/JclAnsiStrings.pas @@ -1,4271 +1,4271 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is JclStrings.pas. } -{ } -{ The Initial Developer of the Original Code is Marcel van Brakel. } -{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. All rights reserved. } -{ } -{ Contributor(s): } -{ Alexander Radchenko } -{ Andreas Hausladen (ahuser) } -{ Anthony Steele } -{ Azret Botash } -{ Barry Kelly } -{ Huanlin Tsai } -{ Jack N.A. Bakker } -{ Jean-Fabien Connault (cycocrew) } -{ John C Molyneux } -{ Leonard Wennekers } -{ Martin Kimmings } -{ Martin Kubecka } -{ Massimo Maria Ghisalberti } -{ Matthias Thoma (mthoma) } -{ Michael Winter } -{ Nick Hodges } -{ Olivier Sannier (obones) } -{ Patrick Kolla } -{ Pelle F. S. Liljendal } -{ Petr Vones (pvones) } -{ Robert Lee } -{ Robert Marquardt (marquardt) } -{ Robert Rossmair (rrossmair) } -{ Andreas Schmidt } -{ } -{**************************************************************************************************} -{ } -{ Various character and string routines (searching, testing and transforming) } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -unit JclAnsiStrings; - -{$I jcl.inc} - -interface - -uses - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - {$IFDEF HAS_UNITSCOPE} - {$IFDEF MSWINDOWS} - Winapi.Windows, - {$ENDIF MSWINDOWS} - System.Classes, System.SysUtils, - {$IFDEF HAS_UNIT_ANSISTRINGS} - System.AnsiStrings, - {$ENDIF HAS_UNIT_ANSISTRINGS} - {$ELSE ~HAS_UNITSCOPE} - {$IFDEF MSWINDOWS} - Windows, - {$ENDIF MSWINDOWS} - Classes, SysUtils, - {$IFDEF HAS_UNIT_ANSISTRINGS} - AnsiStrings, - {$ENDIF HAS_UNIT_ANSISTRINGS} - {$ENDIF ~HAS_UNITSCOPE} - JclBase; - -// Ansi types - -type - {$IFDEF SUPPORTS_UNICODE} - TJclAnsiStringList = class; - - // Codegear should be the one providing this class, in the AnsiStrings unit. - // It has been requested in QC 65630 but this was closed as "won't do". - // So we are providing here a very light implementation that is designed - // to provide the basics, and in no way be a "copy/paste" of what is in the RTL. - TJclAnsiStrings = class(TPersistent) - private - FDelimiter: AnsiChar; - FNameValueSeparator: AnsiChar; - FStrictDelimiter: Boolean; - FQuoteChar: AnsiChar; - FUpdateCount: Integer; - function GetText: AnsiString; - procedure SetText(const Value: AnsiString); - function GetCommaText: AnsiString; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - procedure SetCommaText(const Value: AnsiString); {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - function GetDelimitedText: AnsiString; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - function GetDelimitedText(const ADelimiter: AnsiString; AQuoteChar: AnsiChar): AnsiString; overload; - procedure SetDelimitedText(const Value: AnsiString); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - procedure SetDelimitedText(const Value, ADelimiter: AnsiString; AQuoteChar: AnsiChar); overload; - function ExtractName(const S: AnsiString): AnsiString; - function GetName(Index: Integer): AnsiString; - function GetValue(const Name: AnsiString): AnsiString; - procedure SetValue(const Name, Value: AnsiString); - function GetValueFromIndex(Index: Integer): AnsiString; - procedure SetValueFromIndex(Index: Integer; const Value: AnsiString); - protected - procedure AssignTo(Dest: TPersistent); override; - - procedure Error(const Msg: string; Data: Integer); overload; - procedure Error(Msg: PResStringRec; Data: Integer); overload; - - function GetString(Index: Integer): AnsiString; virtual; abstract; - procedure SetString(Index: Integer; const Value: AnsiString); virtual; abstract; - function GetObject(Index: Integer): TObject; virtual; abstract; - procedure SetObject(Index: Integer; AObject: TObject); virtual; abstract; - - function GetCapacity: Integer; virtual; - procedure SetCapacity(const Value: Integer); virtual; - function GetCount: Integer; virtual; abstract; - function CompareStrings(const S1, S2: AnsiString): Integer; virtual; - procedure SetUpdateState(Updating: Boolean); virtual; - property UpdateCount: Integer read FUpdateCount; - public - constructor Create; - - procedure Assign(Source: TPersistent); override; - - function Add(const S: AnsiString): Integer; virtual; - function AddObject(const S: AnsiString; AObject: TObject): Integer; virtual; abstract; - procedure AddStrings(Strings: TJclAnsiStrings); virtual; - procedure Insert(Index: Integer; const S: AnsiString); virtual; - procedure InsertObject(Index: Integer; const S: AnsiString; AObject: TObject); virtual; abstract; - procedure Delete(Index: Integer); virtual; abstract; - procedure Clear; virtual; abstract; - procedure LoadFromFile(const FileName: TFileName); virtual; - procedure LoadFromStream(Stream: TStream); virtual; - procedure SaveToFile(const FileName: TFileName); virtual; - procedure SaveToStream(Stream: TStream); virtual; - procedure BeginUpdate; - procedure EndUpdate; - function IndexOf(const S: AnsiString): Integer; virtual; - function IndexOfName(const Name: AnsiString): Integer; virtual; - function IndexOfObject(AObject: TObject): Integer; virtual; - procedure Exchange(Index1, Index2: Integer); virtual; - - property Delimiter: AnsiChar read FDelimiter write FDelimiter; - property DelimitedText: AnsiString read GetDelimitedText write SetDelimitedText; - property CommaText: AnsiString read GetCommaText write SetCommaText; - property StrictDelimiter: Boolean read FStrictDelimiter write FStrictDelimiter; - property QuoteChar: AnsiChar read FQuoteChar write FQuoteChar; - - property Strings[Index: Integer]: AnsiString read GetString write SetString; default; - property Objects[Index: Integer]: TObject read GetObject write SetObject; - property Text: AnsiString read GetText write SetText; - property Count: Integer read GetCount; - property Capacity: Integer read GetCapacity write SetCapacity; - property Names[Index: Integer]: AnsiString read GetName; - property Values[const Name: AnsiString]: AnsiString read GetValue write SetValue; - property ValueFromIndex[Index: Integer]: AnsiString read GetValueFromIndex write SetValueFromIndex; - property NameValueSeparator: AnsiChar read FNameValueSeparator write FNameValueSeparator; - end; - - TJclAnsiStringListSortCompare = function(List: TJclAnsiStringList; Index1, Index2: Integer): Integer; - - TJclAnsiStringObjectHolder = record - Str: AnsiString; - Obj: TObject; - end; - - TJclAnsiStringList = class(TJclAnsiStrings) - private - FStrings: array of TJclAnsiStringObjectHolder; - FCount: Integer; - FDuplicates: TDuplicates; - FSorted: Boolean; - FCaseSensitive: Boolean; - FOnChange: TNotifyEvent; - FOnChanging: TNotifyEvent; - procedure Grow; - procedure QuickSort(L, R: Integer; SCompare: TJclAnsiStringListSortCompare); - procedure SetSorted(Value: Boolean); - protected - procedure AssignTo(Dest: TPersistent); override; - function GetString(Index: Integer): AnsiString; override; - procedure SetString(Index: Integer; const Value: AnsiString); override; - function GetObject(Index: Integer): TObject; override; - procedure SetObject(Index: Integer; AObject: TObject); override; - function GetCapacity: Integer; override; - procedure SetCapacity(const Value: Integer); override; - function GetCount: Integer; override; - function CompareStrings(const S1, S2: AnsiString): Integer; override; - procedure SetUpdateState(Updating: Boolean); override; - - procedure Changed; virtual; - procedure Changing; virtual; - public - constructor Create; - destructor Destroy; override; - - function AddObject(const S: AnsiString; AObject: TObject): Integer; override; - procedure Assign(Source: TPersistent); override; - procedure InsertObject(Index: Integer; const S: AnsiString; AObject: TObject); override; - procedure Delete(Index: Integer); override; - function Find(const S: AnsiString; var Index: Integer): Boolean; virtual; - procedure CustomSort(Compare: TJclAnsiStringListSortCompare); virtual; - procedure Sort; virtual; - procedure Clear; override; - - property CaseSensitive: Boolean read FCaseSensitive write FCaseSensitive; - property Duplicates: TDuplicates read FDuplicates write FDuplicates; - property Sorted: Boolean read FSorted write SetSorted; - - property OnChange: TNotifyEvent read FOnChange write FOnChange; - property OnChanging: TNotifyEvent read FOnChanging write FOnChanging; - end; - {$ELSE ~SUPPORTS_UNICODE} - TJclAnsiStrings = Classes.TStrings; - TJclAnsiStringList = Classes.TStringList; - {$ENDIF ~SUPPORTS_UNICODE} - - TAnsiStrings = TJclAnsiStrings; - TAnsiStringList = TJclAnsiStringList; - -// Exceptions -type - EJclAnsiStringError = class(EJclError); - EJclAnsiStringListError = class(EJclAnsiStringError); - -// Character constants and sets - -const - // Misc. often used character definitions - AnsiNull = AnsiChar(#0); - AnsiSoh = AnsiChar(#1); - AnsiStx = AnsiChar(#2); - AnsiEtx = AnsiChar(#3); - AnsiEot = AnsiChar(#4); - AnsiEnq = AnsiChar(#5); - AnsiAck = AnsiChar(#6); - AnsiBell = AnsiChar(#7); - AnsiBackspace = AnsiChar(#8); - AnsiTab = AnsiChar(#9); - AnsiLineFeed = AnsiChar(#10); - AnsiVerticalTab = AnsiChar(#11); - AnsiFormFeed = AnsiChar(#12); - AnsiCarriageReturn = AnsiChar(#13); - AnsiCrLf = AnsiString(#13#10); - AnsiSo = AnsiChar(#14); - AnsiSi = AnsiChar(#15); - AnsiDle = AnsiChar(#16); - AnsiDc1 = AnsiChar(#17); - AnsiDc2 = AnsiChar(#18); - AnsiDc3 = AnsiChar(#19); - AnsiDc4 = AnsiChar(#20); - AnsiNak = AnsiChar(#21); - AnsiSyn = AnsiChar(#22); - AnsiEtb = AnsiChar(#23); - AnsiCan = AnsiChar(#24); - AnsiEm = AnsiChar(#25); - AnsiEndOfFile = AnsiChar(#26); - AnsiEscape = AnsiChar(#27); - AnsiFs = AnsiChar(#28); - AnsiGs = AnsiChar(#29); - AnsiRs = AnsiChar(#30); - AnsiUs = AnsiChar(#31); - AnsiSpace = AnsiChar(' '); - AnsiComma = AnsiChar(','); - AnsiBackslash = AnsiChar('\'); - AnsiForwardSlash = AnsiChar('/'); - - AnsiDoubleQuote = AnsiChar('"'); - AnsiSingleQuote = AnsiChar(''''); - - {$IFDEF MSWINDOWS} - AnsiLineBreak = AnsiCrLf; - {$ENDIF MSWINDOWS} - {$IFDEF UNIX} - AnsiLineBreak = AnsiLineFeed; - {$ENDIF UNIX} - - AnsiSignMinus = AnsiChar('-'); - AnsiSignPlus = AnsiChar('+'); - - // Misc. character sets - - AnsiWhiteSpace = [AnsiTab, AnsiLineFeed, AnsiVerticalTab, - AnsiFormFeed, AnsiCarriageReturn, AnsiSpace]; - AnsiSigns = [AnsiSignMinus, AnsiSignPlus]; - AnsiUppercaseLetters = ['A'..'Z']; - AnsiLowercaseLetters = ['a'..'z']; - AnsiLetters = ['A'..'Z', 'a'..'z']; - AnsiDecDigits = ['0'..'9']; - AnsiOctDigits = ['0'..'7']; - AnsiHexDigits = ['0'..'9', 'A'..'F', 'a'..'f']; - AnsiValidIdentifierLetters = ['0'..'9', 'A'..'Z', 'a'..'z', '_']; - -const - // CharType return values - C1_UPPER = $0001; // Uppercase - C1_LOWER = $0002; // Lowercase - C1_DIGIT = $0004; // Decimal digits - C1_SPACE = $0008; // Space characters - C1_PUNCT = $0010; // Punctuation - C1_CNTRL = $0020; // Control characters - C1_BLANK = $0040; // Blank characters - C1_XDIGIT = $0080; // Hexadecimal digits - C1_ALPHA = $0100; // Any linguistic character: alphabetic, syllabary, or ideographic - - {$IFDEF MSWINDOWS} - {$IFDEF SUPPORTS_EXTSYM} - {$EXTERNALSYM C1_UPPER} - {$EXTERNALSYM C1_LOWER} - {$EXTERNALSYM C1_DIGIT} - {$EXTERNALSYM C1_SPACE} - {$EXTERNALSYM C1_PUNCT} - {$EXTERNALSYM C1_CNTRL} - {$EXTERNALSYM C1_BLANK} - {$EXTERNALSYM C1_XDIGIT} - {$EXTERNALSYM C1_ALPHA} - {$ENDIF SUPPORTS_EXTSYM} - {$ENDIF MSWINDOWS} - -// String Test Routines -function StrIsAlpha(const S: AnsiString): Boolean; -function StrIsAlphaNum(const S: AnsiString): Boolean; -function StrIsAlphaNumUnderscore(const S: AnsiString): Boolean; -function StrContainsChars(const S: AnsiString; Chars: TSysCharSet; CheckAll: Boolean): Boolean; -function StrConsistsOfNumberChars(const S: AnsiString): Boolean; -function StrIsDigit(const S: AnsiString): Boolean; -function StrIsSubset(const S: AnsiString; const ValidChars: TSysCharSet): Boolean; -function StrSame(const S1, S2: AnsiString): Boolean; - -// String Transformation Routines -function StrCenter(const S: AnsiString; L: SizeInt; C: AnsiChar = ' '): AnsiString; -function StrCharPosLower(const S: AnsiString; CharPos: SizeInt): AnsiString; -function StrCharPosUpper(const S: AnsiString; CharPos: SizeInt): AnsiString; -function StrDoubleQuote(const S: AnsiString): AnsiString; -function StrEnsureNoPrefix(const Prefix, Text: AnsiString): AnsiString; -function StrEnsureNoSuffix(const Suffix, Text: AnsiString): AnsiString; -function StrEnsurePrefix(const Prefix, Text: AnsiString): AnsiString; -function StrEnsureSuffix(const Suffix, Text: AnsiString): AnsiString; -function StrEscapedToString(const S: AnsiString): AnsiString; -function StrLower(const S: AnsiString): AnsiString; -procedure StrLowerInPlace(var S: AnsiString); -procedure StrLowerBuff(S: PAnsiChar); -procedure StrMove(var Dest: AnsiString; const Source: AnsiString; const ToIndex, - FromIndex, Count: SizeInt); -function StrPadLeft(const S: AnsiString; Len: SizeInt; C: AnsiChar = AnsiSpace): AnsiString; -function StrPadRight(const S: AnsiString; Len: SizeInt; C: AnsiChar = AnsiSpace): AnsiString; -function StrProper(const S: AnsiString): AnsiString; -procedure StrProperBuff(S: PAnsiChar); -function StrQuote(const S: AnsiString; C: AnsiChar): AnsiString; -function StrRemoveChars(const S: AnsiString; const Chars: TSysCharSet): AnsiString; -function StrKeepChars(const S: AnsiString; const Chars: TSysCharSet): AnsiString; -procedure StrReplace(var S: AnsiString; const Search, Replace: AnsiString; Flags: TReplaceFlags = []); -function StrReplaceChar(const S: AnsiString; const Source, Replace: AnsiChar): AnsiString; -function StrReplaceChars(const S: AnsiString; const Chars: TSysCharSet; Replace: AnsiChar): AnsiString; -function StrReplaceButChars(const S: AnsiString; const Chars: TSysCharSet; Replace: AnsiChar): AnsiString; -function StrRepeat(const S: AnsiString; Count: SizeInt): AnsiString; -function StrRepeatLength(const S: AnsiString; const L: SizeInt): AnsiString; -function StrReverse(const S: AnsiString): AnsiString; -procedure StrReverseInPlace(var S: AnsiString); -function StrSingleQuote(const S: AnsiString): AnsiString; -procedure StrSkipChars(var S: PAnsiChar; const Chars: TSysCharSet); overload; -procedure StrSkipChars(const S: AnsiString; var Index: SizeInt; const Chars: TSysCharSet); overload; -function StrSmartCase(const S: AnsiString; Delimiters: TSysCharSet): AnsiString; -function StrStringToEscaped(const S: AnsiString): AnsiString; -function StrStripNonNumberChars(const S: AnsiString): AnsiString; -function StrToHex(const Source: AnsiString): AnsiString; -function StrTrimCharLeft(const S: AnsiString; C: AnsiChar): AnsiString; -function StrTrimCharsLeft(const S: AnsiString; const Chars: TSysCharSet): AnsiString; -function StrTrimCharRight(const S: AnsiString; C: AnsiChar): AnsiString; -function StrTrimCharsRight(const S: AnsiString; const Chars: TSysCharSet): AnsiString; -function StrTrimQuotes(const S: AnsiString): AnsiString; overload; -function StrTrimQuotes(const S: AnsiString; QuoteChar: AnsiChar): AnsiString; overload; -function StrUpper(const S: AnsiString): AnsiString; -procedure StrUpperInPlace(var S: AnsiString); -procedure StrUpperBuff(S: PAnsiChar); - -{$IFDEF MSWINDOWS} -function StrOemToAnsi(const S: AnsiString): AnsiString; -function StrAnsiToOem(const S: AnsiString): AnsiString; -{$ENDIF MSWINDOWS} - -// String Management -procedure StrAddRef(var S: AnsiString); -procedure StrDecRef(var S: AnsiString); -function StrLength(const S: AnsiString): Longint; -function StrRefCount(const S: AnsiString): Longint; -procedure StrResetLength(var S: AnsiString); - -// String Search and Replace Routines -function StrCharCount(const S: AnsiString; C: AnsiChar): SizeInt; -function StrCharsCount(const S: AnsiString; Chars: TSysCharSet): SizeInt; -function StrStrCount(const S, SubS: AnsiString): SizeInt; -function StrCompare(const S1, S2: AnsiString; CaseSensitive: Boolean = False): SizeInt; -function StrCompareRangeEx(const S1, S2: AnsiString; Index, Count: SizeInt; CaseSensitive: Boolean = False): SizeInt; -function StrCompareRange(const S1, S2: AnsiString; Index, Count: SizeInt; CaseSensitive: Boolean = True): SizeInt; -function StrRepeatChar(C: AnsiChar; Count: SizeInt): AnsiString; -function StrFind(const Substr, S: AnsiString; const Index: SizeInt = 1): SizeInt; -function StrHasPrefix(const S: AnsiString; const Prefixes: array of AnsiString): Boolean; -function StrHasSuffix(const S: AnsiString; const Suffixes: array of AnsiString): Boolean; -function StrIHasPrefix(const S: AnsiString; const Prefixes: array of AnsiString): Boolean; -function StrIHasSuffix(const S: AnsiString; const Suffixes: array of AnsiString): Boolean; -function StrIndex(const S: AnsiString; const List: array of AnsiString; CaseSensitive: Boolean = False): SizeInt; -function StrILastPos(const SubStr, S: AnsiString): SizeInt; -function StrIPos(const SubStr, S: AnsiString): SizeInt; -function StrIPrefixIndex(const S: AnsiString; const Prefixes: array of AnsiString): SizeInt; -function StrIsOneOf(const S: AnsiString; const List: array of AnsiString): Boolean; -function StrISuffixIndex(const S: AnsiString; const Suffixes: array of AnsiString): SizeInt; -function StrLastPos(const SubStr, S: AnsiString): SizeInt; -function StrMatch(const Substr, S: AnsiString; Index: SizeInt = 1): SizeInt; -function StrMatches(const Substr, S: AnsiString; const Index: SizeInt = 1): Boolean; -function StrNIPos(const S, SubStr: AnsiString; N: SizeInt): SizeInt; -function StrNPos(const S, SubStr: AnsiString; N: SizeInt): SizeInt; -function StrPrefixIndex(const S: AnsiString; const Prefixes: array of AnsiString): SizeInt; -function StrSearch(const Substr, S: AnsiString; const Index: SizeInt = 1): SizeInt; -function StrSuffixIndex(const S: AnsiString; const Suffixes: array of AnsiString): SizeInt; - -// String Extraction -// String Extraction -// Returns the String before SubStr -function StrAfter(const SubStr, S: AnsiString): AnsiString; -/// Returns the AnsiString after SubStr -function StrBefore(const SubStr, S: AnsiString): AnsiString; -/// Splits a AnsiString at SubStr, returns true when SubStr is found, Left contains the -/// AnsiString before the SubStr and Rigth the AnsiString behind SubStr -function StrSplit(const SubStr, S: AnsiString;var Left, Right : AnsiString): boolean; -/// Returns the AnsiString between Start and Stop -function StrBetween(const S: AnsiString; const Start, Stop: AnsiChar): AnsiString; -/// Returns the left N characters of the AnsiString -function StrChopRight(const S: AnsiString; N: SizeInt): AnsiString; -/// Returns the left Count characters of the AnsiString -function StrLeft(const S: AnsiString; Count: SizeInt): AnsiString; -/// Returns the AnsiString starting from position Start for the Count Characters -function StrMid(const S: AnsiString; Start, Count: SizeInt): AnsiString; -/// Returns the AnsiString starting from position N to the end -function StrRestOf(const S: AnsiString; N: SizeInt): AnsiString; -/// Returns the right Count characters of the AnsiString -function StrRight(const S: AnsiString; Count: SizeInt): AnsiString; - -// Character Test Routines -function CharEqualNoCase(const C1, C2: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsAlpha(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsAlphaNum(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsBlank(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsControl(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsDelete(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsDigit(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsFracDigit(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsHexDigit(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsLower(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsNumberChar(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsNumber(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsPrintable(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsPunctuation(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsReturn(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsSpace(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsUpper(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsValidIdentifierLetter(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsWhiteSpace(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsWildcard(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharType(const C: AnsiChar): Word; - -// Character Transformation Routines -function CharHex(const C: AnsiChar): Byte; -function CharLower(const C: AnsiChar): AnsiChar; -function CharUpper(const C: AnsiChar): AnsiChar; -function CharToggleCase(const C: AnsiChar): AnsiChar; - -// Character Search and Replace -function CharPos(const S: AnsiString; const C: AnsiChar; const Index: SizeInt = 1): SizeInt; -function CharLastPos(const S: AnsiString; const C: AnsiChar; const Index: SizeInt = 1): SizeInt; -function CharIPos(const S: AnsiString; C: AnsiChar; const Index: SizeInt = 1): SizeInt; -function CharReplace(var S: AnsiString; const Search, Replace: AnsiChar): SizeInt; - -// PCharVector -type - PAnsiCharVector = ^PAnsiChar; - -function StringsToPCharVector(var Dest: PAnsiCharVector; const Source: TJclAnsiStrings): PAnsiCharVector; -function PCharVectorCount(Source: PAnsiCharVector): SizeInt; -procedure PCharVectorToStrings(const Dest: TJclAnsiStrings; Source: PAnsiCharVector); -procedure FreePCharVector(var Dest: PAnsiCharVector); - -// MultiSz Routines -type - PAnsiMultiSz = PAnsiChar; - -function StringsToMultiSz(var Dest: PAnsiMultiSz; const Source: TJclAnsiStrings): PAnsiMultiSz; -procedure MultiSzToStrings(const Dest: TJclAnsiStrings; const Source: PAnsiMultiSz); -function MultiSzLength(const Source: PAnsiMultiSz): SizeInt; -procedure AllocateMultiSz(var Dest: PAnsiMultiSz; Len: SizeInt); -procedure FreeMultiSz(var Dest: PAnsiMultiSz); -function MultiSzDup(const Source: PAnsiMultiSz): PAnsiMultiSz; - -// TJclAnsiStrings Manipulation -procedure StrIToStrings(S, Sep: AnsiString; const List: TJclAnsiStrings; const AllowEmptyString: Boolean = True); -procedure StrToStrings(S, Sep: AnsiString; const List: TJclAnsiStrings; const AllowEmptyString: Boolean = True); -function StringsToStr(const List: TJclAnsiStrings; const Sep: AnsiString; const AllowEmptyString: Boolean = True): AnsiString; -procedure TrimStrings(const List: TJclAnsiStrings; DeleteIfEmpty: Boolean = True); -procedure TrimStringsRight(const List: TJclAnsiStrings; DeleteIfEmpty: Boolean = True); -procedure TrimStringsLeft(const List: TJclAnsiStrings; DeleteIfEmpty: Boolean = True); -function AddStringToStrings(const S: AnsiString; Strings: TJclAnsiStrings; const Unique: Boolean): Boolean; - -// Miscellaneous -// (OF) moved to JclSysUtils -//function BooleanToStr(B: Boolean): AnsiString; -function FileToString(const FileName: TFileName): AnsiString; -procedure StringToFile(const FileName: TFileName; const Contents: AnsiString; Append: Boolean = False); -function StrToken(var S: AnsiString; Separator: AnsiChar): AnsiString; -procedure StrTokens(const S: AnsiString; const List: TJclAnsiStrings); -procedure StrTokenToStrings(S: AnsiString; Separator: AnsiChar; const List: TJclAnsiStrings); -function StrWord(const S: AnsiString; var Index: SizeInt; out Word: AnsiString): Boolean; overload; -function StrWord(var S: PAnsiChar; out Word: AnsiString): Boolean; overload; -function StrIdent(const S: AnsiString; var Index: SizeInt; out Ident: AnsiString): Boolean; overload; -function StrIdent(var S: PAnsiChar; out Ident: AnsiString): Boolean; overload; -function StrToFloatSafe(const S: AnsiString): Float; -function StrToIntSafe(const S: AnsiString): Integer; -procedure StrNormIndex(const StrLen: SizeInt; var Index: SizeInt; var Count: SizeInt); overload; - -function ArrayOf(List: TJclAnsiStrings): TDynStringArray; overload; - -function AnsiCompareNaturalStr(const S1, S2: AnsiString): SizeInt; -function AnsiCompareNaturalText(const S1, S2: AnsiString): SizeInt; - -// Explicit ANSI version of former/deprecated SysUtils PAnsiChar functions -{$IFNDEF DEPRECATED_SYSUTILS_ANSISTRINGS} - {$IFDEF SUPPORTS_INLINE} - {$DEFINE ANSI_INLINE} // inline if the functions are in SysUtils but don't force the user to include System.AnsiStrings - {$ENDIF SUPPORTS_INLINE} -{$ENDIF ~DEPRECATED_SYSUTILS_ANSISTRINGS} -function StrNewA(const Str: PAnsiChar): PAnsiChar; {$IFDEF ANSI_INLINE}inline;{$ENDIF} -procedure StrDisposeA(Str: PAnsiChar); {$IFDEF ANSI_INLINE}inline;{$ENDIF} - -function StrLenA(S: PAnsiChar): Integer; {$IFDEF ANSI_INLINE}inline;{$ENDIF} -function StrEndA(const Str: PAnsiChar): PAnsiChar; {$IFDEF ANSI_INLINE}inline;{$ENDIF} -function StrPosA(const Str1, Str2: PAnsiChar): PAnsiChar; {$IFDEF ANSI_INLINE}inline;{$ENDIF} -function StrPasA(const Str: PAnsiChar): AnsiString; {$IFDEF ANSI_INLINE}inline;{$ENDIF} -function StrCopyA(Dest: PAnsiChar; const Source: PAnsiChar): PAnsiChar; {$IFDEF ANSI_INLINE}inline;{$ENDIF} -function StrLCopyA(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar; {$IFDEF ANSI_INLINE}inline;{$ENDIF} -function StrPCopyA(Dest: PAnsiChar; const Source: AnsiString): PAnsiChar; {$IFDEF ANSI_INLINE}inline;{$ENDIF} -function StrPLCopyA(Dest: PAnsiChar; const Source: AnsiString; MaxLen: Cardinal): PAnsiChar; {$IFDEF ANSI_INLINE}inline;{$ENDIF} -function StrECopyA(Dest: PAnsiChar; const Source: PAnsiChar): PAnsiChar; {$IFDEF ANSI_INLINE}inline;{$ENDIF} -function StrCatA(Dest: PAnsiChar; const Source: PAnsiChar): PAnsiChar; {$IFDEF ANSI_INLINE}inline;{$ENDIF} -function StrLCatA(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar; {$IFDEF ANSI_INLINE}inline;{$ENDIF} -function StrCompA(const Str1, Str2: PAnsiChar): Integer; {$IFDEF ANSI_INLINE}inline;{$ENDIF} -function StrLCompA(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer; {$IFDEF ANSI_INLINE}inline;{$ENDIF} -function StrICompA(const Str1, Str2: PAnsiChar): Integer; {$IFDEF ANSI_INLINE}inline;{$ENDIF} -function StrLICompA(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer; {$IFDEF ANSI_INLINE}inline;{$ENDIF} - -function StrFmtA(Buffer, Format: PAnsiChar; const Args: array of const): PAnsiChar; - -function AnsiStrPosA(const Str1, Str2: PAnsiChar): PAnsiChar; {$IFDEF ANSI_INLINE}inline;{$ENDIF} -function AnsiStrLICompA(S1, S2: PAnsiChar; MaxLen: Cardinal): Integer; {$IFDEF ANSI_INLINE}inline;{$ENDIF} -function AnsiStrLCompA(S1, S2: PAnsiChar; MaxLen: Cardinal): Integer; {$IFDEF ANSI_INLINE}inline;{$ENDIF} - - -// internal structures published to make function inlining working -const - AnsiCharCount = Ord(High(AnsiChar)) + 1; // # of chars in one set - AnsiLoOffset = AnsiCharCount * 0; // offset to lower case chars - AnsiUpOffset = AnsiCharCount * 1; // offset to upper case chars - AnsiReOffset = AnsiCharCount * 2; // offset to reverse case chars - AnsiCaseMapSize = AnsiCharCount * 3; // # of chars is a table - -var - AnsiCaseMap: array [0..AnsiCaseMapSize - 1] of AnsiChar; // case mappings - AnsiCaseMapReady: Boolean = False; // true if case map exists - AnsiCharTypes: array [AnsiChar] of Word; - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\common'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -uses - {$IFDEF HAS_UNIT_LIBC} - Libc, - {$ENDIF HAS_UNIT_LIBC} - {$IFDEF SUPPORTS_UNICODE} - {$IFDEF HAS_UNIT_RTLCONSTS} - {$IFDEF HAS_UNITSCOPE} - System.RTLConsts, - {$ELSE ~HAS_UNITSCOPE} - RtlConsts, - {$ENDIF} - {$ENDIF HAS_UNIT_RTLCONSTS} - {$ENDIF SUPPORTS_UNICODE} - JclLogic, JclResources, JclStreams, JclSynch, JclSysUtils; - -//=== Internal =============================================================== - -type - TAnsiStrRec = packed record - RefCount: Integer; - Length: Integer; - end; - PAnsiStrRec = ^TAnsiStrRec; - -const - AnsiStrRecSize = SizeOf(TAnsiStrRec); // size of the AnsiString header rec - -procedure LoadCharTypes; -var - CurrChar: AnsiChar; - CurrType: Word; -begin - for CurrChar := Low(AnsiChar) to High(AnsiChar) do - begin - {$IFDEF MSWINDOWS} - CurrType := 0; - GetStringTypeExA(LOCALE_USER_DEFAULT, CT_CTYPE1, @CurrChar, SizeOf(AnsiChar), CurrType); - {$DEFINE CHAR_TYPES_INITIALIZED} - {$ENDIF MSWINDOWS} - {$IFDEF LINUX} - CurrType := 0; - if isupper(Byte(CurrChar)) <> 0 then - CurrType := CurrType or C1_UPPER; - if islower(Byte(CurrChar)) <> 0 then - CurrType := CurrType or C1_LOWER; - if isdigit(Byte(CurrChar)) <> 0 then - CurrType := CurrType or C1_DIGIT; - if isspace(Byte(CurrChar)) <> 0 then - CurrType := CurrType or C1_SPACE; - if ispunct(Byte(CurrChar)) <> 0 then - CurrType := CurrType or C1_PUNCT; - if iscntrl(Byte(CurrChar)) <> 0 then - CurrType := CurrType or C1_CNTRL; - if isblank(Byte(CurrChar)) <> 0 then - CurrType := CurrType or C1_BLANK; - if isxdigit(Byte(CurrChar)) <> 0 then - CurrType := CurrType or C1_XDIGIT; - if isalpha(Byte(CurrChar)) <> 0 then - CurrType := CurrType or C1_ALPHA; - {$DEFINE CHAR_TYPES_INITIALIZED} - {$ENDIF LINUX} - AnsiCharTypes[CurrChar] := CurrType; - {$IFNDEF CHAR_TYPES_INITIALIZED} - Implement case map initialization here - {$ENDIF ~CHAR_TYPES_INITIALIZED} - end; -end; - -procedure LoadCaseMap; -var - CurrChar, UpCaseChar, LoCaseChar, ReCaseChar: AnsiChar; -begin - if not AnsiCaseMapReady then - begin - for CurrChar := Low(AnsiChar) to High(AnsiChar) do - begin - {$IFDEF MSWINDOWS} - LoCaseChar := CurrChar; - UpCaseChar := CurrChar; - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CharLowerBuffA(@LoCaseChar, 1); - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CharUpperBuffA(@UpCaseChar, 1); - {$DEFINE CASE_MAP_INITIALIZED} - {$ENDIF MSWINDOWS} - {$IFDEF LINUX} - LoCaseChar := AnsiChar(tolower(Byte(CurrChar))); - UpCaseChar := AnsiChar(toupper(Byte(CurrChar))); - {$DEFINE CASE_MAP_INITIALIZED} - {$ENDIF LINUX} - {$IFNDEF CASE_MAP_INITIALIZED} - Implement case map initialization here - {$ENDIF ~CASE_MAP_INITIALIZED} - if CharIsUpper(CurrChar) then - ReCaseChar := LoCaseChar - else - if CharIsLower(CurrChar) then - ReCaseChar := UpCaseChar - else - ReCaseChar := CurrChar; - AnsiCaseMap[Ord(CurrChar) + AnsiLoOffset] := LoCaseChar; - AnsiCaseMap[Ord(CurrChar) + AnsiUpOffset] := UpCaseChar; - AnsiCaseMap[Ord(CurrChar) + AnsiReOffset] := ReCaseChar; - end; - AnsiCaseMapReady := True; - end; -end; - -// Uppercases or Lowercases a give AnsiString depending on the -// passed offset. (UpOffset or LoOffset) - -procedure StrCase(var Str: AnsiString; const Offset: SizeInt); -var - P: PAnsiChar; - I, L: SizeInt; -begin - if Str <> '' then - begin - UniqueString(Str); - P := PAnsiChar(Str); - L := Length(Str); - for I := 1 to L do - begin - P^ := AnsiCaseMap[Offset + Ord(P^)]; - Inc(P); - end; - end; -end; - -// Internal utility function -// Uppercases or Lowercases a give null terminated string depending on the -// passed offset. (UpOffset or LoOffset) - -procedure StrCaseBuff(S: PAnsiChar; const Offset: SizeInt); -begin - if (S <> nil) and (S^ <> #0) then - begin - repeat - S^ := AnsiCaseMap[Offset + Ord(S^)]; - Inc(S); - until S^ = #0; - end; -end; - -{$IFDEF SUPPORTS_UNICODE} - -//=== { TJclAnsiStrings } ==================================================== - -constructor TJclAnsiStrings.Create; -begin - inherited Create; - - FDelimiter := ','; - FNameValueSeparator := '='; - FQuoteChar := '"'; - FStrictDelimiter := False; -end; - -procedure TJclAnsiStrings.Assign(Source: TPersistent); -var - StringsSource: TStrings; - I: Integer; -begin - if Source is TStrings then - begin - StringsSource := TStrings(Source); - BeginUpdate; - try - Clear; - FDelimiter := AnsiChar(StringsSource.Delimiter); - FNameValueSeparator := AnsiChar(StringsSource.NameValueSeparator); - for I := 0 to StringsSource.Count - 1 do - AddObject(AnsiString(StringsSource.Strings[I]), StringsSource.Objects[I]); - finally - EndUpdate; - end; - end - else - inherited Assign(Source); -end; - -procedure TJclAnsiStrings.AssignTo(Dest: TPersistent); -var - StringsDest: TStrings; - AnsiStringsDest: TJclAnsiStrings; - I: Integer; -begin - if Dest is TStrings then - begin - StringsDest := TStrings(Dest); - StringsDest.BeginUpdate; - try - StringsDest.Clear; - StringsDest.Delimiter := Char(Delimiter); - StringsDest.NameValueSeparator := Char(NameValueSeparator); - for I := 0 to Count - 1 do - StringsDest.AddObject(string(Strings[I]), Objects[I]); - finally - StringsDest.EndUpdate; - end; - end - else - if Dest is TJclAnsiStrings then - begin - AnsiStringsDest := TJclAnsiStrings(Dest); - AnsiStringsDest.BeginUpdate; - try - AnsiStringsDest.Clear; - AnsiStringsDest.FNameValueSeparator := FNameValueSeparator; - AnsiStringsDest.FDelimiter := FDelimiter; - for I := 0 to Count - 1 do - AnsiStringsDest.AddObject(Strings[I], Objects[I]); - finally - AnsiStringsDest.EndUpdate; - end; - end - else - inherited AssignTo(Dest); -end; - -function TJclAnsiStrings.Add(const S: AnsiString): Integer; -begin - Result := AddObject(S, nil); -end; - -procedure TJclAnsiStrings.AddStrings(Strings: TJclAnsiStrings); -var - I: Integer; -begin - for I := 0 to Strings.Count - 1 do - Add(Strings.Strings[I]); -end; - -procedure TJclAnsiStrings.Error(const Msg: string; Data: Integer); -begin - raise EJclAnsiStringListError.CreateFmt(Msg, [Data]); -end; - -procedure TJclAnsiStrings.Error(Msg: PResStringRec; Data: Integer); -begin - Error(LoadResString(Msg), Data); -end; - -function TJclAnsiStrings.CompareStrings(const S1, S2: AnsiString): Integer; -begin - Result := CompareStr(S1, S2); -end; - -procedure TJclAnsiStrings.SetUpdateState(Updating: Boolean); -begin -end; - -function TJclAnsiStrings.IndexOf(const S: AnsiString): Integer; -begin - for Result := 0 to Count - 1 do - if CompareStrings(Strings[Result], S) = 0 then - Exit; - Result := -1; -end; - -function TJclAnsiStrings.IndexOfName(const Name: AnsiString): Integer; -var - P: Integer; - S: AnsiString; -begin - for Result := 0 to Count - 1 do - begin - S := Strings[Result]; - P := AnsiPos(NameValueSeparator, S); - if (P > 0) and (CompareStrings(Copy(S, 1, P - 1), Name) = 0) then - Exit; - end; - Result := -1; -end; - -function TJclAnsiStrings.IndexOfObject(AObject: TObject): Integer; -begin - for Result := 0 to Count - 1 do - if Objects[Result] = AObject then - Exit; - Result := -1; -end; - -procedure TJclAnsiStrings.Exchange(Index1, Index2: Integer); -var - TempString: AnsiString; - TempObject: TObject; -begin - BeginUpdate; - try - TempString := Strings[Index1]; - TempObject := Objects[Index1]; - Strings[Index1] := Strings[Index2]; - Objects[Index1] := Objects[Index2]; - Strings[Index2] := TempString; - Objects[Index2] := TempObject; - finally - EndUpdate; - end; -end; - -function TJclAnsiStrings.GetCommaText: AnsiString; -begin - Result := GetDelimitedText(AnsiComma, AnsiDoubleQuote); -end; - -function TJclAnsiStrings.GetDelimitedText: AnsiString; -begin - Result := GetDelimitedText(Delimiter, QuoteChar); -end; - -function TJclAnsiStrings.GetDelimitedText(const ADelimiter: AnsiString; AQuoteChar: AnsiChar): AnsiString; - - function Quoted(Item: AnsiString): AnsiString; - begin - if (not StrictDelimiter) and ((Pos(AnsiSpace, Item) > 0) or (Pos(FQuoteChar, Item) > 0)) then - begin - Result := AnsiQuotedStr(Item, AQuoteChar); - end - else - Result := Item; - end; - -var - I: Integer; -begin - Result := ''; - for I := 0 to Count - 2 do - Result := Result + Quoted(Strings[I]) + ADelimiter; - if Count > 0 then - Result := Result + Quoted(Strings[Count - 1]); -end; - -procedure TJclAnsiStrings.Insert(Index: Integer; const S: AnsiString); -begin - InsertObject(Index, S, nil); -end; - -procedure TJclAnsiStrings.SetCommaText(const Value: AnsiString); -begin - SetDelimitedText(Value, AnsiComma, AnsiDoubleQuote); -end; - -procedure TJclAnsiStrings.SetDelimitedText(const Value: AnsiString); -begin - SetDelimitedText(Value, Delimiter, QuoteChar); -end; - -procedure TJclAnsiStrings.SetDelimitedText(const Value, ADelimiter: AnsiString; AQuoteChar: AnsiChar); - - procedure InternalAdd(Item: AnsiString); - begin - Item := StrTrimQuotes(Item, AQuoteChar); - StrReplace(Item, AQuoteChar + AQuoteChar, AQuoteChar, [rfReplaceAll]); - Add(Item); - end; - -var - ValueLength, LastStart, Index, QuoteCharCount: Integer; - ValueChar: AnsiChar; -begin - Clear; - LastStart := 1; - QuoteCharCount := 0; - ValueLength := Length(Value); - for Index := 1 to ValueLength do - begin - ValueChar := Value[Index]; - if ValueChar = AQuoteChar then - Inc(QuoteCharCount); - if ((ValueChar = ADelimiter) or ((ValueChar = ' ') and (not StrictDelimiter))) - and ((not Odd(QuoteCharCount) or (QuoteCharCount = 0))) then - begin - if StrictDelimiter then - Add(Copy(Value, LastStart, Index - LastStart)) - else - InternalAdd(Copy(Value, LastStart, Index - LastStart)); - QuoteCharCount := 0; - LastStart := Index + 1; - end; - if (Index = ValueLength) and (LastStart <= ValueLength) then - begin - if StrictDelimiter then - Add(Copy(Value, LastStart, ValueLength - LastStart + 1)) - else - InternalAdd(Copy(Value, LastStart, Index - LastStart + 1)); - end; - end; -end; - -function TJclAnsiStrings.GetText: AnsiString; -var - I: Integer; -begin - Result := ''; - for I := 0 to Count - 2 do - Result := Result + Strings[I] + AnsiLineBreak; - if Count > 0 then - Result := Result + Strings[Count - 1] + AnsiLineBreak; -end; - -procedure TJclAnsiStrings.SetText(const Value: AnsiString); -var - Index, Start, Len: Integer; - S: AnsiString; -begin - Clear; - Len := Length(Value); - Index := 1; - while Index <= Len do - begin - Start := Index; - while (Index <= Len) and not CharIsReturn(Value[Index]) do - Inc(Index); - - S := Copy(Value, Start, Index - Start); - Add(S); - - if (Index <= Len) and (Value[Index] = AnsiCarriageReturn) then - Inc(Index); - if (Index <= Len) and (Value[Index] = AnsiLineFeed) then - Inc(Index); - end; -end; - -function TJclAnsiStrings.GetCapacity: Integer; -begin - Result := Count; // Might be overridden in derived classes -end; - -procedure TJclAnsiStrings.SetCapacity(const Value: Integer); -begin - // Nothing at this level -end; - -procedure TJclAnsiStrings.BeginUpdate; -begin - if FUpdateCount = 0 then SetUpdateState(True); - Inc(FUpdateCount); -end; - -procedure TJclAnsiStrings.EndUpdate; -begin - Dec(FUpdateCount); - if FUpdateCount = 0 then SetUpdateState(False); -end; - -procedure TJclAnsiStrings.LoadFromFile(const FileName: TFileName); -var - Stream: TStream; -begin - Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); - try - LoadFromStream(Stream); - finally - Stream.Free; - end; -end; - -procedure TJclAnsiStrings.LoadFromStream(Stream: TStream); -var - Size: Integer; - S: AnsiString; -begin - BeginUpdate; - try - Size := Stream.Size - Stream.Position; - System.SetString(S, nil, Size); - Stream.Read(PAnsiChar(S)^, Size); - SetText(S); - finally - EndUpdate; - end; -end; - -procedure TJclAnsiStrings.SaveToFile(const FileName: TFileName); -var - Stream: TStream; -begin - Stream := TFileStream.Create(FileName, fmCreate); - try - SaveToStream(Stream); - finally - Stream.Free; - end; -end; - -procedure TJclAnsiStrings.SaveToStream(Stream: TStream); -var - S: AnsiString; -begin - S := GetText; - Stream.WriteBuffer(PAnsiChar(S)^, Length(S)); -end; - -function TJclAnsiStrings.ExtractName(const S: AnsiString): AnsiString; -var - P: Integer; -begin - Result := S; - P := AnsiPos(NameValueSeparator, Result); - if P > 0 then - SetLength(Result, P - 1) - else - SetLength(Result, 0); -end; - -function TJclAnsiStrings.GetName(Index: Integer): AnsiString; -begin - Result := ExtractName(Strings[Index]); -end; - -function TJclAnsiStrings.GetValue(const Name: AnsiString): AnsiString; -var - I: Integer; -begin - I := IndexOfName(Name); - if I >= 0 then - Result := Copy(GetString(I), Length(Name) + 2, MaxInt) - else - Result := ''; -end; - -procedure TJclAnsiStrings.SetValue(const Name, Value: AnsiString); -var - I: Integer; -begin - I := IndexOfName(Name); - if Value <> '' then - begin - if I < 0 then - I := Add(''); - SetString(I, Name + NameValueSeparator + Value); - end - else - begin - if I >= 0 then - Delete(I); - end; -end; - -function TJclAnsiStrings.GetValueFromIndex(Index: Integer): AnsiString; -var - S: AnsiString; - P: Integer; -begin - if Index >= 0 then - begin - S := Strings[Index]; - P := AnsiPos(NameValueSeparator, S); - if P > 0 then - Result := Copy(S, P + 1, Length(S) - P) - else - Result := ''; - end - else - Result := ''; -end; - -procedure TJclAnsiStrings.SetValueFromIndex(Index: Integer; const Value: AnsiString); -begin - if Value <> '' then - begin - if Index < 0 then - Index := Add(''); - SetString(Index, Names[Index] + NameValueSeparator + Value); - end - else - begin - if Index >= 0 then - Delete(Index); - end; -end; - -//=== { TJclAnsiStringList } ================================================= - -constructor TJclAnsiStringList.Create; -begin - inherited Create; - FCaseSensitive := True; -end; - -destructor TJclAnsiStringList.Destroy; -begin - FOnChange := nil; - FOnChanging := nil; - - inherited Destroy; -end; - -procedure TJclAnsiStringList.Assign(Source: TPersistent); -var - StringListSource: TStringList; -begin - if Source is TStringList then - begin - StringListSource := TStringList(Source); - FDuplicates := StringListSource.Duplicates; - FSorted := StringListSource.Sorted; - FCaseSensitive := StringListSource.CaseSensitive; - end; - inherited Assign(Source); -end; - -procedure TJclAnsiStringList.AssignTo(Dest: TPersistent); -var - StringListDest: TStringList; - AnsiStringListDest: TJclAnsiStringList; -begin - if Dest is TStringList then - begin - StringListDest := TStringList(Dest); - StringListDest.Clear; // make following assignments a lot faster - StringListDest.Duplicates := FDuplicates; - StringListDest.Sorted := FSorted; - StringListDest.CaseSensitive := FCaseSensitive; - end - else - if Dest is TJclAnsiStringList then - begin - AnsiStringListDest := TJclAnsiStringList(Dest); - AnsiStringListDest.Clear; - AnsiStringListDest.FDuplicates := FDuplicates; - AnsiStringListDest.FSorted := FSorted; - AnsiStringListDest.FCaseSensitive := FCaseSensitive; - end; - inherited AssignTo(Dest); -end; - -function TJclAnsiStringList.CompareStrings(const S1: AnsiString; const S2: AnsiString): Integer; -begin - if FCaseSensitive then - Result := CompareStr(S1, S2) - else - Result := CompareText(S1, S2); -end; - -procedure TJclAnsiStringList.SetUpdateState(Updating: Boolean); -begin - if Updating then Changing else Changed; -end; - -procedure TJclAnsiStringList.Changed; -begin - if (FUpdateCount = 0) and Assigned(FOnChange) then - FOnChange(Self); -end; - -procedure TJclAnsiStringList.Changing; -begin - if (FUpdateCount = 0) and Assigned(FOnChanging) then - FOnChanging(Self); -end; - -procedure TJclAnsiStringList.Grow; -var - Delta: Integer; -begin - if Capacity > 64 then - Delta := Capacity div 4 - else if Capacity > 8 then - Delta := 16 - else - Delta := 4; - - SetCapacity(Capacity + Delta); -end; - -function TJclAnsiStringList.GetString(Index: Integer): AnsiString; -begin - if (Index < 0) or (Index >= FCount) then - Error(@SListIndexError, Index); - - Result := FStrings[Index].Str; -end; - -procedure TJclAnsiStringList.SetString(Index: Integer; const Value: AnsiString); -begin - if Sorted then - Error(@SSortedListError, 0); - - if (Index < 0) or (Index >= FCount) then - Error(@SListIndexError, Index); - - FStrings[Index].Str := Value; -end; - -function TJclAnsiStringList.GetObject(Index: Integer): TObject; -begin - if (Index < 0) or (Index >= FCount) then - Error(@SListIndexError, Index); - - Result := FStrings[Index].Obj; -end; - -procedure TJclAnsiStringList.SetObject(Index: Integer; AObject: TObject); -begin - if (Index < 0) or (Index >= FCount) then - Error(@SListIndexError, Index); - - FStrings[Index].Obj := AObject; -end; - -function TJclAnsiStringList.GetCapacity: Integer; -begin - Result := Length(FStrings); -end; - -procedure TJclAnsiStringList.SetCapacity(const Value: Integer); -begin - if (Value < FCount) then - Error(@SListCapacityError, Value); - - if Value <> Capacity then - SetLength(FStrings, Value); -end; - -function TJclAnsiStringList.GetCount: Integer; -begin - Result := FCount; -end; - -procedure TJclAnsiStringList.InsertObject(Index: Integer; const S: AnsiString; AObject: TObject); -var - I: Integer; -begin - if Count = Capacity then - Grow; - - for I := Count - 1 downto Index do - FStrings[I + 1] := FStrings[I]; - - FStrings[Index].Str := S; - FStrings[Index].Obj := AObject; - Inc(FCount); -end; - -function TJclAnsiStringList.AddObject(const S: AnsiString; AObject: TObject): Integer; -var - Found: Boolean; -begin - if not Sorted then - Result := Count - else - begin - Found := Find(S, Result); - case Duplicates of - dupAccept: ; - dupIgnore: - if Found then - Exit; - dupError: - if Found then - Error(@SDuplicateString, 0); - end; - end; - - InsertObject(Result, S, AObject); -end; - -procedure TJclAnsiStringList.Delete(Index: Integer); -var - I: Integer; -begin - if (Index < 0) or (Index >= FCount) then - Error(@SListIndexError, Index); - - for I := Index to Count - 2 do - FStrings[I] := FStrings[I + 1]; - - FStrings[FCount - 1].Str := ''; // the last string is no longer useful - - Dec(FCount); -end; - -procedure TJclAnsiStringList.Clear; -var - I: Integer; -begin - FCount := 0; - for I := 0 to Length(FStrings) - 1 do - begin - FStrings[I].Str := ''; - FStrings[I].Obj := nil; - end; -end; - -function TJclAnsiStringList.Find(const S: AnsiString; var Index: Integer): Boolean; -var - L, H, I, C: Integer; -begin - Result := False; - L := 0; - H := FCount - 1; - while L <= H do - begin - I := (L + H) shr 1; - C := CompareStrings(FStrings[I].Str, S); - if C < 0 then - L := I + 1 - else - begin - H := I - 1; - if C = 0 then - begin - Result := True; - if Duplicates <> dupAccept then - L := I; - end; - end; - end; - Index := L; -end; - -function AnsiStringListCompareStrings(List: TJclAnsiStringList; Index1, Index2: Integer): Integer; -begin - Result := List.CompareStrings(List.FStrings[Index1].Str, - List.FStrings[Index2].Str); -end; - -procedure TJclAnsiStringList.Sort; -begin - CustomSort(AnsiStringListCompareStrings); -end; - -procedure TJclAnsiStringList.CustomSort(Compare: TJclAnsiStringListSortCompare); -begin - if not Sorted and (FCount > 1) then - QuickSort(0, FCount - 1, Compare); -end; - -procedure TJclAnsiStringList.QuickSort(L, R: Integer; SCompare: TJclAnsiStringListSortCompare); -var - I, J, P: Integer; -begin - repeat - I := L; - J := R; - P := (L + R) shr 1; - repeat - while SCompare(Self, I, P) < 0 do - Inc(I); - while SCompare(Self, J, P) > 0 do - Dec(J); - if I <= J then - begin - if I <> J then - Exchange(I, J); - if P = I then - P := J - else - if P = J then - P := I; - Inc(I); - Dec(J); - end; - until I > J; - if L < J then - QuickSort(L, J, SCompare); - L := I; - until I >= R; -end; - -procedure TJclAnsiStringList.SetSorted(Value: Boolean); -begin - if FSorted <> Value then - begin - if Value then - Sort; - FSorted := Value; - end; -end; - -{$ENDIF SUPPORTS_UNICODE} - -// String Test Routines -function StrIsAlpha(const S: AnsiString): Boolean; -var - I: SizeInt; -begin - Result := S <> ''; - for I := 1 to Length(S) do - begin - if not CharIsAlpha(S[I]) then - begin - Result := False; - Exit; - end; - end; -end; - -function StrIsAlphaNum(const S: AnsiString): Boolean; -var - I: SizeInt; -begin - Result := S <> ''; - for I := 1 to Length(S) do - begin - if not CharIsAlphaNum(S[I]) then - begin - Result := False; - Exit; - end; - end; -end; - -function StrConsistsofNumberChars(const S: AnsiString): Boolean; -var - I: SizeInt; -begin - Result := S <> ''; - for I := 1 to Length(S) do - begin - if not CharIsNumberChar(S[I]) then - begin - Result := False; - Exit; - end; - end; -end; - -function StrContainsChars(const S: AnsiString; Chars: TSysCharSet; CheckAll: Boolean): Boolean; -var - I: SizeInt; - C: AnsiChar; -begin - Result := Chars = []; - if not Result then - begin - if CheckAll then - begin - for I := 1 to Length(S) do - begin - C := S[I]; - if C in Chars then - begin - Chars := Chars - [C]; - if Chars = [] then - Break; - end; - end; - Result := (Chars = []); - end - else - begin - for I := 1 to Length(S) do - if S[I] in Chars then - begin - Result := True; - Break; - end; - end; - end; -end; - -function StrIsAlphaNumUnderscore(const S: AnsiString): Boolean; -var - I: SizeInt; - C: AnsiChar; -begin - for i := 1 to Length(s) do - begin - C := S[I]; - - if not (CharIsAlphaNum(C) or (C = '_')) then - begin - Result := False; - Exit; - end; - end; - - Result := True and (Length(S) > 0); -end; - -function StrIsDigit(const S: AnsiString): Boolean; -var - I: SizeInt; -begin - Result := S <> ''; - for I := 1 to Length(S) do - begin - if not CharIsDigit(S[I]) then - begin - Result := False; - Exit; - end; - end; -end; - -function StrIsSubset(const S: AnsiString; const ValidChars: TSysCharSet): Boolean; -var - I: SizeInt; -begin - for I := 1 to Length(S) do - begin - if not (S[I] in ValidChars) then - begin - Result := False; - Exit; - end; - end; - - Result := True and (Length(S) > 0); -end; - -function StrSame(const S1, S2: AnsiString): Boolean; -begin - Result := StrCompare(S1, S2) = 0; -end; - -//=== String Transformation Routines ========================================= - -function StrCenter(const S: AnsiString; L: SizeInt; C: AnsiChar = ' '): AnsiString; -begin - if Length(S) < L then - begin - Result := StringOfChar(C, (L - Length(S)) div 2) + S; - Result := Result + StringOfChar(C, L - Length(Result)); - end - else - Result := S; -end; - -function StrCharPosLower(const S: AnsiString; CharPos: SizeInt): AnsiString; -begin - Result := S; - if (CharPos > 0) and (CharPos <= Length(S)) then - Result[CharPos] := CharLower(Result[CharPos]); -end; - -function StrCharPosUpper(const S: AnsiString; CharPos: SizeInt): AnsiString; -begin - Result := S; - if (CharPos > 0) and (CharPos <= Length(S)) then - Result[CharPos] := CharUpper(Result[CharPos]); -end; - -function StrDoubleQuote(const S: AnsiString): AnsiString; -begin - Result := AnsiDoubleQuote + S + AnsiDoubleQuote; -end; - -function StrEnsureNoPrefix(const Prefix, Text: AnsiString): AnsiString; -var - PrefixLen: SizeInt; -begin - PrefixLen := Length(Prefix); - if Copy(Text, 1, PrefixLen) = Prefix then - Result := Copy(Text, PrefixLen + 1, Length(Text)) - else - Result := Text; -end; - -function StrEnsureNoSuffix(const Suffix, Text: AnsiString): AnsiString; -var - SuffixLen: SizeInt; - StrLength: SizeInt; -begin - SuffixLen := Length(Suffix); - StrLength := Length(Text); - if Copy(Text, StrLength - SuffixLen + 1, SuffixLen) = Suffix then - Result := Copy(Text, 1, StrLength - SuffixLen) - else - Result := Text; -end; - -function StrEnsurePrefix(const Prefix, Text: AnsiString): AnsiString; -var - PrefixLen: SizeInt; -begin - PrefixLen := Length(Prefix); - if Copy(Text, 1, PrefixLen) = Prefix then - Result := Text - else - Result := Prefix + Text; -end; - -function StrEnsureSuffix(const Suffix, Text: AnsiString): AnsiString; -var - SuffixLen: SizeInt; -begin - SuffixLen := Length(Suffix); - if Copy(Text, Length(Text) - SuffixLen + 1, SuffixLen) = Suffix then - Result := Text - else - Result := Text + Suffix; -end; - -function StrEscapedToString(const S: AnsiString): AnsiString; - procedure HandleHexEscapeSeq(const S: AnsiString; var I: SizeInt; Len: SizeInt; var Dest: AnsiString); - const - HexDigits = AnsiString('0123456789abcdefABCDEF'); - var - StartI, Val, N: SizeInt; - begin - StartI := I; - N := Pos(S[I + 1], HexDigits) - 1; - if N < 0 then - // '\x' without hex digit following is not escape sequence - Dest := Dest + '\x' - else - begin - Inc(I); // Jump over x - if N >= 16 then - N := N - 6; - Val := N; - // Same for second digit - if I < Len then - begin - N := Pos(S[I + 1], HexDigits) - 1; - if N >= 0 then - begin - Inc(I); // Jump over first digit - if N >= 16 then - N := N - 6; - Val := Val * 16 + N; - end; - end; - - if Val > Ord(High(AnsiChar)) then - raise EJclAnsiStringError.CreateResFmt(@RsNumericConstantTooLarge, [Val, StartI]); - - Dest := Dest + AnsiChar(Val); - end; - end; - - procedure HandleOctEscapeSeq(const S: AnsiString; var I: SizeInt; Len: SizeInt; var Dest: AnsiString); - const - OctDigits = AnsiString('01234567'); - var - StartI, Val, N: SizeInt; - begin - StartI := I; - // first digit - Val := Pos(S[I], OctDigits) - 1; - if I < Len then - begin - N := Pos(S[I + 1], OctDigits) - 1; - if N >= 0 then - begin - Inc(I); - Val := Val * 8 + N; - end; - if I < Len then - begin - N := Pos(S[I + 1], OctDigits) - 1; - if N >= 0 then - begin - Inc(I); - Val := Val * 8 + N; - end; - end; - end; - - if Val > Ord(High(AnsiChar)) then - raise EJclAnsiStringError.CreateResFmt(@RsNumericConstantTooLarge, [Val, StartI]); - - Dest := Dest + AnsiChar(Val); - end; - -var - I, Len: SizeInt; -begin - Result := ''; - I := 1; - Len := Length(S); - while I <= Len do - begin - if not ((S[I] = '\') and (I < Len)) then - Result := Result + S[I] - else - begin - Inc(I); // Jump over escape character - case S[I] of - 'a': - Result := Result + AnsiBell; - 'b': - Result := Result + AnsiBackspace; - 'f': - Result := Result + AnsiFormFeed; - 'n': - Result := Result + AnsiLineFeed; - 'r': - Result := Result + AnsiCarriageReturn; - 't': - Result := Result + AnsiTab; - 'v': - Result := Result + AnsiVerticalTab; - '\': - Result := Result + '\'; - '"': - Result := Result + '"'; - '''': - Result := Result + ''''; // Optionally escaped - '?': - Result := Result + '?'; // Optionally escaped - 'x': - if I < Len then - // Start of hex escape sequence - HandleHexEscapeSeq(S, I, Len, Result) - else - // '\x' at end of AnsiString is not escape sequence - Result := Result + '\x'; - '0'..'7': - // start of octal escape sequence - HandleOctEscapeSeq(S, I, Len, Result); - else - // no escape sequence - Result := Result + '\' + S[I]; - end; - end; - Inc(I); - end; -end; - -function StrLower(const S: AnsiString): AnsiString; -begin - Result := S; - StrLowerInPlace(Result); -end; - -procedure StrLowerInPlace(var S: AnsiString); -begin - StrCase(S, AnsiLoOffset); -end; - -procedure StrLowerBuff(S: PAnsiChar); -begin - StrCaseBuff(S, AnsiLoOffset); -end; - -procedure StrMove(var Dest: AnsiString; const Source: AnsiString; - const ToIndex, FromIndex, Count: SizeInt); -begin - // Check strings - if (Source = '') or (Length(Dest) = 0) then - Exit; - - // Check FromIndex - if (FromIndex <= 0) or (FromIndex > Length(Source)) or - (ToIndex <= 0) or (ToIndex > Length(Dest)) or - ((FromIndex + Count - 1) > Length(Source)) or ((ToIndex + Count - 1) > Length(Dest)) then - { TODO : Is failure without notice the proper thing to do here? } - Exit; - - // Move - Move(Source[FromIndex], Dest[ToIndex], Count); -end; - -function StrPadLeft(const S: AnsiString; Len: SizeInt; C: AnsiChar): AnsiString; -var - L: SizeInt; -begin - L := Length(S); - if L < Len then - Result := StringOfChar(C, Len - L) + S - else - Result := S; -end; - -function StrPadRight(const S: AnsiString; Len: SizeInt; C: AnsiChar): AnsiString; -var - L: SizeInt; -begin - L := Length(S); - if L < Len then - Result := S + StringOfChar(C, Len - L) - else - Result := S; -end; - -function StrProper(const S: AnsiString): AnsiString; -begin - Result := StrLower(S); - if Result <> '' then - Result[1] := UpCase(Result[1]); -end; - -procedure StrProperBuff(S: PAnsiChar); -begin - if (S <> nil) and (S^ <> #0) then - begin - StrLowerBuff(S); - S^ := CharUpper(S^); - end; -end; - -function StrQuote(const S: AnsiString; C: AnsiChar): AnsiString; -var - L: SizeInt; -begin - L := Length(S); - Result := S; - if L > 0 then - begin - if Result[1] <> C then - begin - Result := C + Result; - Inc(L); - end; - if Result[L] <> C then - Result := Result + C; - end; -end; - -function StrRemoveChars(const S: AnsiString; const Chars: TSysCharSet): AnsiString; -var - Source, Dest: PAnsiChar; - Index, Len: SizeInt; -begin - Len := Length(S); - SetLength(Result, Len); - UniqueString(Result); - Source := PAnsiChar(S); - Dest := PAnsiChar(Result); - for Index := 0 to Len - 1 do - begin - if not (Source^ in Chars) then - begin - Dest^ := Source^; - Inc(Dest); - end; - Inc(Source); - end; - SetLength(Result, Dest - PAnsiChar(Result)); -end; - -function StrKeepChars(const S: AnsiString; const Chars: TSysCharSet): AnsiString; -var - Source, Dest: PAnsiChar; - Index, Len: SizeInt; -begin - Len := Length(S); - SetLength(Result, Len); - UniqueString(Result); - Source := PAnsiChar(S); - Dest := PAnsiChar(Result); - for Index := 0 to Len - 1 do - begin - if Source^ in Chars then - begin - Dest^ := Source^; - Inc(Dest); - end; - Inc(Source); - end; - SetLength(Result, Dest - PAnsiChar(Result)); -end; - -function StrRepeat(const S: AnsiString; Count: SizeInt): AnsiString; -var - L: SizeInt; - P: PAnsiChar; -begin - L := Length(S); - SetLength(Result, Count * L); - P := Pointer(Result); - if P <> nil then - begin - while Count > 0 do - begin - Move(Pointer(S)^, P^, L); - P := P + L; - Dec(Count); - end; - end; -end; - -function StrRepeatLength(const S: AnsiString; const L: SizeInt): AnsiString; -var - Count: SizeInt; - LenS: SizeInt; - P: PAnsiChar; -begin - Result := ''; - LenS := Length(S); - - if (LenS > 0) and (S <> '') then - begin - Count := L div LenS; - if Count * LenS < L then - Inc(Count); - SetLength(Result, Count * LenS); - P := Pointer(Result); - while Count > 0 do - begin - Move(Pointer(S)^, P^, LenS); - P := P + LenS; - Dec(Count); - end; - if Length(S) > L then - SetLength(Result, L); - end; -end; - -procedure StrReplace(var S: AnsiString; const Search, Replace: AnsiString; Flags: TReplaceFlags); -var - SearchStr: AnsiString; - ResultStr: AnsiString; { result string } - SourcePtr: PAnsiChar; { pointer into S of character under examination } - SourceMatchPtr: PAnsiChar; { pointers into S and Search when first character has } - SearchMatchPtr: PAnsiChar; { been matched and we're probing for a complete match } - ResultPtr: PAnsiChar; { pointer into Result of character being written } - ResultIndex: SizeInt; - SearchLength: SizeInt; { length of search string } - ReplaceLength: SizeInt; { length of replace string } - BufferLength: SizeInt; { length of temporary result buffer } - ResultLength: SizeInt; { length of result string } - C: AnsiChar; { first character of search string } - IgnoreCase: Boolean; -begin - if Search = '' then - begin - if S = '' then - begin - S := Replace; - Exit; - end - else - raise EJclAnsiStringError.CreateRes(@RsBlankSearchString); - end; - - if S <> '' then - begin - IgnoreCase := rfIgnoreCase in Flags; - if IgnoreCase then - SearchStr := StrUpper(Search) - else - SearchStr := Search; - { avoid having to call Length() within the loop } - SearchLength := Length(Search); - ReplaceLength := Length(Replace); - ResultLength := Length(S); - BufferLength := ResultLength; - SetLength(ResultStr, BufferLength); - { get pointers to begin of source and result } - ResultPtr := PAnsiChar(ResultStr); - SourcePtr := PAnsiChar(S); - C := SearchStr[1]; - { while we haven't reached the end of the string } - while True do - begin - { copy characters until we find the first character of the search string } - if IgnoreCase then - while (CharUpper(SourcePtr^) <> C) and (SourcePtr^ <> #0) do - begin - ResultPtr^ := SourcePtr^; - Inc(ResultPtr); - Inc(SourcePtr); - end - else - while (SourcePtr^ <> C) and (SourcePtr^ <> #0) do - begin - ResultPtr^ := SourcePtr^; - Inc(ResultPtr); - Inc(SourcePtr); - end; - { did we find that first character or did we hit the end of the string? } - if SourcePtr^ = #0 then - Break - else - begin - { continue comparing, +1 because first character was matched already } - SourceMatchPtr := SourcePtr + 1; - SearchMatchPtr := PAnsiChar(SearchStr) + 1; - if IgnoreCase then - while (CharUpper(SourceMatchPtr^) = SearchMatchPtr^) and (SearchMatchPtr^ <> #0) do - begin - Inc(SourceMatchPtr); - Inc(SearchMatchPtr); - end - else - while (SourceMatchPtr^ = SearchMatchPtr^) and (SearchMatchPtr^ <> #0) do - begin - Inc(SourceMatchPtr); - Inc(SearchMatchPtr); - end; - { did we find a complete match? } - if SearchMatchPtr^ = #0 then - begin - // keep track of result length - Inc(ResultLength, ReplaceLength - SearchLength); - if ReplaceLength > 0 then - begin - // increase buffer size if required - if ResultLength > BufferLength then - begin - BufferLength := ResultLength * 2; - ResultIndex := ResultPtr - PAnsiChar(ResultStr) + 1; - SetLength(ResultStr, BufferLength); - ResultPtr := @ResultStr[ResultIndex]; - end; - { append replace to result and move past the search string in source } - Move((@Replace[1])^, ResultPtr^, ReplaceLength); - end; - Inc(SourcePtr, SearchLength); - Inc(ResultPtr, ReplaceLength); - { replace all instances or just one? } - if not (rfReplaceAll in Flags) then - begin - { just one, copy until end of source and break out of loop } - while SourcePtr^ <> #0 do - begin - ResultPtr^ := SourcePtr^; - Inc(ResultPtr); - Inc(SourcePtr); - end; - Break; - end; - end - else - begin - { copy current character and start over with the next } - ResultPtr^ := SourcePtr^; - Inc(ResultPtr); - Inc(SourcePtr); - end; - end; - end; - { set result length and copy result into S } - SetLength(ResultStr, ResultLength); - S := ResultStr; - end; -end; - -function StrReplaceChar(const S: AnsiString; const Source, Replace: AnsiChar): AnsiString; -var - I: SizeInt; -begin - Result := S; - for I := 1 to Length(S) do - if Result[I] = Source then - Result[I] := Replace; -end; - -function StrReplaceChars(const S: AnsiString; const Chars: TSysCharSet; Replace: AnsiChar): AnsiString; -var - I: SizeInt; -begin - Result := S; - for I := 1 to Length(S) do - if Result[I] in Chars then - Result[I] := Replace; -end; - -function StrReplaceButChars(const S: AnsiString; const Chars: TSysCharSet; - Replace: AnsiChar): AnsiString; -var - I: SizeInt; -begin - Result := S; - for I := 1 to Length(S) do - if not (Result[I] in Chars) then - Result[I] := Replace; -end; - -function StrReverse(const S: AnsiString): AnsiString; -begin - Result := S; - StrReverseInplace(Result); -end; - -procedure StrReverseInPlace(var S: AnsiString); -var - P1, P2: PAnsiChar; - C: AnsiChar; -begin - UniqueString(S); - P1 := PAnsiChar(S); - P2 := P1 + SizeOf(AnsiChar) * (Length(S) - 1); - while P1 < P2 do - begin - C := P1^; - P1^ := P2^; - P2^ := C; - Inc(P1); - Dec(P2); - end; -end; - -function StrSingleQuote(const S: AnsiString): AnsiString; -begin - Result := AnsiSingleQuote + S + AnsiSingleQuote; -end; - -procedure StrSkipChars(var S: PAnsiChar; const Chars: TSysCharSet); -begin - while S^ in Chars do - Inc(S); -end; - -procedure StrSkipChars(const S: AnsiString; var Index: SizeInt; const Chars: TSysCharSet); -begin - while S[Index] in Chars do - Inc(Index); -end; - -function StrSmartCase(const S: AnsiString; Delimiters: TSysCharSet): AnsiString; -var - Source, Dest: PAnsiChar; - Index, Len: SizeInt; -begin - Result := ''; - if Delimiters = [] then - Include(Delimiters, AnsiSpace); - - if S <> '' then - begin - Result := S; - UniqueString(Result); - - Len := Length(S); - Source := PAnsiChar(S); - Dest := PAnsiChar(Result); - Inc(Dest); - - for Index := 2 to Len do - begin - if (Source^ in Delimiters) then - Dest^ := CharUpper(Dest^); - - Inc(Dest); - Inc(Source); - end; - - Result[1] := CharUpper(Result[1]); - end; -end; - -function StrStringToEscaped(const S: AnsiString): AnsiString; -var - I: SizeInt; -begin - Result := ''; - for I := 1 to Length(S) do - begin - case S[I] of - AnsiBackspace: - Result := Result + '\b'; - AnsiBell: - Result := Result + '\a'; - AnsiCarriageReturn: - Result := Result + '\r'; - AnsiFormFeed: - Result := Result + '\f'; - AnsiLineFeed: - Result := Result + '\n'; - AnsiTab: - Result := Result + '\t'; - AnsiVerticalTab: - Result := Result + '\v'; - '\': - Result := Result + '\\'; - '"': - Result := Result + '\"'; - else - // Characters < ' ' are escaped with hex sequence - if S[I] < #32 then - Result := Result + AnsiString(Format('\x%.2x', [SizeInt(S[I])])) - else - Result := Result + S[I]; - end; - end; -end; - -function StrStripNonNumberChars(const S: AnsiString): AnsiString; -var - I: SizeInt; - C: AnsiChar; -begin - Result := ''; - for I := 1 to Length(S) do - begin - C := S[I]; - if CharIsNumberChar(C) then - Result := Result + C; - end; -end; - -function StrToHex(const Source: AnsiString): AnsiString; -var - Index: SizeInt; - C, L, N: SizeInt; - BL, BH: Byte; - S: AnsiString; -begin - Result := ''; - if Source <> '' then - begin - S := Source; - L := Length(S); - if Odd(L) then - begin - S := '0' + S; - Inc(L); - end; - Index := 1; - SetLength(Result, L div 2); - C := 1; - N := 1; - while C <= L do - begin - BH := CharHex(S[Index]); - Inc(Index); - BL := CharHex(S[Index]); - Inc(Index); - Inc(C, 2); - if (BH = $FF) or (BL = $FF) then - begin - Result := ''; - Exit; - end; - Result[N] := AnsiChar((Cardinal(BH) shl 4) or Cardinal(BL)); - Inc(N); - end; - end; -end; - -function StrTrimCharLeft(const S: AnsiString; C: AnsiChar): AnsiString; -var - I, L: SizeInt; -begin - I := 1; - L := Length(S); - while (I <= L) and (S[I] = C) do - Inc(I); - Result := Copy(S, I, L - I + 1); -end; - -function StrTrimCharsLeft(const S: AnsiString; const Chars: TSysCharSet): AnsiString; -var - I, L: SizeInt; -begin - I := 1; - L := Length(S); - while (I <= L) and (S[I] in Chars) do - Inc(I); - Result := Copy(S, I, L - I + 1); -end; - -function StrTrimCharsRight(const S: AnsiString; const Chars: TSysCharSet): AnsiString; -var - I: SizeInt; -begin - I := Length(S); - while (I >= 1) and (S[I] in Chars) do - Dec(I); - Result := Copy(S, 1, I); -end; - -function StrTrimCharRight(const S: AnsiString; C: AnsiChar): AnsiString; -var - I: SizeInt; -begin - I := Length(S); - while (I >= 1) and (S[I] = C) do - Dec(I); - Result := Copy(S, 1, I); -end; - -function StrTrimQuotes(const S: AnsiString): AnsiString; -var - First, Last: AnsiChar; - L: SizeInt; -begin - L := Length(S); - if L > 1 then - begin - First := S[1]; - Last := S[L]; - if (First = Last) and ((First = AnsiSingleQuote) or (First = AnsiDoubleQuote)) then - Result := Copy(S, 2, L - 2) - else - Result := S; - end - else - Result := S; -end; - -function StrTrimQuotes(const S: AnsiString; QuoteChar: AnsiChar): AnsiString; -var - First, Last: AnsiChar; - L: SizeInt; -begin - L := Length(S); - if L > 1 then - begin - First := S[1]; - Last := S[L]; - if (First = Last) and (First = QuoteChar) then - Result := Copy(S, 2, L - 2) - else - Result := S; - end - else - Result := S; -end; - -function StrUpper(const S: AnsiString): AnsiString; -begin - Result := S; - StrUpperInPlace(Result); -end; - -procedure StrUpperInPlace(var S: AnsiString); -begin - StrCase(S, AnsiUpOffset); -end; - -procedure StrUpperBuff(S: PAnsiChar); -begin - StrCaseBuff(S, AnsiUpOffset); -end; - -{$IFDEF MSWINDOWS} -function StrOemToAnsi(const S: AnsiString): AnsiString; -begin - SetLength(Result, Length(S)); - OemToAnsiBuff(PAnsiChar(S), PAnsiChar(Result), Length(S)); -end; - -function StrAnsiToOem(const S: AnsiString): AnsiString; -begin - SetLength(Result, Length(S)); - AnsiToOemBuff(PAnsiChar(S), PAnsiChar(Result), Length(S)); -end; -{$ENDIF MSWINDOWS} - -//=== String Management ====================================================== - -procedure StrAddRef(var S: AnsiString); -var - P: PAnsiStrRec; -begin - P := Pointer(S); - if P <> nil then - begin - Dec(P); - if P^.RefCount = -1 then - UniqueString(S) - else - LockedInc(P^.RefCount); - end; -end; - -procedure StrDecRef(var S: AnsiString); -var - P: PAnsiStrRec; -begin - P := Pointer(S); - if P <> nil then - begin - Dec(P); - case P^.RefCount of - -1, 0: - { nothing } ; - 1: - begin - Finalize(S); - Pointer(S) := nil; - end; - else - LockedDec(P^.RefCount); - end; - end; -end; - -function StrLength(const S: AnsiString): Longint; -var - P: PAnsiStrRec; -begin - Result := 0; - P := Pointer(S); - if P <> nil then - begin - Dec(P); - Result := P^.Length and (not $80000000 shr 1); - end; -end; - -function StrRefCount(const S: AnsiString): Longint; -var - P: PAnsiStrRec; -begin - Result := 0; - P := Pointer(S); - if P <> nil then - begin - Dec(P); - Result := P^.RefCount; - end; -end; - -procedure StrResetLength(var S: AnsiString); -var - I: SizeInt; -begin - for I := 0 to Length(S) - 1 do - if S[I + 1] = #0 then - begin - SetLength(S, I); - Exit; - end; -end; - -//=== String Search and Replace Routines ===================================== - -function StrCharCount(const S: AnsiString; C: AnsiChar): SizeInt; -var - I: SizeInt; -begin - Result := 0; - for I := 1 to Length(S) do - if S[I] = C then - Inc(Result); -end; - -function StrCharsCount(const S: AnsiString; Chars: TSysCharSet): SizeInt; -var - I: SizeInt; -begin - Result := 0; - for I := 1 to Length(S) do - if S[I] in Chars then - Inc(Result); -end; - -function StrStrCount(const S, SubS: AnsiString): SizeInt; -var - I: SizeInt; -begin - Result := 0; - if (Length(SubS) > Length(S)) or (Length(SubS) = 0) or (Length(S) = 0) then - Exit; - if Length(SubS) = 1 then - begin - Result := StrCharCount(S, SubS[1]); - Exit; - end; - I := StrSearch(SubS, S, 1); - - if I > 0 then - Inc(Result); - - while (I > 0) and (Length(S) > I + Length(SubS)) do - begin - I := StrSearch(SubS, S, I + 1); - if I > 0 then - Inc(Result); - end; -end; - -(* -{ 1} Test(StrCompareRange('', '', 1, 5), 0); -{ 2} Test(StrCompareRange('A', '', 1, 5), -1); -{ 3} Test(StrCompareRange('AB', '', 1, 5), -1); -{ 4} Test(StrCompareRange('ABC', '', 1, 5), -1); -{ 5} Test(StrCompareRange('', 'A', 1, 5), -1); -{ 6} Test(StrCompareRange('', 'AB', 1, 5), -1); -{ 7} Test(StrCompareRange('', 'ABC', 1, 5), -1); -{ 8} Test(StrCompareRange('A', 'a', 1, 5), -2); -{ 9} Test(StrCompareRange('A', 'a', 1, 1), -32); -{10} Test(StrCompareRange('aA', 'aB', 1, 1), 0); -{11} Test(StrCompareRange('aA', 'aB', 1, 2), -1); -{12} Test(StrCompareRange('aB', 'aA', 1, 2), 1); -{13} Test(StrCompareRange('aA', 'aa', 1, 2), -32); -{14} Test(StrCompareRange('aa', 'aA', 1, 2), 32); -{15} Test(StrCompareRange('', '', 1, 0), 0); -{16} Test(StrCompareRange('A', 'A', 1, 0), -2); -{17} Test(StrCompareRange('Aa', 'A', 1, 0), -2); -{18} Test(StrCompareRange('Aa', 'Aa', 1, 2), 0); -{19} Test(StrCompareRange('Aa', 'A', 1, 2), 0); -{20} Test(StrCompareRange('Ba', 'A', 1, 2), 1); -*) -function StrCompareRangeEx(const S1, S2: AnsiString; Index, Count: SizeInt; CaseSensitive: Boolean): SizeInt; -var - Len1, Len2: SizeInt; - I: SizeInt; - C1, C2: AnsiChar; -begin - if Pointer(S1) = Pointer(S2) then - begin - if (Count <= 0) and (S1 <> '') then - Result := -2 // no work - else - Result := 0; - end - else - if (S1 = '') or (S2 = '') then - Result := -1 // null string - else - if Count <= 0 then - Result := -2 // no work - else - begin - Len1 := Length(S1); - Len2 := Length(S2); - - if (Index - 1) + Count > Len1 then - Result := -2 - else - begin - if (Index - 1) + Count > Len2 then // strange behaviour, but the assembler code does it - Count := Len2 - (Index - 1); - - if CaseSensitive then - begin - for I := 0 to Count - 1 do - begin - C1 := S1[Index + I]; - C2 := S2[Index + I]; - if C1 <> C2 then - begin - Result := Ord(C1) - Ord(C2); - Exit; - end; - end; - end - else - begin - for I := 0 to Count - 1 do - begin - C1 := S1[Index + I]; - C2 := S2[Index + I]; - if C1 <> C2 then - begin - C1 := CharLower(C1); - C2 := CharLower(C2); - if C1 <> C2 then - begin - Result := Ord(C1) - Ord(C2); - Exit; - end; - end; - end; - end; - Result := 0; - end; - end; -end; - -function StrCompare(const S1, S2: AnsiString; CaseSensitive: Boolean): SizeInt; -var - Len1, Len2: SizeInt; -begin - if Pointer(S1) = Pointer(S2) then - Result := 0 - else - begin - Len1 := Length(S1); - Len2 := Length(S2); - Result := Len1 - Len2; - if Result = 0 then - Result := StrCompareRangeEx(S1, S2, 1, Len1, CaseSensitive); - end; -end; - -function StrCompareRange(const S1, S2: AnsiString; Index, Count: SizeInt; CaseSensitive: Boolean): SizeInt; -begin - Result := StrCompareRangeEx(S1, S2, Index, Count, CaseSensitive); -end; - -function StrRepeatChar(C: AnsiChar; Count: SizeInt): AnsiString; -begin - SetLength(Result, Count); - if Count > 0 then - FillChar(Result[1], Count, C); -end; - -function StrFind(const Substr, S: AnsiString; const Index: SizeInt): SizeInt; -var - pos: SizeInt; -begin - if (SubStr <> '') and (S <> '') then - begin - pos := StrIPos(Substr, Copy(S, Index, Length(S) - Index + 1)); - if pos = 0 then - Result := 0 - else - Result := Index + Pos - 1; - end - else - Result := 0; -end; - -function StrHasPrefix(const S: AnsiString; const Prefixes: array of AnsiString): Boolean; -begin - Result := StrPrefixIndex(S, Prefixes) > -1; -end; - -function StrHasSuffix(const S: AnsiString; const Suffixes: array of AnsiString): Boolean; -begin - Result := StrSuffixIndex(S, Suffixes) > -1; -end; - -function StrIHasPrefix(const S: AnsiString; const Prefixes: array of AnsiString): Boolean; -begin - Result := StrIPrefixIndex(S, Prefixes) > -1; -end; - -function StrIHasSuffix(const S: AnsiString; const Suffixes: array of AnsiString): Boolean; -begin - Result := StrISuffixIndex(S, Suffixes) > -1; -end; - -function StrIndex(const S: AnsiString; const List: array of AnsiString; CaseSensitive: Boolean): SizeInt; -var - I: SizeInt; -begin - Result := -1; - for I := Low(List) to High(List) do - begin - if StrCompare(S, List[I], CaseSensitive) = 0 then - begin - Result := I; - Break; - end; - end; -end; - -function StrILastPos(const SubStr, S: AnsiString): SizeInt; -begin - Result := StrLastPos(StrUpper(SubStr), StrUpper(S)); -end; - -function StrIPos(const SubStr, S: AnsiString): SizeInt; -begin - Result := Pos(StrUpper(SubStr), StrUpper(S)); -end; - -function StrIPrefixIndex(const S: AnsiString; const Prefixes: array of AnsiString): SizeInt; -var - I: SizeInt; - Test: AnsiString; -begin - Result := -1; - for I := Low(Prefixes) to High(Prefixes) do - begin - Test := StrLeft(S, Length(Prefixes[I])); - if CompareText(Test, Prefixes[I]) = 0 then - begin - Result := I; - Break; - end; - end; -end; - -function StrIsOneOf(const S: AnsiString; const List: array of AnsiString): Boolean; -begin - Result := StrIndex(S, List) > -1; -end; - -function StrISuffixIndex(const S: AnsiString; const Suffixes: array of AnsiString): SizeInt; -var - I: SizeInt; - Test: AnsiString; -begin - Result := -1; - for I := Low(Suffixes) to High(Suffixes) do - begin - Test := StrRight(S, Length(Suffixes[I])); - if CompareText(Test, Suffixes[I]) = 0 then - begin - Result := I; - Break; - end; - end; -end; - -function StrLastPos(const SubStr, S: AnsiString): SizeInt; -var - Last, Current: PAnsiChar; -begin - Result := 0; - Last := nil; - Current := PAnsiChar(S); - - while (Current <> nil) and (Current^ <> #0) do - begin - Current := AnsiStrPosA(PAnsiChar(Current), PAnsiChar(SubStr)); - if Current <> nil then - begin - Last := Current; - Inc(Current); - end; - end; - if Last <> nil then - Result := Abs(PAnsiChar(S) - Last) + 1; -end; - -// IMPORTANT NOTE: The StrMatch function does currently not work with the Asterix (*) -// (*) acts like (?) - -function StrMatch(const Substr, S: AnsiString; Index: SizeInt): SizeInt; -var - SI, SubI, SLen, SubLen: SizeInt; - SubC: AnsiChar; -begin - SLen := Length(S); - SubLen := Length(Substr); - Result := 0; - if (Index > SLen) or (SubLen = 0) then - Exit; - while Index <= SLen do - begin - SubI := 1; - SI := Index; - while (SI <= SLen) and (SubI <= SubLen) do - begin - SubC := Substr[SubI]; - if (SubC = '*') or (SubC = '?') or (SubC = S[SI]) then - begin - Inc(SI); - Inc(SubI); - end - else - Break; - end; - if SubI > SubLen then - begin - Result := Index; - Break; - end; - Inc(Index); - end; -end; - - -// Derived from "Like" by Michael Winter - -function StrMatches(const Substr, S: AnsiString; const Index: SizeInt): Boolean; -var - StringPtr: PAnsiChar; - PatternPtr: PAnsiChar; - StringRes: PAnsiChar; - PatternRes: PAnsiChar; -begin - if SubStr = '' then - raise EJclAnsiStringError.CreateRes(@RsBlankSearchString); - - Result := SubStr = '*'; - - if Result or (S = '') then - Exit; - - if (Index <= 0) or (Index > Length(S)) then - raise EJclAnsiStringError.CreateRes(@RsArgumentOutOfRange); - - StringPtr := PAnsiChar(@S[Index]); - PatternPtr := PAnsiChar(SubStr); - StringRes := nil; - PatternRes := nil; - - repeat - repeat - case PatternPtr^ of - #0: - begin - Result := StringPtr^ = #0; - if Result or (StringRes = nil) or (PatternRes = nil) then - Exit; - - StringPtr := StringRes; - PatternPtr := PatternRes; - Break; - end; - '*': - begin - Inc(PatternPtr); - PatternRes := PatternPtr; - Break; - end; - '?': - begin - if StringPtr^ = #0 then - Exit; - Inc(StringPtr); - Inc(PatternPtr); - end; - else - begin - if StringPtr^ = #0 then - Exit; - if StringPtr^ <> PatternPtr^ then - begin - if (StringRes = nil) or (PatternRes = nil) then - Exit; - StringPtr := StringRes; - PatternPtr := PatternRes; - Break; - end - else - begin - Inc(StringPtr); - Inc(PatternPtr); - end; - end; - end; - until False; - - repeat - case PatternPtr^ of - #0: - begin - Result := True; - Exit; - end; - '*': - begin - Inc(PatternPtr); - PatternRes := PatternPtr; - end; - '?': - begin - if StringPtr^ = #0 then - Exit; - Inc(StringPtr); - Inc(PatternPtr); - end; - else - begin - repeat - if StringPtr^ = #0 then - Exit; - if StringPtr^ = PatternPtr^ then - Break; - Inc(StringPtr); - until False; - Inc(StringPtr); - StringRes := StringPtr; - Inc(PatternPtr); - Break; - end; - end; - until False; - until False; -end; - -function StrNPos(const S, SubStr: AnsiString; N: SizeInt): SizeInt; -var - I, P: SizeInt; -begin - if N < 1 then - begin - Result := 0; - Exit; - end; - - Result := StrSearch(SubStr, S, 1); - I := 1; - while I < N do - begin - P := StrSearch(SubStr, S, Result + 1); - if P = 0 then - begin - Result := 0; - Break; - end - else - begin - Result := P; - Inc(I); - end; - end; -end; - -function StrNIPos(const S, SubStr: AnsiString; N: SizeInt): SizeInt; -var - I, P: SizeInt; -begin - if N < 1 then - begin - Result := 0; - Exit; - end; - - Result := StrFind(SubStr, S, 1); - I := 1; - while I < N do - begin - P := StrFind(SubStr, S, Result + 1); - if P = 0 then - begin - Result := 0; - Break; - end - else - begin - Result := P; - Inc(I); - end; - end; -end; - -function StrPrefixIndex(const S: AnsiString; const Prefixes: array of AnsiString): SizeInt; -var - I: SizeInt; - Test: AnsiString; -begin - Result := -1; - for I := Low(Prefixes) to High(Prefixes) do - begin - Test := StrLeft(S, Length(Prefixes[I])); - if CompareStr(Test, Prefixes[I]) = 0 then - begin - Result := I; - Break; - end; - end; -end; - -function StrSearch(const Substr, S: AnsiString; const Index: SizeInt): SizeInt; -var - SP, SPI, SubP: PAnsiChar; - SLen: SizeInt; -begin - SLen := Length(S); - if Index <= SLen then - begin - SP := PAnsiChar(S); - SubP := PAnsiChar(Substr); - SPI := SP; - Inc(SPI, Index); - Dec(SPI); - SPI := StrPosA(SPI, SubP); - if SPI <> nil then - Result := SPI - SP + 1 - else - Result := 0; - end - else - Result := 0; -end; - -function StrSuffixIndex(const S: AnsiString; const Suffixes: array of AnsiString): SizeInt; -var - I: SizeInt; - Test: AnsiString; -begin - Result := -1; - for I := Low(Suffixes) to High(Suffixes) do - begin - Test := StrRight(S, Length(Suffixes[I])); - if CompareStr(Test, Suffixes[I]) = 0 then - begin - Result := I; - Break; - end; - end; -end; - -//=== String Extraction ====================================================== - -function StrAfter(const SubStr, S: AnsiString): AnsiString; -var - P: SizeInt; -begin - P := StrFind(SubStr, S, 1); // StrFind is case-insensitive pos - if P <= 0 then - Result := '' // substr not found -> nothing after it - else - Result := StrRestOf(S, P + Length(SubStr)); -end; - -function StrBefore(const SubStr, S: AnsiString): AnsiString; -var - P: SizeInt; -begin - P := StrFind(SubStr, S, 1); - if P <= 0 then - Result := S - else - Result := StrLeft(S, P - 1); -end; - -function StrSplit(const SubStr, S: AnsiString;var Left, Right : AnsiString): boolean; -var - P: SizeInt; -begin - P := StrFind(SubStr, S, 1); - Result:= p > 0; - if Result then - begin - Left := StrLeft(S, P - 1); - Right := StrRestOf(S, P + Length(SubStr)); - end - else - begin - Left := ''; - Right := ''; - end; -end; - -function StrBetween(const S: AnsiString; const Start, Stop: AnsiChar): AnsiString; -var - PosStart, PosEnd: SizeInt; - L: SizeInt; -begin - PosStart := Pos(Start, S); - PosEnd := StrSearch(Stop, S, PosStart + 1); // PosEnd has to be after PosStart. - - if (PosStart > 0) and (PosEnd > PosStart) then - begin - L := PosEnd - PosStart; - Result := Copy(S, PosStart + 1, L - 1); - end - else - Result := ''; -end; - -function StrChopRight(const S: AnsiString; N: SizeInt): AnsiString; -begin - Result := Copy(S, 1, Length(S) - N); -end; - -function StrLeft(const S: AnsiString; Count: SizeInt): AnsiString; -begin - Result := Copy(S, 1, Count); -end; - -function StrMid(const S: AnsiString; Start, Count: SizeInt): AnsiString; -begin - Result := Copy(S, Start, Count); -end; - -function StrRestOf(const S: AnsiString; N: SizeInt): AnsiString; -begin - Result := Copy(S, N, (Length(S) - N + 1)); -end; - -function StrRight(const S: AnsiString; Count: SizeInt): AnsiString; -begin - Result := Copy(S, Length(S) - Count + 1, Count); -end; - -//=== Character (do we have it ;) ============================================ - -function CharEqualNoCase(const C1, C2: AnsiChar): Boolean; -begin - // if they are not equal chars, may be same letter different case - Result := (C1 = C2) or - (CharIsAlpha(C1) and CharIsAlpha(C2) and (CharLower(C1) = CharLower(C2))); -end; - - -function CharIsAlpha(const C: AnsiChar): Boolean; -begin - Result := (AnsiCharTypes[C] and C1_ALPHA) <> 0; -end; - -function CharIsAlphaNum(const C: AnsiChar): Boolean; -begin - Result := ((AnsiCharTypes[C] and C1_ALPHA) <> 0) or - ((AnsiCharTypes[C] and C1_DIGIT) <> 0); -end; - -function CharIsBlank(const C: AnsiChar): Boolean; -begin - Result := ((AnsiCharTypes[C] and C1_BLANK) <> 0); -end; - -function CharIsControl(const C: AnsiChar): Boolean; -begin - Result := (AnsiCharTypes[C] and C1_CNTRL) <> 0; -end; - -function CharIsDelete(const C: AnsiChar): Boolean; -begin - Result := (C = #8); -end; - -function CharIsDigit(const C: AnsiChar): Boolean; -begin - Result := (AnsiCharTypes[C] and C1_DIGIT) <> 0; -end; - -function CharIsFracDigit(const C: AnsiChar): Boolean; -begin - Result := (C = '.') or ((AnsiCharTypes[C] and C1_DIGIT) <> 0); -end; - -function CharIsHexDigit(const C: AnsiChar): Boolean; -begin - case C of - 'A'..'F', - 'a'..'f': - Result := True; - else - Result := ((AnsiCharTypes[C] and C1_DIGIT) <> 0); - end; -end; - -function CharIsLower(const C: AnsiChar): Boolean; -begin - Result := (AnsiCharTypes[C] and C1_LOWER) <> 0; -end; - -// JclSysUtils.TJclFormatSettings.GetDecimalSeparator is manually inlined in the 2 following functions -// this fixes compiler warnings about functions not being inlined - -function CharIsNumberChar(const C: AnsiChar): Boolean; -begin - Result := ((AnsiCharTypes[C] and C1_DIGIT) <> 0) or (C = AnsiSignMinus) or (C = AnsiSignPlus) or - (Char(C) = {$IFDEF RTL220_UP}FormatSettings.DecimalSeparator{$ELSE}SysUtils.DecimalSeparator{$ENDIF}); -end; - -function CharIsNumber(const C: AnsiChar): Boolean; -begin - Result := ((AnsiCharTypes[C] and C1_DIGIT) <> 0) or - (Char(C) = {$IFDEF RTL220_UP}FormatSettings.DecimalSeparator{$ELSE}SysUtils.DecimalSeparator{$ENDIF}); -end; - -function CharIsPrintable(const C: AnsiChar): Boolean; -begin - Result := not CharIsControl(C); -end; - -function CharIsPunctuation(const C: AnsiChar): Boolean; -begin - Result := ((AnsiCharTypes[C] and C1_PUNCT) <> 0); -end; - -function CharIsReturn(const C: AnsiChar): Boolean; -begin - Result := (C = AnsiLineFeed) or (C = AnsiCarriageReturn); -end; - -function CharIsSpace(const C: AnsiChar): Boolean; -begin - Result := (AnsiCharTypes[C] and C1_SPACE) <> 0; -end; - -function CharIsUpper(const C: AnsiChar): Boolean; -begin - Result := (AnsiCharTypes[C] and C1_UPPER) <> 0; -end; - -function CharIsValidIdentifierLetter(const C: AnsiChar): Boolean; -begin - case C of - '0'..'9', 'A'..'Z', 'a'..'z', '_': - Result := True; - else - Result := False; - end; -end; - -function CharIsWhiteSpace(const C: AnsiChar): Boolean; -begin - Result := (C = AnsiTab) or (C = AnsiLineFeed) or (C = AnsiVerticalTab) or - (C = AnsiFormFeed) or (C = AnsiCarriageReturn) or (C =AnsiSpace) or - ((AnsiCharTypes[C] and C1_SPACE) <> 0); -end; - -function CharIsWildcard(const C: AnsiChar): Boolean; -begin - case C of - '*', '?': - Result := True; - else - Result := False; - end; -end; - -function CharType(const C: AnsiChar): Word; -begin - Result := AnsiCharTypes[C]; -end; - -//=== PCharVector ============================================================ - -function StringsToPCharVector(var Dest: PAnsiCharVector; const Source: TJclAnsiStrings): PAnsiCharVector; -var - I: SizeInt; - S: AnsiString; - List: array of PAnsiChar; -begin - Assert(Source <> nil); - Dest := AllocMem((Source.Count + SizeOf(AnsiChar)) * SizeOf(PAnsiChar)); - SetLength(List, Source.Count + SizeOf(AnsiChar)); - for I := 0 to Source.Count - 1 do - begin - S := Source[I]; - {$IFDEF SUPPORTS_UNICODE} - List[I] := AnsiStrAlloc(Length(S) + SizeOf(AnsiChar)); - {$ELSE ~SUPPORTS_UNICODE} - List[I] := StrAlloc(Length(S) + SizeOf(AnsiChar)); - {$ENDIF ~SUPPORTS_UNICODE} - StrPCopyA(List[I], S); - end; - List[Source.Count] := nil; - Move(List[0], Dest^, (Source.Count + 1) * SizeOf(PAnsiChar)); - Result := Dest; -end; - -function PCharVectorCount(Source: PAnsiCharVector): SizeInt; -begin - Result := 0; - if Source <> nil then - while Source^ <> nil do - begin - Inc(Source); - Inc(Result); - end; -end; - -procedure PCharVectorToStrings(const Dest: TJclAnsiStrings; Source: PAnsiCharVector); -var - I, Count: SizeInt; - List: array of PAnsiChar; -begin - Assert(Dest <> nil); - if Source <> nil then - begin - Count := PCharVectorCount(Source); - SetLength(List, Count); - Move(Source^, List[0], Count * SizeOf(PAnsiChar)); - Dest.BeginUpdate; - try - Dest.Clear; - for I := 0 to Count - 1 do - Dest.Add(List[I]); - finally - Dest.EndUpdate; - end; - end; -end; - -procedure FreePCharVector(var Dest: PAnsiCharVector); -var - I, Count: SizeInt; - List: array of PAnsiChar; -begin - if Dest <> nil then - begin - Count := PCharVectorCount(Dest); - SetLength(List, Count); - Move(Dest^, List[0], Count * SizeOf(PAnsiChar)); - for I := 0 to Count - 1 do - StrDisposeA(List[I]); - FreeMem(Dest, (Count + 1) * SizeOf(PAnsiChar)); - Dest := nil; - end; -end; - -//=== Character Transformation Routines ====================================== - -function CharHex(const C: AnsiChar): Byte; -begin - case C of - '0'..'9': - Result := Ord(C) - Ord('0'); - 'a'..'f': - Result := Ord(C) - Ord('a') + 10; - 'A'..'F': - Result := Ord(C) - Ord('A') + 10; - else - Result := $FF; - end; -end; - -function CharLower(const C: AnsiChar): AnsiChar; -begin - Result := AnsiCaseMap[Ord(C) + AnsiLoOffset]; -end; - -function CharToggleCase(const C: AnsiChar): AnsiChar; -begin - Result := AnsiCaseMap[Ord(C) + AnsiReOffset]; -end; - -function CharUpper(const C: AnsiChar): AnsiChar; -begin - Result := AnsiCaseMap[Ord(C) + AnsiUpOffset]; -end; - -//=== Character Search and Replace =========================================== - -function CharLastPos(const S: AnsiString; const C: AnsiChar; const Index: SizeInt): SizeInt; -begin - if (Index > 0) and (Index <= Length(S)) then - for Result := Length(S) downto Index do - if S[Result] = C then - Exit; - Result := 0; -end; - -function CharPos(const S: AnsiString; const C: AnsiChar; const Index: SizeInt): SizeInt; -begin - if (Index > 0) and (Index <= Length(S)) then - for Result := Index to Length(S) do - if S[Result] = C then - Exit; - Result := 0; -end; - -function CharIPos(const S: AnsiString; C: AnsiChar; const Index: SizeInt): SizeInt; -begin - if (Index > 0) and (Index <= Length(S)) then - begin - C := CharUpper(C); - for Result := Index to Length(S) do - if AnsiCaseMap[Ord(S[Result]) + AnsiUpOffset] = C then - Exit; - end; - Result := 0; -end; - -function CharReplace(var S: AnsiString; const Search, Replace: AnsiChar): SizeInt; -var - P: PAnsiChar; - Index, Len: SizeInt; -begin - Result := 0; - if Search <> Replace then - begin - UniqueString(S); - Len := Length(S); - P := PAnsiChar(S); - for Index := 0 to Len - 1 do - begin - if P^ = Search then - begin - P^ := Replace; - Inc(Result); - end; - Inc(P); - end; - end; -end; - -//=== MultiSz ================================================================ - -function StringsToMultiSz(var Dest: PAnsiMultiSz; const Source: TJclAnsiStrings): PAnsiMultiSz; -var - I, TotalLength: SizeInt; - P: PAnsiMultiSz; -begin - Assert(Source <> nil); - TotalLength := 1; - for I := 0 to Source.Count - 1 do - if Source[I] = '' then - raise EJclAnsiStringError.CreateRes(@RsInvalidEmptyStringItem) - else - Inc(TotalLength, StrLenA(PAnsiChar(AnsiString(Source[I]))) + 1); - AllocateMultiSz(Dest, TotalLength); - P := Dest; - for I := 0 to Source.Count - 1 do - begin - P := StrECopyA(P, PAnsiChar(AnsiString(Source[I]))); - Inc(P); - end; - P^ := #0; - Result := Dest; -end; - -procedure MultiSzToStrings(const Dest: TJclAnsiStrings; const Source: PAnsiMultiSz); -var - P: PAnsiMultiSz; -begin - Assert(Dest <> nil); - Dest.BeginUpdate; - try - Dest.Clear; - if Source <> nil then - begin - P := Source; - while P^ <> #0 do - begin - Dest.Add(P); - P := StrEndA(P); - Inc(P); - end; - end; - finally - Dest.EndUpdate; - end; -end; - -function MultiSzLength(const Source: PAnsiMultiSz): SizeInt; -var - P: PAnsiMultiSz; -begin - Result := 0; - if Source <> nil then - begin - P := Source; - repeat - Inc(Result, StrLenA(P) + 1); - P := StrEndA(P); - Inc(P); - until P^ = #0; - Inc(Result); - end; -end; - -procedure AllocateMultiSz(var Dest: PAnsiMultiSz; Len: SizeInt); -begin - if Len > 0 then - GetMem(Dest, Len * SizeOf(AnsiChar)) - else - Dest := nil; -end; - -procedure FreeMultiSz(var Dest: PAnsiMultiSz); -begin - if Dest <> nil then - FreeMem(Dest); - Dest := nil; -end; - -function MultiSzDup(const Source: PAnsiMultiSz): PAnsiMultiSz; -var - Len: SizeInt; -begin - if Source <> nil then - begin - Len := MultiSzLength(Source); - Result := nil; - AllocateMultiSz(Result, Len); - Move(Source^, Result^, Len * SizeOf(AnsiChar)); - end - else - Result := nil; -end; - -//=== TJclAnsiStrings Manipulation =============================================== - -procedure StrToStrings(S, Sep: AnsiString; const List: TJclAnsiStrings; const AllowEmptyString: Boolean = True); -var - I, L: SizeInt; - Left: AnsiString; -begin - Assert(List <> nil); - List.BeginUpdate; - try - List.Clear; - L := Length(Sep); - I := Pos(Sep, S); - while I > 0 do - begin - Left := StrLeft(S, I - 1); - if (Left <> '') or AllowEmptyString then - List.Add(Left); - Delete(S, 1, I + L - 1); - I := Pos(Sep, S); - end; - if (S <> '') or AllowEmptyString then - List.Add(S); // Ignore empty strings at the end (only if AllowEmptyString = False). - finally - List.EndUpdate; - end; -end; - -procedure StrIToStrings(S, Sep: AnsiString; const List: TJclAnsiStrings; const AllowEmptyString: Boolean = True); -var - I, L: SizeInt; - LowerCaseStr: AnsiString; - Left: AnsiString; -begin - Assert(List <> nil); - LowerCaseStr := StrLower(S); - Sep := StrLower(Sep); - L := Length(Sep); - I := Pos(Sep, LowerCaseStr); - List.BeginUpdate; - try - List.Clear; - while I > 0 do - begin - Left := StrLeft(S, I - 1); - if (Left <> '') or AllowEmptyString then - List.Add(Left); - Delete(S, 1, I + L - 1); - Delete(LowerCaseStr, 1, I + L - 1); - I := Pos(Sep, LowerCaseStr); - end; - if (S <> '') or AllowEmptyString then - List.Add(S); // Ignore empty strings at the end (only if AllowEmptyString = False). - finally - List.EndUpdate; - end; -end; - -function StringsToStr(const List: TJclAnsiStrings; const Sep: AnsiString; - const AllowEmptyString: Boolean): AnsiString; -var - I, L: SizeInt; -begin - Result := ''; - for I := 0 to List.Count - 1 do - begin - if (List[I] <> '') or AllowEmptyString then - begin - // don't combine these into one addition, somehow it hurts performance - Result := Result + List[I]; - Result := Result + Sep; - end; - end; - // remove terminating separator - if List.Count <> 0 then - begin - L := Length(Sep); - Delete(Result, Length(Result) - L + 1, L); - end; -end; - -procedure TrimStrings(const List: TJclAnsiStrings; DeleteIfEmpty: Boolean); -var - I: SizeInt; -begin - Assert(List <> nil); - List.BeginUpdate; - try - for I := List.Count - 1 downto 0 do - begin - List[I] := Trim(List[I]); - if (List[I] = '') and DeleteIfEmpty then - List.Delete(I); - end; - finally - List.EndUpdate; - end; -end; - -procedure TrimStringsRight(const List: TJclAnsiStrings; DeleteIfEmpty: Boolean); -var - I: SizeInt; -begin - Assert(List <> nil); - List.BeginUpdate; - try - for I := List.Count - 1 downto 0 do - begin - List[I] := TrimRight(List[I]); - if (List[I] = '') and DeleteIfEmpty then - List.Delete(I); - end; - finally - List.EndUpdate; - end; -end; - -procedure TrimStringsLeft(const List: TJclAnsiStrings; DeleteIfEmpty: Boolean); -var - I: SizeInt; -begin - Assert(List <> nil); - List.BeginUpdate; - try - for I := List.Count - 1 downto 0 do - begin - List[I] := TrimLeft(List[I]); - if (List[I] = '') and DeleteIfEmpty then - List.Delete(I); - end; - finally - List.EndUpdate; - end; -end; - -function AddStringToStrings(const S: AnsiString; Strings: TJclAnsiStrings; const Unique: Boolean): Boolean; -begin - Assert(Strings <> nil); - Result := Unique and (Strings.IndexOf(S) <> -1); - if not Result then - Result := Strings.Add(S) > -1; -end; - -//=== Miscellaneous ========================================================== - -function FileToString(const FileName: TFileName): AnsiString; -var - FS: TFileStream; - Len: SizeInt; -begin - FS := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); - try - Len := FS.Size; - SetLength(Result, Len); - if Len > 0 then - FS.ReadBuffer(Result[1], Len); - finally - FS.Free; - end; -end; - -procedure StringToFile(const FileName: TFileName; const Contents: AnsiString; Append: Boolean); -var - FS: TFileStream; - Len: SizeInt; -begin - if Append and FileExists(FileName) then - FS := TFileStream.Create(FileName, fmOpenReadWrite or fmShareDenyWrite) - else - FS := TFileStream.Create(FileName, fmCreate); - try - if Append then - FS.Seek(0, soEnd); // faster than .Position := .Size - Len := Length(Contents); - if Len > 0 then - FS.WriteBuffer(Contents[1], Len); - finally - FS.Free; - end; -end; - -function StrToken(var S: AnsiString; Separator: AnsiChar): AnsiString; -var - I: SizeInt; -begin - I := Pos(Separator, S); - if I <> 0 then - begin - Result := Copy(S, 1, I - 1); - Delete(S, 1, I); - end - else - begin - Result := S; - S := ''; - end; -end; - -procedure StrTokens(const S: AnsiString; const List: TJclAnsiStrings); -var - Start: PAnsiChar; - Token: AnsiString; - Done: Boolean; -begin - Assert(List <> nil); - if List = nil then - Exit; - - List.BeginUpdate; - try - List.Clear; - Start := Pointer(S); - repeat - Done := StrWord(Start, Token); - if Token <> '' then - List.Add(Token); - until Done; - finally - List.EndUpdate; - end; -end; - -procedure StrTokenToStrings(S: AnsiString; Separator: AnsiChar; const List: TJclAnsiStrings); -var - Token: AnsiString; -begin - Assert(List <> nil); - - if List = nil then - Exit; - - List.BeginUpdate; - try - List.Clear; - while S <> '' do - begin - Token := StrToken(S, Separator); - List.Add(Token); - end; - finally - List.EndUpdate; - end; -end; - -function StrWord(const S: AnsiString; var Index: SizeInt; out Word: AnsiString): Boolean; -var - Start: SizeInt; - C: AnsiChar; -begin - Word := ''; - if (S = '') then - begin - Result := True; - Exit; - end; - Start := Index; - Result := False; - while True do - begin - C := S[Index]; - case C of - #0: - begin - if Start <> 0 then - Word := Copy(S, Start, Index - Start); - Result := True; - Exit; - end; - AnsiSpace, AnsiLineFeed, AnsiCarriageReturn: - begin - if Start <> 0 then - begin - Word := Copy(S, Start, Index - Start); - Exit; - end - else - begin - while CharIsWhiteSpace(C) do - begin - Inc(Index); - C := S[Index]; - end; - end; - end; - else - if Start = 0 then - Start := Index; - Inc(Index); - end; - end; -end; - -function StrWord(var S: PAnsiChar; out Word: AnsiString): Boolean; -var - Start: PAnsiChar; -begin - Word := ''; - if S = nil then - begin - Result := True; - Exit; - end; - Start := nil; - Result := False; - while True do - begin - case S^ of - #0: - begin - if Start <> nil then - SetString(Word, Start, S - Start); - Result := True; - Exit; - end; - AnsiSpace, AnsiLineFeed, AnsiCarriageReturn: - begin - if Start <> nil then - begin - SetString(Word, Start, S - Start); - Exit; - end - else - while CharIsWhiteSpace(S^) do - Inc(S); - end; - else - if Start = nil then - Start := S; - Inc(S); - end; - end; -end; - -function StrIdent(const S: AnsiString; var Index: SizeInt; out Ident: AnsiString): Boolean; -var - Start: SizeInt; - C: AnsiChar; -begin - Ident := ''; - if (S = '') then - begin - Result := True; - Exit; - end; - Start := Index; - Result := False; - while True do - begin - C := S[Index]; - if CharIsValidIdentifierLetter(C) then - begin - if Start = 0 then - Start := Index; - end - else - if C = #0 then - begin - if Start <> 0 then - Ident := Copy(S, Start, Index - Start); - Result := True; - Exit; - end - else - begin - if Start <> 0 then - begin - Ident := Copy(S, Start, Index - Start); - Exit; - end; - end; - Inc(Index); - end; -end; - -function StrIdent(var S: PAnsiChar; out Ident: AnsiString): Boolean; -var - Start: PAnsiChar; - C: AnsiChar; -begin - Ident := ''; - if S = nil then - begin - Result := True; - Exit; - end; - Start := nil; - Result := False; - while True do - begin - C := S^; - if CharIsValidIdentifierLetter(C) then - begin - if Start = nil then - Start := S; - end - else - if C = #0 then - begin - if Start <> nil then - SetString(Ident, Start, S - Start); - Result := True; - Exit; - end - else - begin - if Start <> nil then - begin - SetString(Ident, Start, S - Start); - Exit; - end - end; - Inc(S); - end; -end; - -function StrToFloatSafe(const S: AnsiString): Float; -var - Temp: AnsiString; - I, J, K: SizeInt; - SwapSeparators, IsNegative: Boolean; - DecSep: AnsiChar; - ThouSep: AnsiChar; -begin - DecSep := AnsiChar(JclFormatSettings.DecimalSeparator); - ThouSep := AnsiChar(JclFormatSettings.ThousandSeparator); - Temp := S; - SwapSeparators := False; - - IsNegative := False; - J := 0; - for I := 1 to Length(Temp) do - begin - if Temp[I] = '-' then - IsNegative := not IsNegative - else - if not (Temp[I] in [' ', '(', '+']) then - begin - // if it appears prior to any digit, it has to be a decimal separator - SwapSeparators := Temp[I] = ThouSep; - J := I; - Break; - end; - end; - - if not SwapSeparators then - begin - K := CharPos(Temp, DecSep); - SwapSeparators := - // if it appears prior to any digit, it has to be a decimal separator - (K > J) and - // if it appears multiple times, it has to be a thousand separator - ((StrCharCount(Temp, DecSep) > 1) or - // we assume (consistent with Windows Platform SDK documentation), - // that thousand separators appear only to the left of the decimal - (K < CharPos(Temp, ThouSep))); - end; - - if SwapSeparators then - begin - // assume a numerical string from a different locale, - // where DecimalSeparator and ThousandSeparator are exchanged - for I := 1 to Length(Temp) do - if Temp[I] = DecSep then - Temp[I] := ThouSep - else - if Temp[I] = ThouSep then - Temp[I] := DecSep; - end; - - Temp := StrKeepChars(Temp, AnsiDecDigits + [DecSep]); - - if Length(Temp) > 0 then - begin - if Temp[1] = DecSep then - Temp := '0' + Temp; - if Temp[Length(Temp)] = DecSep then - Temp := Temp + '0'; - Result := StrToFloat(string(Temp)); - if IsNegative then - Result := -Result; - end - else - Result := 0.0; -end; - -function StrToIntSafe(const S: AnsiString): Integer; -begin - Result := Trunc(StrToFloatSafe(S)); -end; - -procedure StrNormIndex(const StrLen: SizeInt; var Index: SizeInt; var Count: SizeInt); overload; -begin - Index := Max(1, Min(Index, StrLen + 1)); - Count := Max(0, Min(Count, StrLen + 1 - Index)); -end; - -function ArrayOf(List: TJclAnsiStrings): TDynStringArray; -var - I: SizeInt; -begin - if List <> nil then - begin - SetLength(Result, List.Count); - for I := 0 to List.Count - 1 do - Result[I] := string(List[I]); - end - else - Result := nil; -end; - -function AnsiCompareNatural(const S1, S2: AnsiString; CaseInsensitive: Boolean): SizeInt; -var - Cur1, Len1, - Cur2, Len2: SizeInt; - - procedure NumberCompare; - var - IsReallyNumber: Boolean; - FirstDiffBreaks: Boolean; - Val1, Val2: SizeInt; - begin - Result := 0; - IsReallyNumber := False; - // count leading spaces in S1 - while CharIsWhiteSpace(S1[Cur1]) do - begin - Dec(Result); - Inc(Cur1); - end; - // count leading spaces in S2 (canceling them out against the ones in S1) - while CharIsWhiteSpace(S2[Cur2]) do - begin - Inc(Result); - Inc(Cur2); - end; - - // if spaces match, or both strings are actually followed by a numeric character, continue the checks - if (Result = 0) or (CharIsNumberChar(S1[Cur1])) and (CharIsNumberChar(S2[Cur2])) then - begin - // Check signed number - if (S1[Cur1] = '-') and (S2[Cur2] <> '-') then - Result := 1 - else - if (S2[Cur2] = '-') and (S1[Cur1] <> '-') then - Result := -1 - else - Result := 0; - - if (S1[Cur1] = '-') or (S1[Cur1] = '+') then - Inc(Cur1); - if (S2[Cur2] = '-') or (S2[Cur2] = '+') then - Inc(Cur2); - - FirstDiffBreaks := (S1[Cur1] = '0') or (S2[Cur2] = '0'); - while CharIsDigit(S1[Cur1]) and CharIsDigit(S2[Cur2]) do - begin - IsReallyNumber := True; - Val1 := StrToInt(string(S1[Cur1])); - Val2 := StrToInt(string(S2[Cur2])); - - if (Result = 0) and (Val1 < Val2) then - Result := -1 - else - if (Result = 0) and (Val1 > Val2) then - Result := 1; - if FirstDiffBreaks and (Result <> 0) then - Break; - Inc(Cur1); - Inc(Cur2); - end; - - if IsReallyNumber then - begin - if not FirstDiffBreaks then - begin - if CharIsDigit(S1[Cur1]) then - Result := 1 - else - if CharIsDigit(S2[Cur2]) then - Result := -1; - end; - end; - end; - end; - -begin - Cur1 := 1; - Len1 := Length(S1); - Cur2 := 1; - Len2 := Length(S2); - Result := 0; - - while (Result = 0) do - begin - if (Cur1 = Len1) and (Cur2 = Len2) then - Break - else - if (S1[Cur1] = '-') and CharIsNumberChar(S2[Cur2]) and (S2[Cur2] <> '-') then - Result := -1 - else - if (S2[Cur2] = '-') and CharIsNumberChar(S1[Cur1]) and (S1[Cur1] <> '-') then - Result := 1 - else - if CharIsNumberChar(S1[Cur1]) and CharIsNumberChar(S2[Cur2]) then - NumberCompare - else - if (Cur1 = Len1) and (Cur2 < Len2) then - Result := -1 - else - if (Cur1 < Len1) and (Cur2 = Len2) then - Result := 1 - else - begin - Result := StrCompare(S1,S2); - if CaseInsensitive then - Result := AnsiStrLICompA(PAnsiChar(@S1[Cur1]), PAnsiChar(@S2[Cur2]), 1) - else - Result := AnsiStrLCompA(PAnsiChar(@S1[Cur1]), PAnsiChar(@S2[Cur2]), 1); - Inc(Cur1); - Inc(Cur2); - end; - end; -end; - -function AnsiCompareNaturalStr(const S1, S2: AnsiString): SizeInt; overload; -begin - Result := AnsiCompareNatural(S1, S2, False); -end; - -function AnsiCompareNaturalText(const S1, S2: AnsiString): SizeInt; overload; -begin - Result := AnsiCompareNatural(S1, S2, True); -end; - - -function StrNewA(const Str: PAnsiChar): PAnsiChar; -begin - Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrNew(Str); -end; - -procedure StrDisposeA(Str: PAnsiChar); -begin - {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrDispose(Str); -end; - -function StrLenA(S: PAnsiChar): Integer; -begin - Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrLen(S); -end; - -function StrEndA(const Str: PAnsiChar): PAnsiChar; -begin - Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrEnd(Str); -end; - -function StrPosA(const Str1, Str2: PAnsiChar): PAnsiChar; -begin - Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrPos(Str1, Str2); -end; - -function StrPasA(const Str: PAnsiChar): AnsiString; -begin - Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrPas(Str); -end; - -function StrCopyA(Dest: PAnsiChar; const Source: PAnsiChar): PAnsiChar; -begin - Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrCopy(Dest, Source); -end; - -function StrLCopyA(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar; -begin - Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrLCopy(Dest, Source, MaxLen); -end; - -function StrPCopyA(Dest: PAnsiChar; const Source: AnsiString): PAnsiChar; -begin - Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrPCopy(Dest, Source); -end; - -function StrPLCopyA(Dest: PAnsiChar; const Source: AnsiString; MaxLen: Cardinal): PAnsiChar; -begin - Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrPLCopy(Dest, Source, MaxLen); -end; - -function StrECopyA(Dest: PAnsiChar; const Source: PAnsiChar): PAnsiChar; -begin - Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrECopy(Dest, Source); -end; - -function StrCatA(Dest: PAnsiChar; const Source: PAnsiChar): PAnsiChar; -begin - Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrCat(Dest, Source); -end; - -function StrLCatA(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar; -begin - Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrLCat(Dest, Source, MaxLen); -end; - -function StrCompA(const Str1, Str2: PAnsiChar): Integer; -begin - Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrComp(Str1, Str2); -end; - -function StrLCompA(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer; -begin - Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrLComp(Str1, Str2, MaxLen); -end; - -function StrICompA(const Str1, Str2: PAnsiChar): Integer; -begin - Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrIComp(Str1, Str2); -end; - -function StrLICompA(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer; -begin - Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrIComp(Str1, Str2); -end; - -function StrFmtA(Buffer, Format: PAnsiChar; const Args: array of const): PAnsiChar; -begin - Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrFmt(Buffer, Format, Args); -end; - -function AnsiStrPosA(const Str1, Str2: PAnsiChar): PAnsiChar; -begin - Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}AnsiStrPos(Str1, Str2); -end; - -function AnsiStrLICompA(S1, S2: PAnsiChar; MaxLen: Cardinal): Integer; -begin - Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}AnsiStrLIComp(S1, S2, MaxLen); -end; - -function AnsiStrLCompA(S1, S2: PAnsiChar; MaxLen: Cardinal): Integer; -begin - Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}AnsiStrLComp(S1, S2, MaxLen); -end; - - -initialization - LoadCharTypes; // this table first - LoadCaseMap; // or this function does not work -{$IFDEF UNITVERSIONING} - RegisterUnitVersion(HInstance, UnitVersioning); - -finalization - UnregisterUnitVersion(HInstance); -{$ENDIF UNITVERSIONING} - -end. +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclStrings.pas. } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. } +{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. All rights reserved. } +{ } +{ Contributor(s): } +{ Alexander Radchenko } +{ Andreas Hausladen (ahuser) } +{ Anthony Steele } +{ Azret Botash } +{ Barry Kelly } +{ Huanlin Tsai } +{ Jack N.A. Bakker } +{ Jean-Fabien Connault (cycocrew) } +{ John C Molyneux } +{ Leonard Wennekers } +{ Martin Kimmings } +{ Martin Kubecka } +{ Massimo Maria Ghisalberti } +{ Matthias Thoma (mthoma) } +{ Michael Winter } +{ Nick Hodges } +{ Olivier Sannier (obones) } +{ Patrick Kolla } +{ Pelle F. S. Liljendal } +{ Petr Vones (pvones) } +{ Robert Lee } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Andreas Schmidt } +{ } +{**************************************************************************************************} +{ } +{ Various character and string routines (searching, testing and transforming) } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclAnsiStrings; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Winapi.Windows, + {$ENDIF MSWINDOWS} + System.Classes, System.SysUtils, + {$IFDEF HAS_UNIT_ANSISTRINGS} + System.AnsiStrings, + {$ENDIF HAS_UNIT_ANSISTRINGS} + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + Classes, SysUtils, + {$IFDEF HAS_UNIT_ANSISTRINGS} + AnsiStrings, + {$ENDIF HAS_UNIT_ANSISTRINGS} + {$ENDIF ~HAS_UNITSCOPE} + JclBase; + +// Ansi types + +type + {$IFDEF SUPPORTS_UNICODE} + TJclAnsiStringList = class; + + // Codegear should be the one providing this class, in the AnsiStrings unit. + // It has been requested in QC 65630 but this was closed as "won't do". + // So we are providing here a very light implementation that is designed + // to provide the basics, and in no way be a "copy/paste" of what is in the RTL. + TJclAnsiStrings = class(TPersistent) + private + FDelimiter: AnsiChar; + FNameValueSeparator: AnsiChar; + FStrictDelimiter: Boolean; + FQuoteChar: AnsiChar; + FUpdateCount: Integer; + function GetText: AnsiString; + procedure SetText(const Value: AnsiString); + function GetCommaText: AnsiString; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + procedure SetCommaText(const Value: AnsiString); {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + function GetDelimitedText: AnsiString; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + function GetDelimitedText(const ADelimiter: AnsiString; AQuoteChar: AnsiChar): AnsiString; overload; + procedure SetDelimitedText(const Value: AnsiString); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + procedure SetDelimitedText(const Value, ADelimiter: AnsiString; AQuoteChar: AnsiChar); overload; + function ExtractName(const S: AnsiString): AnsiString; + function GetName(Index: Integer): AnsiString; + function GetValue(const Name: AnsiString): AnsiString; + procedure SetValue(const Name, Value: AnsiString); + function GetValueFromIndex(Index: Integer): AnsiString; + procedure SetValueFromIndex(Index: Integer; const Value: AnsiString); + protected + procedure AssignTo(Dest: TPersistent); override; + + procedure Error(const Msg: string; Data: Integer); overload; + procedure Error(Msg: PResStringRec; Data: Integer); overload; + + function GetString(Index: Integer): AnsiString; virtual; abstract; + procedure SetString(Index: Integer; const Value: AnsiString); virtual; abstract; + function GetObject(Index: Integer): TObject; virtual; abstract; + procedure SetObject(Index: Integer; AObject: TObject); virtual; abstract; + + function GetCapacity: Integer; virtual; + procedure SetCapacity(const Value: Integer); virtual; + function GetCount: Integer; virtual; abstract; + function CompareStrings(const S1, S2: AnsiString): Integer; virtual; + procedure SetUpdateState(Updating: Boolean); virtual; + property UpdateCount: Integer read FUpdateCount; + public + constructor Create; + + procedure Assign(Source: TPersistent); override; + + function Add(const S: AnsiString): Integer; virtual; + function AddObject(const S: AnsiString; AObject: TObject): Integer; virtual; abstract; + procedure AddStrings(Strings: TJclAnsiStrings); virtual; + procedure Insert(Index: Integer; const S: AnsiString); virtual; + procedure InsertObject(Index: Integer; const S: AnsiString; AObject: TObject); virtual; abstract; + procedure Delete(Index: Integer); virtual; abstract; + procedure Clear; virtual; abstract; + procedure LoadFromFile(const FileName: TFileName); virtual; + procedure LoadFromStream(Stream: TStream); virtual; + procedure SaveToFile(const FileName: TFileName); virtual; + procedure SaveToStream(Stream: TStream); virtual; + procedure BeginUpdate; + procedure EndUpdate; + function IndexOf(const S: AnsiString): Integer; virtual; + function IndexOfName(const Name: AnsiString): Integer; virtual; + function IndexOfObject(AObject: TObject): Integer; virtual; + procedure Exchange(Index1, Index2: Integer); virtual; + + property Delimiter: AnsiChar read FDelimiter write FDelimiter; + property DelimitedText: AnsiString read GetDelimitedText write SetDelimitedText; + property CommaText: AnsiString read GetCommaText write SetCommaText; + property StrictDelimiter: Boolean read FStrictDelimiter write FStrictDelimiter; + property QuoteChar: AnsiChar read FQuoteChar write FQuoteChar; + + property Strings[Index: Integer]: AnsiString read GetString write SetString; default; + property Objects[Index: Integer]: TObject read GetObject write SetObject; + property Text: AnsiString read GetText write SetText; + property Count: Integer read GetCount; + property Capacity: Integer read GetCapacity write SetCapacity; + property Names[Index: Integer]: AnsiString read GetName; + property Values[const Name: AnsiString]: AnsiString read GetValue write SetValue; + property ValueFromIndex[Index: Integer]: AnsiString read GetValueFromIndex write SetValueFromIndex; + property NameValueSeparator: AnsiChar read FNameValueSeparator write FNameValueSeparator; + end; + + TJclAnsiStringListSortCompare = function(List: TJclAnsiStringList; Index1, Index2: Integer): Integer; + + TJclAnsiStringObjectHolder = record + Str: AnsiString; + Obj: TObject; + end; + + TJclAnsiStringList = class(TJclAnsiStrings) + private + FStrings: array of TJclAnsiStringObjectHolder; + FCount: Integer; + FDuplicates: TDuplicates; + FSorted: Boolean; + FCaseSensitive: Boolean; + FOnChange: TNotifyEvent; + FOnChanging: TNotifyEvent; + procedure Grow; + procedure QuickSort(L, R: Integer; SCompare: TJclAnsiStringListSortCompare); + procedure SetSorted(Value: Boolean); + protected + procedure AssignTo(Dest: TPersistent); override; + function GetString(Index: Integer): AnsiString; override; + procedure SetString(Index: Integer; const Value: AnsiString); override; + function GetObject(Index: Integer): TObject; override; + procedure SetObject(Index: Integer; AObject: TObject); override; + function GetCapacity: Integer; override; + procedure SetCapacity(const Value: Integer); override; + function GetCount: Integer; override; + function CompareStrings(const S1, S2: AnsiString): Integer; override; + procedure SetUpdateState(Updating: Boolean); override; + + procedure Changed; virtual; + procedure Changing; virtual; + public + constructor Create; + destructor Destroy; override; + + function AddObject(const S: AnsiString; AObject: TObject): Integer; override; + procedure Assign(Source: TPersistent); override; + procedure InsertObject(Index: Integer; const S: AnsiString; AObject: TObject); override; + procedure Delete(Index: Integer); override; + function Find(const S: AnsiString; var Index: Integer): Boolean; virtual; + procedure CustomSort(Compare: TJclAnsiStringListSortCompare); virtual; + procedure Sort; virtual; + procedure Clear; override; + + property CaseSensitive: Boolean read FCaseSensitive write FCaseSensitive; + property Duplicates: TDuplicates read FDuplicates write FDuplicates; + property Sorted: Boolean read FSorted write SetSorted; + + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property OnChanging: TNotifyEvent read FOnChanging write FOnChanging; + end; + {$ELSE ~SUPPORTS_UNICODE} + TJclAnsiStrings = Classes.TStrings; + TJclAnsiStringList = Classes.TStringList; + {$ENDIF ~SUPPORTS_UNICODE} + + TAnsiStrings = TJclAnsiStrings; + TAnsiStringList = TJclAnsiStringList; + +// Exceptions +type + EJclAnsiStringError = class(EJclError); + EJclAnsiStringListError = class(EJclAnsiStringError); + +// Character constants and sets + +const + // Misc. often used character definitions + AnsiNull = AnsiChar(#0); + AnsiSoh = AnsiChar(#1); + AnsiStx = AnsiChar(#2); + AnsiEtx = AnsiChar(#3); + AnsiEot = AnsiChar(#4); + AnsiEnq = AnsiChar(#5); + AnsiAck = AnsiChar(#6); + AnsiBell = AnsiChar(#7); + AnsiBackspace = AnsiChar(#8); + AnsiTab = AnsiChar(#9); + AnsiLineFeed = AnsiChar(#10); + AnsiVerticalTab = AnsiChar(#11); + AnsiFormFeed = AnsiChar(#12); + AnsiCarriageReturn = AnsiChar(#13); + AnsiCrLf = AnsiString(#13#10); + AnsiSo = AnsiChar(#14); + AnsiSi = AnsiChar(#15); + AnsiDle = AnsiChar(#16); + AnsiDc1 = AnsiChar(#17); + AnsiDc2 = AnsiChar(#18); + AnsiDc3 = AnsiChar(#19); + AnsiDc4 = AnsiChar(#20); + AnsiNak = AnsiChar(#21); + AnsiSyn = AnsiChar(#22); + AnsiEtb = AnsiChar(#23); + AnsiCan = AnsiChar(#24); + AnsiEm = AnsiChar(#25); + AnsiEndOfFile = AnsiChar(#26); + AnsiEscape = AnsiChar(#27); + AnsiFs = AnsiChar(#28); + AnsiGs = AnsiChar(#29); + AnsiRs = AnsiChar(#30); + AnsiUs = AnsiChar(#31); + AnsiSpace = AnsiChar(' '); + AnsiComma = AnsiChar(','); + AnsiBackslash = AnsiChar('\'); + AnsiForwardSlash = AnsiChar('/'); + + AnsiDoubleQuote = AnsiChar('"'); + AnsiSingleQuote = AnsiChar(''''); + + {$IFDEF MSWINDOWS} + AnsiLineBreak = AnsiCrLf; + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + AnsiLineBreak = AnsiLineFeed; + {$ENDIF UNIX} + + AnsiSignMinus = AnsiChar('-'); + AnsiSignPlus = AnsiChar('+'); + + // Misc. character sets + + AnsiWhiteSpace = [AnsiTab, AnsiLineFeed, AnsiVerticalTab, + AnsiFormFeed, AnsiCarriageReturn, AnsiSpace]; + AnsiSigns = [AnsiSignMinus, AnsiSignPlus]; + AnsiUppercaseLetters = ['A'..'Z']; + AnsiLowercaseLetters = ['a'..'z']; + AnsiLetters = ['A'..'Z', 'a'..'z']; + AnsiDecDigits = ['0'..'9']; + AnsiOctDigits = ['0'..'7']; + AnsiHexDigits = ['0'..'9', 'A'..'F', 'a'..'f']; + AnsiValidIdentifierLetters = ['0'..'9', 'A'..'Z', 'a'..'z', '_']; + +const + // CharType return values + C1_UPPER = $0001; // Uppercase + C1_LOWER = $0002; // Lowercase + C1_DIGIT = $0004; // Decimal digits + C1_SPACE = $0008; // Space characters + C1_PUNCT = $0010; // Punctuation + C1_CNTRL = $0020; // Control characters + C1_BLANK = $0040; // Blank characters + C1_XDIGIT = $0080; // Hexadecimal digits + C1_ALPHA = $0100; // Any linguistic character: alphabetic, syllabary, or ideographic + + {$IFDEF MSWINDOWS} + {$IFDEF SUPPORTS_EXTSYM} + {$EXTERNALSYM C1_UPPER} + {$EXTERNALSYM C1_LOWER} + {$EXTERNALSYM C1_DIGIT} + {$EXTERNALSYM C1_SPACE} + {$EXTERNALSYM C1_PUNCT} + {$EXTERNALSYM C1_CNTRL} + {$EXTERNALSYM C1_BLANK} + {$EXTERNALSYM C1_XDIGIT} + {$EXTERNALSYM C1_ALPHA} + {$ENDIF SUPPORTS_EXTSYM} + {$ENDIF MSWINDOWS} + +// String Test Routines +function StrIsAlpha(const S: AnsiString): Boolean; +function StrIsAlphaNum(const S: AnsiString): Boolean; +function StrIsAlphaNumUnderscore(const S: AnsiString): Boolean; +function StrContainsChars(const S: AnsiString; Chars: TSysCharSet; CheckAll: Boolean): Boolean; +function StrConsistsOfNumberChars(const S: AnsiString): Boolean; +function StrIsDigit(const S: AnsiString): Boolean; +function StrIsSubset(const S: AnsiString; const ValidChars: TSysCharSet): Boolean; +function StrSame(const S1, S2: AnsiString): Boolean; + +// String Transformation Routines +function StrCenter(const S: AnsiString; L: SizeInt; C: AnsiChar = ' '): AnsiString; +function StrCharPosLower(const S: AnsiString; CharPos: SizeInt): AnsiString; +function StrCharPosUpper(const S: AnsiString; CharPos: SizeInt): AnsiString; +function StrDoubleQuote(const S: AnsiString): AnsiString; +function StrEnsureNoPrefix(const Prefix, Text: AnsiString): AnsiString; +function StrEnsureNoSuffix(const Suffix, Text: AnsiString): AnsiString; +function StrEnsurePrefix(const Prefix, Text: AnsiString): AnsiString; +function StrEnsureSuffix(const Suffix, Text: AnsiString): AnsiString; +function StrEscapedToString(const S: AnsiString): AnsiString; +function StrLower(const S: AnsiString): AnsiString; +procedure StrLowerInPlace(var S: AnsiString); +procedure StrLowerBuff(S: PAnsiChar); +procedure StrMove(var Dest: AnsiString; const Source: AnsiString; const ToIndex, + FromIndex, Count: SizeInt); +function StrPadLeft(const S: AnsiString; Len: SizeInt; C: AnsiChar = AnsiSpace): AnsiString; +function StrPadRight(const S: AnsiString; Len: SizeInt; C: AnsiChar = AnsiSpace): AnsiString; +function StrProper(const S: AnsiString): AnsiString; +procedure StrProperBuff(S: PAnsiChar); +function StrQuote(const S: AnsiString; C: AnsiChar): AnsiString; +function StrRemoveChars(const S: AnsiString; const Chars: TSysCharSet): AnsiString; +function StrKeepChars(const S: AnsiString; const Chars: TSysCharSet): AnsiString; +procedure StrReplace(var S: AnsiString; const Search, Replace: AnsiString; Flags: TReplaceFlags = []); +function StrReplaceChar(const S: AnsiString; const Source, Replace: AnsiChar): AnsiString; +function StrReplaceChars(const S: AnsiString; const Chars: TSysCharSet; Replace: AnsiChar): AnsiString; +function StrReplaceButChars(const S: AnsiString; const Chars: TSysCharSet; Replace: AnsiChar): AnsiString; +function StrRepeat(const S: AnsiString; Count: SizeInt): AnsiString; +function StrRepeatLength(const S: AnsiString; const L: SizeInt): AnsiString; +function StrReverse(const S: AnsiString): AnsiString; +procedure StrReverseInPlace(var S: AnsiString); +function StrSingleQuote(const S: AnsiString): AnsiString; +procedure StrSkipChars(var S: PAnsiChar; const Chars: TSysCharSet); overload; +procedure StrSkipChars(const S: AnsiString; var Index: SizeInt; const Chars: TSysCharSet); overload; +function StrSmartCase(const S: AnsiString; Delimiters: TSysCharSet): AnsiString; +function StrStringToEscaped(const S: AnsiString): AnsiString; +function StrStripNonNumberChars(const S: AnsiString): AnsiString; +function StrToHex(const Source: AnsiString): AnsiString; +function StrTrimCharLeft(const S: AnsiString; C: AnsiChar): AnsiString; +function StrTrimCharsLeft(const S: AnsiString; const Chars: TSysCharSet): AnsiString; +function StrTrimCharRight(const S: AnsiString; C: AnsiChar): AnsiString; +function StrTrimCharsRight(const S: AnsiString; const Chars: TSysCharSet): AnsiString; +function StrTrimQuotes(const S: AnsiString): AnsiString; overload; +function StrTrimQuotes(const S: AnsiString; QuoteChar: AnsiChar): AnsiString; overload; +function StrUpper(const S: AnsiString): AnsiString; +procedure StrUpperInPlace(var S: AnsiString); +procedure StrUpperBuff(S: PAnsiChar); + +{$IFDEF MSWINDOWS} +function StrOemToAnsi(const S: AnsiString): AnsiString; +function StrAnsiToOem(const S: AnsiString): AnsiString; +{$ENDIF MSWINDOWS} + +// String Management +procedure StrAddRef(var S: AnsiString); +procedure StrDecRef(var S: AnsiString); +function StrLength(const S: AnsiString): Longint; +function StrRefCount(const S: AnsiString): Longint; +procedure StrResetLength(var S: AnsiString); + +// String Search and Replace Routines +function StrCharCount(const S: AnsiString; C: AnsiChar): SizeInt; +function StrCharsCount(const S: AnsiString; Chars: TSysCharSet): SizeInt; +function StrStrCount(const S, SubS: AnsiString): SizeInt; +function StrCompare(const S1, S2: AnsiString; CaseSensitive: Boolean = False): SizeInt; +function StrCompareRangeEx(const S1, S2: AnsiString; Index, Count: SizeInt; CaseSensitive: Boolean = False): SizeInt; +function StrCompareRange(const S1, S2: AnsiString; Index, Count: SizeInt; CaseSensitive: Boolean = True): SizeInt; +function StrRepeatChar(C: AnsiChar; Count: SizeInt): AnsiString; +function StrFind(const Substr, S: AnsiString; const Index: SizeInt = 1): SizeInt; +function StrHasPrefix(const S: AnsiString; const Prefixes: array of AnsiString): Boolean; +function StrHasSuffix(const S: AnsiString; const Suffixes: array of AnsiString): Boolean; +function StrIHasPrefix(const S: AnsiString; const Prefixes: array of AnsiString): Boolean; +function StrIHasSuffix(const S: AnsiString; const Suffixes: array of AnsiString): Boolean; +function StrIndex(const S: AnsiString; const List: array of AnsiString; CaseSensitive: Boolean = False): SizeInt; +function StrILastPos(const SubStr, S: AnsiString): SizeInt; +function StrIPos(const SubStr, S: AnsiString): SizeInt; +function StrIPrefixIndex(const S: AnsiString; const Prefixes: array of AnsiString): SizeInt; +function StrIsOneOf(const S: AnsiString; const List: array of AnsiString): Boolean; +function StrISuffixIndex(const S: AnsiString; const Suffixes: array of AnsiString): SizeInt; +function StrLastPos(const SubStr, S: AnsiString): SizeInt; +function StrMatch(const Substr, S: AnsiString; Index: SizeInt = 1): SizeInt; +function StrMatches(const Substr, S: AnsiString; const Index: SizeInt = 1): Boolean; +function StrNIPos(const S, SubStr: AnsiString; N: SizeInt): SizeInt; +function StrNPos(const S, SubStr: AnsiString; N: SizeInt): SizeInt; +function StrPrefixIndex(const S: AnsiString; const Prefixes: array of AnsiString): SizeInt; +function StrSearch(const Substr, S: AnsiString; const Index: SizeInt = 1): SizeInt; +function StrSuffixIndex(const S: AnsiString; const Suffixes: array of AnsiString): SizeInt; + +// String Extraction +// String Extraction +// Returns the String before SubStr +function StrAfter(const SubStr, S: AnsiString): AnsiString; +/// Returns the AnsiString after SubStr +function StrBefore(const SubStr, S: AnsiString): AnsiString; +/// Splits a AnsiString at SubStr, returns true when SubStr is found, Left contains the +/// AnsiString before the SubStr and Rigth the AnsiString behind SubStr +function StrSplit(const SubStr, S: AnsiString;var Left, Right : AnsiString): boolean; +/// Returns the AnsiString between Start and Stop +function StrBetween(const S: AnsiString; const Start, Stop: AnsiChar): AnsiString; +/// Returns the left N characters of the AnsiString +function StrChopRight(const S: AnsiString; N: SizeInt): AnsiString; +/// Returns the left Count characters of the AnsiString +function StrLeft(const S: AnsiString; Count: SizeInt): AnsiString; +/// Returns the AnsiString starting from position Start for the Count Characters +function StrMid(const S: AnsiString; Start, Count: SizeInt): AnsiString; +/// Returns the AnsiString starting from position N to the end +function StrRestOf(const S: AnsiString; N: SizeInt): AnsiString; +/// Returns the right Count characters of the AnsiString +function StrRight(const S: AnsiString; Count: SizeInt): AnsiString; + +// Character Test Routines +function CharEqualNoCase(const C1, C2: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsAlpha(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsAlphaNum(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsBlank(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsControl(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsDelete(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsDigit(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsFracDigit(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsHexDigit(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsLower(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsNumberChar(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsNumber(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsPrintable(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsPunctuation(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsReturn(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsSpace(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsUpper(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsValidIdentifierLetter(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsWhiteSpace(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsWildcard(const C: AnsiChar): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharType(const C: AnsiChar): Word; + +// Character Transformation Routines +function CharHex(const C: AnsiChar): Byte; +function CharLower(const C: AnsiChar): AnsiChar; +function CharUpper(const C: AnsiChar): AnsiChar; +function CharToggleCase(const C: AnsiChar): AnsiChar; + +// Character Search and Replace +function CharPos(const S: AnsiString; const C: AnsiChar; const Index: SizeInt = 1): SizeInt; +function CharLastPos(const S: AnsiString; const C: AnsiChar; const Index: SizeInt = 1): SizeInt; +function CharIPos(const S: AnsiString; C: AnsiChar; const Index: SizeInt = 1): SizeInt; +function CharReplace(var S: AnsiString; const Search, Replace: AnsiChar): SizeInt; + +// PCharVector +type + PAnsiCharVector = ^PAnsiChar; + +function StringsToPCharVector(var Dest: PAnsiCharVector; const Source: TJclAnsiStrings): PAnsiCharVector; +function PCharVectorCount(Source: PAnsiCharVector): SizeInt; +procedure PCharVectorToStrings(const Dest: TJclAnsiStrings; Source: PAnsiCharVector); +procedure FreePCharVector(var Dest: PAnsiCharVector); + +// MultiSz Routines +type + PAnsiMultiSz = PAnsiChar; + +function StringsToMultiSz(var Dest: PAnsiMultiSz; const Source: TJclAnsiStrings): PAnsiMultiSz; +procedure MultiSzToStrings(const Dest: TJclAnsiStrings; const Source: PAnsiMultiSz); +function MultiSzLength(const Source: PAnsiMultiSz): SizeInt; +procedure AllocateMultiSz(var Dest: PAnsiMultiSz; Len: SizeInt); +procedure FreeMultiSz(var Dest: PAnsiMultiSz); +function MultiSzDup(const Source: PAnsiMultiSz): PAnsiMultiSz; + +// TJclAnsiStrings Manipulation +procedure StrIToStrings(S, Sep: AnsiString; const List: TJclAnsiStrings; const AllowEmptyString: Boolean = True); +procedure StrToStrings(S, Sep: AnsiString; const List: TJclAnsiStrings; const AllowEmptyString: Boolean = True); +function StringsToStr(const List: TJclAnsiStrings; const Sep: AnsiString; const AllowEmptyString: Boolean = True): AnsiString; +procedure TrimStrings(const List: TJclAnsiStrings; DeleteIfEmpty: Boolean = True); +procedure TrimStringsRight(const List: TJclAnsiStrings; DeleteIfEmpty: Boolean = True); +procedure TrimStringsLeft(const List: TJclAnsiStrings; DeleteIfEmpty: Boolean = True); +function AddStringToStrings(const S: AnsiString; Strings: TJclAnsiStrings; const Unique: Boolean): Boolean; + +// Miscellaneous +// (OF) moved to JclSysUtils +//function BooleanToStr(B: Boolean): AnsiString; +function FileToString(const FileName: TFileName): AnsiString; +procedure StringToFile(const FileName: TFileName; const Contents: AnsiString; Append: Boolean = False); +function StrToken(var S: AnsiString; Separator: AnsiChar): AnsiString; +procedure StrTokens(const S: AnsiString; const List: TJclAnsiStrings); +procedure StrTokenToStrings(S: AnsiString; Separator: AnsiChar; const List: TJclAnsiStrings); +function StrWord(const S: AnsiString; var Index: SizeInt; out Word: AnsiString): Boolean; overload; +function StrWord(var S: PAnsiChar; out Word: AnsiString): Boolean; overload; +function StrIdent(const S: AnsiString; var Index: SizeInt; out Ident: AnsiString): Boolean; overload; +function StrIdent(var S: PAnsiChar; out Ident: AnsiString): Boolean; overload; +function StrToFloatSafe(const S: AnsiString): Float; +function StrToIntSafe(const S: AnsiString): Integer; +procedure StrNormIndex(const StrLen: SizeInt; var Index: SizeInt; var Count: SizeInt); overload; + +function ArrayOf(List: TJclAnsiStrings): TDynStringArray; overload; + +function AnsiCompareNaturalStr(const S1, S2: AnsiString): SizeInt; +function AnsiCompareNaturalText(const S1, S2: AnsiString): SizeInt; + +// Explicit ANSI version of former/deprecated SysUtils PAnsiChar functions +{$IFNDEF DEPRECATED_SYSUTILS_ANSISTRINGS} + {$IFDEF SUPPORTS_INLINE} + {$DEFINE ANSI_INLINE} // inline if the functions are in SysUtils but don't force the user to include System.AnsiStrings + {$ENDIF SUPPORTS_INLINE} +{$ENDIF ~DEPRECATED_SYSUTILS_ANSISTRINGS} +function StrNewA(const Str: PAnsiChar): PAnsiChar; {$IFDEF ANSI_INLINE}inline;{$ENDIF} +procedure StrDisposeA(Str: PAnsiChar); {$IFDEF ANSI_INLINE}inline;{$ENDIF} + +function StrLenA(S: PAnsiChar): Integer; {$IFDEF ANSI_INLINE}inline;{$ENDIF} +function StrEndA(const Str: PAnsiChar): PAnsiChar; {$IFDEF ANSI_INLINE}inline;{$ENDIF} +function StrPosA(const Str1, Str2: PAnsiChar): PAnsiChar; {$IFDEF ANSI_INLINE}inline;{$ENDIF} +function StrPasA(const Str: PAnsiChar): AnsiString; {$IFDEF ANSI_INLINE}inline;{$ENDIF} +function StrCopyA(Dest: PAnsiChar; const Source: PAnsiChar): PAnsiChar; {$IFDEF ANSI_INLINE}inline;{$ENDIF} +function StrLCopyA(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar; {$IFDEF ANSI_INLINE}inline;{$ENDIF} +function StrPCopyA(Dest: PAnsiChar; const Source: AnsiString): PAnsiChar; {$IFDEF ANSI_INLINE}inline;{$ENDIF} +function StrPLCopyA(Dest: PAnsiChar; const Source: AnsiString; MaxLen: Cardinal): PAnsiChar; {$IFDEF ANSI_INLINE}inline;{$ENDIF} +function StrECopyA(Dest: PAnsiChar; const Source: PAnsiChar): PAnsiChar; {$IFDEF ANSI_INLINE}inline;{$ENDIF} +function StrCatA(Dest: PAnsiChar; const Source: PAnsiChar): PAnsiChar; {$IFDEF ANSI_INLINE}inline;{$ENDIF} +function StrLCatA(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar; {$IFDEF ANSI_INLINE}inline;{$ENDIF} +function StrCompA(const Str1, Str2: PAnsiChar): Integer; {$IFDEF ANSI_INLINE}inline;{$ENDIF} +function StrLCompA(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer; {$IFDEF ANSI_INLINE}inline;{$ENDIF} +function StrICompA(const Str1, Str2: PAnsiChar): Integer; {$IFDEF ANSI_INLINE}inline;{$ENDIF} +function StrLICompA(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer; {$IFDEF ANSI_INLINE}inline;{$ENDIF} + +function StrFmtA(Buffer, Format: PAnsiChar; const Args: array of const): PAnsiChar; + +function AnsiStrPosA(const Str1, Str2: PAnsiChar): PAnsiChar; {$IFDEF ANSI_INLINE}inline;{$ENDIF} +function AnsiStrLICompA(S1, S2: PAnsiChar; MaxLen: Cardinal): Integer; {$IFDEF ANSI_INLINE}inline;{$ENDIF} +function AnsiStrLCompA(S1, S2: PAnsiChar; MaxLen: Cardinal): Integer; {$IFDEF ANSI_INLINE}inline;{$ENDIF} + + +// internal structures published to make function inlining working +const + AnsiCharCount = Ord(High(AnsiChar)) + 1; // # of chars in one set + AnsiLoOffset = AnsiCharCount * 0; // offset to lower case chars + AnsiUpOffset = AnsiCharCount * 1; // offset to upper case chars + AnsiReOffset = AnsiCharCount * 2; // offset to reverse case chars + AnsiCaseMapSize = AnsiCharCount * 3; // # of chars is a table + +var + AnsiCaseMap: array [0..AnsiCaseMapSize - 1] of AnsiChar; // case mappings + AnsiCaseMapReady: Boolean = False; // true if case map exists + AnsiCharTypes: array [AnsiChar] of Word; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + {$IFDEF SUPPORTS_UNICODE} + {$IFDEF HAS_UNIT_RTLCONSTS} + {$IFDEF HAS_UNITSCOPE} + System.RTLConsts, + {$ELSE ~HAS_UNITSCOPE} + RtlConsts, + {$ENDIF} + {$ENDIF HAS_UNIT_RTLCONSTS} + {$ENDIF SUPPORTS_UNICODE} + JclLogic, JclResources, JclStreams, JclSynch, JclSysUtils; + +//=== Internal =============================================================== + +type + TAnsiStrRec = packed record + RefCount: Integer; + Length: Integer; + end; + PAnsiStrRec = ^TAnsiStrRec; + +const + AnsiStrRecSize = SizeOf(TAnsiStrRec); // size of the AnsiString header rec + +procedure LoadCharTypes; +var + CurrChar: AnsiChar; + CurrType: Word; +begin + for CurrChar := Low(AnsiChar) to High(AnsiChar) do + begin + {$IFDEF MSWINDOWS} + CurrType := 0; + GetStringTypeExA(LOCALE_USER_DEFAULT, CT_CTYPE1, @CurrChar, SizeOf(AnsiChar), CurrType); + {$DEFINE CHAR_TYPES_INITIALIZED} + {$ENDIF MSWINDOWS} + {$IFDEF LINUX} + CurrType := 0; + if isupper(Byte(CurrChar)) <> 0 then + CurrType := CurrType or C1_UPPER; + if islower(Byte(CurrChar)) <> 0 then + CurrType := CurrType or C1_LOWER; + if isdigit(Byte(CurrChar)) <> 0 then + CurrType := CurrType or C1_DIGIT; + if isspace(Byte(CurrChar)) <> 0 then + CurrType := CurrType or C1_SPACE; + if ispunct(Byte(CurrChar)) <> 0 then + CurrType := CurrType or C1_PUNCT; + if iscntrl(Byte(CurrChar)) <> 0 then + CurrType := CurrType or C1_CNTRL; + if isblank(Byte(CurrChar)) <> 0 then + CurrType := CurrType or C1_BLANK; + if isxdigit(Byte(CurrChar)) <> 0 then + CurrType := CurrType or C1_XDIGIT; + if isalpha(Byte(CurrChar)) <> 0 then + CurrType := CurrType or C1_ALPHA; + {$DEFINE CHAR_TYPES_INITIALIZED} + {$ENDIF LINUX} + AnsiCharTypes[CurrChar] := CurrType; + {$IFNDEF CHAR_TYPES_INITIALIZED} + Implement case map initialization here + {$ENDIF ~CHAR_TYPES_INITIALIZED} + end; +end; + +procedure LoadCaseMap; +var + CurrChar, UpCaseChar, LoCaseChar, ReCaseChar: AnsiChar; +begin + if not AnsiCaseMapReady then + begin + for CurrChar := Low(AnsiChar) to High(AnsiChar) do + begin + {$IFDEF MSWINDOWS} + LoCaseChar := CurrChar; + UpCaseChar := CurrChar; + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CharLowerBuffA(@LoCaseChar, 1); + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CharUpperBuffA(@UpCaseChar, 1); + {$DEFINE CASE_MAP_INITIALIZED} + {$ENDIF MSWINDOWS} + {$IFDEF LINUX} + LoCaseChar := AnsiChar(tolower(Byte(CurrChar))); + UpCaseChar := AnsiChar(toupper(Byte(CurrChar))); + {$DEFINE CASE_MAP_INITIALIZED} + {$ENDIF LINUX} + {$IFNDEF CASE_MAP_INITIALIZED} + Implement case map initialization here + {$ENDIF ~CASE_MAP_INITIALIZED} + if CharIsUpper(CurrChar) then + ReCaseChar := LoCaseChar + else + if CharIsLower(CurrChar) then + ReCaseChar := UpCaseChar + else + ReCaseChar := CurrChar; + AnsiCaseMap[Ord(CurrChar) + AnsiLoOffset] := LoCaseChar; + AnsiCaseMap[Ord(CurrChar) + AnsiUpOffset] := UpCaseChar; + AnsiCaseMap[Ord(CurrChar) + AnsiReOffset] := ReCaseChar; + end; + AnsiCaseMapReady := True; + end; +end; + +// Uppercases or Lowercases a give AnsiString depending on the +// passed offset. (UpOffset or LoOffset) + +procedure StrCase(var Str: AnsiString; const Offset: SizeInt); +var + P: PAnsiChar; + I, L: SizeInt; +begin + if Str <> '' then + begin + UniqueString(Str); + P := PAnsiChar(Str); + L := Length(Str); + for I := 1 to L do + begin + P^ := AnsiCaseMap[Offset + Ord(P^)]; + Inc(P); + end; + end; +end; + +// Internal utility function +// Uppercases or Lowercases a give null terminated string depending on the +// passed offset. (UpOffset or LoOffset) + +procedure StrCaseBuff(S: PAnsiChar; const Offset: SizeInt); +begin + if (S <> nil) and (S^ <> #0) then + begin + repeat + S^ := AnsiCaseMap[Offset + Ord(S^)]; + Inc(S); + until S^ = #0; + end; +end; + +{$IFDEF SUPPORTS_UNICODE} + +//=== { TJclAnsiStrings } ==================================================== + +constructor TJclAnsiStrings.Create; +begin + inherited Create; + + FDelimiter := ','; + FNameValueSeparator := '='; + FQuoteChar := '"'; + FStrictDelimiter := False; +end; + +procedure TJclAnsiStrings.Assign(Source: TPersistent); +var + StringsSource: TStrings; + I: Integer; +begin + if Source is TStrings then + begin + StringsSource := TStrings(Source); + BeginUpdate; + try + Clear; + FDelimiter := AnsiChar(StringsSource.Delimiter); + FNameValueSeparator := AnsiChar(StringsSource.NameValueSeparator); + for I := 0 to StringsSource.Count - 1 do + AddObject(AnsiString(StringsSource.Strings[I]), StringsSource.Objects[I]); + finally + EndUpdate; + end; + end + else + inherited Assign(Source); +end; + +procedure TJclAnsiStrings.AssignTo(Dest: TPersistent); +var + StringsDest: TStrings; + AnsiStringsDest: TJclAnsiStrings; + I: Integer; +begin + if Dest is TStrings then + begin + StringsDest := TStrings(Dest); + StringsDest.BeginUpdate; + try + StringsDest.Clear; + StringsDest.Delimiter := Char(Delimiter); + StringsDest.NameValueSeparator := Char(NameValueSeparator); + for I := 0 to Count - 1 do + StringsDest.AddObject(string(Strings[I]), Objects[I]); + finally + StringsDest.EndUpdate; + end; + end + else + if Dest is TJclAnsiStrings then + begin + AnsiStringsDest := TJclAnsiStrings(Dest); + AnsiStringsDest.BeginUpdate; + try + AnsiStringsDest.Clear; + AnsiStringsDest.FNameValueSeparator := FNameValueSeparator; + AnsiStringsDest.FDelimiter := FDelimiter; + for I := 0 to Count - 1 do + AnsiStringsDest.AddObject(Strings[I], Objects[I]); + finally + AnsiStringsDest.EndUpdate; + end; + end + else + inherited AssignTo(Dest); +end; + +function TJclAnsiStrings.Add(const S: AnsiString): Integer; +begin + Result := AddObject(S, nil); +end; + +procedure TJclAnsiStrings.AddStrings(Strings: TJclAnsiStrings); +var + I: Integer; +begin + for I := 0 to Strings.Count - 1 do + Add(Strings.Strings[I]); +end; + +procedure TJclAnsiStrings.Error(const Msg: string; Data: Integer); +begin + raise EJclAnsiStringListError.CreateFmt(Msg, [Data]); +end; + +procedure TJclAnsiStrings.Error(Msg: PResStringRec; Data: Integer); +begin + Error(LoadResString(Msg), Data); +end; + +function TJclAnsiStrings.CompareStrings(const S1, S2: AnsiString): Integer; +begin + Result := CompareStr(S1, S2); +end; + +procedure TJclAnsiStrings.SetUpdateState(Updating: Boolean); +begin +end; + +function TJclAnsiStrings.IndexOf(const S: AnsiString): Integer; +begin + for Result := 0 to Count - 1 do + if CompareStrings(Strings[Result], S) = 0 then + Exit; + Result := -1; +end; + +function TJclAnsiStrings.IndexOfName(const Name: AnsiString): Integer; +var + P: Integer; + S: AnsiString; +begin + for Result := 0 to Count - 1 do + begin + S := Strings[Result]; + P := AnsiPos(NameValueSeparator, S); + if (P > 0) and (CompareStrings(Copy(S, 1, P - 1), Name) = 0) then + Exit; + end; + Result := -1; +end; + +function TJclAnsiStrings.IndexOfObject(AObject: TObject): Integer; +begin + for Result := 0 to Count - 1 do + if Objects[Result] = AObject then + Exit; + Result := -1; +end; + +procedure TJclAnsiStrings.Exchange(Index1, Index2: Integer); +var + TempString: AnsiString; + TempObject: TObject; +begin + BeginUpdate; + try + TempString := Strings[Index1]; + TempObject := Objects[Index1]; + Strings[Index1] := Strings[Index2]; + Objects[Index1] := Objects[Index2]; + Strings[Index2] := TempString; + Objects[Index2] := TempObject; + finally + EndUpdate; + end; +end; + +function TJclAnsiStrings.GetCommaText: AnsiString; +begin + Result := GetDelimitedText(AnsiComma, AnsiDoubleQuote); +end; + +function TJclAnsiStrings.GetDelimitedText: AnsiString; +begin + Result := GetDelimitedText(Delimiter, QuoteChar); +end; + +function TJclAnsiStrings.GetDelimitedText(const ADelimiter: AnsiString; AQuoteChar: AnsiChar): AnsiString; + + function Quoted(Item: AnsiString): AnsiString; + begin + if (not StrictDelimiter) and ((Pos(AnsiSpace, Item) > 0) or (Pos(FQuoteChar, Item) > 0)) then + begin + Result := AnsiQuotedStr(Item, AQuoteChar); + end + else + Result := Item; + end; + +var + I: Integer; +begin + Result := ''; + for I := 0 to Count - 2 do + Result := Result + Quoted(Strings[I]) + ADelimiter; + if Count > 0 then + Result := Result + Quoted(Strings[Count - 1]); +end; + +procedure TJclAnsiStrings.Insert(Index: Integer; const S: AnsiString); +begin + InsertObject(Index, S, nil); +end; + +procedure TJclAnsiStrings.SetCommaText(const Value: AnsiString); +begin + SetDelimitedText(Value, AnsiComma, AnsiDoubleQuote); +end; + +procedure TJclAnsiStrings.SetDelimitedText(const Value: AnsiString); +begin + SetDelimitedText(Value, Delimiter, QuoteChar); +end; + +procedure TJclAnsiStrings.SetDelimitedText(const Value, ADelimiter: AnsiString; AQuoteChar: AnsiChar); + + procedure InternalAdd(Item: AnsiString); + begin + Item := StrTrimQuotes(Item, AQuoteChar); + StrReplace(Item, AQuoteChar + AQuoteChar, AQuoteChar, [rfReplaceAll]); + Add(Item); + end; + +var + ValueLength, LastStart, Index, QuoteCharCount: Integer; + ValueChar: AnsiChar; +begin + Clear; + LastStart := 1; + QuoteCharCount := 0; + ValueLength := Length(Value); + for Index := 1 to ValueLength do + begin + ValueChar := Value[Index]; + if ValueChar = AQuoteChar then + Inc(QuoteCharCount); + if ((ValueChar = ADelimiter) or ((ValueChar = ' ') and (not StrictDelimiter))) + and ((not Odd(QuoteCharCount) or (QuoteCharCount = 0))) then + begin + if StrictDelimiter then + Add(Copy(Value, LastStart, Index - LastStart)) + else + InternalAdd(Copy(Value, LastStart, Index - LastStart)); + QuoteCharCount := 0; + LastStart := Index + 1; + end; + if (Index = ValueLength) and (LastStart <= ValueLength) then + begin + if StrictDelimiter then + Add(Copy(Value, LastStart, ValueLength - LastStart + 1)) + else + InternalAdd(Copy(Value, LastStart, Index - LastStart + 1)); + end; + end; +end; + +function TJclAnsiStrings.GetText: AnsiString; +var + I: Integer; +begin + Result := ''; + for I := 0 to Count - 2 do + Result := Result + Strings[I] + AnsiLineBreak; + if Count > 0 then + Result := Result + Strings[Count - 1] + AnsiLineBreak; +end; + +procedure TJclAnsiStrings.SetText(const Value: AnsiString); +var + Index, Start, Len: Integer; + S: AnsiString; +begin + Clear; + Len := Length(Value); + Index := 1; + while Index <= Len do + begin + Start := Index; + while (Index <= Len) and not CharIsReturn(Value[Index]) do + Inc(Index); + + S := Copy(Value, Start, Index - Start); + Add(S); + + if (Index <= Len) and (Value[Index] = AnsiCarriageReturn) then + Inc(Index); + if (Index <= Len) and (Value[Index] = AnsiLineFeed) then + Inc(Index); + end; +end; + +function TJclAnsiStrings.GetCapacity: Integer; +begin + Result := Count; // Might be overridden in derived classes +end; + +procedure TJclAnsiStrings.SetCapacity(const Value: Integer); +begin + // Nothing at this level +end; + +procedure TJclAnsiStrings.BeginUpdate; +begin + if FUpdateCount = 0 then SetUpdateState(True); + Inc(FUpdateCount); +end; + +procedure TJclAnsiStrings.EndUpdate; +begin + Dec(FUpdateCount); + if FUpdateCount = 0 then SetUpdateState(False); +end; + +procedure TJclAnsiStrings.LoadFromFile(const FileName: TFileName); +var + Stream: TStream; +begin + Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); + try + LoadFromStream(Stream); + finally + Stream.Free; + end; +end; + +procedure TJclAnsiStrings.LoadFromStream(Stream: TStream); +var + Size: Integer; + S: AnsiString; +begin + BeginUpdate; + try + Size := Stream.Size - Stream.Position; + System.SetString(S, nil, Size); + Stream.Read(PAnsiChar(S)^, Size); + SetText(S); + finally + EndUpdate; + end; +end; + +procedure TJclAnsiStrings.SaveToFile(const FileName: TFileName); +var + Stream: TStream; +begin + Stream := TFileStream.Create(FileName, fmCreate); + try + SaveToStream(Stream); + finally + Stream.Free; + end; +end; + +procedure TJclAnsiStrings.SaveToStream(Stream: TStream); +var + S: AnsiString; +begin + S := GetText; + Stream.WriteBuffer(PAnsiChar(S)^, Length(S)); +end; + +function TJclAnsiStrings.ExtractName(const S: AnsiString): AnsiString; +var + P: Integer; +begin + Result := S; + P := AnsiPos(NameValueSeparator, Result); + if P > 0 then + SetLength(Result, P - 1) + else + SetLength(Result, 0); +end; + +function TJclAnsiStrings.GetName(Index: Integer): AnsiString; +begin + Result := ExtractName(Strings[Index]); +end; + +function TJclAnsiStrings.GetValue(const Name: AnsiString): AnsiString; +var + I: Integer; +begin + I := IndexOfName(Name); + if I >= 0 then + Result := Copy(GetString(I), Length(Name) + 2, MaxInt) + else + Result := ''; +end; + +procedure TJclAnsiStrings.SetValue(const Name, Value: AnsiString); +var + I: Integer; +begin + I := IndexOfName(Name); + if Value <> '' then + begin + if I < 0 then + I := Add(''); + SetString(I, Name + NameValueSeparator + Value); + end + else + begin + if I >= 0 then + Delete(I); + end; +end; + +function TJclAnsiStrings.GetValueFromIndex(Index: Integer): AnsiString; +var + S: AnsiString; + P: Integer; +begin + if Index >= 0 then + begin + S := Strings[Index]; + P := AnsiPos(NameValueSeparator, S); + if P > 0 then + Result := Copy(S, P + 1, Length(S) - P) + else + Result := ''; + end + else + Result := ''; +end; + +procedure TJclAnsiStrings.SetValueFromIndex(Index: Integer; const Value: AnsiString); +begin + if Value <> '' then + begin + if Index < 0 then + Index := Add(''); + SetString(Index, Names[Index] + NameValueSeparator + Value); + end + else + begin + if Index >= 0 then + Delete(Index); + end; +end; + +//=== { TJclAnsiStringList } ================================================= + +constructor TJclAnsiStringList.Create; +begin + inherited Create; + FCaseSensitive := True; +end; + +destructor TJclAnsiStringList.Destroy; +begin + FOnChange := nil; + FOnChanging := nil; + + inherited Destroy; +end; + +procedure TJclAnsiStringList.Assign(Source: TPersistent); +var + StringListSource: TStringList; +begin + if Source is TStringList then + begin + StringListSource := TStringList(Source); + FDuplicates := StringListSource.Duplicates; + FSorted := StringListSource.Sorted; + FCaseSensitive := StringListSource.CaseSensitive; + end; + inherited Assign(Source); +end; + +procedure TJclAnsiStringList.AssignTo(Dest: TPersistent); +var + StringListDest: TStringList; + AnsiStringListDest: TJclAnsiStringList; +begin + if Dest is TStringList then + begin + StringListDest := TStringList(Dest); + StringListDest.Clear; // make following assignments a lot faster + StringListDest.Duplicates := FDuplicates; + StringListDest.Sorted := FSorted; + StringListDest.CaseSensitive := FCaseSensitive; + end + else + if Dest is TJclAnsiStringList then + begin + AnsiStringListDest := TJclAnsiStringList(Dest); + AnsiStringListDest.Clear; + AnsiStringListDest.FDuplicates := FDuplicates; + AnsiStringListDest.FSorted := FSorted; + AnsiStringListDest.FCaseSensitive := FCaseSensitive; + end; + inherited AssignTo(Dest); +end; + +function TJclAnsiStringList.CompareStrings(const S1: AnsiString; const S2: AnsiString): Integer; +begin + if FCaseSensitive then + Result := CompareStr(S1, S2) + else + Result := CompareText(S1, S2); +end; + +procedure TJclAnsiStringList.SetUpdateState(Updating: Boolean); +begin + if Updating then Changing else Changed; +end; + +procedure TJclAnsiStringList.Changed; +begin + if (FUpdateCount = 0) and Assigned(FOnChange) then + FOnChange(Self); +end; + +procedure TJclAnsiStringList.Changing; +begin + if (FUpdateCount = 0) and Assigned(FOnChanging) then + FOnChanging(Self); +end; + +procedure TJclAnsiStringList.Grow; +var + Delta: Integer; +begin + if Capacity > 64 then + Delta := Capacity div 4 + else if Capacity > 8 then + Delta := 16 + else + Delta := 4; + + SetCapacity(Capacity + Delta); +end; + +function TJclAnsiStringList.GetString(Index: Integer): AnsiString; +begin + if (Index < 0) or (Index >= FCount) then + Error(@SListIndexError, Index); + + Result := FStrings[Index].Str; +end; + +procedure TJclAnsiStringList.SetString(Index: Integer; const Value: AnsiString); +begin + if Sorted then + Error(@SSortedListError, 0); + + if (Index < 0) or (Index >= FCount) then + Error(@SListIndexError, Index); + + FStrings[Index].Str := Value; +end; + +function TJclAnsiStringList.GetObject(Index: Integer): TObject; +begin + if (Index < 0) or (Index >= FCount) then + Error(@SListIndexError, Index); + + Result := FStrings[Index].Obj; +end; + +procedure TJclAnsiStringList.SetObject(Index: Integer; AObject: TObject); +begin + if (Index < 0) or (Index >= FCount) then + Error(@SListIndexError, Index); + + FStrings[Index].Obj := AObject; +end; + +function TJclAnsiStringList.GetCapacity: Integer; +begin + Result := Length(FStrings); +end; + +procedure TJclAnsiStringList.SetCapacity(const Value: Integer); +begin + if (Value < FCount) then + Error(@SListCapacityError, Value); + + if Value <> Capacity then + SetLength(FStrings, Value); +end; + +function TJclAnsiStringList.GetCount: Integer; +begin + Result := FCount; +end; + +procedure TJclAnsiStringList.InsertObject(Index: Integer; const S: AnsiString; AObject: TObject); +var + I: Integer; +begin + if Count = Capacity then + Grow; + + for I := Count - 1 downto Index do + FStrings[I + 1] := FStrings[I]; + + FStrings[Index].Str := S; + FStrings[Index].Obj := AObject; + Inc(FCount); +end; + +function TJclAnsiStringList.AddObject(const S: AnsiString; AObject: TObject): Integer; +var + Found: Boolean; +begin + if not Sorted then + Result := Count + else + begin + Found := Find(S, Result); + case Duplicates of + dupAccept: ; + dupIgnore: + if Found then + Exit; + dupError: + if Found then + Error(@SDuplicateString, 0); + end; + end; + + InsertObject(Result, S, AObject); +end; + +procedure TJclAnsiStringList.Delete(Index: Integer); +var + I: Integer; +begin + if (Index < 0) or (Index >= FCount) then + Error(@SListIndexError, Index); + + for I := Index to Count - 2 do + FStrings[I] := FStrings[I + 1]; + + FStrings[FCount - 1].Str := ''; // the last string is no longer useful + + Dec(FCount); +end; + +procedure TJclAnsiStringList.Clear; +var + I: Integer; +begin + FCount := 0; + for I := 0 to Length(FStrings) - 1 do + begin + FStrings[I].Str := ''; + FStrings[I].Obj := nil; + end; +end; + +function TJclAnsiStringList.Find(const S: AnsiString; var Index: Integer): Boolean; +var + L, H, I, C: Integer; +begin + Result := False; + L := 0; + H := FCount - 1; + while L <= H do + begin + I := (L + H) shr 1; + C := CompareStrings(FStrings[I].Str, S); + if C < 0 then + L := I + 1 + else + begin + H := I - 1; + if C = 0 then + begin + Result := True; + if Duplicates <> dupAccept then + L := I; + end; + end; + end; + Index := L; +end; + +function AnsiStringListCompareStrings(List: TJclAnsiStringList; Index1, Index2: Integer): Integer; +begin + Result := List.CompareStrings(List.FStrings[Index1].Str, + List.FStrings[Index2].Str); +end; + +procedure TJclAnsiStringList.Sort; +begin + CustomSort(AnsiStringListCompareStrings); +end; + +procedure TJclAnsiStringList.CustomSort(Compare: TJclAnsiStringListSortCompare); +begin + if not Sorted and (FCount > 1) then + QuickSort(0, FCount - 1, Compare); +end; + +procedure TJclAnsiStringList.QuickSort(L, R: Integer; SCompare: TJclAnsiStringListSortCompare); +var + I, J, P: Integer; +begin + repeat + I := L; + J := R; + P := (L + R) shr 1; + repeat + while SCompare(Self, I, P) < 0 do + Inc(I); + while SCompare(Self, J, P) > 0 do + Dec(J); + if I <= J then + begin + if I <> J then + Exchange(I, J); + if P = I then + P := J + else + if P = J then + P := I; + Inc(I); + Dec(J); + end; + until I > J; + if L < J then + QuickSort(L, J, SCompare); + L := I; + until I >= R; +end; + +procedure TJclAnsiStringList.SetSorted(Value: Boolean); +begin + if FSorted <> Value then + begin + if Value then + Sort; + FSorted := Value; + end; +end; + +{$ENDIF SUPPORTS_UNICODE} + +// String Test Routines +function StrIsAlpha(const S: AnsiString): Boolean; +var + I: SizeInt; +begin + Result := S <> ''; + for I := 1 to Length(S) do + begin + if not CharIsAlpha(S[I]) then + begin + Result := False; + Exit; + end; + end; +end; + +function StrIsAlphaNum(const S: AnsiString): Boolean; +var + I: SizeInt; +begin + Result := S <> ''; + for I := 1 to Length(S) do + begin + if not CharIsAlphaNum(S[I]) then + begin + Result := False; + Exit; + end; + end; +end; + +function StrConsistsofNumberChars(const S: AnsiString): Boolean; +var + I: SizeInt; +begin + Result := S <> ''; + for I := 1 to Length(S) do + begin + if not CharIsNumberChar(S[I]) then + begin + Result := False; + Exit; + end; + end; +end; + +function StrContainsChars(const S: AnsiString; Chars: TSysCharSet; CheckAll: Boolean): Boolean; +var + I: SizeInt; + C: AnsiChar; +begin + Result := Chars = []; + if not Result then + begin + if CheckAll then + begin + for I := 1 to Length(S) do + begin + C := S[I]; + if C in Chars then + begin + Chars := Chars - [C]; + if Chars = [] then + Break; + end; + end; + Result := (Chars = []); + end + else + begin + for I := 1 to Length(S) do + if S[I] in Chars then + begin + Result := True; + Break; + end; + end; + end; +end; + +function StrIsAlphaNumUnderscore(const S: AnsiString): Boolean; +var + I: SizeInt; + C: AnsiChar; +begin + for i := 1 to Length(s) do + begin + C := S[I]; + + if not (CharIsAlphaNum(C) or (C = '_')) then + begin + Result := False; + Exit; + end; + end; + + Result := True and (Length(S) > 0); +end; + +function StrIsDigit(const S: AnsiString): Boolean; +var + I: SizeInt; +begin + Result := S <> ''; + for I := 1 to Length(S) do + begin + if not CharIsDigit(S[I]) then + begin + Result := False; + Exit; + end; + end; +end; + +function StrIsSubset(const S: AnsiString; const ValidChars: TSysCharSet): Boolean; +var + I: SizeInt; +begin + for I := 1 to Length(S) do + begin + if not (S[I] in ValidChars) then + begin + Result := False; + Exit; + end; + end; + + Result := True and (Length(S) > 0); +end; + +function StrSame(const S1, S2: AnsiString): Boolean; +begin + Result := StrCompare(S1, S2) = 0; +end; + +//=== String Transformation Routines ========================================= + +function StrCenter(const S: AnsiString; L: SizeInt; C: AnsiChar = ' '): AnsiString; +begin + if Length(S) < L then + begin + Result := StringOfChar(C, (L - Length(S)) div 2) + S; + Result := Result + StringOfChar(C, L - Length(Result)); + end + else + Result := S; +end; + +function StrCharPosLower(const S: AnsiString; CharPos: SizeInt): AnsiString; +begin + Result := S; + if (CharPos > 0) and (CharPos <= Length(S)) then + Result[CharPos] := CharLower(Result[CharPos]); +end; + +function StrCharPosUpper(const S: AnsiString; CharPos: SizeInt): AnsiString; +begin + Result := S; + if (CharPos > 0) and (CharPos <= Length(S)) then + Result[CharPos] := CharUpper(Result[CharPos]); +end; + +function StrDoubleQuote(const S: AnsiString): AnsiString; +begin + Result := AnsiDoubleQuote + S + AnsiDoubleQuote; +end; + +function StrEnsureNoPrefix(const Prefix, Text: AnsiString): AnsiString; +var + PrefixLen: SizeInt; +begin + PrefixLen := Length(Prefix); + if Copy(Text, 1, PrefixLen) = Prefix then + Result := Copy(Text, PrefixLen + 1, Length(Text)) + else + Result := Text; +end; + +function StrEnsureNoSuffix(const Suffix, Text: AnsiString): AnsiString; +var + SuffixLen: SizeInt; + StrLength: SizeInt; +begin + SuffixLen := Length(Suffix); + StrLength := Length(Text); + if Copy(Text, StrLength - SuffixLen + 1, SuffixLen) = Suffix then + Result := Copy(Text, 1, StrLength - SuffixLen) + else + Result := Text; +end; + +function StrEnsurePrefix(const Prefix, Text: AnsiString): AnsiString; +var + PrefixLen: SizeInt; +begin + PrefixLen := Length(Prefix); + if Copy(Text, 1, PrefixLen) = Prefix then + Result := Text + else + Result := Prefix + Text; +end; + +function StrEnsureSuffix(const Suffix, Text: AnsiString): AnsiString; +var + SuffixLen: SizeInt; +begin + SuffixLen := Length(Suffix); + if Copy(Text, Length(Text) - SuffixLen + 1, SuffixLen) = Suffix then + Result := Text + else + Result := Text + Suffix; +end; + +function StrEscapedToString(const S: AnsiString): AnsiString; + procedure HandleHexEscapeSeq(const S: AnsiString; var I: SizeInt; Len: SizeInt; var Dest: AnsiString); + const + HexDigits = AnsiString('0123456789abcdefABCDEF'); + var + StartI, Val, N: SizeInt; + begin + StartI := I; + N := Pos(S[I + 1], HexDigits) - 1; + if N < 0 then + // '\x' without hex digit following is not escape sequence + Dest := Dest + '\x' + else + begin + Inc(I); // Jump over x + if N >= 16 then + N := N - 6; + Val := N; + // Same for second digit + if I < Len then + begin + N := Pos(S[I + 1], HexDigits) - 1; + if N >= 0 then + begin + Inc(I); // Jump over first digit + if N >= 16 then + N := N - 6; + Val := Val * 16 + N; + end; + end; + + if Val > Ord(High(AnsiChar)) then + raise EJclAnsiStringError.CreateResFmt(@RsNumericConstantTooLarge, [Val, StartI]); + + Dest := Dest + AnsiChar(Val); + end; + end; + + procedure HandleOctEscapeSeq(const S: AnsiString; var I: SizeInt; Len: SizeInt; var Dest: AnsiString); + const + OctDigits = AnsiString('01234567'); + var + StartI, Val, N: SizeInt; + begin + StartI := I; + // first digit + Val := Pos(S[I], OctDigits) - 1; + if I < Len then + begin + N := Pos(S[I + 1], OctDigits) - 1; + if N >= 0 then + begin + Inc(I); + Val := Val * 8 + N; + end; + if I < Len then + begin + N := Pos(S[I + 1], OctDigits) - 1; + if N >= 0 then + begin + Inc(I); + Val := Val * 8 + N; + end; + end; + end; + + if Val > Ord(High(AnsiChar)) then + raise EJclAnsiStringError.CreateResFmt(@RsNumericConstantTooLarge, [Val, StartI]); + + Dest := Dest + AnsiChar(Val); + end; + +var + I, Len: SizeInt; +begin + Result := ''; + I := 1; + Len := Length(S); + while I <= Len do + begin + if not ((S[I] = '\') and (I < Len)) then + Result := Result + S[I] + else + begin + Inc(I); // Jump over escape character + case S[I] of + 'a': + Result := Result + AnsiBell; + 'b': + Result := Result + AnsiBackspace; + 'f': + Result := Result + AnsiFormFeed; + 'n': + Result := Result + AnsiLineFeed; + 'r': + Result := Result + AnsiCarriageReturn; + 't': + Result := Result + AnsiTab; + 'v': + Result := Result + AnsiVerticalTab; + '\': + Result := Result + '\'; + '"': + Result := Result + '"'; + '''': + Result := Result + ''''; // Optionally escaped + '?': + Result := Result + '?'; // Optionally escaped + 'x': + if I < Len then + // Start of hex escape sequence + HandleHexEscapeSeq(S, I, Len, Result) + else + // '\x' at end of AnsiString is not escape sequence + Result := Result + '\x'; + '0'..'7': + // start of octal escape sequence + HandleOctEscapeSeq(S, I, Len, Result); + else + // no escape sequence + Result := Result + '\' + S[I]; + end; + end; + Inc(I); + end; +end; + +function StrLower(const S: AnsiString): AnsiString; +begin + Result := S; + StrLowerInPlace(Result); +end; + +procedure StrLowerInPlace(var S: AnsiString); +begin + StrCase(S, AnsiLoOffset); +end; + +procedure StrLowerBuff(S: PAnsiChar); +begin + StrCaseBuff(S, AnsiLoOffset); +end; + +procedure StrMove(var Dest: AnsiString; const Source: AnsiString; + const ToIndex, FromIndex, Count: SizeInt); +begin + // Check strings + if (Source = '') or (Length(Dest) = 0) then + Exit; + + // Check FromIndex + if (FromIndex <= 0) or (FromIndex > Length(Source)) or + (ToIndex <= 0) or (ToIndex > Length(Dest)) or + ((FromIndex + Count - 1) > Length(Source)) or ((ToIndex + Count - 1) > Length(Dest)) then + { TODO : Is failure without notice the proper thing to do here? } + Exit; + + // Move + Move(Source[FromIndex], Dest[ToIndex], Count); +end; + +function StrPadLeft(const S: AnsiString; Len: SizeInt; C: AnsiChar): AnsiString; +var + L: SizeInt; +begin + L := Length(S); + if L < Len then + Result := StringOfChar(C, Len - L) + S + else + Result := S; +end; + +function StrPadRight(const S: AnsiString; Len: SizeInt; C: AnsiChar): AnsiString; +var + L: SizeInt; +begin + L := Length(S); + if L < Len then + Result := S + StringOfChar(C, Len - L) + else + Result := S; +end; + +function StrProper(const S: AnsiString): AnsiString; +begin + Result := StrLower(S); + if Result <> '' then + Result[1] := UpCase(Result[1]); +end; + +procedure StrProperBuff(S: PAnsiChar); +begin + if (S <> nil) and (S^ <> #0) then + begin + StrLowerBuff(S); + S^ := CharUpper(S^); + end; +end; + +function StrQuote(const S: AnsiString; C: AnsiChar): AnsiString; +var + L: SizeInt; +begin + L := Length(S); + Result := S; + if L > 0 then + begin + if Result[1] <> C then + begin + Result := C + Result; + Inc(L); + end; + if Result[L] <> C then + Result := Result + C; + end; +end; + +function StrRemoveChars(const S: AnsiString; const Chars: TSysCharSet): AnsiString; +var + Source, Dest: PAnsiChar; + Index, Len: SizeInt; +begin + Len := Length(S); + SetLength(Result, Len); + UniqueString(Result); + Source := PAnsiChar(S); + Dest := PAnsiChar(Result); + for Index := 0 to Len - 1 do + begin + if not (Source^ in Chars) then + begin + Dest^ := Source^; + Inc(Dest); + end; + Inc(Source); + end; + SetLength(Result, Dest - PAnsiChar(Result)); +end; + +function StrKeepChars(const S: AnsiString; const Chars: TSysCharSet): AnsiString; +var + Source, Dest: PAnsiChar; + Index, Len: SizeInt; +begin + Len := Length(S); + SetLength(Result, Len); + UniqueString(Result); + Source := PAnsiChar(S); + Dest := PAnsiChar(Result); + for Index := 0 to Len - 1 do + begin + if Source^ in Chars then + begin + Dest^ := Source^; + Inc(Dest); + end; + Inc(Source); + end; + SetLength(Result, Dest - PAnsiChar(Result)); +end; + +function StrRepeat(const S: AnsiString; Count: SizeInt): AnsiString; +var + L: SizeInt; + P: PAnsiChar; +begin + L := Length(S); + SetLength(Result, Count * L); + P := Pointer(Result); + if P <> nil then + begin + while Count > 0 do + begin + Move(Pointer(S)^, P^, L); + P := P + L; + Dec(Count); + end; + end; +end; + +function StrRepeatLength(const S: AnsiString; const L: SizeInt): AnsiString; +var + Count: SizeInt; + LenS: SizeInt; + P: PAnsiChar; +begin + Result := ''; + LenS := Length(S); + + if (LenS > 0) and (S <> '') then + begin + Count := L div LenS; + if Count * LenS < L then + Inc(Count); + SetLength(Result, Count * LenS); + P := Pointer(Result); + while Count > 0 do + begin + Move(Pointer(S)^, P^, LenS); + P := P + LenS; + Dec(Count); + end; + if Length(S) > L then + SetLength(Result, L); + end; +end; + +procedure StrReplace(var S: AnsiString; const Search, Replace: AnsiString; Flags: TReplaceFlags); +var + SearchStr: AnsiString; + ResultStr: AnsiString; { result string } + SourcePtr: PAnsiChar; { pointer into S of character under examination } + SourceMatchPtr: PAnsiChar; { pointers into S and Search when first character has } + SearchMatchPtr: PAnsiChar; { been matched and we're probing for a complete match } + ResultPtr: PAnsiChar; { pointer into Result of character being written } + ResultIndex: SizeInt; + SearchLength: SizeInt; { length of search string } + ReplaceLength: SizeInt; { length of replace string } + BufferLength: SizeInt; { length of temporary result buffer } + ResultLength: SizeInt; { length of result string } + C: AnsiChar; { first character of search string } + IgnoreCase: Boolean; +begin + if Search = '' then + begin + if S = '' then + begin + S := Replace; + Exit; + end + else + raise EJclAnsiStringError.CreateRes(@RsBlankSearchString); + end; + + if S <> '' then + begin + IgnoreCase := rfIgnoreCase in Flags; + if IgnoreCase then + SearchStr := StrUpper(Search) + else + SearchStr := Search; + { avoid having to call Length() within the loop } + SearchLength := Length(Search); + ReplaceLength := Length(Replace); + ResultLength := Length(S); + BufferLength := ResultLength; + SetLength(ResultStr, BufferLength); + { get pointers to begin of source and result } + ResultPtr := PAnsiChar(ResultStr); + SourcePtr := PAnsiChar(S); + C := SearchStr[1]; + { while we haven't reached the end of the string } + while True do + begin + { copy characters until we find the first character of the search string } + if IgnoreCase then + while (CharUpper(SourcePtr^) <> C) and (SourcePtr^ <> #0) do + begin + ResultPtr^ := SourcePtr^; + Inc(ResultPtr); + Inc(SourcePtr); + end + else + while (SourcePtr^ <> C) and (SourcePtr^ <> #0) do + begin + ResultPtr^ := SourcePtr^; + Inc(ResultPtr); + Inc(SourcePtr); + end; + { did we find that first character or did we hit the end of the string? } + if SourcePtr^ = #0 then + Break + else + begin + { continue comparing, +1 because first character was matched already } + SourceMatchPtr := SourcePtr + 1; + SearchMatchPtr := PAnsiChar(SearchStr) + 1; + if IgnoreCase then + while (CharUpper(SourceMatchPtr^) = SearchMatchPtr^) and (SearchMatchPtr^ <> #0) do + begin + Inc(SourceMatchPtr); + Inc(SearchMatchPtr); + end + else + while (SourceMatchPtr^ = SearchMatchPtr^) and (SearchMatchPtr^ <> #0) do + begin + Inc(SourceMatchPtr); + Inc(SearchMatchPtr); + end; + { did we find a complete match? } + if SearchMatchPtr^ = #0 then + begin + // keep track of result length + Inc(ResultLength, ReplaceLength - SearchLength); + if ReplaceLength > 0 then + begin + // increase buffer size if required + if ResultLength > BufferLength then + begin + BufferLength := ResultLength * 2; + ResultIndex := ResultPtr - PAnsiChar(ResultStr) + 1; + SetLength(ResultStr, BufferLength); + ResultPtr := @ResultStr[ResultIndex]; + end; + { append replace to result and move past the search string in source } + Move((@Replace[1])^, ResultPtr^, ReplaceLength); + end; + Inc(SourcePtr, SearchLength); + Inc(ResultPtr, ReplaceLength); + { replace all instances or just one? } + if not (rfReplaceAll in Flags) then + begin + { just one, copy until end of source and break out of loop } + while SourcePtr^ <> #0 do + begin + ResultPtr^ := SourcePtr^; + Inc(ResultPtr); + Inc(SourcePtr); + end; + Break; + end; + end + else + begin + { copy current character and start over with the next } + ResultPtr^ := SourcePtr^; + Inc(ResultPtr); + Inc(SourcePtr); + end; + end; + end; + { set result length and copy result into S } + SetLength(ResultStr, ResultLength); + S := ResultStr; + end; +end; + +function StrReplaceChar(const S: AnsiString; const Source, Replace: AnsiChar): AnsiString; +var + I: SizeInt; +begin + Result := S; + for I := 1 to Length(S) do + if Result[I] = Source then + Result[I] := Replace; +end; + +function StrReplaceChars(const S: AnsiString; const Chars: TSysCharSet; Replace: AnsiChar): AnsiString; +var + I: SizeInt; +begin + Result := S; + for I := 1 to Length(S) do + if Result[I] in Chars then + Result[I] := Replace; +end; + +function StrReplaceButChars(const S: AnsiString; const Chars: TSysCharSet; + Replace: AnsiChar): AnsiString; +var + I: SizeInt; +begin + Result := S; + for I := 1 to Length(S) do + if not (Result[I] in Chars) then + Result[I] := Replace; +end; + +function StrReverse(const S: AnsiString): AnsiString; +begin + Result := S; + StrReverseInplace(Result); +end; + +procedure StrReverseInPlace(var S: AnsiString); +var + P1, P2: PAnsiChar; + C: AnsiChar; +begin + UniqueString(S); + P1 := PAnsiChar(S); + P2 := P1 + SizeOf(AnsiChar) * (Length(S) - 1); + while P1 < P2 do + begin + C := P1^; + P1^ := P2^; + P2^ := C; + Inc(P1); + Dec(P2); + end; +end; + +function StrSingleQuote(const S: AnsiString): AnsiString; +begin + Result := AnsiSingleQuote + S + AnsiSingleQuote; +end; + +procedure StrSkipChars(var S: PAnsiChar; const Chars: TSysCharSet); +begin + while S^ in Chars do + Inc(S); +end; + +procedure StrSkipChars(const S: AnsiString; var Index: SizeInt; const Chars: TSysCharSet); +begin + while S[Index] in Chars do + Inc(Index); +end; + +function StrSmartCase(const S: AnsiString; Delimiters: TSysCharSet): AnsiString; +var + Source, Dest: PAnsiChar; + Index, Len: SizeInt; +begin + Result := ''; + if Delimiters = [] then + Include(Delimiters, AnsiSpace); + + if S <> '' then + begin + Result := S; + UniqueString(Result); + + Len := Length(S); + Source := PAnsiChar(S); + Dest := PAnsiChar(Result); + Inc(Dest); + + for Index := 2 to Len do + begin + if (Source^ in Delimiters) then + Dest^ := CharUpper(Dest^); + + Inc(Dest); + Inc(Source); + end; + + Result[1] := CharUpper(Result[1]); + end; +end; + +function StrStringToEscaped(const S: AnsiString): AnsiString; +var + I: SizeInt; +begin + Result := ''; + for I := 1 to Length(S) do + begin + case S[I] of + AnsiBackspace: + Result := Result + '\b'; + AnsiBell: + Result := Result + '\a'; + AnsiCarriageReturn: + Result := Result + '\r'; + AnsiFormFeed: + Result := Result + '\f'; + AnsiLineFeed: + Result := Result + '\n'; + AnsiTab: + Result := Result + '\t'; + AnsiVerticalTab: + Result := Result + '\v'; + '\': + Result := Result + '\\'; + '"': + Result := Result + '\"'; + else + // Characters < ' ' are escaped with hex sequence + if S[I] < #32 then + Result := Result + AnsiString(Format('\x%.2x', [SizeInt(S[I])])) + else + Result := Result + S[I]; + end; + end; +end; + +function StrStripNonNumberChars(const S: AnsiString): AnsiString; +var + I: SizeInt; + C: AnsiChar; +begin + Result := ''; + for I := 1 to Length(S) do + begin + C := S[I]; + if CharIsNumberChar(C) then + Result := Result + C; + end; +end; + +function StrToHex(const Source: AnsiString): AnsiString; +var + Index: SizeInt; + C, L, N: SizeInt; + BL, BH: Byte; + S: AnsiString; +begin + Result := ''; + if Source <> '' then + begin + S := Source; + L := Length(S); + if Odd(L) then + begin + S := '0' + S; + Inc(L); + end; + Index := 1; + SetLength(Result, L div 2); + C := 1; + N := 1; + while C <= L do + begin + BH := CharHex(S[Index]); + Inc(Index); + BL := CharHex(S[Index]); + Inc(Index); + Inc(C, 2); + if (BH = $FF) or (BL = $FF) then + begin + Result := ''; + Exit; + end; + Result[N] := AnsiChar((Cardinal(BH) shl 4) or Cardinal(BL)); + Inc(N); + end; + end; +end; + +function StrTrimCharLeft(const S: AnsiString; C: AnsiChar): AnsiString; +var + I, L: SizeInt; +begin + I := 1; + L := Length(S); + while (I <= L) and (S[I] = C) do + Inc(I); + Result := Copy(S, I, L - I + 1); +end; + +function StrTrimCharsLeft(const S: AnsiString; const Chars: TSysCharSet): AnsiString; +var + I, L: SizeInt; +begin + I := 1; + L := Length(S); + while (I <= L) and (S[I] in Chars) do + Inc(I); + Result := Copy(S, I, L - I + 1); +end; + +function StrTrimCharsRight(const S: AnsiString; const Chars: TSysCharSet): AnsiString; +var + I: SizeInt; +begin + I := Length(S); + while (I >= 1) and (S[I] in Chars) do + Dec(I); + Result := Copy(S, 1, I); +end; + +function StrTrimCharRight(const S: AnsiString; C: AnsiChar): AnsiString; +var + I: SizeInt; +begin + I := Length(S); + while (I >= 1) and (S[I] = C) do + Dec(I); + Result := Copy(S, 1, I); +end; + +function StrTrimQuotes(const S: AnsiString): AnsiString; +var + First, Last: AnsiChar; + L: SizeInt; +begin + L := Length(S); + if L > 1 then + begin + First := S[1]; + Last := S[L]; + if (First = Last) and ((First = AnsiSingleQuote) or (First = AnsiDoubleQuote)) then + Result := Copy(S, 2, L - 2) + else + Result := S; + end + else + Result := S; +end; + +function StrTrimQuotes(const S: AnsiString; QuoteChar: AnsiChar): AnsiString; +var + First, Last: AnsiChar; + L: SizeInt; +begin + L := Length(S); + if L > 1 then + begin + First := S[1]; + Last := S[L]; + if (First = Last) and (First = QuoteChar) then + Result := Copy(S, 2, L - 2) + else + Result := S; + end + else + Result := S; +end; + +function StrUpper(const S: AnsiString): AnsiString; +begin + Result := S; + StrUpperInPlace(Result); +end; + +procedure StrUpperInPlace(var S: AnsiString); +begin + StrCase(S, AnsiUpOffset); +end; + +procedure StrUpperBuff(S: PAnsiChar); +begin + StrCaseBuff(S, AnsiUpOffset); +end; + +{$IFDEF MSWINDOWS} +function StrOemToAnsi(const S: AnsiString): AnsiString; +begin + SetLength(Result, Length(S)); + OemToAnsiBuff(PAnsiChar(S), PAnsiChar(Result), Length(S)); +end; + +function StrAnsiToOem(const S: AnsiString): AnsiString; +begin + SetLength(Result, Length(S)); + AnsiToOemBuff(PAnsiChar(S), PAnsiChar(Result), Length(S)); +end; +{$ENDIF MSWINDOWS} + +//=== String Management ====================================================== + +procedure StrAddRef(var S: AnsiString); +var + P: PAnsiStrRec; +begin + P := Pointer(S); + if P <> nil then + begin + Dec(P); + if P^.RefCount = -1 then + UniqueString(S) + else + LockedInc(P^.RefCount); + end; +end; + +procedure StrDecRef(var S: AnsiString); +var + P: PAnsiStrRec; +begin + P := Pointer(S); + if P <> nil then + begin + Dec(P); + case P^.RefCount of + -1, 0: + { nothing } ; + 1: + begin + Finalize(S); + Pointer(S) := nil; + end; + else + LockedDec(P^.RefCount); + end; + end; +end; + +function StrLength(const S: AnsiString): Longint; +var + P: PAnsiStrRec; +begin + Result := 0; + P := Pointer(S); + if P <> nil then + begin + Dec(P); + Result := P^.Length and (not $80000000 shr 1); + end; +end; + +function StrRefCount(const S: AnsiString): Longint; +var + P: PAnsiStrRec; +begin + Result := 0; + P := Pointer(S); + if P <> nil then + begin + Dec(P); + Result := P^.RefCount; + end; +end; + +procedure StrResetLength(var S: AnsiString); +var + I: SizeInt; +begin + for I := 0 to Length(S) - 1 do + if S[I + 1] = #0 then + begin + SetLength(S, I); + Exit; + end; +end; + +//=== String Search and Replace Routines ===================================== + +function StrCharCount(const S: AnsiString; C: AnsiChar): SizeInt; +var + I: SizeInt; +begin + Result := 0; + for I := 1 to Length(S) do + if S[I] = C then + Inc(Result); +end; + +function StrCharsCount(const S: AnsiString; Chars: TSysCharSet): SizeInt; +var + I: SizeInt; +begin + Result := 0; + for I := 1 to Length(S) do + if S[I] in Chars then + Inc(Result); +end; + +function StrStrCount(const S, SubS: AnsiString): SizeInt; +var + I: SizeInt; +begin + Result := 0; + if (Length(SubS) > Length(S)) or (Length(SubS) = 0) or (Length(S) = 0) then + Exit; + if Length(SubS) = 1 then + begin + Result := StrCharCount(S, SubS[1]); + Exit; + end; + I := StrSearch(SubS, S, 1); + + if I > 0 then + Inc(Result); + + while (I > 0) and (Length(S) > I + Length(SubS)) do + begin + I := StrSearch(SubS, S, I + 1); + if I > 0 then + Inc(Result); + end; +end; + +(* +{ 1} Test(StrCompareRange('', '', 1, 5), 0); +{ 2} Test(StrCompareRange('A', '', 1, 5), -1); +{ 3} Test(StrCompareRange('AB', '', 1, 5), -1); +{ 4} Test(StrCompareRange('ABC', '', 1, 5), -1); +{ 5} Test(StrCompareRange('', 'A', 1, 5), -1); +{ 6} Test(StrCompareRange('', 'AB', 1, 5), -1); +{ 7} Test(StrCompareRange('', 'ABC', 1, 5), -1); +{ 8} Test(StrCompareRange('A', 'a', 1, 5), -2); +{ 9} Test(StrCompareRange('A', 'a', 1, 1), -32); +{10} Test(StrCompareRange('aA', 'aB', 1, 1), 0); +{11} Test(StrCompareRange('aA', 'aB', 1, 2), -1); +{12} Test(StrCompareRange('aB', 'aA', 1, 2), 1); +{13} Test(StrCompareRange('aA', 'aa', 1, 2), -32); +{14} Test(StrCompareRange('aa', 'aA', 1, 2), 32); +{15} Test(StrCompareRange('', '', 1, 0), 0); +{16} Test(StrCompareRange('A', 'A', 1, 0), -2); +{17} Test(StrCompareRange('Aa', 'A', 1, 0), -2); +{18} Test(StrCompareRange('Aa', 'Aa', 1, 2), 0); +{19} Test(StrCompareRange('Aa', 'A', 1, 2), 0); +{20} Test(StrCompareRange('Ba', 'A', 1, 2), 1); +*) +function StrCompareRangeEx(const S1, S2: AnsiString; Index, Count: SizeInt; CaseSensitive: Boolean): SizeInt; +var + Len1, Len2: SizeInt; + I: SizeInt; + C1, C2: AnsiChar; +begin + if Pointer(S1) = Pointer(S2) then + begin + if (Count <= 0) and (S1 <> '') then + Result := -2 // no work + else + Result := 0; + end + else + if (S1 = '') or (S2 = '') then + Result := -1 // null string + else + if Count <= 0 then + Result := -2 // no work + else + begin + Len1 := Length(S1); + Len2 := Length(S2); + + if (Index - 1) + Count > Len1 then + Result := -2 + else + begin + if (Index - 1) + Count > Len2 then // strange behaviour, but the assembler code does it + Count := Len2 - (Index - 1); + + if CaseSensitive then + begin + for I := 0 to Count - 1 do + begin + C1 := S1[Index + I]; + C2 := S2[Index + I]; + if C1 <> C2 then + begin + Result := Ord(C1) - Ord(C2); + Exit; + end; + end; + end + else + begin + for I := 0 to Count - 1 do + begin + C1 := S1[Index + I]; + C2 := S2[Index + I]; + if C1 <> C2 then + begin + C1 := CharLower(C1); + C2 := CharLower(C2); + if C1 <> C2 then + begin + Result := Ord(C1) - Ord(C2); + Exit; + end; + end; + end; + end; + Result := 0; + end; + end; +end; + +function StrCompare(const S1, S2: AnsiString; CaseSensitive: Boolean): SizeInt; +var + Len1, Len2: SizeInt; +begin + if Pointer(S1) = Pointer(S2) then + Result := 0 + else + begin + Len1 := Length(S1); + Len2 := Length(S2); + Result := Len1 - Len2; + if Result = 0 then + Result := StrCompareRangeEx(S1, S2, 1, Len1, CaseSensitive); + end; +end; + +function StrCompareRange(const S1, S2: AnsiString; Index, Count: SizeInt; CaseSensitive: Boolean): SizeInt; +begin + Result := StrCompareRangeEx(S1, S2, Index, Count, CaseSensitive); +end; + +function StrRepeatChar(C: AnsiChar; Count: SizeInt): AnsiString; +begin + SetLength(Result, Count); + if Count > 0 then + FillChar(Result[1], Count, C); +end; + +function StrFind(const Substr, S: AnsiString; const Index: SizeInt): SizeInt; +var + pos: SizeInt; +begin + if (SubStr <> '') and (S <> '') then + begin + pos := StrIPos(Substr, Copy(S, Index, Length(S) - Index + 1)); + if pos = 0 then + Result := 0 + else + Result := Index + Pos - 1; + end + else + Result := 0; +end; + +function StrHasPrefix(const S: AnsiString; const Prefixes: array of AnsiString): Boolean; +begin + Result := StrPrefixIndex(S, Prefixes) > -1; +end; + +function StrHasSuffix(const S: AnsiString; const Suffixes: array of AnsiString): Boolean; +begin + Result := StrSuffixIndex(S, Suffixes) > -1; +end; + +function StrIHasPrefix(const S: AnsiString; const Prefixes: array of AnsiString): Boolean; +begin + Result := StrIPrefixIndex(S, Prefixes) > -1; +end; + +function StrIHasSuffix(const S: AnsiString; const Suffixes: array of AnsiString): Boolean; +begin + Result := StrISuffixIndex(S, Suffixes) > -1; +end; + +function StrIndex(const S: AnsiString; const List: array of AnsiString; CaseSensitive: Boolean): SizeInt; +var + I: SizeInt; +begin + Result := -1; + for I := Low(List) to High(List) do + begin + if StrCompare(S, List[I], CaseSensitive) = 0 then + begin + Result := I; + Break; + end; + end; +end; + +function StrILastPos(const SubStr, S: AnsiString): SizeInt; +begin + Result := StrLastPos(StrUpper(SubStr), StrUpper(S)); +end; + +function StrIPos(const SubStr, S: AnsiString): SizeInt; +begin + Result := Pos(StrUpper(SubStr), StrUpper(S)); +end; + +function StrIPrefixIndex(const S: AnsiString; const Prefixes: array of AnsiString): SizeInt; +var + I: SizeInt; + Test: AnsiString; +begin + Result := -1; + for I := Low(Prefixes) to High(Prefixes) do + begin + Test := StrLeft(S, Length(Prefixes[I])); + if CompareText(Test, Prefixes[I]) = 0 then + begin + Result := I; + Break; + end; + end; +end; + +function StrIsOneOf(const S: AnsiString; const List: array of AnsiString): Boolean; +begin + Result := StrIndex(S, List) > -1; +end; + +function StrISuffixIndex(const S: AnsiString; const Suffixes: array of AnsiString): SizeInt; +var + I: SizeInt; + Test: AnsiString; +begin + Result := -1; + for I := Low(Suffixes) to High(Suffixes) do + begin + Test := StrRight(S, Length(Suffixes[I])); + if CompareText(Test, Suffixes[I]) = 0 then + begin + Result := I; + Break; + end; + end; +end; + +function StrLastPos(const SubStr, S: AnsiString): SizeInt; +var + Last, Current: PAnsiChar; +begin + Result := 0; + Last := nil; + Current := PAnsiChar(S); + + while (Current <> nil) and (Current^ <> #0) do + begin + Current := AnsiStrPosA(PAnsiChar(Current), PAnsiChar(SubStr)); + if Current <> nil then + begin + Last := Current; + Inc(Current); + end; + end; + if Last <> nil then + Result := Abs(PAnsiChar(S) - Last) + 1; +end; + +// IMPORTANT NOTE: The StrMatch function does currently not work with the Asterix (*) +// (*) acts like (?) + +function StrMatch(const Substr, S: AnsiString; Index: SizeInt): SizeInt; +var + SI, SubI, SLen, SubLen: SizeInt; + SubC: AnsiChar; +begin + SLen := Length(S); + SubLen := Length(Substr); + Result := 0; + if (Index > SLen) or (SubLen = 0) then + Exit; + while Index <= SLen do + begin + SubI := 1; + SI := Index; + while (SI <= SLen) and (SubI <= SubLen) do + begin + SubC := Substr[SubI]; + if (SubC = '*') or (SubC = '?') or (SubC = S[SI]) then + begin + Inc(SI); + Inc(SubI); + end + else + Break; + end; + if SubI > SubLen then + begin + Result := Index; + Break; + end; + Inc(Index); + end; +end; + + +// Derived from "Like" by Michael Winter + +function StrMatches(const Substr, S: AnsiString; const Index: SizeInt): Boolean; +var + StringPtr: PAnsiChar; + PatternPtr: PAnsiChar; + StringRes: PAnsiChar; + PatternRes: PAnsiChar; +begin + if SubStr = '' then + raise EJclAnsiStringError.CreateRes(@RsBlankSearchString); + + Result := SubStr = '*'; + + if Result or (S = '') then + Exit; + + if (Index <= 0) or (Index > Length(S)) then + raise EJclAnsiStringError.CreateRes(@RsArgumentOutOfRange); + + StringPtr := PAnsiChar(@S[Index]); + PatternPtr := PAnsiChar(SubStr); + StringRes := nil; + PatternRes := nil; + + repeat + repeat + case PatternPtr^ of + #0: + begin + Result := StringPtr^ = #0; + if Result or (StringRes = nil) or (PatternRes = nil) then + Exit; + + StringPtr := StringRes; + PatternPtr := PatternRes; + Break; + end; + '*': + begin + Inc(PatternPtr); + PatternRes := PatternPtr; + Break; + end; + '?': + begin + if StringPtr^ = #0 then + Exit; + Inc(StringPtr); + Inc(PatternPtr); + end; + else + begin + if StringPtr^ = #0 then + Exit; + if StringPtr^ <> PatternPtr^ then + begin + if (StringRes = nil) or (PatternRes = nil) then + Exit; + StringPtr := StringRes; + PatternPtr := PatternRes; + Break; + end + else + begin + Inc(StringPtr); + Inc(PatternPtr); + end; + end; + end; + until False; + + repeat + case PatternPtr^ of + #0: + begin + Result := True; + Exit; + end; + '*': + begin + Inc(PatternPtr); + PatternRes := PatternPtr; + end; + '?': + begin + if StringPtr^ = #0 then + Exit; + Inc(StringPtr); + Inc(PatternPtr); + end; + else + begin + repeat + if StringPtr^ = #0 then + Exit; + if StringPtr^ = PatternPtr^ then + Break; + Inc(StringPtr); + until False; + Inc(StringPtr); + StringRes := StringPtr; + Inc(PatternPtr); + Break; + end; + end; + until False; + until False; +end; + +function StrNPos(const S, SubStr: AnsiString; N: SizeInt): SizeInt; +var + I, P: SizeInt; +begin + if N < 1 then + begin + Result := 0; + Exit; + end; + + Result := StrSearch(SubStr, S, 1); + I := 1; + while I < N do + begin + P := StrSearch(SubStr, S, Result + 1); + if P = 0 then + begin + Result := 0; + Break; + end + else + begin + Result := P; + Inc(I); + end; + end; +end; + +function StrNIPos(const S, SubStr: AnsiString; N: SizeInt): SizeInt; +var + I, P: SizeInt; +begin + if N < 1 then + begin + Result := 0; + Exit; + end; + + Result := StrFind(SubStr, S, 1); + I := 1; + while I < N do + begin + P := StrFind(SubStr, S, Result + 1); + if P = 0 then + begin + Result := 0; + Break; + end + else + begin + Result := P; + Inc(I); + end; + end; +end; + +function StrPrefixIndex(const S: AnsiString; const Prefixes: array of AnsiString): SizeInt; +var + I: SizeInt; + Test: AnsiString; +begin + Result := -1; + for I := Low(Prefixes) to High(Prefixes) do + begin + Test := StrLeft(S, Length(Prefixes[I])); + if CompareStr(Test, Prefixes[I]) = 0 then + begin + Result := I; + Break; + end; + end; +end; + +function StrSearch(const Substr, S: AnsiString; const Index: SizeInt): SizeInt; +var + SP, SPI, SubP: PAnsiChar; + SLen: SizeInt; +begin + SLen := Length(S); + if Index <= SLen then + begin + SP := PAnsiChar(S); + SubP := PAnsiChar(Substr); + SPI := SP; + Inc(SPI, Index); + Dec(SPI); + SPI := StrPosA(SPI, SubP); + if SPI <> nil then + Result := SPI - SP + 1 + else + Result := 0; + end + else + Result := 0; +end; + +function StrSuffixIndex(const S: AnsiString; const Suffixes: array of AnsiString): SizeInt; +var + I: SizeInt; + Test: AnsiString; +begin + Result := -1; + for I := Low(Suffixes) to High(Suffixes) do + begin + Test := StrRight(S, Length(Suffixes[I])); + if CompareStr(Test, Suffixes[I]) = 0 then + begin + Result := I; + Break; + end; + end; +end; + +//=== String Extraction ====================================================== + +function StrAfter(const SubStr, S: AnsiString): AnsiString; +var + P: SizeInt; +begin + P := StrFind(SubStr, S, 1); // StrFind is case-insensitive pos + if P <= 0 then + Result := '' // substr not found -> nothing after it + else + Result := StrRestOf(S, P + Length(SubStr)); +end; + +function StrBefore(const SubStr, S: AnsiString): AnsiString; +var + P: SizeInt; +begin + P := StrFind(SubStr, S, 1); + if P <= 0 then + Result := S + else + Result := StrLeft(S, P - 1); +end; + +function StrSplit(const SubStr, S: AnsiString;var Left, Right : AnsiString): boolean; +var + P: SizeInt; +begin + P := StrFind(SubStr, S, 1); + Result:= p > 0; + if Result then + begin + Left := StrLeft(S, P - 1); + Right := StrRestOf(S, P + Length(SubStr)); + end + else + begin + Left := ''; + Right := ''; + end; +end; + +function StrBetween(const S: AnsiString; const Start, Stop: AnsiChar): AnsiString; +var + PosStart, PosEnd: SizeInt; + L: SizeInt; +begin + PosStart := Pos(Start, S); + PosEnd := StrSearch(Stop, S, PosStart + 1); // PosEnd has to be after PosStart. + + if (PosStart > 0) and (PosEnd > PosStart) then + begin + L := PosEnd - PosStart; + Result := Copy(S, PosStart + 1, L - 1); + end + else + Result := ''; +end; + +function StrChopRight(const S: AnsiString; N: SizeInt): AnsiString; +begin + Result := Copy(S, 1, Length(S) - N); +end; + +function StrLeft(const S: AnsiString; Count: SizeInt): AnsiString; +begin + Result := Copy(S, 1, Count); +end; + +function StrMid(const S: AnsiString; Start, Count: SizeInt): AnsiString; +begin + Result := Copy(S, Start, Count); +end; + +function StrRestOf(const S: AnsiString; N: SizeInt): AnsiString; +begin + Result := Copy(S, N, (Length(S) - N + 1)); +end; + +function StrRight(const S: AnsiString; Count: SizeInt): AnsiString; +begin + Result := Copy(S, Length(S) - Count + 1, Count); +end; + +//=== Character (do we have it ;) ============================================ + +function CharEqualNoCase(const C1, C2: AnsiChar): Boolean; +begin + // if they are not equal chars, may be same letter different case + Result := (C1 = C2) or + (CharIsAlpha(C1) and CharIsAlpha(C2) and (CharLower(C1) = CharLower(C2))); +end; + + +function CharIsAlpha(const C: AnsiChar): Boolean; +begin + Result := (AnsiCharTypes[C] and C1_ALPHA) <> 0; +end; + +function CharIsAlphaNum(const C: AnsiChar): Boolean; +begin + Result := ((AnsiCharTypes[C] and C1_ALPHA) <> 0) or + ((AnsiCharTypes[C] and C1_DIGIT) <> 0); +end; + +function CharIsBlank(const C: AnsiChar): Boolean; +begin + Result := ((AnsiCharTypes[C] and C1_BLANK) <> 0); +end; + +function CharIsControl(const C: AnsiChar): Boolean; +begin + Result := (AnsiCharTypes[C] and C1_CNTRL) <> 0; +end; + +function CharIsDelete(const C: AnsiChar): Boolean; +begin + Result := (C = #8); +end; + +function CharIsDigit(const C: AnsiChar): Boolean; +begin + Result := (AnsiCharTypes[C] and C1_DIGIT) <> 0; +end; + +function CharIsFracDigit(const C: AnsiChar): Boolean; +begin + Result := (C = '.') or ((AnsiCharTypes[C] and C1_DIGIT) <> 0); +end; + +function CharIsHexDigit(const C: AnsiChar): Boolean; +begin + case C of + 'A'..'F', + 'a'..'f': + Result := True; + else + Result := ((AnsiCharTypes[C] and C1_DIGIT) <> 0); + end; +end; + +function CharIsLower(const C: AnsiChar): Boolean; +begin + Result := (AnsiCharTypes[C] and C1_LOWER) <> 0; +end; + +// JclSysUtils.TJclFormatSettings.GetDecimalSeparator is manually inlined in the 2 following functions +// this fixes compiler warnings about functions not being inlined + +function CharIsNumberChar(const C: AnsiChar): Boolean; +begin + Result := ((AnsiCharTypes[C] and C1_DIGIT) <> 0) or (C = AnsiSignMinus) or (C = AnsiSignPlus) or + (Char(C) = {$IFDEF RTL220_UP}FormatSettings.DecimalSeparator{$ELSE}SysUtils.DecimalSeparator{$ENDIF}); +end; + +function CharIsNumber(const C: AnsiChar): Boolean; +begin + Result := ((AnsiCharTypes[C] and C1_DIGIT) <> 0) or + (Char(C) = {$IFDEF RTL220_UP}FormatSettings.DecimalSeparator{$ELSE}SysUtils.DecimalSeparator{$ENDIF}); +end; + +function CharIsPrintable(const C: AnsiChar): Boolean; +begin + Result := not CharIsControl(C); +end; + +function CharIsPunctuation(const C: AnsiChar): Boolean; +begin + Result := ((AnsiCharTypes[C] and C1_PUNCT) <> 0); +end; + +function CharIsReturn(const C: AnsiChar): Boolean; +begin + Result := (C = AnsiLineFeed) or (C = AnsiCarriageReturn); +end; + +function CharIsSpace(const C: AnsiChar): Boolean; +begin + Result := (AnsiCharTypes[C] and C1_SPACE) <> 0; +end; + +function CharIsUpper(const C: AnsiChar): Boolean; +begin + Result := (AnsiCharTypes[C] and C1_UPPER) <> 0; +end; + +function CharIsValidIdentifierLetter(const C: AnsiChar): Boolean; +begin + case C of + '0'..'9', 'A'..'Z', 'a'..'z', '_': + Result := True; + else + Result := False; + end; +end; + +function CharIsWhiteSpace(const C: AnsiChar): Boolean; +begin + Result := (C = AnsiTab) or (C = AnsiLineFeed) or (C = AnsiVerticalTab) or + (C = AnsiFormFeed) or (C = AnsiCarriageReturn) or (C =AnsiSpace) or + ((AnsiCharTypes[C] and C1_SPACE) <> 0); +end; + +function CharIsWildcard(const C: AnsiChar): Boolean; +begin + case C of + '*', '?': + Result := True; + else + Result := False; + end; +end; + +function CharType(const C: AnsiChar): Word; +begin + Result := AnsiCharTypes[C]; +end; + +//=== PCharVector ============================================================ + +function StringsToPCharVector(var Dest: PAnsiCharVector; const Source: TJclAnsiStrings): PAnsiCharVector; +var + I: SizeInt; + S: AnsiString; + List: array of PAnsiChar; +begin + Assert(Source <> nil); + Dest := AllocMem((Source.Count + SizeOf(AnsiChar)) * SizeOf(PAnsiChar)); + SetLength(List, Source.Count + SizeOf(AnsiChar)); + for I := 0 to Source.Count - 1 do + begin + S := Source[I]; + {$IFDEF SUPPORTS_UNICODE} + List[I] := AnsiStrAlloc(Length(S) + SizeOf(AnsiChar)); + {$ELSE ~SUPPORTS_UNICODE} + List[I] := StrAlloc(Length(S) + SizeOf(AnsiChar)); + {$ENDIF ~SUPPORTS_UNICODE} + StrPCopyA(List[I], S); + end; + List[Source.Count] := nil; + Move(List[0], Dest^, (Source.Count + 1) * SizeOf(PAnsiChar)); + Result := Dest; +end; + +function PCharVectorCount(Source: PAnsiCharVector): SizeInt; +begin + Result := 0; + if Source <> nil then + while Source^ <> nil do + begin + Inc(Source); + Inc(Result); + end; +end; + +procedure PCharVectorToStrings(const Dest: TJclAnsiStrings; Source: PAnsiCharVector); +var + I, Count: SizeInt; + List: array of PAnsiChar; +begin + Assert(Dest <> nil); + if Source <> nil then + begin + Count := PCharVectorCount(Source); + SetLength(List, Count); + Move(Source^, List[0], Count * SizeOf(PAnsiChar)); + Dest.BeginUpdate; + try + Dest.Clear; + for I := 0 to Count - 1 do + Dest.Add(List[I]); + finally + Dest.EndUpdate; + end; + end; +end; + +procedure FreePCharVector(var Dest: PAnsiCharVector); +var + I, Count: SizeInt; + List: array of PAnsiChar; +begin + if Dest <> nil then + begin + Count := PCharVectorCount(Dest); + SetLength(List, Count); + Move(Dest^, List[0], Count * SizeOf(PAnsiChar)); + for I := 0 to Count - 1 do + StrDisposeA(List[I]); + FreeMem(Dest, (Count + 1) * SizeOf(PAnsiChar)); + Dest := nil; + end; +end; + +//=== Character Transformation Routines ====================================== + +function CharHex(const C: AnsiChar): Byte; +begin + case C of + '0'..'9': + Result := Ord(C) - Ord('0'); + 'a'..'f': + Result := Ord(C) - Ord('a') + 10; + 'A'..'F': + Result := Ord(C) - Ord('A') + 10; + else + Result := $FF; + end; +end; + +function CharLower(const C: AnsiChar): AnsiChar; +begin + Result := AnsiCaseMap[Ord(C) + AnsiLoOffset]; +end; + +function CharToggleCase(const C: AnsiChar): AnsiChar; +begin + Result := AnsiCaseMap[Ord(C) + AnsiReOffset]; +end; + +function CharUpper(const C: AnsiChar): AnsiChar; +begin + Result := AnsiCaseMap[Ord(C) + AnsiUpOffset]; +end; + +//=== Character Search and Replace =========================================== + +function CharLastPos(const S: AnsiString; const C: AnsiChar; const Index: SizeInt): SizeInt; +begin + if (Index > 0) and (Index <= Length(S)) then + for Result := Length(S) downto Index do + if S[Result] = C then + Exit; + Result := 0; +end; + +function CharPos(const S: AnsiString; const C: AnsiChar; const Index: SizeInt): SizeInt; +begin + if (Index > 0) and (Index <= Length(S)) then + for Result := Index to Length(S) do + if S[Result] = C then + Exit; + Result := 0; +end; + +function CharIPos(const S: AnsiString; C: AnsiChar; const Index: SizeInt): SizeInt; +begin + if (Index > 0) and (Index <= Length(S)) then + begin + C := CharUpper(C); + for Result := Index to Length(S) do + if AnsiCaseMap[Ord(S[Result]) + AnsiUpOffset] = C then + Exit; + end; + Result := 0; +end; + +function CharReplace(var S: AnsiString; const Search, Replace: AnsiChar): SizeInt; +var + P: PAnsiChar; + Index, Len: SizeInt; +begin + Result := 0; + if Search <> Replace then + begin + UniqueString(S); + Len := Length(S); + P := PAnsiChar(S); + for Index := 0 to Len - 1 do + begin + if P^ = Search then + begin + P^ := Replace; + Inc(Result); + end; + Inc(P); + end; + end; +end; + +//=== MultiSz ================================================================ + +function StringsToMultiSz(var Dest: PAnsiMultiSz; const Source: TJclAnsiStrings): PAnsiMultiSz; +var + I, TotalLength: SizeInt; + P: PAnsiMultiSz; +begin + Assert(Source <> nil); + TotalLength := 1; + for I := 0 to Source.Count - 1 do + if Source[I] = '' then + raise EJclAnsiStringError.CreateRes(@RsInvalidEmptyStringItem) + else + Inc(TotalLength, StrLenA(PAnsiChar(AnsiString(Source[I]))) + 1); + AllocateMultiSz(Dest, TotalLength); + P := Dest; + for I := 0 to Source.Count - 1 do + begin + P := StrECopyA(P, PAnsiChar(AnsiString(Source[I]))); + Inc(P); + end; + P^ := #0; + Result := Dest; +end; + +procedure MultiSzToStrings(const Dest: TJclAnsiStrings; const Source: PAnsiMultiSz); +var + P: PAnsiMultiSz; +begin + Assert(Dest <> nil); + Dest.BeginUpdate; + try + Dest.Clear; + if Source <> nil then + begin + P := Source; + while P^ <> #0 do + begin + Dest.Add(P); + P := StrEndA(P); + Inc(P); + end; + end; + finally + Dest.EndUpdate; + end; +end; + +function MultiSzLength(const Source: PAnsiMultiSz): SizeInt; +var + P: PAnsiMultiSz; +begin + Result := 0; + if Source <> nil then + begin + P := Source; + repeat + Inc(Result, StrLenA(P) + 1); + P := StrEndA(P); + Inc(P); + until P^ = #0; + Inc(Result); + end; +end; + +procedure AllocateMultiSz(var Dest: PAnsiMultiSz; Len: SizeInt); +begin + if Len > 0 then + GetMem(Dest, Len * SizeOf(AnsiChar)) + else + Dest := nil; +end; + +procedure FreeMultiSz(var Dest: PAnsiMultiSz); +begin + if Dest <> nil then + FreeMem(Dest); + Dest := nil; +end; + +function MultiSzDup(const Source: PAnsiMultiSz): PAnsiMultiSz; +var + Len: SizeInt; +begin + if Source <> nil then + begin + Len := MultiSzLength(Source); + Result := nil; + AllocateMultiSz(Result, Len); + Move(Source^, Result^, Len * SizeOf(AnsiChar)); + end + else + Result := nil; +end; + +//=== TJclAnsiStrings Manipulation =============================================== + +procedure StrToStrings(S, Sep: AnsiString; const List: TJclAnsiStrings; const AllowEmptyString: Boolean = True); +var + I, L: SizeInt; + Left: AnsiString; +begin + Assert(List <> nil); + List.BeginUpdate; + try + List.Clear; + L := Length(Sep); + I := Pos(Sep, S); + while I > 0 do + begin + Left := StrLeft(S, I - 1); + if (Left <> '') or AllowEmptyString then + List.Add(Left); + Delete(S, 1, I + L - 1); + I := Pos(Sep, S); + end; + if (S <> '') or AllowEmptyString then + List.Add(S); // Ignore empty strings at the end (only if AllowEmptyString = False). + finally + List.EndUpdate; + end; +end; + +procedure StrIToStrings(S, Sep: AnsiString; const List: TJclAnsiStrings; const AllowEmptyString: Boolean = True); +var + I, L: SizeInt; + LowerCaseStr: AnsiString; + Left: AnsiString; +begin + Assert(List <> nil); + LowerCaseStr := StrLower(S); + Sep := StrLower(Sep); + L := Length(Sep); + I := Pos(Sep, LowerCaseStr); + List.BeginUpdate; + try + List.Clear; + while I > 0 do + begin + Left := StrLeft(S, I - 1); + if (Left <> '') or AllowEmptyString then + List.Add(Left); + Delete(S, 1, I + L - 1); + Delete(LowerCaseStr, 1, I + L - 1); + I := Pos(Sep, LowerCaseStr); + end; + if (S <> '') or AllowEmptyString then + List.Add(S); // Ignore empty strings at the end (only if AllowEmptyString = False). + finally + List.EndUpdate; + end; +end; + +function StringsToStr(const List: TJclAnsiStrings; const Sep: AnsiString; + const AllowEmptyString: Boolean): AnsiString; +var + I, L: SizeInt; +begin + Result := ''; + for I := 0 to List.Count - 1 do + begin + if (List[I] <> '') or AllowEmptyString then + begin + // don't combine these into one addition, somehow it hurts performance + Result := Result + List[I]; + Result := Result + Sep; + end; + end; + // remove terminating separator + if List.Count <> 0 then + begin + L := Length(Sep); + Delete(Result, Length(Result) - L + 1, L); + end; +end; + +procedure TrimStrings(const List: TJclAnsiStrings; DeleteIfEmpty: Boolean); +var + I: SizeInt; +begin + Assert(List <> nil); + List.BeginUpdate; + try + for I := List.Count - 1 downto 0 do + begin + List[I] := Trim(List[I]); + if (List[I] = '') and DeleteIfEmpty then + List.Delete(I); + end; + finally + List.EndUpdate; + end; +end; + +procedure TrimStringsRight(const List: TJclAnsiStrings; DeleteIfEmpty: Boolean); +var + I: SizeInt; +begin + Assert(List <> nil); + List.BeginUpdate; + try + for I := List.Count - 1 downto 0 do + begin + List[I] := TrimRight(List[I]); + if (List[I] = '') and DeleteIfEmpty then + List.Delete(I); + end; + finally + List.EndUpdate; + end; +end; + +procedure TrimStringsLeft(const List: TJclAnsiStrings; DeleteIfEmpty: Boolean); +var + I: SizeInt; +begin + Assert(List <> nil); + List.BeginUpdate; + try + for I := List.Count - 1 downto 0 do + begin + List[I] := TrimLeft(List[I]); + if (List[I] = '') and DeleteIfEmpty then + List.Delete(I); + end; + finally + List.EndUpdate; + end; +end; + +function AddStringToStrings(const S: AnsiString; Strings: TJclAnsiStrings; const Unique: Boolean): Boolean; +begin + Assert(Strings <> nil); + Result := Unique and (Strings.IndexOf(S) <> -1); + if not Result then + Result := Strings.Add(S) > -1; +end; + +//=== Miscellaneous ========================================================== + +function FileToString(const FileName: TFileName): AnsiString; +var + FS: TFileStream; + Len: SizeInt; +begin + FS := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); + try + Len := FS.Size; + SetLength(Result, Len); + if Len > 0 then + FS.ReadBuffer(Result[1], Len); + finally + FS.Free; + end; +end; + +procedure StringToFile(const FileName: TFileName; const Contents: AnsiString; Append: Boolean); +var + FS: TFileStream; + Len: SizeInt; +begin + if Append and FileExists(FileName) then + FS := TFileStream.Create(FileName, fmOpenReadWrite or fmShareDenyWrite) + else + FS := TFileStream.Create(FileName, fmCreate); + try + if Append then + FS.Seek(0, soEnd); // faster than .Position := .Size + Len := Length(Contents); + if Len > 0 then + FS.WriteBuffer(Contents[1], Len); + finally + FS.Free; + end; +end; + +function StrToken(var S: AnsiString; Separator: AnsiChar): AnsiString; +var + I: SizeInt; +begin + I := Pos(Separator, S); + if I <> 0 then + begin + Result := Copy(S, 1, I - 1); + Delete(S, 1, I); + end + else + begin + Result := S; + S := ''; + end; +end; + +procedure StrTokens(const S: AnsiString; const List: TJclAnsiStrings); +var + Start: PAnsiChar; + Token: AnsiString; + Done: Boolean; +begin + Assert(List <> nil); + if List = nil then + Exit; + + List.BeginUpdate; + try + List.Clear; + Start := Pointer(S); + repeat + Done := StrWord(Start, Token); + if Token <> '' then + List.Add(Token); + until Done; + finally + List.EndUpdate; + end; +end; + +procedure StrTokenToStrings(S: AnsiString; Separator: AnsiChar; const List: TJclAnsiStrings); +var + Token: AnsiString; +begin + Assert(List <> nil); + + if List = nil then + Exit; + + List.BeginUpdate; + try + List.Clear; + while S <> '' do + begin + Token := StrToken(S, Separator); + List.Add(Token); + end; + finally + List.EndUpdate; + end; +end; + +function StrWord(const S: AnsiString; var Index: SizeInt; out Word: AnsiString): Boolean; +var + Start: SizeInt; + C: AnsiChar; +begin + Word := ''; + if (S = '') then + begin + Result := True; + Exit; + end; + Start := Index; + Result := False; + while True do + begin + C := S[Index]; + case C of + #0: + begin + if Start <> 0 then + Word := Copy(S, Start, Index - Start); + Result := True; + Exit; + end; + AnsiSpace, AnsiLineFeed, AnsiCarriageReturn: + begin + if Start <> 0 then + begin + Word := Copy(S, Start, Index - Start); + Exit; + end + else + begin + while CharIsWhiteSpace(C) do + begin + Inc(Index); + C := S[Index]; + end; + end; + end; + else + if Start = 0 then + Start := Index; + Inc(Index); + end; + end; +end; + +function StrWord(var S: PAnsiChar; out Word: AnsiString): Boolean; +var + Start: PAnsiChar; +begin + Word := ''; + if S = nil then + begin + Result := True; + Exit; + end; + Start := nil; + Result := False; + while True do + begin + case S^ of + #0: + begin + if Start <> nil then + SetString(Word, Start, S - Start); + Result := True; + Exit; + end; + AnsiSpace, AnsiLineFeed, AnsiCarriageReturn: + begin + if Start <> nil then + begin + SetString(Word, Start, S - Start); + Exit; + end + else + while CharIsWhiteSpace(S^) do + Inc(S); + end; + else + if Start = nil then + Start := S; + Inc(S); + end; + end; +end; + +function StrIdent(const S: AnsiString; var Index: SizeInt; out Ident: AnsiString): Boolean; +var + Start: SizeInt; + C: AnsiChar; +begin + Ident := ''; + if (S = '') then + begin + Result := True; + Exit; + end; + Start := Index; + Result := False; + while True do + begin + C := S[Index]; + if CharIsValidIdentifierLetter(C) then + begin + if Start = 0 then + Start := Index; + end + else + if C = #0 then + begin + if Start <> 0 then + Ident := Copy(S, Start, Index - Start); + Result := True; + Exit; + end + else + begin + if Start <> 0 then + begin + Ident := Copy(S, Start, Index - Start); + Exit; + end; + end; + Inc(Index); + end; +end; + +function StrIdent(var S: PAnsiChar; out Ident: AnsiString): Boolean; +var + Start: PAnsiChar; + C: AnsiChar; +begin + Ident := ''; + if S = nil then + begin + Result := True; + Exit; + end; + Start := nil; + Result := False; + while True do + begin + C := S^; + if CharIsValidIdentifierLetter(C) then + begin + if Start = nil then + Start := S; + end + else + if C = #0 then + begin + if Start <> nil then + SetString(Ident, Start, S - Start); + Result := True; + Exit; + end + else + begin + if Start <> nil then + begin + SetString(Ident, Start, S - Start); + Exit; + end + end; + Inc(S); + end; +end; + +function StrToFloatSafe(const S: AnsiString): Float; +var + Temp: AnsiString; + I, J, K: SizeInt; + SwapSeparators, IsNegative: Boolean; + DecSep: AnsiChar; + ThouSep: AnsiChar; +begin + DecSep := AnsiChar(JclFormatSettings.DecimalSeparator); + ThouSep := AnsiChar(JclFormatSettings.ThousandSeparator); + Temp := S; + SwapSeparators := False; + + IsNegative := False; + J := 0; + for I := 1 to Length(Temp) do + begin + if Temp[I] = '-' then + IsNegative := not IsNegative + else + if not (Temp[I] in [' ', '(', '+']) then + begin + // if it appears prior to any digit, it has to be a decimal separator + SwapSeparators := Temp[I] = ThouSep; + J := I; + Break; + end; + end; + + if not SwapSeparators then + begin + K := CharPos(Temp, DecSep); + SwapSeparators := + // if it appears prior to any digit, it has to be a decimal separator + (K > J) and + // if it appears multiple times, it has to be a thousand separator + ((StrCharCount(Temp, DecSep) > 1) or + // we assume (consistent with Windows Platform SDK documentation), + // that thousand separators appear only to the left of the decimal + (K < CharPos(Temp, ThouSep))); + end; + + if SwapSeparators then + begin + // assume a numerical string from a different locale, + // where DecimalSeparator and ThousandSeparator are exchanged + for I := 1 to Length(Temp) do + if Temp[I] = DecSep then + Temp[I] := ThouSep + else + if Temp[I] = ThouSep then + Temp[I] := DecSep; + end; + + Temp := StrKeepChars(Temp, AnsiDecDigits + [DecSep]); + + if Length(Temp) > 0 then + begin + if Temp[1] = DecSep then + Temp := '0' + Temp; + if Temp[Length(Temp)] = DecSep then + Temp := Temp + '0'; + Result := StrToFloat(string(Temp)); + if IsNegative then + Result := -Result; + end + else + Result := 0.0; +end; + +function StrToIntSafe(const S: AnsiString): Integer; +begin + Result := Trunc(StrToFloatSafe(S)); +end; + +procedure StrNormIndex(const StrLen: SizeInt; var Index: SizeInt; var Count: SizeInt); overload; +begin + Index := Max(1, Min(Index, StrLen + 1)); + Count := Max(0, Min(Count, StrLen + 1 - Index)); +end; + +function ArrayOf(List: TJclAnsiStrings): TDynStringArray; +var + I: SizeInt; +begin + if List <> nil then + begin + SetLength(Result, List.Count); + for I := 0 to List.Count - 1 do + Result[I] := string(List[I]); + end + else + Result := nil; +end; + +function AnsiCompareNatural(const S1, S2: AnsiString; CaseInsensitive: Boolean): SizeInt; +var + Cur1, Len1, + Cur2, Len2: SizeInt; + + procedure NumberCompare; + var + IsReallyNumber: Boolean; + FirstDiffBreaks: Boolean; + Val1, Val2: SizeInt; + begin + Result := 0; + IsReallyNumber := False; + // count leading spaces in S1 + while CharIsWhiteSpace(S1[Cur1]) do + begin + Dec(Result); + Inc(Cur1); + end; + // count leading spaces in S2 (canceling them out against the ones in S1) + while CharIsWhiteSpace(S2[Cur2]) do + begin + Inc(Result); + Inc(Cur2); + end; + + // if spaces match, or both strings are actually followed by a numeric character, continue the checks + if (Result = 0) or (CharIsNumberChar(S1[Cur1])) and (CharIsNumberChar(S2[Cur2])) then + begin + // Check signed number + if (S1[Cur1] = '-') and (S2[Cur2] <> '-') then + Result := 1 + else + if (S2[Cur2] = '-') and (S1[Cur1] <> '-') then + Result := -1 + else + Result := 0; + + if (S1[Cur1] = '-') or (S1[Cur1] = '+') then + Inc(Cur1); + if (S2[Cur2] = '-') or (S2[Cur2] = '+') then + Inc(Cur2); + + FirstDiffBreaks := (S1[Cur1] = '0') or (S2[Cur2] = '0'); + while CharIsDigit(S1[Cur1]) and CharIsDigit(S2[Cur2]) do + begin + IsReallyNumber := True; + Val1 := StrToInt(string(S1[Cur1])); + Val2 := StrToInt(string(S2[Cur2])); + + if (Result = 0) and (Val1 < Val2) then + Result := -1 + else + if (Result = 0) and (Val1 > Val2) then + Result := 1; + if FirstDiffBreaks and (Result <> 0) then + Break; + Inc(Cur1); + Inc(Cur2); + end; + + if IsReallyNumber then + begin + if not FirstDiffBreaks then + begin + if CharIsDigit(S1[Cur1]) then + Result := 1 + else + if CharIsDigit(S2[Cur2]) then + Result := -1; + end; + end; + end; + end; + +begin + Cur1 := 1; + Len1 := Length(S1); + Cur2 := 1; + Len2 := Length(S2); + Result := 0; + + while (Result = 0) do + begin + if (Cur1 = Len1) and (Cur2 = Len2) then + Break + else + if (S1[Cur1] = '-') and CharIsNumberChar(S2[Cur2]) and (S2[Cur2] <> '-') then + Result := -1 + else + if (S2[Cur2] = '-') and CharIsNumberChar(S1[Cur1]) and (S1[Cur1] <> '-') then + Result := 1 + else + if CharIsNumberChar(S1[Cur1]) and CharIsNumberChar(S2[Cur2]) then + NumberCompare + else + if (Cur1 = Len1) and (Cur2 < Len2) then + Result := -1 + else + if (Cur1 < Len1) and (Cur2 = Len2) then + Result := 1 + else + begin + Result := StrCompare(S1,S2); + if CaseInsensitive then + Result := AnsiStrLICompA(PAnsiChar(@S1[Cur1]), PAnsiChar(@S2[Cur2]), 1) + else + Result := AnsiStrLCompA(PAnsiChar(@S1[Cur1]), PAnsiChar(@S2[Cur2]), 1); + Inc(Cur1); + Inc(Cur2); + end; + end; +end; + +function AnsiCompareNaturalStr(const S1, S2: AnsiString): SizeInt; overload; +begin + Result := AnsiCompareNatural(S1, S2, False); +end; + +function AnsiCompareNaturalText(const S1, S2: AnsiString): SizeInt; overload; +begin + Result := AnsiCompareNatural(S1, S2, True); +end; + + +function StrNewA(const Str: PAnsiChar): PAnsiChar; +begin + Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrNew(Str); +end; + +procedure StrDisposeA(Str: PAnsiChar); +begin + {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrDispose(Str); +end; + +function StrLenA(S: PAnsiChar): Integer; +begin + Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrLen(S); +end; + +function StrEndA(const Str: PAnsiChar): PAnsiChar; +begin + Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrEnd(Str); +end; + +function StrPosA(const Str1, Str2: PAnsiChar): PAnsiChar; +begin + Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrPos(Str1, Str2); +end; + +function StrPasA(const Str: PAnsiChar): AnsiString; +begin + Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrPas(Str); +end; + +function StrCopyA(Dest: PAnsiChar; const Source: PAnsiChar): PAnsiChar; +begin + Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrCopy(Dest, Source); +end; + +function StrLCopyA(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar; +begin + Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrLCopy(Dest, Source, MaxLen); +end; + +function StrPCopyA(Dest: PAnsiChar; const Source: AnsiString): PAnsiChar; +begin + Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrPCopy(Dest, Source); +end; + +function StrPLCopyA(Dest: PAnsiChar; const Source: AnsiString; MaxLen: Cardinal): PAnsiChar; +begin + Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrPLCopy(Dest, Source, MaxLen); +end; + +function StrECopyA(Dest: PAnsiChar; const Source: PAnsiChar): PAnsiChar; +begin + Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrECopy(Dest, Source); +end; + +function StrCatA(Dest: PAnsiChar; const Source: PAnsiChar): PAnsiChar; +begin + Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrCat(Dest, Source); +end; + +function StrLCatA(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar; +begin + Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrLCat(Dest, Source, MaxLen); +end; + +function StrCompA(const Str1, Str2: PAnsiChar): Integer; +begin + Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrComp(Str1, Str2); +end; + +function StrLCompA(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer; +begin + Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrLComp(Str1, Str2, MaxLen); +end; + +function StrICompA(const Str1, Str2: PAnsiChar): Integer; +begin + Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrIComp(Str1, Str2); +end; + +function StrLICompA(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer; +begin + Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrIComp(Str1, Str2); +end; + +function StrFmtA(Buffer, Format: PAnsiChar; const Args: array of const): PAnsiChar; +begin + Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrFmt(Buffer, Format, Args); +end; + +function AnsiStrPosA(const Str1, Str2: PAnsiChar): PAnsiChar; +begin + Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}AnsiStrPos(Str1, Str2); +end; + +function AnsiStrLICompA(S1, S2: PAnsiChar; MaxLen: Cardinal): Integer; +begin + Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}AnsiStrLIComp(S1, S2, MaxLen); +end; + +function AnsiStrLCompA(S1, S2: PAnsiChar; MaxLen: Cardinal): Integer; +begin + Result := {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}AnsiStrLComp(S1, S2, MaxLen); +end; + + +initialization + LoadCharTypes; // this table first + LoadCaseMap; // or this function does not work +{$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclArrayLists.pas b/3rdParty/JCL/source/common/JclArrayLists.pas new file mode 100644 index 00000000..65610507 --- /dev/null +++ b/3rdParty/JCL/source/common/JclArrayLists.pas @@ -0,0 +1,12057 @@ +{**************************************************************************************************} +{ WARNING: JEDI preprocessor generated unit. Do not edit. } +{**************************************************************************************************} + +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is ArrayList.pas. } +{ } +{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } +{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } +{ All rights reserved. } +{ } +{ Contributors: } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclArrayLists; + +{$I jcl.inc} + +interface + +uses + {$IFDEF HAS_UNITSCOPE} + System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Classes, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclAlgorithms, + JclBase, JclAbstractContainers, JclContainerIntf, JclSynch; + + +type + TItrStart = (isFirst, isLast); + + TJclIntfArrayList = class(TJclIntfAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclIntfEqualityComparer, IJclIntfContainer, IJclIntfFlatContainer, + IJclIntfCollection, IJclIntfList, IJclIntfArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElementData: TDynIInterfaceArray; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: IInterface; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); overload; + constructor Create(const ACollection: IJclIntfCollection); overload; + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclIntfCollection } + function Add(const AInterface: IInterface): Boolean; + function AddAll(const ACollection: IJclIntfCollection): Boolean; + procedure Clear; + function Contains(const AInterface: IInterface): Boolean; + function ContainsAll(const ACollection: IJclIntfCollection): Boolean; + function CollectionEquals(const ACollection: IJclIntfCollection): Boolean; + function Extract(const AInterface: IInterface): Boolean; + function ExtractAll(const ACollection: IJclIntfCollection): Boolean; + function First: IJclIntfIterator; + function IsEmpty: Boolean; + function Last: IJclIntfIterator; + function Remove(const AInterface: IInterface): Boolean; + function RemoveAll(const ACollection: IJclIntfCollection): Boolean; + function RetainAll(const ACollection: IJclIntfCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIntfIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclIntfList } + function Delete(Index: Integer): IInterface; + function ExtractIndex(Index: Integer): IInterface; + function GetObject(Index: Integer): IInterface; + function IndexOf(const AInterface: IInterface): Integer; + function Insert(Index: Integer; const AInterface: IInterface): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclIntfCollection): Boolean; + function LastIndexOf(const AInterface: IInterface): Integer; + procedure SetObject(Index: Integer; const AInterface: IInterface); + function SubList(First, Count: Integer): IJclIntfList; + end; + + TJclIntfArrayIterator = class(TJclAbstractIterator, IJclIntfIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclIntfArrayList; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclIntfArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclIntfIterator } + function Add(const AInterface: IInterface): Boolean; + procedure Extract; + function GetObject: IInterface; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AInterface: IInterface): Boolean; + function IteratorEquals(const AIterator: IJclIntfIterator): Boolean; + function Next: IInterface; + function NextIndex: Integer; + function Previous: IInterface; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetObject(const AInterface: IInterface); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: IInterface read GetObject; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclAnsiStrArrayList = class(TJclAnsiStrAbstractCollection, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclAnsiStrEqualityComparer, IJclAnsiStrContainer, IJclAnsiStrFlatContainer, IJclStrBaseContainer, + IJclAnsiStrCollection, IJclAnsiStrList, IJclAnsiStrArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElementData: TDynAnsiStringArray; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: AnsiString; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); overload; + constructor Create(const ACollection: IJclAnsiStrCollection); overload; + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclAnsiStrCollection } + function Add(const AString: AnsiString): Boolean; override; + function AddAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + procedure Clear; override; + function Contains(const AString: AnsiString): Boolean; override; + function ContainsAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + function CollectionEquals(const ACollection: IJclAnsiStrCollection): Boolean; override; + function Extract(const AString: AnsiString): Boolean; override; + function ExtractAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + function First: IJclAnsiStrIterator; override; + function IsEmpty: Boolean; override; + function Last: IJclAnsiStrIterator; override; + function Remove(const AString: AnsiString): Boolean; override; + function RemoveAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + function RetainAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + function Size: Integer; override; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclAnsiStrIterator; override; + {$ENDIF SUPPORTS_FOR_IN} + { IJclAnsiStrList } + function Delete(Index: Integer): AnsiString; + function ExtractIndex(Index: Integer): AnsiString; + function GetString(Index: Integer): AnsiString; + function IndexOf(const AString: AnsiString): Integer; + function Insert(Index: Integer; const AString: AnsiString): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclAnsiStrCollection): Boolean; + function LastIndexOf(const AString: AnsiString): Integer; + procedure SetString(Index: Integer; const AString: AnsiString); + function SubList(First, Count: Integer): IJclAnsiStrList; + end; + + TJclAnsiStrArrayIterator = class(TJclAbstractIterator, IJclAnsiStrIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclAnsiStrArrayList; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclAnsiStrArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclAnsiStrIterator } + function Add(const AString: AnsiString): Boolean; + procedure Extract; + function GetString: AnsiString; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AString: AnsiString): Boolean; + function IteratorEquals(const AIterator: IJclAnsiStrIterator): Boolean; + function Next: AnsiString; + function NextIndex: Integer; + function Previous: AnsiString; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetString(const AString: AnsiString); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: AnsiString read GetString; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclWideStrArrayList = class(TJclWideStrAbstractCollection, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclWideStrEqualityComparer, IJclWideStrContainer, IJclWideStrFlatContainer, IJclStrBaseContainer, + IJclWideStrCollection, IJclWideStrList, IJclWideStrArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElementData: TDynWideStringArray; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: WideString; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); overload; + constructor Create(const ACollection: IJclWideStrCollection); overload; + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclWideStrCollection } + function Add(const AString: WideString): Boolean; override; + function AddAll(const ACollection: IJclWideStrCollection): Boolean; override; + procedure Clear; override; + function Contains(const AString: WideString): Boolean; override; + function ContainsAll(const ACollection: IJclWideStrCollection): Boolean; override; + function CollectionEquals(const ACollection: IJclWideStrCollection): Boolean; override; + function Extract(const AString: WideString): Boolean; override; + function ExtractAll(const ACollection: IJclWideStrCollection): Boolean; override; + function First: IJclWideStrIterator; override; + function IsEmpty: Boolean; override; + function Last: IJclWideStrIterator; override; + function Remove(const AString: WideString): Boolean; override; + function RemoveAll(const ACollection: IJclWideStrCollection): Boolean; override; + function RetainAll(const ACollection: IJclWideStrCollection): Boolean; override; + function Size: Integer; override; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclWideStrIterator; override; + {$ENDIF SUPPORTS_FOR_IN} + { IJclWideStrList } + function Delete(Index: Integer): WideString; + function ExtractIndex(Index: Integer): WideString; + function GetString(Index: Integer): WideString; + function IndexOf(const AString: WideString): Integer; + function Insert(Index: Integer; const AString: WideString): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclWideStrCollection): Boolean; + function LastIndexOf(const AString: WideString): Integer; + procedure SetString(Index: Integer; const AString: WideString); + function SubList(First, Count: Integer): IJclWideStrList; + end; + + TJclWideStrArrayIterator = class(TJclAbstractIterator, IJclWideStrIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclWideStrArrayList; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclWideStrArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclWideStrIterator } + function Add(const AString: WideString): Boolean; + procedure Extract; + function GetString: WideString; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AString: WideString): Boolean; + function IteratorEquals(const AIterator: IJclWideStrIterator): Boolean; + function Next: WideString; + function NextIndex: Integer; + function Previous: WideString; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetString(const AString: WideString); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: WideString read GetString; + {$ENDIF SUPPORTS_FOR_IN} + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclUnicodeStrArrayList = class(TJclUnicodeStrAbstractCollection, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclUnicodeStrEqualityComparer, IJclUnicodeStrContainer, IJclUnicodeStrFlatContainer, IJclStrBaseContainer, + IJclUnicodeStrCollection, IJclUnicodeStrList, IJclUnicodeStrArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElementData: TDynUnicodeStringArray; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: UnicodeString; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); overload; + constructor Create(const ACollection: IJclUnicodeStrCollection); overload; + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclUnicodeStrCollection } + function Add(const AString: UnicodeString): Boolean; override; + function AddAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + procedure Clear; override; + function Contains(const AString: UnicodeString): Boolean; override; + function ContainsAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function CollectionEquals(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function Extract(const AString: UnicodeString): Boolean; override; + function ExtractAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function First: IJclUnicodeStrIterator; override; + function IsEmpty: Boolean; override; + function Last: IJclUnicodeStrIterator; override; + function Remove(const AString: UnicodeString): Boolean; override; + function RemoveAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function RetainAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function Size: Integer; override; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclUnicodeStrIterator; override; + {$ENDIF SUPPORTS_FOR_IN} + { IJclUnicodeStrList } + function Delete(Index: Integer): UnicodeString; + function ExtractIndex(Index: Integer): UnicodeString; + function GetString(Index: Integer): UnicodeString; + function IndexOf(const AString: UnicodeString): Integer; + function Insert(Index: Integer; const AString: UnicodeString): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclUnicodeStrCollection): Boolean; + function LastIndexOf(const AString: UnicodeString): Integer; + procedure SetString(Index: Integer; const AString: UnicodeString); + function SubList(First, Count: Integer): IJclUnicodeStrList; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclUnicodeStrArrayIterator = class(TJclAbstractIterator, IJclUnicodeStrIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclUnicodeStrArrayList; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclUnicodeStrArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclUnicodeStrIterator } + function Add(const AString: UnicodeString): Boolean; + procedure Extract; + function GetString: UnicodeString; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AString: UnicodeString): Boolean; + function IteratorEquals(const AIterator: IJclUnicodeStrIterator): Boolean; + function Next: UnicodeString; + function NextIndex: Integer; + function Previous: UnicodeString; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetString(const AString: UnicodeString); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: UnicodeString read GetString; + {$ENDIF SUPPORTS_FOR_IN} + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + TJclStrArrayList = TJclAnsiStrArrayList; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TJclStrArrayList = TJclWideStrArrayList; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TJclStrArrayList = TJclUnicodeStrArrayList; + {$ENDIF CONTAINER_UNICODESTR} + + {$IFDEF CONTAINER_ANSISTR} + TJclStrArrayIterator = TJclAnsiStrArrayIterator; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TJclStrArrayIterator = TJclWideStrArrayIterator; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TJclStrArrayIterator = TJclUnicodeStrArrayIterator; + {$ENDIF CONTAINER_UNICODESTR} + + TJclSingleArrayList = class(TJclSingleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclSingleEqualityComparer, IJclSingleContainer, IJclSingleFlatContainer, + IJclSingleCollection, IJclSingleList, IJclSingleArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElementData: TDynSingleArray; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: Single; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); overload; + constructor Create(const ACollection: IJclSingleCollection); overload; + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclSingleCollection } + function Add(const AValue: Single): Boolean; + function AddAll(const ACollection: IJclSingleCollection): Boolean; + procedure Clear; + function Contains(const AValue: Single): Boolean; + function ContainsAll(const ACollection: IJclSingleCollection): Boolean; + function CollectionEquals(const ACollection: IJclSingleCollection): Boolean; + function Extract(const AValue: Single): Boolean; + function ExtractAll(const ACollection: IJclSingleCollection): Boolean; + function First: IJclSingleIterator; + function IsEmpty: Boolean; + function Last: IJclSingleIterator; + function Remove(const AValue: Single): Boolean; + function RemoveAll(const ACollection: IJclSingleCollection): Boolean; + function RetainAll(const ACollection: IJclSingleCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclSingleIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclSingleList } + function Delete(Index: Integer): Single; + function ExtractIndex(Index: Integer): Single; + function GetValue(Index: Integer): Single; + function IndexOf(const AValue: Single): Integer; + function Insert(Index: Integer; const AValue: Single): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclSingleCollection): Boolean; + function LastIndexOf(const AValue: Single): Integer; + procedure SetValue(Index: Integer; const AValue: Single); + function SubList(First, Count: Integer): IJclSingleList; + end; + + TJclSingleArrayIterator = class(TJclAbstractIterator, IJclSingleIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclSingleArrayList; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclSingleArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclSingleIterator } + function Add(const AValue: Single): Boolean; + procedure Extract; + function GetValue: Single; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AValue: Single): Boolean; + function IteratorEquals(const AIterator: IJclSingleIterator): Boolean; + function Next: Single; + function NextIndex: Integer; + function Previous: Single; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(const AValue: Single); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Single read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclDoubleArrayList = class(TJclDoubleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclDoubleEqualityComparer, IJclDoubleContainer, IJclDoubleFlatContainer, + IJclDoubleCollection, IJclDoubleList, IJclDoubleArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElementData: TDynDoubleArray; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: Double; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); overload; + constructor Create(const ACollection: IJclDoubleCollection); overload; + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclDoubleCollection } + function Add(const AValue: Double): Boolean; + function AddAll(const ACollection: IJclDoubleCollection): Boolean; + procedure Clear; + function Contains(const AValue: Double): Boolean; + function ContainsAll(const ACollection: IJclDoubleCollection): Boolean; + function CollectionEquals(const ACollection: IJclDoubleCollection): Boolean; + function Extract(const AValue: Double): Boolean; + function ExtractAll(const ACollection: IJclDoubleCollection): Boolean; + function First: IJclDoubleIterator; + function IsEmpty: Boolean; + function Last: IJclDoubleIterator; + function Remove(const AValue: Double): Boolean; + function RemoveAll(const ACollection: IJclDoubleCollection): Boolean; + function RetainAll(const ACollection: IJclDoubleCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclDoubleIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclDoubleList } + function Delete(Index: Integer): Double; + function ExtractIndex(Index: Integer): Double; + function GetValue(Index: Integer): Double; + function IndexOf(const AValue: Double): Integer; + function Insert(Index: Integer; const AValue: Double): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclDoubleCollection): Boolean; + function LastIndexOf(const AValue: Double): Integer; + procedure SetValue(Index: Integer; const AValue: Double); + function SubList(First, Count: Integer): IJclDoubleList; + end; + + TJclDoubleArrayIterator = class(TJclAbstractIterator, IJclDoubleIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclDoubleArrayList; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclDoubleArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclDoubleIterator } + function Add(const AValue: Double): Boolean; + procedure Extract; + function GetValue: Double; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AValue: Double): Boolean; + function IteratorEquals(const AIterator: IJclDoubleIterator): Boolean; + function Next: Double; + function NextIndex: Integer; + function Previous: Double; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(const AValue: Double); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Double read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclExtendedArrayList = class(TJclExtendedAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclExtendedEqualityComparer, IJclExtendedContainer, IJclExtendedFlatContainer, + IJclExtendedCollection, IJclExtendedList, IJclExtendedArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElementData: TDynExtendedArray; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: Extended; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); overload; + constructor Create(const ACollection: IJclExtendedCollection); overload; + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclExtendedCollection } + function Add(const AValue: Extended): Boolean; + function AddAll(const ACollection: IJclExtendedCollection): Boolean; + procedure Clear; + function Contains(const AValue: Extended): Boolean; + function ContainsAll(const ACollection: IJclExtendedCollection): Boolean; + function CollectionEquals(const ACollection: IJclExtendedCollection): Boolean; + function Extract(const AValue: Extended): Boolean; + function ExtractAll(const ACollection: IJclExtendedCollection): Boolean; + function First: IJclExtendedIterator; + function IsEmpty: Boolean; + function Last: IJclExtendedIterator; + function Remove(const AValue: Extended): Boolean; + function RemoveAll(const ACollection: IJclExtendedCollection): Boolean; + function RetainAll(const ACollection: IJclExtendedCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclExtendedIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclExtendedList } + function Delete(Index: Integer): Extended; + function ExtractIndex(Index: Integer): Extended; + function GetValue(Index: Integer): Extended; + function IndexOf(const AValue: Extended): Integer; + function Insert(Index: Integer; const AValue: Extended): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclExtendedCollection): Boolean; + function LastIndexOf(const AValue: Extended): Integer; + procedure SetValue(Index: Integer; const AValue: Extended); + function SubList(First, Count: Integer): IJclExtendedList; + end; + + TJclExtendedArrayIterator = class(TJclAbstractIterator, IJclExtendedIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclExtendedArrayList; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclExtendedArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclExtendedIterator } + function Add(const AValue: Extended): Boolean; + procedure Extract; + function GetValue: Extended; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AValue: Extended): Boolean; + function IteratorEquals(const AIterator: IJclExtendedIterator): Boolean; + function Next: Extended; + function NextIndex: Integer; + function Previous: Extended; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(const AValue: Extended); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Extended read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + {$IFDEF MATH_SINGLE_PRECISION} + TJclFloatArrayList = TJclSingleArrayList; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TJclFloatArrayList = TJclDoubleArrayList; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TJclFloatArrayList = TJclExtendedArrayList; + {$ENDIF MATH_EXTENDED_PRECISION} + + {$IFDEF MATH_SINGLE_PRECISION} + TJclFloatArrayIterator = TJclSingleArrayIterator; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TJclFloatArrayIterator = TJclDoubleArrayIterator; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TJclFloatArrayIterator = TJclExtendedArrayIterator; + {$ENDIF MATH_EXTENDED_PRECISION} + + TJclIntegerArrayList = class(TJclIntegerAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclIntegerEqualityComparer, IJclIntegerContainer, IJclIntegerFlatContainer, + IJclIntegerCollection, IJclIntegerList, IJclIntegerArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElementData: TDynIntegerArray; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: Integer; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); overload; + constructor Create(const ACollection: IJclIntegerCollection); overload; + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclIntegerCollection } + function Add(AValue: Integer): Boolean; + function AddAll(const ACollection: IJclIntegerCollection): Boolean; + procedure Clear; + function Contains(AValue: Integer): Boolean; + function ContainsAll(const ACollection: IJclIntegerCollection): Boolean; + function CollectionEquals(const ACollection: IJclIntegerCollection): Boolean; + function Extract(AValue: Integer): Boolean; + function ExtractAll(const ACollection: IJclIntegerCollection): Boolean; + function First: IJclIntegerIterator; + function IsEmpty: Boolean; + function Last: IJclIntegerIterator; + function Remove(AValue: Integer): Boolean; + function RemoveAll(const ACollection: IJclIntegerCollection): Boolean; + function RetainAll(const ACollection: IJclIntegerCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIntegerIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclIntegerList } + function Delete(Index: Integer): Integer; + function ExtractIndex(Index: Integer): Integer; + function GetValue(Index: Integer): Integer; + function IndexOf(AValue: Integer): Integer; + function Insert(Index: Integer; AValue: Integer): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclIntegerCollection): Boolean; + function LastIndexOf(AValue: Integer): Integer; + procedure SetValue(Index: Integer; AValue: Integer); + function SubList(First, Count: Integer): IJclIntegerList; + end; + + TJclIntegerArrayIterator = class(TJclAbstractIterator, IJclIntegerIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclIntegerArrayList; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclIntegerArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclIntegerIterator } + function Add(AValue: Integer): Boolean; + procedure Extract; + function GetValue: Integer; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(AValue: Integer): Boolean; + function IteratorEquals(const AIterator: IJclIntegerIterator): Boolean; + function Next: Integer; + function NextIndex: Integer; + function Previous: Integer; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(AValue: Integer); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Integer read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclCardinalArrayList = class(TJclCardinalAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclCardinalEqualityComparer, IJclCardinalContainer, IJclCardinalFlatContainer, + IJclCardinalCollection, IJclCardinalList, IJclCardinalArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElementData: TDynCardinalArray; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: Cardinal; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); overload; + constructor Create(const ACollection: IJclCardinalCollection); overload; + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclCardinalCollection } + function Add(AValue: Cardinal): Boolean; + function AddAll(const ACollection: IJclCardinalCollection): Boolean; + procedure Clear; + function Contains(AValue: Cardinal): Boolean; + function ContainsAll(const ACollection: IJclCardinalCollection): Boolean; + function CollectionEquals(const ACollection: IJclCardinalCollection): Boolean; + function Extract(AValue: Cardinal): Boolean; + function ExtractAll(const ACollection: IJclCardinalCollection): Boolean; + function First: IJclCardinalIterator; + function IsEmpty: Boolean; + function Last: IJclCardinalIterator; + function Remove(AValue: Cardinal): Boolean; + function RemoveAll(const ACollection: IJclCardinalCollection): Boolean; + function RetainAll(const ACollection: IJclCardinalCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclCardinalIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclCardinalList } + function Delete(Index: Integer): Cardinal; + function ExtractIndex(Index: Integer): Cardinal; + function GetValue(Index: Integer): Cardinal; + function IndexOf(AValue: Cardinal): Integer; + function Insert(Index: Integer; AValue: Cardinal): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclCardinalCollection): Boolean; + function LastIndexOf(AValue: Cardinal): Integer; + procedure SetValue(Index: Integer; AValue: Cardinal); + function SubList(First, Count: Integer): IJclCardinalList; + end; + + TJclCardinalArrayIterator = class(TJclAbstractIterator, IJclCardinalIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclCardinalArrayList; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclCardinalArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclCardinalIterator } + function Add(AValue: Cardinal): Boolean; + procedure Extract; + function GetValue: Cardinal; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(AValue: Cardinal): Boolean; + function IteratorEquals(const AIterator: IJclCardinalIterator): Boolean; + function Next: Cardinal; + function NextIndex: Integer; + function Previous: Cardinal; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(AValue: Cardinal); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Cardinal read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclInt64ArrayList = class(TJclInt64AbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclInt64EqualityComparer, IJclInt64Container, IJclInt64FlatContainer, + IJclInt64Collection, IJclInt64List, IJclInt64Array) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElementData: TDynInt64Array; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: Int64; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); overload; + constructor Create(const ACollection: IJclInt64Collection); overload; + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclInt64Collection } + function Add(const AValue: Int64): Boolean; + function AddAll(const ACollection: IJclInt64Collection): Boolean; + procedure Clear; + function Contains(const AValue: Int64): Boolean; + function ContainsAll(const ACollection: IJclInt64Collection): Boolean; + function CollectionEquals(const ACollection: IJclInt64Collection): Boolean; + function Extract(const AValue: Int64): Boolean; + function ExtractAll(const ACollection: IJclInt64Collection): Boolean; + function First: IJclInt64Iterator; + function IsEmpty: Boolean; + function Last: IJclInt64Iterator; + function Remove(const AValue: Int64): Boolean; + function RemoveAll(const ACollection: IJclInt64Collection): Boolean; + function RetainAll(const ACollection: IJclInt64Collection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclInt64Iterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclInt64List } + function Delete(Index: Integer): Int64; + function ExtractIndex(Index: Integer): Int64; + function GetValue(Index: Integer): Int64; + function IndexOf(const AValue: Int64): Integer; + function Insert(Index: Integer; const AValue: Int64): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclInt64Collection): Boolean; + function LastIndexOf(const AValue: Int64): Integer; + procedure SetValue(Index: Integer; const AValue: Int64); + function SubList(First, Count: Integer): IJclInt64List; + end; + + TJclInt64ArrayIterator = class(TJclAbstractIterator, IJclInt64Iterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclInt64ArrayList; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclInt64ArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclInt64Iterator } + function Add(const AValue: Int64): Boolean; + procedure Extract; + function GetValue: Int64; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AValue: Int64): Boolean; + function IteratorEquals(const AIterator: IJclInt64Iterator): Boolean; + function Next: Int64; + function NextIndex: Integer; + function Previous: Int64; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(const AValue: Int64); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Int64 read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclPtrArrayList = class(TJclPtrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclPtrEqualityComparer, IJclPtrContainer, IJclPtrFlatContainer, + IJclPtrCollection, IJclPtrList, IJclPtrArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElementData: TDynPointerArray; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: Pointer; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); overload; + constructor Create(const ACollection: IJclPtrCollection); overload; + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclPtrCollection } + function Add(APtr: Pointer): Boolean; + function AddAll(const ACollection: IJclPtrCollection): Boolean; + procedure Clear; + function Contains(APtr: Pointer): Boolean; + function ContainsAll(const ACollection: IJclPtrCollection): Boolean; + function CollectionEquals(const ACollection: IJclPtrCollection): Boolean; + function Extract(APtr: Pointer): Boolean; + function ExtractAll(const ACollection: IJclPtrCollection): Boolean; + function First: IJclPtrIterator; + function IsEmpty: Boolean; + function Last: IJclPtrIterator; + function Remove(APtr: Pointer): Boolean; + function RemoveAll(const ACollection: IJclPtrCollection): Boolean; + function RetainAll(const ACollection: IJclPtrCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclPtrIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclPtrList } + function Delete(Index: Integer): Pointer; + function ExtractIndex(Index: Integer): Pointer; + function GetPointer(Index: Integer): Pointer; + function IndexOf(APtr: Pointer): Integer; + function Insert(Index: Integer; APtr: Pointer): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclPtrCollection): Boolean; + function LastIndexOf(APtr: Pointer): Integer; + procedure SetPointer(Index: Integer; APtr: Pointer); + function SubList(First, Count: Integer): IJclPtrList; + end; + + TJclPtrArrayIterator = class(TJclAbstractIterator, IJclPtrIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclPtrArrayList; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclPtrArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclPtrIterator } + function Add(APtr: Pointer): Boolean; + procedure Extract; + function GetPointer: Pointer; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(APtr: Pointer): Boolean; + function IteratorEquals(const AIterator: IJclPtrIterator): Boolean; + function Next: Pointer; + function NextIndex: Integer; + function Previous: Pointer; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetPointer(APtr: Pointer); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Pointer read GetPointer; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclArrayList = class(TJclAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclEqualityComparer, IJclContainer, IJclFlatContainer, IJclObjectOwner, + IJclCollection, IJclList, IJclArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElementData: TDynObjectArray; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: TObject; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer; AOwnsObjects: Boolean); overload; + constructor Create(const ACollection: IJclCollection; AOwnsObjects: Boolean); overload; + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclCollection } + function Add(AObject: TObject): Boolean; + function AddAll(const ACollection: IJclCollection): Boolean; + procedure Clear; + function Contains(AObject: TObject): Boolean; + function ContainsAll(const ACollection: IJclCollection): Boolean; + function CollectionEquals(const ACollection: IJclCollection): Boolean; + function Extract(AObject: TObject): Boolean; + function ExtractAll(const ACollection: IJclCollection): Boolean; + function First: IJclIterator; + function IsEmpty: Boolean; + function Last: IJclIterator; + function Remove(AObject: TObject): Boolean; + function RemoveAll(const ACollection: IJclCollection): Boolean; + function RetainAll(const ACollection: IJclCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclList } + function Delete(Index: Integer): TObject; + function ExtractIndex(Index: Integer): TObject; + function GetObject(Index: Integer): TObject; + function IndexOf(AObject: TObject): Integer; + function Insert(Index: Integer; AObject: TObject): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclCollection): Boolean; + function LastIndexOf(AObject: TObject): Integer; + procedure SetObject(Index: Integer; AObject: TObject); + function SubList(First, Count: Integer): IJclList; + end; + + TJclArrayIterator = class(TJclAbstractIterator, IJclIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclArrayList; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclIterator } + function Add(AObject: TObject): Boolean; + procedure Extract; + function GetObject: TObject; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(AObject: TObject): Boolean; + function IteratorEquals(const AIterator: IJclIterator): Boolean; + function Next: TObject; + function NextIndex: Integer; + function Previous: TObject; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetObject(AObject: TObject); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: TObject read GetObject; + {$ENDIF SUPPORTS_FOR_IN} + end; + + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + + TJclArrayIterator = class; + + TJclArrayList = class(TJclAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclEqualityComparer, IJclContainer, IJclFlatContainer, IJclItemOwner, + IJclCollection, IJclList, IJclArray) + protected + type + TDynArray = array of T; + TArrayIterator = TJclArrayIterator; + procedure MoveArray(var List: TDynArray; FromIndex, ToIndex, Count: SizeInt); + private + FElementData: TDynArray; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: T; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer; AOwnsItems: Boolean); overload; + constructor Create(const ACollection: IJclCollection; AOwnsItems: Boolean); overload; + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclCollection } + function Add(const AItem: T): Boolean; + function AddAll(const ACollection: IJclCollection): Boolean; + procedure Clear; + function Contains(const AItem: T): Boolean; + function ContainsAll(const ACollection: IJclCollection): Boolean; + function CollectionEquals(const ACollection: IJclCollection): Boolean; + function Extract(const AItem: T): Boolean; + function ExtractAll(const ACollection: IJclCollection): Boolean; + function First: IJclIterator; + function IsEmpty: Boolean; + function Last: IJclIterator; + function Remove(const AItem: T): Boolean; + function RemoveAll(const ACollection: IJclCollection): Boolean; + function RetainAll(const ACollection: IJclCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclList } + function Delete(Index: Integer): T; + function ExtractIndex(Index: Integer): T; + function GetItem(Index: Integer): T; + function IndexOf(const AItem: T): Integer; + function Insert(Index: Integer; const AItem: T): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclCollection): Boolean; + function LastIndexOf(const AItem: T): Integer; + procedure SetItem(Index: Integer; const AItem: T); + function SubList(First, Count: Integer): IJclList; + end; + + TJclArrayIterator = class(TJclAbstractIterator, IJclIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclArrayList; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclIterator } + function Add(const AItem: T): Boolean; + procedure Extract; + function GetItem: T; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AItem: T): Boolean; + function IteratorEquals(const AIterator: IJclIterator): Boolean; + function Next: T; + function NextIndex: Integer; + function Previous: T; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetItem(const AItem: T); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: T read GetItem; + {$ENDIF SUPPORTS_FOR_IN} + end; + + // E = External helper to compare items for equality + // GetHashCode is not used + TJclArrayListE = class(TJclArrayList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, IJclItemOwner, IJclEqualityComparer, + IJclCollection, IJclList, IJclArray) + private + FEqualityComparer: IJclEqualityComparer; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AEqualityComparer: IJclEqualityComparer; ACapacity: Integer; AOwnsItems: Boolean); overload; + constructor Create(const AEqualityComparer: IJclEqualityComparer; const ACollection: IJclCollection; AOwnsItems: Boolean); overload; + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + property EqualityComparer: IJclEqualityComparer read FEqualityComparer write FEqualityComparer; + end; + + // F = Function to compare items for equality + TJclArrayListF = class(TJclArrayList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, IJclItemOwner, IJclEqualityComparer, + IJclCollection, IJclList, IJclArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AEqualityCompare: TEqualityCompare; ACapacity: Integer; AOwnsItems: Boolean); overload; + constructor Create(const AEqualityCompare: TEqualityCompare; const ACollection: IJclCollection; AOwnsItems: Boolean); overload; + end; + + // I = Items can compare themselves to others + TJclArrayListI> = class(TJclArrayList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, IJclItemOwner, IJclEqualityComparer, + IJclCollection, IJclList, IJclArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +{$IFDEF BCB} +{$IFDEF WIN64} + {$HPPEMIT '#ifdef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #undef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #define JclArrayLists_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT '#endif'} + + {$HPPEMIT END '#ifdef JclArrayLists_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #define MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #undef JclArrayLists_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END '#endif'} +{$ENDIF WIN64} +{$ENDIF BCB} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF SUPPORTNAMESPACES} + System.SysUtils; + {$ELSE} + SysUtils; + {$ENDIF} + +//=== { TJclIntfArrayList } ====================================================== + +constructor TJclIntfArrayList.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +constructor TJclIntfArrayList.Create(const ACollection: IJclIntfCollection); +begin + inherited Create(); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclIntfArrayList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclIntfArrayList.Add(const AInterface: IInterface): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AInterface, nil); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(AInterface, FElementData[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElementData[FSize] := AInterface; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfArrayList.AddAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfArrayList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclIntfArrayList; + ACollection: IJclIntfCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntfArrayList then + begin + ADest := TJclIntfArrayList(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclIntfCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclIntfArrayList.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeObject(FElementData[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfArrayList.CollectionEquals(const ACollection: IJclIntfCollection): Boolean; +var + I: Integer; + It: IJclIntfIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FElementData[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfArrayList.Contains(const AInterface: IInterface): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AInterface) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfArrayList.ContainsAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfArrayList.Delete(Index: Integer): IInterface; +var + Extracted: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreeObject(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfArrayList.Extract(const AInterface: IInterface): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], AInterface) then + begin + if I < (FSize - 1) then + MoveArray(FElementData, I + 1, I, FSize - 1 - I) + else + FElementData[I] := nil; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfArrayList.ExtractAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfArrayList.ExtractIndex(Index: Integer): IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FElementData[Index]; + if Index < (FSize - 1) then + MoveArray(FElementData, Index + 1, Index, FSize - 1 - Index) + else + FElementData[Index] := nil; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfArrayList.First: IJclIntfIterator; +begin + Result := TJclIntfArrayIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclIntfArrayList.GetEnumerator: IJclIntfIterator; +begin + Result := TJclIntfArrayIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclIntfArrayList.GetObject(Index: Integer): IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if (Index >= 0) and (Index < FSize) then + Result := FElementData[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfArrayList.IndexOf(const AInterface: IInterface): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AInterface) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfArrayList.Insert(Index: Integer; const AInterface: IInterface): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AInterface, nil); + + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AInterface, FElementData[I]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FElementData, Index, Index + 1, FSize - Index); + FElementData[Index] := AInterface; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfArrayList.InsertAll(Index: Integer; const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfArrayList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntfArrayList.Last: IJclIntfIterator; +begin + Result := TJclIntfArrayIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclIntfArrayList.LastIndexOf(const AInterface: IInterface): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], AInterface) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfArrayList.RaiseOutOfBoundsError: IInterface; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclIntfArrayList.Remove(const AInterface: IInterface): Boolean; +var + Extracted: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AInterface); + if Result then + begin + Extracted := AInterface; + FreeObject(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfArrayList.RemoveAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfArrayList.RetainAll(const ACollection: IJclIntfCollection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FElementData[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfArrayList.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FElementData, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfArrayList.SetObject(Index: Integer; const AInterface: IInterface); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AInterface, nil); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AInterface) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreeObject(FElementData[Index]); + FElementData[Index] := AInterface; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfArrayList.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfArrayList.SubList(First, Count: Integer): IJclIntfList; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclIntfList; + for I := First to Last do + Result.Add(FElementData[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfArrayList.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfArrayList.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclIntfArrayIterator } =============================================================== + +constructor TJclIntfArrayIterator.Create(AOwnList: TJclIntfArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclIntfArrayIterator.Add(const AInterface: IInterface): Boolean; +begin + Result := FOwnList.Add(AInterface); +end; + +procedure TJclIntfArrayIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclIntfArrayIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclIntfArrayIterator then + begin + ADest := TJclIntfArrayIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclIntfArrayIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclIntfArrayIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclIntfArrayIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclIntfArrayIterator.GetObject: IInterface; +begin + CheckValid; + Result := FOwnList.GetObject(FCursor); +end; + +function TJclIntfArrayIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclIntfArrayIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclIntfArrayIterator.Insert(const AInterface: IInterface): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, AInterface); +end; + +function TJclIntfArrayIterator.IteratorEquals(const AIterator: IJclIntfIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclIntfArrayIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclIntfArrayIterator then + begin + ItrObj := TJclIntfArrayIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclIntfArrayIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclIntfArrayIterator.Next: IInterface; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetObject(FCursor); +end; + +function TJclIntfArrayIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclIntfArrayIterator.Previous: IInterface; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetObject(FCursor); +end; + +function TJclIntfArrayIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclIntfArrayIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclIntfArrayIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclIntfArrayIterator.SetObject(const AInterface: IInterface); +begin + CheckValid; + FOwnList.SetObject(FCursor, AInterface); +end; + +//=== { TJclAnsiStrArrayList } ====================================================== + +constructor TJclAnsiStrArrayList.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +constructor TJclAnsiStrArrayList.Create(const ACollection: IJclAnsiStrCollection); +begin + inherited Create(); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclAnsiStrArrayList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclAnsiStrArrayList.Add(const AString: AnsiString): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AString, ''); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(AString, FElementData[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElementData[FSize] := AString; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrArrayList.AddAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrArrayList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclAnsiStrArrayList; + ACollection: IJclAnsiStrCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclAnsiStrArrayList then + begin + ADest := TJclAnsiStrArrayList(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclAnsiStrCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclAnsiStrArrayList.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeString(FElementData[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrArrayList.CollectionEquals(const ACollection: IJclAnsiStrCollection): Boolean; +var + I: Integer; + It: IJclAnsiStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FElementData[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrArrayList.Contains(const AString: AnsiString): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AString) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrArrayList.ContainsAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrArrayList.Delete(Index: Integer): AnsiString; +var + Extracted: AnsiString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreeString(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrArrayList.Extract(const AString: AnsiString): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], AString) then + begin + if I < (FSize - 1) then + MoveArray(FElementData, I + 1, I, FSize - 1 - I) + else + FElementData[I] := ''; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrArrayList.ExtractAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrArrayList.ExtractIndex(Index: Integer): AnsiString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FElementData[Index]; + if Index < (FSize - 1) then + MoveArray(FElementData, Index + 1, Index, FSize - 1 - Index) + else + FElementData[Index] := ''; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrArrayList.First: IJclAnsiStrIterator; +begin + Result := TJclAnsiStrArrayIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclAnsiStrArrayList.GetEnumerator: IJclAnsiStrIterator; +begin + Result := TJclAnsiStrArrayIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclAnsiStrArrayList.GetString(Index: Integer): AnsiString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if (Index >= 0) and (Index < FSize) then + Result := FElementData[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrArrayList.IndexOf(const AString: AnsiString): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AString) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrArrayList.Insert(Index: Integer; const AString: AnsiString): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AString, ''); + + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AString, FElementData[I]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FElementData, Index, Index + 1, FSize - Index); + FElementData[Index] := AString; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrArrayList.InsertAll(Index: Integer; const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrArrayList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclAnsiStrArrayList.Last: IJclAnsiStrIterator; +begin + Result := TJclAnsiStrArrayIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclAnsiStrArrayList.LastIndexOf(const AString: AnsiString): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], AString) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrArrayList.RaiseOutOfBoundsError: AnsiString; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclAnsiStrArrayList.Remove(const AString: AnsiString): Boolean; +var + Extracted: AnsiString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AString); + if Result then + begin + Extracted := AString; + FreeString(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrArrayList.RemoveAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrArrayList.RetainAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FElementData[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrArrayList.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FElementData, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrArrayList.SetString(Index: Integer; const AString: AnsiString); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AString, ''); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AString) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreeString(FElementData[Index]); + FElementData[Index] := AString; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrArrayList.Size: Integer; +begin + Result := FSize; +end; + +function TJclAnsiStrArrayList.SubList(First, Count: Integer): IJclAnsiStrList; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclAnsiStrList; + for I := First to Last do + Result.Add(FElementData[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrArrayList.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclAnsiStrArrayList.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclAnsiStrArrayIterator } =============================================================== + +constructor TJclAnsiStrArrayIterator.Create(AOwnList: TJclAnsiStrArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclAnsiStrArrayIterator.Add(const AString: AnsiString): Boolean; +begin + Result := FOwnList.Add(AString); +end; + +procedure TJclAnsiStrArrayIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclAnsiStrArrayIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclAnsiStrArrayIterator then + begin + ADest := TJclAnsiStrArrayIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclAnsiStrArrayIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclAnsiStrArrayIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclAnsiStrArrayIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclAnsiStrArrayIterator.GetString: AnsiString; +begin + CheckValid; + Result := FOwnList.GetString(FCursor); +end; + +function TJclAnsiStrArrayIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclAnsiStrArrayIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclAnsiStrArrayIterator.Insert(const AString: AnsiString): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, AString); +end; + +function TJclAnsiStrArrayIterator.IteratorEquals(const AIterator: IJclAnsiStrIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclAnsiStrArrayIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclAnsiStrArrayIterator then + begin + ItrObj := TJclAnsiStrArrayIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclAnsiStrArrayIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclAnsiStrArrayIterator.Next: AnsiString; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetString(FCursor); +end; + +function TJclAnsiStrArrayIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclAnsiStrArrayIterator.Previous: AnsiString; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetString(FCursor); +end; + +function TJclAnsiStrArrayIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclAnsiStrArrayIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclAnsiStrArrayIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclAnsiStrArrayIterator.SetString(const AString: AnsiString); +begin + CheckValid; + FOwnList.SetString(FCursor, AString); +end; + +//=== { TJclWideStrArrayList } ====================================================== + +constructor TJclWideStrArrayList.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +constructor TJclWideStrArrayList.Create(const ACollection: IJclWideStrCollection); +begin + inherited Create(); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclWideStrArrayList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclWideStrArrayList.Add(const AString: WideString): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AString, ''); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(AString, FElementData[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElementData[FSize] := AString; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrArrayList.AddAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrArrayList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclWideStrArrayList; + ACollection: IJclWideStrCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclWideStrArrayList then + begin + ADest := TJclWideStrArrayList(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclWideStrCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclWideStrArrayList.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeString(FElementData[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrArrayList.CollectionEquals(const ACollection: IJclWideStrCollection): Boolean; +var + I: Integer; + It: IJclWideStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FElementData[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrArrayList.Contains(const AString: WideString): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AString) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrArrayList.ContainsAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrArrayList.Delete(Index: Integer): WideString; +var + Extracted: WideString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreeString(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrArrayList.Extract(const AString: WideString): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], AString) then + begin + if I < (FSize - 1) then + MoveArray(FElementData, I + 1, I, FSize - 1 - I) + else + FElementData[I] := ''; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrArrayList.ExtractAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrArrayList.ExtractIndex(Index: Integer): WideString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FElementData[Index]; + if Index < (FSize - 1) then + MoveArray(FElementData, Index + 1, Index, FSize - 1 - Index) + else + FElementData[Index] := ''; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrArrayList.First: IJclWideStrIterator; +begin + Result := TJclWideStrArrayIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclWideStrArrayList.GetEnumerator: IJclWideStrIterator; +begin + Result := TJclWideStrArrayIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclWideStrArrayList.GetString(Index: Integer): WideString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if (Index >= 0) and (Index < FSize) then + Result := FElementData[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrArrayList.IndexOf(const AString: WideString): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AString) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrArrayList.Insert(Index: Integer; const AString: WideString): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AString, ''); + + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AString, FElementData[I]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FElementData, Index, Index + 1, FSize - Index); + FElementData[Index] := AString; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrArrayList.InsertAll(Index: Integer; const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrArrayList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclWideStrArrayList.Last: IJclWideStrIterator; +begin + Result := TJclWideStrArrayIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclWideStrArrayList.LastIndexOf(const AString: WideString): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], AString) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrArrayList.RaiseOutOfBoundsError: WideString; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclWideStrArrayList.Remove(const AString: WideString): Boolean; +var + Extracted: WideString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AString); + if Result then + begin + Extracted := AString; + FreeString(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrArrayList.RemoveAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrArrayList.RetainAll(const ACollection: IJclWideStrCollection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FElementData[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrArrayList.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FElementData, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrArrayList.SetString(Index: Integer; const AString: WideString); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AString, ''); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AString) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreeString(FElementData[Index]); + FElementData[Index] := AString; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrArrayList.Size: Integer; +begin + Result := FSize; +end; + +function TJclWideStrArrayList.SubList(First, Count: Integer): IJclWideStrList; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclWideStrList; + for I := First to Last do + Result.Add(FElementData[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrArrayList.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclWideStrArrayList.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclWideStrArrayIterator } =============================================================== + +constructor TJclWideStrArrayIterator.Create(AOwnList: TJclWideStrArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclWideStrArrayIterator.Add(const AString: WideString): Boolean; +begin + Result := FOwnList.Add(AString); +end; + +procedure TJclWideStrArrayIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclWideStrArrayIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclWideStrArrayIterator then + begin + ADest := TJclWideStrArrayIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclWideStrArrayIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclWideStrArrayIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclWideStrArrayIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclWideStrArrayIterator.GetString: WideString; +begin + CheckValid; + Result := FOwnList.GetString(FCursor); +end; + +function TJclWideStrArrayIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclWideStrArrayIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclWideStrArrayIterator.Insert(const AString: WideString): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, AString); +end; + +function TJclWideStrArrayIterator.IteratorEquals(const AIterator: IJclWideStrIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclWideStrArrayIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclWideStrArrayIterator then + begin + ItrObj := TJclWideStrArrayIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclWideStrArrayIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclWideStrArrayIterator.Next: WideString; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetString(FCursor); +end; + +function TJclWideStrArrayIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclWideStrArrayIterator.Previous: WideString; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetString(FCursor); +end; + +function TJclWideStrArrayIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclWideStrArrayIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclWideStrArrayIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclWideStrArrayIterator.SetString(const AString: WideString); +begin + CheckValid; + FOwnList.SetString(FCursor, AString); +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrArrayList } ====================================================== + +constructor TJclUnicodeStrArrayList.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +constructor TJclUnicodeStrArrayList.Create(const ACollection: IJclUnicodeStrCollection); +begin + inherited Create(); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclUnicodeStrArrayList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclUnicodeStrArrayList.Add(const AString: UnicodeString): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AString, ''); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(AString, FElementData[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElementData[FSize] := AString; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrArrayList.AddAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrArrayList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclUnicodeStrArrayList; + ACollection: IJclUnicodeStrCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclUnicodeStrArrayList then + begin + ADest := TJclUnicodeStrArrayList(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclUnicodeStrCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclUnicodeStrArrayList.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeString(FElementData[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrArrayList.CollectionEquals(const ACollection: IJclUnicodeStrCollection): Boolean; +var + I: Integer; + It: IJclUnicodeStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FElementData[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrArrayList.Contains(const AString: UnicodeString): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AString) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrArrayList.ContainsAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrArrayList.Delete(Index: Integer): UnicodeString; +var + Extracted: UnicodeString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreeString(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrArrayList.Extract(const AString: UnicodeString): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], AString) then + begin + if I < (FSize - 1) then + MoveArray(FElementData, I + 1, I, FSize - 1 - I) + else + FElementData[I] := ''; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrArrayList.ExtractAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrArrayList.ExtractIndex(Index: Integer): UnicodeString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FElementData[Index]; + if Index < (FSize - 1) then + MoveArray(FElementData, Index + 1, Index, FSize - 1 - Index) + else + FElementData[Index] := ''; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrArrayList.First: IJclUnicodeStrIterator; +begin + Result := TJclUnicodeStrArrayIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclUnicodeStrArrayList.GetEnumerator: IJclUnicodeStrIterator; +begin + Result := TJclUnicodeStrArrayIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclUnicodeStrArrayList.GetString(Index: Integer): UnicodeString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if (Index >= 0) and (Index < FSize) then + Result := FElementData[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrArrayList.IndexOf(const AString: UnicodeString): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AString) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrArrayList.Insert(Index: Integer; const AString: UnicodeString): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AString, ''); + + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AString, FElementData[I]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FElementData, Index, Index + 1, FSize - Index); + FElementData[Index] := AString; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrArrayList.InsertAll(Index: Integer; const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrArrayList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclUnicodeStrArrayList.Last: IJclUnicodeStrIterator; +begin + Result := TJclUnicodeStrArrayIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclUnicodeStrArrayList.LastIndexOf(const AString: UnicodeString): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], AString) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrArrayList.RaiseOutOfBoundsError: UnicodeString; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclUnicodeStrArrayList.Remove(const AString: UnicodeString): Boolean; +var + Extracted: UnicodeString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AString); + if Result then + begin + Extracted := AString; + FreeString(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrArrayList.RemoveAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrArrayList.RetainAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FElementData[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrArrayList.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FElementData, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrArrayList.SetString(Index: Integer; const AString: UnicodeString); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AString, ''); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AString) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreeString(FElementData[Index]); + FElementData[Index] := AString; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrArrayList.Size: Integer; +begin + Result := FSize; +end; + +function TJclUnicodeStrArrayList.SubList(First, Count: Integer): IJclUnicodeStrList; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclUnicodeStrList; + for I := First to Last do + Result.Add(FElementData[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrArrayList.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclUnicodeStrArrayList.Create(FSize); + AssignPropertiesTo(Result); +end; + +{$ENDIF SUPPORTS_UNICODE_STRING} + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrArrayIterator } =============================================================== + +constructor TJclUnicodeStrArrayIterator.Create(AOwnList: TJclUnicodeStrArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclUnicodeStrArrayIterator.Add(const AString: UnicodeString): Boolean; +begin + Result := FOwnList.Add(AString); +end; + +procedure TJclUnicodeStrArrayIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclUnicodeStrArrayIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclUnicodeStrArrayIterator then + begin + ADest := TJclUnicodeStrArrayIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclUnicodeStrArrayIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclUnicodeStrArrayIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclUnicodeStrArrayIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclUnicodeStrArrayIterator.GetString: UnicodeString; +begin + CheckValid; + Result := FOwnList.GetString(FCursor); +end; + +function TJclUnicodeStrArrayIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclUnicodeStrArrayIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclUnicodeStrArrayIterator.Insert(const AString: UnicodeString): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, AString); +end; + +function TJclUnicodeStrArrayIterator.IteratorEquals(const AIterator: IJclUnicodeStrIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclUnicodeStrArrayIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclUnicodeStrArrayIterator then + begin + ItrObj := TJclUnicodeStrArrayIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclUnicodeStrArrayIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclUnicodeStrArrayIterator.Next: UnicodeString; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetString(FCursor); +end; + +function TJclUnicodeStrArrayIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclUnicodeStrArrayIterator.Previous: UnicodeString; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetString(FCursor); +end; + +function TJclUnicodeStrArrayIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclUnicodeStrArrayIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclUnicodeStrArrayIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclUnicodeStrArrayIterator.SetString(const AString: UnicodeString); +begin + CheckValid; + FOwnList.SetString(FCursor, AString); +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +//=== { TJclSingleArrayList } ====================================================== + +constructor TJclSingleArrayList.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +constructor TJclSingleArrayList.Create(const ACollection: IJclSingleCollection); +begin + inherited Create(); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclSingleArrayList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclSingleArrayList.Add(const AValue: Single): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(AValue, FElementData[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElementData[FSize] := AValue; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleArrayList.AddAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleArrayList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclSingleArrayList; + ACollection: IJclSingleCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclSingleArrayList then + begin + ADest := TJclSingleArrayList(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclSingleCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclSingleArrayList.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeSingle(FElementData[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleArrayList.CollectionEquals(const ACollection: IJclSingleCollection): Boolean; +var + I: Integer; + It: IJclSingleIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FElementData[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleArrayList.Contains(const AValue: Single): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AValue) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleArrayList.ContainsAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleArrayList.Delete(Index: Integer): Single; +var + Extracted: Single; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreeSingle(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleArrayList.Extract(const AValue: Single): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], AValue) then + begin + if I < (FSize - 1) then + MoveArray(FElementData, I + 1, I, FSize - 1 - I) + else + FElementData[I] := 0.0; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleArrayList.ExtractAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleArrayList.ExtractIndex(Index: Integer): Single; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FElementData[Index]; + if Index < (FSize - 1) then + MoveArray(FElementData, Index + 1, Index, FSize - 1 - Index) + else + FElementData[Index] := 0.0; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleArrayList.First: IJclSingleIterator; +begin + Result := TJclSingleArrayIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclSingleArrayList.GetEnumerator: IJclSingleIterator; +begin + Result := TJclSingleArrayIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclSingleArrayList.GetValue(Index: Integer): Single; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if (Index >= 0) and (Index < FSize) then + Result := FElementData[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleArrayList.IndexOf(const AValue: Single): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AValue) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleArrayList.Insert(Index: Integer; const AValue: Single): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AValue, FElementData[I]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FElementData, Index, Index + 1, FSize - Index); + FElementData[Index] := AValue; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleArrayList.InsertAll(Index: Integer; const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleArrayList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclSingleArrayList.Last: IJclSingleIterator; +begin + Result := TJclSingleArrayIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclSingleArrayList.LastIndexOf(const AValue: Single): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], AValue) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleArrayList.RaiseOutOfBoundsError: Single; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclSingleArrayList.Remove(const AValue: Single): Boolean; +var + Extracted: Single; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeSingle(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleArrayList.RemoveAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleArrayList.RetainAll(const ACollection: IJclSingleCollection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FElementData[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleArrayList.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FElementData, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleArrayList.SetValue(Index: Integer; const AValue: Single); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AValue) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreeSingle(FElementData[Index]); + FElementData[Index] := AValue; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleArrayList.Size: Integer; +begin + Result := FSize; +end; + +function TJclSingleArrayList.SubList(First, Count: Integer): IJclSingleList; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclSingleList; + for I := First to Last do + Result.Add(FElementData[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleArrayList.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclSingleArrayList.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclSingleArrayIterator } =============================================================== + +constructor TJclSingleArrayIterator.Create(AOwnList: TJclSingleArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclSingleArrayIterator.Add(const AValue: Single): Boolean; +begin + Result := FOwnList.Add(AValue); +end; + +procedure TJclSingleArrayIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclSingleArrayIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclSingleArrayIterator then + begin + ADest := TJclSingleArrayIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclSingleArrayIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclSingleArrayIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclSingleArrayIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclSingleArrayIterator.GetValue: Single; +begin + CheckValid; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclSingleArrayIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclSingleArrayIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclSingleArrayIterator.Insert(const AValue: Single): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, AValue); +end; + +function TJclSingleArrayIterator.IteratorEquals(const AIterator: IJclSingleIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclSingleArrayIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclSingleArrayIterator then + begin + ItrObj := TJclSingleArrayIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclSingleArrayIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclSingleArrayIterator.Next: Single; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclSingleArrayIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclSingleArrayIterator.Previous: Single; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclSingleArrayIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclSingleArrayIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclSingleArrayIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclSingleArrayIterator.SetValue(const AValue: Single); +begin + CheckValid; + FOwnList.SetValue(FCursor, AValue); +end; + +//=== { TJclDoubleArrayList } ====================================================== + +constructor TJclDoubleArrayList.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +constructor TJclDoubleArrayList.Create(const ACollection: IJclDoubleCollection); +begin + inherited Create(); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclDoubleArrayList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclDoubleArrayList.Add(const AValue: Double): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(AValue, FElementData[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElementData[FSize] := AValue; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleArrayList.AddAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleArrayList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclDoubleArrayList; + ACollection: IJclDoubleCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclDoubleArrayList then + begin + ADest := TJclDoubleArrayList(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclDoubleCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclDoubleArrayList.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeDouble(FElementData[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleArrayList.CollectionEquals(const ACollection: IJclDoubleCollection): Boolean; +var + I: Integer; + It: IJclDoubleIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FElementData[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleArrayList.Contains(const AValue: Double): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AValue) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleArrayList.ContainsAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleArrayList.Delete(Index: Integer): Double; +var + Extracted: Double; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreeDouble(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleArrayList.Extract(const AValue: Double): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], AValue) then + begin + if I < (FSize - 1) then + MoveArray(FElementData, I + 1, I, FSize - 1 - I) + else + FElementData[I] := 0.0; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleArrayList.ExtractAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleArrayList.ExtractIndex(Index: Integer): Double; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FElementData[Index]; + if Index < (FSize - 1) then + MoveArray(FElementData, Index + 1, Index, FSize - 1 - Index) + else + FElementData[Index] := 0.0; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleArrayList.First: IJclDoubleIterator; +begin + Result := TJclDoubleArrayIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclDoubleArrayList.GetEnumerator: IJclDoubleIterator; +begin + Result := TJclDoubleArrayIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclDoubleArrayList.GetValue(Index: Integer): Double; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if (Index >= 0) and (Index < FSize) then + Result := FElementData[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleArrayList.IndexOf(const AValue: Double): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AValue) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleArrayList.Insert(Index: Integer; const AValue: Double): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AValue, FElementData[I]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FElementData, Index, Index + 1, FSize - Index); + FElementData[Index] := AValue; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleArrayList.InsertAll(Index: Integer; const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleArrayList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclDoubleArrayList.Last: IJclDoubleIterator; +begin + Result := TJclDoubleArrayIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclDoubleArrayList.LastIndexOf(const AValue: Double): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], AValue) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleArrayList.RaiseOutOfBoundsError: Double; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclDoubleArrayList.Remove(const AValue: Double): Boolean; +var + Extracted: Double; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeDouble(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleArrayList.RemoveAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleArrayList.RetainAll(const ACollection: IJclDoubleCollection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FElementData[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleArrayList.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FElementData, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleArrayList.SetValue(Index: Integer; const AValue: Double); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AValue) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreeDouble(FElementData[Index]); + FElementData[Index] := AValue; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleArrayList.Size: Integer; +begin + Result := FSize; +end; + +function TJclDoubleArrayList.SubList(First, Count: Integer): IJclDoubleList; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclDoubleList; + for I := First to Last do + Result.Add(FElementData[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleArrayList.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclDoubleArrayList.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclDoubleArrayIterator } =============================================================== + +constructor TJclDoubleArrayIterator.Create(AOwnList: TJclDoubleArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclDoubleArrayIterator.Add(const AValue: Double): Boolean; +begin + Result := FOwnList.Add(AValue); +end; + +procedure TJclDoubleArrayIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclDoubleArrayIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclDoubleArrayIterator then + begin + ADest := TJclDoubleArrayIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclDoubleArrayIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclDoubleArrayIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclDoubleArrayIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclDoubleArrayIterator.GetValue: Double; +begin + CheckValid; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclDoubleArrayIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclDoubleArrayIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclDoubleArrayIterator.Insert(const AValue: Double): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, AValue); +end; + +function TJclDoubleArrayIterator.IteratorEquals(const AIterator: IJclDoubleIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclDoubleArrayIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclDoubleArrayIterator then + begin + ItrObj := TJclDoubleArrayIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclDoubleArrayIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclDoubleArrayIterator.Next: Double; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclDoubleArrayIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclDoubleArrayIterator.Previous: Double; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclDoubleArrayIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclDoubleArrayIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclDoubleArrayIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclDoubleArrayIterator.SetValue(const AValue: Double); +begin + CheckValid; + FOwnList.SetValue(FCursor, AValue); +end; + +//=== { TJclExtendedArrayList } ====================================================== + +constructor TJclExtendedArrayList.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +constructor TJclExtendedArrayList.Create(const ACollection: IJclExtendedCollection); +begin + inherited Create(); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclExtendedArrayList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclExtendedArrayList.Add(const AValue: Extended): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(AValue, FElementData[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElementData[FSize] := AValue; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedArrayList.AddAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedArrayList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclExtendedArrayList; + ACollection: IJclExtendedCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclExtendedArrayList then + begin + ADest := TJclExtendedArrayList(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclExtendedCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclExtendedArrayList.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeExtended(FElementData[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedArrayList.CollectionEquals(const ACollection: IJclExtendedCollection): Boolean; +var + I: Integer; + It: IJclExtendedIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FElementData[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedArrayList.Contains(const AValue: Extended): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AValue) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedArrayList.ContainsAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedArrayList.Delete(Index: Integer): Extended; +var + Extracted: Extended; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreeExtended(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedArrayList.Extract(const AValue: Extended): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], AValue) then + begin + if I < (FSize - 1) then + MoveArray(FElementData, I + 1, I, FSize - 1 - I) + else + FElementData[I] := 0.0; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedArrayList.ExtractAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedArrayList.ExtractIndex(Index: Integer): Extended; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FElementData[Index]; + if Index < (FSize - 1) then + MoveArray(FElementData, Index + 1, Index, FSize - 1 - Index) + else + FElementData[Index] := 0.0; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedArrayList.First: IJclExtendedIterator; +begin + Result := TJclExtendedArrayIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclExtendedArrayList.GetEnumerator: IJclExtendedIterator; +begin + Result := TJclExtendedArrayIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclExtendedArrayList.GetValue(Index: Integer): Extended; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if (Index >= 0) and (Index < FSize) then + Result := FElementData[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedArrayList.IndexOf(const AValue: Extended): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AValue) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedArrayList.Insert(Index: Integer; const AValue: Extended): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AValue, FElementData[I]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FElementData, Index, Index + 1, FSize - Index); + FElementData[Index] := AValue; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedArrayList.InsertAll(Index: Integer; const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedArrayList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclExtendedArrayList.Last: IJclExtendedIterator; +begin + Result := TJclExtendedArrayIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclExtendedArrayList.LastIndexOf(const AValue: Extended): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], AValue) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedArrayList.RaiseOutOfBoundsError: Extended; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclExtendedArrayList.Remove(const AValue: Extended): Boolean; +var + Extracted: Extended; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeExtended(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedArrayList.RemoveAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedArrayList.RetainAll(const ACollection: IJclExtendedCollection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FElementData[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedArrayList.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FElementData, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedArrayList.SetValue(Index: Integer; const AValue: Extended); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AValue) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreeExtended(FElementData[Index]); + FElementData[Index] := AValue; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedArrayList.Size: Integer; +begin + Result := FSize; +end; + +function TJclExtendedArrayList.SubList(First, Count: Integer): IJclExtendedList; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclExtendedList; + for I := First to Last do + Result.Add(FElementData[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedArrayList.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclExtendedArrayList.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclExtendedArrayIterator } =============================================================== + +constructor TJclExtendedArrayIterator.Create(AOwnList: TJclExtendedArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclExtendedArrayIterator.Add(const AValue: Extended): Boolean; +begin + Result := FOwnList.Add(AValue); +end; + +procedure TJclExtendedArrayIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclExtendedArrayIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclExtendedArrayIterator then + begin + ADest := TJclExtendedArrayIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclExtendedArrayIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclExtendedArrayIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclExtendedArrayIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclExtendedArrayIterator.GetValue: Extended; +begin + CheckValid; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclExtendedArrayIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclExtendedArrayIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclExtendedArrayIterator.Insert(const AValue: Extended): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, AValue); +end; + +function TJclExtendedArrayIterator.IteratorEquals(const AIterator: IJclExtendedIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclExtendedArrayIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclExtendedArrayIterator then + begin + ItrObj := TJclExtendedArrayIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclExtendedArrayIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclExtendedArrayIterator.Next: Extended; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclExtendedArrayIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclExtendedArrayIterator.Previous: Extended; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclExtendedArrayIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclExtendedArrayIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclExtendedArrayIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclExtendedArrayIterator.SetValue(const AValue: Extended); +begin + CheckValid; + FOwnList.SetValue(FCursor, AValue); +end; + +//=== { TJclIntegerArrayList } ====================================================== + +constructor TJclIntegerArrayList.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +constructor TJclIntegerArrayList.Create(const ACollection: IJclIntegerCollection); +begin + inherited Create(); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclIntegerArrayList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclIntegerArrayList.Add(AValue: Integer): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(AValue, FElementData[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElementData[FSize] := AValue; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerArrayList.AddAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerArrayList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclIntegerArrayList; + ACollection: IJclIntegerCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntegerArrayList then + begin + ADest := TJclIntegerArrayList(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclIntegerCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclIntegerArrayList.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeInteger(FElementData[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerArrayList.CollectionEquals(const ACollection: IJclIntegerCollection): Boolean; +var + I: Integer; + It: IJclIntegerIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FElementData[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerArrayList.Contains(AValue: Integer): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AValue) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerArrayList.ContainsAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerArrayList.Delete(Index: Integer): Integer; +var + Extracted: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreeInteger(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerArrayList.Extract(AValue: Integer): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], AValue) then + begin + if I < (FSize - 1) then + MoveArray(FElementData, I + 1, I, FSize - 1 - I) + else + FElementData[I] := 0; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerArrayList.ExtractAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerArrayList.ExtractIndex(Index: Integer): Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FElementData[Index]; + if Index < (FSize - 1) then + MoveArray(FElementData, Index + 1, Index, FSize - 1 - Index) + else + FElementData[Index] := 0; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerArrayList.First: IJclIntegerIterator; +begin + Result := TJclIntegerArrayIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclIntegerArrayList.GetEnumerator: IJclIntegerIterator; +begin + Result := TJclIntegerArrayIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclIntegerArrayList.GetValue(Index: Integer): Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if (Index >= 0) and (Index < FSize) then + Result := FElementData[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerArrayList.IndexOf(AValue: Integer): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AValue) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerArrayList.Insert(Index: Integer; AValue: Integer): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0); + + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AValue, FElementData[I]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FElementData, Index, Index + 1, FSize - Index); + FElementData[Index] := AValue; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerArrayList.InsertAll(Index: Integer; const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerArrayList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntegerArrayList.Last: IJclIntegerIterator; +begin + Result := TJclIntegerArrayIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclIntegerArrayList.LastIndexOf(AValue: Integer): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], AValue) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerArrayList.RaiseOutOfBoundsError: Integer; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclIntegerArrayList.Remove(AValue: Integer): Boolean; +var + Extracted: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeInteger(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerArrayList.RemoveAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerArrayList.RetainAll(const ACollection: IJclIntegerCollection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FElementData[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerArrayList.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FElementData, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerArrayList.SetValue(Index: Integer; AValue: Integer); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AValue) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreeInteger(FElementData[Index]); + FElementData[Index] := AValue; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerArrayList.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntegerArrayList.SubList(First, Count: Integer): IJclIntegerList; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclIntegerList; + for I := First to Last do + Result.Add(FElementData[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerArrayList.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntegerArrayList.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclIntegerArrayIterator } =============================================================== + +constructor TJclIntegerArrayIterator.Create(AOwnList: TJclIntegerArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclIntegerArrayIterator.Add(AValue: Integer): Boolean; +begin + Result := FOwnList.Add(AValue); +end; + +procedure TJclIntegerArrayIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclIntegerArrayIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclIntegerArrayIterator then + begin + ADest := TJclIntegerArrayIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclIntegerArrayIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclIntegerArrayIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclIntegerArrayIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclIntegerArrayIterator.GetValue: Integer; +begin + CheckValid; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclIntegerArrayIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclIntegerArrayIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclIntegerArrayIterator.Insert(AValue: Integer): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, AValue); +end; + +function TJclIntegerArrayIterator.IteratorEquals(const AIterator: IJclIntegerIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclIntegerArrayIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclIntegerArrayIterator then + begin + ItrObj := TJclIntegerArrayIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclIntegerArrayIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclIntegerArrayIterator.Next: Integer; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclIntegerArrayIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclIntegerArrayIterator.Previous: Integer; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclIntegerArrayIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclIntegerArrayIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclIntegerArrayIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclIntegerArrayIterator.SetValue(AValue: Integer); +begin + CheckValid; + FOwnList.SetValue(FCursor, AValue); +end; + +//=== { TJclCardinalArrayList } ====================================================== + +constructor TJclCardinalArrayList.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +constructor TJclCardinalArrayList.Create(const ACollection: IJclCardinalCollection); +begin + inherited Create(); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclCardinalArrayList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclCardinalArrayList.Add(AValue: Cardinal): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(AValue, FElementData[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElementData[FSize] := AValue; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalArrayList.AddAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalArrayList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclCardinalArrayList; + ACollection: IJclCardinalCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclCardinalArrayList then + begin + ADest := TJclCardinalArrayList(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclCardinalCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclCardinalArrayList.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeCardinal(FElementData[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalArrayList.CollectionEquals(const ACollection: IJclCardinalCollection): Boolean; +var + I: Integer; + It: IJclCardinalIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FElementData[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalArrayList.Contains(AValue: Cardinal): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AValue) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalArrayList.ContainsAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalArrayList.Delete(Index: Integer): Cardinal; +var + Extracted: Cardinal; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreeCardinal(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalArrayList.Extract(AValue: Cardinal): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], AValue) then + begin + if I < (FSize - 1) then + MoveArray(FElementData, I + 1, I, FSize - 1 - I) + else + FElementData[I] := 0; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalArrayList.ExtractAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalArrayList.ExtractIndex(Index: Integer): Cardinal; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FElementData[Index]; + if Index < (FSize - 1) then + MoveArray(FElementData, Index + 1, Index, FSize - 1 - Index) + else + FElementData[Index] := 0; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalArrayList.First: IJclCardinalIterator; +begin + Result := TJclCardinalArrayIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclCardinalArrayList.GetEnumerator: IJclCardinalIterator; +begin + Result := TJclCardinalArrayIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclCardinalArrayList.GetValue(Index: Integer): Cardinal; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if (Index >= 0) and (Index < FSize) then + Result := FElementData[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalArrayList.IndexOf(AValue: Cardinal): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AValue) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalArrayList.Insert(Index: Integer; AValue: Cardinal): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0); + + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AValue, FElementData[I]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FElementData, Index, Index + 1, FSize - Index); + FElementData[Index] := AValue; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalArrayList.InsertAll(Index: Integer; const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalArrayList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclCardinalArrayList.Last: IJclCardinalIterator; +begin + Result := TJclCardinalArrayIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclCardinalArrayList.LastIndexOf(AValue: Cardinal): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], AValue) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalArrayList.RaiseOutOfBoundsError: Cardinal; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclCardinalArrayList.Remove(AValue: Cardinal): Boolean; +var + Extracted: Cardinal; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeCardinal(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalArrayList.RemoveAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalArrayList.RetainAll(const ACollection: IJclCardinalCollection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FElementData[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalArrayList.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FElementData, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalArrayList.SetValue(Index: Integer; AValue: Cardinal); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AValue) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreeCardinal(FElementData[Index]); + FElementData[Index] := AValue; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalArrayList.Size: Integer; +begin + Result := FSize; +end; + +function TJclCardinalArrayList.SubList(First, Count: Integer): IJclCardinalList; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclCardinalList; + for I := First to Last do + Result.Add(FElementData[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalArrayList.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclCardinalArrayList.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclCardinalArrayIterator } =============================================================== + +constructor TJclCardinalArrayIterator.Create(AOwnList: TJclCardinalArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclCardinalArrayIterator.Add(AValue: Cardinal): Boolean; +begin + Result := FOwnList.Add(AValue); +end; + +procedure TJclCardinalArrayIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclCardinalArrayIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclCardinalArrayIterator then + begin + ADest := TJclCardinalArrayIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclCardinalArrayIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclCardinalArrayIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclCardinalArrayIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclCardinalArrayIterator.GetValue: Cardinal; +begin + CheckValid; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclCardinalArrayIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclCardinalArrayIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclCardinalArrayIterator.Insert(AValue: Cardinal): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, AValue); +end; + +function TJclCardinalArrayIterator.IteratorEquals(const AIterator: IJclCardinalIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclCardinalArrayIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclCardinalArrayIterator then + begin + ItrObj := TJclCardinalArrayIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclCardinalArrayIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclCardinalArrayIterator.Next: Cardinal; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclCardinalArrayIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclCardinalArrayIterator.Previous: Cardinal; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclCardinalArrayIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclCardinalArrayIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclCardinalArrayIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclCardinalArrayIterator.SetValue(AValue: Cardinal); +begin + CheckValid; + FOwnList.SetValue(FCursor, AValue); +end; + +//=== { TJclInt64ArrayList } ====================================================== + +constructor TJclInt64ArrayList.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +constructor TJclInt64ArrayList.Create(const ACollection: IJclInt64Collection); +begin + inherited Create(); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclInt64ArrayList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclInt64ArrayList.Add(const AValue: Int64): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(AValue, FElementData[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElementData[FSize] := AValue; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64ArrayList.AddAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64ArrayList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclInt64ArrayList; + ACollection: IJclInt64Collection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclInt64ArrayList then + begin + ADest := TJclInt64ArrayList(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclInt64Collection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclInt64ArrayList.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeInt64(FElementData[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64ArrayList.CollectionEquals(const ACollection: IJclInt64Collection): Boolean; +var + I: Integer; + It: IJclInt64Iterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FElementData[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64ArrayList.Contains(const AValue: Int64): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AValue) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64ArrayList.ContainsAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64ArrayList.Delete(Index: Integer): Int64; +var + Extracted: Int64; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreeInt64(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64ArrayList.Extract(const AValue: Int64): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], AValue) then + begin + if I < (FSize - 1) then + MoveArray(FElementData, I + 1, I, FSize - 1 - I) + else + FElementData[I] := 0; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64ArrayList.ExtractAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64ArrayList.ExtractIndex(Index: Integer): Int64; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FElementData[Index]; + if Index < (FSize - 1) then + MoveArray(FElementData, Index + 1, Index, FSize - 1 - Index) + else + FElementData[Index] := 0; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64ArrayList.First: IJclInt64Iterator; +begin + Result := TJclInt64ArrayIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclInt64ArrayList.GetEnumerator: IJclInt64Iterator; +begin + Result := TJclInt64ArrayIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclInt64ArrayList.GetValue(Index: Integer): Int64; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if (Index >= 0) and (Index < FSize) then + Result := FElementData[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64ArrayList.IndexOf(const AValue: Int64): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AValue) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64ArrayList.Insert(Index: Integer; const AValue: Int64): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0); + + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AValue, FElementData[I]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FElementData, Index, Index + 1, FSize - Index); + FElementData[Index] := AValue; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64ArrayList.InsertAll(Index: Integer; const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64ArrayList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclInt64ArrayList.Last: IJclInt64Iterator; +begin + Result := TJclInt64ArrayIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclInt64ArrayList.LastIndexOf(const AValue: Int64): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], AValue) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64ArrayList.RaiseOutOfBoundsError: Int64; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclInt64ArrayList.Remove(const AValue: Int64): Boolean; +var + Extracted: Int64; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeInt64(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64ArrayList.RemoveAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64ArrayList.RetainAll(const ACollection: IJclInt64Collection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FElementData[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64ArrayList.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FElementData, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64ArrayList.SetValue(Index: Integer; const AValue: Int64); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AValue) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreeInt64(FElementData[Index]); + FElementData[Index] := AValue; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64ArrayList.Size: Integer; +begin + Result := FSize; +end; + +function TJclInt64ArrayList.SubList(First, Count: Integer): IJclInt64List; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclInt64List; + for I := First to Last do + Result.Add(FElementData[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64ArrayList.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclInt64ArrayList.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclInt64ArrayIterator } =============================================================== + +constructor TJclInt64ArrayIterator.Create(AOwnList: TJclInt64ArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclInt64ArrayIterator.Add(const AValue: Int64): Boolean; +begin + Result := FOwnList.Add(AValue); +end; + +procedure TJclInt64ArrayIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclInt64ArrayIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclInt64ArrayIterator then + begin + ADest := TJclInt64ArrayIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclInt64ArrayIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclInt64ArrayIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclInt64ArrayIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclInt64ArrayIterator.GetValue: Int64; +begin + CheckValid; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclInt64ArrayIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclInt64ArrayIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclInt64ArrayIterator.Insert(const AValue: Int64): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, AValue); +end; + +function TJclInt64ArrayIterator.IteratorEquals(const AIterator: IJclInt64Iterator): Boolean; +var + Obj: TObject; + ItrObj: TJclInt64ArrayIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclInt64ArrayIterator then + begin + ItrObj := TJclInt64ArrayIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclInt64ArrayIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclInt64ArrayIterator.Next: Int64; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclInt64ArrayIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclInt64ArrayIterator.Previous: Int64; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclInt64ArrayIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclInt64ArrayIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclInt64ArrayIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclInt64ArrayIterator.SetValue(const AValue: Int64); +begin + CheckValid; + FOwnList.SetValue(FCursor, AValue); +end; + +//=== { TJclPtrArrayList } ====================================================== + +constructor TJclPtrArrayList.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +constructor TJclPtrArrayList.Create(const ACollection: IJclPtrCollection); +begin + inherited Create(); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclPtrArrayList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclPtrArrayList.Add(APtr: Pointer): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(APtr, nil); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(APtr, FElementData[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElementData[FSize] := APtr; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrArrayList.AddAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrArrayList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclPtrArrayList; + ACollection: IJclPtrCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclPtrArrayList then + begin + ADest := TJclPtrArrayList(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclPtrCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclPtrArrayList.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreePointer(FElementData[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrArrayList.CollectionEquals(const ACollection: IJclPtrCollection): Boolean; +var + I: Integer; + It: IJclPtrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FElementData[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrArrayList.Contains(APtr: Pointer): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], APtr) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrArrayList.ContainsAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrArrayList.Delete(Index: Integer): Pointer; +var + Extracted: Pointer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreePointer(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrArrayList.Extract(APtr: Pointer): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], APtr) then + begin + if I < (FSize - 1) then + MoveArray(FElementData, I + 1, I, FSize - 1 - I) + else + FElementData[I] := nil; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrArrayList.ExtractAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrArrayList.ExtractIndex(Index: Integer): Pointer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FElementData[Index]; + if Index < (FSize - 1) then + MoveArray(FElementData, Index + 1, Index, FSize - 1 - Index) + else + FElementData[Index] := nil; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrArrayList.First: IJclPtrIterator; +begin + Result := TJclPtrArrayIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclPtrArrayList.GetEnumerator: IJclPtrIterator; +begin + Result := TJclPtrArrayIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclPtrArrayList.GetPointer(Index: Integer): Pointer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if (Index >= 0) and (Index < FSize) then + Result := FElementData[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrArrayList.IndexOf(APtr: Pointer): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], APtr) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrArrayList.Insert(Index: Integer; APtr: Pointer): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(APtr, nil); + + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(APtr, FElementData[I]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FElementData, Index, Index + 1, FSize - Index); + FElementData[Index] := APtr; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrArrayList.InsertAll(Index: Integer; const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrArrayList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclPtrArrayList.Last: IJclPtrIterator; +begin + Result := TJclPtrArrayIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclPtrArrayList.LastIndexOf(APtr: Pointer): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], APtr) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrArrayList.RaiseOutOfBoundsError: Pointer; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclPtrArrayList.Remove(APtr: Pointer): Boolean; +var + Extracted: Pointer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(APtr); + if Result then + begin + Extracted := APtr; + FreePointer(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrArrayList.RemoveAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrArrayList.RetainAll(const ACollection: IJclPtrCollection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FElementData[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrArrayList.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FElementData, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrArrayList.SetPointer(Index: Integer; APtr: Pointer); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(APtr, nil); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], APtr) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreePointer(FElementData[Index]); + FElementData[Index] := APtr; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrArrayList.Size: Integer; +begin + Result := FSize; +end; + +function TJclPtrArrayList.SubList(First, Count: Integer): IJclPtrList; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclPtrList; + for I := First to Last do + Result.Add(FElementData[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrArrayList.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclPtrArrayList.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclPtrArrayIterator } =============================================================== + +constructor TJclPtrArrayIterator.Create(AOwnList: TJclPtrArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclPtrArrayIterator.Add(APtr: Pointer): Boolean; +begin + Result := FOwnList.Add(APtr); +end; + +procedure TJclPtrArrayIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclPtrArrayIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclPtrArrayIterator then + begin + ADest := TJclPtrArrayIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclPtrArrayIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPtrArrayIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclPtrArrayIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclPtrArrayIterator.GetPointer: Pointer; +begin + CheckValid; + Result := FOwnList.GetPointer(FCursor); +end; + +function TJclPtrArrayIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclPtrArrayIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclPtrArrayIterator.Insert(APtr: Pointer): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, APtr); +end; + +function TJclPtrArrayIterator.IteratorEquals(const AIterator: IJclPtrIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclPtrArrayIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclPtrArrayIterator then + begin + ItrObj := TJclPtrArrayIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclPtrArrayIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclPtrArrayIterator.Next: Pointer; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetPointer(FCursor); +end; + +function TJclPtrArrayIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclPtrArrayIterator.Previous: Pointer; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetPointer(FCursor); +end; + +function TJclPtrArrayIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclPtrArrayIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclPtrArrayIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclPtrArrayIterator.SetPointer(APtr: Pointer); +begin + CheckValid; + FOwnList.SetPointer(FCursor, APtr); +end; + +//=== { TJclArrayList } ====================================================== + +constructor TJclArrayList.Create(ACapacity: Integer; AOwnsObjects: Boolean); +begin + inherited Create(AOwnsObjects); + SetCapacity(ACapacity); +end; + +constructor TJclArrayList.Create(const ACollection: IJclCollection; AOwnsObjects: Boolean); +begin + inherited Create(AOwnsObjects); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclArrayList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclArrayList.Add(AObject: TObject): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AObject, nil); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(AObject, FElementData[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElementData[FSize] := AObject; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.AddAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclArrayList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclArrayList; + ACollection: IJclCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclArrayList then + begin + ADest := TJclArrayList(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclArrayList.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeObject(FElementData[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.CollectionEquals(const ACollection: IJclCollection): Boolean; +var + I: Integer; + It: IJclIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FElementData[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.Contains(AObject: TObject): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AObject) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.ContainsAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.Delete(Index: Integer): TObject; +var + Extracted: TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreeObject(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.Extract(AObject: TObject): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], AObject) then + begin + if I < (FSize - 1) then + MoveArray(FElementData, I + 1, I, FSize - 1 - I) + else + FElementData[I] := nil; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.ExtractAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.ExtractIndex(Index: Integer): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FElementData[Index]; + if Index < (FSize - 1) then + MoveArray(FElementData, Index + 1, Index, FSize - 1 - Index) + else + FElementData[Index] := nil; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.First: IJclIterator; +begin + Result := TJclArrayIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclArrayList.GetEnumerator: IJclIterator; +begin + Result := TJclArrayIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclArrayList.GetObject(Index: Integer): TObject; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if (Index >= 0) and (Index < FSize) then + Result := FElementData[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.IndexOf(AObject: TObject): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AObject) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.Insert(Index: Integer; AObject: TObject): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AObject, nil); + + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AObject, FElementData[I]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FElementData, Index, Index + 1, FSize - Index); + FElementData[Index] := AObject; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.InsertAll(Index: Integer; const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclArrayList.Last: IJclIterator; +begin + Result := TJclArrayIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclArrayList.LastIndexOf(AObject: TObject): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], AObject) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.RaiseOutOfBoundsError: TObject; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclArrayList.Remove(AObject: TObject): Boolean; +var + Extracted: TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AObject); + if Result then + begin + Extracted := AObject; + FreeObject(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.RemoveAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.RetainAll(const ACollection: IJclCollection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FElementData[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclArrayList.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FElementData, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclArrayList.SetObject(Index: Integer; AObject: TObject); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AObject, nil); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AObject) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreeObject(FElementData[Index]); + FElementData[Index] := AObject; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.Size: Integer; +begin + Result := FSize; +end; + +function TJclArrayList.SubList(First, Count: Integer): IJclList; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclList; + for I := First to Last do + Result.Add(FElementData[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclArrayList.Create(FSize, False); + AssignPropertiesTo(Result); +end; + +//=== { TJclArrayIterator } =============================================================== + +constructor TJclArrayIterator.Create(AOwnList: TJclArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclArrayIterator.Add(AObject: TObject): Boolean; +begin + Result := FOwnList.Add(AObject); +end; + +procedure TJclArrayIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclArrayIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclArrayIterator then + begin + ADest := TJclArrayIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclArrayIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclArrayIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclArrayIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclArrayIterator.GetObject: TObject; +begin + CheckValid; + Result := FOwnList.GetObject(FCursor); +end; + +function TJclArrayIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclArrayIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclArrayIterator.Insert(AObject: TObject): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, AObject); +end; + +function TJclArrayIterator.IteratorEquals(const AIterator: IJclIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclArrayIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclArrayIterator then + begin + ItrObj := TJclArrayIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclArrayIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclArrayIterator.Next: TObject; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetObject(FCursor); +end; + +function TJclArrayIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclArrayIterator.Previous: TObject; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetObject(FCursor); +end; + +function TJclArrayIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclArrayIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclArrayIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclArrayIterator.SetObject(AObject: TObject); +begin + CheckValid; + FOwnList.SetObject(FCursor, AObject); +end; + + +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +//=== { TJclArrayList } ====================================================== + +constructor TJclArrayList.Create(ACapacity: Integer; AOwnsItems: Boolean); +begin + inherited Create(AOwnsItems); + SetCapacity(ACapacity); +end; + +constructor TJclArrayList.Create(const ACollection: IJclCollection; AOwnsItems: Boolean); +begin + inherited Create(AOwnsItems); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclArrayList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclArrayList.Add(const AItem: T): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AItem, Default(T)); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(AItem, FElementData[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElementData[FSize] := AItem; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.AddAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclArrayList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclArrayList; + ACollection: IJclCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclArrayList then + begin + ADest := TJclArrayList(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclArrayList.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeItem(FElementData[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.CollectionEquals(const ACollection: IJclCollection): Boolean; +var + I: Integer; + It: IJclIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FElementData[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.Contains(const AItem: T): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AItem) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.ContainsAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.Delete(Index: Integer): T; +var + Extracted: T; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreeItem(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.Extract(const AItem: T): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], AItem) then + begin + if I < (FSize - 1) then + MoveArray(FElementData, I + 1, I, FSize - 1 - I) + else + FElementData[I] := Default(T); + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.ExtractAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.ExtractIndex(Index: Integer): T; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FElementData[Index]; + if Index < (FSize - 1) then + MoveArray(FElementData, Index + 1, Index, FSize - 1 - Index) + else + FElementData[Index] := Default(T); + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.First: IJclIterator; +begin + Result := TArrayIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclArrayList.GetEnumerator: IJclIterator; +begin + Result := TArrayIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclArrayList.GetItem(Index: Integer): T; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := Default(T); + if (Index >= 0) and (Index < FSize) then + Result := FElementData[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.IndexOf(const AItem: T): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AItem) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.Insert(Index: Integer; const AItem: T): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AItem, Default(T)); + + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AItem, FElementData[I]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FElementData, Index, Index + 1, FSize - Index); + FElementData[Index] := AItem; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.InsertAll(Index: Integer; const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclArrayList.Last: IJclIterator; +begin + Result := TArrayIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclArrayList.LastIndexOf(const AItem: T): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], AItem) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.RaiseOutOfBoundsError: T; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclArrayList.Remove(const AItem: T): Boolean; +var + Extracted: T; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AItem); + if Result then + begin + Extracted := AItem; + FreeItem(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.RemoveAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.RetainAll(const ACollection: IJclCollection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FElementData[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclArrayList.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FElementData, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclArrayList.SetItem(Index: Integer; const AItem: T); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AItem, Default(T)); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], AItem) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreeItem(FElementData[Index]); + FElementData[Index] := AItem; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArrayList.Size: Integer; +begin + Result := FSize; +end; + +function TJclArrayList.SubList(First, Count: Integer): IJclList; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclList; + for I := First to Last do + Result.Add(FElementData[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclArrayList.MoveArray(var List: TDynArray; FromIndex, ToIndex, Count: SizeInt); +var + I: SizeInt; +begin + if FromIndex < ToIndex then + begin + for I := Count - 1 downto 0 do + List[ToIndex + I] := List[FromIndex + I]; + + if (ToIndex - FromIndex) < Count then + // overlapped source and target + for I := 0 to ToIndex - FromIndex - 1 do + List[FromIndex + I] := Default(T) + else + // independent + for I := 0 to Count - 1 do + List[FromIndex + I] := Default(T); + end + else + begin + for I := 0 to Count - 1 do + List[ToIndex + I] := List[FromIndex + I]; + + if (FromIndex - ToIndex) < Count then + // overlapped source and target + for I := Count - FromIndex + ToIndex to Count - 1 do + List[FromIndex + I] := Default(T) + else + // independent + for I := 0 to Count - 1 do + List[FromIndex + I] := Default(T); + end; +end; + +//=== { TJclArrayIterator } =============================================================== + +constructor TJclArrayIterator.Create(AOwnList: TJclArrayList; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclArrayIterator.Add(const AItem: T): Boolean; +begin + Result := FOwnList.Add(AItem); +end; + +procedure TJclArrayIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclArrayIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclArrayIterator then + begin + ADest := TJclArrayIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclArrayIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclArrayIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclArrayIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclArrayIterator.GetItem: T; +begin + CheckValid; + Result := FOwnList.GetItem(FCursor); +end; + +function TJclArrayIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclArrayIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclArrayIterator.Insert(const AItem: T): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, AItem); +end; + +function TJclArrayIterator.IteratorEquals(const AIterator: IJclIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclArrayIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclArrayIterator then + begin + ItrObj := TJclArrayIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclArrayIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclArrayIterator.Next: T; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetItem(FCursor); +end; + +function TJclArrayIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclArrayIterator.Previous: T; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetItem(FCursor); +end; + +function TJclArrayIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclArrayIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclArrayIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclArrayIterator.SetItem(const AItem: T); +begin + CheckValid; + FOwnList.SetItem(FCursor, AItem); +end; + +//=== { TJclArrayListE } ================================================== + +constructor TJclArrayListE.Create(const AEqualityComparer: IJclEqualityComparer; ACapacity: Integer; + AOwnsItems: Boolean); +begin + inherited Create(ACapacity, AOwnsItems); + FEqualityComparer := AEqualityComparer; +end; + +constructor TJclArrayListE.Create(const AEqualityComparer: IJclEqualityComparer; + const ACollection: IJclCollection; AOwnsItems: Boolean); +begin + inherited Create(ACollection, AOwnsItems); + FEqualityComparer := AEqualityComparer; +end; + +procedure TJclArrayListE.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclArrayListE then + TJclArrayListE(Dest).FEqualityComparer := FEqualityComparer; +end; + +function TJclArrayListE.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclArrayListE.Create(EqualityComparer, FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclArrayListE.ItemsEqual(const A, B: T): Boolean; +begin + if EqualityComparer <> nil then + Result := EqualityComparer.ItemsEqual(A, B) + else + Result := inherited ItemsEqual(A, B); +end; + +//=== { TJclArrayListF } ================================================== + +constructor TJclArrayListF.Create(const AEqualityCompare: TEqualityCompare; + ACapacity: Integer; AOwnsItems: Boolean); +begin + inherited Create(ACapacity, AOwnsItems); + SetEqualityCompare(AEqualityCompare); +end; + +constructor TJclArrayListF.Create(const AEqualityCompare: TEqualityCompare; const ACollection: IJclCollection; + AOwnsItems: Boolean); +begin + inherited Create(ACollection, AOwnsItems); + SetEqualityCompare(AEqualityCompare); +end; + +function TJclArrayListF.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclArrayListF.Create(EqualityCompare, FSize, False); + AssignPropertiesTo(Result); +end; + +//=== { TJclArrayListI } ================================================== + +function TJclArrayListI.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclArrayListI.Create(FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclArrayListI.ItemsEqual(const A, B: T): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + Result := A.Equals(B); +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclArraySets.pas b/3rdParty/JCL/source/common/JclArraySets.pas new file mode 100644 index 00000000..fb9584cc --- /dev/null +++ b/3rdParty/JCL/source/common/JclArraySets.pas @@ -0,0 +1,2388 @@ +{**************************************************************************************************} +{ WARNING: JEDI preprocessor generated unit. Do not edit. } +{**************************************************************************************************} + +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is ArraySet.pas. } +{ } +{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } +{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } +{ All rights reserved. } +{ } +{ Contributors: } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclArraySets; + +{$I jcl.inc} + +interface + +uses + {$IFDEF HAS_UNITSCOPE} + System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Classes, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF SUPPORTS_GENERICS} + JclAlgorithms, + {$ENDIF SUPPORTS_GENERICS} + JclBase, JclAbstractContainers, JclContainerIntf, JclArrayLists, JclSynch; + +type + TJclIntfArraySet = class(TJclIntfArrayList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclIntfContainer, IJclIntfFlatContainer, IJclIntfEqualityComparer, IJclIntfComparer, + IJclIntfCollection, IJclIntfList, IJclIntfArray, IJclIntfSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + function BinarySearch(const AInterface: IInterface): Integer; + public + { IJclIntfCollection } + function Add(const AInterface: IInterface): Boolean; + function AddAll(const ACollection: IJclIntfCollection): Boolean; + function Contains(const AInterface: IInterface): Boolean; + { IJclIntfList } + function Insert(Index: Integer; const AInterface: IInterface): Boolean; + { IJclIntfSet } + procedure Intersect(const ACollection: IJclIntfCollection); + procedure Subtract(const ACollection: IJclIntfCollection); + procedure Union(const ACollection: IJclIntfCollection); + end; + + TJclAnsiStrArraySet = class(TJclAnsiStrArrayList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclAnsiStrContainer, IJclAnsiStrFlatContainer, IJclAnsiStrEqualityComparer, IJclAnsiStrComparer, IJclStrBaseContainer, + IJclAnsiStrCollection, IJclAnsiStrList, IJclAnsiStrArray, IJclAnsiStrSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + function BinarySearch(const AString: AnsiString): Integer; + public + { IJclAnsiStrCollection } + function Add(const AString: AnsiString): Boolean; override; + function AddAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + function Contains(const AString: AnsiString): Boolean; override; + { IJclAnsiStrList } + function Insert(Index: Integer; const AString: AnsiString): Boolean; + { IJclAnsiStrSet } + procedure Intersect(const ACollection: IJclAnsiStrCollection); + procedure Subtract(const ACollection: IJclAnsiStrCollection); + procedure Union(const ACollection: IJclAnsiStrCollection); + end; + + TJclWideStrArraySet = class(TJclWideStrArrayList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclWideStrContainer, IJclWideStrFlatContainer, IJclWideStrEqualityComparer, IJclWideStrComparer, IJclStrBaseContainer, + IJclWideStrCollection, IJclWideStrList, IJclWideStrArray, IJclWideStrSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + function BinarySearch(const AString: WideString): Integer; + public + { IJclWideStrCollection } + function Add(const AString: WideString): Boolean; override; + function AddAll(const ACollection: IJclWideStrCollection): Boolean; override; + function Contains(const AString: WideString): Boolean; override; + { IJclWideStrList } + function Insert(Index: Integer; const AString: WideString): Boolean; + { IJclWideStrSet } + procedure Intersect(const ACollection: IJclWideStrCollection); + procedure Subtract(const ACollection: IJclWideStrCollection); + procedure Union(const ACollection: IJclWideStrCollection); + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclUnicodeStrArraySet = class(TJclUnicodeStrArrayList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclUnicodeStrContainer, IJclUnicodeStrFlatContainer, IJclUnicodeStrEqualityComparer, IJclUnicodeStrComparer, IJclStrBaseContainer, + IJclUnicodeStrCollection, IJclUnicodeStrList, IJclUnicodeStrArray, IJclUnicodeStrSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + function BinarySearch(const AString: UnicodeString): Integer; + public + { IJclUnicodeStrCollection } + function Add(const AString: UnicodeString): Boolean; override; + function AddAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function Contains(const AString: UnicodeString): Boolean; override; + { IJclUnicodeStrList } + function Insert(Index: Integer; const AString: UnicodeString): Boolean; + { IJclUnicodeStrSet } + procedure Intersect(const ACollection: IJclUnicodeStrCollection); + procedure Subtract(const ACollection: IJclUnicodeStrCollection); + procedure Union(const ACollection: IJclUnicodeStrCollection); + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + TJclStrArraySet = TJclAnsiStrArraySet; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TJclStrArraySet = TJclWideStrArraySet; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TJclStrArraySet = TJclUnicodeStrArraySet; + {$ENDIF CONTAINER_UNICODESTR} + + TJclSingleArraySet = class(TJclSingleArrayList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclSingleContainer, IJclSingleFlatContainer, IJclSingleEqualityComparer, IJclSingleComparer, + IJclSingleCollection, IJclSingleList, IJclSingleArray, IJclSingleSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + function BinarySearch(const AValue: Single): Integer; + public + { IJclSingleCollection } + function Add(const AValue: Single): Boolean; + function AddAll(const ACollection: IJclSingleCollection): Boolean; + function Contains(const AValue: Single): Boolean; + { IJclSingleList } + function Insert(Index: Integer; const AValue: Single): Boolean; + { IJclSingleSet } + procedure Intersect(const ACollection: IJclSingleCollection); + procedure Subtract(const ACollection: IJclSingleCollection); + procedure Union(const ACollection: IJclSingleCollection); + end; + + TJclDoubleArraySet = class(TJclDoubleArrayList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclDoubleContainer, IJclDoubleFlatContainer, IJclDoubleEqualityComparer, IJclDoubleComparer, + IJclDoubleCollection, IJclDoubleList, IJclDoubleArray, IJclDoubleSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + function BinarySearch(const AValue: Double): Integer; + public + { IJclDoubleCollection } + function Add(const AValue: Double): Boolean; + function AddAll(const ACollection: IJclDoubleCollection): Boolean; + function Contains(const AValue: Double): Boolean; + { IJclDoubleList } + function Insert(Index: Integer; const AValue: Double): Boolean; + { IJclDoubleSet } + procedure Intersect(const ACollection: IJclDoubleCollection); + procedure Subtract(const ACollection: IJclDoubleCollection); + procedure Union(const ACollection: IJclDoubleCollection); + end; + + TJclExtendedArraySet = class(TJclExtendedArrayList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclExtendedContainer, IJclExtendedFlatContainer, IJclExtendedEqualityComparer, IJclExtendedComparer, + IJclExtendedCollection, IJclExtendedList, IJclExtendedArray, IJclExtendedSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + function BinarySearch(const AValue: Extended): Integer; + public + { IJclExtendedCollection } + function Add(const AValue: Extended): Boolean; + function AddAll(const ACollection: IJclExtendedCollection): Boolean; + function Contains(const AValue: Extended): Boolean; + { IJclExtendedList } + function Insert(Index: Integer; const AValue: Extended): Boolean; + { IJclExtendedSet } + procedure Intersect(const ACollection: IJclExtendedCollection); + procedure Subtract(const ACollection: IJclExtendedCollection); + procedure Union(const ACollection: IJclExtendedCollection); + end; + + {$IFDEF MATH_SINGLE_PRECISION} + TJclFloatArraySet = TJclSingleArraySet; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TJclFloatArraySet = TJclDoubleArraySet; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TJclFloatArraySet = TJclExtendedArraySet; + {$ENDIF MATH_EXTENDED_PRECISION} + + TJclIntegerArraySet = class(TJclIntegerArrayList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclIntegerContainer, IJclIntegerFlatContainer, IJclIntegerEqualityComparer, IJclIntegerComparer, + IJclIntegerCollection, IJclIntegerList, IJclIntegerArray, IJclIntegerSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + function BinarySearch(AValue: Integer): Integer; + public + { IJclIntegerCollection } + function Add(AValue: Integer): Boolean; + function AddAll(const ACollection: IJclIntegerCollection): Boolean; + function Contains(AValue: Integer): Boolean; + { IJclIntegerList } + function Insert(Index: Integer; AValue: Integer): Boolean; + { IJclIntegerSet } + procedure Intersect(const ACollection: IJclIntegerCollection); + procedure Subtract(const ACollection: IJclIntegerCollection); + procedure Union(const ACollection: IJclIntegerCollection); + end; + + TJclCardinalArraySet = class(TJclCardinalArrayList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclCardinalContainer, IJclCardinalFlatContainer, IJclCardinalEqualityComparer, IJclCardinalComparer, + IJclCardinalCollection, IJclCardinalList, IJclCardinalArray, IJclCardinalSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + function BinarySearch(AValue: Cardinal): Integer; + public + { IJclCardinalCollection } + function Add(AValue: Cardinal): Boolean; + function AddAll(const ACollection: IJclCardinalCollection): Boolean; + function Contains(AValue: Cardinal): Boolean; + { IJclCardinalList } + function Insert(Index: Integer; AValue: Cardinal): Boolean; + { IJclCardinalSet } + procedure Intersect(const ACollection: IJclCardinalCollection); + procedure Subtract(const ACollection: IJclCardinalCollection); + procedure Union(const ACollection: IJclCardinalCollection); + end; + + TJclInt64ArraySet = class(TJclInt64ArrayList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclInt64Container, IJclInt64FlatContainer, IJclInt64EqualityComparer, IJclInt64Comparer, + IJclInt64Collection, IJclInt64List, IJclInt64Array, IJclInt64Set) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + function BinarySearch(const AValue: Int64): Integer; + public + { IJclInt64Collection } + function Add(const AValue: Int64): Boolean; + function AddAll(const ACollection: IJclInt64Collection): Boolean; + function Contains(const AValue: Int64): Boolean; + { IJclInt64List } + function Insert(Index: Integer; const AValue: Int64): Boolean; + { IJclInt64Set } + procedure Intersect(const ACollection: IJclInt64Collection); + procedure Subtract(const ACollection: IJclInt64Collection); + procedure Union(const ACollection: IJclInt64Collection); + end; + + TJclPtrArraySet = class(TJclPtrArrayList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclPtrContainer, IJclPtrFlatContainer, IJclPtrEqualityComparer, IJclPtrComparer, + IJclPtrCollection, IJclPtrList, IJclPtrArray, IJclPtrSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + function BinarySearch(APtr: Pointer): Integer; + public + { IJclPtrCollection } + function Add(APtr: Pointer): Boolean; + function AddAll(const ACollection: IJclPtrCollection): Boolean; + function Contains(APtr: Pointer): Boolean; + { IJclPtrList } + function Insert(Index: Integer; APtr: Pointer): Boolean; + { IJclPtrSet } + procedure Intersect(const ACollection: IJclPtrCollection); + procedure Subtract(const ACollection: IJclPtrCollection); + procedure Union(const ACollection: IJclPtrCollection); + end; + + TJclArraySet = class(TJclArrayList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclContainer, IJclFlatContainer, IJclEqualityComparer, IJclComparer, IJclObjectOwner, + IJclCollection, IJclList, IJclArray, IJclSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + function BinarySearch(AObject: TObject): Integer; + public + { IJclCollection } + function Add(AObject: TObject): Boolean; + function AddAll(const ACollection: IJclCollection): Boolean; + function Contains(AObject: TObject): Boolean; + { IJclList } + function Insert(Index: Integer; AObject: TObject): Boolean; + { IJclSet } + procedure Intersect(const ACollection: IJclCollection); + procedure Subtract(const ACollection: IJclCollection); + procedure Union(const ACollection: IJclCollection); + end; + + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + + TJclArraySet = class(TJclArrayList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclContainer, IJclFlatContainer, IJclEqualityComparer, IJclComparer, IJclItemOwner, + IJclCollection, IJclList, IJclArray, IJclSet) + private + function BinarySearch(const AItem: T): Integer; + public + { IJclCollection } + function Add(const AItem: T): Boolean; + function AddAll(const ACollection: IJclCollection): Boolean; + function Contains(const AItem: T): Boolean; + { IJclList } + function Insert(Index: Integer; const AItem: T): Boolean; + { IJclSet } + procedure Intersect(const ACollection: IJclCollection); + procedure Subtract(const ACollection: IJclCollection); + procedure Union(const ACollection: IJclCollection); + end; + + // E = External helper to compare items + TJclArraySetE = class(TJclArraySet, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, IJclItemOwner, IJclEqualityComparer, IJclComparer, + IJclCollection, IJclList, IJclArray, IJclSet) + private + FComparer: IJclComparer; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AComparer: IJclComparer; ACapacity: Integer; AOwnsItems: Boolean); overload; + constructor Create(const AComparer: IJclComparer; const ACollection: IJclCollection; AOwnsItems: Boolean); overload; + { IJclEqualityComparer } + function ItemsCompare(const A, B: T): Integer; override; + { IJclComparer } + function ItemsEqual(const A, B: T): Boolean; override; + property Comparer: IJclComparer read FComparer write FComparer; + end; + + // F = Function to compare items + TJclArraySetF = class(TJclArraySet, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, IJclItemOwner, IJclEqualityComparer, IJclComparer, + IJclCollection, IJclList, IJclArray, IJclSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const ACompare: TCompare; ACapacity: Integer; AOwnsItems: Boolean); overload; + constructor Create(const ACompare: TCompare; const ACollection: IJclCollection; AOwnsItems: Boolean); overload; + end; + + // I = Items can compare themselves to others + TJclArraySetI> = class(TJclArraySet, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, IJclItemOwner, IJclEqualityComparer, IJclComparer, + IJclCollection, IJclList, IJclArray, IJclSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + { IJclEqualityComparer } + function ItemsCompare(const A, B: T): Integer; override; + { IJclComparer } + function ItemsEqual(const A, B: T): Boolean; override; + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +{$IFDEF BCB} +{$IFDEF WIN64} + {$HPPEMIT '#ifdef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #undef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #define JclArraySets_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT '#endif'} + + {$HPPEMIT END '#ifdef JclArraySets_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #define MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #undef JclArraySets_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END '#endif'} +{$ENDIF WIN64} +{$ENDIF BCB} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +//=== { TJclIntfArraySet } ==================================================== + +function TJclIntfArraySet.Add(const AInterface: IInterface): Boolean; +var + Idx: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AInterface, nil); + if Result then + begin + Idx := BinarySearch(AInterface); + if Idx >= 0 then + Result := not ItemsEqual(GetObject(Idx), AInterface) or CheckDuplicate + else + Result := True; + if Result then + Result := inherited Insert(Idx + 1, AInterface); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfArraySet.AddAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfArraySet.BinarySearch(const AInterface: IInterface): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := Size - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := ItemsCompare(GetObject(CompPos), AInterface); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfArraySet.Contains(const AInterface: IInterface): Boolean; +var + Idx: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Idx := BinarySearch(AInterface); + if Idx >= 0 then + Result := ItemsEqual(GetObject(Idx), AInterface) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfArraySet.Insert(Index: Integer; const AInterface: IInterface): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclIntfArraySet.Intersect(const ACollection: IJclIntfCollection); +begin + RetainAll(ACollection); +end; + +procedure TJclIntfArraySet.Subtract(const ACollection: IJclIntfCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclIntfArraySet.Union(const ACollection: IJclIntfCollection); +begin + AddAll(ACollection); +end; + +function TJclIntfArraySet.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfArraySet.Create(Size); + AssignPropertiesTo(Result); +end; + +//=== { TJclAnsiStrArraySet } ==================================================== + +function TJclAnsiStrArraySet.Add(const AString: AnsiString): Boolean; +var + Idx: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AString, ''); + if Result then + begin + Idx := BinarySearch(AString); + if Idx >= 0 then + Result := not ItemsEqual(GetString(Idx), AString) or CheckDuplicate + else + Result := True; + if Result then + Result := inherited Insert(Idx + 1, AString); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrArraySet.AddAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrArraySet.BinarySearch(const AString: AnsiString): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := Size - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := ItemsCompare(GetString(CompPos), AString); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrArraySet.Contains(const AString: AnsiString): Boolean; +var + Idx: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Idx := BinarySearch(AString); + if Idx >= 0 then + Result := ItemsEqual(GetString(Idx), AString) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrArraySet.Insert(Index: Integer; const AString: AnsiString): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclAnsiStrArraySet.Intersect(const ACollection: IJclAnsiStrCollection); +begin + RetainAll(ACollection); +end; + +procedure TJclAnsiStrArraySet.Subtract(const ACollection: IJclAnsiStrCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclAnsiStrArraySet.Union(const ACollection: IJclAnsiStrCollection); +begin + AddAll(ACollection); +end; + +function TJclAnsiStrArraySet.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclAnsiStrArraySet.Create(Size); + AssignPropertiesTo(Result); +end; + +//=== { TJclWideStrArraySet } ==================================================== + +function TJclWideStrArraySet.Add(const AString: WideString): Boolean; +var + Idx: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AString, ''); + if Result then + begin + Idx := BinarySearch(AString); + if Idx >= 0 then + Result := not ItemsEqual(GetString(Idx), AString) or CheckDuplicate + else + Result := True; + if Result then + Result := inherited Insert(Idx + 1, AString); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrArraySet.AddAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrArraySet.BinarySearch(const AString: WideString): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := Size - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := ItemsCompare(GetString(CompPos), AString); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrArraySet.Contains(const AString: WideString): Boolean; +var + Idx: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Idx := BinarySearch(AString); + if Idx >= 0 then + Result := ItemsEqual(GetString(Idx), AString) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrArraySet.Insert(Index: Integer; const AString: WideString): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclWideStrArraySet.Intersect(const ACollection: IJclWideStrCollection); +begin + RetainAll(ACollection); +end; + +procedure TJclWideStrArraySet.Subtract(const ACollection: IJclWideStrCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclWideStrArraySet.Union(const ACollection: IJclWideStrCollection); +begin + AddAll(ACollection); +end; + +function TJclWideStrArraySet.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclWideStrArraySet.Create(Size); + AssignPropertiesTo(Result); +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrArraySet } ==================================================== + +function TJclUnicodeStrArraySet.Add(const AString: UnicodeString): Boolean; +var + Idx: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AString, ''); + if Result then + begin + Idx := BinarySearch(AString); + if Idx >= 0 then + Result := not ItemsEqual(GetString(Idx), AString) or CheckDuplicate + else + Result := True; + if Result then + Result := inherited Insert(Idx + 1, AString); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrArraySet.AddAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrArraySet.BinarySearch(const AString: UnicodeString): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := Size - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := ItemsCompare(GetString(CompPos), AString); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrArraySet.Contains(const AString: UnicodeString): Boolean; +var + Idx: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Idx := BinarySearch(AString); + if Idx >= 0 then + Result := ItemsEqual(GetString(Idx), AString) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrArraySet.Insert(Index: Integer; const AString: UnicodeString): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclUnicodeStrArraySet.Intersect(const ACollection: IJclUnicodeStrCollection); +begin + RetainAll(ACollection); +end; + +procedure TJclUnicodeStrArraySet.Subtract(const ACollection: IJclUnicodeStrCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclUnicodeStrArraySet.Union(const ACollection: IJclUnicodeStrCollection); +begin + AddAll(ACollection); +end; + +function TJclUnicodeStrArraySet.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclUnicodeStrArraySet.Create(Size); + AssignPropertiesTo(Result); +end; + +{$ENDIF SUPPORTS_UNICODE_STRING} + +//=== { TJclSingleArraySet } ==================================================== + +function TJclSingleArraySet.Add(const AValue: Single): Boolean; +var + Idx: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if Result then + begin + Idx := BinarySearch(AValue); + if Idx >= 0 then + Result := not ItemsEqual(GetValue(Idx), AValue) or CheckDuplicate + else + Result := True; + if Result then + Result := inherited Insert(Idx + 1, AValue); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleArraySet.AddAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleArraySet.BinarySearch(const AValue: Single): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := Size - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := ItemsCompare(GetValue(CompPos), AValue); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleArraySet.Contains(const AValue: Single): Boolean; +var + Idx: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Idx := BinarySearch(AValue); + if Idx >= 0 then + Result := ItemsEqual(GetValue(Idx), AValue) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleArraySet.Insert(Index: Integer; const AValue: Single): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclSingleArraySet.Intersect(const ACollection: IJclSingleCollection); +begin + RetainAll(ACollection); +end; + +procedure TJclSingleArraySet.Subtract(const ACollection: IJclSingleCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclSingleArraySet.Union(const ACollection: IJclSingleCollection); +begin + AddAll(ACollection); +end; + +function TJclSingleArraySet.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclSingleArraySet.Create(Size); + AssignPropertiesTo(Result); +end; + +//=== { TJclDoubleArraySet } ==================================================== + +function TJclDoubleArraySet.Add(const AValue: Double): Boolean; +var + Idx: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if Result then + begin + Idx := BinarySearch(AValue); + if Idx >= 0 then + Result := not ItemsEqual(GetValue(Idx), AValue) or CheckDuplicate + else + Result := True; + if Result then + Result := inherited Insert(Idx + 1, AValue); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleArraySet.AddAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleArraySet.BinarySearch(const AValue: Double): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := Size - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := ItemsCompare(GetValue(CompPos), AValue); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleArraySet.Contains(const AValue: Double): Boolean; +var + Idx: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Idx := BinarySearch(AValue); + if Idx >= 0 then + Result := ItemsEqual(GetValue(Idx), AValue) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleArraySet.Insert(Index: Integer; const AValue: Double): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclDoubleArraySet.Intersect(const ACollection: IJclDoubleCollection); +begin + RetainAll(ACollection); +end; + +procedure TJclDoubleArraySet.Subtract(const ACollection: IJclDoubleCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclDoubleArraySet.Union(const ACollection: IJclDoubleCollection); +begin + AddAll(ACollection); +end; + +function TJclDoubleArraySet.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclDoubleArraySet.Create(Size); + AssignPropertiesTo(Result); +end; + +//=== { TJclExtendedArraySet } ==================================================== + +function TJclExtendedArraySet.Add(const AValue: Extended): Boolean; +var + Idx: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if Result then + begin + Idx := BinarySearch(AValue); + if Idx >= 0 then + Result := not ItemsEqual(GetValue(Idx), AValue) or CheckDuplicate + else + Result := True; + if Result then + Result := inherited Insert(Idx + 1, AValue); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedArraySet.AddAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedArraySet.BinarySearch(const AValue: Extended): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := Size - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := ItemsCompare(GetValue(CompPos), AValue); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedArraySet.Contains(const AValue: Extended): Boolean; +var + Idx: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Idx := BinarySearch(AValue); + if Idx >= 0 then + Result := ItemsEqual(GetValue(Idx), AValue) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedArraySet.Insert(Index: Integer; const AValue: Extended): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclExtendedArraySet.Intersect(const ACollection: IJclExtendedCollection); +begin + RetainAll(ACollection); +end; + +procedure TJclExtendedArraySet.Subtract(const ACollection: IJclExtendedCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclExtendedArraySet.Union(const ACollection: IJclExtendedCollection); +begin + AddAll(ACollection); +end; + +function TJclExtendedArraySet.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclExtendedArraySet.Create(Size); + AssignPropertiesTo(Result); +end; + +//=== { TJclIntegerArraySet } ==================================================== + +function TJclIntegerArraySet.Add(AValue: Integer): Boolean; +var + Idx: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if Result then + begin + Idx := BinarySearch(AValue); + if Idx >= 0 then + Result := not ItemsEqual(GetValue(Idx), AValue) or CheckDuplicate + else + Result := True; + if Result then + Result := inherited Insert(Idx + 1, AValue); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerArraySet.AddAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerArraySet.BinarySearch(AValue: Integer): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := Size - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := ItemsCompare(GetValue(CompPos), AValue); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerArraySet.Contains(AValue: Integer): Boolean; +var + Idx: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Idx := BinarySearch(AValue); + if Idx >= 0 then + Result := ItemsEqual(GetValue(Idx), AValue) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerArraySet.Insert(Index: Integer; AValue: Integer): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclIntegerArraySet.Intersect(const ACollection: IJclIntegerCollection); +begin + RetainAll(ACollection); +end; + +procedure TJclIntegerArraySet.Subtract(const ACollection: IJclIntegerCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclIntegerArraySet.Union(const ACollection: IJclIntegerCollection); +begin + AddAll(ACollection); +end; + +function TJclIntegerArraySet.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntegerArraySet.Create(Size); + AssignPropertiesTo(Result); +end; + +//=== { TJclCardinalArraySet } ==================================================== + +function TJclCardinalArraySet.Add(AValue: Cardinal): Boolean; +var + Idx: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if Result then + begin + Idx := BinarySearch(AValue); + if Idx >= 0 then + Result := not ItemsEqual(GetValue(Idx), AValue) or CheckDuplicate + else + Result := True; + if Result then + Result := inherited Insert(Idx + 1, AValue); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalArraySet.AddAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalArraySet.BinarySearch(AValue: Cardinal): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := Size - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := ItemsCompare(GetValue(CompPos), AValue); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalArraySet.Contains(AValue: Cardinal): Boolean; +var + Idx: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Idx := BinarySearch(AValue); + if Idx >= 0 then + Result := ItemsEqual(GetValue(Idx), AValue) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalArraySet.Insert(Index: Integer; AValue: Cardinal): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclCardinalArraySet.Intersect(const ACollection: IJclCardinalCollection); +begin + RetainAll(ACollection); +end; + +procedure TJclCardinalArraySet.Subtract(const ACollection: IJclCardinalCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclCardinalArraySet.Union(const ACollection: IJclCardinalCollection); +begin + AddAll(ACollection); +end; + +function TJclCardinalArraySet.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclCardinalArraySet.Create(Size); + AssignPropertiesTo(Result); +end; + +//=== { TJclInt64ArraySet } ==================================================== + +function TJclInt64ArraySet.Add(const AValue: Int64): Boolean; +var + Idx: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if Result then + begin + Idx := BinarySearch(AValue); + if Idx >= 0 then + Result := not ItemsEqual(GetValue(Idx), AValue) or CheckDuplicate + else + Result := True; + if Result then + Result := inherited Insert(Idx + 1, AValue); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64ArraySet.AddAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64ArraySet.BinarySearch(const AValue: Int64): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := Size - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := ItemsCompare(GetValue(CompPos), AValue); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64ArraySet.Contains(const AValue: Int64): Boolean; +var + Idx: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Idx := BinarySearch(AValue); + if Idx >= 0 then + Result := ItemsEqual(GetValue(Idx), AValue) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64ArraySet.Insert(Index: Integer; const AValue: Int64): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclInt64ArraySet.Intersect(const ACollection: IJclInt64Collection); +begin + RetainAll(ACollection); +end; + +procedure TJclInt64ArraySet.Subtract(const ACollection: IJclInt64Collection); +begin + RemoveAll(ACollection); +end; + +procedure TJclInt64ArraySet.Union(const ACollection: IJclInt64Collection); +begin + AddAll(ACollection); +end; + +function TJclInt64ArraySet.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclInt64ArraySet.Create(Size); + AssignPropertiesTo(Result); +end; + +//=== { TJclPtrArraySet } ==================================================== + +function TJclPtrArraySet.Add(APtr: Pointer): Boolean; +var + Idx: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(APtr, nil); + if Result then + begin + Idx := BinarySearch(APtr); + if Idx >= 0 then + Result := not ItemsEqual(GetPointer(Idx), APtr) or CheckDuplicate + else + Result := True; + if Result then + Result := inherited Insert(Idx + 1, APtr); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrArraySet.AddAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrArraySet.BinarySearch(APtr: Pointer): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := Size - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := ItemsCompare(GetPointer(CompPos), APtr); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrArraySet.Contains(APtr: Pointer): Boolean; +var + Idx: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Idx := BinarySearch(APtr); + if Idx >= 0 then + Result := ItemsEqual(GetPointer(Idx), APtr) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrArraySet.Insert(Index: Integer; APtr: Pointer): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclPtrArraySet.Intersect(const ACollection: IJclPtrCollection); +begin + RetainAll(ACollection); +end; + +procedure TJclPtrArraySet.Subtract(const ACollection: IJclPtrCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclPtrArraySet.Union(const ACollection: IJclPtrCollection); +begin + AddAll(ACollection); +end; + +function TJclPtrArraySet.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclPtrArraySet.Create(Size); + AssignPropertiesTo(Result); +end; + +//=== { TJclArraySet } ==================================================== + +function TJclArraySet.Add(AObject: TObject): Boolean; +var + Idx: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AObject, nil); + if Result then + begin + Idx := BinarySearch(AObject); + if Idx >= 0 then + Result := not ItemsEqual(GetObject(Idx), AObject) or CheckDuplicate + else + Result := True; + if Result then + Result := inherited Insert(Idx + 1, AObject); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArraySet.AddAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArraySet.BinarySearch(AObject: TObject): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := Size - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := ItemsCompare(GetObject(CompPos), AObject); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArraySet.Contains(AObject: TObject): Boolean; +var + Idx: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Idx := BinarySearch(AObject); + if Idx >= 0 then + Result := ItemsEqual(GetObject(Idx), AObject) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArraySet.Insert(Index: Integer; AObject: TObject): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclArraySet.Intersect(const ACollection: IJclCollection); +begin + RetainAll(ACollection); +end; + +procedure TJclArraySet.Subtract(const ACollection: IJclCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclArraySet.Union(const ACollection: IJclCollection); +begin + AddAll(ACollection); +end; + +function TJclArraySet.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclArraySet.Create(Size, False); + AssignPropertiesTo(Result); +end; + + +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +//=== { TJclArraySet } ==================================================== + +function TJclArraySet.Add(const AItem: T): Boolean; +var + Idx: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AItem, Default(T)); + if Result then + begin + Idx := BinarySearch(AItem); + if Idx >= 0 then + Result := not ItemsEqual(GetItem(Idx), AItem) or CheckDuplicate + else + Result := True; + if Result then + Result := inherited Insert(Idx + 1, AItem); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArraySet.AddAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArraySet.BinarySearch(const AItem: T): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := Size - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := ItemsCompare(GetItem(CompPos), AItem); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArraySet.Contains(const AItem: T): Boolean; +var + Idx: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Idx := BinarySearch(AItem); + if Idx >= 0 then + Result := ItemsEqual(GetItem(Idx), AItem) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclArraySet.Insert(Index: Integer; const AItem: T): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclArraySet.Intersect(const ACollection: IJclCollection); +begin + RetainAll(ACollection); +end; + +procedure TJclArraySet.Subtract(const ACollection: IJclCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclArraySet.Union(const ACollection: IJclCollection); +begin + AddAll(ACollection); +end; + +//=== { TJclArraySetE } =================================================== + +constructor TJclArraySetE.Create(const AComparer: IJclComparer; ACapacity: Integer; AOwnsItems: Boolean); +begin + inherited Create(ACapacity, AOwnsItems); + FComparer := AComparer; +end; + +constructor TJclArraySetE.Create(const AComparer: IJclComparer; const ACollection: IJclCollection; + AOwnsItems: Boolean); +begin + inherited Create(ACollection, AOwnsItems); + FComparer := AComparer; +end; + +procedure TJclArraySetE.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclArraySetE then + TJclArraySetE(Dest).FComparer := Comparer; +end; + +function TJclArraySetE.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclArraySetE.Create(Comparer, Size, False); + AssignPropertiesTo(Result); +end; + +function TJclArraySetE.ItemsCompare(const A, B: T): Integer; +begin + if Comparer <> nil then + Result := Comparer.Compare(A, B) + else + Result := inherited ItemsCompare(A, B); +end; + +function TJclArraySetE.ItemsEqual(const A, B: T): Boolean; +begin + if Comparer <> nil then + Result := Comparer.Compare(A, B) = 0 + else + Result := inherited ItemsEqual(A, B); +end; + +//=== { TJclArraySetF } =================================================== + +constructor TJclArraySetF.Create(const ACompare: TCompare; ACapacity: Integer; AOwnsItems: Boolean); +begin + inherited Create(ACapacity, AOwnsItems); + SetCompare(ACompare); +end; + +constructor TJclArraySetF.Create(const ACompare: TCompare; const ACollection: IJclCollection; + AOwnsItems: Boolean); +begin + inherited Create(ACollection, AOwnsItems); + SetCompare(ACompare); +end; + +function TJclArraySetF.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclArraySetF.Create(Compare, Size, False); + AssignPropertiesTo(Result); +end; + +//=== { TJclArraySetI } =================================================== + +function TJclArraySetI.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclArraySetI.Create(Size, False); + AssignPropertiesTo(Result); +end; + +function TJclArraySetI.ItemsCompare(const A, B: T): Integer; +begin + if Assigned(FCompare) then + Result := FCompare(A, B) + else + Result := A.CompareTo(B); +end; + +function TJclArraySetI.ItemsEqual(const A, B: T): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + Result := A.CompareTo(B) = 0; +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclBase.pas b/3rdParty/JCL/source/common/JclBase.pas index 716229d2..ed1bc3b7 100644 --- a/3rdParty/JCL/source/common/JclBase.pas +++ b/3rdParty/JCL/source/common/JclBase.pas @@ -1,643 +1,650 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is JclBase.pas. } -{ } -{ The Initial Developer of the Original Code is Marcel van Brakel. } -{ Portions created by Marcel van Brakel are Copyright Marcel van Brakel. All rights reserved. } -{ } -{ Contributors: } -{ Marcel van Brakel, } -{ Peter Friese, } -{ Robert Marquardt (marquardt) } -{ Robert Rossmair (rrossmair) } -{ Petr Vones (pvones) } -{ Florent Ouchet (outchy) } -{ } -{**************************************************************************************************} -{ } -{ This unit contains generic JCL base classes and routines to support earlier } -{ versions of Delphi as well as FPC. } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -unit JclBase; - -{$I jcl.inc} - -interface - -uses - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - {$IFDEF HAS_UNITSCOPE} - {$IFDEF MSWINDOWS} - Winapi.Windows, - {$ENDIF MSWINDOWS} - System.SysUtils; - {$ELSE ~HAS_UNITSCOPE} - {$IFDEF MSWINDOWS} - Windows, - {$ENDIF MSWINDOWS} - SysUtils; - {$ENDIF ~HAS_UNITSCOPE} - -// Version -const - JclVersionMajor = 2; // 0=pre-release|beta/1, 2, ...=final - JclVersionMinor = 8; // Fifth minor release since JCL 1.90 - JclVersionRelease = 0; // 0: pre-release|beta/ 1: release - JclVersionBuild = 5677; // build number, days since march 1, 2000 - JclVersion = (JclVersionMajor shl 24) or (JclVersionMinor shl 16) or - (JclVersionRelease shl 15) or (JclVersionBuild shl 0); - -// EJclError -type - EJclError = class(Exception); - -// EJclInternalError -type - EJclInternalError = class(EJclError); - -// Types -type - {$IFDEF MATH_EXTENDED_PRECISION} - Float = Extended; - {$ENDIF MATH_EXTENDED_PRECISION} - {$IFDEF MATH_DOUBLE_PRECISION} - Float = Double; - {$ENDIF MATH_DOUBLE_PRECISION} - {$IFDEF MATH_SINGLE_PRECISION} - Float = Single; - {$ENDIF MATH_SINGLE_PRECISION} - - PFloat = ^Float; - -type - {$IFDEF FPC} - Largeint = Int64; - {$ELSE ~FPC} - {$IFDEF CPU32} - SizeInt = Integer; - {$ENDIF CPU32} - {$IFDEF CPU64} - SizeInt = NativeInt; - {$ENDIF CPU64} - PSizeInt = ^SizeInt; - PPointer = ^Pointer; - PByte = System.PByte; - Int8 = ShortInt; - Int16 = Smallint; - Int32 = Integer; - UInt8 = Byte; - UInt16 = Word; - UInt32 = LongWord; - PCardinal = ^Cardinal; - {$IFNDEF COMPILER7_UP} - UInt64 = Int64; - {$ENDIF ~COMPILER7_UP} - PWideChar = System.PWideChar; - PPWideChar = ^PWideChar; - PPAnsiChar = ^PAnsiChar; - PInt64 = type System.PInt64; - {$ENDIF ~FPC} - PPInt64 = ^PInt64; - PPPAnsiChar = ^PPAnsiChar; - -// Int64 support -procedure I64ToCardinals(I: Int64; out LowPart, HighPart: Cardinal); -procedure CardinalsToI64(out I: Int64; const LowPart, HighPart: Cardinal); - -// Redefinition of TLargeInteger to relieve dependency on Windows.pas - -{$IFNDEF FPC} -type - PLargeInteger = ^TLargeInteger; - TLargeInteger = Int64; -{$ENDIF ~FPC} - -{$IFNDEF COMPILER11_UP} -type - TBytes = array of Byte; -{$ENDIF ~COMPILER11_UP} - -// Redefinition of PByteArray to avoid range check exceptions. -type - TJclByteArray = array [0..MaxInt div SizeOf(Byte) - 1] of Byte; - PJclByteArray = ^TJclByteArray; - TJclBytes = Pointer; // under .NET System.pas: TBytes = array of Byte; - -// Redefinition of ULARGE_INTEGER to relieve dependency on Windows.pas -type - {$IFNDEF FPC} - PULARGE_INTEGER = ^ULARGE_INTEGER; - {$EXTERNALSYM PULARGE_INTEGER} - ULARGE_INTEGER = record - case Integer of - 0: - (LowPart: LongWord; - HighPart: LongWord); - 1: - (QuadPart: Int64); - end; - {$EXTERNALSYM ULARGE_INTEGER} - {$ENDIF ~FPC} - TJclULargeInteger = ULARGE_INTEGER; - PJclULargeInteger = PULARGE_INTEGER; - - {$IFNDEF COMPILER16_UP} - LONG = Longint; - {$EXTERNALSYM LONG} - {$ENDIF ~COMPILER16_UP} - -// Dynamic Array support -type - TDynByteArray = array of Byte; - TDynShortIntArray = array of Shortint; - TDynWordArray = array of Word; - TDynSmallIntArray = array of Smallint; - TDynLongIntArray = array of Longint; - TDynInt64Array = array of Int64; - TDynCardinalArray = array of Cardinal; - TDynIntegerArray = array of Integer; - TDynSizeIntArray = array of SizeInt; - TDynExtendedArray = array of Extended; - TDynDoubleArray = array of Double; - TDynSingleArray = array of Single; - TDynFloatArray = array of Float; - TDynPointerArray = array of Pointer; - TDynStringArray = array of string; - TDynAnsiStringArray = array of AnsiString; - TDynWideStringArray = array of WideString; - {$IFDEF SUPPORTS_UNICODE_STRING} - TDynUnicodeStringArray = array of UnicodeString; - {$ENDIF SUPPORTS_UNICODE_STRING} - TDynIInterfaceArray = array of IInterface; - TDynObjectArray = array of TObject; - TDynCharArray = array of Char; - TDynAnsiCharArray = array of AnsiChar; - TDynWideCharArray = array of WideChar; - -// Cross-Platform Compatibility -const - // line delimiters for a version of Delphi/C++Builder - NativeLineFeed = Char(#10); - NativeCarriageReturn = Char(#13); - NativeCrLf = string(#13#10); - // default line break for a version of Delphi on a platform - {$IFDEF MSWINDOWS} - NativeLineBreak = NativeCrLf; - {$ENDIF MSWINDOWS} - {$IFDEF UNIX} - NativeLineBreak = NativeLineFeed; - {$ENDIF UNIX} - - HexPrefixPascal = string('$'); - HexPrefixC = string('0x'); - HexDigitFmt32 = string('%.8x'); - HexDigitFmt64 = string('%.16x'); - - {$IFDEF BCB} - HexPrefix = HexPrefixC; - {$ELSE ~BCB} - HexPrefix = HexPrefixPascal; - {$ENDIF ~BCB} - - {$IFDEF CPU32} - HexDigitFmt = HexDigitFmt32; - {$ENDIF CPU32} - {$IFDEF CPU64} - HexDigitFmt = HexDigitFmt64; - {$ENDIF CPU64} - - HexFmt = HexPrefix + HexDigitFmt; - -const - BOM_UTF16_LSB: array [0..1] of Byte = ($FF,$FE); - BOM_UTF16_MSB: array [0..1] of Byte = ($FE,$FF); - BOM_UTF8: array [0..2] of Byte = ($EF,$BB,$BF); - BOM_UTF32_LSB: array [0..3] of Byte = ($FF,$FE,$00,$00); - BOM_UTF32_MSB: array [0..3] of Byte = ($00,$00,$FE,$FF); -// BOM_UTF7_1: array [0..3] of Byte = ($2B,$2F,$76,$38); -// BOM_UTF7_2: array [0..3] of Byte = ($2B,$2F,$76,$39); -// BOM_UTF7_3: array [0..3] of Byte = ($2B,$2F,$76,$2B); -// BOM_UTF7_4: array [0..3] of Byte = ($2B,$2F,$76,$2F); -// BOM_UTF7_5: array [0..3] of Byte = ($2B,$2F,$76,$38,$2D); - -type - // Unicode transformation formats (UTF) data types - PUTF7 = ^UTF7; - UTF7 = AnsiChar; - PUTF8 = ^UTF8; - UTF8 = AnsiChar; - PUTF16 = ^UTF16; - UTF16 = WideChar; - PUTF32 = ^UTF32; - UTF32 = Cardinal; - - // UTF conversion schemes (UCS) data types - PUCS4 = ^UCS4; - UCS4 = Cardinal; - PUCS2 = PWideChar; - UCS2 = WideChar; - - TUCS2Array = array of UCS2; - TUCS4Array = array of UCS4; - - // string types - TUTF8String = AnsiString; - {$IFDEF SUPPORTS_UNICODE_STRING} - TUTF16String = UnicodeString; - TUCS2String = UnicodeString; - {$ELSE} - TUTF16String = WideString; - TUCS2String = WideString; - {$ENDIF SUPPORTS_UNICODE_STRING} - -var - AnsiReplacementCharacter: AnsiChar; - -const - UCS4ReplacementCharacter: UCS4 = $0000FFFD; - MaximumUCS2: UCS4 = $0000FFFF; - MaximumUTF16: UCS4 = $0010FFFF; - MaximumUCS4: UCS4 = $7FFFFFFF; - - SurrogateHighStart = UCS4($D800); - SurrogateHighEnd = UCS4($DBFF); - SurrogateLowStart = UCS4($DC00); - SurrogateLowEnd = UCS4($DFFF); - -// basic set types -type - TSetOfAnsiChar = set of AnsiChar; - -{$IFNDEF XPLATFORM_RTL} -procedure RaiseLastOSError; -{$ENDIF ~XPLATFORM_RTL} - -{$IFNDEF RTL230_UP} -procedure CheckOSError(ErrorCode: Cardinal); -{$ENDIF RTL230_UP} - -procedure MoveChar(const Source: string; FromIndex: SizeInt; - var Dest: string; ToIndex, Count: SizeInt); overload; // Index: 0..n-1 - -function AnsiByteArrayStringLen(Data: TBytes): SizeInt; -function StringToAnsiByteArray(const S: string): TBytes; -function AnsiByteArrayToString(const Data: TBytes; Count: SizeInt): string; - -function BytesOf(const Value: AnsiString): TBytes; overload; -function BytesOf(const Value: WideString): TBytes; overload; -function BytesOf(const Value: WideChar): TBytes; overload; -function BytesOf(const Value: AnsiChar): TBytes; overload; -function StringOf(const Bytes: array of Byte): AnsiString; overload; -function StringOf(const Bytes: Pointer; Size: Cardinal): AnsiString; overload; - -{$IFNDEF FPC} -{$IFNDEF COMPILER11_UP} -type // Definitions for 32 Bit Compilers - // From BaseTsd.h - INT_PTR = Integer; - {$EXTERNALSYM INT_PTR} - LONG_PTR = Longint; - {$EXTERNALSYM LONG_PTR} - UINT_PTR = Cardinal; - {$EXTERNALSYM UINT_PTR} - ULONG_PTR = LongWord; - {$EXTERNALSYM ULONG_PTR} - DWORD_PTR = ULONG_PTR; - {$EXTERNALSYM DWORD_PTR} -{$ENDIF ~COMPILER11_UP} - -type - PDWORD_PTR = ^DWORD_PTR; - {$EXTERNALSYM PDWORD_PTR} -{$ENDIF ~FPC} - -type - TJclAddr32 = Cardinal; - {$IFDEF FPC} - TJclAddr64 = QWord; - {$IFDEF CPU64} - TJclAddr = QWord; - {$ENDIF CPU64} - {$IFDEF CPU32} - TJclAddr = Cardinal; - {$ENDIF CPU32} - {$ENDIF FPC} - {$IFDEF BORLAND} - TJclAddr64 = Int64; - {$IFDEF CPU64} - TJclAddr = TJclAddr64; - {$ENDIF CPU64} - {$IFDEF CPU32} - TJclAddr = TJclAddr32; - {$ENDIF CPU32} - {$ENDIF BORLAND} - PJclAddr = ^TJclAddr; - - EJclAddr64Exception = class(EJclError); - -function Addr64ToAddr32(const Value: TJclAddr64): TJclAddr32; -function Addr32ToAddr64(const Value: TJclAddr32): TJclAddr64; - -{$IFDEF FPC} -type - HWND = type Windows.HWND; -{$ENDIF FPC} - - {$IFDEF SUPPORTS_GENERICS} -//DOM-IGNORE-BEGIN - -type - TCompare = function(const Obj1, Obj2: T): Integer; - TEqualityCompare = function(const Obj1, Obj2: T): Boolean; - THashConvert = function(const AItem: T): Integer; - - IEqualityComparer = interface - function Equals(A, B: T): Boolean; - function GetHashCode(Obj: T): Integer; - end; - - TEquatable = class(TInterfacedObject, IEquatable, IEqualityComparer) - public - { IEquatable } - function TestEquals(Other: T): Boolean; overload; - function IEquatable.Equals = TestEquals; - { IEqualityComparer } - function TestEquals(A, B: T): Boolean; overload; - function IEqualityComparer.Equals = TestEquals; - function GetHashCode2(Obj: T): Integer; - function IEqualityComparer.GetHashCode = GetHashCode2; - end; - -//DOM-IGNORE-END -{$ENDIF SUPPORTS_GENERICS} - -const - {$IFDEF SUPPORTS_UNICODE} - AWSuffix = 'W'; - {$ELSE ~SUPPORTS_UNICODE} - AWSuffix = 'A'; - {$ENDIF ~SUPPORTS_UNICODE} - -{$IFDEF FPC} -// FPC emits a lot of warning because the first parameter of its internal -// GetMem is a var parameter, which is not initialized before the call to GetMem -procedure GetMem(out P; Size: Longint); -{$ENDIF FPC} - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\common'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -uses - JclResources; - -procedure MoveChar(const Source: string; FromIndex: SizeInt; - var Dest: string; ToIndex, Count: SizeInt); -begin - Move(Source[FromIndex + 1], Dest[ToIndex + 1], Count * SizeOf(Char)); -end; - -function AnsiByteArrayStringLen(Data: TBytes): SizeInt; -var - I: SizeInt; -begin - Result := Length(Data); - for I := 0 to Result - 1 do - if Data[I] = 0 then - begin - Result := I + 1; - Break; - end; -end; - -function StringToAnsiByteArray(const S: string): TBytes; -var - I: SizeInt; - AnsiS: AnsiString; -begin - AnsiS := AnsiString(S); // convert to AnsiString - SetLength(Result, Length(AnsiS)); - for I := 0 to High(Result) do - Result[I] := Byte(AnsiS[I + 1]); -end; - -function AnsiByteArrayToString(const Data: TBytes; Count: SizeInt): string; -var - I: SizeInt; - AnsiS: AnsiString; -begin - if Length(Data) < Count then - Count := Length(Data); - SetLength(AnsiS, Count); - for I := 0 to Length(AnsiS) - 1 do - AnsiS[I + 1] := AnsiChar(Data[I]); - Result := string(AnsiS); // convert to System.String -end; - -function BytesOf(const Value: AnsiString): TBytes; -begin - SetLength(Result, Length(Value)); - if Value <> '' then - Move(Pointer(Value)^, Result[0], Length(Value)); -end; - -function BytesOf(const Value: WideString): TBytes; -begin - if Value <> '' then - Result := JclBase.BytesOf(AnsiString(Value)) - else - SetLength(Result, 0); -end; - -function BytesOf(const Value: WideChar): TBytes; -begin - Result := JclBase.BytesOf(WideString(Value)); -end; - -function BytesOf(const Value: AnsiChar): TBytes; -begin - SetLength(Result, 1); - Result[0] := Byte(Value); -end; - -function StringOf(const Bytes: array of Byte): AnsiString; -begin - if Length(Bytes) > 0 then - begin - SetLength(Result, Length(Bytes)); - Move(Bytes[0], Pointer(Result)^, Length(Bytes)); - end - else - Result := ''; -end; - -function StringOf(const Bytes: Pointer; Size: Cardinal): AnsiString; -begin - if (Bytes <> nil) and (Size > 0) then - begin - SetLength(Result, Size); - Move(Bytes^, Pointer(Result)^, Size); - end - else - Result := ''; -end; - -// Int64 support - -procedure I64ToCardinals(I: Int64; out LowPart, HighPart: Cardinal); -begin - LowPart := TJclULargeInteger(I).LowPart; - HighPart := TJclULargeInteger(I).HighPart; -end; - -procedure CardinalsToI64(out I: Int64; const LowPart, HighPart: Cardinal); -begin - TJclULargeInteger(I).LowPart := LowPart; - TJclULargeInteger(I).HighPart := HighPart; -end; - -// Cross Platform Compatibility - -{$IFNDEF XPLATFORM_RTL} -procedure RaiseLastOSError; -begin - RaiseLastWin32Error; -end; -{$ENDIF ~XPLATFORM_RTL} - -{$IFNDEF RTL230_UP} -procedure CheckOSError(ErrorCode: Cardinal); -begin - if ErrorCode <> ERROR_SUCCESS then - {$IFDEF RTL170_UP} - RaiseLastOSError(ErrorCode); - {$ELSE ~RTL170_UP} - RaiseLastOSError; - {$ENDIF ~RTL170_UP} -end; -{$ENDIF RTL230_UP} - -{$OVERFLOWCHECKS OFF} - -function Addr64ToAddr32(const Value: TJclAddr64): TJclAddr32; -begin - if (Value shr 32) = 0 then - Result := Value - else - raise EJclAddr64Exception.CreateResFmt(@RsCantConvertAddr64, [HexPrefix, Value]); -end; - -function Addr32ToAddr64(const Value: TJclAddr32): TJclAddr64; -begin - Result := Value; -end; - -{$IFDEF OVERFLOWCHECKS_ON} -{$OVERFLOWCHECKS ON} -{$ENDIF OVERFLOWCHECKS_ON} - -{$IFDEF SUPPORTS_GENERICS} -//DOM-IGNORE-BEGIN - -//=== { TEquatable } ====================================================== - -function TEquatable.TestEquals(Other: T): Boolean; -begin - if Other = nil then - Result := False - else - Result := GetHashCode = Other.GetHashCode; -end; - -function TEquatable.TestEquals(A, B: T): Boolean; -begin - if A = nil then - Result := B = nil - else - if B = nil then - Result := False - else - Result := A.GetHashCode = B.GetHashCode; -end; - -function TEquatable.GetHashCode2(Obj: T): Integer; -begin - if Obj = nil then - Result := 0 - else - Result := Obj.GetHashCode; -end; - -//DOM-IGNORE-END -{$ENDIF SUPPORTS_GENERICS} - -procedure LoadAnsiReplacementCharacter; -{$IFDEF MSWINDOWS} -var - CpInfo: TCpInfo; -begin - CpInfo.MaxCharSize := 0; - if GetCPInfo(CP_ACP, CpInfo) then - AnsiReplacementCharacter := AnsiChar(Chr(CpInfo.DefaultChar[0])) - else - raise EJclInternalError.CreateRes(@RsEReplacementChar); -end; -{$ELSE ~MSWINDOWS} -begin - AnsiReplacementCharacter := '?'; -end; -{$ENDIF ~MSWINDOWS} - -{$IFDEF FPC} -// FPC emits a lot of warning because the first parameter of its internal -// GetMem is a var parameter, which is not initialized before the call to GetMem -procedure GetMem(out P; Size: Longint); -begin - Pointer(P) := nil; - GetMem(Pointer(P), Size); -end; -{$ENDIF FPC} - -initialization - - LoadAnsiReplacementCharacter; - {$IFDEF UNITVERSIONING} - RegisterUnitVersion(HInstance, UnitVersioning); - {$ENDIF UNITVERSIONING} - -finalization - {$IFDEF UNITVERSIONING} - UnregisterUnitVersion(HInstance); - {$ENDIF UNITVERSIONING} - -end. +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclBase.pas. } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. } +{ Portions created by Marcel van Brakel are Copyright Marcel van Brakel. All rights reserved. } +{ } +{ Contributors: } +{ Marcel van Brakel, } +{ Peter Friese, } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Petr Vones (pvones) } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ This unit contains generic JCL base classes and routines to support earlier } +{ versions of Delphi as well as FPC. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclBase; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Winapi.Windows, + {$ENDIF MSWINDOWS} + System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +// Version +const + JclVersionMajor = 2; // 0=pre-release|beta/1, 2, ...=final + JclVersionMinor = 9; // Fifth minor release since JCL 1.90 + JclVersionRelease = 0; // 0: pre-release|beta/ 1: release + JclVersionBuild = 9331; // build number, days since march 1, 2000 + JclVersion = (JclVersionMajor shl 24) or (JclVersionMinor shl 16) or + (JclVersionRelease shl 15) or (JclVersionBuild shl 0); + +// EJclError +type + EJclError = class(Exception); + +// EJclInternalError +type + EJclInternalError = class(EJclError); + +// Types +type + {$IFDEF MATH_EXTENDED_PRECISION} + Float = Extended; + {$ENDIF MATH_EXTENDED_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + Float = Double; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_SINGLE_PRECISION} + Float = Single; + {$ENDIF MATH_SINGLE_PRECISION} + + PFloat = ^Float; + +type + {$IFDEF FPC} + Largeint = Int64; + {$ELSE ~FPC} + {$IFDEF CPU32} + SizeInt = Integer; + {$ENDIF CPU32} + {$IFDEF CPU64} + SizeInt = NativeInt; + {$ENDIF CPU64} + PSizeInt = ^SizeInt; + PPointer = ^Pointer; + PByte = System.PByte; + Int8 = ShortInt; + Int16 = Smallint; + Int32 = Integer; + UInt8 = Byte; + UInt16 = Word; + UInt32 = LongWord; + PCardinal = ^Cardinal; + {$IFNDEF COMPILER7_UP} + UInt64 = Int64; + {$ENDIF ~COMPILER7_UP} + PWideChar = System.PWideChar; + PPWideChar = ^PWideChar; + PPAnsiChar = ^PAnsiChar; + PInt64 = type System.PInt64; + {$ENDIF ~FPC} + PPInt64 = ^PInt64; + PPPAnsiChar = ^PPAnsiChar; + +// Int64 support +procedure I64ToCardinals(I: Int64; out LowPart, HighPart: Cardinal); +procedure CardinalsToI64(out I: Int64; const LowPart, HighPart: Cardinal); + +// Redefinition of TLargeInteger to relieve dependency on Windows.pas + +{$IFNDEF FPC} +type + PLargeInteger = ^TLargeInteger; + TLargeInteger = Int64; +{$ENDIF ~FPC} + +{$IFNDEF COMPILER11_UP} +type + TBytes = array of Byte; +{$ENDIF ~COMPILER11_UP} + +type + {$IFDEF RTL360_UP} + TJclListSize = NativeInt; + {$ELSE} + TJclListSize = Integer; + {$ENDIF ~RTL360_UP} + +// Redefinition of PByteArray to avoid range check exceptions. +type + TJclByteArray = array [0..MaxInt div SizeOf(Byte) - 1] of Byte; + PJclByteArray = ^TJclByteArray; + TJclBytes = Pointer; // under .NET System.pas: TBytes = array of Byte; + +// Redefinition of ULARGE_INTEGER to relieve dependency on Windows.pas +type + {$IFNDEF FPC} + PULARGE_INTEGER = ^ULARGE_INTEGER; + {$EXTERNALSYM PULARGE_INTEGER} + ULARGE_INTEGER = record + case Integer of + 0: + (LowPart: LongWord; + HighPart: LongWord); + 1: + (QuadPart: Int64); + end; + {$EXTERNALSYM ULARGE_INTEGER} + {$ENDIF ~FPC} + TJclULargeInteger = ULARGE_INTEGER; + PJclULargeInteger = PULARGE_INTEGER; + + {$IFNDEF COMPILER16_UP} + LONG = Longint; + {$EXTERNALSYM LONG} + {$ENDIF ~COMPILER16_UP} + +// Dynamic Array support +type + TDynByteArray = array of Byte; + TDynShortIntArray = array of Shortint; + TDynWordArray = array of Word; + TDynSmallIntArray = array of Smallint; + TDynLongIntArray = array of Longint; + TDynInt64Array = array of Int64; + TDynCardinalArray = array of Cardinal; + TDynIntegerArray = array of Integer; + TDynSizeIntArray = array of SizeInt; + TDynExtendedArray = array of Extended; + TDynDoubleArray = array of Double; + TDynSingleArray = array of Single; + TDynFloatArray = array of Float; + TDynPointerArray = array of Pointer; + TDynStringArray = array of string; + TDynAnsiStringArray = array of AnsiString; + TDynWideStringArray = array of WideString; + {$IFDEF SUPPORTS_UNICODE_STRING} + TDynUnicodeStringArray = array of UnicodeString; + {$ENDIF SUPPORTS_UNICODE_STRING} + TDynIInterfaceArray = array of IInterface; + TDynObjectArray = array of TObject; + TDynCharArray = array of Char; + TDynAnsiCharArray = array of AnsiChar; + TDynWideCharArray = array of WideChar; + +// Cross-Platform Compatibility +const + // line delimiters for a version of Delphi/C++Builder + NativeLineFeed = Char(#10); + NativeCarriageReturn = Char(#13); + NativeCrLf = string(#13#10); + // default line break for a version of Delphi on a platform + {$IFDEF MSWINDOWS} + NativeLineBreak = NativeCrLf; + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + NativeLineBreak = NativeLineFeed; + {$ENDIF UNIX} + + HexPrefixPascal = string('$'); + HexPrefixC = string('0x'); + HexDigitFmt32 = string('%.8x'); + HexDigitFmt64 = string('%.16x'); + + {$IFDEF BCB} + HexPrefix = HexPrefixC; + {$ELSE ~BCB} + HexPrefix = HexPrefixPascal; + {$ENDIF ~BCB} + + {$IFDEF CPU32} + HexDigitFmt = HexDigitFmt32; + {$ENDIF CPU32} + {$IFDEF CPU64} + HexDigitFmt = HexDigitFmt64; + {$ENDIF CPU64} + + HexFmt = HexPrefix + HexDigitFmt; + +const + BOM_UTF16_LSB: array [0..1] of Byte = ($FF,$FE); + BOM_UTF16_MSB: array [0..1] of Byte = ($FE,$FF); + BOM_UTF8: array [0..2] of Byte = ($EF,$BB,$BF); + BOM_UTF32_LSB: array [0..3] of Byte = ($FF,$FE,$00,$00); + BOM_UTF32_MSB: array [0..3] of Byte = ($00,$00,$FE,$FF); +// BOM_UTF7_1: array [0..3] of Byte = ($2B,$2F,$76,$38); +// BOM_UTF7_2: array [0..3] of Byte = ($2B,$2F,$76,$39); +// BOM_UTF7_3: array [0..3] of Byte = ($2B,$2F,$76,$2B); +// BOM_UTF7_4: array [0..3] of Byte = ($2B,$2F,$76,$2F); +// BOM_UTF7_5: array [0..3] of Byte = ($2B,$2F,$76,$38,$2D); + +type + // Unicode transformation formats (UTF) data types + PUTF7 = ^UTF7; + UTF7 = AnsiChar; + PUTF8 = ^UTF8; + UTF8 = AnsiChar; + PUTF16 = ^UTF16; + UTF16 = WideChar; + PUTF32 = ^UTF32; + UTF32 = Cardinal; + + // UTF conversion schemes (UCS) data types + PUCS4 = ^UCS4; + UCS4 = Cardinal; + PUCS2 = PWideChar; + UCS2 = WideChar; + + TUCS2Array = array of UCS2; + TUCS4Array = array of UCS4; + + // string types + TUTF8String = AnsiString; + {$IFDEF SUPPORTS_UNICODE_STRING} + TUTF16String = UnicodeString; + TUCS2String = UnicodeString; + {$ELSE} + TUTF16String = WideString; + TUCS2String = WideString; + {$ENDIF SUPPORTS_UNICODE_STRING} + +var + AnsiReplacementCharacter: AnsiChar; + +const + UCS4ReplacementCharacter: UCS4 = $0000FFFD; + MaximumUCS2: UCS4 = $0000FFFF; + MaximumUTF16: UCS4 = $0010FFFF; + MaximumUCS4: UCS4 = $7FFFFFFF; + + SurrogateHighStart = UCS4($D800); + SurrogateHighEnd = UCS4($DBFF); + SurrogateLowStart = UCS4($DC00); + SurrogateLowEnd = UCS4($DFFF); + +// basic set types +type + TSetOfAnsiChar = set of AnsiChar; + +{$IFNDEF XPLATFORM_RTL} +procedure RaiseLastOSError; +{$ENDIF ~XPLATFORM_RTL} + +{$IFNDEF RTL230_UP} +procedure CheckOSError(ErrorCode: Cardinal); +{$ENDIF RTL230_UP} + +procedure MoveChar(const Source: string; FromIndex: SizeInt; + var Dest: string; ToIndex, Count: SizeInt); overload; // Index: 0..n-1 + +function AnsiByteArrayStringLen(Data: TBytes): SizeInt; +function StringToAnsiByteArray(const S: string): TBytes; +function AnsiByteArrayToString(const Data: TBytes; Count: SizeInt): string; + +function BytesOf(const Value: AnsiString): TBytes; overload; +function BytesOf(const Value: WideString): TBytes; overload; +function BytesOf(const Value: WideChar): TBytes; overload; +function BytesOf(const Value: AnsiChar): TBytes; overload; +function StringOf(const Bytes: array of Byte): AnsiString; overload; +function StringOf(const Bytes: Pointer; Size: Cardinal): AnsiString; overload; + +{$IFNDEF FPC} +{$IFNDEF COMPILER11_UP} +type // Definitions for 32 Bit Compilers + // From BaseTsd.h + INT_PTR = Integer; + {$EXTERNALSYM INT_PTR} + LONG_PTR = Longint; + {$EXTERNALSYM LONG_PTR} + UINT_PTR = Cardinal; + {$EXTERNALSYM UINT_PTR} + ULONG_PTR = LongWord; + {$EXTERNALSYM ULONG_PTR} + DWORD_PTR = ULONG_PTR; + {$EXTERNALSYM DWORD_PTR} +{$ENDIF ~COMPILER11_UP} + +type + PDWORD_PTR = ^DWORD_PTR; + {$EXTERNALSYM PDWORD_PTR} +{$ENDIF ~FPC} + +type + TJclAddr32 = Cardinal; + {$IFDEF FPC} + TJclAddr64 = QWord; + {$IFDEF CPU64} + TJclAddr = QWord; + {$ENDIF CPU64} + {$IFDEF CPU32} + TJclAddr = Cardinal; + {$ENDIF CPU32} + {$ENDIF FPC} + {$IFDEF BORLAND} + TJclAddr64 = Int64; + {$IFDEF CPU64} + TJclAddr = TJclAddr64; + {$ENDIF CPU64} + {$IFDEF CPU32} + TJclAddr = TJclAddr32; + {$ENDIF CPU32} + {$ENDIF BORLAND} + PJclAddr = ^TJclAddr; + + EJclAddr64Exception = class(EJclError); + +function Addr64ToAddr32(const Value: TJclAddr64): TJclAddr32; +function Addr32ToAddr64(const Value: TJclAddr32): TJclAddr64; + +{$IFDEF FPC} +type + HWND = type Windows.HWND; +{$ENDIF FPC} + + {$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +type + TCompare = function(const Obj1, Obj2: T): Integer; + TEqualityCompare = function(const Obj1, Obj2: T): Boolean; + THashConvert = function(const AItem: T): Integer; + + IEqualityComparer = interface + function Equals(A, B: T): Boolean; + function GetHashCode(Obj: T): Integer; + end; + + TEquatable = class(TInterfacedObject, IEquatable, IEqualityComparer) + public + { IEquatable } + function TestEquals(Other: T): Boolean; overload; + function IEquatable.Equals = TestEquals; + { IEqualityComparer } + function TestEquals(A, B: T): Boolean; overload; + function IEqualityComparer.Equals = TestEquals; + function GetHashCode2(Obj: T): Integer; + function IEqualityComparer.GetHashCode = GetHashCode2; + end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +const + {$IFDEF SUPPORTS_UNICODE} + AWSuffix = 'W'; + {$ELSE ~SUPPORTS_UNICODE} + AWSuffix = 'A'; + {$ENDIF ~SUPPORTS_UNICODE} + +{$IFDEF FPC} +// FPC emits a lot of warning because the first parameter of its internal +// GetMem is a var parameter, which is not initialized before the call to GetMem +procedure GetMem(out P; Size: Longint); +{$ENDIF FPC} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + JclResources; + +procedure MoveChar(const Source: string; FromIndex: SizeInt; + var Dest: string; ToIndex, Count: SizeInt); +begin + Move(Source[FromIndex + 1], Dest[ToIndex + 1], Count * SizeOf(Char)); +end; + +function AnsiByteArrayStringLen(Data: TBytes): SizeInt; +var + I: SizeInt; +begin + Result := Length(Data); + for I := 0 to Result - 1 do + if Data[I] = 0 then + begin + Result := I + 1; + Break; + end; +end; + +function StringToAnsiByteArray(const S: string): TBytes; +var + I: SizeInt; + AnsiS: AnsiString; +begin + AnsiS := AnsiString(S); // convert to AnsiString + SetLength(Result, Length(AnsiS)); + for I := 0 to High(Result) do + Result[I] := Byte(AnsiS[I + 1]); +end; + +function AnsiByteArrayToString(const Data: TBytes; Count: SizeInt): string; +var + I: SizeInt; + AnsiS: AnsiString; +begin + if Length(Data) < Count then + Count := Length(Data); + SetLength(AnsiS, Count); + for I := 0 to Length(AnsiS) - 1 do + AnsiS[I + 1] := AnsiChar(Data[I]); + Result := string(AnsiS); // convert to System.String +end; + +function BytesOf(const Value: AnsiString): TBytes; +begin + SetLength(Result, Length(Value)); + if Value <> '' then + Move(Pointer(Value)^, Result[0], Length(Value)); +end; + +function BytesOf(const Value: WideString): TBytes; +begin + if Value <> '' then + Result := JclBase.BytesOf(AnsiString(Value)) + else + SetLength(Result, 0); +end; + +function BytesOf(const Value: WideChar): TBytes; +begin + Result := JclBase.BytesOf(WideString(Value)); +end; + +function BytesOf(const Value: AnsiChar): TBytes; +begin + SetLength(Result, 1); + Result[0] := Byte(Value); +end; + +function StringOf(const Bytes: array of Byte): AnsiString; +begin + if Length(Bytes) > 0 then + begin + SetLength(Result, Length(Bytes)); + Move(Bytes[0], Pointer(Result)^, Length(Bytes)); + end + else + Result := ''; +end; + +function StringOf(const Bytes: Pointer; Size: Cardinal): AnsiString; +begin + if (Bytes <> nil) and (Size > 0) then + begin + SetLength(Result, Size); + Move(Bytes^, Pointer(Result)^, Size); + end + else + Result := ''; +end; + +// Int64 support + +procedure I64ToCardinals(I: Int64; out LowPart, HighPart: Cardinal); +begin + LowPart := TJclULargeInteger(I).LowPart; + HighPart := TJclULargeInteger(I).HighPart; +end; + +procedure CardinalsToI64(out I: Int64; const LowPart, HighPart: Cardinal); +begin + TJclULargeInteger(I).LowPart := LowPart; + TJclULargeInteger(I).HighPart := HighPart; +end; + +// Cross Platform Compatibility + +{$IFNDEF XPLATFORM_RTL} +procedure RaiseLastOSError; +begin + RaiseLastWin32Error; +end; +{$ENDIF ~XPLATFORM_RTL} + +{$IFNDEF RTL230_UP} +procedure CheckOSError(ErrorCode: Cardinal); +begin + if ErrorCode <> ERROR_SUCCESS then + {$IFDEF RTL170_UP} + RaiseLastOSError(ErrorCode); + {$ELSE ~RTL170_UP} + RaiseLastOSError; + {$ENDIF ~RTL170_UP} +end; +{$ENDIF RTL230_UP} + +{$OVERFLOWCHECKS OFF} + +function Addr64ToAddr32(const Value: TJclAddr64): TJclAddr32; +begin + if (Value shr 32) = 0 then + Result := Value + else + raise EJclAddr64Exception.CreateResFmt(@RsCantConvertAddr64, [HexPrefix, Value]); +end; + +function Addr32ToAddr64(const Value: TJclAddr32): TJclAddr64; +begin + Result := Value; +end; + +{$IFDEF OVERFLOWCHECKS_ON} +{$OVERFLOWCHECKS ON} +{$ENDIF OVERFLOWCHECKS_ON} + +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +//=== { TEquatable } ====================================================== + +function TEquatable.TestEquals(Other: T): Boolean; +begin + if Other = nil then + Result := False + else + Result := GetHashCode = Other.GetHashCode; +end; + +function TEquatable.TestEquals(A, B: T): Boolean; +begin + if A = nil then + Result := B = nil + else + if B = nil then + Result := False + else + Result := A.GetHashCode = B.GetHashCode; +end; + +function TEquatable.GetHashCode2(Obj: T): Integer; +begin + if Obj = nil then + Result := 0 + else + Result := Obj.GetHashCode; +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +procedure LoadAnsiReplacementCharacter; +{$IFDEF MSWINDOWS} +var + CpInfo: TCpInfo; +begin + CpInfo.MaxCharSize := 0; + if GetCPInfo(CP_ACP, CpInfo) then + AnsiReplacementCharacter := AnsiChar(Chr(CpInfo.DefaultChar[0])) + else + raise EJclInternalError.CreateRes(@RsEReplacementChar); +end; +{$ELSE ~MSWINDOWS} +begin + AnsiReplacementCharacter := '?'; +end; +{$ENDIF ~MSWINDOWS} + +{$IFDEF FPC} +// FPC emits a lot of warning because the first parameter of its internal +// GetMem is a var parameter, which is not initialized before the call to GetMem +procedure GetMem(out P; Size: Longint); +begin + Pointer(P) := nil; + GetMem(Pointer(P), Size); +end; +{$ENDIF FPC} + +initialization + + LoadAnsiReplacementCharacter; + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclBinaryTrees.pas b/3rdParty/JCL/source/common/JclBinaryTrees.pas new file mode 100644 index 00000000..ff7ed26c --- /dev/null +++ b/3rdParty/JCL/source/common/JclBinaryTrees.pas @@ -0,0 +1,21387 @@ +{**************************************************************************************************} +{ WARNING: JEDI preprocessor generated unit. Do not edit. } +{**************************************************************************************************} + +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is BinaryTree.pas. } +{ } +{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } +{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } +{ All rights reserved. } +{ } +{ Contributors: } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclBinaryTrees; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Classes, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclAbstractContainers, JclAlgorithms, JclContainerIntf, JclSynch; + +type + TItrStart = (isFirst, isLast, isRoot); + + TJclIntfBinaryNode = class + public + Value: IInterface; + Left: TJclIntfBinaryNode; + Right: TJclIntfBinaryNode; + Parent: TJclIntfBinaryNode; + end; + + TJclIntfBinaryTree = class(TJclIntfAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, + IJclIntfEqualityComparer, IJclIntfComparer, IJclIntfContainer, IJclIntfFlatContainer, + IJclIntfCollection, IJclIntfTree) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FMaxDepth: Integer; + FRoot: TJclIntfBinaryNode; + FTraverseOrder: TJclTraverseOrder; + function BuildTree(const LeafArray: array of TJclIntfBinaryNode; Left, Right: Integer; Parent: TJclIntfBinaryNode; + Offset: Integer): TJclIntfBinaryNode; + function CloneNode(Node, Parent: TJclIntfBinaryNode): TJclIntfBinaryNode; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + procedure AutoPack; override; + public + constructor Create(ACompare: TIntfCompare); + destructor Destroy; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclIntfCollection } + function Add(const AInterface: IInterface): Boolean; + function AddAll(const ACollection: IJclIntfCollection): Boolean; + procedure Clear; + function Contains(const AInterface: IInterface): Boolean; + function ContainsAll(const ACollection: IJclIntfCollection): Boolean; + function CollectionEquals(const ACollection: IJclIntfCollection): Boolean; + function Extract(const AInterface: IInterface): Boolean; + function ExtractAll(const ACollection: IJclIntfCollection): Boolean; + function First: IJclIntfIterator; + function IsEmpty: Boolean; + function Last: IJclIntfIterator; + function Remove(const AInterface: IInterface): Boolean; + function RemoveAll(const ACollection: IJclIntfCollection): Boolean; + function RetainAll(const ACollection: IJclIntfCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIntfIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclIntfTree } + function GetRoot: IJclIntfTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclIntfTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + TJclIntfBinaryTreeIterator = class(TJclAbstractIterator, IJclIntfIterator, IJclIntfTreeIterator, IJclIntfBinaryTreeIterator) + protected + FCursor: TJclIntfBinaryNode; + FStart: TItrStart; + FOwnTree: TJclIntfBinaryTree; + FEqualityComparer: IJclIntfEqualityComparer; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function GetNextCursor: TJclIntfBinaryNode; virtual; abstract; + function GetPreviousCursor: TJclIntfBinaryNode; virtual; abstract; + public + constructor Create(const AOwnTree: TJclIntfBinaryTree; ACursor: TJclIntfBinaryNode; AValid: Boolean; AStart: TItrStart); + { IJclIntfIterator } + function Add(const AInterface: IInterface): Boolean; + procedure Extract; + function GetObject: IInterface; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AInterface: IInterface): Boolean; + function IteratorEquals(const AIterator: IJclIntfIterator): Boolean; + function Next: IInterface; + function NextIndex: Integer; + function Previous: IInterface; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetObject(const AInterface: IInterface); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: IInterface read GetObject; + {$ENDIF SUPPORTS_FOR_IN} + { IJclIntfTreeIterator } + function AddChild(const AInterface: IInterface): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): IInterface; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(const AInterface: IInterface): Integer; + function InsertChild(Index: Integer; const AInterface: IInterface): Boolean; + function Parent: IInterface; + procedure SetChild(Index: Integer; const AInterface: IInterface); + { IJclIntfBinaryTreeIterator } + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: IInterface; + function Right: IInterface; + end; + + TJclPreOrderIntfBinaryTreeIterator = class(TJclIntfBinaryTreeIterator, IJclIntfIterator, IJclIntfTreeIterator, IJclIntfBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclIntfBinaryNode; override; + function GetPreviousCursor: TJclIntfBinaryNode; override; + end; + + TJclInOrderIntfBinaryTreeIterator = class(TJclIntfBinaryTreeIterator, IJclIntfIterator, IJclIntfTreeIterator, IJclIntfBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclIntfBinaryNode; override; + function GetPreviousCursor: TJclIntfBinaryNode; override; + end; + + TJclPostOrderIntfBinaryTreeIterator = class(TJclIntfBinaryTreeIterator, IJclIntfIterator, IJclIntfTreeIterator, IJclIntfBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclIntfBinaryNode; override; + function GetPreviousCursor: TJclIntfBinaryNode; override; + end; + + TJclAnsiStrBinaryNode = class + public + Value: AnsiString; + Left: TJclAnsiStrBinaryNode; + Right: TJclAnsiStrBinaryNode; + Parent: TJclAnsiStrBinaryNode; + end; + + TJclAnsiStrBinaryTree = class(TJclAnsiStrAbstractCollection, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, + IJclAnsiStrEqualityComparer, IJclAnsiStrComparer, IJclAnsiStrContainer, IJclAnsiStrFlatContainer, IJclStrBaseContainer, + IJclAnsiStrCollection, IJclAnsiStrTree) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FMaxDepth: Integer; + FRoot: TJclAnsiStrBinaryNode; + FTraverseOrder: TJclTraverseOrder; + function BuildTree(const LeafArray: array of TJclAnsiStrBinaryNode; Left, Right: Integer; Parent: TJclAnsiStrBinaryNode; + Offset: Integer): TJclAnsiStrBinaryNode; + function CloneNode(Node, Parent: TJclAnsiStrBinaryNode): TJclAnsiStrBinaryNode; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + procedure AutoPack; override; + public + constructor Create(ACompare: TAnsiStrCompare); + destructor Destroy; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclAnsiStrCollection } + function Add(const AString: AnsiString): Boolean; override; + function AddAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + procedure Clear; override; + function Contains(const AString: AnsiString): Boolean; override; + function ContainsAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + function CollectionEquals(const ACollection: IJclAnsiStrCollection): Boolean; override; + function Extract(const AString: AnsiString): Boolean; override; + function ExtractAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + function First: IJclAnsiStrIterator; override; + function IsEmpty: Boolean; override; + function Last: IJclAnsiStrIterator; override; + function Remove(const AString: AnsiString): Boolean; override; + function RemoveAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + function RetainAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + function Size: Integer; override; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclAnsiStrIterator; override; + {$ENDIF SUPPORTS_FOR_IN} + { IJclAnsiStrTree } + function GetRoot: IJclAnsiStrTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclAnsiStrTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + TJclAnsiStrBinaryTreeIterator = class(TJclAbstractIterator, IJclAnsiStrIterator, IJclAnsiStrTreeIterator, IJclAnsiStrBinaryTreeIterator) + protected + FCursor: TJclAnsiStrBinaryNode; + FStart: TItrStart; + FOwnTree: TJclAnsiStrBinaryTree; + FEqualityComparer: IJclAnsiStrEqualityComparer; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function GetNextCursor: TJclAnsiStrBinaryNode; virtual; abstract; + function GetPreviousCursor: TJclAnsiStrBinaryNode; virtual; abstract; + public + constructor Create(const AOwnTree: TJclAnsiStrBinaryTree; ACursor: TJclAnsiStrBinaryNode; AValid: Boolean; AStart: TItrStart); + { IJclAnsiStrIterator } + function Add(const AString: AnsiString): Boolean; + procedure Extract; + function GetString: AnsiString; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AString: AnsiString): Boolean; + function IteratorEquals(const AIterator: IJclAnsiStrIterator): Boolean; + function Next: AnsiString; + function NextIndex: Integer; + function Previous: AnsiString; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetString(const AString: AnsiString); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: AnsiString read GetString; + {$ENDIF SUPPORTS_FOR_IN} + { IJclAnsiStrTreeIterator } + function AddChild(const AString: AnsiString): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): AnsiString; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(const AString: AnsiString): Integer; + function InsertChild(Index: Integer; const AString: AnsiString): Boolean; + function Parent: AnsiString; + procedure SetChild(Index: Integer; const AString: AnsiString); + { IJclAnsiStrBinaryTreeIterator } + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: AnsiString; + function Right: AnsiString; + end; + + TJclPreOrderAnsiStrBinaryTreeIterator = class(TJclAnsiStrBinaryTreeIterator, IJclAnsiStrIterator, IJclAnsiStrTreeIterator, IJclAnsiStrBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclAnsiStrBinaryNode; override; + function GetPreviousCursor: TJclAnsiStrBinaryNode; override; + end; + + TJclInOrderAnsiStrBinaryTreeIterator = class(TJclAnsiStrBinaryTreeIterator, IJclAnsiStrIterator, IJclAnsiStrTreeIterator, IJclAnsiStrBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclAnsiStrBinaryNode; override; + function GetPreviousCursor: TJclAnsiStrBinaryNode; override; + end; + + TJclPostOrderAnsiStrBinaryTreeIterator = class(TJclAnsiStrBinaryTreeIterator, IJclAnsiStrIterator, IJclAnsiStrTreeIterator, IJclAnsiStrBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclAnsiStrBinaryNode; override; + function GetPreviousCursor: TJclAnsiStrBinaryNode; override; + end; + + TJclWideStrBinaryNode = class + public + Value: WideString; + Left: TJclWideStrBinaryNode; + Right: TJclWideStrBinaryNode; + Parent: TJclWideStrBinaryNode; + end; + + TJclWideStrBinaryTree = class(TJclWideStrAbstractCollection, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, + IJclWideStrEqualityComparer, IJclWideStrComparer, IJclWideStrContainer, IJclWideStrFlatContainer, IJclStrBaseContainer, + IJclWideStrCollection, IJclWideStrTree) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FMaxDepth: Integer; + FRoot: TJclWideStrBinaryNode; + FTraverseOrder: TJclTraverseOrder; + function BuildTree(const LeafArray: array of TJclWideStrBinaryNode; Left, Right: Integer; Parent: TJclWideStrBinaryNode; + Offset: Integer): TJclWideStrBinaryNode; + function CloneNode(Node, Parent: TJclWideStrBinaryNode): TJclWideStrBinaryNode; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + procedure AutoPack; override; + public + constructor Create(ACompare: TWideStrCompare); + destructor Destroy; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclWideStrCollection } + function Add(const AString: WideString): Boolean; override; + function AddAll(const ACollection: IJclWideStrCollection): Boolean; override; + procedure Clear; override; + function Contains(const AString: WideString): Boolean; override; + function ContainsAll(const ACollection: IJclWideStrCollection): Boolean; override; + function CollectionEquals(const ACollection: IJclWideStrCollection): Boolean; override; + function Extract(const AString: WideString): Boolean; override; + function ExtractAll(const ACollection: IJclWideStrCollection): Boolean; override; + function First: IJclWideStrIterator; override; + function IsEmpty: Boolean; override; + function Last: IJclWideStrIterator; override; + function Remove(const AString: WideString): Boolean; override; + function RemoveAll(const ACollection: IJclWideStrCollection): Boolean; override; + function RetainAll(const ACollection: IJclWideStrCollection): Boolean; override; + function Size: Integer; override; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclWideStrIterator; override; + {$ENDIF SUPPORTS_FOR_IN} + { IJclWideStrTree } + function GetRoot: IJclWideStrTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclWideStrTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + TJclWideStrBinaryTreeIterator = class(TJclAbstractIterator, IJclWideStrIterator, IJclWideStrTreeIterator, IJclWideStrBinaryTreeIterator) + protected + FCursor: TJclWideStrBinaryNode; + FStart: TItrStart; + FOwnTree: TJclWideStrBinaryTree; + FEqualityComparer: IJclWideStrEqualityComparer; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function GetNextCursor: TJclWideStrBinaryNode; virtual; abstract; + function GetPreviousCursor: TJclWideStrBinaryNode; virtual; abstract; + public + constructor Create(const AOwnTree: TJclWideStrBinaryTree; ACursor: TJclWideStrBinaryNode; AValid: Boolean; AStart: TItrStart); + { IJclWideStrIterator } + function Add(const AString: WideString): Boolean; + procedure Extract; + function GetString: WideString; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AString: WideString): Boolean; + function IteratorEquals(const AIterator: IJclWideStrIterator): Boolean; + function Next: WideString; + function NextIndex: Integer; + function Previous: WideString; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetString(const AString: WideString); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: WideString read GetString; + {$ENDIF SUPPORTS_FOR_IN} + { IJclWideStrTreeIterator } + function AddChild(const AString: WideString): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): WideString; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(const AString: WideString): Integer; + function InsertChild(Index: Integer; const AString: WideString): Boolean; + function Parent: WideString; + procedure SetChild(Index: Integer; const AString: WideString); + { IJclWideStrBinaryTreeIterator } + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: WideString; + function Right: WideString; + end; + + TJclPreOrderWideStrBinaryTreeIterator = class(TJclWideStrBinaryTreeIterator, IJclWideStrIterator, IJclWideStrTreeIterator, IJclWideStrBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclWideStrBinaryNode; override; + function GetPreviousCursor: TJclWideStrBinaryNode; override; + end; + + TJclInOrderWideStrBinaryTreeIterator = class(TJclWideStrBinaryTreeIterator, IJclWideStrIterator, IJclWideStrTreeIterator, IJclWideStrBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclWideStrBinaryNode; override; + function GetPreviousCursor: TJclWideStrBinaryNode; override; + end; + + TJclPostOrderWideStrBinaryTreeIterator = class(TJclWideStrBinaryTreeIterator, IJclWideStrIterator, IJclWideStrTreeIterator, IJclWideStrBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclWideStrBinaryNode; override; + function GetPreviousCursor: TJclWideStrBinaryNode; override; + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclUnicodeStrBinaryNode = class + public + Value: UnicodeString; + Left: TJclUnicodeStrBinaryNode; + Right: TJclUnicodeStrBinaryNode; + Parent: TJclUnicodeStrBinaryNode; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclUnicodeStrBinaryTree = class(TJclUnicodeStrAbstractCollection, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, + IJclUnicodeStrEqualityComparer, IJclUnicodeStrComparer, IJclUnicodeStrContainer, IJclUnicodeStrFlatContainer, IJclStrBaseContainer, + IJclUnicodeStrCollection, IJclUnicodeStrTree) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FMaxDepth: Integer; + FRoot: TJclUnicodeStrBinaryNode; + FTraverseOrder: TJclTraverseOrder; + function BuildTree(const LeafArray: array of TJclUnicodeStrBinaryNode; Left, Right: Integer; Parent: TJclUnicodeStrBinaryNode; + Offset: Integer): TJclUnicodeStrBinaryNode; + function CloneNode(Node, Parent: TJclUnicodeStrBinaryNode): TJclUnicodeStrBinaryNode; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + procedure AutoPack; override; + public + constructor Create(ACompare: TUnicodeStrCompare); + destructor Destroy; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclUnicodeStrCollection } + function Add(const AString: UnicodeString): Boolean; override; + function AddAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + procedure Clear; override; + function Contains(const AString: UnicodeString): Boolean; override; + function ContainsAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function CollectionEquals(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function Extract(const AString: UnicodeString): Boolean; override; + function ExtractAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function First: IJclUnicodeStrIterator; override; + function IsEmpty: Boolean; override; + function Last: IJclUnicodeStrIterator; override; + function Remove(const AString: UnicodeString): Boolean; override; + function RemoveAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function RetainAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function Size: Integer; override; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclUnicodeStrIterator; override; + {$ENDIF SUPPORTS_FOR_IN} + { IJclUnicodeStrTree } + function GetRoot: IJclUnicodeStrTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclUnicodeStrTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclUnicodeStrBinaryTreeIterator = class(TJclAbstractIterator, IJclUnicodeStrIterator, IJclUnicodeStrTreeIterator, IJclUnicodeStrBinaryTreeIterator) + protected + FCursor: TJclUnicodeStrBinaryNode; + FStart: TItrStart; + FOwnTree: TJclUnicodeStrBinaryTree; + FEqualityComparer: IJclUnicodeStrEqualityComparer; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function GetNextCursor: TJclUnicodeStrBinaryNode; virtual; abstract; + function GetPreviousCursor: TJclUnicodeStrBinaryNode; virtual; abstract; + public + constructor Create(const AOwnTree: TJclUnicodeStrBinaryTree; ACursor: TJclUnicodeStrBinaryNode; AValid: Boolean; AStart: TItrStart); + { IJclUnicodeStrIterator } + function Add(const AString: UnicodeString): Boolean; + procedure Extract; + function GetString: UnicodeString; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AString: UnicodeString): Boolean; + function IteratorEquals(const AIterator: IJclUnicodeStrIterator): Boolean; + function Next: UnicodeString; + function NextIndex: Integer; + function Previous: UnicodeString; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetString(const AString: UnicodeString); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: UnicodeString read GetString; + {$ENDIF SUPPORTS_FOR_IN} + { IJclUnicodeStrTreeIterator } + function AddChild(const AString: UnicodeString): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): UnicodeString; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(const AString: UnicodeString): Integer; + function InsertChild(Index: Integer; const AString: UnicodeString): Boolean; + function Parent: UnicodeString; + procedure SetChild(Index: Integer; const AString: UnicodeString); + { IJclUnicodeStrBinaryTreeIterator } + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: UnicodeString; + function Right: UnicodeString; + end; + + TJclPreOrderUnicodeStrBinaryTreeIterator = class(TJclUnicodeStrBinaryTreeIterator, IJclUnicodeStrIterator, IJclUnicodeStrTreeIterator, IJclUnicodeStrBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclUnicodeStrBinaryNode; override; + function GetPreviousCursor: TJclUnicodeStrBinaryNode; override; + end; + + TJclInOrderUnicodeStrBinaryTreeIterator = class(TJclUnicodeStrBinaryTreeIterator, IJclUnicodeStrIterator, IJclUnicodeStrTreeIterator, IJclUnicodeStrBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclUnicodeStrBinaryNode; override; + function GetPreviousCursor: TJclUnicodeStrBinaryNode; override; + end; + + TJclPostOrderUnicodeStrBinaryTreeIterator = class(TJclUnicodeStrBinaryTreeIterator, IJclUnicodeStrIterator, IJclUnicodeStrTreeIterator, IJclUnicodeStrBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclUnicodeStrBinaryNode; override; + function GetPreviousCursor: TJclUnicodeStrBinaryNode; override; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + TJclStrBinaryNode = TJclAnsiStrBinaryNode; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TJclStrBinaryNode = TJclWideStrBinaryNode; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TJclStrBinaryNode = TJclUnicodeStrBinaryNode; + {$ENDIF CONTAINER_UNICODESTR} + + {$IFDEF CONTAINER_ANSISTR} + TJclStrBinaryTree = TJclAnsiStrBinaryTree; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TJclStrBinaryTree = TJclWideStrBinaryTree; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TJclStrBinaryTree = TJclUnicodeStrBinaryTree; + {$ENDIF CONTAINER_UNICODESTR} + + {$IFDEF CONTAINER_ANSISTR} + TJclStrBinaryTreeIterator = TJclAnsiStrBinaryTreeIterator; + TJclPreOrderStrBinaryTreeIterator = TJclPreOrderAnsiStrBinaryTreeIterator; + TJclInOrderStrBinaryTreeIterator = TJclInOrderAnsiStrBinaryTreeIterator; + TJclPostOrderStrBinaryTreeIterator = TJclPostOrderAnsiStrBinaryTreeIterator; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TJclStrBinaryTreeIterator = TJclWideStrBinaryTreeIterator; + TJclPreOrderStrBinaryTreeIterator = TJclPreOrderWideStrBinaryTreeIterator; + TJclInOrderStrBinaryTreeIterator = TJclInOrderWideStrBinaryTreeIterator; + TJclPostOrderStrBinaryTreeIterator = TJclPostOrderWideStrBinaryTreeIterator; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TJclStrBinaryTreeIterator = TJclUnicodeStrBinaryTreeIterator; + TJclPreOrderStrBinaryTreeIterator = TJclPreOrderUnicodeStrBinaryTreeIterator; + TJclInOrderStrBinaryTreeIterator = TJclInOrderUnicodeStrBinaryTreeIterator; + TJclPostOrderStrBinaryTreeIterator = TJclPostOrderUnicodeStrBinaryTreeIterator; + {$ENDIF CONTAINER_UNICODESTR} + + TJclSingleBinaryNode = class + public + Value: Single; + Left: TJclSingleBinaryNode; + Right: TJclSingleBinaryNode; + Parent: TJclSingleBinaryNode; + end; + + TJclSingleBinaryTree = class(TJclSingleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, + IJclSingleEqualityComparer, IJclSingleComparer, IJclSingleContainer, IJclSingleFlatContainer, + IJclSingleCollection, IJclSingleTree) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FMaxDepth: Integer; + FRoot: TJclSingleBinaryNode; + FTraverseOrder: TJclTraverseOrder; + function BuildTree(const LeafArray: array of TJclSingleBinaryNode; Left, Right: Integer; Parent: TJclSingleBinaryNode; + Offset: Integer): TJclSingleBinaryNode; + function CloneNode(Node, Parent: TJclSingleBinaryNode): TJclSingleBinaryNode; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + procedure AutoPack; override; + public + constructor Create(ACompare: TSingleCompare); + destructor Destroy; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclSingleCollection } + function Add(const AValue: Single): Boolean; + function AddAll(const ACollection: IJclSingleCollection): Boolean; + procedure Clear; + function Contains(const AValue: Single): Boolean; + function ContainsAll(const ACollection: IJclSingleCollection): Boolean; + function CollectionEquals(const ACollection: IJclSingleCollection): Boolean; + function Extract(const AValue: Single): Boolean; + function ExtractAll(const ACollection: IJclSingleCollection): Boolean; + function First: IJclSingleIterator; + function IsEmpty: Boolean; + function Last: IJclSingleIterator; + function Remove(const AValue: Single): Boolean; + function RemoveAll(const ACollection: IJclSingleCollection): Boolean; + function RetainAll(const ACollection: IJclSingleCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclSingleIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclSingleTree } + function GetRoot: IJclSingleTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclSingleTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + TJclSingleBinaryTreeIterator = class(TJclAbstractIterator, IJclSingleIterator, IJclSingleTreeIterator, IJclSingleBinaryTreeIterator) + protected + FCursor: TJclSingleBinaryNode; + FStart: TItrStart; + FOwnTree: TJclSingleBinaryTree; + FEqualityComparer: IJclSingleEqualityComparer; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function GetNextCursor: TJclSingleBinaryNode; virtual; abstract; + function GetPreviousCursor: TJclSingleBinaryNode; virtual; abstract; + public + constructor Create(const AOwnTree: TJclSingleBinaryTree; ACursor: TJclSingleBinaryNode; AValid: Boolean; AStart: TItrStart); + { IJclSingleIterator } + function Add(const AValue: Single): Boolean; + procedure Extract; + function GetValue: Single; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AValue: Single): Boolean; + function IteratorEquals(const AIterator: IJclSingleIterator): Boolean; + function Next: Single; + function NextIndex: Integer; + function Previous: Single; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(const AValue: Single); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Single read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + { IJclSingleTreeIterator } + function AddChild(const AValue: Single): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): Single; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(const AValue: Single): Integer; + function InsertChild(Index: Integer; const AValue: Single): Boolean; + function Parent: Single; + procedure SetChild(Index: Integer; const AValue: Single); + { IJclSingleBinaryTreeIterator } + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: Single; + function Right: Single; + end; + + TJclPreOrderSingleBinaryTreeIterator = class(TJclSingleBinaryTreeIterator, IJclSingleIterator, IJclSingleTreeIterator, IJclSingleBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclSingleBinaryNode; override; + function GetPreviousCursor: TJclSingleBinaryNode; override; + end; + + TJclInOrderSingleBinaryTreeIterator = class(TJclSingleBinaryTreeIterator, IJclSingleIterator, IJclSingleTreeIterator, IJclSingleBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclSingleBinaryNode; override; + function GetPreviousCursor: TJclSingleBinaryNode; override; + end; + + TJclPostOrderSingleBinaryTreeIterator = class(TJclSingleBinaryTreeIterator, IJclSingleIterator, IJclSingleTreeIterator, IJclSingleBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclSingleBinaryNode; override; + function GetPreviousCursor: TJclSingleBinaryNode; override; + end; + + TJclDoubleBinaryNode = class + public + Value: Double; + Left: TJclDoubleBinaryNode; + Right: TJclDoubleBinaryNode; + Parent: TJclDoubleBinaryNode; + end; + + TJclDoubleBinaryTree = class(TJclDoubleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, + IJclDoubleEqualityComparer, IJclDoubleComparer, IJclDoubleContainer, IJclDoubleFlatContainer, + IJclDoubleCollection, IJclDoubleTree) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FMaxDepth: Integer; + FRoot: TJclDoubleBinaryNode; + FTraverseOrder: TJclTraverseOrder; + function BuildTree(const LeafArray: array of TJclDoubleBinaryNode; Left, Right: Integer; Parent: TJclDoubleBinaryNode; + Offset: Integer): TJclDoubleBinaryNode; + function CloneNode(Node, Parent: TJclDoubleBinaryNode): TJclDoubleBinaryNode; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + procedure AutoPack; override; + public + constructor Create(ACompare: TDoubleCompare); + destructor Destroy; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclDoubleCollection } + function Add(const AValue: Double): Boolean; + function AddAll(const ACollection: IJclDoubleCollection): Boolean; + procedure Clear; + function Contains(const AValue: Double): Boolean; + function ContainsAll(const ACollection: IJclDoubleCollection): Boolean; + function CollectionEquals(const ACollection: IJclDoubleCollection): Boolean; + function Extract(const AValue: Double): Boolean; + function ExtractAll(const ACollection: IJclDoubleCollection): Boolean; + function First: IJclDoubleIterator; + function IsEmpty: Boolean; + function Last: IJclDoubleIterator; + function Remove(const AValue: Double): Boolean; + function RemoveAll(const ACollection: IJclDoubleCollection): Boolean; + function RetainAll(const ACollection: IJclDoubleCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclDoubleIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclDoubleTree } + function GetRoot: IJclDoubleTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclDoubleTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + TJclDoubleBinaryTreeIterator = class(TJclAbstractIterator, IJclDoubleIterator, IJclDoubleTreeIterator, IJclDoubleBinaryTreeIterator) + protected + FCursor: TJclDoubleBinaryNode; + FStart: TItrStart; + FOwnTree: TJclDoubleBinaryTree; + FEqualityComparer: IJclDoubleEqualityComparer; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function GetNextCursor: TJclDoubleBinaryNode; virtual; abstract; + function GetPreviousCursor: TJclDoubleBinaryNode; virtual; abstract; + public + constructor Create(const AOwnTree: TJclDoubleBinaryTree; ACursor: TJclDoubleBinaryNode; AValid: Boolean; AStart: TItrStart); + { IJclDoubleIterator } + function Add(const AValue: Double): Boolean; + procedure Extract; + function GetValue: Double; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AValue: Double): Boolean; + function IteratorEquals(const AIterator: IJclDoubleIterator): Boolean; + function Next: Double; + function NextIndex: Integer; + function Previous: Double; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(const AValue: Double); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Double read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + { IJclDoubleTreeIterator } + function AddChild(const AValue: Double): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): Double; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(const AValue: Double): Integer; + function InsertChild(Index: Integer; const AValue: Double): Boolean; + function Parent: Double; + procedure SetChild(Index: Integer; const AValue: Double); + { IJclDoubleBinaryTreeIterator } + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: Double; + function Right: Double; + end; + + TJclPreOrderDoubleBinaryTreeIterator = class(TJclDoubleBinaryTreeIterator, IJclDoubleIterator, IJclDoubleTreeIterator, IJclDoubleBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclDoubleBinaryNode; override; + function GetPreviousCursor: TJclDoubleBinaryNode; override; + end; + + TJclInOrderDoubleBinaryTreeIterator = class(TJclDoubleBinaryTreeIterator, IJclDoubleIterator, IJclDoubleTreeIterator, IJclDoubleBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclDoubleBinaryNode; override; + function GetPreviousCursor: TJclDoubleBinaryNode; override; + end; + + TJclPostOrderDoubleBinaryTreeIterator = class(TJclDoubleBinaryTreeIterator, IJclDoubleIterator, IJclDoubleTreeIterator, IJclDoubleBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclDoubleBinaryNode; override; + function GetPreviousCursor: TJclDoubleBinaryNode; override; + end; + + TJclExtendedBinaryNode = class + public + Value: Extended; + Left: TJclExtendedBinaryNode; + Right: TJclExtendedBinaryNode; + Parent: TJclExtendedBinaryNode; + end; + + TJclExtendedBinaryTree = class(TJclExtendedAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, + IJclExtendedEqualityComparer, IJclExtendedComparer, IJclExtendedContainer, IJclExtendedFlatContainer, + IJclExtendedCollection, IJclExtendedTree) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FMaxDepth: Integer; + FRoot: TJclExtendedBinaryNode; + FTraverseOrder: TJclTraverseOrder; + function BuildTree(const LeafArray: array of TJclExtendedBinaryNode; Left, Right: Integer; Parent: TJclExtendedBinaryNode; + Offset: Integer): TJclExtendedBinaryNode; + function CloneNode(Node, Parent: TJclExtendedBinaryNode): TJclExtendedBinaryNode; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + procedure AutoPack; override; + public + constructor Create(ACompare: TExtendedCompare); + destructor Destroy; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclExtendedCollection } + function Add(const AValue: Extended): Boolean; + function AddAll(const ACollection: IJclExtendedCollection): Boolean; + procedure Clear; + function Contains(const AValue: Extended): Boolean; + function ContainsAll(const ACollection: IJclExtendedCollection): Boolean; + function CollectionEquals(const ACollection: IJclExtendedCollection): Boolean; + function Extract(const AValue: Extended): Boolean; + function ExtractAll(const ACollection: IJclExtendedCollection): Boolean; + function First: IJclExtendedIterator; + function IsEmpty: Boolean; + function Last: IJclExtendedIterator; + function Remove(const AValue: Extended): Boolean; + function RemoveAll(const ACollection: IJclExtendedCollection): Boolean; + function RetainAll(const ACollection: IJclExtendedCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclExtendedIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclExtendedTree } + function GetRoot: IJclExtendedTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclExtendedTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + TJclExtendedBinaryTreeIterator = class(TJclAbstractIterator, IJclExtendedIterator, IJclExtendedTreeIterator, IJclExtendedBinaryTreeIterator) + protected + FCursor: TJclExtendedBinaryNode; + FStart: TItrStart; + FOwnTree: TJclExtendedBinaryTree; + FEqualityComparer: IJclExtendedEqualityComparer; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function GetNextCursor: TJclExtendedBinaryNode; virtual; abstract; + function GetPreviousCursor: TJclExtendedBinaryNode; virtual; abstract; + public + constructor Create(const AOwnTree: TJclExtendedBinaryTree; ACursor: TJclExtendedBinaryNode; AValid: Boolean; AStart: TItrStart); + { IJclExtendedIterator } + function Add(const AValue: Extended): Boolean; + procedure Extract; + function GetValue: Extended; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AValue: Extended): Boolean; + function IteratorEquals(const AIterator: IJclExtendedIterator): Boolean; + function Next: Extended; + function NextIndex: Integer; + function Previous: Extended; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(const AValue: Extended); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Extended read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + { IJclExtendedTreeIterator } + function AddChild(const AValue: Extended): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): Extended; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(const AValue: Extended): Integer; + function InsertChild(Index: Integer; const AValue: Extended): Boolean; + function Parent: Extended; + procedure SetChild(Index: Integer; const AValue: Extended); + { IJclExtendedBinaryTreeIterator } + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: Extended; + function Right: Extended; + end; + + TJclPreOrderExtendedBinaryTreeIterator = class(TJclExtendedBinaryTreeIterator, IJclExtendedIterator, IJclExtendedTreeIterator, IJclExtendedBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclExtendedBinaryNode; override; + function GetPreviousCursor: TJclExtendedBinaryNode; override; + end; + + TJclInOrderExtendedBinaryTreeIterator = class(TJclExtendedBinaryTreeIterator, IJclExtendedIterator, IJclExtendedTreeIterator, IJclExtendedBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclExtendedBinaryNode; override; + function GetPreviousCursor: TJclExtendedBinaryNode; override; + end; + + TJclPostOrderExtendedBinaryTreeIterator = class(TJclExtendedBinaryTreeIterator, IJclExtendedIterator, IJclExtendedTreeIterator, IJclExtendedBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclExtendedBinaryNode; override; + function GetPreviousCursor: TJclExtendedBinaryNode; override; + end; + + {$IFDEF MATH_SINGLE_PRECISION} + TJclFloatBinaryNode = TJclSingleBinaryNode; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TJclFloatBinaryNode = TJclDoubleBinaryNode; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TJclFloatBinaryNode = TJclExtendedBinaryNode; + {$ENDIF MATH_EXTENDED_PRECISION} + + {$IFDEF MATH_SINGLE_PRECISION} + TJclFloatBinaryTree = TJclSingleBinaryTree; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TJclFloatBinaryTree = TJclDoubleBinaryTree; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TJclFloatBinaryTree = TJclExtendedBinaryTree; + {$ENDIF MATH_EXTENDED_PRECISION} + + {$IFDEF MATH_SINGLE_PRECISION} + TJclFloatBinaryTreeIterator = TJclSingleBinaryTreeIterator; + TJclPreOrderFloatBinaryTreeIterator = TJclPreOrderSingleBinaryTreeIterator; + TJclInOrderFloatBinaryTreeIterator = TJclInOrderSingleBinaryTreeIterator; + TJclPostOrderFloatBinaryTreeIterator = TJclPostOrderSingleBinaryTreeIterator; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TJclFloatBinaryTreeIterator = TJclDoubleBinaryTreeIterator; + TJclPreOrderFloatBinaryTreeIterator = TJclPreOrderDoubleBinaryTreeIterator; + TJclInOrderFloatBinaryTreeIterator = TJclInOrderDoubleBinaryTreeIterator; + TJclPostOrderFloatBinaryTreeIterator = TJclPostOrderDoubleBinaryTreeIterator; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TJclFloatBinaryTreeIterator = TJclExtendedBinaryTreeIterator; + TJclPreOrderFloatBinaryTreeIterator = TJclPreOrderExtendedBinaryTreeIterator; + TJclInOrderFloatBinaryTreeIterator = TJclInOrderExtendedBinaryTreeIterator; + TJclPostOrderFloatBinaryTreeIterator = TJclPostOrderExtendedBinaryTreeIterator; + {$ENDIF MATH_EXTENDED_PRECISION} + + TJclIntegerBinaryNode = class + public + Value: Integer; + Left: TJclIntegerBinaryNode; + Right: TJclIntegerBinaryNode; + Parent: TJclIntegerBinaryNode; + end; + + TJclIntegerBinaryTree = class(TJclIntegerAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, + IJclIntegerEqualityComparer, IJclIntegerComparer, IJclIntegerContainer, IJclIntegerFlatContainer, + IJclIntegerCollection, IJclIntegerTree) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FMaxDepth: Integer; + FRoot: TJclIntegerBinaryNode; + FTraverseOrder: TJclTraverseOrder; + function BuildTree(const LeafArray: array of TJclIntegerBinaryNode; Left, Right: Integer; Parent: TJclIntegerBinaryNode; + Offset: Integer): TJclIntegerBinaryNode; + function CloneNode(Node, Parent: TJclIntegerBinaryNode): TJclIntegerBinaryNode; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + procedure AutoPack; override; + public + constructor Create(ACompare: TIntegerCompare); + destructor Destroy; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclIntegerCollection } + function Add(AValue: Integer): Boolean; + function AddAll(const ACollection: IJclIntegerCollection): Boolean; + procedure Clear; + function Contains(AValue: Integer): Boolean; + function ContainsAll(const ACollection: IJclIntegerCollection): Boolean; + function CollectionEquals(const ACollection: IJclIntegerCollection): Boolean; + function Extract(AValue: Integer): Boolean; + function ExtractAll(const ACollection: IJclIntegerCollection): Boolean; + function First: IJclIntegerIterator; + function IsEmpty: Boolean; + function Last: IJclIntegerIterator; + function Remove(AValue: Integer): Boolean; + function RemoveAll(const ACollection: IJclIntegerCollection): Boolean; + function RetainAll(const ACollection: IJclIntegerCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIntegerIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclIntegerTree } + function GetRoot: IJclIntegerTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclIntegerTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + TJclIntegerBinaryTreeIterator = class(TJclAbstractIterator, IJclIntegerIterator, IJclIntegerTreeIterator, IJclIntegerBinaryTreeIterator) + protected + FCursor: TJclIntegerBinaryNode; + FStart: TItrStart; + FOwnTree: TJclIntegerBinaryTree; + FEqualityComparer: IJclIntegerEqualityComparer; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function GetNextCursor: TJclIntegerBinaryNode; virtual; abstract; + function GetPreviousCursor: TJclIntegerBinaryNode; virtual; abstract; + public + constructor Create(const AOwnTree: TJclIntegerBinaryTree; ACursor: TJclIntegerBinaryNode; AValid: Boolean; AStart: TItrStart); + { IJclIntegerIterator } + function Add(AValue: Integer): Boolean; + procedure Extract; + function GetValue: Integer; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(AValue: Integer): Boolean; + function IteratorEquals(const AIterator: IJclIntegerIterator): Boolean; + function Next: Integer; + function NextIndex: Integer; + function Previous: Integer; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(AValue: Integer); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Integer read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + { IJclIntegerTreeIterator } + function AddChild(AValue: Integer): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): Integer; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(AValue: Integer): Integer; + function InsertChild(Index: Integer; AValue: Integer): Boolean; + function Parent: Integer; + procedure SetChild(Index: Integer; AValue: Integer); + { IJclIntegerBinaryTreeIterator } + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: Integer; + function Right: Integer; + end; + + TJclPreOrderIntegerBinaryTreeIterator = class(TJclIntegerBinaryTreeIterator, IJclIntegerIterator, IJclIntegerTreeIterator, IJclIntegerBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclIntegerBinaryNode; override; + function GetPreviousCursor: TJclIntegerBinaryNode; override; + end; + + TJclInOrderIntegerBinaryTreeIterator = class(TJclIntegerBinaryTreeIterator, IJclIntegerIterator, IJclIntegerTreeIterator, IJclIntegerBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclIntegerBinaryNode; override; + function GetPreviousCursor: TJclIntegerBinaryNode; override; + end; + + TJclPostOrderIntegerBinaryTreeIterator = class(TJclIntegerBinaryTreeIterator, IJclIntegerIterator, IJclIntegerTreeIterator, IJclIntegerBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclIntegerBinaryNode; override; + function GetPreviousCursor: TJclIntegerBinaryNode; override; + end; + + TJclCardinalBinaryNode = class + public + Value: Cardinal; + Left: TJclCardinalBinaryNode; + Right: TJclCardinalBinaryNode; + Parent: TJclCardinalBinaryNode; + end; + + TJclCardinalBinaryTree = class(TJclCardinalAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, + IJclCardinalEqualityComparer, IJclCardinalComparer, IJclCardinalContainer, IJclCardinalFlatContainer, + IJclCardinalCollection, IJclCardinalTree) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FMaxDepth: Integer; + FRoot: TJclCardinalBinaryNode; + FTraverseOrder: TJclTraverseOrder; + function BuildTree(const LeafArray: array of TJclCardinalBinaryNode; Left, Right: Integer; Parent: TJclCardinalBinaryNode; + Offset: Integer): TJclCardinalBinaryNode; + function CloneNode(Node, Parent: TJclCardinalBinaryNode): TJclCardinalBinaryNode; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + procedure AutoPack; override; + public + constructor Create(ACompare: TCardinalCompare); + destructor Destroy; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclCardinalCollection } + function Add(AValue: Cardinal): Boolean; + function AddAll(const ACollection: IJclCardinalCollection): Boolean; + procedure Clear; + function Contains(AValue: Cardinal): Boolean; + function ContainsAll(const ACollection: IJclCardinalCollection): Boolean; + function CollectionEquals(const ACollection: IJclCardinalCollection): Boolean; + function Extract(AValue: Cardinal): Boolean; + function ExtractAll(const ACollection: IJclCardinalCollection): Boolean; + function First: IJclCardinalIterator; + function IsEmpty: Boolean; + function Last: IJclCardinalIterator; + function Remove(AValue: Cardinal): Boolean; + function RemoveAll(const ACollection: IJclCardinalCollection): Boolean; + function RetainAll(const ACollection: IJclCardinalCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclCardinalIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclCardinalTree } + function GetRoot: IJclCardinalTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclCardinalTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + TJclCardinalBinaryTreeIterator = class(TJclAbstractIterator, IJclCardinalIterator, IJclCardinalTreeIterator, IJclCardinalBinaryTreeIterator) + protected + FCursor: TJclCardinalBinaryNode; + FStart: TItrStart; + FOwnTree: TJclCardinalBinaryTree; + FEqualityComparer: IJclCardinalEqualityComparer; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function GetNextCursor: TJclCardinalBinaryNode; virtual; abstract; + function GetPreviousCursor: TJclCardinalBinaryNode; virtual; abstract; + public + constructor Create(const AOwnTree: TJclCardinalBinaryTree; ACursor: TJclCardinalBinaryNode; AValid: Boolean; AStart: TItrStart); + { IJclCardinalIterator } + function Add(AValue: Cardinal): Boolean; + procedure Extract; + function GetValue: Cardinal; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(AValue: Cardinal): Boolean; + function IteratorEquals(const AIterator: IJclCardinalIterator): Boolean; + function Next: Cardinal; + function NextIndex: Integer; + function Previous: Cardinal; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(AValue: Cardinal); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Cardinal read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + { IJclCardinalTreeIterator } + function AddChild(AValue: Cardinal): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): Cardinal; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(AValue: Cardinal): Integer; + function InsertChild(Index: Integer; AValue: Cardinal): Boolean; + function Parent: Cardinal; + procedure SetChild(Index: Integer; AValue: Cardinal); + { IJclCardinalBinaryTreeIterator } + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: Cardinal; + function Right: Cardinal; + end; + + TJclPreOrderCardinalBinaryTreeIterator = class(TJclCardinalBinaryTreeIterator, IJclCardinalIterator, IJclCardinalTreeIterator, IJclCardinalBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclCardinalBinaryNode; override; + function GetPreviousCursor: TJclCardinalBinaryNode; override; + end; + + TJclInOrderCardinalBinaryTreeIterator = class(TJclCardinalBinaryTreeIterator, IJclCardinalIterator, IJclCardinalTreeIterator, IJclCardinalBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclCardinalBinaryNode; override; + function GetPreviousCursor: TJclCardinalBinaryNode; override; + end; + + TJclPostOrderCardinalBinaryTreeIterator = class(TJclCardinalBinaryTreeIterator, IJclCardinalIterator, IJclCardinalTreeIterator, IJclCardinalBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclCardinalBinaryNode; override; + function GetPreviousCursor: TJclCardinalBinaryNode; override; + end; + + TJclInt64BinaryNode = class + public + Value: Int64; + Left: TJclInt64BinaryNode; + Right: TJclInt64BinaryNode; + Parent: TJclInt64BinaryNode; + end; + + TJclInt64BinaryTree = class(TJclInt64AbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, + IJclInt64EqualityComparer, IJclInt64Comparer, IJclInt64Container, IJclInt64FlatContainer, + IJclInt64Collection, IJclInt64Tree) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FMaxDepth: Integer; + FRoot: TJclInt64BinaryNode; + FTraverseOrder: TJclTraverseOrder; + function BuildTree(const LeafArray: array of TJclInt64BinaryNode; Left, Right: Integer; Parent: TJclInt64BinaryNode; + Offset: Integer): TJclInt64BinaryNode; + function CloneNode(Node, Parent: TJclInt64BinaryNode): TJclInt64BinaryNode; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + procedure AutoPack; override; + public + constructor Create(ACompare: TInt64Compare); + destructor Destroy; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclInt64Collection } + function Add(const AValue: Int64): Boolean; + function AddAll(const ACollection: IJclInt64Collection): Boolean; + procedure Clear; + function Contains(const AValue: Int64): Boolean; + function ContainsAll(const ACollection: IJclInt64Collection): Boolean; + function CollectionEquals(const ACollection: IJclInt64Collection): Boolean; + function Extract(const AValue: Int64): Boolean; + function ExtractAll(const ACollection: IJclInt64Collection): Boolean; + function First: IJclInt64Iterator; + function IsEmpty: Boolean; + function Last: IJclInt64Iterator; + function Remove(const AValue: Int64): Boolean; + function RemoveAll(const ACollection: IJclInt64Collection): Boolean; + function RetainAll(const ACollection: IJclInt64Collection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclInt64Iterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclInt64Tree } + function GetRoot: IJclInt64TreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclInt64TreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + TJclInt64BinaryTreeIterator = class(TJclAbstractIterator, IJclInt64Iterator, IJclInt64TreeIterator, IJclInt64BinaryTreeIterator) + protected + FCursor: TJclInt64BinaryNode; + FStart: TItrStart; + FOwnTree: TJclInt64BinaryTree; + FEqualityComparer: IJclInt64EqualityComparer; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function GetNextCursor: TJclInt64BinaryNode; virtual; abstract; + function GetPreviousCursor: TJclInt64BinaryNode; virtual; abstract; + public + constructor Create(const AOwnTree: TJclInt64BinaryTree; ACursor: TJclInt64BinaryNode; AValid: Boolean; AStart: TItrStart); + { IJclInt64Iterator } + function Add(const AValue: Int64): Boolean; + procedure Extract; + function GetValue: Int64; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AValue: Int64): Boolean; + function IteratorEquals(const AIterator: IJclInt64Iterator): Boolean; + function Next: Int64; + function NextIndex: Integer; + function Previous: Int64; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(const AValue: Int64); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Int64 read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + { IJclInt64TreeIterator } + function AddChild(const AValue: Int64): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): Int64; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(const AValue: Int64): Integer; + function InsertChild(Index: Integer; const AValue: Int64): Boolean; + function Parent: Int64; + procedure SetChild(Index: Integer; const AValue: Int64); + { IJclInt64BinaryTreeIterator } + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: Int64; + function Right: Int64; + end; + + TJclPreOrderInt64BinaryTreeIterator = class(TJclInt64BinaryTreeIterator, IJclInt64Iterator, IJclInt64TreeIterator, IJclInt64BinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclInt64BinaryNode; override; + function GetPreviousCursor: TJclInt64BinaryNode; override; + end; + + TJclInOrderInt64BinaryTreeIterator = class(TJclInt64BinaryTreeIterator, IJclInt64Iterator, IJclInt64TreeIterator, IJclInt64BinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclInt64BinaryNode; override; + function GetPreviousCursor: TJclInt64BinaryNode; override; + end; + + TJclPostOrderInt64BinaryTreeIterator = class(TJclInt64BinaryTreeIterator, IJclInt64Iterator, IJclInt64TreeIterator, IJclInt64BinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclInt64BinaryNode; override; + function GetPreviousCursor: TJclInt64BinaryNode; override; + end; + + TJclPtrBinaryNode = class + public + Value: Pointer; + Left: TJclPtrBinaryNode; + Right: TJclPtrBinaryNode; + Parent: TJclPtrBinaryNode; + end; + + TJclPtrBinaryTree = class(TJclPtrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, + IJclPtrEqualityComparer, IJclPtrComparer, IJclPtrContainer, IJclPtrFlatContainer, + IJclPtrCollection, IJclPtrTree) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FMaxDepth: Integer; + FRoot: TJclPtrBinaryNode; + FTraverseOrder: TJclTraverseOrder; + function BuildTree(const LeafArray: array of TJclPtrBinaryNode; Left, Right: Integer; Parent: TJclPtrBinaryNode; + Offset: Integer): TJclPtrBinaryNode; + function CloneNode(Node, Parent: TJclPtrBinaryNode): TJclPtrBinaryNode; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + procedure AutoPack; override; + public + constructor Create(ACompare: TPtrCompare); + destructor Destroy; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclPtrCollection } + function Add(APtr: Pointer): Boolean; + function AddAll(const ACollection: IJclPtrCollection): Boolean; + procedure Clear; + function Contains(APtr: Pointer): Boolean; + function ContainsAll(const ACollection: IJclPtrCollection): Boolean; + function CollectionEquals(const ACollection: IJclPtrCollection): Boolean; + function Extract(APtr: Pointer): Boolean; + function ExtractAll(const ACollection: IJclPtrCollection): Boolean; + function First: IJclPtrIterator; + function IsEmpty: Boolean; + function Last: IJclPtrIterator; + function Remove(APtr: Pointer): Boolean; + function RemoveAll(const ACollection: IJclPtrCollection): Boolean; + function RetainAll(const ACollection: IJclPtrCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclPtrIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclPtrTree } + function GetRoot: IJclPtrTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclPtrTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + TJclPtrBinaryTreeIterator = class(TJclAbstractIterator, IJclPtrIterator, IJclPtrTreeIterator, IJclPtrBinaryTreeIterator) + protected + FCursor: TJclPtrBinaryNode; + FStart: TItrStart; + FOwnTree: TJclPtrBinaryTree; + FEqualityComparer: IJclPtrEqualityComparer; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function GetNextCursor: TJclPtrBinaryNode; virtual; abstract; + function GetPreviousCursor: TJclPtrBinaryNode; virtual; abstract; + public + constructor Create(const AOwnTree: TJclPtrBinaryTree; ACursor: TJclPtrBinaryNode; AValid: Boolean; AStart: TItrStart); + { IJclPtrIterator } + function Add(APtr: Pointer): Boolean; + procedure Extract; + function GetPointer: Pointer; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(APtr: Pointer): Boolean; + function IteratorEquals(const AIterator: IJclPtrIterator): Boolean; + function Next: Pointer; + function NextIndex: Integer; + function Previous: Pointer; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetPointer(APtr: Pointer); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Pointer read GetPointer; + {$ENDIF SUPPORTS_FOR_IN} + { IJclPtrTreeIterator } + function AddChild(APtr: Pointer): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): Pointer; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(APtr: Pointer): Integer; + function InsertChild(Index: Integer; APtr: Pointer): Boolean; + function Parent: Pointer; + procedure SetChild(Index: Integer; APtr: Pointer); + { IJclPtrBinaryTreeIterator } + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: Pointer; + function Right: Pointer; + end; + + TJclPreOrderPtrBinaryTreeIterator = class(TJclPtrBinaryTreeIterator, IJclPtrIterator, IJclPtrTreeIterator, IJclPtrBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclPtrBinaryNode; override; + function GetPreviousCursor: TJclPtrBinaryNode; override; + end; + + TJclInOrderPtrBinaryTreeIterator = class(TJclPtrBinaryTreeIterator, IJclPtrIterator, IJclPtrTreeIterator, IJclPtrBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclPtrBinaryNode; override; + function GetPreviousCursor: TJclPtrBinaryNode; override; + end; + + TJclPostOrderPtrBinaryTreeIterator = class(TJclPtrBinaryTreeIterator, IJclPtrIterator, IJclPtrTreeIterator, IJclPtrBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclPtrBinaryNode; override; + function GetPreviousCursor: TJclPtrBinaryNode; override; + end; + + TJclBinaryNode = class + public + Value: TObject; + Left: TJclBinaryNode; + Right: TJclBinaryNode; + Parent: TJclBinaryNode; + end; + + TJclBinaryTree = class(TJclAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, + IJclEqualityComparer, IJclComparer, IJclContainer, IJclFlatContainer, IJclObjectOwner, + IJclCollection, IJclTree) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FMaxDepth: Integer; + FRoot: TJclBinaryNode; + FTraverseOrder: TJclTraverseOrder; + function BuildTree(const LeafArray: array of TJclBinaryNode; Left, Right: Integer; Parent: TJclBinaryNode; + Offset: Integer): TJclBinaryNode; + function CloneNode(Node, Parent: TJclBinaryNode): TJclBinaryNode; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + procedure AutoPack; override; + public + constructor Create(ACompare: TCompare; AOwnsObjects: Boolean); + destructor Destroy; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclCollection } + function Add(AObject: TObject): Boolean; + function AddAll(const ACollection: IJclCollection): Boolean; + procedure Clear; + function Contains(AObject: TObject): Boolean; + function ContainsAll(const ACollection: IJclCollection): Boolean; + function CollectionEquals(const ACollection: IJclCollection): Boolean; + function Extract(AObject: TObject): Boolean; + function ExtractAll(const ACollection: IJclCollection): Boolean; + function First: IJclIterator; + function IsEmpty: Boolean; + function Last: IJclIterator; + function Remove(AObject: TObject): Boolean; + function RemoveAll(const ACollection: IJclCollection): Boolean; + function RetainAll(const ACollection: IJclCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclTree } + function GetRoot: IJclTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + TJclBinaryTreeIterator = class(TJclAbstractIterator, IJclIterator, IJclTreeIterator, IJclBinaryTreeIterator) + protected + FCursor: TJclBinaryNode; + FStart: TItrStart; + FOwnTree: TJclBinaryTree; + FEqualityComparer: IJclEqualityComparer; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function GetNextCursor: TJclBinaryNode; virtual; abstract; + function GetPreviousCursor: TJclBinaryNode; virtual; abstract; + public + constructor Create(const AOwnTree: TJclBinaryTree; ACursor: TJclBinaryNode; AValid: Boolean; AStart: TItrStart); + { IJclIterator } + function Add(AObject: TObject): Boolean; + procedure Extract; + function GetObject: TObject; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(AObject: TObject): Boolean; + function IteratorEquals(const AIterator: IJclIterator): Boolean; + function Next: TObject; + function NextIndex: Integer; + function Previous: TObject; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetObject(AObject: TObject); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: TObject read GetObject; + {$ENDIF SUPPORTS_FOR_IN} + { IJclTreeIterator } + function AddChild(AObject: TObject): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): TObject; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(AObject: TObject): Integer; + function InsertChild(Index: Integer; AObject: TObject): Boolean; + function Parent: TObject; + procedure SetChild(Index: Integer; AObject: TObject); + { IJclBinaryTreeIterator } + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: TObject; + function Right: TObject; + end; + + TJclPreOrderBinaryTreeIterator = class(TJclBinaryTreeIterator, IJclIterator, IJclTreeIterator, IJclBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclBinaryNode; override; + function GetPreviousCursor: TJclBinaryNode; override; + end; + + TJclInOrderBinaryTreeIterator = class(TJclBinaryTreeIterator, IJclIterator, IJclTreeIterator, IJclBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclBinaryNode; override; + function GetPreviousCursor: TJclBinaryNode; override; + end; + + TJclPostOrderBinaryTreeIterator = class(TJclBinaryTreeIterator, IJclIterator, IJclTreeIterator, IJclBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclBinaryNode; override; + function GetPreviousCursor: TJclBinaryNode; override; + end; + + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + + TJclBinaryNode = class + public + Value: T; + Left: TJclBinaryNode; + Right: TJclBinaryNode; + Parent: TJclBinaryNode; + end; + + TJclBinaryTreeIterator = class; + TJclPreOrderBinaryTreeIterator = class; + TJclInOrderBinaryTreeIterator = class; + TJclPostOrderBinaryTreeIterator = class; + + TJclBinaryTree = class(TJclAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, + IJclEqualityComparer, IJclComparer, IJclContainer, IJclFlatContainer,IJclItemOwner, + IJclCollection, IJclTree) + protected + type + TBinaryNode = TJclBinaryNode; + TPreOrderBinaryTreeIterator = TJclPreOrderBinaryTreeIterator; + TInOrderBinaryTreeIterator = TJclInOrderBinaryTreeIterator; + TPostOrderBinaryTreeIterator = TJclPostOrderBinaryTreeIterator; + private + FMaxDepth: Integer; + FRoot: TBinaryNode; + FTraverseOrder: TJclTraverseOrder; + function BuildTree(const LeafArray: array of TBinaryNode; Left, Right: Integer; Parent: TBinaryNode; + Offset: Integer): TBinaryNode; + function CloneNode(Node, Parent: TBinaryNode): TBinaryNode; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + procedure AutoPack; override; + public + constructor Create(AOwnsItems: Boolean); + destructor Destroy; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclCollection } + function Add(const AItem: T): Boolean; + function AddAll(const ACollection: IJclCollection): Boolean; + procedure Clear; + function Contains(const AItem: T): Boolean; + function ContainsAll(const ACollection: IJclCollection): Boolean; + function CollectionEquals(const ACollection: IJclCollection): Boolean; + function Extract(const AItem: T): Boolean; + function ExtractAll(const ACollection: IJclCollection): Boolean; + function First: IJclIterator; + function IsEmpty: Boolean; + function Last: IJclIterator; + function Remove(const AItem: T): Boolean; + function RemoveAll(const ACollection: IJclCollection): Boolean; + function RetainAll(const ACollection: IJclCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclTree } + function GetRoot: IJclTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + TJclBinaryTreeIterator = class(TJclAbstractIterator, IJclIterator, IJclTreeIterator, IJclBinaryTreeIterator) + protected + FCursor: TJclBinaryNode; + FStart: TItrStart; + FOwnTree: TJclBinaryTree; + FEqualityComparer: IJclEqualityComparer; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function GetNextCursor: TJclBinaryNode; virtual; abstract; + function GetPreviousCursor: TJclBinaryNode; virtual; abstract; + public + constructor Create(const AOwnTree: TJclBinaryTree; ACursor: TJclBinaryNode; AValid: Boolean; AStart: TItrStart); + { IJclIterator } + function Add(const AItem: T): Boolean; + procedure Extract; + function GetItem: T; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AItem: T): Boolean; + function IteratorEquals(const AIterator: IJclIterator): Boolean; + function Next: T; + function NextIndex: Integer; + function Previous: T; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetItem(const AItem: T); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: T read GetItem; + {$ENDIF SUPPORTS_FOR_IN} + { IJclTreeIterator } + function AddChild(const AItem: T): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): T; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(const AItem: T): Integer; + function InsertChild(Index: Integer; const AItem: T): Boolean; + function Parent: T; + procedure SetChild(Index: Integer; const AItem: T); + { IJclBinaryTreeIterator } + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: T; + function Right: T; + end; + + TJclPreOrderBinaryTreeIterator = class(TJclBinaryTreeIterator, IJclIterator, IJclTreeIterator, IJclBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclBinaryNode; override; + function GetPreviousCursor: TJclBinaryNode; override; + end; + + TJclInOrderBinaryTreeIterator = class(TJclBinaryTreeIterator, IJclIterator, IJclTreeIterator, IJclBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclBinaryNode; override; + function GetPreviousCursor: TJclBinaryNode; override; + end; + + TJclPostOrderBinaryTreeIterator = class(TJclBinaryTreeIterator, IJclIterator, IJclTreeIterator, IJclBinaryTreeIterator, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclBinaryNode; override; + function GetPreviousCursor: TJclBinaryNode; override; + end; + + // E = External helper to compare items + TJclBinaryTreeE = class(TJclBinaryTree, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclContainer, IJclItemOwner, IJclEqualityComparer, IJclComparer, + IJclCollection, IJclTree) + private + FComparer: IJclComparer; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AComparer: IJclComparer; AOwnsItems: Boolean); + { IJclComparer } + function ItemsCompare(const A, B: T): Integer; override; + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + property Comparer: IJclComparer read FComparer write FComparer; + end; + + // F = Function to compare items + TJclBinaryTreeF = class(TJclBinaryTree, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclContainer, IJclItemOwner, IJclEqualityComparer, IJclComparer, + IJclCollection, IJclTree) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(ACompare: TCompare; AOwnsItems: Boolean); + end; + + // I = Items can compare themselves to an other + TJclBinaryTreeI> = class(TJclBinaryTree, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclContainer, IJclItemOwner, IJclEqualityComparer, IJclComparer, + IJclCollection, IJclTree) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + { IJclComparer } + function ItemsCompare(const A, B: T): Integer; override; + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +{$IFDEF BCB} +{$IFDEF WIN64} + {$HPPEMIT '#ifdef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #undef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #define JclBinaryTrees_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT '#endif'} + + {$HPPEMIT END '#ifdef JclBinaryTrees_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #define MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #undef JclBinaryTrees_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END '#endif'} +{$ENDIF WIN64} +{$ENDIF BCB} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +//=== { TJclIntfBinaryTree } ================================================= + +constructor TJclIntfBinaryTree.Create(ACompare: TIntfCompare); +begin + inherited Create(); + FTraverseOrder := toOrder; + FMaxDepth := 0; + FAutoPackParameter := 2; + SetCompare(ACompare); +end; + +destructor TJclIntfBinaryTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclIntfBinaryTree.Add(const AInterface: IInterface): Boolean; +var + NewNode, Current, Save: TJclIntfBinaryNode; + Comp, Depth: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // Insert into right place + if FAllowDefaultElements or not ItemsEqual(AInterface, nil) then + begin + Save := nil; + Current := FRoot; + Comp := 1; + Depth := 0; + while Current <> nil do + begin + Inc(Depth); + Save := Current; + Comp := ItemsCompare(AInterface, Current.Value); + if Comp < 0 then + Current := Current.Left + else + if Comp > 0 then + Current := Current.Right + else + if CheckDuplicate then + Current := Current.Left // arbitrary decision + else + Break; + end; + if (Comp <> 0) or CheckDuplicate then + begin + NewNode := TJclIntfBinaryNode.Create; + NewNode.Value := AInterface; + NewNode.Parent := Save; + if Save = nil then + FRoot := NewNode + else + if ItemsCompare(NewNode.Value, Save.Value) <= 0 then + Save.Left := NewNode + else + Save.Right := NewNode; + Inc(FSize); + Inc(Depth); + if Depth > FMaxDepth then + FMaxDepth := Depth; + Result := True; + AutoPack; + end + else + Result := False; + end + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfBinaryTree.AddAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfBinaryTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclIntfBinaryTree; + ACollection: IJclIntfCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntfBinaryTree then + begin + ADest := TJclIntfBinaryTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclIntfCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclIntfBinaryTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclIntfBinaryTree then + TJclIntfBinaryTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclIntfBinaryTree.AutoPack; +begin + case FAutoPackStrategy of + //apsDisabled: ; + apsAgressive: + if (FMaxDepth > 1) and (((1 shl (FMaxDepth - 1)) - 1) > FSize) then + Pack; + // apsIncremental: ; + apsProportional: + if (FMaxDepth > FAutoPackParameter) and (((1 shl (FMaxDepth - FAutoPackParameter)) - 1) > FSize) then + Pack; + end; +end; + +function TJclIntfBinaryTree.BuildTree(const LeafArray: array of TJclIntfBinaryNode; Left, Right: Integer; Parent: TJclIntfBinaryNode; + Offset: Integer): TJclIntfBinaryNode; +var + Middle: Integer; +begin + Middle := (Left + Right + Offset) shr 1; + Result := LeafArray[Middle]; + Result.Parent := Parent; + if Middle > Left then + Result.Left := BuildTree(LeafArray, Left, Middle - 1, Result, 0) + else + Result.Left := nil; + if Middle < Right then + Result.Right := BuildTree(LeafArray, Middle + 1, Right, Result, 1) + else + Result.Right := nil; +end; + +procedure TJclIntfBinaryTree.Clear; +var + Current, Parent: TJclIntfBinaryNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // postorder + Current := FRoot; + if Current = nil then + Exit; + // find first in post-order + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + // for all items in the tree in post-order + repeat + Parent := Current.Parent; + // remove reference + if Parent <> nil then + begin + if Parent.Left = Current then + Parent.Left := nil + else + if Parent.Right = Current then + Parent.Right := nil; + end; + + // free item + FreeObject(Current.Value); + Current.Free; + + // find next item + Current := Parent; + if (Current <> nil) and (Current.Right <> nil) then + begin + Current := Current.Right; + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + end; + until Current = nil; + FRoot := nil; + FSize := 0; + FMaxDepth := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfBinaryTree.CloneNode(Node, Parent: TJclIntfBinaryNode): TJclIntfBinaryNode; +begin + Result := TJclIntfBinaryNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + if Node.Left <> nil then + Result.Left := CloneNode(Node.Left, Result); // recursive call + if Node.Right <> nil then + Result.Right := CloneNode(Node.Right, Result); // recursive call +end; + +function TJclIntfBinaryTree.CollectionEquals(const ACollection: IJclIntfCollection): Boolean; +var + It, ItSelf: IJclIntfIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfBinaryTree.Contains(const AInterface: IInterface): Boolean; +var + Comp: Integer; + Current: TJclIntfBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FRoot; + while Current <> nil do + begin + Comp := ItemsCompare(Current.Value, AInterface); + if Comp = 0 then + begin + Result := True; + Break; + end + else + if Comp > 0 then + Current := Current.Left + else + Current := Current.Right; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfBinaryTree.ContainsAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfBinaryTree.Extract(const AInterface: IInterface): Boolean; +var + Current, Successor: TJclIntfBinaryNode; + Comp: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + // locate AInterface in the tree + Current := FRoot; + repeat + while Current <> nil do + begin + Comp := ItemsCompare(AInterface, Current.Value); + if Comp = 0 then + Break + else + if Comp < 0 then + Current := Current.Left + else + Current := Current.Right; + end; + if Current = nil then + Break; + Result := True; + // Remove Current from tree + if (Current.Left = nil) and (Current.Right <> nil) then + begin + // remove references to Current + Current.Right.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Right + else + Current.Parent.Right := Current.Right; + end + else + // fix root + FRoot := Current.Right; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right = nil) then + begin + // remove references to Current + Current.Left.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Left + else + Current.Parent.Right := Current.Left; + end + else + // fix root + FRoot := Current.Left; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right <> nil) then + begin + // find the successor in tree + Successor := Current.Right; + while Successor.Left <> nil do + Successor := Successor.Left; + + if Successor <> Current.Right then + begin + // remove references to successor + Successor.Parent.Left := Successor.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor.Parent; + Successor.Right := Current.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor; + end; + + // insert successor in new position + Successor.Left := Current.Left; + if Current.Left <> nil then + Current.Left.Parent := Successor; + Successor.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Successor + else + Current.Parent.Right := Successor; + end + else + // fix root + FRoot := Successor; + Successor := Current.Parent; + if Successor <> nil then + Successor := FRoot; + end + else + begin + // (Current.Left = nil) and (Current.Right = nil) + Successor := Current.Parent; + if Successor <> nil then + begin + // remove references from parent + if Successor.Left = Current then + Successor.Left := nil + else + Successor.Right := nil; + end + else + FRoot := nil; + end; + Current.Value := nil; + Current.Free; + Dec(FSize); + Current := Successor; + until FRemoveSingleElement or (Current = nil); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfBinaryTree.ExtractAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfBinaryTree.First: IJclIntfIterator; +var + Start: TJclIntfBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderIntfBinaryTreeIterator.Create(Self, Start, False, isFirst); + toOrder: + begin + if Start <> nil then + while Start.Left <> nil do + Start := Start.Left; + Result := TJclInOrderIntfBinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + toPostOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Left <> nil then + Start := Start.Left + else + Start := Start.Right; + end; + Result := TJclPostOrderIntfBinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclIntfBinaryTree.GetEnumerator: IJclIntfIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclIntfBinaryTree.GetRoot: IJclIntfTreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderIntfBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toOrder: + Result := TJclInOrderIntfBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TJclPostOrderIntfBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfBinaryTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclIntfBinaryTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntfBinaryTree.Last: IJclIntfIterator; +var + Start: TJclIntfBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Right <> nil then + Start := Start.Right + else + Start := Start.Left; + end; + Result := TJclPreOrderIntfBinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toOrder: + begin + if Start <> nil then + while Start.Right <> nil do + Start := Start.Right; + Result := TJclInOrderIntfBinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TJclPostOrderIntfBinaryTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfBinaryTree.Pack; +var + LeafArray: array of TJclIntfBinaryNode; + ANode, BNode: TJclIntfBinaryNode; + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetLength(Leafarray, FSize); + try + // in order enumeration of nodes + ANode := FRoot; + if ANode <> nil then + begin + // find first node + while ANode.Left <> nil do + ANode := ANode.Left; + + Index := 0; + while ANode <> nil do + begin + LeafArray[Index] := ANode; + Inc(Index); + if ANode.Right <> nil then + begin + ANode := ANode.Right; + while (ANode.Left <> nil) do + ANode := ANode.Left; + end + else + begin + BNode := ANode; + ANode := ANode.Parent; + while (ANode <> nil) and (ANode.Right = BNode) do + begin + BNode := ANode; + ANode := ANode.Parent; + end; + end; + end; + + Index := FSize shr 1; + FRoot := LeafArray[Index]; + FRoot.Parent := nil; + if Index > 0 then + FRoot.Left := BuildTree(LeafArray, 0, Index - 1, FRoot, 0) + else + FRoot.Left := nil; + if Index < (FSize - 1) then + FRoot.Right := BuildTree(LeafArray, Index + 1, FSize - 1, FRoot, 1) + else + FRoot.Right := nil; + end; + finally + SetLength(LeafArray, 0); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfBinaryTree.Remove(const AInterface: IInterface): Boolean; +var + Extracted: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AInterface); + if Result then + begin + Extracted := AInterface; + FreeObject(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfBinaryTree.RemoveAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfBinaryTree.RetainAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfBinaryTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclIntfBinaryTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclIntfBinaryTree.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfBinaryTree.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfBinaryTree.Create(Compare); + AssignPropertiesTo(Result); +end; + +//=== { TJclIntfBinaryTreeIterator } =========================================================== + +constructor TJclIntfBinaryTreeIterator.Create(const AOwnTree: TJclIntfBinaryTree; ACursor: TJclIntfBinaryNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FStart := AStart; + FOwnTree := AOwnTree; + FEqualityComparer := AOwnTree as IJclIntfEqualityComparer; +end; + +function TJclIntfBinaryTreeIterator.Add(const AInterface: IInterface): Boolean; +begin + Result := FOwnTree.Add(AInterface); +end; + +function TJclIntfBinaryTreeIterator.AddChild(const AInterface: IInterface): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclIntfBinaryTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclIntfBinaryTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclIntfBinaryTreeIterator then + begin + ADest := TJclIntfBinaryTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclIntfBinaryTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + Inc(Result); + if FCursor.Right <> nil then + Inc(Result); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfBinaryTreeIterator.DeleteChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclIntfBinaryTreeIterator.DeleteChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclIntfBinaryTreeIterator.Extract; +var + OldCursor: TJclIntfBinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Extract(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfBinaryTreeIterator.ExtractChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclIntfBinaryTreeIterator.ExtractChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclIntfBinaryTreeIterator.GetChild(Index: Integer): IInterface; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := nil; + if (FCursor <> nil) and (Index = 0) and (FCursor.Left <> nil) then + FCursor := FCursor.Left + else + if (FCursor <> nil) and (Index = 0) then + FCursor := FCursor.Right + else + if (FCursor <> nil) and (Index = 1) then + FCursor := FCursor.Right + else + FCursor := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfBinaryTreeIterator.GetObject: IInterface; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfBinaryTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index = 0) then + Result := (FCursor.Left <> nil) or (FCursor.Right <> nil) + else + if (FCursor <> nil) and (Index = 1) then + Result := (FCursor.Left <> nil) and (FCursor.Right <> nil) + else + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfBinaryTreeIterator.HasLeft: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Left <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfBinaryTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfBinaryTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfBinaryTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfBinaryTreeIterator.HasRight: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Right <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfBinaryTreeIterator.IndexOfChild(const AInterface: IInterface): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := -1; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + begin + if FEqualityComparer.ItemsEqual(FCursor.Left.Value, AInterface) then + Result := 0 + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, AInterface) then + Result := 1; + end + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, AInterface) then + Result := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfBinaryTreeIterator.Insert(const AInterface: IInterface): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclIntfBinaryTreeIterator.InsertChild(Index: Integer; const AInterface: IInterface): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclIntfBinaryTreeIterator.IteratorEquals(const AIterator: IJclIntfIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclIntfBinaryTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclIntfBinaryTreeIterator then + begin + ItrObj := TJclIntfBinaryTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +function TJclIntfBinaryTreeIterator.Left: IInterface; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := nil; + if FCursor <> nil then + FCursor := FCursor.Left; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclIntfBinaryTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclIntfBinaryTreeIterator.Next: IInterface; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfBinaryTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclIntfBinaryTreeIterator.Parent: IInterface; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := nil; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfBinaryTreeIterator.Previous: IInterface; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfBinaryTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclIntfBinaryTreeIterator.Remove; +var + OldCursor: TJclIntfBinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Remove(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfBinaryTreeIterator.Reset; +var + NewCursor: TJclIntfBinaryNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfBinaryTreeIterator.Right: IInterface; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := nil; + if FCursor <> nil then + FCursor := FCursor.Right; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfBinaryTreeIterator.SetChild(Index: Integer; const AInterface: IInterface); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclIntfBinaryTreeIterator.SetObject(const AInterface: IInterface); +begin + raise EJclOperationNotSupportedError.Create; +end; + +//=== { TJclPreOrderIntfBinaryTreeIterator } =================================================== + +function TJclPreOrderIntfBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderIntfBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderIntfBinaryTreeIterator.GetNextCursor: TJclIntfBinaryNode; +var + LastRet: TJclIntfBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.Left <> nil then + Result := Result.Left + else + if Result.Right <> nil then + Result := Result.Right + else + begin + Result := Result.Parent; + while (Result <> nil) and ((Result.Right = nil) or (Result.Right = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Right; + end; +end; + +function TJclPreOrderIntfBinaryTreeIterator.GetPreviousCursor: TJclIntfBinaryNode; +var + LastRet: TJclIntfBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Left <> LastRet) and (Result.Left <> nil) then + // come from Right + begin + Result := Result.Left; + while (Result.Left <> nil) or (Result.Right <> nil) do // both childs + begin + if Result.Right <> nil then // right child first + Result := Result.Right + else + Result := Result.Left; + end; + end; +end; + +//=== { TJclInOrderIntfBinaryTreeIterator } ==================================================== + +function TJclInOrderIntfBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclInOrderIntfBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclInOrderIntfBinaryTreeIterator.GetNextCursor: TJclIntfBinaryNode; +var + LastRet: TJclIntfBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + begin + Result := Result.Right; + while (Result.Left <> nil) do + Result := Result.Left; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right = LastRet) do + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +function TJclInOrderIntfBinaryTreeIterator.GetPreviousCursor: TJclIntfBinaryNode; +var + LastRet: TJclIntfBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Left <> nil then + begin + Result := Result.Left; + while Result.Right <> nil do + Result := Result.Right; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right <> LastRet) do // Come from Left + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +//=== { TJclPostOrderIntfBinaryTreeIterator } ================================================== + +function TJclPostOrderIntfBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderIntfBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderIntfBinaryTreeIterator.GetNextCursor: TJclIntfBinaryNode; +var + LastRet: TJclIntfBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Right <> nil) and (Result.Right <> LastRet) then + begin + Result := Result.Right; + while (Result.Left <> nil) or (Result.Right <> nil) do + begin + if Result.Left <> nil then + Result := Result.Left + else + Result := Result.Right; + end; + end; +end; + +function TJclPostOrderIntfBinaryTreeIterator.GetPreviousCursor: TJclIntfBinaryNode; +var + LastRet: TJclIntfBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + Result := Result.Right + else + if Result.Left <> nil then + Result := Result.Left + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and ((Result.Left = nil) or (Result.Left = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Left; + end; +end; + +//=== { TJclAnsiStrBinaryTree } ================================================= + +constructor TJclAnsiStrBinaryTree.Create(ACompare: TAnsiStrCompare); +begin + inherited Create(); + FTraverseOrder := toOrder; + FMaxDepth := 0; + FAutoPackParameter := 2; + SetCompare(ACompare); +end; + +destructor TJclAnsiStrBinaryTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclAnsiStrBinaryTree.Add(const AString: AnsiString): Boolean; +var + NewNode, Current, Save: TJclAnsiStrBinaryNode; + Comp, Depth: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // Insert into right place + if FAllowDefaultElements or not ItemsEqual(AString, '') then + begin + Save := nil; + Current := FRoot; + Comp := 1; + Depth := 0; + while Current <> nil do + begin + Inc(Depth); + Save := Current; + Comp := ItemsCompare(AString, Current.Value); + if Comp < 0 then + Current := Current.Left + else + if Comp > 0 then + Current := Current.Right + else + if CheckDuplicate then + Current := Current.Left // arbitrary decision + else + Break; + end; + if (Comp <> 0) or CheckDuplicate then + begin + NewNode := TJclAnsiStrBinaryNode.Create; + NewNode.Value := AString; + NewNode.Parent := Save; + if Save = nil then + FRoot := NewNode + else + if ItemsCompare(NewNode.Value, Save.Value) <= 0 then + Save.Left := NewNode + else + Save.Right := NewNode; + Inc(FSize); + Inc(Depth); + if Depth > FMaxDepth then + FMaxDepth := Depth; + Result := True; + AutoPack; + end + else + Result := False; + end + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrBinaryTree.AddAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrBinaryTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclAnsiStrBinaryTree; + ACollection: IJclAnsiStrCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclAnsiStrBinaryTree then + begin + ADest := TJclAnsiStrBinaryTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclAnsiStrCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclAnsiStrBinaryTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclAnsiStrBinaryTree then + TJclAnsiStrBinaryTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclAnsiStrBinaryTree.AutoPack; +begin + case FAutoPackStrategy of + //apsDisabled: ; + apsAgressive: + if (FMaxDepth > 1) and (((1 shl (FMaxDepth - 1)) - 1) > FSize) then + Pack; + // apsIncremental: ; + apsProportional: + if (FMaxDepth > FAutoPackParameter) and (((1 shl (FMaxDepth - FAutoPackParameter)) - 1) > FSize) then + Pack; + end; +end; + +function TJclAnsiStrBinaryTree.BuildTree(const LeafArray: array of TJclAnsiStrBinaryNode; Left, Right: Integer; Parent: TJclAnsiStrBinaryNode; + Offset: Integer): TJclAnsiStrBinaryNode; +var + Middle: Integer; +begin + Middle := (Left + Right + Offset) shr 1; + Result := LeafArray[Middle]; + Result.Parent := Parent; + if Middle > Left then + Result.Left := BuildTree(LeafArray, Left, Middle - 1, Result, 0) + else + Result.Left := nil; + if Middle < Right then + Result.Right := BuildTree(LeafArray, Middle + 1, Right, Result, 1) + else + Result.Right := nil; +end; + +procedure TJclAnsiStrBinaryTree.Clear; +var + Current, Parent: TJclAnsiStrBinaryNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // postorder + Current := FRoot; + if Current = nil then + Exit; + // find first in post-order + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + // for all items in the tree in post-order + repeat + Parent := Current.Parent; + // remove reference + if Parent <> nil then + begin + if Parent.Left = Current then + Parent.Left := nil + else + if Parent.Right = Current then + Parent.Right := nil; + end; + + // free item + FreeString(Current.Value); + Current.Free; + + // find next item + Current := Parent; + if (Current <> nil) and (Current.Right <> nil) then + begin + Current := Current.Right; + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + end; + until Current = nil; + FRoot := nil; + FSize := 0; + FMaxDepth := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrBinaryTree.CloneNode(Node, Parent: TJclAnsiStrBinaryNode): TJclAnsiStrBinaryNode; +begin + Result := TJclAnsiStrBinaryNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + if Node.Left <> nil then + Result.Left := CloneNode(Node.Left, Result); // recursive call + if Node.Right <> nil then + Result.Right := CloneNode(Node.Right, Result); // recursive call +end; + +function TJclAnsiStrBinaryTree.CollectionEquals(const ACollection: IJclAnsiStrCollection): Boolean; +var + It, ItSelf: IJclAnsiStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrBinaryTree.Contains(const AString: AnsiString): Boolean; +var + Comp: Integer; + Current: TJclAnsiStrBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FRoot; + while Current <> nil do + begin + Comp := ItemsCompare(Current.Value, AString); + if Comp = 0 then + begin + Result := True; + Break; + end + else + if Comp > 0 then + Current := Current.Left + else + Current := Current.Right; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrBinaryTree.ContainsAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrBinaryTree.Extract(const AString: AnsiString): Boolean; +var + Current, Successor: TJclAnsiStrBinaryNode; + Comp: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + // locate AString in the tree + Current := FRoot; + repeat + while Current <> nil do + begin + Comp := ItemsCompare(AString, Current.Value); + if Comp = 0 then + Break + else + if Comp < 0 then + Current := Current.Left + else + Current := Current.Right; + end; + if Current = nil then + Break; + Result := True; + // Remove Current from tree + if (Current.Left = nil) and (Current.Right <> nil) then + begin + // remove references to Current + Current.Right.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Right + else + Current.Parent.Right := Current.Right; + end + else + // fix root + FRoot := Current.Right; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right = nil) then + begin + // remove references to Current + Current.Left.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Left + else + Current.Parent.Right := Current.Left; + end + else + // fix root + FRoot := Current.Left; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right <> nil) then + begin + // find the successor in tree + Successor := Current.Right; + while Successor.Left <> nil do + Successor := Successor.Left; + + if Successor <> Current.Right then + begin + // remove references to successor + Successor.Parent.Left := Successor.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor.Parent; + Successor.Right := Current.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor; + end; + + // insert successor in new position + Successor.Left := Current.Left; + if Current.Left <> nil then + Current.Left.Parent := Successor; + Successor.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Successor + else + Current.Parent.Right := Successor; + end + else + // fix root + FRoot := Successor; + Successor := Current.Parent; + if Successor <> nil then + Successor := FRoot; + end + else + begin + // (Current.Left = nil) and (Current.Right = nil) + Successor := Current.Parent; + if Successor <> nil then + begin + // remove references from parent + if Successor.Left = Current then + Successor.Left := nil + else + Successor.Right := nil; + end + else + FRoot := nil; + end; + Current.Value := ''; + Current.Free; + Dec(FSize); + Current := Successor; + until FRemoveSingleElement or (Current = nil); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrBinaryTree.ExtractAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrBinaryTree.First: IJclAnsiStrIterator; +var + Start: TJclAnsiStrBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderAnsiStrBinaryTreeIterator.Create(Self, Start, False, isFirst); + toOrder: + begin + if Start <> nil then + while Start.Left <> nil do + Start := Start.Left; + Result := TJclInOrderAnsiStrBinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + toPostOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Left <> nil then + Start := Start.Left + else + Start := Start.Right; + end; + Result := TJclPostOrderAnsiStrBinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclAnsiStrBinaryTree.GetEnumerator: IJclAnsiStrIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclAnsiStrBinaryTree.GetRoot: IJclAnsiStrTreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderAnsiStrBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toOrder: + Result := TJclInOrderAnsiStrBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TJclPostOrderAnsiStrBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrBinaryTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclAnsiStrBinaryTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclAnsiStrBinaryTree.Last: IJclAnsiStrIterator; +var + Start: TJclAnsiStrBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Right <> nil then + Start := Start.Right + else + Start := Start.Left; + end; + Result := TJclPreOrderAnsiStrBinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toOrder: + begin + if Start <> nil then + while Start.Right <> nil do + Start := Start.Right; + Result := TJclInOrderAnsiStrBinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TJclPostOrderAnsiStrBinaryTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrBinaryTree.Pack; +var + LeafArray: array of TJclAnsiStrBinaryNode; + ANode, BNode: TJclAnsiStrBinaryNode; + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetLength(Leafarray, FSize); + try + // in order enumeration of nodes + ANode := FRoot; + if ANode <> nil then + begin + // find first node + while ANode.Left <> nil do + ANode := ANode.Left; + + Index := 0; + while ANode <> nil do + begin + LeafArray[Index] := ANode; + Inc(Index); + if ANode.Right <> nil then + begin + ANode := ANode.Right; + while (ANode.Left <> nil) do + ANode := ANode.Left; + end + else + begin + BNode := ANode; + ANode := ANode.Parent; + while (ANode <> nil) and (ANode.Right = BNode) do + begin + BNode := ANode; + ANode := ANode.Parent; + end; + end; + end; + + Index := FSize shr 1; + FRoot := LeafArray[Index]; + FRoot.Parent := nil; + if Index > 0 then + FRoot.Left := BuildTree(LeafArray, 0, Index - 1, FRoot, 0) + else + FRoot.Left := nil; + if Index < (FSize - 1) then + FRoot.Right := BuildTree(LeafArray, Index + 1, FSize - 1, FRoot, 1) + else + FRoot.Right := nil; + end; + finally + SetLength(LeafArray, 0); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrBinaryTree.Remove(const AString: AnsiString): Boolean; +var + Extracted: AnsiString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AString); + if Result then + begin + Extracted := AString; + FreeString(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrBinaryTree.RemoveAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrBinaryTree.RetainAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrBinaryTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclAnsiStrBinaryTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclAnsiStrBinaryTree.Size: Integer; +begin + Result := FSize; +end; + +function TJclAnsiStrBinaryTree.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclAnsiStrBinaryTree.Create(Compare); + AssignPropertiesTo(Result); +end; + +//=== { TJclAnsiStrBinaryTreeIterator } =========================================================== + +constructor TJclAnsiStrBinaryTreeIterator.Create(const AOwnTree: TJclAnsiStrBinaryTree; ACursor: TJclAnsiStrBinaryNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FStart := AStart; + FOwnTree := AOwnTree; + FEqualityComparer := AOwnTree as IJclAnsiStrEqualityComparer; +end; + +function TJclAnsiStrBinaryTreeIterator.Add(const AString: AnsiString): Boolean; +begin + Result := FOwnTree.Add(AString); +end; + +function TJclAnsiStrBinaryTreeIterator.AddChild(const AString: AnsiString): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclAnsiStrBinaryTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclAnsiStrBinaryTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclAnsiStrBinaryTreeIterator then + begin + ADest := TJclAnsiStrBinaryTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclAnsiStrBinaryTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + Inc(Result); + if FCursor.Right <> nil then + Inc(Result); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrBinaryTreeIterator.DeleteChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclAnsiStrBinaryTreeIterator.DeleteChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclAnsiStrBinaryTreeIterator.Extract; +var + OldCursor: TJclAnsiStrBinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Extract(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrBinaryTreeIterator.ExtractChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclAnsiStrBinaryTreeIterator.ExtractChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclAnsiStrBinaryTreeIterator.GetChild(Index: Integer): AnsiString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := ''; + if (FCursor <> nil) and (Index = 0) and (FCursor.Left <> nil) then + FCursor := FCursor.Left + else + if (FCursor <> nil) and (Index = 0) then + FCursor := FCursor.Right + else + if (FCursor <> nil) and (Index = 1) then + FCursor := FCursor.Right + else + FCursor := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrBinaryTreeIterator.GetString: AnsiString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := ''; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrBinaryTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index = 0) then + Result := (FCursor.Left <> nil) or (FCursor.Right <> nil) + else + if (FCursor <> nil) and (Index = 1) then + Result := (FCursor.Left <> nil) and (FCursor.Right <> nil) + else + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrBinaryTreeIterator.HasLeft: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Left <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrBinaryTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrBinaryTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrBinaryTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrBinaryTreeIterator.HasRight: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Right <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrBinaryTreeIterator.IndexOfChild(const AString: AnsiString): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := -1; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + begin + if FEqualityComparer.ItemsEqual(FCursor.Left.Value, AString) then + Result := 0 + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, AString) then + Result := 1; + end + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, AString) then + Result := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrBinaryTreeIterator.Insert(const AString: AnsiString): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclAnsiStrBinaryTreeIterator.InsertChild(Index: Integer; const AString: AnsiString): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclAnsiStrBinaryTreeIterator.IteratorEquals(const AIterator: IJclAnsiStrIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclAnsiStrBinaryTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclAnsiStrBinaryTreeIterator then + begin + ItrObj := TJclAnsiStrBinaryTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +function TJclAnsiStrBinaryTreeIterator.Left: AnsiString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := ''; + if FCursor <> nil then + FCursor := FCursor.Left; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclAnsiStrBinaryTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclAnsiStrBinaryTreeIterator.Next: AnsiString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := ''; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrBinaryTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclAnsiStrBinaryTreeIterator.Parent: AnsiString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := ''; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrBinaryTreeIterator.Previous: AnsiString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := ''; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrBinaryTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclAnsiStrBinaryTreeIterator.Remove; +var + OldCursor: TJclAnsiStrBinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Remove(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrBinaryTreeIterator.Reset; +var + NewCursor: TJclAnsiStrBinaryNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrBinaryTreeIterator.Right: AnsiString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := ''; + if FCursor <> nil then + FCursor := FCursor.Right; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrBinaryTreeIterator.SetChild(Index: Integer; const AString: AnsiString); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclAnsiStrBinaryTreeIterator.SetString(const AString: AnsiString); +begin + raise EJclOperationNotSupportedError.Create; +end; + +//=== { TJclPreOrderAnsiStrBinaryTreeIterator } =================================================== + +function TJclPreOrderAnsiStrBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderAnsiStrBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderAnsiStrBinaryTreeIterator.GetNextCursor: TJclAnsiStrBinaryNode; +var + LastRet: TJclAnsiStrBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.Left <> nil then + Result := Result.Left + else + if Result.Right <> nil then + Result := Result.Right + else + begin + Result := Result.Parent; + while (Result <> nil) and ((Result.Right = nil) or (Result.Right = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Right; + end; +end; + +function TJclPreOrderAnsiStrBinaryTreeIterator.GetPreviousCursor: TJclAnsiStrBinaryNode; +var + LastRet: TJclAnsiStrBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Left <> LastRet) and (Result.Left <> nil) then + // come from Right + begin + Result := Result.Left; + while (Result.Left <> nil) or (Result.Right <> nil) do // both childs + begin + if Result.Right <> nil then // right child first + Result := Result.Right + else + Result := Result.Left; + end; + end; +end; + +//=== { TJclInOrderAnsiStrBinaryTreeIterator } ==================================================== + +function TJclInOrderAnsiStrBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclInOrderAnsiStrBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclInOrderAnsiStrBinaryTreeIterator.GetNextCursor: TJclAnsiStrBinaryNode; +var + LastRet: TJclAnsiStrBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + begin + Result := Result.Right; + while (Result.Left <> nil) do + Result := Result.Left; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right = LastRet) do + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +function TJclInOrderAnsiStrBinaryTreeIterator.GetPreviousCursor: TJclAnsiStrBinaryNode; +var + LastRet: TJclAnsiStrBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Left <> nil then + begin + Result := Result.Left; + while Result.Right <> nil do + Result := Result.Right; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right <> LastRet) do // Come from Left + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +//=== { TJclPostOrderAnsiStrBinaryTreeIterator } ================================================== + +function TJclPostOrderAnsiStrBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderAnsiStrBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderAnsiStrBinaryTreeIterator.GetNextCursor: TJclAnsiStrBinaryNode; +var + LastRet: TJclAnsiStrBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Right <> nil) and (Result.Right <> LastRet) then + begin + Result := Result.Right; + while (Result.Left <> nil) or (Result.Right <> nil) do + begin + if Result.Left <> nil then + Result := Result.Left + else + Result := Result.Right; + end; + end; +end; + +function TJclPostOrderAnsiStrBinaryTreeIterator.GetPreviousCursor: TJclAnsiStrBinaryNode; +var + LastRet: TJclAnsiStrBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + Result := Result.Right + else + if Result.Left <> nil then + Result := Result.Left + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and ((Result.Left = nil) or (Result.Left = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Left; + end; +end; + +//=== { TJclWideStrBinaryTree } ================================================= + +constructor TJclWideStrBinaryTree.Create(ACompare: TWideStrCompare); +begin + inherited Create(); + FTraverseOrder := toOrder; + FMaxDepth := 0; + FAutoPackParameter := 2; + SetCompare(ACompare); +end; + +destructor TJclWideStrBinaryTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclWideStrBinaryTree.Add(const AString: WideString): Boolean; +var + NewNode, Current, Save: TJclWideStrBinaryNode; + Comp, Depth: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // Insert into right place + if FAllowDefaultElements or not ItemsEqual(AString, '') then + begin + Save := nil; + Current := FRoot; + Comp := 1; + Depth := 0; + while Current <> nil do + begin + Inc(Depth); + Save := Current; + Comp := ItemsCompare(AString, Current.Value); + if Comp < 0 then + Current := Current.Left + else + if Comp > 0 then + Current := Current.Right + else + if CheckDuplicate then + Current := Current.Left // arbitrary decision + else + Break; + end; + if (Comp <> 0) or CheckDuplicate then + begin + NewNode := TJclWideStrBinaryNode.Create; + NewNode.Value := AString; + NewNode.Parent := Save; + if Save = nil then + FRoot := NewNode + else + if ItemsCompare(NewNode.Value, Save.Value) <= 0 then + Save.Left := NewNode + else + Save.Right := NewNode; + Inc(FSize); + Inc(Depth); + if Depth > FMaxDepth then + FMaxDepth := Depth; + Result := True; + AutoPack; + end + else + Result := False; + end + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrBinaryTree.AddAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrBinaryTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclWideStrBinaryTree; + ACollection: IJclWideStrCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclWideStrBinaryTree then + begin + ADest := TJclWideStrBinaryTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclWideStrCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclWideStrBinaryTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclWideStrBinaryTree then + TJclWideStrBinaryTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclWideStrBinaryTree.AutoPack; +begin + case FAutoPackStrategy of + //apsDisabled: ; + apsAgressive: + if (FMaxDepth > 1) and (((1 shl (FMaxDepth - 1)) - 1) > FSize) then + Pack; + // apsIncremental: ; + apsProportional: + if (FMaxDepth > FAutoPackParameter) and (((1 shl (FMaxDepth - FAutoPackParameter)) - 1) > FSize) then + Pack; + end; +end; + +function TJclWideStrBinaryTree.BuildTree(const LeafArray: array of TJclWideStrBinaryNode; Left, Right: Integer; Parent: TJclWideStrBinaryNode; + Offset: Integer): TJclWideStrBinaryNode; +var + Middle: Integer; +begin + Middle := (Left + Right + Offset) shr 1; + Result := LeafArray[Middle]; + Result.Parent := Parent; + if Middle > Left then + Result.Left := BuildTree(LeafArray, Left, Middle - 1, Result, 0) + else + Result.Left := nil; + if Middle < Right then + Result.Right := BuildTree(LeafArray, Middle + 1, Right, Result, 1) + else + Result.Right := nil; +end; + +procedure TJclWideStrBinaryTree.Clear; +var + Current, Parent: TJclWideStrBinaryNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // postorder + Current := FRoot; + if Current = nil then + Exit; + // find first in post-order + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + // for all items in the tree in post-order + repeat + Parent := Current.Parent; + // remove reference + if Parent <> nil then + begin + if Parent.Left = Current then + Parent.Left := nil + else + if Parent.Right = Current then + Parent.Right := nil; + end; + + // free item + FreeString(Current.Value); + Current.Free; + + // find next item + Current := Parent; + if (Current <> nil) and (Current.Right <> nil) then + begin + Current := Current.Right; + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + end; + until Current = nil; + FRoot := nil; + FSize := 0; + FMaxDepth := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrBinaryTree.CloneNode(Node, Parent: TJclWideStrBinaryNode): TJclWideStrBinaryNode; +begin + Result := TJclWideStrBinaryNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + if Node.Left <> nil then + Result.Left := CloneNode(Node.Left, Result); // recursive call + if Node.Right <> nil then + Result.Right := CloneNode(Node.Right, Result); // recursive call +end; + +function TJclWideStrBinaryTree.CollectionEquals(const ACollection: IJclWideStrCollection): Boolean; +var + It, ItSelf: IJclWideStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrBinaryTree.Contains(const AString: WideString): Boolean; +var + Comp: Integer; + Current: TJclWideStrBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FRoot; + while Current <> nil do + begin + Comp := ItemsCompare(Current.Value, AString); + if Comp = 0 then + begin + Result := True; + Break; + end + else + if Comp > 0 then + Current := Current.Left + else + Current := Current.Right; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrBinaryTree.ContainsAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrBinaryTree.Extract(const AString: WideString): Boolean; +var + Current, Successor: TJclWideStrBinaryNode; + Comp: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + // locate AString in the tree + Current := FRoot; + repeat + while Current <> nil do + begin + Comp := ItemsCompare(AString, Current.Value); + if Comp = 0 then + Break + else + if Comp < 0 then + Current := Current.Left + else + Current := Current.Right; + end; + if Current = nil then + Break; + Result := True; + // Remove Current from tree + if (Current.Left = nil) and (Current.Right <> nil) then + begin + // remove references to Current + Current.Right.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Right + else + Current.Parent.Right := Current.Right; + end + else + // fix root + FRoot := Current.Right; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right = nil) then + begin + // remove references to Current + Current.Left.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Left + else + Current.Parent.Right := Current.Left; + end + else + // fix root + FRoot := Current.Left; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right <> nil) then + begin + // find the successor in tree + Successor := Current.Right; + while Successor.Left <> nil do + Successor := Successor.Left; + + if Successor <> Current.Right then + begin + // remove references to successor + Successor.Parent.Left := Successor.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor.Parent; + Successor.Right := Current.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor; + end; + + // insert successor in new position + Successor.Left := Current.Left; + if Current.Left <> nil then + Current.Left.Parent := Successor; + Successor.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Successor + else + Current.Parent.Right := Successor; + end + else + // fix root + FRoot := Successor; + Successor := Current.Parent; + if Successor <> nil then + Successor := FRoot; + end + else + begin + // (Current.Left = nil) and (Current.Right = nil) + Successor := Current.Parent; + if Successor <> nil then + begin + // remove references from parent + if Successor.Left = Current then + Successor.Left := nil + else + Successor.Right := nil; + end + else + FRoot := nil; + end; + Current.Value := ''; + Current.Free; + Dec(FSize); + Current := Successor; + until FRemoveSingleElement or (Current = nil); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrBinaryTree.ExtractAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrBinaryTree.First: IJclWideStrIterator; +var + Start: TJclWideStrBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderWideStrBinaryTreeIterator.Create(Self, Start, False, isFirst); + toOrder: + begin + if Start <> nil then + while Start.Left <> nil do + Start := Start.Left; + Result := TJclInOrderWideStrBinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + toPostOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Left <> nil then + Start := Start.Left + else + Start := Start.Right; + end; + Result := TJclPostOrderWideStrBinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclWideStrBinaryTree.GetEnumerator: IJclWideStrIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclWideStrBinaryTree.GetRoot: IJclWideStrTreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderWideStrBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toOrder: + Result := TJclInOrderWideStrBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TJclPostOrderWideStrBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrBinaryTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclWideStrBinaryTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclWideStrBinaryTree.Last: IJclWideStrIterator; +var + Start: TJclWideStrBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Right <> nil then + Start := Start.Right + else + Start := Start.Left; + end; + Result := TJclPreOrderWideStrBinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toOrder: + begin + if Start <> nil then + while Start.Right <> nil do + Start := Start.Right; + Result := TJclInOrderWideStrBinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TJclPostOrderWideStrBinaryTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrBinaryTree.Pack; +var + LeafArray: array of TJclWideStrBinaryNode; + ANode, BNode: TJclWideStrBinaryNode; + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetLength(Leafarray, FSize); + try + // in order enumeration of nodes + ANode := FRoot; + if ANode <> nil then + begin + // find first node + while ANode.Left <> nil do + ANode := ANode.Left; + + Index := 0; + while ANode <> nil do + begin + LeafArray[Index] := ANode; + Inc(Index); + if ANode.Right <> nil then + begin + ANode := ANode.Right; + while (ANode.Left <> nil) do + ANode := ANode.Left; + end + else + begin + BNode := ANode; + ANode := ANode.Parent; + while (ANode <> nil) and (ANode.Right = BNode) do + begin + BNode := ANode; + ANode := ANode.Parent; + end; + end; + end; + + Index := FSize shr 1; + FRoot := LeafArray[Index]; + FRoot.Parent := nil; + if Index > 0 then + FRoot.Left := BuildTree(LeafArray, 0, Index - 1, FRoot, 0) + else + FRoot.Left := nil; + if Index < (FSize - 1) then + FRoot.Right := BuildTree(LeafArray, Index + 1, FSize - 1, FRoot, 1) + else + FRoot.Right := nil; + end; + finally + SetLength(LeafArray, 0); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrBinaryTree.Remove(const AString: WideString): Boolean; +var + Extracted: WideString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AString); + if Result then + begin + Extracted := AString; + FreeString(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrBinaryTree.RemoveAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrBinaryTree.RetainAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrBinaryTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclWideStrBinaryTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclWideStrBinaryTree.Size: Integer; +begin + Result := FSize; +end; + +function TJclWideStrBinaryTree.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclWideStrBinaryTree.Create(Compare); + AssignPropertiesTo(Result); +end; + +//=== { TJclWideStrBinaryTreeIterator } =========================================================== + +constructor TJclWideStrBinaryTreeIterator.Create(const AOwnTree: TJclWideStrBinaryTree; ACursor: TJclWideStrBinaryNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FStart := AStart; + FOwnTree := AOwnTree; + FEqualityComparer := AOwnTree as IJclWideStrEqualityComparer; +end; + +function TJclWideStrBinaryTreeIterator.Add(const AString: WideString): Boolean; +begin + Result := FOwnTree.Add(AString); +end; + +function TJclWideStrBinaryTreeIterator.AddChild(const AString: WideString): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclWideStrBinaryTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclWideStrBinaryTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclWideStrBinaryTreeIterator then + begin + ADest := TJclWideStrBinaryTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclWideStrBinaryTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + Inc(Result); + if FCursor.Right <> nil then + Inc(Result); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrBinaryTreeIterator.DeleteChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclWideStrBinaryTreeIterator.DeleteChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclWideStrBinaryTreeIterator.Extract; +var + OldCursor: TJclWideStrBinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Extract(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrBinaryTreeIterator.ExtractChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclWideStrBinaryTreeIterator.ExtractChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclWideStrBinaryTreeIterator.GetChild(Index: Integer): WideString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := ''; + if (FCursor <> nil) and (Index = 0) and (FCursor.Left <> nil) then + FCursor := FCursor.Left + else + if (FCursor <> nil) and (Index = 0) then + FCursor := FCursor.Right + else + if (FCursor <> nil) and (Index = 1) then + FCursor := FCursor.Right + else + FCursor := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrBinaryTreeIterator.GetString: WideString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := ''; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrBinaryTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index = 0) then + Result := (FCursor.Left <> nil) or (FCursor.Right <> nil) + else + if (FCursor <> nil) and (Index = 1) then + Result := (FCursor.Left <> nil) and (FCursor.Right <> nil) + else + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrBinaryTreeIterator.HasLeft: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Left <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrBinaryTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrBinaryTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrBinaryTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrBinaryTreeIterator.HasRight: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Right <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrBinaryTreeIterator.IndexOfChild(const AString: WideString): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := -1; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + begin + if FEqualityComparer.ItemsEqual(FCursor.Left.Value, AString) then + Result := 0 + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, AString) then + Result := 1; + end + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, AString) then + Result := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrBinaryTreeIterator.Insert(const AString: WideString): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclWideStrBinaryTreeIterator.InsertChild(Index: Integer; const AString: WideString): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclWideStrBinaryTreeIterator.IteratorEquals(const AIterator: IJclWideStrIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclWideStrBinaryTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclWideStrBinaryTreeIterator then + begin + ItrObj := TJclWideStrBinaryTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +function TJclWideStrBinaryTreeIterator.Left: WideString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := ''; + if FCursor <> nil then + FCursor := FCursor.Left; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclWideStrBinaryTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclWideStrBinaryTreeIterator.Next: WideString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := ''; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrBinaryTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclWideStrBinaryTreeIterator.Parent: WideString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := ''; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrBinaryTreeIterator.Previous: WideString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := ''; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrBinaryTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclWideStrBinaryTreeIterator.Remove; +var + OldCursor: TJclWideStrBinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Remove(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrBinaryTreeIterator.Reset; +var + NewCursor: TJclWideStrBinaryNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrBinaryTreeIterator.Right: WideString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := ''; + if FCursor <> nil then + FCursor := FCursor.Right; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrBinaryTreeIterator.SetChild(Index: Integer; const AString: WideString); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclWideStrBinaryTreeIterator.SetString(const AString: WideString); +begin + raise EJclOperationNotSupportedError.Create; +end; + +//=== { TJclPreOrderWideStrBinaryTreeIterator } =================================================== + +function TJclPreOrderWideStrBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderWideStrBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderWideStrBinaryTreeIterator.GetNextCursor: TJclWideStrBinaryNode; +var + LastRet: TJclWideStrBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.Left <> nil then + Result := Result.Left + else + if Result.Right <> nil then + Result := Result.Right + else + begin + Result := Result.Parent; + while (Result <> nil) and ((Result.Right = nil) or (Result.Right = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Right; + end; +end; + +function TJclPreOrderWideStrBinaryTreeIterator.GetPreviousCursor: TJclWideStrBinaryNode; +var + LastRet: TJclWideStrBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Left <> LastRet) and (Result.Left <> nil) then + // come from Right + begin + Result := Result.Left; + while (Result.Left <> nil) or (Result.Right <> nil) do // both childs + begin + if Result.Right <> nil then // right child first + Result := Result.Right + else + Result := Result.Left; + end; + end; +end; + +//=== { TJclInOrderWideStrBinaryTreeIterator } ==================================================== + +function TJclInOrderWideStrBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclInOrderWideStrBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclInOrderWideStrBinaryTreeIterator.GetNextCursor: TJclWideStrBinaryNode; +var + LastRet: TJclWideStrBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + begin + Result := Result.Right; + while (Result.Left <> nil) do + Result := Result.Left; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right = LastRet) do + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +function TJclInOrderWideStrBinaryTreeIterator.GetPreviousCursor: TJclWideStrBinaryNode; +var + LastRet: TJclWideStrBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Left <> nil then + begin + Result := Result.Left; + while Result.Right <> nil do + Result := Result.Right; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right <> LastRet) do // Come from Left + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +//=== { TJclPostOrderWideStrBinaryTreeIterator } ================================================== + +function TJclPostOrderWideStrBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderWideStrBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderWideStrBinaryTreeIterator.GetNextCursor: TJclWideStrBinaryNode; +var + LastRet: TJclWideStrBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Right <> nil) and (Result.Right <> LastRet) then + begin + Result := Result.Right; + while (Result.Left <> nil) or (Result.Right <> nil) do + begin + if Result.Left <> nil then + Result := Result.Left + else + Result := Result.Right; + end; + end; +end; + +function TJclPostOrderWideStrBinaryTreeIterator.GetPreviousCursor: TJclWideStrBinaryNode; +var + LastRet: TJclWideStrBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + Result := Result.Right + else + if Result.Left <> nil then + Result := Result.Left + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and ((Result.Left = nil) or (Result.Left = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Left; + end; +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrBinaryTree } ================================================= + +constructor TJclUnicodeStrBinaryTree.Create(ACompare: TUnicodeStrCompare); +begin + inherited Create(); + FTraverseOrder := toOrder; + FMaxDepth := 0; + FAutoPackParameter := 2; + SetCompare(ACompare); +end; + +destructor TJclUnicodeStrBinaryTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclUnicodeStrBinaryTree.Add(const AString: UnicodeString): Boolean; +var + NewNode, Current, Save: TJclUnicodeStrBinaryNode; + Comp, Depth: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // Insert into right place + if FAllowDefaultElements or not ItemsEqual(AString, '') then + begin + Save := nil; + Current := FRoot; + Comp := 1; + Depth := 0; + while Current <> nil do + begin + Inc(Depth); + Save := Current; + Comp := ItemsCompare(AString, Current.Value); + if Comp < 0 then + Current := Current.Left + else + if Comp > 0 then + Current := Current.Right + else + if CheckDuplicate then + Current := Current.Left // arbitrary decision + else + Break; + end; + if (Comp <> 0) or CheckDuplicate then + begin + NewNode := TJclUnicodeStrBinaryNode.Create; + NewNode.Value := AString; + NewNode.Parent := Save; + if Save = nil then + FRoot := NewNode + else + if ItemsCompare(NewNode.Value, Save.Value) <= 0 then + Save.Left := NewNode + else + Save.Right := NewNode; + Inc(FSize); + Inc(Depth); + if Depth > FMaxDepth then + FMaxDepth := Depth; + Result := True; + AutoPack; + end + else + Result := False; + end + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrBinaryTree.AddAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrBinaryTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclUnicodeStrBinaryTree; + ACollection: IJclUnicodeStrCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclUnicodeStrBinaryTree then + begin + ADest := TJclUnicodeStrBinaryTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclUnicodeStrCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclUnicodeStrBinaryTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclUnicodeStrBinaryTree then + TJclUnicodeStrBinaryTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclUnicodeStrBinaryTree.AutoPack; +begin + case FAutoPackStrategy of + //apsDisabled: ; + apsAgressive: + if (FMaxDepth > 1) and (((1 shl (FMaxDepth - 1)) - 1) > FSize) then + Pack; + // apsIncremental: ; + apsProportional: + if (FMaxDepth > FAutoPackParameter) and (((1 shl (FMaxDepth - FAutoPackParameter)) - 1) > FSize) then + Pack; + end; +end; + +function TJclUnicodeStrBinaryTree.BuildTree(const LeafArray: array of TJclUnicodeStrBinaryNode; Left, Right: Integer; Parent: TJclUnicodeStrBinaryNode; + Offset: Integer): TJclUnicodeStrBinaryNode; +var + Middle: Integer; +begin + Middle := (Left + Right + Offset) shr 1; + Result := LeafArray[Middle]; + Result.Parent := Parent; + if Middle > Left then + Result.Left := BuildTree(LeafArray, Left, Middle - 1, Result, 0) + else + Result.Left := nil; + if Middle < Right then + Result.Right := BuildTree(LeafArray, Middle + 1, Right, Result, 1) + else + Result.Right := nil; +end; + +procedure TJclUnicodeStrBinaryTree.Clear; +var + Current, Parent: TJclUnicodeStrBinaryNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // postorder + Current := FRoot; + if Current = nil then + Exit; + // find first in post-order + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + // for all items in the tree in post-order + repeat + Parent := Current.Parent; + // remove reference + if Parent <> nil then + begin + if Parent.Left = Current then + Parent.Left := nil + else + if Parent.Right = Current then + Parent.Right := nil; + end; + + // free item + FreeString(Current.Value); + Current.Free; + + // find next item + Current := Parent; + if (Current <> nil) and (Current.Right <> nil) then + begin + Current := Current.Right; + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + end; + until Current = nil; + FRoot := nil; + FSize := 0; + FMaxDepth := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrBinaryTree.CloneNode(Node, Parent: TJclUnicodeStrBinaryNode): TJclUnicodeStrBinaryNode; +begin + Result := TJclUnicodeStrBinaryNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + if Node.Left <> nil then + Result.Left := CloneNode(Node.Left, Result); // recursive call + if Node.Right <> nil then + Result.Right := CloneNode(Node.Right, Result); // recursive call +end; + +function TJclUnicodeStrBinaryTree.CollectionEquals(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It, ItSelf: IJclUnicodeStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrBinaryTree.Contains(const AString: UnicodeString): Boolean; +var + Comp: Integer; + Current: TJclUnicodeStrBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FRoot; + while Current <> nil do + begin + Comp := ItemsCompare(Current.Value, AString); + if Comp = 0 then + begin + Result := True; + Break; + end + else + if Comp > 0 then + Current := Current.Left + else + Current := Current.Right; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrBinaryTree.ContainsAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrBinaryTree.Extract(const AString: UnicodeString): Boolean; +var + Current, Successor: TJclUnicodeStrBinaryNode; + Comp: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + // locate AString in the tree + Current := FRoot; + repeat + while Current <> nil do + begin + Comp := ItemsCompare(AString, Current.Value); + if Comp = 0 then + Break + else + if Comp < 0 then + Current := Current.Left + else + Current := Current.Right; + end; + if Current = nil then + Break; + Result := True; + // Remove Current from tree + if (Current.Left = nil) and (Current.Right <> nil) then + begin + // remove references to Current + Current.Right.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Right + else + Current.Parent.Right := Current.Right; + end + else + // fix root + FRoot := Current.Right; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right = nil) then + begin + // remove references to Current + Current.Left.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Left + else + Current.Parent.Right := Current.Left; + end + else + // fix root + FRoot := Current.Left; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right <> nil) then + begin + // find the successor in tree + Successor := Current.Right; + while Successor.Left <> nil do + Successor := Successor.Left; + + if Successor <> Current.Right then + begin + // remove references to successor + Successor.Parent.Left := Successor.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor.Parent; + Successor.Right := Current.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor; + end; + + // insert successor in new position + Successor.Left := Current.Left; + if Current.Left <> nil then + Current.Left.Parent := Successor; + Successor.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Successor + else + Current.Parent.Right := Successor; + end + else + // fix root + FRoot := Successor; + Successor := Current.Parent; + if Successor <> nil then + Successor := FRoot; + end + else + begin + // (Current.Left = nil) and (Current.Right = nil) + Successor := Current.Parent; + if Successor <> nil then + begin + // remove references from parent + if Successor.Left = Current then + Successor.Left := nil + else + Successor.Right := nil; + end + else + FRoot := nil; + end; + Current.Value := ''; + Current.Free; + Dec(FSize); + Current := Successor; + until FRemoveSingleElement or (Current = nil); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrBinaryTree.ExtractAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrBinaryTree.First: IJclUnicodeStrIterator; +var + Start: TJclUnicodeStrBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderUnicodeStrBinaryTreeIterator.Create(Self, Start, False, isFirst); + toOrder: + begin + if Start <> nil then + while Start.Left <> nil do + Start := Start.Left; + Result := TJclInOrderUnicodeStrBinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + toPostOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Left <> nil then + Start := Start.Left + else + Start := Start.Right; + end; + Result := TJclPostOrderUnicodeStrBinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclUnicodeStrBinaryTree.GetEnumerator: IJclUnicodeStrIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclUnicodeStrBinaryTree.GetRoot: IJclUnicodeStrTreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderUnicodeStrBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toOrder: + Result := TJclInOrderUnicodeStrBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TJclPostOrderUnicodeStrBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrBinaryTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclUnicodeStrBinaryTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclUnicodeStrBinaryTree.Last: IJclUnicodeStrIterator; +var + Start: TJclUnicodeStrBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Right <> nil then + Start := Start.Right + else + Start := Start.Left; + end; + Result := TJclPreOrderUnicodeStrBinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toOrder: + begin + if Start <> nil then + while Start.Right <> nil do + Start := Start.Right; + Result := TJclInOrderUnicodeStrBinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TJclPostOrderUnicodeStrBinaryTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrBinaryTree.Pack; +var + LeafArray: array of TJclUnicodeStrBinaryNode; + ANode, BNode: TJclUnicodeStrBinaryNode; + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetLength(Leafarray, FSize); + try + // in order enumeration of nodes + ANode := FRoot; + if ANode <> nil then + begin + // find first node + while ANode.Left <> nil do + ANode := ANode.Left; + + Index := 0; + while ANode <> nil do + begin + LeafArray[Index] := ANode; + Inc(Index); + if ANode.Right <> nil then + begin + ANode := ANode.Right; + while (ANode.Left <> nil) do + ANode := ANode.Left; + end + else + begin + BNode := ANode; + ANode := ANode.Parent; + while (ANode <> nil) and (ANode.Right = BNode) do + begin + BNode := ANode; + ANode := ANode.Parent; + end; + end; + end; + + Index := FSize shr 1; + FRoot := LeafArray[Index]; + FRoot.Parent := nil; + if Index > 0 then + FRoot.Left := BuildTree(LeafArray, 0, Index - 1, FRoot, 0) + else + FRoot.Left := nil; + if Index < (FSize - 1) then + FRoot.Right := BuildTree(LeafArray, Index + 1, FSize - 1, FRoot, 1) + else + FRoot.Right := nil; + end; + finally + SetLength(LeafArray, 0); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrBinaryTree.Remove(const AString: UnicodeString): Boolean; +var + Extracted: UnicodeString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AString); + if Result then + begin + Extracted := AString; + FreeString(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrBinaryTree.RemoveAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrBinaryTree.RetainAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrBinaryTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclUnicodeStrBinaryTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclUnicodeStrBinaryTree.Size: Integer; +begin + Result := FSize; +end; + +function TJclUnicodeStrBinaryTree.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclUnicodeStrBinaryTree.Create(Compare); + AssignPropertiesTo(Result); +end; + +{$ENDIF SUPPORTS_UNICODE_STRING} + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrBinaryTreeIterator } =========================================================== + +constructor TJclUnicodeStrBinaryTreeIterator.Create(const AOwnTree: TJclUnicodeStrBinaryTree; ACursor: TJclUnicodeStrBinaryNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FStart := AStart; + FOwnTree := AOwnTree; + FEqualityComparer := AOwnTree as IJclUnicodeStrEqualityComparer; +end; + +function TJclUnicodeStrBinaryTreeIterator.Add(const AString: UnicodeString): Boolean; +begin + Result := FOwnTree.Add(AString); +end; + +function TJclUnicodeStrBinaryTreeIterator.AddChild(const AString: UnicodeString): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclUnicodeStrBinaryTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclUnicodeStrBinaryTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclUnicodeStrBinaryTreeIterator then + begin + ADest := TJclUnicodeStrBinaryTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclUnicodeStrBinaryTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + Inc(Result); + if FCursor.Right <> nil then + Inc(Result); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrBinaryTreeIterator.DeleteChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclUnicodeStrBinaryTreeIterator.DeleteChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclUnicodeStrBinaryTreeIterator.Extract; +var + OldCursor: TJclUnicodeStrBinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Extract(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrBinaryTreeIterator.ExtractChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclUnicodeStrBinaryTreeIterator.ExtractChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclUnicodeStrBinaryTreeIterator.GetChild(Index: Integer): UnicodeString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := ''; + if (FCursor <> nil) and (Index = 0) and (FCursor.Left <> nil) then + FCursor := FCursor.Left + else + if (FCursor <> nil) and (Index = 0) then + FCursor := FCursor.Right + else + if (FCursor <> nil) and (Index = 1) then + FCursor := FCursor.Right + else + FCursor := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrBinaryTreeIterator.GetString: UnicodeString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := ''; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrBinaryTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index = 0) then + Result := (FCursor.Left <> nil) or (FCursor.Right <> nil) + else + if (FCursor <> nil) and (Index = 1) then + Result := (FCursor.Left <> nil) and (FCursor.Right <> nil) + else + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrBinaryTreeIterator.HasLeft: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Left <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrBinaryTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrBinaryTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrBinaryTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrBinaryTreeIterator.HasRight: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Right <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrBinaryTreeIterator.IndexOfChild(const AString: UnicodeString): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := -1; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + begin + if FEqualityComparer.ItemsEqual(FCursor.Left.Value, AString) then + Result := 0 + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, AString) then + Result := 1; + end + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, AString) then + Result := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrBinaryTreeIterator.Insert(const AString: UnicodeString): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclUnicodeStrBinaryTreeIterator.InsertChild(Index: Integer; const AString: UnicodeString): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclUnicodeStrBinaryTreeIterator.IteratorEquals(const AIterator: IJclUnicodeStrIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclUnicodeStrBinaryTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclUnicodeStrBinaryTreeIterator then + begin + ItrObj := TJclUnicodeStrBinaryTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +function TJclUnicodeStrBinaryTreeIterator.Left: UnicodeString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := ''; + if FCursor <> nil then + FCursor := FCursor.Left; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclUnicodeStrBinaryTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclUnicodeStrBinaryTreeIterator.Next: UnicodeString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := ''; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrBinaryTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclUnicodeStrBinaryTreeIterator.Parent: UnicodeString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := ''; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrBinaryTreeIterator.Previous: UnicodeString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := ''; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrBinaryTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclUnicodeStrBinaryTreeIterator.Remove; +var + OldCursor: TJclUnicodeStrBinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Remove(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrBinaryTreeIterator.Reset; +var + NewCursor: TJclUnicodeStrBinaryNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrBinaryTreeIterator.Right: UnicodeString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := ''; + if FCursor <> nil then + FCursor := FCursor.Right; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrBinaryTreeIterator.SetChild(Index: Integer; const AString: UnicodeString); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclUnicodeStrBinaryTreeIterator.SetString(const AString: UnicodeString); +begin + raise EJclOperationNotSupportedError.Create; +end; + +//=== { TJclPreOrderUnicodeStrBinaryTreeIterator } =================================================== + +function TJclPreOrderUnicodeStrBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderUnicodeStrBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderUnicodeStrBinaryTreeIterator.GetNextCursor: TJclUnicodeStrBinaryNode; +var + LastRet: TJclUnicodeStrBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.Left <> nil then + Result := Result.Left + else + if Result.Right <> nil then + Result := Result.Right + else + begin + Result := Result.Parent; + while (Result <> nil) and ((Result.Right = nil) or (Result.Right = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Right; + end; +end; + +function TJclPreOrderUnicodeStrBinaryTreeIterator.GetPreviousCursor: TJclUnicodeStrBinaryNode; +var + LastRet: TJclUnicodeStrBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Left <> LastRet) and (Result.Left <> nil) then + // come from Right + begin + Result := Result.Left; + while (Result.Left <> nil) or (Result.Right <> nil) do // both childs + begin + if Result.Right <> nil then // right child first + Result := Result.Right + else + Result := Result.Left; + end; + end; +end; + +//=== { TJclInOrderUnicodeStrBinaryTreeIterator } ==================================================== + +function TJclInOrderUnicodeStrBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclInOrderUnicodeStrBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclInOrderUnicodeStrBinaryTreeIterator.GetNextCursor: TJclUnicodeStrBinaryNode; +var + LastRet: TJclUnicodeStrBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + begin + Result := Result.Right; + while (Result.Left <> nil) do + Result := Result.Left; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right = LastRet) do + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +function TJclInOrderUnicodeStrBinaryTreeIterator.GetPreviousCursor: TJclUnicodeStrBinaryNode; +var + LastRet: TJclUnicodeStrBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Left <> nil then + begin + Result := Result.Left; + while Result.Right <> nil do + Result := Result.Right; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right <> LastRet) do // Come from Left + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +//=== { TJclPostOrderUnicodeStrBinaryTreeIterator } ================================================== + +function TJclPostOrderUnicodeStrBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderUnicodeStrBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderUnicodeStrBinaryTreeIterator.GetNextCursor: TJclUnicodeStrBinaryNode; +var + LastRet: TJclUnicodeStrBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Right <> nil) and (Result.Right <> LastRet) then + begin + Result := Result.Right; + while (Result.Left <> nil) or (Result.Right <> nil) do + begin + if Result.Left <> nil then + Result := Result.Left + else + Result := Result.Right; + end; + end; +end; + +function TJclPostOrderUnicodeStrBinaryTreeIterator.GetPreviousCursor: TJclUnicodeStrBinaryNode; +var + LastRet: TJclUnicodeStrBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + Result := Result.Right + else + if Result.Left <> nil then + Result := Result.Left + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and ((Result.Left = nil) or (Result.Left = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Left; + end; +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +//=== { TJclSingleBinaryTree } ================================================= + +constructor TJclSingleBinaryTree.Create(ACompare: TSingleCompare); +begin + inherited Create(); + FTraverseOrder := toOrder; + FMaxDepth := 0; + FAutoPackParameter := 2; + SetCompare(ACompare); +end; + +destructor TJclSingleBinaryTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclSingleBinaryTree.Add(const AValue: Single): Boolean; +var + NewNode, Current, Save: TJclSingleBinaryNode; + Comp, Depth: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // Insert into right place + if FAllowDefaultElements or not ItemsEqual(AValue, 0.0) then + begin + Save := nil; + Current := FRoot; + Comp := 1; + Depth := 0; + while Current <> nil do + begin + Inc(Depth); + Save := Current; + Comp := ItemsCompare(AValue, Current.Value); + if Comp < 0 then + Current := Current.Left + else + if Comp > 0 then + Current := Current.Right + else + if CheckDuplicate then + Current := Current.Left // arbitrary decision + else + Break; + end; + if (Comp <> 0) or CheckDuplicate then + begin + NewNode := TJclSingleBinaryNode.Create; + NewNode.Value := AValue; + NewNode.Parent := Save; + if Save = nil then + FRoot := NewNode + else + if ItemsCompare(NewNode.Value, Save.Value) <= 0 then + Save.Left := NewNode + else + Save.Right := NewNode; + Inc(FSize); + Inc(Depth); + if Depth > FMaxDepth then + FMaxDepth := Depth; + Result := True; + AutoPack; + end + else + Result := False; + end + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleBinaryTree.AddAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleBinaryTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclSingleBinaryTree; + ACollection: IJclSingleCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclSingleBinaryTree then + begin + ADest := TJclSingleBinaryTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclSingleCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclSingleBinaryTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclSingleBinaryTree then + TJclSingleBinaryTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclSingleBinaryTree.AutoPack; +begin + case FAutoPackStrategy of + //apsDisabled: ; + apsAgressive: + if (FMaxDepth > 1) and (((1 shl (FMaxDepth - 1)) - 1) > FSize) then + Pack; + // apsIncremental: ; + apsProportional: + if (FMaxDepth > FAutoPackParameter) and (((1 shl (FMaxDepth - FAutoPackParameter)) - 1) > FSize) then + Pack; + end; +end; + +function TJclSingleBinaryTree.BuildTree(const LeafArray: array of TJclSingleBinaryNode; Left, Right: Integer; Parent: TJclSingleBinaryNode; + Offset: Integer): TJclSingleBinaryNode; +var + Middle: Integer; +begin + Middle := (Left + Right + Offset) shr 1; + Result := LeafArray[Middle]; + Result.Parent := Parent; + if Middle > Left then + Result.Left := BuildTree(LeafArray, Left, Middle - 1, Result, 0) + else + Result.Left := nil; + if Middle < Right then + Result.Right := BuildTree(LeafArray, Middle + 1, Right, Result, 1) + else + Result.Right := nil; +end; + +procedure TJclSingleBinaryTree.Clear; +var + Current, Parent: TJclSingleBinaryNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // postorder + Current := FRoot; + if Current = nil then + Exit; + // find first in post-order + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + // for all items in the tree in post-order + repeat + Parent := Current.Parent; + // remove reference + if Parent <> nil then + begin + if Parent.Left = Current then + Parent.Left := nil + else + if Parent.Right = Current then + Parent.Right := nil; + end; + + // free item + FreeSingle(Current.Value); + Current.Free; + + // find next item + Current := Parent; + if (Current <> nil) and (Current.Right <> nil) then + begin + Current := Current.Right; + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + end; + until Current = nil; + FRoot := nil; + FSize := 0; + FMaxDepth := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleBinaryTree.CloneNode(Node, Parent: TJclSingleBinaryNode): TJclSingleBinaryNode; +begin + Result := TJclSingleBinaryNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + if Node.Left <> nil then + Result.Left := CloneNode(Node.Left, Result); // recursive call + if Node.Right <> nil then + Result.Right := CloneNode(Node.Right, Result); // recursive call +end; + +function TJclSingleBinaryTree.CollectionEquals(const ACollection: IJclSingleCollection): Boolean; +var + It, ItSelf: IJclSingleIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleBinaryTree.Contains(const AValue: Single): Boolean; +var + Comp: Integer; + Current: TJclSingleBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FRoot; + while Current <> nil do + begin + Comp := ItemsCompare(Current.Value, AValue); + if Comp = 0 then + begin + Result := True; + Break; + end + else + if Comp > 0 then + Current := Current.Left + else + Current := Current.Right; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleBinaryTree.ContainsAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleBinaryTree.Extract(const AValue: Single): Boolean; +var + Current, Successor: TJclSingleBinaryNode; + Comp: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + // locate AValue in the tree + Current := FRoot; + repeat + while Current <> nil do + begin + Comp := ItemsCompare(AValue, Current.Value); + if Comp = 0 then + Break + else + if Comp < 0 then + Current := Current.Left + else + Current := Current.Right; + end; + if Current = nil then + Break; + Result := True; + // Remove Current from tree + if (Current.Left = nil) and (Current.Right <> nil) then + begin + // remove references to Current + Current.Right.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Right + else + Current.Parent.Right := Current.Right; + end + else + // fix root + FRoot := Current.Right; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right = nil) then + begin + // remove references to Current + Current.Left.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Left + else + Current.Parent.Right := Current.Left; + end + else + // fix root + FRoot := Current.Left; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right <> nil) then + begin + // find the successor in tree + Successor := Current.Right; + while Successor.Left <> nil do + Successor := Successor.Left; + + if Successor <> Current.Right then + begin + // remove references to successor + Successor.Parent.Left := Successor.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor.Parent; + Successor.Right := Current.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor; + end; + + // insert successor in new position + Successor.Left := Current.Left; + if Current.Left <> nil then + Current.Left.Parent := Successor; + Successor.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Successor + else + Current.Parent.Right := Successor; + end + else + // fix root + FRoot := Successor; + Successor := Current.Parent; + if Successor <> nil then + Successor := FRoot; + end + else + begin + // (Current.Left = nil) and (Current.Right = nil) + Successor := Current.Parent; + if Successor <> nil then + begin + // remove references from parent + if Successor.Left = Current then + Successor.Left := nil + else + Successor.Right := nil; + end + else + FRoot := nil; + end; + Current.Value := 0.0; + Current.Free; + Dec(FSize); + Current := Successor; + until FRemoveSingleElement or (Current = nil); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleBinaryTree.ExtractAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleBinaryTree.First: IJclSingleIterator; +var + Start: TJclSingleBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderSingleBinaryTreeIterator.Create(Self, Start, False, isFirst); + toOrder: + begin + if Start <> nil then + while Start.Left <> nil do + Start := Start.Left; + Result := TJclInOrderSingleBinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + toPostOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Left <> nil then + Start := Start.Left + else + Start := Start.Right; + end; + Result := TJclPostOrderSingleBinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclSingleBinaryTree.GetEnumerator: IJclSingleIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclSingleBinaryTree.GetRoot: IJclSingleTreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderSingleBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toOrder: + Result := TJclInOrderSingleBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TJclPostOrderSingleBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleBinaryTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclSingleBinaryTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclSingleBinaryTree.Last: IJclSingleIterator; +var + Start: TJclSingleBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Right <> nil then + Start := Start.Right + else + Start := Start.Left; + end; + Result := TJclPreOrderSingleBinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toOrder: + begin + if Start <> nil then + while Start.Right <> nil do + Start := Start.Right; + Result := TJclInOrderSingleBinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TJclPostOrderSingleBinaryTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleBinaryTree.Pack; +var + LeafArray: array of TJclSingleBinaryNode; + ANode, BNode: TJclSingleBinaryNode; + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetLength(Leafarray, FSize); + try + // in order enumeration of nodes + ANode := FRoot; + if ANode <> nil then + begin + // find first node + while ANode.Left <> nil do + ANode := ANode.Left; + + Index := 0; + while ANode <> nil do + begin + LeafArray[Index] := ANode; + Inc(Index); + if ANode.Right <> nil then + begin + ANode := ANode.Right; + while (ANode.Left <> nil) do + ANode := ANode.Left; + end + else + begin + BNode := ANode; + ANode := ANode.Parent; + while (ANode <> nil) and (ANode.Right = BNode) do + begin + BNode := ANode; + ANode := ANode.Parent; + end; + end; + end; + + Index := FSize shr 1; + FRoot := LeafArray[Index]; + FRoot.Parent := nil; + if Index > 0 then + FRoot.Left := BuildTree(LeafArray, 0, Index - 1, FRoot, 0) + else + FRoot.Left := nil; + if Index < (FSize - 1) then + FRoot.Right := BuildTree(LeafArray, Index + 1, FSize - 1, FRoot, 1) + else + FRoot.Right := nil; + end; + finally + SetLength(LeafArray, 0); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleBinaryTree.Remove(const AValue: Single): Boolean; +var + Extracted: Single; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeSingle(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleBinaryTree.RemoveAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleBinaryTree.RetainAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleBinaryTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclSingleBinaryTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclSingleBinaryTree.Size: Integer; +begin + Result := FSize; +end; + +function TJclSingleBinaryTree.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclSingleBinaryTree.Create(Compare); + AssignPropertiesTo(Result); +end; + +//=== { TJclSingleBinaryTreeIterator } =========================================================== + +constructor TJclSingleBinaryTreeIterator.Create(const AOwnTree: TJclSingleBinaryTree; ACursor: TJclSingleBinaryNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FStart := AStart; + FOwnTree := AOwnTree; + FEqualityComparer := AOwnTree as IJclSingleEqualityComparer; +end; + +function TJclSingleBinaryTreeIterator.Add(const AValue: Single): Boolean; +begin + Result := FOwnTree.Add(AValue); +end; + +function TJclSingleBinaryTreeIterator.AddChild(const AValue: Single): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclSingleBinaryTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclSingleBinaryTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclSingleBinaryTreeIterator then + begin + ADest := TJclSingleBinaryTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclSingleBinaryTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + Inc(Result); + if FCursor.Right <> nil then + Inc(Result); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleBinaryTreeIterator.DeleteChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclSingleBinaryTreeIterator.DeleteChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclSingleBinaryTreeIterator.Extract; +var + OldCursor: TJclSingleBinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Extract(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleBinaryTreeIterator.ExtractChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclSingleBinaryTreeIterator.ExtractChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclSingleBinaryTreeIterator.GetChild(Index: Integer): Single; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if (FCursor <> nil) and (Index = 0) and (FCursor.Left <> nil) then + FCursor := FCursor.Left + else + if (FCursor <> nil) and (Index = 0) then + FCursor := FCursor.Right + else + if (FCursor <> nil) and (Index = 1) then + FCursor := FCursor.Right + else + FCursor := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleBinaryTreeIterator.GetValue: Single; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := 0.0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleBinaryTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index = 0) then + Result := (FCursor.Left <> nil) or (FCursor.Right <> nil) + else + if (FCursor <> nil) and (Index = 1) then + Result := (FCursor.Left <> nil) and (FCursor.Right <> nil) + else + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleBinaryTreeIterator.HasLeft: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Left <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleBinaryTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleBinaryTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleBinaryTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleBinaryTreeIterator.HasRight: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Right <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleBinaryTreeIterator.IndexOfChild(const AValue: Single): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := -1; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + begin + if FEqualityComparer.ItemsEqual(FCursor.Left.Value, AValue) then + Result := 0 + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, AValue) then + Result := 1; + end + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, AValue) then + Result := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleBinaryTreeIterator.Insert(const AValue: Single): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclSingleBinaryTreeIterator.InsertChild(Index: Integer; const AValue: Single): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclSingleBinaryTreeIterator.IteratorEquals(const AIterator: IJclSingleIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclSingleBinaryTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclSingleBinaryTreeIterator then + begin + ItrObj := TJclSingleBinaryTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +function TJclSingleBinaryTreeIterator.Left: Single; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FCursor <> nil then + FCursor := FCursor.Left; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclSingleBinaryTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclSingleBinaryTreeIterator.Next: Single; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := 0.0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleBinaryTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclSingleBinaryTreeIterator.Parent: Single; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleBinaryTreeIterator.Previous: Single; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := 0.0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleBinaryTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclSingleBinaryTreeIterator.Remove; +var + OldCursor: TJclSingleBinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Remove(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleBinaryTreeIterator.Reset; +var + NewCursor: TJclSingleBinaryNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleBinaryTreeIterator.Right: Single; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FCursor <> nil then + FCursor := FCursor.Right; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleBinaryTreeIterator.SetChild(Index: Integer; const AValue: Single); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclSingleBinaryTreeIterator.SetValue(const AValue: Single); +begin + raise EJclOperationNotSupportedError.Create; +end; + +//=== { TJclPreOrderSingleBinaryTreeIterator } =================================================== + +function TJclPreOrderSingleBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderSingleBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderSingleBinaryTreeIterator.GetNextCursor: TJclSingleBinaryNode; +var + LastRet: TJclSingleBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.Left <> nil then + Result := Result.Left + else + if Result.Right <> nil then + Result := Result.Right + else + begin + Result := Result.Parent; + while (Result <> nil) and ((Result.Right = nil) or (Result.Right = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Right; + end; +end; + +function TJclPreOrderSingleBinaryTreeIterator.GetPreviousCursor: TJclSingleBinaryNode; +var + LastRet: TJclSingleBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Left <> LastRet) and (Result.Left <> nil) then + // come from Right + begin + Result := Result.Left; + while (Result.Left <> nil) or (Result.Right <> nil) do // both childs + begin + if Result.Right <> nil then // right child first + Result := Result.Right + else + Result := Result.Left; + end; + end; +end; + +//=== { TJclInOrderSingleBinaryTreeIterator } ==================================================== + +function TJclInOrderSingleBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclInOrderSingleBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclInOrderSingleBinaryTreeIterator.GetNextCursor: TJclSingleBinaryNode; +var + LastRet: TJclSingleBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + begin + Result := Result.Right; + while (Result.Left <> nil) do + Result := Result.Left; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right = LastRet) do + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +function TJclInOrderSingleBinaryTreeIterator.GetPreviousCursor: TJclSingleBinaryNode; +var + LastRet: TJclSingleBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Left <> nil then + begin + Result := Result.Left; + while Result.Right <> nil do + Result := Result.Right; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right <> LastRet) do // Come from Left + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +//=== { TJclPostOrderSingleBinaryTreeIterator } ================================================== + +function TJclPostOrderSingleBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderSingleBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderSingleBinaryTreeIterator.GetNextCursor: TJclSingleBinaryNode; +var + LastRet: TJclSingleBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Right <> nil) and (Result.Right <> LastRet) then + begin + Result := Result.Right; + while (Result.Left <> nil) or (Result.Right <> nil) do + begin + if Result.Left <> nil then + Result := Result.Left + else + Result := Result.Right; + end; + end; +end; + +function TJclPostOrderSingleBinaryTreeIterator.GetPreviousCursor: TJclSingleBinaryNode; +var + LastRet: TJclSingleBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + Result := Result.Right + else + if Result.Left <> nil then + Result := Result.Left + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and ((Result.Left = nil) or (Result.Left = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Left; + end; +end; + +//=== { TJclDoubleBinaryTree } ================================================= + +constructor TJclDoubleBinaryTree.Create(ACompare: TDoubleCompare); +begin + inherited Create(); + FTraverseOrder := toOrder; + FMaxDepth := 0; + FAutoPackParameter := 2; + SetCompare(ACompare); +end; + +destructor TJclDoubleBinaryTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclDoubleBinaryTree.Add(const AValue: Double): Boolean; +var + NewNode, Current, Save: TJclDoubleBinaryNode; + Comp, Depth: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // Insert into right place + if FAllowDefaultElements or not ItemsEqual(AValue, 0.0) then + begin + Save := nil; + Current := FRoot; + Comp := 1; + Depth := 0; + while Current <> nil do + begin + Inc(Depth); + Save := Current; + Comp := ItemsCompare(AValue, Current.Value); + if Comp < 0 then + Current := Current.Left + else + if Comp > 0 then + Current := Current.Right + else + if CheckDuplicate then + Current := Current.Left // arbitrary decision + else + Break; + end; + if (Comp <> 0) or CheckDuplicate then + begin + NewNode := TJclDoubleBinaryNode.Create; + NewNode.Value := AValue; + NewNode.Parent := Save; + if Save = nil then + FRoot := NewNode + else + if ItemsCompare(NewNode.Value, Save.Value) <= 0 then + Save.Left := NewNode + else + Save.Right := NewNode; + Inc(FSize); + Inc(Depth); + if Depth > FMaxDepth then + FMaxDepth := Depth; + Result := True; + AutoPack; + end + else + Result := False; + end + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleBinaryTree.AddAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleBinaryTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclDoubleBinaryTree; + ACollection: IJclDoubleCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclDoubleBinaryTree then + begin + ADest := TJclDoubleBinaryTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclDoubleCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclDoubleBinaryTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclDoubleBinaryTree then + TJclDoubleBinaryTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclDoubleBinaryTree.AutoPack; +begin + case FAutoPackStrategy of + //apsDisabled: ; + apsAgressive: + if (FMaxDepth > 1) and (((1 shl (FMaxDepth - 1)) - 1) > FSize) then + Pack; + // apsIncremental: ; + apsProportional: + if (FMaxDepth > FAutoPackParameter) and (((1 shl (FMaxDepth - FAutoPackParameter)) - 1) > FSize) then + Pack; + end; +end; + +function TJclDoubleBinaryTree.BuildTree(const LeafArray: array of TJclDoubleBinaryNode; Left, Right: Integer; Parent: TJclDoubleBinaryNode; + Offset: Integer): TJclDoubleBinaryNode; +var + Middle: Integer; +begin + Middle := (Left + Right + Offset) shr 1; + Result := LeafArray[Middle]; + Result.Parent := Parent; + if Middle > Left then + Result.Left := BuildTree(LeafArray, Left, Middle - 1, Result, 0) + else + Result.Left := nil; + if Middle < Right then + Result.Right := BuildTree(LeafArray, Middle + 1, Right, Result, 1) + else + Result.Right := nil; +end; + +procedure TJclDoubleBinaryTree.Clear; +var + Current, Parent: TJclDoubleBinaryNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // postorder + Current := FRoot; + if Current = nil then + Exit; + // find first in post-order + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + // for all items in the tree in post-order + repeat + Parent := Current.Parent; + // remove reference + if Parent <> nil then + begin + if Parent.Left = Current then + Parent.Left := nil + else + if Parent.Right = Current then + Parent.Right := nil; + end; + + // free item + FreeDouble(Current.Value); + Current.Free; + + // find next item + Current := Parent; + if (Current <> nil) and (Current.Right <> nil) then + begin + Current := Current.Right; + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + end; + until Current = nil; + FRoot := nil; + FSize := 0; + FMaxDepth := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleBinaryTree.CloneNode(Node, Parent: TJclDoubleBinaryNode): TJclDoubleBinaryNode; +begin + Result := TJclDoubleBinaryNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + if Node.Left <> nil then + Result.Left := CloneNode(Node.Left, Result); // recursive call + if Node.Right <> nil then + Result.Right := CloneNode(Node.Right, Result); // recursive call +end; + +function TJclDoubleBinaryTree.CollectionEquals(const ACollection: IJclDoubleCollection): Boolean; +var + It, ItSelf: IJclDoubleIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleBinaryTree.Contains(const AValue: Double): Boolean; +var + Comp: Integer; + Current: TJclDoubleBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FRoot; + while Current <> nil do + begin + Comp := ItemsCompare(Current.Value, AValue); + if Comp = 0 then + begin + Result := True; + Break; + end + else + if Comp > 0 then + Current := Current.Left + else + Current := Current.Right; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleBinaryTree.ContainsAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleBinaryTree.Extract(const AValue: Double): Boolean; +var + Current, Successor: TJclDoubleBinaryNode; + Comp: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + // locate AValue in the tree + Current := FRoot; + repeat + while Current <> nil do + begin + Comp := ItemsCompare(AValue, Current.Value); + if Comp = 0 then + Break + else + if Comp < 0 then + Current := Current.Left + else + Current := Current.Right; + end; + if Current = nil then + Break; + Result := True; + // Remove Current from tree + if (Current.Left = nil) and (Current.Right <> nil) then + begin + // remove references to Current + Current.Right.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Right + else + Current.Parent.Right := Current.Right; + end + else + // fix root + FRoot := Current.Right; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right = nil) then + begin + // remove references to Current + Current.Left.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Left + else + Current.Parent.Right := Current.Left; + end + else + // fix root + FRoot := Current.Left; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right <> nil) then + begin + // find the successor in tree + Successor := Current.Right; + while Successor.Left <> nil do + Successor := Successor.Left; + + if Successor <> Current.Right then + begin + // remove references to successor + Successor.Parent.Left := Successor.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor.Parent; + Successor.Right := Current.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor; + end; + + // insert successor in new position + Successor.Left := Current.Left; + if Current.Left <> nil then + Current.Left.Parent := Successor; + Successor.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Successor + else + Current.Parent.Right := Successor; + end + else + // fix root + FRoot := Successor; + Successor := Current.Parent; + if Successor <> nil then + Successor := FRoot; + end + else + begin + // (Current.Left = nil) and (Current.Right = nil) + Successor := Current.Parent; + if Successor <> nil then + begin + // remove references from parent + if Successor.Left = Current then + Successor.Left := nil + else + Successor.Right := nil; + end + else + FRoot := nil; + end; + Current.Value := 0.0; + Current.Free; + Dec(FSize); + Current := Successor; + until FRemoveSingleElement or (Current = nil); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleBinaryTree.ExtractAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleBinaryTree.First: IJclDoubleIterator; +var + Start: TJclDoubleBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderDoubleBinaryTreeIterator.Create(Self, Start, False, isFirst); + toOrder: + begin + if Start <> nil then + while Start.Left <> nil do + Start := Start.Left; + Result := TJclInOrderDoubleBinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + toPostOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Left <> nil then + Start := Start.Left + else + Start := Start.Right; + end; + Result := TJclPostOrderDoubleBinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclDoubleBinaryTree.GetEnumerator: IJclDoubleIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclDoubleBinaryTree.GetRoot: IJclDoubleTreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderDoubleBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toOrder: + Result := TJclInOrderDoubleBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TJclPostOrderDoubleBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleBinaryTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclDoubleBinaryTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclDoubleBinaryTree.Last: IJclDoubleIterator; +var + Start: TJclDoubleBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Right <> nil then + Start := Start.Right + else + Start := Start.Left; + end; + Result := TJclPreOrderDoubleBinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toOrder: + begin + if Start <> nil then + while Start.Right <> nil do + Start := Start.Right; + Result := TJclInOrderDoubleBinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TJclPostOrderDoubleBinaryTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleBinaryTree.Pack; +var + LeafArray: array of TJclDoubleBinaryNode; + ANode, BNode: TJclDoubleBinaryNode; + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetLength(Leafarray, FSize); + try + // in order enumeration of nodes + ANode := FRoot; + if ANode <> nil then + begin + // find first node + while ANode.Left <> nil do + ANode := ANode.Left; + + Index := 0; + while ANode <> nil do + begin + LeafArray[Index] := ANode; + Inc(Index); + if ANode.Right <> nil then + begin + ANode := ANode.Right; + while (ANode.Left <> nil) do + ANode := ANode.Left; + end + else + begin + BNode := ANode; + ANode := ANode.Parent; + while (ANode <> nil) and (ANode.Right = BNode) do + begin + BNode := ANode; + ANode := ANode.Parent; + end; + end; + end; + + Index := FSize shr 1; + FRoot := LeafArray[Index]; + FRoot.Parent := nil; + if Index > 0 then + FRoot.Left := BuildTree(LeafArray, 0, Index - 1, FRoot, 0) + else + FRoot.Left := nil; + if Index < (FSize - 1) then + FRoot.Right := BuildTree(LeafArray, Index + 1, FSize - 1, FRoot, 1) + else + FRoot.Right := nil; + end; + finally + SetLength(LeafArray, 0); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleBinaryTree.Remove(const AValue: Double): Boolean; +var + Extracted: Double; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeDouble(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleBinaryTree.RemoveAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleBinaryTree.RetainAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleBinaryTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclDoubleBinaryTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclDoubleBinaryTree.Size: Integer; +begin + Result := FSize; +end; + +function TJclDoubleBinaryTree.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclDoubleBinaryTree.Create(Compare); + AssignPropertiesTo(Result); +end; + +//=== { TJclDoubleBinaryTreeIterator } =========================================================== + +constructor TJclDoubleBinaryTreeIterator.Create(const AOwnTree: TJclDoubleBinaryTree; ACursor: TJclDoubleBinaryNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FStart := AStart; + FOwnTree := AOwnTree; + FEqualityComparer := AOwnTree as IJclDoubleEqualityComparer; +end; + +function TJclDoubleBinaryTreeIterator.Add(const AValue: Double): Boolean; +begin + Result := FOwnTree.Add(AValue); +end; + +function TJclDoubleBinaryTreeIterator.AddChild(const AValue: Double): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclDoubleBinaryTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclDoubleBinaryTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclDoubleBinaryTreeIterator then + begin + ADest := TJclDoubleBinaryTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclDoubleBinaryTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + Inc(Result); + if FCursor.Right <> nil then + Inc(Result); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleBinaryTreeIterator.DeleteChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclDoubleBinaryTreeIterator.DeleteChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclDoubleBinaryTreeIterator.Extract; +var + OldCursor: TJclDoubleBinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Extract(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleBinaryTreeIterator.ExtractChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclDoubleBinaryTreeIterator.ExtractChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclDoubleBinaryTreeIterator.GetChild(Index: Integer): Double; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if (FCursor <> nil) and (Index = 0) and (FCursor.Left <> nil) then + FCursor := FCursor.Left + else + if (FCursor <> nil) and (Index = 0) then + FCursor := FCursor.Right + else + if (FCursor <> nil) and (Index = 1) then + FCursor := FCursor.Right + else + FCursor := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleBinaryTreeIterator.GetValue: Double; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := 0.0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleBinaryTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index = 0) then + Result := (FCursor.Left <> nil) or (FCursor.Right <> nil) + else + if (FCursor <> nil) and (Index = 1) then + Result := (FCursor.Left <> nil) and (FCursor.Right <> nil) + else + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleBinaryTreeIterator.HasLeft: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Left <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleBinaryTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleBinaryTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleBinaryTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleBinaryTreeIterator.HasRight: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Right <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleBinaryTreeIterator.IndexOfChild(const AValue: Double): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := -1; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + begin + if FEqualityComparer.ItemsEqual(FCursor.Left.Value, AValue) then + Result := 0 + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, AValue) then + Result := 1; + end + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, AValue) then + Result := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleBinaryTreeIterator.Insert(const AValue: Double): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclDoubleBinaryTreeIterator.InsertChild(Index: Integer; const AValue: Double): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclDoubleBinaryTreeIterator.IteratorEquals(const AIterator: IJclDoubleIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclDoubleBinaryTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclDoubleBinaryTreeIterator then + begin + ItrObj := TJclDoubleBinaryTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +function TJclDoubleBinaryTreeIterator.Left: Double; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FCursor <> nil then + FCursor := FCursor.Left; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclDoubleBinaryTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclDoubleBinaryTreeIterator.Next: Double; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := 0.0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleBinaryTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclDoubleBinaryTreeIterator.Parent: Double; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleBinaryTreeIterator.Previous: Double; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := 0.0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleBinaryTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclDoubleBinaryTreeIterator.Remove; +var + OldCursor: TJclDoubleBinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Remove(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleBinaryTreeIterator.Reset; +var + NewCursor: TJclDoubleBinaryNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleBinaryTreeIterator.Right: Double; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FCursor <> nil then + FCursor := FCursor.Right; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleBinaryTreeIterator.SetChild(Index: Integer; const AValue: Double); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclDoubleBinaryTreeIterator.SetValue(const AValue: Double); +begin + raise EJclOperationNotSupportedError.Create; +end; + +//=== { TJclPreOrderDoubleBinaryTreeIterator } =================================================== + +function TJclPreOrderDoubleBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderDoubleBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderDoubleBinaryTreeIterator.GetNextCursor: TJclDoubleBinaryNode; +var + LastRet: TJclDoubleBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.Left <> nil then + Result := Result.Left + else + if Result.Right <> nil then + Result := Result.Right + else + begin + Result := Result.Parent; + while (Result <> nil) and ((Result.Right = nil) or (Result.Right = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Right; + end; +end; + +function TJclPreOrderDoubleBinaryTreeIterator.GetPreviousCursor: TJclDoubleBinaryNode; +var + LastRet: TJclDoubleBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Left <> LastRet) and (Result.Left <> nil) then + // come from Right + begin + Result := Result.Left; + while (Result.Left <> nil) or (Result.Right <> nil) do // both childs + begin + if Result.Right <> nil then // right child first + Result := Result.Right + else + Result := Result.Left; + end; + end; +end; + +//=== { TJclInOrderDoubleBinaryTreeIterator } ==================================================== + +function TJclInOrderDoubleBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclInOrderDoubleBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclInOrderDoubleBinaryTreeIterator.GetNextCursor: TJclDoubleBinaryNode; +var + LastRet: TJclDoubleBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + begin + Result := Result.Right; + while (Result.Left <> nil) do + Result := Result.Left; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right = LastRet) do + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +function TJclInOrderDoubleBinaryTreeIterator.GetPreviousCursor: TJclDoubleBinaryNode; +var + LastRet: TJclDoubleBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Left <> nil then + begin + Result := Result.Left; + while Result.Right <> nil do + Result := Result.Right; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right <> LastRet) do // Come from Left + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +//=== { TJclPostOrderDoubleBinaryTreeIterator } ================================================== + +function TJclPostOrderDoubleBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderDoubleBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderDoubleBinaryTreeIterator.GetNextCursor: TJclDoubleBinaryNode; +var + LastRet: TJclDoubleBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Right <> nil) and (Result.Right <> LastRet) then + begin + Result := Result.Right; + while (Result.Left <> nil) or (Result.Right <> nil) do + begin + if Result.Left <> nil then + Result := Result.Left + else + Result := Result.Right; + end; + end; +end; + +function TJclPostOrderDoubleBinaryTreeIterator.GetPreviousCursor: TJclDoubleBinaryNode; +var + LastRet: TJclDoubleBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + Result := Result.Right + else + if Result.Left <> nil then + Result := Result.Left + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and ((Result.Left = nil) or (Result.Left = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Left; + end; +end; + +//=== { TJclExtendedBinaryTree } ================================================= + +constructor TJclExtendedBinaryTree.Create(ACompare: TExtendedCompare); +begin + inherited Create(); + FTraverseOrder := toOrder; + FMaxDepth := 0; + FAutoPackParameter := 2; + SetCompare(ACompare); +end; + +destructor TJclExtendedBinaryTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclExtendedBinaryTree.Add(const AValue: Extended): Boolean; +var + NewNode, Current, Save: TJclExtendedBinaryNode; + Comp, Depth: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // Insert into right place + if FAllowDefaultElements or not ItemsEqual(AValue, 0.0) then + begin + Save := nil; + Current := FRoot; + Comp := 1; + Depth := 0; + while Current <> nil do + begin + Inc(Depth); + Save := Current; + Comp := ItemsCompare(AValue, Current.Value); + if Comp < 0 then + Current := Current.Left + else + if Comp > 0 then + Current := Current.Right + else + if CheckDuplicate then + Current := Current.Left // arbitrary decision + else + Break; + end; + if (Comp <> 0) or CheckDuplicate then + begin + NewNode := TJclExtendedBinaryNode.Create; + NewNode.Value := AValue; + NewNode.Parent := Save; + if Save = nil then + FRoot := NewNode + else + if ItemsCompare(NewNode.Value, Save.Value) <= 0 then + Save.Left := NewNode + else + Save.Right := NewNode; + Inc(FSize); + Inc(Depth); + if Depth > FMaxDepth then + FMaxDepth := Depth; + Result := True; + AutoPack; + end + else + Result := False; + end + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedBinaryTree.AddAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedBinaryTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclExtendedBinaryTree; + ACollection: IJclExtendedCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclExtendedBinaryTree then + begin + ADest := TJclExtendedBinaryTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclExtendedCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclExtendedBinaryTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclExtendedBinaryTree then + TJclExtendedBinaryTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclExtendedBinaryTree.AutoPack; +begin + case FAutoPackStrategy of + //apsDisabled: ; + apsAgressive: + if (FMaxDepth > 1) and (((1 shl (FMaxDepth - 1)) - 1) > FSize) then + Pack; + // apsIncremental: ; + apsProportional: + if (FMaxDepth > FAutoPackParameter) and (((1 shl (FMaxDepth - FAutoPackParameter)) - 1) > FSize) then + Pack; + end; +end; + +function TJclExtendedBinaryTree.BuildTree(const LeafArray: array of TJclExtendedBinaryNode; Left, Right: Integer; Parent: TJclExtendedBinaryNode; + Offset: Integer): TJclExtendedBinaryNode; +var + Middle: Integer; +begin + Middle := (Left + Right + Offset) shr 1; + Result := LeafArray[Middle]; + Result.Parent := Parent; + if Middle > Left then + Result.Left := BuildTree(LeafArray, Left, Middle - 1, Result, 0) + else + Result.Left := nil; + if Middle < Right then + Result.Right := BuildTree(LeafArray, Middle + 1, Right, Result, 1) + else + Result.Right := nil; +end; + +procedure TJclExtendedBinaryTree.Clear; +var + Current, Parent: TJclExtendedBinaryNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // postorder + Current := FRoot; + if Current = nil then + Exit; + // find first in post-order + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + // for all items in the tree in post-order + repeat + Parent := Current.Parent; + // remove reference + if Parent <> nil then + begin + if Parent.Left = Current then + Parent.Left := nil + else + if Parent.Right = Current then + Parent.Right := nil; + end; + + // free item + FreeExtended(Current.Value); + Current.Free; + + // find next item + Current := Parent; + if (Current <> nil) and (Current.Right <> nil) then + begin + Current := Current.Right; + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + end; + until Current = nil; + FRoot := nil; + FSize := 0; + FMaxDepth := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedBinaryTree.CloneNode(Node, Parent: TJclExtendedBinaryNode): TJclExtendedBinaryNode; +begin + Result := TJclExtendedBinaryNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + if Node.Left <> nil then + Result.Left := CloneNode(Node.Left, Result); // recursive call + if Node.Right <> nil then + Result.Right := CloneNode(Node.Right, Result); // recursive call +end; + +function TJclExtendedBinaryTree.CollectionEquals(const ACollection: IJclExtendedCollection): Boolean; +var + It, ItSelf: IJclExtendedIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedBinaryTree.Contains(const AValue: Extended): Boolean; +var + Comp: Integer; + Current: TJclExtendedBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FRoot; + while Current <> nil do + begin + Comp := ItemsCompare(Current.Value, AValue); + if Comp = 0 then + begin + Result := True; + Break; + end + else + if Comp > 0 then + Current := Current.Left + else + Current := Current.Right; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedBinaryTree.ContainsAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedBinaryTree.Extract(const AValue: Extended): Boolean; +var + Current, Successor: TJclExtendedBinaryNode; + Comp: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + // locate AValue in the tree + Current := FRoot; + repeat + while Current <> nil do + begin + Comp := ItemsCompare(AValue, Current.Value); + if Comp = 0 then + Break + else + if Comp < 0 then + Current := Current.Left + else + Current := Current.Right; + end; + if Current = nil then + Break; + Result := True; + // Remove Current from tree + if (Current.Left = nil) and (Current.Right <> nil) then + begin + // remove references to Current + Current.Right.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Right + else + Current.Parent.Right := Current.Right; + end + else + // fix root + FRoot := Current.Right; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right = nil) then + begin + // remove references to Current + Current.Left.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Left + else + Current.Parent.Right := Current.Left; + end + else + // fix root + FRoot := Current.Left; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right <> nil) then + begin + // find the successor in tree + Successor := Current.Right; + while Successor.Left <> nil do + Successor := Successor.Left; + + if Successor <> Current.Right then + begin + // remove references to successor + Successor.Parent.Left := Successor.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor.Parent; + Successor.Right := Current.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor; + end; + + // insert successor in new position + Successor.Left := Current.Left; + if Current.Left <> nil then + Current.Left.Parent := Successor; + Successor.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Successor + else + Current.Parent.Right := Successor; + end + else + // fix root + FRoot := Successor; + Successor := Current.Parent; + if Successor <> nil then + Successor := FRoot; + end + else + begin + // (Current.Left = nil) and (Current.Right = nil) + Successor := Current.Parent; + if Successor <> nil then + begin + // remove references from parent + if Successor.Left = Current then + Successor.Left := nil + else + Successor.Right := nil; + end + else + FRoot := nil; + end; + Current.Value := 0.0; + Current.Free; + Dec(FSize); + Current := Successor; + until FRemoveSingleElement or (Current = nil); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedBinaryTree.ExtractAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedBinaryTree.First: IJclExtendedIterator; +var + Start: TJclExtendedBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderExtendedBinaryTreeIterator.Create(Self, Start, False, isFirst); + toOrder: + begin + if Start <> nil then + while Start.Left <> nil do + Start := Start.Left; + Result := TJclInOrderExtendedBinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + toPostOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Left <> nil then + Start := Start.Left + else + Start := Start.Right; + end; + Result := TJclPostOrderExtendedBinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclExtendedBinaryTree.GetEnumerator: IJclExtendedIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclExtendedBinaryTree.GetRoot: IJclExtendedTreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderExtendedBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toOrder: + Result := TJclInOrderExtendedBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TJclPostOrderExtendedBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedBinaryTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclExtendedBinaryTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclExtendedBinaryTree.Last: IJclExtendedIterator; +var + Start: TJclExtendedBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Right <> nil then + Start := Start.Right + else + Start := Start.Left; + end; + Result := TJclPreOrderExtendedBinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toOrder: + begin + if Start <> nil then + while Start.Right <> nil do + Start := Start.Right; + Result := TJclInOrderExtendedBinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TJclPostOrderExtendedBinaryTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedBinaryTree.Pack; +var + LeafArray: array of TJclExtendedBinaryNode; + ANode, BNode: TJclExtendedBinaryNode; + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetLength(Leafarray, FSize); + try + // in order enumeration of nodes + ANode := FRoot; + if ANode <> nil then + begin + // find first node + while ANode.Left <> nil do + ANode := ANode.Left; + + Index := 0; + while ANode <> nil do + begin + LeafArray[Index] := ANode; + Inc(Index); + if ANode.Right <> nil then + begin + ANode := ANode.Right; + while (ANode.Left <> nil) do + ANode := ANode.Left; + end + else + begin + BNode := ANode; + ANode := ANode.Parent; + while (ANode <> nil) and (ANode.Right = BNode) do + begin + BNode := ANode; + ANode := ANode.Parent; + end; + end; + end; + + Index := FSize shr 1; + FRoot := LeafArray[Index]; + FRoot.Parent := nil; + if Index > 0 then + FRoot.Left := BuildTree(LeafArray, 0, Index - 1, FRoot, 0) + else + FRoot.Left := nil; + if Index < (FSize - 1) then + FRoot.Right := BuildTree(LeafArray, Index + 1, FSize - 1, FRoot, 1) + else + FRoot.Right := nil; + end; + finally + SetLength(LeafArray, 0); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedBinaryTree.Remove(const AValue: Extended): Boolean; +var + Extracted: Extended; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeExtended(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedBinaryTree.RemoveAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedBinaryTree.RetainAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedBinaryTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclExtendedBinaryTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclExtendedBinaryTree.Size: Integer; +begin + Result := FSize; +end; + +function TJclExtendedBinaryTree.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclExtendedBinaryTree.Create(Compare); + AssignPropertiesTo(Result); +end; + +//=== { TJclExtendedBinaryTreeIterator } =========================================================== + +constructor TJclExtendedBinaryTreeIterator.Create(const AOwnTree: TJclExtendedBinaryTree; ACursor: TJclExtendedBinaryNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FStart := AStart; + FOwnTree := AOwnTree; + FEqualityComparer := AOwnTree as IJclExtendedEqualityComparer; +end; + +function TJclExtendedBinaryTreeIterator.Add(const AValue: Extended): Boolean; +begin + Result := FOwnTree.Add(AValue); +end; + +function TJclExtendedBinaryTreeIterator.AddChild(const AValue: Extended): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclExtendedBinaryTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclExtendedBinaryTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclExtendedBinaryTreeIterator then + begin + ADest := TJclExtendedBinaryTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclExtendedBinaryTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + Inc(Result); + if FCursor.Right <> nil then + Inc(Result); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedBinaryTreeIterator.DeleteChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclExtendedBinaryTreeIterator.DeleteChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclExtendedBinaryTreeIterator.Extract; +var + OldCursor: TJclExtendedBinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Extract(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedBinaryTreeIterator.ExtractChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclExtendedBinaryTreeIterator.ExtractChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclExtendedBinaryTreeIterator.GetChild(Index: Integer): Extended; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if (FCursor <> nil) and (Index = 0) and (FCursor.Left <> nil) then + FCursor := FCursor.Left + else + if (FCursor <> nil) and (Index = 0) then + FCursor := FCursor.Right + else + if (FCursor <> nil) and (Index = 1) then + FCursor := FCursor.Right + else + FCursor := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedBinaryTreeIterator.GetValue: Extended; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := 0.0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedBinaryTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index = 0) then + Result := (FCursor.Left <> nil) or (FCursor.Right <> nil) + else + if (FCursor <> nil) and (Index = 1) then + Result := (FCursor.Left <> nil) and (FCursor.Right <> nil) + else + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedBinaryTreeIterator.HasLeft: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Left <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedBinaryTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedBinaryTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedBinaryTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedBinaryTreeIterator.HasRight: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Right <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedBinaryTreeIterator.IndexOfChild(const AValue: Extended): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := -1; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + begin + if FEqualityComparer.ItemsEqual(FCursor.Left.Value, AValue) then + Result := 0 + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, AValue) then + Result := 1; + end + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, AValue) then + Result := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedBinaryTreeIterator.Insert(const AValue: Extended): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclExtendedBinaryTreeIterator.InsertChild(Index: Integer; const AValue: Extended): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclExtendedBinaryTreeIterator.IteratorEquals(const AIterator: IJclExtendedIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclExtendedBinaryTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclExtendedBinaryTreeIterator then + begin + ItrObj := TJclExtendedBinaryTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +function TJclExtendedBinaryTreeIterator.Left: Extended; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FCursor <> nil then + FCursor := FCursor.Left; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclExtendedBinaryTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclExtendedBinaryTreeIterator.Next: Extended; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := 0.0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedBinaryTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclExtendedBinaryTreeIterator.Parent: Extended; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedBinaryTreeIterator.Previous: Extended; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := 0.0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedBinaryTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclExtendedBinaryTreeIterator.Remove; +var + OldCursor: TJclExtendedBinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Remove(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedBinaryTreeIterator.Reset; +var + NewCursor: TJclExtendedBinaryNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedBinaryTreeIterator.Right: Extended; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FCursor <> nil then + FCursor := FCursor.Right; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedBinaryTreeIterator.SetChild(Index: Integer; const AValue: Extended); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclExtendedBinaryTreeIterator.SetValue(const AValue: Extended); +begin + raise EJclOperationNotSupportedError.Create; +end; + +//=== { TJclPreOrderExtendedBinaryTreeIterator } =================================================== + +function TJclPreOrderExtendedBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderExtendedBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderExtendedBinaryTreeIterator.GetNextCursor: TJclExtendedBinaryNode; +var + LastRet: TJclExtendedBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.Left <> nil then + Result := Result.Left + else + if Result.Right <> nil then + Result := Result.Right + else + begin + Result := Result.Parent; + while (Result <> nil) and ((Result.Right = nil) or (Result.Right = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Right; + end; +end; + +function TJclPreOrderExtendedBinaryTreeIterator.GetPreviousCursor: TJclExtendedBinaryNode; +var + LastRet: TJclExtendedBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Left <> LastRet) and (Result.Left <> nil) then + // come from Right + begin + Result := Result.Left; + while (Result.Left <> nil) or (Result.Right <> nil) do // both childs + begin + if Result.Right <> nil then // right child first + Result := Result.Right + else + Result := Result.Left; + end; + end; +end; + +//=== { TJclInOrderExtendedBinaryTreeIterator } ==================================================== + +function TJclInOrderExtendedBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclInOrderExtendedBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclInOrderExtendedBinaryTreeIterator.GetNextCursor: TJclExtendedBinaryNode; +var + LastRet: TJclExtendedBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + begin + Result := Result.Right; + while (Result.Left <> nil) do + Result := Result.Left; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right = LastRet) do + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +function TJclInOrderExtendedBinaryTreeIterator.GetPreviousCursor: TJclExtendedBinaryNode; +var + LastRet: TJclExtendedBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Left <> nil then + begin + Result := Result.Left; + while Result.Right <> nil do + Result := Result.Right; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right <> LastRet) do // Come from Left + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +//=== { TJclPostOrderExtendedBinaryTreeIterator } ================================================== + +function TJclPostOrderExtendedBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderExtendedBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderExtendedBinaryTreeIterator.GetNextCursor: TJclExtendedBinaryNode; +var + LastRet: TJclExtendedBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Right <> nil) and (Result.Right <> LastRet) then + begin + Result := Result.Right; + while (Result.Left <> nil) or (Result.Right <> nil) do + begin + if Result.Left <> nil then + Result := Result.Left + else + Result := Result.Right; + end; + end; +end; + +function TJclPostOrderExtendedBinaryTreeIterator.GetPreviousCursor: TJclExtendedBinaryNode; +var + LastRet: TJclExtendedBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + Result := Result.Right + else + if Result.Left <> nil then + Result := Result.Left + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and ((Result.Left = nil) or (Result.Left = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Left; + end; +end; + +//=== { TJclIntegerBinaryTree } ================================================= + +constructor TJclIntegerBinaryTree.Create(ACompare: TIntegerCompare); +begin + inherited Create(); + FTraverseOrder := toOrder; + FMaxDepth := 0; + FAutoPackParameter := 2; + SetCompare(ACompare); +end; + +destructor TJclIntegerBinaryTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclIntegerBinaryTree.Add(AValue: Integer): Boolean; +var + NewNode, Current, Save: TJclIntegerBinaryNode; + Comp, Depth: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // Insert into right place + if FAllowDefaultElements or not ItemsEqual(AValue, 0) then + begin + Save := nil; + Current := FRoot; + Comp := 1; + Depth := 0; + while Current <> nil do + begin + Inc(Depth); + Save := Current; + Comp := ItemsCompare(AValue, Current.Value); + if Comp < 0 then + Current := Current.Left + else + if Comp > 0 then + Current := Current.Right + else + if CheckDuplicate then + Current := Current.Left // arbitrary decision + else + Break; + end; + if (Comp <> 0) or CheckDuplicate then + begin + NewNode := TJclIntegerBinaryNode.Create; + NewNode.Value := AValue; + NewNode.Parent := Save; + if Save = nil then + FRoot := NewNode + else + if ItemsCompare(NewNode.Value, Save.Value) <= 0 then + Save.Left := NewNode + else + Save.Right := NewNode; + Inc(FSize); + Inc(Depth); + if Depth > FMaxDepth then + FMaxDepth := Depth; + Result := True; + AutoPack; + end + else + Result := False; + end + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerBinaryTree.AddAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerBinaryTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclIntegerBinaryTree; + ACollection: IJclIntegerCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntegerBinaryTree then + begin + ADest := TJclIntegerBinaryTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclIntegerCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclIntegerBinaryTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclIntegerBinaryTree then + TJclIntegerBinaryTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclIntegerBinaryTree.AutoPack; +begin + case FAutoPackStrategy of + //apsDisabled: ; + apsAgressive: + if (FMaxDepth > 1) and (((1 shl (FMaxDepth - 1)) - 1) > FSize) then + Pack; + // apsIncremental: ; + apsProportional: + if (FMaxDepth > FAutoPackParameter) and (((1 shl (FMaxDepth - FAutoPackParameter)) - 1) > FSize) then + Pack; + end; +end; + +function TJclIntegerBinaryTree.BuildTree(const LeafArray: array of TJclIntegerBinaryNode; Left, Right: Integer; Parent: TJclIntegerBinaryNode; + Offset: Integer): TJclIntegerBinaryNode; +var + Middle: Integer; +begin + Middle := (Left + Right + Offset) shr 1; + Result := LeafArray[Middle]; + Result.Parent := Parent; + if Middle > Left then + Result.Left := BuildTree(LeafArray, Left, Middle - 1, Result, 0) + else + Result.Left := nil; + if Middle < Right then + Result.Right := BuildTree(LeafArray, Middle + 1, Right, Result, 1) + else + Result.Right := nil; +end; + +procedure TJclIntegerBinaryTree.Clear; +var + Current, Parent: TJclIntegerBinaryNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // postorder + Current := FRoot; + if Current = nil then + Exit; + // find first in post-order + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + // for all items in the tree in post-order + repeat + Parent := Current.Parent; + // remove reference + if Parent <> nil then + begin + if Parent.Left = Current then + Parent.Left := nil + else + if Parent.Right = Current then + Parent.Right := nil; + end; + + // free item + FreeInteger(Current.Value); + Current.Free; + + // find next item + Current := Parent; + if (Current <> nil) and (Current.Right <> nil) then + begin + Current := Current.Right; + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + end; + until Current = nil; + FRoot := nil; + FSize := 0; + FMaxDepth := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerBinaryTree.CloneNode(Node, Parent: TJclIntegerBinaryNode): TJclIntegerBinaryNode; +begin + Result := TJclIntegerBinaryNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + if Node.Left <> nil then + Result.Left := CloneNode(Node.Left, Result); // recursive call + if Node.Right <> nil then + Result.Right := CloneNode(Node.Right, Result); // recursive call +end; + +function TJclIntegerBinaryTree.CollectionEquals(const ACollection: IJclIntegerCollection): Boolean; +var + It, ItSelf: IJclIntegerIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerBinaryTree.Contains(AValue: Integer): Boolean; +var + Comp: Integer; + Current: TJclIntegerBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FRoot; + while Current <> nil do + begin + Comp := ItemsCompare(Current.Value, AValue); + if Comp = 0 then + begin + Result := True; + Break; + end + else + if Comp > 0 then + Current := Current.Left + else + Current := Current.Right; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerBinaryTree.ContainsAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerBinaryTree.Extract(AValue: Integer): Boolean; +var + Current, Successor: TJclIntegerBinaryNode; + Comp: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + // locate AValue in the tree + Current := FRoot; + repeat + while Current <> nil do + begin + Comp := ItemsCompare(AValue, Current.Value); + if Comp = 0 then + Break + else + if Comp < 0 then + Current := Current.Left + else + Current := Current.Right; + end; + if Current = nil then + Break; + Result := True; + // Remove Current from tree + if (Current.Left = nil) and (Current.Right <> nil) then + begin + // remove references to Current + Current.Right.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Right + else + Current.Parent.Right := Current.Right; + end + else + // fix root + FRoot := Current.Right; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right = nil) then + begin + // remove references to Current + Current.Left.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Left + else + Current.Parent.Right := Current.Left; + end + else + // fix root + FRoot := Current.Left; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right <> nil) then + begin + // find the successor in tree + Successor := Current.Right; + while Successor.Left <> nil do + Successor := Successor.Left; + + if Successor <> Current.Right then + begin + // remove references to successor + Successor.Parent.Left := Successor.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor.Parent; + Successor.Right := Current.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor; + end; + + // insert successor in new position + Successor.Left := Current.Left; + if Current.Left <> nil then + Current.Left.Parent := Successor; + Successor.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Successor + else + Current.Parent.Right := Successor; + end + else + // fix root + FRoot := Successor; + Successor := Current.Parent; + if Successor <> nil then + Successor := FRoot; + end + else + begin + // (Current.Left = nil) and (Current.Right = nil) + Successor := Current.Parent; + if Successor <> nil then + begin + // remove references from parent + if Successor.Left = Current then + Successor.Left := nil + else + Successor.Right := nil; + end + else + FRoot := nil; + end; + Current.Value := 0; + Current.Free; + Dec(FSize); + Current := Successor; + until FRemoveSingleElement or (Current = nil); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerBinaryTree.ExtractAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerBinaryTree.First: IJclIntegerIterator; +var + Start: TJclIntegerBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderIntegerBinaryTreeIterator.Create(Self, Start, False, isFirst); + toOrder: + begin + if Start <> nil then + while Start.Left <> nil do + Start := Start.Left; + Result := TJclInOrderIntegerBinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + toPostOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Left <> nil then + Start := Start.Left + else + Start := Start.Right; + end; + Result := TJclPostOrderIntegerBinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclIntegerBinaryTree.GetEnumerator: IJclIntegerIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclIntegerBinaryTree.GetRoot: IJclIntegerTreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderIntegerBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toOrder: + Result := TJclInOrderIntegerBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TJclPostOrderIntegerBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerBinaryTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclIntegerBinaryTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntegerBinaryTree.Last: IJclIntegerIterator; +var + Start: TJclIntegerBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Right <> nil then + Start := Start.Right + else + Start := Start.Left; + end; + Result := TJclPreOrderIntegerBinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toOrder: + begin + if Start <> nil then + while Start.Right <> nil do + Start := Start.Right; + Result := TJclInOrderIntegerBinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TJclPostOrderIntegerBinaryTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerBinaryTree.Pack; +var + LeafArray: array of TJclIntegerBinaryNode; + ANode, BNode: TJclIntegerBinaryNode; + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetLength(Leafarray, FSize); + try + // in order enumeration of nodes + ANode := FRoot; + if ANode <> nil then + begin + // find first node + while ANode.Left <> nil do + ANode := ANode.Left; + + Index := 0; + while ANode <> nil do + begin + LeafArray[Index] := ANode; + Inc(Index); + if ANode.Right <> nil then + begin + ANode := ANode.Right; + while (ANode.Left <> nil) do + ANode := ANode.Left; + end + else + begin + BNode := ANode; + ANode := ANode.Parent; + while (ANode <> nil) and (ANode.Right = BNode) do + begin + BNode := ANode; + ANode := ANode.Parent; + end; + end; + end; + + Index := FSize shr 1; + FRoot := LeafArray[Index]; + FRoot.Parent := nil; + if Index > 0 then + FRoot.Left := BuildTree(LeafArray, 0, Index - 1, FRoot, 0) + else + FRoot.Left := nil; + if Index < (FSize - 1) then + FRoot.Right := BuildTree(LeafArray, Index + 1, FSize - 1, FRoot, 1) + else + FRoot.Right := nil; + end; + finally + SetLength(LeafArray, 0); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerBinaryTree.Remove(AValue: Integer): Boolean; +var + Extracted: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeInteger(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerBinaryTree.RemoveAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerBinaryTree.RetainAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerBinaryTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclIntegerBinaryTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclIntegerBinaryTree.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntegerBinaryTree.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntegerBinaryTree.Create(Compare); + AssignPropertiesTo(Result); +end; + +//=== { TJclIntegerBinaryTreeIterator } =========================================================== + +constructor TJclIntegerBinaryTreeIterator.Create(const AOwnTree: TJclIntegerBinaryTree; ACursor: TJclIntegerBinaryNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FStart := AStart; + FOwnTree := AOwnTree; + FEqualityComparer := AOwnTree as IJclIntegerEqualityComparer; +end; + +function TJclIntegerBinaryTreeIterator.Add(AValue: Integer): Boolean; +begin + Result := FOwnTree.Add(AValue); +end; + +function TJclIntegerBinaryTreeIterator.AddChild(AValue: Integer): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclIntegerBinaryTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclIntegerBinaryTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclIntegerBinaryTreeIterator then + begin + ADest := TJclIntegerBinaryTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclIntegerBinaryTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + Inc(Result); + if FCursor.Right <> nil then + Inc(Result); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerBinaryTreeIterator.DeleteChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclIntegerBinaryTreeIterator.DeleteChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclIntegerBinaryTreeIterator.Extract; +var + OldCursor: TJclIntegerBinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Extract(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerBinaryTreeIterator.ExtractChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclIntegerBinaryTreeIterator.ExtractChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclIntegerBinaryTreeIterator.GetChild(Index: Integer): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if (FCursor <> nil) and (Index = 0) and (FCursor.Left <> nil) then + FCursor := FCursor.Left + else + if (FCursor <> nil) and (Index = 0) then + FCursor := FCursor.Right + else + if (FCursor <> nil) and (Index = 1) then + FCursor := FCursor.Right + else + FCursor := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerBinaryTreeIterator.GetValue: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := 0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerBinaryTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index = 0) then + Result := (FCursor.Left <> nil) or (FCursor.Right <> nil) + else + if (FCursor <> nil) and (Index = 1) then + Result := (FCursor.Left <> nil) and (FCursor.Right <> nil) + else + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerBinaryTreeIterator.HasLeft: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Left <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerBinaryTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerBinaryTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerBinaryTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerBinaryTreeIterator.HasRight: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Right <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerBinaryTreeIterator.IndexOfChild(AValue: Integer): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := -1; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + begin + if FEqualityComparer.ItemsEqual(FCursor.Left.Value, AValue) then + Result := 0 + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, AValue) then + Result := 1; + end + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, AValue) then + Result := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerBinaryTreeIterator.Insert(AValue: Integer): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclIntegerBinaryTreeIterator.InsertChild(Index: Integer; AValue: Integer): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclIntegerBinaryTreeIterator.IteratorEquals(const AIterator: IJclIntegerIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclIntegerBinaryTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclIntegerBinaryTreeIterator then + begin + ItrObj := TJclIntegerBinaryTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +function TJclIntegerBinaryTreeIterator.Left: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + FCursor := FCursor.Left; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclIntegerBinaryTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclIntegerBinaryTreeIterator.Next: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := 0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerBinaryTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclIntegerBinaryTreeIterator.Parent: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerBinaryTreeIterator.Previous: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := 0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerBinaryTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclIntegerBinaryTreeIterator.Remove; +var + OldCursor: TJclIntegerBinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Remove(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerBinaryTreeIterator.Reset; +var + NewCursor: TJclIntegerBinaryNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerBinaryTreeIterator.Right: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + FCursor := FCursor.Right; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerBinaryTreeIterator.SetChild(Index: Integer; AValue: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclIntegerBinaryTreeIterator.SetValue(AValue: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +//=== { TJclPreOrderIntegerBinaryTreeIterator } =================================================== + +function TJclPreOrderIntegerBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderIntegerBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderIntegerBinaryTreeIterator.GetNextCursor: TJclIntegerBinaryNode; +var + LastRet: TJclIntegerBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.Left <> nil then + Result := Result.Left + else + if Result.Right <> nil then + Result := Result.Right + else + begin + Result := Result.Parent; + while (Result <> nil) and ((Result.Right = nil) or (Result.Right = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Right; + end; +end; + +function TJclPreOrderIntegerBinaryTreeIterator.GetPreviousCursor: TJclIntegerBinaryNode; +var + LastRet: TJclIntegerBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Left <> LastRet) and (Result.Left <> nil) then + // come from Right + begin + Result := Result.Left; + while (Result.Left <> nil) or (Result.Right <> nil) do // both childs + begin + if Result.Right <> nil then // right child first + Result := Result.Right + else + Result := Result.Left; + end; + end; +end; + +//=== { TJclInOrderIntegerBinaryTreeIterator } ==================================================== + +function TJclInOrderIntegerBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclInOrderIntegerBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclInOrderIntegerBinaryTreeIterator.GetNextCursor: TJclIntegerBinaryNode; +var + LastRet: TJclIntegerBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + begin + Result := Result.Right; + while (Result.Left <> nil) do + Result := Result.Left; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right = LastRet) do + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +function TJclInOrderIntegerBinaryTreeIterator.GetPreviousCursor: TJclIntegerBinaryNode; +var + LastRet: TJclIntegerBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Left <> nil then + begin + Result := Result.Left; + while Result.Right <> nil do + Result := Result.Right; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right <> LastRet) do // Come from Left + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +//=== { TJclPostOrderIntegerBinaryTreeIterator } ================================================== + +function TJclPostOrderIntegerBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderIntegerBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderIntegerBinaryTreeIterator.GetNextCursor: TJclIntegerBinaryNode; +var + LastRet: TJclIntegerBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Right <> nil) and (Result.Right <> LastRet) then + begin + Result := Result.Right; + while (Result.Left <> nil) or (Result.Right <> nil) do + begin + if Result.Left <> nil then + Result := Result.Left + else + Result := Result.Right; + end; + end; +end; + +function TJclPostOrderIntegerBinaryTreeIterator.GetPreviousCursor: TJclIntegerBinaryNode; +var + LastRet: TJclIntegerBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + Result := Result.Right + else + if Result.Left <> nil then + Result := Result.Left + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and ((Result.Left = nil) or (Result.Left = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Left; + end; +end; + +//=== { TJclCardinalBinaryTree } ================================================= + +constructor TJclCardinalBinaryTree.Create(ACompare: TCardinalCompare); +begin + inherited Create(); + FTraverseOrder := toOrder; + FMaxDepth := 0; + FAutoPackParameter := 2; + SetCompare(ACompare); +end; + +destructor TJclCardinalBinaryTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclCardinalBinaryTree.Add(AValue: Cardinal): Boolean; +var + NewNode, Current, Save: TJclCardinalBinaryNode; + Comp, Depth: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // Insert into right place + if FAllowDefaultElements or not ItemsEqual(AValue, 0) then + begin + Save := nil; + Current := FRoot; + Comp := 1; + Depth := 0; + while Current <> nil do + begin + Inc(Depth); + Save := Current; + Comp := ItemsCompare(AValue, Current.Value); + if Comp < 0 then + Current := Current.Left + else + if Comp > 0 then + Current := Current.Right + else + if CheckDuplicate then + Current := Current.Left // arbitrary decision + else + Break; + end; + if (Comp <> 0) or CheckDuplicate then + begin + NewNode := TJclCardinalBinaryNode.Create; + NewNode.Value := AValue; + NewNode.Parent := Save; + if Save = nil then + FRoot := NewNode + else + if ItemsCompare(NewNode.Value, Save.Value) <= 0 then + Save.Left := NewNode + else + Save.Right := NewNode; + Inc(FSize); + Inc(Depth); + if Depth > FMaxDepth then + FMaxDepth := Depth; + Result := True; + AutoPack; + end + else + Result := False; + end + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalBinaryTree.AddAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalBinaryTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclCardinalBinaryTree; + ACollection: IJclCardinalCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclCardinalBinaryTree then + begin + ADest := TJclCardinalBinaryTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclCardinalCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclCardinalBinaryTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclCardinalBinaryTree then + TJclCardinalBinaryTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclCardinalBinaryTree.AutoPack; +begin + case FAutoPackStrategy of + //apsDisabled: ; + apsAgressive: + if (FMaxDepth > 1) and (((1 shl (FMaxDepth - 1)) - 1) > FSize) then + Pack; + // apsIncremental: ; + apsProportional: + if (FMaxDepth > FAutoPackParameter) and (((1 shl (FMaxDepth - FAutoPackParameter)) - 1) > FSize) then + Pack; + end; +end; + +function TJclCardinalBinaryTree.BuildTree(const LeafArray: array of TJclCardinalBinaryNode; Left, Right: Integer; Parent: TJclCardinalBinaryNode; + Offset: Integer): TJclCardinalBinaryNode; +var + Middle: Integer; +begin + Middle := (Left + Right + Offset) shr 1; + Result := LeafArray[Middle]; + Result.Parent := Parent; + if Middle > Left then + Result.Left := BuildTree(LeafArray, Left, Middle - 1, Result, 0) + else + Result.Left := nil; + if Middle < Right then + Result.Right := BuildTree(LeafArray, Middle + 1, Right, Result, 1) + else + Result.Right := nil; +end; + +procedure TJclCardinalBinaryTree.Clear; +var + Current, Parent: TJclCardinalBinaryNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // postorder + Current := FRoot; + if Current = nil then + Exit; + // find first in post-order + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + // for all items in the tree in post-order + repeat + Parent := Current.Parent; + // remove reference + if Parent <> nil then + begin + if Parent.Left = Current then + Parent.Left := nil + else + if Parent.Right = Current then + Parent.Right := nil; + end; + + // free item + FreeCardinal(Current.Value); + Current.Free; + + // find next item + Current := Parent; + if (Current <> nil) and (Current.Right <> nil) then + begin + Current := Current.Right; + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + end; + until Current = nil; + FRoot := nil; + FSize := 0; + FMaxDepth := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalBinaryTree.CloneNode(Node, Parent: TJclCardinalBinaryNode): TJclCardinalBinaryNode; +begin + Result := TJclCardinalBinaryNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + if Node.Left <> nil then + Result.Left := CloneNode(Node.Left, Result); // recursive call + if Node.Right <> nil then + Result.Right := CloneNode(Node.Right, Result); // recursive call +end; + +function TJclCardinalBinaryTree.CollectionEquals(const ACollection: IJclCardinalCollection): Boolean; +var + It, ItSelf: IJclCardinalIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalBinaryTree.Contains(AValue: Cardinal): Boolean; +var + Comp: Integer; + Current: TJclCardinalBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FRoot; + while Current <> nil do + begin + Comp := ItemsCompare(Current.Value, AValue); + if Comp = 0 then + begin + Result := True; + Break; + end + else + if Comp > 0 then + Current := Current.Left + else + Current := Current.Right; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalBinaryTree.ContainsAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalBinaryTree.Extract(AValue: Cardinal): Boolean; +var + Current, Successor: TJclCardinalBinaryNode; + Comp: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + // locate AValue in the tree + Current := FRoot; + repeat + while Current <> nil do + begin + Comp := ItemsCompare(AValue, Current.Value); + if Comp = 0 then + Break + else + if Comp < 0 then + Current := Current.Left + else + Current := Current.Right; + end; + if Current = nil then + Break; + Result := True; + // Remove Current from tree + if (Current.Left = nil) and (Current.Right <> nil) then + begin + // remove references to Current + Current.Right.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Right + else + Current.Parent.Right := Current.Right; + end + else + // fix root + FRoot := Current.Right; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right = nil) then + begin + // remove references to Current + Current.Left.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Left + else + Current.Parent.Right := Current.Left; + end + else + // fix root + FRoot := Current.Left; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right <> nil) then + begin + // find the successor in tree + Successor := Current.Right; + while Successor.Left <> nil do + Successor := Successor.Left; + + if Successor <> Current.Right then + begin + // remove references to successor + Successor.Parent.Left := Successor.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor.Parent; + Successor.Right := Current.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor; + end; + + // insert successor in new position + Successor.Left := Current.Left; + if Current.Left <> nil then + Current.Left.Parent := Successor; + Successor.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Successor + else + Current.Parent.Right := Successor; + end + else + // fix root + FRoot := Successor; + Successor := Current.Parent; + if Successor <> nil then + Successor := FRoot; + end + else + begin + // (Current.Left = nil) and (Current.Right = nil) + Successor := Current.Parent; + if Successor <> nil then + begin + // remove references from parent + if Successor.Left = Current then + Successor.Left := nil + else + Successor.Right := nil; + end + else + FRoot := nil; + end; + Current.Value := 0; + Current.Free; + Dec(FSize); + Current := Successor; + until FRemoveSingleElement or (Current = nil); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalBinaryTree.ExtractAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalBinaryTree.First: IJclCardinalIterator; +var + Start: TJclCardinalBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderCardinalBinaryTreeIterator.Create(Self, Start, False, isFirst); + toOrder: + begin + if Start <> nil then + while Start.Left <> nil do + Start := Start.Left; + Result := TJclInOrderCardinalBinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + toPostOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Left <> nil then + Start := Start.Left + else + Start := Start.Right; + end; + Result := TJclPostOrderCardinalBinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclCardinalBinaryTree.GetEnumerator: IJclCardinalIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclCardinalBinaryTree.GetRoot: IJclCardinalTreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderCardinalBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toOrder: + Result := TJclInOrderCardinalBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TJclPostOrderCardinalBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalBinaryTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclCardinalBinaryTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclCardinalBinaryTree.Last: IJclCardinalIterator; +var + Start: TJclCardinalBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Right <> nil then + Start := Start.Right + else + Start := Start.Left; + end; + Result := TJclPreOrderCardinalBinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toOrder: + begin + if Start <> nil then + while Start.Right <> nil do + Start := Start.Right; + Result := TJclInOrderCardinalBinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TJclPostOrderCardinalBinaryTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalBinaryTree.Pack; +var + LeafArray: array of TJclCardinalBinaryNode; + ANode, BNode: TJclCardinalBinaryNode; + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetLength(Leafarray, FSize); + try + // in order enumeration of nodes + ANode := FRoot; + if ANode <> nil then + begin + // find first node + while ANode.Left <> nil do + ANode := ANode.Left; + + Index := 0; + while ANode <> nil do + begin + LeafArray[Index] := ANode; + Inc(Index); + if ANode.Right <> nil then + begin + ANode := ANode.Right; + while (ANode.Left <> nil) do + ANode := ANode.Left; + end + else + begin + BNode := ANode; + ANode := ANode.Parent; + while (ANode <> nil) and (ANode.Right = BNode) do + begin + BNode := ANode; + ANode := ANode.Parent; + end; + end; + end; + + Index := FSize shr 1; + FRoot := LeafArray[Index]; + FRoot.Parent := nil; + if Index > 0 then + FRoot.Left := BuildTree(LeafArray, 0, Index - 1, FRoot, 0) + else + FRoot.Left := nil; + if Index < (FSize - 1) then + FRoot.Right := BuildTree(LeafArray, Index + 1, FSize - 1, FRoot, 1) + else + FRoot.Right := nil; + end; + finally + SetLength(LeafArray, 0); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalBinaryTree.Remove(AValue: Cardinal): Boolean; +var + Extracted: Cardinal; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeCardinal(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalBinaryTree.RemoveAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalBinaryTree.RetainAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalBinaryTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclCardinalBinaryTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclCardinalBinaryTree.Size: Integer; +begin + Result := FSize; +end; + +function TJclCardinalBinaryTree.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclCardinalBinaryTree.Create(Compare); + AssignPropertiesTo(Result); +end; + +//=== { TJclCardinalBinaryTreeIterator } =========================================================== + +constructor TJclCardinalBinaryTreeIterator.Create(const AOwnTree: TJclCardinalBinaryTree; ACursor: TJclCardinalBinaryNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FStart := AStart; + FOwnTree := AOwnTree; + FEqualityComparer := AOwnTree as IJclCardinalEqualityComparer; +end; + +function TJclCardinalBinaryTreeIterator.Add(AValue: Cardinal): Boolean; +begin + Result := FOwnTree.Add(AValue); +end; + +function TJclCardinalBinaryTreeIterator.AddChild(AValue: Cardinal): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclCardinalBinaryTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclCardinalBinaryTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclCardinalBinaryTreeIterator then + begin + ADest := TJclCardinalBinaryTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclCardinalBinaryTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + Inc(Result); + if FCursor.Right <> nil then + Inc(Result); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalBinaryTreeIterator.DeleteChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclCardinalBinaryTreeIterator.DeleteChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclCardinalBinaryTreeIterator.Extract; +var + OldCursor: TJclCardinalBinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Extract(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalBinaryTreeIterator.ExtractChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclCardinalBinaryTreeIterator.ExtractChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclCardinalBinaryTreeIterator.GetChild(Index: Integer): Cardinal; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if (FCursor <> nil) and (Index = 0) and (FCursor.Left <> nil) then + FCursor := FCursor.Left + else + if (FCursor <> nil) and (Index = 0) then + FCursor := FCursor.Right + else + if (FCursor <> nil) and (Index = 1) then + FCursor := FCursor.Right + else + FCursor := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalBinaryTreeIterator.GetValue: Cardinal; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := 0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalBinaryTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index = 0) then + Result := (FCursor.Left <> nil) or (FCursor.Right <> nil) + else + if (FCursor <> nil) and (Index = 1) then + Result := (FCursor.Left <> nil) and (FCursor.Right <> nil) + else + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalBinaryTreeIterator.HasLeft: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Left <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalBinaryTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalBinaryTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalBinaryTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalBinaryTreeIterator.HasRight: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Right <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalBinaryTreeIterator.IndexOfChild(AValue: Cardinal): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := -1; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + begin + if FEqualityComparer.ItemsEqual(FCursor.Left.Value, AValue) then + Result := 0 + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, AValue) then + Result := 1; + end + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, AValue) then + Result := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalBinaryTreeIterator.Insert(AValue: Cardinal): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclCardinalBinaryTreeIterator.InsertChild(Index: Integer; AValue: Cardinal): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclCardinalBinaryTreeIterator.IteratorEquals(const AIterator: IJclCardinalIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclCardinalBinaryTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclCardinalBinaryTreeIterator then + begin + ItrObj := TJclCardinalBinaryTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +function TJclCardinalBinaryTreeIterator.Left: Cardinal; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + FCursor := FCursor.Left; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclCardinalBinaryTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclCardinalBinaryTreeIterator.Next: Cardinal; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := 0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalBinaryTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclCardinalBinaryTreeIterator.Parent: Cardinal; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalBinaryTreeIterator.Previous: Cardinal; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := 0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalBinaryTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclCardinalBinaryTreeIterator.Remove; +var + OldCursor: TJclCardinalBinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Remove(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalBinaryTreeIterator.Reset; +var + NewCursor: TJclCardinalBinaryNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalBinaryTreeIterator.Right: Cardinal; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + FCursor := FCursor.Right; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalBinaryTreeIterator.SetChild(Index: Integer; AValue: Cardinal); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclCardinalBinaryTreeIterator.SetValue(AValue: Cardinal); +begin + raise EJclOperationNotSupportedError.Create; +end; + +//=== { TJclPreOrderCardinalBinaryTreeIterator } =================================================== + +function TJclPreOrderCardinalBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderCardinalBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderCardinalBinaryTreeIterator.GetNextCursor: TJclCardinalBinaryNode; +var + LastRet: TJclCardinalBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.Left <> nil then + Result := Result.Left + else + if Result.Right <> nil then + Result := Result.Right + else + begin + Result := Result.Parent; + while (Result <> nil) and ((Result.Right = nil) or (Result.Right = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Right; + end; +end; + +function TJclPreOrderCardinalBinaryTreeIterator.GetPreviousCursor: TJclCardinalBinaryNode; +var + LastRet: TJclCardinalBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Left <> LastRet) and (Result.Left <> nil) then + // come from Right + begin + Result := Result.Left; + while (Result.Left <> nil) or (Result.Right <> nil) do // both childs + begin + if Result.Right <> nil then // right child first + Result := Result.Right + else + Result := Result.Left; + end; + end; +end; + +//=== { TJclInOrderCardinalBinaryTreeIterator } ==================================================== + +function TJclInOrderCardinalBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclInOrderCardinalBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclInOrderCardinalBinaryTreeIterator.GetNextCursor: TJclCardinalBinaryNode; +var + LastRet: TJclCardinalBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + begin + Result := Result.Right; + while (Result.Left <> nil) do + Result := Result.Left; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right = LastRet) do + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +function TJclInOrderCardinalBinaryTreeIterator.GetPreviousCursor: TJclCardinalBinaryNode; +var + LastRet: TJclCardinalBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Left <> nil then + begin + Result := Result.Left; + while Result.Right <> nil do + Result := Result.Right; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right <> LastRet) do // Come from Left + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +//=== { TJclPostOrderCardinalBinaryTreeIterator } ================================================== + +function TJclPostOrderCardinalBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderCardinalBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderCardinalBinaryTreeIterator.GetNextCursor: TJclCardinalBinaryNode; +var + LastRet: TJclCardinalBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Right <> nil) and (Result.Right <> LastRet) then + begin + Result := Result.Right; + while (Result.Left <> nil) or (Result.Right <> nil) do + begin + if Result.Left <> nil then + Result := Result.Left + else + Result := Result.Right; + end; + end; +end; + +function TJclPostOrderCardinalBinaryTreeIterator.GetPreviousCursor: TJclCardinalBinaryNode; +var + LastRet: TJclCardinalBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + Result := Result.Right + else + if Result.Left <> nil then + Result := Result.Left + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and ((Result.Left = nil) or (Result.Left = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Left; + end; +end; + +//=== { TJclInt64BinaryTree } ================================================= + +constructor TJclInt64BinaryTree.Create(ACompare: TInt64Compare); +begin + inherited Create(); + FTraverseOrder := toOrder; + FMaxDepth := 0; + FAutoPackParameter := 2; + SetCompare(ACompare); +end; + +destructor TJclInt64BinaryTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclInt64BinaryTree.Add(const AValue: Int64): Boolean; +var + NewNode, Current, Save: TJclInt64BinaryNode; + Comp, Depth: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // Insert into right place + if FAllowDefaultElements or not ItemsEqual(AValue, 0) then + begin + Save := nil; + Current := FRoot; + Comp := 1; + Depth := 0; + while Current <> nil do + begin + Inc(Depth); + Save := Current; + Comp := ItemsCompare(AValue, Current.Value); + if Comp < 0 then + Current := Current.Left + else + if Comp > 0 then + Current := Current.Right + else + if CheckDuplicate then + Current := Current.Left // arbitrary decision + else + Break; + end; + if (Comp <> 0) or CheckDuplicate then + begin + NewNode := TJclInt64BinaryNode.Create; + NewNode.Value := AValue; + NewNode.Parent := Save; + if Save = nil then + FRoot := NewNode + else + if ItemsCompare(NewNode.Value, Save.Value) <= 0 then + Save.Left := NewNode + else + Save.Right := NewNode; + Inc(FSize); + Inc(Depth); + if Depth > FMaxDepth then + FMaxDepth := Depth; + Result := True; + AutoPack; + end + else + Result := False; + end + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64BinaryTree.AddAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64BinaryTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclInt64BinaryTree; + ACollection: IJclInt64Collection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclInt64BinaryTree then + begin + ADest := TJclInt64BinaryTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclInt64Collection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclInt64BinaryTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclInt64BinaryTree then + TJclInt64BinaryTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclInt64BinaryTree.AutoPack; +begin + case FAutoPackStrategy of + //apsDisabled: ; + apsAgressive: + if (FMaxDepth > 1) and (((1 shl (FMaxDepth - 1)) - 1) > FSize) then + Pack; + // apsIncremental: ; + apsProportional: + if (FMaxDepth > FAutoPackParameter) and (((1 shl (FMaxDepth - FAutoPackParameter)) - 1) > FSize) then + Pack; + end; +end; + +function TJclInt64BinaryTree.BuildTree(const LeafArray: array of TJclInt64BinaryNode; Left, Right: Integer; Parent: TJclInt64BinaryNode; + Offset: Integer): TJclInt64BinaryNode; +var + Middle: Integer; +begin + Middle := (Left + Right + Offset) shr 1; + Result := LeafArray[Middle]; + Result.Parent := Parent; + if Middle > Left then + Result.Left := BuildTree(LeafArray, Left, Middle - 1, Result, 0) + else + Result.Left := nil; + if Middle < Right then + Result.Right := BuildTree(LeafArray, Middle + 1, Right, Result, 1) + else + Result.Right := nil; +end; + +procedure TJclInt64BinaryTree.Clear; +var + Current, Parent: TJclInt64BinaryNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // postorder + Current := FRoot; + if Current = nil then + Exit; + // find first in post-order + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + // for all items in the tree in post-order + repeat + Parent := Current.Parent; + // remove reference + if Parent <> nil then + begin + if Parent.Left = Current then + Parent.Left := nil + else + if Parent.Right = Current then + Parent.Right := nil; + end; + + // free item + FreeInt64(Current.Value); + Current.Free; + + // find next item + Current := Parent; + if (Current <> nil) and (Current.Right <> nil) then + begin + Current := Current.Right; + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + end; + until Current = nil; + FRoot := nil; + FSize := 0; + FMaxDepth := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64BinaryTree.CloneNode(Node, Parent: TJclInt64BinaryNode): TJclInt64BinaryNode; +begin + Result := TJclInt64BinaryNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + if Node.Left <> nil then + Result.Left := CloneNode(Node.Left, Result); // recursive call + if Node.Right <> nil then + Result.Right := CloneNode(Node.Right, Result); // recursive call +end; + +function TJclInt64BinaryTree.CollectionEquals(const ACollection: IJclInt64Collection): Boolean; +var + It, ItSelf: IJclInt64Iterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64BinaryTree.Contains(const AValue: Int64): Boolean; +var + Comp: Integer; + Current: TJclInt64BinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FRoot; + while Current <> nil do + begin + Comp := ItemsCompare(Current.Value, AValue); + if Comp = 0 then + begin + Result := True; + Break; + end + else + if Comp > 0 then + Current := Current.Left + else + Current := Current.Right; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64BinaryTree.ContainsAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64BinaryTree.Extract(const AValue: Int64): Boolean; +var + Current, Successor: TJclInt64BinaryNode; + Comp: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + // locate AValue in the tree + Current := FRoot; + repeat + while Current <> nil do + begin + Comp := ItemsCompare(AValue, Current.Value); + if Comp = 0 then + Break + else + if Comp < 0 then + Current := Current.Left + else + Current := Current.Right; + end; + if Current = nil then + Break; + Result := True; + // Remove Current from tree + if (Current.Left = nil) and (Current.Right <> nil) then + begin + // remove references to Current + Current.Right.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Right + else + Current.Parent.Right := Current.Right; + end + else + // fix root + FRoot := Current.Right; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right = nil) then + begin + // remove references to Current + Current.Left.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Left + else + Current.Parent.Right := Current.Left; + end + else + // fix root + FRoot := Current.Left; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right <> nil) then + begin + // find the successor in tree + Successor := Current.Right; + while Successor.Left <> nil do + Successor := Successor.Left; + + if Successor <> Current.Right then + begin + // remove references to successor + Successor.Parent.Left := Successor.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor.Parent; + Successor.Right := Current.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor; + end; + + // insert successor in new position + Successor.Left := Current.Left; + if Current.Left <> nil then + Current.Left.Parent := Successor; + Successor.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Successor + else + Current.Parent.Right := Successor; + end + else + // fix root + FRoot := Successor; + Successor := Current.Parent; + if Successor <> nil then + Successor := FRoot; + end + else + begin + // (Current.Left = nil) and (Current.Right = nil) + Successor := Current.Parent; + if Successor <> nil then + begin + // remove references from parent + if Successor.Left = Current then + Successor.Left := nil + else + Successor.Right := nil; + end + else + FRoot := nil; + end; + Current.Value := 0; + Current.Free; + Dec(FSize); + Current := Successor; + until FRemoveSingleElement or (Current = nil); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64BinaryTree.ExtractAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64BinaryTree.First: IJclInt64Iterator; +var + Start: TJclInt64BinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderInt64BinaryTreeIterator.Create(Self, Start, False, isFirst); + toOrder: + begin + if Start <> nil then + while Start.Left <> nil do + Start := Start.Left; + Result := TJclInOrderInt64BinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + toPostOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Left <> nil then + Start := Start.Left + else + Start := Start.Right; + end; + Result := TJclPostOrderInt64BinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclInt64BinaryTree.GetEnumerator: IJclInt64Iterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclInt64BinaryTree.GetRoot: IJclInt64TreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderInt64BinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toOrder: + Result := TJclInOrderInt64BinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TJclPostOrderInt64BinaryTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64BinaryTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclInt64BinaryTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclInt64BinaryTree.Last: IJclInt64Iterator; +var + Start: TJclInt64BinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Right <> nil then + Start := Start.Right + else + Start := Start.Left; + end; + Result := TJclPreOrderInt64BinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toOrder: + begin + if Start <> nil then + while Start.Right <> nil do + Start := Start.Right; + Result := TJclInOrderInt64BinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TJclPostOrderInt64BinaryTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64BinaryTree.Pack; +var + LeafArray: array of TJclInt64BinaryNode; + ANode, BNode: TJclInt64BinaryNode; + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetLength(Leafarray, FSize); + try + // in order enumeration of nodes + ANode := FRoot; + if ANode <> nil then + begin + // find first node + while ANode.Left <> nil do + ANode := ANode.Left; + + Index := 0; + while ANode <> nil do + begin + LeafArray[Index] := ANode; + Inc(Index); + if ANode.Right <> nil then + begin + ANode := ANode.Right; + while (ANode.Left <> nil) do + ANode := ANode.Left; + end + else + begin + BNode := ANode; + ANode := ANode.Parent; + while (ANode <> nil) and (ANode.Right = BNode) do + begin + BNode := ANode; + ANode := ANode.Parent; + end; + end; + end; + + Index := FSize shr 1; + FRoot := LeafArray[Index]; + FRoot.Parent := nil; + if Index > 0 then + FRoot.Left := BuildTree(LeafArray, 0, Index - 1, FRoot, 0) + else + FRoot.Left := nil; + if Index < (FSize - 1) then + FRoot.Right := BuildTree(LeafArray, Index + 1, FSize - 1, FRoot, 1) + else + FRoot.Right := nil; + end; + finally + SetLength(LeafArray, 0); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64BinaryTree.Remove(const AValue: Int64): Boolean; +var + Extracted: Int64; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeInt64(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64BinaryTree.RemoveAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64BinaryTree.RetainAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64BinaryTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclInt64BinaryTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclInt64BinaryTree.Size: Integer; +begin + Result := FSize; +end; + +function TJclInt64BinaryTree.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclInt64BinaryTree.Create(Compare); + AssignPropertiesTo(Result); +end; + +//=== { TJclInt64BinaryTreeIterator } =========================================================== + +constructor TJclInt64BinaryTreeIterator.Create(const AOwnTree: TJclInt64BinaryTree; ACursor: TJclInt64BinaryNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FStart := AStart; + FOwnTree := AOwnTree; + FEqualityComparer := AOwnTree as IJclInt64EqualityComparer; +end; + +function TJclInt64BinaryTreeIterator.Add(const AValue: Int64): Boolean; +begin + Result := FOwnTree.Add(AValue); +end; + +function TJclInt64BinaryTreeIterator.AddChild(const AValue: Int64): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclInt64BinaryTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclInt64BinaryTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclInt64BinaryTreeIterator then + begin + ADest := TJclInt64BinaryTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclInt64BinaryTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + Inc(Result); + if FCursor.Right <> nil then + Inc(Result); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64BinaryTreeIterator.DeleteChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclInt64BinaryTreeIterator.DeleteChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclInt64BinaryTreeIterator.Extract; +var + OldCursor: TJclInt64BinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Extract(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64BinaryTreeIterator.ExtractChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclInt64BinaryTreeIterator.ExtractChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclInt64BinaryTreeIterator.GetChild(Index: Integer): Int64; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if (FCursor <> nil) and (Index = 0) and (FCursor.Left <> nil) then + FCursor := FCursor.Left + else + if (FCursor <> nil) and (Index = 0) then + FCursor := FCursor.Right + else + if (FCursor <> nil) and (Index = 1) then + FCursor := FCursor.Right + else + FCursor := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64BinaryTreeIterator.GetValue: Int64; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := 0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64BinaryTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index = 0) then + Result := (FCursor.Left <> nil) or (FCursor.Right <> nil) + else + if (FCursor <> nil) and (Index = 1) then + Result := (FCursor.Left <> nil) and (FCursor.Right <> nil) + else + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64BinaryTreeIterator.HasLeft: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Left <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64BinaryTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64BinaryTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64BinaryTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64BinaryTreeIterator.HasRight: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Right <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64BinaryTreeIterator.IndexOfChild(const AValue: Int64): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := -1; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + begin + if FEqualityComparer.ItemsEqual(FCursor.Left.Value, AValue) then + Result := 0 + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, AValue) then + Result := 1; + end + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, AValue) then + Result := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64BinaryTreeIterator.Insert(const AValue: Int64): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclInt64BinaryTreeIterator.InsertChild(Index: Integer; const AValue: Int64): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclInt64BinaryTreeIterator.IteratorEquals(const AIterator: IJclInt64Iterator): Boolean; +var + Obj: TObject; + ItrObj: TJclInt64BinaryTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclInt64BinaryTreeIterator then + begin + ItrObj := TJclInt64BinaryTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +function TJclInt64BinaryTreeIterator.Left: Int64; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + FCursor := FCursor.Left; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclInt64BinaryTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclInt64BinaryTreeIterator.Next: Int64; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := 0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64BinaryTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclInt64BinaryTreeIterator.Parent: Int64; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64BinaryTreeIterator.Previous: Int64; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := 0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64BinaryTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclInt64BinaryTreeIterator.Remove; +var + OldCursor: TJclInt64BinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Remove(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64BinaryTreeIterator.Reset; +var + NewCursor: TJclInt64BinaryNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64BinaryTreeIterator.Right: Int64; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + FCursor := FCursor.Right; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64BinaryTreeIterator.SetChild(Index: Integer; const AValue: Int64); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclInt64BinaryTreeIterator.SetValue(const AValue: Int64); +begin + raise EJclOperationNotSupportedError.Create; +end; + +//=== { TJclPreOrderInt64BinaryTreeIterator } =================================================== + +function TJclPreOrderInt64BinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderInt64BinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderInt64BinaryTreeIterator.GetNextCursor: TJclInt64BinaryNode; +var + LastRet: TJclInt64BinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.Left <> nil then + Result := Result.Left + else + if Result.Right <> nil then + Result := Result.Right + else + begin + Result := Result.Parent; + while (Result <> nil) and ((Result.Right = nil) or (Result.Right = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Right; + end; +end; + +function TJclPreOrderInt64BinaryTreeIterator.GetPreviousCursor: TJclInt64BinaryNode; +var + LastRet: TJclInt64BinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Left <> LastRet) and (Result.Left <> nil) then + // come from Right + begin + Result := Result.Left; + while (Result.Left <> nil) or (Result.Right <> nil) do // both childs + begin + if Result.Right <> nil then // right child first + Result := Result.Right + else + Result := Result.Left; + end; + end; +end; + +//=== { TJclInOrderInt64BinaryTreeIterator } ==================================================== + +function TJclInOrderInt64BinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclInOrderInt64BinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclInOrderInt64BinaryTreeIterator.GetNextCursor: TJclInt64BinaryNode; +var + LastRet: TJclInt64BinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + begin + Result := Result.Right; + while (Result.Left <> nil) do + Result := Result.Left; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right = LastRet) do + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +function TJclInOrderInt64BinaryTreeIterator.GetPreviousCursor: TJclInt64BinaryNode; +var + LastRet: TJclInt64BinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Left <> nil then + begin + Result := Result.Left; + while Result.Right <> nil do + Result := Result.Right; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right <> LastRet) do // Come from Left + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +//=== { TJclPostOrderInt64BinaryTreeIterator } ================================================== + +function TJclPostOrderInt64BinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderInt64BinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderInt64BinaryTreeIterator.GetNextCursor: TJclInt64BinaryNode; +var + LastRet: TJclInt64BinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Right <> nil) and (Result.Right <> LastRet) then + begin + Result := Result.Right; + while (Result.Left <> nil) or (Result.Right <> nil) do + begin + if Result.Left <> nil then + Result := Result.Left + else + Result := Result.Right; + end; + end; +end; + +function TJclPostOrderInt64BinaryTreeIterator.GetPreviousCursor: TJclInt64BinaryNode; +var + LastRet: TJclInt64BinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + Result := Result.Right + else + if Result.Left <> nil then + Result := Result.Left + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and ((Result.Left = nil) or (Result.Left = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Left; + end; +end; + +//=== { TJclPtrBinaryTree } ================================================= + +constructor TJclPtrBinaryTree.Create(ACompare: TPtrCompare); +begin + inherited Create(); + FTraverseOrder := toOrder; + FMaxDepth := 0; + FAutoPackParameter := 2; + SetCompare(ACompare); +end; + +destructor TJclPtrBinaryTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclPtrBinaryTree.Add(APtr: Pointer): Boolean; +var + NewNode, Current, Save: TJclPtrBinaryNode; + Comp, Depth: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // Insert into right place + if FAllowDefaultElements or not ItemsEqual(APtr, nil) then + begin + Save := nil; + Current := FRoot; + Comp := 1; + Depth := 0; + while Current <> nil do + begin + Inc(Depth); + Save := Current; + Comp := ItemsCompare(APtr, Current.Value); + if Comp < 0 then + Current := Current.Left + else + if Comp > 0 then + Current := Current.Right + else + if CheckDuplicate then + Current := Current.Left // arbitrary decision + else + Break; + end; + if (Comp <> 0) or CheckDuplicate then + begin + NewNode := TJclPtrBinaryNode.Create; + NewNode.Value := APtr; + NewNode.Parent := Save; + if Save = nil then + FRoot := NewNode + else + if ItemsCompare(NewNode.Value, Save.Value) <= 0 then + Save.Left := NewNode + else + Save.Right := NewNode; + Inc(FSize); + Inc(Depth); + if Depth > FMaxDepth then + FMaxDepth := Depth; + Result := True; + AutoPack; + end + else + Result := False; + end + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrBinaryTree.AddAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrBinaryTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclPtrBinaryTree; + ACollection: IJclPtrCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclPtrBinaryTree then + begin + ADest := TJclPtrBinaryTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclPtrCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclPtrBinaryTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclPtrBinaryTree then + TJclPtrBinaryTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclPtrBinaryTree.AutoPack; +begin + case FAutoPackStrategy of + //apsDisabled: ; + apsAgressive: + if (FMaxDepth > 1) and (((1 shl (FMaxDepth - 1)) - 1) > FSize) then + Pack; + // apsIncremental: ; + apsProportional: + if (FMaxDepth > FAutoPackParameter) and (((1 shl (FMaxDepth - FAutoPackParameter)) - 1) > FSize) then + Pack; + end; +end; + +function TJclPtrBinaryTree.BuildTree(const LeafArray: array of TJclPtrBinaryNode; Left, Right: Integer; Parent: TJclPtrBinaryNode; + Offset: Integer): TJclPtrBinaryNode; +var + Middle: Integer; +begin + Middle := (Left + Right + Offset) shr 1; + Result := LeafArray[Middle]; + Result.Parent := Parent; + if Middle > Left then + Result.Left := BuildTree(LeafArray, Left, Middle - 1, Result, 0) + else + Result.Left := nil; + if Middle < Right then + Result.Right := BuildTree(LeafArray, Middle + 1, Right, Result, 1) + else + Result.Right := nil; +end; + +procedure TJclPtrBinaryTree.Clear; +var + Current, Parent: TJclPtrBinaryNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // postorder + Current := FRoot; + if Current = nil then + Exit; + // find first in post-order + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + // for all items in the tree in post-order + repeat + Parent := Current.Parent; + // remove reference + if Parent <> nil then + begin + if Parent.Left = Current then + Parent.Left := nil + else + if Parent.Right = Current then + Parent.Right := nil; + end; + + // free item + FreePointer(Current.Value); + Current.Free; + + // find next item + Current := Parent; + if (Current <> nil) and (Current.Right <> nil) then + begin + Current := Current.Right; + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + end; + until Current = nil; + FRoot := nil; + FSize := 0; + FMaxDepth := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrBinaryTree.CloneNode(Node, Parent: TJclPtrBinaryNode): TJclPtrBinaryNode; +begin + Result := TJclPtrBinaryNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + if Node.Left <> nil then + Result.Left := CloneNode(Node.Left, Result); // recursive call + if Node.Right <> nil then + Result.Right := CloneNode(Node.Right, Result); // recursive call +end; + +function TJclPtrBinaryTree.CollectionEquals(const ACollection: IJclPtrCollection): Boolean; +var + It, ItSelf: IJclPtrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrBinaryTree.Contains(APtr: Pointer): Boolean; +var + Comp: Integer; + Current: TJclPtrBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FRoot; + while Current <> nil do + begin + Comp := ItemsCompare(Current.Value, APtr); + if Comp = 0 then + begin + Result := True; + Break; + end + else + if Comp > 0 then + Current := Current.Left + else + Current := Current.Right; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrBinaryTree.ContainsAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrBinaryTree.Extract(APtr: Pointer): Boolean; +var + Current, Successor: TJclPtrBinaryNode; + Comp: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + // locate APtr in the tree + Current := FRoot; + repeat + while Current <> nil do + begin + Comp := ItemsCompare(APtr, Current.Value); + if Comp = 0 then + Break + else + if Comp < 0 then + Current := Current.Left + else + Current := Current.Right; + end; + if Current = nil then + Break; + Result := True; + // Remove Current from tree + if (Current.Left = nil) and (Current.Right <> nil) then + begin + // remove references to Current + Current.Right.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Right + else + Current.Parent.Right := Current.Right; + end + else + // fix root + FRoot := Current.Right; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right = nil) then + begin + // remove references to Current + Current.Left.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Left + else + Current.Parent.Right := Current.Left; + end + else + // fix root + FRoot := Current.Left; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right <> nil) then + begin + // find the successor in tree + Successor := Current.Right; + while Successor.Left <> nil do + Successor := Successor.Left; + + if Successor <> Current.Right then + begin + // remove references to successor + Successor.Parent.Left := Successor.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor.Parent; + Successor.Right := Current.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor; + end; + + // insert successor in new position + Successor.Left := Current.Left; + if Current.Left <> nil then + Current.Left.Parent := Successor; + Successor.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Successor + else + Current.Parent.Right := Successor; + end + else + // fix root + FRoot := Successor; + Successor := Current.Parent; + if Successor <> nil then + Successor := FRoot; + end + else + begin + // (Current.Left = nil) and (Current.Right = nil) + Successor := Current.Parent; + if Successor <> nil then + begin + // remove references from parent + if Successor.Left = Current then + Successor.Left := nil + else + Successor.Right := nil; + end + else + FRoot := nil; + end; + Current.Value := nil; + Current.Free; + Dec(FSize); + Current := Successor; + until FRemoveSingleElement or (Current = nil); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrBinaryTree.ExtractAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrBinaryTree.First: IJclPtrIterator; +var + Start: TJclPtrBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderPtrBinaryTreeIterator.Create(Self, Start, False, isFirst); + toOrder: + begin + if Start <> nil then + while Start.Left <> nil do + Start := Start.Left; + Result := TJclInOrderPtrBinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + toPostOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Left <> nil then + Start := Start.Left + else + Start := Start.Right; + end; + Result := TJclPostOrderPtrBinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclPtrBinaryTree.GetEnumerator: IJclPtrIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclPtrBinaryTree.GetRoot: IJclPtrTreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderPtrBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toOrder: + Result := TJclInOrderPtrBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TJclPostOrderPtrBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrBinaryTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclPtrBinaryTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclPtrBinaryTree.Last: IJclPtrIterator; +var + Start: TJclPtrBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Right <> nil then + Start := Start.Right + else + Start := Start.Left; + end; + Result := TJclPreOrderPtrBinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toOrder: + begin + if Start <> nil then + while Start.Right <> nil do + Start := Start.Right; + Result := TJclInOrderPtrBinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TJclPostOrderPtrBinaryTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrBinaryTree.Pack; +var + LeafArray: array of TJclPtrBinaryNode; + ANode, BNode: TJclPtrBinaryNode; + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetLength(Leafarray, FSize); + try + // in order enumeration of nodes + ANode := FRoot; + if ANode <> nil then + begin + // find first node + while ANode.Left <> nil do + ANode := ANode.Left; + + Index := 0; + while ANode <> nil do + begin + LeafArray[Index] := ANode; + Inc(Index); + if ANode.Right <> nil then + begin + ANode := ANode.Right; + while (ANode.Left <> nil) do + ANode := ANode.Left; + end + else + begin + BNode := ANode; + ANode := ANode.Parent; + while (ANode <> nil) and (ANode.Right = BNode) do + begin + BNode := ANode; + ANode := ANode.Parent; + end; + end; + end; + + Index := FSize shr 1; + FRoot := LeafArray[Index]; + FRoot.Parent := nil; + if Index > 0 then + FRoot.Left := BuildTree(LeafArray, 0, Index - 1, FRoot, 0) + else + FRoot.Left := nil; + if Index < (FSize - 1) then + FRoot.Right := BuildTree(LeafArray, Index + 1, FSize - 1, FRoot, 1) + else + FRoot.Right := nil; + end; + finally + SetLength(LeafArray, 0); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrBinaryTree.Remove(APtr: Pointer): Boolean; +var + Extracted: Pointer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(APtr); + if Result then + begin + Extracted := APtr; + FreePointer(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrBinaryTree.RemoveAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrBinaryTree.RetainAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrBinaryTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclPtrBinaryTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclPtrBinaryTree.Size: Integer; +begin + Result := FSize; +end; + +function TJclPtrBinaryTree.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclPtrBinaryTree.Create(Compare); + AssignPropertiesTo(Result); +end; + +//=== { TJclPtrBinaryTreeIterator } =========================================================== + +constructor TJclPtrBinaryTreeIterator.Create(const AOwnTree: TJclPtrBinaryTree; ACursor: TJclPtrBinaryNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FStart := AStart; + FOwnTree := AOwnTree; + FEqualityComparer := AOwnTree as IJclPtrEqualityComparer; +end; + +function TJclPtrBinaryTreeIterator.Add(APtr: Pointer): Boolean; +begin + Result := FOwnTree.Add(APtr); +end; + +function TJclPtrBinaryTreeIterator.AddChild(APtr: Pointer): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclPtrBinaryTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclPtrBinaryTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclPtrBinaryTreeIterator then + begin + ADest := TJclPtrBinaryTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclPtrBinaryTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + Inc(Result); + if FCursor.Right <> nil then + Inc(Result); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrBinaryTreeIterator.DeleteChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclPtrBinaryTreeIterator.DeleteChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclPtrBinaryTreeIterator.Extract; +var + OldCursor: TJclPtrBinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Extract(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrBinaryTreeIterator.ExtractChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclPtrBinaryTreeIterator.ExtractChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclPtrBinaryTreeIterator.GetChild(Index: Integer): Pointer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := nil; + if (FCursor <> nil) and (Index = 0) and (FCursor.Left <> nil) then + FCursor := FCursor.Left + else + if (FCursor <> nil) and (Index = 0) then + FCursor := FCursor.Right + else + if (FCursor <> nil) and (Index = 1) then + FCursor := FCursor.Right + else + FCursor := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrBinaryTreeIterator.GetPointer: Pointer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrBinaryTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index = 0) then + Result := (FCursor.Left <> nil) or (FCursor.Right <> nil) + else + if (FCursor <> nil) and (Index = 1) then + Result := (FCursor.Left <> nil) and (FCursor.Right <> nil) + else + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrBinaryTreeIterator.HasLeft: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Left <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrBinaryTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrBinaryTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrBinaryTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrBinaryTreeIterator.HasRight: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Right <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrBinaryTreeIterator.IndexOfChild(APtr: Pointer): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := -1; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + begin + if FEqualityComparer.ItemsEqual(FCursor.Left.Value, APtr) then + Result := 0 + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, APtr) then + Result := 1; + end + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, APtr) then + Result := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrBinaryTreeIterator.Insert(APtr: Pointer): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclPtrBinaryTreeIterator.InsertChild(Index: Integer; APtr: Pointer): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclPtrBinaryTreeIterator.IteratorEquals(const AIterator: IJclPtrIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclPtrBinaryTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclPtrBinaryTreeIterator then + begin + ItrObj := TJclPtrBinaryTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +function TJclPtrBinaryTreeIterator.Left: Pointer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := nil; + if FCursor <> nil then + FCursor := FCursor.Left; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclPtrBinaryTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclPtrBinaryTreeIterator.Next: Pointer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrBinaryTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclPtrBinaryTreeIterator.Parent: Pointer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := nil; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrBinaryTreeIterator.Previous: Pointer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrBinaryTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclPtrBinaryTreeIterator.Remove; +var + OldCursor: TJclPtrBinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Remove(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrBinaryTreeIterator.Reset; +var + NewCursor: TJclPtrBinaryNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrBinaryTreeIterator.Right: Pointer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := nil; + if FCursor <> nil then + FCursor := FCursor.Right; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrBinaryTreeIterator.SetChild(Index: Integer; APtr: Pointer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclPtrBinaryTreeIterator.SetPointer(APtr: Pointer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +//=== { TJclPreOrderPtrBinaryTreeIterator } =================================================== + +function TJclPreOrderPtrBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderPtrBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderPtrBinaryTreeIterator.GetNextCursor: TJclPtrBinaryNode; +var + LastRet: TJclPtrBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.Left <> nil then + Result := Result.Left + else + if Result.Right <> nil then + Result := Result.Right + else + begin + Result := Result.Parent; + while (Result <> nil) and ((Result.Right = nil) or (Result.Right = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Right; + end; +end; + +function TJclPreOrderPtrBinaryTreeIterator.GetPreviousCursor: TJclPtrBinaryNode; +var + LastRet: TJclPtrBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Left <> LastRet) and (Result.Left <> nil) then + // come from Right + begin + Result := Result.Left; + while (Result.Left <> nil) or (Result.Right <> nil) do // both childs + begin + if Result.Right <> nil then // right child first + Result := Result.Right + else + Result := Result.Left; + end; + end; +end; + +//=== { TJclInOrderPtrBinaryTreeIterator } ==================================================== + +function TJclInOrderPtrBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclInOrderPtrBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclInOrderPtrBinaryTreeIterator.GetNextCursor: TJclPtrBinaryNode; +var + LastRet: TJclPtrBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + begin + Result := Result.Right; + while (Result.Left <> nil) do + Result := Result.Left; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right = LastRet) do + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +function TJclInOrderPtrBinaryTreeIterator.GetPreviousCursor: TJclPtrBinaryNode; +var + LastRet: TJclPtrBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Left <> nil then + begin + Result := Result.Left; + while Result.Right <> nil do + Result := Result.Right; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right <> LastRet) do // Come from Left + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +//=== { TJclPostOrderPtrBinaryTreeIterator } ================================================== + +function TJclPostOrderPtrBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderPtrBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderPtrBinaryTreeIterator.GetNextCursor: TJclPtrBinaryNode; +var + LastRet: TJclPtrBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Right <> nil) and (Result.Right <> LastRet) then + begin + Result := Result.Right; + while (Result.Left <> nil) or (Result.Right <> nil) do + begin + if Result.Left <> nil then + Result := Result.Left + else + Result := Result.Right; + end; + end; +end; + +function TJclPostOrderPtrBinaryTreeIterator.GetPreviousCursor: TJclPtrBinaryNode; +var + LastRet: TJclPtrBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + Result := Result.Right + else + if Result.Left <> nil then + Result := Result.Left + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and ((Result.Left = nil) or (Result.Left = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Left; + end; +end; + +//=== { TJclBinaryTree } ================================================= + +constructor TJclBinaryTree.Create(ACompare: TCompare; AOwnsObjects: Boolean); +begin + inherited Create(AOwnsObjects); + FTraverseOrder := toOrder; + FMaxDepth := 0; + FAutoPackParameter := 2; + SetCompare(ACompare); +end; + +destructor TJclBinaryTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclBinaryTree.Add(AObject: TObject): Boolean; +var + NewNode, Current, Save: TJclBinaryNode; + Comp, Depth: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // Insert into right place + if FAllowDefaultElements or not ItemsEqual(AObject, nil) then + begin + Save := nil; + Current := FRoot; + Comp := 1; + Depth := 0; + while Current <> nil do + begin + Inc(Depth); + Save := Current; + Comp := ItemsCompare(AObject, Current.Value); + if Comp < 0 then + Current := Current.Left + else + if Comp > 0 then + Current := Current.Right + else + if CheckDuplicate then + Current := Current.Left // arbitrary decision + else + Break; + end; + if (Comp <> 0) or CheckDuplicate then + begin + NewNode := TJclBinaryNode.Create; + NewNode.Value := AObject; + NewNode.Parent := Save; + if Save = nil then + FRoot := NewNode + else + if ItemsCompare(NewNode.Value, Save.Value) <= 0 then + Save.Left := NewNode + else + Save.Right := NewNode; + Inc(FSize); + Inc(Depth); + if Depth > FMaxDepth then + FMaxDepth := Depth; + Result := True; + AutoPack; + end + else + Result := False; + end + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTree.AddAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclBinaryTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclBinaryTree; + ACollection: IJclCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclBinaryTree then + begin + ADest := TJclBinaryTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclBinaryTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclBinaryTree then + TJclBinaryTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclBinaryTree.AutoPack; +begin + case FAutoPackStrategy of + //apsDisabled: ; + apsAgressive: + if (FMaxDepth > 1) and (((1 shl (FMaxDepth - 1)) - 1) > FSize) then + Pack; + // apsIncremental: ; + apsProportional: + if (FMaxDepth > FAutoPackParameter) and (((1 shl (FMaxDepth - FAutoPackParameter)) - 1) > FSize) then + Pack; + end; +end; + +function TJclBinaryTree.BuildTree(const LeafArray: array of TJclBinaryNode; Left, Right: Integer; Parent: TJclBinaryNode; + Offset: Integer): TJclBinaryNode; +var + Middle: Integer; +begin + Middle := (Left + Right + Offset) shr 1; + Result := LeafArray[Middle]; + Result.Parent := Parent; + if Middle > Left then + Result.Left := BuildTree(LeafArray, Left, Middle - 1, Result, 0) + else + Result.Left := nil; + if Middle < Right then + Result.Right := BuildTree(LeafArray, Middle + 1, Right, Result, 1) + else + Result.Right := nil; +end; + +procedure TJclBinaryTree.Clear; +var + Current, Parent: TJclBinaryNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // postorder + Current := FRoot; + if Current = nil then + Exit; + // find first in post-order + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + // for all items in the tree in post-order + repeat + Parent := Current.Parent; + // remove reference + if Parent <> nil then + begin + if Parent.Left = Current then + Parent.Left := nil + else + if Parent.Right = Current then + Parent.Right := nil; + end; + + // free item + FreeObject(Current.Value); + Current.Free; + + // find next item + Current := Parent; + if (Current <> nil) and (Current.Right <> nil) then + begin + Current := Current.Right; + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + end; + until Current = nil; + FRoot := nil; + FSize := 0; + FMaxDepth := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTree.CloneNode(Node, Parent: TJclBinaryNode): TJclBinaryNode; +begin + Result := TJclBinaryNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + if Node.Left <> nil then + Result.Left := CloneNode(Node.Left, Result); // recursive call + if Node.Right <> nil then + Result.Right := CloneNode(Node.Right, Result); // recursive call +end; + +function TJclBinaryTree.CollectionEquals(const ACollection: IJclCollection): Boolean; +var + It, ItSelf: IJclIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTree.Contains(AObject: TObject): Boolean; +var + Comp: Integer; + Current: TJclBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FRoot; + while Current <> nil do + begin + Comp := ItemsCompare(Current.Value, AObject); + if Comp = 0 then + begin + Result := True; + Break; + end + else + if Comp > 0 then + Current := Current.Left + else + Current := Current.Right; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTree.ContainsAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTree.Extract(AObject: TObject): Boolean; +var + Current, Successor: TJclBinaryNode; + Comp: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + // locate AObject in the tree + Current := FRoot; + repeat + while Current <> nil do + begin + Comp := ItemsCompare(AObject, Current.Value); + if Comp = 0 then + Break + else + if Comp < 0 then + Current := Current.Left + else + Current := Current.Right; + end; + if Current = nil then + Break; + Result := True; + // Remove Current from tree + if (Current.Left = nil) and (Current.Right <> nil) then + begin + // remove references to Current + Current.Right.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Right + else + Current.Parent.Right := Current.Right; + end + else + // fix root + FRoot := Current.Right; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right = nil) then + begin + // remove references to Current + Current.Left.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Left + else + Current.Parent.Right := Current.Left; + end + else + // fix root + FRoot := Current.Left; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right <> nil) then + begin + // find the successor in tree + Successor := Current.Right; + while Successor.Left <> nil do + Successor := Successor.Left; + + if Successor <> Current.Right then + begin + // remove references to successor + Successor.Parent.Left := Successor.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor.Parent; + Successor.Right := Current.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor; + end; + + // insert successor in new position + Successor.Left := Current.Left; + if Current.Left <> nil then + Current.Left.Parent := Successor; + Successor.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Successor + else + Current.Parent.Right := Successor; + end + else + // fix root + FRoot := Successor; + Successor := Current.Parent; + if Successor <> nil then + Successor := FRoot; + end + else + begin + // (Current.Left = nil) and (Current.Right = nil) + Successor := Current.Parent; + if Successor <> nil then + begin + // remove references from parent + if Successor.Left = Current then + Successor.Left := nil + else + Successor.Right := nil; + end + else + FRoot := nil; + end; + Current.Value := nil; + Current.Free; + Dec(FSize); + Current := Successor; + until FRemoveSingleElement or (Current = nil); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTree.ExtractAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTree.First: IJclIterator; +var + Start: TJclBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderBinaryTreeIterator.Create(Self, Start, False, isFirst); + toOrder: + begin + if Start <> nil then + while Start.Left <> nil do + Start := Start.Left; + Result := TJclInOrderBinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + toPostOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Left <> nil then + Start := Start.Left + else + Start := Start.Right; + end; + Result := TJclPostOrderBinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclBinaryTree.GetEnumerator: IJclIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclBinaryTree.GetRoot: IJclTreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toOrder: + Result := TJclInOrderBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TJclPostOrderBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclBinaryTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclBinaryTree.Last: IJclIterator; +var + Start: TJclBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Right <> nil then + Start := Start.Right + else + Start := Start.Left; + end; + Result := TJclPreOrderBinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toOrder: + begin + if Start <> nil then + while Start.Right <> nil do + Start := Start.Right; + Result := TJclInOrderBinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TJclPostOrderBinaryTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclBinaryTree.Pack; +var + LeafArray: array of TJclBinaryNode; + ANode, BNode: TJclBinaryNode; + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetLength(Leafarray, FSize); + try + // in order enumeration of nodes + ANode := FRoot; + if ANode <> nil then + begin + // find first node + while ANode.Left <> nil do + ANode := ANode.Left; + + Index := 0; + while ANode <> nil do + begin + LeafArray[Index] := ANode; + Inc(Index); + if ANode.Right <> nil then + begin + ANode := ANode.Right; + while (ANode.Left <> nil) do + ANode := ANode.Left; + end + else + begin + BNode := ANode; + ANode := ANode.Parent; + while (ANode <> nil) and (ANode.Right = BNode) do + begin + BNode := ANode; + ANode := ANode.Parent; + end; + end; + end; + + Index := FSize shr 1; + FRoot := LeafArray[Index]; + FRoot.Parent := nil; + if Index > 0 then + FRoot.Left := BuildTree(LeafArray, 0, Index - 1, FRoot, 0) + else + FRoot.Left := nil; + if Index < (FSize - 1) then + FRoot.Right := BuildTree(LeafArray, Index + 1, FSize - 1, FRoot, 1) + else + FRoot.Right := nil; + end; + finally + SetLength(LeafArray, 0); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTree.Remove(AObject: TObject): Boolean; +var + Extracted: TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AObject); + if Result then + begin + Extracted := AObject; + FreeObject(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTree.RemoveAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTree.RetainAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclBinaryTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclBinaryTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclBinaryTree.Size: Integer; +begin + Result := FSize; +end; + +function TJclBinaryTree.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclBinaryTree.Create(Compare, False); + AssignPropertiesTo(Result); +end; + +//=== { TJclBinaryTreeIterator } =========================================================== + +constructor TJclBinaryTreeIterator.Create(const AOwnTree: TJclBinaryTree; ACursor: TJclBinaryNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FStart := AStart; + FOwnTree := AOwnTree; + FEqualityComparer := AOwnTree as IJclEqualityComparer; +end; + +function TJclBinaryTreeIterator.Add(AObject: TObject): Boolean; +begin + Result := FOwnTree.Add(AObject); +end; + +function TJclBinaryTreeIterator.AddChild(AObject: TObject): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclBinaryTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclBinaryTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclBinaryTreeIterator then + begin + ADest := TJclBinaryTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclBinaryTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + Inc(Result); + if FCursor.Right <> nil then + Inc(Result); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclBinaryTreeIterator.DeleteChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclBinaryTreeIterator.DeleteChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclBinaryTreeIterator.Extract; +var + OldCursor: TJclBinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Extract(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclBinaryTreeIterator.ExtractChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclBinaryTreeIterator.ExtractChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclBinaryTreeIterator.GetChild(Index: Integer): TObject; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := nil; + if (FCursor <> nil) and (Index = 0) and (FCursor.Left <> nil) then + FCursor := FCursor.Left + else + if (FCursor <> nil) and (Index = 0) then + FCursor := FCursor.Right + else + if (FCursor <> nil) and (Index = 1) then + FCursor := FCursor.Right + else + FCursor := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.GetObject: TObject; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index = 0) then + Result := (FCursor.Left <> nil) or (FCursor.Right <> nil) + else + if (FCursor <> nil) and (Index = 1) then + Result := (FCursor.Left <> nil) and (FCursor.Right <> nil) + else + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.HasLeft: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Left <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.HasRight: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Right <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.IndexOfChild(AObject: TObject): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := -1; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + begin + if FEqualityComparer.ItemsEqual(FCursor.Left.Value, AObject) then + Result := 0 + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, AObject) then + Result := 1; + end + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, AObject) then + Result := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.Insert(AObject: TObject): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclBinaryTreeIterator.InsertChild(Index: Integer; AObject: TObject): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclBinaryTreeIterator.IteratorEquals(const AIterator: IJclIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclBinaryTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclBinaryTreeIterator then + begin + ItrObj := TJclBinaryTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +function TJclBinaryTreeIterator.Left: TObject; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := nil; + if FCursor <> nil then + FCursor := FCursor.Left; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclBinaryTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclBinaryTreeIterator.Next: TObject; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclBinaryTreeIterator.Parent: TObject; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := nil; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.Previous: TObject; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclBinaryTreeIterator.Remove; +var + OldCursor: TJclBinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Remove(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclBinaryTreeIterator.Reset; +var + NewCursor: TJclBinaryNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.Right: TObject; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := nil; + if FCursor <> nil then + FCursor := FCursor.Right; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclBinaryTreeIterator.SetChild(Index: Integer; AObject: TObject); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclBinaryTreeIterator.SetObject(AObject: TObject); +begin + raise EJclOperationNotSupportedError.Create; +end; + +//=== { TJclPreOrderBinaryTreeIterator } =================================================== + +function TJclPreOrderBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderBinaryTreeIterator.GetNextCursor: TJclBinaryNode; +var + LastRet: TJclBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.Left <> nil then + Result := Result.Left + else + if Result.Right <> nil then + Result := Result.Right + else + begin + Result := Result.Parent; + while (Result <> nil) and ((Result.Right = nil) or (Result.Right = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Right; + end; +end; + +function TJclPreOrderBinaryTreeIterator.GetPreviousCursor: TJclBinaryNode; +var + LastRet: TJclBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Left <> LastRet) and (Result.Left <> nil) then + // come from Right + begin + Result := Result.Left; + while (Result.Left <> nil) or (Result.Right <> nil) do // both childs + begin + if Result.Right <> nil then // right child first + Result := Result.Right + else + Result := Result.Left; + end; + end; +end; + +//=== { TJclInOrderBinaryTreeIterator } ==================================================== + +function TJclInOrderBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclInOrderBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclInOrderBinaryTreeIterator.GetNextCursor: TJclBinaryNode; +var + LastRet: TJclBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + begin + Result := Result.Right; + while (Result.Left <> nil) do + Result := Result.Left; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right = LastRet) do + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +function TJclInOrderBinaryTreeIterator.GetPreviousCursor: TJclBinaryNode; +var + LastRet: TJclBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Left <> nil then + begin + Result := Result.Left; + while Result.Right <> nil do + Result := Result.Right; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right <> LastRet) do // Come from Left + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +//=== { TJclPostOrderBinaryTreeIterator } ================================================== + +function TJclPostOrderBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderBinaryTreeIterator.GetNextCursor: TJclBinaryNode; +var + LastRet: TJclBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Right <> nil) and (Result.Right <> LastRet) then + begin + Result := Result.Right; + while (Result.Left <> nil) or (Result.Right <> nil) do + begin + if Result.Left <> nil then + Result := Result.Left + else + Result := Result.Right; + end; + end; +end; + +function TJclPostOrderBinaryTreeIterator.GetPreviousCursor: TJclBinaryNode; +var + LastRet: TJclBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + Result := Result.Right + else + if Result.Left <> nil then + Result := Result.Left + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and ((Result.Left = nil) or (Result.Left = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Left; + end; +end; + + + +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +//=== { TJclBinaryTree } ================================================= + +constructor TJclBinaryTree.Create(AOwnsItems: Boolean); +begin + inherited Create(AOwnsItems); + FTraverseOrder := toOrder; + FMaxDepth := 0; + FAutoPackParameter := 2; +end; + +destructor TJclBinaryTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclBinaryTree.Add(const AItem: T): Boolean; +var + NewNode, Current, Save: TJclBinaryNode; + Comp, Depth: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // Insert into right place + if FAllowDefaultElements or not ItemsEqual(AItem, Default(T)) then + begin + Save := nil; + Current := FRoot; + Comp := 1; + Depth := 0; + while Current <> nil do + begin + Inc(Depth); + Save := Current; + Comp := ItemsCompare(AItem, Current.Value); + if Comp < 0 then + Current := Current.Left + else + if Comp > 0 then + Current := Current.Right + else + if CheckDuplicate then + Current := Current.Left // arbitrary decision + else + Break; + end; + if (Comp <> 0) or CheckDuplicate then + begin + NewNode := TJclBinaryNode.Create; + NewNode.Value := AItem; + NewNode.Parent := Save; + if Save = nil then + FRoot := NewNode + else + if ItemsCompare(NewNode.Value, Save.Value) <= 0 then + Save.Left := NewNode + else + Save.Right := NewNode; + Inc(FSize); + Inc(Depth); + if Depth > FMaxDepth then + FMaxDepth := Depth; + Result := True; + AutoPack; + end + else + Result := False; + end + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTree.AddAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclBinaryTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclBinaryTree; + ACollection: IJclCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclBinaryTree then + begin + ADest := TJclBinaryTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclBinaryTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclBinaryTree then + TJclBinaryTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclBinaryTree.AutoPack; +begin + case FAutoPackStrategy of + //apsDisabled: ; + apsAgressive: + if (FMaxDepth > 1) and (((1 shl (FMaxDepth - 1)) - 1) > FSize) then + Pack; + // apsIncremental: ; + apsProportional: + if (FMaxDepth > FAutoPackParameter) and (((1 shl (FMaxDepth - FAutoPackParameter)) - 1) > FSize) then + Pack; + end; +end; + +function TJclBinaryTree.BuildTree(const LeafArray: array of TJclBinaryNode; Left, Right: Integer; Parent: TJclBinaryNode; + Offset: Integer): TJclBinaryNode; +var + Middle: Integer; +begin + Middle := (Left + Right + Offset) shr 1; + Result := LeafArray[Middle]; + Result.Parent := Parent; + if Middle > Left then + Result.Left := BuildTree(LeafArray, Left, Middle - 1, Result, 0) + else + Result.Left := nil; + if Middle < Right then + Result.Right := BuildTree(LeafArray, Middle + 1, Right, Result, 1) + else + Result.Right := nil; +end; + +procedure TJclBinaryTree.Clear; +var + Current, Parent: TJclBinaryNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + // postorder + Current := FRoot; + if Current = nil then + Exit; + // find first in post-order + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + // for all items in the tree in post-order + repeat + Parent := Current.Parent; + // remove reference + if Parent <> nil then + begin + if Parent.Left = Current then + Parent.Left := nil + else + if Parent.Right = Current then + Parent.Right := nil; + end; + + // free item + FreeItem(Current.Value); + Current.Free; + + // find next item + Current := Parent; + if (Current <> nil) and (Current.Right <> nil) then + begin + Current := Current.Right; + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + end; + until Current = nil; + FRoot := nil; + FSize := 0; + FMaxDepth := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTree.CloneNode(Node, Parent: TJclBinaryNode): TJclBinaryNode; +begin + Result := TJclBinaryNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + if Node.Left <> nil then + Result.Left := CloneNode(Node.Left, Result); // recursive call + if Node.Right <> nil then + Result.Right := CloneNode(Node.Right, Result); // recursive call +end; + +function TJclBinaryTree.CollectionEquals(const ACollection: IJclCollection): Boolean; +var + It, ItSelf: IJclIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTree.Contains(const AItem: T): Boolean; +var + Comp: Integer; + Current: TJclBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FRoot; + while Current <> nil do + begin + Comp := ItemsCompare(Current.Value, AItem); + if Comp = 0 then + begin + Result := True; + Break; + end + else + if Comp > 0 then + Current := Current.Left + else + Current := Current.Right; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTree.ContainsAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTree.Extract(const AItem: T): Boolean; +var + Current, Successor: TJclBinaryNode; + Comp: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + // locate AItem in the tree + Current := FRoot; + repeat + while Current <> nil do + begin + Comp := ItemsCompare(AItem, Current.Value); + if Comp = 0 then + Break + else + if Comp < 0 then + Current := Current.Left + else + Current := Current.Right; + end; + if Current = nil then + Break; + Result := True; + // Remove Current from tree + if (Current.Left = nil) and (Current.Right <> nil) then + begin + // remove references to Current + Current.Right.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Right + else + Current.Parent.Right := Current.Right; + end + else + // fix root + FRoot := Current.Right; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right = nil) then + begin + // remove references to Current + Current.Left.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Left + else + Current.Parent.Right := Current.Left; + end + else + // fix root + FRoot := Current.Left; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right <> nil) then + begin + // find the successor in tree + Successor := Current.Right; + while Successor.Left <> nil do + Successor := Successor.Left; + + if Successor <> Current.Right then + begin + // remove references to successor + Successor.Parent.Left := Successor.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor.Parent; + Successor.Right := Current.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor; + end; + + // insert successor in new position + Successor.Left := Current.Left; + if Current.Left <> nil then + Current.Left.Parent := Successor; + Successor.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Successor + else + Current.Parent.Right := Successor; + end + else + // fix root + FRoot := Successor; + Successor := Current.Parent; + if Successor <> nil then + Successor := FRoot; + end + else + begin + // (Current.Left = nil) and (Current.Right = nil) + Successor := Current.Parent; + if Successor <> nil then + begin + // remove references from parent + if Successor.Left = Current then + Successor.Left := nil + else + Successor.Right := nil; + end + else + FRoot := nil; + end; + Current.Value := Default(T); + Current.Free; + Dec(FSize); + Current := Successor; + until FRemoveSingleElement or (Current = nil); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTree.ExtractAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTree.First: IJclIterator; +var + Start: TJclBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TPreOrderBinaryTreeIterator.Create(Self, Start, False, isFirst); + toOrder: + begin + if Start <> nil then + while Start.Left <> nil do + Start := Start.Left; + Result := TInOrderBinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + toPostOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Left <> nil then + Start := Start.Left + else + Start := Start.Right; + end; + Result := TPostOrderBinaryTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclBinaryTree.GetEnumerator: IJclIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclBinaryTree.GetRoot: IJclTreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TPreOrderBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toOrder: + Result := TInOrderBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TPostOrderBinaryTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclBinaryTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclBinaryTree.Last: IJclIterator; +var + Start: TJclBinaryNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Right <> nil then + Start := Start.Right + else + Start := Start.Left; + end; + Result := TPreOrderBinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toOrder: + begin + if Start <> nil then + while Start.Right <> nil do + Start := Start.Right; + Result := TInOrderBinaryTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TPostOrderBinaryTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclBinaryTree.Pack; +var + LeafArray: array of TJclBinaryNode; + ANode, BNode: TJclBinaryNode; + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetLength(Leafarray, FSize); + try + // in order enumeration of nodes + ANode := FRoot; + if ANode <> nil then + begin + // find first node + while ANode.Left <> nil do + ANode := ANode.Left; + + Index := 0; + while ANode <> nil do + begin + LeafArray[Index] := ANode; + Inc(Index); + if ANode.Right <> nil then + begin + ANode := ANode.Right; + while (ANode.Left <> nil) do + ANode := ANode.Left; + end + else + begin + BNode := ANode; + ANode := ANode.Parent; + while (ANode <> nil) and (ANode.Right = BNode) do + begin + BNode := ANode; + ANode := ANode.Parent; + end; + end; + end; + + Index := FSize shr 1; + FRoot := LeafArray[Index]; + FRoot.Parent := nil; + if Index > 0 then + FRoot.Left := BuildTree(LeafArray, 0, Index - 1, FRoot, 0) + else + FRoot.Left := nil; + if Index < (FSize - 1) then + FRoot.Right := BuildTree(LeafArray, Index + 1, FSize - 1, FRoot, 1) + else + FRoot.Right := nil; + end; + finally + SetLength(LeafArray, 0); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTree.Remove(const AItem: T): Boolean; +var + Extracted: T; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AItem); + if Result then + begin + Extracted := AItem; + FreeItem(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTree.RemoveAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTree.RetainAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclBinaryTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclBinaryTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclBinaryTree.Size: Integer; +begin + Result := FSize; +end; + +//=== { TJclBinaryTreeIterator } =========================================================== + +constructor TJclBinaryTreeIterator.Create(const AOwnTree: TJclBinaryTree; ACursor: TJclBinaryNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FStart := AStart; + FOwnTree := AOwnTree; + FEqualityComparer := AOwnTree as IJclEqualityComparer; +end; + +function TJclBinaryTreeIterator.Add(const AItem: T): Boolean; +begin + Result := FOwnTree.Add(AItem); +end; + +function TJclBinaryTreeIterator.AddChild(const AItem: T): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclBinaryTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclBinaryTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclBinaryTreeIterator then + begin + ADest := TJclBinaryTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclBinaryTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + Inc(Result); + if FCursor.Right <> nil then + Inc(Result); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclBinaryTreeIterator.DeleteChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclBinaryTreeIterator.DeleteChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclBinaryTreeIterator.Extract; +var + OldCursor: TJclBinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Extract(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclBinaryTreeIterator.ExtractChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclBinaryTreeIterator.ExtractChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclBinaryTreeIterator.GetChild(Index: Integer): T; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := Default(T); + if (FCursor <> nil) and (Index = 0) and (FCursor.Left <> nil) then + FCursor := FCursor.Left + else + if (FCursor <> nil) and (Index = 0) then + FCursor := FCursor.Right + else + if (FCursor <> nil) and (Index = 1) then + FCursor := FCursor.Right + else + FCursor := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.GetItem: T; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := Default(T); + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index = 0) then + Result := (FCursor.Left <> nil) or (FCursor.Right <> nil) + else + if (FCursor <> nil) and (Index = 1) then + Result := (FCursor.Left <> nil) and (FCursor.Right <> nil) + else + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.HasLeft: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Left <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.HasRight: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Right <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.IndexOfChild(const AItem: T): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := -1; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + begin + if FEqualityComparer.ItemsEqual(FCursor.Left.Value, AItem) then + Result := 0 + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, AItem) then + Result := 1; + end + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, AItem) then + Result := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.Insert(const AItem: T): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclBinaryTreeIterator.InsertChild(Index: Integer; const AItem: T): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclBinaryTreeIterator.IteratorEquals(const AIterator: IJclIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclBinaryTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclBinaryTreeIterator then + begin + ItrObj := TJclBinaryTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +function TJclBinaryTreeIterator.Left: T; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := Default(T); + if FCursor <> nil then + FCursor := FCursor.Left; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclBinaryTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclBinaryTreeIterator.Next: T; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := Default(T); + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclBinaryTreeIterator.Parent: T; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := Default(T); + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.Previous: T; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := Default(T); + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclBinaryTreeIterator.Remove; +var + OldCursor: TJclBinaryNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Remove(OldCursor.Value); + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclBinaryTreeIterator.Reset; +var + NewCursor: TJclBinaryNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclBinaryTreeIterator.Right: T; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := Default(T); + if FCursor <> nil then + FCursor := FCursor.Right; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclBinaryTreeIterator.SetChild(Index: Integer; const AItem: T); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclBinaryTreeIterator.SetItem(const AItem: T); +begin + raise EJclOperationNotSupportedError.Create; +end; + +//=== { TJclPreOrderBinaryTreeIterator } =================================================== + +function TJclPreOrderBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderBinaryTreeIterator.GetNextCursor: TJclBinaryNode; +var + LastRet: TJclBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.Left <> nil then + Result := Result.Left + else + if Result.Right <> nil then + Result := Result.Right + else + begin + Result := Result.Parent; + while (Result <> nil) and ((Result.Right = nil) or (Result.Right = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Right; + end; +end; + +function TJclPreOrderBinaryTreeIterator.GetPreviousCursor: TJclBinaryNode; +var + LastRet: TJclBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Left <> LastRet) and (Result.Left <> nil) then + // come from Right + begin + Result := Result.Left; + while (Result.Left <> nil) or (Result.Right <> nil) do // both childs + begin + if Result.Right <> nil then // right child first + Result := Result.Right + else + Result := Result.Left; + end; + end; +end; + +//=== { TJclInOrderBinaryTreeIterator } ==================================================== + +function TJclInOrderBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclInOrderBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclInOrderBinaryTreeIterator.GetNextCursor: TJclBinaryNode; +var + LastRet: TJclBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + begin + Result := Result.Right; + while (Result.Left <> nil) do + Result := Result.Left; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right = LastRet) do + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +function TJclInOrderBinaryTreeIterator.GetPreviousCursor: TJclBinaryNode; +var + LastRet: TJclBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Left <> nil then + begin + Result := Result.Left; + while Result.Right <> nil do + Result := Result.Right; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right <> LastRet) do // Come from Left + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +//=== { TJclPostOrderBinaryTreeIterator } ================================================== + +function TJclPostOrderBinaryTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderBinaryTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderBinaryTreeIterator.GetNextCursor: TJclBinaryNode; +var + LastRet: TJclBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Right <> nil) and (Result.Right <> LastRet) then + begin + Result := Result.Right; + while (Result.Left <> nil) or (Result.Right <> nil) do + begin + if Result.Left <> nil then + Result := Result.Left + else + Result := Result.Right; + end; + end; +end; + +function TJclPostOrderBinaryTreeIterator.GetPreviousCursor: TJclBinaryNode; +var + LastRet: TJclBinaryNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + Result := Result.Right + else + if Result.Left <> nil then + Result := Result.Left + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and ((Result.Left = nil) or (Result.Left = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Left; + end; +end; + +//=== { TJclBinaryTreeE } ================================================= + +constructor TJclBinaryTreeE.Create(const AComparer: IJclComparer; AOwnsItems: Boolean); +begin + inherited Create(AOwnsItems); + FComparer := AComparer; +end; + +procedure TJclBinaryTreeE.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclBinaryTreeE then + TJclBinaryTreeE(Dest).FComparer := FComparer; +end; + +function TJclBinaryTreeE.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclBinaryTreeE.Create(Comparer, False); + AssignPropertiesTo(Result); +end; + +function TJclBinaryTreeE.ItemsCompare(const A, B: T): Integer; +begin + if Comparer <> nil then + Result := Comparer.Compare(A, B) + else + Result := inherited ItemsCompare(A, B); +end; + +function TJclBinaryTreeE.ItemsEqual(const A, B: T): Boolean; +begin + if Comparer <> nil then + Result := Comparer.Compare(A, B) = 0 + else + Result := inherited ItemsEqual(A, B); +end; + +//=== { TJclBinaryTreeF } ================================================= + +constructor TJclBinaryTreeF.Create(ACompare: TCompare; AOwnsItems: Boolean); +begin + inherited Create(AOwnsItems); + SetCompare(ACompare); +end; + +function TJclBinaryTreeF.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclBinaryTreeF.Create(Compare, False); + AssignPropertiesTo(Result); +end; + +//=== { TJclBinaryTreeI } ================================================= + +function TJclBinaryTreeI.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclBinaryTreeI.Create(False); + AssignPropertiesTo(Result); +end; + +function TJclBinaryTreeI.ItemsCompare(const A, B: T): Integer; +begin + if Assigned(FCompare) then + Result := FCompare(A, B) + else + Result := A.CompareTo(B); +end; + +function TJclBinaryTreeI.ItemsEqual(const A, B: T): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + Result := A.CompareTo(B) = 0; +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclCharsets.pas b/3rdParty/JCL/source/common/JclCharsets.pas index 34a85d5c..3ad87f45 100644 --- a/3rdParty/JCL/source/common/JclCharsets.pas +++ b/3rdParty/JCL/source/common/JclCharsets.pas @@ -1,572 +1,572 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is JclCharsets.pas. } -{ } -{ The Initial Developer of the Original Code is Florent Ouchet. } -{ Portions created by Florent Ouchet are Copyright Florent Ouchet. All rights reserved. } -{ } -{ Contributors: } -{ } -{**************************************************************************************************} -{ } -{ Windows codepage bindings are taken from IE5 ones: } -{ http://msdn.microsoft.com/en-us/library/aa752010(VS.85).aspx } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -unit JclCharsets; - -{$I jcl.inc} - -interface - -uses - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - JclBase; - -type - EJclCharsetError = class(EJclError); - -const - CP_UTF16LE = 1200; - -type - TJclCharsetInfo = record - Name: string; - CodePage: Word; - FamilyCodePage: Word; - end; - -const JclCharsetInfos: array [0..285] of TJclCharsetInfo = -(* Arabic (ASMO 708) ASMO-708 708 1256 *) - ((Name: 'ASMO-708'; CodePage: 708; FamilyCodePage: 1256), -(* Arabic (DOS) DOS-720 720 1256 *) - (Name: 'DOS-720'; CodePage: 720; FamilyCodePage: 1256), -(* Arabic (ISO) iso-8859-6 arabic, csISOLatinArabic, ECMA-114, ISO_8859-6, ISO_8859-6:1987, iso-ir-127 28596 1256 *) - (Name: 'iso-8859-6'; CodePage: 28596; FamilyCodePage: 1256), - (Name: 'arabic'; CodePage: 28596; FamilyCodePage: 1256), - (Name: 'csISOLatinArabic'; CodePage: 28596; FamilyCodePage: 1256), - (Name: 'ECMA-114'; CodePage: 28596; FamilyCodePage: 1256), - (Name: 'ISO_8859-6'; CodePage: 28596; FamilyCodePage: 1256), - (Name: 'ISO_8859-6:1987'; CodePage: 28596; FamilyCodePage: 1256), - (Name: 'iso-ir-127'; CodePage: 28596; FamilyCodePage: 1256), -(* Arabic (Mac) x-mac-arabic 10004 1256 *) - (Name: 'x-mac-arabic'; CodePage: 10004; FamilyCodePage: 1256), -(* Arabic (Windows) windows-1256 cp1256 1256 1256 *) - (Name: 'windows-1256'; CodePage: 1256; FamilyCodePage: 1256), - (Name: 'cp1256'; CodePage: 1256; FamilyCodePage: 1256), -(* Baltic (DOS) ibm775 CP500 775 1257 *) - (Name: 'ibm775'; CodePage: 775; FamilyCodePage: 1257), - (Name: 'CP500'; CodePage: 775; FamilyCodePage: 1257), -(* Baltic (ISO) iso-8859-4 csISOLatin4, ISO_8859-4, ISO_8859-4:1988, iso-ir-110, l4, latin4 28594 1257 *) - (Name: 'iso-8859-4'; CodePage: 28594; FamilyCodePage: 1257), - (Name: 'csISOLatin4'; CodePage: 28594; FamilyCodePage: 1257), - (Name: 'ISO_8859-4'; CodePage: 28594; FamilyCodePage: 1257), - (Name: 'ISO_8859-4:1988'; CodePage: 28594; FamilyCodePage: 1257), - (Name: 'iso-ir-110'; CodePage: 28594; FamilyCodePage: 1257), - (Name: 'l4'; CodePage: 28594; FamilyCodePage: 1257), - (Name: 'latin4'; CodePage: 28594; FamilyCodePage: 1257), -(* Baltic (Windows) windows-1257 1257 1257 *) - (Name: 'windows-1257'; CodePage: 1257; FamilyCodePage: 1257), -(* Central European (DOS) ibm852 cp852 852 1250 *) - (Name: 'ibm852'; CodePage: 852; FamilyCodePage: 1250), - (Name: 'cp852'; CodePage: 852; FamilyCodePage: 1250), -(* Central European (ISO) iso-8859-2 csISOLatin2, iso_8859-2, iso_8859-2:1987, iso8859-2, iso-ir-101, l2, latin2 28592 1250 *) - (Name: 'iso-8859-2'; CodePage: 28592; FamilyCodePage: 1250), - (Name: 'csISOLatin2'; CodePage: 28592; FamilyCodePage: 1250), - (Name: 'iso_8859-2'; CodePage: 28592; FamilyCodePage: 1250), - (Name: 'iso_8859-2:1987'; CodePage: 28592; FamilyCodePage: 1250), - (Name: 'iso8859-2'; CodePage: 28592; FamilyCodePage: 1250), - (Name: 'iso-ir-101'; CodePage: 28592; FamilyCodePage: 1250), - (Name: 'l2'; CodePage: 28592; FamilyCodePage: 1250), - (Name: 'latin2'; CodePage: 28592; FamilyCodePage: 1250), -(* Central European (Mac) x-mac-ce 10029 1250 *) - (Name: 'x-mac-ce'; CodePage: 10029; FamilyCodePage: 1250), -(* Central European (Windows) windows-1250 x-cp1250 1250 1250 *) - (Name: 'windows-1250'; CodePage: 1250; FamilyCodePage: 1250), - (Name: 'x-cp1250'; CodePage: 1250; FamilyCodePage: 1250), -(* Chinese Simplified (EUC) EUC-CN x-euc-cn 51936 936 *) - (Name: 'EUC-CN'; CodePage: 51936; FamilyCodePage: 936), - (Name: 'x-euc-cn'; CodePage: 51936; FamilyCodePage: 936), -(* Chinese Simplified (GB2312) gb2312 chinese, CN-GB, csGB2312, csGB231280, csISO58GB231280, GB_2312-80, GB231280, GB2312-80, GBK, iso-ir-58 936 936 *) - (Name: 'gb2312'; CodePage: 936; FamilyCodePage: 936), - (Name: 'chinese'; CodePage: 936; FamilyCodePage: 936), - (Name: 'CN-GB'; CodePage: 936; FamilyCodePage: 936), - (Name: 'csGB2312'; CodePage: 936; FamilyCodePage: 936), - (Name: 'csGB231280'; CodePage: 936; FamilyCodePage: 936), - (Name: 'csISO58GB231280'; CodePage: 936; FamilyCodePage: 936), - (Name: 'GB_2312-80'; CodePage: 936; FamilyCodePage: 936), - (Name: 'GB231280'; CodePage: 936; FamilyCodePage: 936), - (Name: 'GB2312-80'; CodePage: 936; FamilyCodePage: 936), - (Name: 'GBK'; CodePage: 936; FamilyCodePage: 936), - (Name: 'iso-ir-58'; CodePage: 936; FamilyCodePage: 936), -(* Chinese Simplified (HZ) hz-gb-2312 52936 936 *) - (Name: 'hz-gb-2312'; CodePage: 52936; FamilyCodePage: 936), -(* Chinese Simplified (Mac) x-mac-chinesesimp 10008 936 *) - (Name: 'x-mac-chinesesimp'; CodePage: 10008; FamilyCodePage: 936), -(* Chinese Traditional (Big5) big5 cn-big5, csbig5, x-x-big5 950 950 *) - (Name: 'big5'; CodePage: 950; FamilyCodePage: 950), - (Name: 'cn-big5'; CodePage: 950; FamilyCodePage: 950), - (Name: 'csbig5'; CodePage: 950; FamilyCodePage: 950), - (Name: 'x-x-big5'; CodePage: 950; FamilyCodePage: 950), - (Name: 'MS950'; CodePage: 950; FamilyCodePage: 950), -(* Chinese Traditional (CNS) x-Chinese-CNS 20000 950 *) - (Name: 'x-Chinese-CNS'; CodePage: 20000; FamilyCodePage: 950), -(* Chinese Traditional (Eten) x-Chinese-Eten 20002 950 *) - (Name: 'x-Chinese-Eten'; CodePage: 20002; FamilyCodePage: 950), -(* Chinese Traditional (Mac) x-mac-chinesetrad 10002 950 *) - (Name: 'x-mac-chinesetrad'; CodePage: 10002; FamilyCodePage: 950), -(* Cyrillic (DOS) cp866 ibm866 866 1251 *) - (Name: 'cp866'; CodePage: 866; FamilyCodePage: 1251), - (Name: 'ibm866'; CodePage: 866; FamilyCodePage: 1251), -(* Cyrillic (ISO) iso-8859-5 csISOLatin5, csISOLatinCyrillic, cyrillic, ISO_8859-5, ISO_8859-5:1988, iso-ir-144, l5 28595 1251 *) - (Name: 'iso-8859-5'; CodePage: 28595; FamilyCodePage: 1251), - (Name: 'csISOLatinCyrillic'; CodePage: 28595; FamilyCodePage: 1251), - (Name: 'cyrillic'; CodePage: 28595; FamilyCodePage: 1251), - (Name: 'ISO_8859-5'; CodePage: 28595; FamilyCodePage: 1251), - (Name: 'ISO_8859-5:1988'; CodePage: 28595; FamilyCodePage: 1251), - (Name: 'iso-ir-144'; CodePage: 28595; FamilyCodePage: 1251), -(* Cyrillic (KOI8-R) koi8-r csKOI8R, koi, koi8, koi8r 20866 1251 *) - (Name: 'koi8-r'; CodePage: 20866; FamilyCodePage: 1251), - (Name: 'csKOI8R'; CodePage: 20866; FamilyCodePage: 1251), - (Name: 'koi'; CodePage: 20866; FamilyCodePage: 1251), - (Name: 'koi8'; CodePage: 20866; FamilyCodePage: 1251), - (Name: 'koi8r'; CodePage: 20866; FamilyCodePage: 1251), -(* Cyrillic (KOI8-U) koi8-u koi8-ru 21866 1251 *) - (Name: 'koi8-u'; CodePage: 21866; FamilyCodePage: 1251), - (Name: 'koi8-ru'; CodePage: 21866; FamilyCodePage: 1251), -(* Cyrillic (Mac) x-mac-cyrillic 10007 1251 *) - (Name: 'x-mac-cyrillic'; CodePage: 10007; FamilyCodePage: 1251), -(* Cyrillic (Windows) windows-1251 x-cp1251 1251 1251 *) - (Name: 'windows-1251'; CodePage: 1251; FamilyCodePage: 1251), - (Name: 'x-cp1251'; CodePage: 1251; FamilyCodePage: 1251), -(* Europa x-Europa 29001 1252 *) - (Name: 'x-Europa'; CodePage: 29001; FamilyCodePage: 1252), -(* German (IA5) x-IA5-German 20106 1252 *) - (Name: 'x-IA5-German'; CodePage: 20106; FamilyCodePage: 1252), -(* Greek (DOS) ibm737 737 1253 *) - (Name: 'ibm737'; CodePage: 737; FamilyCodePage: 1253), -(* Greek (ISO) iso-8859-7 csISOLatinGreek, ECMA-118, ELOT_928, greek, greek8, ISO_8859-7, ISO_8859-7:1987, iso-ir-126 28597 1253 *) - (Name: 'iso-8859-7'; CodePage: 28597; FamilyCodePage: 1253), - (Name: 'csISOLatinGreek'; CodePage: 28597; FamilyCodePage: 1253), - (Name: 'ECMA-118'; CodePage: 28597; FamilyCodePage: 1253), - (Name: 'ELOT_928'; CodePage: 28597; FamilyCodePage: 1253), - (Name: 'greek'; CodePage: 28597; FamilyCodePage: 1253), - (Name: 'greek8'; CodePage: 28597; FamilyCodePage: 1253), - (Name: 'ISO_8859-7'; CodePage: 28597; FamilyCodePage: 1253), - (Name: 'ISO_8859-7:1987'; CodePage: 28597; FamilyCodePage: 1253), - (Name: 'iso-ir-126'; CodePage: 28597; FamilyCodePage: 1253), -(* Greek (Mac) x-mac-greek 10006 1253 *) - (Name: 'x-mac-greek'; CodePage: 10006; FamilyCodePage: 1253), -(* Greek (Windows) windows-1253 1253 1253 *) - (Name: 'windows-1253'; CodePage: 1253; FamilyCodePage: 1253), -(* Greek, Modern (DOS) ibm869 869 1253 *) - (Name: 'ibm869'; CodePage: 869; FamilyCodePage: 1253), -(* Hebrew (DOS) DOS-862 862 1255 *) - (Name: 'DOS-862'; CodePage: 862; FamilyCodePage: 1255), -(* Hebrew (ISO-Logical) iso-8859-8-i logical 38598 1255 *) - (Name: 'iso-8859-8-i'; CodePage: 38598; FamilyCodePage: 1255), - (Name: 'logical'; CodePage: 38598; FamilyCodePage: 1255), -(* Hebrew (ISO-Visual) iso-8859-8 csISOLatinHebrew, hebrew, ISO_8859-8, ISO_8859-8:1988, ISO-8859-8, iso-ir-138, visual 28598 1255 *) - (Name: 'iso-8859-8'; CodePage: 28598; FamilyCodePage: 1255), - (Name: 'csISOLatinHebrew'; CodePage: 28598; FamilyCodePage: 1255), - (Name: 'hebrew'; CodePage: 28598; FamilyCodePage: 1255), - (Name: 'ISO_8859-8'; CodePage: 28598; FamilyCodePage: 1255), - (Name: 'ISO_8859-8:1988'; CodePage: 28598; FamilyCodePage: 1255), - (Name: 'ISO-8859-8'; CodePage: 28598; FamilyCodePage: 1255), - (Name: 'iso-ir-138'; CodePage: 28598; FamilyCodePage: 1255), - (Name: 'visual'; CodePage: 28598; FamilyCodePage: 1255), -(* Hebrew (Mac) x-mac-hebrew 10005 1255 *) - (Name: 'x-mac-hebrew'; CodePage: 10005; FamilyCodePage: 1255), -(* Hebrew (Windows) windows-1255 ISO_8859-8-I, ISO-8859-8, visual 1255 1255 *) - (Name: 'windows-1255'; CodePage: 1255; FamilyCodePage: 1255), - (Name: 'CP1255'; CodePage: 1255; FamilyCodePage: 1255), - (Name: 'ISO_8859-8-I'; CodePage: 1255; FamilyCodePage: 1255), - (Name: 'ISO-8859-8'; CodePage: 1255; FamilyCodePage: 1255), - (Name: 'visual'; CodePage: 1255; FamilyCodePage: 1255), -(* IBM EBCDIC (Arabic) x-EBCDIC-Arabic 20420 1256 *) - (Name: 'x-EBCDIC-Arabic'; CodePage: 20420; FamilyCodePage: 1256), -(* IBM EBCDIC (Cyrillic Russian) x-EBCDIC-CyrillicRussian 20880 1251 *) - (Name: 'x-EBCDIC-CyrillicRussian'; CodePage: 20880; FamilyCodePage: 1251), -(* IBM EBCDIC (Cyrillic Serbian-Bulgarian) x-EBCDIC-CyrillicSerbianBulgarian 21025 1251 *) - (Name: 'x-EBCDIC-CyrillicSerbianBulgarian'; CodePage: 21025; FamilyCodePage: 1251), -(* IBM EBCDIC (Denmark-Norway) x-EBCDIC-DenmarkNorway 20277 1252 *) - (Name: 'x-EBCDIC-DenmarkNorway'; CodePage: 20277; FamilyCodePage: 1252), -(* IBM EBCDIC (Denmark-Norway-Euro) x-ebcdic-denmarknorway-euro 1142 1252 *) - (Name: 'x-ebcdic-denmarknorway-euro'; CodePage: 1142; FamilyCodePage: 1252), -(* IBM EBCDIC (Finland-Sweden) x-EBCDIC-FinlandSweden 20278 1252 *) - (Name: 'x-EBCDIC-FinlandSweden'; CodePage: 20278; FamilyCodePage: 1252), -(* IBM EBCDIC (Finland-Sweden-Euro) x-ebcdic-finlandsweden-euro X-EBCDIC-France 1143 1252 *) - (Name: 'x-ebcdic-finlandsweden-euro'; CodePage: 1143; FamilyCodePage: 1252), - (Name: 'X-EBCDIC-France'; CodePage: 1143; FamilyCodePage: 1252), -(* IBM EBCDIC (France-Euro) x-ebcdic-france-euro 1147 1252 *) - (Name: 'x-ebcdic-france-euro'; CodePage: 1147; FamilyCodePage: 1252), -(* IBM EBCDIC (Germany) x-EBCDIC-Germany 20273 1252 *) - (Name: 'x-EBCDIC-Germany'; CodePage: 20273; FamilyCodePage: 1252), -(* IBM EBCDIC (Germany-Euro) x-ebcdic-germany-euro 1141 1252 *) - (Name: 'x-ebcdic-germany-euro'; CodePage: 1141; FamilyCodePage: 1252), -(* IBM EBCDIC (Greek Modern) x-EBCDIC-GreekModern 875 1253 *) - (Name: 'x-EBCDIC-GreekModern'; CodePage: 875; FamilyCodePage: 1253), -(* IBM EBCDIC (Greek) x-EBCDIC-Greek 20423 1253 *) - (Name: 'x-EBCDIC-Greek'; CodePage: 20423; FamilyCodePage: 1253), -(* IBM EBCDIC (Hebrew) x-EBCDIC-Hebrew 20424 1255 *) - (Name: 'x-EBCDIC-Hebrew'; CodePage: 20424; FamilyCodePage: 1255), -(* IBM EBCDIC (Icelandic) x-EBCDIC-Icelandic 20871 1252 *) - (Name: 'x-EBCDIC-Icelandic'; CodePage: 20871; FamilyCodePage: 1252), -(* IBM EBCDIC (Icelandic-Euro) x-ebcdic-icelandic-euro 1149 1252 *) - (Name: 'x-ebcdic-icelandic-euro'; CodePage: 1149; FamilyCodePage: 1252), -(* IBM EBCDIC (International-Euro) x-ebcdic-international-euro 1148 1252 *) - (Name: 'x-ebcdic-international-euro'; CodePage: 1148; FamilyCodePage: 1252), -(* IBM EBCDIC (Italy) x-EBCDIC-Italy 20280 1252 *) - (Name: 'x-EBCDIC-Italy'; CodePage: 20280; FamilyCodePage: 1252), -(* IBM EBCDIC (Italy-Euro) x-ebcdic-italy-euro 1144 1252 *) - (Name: 'x-ebcdic-italy-euro'; CodePage: 1144; FamilyCodePage: 1252), -(* IBM EBCDIC (Japanese and Japanese Katakana) x-EBCDIC-JapaneseAndKana 50930 932 *) - (Name: 'x-EBCDIC-JapaneseAndKana'; CodePage: 50930; FamilyCodePage: 932), -(* IBM EBCDIC (Japanese and Japanese-Latin) x-EBCDIC-JapaneseAndJapaneseLatin 50939 932 *) - (Name: 'x-EBCDIC-JapaneseAndJapaneseLatin'; CodePage: 50939; FamilyCodePage: 932), -(* IBM EBCDIC (Japanese and US-Canada) x-EBCDIC-JapaneseAndUSCanada 50931 932 *) - (Name: 'x-EBCDIC-JapaneseAndUSCanada'; CodePage: 50931; FamilyCodePage: 932), -(* IBM EBCDIC (Japanese katakana) x-EBCDIC-JapaneseKatakana 20290 932 *) - (Name: 'x-EBCDIC-JapaneseKatakana'; CodePage: 20290; FamilyCodePage: 932), -(* IBM EBCDIC (Korean and Korean Extended) x-EBCDIC-KoreanAndKoreanExtended 50933 949 *) - (Name: 'x-EBCDIC-KoreanAndKoreanExtended'; CodePage: 50933; FamilyCodePage: 949), -(* IBM EBCDIC (Korean Extended) x-EBCDIC-KoreanExtended 20833 949 *) - (Name: 'x-EBCDIC-KoreanExtended'; CodePage: 20833; FamilyCodePage: 949), -(* IBM EBCDIC (Multilingual Latin-2) CP870 870 1250 *) - (Name: 'CP870'; CodePage: 870; FamilyCodePage: 1250), -(* IBM EBCDIC (Simplified Chinese) x-EBCDIC-SimplifiedChinese 50935 936 *) - (Name: 'x-EBCDIC-SimplifiedChinese'; CodePage: 50935; FamilyCodePage: 936), -(* IBM EBCDIC (Spain) X-EBCDIC-Spain 20284 1252 *) - (Name: 'X-EBCDIC-Spain'; CodePage: 20284; FamilyCodePage: 1252), -(* IBM EBCDIC (Spain-Euro) x-ebcdic-spain-euro 1145 1252 *) - (Name: 'x-ebcdic-spain-euro'; CodePage: 1145; FamilyCodePage: 1252), -(* IBM EBCDIC (Thai) x-EBCDIC-Thai 20838 874 *) - (Name: 'x-EBCDIC-Thai'; CodePage: 20838; FamilyCodePage: 874), -(* IBM EBCDIC (Traditional Chinese) x-EBCDIC-TraditionalChinese 50937 950 *) - (Name: 'x-EBCDIC-TraditionalChinese'; CodePage: 50937; FamilyCodePage: 950), -(* IBM EBCDIC (Turkish Latin-5) CP1026 1026 1254 *) - (Name: 'CP1026'; CodePage: 1026; FamilyCodePage: 1254), -(* IBM EBCDIC (Turkish) x-EBCDIC-Turkish 20905 1254 *) - (Name: 'x-EBCDIC-Turkish'; CodePage: 20905; FamilyCodePage: 1254), -(* IBM EBCDIC (UK) x-EBCDIC-UK 20285 1252 *) - (Name: 'x-EBCDIC-UK'; CodePage: 20285; FamilyCodePage: 1252), -(* IBM EBCDIC (UK-Euro) x-ebcdic-uk-euro 1146 1252 *) - (Name: 'x-ebcdic-uk-euro'; CodePage: 1146; FamilyCodePage: 1252), -(* IBM EBCDIC (US-Canada) ebcdic-cp-us 37 1252 *) - (Name: 'ebcdic-cp-us'; CodePage: 37; FamilyCodePage: 1252), -(* IBM EBCDIC (US-Canada-Euro) x-ebcdic-cp-us-euro 1140 1252 *) - (Name: 'x-ebcdic-cp-us-euro'; CodePage: 1140; FamilyCodePage: 1252), -(* Icelandic (DOS) ibm861 861 1252 *) - (Name: 'ibm861'; CodePage: 861; FamilyCodePage: 1252), -(* Icelandic (Mac) x-mac-icelandic 10079 1252 *) - (Name: 'x-mac-icelandic'; CodePage: 10079; FamilyCodePage: 1252), -(* ISCII Assamese x-iscii-as 57006 57006 *) - (Name: 'x-iscii-as'; CodePage: 57006; FamilyCodePage: 57006), -(* ISCII Bengali x-iscii-be 57003 57003 *) - (Name: 'x-iscii-be'; CodePage: 57003; FamilyCodePage: 57003), -(* ISCII Devanagari x-iscii-de 57002 57002 *) - (Name: 'x-iscii-de'; CodePage: 57002; FamilyCodePage: 57002), -(* ISCII Gujarathi x-iscii-gu 57010 57010 *) - (Name: 'x-iscii-gu'; CodePage: 57010; FamilyCodePage: 57010), -(* ISCII Kannada x-iscii-ka 57008 57008 *) - (Name: 'x-iscii-ka'; CodePage: 57008; FamilyCodePage: 57008), -(* ISCII Malayalam x-iscii-ma 57009 57009 *) - (Name: 'x-iscii-ma'; CodePage: 57009; FamilyCodePage: 57009), -(* ISCII Oriya x-iscii-or 57007 57007 *) - (Name: 'x-iscii-or'; CodePage: 57007; FamilyCodePage: 57007), -(* ISCII Panjabi x-iscii-pa 57011 57011 *) - (Name: 'x-iscii-pa'; CodePage: 57011; FamilyCodePage: 57011), -(* ISCII Tamil x-iscii-ta 57004 57004 *) - (Name: 'x-iscii-ta'; CodePage: 57004; FamilyCodePage: 57004), -(* ISCII Telugu x-iscii-te 57005 57005 *) - (Name: 'x-iscii-te'; CodePage: 57005; FamilyCodePage: 57005), -(* Japanese (EUC) euc-jp csEUCPkdFmtJapanese, Extended_UNIX_Code_Packed_Format_for_Japanese, x-euc, x-euc-jp 51932 932 *) - (Name: 'euc-jp'; CodePage: 51932; FamilyCodePage: 932), - (Name: 'csEUCPkdFmtJapanese'; CodePage: 51932; FamilyCodePage: 932), - (Name: 'Extended_UNIX_Code_Packed_Format_for_Japanese'; CodePage: 51932; FamilyCodePage: 932), - (Name: 'x-euc'; CodePage: 51932; FamilyCodePage: 932), - (Name: 'x-euc-jp'; CodePage: 51932; FamilyCodePage: 932), -(* Japanese (JIS) iso-2022-jp 50220 932 *) - (Name: 'iso-2022-jp'; CodePage: 50220; FamilyCodePage: 932), -(* Japanese (JIS-Allow 1 byte Kana - SO/SI) iso-2022-jp _iso-2022-jp$SIO 50222 932 *) - (Name: 'iso-2022-jp'; CodePage: 50222; FamilyCodePage: 932), - (Name: '_iso-2022-jp$SIO'; CodePage: 50222; FamilyCodePage: 932), -(* Japanese (JIS-Allow 1 byte Kana) csISO2022JP _iso-2022-jp 50221 932 *) - (Name: 'csISO2022JP'; CodePage: 50221; FamilyCodePage: 932), - (Name: '_iso-2022-jp'; CodePage: 50221; FamilyCodePage: 932), -(* Japanese (Mac) x-mac-japanese 10001 932 *) - (Name: 'x-mac-japanese'; CodePage: 10001; FamilyCodePage: 932), -(* Japanese (Shift-JIS) shift_jis csShiftJIS, csWindows31J, ms_Kanji, shift-jis, x-ms-cp932, x-sjis 932 932 *) - (Name: 'shift_jis'; CodePage: 932; FamilyCodePage: 932), - (Name: 'csShiftJIS'; CodePage: 932; FamilyCodePage: 932), - (Name: 'csWindows31J'; CodePage: 932; FamilyCodePage: 932), - (Name: 'ms_Kanji'; CodePage: 932; FamilyCodePage: 932), - (Name: 'shift-jis'; CodePage: 932; FamilyCodePage: 932), - (Name: 'x-ms-cp932'; CodePage: 932; FamilyCodePage: 932), - (Name: 'x-sjis'; CodePage: 932; FamilyCodePage: 932), - (Name: 'MS932'; CodePage: 932; FamilyCodePage: 932), -(* Korean ks_c_5601-1987 csKSC56011987, euc-kr, iso-ir-149, korean, ks_c_5601, ks_c_5601_1987, ks_c_5601-1989, KSC_5601, KSC5601 949 949 *) - (Name: 'ks_c_5601-1987'; CodePage: 949; FamilyCodePage: 949), - (Name: 'csKSC56011987'; CodePage: 949; FamilyCodePage: 949), - (Name: 'euc-kr'; CodePage: 949; FamilyCodePage: 949), - (Name: 'iso-ir-149'; CodePage: 949; FamilyCodePage: 949), - (Name: 'korean'; CodePage: 949; FamilyCodePage: 949), - (Name: 'ks_c_5601'; CodePage: 949; FamilyCodePage: 949), - (Name: 'ks_c_5601_1987'; CodePage: 949; FamilyCodePage: 949), - (Name: 'ks_c_5601-1989'; CodePage: 949; FamilyCodePage: 949), - (Name: 'KSC_5601'; CodePage: 949; FamilyCodePage: 949), - (Name: 'KSC5601'; CodePage: 949; FamilyCodePage: 949), -(* Korean (EUC) euc-kr csEUCKR 51949 949 *) - (Name: 'euc-kr'; CodePage: 51949; FamilyCodePage: 949), - (Name: 'csEUCKR'; CodePage: 51949; FamilyCodePage: 949), -(* Korean (ISO) iso-2022-kr csISO2022KR 50225 949 *) - (Name: 'iso-2022-kr'; CodePage: 50225; FamilyCodePage: 949), - (Name: 'csISO2022KR'; CodePage: 50225; FamilyCodePage: 949), -(* Korean (Johab) Johab 1361 1361 *) - (Name: 'Johab'; CodePage: 1361; FamilyCodePage: 1361), -(* Korean (Mac) x-mac-korean 10003 949 *) - (Name: 'x-mac-korean'; CodePage: 10003; FamilyCodePage: 949), -(* Latin 3 (ISO) iso-8859-3 csISOLatin3, ISO_8859-3, ISO_8859-3:1988, iso-ir-109, l3, latin3 28593 1254 *) - (Name: 'iso-8859-3'; CodePage: 28593; FamilyCodePage: 1254), - (Name: 'csISOLatin3'; CodePage: 28593; FamilyCodePage: 1254), - (Name: 'ISO_8859-3'; CodePage: 28593; FamilyCodePage: 1254), - (Name: 'ISO_8859-3:1988'; CodePage: 28593; FamilyCodePage: 1254), - (Name: 'iso-ir-109'; CodePage: 28593; FamilyCodePage: 1254), - (Name: 'l3,'; CodePage: 28593; FamilyCodePage: 1254), - (Name: 'latin3'; CodePage: 28593; FamilyCodePage: 1254), -(* Latin 9 (ISO) iso-8859-15 csISOLatin9, ISO_8859-15, l9, latin9 28605 1252 *) - (Name: 'iso-8859-15'; CodePage: 28605; FamilyCodePage: 1252), - (Name: 'csISOLatin9'; CodePage: 28605; FamilyCodePage: 1252), - (Name: 'ISO_8859-15'; CodePage: 28605; FamilyCodePage: 1252), - (Name: 'l9'; CodePage: 28605; FamilyCodePage: 1252), - (Name: 'latin9'; CodePage: 28605; FamilyCodePage: 1252), -(* Norwegian (IA5) x-IA5-Norwegian 20108 1252 *) - (Name: 'x-IA5-Norwegian'; CodePage: 20108; FamilyCodePage: 1252), -(* OEM United States IBM437 437, cp437, csPC8, CodePage437 437 1252 *) - (Name: 'IBM437'; CodePage: 437; FamilyCodePage: 1252), - (Name: '437'; CodePage: 437; FamilyCodePage: 1252), - (Name: 'cp437'; CodePage: 437; FamilyCodePage: 1252), - (Name: 'csPC8'; CodePage: 437; FamilyCodePage: 1252), - (Name: 'CodePage437'; CodePage: 437; FamilyCodePage: 1252), -(* Swedish (IA5) x-IA5-Swedish 20107 1252 *) - (Name: 'x-IA5-Swedish'; CodePage: 20107; FamilyCodePage: 1252), -(* Thai (Windows) windows-874 DOS-874, iso-8859-11, TIS-620 874 874 *) - (Name: 'windows-874'; CodePage: 874; FamilyCodePage: 874), - (Name: 'DOS-874'; CodePage: 874; FamilyCodePage: 874), - (Name: 'iso-8859-11'; CodePage: 874; FamilyCodePage: 874), - (Name: 'TIS-620'; CodePage: 874; FamilyCodePage: 874), -(* Turkish (DOS) ibm857 857 1254 *) - (Name: 'ibm857'; CodePage: 857; FamilyCodePage: 1254), -(* Turkish (ISO) iso-8859-9 csISOLatin5, ISO_8859-9, ISO_8859-9:1989, iso-ir-148, l5, latin5 28599 1254 *) - (Name: 'iso-8859-9'; CodePage: 28599; FamilyCodePage: 1254), - (Name: 'csISOLatin5'; CodePage: 28599; FamilyCodePage: 1254), - (Name: 'ISO_8859-9'; CodePage: 28599; FamilyCodePage: 1254), - (Name: 'ISO_8859-9:1989'; CodePage: 28599; FamilyCodePage: 1254), - (Name: 'iso-ir-148'; CodePage: 28599; FamilyCodePage: 1254), - (Name: 'l5'; CodePage: 28599; FamilyCodePage: 1254), - (Name: 'latin5'; CodePage: 28599; FamilyCodePage: 1254), -(* Turkish (Mac) x-mac-turkish 10081 1254 *) - (Name: 'x-mac-turkish'; CodePage: 10081; FamilyCodePage: 1254), -(* Turkish (Windows) windows-1254 ISO_8859-9, ISO_8859-9:1989, iso-8859-9, iso-ir-148, latin5 1254 1254 *) - (Name: 'windows-1254'; CodePage: 1254; FamilyCodePage: 1254), - (Name: 'ISO_8859-9'; CodePage: 1254; FamilyCodePage: 1254), - (Name: 'ISO_8859-9:1989'; CodePage: 1254; FamilyCodePage: 1254), - (Name: 'iso-8859-9'; CodePage: 1254; FamilyCodePage: 1254), - (Name: 'iso-ir-148'; CodePage: 1254; FamilyCodePage: 1254), -(* Unicode unicode utf-16 1200 1200 *) - (Name: 'utf-16'; CodePage: 1200; FamilyCodePage: 1200), - (Name: 'unicode'; CodePage: 1200; FamilyCodePage: 1200), -(* Unicode (Big-Endian) unicodeFFFE 1201 1200 *) - (Name: 'unicodeFFFE'; CodePage: 1201; FamilyCodePage: 1200), -(* Unicode (UTF-7) utf-7 csUnicode11UTF7, unicode-1-1-utf-7, x-unicode-2-0-utf-7 65000 1200 *) - (Name: 'utf-7'; CodePage: 65000; FamilyCodePage: 1200), - (Name: 'csUnicode11UTF7'; CodePage: 65000; FamilyCodePage: 1200), - (Name: 'unicode-1-1-utf-7'; CodePage: 65000; FamilyCodePage: 1200), - (Name: 'x-unicode-2-0-utf-7'; CodePage: 65000; FamilyCodePage: 1200), -(* Unicode (UTF-8) utf-8 unicode-1-1-utf-8, unicode-2-0-utf-8, x-unicode-2-0-utf-8 65001 1200 *) - (Name: 'utf-8'; CodePage: 65001; FamilyCodePage: 1200), - (Name: 'unicode-1-1-utf-8'; CodePage: 65001; FamilyCodePage: 1200), - (Name: 'unicode-2-0-utf-8'; CodePage: 65001; FamilyCodePage: 1200), - (Name: 'x-unicode-2-0-utf-8'; CodePage: 65001; FamilyCodePage: 1200), -(* US-ASCII us-ascii ANSI_X3.4-1968, ANSI_X3.4-1986, ascii, cp367, csASCII, IBM367, ISO_646.irv:1991, ISO646-US, iso-ir-6us 20127 1252 *) - (Name: 'us-ascii'; CodePage: 20127; FamilyCodePage: 1252), - (Name: 'ANSI_X3.4-1968'; CodePage: 20127; FamilyCodePage: 1252), - (Name: 'ANSI_X3.4-1986'; CodePage: 20127; FamilyCodePage: 1252), - (Name: 'ascii'; CodePage: 20127; FamilyCodePage: 1252), - (Name: 'cp367'; CodePage: 20127; FamilyCodePage: 1252), - (Name: 'csASCII'; CodePage: 20127; FamilyCodePage: 1252), - (Name: 'IBM367'; CodePage: 20127; FamilyCodePage: 1252), - (Name: 'ISO_646.irv:1991'; CodePage: 20127; FamilyCodePage: 1252), - (Name: 'ISO646-US'; CodePage: 20127; FamilyCodePage: 1252), - (Name: 'iso-ir-6us'; CodePage: 20127; FamilyCodePage: 1252), -(* Vietnamese (Windows) windows-1258 1258 1258 *) - (Name: 'windows-1258'; CodePage: 1258; FamilyCodePage: 1258), -(* Western European (DOS) ibm850 850 1252 *) - (Name: 'ibm850'; CodePage: 850; FamilyCodePage: 1252), -(* Western European (IA5) x-IA5 20105 1252 *) - (Name: 'x-IA5'; CodePage: 20105; FamilyCodePage: 1252), -(* Western European (ISO) iso-8859-1 cp819, csISOLatin1, ibm819, iso_8859-1, iso_8859-1:1987, iso8859-1, iso-ir-100, l1, latin1 28591 1252 *) - (Name: 'iso-8859-1'; CodePage: 28591; FamilyCodePage: 1252), - (Name: 'cp819'; CodePage: 28591; FamilyCodePage: 1252), - (Name: 'csISOLatin1'; CodePage: 28591; FamilyCodePage: 1252), - (Name: 'ibm819'; CodePage: 28591; FamilyCodePage: 1252), - (Name: 'iso_8859-1'; CodePage: 28591; FamilyCodePage: 1252), - (Name: 'iso_8859-1:1987'; CodePage: 28591; FamilyCodePage: 1252), - (Name: 'iso8859-1'; CodePage: 28591; FamilyCodePage: 1252), - (Name: 'iso-ir-100'; CodePage: 28591; FamilyCodePage: 1252), - (Name: 'l1'; CodePage: 28591; FamilyCodePage: 1252), - (Name: 'latin1'; CodePage: 28591; FamilyCodePage: 1252), -(* Western European (Mac) macintosh 10000 1252 *) - (Name: 'macintosh'; CodePage: 10000; FamilyCodePage: 1252), -(* Western European (Windows) Windows-1252 ANSI_X3.4-1968, ANSI_X3.4-1986, ascii, cp367, cp819, csASCII, IBM367, ibm819, ISO_646.irv:1991, iso_8859-1, iso_8859-1:1987, ISO646-US, iso8859-1, iso-8859-1, iso-ir-100, iso-ir-6, latin1, us, us-ascii, x-ansi 1252 1252 *) - (Name: 'Windows-1252'; CodePage: 1252; FamilyCodePage: 1252), - (Name: 'ANSI_X3.4-1968'; CodePage: 1252; FamilyCodePage: 1252), - (Name: 'ANSI_X3.4-1986'; CodePage: 1252; FamilyCodePage: 1252), - (Name: 'CP1252'; CodePage: 1252; FamilyCodePage: 1252), - (Name: 'ascii'; CodePage: 1252; FamilyCodePage: 1252), - (Name: 'cp367'; CodePage: 1252; FamilyCodePage: 1252), - (Name: 'cp819'; CodePage: 1252; FamilyCodePage: 1252), - (Name: 'csASCII'; CodePage: 1252; FamilyCodePage: 1252), - (Name: 'IBM367'; CodePage: 1252; FamilyCodePage: 1252), - (Name: 'ibm819'; CodePage: 1252; FamilyCodePage: 1252), - (Name: 'ISO_646.irv:1991'; CodePage: 1252; FamilyCodePage: 1252), - (Name: 'iso_8859-1'; CodePage: 1252; FamilyCodePage: 1252), - (Name: 'iso_8859-1:1987'; CodePage: 1252; FamilyCodePage: 1252), - (Name: 'ISO646-US'; CodePage: 1252; FamilyCodePage: 1252), - (Name: 'iso8859-1'; CodePage: 1252; FamilyCodePage: 1252), - (Name: 'iso-8859-1'; CodePage: 1252; FamilyCodePage: 1252), - (Name: 'iso-ir-100'; CodePage: 1252; FamilyCodePage: 1252), - (Name: 'iso-ir-6'; CodePage: 1252; FamilyCodePage: 1252), - (Name: 'latin1'; CodePage: 1252; FamilyCodePage: 1252), - (Name: 'us'; CodePage: 1252; FamilyCodePage: 1252), - (Name: 'us-ascii'; CodePage: 1252; FamilyCodePage: 1252), - (Name: 'x-ansi'; CodePage: 1252; FamilyCodePage: 1252) ); - -function FamilyCodePageFromCharsetName(const CharsetName: string): Word; -function FamilyCodePageFromCodePage(CodePage: Word): Word; -function CodePageFromCharsetName(const CharsetName: string): Word; -function CharsetInfoFromCharsetName(const CharsetName: string): TJclCharsetInfo; -function CharsetNameFromCodePage(CodePage: Word): string; - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\common'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -uses - {$IFDEF HAS_UNITSCOPE} - System.SysUtils, - {$ELSE ~HAS_UNITSCOPE} - SysUtils, - {$ENDIF ~HAS_UNITSCOPE} - JclResources; - -function FamilyCodePageFromCharsetName(const CharsetName: string): Word; -var - Index: Integer; - UpperCharsetName: string; -begin - UpperCharsetName := UpperCase(CharsetName); - for Index := Low(JclCharsetInfos) to High(JclCharsetInfos) do - if CompareStr(UpperCharsetName, UpperCase(JclCharsetInfos[Index].Name)) = 0 then - begin - Result := JclCharsetInfos[Index].FamilyCodePage; - Exit; - end; - raise EJclCharsetError.CreateRes(@RsENoCharset); -end; - -function CodePageFromCharsetName(const CharsetName: string): Word; -var - Index: Integer; - UpperCharsetName: string; -begin - UpperCharsetName := UpperCase(CharsetName); - for Index := Low(JclCharsetInfos) to High(JclCharsetInfos) do - if CompareStr(UpperCharsetName, UpperCase(JclCharsetInfos[Index].Name)) = 0 then - begin - Result := JclCharsetInfos[Index].CodePage; - Exit; - end; - raise EJclCharsetError.CreateRes(@RsENoCharset); -end; - -function CharsetInfoFromCharsetName(const CharsetName: string): TJclCharsetInfo; -var - Index: Integer; - UpperCharsetName: string; -begin - UpperCharsetName := UpperCase(CharsetName); - for Index := Low(JclCharsetInfos) to High(JclCharsetInfos) do - if CompareStr(UpperCharsetName, UpperCase(JclCharsetInfos[Index].Name)) = 0 then - begin - Result := JclCharsetInfos[Index]; - Exit; - end; - raise EJclCharsetError.CreateRes(@RsENoCharset); -end; - -function FamilyCodePageFromCodePage(CodePage: Word): Word; -var - Index: Integer; -begin - for Index := Low(JclCharsetInfos) to High(JclCharsetInfos) do - if JclCharsetInfos[Index].CodePage = CodePage then - begin - Result := JclCharsetInfos[Index].FamilyCodePage; - Exit; - end; - raise EJclCharsetError.CreateRes(@RsENoCharset); -end; - -function CharsetNameFromCodePage(CodePage: Word): string; -var - Index: Integer; -begin - for Index := Low(JclCharsetInfos) to High(JclCharsetInfos) do - if JclCharsetInfos[Index].CodePage = CodePage then - begin - Result := JclCharsetInfos[Index].Name; - Exit; - end; - raise EJclCharsetError.CreateRes(@RsENoCharset); -end; - -{$IFDEF UNITVERSIONING} -initialization - RegisterUnitVersion(HInstance, UnitVersioning); - -finalization - UnregisterUnitVersion(HInstance); -{$ENDIF UNITVERSIONING} - -end. - +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclCharsets.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet. } +{ Portions created by Florent Ouchet are Copyright Florent Ouchet. All rights reserved. } +{ } +{ Contributors: } +{ } +{**************************************************************************************************} +{ } +{ Windows codepage bindings are taken from IE5 ones: } +{ http://msdn.microsoft.com/en-us/library/aa752010(VS.85).aspx } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclCharsets; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclBase; + +type + EJclCharsetError = class(EJclError); + +const + CP_UTF16LE = 1200; + +type + TJclCharsetInfo = record + Name: string; + CodePage: Word; + FamilyCodePage: Word; + end; + +const JclCharsetInfos: array [0..285] of TJclCharsetInfo = +(* Arabic (ASMO 708) ASMO-708 708 1256 *) + ((Name: 'ASMO-708'; CodePage: 708; FamilyCodePage: 1256), +(* Arabic (DOS) DOS-720 720 1256 *) + (Name: 'DOS-720'; CodePage: 720; FamilyCodePage: 1256), +(* Arabic (ISO) iso-8859-6 arabic, csISOLatinArabic, ECMA-114, ISO_8859-6, ISO_8859-6:1987, iso-ir-127 28596 1256 *) + (Name: 'iso-8859-6'; CodePage: 28596; FamilyCodePage: 1256), + (Name: 'arabic'; CodePage: 28596; FamilyCodePage: 1256), + (Name: 'csISOLatinArabic'; CodePage: 28596; FamilyCodePage: 1256), + (Name: 'ECMA-114'; CodePage: 28596; FamilyCodePage: 1256), + (Name: 'ISO_8859-6'; CodePage: 28596; FamilyCodePage: 1256), + (Name: 'ISO_8859-6:1987'; CodePage: 28596; FamilyCodePage: 1256), + (Name: 'iso-ir-127'; CodePage: 28596; FamilyCodePage: 1256), +(* Arabic (Mac) x-mac-arabic 10004 1256 *) + (Name: 'x-mac-arabic'; CodePage: 10004; FamilyCodePage: 1256), +(* Arabic (Windows) windows-1256 cp1256 1256 1256 *) + (Name: 'windows-1256'; CodePage: 1256; FamilyCodePage: 1256), + (Name: 'cp1256'; CodePage: 1256; FamilyCodePage: 1256), +(* Baltic (DOS) ibm775 CP500 775 1257 *) + (Name: 'ibm775'; CodePage: 775; FamilyCodePage: 1257), + (Name: 'CP500'; CodePage: 775; FamilyCodePage: 1257), +(* Baltic (ISO) iso-8859-4 csISOLatin4, ISO_8859-4, ISO_8859-4:1988, iso-ir-110, l4, latin4 28594 1257 *) + (Name: 'iso-8859-4'; CodePage: 28594; FamilyCodePage: 1257), + (Name: 'csISOLatin4'; CodePage: 28594; FamilyCodePage: 1257), + (Name: 'ISO_8859-4'; CodePage: 28594; FamilyCodePage: 1257), + (Name: 'ISO_8859-4:1988'; CodePage: 28594; FamilyCodePage: 1257), + (Name: 'iso-ir-110'; CodePage: 28594; FamilyCodePage: 1257), + (Name: 'l4'; CodePage: 28594; FamilyCodePage: 1257), + (Name: 'latin4'; CodePage: 28594; FamilyCodePage: 1257), +(* Baltic (Windows) windows-1257 1257 1257 *) + (Name: 'windows-1257'; CodePage: 1257; FamilyCodePage: 1257), +(* Central European (DOS) ibm852 cp852 852 1250 *) + (Name: 'ibm852'; CodePage: 852; FamilyCodePage: 1250), + (Name: 'cp852'; CodePage: 852; FamilyCodePage: 1250), +(* Central European (ISO) iso-8859-2 csISOLatin2, iso_8859-2, iso_8859-2:1987, iso8859-2, iso-ir-101, l2, latin2 28592 1250 *) + (Name: 'iso-8859-2'; CodePage: 28592; FamilyCodePage: 1250), + (Name: 'csISOLatin2'; CodePage: 28592; FamilyCodePage: 1250), + (Name: 'iso_8859-2'; CodePage: 28592; FamilyCodePage: 1250), + (Name: 'iso_8859-2:1987'; CodePage: 28592; FamilyCodePage: 1250), + (Name: 'iso8859-2'; CodePage: 28592; FamilyCodePage: 1250), + (Name: 'iso-ir-101'; CodePage: 28592; FamilyCodePage: 1250), + (Name: 'l2'; CodePage: 28592; FamilyCodePage: 1250), + (Name: 'latin2'; CodePage: 28592; FamilyCodePage: 1250), +(* Central European (Mac) x-mac-ce 10029 1250 *) + (Name: 'x-mac-ce'; CodePage: 10029; FamilyCodePage: 1250), +(* Central European (Windows) windows-1250 x-cp1250 1250 1250 *) + (Name: 'windows-1250'; CodePage: 1250; FamilyCodePage: 1250), + (Name: 'x-cp1250'; CodePage: 1250; FamilyCodePage: 1250), +(* Chinese Simplified (EUC) EUC-CN x-euc-cn 51936 936 *) + (Name: 'EUC-CN'; CodePage: 51936; FamilyCodePage: 936), + (Name: 'x-euc-cn'; CodePage: 51936; FamilyCodePage: 936), +(* Chinese Simplified (GB2312) gb2312 chinese, CN-GB, csGB2312, csGB231280, csISO58GB231280, GB_2312-80, GB231280, GB2312-80, GBK, iso-ir-58 936 936 *) + (Name: 'gb2312'; CodePage: 936; FamilyCodePage: 936), + (Name: 'chinese'; CodePage: 936; FamilyCodePage: 936), + (Name: 'CN-GB'; CodePage: 936; FamilyCodePage: 936), + (Name: 'csGB2312'; CodePage: 936; FamilyCodePage: 936), + (Name: 'csGB231280'; CodePage: 936; FamilyCodePage: 936), + (Name: 'csISO58GB231280'; CodePage: 936; FamilyCodePage: 936), + (Name: 'GB_2312-80'; CodePage: 936; FamilyCodePage: 936), + (Name: 'GB231280'; CodePage: 936; FamilyCodePage: 936), + (Name: 'GB2312-80'; CodePage: 936; FamilyCodePage: 936), + (Name: 'GBK'; CodePage: 936; FamilyCodePage: 936), + (Name: 'iso-ir-58'; CodePage: 936; FamilyCodePage: 936), +(* Chinese Simplified (HZ) hz-gb-2312 52936 936 *) + (Name: 'hz-gb-2312'; CodePage: 52936; FamilyCodePage: 936), +(* Chinese Simplified (Mac) x-mac-chinesesimp 10008 936 *) + (Name: 'x-mac-chinesesimp'; CodePage: 10008; FamilyCodePage: 936), +(* Chinese Traditional (Big5) big5 cn-big5, csbig5, x-x-big5 950 950 *) + (Name: 'big5'; CodePage: 950; FamilyCodePage: 950), + (Name: 'cn-big5'; CodePage: 950; FamilyCodePage: 950), + (Name: 'csbig5'; CodePage: 950; FamilyCodePage: 950), + (Name: 'x-x-big5'; CodePage: 950; FamilyCodePage: 950), + (Name: 'MS950'; CodePage: 950; FamilyCodePage: 950), +(* Chinese Traditional (CNS) x-Chinese-CNS 20000 950 *) + (Name: 'x-Chinese-CNS'; CodePage: 20000; FamilyCodePage: 950), +(* Chinese Traditional (Eten) x-Chinese-Eten 20002 950 *) + (Name: 'x-Chinese-Eten'; CodePage: 20002; FamilyCodePage: 950), +(* Chinese Traditional (Mac) x-mac-chinesetrad 10002 950 *) + (Name: 'x-mac-chinesetrad'; CodePage: 10002; FamilyCodePage: 950), +(* Cyrillic (DOS) cp866 ibm866 866 1251 *) + (Name: 'cp866'; CodePage: 866; FamilyCodePage: 1251), + (Name: 'ibm866'; CodePage: 866; FamilyCodePage: 1251), +(* Cyrillic (ISO) iso-8859-5 csISOLatin5, csISOLatinCyrillic, cyrillic, ISO_8859-5, ISO_8859-5:1988, iso-ir-144, l5 28595 1251 *) + (Name: 'iso-8859-5'; CodePage: 28595; FamilyCodePage: 1251), + (Name: 'csISOLatinCyrillic'; CodePage: 28595; FamilyCodePage: 1251), + (Name: 'cyrillic'; CodePage: 28595; FamilyCodePage: 1251), + (Name: 'ISO_8859-5'; CodePage: 28595; FamilyCodePage: 1251), + (Name: 'ISO_8859-5:1988'; CodePage: 28595; FamilyCodePage: 1251), + (Name: 'iso-ir-144'; CodePage: 28595; FamilyCodePage: 1251), +(* Cyrillic (KOI8-R) koi8-r csKOI8R, koi, koi8, koi8r 20866 1251 *) + (Name: 'koi8-r'; CodePage: 20866; FamilyCodePage: 1251), + (Name: 'csKOI8R'; CodePage: 20866; FamilyCodePage: 1251), + (Name: 'koi'; CodePage: 20866; FamilyCodePage: 1251), + (Name: 'koi8'; CodePage: 20866; FamilyCodePage: 1251), + (Name: 'koi8r'; CodePage: 20866; FamilyCodePage: 1251), +(* Cyrillic (KOI8-U) koi8-u koi8-ru 21866 1251 *) + (Name: 'koi8-u'; CodePage: 21866; FamilyCodePage: 1251), + (Name: 'koi8-ru'; CodePage: 21866; FamilyCodePage: 1251), +(* Cyrillic (Mac) x-mac-cyrillic 10007 1251 *) + (Name: 'x-mac-cyrillic'; CodePage: 10007; FamilyCodePage: 1251), +(* Cyrillic (Windows) windows-1251 x-cp1251 1251 1251 *) + (Name: 'windows-1251'; CodePage: 1251; FamilyCodePage: 1251), + (Name: 'x-cp1251'; CodePage: 1251; FamilyCodePage: 1251), +(* Europa x-Europa 29001 1252 *) + (Name: 'x-Europa'; CodePage: 29001; FamilyCodePage: 1252), +(* German (IA5) x-IA5-German 20106 1252 *) + (Name: 'x-IA5-German'; CodePage: 20106; FamilyCodePage: 1252), +(* Greek (DOS) ibm737 737 1253 *) + (Name: 'ibm737'; CodePage: 737; FamilyCodePage: 1253), +(* Greek (ISO) iso-8859-7 csISOLatinGreek, ECMA-118, ELOT_928, greek, greek8, ISO_8859-7, ISO_8859-7:1987, iso-ir-126 28597 1253 *) + (Name: 'iso-8859-7'; CodePage: 28597; FamilyCodePage: 1253), + (Name: 'csISOLatinGreek'; CodePage: 28597; FamilyCodePage: 1253), + (Name: 'ECMA-118'; CodePage: 28597; FamilyCodePage: 1253), + (Name: 'ELOT_928'; CodePage: 28597; FamilyCodePage: 1253), + (Name: 'greek'; CodePage: 28597; FamilyCodePage: 1253), + (Name: 'greek8'; CodePage: 28597; FamilyCodePage: 1253), + (Name: 'ISO_8859-7'; CodePage: 28597; FamilyCodePage: 1253), + (Name: 'ISO_8859-7:1987'; CodePage: 28597; FamilyCodePage: 1253), + (Name: 'iso-ir-126'; CodePage: 28597; FamilyCodePage: 1253), +(* Greek (Mac) x-mac-greek 10006 1253 *) + (Name: 'x-mac-greek'; CodePage: 10006; FamilyCodePage: 1253), +(* Greek (Windows) windows-1253 1253 1253 *) + (Name: 'windows-1253'; CodePage: 1253; FamilyCodePage: 1253), +(* Greek, Modern (DOS) ibm869 869 1253 *) + (Name: 'ibm869'; CodePage: 869; FamilyCodePage: 1253), +(* Hebrew (DOS) DOS-862 862 1255 *) + (Name: 'DOS-862'; CodePage: 862; FamilyCodePage: 1255), +(* Hebrew (ISO-Logical) iso-8859-8-i logical 38598 1255 *) + (Name: 'iso-8859-8-i'; CodePage: 38598; FamilyCodePage: 1255), + (Name: 'logical'; CodePage: 38598; FamilyCodePage: 1255), +(* Hebrew (ISO-Visual) iso-8859-8 csISOLatinHebrew, hebrew, ISO_8859-8, ISO_8859-8:1988, ISO-8859-8, iso-ir-138, visual 28598 1255 *) + (Name: 'iso-8859-8'; CodePage: 28598; FamilyCodePage: 1255), + (Name: 'csISOLatinHebrew'; CodePage: 28598; FamilyCodePage: 1255), + (Name: 'hebrew'; CodePage: 28598; FamilyCodePage: 1255), + (Name: 'ISO_8859-8'; CodePage: 28598; FamilyCodePage: 1255), + (Name: 'ISO_8859-8:1988'; CodePage: 28598; FamilyCodePage: 1255), + (Name: 'ISO-8859-8'; CodePage: 28598; FamilyCodePage: 1255), + (Name: 'iso-ir-138'; CodePage: 28598; FamilyCodePage: 1255), + (Name: 'visual'; CodePage: 28598; FamilyCodePage: 1255), +(* Hebrew (Mac) x-mac-hebrew 10005 1255 *) + (Name: 'x-mac-hebrew'; CodePage: 10005; FamilyCodePage: 1255), +(* Hebrew (Windows) windows-1255 ISO_8859-8-I, ISO-8859-8, visual 1255 1255 *) + (Name: 'windows-1255'; CodePage: 1255; FamilyCodePage: 1255), + (Name: 'CP1255'; CodePage: 1255; FamilyCodePage: 1255), + (Name: 'ISO_8859-8-I'; CodePage: 1255; FamilyCodePage: 1255), + (Name: 'ISO-8859-8'; CodePage: 1255; FamilyCodePage: 1255), + (Name: 'visual'; CodePage: 1255; FamilyCodePage: 1255), +(* IBM EBCDIC (Arabic) x-EBCDIC-Arabic 20420 1256 *) + (Name: 'x-EBCDIC-Arabic'; CodePage: 20420; FamilyCodePage: 1256), +(* IBM EBCDIC (Cyrillic Russian) x-EBCDIC-CyrillicRussian 20880 1251 *) + (Name: 'x-EBCDIC-CyrillicRussian'; CodePage: 20880; FamilyCodePage: 1251), +(* IBM EBCDIC (Cyrillic Serbian-Bulgarian) x-EBCDIC-CyrillicSerbianBulgarian 21025 1251 *) + (Name: 'x-EBCDIC-CyrillicSerbianBulgarian'; CodePage: 21025; FamilyCodePage: 1251), +(* IBM EBCDIC (Denmark-Norway) x-EBCDIC-DenmarkNorway 20277 1252 *) + (Name: 'x-EBCDIC-DenmarkNorway'; CodePage: 20277; FamilyCodePage: 1252), +(* IBM EBCDIC (Denmark-Norway-Euro) x-ebcdic-denmarknorway-euro 1142 1252 *) + (Name: 'x-ebcdic-denmarknorway-euro'; CodePage: 1142; FamilyCodePage: 1252), +(* IBM EBCDIC (Finland-Sweden) x-EBCDIC-FinlandSweden 20278 1252 *) + (Name: 'x-EBCDIC-FinlandSweden'; CodePage: 20278; FamilyCodePage: 1252), +(* IBM EBCDIC (Finland-Sweden-Euro) x-ebcdic-finlandsweden-euro X-EBCDIC-France 1143 1252 *) + (Name: 'x-ebcdic-finlandsweden-euro'; CodePage: 1143; FamilyCodePage: 1252), + (Name: 'X-EBCDIC-France'; CodePage: 1143; FamilyCodePage: 1252), +(* IBM EBCDIC (France-Euro) x-ebcdic-france-euro 1147 1252 *) + (Name: 'x-ebcdic-france-euro'; CodePage: 1147; FamilyCodePage: 1252), +(* IBM EBCDIC (Germany) x-EBCDIC-Germany 20273 1252 *) + (Name: 'x-EBCDIC-Germany'; CodePage: 20273; FamilyCodePage: 1252), +(* IBM EBCDIC (Germany-Euro) x-ebcdic-germany-euro 1141 1252 *) + (Name: 'x-ebcdic-germany-euro'; CodePage: 1141; FamilyCodePage: 1252), +(* IBM EBCDIC (Greek Modern) x-EBCDIC-GreekModern 875 1253 *) + (Name: 'x-EBCDIC-GreekModern'; CodePage: 875; FamilyCodePage: 1253), +(* IBM EBCDIC (Greek) x-EBCDIC-Greek 20423 1253 *) + (Name: 'x-EBCDIC-Greek'; CodePage: 20423; FamilyCodePage: 1253), +(* IBM EBCDIC (Hebrew) x-EBCDIC-Hebrew 20424 1255 *) + (Name: 'x-EBCDIC-Hebrew'; CodePage: 20424; FamilyCodePage: 1255), +(* IBM EBCDIC (Icelandic) x-EBCDIC-Icelandic 20871 1252 *) + (Name: 'x-EBCDIC-Icelandic'; CodePage: 20871; FamilyCodePage: 1252), +(* IBM EBCDIC (Icelandic-Euro) x-ebcdic-icelandic-euro 1149 1252 *) + (Name: 'x-ebcdic-icelandic-euro'; CodePage: 1149; FamilyCodePage: 1252), +(* IBM EBCDIC (International-Euro) x-ebcdic-international-euro 1148 1252 *) + (Name: 'x-ebcdic-international-euro'; CodePage: 1148; FamilyCodePage: 1252), +(* IBM EBCDIC (Italy) x-EBCDIC-Italy 20280 1252 *) + (Name: 'x-EBCDIC-Italy'; CodePage: 20280; FamilyCodePage: 1252), +(* IBM EBCDIC (Italy-Euro) x-ebcdic-italy-euro 1144 1252 *) + (Name: 'x-ebcdic-italy-euro'; CodePage: 1144; FamilyCodePage: 1252), +(* IBM EBCDIC (Japanese and Japanese Katakana) x-EBCDIC-JapaneseAndKana 50930 932 *) + (Name: 'x-EBCDIC-JapaneseAndKana'; CodePage: 50930; FamilyCodePage: 932), +(* IBM EBCDIC (Japanese and Japanese-Latin) x-EBCDIC-JapaneseAndJapaneseLatin 50939 932 *) + (Name: 'x-EBCDIC-JapaneseAndJapaneseLatin'; CodePage: 50939; FamilyCodePage: 932), +(* IBM EBCDIC (Japanese and US-Canada) x-EBCDIC-JapaneseAndUSCanada 50931 932 *) + (Name: 'x-EBCDIC-JapaneseAndUSCanada'; CodePage: 50931; FamilyCodePage: 932), +(* IBM EBCDIC (Japanese katakana) x-EBCDIC-JapaneseKatakana 20290 932 *) + (Name: 'x-EBCDIC-JapaneseKatakana'; CodePage: 20290; FamilyCodePage: 932), +(* IBM EBCDIC (Korean and Korean Extended) x-EBCDIC-KoreanAndKoreanExtended 50933 949 *) + (Name: 'x-EBCDIC-KoreanAndKoreanExtended'; CodePage: 50933; FamilyCodePage: 949), +(* IBM EBCDIC (Korean Extended) x-EBCDIC-KoreanExtended 20833 949 *) + (Name: 'x-EBCDIC-KoreanExtended'; CodePage: 20833; FamilyCodePage: 949), +(* IBM EBCDIC (Multilingual Latin-2) CP870 870 1250 *) + (Name: 'CP870'; CodePage: 870; FamilyCodePage: 1250), +(* IBM EBCDIC (Simplified Chinese) x-EBCDIC-SimplifiedChinese 50935 936 *) + (Name: 'x-EBCDIC-SimplifiedChinese'; CodePage: 50935; FamilyCodePage: 936), +(* IBM EBCDIC (Spain) X-EBCDIC-Spain 20284 1252 *) + (Name: 'X-EBCDIC-Spain'; CodePage: 20284; FamilyCodePage: 1252), +(* IBM EBCDIC (Spain-Euro) x-ebcdic-spain-euro 1145 1252 *) + (Name: 'x-ebcdic-spain-euro'; CodePage: 1145; FamilyCodePage: 1252), +(* IBM EBCDIC (Thai) x-EBCDIC-Thai 20838 874 *) + (Name: 'x-EBCDIC-Thai'; CodePage: 20838; FamilyCodePage: 874), +(* IBM EBCDIC (Traditional Chinese) x-EBCDIC-TraditionalChinese 50937 950 *) + (Name: 'x-EBCDIC-TraditionalChinese'; CodePage: 50937; FamilyCodePage: 950), +(* IBM EBCDIC (Turkish Latin-5) CP1026 1026 1254 *) + (Name: 'CP1026'; CodePage: 1026; FamilyCodePage: 1254), +(* IBM EBCDIC (Turkish) x-EBCDIC-Turkish 20905 1254 *) + (Name: 'x-EBCDIC-Turkish'; CodePage: 20905; FamilyCodePage: 1254), +(* IBM EBCDIC (UK) x-EBCDIC-UK 20285 1252 *) + (Name: 'x-EBCDIC-UK'; CodePage: 20285; FamilyCodePage: 1252), +(* IBM EBCDIC (UK-Euro) x-ebcdic-uk-euro 1146 1252 *) + (Name: 'x-ebcdic-uk-euro'; CodePage: 1146; FamilyCodePage: 1252), +(* IBM EBCDIC (US-Canada) ebcdic-cp-us 37 1252 *) + (Name: 'ebcdic-cp-us'; CodePage: 37; FamilyCodePage: 1252), +(* IBM EBCDIC (US-Canada-Euro) x-ebcdic-cp-us-euro 1140 1252 *) + (Name: 'x-ebcdic-cp-us-euro'; CodePage: 1140; FamilyCodePage: 1252), +(* Icelandic (DOS) ibm861 861 1252 *) + (Name: 'ibm861'; CodePage: 861; FamilyCodePage: 1252), +(* Icelandic (Mac) x-mac-icelandic 10079 1252 *) + (Name: 'x-mac-icelandic'; CodePage: 10079; FamilyCodePage: 1252), +(* ISCII Assamese x-iscii-as 57006 57006 *) + (Name: 'x-iscii-as'; CodePage: 57006; FamilyCodePage: 57006), +(* ISCII Bengali x-iscii-be 57003 57003 *) + (Name: 'x-iscii-be'; CodePage: 57003; FamilyCodePage: 57003), +(* ISCII Devanagari x-iscii-de 57002 57002 *) + (Name: 'x-iscii-de'; CodePage: 57002; FamilyCodePage: 57002), +(* ISCII Gujarathi x-iscii-gu 57010 57010 *) + (Name: 'x-iscii-gu'; CodePage: 57010; FamilyCodePage: 57010), +(* ISCII Kannada x-iscii-ka 57008 57008 *) + (Name: 'x-iscii-ka'; CodePage: 57008; FamilyCodePage: 57008), +(* ISCII Malayalam x-iscii-ma 57009 57009 *) + (Name: 'x-iscii-ma'; CodePage: 57009; FamilyCodePage: 57009), +(* ISCII Oriya x-iscii-or 57007 57007 *) + (Name: 'x-iscii-or'; CodePage: 57007; FamilyCodePage: 57007), +(* ISCII Panjabi x-iscii-pa 57011 57011 *) + (Name: 'x-iscii-pa'; CodePage: 57011; FamilyCodePage: 57011), +(* ISCII Tamil x-iscii-ta 57004 57004 *) + (Name: 'x-iscii-ta'; CodePage: 57004; FamilyCodePage: 57004), +(* ISCII Telugu x-iscii-te 57005 57005 *) + (Name: 'x-iscii-te'; CodePage: 57005; FamilyCodePage: 57005), +(* Japanese (EUC) euc-jp csEUCPkdFmtJapanese, Extended_UNIX_Code_Packed_Format_for_Japanese, x-euc, x-euc-jp 51932 932 *) + (Name: 'euc-jp'; CodePage: 51932; FamilyCodePage: 932), + (Name: 'csEUCPkdFmtJapanese'; CodePage: 51932; FamilyCodePage: 932), + (Name: 'Extended_UNIX_Code_Packed_Format_for_Japanese'; CodePage: 51932; FamilyCodePage: 932), + (Name: 'x-euc'; CodePage: 51932; FamilyCodePage: 932), + (Name: 'x-euc-jp'; CodePage: 51932; FamilyCodePage: 932), +(* Japanese (JIS) iso-2022-jp 50220 932 *) + (Name: 'iso-2022-jp'; CodePage: 50220; FamilyCodePage: 932), +(* Japanese (JIS-Allow 1 byte Kana - SO/SI) iso-2022-jp _iso-2022-jp$SIO 50222 932 *) + (Name: 'iso-2022-jp'; CodePage: 50222; FamilyCodePage: 932), + (Name: '_iso-2022-jp$SIO'; CodePage: 50222; FamilyCodePage: 932), +(* Japanese (JIS-Allow 1 byte Kana) csISO2022JP _iso-2022-jp 50221 932 *) + (Name: 'csISO2022JP'; CodePage: 50221; FamilyCodePage: 932), + (Name: '_iso-2022-jp'; CodePage: 50221; FamilyCodePage: 932), +(* Japanese (Mac) x-mac-japanese 10001 932 *) + (Name: 'x-mac-japanese'; CodePage: 10001; FamilyCodePage: 932), +(* Japanese (Shift-JIS) shift_jis csShiftJIS, csWindows31J, ms_Kanji, shift-jis, x-ms-cp932, x-sjis 932 932 *) + (Name: 'shift_jis'; CodePage: 932; FamilyCodePage: 932), + (Name: 'csShiftJIS'; CodePage: 932; FamilyCodePage: 932), + (Name: 'csWindows31J'; CodePage: 932; FamilyCodePage: 932), + (Name: 'ms_Kanji'; CodePage: 932; FamilyCodePage: 932), + (Name: 'shift-jis'; CodePage: 932; FamilyCodePage: 932), + (Name: 'x-ms-cp932'; CodePage: 932; FamilyCodePage: 932), + (Name: 'x-sjis'; CodePage: 932; FamilyCodePage: 932), + (Name: 'MS932'; CodePage: 932; FamilyCodePage: 932), +(* Korean ks_c_5601-1987 csKSC56011987, euc-kr, iso-ir-149, korean, ks_c_5601, ks_c_5601_1987, ks_c_5601-1989, KSC_5601, KSC5601 949 949 *) + (Name: 'ks_c_5601-1987'; CodePage: 949; FamilyCodePage: 949), + (Name: 'csKSC56011987'; CodePage: 949; FamilyCodePage: 949), + (Name: 'euc-kr'; CodePage: 949; FamilyCodePage: 949), + (Name: 'iso-ir-149'; CodePage: 949; FamilyCodePage: 949), + (Name: 'korean'; CodePage: 949; FamilyCodePage: 949), + (Name: 'ks_c_5601'; CodePage: 949; FamilyCodePage: 949), + (Name: 'ks_c_5601_1987'; CodePage: 949; FamilyCodePage: 949), + (Name: 'ks_c_5601-1989'; CodePage: 949; FamilyCodePage: 949), + (Name: 'KSC_5601'; CodePage: 949; FamilyCodePage: 949), + (Name: 'KSC5601'; CodePage: 949; FamilyCodePage: 949), +(* Korean (EUC) euc-kr csEUCKR 51949 949 *) + (Name: 'euc-kr'; CodePage: 51949; FamilyCodePage: 949), + (Name: 'csEUCKR'; CodePage: 51949; FamilyCodePage: 949), +(* Korean (ISO) iso-2022-kr csISO2022KR 50225 949 *) + (Name: 'iso-2022-kr'; CodePage: 50225; FamilyCodePage: 949), + (Name: 'csISO2022KR'; CodePage: 50225; FamilyCodePage: 949), +(* Korean (Johab) Johab 1361 1361 *) + (Name: 'Johab'; CodePage: 1361; FamilyCodePage: 1361), +(* Korean (Mac) x-mac-korean 10003 949 *) + (Name: 'x-mac-korean'; CodePage: 10003; FamilyCodePage: 949), +(* Latin 3 (ISO) iso-8859-3 csISOLatin3, ISO_8859-3, ISO_8859-3:1988, iso-ir-109, l3, latin3 28593 1254 *) + (Name: 'iso-8859-3'; CodePage: 28593; FamilyCodePage: 1254), + (Name: 'csISOLatin3'; CodePage: 28593; FamilyCodePage: 1254), + (Name: 'ISO_8859-3'; CodePage: 28593; FamilyCodePage: 1254), + (Name: 'ISO_8859-3:1988'; CodePage: 28593; FamilyCodePage: 1254), + (Name: 'iso-ir-109'; CodePage: 28593; FamilyCodePage: 1254), + (Name: 'l3,'; CodePage: 28593; FamilyCodePage: 1254), + (Name: 'latin3'; CodePage: 28593; FamilyCodePage: 1254), +(* Latin 9 (ISO) iso-8859-15 csISOLatin9, ISO_8859-15, l9, latin9 28605 1252 *) + (Name: 'iso-8859-15'; CodePage: 28605; FamilyCodePage: 1252), + (Name: 'csISOLatin9'; CodePage: 28605; FamilyCodePage: 1252), + (Name: 'ISO_8859-15'; CodePage: 28605; FamilyCodePage: 1252), + (Name: 'l9'; CodePage: 28605; FamilyCodePage: 1252), + (Name: 'latin9'; CodePage: 28605; FamilyCodePage: 1252), +(* Norwegian (IA5) x-IA5-Norwegian 20108 1252 *) + (Name: 'x-IA5-Norwegian'; CodePage: 20108; FamilyCodePage: 1252), +(* OEM United States IBM437 437, cp437, csPC8, CodePage437 437 1252 *) + (Name: 'IBM437'; CodePage: 437; FamilyCodePage: 1252), + (Name: '437'; CodePage: 437; FamilyCodePage: 1252), + (Name: 'cp437'; CodePage: 437; FamilyCodePage: 1252), + (Name: 'csPC8'; CodePage: 437; FamilyCodePage: 1252), + (Name: 'CodePage437'; CodePage: 437; FamilyCodePage: 1252), +(* Swedish (IA5) x-IA5-Swedish 20107 1252 *) + (Name: 'x-IA5-Swedish'; CodePage: 20107; FamilyCodePage: 1252), +(* Thai (Windows) windows-874 DOS-874, iso-8859-11, TIS-620 874 874 *) + (Name: 'windows-874'; CodePage: 874; FamilyCodePage: 874), + (Name: 'DOS-874'; CodePage: 874; FamilyCodePage: 874), + (Name: 'iso-8859-11'; CodePage: 874; FamilyCodePage: 874), + (Name: 'TIS-620'; CodePage: 874; FamilyCodePage: 874), +(* Turkish (DOS) ibm857 857 1254 *) + (Name: 'ibm857'; CodePage: 857; FamilyCodePage: 1254), +(* Turkish (ISO) iso-8859-9 csISOLatin5, ISO_8859-9, ISO_8859-9:1989, iso-ir-148, l5, latin5 28599 1254 *) + (Name: 'iso-8859-9'; CodePage: 28599; FamilyCodePage: 1254), + (Name: 'csISOLatin5'; CodePage: 28599; FamilyCodePage: 1254), + (Name: 'ISO_8859-9'; CodePage: 28599; FamilyCodePage: 1254), + (Name: 'ISO_8859-9:1989'; CodePage: 28599; FamilyCodePage: 1254), + (Name: 'iso-ir-148'; CodePage: 28599; FamilyCodePage: 1254), + (Name: 'l5'; CodePage: 28599; FamilyCodePage: 1254), + (Name: 'latin5'; CodePage: 28599; FamilyCodePage: 1254), +(* Turkish (Mac) x-mac-turkish 10081 1254 *) + (Name: 'x-mac-turkish'; CodePage: 10081; FamilyCodePage: 1254), +(* Turkish (Windows) windows-1254 ISO_8859-9, ISO_8859-9:1989, iso-8859-9, iso-ir-148, latin5 1254 1254 *) + (Name: 'windows-1254'; CodePage: 1254; FamilyCodePage: 1254), + (Name: 'ISO_8859-9'; CodePage: 1254; FamilyCodePage: 1254), + (Name: 'ISO_8859-9:1989'; CodePage: 1254; FamilyCodePage: 1254), + (Name: 'iso-8859-9'; CodePage: 1254; FamilyCodePage: 1254), + (Name: 'iso-ir-148'; CodePage: 1254; FamilyCodePage: 1254), +(* Unicode unicode utf-16 1200 1200 *) + (Name: 'utf-16'; CodePage: 1200; FamilyCodePage: 1200), + (Name: 'unicode'; CodePage: 1200; FamilyCodePage: 1200), +(* Unicode (Big-Endian) unicodeFFFE 1201 1200 *) + (Name: 'unicodeFFFE'; CodePage: 1201; FamilyCodePage: 1200), +(* Unicode (UTF-7) utf-7 csUnicode11UTF7, unicode-1-1-utf-7, x-unicode-2-0-utf-7 65000 1200 *) + (Name: 'utf-7'; CodePage: 65000; FamilyCodePage: 1200), + (Name: 'csUnicode11UTF7'; CodePage: 65000; FamilyCodePage: 1200), + (Name: 'unicode-1-1-utf-7'; CodePage: 65000; FamilyCodePage: 1200), + (Name: 'x-unicode-2-0-utf-7'; CodePage: 65000; FamilyCodePage: 1200), +(* Unicode (UTF-8) utf-8 unicode-1-1-utf-8, unicode-2-0-utf-8, x-unicode-2-0-utf-8 65001 1200 *) + (Name: 'utf-8'; CodePage: 65001; FamilyCodePage: 1200), + (Name: 'unicode-1-1-utf-8'; CodePage: 65001; FamilyCodePage: 1200), + (Name: 'unicode-2-0-utf-8'; CodePage: 65001; FamilyCodePage: 1200), + (Name: 'x-unicode-2-0-utf-8'; CodePage: 65001; FamilyCodePage: 1200), +(* US-ASCII us-ascii ANSI_X3.4-1968, ANSI_X3.4-1986, ascii, cp367, csASCII, IBM367, ISO_646.irv:1991, ISO646-US, iso-ir-6us 20127 1252 *) + (Name: 'us-ascii'; CodePage: 20127; FamilyCodePage: 1252), + (Name: 'ANSI_X3.4-1968'; CodePage: 20127; FamilyCodePage: 1252), + (Name: 'ANSI_X3.4-1986'; CodePage: 20127; FamilyCodePage: 1252), + (Name: 'ascii'; CodePage: 20127; FamilyCodePage: 1252), + (Name: 'cp367'; CodePage: 20127; FamilyCodePage: 1252), + (Name: 'csASCII'; CodePage: 20127; FamilyCodePage: 1252), + (Name: 'IBM367'; CodePage: 20127; FamilyCodePage: 1252), + (Name: 'ISO_646.irv:1991'; CodePage: 20127; FamilyCodePage: 1252), + (Name: 'ISO646-US'; CodePage: 20127; FamilyCodePage: 1252), + (Name: 'iso-ir-6us'; CodePage: 20127; FamilyCodePage: 1252), +(* Vietnamese (Windows) windows-1258 1258 1258 *) + (Name: 'windows-1258'; CodePage: 1258; FamilyCodePage: 1258), +(* Western European (DOS) ibm850 850 1252 *) + (Name: 'ibm850'; CodePage: 850; FamilyCodePage: 1252), +(* Western European (IA5) x-IA5 20105 1252 *) + (Name: 'x-IA5'; CodePage: 20105; FamilyCodePage: 1252), +(* Western European (ISO) iso-8859-1 cp819, csISOLatin1, ibm819, iso_8859-1, iso_8859-1:1987, iso8859-1, iso-ir-100, l1, latin1 28591 1252 *) + (Name: 'iso-8859-1'; CodePage: 28591; FamilyCodePage: 1252), + (Name: 'cp819'; CodePage: 28591; FamilyCodePage: 1252), + (Name: 'csISOLatin1'; CodePage: 28591; FamilyCodePage: 1252), + (Name: 'ibm819'; CodePage: 28591; FamilyCodePage: 1252), + (Name: 'iso_8859-1'; CodePage: 28591; FamilyCodePage: 1252), + (Name: 'iso_8859-1:1987'; CodePage: 28591; FamilyCodePage: 1252), + (Name: 'iso8859-1'; CodePage: 28591; FamilyCodePage: 1252), + (Name: 'iso-ir-100'; CodePage: 28591; FamilyCodePage: 1252), + (Name: 'l1'; CodePage: 28591; FamilyCodePage: 1252), + (Name: 'latin1'; CodePage: 28591; FamilyCodePage: 1252), +(* Western European (Mac) macintosh 10000 1252 *) + (Name: 'macintosh'; CodePage: 10000; FamilyCodePage: 1252), +(* Western European (Windows) Windows-1252 ANSI_X3.4-1968, ANSI_X3.4-1986, ascii, cp367, cp819, csASCII, IBM367, ibm819, ISO_646.irv:1991, iso_8859-1, iso_8859-1:1987, ISO646-US, iso8859-1, iso-8859-1, iso-ir-100, iso-ir-6, latin1, us, us-ascii, x-ansi 1252 1252 *) + (Name: 'Windows-1252'; CodePage: 1252; FamilyCodePage: 1252), + (Name: 'ANSI_X3.4-1968'; CodePage: 1252; FamilyCodePage: 1252), + (Name: 'ANSI_X3.4-1986'; CodePage: 1252; FamilyCodePage: 1252), + (Name: 'CP1252'; CodePage: 1252; FamilyCodePage: 1252), + (Name: 'ascii'; CodePage: 1252; FamilyCodePage: 1252), + (Name: 'cp367'; CodePage: 1252; FamilyCodePage: 1252), + (Name: 'cp819'; CodePage: 1252; FamilyCodePage: 1252), + (Name: 'csASCII'; CodePage: 1252; FamilyCodePage: 1252), + (Name: 'IBM367'; CodePage: 1252; FamilyCodePage: 1252), + (Name: 'ibm819'; CodePage: 1252; FamilyCodePage: 1252), + (Name: 'ISO_646.irv:1991'; CodePage: 1252; FamilyCodePage: 1252), + (Name: 'iso_8859-1'; CodePage: 1252; FamilyCodePage: 1252), + (Name: 'iso_8859-1:1987'; CodePage: 1252; FamilyCodePage: 1252), + (Name: 'ISO646-US'; CodePage: 1252; FamilyCodePage: 1252), + (Name: 'iso8859-1'; CodePage: 1252; FamilyCodePage: 1252), + (Name: 'iso-8859-1'; CodePage: 1252; FamilyCodePage: 1252), + (Name: 'iso-ir-100'; CodePage: 1252; FamilyCodePage: 1252), + (Name: 'iso-ir-6'; CodePage: 1252; FamilyCodePage: 1252), + (Name: 'latin1'; CodePage: 1252; FamilyCodePage: 1252), + (Name: 'us'; CodePage: 1252; FamilyCodePage: 1252), + (Name: 'us-ascii'; CodePage: 1252; FamilyCodePage: 1252), + (Name: 'x-ansi'; CodePage: 1252; FamilyCodePage: 1252) ); + +function FamilyCodePageFromCharsetName(const CharsetName: string): Word; +function FamilyCodePageFromCodePage(CodePage: Word): Word; +function CodePageFromCharsetName(const CharsetName: string): Word; +function CharsetInfoFromCharsetName(const CharsetName: string): TJclCharsetInfo; +function CharsetNameFromCodePage(CodePage: Word): string; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclResources; + +function FamilyCodePageFromCharsetName(const CharsetName: string): Word; +var + Index: Integer; + UpperCharsetName: string; +begin + UpperCharsetName := UpperCase(CharsetName); + for Index := Low(JclCharsetInfos) to High(JclCharsetInfos) do + if CompareStr(UpperCharsetName, UpperCase(JclCharsetInfos[Index].Name)) = 0 then + begin + Result := JclCharsetInfos[Index].FamilyCodePage; + Exit; + end; + raise EJclCharsetError.CreateRes(@RsENoCharset); +end; + +function CodePageFromCharsetName(const CharsetName: string): Word; +var + Index: Integer; + UpperCharsetName: string; +begin + UpperCharsetName := UpperCase(CharsetName); + for Index := Low(JclCharsetInfos) to High(JclCharsetInfos) do + if CompareStr(UpperCharsetName, UpperCase(JclCharsetInfos[Index].Name)) = 0 then + begin + Result := JclCharsetInfos[Index].CodePage; + Exit; + end; + raise EJclCharsetError.CreateRes(@RsENoCharset); +end; + +function CharsetInfoFromCharsetName(const CharsetName: string): TJclCharsetInfo; +var + Index: Integer; + UpperCharsetName: string; +begin + UpperCharsetName := UpperCase(CharsetName); + for Index := Low(JclCharsetInfos) to High(JclCharsetInfos) do + if CompareStr(UpperCharsetName, UpperCase(JclCharsetInfos[Index].Name)) = 0 then + begin + Result := JclCharsetInfos[Index]; + Exit; + end; + raise EJclCharsetError.CreateRes(@RsENoCharset); +end; + +function FamilyCodePageFromCodePage(CodePage: Word): Word; +var + Index: Integer; +begin + for Index := Low(JclCharsetInfos) to High(JclCharsetInfos) do + if JclCharsetInfos[Index].CodePage = CodePage then + begin + Result := JclCharsetInfos[Index].FamilyCodePage; + Exit; + end; + raise EJclCharsetError.CreateRes(@RsENoCharset); +end; + +function CharsetNameFromCodePage(CodePage: Word): string; +var + Index: Integer; +begin + for Index := Low(JclCharsetInfos) to High(JclCharsetInfos) do + if JclCharsetInfos[Index].CodePage = CodePage then + begin + Result := JclCharsetInfos[Index].Name; + Exit; + end; + raise EJclCharsetError.CreateRes(@RsENoCharset); +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclCompilerUtils.pas b/3rdParty/JCL/source/common/JclCompilerUtils.pas new file mode 100644 index 00000000..749e3da4 --- /dev/null +++ b/3rdParty/JCL/source/common/JclCompilerUtils.pas @@ -0,0 +1,1508 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is DelphiInstall.pas. } +{ } +{ The Initial Developer of the Original Code is Petr Vones. Portions created by Petr Vones are } +{ Copyright (C) of Petr Vones. All Rights Reserved. } +{ } +{ Contributor(s): } +{ Andreas Hausladen (ahuser) } +{ Florent Ouchet (outchy) } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) - crossplatform & BCB support } +{ Uwe Schuster (uschuster) } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclCompilerUtils; + +{$I jcl.inc} +{$I crossplatform.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Winapi.Windows, + {$ENDIF MSWINDOWS} + System.Classes, System.SysUtils, System.IniFiles, + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + Classes, SysUtils, IniFiles, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclSysUtils; + +type + EJclCompilerUtilsException = class(EJclError); + + TJclCompilerSettingsFormat = (csfDOF, csfBDSProj, csfMsBuild); + + TJclBorlandCommandLineTool = class; + TJclBorlandCommandLineToolEvent = procedure(Sender:TJclBorlandCommandLineTool) of object; + + TJclBorlandCommandLineTool = class(TInterfacedObject, IJclCommandLineTool) + private + FBinDirectory: string; + FCompilerSettingsFormat: TJclCompilerSettingsFormat; + FLongPathBug: Boolean; + FOptions: TStringList; + FOutputCallback: TTextHandler; + FOutput: string; + FOnAfterExecute: TJclBorlandCommandLineToolEvent; + FOnBeforeExecute: TJclBorlandCommandLineToolEvent; + protected + procedure CheckOutputValid; + function GetFileName: string; + function InternalExecute(const CommandLine: string): Boolean; + public + constructor Create(const ABinDirectory: string; ALongPathBug: Boolean; + ACompilerSettingsFormat: TJclCompilerSettingsFormat); + destructor Destroy; override; + { IJclCommandLineTool } + function GetExeName: string; virtual; + function GetOptions: TStrings; + function GetOutput: string; + function GetOutputCallback: TTextHandler; + procedure AddPathOption(const Option, Path: string); + function Execute(const CommandLine: string): Boolean; virtual; + procedure SetOutputCallback(const CallbackMethod: TTextHandler); + property BinDirectory: string read FBinDirectory; + property CompilerSettingsFormat: TJclCompilerSettingsFormat read FCompilerSettingsFormat; + property ExeName: string read GetExeName; + property LongPathBug: Boolean read FLongPathBug; + property Options: TStrings read GetOptions; + property OutputCallback: TTextHandler write SetOutputCallback; + property Output: string read GetOutput; + + property FileName: string read GetFileName; + property OnAfterExecute: TJclBorlandCommandLineToolEvent read FOnAfterExecute write FOnAfterExecute; + property OnBeforeExecute: TJclBorlandCommandLineToolEvent read FOnBeforeExecute write FOnBeforeExecute; + end; + + TJclBCC32 = class(TJclBorlandCommandLineTool) + public + class function GetPlatform: string; virtual; + function GetExeName: string; override; + end; + + TJclBCC32C = class(TJclBorlandCommandLineTool) + public + class function GetPlatform: string; virtual; + function GetExeName: string; override; + end; + + TJclBCC64 = class(TJclBCC32) + public + class function GetPlatform: string; override; + function GetExeName: string; override; + end; + + TJclBCC64X = class(TJclBCC64) + public + class function GetPlatform: string; override; + function GetExeName: string; override; + end; + + TProjectOptions = record + UsePackages: Boolean; + UnitOutputDir: string; + SearchPath: string; + DynamicPackages: string; + SearchDcpPath: string; + Conditionals: string; + Namespace: string; + end; + + TJclStringsGetterFunction = function: TStrings of object; + + TJclDCC32 = class(TJclBorlandCommandLineTool) + private + FDCPSearchPath: string; + FLibrarySearchPath: string; + FLibraryDebugSearchPath: string; + FCppSearchPath: string; + FOnEnvironmentVariables: TJclStringsGetterFunction; + FSupportsNoConfig: Boolean; + FSupportsPlatform: Boolean; + FDCCVersion: Single; + protected + procedure AddProjectOptions(const ProjectFileName, DCPPath: string); + function Compile(const ProjectFileName: string): Boolean; + public + class function GetPlatform: string; virtual; + constructor Create(const ABinDirectory: string; ALongPathBug: Boolean; ADCCVersion: Single; + ACompilerSettingsFormat: TJclCompilerSettingsFormat; ASupportsNoConfig, ASupportsPlatform: Boolean; + const ADCPSearchPath, ALibrarySearchPath, ALibraryDebugSearchPath, ACppSearchPath: string); + function GetExeName: string; override; + function Execute(const CommandLine: string): Boolean; override; + function MakePackage(const PackageName, BPLPath, DCPPath: string; + ExtraOptions: string = ''; ADebug: Boolean = False): Boolean; + function MakeProject(const ProjectName, OutputDir, DcpSearchPath: string; + ExtraOptions: string = ''; ADebug: Boolean = False): Boolean; + procedure SetDefaultOptions(ADebug: Boolean); virtual; + function AddBDSProjOptions(const ProjectFileName: string; var ProjectOptions: TProjectOptions): Boolean; + function AddDOFOptions(const ProjectFileName: string; var ProjectOptions: TProjectOptions): Boolean; + function AddDProjOptions(const ProjectFileName: string; var ProjectOptions: TProjectOptions): Boolean; + property CppSearchPath: string read FCppSearchPath; + property DCPSearchPath: string read FDCPSearchPath; + property LibrarySearchPath: string read FLibrarySearchPath; + property LibraryDebugSearchPath: string read FLibraryDebugSearchPath; + property OnEnvironmentVariables: TJclStringsGetterFunction read FOnEnvironmentVariables write FOnEnvironmentVariables; + property SupportsNoConfig: Boolean read FSupportsNoConfig; + property SupportsPlatform: Boolean read FSupportsPlatform; + property DCCVersion: Single read FDCCVersion; + end; + + TJclDCC64 = class(TJclDCC32) + public + class function GetPlatform: string; override; + function GetExeName: string; override; + end; + + TJclDCCOSX32 = class(TJclDCC32) + public + class function GetPlatform: string; override; + function GetExeName: string; override; + end; + + TJclDCCOSX64 = class(TJclDCC32) + public + class function GetPlatform: string; override; + function GetExeName: string; override; + end; + + TJclDCCiOSSimulator = class(TJclDCC32) + public + class function GetPlatform: string; override; + function GetExeName: string; override; + end; + + TJclDCCiOS32 = class(TJclDCC32) + public + class function GetPlatform: string; override; + function GetExeName: string; override; + end; + + TJclDCCiOS64 = class(TJclDCC32) + public + class function GetPlatform: string; override; + function GetExeName: string; override; + end; + + TJclDCCArm32 = class(TJclDCC32) + public + class function GetPlatform: string; override; + function GetExeName: string; override; + end; + + TJclDCCArm64 = class(TJclDCC32) + public + class function GetPlatform: string; override; + function GetExeName: string; override; + end; + + TJclDCCLinux64 = class(TJclDCC32) + public + class function GetPlatform: string; override; + function GetExeName: string; override; + end; + + {$IFDEF MSWINDOWS} + TJclDCCIL = class(TJclDCC32) + private + FMaxCLRVersion: string; + protected + function GetMaxCLRVersion: string; + public + function GetExeName: string; override; + function MakeProject(const ProjectName, OutputDir, ExtraOptions: string; + ADebug: Boolean = False): Boolean; reintroduce; + procedure SetDefaultOptions(ADebug: Boolean); override; + property MaxCLRVersion: string read GetMaxCLRVersion; + end; + {$ENDIF MSWINDOWS} + + TJclBpr2Mak = class(TJclBorlandCommandLineTool) + public + function GetExeName: string; override; + end; + + TJclBorlandMake = class(TJclBorlandCommandLineTool) + public + function GetExeName: string; override; + end; + +const + AsmExeName = 'tasm32.exe'; + BCC32ExeName = 'bcc32.exe'; + BCC32CExeName = 'bcc32c.exe'; + BCC64ExeName = 'bcc64.exe'; + BCC64XExeName = 'bcc64x.exe'; + DCC32ExeName = 'dcc32.exe'; + DCC64ExeName = 'dcc64.exe'; + DCCOSX32ExeName = 'dccosx.exe'; + DCCOSX64ExeName = 'dccosx64.exe'; + DCCiOSSimulatorExeName = 'dccios32.exe'; + DCCiOS32ExeName = 'dcciosarm.exe'; + DCCiOS64ExeName = 'dcciosarm64.exe'; + DCCArm32ExeName = 'dccaarm.exe'; //Android 32 + DCCArm64ExeName = 'dccaarm64.exe'; //Android 64 + DCCLinux64ExeName = 'dcclinux64.exe'; + DCCILExeName = 'dccil.exe'; + Bpr2MakExeName = 'bpr2mak.exe'; + MakeExeName = 'make.exe'; + + BinaryExtensionPackage = '.bpl'; + BinaryExtensionLibrary = '.dll'; + BinaryExtensionExecutable = '.exe'; + SourceExtensionDelphiPackage = '.dpk'; + SourceExtensionBCBPackage = '.bpk'; + SourceExtensionDelphiProject = '.dpr'; + SourceExtensionBCBProject = '.bpr'; + SourceExtensionDProject = '.dproj'; + SourceExtensionBDSProject = '.bdsproj'; + SourceExtensionDOFProject = '.dof'; + SourceExtensionConfiguration = '.cfg'; + +function BinaryFileName(const OutputPath, ProjectFileName: string): string; + +function IsDelphiPackage(const FileName: string): Boolean; +function IsDelphiProject(const FileName: string): Boolean; +function IsBCBPackage(const FileName: string): Boolean; +function IsBCBProject(const FileName: string): Boolean; + +procedure GetDPRFileInfo(const DPRFileName: string; out BinaryExtension: string; + const LibSuffix: PString = nil); +procedure GetBPRFileInfo(const BPRFileName: string; out BinaryFileName: string; + const Description: PString = nil); +procedure GetDPKFileInfo(const DPKFileName: string; out RunOnly: Boolean; + const LibSuffix: PString = nil; const Description: PString = nil); +procedure GetBPKFileInfo(const BPKFileName: string; out RunOnly: Boolean; + const BinaryFileName: PString = nil; const Description: PString = nil); + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysConst, + {$ELSE ~HAS_UNITSCOPE} + SysConst, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + JclFileUtils, + JclDevToolsResources, + JclIDEUtils, + JclAnsiStrings, + JclWideStrings, + JclStrings, + JclSysInfo, + JclSimpleXml, + JclMsBuild; + +const + // DOF options + DOFDirectoriesSection = 'Directories'; + DOFUnitOutputDirKey = 'UnitOutputDir'; + DOFSearchPathName = 'SearchPath'; + DOFConditionals = 'Conditionals'; + DOFLinkerSection = 'Linker'; + DOFPackagesKey = 'Packages'; + DOFCompilerSection = 'Compiler'; + DOFPackageNoLinkKey = 'PackageNoLink'; + // injection of new compiler options to workaround L1496 internal error of Delphi 5 and C++Builder 5 + // adding -B switch to the compiler command line forces units to be built + DOFAdditionalSection = 'Additional'; + DOFOptionsKey = 'Options'; + + // BDSProj options + BDSProjPersonalityInfoNodeName = 'PersonalityInfo'; + BDSProjOptionNodeName = 'Option'; + BDSProjNameProperty = 'Name'; + BDSProjPersonalityValue = 'Personality'; + BDSProjUnitOutputDirValue = 'UnitOutputDir'; + BDSProjSearchPathValue = 'SearchPath'; + BDSProjPackagesValue = 'Packages'; + BDSProjConditionalsValue = 'Conditionals'; + BDSProjUsePackagesValue = 'UsePackages'; + BDSProjDirectoriesNodeName = 'Directories'; + + // DProj options + DProjPersonalityNodeName = 'Borland.Personality'; + DProjDelphiPersonalityValue = 'Delphi.Personality'; + DProjDelphiDotNetPersonalityValue = 'DelphiDotNet.Personality'; + DProjUsePackageNodeName = 'DCC_UsePackage'; + DProjDcuOutputDirNodeName = 'DCC_DcuOutput'; + DProjUnitSearchPathNodeName = 'DCC_UnitSearchPath'; + DProjDefineNodeName = 'DCC_Define'; + DProjNamespaceNodeName = 'DCC_Namespace'; + + DelphiLibSuffixOption = '{$LIBSUFFIX '''; + DelphiDescriptionOption = '{$DESCRIPTION '''; + DelphiRunOnlyOption = '{$RUNONLY}'; + DelphiBinaryExtOption = '{$E '; + BCBLFlagsOption = ' 0 then + begin + SubS1 := Copy(S, LProjectPos, Length(S)); + J := 1; + while (Pos('>', SubS1) = 0) and ((I + J) < BPKFile.Count) do + begin + SubS1 := SubS1 + BPKFile[I + J]; + Inc(J); + end; + + BinaryFileNamePos := Pos('"', SubS1); + if BinaryFileNamePos > 0 then + begin + SubS2 := Copy(SubS1, BinaryFileNamePos + 1, Length(SubS1) - BinaryFileNamePos); + EndFileNamePos := Pos('"', SubS2); + + if EndFileNamePos > 0 then + BinaryFileName := Copy(SubS2, 1, EndFileNamePos - 1); + end; + end; + + LFlagsPos := Pos(BCBLFlagsOption, S); + if LFlagsPos > 0 then + begin + SubS1 := Copy(S, LFlagsPos, Length(S)); + J := 1; + while (Pos('>', SubS1) = 0) and ((I + J) < BPKFile.Count) do + begin + SubS1 := SubS1 + BPKFile[I + J]; + Inc(J); + end; + DSwitchPos := Pos(BCBDSwitchOption, SubS1); + if DSwitchPos > 0 then + begin + SubS2 := Copy(SubS1, DSwitchPos, Length(SubS1)); + SemiColonPos := Pos(';', SubS2); + if SemiColonPos > 0 then + begin + SubS3 := Copy(SubS2, SemiColonPos + 1, Length(SubS2)); + AmpPos := Pos('&', SubS3); + if (Description <> nil) and (AmpPos > 0) then + Description^ := Copy(SubS3, 1, AmpPos - 1); + end; + end; + end; + end; + finally + BPKFile.Free; + end; +end; + +procedure GetDPKFileInfo(const DPKFileName: string; out RunOnly: Boolean; + const LibSuffix: PString = nil; const Description: PString = nil); +var + I: Integer; + S: string; + DPKFile: TStringList; +begin + DPKFile := TStringList.Create; + try + DPKFile.LoadFromFile(DPKFileName); + if Assigned(Description) then + Description^ := ''; + if Assigned(LibSuffix) then + LibSuffix^ := ''; + RunOnly := False; + for I := 0 to DPKFile.Count - 1 do + begin + S := TrimRight(DPKFile.Strings[I]); + if Assigned(Description) and (Pos(DelphiDescriptionOption, S) = 1) then + Description^ := Copy(S, Length(DelphiDescriptionOption), Length(S) - Length(DelphiDescriptionOption)) + else + if Assigned(LibSuffix) and (Pos(DelphiLibSuffixOption, S) = 1) then + LibSuffix^ := StrTrimQuotes(Copy(S, Length(DelphiLibSuffixOption), Length(S) - Length(DelphiLibSuffixOption))) + else + if Pos(DelphiRunOnlyOption, S) = 1 then + RunOnly := True; + end; + finally + DPKFile.Free; + end; +end; + +procedure GetBPKFileInfo(const BPKFileName: string; out RunOnly: Boolean; + const BinaryFileName: PString = nil; const Description: PString = nil); +var + I, J: Integer; + S, SubS1, SubS2, SubS3: string; + BPKFile: TStringList; + LFlagsPos, DSwitchPos, SemiColonPos, AmpPos, GprPos: Integer; + LProjectPos, BinaryFileNamePos, EndFileNamePos: Integer; +begin + BPKFile := TStringList.Create; + try + BPKFile.LoadFromFile(BPKFileName); + if Assigned(Description) then + Description^ := ''; + if Assigned(BinaryFileName) then + BinaryFileName^ := ''; + RunOnly := False; + for I := 0 to BPKFile.Count - 1 do + begin + S := BPKFile[I]; + + LProjectPos := Pos(BCBProjectOption, S); + if Assigned(BinaryFileName) and (LProjectPos > 0) then + begin + SubS1 := Copy(S, LProjectPos, Length(S)); + J := 1; + while (Pos('>', SubS1) = 0) and ((I + J) < BPKFile.Count) do + begin + SubS1 := SubS1 + BPKFile[I + J]; + Inc(J); + end; + + BinaryFileNamePos := Pos('"', SubS1); + if BinaryFileNamePos > 0 then + begin + SubS2 := Copy(SubS1, BinaryFileNamePos + 1, Length(SubS1) - BinaryFileNamePos); + EndFileNamePos := Pos('"', SubS2); + + if EndFileNamePos > 0 then + BinaryFileName^ := Copy(SubS2, 1, EndFileNamePos - 1); + end; + end; + + LFlagsPos := Pos(BCBLFlagsOption, S); + if LFlagsPos > 0 then + begin + SubS1 := Copy(S, LFlagsPos, Length(S)); + J := 1; + while (Pos('>', SubS1) = 0) and ((I + J) < BPKFile.Count) do + begin + SubS1 := SubS1 + BPKFile[I + J]; + Inc(J); + end; + DSwitchPos := Pos(BCBDSwitchOption, SubS1); + GprPos := Pos(BCBGprSwitchOption, SubS1); + if DSwitchPos > 0 then + begin + SubS2 := Copy(SubS1, DSwitchPos, Length(SubS1)); + SemiColonPos := Pos(';', SubS2); + if SemiColonPos > 0 then + begin + SubS3 := Copy(SubS2, SemiColonPos + 1, Length(SubS2)); + AmpPos := Pos('&', SubS3); + if (Description <> nil) and (AmpPos > 0) then + Description^ := Copy(SubS3, 1, AmpPos - 1); + end; + end; + if GprPos > 0 then + RunOnly := True; + end; + end; + finally + BPKFile.Free; + end; +end; + +function BinaryFileName(const OutputPath, ProjectFileName: string): string; +var + ProjectExtension, LibSuffix, BinaryExtension: string; + RunOnly: Boolean; +begin + ProjectExtension := ExtractFileExt(ProjectFileName); + if SameText(ProjectExtension, SourceExtensionDelphiPackage) then + begin + GetDPKFileInfo(ProjectFileName, RunOnly, @LibSuffix); + Result := PathExtractFileNameNoExt(ProjectFileName) + LibSuffix + BinaryExtensionPackage; + end + else + if SameText(ProjectExtension, SourceExtensionDelphiProject) then + begin + GetDPRFileInfo(ProjectFileName, BinaryExtension, @LibSuffix); + Result := PathExtractFileNameNoExt(ProjectFileName) + LibSuffix + BinaryExtension; + end + else + if SameText(ProjectExtension, SourceExtensionBCBPackage) then + GetBPKFileInfo(ProjectFileName, RunOnly, @Result) + else + if SameText(ProjectExtension, SourceExtensionBCBProject) then + GetBPRFileInfo(ProjectFileName, Result) + else + raise EJclCompilerUtilsException.CreateResFmt(@RsEUnknownProjectExtension, [ProjectExtension]); + + Result := PathAddSeparator(OutputPath) + Result; +end; + +function IsDelphiPackage(const FileName: string): Boolean; +begin + Result := SameText(ExtractFileExt(FileName), SourceExtensionDelphiPackage); +end; + +function IsDelphiProject(const FileName: string): Boolean; +begin + Result := SameText(ExtractFileExt(FileName), SourceExtensionDelphiProject); +end; + +function IsBCBPackage(const FileName: string): Boolean; +begin + Result := SameText(ExtractFileExt(FileName), SourceExtensionBCBPackage); +end; + +function IsBCBProject(const FileName: string): Boolean; +begin + Result := SameText(ExtractFileExt(FileName), SourceExtensionBCBProject); +end; + +{$IFDEF MSWINDOWS} +type + TFindResStartRec = record + StartStr: WideString; + MatchStr: WideString; + end; + PFindResStartRec = ^TFindResStartRec; + +// helper function to check strings starting "StartStr" in current string table +function FindResStartCallBack(hModule: HMODULE; lpszType, lpszName: PChar; + lParam: PFindResStartRec): BOOL; stdcall; +var + ResInfo, ResHData, ResSize, ResIndex: Cardinal; + ResData: PWord; + StrLength: Word; + MatchLen: Integer; +begin + Result := True; + MatchLen := Length(lParam^.StartStr); + + ResInfo := FindResource(hModule, lpszName, lpszType); + if ResInfo <> 0 then + begin + ResHData := LoadResource(hModule, ResInfo); + if ResHData <> 0 then + begin + ResData := LockResource(ResHData); + if Assigned(ResData) then + begin + // string tables are a concatenation of maximum 16 prefixed-length widestrings + ResSize := SizeofResource(hModule, ResInfo) div 2; + ResIndex := 0; + // iterate all concatenated strings + while ResIndex < ResSize do + begin + StrLength := ResData^; + Inc(ResData); + Inc(ResIndex); + if (StrLength >= MatchLen) and + (StrLICompW(PWideChar(lParam^.StartStr), PWideChar(ResData), MatchLen) = 0) then + begin + // we have a match + SetLength(lParam^.MatchStr, StrLength); + Move(ResData^, lParam^.MatchStr[1], StrLength * SizeOf(lParam^.MatchStr[1])); + Result := False; + Break; + end; + Inc(ResData, StrLength); + Inc(ResIndex, StrLength); + end; + end; + end; + end; +end; + +// find in specified module "FileName" a resourcestring starting with StartStr +function FindResStart(const FileName: string; const StartStr: WideString): WideString; +var + H: HMODULE; + FindResRec: TFindResStartRec; +begin + FindResRec.StartStr := StartStr; + FindResRec.MatchStr := ''; + + H := LoadLibraryEx(PChar(FileName), 0, LOAD_LIBRARY_AS_DATAFILE or DONT_RESOLVE_DLL_REFERENCES); + if H <> 0 then + try + EnumResourceNames(H, RT_STRING, @FindResStartCallBack, LPARAM(@FindResRec)); + finally + FreeLibrary(H); + end; + + Result := FindResRec.MatchStr; +end; +{$ENDIF MSWINDOWS} + +//=== { TJclBorlandCommandLineTool } ========================================= + +constructor TJclBorlandCommandLineTool.Create(const ABinDirectory: string; ALongPathBug: Boolean; + ACompilerSettingsFormat: TJclCompilerSettingsFormat); +begin + inherited Create; + FBinDirectory := ABinDirectory; + FLongPathBug := ALongPathBug; + FCompilerSettingsFormat := ACompilerSettingsFormat; + FOptions := TStringList.Create; +end; + +destructor TJclBorlandCommandLineTool.Destroy; +begin + FreeAndNil(FOptions); + inherited Destroy; +end; + +procedure TJclBorlandCommandLineTool.AddPathOption(const Option, Path: string); +var + S: string; + + // path before Delphi 2005 must be shortened + // to avoid the 126 character limit of DCC32 (and eventually other command line tools) + // which shows up with misleading error messages ("Fatal: System.pas not found") or + // might even cause AVs + procedure ConvertToShortPathNames(var Paths: string); + var + List: TStringList; + I: Integer; + begin + {$IFDEF MSWINDOWS} + if LongPathBug then + begin + List := TStringList.Create; + try + StrToStrings(Paths, PathSep, List); + for I := 0 to List.Count - 1 do + List[I] := PathGetShortName(List[I]); + Paths := StringsToStr(List, PathSep); + finally + List.Free; + end; + end; + {$ENDIF MSWINDOWS} + end; + +begin + S := PathRemoveSeparator(Path); + ConvertToShortPathNames(S); + { TODO : If we were sure that options are always case-insensitive + for Borland tools, we could use UpperCase(Option) below. } + S := Format('-%s"%s"', [Option, S]); + // avoid duplicate entries + if Options.IndexOf(S) = -1 then + Options.Add(S); +end; + +procedure TJclBorlandCommandLineTool.CheckOutputValid; +begin + if Assigned(FOutputCallback) then + raise EJclCommandLineToolError.CreateResFmt(@RsECmdLineToolOutputInvalid, [GetExeName]); +end; + +function TJclBorlandCommandLineTool.Execute(const CommandLine: string): Boolean; +begin + if Assigned(FOnBeforeExecute) then + FOnBeforeExecute(Self); + + Result := InternalExecute(CommandLine); + + if Assigned(FOnAfterExecute) then + FOnAfterExecute(Self); +end; + +function TJclBorlandCommandLineTool.GetExeName: string; +begin + Result := ''; + {$IFDEF MSWINDOWS} + raise EAbstractError.CreateResFmt(@SAbstractError, ['']); // BCB doesn't support abstract keyword + {$ENDIF MSWINDOWS} +end; + +function TJclBorlandCommandLineTool.GetFileName: string; +begin + Result := BinDirectory + GetExeName; + if Pos(' ', Result) > 0 then + Result := AnsiQuotedStr(Result, '"'); +end; + +function TJclBorlandCommandLineTool.GetOptions: TStrings; +begin + Result := FOptions; +end; + +function TJclBorlandCommandLineTool.GetOutput: string; +begin + CheckOutputValid; + Result := FOutput; +end; + +function TJclBorlandCommandLineTool.GetOutputCallback: TTextHandler; +begin + Result := FOutputCallback; +end; + +function TJclBorlandCommandLineTool.InternalExecute(const CommandLine: string): Boolean; +var + LaunchCommand: string; + Options: TJclExecuteCmdProcessOptions; +begin + LaunchCommand := Format('%s %s', [FileName, CommandLine]); + + Options := TJclExecuteCmdProcessOptions.Create(LaunchCommand); + try + if Assigned(FOutputCallback) then + begin + Options.OutputLineCallback := FOutputCallback; + FOutputCallback(LaunchCommand); + Result := ExecuteCmdProcess(Options) and (Options.ExitCode = 0); + end + else + begin + Result := ExecuteCmdProcess(Options) and (Options.ExitCode = 0); + FOutput := FOutput + Options.Output; + end; + finally + Options.Free; + end; +end; + +procedure TJclBorlandCommandLineTool.SetOutputCallback(const CallbackMethod: TTextHandler); +begin + FOutputCallback := CallbackMethod; +end; + +//=== { TJclBCC32 } ============================================================ + +function TJclBCC32.GetExeName: string; +begin + Result := BCC32ExeName; +end; + +class function TJclBCC32.GetPlatform: string; +begin + Result := BDSPlatformWin32; +end; + +//=== { TJclBCC32 } ============================================================ + +function TJclBCC32C.GetExeName: string; +begin + Result := BCC32CExeName; +end; + +class function TJclBCC32C.GetPlatform: string; +begin + Result := BDSPlatformWin32; // same name as bcc32, the IDE uses the Clang32Suffix suffix in value names +end; + +//=== { TJclBCC64 } ============================================================ + +function TJclBCC64.GetExeName: string; +begin + Result := BCC64ExeName; +end; + +class function TJclBCC64.GetPlatform: string; +begin + Result := BDSPlatformWin64; +end; + +//=== { TJclBCC64X } ============================================================ + +function TJclBCC64X.GetExeName: string; +begin + Result := BCC64XExeName; +end; + +class function TJclBCC64X.GetPlatform: string; +begin + Result := BDSPlatformWin64x; +end; + +//=== { TJclDCC32 } ============================================================ + +function TJclDCC32.AddDProjOptions(const ProjectFileName: string; var ProjectOptions: TProjectOptions): Boolean; +var + DProjFileName, PersonalityName: string; + MsBuildOptions: TJclMsBuildParser; + ProjectExtensionsNode, PersonalityNode: TJclSimpleXMLElem; +begin + DProjFileName := ChangeFileExt(ProjectFileName, SourceExtensionDProject); + Result := FileExists(DProjFileName) and (CompilerSettingsFormat = csfMsBuild); + if Result then + begin + MsBuildOptions := TJclMsBuildParser.Create(DProjFileName); + try + MsBuildOptions.Init; + if SupportsPlatform then + MsBuildOptions.Properties.GlobalProperties.Values['Platform'] := GetPlatform; + + if Assigned(FOnEnvironmentVariables) then + MsBuildOptions.Properties.EnvironmentProperties.Assign(FOnEnvironmentVariables); + + MsBuildOptions.Parse; + + PersonalityName := ''; + ProjectExtensionsNode := MsBuildOptions.ProjectExtensions; + if Assigned(ProjectExtensionsNode) then + begin + PersonalityNode := ProjectExtensionsNode.Items.ItemNamed[DProjPersonalityNodeName]; + if Assigned(PersonalityNode) then + PersonalityName := PersonalityNode.Value; + end; + if StrHasPrefix(PersonalityName, [DProjDelphiPersonalityValue]) or + AnsiSameText(PersonalityName, DProjDelphiDotNetPersonalityValue) then + begin + ProjectOptions.DynamicPackages := MsBuildOptions.Properties.Values[DProjUsePackageNodeName]; + ProjectOptions.UsePackages := ProjectOptions.DynamicPackages <> ''; + ProjectOptions.UnitOutputDir := MsBuildOptions.Properties.Values[DProjDcuOutputDirNodeName]; + ProjectOptions.SearchPath := MsBuildOptions.Properties.Values[DProjUnitSearchPathNodeName]; + ProjectOptions.Conditionals := MsBuildOptions.Properties.Values[DProjDefineNodeName]; + ProjectOptions.Namespace := MsBuildOptions.Properties.Values[DProjNamespaceNodeName]; + end; + finally + MsBuildOptions.Free; + end; + end; +end; + +function TJclDCC32.AddBDSProjOptions(const ProjectFileName: string; var ProjectOptions: TProjectOptions): Boolean; +var + BDSProjFileName, PersonalityName: string; + OptionsXmlFile: TJclSimpleXML; + PersonalityInfoNode, OptionNode, ChildNode, PersonalityNode, DirectoriesNode: TJclSimpleXMLElem; + NodeIndex: Integer; + NameProperty: TJclSimpleXMLProp; +begin + BDSProjFileName := ChangeFileExt(ProjectFileName, SourceExtensionBDSProject); + Result := FileExists(BDSProjFileName); + if Result then + begin + OptionsXmlFile := TJclSimpleXML.Create; + try + OptionsXmlFile.LoadFromFile(BDSProjFileName); + OptionsXmlFile.Options := OptionsXmlFile.Options - [sxoAutoCreate]; + PersonalityInfoNode := OptionsXmlFile.Root.Items.ItemNamed[BDSProjPersonalityInfoNodeName]; + PersonalityName := ''; + if Assigned(PersonalityInfoNode) then + begin + OptionNode := PersonalityInfoNode.Items.ItemNamed[BDSProjOptionNodeName]; + if Assigned(OptionNode) then + for NodeIndex := 0 to OptionNode.Items.Count - 1 do + begin + ChildNode := OptionNode.Items.Item[NodeIndex]; + if SameText(ChildNode.Name, BDSProjOptionNodeName) then + begin + NameProperty := ChildNode.Properties.ItemNamed[BDSProjNameProperty]; + if Assigned(NameProperty) and SameText(NameProperty.Value, BDSProjPersonalityValue) then + begin + PersonalityName := ChildNode.Value; + Break; + end; + end; + end; + end; + if PersonalityName <> '' then + begin + PersonalityNode := OptionsXmlFile.Root.Items.ItemNamed[PersonalityName]; + if Assigned(PersonalityNode) then + begin + DirectoriesNode := PersonalityNode.Items.ItemNamed[BDSProjDirectoriesNodeName]; + if Assigned(DirectoriesNode) then + for NodeIndex := 0 to DirectoriesNode.Items.Count - 1 do + begin + ChildNode := DirectoriesNode.Items.Item[NodeIndex]; + if SameText(ChildNode.Name, BDSProjDirectoriesNodeName) then + begin + NameProperty := ChildNode.Properties.ItemNamed[BDSProjNameProperty]; + if Assigned(NameProperty) then + begin + if SameText(NameProperty.Value, BDSProjUnitOutputDirValue) then + ProjectOptions.UnitOutputDir := ChildNode.Value + else + if SameText(NameProperty.Value, BDSProjSearchPathValue) then + ProjectOptions.SearchPath := ChildNode.Value + else + if SameText(NameProperty.Value, BDSProjPackagesValue) then + ProjectOptions.DynamicPackages := ChildNode.Value + else + if SameText(NameProperty.Value, BDSProjConditionalsValue) then + ProjectOptions.Conditionals := ChildNode.Value + else + if SameText(NameProperty.Value, BDSProjUsePackagesValue) then + ProjectOptions.UsePackages := StrToBoolean(ChildNode.Value); + ProjectOptions.Namespace := ''; + end; + end; + end; + end; + end; + finally + OptionsXmlFile.Free; + end; + end; +end; + +function TJclDCC32.AddDOFOptions(const ProjectFileName: string; var ProjectOptions: TProjectOptions): Boolean; +var + DOFFileName: string; + OptionsFile: TIniFile; +begin + DOFFileName := ChangeFileExt(ProjectFileName, SourceExtensionDOFProject); + Result := FileExists(DOFFileName); + if Result then + begin + OptionsFile := TIniFile.Create(DOFFileName); + try + ProjectOptions.SearchPath := OptionsFile.ReadString(DOFDirectoriesSection, DOFSearchPathName, ''); + ProjectOptions.UnitOutputDir := OptionsFile.ReadString(DOFDirectoriesSection, DOFUnitOutputDirKey, ''); + ProjectOptions.Conditionals := OptionsFile.ReadString(DOFDirectoriesSection, DOFConditionals, ''); + ProjectOptions.UsePackages := OptionsFile.ReadString(DOFCompilerSection, DOFPackageNoLinkKey, '') = '1'; + ProjectOptions.DynamicPackages := OptionsFile.ReadString(DOFLinkerSection, DOFPackagesKey, ''); + ProjectOptions.Namespace := ''; + finally + OptionsFile.Free; + end; + end; +end; + +procedure TJclDCC32.AddProjectOptions(const ProjectFileName, DCPPath: string); +var + ProjectOptions: TProjectOptions; +begin + ProjectOptions.UsePackages := False; + ProjectOptions.UnitOutputDir := ''; + ProjectOptions.SearchPath := ''; + ProjectOptions.DynamicPackages := ''; + ProjectOptions.SearchDcpPath := ''; + ProjectOptions.Conditionals := ''; + ProjectOptions.Namespace := ''; + + if AddDProjOptions(ProjectFileName, ProjectOptions) or + AddBDSProjOptions(ProjectFileName, ProjectOptions) or + AddDOFOptions(ProjectFileName, ProjectOptions) then + begin + if ProjectOptions.UnitOutputDir <> '' then + begin + if DCCVersion >= 24.0 then // XE3+ + AddPathOption('NU', ProjectOptions.UnitOutputDir) + else + AddPathOption('N', ProjectOptions.UnitOutputDir); + end; + if ProjectOptions.SearchPath <> '' then + begin + AddPathOption('I', ProjectOptions.SearchPath); + AddPathOption('R', ProjectOptions.SearchPath); + end; + if ProjectOptions.Conditionals <> '' then + Options.Add(Format('-D%s', [ProjectOptions.Conditionals])); + if SamePath(DCPPath, DCPSearchPath) then + ProjectOptions.SearchDcpPath := DCPPath + else + ProjectOptions.SearchDcpPath := StrEnsureSuffix(PathSep, DCPPath) + DCPSearchPath; + AddPathOption('U', StrEnsureSuffix(PathSep, ProjectOptions.SearchDcpPath) + ProjectOptions.SearchPath); + if ProjectOptions.UsePackages and (ProjectOptions.DynamicPackages <> '') then + Options.Add(Format('-LU"%s"', [ProjectOptions.DynamicPackages])); + if ProjectOptions.Namespace <> '' then + Options.Add('-ns' + ProjectOptions.Namespace); + end; +end; + +function TJclDCC32.Compile(const ProjectFileName: string): Boolean; +begin + // Note: PathGetShortName may not return the short path if it's a network + // drive. Hence we always double quote the path, regardless of the compiling + // environment. + Result := Execute(StrDoubleQuote(StrTrimQuotes(ProjectFileName))); +end; + +constructor TJclDCC32.Create(const ABinDirectory: string; ALongPathBug: Boolean; ADCCVersion: Single; + ACompilerSettingsFormat: TJclCompilerSettingsFormat; ASupportsNoConfig, ASupportsPlatform: Boolean; + const ADCPSearchPath, ALibrarySearchPath, ALibraryDebugSearchPath, ACppSearchPath: string); +begin + inherited Create(ABinDirectory, ALongPathBug, ACompilerSettingsFormat); + FDCCVersion := ADCCVersion; + FSupportsNoConfig := ASupportsNoConfig; + FSupportsPlatform := ASupportsPlatform; + FDCPSearchPath := ADCPSearchPath; + FLibrarySearchPath := ALibrarySearchPath; + FLibraryDebugSearchPath := ALibraryDebugSearchPath; + FCppSearchPath := ACppSearchPath; + SetDefaultOptions(False); // in case $(DELPHI)\bin\dcc32.cfg (replace as appropriate) is invalid +end; + +function TJclDCC32.Execute(const CommandLine: string): Boolean; + + function IsPathOption(const S: string; out Len: Integer): Boolean; + begin + Result := False; + if (Length(S) >= 2) and (S[1] = '-') then + case UpCase(S[2]) of + 'E', 'I', 'O', 'R', 'U': + begin + Result := True; + Len := 2; + end; + 'L': + if Length(S) >= 3 then + begin + case UpCase(S[3]) of + 'E', 'e', + 'N', 'n': + Result := True; + else + Result := False; + end; + Len := 3; + end; + 'N': + begin + Result := True; + if Length(S) >= 3 then + begin + case Upcase(S[3]) of + 'U', 'X': // -NU -NX + if DCCVersion >= 24.0 then // XE3+ + Len := 3 + else + Len := 2; + '0'..'9', + 'H', 'O', 'B': + Len := 3; + 'S': // -NS + if DCCVersion >= 23.0 then // XE2+ + Len := 3 + else + Len := 2; + else + Len := 2; + end; + end; + end; + end; + end; + +var + OptionIndex, PathIndex, SwitchLen: Integer; + PathList: TStrings; + Option, Arguments, CurrentFolder: string; +begin + if Assigned(FOnBeforeExecute) then + FOnBeforeExecute(Self); + + FOutput := ''; + Arguments := ''; + CurrentFolder := PathGetShortName(GetCurrentFolder); // used if LongPathBug is True + + PathList := TStringList.Create; + try + for OptionIndex := 0 to Options.Count - 1 do + begin + Option := Options.Strings[OptionIndex]; + if IsPathOption(Option, SwitchLen) then + begin + StrToStrings(StrTrimQuotes(Copy(Option, SwitchLen + 1, Length(Option) - SwitchLen)), PathSep, PathList); + if LongPathBug then + // change to relative paths to avoid DCC32 126 character path limit + for PathIndex := 0 to PathList.Count - 1 do + PathList.Strings[PathIndex] := PathGetRelativePath(CurrentFolder, ExpandFileName(PathList[PathIndex])); + if PathList.Count > 0 then + Arguments := Format('%s %s"%s"', [Arguments, Copy(Option, 1, SwitchLen), + StringsToStr(PathList, PathSep)]); + end + else + Arguments := Format('%s %s', [Arguments, Option]); + end; + finally + PathList.Free; + end; + + Result := InternalExecute(CommandLine + Arguments); + + if Assigned(FOnAfterExecute) then + FOnAfterExecute(Self); +end; + +function TJclDCC32.GetExeName: string; +begin + Result := DCC32ExeName; +end; + +class function TJclDCC32.GetPlatform: string; +begin + Result := BDSPlatformWin32; +end; + +function TJclDCC32.MakePackage(const PackageName, BPLPath, DCPPath: string; ExtraOptions: string = ''; ADebug: Boolean = False): Boolean; +var + SaveDir: string; + ConfigurationFileName, BackupFileName: string; +begin + SaveDir := GetCurrentDir; + SetCurrentDir(ExtractFilePath(PackageName) + '.'); + try + // backup existing configuration file, if any + ConfigurationFileName := ChangeFileExt(PackageName, SourceExtensionConfiguration); + if FileExists(ConfigurationFileName) then + FileBackup(ConfigurationFileName, True); + + Options.Clear; + SetDefaultOptions(ADebug); + AddProjectOptions(PackageName, DCPPath); + try + AddPathOption('LN', DCPPath); + AddPathOption('LE', BPLPath); + Options.Add(ExtraOptions); + Result := Compile(PackageName); + finally + // restore existing configuration file, if any + BackupFileName := GetBackupFileName(ConfigurationFileName); + if FileExists(BackupFileName) then + FileMove(BackupFileName, ConfigurationFileName, True); + end; + finally + SetCurrentDir(SaveDir); + end; +end; + +function TJclDCC32.MakeProject(const ProjectName, OutputDir, DcpSearchPath: string; + ExtraOptions: string = ''; ADebug: Boolean = False): Boolean; +var + SaveDir: string; + ConfigurationFileName, BackupFileName: string; +begin + SaveDir := GetCurrentDir; + SetCurrentDir(ExtractFilePath(ProjectName) + '.'); + try + // backup existing configuration file, if any + ConfigurationFileName := ChangeFileExt(ProjectName, SourceExtensionConfiguration); + if FileExists(ConfigurationFileName) then + FileBackup(ConfigurationFileName, True); + + Options.Clear; + SetDefaultOptions(ADebug); + AddProjectOptions(ProjectName, DcpSearchPath); + try + AddPathOption('E', OutputDir); + Options.Add(ExtraOptions); + Result := Compile(ProjectName); + finally + // restore existing configuration file, if any + BackupFileName := GetBackupFileName(ConfigurationFileName); + if FileExists(BackupFileName) then + FileMove(BackupFileName, ConfigurationFileName, True); + end; + finally + SetCurrentDir(SaveDir); + end; +end; + +procedure TJclDCC32.SetDefaultOptions(ADebug: Boolean); +begin + Options.Clear; + if SupportsNoConfig then + Options.Add('--no-config'); + if ADebug then + AddPathOption('U', LibraryDebugSearchPath); + AddPathOption('U', LibrarySearchPath); + if CppSearchPath <> '' then + begin + AddPathOption('U', CppSearchPath); + Options.Add('-LUrtl'); + end; +end; + +//=== { TJclDCC64 } ========================================================== + +class function TJclDCC64.GetPlatform: string; +begin + Result := BDSPlatformWin64; +end; + +function TJclDCC64.GetExeName: string; +begin + Result := DCC64ExeName; +end; + +//=== { TJclDCCOSX32 } ======================================================= + +class function TJclDCCOSX32.GetPlatform: string; +begin + Result := BDSPlatformOSX32; +end; + +function TJclDCCOSX32.GetExeName: string; +begin + Result := DCCOSX32ExeName; +end; + +//=== { TJclDCCOSX64 } ======================================================= + +class function TJclDCCOSX64.GetPlatform: string; +begin + Result := BDSPlatformOSX64; +end; + +function TJclDCCOSX64.GetExeName: string; +begin + Result := DCCOSX64ExeName; +end; + +//=== { TJclDCCiOSSimulator } ======================================================= + +class function TJclDCCiOSSimulator.GetPlatform: string; +begin + Result := BDSPlatformiOSSimulator; +end; + +function TJclDCCiOSSimulator.GetExeName: string; +begin + Result := DCCiOSSimulatorExeName; +end; + +//=== { TJclDCCiOS32 } ======================================================= + +class function TJclDCCiOS32.GetPlatform: string; +begin + Result := BDSPlatformiOSDevice32; +end; + +function TJclDCCiOS32.GetExeName: string; +begin + Result := DCCiOS32ExeName; +end; + +//=== { TJclDCCiOS64 } ======================================================= + +class function TJclDCCiOS64.GetPlatform: string; +begin + Result := BDSPlatformiOSDevice64; +end; + +function TJclDCCiOS64.GetExeName: string; +begin + Result := DCCiOS64ExeName; +end; + +//=== { TJclDCCArm32 } ======================================================= + +class function TJclDCCArm32.GetPlatform: string; +begin + Result := BDSPlatformAndroid32; +end; + +function TJclDCCArm32.GetExeName: string; +begin + Result := DCCArm32ExeName; +end; + +//=== { TJclDCCArm64 } ======================================================= + +class function TJclDCCArm64.GetPlatform: string; +begin + Result := BDSPlatformAndroid64; +end; + +function TJclDCCArm64.GetExeName: string; +begin + Result := DCCArm64ExeName; +end; + +//=== { TJclDCCLinux64 } ======================================================= + +class function TJclDCCLinux64.GetPlatform: string; +begin + Result := BDSPlatformLinux64; +end; + +function TJclDCCLinux64.GetExeName: string; +begin + Result := DCCLinux64ExeName; +end; + +{$IFDEF MSWINDOWS} +//=== { TJclDCCIL } ========================================================== + +function TJclDCCIL.GetExeName: string; +begin + Result := DCCILExeName; +end; + +function TJclDCCIL.GetMaxCLRVersion: string; +var + StartPos, EndPos: Integer; +begin + if FMaxCLRVersion <> '' then + begin + Result := FMaxCLRVersion; + Exit; + end; + + Result := FindResStart(BinDirectory + GetExeName, ' --clrversion'); + + StartPos := Pos(':', Result); + if StartPos = 0 then + StartPos := Pos('=', Result); + + if StartPos > 0 then + Result := Copy(Result, StartPos + 1, Length(Result) - StartPos); + + EndPos := Pos(' ', Result); + if EndPos > 0 then + SetLength(Result, EndPos - 1); + + if Result = '' then + Result := 'v1.1.4322'; // do not localize + + FMaxCLRVersion := Result; +end; + +function TJclDCCIL.MakeProject(const ProjectName, OutputDir, + ExtraOptions: string; ADebug: Boolean = False): Boolean; +var + SaveDir: string; +begin + SaveDir := GetCurrentDir; + SetCurrentDir(ExtractFilePath(ProjectName) + '.'); + try + Options.Clear; + SetDefaultOptions(ADebug); + AddProjectOptions(ProjectName, ''); + AddPathOption('E', OutputDir); + Options.Add(ExtraOptions); + Result := Compile(ProjectName); + finally + SetCurrentDir(SaveDir); + end; +end; + +procedure TJclDCCIL.SetDefaultOptions(ADebug: Boolean); +begin + Options.Clear; + if ADebug then + AddPathOption('U', LibraryDebugSearchPath); + AddPathOption('U', LibrarySearchPath); +end; + +{$ENDIF MSWINDOWS} + +//=== { TJclBorlandMake } ==================================================== + +function TJclBorlandMake.GetExeName: string; +begin + Result := MakeExeName; +end; + +//=== { TJclBpr2Mak } ======================================================== + +function TJclBpr2Mak.GetExeName: string; +begin + Result := Bpr2MakExeName; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclComplex.pas b/3rdParty/JCL/source/common/JclComplex.pas new file mode 100644 index 00000000..492e61f6 --- /dev/null +++ b/3rdParty/JCL/source/common/JclComplex.pas @@ -0,0 +1,1584 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclComplex.pas. } +{ } +{ The Initial Developer of the Original Code is Alexei Koudinov. Portions created by } +{ Alexei Koudinov are Copyright (C) of Alexei Koudinov. All Rights Reserved. } +{ } +{ Contributor(s): } +{ Marcel van Brakel } +{ Alexei Koudinov } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ } +{**************************************************************************************************} +{ } +{ Class for working with complex numbers. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclComplex; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclMath, JclResources, JclStrings; + +const + TComplex_VERSION = 5.01; + +type + TComplexKind = (crRectangular, crPolar); + + TCoords = record + X: Float; // rectangular real + Y: Float; // rectangular imaginary + R: Float; // polar radius + Theta: Float; // polar angle + end; + + TRectCoord = record + X: Float; + Y: Float; + end; + + TJclComplex = class(TObject) + private {z = x + yi} + FCoord: TCoords; + FFracLen: Byte; + function MiscalcFloat(const X: Float): Float; + procedure MiscalcComplex; // eliminates miscalculation + procedure FillCoords(const ComplexType: TComplexKind); + function GetRectangularString: string; + function GetPolarString: string; + procedure SetRectangularString(StrToParse: string); + procedure SetPolarString(StrToParse: string); + procedure SetFracLen(const X: Byte); + function GetRadius: Float; + function GetAngle: Float; + function NormalizeAngle(const Value: Float): Float; + protected + function Assign(const Coord: TCoords; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload; + function CoreAdd(const First, Second: TRectCoord): TRectCoord; + function CoreDiv(const First, Second: TRectCoord): TRectCoord; + function CoreMul(const First, Second: TRectCoord): TRectCoord; + function CoreSub(const First, Second: TRectCoord): TRectCoord; + function CoreLn (const LnValue: TRectCoord): TRectCoord; + function CoreExp(const ExpValue: TRectCoord): TRectCoord; + function CorePwr(First, Second, Polar: TRectCoord): TRectCoord; + function CoreIntPwr(First: TRectCoord; const Polar: TRectCoord; const Pwr: Integer): TRectCoord; + function CoreRealPwr(First: TRectCoord; const Polar: TRectCoord; const Pwr: Float): TRectCoord; + function CoreRoot(First: TRectCoord; const Polar: TRectCoord; const K, N: Word): TRectCoord; + function CoreCos(const Value: TRectCoord): TRectCoord; + function CoreSin(const Value: TRectCoord): TRectCoord; + function CoreTan(const Value: TRectCoord): TRectCoord; + function CoreCot(const Value: TRectCoord): TRectCoord; + function CoreSec(const Value: TRectCoord): TRectCoord; + function CoreCsc(const Value: TRectCoord): TRectCoord; + function CoreCosH(const Value: TRectCoord): TRectCoord; + function CoreSinH(const Value: TRectCoord): TRectCoord; + function CoreTanH(const Value: TRectCoord): TRectCoord; + function CoreCotH(const Value: TRectCoord): TRectCoord; + function CoreSecH(const Value: TRectCoord): TRectCoord; + function CoreCscH(const Value: TRectCoord): TRectCoord; + function CoreI0(const Value: TRectCoord): TRectCoord; + function CoreJ0(const Value: TRectCoord): TRectCoord; + function CoreApproxLnGamma(const Value: TRectCoord): TRectCoord; + function CoreLnGamma(Value: TRectCoord): TRectCoord; + function CoreGamma(const Value: TRectCoord): TRectCoord; + public + //----------- constructors + constructor Create; overload; + constructor Create(const X, Y: Float; const ComplexType: TComplexKind = crRectangular); overload; + + //----------- complex numbers assignment routines + function Assign(const X, Y: Float; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload; + function AssignZero: TJclComplex; + function AssignOne: TJclComplex; + function Duplicate: TJclComplex; + + //----------- arithmetics -- modify the object itself + function CAdd(const AddValue: TJclComplex): TJclComplex; overload; + function CAdd(const X, Y: Float; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload; + function CDiv(const DivValue: TJclComplex): TJclComplex; overload; + function CDiv(const X, Y: Float; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload; + function CMul(const MulValue: TJclComplex): TJclComplex; overload; + function CMul(const X, Y: Float; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload; + function CSub(const SubValue: TJclComplex): TJclComplex; overload; + function CSub(const X, Y: Float; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload; + function CNeg: TJclComplex; + function CConjugate: TJclComplex; + + //----------- arithmetics -- creates new resulting object + function CNewAdd(const AddValue: TJclComplex): TJclComplex; overload; + function CNewAdd(const X, Y: Float; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload; + function CNewDiv(const DivValue: TJclComplex): TJclComplex; overload; + function CNewDiv(const X, Y: Float; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload; + function CNewMul(const MulValue: TJclComplex): TJclComplex; overload; + function CNewMul(const X, Y: Float; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload; + function CNewSub(const SubValue: TJclComplex): TJclComplex; overload; + function CNewSub(const X, Y: Float; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload; + function CNewNeg: TJclComplex; + function CNewConjugate: TJclComplex; + + //----------- natural log and exponential functions -- modify the object itself + function CLn: TJclComplex; + function CExp: TJclComplex; + function CPwr(const PwrValue: TJclComplex): TJclComplex; overload; + function CPwr(const X, Y: Float; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload; + function CIntPwr(const Pwr: Integer): TJclComplex; + function CRealPwr(const Pwr: Float): TJclComplex; + function CRoot(const K, N: Word): TJclComplex; + function CSqrt: TJclComplex; + + //----------- natural log and exponential functions -- create new resulting object + function CNewLn: TJclComplex; + function CNewExp: TJclComplex; + function CNewPwr(PwrValue: TJclComplex): TJclComplex; overload; + function CNewPwr(const X, Y: Float; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload; + function CNewIntPwr(const Pwr: Integer): TJclComplex; + function CNewRealPwr(const Pwr: Float): TJclComplex; + function CNewRoot(const K, N: Word): TJclComplex; + function CNewSqrt: TJclComplex; + + //----------- trigonometric functions -- modify the object itself + function CCos: TJclComplex; + function CSin: TJclComplex; + function CTan: TJclComplex; + function CCot: TJclComplex; + function CSec: TJclComplex; + function CCsc: TJclComplex; + + //----------- trigonometric functions -- create new resulting object + function CNewCsc: TJclComplex; + function CNewCos: TJclComplex; + function CNewSin: TJclComplex; + function CNewTan: TJclComplex; + function CNewCot: TJclComplex; + function CNewSec: TJclComplex; + + //----------- complex hyperbolic functions -- modify the object itself + function CCosH: TJclComplex; + function CSinH: TJclComplex; + function CTanH: TJclComplex; + function CCotH: TJclComplex; + function CSecH: TJclComplex; + function CCscH: TJclComplex; + + //----------- complex hyperbolic functions -- create new resulting object + function CNewCosH: TJclComplex; + function CNewSinH: TJclComplex; + function CNewTanH: TJclComplex; + function CNewCotH: TJclComplex; + function CNewSecH: TJclComplex; + function CNewCscH: TJclComplex; + + //----------- complex Bessel functions of order zero -- modify the object itself + function CI0: TJclComplex; + function CJ0: TJclComplex; + + //----------- complex Bessel functions of order zero -- create new resulting object + function CNewI0: TJclComplex; + function CNewJ0: TJclComplex; + + //----------- complex Gamma functions -- modify the object itself + function CApproxLnGamma: TJclComplex; + function CLnGamma: TJclComplex; + function CGamma: TJclComplex; + + //----------- complex Gamma functions -- create new resulting object + function CNewApproxLnGamma: TJclComplex; + function CNewLnGamma: TJclComplex; + function CNewGamma: TJclComplex; + + //----------- miscellaneous routines + function AbsoluteValue: Float; overload; + function AbsoluteValue(const Coord: TRectCoord): Float; overload; + function AbsoluteValueSqr: Float; overload; + function AbsoluteValueSqr(const Coord: TRectCoord): Float; overload; + function FormatExtended(const X: Float): string; + + property FracLength: Byte read FFracLen write SetFracLen default 8; + + //----------- getting different parts of the number + property RealPart: Float read FCoord.X; + property ImaginaryPart: Float read FCoord.Y; + property Radius: Float read GetRadius; + property Angle: Float read GetAngle; + + //----------- format output + property AsString: string read GetRectangularString write SetRectangularString; + property AsPolarString: string read GetPolarString write SetPolarString; + end; + +var + ComplexPrecision: Float = 1E-14; + +const + MaxTerm: Byte = 35; + EpsilonSqr: Float = 1E-20; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +const + MaxFracLen = 18; + RectOne: TRectCoord = (X: 1.0; Y: 0.0); + RectZero: TRectCoord = (X: 0.0; Y: 0.0); + RectInfinity: TRectCoord = (X: Infinity; Y: Infinity); + +function Coordinates(const cX, cY: Float; CoordType: TComplexKind): TCoords; +begin + case CoordType of + crRectangular: + begin + Result.X := cX; + Result.Y := cY; + Result.R := 0.0; + Result.Theta := 0.0; + end; + crPolar: + begin + Result.X := 0.0; + Result.Y := 0.0; + Result.R := cX; + Result.Theta := cY; + end; + end; +end; + +function RectCoord(const X, Y: Float): TRectCoord; overload; +begin + Result.X := X; + Result.Y := Y; +end; + +function RectCoord(Value: TJclComplex): TRectCoord; overload; +begin + Result.X := Value.FCoord.X; + Result.Y := Value.FCoord.Y; +end; + +//=== { TJclComplex } ======================================================== + +constructor TJclComplex.Create; +begin + inherited Create; + AssignZero; + FFracLen := MaxFracLen; +end; + +constructor TJclComplex.Create(const X, Y: Float; const ComplexType: TComplexKind); +begin + inherited Create; + Assign(X, Y, ComplexType); + FFracLen := MaxFracLen; +end; + +procedure TJclComplex.FillCoords(const ComplexType: TComplexKind); +begin + MiscalcComplex; + case ComplexType of + crPolar: + begin + FCoord.X := FCoord.R * JclMath.Cos(FCoord.Theta); + FCoord.Y := FCoord.R * JclMath.Sin(FCoord.Theta); + end; + crRectangular: + if FCoord.X = 0.0 then + begin + FCoord.R := Abs(FCoord.Y); + if FCoord.Y <> 0 then + FCoord.Theta := PiOn2 * Sgn(FCoord.Y) + else + FCoord.Theta := PiOn2; // Fixes corner case where Sgn(0) = 0 + end + else + begin + FCoord.R := AbsoluteValue; + FCoord.Theta := System.ArcTan(FCoord.Y / FCoord.X); + if FCoord.X < 0.0 then + begin + if FCoord.Y <> 0 then + FCoord.Theta := FCoord.Theta + Pi * Sgn(FCoord.Y) + else + FCoord.Theta := FCoord.Theta + Pi; // Fixes corner case where Sgn(0) = 0 + end; + end; + end; + MiscalcComplex; +end; + +function TJclComplex.MiscalcFloat(const X: Float): Float; +begin + Result := X; + if Abs(Result) < ComplexPrecision then + Result := 0.0; +end; + +procedure TJclComplex.MiscalcComplex; // eliminates miscalculation +begin + FCoord.X := MiscalcFloat(FCoord.X); + FCoord.Y := MiscalcFloat(FCoord.Y); + FCoord.R := MiscalcFloat(FCoord.R); + if FCoord.R = 0.0 then + FCoord.Theta := 0.0 + else + FCoord.Theta := MiscalcFloat(FCoord.Theta); +end; + +function TJclComplex.Assign(const X, Y: Float; const ComplexType: TComplexKind): TJclComplex; +begin + Result := Assign(Coordinates(X, Y, ComplexType), ComplexType); +end; + +function TJclComplex.Assign(const Coord: TCoords; const ComplexType: TComplexKind): TJclComplex; +begin + FCoord := Coord; + FillCoords(ComplexType); + MiscalcComplex; + Result := Self; +end; + +function TJclComplex.AssignZero: TJclComplex; +begin + Result := Assign(0.0, 0.0, crRectangular); +end; + +function TJclComplex.AssignOne: TJclComplex; +begin + Result := Assign(1.0, 0.0, crRectangular); +end; + +function TJclComplex.GetRectangularString: string; +const + cImaginary = 'i'; +begin + MiscalcComplex; + if (FCoord.X = 0.0) and (FCoord.Y = 0.0) then + Result := '0' + else + if FCoord.X <> 0.0 then + begin + Result := FormatExtended(FCoord.X); + if FCoord.Y > 0.0 then + Result := Result + '+' + else + if FCoord.Y < 0.0 then + Result := Result + '-'; + if FCoord.Y <> 0.0 then + Result := Result + FormatExtended(Abs(FCoord.Y)) + cImaginary; + end + else + Result := FormatExtended(FCoord.Y) + cImaginary; +end; + +function TJclComplex.GetPolarString: string; +begin + FillCoords(crRectangular); + Result := FormatExtended(FCoord.R) + '*CIS(' + FormatExtended(FCoord.Theta) + ')'; +end; + +procedure TJclComplex.SetRectangularString(StrToParse: string); +var + SignPos: Integer; + RealPart, ImagPart: Float; +begin + StrToParse := StrRemoveChars(StrToParse, CharIsSpace); + SignPos := StrFind('+', StrToParse, 2); + if SignPos = 0 then + SignPos := StrFind('-', StrToParse, 2); + if SignPos > 0 then + begin + try + RealPart := StrToFloat(Copy(StrToParse, 1, SignPos - 1)); + except + raise EJclMathError.CreateRes(@RsComplexInvalidString); + end; + try + ImagPart := StrToFloat(Copy(StrToParse, SignPos, Length(StrToParse) - SignPos)); + except + raise EJclMathError.CreateRes(@RsComplexInvalidString); + end; + end + else + begin + if (StrToParse[Length(StrToParse)] = 'i') or (StrToParse[Length(StrToParse)] = 'I') then + begin + RealPart := 0.0; + try + ImagPart := StrToFloat(Copy(StrToParse, 1, Length(StrToParse) - 1)); + except + raise EJclMathError.CreateRes(@RsComplexInvalidString); + end; + end + else + begin + try + RealPart := StrToFloat(StrToParse); + except + raise EJclMathError.CreateRes(@RsComplexInvalidString); + end; + ImagPart := 0.0; + end; + end; + Assign(RealPart, ImagPart, crRectangular); +end; + +procedure TJclComplex.SetPolarString(StrToParse: string); +var + AstPos: Integer; + Radius, Angle: Float; +begin + StrToParse := AnsiUpperCase(StrRemoveChars(StrToParse, CharIsSpace)); + AstPos := Pos('*', StrToParse); + if AstPos = 0 then + raise EJclMathError.CreateRes(@RsComplexInvalidString); + try + Radius := StrToFloat(StrLeft(StrToParse, AstPos - 1)); + except + raise EJclMathError.CreateRes(@RsComplexInvalidString); + end; + AstPos := Pos('(', StrToParse); + if AstPos = 0 then + raise EJclMathError.CreateRes(@RsComplexInvalidString); + try + Angle := StrToFloat(Copy(StrToParse, AstPos + 1, Length(StrToParse) - AstPos - 1)); + except + raise EJclMathError.CreateRes(@RsComplexInvalidString); + end; + Assign(Radius, Angle, crPolar); +end; + +function TJclComplex.Duplicate: TJclComplex; +begin + Result := TJclComplex.Create(FCoord.X, FCoord.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +//=== arithmetics ============================================================ + +function TJclComplex.CoreAdd(const First, Second: TRectCoord): TRectCoord; +begin + Result.X := First.X + Second.X; + Result.Y := First.Y + Second.Y; +end; + +function TJclComplex.CAdd(const AddValue: TJclComplex): TJclComplex; +var + ResCoord: TRectCoord; +begin + ResCoord := CoreAdd(RectCoord(Self), RectCoord(AddValue)); + FCoord.X := ResCoord.X; + FCoord.Y := ResCoord.Y; + Result := Self; +end; + +function TJclComplex.CAdd(const X, Y: Float; const ComplexType: TComplexKind): TJclComplex; +var + NewComplex: TJclComplex; +begin + NewComplex := TJclComplex.Create(X, Y, ComplexType); + try + Result := CAdd(NewComplex); + finally + NewComplex.Free; + end; +end; + +function TJclComplex.CNewAdd(const AddValue: TJclComplex): TJclComplex; +var + ResCoord: TRectCoord; +begin + ResCoord := CoreAdd(RectCoord(Self), RectCoord(AddValue)); + Result := TJclComplex.Create(ResCoord.X, ResCoord.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CNewAdd(const X, Y: Float; const ComplexType: TComplexKind): TJclComplex; +var + NewComplex: TJclComplex; +begin + NewComplex := TJclComplex.Create(X, Y, ComplexType); + try + Result := CNewAdd(NewComplex); + finally + NewComplex.Free; + end; +end; + +function TJclComplex.CoreDiv(const First, Second: TRectCoord): TRectCoord; +var + Denom: Float; +begin + Denom := Sqr(Second.X) + Sqr(Second.Y); + Result.X := (First.X * Second.X + First.Y * Second.Y) / Denom; + Result.Y := (First.Y * Second.X - First.X * Second.Y) / Denom; +end; + +function TJclComplex.CDiv(const DivValue: TJclComplex): TJclComplex; +var + ResCoord: TRectCoord; +begin + ResCoord := CoreDiv(RectCoord(Self), RectCoord(DivValue)); + FCoord.X := ResCoord.X; + FCoord.Y := ResCoord.Y; + Result := Self; +end; + +function TJclComplex.CDiv(const X, Y: Float; const ComplexType: TComplexKind): TJclComplex; +var + NewComplex: TJclComplex; +begin + NewComplex := TJclComplex.Create(X, Y, ComplexType); + try + Result := CDiv(NewComplex); + finally + NewComplex.Free; + end; +end; + +function TJclComplex.CNewDiv(const DivValue: TJclComplex): TJclComplex; +var + ResCoord: TRectCoord; +begin + ResCoord := CoreDiv(RectCoord(Self), RectCoord(DivValue)); + Result := TJclComplex.Create(ResCoord.X, ResCoord.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CNewDiv(const X, Y: Float; const ComplexType: TComplexKind): TJclComplex; +var + NewComplex: TJclComplex; +begin + NewComplex := TJclComplex.Create(X, Y, ComplexType); + try + Result := CNewDiv(NewComplex); + finally + NewComplex.Free; + end; +end; + +function TJclComplex.CoreMul(const First, Second: TRectCoord): TRectCoord; +begin + Result.X := First.X * Second.X - First.Y * Second.Y; + Result.Y := First.X * Second.Y + First.Y * Second.X; +end; + +function TJclComplex.CMul(const MulValue: TJclComplex): TJclComplex; +var + ResCoord: TRectCoord; +begin + ResCoord := CoreMul(RectCoord(Self), RectCoord(MulValue)); + FCoord.X := ResCoord.X; + FCoord.Y := ResCoord.Y; + Result := Self; +end; + +function TJclComplex.CMul(const X, Y: Float; const ComplexType: TComplexKind): TJclComplex; +var + NewComplex: TJclComplex; +begin + NewComplex := TJclComplex.Create(X, Y, ComplexType); + try + Result := CMul(NewComplex); + finally + NewComplex.Free; + end; +end; + +function TJclComplex.CNewMul(const MulValue: TJclComplex): TJclComplex; +var + ResCoord: TRectCoord; +begin + ResCoord := CoreMul(RectCoord(Self), RectCoord(MulValue)); + Result := TJclComplex.Create(ResCoord.X, ResCoord.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CNewMul(const X, Y: Float; const ComplexType: TComplexKind): TJclComplex; +var + NewComplex: TJclComplex; +begin + NewComplex := TJclComplex.Create(X, Y, ComplexType); + try + Result := CNewMul(NewComplex); + finally + NewComplex.Free; + end; +end; + +function TJclComplex.CoreSub(const First, Second: TRectCoord): TRectCoord; +begin + Result.X := First.X - Second.X; + Result.Y := First.Y - Second.Y; +end; + +function TJclComplex.CSub(const SubValue: TJclComplex): TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreSub(RectCoord(Self), RectCoord(SubValue)); + FCoord.X := ResValue.X; + FCoord.Y := ResValue.Y; + Result := Self; +end; + +function TJclComplex.CSub(const X, Y: Float; const ComplexType: TComplexKind): TJclComplex; +var + NewComplex: TJclComplex; +begin + NewComplex := TJclComplex.Create(X, Y, ComplexType); + try + Result := CSub(NewComplex); + finally + NewComplex.Free; + end; +end; + +function TJclComplex.CNewSub(const SubValue: TJclComplex): TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreSub(RectCoord(Self), RectCoord(SubValue)); + Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CNewSub(const X, Y: Float; const ComplexType: TComplexKind): TJclComplex; +var + NewComplex: TJclComplex; +begin + NewComplex := TJclComplex.Create(X, Y, ComplexType); + try + Result := CNewSub(NewComplex); + finally + NewComplex.Free; + end; +end; + +function TJclComplex.CNeg; +begin + FCoord.X := -FCoord.X; + FCoord.Y := -FCoord.Y; + Result := Self; +end; + +function TJclComplex.CNewNeg; +begin + Result := TJclComplex.Create(-FCoord.X, -FCoord.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CConjugate; +begin + FCoord.Y := -FCoord.Y; + Result := Self; +end; + +function TJclComplex.CNewConjugate; +begin + Result := TJclComplex.Create(FCoord.X, -FCoord.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +//=== natural log and exponential functions ================================== + +function TJclComplex.CoreLn(const LnValue: TRectCoord): TRectCoord; +begin + Result.X := System.Ln(LnValue.X); + Result.Y := NormalizeAngle(LnValue.Y); +end; + +function TJclComplex.CLn: TJclComplex; +var + ResCoord: TRectCoord; +begin + FillCoords(crRectangular); + ResCoord := CoreLn(RectCoord(FCoord.R, FCoord.Theta)); + FCoord.X := ResCoord.X; + FCoord.Y := ResCoord.Y; + Result := Self; +end; + +function TJclComplex.CNewLn: TJclComplex; +var + ResCoord: TRectCoord; +begin + FillCoords(crRectangular); + ResCoord := CoreLn(RectCoord(FCoord.R, FCoord.Theta)); + Result := TJclComplex.Create(ResCoord.X, ResCoord.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CoreExp(const ExpValue: TRectCoord): TRectCoord; +var + ExpX: Float; +begin + ExpX := JclMath.Exp(ExpValue.X); + Result.X := ExpX * JclMath.Cos(ExpValue.Y); + Result.Y := ExpX * JclMath.Sin(ExpValue.Y); +end; + +function TJclComplex.CExp: TJclComplex; +var + ResCoord: TRectCoord; +begin + ResCoord := CoreExp(RectCoord(FCoord.X, FCoord.Y)); + FCoord.X := ResCoord.X; + FCoord.Y := ResCoord.Y; + Result := Self; +end; + +function TJclComplex.CNewExp: TJclComplex; +var + ResCoord: TRectCoord; +begin + ResCoord := CoreExp(RectCoord(FCoord.X, FCoord.Y)); + Result := TJclComplex.Create(ResCoord.X, ResCoord.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CorePwr(First, Second, Polar: TRectCoord): TRectCoord; +begin + First.X := MiscalcFloat(First.X); + First.Y := MiscalcFloat(First.Y); + Second.X := MiscalcFloat(Second.X); + Second.Y := MiscalcFloat(Second.Y); + if AbsoluteValueSqr(First) = 0.0 then + if AbsoluteValueSqr(Second) = 0.0 then + Result := RectOne + else + Result := RectZero + else + Result := CoreExp(CoreMul(Second, CoreLn(Polar))); +end; + +function TJclComplex.CPwr(const PwrValue: TJclComplex): TJclComplex; +var + ResValue: TRectCoord; +begin + FillCoords(crRectangular); + ResValue := CorePwr(RectCoord(Self), RectCoord(PwrValue), RectCoord(FCoord.R, FCoord.Theta)); + FCoord.X := ResValue.X; + FCoord.Y := ResValue.Y; + Result := Self; +end; + +function TJclComplex.CPwr(const X, Y: Float; const ComplexType: TComplexKind): TJclComplex; +var + NewComplex: TJclComplex; +begin + NewComplex := TJclComplex.Create(X, Y, ComplexType); + try + Result := CPwr(NewComplex); + finally + NewComplex.Free; + end; +end; + +function TJclComplex.CNewPwr(PwrValue: TJclComplex): TJclComplex; +var + ResValue: TRectCoord; +begin + FillCoords(crRectangular); + ResValue := CorePwr(RectCoord(Self), RectCoord(PwrValue), RectCoord(FCoord.R, FCoord.Theta)); + Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CNewPwr(const X, Y: Float; const ComplexType: TComplexKind): TJclComplex; +var + NewComplex: TJclComplex; +begin + NewComplex := TJclComplex.Create(X, Y, ComplexType); + try + Result := CNewPwr(NewComplex); + finally + NewComplex.Free; + end; +end; + +function TJclComplex.CoreIntPwr(First: TRectCoord; const Polar: TRectCoord; const Pwr: Integer): TRectCoord; +begin + First.X := MiscalcFloat(First.X); + First.Y := MiscalcFloat(First.Y); + if AbsoluteValueSqr(First) = 0.0 then + if Pwr = 0 then + Result := RectOne + else + Result := RectZero + else + Result := RectCoord(PowerInt(Polar.X, Pwr), NormalizeAngle(Pwr * Polar.Y)); +end; + +function TJclComplex.CIntPwr(const Pwr: Integer): TJclComplex; +var + ResValue: TRectCoord; +begin + FillCoords(crRectangular); + ResValue := CoreIntPwr(RectCoord(Self), RectCoord(FCoord.R, FCoord.Theta), Pwr); + FCoord.R := ResValue.X; + FCoord.Theta := ResValue.Y; + FillCoords(crPolar); + Result := Self; +end; + +function TJclComplex.CNewIntPwr(const Pwr: Integer): TJclComplex; +var + ResValue: TRectCoord; +begin + FillCoords(crRectangular); + ResValue := CoreIntPwr(RectCoord(Self), RectCoord(FCoord.R, FCoord.Theta), Pwr); + Result := TJclComplex.Create(ResValue.X, ResValue.Y, crPolar); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CoreRealPwr(First: TRectCoord; const Polar: TRectCoord; const Pwr: Float): TRectCoord; +begin + First.X := MiscalcFloat(First.X); + First.Y := MiscalcFloat(First.Y); + if AbsoluteValueSqr(First) = 0.0 then + if MiscalcFloat(Pwr) = 0.0 then + Result := RectOne + else + Result := RectZero + else + Result := RectCoord(Power(Polar.X, Pwr), NormalizeAngle(Pwr * Polar.Y)); +end; + +function TJclComplex.CRealPwr(const Pwr: Float): TJclComplex; +var + ResValue: TRectCoord; +begin + FillCoords(crRectangular); + ResValue := CoreRealPwr(RectCoord(Self), RectCoord(FCoord.R, FCoord.Theta), Pwr); + FCoord.R := ResValue.X; + FCoord.Theta := ResValue.Y; + FillCoords(crPolar); + Result := Self; +end; + +function TJclComplex.CNewRealPwr(const Pwr: Float): TJclComplex; +var + ResValue: TRectCoord; +begin + FillCoords(crRectangular); + ResValue := CoreRealPwr(RectCoord(Self), RectCoord(FCoord.R, FCoord.Theta), Pwr); + Result := TJclComplex.Create(ResValue.X, ResValue.Y, crPolar); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CoreRoot(First: TRectCoord; const Polar: TRectCoord; const K, N: Word): TRectCoord; +begin + First.X := MiscalcFloat(First.X); + First.Y := MiscalcFloat(First.Y); + if AbsoluteValue(First) = 0.0 then + Result := RectZero + else + Result := RectCoord(Power(Polar.X, 1.0 / N), NormalizeAngle((Polar.Y + K * TwoPi) / N)); +end; + +function TJclComplex.CRoot(const K, N: Word): TJclComplex; +var + ResValue: TRectCoord; +begin + FillCoords(crRectangular); + ResValue := CoreRoot(RectCoord(Self), RectCoord(FCoord.R, FCoord.Theta), K, N); + FCoord.R := ResValue.X; + FCoord.Theta := ResValue.Y; + FillCoords(crPolar); + Result := Self; +end; + +function TJclComplex.CNewRoot(const K, N: Word): TJclComplex; +var + ResValue: TRectCoord; +begin + FillCoords(crRectangular); + ResValue := CoreRoot(RectCoord(Self), RectCoord(FCoord.R, FCoord.Theta), K, N); + Result := TJclComplex.Create(ResValue.X, ResValue.Y, crPolar); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CSqrt: TJclComplex; +begin + Result := CRoot(0, 2); +end; + +function TJclComplex.CNewSqrt: TJclComplex; +begin + Result := CNewRoot(0, 2); +end; + +//=== trigonometric functions ================================================ + +function TJclComplex.CoreCos(const Value: TRectCoord): TRectCoord; +begin + Result := RectCoord(JclMath.Cos(Value.X) * JclMath.CosH(Value.Y), -JclMath.Sin(Value.X) * JclMath.SinH(Value.Y)); +end; + +function TJclComplex.CCos: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreCos(RectCoord(Self)); + FCoord.X := ResValue.X; + FCoord.Y := ResValue.Y; + Result := Self; +end; + +function TJclComplex.CNewCos: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreCos(RectCoord(Self)); + Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CoreSin(const Value: TRectCoord): TRectCoord; +begin + Result := RectCoord(JclMath.Sin(Value.X) * JclMath.CosH(Value.Y), JclMath.Cos(Value.X) * JclMath.SinH(Value.Y)); +end; + +function TJclComplex.CSin: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreSin(RectCoord(Self)); + FCoord.X := ResValue.X; + FCoord.Y := ResValue.Y; + Result := Self; +end; + +function TJclComplex.CNewSin: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreSin(RectCoord(Self)); + Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CoreTan(const Value: TRectCoord): TRectCoord; +var + TempValue: Float; +begin + TempValue := JclMath.Cos(2.0 * Value.X) + JclMath.CosH(2.0 * Value.Y); + if MiscalcFloat(TempValue) <> 0.0 then + Result := RectCoord(JclMath.Sin(2.0 * Value.X) / TempValue, JclMath.SinH(2.0 * Value.Y) / TempValue) + else + Result := RectInfinity; +end; + +function TJclComplex.CTan: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreTan(RectCoord(Self)); + FCoord.X := ResValue.X; + FCoord.Y := ResValue.Y; + Result := Self; +end; + +function TJclComplex.CNewTan: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreTan(RectCoord(Self)); + Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CoreCot(const Value: TRectCoord): TRectCoord; +var + TempValue: Float; +begin + TempValue := JclMath.Cosh(2.0 * Value.Y) - JclMath.Cos(2.0 * Value.X); + if MiscalcFloat(TempValue) <> 0.0 then + Result := RectCoord(JclMath.Sin(2.0 * Value.X) / TempValue, -JclMath.SinH(2.0 * Value.Y) / TempValue) + else + Result := RectInfinity; +end; + +function TJclComplex.CCot: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreCot(RectCoord(Self)); + FCoord.X := ResValue.X; + FCoord.Y := ResValue.Y; + Result := Self; +end; + +function TJclComplex.CNewCot: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreCot(RectCoord(Self)); + Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CoreSec(const Value: TRectCoord): TRectCoord; +var + TempValue: TRectCoord; +begin + TempValue := CoreCos(Value); + if MiscalcFloat(AbsoluteValue(TempValue)) <> 0.0 then + Result := CoreDiv(RectOne, TempValue) + else + Result := RectInfinity; +end; + +function TJclComplex.CSec: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreSec(RectCoord(Self)); + FCoord.X := ResValue.X; + FCoord.Y := ResValue.Y; + Result := Self; +end; + +function TJclComplex.CNewSec: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreSec(RectCoord(Self)); + Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CoreCsc(const Value: TRectCoord): TRectCoord; +var + TempValue: TRectCoord; +begin + TempValue := CoreSin(Value); + if MiscalcFloat(AbsoluteValue(TempValue)) <> 0.0 then + Result := CoreDiv(RectOne, TempValue) + else + Result := RectInfinity; +end; + +function TJclComplex.CCsc: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreCsc(RectCoord(Self)); + FCoord.X := ResValue.X; + FCoord.Y := ResValue.Y; + Result := Self; +end; + +function TJclComplex.CNewCsc: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreCsc(RectCoord(Self)); + Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +//=== hyperbolic functions =================================================== + +function TJclComplex.CoreCosH(const Value: TRectCoord): TRectCoord; +begin + Result := RectCoord(JclMath.CosH(Value.X) * JclMath.Cos(Value.Y), JclMath.SinH(Value.X) * JclMath.Sin(Value.Y)); +end; + +function TJclComplex.CCosH: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreCosH(RectCoord(Self)); + FCoord.X := ResValue.X; + FCoord.Y := ResValue.Y; + Result := Self; +end; + +function TJclComplex.CNewCosH: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreCosH(RectCoord(Self)); + Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CoreSinH(const Value: TRectCoord): TRectCoord; +begin + Result := RectCoord(JclMath.SinH(Value.X) * JclMath.Cos(Value.Y), JclMath.CosH(Value.X) * JclMath.Sin(Value.Y)); +end; + +function TJclComplex.CSinH: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreSinH(RectCoord(Self)); + FCoord.X := ResValue.X; + FCoord.Y := ResValue.Y; + Result := Self; +end; + +function TJclComplex.CNewSinH: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreSinH(RectCoord(Self)); + Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CoreTanH(const Value: TRectCoord): TRectCoord; +var + TempValue: Float; +begin + TempValue := JclMath.CosH(2.0 * Value.X) + JclMath.Cos(2.0 * Value.Y); + if MiscalcFloat(TempValue) <> 0.0 then + Result := RectCoord(JclMath.SinH(2.0 * Value.X) / TempValue, JclMath.Sin(2.0 * Value.Y) / TempValue) + else + Result := RectInfinity; +end; + +function TJclComplex.CTanH: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreTanH(RectCoord(Self)); + FCoord.X := ResValue.X; + FCoord.Y := ResValue.Y; + Result := Self; +end; + +function TJclComplex.CNewTanH: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreTanH(RectCoord(Self)); + Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CoreCotH(const Value: TRectCoord): TRectCoord; +var + TempValue: Float; +begin + TempValue := JclMath.Cosh(2.0 * Value.X) - JclMath.Cos(2.0 * Value.Y); + if MiscalcFloat(TempValue) <> 0.0 then + Result := RectCoord(JclMath.SinH(2.0 * Value.X) / TempValue, -JclMath.Sin(2.0 * Value.Y) / TempValue) + else + Result := RectInfinity; +end; + +function TJclComplex.CCotH: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreCotH(RectCoord(Self)); + FCoord.X := ResValue.X; + FCoord.Y := ResValue.Y; + Result := Self; +end; + +function TJclComplex.CNewCotH: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreCotH(RectCoord(Self)); + Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CoreSecH(const Value: TRectCoord): TRectCoord; +var + TempValue: TRectCoord; +begin + TempValue := CoreCosH(Value); + if MiscalcFloat(AbsoluteValue(TempValue)) <> 0.0 then + Result := CoreDiv(RectOne, TempValue) + else + Result := RectInfinity; +end; + +function TJclComplex.CSecH: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreSecH(RectCoord(Self)); + FCoord.X := ResValue.X; + FCoord.Y := ResValue.Y; + Result := Self; +end; + +function TJclComplex.CNewSecH: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreSecH(RectCoord(Self)); + Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CoreCscH(const Value: TRectCoord): TRectCoord; +var + TempValue: TRectCoord; +begin + TempValue := CoreSinH(Value); + if MiscalcFloat(AbsoluteValue(TempValue)) <> 0.0 then + Result := CoreDiv(RectOne, TempValue) + else + Result := RectInfinity; +end; + +function TJclComplex.CCscH: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreCscH(RectCoord(Self)); + FCoord.X := ResValue.X; + FCoord.Y := ResValue.Y; + Result := Self; +end; + +function TJclComplex.CNewCscH: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreCscH(RectCoord(Self)); + Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +//=== complex Bessel functions of order zero ================================= + +function TJclComplex.CoreI0(const Value: TRectCoord): TRectCoord; +var + ZSqr25, Term: TRectCoord; + I: Integer; + SizeSqr: Float; +begin + Result := RectOne; + ZSqr25 := CoreMul(Value, Value); + ZSqr25 := RectCoord(0.25 * ZSqr25.X, 0.25 * ZSqr25.Y); + Term := ZSqr25; + Result := CoreAdd(Result, ZSqr25); + I := 1; + repeat + Term := CoreMul(ZSqr25, Term); + Inc(I); + Term := RectCoord(Term.X / Sqr(I), Term.Y / Sqr(I)); + Result := CoreAdd(Result, Term); + SizeSqr := Sqr(Term.X) + Sqr(Term.Y); + until (I > MaxTerm) or (SizeSqr < EpsilonSqr); +end; + +function TJclComplex.CI0: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreI0(RectCoord(Self)); + FCoord.X := ResValue.X; + FCoord.Y := ResValue.Y; + Result := Self; +end; + +function TJclComplex.CNewI0: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreI0(RectCoord(Self)); + Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CoreJ0(const Value: TRectCoord): TRectCoord; +var + ZSqr25, Term: TRectCoord; + I: Integer; + SizeSqr: Float; + AddFlag: Boolean; +begin + Result := RectOne; + ZSqr25 := CoreMul(Value, Value); + ZSqr25 := RectCoord(0.25 * ZSqr25.X, 0.25 * ZSqr25.Y); + Term := ZSqr25; + Result := CoreSub(Result, ZSqr25); + AddFlag := False; + I := 1; + repeat + Term := CoreMul(ZSqr25, Term); + Inc(I); + AddFlag := not AddFlag; + Term := RectCoord(Term.X / Sqr(I), Term.Y / Sqr(I)); + if AddFlag then + Result := CoreAdd(Result, Term) + else + Result := CoreSub(Result, Term); + SizeSqr := Sqr(Term.X) + Sqr(Term.Y); + until (I > MaxTerm) or (SizeSqr < EpsilonSqr); +end; + +function TJclComplex.CJ0: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreJ0(RectCoord(Self)); + FCoord.X := ResValue.X; + FCoord.Y := ResValue.Y; + Result := Self; +end; + +function TJclComplex.CNewJ0: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreJ0(RectCoord(Self)); + Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CoreApproxLnGamma(const Value: TRectCoord): TRectCoord; +const + C: array [1..8] of Float = + (1.0 / 12.0, -1.0 / 360.0, 1.0 / 1260.0, -1.0 / 1680.0, + 1.0 / 1188.0, -691.0 / 360360.0, 1.0 / 156.0, -3617.0 / 122400.0); +var + I: Integer; + Powers: array [1..8] of TRectCoord; + Temp1, Temp2: TRectCoord; +begin + Temp1 := CoreLn(Value); + Temp2 := RectCoord(Value.X - 0.5, Value.Y); + Result := CoreAdd(Temp1, Temp2); + Result := CoreSub(Result, Value); + Result.X := Result.X + hLn2PI; + + Temp1 := RectOne; + Powers[1] := CoreDiv(Temp1, Value); + Temp2 := CoreMul(powers[1], Powers[1]); + for I := 2 to 8 do + Powers[I] := CoreMul(Powers[I - 1], Temp2); + for I := 8 downto 1 do + begin + Temp1 := RectCoord(C[I] * Powers[I].X, C[I] * Powers[I].Y); + Result := CoreAdd(Result, Temp1); + end; +end; + +function TJclComplex.CApproxLnGamma: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreApproxLnGamma(RectCoord(Self)); + FCoord.X := ResValue.X; + FCoord.Y := ResValue.Y; + Result := Self; +end; + +function TJclComplex.CNewApproxLnGamma: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreApproxLnGamma(RectCoord(Self)); + Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CoreLnGamma(Value: TRectCoord): TRectCoord; +var + LNA, Temp: TRectCoord; +begin + if (Value.X <= 0.0) and (MiscalcFloat(Value.Y) = 0.0) then + if MiscalcFloat(Int(Value.X - 1E-8) - Value.X) = 0.0 then + begin + Result := RectInfinity; + Exit; + end; + + if Value.Y < 0.0 then + begin + Value := RectCoord(Value.X, -Value.Y); + Result := CoreLnGamma(Value); + Result := RectCoord(Result.X, -Result.Y); + end + else + begin + if Value.X < 9.0 then + begin + LNA := CoreLn(Value); + Value := RectCoord(Value.X + 1, Value.Y); + Temp := CoreLnGamma(Value); + Result := CoreSub(Temp, LNA); + end + else + CoreApproxLnGamma(Value); + end; +end; + +function TJclComplex.CLnGamma: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreLnGamma(RectCoord(Self)); + FCoord.X := ResValue.X; + FCoord.Y := ResValue.Y; + Result := Self; +end; + +function TJclComplex.CNewLnGamma: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreLnGamma(RectCoord(Self)); + Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +function TJclComplex.CoreGamma(const Value: TRectCoord): TRectCoord; +var + LNZ: TRectCoord; +begin + LNZ := CoreLnGamma(Value); + if LNZ.X > 75.0 then + Result := RectInfinity + else + if LNZ.X < -200.0 then + Result := RectZero + else + Result := CoreExp(LNZ); +end; + +function TJclComplex.CGamma: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreGamma(RectCoord(Self)); + FCoord.X := ResValue.X; + FCoord.Y := ResValue.Y; + Result := Self; +end; + +function TJclComplex.CNewGamma: TJclComplex; +var + ResValue: TRectCoord; +begin + ResValue := CoreGamma(RectCoord(Self)); + Result := TJclComplex.Create(ResValue.X, ResValue.Y, crRectangular); + Result.FFracLen := FFracLen; +end; + +//=== miscellaneous ========================================================== + +function TJclComplex.AbsoluteValue: Float; +begin + Result := Sqrt(Sqr(FCoord.X) + Sqr(FCoord.Y)); +end; + +function TJclComplex.AbsoluteValue(const Coord: TRectCoord): Float; +begin + Result := Sqrt(Sqr(Coord.X) + Sqr(Coord.Y)); +end; + +function TJclComplex.AbsoluteValueSqr: Float; +begin + Result := Sqr(FCoord.X) + Sqr(FCoord.Y); +end; + +function TJclComplex.AbsoluteValueSqr(const Coord: TRectCoord): Float; +begin + Result := Sqr(Coord.X) + Sqr(Coord.Y); +end; + +function TJclComplex.FormatExtended(const X: Float): string; +begin + Result := FloatToStrF(X, ffFixed, FFracLen, FFracLen); +end; + +procedure TJclComplex.SetFracLen(const X: Byte); +begin + if X > MaxFracLen then + FFracLen := MaxFracLen + else + FFracLen := X; +end; + +function TJclComplex.GetRadius: Float; +begin + FillCoords(crRectangular); + Result := FCoord.R; +end; + +function TJclComplex.GetAngle: Float; +begin + FillCoords(crRectangular); + Result := FCoord.Theta; +end; + +function TJclComplex.NormalizeAngle(const Value: Float): Float; +var + N: Integer; +begin + Result := Value; + if Result > Pi then + begin + N := Floor((Result + Pi) / TwoPi); + Result := Result - N * TwoPi; + end + else + if Result < -Pi then + begin + N := Floor((-Result + Pi) / TwoPi); + Result := Result + N * TwoPi; + end; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclCompression.pas b/3rdParty/JCL/source/common/JclCompression.pas new file mode 100644 index 00000000..70c21376 --- /dev/null +++ b/3rdParty/JCL/source/common/JclCompression.pas @@ -0,0 +1,10068 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclCompression.pas. } +{ } +{ The Initial Developer of the Original Code is Matthias Thoma. } +{ All Rights Reserved. } +{ } +{ Contributors: } +{ Olivier Sannier (obones) } +{ Florent Ouchet (outchy) } +{ Jan Goyvaerts (jgsoft) } +{ Uwe Schuster (uschuster) } +{ } +{**************************************************************************************************} +{ } +{ Alternatively, the contents of this file may be used under the terms of the GNU Lesser General } +{ Public License (the "LGPL License"), in which case the provisions of the LGPL License are } +{ applicable instead of those above. If you wish to allow use of your version of this file only } +{ under the terms of the LGPL License and not to allow others to use your version of this file } +{ under the MPL, indicate your decision by deleting the provisions above and replace them with the } +{ notice and other provisions required by the LGPL License. If you do not delete the provisions } +{ above, a recipient may use your version of this file under either the MPL or the LGPL License. } +{ } +{ For more information about the LGPL: } +{ http://www.gnu.org/copyleft/lesser.html } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclCompression; + +{$I jcl.inc} +{$I crossplatform.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + {$IFDEF HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Winapi.Windows, Sevenzip, Winapi.ActiveX, + {$ENDIF MSWINDOWS} + System.Types, + System.SysUtils, System.Classes, System.Contnrs, + {$IFDEF ZLIB_RTL} + System.ZLib, + {$ENDIF ZLIB_RTL} + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Windows, Sevenzip, ActiveX, + {$ENDIF MSWINDOWS} + Types, + SysUtils, Classes, Contnrs, + {$IFDEF ZLIB_RTL} + ZLib, + {$ENDIF ZLIB_RTL} + {$ENDIF ~HAS_UNITSCOPE} + zlibh, bzip2, JclWideStrings, JclBase, JclStreams; + +{$IFDEF RTL230_UP} +{$HPPEMIT '// To avoid ambiguity with System::Zlib::z_stream_s we force using ours'} +{$HPPEMIT '#define z_stream_s Zlibh::z_stream_s'} +{$ENDIF RTL230_UP} + +{************************************************************************************************** + Class hierarchy + + TJclCompressionStream + | + |-- TJclCompressStream + | | + | |-- TJclZLibCompressStream handled by zlib http://www.zlib.net/ + | |-- TJclBZIP2CompressStream handled by bzip2 http://www.bzip.net/ + | |-- TJclGZIPCompressStream handled by zlib http://www.zlib.net/ + JCL + | + |-- TJclDecompressStream + | + |-- TJclZLibDecompressStream handled by zlib http://www.zlib.net/ + |-- TBZIP2DecompressStream handled by bzip2 http://www.bzip.net/ + |-- TGZIPDecompressStream handled by zlib http://www.zlib.net/ + JCL + + TJclCompressionArchive + | + |-- TJclCompressArchive + | | + | |-- TJclSevenzipCompressArchive + | | + | |-- TJclZipCompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclBZ2CompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJcl7zCompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclTarCompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclGZipCompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclXzCompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclSwfcCompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclWimCompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | + |-- TJclDecompressArchive + | | + | |-- TJclSevenZipDecompressArchive + | | + | |-- TJclZipDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclBZ2DecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclRarDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclArjDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclZDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclLzhDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJcl7zDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclCabDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclNsisDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclLzmaDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclLzma86DecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclPeDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclElfDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclMachoDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclUdfDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclXarDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclMubDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclHfsDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclDmgDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclCompoundDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclWimDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclIsoDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclBkfDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclChmDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclSplitDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclRpmDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclDebDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclCpioDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclTarDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclGZipDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclXzDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclNtfsDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclFatDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclMbrDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclVhdDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclMslzDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclFlvDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclSwfDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclSwfcDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclAPMDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclPpmdDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclTEDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclUEFIcDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclUEFIsDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclSquashFSDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclCramFSDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclExtDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclVMDKDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclVDIDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclQcowDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclGPTDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclRar5DecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclIHexDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | |-- TJclHxsDecompressArchive handled by sevenzip http://sevenzip.sourceforge.net/ + | + |-- TJclUpdateArchive + | + |-- TJclSevenzipUpdateArchive + | + |-- TJclZipUpdateArchive handled by sevenzip http://sevenzip.sourceforge.net/ + |-- TJclBZ2UpdateArchive handled by sevenzip http://sevenzip.sourceforge.net/ + |-- TJcl7zUpdateArchive handled by sevenzip http://sevenzip.sourceforge.net/ + |-- TJclTarUpdateArchive handled by sevenzip http://sevenzip.sourceforge.net/ + |-- TJclGZipUpdateArchive handled by sevenzip http://sevenzip.sourceforge.net/ + |-- TJclXzUpdateArchive handled by sevenzip http://sevenzip.sourceforge.net/ + |-- TJclSwfcUpdateArchive handled by sevenzip http://sevenzip.sourceforge.net/ + +**************************************************************************************************} + +type + TJclCompressionStream = class(TJclStream) + private + FOnProgress: TNotifyEvent; + FBuffer: Pointer; + FBufferSize: Cardinal; + FStream: TStream; + protected + function SetBufferSize(Size: Cardinal): Cardinal; virtual; + procedure Progress(Sender: TObject); dynamic; + property OnProgress: TNotifyEvent read FOnProgress write FOnProgress; + public + class function StreamExtensions: string; virtual; + class function StreamName: string; virtual; + class function StreamSubExtensions: string; virtual; + + constructor Create(AStream: TStream); + destructor Destroy; override; + + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; + procedure Reset; virtual; + end; + + TJclCompressionStreamClass = class of TJclCompressionStream; + + TJclCompressStream = class(TJclCompressionStream) + public + function Flush: Integer; dynamic; abstract; + constructor Create(Destination: TStream); + end; + + TJclCompressStreamClass = class of TJclCompressStream; + + TJclDecompressStream = class(TJclCompressionStream) + private + FOwnsStream: Boolean; + public + constructor Create(Source: TStream; AOwnsStream: Boolean = False); + destructor Destroy; override; + end; + + TJclDecompressStreamClass = class of TJclDecompressStream; + + TJclCompressionStreamFormats = class + private + FCompressFormats: TList; + FDecompressFormats: TList; + protected + function GetCompressFormatCount: Integer; + function GetCompressFormat(Index: Integer): TJclCompressStreamClass; + function GetDecompressFormatCount: Integer; + function GetDecompressFormat(Index: Integer): TJclDecompressStreamClass; + public + constructor Create; + destructor Destroy; override; + + procedure RegisterFormat(AClass: TJclCompressionStreamClass); + procedure UnregisterFormat(AClass: TJclCompressionStreamClass); + + function FindCompressFormat(const AFileName: TFileName): TJclCompressStreamClass; + function FindDecompressFormat(const AFileName: TFileName): TJclDecompressStreamClass; + + property CompressFormatCount: Integer read GetCompressFormatCount; + property CompressFormats[Index: Integer]: TJclCompressStreamClass read GetCompressFormat; + property DecompressFormatCount: Integer read GetDecompressFormatCount; + property DecompressFormats[Index: Integer]: TJclDecompressStreamClass read GetDecompressFormat; + end; + +// retreive a singleton list containing registered stream classes +function GetStreamFormats: TJclCompressionStreamFormats; + +// ZIP Support +type + TJclCompressionLevel = Integer; + + TJclZLibCompressStream = class(TJclCompressStream) + private + FWindowBits: Integer; + FMemLevel: Integer; + FMethod: Integer; + FStrategy: Integer; + FDeflateInitialized: Boolean; + FCompressionLevel: Integer; + protected + ZLibRecord: TZStreamRec; + procedure SetCompressionLevel(Value: Integer); + procedure SetStrategy(Value: Integer); + procedure SetMemLevel(Value: Integer); + procedure SetMethod(Value: Integer); + procedure SetWindowBits(Value: Integer); + public + // stream description + class function StreamExtensions: string; override; + class function StreamName: string; override; + class function StreamSubExtensions: string; override; + + constructor Create(Destination: TStream; CompressionLevel: TJclCompressionLevel = -1); + destructor Destroy; override; + + function Flush: Integer; override; + procedure Reset; override; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; + function Write(const Buffer; Count: Longint): Longint; override; + + property WindowBits: Integer read FWindowBits write SetWindowBits; + property MemLevel: Integer read FMemLevel write SetMemLevel; + property Method: Integer read FMethod write SetMethod; + property Strategy: Integer read FStrategy write SetStrategy; + property CompressionLevel: Integer read FCompressionLevel write SetCompressionLevel; + end; + +{$IFDEF ZLIB_RTL} +const + DEF_WBITS = 15; + {$EXTERNALSYM DEF_WBITS} + DEF_MEM_LEVEL = 8; + {$EXTERNALSYM DEF_MEM_LEVEL} + +type + PBytef = PByte; + {$EXTERNALSYM PBytef} +{$ENDIF ZLIB_RTL} + +type + TJclZLibDecompressStream = class(TJclDecompressStream) + private + FWindowBits: Integer; + FInflateInitialized: Boolean; + protected + ZLibRecord: TZStreamRec; + procedure SetWindowBits(Value: Integer); + public + // stream description + class function StreamExtensions: string; override; + class function StreamName: string; override; + class function StreamSubExtensions: string; override; + + constructor Create(Source: TStream; WindowBits: Integer = DEF_WBITS; AOwnsStream: Boolean = False); + destructor Destroy; override; + + function Read(var Buffer; Count: Longint): Longint; override; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; + + property WindowBits: Integer read FWindowBits write SetWindowBits; + end; + + // GZIP Support + +//=== { GZIP helpers } ======================================================= + +type + TJclGZIPHeader = packed record + ID1: Byte; + ID2: Byte; + CompressionMethod: Byte; + Flags: Byte; + ModifiedTime: Cardinal; + ExtraFlags: Byte; + OS: Byte; + end; + + TJclGZIPFooter = packed record + DataCRC32: Cardinal; + DataSize: Cardinal; + end; + +const + // ID1 and ID2 fields + JCL_GZIP_ID1 = $1F; // value for the ID1 field + JCL_GZIP_ID2 = $8B; // value for the ID2 field + + // Compression Model field + JCL_GZIP_CM_DEFLATE = 8; // Zlib classic + + // Flags field : extra fields for the header + JCL_GZIP_FLAG_TEXT = $01; // file is probably ASCII text + JCL_GZIP_FLAG_CRC = $02; // a CRC16 for the header is present + JCL_GZIP_FLAG_EXTRA = $04; // extra fields present + JCL_GZIP_FLAG_NAME = $08; // original file name is present + JCL_GZIP_FLAG_COMMENT = $10; // comment is present + + // ExtraFlags field : compression level + JCL_GZIP_EFLAG_MAX = 2; // compressor used maximum compression + JCL_GZIP_EFLAG_FAST = 4; // compressor used fastest compression + + // OS field : file system + JCL_GZIP_OS_FAT = 0; // FAT filesystem (MS-DOS, OS/2, NT/Win32) + JCL_GZIP_OS_AMIGA = 1; // Amiga + JCL_GZIP_OS_VMS = 2; // VMS (or OpenVMS) + JCL_GZIP_OS_UNIX = 3; // Unix + JCL_GZIP_OS_VM = 4; // VM/CMS + JCL_GZIP_OS_ATARI = 5; // Atari TOS + JCL_GZIP_OS_HPFS = 6; // HPFS filesystem (OS/2, NT) + JCL_GZIP_OS_MAC = 7; // Macintosh + JCL_GZIP_OS_Z = 8; // Z-System + JCL_GZIP_OS_CPM = 9; // CP/M + JCL_GZIP_OS_TOPS = 10; // TOPS-20 + JCL_GZIP_OS_NTFS = 11; // NTFS filesystem (NT) + JCL_GZIP_OS_QDOS = 12; // QDOS + JCL_GZIP_OS_ACORN = 13; // Acorn RISCOS + JCL_GZIP_OS_UNKNOWN = 255; // unknown + +type + TJclGZIPSubFieldHeader = packed record + SI1: Byte; + SI2: Byte; + Len: Word; + end; + +// constants to identify sub fields in the extra field +// source: http://www.gzip.org/format.txt +const + JCL_GZIP_X_AC1 = $41; // AC Acorn RISC OS/BBC MOS file type information + JCL_GZIP_X_AC2 = $43; + JCL_GZIP_X_Ap1 = $41; // Ap Apollo file type information + JCL_GZIP_X_Ap2 = $70; + JCL_GZIP_X_cp1 = $63; // cp file compressed by cpio + JCL_GZIP_X_cp2 = $70; + JCL_GZIP_X_GS1 = $1D; // GS gzsig + JCL_GZIP_X_GS2 = $53; + JCL_GZIP_X_KN1 = $4B; // KN KeyNote assertion (RFC 2704) + JCL_GZIP_X_KN2 = $4E; + JCL_GZIP_X_Mc1 = $4D; // Mc Macintosh info (Type and Creator values) + JCL_GZIP_X_Mc2 = $63; + JCL_GZIP_X_RO1 = $52; // RO Acorn Risc OS file type information + JCL_GZIP_X_RO2 = $4F; + +type + TJclGZIPFlag = (gfDataIsText, gfHeaderCRC16, gfExtraField, gfOriginalFileName, gfComment); + TJclGZIPFlags = set of TJclGZIPFlag; + TJclGZIPFatSystem = (gfsFat, gfsAmiga, gfsVMS, gfsUnix, gfsVM, gfsAtari, gfsHPFS, + gfsMac, gfsZ, gfsCPM, gfsTOPS, gfsNTFS, gfsQDOS, gfsAcorn, gfsOther, gfsUnknown); + + // Format is described in RFC 1952, http://www.faqs.org/rfcs/rfc1952.html + TJclGZIPCompressionStream = class(TJclCompressStream) + private + FFlags: TJclGZIPFlags; + FUnixTime: Cardinal; + FAutoSetTime: Boolean; + FCompressionLevel: TJclCompressionLevel; + FFatSystem: TJclGZIPFatSystem; + FExtraField: string; + FOriginalFileName: TFileName; + FComment: string; + FZLibStream: TJclZLibCompressStream; + FOriginalSize: Cardinal; + FDataCRC32: Cardinal; + FHeaderWritten: Boolean; + FFooterWritten: Boolean; // flag so we only write the footer once! (NEW 2007) + + procedure WriteHeader; + function GetDosTime: TDateTime; + function GetUnixTime: Cardinal; + procedure SetDosTime(const Value: TDateTime); + procedure SetUnixTime(Value: Cardinal); + procedure ZLibStreamProgress(Sender: TObject); + public + // stream description + class function StreamExtensions: string; override; + class function StreamName: string; override; + class function StreamSubExtensions: string; override; + + constructor Create(Destination: TStream; CompressionLevel: TJclCompressionLevel = -1); + destructor Destroy; override; + + function Write(const Buffer; Count: Longint): Longint; override; + procedure Reset; override; + // IMPORTANT: In order to get a valid GZip file, Flush MUST be called after + // the last call to Write. + function Flush: Integer; override; + + property Flags: TJclGZIPFlags read FFlags write FFlags; + property DosTime: TDateTime read GetDosTime write SetDosTime; + property UnixTime: Cardinal read GetUnixTime write SetUnixTime; + property AutoSetTime: Boolean read FAutoSetTime write FAutoSetTime; + property FatSystem: TJclGZIPFatSystem read FFatSystem write FFatSystem; + property ExtraField: string read FExtraField write FExtraField; + // Note: In order for most decompressors to work, the original file name + // must be given or they would display an empty file name in their list. + // This does not affect the decompression stream below as it simply reads + // the value and does not work with it + property OriginalFileName: TFileName read FOriginalFileName write FOriginalFileName; + property Comment: string read FComment write FComment; + end; + + TJclGZIPDecompressionStream = class(TJclDecompressStream) + private + FHeader: TJclGZIPHeader; + FFooter: TJclGZIPFooter; + FCompressedDataStream: TJclDelegatedStream; + FZLibStream: TJclZLibDecompressStream; + FOriginalFileName: TFileName; + FComment: string; + FExtraField: string; + FComputedHeaderCRC16: Word; + FStoredHeaderCRC16: Word; + FComputedDataCRC32: Cardinal; + FCompressedDataSize: Int64; + FDataSize: Int64; + FDataStarted: Boolean; + FDataEnded: Boolean; + FAutoCheckDataCRC32: Boolean; + function GetCompressedDataSize: Int64; + function GetComputedDataCRC32: Cardinal; + function GetDosTime: TDateTime; + function GetFatSystem: TJclGZIPFatSystem; + function GetFlags: TJclGZIPFlags; + function GetOriginalDataSize: Cardinal; + function GetStoredDataCRC32: Cardinal; + function ReadCompressedData(Sender: TObject; var Buffer; Count: Longint): Longint; + procedure ZLibStreamProgress(Sender: TObject); + public + // stream description + class function StreamExtensions: string; override; + class function StreamName: string; override; + class function StreamSubExtensions: string; override; + + constructor Create(Source: TStream; CheckHeaderCRC: Boolean = True; AOwnsStream: Boolean = False); + destructor Destroy; override; + + function Read(var Buffer; Count: Longint): Longint; override; + + property ComputedHeaderCRC16: Word read FComputedHeaderCRC16; + property StoredHeaderCRC16: Word read FStoredHeaderCRC16; + property ExtraField: string read FExtraField; + property OriginalFileName: TFileName read FOriginalFileName; + property Comment: string read FComment; + property Flags: TJclGZIPFlags read GetFlags; + property CompressionLevel: Byte read FHeader.ExtraFlags; + property FatSystem: TJclGZIPFatSystem read GetFatSystem; + property UnixTime: Cardinal read FHeader.ModifiedTime; + property DosTime: TDateTime read GetDosTime; + property ComputedDataCRC32: Cardinal read GetComputedDataCRC32; + property StoredDataCRC32: Cardinal read GetStoredDataCRC32; + property AutoCheckDataCRC32: Boolean read FAutoCheckDataCRC32 write FAutoCheckDataCRC32; + property CompressedDataSize: Int64 read GetCompressedDataSize; + property OriginalDataSize: Cardinal read GetOriginalDataSize; + end; + + // BZIP2 Support + TJclBZIP2CompressionStream = class(TJclCompressStream) + private + FDeflateInitialized: Boolean; + FCompressionLevel: Integer; + protected + BZLibRecord: bz_stream; + procedure SetCompressionLevel(const Value: Integer); + public + // stream description + class function StreamExtensions: string; override; + class function StreamName: string; override; + class function StreamSubExtensions: string; override; + + constructor Create(Destination: TStream; ACompressionLevel: TJclCompressionLevel = 9); + destructor Destroy; override; + + function Flush: Integer; override; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; + function Write(const Buffer; Count: Longint): Longint; override; + + property CompressionLevel: Integer read FCompressionLevel write SetCompressionLevel; + end; + + TJclBZIP2DecompressionStream = class(TJclDecompressStream) + private + FInflateInitialized: Boolean; + protected + BZLibRecord: bz_stream; + public + // stream description + class function StreamExtensions: string; override; + class function StreamName: string; override; + class function StreamSubExtensions: string; override; + + constructor Create(Source: TStream; AOwnsStream: Boolean = False); overload; + destructor Destroy; override; + + function Read(var Buffer; Count: Longint): Longint; override; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; + end; + + EJclCompressionError = class(EJclError); + EJclCompressionCancelled = class(EJclCompressionError); + EJclCompressionFalse = class(EJclCompressionError); + + // callback type used in helper functions below: + TJclCompressStreamProgressCallback = procedure(FileSize, Position: Int64; UserData: Pointer) of object; + +{helper functions - one liners by wpostma} +function GZipFile(SourceFile, DestinationFile: TFileName; CompressionLevel: Integer = Z_DEFAULT_COMPRESSION; + ProgressCallback: TJclCompressStreamProgressCallback = nil; UserData: Pointer = nil): Boolean; +function UnGZipFile(SourceFile, DestinationFile: TFileName; + ProgressCallback: TJclCompressStreamProgressCallback = nil; UserData: Pointer = nil): Boolean; +procedure GZipStream(SourceStream, DestinationStream: TStream; CompressionLevel: Integer = Z_DEFAULT_COMPRESSION; + ProgressCallback: TJclCompressStreamProgressCallback = nil; UserData: Pointer = nil); +procedure UnGZipStream(SourceStream, DestinationStream: TStream; + ProgressCallback: TJclCompressStreamProgressCallback = nil; UserData: Pointer = nil); + +function BZip2File(SourceFile, DestinationFile: TFileName; CompressionLevel: Integer = 5; + ProgressCallback: TJclCompressStreamProgressCallback = nil; UserData: Pointer = nil): Boolean; +function UnBZip2File(SourceFile, DestinationFile: TFileName; + ProgressCallback: TJclCompressStreamProgressCallback = nil; UserData: Pointer = nil): Boolean; +procedure BZip2Stream(SourceStream, DestinationStream: TStream; CompressionLevel: Integer = 5; + ProgressCallback: TJclCompressStreamProgressCallback = nil; UserData: Pointer = nil); +procedure UnBZip2Stream(SourceStream, DestinationStream: TStream; + ProgressCallback: TJclCompressStreamProgressCallback = nil; UserData: Pointer = nil); + +// archive ancestor classes +{$IFDEF MSWINDOWS} +type + TJclSafecallInterfacedObject = class(TInterfacedObject) + public + function SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult; override; + end; + + TJclCompressionVolumeEvent = procedure(Sender: TObject; Index: Integer; + var AFileName: TFileName; var AStream: TStream; var AOwnsStream: Boolean) of object; + TJclCompressionVolumeMaxSizeEvent = procedure(Sender: TObject; Index: Integer; + var AVolumeMaxSize: Int64) of object; + TJclCompressionProgressEvent = procedure(Sender: TObject; const Value, MaxValue: Int64) of object; + TJclCompressionRatioEvent = procedure(Sender: TObject; const InSize, OutSize: Int64) of object; + TJclCompressionGetPasswordEvent = function (Sender: TObject; var Password: WideString): Boolean of object; + + TJclCompressionItemProperty = (ipPackedName, ipPackedSize, ipPackedExtension, + ipFileSize, ipFileName, ipAttributes, ipCreationTime, ipLastAccessTime, + ipLastWriteTime, ipComment, ipHostOS, ipHostFS, ipUser, ipGroup, ipCRC, + ipStream, ipMethod, ipEncrypted, ipPosixAttrib, ipLink); + TJclCompressionItemProperties = set of TJclCompressionItemProperty; + + TJclCompressionItemKind = (ikFile, ikDirectory); + + TJclCompressionOperationSuccess = (osNoOperation, osOK, osUnsupportedMethod, + osDataError, osCRCError, osUnknownError); + + TJclCompressionDuplicateCheck = (dcNone, dcExisting, dcAll); + TJclCompressionDuplicateAction = (daOverwrite, daError, daSkip); + + TJclCompressionArchive = class; + + TJclCompressionItem = class + private + FArchive: TJclCompressionArchive; + // source or destination + FFileName: TFileName; + FStream: TStream; + FOwnsStream: Boolean; + // miscellaneous + FValidProperties: TJclCompressionItemProperties; + FModifiedProperties: TJclCompressionItemProperties; + FPackedIndex: Cardinal; + FSelected: Boolean; + FOperationSuccess: TJclCompressionOperationSuccess; + // file properties + FPackedName: WideString; + FPackedSize: Int64; + FFileSize: Int64; + FAttributes: Cardinal; + FPackedExtension: WideString; + FCreationTime: TFileTime; + FLastAccessTime: TFileTime; + FLastWriteTime: TFileTime; + FComment: WideString; + FHostOS: WideString; + FHostFS: WideString; + FUser: WideString; + FGroup: WideString; + FCRC: Cardinal; + FMethod: WideString; + FEncrypted: Boolean; + FPosixAttrib: Cardinal; + FLink: WideString; + function WideChangeFileExt(const AFileName, AExtension: WideString): WideString; + function WideExtractFileExt(const AFileName: WideString): WideString; + function WideExtractFileName(const AFileName: WideString): WideString; + protected + // property checkers + procedure CheckGetProperty(AProperty: TJclCompressionItemProperty); virtual; abstract; + procedure CheckSetProperty(AProperty: TJclCompressionItemProperty); virtual; abstract; + function ValidateExtraction(Index: Integer): Boolean; virtual; + function DeleteOutputFile: Boolean; + function UpdateFileTimes: Boolean; + // property getters + function GetAttributes: Cardinal; + function GetComment: WideString; + function GetCRC: Cardinal; + function GetCreationTime: TFileTime; + function GetDirectory: Boolean; + function GetEncrypted: Boolean; + function GetFileName: TFileName; + function GetFileSize: Int64; + function GetGroup: WideString; + function GetHostFS: WideString; + function GetHostOS: WideString; + function GetItemKind: TJclCompressionItemKind; + function GetLastAccessTime: TFileTime; + function GetLastWriteTime: TFileTime; + function GetLink: WideString; + function GetMethod: WideString; + function GetNestedArchiveName: WideString; virtual; + function GetNestedArchiveStream: TStream; virtual; + function GetPackedExtension: WideString; + function GetPackedName: WideString; + function GetPackedSize: Int64; + function GetPosixAttrib: Cardinal; + function GetStream: TStream; + function GetUser: WideString; + // property setters + procedure SetAttributes(Value: Cardinal); + procedure SetComment(const Value: WideString); + procedure SetCRC(Value: Cardinal); + procedure SetCreationTime(const Value: TFileTime); + procedure SetDirectory(Value: Boolean); + procedure SetEncrypted(Value: Boolean); + procedure SetFileName(const Value: TFileName); + procedure SetFileSize(const Value: Int64); + procedure SetGroup(const Value: WideString); + procedure SetHostFS(const Value: WideString); + procedure SetHostOS(const Value: WideString); + procedure SetLastAccessTime(const Value: TFileTime); + procedure SetLastWriteTime(const Value: TFileTime); + procedure SetLink(const Value: WideString); + procedure SetMethod(const Value: WideString); + procedure SetPackedExtension(const Value: WideString); + procedure SetPackedName(const Value: WideString); + procedure SetPackedSize(const Value: Int64); + procedure SetPosixAttrib(Value: Cardinal); + procedure SetStream(const Value: TStream); + procedure SetUser(const Value: WideString); + public + constructor Create(AArchive: TJclCompressionArchive); + destructor Destroy; override; + // release stream if owned and created from file name + procedure ReleaseStream; + // properties in archive + property Attributes: Cardinal read GetAttributes write SetAttributes; + property Comment: WideString read GetComment write SetComment; + property CRC: Cardinal read GetCRC write SetCRC; + property CreationTime: TFileTime read GetCreationTime write SetCreationTime; + property Directory: Boolean read GetDirectory write SetDirectory; + property Encrypted: Boolean read GetEncrypted write SetEncrypted; + property FileSize: Int64 read GetFileSize write SetFileSize; + property Group: WideString read GetGroup write SetGroup; + property HostOS: WideString read GetHostOS write SetHostOS; + property HostFS: WideString read GetHostFS write SetHostFS; + property Kind: TJclCompressionItemKind read GetItemKind; + property LastAccessTime: TFileTime read GetLastAccessTime write SetLastAccessTime; + property LastWriteTime: TFileTime read GetLastWriteTime write SetLastWriteTime; + property Link: WideString read GetLink write SetLink; + property Method: WideString read GetMethod write SetMethod; + property PackedExtension: WideString read GetPackedExtension write SetPackedExtension; + property PackedName: WideString read GetPackedName write SetPackedName; + property PackedSize: Int64 read GetPackedSize write SetPackedSize; + property PosixAttrib: Cardinal read GetPosixAttrib write SetPosixAttrib; + property User: WideString read GetUser write SetUser; + // source or destination + property FileName: TFileName read GetFileName write SetFileName; + property OwnsStream: Boolean read FOwnsStream write FOwnsStream; + property Stream: TStream read GetStream write SetStream; + property NestedArchiveStream: TStream read GetNestedArchiveStream; + property NestedArchiveName: WideString read GetNestedArchiveName; + // miscellaneous + property Archive: TJclCompressionArchive read FArchive; + property OperationSuccess: TJclCompressionOperationSuccess read FOperationSuccess + write FOperationSuccess; + property ValidProperties: TJclCompressionItemProperties read FValidProperties; + property ModifiedProperties: TJclCompressionItemProperties read FModifiedProperties + write FModifiedProperties; + property PackedIndex: Cardinal read FPackedIndex; + property Selected: Boolean read FSelected write FSelected; + end; + + TJclCompressionItemClass = class of TJclCompressionItem; + + TJclCompressionVolume = class + protected + FFileName: TFileName; + FTmpFileName: TFileName; + FStream: TStream; + FTmpStream: TStream; + FOwnsStream: Boolean; + FOwnsTmpStream: Boolean; + FVolumeMaxSize: Int64; + public + constructor Create(AStream, ATmpStream: TStream; AOwnsStream, AOwnsTmpStream: Boolean; + AFileName, ATmpFileName: TFileName; AVolumeMaxSize: Int64); + destructor Destroy; override; + procedure ReleaseStreams; + property FileName: TFileName read FFileName; + property TmpFileName: TFileName read FTmpFileName; + property Stream: TStream read FStream; + property TmpStream: TStream read FTmpStream; + property OwnsStream: Boolean read FOwnsStream; + property OwnsTmpStream: Boolean read FOwnsTmpStream; + property VolumeMaxSize: Int64 read FVolumeMaxSize; + end; + + TJclStreamAccess = (saCreate, saReadOnly, saReadOnlyDenyNone, saWriteOnly, saReadWrite); + + { TJclCompressionArchive is not ref-counted } + TJclCompressionArchive = class(TJclSafecallInterfacedObject, IInterface) + private + FOnOpenPassword: TJclCompressionGetPasswordEvent; + FOnProgress: TJclCompressionProgressEvent; + FOnRatio: TJclCompressionRatioEvent; + FOnVolume: TJclCompressionVolumeEvent; + FOnVolumeMaxSize: TJclCompressionVolumeMaxSizeEvent; + FPassword: WideString; + FVolumeIndex: Integer; + FVolumeIndexOffset: Integer; + FVolumeMaxSize: Int64; + FVolumeFileNameMask: TFileName; + FProgressMax: Int64; + FCancelCurrentOperation: Boolean; + FCurrentItemIndex: Integer; + function GetItemCount: Integer; + function GetItem(Index: Integer): TJclCompressionItem; + function GetVolumeCount: Integer; + function GetVolume(Index: Integer): TJclCompressionVolume; + protected + FVolumes: TObjectList; + FItems: TObjectList; + + procedure InitializeArchiveProperties; virtual; + + function InternalOpenStream(const FileName: TFileName): TStream; + function TranslateItemPath(const ItemPath, OldBase, NewBase: WideString): WideString; + + function DoGetOpenPassword: Boolean; + function DoProgress(const Value, MaxValue: Int64): Boolean; + function DoRatio(const InSize, OutSize: Int64): Boolean; + function NeedStream(Index: Integer): TStream; + function NeedStreamMaxSize(Index: Integer): Int64; + procedure ReleaseVolumes; + function GetItemClass: TJclCompressionItemClass; virtual; abstract; + function GetSupportsNestedArchive: Boolean; virtual; + public + { IInterface } + // function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall; + function _AddRef: Integer; stdcall; + function _Release: Integer; stdcall; + public + class function MultipleItemContainer: Boolean; virtual; + class function VolumeAccess: TJclStreamAccess; virtual; + function ItemAccess: TJclStreamAccess; virtual; + class function ArchiveExtensions: string; virtual; + class function ArchiveName: string; virtual; + class function ArchiveSubExtensions: string; virtual; + class function ArchiveSignature: TDynByteArray; virtual; + + constructor Create(Volume0: TStream; AVolumeMaxSize: Int64 = 0; + AOwnVolume: Boolean = False); overload; virtual; + constructor Create(const VolumeFileName: TFileName; AVolumeMaxSize: Int64 = 0; + VolumeMask: Boolean = False); overload; virtual; + // if VolumeMask is true then VolumeFileName represents a mask to get volume file names + // "myfile%d.zip" "myfile.zip.%.3d" ... + destructor Destroy; override; + + function AddVolume(const VolumeFileName: TFileName; + AVolumeMaxSize: Int64 = 0): Integer; overload; virtual; + function AddVolume(const VolumeFileName, TmpVolumeFileName: TFileName; + AVolumeMaxSize: Int64 = 0): Integer; overload; virtual; + function AddVolume(VolumeStream: TStream; AVolumeMaxSize: Int64 = 0; + AOwnsStream: Boolean = False): Integer; overload; virtual; + function AddVolume(VolumeStream, TmpVolumeStream: TStream; AVolumeMaxSize: Int64 = 0; + AOwnsStream: Boolean = False; AOwnsTmpStream: Boolean = False): Integer; overload; virtual; + + // miscellaneous + procedure ClearVolumes; + procedure ClearItems; + + procedure CheckOperationSuccess; + procedure ClearOperationSuccess; + procedure SelectAll; + procedure UnselectAll; + + property ItemCount: Integer read GetItemCount; + property Items[Index: Integer]: TJclCompressionItem read GetItem; + + property VolumeCount: Integer read GetVolumeCount; + property Volumes[Index: Integer]: TJclCompressionVolume read GetVolume; + property VolumeMaxSize: Int64 read FVolumeMaxSize; + property VolumeFileNameMask: TFileName read FVolumeFileNameMask; + property VolumeIndexOffset: Integer read FVolumeIndexOffset write FVolumeIndexOffset; + + property CurrentItemIndex: Integer read FCurrentItemIndex; // valid during OnProgress + property OnOpenPassword: TJclCompressionGetPasswordEvent read FOnOpenPassword write FOnOpenPassword; + property OnProgress: TJclCompressionProgressEvent read FOnProgress write FOnProgress; + property OnRatio: TJclCompressionRatioEvent read FOnRatio write FOnRatio; + + // volume events + property OnVolume: TJclCompressionVolumeEvent read FOnVolume write FOnVolume; + property OnVolumeMaxSize: TJclCompressionVolumeMaxSizeEvent read FOnVolumeMaxSize + write FOnVolumeMaxSize; + property Password: WideString read FPassword write FPassword; + + property SupportsNestedArchive: Boolean read GetSupportsNestedArchive; + property CancelCurrentOperation: Boolean read FCancelCurrentOperation write FCancelCurrentOperation; + end; + + TJclCompressionArchiveClass = class of TJclCompressionArchive; + + IJclArchiveNumberOfThreads = interface + ['{9CFAB801-E68E-4A51-AC49-277B297F1141}'] + function GetNumberOfThreads: Cardinal; + procedure SetNumberOfThreads(Value: Cardinal); + property NumberOfThreads: Cardinal read GetNumberOfThreads write SetNumberOfThreads; + end; + + IJclArchiveCompressionLevel = interface + ['{A6A2F55F-2860-4E44-BC20-8C5D3E322AB6}'] + function GetCompressionLevel: Cardinal; + function GetCompressionLevelMax: Cardinal; + function GetCompressionLevelMin: Cardinal; + procedure SetCompressionLevel(Value: Cardinal); + property CompressionLevel: Cardinal read GetCompressionLevel write SetCompressionLevel; + property CompressionLevelMax: Cardinal read GetCompressionLevelMax; + property CompressionLevelMin: Cardinal read GetCompressionLevelMin; + end; + + TJclCompressionMethod = (cmCopy, cmDeflate, cmDeflate64, cmBZip2, cmLZMA, cmLZMA2, cmPPMd); + TJclCompressionMethods = set of TJclCompressionMethod; + + IJclArchiveCompressionMethod = interface + ['{2818F8E8-7D5F-4C8C-865E-9BA4512BB766}'] + function GetCompressionMethod: TJclCompressionMethod; + function GetSupportedCompressionMethods: TJclCompressionMethods; + procedure SetCompressionMethod(Value: TJclCompressionMethod); + property CompressionMethod: TJclCompressionMethod read GetCompressionMethod write SetCompressionMethod; + property SupportedCompressionMethods: TJclCompressionMethods read GetSupportedCompressionMethods; + end; + + TJclEncryptionMethod = (emNone, emAES128, emAES192, emAES256, emZipCrypto); + TJclEncryptionMethods = set of TJclEncryptionMethod; + + IJclArchiveEncryptionMethod = interface + ['{643485B6-66A1-41C9-A13B-0A8453E9D0C9}'] + function GetEncryptionMethod: TJclEncryptionMethod; + function GetSupportedEncryptionMethods: TJclEncryptionMethods; + procedure SetEncryptionMethod(Value: TJclEncryptionMethod); + property EncryptionMethod: TJclEncryptionMethod read GetEncryptionMethod write SetEncryptionMethod; + property SupportedEncryptionMethods: TJclEncryptionMethods read GetSupportedEncryptionMethods; + end; + + IJclArchiveDictionarySize = interface + ['{D3949834-9F3B-49BC-8403-FE3CE5FDCF35}'] + function GetDictionarySize: Cardinal; + procedure SetDictionarySize(Value: Cardinal); + property DictionarySize: Cardinal read GetDictionarySize write SetDictionarySize; + end; + + IJclArchiveNumberOfPasses = interface + ['{C61B2814-50CE-4C3C-84A5-BACF8A57E3BC}'] + function GetNumberOfPasses: Cardinal; + procedure SetNumberOfPasses(Value: Cardinal); + property NumberOfPasses: Cardinal read GetNumberOfPasses write SetNumberOfPasses; + end; + + IJclArchiveRemoveSfxBlock = interface + ['{852D050D-734E-4610-902A-8FB845DB32A9}'] + function GetRemoveSfxBlock: Boolean; + procedure SetRemoveSfxBlock(Value: Boolean); + property RemoveSfxBlock: Boolean read GetRemoveSfxBlock write SetRemoveSfxBlock; + end; + + IJclArchiveCompressHeader = interface + ['{22C62A3B-A58E-4F88-9D3F-08586B542639}'] + function GetCompressHeader: Boolean; + function GetCompressHeaderFull: Boolean; + procedure SetCompressHeader(Value: Boolean); + procedure SetCompressHeaderFull(Value: Boolean); + property CompressHeader: Boolean read GetCompressHeader write SetCompressHeader; + property CompressHeaderFull: Boolean read GetCompressHeaderFull write SetCompressHeaderFull; + end; + + IJclArchiveEncryptHeader = interface + ['{7DBA20A8-48A1-4CA2-B9AC-41C219A09A4A}'] + function GetEncryptHeader: Boolean; + procedure SetEncryptHeader(Value: Boolean); + property EncryptHeader: Boolean read GetEncryptHeader write SetEncryptHeader; + end; + + IJclArchiveSaveCreationDateTime = interface + ['{8B212BF9-C13F-4582-A4FA-A40E538EFF65}'] + function GetSaveCreationDateTime: Boolean; + procedure SetSaveCreationDateTime(Value: Boolean); + property SaveCreationDateTime: Boolean read GetSaveCreationDateTime write SetSaveCreationDateTime; + end; + + IJclArchiveSaveLastAccessDateTime = interface + ['{1A4B2906-9DD2-4584-B7A3-3639DA92AFC5}'] + function GetSaveLastAccessDateTime: Boolean; + procedure SetSaveLastAccessDateTime(Value: Boolean); + property SaveLastAccessDateTime: Boolean read GetSaveLastAccessDateTime write SetSaveLastAccessDateTime; + end; + + IJclArchiveSaveLastWriteDateTime = interface + ['{0C1729DC-35E8-43D4-8ECA-54F20CDFF87A}'] + function GetSaveLastWriteDateTime: Boolean; + procedure SetSaveLastWriteDateTime(Value: Boolean); + property SaveLastWriteDateTime: Boolean read GetSaveLastWriteDateTime write SetSaveLastWriteDateTime; + end; + + IJclArchiveAlgorithm = interface + ['{53965F1F-24CC-4548-B9E8-5AE2EB7F142D}'] + function GetAlgorithm: Cardinal; + function GetSupportedAlgorithms: TDynCardinalArray; + procedure SetAlgorithm(Value: Cardinal); + property Algorithm: Cardinal read GetAlgorithm write SetAlgorithm; + property SupportedAlgorithms: TDynCardinalArray read GetSupportedAlgorithms; + end; + + IJclArchiveSolid = interface + ['{6902C54C-1577-422C-B18B-E27953A28661}'] + function GetSolidBlockSize: Int64; + function GetSolidExtension: Boolean; + procedure SetSolidBlockSize(const Value: Int64); + procedure SetSolidExtension(Value: Boolean); + property SolidBlockSize: Int64 read GetSolidBlockSize write SetSolidBlockSize; + property SolidExtension: Boolean read GetSolidExtension write SetSolidExtension; + end; + + TJclCompressItem = class(TJclCompressionItem) + protected + procedure CheckGetProperty(AProperty: TJclCompressionItemProperty); override; + procedure CheckSetProperty(AProperty: TJclCompressionItemProperty); override; + end; + + TJclCompressArchive = class(TJclCompressionArchive, IInterface) + private + FBaseRelName: WideString; + FBaseDirName: string; + FAddFilesInDir: Boolean; + FDuplicateAction: TJclCompressionDuplicateAction; + FDuplicateCheck: TJclCompressionDuplicateCheck; + procedure InternalAddFile(const Directory: string; const FileInfo: TSearchRec); + procedure InternalAddDirectory(const Directory: string); + protected + FCompressing: Boolean; + FPackedNames: TJclWideStringList; + procedure CheckNotCompressing; + function AddFileCheckDuplicate(NewItem: TJclCompressionItem): Integer; + public + class function VolumeAccess: TJclStreamAccess; override; + function ItemAccess: TJclStreamAccess; override; + + destructor Destroy; override; + + function AddDirectory(const PackedName: WideString; + const DirName: string = ''; RecurseIntoDir: Boolean = False; + AddFilesInDir: Boolean = False): Integer; overload; virtual; + function AddFile(const PackedName: WideString; + const FileName: TFileName): Integer; overload; virtual; + function AddFile(const PackedName: WideString; AStream: TStream; + AOwnsStream: Boolean = False): Integer; overload; virtual; + procedure Compress; virtual; + + property DuplicateCheck: TJclCompressionDuplicateCheck read FDuplicateCheck write FDuplicateCheck; + property DuplicateAction: TJclCompressionDuplicateAction read FDuplicateAction write FDuplicateAction; + end; + + TJclCompressArchiveClass = class of TJclCompressArchive; + + TJclCompressArchiveClassArray = array of TJclCompressArchiveClass; + + TJclDecompressItem = class(TJclCompressionItem) + protected + procedure CheckGetProperty(AProperty: TJclCompressionItemProperty); override; + procedure CheckSetProperty(AProperty: TJclCompressionItemProperty); override; + function ValidateExtraction(Index: Integer): Boolean; override; + end; + + // return False not to extract this file + // assign your own FileName, Stream or AOwnsStream to override default one + TJclCompressionExtractEvent = function (Sender: TObject; Index: Integer; + var FileName: TFileName; var Stream: TStream; var AOwnsStream: Boolean): Boolean of object; + + TJclDecompressArchive = class(TJclCompressionArchive, IInterface) + private + FOnExtract: TJclCompressionExtractEvent; + FAutoCreateSubDir: Boolean; + protected + FDecompressing: Boolean; + FListing: Boolean; + FDestinationDir: string; + FExtractingAllIndex: Integer; + procedure CheckNotDecompressing; + procedure CheckListing; + + function ValidateExtraction(Index: Integer; var FileName: TFileName; var AStream: TStream; + var AOwnsStream: Boolean): Boolean; virtual; + public + class function VolumeAccess: TJclStreamAccess; override; + function ItemAccess: TJclStreamAccess; override; + + procedure ListFiles; virtual; abstract; + procedure ExtractSelected(const ADestinationDir: string = ''; + AAutoCreateSubDir: Boolean = True); virtual; + procedure ExtractAll(const ADestinationDir: string = ''; + AAutoCreateSubDir: Boolean = True); virtual; + + property OnExtract: TJclCompressionExtractEvent read FOnExtract write FOnExtract; + property DestinationDir: string read FDestinationDir; + property AutoCreateSubDir: Boolean read FAutoCreateSubDir; + end; + + TJclDecompressArchiveClass = class of TJclDecompressArchive; + + TJclDecompressArchiveClassArray = array of TJclDecompressArchiveClass; + + TJclUpdateItem = class(TJclCompressionItem) + protected + procedure CheckGetProperty(AProperty: TJclCompressionItemProperty); override; + procedure CheckSetProperty(AProperty: TJclCompressionItemProperty); override; + function ValidateExtraction(Index: Integer): Boolean; override; + end; + + TJclUpdateArchive = class(TJclCompressArchive, IInterface) + private + FOnExtract: TJclCompressionExtractEvent; + FAutoCreateSubDir: Boolean; + protected + FDecompressing: Boolean; + FListing: Boolean; + FDestinationDir: string; + FExtractingAllIndex: Integer; + procedure CheckNotDecompressing; + procedure CheckListing; + + procedure InitializeArchiveProperties; override; + + function ValidateExtraction(Index: Integer; var FileName: TFileName; var AStream: TStream; + var AOwnsStream: Boolean): Boolean; virtual; + public + class function VolumeAccess: TJclStreamAccess; override; + function ItemAccess: TJclStreamAccess; override; + + procedure ListFiles; virtual; abstract; + procedure ExtractSelected(const ADestinationDir: string = ''; + AAutoCreateSubDir: Boolean = True); virtual; + procedure ExtractAll(const ADestinationDir: string = ''; + AAutoCreateSubDir: Boolean = True); virtual; + procedure DeleteItem(Index: Integer); virtual; abstract; + procedure RemoveItem(const PackedName: WideString); virtual; abstract; + + property OnExtract: TJclCompressionExtractEvent read FOnExtract write FOnExtract; + property DestinationDir: string read FDestinationDir; + property AutoCreateSubDir: Boolean read FAutoCreateSubDir; + end; + + // ancestor class for all archives that update files in-place (not creating a copy of the volumes) + TJclInPlaceUpdateArchive = class(TJclUpdateArchive, IInterface) + end; + + // called when tmp volumes will replace volumes after out-of-place update + TJclCompressionReplaceEvent = function (Sender: TObject; const SrcFileName, DestFileName: TFileName; + var SrcStream, DestStream: TStream; var OwnsSrcStream, OwnsDestStream: Boolean): Boolean of object; + + // ancestor class for all archives that update files out-of-place (by creating a copy of the volumes) + TJclOutOfPlaceUpdateArchive = class(TJclUpdateArchive, IInterface) + private + FReplaceVolumes: Boolean; + FTmpVolumeIndex: Integer; + FOnReplace: TJclCompressionReplaceEvent; + FOnTmpVolume: TJclCompressionVolumeEvent; + protected + function NeedTmpStream(Index: Integer): TStream; + procedure InitializeArchiveProperties; override; + function InternalOpenTmpStream(const FileName: TFileName): TStream; + public + class function TmpVolumeAccess: TJclStreamAccess; virtual; + + procedure Compress; override; + + property ReplaceVolumes: Boolean read FReplaceVolumes write FReplaceVolumes; + property OnReplace: TJclCompressionReplaceEvent read FOnReplace write FOnReplace; + property OnTmpVolume: TJclCompressionVolumeEvent read FOnTmpVolume write FOnTmpVolume; + end; + + TJclUpdateArchiveClass = class of TJclUpdateArchive; + + TJclUpdateArchiveClassArray = array of TJclUpdateArchiveClass; + +// registered archive formats +type + TJclCompressionArchiveFormats = class + private + FCompressFormats: TList; + FDecompressFormats: TList; + FUpdateFormats: TList; + protected + function GetCompressFormatCount: Integer; + function GetCompressFormat(Index: Integer): TJclCompressArchiveClass; + function GetDecompressFormatCount: Integer; + function GetDecompressFormat(Index: Integer): TJclDecompressArchiveClass; + function GetUpdateFormatCount: Integer; + function GetUpdateFormat(Index: Integer): TJclUpdateArchiveClass; + public + constructor Create; + destructor Destroy; override; + + procedure RegisterFormat(AClass: TJclCompressionArchiveClass); + procedure UnregisterFormat(AClass: TJclCompressionArchiveClass); + + // archive signatures do not give significant results for ISO/UDF (signature is not located at stream start) + // need to find a generic way to match all signature before publishing the code + //function SignatureMatches(Format: TJclCompressionArchiveClass; ArchiveStream: TStream; var Buffer: TDynByteArray): Boolean; + function FindCompressFormat(const AFileName: TFileName): TJclCompressArchiveClass; + //function FindDecompressFormat(const AFileName: TFileName; TestArchiveSignature: Boolean): TJclDecompressArchiveClass; overload; + function FindDecompressFormat(const AFileName: TFileName): TJclDecompressArchiveClass; //overload; + //function FindUpdateFormat(const AFileName: TFileName; TestArchiveSignature: Boolean): TJclUpdateArchiveClass; overload; + function FindUpdateFormat(const AFileName: TFileName): TJclUpdateArchiveClass; //overload; + + function FindCompressFormats(const AFileName: TFileName): TJclCompressArchiveClassArray; + function FindDecompressFormats(const AFileName: TFileName): TJclDecompressArchiveClassArray; + function FindUpdateFormats(const AFileName: TFileName): TJclUpdateArchiveClassArray; + + property CompressFormatCount: Integer read GetCompressFormatCount; + property CompressFormats[Index: Integer]: TJclCompressArchiveClass read GetCompressFormat; + property DecompressFormatCount: Integer read GetDecompressFormatCount; + property DecompressFormats[Index: Integer]: TJclDecompressArchiveClass read GetDecompressFormat; + property UpdateFormatCount: Integer read GetUpdateFormatCount; + property UpdateFormats[Index: Integer]: TJclUpdateArchiveClass read GetUpdateFormat; + end; + +// retreive a singleton list containing archive formats +function GetArchiveFormats: TJclCompressionArchiveFormats; + +// sevenzip classes for compression +type + TJclSevenzipCompressArchive = class(TJclCompressArchive, IInterface) + private + FOutArchive: IOutArchive; + protected + function GetItemClass: TJclCompressionItemClass; override; + function GetOutArchive: IOutArchive; + public + class function ArchiveCLSID: TGUID; virtual; + class function ArchiveSignature: TDynByteArray; override; + destructor Destroy; override; + procedure Compress; override; + property OutArchive: IOutArchive read GetOutArchive; + end; + + // file formats + + TJclZipCompressArchive = class(TJclSevenzipCompressArchive, IJclArchiveCompressionLevel, IJclArchiveCompressionMethod, + IJclArchiveEncryptionMethod, IJclArchiveDictionarySize, IJclArchiveNumberOfPasses, IJclArchiveNumberOfThreads, + IJclArchiveAlgorithm, IInterface) + private + FNumberOfThreads: Cardinal; + FEncryptionMethod: TJclEncryptionMethod; + FDictionarySize: Cardinal; + FCompressionLevel: Cardinal; + FCompressionMethod: TJclCompressionMethod; + FNumberOfPasses: Cardinal; + FAlgorithm: Cardinal; + protected + procedure InitializeArchiveProperties; override; + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + { IJclArchiveNumberOfThreads } + function GetNumberOfThreads: Cardinal; + procedure SetNumberOfThreads(Value: Cardinal); + { IJclArchiveEncryptionMethod } + function GetEncryptionMethod: TJclEncryptionMethod; + function GetSupportedEncryptionMethods: TJclEncryptionMethods; + procedure SetEncryptionMethod(Value: TJclEncryptionMethod); + { IJclArchiveDictionarySize } + function GetDictionarySize: Cardinal; + procedure SetDictionarySize(Value: Cardinal); + { IJclArchiveCompressionLevel } + function GetCompressionLevel: Cardinal; + function GetCompressionLevelMax: Cardinal; + function GetCompressionLevelMin: Cardinal; + procedure SetCompressionLevel(Value: Cardinal); + { IJclArchiveCompressionMethod } + function GetCompressionMethod: TJclCompressionMethod; + function GetSupportedCompressionMethods: TJclCompressionMethods; + procedure SetCompressionMethod(Value: TJclCompressionMethod); + { IJclArchiveNumberOfPasses } + function GetNumberOfPasses: Cardinal; + procedure SetNumberOfPasses(Value: Cardinal); + { IJclArchiveAlgoritm } + function GetAlgorithm: Cardinal; + function GetSupportedAlgorithms: TDynCardinalArray; + procedure SetAlgorithm(Value: Cardinal); + end; + + TJclBZ2CompressArchive = class(TJclSevenzipCompressArchive, IJclArchiveCompressionLevel, IJclArchiveDictionarySize, + IJclArchiveNumberOfPasses, IJclArchiveNumberOfThreads, IInterface) + private + FNumberOfThreads: Cardinal; + FDictionarySize: Cardinal; + FCompressionLevel: Cardinal; + FNumberOfPasses: Cardinal; + protected + procedure InitializeArchiveProperties; override; + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveSubExtensions: string; override; + class function ArchiveCLSID: TGUID; override; + { IJclArchiveNumberOfThreads } + function GetNumberOfThreads: Cardinal; + procedure SetNumberOfThreads(Value: Cardinal); + { IJclArchiveDictionarySize } + function GetDictionarySize: Cardinal; + procedure SetDictionarySize(Value: Cardinal); + { IJclArchiveCompressionLevel } + function GetCompressionLevel: Cardinal; + function GetCompressionLevelMax: Cardinal; + function GetCompressionLevelMin: Cardinal; + procedure SetCompressionLevel(Value: Cardinal); + { IJclArchiveNumberOfPasses } + function GetNumberOfPasses: Cardinal; + procedure SetNumberOfPasses(Value: Cardinal); + end; + + TJcl7zCompressArchive = class(TJclSevenzipCompressArchive, IJclArchiveCompressionLevel, IJclArchiveDictionarySize, + IJclArchiveNumberOfThreads, IJclArchiveRemoveSfxBlock, IJclArchiveCompressHeader, IJclArchiveEncryptHeader, + IJclArchiveSaveCreationDateTime, IJclArchiveSaveLastAccessDateTime, IJclArchiveSaveLastWriteDateTime, + IJclArchiveSolid, IInterface) + private + FNumberOfThreads: Cardinal; + FEncryptHeader: Boolean; + FRemoveSfxBlock: Boolean; + FDictionarySize: Cardinal; + FCompressionLevel: Cardinal; + FCompressHeader: Boolean; + FCompressHeaderFull: Boolean; + FSaveLastAccessDateTime: Boolean; + FSaveCreationDateTime: Boolean; + FSaveLastWriteDateTime: Boolean; + FSolidBlockSize: Int64; + FSolidExtension: Boolean; + protected + procedure InitializeArchiveProperties; override; + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + { IJclArchiveNumberOfThreads } + function GetNumberOfThreads: Cardinal; + procedure SetNumberOfThreads(Value: Cardinal); + { IJclArchiveEncryptHeader } + function GetEncryptHeader: Boolean; + procedure SetEncryptHeader(Value: Boolean); + { IJclArchiveRemoveSfxBlock } + function GetRemoveSfxBlock: Boolean; + procedure SetRemoveSfxBlock(Value: Boolean); + { IJclArchiveDictionarySize } + function GetDictionarySize: Cardinal; + procedure SetDictionarySize(Value: Cardinal); + { IJclArchiveCompressionLevel } + function GetCompressionLevel: Cardinal; + function GetCompressionLevelMax: Cardinal; + function GetCompressionLevelMin: Cardinal; + procedure SetCompressionLevel(Value: Cardinal); + { IJclArchiveCompressHeader } + function GetCompressHeader: Boolean; + function GetCompressHeaderFull: Boolean; + procedure SetCompressHeader(Value: Boolean); + procedure SetCompressHeaderFull(Value: Boolean); + { IJclArchiveSaveLastAccessDateTime } + function GetSaveLastAccessDateTime: Boolean; + procedure SetSaveLastAccessDateTime(Value: Boolean); + { IJclArchiveSaveCreationDateTime } + function GetSaveCreationDateTime: Boolean; + procedure SetSaveCreationDateTime(Value: Boolean); + { IJclArchiveSaveLastWriteDateTime } + function GetSaveLastWriteDateTime: Boolean; + procedure SetSaveLastWriteDateTime(Value: Boolean); + { IJclArchiveSolid } + function GetSolidBlockSize: Int64; + function GetSolidExtension: Boolean; + procedure SetSolidBlockSize(const Value: Int64); + procedure SetSolidExtension(Value: Boolean); + end; + + TJclTarCompressArchive = class(TJclSevenzipCompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclGZipCompressArchive = class(TJclSevenzipCompressArchive, IJclArchiveCompressionLevel, IJclArchiveNumberOfPasses, + IJclArchiveAlgorithm, IInterface) + private + FCompressionLevel: Cardinal; + FNumberOfPasses: Cardinal; + FAlgorithm: Cardinal; + protected + procedure InitializeArchiveProperties; override; + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveSubExtensions: string; override; + class function ArchiveCLSID: TGUID; override; + { IJclArchiveCompressionLevel } + function GetCompressionLevel: Cardinal; + function GetCompressionLevelMax: Cardinal; + function GetCompressionLevelMin: Cardinal; + procedure SetCompressionLevel(Value: Cardinal); + { IJclArchiveNumberOfPasses } + function GetNumberOfPasses: Cardinal; + procedure SetNumberOfPasses(Value: Cardinal); + { IJclArchiveAlgorithm } + function GetAlgorithm: Cardinal; + function GetSupportedAlgorithms: TDynCardinalArray; + procedure SetAlgorithm(Value: Cardinal); + end; + + TJclXzCompressArchive = class(TJclSevenzipCompressArchive, IJclArchiveCompressionMethod, IInterface) + private + FCompressionMethod: TJclCompressionMethod; + protected + procedure InitializeArchiveProperties; override; + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveSubExtensions: string; override; + class function ArchiveCLSID: TGUID; override; + { IJclArchiveCompressionMethod } + function GetCompressionMethod: TJclCompressionMethod; + function GetSupportedCompressionMethods: TJclCompressionMethods; + procedure SetCompressionMethod(Value: TJclCompressionMethod); + end; + + TJclSwfcCompressArchive = class(TJclSevenzipCompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclWimCompressArchive = class(TJclSevenzipCompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + +// sevenzip classes for decompression +type + TJclSevenzipDecompressItem = class(TJclDecompressItem) + protected + function GetNestedArchiveStream: TStream; override; + end; + + TJclSevenzipDecompressArchive = class(TJclDecompressArchive, IInterface) + private + FInArchive: IInArchive; + FInArchiveGetStream: IInArchiveGetStream; + FOpened: Boolean; + protected + procedure OpenArchive; + function GetInArchive: IInArchive; + function GetInArchiveGetStream: IInArchiveGetStream; + function GetItemClass: TJclCompressionItemClass; override; + function GetSupportsNestedArchive: Boolean; override; + public + class function ArchiveCLSID: TGUID; virtual; + class function ArchiveSignature: TDynByteArray; override; + destructor Destroy; override; + procedure ListFiles; override; + procedure ExtractSelected(const ADestinationDir: string = ''; + AAutoCreateSubDir: Boolean = True); override; + procedure ExtractAll(const ADestinationDir: string = ''; + AAutoCreateSubDir: Boolean = True); override; + property InArchive: IInArchive read GetInArchive; + property InArchiveGetStream: IInArchiveGetStream read GetInArchiveGetStream; + end; + + // file formats + + TJclZipDecompressArchive = class(TJclSevenzipDecompressArchive, IJclArchiveNumberOfThreads, IInterface) + private + FNumberOfThreads: Cardinal; + protected + procedure InitializeArchiveProperties; override; + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + { IJclArchiveNumberOfThreads } + function GetNumberOfThreads: Cardinal; + procedure SetNumberOfThreads(Value: Cardinal); + end; + + TJclBZ2DecompressArchive = class(TJclSevenzipDecompressArchive, IJclArchiveNumberOfThreads, IInterface) + private + FNumberOfThreads: Cardinal; + protected + procedure InitializeArchiveProperties; override; + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveSubExtensions: string; override; + class function ArchiveCLSID: TGUID; override; + { IJclArchiveNumberOfThreads } + function GetNumberOfThreads: Cardinal; + procedure SetNumberOfThreads(Value: Cardinal); + end; + + TJclRarDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclArjDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclZDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveSubExtensions: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclLzhDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJcl7zDecompressArchive = class(TJclSevenzipDecompressArchive, IJclArchiveNumberOfThreads, IInterface) + private + FNumberOfThreads: Cardinal; + protected + procedure InitializeArchiveProperties; override; + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + { IJclArchiveNumberOfThreads } + function GetNumberOfThreads: Cardinal; + procedure SetNumberOfThreads(Value: Cardinal); + end; + + TJclCabDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclNsisDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclLzmaDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclLzma86DecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclPeDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclElfDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclMachoDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclUdfDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclXarDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclMubDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclHfsDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclDmgDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclCompoundDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclWimDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclIsoDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + // not implemented in 9.04 + {TJclBkfDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + protected + function GetCLSID: TGUID; override; + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + end;} + + TJclChmDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclSplitDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclRpmDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclDebDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclCpioDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclTarDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclGZipDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveSubExtensions: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclXzDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveSubExtensions: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclNtfsDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclFatDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclMbrDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclVhdDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveSubExtensions: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclMslzDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclFlvDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclSwfDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclSwfcDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclAPMDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclPpmdDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclTEDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclUEFIcDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclUEFIsDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclSquashFSDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclCramFSDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclExtDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclVMDKDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclVDIDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclQcowDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclGPTDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclRar5DecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclIHexDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclHxsDecompressArchive = class(TJclSevenzipDecompressArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + +//sevenzip classes for updates (read and write) +type + TJclSevenzipUpdateArchive = class(TJclOutOfPlaceUpdateArchive, IInterface) + private + FInArchive: IInArchive; + FOutArchive: IOutArchive; + FOpened: Boolean; + protected + procedure OpenArchive; + function GetInArchive: IInArchive; + function GetItemClass: TJclCompressionItemClass; override; + function GetOutArchive: IOutArchive; + public + class function ArchiveCLSID: TGUID; virtual; + class function ArchiveSignature: TDynByteArray; override; + destructor Destroy; override; + procedure ListFiles; override; + procedure ExtractSelected(const ADestinationDir: string = ''; + AAutoCreateSubDir: Boolean = True); override; + procedure ExtractAll(const ADestinationDir: string = ''; + AAutoCreateSubDir: Boolean = True); override; + procedure Compress; override; + procedure DeleteItem(Index: Integer); override; + procedure RemoveItem(const PackedName: WideString); override; + property InArchive: IInArchive read GetInArchive; + property OutArchive: IOutArchive read GetOutArchive; + end; + + TJclZipUpdateArchive = class(TJclSevenzipUpdateArchive, IJclArchiveCompressionLevel, IJclArchiveCompressionMethod, + IJclArchiveEncryptionMethod, IJclArchiveDictionarySize, IJclArchiveNumberOfPasses, IJclArchiveNumberOfThreads, + IJclArchiveAlgorithm, IInterface) + private + FNumberOfThreads: Cardinal; + FEncryptionMethod: TJclEncryptionMethod; + FDictionarySize: Cardinal; + FCompressionLevel: Cardinal; + FCompressionMethod: TJclCompressionMethod; + FNumberOfPasses: Cardinal; + FAlgorithm: Cardinal; + protected + procedure InitializeArchiveProperties; override; + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + { IJclArchiveNumberOfThreads } + function GetNumberOfThreads: Cardinal; + procedure SetNumberOfThreads(Value: Cardinal); + { IJclArchiveEncryptionMethod } + function GetEncryptionMethod: TJclEncryptionMethod; + function GetSupportedEncryptionMethods: TJclEncryptionMethods; + procedure SetEncryptionMethod(Value: TJclEncryptionMethod); + { IJclArchiveDictionarySize } + function GetDictionarySize: Cardinal; + procedure SetDictionarySize(Value: Cardinal); + { IJclArchiveCompressionLevel } + function GetCompressionLevel: Cardinal; + function GetCompressionLevelMax: Cardinal; + function GetCompressionLevelMin: Cardinal; + procedure SetCompressionLevel(Value: Cardinal); + { IJclArchiveCompressionMethod } + function GetCompressionMethod: TJclCompressionMethod; + function GetSupportedCompressionMethods: TJclCompressionMethods; + procedure SetCompressionMethod(Value: TJclCompressionMethod); + { IJclArchiveNumberOfPasses } + function GetNumberOfPasses: Cardinal; + procedure SetNumberOfPasses(Value: Cardinal); + { IJclArchiveAlgoritm } + function GetAlgorithm: Cardinal; + function GetSupportedAlgorithms: TDynCardinalArray; + procedure SetAlgorithm(Value: Cardinal); + end; + + TJclBZ2UpdateArchive = class(TJclSevenzipUpdateArchive, IJclArchiveCompressionLevel, IJclArchiveDictionarySize, + IJclArchiveNumberOfPasses, IJclArchiveNumberOfThreads, IInterface) + private + FNumberOfThreads: Cardinal; + FDictionarySize: Cardinal; + FCompressionLevel: Cardinal; + FNumberOfPasses: Cardinal; + protected + procedure InitializeArchiveProperties; override; + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveSubExtensions: string; override; + class function ArchiveCLSID: TGUID; override; + { IJclArchiveNumberOfThreads } + function GetNumberOfThreads: Cardinal; + procedure SetNumberOfThreads(Value: Cardinal); + { IJclArchiveDictionarySize } + function GetDictionarySize: Cardinal; + procedure SetDictionarySize(Value: Cardinal); + { IJclArchiveCompressionLevel } + function GetCompressionLevel: Cardinal; + function GetCompressionLevelMax: Cardinal; + function GetCompressionLevelMin: Cardinal; + procedure SetCompressionLevel(Value: Cardinal); + { IJclArchiveNumberOfPasses } + function GetNumberOfPasses: Cardinal; + procedure SetNumberOfPasses(Value: Cardinal); + end; + + TJcl7zUpdateArchive = class(TJclSevenzipUpdateArchive, IJclArchiveCompressionLevel, IJclArchiveDictionarySize, + IJclArchiveNumberOfThreads, IJclArchiveRemoveSfxBlock, IJclArchiveCompressHeader, IJclArchiveEncryptHeader, + IJclArchiveSaveCreationDateTime, IJclArchiveSaveLastAccessDateTime, IJclArchiveSaveLastWriteDateTime, IInterface) + private + FNumberOfThreads: Cardinal; + FEncryptHeader: Boolean; + FRemoveSfxBlock: Boolean; + FDictionarySize: Cardinal; + FCompressionLevel: Cardinal; + FCompressHeader: Boolean; + FCompressHeaderFull: Boolean; + FSaveLastAccessDateTime: Boolean; + FSaveCreationDateTime: Boolean; + FSaveLastWriteDateTime: Boolean; + protected + procedure InitializeArchiveProperties; override; + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + { IJclArchiveNumberOfThreads } + function GetNumberOfThreads: Cardinal; + procedure SetNumberOfThreads(Value: Cardinal); + { IJclArchiveEncryptHeader } + function GetEncryptHeader: Boolean; + procedure SetEncryptHeader(Value: Boolean); + { IJclArchiveRemoveSfxBlock } + function GetRemoveSfxBlock: Boolean; + procedure SetRemoveSfxBlock(Value: Boolean); + { IJclArchiveDictionarySize } + function GetDictionarySize: Cardinal; + procedure SetDictionarySize(Value: Cardinal); + { IJclArchiveCompressionLevel } + function GetCompressionLevel: Cardinal; + function GetCompressionLevelMax: Cardinal; + function GetCompressionLevelMin: Cardinal; + procedure SetCompressionLevel(Value: Cardinal); + { IJclArchiveCompressHeader } + function GetCompressHeader: Boolean; + function GetCompressHeaderFull: Boolean; + procedure SetCompressHeader(Value: Boolean); + procedure SetCompressHeaderFull(Value: Boolean); + { IJclArchiveSaveLastAccessDateTime } + function GetSaveLastAccessDateTime: Boolean; + procedure SetSaveLastAccessDateTime(Value: Boolean); + { IJclArchiveSaveCreationDateTime } + function GetSaveCreationDateTime: Boolean; + procedure SetSaveCreationDateTime(Value: Boolean); + { IJclArchiveSaveLastWriteDateTime } + function GetSaveLastWriteDateTime: Boolean; + procedure SetSaveLastWriteDateTime(Value: Boolean); + end; + + TJclTarUpdateArchive = class(TJclSevenzipUpdateArchive, IInterface) + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + + TJclGZipUpdateArchive = class(TJclSevenzipUpdateArchive, IJclArchiveCompressionLevel, IJclArchiveNumberOfPasses, + IJclArchiveAlgorithm, IInterface) + private + FCompressionLevel: Cardinal; + FNumberOfPasses: Cardinal; + FAlgorithm: Cardinal; + protected + procedure InitializeArchiveProperties; override; + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveSubExtensions: string; override; + class function ArchiveCLSID: TGUID; override; + { IJclArchiveCompressionLevel } + function GetCompressionLevel: Cardinal; + function GetCompressionLevelMax: Cardinal; + function GetCompressionLevelMin: Cardinal; + procedure SetCompressionLevel(Value: Cardinal); + { IJclArchiveNumberOfPasses } + function GetNumberOfPasses: Cardinal; + procedure SetNumberOfPasses(Value: Cardinal); + { IJclArchiveAlgorithm } + function GetAlgorithm: Cardinal; + function GetSupportedAlgorithms: TDynCardinalArray; + procedure SetAlgorithm(Value: Cardinal); + end; + + TJclXzUpdateArchive = class(TJclSevenzipUpdateArchive, IJclArchiveCompressionMethod, IInterface) + private + FCompressionMethod: TJclCompressionMethod; + protected + procedure InitializeArchiveProperties; override; + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveSubExtensions: string; override; + class function ArchiveCLSID: TGUID; override; + { IJclArchiveCompressionMethod } + function GetCompressionMethod: TJclCompressionMethod; + function GetSupportedCompressionMethods: TJclCompressionMethods; + procedure SetCompressionMethod(Value: TJclCompressionMethod); + end; + + TJclSwfcUpdateArchive = class(TJclSevenzipUpdateArchive, IInterface) + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + class function ArchiveCLSID: TGUID; override; + end; + +// internal sevenzip stuff, do not use it directly +type + TJclSevenzipOutStream = class(TJclSafecallInterfacedObject, + ISequentialOutStream, IOutStream, IUnknown) + private + FArchive: TJclCompressionArchive; + FItemIndex: Integer; + FStream: TStream; + FOwnsStream: Boolean; + FTruncateOnRelease: Boolean; + FMaximumPosition: Int64; + procedure NeedStream; + procedure ReleaseStream; + public + constructor Create(AArchive: TJclCompressionArchive; AItemIndex: Integer); overload; + constructor Create(AStream: TStream; AOwnsStream: Boolean; ATruncateOnRelease: Boolean); overload; + destructor Destroy; override; + // ISequentialOutStream + procedure Write(Data: Pointer; Size: Cardinal; ProcessedSize: PCardinal); safecall; + // IOutStream + procedure Seek(Offset: Int64; SeekOrigin: Cardinal; NewPosition: PInt64); safecall; + procedure SetSize(NewSize: Int64); safecall; + end; + + TJclSevenzipNestedInStream = class(TJclStream) + private + FInStream: IInStream; + protected + procedure SetSize(const NewSize: Int64); override; + public + constructor Create(AInStream: IInStream); + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; + end; + + TJclSevenzipInStream = class(TJclSafecallInterfacedObject, ISequentialInStream, + IInStream, IStreamGetSize, IUnknown) + private + FArchive: TJclCompressionArchive; + FItemIndex: Integer; + FStream: TStream; + FOwnsStream: Boolean; + procedure NeedStream; + procedure ReleaseStream; + public + constructor Create(AArchive: TJclCompressionArchive; AItemIndex: Integer); overload; + constructor Create(AStream: TStream; AOwnsStream: Boolean); overload; + destructor Destroy; override; + // ISequentialInStream + procedure Read(Data: Pointer; Size: Cardinal; ProcessedSize: PCardinal); safecall; + // IInStream + procedure Seek(Offset: Int64; SeekOrigin: Cardinal; NewPosition: PInt64); safecall; + // IStreamGetSize + procedure GetSize(out Size: Int64); safecall; + end; + + TJclSevenzipOpenCallback = class(TJclSafecallInterfacedObject, + IArchiveOpenCallback, ICryptoGetTextPassword, IUnknown) + private + FArchive: TJclCompressionArchive; + public + constructor Create(AArchive: TJclCompressionArchive); + // IArchiveOpenCallback + procedure SetCompleted(Files: PInt64; Bytes: PInt64); safecall; + procedure SetTotal(Files: PInt64; Bytes: PInt64); safecall; + // ICryptoGetTextPassword + procedure CryptoGetTextPassword(out Password: TBStr); safecall; + end; + + TJclSevenzipExtractCallback = class(TJclSafecallInterfacedObject, IUnknown, + IProgress, IArchiveExtractCallback, ICryptoGetTextPassword, + ICompressProgressInfo) + private + FArchive: TJclCompressionArchive; + FLastStream: Cardinal; + public + constructor Create(AArchive: TJclCompressionArchive); + // IArchiveExtractCallback + function GetStream(Index: Cardinal; out OutStream: ISequentialOutStream; + askExtractMode: Cardinal): HRESULT; stdcall; + procedure PrepareOperation(askExtractMode: Cardinal); safecall; + procedure SetOperationResult(resultEOperationResult: Integer); safecall; + // IProgress + procedure SetCompleted(CompleteValue: PInt64); safecall; + procedure SetTotal(Total: Int64); safecall; + // ICryptoGetTextPassword + procedure CryptoGetTextPassword(out Password: TBStr); safecall; + // ICompressProgressInfo + procedure SetRatioInfo(InSize: PInt64; OutSize: PInt64); safecall; + end; + + TJclSevenzipUpdateCallback = class(TJclSafecallInterfacedObject, IUnknown, + IProgress, IArchiveUpdateCallback, IArchiveUpdateCallback2, + ICryptoGetTextPassword2, ICompressProgressInfo) + private + FArchive: TJclCompressionArchive; + FLastStream: Cardinal; + public + constructor Create(AArchive: TJclCompressionArchive); + // IProgress + procedure SetCompleted(CompleteValue: PInt64); safecall; + procedure SetTotal(Total: Int64); safecall; + // IArchiveUpdateCallback + procedure GetProperty(Index: Cardinal; PropID: TPropID; out Value: TPropVariant); safecall; + procedure GetStream(Index: Cardinal; out InStream: ISequentialInStream); safecall; + procedure GetUpdateItemInfo(Index: Cardinal; NewData: PInteger; + NewProperties: PInteger; IndexInArchive: PCardinal); safecall; + procedure SetOperationResult(OperationResult: Integer); safecall; + // IArchiveUpdateCallback2 + function GetVolumeSize(Index: Cardinal; out Size: Int64): HRESULT; + procedure GetVolumeStream(Index: Cardinal; + out VolumeStream: ISequentialOutStream); safecall; + // ICryptoGetTextPassword2 + procedure CryptoGetTextPassword2(out PasswordIsDefined: LongBool; + out Password: TBStr); safecall; + // ICompressProgressInfo + procedure SetRatioInfo(InSize: PInt64; OutSize: PInt64); safecall; + end; + +type + TWideStringSetter = procedure (const Value: WideString) of object; + TCardinalSetter = procedure (Value: Cardinal) of object; + TInt64Setter = procedure (const Value: Int64) of object; + TFileTimeSetter = procedure (const Value: TFileTime) of object; + TBoolSetter = procedure (Value: Boolean) of object; + +procedure SevenzipCheck(Value: HRESULT); +function Get7zWideStringProp(const AArchive: IInArchive; ItemIndex: Integer; + PropID: Cardinal; const Setter: TWideStringSetter): Boolean; +function Get7zCardinalProp(const AArchive: IInArchive; ItemIndex: Integer; + PropID: Cardinal; const Setter: TCardinalSetter): Boolean; +function Get7zInt64Prop(const AArchive: IInArchive; ItemIndex: Integer; + PropID: Cardinal; const Setter: TInt64Setter): Boolean; +function Get7zFileTimeProp(const AArchive: IInArchive; ItemIndex: Integer; + PropID: Cardinal; const Setter: TFileTimeSetter): Boolean; +function Get7zBoolProp(const AArchive: IInArchive; ItemIndex: Integer; + PropID: Cardinal; const Setter: TBoolSetter): Boolean; +procedure Load7zFileAttribute(AInArchive: IInArchive; ItemIndex: Integer; + AItem: TJclCompressionItem); +procedure GetSevenzipArchiveCompressionProperties(AJclArchive: IInterface; ASevenzipArchive: IInterface); +procedure SetSevenzipArchiveCompressionProperties(AJclArchive: IInterface; ASevenzipArchive: IInterface); + + +function Create7zFile(SourceFiles: TStrings; const DestinationFile: TFileName; VolumeSize: Int64 = 0; + Password: String = ''; OnArchiveProgress: TJclCompressionProgressEvent = nil; + OnArchiveRatio: TJclCompressionRatioEvent = nil): Boolean; overload; +function Create7zFile(const SourceFile, DestinationFile: TFileName; VolumeSize: Int64 = 0; Password: String = ''; + OnArchiveProgress: TJclCompressionProgressEvent = nil; + OnArchiveRatio: TJclCompressionRatioEvent = nil): Boolean; overload; + +{$ENDIF MSWINDOWS} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.StrUtils, + {$ELSE} + StrUtils, + {$ENDIF HAS_UNITSCOPE} + JclUnicode, // WideSameText + JclDateTime, JclFileUtils, JclResources, JclStrings, JclSysUtils; + +const + JclDefaultBufferSize = 131072; // 128k + +var + // using TObject prevents default linking of TJclCompressionStreamFormats + // and TJclCompressionArchiveFormats and all classes + GlobalStreamFormats: TObject; + GlobalArchiveFormats: TObject; + +//=== { TJclCompressionStream } ============================================== + +constructor TJclCompressionStream.Create(AStream: TStream); +begin + inherited Create; + FBuffer := nil; + SetBufferSize(JclDefaultBufferSize); + FStream := AStream; +end; + +destructor TJclCompressionStream.Destroy; +begin + SetBufferSize(0); + inherited Destroy; +end; + +function TJclCompressionStream.Read(var Buffer; Count: Longint): Longint; +begin + raise EJclCompressionError.CreateRes(@RsCompressionReadNotSupported); +end; + +function TJclCompressionStream.Write(const Buffer; Count: Longint): Longint; +begin + raise EJclCompressionError.CreateRes(@RsCompressionWriteNotSupported); +end; + +function TJclCompressionStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; +begin + raise EJclCompressionError.CreateRes(@RsCompressionSeekNotSupported); +end; + +procedure TJclCompressionStream.Reset; +begin + raise EJclCompressionError.CreateRes(@RsCompressionResetNotSupported); +end; + +function TJclCompressionStream.SetBufferSize(Size: Cardinal): Cardinal; +begin + if FBuffer <> nil then + FreeMem(FBuffer, FBufferSize); + + FBufferSize := Size; + + if FBufferSize > 0 then + GetMem(FBuffer, FBufferSize) + else + FBuffer := nil; + + Result := FBufferSize; +end; + +class function TJclCompressionStream.StreamExtensions: string; +begin + Result := ''; +end; + +class function TJclCompressionStream.StreamName: string; +begin + Result := ''; +end; + +class function TJclCompressionStream.StreamSubExtensions: string; +begin + Result := ''; +end; + +procedure TJclCompressionStream.Progress(Sender: TObject); +begin + if Assigned(FOnProgress) then + FOnProgress(Sender); +end; + +//=== { TJclCompressStream } ================================================= + +constructor TJclCompressStream.Create(Destination: TStream); +begin + inherited Create(Destination); +end; + +//=== { TJclDecompressStream } =============================================== + +constructor TJclDecompressStream.Create(Source: TStream; AOwnsStream: Boolean); +begin + inherited Create(Source); + FOwnsStream := AOwnsStream; +end; + +destructor TJclDecompressStream.Destroy; +begin + if FOwnsStream then + FStream.Free; + inherited Destroy; +end; + +//=== { TJclCompressionStreamFormats } ======================================= + +constructor TJclCompressionStreamFormats.Create; +begin + inherited Create; + FCompressFormats := TList.Create; + FDecompressFormats := TList.Create; + RegisterFormat(TJclZLibCompressStream); + RegisterFormat(TJclZLibDecompressStream); + RegisterFormat(TJclGZIPCompressionStream); + RegisterFormat(TJclGZIPDecompressionStream); + RegisterFormat(TJclBZIP2CompressionStream); + RegisterFormat(TJclBZIP2DecompressionStream); +end; + +destructor TJclCompressionStreamFormats.Destroy; +begin + FCompressFormats.Free; + FDecompressFormats.Free; + inherited Destroy; +end; + +function TJclCompressionStreamFormats.FindCompressFormat(const AFileName: TFileName): TJclCompressStreamClass; +var + IndexFormat, IndexFilter: Integer; + Filters: TStrings; + AFormat: TJclCompressStreamClass; +begin + Result := nil; + Filters := TStringList.Create; + try + for IndexFormat := 0 to CompressFormatCount - 1 do + begin + AFormat := CompressFormats[IndexFormat]; + StrTokenToStrings(AFormat.StreamExtensions, DirSeparator, Filters); + for IndexFilter := 0 to Filters.Count - 1 do + if IsFileNameMatch(AFileName, Filters.Strings[IndexFilter]) then + begin + Result := AFormat; + Break; + end; + if Result <> nil then + Break; + end; + finally + Filters.Free; + end; +end; + +function TJclCompressionStreamFormats.FindDecompressFormat(const AFileName: TFileName): TJclDecompressStreamClass; +var + IndexFormat, IndexFilter: Integer; + Filters: TStrings; + AFormat: TJclDecompressStreamClass; +begin + Result := nil; + Filters := TStringList.Create; + try + for IndexFormat := 0 to DecompressFormatCount - 1 do + begin + AFormat := DecompressFormats[IndexFormat]; + StrTokenToStrings(AFormat.StreamExtensions, DirSeparator, Filters); + for IndexFilter := 0 to Filters.Count - 1 do + if IsFileNameMatch(AFileName, Filters.Strings[IndexFilter]) then + begin + Result := AFormat; + Break; + end; + if Result <> nil then + Break; + end; + finally + Filters.Free; + end; +end; + +function TJclCompressionStreamFormats.GetCompressFormat(Index: Integer): TJclCompressStreamClass; +begin + Result := TJclCompressStreamClass(FCompressFormats.Items[Index]); +end; + +function TJclCompressionStreamFormats.GetCompressFormatCount: Integer; +begin + Result := FCompressFormats.Count; +end; + +function TJclCompressionStreamFormats.GetDecompressFormat(Index: Integer): TJclDecompressStreamClass; +begin + Result := TJclDecompressStreamClass(FDecompressFormats.Items[Index]); +end; + +function TJclCompressionStreamFormats.GetDecompressFormatCount: Integer; +begin + Result := FDecompressFormats.Count; +end; + +procedure TJclCompressionStreamFormats.RegisterFormat(AClass: TJclCompressionStreamClass); +begin + if AClass.InheritsFrom(TJclCompressStream) then + FCompressFormats.Add(AClass) + else + if AClass.InheritsFrom(TJclDecompressStream) then + FDecompressFormats.Add(AClass); +end; + +procedure TJclCompressionStreamFormats.UnregisterFormat(AClass: TJclCompressionStreamClass); +begin + if AClass.InheritsFrom(TJclCompressStream) then + FCompressFormats.Remove(AClass) + else + if AClass.InheritsFrom(TJclDecompressStream) then + FDecompressFormats.Remove(AClass); +end; + +function GetStreamFormats: TJclCompressionStreamFormats; +begin + if not Assigned(GlobalStreamFormats) then + GlobalStreamFormats := TJclCompressionStreamFormats.Create; + Result := TJclCompressionStreamFormats(GlobalStreamFormats); +end; + +//=== { TJclZLibCompressionStream } ========================================== + +{ Error checking helper } + +function ZLibCheck(const ErrCode: Integer): Integer; +begin + case ErrCode of + 0..High(ErrCode): + Result := ErrCode; // no error + Z_ERRNO: + raise EJclCompressionError.CreateRes(@RsCompressionZLibZErrNo); + Z_STREAM_ERROR: + raise EJclCompressionError.CreateRes(@RsCompressionZLibZStreamError); + Z_DATA_ERROR: + raise EJclCompressionError.CreateRes(@RsCompressionZLibZDataError); + Z_MEM_ERROR: + raise EJclCompressionError.CreateRes(@RsCompressionZLibZMemError); + Z_BUF_ERROR: + raise EJclCompressionError.CreateRes(@RsCompressionZLibZBufError); + Z_VERSION_ERROR: + raise EJclCompressionError.CreateRes(@RsCompressionZLibZVersionError); + else + raise EJclCompressionError.CreateResFmt(@RsCompressionZLibError, [ErrCode]); + end; +end; + +constructor TJclZLibCompressStream.Create(Destination: TStream; CompressionLevel: TJclCompressionLevel); +begin + inherited Create(Destination); + + LoadZLib; + + Assert(FBuffer <> nil); + Assert(FBufferSize > 0); + + // Initialize ZLib StreamRecord + ZLibRecord.zalloc := nil; // Use build-in memory allocation functionality + ZLibRecord.zfree := nil; + ZLibRecord.next_in := nil; + ZLibRecord.avail_in := 0; + ZLibRecord.next_out := FBuffer; + ZLibRecord.avail_out := FBufferSize; + + FWindowBits := DEF_WBITS; + FMemLevel := DEF_MEM_LEVEL; + FMethod := Z_DEFLATED; + FStrategy := Z_DEFAULT_STRATEGY; + FCompressionLevel := CompressionLevel; + FDeflateInitialized := False; +end; + +destructor TJclZLibCompressStream.Destroy; +begin + Flush; + if FDeflateInitialized then + begin + ZLibRecord.next_in := nil; + ZLibRecord.avail_in := 0; + ZLibRecord.avail_out := 0; + ZLibRecord.next_out := nil; + + ZLibCheck(deflateEnd(ZLibRecord)); + end; + + inherited Destroy; +end; + +function TJclZLibCompressStream.Write(const Buffer; Count: Longint): Longint; +begin + if not FDeflateInitialized then + begin + ZLibCheck(deflateInit2(ZLibRecord, FCompressionLevel, FMethod, FWindowBits, FMemLevel, FStrategy)); + FDeflateInitialized := True; + end; + + ZLibRecord.next_in := @Buffer; + ZLibRecord.avail_in := Count; + + while ZLibRecord.avail_in > 0 do + begin + ZLibCheck(deflate(ZLibRecord, Z_NO_FLUSH)); + + if ZLibRecord.avail_out = 0 then // Output buffer empty. Write to stream and go on... + begin + FStream.WriteBuffer(FBuffer^, FBufferSize); + Progress(Self); + ZLibRecord.next_out := FBuffer; + ZLibRecord.avail_out := FBufferSize; + end; + end; + + Result := Count; +end; + +function TJclZLibCompressStream.Flush: Integer; +begin + Result := 0; + + if FDeflateInitialized then + begin + ZLibRecord.next_in := nil; + ZLibRecord.avail_in := 0; + + while (ZLibCheck(deflate(ZLibRecord, Z_FINISH)) <> Z_STREAM_END) and + (ZLibRecord.avail_out = 0) do + begin + FStream.WriteBuffer(FBuffer^, FBufferSize); + Progress(Self); + + ZLibRecord.next_out := FBuffer; + ZLibRecord.avail_out := FBufferSize; + Inc(Result, FBufferSize); + end; + + if ZLibRecord.avail_out < FBufferSize then + begin + FStream.WriteBuffer(FBuffer^, FBufferSize - ZLibRecord.avail_out); + Progress(Self); + Inc(Result, FBufferSize - ZLibRecord.avail_out); + ZLibRecord.next_out := FBuffer; + ZLibRecord.avail_out := FBufferSize; + end; + end; +end; + +function TJclZLibCompressStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; +begin + if (Offset = 0) and (Origin = soCurrent) then + Result := ZLibRecord.total_in + else + if (Offset = 0) and (Origin = soBeginning) and (ZLibRecord.total_in = 0) then + Result := 0 + else + Result := inherited Seek(Offset, Origin); +end; + +procedure TJclZLibCompressStream.SetWindowBits(Value: Integer); +begin + FWindowBits := Value; +end; + +class function TJclZLibCompressStream.StreamExtensions: string; +begin + Result := LoadResString(@RsCompressionZExtensions); +end; + +class function TJclZLibCompressStream.StreamName: string; +begin + Result := LoadResString(@RsCompressionZName); +end; + +class function TJclZLibCompressStream.StreamSubExtensions: string; +begin + Result := LoadResString(@RsCompressionZSubExtensions); +end; + +procedure TJclZLibCompressStream.SetMethod(Value: Integer); +begin + FMethod := Value; +end; + +procedure TJclZLibCompressStream.SetStrategy(Value: Integer); +begin + FStrategy := Value; + if FDeflateInitialized then + ZLibCheck(deflateParams(ZLibRecord, FCompressionLevel, FStrategy)); +end; + +procedure TJclZLibCompressStream.SetMemLevel(Value: Integer); +begin + FMemLevel := Value; +end; + +procedure TJclZLibCompressStream.SetCompressionLevel(Value: Integer); +begin + FCompressionLevel := Value; + if FDeflateInitialized then + ZLibCheck(deflateParams(ZLibRecord, FCompressionLevel, FStrategy)); +end; + +procedure TJclZLibCompressStream.Reset; +begin + if FDeflateInitialized then + begin + Flush; + ZLibCheck(deflateReset(ZLibRecord)); + end; +end; + +//=== { TJclZLibDecompressionStream } ======================================= + +constructor TJclZLibDecompressStream.Create(Source: TStream; WindowBits: Integer; AOwnsStream: Boolean); +begin + inherited Create(Source, AOwnsStream); + + LoadZLib; + + // Initialize ZLib StreamRecord + ZLibRecord.zalloc := nil; // Use build-in memory allocation functionality + ZLibRecord.zfree := nil; + ZLibRecord.next_in := nil; + ZLibRecord.avail_in := 0; + ZLibRecord.next_out := FBuffer; + ZLibRecord.avail_out := FBufferSize; + + FInflateInitialized := False; + FWindowBits := WindowBits; +end; + +destructor TJclZLibDecompressStream.Destroy; +begin + if FInflateInitialized then + begin + FStream.Seek(-ZLibRecord.avail_in, soCurrent); + ZLibCheck(inflateEnd(ZLibRecord)); + end; + + inherited Destroy; +end; + +function TJclZLibDecompressStream.Read(var Buffer; Count: Longint): Longint; +var + Res: Integer; +begin + if not FInflateInitialized then + begin + ZLibCheck(InflateInit2(ZLibRecord, FWindowBits)); + FInflateInitialized := True; + end; + + ZLibRecord.next_out := @Buffer; + ZLibRecord.avail_out := Count; + + while ZLibRecord.avail_out > 0 do // as long as we have data + begin + if ZLibRecord.avail_in = 0 then + begin + ZLibRecord.avail_in := FStream.Read(FBuffer^, FBufferSize); + + if ZLibRecord.avail_in = 0 then + begin + Result := Count - Longint(ZLibRecord.avail_out); + Exit; + end; + + ZLibRecord.next_in := FBuffer; + end; + + if ZLibRecord.avail_in > 0 then + begin + Res := inflate(ZLibRecord, Z_NO_FLUSH); + ZLibCheck(Res); + Progress(Self); + + // Suggestion by ZENsan (mantis 4546) + if Res = Z_STREAM_END then + begin + Result := Count - Longint(ZLibRecord.avail_out); + Exit; + end; + end; + end; + + Result := Count; +end; + +function TJclZLibDecompressStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; +begin + if (Offset = 0) and (Origin = soCurrent) then + Result := ZLibRecord.total_out + else + Result := inherited Seek(Offset, Origin); +end; + +procedure TJclZLibDecompressStream.SetWindowBits(Value: Integer); +begin + FWindowBits := Value; +end; + +class function TJclZLibDecompressStream.StreamExtensions: string; +begin + Result := LoadResString(@RsCompressionZExtensions); +end; + +class function TJclZLibDecompressStream.StreamName: string; +begin + Result := LoadResString(@RsCompressionZName); +end; + +class function TJclZLibDecompressStream.StreamSubExtensions: string; +begin + Result := LoadResString(@RsCompressionZSubExtensions); +end; + +//=== { TJclGZIPCompressionStream } ========================================== + +constructor TJclGZIPCompressionStream.Create(Destination: TStream; CompressionLevel: TJclCompressionLevel); +begin + inherited Create(Destination); + + LoadZLib; + + FFlags := [gfHeaderCRC16, gfExtraField, gfOriginalFileName, gfComment]; + FAutoSetTime := True; + FFatSystem := gfsUnknown; + FCompressionLevel := CompressionLevel; + FDataCRC32 := crc32(0, nil, 0); +end; + +destructor TJclGZIPCompressionStream.Destroy; +begin + // BUGFIX: CRC32 and Uncompressed Size missing from GZIP output + // unless you called Flush manually. This is not correct Stream behaviour. + // Flush should be optional! + Flush; + FZLibStream.Free; + inherited Destroy; +end; + +function TJclGZIPCompressionStream.Flush: Integer; +var + AFooter: TJclGZIPFooter; +begin + if Assigned(FZLibStream) then + Result := FZLibStream.Flush + else + Result := 0; + + if FFooterWritten then + Exit; + FFooterWritten := True; + + // Write footer, CRC32 followed by ISIZE + AFooter.DataCRC32 := FDataCRC32; + AFooter.DataSize := FOriginalSize; + + Inc(Result, FStream.Write(AFooter, SizeOf(AFooter))); +end; + +function TJclGZIPCompressionStream.GetDosTime: TDateTime; +begin + if AutoSetTime then + Result := Now + else + Result := UnixTimeToDateTime(FUnixTime); +end; + +function TJclGZIPCompressionStream.GetUnixTime: Cardinal; +begin + if AutoSetTime then + Result := DateTimeToUnixTime(Now) + else + Result := FUnixTime; +end; + +procedure TJclGZIPCompressionStream.Reset; +begin + if Assigned(FZLibStream) then + FZLibStream.Reset; + + FDataCRC32 := crc32(0, nil, 0); + FOriginalSize := 0; +end; + +procedure TJclGZIPCompressionStream.SetDosTime(const Value: TDateTime); +begin + AutoSetTime := False; + FUnixTime := DateTimeToUnixTime(Value); +end; + +procedure TJclGZIPCompressionStream.SetUnixTime(Value: Cardinal); +begin + AutoSetTime := False; + FUnixTime := Value; +end; + +class function TJclGZIPCompressionStream.StreamExtensions: string; +begin + Result := LoadResString(@RsCompressionGZipExtensions); +end; + +class function TJclGZIPCompressionStream.StreamName: string; +begin + Result := LoadResString(@RsCompressionGZipName); +end; + +class function TJclGZIPCompressionStream.StreamSubExtensions: string; +begin + Result := LoadResString(@RsCompressionGZipSubExtensions); +end; + +function TJclGZIPCompressionStream.Write(const Buffer; Count: Integer): Longint; +begin + if not FHeaderWritten then + begin + WriteHeader; + FHeaderWritten := True; + end; + + if not Assigned(FZLibStream) then + begin + FZLibStream := TJclZLibCompressStream.Create(FStream, FCompressionLevel); + FZLibStream.WindowBits := -DEF_WBITS; // negative value for raw mode + FZLibStream.OnProgress := ZLibStreamProgress; + end; + + Result := FZLibStream.Write(Buffer, Count); + FDataCRC32 := crc32(FDataCRC32, PBytef(@Buffer), Result); + Inc(FOriginalSize, Result); +end; + +procedure TJclGZIPCompressionStream.WriteHeader; +const + FatSystemToByte: array [TJclGZIPFatSystem] of Byte = + (JCL_GZIP_OS_FAT, JCL_GZIP_OS_AMIGA, JCL_GZIP_OS_VMS, JCL_GZIP_OS_UNIX, + JCL_GZIP_OS_VM, JCL_GZIP_OS_ATARI, JCL_GZIP_OS_HPFS, JCL_GZIP_OS_MAC, + JCL_GZIP_OS_Z, JCL_GZIP_OS_CPM, JCL_GZIP_OS_TOPS, JCL_GZIP_OS_NTFS, + JCL_GZIP_OS_QDOS, JCL_GZIP_OS_ACORN, JCL_GZIP_OS_UNKNOWN, JCL_GZIP_OS_UNKNOWN); +var + AHeader: TJclGZIPHeader; + ExtraFieldLength, HeaderCRC16: Word; + HeaderCRC: Cardinal; + TmpAnsiString: AnsiString; + + procedure StreamWriteBuffer(const Buffer; Count: Longint); + begin + FStream.WriteBuffer(Buffer, Count); + if gfHeaderCRC16 in Flags then + HeaderCRC := crc32(HeaderCRC, @Byte(Buffer), Count); + end; + + function CheckCString(const Buffer: string): Boolean; + var + Index: Integer; + begin + Result := False; + for Index := 1 to Length(Buffer) do + if Buffer[Index] = #0 then + Exit; + Result := True; + end; + +begin + if gfHeaderCRC16 in Flags then + HeaderCRC := crc32(0, nil, 0); + + AHeader.ID1 := JCL_GZIP_ID1; + AHeader.ID2 := JCL_GZIP_ID2; + AHeader.CompressionMethod := JCL_GZIP_CM_DEFLATE; + AHeader.Flags := 0; + if gfDataIsText in Flags then + AHeader.Flags := AHeader.Flags or JCL_GZIP_FLAG_TEXT; + if gfHeaderCRC16 in Flags then + AHeader.Flags := AHeader.Flags or JCL_GZIP_FLAG_CRC; + if (gfExtraField in Flags) and (ExtraField <> '') then + AHeader.Flags := AHeader.Flags or JCL_GZIP_FLAG_EXTRA; + if (gfOriginalFileName in Flags) and (OriginalFileName <> '') then + AHeader.Flags := AHeader.Flags or JCL_GZIP_FLAG_NAME; + if (gfComment in Flags) and (Comment <> '') then + AHeader.Flags := AHeader.Flags or JCL_GZIP_FLAG_COMMENT; + + if AutoSetTime then + AHeader.ModifiedTime := DateTimeToUnixTime(Now) + else + AHeader.ModifiedTime := FUnixTime; + + case FCompressionLevel of + Z_BEST_COMPRESSION: + AHeader.ExtraFlags := JCL_GZIP_EFLAG_MAX; + Z_BEST_SPEED: + AHeader.ExtraFlags := JCL_GZIP_EFLAG_FAST; + else + AHeader.ExtraFlags := 0; + end; + + AHeader.OS := FatSystemToByte[FatSystem]; + + StreamWriteBuffer(AHeader, SizeOf(AHeader)); + + if (gfExtraField in Flags) and (ExtraField <> '') then + begin + if Length(ExtraField) > High(Word) then + raise EJclCompressionError.CreateRes(@RsCompressionGZIPExtraFieldTooLong); + ExtraFieldLength := Length(ExtraField); + StreamWriteBuffer(ExtraFieldLength, SizeOf(ExtraFieldLength)); + StreamWriteBuffer(ExtraField[1], Length(ExtraField)); + end; + + if (gfOriginalFileName in Flags) and (OriginalFileName <> '') then + begin + if not CheckCString(OriginalFileName) then + raise EJclCompressionError.CreateRes(@RsCompressionGZIPBadString); + + TmpAnsiString := AnsiString(OriginalFileName); + StreamWriteBuffer(TmpAnsiString[1], Length(TmpAnsiString) + 1); + end; + + if (gfComment in Flags) and (Comment <> '') then + begin + if not CheckCString(Comment) then + raise EJclCompressionError.CreateRes(@RsCompressionGZIPBadString); + + TmpAnsiString := AnsiString(Comment); + StreamWriteBuffer(TmpAnsiString[1], Length(TmpAnsiString) + 1); + end; + + if (gfHeaderCRC16 in Flags) then + begin + HeaderCRC16 := HeaderCRC and $FFFF; + FStream.WriteBuffer(HeaderCRC16, SizeOf(HeaderCRC16)); + end; +end; + +procedure TJclGZIPCompressionStream.ZLibStreamProgress(Sender: TObject); +begin + Progress(Self); +end; + +//=== { TJclGZIPDecompressionStream } ======================================== + +constructor TJclGZIPDecompressionStream.Create(Source: TStream; CheckHeaderCRC: Boolean; AOwnsStream: Boolean); +var + HeaderCRC: Cardinal; + ComputeHeaderCRC: Boolean; + ExtraFieldLength: Word; + + procedure ReadBuffer(var Buffer; SizeOfBuffer: Longint); + begin + Source.ReadBuffer(Buffer, SizeOfBuffer); + if ComputeHeaderCRC then + HeaderCRC := crc32(HeaderCRC, @Byte(Buffer), SizeOfBuffer); + end; + + function ReadCString: AnsiString; + var + Buf: AnsiChar; + begin + Result := ''; + Buf := #0; + repeat + Source.ReadBuffer(Buf, SizeOf(Buf)); + if Buf = #0 then Break; + Result := Result + Buf; + until False; + end; + +begin + inherited Create(Source, AOwnsStream); + + LoadZLib; + + FAutoCheckDataCRC32 := True; + FComputedDataCRC32 := crc32(0, nil, 0); + HeaderCRC := crc32(0, nil, 0); + + ComputeHeaderCRC := CheckHeaderCRC; + ReadBuffer(FHeader, SizeOf(FHeader)); + if (FHeader.ID1 <> JCL_GZIP_ID1) or (FHeader.ID2 <> JCL_GZIP_ID2) then + raise EJclCompressionError.CreateResFmt(@RsCompressionGZipInvalidID, [FHeader.ID1, FHeader.ID2]); + if (FHeader.CompressionMethod <> JCL_GZIP_CM_DEFLATE) then + raise EJclCompressionError.CreateResFmt(@RsCompressionGZipUnsupportedCM, [FHeader.CompressionMethod]); + + if (FHeader.Flags and JCL_GZIP_FLAG_EXTRA) <> 0 then + begin + ExtraFieldLength := 0; + ReadBuffer(ExtraFieldLength, SizeOf(ExtraFieldLength)); + SetLength(FExtraField, ExtraFieldLength); + ReadBuffer(FExtraField[1], ExtraFieldLength); + end; + + if (FHeader.Flags and JCL_GZIP_FLAG_NAME) <> 0 then + FOriginalFileName := TFileName(ReadCString); + if (FHeader.Flags and JCL_GZIP_FLAG_COMMENT) <> 0 then + FComment := string(ReadCString); + + if CheckHeaderCRC then + begin + ComputeHeaderCRC := False; + FComputedHeaderCRC16 := HeaderCRC and $FFFF; + end; + + if (FHeader.Flags and JCL_GZIP_FLAG_CRC) <> 0 then + begin + Source.ReadBuffer(FStoredHeaderCRC16, SizeOf(FStoredHeaderCRC16)); + if CheckHeaderCRC and (FComputedHeaderCRC16 <> FStoredHeaderCRC16) then + raise EJclCompressionError.CreateRes(@RsCompressionGZipHeaderCRC); + end; +end; + +destructor TJclGZIPDecompressionStream.Destroy; +begin + FZLibStream.Free; + FCompressedDataStream.Free; + inherited Destroy; +end; + +function TJclGZIPDecompressionStream.GetCompressedDataSize: Int64; +begin + if not FDataStarted then + Result := FStream.Size - FStream.Position - SizeOf(FFooter) + else + if FDataEnded then + Result := FCompressedDataSize + else + raise EJclCompressionError.CreateRes(@RsCompressionGZipDecompressing); +end; + +function TJclGZIPDecompressionStream.GetComputedDataCRC32: Cardinal; +begin + if FDataEnded then + Result := FComputedDataCRC32 + else + raise EJclCompressionError.CreateRes(@RsCompressionGZipNotDecompressed); +end; + +function TJclGZIPDecompressionStream.GetDosTime: TDateTime; +begin + Result := UnixTimeToDateTime(FHeader.ModifiedTime); +end; + +function TJclGZIPDecompressionStream.GetFatSystem: TJclGZIPFatSystem; +const + ByteToFatSystem: array [JCL_GZIP_OS_FAT..JCL_GZIP_OS_ACORN] of TJclGZIPFatSystem = + (gfsFat, gfsAmiga, gfsVMS, gfsUnix, gfsVM, gfsAtari, gfsHPFS, gfsMac, gfsZ, + gfsCPM, gfsTOPS, gfsNTFS, gfsQDOS, gfsAcorn); +begin + case FHeader.OS of + JCL_GZIP_OS_FAT..JCL_GZIP_OS_ACORN: + Result := ByteToFatSystem[FHeader.OS]; + JCL_GZIP_OS_UNKNOWN: + Result := gfsUnknown; + else + Result := gfsOther; + end; +end; + +function TJclGZIPDecompressionStream.GetFlags: TJclGZIPFlags; +begin + Result := []; + if (FHeader.Flags and JCL_GZIP_FLAG_TEXT) <> 0 then + Result := Result + [gfDataIsText]; + if (FHeader.Flags and JCL_GZIP_FLAG_CRC) <> 0 then + Result := Result + [gfHeaderCRC16]; + if (FHeader.Flags and JCL_GZIP_FLAG_EXTRA) <> 0 then + Result := Result + [gfExtraField]; + if (FHeader.Flags and JCL_GZIP_FLAG_NAME) <> 0 then + Result := Result + [gfOriginalFileName]; + if (FHeader.Flags and JCL_GZIP_FLAG_COMMENT) <> 0 then + Result := Result + [gfComment]; +end; + +function TJclGZIPDecompressionStream.GetOriginalDataSize: Cardinal; +var + StartPos: Int64; + AFooter: TJclGZIPFooter; +begin + if not FDataStarted then + begin + StartPos := FStream.Position; + try + FStream.Seek(-SizeOf(AFooter), soEnd); + AFooter.DataCRC32 := 0; + AFooter.DataSize := 0; + FStream.ReadBuffer(AFooter, SizeOf(AFooter)); + Result := AFooter.DataSize; + finally + FStream.Seek(StartPos, soBeginning); + end; + end + else + if FDataEnded then + Result := FFooter.DataSize + else + raise EJclCompressionError.CreateRes(@RsCompressionGZipDecompressing); +end; + +function TJclGZIPDecompressionStream.GetStoredDataCRC32: Cardinal; +var + StartPos: Int64; + AFooter: TJclGZIPFooter; +begin + if not FDataStarted then + begin + StartPos := FStream.Position; + try + FStream.Seek(-SizeOf(AFooter), soEnd); + AFooter.DataSize := 0; + AFooter.DataCRC32 := 0; + FStream.ReadBuffer(AFooter, SizeOf(AFooter)); + Result := AFooter.DataCRC32; + finally + FStream.Seek(StartPos, soBeginning); + end; + end + else + if FDataEnded then + Result := FFooter.DataCRC32 + else + raise EJclCompressionError.CreateRes(@RsCompressionGZipDecompressing); +end; + +function TJclGZIPDecompressionStream.Read(var Buffer; Count: Longint): Longint; +begin + if not Assigned(FZLibStream) then + begin + FCompressedDataStream := TJclDelegatedStream.Create; + FCompressedDataStream.OnRead := ReadCompressedData; + FZLibStream := TJclZLibDecompressStream.Create(FCompressedDataStream, -DEF_WBITS); + FZLibStream.OnProgress := ZLibStreamProgress; + end; + Result := FZLibStream.Read(Buffer, Count); + Inc(FDataSize, Result); + FComputedDataCRC32 := crc32(FComputedDataCRC32, @Byte(Buffer), Result); + if Result < Count then + begin + if not FDataEnded then + // the decompressed stream is stopping before the compressed stream + raise EJclCompressionError.CreateRes(@RsCompressionGZipInternalError); + if AutoCheckDataCRC32 and (FComputedDataCRC32 <> FFooter.DataCRC32) then + raise EJclCompressionError.CreateRes(@RsCompressionGZipDataCRCFailed); + end; +end; + +function TJclGZIPDecompressionStream.ReadCompressedData(Sender: TObject; var Buffer; + Count: Longint): Longint; +var + BufferAddr: PAnsiChar; + FooterAddr: PAnsiChar; +begin + if (Count = 0) or FDataEnded then + begin + Result := 0; + Exit; + end + else + if not FDataStarted then + begin + FDataStarted := True; + // prolog + if FStream.Read(FFooter, SizeOf(FFooter)) < SizeOf(FFooter) then + raise EJclCompressionError.CreateRes(@RsCompressionGZipDataTruncated); + end; + + BufferAddr := @Byte(Buffer); + Move(FFooter, Buffer, SizeOf(FFooter)); + Result := FStream.Read(BufferAddr[SizeOf(FFooter)], Count - SizeOf(FFooter)) + + FStream.Read(FFooter, SizeOf(FFooter)); + + if Result < Count then + begin + FDataEnded := True; + // epilog + FooterAddr := @FFooter; + if (Count - Result) < SizeOf(FFooter) then + begin + // the "real" footer is splitted in the data and the footer + // shift the valid bytes of the footer to their place + Move(FFooter, FooterAddr[Count - Result], SizeOf(FFooter) - Count + Result); + // the missing bytes of the footer are located after the data + Move(BufferAddr[Result], FFooter, Count - Result); + end + else + // the "real" footer is located in the data + Move(BufferAddr[Result], FFooter, SizeOf(FFooter)); + end; + Inc(FCompressedDataSize, Result); +end; + +class function TJclGZIPDecompressionStream.StreamExtensions: string; +begin + Result := LoadResString(@RsCompressionGZipExtensions); +end; + +class function TJclGZIPDecompressionStream.StreamName: string; +begin + Result := LoadResString(@RsCompressionGZipName); +end; + +class function TJclGZIPDecompressionStream.StreamSubExtensions: string; +begin + Result := LoadResString(@RsCompressionGZipSubExtensions); +end; + +procedure TJclGZIPDecompressionStream.ZLibStreamProgress(Sender: TObject); +begin + Progress(Self); +end; + +//=== { TJclBZLibCompressionStream } ========================================= + +{ Error checking helper } + +function BZIP2LibCheck(const ErrCode: Integer): Integer; +begin + case ErrCode of + 0..High(ErrCode): + Result := ErrCode; // no error + BZ_SEQUENCE_ERROR: + raise EJclCompressionError.CreateRes(@RsCompressionBZIP2SequenceError); + BZ_PARAM_ERROR: + raise EJclCompressionError.CreateRes(@RsCompressionBZIP2ParameterError); + BZ_MEM_ERROR: + raise EJclCompressionError.CreateRes(@RsCompressionBZIP2MemoryError); + BZ_DATA_ERROR: + raise EJclCompressionError.CreateRes(@RsCompressionBZIP2DataError); + BZ_DATA_ERROR_MAGIC: + raise EJclCompressionError.CreateRes(@RsCompressionBZIP2HeaderError); + BZ_IO_ERROR: + raise EJclCompressionError.CreateRes(@RsCompressionBZIP2IOError); + BZ_UNEXPECTED_EOF: + raise EJclCompressionError.CreateRes(@RsCompressionBZIP2EOFError); + BZ_OUTBUFF_FULL: + raise EJclCompressionError.CreateRes(@RsCompressionBZIP2OutBuffError); + BZ_CONFIG_ERROR: + raise EJclCompressionError.CreateRes(@RsCompressionBZIP2ConfigError); + else + raise EJclCompressionError.CreateResFmt(@RsCompressionBZIP2Error, [ErrCode]); + end; +end; + +constructor TJclBZIP2CompressionStream.Create(Destination: TStream; ACompressionLevel: TJclCompressionLevel); +begin + inherited Create(Destination); + + LoadBZip2; + + Assert(FBuffer <> nil); + Assert(FBufferSize > 0); + + // Initialize ZLib StreamRecord + BZLibRecord.bzalloc := nil; // Use build-in memory allocation functionality + BZLibRecord.bzfree := nil; + BZLibRecord.next_in := nil; + BZLibRecord.avail_in := 0; + BZLibRecord.next_out := FBuffer; + BZLibRecord.avail_out := FBufferSize; + + FDeflateInitialized := False; + + FCompressionLevel := ACompressionLevel; +end; + +destructor TJclBZIP2CompressionStream.Destroy; +begin + Flush; + if FDeflateInitialized then + BZIP2LibCheck(BZ2_bzCompressEnd(BZLibRecord)); + + inherited Destroy; +end; + +function TJclBZIP2CompressionStream.Flush: Integer; +begin + Result := 0; + + if FDeflateInitialized then + begin + BZLibRecord.next_in := nil; + BZLibRecord.avail_in := 0; + + while (BZIP2LibCheck(BZ2_bzCompress(BZLibRecord, BZ_FINISH)) <> BZ_STREAM_END) and (BZLibRecord.avail_out = 0) do + begin + FStream.WriteBuffer(FBuffer^, FBufferSize); + Progress(Self); + + BZLibRecord.next_out := FBuffer; + BZLibRecord.avail_out := FBufferSize; + Inc(Result, FBufferSize); + end; + + if BZLibRecord.avail_out < FBufferSize then + begin + FStream.WriteBuffer(FBuffer^, FBufferSize - BZLibRecord.avail_out); + Progress(Self); + Inc(Result, FBufferSize - BZLibRecord.avail_out); + BZLibRecord.next_out := FBuffer; + BZLibRecord.avail_out := FBufferSize; + end; + end; +end; + +function TJclBZIP2CompressionStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; +begin + if (Offset = 0) and (Origin = soCurrent) then + Result := (BZLibRecord.total_in_hi32 shl 32) or BZLibRecord.total_in_lo32 + else + if (Offset = 0) and (Origin = soBeginning) and (BZLibRecord.total_in_lo32 = 0) then + Result := 0 + else + Result := inherited Seek(Offset, Origin); +end; + +procedure TJclBZIP2CompressionStream.SetCompressionLevel(const Value: Integer); +begin + if not FDeflateInitialized then + FCompressionLevel := Value + else + raise EJclCompressionError.CreateRes(@RsCompressionBZIP2SequenceError); +end; + +class function TJclBZIP2CompressionStream.StreamExtensions: string; +begin + Result := LoadResString(@RsCompressionBZip2Extensions); +end; + +class function TJclBZIP2CompressionStream.StreamName: string; +begin + Result := LoadResString(@RsCompressionBZip2Name); +end; + +class function TJclBZIP2CompressionStream.StreamSubExtensions: string; +begin + Result := LoadResString(@RsCompressionBZip2SubExtensions); +end; + +function TJclBZIP2CompressionStream.Write(const Buffer; Count: Longint): Longint; +begin + if not FDeflateInitialized then + begin + BZIP2LibCheck(BZ2_bzCompressInit(BZLibRecord, FCompressionLevel, 0, 0)); + FDeflateInitialized := True; + end; + + BZLibRecord.next_in := @Buffer; + BZLibRecord.avail_in := Count; + + while BZLibRecord.avail_in > 0 do + begin + BZIP2LibCheck(BZ2_bzCompress(BZLibRecord, BZ_RUN)); + + if BZLibRecord.avail_out = 0 then // Output buffer empty. Write to stream and go on... + begin + FStream.WriteBuffer(FBuffer^, FBufferSize); + Progress(Self); + BZLibRecord.next_out := FBuffer; + BZLibRecord.avail_out := FBufferSize; + end; + end; + + Result := Count; +end; + +//=== { TJclBZip2DecompressionStream } ======================================= + +constructor TJclBZIP2DecompressionStream.Create(Source: TStream; AOwnsStream: Boolean); +begin + inherited Create(Source, AOwnsStream); + + LoadBZip2; + + // Initialize ZLib StreamRecord + BZLibRecord.bzalloc := nil; // Use build-in memory allocation functionality + BZLibRecord.bzfree := nil; + BZLibRecord.opaque := nil; + BZLibRecord.next_in := nil; + BZLibRecord.state := nil; + BZLibRecord.avail_in := 0; + BZLibRecord.next_out := FBuffer; + BZLibRecord.avail_out := FBufferSize; + + FInflateInitialized := False; +end; + +destructor TJclBZIP2DecompressionStream.Destroy; +begin + if FInflateInitialized then + begin + FStream.Seek(-BZLibRecord.avail_in, soCurrent); + BZIP2LibCheck(BZ2_bzDecompressEnd(BZLibRecord)); + end; + + inherited Destroy; +end; + +function TJclBZIP2DecompressionStream.Read(var Buffer; Count: Longint): Longint; +begin + if not FInflateInitialized then + begin + BZIP2LibCheck(BZ2_bzDecompressInit(BZLibRecord, 0, 0)); + FInflateInitialized := True; + end; + + BZLibRecord.next_out := @Buffer; + BZLibRecord.avail_out := Count; + Result := 0; + + while Result < Count do // as long as we need data + begin + if BZLibRecord.avail_in = 0 then // no more compressed data + begin + BZLibRecord.avail_in := FStream.Read(FBuffer^, FBufferSize); + if BZLibRecord.avail_in = 0 then + Exit; + + BZLibRecord.next_in := FBuffer; + end; + + if BZLibRecord.avail_in > 0 then + begin + BZIP2LibCheck(BZ2_bzDecompress(BZLibRecord)); + Result := Count; + Dec(Result, BZLibRecord.avail_out); + end + end; + + Result := Count; +end; + +function TJclBZIP2DecompressionStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; +begin + if (Offset = 0) and (Origin = soCurrent) then + Result := (BZLibRecord.total_out_hi32 shl 32) or BZLibRecord.total_out_lo32 + else + Result := inherited Seek(Offset, Origin); +end; + +class function TJclBZIP2DecompressionStream.StreamExtensions: string; +begin + Result := LoadResString(@RsCompressionBZip2Extensions); +end; + +class function TJclBZIP2DecompressionStream.StreamName: string; +begin + Result := LoadResString(@RsCompressionBZip2Name); +end; + +class function TJclBZIP2DecompressionStream.StreamSubExtensions: string; +begin + Result := LoadResString(@RsCompressionBZip2SubExtensions); +end; + +procedure InternalCompress(SourceStream: TStream; CompressStream: TJclCompressStream; + ProgressCallback: TJclCompressStreamProgressCallback; UserData: Pointer); +var + SourceStreamSize, SourceStreamPosition: Int64; + Buffer: Pointer; + ReadBytes: Integer; + EofFlag: Boolean; +begin + SourceStreamSize := SourceStream.Size; // source file size + SourceStreamPosition := 0; + + GetMem(Buffer, JclDefaultBufferSize + 2); + try + // ZLibStream.CopyFrom(SourceStream, 0 ); // One line way to do it! may not + // // be reliable idea to do this! also, + // //no progress callbacks! + EofFlag := False; + while not EofFlag do + begin + if Assigned(ProgressCallback) then + ProgressCallback(SourceStreamSize, SourceStreamPosition, UserData); + + ReadBytes := SourceStream.Read(Buffer^, JclDefaultBufferSize); + SourceStreamPosition := SourceStreamPosition + ReadBytes; + + CompressStream.WriteBuffer(Buffer^, ReadBytes); + + // short block indicates end of zlib stream + EofFlag := ReadBytes < JclDefaultBufferSize; + end; + //CompressStream.Flush; (called by the destructor of compression streams + finally + FreeMem(Buffer); + end; + if Assigned(ProgressCallback) then + ProgressCallback(SourceStreamSize, SourceStreamPosition, UserData); +end; + +procedure InternalDecompress(SourceStream, DestStream: TStream; + DecompressStream: TJclDecompressStream; + ProgressCallback: TJclCompressStreamProgressCallback; UserData: Pointer); +var + SourceStreamSize: Int64; + Buffer: Pointer; + ReadBytes: Integer; + EofFlag: Boolean; +begin + SourceStreamSize := SourceStream.Size; // source file size + + GetMem(Buffer, JclDefaultBufferSize + 2); + try + // ZLibStream.CopyFrom(SourceStream, 0 ); // One line way to do it! may not + // // be reliable idea to do this! also, + // //no progress callbacks! + EofFlag := False; + while not EofFlag do + begin + if Assigned(ProgressCallback) then + ProgressCallback(SourceStreamSize, SourceStream.Position, UserData); + + ReadBytes := DecompressStream.Read(Buffer^, JclDefaultBufferSize); + + DestStream.WriteBuffer(Buffer^, ReadBytes); + + // short block indicates end of zlib stream + EofFlag := ReadBytes < JclDefaultBufferSize; + end; + finally + FreeMem(Buffer); + end; + if Assigned(ProgressCallback) then + ProgressCallback(SourceStreamSize, SourceStream.Position, UserData); +end; + +{ Compress to a .gz file - one liner - NEW MARCH 2007 } + +function GZipFile(SourceFile, DestinationFile: TFileName; CompressionLevel: Integer; + ProgressCallback: TJclCompressStreamProgressCallback; UserData: Pointer): Boolean; +var + GZipStream: TJclGZIPCompressionStream; + DestStream: TFileStream; + SourceStream: TFileStream; + GZipStreamDateTime: TDateTime; +begin + Result := False; + if not FileExists(SourceFile) then // can't copy what doesn't exist! + Exit; + + GetFileLastWrite(SourceFile, GZipStreamDateTime); + + {destination and source streams first and second} + SourceStream := TFileStream.Create(SourceFile, fmOpenRead or fmShareDenyWrite); + try + DestStream := TFileStream.Create(DestinationFile, fmCreate); // see SysUtils + try + { create compressionstream third, and copy from source, + through zlib compress layer, + out through file stream} + GZipStream := TJclGZIPCompressionStream.Create(DestStream, CompressionLevel); + try + GZipStream.DosTime := GZipStreamDateTime; + InternalCompress(SourceStream, GZipStream, ProgressCallback, UserData); + finally + GZipStream.Free; + end; + finally + DestStream.Free; + end; + finally + SourceStream.Free; + end; + Result := FileExists(DestinationFile); +end; + +{ Decompress a .gz file } + +function UnGZipFile(SourceFile, DestinationFile: TFileName; + ProgressCallback: TJclCompressStreamProgressCallback; UserData: Pointer): Boolean; +var + GZipStream: TJclGZIPDecompressionStream; + DestStream: TFileStream; + SourceStream: TFileStream; + GZipStreamDateTime: TDateTime; +begin + Result := False; + if not FileExists(SourceFile) then // can't copy what doesn't exist! + Exit; + + {destination and source streams first and second} + SourceStream := TFileStream.Create(SourceFile, {mode} fmOpenRead or fmShareDenyWrite); + try + DestStream := TFileStream.Create(DestinationFile, {mode} fmCreate); // see SysUtils + try + { create decompressionstream third, and copy from source, + through zlib decompress layer, out through file stream + } + GZipStream := TJclGZIPDecompressionStream.Create(SourceStream); + try + InternalDecompress(SourceStream, DestStream, GZipStream, ProgressCallback, UserData); + GZipStreamDateTime := GZipStream.DosTime; + finally + GZipStream.Free; + end; + finally + DestStream.Free; + end; + finally + SourceStream.Free; + end; + Result := FileExists(DestinationFile); + if Result and (GZipStreamDateTime <> 0) then + // preserve datetime when unpacking! (see JclFileUtils) + SetFileLastWrite(DestinationFile, GZipStreamDateTime); +end; + +procedure GZipStream(SourceStream, DestinationStream: TStream; CompressionLevel: Integer = Z_DEFAULT_COMPRESSION; + ProgressCallback: TJclCompressStreamProgressCallback = nil; UserData: Pointer = nil); +var + GZStream: TJclGZIPCompressionStream; +begin + GZStream := TJclGZIPCompressionStream.Create(DestinationStream, CompressionLevel); + try + InternalCompress(SourceStream, GZStream, ProgressCallback, UserData); + finally + GZStream.Free; + end; +end; + +procedure UnGZipStream(SourceStream, DestinationStream: TStream; + ProgressCallback: TJclCompressStreamProgressCallback = nil; UserData: Pointer = nil); +var + GZipStream: TJclGZIPDecompressionStream; +begin + GZipStream := TJclGZIPDecompressionStream.Create(SourceStream); + try + InternalDecompress(SourceStream, DestinationStream, GZipStream, ProgressCallback, UserData); + finally + GZipStream.Free; + end; +end; + +{ Compress to a .bz2 file - one liner } + +function BZip2File(SourceFile, DestinationFile: TFileName; CompressionLevel: Integer; + ProgressCallback: TJclCompressStreamProgressCallback; UserData: Pointer): Boolean; +var + BZip2Stream: TJclBZIP2CompressionStream; + DestStream: TFileStream; + SourceStream: TFileStream; +begin + Result := False; + if not FileExists(SourceFile) then // can't copy what doesn't exist! + Exit; + + {destination and source streams first and second} + SourceStream := TFileStream.Create(SourceFile, fmOpenRead or fmShareDenyWrite); + try + DestStream := TFileStream.Create(DestinationFile, fmCreate); // see SysUtils + try + { create compressionstream third, and copy from source, + through zlib compress layer, + out through file stream} + BZip2Stream := TJclBZIP2CompressionStream.Create(DestStream, CompressionLevel); + try + InternalCompress(SourceStream, BZip2Stream, ProgressCallback, UserData); + finally + BZip2Stream.Free; + end; + finally + DestStream.Free; + end; + finally + SourceStream.Free; + end; + Result := FileExists(DestinationFile); +end; + +{ Decompress a .bzip2 file } + +function UnBZip2File(SourceFile, DestinationFile: TFileName; + ProgressCallback: TJclCompressStreamProgressCallback; UserData: Pointer): Boolean; +var + BZip2Stream: TJclBZIP2DecompressionStream; + DestStream: TFileStream; + SourceStream: TFileStream; +begin + Result := False; + if not FileExists(SourceFile) then // can't copy what doesn't exist! + Exit; + + {destination and source streams first and second} + SourceStream := TFileStream.Create(SourceFile, {mode} fmOpenRead or fmShareDenyWrite); + try + DestStream := TFileStream.Create(DestinationFile, {mode} fmCreate); // see SysUtils + try + { create decompressionstream third, and copy from source, + through zlib decompress layer, out through file stream + } + BZip2Stream := TJclBZIP2DecompressionStream.Create(SourceStream); + try + InternalDecompress(SourceStream, DestStream, BZip2Stream, ProgressCallback, UserData); + finally + BZip2Stream.Free; + end; + finally + DestStream.Free; + end; + finally + SourceStream.Free; + end; + Result := FileExists(DestinationFile); +end; + +procedure BZip2Stream(SourceStream, DestinationStream: TStream; CompressionLevel: Integer = 5; + ProgressCallback: TJclCompressStreamProgressCallback = nil; UserData: Pointer = nil); +var + BZ2Stream: TJclBZIP2CompressionStream; +begin + BZ2Stream := TJclBZIP2CompressionStream.Create(DestinationStream, CompressionLevel); + try + InternalCompress(SourceStream, BZ2Stream, ProgressCallback, UserData); + finally + BZ2Stream.Free; + end; +end; + +procedure UnBZip2Stream(SourceStream, DestinationStream: TStream; + ProgressCallback: TJclCompressStreamProgressCallback = nil; UserData: Pointer = nil); +var + BZip2Stream: TJclBZIP2DecompressionStream; +begin + BZip2Stream := TJclBZIP2DecompressionStream.Create(SourceStream); + try + InternalDecompress(SourceStream, DestinationStream, BZip2Stream, ProgressCallback, UserData); + finally + BZip2Stream.Free; + end; +end; + +{$IFDEF MSWINDOWS} + +function OpenFileStream(const FileName: TFileName; StreamAccess: TJclStreamAccess): TStream; +begin + Result := nil; + case StreamAccess of + saCreate: + Result := TFileStream.Create(FileName, fmCreate); + saReadOnly: + if FileExists(FileName) then + Result := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); + saReadOnlyDenyNone: + if FileExists(FileName) then + Result := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone); + saWriteOnly: + if FileExists(FileName) then + Result := TFileStream.Create(FileName, fmOpenWrite) + else + if FileName <> '' then + Result := TFileStream.Create(FileName, fmCreate); + saReadWrite: + if FileExists(FileName) then + Result := TFileStream.Create(FileName, fmOpenReadWrite) + else + if FileName <> '' then + Result := TFileStream.Create(FileName, fmCreate); + end; +end; + +//=== { TJclSafecallInterfacedObject } ======================================= + +function TJclSafecallInterfacedObject.SafeCallException(ExceptObject: TObject; + ExceptAddr: Pointer): HResult; +begin + {$IFDEF HAS_ENOTIMPLEMENTED} + if ExceptObject is ENotImplemented then + Result := E_NOTIMPL + else + {$ENDIF HAS_ENOTIMPLEMENTED} + {$IFDEF HAS_EARGUMENTEXCEPTION} + if ExceptObject is EArgumentException then + Result := E_INVALIDARG + else + {$ENDIF HAS_EARGUMENTEXCEPTION} + if ExceptObject is EOutOfMemory then + Result := E_OUTOFMEMORY + else + if ExceptObject is EJclCompressionCancelled then + Result := E_ABORT + else + if ExceptObject is EOSError then + Result := HResultFromWin32(EOSError(ExceptObject).ErrorCode) + else if ExceptObject is EStreamError then + // EFCreateError/EFOpenError don't save the error code, so access denied + // and the like become generic "Unknown error" HRESULTs. If GetLastError + // matches the error message, use it. + if AnsiEndsStr(SysErrorMessage(GetLastError), EStreamError(ExceptObject).Message) then + Result := HResultFromWin32(GetLastError) + else + Result := E_FAIL + else + Result := inherited SafeCallException(ExceptObject, ExceptAddr); +end; + +//=== { TJclCompressionItem } ================================================ + +constructor TJclCompressionItem.Create(AArchive: TJclCompressionArchive); +begin + inherited Create; + FArchive := AArchive; + FPackedIndex := $FFFFFFFF; +end; + +function TJclCompressionItem.DeleteOutputFile: Boolean; +begin + Result := (FFileName <> '') and FileExists(FFileName) and FileDelete(FFileName); +end; + +destructor TJclCompressionItem.Destroy; +begin + ReleaseStream; + + inherited Destroy; +end; + +function TJclCompressionItem.GetAttributes: Cardinal; +begin + CheckGetProperty(ipAttributes); + Result := FAttributes; +end; + +function TJclCompressionItem.GetComment: WideString; +begin + CheckGetProperty(ipComment); + Result := FComment; +end; + +function TJclCompressionItem.GetCRC: Cardinal; +begin + CheckGetProperty(ipCRC); + Result := FCRC; +end; + +function TJclCompressionItem.GetCreationTime: TFileTime; +begin + CheckGetProperty(ipCreationTime); + Result := FCreationTime; +end; + +function TJclCompressionItem.GetDirectory: Boolean; +begin + Result := (Attributes and FILE_ATTRIBUTE_DIRECTORY) <> 0; +end; + +function TJclCompressionItem.GetEncrypted: Boolean; +begin + CheckGetProperty(ipEncrypted); + Result := FEncrypted; +end; + +function TJclCompressionItem.GetFileName: TFileName; +begin + CheckGetProperty(ipFileName); + Result := FFileName; +end; + +function TJclCompressionItem.GetFileSize: Int64; +begin + CheckGetProperty(ipFileSize); + Result := FFileSize; +end; + +function TJclCompressionItem.GetGroup: WideString; +begin + CheckGetProperty(ipGroup); + Result := FGroup; +end; + +function TJclCompressionItem.GetHostFS: WideString; +begin + CheckGetProperty(ipHostFS); + Result := FHostFS; +end; + +function TJclCompressionItem.GetHostOS: WideString; +begin + CheckGetProperty(ipHostOS); + Result := FHostOS; +end; + +function TJclCompressionItem.GetItemKind: TJclCompressionItemKind; +begin + if (Attributes and FILE_ATTRIBUTE_DIRECTORY) <> 0 then + Result := ikDirectory + else + Result := ikFile; +end; + +function TJclCompressionItem.GetLastAccessTime: TFileTime; +begin + CheckGetProperty(ipLastAccessTime); + Result := FLastAccessTime; +end; + +function TJclCompressionItem.GetLastWriteTime: TFileTime; +begin + CheckGetProperty(ipLastWriteTime); + Result := FLastWriteTime; +end; + +function TJclCompressionItem.GetLink: WideString; +begin + CheckGetProperty(ipLink); + Result := FLink; +end; + +function TJclCompressionItem.GetMethod: WideString; +begin + CheckGetProperty(ipMethod); + Result := FMethod; +end; + +function TJclCompressionItem.GetNestedArchiveName: WideString; +var + ParentArchiveExtension, ArchiveFileName, ArchiveExtension: WideString; + ExtensionMap: TJclWideStrings; +begin + if ipPackedName in ValidProperties then + Result := PackedName + else + begin + ArchiveFileName := ''; + ArchiveExtension := ''; + + // find archive file name + if Archive.VolumeCount > 0 then + ArchiveFileName := WideExtractFileName(WideString(Archive.Volumes[0].FileName)); + if (ArchiveFileName <> '') and (WideExtractFileExt(ArchiveFileName) = '.001') then + ArchiveFileName := WideChangeFileExt(ArchiveFileName, ''); + ParentArchiveExtension := WideExtractFileExt(ArchiveFileName); + ArchiveFileName := WideChangeFileExt(ArchiveFileName, ''); + + // find item extension + ArchiveExtension := WideExtractFileExt(ArchiveFileName); + if ArchiveExtension <> '' then + ArchiveFileName := WideChangeFileExt(ArchiveFileName, '') + else + if ipPackedExtension in ValidProperties then + ArchiveExtension := PackedExtension + else + if ArchiveFileName <> '' then + begin + ExtensionMap := TJclWideStringList.Create; + try + ExtensionMap.Delimiter := ';'; + ExtensionMap.DelimitedText := Archive.ArchiveSubExtensions; + ArchiveExtension := ExtensionMap.Values[ParentArchiveExtension]; + finally + ExtensionMap.Free; + end; + end; + + // elaborate result + if (ArchiveFileName = '') and (ArchiveExtension = '') then + raise EJclCompressionError.CreateRes(@RsCompressionUnavailableProperty) + else + if ArchiveFileName = '' then + Result := ArchiveExtension + else + Result := WideChangeFileExt(ArchiveFileName, ArchiveExtension); + end; +end; + +function TJclCompressionItem.GetNestedArchiveStream: TStream; +begin + raise EJclCompressionError.CreateRes(@RsCompressionNoNestedArchive); +end; + +function TJclCompressionItem.GetPackedExtension: WideString; +begin + CheckGetProperty(ipPackedExtension); + if FPackedName = '' then + Result := FPackedExtension + else + Result := WideExtractFileExt(FPackedName); +end; + +function TJclCompressionItem.GetPackedName: WideString; +begin + CheckGetProperty(ipPackedName); + Result := FPackedName; +end; + +function TJclCompressionItem.GetPackedSize: Int64; +begin + CheckGetProperty(ipPackedSize); + Result := FPackedSize; +end; + +function TJclCompressionItem.GetPosixAttrib: Cardinal; +begin + CheckGetProperty(ipPosixAttrib); + Result := FPosixAttrib; +end; + +function TJclCompressionItem.GetStream: TStream; +begin + if not Assigned(FStream) and (FileName <> '') then + FStream := OpenFileStream(FileName, Archive.ItemAccess); + + Result := FStream; +end; + +function TJclCompressionItem.GetUser: WideString; +begin + CheckGetProperty(ipUser); + Result := FUser; +end; + +procedure TJclCompressionItem.ReleaseStream; +begin + if OwnsStream or (FileName <> '') then + FreeAndNil(FStream); +end; + +procedure TJclCompressionItem.SetAttributes(Value: Cardinal); +begin + CheckSetProperty(ipAttributes); + FAttributes := Value; + Include(FModifiedProperties, ipAttributes); + Include(FValidProperties, ipAttributes); +end; + +procedure TJclCompressionItem.SetComment(const Value: WideString); +begin + CheckSetProperty(ipComment); + FComment := Value; + Include(FModifiedProperties, ipComment); + Include(FValidProperties, ipComment); +end; + +procedure TJclCompressionItem.SetCRC(Value: Cardinal); +begin + CheckSetProperty(ipCRC); + FCRC := Value; + Include(FModifiedProperties, ipCRC); + Include(FValidProperties, ipCRC); +end; + +procedure TJclCompressionItem.SetCreationTime(const Value: TFileTime); +begin + CheckSetProperty(ipCreationTime); + FCreationTime := Value; + Include(FModifiedProperties, ipCreationTime); + Include(FValidProperties, ipCreationTime); +end; + +procedure TJclCompressionItem.SetDirectory(Value: Boolean); +begin + CheckSetProperty(ipAttributes); + if Value then + FAttributes := FAttributes or FILE_ATTRIBUTE_DIRECTORY + else + FAttributes := FAttributes and (not FILE_ATTRIBUTE_DIRECTORY); + Include(FModifiedProperties, ipAttributes); + Include(FValidProperties, ipAttributes); +end; + +procedure TJclCompressionItem.SetEncrypted(Value: Boolean); +begin + CheckSetProperty(ipEncrypted); + FEncrypted := Value; + Include(FModifiedProperties, ipEncrypted); + Include(FValidProperties, ipEncrypted); +end; + +procedure TJclCompressionItem.SetFileName(const Value: TFileName); +var + AFindData: TWin32FindData; +begin + CheckSetProperty(ipFileName); + FFileName := Value; + if Value <> '' then + begin + Include(FModifiedProperties, ipFileName); + Include(FValidProperties, ipFileName); + end + else + begin + Exclude(FModifiedProperties, ipFileName); + Exclude(FValidProperties, ipFileName); + end; + + if (Value <> '') and (FArchive is TJclCompressionArchive) + and GetFileAttributesEx(PChar(Value), GetFileExInfoStandard, @AFindData) then + begin + FileSize := (Int64(AFindData.nFileSizeHigh) shl 32) or AFindData.nFileSizeLow; + Attributes := AFindData.dwFileAttributes; + CreationTime := AFindData.ftCreationTime; + LastAccessTime := AFindData.ftLastAccessTime; + LastWriteTime := AFindData.ftLastWriteTime; + // TODO: user name and group (using file handle and GetSecurityInfo) + {$IFDEF MSWINDOWS} + HostOS := LoadResString(@RsCompression7zWindows); + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + HostOS := LoadResString(@RsCompression7zUnix); + {$ENDIF UNIX} + end; +end; + +procedure TJclCompressionItem.SetFileSize(const Value: Int64); +begin + CheckSetProperty(ipFileSize); + FFileSize := Value; + Include(FModifiedProperties, ipFileSize); + Include(FValidProperties, ipFileSize); +end; + +procedure TJclCompressionItem.SetGroup(const Value: WideString); +begin + CheckSetProperty(ipGroup); + FGroup := Value; + Include(FModifiedProperties, ipGroup); + Include(FValidProperties, ipGroup); +end; + +procedure TJclCompressionItem.SetHostFS(const Value: WideString); +begin + CheckSetProperty(ipHostFS); + FHostFS := Value; + Include(FModifiedProperties, ipHostFS); + Include(FValidProperties, ipHostFS); +end; + +procedure TJclCompressionItem.SetHostOS(const Value: WideString); +begin + CheckSetProperty(ipHostOS); + FHostOS := Value; + Include(FModifiedProperties, ipHostOS); + Include(FValidProperties, ipHostOS); +end; + +procedure TJclCompressionItem.SetLastAccessTime(const Value: TFileTime); +begin + CheckSetProperty(ipLastAccessTime); + FLastAccessTime := Value; + Include(FModifiedProperties, ipLastAccessTime); + Include(FValidProperties, ipLastAccessTime); +end; + +procedure TJclCompressionItem.SetLastWriteTime(const Value: TFileTime); +begin + CheckSetProperty(ipLastWriteTime); + FLastWriteTime := Value; + Include(FModifiedProperties, ipLastWriteTime); + Include(FValidProperties, ipLastWriteTime); +end; + +procedure TJclCompressionItem.SetLink(const Value: WideString); +begin + CheckSetProperty(ipLink); + FLink := Value; + Include(FModifiedProperties, ipLink); + Include(FValidProperties, ipLink); +end; + +procedure TJclCompressionItem.SetMethod(const Value: WideString); +begin + CheckSetProperty(ipMethod); + FMethod := Value; + Include(FModifiedProperties, ipMethod); + Include(FValidProperties, ipMethod); +end; + +procedure TJclCompressionItem.SetPackedExtension(const Value: WideString); +begin + CheckSetProperty(ipPackedExtension); + if (Value <> '') and (Value[1] <> '.') then + // force heading '.' + FPackedExtension := '.' + Value + else + FPackedExtension := Value; + Include(FModifiedProperties, ipPackedExtension); + Include(FValidProperties, ipPackedExtension); +end; + +procedure TJclCompressionItem.SetPackedName(const Value: WideString); +var + PackedNamesIndex: Integer; +begin + if FPackedName <> Value then + begin + CheckSetProperty(ipPackedName); + if FArchive is TJclCompressArchive then + begin + PackedNamesIndex := -1; + if (TJclCompressArchive(FArchive).FPackedNames <> nil) and + TJclCompressArchive(FArchive).FPackedNames.Find(FPackedName, PackedNamesIndex) then + begin + TJclCompressArchive(FArchive).FPackedNames.Delete(PackedNamesIndex); + try + TJclCompressArchive(FArchive).FPackedNames.Add(Value); + except + raise EJclCompressionError.Create(Format(LoadResString(@RsCompressionDuplicate), [Value])); + end; + end; + end; + FPackedName := Value; + Include(FModifiedProperties, ipPackedName); + Include(FValidProperties, ipPackedName); + end; +end; + +procedure TJclCompressionItem.SetPackedSize(const Value: Int64); +begin + CheckSetProperty(ipPackedSize); + FPackedSize := Value; + Include(FModifiedProperties, ipPackedSize); + Include(FValidProperties, ipPackedSize); +end; + +procedure TJclCompressionItem.SetPosixAttrib(Value: Cardinal); +begin + CheckSetProperty(ipPosixAttrib); + FPosixAttrib := Value; + Include(FModifiedProperties, ipPosixAttrib); + Include(FValidProperties, ipPosixAttrib); +end; + +procedure TJclCompressionItem.SetStream(const Value: TStream); +begin + CheckSetProperty(ipStream); + ReleaseStream; + FStream := Value; + if Value <> nil then begin + Include(FModifiedProperties, ipStream); + Include(FValidProperties, ipStream); + end + else begin + Exclude(FModifiedProperties, ipStream); + Exclude(FValidProperties, ipStream); + end; +end; + +procedure TJclCompressionItem.SetUser(const Value: WideString); +begin + CheckSetProperty(ipUser); + FUser := Value; + Include(FModifiedProperties, ipUser); + Include(FValidProperties, ipUser); +end; + +function TJclCompressionItem.UpdateFileTimes: Boolean; +const + FILE_WRITE_ATTRIBUTES = $00000100; +var + FileHandle: THandle; + ACreationTime, ALastAccessTime, ALastWriteTime: PFileTime; +begin + ReleaseStream; + Result := FFileName <> ''; + if Result then + begin + FileHandle := CreateFile(PChar(FFileName), FILE_WRITE_ATTRIBUTES, FILE_SHARE_READ, nil, OPEN_ALWAYS, 0, 0); + try + // creation time should be the oldest + if ipCreationTime in FValidProperties then + ACreationTime := @FCreationTime + else + if ipLastWriteTime in FValidProperties then + ACreationTime := @FLastWriteTime + else + if ipLastAccessTime in FValidProperties then + ACreationTime := @FLastAccessTime + else + ACreationTime := nil; + + // last access time may default to now if not set + if ipLastAccessTime in FValidProperties then + ALastAccessTime := @FLastAccessTime + else + ALastAccessTime := nil; + + // last write time may, if not set, be the creation time or last access time + if ipLastWriteTime in FValidProperties then + ALastWriteTime := @FLastWriteTime + else + if ipCreationTime in FValidProperties then + ALastWriteTime := @FCreationTime + else + if ipLastAccessTime in FValidProperties then + ALastWriteTime := @FLastAccessTime + else + ALastWriteTime := nil; + + Result := (FileHandle <> INVALID_HANDLE_VALUE) and SetFileTime(FileHandle, ACreationTime, ALastAccessTime, + ALastWriteTime); + finally + CloseHandle(FileHandle); + end; + end; +end; + +function TJclCompressionItem.ValidateExtraction(Index: Integer): Boolean; +begin + Result := False; +end; + +function TJclCompressionItem.WideChangeFileExt(const AFileName, + AExtension: WideString): WideString; +var + Index: Integer; +begin + Result := AFileName; + // Unicode version of ChangeFileExt + for Index := Length(Result) downto 1 do + begin + case Result[Index] of + '.': + begin + Result := Copy(Result, 1, Index - 1) + AExtension; + Exit; + end; + DirSeparator, + DirDelimiter: + // no extension + Break; + end; + end; + Result := Result + AExtension; +end; + +function TJclCompressionItem.WideExtractFileExt( + const AFileName: WideString): WideString; +var + Index: Integer; +begin + Result := ''; + // Unicode version of ExtractFileExt + for Index := Length(AFileName) downto 1 do + begin + case AFileName[Index] of + '.': + begin + Result := Copy(AFileName, Index, Length(AFileName) - Index + 1); + Break; + end; + DirSeparator, + DirDelimiter: + // no extension + Break; + end; + end; +end; + +function TJclCompressionItem.WideExtractFileName( + const AFileName: WideString): WideString; +var + Index: Integer; +begin + Result := AFileName; + // Unicode version of ExtractFileName + for Index := Length(AFileName) downto 1 do + begin + case AFileName[Index] of + DirSeparator, + DirDelimiter: + begin + Result := Copy(AFileName, Index + 1, Length(AFileName) - Index); + Break; + end; + end; + end; +end; + +//=== { TJclCompressionArchiveFormats } ====================================== + +constructor TJclCompressionArchiveFormats.Create; +begin + inherited Create; + FCompressFormats := TList.Create; + FDecompressFormats := TList.Create; + FUpdateFormats := TList.Create; + // register compression archives + RegisterFormat(TJclZipCompressArchive); + RegisterFormat(TJclBZ2CompressArchive); + RegisterFormat(TJcl7zCompressArchive); + RegisterFormat(TJclTarCompressArchive); + RegisterFormat(TJclGZipCompressArchive); + RegisterFormat(TJclXzCompressArchive); + RegisterFormat(TJclSwfcCompressArchive); + RegisterFormat(TJclWimCompressArchive); + // register decompression archives + RegisterFormat(TJclZipDecompressArchive); + RegisterFormat(TJclBZ2DecompressArchive); + RegisterFormat(TJclRarDecompressArchive); + RegisterFormat(TJclArjDecompressArchive); + RegisterFormat(TJclZDecompressArchive); + RegisterFormat(TJclLzhDecompressArchive); + RegisterFormat(TJcl7zDecompressArchive); + RegisterFormat(TJclCabDecompressArchive); + RegisterFormat(TJclNsisDecompressArchive); + RegisterFormat(TJclLzmaDecompressArchive); + RegisterFormat(TJclLzma86DecompressArchive); + RegisterFormat(TJclPeDecompressArchive); + RegisterFormat(TJclElfDecompressArchive); + RegisterFormat(TJclMachoDecompressArchive); + RegisterFormat(TJclUdfDecompressArchive); + RegisterFormat(TJclXarDecompressArchive); + RegisterFormat(TJclMubDecompressArchive); + RegisterFormat(TJclHfsDecompressArchive); + RegisterFormat(TJclDmgDecompressArchive); + RegisterFormat(TJclCompoundDecompressArchive); + RegisterFormat(TJclWimDecompressArchive); + RegisterFormat(TJclIsoDecompressArchive); + RegisterFormat(TJclChmDecompressArchive); + RegisterFormat(TJclSplitDecompressArchive); + RegisterFormat(TJclRpmDecompressArchive); + RegisterFormat(TJclDebDecompressArchive); + RegisterFormat(TJclCpioDecompressArchive); + RegisterFormat(TJclTarDecompressArchive); + RegisterFormat(TJclGZipDecompressArchive); + RegisterFormat(TJclXzDecompressArchive); + RegisterFormat(TJclNtfsDecompressArchive); + RegisterFormat(TJclFatDecompressArchive); + RegisterFormat(TJclMbrDecompressArchive); + RegisterFormat(TJclVhdDecompressArchive); + RegisterFormat(TJclMslzDecompressArchive); + RegisterFormat(TJclFlvDecompressArchive); + RegisterFormat(TJclSwfDecompressArchive); + RegisterFormat(TJclSwfcDecompressArchive); + RegisterFormat(TJclAPMDecompressArchive); + RegisterFormat(TJclPpmdDecompressArchive); + RegisterFormat(TJclTEDecompressArchive); + RegisterFormat(TJclUEFIcDecompressArchive); + RegisterFormat(TJclUEFIsDecompressArchive); + RegisterFormat(TJclSquashFSDecompressArchive); + RegisterFormat(TJclCramFSDecompressArchive); + RegisterFormat(TJclExtDecompressArchive); + RegisterFormat(TJclVMDKDecompressArchive); + RegisterFormat(TJclVDIDecompressArchive); + RegisterFormat(TJclQcowDecompressArchive); + RegisterFormat(TJclGPTDecompressArchive); + RegisterFormat(TJclRar5DecompressArchive); + RegisterFormat(TJclIHexDecompressArchive); + RegisterFormat(TJclHxsDecompressArchive); + // register update archives + RegisterFormat(TJclZipUpdateArchive); + RegisterFormat(TJclBZ2UpdateArchive); + RegisterFormat(TJcl7zUpdateArchive); + RegisterFormat(TJclTarUpdateArchive); + RegisterFormat(TJclGZipUpdateArchive); + RegisterFormat(TJclSwfcUpdateArchive); +end; + +destructor TJclCompressionArchiveFormats.Destroy; +begin + FCompressFormats.Free; + FDecompressFormats.Free; + FUpdateFormats.Free; + inherited Destroy; +end; + +function TJclCompressionArchiveFormats.FindCompressFormat(const AFileName: TFileName): TJclCompressArchiveClass; +var + IndexFormat, IndexFilter: Integer; + Filters: TStrings; + AFormat: TJclCompressArchiveClass; +begin + Result := nil; + Filters := TStringList.Create; + try + for IndexFormat := 0 to CompressFormatCount - 1 do + begin + AFormat := CompressFormats[IndexFormat]; + StrTokenToStrings(AFormat.ArchiveExtensions, DirSeparator, Filters); + for IndexFilter := 0 to Filters.Count - 1 do + if IsFileNameMatch(AFileName, Filters.Strings[IndexFilter]) then + begin + Result := AFormat; + Break; + end; + if Result <> nil then + Break; + end; + finally + Filters.Free; + end; +end; + +function TJclCompressionArchiveFormats.FindCompressFormats( + const AFileName: TFileName): TJclCompressArchiveClassArray; +var + IndexFormat, IndexFilter: Integer; + Filters: TStrings; + AFormat: TJclCompressArchiveClass; +begin + SetLength(Result, 0); + Filters := TStringList.Create; + try + for IndexFormat := 0 to CompressFormatCount - 1 do + begin + AFormat := CompressFormats[IndexFormat]; + StrTokenToStrings(AFormat.ArchiveExtensions, DirSeparator, Filters); + for IndexFilter := 0 to Filters.Count - 1 do + if IsFileNameMatch(AFileName, Filters.Strings[IndexFilter]) then + begin + SetLength(Result, Length(Result) + 1); + Result[High(Result)] := AFormat; + Break; + end; + end; + finally + Filters.Free; + end; +end; + +{function TJclCompressionArchiveFormats.FindDecompressFormat(const AFileName: TFileName; + TestArchiveSignature: Boolean): TJclDecompressArchiveClass; +var + MatchingFormats: TJclDecompressArchiveClassArray; + Index: Integer; + ArchiveStream: TStream; + Buffer: TDynByteArray; +begin + SetLength(Buffer, 0); + + // enumerate formats based on filename + MatchingFormats := FindDecompressFormats(AFileName); + if (Length(MatchingFormats) >= 1) and (not TestArchiveSignature) then + begin + Result := MatchingFormats[0]; + Exit; + end + else + Result := nil; + + // load archive to test signature + ArchiveStream := TFileStream.Create(AFileName, fmOpenRead and fmShareDenyNone); + try + for Index := Low(MatchingFormats) to High(MatchingFormats) do + if SignatureMatches(MatchingFormats[Index], ArchiveStream, Buffer) then + begin + Result := MatchingFormats[Index]; + Exit; + end; + finally + ArchiveStream.Free; + end; +end;} + +function TJclCompressionArchiveFormats.FindDecompressFormat(const AFileName: TFileName): TJclDecompressArchiveClass; +var + MatchingFormats: TJclDecompressArchiveClassArray; +begin + // enumerate formats based on filename + MatchingFormats := FindDecompressFormats(AFileName); + if Length(MatchingFormats) >= 1 then + begin + Result := MatchingFormats[0]; + Exit; + end + else + Result := nil; +end; + +function TJclCompressionArchiveFormats.FindDecompressFormats( + const AFileName: TFileName): TJclDecompressArchiveClassArray; +var + IndexFormat, IndexFilter: Integer; + Filters: TStrings; + AFormat: TJclDecompressArchiveClass; +begin + SetLength(Result, 0); + Filters := TStringList.Create; + try + for IndexFormat := 0 to DecompressFormatCount - 1 do + begin + AFormat := DecompressFormats[IndexFormat]; + StrTokenToStrings(AFormat.ArchiveExtensions, DirSeparator, Filters); + for IndexFilter := 0 to Filters.Count - 1 do + if IsFileNameMatch(AFileName, Filters.Strings[IndexFilter]) then + begin + SetLength(Result, Length(Result) + 1); + Result[High(Result)] := AFormat; + Break; + end; + end; + finally + Filters.Free; + end; +end; + +{function TJclCompressionArchiveFormats.FindUpdateFormat(const AFileName: TFileName; + TestArchiveSignature: Boolean): TJclUpdateArchiveClass; +var + MatchingFormats: TJclUpdateArchiveClassArray; + Index: Integer; + ArchiveStream: TStream; + Buffer: TDynByteArray; +begin + SetLength(Buffer, 0); + + // enumerate formats based on filename + MatchingFormats := FindUpdateFormats(AFileName); + if (Length(MatchingFormats) >= 1) and (not TestArchiveSignature) then + begin + Result := MatchingFormats[0]; + Exit; + end + else + Result := nil; + + // load archive to test signature + ArchiveStream := TFileStream.Create(AFileName, fmOpenRead and fmShareDenyNone); + try + for Index := Low(MatchingFormats) to High(MatchingFormats) do + if SignatureMatches(MatchingFormats[Index], ArchiveStream, Buffer) then + begin + Result := MatchingFormats[Index]; + Exit; + end; + finally + ArchiveStream.Free; + end; +end;} + +function TJclCompressionArchiveFormats.FindUpdateFormat(const AFileName: TFileName): TJclUpdateArchiveClass; +var + MatchingFormats: TJclUpdateArchiveClassArray; +begin + // enumerate formats based on filename + MatchingFormats := FindUpdateFormats(AFileName); + if Length(MatchingFormats) >= 1 then + begin + Result := MatchingFormats[0]; + Exit; + end + else + Result := nil; +end; + +function TJclCompressionArchiveFormats.FindUpdateFormats( + const AFileName: TFileName): TJclUpdateArchiveClassArray; +var + IndexFormat, IndexFilter: Integer; + Filters: TStrings; + AFormat: TJclUpdateArchiveClass; +begin + SetLength(Result, 0); + Filters := TStringList.Create; + try + for IndexFormat := 0 to UpdateFormatCount - 1 do + begin + AFormat := UpdateFormats[IndexFormat]; + StrTokenToStrings(AFormat.ArchiveExtensions, DirSeparator, Filters); + for IndexFilter := 0 to Filters.Count - 1 do + if IsFileNameMatch(AFileName, Filters.Strings[IndexFilter]) then + begin + SetLength(Result, Length(Result) + 1); + Result[High(Result)] := AFormat; + Break; + end; + end; + finally + Filters.Free; + end; +end; + +function TJclCompressionArchiveFormats.GetCompressFormat(Index: Integer): TJclCompressArchiveClass; +begin + Result := TJclCompressArchiveClass(FCompressFormats.Items[Index]); +end; + +function TJclCompressionArchiveFormats.GetCompressFormatCount: Integer; +begin + Result := FCompressFormats.Count; +end; + +function TJclCompressionArchiveFormats.GetDecompressFormat(Index: Integer): TJclDecompressArchiveClass; +begin + Result := TJclDecompressArchiveClass(FDecompressFormats.Items[Index]); +end; + +function TJclCompressionArchiveFormats.GetDecompressFormatCount: Integer; +begin + Result := FDecompressFormats.Count; +end; + +function TJclCompressionArchiveFormats.GetUpdateFormat(Index: Integer): TJclUpdateArchiveClass; +begin + Result := TJclUpdateArchiveClass(FUpdateFormats.Items[Index]); +end; + +function TJclCompressionArchiveFormats.GetUpdateFormatCount: Integer; +begin + Result := FUpdateFormats.Count; +end; + +procedure TJclCompressionArchiveFormats.RegisterFormat(AClass: TJclCompressionArchiveClass); +begin + if AClass.InheritsFrom(TJclUpdateArchive) then + FUpdateFormats.Add(AClass) + else + if AClass.InheritsFrom(TJclDecompressArchive) then + FDecompressFormats.Add(AClass) + else + if AClass.InheritsFrom(TJclCompressArchive) then + FCompressFormats.Add(AClass); +end; + +{function TJclCompressionArchiveFormats.SignatureMatches( + Format: TJclCompressionArchiveClass; ArchiveStream: TStream; + var Buffer: TDynByteArray): Boolean; +var + Index, StartPos, EndPos: Integer; + Signature: TDynByteArray; +begin + // must match empty signatures + Result := True; + Signature := Format.ArchiveSignature; + + // fill buffer if needed + StartPos := Length(Buffer); // High(Buffer) + 1 + EndPos := Length(Signature); + if StartPos < EndPos then + begin + SetLength(Buffer, EndPos); + for Index := StartPos to EndPos - 1 do + ArchiveStream.ReadBuffer(Buffer[Index], SizeOf(Buffer[Index])); + end; + + // compare buffer and signature + for Index := 0 to EndPos - 1 do + if Buffer[Index] <> Signature[Index] then + begin + Result := False; + Break; + end; +end;} + +procedure TJclCompressionArchiveFormats.UnregisterFormat(AClass: TJclCompressionArchiveClass); +begin + if AClass.InheritsFrom(TJclUpdateArchive) then + FUpdateFormats.Remove(AClass) + else + if AClass.InheritsFrom(TJclDecompressArchive) then + FDecompressFormats.Remove(AClass) + else + if AClass.InheritsFrom(TJclCompressArchive) then + FCompressFormats.Remove(AClass); +end; + +function GetArchiveFormats: TJclCompressionArchiveFormats; +begin + if not Assigned(GlobalArchiveFormats) then + GlobalArchiveFormats := TJclCompressionArchiveFormats.Create; + Result := TJclCompressionArchiveFormats(GlobalArchiveFormats); +end; + +//=== { TJclCompressionVolume } ============================================== + +constructor TJclCompressionVolume.Create(AStream, ATmpStream: TStream; AOwnsStream, AOwnsTmpStream: Boolean; + AFileName, ATmpFileName: TFileName; AVolumeMaxSize: Int64); +begin + inherited Create; + FStream := AStream; + FTmpStream := ATmpStream; + FOwnsStream := AOwnsStream; + FOwnsTmpStream := AOwnsTmpStream; + FFileName := AFileName; + FTmpFileName := ATmpFileName; + FVolumeMaxSize := AVolumeMaxSize; +end; + +destructor TJclCompressionVolume.Destroy; +begin + ReleaseStreams; + inherited Destroy; +end; + +procedure TJclCompressionVolume.ReleaseStreams; +begin + if OwnsStream then + FreeAndNil(FStream); + if OwnsTmpStream then + FreeAndNil(FTmpStream); +end; + +//=== { TJclCompressionArchive } ============================================= + +constructor TJclCompressionArchive.Create(Volume0: TStream; + AVolumeMaxSize: Int64 = 0; AOwnVolume: Boolean = False); +begin + inherited Create; + FVolumeIndex := -1; + FVolumeIndexOffset := 1; + FVolumeMaxSize := AVolumeMaxSize; + FItems := TObjectList.Create(True); + FVolumes := TObjectList.Create(True); + if Assigned(Volume0) then + AddVolume(Volume0, AVolumeMaxSize, AOwnVolume); + InitializeArchiveProperties; +end; + +constructor TJclCompressionArchive.Create(const VolumeFileName: TFileName; + AVolumeMaxSize: Int64 = 0; VolumeMask: Boolean = False); +begin + inherited Create; + FVolumeIndex := -1; + FVolumeIndexOffset := 1; + FVolumeMaxSize := AVolumeMaxSize; + FItems := TObjectList.Create(True); + FVolumes := TObjectList.Create(True); + if VolumeMask then + FVolumeFileNameMask := VolumeFileName + else + AddVolume(VolumeFileName, AVolumeMaxSize); + InitializeArchiveProperties; +end; + +destructor TJclCompressionArchive.Destroy; +begin + FItems.Free; + FVolumes.Free; + + inherited Destroy; +end; + +function TJclCompressionArchive.AddVolume(VolumeStream: TStream; + AVolumeMaxSize: Int64; AOwnsStream: Boolean): Integer; +begin + Result := FVolumes.Add(TJclCompressionVolume.Create(VolumeStream, nil, AOwnsStream, True, '', '', AVolumeMaxSize)); +end; + +function TJclCompressionArchive.AddVolume(VolumeStream, TmpVolumeStream: TStream; + AVolumeMaxSize: Int64; AOwnsStream, AOwnsTmpStream: Boolean): Integer; +begin + Result := FVolumes.Add(TJclCompressionVolume.Create(VolumeStream, TmpVolumeStream, AOwnsStream, AOwnsTmpStream, '', '', AVolumeMaxSize)); +end; + +function TJclCompressionArchive.AddVolume(const VolumeFileName: TFileName; + AVolumeMaxSize: Int64): Integer; +begin + Result := FVolumes.Add(TJclCompressionVolume.Create(nil, nil, True, True, VolumeFileName, '', AVolumeMaxSize)); +end; + +function TJclCompressionArchive.AddVolume(const VolumeFileName, TmpVolumeFileName: TFileName; + AVolumeMaxSize: Int64): Integer; +begin + Result := FVolumes.Add(TJclCompressionVolume.Create(nil, nil, True, True, VolumeFileName, TmpVolumeFileName, AVolumeMaxSize)); +end; + +class function TJclCompressionArchive.ArchiveExtensions: string; +begin + Result := ''; +end; + +class function TJclCompressionArchive.ArchiveName: string; +begin + Result := ''; +end; + +class function TJclCompressionArchive.ArchiveSignature: TDynByteArray; +begin + SetLength(Result, 0); +end; + +class function TJclCompressionArchive.ArchiveSubExtensions: string; +begin + Result := ''; +end; + +procedure TJclCompressionArchive.CheckOperationSuccess; +var + Index: Integer; +begin + for Index := 0 to FItems.Count - 1 do + begin + case TJclCompressionItem(FItems.Items[Index]).OperationSuccess of + osNoOperation: ; + osOK: ; + osUnsupportedMethod: + raise EJclCompressionError.CreateRes(@RsCompressionUnsupportedMethod); + osDataError: + raise EJclCompressionError.CreateRes(@RsCompressionDataError); + osCRCError: + raise EJclCompressionError.CreateRes(@RsCompressionCRCError); + else + raise EJclCompressionError.CreateRes(@RsCompressionUnknownError); + end; + end; +end; + +procedure TJclCompressionArchive.ClearItems; +begin + FItems.Clear; + FCurrentItemIndex := -1; +end; + +procedure TJclCompressionArchive.ClearOperationSuccess; +var + Index: Integer; +begin + for Index := 0 to FItems.Count - 1 do + TJclCompressionItem(FItems.Items[Index]).OperationSuccess := osNoOperation; +end; + +procedure TJclCompressionArchive.ClearVolumes; +begin + FVolumes.Clear; +end; + +procedure TJclCompressionArchive.InitializeArchiveProperties; +begin + // override to customize +end; + +function TJclCompressionArchive.DoGetOpenPassword: Boolean; +begin + if Assigned(FOnOpenPassword) then + Result := FOnOpenPassword(Self, FPassword) + else + Result := True; +end; + +function TJclCompressionArchive.DoProgress(const Value, MaxValue: Int64): Boolean; +begin + if Assigned(FOnProgress) then + FOnProgress(Self, Value, MaxValue); + Result := not FCancelCurrentOperation; +end; + +function TJclCompressionArchive.DoRatio(const InSize, OutSize: Int64): Boolean; +begin + if Assigned(FOnRatio) then + FOnRatio(Self, InSize, OutSize); + Result := not FCancelCurrentOperation; +end; + +function TJclCompressionArchive.GetItem(Index: Integer): TJclCompressionItem; +begin + Result := TJclCompressionItem(FItems.Items[Index]); +end; + +function TJclCompressionArchive.GetItemCount: Integer; +begin + Result := FItems.Count; +end; + +function TJclCompressionArchive.GetSupportsNestedArchive: Boolean; +begin + Result := False; +end; + +function TJclCompressionArchive.GetVolume(Index: Integer): TJclCompressionVolume; +begin + Result := TJclCompressionVolume(FVolumes.Items[Index]); +end; + +function TJclCompressionArchive.GetVolumeCount: Integer; +begin + Result := FVolumes.Count; +end; + +function TJclCompressionArchive.InternalOpenStream( + const FileName: TFileName): TStream; +begin + Result := OpenFileStream(FileName, VolumeAccess); +end; + +function TJclCompressionArchive.ItemAccess: TJclStreamAccess; +begin + Result := saReadOnly; +end; + +class function TJclCompressionArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +function TJclCompressionArchive.NeedStream(Index: Integer): TStream; +var + AVolume: TJclCompressionVolume; + AOwnsStream: Boolean; + AFileName: TFileName; +begin + Result := nil; + + if Index <> FVolumeIndex then + begin + AOwnsStream := VolumeFileNameMask <> ''; + AVolume := nil; + AFileName := Format(VolumeFileNameMask, [Index + VolumeIndexOffset]); + if (Index >= 0) and (Index < FVolumes.Count) then + begin + AVolume := TJclCompressionVolume(FVolumes.Items[Index]); + Result := AVolume.Stream; + AOwnsStream := AVolume.OwnsStream; + AFileName := AVolume.FileName; + end; + + if Assigned(FOnVolume) then + FOnVolume(Self, Index, AFileName, Result, AOwnsStream); + + if Assigned(AVolume) then + begin + if not Assigned(Result) then + Result := InternalOpenStream(AFileName); + AVolume.FFileName := AFileName; + AVolume.FStream := Result; + AVolume.FOwnsStream := AOwnsStream; + end + else + begin + while FVolumes.Count < Index do + FVolumes.Add(TJclCompressionVolume.Create(nil, nil, True, True, Format(VolumeFileNameMask, [Index + VolumeIndexOffset]), '', FVolumeMaxSize)); + if not Assigned(Result) then + Result := InternalOpenStream(AFileName); + if Assigned(Result) then + begin + if Index < FVolumes.Count then + begin + AVolume := TJclCompressionVolume(FVolumes.Items[Index]); + AVolume.FFileName := AFileName; + AVolume.FStream := Result; + AVolume.FOwnsStream := AOwnsStream; + AVolume.FVolumeMaxSize := FVolumeMaxSize; + end + else + FVolumes.Add(TJclCompressionVolume.Create(Result, nil, AOwnsStream, True, AFileName, '', FVolumeMaxSize)); + end; + end; + FVolumeIndex := Index; + end + else + if (Index >= 0) and (Index < FVolumes.Count) then + begin + AVolume := TJclCompressionVolume(FVolumes.Items[Index]); + Result := AVolume.Stream; + if Assigned(Result) then + Result.Seek(0, soBeginning); + end + else + FVolumeIndex := Index; +end; + +function TJclCompressionArchive.NeedStreamMaxSize(Index: Integer): Int64; +var + AVolume: TJclCompressionVolume; + LVolumeMaxSize: Int64; +begin + if (Index <> FVolumeIndex) then + begin + AVolume := nil; + if (Index >= 0) and (Index < FVolumes.Count) then begin + AVolume := TJclCompressionVolume(FVolumes.Items[Index]); + LVolumeMaxSize := AVolume.VolumeMaxSize; + end + else + LVolumeMaxSize := FVolumeMaxSize; + if Assigned(FOnVolumeMaxSize) then + FOnVolumeMaxSize(Self, Index, LVolumeMaxSize); + if Assigned(AVolume) then + AVolume.FVolumeMaxSize := LVolumeMaxSize + else + begin + while FVolumes.Count < Index do + FVolumes.Add(TJclCompressionVolume.Create(nil, nil, True, True, Format(VolumeFileNameMask, [Index + VolumeIndexOffset]), '', FVolumeMaxSize)); + if Index < FVolumes.Count then + begin + AVolume := TJclCompressionVolume(FVolumes.Items[Index]); + AVolume.FFileName := Format(VolumeFileNameMask, [Index + VolumeIndexOffset]); + AVolume.FStream := nil; + AVolume.FOwnsStream := True; + AVolume.FVolumeMaxSize := LVolumeMaxSize; + end + else + FVolumes.Add(TJclCompressionVolume.Create(nil, nil, True, True, Format(VolumeFileNameMask, [Index + VolumeIndexOffset]), '', LVolumeMaxSize)); + end; + end; + if (Index >= 0) and (Index < FVolumes.Count) then + Result := Volumes[Index].VolumeMaxSize + else + Result := FVolumeMaxSize; +end; + +procedure TJclCompressionArchive.ReleaseVolumes; +var + Index: Integer; +begin + for Index := 0 to FVolumes.Count - 1 do + TJclCompressionVolume(FVolumes.Items[Index]).ReleaseStreams; +end; + +procedure TJclCompressionArchive.SelectAll; +var + Index: Integer; +begin + for Index := 0 to FItems.Count - 1 do + TJclCompressionItem(FItems.Items[Index]).Selected := True; +end; + +function TJclCompressionArchive.TranslateItemPath(const ItemPath, OldBase, + NewBase: WideString): WideString; +begin + Result := PathCanonicalize(PathAddSeparator(NewBase) + PathGetRelativePath(OldBase, ItemPath)); +end; + +procedure TJclCompressionArchive.UnselectAll; +var + Index: Integer; +begin + for Index := 0 to FItems.Count - 1 do + TJclCompressionItem(FItems.Items[Index]).Selected := False; +end; + +class function TJclCompressionArchive.VolumeAccess: TJclStreamAccess; +begin + Result := saReadOnly; +end; + +function TJclCompressionArchive._AddRef: Integer; +begin + Result := -1; +end; + +function TJclCompressionArchive._Release: Integer; +begin + Result := -1; +end; + +//=== { TJclCompressItem } =================================================== + +procedure TJclCompressItem.CheckGetProperty( + AProperty: TJclCompressionItemProperty); +begin + // always valid +end; + +procedure TJclCompressItem.CheckSetProperty( + AProperty: TJclCompressionItemProperty); +begin + if AProperty in [ipMethod] then + raise EJclCompressionError.CreateRes(@RsCompressionWriteNotSupported); + (Archive as TJclCompressArchive).CheckNotCompressing; +end; + +//=== { TJclCompressArchive } ================================================ + +destructor TJclCompressArchive.Destroy; +begin + FPackedNames.Free; + inherited Destroy; +end; + +function TJclCompressArchive.AddDirectory(const PackedName: WideString; + const DirName: string; RecurseIntoDir: Boolean; AddFilesInDir: Boolean): Integer; +var + AItem: TJclCompressionItem; +begin + CheckNotCompressing; + + if DirName <> '' then + begin + FBaseRelName := PackedName; + FBaseDirName := PathRemoveSeparator(DirName); + FAddFilesInDir := AddFilesInDir; + + if RecurseIntoDir then + begin + Result := FItems.Count; + EnumDirectories(DirName, InternalAddDirectory, True, '', nil); + Exit; + end; + end; + + AItem := GetItemClass.Create(Self); + try + AItem.Directory := True; + AItem.PackedName := PackedName; + AItem.FileName := DirName; + except + AItem.Destroy; + raise; + end; + + Result := AddFileCheckDuplicate(AItem); + + if (DirName <> '') and AddFilesInDir then + EnumFiles(PathAddSeparator(DirName) + '*', InternalAddFile, faDirectory); +end; + +function TJclCompressArchive.AddFile(const PackedName: WideString; + const FileName: TFileName): Integer; +var + AItem: TJclCompressionItem; +begin + CheckNotCompressing; + + AItem := GetItemClass.Create(Self); + try + AItem.PackedName := PackedName; + AItem.FileName := FileName; + except + AItem.Destroy; + raise; + end; + + Result := AddFileCheckDuplicate(AItem); +end; + +function TJclCompressArchive.AddFile(const PackedName: WideString; + AStream: TStream; AOwnsStream: Boolean): Integer; +var + AItem: TJclCompressionItem; + NowFileTime: TFileTime; +begin + CheckNotCompressing; + + AItem := GetItemClass.Create(Self); + try + AItem.PackedName := PackedName; + AItem.Stream := AStream; + AItem.OwnsStream := AOwnsStream; + AItem.FileSize := AStream.Size - AStream.Position; + NowFileTime := LocalDateTimeToFileTime(Now); + AItem.Attributes := faReadOnly and faArchive; + AItem.CreationTime := NowFileTime; + AItem.LastAccessTime := NowFileTime; + AItem.LastWriteTime := NowFileTime; + {$IFDEF MSWINDOWS} + AItem.HostOS := LoadResString(@RsCompression7zWindows); + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + AItem.HostOS := LoadResString(@RsCompression7zUnix); + {$ENDIF UNIX} + except + AItem.Destroy; + raise; + end; + + Result := AddFileCheckDuplicate(AItem); +end; + +function TJclCompressArchive.AddFileCheckDuplicate(NewItem: TJclCompressionItem): Integer; +var + I, PackedNamesIndex: Integer; + S: string; +begin + if FDuplicateCheck = dcNone then + Result := FItems.Add(NewItem) + else + begin + if FPackedNames = nil then + begin + FPackedNames := TJclWideStringList.Create; + FPackedNames.Sorted := True; + {$IFDEF UNIX} + FPackedNames.CaseSensitive := True; + {$ELSE ~UNIX} + FPackedNames.CaseSensitive := False; + {$ENDIF ~UNIX} + FPackedNames.Duplicates := dupIgnore; + for I := ItemCount - 1 downto 0 do + FPackedNames.AddObject(Items[I].PackedName, Items[I]); + FPackedNames.Duplicates := dupError; + end; + if DuplicateCheck = dcAll then + begin + try + PackedNamesIndex := -1; + FPackedNames.AddObject(NewItem.PackedName, NewItem); + Result := FItems.Add(NewItem); + except + Result := -1; + end; + end + else + if FPackedNames.Find(NewItem.PackedName, PackedNamesIndex) then + Result := -1 + else + Result := FItems.Add(NewItem); + if Result < 0 then + begin + case DuplicateAction of + daOverwrite: + begin + if PackedNamesIndex < 0 then + PackedNamesIndex := FPackedNames.IndexOf(NewItem.PackedName); + FItems.Remove(FPackedNames.Objects[PackedNamesIndex]); + Result := FItems.Add(NewItem); + if DuplicateCheck = dcAll then + FPackedNames.Objects[PackedNamesIndex] := NewItem + else + FPackedNames.Delete(PackedNamesIndex); + end; + daError: + begin + S := Format(LoadResString(@RsCompressionDuplicate), [NewItem.PackedName]); + NewItem.Free; + raise EJclCompressionError.Create(S); + end; + daSkip: + begin + NewItem.Free; + Result := -1; + end; + end + end; + end; +end; + +procedure TJclCompressArchive.CheckNotCompressing; +begin + if FCompressing then + raise EJclCompressionError.CreateRes(@RsCompressionCompressingError); +end; + +procedure TJclCompressArchive.Compress; +begin +// Calling ReleaseVolumes here causes subsequent operations on the archive to fail with an "unsupported method" exception +// ReleaseVolumes; +end; + +procedure TJclCompressArchive.InternalAddDirectory(const Directory: string); +begin + AddDirectory(TranslateItemPath(Directory, FBaseDirName, FBaseRelName), Directory, False, FAddFilesInDir); +end; + +procedure TJclCompressArchive.InternalAddFile(const Directory: string; + const FileInfo: TSearchRec); +var + AFileName: TFileName; + AItem: TJclCompressionItem; +begin + AFileName := PathAddSeparator(Directory) + FileInfo.Name; + + AItem := GetItemClass.Create(Self); + try + AItem.PackedName := TranslateItemPath(AFileName, FBaseDirName, FBaseRelName); + AItem.FileName := AFileName; + except + AItem.Destroy; + raise; + end; + + AddFileCheckDuplicate(AItem); +end; + +function TJclCompressArchive.ItemAccess: TJclStreamAccess; +begin + Result := saReadOnly; +end; + +class function TJclCompressArchive.VolumeAccess: TJclStreamAccess; +begin + Result := saWriteOnly; +end; + +//=== { TJclDecompressItem } ================================================= + +procedure TJclDecompressItem.CheckGetProperty( + AProperty: TJclCompressionItemProperty); +begin + // TODO +end; + +procedure TJclDecompressItem.CheckSetProperty( + AProperty: TJclCompressionItemProperty); +begin + (Archive as TJclDecompressArchive).CheckNotDecompressing; +end; + +function TJclDecompressItem.ValidateExtraction(Index: Integer): Boolean; +begin + Result := (FArchive as TJclDecompressArchive).ValidateExtraction(Index, + FFileName, FStream, FOwnsStream); +end; + +//=== { TJclDecompressArchive } ============================================== + +procedure TJclDecompressArchive.CheckListing; +begin + if not FListing then + raise EJclCompressionError.CreateRes(@RsCompressionUnavailableProperty); +end; + +procedure TJclDecompressArchive.CheckNotDecompressing; +begin + if FDecompressing then + raise EJclCompressionError.CreateRes(@RsCompressionDecompressingError); +end; + +procedure TJclDecompressArchive.ExtractAll(const ADestinationDir: string; + AAutoCreateSubDir: Boolean); +begin +// Calling ReleaseVolumes here causes subsequent operations on the archive to fail with an "unsupported method" exception +// ReleaseVolumes; +end; + +procedure TJclDecompressArchive.ExtractSelected(const ADestinationDir: string; + AAutoCreateSubDir: Boolean); +begin +// Calling ReleaseVolumes here causes subsequent operations on the archive to fail with an "unsupported method" exception +// ReleaseVolumes; +end; + +function TJclDecompressArchive.ItemAccess: TJclStreamAccess; +begin + Result := saCreate; +end; + +function TJclDecompressArchive.ValidateExtraction(Index: Integer; + var FileName: TFileName; var AStream: TStream; var AOwnsStream: Boolean): Boolean; +var + AItem: TJclCompressionItem; + PackedName: TFileName; +begin + if FExtractingAllIndex <> -1 then + // extracting all + FExtractingAllIndex := Index; + + AItem := Items[Index]; + + if (FileName = '') and not Assigned(AStream) then + begin + PackedName := AItem.PackedName; + + if PackedName = '' then + PackedName := ChangeFileExt(ExtractFileName(Volumes[0].FileName), AItem.PackedExtension); + + FileName := PathGetRelativePath(FDestinationDir, PackedName); + end; + Result := True; + + if Assigned(FOnExtract) then + Result := FOnExtract(Self, Index, FileName, AStream, AOwnsStream); + + if Result and not Assigned(AStream) and AutoCreateSubDir then + begin + if (AItem.Attributes and faDirectory) <> 0 then + ForceDirectories(FileName) + else + ForceDirectories(ExtractFilePath(FileName)); + end; +end; + +class function TJclDecompressArchive.VolumeAccess: TJclStreamAccess; +begin + Result := saReadOnly; +end; + +//=== { TJclUpdateItem } ===================================================== + +procedure TJclUpdateItem.CheckGetProperty( + AProperty: TJclCompressionItemProperty); +begin + // TODO +end; + +procedure TJclUpdateItem.CheckSetProperty( + AProperty: TJclCompressionItemProperty); +begin + (Archive as TJclCompressArchive).CheckNotCompressing; +end; + +function TJclUpdateItem.ValidateExtraction(Index: Integer): Boolean; +begin + Result := (Archive as TJclUpdateArchive).ValidateExtraction(Index, FFileName, + FStream, FOwnsStream); +end; + +//=== { TJclUpdateArchive } ================================================== + +procedure TJclUpdateArchive.CheckListing; +begin + if not FListing then + raise EJclCompressionError.CreateRes(@RsCompressionUnavailableProperty); +end; + +procedure TJclUpdateArchive.CheckNotDecompressing; +begin + if FDecompressing then + raise EJclCompressionError.CreateRes(@RsCompressionDecompressingError); +end; + +procedure TJclUpdateArchive.ExtractAll(const ADestinationDir: string; + AAutoCreateSubDir: Boolean); +begin +// Calling ReleaseVolumes here causes subsequent operations on the archive to fail with an "unsupported method" exception +// ReleaseVolumes; +end; + +procedure TJclUpdateArchive.ExtractSelected(const ADestinationDir: string; + AAutoCreateSubDir: Boolean); +begin +// Calling ReleaseVolumes here causes subsequent operations on the archive to fail with an "unsupported method" exception +// ReleaseVolumes; +end; + +procedure TJclUpdateArchive.InitializeArchiveProperties; +begin + inherited InitializeArchiveProperties; + FDuplicateCheck := dcExisting; +end; + +function TJclUpdateArchive.ItemAccess: TJclStreamAccess; +begin + if FDecompressing then Result := saCreate + else Result := saReadOnly; +end; + +function TJclUpdateArchive.ValidateExtraction(Index: Integer; + var FileName: TFileName; var AStream: TStream; + var AOwnsStream: Boolean): Boolean; +var + AItem: TJclCompressionItem; + PackedName: TFileName; +begin + if FExtractingAllIndex <> -1 then + // extracting all + FExtractingAllIndex := Index; + + AItem := Items[Index]; + + if (FileName = '') and not Assigned(AStream) then + begin + PackedName := AItem.PackedName; + + if PackedName = '' then + PackedName := ChangeFileExt(ExtractFileName(Volumes[0].FileName), AItem.PackedExtension); + + FileName := PathGetRelativePath(FDestinationDir, PackedName); + end; + Result := True; + + if Assigned(FOnExtract) then + Result := FOnExtract(Self, Index, FileName, AStream, AOwnsStream); + + if Result and not Assigned(AStream) and AutoCreateSubDir then + begin + if (AItem.Attributes and faDirectory) <> 0 then + ForceDirectories(FileName) + else + ForceDirectories(ExtractFilePath(FileName)); + end; +end; + +class function TJclUpdateArchive.VolumeAccess: TJclStreamAccess; +begin + Result := saReadOnly; +end; + +//=== { TJclOutOfPlaceUpdateArchive } ======================================== + +procedure TJclOutOfPlaceUpdateArchive.Compress; +var + Index: Integer; + AVolume: TJclCompressionVolume; + SrcFileName, DestFileName: TFileName; + SrcStream, DestStream: TStream; + OwnsSrcStream, OwnsDestStream, AllHandled, Handled: Boolean; + CopiedSize: Int64; +begin + // release volume streams and other finalization + inherited Compress; + + if ReplaceVolumes then + begin + AllHandled := True; + + // replace streams by tmp streams + for Index := 0 to FVolumes.Count - 1 do + begin + AVolume := TJclCompressionVolume(FVolumes.Items[Index]); + + SrcFileName := AVolume.TmpFileName; + DestFileName := AVolume.FileName; + SrcStream := AVolume.TmpStream; + DestStream := AVolume.Stream; + OwnsSrcStream := AVolume.OwnsTmpStream; + OwnsDestStream := AVolume.OwnsStream; + + Handled := Assigned(FOnReplace) and FOnReplace(Self, SrcFileName, DestFileName, SrcStream, DestStream, OwnsSrcStream, OwnsDestStream); + + if not Handled then + begin + if (SrcFileName <> '') and (DestFileName <> '') and + (OwnsSrcStream or not Assigned(SrcStream)) and + (OwnsDestStream or not Assigned(DestStream)) then + begin + // close references before moving files + if OwnsSrcStream then + FreeAndNil(SrcStream); + if OwnsDestStream then + FreeAndNil(DestStream); + Handled := FileMove(SrcFileName, DestFileName, True); + end + else + if (SrcFileName = '') and (DestFileName = '') and Assigned(SrcStream) and Assigned(DestStream) then + begin + // in-memory moves + SrcStream.Seek(0, soBeginning); + DestStream.Seek(0, soBeginning); + CopiedSize := StreamCopy(SrcStream, DestStream); + // reset size + DestStream.Size := CopiedSize; + Handled := True; + end; + // identity + // else + // Handled := False; + end; + + // update volume information + AVolume.FTmpStream := SrcStream; + AVolume.FStream := DestStream; + AVolume.FOwnsTmpStream := OwnsSrcStream; + AVolume.FOwnsStream := OwnsDestStream; + AVolume.FTmpFileName := SrcFileName; + AVolume.FFileName := DestFileName; + + AllHandled := AllHandled and Handled; + end; + if not AllHandled then + raise EJclCompressionError.CreateRes(@RsCompressionReplaceError); + end; +end; + +procedure TJclOutOfPlaceUpdateArchive.InitializeArchiveProperties; +begin + inherited InitializeArchiveProperties; + FReplaceVolumes := True; + FTmpVolumeIndex := -1; +end; + +function TJclOutOfPlaceUpdateArchive.InternalOpenTmpStream( + const FileName: TFileName): TStream; +begin + Result := OpenFileStream(FileName, TmpVolumeAccess); +end; + +function TJclOutOfPlaceUpdateArchive.NeedTmpStream(Index: Integer): TStream; +var + AVolume: TJclCompressionVolume; + AOwnsStream: Boolean; + AFileName: TFileName; +begin + Result := nil; + + if Index <> FTmpVolumeIndex then + begin + AOwnsStream := VolumeFileNameMask <> ''; + AVolume := nil; + if VolumeFileNameMask = '' then AFileName := '' + else AFileName := FindUnusedFileName(Format(VolumeFileNameMask, [Index + VolumeIndexOffset]), '.tmp'); + if (Index >= 0) and (Index < FVolumes.Count) then + begin + AVolume := TJclCompressionVolume(FVolumes.Items[Index]); + Result := AVolume.TmpStream; + AOwnsStream := AVolume.OwnsTmpStream; + AFileName := AVolume.TmpFileName; + if (AFileName = '') and (AVolume.FileName <> '') then + AFileName := FindUnusedFileName(AVolume.FileName, '.tmp'); + end; + + if Assigned(FOnTmpVolume) then + FOnTmpVolume(Self, Index, AFileName, Result, AOwnsStream); + + if Assigned(AVolume) then + begin + if not Assigned(Result) then + Result := InternalOpenTmpStream(AFileName); + AVolume.FTmpFileName := AFileName; + AVolume.FTmpStream := Result; + AVolume.FOwnsTmpStream := AOwnsStream; + end + else + begin + while FVolumes.Count < Index do + FVolumes.Add(TJclCompressionVolume.Create(nil, nil, True, True, Format(VolumeFileNameMask, [Index + VolumeIndexOffset]), '', FVolumeMaxSize)); + if not Assigned(Result) then + Result := InternalOpenTmpStream(AFileName); + if Assigned(Result) then + begin + if Index < FVolumes.Count then + begin + AVolume := TJclCompressionVolume(FVolumes.Items[Index]); + AVolume.FTmpFileName := AFileName; + AVolume.FTmpStream := Result; + AVolume.FOwnsTmpStream := AOwnsStream; + AVolume.FVolumeMaxSize := FVolumeMaxSize; + end + else + FVolumes.Add(TJclCompressionVolume.Create(nil, Result, True, AOwnsStream, '', AFileName, FVolumeMaxSize)); + end; + end; + FTmpVolumeIndex := Index; + end + else + if (Index >= 0) and (Index < FVolumes.Count) then + begin + AVolume := TJclCompressionVolume(FVolumes.Items[Index]); + Result := AVolume.TmpStream; + if Assigned(Result) then + Result.Seek(0, soBeginning); + end + else + FTmpVolumeIndex := Index; +end; + +class function TJclOutOfPlaceUpdateArchive.TmpVolumeAccess: TJclStreamAccess; +begin + Result := saWriteOnly; +end; + +//=== { TJclSevenzipOutStream } ============================================== + +constructor TJclSevenzipOutStream.Create(AArchive: TJclCompressionArchive; AItemIndex: Integer); +begin + inherited Create; + + FArchive := AArchive; + FItemIndex := AItemIndex; + FStream := nil; + FOwnsStream := False; + FMaximumPosition := 0; + FTruncateOnRelease := False; +end; + +constructor TJclSevenzipOutStream.Create(AStream: TStream; AOwnsStream: Boolean; ATruncateOnRelease: Boolean); +begin + inherited Create; + + FArchive := nil; + FItemIndex := -1; + FStream := AStream; + FOwnsStream := AOwnsStream; + FMaximumPosition := 0; + FTruncateOnRelease := ATruncateOnRelease; +end; + +destructor TJclSevenzipOutStream.Destroy; +begin + ReleaseStream; + + inherited Destroy; +end; + +procedure TJclSevenzipOutStream.NeedStream; +begin + if Assigned(FArchive) then + begin + FArchive.FCurrentItemIndex := FItemIndex; + if not Assigned(FStream) then + FStream := FArchive.Items[FItemIndex].Stream; + end; + if not Assigned(FStream) then + raise EJclCompressionError.CreateRes(@RsCompression7zUnassignedStream); +end; + +procedure TJclSevenzipOutStream.ReleaseStream; +begin + // truncate to the maximum position that was written + if FTruncateOnRelease then + FStream.Size := FMaximumPosition; + + if Assigned(FArchive) then + FArchive.Items[FItemIndex].ReleaseStream + else + if FOwnsStream then + FStream.Free; +end; + +procedure TJclSevenzipOutStream.Seek(Offset: Int64; SeekOrigin: Cardinal; + NewPosition: PInt64); +var + NewPos: Int64; +begin + NeedStream; + + // STREAM_SEEK_SET = 0 = soBeginning + // STREAM_SEEK_CUR = 1 = soCurrent + // STREAM_SEEK_END = 2 = soEnd + NewPos := FStream.Seek(Offset, TSeekOrigin(SeekOrigin)); + if Assigned(NewPosition) then + NewPosition^ := NewPos; +end; + +procedure TJclSevenzipOutStream.SetSize(NewSize: Int64); +begin + NeedStream; + + FStream.Size := NewSize; + if FTruncateOnRelease and (FMaximumPosition < NewSize) then + FMaximumPosition := NewSize; +end; + +procedure TJclSevenzipOutStream.Write(Data: Pointer; Size: Cardinal; + ProcessedSize: PCardinal); +var + Processed: Cardinal; + APosition: Int64; +begin + NeedStream; + + Processed := FStream.Write(Data^, Size); + if Assigned(ProcessedSize) then + ProcessedSize^ := Processed; + if FTruncateOnRelease then + begin + APosition := FStream.Position; + if FMaximumPosition < APosition then + FMaximumPosition := APosition; + end; +end; + +//=== { TJclSevenzipNestedInStream } ========================================= + +constructor TJclSevenzipNestedInStream.Create(AInStream: IInStream); +begin + inherited Create; + FInStream := AInStream; +end; + +function TJclSevenzipNestedInStream.Read(var Buffer; Count: Integer): Longint; +begin + FInStream.Read(@Buffer, Count, @Result); +end; + +function TJclSevenzipNestedInStream.Seek(const Offset: Int64; + Origin: TSeekOrigin): Int64; +begin + FInStream.Seek(Offset, Cardinal(Origin), @Result); +end; + +procedure TJclSevenzipNestedInStream.SetSize(const NewSize: Int64); +begin + raise EJclCompressionError.CreateRes(@RsCompressionWriteNotSupported); +end; + +function TJclSevenzipNestedInStream.Write(const Buffer; + Count: Integer): Longint; +begin + raise EJclCompressionError.CreateRes(@RsCompressionWriteNotSupported); +end; + +//=== { TJclSevenzipInStream } =============================================== + +constructor TJclSevenzipInStream.Create(AArchive: TJclCompressionArchive; AItemIndex: Integer); +begin + inherited Create; + + FArchive := AArchive; + FItemIndex := AItemIndex; + FStream := nil; + FOwnsStream := False; +end; + +constructor TJclSevenzipInStream.Create(AStream: TStream; AOwnsStream: Boolean); +begin + inherited Create; + + FArchive := nil; + FItemIndex := -1; + FStream := AStream; + FOwnsStream := AOwnsStream; +end; + +destructor TJclSevenzipInStream.Destroy; +begin + ReleaseStream; + inherited Destroy; +end; + +procedure TJclSevenzipInStream.GetSize(out Size: Int64); +begin + NeedStream; + + Size := FStream.Size; +end; + +procedure TJclSevenzipInStream.NeedStream; +begin + if Assigned(FArchive) then + begin + FArchive.FCurrentItemIndex := FItemIndex; + if not Assigned(FStream) then + FStream := FArchive.Items[FItemIndex].Stream; + end; + + if not Assigned(FStream) then + raise EJclCompressionError.CreateRes(@RsCompression7zUnassignedStream); +end; + +procedure TJclSevenzipInStream.Read(Data: Pointer; Size: Cardinal; + ProcessedSize: PCardinal); +var + Processed: Cardinal; +begin + NeedStream; + + Processed := FStream.Read(Data^, Size); + if Assigned(ProcessedSize) then + ProcessedSize^ := Processed; +end; + +procedure TJclSevenzipInStream.ReleaseStream; +begin + if Assigned(FArchive) then + FArchive.Items[FItemIndex].ReleaseStream + else + if FOwnsStream then + FStream.Free; +end; + +procedure TJclSevenzipInStream.Seek(Offset: Int64; SeekOrigin: Cardinal; NewPosition: PInt64); +var + NewPos: Int64; +begin + NeedStream; + + // STREAM_SEEK_SET = 0 = soBeginning + // STREAM_SEEK_CUR = 1 = soCurrent + // STREAM_SEEK_END = 2 = soEnd + NewPos := FStream.Seek(Offset, TSeekOrigin(SeekOrigin)); + if Assigned(NewPosition) then + NewPosition^ := NewPos; +end; + +// sevenzip helper functions + +procedure SevenzipCheck(Value: HRESULT); +begin + if Value = S_FALSE then + raise EJclCompressionFalse.CreateResFmt(@RsCompression7zReturnError, + [S_FALSE, 'S_FALSE']) + else if (Value <> S_OK) and (Value <> E_ABORT) then + raise EJclCompressionError.CreateResFmt(@RsCompression7zReturnError, [Value, + SysErrorMessage(HResultCode(Value))]); +end; + +function Get7zWideStringProp(const AArchive: IInArchive; ItemIndex: Integer; + PropID: Cardinal; const Setter: TWideStringSetter): Boolean; +var + Value: TPropVariant; +begin + ZeroMemory(@Value, SizeOf(Value)); + AArchive.GetProperty(ItemIndex, PropID, Value); + case Value.vt of + VT_EMPTY, VT_NULL: + Result := False; + VT_LPSTR: + begin + Result := True; + Setter(WideString(AnsiString(Value.pszVal))); + end; + VT_LPWSTR: + begin + Result := True; + Setter(Value.pwszVal); + end; + VT_BSTR: + begin + Result := True; + Setter(Value.bstrVal); + SysFreeString(Value.bstrVal); + end; + VT_I1: + begin + Result := True; + Setter(IntToStr(Value.iVal)); + end; + VT_I2: + begin + Result := True; + Setter(IntToStr(Value.iVal)); + end; + VT_INT, VT_I4: + begin + Result := True; + Setter(IntToStr(Value.lVal)); + end; + VT_I8: + begin + Result := True; + Setter(IntToStr(Value.hVal.QuadPart)); + end; + VT_UI1: + begin + Result := True; + Setter(IntToStr(Value.bVal)); + end; + VT_UI2: + begin + Result := True; + Setter(IntToStr(Value.uiVal)); + end; + VT_UINT, VT_UI4: + begin + Result := True; + Setter(IntToStr(Value.ulVal)); + end; + VT_UI8: + begin + Result := True; + Setter(IntToStr(Value.uhVal.QuadPart)); + end; + else + raise EJclCompressionError.CreateResFmt(@RsCompression7zUnknownValueType, [Value.vt, PropID]); + end; +end; + +function Get7zCardinalProp(const AArchive: IInArchive; ItemIndex: Integer; + PropID: Cardinal; const Setter: TCardinalSetter): Boolean; +var + Value: TPropVariant; +begin + ZeroMemory(@Value, SizeOf(Value)); + AArchive.GetProperty(ItemIndex, PropID, Value); + case Value.vt of + VT_EMPTY, VT_NULL: + Result := False; + VT_I1, VT_I2, VT_INT, VT_I4, VT_I8, + VT_UI1, VT_UI2, VT_UINT, VT_UI4, VT_UI8: + begin + Result := True; + case Value.vt of + VT_I1: + Setter(Value.iVal); + VT_I2: + Setter(Value.iVal); + VT_INT, VT_I4: + Setter(Value.lVal); + VT_I8: + Setter(Value.hVal.QuadPart); + VT_UI1: + Setter(Value.bVal); + VT_UI2: + Setter(Value.uiVal); + VT_UINT, VT_UI4: + Setter(Value.ulVal); + VT_UI8: + Setter(Value.uhVal.QuadPart); + end; + end; + else + raise EJclCompressionError.CreateResFmt(@RsCompression7zUnknownValueType, [Value.vt, PropID]); + end; +end; + +function Get7zInt64Prop(const AArchive: IInArchive; ItemIndex: Integer; + PropID: Cardinal; const Setter: TInt64Setter): Boolean; +var + Value: TPropVariant; +begin + ZeroMemory(@Value, SizeOf(Value)); + AArchive.GetProperty(ItemIndex, PropID, Value); + case Value.vt of + VT_EMPTY, VT_NULL: + Result := False; + VT_I1, VT_I2, VT_INT, VT_I4, VT_I8, + VT_UI1, VT_UI2, VT_UINT, VT_UI4, VT_UI8: + begin + Result := True; + case Value.vt of + VT_I1: + Setter(Value.iVal); + VT_I2: + Setter(Value.iVal); + VT_INT, VT_I4: + Setter(Value.lVal); + VT_I8: + Setter(Value.hVal.QuadPart); + VT_UI1: + Setter(Value.bVal); + VT_UI2: + Setter(Value.uiVal); + VT_UINT, VT_UI4: + Setter(Value.ulVal); + VT_UI8: + Setter(Value.uhVal.QuadPart); + end; + end; + else + raise EJclCompressionError.CreateResFmt(@RsCompression7zUnknownValueType, [Value.vt, PropID]); + end; +end; + +function Get7zFileTimeProp(const AArchive: IInArchive; ItemIndex: Integer; + PropID: Cardinal; const Setter: TFileTimeSetter): Boolean; +var + Value: TPropVariant; +begin + ZeroMemory(@Value, SizeOf(Value)); + AArchive.GetProperty(ItemIndex, PropID, Value); + case Value.vt of + VT_EMPTY, VT_NULL: + Result := False; + VT_FILETIME: + begin + Result := True; + Setter(Value.filetime); + end; + else + raise EJclCompressionError.CreateResFmt(@RsCompression7zUnknownValueType, [Value.vt, PropID]); + end; +end; + +function Get7zBoolProp(const AArchive: IInArchive; ItemIndex: Integer; + PropID: Cardinal; const Setter: TBoolSetter): Boolean; +var + Value: TPropVariant; +begin + ZeroMemory(@Value, SizeOf(Value)); + AArchive.GetProperty(ItemIndex, PropID, Value); + case Value.vt of + VT_EMPTY, VT_NULL: + Result := False; + VT_BOOL: + begin + Result := True; + Setter(Value.bool); + end; + else + raise EJclCompressionError.CreateResFmt(@RsCompression7zUnknownValueType, [Value.vt, PropID]); + end; +end; + +// TODO: Are changes for UTF-8 filenames (>= 4.58 beta) necessary? +procedure Load7zFileAttribute(AInArchive: IInArchive; ItemIndex: Integer; + AItem: TJclCompressionItem); +begin + AItem.FValidProperties := []; + AItem.FPackedIndex := ItemIndex; + AItem.FileName := ''; + AItem.Stream := nil; + AItem.OwnsStream := False; + + // sometimes, items have neither names nor extension although other properties may succeed + Get7zWideStringProp(AInArchive, ItemIndex, kpidPath, AItem.SetPackedName); + Get7zWideStringProp(AInArchive, ItemIndex, kpidExtension, AItem.SetPackedExtension); + Get7zCardinalProp(AInArchive, ItemIndex, kpidAttrib, AItem.SetAttributes); + // SetDirectory must be after SetAttributes + Get7zBoolProp(AInArchive, ItemIndex, kpidIsDir, AItem.SetDirectory); + Get7zInt64Prop(AInArchive, ItemIndex, kpidSize, AItem.SetFileSize); + Get7zInt64Prop(AInArchive, ItemIndex, kpidPackSize, AItem.SetPackedSize); + Get7zFileTimeProp(AInArchive, ItemIndex, kpidCTime, AItem.SetCreationTime); + Get7zFileTimeProp(AInArchive, ItemIndex, kpidATime, AItem.SetLastAccessTime); + Get7zFileTimeProp(AInArchive, ItemIndex, kpidMTime, AItem.SetLastWriteTime); + Get7zWideStringProp(AInArchive, ItemIndex, kpidComment, AItem.SetComment); + Get7zWideStringProp(AInArchive, ItemIndex, kpidHostOS, AItem.SetHostOS); + Get7zWideStringProp(AInArchive, ItemIndex, kpidFileSystem, AItem.SetHostFS); + Get7zWideStringProp(AInArchive, ItemIndex, kpidUser, AItem.SetUser); + Get7zWideStringProp(AInArchive, ItemIndex, kpidGroup, AItem.SetGroup); + Get7zCardinalProp(AInArchive, ItemIndex, kpidCRC, AItem.SetCRC); + Get7zWideStringProp(AInArchive, ItemIndex, kpidMethod, AItem.SetMethod); + Get7zBoolProp(AInArchive, ItemIndex, kpidEncrypted, AItem.SetEncrypted); + Get7zCardinalProp(AInArchive, ItemIndex, kpidPosixAttrib, AItem.SetPosixAttrib); + Get7zWideStringProp(AInArchive, ItemIndex, kpidLink, AItem.SetLink); + + // reset modified flags + AItem.ModifiedProperties := []; +end; + +procedure GetSevenzipArchiveCompressionProperties(AJclArchive: IInterface; ASevenzipArchive: IInterface); +begin + // TODO properties from ASevenzipArchive to AJclArchive +end; + +procedure SetSevenzipArchiveCompressionProperties(AJclArchive: IInterface; ASevenzipArchive: IInterface); +var + PropertySetter: Sevenzip.ISetProperties; + InArchive, OutArchive: Boolean; + Unused: IInterface; + MultiThreadStrategy: IJclArchiveNumberOfThreads; + CompressionMethod: IJclArchiveCompressionMethod; + CompressionLevel: IJclArchiveCompressionLevel; + EncryptionMethod: IJclArchiveEncryptionMethod; + DictionarySize: IJclArchiveDictionarySize; + NumberOfPasses: IJclArchiveNumberOfPasses; + RemoveSfxBlock: IJclArchiveRemoveSfxBlock; + CompressHeader: IJclArchiveCompressHeader; + EncryptHeader: IJclArchiveEncryptHeader; + SaveCreationDateTime: IJclArchiveSaveCreationDateTime; + SaveLastAccessDateTime: IJclArchiveSaveLastAccessDateTime; + SaveLastWriteDateTime: IJclArchiveSaveLastWriteDateTime; + Algorithm: IJclArchiveAlgorithm; + Solid: IJclArchiveSolid; + PropNames: array of PWideChar; + PropValues: array of TPropVariant; + I: Integer; + + procedure AddProperty(const Name: PWideChar; const Value: TPropVariant); + begin + SetLength(PropNames, Length(PropNames) + 1); + PropNames[High(PropNames)] := Name; + SetLength(PropValues, Length(PropValues) + 1); + PropValues[High(PropValues)] := Value; + end; + + procedure AddCardinalProperty(const Name: PWideChar; Value: Cardinal); + var + PropValue: TPropVariant; + begin + PropValue.vt := VT_UI4; + PropValue.ulVal := Value; + AddProperty(Name, PropValue); + end; + + procedure AddWideStringProperty(const Name: PWideChar; const Value: WideString); + var + PropValue: TPropVariant; + begin + PropValue.vt := VT_BSTR; + PropValue.bstrVal := SysAllocString(PWideChar(Value)); + AddProperty(Name, PropValue); + end; + + procedure AddBooleanProperty(const Name: PWideChar; Value: Boolean); + var + PropValue: TPropVariant; + const + BooleanValues: array [False..True] of WideString = ('OFF', 'ON'); + begin + PropValue.vt := VT_BSTR; + PropValue.bstrVal := SysAllocString(PWideChar(BooleanValues[Value])); + AddProperty(Name, PropValue); + end; + +const + EncryptionMethodNames: array [TJclEncryptionMethod] of WideString = + ( '' {emNone}, + kAES128MethodName {emAES128}, + kAES192MethodName {emAES192}, + kAES256MethodName {emAES256}, + kZipCryptoMethodName {emZipCrypto} ); + CompressionMethodNames: array [TJclCompressionMethod] of WideString = + ( kCopyMethodName {cmCopy}, + kDeflateMethodName {cmDeflate}, + kDeflate64MethodName {cmDeflate64}, + kBZip2MethodName {cmBZip2}, + kLZMAMethodName {cmLZMA}, + kLZMA2MethodName {cmLZMA2}, + kPPMdMethodName {cmPPMd} ); +begin + if Supports(ASevenzipArchive, Sevenzip.ISetProperties, PropertySetter) and Assigned(PropertySetter) then + begin + InArchive := Supports(ASevenzipArchive, Sevenzip.IInArchive, Unused); + OutArchive := Supports(ASevenzipArchive, Sevenzip.IOutArchive, Unused); + if (InArchive or OutArchive) and Supports(AJclArchive, IJclArchiveNumberOfThreads, MultiThreadStrategy) + and Assigned(MultiThreadStrategy) and (MultiThreadStrategy.NumberOfThreads > 1) then + AddCardinalProperty('MT', MultiThreadStrategy.NumberOfThreads); + + try + if OutArchive then + begin + if Supports(AJclArchive, IJclArchiveCompressionMethod, CompressionMethod) and Assigned(CompressionMethod) then + AddWideStringProperty('M', CompressionMethodNames[CompressionMethod.CompressionMethod]); + + if Supports(AJclArchive, IJclArchiveCompressionLevel, CompressionLevel) and Assigned(CompressionLevel) then + AddCardinalProperty('X', CompressionLevel.CompressionLevel); + + if Supports(AJclArchive, IJclArchiveEncryptionMethod, EncryptionMethod) and Assigned(EncryptionMethod) + and (EncryptionMethod.EncryptionMethod <> emNone) then + AddWideStringProperty('EM', EncryptionMethodNames[EncryptionMethod.EncryptionMethod]); + + if Supports(AJclArchive, IJclArchiveDictionarySize, DictionarySize) and Assigned(DictionarySize) and + Supports(AJclArchive, IJclArchiveCompressionMethod, CompressionMethod) and Assigned(CompressionMethod) and + (CompressionMethod.CompressionMethod in [cmBZip2,cmLZMA,cmLZMA2]) then + AddWideStringProperty('D', IntToStr(DictionarySize.DictionarySize) + 'B'); + + if Supports(AJclArchive, IJclArchiveNumberOfPasses, NumberOfPasses) and Assigned(NumberOfPasses) then + AddCardinalProperty('PASS', NumberOfPasses.NumberOfPasses); + + if Supports(AJclArchive, IJclArchiveRemoveSfxBlock, RemoveSfxBlock) and Assigned(RemoveSfxBlock) then + AddBooleanProperty('RSFX', RemoveSfxBlock.RemoveSfxBlock); + + if Supports(AJclArchive, IJclArchiveCompressHeader, CompressHeader) and Assigned(CompressHeader) then + begin + AddBooleanProperty('HC', CompressHeader.CompressHeader); + if CompressHeader.CompressHeaderFull then + AddBooleanProperty('HCF', CompressHeader.CompressHeaderFull); + end; + + if Supports(AJclArchive, IJclArchiveEncryptHeader, EncryptHeader) and Assigned(EncryptHeader) then + AddBooleanProperty('HE', EncryptHeader.EncryptHeader); + + if Supports(AJclArchive, IJclArchiveSaveCreationDateTime, SaveCreationDateTime) + and Assigned(SaveCreationDateTime) then + AddBooleanProperty('TC', SaveCreationDateTime.SaveCreationDateTime); + + if Supports(AJclArchive, IJclArchiveSaveLastAccessDateTime, SaveLastAccessDateTime) + and Assigned(SaveLastAccessDateTime) then + AddBooleanProperty('TA', SaveLastAccessDateTime.SaveLastAccessDateTime); + + if Supports(AJclArchive, IJclArchiveSaveLastWriteDateTime, SaveLastWriteDateTime) + and Assigned(SaveLastWriteDateTime) then + AddBooleanProperty('TM', SaveLastWriteDateTime.SaveLastWriteDateTime); + + if Supports(AJclArchive, IJclArchiveAlgorithm, Algorithm) and Assigned(Algorithm) then + AddCardinalProperty('A', Algorithm.Algorithm); + + if Supports(AJclArchive, IJclArchiveSolid, Solid) and Assigned(Solid) then + begin + if Solid.SolidExtension then + AddWideStringProperty('S', 'E'); + if Solid.SolidBlockSize > 0 then + AddWideStringProperty('S', IntToStr(Solid.SolidBlockSize) + 'B') + else + AddWideStringProperty('S', IntToStr(Solid.SolidBlockSize) + 'F'); + end; + end; + if Length(PropNames) > 0 then + PropertySetter.SetProperties(@PropNames[0], @PropValues[0], Length(PropNames)); + finally + // Release BSTR strings. VariantPropClear() would do that, but it is only available in Delphi XE3 and newer + for I := 0 to Length(PropValues) - 1 do + if (PropValues[I].vt = VT_BSTR) and (PropValues[I].bstrVal <> nil) then + SysFreeString(PropValues[I].bstrVal); + end; + end; +end; + +function Create7zFile(SourceFiles: TStrings; const DestinationFile: TFileName; VolumeSize: Int64; Password: String; + OnArchiveProgress: TJclCompressionProgressEvent; OnArchiveRatio: TJclCompressionRatioEvent): Boolean; +var + ArchiveFileName: string; + SourceFile : String; + AFormat: TJclUpdateArchiveClass; + Archive : TJclCompressionArchive; + i: Integer; + InnerList : tStringList; + j: Integer; +begin + Result := False; + ArchiveFileName := DestinationFile; + + AFormat := GetArchiveFormats.FindUpdateFormat(ArchiveFileName); + + if AFormat <> nil then + begin + + if VolumeSize <> 0 then + ArchiveFileName := ArchiveFileName + '.%.3d'; + + Archive := AFormat.Create(ArchiveFileName, VolumeSize, VolumeSize <> 0); + try + Archive.Password := Password; + Archive.OnProgress := OnArchiveProgress; + Archive.OnRatio := OnArchiveRatio; + + InnerList := tStringList.Create; + try + for i := 0 to SourceFiles.Count - 1 do + begin + InnerList.Clear; + BuildFileList(SourceFiles[i], faAnyFile, InnerList, True); + for j := 0 to InnerList.Count - 1 do + begin + SourceFile:=InnerList[j]; + (Archive as TJclCompressArchive).AddFile(ExtractFileName(SourceFile), SourceFile); + Result := True; + end; + end; + finally + InnerList.Free; + end; + (Archive as TJclCompressArchive).Compress; + finally + Archive.Free; + end; + end; +end; + +function Create7zFile(const SourceFile, DestinationFile: TFileName; VolumeSize: Int64; Password: String; + OnArchiveProgress: TJclCompressionProgressEvent; OnArchiveRatio: TJclCompressionRatioEvent): Boolean; +var + SourceFiles : TStringList; +begin + SourceFiles := TStringList.Create; + try + SourceFiles.Add(SourceFile); + Result := Create7zFile(SourceFiles, DestinationFile, VolumeSize, Password, OnArchiveProgress, OnArchiveRatio); + finally + SourceFiles.Free; + end; +end; + +function Get7zArchiveSignature(const ClassID: TGUID): TDynByteArray; +var + I, NumberOfFormats: Cardinal; + J: Integer; + PropValue: TPropVariant; + Found: Boolean; + Data: PAnsiChar; +begin + {$IFNDEF COMPILER25_UP} + Found := False; + {$ENDIF ~COMPILER25_UP} + SetLength(Result, 0); + SevenzipCheck(Sevenzip.GetNumberOfFormats(@NumberOfFormats)); + for I := 0 to NumberOfFormats - 1 do + begin + SevenzipCheck(Sevenzip.GetHandlerProperty2(I, kClassID, PropValue)); + if PropValue.vt = VT_BSTR then + begin + try + if SysStringByteLen(PropValue.bstrVal) = SizeOf(TGUID) then + Found := GUIDEquals(PGUID(PropValue.bstrVal)^, ClassID) + else + raise EJclCompressionError.CreateRes(@RsCompressionDataError); + finally + SysFreeString(PropValue.bstrVal); + end; + end + else + raise EJclCompressionError.CreateResFmt(@RsCompression7zUnknownValueType, [PropValue.vt, kClassID]); + + if Found then + begin + SevenzipCheck(Sevenzip.GetHandlerProperty2(I, kStartSignature, PropValue)); + if PropValue.vt = VT_BSTR then + begin + try + SetLength(Result, SysStringByteLen(PropValue.bstrVal)); + Data := PAnsiChar(PropValue.bstrVal); + for J := Low(Result) to High(Result) do + Result[J] := Ord(Data[J]); + finally + SysFreeString(PropValue.bstrVal); + end; + end + else + if PropValue.vt <> VT_EMPTY then + raise EJclCompressionError.CreateResFmt(@RsCompression7zUnknownValueType, [PropValue.vt, kClassID]); + Break; + end; + end; +end; + +//=== { TJclSevenzipOutputCallback } ========================================= + +constructor TJclSevenzipUpdateCallback.Create( + AArchive: TJclCompressionArchive); +begin + inherited Create; + FArchive := AArchive; +end; + +procedure TJclSevenzipUpdateCallback.CryptoGetTextPassword2( + out PasswordIsDefined: LongBool; out Password: TBStr); +begin + PasswordIsDefined := FArchive.Password <> ''; + Password := SysAllocString(PWideChar(FArchive.Password)); +end; + +procedure TJclSevenzipUpdateCallback.GetProperty(Index: Cardinal; PropID: TPropID; + out Value: TPropVariant); +var + AItem: TJclCompressionItem; +begin + AItem := FArchive.Items[Index]; + case PropID of + kpidNoProperty: + Value.vt := VT_NULL; + // kpidMainSubfile: ; + // kpidHandlerItemIndex: ; + kpidPath: + begin + Value.vt := VT_BSTR; + Value.bstrVal := SysAllocString(PWideChar(AItem.PackedName)); + end; + //kpidName: (read only) +{ kpidExtension: + begin + Value.vt := VT_BSTR; + Value.bstrVal := SysAllocString(PWideChar(WideString(ExtractFileExt(FCompressionStream.FileNames[Index])))); + end;} + kpidIsDir: + begin + Value.vt := VT_BOOL; + Value.bool := AItem.Kind = ikDirectory; + end; + kpidSize: + begin + Value.vt := VT_UI8; + Value.uhVal.QuadPart := AItem.FileSize; + end; + // kpidPackSize: ; + kpidAttrib: + begin + Value.vt := VT_UI4; + Value.ulVal := AItem.Attributes; + end; + kpidCTime: + begin + Value.vt := VT_FILETIME; + Value.filetime := AItem.CreationTime; + end; + kpidATime: + begin + Value.vt := VT_FILETIME; + Value.filetime := AItem.LastAccessTime; + end; + kpidMTime: + begin + Value.vt := VT_FILETIME; + Value.filetime := AItem.LastWriteTime; + end; + kpidSolid: + begin + Value.vt := VT_BOOL; + Value.bool := True; + end; + // kpidCommented: ; + // kpidEncrypted: ; + // kpidSplitBefore: ; + // kpidSplitAfter: ; + // kpidDictionarySize: ; + // kpidCRC: ; + // kpidType: ; + kpidIsAnti: + begin + Value.vt := VT_BOOL; + Value.bool := False; + end; + // kpidMethod: ; + // kpidHostOS: ; + // kpidFileSystem: ; + kpidUser: + begin + Value.vt := VT_BSTR; + Value.bstrVal := SysAllocString(PWideChar(AItem.User)); + end; + kpidGroup: + begin + Value.vt := VT_BSTR; + Value.bstrVal := SysAllocString(PWideChar(AItem.Group)); + end; + // kpidBlock: ; + // kpidComment: ; + // kpidPosition: ; + // kpidPrefix: ; + // kpidNumSubDirs: ; + // kpidNumSubFiles: ; + // kpidUnpackVer: ; + // kpidVolume: ; + // kpidIsVolume: ; + // kpidOffset: ; + // kpidLinks: ; + // kpidNumBlocks: ; + // kpidNumVolumes: ; + kpidTimeType: + begin + Value.vt := VT_UI4; + Value.ulVal := kWindows; + end; + // kpidBit64: ; + // kpidBigEndian: ; + // kpidCpu: ; + // kpidPhySize: ; + // kpidHeadersSize: ; + // kpidChecksum: ; + // kpidCharacts: ; + // kpidVa: ; + // kpidId: ; + // kpidShortName: ; + // kpidCreatorApp: ; + // kpidSectorSize: ; + kpidPosixAttrib: + begin + Value.vt := VT_UI4; + Value.ulVal := AItem.PosixAttrib; + end; + kpidLink: + begin + Value.vt := VT_BSTR; + Value.bstrVal := SysAllocString(PWideChar(AItem.Link)); + end; + // kpidTotalSize: ; + // kpidFreeSpace: ; + // kpidClusterSize: ; + // kpidVolumeName: ; + // kpidLocalName: ; + // kpidProvider: ; + // kpidUserDefined: ; + else + Value.vt := VT_EMPTY; + end; +end; + +procedure TJclSevenzipUpdateCallback.GetStream(Index: Cardinal; + out InStream: ISequentialInStream); +begin + FLastStream := Index; + InStream := TJclSevenzipInStream.Create(FArchive, Index); +end; + +procedure TJclSevenzipUpdateCallback.GetUpdateItemInfo(Index: Cardinal; NewData, + NewProperties: PInteger; IndexInArchive: PCardinal); +var + CompressionItem: TJclCompressionItem; +begin + CompressionItem := FArchive.Items[Index]; + + if Assigned(NewData) then + begin + if ([ipFileName, ipStream] * CompressionItem.ModifiedProperties) <> [] then + NewData^ := 1 + else + NewData^ := 0; + end; + + if Assigned(NewProperties) then + begin + if (CompressionItem.ModifiedProperties - [ipFileName, ipStream]) <> [] then + NewProperties^ := 1 + else + NewProperties^ := 0; + end; + + // TODO + if Assigned(IndexInArchive) then + IndexInArchive^ := CompressionItem.PackedIndex; +end; + +function TJclSevenzipUpdateCallback.GetVolumeSize(Index: Cardinal; + out Size: Int64): HRESULT; +begin + // the JCL has its own spliting engine + Size := 0; + Result := S_FALSE; +end; + +procedure TJclSevenzipUpdateCallback.GetVolumeStream(Index: Cardinal; + out VolumeStream: ISequentialOutStream); +{$IFNDEF HAS_ENOTIMPLEMENTED} +var + OSError: EOSError; +{$ENDIF ~HAS_ENOTIMPLEMENTED} +begin + VolumeStream := nil; + {$IFDEF HAS_ENOTIMPLEMENTED} + raise ENotImplemented.Create(''); + {$ELSE} + OSError := EOSError.Create('GetVolumeStream is not implemented'); + OSError.ErrorCode := ERROR_CALL_NOT_IMPLEMENTED; + raise OSError; + {$ENDIF HAS_ENOTIMPLEMENTED} +end; + +procedure TJclSevenzipUpdateCallback.SetCompleted( + CompleteValue: PInt64); +begin + if Assigned(CompleteValue) and not FArchive.DoProgress(CompleteValue^, FArchive.FProgressMax) then + raise EJclCompressionCancelled.CreateRes(@RsCompressionUserAbort); +end; + +procedure TJclSevenzipUpdateCallback.SetOperationResult( + OperationResult: Integer); +begin + case OperationResult of + kOK: + FArchive.Items[FLastStream].OperationSuccess := osOK; + kUnSupportedMethod: + FArchive.Items[FLastStream].OperationSuccess := osUnsupportedMethod; + kDataError: + FArchive.Items[FLastStream].OperationSuccess := osDataError; + kCRCError: + FArchive.Items[FLastStream].OperationSuccess := osCRCError; + else + FArchive.Items[FLastStream].OperationSuccess := osUnknownError; + end; +end; + +procedure TJclSevenzipUpdateCallback.SetRatioInfo(InSize, OutSize: PInt64); +var + AInSize, AOutSize: Int64; +begin + if Assigned(InSize) then + AInSize := InSize^ + else + AInSize := -1; + if Assigned(OutSize) then + AOutSize := OutSize^ + else + AOutSize := -1; + if not FArchive.DoRatio(AInSize, AOutSize) then + raise EJclCompressionCancelled.CreateRes(@RsCompressionUserAbort); +end; + +procedure TJclSevenzipUpdateCallback.SetTotal(Total: Int64); +begin + FArchive.FProgressMax := Total; + if FArchive.CancelCurrentOperation then + raise EJclCompressionCancelled.CreateRes(@RsCompressionUserAbort); +end; + +//=== { TJclSevenzipCompressArchive } ======================================== + +class function TJclSevenzipCompressArchive.ArchiveCLSID: TGUID; +begin + Result := GUID_NULL; +end; + +class function TJclSevenzipCompressArchive.ArchiveSignature: TDynByteArray; +begin + Result := Get7zArchiveSignature(ArchiveCLSID); +end; + +destructor TJclSevenzipCompressArchive.Destroy; +begin + FOutArchive := nil; + inherited Destroy; +end; + +function TJclSevenzipCompressArchive.GetItemClass: TJclCompressionItemClass; +begin + Result := TJclCompressItem; +end; + +function TJclSevenzipCompressArchive.GetOutArchive: IOutArchive; +var + SevenzipCLSID, InterfaceID: TGUID; +begin + if not Assigned(FOutArchive) then + begin + SevenzipCLSID := ArchiveCLSID; + InterfaceID := Sevenzip.IOutArchive; + if (not Is7ZipLoaded) and (not Load7Zip) then + raise EJclCompressionError.CreateRes(@RsCompression7zLoadError); + if (Sevenzip.CreateObject(@SevenzipCLSID, @InterfaceID, FOutArchive) <> ERROR_SUCCESS) + or not Assigned(FOutArchive) then + raise EJclCompressionError.CreateResFmt(@RsCompression7zOutArchiveError, [GUIDToString(SevenzipCLSID)]); + end; + Result := FOutArchive; +end; + +procedure TJclSevenzipCompressArchive.Compress; +var + OutStream: IOutStream; + UpdateCallback: IArchiveUpdateCallback; + SplitStream: TJclDynamicSplitStream; +begin + CheckNotCompressing; + + FCompressing := True; + try + SplitStream := TJclDynamicSplitStream.Create(False); + SplitStream.OnVolume := NeedStream; + SplitStream.OnVolumeMaxSize := NeedStreamMaxSize; + OutStream := TJclSevenzipOutStream.Create(SplitStream, True, False); + UpdateCallback := TJclSevenzipUpdateCallback.Create(Self); + + SetSevenzipArchiveCompressionProperties(Self, OutArchive); + + OutArchive.UpdateItems(OutStream, ItemCount, UpdateCallback); + finally + FCompressing := False; + // release volumes and other finalizations + inherited Compress; + end; +end; + +//=== { TJcl7zCompressArchive } ============================================== + +class function TJcl7zCompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompression7zExtensions); +end; + +class function TJcl7zCompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompression7zName); +end; + +class function TJcl7zCompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormat7z; +end; + +function TJcl7zCompressArchive.GetCompressHeader: Boolean; +begin + Result := FCompressHeader; +end; + +function TJcl7zCompressArchive.GetCompressHeaderFull: Boolean; +begin + Result := FCompressHeaderFull; +end; + +function TJcl7zCompressArchive.GetCompressionLevel: Cardinal; +begin + Result := FCompressionLevel; +end; + +function TJcl7zCompressArchive.GetCompressionLevelMax: Cardinal; +begin + Result := 9; +end; + +function TJcl7zCompressArchive.GetCompressionLevelMin: Cardinal; +begin + Result := 0; +end; + +function TJcl7zCompressArchive.GetDictionarySize: Cardinal; +begin + Result := FDictionarySize; +end; + +function TJcl7zCompressArchive.GetEncryptHeader: Boolean; +begin + Result := FEncryptHeader; +end; + +function TJcl7zCompressArchive.GetNumberOfThreads: Cardinal; +begin + Result := FNumberOfThreads; +end; + +function TJcl7zCompressArchive.GetRemoveSfxBlock: Boolean; +begin + Result := FRemoveSfxBlock; +end; + +function TJcl7zCompressArchive.GetSaveCreationDateTime: Boolean; +begin + Result := FSaveCreationDateTime; +end; + +function TJcl7zCompressArchive.GetSaveLastAccessDateTime: Boolean; +begin + Result := FSaveLastAccessDateTime; +end; + +function TJcl7zCompressArchive.GetSaveLastWriteDateTime: Boolean; +begin + Result := FSaveLastWriteDateTime; +end; + +function TJcl7zCompressArchive.GetSolidBlockSize: Int64; +begin + Result := FSolidBlockSize; +end; + +function TJcl7zCompressArchive.GetSolidExtension: Boolean; +begin + Result := FSolidExtension; +end; + +procedure TJcl7zCompressArchive.InitializeArchiveProperties; +begin + inherited InitializeArchiveProperties; + FNumberOfThreads := 1; + FEncryptHeader := False; + FRemoveSfxBlock := False; + FDictionarySize := kLzmaDicSizeX5; + FCompressionLevel := 6; + FCompressHeader := False; + FCompressHeaderFull := False; + FSaveLastAccessDateTime := True; + FSaveCreationDateTime := True; + FSaveLastWriteDateTime := True; + FSolidBlockSize := High(Cardinal); + FSolidExtension := False; +end; + +class function TJcl7zCompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +procedure TJcl7zCompressArchive.SetCompressHeader(Value: Boolean); +begin + CheckNotCompressing; + FCompressHeader := Value; +end; + +procedure TJcl7zCompressArchive.SetCompressHeaderFull(Value: Boolean); +begin + CheckNotCompressing; + FCompressHeaderFull := Value; +end; + +procedure TJcl7zCompressArchive.SetCompressionLevel(Value: Cardinal); +begin + CheckNotCompressing; + if Value <= 9 then + begin + FCompressionLevel := Value; + if Value >= 9 then + FDictionarySize := kLzmaDicSizeX9 + else + if Value >= 7 then + FDictionarySize := kLzmaDicSizeX7 + else + if Value >= 5 then + FDictionarySize := kLzmaDicSizeX5 + else + if Value >= 3 then + FDictionarySize := kLzmaDicSizeX3 + else + FDictionarySize := kLzmaDicSizeX1; + end + else + raise EJclCompressionError.CreateRes(@RsCompressionUnavailableProperty); +end; + +procedure TJcl7zCompressArchive.SetDictionarySize(Value: Cardinal); +begin + CheckNotCompressing; + FDictionarySize := Value; +end; + +procedure TJcl7zCompressArchive.SetEncryptHeader(Value: Boolean); +begin + CheckNotCompressing; + FEncryptHeader := Value; +end; + +procedure TJcl7zCompressArchive.SetNumberOfThreads(Value: Cardinal); +begin + CheckNotCompressing; + FNumberOfThreads := Value; +end; + +procedure TJcl7zCompressArchive.SetRemoveSfxBlock(Value: Boolean); +begin + CheckNotCompressing; + FRemoveSfxBlock := Value; +end; + +procedure TJcl7zCompressArchive.SetSaveCreationDateTime(Value: Boolean); +begin + CheckNotCompressing; + FSaveCreationDateTime := Value; +end; + +procedure TJcl7zCompressArchive.SetSaveLastAccessDateTime(Value: Boolean); +begin + CheckNotCompressing; + FSaveLastAccessDateTime := Value; +end; + +procedure TJcl7zCompressArchive.SetSaveLastWriteDateTime(Value: Boolean); +begin + CheckNotCompressing; + FSaveLastWriteDateTime := Value; +end; + +procedure TJcl7zCompressArchive.SetSolidBlockSize(const Value: Int64); +begin + CheckNotCompressing; + FSolidBlockSize := Value; +end; + +procedure TJcl7zCompressArchive.SetSolidExtension(Value: Boolean); +begin + CheckNotCompressing; + FSolidExtension := Value; +end; + +//=== { TJclZipCompressArchive } ============================================= + +class function TJclZipCompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionZipExtensions); +end; + +class function TJclZipCompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionZipName); +end; + +class function TJclZipCompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatZip; +end; + +function TJclZipCompressArchive.GetAlgorithm: Cardinal; +begin + Result := FAlgorithm; +end; + +function TJclZipCompressArchive.GetCompressionLevel: Cardinal; +begin + Result := FCompressionLevel; +end; + +function TJclZipCompressArchive.GetCompressionLevelMax: Cardinal; +begin + Result := 9; +end; + +function TJclZipCompressArchive.GetCompressionLevelMin: Cardinal; +begin + Result := 0; +end; + +function TJclZipCompressArchive.GetCompressionMethod: TJclCompressionMethod; +begin + Result := FCompressionMethod; +end; + +function TJclZipCompressArchive.GetDictionarySize: Cardinal; +begin + Result := FDictionarySize; +end; + +function TJclZipCompressArchive.GetEncryptionMethod: TJclEncryptionMethod; +begin + Result := FEncryptionMethod; +end; + +function TJclZipCompressArchive.GetNumberOfPasses: Cardinal; +begin + Result := FNumberOfPasses; +end; + +function TJclZipCompressArchive.GetNumberOfThreads: Cardinal; +begin + Result := FNumberOfThreads; +end; + +function TJclZipCompressArchive.GetSupportedAlgorithms: TDynCardinalArray; +begin + SetLength(Result, 2); + Result[0] := 0; + Result[1] := 1; +end; + +function TJclZipCompressArchive.GetSupportedCompressionMethods: TJclCompressionMethods; +begin + Result := [cmCopy,cmDeflate,cmDeflate64,cmBZip2,cmLZMA,cmPPMd]; +end; + +function TJclZipCompressArchive.GetSupportedEncryptionMethods: TJclEncryptionMethods; +begin + Result := [emNone,emAES128,emAES192,emAES256,emZipCrypto]; +end; + +procedure TJclZipCompressArchive.InitializeArchiveProperties; +begin + inherited InitializeArchiveProperties; + FNumberOfThreads := 1; + FEncryptionMethod := emZipCrypto; + FDictionarySize := kBZip2DicSizeX5; + FCompressionLevel := 7; + FCompressionMethod := cmDeflate; + FNumberOfPasses := kDeflateNumPassesX7; + FAlgorithm := kLzAlgoX5; +end; + +class function TJclZipCompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +procedure TJclZipCompressArchive.SetAlgorithm(Value: Cardinal); +begin + CheckNotCompressing; + if (Value = 0) or (Value = 1) then + FAlgorithm := Value + else + raise EJclCompressionError.CreateRes(@RsCompressionUnavailableProperty); +end; + +procedure TJclZipCompressArchive.SetCompressionLevel(Value: Cardinal); +begin + CheckNotCompressing; + if Value <= 9 then + begin + FCompressionLevel := Value; + case FCompressionMethod of + cmDeflate, cmDeflate64: + begin + if Value >= 9 then + FNumberOfPasses := kDeflateNumPassesX9 + else + if Value >= 7 then + FNumberOfPasses := kDeflateNumPassesX7 + else + FNumberOfPasses := kDeflateNumPassesX1; + if Value >= 5 then + FAlgorithm := kLzAlgoX5 + else + FAlgorithm := kLzAlgoX1; + end; + cmBZip2: + begin + if Value >= 9 then + FNumberOfPasses := kBZip2NumPassesX9 + else + if Value >= 7 then + FNumberOfPasses := kBZip2NumPassesX7 + else + FNumberOfPasses := kBZip2NumPassesX1; + if Value >= 5 then + FDictionarySize := kBZip2DicSizeX5 + else + if Value >= 3 then + FDictionarySize := kBZip2DicSizeX3 + else + FDictionarySize := kBZip2DicSizeX1; + end; + cmLZMA: + begin + if Value >= 9 then + FDictionarySize := kLzmaDicSizeX9 + else + if Value >= 7 then + FDictionarySize := kLzmaDicSizeX7 + else + if Value >= 5 then + FDictionarySize := kLzmaDicSizeX5 + else + if Value >= 3 then + FDictionarySize := kLzmaDicSizeX3 + else + FDictionarySize := kLzmaDicSizeX1; + if Value >= 5 then + FAlgorithm := kLzAlgoX5 + else + FAlgorithm := kLzAlgoX1; + end; + end; + end + else + raise EJclCompressionError.CreateRes(@RsCompressionUnavailableProperty); +end; + +procedure TJclZipCompressArchive.SetCompressionMethod(Value: TJclCompressionMethod); +begin + CheckNotCompressing; + if Value in GetSupportedCompressionMethods then + FCompressionMethod := Value + else + raise EJclCompressionError.CreateRes(@RsCompressionUnavailableProperty); +end; + +procedure TJclZipCompressArchive.SetDictionarySize(Value: Cardinal); +begin + CheckNotCompressing; + FDictionarySize := Value; +end; + +procedure TJclZipCompressArchive.SetEncryptionMethod(Value: TJclEncryptionMethod); +begin + CheckNotCompressing; + if Value in GetSupportedEncryptionMethods then + FEncryptionMethod := Value + else + raise EJclCompressionError.CreateRes(@RsCompressionUnavailableProperty); +end; + +procedure TJclZipCompressArchive.SetNumberOfPasses(Value: Cardinal); +begin + CheckNotCompressing; + FNumberOfPasses := Value; +end; + +procedure TJclZipCompressArchive.SetNumberOfThreads(Value: Cardinal); +begin + CheckNotCompressing; + FNumberOfThreads := Value; +end; + +//=== { TJclBZ2CompressArchive } ============================================= + +class function TJclBZ2CompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionBZip2Extensions); +end; + +class function TJclBZ2CompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionBZip2Name); +end; + +class function TJclBZ2CompressArchive.ArchiveSubExtensions: string; +begin + Result := LoadResString(@RsCompressionBZip2SubExtensions); +end; + +class function TJclBZ2CompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatBZ2; +end; + +function TJclBZ2CompressArchive.GetCompressionLevel: Cardinal; +begin + Result := FCompressionLevel; +end; + +function TJclBZ2CompressArchive.GetCompressionLevelMax: Cardinal; +begin + Result := 9; +end; + +function TJclBZ2CompressArchive.GetCompressionLevelMin: Cardinal; +begin + Result := 0; +end; + +function TJclBZ2CompressArchive.GetDictionarySize: Cardinal; +begin + Result := FDictionarySize; +end; + +function TJclBZ2CompressArchive.GetNumberOfPasses: Cardinal; +begin + Result := FNumberOfPasses; +end; + +function TJclBZ2CompressArchive.GetNumberOfThreads: Cardinal; +begin + Result := FNumberOfThreads; +end; + +procedure TJclBZ2CompressArchive.InitializeArchiveProperties; +begin + inherited InitializeArchiveProperties; + FNumberOfThreads := 1; + FDictionarySize := kBZip2DicSizeX5; + FCompressionLevel := 7; + FNumberOfPasses := kBZip2NumPassesX7; +end; + +procedure TJclBZ2CompressArchive.SetCompressionLevel(Value: Cardinal); +begin + CheckNotCompressing; + if Value <= 9 then + begin + FCompressionLevel := Value; + if Value >= 9 then + FNumberOfPasses := kBZip2NumPassesX9 + else + if Value >= 7 then + FNumberOfPasses := kBZip2NumPassesX7 + else + FNumberOfPasses := kBZip2NumPassesX1; + if Value >= 5 then + FDictionarySize := kBZip2DicSizeX5 + else + if Value >= 3 then + FDictionarySize := kBZip2DicSizeX3 + else + FDictionarySize := kBZip2DicSizeX1; + end + else + raise EJclCompressionError.CreateRes(@RsCompressionUnavailableProperty); +end; + +procedure TJclBZ2CompressArchive.SetDictionarySize(Value: Cardinal); +begin + CheckNotCompressing; + FDictionarySize := Value; +end; + +procedure TJclBZ2CompressArchive.SetNumberOfPasses(Value: Cardinal); +begin + CheckNotCompressing; + FNumberOfPasses := Value; +end; + +procedure TJclBZ2CompressArchive.SetNumberOfThreads(Value: Cardinal); +begin + CheckNotCompressing; + FNumberOfThreads := Value; +end; + +//=== { TJclTarCompressArchive } ============================================= + +class function TJclTarCompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionTarExtensions); +end; + +class function TJclTarCompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionTarName); +end; + +class function TJclTarCompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatTar; +end; + +class function TJclTarCompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclGZipCompressArchive } ============================================ + +class function TJclGZipCompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionGZipExtensions); +end; + +class function TJclGZipCompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionGZipName); +end; + +class function TJclGZipCompressArchive.ArchiveSubExtensions: string; +begin + Result := LoadResString(@RsCompressionGZipSubExtensions); +end; + +class function TJclGZipCompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatGZip; +end; + +function TJclGZipCompressArchive.GetAlgorithm: Cardinal; +begin + Result := FAlgorithm; +end; + +function TJclGZipCompressArchive.GetCompressionLevel: Cardinal; +begin + Result := FCompressionLevel; +end; + +function TJclGZipCompressArchive.GetCompressionLevelMax: Cardinal; +begin + Result := 9; +end; + +function TJclGZipCompressArchive.GetCompressionLevelMin: Cardinal; +begin + Result := 0; +end; + +function TJclGZipCompressArchive.GetNumberOfPasses: Cardinal; +begin + Result := FNumberOfPasses; +end; + +function TJclGZipCompressArchive.GetSupportedAlgorithms: TDynCardinalArray; +begin + SetLength(Result,2); + Result[0] := 0; + Result[1] := 1; +end; + +procedure TJclGZipCompressArchive.InitializeArchiveProperties; +begin + inherited InitializeArchiveProperties; + FCompressionLevel := 7; + FNumberOfPasses := kDeflateNumPassesX7; + FAlgorithm := kLzAlgoX5; +end; + +procedure TJclGZipCompressArchive.SetAlgorithm(Value: Cardinal); +begin + CheckNotCompressing; + FAlgorithm := Value; +end; + +procedure TJclGZipCompressArchive.SetCompressionLevel(Value: Cardinal); +begin + CheckNotCompressing; + if Value <= 9 then + begin + if Value >= 9 then + FNumberOfPasses := kDeflateNumPassesX9 + else + if Value >= 7 then + FNumberOfPasses := kDeflateNumPassesX7 + else + FNumberOfPasses := kDeflateNumPassesX1; + if Value >= 5 then + FAlgorithm := kLzAlgoX5 + else + FAlgorithm := kLzAlgoX1; + end + else + raise EJclCompressionError.CreateRes(@RsCompressionUnavailableProperty); +end; + +procedure TJclGZipCompressArchive.SetNumberOfPasses(Value: Cardinal); +begin + CheckNotCompressing; + FNumberOfPasses := Value; +end; + +//=== { TJclXzCompressArchive } ============================================== + +class function TJclXzCompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionXzExtensions); +end; + +class function TJclXzCompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionXzName); +end; + +class function TJclXzCompressArchive.ArchiveSubExtensions: string; +begin + Result := LoadResString(@RsCompressionXzSubExtensions); +end; + +class function TJclXzCompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatXz; +end; + +function TJclXzCompressArchive.GetCompressionMethod: TJclCompressionMethod; +begin + Result := FCompressionMethod; +end; + +function TJclXzCompressArchive.GetSupportedCompressionMethods: TJclCompressionMethods; +begin + Result := [cmLZMA2]; +end; + +procedure TJclXzCompressArchive.InitializeArchiveProperties; +begin + inherited InitializeArchiveProperties; + FCompressionMethod := cmLZMA2; +end; + +procedure TJclXzCompressArchive.SetCompressionMethod( + Value: TJclCompressionMethod); +begin + CheckNotCompressing; + FCompressionMethod := Value; +end; + +//=== { TJclSwfcCompressArchive } ============================================ + +class function TJclSwfcCompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionSwfcExtensions); +end; + +class function TJclSwfcCompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionSwfcName); +end; + +class function TJclSwfcCompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatSwfc; +end; + +//=== { TJclWimCompressArchive } ============================================= + +class function TJclWimCompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatWim; +end; + +class function TJclWimCompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionWimExtensions); +end; + +class function TJclWimCompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionWimName); +end; + +//=== { TJclSevenzipOpenCallback } =========================================== + +constructor TJclSevenzipOpenCallback.Create( + AArchive: TJclCompressionArchive); +begin + inherited Create; + FArchive := AArchive; +end; + +procedure TJclSevenzipOpenCallback.CryptoGetTextPassword(out Password: TBStr); +begin + if not FArchive.DoGetOpenPassword then + raise EJclCompressionCancelled.CreateRes(@RsCompressionUserAbort); + Password := SysAllocString(PWideChar(FArchive.Password)); +end; + +procedure TJclSevenzipOpenCallback.SetCompleted(Files, Bytes: PInt64); +begin + if Assigned(Files) and not FArchive.DoProgress(Files^, FArchive.FProgressMax) then + raise EJclCompressionCancelled.CreateRes(@RsCompressionUserAbort); +end; + +procedure TJclSevenzipOpenCallback.SetTotal(Files, Bytes: PInt64); +begin + if Assigned(Files) then + FArchive.FProgressMax := Files^; + if FArchive.CancelCurrentOperation then + raise EJclCompressionCancelled.CreateRes(@RsCompressionUserAbort); +end; + +//=== { TJclSevenzipExtractCallback } ======================================== + +constructor TJclSevenzipExtractCallback.Create( + AArchive: TJclCompressionArchive); +begin + inherited Create; + FArchive := AArchive; +end; + +procedure TJclSevenzipExtractCallback.CryptoGetTextPassword(out Password: TBStr); +begin + Password := SysAllocString(PWideChar(FArchive.Password)); +end; + +function TJclSevenzipExtractCallback.GetStream(Index: Cardinal; + out OutStream: ISequentialOutStream; askExtractMode: Cardinal): HRESULT; +begin + try + FLastStream := Index; + + case askExtractMode of + kTest, kSkip: + Result := S_OK; + kExtract: + if FArchive.Items[Index].ValidateExtraction(Index) then + begin + OutStream := TJclSevenzipOutStream.Create(FArchive, Index); + Result := S_OK; + end + else + Result := S_FALSE; + else + Result := E_INVALIDARG; + end; + except + Result := SafeCallException(ExceptObject, ExceptAddr); + end; +end; + +procedure TJclSevenzipExtractCallback.PrepareOperation(askExtractMode: Cardinal); +begin +end; + +procedure TJclSevenzipExtractCallback.SetCompleted(CompleteValue: PInt64); +begin + if Assigned(CompleteValue) and not FArchive.DoProgress(CompleteValue^, FArchive.FProgressMax) then + raise EJclCompressionCancelled.CreateRes(@RsCompressionUserAbort); +end; + +procedure TJclSevenzipExtractCallback.SetOperationResult( + resultEOperationResult: Integer); +var + LastItem: TJclCompressionItem; +begin + LastItem := FArchive.Items[FLastStream]; + case resultEOperationResult of + kOK: + begin + LastItem.OperationSuccess := osOK; + LastItem.UpdateFileTimes; + end; + kUnSupportedMethod: + begin + LastItem.OperationSuccess := osUnsupportedMethod; + LastItem.DeleteOutputFile; + end; + kDataError: + begin + LastItem.OperationSuccess := osDataError; + LastItem.DeleteOutputFile; + end; + kCRCError: + begin + LastItem.OperationSuccess := osCRCError; + LastItem.DeleteOutputFile; + end + else + LastItem.OperationSuccess := osUnknownError; + LastItem.DeleteOutputFile; + end; +end; + +procedure TJclSevenzipExtractCallback.SetRatioInfo(InSize, OutSize: PInt64); +var + AInSize, AOutSize: Int64; +begin + if Assigned(InSize) then + AInSize := InSize^ + else + AInSize := -1; + if Assigned(OutSize) then + AOutSize := OutSize^ + else + AOutSize := -1; + if not FArchive.DoRatio(AInSize, AOutSize) then + raise EJclCompressionCancelled.CreateRes(@RsCompressionUserAbort); +end; + +procedure TJclSevenzipExtractCallback.SetTotal(Total: Int64); +begin + FArchive.FProgressMax := Total; + if FArchive.CancelCurrentOperation then + raise EJclCompressionCancelled.CreateRes(@RsCompressionUserAbort); +end; + +//=== { TJclSevenzipDecompressItem } ========================================= + +function TJclSevenzipDecompressItem.GetNestedArchiveStream: TStream; +var + SequentialInStream: ISequentialInStream; +begin + if Archive.SupportsNestedArchive and (Archive is TJclSevenzipDecompressArchive) then + begin + TJclSevenzipDecompressArchive(Archive).InArchiveGetStream.GetStream(PackedIndex, SequentialInStream); + Result := TJclSevenzipNestedInStream.Create(SequentialInStream as IInStream); + end + else + Result := inherited GetNestedArchiveStream; +end; + +//=== { TJclSevenzipDecompressArchive } ====================================== + +class function TJclSevenzipDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := GUID_NULL; +end; + +class function TJclSevenzipDecompressArchive.ArchiveSignature: TDynByteArray; +begin + Result := Get7zArchiveSignature(ArchiveCLSID); +end; + +destructor TJclSevenzipDecompressArchive.Destroy; +begin + FInArchive := nil; + FInArchiveGetStream := nil; + inherited Destroy; +end; + +procedure TJclSevenzipDecompressArchive.ExtractAll(const ADestinationDir: string; + AAutoCreateSubDir: Boolean); +var + AExtractCallback: IArchiveExtractCallback; + Indices: array of Cardinal; + NbIndices: Cardinal; + Index: Integer; +begin + CheckNotDecompressing; + + FDestinationDir := ADestinationDir; + FAutoCreateSubDir := AAutoCreateSubDir; + + if FDestinationDir <> '' then + FDestinationDir := PathAddSeparator(FDestinationDir); + + FDecompressing := True; + FExtractingAllIndex := 0; + AExtractCallback := TJclSevenzipExtractCallback.Create(Self); + try + OpenArchive; + + // seems buggy: first param "indices" is dereferenced without + // liveness checks inside Sevenzip code + //SevenzipCheck(InArchive.Extract(nil, $FFFFFFFF, 0, AExtractCallback)); + + NbIndices := ItemCount; + SetLength(Indices, NbIndices); + for Index := 0 to NbIndices - 1 do + begin + Items[Index].Selected := True; + Indices[Index] := Index; + end; + InArchive.Extract(@Indices[0], NbIndices, 0, AExtractCallback); + + CheckOperationSuccess; + finally + FDestinationDir := ''; + FDecompressing := False; + FExtractingAllIndex := -1; + FCurrentItemIndex := -1; + AExtractCallback := nil; + // release volumes and other finalizations + inherited ExtractAll(ADestinationDir, AAutoCreateSubDir); + end; +end; + +procedure TJclSevenzipDecompressArchive.ExtractSelected(const ADestinationDir: string; + AAutoCreateSubDir: Boolean); +var + AExtractCallback: IArchiveExtractCallback; + Indices: array of Cardinal; + NbIndices: Cardinal; + Index: Integer; +begin + CheckNotDecompressing; + + FDestinationDir := ADestinationDir; + FAutoCreateSubDir := AAutoCreateSubDir; + + if FDestinationDir <> '' then + FDestinationDir := PathAddSeparator(FDestinationDir); + + FDecompressing := True; + AExtractCallback := TJclSevenzipExtractCallback.Create(Self); + try + OpenArchive; + + NbIndices := 0; + for Index := 0 to ItemCount - 1 do + if Items[Index].Selected then + Inc(NbIndices); + + SetLength(Indices, NbIndices); + NbIndices := 0; + for Index := 0 to ItemCount - 1 do + if Items[Index].Selected then + begin + Indices[NbIndices] := Index; + Inc(NbIndices); + end; + + InArchive.Extract(@Indices[0], Length(Indices), 0, AExtractCallback); + CheckOperationSuccess; + finally + FDestinationDir := ''; + FDecompressing := False; + AExtractCallback := nil; + FCurrentItemIndex := -1; + // release volumes and other finalizations + inherited ExtractSelected(ADestinationDir, AAutoCreateSubDir); + end; +end; + +function TJclSevenzipDecompressArchive.GetInArchive: IInArchive; +var + SevenzipCLSID, InterfaceID: TGUID; +begin + if not Assigned(FInArchive) then + begin + SevenzipCLSID := ArchiveCLSID; + InterfaceID := Sevenzip.IInArchive; + if (not Is7ZipLoaded) and (not Load7Zip) then + raise EJclCompressionError.CreateRes(@RsCompression7zLoadError); + if (Sevenzip.CreateObject(@SevenzipCLSID, @InterfaceID, FInArchive) <> ERROR_SUCCESS) + or not Assigned(FInArchive) then + raise EJclCompressionError.CreateResFmt(@RsCompression7zInArchiveError, [GUIDToString(SevenzipCLSID)]); + FExtractingAllIndex := -1; + end; + Result := FInArchive; +end; + +function TJclSevenzipDecompressArchive.GetInArchiveGetStream: IInArchiveGetStream; +begin + if not Assigned(FInArchiveGetStream) then + FInArchiveGetStream := InArchive as Sevenzip.IInArchiveGetStream; + Result := FInArchiveGetStream; +end; + +function TJclSevenzipDecompressArchive.GetItemClass: TJclCompressionItemClass; +begin + Result := TJclSevenzipDecompressItem; +end; + +function TJclSevenzipDecompressArchive.GetSupportsNestedArchive: Boolean; +begin + Result := Assigned(FInArchiveGetStream) or + Supports(InArchive, Sevenzip.IInArchiveGetStream, FInArchiveGetStream) +end; + +procedure TJclSevenzipDecompressArchive.ListFiles; +var + NumberOfItems: Cardinal; + Index: Integer; + AItem: TJclCompressionItem; +begin + CheckNotDecompressing; + + FListing := True; + try + ClearItems; + OpenArchive; + + InArchive.GetNumberOfItems(NumberOfItems); + if NumberOfItems > 0 then + begin + for Index := 0 to NumberOfItems - 1 do + begin + AItem := GetItemClass.Create(Self); + Load7zFileAttribute(InArchive, Index, AItem); + FItems.Add(AItem); + end; + end; + finally + FListing := False; + end; +end; + +procedure TJclSevenzipDecompressArchive.OpenArchive; +var + SplitStream: TJclDynamicSplitStream; + OpenCallback: IArchiveOpenCallback; + MaxCheckStartPosition: Int64; + AInStream: IInStream; +begin + if not FOpened then + begin + if (VolumeFileNameMask <> '') or (VolumeMaxSize <> 0) or (FVolumes.Count <> 0) then + begin + SplitStream := TJclDynamicSplitStream.Create(False); + SplitStream.OnVolume := NeedStream; + SplitStream.OnVolumeMaxSize := NeedStreamMaxSize; + AInStream := TJclSevenzipInStream.Create(SplitStream, True); + end + else + AInStream := TJclSevenzipInStream.Create(NeedStream(0), False); + OpenCallback := TJclSevenzipOpenCallback.Create(Self); + + SetSevenzipArchiveCompressionProperties(Self, InArchive); + + MaxCheckStartPosition := 1 shl 22; + SevenZipCheck(InArchive.Open(AInStream, @MaxCheckStartPosition, OpenCallback)); + + GetSevenzipArchiveCompressionProperties(Self, InArchive); + + FOpened := True; + end; +end; + +//=== { TJclZipDecompressArchive } =========================================== + +class function TJclZipDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionZipExtensions); +end; + +class function TJclZipDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionZipName); +end; + +class function TJclZipDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatZip; +end; + +function TJclZipDecompressArchive.GetNumberOfThreads: Cardinal; +begin + Result := FNumberOfThreads; +end; + +procedure TJclZipDecompressArchive.InitializeArchiveProperties; +begin + inherited InitializeArchiveProperties; + FNumberOfThreads := 1; +end; + +class function TJclZipDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +procedure TJclZipDecompressArchive.SetNumberOfThreads(Value: Cardinal); +begin + CheckNotDecompressing; + FNumberOfThreads := Value; +end; + +//=== { TJclBZ2DecompressArchive } =========================================== + +class function TJclBZ2DecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionBZip2Extensions); +end; + +class function TJclBZ2DecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionBZip2Name); +end; + +class function TJclBZ2DecompressArchive.ArchiveSubExtensions: string; +begin + Result := LoadResString(@RsCompressionBZip2SubExtensions); +end; + +class function TJclBZ2DecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatBZ2; +end; + +function TJclBZ2DecompressArchive.GetNumberOfThreads: Cardinal; +begin + Result := FNumberOfThreads; +end; + +procedure TJclBZ2DecompressArchive.InitializeArchiveProperties; +begin + inherited InitializeArchiveProperties; + FNumberOfThreads := 1; +end; + +procedure TJclBZ2DecompressArchive.SetNumberOfThreads(Value: Cardinal); +begin + CheckNotDecompressing; + FNumberOfThreads := Value; +end; + +//=== { TJclRarDecompressArchive } =========================================== + +class function TJclRarDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionRarExtensions); +end; + +class function TJclRarDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionRarName); +end; + +class function TJclRarDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatRar; +end; + +class function TJclRarDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclArjDecompressArchive } =========================================== + +class function TJclArjDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionArjExtensions); +end; + +class function TJclArjDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionArjName); +end; + +class function TJclArjDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatArj; +end; + +class function TJclArjDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclZDecompressArchive } ============================================= + +class function TJclZDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionZExtensions); +end; + +class function TJclZDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionZName); +end; + +class function TJclZDecompressArchive.ArchiveSubExtensions: string; +begin + Result := LoadResString(@RsCompressionZSubExtensions); +end; + +class function TJclZDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatZ; +end; + +class function TJclZDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclLzhDecompressArchive } =========================================== + +class function TJclLzhDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionLzhExtensions); +end; + +class function TJclLzhDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionLzhName); +end; + +class function TJclLzhDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatLzh; +end; + +class function TJclLzhDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJcl7zDecompressArchive } ============================================ + +class function TJcl7zDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompression7zExtensions); +end; + +class function TJcl7zDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompression7zName); +end; + +class function TJcl7zDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormat7z; +end; + +function TJcl7zDecompressArchive.GetNumberOfThreads: Cardinal; +begin + Result := FNumberOfThreads; +end; + +procedure TJcl7zDecompressArchive.InitializeArchiveProperties; +begin + inherited InitializeArchiveProperties; + FNumberOfThreads := 1; +end; + +class function TJcl7zDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +procedure TJcl7zDecompressArchive.SetNumberOfThreads(Value: Cardinal); +begin + CheckNotDecompressing; + FNumberOfThreads := Value; +end; + +//=== { TJclCabDecompressArchive } =========================================== + +class function TJclCabDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionCabExtensions); +end; + +class function TJclCabDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionCabName); +end; + +class function TJclCabDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatCab; +end; + +class function TJclCabDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclNsisDecompressArchive } ========================================== + +class function TJclNsisDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionNsisExtensions); +end; + +class function TJclNsisDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionNsisName); +end; + +class function TJclNsisDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatNsis; +end; + +class function TJclNsisDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclLzmaDecompressArchive } ========================================== + +class function TJclLzmaDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionLzmaExtensions); +end; + +class function TJclLzmaDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionLzmaName); +end; + +class function TJclLzmaDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatLzma; +end; + +class function TJclLzmaDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := False; +end; + +//=== { TJclLzma86DecompressArchive } ======================================== + +class function TJclLzma86DecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionLzma86Extensions); +end; + +class function TJclLzma86DecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionLzma86Name); +end; + +class function TJclLzma86DecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatLzma86; +end; + +class function TJclLzma86DecompressArchive.MultipleItemContainer: Boolean; +begin + Result := False; +end; + +//=== { TJclPeDecompressArchive } ============================================ + +class function TJclPeDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionPeExtensions); +end; + +class function TJclPeDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionPeName); +end; + +class function TJclPeDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatPe; +end; + +class function TJclPeDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclElfDecompressArchive } =========================================== + +class function TJclElfDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionElfExtensions); +end; + +class function TJclElfDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionElfName); +end; + +class function TJclElfDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatElf; +end; + +class function TJclElfDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclMachoDecompressArchive } ========================================= + +class function TJclMachoDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionMachoExtensions); +end; + +class function TJclMachoDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionMachoName); +end; + +class function TJclMachoDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatMacho; +end; + +class function TJclMachoDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclUdfDecompressArchive } ========================================== + +class function TJclUdfDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionUdfExtensions); +end; + +class function TJclUdfDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionUdfName); +end; + +class function TJclUdfDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatUdf; +end; + +class function TJclUdfDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclXarDecompressArchive } =========================================== + +class function TJclXarDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionXarExtensions); +end; + +class function TJclXarDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionXarName); +end; + +class function TJclXarDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatXar; +end; + +class function TJclXarDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclMubDecompressArchive } =========================================== + +class function TJclMubDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionMubExtensions); +end; + +class function TJclMubDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionMubName); +end; + +class function TJclMubDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatMub; +end; + +class function TJclMubDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclHfsDecompressArchive } =========================================== + +class function TJclHfsDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionHfsExtensions); +end; + +class function TJclHfsDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionHfsName); +end; + +class function TJclHfsDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatHfs; +end; + +class function TJclHfsDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclDmgDecompressArchive } =========================================== + +class function TJclDmgDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionDmgExtensions); +end; + +class function TJclDmgDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionDmgName); +end; + +class function TJclDmgDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatDmg; +end; + +class function TJclDmgDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclCompoundDecompressArchive } ====================================== + +class function TJclCompoundDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionCompoundExtensions); +end; + +class function TJclCompoundDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionCompoundName); +end; + +class function TJclCompoundDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatCompound; +end; + +class function TJclCompoundDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclWimDecompressArchive } =========================================== + +class function TJclWimDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionWimExtensions); +end; + +class function TJclWimDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionWimName); +end; + +class function TJclWimDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatWim; +end; + +class function TJclWimDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclIsoDecompressArchive } =========================================== + +class function TJclIsoDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionIsoExtensions); +end; + +class function TJclIsoDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionIsoName); +end; + +class function TJclIsoDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatIso; +end; + +class function TJclIsoDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclChmDecompressArchive } =========================================== + +class function TJclChmDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionChmExtensions); +end; + +class function TJclChmDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionChmName); +end; + +class function TJclChmDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatChm; +end; + +class function TJclChmDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclSplitDecompressArchive } ========================================= + +class function TJclSplitDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionSplitExtensions); +end; + +class function TJclSplitDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionSplitName); +end; + +class function TJclSplitDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatSplit; +end; + +//=== { TJclRpmDecompressArchive } =========================================== + +class function TJclRpmDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionRpmExtensions); +end; + +class function TJclRpmDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionRpmName); +end; + +class function TJclRpmDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatRpm; +end; + +class function TJclRpmDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclDebDecompressArchive } =========================================== + +class function TJclDebDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionDebExtensions); +end; + +class function TJclDebDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionDebName); +end; + +class function TJclDebDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatDeb; +end; + +class function TJclDebDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclCpioDecompressArchive } ========================================== + +class function TJclCpioDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionCpioExtensions); +end; + +class function TJclCpioDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionCpioName); +end; + +class function TJclCpioDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatCpio; +end; + +class function TJclCpioDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclTarDecompressArchive } =========================================== + +class function TJclTarDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionTarExtensions); +end; + +class function TJclTarDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionTarName); +end; + +class function TJclTarDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatTar; +end; + +class function TJclTarDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclGZipDecompressArchive } ========================================== + +class function TJclGZipDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionGZipExtensions); +end; + +class function TJclGZipDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionGZipName); +end; + +class function TJclGZipDecompressArchive.ArchiveSubExtensions: string; +begin + Result := LoadResString(@RsCompressionGZipSubExtensions); +end; + +class function TJclGZipDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatGZip; +end; + +//=== { TJclXzDecompressArchive } ============================================ + +class function TJclXzDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionXzExtensions); +end; + +class function TJclXzDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionXzName); +end; + +class function TJclXzDecompressArchive.ArchiveSubExtensions: string; +begin + Result := LoadResString(@RsCompressionXzSubExtensions); +end; + +class function TJclXzDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatXz; +end; + +//=== { TJclNtfsDecompressArchive } ========================================== + +class function TJclNtfsDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionNtfsExtensions); +end; + +class function TJclNtfsDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionNtfsName); +end; + +class function TJclNtfsDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatNtfs; +end; + +class function TJclNtfsDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclFatDecompressArchive } =========================================== + +class function TJclFatDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionFatExtensions); +end; + +class function TJclFatDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionFatName); +end; + +class function TJclFatDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatFat; +end; + +class function TJclFatDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclMbrDecompressArchive } =========================================== + +class function TJclMbrDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionMbrExtensions); +end; + +class function TJclMbrDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionMbrName); +end; + +class function TJclMbrDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatMbr; +end; + +class function TJclMbrDecompressArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclVhdDecompressArchive } =========================================== + +class function TJclVhdDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionVhdExtensions); +end; + +class function TJclVhdDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionVhdName); +end; + +class function TJclVhdDecompressArchive.ArchiveSubExtensions: string; +begin + Result := LoadResString(@RsCompressionVhdSubExtensions); +end; + +class function TJclVhdDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatVhd; +end; + +//=== { TJclMslzDecompressArchive } ========================================== + +class function TJclMslzDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionMslzExtensions); +end; + +class function TJclMslzDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionMslzName); +end; + +class function TJclMslzDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatMslz; +end; + +//=== { TJclFlvDecompressArchive } =========================================== + +class function TJclFlvDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionFlvExtensions); +end; + +class function TJclFlvDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionFlvName); +end; + +class function TJclFlvDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatFlv; +end; + +//=== { TJclSwfDecompressArchive } =========================================== + +class function TJclSwfDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionSwfExtensions); +end; + +class function TJclSwfDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionSwfName); +end; + +class function TJclSwfDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatSwf; +end; + +//=== { TJclSwfcDecompressArchive } ========================================== + +class function TJclSwfcDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionSwfcExtensions); +end; + +class function TJclSwfcDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionSwfcName); +end; + +class function TJclSwfcDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatSwfc; +end; + +//=== { TJclAPMDecompressArchive } =========================================== + +class function TJclAPMDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionApmExtensions); +end; + +class function TJclAPMDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionApmName); +end; + +class function TJclAPMDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatAPM; +end; + +//=== { TJclPpmdDecompressArchive } ========================================== + +class function TJclPpmdDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionPpmdExtensions); +end; + +class function TJclPpmdDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionPpmdName); +end; + +class function TJclPpmdDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatPpmd; +end; + +//=== { TJclTEDecompressArchive } ============================================ + +class function TJclTEDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionTEExtensions); +end; + +class function TJclTEDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionTEName); +end; + +class function TJclTEDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatTE; +end; + +//=== { TJclUEFIcDecompressArchive } ========================================= + +class function TJclUEFIcDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionUEFIcExtensions); +end; + +class function TJclUEFIcDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionUEFIcName); +end; + +class function TJclUEFIcDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatUEFIc; +end; + +//=== { TJclUEFIsDecompressArchive } ========================================= + +class function TJclUEFIsDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionUEFIsExtensions); +end; + +class function TJclUEFIsDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionUEFIsName); +end; + +class function TJclUEFIsDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatUEFIs; +end; + +//=== { TJclSquashFSDecompressArchive } ====================================== + +class function TJclSquashFSDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionSquashFSExtensions); +end; + +class function TJclSquashFSDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionSquashFSName); +end; + +class function TJclSquashFSDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatSquashFS; +end; + +//=== { TJclCramFSDecompressArchive } ======================================== + +class function TJclCramFSDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionCramFSExtensions); +end; + +class function TJclCramFSDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionCramFSName); +end; + +class function TJclCramFSDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatCramFS; +end; + +//=== { TJclExtDecompressArchive } =========================================== + +class function TJclExtDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatExt; +end; + +class function TJclExtDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionExtExtensions); +end; + +class function TJclExtDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionExtName); +end; + +//=== { TJclVMDKDecompressArchive } ========================================== + +class function TJclVMDKDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatVMDK; +end; + +class function TJclVMDKDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionVMDKExtensions); +end; + +class function TJclVMDKDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionVMDKName); +end; + +//=== { TJclVDIDecompressArchive } =========================================== + +class function TJclVDIDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatVDI; +end; + +class function TJclVDIDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionVDIExtensions); +end; + +class function TJclVDIDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionVDIName); +end; + +//=== { TJclQcowDecompressArchive } ========================================== + +class function TJclQcowDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatQcow; +end; + +class function TJclQcowDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionQcowExtensions); +end; + +class function TJclQcowDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionQcowName); +end; + +//=== { TJclGPTDecompressArchive } =========================================== + +class function TJclGPTDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatGPT; +end; + +class function TJclGPTDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionGPTExtensions); +end; + +class function TJclGPTDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionGPTName); +end; + +//=== { TJclRar5DecompressArchive } ========================================== + +class function TJclRar5DecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatRar5; +end; + +class function TJclRar5DecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionRar5Extensions); +end; + +class function TJclRar5DecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionRar5Name); +end; + +//=== { TJclIHexDecompressArchive } ========================================== + +class function TJclIHexDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatIHex; +end; + +class function TJclIHexDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionIHexExtensions); +end; + +class function TJclIHexDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionIHexName); +end; + +//=== { TJclHxsDecompressArchive } =========================================== + +class function TJclHxsDecompressArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatHxs; +end; + +class function TJclHxsDecompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionHxsExtensions); +end; + +class function TJclHxsDecompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionHxsName); +end; + +//=== { TJclSevenzipUpdateArchive } ========================================== + +class function TJclSevenzipUpdateArchive.ArchiveCLSID: TGUID; +begin + Result := GUID_NULL; +end; + +destructor TJclSevenzipUpdateArchive.Destroy; +begin + FInArchive := nil; + FOutArchive := nil; + inherited Destroy; +end; + +class function TJclSevenzipUpdateArchive.ArchiveSignature: TDynByteArray; +begin + Result := Get7zArchiveSignature(ArchiveCLSID); +end; + +procedure TJclSevenzipUpdateArchive.Compress; +var + OutStream: IOutStream; + UpdateCallback: IArchiveUpdateCallback; + SplitStream: TJclDynamicSplitStream; + Index: Integer; + Volume: TJclCompressionVolume; +begin + CheckNotCompressing; + CheckNotDecompressing; + + FCompressing := True; + try + SplitStream := TJclDynamicSplitStream.Create(True); + SplitStream.OnVolume := NeedTmpStream; + SplitStream.OnVolumeMaxSize := NeedStreamMaxSize; + OutStream := TJclSevenzipOutStream.Create(SplitStream, True, True); + UpdateCallback := TJclSevenzipUpdateCallback.Create(Self); + + SetSevenzipArchiveCompressionProperties(Self, OutArchive); + + ReplaceVolumes := True; + try + OutArchive.UpdateItems(OutStream, ItemCount, UpdateCallback); + except + ReplaceVolumes := False; + // release reference to volume streams + OutStream := nil; + // Modifying the archive failed; reset volumes to their original state + for Index := 0 to FVolumes.Count - 1 do + begin + Volume := TJclCompressionVolume(FVolumes.Items[Index]); + Assert(Volume.OwnsTmpStream); + FreeAndNil(Volume.FTmpStream); + FileDelete(Volume.TmpFileName); + Volume.FTmpFileName := ''; + end; + raise + end; + finally + FCompressing := False; + // release reference to volume streams + OutStream := nil; + // replace streams by tmp streams + inherited Compress; + end; +end; + +procedure TJclSevenzipUpdateArchive.DeleteItem(Index: Integer); +var + I, BaseLength: Integer; + IsDirectory: Boolean; + AItem: TJclCompressionItem; + DirectoryName: WideString; +begin + AItem := Items[Index]; + IsDirectory := (AItem.Attributes and faDirectory) <> 0; + DirectoryName := AItem.PackedName + DirDelimiter; + + FItems.Delete(Index); + + if IsDirectory then + begin + BaseLength := Length(DirectoryName); + + for I := ItemCount - 1 downto 0 do + if WideSameText(DirectoryName, Copy(Items[I].PackedName, 1, BaseLength)) then + FItems.Delete(I); + end; +end; + +procedure TJclSevenzipUpdateArchive.ExtractAll(const ADestinationDir: string; + AAutoCreateSubDir: Boolean); +var + AExtractCallback: IArchiveExtractCallback; + Indices: array of Cardinal; + NbIndices: Cardinal; + Index: Integer; +begin + CheckNotDecompressing; + CheckNotCompressing; + + FDestinationDir := ADestinationDir; + FAutoCreateSubDir := AAutoCreateSubDir; + + if FDestinationDir <> '' then + FDestinationDir := PathAddSeparator(FDestinationDir); + + FDecompressing := True; + FExtractingAllIndex := 0; + AExtractCallback := TJclSevenzipExtractCallback.Create(Self); + try + OpenArchive; + + // seems buggy: first param "indices" is dereferenced without + // liveness checks inside Sevenzip code + //SevenzipCheck(InArchive.Extract(nil, $FFFFFFFF, 0, AExtractCallback)); + + NbIndices := ItemCount; + SetLength(Indices, NbIndices); + for Index := 0 to NbIndices - 1 do + begin + Items[Index].Selected := True; + Indices[Index] := Index; + end; + InArchive.Extract(@Indices[0], NbIndices, 0, AExtractCallback); + + CheckOperationSuccess; + finally + FDestinationDir := ''; + FDecompressing := False; + FExtractingAllIndex := -1; + FCurrentItemIndex := -1; + AExtractCallback := nil; + // release volumes and other finalizations + inherited ExtractAll(ADestinationDir, AAutoCreateSubDir); + end; +end; + +procedure TJclSevenzipUpdateArchive.ExtractSelected( + const ADestinationDir: string; AAutoCreateSubDir: Boolean); +var + AExtractCallback: IArchiveExtractCallback; + Indices: array of Cardinal; + NbIndices: Cardinal; + Index: Integer; +begin + CheckNotDecompressing; + CheckNotCompressing; + + FDestinationDir := ADestinationDir; + FAutoCreateSubDir := AAutoCreateSubDir; + + if FDestinationDir <> '' then + FDestinationDir := PathAddSeparator(FDestinationDir); + + FDecompressing := True; + AExtractCallback := TJclSevenzipExtractCallback.Create(Self); + try + OpenArchive; + + NbIndices := 0; + for Index := 0 to ItemCount - 1 do + if Items[Index].Selected then + Inc(NbIndices); + + SetLength(Indices, NbIndices); + NbIndices := 0; + for Index := 0 to ItemCount - 1 do + if Items[Index].Selected then + begin + Indices[NbIndices] := Index; + Inc(NbIndices); + end; + + InArchive.Extract(@Indices[0], Length(Indices), 0, AExtractCallback); + CheckOperationSuccess; + finally + FDestinationDir := ''; + FDecompressing := False; + AExtractCallback := nil; + FCurrentItemIndex := -1; + // release volumes and other finalizations + inherited ExtractSelected(ADestinationDir, AAutoCreateSubDir); + end; +end; + +function TJclSevenzipUpdateArchive.GetInArchive: IInArchive; +var + SevenzipCLSID, InterfaceID: TGUID; +begin + if not Assigned(FInArchive) then + begin + SevenzipCLSID := ArchiveCLSID; + InterfaceID := Sevenzip.IInArchive; + if (not Is7ZipLoaded) and (not Load7Zip) then + raise EJclCompressionError.CreateRes(@RsCompression7zLoadError); + if (Sevenzip.CreateObject(@SevenzipCLSID, @InterfaceID, FInArchive) <> ERROR_SUCCESS) + or not Assigned(FInArchive) then + raise EJclCompressionError.CreateResFmt(@RsCompression7zInArchiveError, [GUIDToString(SevenzipCLSID)]); + end; + Result := FInArchive; +end; + +function TJclSevenzipUpdateArchive.GetItemClass: TJclCompressionItemClass; +begin + Result := TJclUpdateItem; +end; + +function TJclSevenzipUpdateArchive.GetOutArchive: IOutArchive; +var + SevenzipCLSID, InterfaceID: TGUID; +begin + if not Assigned(FOutarchive) then + begin + SevenzipCLSID := ArchiveCLSID; + InterfaceID := Sevenzip.IOutArchive; + if not Supports(InArchive, InterfaceID, FOutArchive) + or not Assigned(FOutArchive) then + raise EJclCompressionError.CreateResFmt(@RsCompression7zOutArchiveError, [GUIDToString(SevenzipCLSID)]); + end; + Result := FOutArchive; +end; + +procedure TJclSevenzipUpdateArchive.ListFiles; +var + NumberOfItems: Cardinal; + Index: Integer; + AItem: TJclCompressionItem; +begin + CheckNotDecompressing; + CheckNotCompressing; + + FListing := True; + try + ClearItems; + OpenArchive; + + InArchive.GetNumberOfItems(NumberOfItems); + if NumberOfItems > 0 then + begin + for Index := 0 to NumberOfItems - 1 do + begin + AItem := GetItemClass.Create(Self); + Load7zFileAttribute(InArchive, Index, AItem); + FItems.Add(AItem); + end; + end; + finally + FListing := False; + end; +end; + +procedure TJclSevenzipUpdateArchive.OpenArchive; +var + OpenCallback: IArchiveOpenCallback; + MaxCheckStartPosition: Int64; + AInStream: IInStream; + SplitStream: TJclDynamicSplitStream; +begin + if not FOpened then + begin + SplitStream := TJclDynamicSplitStream.Create(True); + SplitStream.OnVolume := NeedStream; + SplitStream.OnVolumeMaxSize := NeedStreamMaxSize; + + AInStream := TJclSevenzipInStream.Create(SplitStream, True); + OpenCallback := TJclSevenzipOpenCallback.Create(Self); + + SetSevenzipArchiveCompressionProperties(Self, InArchive); + + MaxCheckStartPosition := 1 shl 22; + SevenZipCheck(InArchive.Open(AInStream, @MaxCheckStartPosition, OpenCallback)); + + GetSevenzipArchiveCompressionProperties(Self, InArchive); + + FOpened := True; + end; +end; + +procedure TJclSevenzipUpdateArchive.RemoveItem(const PackedName: WideString); +var + Index, BaseLength, PackedNamesIndex: Integer; + IsDirectory: Boolean; + AItem: TJclCompressionItem; + DirectoryName: WideString; +begin + IsDirectory := False; + for Index := 0 to ItemCount - 1 do + begin + AItem := Items[Index]; + if WideSameText(AItem.PackedName, PackedName) then + begin + DirectoryName := AItem.PackedName; + if (AItem.Attributes and faDirectory) <> 0 then + IsDirectory := True; + FItems.Delete(Index); + PackedNamesIndex := -1; + if (FPackedNames <> nil) and FPackedNames.Find(PackedName, PackedNamesIndex) then + FPackedNames.Delete(PackedNamesIndex); + Break; + end; + end; + + if IsDirectory then + begin + DirectoryName := PackedName + DirDelimiter; + BaseLength := Length(DirectoryName); + + for Index := ItemCount - 1 downto 0 do + if WideSameText(DirectoryName, Copy(Items[Index].PackedName, 1, BaseLength)) then + begin + if (FPackedNames <> nil) and FPackedNames.Find(Items[Index].PackedName, PackedNamesIndex) then + FPackedNames.Delete(PackedNamesIndex); + FItems.Delete(Index); + end; + end; +end; + +//=== { TJclZipUpdateArchive } =============================================== + +class function TJclZipUpdateArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionZipExtensions); +end; + +class function TJclZipUpdateArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionZipName); +end; + +class function TJclZipUpdateArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatZip; +end; + +function TJclZipUpdateArchive.GetAlgorithm: Cardinal; +begin + Result := FAlgorithm; +end; + +function TJclZipUpdateArchive.GetCompressionLevel: Cardinal; +begin + Result := FCompressionLevel; +end; + +function TJclZipUpdateArchive.GetCompressionLevelMax: Cardinal; +begin + Result := 9; +end; + +function TJclZipUpdateArchive.GetCompressionLevelMin: Cardinal; +begin + Result := 0; +end; + +function TJclZipUpdateArchive.GetCompressionMethod: TJclCompressionMethod; +begin + Result := FCompressionMethod; +end; + +function TJclZipUpdateArchive.GetDictionarySize: Cardinal; +begin + Result := FDictionarySize; +end; + +function TJclZipUpdateArchive.GetEncryptionMethod: TJclEncryptionMethod; +begin + Result := FEncryptionMethod; +end; + +function TJclZipUpdateArchive.GetNumberOfPasses: Cardinal; +begin + Result := FNumberOfPasses; +end; + +function TJclZipUpdateArchive.GetNumberOfThreads: Cardinal; +begin + Result := FNumberOfThreads; +end; + +function TJclZipUpdateArchive.GetSupportedAlgorithms: TDynCardinalArray; +begin + SetLength(Result,2); + Result[0] := 0; + Result[1] := 1; +end; + +function TJclZipUpdateArchive.GetSupportedCompressionMethods: TJclCompressionMethods; +begin + Result := [cmCopy,cmDeflate,cmDeflate64,cmBZip2,cmLZMA,cmPPMd]; +end; + +function TJclZipUpdateArchive.GetSupportedEncryptionMethods: TJclEncryptionMethods; +begin + Result := [emNone,emAES128,emAES192,emAES256,emZipCrypto]; +end; + +procedure TJclZipUpdateArchive.InitializeArchiveProperties; +begin + inherited InitializeArchiveProperties; + FNumberOfThreads := 1; + FEncryptionMethod := emZipCrypto; + FDictionarySize := kBZip2DicSizeX5; + FCompressionLevel := 7; + FCompressionMethod := cmDeflate; + FNumberOfPasses := kDeflateNumPassesX7; + FAlgorithm := kLzAlgoX5; +end; + +class function TJclZipUpdateArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +procedure TJclZipUpdateArchive.SetAlgorithm(Value: Cardinal); +begin + CheckNotCompressing; + CheckNotDecompressing; + if (Value = 0) or (Value = 1) then + FAlgorithm := Value + else + raise EJclCompressionError.CreateRes(@RsCompressionUnavailableProperty); +end; + +procedure TJclZipUpdateArchive.SetCompressionLevel(Value: Cardinal); +begin + CheckNotCompressing; + CheckNotDecompressing; + if Value <= 9 then + begin + FCompressionLevel := Value; + case FCompressionMethod of + cmDeflate, cmDeflate64: + begin + if Value >= 9 then + FNumberOfPasses := kDeflateNumPassesX9 + else + if Value >= 7 then + FNumberOfPasses := kDeflateNumPassesX7 + else + FNumberOfPasses := kDeflateNumPassesX1; + if Value >= 5 then + FAlgorithm := kLzAlgoX5 + else + FAlgorithm := kLzAlgoX1; + end; + cmBZip2: + begin + if Value >= 9 then + FNumberOfPasses := kBZip2NumPassesX9 + else + if Value >= 7 then + FNumberOfPasses := kBZip2NumPassesX7 + else + FNumberOfPasses := kBZip2NumPassesX1; + if Value >= 5 then + FDictionarySize := kBZip2DicSizeX5 + else + if Value >= 3 then + FDictionarySize := kBZip2DicSizeX3 + else + FDictionarySize := kBZip2DicSizeX1; + end; + cmLZMA: + begin + if Value >= 9 then + FDictionarySize := kLzmaDicSizeX9 + else + if Value >= 7 then + FDictionarySize := kLzmaDicSizeX7 + else + if Value >= 5 then + FDictionarySize := kLzmaDicSizeX5 + else + if Value >= 3 then + FDictionarySize := kLzmaDicSizeX3 + else + FDictionarySize := kLzmaDicSizeX1; + if Value >= 5 then + FAlgorithm := kLzAlgoX5 + else + FAlgorithm := kLzAlgoX1; + end; + end; + end + else + raise EJclCompressionError.CreateRes(@RsCompressionUnavailableProperty); +end; + +procedure TJclZipUpdateArchive.SetCompressionMethod(Value: TJclCompressionMethod); +begin + CheckNotCompressing; + CheckNotDecompressing; + if Value in GetSupportedCompressionMethods then + FCompressionMethod := Value + else + raise EJclCompressionError.CreateRes(@RsCompressionUnavailableProperty); +end; + +procedure TJclZipUpdateArchive.SetDictionarySize(Value: Cardinal); +begin + CheckNotCompressing; + CheckNotDecompressing; + FDictionarySize := Value; +end; + +procedure TJclZipUpdateArchive.SetEncryptionMethod(Value: TJclEncryptionMethod); +begin + CheckNotCompressing; + CheckNotDecompressing; + if Value in GetSupportedEncryptionMethods then + FEncryptionMethod := Value + else + raise EJclCompressionError.CreateRes(@RsCompressionUnavailableProperty); +end; + +procedure TJclZipUpdateArchive.SetNumberOfPasses(Value: Cardinal); +begin + CheckNotCompressing; + CheckNotDecompressing; + FNumberOfPasses := Value; +end; + +procedure TJclZipUpdateArchive.SetNumberOfThreads(Value: Cardinal); +begin + CheckNotCompressing; + CheckNotDecompressing; + FNumberOfThreads := Value; +end; + +//=== { TJclBZ2UpdateArchive } =============================================== + +class function TJclBZ2UpdateArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionBZip2Extensions); +end; + +class function TJclBZ2UpdateArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionBZip2Name); +end; + +class function TJclBZ2UpdateArchive.ArchiveSubExtensions: string; +begin + Result := LoadResString(@RsCompressionBZip2SubExtensions); +end; + +class function TJclBZ2UpdateArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatBZ2; +end; + +function TJclBZ2UpdateArchive.GetCompressionLevel: Cardinal; +begin + Result := FCompressionLevel; +end; + +function TJclBZ2UpdateArchive.GetCompressionLevelMax: Cardinal; +begin + Result := 9; +end; + +function TJclBZ2UpdateArchive.GetCompressionLevelMin: Cardinal; +begin + Result := 0; +end; + +function TJclBZ2UpdateArchive.GetDictionarySize: Cardinal; +begin + Result := FDictionarySize; +end; + +function TJclBZ2UpdateArchive.GetNumberOfPasses: Cardinal; +begin + Result := FNumberOfPasses; +end; + +function TJclBZ2UpdateArchive.GetNumberOfThreads: Cardinal; +begin + Result := FNumberOfThreads; +end; + +procedure TJclBZ2UpdateArchive.InitializeArchiveProperties; +begin + inherited InitializeArchiveProperties; + FNumberOfThreads := 1; + FDictionarySize := kBZip2DicSizeX5; + FCompressionLevel := 7; + FNumberOfPasses := kBZip2NumPassesX7; +end; + +procedure TJclBZ2UpdateArchive.SetCompressionLevel(Value: Cardinal); +begin + CheckNotCompressing; + CheckNotDecompressing; + if Value <= 9 then + begin + FCompressionLevel := Value; + if Value >= 9 then + FNumberOfPasses := kBZip2NumPassesX9 + else + if Value >= 7 then + FNumberOfPasses := kBZip2NumPassesX7 + else + FNumberOfPasses := kBZip2NumPassesX1; + if Value >= 5 then + FDictionarySize := kBZip2DicSizeX5 + else + if Value >= 3 then + FDictionarySize := kBZip2DicSizeX3 + else + FDictionarySize := kBZip2DicSizeX1; + end + else + raise EJclCompressionError.CreateRes(@RsCompressionUnavailableProperty); +end; + +procedure TJclBZ2UpdateArchive.SetDictionarySize(Value: Cardinal); +begin + CheckNotCompressing; + CheckNotDecompressing; + FDictionarySize := Value; +end; + +procedure TJclBZ2UpdateArchive.SetNumberOfPasses(Value: Cardinal); +begin + CheckNotCompressing; + CheckNotDecompressing; + FNumberOfPasses := Value; +end; + +procedure TJclBZ2UpdateArchive.SetNumberOfThreads(Value: Cardinal); +begin + CheckNotCompressing; + CheckNotDecompressing; + FNumberOfThreads := Value; +end; + +//=== { TJcl7zUpdateArchive } ================================================ + +class function TJcl7zUpdateArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompression7zExtensions); +end; + +class function TJcl7zUpdateArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompression7zName); +end; + +class function TJcl7zUpdateArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormat7z; +end; + +function TJcl7zUpdateArchive.GetCompressHeader: Boolean; +begin + Result := FCompressHeader; +end; + +function TJcl7zUpdateArchive.GetCompressHeaderFull: Boolean; +begin + Result := FCompressHeaderFull; +end; + +function TJcl7zUpdateArchive.GetCompressionLevel: Cardinal; +begin + Result := FCompressionLevel; +end; + +function TJcl7zUpdateArchive.GetCompressionLevelMax: Cardinal; +begin + Result := 9; +end; + +function TJcl7zUpdateArchive.GetCompressionLevelMin: Cardinal; +begin + Result := 0; +end; + +function TJcl7zUpdateArchive.GetDictionarySize: Cardinal; +begin + Result := FDictionarySize; +end; + +function TJcl7zUpdateArchive.GetEncryptHeader: Boolean; +begin + Result := FEncryptHeader; +end; + +function TJcl7zUpdateArchive.GetNumberOfThreads: Cardinal; +begin + Result := FNumberOfThreads; +end; + +function TJcl7zUpdateArchive.GetRemoveSfxBlock: Boolean; +begin + Result := FRemoveSfxBlock; +end; + +function TJcl7zUpdateArchive.GetSaveCreationDateTime: Boolean; +begin + Result := FSaveCreationDateTime; +end; + +function TJcl7zUpdateArchive.GetSaveLastAccessDateTime: Boolean; +begin + Result := FSaveLastAccessDateTime; +end; + +function TJcl7zUpdateArchive.GetSaveLastWriteDateTime: Boolean; +begin + Result := FSaveLastWriteDateTime; +end; + +procedure TJcl7zUpdateArchive.InitializeArchiveProperties; +begin + inherited InitializeArchiveProperties; + FNumberOfThreads := 1; + FEncryptHeader := False; + FRemoveSfxBlock := False; + FDictionarySize := kLzmaDicSizeX5; + FCompressionLevel := 6; + FCompressHeader := False; + FCompressHeaderFull := False; + FSaveLastAccessDateTime := True; + FSaveCreationDateTime := True; + FSaveLastWriteDateTime := True; +end; + +class function TJcl7zUpdateArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +procedure TJcl7zUpdateArchive.SetCompressHeader(Value: Boolean); +begin + CheckNotCompressing; + CheckNotDecompressing; + FCompressHeader := Value; +end; + +procedure TJcl7zUpdateArchive.SetCompressHeaderFull(Value: Boolean); +begin + CheckNotCompressing; + CheckNotDecompressing; + FCompressHeaderFull := Value; +end; + +procedure TJcl7zUpdateArchive.SetCompressionLevel(Value: Cardinal); +begin + CheckNotCompressing; + CheckNotDecompressing; + if Value <= 9 then + begin + FCompressionLevel := Value; + if Value >= 9 then + FDictionarySize := kLzmaDicSizeX9 + else + if Value >= 7 then + FDictionarySize := kLzmaDicSizeX7 + else + if Value >= 5 then + FDictionarySize := kLzmaDicSizeX5 + else + if Value >= 3 then + FDictionarySize := kLzmaDicSizeX3 + else + FDictionarySize := kLzmaDicSizeX1; + end + else + raise EJclCompressionError.CreateRes(@RsCompressionUnavailableProperty); +end; + +procedure TJcl7zUpdateArchive.SetDictionarySize(Value: Cardinal); +begin + CheckNotCompressing; + CheckNotDecompressing; + FDictionarySize := Value; +end; + +procedure TJcl7zUpdateArchive.SetEncryptHeader(Value: Boolean); +begin + CheckNotCompressing; + CheckNotDecompressing; + FEncryptHeader := Value; +end; + +procedure TJcl7zUpdateArchive.SetNumberOfThreads(Value: Cardinal); +begin + CheckNotCompressing; + CheckNotDecompressing; + FNumberOfThreads := Value; +end; + +procedure TJcl7zUpdateArchive.SetRemoveSfxBlock(Value: Boolean); +begin + CheckNotCompressing; + CheckNotDecompressing; + FRemoveSfxBlock := Value; +end; + +procedure TJcl7zUpdateArchive.SetSaveCreationDateTime(Value: Boolean); +begin + CheckNotCompressing; + CheckNotDecompressing; + FSaveCreationDateTime := Value; +end; + +procedure TJcl7zUpdateArchive.SetSaveLastAccessDateTime(Value: Boolean); +begin + CheckNotCompressing; + CheckNotDecompressing; + FSaveLastAccessDateTime := Value; +end; + +procedure TJcl7zUpdateArchive.SetSaveLastWriteDateTime(Value: Boolean); +begin + CheckNotCompressing; + CheckNotDecompressing; + FSaveLastWriteDateTime := Value; +end; + +//=== { TJclTarUpdateArchive } =============================================== + +class function TJclTarUpdateArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionTarExtensions); +end; + +class function TJclTarUpdateArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionTarName); +end; + +class function TJclTarUpdateArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatTar; +end; + +class function TJclTarUpdateArchive.MultipleItemContainer: Boolean; +begin + Result := True; +end; + +//=== { TJclGZipUpdateArchive } ============================================== + +class function TJclGZipUpdateArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionGZipExtensions); +end; + +class function TJclGZipUpdateArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionGZipName); +end; + +class function TJclGZipUpdateArchive.ArchiveSubExtensions: string; +begin + Result := LoadResString(@RsCompressionGZipSubExtensions); +end; + +class function TJclGZipUpdateArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatGZip; +end; + +function TJclGZipUpdateArchive.GetAlgorithm: Cardinal; +begin + Result := FAlgorithm; +end; + +function TJclGZipUpdateArchive.GetCompressionLevel: Cardinal; +begin + Result := FCompressionLevel; +end; + +function TJclGZipUpdateArchive.GetCompressionLevelMax: Cardinal; +begin + Result := 9; +end; + +function TJclGZipUpdateArchive.GetCompressionLevelMin: Cardinal; +begin + Result := 0; +end; + +function TJclGZipUpdateArchive.GetNumberOfPasses: Cardinal; +begin + Result := FNumberOfPasses; +end; + +function TJclGZipUpdateArchive.GetSupportedAlgorithms: TDynCardinalArray; +begin + SetLength(Result,2); + Result[0] := 0; + Result[1] := 1; +end; + +procedure TJclGZipUpdateArchive.InitializeArchiveProperties; +begin + inherited InitializeArchiveProperties; + FCompressionLevel := 7; + FNumberOfPasses := kDeflateNumPassesX7; + FAlgorithm := kLzAlgoX5; +end; + +procedure TJclGZipUpdateArchive.SetAlgorithm(Value: Cardinal); +begin + CheckNotCompressing; + CheckNotDecompressing; + FAlgorithm := Value; +end; + +procedure TJclGZipUpdateArchive.SetCompressionLevel(Value: Cardinal); +begin + CheckNotCompressing; + CheckNotDecompressing; + if Value <= 9 then + begin + if Value >= 9 then + FNumberOfPasses := kDeflateNumPassesX9 + else + if Value >= 7 then + FNumberOfPasses := kDeflateNumPassesX7 + else + FNumberOfPasses := kDeflateNumPassesX1; + if Value >= 5 then + FAlgorithm := kLzAlgoX5 + else + FAlgorithm := kLzAlgoX1; + end + else + raise EJclCompressionError.CreateRes(@RsCompressionUnavailableProperty); +end; + +procedure TJclGZipUpdateArchive.SetNumberOfPasses(Value: Cardinal); +begin + CheckNotCompressing; + CheckNotDecompressing; + FNumberOfPasses := Value; +end; + +//=== { TJclXzUpdateArchive } ================================================ + +class function TJclXzUpdateArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionXzExtensions); +end; + +class function TJclXzUpdateArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionXzExtensions); +end; + +class function TJclXzUpdateArchive.ArchiveSubExtensions: string; +begin + Result := LoadResString(@RsCompressionXzSubExtensions); +end; + +class function TJclXzUpdateArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatXz; +end; + +function TJclXzUpdateArchive.GetCompressionMethod: TJclCompressionMethod; +begin + Result := FCompressionMethod; +end; + +function TJclXzUpdateArchive.GetSupportedCompressionMethods: TJclCompressionMethods; +begin + Result := [cmLZMA2]; +end; + +procedure TJclXzUpdateArchive.InitializeArchiveProperties; +begin + inherited InitializeArchiveProperties; + FCompressionMethod := cmLZMA2 +end; + +procedure TJclXzUpdateArchive.SetCompressionMethod( + Value: TJclCompressionMethod); +begin + CheckNotDecompressing; + CheckNotCompressing; + FCompressionMethod := Value; +end; + +//=== { TJclSwfcUpdateArchive } ============================================== + +class function TJclSwfcUpdateArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompressionSwfcExtensions); +end; + +class function TJclSwfcUpdateArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompressionSwfcName); +end; + +class function TJclSwfcUpdateArchive.ArchiveCLSID: TGUID; +begin + Result := CLSID_CFormatSwfc; +end; + +{$ENDIF MSWINDOWS} + +initialization + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + + FreeAndNil(GlobalStreamFormats); + FreeAndNil(GlobalArchiveFormats); + +end. + diff --git a/3rdParty/JCL/source/common/JclContainerIntf.pas b/3rdParty/JCL/source/common/JclContainerIntf.pas new file mode 100644 index 00000000..b9f1e98e --- /dev/null +++ b/3rdParty/JCL/source/common/JclContainerIntf.pas @@ -0,0 +1,4941 @@ +{**************************************************************************************************} +{ WARNING: JEDI preprocessor generated unit. Do not edit. } +{**************************************************************************************************} + +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is DCL_intf.pas. } +{ } +{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } +{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } +{ All rights reserved. } +{ } +{ Contributors: } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclContainerIntf; + +{$I jcl.inc} + + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Classes, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, + JclAnsiStrings, + JclWideStrings; + +{$IFDEF BCB6} +{$DEFINE BUGGY_DEFAULT_INDEXED_PROP} +{$ENDIF BCB6} +{$IFDEF BCB10} +{$DEFINE BUGGY_DEFAULT_INDEXED_PROP} +{$ENDIF BCB10} +{$IFDEF BCB11} +{$DEFINE BUGGY_DEFAULT_INDEXED_PROP} +{$ENDIF BCB11} + +const + DefaultContainerCapacity = 16; + +type + // function pointer types + + // iterate functions Type -> (void) + TIntfIterateProcedure = procedure(const AInterface: IInterface); + TAnsiStrIterateProcedure = procedure(const AString: AnsiString); + TWideStrIterateProcedure = procedure(const AString: WideString); + {$IFDEF SUPPORTS_UNICODE_STRING} + TUnicodeStrIterateProcedure = procedure(const AString: UnicodeString); + {$ENDIF SUPPORTS_UNICODE_STRING} + {$IFDEF CONTAINER_ANSISTR} + TStrIterateProcedure = TAnsiStrIterateProcedure; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TStrIterateProcedure = TWideStrIterateProcedure; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TStrIterateProcedure = TUnicodeStrIterateProcedure; + {$ENDIF CONTAINER_UNICODESTR} + TSingleIterateProcedure = procedure(const AValue: Single); + TDoubleIterateProcedure = procedure(const AValue: Double); + TExtendedIterateProcedure = procedure(const AValue: Extended); + {$IFDEF MATH_SINGLE_PRECISION} + TFloatIterateProcedure = TSingleIterateProcedure; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TFloatIterateProcedure = TDoubleIterateProcedure; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TFloatIterateProcedure = TExtendedIterateProcedure; + {$ENDIF MATH_EXTENDED_PRECISION} + TIntegerIterateProcedure = procedure(AValue: Integer); + TCardinalIterateProcedure = procedure(AValue: Cardinal); + TInt64IterateProcedure = procedure(const AValue: Int64); + TPtrIterateProcedure = procedure(APtr: Pointer); + TIterateProcedure = procedure(AObject: TObject); + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + TIterateProcedure = procedure(const AItem: T); + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + // apply functions Type -> Type + TIntfApplyFunction = function(const AInterface: IInterface): IInterface; + TAnsiStrApplyFunction = function(const AString: AnsiString): AnsiString; + TWideStrApplyFunction = function(const AString: WideString): WideString; + {$IFDEF SUPPORTS_UNICODE_STRING} + TUnicodeStrApplyFunction = function(const AString: UnicodeString): UnicodeString; + {$ENDIF SUPPORTS_UNICODE_STRING} + {$IFDEF CONTAINER_ANSISTR} + TStrApplyFunction = TAnsiStrApplyFunction; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TStrApplyFunction = TWideStrApplyFunction; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TStrApplyFunction = TUnicodeStrApplyFunction; + {$ENDIF CONTAINER_UNICODESTR} + TSingleApplyFunction = function(const AValue: Single): Single; + TDoubleApplyFunction = function(const AValue: Double): Double; + TExtendedApplyFunction = function(const AValue: Extended): Extended; + {$IFDEF MATH_SINGLE_PRECISION} + TFloatApplyFunction = TSingleApplyFunction; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TFloatApplyFunction = TDoubleApplyFunction; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TFloatApplyFunction = TExtendedApplyFunction; + {$ENDIF MATH_EXTENDED_PRECISION} + TIntegerApplyFunction = function(AValue: Integer): Integer; + TCardinalApplyFunction = function(AValue: Cardinal): Cardinal; + TInt64ApplyFunction = function(const AValue: Int64): Int64; + TPtrApplyFunction = function(APtr: Pointer): Pointer; + TApplyFunction = function(AObject: TObject): TObject; + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + TApplyFunction = function(const AItem: T): T; + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + // comparison functions Type -> Type -> Integer + TIntfCompare = function(const Obj1, Obj2: IInterface): Integer; + TAnsiStrCompare = function(const Obj1, Obj2: AnsiString): Integer; + TWideStrCompare = function(const Obj1, Obj2: WideString): Integer; + {$IFDEF SUPPORTS_UNICODE_STRING} + TUnicodeStrCompare = function(const Obj1, Obj2: UnicodeString): Integer; + {$ENDIF SUPPORTS_UNICODE_STRING} + {$IFDEF CONTAINER_ANSISTR} + TStrCompare = TAnsiStrCompare; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TStrCompare = TWideStrCompare; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TStrCompare = TUnicodeStrCompare; + {$ENDIF CONTAINER_UNICODESTR} + TSingleCompare = function(const Obj1, Obj2: Single): Integer; + TDoubleCompare = function(const Obj1, Obj2: Double): Integer; + TExtendedCompare = function(const Obj1, Obj2: Extended): Integer; + {$IFDEF MATH_SINGLE_PRECISION} + TFloatCompare = TSingleCompare; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TFloatCompare = TDoubleCompare; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TFloatCompare = TExtendedCompare; + {$ENDIF MATH_EXTENDED_PRECISION} + TIntegerCompare = function(Obj1, Obj2: Integer): Integer; + TCardinalCompare = function(Obj1, Obj2: Cardinal): Integer; + TInt64Compare = function(const Obj1, Obj2: Int64): Integer; + TPtrCompare = function(Obj1, Obj2: Pointer): Integer; + TCompare = function(Obj1, Obj2: TObject): Integer; + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + TCompare = function(const Obj1, Obj2: T): Integer; + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + // comparison for equality functions Type -> Type -> Boolean + TIntfEqualityCompare = function(const Obj1, Obj2: IInterface): Boolean; + TAnsiStrEqualityCompare = function(const Obj1, Obj2: AnsiString): Boolean; + TWideStrEqualityCompare = function(const Obj1, Obj2: WideString): Boolean; + {$IFDEF SUPPORTS_UNICODE_STRING} + TUnicodeStrEqualityCompare = function(const Obj1, Obj2: UnicodeString): Boolean; + {$ENDIF SUPPORTS_UNICODE_STRING} + {$IFDEF CONTAINER_ANSISTR} + TStrEqualityCompare = TAnsiStrEqualityCompare; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TStrEqualityCompare = TWideStrEqualityCompare; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TStrEqualityCompare = TUnicodeStrEqualityCompare; + {$ENDIF CONTAINER_UNICODESTR} + TSingleEqualityCompare = function(const Obj1, Obj2: Single): Boolean; + TDoubleEqualityCompare = function(const Obj1, Obj2: Double): Boolean; + TExtendedEqualityCompare = function(const Obj1, Obj2: Extended): Boolean; + {$IFDEF MATH_SINGLE_PRECISION} + TFloatEqualityCompare = TSingleEqualityCompare; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TFloatEqualityCompare = TDoubleEqualityCompare; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TFloatEqualityCompare = TExtendedEqualityCompare; + {$ENDIF MATH_EXTENDED_PRECISION} + TIntegerEqualityCompare = function(Obj1, Obj2: Integer): Boolean; + TCardinalEqualityCompare = function(Obj1, Obj2: Cardinal): Boolean; + TInt64EqualityCompare = function(const Obj1, Obj2: Int64): Boolean; + TPtrEqualityCompare = function(Obj1, Obj2: Pointer): Boolean; + TEqualityCompare = function(Obj1, Obj2: TObject): Boolean; + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + TEqualityCompare = function(const Obj1, Obj2: T): Boolean; + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + // hash functions Type -> Integer + TIntfHashConvert = function(const AInterface: IInterface): Integer; + TAnsiStrHashConvert = function(const AString: AnsiString): Integer; + TWideStrHashConvert = function(const AString: WideString): Integer; + {$IFDEF SUPPORTS_UNICODE_STRING} + TUnicodeStrHashConvert = function(const AString: UnicodeString): Integer; + {$ENDIF SUPPORTS_UNICODE_STRING} + {$IFDEF CONTAINER_ANSISTR} + TStrHashConvert = TAnsiStrHashConvert; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TStrHashConvert = TWideStrHashConvert; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TStrHashConvert = TUnicodeStrHashConvert; + {$ENDIF CONTAINER_UNICODESTR} + TSingleHashConvert = function(const AValue: Single): Integer; + TDoubleHashConvert = function(const AValue: Double): Integer; + TExtendedHashConvert = function(const AValue: Extended): Integer; + {$IFDEF MATH_SINGLE_PRECISION} + TFloatHashConvert = TSingleHashConvert; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TFloatHashConvert = TDoubleHashConvert; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TFloatHashConvert = TExtendedHashConvert; + {$ENDIF MATH_EXTENDED_PRECISION} + TIntegerHashConvert = function(AValue: Integer): Integer; + TCardinalHashConvert = function(AValue: Cardinal): Integer; + TInt64HashConvert = function(const AValue: Int64): Integer; + TPtrHashConvert = function(APtr: Pointer): Integer; + THashConvert = function(AObject: TObject): Integer; + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + THashConvert = function(const AItem: T): Integer; + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + IJclLockable = interface + ['{524AD65E-AE1B-4BC6-91C8-8181F0198BA9}'] + procedure ReadLock; + procedure ReadUnlock; + procedure WriteLock; + procedure WriteUnlock; + end; + + IJclAbstractIterator = interface{$IFDEF THREADSAFE}(IJclLockable){$ENDIF THREADSAFE} + ['{1064D0B4-D9FC-475D-88BE-520490013B46}'] + procedure Assign(const Source: IJclAbstractIterator); + procedure AssignTo(const Dest: IJclAbstractIterator); + function GetIteratorReference: TObject; + end; + + IJclBaseContainer = interface{$IFDEF THREADSAFE}(IJclLockable){$ENDIF THREADSAFE} + ['{C517175A-028E-486A-BF27-5EF7FC3101D9}'] + procedure Assign(const Source: IJclBaseContainer); + procedure AssignTo(const Dest: IJclBaseContainer); + function GetAllowDefaultElements: Boolean; + function GetContainerReference: TObject; + function GetDuplicates: TDuplicates; + function GetReadOnly: Boolean; + function GetRemoveSingleElement: Boolean; + function GetReturnDefaultElements: Boolean; + function GetThreadSafe: Boolean; + procedure SetAllowDefaultElements(Value: Boolean); + procedure SetDuplicates(Value: TDuplicates); + procedure SetReadOnly(Value: Boolean); + procedure SetRemoveSingleElement(Value: Boolean); + procedure SetReturnDefaultElements(Value: Boolean); + procedure SetThreadSafe(Value: Boolean); + property AllowDefaultElements: Boolean read GetAllowDefaultElements write SetAllowDefaultElements; + property Duplicates: TDuplicates read GetDuplicates write SetDuplicates; + property ReadOnly: Boolean read GetReadOnly write SetReadOnly; + property RemoveSingleElement: Boolean read GetRemoveSingleElement write SetRemoveSingleElement; + property ReturnDefaultElements: Boolean read GetReturnDefaultElements write SetReturnDefaultElements; + property ThreadSafe: Boolean read GetThreadSafe write SetThreadSafe; + end; + + IJclIntfContainer = interface(IJclBaseContainer) + ['{44F10075-9702-4DCA-9731-D8990F234A74}'] + end; + + IJclIntfFlatContainer = interface(IJclIntfContainer) + ['{15116007-6BB8-4D9D-8249-C2F49D4AB3EA}'] + end; + + IJclStrBaseContainer = interface(IJclBaseContainer) + ['{9753E1D7-F093-4D5C-8B32-40403F6F700E}'] + function GetCaseSensitive: Boolean; + procedure SetCaseSensitive(Value: Boolean); + property CaseSensitive: Boolean read GetCaseSensitive write SetCaseSensitive; + end; + + TJclAnsiStrEncoding = (seISO, seUTF8); + + IJclAnsiStrContainer = interface(IJclStrBaseContainer) + ['{F8239357-B96F-46F1-A48E-B5DF25B5F1FA}'] + function GetEncoding: TJclAnsiStrEncoding; + procedure SetEncoding(Value: TJclAnsiStrEncoding); + property Encoding: TJclAnsiStrEncoding read GetEncoding write SetEncoding; + end; + + IJclAnsiStrFlatContainer = interface(IJclAnsiStrContainer) + ['{8A45A4D4-6317-4CDF-8314-C3E5CC6899F4}'] + procedure LoadFromStrings(Strings: TJclAnsiStrings); + procedure SaveToStrings(Strings: TJclAnsiStrings); + procedure AppendToStrings(Strings: TJclAnsiStrings); + procedure AppendFromStrings(Strings: TJclAnsiStrings); + function GetAsStrings: TJclAnsiStrings; + function GetAsDelimited(const Separator: AnsiString = AnsiLineBreak): AnsiString; + procedure AppendDelimited(const AString: AnsiString; const Separator: AnsiString = AnsiLineBreak); + procedure LoadDelimited(const AString: AnsiString; const Separator: AnsiString = AnsiLineBreak); + end; + + TJclWideStrEncoding = (seUTF16); + + IJclWideStrContainer = interface(IJclStrBaseContainer) + ['{875E1AC4-CA22-46BC-8999-048E5B9BF11D}'] + function GetEncoding: TJclWideStrEncoding; + procedure SetEncoding(Value: TJclWideStrEncoding); + property Encoding: TJclWideStrEncoding read GetEncoding write SetEncoding; + end; + + IJclWideStrFlatContainer = interface(IJclWideStrContainer) + ['{5B001B93-CA1C-47A8-98B8-451CCB444930}'] + procedure LoadFromStrings(Strings: TJclWideStrings); + procedure SaveToStrings(Strings: TJclWideStrings); + procedure AppendToStrings(Strings: TJclWideStrings); + procedure AppendFromStrings(Strings: TJclWideStrings); + function GetAsStrings: TJclWideStrings; + function GetAsDelimited(const Separator: WideString = WideLineBreak): WideString; + procedure AppendDelimited(const AString: WideString; const Separator: WideString = WideLineBreak); + procedure LoadDelimited(const AString: WideString; const Separator: WideString = WideLineBreak); + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclUnicodeStrContainer = interface(IJclStrBaseContainer) + ['{619BA29F-5E05-464D-B472-1C8453DBC707}'] + end; + + IJclUnicodeStrFlatContainer = interface(IJclUnicodeStrContainer) + ['{3343D73E-4ADC-458E-8289-A4B83D1479D1}'] + procedure LoadFromStrings(Strings: TJclUnicodeStrings); + procedure SaveToStrings(Strings: TJclUnicodeStrings); + procedure AppendToStrings(Strings: TJclUnicodeStrings); + procedure AppendFromStrings(Strings: TJclUnicodeStrings); + function GetAsStrings: TJclUnicodeStrings; + function GetAsDelimited(const Separator: UnicodeString = WideLineBreak): UnicodeString; + procedure AppendDelimited(const AString: UnicodeString; const Separator: UnicodeString = WideLineBreak); + procedure LoadDelimited(const AString: UnicodeString; const Separator: UnicodeString = WideLineBreak); + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + IJclStrContainer = IJclAnsiStrContainer; + IJclStrFlatContainer = IJclAnsiStrFlatContainer; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclStrContainer = IJclWideStrContainer; + IJclStrFlatContainer = IJclWideStrFlatContainer; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclStrContainer = IJclUnicodeStrContainer; + IJclStrFlatContainer = IJclUnicodeStrFlatContainer; + {$ENDIF CONTAINER_UNICODESTR} + + IJclSingleContainer = interface(IJclBaseContainer) + ['{22BE88BD-87D1-4B4D-9FAB-F1B6D555C6A9}'] + function GetPrecision: Single; + procedure SetPrecision(const Value: Single); + property Precision: Single read GetPrecision write SetPrecision; + end; + + IJclSingleFlatContainer = interface(IJclSingleContainer) + ['{F16955E8-94D2-4201-809B-CC2EA39B5FDD}'] + end; + + IJclDoubleContainer = interface(IJclBaseContainer) + ['{372B9354-DF6D-4CAA-A5A9-C50E1FEE5525}'] + function GetPrecision: Double; + procedure SetPrecision(const Value: Double); + property Precision: Double read GetPrecision write SetPrecision; + end; + + IJclDoubleFlatContainer = interface(IJclDoubleContainer) + ['{2F0252CE-7471-45CA-8C8D-FD3925507C00}'] + end; + + IJclExtendedContainer = interface(IJclBaseContainer) + ['{431A6482-FD5C-45A7-BE53-339A3CF75AC9}'] + function GetPrecision: Extended; + procedure SetPrecision(const Value: Extended); + property Precision: Extended read GetPrecision write SetPrecision; + end; + + IJclExtendedFlatContainer = interface(IJclExtendedContainer) + ['{1D3F48A2-001E-48F7-8A54-B9F4CE837523}'] + end; + + {$IFDEF MATH_EXTENDED_PRECISION} + IJclFloatContainer = IJclExtendedContainer; + IJclFloatFlatContainer = IJclExtendedFlatContainer; + {$ENDIF MATH_EXTENDED_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclFloatContainer = IJclDoubleContainer; + IJclFloatFlatContainer = IJclDoubleFlatContainer; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_SINGLE_PRECISION} + IJclFloatContainer = IJclSingleContainer; + IJclFloatFlatContainer = IJclSingleFlatContainer; + {$ENDIF MATH_SINGLE_PRECISION} + + IJclIntegerContainer = interface(IJclBaseContainer) + ['{3BAF5447-9835-43A4-9FF3-E5EA7D43A7D1}'] + end; + + IJclIntegerFlatContainer = interface(IJclIntegerContainer) + ['{EF4EFCD9-60CB-4525-9D20-18E55291F7CF}'] + end; + + IJclCardinalContainer = interface(IJclBaseContainer) + ['{01DF05CF-62E9-46B3-8BC1-2830EEF43644}'] + end; + + IJclCardinalFlatContainer = interface(IJclCardinalContainer) + ['{79E48B80-3215-47D0-A1B5-D74C495AC9D1}'] + end; + + IJclInt64Container = interface(IJclBaseContainer) + ['{B560B2B6-F8C7-45F0-A5E5-920AA61C1540}'] + end; + + IJclInt64FlatContainer = interface(IJclInt64Container) + ['{E740B9EF-7342-4CEF-B7FB-96C5267F5738}'] + end; + + IJclPtrContainer = interface(IJclBaseContainer) + ['{E8DD2A85-1E12-4605-B517-7E3121C5624F}'] + end; + + IJclPtrFlatContainer = interface(IJclPtrContainer) + ['{43C41789-DE71-4DA5-B4AC-3F53EB9459CD}'] + end; + + IJclContainer = interface(IJclBaseContainer) + ['{A9EBED03-4993-426A-8449-30D98DC2AC90}'] + end; + + IJclFlatContainer = interface(IJclContainer) + ['{0A070B6F-54A1-4B3D-A4E4-CFFAE2C7C57B}'] + end; + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + IJclContainer = interface(IJclBaseContainer) + ['{19599A90-F392-430D-878D-A73E096C04AF}'] + end; + + IJclFlatContainer = interface(IJclContainer) + ['{F562ECFB-98DC-4A82-A806-ED978B9D1667}'] + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + IJclIntfEqualityComparer = interface + ['{5CC2DF51-BE56-4D02-A171-31BAAC097632}'] + function GetEqualityCompare: TIntfEqualityCompare; + procedure SetEqualityCompare(Value: TIntfEqualityCompare); + function ItemsEqual(const A, B: IInterface): Boolean; + property EqualityCompare: TIntfEqualityCompare read GetEqualityCompare write SetEqualityCompare; + end; + + IJclAnsiStrEqualityComparer = interface + ['{E3DB9016-F0D0-4CE0-B156-4C5DCA47FD3B}'] + function GetEqualityCompare: TAnsiStrEqualityCompare; + procedure SetEqualityCompare(Value: TAnsiStrEqualityCompare); + function ItemsEqual(const A, B: AnsiString): Boolean; + property EqualityCompare: TAnsiStrEqualityCompare read GetEqualityCompare write SetEqualityCompare; + end; + + IJclWideStrEqualityComparer = interface + ['{2E5696C9-8374-4347-9DC9-B3722F47F5FB}'] + function GetEqualityCompare: TWideStrEqualityCompare; + procedure SetEqualityCompare(Value: TWideStrEqualityCompare); + function ItemsEqual(const A, B: WideString): Boolean; + property EqualityCompare: TWideStrEqualityCompare read GetEqualityCompare write SetEqualityCompare; + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclUnicodeStrEqualityComparer = interface + ['{EDFCC1C7-79DB-4F58-BD64-5016B44EEAC0}'] + function GetEqualityCompare: TUnicodeStrEqualityCompare; + procedure SetEqualityCompare(Value: TUnicodeStrEqualityCompare); + function ItemsEqual(const A, B: UnicodeString): Boolean; + property EqualityCompare: TUnicodeStrEqualityCompare read GetEqualityCompare write SetEqualityCompare; + end; + + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + IJclStrEqualityComparer = IJclAnsiStrEqualityComparer; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclStrEqualityComparer = IJclWideStrEqualityComparer; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclStrEqualityComparer = IJclUnicodeStrEqualityComparer; + {$ENDIF CONTAINER_UNICODESTR} + + IJclSingleEqualityComparer = interface + ['{4835BC5B-1A87-4864-BFE1-778F3BAF26B1}'] + function GetEqualityCompare: TSingleEqualityCompare; + procedure SetEqualityCompare(Value: TSingleEqualityCompare); + function ItemsEqual(const A, B: Single): Boolean; + property EqualityCompare: TSingleEqualityCompare read GetEqualityCompare write SetEqualityCompare; + end; + + IJclDoubleEqualityComparer = interface + ['{15F0A9F0-D5DC-4978-8CDB-53B6E510262C}'] + function GetEqualityCompare: TDoubleEqualityCompare; + procedure SetEqualityCompare(Value: TDoubleEqualityCompare); + function ItemsEqual(const A, B: Double): Boolean; + property EqualityCompare: TDoubleEqualityCompare read GetEqualityCompare write SetEqualityCompare; + end; + + IJclExtendedEqualityComparer = interface + ['{149883D5-4138-4570-8C5C-99F186B7E646}'] + function GetEqualityCompare: TExtendedEqualityCompare; + procedure SetEqualityCompare(Value: TExtendedEqualityCompare); + function ItemsEqual(const A, B: Extended): Boolean; + property EqualityCompare: TExtendedEqualityCompare read GetEqualityCompare write SetEqualityCompare; + end; + + {$IFDEF MATH_SINGLE_PRECISION} + IJclFloatEqualityComparer = IJclSingleEqualityComparer; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclFloatEqualityComparer = IJclDoubleEqualityComparer; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + IJclFloatEqualityComparer = IJclExtendedEqualityComparer; + {$ENDIF MATH_EXTENDED_PRECISION} + + IJclIntegerEqualityComparer = interface + ['{AABC35E6-A779-4A44-B748-27BFCB34FDFB}'] + function GetEqualityCompare: TIntegerEqualityCompare; + procedure SetEqualityCompare(Value: TIntegerEqualityCompare); + function ItemsEqual(A, B: Integer): Boolean; + property EqualityCompare: TIntegerEqualityCompare read GetEqualityCompare write SetEqualityCompare; + end; + + IJclCardinalEqualityComparer = interface + ['{B2DECF81-6ECE-4D9F-80E1-C8C884DB407C}'] + function GetEqualityCompare: TCardinalEqualityCompare; + procedure SetEqualityCompare(Value: TCardinalEqualityCompare); + function ItemsEqual(A, B: Cardinal): Boolean; + property EqualityCompare: TCardinalEqualityCompare read GetEqualityCompare write SetEqualityCompare; + end; + + IJclInt64EqualityComparer = interface + ['{8B2825E2-0C81-42BA-AC0D-104344CE7E56}'] + function GetEqualityCompare: TInt64EqualityCompare; + procedure SetEqualityCompare(Value: TInt64EqualityCompare); + function ItemsEqual(const A, B: Int64): Boolean; + property EqualityCompare: TInt64EqualityCompare read GetEqualityCompare write SetEqualityCompare; + end; + + IJclPtrEqualityComparer = interface + ['{C6B7CBF9-ECD9-4D70-85CC-4E2367A1D806}'] + function GetEqualityCompare: TPtrEqualityCompare; + procedure SetEqualityCompare(Value: TPtrEqualityCompare); + function ItemsEqual(A, B: Pointer): Boolean; + property EqualityCompare: TPtrEqualityCompare read GetEqualityCompare write SetEqualityCompare; + end; + + IJclEqualityComparer = interface + ['{82C67986-8365-44AB-8D56-7B0CF4F6B918}'] + function GetEqualityCompare: TEqualityCompare; + procedure SetEqualityCompare(Value: TEqualityCompare); + function ItemsEqual(A, B: TObject): Boolean; + property EqualityCompare: TEqualityCompare read GetEqualityCompare write SetEqualityCompare; + end; + + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + IJclEqualityComparer = interface + ['{4AF79AD6-D9F4-424B-BEAA-68857F9222B4}'] + function GetEqualityCompare: TEqualityCompare; + procedure SetEqualityCompare(Value: TEqualityCompare); + function ItemsEqual(const A, B: T): Boolean; + property EqualityCompare: TEqualityCompare read GetEqualityCompare write SetEqualityCompare; + end; + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + IJclIntfComparer = interface + ['{EB41B843-184B-420D-B5DA-27D055B4CD55}'] + function GetCompare: TIntfCompare; + procedure SetCompare(Value: TIntfCompare); + function ItemsCompare(const A, B: IInterface): Integer; + property Compare: TIntfCompare read GetCompare write SetCompare; + end; + + IJclAnsiStrComparer = interface + ['{09063CBB-9226-4734-B2A0-A178C2343176}'] + function GetCompare: TAnsiStrCompare; + procedure SetCompare(Value: TAnsiStrCompare); + function ItemsCompare(const A, B: AnsiString): Integer; + property Compare: TAnsiStrCompare read GetCompare write SetCompare; + end; + + IJclWideStrComparer = interface + ['{7A24AEDA-25B1-4E73-B2E9-5D74011E4C9C}'] + function GetCompare: TWideStrCompare; + procedure SetCompare(Value: TWideStrCompare); + function ItemsCompare(const A, B: WideString): Integer; + property Compare: TWideStrCompare read GetCompare write SetCompare; + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclUnicodeStrComparer = interface + ['{E81E2705-0CA0-4DBD-BECC-5F9AA623A6E4}'] + function GetCompare: TUnicodeStrCompare; + procedure SetCompare(Value: TUnicodeStrCompare); + function ItemsCompare(const A, B: UnicodeString): Integer; + property Compare: TUnicodeStrCompare read GetCompare write SetCompare; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + IJclStrComparer = IJclAnsiStrComparer; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclStrComparer = IJclWideStrComparer; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclStrComparer = IJclUnicodeStrComparer; + {$ENDIF CONTAINER_UNICODESTR} + + IJclSingleComparer = interface + ['{008225CE-075E-4450-B9DE-9863CB6D347C}'] + function GetCompare: TSingleCompare; + procedure SetCompare(Value: TSingleCompare); + function ItemsCompare(const A, B: Single): Integer; + property Compare: TSingleCompare read GetCompare write SetCompare; + end; + + IJclDoubleComparer = interface + ['{BC245D7F-7EB9-43D0-81B4-EE215486A5AA}'] + function GetCompare: TDoubleCompare; + procedure SetCompare(Value: TDoubleCompare); + function ItemsCompare(const A, B: Double): Integer; + property Compare: TDoubleCompare read GetCompare write SetCompare; + end; + + IJclExtendedComparer = interface + ['{92657C66-C18D-4BF8-A538-A3B0140320BB}'] + function GetCompare: TExtendedCompare; + procedure SetCompare(Value: TExtendedCompare); + function ItemsCompare(const A, B: Extended): Integer; + property Compare: TExtendedCompare read GetCompare write SetCompare; + end; + + {$IFDEF MATH_SINGLE_PRECISION} + IJclFloatComparer = IJclSingleComparer; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclFloatComparer = IJclDoubleComparer; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + IJclFloatComparer = IJclExtendedComparer; + {$ENDIF MATH_EXTENDED_PRECISION} + + IJclIntegerComparer = interface + ['{362C3A6A-CBC1-4D5F-8652-158913DC9865}'] + function GetCompare: TIntegerCompare; + procedure SetCompare(Value: TIntegerCompare); + function ItemsCompare(A, B: Integer): Integer; + property Compare: TIntegerCompare read GetCompare write SetCompare; + end; + + IJclCardinalComparer = interface + ['{56E44725-00B9-4530-8CC2-72DCA9171EE0}'] + function GetCompare: TCardinalCompare; + procedure SetCompare(Value: TCardinalCompare); + function ItemsCompare(A, B: Cardinal): Integer; + property Compare: TCardinalCompare read GetCompare write SetCompare; + end; + + IJclInt64Comparer = interface + ['{87C935BF-3A42-4F1F-A474-9C823939EE1C}'] + function GetCompare: TInt64Compare; + procedure SetCompare(Value: TInt64Compare); + function ItemsCompare(const A, B: Int64): Integer; + property Compare: TInt64Compare read GetCompare write SetCompare; + end; + + IJclPtrComparer = interface + ['{85557D4C-A036-477E-BA73-B5EEF43A8696}'] + function GetCompare: TPtrCompare; + procedure SetCompare(Value: TPtrCompare); + function ItemsCompare(A, B: Pointer): Integer; + property Compare: TPtrCompare read GetCompare write SetCompare; + end; + + IJclComparer = interface + ['{7B376028-56DC-4C4A-86A9-1AC19E3EDF75}'] + function GetCompare: TCompare; + procedure SetCompare(Value: TCompare); + function ItemsCompare(A, B: TObject): Integer; + property Compare: TCompare read GetCompare write SetCompare; + end; + + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + IJclComparer = interface + ['{830AFC8C-AA06-46F5-AABD-8EB46B2A9986}'] + function GetCompare: TCompare; + procedure SetCompare(Value: TCompare); + function ItemsCompare(const A, B: T): Integer; + property Compare: TCompare read GetCompare write SetCompare; + end; + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + IJclIntfHashConverter = interface + ['{7BAA0791-3B45-4D0F-9CD8-D13B81694786}'] + function GetHashConvert: TIntfHashConvert; + procedure SetHashConvert(Value: TIntfHashConvert); + function Hash(const AInterface: IInterface): Integer; + property HashConvert: TIntfHashConvert read GetHashConvert write SetHashConvert; + end; + + IJclAnsiStrHashConverter = interface + ['{9841014E-8A31-4C79-8AD5-EB03C4E85533}'] + function GetHashConvert: TAnsiStrHashConvert; + procedure SetHashConvert(Value: TAnsiStrHashConvert); + function Hash(const AString: AnsiString): Integer; + property HashConvert: TAnsiStrHashConvert read GetHashConvert write SetHashConvert; + end; + + IJclWideStrHashConverter = interface + ['{2584118F-19AE-443E-939B-0DB18BCD0117}'] + function GetHashConvert: TWideStrHashConvert; + procedure SetHashConvert(Value: TWideStrHashConvert); + function Hash(const AString: WideString): Integer; + property HashConvert: TWideStrHashConvert read GetHashConvert write SetHashConvert; + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclUnicodeStrHashConverter = interface + ['{08CD8171-DBAF-405F-9802-46D955C8BBE6}'] + function GetHashConvert: TUnicodeStrHashConvert; + procedure SetHashConvert(Value: TUnicodeStrHashConvert); + function Hash(const AString: UnicodeString): Integer; + property HashConvert: TUnicodeStrHashConvert read GetHashConvert write SetHashConvert; + end; + + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + IJclStrHashConverter = IJclAnsiStrHashConverter; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclStrHashConverter = IJclWideStrHashConverter; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclStrHashConverter = IJclUnicodeStrHashConverter; + {$ENDIF CONTAINER_UNICODESTR} + + IJclSingleHashConverter = interface + ['{20F0E481-F1D2-48B6-A95D-FBB56AF119F5}'] + function GetHashConvert: TSingleHashConvert; + procedure SetHashConvert(Value: TSingleHashConvert); + function Hash(const AValue: Single): Integer; + property HashConvert: TSingleHashConvert read GetHashConvert write SetHashConvert; + end; + + IJclDoubleHashConverter = interface + ['{193A2881-535B-4AF4-B0C3-6845A2800F80}'] + function GetHashConvert: TDoubleHashConvert; + procedure SetHashConvert(Value: TDoubleHashConvert); + function Hash(const AValue: Double): Integer; + property HashConvert: TDoubleHashConvert read GetHashConvert write SetHashConvert; + end; + + IJclExtendedHashConverter = interface + ['{77CECDB9-2774-4FDC-8E5A-A80325626434}'] + function GetHashConvert: TExtendedHashConvert; + procedure SetHashConvert(Value: TExtendedHashConvert); + function Hash(const AValue: Extended): Integer; + property HashConvert: TExtendedHashConvert read GetHashConvert write SetHashConvert; + end; + + {$IFDEF MATH_SINGLE_PRECISION} + IJclFloatHashConverter = IJclSingleHashConverter; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclFloatHashConverter = IJclDoubleHashConverter; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + IJclFloatHashConverter = IJclExtendedHashConverter; + {$ENDIF MATH_EXTENDED_PRECISION} + + IJclIntegerHashConverter = interface + ['{92C540B2-C16C-47E4-995A-644BE71878B1}'] + function GetHashConvert: TIntegerHashConvert; + procedure SetHashConvert(Value: TIntegerHashConvert); + function Hash(AValue: Integer): Integer; + property HashConvert: TIntegerHashConvert read GetHashConvert write SetHashConvert; + end; + + IJclCardinalHashConverter = interface + ['{2DF04C8A-16B8-4712-BC5D-AD35014EC9F7}'] + function GetHashConvert: TCardinalHashConvert; + procedure SetHashConvert(Value: TCardinalHashConvert); + function Hash(AValue: Cardinal): Integer; + property HashConvert: TCardinalHashConvert read GetHashConvert write SetHashConvert; + end; + + IJclInt64HashConverter = interface + ['{96CF2A71-9185-4E26-B283-457ABC3584E7}'] + function GetHashConvert: TInt64HashConvert; + procedure SetHashConvert(Value: TInt64HashConvert); + function Hash(const AValue: Int64): Integer; + property HashConvert: TInt64HashConvert read GetHashConvert write SetHashConvert; + end; + + IJclPtrHashConverter = interface + ['{D704CC67-CFED-44E6-9504-65D5E468FCAF}'] + function GetHashConvert: TPtrHashConvert; + procedure SetHashConvert(Value: TPtrHashConvert); + function Hash(APtr: Pointer): Integer; + property HashConvert: TPtrHashConvert read GetHashConvert write SetHashConvert; + end; + + IJclHashConverter = interface + ['{2D0DD6F4-162E-41D6-8A34-489E7EACABCD}'] + function GetHashConvert: THashConvert; + procedure SetHashConvert(Value: THashConvert); + function Hash(AObject: TObject): Integer; + property HashConvert: THashConvert read GetHashConvert write SetHashConvert; + end; + + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + IJclHashConverter = interface + ['{300AEA0E-7433-4C3E-99A6-E533212ACF42}'] + function GetHashConvert: THashConvert; + procedure SetHashConvert(Value: THashConvert); + function Hash(const AItem: T): Integer; + property HashConvert: THashConvert read GetHashConvert write SetHashConvert; + end; + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + IJclIntfCloneable = interface + ['{BCF77740-FB60-4306-9BD1-448AADE5FF4E}'] + function IntfClone: IInterface; + end; + + IJclCloneable = interface + ['{D224AE70-2C93-4998-9479-1D513D75F2B2}'] + function ObjectClone: TObject; + end; + + TJclAutoPackStrategy = (apsDisabled, apsAgressive, apsProportional, apsIncremental); + + // parameter signification depends on strategy + // - Disabled = unused (arrays are never packed) + // - Agressive = unused (arrays are always packed) + // - Proportional = ratio of empty slots before the array is packed + // number of empty slots is computed by this formula: Capacity div Parameter + // - Incremental = amount of empty slots before the array is packed + + IJclPackable = interface + ['{03802D2B-E0AB-4300-A777-0B8A2BD993DF}'] + function CalcGrowCapacity(ACapacity, ASize: Integer): Integer; + function GetAutoPackParameter: Integer; + function GetAutoPackStrategy: TJclAutoPackStrategy; + function GetCapacity: Integer; + procedure Pack; // reduce used memory by eliminating empty storage area (force) + procedure SetAutoPackParameter(Value: Integer); + procedure SetAutoPackStrategy(Value: TJclAutoPackStrategy); + procedure SetCapacity(Value: Integer); + property AutoPackParameter: Integer read GetAutoPackParameter write SetAutoPackParameter; + property AutoPackStrategy: TJclAutoPackStrategy read GetAutoPackStrategy write SetAutoPackStrategy; + property Capacity: Integer read GetCapacity write SetCapacity; + end; + + TJclAutoGrowStrategy = (agsDisabled, agsAgressive, agsProportional, agsIncremental); + + // parameter signification depends on strategy + // - Disabled = unused (arrays never grow) + // - Agressive = unused (arrays always grow by 1 element) + // - Proportional = ratio of empty slots to add to the array + // number of empty slots is computed by this formula: Capacity div Parameter + // - Incremental = amount of empty slots to add to the array + + IJclGrowable = interface(IJclPackable) + ['{C71E8586-5688-444C-9BDD-9969D988123B}'] + function CalcPackCapacity(ACapacity, ASize: Integer): Integer; + function GetAutoGrowParameter: Integer; + function GetAutoGrowStrategy: TJclAutoGrowStrategy; + procedure Grow; + procedure SetAutoGrowParameter(Value: Integer); + procedure SetAutoGrowStrategy(Value: TJclAutoGrowStrategy); + property AutoGrowParameter: Integer read GetAutoGrowParameter write SetAutoGrowParameter; + property AutoGrowStrategy: TJclAutoGrowStrategy read GetAutoGrowStrategy write SetAutoGrowStrategy; + end; + + TFreeIntfEvent = function (var AInterface: IInterface): IInterface of object; + + IJclIntfOwner = interface(IInterface) + ['{17C1D3FB-BB32-48F2-BD1C-D43EA05A86A8}'] + function GetOnFreeObject: TFreeIntfEvent; + function FreeObject(var AInterface: IInterface): IInterface; + procedure SetOnFreeObject(Value: TFreeIntfEvent); + property OnFreeObject: TFreeIntfEvent read GetOnFreeObject write SetOnFreeObject; + end; + + TFreeAnsiStrEvent = function (var AString: AnsiString): AnsiString of object; + + IJclAnsiStrOwner = interface(IInterface) + ['{4F64F1F6-766A-4CFA-B51B-654116E308A8}'] + function GetOnFreeString: TFreeAnsiStrEvent; + function FreeString(var AString: AnsiString): AnsiString; + procedure SetOnFreeString(Value: TFreeAnsiStrEvent); + property OnFreeString: TFreeAnsiStrEvent read GetOnFreeString write SetOnFreeString; + end; + + TFreeWideStrEvent = function (var AString: WideString): WideString of object; + + IJclWideStrOwner = interface(IInterface) + ['{282B7A64-BCD0-4EAE-8776-4EF92D7E3D8B}'] + function GetOnFreeString: TFreeWideStrEvent; + function FreeString(var AString: WideString): WideString; + procedure SetOnFreeString(Value: TFreeWideStrEvent); + property OnFreeString: TFreeWideStrEvent read GetOnFreeString write SetOnFreeString; + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + TFreeUnicodeStrEvent = function (var AString: UnicodeString): UnicodeString of object; + + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclUnicodeStrOwner = interface(IInterface) + ['{07F402E6-DD97-4AA4-83D8-4CCD419FCCFC}'] + function GetOnFreeString: TFreeUnicodeStrEvent; + function FreeString(var AString: UnicodeString): UnicodeString; + procedure SetOnFreeString(Value: TFreeUnicodeStrEvent); + property OnFreeString: TFreeUnicodeStrEvent read GetOnFreeString write SetOnFreeString; + end; + + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + TFreeStrEvent = TFreeAnsiStrEvent; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TFreeStrEvent = TFreeWideStrEvent; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TFreeStrEvent = TFreeUnicodeStrEvent; + {$ENDIF CONTAINER_UNICODESTR} + + {$IFDEF CONTAINER_ANSISTR} + IJclStrOwner = IJclAnsiStrOwner; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclStrOwner = IJclWideStrOwner; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclStrOwner = IJclUnicodeStrOwner; + {$ENDIF CONTAINER_UNICODESTR} + + TFreeSingleEvent = function (var AValue: Single): Single of object; + + IJclSingleOwner = interface(IInterface) + ['{B002C201-70D7-4FA8-B44A-6D18E82580E5}'] + function GetOnFreeSingle: TFreeSingleEvent; + function FreeSingle(var AValue: Single): Single; + procedure SetOnFreeSingle(Value: TFreeSingleEvent); + property OnFreeSingle: TFreeSingleEvent read GetOnFreeSingle write SetOnFreeSingle; + end; + + TFreeDoubleEvent = function (var AValue: Double): Double of object; + + IJclDoubleOwner = interface(IInterface) + ['{3BEFEDB0-C904-4400-ABEF-40FC928BB258}'] + function GetOnFreeDouble: TFreeDoubleEvent; + function FreeDouble(var AValue: Double): Double; + procedure SetOnFreeDouble(Value: TFreeDoubleEvent); + property OnFreeDouble: TFreeDoubleEvent read GetOnFreeDouble write SetOnFreeDouble; + end; + + TFreeExtendedEvent = function (var AValue: Extended): Extended of object; + + IJclExtendedOwner = interface(IInterface) + ['{4501B203-6784-479D-8A8E-FBE3E1249CCF}'] + function GetOnFreeExtended: TFreeExtendedEvent; + function FreeExtended(var AValue: Extended): Extended; + procedure SetOnFreeExtended(Value: TFreeExtendedEvent); + property OnFreeExtended: TFreeExtendedEvent read GetOnFreeExtended write SetOnFreeExtended; + end; + + {$IFDEF MATH_SINGLE_PRECISION} + TFreeFloatEvent = TFreeSingleEvent; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TFreeFloatEvent = TFreeDoubleEvent; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TFreeFloatEvent = TFreeExtendedEvent; + {$ENDIF MATH_EXTENDED_PRECISION} + + {$IFDEF MATH_SINGLE_PRECISION} + IJclFloatOwner = IJclSingleOwner; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclFloatOwner = IJclDoubleOwner; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + IJclFloatOwner = IJclExtendedOwner; + {$ENDIF MATH_EXTENDED_PRECISION} + + TFreeIntegerEvent = function (var AValue: Integer): Integer of object; + + IJclIntegerOwner = interface(IInterface) + ['{00E37ECB-0FF0-4833-8143-EB7FBEF9E208}'] + function GetOnFreeInteger: TFreeIntegerEvent; + function FreeInteger(var AValue: Integer): Integer; + procedure SetOnFreeInteger(Value: TFreeIntegerEvent); + property OnFreeInteger: TFreeIntegerEvent read GetOnFreeInteger write SetOnFreeInteger; + end; + + TFreeCardinalEvent = function (var AValue: Cardinal): Cardinal of object; + + IJclCardinalOwner = interface(IInterface) + ['{27B3EDEF-0ACD-4592-95F2-52A1DF5E7A39}'] + function GetOnFreeCardinal: TFreeCardinalEvent; + function FreeCardinal(var AValue: Cardinal): Cardinal; + procedure SetOnFreeCardinal(Value: TFreeCardinalEvent); + property OnFreeCardinal: TFreeCardinalEvent read GetOnFreeCardinal write SetOnFreeCardinal; + end; + + TFreeInt64Event = function (var AValue: Int64): Int64 of object; + + IJclInt64Owner = interface(IInterface) + ['{7D4A1375-057A-42B8-8DAA-52DE30058864}'] + function GetOnFreeInt64: TFreeInt64Event; + function FreeInt64(var AValue: Int64): Int64; + procedure SetOnFreeInt64(Value: TFreeInt64Event); + property OnFreeInt64: TFreeInt64Event read GetOnFreeInt64 write SetOnFreeInt64; + end; + + TFreePtrEvent = function (var APtr: Pointer): Pointer of object; + + IJclPtrOwner = interface(IInterface) + ['{28340328-34AD-4632-9BAC-A7387A822200}'] + function GetOnFreePointer: TFreePtrEvent; + function FreePointer(var APtr: Pointer): Pointer; + procedure SetOnFreePointer(Value: TFreePtrEvent); + property OnFreePointer: TFreePtrEvent read GetOnFreePointer write SetOnFreePointer; + end; + + TFreeObjectEvent = function (var AObject: TObject): TObject of object; + + IJclObjectOwner = interface(IInterface) + ['{5157EA13-924E-4A56-995D-36956441025C}'] + function GetOnFreeObject: TFreeObjectEvent; + function FreeObject(var AObject: TObject): TObject; + procedure SetOnFreeObject(Value: TFreeObjectEvent); + property OnFreeObject: TFreeObjectEvent read GetOnFreeObject write SetOnFreeObject; + function GetOwnsObjects: Boolean; + property OwnsObjects: Boolean read GetOwnsObjects; + end; + + + + IJclKeyOwner = interface + ['{8BE209E6-2F85-44FD-B0CD-A8363C95349A}'] + function FreeKey(var Key: TObject): TObject; + function GetOwnsKeys: Boolean; + property OwnsKeys: Boolean read GetOwnsKeys; + end; + + IJclValueOwner = interface + ['{3BCD98CE-7056-416A-A9E7-AE3AB2A62E54}'] + function FreeValue(var Value: TObject): TObject; + function GetOwnsValues: Boolean; + property OwnsValues: Boolean read GetOwnsValues; + end; + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + + TFreeItemEvent = function (var AItem: T): T of object; + + IJclItemOwner = interface(IInterface) + ['{0CC220C1-E705-4B21-9F53-4AD340952165}'] + function GetOnFreeItem: TFreeItemEvent; + function FreeItem(var AItem: T): T; + procedure SetOnFreeItem(Value: TFreeItemEvent); + property OnFreeItem: TFreeItemEvent read GetOnFreeItem write SetOnFreeItem; + + function GetOwnsItems: Boolean; + property OwnsItems: Boolean read GetOwnsItems; + end; + + IJclPairOwner = interface + ['{321C1FF7-AA2E-4229-966A-7EC6417EA16D}'] + function FreeKey(var Key: TKey): TKey; + function FreeValue(var Value: TValue): TValue; + function GetOwnsKeys: Boolean; + function GetOwnsValues: Boolean; + property OwnsKeys: Boolean read GetOwnsKeys; + property OwnsValues: Boolean read GetOwnsValues; + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + IJclIntfIterator = interface(IJclAbstractIterator) + ['{E121A98A-7C43-4587-806B-9189E8B2F106}'] + function Add(const AInterface: IInterface): Boolean; + procedure Extract; + function GetObject: IInterface; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AInterface: IInterface): Boolean; + function IteratorEquals(const AIterator: IJclIntfIterator): Boolean; + function Next: IInterface; + function NextIndex: Integer; + function Previous: IInterface; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetObject(const AInterface: IInterface); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: IInterface read GetObject; + {$ENDIF SUPPORTS_FOR_IN} + end; + + IJclAnsiStrIterator = interface(IJclAbstractIterator) + ['{D5D4B681-F902-49C7-B9E1-73007C9D64F0}'] + function Add(const AString: AnsiString): Boolean; + procedure Extract; + function GetString: AnsiString; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AString: AnsiString): Boolean; + function IteratorEquals(const AIterator: IJclAnsiStrIterator): Boolean; + function Next: AnsiString; + function NextIndex: Integer; + function Previous: AnsiString; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetString(const AString: AnsiString); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: AnsiString read GetString; + {$ENDIF SUPPORTS_FOR_IN} + end; + + IJclWideStrIterator = interface(IJclAbstractIterator) + ['{F03BC7D4-CCDA-4C4A-AF3A-E51FDCDE8ADE}'] + function Add(const AString: WideString): Boolean; + procedure Extract; + function GetString: WideString; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AString: WideString): Boolean; + function IteratorEquals(const AIterator: IJclWideStrIterator): Boolean; + function Next: WideString; + function NextIndex: Integer; + function Previous: WideString; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetString(const AString: WideString); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: WideString read GetString; + {$ENDIF SUPPORTS_FOR_IN} + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclUnicodeStrIterator = interface(IJclAbstractIterator) + ['{B913FFDC-792A-48FB-B58E-763EFDEBA15C}'] + function Add(const AString: UnicodeString): Boolean; + procedure Extract; + function GetString: UnicodeString; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AString: UnicodeString): Boolean; + function IteratorEquals(const AIterator: IJclUnicodeStrIterator): Boolean; + function Next: UnicodeString; + function NextIndex: Integer; + function Previous: UnicodeString; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetString(const AString: UnicodeString); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: UnicodeString read GetString; + {$ENDIF SUPPORTS_FOR_IN} + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + IJclStrIterator = IJclAnsiStrIterator; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclStrIterator = IJclWideStrIterator; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclStrIterator = IJclUnicodeStrIterator; + {$ENDIF CONTAINER_UNICODESTR} + + IJclSingleIterator = interface(IJclAbstractIterator) + ['{FD1124F8-CB2B-4AD7-B12D-C05702F4204B}'] + function Add(const AValue: Single): Boolean; + procedure Extract; + function GetValue: Single; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AValue: Single): Boolean; + function IteratorEquals(const AIterator: IJclSingleIterator): Boolean; + function Next: Single; + function NextIndex: Integer; + function Previous: Single; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(const AValue: Single); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Single read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + IJclDoubleIterator = interface(IJclAbstractIterator) + ['{004C154A-281C-4DA7-BF64-F3EE80ACF640}'] + function Add(const AValue: Double): Boolean; + procedure Extract; + function GetValue: Double; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AValue: Double): Boolean; + function IteratorEquals(const AIterator: IJclDoubleIterator): Boolean; + function Next: Double; + function NextIndex: Integer; + function Previous: Double; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(const AValue: Double); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Double read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + IJclExtendedIterator = interface(IJclAbstractIterator) + ['{B89877A5-DED4-4CD9-AB90-C7D062111DE0}'] + function Add(const AValue: Extended): Boolean; + procedure Extract; + function GetValue: Extended; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AValue: Extended): Boolean; + function IteratorEquals(const AIterator: IJclExtendedIterator): Boolean; + function Next: Extended; + function NextIndex: Integer; + function Previous: Extended; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(const AValue: Extended); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Extended read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + {$IFDEF MATH_SINGLE_PRECISION} + IJclFloatIterator = IJclSingleIterator; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclFloatIterator = IJclDoubleIterator; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + IJclFloatIterator = IJclExtendedIterator; + {$ENDIF MATH_EXTENDED_PRECISION} + + IJclIntegerIterator = interface(IJclAbstractIterator) + ['{1406A991-4574-48A1-83FE-2EDCA03908BE}'] + function Add(AValue: Integer): Boolean; + procedure Extract; + function GetValue: Integer; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(AValue: Integer): Boolean; + function IteratorEquals(const AIterator: IJclIntegerIterator): Boolean; + function Next: Integer; + function NextIndex: Integer; + function Previous: Integer; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(AValue: Integer); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Integer read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + IJclCardinalIterator = interface(IJclAbstractIterator) + ['{72847A34-C8C4-4592-9447-CEB8161E33AD}'] + function Add(AValue: Cardinal): Boolean; + procedure Extract; + function GetValue: Cardinal; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(AValue: Cardinal): Boolean; + function IteratorEquals(const AIterator: IJclCardinalIterator): Boolean; + function Next: Cardinal; + function NextIndex: Integer; + function Previous: Cardinal; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(AValue: Cardinal); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Cardinal read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + IJclInt64Iterator = interface(IJclAbstractIterator) + ['{573E5A51-BF76-43D7-9F93-46305BED20A8}'] + function Add(const AValue: Int64): Boolean; + procedure Extract; + function GetValue: Int64; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AValue: Int64): Boolean; + function IteratorEquals(const AIterator: IJclInt64Iterator): Boolean; + function Next: Int64; + function NextIndex: Integer; + function Previous: Int64; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(const AValue: Int64); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Int64 read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + IJclPtrIterator = interface(IJclAbstractIterator) + ['{62B5501C-07AA-4D00-A85B-713B39912CDF}'] + function Add(APtr: Pointer): Boolean; + procedure Extract; + function GetPointer: Pointer; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(APtr: Pointer): Boolean; + function IteratorEquals(const AIterator: IJclPtrIterator): Boolean; + function Next: Pointer; + function NextIndex: Integer; + function Previous: Pointer; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetPointer(APtr: Pointer); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Pointer read GetPointer; + {$ENDIF SUPPORTS_FOR_IN} + end; + + IJclIterator = interface(IJclAbstractIterator) + ['{997DF9B7-9AA2-4239-8B94-14DFFD26D790}'] + function Add(AObject: TObject): Boolean; + procedure Extract; + function GetObject: TObject; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(AObject: TObject): Boolean; + function IteratorEquals(const AIterator: IJclIterator): Boolean; + function Next: TObject; + function NextIndex: Integer; + function Previous: TObject; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetObject(AObject: TObject); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: TObject read GetObject; + {$ENDIF SUPPORTS_FOR_IN} + end; + + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + IJclIterator = interface(IJclAbstractIterator) + ['{6E8547A4-5B5D-4831-8AE3-9C6D04071B11}'] + function Add(const AItem: T): Boolean; + procedure Extract; + function GetItem: T; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AItem: T): Boolean; + function IteratorEquals(const AIterator: IJclIterator): Boolean; + function Next: T; + function NextIndex: Integer; + function Previous: T; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetItem(const AItem: T); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: T read GetItem; + {$ENDIF SUPPORTS_FOR_IN} + end; + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + IJclIntfTreeIterator = interface(IJclIntfIterator) + ['{C97379BF-C6A9-4A90-9D7A-152E9BAD314F}'] + function AddChild(const AInterface: IInterface): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): IInterface; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(const AInterface: IInterface): Integer; + function InsertChild(Index: Integer; const AInterface: IInterface): Boolean; + function Parent: IInterface; + procedure SetChild(Index: Integer; const AInterface: IInterface); + property Children[Index: Integer]: IInterface read GetChild write SetChild; + end; + + IJclAnsiStrTreeIterator = interface(IJclAnsiStrIterator) + ['{66BC5C76-758C-4E72-ABF1-EB02CF851C6D}'] + function AddChild(const AString: AnsiString): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): AnsiString; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(const AString: AnsiString): Integer; + function InsertChild(Index: Integer; const AString: AnsiString): Boolean; + function Parent: AnsiString; + procedure SetChild(Index: Integer; const AString: AnsiString); + property Children[Index: Integer]: AnsiString read GetChild write SetChild; + end; + + IJclWideStrTreeIterator = interface(IJclWideStrIterator) + ['{B3168A3B-5A90-4ABF-855F-3D2B3AB6EE7F}'] + function AddChild(const AString: WideString): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): WideString; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(const AString: WideString): Integer; + function InsertChild(Index: Integer; const AString: WideString): Boolean; + function Parent: WideString; + procedure SetChild(Index: Integer; const AString: WideString); + property Children[Index: Integer]: WideString read GetChild write SetChild; + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclUnicodeStrTreeIterator = interface(IJclUnicodeStrIterator) + ['{0B0A60DE-0403-4EE1-B1F0-10D849924CF8}'] + function AddChild(const AString: UnicodeString): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): UnicodeString; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(const AString: UnicodeString): Integer; + function InsertChild(Index: Integer; const AString: UnicodeString): Boolean; + function Parent: UnicodeString; + procedure SetChild(Index: Integer; const AString: UnicodeString); + property Children[Index: Integer]: UnicodeString read GetChild write SetChild; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + IJclStrTreeIterator = IJclAnsiStrTreeIterator; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclStrTreeIterator = IJclWideStrTreeIterator; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclStrTreeIterator = IJclUnicodeStrTreeIterator; + {$ENDIF CONTAINER_UNICODESTR} + + IJclSingleTreeIterator = interface(IJclSingleIterator) + ['{17BFDE9D-DBF7-4DC8-AC74-919C717B4726}'] + function AddChild(const AValue: Single): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): Single; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(const AValue: Single): Integer; + function InsertChild(Index: Integer; const AValue: Single): Boolean; + function Parent: Single; + procedure SetChild(Index: Integer; const AValue: Single); + property Children[Index: Integer]: Single read GetChild write SetChild; + end; + + IJclDoubleTreeIterator = interface(IJclDoubleIterator) + ['{EB39B84E-D3C5-496E-A521-B8BF24579252}'] + function AddChild(const AValue: Double): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): Double; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(const AValue: Double): Integer; + function InsertChild(Index: Integer; const AValue: Double): Boolean; + function Parent: Double; + procedure SetChild(Index: Integer; const AValue: Double); + property Children[Index: Integer]: Double read GetChild write SetChild; + end; + + IJclExtendedTreeIterator = interface(IJclExtendedIterator) + ['{1B40A544-FC5D-454C-8E42-CE17B015E65C}'] + function AddChild(const AValue: Extended): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): Extended; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(const AValue: Extended): Integer; + function InsertChild(Index: Integer; const AValue: Extended): Boolean; + function Parent: Extended; + procedure SetChild(Index: Integer; const AValue: Extended); + property Children[Index: Integer]: Extended read GetChild write SetChild; + end; + + {$IFDEF MATH_SINGLE_PRECISION} + IJclFloatTreeIterator = IJclSingleTreeIterator; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclFloatTreeIterator = IJclDoubleTreeIterator; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + IJclFloatTreeIterator = IJclExtendedTreeIterator; + {$ENDIF MATH_EXTENDED_PRECISION} + + IJclIntegerTreeIterator = interface(IJclIntegerIterator) + ['{88EDC5C5-CA41-41AF-9838-AA19D07E69F5}'] + function AddChild(AValue: Integer): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): Integer; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(AValue: Integer): Integer; + function InsertChild(Index: Integer; AValue: Integer): Boolean; + function Parent: Integer; + procedure SetChild(Index: Integer; AValue: Integer); + property Children[Index: Integer]: Integer read GetChild write SetChild; + end; + + IJclCardinalTreeIterator = interface(IJclCardinalIterator) + ['{FDBF493F-F79D-46EB-A59D-7193B6E6A860}'] + function AddChild(AValue: Cardinal): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): Cardinal; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(AValue: Cardinal): Integer; + function InsertChild(Index: Integer; AValue: Cardinal): Boolean; + function Parent: Cardinal; + procedure SetChild(Index: Integer; AValue: Cardinal); + property Children[Index: Integer]: Cardinal read GetChild write SetChild; + end; + + IJclInt64TreeIterator = interface(IJclInt64Iterator) + ['{C5A5E504-E19B-43AC-90B9-E4B8984BFA23}'] + function AddChild(const AValue: Int64): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): Int64; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(const AValue: Int64): Integer; + function InsertChild(Index: Integer; const AValue: Int64): Boolean; + function Parent: Int64; + procedure SetChild(Index: Integer; const AValue: Int64); + property Children[Index: Integer]: Int64 read GetChild write SetChild; + end; + + IJclPtrTreeIterator = interface(IJclPtrIterator) + ['{ED4C08E6-60FC-4ED3-BD19-E6605B9BD943}'] + function AddChild(APtr: Pointer): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): Pointer; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(APtr: Pointer): Integer; + function InsertChild(Index: Integer; APtr: Pointer): Boolean; + function Parent: Pointer; + procedure SetChild(Index: Integer; APtr: Pointer); + property Children[Index: Integer]: Pointer read GetChild write SetChild; + end; + + IJclTreeIterator = interface(IJclIterator) + ['{8B4863B0-B6B9-426E-B5B8-7AF71D264237}'] + function AddChild(AObject: TObject): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): TObject; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(AObject: TObject): Integer; + function InsertChild(Index: Integer; AObject: TObject): Boolean; + function Parent: TObject; + procedure SetChild(Index: Integer; AObject: TObject); + property Children[Index: Integer]: TObject read GetChild write SetChild; + end; + + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + IJclTreeIterator = interface(IJclIterator) + ['{29A06DA4-D93A-40A5-8581-0FE85BC8384B}'] + function AddChild(const AItem: T): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): T; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(const AItem: T): Integer; + function InsertChild(Index: Integer; const AItem: T): Boolean; + function Parent: T; + procedure SetChild(Index: Integer; const AItem: T); + property Children[Index: Integer]: T read GetChild write SetChild; + end; + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + IJclIntfBinaryTreeIterator = interface(IJclIntfTreeIterator) + ['{8BE874B2-0075-4EE0-8F49-665FC894D923}'] + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: IInterface; + function Right: IInterface; + end; + + IJclAnsiStrBinaryTreeIterator = interface(IJclAnsiStrTreeIterator) + ['{34A4A300-042C-43A9-AC23-8FC1B76BFB25}'] + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: AnsiString; + function Right: AnsiString; + end; + + IJclWideStrBinaryTreeIterator = interface(IJclWideStrTreeIterator) + ['{17C08EB9-6880-469E-878A-8F5EBFE905B1}'] + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: WideString; + function Right: WideString; + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclUnicodeStrBinaryTreeIterator = interface(IJclUnicodeStrTreeIterator) + ['{CA32B126-AD4B-4C33-BC47-52B09FE093BE}'] + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: UnicodeString; + function Right: UnicodeString; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + IJclStrBinaryTreeIterator = IJclAnsiStrBinaryTreeIterator; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclStrBinaryTreeIterator = IJclWideStrBinaryTreeIterator; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclStrBinaryTreeIterator = IJclUnicodeStrBinaryTreeIterator; + {$ENDIF CONTAINER_UNICODESTR} + + IJclSingleBinaryTreeIterator = interface(IJclSingleTreeIterator) + ['{BC6FFB13-FA1C-4077-8273-F25A3119168B}'] + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: Single; + function Right: Single; + end; + + IJclDoubleBinaryTreeIterator = interface(IJclDoubleTreeIterator) + ['{CE48083C-D60C-4315-BC14-8CE77AC3269E}'] + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: Double; + function Right: Double; + end; + + IJclExtendedBinaryTreeIterator = interface(IJclExtendedTreeIterator) + ['{8A9FAE2A-5EF5-4165-8E8D-51F2102A4580}'] + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: Extended; + function Right: Extended; + end; + + {$IFDEF MATH_SINGLE_PRECISION} + IJclFloatBinaryTreeIterator = IJclSingleBinaryTreeIterator; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclFloatBinaryTreeIterator = IJclDoubleBinaryTreeIterator; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + IJclFloatBinaryTreeIterator = IJclExtendedBinaryTreeIterator; + {$ENDIF MATH_EXTENDED_PRECISION} + + IJclIntegerBinaryTreeIterator = interface(IJclIntegerTreeIterator) + ['{FE2BF57D-D10D-4B0C-903D-BB61700FBA0A}'] + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: Integer; + function Right: Integer; + end; + + IJclCardinalBinaryTreeIterator = interface(IJclCardinalTreeIterator) + ['{AAA358F5-95A1-480F-8E2A-09028BA6C397}'] + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: Cardinal; + function Right: Cardinal; + end; + + IJclInt64BinaryTreeIterator = interface(IJclInt64TreeIterator) + ['{5605E164-5CDD-40B1-9323-DE1CB584E289}'] + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: Int64; + function Right: Int64; + end; + + IJclPtrBinaryTreeIterator = interface(IJclPtrTreeIterator) + ['{75D3DF0D-C491-43F7-B078-E658197E8051}'] + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: Pointer; + function Right: Pointer; + end; + + IJclBinaryTreeIterator = interface(IJclTreeIterator) + ['{821DE28D-631C-4F23-A0B2-CC0F35B4C64D}'] + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: TObject; + function Right: TObject; + end; + + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + IJclBinaryTreeIterator = interface(IJclTreeIterator) + ['{0CF5B0FC-C644-458C-BF48-2E093DAFEC26}'] + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: T; + function Right: T; + end; + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + IJclIntfCollection = interface(IJclIntfFlatContainer) + ['{8E178463-4575-487A-B4D5-DC2AED3C7ACA}'] + function Add(const AInterface: IInterface): Boolean; + function AddAll(const ACollection: IJclIntfCollection): Boolean; + procedure Clear; + function Contains(const AInterface: IInterface): Boolean; + function ContainsAll(const ACollection: IJclIntfCollection): Boolean; + function CollectionEquals(const ACollection: IJclIntfCollection): Boolean; + function Extract(const AInterface: IInterface): Boolean; + function ExtractAll(const ACollection: IJclIntfCollection): Boolean; + function First: IJclIntfIterator; + function IsEmpty: Boolean; + function Last: IJclIntfIterator; + function Remove(const AInterface: IInterface): Boolean; + function RemoveAll(const ACollection: IJclIntfCollection): Boolean; + function RetainAll(const ACollection: IJclIntfCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIntfIterator; + {$ENDIF SUPPORTS_FOR_IN} + end; + + IJclAnsiStrCollection = interface(IJclAnsiStrFlatContainer) + ['{3E3CFC19-E8AF-4DD7-91FA-2DF2895FC7B9}'] + function Add(const AString: AnsiString): Boolean; + function AddAll(const ACollection: IJclAnsiStrCollection): Boolean; + procedure Clear; + function Contains(const AString: AnsiString): Boolean; + function ContainsAll(const ACollection: IJclAnsiStrCollection): Boolean; + function CollectionEquals(const ACollection: IJclAnsiStrCollection): Boolean; + function Extract(const AString: AnsiString): Boolean; + function ExtractAll(const ACollection: IJclAnsiStrCollection): Boolean; + function First: IJclAnsiStrIterator; + function IsEmpty: Boolean; + function Last: IJclAnsiStrIterator; + function Remove(const AString: AnsiString): Boolean; + function RemoveAll(const ACollection: IJclAnsiStrCollection): Boolean; + function RetainAll(const ACollection: IJclAnsiStrCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclAnsiStrIterator; + {$ENDIF SUPPORTS_FOR_IN} + end; + + IJclWideStrCollection = interface(IJclWideStrFlatContainer) + ['{CDCC0F94-4DD0-4F25-B441-6AE55D5C7466}'] + function Add(const AString: WideString): Boolean; + function AddAll(const ACollection: IJclWideStrCollection): Boolean; + procedure Clear; + function Contains(const AString: WideString): Boolean; + function ContainsAll(const ACollection: IJclWideStrCollection): Boolean; + function CollectionEquals(const ACollection: IJclWideStrCollection): Boolean; + function Extract(const AString: WideString): Boolean; + function ExtractAll(const ACollection: IJclWideStrCollection): Boolean; + function First: IJclWideStrIterator; + function IsEmpty: Boolean; + function Last: IJclWideStrIterator; + function Remove(const AString: WideString): Boolean; + function RemoveAll(const ACollection: IJclWideStrCollection): Boolean; + function RetainAll(const ACollection: IJclWideStrCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclWideStrIterator; + {$ENDIF SUPPORTS_FOR_IN} + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclUnicodeStrCollection = interface(IJclUnicodeStrFlatContainer) + ['{82EA7DDE-4EBF-4E0D-A380-CAF8A24C1A0D}'] + function Add(const AString: UnicodeString): Boolean; + function AddAll(const ACollection: IJclUnicodeStrCollection): Boolean; + procedure Clear; + function Contains(const AString: UnicodeString): Boolean; + function ContainsAll(const ACollection: IJclUnicodeStrCollection): Boolean; + function CollectionEquals(const ACollection: IJclUnicodeStrCollection): Boolean; + function Extract(const AString: UnicodeString): Boolean; + function ExtractAll(const ACollection: IJclUnicodeStrCollection): Boolean; + function First: IJclUnicodeStrIterator; + function IsEmpty: Boolean; + function Last: IJclUnicodeStrIterator; + function Remove(const AString: UnicodeString): Boolean; + function RemoveAll(const ACollection: IJclUnicodeStrCollection): Boolean; + function RetainAll(const ACollection: IJclUnicodeStrCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclUnicodeStrIterator; + {$ENDIF SUPPORTS_FOR_IN} + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + IJclStrCollection = IJclAnsiStrCollection; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclStrCollection = IJclWideStrCollection; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclStrCollection = IJclUnicodeStrCollection; + {$ENDIF CONTAINER_UNICODESTR} + + IJclSingleCollection = interface(IJclSingleFlatContainer) + ['{1D34D474-6588-441E-B2B3-8C021A37ED89}'] + function Add(const AValue: Single): Boolean; + function AddAll(const ACollection: IJclSingleCollection): Boolean; + procedure Clear; + function Contains(const AValue: Single): Boolean; + function ContainsAll(const ACollection: IJclSingleCollection): Boolean; + function CollectionEquals(const ACollection: IJclSingleCollection): Boolean; + function Extract(const AValue: Single): Boolean; + function ExtractAll(const ACollection: IJclSingleCollection): Boolean; + function First: IJclSingleIterator; + function IsEmpty: Boolean; + function Last: IJclSingleIterator; + function Remove(const AValue: Single): Boolean; + function RemoveAll(const ACollection: IJclSingleCollection): Boolean; + function RetainAll(const ACollection: IJclSingleCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclSingleIterator; + {$ENDIF SUPPORTS_FOR_IN} + end; + + IJclDoubleCollection = interface(IJclDoubleFlatContainer) + ['{E54C7717-C33A-4F1B-860C-4F60F303EAD3}'] + function Add(const AValue: Double): Boolean; + function AddAll(const ACollection: IJclDoubleCollection): Boolean; + procedure Clear; + function Contains(const AValue: Double): Boolean; + function ContainsAll(const ACollection: IJclDoubleCollection): Boolean; + function CollectionEquals(const ACollection: IJclDoubleCollection): Boolean; + function Extract(const AValue: Double): Boolean; + function ExtractAll(const ACollection: IJclDoubleCollection): Boolean; + function First: IJclDoubleIterator; + function IsEmpty: Boolean; + function Last: IJclDoubleIterator; + function Remove(const AValue: Double): Boolean; + function RemoveAll(const ACollection: IJclDoubleCollection): Boolean; + function RetainAll(const ACollection: IJclDoubleCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclDoubleIterator; + {$ENDIF SUPPORTS_FOR_IN} + end; + + IJclExtendedCollection = interface(IJclExtendedFlatContainer) + ['{2A1341CB-B997-4E3B-B1CA-6D60AE853C55}'] + function Add(const AValue: Extended): Boolean; + function AddAll(const ACollection: IJclExtendedCollection): Boolean; + procedure Clear; + function Contains(const AValue: Extended): Boolean; + function ContainsAll(const ACollection: IJclExtendedCollection): Boolean; + function CollectionEquals(const ACollection: IJclExtendedCollection): Boolean; + function Extract(const AValue: Extended): Boolean; + function ExtractAll(const ACollection: IJclExtendedCollection): Boolean; + function First: IJclExtendedIterator; + function IsEmpty: Boolean; + function Last: IJclExtendedIterator; + function Remove(const AValue: Extended): Boolean; + function RemoveAll(const ACollection: IJclExtendedCollection): Boolean; + function RetainAll(const ACollection: IJclExtendedCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclExtendedIterator; + {$ENDIF SUPPORTS_FOR_IN} + end; + + {$IFDEF MATH_SINGLE_PRECISION} + IJclFloatCollection = IJclSingleCollection; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclFloatCollection = IJclDoubleCollection; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + IJclFloatCollection = IJclExtendedCollection; + {$ENDIF MATH_EXTENDED_PRECISION} + + IJclIntegerCollection = interface(IJclIntegerFlatContainer) + ['{AF69890D-22D1-4D89-8FFD-5FAD7E0638BA}'] + function Add(AValue: Integer): Boolean; + function AddAll(const ACollection: IJclIntegerCollection): Boolean; + procedure Clear; + function Contains(AValue: Integer): Boolean; + function ContainsAll(const ACollection: IJclIntegerCollection): Boolean; + function CollectionEquals(const ACollection: IJclIntegerCollection): Boolean; + function Extract(AValue: Integer): Boolean; + function ExtractAll(const ACollection: IJclIntegerCollection): Boolean; + function First: IJclIntegerIterator; + function IsEmpty: Boolean; + function Last: IJclIntegerIterator; + function Remove(AValue: Integer): Boolean; + function RemoveAll(const ACollection: IJclIntegerCollection): Boolean; + function RetainAll(const ACollection: IJclIntegerCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIntegerIterator; + {$ENDIF SUPPORTS_FOR_IN} + end; + + IJclCardinalCollection = interface(IJclCardinalFlatContainer) + ['{CFBD0344-58C8-4FA2-B4D7-D21D77DFBF80}'] + function Add(AValue: Cardinal): Boolean; + function AddAll(const ACollection: IJclCardinalCollection): Boolean; + procedure Clear; + function Contains(AValue: Cardinal): Boolean; + function ContainsAll(const ACollection: IJclCardinalCollection): Boolean; + function CollectionEquals(const ACollection: IJclCardinalCollection): Boolean; + function Extract(AValue: Cardinal): Boolean; + function ExtractAll(const ACollection: IJclCardinalCollection): Boolean; + function First: IJclCardinalIterator; + function IsEmpty: Boolean; + function Last: IJclCardinalIterator; + function Remove(AValue: Cardinal): Boolean; + function RemoveAll(const ACollection: IJclCardinalCollection): Boolean; + function RetainAll(const ACollection: IJclCardinalCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclCardinalIterator; + {$ENDIF SUPPORTS_FOR_IN} + end; + + IJclInt64Collection = interface(IJclInt64FlatContainer) + ['{93A45BDE-3C4C-48D6-9874-5322914DFDDA}'] + function Add(const AValue: Int64): Boolean; + function AddAll(const ACollection: IJclInt64Collection): Boolean; + procedure Clear; + function Contains(const AValue: Int64): Boolean; + function ContainsAll(const ACollection: IJclInt64Collection): Boolean; + function CollectionEquals(const ACollection: IJclInt64Collection): Boolean; + function Extract(const AValue: Int64): Boolean; + function ExtractAll(const ACollection: IJclInt64Collection): Boolean; + function First: IJclInt64Iterator; + function IsEmpty: Boolean; + function Last: IJclInt64Iterator; + function Remove(const AValue: Int64): Boolean; + function RemoveAll(const ACollection: IJclInt64Collection): Boolean; + function RetainAll(const ACollection: IJclInt64Collection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclInt64Iterator; + {$ENDIF SUPPORTS_FOR_IN} + end; + + IJclPtrCollection = interface(IJclPtrFlatContainer) + ['{02E909A7-5B1D-40D4-82EA-A0CD97D5C811}'] + function Add(APtr: Pointer): Boolean; + function AddAll(const ACollection: IJclPtrCollection): Boolean; + procedure Clear; + function Contains(APtr: Pointer): Boolean; + function ContainsAll(const ACollection: IJclPtrCollection): Boolean; + function CollectionEquals(const ACollection: IJclPtrCollection): Boolean; + function Extract(APtr: Pointer): Boolean; + function ExtractAll(const ACollection: IJclPtrCollection): Boolean; + function First: IJclPtrIterator; + function IsEmpty: Boolean; + function Last: IJclPtrIterator; + function Remove(APtr: Pointer): Boolean; + function RemoveAll(const ACollection: IJclPtrCollection): Boolean; + function RetainAll(const ACollection: IJclPtrCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclPtrIterator; + {$ENDIF SUPPORTS_FOR_IN} + end; + + IJclCollection = interface(IJclFlatContainer) + ['{58947EF1-CD21-4DD1-AE3D-225C3AAD7EE5}'] + function Add(AObject: TObject): Boolean; + function AddAll(const ACollection: IJclCollection): Boolean; + procedure Clear; + function Contains(AObject: TObject): Boolean; + function ContainsAll(const ACollection: IJclCollection): Boolean; + function CollectionEquals(const ACollection: IJclCollection): Boolean; + function Extract(AObject: TObject): Boolean; + function ExtractAll(const ACollection: IJclCollection): Boolean; + function First: IJclIterator; + function IsEmpty: Boolean; + function Last: IJclIterator; + function Remove(AObject: TObject): Boolean; + function RemoveAll(const ACollection: IJclCollection): Boolean; + function RetainAll(const ACollection: IJclCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIterator; + {$ENDIF SUPPORTS_FOR_IN} + end; + + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + IJclCollection = interface(IJclBaseContainer) + ['{67EE8AF3-19B0-4DCA-A730-3C9B261B8EC5}'] + function Add(const AItem: T): Boolean; + function AddAll(const ACollection: IJclCollection): Boolean; + procedure Clear; + function Contains(const AItem: T): Boolean; + function ContainsAll(const ACollection: IJclCollection): Boolean; + function CollectionEquals(const ACollection: IJclCollection): Boolean; + function Extract(const AItem: T): Boolean; + function ExtractAll(const ACollection: IJclCollection): Boolean; + function First: IJclIterator; + function IsEmpty: Boolean; + function Last: IJclIterator; + function Remove(const AItem: T): Boolean; + function RemoveAll(const ACollection: IJclCollection): Boolean; + function RetainAll(const ACollection: IJclCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIterator; + {$ENDIF SUPPORTS_FOR_IN} + end; + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + IJclIntfList = interface(IJclIntfCollection) + ['{E14EDA4B-1DAA-4013-9E6C-CDCB365C7CF9}'] + function Delete(Index: Integer): IInterface; + function ExtractIndex(Index: Integer): IInterface; + function GetObject(Index: Integer): IInterface; + function IndexOf(const AInterface: IInterface): Integer; + function Insert(Index: Integer; const AInterface: IInterface): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclIntfCollection): Boolean; + function LastIndexOf(const AInterface: IInterface): Integer; + procedure SetObject(Index: Integer; const AInterface: IInterface); + function SubList(First, Count: Integer): IJclIntfList; + property Objects[Key: Integer]: IInterface read GetObject write SetObject; default; + end; + + IJclAnsiStrList = interface(IJclAnsiStrCollection) + ['{07DD7644-EAC6-4059-99FC-BEB7FBB73186}'] + function Delete(Index: Integer): AnsiString; + function ExtractIndex(Index: Integer): AnsiString; + function GetString(Index: Integer): AnsiString; + function IndexOf(const AString: AnsiString): Integer; + function Insert(Index: Integer; const AString: AnsiString): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclAnsiStrCollection): Boolean; + function LastIndexOf(const AString: AnsiString): Integer; + procedure SetString(Index: Integer; const AString: AnsiString); + function SubList(First, Count: Integer): IJclAnsiStrList; + property Strings[Key: Integer]: AnsiString read GetString write SetString; default; + end; + + IJclWideStrList = interface(IJclWideStrCollection) + ['{C9955874-6AC0-4CE0-8CC0-606A3F1702C6}'] + function Delete(Index: Integer): WideString; + function ExtractIndex(Index: Integer): WideString; + function GetString(Index: Integer): WideString; + function IndexOf(const AString: WideString): Integer; + function Insert(Index: Integer; const AString: WideString): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclWideStrCollection): Boolean; + function LastIndexOf(const AString: WideString): Integer; + procedure SetString(Index: Integer; const AString: WideString); + function SubList(First, Count: Integer): IJclWideStrList; + property Strings[Key: Integer]: WideString read GetString write SetString; default; + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclUnicodeStrList = interface(IJclUnicodeStrCollection) + ['{F4307EB4-D66E-4656-AC56-50883D0F2C83}'] + function Delete(Index: Integer): UnicodeString; + function ExtractIndex(Index: Integer): UnicodeString; + function GetString(Index: Integer): UnicodeString; + function IndexOf(const AString: UnicodeString): Integer; + function Insert(Index: Integer; const AString: UnicodeString): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclUnicodeStrCollection): Boolean; + function LastIndexOf(const AString: UnicodeString): Integer; + procedure SetString(Index: Integer; const AString: UnicodeString); + function SubList(First, Count: Integer): IJclUnicodeStrList; + property Strings[Key: Integer]: UnicodeString read GetString write SetString; default; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + IJclStrList = IJclAnsiStrList; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclStrList = IJclWideStrList; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclStrList = IJclUnicodeStrList; + {$ENDIF CONTAINER_UNICODESTR} + + IJclSingleList = interface(IJclSingleCollection) + ['{D081324C-70A4-4AAC-BA42-7557F0262826}'] + function Delete(Index: Integer): Single; + function ExtractIndex(Index: Integer): Single; + function GetValue(Index: Integer): Single; + function IndexOf(const AValue: Single): Integer; + function Insert(Index: Integer; const AValue: Single): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclSingleCollection): Boolean; + function LastIndexOf(const AValue: Single): Integer; + procedure SetValue(Index: Integer; const AValue: Single); + function SubList(First, Count: Integer): IJclSingleList; + property Values[Key: Integer]: Single read GetValue write SetValue; default; + end; + + IJclDoubleList = interface(IJclDoubleCollection) + ['{ECA58515-3903-4312-9486-3214E03F35AB}'] + function Delete(Index: Integer): Double; + function ExtractIndex(Index: Integer): Double; + function GetValue(Index: Integer): Double; + function IndexOf(const AValue: Double): Integer; + function Insert(Index: Integer; const AValue: Double): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclDoubleCollection): Boolean; + function LastIndexOf(const AValue: Double): Integer; + procedure SetValue(Index: Integer; const AValue: Double); + function SubList(First, Count: Integer): IJclDoubleList; + property Values[Key: Integer]: Double read GetValue write SetValue; default; + end; + + IJclExtendedList = interface(IJclExtendedCollection) + ['{7463F954-F8DF-4B02-A284-FCB98746248E}'] + function Delete(Index: Integer): Extended; + function ExtractIndex(Index: Integer): Extended; + function GetValue(Index: Integer): Extended; + function IndexOf(const AValue: Extended): Integer; + function Insert(Index: Integer; const AValue: Extended): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclExtendedCollection): Boolean; + function LastIndexOf(const AValue: Extended): Integer; + procedure SetValue(Index: Integer; const AValue: Extended); + function SubList(First, Count: Integer): IJclExtendedList; + property Values[Key: Integer]: Extended read GetValue write SetValue; default; + end; + + {$IFDEF MATH_SINGLE_PRECISION} + IJclFloatList = IJclSingleList; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclFloatList = IJclDoubleList; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + IJclFloatList = IJclExtendedList; + {$ENDIF MATH_EXTENDED_PRECISION} + + IJclIntegerList = interface(IJclIntegerCollection) + ['{339BE91B-557D-4CE0-A854-1CBD4FE31725}'] + function Delete(Index: Integer): Integer; + function ExtractIndex(Index: Integer): Integer; + function GetValue(Index: Integer): Integer; + function IndexOf(AValue: Integer): Integer; + function Insert(Index: Integer; AValue: Integer): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclIntegerCollection): Boolean; + function LastIndexOf(AValue: Integer): Integer; + procedure SetValue(Index: Integer; AValue: Integer); + function SubList(First, Count: Integer): IJclIntegerList; + property Values[Key: Integer]: Integer read GetValue write SetValue; default; + end; + + IJclCardinalList = interface(IJclCardinalCollection) + ['{02B09EA8-DE6F-4A18-AA57-C3533E6AC4E3}'] + function Delete(Index: Integer): Cardinal; + function ExtractIndex(Index: Integer): Cardinal; + function GetValue(Index: Integer): Cardinal; + function IndexOf(AValue: Cardinal): Integer; + function Insert(Index: Integer; AValue: Cardinal): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclCardinalCollection): Boolean; + function LastIndexOf(AValue: Cardinal): Integer; + procedure SetValue(Index: Integer; AValue: Cardinal); + function SubList(First, Count: Integer): IJclCardinalList; + property Values[Key: Integer]: Cardinal read GetValue write SetValue; default; + end; + + IJclInt64List = interface(IJclInt64Collection) + ['{E8D49200-91D3-4BD0-A59B-B93EC7E2074B}'] + function Delete(Index: Integer): Int64; + function ExtractIndex(Index: Integer): Int64; + function GetValue(Index: Integer): Int64; + function IndexOf(const AValue: Int64): Integer; + function Insert(Index: Integer; const AValue: Int64): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclInt64Collection): Boolean; + function LastIndexOf(const AValue: Int64): Integer; + procedure SetValue(Index: Integer; const AValue: Int64); + function SubList(First, Count: Integer): IJclInt64List; + property Values[Key: Integer]: Int64 read GetValue write SetValue; default; + end; + + IJclPtrList = interface(IJclPtrCollection) + ['{2CF5CF1F-C012-480C-A4CE-38BDAFB15D05}'] + function Delete(Index: Integer): Pointer; + function ExtractIndex(Index: Integer): Pointer; + function GetPointer(Index: Integer): Pointer; + function IndexOf(APtr: Pointer): Integer; + function Insert(Index: Integer; APtr: Pointer): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclPtrCollection): Boolean; + function LastIndexOf(APtr: Pointer): Integer; + procedure SetPointer(Index: Integer; APtr: Pointer); + function SubList(First, Count: Integer): IJclPtrList; + property Pointers[Key: Integer]: Pointer read GetPointer write SetPointer; default; + end; + + IJclList = interface(IJclCollection) + ['{8ABC70AC-5C06-43EA-AFE0-D066379BCC28}'] + function Delete(Index: Integer): TObject; + function ExtractIndex(Index: Integer): TObject; + function GetObject(Index: Integer): TObject; + function IndexOf(AObject: TObject): Integer; + function Insert(Index: Integer; AObject: TObject): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclCollection): Boolean; + function LastIndexOf(AObject: TObject): Integer; + procedure SetObject(Index: Integer; AObject: TObject); + function SubList(First, Count: Integer): IJclList; + property Objects[Key: Integer]: TObject read GetObject write SetObject; default; + end; + + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + IJclList = interface(IJclCollection) + ['{3B4BE3D7-8FF7-4163-91DF-3F73AE6935E7}'] + function Delete(Index: Integer): T; + function ExtractIndex(Index: Integer): T; + function GetItem(Index: Integer): T; + function IndexOf(const AItem: T): Integer; + function Insert(Index: Integer; const AItem: T): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclCollection): Boolean; + function LastIndexOf(const AItem: T): Integer; + procedure SetItem(Index: Integer; const AItem: T); + function SubList(First, Count: Integer): IJclList; + property Items[Key: Integer]: T read GetItem write SetItem; default; + end; + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + // Pointer functions for sort algorithms + TIntfSortProc = procedure(const AList: IJclIntfList; L, R: Integer; AComparator: TIntfCompare); + TAnsiStrSortProc = procedure(const AList: IJclAnsiStrList; L, R: Integer; AComparator: TAnsiStrCompare); + TWideStrSortProc = procedure(const AList: IJclWideStrList; L, R: Integer; AComparator: TWideStrCompare); + {$IFDEF SUPPORTS_UNICODE_STRING} + TUnicodeStrSortProc = procedure(const AList: IJclUnicodeStrList; L, R: Integer; AComparator: TUnicodeStrCompare); + {$ENDIF SUPPORTS_UNICODE_STRING} + {$IFDEF CONTAINER_ANSISTR} + TStrSortProc = TAnsiStrSortProc; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TStrSortProc = TWideStrSortProc; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TStrSortProc = TUnicodeStrSortProc; + {$ENDIF CONTAINER_UNICODESTR} + TSingleSortProc = procedure(const AList: IJclSingleList; L, R: Integer; AComparator: TSingleCompare); + TDoubleSortProc = procedure(const AList: IJclDoubleList; L, R: Integer; AComparator: TDoubleCompare); + TExtendedSortProc = procedure(const AList: IJclExtendedList; L, R: Integer; AComparator: TExtendedCompare); + {$IFDEF MATH_SINGLE_PRECISION} + TFloatSortProc = TSingleSortProc; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TFloatSortProc = TDoubleSortProc; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TFloatSortProc = TExtendedSortProc; + {$ENDIF MATH_EXTENDED_PRECISION} + TIntegerSortProc = procedure(const AList: IJclIntegerList; L, R: Integer; AComparator: TIntegerCompare); + TCardinalSortProc = procedure(const AList: IJclCardinalList; L, R: Integer; AComparator: TCardinalCompare); + TInt64SortProc = procedure(const AList: IJclInt64List; L, R: Integer; AComparator: TInt64Compare); + TPtrSortProc = procedure(const AList: IJclPtrList; L, R: Integer; AComparator: TPtrCompare); + TSortProc = procedure(const AList: IJclList; L, R: Integer; AComparator: TCompare); + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + TSortProc = procedure(const AList: IJclList; L, R: Integer; AComparator: TCompare); + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + IJclIntfArray = interface(IJclIntfList) + ['{B055B427-7817-43FC-97D4-AD1845643D63}'] + function GetObject(Index: Integer): IInterface; + procedure SetObject(Index: Integer; const AInterface: IInterface); + property Objects[Index: Integer]: IInterface read GetObject write SetObject; default; + end; + + IJclAnsiStrArray = interface(IJclAnsiStrList) + ['{4953EA83-9288-4537-9D10-544D1C992B62}'] + function GetString(Index: Integer): AnsiString; + procedure SetString(Index: Integer; const AString: AnsiString); + property Strings[Index: Integer]: AnsiString read GetString write SetString; default; + end; + + IJclWideStrArray = interface(IJclWideStrList) + ['{3CE09F9A-5CB4-4867-80D5-C2313D278D69}'] + function GetString(Index: Integer): WideString; + procedure SetString(Index: Integer; const AString: WideString); + property Strings[Index: Integer]: WideString read GetString write SetString; default; + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclUnicodeStrArray = interface(IJclUnicodeStrList) + ['{24312E5B-B61D-485C-9E57-AC36C93D8159}'] + function GetString(Index: Integer): UnicodeString; + procedure SetString(Index: Integer; const AString: UnicodeString); + property Strings[Index: Integer]: UnicodeString read GetString write SetString; default; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + IJclStrArray = IJclAnsiStrArray; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclStrArray = IJclWideStrArray; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclStrArray = IJclUnicodeStrArray; + {$ENDIF CONTAINER_UNICODESTR} + + IJclSingleArray = interface(IJclSingleList) + ['{B96E2A4D-D750-4B65-B975-C619A05A29F6}'] + function GetValue(Index: Integer): Single; + procedure SetValue(Index: Integer; const AValue: Single); + property Values[Index: Integer]: Single read GetValue write SetValue; default; + end; + + IJclDoubleArray = interface(IJclDoubleList) + ['{67E66324-9757-4E85-8ECD-53396910FB39}'] + function GetValue(Index: Integer): Double; + procedure SetValue(Index: Integer; const AValue: Double); + property Values[Index: Integer]: Double read GetValue write SetValue; default; + end; + + IJclExtendedArray = interface(IJclExtendedList) + ['{A3693A89-3E57-41B3-9A92-F6CBB64F89AB}'] + function GetValue(Index: Integer): Extended; + procedure SetValue(Index: Integer; const AValue: Extended); + property Values[Index: Integer]: Extended read GetValue write SetValue; default; + end; + + {$IFDEF MATH_SINGLE_PRECISION} + IJclFloatArray = IJclSingleArray; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclFloatArray = IJclDoubleArray; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + IJclFloatArray = IJclExtendedArray; + {$ENDIF MATH_EXTENDED_PRECISION} + + IJclIntegerArray = interface(IJclIntegerList) + ['{2B7C8B33-C0BD-4EC3-9764-63866E174781}'] + function GetValue(Index: Integer): Integer; + procedure SetValue(Index: Integer; AValue: Integer); + property Values[Index: Integer]: Integer read GetValue write SetValue; default; + end; + + IJclCardinalArray = interface(IJclCardinalList) + ['{C451F2F8-65C6-4C29-99A0-CC9C15356418}'] + function GetValue(Index: Integer): Cardinal; + procedure SetValue(Index: Integer; AValue: Cardinal); + property Values[Index: Integer]: Cardinal read GetValue write SetValue; default; + end; + + IJclInt64Array = interface(IJclInt64List) + ['{D947C43D-2D04-442A-A707-39EDE7D96FC9}'] + function GetValue(Index: Integer): Int64; + procedure SetValue(Index: Integer; const AValue: Int64); + property Values[Index: Integer]: Int64 read GetValue write SetValue; default; + end; + + IJclPtrArray = interface(IJclPtrList) + ['{D43E8D18-26B3-41A2-8D52-ED7EA2FE1AB7}'] + function GetPointer(Index: Integer): Pointer; + procedure SetPointer(Index: Integer; APtr: Pointer); + property Pointers[Index: Integer]: Pointer read GetPointer write SetPointer; default; + end; + + IJclArray = interface(IJclList) + ['{A69F6D35-54B2-4361-852E-097ED75E648A}'] + function GetObject(Index: Integer): TObject; + procedure SetObject(Index: Integer; AObject: TObject); + property Objects[Index: Integer]: TObject read GetObject write SetObject; default; + end; + + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + IJclArray = interface(IJclList) + ['{38810C13-E35E-428A-B84F-D25FB994BE8E}'] + function GetItem(Index: Integer): T; + procedure SetItem(Index: Integer; const AItem: T); + property Items[Index: Integer]: T read GetItem write SetItem; default; + end; + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + IJclIntfSet = interface(IJclIntfCollection) + ['{E2D28852-9774-49B7-A739-5DBA2B705924}'] + procedure Intersect(const ACollection: IJclIntfCollection); + procedure Subtract(const ACollection: IJclIntfCollection); + procedure Union(const ACollection: IJclIntfCollection); + end; + + IJclAnsiStrSet = interface(IJclAnsiStrCollection) + ['{72204D85-2B68-4914-B9F2-09E5180C12E9}'] + procedure Intersect(const ACollection: IJclAnsiStrCollection); + procedure Subtract(const ACollection: IJclAnsiStrCollection); + procedure Union(const ACollection: IJclAnsiStrCollection); + end; + + IJclWideStrSet = interface(IJclWideStrCollection) + ['{08009E0A-ABDD-46AB-8CEE-407D4723E17C}'] + procedure Intersect(const ACollection: IJclWideStrCollection); + procedure Subtract(const ACollection: IJclWideStrCollection); + procedure Union(const ACollection: IJclWideStrCollection); + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclUnicodeStrSet = interface(IJclUnicodeStrCollection) + ['{440E9BCB-341F-40B6-8AED-479B2E98C92A}'] + procedure Intersect(const ACollection: IJclUnicodeStrCollection); + procedure Subtract(const ACollection: IJclUnicodeStrCollection); + procedure Union(const ACollection: IJclUnicodeStrCollection); + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + IJclStrSet = IJclAnsiStrSet; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclStrSet = IJclWideStrSet; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclStrSet = IJclUnicodeStrSet; + {$ENDIF CONTAINER_UNICODESTR} + + IJclSingleSet = interface(IJclSingleCollection) + ['{36E34A78-6A29-4503-97D5-4BF53538CEC0}'] + procedure Intersect(const ACollection: IJclSingleCollection); + procedure Subtract(const ACollection: IJclSingleCollection); + procedure Union(const ACollection: IJclSingleCollection); + end; + + IJclDoubleSet = interface(IJclDoubleCollection) + ['{4E1E4847-E934-4811-A26C-5FC8E772A623}'] + procedure Intersect(const ACollection: IJclDoubleCollection); + procedure Subtract(const ACollection: IJclDoubleCollection); + procedure Union(const ACollection: IJclDoubleCollection); + end; + + IJclExtendedSet = interface(IJclExtendedCollection) + ['{3B9CF52D-1C49-4388-A7B3-9BEE1821FFD4}'] + procedure Intersect(const ACollection: IJclExtendedCollection); + procedure Subtract(const ACollection: IJclExtendedCollection); + procedure Union(const ACollection: IJclExtendedCollection); + end; + + {$IFDEF MATH_SINGLE_PRECISION} + IJclFloatSet = IJclSingleSet; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclFloatSet = IJclDoubleSet; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + IJclFloatSet = IJclExtendedSet; + {$ENDIF MATH_EXTENDED_PRECISION} + + IJclIntegerSet = interface(IJclIntegerCollection) + ['{5E4D29AF-F508-465B-9008-D11FF82F25FE}'] + procedure Intersect(const ACollection: IJclIntegerCollection); + procedure Subtract(const ACollection: IJclIntegerCollection); + procedure Union(const ACollection: IJclIntegerCollection); + end; + + IJclCardinalSet = interface(IJclCardinalCollection) + ['{09858637-CE8F-42E6-97E0-2786CD68387B}'] + procedure Intersect(const ACollection: IJclCardinalCollection); + procedure Subtract(const ACollection: IJclCardinalCollection); + procedure Union(const ACollection: IJclCardinalCollection); + end; + + IJclInt64Set = interface(IJclInt64Collection) + ['{ACB3127A-48EE-4F9F-B988-6AE9057780E9}'] + procedure Intersect(const ACollection: IJclInt64Collection); + procedure Subtract(const ACollection: IJclInt64Collection); + procedure Union(const ACollection: IJclInt64Collection); + end; + + IJclPtrSet = interface(IJclPtrCollection) + ['{26717C68-4F83-4CCB-973A-7324FBD09632}'] + procedure Intersect(const ACollection: IJclPtrCollection); + procedure Subtract(const ACollection: IJclPtrCollection); + procedure Union(const ACollection: IJclPtrCollection); + end; + + IJclSet = interface(IJclCollection) + ['{0B7CDB90-8588-4260-A54C-D87101C669EA}'] + procedure Intersect(const ACollection: IJclCollection); + procedure Subtract(const ACollection: IJclCollection); + procedure Union(const ACollection: IJclCollection); + end; + + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + IJclSet = interface(IJclCollection) + ['{0B7CDB90-8588-4260-A54C-D87101C669EA}'] + procedure Intersect(const ACollection: IJclCollection); + procedure Subtract(const ACollection: IJclCollection); + procedure Union(const ACollection: IJclCollection); + end; + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + TJclTraverseOrder = (toPreOrder, toOrder, toPostOrder); + + IJclIntfTree = interface(IJclIntfCollection) + ['{5A21688F-113D-41B4-A17C-54BDB0BD6559}'] + function GetRoot: IJclIntfTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclIntfTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + IJclAnsiStrTree = interface(IJclAnsiStrCollection) + ['{1E1896C0-0497-47DF-83AF-A9422084636C}'] + function GetRoot: IJclAnsiStrTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclAnsiStrTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + IJclWideStrTree = interface(IJclWideStrCollection) + ['{E325615A-7A20-4788-87FA-9051002CCD91}'] + function GetRoot: IJclWideStrTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclWideStrTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclUnicodeStrTree = interface(IJclUnicodeStrCollection) + ['{A378BC36-1FB1-4330-A335-037DD370E81B}'] + function GetRoot: IJclUnicodeStrTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclUnicodeStrTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + IJclStrTree = IJclAnsiStrTree; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclStrTree = IJclWideStrTree; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclStrTree = IJclUnicodeStrTree; + {$ENDIF CONTAINER_UNICODESTR} + + IJclSingleTree = interface(IJclSingleCollection) + ['{A90A51BC-EBD7-40D3-B0A0-C9987E7A83D0}'] + function GetRoot: IJclSingleTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclSingleTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + IJclDoubleTree = interface(IJclDoubleCollection) + ['{69DA85B1-A0DD-407B-B5CF-5EB7C6D4B82D}'] + function GetRoot: IJclDoubleTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclDoubleTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + IJclExtendedTree = interface(IJclExtendedCollection) + ['{9ACCCAFD-B617-43DC-AAF9-916BE324A17E}'] + function GetRoot: IJclExtendedTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclExtendedTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + {$IFDEF MATH_SINGLE_PRECISION} + IJclFloatTree = IJclSingleTree; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclFloatTree = IJclDoubleTree; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + IJclFloatTree = IJclExtendedTree; + {$ENDIF MATH_EXTENDED_PRECISION} + + IJclIntegerTree = interface(IJclIntegerCollection) + ['{40A6F934-E5F3-4C74-AC02-227035C8C3C6}'] + function GetRoot: IJclIntegerTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclIntegerTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + IJclCardinalTree = interface(IJclCardinalCollection) + ['{6C76C668-50C8-42A2-B72B-79BF102E270D}'] + function GetRoot: IJclCardinalTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclCardinalTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + IJclInt64Tree = interface(IJclInt64Collection) + ['{1925B973-8B75-4A79-A993-DF2598FF19BE}'] + function GetRoot: IJclInt64TreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclInt64TreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + IJclPtrTree = interface(IJclPtrCollection) + ['{2C1ACA3E-3F23-4E3C-984D-151CF9776E14}'] + function GetRoot: IJclPtrTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclPtrTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + IJclTree = interface(IJclCollection) + ['{B0C658CC-FEF5-4178-A4C5-442C0DEDE207}'] + function GetRoot: IJclTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + IJclTree = interface(IJclCollection) + ['{3F963AB5-5A75-41F9-A21B-7E7FB541A459}'] + function GetRoot: IJclTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + IJclIntfIntfMap = interface(IJclBaseContainer) + ['{01D05399-4A05-4F3E-92F4-0C236BE77019}'] + procedure Clear; + function ContainsKey(const Key: IInterface): Boolean; + function ContainsValue(const Value: IInterface): Boolean; + function Extract(const Key: IInterface): IInterface; + function GetValue(const Key: IInterface): IInterface; + function IsEmpty: Boolean; + function KeyOfValue(const Value: IInterface): IInterface; + function KeySet: IJclIntfSet; + function MapEquals(const AMap: IJclIntfIntfMap): Boolean; + procedure PutAll(const AMap: IJclIntfIntfMap); + procedure PutValue(const Key: IInterface; const Value: IInterface); + function Remove(const Key: IInterface): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + property Items[const Key: IInterface]: IInterface read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclAnsiStrIntfMap = interface(IJclAnsiStrContainer) + ['{A4788A96-281A-4924-AA24-03776DDAAD8A}'] + procedure Clear; + function ContainsKey(const Key: AnsiString): Boolean; + function ContainsValue(const Value: IInterface): Boolean; + function Extract(const Key: AnsiString): IInterface; + function GetValue(const Key: AnsiString): IInterface; + function IsEmpty: Boolean; + function KeyOfValue(const Value: IInterface): AnsiString; + function KeySet: IJclAnsiStrSet; + function MapEquals(const AMap: IJclAnsiStrIntfMap): Boolean; + procedure PutAll(const AMap: IJclAnsiStrIntfMap); + procedure PutValue(const Key: AnsiString; const Value: IInterface); + function Remove(const Key: AnsiString): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + property Items[const Key: AnsiString]: IInterface read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclIntfAnsiStrMap = interface(IJclAnsiStrContainer) + ['{B10E324A-1D98-42FF-B9B4-7F99044591B2}'] + procedure Clear; + function ContainsKey(const Key: IInterface): Boolean; + function ContainsValue(const Value: AnsiString): Boolean; + function Extract(const Key: IInterface): AnsiString; + function GetValue(const Key: IInterface): AnsiString; + function IsEmpty: Boolean; + function KeyOfValue(const Value: AnsiString): IInterface; + function KeySet: IJclIntfSet; + function MapEquals(const AMap: IJclIntfAnsiStrMap): Boolean; + procedure PutAll(const AMap: IJclIntfAnsiStrMap); + procedure PutValue(const Key: IInterface; const Value: AnsiString); + function Remove(const Key: IInterface): AnsiString; + function Size: Integer; + function Values: IJclAnsiStrCollection; + property Items[const Key: IInterface]: AnsiString read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclAnsiStrAnsiStrMap = interface(IJclAnsiStrContainer) + ['{B01D6C80-E120-4BC2-AA93-3DEE18A19B7A}'] + procedure Clear; + function ContainsKey(const Key: AnsiString): Boolean; + function ContainsValue(const Value: AnsiString): Boolean; + function Extract(const Key: AnsiString): AnsiString; + function GetValue(const Key: AnsiString): AnsiString; + function IsEmpty: Boolean; + function KeyOfValue(const Value: AnsiString): AnsiString; + function KeySet: IJclAnsiStrSet; + function MapEquals(const AMap: IJclAnsiStrAnsiStrMap): Boolean; + procedure PutAll(const AMap: IJclAnsiStrAnsiStrMap); + procedure PutValue(const Key: AnsiString; const Value: AnsiString); + function Remove(const Key: AnsiString): AnsiString; + function Size: Integer; + function Values: IJclAnsiStrCollection; + property Items[const Key: AnsiString]: AnsiString read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclWideStrIntfMap = interface(IJclWideStrContainer) + ['{C959AB76-9CF0-4C2C-A2C6-8A1846563FAF}'] + procedure Clear; + function ContainsKey(const Key: WideString): Boolean; + function ContainsValue(const Value: IInterface): Boolean; + function Extract(const Key: WideString): IInterface; + function GetValue(const Key: WideString): IInterface; + function IsEmpty: Boolean; + function KeyOfValue(const Value: IInterface): WideString; + function KeySet: IJclWideStrSet; + function MapEquals(const AMap: IJclWideStrIntfMap): Boolean; + procedure PutAll(const AMap: IJclWideStrIntfMap); + procedure PutValue(const Key: WideString; const Value: IInterface); + function Remove(const Key: WideString): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + property Items[const Key: WideString]: IInterface read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclIntfWideStrMap = interface(IJclWideStrContainer) + ['{D9FD7887-B840-4636-8A8F-E586663E332C}'] + procedure Clear; + function ContainsKey(const Key: IInterface): Boolean; + function ContainsValue(const Value: WideString): Boolean; + function Extract(const Key: IInterface): WideString; + function GetValue(const Key: IInterface): WideString; + function IsEmpty: Boolean; + function KeyOfValue(const Value: WideString): IInterface; + function KeySet: IJclIntfSet; + function MapEquals(const AMap: IJclIntfWideStrMap): Boolean; + procedure PutAll(const AMap: IJclIntfWideStrMap); + procedure PutValue(const Key: IInterface; const Value: WideString); + function Remove(const Key: IInterface): WideString; + function Size: Integer; + function Values: IJclWideStrCollection; + property Items[const Key: IInterface]: WideString read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclWideStrWideStrMap = interface(IJclWideStrContainer) + ['{8E8D2735-C4FB-4F00-8802-B2102BCE3644}'] + procedure Clear; + function ContainsKey(const Key: WideString): Boolean; + function ContainsValue(const Value: WideString): Boolean; + function Extract(const Key: WideString): WideString; + function GetValue(const Key: WideString): WideString; + function IsEmpty: Boolean; + function KeyOfValue(const Value: WideString): WideString; + function KeySet: IJclWideStrSet; + function MapEquals(const AMap: IJclWideStrWideStrMap): Boolean; + procedure PutAll(const AMap: IJclWideStrWideStrMap); + procedure PutValue(const Key: WideString; const Value: WideString); + function Remove(const Key: WideString): WideString; + function Size: Integer; + function Values: IJclWideStrCollection; + property Items[const Key: WideString]: WideString read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclUnicodeStrIntfMap = interface(IJclUnicodeStrContainer) + ['{C83D4F5E-8E66-41E9-83F6-338B44F24BE6}'] + procedure Clear; + function ContainsKey(const Key: UnicodeString): Boolean; + function ContainsValue(const Value: IInterface): Boolean; + function Extract(const Key: UnicodeString): IInterface; + function GetValue(const Key: UnicodeString): IInterface; + function IsEmpty: Boolean; + function KeyOfValue(const Value: IInterface): UnicodeString; + function KeySet: IJclUnicodeStrSet; + function MapEquals(const AMap: IJclUnicodeStrIntfMap): Boolean; + procedure PutAll(const AMap: IJclUnicodeStrIntfMap); + procedure PutValue(const Key: UnicodeString; const Value: IInterface); + function Remove(const Key: UnicodeString): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + property Items[const Key: UnicodeString]: IInterface read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclIntfUnicodeStrMap = interface(IJclUnicodeStrContainer) + ['{40F8B873-B763-4A3C-8EC4-31DB3404BF73}'] + procedure Clear; + function ContainsKey(const Key: IInterface): Boolean; + function ContainsValue(const Value: UnicodeString): Boolean; + function Extract(const Key: IInterface): UnicodeString; + function GetValue(const Key: IInterface): UnicodeString; + function IsEmpty: Boolean; + function KeyOfValue(const Value: UnicodeString): IInterface; + function KeySet: IJclIntfSet; + function MapEquals(const AMap: IJclIntfUnicodeStrMap): Boolean; + procedure PutAll(const AMap: IJclIntfUnicodeStrMap); + procedure PutValue(const Key: IInterface; const Value: UnicodeString); + function Remove(const Key: IInterface): UnicodeString; + function Size: Integer; + function Values: IJclUnicodeStrCollection; + property Items[const Key: IInterface]: UnicodeString read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclUnicodeStrUnicodeStrMap = interface(IJclUnicodeStrContainer) + ['{557E1CBD-06AC-41C2-BAED-253709CBD0AE}'] + procedure Clear; + function ContainsKey(const Key: UnicodeString): Boolean; + function ContainsValue(const Value: UnicodeString): Boolean; + function Extract(const Key: UnicodeString): UnicodeString; + function GetValue(const Key: UnicodeString): UnicodeString; + function IsEmpty: Boolean; + function KeyOfValue(const Value: UnicodeString): UnicodeString; + function KeySet: IJclUnicodeStrSet; + function MapEquals(const AMap: IJclUnicodeStrUnicodeStrMap): Boolean; + procedure PutAll(const AMap: IJclUnicodeStrUnicodeStrMap); + procedure PutValue(const Key: UnicodeString; const Value: UnicodeString); + function Remove(const Key: UnicodeString): UnicodeString; + function Size: Integer; + function Values: IJclUnicodeStrCollection; + property Items[const Key: UnicodeString]: UnicodeString read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + IJclStrIntfMap = IJclAnsiStrIntfMap; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclStrIntfMap = IJclWideStrIntfMap; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclStrIntfMap = IJclUnicodeStrIntfMap; + {$ENDIF CONTAINER_UNICODESTR} + + {$IFDEF CONTAINER_ANSISTR} + IJclIntfStrMap = IJclIntfAnsiStrMap; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclIntfStrMap = IJclIntfWideStrMap; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclIntfStrMap = IJclIntfUnicodeStrMap; + {$ENDIF CONTAINER_UNICODESTR} + + {$IFDEF CONTAINER_ANSISTR} + IJclStrStrMap = IJclAnsiStrAnsiStrMap; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclStrStrMap = IJclWideStrWideStrMap; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclStrStrMap = IJclUnicodeStrUnicodeStrMap; + {$ENDIF CONTAINER_UNICODESTR} + + IJclSingleIntfMap = interface(IJclSingleContainer) + ['{5F5E9E8B-E648-450B-B6C0-0EC65CC2D0BA}'] + procedure Clear; + function ContainsKey(const Key: Single): Boolean; + function ContainsValue(const Value: IInterface): Boolean; + function Extract(const Key: Single): IInterface; + function GetValue(const Key: Single): IInterface; + function IsEmpty: Boolean; + function KeyOfValue(const Value: IInterface): Single; + function KeySet: IJclSingleSet; + function MapEquals(const AMap: IJclSingleIntfMap): Boolean; + procedure PutAll(const AMap: IJclSingleIntfMap); + procedure PutValue(const Key: Single; const Value: IInterface); + function Remove(const Key: Single): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + property Items[const Key: Single]: IInterface read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclIntfSingleMap = interface(IJclSingleContainer) + ['{234D1618-FB0E-46F5-A70D-5106163A90F7}'] + procedure Clear; + function ContainsKey(const Key: IInterface): Boolean; + function ContainsValue(const Value: Single): Boolean; + function Extract(const Key: IInterface): Single; + function GetValue(const Key: IInterface): Single; + function IsEmpty: Boolean; + function KeyOfValue(const Value: Single): IInterface; + function KeySet: IJclIntfSet; + function MapEquals(const AMap: IJclIntfSingleMap): Boolean; + procedure PutAll(const AMap: IJclIntfSingleMap); + procedure PutValue(const Key: IInterface; const Value: Single); + function Remove(const Key: IInterface): Single; + function Size: Integer; + function Values: IJclSingleCollection; + property Items[const Key: IInterface]: Single read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclSingleSingleMap = interface(IJclSingleContainer) + ['{AEB0008F-F3CF-4055-A7F3-A330D312F03F}'] + procedure Clear; + function ContainsKey(const Key: Single): Boolean; + function ContainsValue(const Value: Single): Boolean; + function Extract(const Key: Single): Single; + function GetValue(const Key: Single): Single; + function IsEmpty: Boolean; + function KeyOfValue(const Value: Single): Single; + function KeySet: IJclSingleSet; + function MapEquals(const AMap: IJclSingleSingleMap): Boolean; + procedure PutAll(const AMap: IJclSingleSingleMap); + procedure PutValue(const Key: Single; const Value: Single); + function Remove(const Key: Single): Single; + function Size: Integer; + function Values: IJclSingleCollection; + property Items[const Key: Single]: Single read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclDoubleIntfMap = interface(IJclDoubleContainer) + ['{08968FFB-36C6-4FBA-BC09-3DCA2B5D7A50}'] + procedure Clear; + function ContainsKey(const Key: Double): Boolean; + function ContainsValue(const Value: IInterface): Boolean; + function Extract(const Key: Double): IInterface; + function GetValue(const Key: Double): IInterface; + function IsEmpty: Boolean; + function KeyOfValue(const Value: IInterface): Double; + function KeySet: IJclDoubleSet; + function MapEquals(const AMap: IJclDoubleIntfMap): Boolean; + procedure PutAll(const AMap: IJclDoubleIntfMap); + procedure PutValue(const Key: Double; const Value: IInterface); + function Remove(const Key: Double): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + property Items[const Key: Double]: IInterface read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclIntfDoubleMap = interface(IJclDoubleContainer) + ['{B23DAF6A-6DC5-4DDD-835C-CD4633DDA010}'] + procedure Clear; + function ContainsKey(const Key: IInterface): Boolean; + function ContainsValue(const Value: Double): Boolean; + function Extract(const Key: IInterface): Double; + function GetValue(const Key: IInterface): Double; + function IsEmpty: Boolean; + function KeyOfValue(const Value: Double): IInterface; + function KeySet: IJclIntfSet; + function MapEquals(const AMap: IJclIntfDoubleMap): Boolean; + procedure PutAll(const AMap: IJclIntfDoubleMap); + procedure PutValue(const Key: IInterface; const Value: Double); + function Remove(const Key: IInterface): Double; + function Size: Integer; + function Values: IJclDoubleCollection; + property Items[const Key: IInterface]: Double read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclDoubleDoubleMap = interface(IJclDoubleContainer) + ['{329A03B8-0B6B-4FE3-87C5-4B63447A5FFD}'] + procedure Clear; + function ContainsKey(const Key: Double): Boolean; + function ContainsValue(const Value: Double): Boolean; + function Extract(const Key: Double): Double; + function GetValue(const Key: Double): Double; + function IsEmpty: Boolean; + function KeyOfValue(const Value: Double): Double; + function KeySet: IJclDoubleSet; + function MapEquals(const AMap: IJclDoubleDoubleMap): Boolean; + procedure PutAll(const AMap: IJclDoubleDoubleMap); + procedure PutValue(const Key: Double; const Value: Double); + function Remove(const Key: Double): Double; + function Size: Integer; + function Values: IJclDoubleCollection; + property Items[const Key: Double]: Double read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclExtendedIntfMap = interface(IJclExtendedContainer) + ['{7C0731E0-C9AB-4378-B1B0-8CE3DD60AD41}'] + procedure Clear; + function ContainsKey(const Key: Extended): Boolean; + function ContainsValue(const Value: IInterface): Boolean; + function Extract(const Key: Extended): IInterface; + function GetValue(const Key: Extended): IInterface; + function IsEmpty: Boolean; + function KeyOfValue(const Value: IInterface): Extended; + function KeySet: IJclExtendedSet; + function MapEquals(const AMap: IJclExtendedIntfMap): Boolean; + procedure PutAll(const AMap: IJclExtendedIntfMap); + procedure PutValue(const Key: Extended; const Value: IInterface); + function Remove(const Key: Extended): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + property Items[const Key: Extended]: IInterface read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclIntfExtendedMap = interface(IJclExtendedContainer) + ['{479FCE5A-2D8A-44EE-96BC-E8DA3187DBD8}'] + procedure Clear; + function ContainsKey(const Key: IInterface): Boolean; + function ContainsValue(const Value: Extended): Boolean; + function Extract(const Key: IInterface): Extended; + function GetValue(const Key: IInterface): Extended; + function IsEmpty: Boolean; + function KeyOfValue(const Value: Extended): IInterface; + function KeySet: IJclIntfSet; + function MapEquals(const AMap: IJclIntfExtendedMap): Boolean; + procedure PutAll(const AMap: IJclIntfExtendedMap); + procedure PutValue(const Key: IInterface; const Value: Extended); + function Remove(const Key: IInterface): Extended; + function Size: Integer; + function Values: IJclExtendedCollection; + property Items[const Key: IInterface]: Extended read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclExtendedExtendedMap = interface(IJclExtendedContainer) + ['{962C2B09-8CF5-44E8-A21A-4A7DAFB72A11}'] + procedure Clear; + function ContainsKey(const Key: Extended): Boolean; + function ContainsValue(const Value: Extended): Boolean; + function Extract(const Key: Extended): Extended; + function GetValue(const Key: Extended): Extended; + function IsEmpty: Boolean; + function KeyOfValue(const Value: Extended): Extended; + function KeySet: IJclExtendedSet; + function MapEquals(const AMap: IJclExtendedExtendedMap): Boolean; + procedure PutAll(const AMap: IJclExtendedExtendedMap); + procedure PutValue(const Key: Extended; const Value: Extended); + function Remove(const Key: Extended): Extended; + function Size: Integer; + function Values: IJclExtendedCollection; + property Items[const Key: Extended]: Extended read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + {$IFDEF MATH_SINGLE_PRECISION} + IJclFloatIntfMap = IJclSingleIntfMap; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclFloatIntfMap = IJclDoubleIntfMap; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + IJclFloatIntfMap = IJclExtendedIntfMap; + {$ENDIF MATH_EXTENDED_PRECISION} + + {$IFDEF MATH_SINGLE_PRECISION} + IJclIntfFloatMap = IJclIntfSingleMap; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclIntfFloatMap = IJclIntfDoubleMap; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + IJclIntfFloatMap = IJclIntfExtendedMap; + {$ENDIF MATH_EXTENDED_PRECISION} + + {$IFDEF MATH_SINGLE_PRECISION} + IJclFloatFloatMap = IJclSingleSingleMap; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclFloatFloatMap = IJclDoubleDoubleMap; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + IJclFloatFloatMap = IJclExtendedExtendedMap; + {$ENDIF MATH_EXTENDED_PRECISION} + + IJclIntegerIntfMap = interface(IJclBaseContainer) + ['{E535FE65-AC88-49D3-BEF2-FB30D92C2FA6}'] + procedure Clear; + function ContainsKey(Key: Integer): Boolean; + function ContainsValue(const Value: IInterface): Boolean; + function Extract(Key: Integer): IInterface; + function GetValue(Key: Integer): IInterface; + function IsEmpty: Boolean; + function KeyOfValue(const Value: IInterface): Integer; + function KeySet: IJclIntegerSet; + function MapEquals(const AMap: IJclIntegerIntfMap): Boolean; + procedure PutAll(const AMap: IJclIntegerIntfMap); + procedure PutValue(Key: Integer; const Value: IInterface); + function Remove(Key: Integer): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + property Items[Key: Integer]: IInterface read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclIntfIntegerMap = interface(IJclBaseContainer) + ['{E01DA012-BEE0-4259-8E30-0A7A1A87BED0}'] + procedure Clear; + function ContainsKey(const Key: IInterface): Boolean; + function ContainsValue(Value: Integer): Boolean; + function Extract(const Key: IInterface): Integer; + function GetValue(const Key: IInterface): Integer; + function IsEmpty: Boolean; + function KeyOfValue(Value: Integer): IInterface; + function KeySet: IJclIntfSet; + function MapEquals(const AMap: IJclIntfIntegerMap): Boolean; + procedure PutAll(const AMap: IJclIntfIntegerMap); + procedure PutValue(const Key: IInterface; Value: Integer); + function Remove(const Key: IInterface): Integer; + function Size: Integer; + function Values: IJclIntegerCollection; + property Items[const Key: IInterface]: Integer read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclIntegerIntegerMap = interface(IJclBaseContainer) + ['{23A46BC0-DF8D-4BD2-89D2-4DACF1EC73A1}'] + procedure Clear; + function ContainsKey(Key: Integer): Boolean; + function ContainsValue(Value: Integer): Boolean; + function Extract(Key: Integer): Integer; + function GetValue(Key: Integer): Integer; + function IsEmpty: Boolean; + function KeyOfValue(Value: Integer): Integer; + function KeySet: IJclIntegerSet; + function MapEquals(const AMap: IJclIntegerIntegerMap): Boolean; + procedure PutAll(const AMap: IJclIntegerIntegerMap); + procedure PutValue(Key: Integer; Value: Integer); + function Remove(Key: Integer): Integer; + function Size: Integer; + function Values: IJclIntegerCollection; + property Items[Key: Integer]: Integer read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclCardinalIntfMap = interface(IJclBaseContainer) + ['{80D39FB1-0D10-49CE-8AF3-1CD98A1D4F6C}'] + procedure Clear; + function ContainsKey(Key: Cardinal): Boolean; + function ContainsValue(const Value: IInterface): Boolean; + function Extract(Key: Cardinal): IInterface; + function GetValue(Key: Cardinal): IInterface; + function IsEmpty: Boolean; + function KeyOfValue(const Value: IInterface): Cardinal; + function KeySet: IJclCardinalSet; + function MapEquals(const AMap: IJclCardinalIntfMap): Boolean; + procedure PutAll(const AMap: IJclCardinalIntfMap); + procedure PutValue(Key: Cardinal; const Value: IInterface); + function Remove(Key: Cardinal): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + property Items[Key: Cardinal]: IInterface read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclIntfCardinalMap = interface(IJclBaseContainer) + ['{E1A724AB-6BDA-45F0-AE21-5E7E789A751B}'] + procedure Clear; + function ContainsKey(const Key: IInterface): Boolean; + function ContainsValue(Value: Cardinal): Boolean; + function Extract(const Key: IInterface): Cardinal; + function GetValue(const Key: IInterface): Cardinal; + function IsEmpty: Boolean; + function KeyOfValue(Value: Cardinal): IInterface; + function KeySet: IJclIntfSet; + function MapEquals(const AMap: IJclIntfCardinalMap): Boolean; + procedure PutAll(const AMap: IJclIntfCardinalMap); + procedure PutValue(const Key: IInterface; Value: Cardinal); + function Remove(const Key: IInterface): Cardinal; + function Size: Integer; + function Values: IJclCardinalCollection; + property Items[const Key: IInterface]: Cardinal read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclCardinalCardinalMap = interface(IJclBaseContainer) + ['{1CD3F54C-F92F-4AF4-82B2-0829C08AA83B}'] + procedure Clear; + function ContainsKey(Key: Cardinal): Boolean; + function ContainsValue(Value: Cardinal): Boolean; + function Extract(Key: Cardinal): Cardinal; + function GetValue(Key: Cardinal): Cardinal; + function IsEmpty: Boolean; + function KeyOfValue(Value: Cardinal): Cardinal; + function KeySet: IJclCardinalSet; + function MapEquals(const AMap: IJclCardinalCardinalMap): Boolean; + procedure PutAll(const AMap: IJclCardinalCardinalMap); + procedure PutValue(Key: Cardinal; Value: Cardinal); + function Remove(Key: Cardinal): Cardinal; + function Size: Integer; + function Values: IJclCardinalCollection; + property Items[Key: Cardinal]: Cardinal read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclInt64IntfMap = interface(IJclBaseContainer) + ['{B64FB2D1-8D45-4367-B950-98D3D05AC6A0}'] + procedure Clear; + function ContainsKey(const Key: Int64): Boolean; + function ContainsValue(const Value: IInterface): Boolean; + function Extract(const Key: Int64): IInterface; + function GetValue(const Key: Int64): IInterface; + function IsEmpty: Boolean; + function KeyOfValue(const Value: IInterface): Int64; + function KeySet: IJclInt64Set; + function MapEquals(const AMap: IJclInt64IntfMap): Boolean; + procedure PutAll(const AMap: IJclInt64IntfMap); + procedure PutValue(const Key: Int64; const Value: IInterface); + function Remove(const Key: Int64): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + property Items[const Key: Int64]: IInterface read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclIntfInt64Map = interface(IJclBaseContainer) + ['{9886BEE3-D15B-45D2-A3FB-4D3A0ADEC8AC}'] + procedure Clear; + function ContainsKey(const Key: IInterface): Boolean; + function ContainsValue(const Value: Int64): Boolean; + function Extract(const Key: IInterface): Int64; + function GetValue(const Key: IInterface): Int64; + function IsEmpty: Boolean; + function KeyOfValue(const Value: Int64): IInterface; + function KeySet: IJclIntfSet; + function MapEquals(const AMap: IJclIntfInt64Map): Boolean; + procedure PutAll(const AMap: IJclIntfInt64Map); + procedure PutValue(const Key: IInterface; const Value: Int64); + function Remove(const Key: IInterface): Int64; + function Size: Integer; + function Values: IJclInt64Collection; + property Items[const Key: IInterface]: Int64 read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclInt64Int64Map = interface(IJclBaseContainer) + ['{EF2A2726-408A-4984-9971-DDC1B6EFC9F5}'] + procedure Clear; + function ContainsKey(const Key: Int64): Boolean; + function ContainsValue(const Value: Int64): Boolean; + function Extract(const Key: Int64): Int64; + function GetValue(const Key: Int64): Int64; + function IsEmpty: Boolean; + function KeyOfValue(const Value: Int64): Int64; + function KeySet: IJclInt64Set; + function MapEquals(const AMap: IJclInt64Int64Map): Boolean; + procedure PutAll(const AMap: IJclInt64Int64Map); + procedure PutValue(const Key: Int64; const Value: Int64); + function Remove(const Key: Int64): Int64; + function Size: Integer; + function Values: IJclInt64Collection; + property Items[const Key: Int64]: Int64 read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclPtrIntfMap = interface(IJclBaseContainer) + ['{B7C48542-39A0-453F-8F03-8C8CFAB0DCCF}'] + procedure Clear; + function ContainsKey(Key: Pointer): Boolean; + function ContainsValue(const Value: IInterface): Boolean; + function Extract(Key: Pointer): IInterface; + function GetValue(Key: Pointer): IInterface; + function IsEmpty: Boolean; + function KeyOfValue(const Value: IInterface): Pointer; + function KeySet: IJclPtrSet; + function MapEquals(const AMap: IJclPtrIntfMap): Boolean; + procedure PutAll(const AMap: IJclPtrIntfMap); + procedure PutValue(Key: Pointer; const Value: IInterface); + function Remove(Key: Pointer): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + property Items[Key: Pointer]: IInterface read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclIntfPtrMap = interface(IJclBaseContainer) + ['{DA51D823-58DB-4D7C-9B8E-07E0FD560B57}'] + procedure Clear; + function ContainsKey(const Key: IInterface): Boolean; + function ContainsValue(Value: Pointer): Boolean; + function Extract(const Key: IInterface): Pointer; + function GetValue(const Key: IInterface): Pointer; + function IsEmpty: Boolean; + function KeyOfValue(Value: Pointer): IInterface; + function KeySet: IJclIntfSet; + function MapEquals(const AMap: IJclIntfPtrMap): Boolean; + procedure PutAll(const AMap: IJclIntfPtrMap); + procedure PutValue(const Key: IInterface; Value: Pointer); + function Remove(const Key: IInterface): Pointer; + function Size: Integer; + function Values: IJclPtrCollection; + property Items[const Key: IInterface]: Pointer read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclPtrPtrMap = interface(IJclBaseContainer) + ['{1200CB0F-A766-443F-9030-5A804C11B798}'] + procedure Clear; + function ContainsKey(Key: Pointer): Boolean; + function ContainsValue(Value: Pointer): Boolean; + function Extract(Key: Pointer): Pointer; + function GetValue(Key: Pointer): Pointer; + function IsEmpty: Boolean; + function KeyOfValue(Value: Pointer): Pointer; + function KeySet: IJclPtrSet; + function MapEquals(const AMap: IJclPtrPtrMap): Boolean; + procedure PutAll(const AMap: IJclPtrPtrMap); + procedure PutValue(Key: Pointer; Value: Pointer); + function Remove(Key: Pointer): Pointer; + function Size: Integer; + function Values: IJclPtrCollection; + property Items[Key: Pointer]: Pointer read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclIntfMap = interface(IJclBaseContainer) + ['{C70570C6-EDDB-47B4-9003-C637B486731D}'] + procedure Clear; + function ContainsKey(const Key: IInterface): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Extract(const Key: IInterface): TObject; + function GetValue(const Key: IInterface): TObject; + function IsEmpty: Boolean; + function KeyOfValue(Value: TObject): IInterface; + function KeySet: IJclIntfSet; + function MapEquals(const AMap: IJclIntfMap): Boolean; + procedure PutAll(const AMap: IJclIntfMap); + procedure PutValue(const Key: IInterface; Value: TObject); + function Remove(const Key: IInterface): TObject; + function Size: Integer; + function Values: IJclCollection; + property Items[const Key: IInterface]: TObject read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclAnsiStrMap = interface(IJclAnsiStrContainer) + ['{A7D0A882-6952-496D-A258-23D47DDCCBC4}'] + procedure Clear; + function ContainsKey(const Key: AnsiString): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Extract(const Key: AnsiString): TObject; + function GetValue(const Key: AnsiString): TObject; + function IsEmpty: Boolean; + function KeyOfValue(Value: TObject): AnsiString; + function KeySet: IJclAnsiStrSet; + function MapEquals(const AMap: IJclAnsiStrMap): Boolean; + procedure PutAll(const AMap: IJclAnsiStrMap); + procedure PutValue(const Key: AnsiString; Value: TObject); + function Remove(const Key: AnsiString): TObject; + function Size: Integer; + function Values: IJclCollection; + property Items[const Key: AnsiString]: TObject read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclWideStrMap = interface(IJclWideStrContainer) + ['{ACE8E6B4-5A56-4753-A2C6-BAE195A56B63}'] + procedure Clear; + function ContainsKey(const Key: WideString): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Extract(const Key: WideString): TObject; + function GetValue(const Key: WideString): TObject; + function IsEmpty: Boolean; + function KeyOfValue(Value: TObject): WideString; + function KeySet: IJclWideStrSet; + function MapEquals(const AMap: IJclWideStrMap): Boolean; + procedure PutAll(const AMap: IJclWideStrMap); + procedure PutValue(const Key: WideString; Value: TObject); + function Remove(const Key: WideString): TObject; + function Size: Integer; + function Values: IJclCollection; + property Items[const Key: WideString]: TObject read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclUnicodeStrMap = interface(IJclUnicodeStrContainer) + ['{4328E033-9B92-40C6-873D-A6982CFC2B95}'] + procedure Clear; + function ContainsKey(const Key: UnicodeString): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Extract(const Key: UnicodeString): TObject; + function GetValue(const Key: UnicodeString): TObject; + function IsEmpty: Boolean; + function KeyOfValue(Value: TObject): UnicodeString; + function KeySet: IJclUnicodeStrSet; + function MapEquals(const AMap: IJclUnicodeStrMap): Boolean; + procedure PutAll(const AMap: IJclUnicodeStrMap); + procedure PutValue(const Key: UnicodeString; Value: TObject); + function Remove(const Key: UnicodeString): TObject; + function Size: Integer; + function Values: IJclCollection; + property Items[const Key: UnicodeString]: TObject read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + IJclStrMap = IJclAnsiStrMap; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclStrMap = IJclWideStrMap; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclStrMap = IJclUnicodeStrMap; + {$ENDIF CONTAINER_UNICODESTR} + + IJclSingleMap = interface(IJclSingleContainer) + ['{C501920A-F252-4F94-B142-1F05AE06C3D2}'] + procedure Clear; + function ContainsKey(const Key: Single): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Extract(const Key: Single): TObject; + function GetValue(const Key: Single): TObject; + function IsEmpty: Boolean; + function KeyOfValue(Value: TObject): Single; + function KeySet: IJclSingleSet; + function MapEquals(const AMap: IJclSingleMap): Boolean; + procedure PutAll(const AMap: IJclSingleMap); + procedure PutValue(const Key: Single; Value: TObject); + function Remove(const Key: Single): TObject; + function Size: Integer; + function Values: IJclCollection; + property Items[const Key: Single]: TObject read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclDoubleMap = interface(IJclDoubleContainer) + ['{B1B994AC-49C9-418B-814B-43BAD706F355}'] + procedure Clear; + function ContainsKey(const Key: Double): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Extract(const Key: Double): TObject; + function GetValue(const Key: Double): TObject; + function IsEmpty: Boolean; + function KeyOfValue(Value: TObject): Double; + function KeySet: IJclDoubleSet; + function MapEquals(const AMap: IJclDoubleMap): Boolean; + procedure PutAll(const AMap: IJclDoubleMap); + procedure PutValue(const Key: Double; Value: TObject); + function Remove(const Key: Double): TObject; + function Size: Integer; + function Values: IJclCollection; + property Items[const Key: Double]: TObject read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclExtendedMap = interface(IJclExtendedContainer) + ['{3BCC8C87-A186-45E8-9B37-0B8E85120434}'] + procedure Clear; + function ContainsKey(const Key: Extended): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Extract(const Key: Extended): TObject; + function GetValue(const Key: Extended): TObject; + function IsEmpty: Boolean; + function KeyOfValue(Value: TObject): Extended; + function KeySet: IJclExtendedSet; + function MapEquals(const AMap: IJclExtendedMap): Boolean; + procedure PutAll(const AMap: IJclExtendedMap); + procedure PutValue(const Key: Extended; Value: TObject); + function Remove(const Key: Extended): TObject; + function Size: Integer; + function Values: IJclCollection; + property Items[const Key: Extended]: TObject read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + {$IFDEF MATH_SINGLE_PRECISION} + IJclFloatMap = IJclSingleMap; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclFloatMap = IJclDoubleMap; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + IJclFloatMap = IJclExtendedMap; + {$ENDIF MATH_EXTENDED_PRECISION} + + IJclIntegerMap = interface(IJclBaseContainer) + ['{D6FA5D64-A4AF-4419-9981-56BA79BF8770}'] + procedure Clear; + function ContainsKey(Key: Integer): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Extract(Key: Integer): TObject; + function GetValue(Key: Integer): TObject; + function IsEmpty: Boolean; + function KeyOfValue(Value: TObject): Integer; + function KeySet: IJclIntegerSet; + function MapEquals(const AMap: IJclIntegerMap): Boolean; + procedure PutAll(const AMap: IJclIntegerMap); + procedure PutValue(Key: Integer; Value: TObject); + function Remove(Key: Integer): TObject; + function Size: Integer; + function Values: IJclCollection; + property Items[Key: Integer]: TObject read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclCardinalMap = interface(IJclBaseContainer) + ['{A2F92F4F-11CB-4DB2-932F-F10A14237126}'] + procedure Clear; + function ContainsKey(Key: Cardinal): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Extract(Key: Cardinal): TObject; + function GetValue(Key: Cardinal): TObject; + function IsEmpty: Boolean; + function KeyOfValue(Value: TObject): Cardinal; + function KeySet: IJclCardinalSet; + function MapEquals(const AMap: IJclCardinalMap): Boolean; + procedure PutAll(const AMap: IJclCardinalMap); + procedure PutValue(Key: Cardinal; Value: TObject); + function Remove(Key: Cardinal): TObject; + function Size: Integer; + function Values: IJclCollection; + property Items[Key: Cardinal]: TObject read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclInt64Map = interface(IJclBaseContainer) + ['{4C720CE0-7A7C-41D5-BFC1-8D58A47E648F}'] + procedure Clear; + function ContainsKey(const Key: Int64): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Extract(const Key: Int64): TObject; + function GetValue(const Key: Int64): TObject; + function IsEmpty: Boolean; + function KeyOfValue(Value: TObject): Int64; + function KeySet: IJclInt64Set; + function MapEquals(const AMap: IJclInt64Map): Boolean; + procedure PutAll(const AMap: IJclInt64Map); + procedure PutValue(const Key: Int64; Value: TObject); + function Remove(const Key: Int64): TObject; + function Size: Integer; + function Values: IJclCollection; + property Items[const Key: Int64]: TObject read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclPtrMap = interface(IJclBaseContainer) + ['{2FE029A9-026C-487D-8204-AD3A28BD2FA2}'] + procedure Clear; + function ContainsKey(Key: Pointer): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Extract(Key: Pointer): TObject; + function GetValue(Key: Pointer): TObject; + function IsEmpty: Boolean; + function KeyOfValue(Value: TObject): Pointer; + function KeySet: IJclPtrSet; + function MapEquals(const AMap: IJclPtrMap): Boolean; + procedure PutAll(const AMap: IJclPtrMap); + procedure PutValue(Key: Pointer; Value: TObject); + function Remove(Key: Pointer): TObject; + function Size: Integer; + function Values: IJclCollection; + property Items[Key: Pointer]: TObject read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + IJclMap = interface(IJclBaseContainer) + ['{A7D0A882-6952-496D-A258-23D47DDCCBC4}'] + procedure Clear; + function ContainsKey(Key: TObject): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Extract(Key: TObject): TObject; + function GetValue(Key: TObject): TObject; + function IsEmpty: Boolean; + function KeyOfValue(Value: TObject): TObject; + function KeySet: IJclSet; + function MapEquals(const AMap: IJclMap): Boolean; + procedure PutAll(const AMap: IJclMap); + procedure PutValue(Key: TObject; Value: TObject); + function Remove(Key: TObject): TObject; + function Size: Integer; + function Values: IJclCollection; + property Items[Key: TObject]: TObject read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + + + (*IJclMultiIntfIntfMap = interface(IJclIntfIntfMap) + ['{497775A5-D3F1-49FC-A641-15CC9E77F3D0}'] + function GetValues(const Key: IInterface): IJclIntfIterator; + function Count(const Key: IInterface): Integer; + end;*) + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + IHashable = interface + function GetHashCode: Integer; + end; + + IJclMap = interface(IJclBaseContainer) + ['{22624C43-4828-4A1E-BDD4-4A7FE59AE135}'] + procedure Clear; + function ContainsKey(const Key: TKey): Boolean; + function ContainsValue(const Value: TValue): Boolean; + function Extract(const Key: TKey): TValue; + function GetValue(const Key: TKey): TValue; + function IsEmpty: Boolean; + function KeyOfValue(const Value: TValue): TKey; + function KeySet: IJclSet; + function MapEquals(const AMap: IJclMap): Boolean; + procedure PutAll(const AMap: IJclMap); + procedure PutValue(const Key: TKey; const Value: TValue); + function Remove(const Key: TKey): TValue; + function Size: Integer; + function Values: IJclCollection; + property Items[const Key: TKey]: TValue read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + IJclIntfQueue = interface(IJclIntfContainer) + ['{B88756FE-5553-4106-957E-3E33120BFA99}'] + procedure Clear; + function Contains(const AInterface: IInterface): Boolean; + function Dequeue: IInterface; + function Empty: Boolean; + function Enqueue(const AInterface: IInterface): Boolean; + function Peek: IInterface; + function Size: Integer; + end; + + IJclAnsiStrQueue = interface(IJclAnsiStrContainer) + ['{5BA0ED9A-5AF3-4F79-9D80-34FA7FF15D1F}'] + procedure Clear; + function Contains(const AString: AnsiString): Boolean; + function Dequeue: AnsiString; + function Empty: Boolean; + function Enqueue(const AString: AnsiString): Boolean; + function Peek: AnsiString; + function Size: Integer; + end; + + IJclWideStrQueue = interface(IJclWideStrContainer) + ['{058BBFB7-E9B9-44B5-B676-D5B5B9A79BEF}'] + procedure Clear; + function Contains(const AString: WideString): Boolean; + function Dequeue: WideString; + function Empty: Boolean; + function Enqueue(const AString: WideString): Boolean; + function Peek: WideString; + function Size: Integer; + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclUnicodeStrQueue = interface(IJclUnicodeStrContainer) + ['{94A09E52-424A-486E-846B-9C2C52DC3A8F}'] + procedure Clear; + function Contains(const AString: UnicodeString): Boolean; + function Dequeue: UnicodeString; + function Empty: Boolean; + function Enqueue(const AString: UnicodeString): Boolean; + function Peek: UnicodeString; + function Size: Integer; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + IJclStrQueue = IJclAnsiStrQueue; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclStrQueue = IJclWideStrQueue; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclStrQueue = IJclUnicodeStrQueue; + {$ENDIF CONTAINER_UNICODESTR} + + IJclSingleQueue = interface(IJclSingleContainer) + ['{67D74314-9967-4C99-8A48-6E0ADD73EC29}'] + procedure Clear; + function Contains(const AValue: Single): Boolean; + function Dequeue: Single; + function Empty: Boolean; + function Enqueue(const AValue: Single): Boolean; + function Peek: Single; + function Size: Integer; + end; + + IJclDoubleQueue = interface(IJclDoubleContainer) + ['{FA1B6D25-3456-4963-87DC-5A2E53B2963F}'] + procedure Clear; + function Contains(const AValue: Double): Boolean; + function Dequeue: Double; + function Empty: Boolean; + function Enqueue(const AValue: Double): Boolean; + function Peek: Double; + function Size: Integer; + end; + + IJclExtendedQueue = interface(IJclExtendedContainer) + ['{76F349C0-7681-4BE8-9E94-280C962780D8}'] + procedure Clear; + function Contains(const AValue: Extended): Boolean; + function Dequeue: Extended; + function Empty: Boolean; + function Enqueue(const AValue: Extended): Boolean; + function Peek: Extended; + function Size: Integer; + end; + + {$IFDEF MATH_SINGLE_PRECISION} + IJclFloatQueue = IJclSingleQueue; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclFloatQueue = IJclDoubleQueue; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + IJclFloatQueue = IJclExtendedQueue; + {$ENDIF MATH_EXTENDED_PRECISION} + + IJclIntegerQueue = interface(IJclIntegerContainer) + ['{4C4E174E-5D19-44CE-A248-B5589A9B68DF}'] + procedure Clear; + function Contains(AValue: Integer): Boolean; + function Dequeue: Integer; + function Empty: Boolean; + function Enqueue(AValue: Integer): Boolean; + function Peek: Integer; + function Size: Integer; + end; + + IJclCardinalQueue = interface(IJclCardinalContainer) + ['{CC1D4358-E259-4FB0-BA83-5180A0F8A6C0}'] + procedure Clear; + function Contains(AValue: Cardinal): Boolean; + function Dequeue: Cardinal; + function Empty: Boolean; + function Enqueue(AValue: Cardinal): Boolean; + function Peek: Cardinal; + function Size: Integer; + end; + + IJclInt64Queue = interface(IJclInt64Container) + ['{96B620BB-9A90-43D5-82A7-2D818A11C8E1}'] + procedure Clear; + function Contains(const AValue: Int64): Boolean; + function Dequeue: Int64; + function Empty: Boolean; + function Enqueue(const AValue: Int64): Boolean; + function Peek: Int64; + function Size: Integer; + end; + + IJclPtrQueue = interface(IJclPtrContainer) + ['{1052DD37-3035-4C44-A793-54AC4B9C0B29}'] + procedure Clear; + function Contains(APtr: Pointer): Boolean; + function Dequeue: Pointer; + function Empty: Boolean; + function Enqueue(APtr: Pointer): Boolean; + function Peek: Pointer; + function Size: Integer; + end; + + IJclQueue = interface(IJclContainer) + ['{7D0F9DE4-71EA-46EF-B879-88BCFD5D9610}'] + procedure Clear; + function Contains(AObject: TObject): Boolean; + function Dequeue: TObject; + function Empty: Boolean; + function Enqueue(AObject: TObject): Boolean; + function Peek: TObject; + function Size: Integer; + end; + + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + IJclQueue = interface(IJclBaseContainer) + ['{16AB909F-2194-46CF-BD89-B4207AC0CAB8}'] + procedure Clear; + function Contains(const AItem: T): Boolean; + function Dequeue: T; + function Empty: Boolean; + function Enqueue(const AItem: T): Boolean; + function Peek: T; + function Size: Integer; + end; + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + IJclIntfIntfSortedMap = interface(IJclIntfIntfMap) + ['{265A6EB2-4BB3-459F-8813-360FD32A4971}'] + function FirstKey: IInterface; + function HeadMap(const ToKey: IInterface): IJclIntfIntfSortedMap; + function LastKey: IInterface; + function SubMap(const FromKey, ToKey: IInterface): IJclIntfIntfSortedMap; + function TailMap(const FromKey: IInterface): IJclIntfIntfSortedMap; + end; + + IJclAnsiStrIntfSortedMap = interface(IJclAnsiStrIntfMap) + ['{706D1C91-5416-4FDC-B6B1-F4C1E8CFCD38}'] + function FirstKey: AnsiString; + function HeadMap(const ToKey: AnsiString): IJclAnsiStrIntfSortedMap; + function LastKey: AnsiString; + function SubMap(const FromKey, ToKey: AnsiString): IJclAnsiStrIntfSortedMap; + function TailMap(const FromKey: AnsiString): IJclAnsiStrIntfSortedMap; + end; + + IJclIntfAnsiStrSortedMap = interface(IJclIntfAnsiStrMap) + ['{96E6AC5E-8C40-4795-9C8A-CFD098B58680}'] + function FirstKey: IInterface; + function HeadMap(const ToKey: IInterface): IJclIntfAnsiStrSortedMap; + function LastKey: IInterface; + function SubMap(const FromKey, ToKey: IInterface): IJclIntfAnsiStrSortedMap; + function TailMap(const FromKey: IInterface): IJclIntfAnsiStrSortedMap; + end; + + IJclAnsiStrAnsiStrSortedMap = interface(IJclAnsiStrAnsiStrMap) + ['{4F457799-5D03-413D-A46C-067DC4200CC3}'] + function FirstKey: AnsiString; + function HeadMap(const ToKey: AnsiString): IJclAnsiStrAnsiStrSortedMap; + function LastKey: AnsiString; + function SubMap(const FromKey, ToKey: AnsiString): IJclAnsiStrAnsiStrSortedMap; + function TailMap(const FromKey: AnsiString): IJclAnsiStrAnsiStrSortedMap; + end; + + IJclWideStrIntfSortedMap = interface(IJclWideStrIntfMap) + ['{299FDCFD-2DB7-4D64-BF18-EE3668316430}'] + function FirstKey: WideString; + function HeadMap(const ToKey: WideString): IJclWideStrIntfSortedMap; + function LastKey: WideString; + function SubMap(const FromKey, ToKey: WideString): IJclWideStrIntfSortedMap; + function TailMap(const FromKey: WideString): IJclWideStrIntfSortedMap; + end; + + IJclIntfWideStrSortedMap = interface(IJclIntfWideStrMap) + ['{FBE3AD2E-2781-4DC0-9E80-027027380E21}'] + function FirstKey: IInterface; + function HeadMap(const ToKey: IInterface): IJclIntfWideStrSortedMap; + function LastKey: IInterface; + function SubMap(const FromKey, ToKey: IInterface): IJclIntfWideStrSortedMap; + function TailMap(const FromKey: IInterface): IJclIntfWideStrSortedMap; + end; + + IJclWideStrWideStrSortedMap = interface(IJclWideStrWideStrMap) + ['{3B0757B2-2290-4AFA-880D-F9BA600E501E}'] + function FirstKey: WideString; + function HeadMap(const ToKey: WideString): IJclWideStrWideStrSortedMap; + function LastKey: WideString; + function SubMap(const FromKey, ToKey: WideString): IJclWideStrWideStrSortedMap; + function TailMap(const FromKey: WideString): IJclWideStrWideStrSortedMap; + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclUnicodeStrIntfSortedMap = interface(IJclUnicodeStrIntfMap) + ['{25FDE916-730D-449A-BA29-852D8A0470B6}'] + function FirstKey: UnicodeString; + function HeadMap(const ToKey: UnicodeString): IJclUnicodeStrIntfSortedMap; + function LastKey: UnicodeString; + function SubMap(const FromKey, ToKey: UnicodeString): IJclUnicodeStrIntfSortedMap; + function TailMap(const FromKey: UnicodeString): IJclUnicodeStrIntfSortedMap; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclIntfUnicodeStrSortedMap = interface(IJclIntfUnicodeStrMap) + ['{B0B0CB9B-268B-40D2-94A8-0B8B5BE2E1AC}'] + function FirstKey: IInterface; + function HeadMap(const ToKey: IInterface): IJclIntfUnicodeStrSortedMap; + function LastKey: IInterface; + function SubMap(const FromKey, ToKey: IInterface): IJclIntfUnicodeStrSortedMap; + function TailMap(const FromKey: IInterface): IJclIntfUnicodeStrSortedMap; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclUnicodeStrUnicodeStrSortedMap = interface(IJclUnicodeStrUnicodeStrMap) + ['{D8EACC5D-B31E-47A8-9CC9-32B15A79CACA}'] + function FirstKey: UnicodeString; + function HeadMap(const ToKey: UnicodeString): IJclUnicodeStrUnicodeStrSortedMap; + function LastKey: UnicodeString; + function SubMap(const FromKey, ToKey: UnicodeString): IJclUnicodeStrUnicodeStrSortedMap; + function TailMap(const FromKey: UnicodeString): IJclUnicodeStrUnicodeStrSortedMap; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + IJclStrIntfSortedMap = IJclAnsiStrIntfSortedMap; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclStrIntfSortedMap = IJclWideStrIntfSortedMap; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclStrIntfSortedMap = IJclUnicodeStrIntfSortedMap; + {$ENDIF CONTAINER_UNICODESTR} + + {$IFDEF CONTAINER_ANSISTR} + IJclIntfStrSortedMap = IJclIntfAnsiStrSortedMap; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclIntfStrSortedMap = IJclIntfWideStrSortedMap; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclIntfStrSortedMap = IJclIntfUnicodeStrSortedMap; + {$ENDIF CONTAINER_UNICODESTR} + + {$IFDEF CONTAINER_ANSISTR} + IJclStrStrSortedMap = IJclAnsiStrAnsiStrSortedMap; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclStrStrSortedMap = IJclWideStrWideStrSortedMap; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclStrStrSortedMap = IJclUnicodeStrUnicodeStrSortedMap; + {$ENDIF CONTAINER_UNICODESTR} + + IJclSingleIntfSortedMap = interface(IJclSingleIntfMap) + ['{83D57068-7B8E-453E-B35B-2AB4B594A7A9}'] + function FirstKey: Single; + function HeadMap(const ToKey: Single): IJclSingleIntfSortedMap; + function LastKey: Single; + function SubMap(const FromKey, ToKey: Single): IJclSingleIntfSortedMap; + function TailMap(const FromKey: Single): IJclSingleIntfSortedMap; + end; + + IJclIntfSingleSortedMap = interface(IJclIntfSingleMap) + ['{B07FA192-3466-4F2A-BBF0-2DC0100B08A8}'] + function FirstKey: IInterface; + function HeadMap(const ToKey: IInterface): IJclIntfSingleSortedMap; + function LastKey: IInterface; + function SubMap(const FromKey, ToKey: IInterface): IJclIntfSingleSortedMap; + function TailMap(const FromKey: IInterface): IJclIntfSingleSortedMap; + end; + + IJclSingleSingleSortedMap = interface(IJclSingleSingleMap) + ['{7C6EA0B4-959D-44D5-915F-99DFC1753B00}'] + function FirstKey: Single; + function HeadMap(const ToKey: Single): IJclSingleSingleSortedMap; + function LastKey: Single; + function SubMap(const FromKey, ToKey: Single): IJclSingleSingleSortedMap; + function TailMap(const FromKey: Single): IJclSingleSingleSortedMap; + end; + + IJclDoubleIntfSortedMap = interface(IJclDoubleIntfMap) + ['{F36C5F4F-4F8C-4943-AA35-41623D3C21E9}'] + function FirstKey: Double; + function HeadMap(const ToKey: Double): IJclDoubleIntfSortedMap; + function LastKey: Double; + function SubMap(const FromKey, ToKey: Double): IJclDoubleIntfSortedMap; + function TailMap(const FromKey: Double): IJclDoubleIntfSortedMap; + end; + + IJclIntfDoubleSortedMap = interface(IJclIntfDoubleMap) + ['{0F16ADAE-F499-4857-B5EA-6F3CC9009DBA}'] + function FirstKey: IInterface; + function HeadMap(const ToKey: IInterface): IJclIntfDoubleSortedMap; + function LastKey: IInterface; + function SubMap(const FromKey, ToKey: IInterface): IJclIntfDoubleSortedMap; + function TailMap(const FromKey: IInterface): IJclIntfDoubleSortedMap; + end; + + IJclDoubleDoubleSortedMap = interface(IJclDoubleDoubleMap) + ['{855C858B-74CF-4338-872B-AF88A02DB537}'] + function FirstKey: Double; + function HeadMap(const ToKey: Double): IJclDoubleDoubleSortedMap; + function LastKey: Double; + function SubMap(const FromKey, ToKey: Double): IJclDoubleDoubleSortedMap; + function TailMap(const FromKey: Double): IJclDoubleDoubleSortedMap; + end; + + IJclExtendedIntfSortedMap = interface(IJclExtendedIntfMap) + ['{A30B8835-A319-4776-9A11-D1EEF60B9C26}'] + function FirstKey: Extended; + function HeadMap(const ToKey: Extended): IJclExtendedIntfSortedMap; + function LastKey: Extended; + function SubMap(const FromKey, ToKey: Extended): IJclExtendedIntfSortedMap; + function TailMap(const FromKey: Extended): IJclExtendedIntfSortedMap; + end; + + IJclIntfExtendedSortedMap = interface(IJclIntfExtendedMap) + ['{3493D6C4-3075-48B6-8E99-CB0000D3978C}'] + function FirstKey: IInterface; + function HeadMap(const ToKey: IInterface): IJclIntfExtendedSortedMap; + function LastKey: IInterface; + function SubMap(const FromKey, ToKey: IInterface): IJclIntfExtendedSortedMap; + function TailMap(const FromKey: IInterface): IJclIntfExtendedSortedMap; + end; + + IJclExtendedExtendedSortedMap = interface(IJclExtendedExtendedMap) + ['{8CAA505C-D9BB-47E7-92EC-6043DC4AF42C}'] + function FirstKey: Extended; + function HeadMap(const ToKey: Extended): IJclExtendedExtendedSortedMap; + function LastKey: Extended; + function SubMap(const FromKey, ToKey: Extended): IJclExtendedExtendedSortedMap; + function TailMap(const FromKey: Extended): IJclExtendedExtendedSortedMap; + end; + + {$IFDEF MATH_SINGLE_PRECISION} + IJclFloatIntfSortedMap = IJclSingleIntfSortedMap; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclFloatIntfSortedMap = IJclDoubleIntfSortedMap; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + IJclFloatIntfSortedMap = IJclExtendedIntfSortedMap; + {$ENDIF MATH_EXTENDED_PRECISION} + + {$IFDEF MATH_SINGLE_PRECISION} + IJclIntfFloatSortedMap = IJclIntfSingleSortedMap; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclIntfFloatSortedMap = IJclIntfDoubleSortedMap; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + IJclIntfFloatSortedMap = IJclIntfExtendedSortedMap; + {$ENDIF MATH_EXTENDED_PRECISION} + + {$IFDEF MATH_SINGLE_PRECISION} + IJclFloatFloatSortedMap = IJclSingleSingleSortedMap; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclFloatFloatSortedMap = IJclDoubleDoubleSortedMap; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + IJclFloatFloatSortedMap = IJclExtendedExtendedSortedMap; + {$ENDIF MATH_EXTENDED_PRECISION} + + IJclIntegerIntfSortedMap = interface(IJclIntegerIntfMap) + ['{8B22802C-61F2-4DA5-B1E9-DBB7840E7996}'] + function FirstKey: Integer; + function HeadMap(ToKey: Integer): IJclIntegerIntfSortedMap; + function LastKey: Integer; + function SubMap(FromKey, ToKey: Integer): IJclIntegerIntfSortedMap; + function TailMap(FromKey: Integer): IJclIntegerIntfSortedMap; + end; + + IJclIntfIntegerSortedMap = interface(IJclIntfIntegerMap) + ['{8D3C9B7E-772D-409B-A58C-0CABFAFDEFF0}'] + function FirstKey: IInterface; + function HeadMap(const ToKey: IInterface): IJclIntfIntegerSortedMap; + function LastKey: IInterface; + function SubMap(const FromKey, ToKey: IInterface): IJclIntfIntegerSortedMap; + function TailMap(const FromKey: IInterface): IJclIntfIntegerSortedMap; + end; + + IJclIntegerIntegerSortedMap = interface(IJclIntegerIntegerMap) + ['{8A8BA17A-F468-469C-AF99-77D64C802F7A}'] + function FirstKey: Integer; + function HeadMap(ToKey: Integer): IJclIntegerIntegerSortedMap; + function LastKey: Integer; + function SubMap(FromKey, ToKey: Integer): IJclIntegerIntegerSortedMap; + function TailMap(FromKey: Integer): IJclIntegerIntegerSortedMap; + end; + + IJclCardinalIntfSortedMap = interface(IJclCardinalIntfMap) + ['{BAE97425-4F2E-461B-88DD-F83D27657AFA}'] + function FirstKey: Cardinal; + function HeadMap(ToKey: Cardinal): IJclCardinalIntfSortedMap; + function LastKey: Cardinal; + function SubMap(FromKey, ToKey: Cardinal): IJclCardinalIntfSortedMap; + function TailMap(FromKey: Cardinal): IJclCardinalIntfSortedMap; + end; + + IJclIntfCardinalSortedMap = interface(IJclIntfCardinalMap) + ['{BC66BACF-23AE-48C4-9573-EDC3B5110BE7}'] + function FirstKey: IInterface; + function HeadMap(const ToKey: IInterface): IJclIntfCardinalSortedMap; + function LastKey: IInterface; + function SubMap(const FromKey, ToKey: IInterface): IJclIntfCardinalSortedMap; + function TailMap(const FromKey: IInterface): IJclIntfCardinalSortedMap; + end; + + IJclCardinalCardinalSortedMap = interface(IJclCardinalCardinalMap) + ['{182ACDA4-7D74-4D29-BB5C-4C8189DA774E}'] + function FirstKey: Cardinal; + function HeadMap(ToKey: Cardinal): IJclCardinalCardinalSortedMap; + function LastKey: Cardinal; + function SubMap(FromKey, ToKey: Cardinal): IJclCardinalCardinalSortedMap; + function TailMap(FromKey: Cardinal): IJclCardinalCardinalSortedMap; + end; + + IJclInt64IntfSortedMap = interface(IJclInt64IntfMap) + ['{24391756-FB02-4901-81E3-A37738B73DAD}'] + function FirstKey: Int64; + function HeadMap(const ToKey: Int64): IJclInt64IntfSortedMap; + function LastKey: Int64; + function SubMap(const FromKey, ToKey: Int64): IJclInt64IntfSortedMap; + function TailMap(const FromKey: Int64): IJclInt64IntfSortedMap; + end; + + IJclIntfInt64SortedMap = interface(IJclIntfInt64Map) + ['{6E2AB647-59CC-4609-82E8-6AE75AED80CA}'] + function FirstKey: IInterface; + function HeadMap(const ToKey: IInterface): IJclIntfInt64SortedMap; + function LastKey: IInterface; + function SubMap(const FromKey, ToKey: IInterface): IJclIntfInt64SortedMap; + function TailMap(const FromKey: IInterface): IJclIntfInt64SortedMap; + end; + + IJclInt64Int64SortedMap = interface(IJclInt64Int64Map) + ['{168581D2-9DD3-46D0-934E-EA0CCE5E3C0C}'] + function FirstKey: Int64; + function HeadMap(const ToKey: Int64): IJclInt64Int64SortedMap; + function LastKey: Int64; + function SubMap(const FromKey, ToKey: Int64): IJclInt64Int64SortedMap; + function TailMap(const FromKey: Int64): IJclInt64Int64SortedMap; + end; + + IJclPtrIntfSortedMap = interface(IJclPtrIntfMap) + ['{6D7B8042-3CBC-4C8F-98B5-69AFAA104532}'] + function FirstKey: Pointer; + function HeadMap(ToKey: Pointer): IJclPtrIntfSortedMap; + function LastKey: Pointer; + function SubMap(FromKey, ToKey: Pointer): IJclPtrIntfSortedMap; + function TailMap(FromKey: Pointer): IJclPtrIntfSortedMap; + end; + + IJclIntfPtrSortedMap = interface(IJclIntfPtrMap) + ['{B054BDA2-536F-4C16-B6BB-BB64FA0818B3}'] + function FirstKey: IInterface; + function HeadMap(const ToKey: IInterface): IJclIntfPtrSortedMap; + function LastKey: IInterface; + function SubMap(const FromKey, ToKey: IInterface): IJclIntfPtrSortedMap; + function TailMap(const FromKey: IInterface): IJclIntfPtrSortedMap; + end; + + IJclPtrPtrSortedMap = interface(IJclPtrPtrMap) + ['{F1FAE922-0212-41D0-BB4E-76A8AB2CAB86}'] + function FirstKey: Pointer; + function HeadMap(ToKey: Pointer): IJclPtrPtrSortedMap; + function LastKey: Pointer; + function SubMap(FromKey, ToKey: Pointer): IJclPtrPtrSortedMap; + function TailMap(FromKey: Pointer): IJclPtrPtrSortedMap; + end; + + IJclIntfSortedMap = interface(IJclIntfMap) + ['{3CED1477-B958-4109-9BDA-7C84B9E063B2}'] + function FirstKey: IInterface; + function HeadMap(const ToKey: IInterface): IJclIntfSortedMap; + function LastKey: IInterface; + function SubMap(const FromKey, ToKey: IInterface): IJclIntfSortedMap; + function TailMap(const FromKey: IInterface): IJclIntfSortedMap; + end; + + IJclAnsiStrSortedMap = interface(IJclAnsiStrMap) + ['{573F98E3-EBCD-4F28-8F35-96A7366CBF47}'] + function FirstKey: AnsiString; + function HeadMap(const ToKey: AnsiString): IJclAnsiStrSortedMap; + function LastKey: AnsiString; + function SubMap(const FromKey, ToKey: AnsiString): IJclAnsiStrSortedMap; + function TailMap(const FromKey: AnsiString): IJclAnsiStrSortedMap; + end; + + IJclWideStrSortedMap = interface(IJclWideStrMap) + ['{B3021EFC-DE25-4B4B-A896-ACE823CD5C01}'] + function FirstKey: WideString; + function HeadMap(const ToKey: WideString): IJclWideStrSortedMap; + function LastKey: WideString; + function SubMap(const FromKey, ToKey: WideString): IJclWideStrSortedMap; + function TailMap(const FromKey: WideString): IJclWideStrSortedMap; + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclUnicodeStrSortedMap = interface(IJclUnicodeStrMap) + ['{5510B8FC-3439-4211-8D1F-5EDD9A56D3E3}'] + function FirstKey: UnicodeString; + function HeadMap(const ToKey: UnicodeString): IJclUnicodeStrSortedMap; + function LastKey: UnicodeString; + function SubMap(const FromKey, ToKey: UnicodeString): IJclUnicodeStrSortedMap; + function TailMap(const FromKey: UnicodeString): IJclUnicodeStrSortedMap; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + IJclStrSortedMap = IJclAnsiStrSortedMap; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclStrSortedMap = IJclWideStrSortedMap; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclStrSortedMap = IJclUnicodeStrSortedMap; + {$ENDIF CONTAINER_UNICODESTR} + + IJclSingleSortedMap = interface(IJclSingleMap) + ['{8C1A12BE-A7F2-4351-90B7-25DB0AAF5F94}'] + function FirstKey: Single; + function HeadMap(const ToKey: Single): IJclSingleSortedMap; + function LastKey: Single; + function SubMap(const FromKey, ToKey: Single): IJclSingleSortedMap; + function TailMap(const FromKey: Single): IJclSingleSortedMap; + end; + + IJclDoubleSortedMap = interface(IJclDoubleMap) + ['{8018D66B-AA54-4016-84FC-3E780FFCC38B}'] + function FirstKey: Double; + function HeadMap(const ToKey: Double): IJclDoubleSortedMap; + function LastKey: Double; + function SubMap(const FromKey, ToKey: Double): IJclDoubleSortedMap; + function TailMap(const FromKey: Double): IJclDoubleSortedMap; + end; + + IJclExtendedSortedMap = interface(IJclExtendedMap) + ['{2B82C65A-B3EF-477D-BEC0-3D8620A226B1}'] + function FirstKey: Extended; + function HeadMap(const ToKey: Extended): IJclExtendedSortedMap; + function LastKey: Extended; + function SubMap(const FromKey, ToKey: Extended): IJclExtendedSortedMap; + function TailMap(const FromKey: Extended): IJclExtendedSortedMap; + end; + + {$IFDEF MATH_SINGLE_PRECISION} + IJclFloatSortedMap = IJclSingleSortedMap; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclFloatSortedMap = IJclDoubleSortedMap; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + IJclFloatSortedMap = IJclExtendedSortedMap; + {$ENDIF MATH_EXTENDED_PRECISION} + + IJclIntegerSortedMap = interface(IJclIntegerMap) + ['{DD7B4C5E-6D51-44CC-9328-B38396A7E1C9}'] + function FirstKey: Integer; + function HeadMap(ToKey: Integer): IJclIntegerSortedMap; + function LastKey: Integer; + function SubMap(FromKey, ToKey: Integer): IJclIntegerSortedMap; + function TailMap(FromKey: Integer): IJclIntegerSortedMap; + end; + + IJclCardinalSortedMap = interface(IJclCardinalMap) + ['{4AEAF81F-D72E-4499-B10E-3D017F39915E}'] + function FirstKey: Cardinal; + function HeadMap(ToKey: Cardinal): IJclCardinalSortedMap; + function LastKey: Cardinal; + function SubMap(FromKey, ToKey: Cardinal): IJclCardinalSortedMap; + function TailMap(FromKey: Cardinal): IJclCardinalSortedMap; + end; + + IJclInt64SortedMap = interface(IJclInt64Map) + ['{06C03F90-7DE9-4043-AA56-AAE071D8BD50}'] + function FirstKey: Int64; + function HeadMap(const ToKey: Int64): IJclInt64SortedMap; + function LastKey: Int64; + function SubMap(const FromKey, ToKey: Int64): IJclInt64SortedMap; + function TailMap(const FromKey: Int64): IJclInt64SortedMap; + end; + + IJclPtrSortedMap = interface(IJclPtrMap) + ['{578918DB-6A4A-4A9D-B44E-AE3E8FF70818}'] + function FirstKey: Pointer; + function HeadMap(ToKey: Pointer): IJclPtrSortedMap; + function LastKey: Pointer; + function SubMap(FromKey, ToKey: Pointer): IJclPtrSortedMap; + function TailMap(FromKey: Pointer): IJclPtrSortedMap; + end; + + IJclSortedMap = interface(IJclMap) + ['{F317A70F-7851-49C2-9DCF-092D8F4D4F98}'] + function FirstKey: TObject; + function HeadMap(ToKey: TObject): IJclSortedMap; + function LastKey: TObject; + function SubMap(FromKey, ToKey: TObject): IJclSortedMap; + function TailMap(FromKey: TObject): IJclSortedMap; + end; + + + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + IJclSortedMap = interface(IJclMap) + ['{C62B75C4-891B-442E-A5D6-9954E75A5C0C}'] + function FirstKey: TKey; + function HeadMap(const ToKey: TKey): IJclSortedMap; + function LastKey: TKey; + function SubMap(const FromKey, ToKey: TKey): IJclSortedMap; + function TailMap(const FromKey: TKey): IJclSortedMap; + end; + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + IJclIntfSortedSet = interface(IJclIntfSet) + ['{159BE5A7-7349-42FF-BE55-9CA1B9DBA991}'] + function HeadSet(const Finish: IInterface): IJclIntfSortedSet; + function SubSet(const Start, Finish: IInterface): IJclIntfSortedSet; + function TailSet(const Start: IInterface): IJclIntfSortedSet; + end; + + IJclAnsiStrSortedSet = interface(IJclAnsiStrSet) + ['{03198146-F967-4310-868B-7AD3D52D5CBE}'] + function HeadSet(const Finish: AnsiString): IJclAnsiStrSortedSet; + function SubSet(const Start, Finish: AnsiString): IJclAnsiStrSortedSet; + function TailSet(const Start: AnsiString): IJclAnsiStrSortedSet; + end; + + IJclWideStrSortedSet = interface(IJclWideStrSet) + ['{ED9567E2-C1D3-4C00-A1D4-90D5C7E27C2D}'] + function HeadSet(const Finish: WideString): IJclWideStrSortedSet; + function SubSet(const Start, Finish: WideString): IJclWideStrSortedSet; + function TailSet(const Start: WideString): IJclWideStrSortedSet; + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclUnicodeStrSortedSet = interface(IJclUnicodeStrSet) + ['{172BCD6F-D23C-4014-9C8C-A77A27D6E881}'] + function HeadSet(const Finish: UnicodeString): IJclUnicodeStrSortedSet; + function SubSet(const Start, Finish: UnicodeString): IJclUnicodeStrSortedSet; + function TailSet(const Start: UnicodeString): IJclUnicodeStrSortedSet; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + IJclStrSortedSet = IJclAnsiStrSortedSet; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclStrSortedSet = IJclWideStrSortedSet; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclStrSortedSet = IJclUnicodeStrSortedSet; + {$ENDIF CONTAINER_UNICODESTR} + + IJclSingleSortedSet = interface(IJclSingleSet) + ['{65EDA801-9E04-4119-BF9E-D7DD4AF82144}'] + function HeadSet(const Finish: Single): IJclSingleSortedSet; + function SubSet(const Start, Finish: Single): IJclSingleSortedSet; + function TailSet(const Start: Single): IJclSingleSortedSet; + end; + + IJclDoubleSortedSet = interface(IJclDoubleSet) + ['{DA0E689F-BAFE-4BCE-85E4-C38E780BC84C}'] + function HeadSet(const Finish: Double): IJclDoubleSortedSet; + function SubSet(const Start, Finish: Double): IJclDoubleSortedSet; + function TailSet(const Start: Double): IJclDoubleSortedSet; + end; + + IJclExtendedSortedSet = interface(IJclExtendedSet) + ['{A9875ED3-81A4-43A3-86BB-3429F51B278B}'] + function HeadSet(const Finish: Extended): IJclExtendedSortedSet; + function SubSet(const Start, Finish: Extended): IJclExtendedSortedSet; + function TailSet(const Start: Extended): IJclExtendedSortedSet; + end; + + {$IFDEF MATH_SINGLE_PRECISION} + IJclFloatSortedSet = IJclSingleSortedSet; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclFloatSortedSet = IJclDoubleSortedSet; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + IJclFloatSortedSet = IJclExtendedSortedSet; + {$ENDIF MATH_EXTENDED_PRECISION} + + IJclIntegerSortedSet = interface(IJclIntegerSet) + ['{E086C54B-4FA3-426D-AC4E-FF8E8CA3D663}'] + function HeadSet(Finish: Integer): IJclIntegerSortedSet; + function SubSet(Start, Finish: Integer): IJclIntegerSortedSet; + function TailSet(Start: Integer): IJclIntegerSortedSet; + end; + + IJclCardinalSortedSet = interface(IJclCardinalSet) + ['{2D7995C6-A784-48B6-87E9-55D394A72362}'] + function HeadSet(Finish: Cardinal): IJclCardinalSortedSet; + function SubSet(Start, Finish: Cardinal): IJclCardinalSortedSet; + function TailSet(Start: Cardinal): IJclCardinalSortedSet; + end; + + IJclInt64SortedSet = interface(IJclInt64Set) + ['{4C1C3FCA-6169-4A2F-B044-91AC2AA2E954}'] + function HeadSet(const Finish: Int64): IJclInt64SortedSet; + function SubSet(const Start, Finish: Int64): IJclInt64SortedSet; + function TailSet(const Start: Int64): IJclInt64SortedSet; + end; + + IJclPtrSortedSet = interface(IJclPtrSet) + ['{F3A3183C-0820-425C-9446-E0838F0ADAD8}'] + function HeadSet(Finish: Pointer): IJclPtrSortedSet; + function SubSet(Start, Finish: Pointer): IJclPtrSortedSet; + function TailSet(Start: Pointer): IJclPtrSortedSet; + end; + + IJclSortedSet = interface(IJclSet) + ['{A3D23E76-ADE9-446C-9B97-F49FCE895D9F}'] + function HeadSet(Finish: TObject): IJclSortedSet; + function SubSet(Start, Finish: TObject): IJclSortedSet; + function TailSet(Start: TObject): IJclSortedSet; + end; + + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + IJclSortedSet = interface(IJclSet) + ['{30F836E3-2FB1-427E-A499-DFAE201633C8}'] + function HeadSet(const Finish: T): IJclSortedSet; + function SubSet(const Start, Finish: T): IJclSortedSet; + function TailSet(const Start: T): IJclSortedSet; + end; + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + IJclIntfStack = interface(IJclIntfContainer) + ['{CA1DC7A1-8D8F-4A5D-81D1-0FE32E9A4E84}'] + procedure Clear; + function Contains(const AInterface: IInterface): Boolean; + function Empty: Boolean; + function Peek: IInterface; + function Pop: IInterface; + function Push(const AInterface: IInterface): Boolean; + function Size: Integer; + end; + + IJclAnsiStrStack = interface(IJclAnsiStrContainer) + ['{649BB74C-D7BE-40D9-9F4E-32DDC3F13F3B}'] + procedure Clear; + function Contains(const AString: AnsiString): Boolean; + function Empty: Boolean; + function Peek: AnsiString; + function Pop: AnsiString; + function Push(const AString: AnsiString): Boolean; + function Size: Integer; + end; + + IJclWideStrStack = interface(IJclWideStrContainer) + ['{B2C3B165-33F1-4B7D-A2EC-0B19D12CE33C}'] + procedure Clear; + function Contains(const AString: WideString): Boolean; + function Empty: Boolean; + function Peek: WideString; + function Pop: WideString; + function Push(const AString: WideString): Boolean; + function Size: Integer; + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclUnicodeStrStack = interface(IJclUnicodeStrContainer) + ['{BC046C3D-E3D2-42BA-A96D-054834A70404}'] + procedure Clear; + function Contains(const AString: UnicodeString): Boolean; + function Empty: Boolean; + function Peek: UnicodeString; + function Pop: UnicodeString; + function Push(const AString: UnicodeString): Boolean; + function Size: Integer; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + IJclStrStack = IJclAnsiStrStack; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclStrStack = IJclWideStrStack; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclStrStack = IJclUnicodeStrStack; + {$ENDIF CONTAINER_UNICODESTR} + + IJclSingleStack = interface(IJclSingleContainer) + ['{8DCE45C8-B5B3-43AB-BA08-DAD531CEB9CF}'] + procedure Clear; + function Contains(const AValue: Single): Boolean; + function Empty: Boolean; + function Peek: Single; + function Pop: Single; + function Push(const AValue: Single): Boolean; + function Size: Integer; + end; + + IJclDoubleStack = interface(IJclDoubleContainer) + ['{46DF2701-16F0-453C-B938-F04E9C1CEBF8}'] + procedure Clear; + function Contains(const AValue: Double): Boolean; + function Empty: Boolean; + function Peek: Double; + function Pop: Double; + function Push(const AValue: Double): Boolean; + function Size: Integer; + end; + + IJclExtendedStack = interface(IJclExtendedContainer) + ['{A2A30585-F561-4757-ABE1-CA511AE72CC5}'] + procedure Clear; + function Contains(const AValue: Extended): Boolean; + function Empty: Boolean; + function Peek: Extended; + function Pop: Extended; + function Push(const AValue: Extended): Boolean; + function Size: Integer; + end; + + {$IFDEF MATH_SINGLE_PRECISION} + IJclFloatStack = IJclSingleStack; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclFloatStack = IJclDoubleStack; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + IJclFloatStack = IJclExtendedStack; + {$ENDIF MATH_EXTENDED_PRECISION} + + IJclIntegerStack = interface(IJclIntegerContainer) + ['{9190BF0E-5B0C-4D6C-A107-20A933C9B56A}'] + procedure Clear; + function Contains(AValue: Integer): Boolean; + function Empty: Boolean; + function Peek: Integer; + function Pop: Integer; + function Push(AValue: Integer): Boolean; + function Size: Integer; + end; + + IJclCardinalStack = interface(IJclCardinalContainer) + ['{94F9EDB3-602B-49CE-9990-0AFDAC556F83}'] + procedure Clear; + function Contains(AValue: Cardinal): Boolean; + function Empty: Boolean; + function Peek: Cardinal; + function Pop: Cardinal; + function Push(AValue: Cardinal): Boolean; + function Size: Integer; + end; + + IJclInt64Stack = interface(IJclInt64Container) + ['{D689EB8F-2746-40E9-AD1B-7E656475FC64}'] + procedure Clear; + function Contains(const AValue: Int64): Boolean; + function Empty: Boolean; + function Peek: Int64; + function Pop: Int64; + function Push(const AValue: Int64): Boolean; + function Size: Integer; + end; + + IJclPtrStack = interface(IJclPtrContainer) + ['{AD11D06C-E0E1-4EDE-AA2F-BC8BDD972B73}'] + procedure Clear; + function Contains(APtr: Pointer): Boolean; + function Empty: Boolean; + function Peek: Pointer; + function Pop: Pointer; + function Push(APtr: Pointer): Boolean; + function Size: Integer; + end; + + IJclStack = interface(IJclContainer) + ['{E07E0BD8-A831-41B9-B9A0-7199BD4873B9}'] + procedure Clear; + function Contains(AObject: TObject): Boolean; + function Empty: Boolean; + function Peek: TObject; + function Pop: TObject; + function Push(AObject: TObject): Boolean; + function Size: Integer; + end; + + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + IJclStack = interface(IJclBaseContainer) + ['{2F08EAC9-270D-496E-BE10-5E975918A5F2}'] + procedure Clear; + function Contains(const AItem: T): Boolean; + function Empty: Boolean; + function Peek: T; + function Pop: T; + function Push(const AItem: T): Boolean; + function Size: Integer; + end; + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + // Exceptions + EJclContainerError = class(EJclError); + + EJclOutOfBoundsError = class(EJclContainerError) + public + // RsEOutOfBounds + constructor Create; + end; + + EJclNoSuchElementError = class(EJclContainerError) + public + // RsEValueNotFound + constructor Create(const Value: string); + end; + + EJclDuplicateElementError = class(EJclContainerError) + public + // RsEDuplicateElement + constructor Create; + end; + + EJclIllegalArgumentError = class(EJclContainerError) + end; + + EJclNoCollectionError = class(EJclIllegalArgumentError) + public + // RsENoCollection + constructor Create; + end; + + EJclIllegalQueueCapacityError = class(EJclIllegalArgumentError) + public + // RsEIllegalQueueCapacity + constructor Create; + end; + + EJclOperationNotSupportedError = class(EJclContainerError) + public + // RsEOperationNotSupported + constructor Create; + end; + + EJclNoEqualityComparerError = class(EJclContainerError) + public + // RsENoEqualityComparer + constructor Create; + end; + + EJclNoComparerError = class(EJclContainerError) + public + // RsENoComparer + constructor Create; + end; + + EJclNoHashConverterError = class(EJclContainerError) + public + // RsENoHashConverter + constructor Create; + end; + + EJclIllegalStateOperationError = class(EJclContainerError) + public + // RsEIllegalStateOperation + constructor Create; + end; + + EJclAssignError = class(EJclContainerError) + public + // RsEAssignError + constructor Create; + end; + + EJclReadOnlyError = class(EJclContainerError) + public + // RsEReadOnlyError + constructor Create; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclResources; + +//=== { EJclOutOfBoundsError } =============================================== + +constructor EJclOutOfBoundsError.Create; +begin + inherited CreateRes(@RsEOutOfBounds); +end; + +//=== { EJclNoSuchElementError } ============================================= + +constructor EJclNoSuchElementError.Create(const Value: string); +begin + inherited CreateResFmt(@RsEValueNotFound, [Value]); +end; + +//=== { EJclDuplicateElementError } ========================================== + +constructor EJclDuplicateElementError.Create; +begin + inherited CreateRes(@RsEDuplicateElement); +end; + +//=== { EJclIllegalQueueCapacityError } ====================================== + +constructor EJclIllegalQueueCapacityError.Create; +begin + inherited CreateRes(@RsEIllegalQueueCapacity); +end; + +//=== { EJclNoCollectionError } ============================================== + +constructor EJclNoCollectionError.Create; +begin + inherited CreateRes(@RsENoCollection); +end; + +//=== { EJclOperationNotSupportedError } ===================================== + +constructor EJclOperationNotSupportedError.Create; +begin + inherited CreateRes(@RsEOperationNotSupported); +end; + +//=== { EJclIllegalStateOperationError } ===================================== + +constructor EJclIllegalStateOperationError.Create; +begin + inherited CreateRes(@RsEIllegalStateOperation); +end; + +//=== { EJclNoComparerError } ================================================ + +constructor EJclNoComparerError.Create; +begin + inherited CreateRes(@RsENoComparer); +end; + +//=== { EJclNoEqualityComparerError } ======================================== + +constructor EJclNoEqualityComparerError.Create; +begin + inherited CreateRes(@RsENoEqualityComparer); +end; + +//=== { EJclNoHashConverterError } =========================================== + +constructor EJclNoHashConverterError.Create; +begin + inherited CreateRes(@RsENoHashConverter); +end; + +//=== { EJclAssignError } ==================================================== + +constructor EJclAssignError.Create; +begin + inherited CreateRes(@RsEAssignError); +end; + +//=== { EJclReadOnlyError } ================================================== + +constructor EJclReadOnlyError.Create; +begin + inherited CreateRes(@RsEReadOnlyError); +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclCounter.pas b/3rdParty/JCL/source/common/JclCounter.pas new file mode 100644 index 00000000..6d29ee8f --- /dev/null +++ b/3rdParty/JCL/source/common/JclCounter.pas @@ -0,0 +1,251 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclCounter.pas. } +{ } +{ The Initial Developers of the Original Code are Theo Bebekis and Marcel van Brakel. } +{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. All Rights Reserved. } +{ Portions created by Theo Bebekis are Copyright (C) Theo Bebekis. All Rights Reserved. } +{ } +{ Contributor(s): } +{ Theo Bebekis } +{ Marcel van Brakel } +{ Robert Marquardt (marquardt) } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ } +{**************************************************************************************************} +{ } +{ This unit contains a high performance counter class which can be used for highly accurate timing } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclCounter; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Winapi.Windows, + {$ENDIF MSWINDOWS} + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + JclBase; + +type + TJclCounter = class(TObject) + private + FCounting: Boolean; + FElapsedTime: Float; + FOverhead: Int64; + FOverallElapsedTime: Float; + FFrequency: Int64; + FStart: Int64; + FStop: Int64; + {$IFDEF LINUX} + FTimeval: TTimeval; + {$ENDIF LINUX} + protected + function GetRunElapsedTime: Float; + public + constructor Create(const Compensate: Boolean = False); + procedure Continue; + procedure Start; + function Stop: Float; + property Counting: Boolean read FCounting; + property ElapsedTime: Float read FElapsedTime; + property Overhead: Int64 read FOverhead; + property RunElapsedTime: Float read GetRunElapsedTime; + end; + +procedure ContinueCount(var Counter: TJclCounter); +procedure StartCount(var Counter: TJclCounter; const Compensate: Boolean = False); +function StopCount(var Counter: TJclCounter): Float; + +type + EJclCounterError = class(EJclError); + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclResources; + +procedure NoCounterError; +begin + raise EJclCounterError.CreateRes(@RsNoCounter); +end; + +constructor TJclCounter.Create(const Compensate: Boolean); +const + Iterations: Integer = 10000; +var + Count: Integer; + TmpOverhead: Int64; +begin + inherited Create; + + {$IFDEF MSWINDOWS} + if not QueryPerformanceFrequency(FFrequency) then + NoCounterError; + {$ENDIF MSWINDOWS} + {$IFDEF LINUX} + FFrequency := 100000; // 1 sec = 10E6 microseconds, therefore we have to divide by 10E5 + {$ENDIF LINUX} + + FCounting := False; + FOverhead := 0; + + if Compensate then + begin + // Determine overhead associated with calling of the Start and Stop methods. + // This allows the Stop method to compensate for it and return a more + // accurate result. Thanks to John O'Harrow (john att elmcrest dott demon dott co dott uk) + TmpOverhead := 0; + for Count := 0 to Iterations-1 do + begin + Start; + Stop; + TmpOverhead := TmpOverhead + (FStop - FStart); + end; + FOverHead := Round(TmpOverhead / Iterations); + end; + + FOverallElapsedTime := 0; + FElapsedTime := 0; +end; + +procedure TJclCounter.Start; +begin + FCounting := True; + FElapsedTime := 0; + FOverallElapsedTime := 0; + {$IFDEF MSWINDOWS} + if not QueryPerformanceCounter(FStart) then + NoCounterError; + {$ENDIF MSWINDOWS} + {$IFDEF LINUX} + GetTimeOfDay(FTimeval, nil); + FStart := FTimeval.tv_sec * 100000 + (FTimeval.tv_usec); + {$ENDIF LINUX} +end; + +function TJclCounter.Stop: Float; +begin + {$IFDEF MSWINDOWS} + if not QueryPerformanceCounter(FStop) then + NoCounterError; + {$ENDIF MSWINDOWS} + {$IFDEF LINUX} + GetTimeOfDay(FTimeval, nil); + FStop := FTimeval.tv_sec * 100000 + (FTimeval.tv_usec); + {$ENDIF LINUX} + FCounting := False; + FElapsedTime := FOverallElapsedTime + ((FStop - FStart - FOverhead) / FFrequency); + FOverallElapsedTime := FElapsedTime; + Result := FElapsedTime; +end; + +function TJclCounter.GetRunElapsedTime: Float; +var + TimeNow: Int64; +begin + {$IFDEF MSWINDOWS} + TimeNow := 0; + if not QueryPerformanceCounter(TimeNow) then + NoCounterError; + {$ENDIF MSWINDOWS} + {$IFDEF LINUX} + GetTimeOfDay(FTimeval, nil); + TimeNow := FTimeval.tv_sec * 100000 + (FTimeval.tv_usec); + {$ENDIF LINUX} + Result := FOverallElapsedTime + ((TimeNow - FStart - FOverhead) / FFrequency); +end; + +procedure TJclCounter.Continue; +var + Overall: Float; +begin + if not(FCounting) then + begin + Overall := FOverallElapsedTime; + Start; + FOverallElapsedTime := Overall; + end; +end; + +procedure StartCount(var Counter: TJclCounter; const Compensate: Boolean = False); +begin + Counter := TJclCounter.Create(Compensate); + Counter.Start; +end; + +function StopCount(var Counter: TJclCounter): Float; +begin + if Counter <> nil then + begin + Result := Counter.Stop; + FreeAndNil(Counter); + end + else + Result := 0.0; +end; + +procedure ContinueCount(var Counter: TJclCounter); +begin + if Counter <> nil then + Counter.Continue; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclDateTime.pas b/3rdParty/JCL/source/common/JclDateTime.pas index 012a08d3..cbd926f2 100644 --- a/3rdParty/JCL/source/common/JclDateTime.pas +++ b/3rdParty/JCL/source/common/JclDateTime.pas @@ -1,1449 +1,1449 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is JclDateTime.pas. } -{ } -{ The Initial Developer of the Original Code is Marcel van Brakel. } -{ Portions created by Marcel van Brakel are Copyright Marcel van Brakel. All rights reserved. } -{ } -{ Contributors: } -{ Anthony Steele } -{ Charlie Calvert } -{ Heri Bender } -{ Marc Convents } -{ Marcel van Brakel } -{ Matthias Thoma (mthoma) } -{ Michael Schnell } -{ Nick Hodges } -{ Petr Vones } -{ Robert Marquardt (marquardt) } -{ Robert Rossmair (rrossmair) } -{ Uwe Schuster (uschuster) } -{ } -{**************************************************************************************************} -{ } -{ Routines for working with dates and times. Mostly conversion between the } -{ different formats but also some date testing routines (is leap year? etc) } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -// in Help: -// We do all conversions (but thoses provided by Delphi anyway) between -// TDateTime, TDosDateTime, TFileTime and TSystemTime plus -// TDatetime, TDosDateTime, TFileTime, TSystemTime to string - -unit JclDateTime; - -{$I jcl.inc} -{$I crossplatform.inc} - -interface - -uses - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - {$IFDEF HAS_UNITSCOPE} - {$IFDEF MSWINDOWS} - Winapi.Windows, - {$ENDIF MSWINDOWS} - System.SysUtils, - {$ELSE ~HAS_UNITSCOPE} - {$IFDEF MSWINDOWS} - Windows, - {$ENDIF MSWINDOWS} - SysUtils, - {$ENDIF ~HAS_UNITSCOPE} - {$IFDEF HAS_UNIT_LIBC} - Libc, - {$ENDIF HAS_UNIT_LIBC} - {$IFDEF FPC} - {$IFDEF UNIX} - {$IFNDEF LINUX} - Unix, - {$ENDIF ~LINUX} - {$ENDIF FPC} - {$ENDIF} - JclBase, JclResources; - -const - // 1970-01-01T00:00:00 in TDateTime - UnixTimeStart = 25569; - -{ Encode / Decode functions } - -function EncodeDate(const Year: Integer; Month, Day: Word): TDateTime; -procedure DecodeDate(Date: TDateTime; out Year, Month, Day: Word); overload; -procedure DecodeDate(Date: TDateTime; out Year: Integer; out Month, Day: Word); overload; -procedure DecodeDate(Date: TDateTime; out Year, Month, Day: Integer); overload; - -function CenturyOfDate(const DateTime: TDateTime): Integer; -function CenturyBaseYear(const DateTime: TDateTime): Integer; -function DayOfDate(const DateTime: TDateTime): Integer; -function MonthOfDate(const DateTime: TDateTime): Integer; -function YearOfDate(const DateTime: TDateTime): Integer; -function DayOfTheYear(const DateTime: TDateTime; out Year: Integer): Integer; overload; -function DayOfTheYear(const DateTime: TDateTime): Integer; overload; -function DayOfTheYearToDateTime(const Year, Day: Integer): TDateTime; -function HourOfTime(const DateTime: TDateTime): Integer; -function MinuteOfTime(const DateTime: TDateTime): Integer; -function SecondOfTime(const DateTime: TDateTime): Integer; - -{ ISO 8601 support } - -function GetISOYearNumberOfWeeks(const Year: Word): Word; -function IsISOLongYear(const Year: Word): Boolean; overload; -function IsISOLongYear(const DateTime: TDateTime): Boolean; overload; -function ISODayOfWeek(const DateTime: TDateTime): Word; -function ISOWeekNumber(DateTime: TDateTime; out YearOfWeekNumber, WeekDay: Integer): Integer; overload; -function ISOWeekNumber(DateTime: TDateTime; out YearOfWeekNumber: Integer): Integer; overload; -function ISOWeekNumber(DateTime: TDateTime): Integer; overload; -function ISOWeekToDateTime(const Year, Week, Day: Integer): TDateTime; - -{ Miscellanous } - -function IsLeapYear(const Year: Integer): Boolean; overload; -function IsLeapYear(const DateTime: TDateTime): Boolean; overload; -function DaysInMonth(const DateTime: TDateTime): Integer; -function Make4DigitYear(Year, Pivot: Integer): Integer; -function MakeYear4Digit(Year, WindowsillYear: Integer): Integer; -function EasterSunday(const Year: Integer): TDateTime; -function FormatDateTime(Form: string; DateTime: TDateTime): string; -function FATDatesEqual(const FileTime1, FileTime2: Int64): Boolean; overload; -function FATDatesEqual(const FileTime1, FileTime2: TFileTime): Boolean; overload; - -// Conversion -type - TDosDateTime = Integer; - -function HoursToMSecs(Hours: Integer): Integer; -function MinutesToMSecs(Minutes: Integer): Integer; -function SecondsToMSecs(Seconds: Integer): Integer; - -function TimeOfDateTimeToSeconds(DateTime: TDateTime): Integer; -function TimeOfDateTimeToMSecs(DateTime: TDateTime): Integer; - -function DateTimeToLocalDateTime(DateTime: TDateTime): TDateTime; -function LocalDateTimeToDateTime(DateTime: TDateTime): TDateTime; - -{$IFDEF MSWINDOWS} -function DateTimeToDosDateTime(const DateTime: TDateTime): TDosDateTime; -function DateTimeToFileTime(DateTime: TDateTime): TFileTime; -function DateTimeToSystemTime(DateTime: TDateTime): TSystemTime; overload; -procedure DateTimeToSystemTime(DateTime: TDateTime; out SysTime: TSystemTime); overload; - -function LocalDateTimeToFileTime(DateTime: TDateTime): FileTime; -{$ENDIF MSWINDOWS} - -function DosDateTimeToDateTime(const DosTime: TDosDateTime): TDateTime; -{$IFDEF MSWINDOWS} -function DosDateTimeToFileTime(DosTime: TDosDateTime): TFileTime; overload; -procedure DosDateTimeToFileTime(DTH, DTL: Word; FT: TFileTime); overload; -function DosDateTimeToSystemTime(const DosTime: TDosDateTime): TSystemTime; -{$ENDIF MSWINDOWS} -function DosDateTimeToStr(DateTime: Integer): string; - -function FileTimeToDateTime(const FileTime: TFileTime): TDateTime; -{$IFDEF MSWINDOWS} -function FileTimeToLocalDateTime(const FileTime: TFileTime): TDateTime; -function FileTimeToDosDateTime(const FileTime: TFileTime): TDosDateTime; overload; -procedure FileTimeToDosDateTime(const FileTime: TFileTime; out Date, Time: Word); overload; -function FileTimeToSystemTime(const FileTime: TFileTime): TSystemTime; overload; -procedure FileTimeToSystemTime(const FileTime: TFileTime; out ST: TSystemTime); overload; -{$ENDIF MSWINDOWS} -function FileTimeToStr(const FileTime: TFileTime): string; - -{$IFDEF MSWINDOWS} -function SystemTimeToDosDateTime(const SystemTime: TSystemTime): TDosDateTime; -function SystemTimeToFileTime(const SystemTime: TSystemTime): TFileTime; overload; -procedure SystemTimeToFileTime(const SystemTime: TSystemTime; FTime: TFileTime); overload; -function SystemTimeToStr(const SystemTime: TSystemTime): string; - -// Filedates -function CreationDateTimeOfFile(const Sr: TSearchRec): TDateTime; -function LastAccessDateTimeOfFile(const Sr: TSearchRec): TDateTime; -function LastWriteDateTimeOfFile(const Sr: TSearchRec): TDateTime; -{$ENDIF MSWINDOWS} - -type - TJclUnixTime32 = Longword; - -function DateTimeToUnixTime(DateTime: TDateTime): TJclUnixTime32; -function UnixTimeToDateTime(const UnixTime: TJclUnixTime32): TDateTime; - -{$IFDEF MSWINDOWS} -function FileTimeToUnixTime(const AValue: TFileTime): TJclUnixTime32; -function UnixTimeToFileTime(const AValue: TJclUnixTime32): TFileTime; -{$ENDIF MSWINDOWS} - -// Time stamps (formerly in JclSchedule) -function NullStamp: TTimeStamp; -function CompareTimeStamps(const Stamp1, Stamp2: TTimeStamp): Int64; -function EqualTimeStamps(const Stamp1, Stamp2: TTimeStamp): Boolean; -function IsNullTimeStamp(const Stamp: TTimeStamp): Boolean; -function TimeStampDOW(const Stamp: TTimeStamp): Integer; - -// Day of week (formerly in JclSchedule) -function FirstWeekDay(const Year, Month: Integer; out DOW: Integer): Integer; overload; -function FirstWeekDay(const Year, Month: Integer): Integer; overload; -function LastWeekDay(const Year, Month: Integer; out DOW: Integer): Integer; overload; -function LastWeekDay(const Year, Month: Integer): Integer; overload; -function IndexedWeekDay(const Year, Month: Integer; Index: Integer): Integer; -function FirstWeekendDay(const Year, Month: Integer; out DOW: Integer): Integer; overload; -function FirstWeekendDay(const Year, Month: Integer): Integer; overload; -function LastWeekendDay(const Year, Month: Integer; out DOW: Integer): Integer; overload; -function LastWeekendDay(const Year, Month: Integer): Integer; overload; -function IndexedWeekendDay(const Year, Month: Integer; Index: Integer): Integer; -function FirstDayOfWeek(const Year, Month, DayOfWeek: Integer): Integer; -function LastDayOfWeek(const Year, Month, DayOfWeek: Integer): Integer; -function IndexedDayOfWeek(const Year, Month, DayOfWeek, Index: Integer): Integer; - -type - EJclDateTimeError = class(EJclError); - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\common'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -uses - JclSysUtils; - -const - DaysInMonths: array [1..12] of Integer = - (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); - - MinutesPerDay = 60 * 24; - //SecondsPerMinute = 60; - //SecondsPerHour = 3600; - SecondsPerDay = MinutesPerDay * 60; - MsecsPerMinute = 60 * 1000; - MsecsPerHour = 60 * MsecsPerMinute; - DaysPerYear = 365.2422454; // Solar Year - DaysPerMonth = DaysPerYear / 12; - DateTimeBaseDay = -693593; // 1/1/0001 - EncodeDateMaxYear = 9999; - SolarDifference = 1.7882454; // Difference of Julian Calendar to Solar Calendar at 1/1/10000 - DateTimeMaxDay = 2958466; // 12/31/EncodeDateMaxYear + 1; - FileTimeBase = -109205.0; - FileTimeStep: Extended = 24.0 * 60.0 * 60.0 * 1000.0 * 1000.0 * 10.0; // 100 nSek per Day - - // Weekday to start the week - // 1 : Sonday - // 2 : Monday (according to ISO 8601) - //ISOFirstWeekDay = 2; - - // minmimum number of days of the year in the first week of the year week - // 1 : week one starts at 1/1 - // 4 : first week has at least four days (according to ISO 8601) - // 7 : first full week - //ISOFirstWeekMinDays = 4; - -function EncodeDate(const Year: Integer; Month, Day: Word): TDateTime; overload; -begin - if (Year > 0) and (Year < EncodeDateMaxYear + 1) then - Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.EncodeDate(Year, Month, Day) - else - begin - if Year <= 0 then - Result := Year * DaysPerYear + DateTimeBaseDay - else // Year >= 10000 - // for some reason year 0 does not exist so we switch from - // the last day of year -1 (-693594) to the first days of year 1 - Result := (Year-1) * DaysPerYear + DateTimeBaseDay + // BaseDate is 1/1/1 - SolarDifference; // guarantee a smooth transition at 1/1/10000 - Result := Trunc(Result); - Result := Result + (Month - 1) * DaysPerMonth; - Result := Integer(Round(Result)) + (Day - 1); - end; -end; - -procedure DecodeDate(Date: TDateTime; out Year, Month, Day: Word); -begin - {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.DecodeDate(Date, Year, Month, Day); -end; - -procedure DecodeDate(Date: TDateTime; out Year, Month, Day: Integer); -var - WMonth, WDay: Word; -begin - DecodeDate(Date, Year, WMonth, WDay); - Month := WMonth; - Day := WDay; -end; - -procedure DecodeDate(Date: TDateTime; out Year: Integer; out Month, Day: Word); -var - WYear: Word; - RDays, RMonths: TDateTime; -begin - if (Date >= DateTimeBaseDay) and (Date < DateTimeMaxDay) then - begin - {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.DecodeDate(Date, WYear, Month, Day); - Year := WYear; - end - else - begin - Year := Trunc((Date - DateTimeBaseDay) / DaysPerYear); - if Year <= 0 then - Year := Year - 1 - // for some historical reason year 0 does not exist so we switch from - // the last day of year -1 (-693594) to the first days of year 1 - else // Year >= 10000 - Date := Date - SolarDifference; // guarantee a smooth transition at 1/1/10000 - RDays := Date - DateTimeBaseDay; // Days relative to 1/1/0001 - RMonths := RDays / DaysPerMonth; // "Months" relative to 1/1/0001 - RMonths := RMonths - Year * 12.0; // 12 "Months" per Year - if RMonths < 0 then // possible truncation glitches - begin - RMonths := 11; - Year := Year - 1; - end; - Month := Trunc(RMonths); - RMonths := Month; - Month := Month + 1; - RDays := RDays - Year * DaysPerYear; // subtract Base Day ot the year - RDays := RDays - RMonths * DaysPerMonth;// subtract Base Day of the month - Day := Trunc(RDays)+ 1; - if Year > 0 then // Year >= 10000 - Year := Year + 1; // BaseDate is 1/1/1 - end; -end; - -procedure ResultCheck(Val: LongBool); -begin - if not Val then - raise EJclDateTimeError.CreateRes(@RsDateConversion); -end; - -function CenturyBaseYear(const DateTime: TDateTime): Integer; -var - Y: Integer; -begin - Y := YearOfDate(DateTime); - Result := (Y div 100) * 100; - if Y <= 0 then - Result := Result - 100; -end; - -function CenturyOfDate(const DateTime: TDateTime): Integer; -var - Y: Integer; -begin - Y := YearOfDate(DateTime); - if Y > 0 then - Result := (Y div 100) + 1 - else - Result := (Y div 100) - 1; -end; - -function DayOfDate(const DateTime: TDateTime): Integer; -var - Y: Integer; - M, D: Word; -begin - DecodeDate(DateTime, Y, M, D); - Result := D; -end; - -function MonthOfDate(const DateTime: TDateTime): Integer; -var - Y: Integer; - M, D: Word; -begin - DecodeDate(DateTime, Y, M, D); - Result := M; -end; - -function YearOfDate(const DateTime: TDateTime): Integer; -var - M, D: Word; -begin - DecodeDate(DateTime, Result, M, D); -end; - -function DayOfTheYear(const DateTime: TDateTime; out Year: Integer): Integer; -var - Month, Day: Word; - DT: TDateTime; -begin - DecodeDate(DateTime, Year, Month, Day); - DT := EncodeDate(Year, 1, 1); - Result := Trunc(DateTime); - Result := Result - Trunc(DT) + 1; -end; - -function DayOfTheYear(const DateTime: TDateTime): Integer; -var - Year: Integer; -begin - Result := DayOfTheYear(DateTime, Year); -end; - -function DayOfTheYearToDateTime(const Year, Day: Integer): TDateTime; -begin - Result := EncodeDate(Year, 1, 1) + Day - 1; -end; - -function HourOfTime(const DateTime: TDateTime): Integer; -var - H, M, S, MS: Word; -begin - DecodeTime(DateTime, H, M, S, MS); - Result := H; -end; - -function MinuteOfTime(const DateTime: TDateTime): Integer; -var - H, M, S, MS: Word; -begin - DecodeTime(DateTime, H, M, S, MS); - Result := M; -end; - -function SecondOfTime(const DateTime: TDateTime): Integer; -var - H, M, S, MS: Word; -begin - DecodeTime(DateTime, H, M, S, MS); - Result := S; -end; - -function TimeOfDateTimeToSeconds(DateTime: TDateTime): Integer; -begin - Result := Round(Frac(DateTime) * SecondsPerDay); -end; - -function TimeOfDateTimeToMSecs(DateTime: TDateTime): Integer; -begin - Result := Round(Frac(DateTime) * MSecsPerDay); -end; - -function DaysInMonth(const DateTime: TDateTime): Integer; -var - M: Integer; -begin - M := MonthOfDate(DateTime); - Result := DaysInMonths[M]; - if (M = 2) and IsLeapYear(DateTime) then - Result := 29; -end; - -// SysUtils.DayOfWeek returns the day of the week of the given date. The result is an integer between -// 1 and 7, corresponding to Sunday through Saturday. ISODayOfWeek on the other hand returns an integer -// between 1 and 7 where the first day is a Monday. The forumla for calculation ISODayOfTheWeek is -// simply -// DayOfWeek(D) - 1 if DayOfWeek(D) > 1 -// ISODayOfWeek (D) = 7 if DayOfWeek(D) = 1 - -function ISODayOfWeek(const DateTime: TDateTime): Word; -var - TmpDayOfWeek: Word; -begin - TmpDayOfWeek := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.DayOfWeek(DateTime); - if TmpDayOfWeek = 1 then - Result := 7 - else - Result := TmpDayOfWeek - 1; -end; - -// Determines if the ISO Year is ordinary (52 weeks) or Long (53 weeks). Uses a rule first -// suggested by Sven Pran (Norway) and Lars Nordentoft (Denmark) - according to -// http://www.phys.uu.nl/~vgent/calendar/isocalendar.htm - -function IsISOLongYear(const DateTime: TDateTime): Boolean; -var - TmpYear: Word; -begin - TmpYear := YearOfDate(DateTime); - Result := IsISOLongYear(TmpYear); -end; - -function IsISOLongYear(const Year: Word): Boolean; -var - TmpWeekday: Word; -begin - TmpWeekday := ISODayOfWeek(DayOfTheYearToDateTime(Year, 1)); - Result := (IsLeapYear(Year) and ((TmpWeekday = 3) or (TmpWeekday = 4))) or (TmpWeekday = 4); -end; - -function GetISOYearNumberOfWeeks(const Year: Word): Word; -begin - Result := 52; - if IsISOLongYear(Year) then - Result := 53; -end; - -// ISOWeekNumber function returns Integer 1..7 equivalent to Sunday..Saturday. -// ISO 8601 weeks start with Monday and the first week of a year is the one which -// includes the first Thursday - -function ISOWeekNumber(DateTime: TDateTime; out YearOfWeekNumber, WeekDay: Integer): Integer; -var - TmpYear: Integer; - January4th: TDateTime; - FirstMonday: TDateTime; -begin - // Applying the rule: The first calendar week is the week that includes January, 4th - TmpYear := YearOfDate(DateTime); - WeekDay := ISODayOfWeek(DateTime); - // adjust if we are between 12/29 and 12/31 - if (MonthOfDate(DateTime) = 12) and (DayOfDate(DateTime) >= 29) and - (ISODayOfWeek(DateTime) <= 3) then - TmpYear := TmpYear + 1; - - January4th := DayOfTheYearToDateTime(TmpYear, 4); - FirstMonday := January4th + 1 - ISODayOfWeek(January4th); - - // If our date is < FirstMonday we are in the last week of the previous year - if DateTime < FirstMonday then - begin - Result := GetISOYearNumberOfWeeks(TmpYear - 1); - YearOfWeekNumber := TmpYear - 1; - Exit; - end - else - begin - YearOfWeekNumber := TmpYear; - Result := (Trunc(DateTime - FirstMonday) div 7) + 1; - end; - - if Result > GetISOYearNumberOfWeeks(YearOfDate(DateTime)) then - Result := GetISOYearNumberOfWeeks(YearOfDate(DateTime)); -end; - -function ISOWeekNumber(DateTime: TDateTime; out YearOfWeekNumber: Integer): Integer; -var - Temp: Integer; -begin - Result := ISOWeekNumber(DateTime, YearOfWeekNumber, Temp); -end; - -function ISOWeekNumber(DateTime: TDateTime): Integer; -var - Temp: Integer; -begin - Result := ISOWeekNumber(DateTime, Temp, Temp); -end; - -function ISOWeekToDateTime(const Year, Week, Day: Integer): TDateTime; -var - January4th: TDateTime; - FirstMonday: TDateTime; -begin - January4th := DayOfTheYearToDateTime(Year, 4); - FirstMonday := January4th + 1 - ISODayOfWeek(January4th); - Result := FirstMonday + (Week - 1) * 7 + (Day - 1); -end; - -// The original Gregorian rule for all who want to learn it -// Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0)); - -function IsLeapYear(const Year: Integer): Boolean; -begin - Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.IsLeapYear(Year); -end; - -function IsLeapYear(const DateTime: TDateTime): Boolean; -begin - Result := IsLeapYear(YearOfDate(DateTime)); -end; - -function Make4DigitYear(Year, Pivot: Integer): Integer; -begin - { TODO : Make4DigitYear } - Assert((Year >= 0) and (Year <= 100) and (Pivot >= 0) and (Pivot <= 100)); - if Year = 100 then - Year := 0; - if Pivot = 100 then - Pivot := 0; - if Year < Pivot then - Result := 2000 + Year - else - Result := 1900 + Year; -end; - -// "window" technique for years to translate 2 digits to 4 digits. -// The window is 100 years wide -// The windowsill year is the lower edge of the window -// A windowsill year of 1900 is equivalent to putting 1900 before every 2-digit year -// if WindowsillYear is 1940, then 40 is interpreted as 1940, 00 as 2000 and 39 as 2039 -// The system default is 1950 - -function MakeYear4Digit(Year, WindowsillYear: Integer): Integer; -var - CC, Y: Integer; -begin - // have come across this specific problem : y2K read as year 100 - if Year = 100 then - Year := 0; - // turn 2 digit years to 4 digits - Y := Year mod 100; - CC := (WindowsillYear div 100) * 100; - Result := Y + CC; // give the result the same century as the windowsill - if Result < WindowsillYear then // cannot be lower than the windowsill - Result := Result + 100; - if (Year >= 100) or (Year < 0) then - Assert(Year = Result); // Assert: no unwanted century translation -end; - -// Calculates and returns Easter Day for specified year. -// Originally from Mark Lussier, AppVision . -// Corrected to prevent integer overflow if it is inadvertedly -// passed a year of 6554 or greater. - -function EasterSunday(const Year: Integer): TDateTime; -var - Month, Day, Moon, Epact, Sunday, - Gold, Cent, Corx, Corz: Integer; -begin - { The Golden Number of the year in the 19 year Metonic Cycle: } - Gold := Year mod 19 + 1; - { Calculate the Century: } - Cent := Year div 100 + 1; - { Number of years in which leap year was dropped in order... } - { to keep in step with the sun: } - Corx := (3 * Cent) div 4 - 12; - { Special correction to synchronize Easter with moon's orbit: } - Corz := (8 * Cent + 5) div 25 - 5; - { Find Sunday: } - Sunday := (Longint(5) * Year) div 4 - Corx - 10; - { ^ To prevent overflow at year 6554} - { Set Epact - specifies occurrence of full moon: } - Epact := (11 * Gold + 20 + Corz - Corx) mod 30; - if Epact < 0 then - Epact := Epact + 30; - if ((Epact = 25) and (Gold > 11)) or (Epact = 24) then - Epact := Epact + 1; - { Find Full Moon: } - Moon := 44 - Epact; - if Moon < 21 then - Moon := Moon + 30; - { Advance to Sunday: } - Moon := Moon + 7 - ((Sunday + Moon) mod 7); - if Moon > 31 then - begin - Month := 4; - Day := Moon - 31; - end - else - begin - Month := 3; - Day := Moon; - end; - Result := EncodeDate(Year, Month, Day); -end; - -// Conversion - -{$IFDEF MSWINDOWS} -function DateTimeToLocalDateTime(DateTime: TDateTime): TDateTime; -var - TimeZoneInfo: TTimeZoneInformation; -begin - ResetMemory(TimeZoneInfo, SizeOf(TimeZoneInfo)); - case GetTimeZoneInformation(TimeZoneInfo) of - TIME_ZONE_ID_STANDARD, TIME_ZONE_ID_UNKNOWN: - Result := DateTime - (TimeZoneInfo.Bias + TimeZoneInfo.StandardBias) / MinutesPerDay; - TIME_ZONE_ID_DAYLIGHT: - Result := DateTime - (TimeZoneInfo.Bias + TimeZoneInfo.DaylightBias) / MinutesPerDay; - else - raise EJclDateTimeError.CreateRes(@RsMakeUTCTime); - end; -end; -{$ENDIF MSWINDOWS} - -{$IFDEF UNIX} -function DateTimeToLocalDateTime(DateTime: TDateTime): TDateTime; -var - {$IFDEF LINUX} - TimeNow: time_t; - Local, UTCTime: TUnixTime; - {$ENDIF LINUX} - Offset: Double; -begin - {$IFDEF LINUX} - TimeNow := __time(nil); - UTCTime := gmtime(@TimeNow)^; - Local := localtime(@TimeNow)^; - Offset := difftime(mktime(UTCTime), mktime(Local)); - {$ELSE ~LINUX} - Offset := -TZSeconds; - {$ENDIF ~LINUX} - Result := ((DateTime * SecsPerDay) - Offset) / SecsPerDay; -end; -{$ENDIF UNIX} - -{$IFDEF MSWINDOWS} -function LocalDateTimeToDateTime(DateTime: TDateTime): TDateTime; -var - TimeZoneInfo: TTimeZoneInformation; -begin - ResetMemory(TimeZoneInfo, SizeOf(TimeZoneInfo)); - case GetTimeZoneInformation(TimeZoneInfo) of - TIME_ZONE_ID_STANDARD, TIME_ZONE_ID_UNKNOWN: - Result := DateTime + (TimeZoneInfo.Bias + TimeZoneInfo.StandardBias) / MinutesPerDay; - TIME_ZONE_ID_DAYLIGHT: - Result := DateTime + (TimeZoneInfo.Bias + TimeZoneInfo.DaylightBias) / MinutesPerDay; - else - raise EJclDateTimeError.CreateRes(@RsMakeUTCTime); - end; -end; -{$ENDIF MSWINDOWS} - -{$IFDEF UNIX} -function LocalDateTimeToDateTime(DateTime: TDateTime): TDateTime; -var - {$IFDEF LINUX} - TimeNow: time_t; - Local, UTCTime: TUnixTime; - {$ENDIF LINUX} - Offset: Double; -begin - {$IFDEF LINUX} - TimeNow := __time(nil); - UTCTime := gmtime(@TimeNow)^; - Local := localtime(@TimeNow)^; - Offset := difftime(mktime(UTCTime), mktime(Local)); - {$ELSE ~LINUX} - Offset := -TZSeconds; - {$ENDIF ~LINUX} - Result := ((DateTime * SecsPerDay) + Offset) / SecsPerDay; -end; -{$ENDIF UNIX} - -function HoursToMSecs(Hours: Integer): Integer; -begin - Assert(Hours < MaxInt / MsecsPerHour); - Result := Hours * MsecsPerHour; -end; - -function MinutesToMSecs(Minutes: Integer): Integer; -begin - Assert(Minutes < MaxInt div MsecsPerMinute); - Result := Minutes * MsecsPerMinute; -end; - -function SecondsToMSecs(Seconds: Integer): Integer; -begin - Assert(Seconds < MaxInt div 1000); - Result := Seconds * 1000; -end; - -// using system calls this can be done like this: -// var -// SystemTime: TSystemTime; -// begin -// ResultCheck(FileTimeToSystemTime(FileTime, SystemTime)); -// Result := SystemTimeToDateTime(SystemTime); - -function FileTimeToDateTime(const FileTime: TFileTime): TDateTime; -begin - Result := Int64(FileTime) / FileTimeStep; - Result := Result + FileTimeBase; -end; - -{$IFDEF MSWINDOWS} - -function FileTimeToLocalDateTime(const FileTime: TFileTime): TDateTime; -var - LocalFileTime: TFileTime; -begin - LocalFileTime.dwHighDateTime := 0; - LocalFileTime.dwLowDateTime := 0; - ResultCheck(FileTimeToLocalFileTime(FileTime, LocalFileTime)); - Result := FileTimeToDateTime(LocalFileTime); - { TODO : daylight saving time } -end; - -function LocalDateTimeToFileTime(DateTime: TDateTime): FileTime; -var - LocalFileTime: TFileTime; -begin - LocalFileTime := DateTimeToFileTime(DateTime); - Result.dwHighDateTime := 0; - Result.dwLowDateTime := 0; - ResultCheck(LocalFileTimeToFileTime(LocalFileTime, Result)); - { TODO : daylight saving time } -end; - -{$ENDIF MSWINDOWS} - -function DateTimeToFileTime(DateTime: TDateTime): TFileTime; -var - E: Extended; - F64: Int64; -begin - E := (DateTime - FileTimeBase) * FileTimeStep; - F64 := Round(E); - Result := TFileTime(F64); -end; - -{$IFDEF MSWINDOWS} - -function DosDateTimeToSystemTime(const DosTime: TDosDateTime): TSystemTime; -var - FileTime: TFileTime; -begin - FileTime := DosDateTimeToFileTime(DosTime); - Result := FileTimeToSystemTime(FileTime); -end; - -function SystemTimeToDosDateTime(const SystemTime: TSystemTime): TDosDateTime; -var - FileTime: TFileTime; -begin - FileTime := SystemTimeToFileTime(SystemTime); - Result := FileTimeToDosDateTime(FileTime); -end; - -{$ENDIF MSWINDOWS} - -// DosDateTimeToDateTime performs the same action as SysUtils.FileDateToDateTime -// not using SysUtils.FileDateToDateTime this can be done like that: -// var -// FileTime: TFileTime; -// SystemTime: TSystemTime; -// begin -// ResultCheck(DosDateTimeToFileTime(HiWord(DosTime), LoWord(DosTime), FileTime)); -// ResultCheck(FileTimeToSystemTime(FileTime, SystemTime)); -// Result := SystemTimeToDateTime(SystemTime); - -function DosDateTimeToDateTime(const DosTime: TDosDateTime): TDateTime; -begin - Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FileDateToDateTime(DosTime); -end; - -// DateTimeToDosDateTime performs the same action as SysUtils.DateTimeToFileDate -// not using SysUtils.DateTimeToDosDateTime this can be done like that: -// var -// SystemTime: TSystemTime; -// FileTime: TFileTime; -// Date, Time: Word; -// begin -// DateTimeToSystemTime(DateTime, SystemTime); -// ResultCheck(SystemTimeToFileTime(SystemTime, FileTime)); -// ResultCheck(FileTimeToDosDateTime(FileTime, Date, Time)); -// Result := (Date shl 16) or Time; - -function DateTimeToDosDateTime(const DateTime: TDateTime): TDosDateTime; -begin - Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.DateTimeToFileDate(DateTime); -end; - -{$IFDEF MSWINDOWS} - -function FileTimeToSystemTime(const FileTime: TFileTime): TSystemTime; overload; -begin - ResultCheck({$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.FileTimeToSystemTime(FileTime, Result)); -end; - -procedure FileTimeToSystemTime(const FileTime: TFileTime; out ST: TSystemTime); overload; -begin - {$IFDEF FPC} - ST.Day := 0; - {$ENDIF FPC} - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.FileTimeToSystemTime(FileTime, ST); -end; - -function SystemTimeToFileTime(const SystemTime: TSystemTime): TFileTime; overload; -begin - Result.dwHighDateTime := 0; - Result.dwLowDateTime := 0; - ResultCheck({$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.SystemTimeToFileTime(SystemTime, Result)); -end; - -procedure SystemTimeToFileTime(const SystemTime: TSystemTime; FTime: TFileTime); overload; -begin - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.SystemTimeToFileTime(SystemTime, FTime); -end; - -function DateTimeToSystemTime(DateTime: TDateTime): TSystemTime; overload; -begin - {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.DateTimeToSystemTime(DateTime, Result); -end; - -procedure DateTimeToSystemTime(DateTime: TDateTime; out SysTime: TSystemTime); overload; -begin - {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.DateTimeToSystemTime(DateTime, SysTime); -end; - -function DosDateTimeToFileTime(DosTime: TDosDateTime): TFileTime; overload; -begin - Result.dwHighDateTime := 0; - Result.dwLowDateTime := 0; - ResultCheck({$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.DosDateTimeToFileTime(HIWORD(DosTime), LOWORD(DosTime), Result)); -end; - -procedure DosDateTimeToFileTime(DTH, DTL: Word; FT: TFileTime); overload; -begin - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.DosDateTimeToFileTime(DTH, DTL, FT); -end; - -function FileTimeToDosDateTime(const FileTime: TFileTime): TDosDateTime; overload; -var - Date, Time: Word; -begin - Date := 0; - Time := 0; - ResultCheck({$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.FileTimeToDosDateTime(FileTime, Date, Time)); - Result := (Date shl 16) or Time; -end; - -procedure FileTimeToDosDateTime(const FileTime: TFileTime; out Date, Time: Word); overload; -begin - Date := 0; - Time := 0; - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.FileTimeToDosDateTime(FileTime, Date, Time); -end; - -{$ENDIF MSWINDOWS} - -function FileTimeToStr(const FileTime: TFileTime): string; -var - DateTime: TDateTime; -begin - DateTime := FileTimeToDateTime(FileTime); - Result := DateTimeToStr(DateTime); -end; - -function DosDateTimeToStr(DateTime: Integer): string; -begin - Result := DateTimeToStr(DosDateTimeToDateTime(DateTime)); -end; - -{$IFDEF MSWINDOWS} - -// we can't do this better without copying Borland-owned code from the Delphi VCL, -// as the straight forward conversion doing exactly this task is hidden -// deeply inside SysUtils.pas. -// So the date is converted forth and back to/from Julian date -// If someone needs a faster version please take a look at SysUtils.pas->DateTimeToStr. - -function SystemTimeToStr(const SystemTime: TSystemTime): string; -begin - Result := DateTimeToStr(SystemTimeToDateTime(SystemTime)); -end; - -function CreationDateTimeOfFile(const Sr: TSearchRec): TDateTime; -begin - Result := FileTimeToDateTime(Sr.FindData.ftCreationTime); -end; - -function LastAccessDateTimeOfFile(const Sr: TSearchRec): TDateTime; -begin - Result := FileTimeToDateTime(Sr.FindData.ftLastAccessTime); -end; - -function LastWriteDateTimeOfFile(const Sr: TSearchRec): TDateTime; -begin - Result := FileTimeToDateTime(Sr.FindData.ftLastWriteTime); -end; - -{$ENDIF MSWINDOWS} - -// Additional format tokens (also available in upper case): -// w: Week no according to ISO -// ww: Week no according to ISO forced two digits -// i: Year of the ISO-week denoted by w (4 digits for 1000..9999) -// ii: Year of the ISO-week denoted by w forced two digits -// e: Number of the Day in the ISO-week denoted by w (ISO-Notation 1=Monday...) -// f: Number of the Day in the year denoted by y -// fff: Number of the Day in the year denoted by y forced three digits - -function FormatDateTime(Form: string; DateTime: TDateTime): string; -var - N: Integer; - ISODay, ISOWeek, ISOYear, DayOfYear, YY: Integer; - - procedure Digest; - begin - if N > 1 then - begin - Result := Result + Copy(Form, 1, N - 1); - Delete(Form, 1, N - 1); - N := 1; - end; - end; - -begin - ISOWeek := 0; - DayOfYear := 0; - Result := ''; - N := 1; - while N <= Length(Form) do - begin - case Form[N] of - '"': - begin - Inc(N); - Digest; - N := Pos('"', Form); - if N = 0 then - begin - Result := Result + Form; - Form := ''; - N := 1; - end - else - begin - Inc(N); - Digest; - end; - end; - '''': - begin - Inc(N); - Digest; - N := Pos('''', Form); - if N = 0 then - begin - Result := Result + Form; - Form := ''; - N := 1; - end - else - begin - Inc(N); - Digest; - end; - end; - 'i', 'I': //ISO Week Year - begin - Digest; - if ISOWeek = 0 then - ISOWeek := ISOWeekNumber(DateTime, ISOYear, ISODay); - if (Length(Form) > 1) and ((Form[2] = 'i') or (Form[2] = 'I')) then - begin // - if (Length(Form) > 2) and ((Form[3] = 'i') or (Form[3] = 'I')) then - begin - if (Length(Form) > 3) and ((Form[4] = 'i') or (Form[4] = 'I')) then - begin // - Delete(Form, 1, 4); - Result := Result + '"' + IntToStr(ISOYear) + '"'; - end - else - begin // - Delete(Form, 1, 3); - Result := Result + '"' + IntToStr(ISOYear) + '"'; - end; - end - else - begin // - Delete(Form, 1, 2); - Result := Result + '"'; - if ISOYear < 10 then - Result := Result + '0'; - YY := ISOYear mod 100; - if YY < 10 then - Result := Result + '0'; - Result := Result + IntToStr(YY) + '"'; - end; - end - else - begin // - Delete(Form, 1, 1); - Result := Result + '"' + IntToStr(ISOYear) + '"'; - end; - end; - 'w', 'W': // ISO Week - begin - Digest; - if ISOWeek = 0 then - ISOWeek := ISOWeekNumber(DateTime, ISOYear, ISODay); - if (Length(Form) > 1) and ((Form[2] = 'w') or (Form[2] = 'W')) then - begin // - Delete(Form, 1, 2); - Result := Result + '"'; - if ISOWeek < 10 then - Result := Result + '0'; - Result := Result + IntToStr(ISOWeek) + '"'; - end - else - begin // - Delete(Form, 1, 1); - Result := Result + '"' + IntToStr(ISOWeek) + '"'; - end; - end; - 'e', 'E': // ISO Week Day - begin - Digest; - if ISOWeek = 0 then - ISOWeek := ISOWeekNumber(DateTime, ISOYear, ISODay); - Delete(Form, 1, 1); - Result := Result + '"' + IntToStr(ISODay) + '"'; - end; - 'f', 'F': // Day of the Year - begin - Digest; - if DayOfYear = 0 then - DayOfYear := DayOfTheYear(DateTime); - if (Length(Form) > 1) and ((Form[2] = 'f') or (Form[2] = 'F')) then - begin - if (Length(Form) > 2) and ((Form[3] = 'f') or (Form[3] = 'F')) then - begin // - Delete(Form, 1, 3); - Result := Result + '"'; - if DayOfYear < 10 then - Result := Result + '0'; - if DayOfYear < 100 then - Result := Result + '0'; - Result := Result + IntToStr(DayOfYear) + '"'; - end - else - begin // - Delete(Form, 1, 2); - Result := Result + '"'; - if DayOfYear < 10 then - Result := Result + '0'; - Result := Result + IntToStr(DayOfYear) + '"'; - end; - end - else - begin // - Delete(Form, 1, 1); - Result := Result + '"' + IntToStr(DayOfYear) + '"'; - end - end; - else - Inc(N); - end; - end; - Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FormatDateTime(Result + Form, DateTime); -end; - -// FAT has a granularity of 2 seconds -// The intervals are 1/10 of a second - -function FATDatesEqual(const FileTime1, FileTime2: Int64): Boolean; -const - ALLOWED_FAT_FILE_TIME_VARIATION = 20; -begin - Result := Abs(FileTime1 - FileTime2) <= ALLOWED_FAT_FILE_TIME_VARIATION; -end; - -function FATDatesEqual(const FileTime1, FileTime2: TFileTime): Boolean; -begin - Result := FATDatesEqual(Int64(FileTime1), Int64(FileTime2)); -end; - -// Conversion Unix time <--> TDateTime - -function DateTimeToUnixTime(DateTime: TDateTime): TJclUnixTime32; -begin - Result := Round((DateTime-UnixTimeStart) * SecondsPerDay); -end; - -function UnixTimeToDateTime(const UnixTime: TJclUnixTime32): TDateTime; -begin - Result:= UnixTimeStart + (UnixTime / SecondsPerDay); -end; - -// Conversion Unix time <--> FileTime - -{$IFDEF MSWINDOWS} - -function UnixTimeToFileTime(const AValue: TJclUnixTime32): TFileTime; -begin - Result := DateTimeToFileTime(UnixTimeToDateTime(AValue)); -end; - -function FileTimeToUnixTime(const AValue: TFileTime): TJclUnixTime32; -begin - Result := DateTimeToUnixTime(FileTimeToDateTime(AValue)); -end; - -{$ENDIF MSWINDOWS} - -// Time stamps utilities - -// Utility functions -function NullStamp: TTimeStamp; -begin - Result.Date := 0; - Result.Time := -1; -end; - -function CompareTimeStamps(const Stamp1, Stamp2: TTimeStamp): Int64; -begin - if Stamp1.Date < Stamp2.Date then - Result := -1 - else - if Stamp1.Date = Stamp2.Date then - begin - if Stamp1.Time < Stamp2.Time then - Result := -1 - else - if Stamp1.Time = Stamp2.Time then - Result := 0 - else // If Stamp1.Time > Stamp2.Time then - Result := 1; - end - else // if Stamp1.Date > Stamp2.Date then - Result := 1; -// Result := Int64(Stamp1) - Int64(Stamp2); -end; - -function EqualTimeStamps(const Stamp1, Stamp2: TTimeStamp): Boolean; -begin - Result := CompareTimeStamps(Stamp1, Stamp2) = 0; -end; - -function IsNullTimeStamp(const Stamp: TTimeStamp): Boolean; -begin - Result := CompareTimeStamps(NullStamp, Stamp) = 0; -end; - -function TimeStampDOW(const Stamp: TTimeStamp): Integer; -begin - Result := (Stamp.Date - 1) mod 7 + 1 -end; - -// day of week utilities - -function FirstWeekDay(const Year, Month: Integer; out DOW: Integer): Integer; -begin - DOW := ISODayOfWeek(EncodeDate(Year, Month, 1)); - if DOW > 5 then - begin - Result := 9 - DOW; - DOW := 1; - end - else - Result := 1; -end; - -function FirstWeekDay(const Year, Month: Integer): Integer; -var - Dummy: Integer; -begin - Result := FirstWeekDay(Year, Month, Dummy); -end; - -function LastWeekDay(const Year, Month: Integer; out DOW: Integer): Integer; -begin - DOW := ISODayOfWeek(EncodeDate(Year, Month, DaysInMonth(EncodeDate(Year, Month, 1)))); - if DOW > 5 then - begin - Result := DaysInMonth(EncodeDate(Year, Month, 1)) - (DOW - 5); - DOW := 5; - end - else - Result := DaysInMonth(EncodeDate(Year, Month, 1)); -end; - -function LastWeekDay(const Year, Month: Integer): Integer; -var - Dummy: Integer; -begin - Result := LastWeekDay(Year, Month, Dummy); -end; - -function IndexedWeekDay(const Year, Month: Integer; Index: Integer): Integer; -var - DOW: Integer; -begin - if Index > 0 then - Result := FirstWeekDay(Year, Month, DOW) - else - if Index < 0 then - Result := LastWeekDay(Year, Month, DOW) - else - Result := 0; - if Index > 1 then // n-th weekday from start of month - begin - Dec(Index); - if DOW > 1 then // adjust to first monday - begin - if Index < (5 - DOW) then - begin - Inc(Result, Index); - Index := 0; - end - else - begin - Dec(Index, 6 - DOW); - Inc(Result, 8 - DOW); - end; - end; - Result := Result + (7 * (Index div 5)) + (Index mod 5); - end - else - if Index < -1 then // n-th weekday from end of month - begin - Index := Abs(Index) - 1; - if DOW < 5 then // adjust to last friday - begin - if Index < DOW then - begin - Dec(Result, Index); - Index := 0; - end - else - begin - Dec(Index, DOW); - Dec(Result, DOW + 2); - end; - end; - Result := Result - (7 * (Index div 5)) - (Index mod 5); - end; - if (Result < 0) or (Result > DaysInMonth(EncodeDate(Year, Month, 1))) then - Result := 0; -end; - -function FirstWeekendDay(const Year, Month: Integer; out DOW: Integer): Integer; -begin - DOW := ISODayOfWeek(EncodeDate(Year, Month, 1)); - if DOW < 6 then - begin - Result := 7 - DOW; - DOW := 6; - end - else - Result := 1; -end; - -function FirstWeekendDay(const Year, Month: Integer): Integer; -var - Dummy: Integer; -begin - Result := FirstWeekendDay(Year, Month, Dummy); -end; - -function LastWeekendDay(const Year, Month: Integer; out DOW: Integer): Integer; -begin - DOW := ISODayOfWeek(EncodeDate(Year, Month, DaysInMonth(EncodeDate(Year, Month, 1)))); - if DOW < 6 then - begin - Result := DaysInMonth(EncodeDate(Year, Month, 1)) - DOW; - DOW := 7; - end - else - Result := DaysInMonth(EncodeDate(Year, Month, 1)); -end; - -function LastWeekendDay(const Year, Month: Integer): Integer; -var - Dummy: Integer; -begin - Result := LastWeekendDay(Year, Month, Dummy); -end; - -function IndexedWeekendDay(const Year, Month: Integer; Index: Integer): Integer; -var - DOW: Integer; -begin - if Index > 0 then - Result := FirstWeekendDay(Year, Month, DOW) - else - if Index < 0 then - Result := LastWeekendDay(Year, Month, DOW) - else - Result := 0; - if Index > 1 then // n-th weekend day from the start of the month - begin - if (DOW > 6) and not Odd(Index) then // Adjust to first saturday - begin - Inc(Result, 6); - Dec(Index); - end; - if Index > 1 then - begin - Dec(Index); - Result := Result + (7 * (Index div 2)) + (Index mod 2); - end; - end - else - if Index < -1 then // n-th weekend day from the start of the month - begin - Index := Abs(Index); - if (DOW < 7) and not Odd(Index) then // Adjust to last sunday - begin - Dec(Result, 6); - Dec(Index); - end; - if Index > 1 then - begin - Dec(Index); - Result := Result - (7 * (Index div 2)) - (Index mod 2); - end; - end; - if (Result < 0) or (Result > DaysInMonth(EncodeDate(Year, Month, 1))) then - Result := 0; -end; - -function FirstDayOfWeek(const Year, Month, DayOfWeek: Integer): Integer; -var - DOW: Integer; -begin - DOW := ISODayOfWeek(EncodeDate(Year, Month, 1)); - if DOW > DayOfWeek then - Result := 8 + DayOfWeek - DOW - else - if DOW < DayOfWeek then - Result := 1 + DayOfWeek - DOW - else - Result := 1; -end; - -function LastDayOfWeek(const Year, Month, DayOfWeek: Integer): Integer; -var - DOW: Integer; -begin - DOW := ISODayOfWeek(EncodeDate(Year, Month, DaysInMonth(EncodeDate(Year, Month, 1)))); - if DOW > DayOfWeek then - Result := DaysInMonth(EncodeDate(Year, Month, 1)) - (DOW - DayOfWeek) - else - if DOW < DayOfWeek then - Result := DaysInMonth(EncodeDate(Year, Month, 1)) - (7 - DayOfWeek + DOW) - else - Result := DaysInMonth(EncodeDate(Year, Month, 1)); -end; - -function IndexedDayOfWeek(const Year, Month, DayOfWeek, Index: Integer): Integer; -begin - if Index > 0 then - Result := FirstDayOfWeek(Year, Month, DayOfWeek) + 7 * (Index - 1) - else - if Index < 0 then - Result := LastDayOfWeek(Year, Month, DayOfWeek) - 7 * (Abs(Index) - 1) - else - Result := 0; - if (Result < 0) or (Result > DaysInMonth(EncodeDate(Year, Month, 1))) then - Result := 0; -end; - -{$IFDEF UNITVERSIONING} -initialization - RegisterUnitVersion(HInstance, UnitVersioning); - -finalization - UnregisterUnitVersion(HInstance); -{$ENDIF UNITVERSIONING} - -end. - +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclDateTime.pas. } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. } +{ Portions created by Marcel van Brakel are Copyright Marcel van Brakel. All rights reserved. } +{ } +{ Contributors: } +{ Anthony Steele } +{ Charlie Calvert } +{ Heri Bender } +{ Marc Convents } +{ Marcel van Brakel } +{ Matthias Thoma (mthoma) } +{ Michael Schnell } +{ Nick Hodges } +{ Petr Vones } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Uwe Schuster (uschuster) } +{ } +{**************************************************************************************************} +{ } +{ Routines for working with dates and times. Mostly conversion between the } +{ different formats but also some date testing routines (is leap year? etc) } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +// in Help: +// We do all conversions (but thoses provided by Delphi anyway) between +// TDateTime, TDosDateTime, TFileTime and TSystemTime plus +// TDatetime, TDosDateTime, TFileTime, TSystemTime to string + +unit JclDateTime; + +{$I jcl.inc} +{$I crossplatform.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Winapi.Windows, + {$ENDIF MSWINDOWS} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + {$IFDEF FPC} + {$IFDEF UNIX} + {$IFNDEF LINUX} + Unix, + {$ENDIF ~LINUX} + {$ENDIF FPC} + {$ENDIF} + JclBase, JclResources; + +const + // 1970-01-01T00:00:00 in TDateTime + UnixTimeStart = 25569; + +{ Encode / Decode functions } + +function EncodeDate(const Year: Integer; Month, Day: Word): TDateTime; +procedure DecodeDate(Date: TDateTime; out Year, Month, Day: Word); overload; +procedure DecodeDate(Date: TDateTime; out Year: Integer; out Month, Day: Word); overload; +procedure DecodeDate(Date: TDateTime; out Year, Month, Day: Integer); overload; + +function CenturyOfDate(const DateTime: TDateTime): Integer; +function CenturyBaseYear(const DateTime: TDateTime): Integer; +function DayOfDate(const DateTime: TDateTime): Integer; +function MonthOfDate(const DateTime: TDateTime): Integer; +function YearOfDate(const DateTime: TDateTime): Integer; +function DayOfTheYear(const DateTime: TDateTime; out Year: Integer): Integer; overload; +function DayOfTheYear(const DateTime: TDateTime): Integer; overload; +function DayOfTheYearToDateTime(const Year, Day: Integer): TDateTime; +function HourOfTime(const DateTime: TDateTime): Integer; +function MinuteOfTime(const DateTime: TDateTime): Integer; +function SecondOfTime(const DateTime: TDateTime): Integer; + +{ ISO 8601 support } + +function GetISOYearNumberOfWeeks(const Year: Word): Word; +function IsISOLongYear(const Year: Word): Boolean; overload; +function IsISOLongYear(const DateTime: TDateTime): Boolean; overload; +function ISODayOfWeek(const DateTime: TDateTime): Word; +function ISOWeekNumber(DateTime: TDateTime; out YearOfWeekNumber, WeekDay: Integer): Integer; overload; +function ISOWeekNumber(DateTime: TDateTime; out YearOfWeekNumber: Integer): Integer; overload; +function ISOWeekNumber(DateTime: TDateTime): Integer; overload; +function ISOWeekToDateTime(const Year, Week, Day: Integer): TDateTime; + +{ Miscellanous } + +function IsLeapYear(const Year: Integer): Boolean; overload; +function IsLeapYear(const DateTime: TDateTime): Boolean; overload; +function DaysInMonth(const DateTime: TDateTime): Integer; +function Make4DigitYear(Year, Pivot: Integer): Integer; +function MakeYear4Digit(Year, WindowsillYear: Integer): Integer; +function EasterSunday(const Year: Integer): TDateTime; +function FormatDateTime(Form: string; DateTime: TDateTime): string; +function FATDatesEqual(const FileTime1, FileTime2: Int64): Boolean; overload; +function FATDatesEqual(const FileTime1, FileTime2: TFileTime): Boolean; overload; + +// Conversion +type + TDosDateTime = Integer; + +function HoursToMSecs(Hours: Integer): Integer; +function MinutesToMSecs(Minutes: Integer): Integer; +function SecondsToMSecs(Seconds: Integer): Integer; + +function TimeOfDateTimeToSeconds(DateTime: TDateTime): Integer; +function TimeOfDateTimeToMSecs(DateTime: TDateTime): Integer; + +function DateTimeToLocalDateTime(DateTime: TDateTime): TDateTime; +function LocalDateTimeToDateTime(DateTime: TDateTime): TDateTime; + +{$IFDEF MSWINDOWS} +function DateTimeToDosDateTime(const DateTime: TDateTime): TDosDateTime; +function DateTimeToFileTime(DateTime: TDateTime): TFileTime; +function DateTimeToSystemTime(DateTime: TDateTime): TSystemTime; overload; +procedure DateTimeToSystemTime(DateTime: TDateTime; out SysTime: TSystemTime); overload; + +function LocalDateTimeToFileTime(DateTime: TDateTime): FileTime; +{$ENDIF MSWINDOWS} + +function DosDateTimeToDateTime(const DosTime: TDosDateTime): TDateTime; +{$IFDEF MSWINDOWS} +function DosDateTimeToFileTime(DosTime: TDosDateTime): TFileTime; overload; +procedure DosDateTimeToFileTime(DTH, DTL: Word; FT: TFileTime); overload; +function DosDateTimeToSystemTime(const DosTime: TDosDateTime): TSystemTime; +{$ENDIF MSWINDOWS} +function DosDateTimeToStr(DateTime: Integer): string; + +function FileTimeToDateTime(const FileTime: TFileTime): TDateTime; +{$IFDEF MSWINDOWS} +function FileTimeToLocalDateTime(const FileTime: TFileTime): TDateTime; +function FileTimeToDosDateTime(const FileTime: TFileTime): TDosDateTime; overload; +procedure FileTimeToDosDateTime(const FileTime: TFileTime; out Date, Time: Word); overload; +function FileTimeToSystemTime(const FileTime: TFileTime): TSystemTime; overload; +procedure FileTimeToSystemTime(const FileTime: TFileTime; out ST: TSystemTime); overload; +{$ENDIF MSWINDOWS} +function FileTimeToStr(const FileTime: TFileTime): string; + +{$IFDEF MSWINDOWS} +function SystemTimeToDosDateTime(const SystemTime: TSystemTime): TDosDateTime; +function SystemTimeToFileTime(const SystemTime: TSystemTime): TFileTime; overload; +procedure SystemTimeToFileTime(const SystemTime: TSystemTime; FTime: TFileTime); overload; +function SystemTimeToStr(const SystemTime: TSystemTime): string; + +// Filedates +function CreationDateTimeOfFile(const Sr: TSearchRec): TDateTime; +function LastAccessDateTimeOfFile(const Sr: TSearchRec): TDateTime; +function LastWriteDateTimeOfFile(const Sr: TSearchRec): TDateTime; +{$ENDIF MSWINDOWS} + +type + TJclUnixTime32 = Longword; + +function DateTimeToUnixTime(DateTime: TDateTime): TJclUnixTime32; +function UnixTimeToDateTime(const UnixTime: TJclUnixTime32): TDateTime; + +{$IFDEF MSWINDOWS} +function FileTimeToUnixTime(const AValue: TFileTime): TJclUnixTime32; +function UnixTimeToFileTime(const AValue: TJclUnixTime32): TFileTime; +{$ENDIF MSWINDOWS} + +// Time stamps (formerly in JclSchedule) +function NullStamp: TTimeStamp; +function CompareTimeStamps(const Stamp1, Stamp2: TTimeStamp): Int64; +function EqualTimeStamps(const Stamp1, Stamp2: TTimeStamp): Boolean; +function IsNullTimeStamp(const Stamp: TTimeStamp): Boolean; +function TimeStampDOW(const Stamp: TTimeStamp): Integer; + +// Day of week (formerly in JclSchedule) +function FirstWeekDay(const Year, Month: Integer; out DOW: Integer): Integer; overload; +function FirstWeekDay(const Year, Month: Integer): Integer; overload; +function LastWeekDay(const Year, Month: Integer; out DOW: Integer): Integer; overload; +function LastWeekDay(const Year, Month: Integer): Integer; overload; +function IndexedWeekDay(const Year, Month: Integer; Index: Integer): Integer; +function FirstWeekendDay(const Year, Month: Integer; out DOW: Integer): Integer; overload; +function FirstWeekendDay(const Year, Month: Integer): Integer; overload; +function LastWeekendDay(const Year, Month: Integer; out DOW: Integer): Integer; overload; +function LastWeekendDay(const Year, Month: Integer): Integer; overload; +function IndexedWeekendDay(const Year, Month: Integer; Index: Integer): Integer; +function FirstDayOfWeek(const Year, Month, DayOfWeek: Integer): Integer; +function LastDayOfWeek(const Year, Month, DayOfWeek: Integer): Integer; +function IndexedDayOfWeek(const Year, Month, DayOfWeek, Index: Integer): Integer; + +type + EJclDateTimeError = class(EJclError); + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + JclSysUtils; + +const + DaysInMonths: array [1..12] of Integer = + (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); + + MinutesPerDay = 60 * 24; + //SecondsPerMinute = 60; + //SecondsPerHour = 3600; + SecondsPerDay = MinutesPerDay * 60; + MsecsPerMinute = 60 * 1000; + MsecsPerHour = 60 * MsecsPerMinute; + DaysPerYear = 365.2422454; // Solar Year + DaysPerMonth = DaysPerYear / 12; + DateTimeBaseDay = -693593; // 1/1/0001 + EncodeDateMaxYear = 9999; + SolarDifference = 1.7882454; // Difference of Julian Calendar to Solar Calendar at 1/1/10000 + DateTimeMaxDay = 2958466; // 12/31/EncodeDateMaxYear + 1; + FileTimeBase = -109205.0; + FileTimeStep: Extended = 24.0 * 60.0 * 60.0 * 1000.0 * 1000.0 * 10.0; // 100 nSek per Day + + // Weekday to start the week + // 1 : Sonday + // 2 : Monday (according to ISO 8601) + //ISOFirstWeekDay = 2; + + // minmimum number of days of the year in the first week of the year week + // 1 : week one starts at 1/1 + // 4 : first week has at least four days (according to ISO 8601) + // 7 : first full week + //ISOFirstWeekMinDays = 4; + +function EncodeDate(const Year: Integer; Month, Day: Word): TDateTime; overload; +begin + if (Year > 0) and (Year < EncodeDateMaxYear + 1) then + Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.EncodeDate(Year, Month, Day) + else + begin + if Year <= 0 then + Result := Year * DaysPerYear + DateTimeBaseDay + else // Year >= 10000 + // for some reason year 0 does not exist so we switch from + // the last day of year -1 (-693594) to the first days of year 1 + Result := (Year-1) * DaysPerYear + DateTimeBaseDay + // BaseDate is 1/1/1 + SolarDifference; // guarantee a smooth transition at 1/1/10000 + Result := Trunc(Result); + Result := Result + (Month - 1) * DaysPerMonth; + Result := Integer(Round(Result)) + (Day - 1); + end; +end; + +procedure DecodeDate(Date: TDateTime; out Year, Month, Day: Word); +begin + {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.DecodeDate(Date, Year, Month, Day); +end; + +procedure DecodeDate(Date: TDateTime; out Year, Month, Day: Integer); +var + WMonth, WDay: Word; +begin + DecodeDate(Date, Year, WMonth, WDay); + Month := WMonth; + Day := WDay; +end; + +procedure DecodeDate(Date: TDateTime; out Year: Integer; out Month, Day: Word); +var + WYear: Word; + RDays, RMonths: TDateTime; +begin + if (Date >= DateTimeBaseDay) and (Date < DateTimeMaxDay) then + begin + {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.DecodeDate(Date, WYear, Month, Day); + Year := WYear; + end + else + begin + Year := Trunc((Date - DateTimeBaseDay) / DaysPerYear); + if Year <= 0 then + Year := Year - 1 + // for some historical reason year 0 does not exist so we switch from + // the last day of year -1 (-693594) to the first days of year 1 + else // Year >= 10000 + Date := Date - SolarDifference; // guarantee a smooth transition at 1/1/10000 + RDays := Date - DateTimeBaseDay; // Days relative to 1/1/0001 + RMonths := RDays / DaysPerMonth; // "Months" relative to 1/1/0001 + RMonths := RMonths - Year * 12.0; // 12 "Months" per Year + if RMonths < 0 then // possible truncation glitches + begin + RMonths := 11; + Year := Year - 1; + end; + Month := Trunc(RMonths); + RMonths := Month; + Month := Month + 1; + RDays := RDays - Year * DaysPerYear; // subtract Base Day ot the year + RDays := RDays - RMonths * DaysPerMonth;// subtract Base Day of the month + Day := Trunc(RDays)+ 1; + if Year > 0 then // Year >= 10000 + Year := Year + 1; // BaseDate is 1/1/1 + end; +end; + +procedure ResultCheck(Val: LongBool); +begin + if not Val then + raise EJclDateTimeError.CreateRes(@RsDateConversion); +end; + +function CenturyBaseYear(const DateTime: TDateTime): Integer; +var + Y: Integer; +begin + Y := YearOfDate(DateTime); + Result := (Y div 100) * 100; + if Y <= 0 then + Result := Result - 100; +end; + +function CenturyOfDate(const DateTime: TDateTime): Integer; +var + Y: Integer; +begin + Y := YearOfDate(DateTime); + if Y > 0 then + Result := (Y div 100) + 1 + else + Result := (Y div 100) - 1; +end; + +function DayOfDate(const DateTime: TDateTime): Integer; +var + Y: Integer; + M, D: Word; +begin + DecodeDate(DateTime, Y, M, D); + Result := D; +end; + +function MonthOfDate(const DateTime: TDateTime): Integer; +var + Y: Integer; + M, D: Word; +begin + DecodeDate(DateTime, Y, M, D); + Result := M; +end; + +function YearOfDate(const DateTime: TDateTime): Integer; +var + M, D: Word; +begin + DecodeDate(DateTime, Result, M, D); +end; + +function DayOfTheYear(const DateTime: TDateTime; out Year: Integer): Integer; +var + Month, Day: Word; + DT: TDateTime; +begin + DecodeDate(DateTime, Year, Month, Day); + DT := EncodeDate(Year, 1, 1); + Result := Trunc(DateTime); + Result := Result - Trunc(DT) + 1; +end; + +function DayOfTheYear(const DateTime: TDateTime): Integer; +var + Year: Integer; +begin + Result := DayOfTheYear(DateTime, Year); +end; + +function DayOfTheYearToDateTime(const Year, Day: Integer): TDateTime; +begin + Result := EncodeDate(Year, 1, 1) + Day - 1; +end; + +function HourOfTime(const DateTime: TDateTime): Integer; +var + H, M, S, MS: Word; +begin + DecodeTime(DateTime, H, M, S, MS); + Result := H; +end; + +function MinuteOfTime(const DateTime: TDateTime): Integer; +var + H, M, S, MS: Word; +begin + DecodeTime(DateTime, H, M, S, MS); + Result := M; +end; + +function SecondOfTime(const DateTime: TDateTime): Integer; +var + H, M, S, MS: Word; +begin + DecodeTime(DateTime, H, M, S, MS); + Result := S; +end; + +function TimeOfDateTimeToSeconds(DateTime: TDateTime): Integer; +begin + Result := Round(Frac(DateTime) * SecondsPerDay); +end; + +function TimeOfDateTimeToMSecs(DateTime: TDateTime): Integer; +begin + Result := Round(Frac(DateTime) * MSecsPerDay); +end; + +function DaysInMonth(const DateTime: TDateTime): Integer; +var + M: Integer; +begin + M := MonthOfDate(DateTime); + Result := DaysInMonths[M]; + if (M = 2) and IsLeapYear(DateTime) then + Result := 29; +end; + +// SysUtils.DayOfWeek returns the day of the week of the given date. The result is an integer between +// 1 and 7, corresponding to Sunday through Saturday. ISODayOfWeek on the other hand returns an integer +// between 1 and 7 where the first day is a Monday. The forumla for calculation ISODayOfTheWeek is +// simply +// DayOfWeek(D) - 1 if DayOfWeek(D) > 1 +// ISODayOfWeek (D) = 7 if DayOfWeek(D) = 1 + +function ISODayOfWeek(const DateTime: TDateTime): Word; +var + TmpDayOfWeek: Word; +begin + TmpDayOfWeek := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.DayOfWeek(DateTime); + if TmpDayOfWeek = 1 then + Result := 7 + else + Result := TmpDayOfWeek - 1; +end; + +// Determines if the ISO Year is ordinary (52 weeks) or Long (53 weeks). Uses a rule first +// suggested by Sven Pran (Norway) and Lars Nordentoft (Denmark) - according to +// http://www.phys.uu.nl/~vgent/calendar/isocalendar.htm + +function IsISOLongYear(const DateTime: TDateTime): Boolean; +var + TmpYear: Word; +begin + TmpYear := YearOfDate(DateTime); + Result := IsISOLongYear(TmpYear); +end; + +function IsISOLongYear(const Year: Word): Boolean; +var + TmpWeekday: Word; +begin + TmpWeekday := ISODayOfWeek(DayOfTheYearToDateTime(Year, 1)); + Result := (IsLeapYear(Year) and ((TmpWeekday = 3) or (TmpWeekday = 4))) or (TmpWeekday = 4); +end; + +function GetISOYearNumberOfWeeks(const Year: Word): Word; +begin + Result := 52; + if IsISOLongYear(Year) then + Result := 53; +end; + +// ISOWeekNumber function returns Integer 1..7 equivalent to Sunday..Saturday. +// ISO 8601 weeks start with Monday and the first week of a year is the one which +// includes the first Thursday + +function ISOWeekNumber(DateTime: TDateTime; out YearOfWeekNumber, WeekDay: Integer): Integer; +var + TmpYear: Integer; + January4th: TDateTime; + FirstMonday: TDateTime; +begin + // Applying the rule: The first calendar week is the week that includes January, 4th + TmpYear := YearOfDate(DateTime); + WeekDay := ISODayOfWeek(DateTime); + // adjust if we are between 12/29 and 12/31 + if (MonthOfDate(DateTime) = 12) and (DayOfDate(DateTime) >= 29) and + (ISODayOfWeek(DateTime) <= 3) then + TmpYear := TmpYear + 1; + + January4th := DayOfTheYearToDateTime(TmpYear, 4); + FirstMonday := January4th + 1 - ISODayOfWeek(January4th); + + // If our date is < FirstMonday we are in the last week of the previous year + if DateTime < FirstMonday then + begin + Result := GetISOYearNumberOfWeeks(TmpYear - 1); + YearOfWeekNumber := TmpYear - 1; + Exit; + end + else + begin + YearOfWeekNumber := TmpYear; + Result := (Trunc(DateTime - FirstMonday) div 7) + 1; + end; + + if Result > GetISOYearNumberOfWeeks(YearOfDate(DateTime)) then + Result := GetISOYearNumberOfWeeks(YearOfDate(DateTime)); +end; + +function ISOWeekNumber(DateTime: TDateTime; out YearOfWeekNumber: Integer): Integer; +var + Temp: Integer; +begin + Result := ISOWeekNumber(DateTime, YearOfWeekNumber, Temp); +end; + +function ISOWeekNumber(DateTime: TDateTime): Integer; +var + Temp: Integer; +begin + Result := ISOWeekNumber(DateTime, Temp, Temp); +end; + +function ISOWeekToDateTime(const Year, Week, Day: Integer): TDateTime; +var + January4th: TDateTime; + FirstMonday: TDateTime; +begin + January4th := DayOfTheYearToDateTime(Year, 4); + FirstMonday := January4th + 1 - ISODayOfWeek(January4th); + Result := FirstMonday + (Week - 1) * 7 + (Day - 1); +end; + +// The original Gregorian rule for all who want to learn it +// Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0)); + +function IsLeapYear(const Year: Integer): Boolean; +begin + Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.IsLeapYear(Year); +end; + +function IsLeapYear(const DateTime: TDateTime): Boolean; +begin + Result := IsLeapYear(YearOfDate(DateTime)); +end; + +function Make4DigitYear(Year, Pivot: Integer): Integer; +begin + { TODO : Make4DigitYear } + Assert((Year >= 0) and (Year <= 100) and (Pivot >= 0) and (Pivot <= 100)); + if Year = 100 then + Year := 0; + if Pivot = 100 then + Pivot := 0; + if Year < Pivot then + Result := 2000 + Year + else + Result := 1900 + Year; +end; + +// "window" technique for years to translate 2 digits to 4 digits. +// The window is 100 years wide +// The windowsill year is the lower edge of the window +// A windowsill year of 1900 is equivalent to putting 1900 before every 2-digit year +// if WindowsillYear is 1940, then 40 is interpreted as 1940, 00 as 2000 and 39 as 2039 +// The system default is 1950 + +function MakeYear4Digit(Year, WindowsillYear: Integer): Integer; +var + CC, Y: Integer; +begin + // have come across this specific problem : y2K read as year 100 + if Year = 100 then + Year := 0; + // turn 2 digit years to 4 digits + Y := Year mod 100; + CC := (WindowsillYear div 100) * 100; + Result := Y + CC; // give the result the same century as the windowsill + if Result < WindowsillYear then // cannot be lower than the windowsill + Result := Result + 100; + if (Year >= 100) or (Year < 0) then + Assert(Year = Result); // Assert: no unwanted century translation +end; + +// Calculates and returns Easter Day for specified year. +// Originally from Mark Lussier, AppVision . +// Corrected to prevent integer overflow if it is inadvertedly +// passed a year of 6554 or greater. + +function EasterSunday(const Year: Integer): TDateTime; +var + Month, Day, Moon, Epact, Sunday, + Gold, Cent, Corx, Corz: Integer; +begin + { The Golden Number of the year in the 19 year Metonic Cycle: } + Gold := Year mod 19 + 1; + { Calculate the Century: } + Cent := Year div 100 + 1; + { Number of years in which leap year was dropped in order... } + { to keep in step with the sun: } + Corx := (3 * Cent) div 4 - 12; + { Special correction to synchronize Easter with moon's orbit: } + Corz := (8 * Cent + 5) div 25 - 5; + { Find Sunday: } + Sunday := (Longint(5) * Year) div 4 - Corx - 10; + { ^ To prevent overflow at year 6554} + { Set Epact - specifies occurrence of full moon: } + Epact := (11 * Gold + 20 + Corz - Corx) mod 30; + if Epact < 0 then + Epact := Epact + 30; + if ((Epact = 25) and (Gold > 11)) or (Epact = 24) then + Epact := Epact + 1; + { Find Full Moon: } + Moon := 44 - Epact; + if Moon < 21 then + Moon := Moon + 30; + { Advance to Sunday: } + Moon := Moon + 7 - ((Sunday + Moon) mod 7); + if Moon > 31 then + begin + Month := 4; + Day := Moon - 31; + end + else + begin + Month := 3; + Day := Moon; + end; + Result := EncodeDate(Year, Month, Day); +end; + +// Conversion + +{$IFDEF MSWINDOWS} +function DateTimeToLocalDateTime(DateTime: TDateTime): TDateTime; +var + TimeZoneInfo: TTimeZoneInformation; +begin + ResetMemory(TimeZoneInfo, SizeOf(TimeZoneInfo)); + case GetTimeZoneInformation(TimeZoneInfo) of + TIME_ZONE_ID_STANDARD, TIME_ZONE_ID_UNKNOWN: + Result := DateTime - (TimeZoneInfo.Bias + TimeZoneInfo.StandardBias) / MinutesPerDay; + TIME_ZONE_ID_DAYLIGHT: + Result := DateTime - (TimeZoneInfo.Bias + TimeZoneInfo.DaylightBias) / MinutesPerDay; + else + raise EJclDateTimeError.CreateRes(@RsMakeUTCTime); + end; +end; +{$ENDIF MSWINDOWS} + +{$IFDEF UNIX} +function DateTimeToLocalDateTime(DateTime: TDateTime): TDateTime; +var + {$IFDEF LINUX} + TimeNow: time_t; + Local, UTCTime: TUnixTime; + {$ENDIF LINUX} + Offset: Double; +begin + {$IFDEF LINUX} + TimeNow := __time(nil); + UTCTime := gmtime(@TimeNow)^; + Local := localtime(@TimeNow)^; + Offset := difftime(mktime(UTCTime), mktime(Local)); + {$ELSE ~LINUX} + Offset := -TZSeconds; + {$ENDIF ~LINUX} + Result := ((DateTime * SecsPerDay) - Offset) / SecsPerDay; +end; +{$ENDIF UNIX} + +{$IFDEF MSWINDOWS} +function LocalDateTimeToDateTime(DateTime: TDateTime): TDateTime; +var + TimeZoneInfo: TTimeZoneInformation; +begin + ResetMemory(TimeZoneInfo, SizeOf(TimeZoneInfo)); + case GetTimeZoneInformation(TimeZoneInfo) of + TIME_ZONE_ID_STANDARD, TIME_ZONE_ID_UNKNOWN: + Result := DateTime + (TimeZoneInfo.Bias + TimeZoneInfo.StandardBias) / MinutesPerDay; + TIME_ZONE_ID_DAYLIGHT: + Result := DateTime + (TimeZoneInfo.Bias + TimeZoneInfo.DaylightBias) / MinutesPerDay; + else + raise EJclDateTimeError.CreateRes(@RsMakeUTCTime); + end; +end; +{$ENDIF MSWINDOWS} + +{$IFDEF UNIX} +function LocalDateTimeToDateTime(DateTime: TDateTime): TDateTime; +var + {$IFDEF LINUX} + TimeNow: time_t; + Local, UTCTime: TUnixTime; + {$ENDIF LINUX} + Offset: Double; +begin + {$IFDEF LINUX} + TimeNow := __time(nil); + UTCTime := gmtime(@TimeNow)^; + Local := localtime(@TimeNow)^; + Offset := difftime(mktime(UTCTime), mktime(Local)); + {$ELSE ~LINUX} + Offset := -TZSeconds; + {$ENDIF ~LINUX} + Result := ((DateTime * SecsPerDay) + Offset) / SecsPerDay; +end; +{$ENDIF UNIX} + +function HoursToMSecs(Hours: Integer): Integer; +begin + Assert(Hours < MaxInt / MsecsPerHour); + Result := Hours * MsecsPerHour; +end; + +function MinutesToMSecs(Minutes: Integer): Integer; +begin + Assert(Minutes < MaxInt div MsecsPerMinute); + Result := Minutes * MsecsPerMinute; +end; + +function SecondsToMSecs(Seconds: Integer): Integer; +begin + Assert(Seconds < MaxInt div 1000); + Result := Seconds * 1000; +end; + +// using system calls this can be done like this: +// var +// SystemTime: TSystemTime; +// begin +// ResultCheck(FileTimeToSystemTime(FileTime, SystemTime)); +// Result := SystemTimeToDateTime(SystemTime); + +function FileTimeToDateTime(const FileTime: TFileTime): TDateTime; +begin + Result := Int64(FileTime) / FileTimeStep; + Result := Result + FileTimeBase; +end; + +{$IFDEF MSWINDOWS} + +function FileTimeToLocalDateTime(const FileTime: TFileTime): TDateTime; +var + LocalFileTime: TFileTime; +begin + LocalFileTime.dwHighDateTime := 0; + LocalFileTime.dwLowDateTime := 0; + ResultCheck(FileTimeToLocalFileTime(FileTime, LocalFileTime)); + Result := FileTimeToDateTime(LocalFileTime); + { TODO : daylight saving time } +end; + +function LocalDateTimeToFileTime(DateTime: TDateTime): FileTime; +var + LocalFileTime: TFileTime; +begin + LocalFileTime := DateTimeToFileTime(DateTime); + Result.dwHighDateTime := 0; + Result.dwLowDateTime := 0; + ResultCheck(LocalFileTimeToFileTime(LocalFileTime, Result)); + { TODO : daylight saving time } +end; + +{$ENDIF MSWINDOWS} + +function DateTimeToFileTime(DateTime: TDateTime): TFileTime; +var + E: Extended; + F64: Int64; +begin + E := (DateTime - FileTimeBase) * FileTimeStep; + F64 := Round(E); + Result := TFileTime(F64); +end; + +{$IFDEF MSWINDOWS} + +function DosDateTimeToSystemTime(const DosTime: TDosDateTime): TSystemTime; +var + FileTime: TFileTime; +begin + FileTime := DosDateTimeToFileTime(DosTime); + Result := FileTimeToSystemTime(FileTime); +end; + +function SystemTimeToDosDateTime(const SystemTime: TSystemTime): TDosDateTime; +var + FileTime: TFileTime; +begin + FileTime := SystemTimeToFileTime(SystemTime); + Result := FileTimeToDosDateTime(FileTime); +end; + +{$ENDIF MSWINDOWS} + +// DosDateTimeToDateTime performs the same action as SysUtils.FileDateToDateTime +// not using SysUtils.FileDateToDateTime this can be done like that: +// var +// FileTime: TFileTime; +// SystemTime: TSystemTime; +// begin +// ResultCheck(DosDateTimeToFileTime(HiWord(DosTime), LoWord(DosTime), FileTime)); +// ResultCheck(FileTimeToSystemTime(FileTime, SystemTime)); +// Result := SystemTimeToDateTime(SystemTime); + +function DosDateTimeToDateTime(const DosTime: TDosDateTime): TDateTime; +begin + Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FileDateToDateTime(DosTime); +end; + +// DateTimeToDosDateTime performs the same action as SysUtils.DateTimeToFileDate +// not using SysUtils.DateTimeToDosDateTime this can be done like that: +// var +// SystemTime: TSystemTime; +// FileTime: TFileTime; +// Date, Time: Word; +// begin +// DateTimeToSystemTime(DateTime, SystemTime); +// ResultCheck(SystemTimeToFileTime(SystemTime, FileTime)); +// ResultCheck(FileTimeToDosDateTime(FileTime, Date, Time)); +// Result := (Date shl 16) or Time; + +function DateTimeToDosDateTime(const DateTime: TDateTime): TDosDateTime; +begin + Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.DateTimeToFileDate(DateTime); +end; + +{$IFDEF MSWINDOWS} + +function FileTimeToSystemTime(const FileTime: TFileTime): TSystemTime; overload; +begin + ResultCheck({$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.FileTimeToSystemTime(FileTime, Result)); +end; + +procedure FileTimeToSystemTime(const FileTime: TFileTime; out ST: TSystemTime); overload; +begin + {$IFDEF FPC} + ST.Day := 0; + {$ENDIF FPC} + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.FileTimeToSystemTime(FileTime, ST); +end; + +function SystemTimeToFileTime(const SystemTime: TSystemTime): TFileTime; overload; +begin + Result.dwHighDateTime := 0; + Result.dwLowDateTime := 0; + ResultCheck({$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.SystemTimeToFileTime(SystemTime, Result)); +end; + +procedure SystemTimeToFileTime(const SystemTime: TSystemTime; FTime: TFileTime); overload; +begin + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.SystemTimeToFileTime(SystemTime, FTime); +end; + +function DateTimeToSystemTime(DateTime: TDateTime): TSystemTime; overload; +begin + {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.DateTimeToSystemTime(DateTime, Result); +end; + +procedure DateTimeToSystemTime(DateTime: TDateTime; out SysTime: TSystemTime); overload; +begin + {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.DateTimeToSystemTime(DateTime, SysTime); +end; + +function DosDateTimeToFileTime(DosTime: TDosDateTime): TFileTime; overload; +begin + Result.dwHighDateTime := 0; + Result.dwLowDateTime := 0; + ResultCheck({$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.DosDateTimeToFileTime(HIWORD(DosTime), LOWORD(DosTime), Result)); +end; + +procedure DosDateTimeToFileTime(DTH, DTL: Word; FT: TFileTime); overload; +begin + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.DosDateTimeToFileTime(DTH, DTL, FT); +end; + +function FileTimeToDosDateTime(const FileTime: TFileTime): TDosDateTime; overload; +var + Date, Time: Word; +begin + Date := 0; + Time := 0; + ResultCheck({$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.FileTimeToDosDateTime(FileTime, Date, Time)); + Result := (Date shl 16) or Time; +end; + +procedure FileTimeToDosDateTime(const FileTime: TFileTime; out Date, Time: Word); overload; +begin + Date := 0; + Time := 0; + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.FileTimeToDosDateTime(FileTime, Date, Time); +end; + +{$ENDIF MSWINDOWS} + +function FileTimeToStr(const FileTime: TFileTime): string; +var + DateTime: TDateTime; +begin + DateTime := FileTimeToDateTime(FileTime); + Result := DateTimeToStr(DateTime); +end; + +function DosDateTimeToStr(DateTime: Integer): string; +begin + Result := DateTimeToStr(DosDateTimeToDateTime(DateTime)); +end; + +{$IFDEF MSWINDOWS} + +// we can't do this better without copying Borland-owned code from the Delphi VCL, +// as the straight forward conversion doing exactly this task is hidden +// deeply inside SysUtils.pas. +// So the date is converted forth and back to/from Julian date +// If someone needs a faster version please take a look at SysUtils.pas->DateTimeToStr. + +function SystemTimeToStr(const SystemTime: TSystemTime): string; +begin + Result := DateTimeToStr(SystemTimeToDateTime(SystemTime)); +end; + +function CreationDateTimeOfFile(const Sr: TSearchRec): TDateTime; +begin + Result := FileTimeToDateTime(Sr.FindData.ftCreationTime); +end; + +function LastAccessDateTimeOfFile(const Sr: TSearchRec): TDateTime; +begin + Result := FileTimeToDateTime(Sr.FindData.ftLastAccessTime); +end; + +function LastWriteDateTimeOfFile(const Sr: TSearchRec): TDateTime; +begin + Result := FileTimeToDateTime(Sr.FindData.ftLastWriteTime); +end; + +{$ENDIF MSWINDOWS} + +// Additional format tokens (also available in upper case): +// w: Week no according to ISO +// ww: Week no according to ISO forced two digits +// i: Year of the ISO-week denoted by w (4 digits for 1000..9999) +// ii: Year of the ISO-week denoted by w forced two digits +// e: Number of the Day in the ISO-week denoted by w (ISO-Notation 1=Monday...) +// f: Number of the Day in the year denoted by y +// fff: Number of the Day in the year denoted by y forced three digits + +function FormatDateTime(Form: string; DateTime: TDateTime): string; +var + N: Integer; + ISODay, ISOWeek, ISOYear, DayOfYear, YY: Integer; + + procedure Digest; + begin + if N > 1 then + begin + Result := Result + Copy(Form, 1, N - 1); + Delete(Form, 1, N - 1); + N := 1; + end; + end; + +begin + ISOWeek := 0; + DayOfYear := 0; + Result := ''; + N := 1; + while N <= Length(Form) do + begin + case Form[N] of + '"': + begin + Inc(N); + Digest; + N := Pos('"', Form); + if N = 0 then + begin + Result := Result + Form; + Form := ''; + N := 1; + end + else + begin + Inc(N); + Digest; + end; + end; + '''': + begin + Inc(N); + Digest; + N := Pos('''', Form); + if N = 0 then + begin + Result := Result + Form; + Form := ''; + N := 1; + end + else + begin + Inc(N); + Digest; + end; + end; + 'i', 'I': //ISO Week Year + begin + Digest; + if ISOWeek = 0 then + ISOWeek := ISOWeekNumber(DateTime, ISOYear, ISODay); + if (Length(Form) > 1) and ((Form[2] = 'i') or (Form[2] = 'I')) then + begin // + if (Length(Form) > 2) and ((Form[3] = 'i') or (Form[3] = 'I')) then + begin + if (Length(Form) > 3) and ((Form[4] = 'i') or (Form[4] = 'I')) then + begin // + Delete(Form, 1, 4); + Result := Result + '"' + IntToStr(ISOYear) + '"'; + end + else + begin // + Delete(Form, 1, 3); + Result := Result + '"' + IntToStr(ISOYear) + '"'; + end; + end + else + begin // + Delete(Form, 1, 2); + Result := Result + '"'; + if ISOYear < 10 then + Result := Result + '0'; + YY := ISOYear mod 100; + if YY < 10 then + Result := Result + '0'; + Result := Result + IntToStr(YY) + '"'; + end; + end + else + begin // + Delete(Form, 1, 1); + Result := Result + '"' + IntToStr(ISOYear) + '"'; + end; + end; + 'w', 'W': // ISO Week + begin + Digest; + if ISOWeek = 0 then + ISOWeek := ISOWeekNumber(DateTime, ISOYear, ISODay); + if (Length(Form) > 1) and ((Form[2] = 'w') or (Form[2] = 'W')) then + begin // + Delete(Form, 1, 2); + Result := Result + '"'; + if ISOWeek < 10 then + Result := Result + '0'; + Result := Result + IntToStr(ISOWeek) + '"'; + end + else + begin // + Delete(Form, 1, 1); + Result := Result + '"' + IntToStr(ISOWeek) + '"'; + end; + end; + 'e', 'E': // ISO Week Day + begin + Digest; + if ISOWeek = 0 then + ISOWeek := ISOWeekNumber(DateTime, ISOYear, ISODay); + Delete(Form, 1, 1); + Result := Result + '"' + IntToStr(ISODay) + '"'; + end; + 'f', 'F': // Day of the Year + begin + Digest; + if DayOfYear = 0 then + DayOfYear := DayOfTheYear(DateTime); + if (Length(Form) > 1) and ((Form[2] = 'f') or (Form[2] = 'F')) then + begin + if (Length(Form) > 2) and ((Form[3] = 'f') or (Form[3] = 'F')) then + begin // + Delete(Form, 1, 3); + Result := Result + '"'; + if DayOfYear < 10 then + Result := Result + '0'; + if DayOfYear < 100 then + Result := Result + '0'; + Result := Result + IntToStr(DayOfYear) + '"'; + end + else + begin // + Delete(Form, 1, 2); + Result := Result + '"'; + if DayOfYear < 10 then + Result := Result + '0'; + Result := Result + IntToStr(DayOfYear) + '"'; + end; + end + else + begin // + Delete(Form, 1, 1); + Result := Result + '"' + IntToStr(DayOfYear) + '"'; + end + end; + else + Inc(N); + end; + end; + Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FormatDateTime(Result + Form, DateTime); +end; + +// FAT has a granularity of 2 seconds +// The intervals are 1/10 of a second + +function FATDatesEqual(const FileTime1, FileTime2: Int64): Boolean; +const + ALLOWED_FAT_FILE_TIME_VARIATION = 20; +begin + Result := Abs(FileTime1 - FileTime2) <= ALLOWED_FAT_FILE_TIME_VARIATION; +end; + +function FATDatesEqual(const FileTime1, FileTime2: TFileTime): Boolean; +begin + Result := FATDatesEqual(Int64(FileTime1), Int64(FileTime2)); +end; + +// Conversion Unix time <--> TDateTime + +function DateTimeToUnixTime(DateTime: TDateTime): TJclUnixTime32; +begin + Result := Round((DateTime-UnixTimeStart) * SecondsPerDay); +end; + +function UnixTimeToDateTime(const UnixTime: TJclUnixTime32): TDateTime; +begin + Result:= UnixTimeStart + (UnixTime / SecondsPerDay); +end; + +// Conversion Unix time <--> FileTime + +{$IFDEF MSWINDOWS} + +function UnixTimeToFileTime(const AValue: TJclUnixTime32): TFileTime; +begin + Result := DateTimeToFileTime(UnixTimeToDateTime(AValue)); +end; + +function FileTimeToUnixTime(const AValue: TFileTime): TJclUnixTime32; +begin + Result := DateTimeToUnixTime(FileTimeToDateTime(AValue)); +end; + +{$ENDIF MSWINDOWS} + +// Time stamps utilities + +// Utility functions +function NullStamp: TTimeStamp; +begin + Result.Date := 0; + Result.Time := -1; +end; + +function CompareTimeStamps(const Stamp1, Stamp2: TTimeStamp): Int64; +begin + if Stamp1.Date < Stamp2.Date then + Result := -1 + else + if Stamp1.Date = Stamp2.Date then + begin + if Stamp1.Time < Stamp2.Time then + Result := -1 + else + if Stamp1.Time = Stamp2.Time then + Result := 0 + else // If Stamp1.Time > Stamp2.Time then + Result := 1; + end + else // if Stamp1.Date > Stamp2.Date then + Result := 1; +// Result := Int64(Stamp1) - Int64(Stamp2); +end; + +function EqualTimeStamps(const Stamp1, Stamp2: TTimeStamp): Boolean; +begin + Result := CompareTimeStamps(Stamp1, Stamp2) = 0; +end; + +function IsNullTimeStamp(const Stamp: TTimeStamp): Boolean; +begin + Result := CompareTimeStamps(NullStamp, Stamp) = 0; +end; + +function TimeStampDOW(const Stamp: TTimeStamp): Integer; +begin + Result := (Stamp.Date - 1) mod 7 + 1 +end; + +// day of week utilities + +function FirstWeekDay(const Year, Month: Integer; out DOW: Integer): Integer; +begin + DOW := ISODayOfWeek(EncodeDate(Year, Month, 1)); + if DOW > 5 then + begin + Result := 9 - DOW; + DOW := 1; + end + else + Result := 1; +end; + +function FirstWeekDay(const Year, Month: Integer): Integer; +var + Dummy: Integer; +begin + Result := FirstWeekDay(Year, Month, Dummy); +end; + +function LastWeekDay(const Year, Month: Integer; out DOW: Integer): Integer; +begin + DOW := ISODayOfWeek(EncodeDate(Year, Month, DaysInMonth(EncodeDate(Year, Month, 1)))); + if DOW > 5 then + begin + Result := DaysInMonth(EncodeDate(Year, Month, 1)) - (DOW - 5); + DOW := 5; + end + else + Result := DaysInMonth(EncodeDate(Year, Month, 1)); +end; + +function LastWeekDay(const Year, Month: Integer): Integer; +var + Dummy: Integer; +begin + Result := LastWeekDay(Year, Month, Dummy); +end; + +function IndexedWeekDay(const Year, Month: Integer; Index: Integer): Integer; +var + DOW: Integer; +begin + if Index > 0 then + Result := FirstWeekDay(Year, Month, DOW) + else + if Index < 0 then + Result := LastWeekDay(Year, Month, DOW) + else + Result := 0; + if Index > 1 then // n-th weekday from start of month + begin + Dec(Index); + if DOW > 1 then // adjust to first monday + begin + if Index < (5 - DOW) then + begin + Inc(Result, Index); + Index := 0; + end + else + begin + Dec(Index, 6 - DOW); + Inc(Result, 8 - DOW); + end; + end; + Result := Result + (7 * (Index div 5)) + (Index mod 5); + end + else + if Index < -1 then // n-th weekday from end of month + begin + Index := Abs(Index) - 1; + if DOW < 5 then // adjust to last friday + begin + if Index < DOW then + begin + Dec(Result, Index); + Index := 0; + end + else + begin + Dec(Index, DOW); + Dec(Result, DOW + 2); + end; + end; + Result := Result - (7 * (Index div 5)) - (Index mod 5); + end; + if (Result < 0) or (Result > DaysInMonth(EncodeDate(Year, Month, 1))) then + Result := 0; +end; + +function FirstWeekendDay(const Year, Month: Integer; out DOW: Integer): Integer; +begin + DOW := ISODayOfWeek(EncodeDate(Year, Month, 1)); + if DOW < 6 then + begin + Result := 7 - DOW; + DOW := 6; + end + else + Result := 1; +end; + +function FirstWeekendDay(const Year, Month: Integer): Integer; +var + Dummy: Integer; +begin + Result := FirstWeekendDay(Year, Month, Dummy); +end; + +function LastWeekendDay(const Year, Month: Integer; out DOW: Integer): Integer; +begin + DOW := ISODayOfWeek(EncodeDate(Year, Month, DaysInMonth(EncodeDate(Year, Month, 1)))); + if DOW < 6 then + begin + Result := DaysInMonth(EncodeDate(Year, Month, 1)) - DOW; + DOW := 7; + end + else + Result := DaysInMonth(EncodeDate(Year, Month, 1)); +end; + +function LastWeekendDay(const Year, Month: Integer): Integer; +var + Dummy: Integer; +begin + Result := LastWeekendDay(Year, Month, Dummy); +end; + +function IndexedWeekendDay(const Year, Month: Integer; Index: Integer): Integer; +var + DOW: Integer; +begin + if Index > 0 then + Result := FirstWeekendDay(Year, Month, DOW) + else + if Index < 0 then + Result := LastWeekendDay(Year, Month, DOW) + else + Result := 0; + if Index > 1 then // n-th weekend day from the start of the month + begin + if (DOW > 6) and not Odd(Index) then // Adjust to first saturday + begin + Inc(Result, 6); + Dec(Index); + end; + if Index > 1 then + begin + Dec(Index); + Result := Result + (7 * (Index div 2)) + (Index mod 2); + end; + end + else + if Index < -1 then // n-th weekend day from the start of the month + begin + Index := Abs(Index); + if (DOW < 7) and not Odd(Index) then // Adjust to last sunday + begin + Dec(Result, 6); + Dec(Index); + end; + if Index > 1 then + begin + Dec(Index); + Result := Result - (7 * (Index div 2)) - (Index mod 2); + end; + end; + if (Result < 0) or (Result > DaysInMonth(EncodeDate(Year, Month, 1))) then + Result := 0; +end; + +function FirstDayOfWeek(const Year, Month, DayOfWeek: Integer): Integer; +var + DOW: Integer; +begin + DOW := ISODayOfWeek(EncodeDate(Year, Month, 1)); + if DOW > DayOfWeek then + Result := 8 + DayOfWeek - DOW + else + if DOW < DayOfWeek then + Result := 1 + DayOfWeek - DOW + else + Result := 1; +end; + +function LastDayOfWeek(const Year, Month, DayOfWeek: Integer): Integer; +var + DOW: Integer; +begin + DOW := ISODayOfWeek(EncodeDate(Year, Month, DaysInMonth(EncodeDate(Year, Month, 1)))); + if DOW > DayOfWeek then + Result := DaysInMonth(EncodeDate(Year, Month, 1)) - (DOW - DayOfWeek) + else + if DOW < DayOfWeek then + Result := DaysInMonth(EncodeDate(Year, Month, 1)) - (7 - DayOfWeek + DOW) + else + Result := DaysInMonth(EncodeDate(Year, Month, 1)); +end; + +function IndexedDayOfWeek(const Year, Month, DayOfWeek, Index: Integer): Integer; +begin + if Index > 0 then + Result := FirstDayOfWeek(Year, Month, DayOfWeek) + 7 * (Index - 1) + else + if Index < 0 then + Result := LastDayOfWeek(Year, Month, DayOfWeek) - 7 * (Abs(Index) - 1) + else + Result := 0; + if (Result < 0) or (Result > DaysInMonth(EncodeDate(Year, Month, 1))) then + Result := 0; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclDevToolsResources.pas b/3rdParty/JCL/source/common/JclDevToolsResources.pas new file mode 100644 index 00000000..1201a8f5 --- /dev/null +++ b/3rdParty/JCL/source/common/JclDevToolsResources.pas @@ -0,0 +1,192 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclResources.pas. } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. } +{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. All rights reserved. } +{ } +{ Contributors: } +{ Alexei Koudinov } +{ Barry Kelly } +{ Flier Lu (flier) } +{ Florent Ouchet (outchy) } +{ Jean-Fabien Connault (cycocrew) } +{ Marcel Bestebroer } +{ Marcel van Brakel } +{ Matthias Thoma (mthoma) } +{ Peter Friese } +{ Petr Vones (pvones) } +{ Raymond Alexander (rayspostbox3) } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Scott Price (scottprice) } +{ Uwe Schuster (uschuster) } +{ } +{**************************************************************************************************} +{ } +{ Unit which provides a central place for all resource strings used in the JCL developer tool } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclDevToolsResources; + +{$I jcl.inc} + +interface + +{$IFDEF UNITVERSIONING} +uses + JclUnitVersioning; +{$ENDIF UNITVERSIONING} + +//=== JclIDEUtils ============================================================ +resourcestring + RsNeedUpdate = 'You should install latest Update Pack #%d for %s'; + RsUpdatePackName = 'Update Pack #%d'; + RsDelphiName = 'Delphi'; + RsBCBName = 'C++Builder'; + RsCSharpName = 'C#Builder'; + RsBDSName = 'Borland Developer Studio'; + RsRSName = 'RAD Studio'; + {$IFDEF MSWINDOWS} + RsClientServer = 'Client/Server'; + RsStandard = 'Standard'; + {$ENDIF MSWINDOWS} + RsArchitect = 'Architect'; + RsEnterprise = 'Enterprise'; + RsPersonal = 'Personal'; + RsProfessional = 'Professional'; + + RsMsBuildNotSupported = 'MSBuild is not supported by this IDE'; + + RsPackageInstallationStarted = 'Installing package %s'; + RsPackageInstallationFinished = 'Installation of package finished'; + RsPackageUninstallationStarted = 'Uninstalling package %s'; + RsPackageUninstallationFinished = 'Uninstallation of package finished'; + RsIdePackageInstallationStarted = 'Installing ide package %s'; + RsIdePackageInstallationFinished = 'Installation of ide package finished'; + RsIdePackageUninstallationStarted = 'Uninstalling ide package %s'; + RsIdePackageUninstallationFinished = 'Uninstallation of ide package finished'; + RsExpertInstallationStarted = 'Installing expert %s'; + RsExpertInstallationFinished = 'Installation of expert finished'; + RsExpertUninstallationStarted = 'Uninstalling expert %s'; + RsExpertUninstallationFinished = 'Uninstallation of expert finished'; + + RsCompilingPackage = 'Compiling package %s'; + RsCompilingProject = 'Compiling project %s'; + RsCompilationOk = 'Compilation success'; + RsCompilationFailed = 'Compilation failure'; + RsCreatingJdbg = 'Creating JEDI Debug informations for %s'; + RsInsertingJdbg = 'Inserting JEDI Debug informations in %s'; + RsJdbgInfo = 'Bug unit: %s; MAP size: %d; Debug size: %d'; + RsJdbgInfoOk = 'JDBG successfully generated'; + RsJdbgInfoFailed = 'Cannot generate JDBG informations'; + RsDeletingFile = 'Deleting file %s'; + RsFileDeletionOk = 'File deletion success'; + RsFileDeletionFailed = 'File deletion failure'; + RsRegisteringPackage = 'Registering package %s'; + RsRegisteringIdePackage = 'Registering ide package %s'; + RsRegisteringExpert = 'Registering expert %s'; + RsRegistrationOk = 'Registration ok'; + RsRegistrationFailed = 'Registration failed'; + RsUnregisteringPackage = 'Removing from registry package %s'; + RsUnregisteringIdePackage = 'Removing from registry ide package %s'; + RsUnregisteringExpert = 'Removing from registry expert %s'; + RsUnregistrationOk = 'Unregistration ok'; + RsUnregistrationFailed = 'Unregistration failed'; + RsCleaningPackageCache = 'Cleaning package cache for %s'; + RsCleaningOk = 'Cleaning ok'; + RsCleaningFailed = 'Cleaning failed'; + + RsEUnknownPackageExtension = '%s not a known package extension'; + RsEUnknownProjectExtension = '%s not a known project extension'; + RsEUnknownIdePackageExtension = '%s not a known IDE package extension'; + RsEIndexOufOfRange = 'Index out of range'; + RsECmdLineToolOutputInvalid = '%s: Output invalid, when OutputCallback assigned.'; + RsENotABcbPackage = '%s not a C++Builder package source file'; + RsENotADelphiProject = '%s not a Delphi project source file'; + RsENotADelphiPackage = '%s not a Delphi package source file'; + RsENotFound = '%s not found'; + RsECannotInstallRunOnly = 'A run-only package cannot be installed'; + RsENotABcbProject = '%s not a C++Builder project source file'; + RsENoSupportedPersonality = 'No personalities supported'; + RsEDualPackageNotSupported = 'This installation of %s doesn''t support dual packages'; + RsEWin64PlatformNotValid = 'This installation cannot generate binaries for Win64'; + RsEOSXPlatformNotValid = 'This installation cannot generate binaries for OSX'; + RsEPlatformNotValid = 'This installation cannot generate binaries for an unknown platform'; + {$IFDEF MSWINDOWS} + RsENoOpenHelp = 'open help not present in Borland Developer Studio'; + {$ENDIF MSWINDOWS} + RsERsVars = 'Query of RsVars for %s %d reported the following error "%s"'; + +//=== JclMsBuild.pas ========================================================= +resourcestring + RsEEndOfString = 'Invalid condition: end of string in condition "%s"'; + RsEMissingParenthesis = 'Invalid condition: missing parenthesis in condition "%s"'; + RsEUnknownOperator = 'Invalid condition: unknown operator in condition "%s"'; + RsEReservedProperty = 'Attempt to override or to delete a reserved MsBuild property'; + RsENoProjectElem = 'Project element expected, got "%s"'; + RsEUnknownSchema = 'Unknown schema "%s"'; + RsEUnknownProperty = 'Unknown property "%s"'; + RsEUnknownElement = 'Unknown element "%s"'; + RsEMultipleProjectExtensions = 'Multiple project extensions'; + RsEMultipleOtherwise = 'Multiple otherwise'; + RsEConditionNotUnique = 'Condition is not unique'; + RsEMissingTargetName = 'Missing target name'; + RsEMissingTaskName = 'Missing task name'; + RsEMissingAssembly = 'Missing assembly'; + RsEMissingTaskParameter = 'Missing task parameter'; + RsEMissingOutputName = 'Missing output name'; + RsEMSBuildPath = 'Unable to locate MSBuild.exe'; + RsEFunctionProperty = 'Unable to evaluate function property "%s"'; + RsERegistryProperty = 'Unable to evaluate registry property root="%s" path="%s" name="%s"'; + RsELocateXmlElem = 'Unable to locate the XML element for MSBuild property "%s"'; + RsEUnsupportedChildTypeInElement = 'Unsupported child type "%s" in element "%s"'; + +//=== JclUsesUtils.pas ======================================================= +resourcestring + RsEDuplicateUnit = 'Duplicate unit ''%s'''; + RsEInvalidLibrary = 'Invalid library'; + RsEInvalidProgram = 'Invalid program'; + RsEInvalidUnit = 'Invalid unit'; + RsEInvalidUses = 'Invalid uses clause'; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclExprEval.pas b/3rdParty/JCL/source/common/JclExprEval.pas new file mode 100644 index 00000000..fd1db197 --- /dev/null +++ b/3rdParty/JCL/source/common/JclExprEval.pas @@ -0,0 +1,4693 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclExprEval.pas. } +{ } +{ The Initial Developer of the Original Code is Barry Kelly. } +{ Portions created by Barry Kelly are Copyright (C) Barry Kelly. All rights reserved. } +{ } +{ Contributor(s): } +{ Barry Kelly } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ } +{**************************************************************************************************} +{ } +{ This unit contains three expression evaluators, each tailored for different usage patterns. It } +{ also contains the component objects, so that a customized expression evaluator can be assembled } +{ relatively easily. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +// operator priority (as implemented in this unit) +// all binary operators are associated from left to right +// all unary operators are associated from right to left + +// (highest) not bnot(bitwise) +(unary) -(unary) (level 3) +// * / div mod and band(bitwise) shl shr (level 2) +// +(binary) -(binary) or xor bor(bitwise) bxor(bitwise) (level 1) +// (lowest) < <= > >= cmp = <> (level 0) + +// details on cmp operator: +// "1.5 cmp 2.0" returns -1.0 because 1.5 < 2.0 +// "1.5 cmp 1.5" returns 0.0 because 1.5 = 1.5 +// "1.5 cmp 0.0" returns 1.0 because 1.5 > 0.0 + +unit JclExprEval; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, System.Classes, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, Classes, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclSysUtils, JclStrHashMap, JclResources; + +const + cExprEvalHashSize = 127; + +type + EJclExprEvalError = class(EJclError); + +type + TFloat = JclBase.Float; + + TFloat32 = Single; + PFloat32 = ^TFloat32; + + TFloat64 = Double; + PFloat64 = ^TFloat64; + + {$IFDEF SUPPORTS_EXTENDED} + TFloat80 = Extended; + PFloat80 = ^TFloat80; + {$ENDIF SUPPORTS_EXTENDED} + + TFloatFunc = function: TFloat; + TFloat32Func = function: TFloat32; + TFloat64Func = function: TFloat64; + {$IFDEF SUPPORTS_EXTENDED} + TFloat80Func = function: TFloat80; + {$ENDIF SUPPORTS_EXTENDED} + + TUnaryFunc = function(X: TFloat): TFloat; + TUnary32Func = function(X: TFloat32): TFloat32; + TUnary64Func = function(X: TFloat64): TFloat64; + {$IFDEF SUPPORTS_EXTENDED} + TUnary80Func = function(X: TFloat80): TFloat80; + {$ENDIF SUPPORTS_EXTENDED} + + TBinaryFunc = function(X, Y: TFloat): TFloat; + TBinary32Func = function(X, Y: TFloat32): TFloat32; + TBinary64Func = function(X, Y: TFloat64): TFloat64; + {$IFDEF SUPPORTS_EXTENDED} + TBinary80Func = function(X, Y: TFloat80): TFloat80; + {$ENDIF SUPPORTS_EXTENDED} + + TTernaryFunc = function(X, Y, Z: TFloat): TFloat; + TTernary32Func = function(X, Y, Z: TFloat32): TFloat32; + TTernary64Func = function(X, Y, Z: TFloat64): TFloat64; + {$IFDEF SUPPORTS_EXTENDED} + TTernary80Func = function(X, Y, Z: TFloat80): TFloat80; + {$ENDIF SUPPORTS_EXTENDED} + +type + { Forward Declarations } + TExprLexer = class; + TExprCompileParser = class; + TExprEvalParser = class; + TExprSym = class; + TExprNode = class; + TExprNodeFactory = class; + + TExprContext = class(TObject) + public + function Find(const AName: string): TExprSym; virtual; abstract; + end; + + TExprHashContext = class(TExprContext) + private + FHashMap: TStringHashMap; + public + constructor Create(ACaseSensitive: Boolean = False; AHashSize: Integer = 127); + destructor Destroy; override; + procedure Add(ASymbol: TExprSym); + procedure Remove(const AName: string); + function Find(const AName: string): TExprSym; override; + end; + + TExprSetContext = class(TExprContext) + private + FList: TList; + FOwnsContexts: Boolean; + function GetContexts(AIndex: Integer): TExprContext; + function GetCount: Integer; + public + constructor Create(AOwnsContexts: Boolean); + destructor Destroy; override; + procedure Add(AContext: TExprContext); + procedure Remove(AContext: TExprContext); + procedure Delete(AIndex: Integer); + function Extract(AContext: TExprContext): TExprContext; + property Count: Integer read GetCount; + property Contexts[AIndex: Integer]: TExprContext read GetContexts; + property InternalList: TList read FList; + function Find(const AName: string): TExprSym; override; + end; + + TExprSym = class(TObject) + private + FIdent: string; + FLexer: TExprLexer; + FEvalParser: TExprEvalParser; + FCompileParser: TExprCompileParser; + FNodeFactory: TExprNodeFactory; + public + constructor Create(const AIdent: string); + function Evaluate: TFloat; virtual; abstract; + function Compile: TExprNode; virtual; abstract; + property Ident: string read FIdent; + property Lexer: TExprLexer read FLexer write FLexer; + property CompileParser: TExprCompileParser read FCompileParser + write FCompileParser; + property EvalParser: TExprEvalParser read FEvalParser write FEvalParser; + property NodeFactory: TExprNodeFactory read FNodeFactory write FNodeFactory; + end; + + TExprToken = ( + // specials + etEof, + etNumber, + etIdentifier, + + // user extension tokens + etUser0, etUser1, etUser2, etUser3, etUser4, etUser5, etUser6, etUser7, + etUser8, etUser9, etUser10, etUser11, etUser12, etUser13, etUser14, etUser15, + etUser16, etUser17, etUser18, etUser19, etUser20, etUser21, etUser22, etUser23, + etUser24, etUser25, etUser26, etUser27, etUser28, etUser29, etUser30, etUser31, + + // compound tokens + etNotEqual, // <> + etLessEqual, // <= + etGreaterEqual, // >= + + // ASCII normal & ordinals + + etBang, // '!' #$21 33 + etDoubleQuote, // '"' #$22 34 + etHash, // '#' #$23 35 + etDollar, // '$' #$24 36 + etPercent, // '%' #$25 37 + etAmpersand, // '&' #$26 38 + etSingleQuote, // '''' #$27 39 + etLParen, // '(' #$28 40 + etRParen, // ')' #$29 41 + etAsterisk, // '*' #$2A 42 + etPlus, // '+' #$2B 43 + etComma, // ',' #$2C 44 + etMinus, // '-' #$2D 45 + etDot, // '.' #$2E 46 + etForwardSlash, // '/' #$2F 47 + + // 48..57 - numbers... + + etColon, // ':' #$3A 58 + etSemiColon, // ';' #$3B 59 + etLessThan, // '<' #$3C 60 + etEqualTo, // '=' #$3D 61 + etGreaterThan, // '>' #$3E 62 + etQuestion, // '?' #$3F 63 + etAt, // '@' #$40 64 + + // 65..90 - capital letters... + + etLBracket, // '[' #$5B 91 + etBackSlash, // '\' #$5C 92 + etRBracket, // ']' #$5D 93 + etArrow, // '^' #$5E 94 + // 95 - underscore + etBackTick, // '`' #$60 96 + + // 97..122 - small letters... + + etLBrace, // '{' #$7B 123 + etPipe, // '|' #$7C 124 + etRBrace, // '}' #$7D 125 + etTilde, // '~' #$7E 126 + et127, // '' #$7F 127 + etEuro, // '€' #$80 128 + et129, // '' #$81 129 + et130, // '‚' #$82 130 + et131, // 'ƒ' #$83 131 + et132, // '„' #$84 132 + et133, // '…' #$85 133 + et134, // '†' #$86 134 + et135, // '‡' #$87 135 + et136, // 'ˆ' #$88 136 + et137, // '‰' #$89 137 + et138, // 'Š' #$8A 138 + et139, // '‹' #$8B 139 + et140, // 'Œ' #$8C 140 + et141, // '' #$8D 141 + et142, // 'Ž' #$8E 142 + et143, // '' #$8F 143 + et144, // '' #$90 144 + et145, // '‘' #$91 145 + et146, // '’' #$92 146 + et147, // '“' #$93 147 + et148, // '”' #$94 148 + et149, // '•' #$95 149 + et150, // '–' #$96 150 + et151, // '—' #$97 151 + et152, // '˜' #$98 152 + et153, // '™' #$99 153 + et154, // 'š' #$9A 154 + et155, // '›' #$9B 155 + et156, // 'œ' #$9C 156 + et157, // '' #$9D 157 + et158, // 'ž' #$9E 158 + et159, // 'Ÿ' #$9F 159 + et160, // ' ' #$A0 160 + et161, // '¡' #$A1 161 + et162, // '¢' #$A2 162 + et163, // '£' #$A3 163 + et164, // '¤' #$A4 164 + et165, // '¥' #$A5 165 + et166, // '¦' #$A6 166 + et167, // '§' #$A7 167 + et168, // '¨' #$A8 168 + et169, // '©' #$A9 169 + et170, // 'ª' #$AA 170 + et171, // '«' #$AB 171 + et172, // '¬' #$AC 172 + et173, // '­' #$AD 173 + et174, // '®' #$AE 174 + et175, // '¯' #$AF 175 + et176, // '°' #$B0 176 + et177, // '±' #$B1 177 + et178, // '²' #$B2 178 + et179, // '³' #$B3 179 + et180, // '´' #$B4 180 + et181, // 'µ' #$B5 181 + et182, // '¶' #$B6 182 + et183, // '·' #$B7 183 + et184, // '¸' #$B8 184 + et185, // '¹' #$B9 185 + et186, // 'º' #$BA 186 + et187, // '»' #$BB 187 + et188, // '¼' #$BC 188 + et189, // '½' #$BD 189 + et190, // '¾' #$BE 190 + et191, // '¿' #$BF 191 + et192, // 'À' #$C0 192 + et193, // 'Á' #$C1 193 + et194, // 'Â' #$C2 194 + et195, // 'Ã' #$C3 195 + et196, // 'Ä' #$C4 196 + et197, // 'Å' #$C5 197 + et198, // 'Æ' #$C6 198 + et199, // 'Ç' #$C7 199 + et200, // 'È' #$C8 200 + et201, // 'É' #$C9 201 + et202, // 'Ê' #$CA 202 + et203, // 'Ë' #$CB 203 + et204, // 'Ì' #$CC 204 + et205, // 'Í' #$CD 205 + et206, // 'Î' #$CE 206 + et207, // 'Ï' #$CF 207 + et208, // 'Ð' #$D0 208 + et209, // 'Ñ' #$D1 209 + et210, // 'Ò' #$D2 210 + et211, // 'Ó' #$D3 211 + et212, // 'Ô' #$D4 212 + et213, // 'Õ' #$D5 213 + et214, // 'Ö' #$D6 214 + et215, // '×' #$D7 215 + et216, // 'Ø' #$D8 216 + et217, // 'Ù' #$D9 217 + et218, // 'Ú' #$DA 218 + et219, // 'Û' #$DB 219 + et220, // 'Ü' #$DC 220 + et221, // 'Ý' #$DD 221 + et222, // 'Þ' #$DE 222 + et223, // 'ß' #$DF 223 + et224, // 'à' #$E0 224 + et225, // 'á' #$E1 225 + et226, // 'â' #$E2 226 + et227, // 'ã' #$E3 227 + et228, // 'ä' #$E4 228 + et229, // 'å' #$E5 229 + et230, // 'æ' #$E6 230 + et231, // 'ç' #$E7 231 + et232, // 'è' #$E8 232 + et233, // 'é' #$E9 233 + et234, // 'ê' #$EA 234 + et235, // 'ë' #$EB 235 + et236, // 'ì' #$EC 236 + et237, // 'í' #$ED 237 + et238, // 'î' #$EE 238 + et239, // 'ï' #$EF 239 + et240, // 'ð' #$F0 240 + et241, // 'ñ' #$F1 241 + et242, // 'ò' #$F2 242 + et243, // 'ó' #$F3 243 + et244, // 'ô' #$F4 244 + et245, // 'õ' #$F5 245 + et246, // 'ö' #$F6 246 + et247, // '÷' #$F7 247 + et248, // 'ø' #$F8 248 + et249, // 'ù' #$F9 249 + et250, // 'ú' #$FA 250 + et251, // 'û' #$FB 251 + et252, // 'ü' #$FC 252 + et253, // 'ý' #$FD 253 + et254, // 'þ' #$FE 254 + et255, // 'ÿ' #$FF 255 + etInvalid // invalid token type + ); + + TExprLexer = class(TObject) + protected + FCurrTok: TExprToken; + FTokenAsNumber: TFloat; + FTokenAsString: string; + public + constructor Create; + procedure NextTok; virtual; abstract; + procedure Reset; virtual; + property TokenAsString: string read FTokenAsString; + property TokenAsNumber: TFloat read FTokenAsNumber; + property CurrTok: TExprToken read FCurrTok; + end; + + TExprNode = class(TObject) + private + FDepList: TList; + function GetDepCount: Integer; + function GetDeps(AIndex: Integer): TExprNode; + public + constructor Create(const ADepList: array of TExprNode); + destructor Destroy; override; + procedure AddDep(ADep: TExprNode); + property DepCount: Integer read GetDepCount; + property Deps[AIndex: Integer]: TExprNode read GetDeps; default; + property DepList: TList read FDepList; + end; + + TExprNodeFactory = class(TObject) + public + function LoadVar32(ALoc: PFloat32): TExprNode; virtual; abstract; + function LoadVar64(ALoc: PFloat64): TExprNode; virtual; abstract; + {$IFDEF SUPPORTS_EXTENDED} + function LoadVar80(ALoc: PFloat80): TExprNode; virtual; abstract; + {$ENDIF SUPPORTS_EXTENDED} + + function LoadConst32(AValue: TFloat32): TExprNode; virtual; abstract; + function LoadConst64(AValue: TFloat64): TExprNode; virtual; abstract; + {$IFDEF SUPPORTS_EXTENDED} + function LoadConst80(AValue: TFloat80): TExprNode; virtual; abstract; + {$ENDIF SUPPORTS_EXTENDED} + + function CallFloatFunc(AFunc: TFloatFunc): TExprNode; virtual; abstract; + function CallFloat32Func(AFunc: TFloat32Func): TExprNode; virtual; abstract; + function CallFloat64Func(AFunc: TFloat64Func): TExprNode; virtual; abstract; + {$IFDEF SUPPORTS_EXTENDED} + function CallFloat80Func(AFunc: TFloat80Func): TExprNode; virtual; abstract; + {$ENDIF SUPPORTS_EXTENDED} + function CallUnaryFunc(AFunc: TUnaryFunc; X: TExprNode): TExprNode; virtual; abstract; + function CallUnary32Func(AFunc: TUnary32Func; X: TExprNode): TExprNode; virtual; abstract; + function CallUnary64Func(AFunc: TUnary64Func; X: TExprNode): TExprNode; virtual; abstract; + {$IFDEF SUPPORTS_EXTENDED} + function CallUnary80Func(AFunc: TUnary80Func; X: TExprNode): TExprNode; virtual; abstract; + {$ENDIF SUPPORTS_EXTENDED} + function CallBinaryFunc(AFunc: TBinaryFunc; X, Y: TExprNode): TExprNode; virtual; abstract; + function CallBinary32Func(AFunc: TBinary32Func; X, Y: TExprNode): TExprNode; virtual; abstract; + function CallBinary64Func(AFunc: TBinary64Func; X, Y: TExprNode): TExprNode; virtual; abstract; + {$IFDEF SUPPORTS_EXTENDED} + function CallBinary80Func(AFunc: TBinary80Func; X, Y: TExprNode): TExprNode; virtual; abstract; + {$ENDIF SUPPORTS_EXTENDED} + function CallTernaryFunc(AFunc: TTernaryFunc; X, Y, Z: TExprNode): TExprNode; virtual; abstract; + function CallTernary32Func(AFunc: TTernary32Func; X, Y, Z: TExprNode): TExprNode; virtual; abstract; + function CallTernary64Func(AFunc: TTernary64Func; X, Y, Z: TExprNode): TExprNode; virtual; abstract; + {$IFDEF SUPPORTS_EXTENDED} + function CallTernary80Func(AFunc: TTernary80Func; X, Y, Z: TExprNode): TExprNode; virtual; abstract; + {$ENDIF SUPPORTS_EXTENDED} + + function Add(ALeft, ARight: TExprNode): TExprNode; virtual; abstract; + function Subtract(ALeft, ARight: TExprNode): TExprNode; virtual; abstract; + function Multiply(ALeft, ARight: TExprNode): TExprNode; virtual; abstract; + function Divide(ALeft, ARight: TExprNode): TExprNode; virtual; abstract; + function IntegerDivide(ALeft, ARight: TExprNode): TExprNode; virtual; abstract; + function Modulo(ALeft, ARight: TExprNode): TExprNode; virtual; abstract; + function Negate(AValue: TExprNode): TExprNode; virtual; abstract; + function Power(ALeft, ARight: TExprNode): TExprNode; virtual; abstract; + + function Compare(ALeft, ARight: TExprNode): TExprNode; virtual; abstract; + function CompareEqual(ALeft, ARight: TExprNode): TExprNode; virtual; abstract; + function CompareNotEqual(ALeft, ARight: TExprNode): TExprNode; virtual; abstract; + function CompareLess(ALeft, ARight: TExprNode): TExprNode; virtual; abstract; + function CompareLessEqual(ALeft, ARight: TExprNode): TExprNode; virtual; abstract; + function CompareGreater(ALeft, ARight: TExprNode): TExprNode; virtual; abstract; + function CompareGreaterEqual(ALeft, ARight: TExprNode): TExprNode; virtual; abstract; + + function LogicalAnd(ALeft, ARight: TExprNode): TExprNode; virtual; abstract; + function LogicalOr(ALeft, ARight: TExprNode): TExprNode; virtual; abstract; + function LogicalXor(ALeft, ARight: TExprNode): TExprNode; virtual; abstract; + function LogicalNot(AValue: TExprNode): TExprNode; virtual; abstract; + function BitwiseAnd(ALeft, ARight: TExprNode): TExprNode; virtual; abstract; + function BitwiseOr(ALeft, ARight: TExprNode): TExprNode; virtual; abstract; + function BitwiseXor(ALeft, ARight: TExprNode): TExprNode; virtual; abstract; + function BitwiseNot(AValue: TExprNode): TExprNode; virtual; abstract; + function ShiftLeft(ALeft, ARight: TExprNode): TExprNode; virtual; abstract; + function ShiftRight(ALeft, ARight: TExprNode): TExprNode; virtual; abstract; + + function LoadVar(ALoc: PFloat32): TExprNode; overload; + function LoadVar(ALoc: PFloat64): TExprNode; overload; + {$IFDEF SUPPORTS_EXTENDED} + function LoadVar(ALoc: PFloat80): TExprNode; overload; + {$ENDIF SUPPORTS_EXTENDED} + function LoadConst(AValue: TFloat32): TExprNode; overload; + function LoadConst(AValue: TFloat64): TExprNode; overload; + {$IFDEF SUPPORTS_EXTENDED} + function LoadConst(AValue: TFloat80): TExprNode; overload; + {$ENDIF SUPPORTS_EXTENDED} + end; + + TExprCompileParser = class(TObject) + private + FContext: TExprContext; + FLexer: TExprLexer; + FNodeFactory: TExprNodeFactory; + protected + function CompileExprLevel0(ASkip: Boolean): TExprNode; virtual; + function CompileExprLevel1(ASkip: Boolean): TExprNode; virtual; + function CompileExprLevel2(ASkip: Boolean): TExprNode; virtual; + function CompileExprLevel3(ASkip: Boolean): TExprNode; virtual; + function CompileExprLevel4(ASkip: Boolean): TExprNode; virtual; + function CompileFactor: TExprNode; virtual; + function CompileIdentFactor: TExprNode; virtual; + public + constructor Create(ALexer: TExprLexer; ANodeFactory: TExprNodeFactory); + function Compile: TExprNode; virtual; + property Lexer: TExprLexer read FLexer; + property NodeFactory: TExprNodeFactory read FNodeFactory; + property Context: TExprContext read FContext write FContext; + end; + + TExprEvalParser = class(TObject) + private + FContext: TExprContext; + FLexer: TExprLexer; + protected + function EvalExprLevel0(ASkip: Boolean): TFloat; virtual; + function EvalExprLevel1(ASkip: Boolean): TFloat; virtual; + function EvalExprLevel2(ASkip: Boolean): TFloat; virtual; + function EvalExprLevel3(ASkip: Boolean): TFloat; virtual; + function EvalExprLevel4(ASkip: Boolean): TFloat; virtual; + function EvalFactor: TFloat; virtual; + function EvalIdentFactor: TFloat; virtual; + public + constructor Create(ALexer: TExprLexer); + function Evaluate: TFloat; virtual; + + property Lexer: TExprLexer read FLexer; + property Context: TExprContext read FContext write FContext; + end; + +{ some concrete class descendants follow... } + + TExprSimpleLexer = class(TExprLexer) + protected + FCurrPos: PChar; + FBuf: string; + procedure SetBuf(const ABuf: string); + public + constructor Create(const ABuf: string); + + procedure NextTok; override; + procedure Reset; override; + + property Buf: string read FBuf write SetBuf; + end; + + TExprVirtMachOp = class(TObject) + private + function GetOutputLoc: PFloat; + protected + FOutput: TFloat; + public + procedure Execute; virtual; abstract; + property OutputLoc: PFloat read GetOutputLoc; + end; + + TExprVirtMach = class(TObject) + private + FCodeList: TList; + FConstList: TList; + public + constructor Create; + destructor Destroy; override; + procedure Add(AOp: TExprVirtMachOp); + procedure AddConst(AOp: TExprVirtMachOp); + procedure Clear; + function Execute: TFloat; + end; + + TExprVirtMachNodeFactory = class(TExprNodeFactory) + private + FNodeList: TList; + function AddNode(ANode: TExprNode): TExprNode; + procedure DoClean(AVirtMach: TExprVirtMach); + procedure DoConsts(AVirtMach: TExprVirtMach); + procedure DoCode(AVirtMach: TExprVirtMach); + public + constructor Create; + destructor Destroy; override; + + procedure GenCode(AVirtMach: TExprVirtMach); + + function LoadVar32(ALoc: PFloat32): TExprNode; override; + function LoadVar64(ALoc: PFloat64): TExprNode; override; + {$IFDEF SUPPORTS_EXTENDED} + function LoadVar80(ALoc: PFloat80): TExprNode; override; + {$ENDIF SUPPORTS_EXTENDED} + function LoadConst32(AValue: TFloat32): TExprNode; override; + function LoadConst64(AValue: TFloat64): TExprNode; override; + {$IFDEF SUPPORTS_EXTENDED} + function LoadConst80(AValue: TFloat80): TExprNode; override; + {$ENDIF SUPPORTS_EXTENDED} + + function CallFloatFunc(AFunc: TFloatFunc): TExprNode; override; + function CallFloat32Func(AFunc: TFloat32Func): TExprNode; override; + function CallFloat64Func(AFunc: TFloat64Func): TExprNode; override; + {$IFDEF SUPPORTS_EXTENDED} + function CallFloat80Func(AFunc: TFloat80Func): TExprNode; override; + {$ENDIF SUPPORTS_EXTENDED} + function CallUnaryFunc(AFunc: TUnaryFunc; X: TExprNode): TExprNode; override; + function CallUnary32Func(AFunc: TUnary32Func; X: TExprNode): TExprNode; override; + function CallUnary64Func(AFunc: TUnary64Func; X: TExprNode): TExprNode; override; + {$IFDEF SUPPORTS_EXTENDED} + function CallUnary80Func(AFunc: TUnary80Func; X: TExprNode): TExprNode; override; + {$ENDIF SUPPORTS_EXTENDED} + function CallBinaryFunc(AFunc: TBinaryFunc; X, Y: TExprNode): TExprNode; override; + function CallBinary32Func(AFunc: TBinary32Func; X, Y: TExprNode): TExprNode; override; + function CallBinary64Func(AFunc: TBinary64Func; X, Y: TExprNode): TExprNode; override; + {$IFDEF SUPPORTS_EXTENDED} + function CallBinary80Func(AFunc: TBinary80Func; X, Y: TExprNode): TExprNode; override; + {$ENDIF SUPPORTS_EXTENDED} + function CallTernaryFunc(AFunc: TTernaryFunc; X, Y, Z: TExprNode): TExprNode; override; + function CallTernary32Func(AFunc: TTernary32Func; X, Y, Z: TExprNode): TExprNode; override; + function CallTernary64Func(AFunc: TTernary64Func; X, Y, Z: TExprNode): TExprNode; override; + {$IFDEF SUPPORTS_EXTENDED} + function CallTernary80Func(AFunc: TTernary80Func; X, Y, Z: TExprNode): TExprNode; override; + {$ENDIF SUPPORTS_EXTENDED} + + function Add(ALeft, ARight: TExprNode): TExprNode; override; + function Subtract(ALeft, ARight: TExprNode): TExprNode; override; + function Multiply(ALeft, ARight: TExprNode): TExprNode; override; + function Divide(ALeft, ARight: TExprNode): TExprNode; override; + function IntegerDivide(ALeft, ARight: TExprNode): TExprNode; override; + function Modulo(ALeft, ARight: TExprNode): TExprNode; override; + function Negate(AValue: TExprNode): TExprNode; override; + function Power(ALeft, ARight: TExprNode): TExprNode; override; + + function Compare(ALeft, ARight: TExprNode): TExprNode; override; + function CompareEqual(ALeft, ARight: TExprNode): TExprNode; override; + function CompareNotEqual(ALeft, ARight: TExprNode): TExprNode; override; + function CompareLess(ALeft, ARight: TExprNode): TExprNode; override; + function CompareLessEqual(ALeft, ARight: TExprNode): TExprNode; override; + function CompareGreater(ALeft, ARight: TExprNode): TExprNode; override; + function CompareGreaterEqual(ALeft, ARight: TExprNode): TExprNode; override; + + function LogicalAnd(ALeft, ARight: TExprNode): TExprNode; override; + function LogicalOr(ALeft, ARight: TExprNode): TExprNode; override; + function LogicalXor(ALeft, ARight: TExprNode): TExprNode; override; + function LogicalNot(AValue: TExprNode): TExprNode; override; + function BitwiseAnd(ALeft, ARight: TExprNode): TExprNode; override; + function BitwiseOr(ALeft, ARight: TExprNode): TExprNode; override; + function BitwiseXor(ALeft, ARight: TExprNode): TExprNode; override; + function BitwiseNot(AValue: TExprNode): TExprNode; override; + function ShiftLeft(ALeft, ARight: TExprNode): TExprNode; override; + function ShiftRight(ALeft, ARight: TExprNode): TExprNode; override; + end; + + { some concrete symbols } + + TExprConstSym = class(TExprSym) + private + FValue: TFloat; + public + constructor Create(const AIdent: string; AValue: TFloat); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + + TExprConst32Sym = class(TExprSym) + private + FValue: TFloat32; + public + constructor Create(const AIdent: string; AValue: TFloat32); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + + TExprConst64Sym = class(TExprSym) + private + FValue: TFloat64; + public + constructor Create(const AIdent: string; AValue: TFloat64); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + + {$IFDEF SUPPORTS_EXTENDED} + TExprConst80Sym = class(TExprSym) + private + FValue: TFloat80; + public + constructor Create(const AIdent: string; AValue: TFloat80); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + {$ENDIF SUPPORTS_EXTENDED} + + TExprVar32Sym = class(TExprSym) + private + FLoc: PFloat32; + public + constructor Create(const AIdent: string; ALoc: PFloat32); + + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + + TExprVar64Sym = class(TExprSym) + private + FLoc: PFloat64; + public + constructor Create(const AIdent: string; ALoc: PFloat64); + + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + + {$IFDEF SUPPORTS_EXTENDED} + TExprVar80Sym = class(TExprSym) + private + FLoc: PFloat80; + public + constructor Create(const AIdent: string; ALoc: PFloat80); + + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + {$ENDIF SUPPORTS_EXTENDED} + + TExprAbstractFuncSym = class(TExprSym) + protected + function EvalFirstArg: TFloat; + function EvalNextArg: TFloat; + function CompileFirstArg: TExprNode; + function CompileNextArg: TExprNode; + procedure EndArgs; + end; + + TExprFuncSym = class(TExprAbstractFuncSym) + private + FFunc: TFloatFunc; + public + constructor Create(const AIdent: string; AFunc: TFloatFunc); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + + TExprFloat32FuncSym = class(TExprAbstractFuncSym) + private + FFunc: TFloat32Func; + public + constructor Create(const AIdent: string; AFunc: TFloat32Func); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + + TExprFloat64FuncSym = class(TExprAbstractFuncSym) + private + FFunc: TFloat64Func; + public + constructor Create(const AIdent: string; AFunc: TFloat64Func); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + + {$IFDEF SUPPORTS_EXTENDED} + TExprFloat80FuncSym = class(TExprAbstractFuncSym) + private + FFunc: TFloat80Func; + public + constructor Create(const AIdent: string; AFunc: TFloat80Func); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + {$ENDIF SUPPORTS_EXTENDED} + + TExprUnaryFuncSym = class(TExprAbstractFuncSym) + private + FFunc: TUnaryFunc; + public + constructor Create(const AIdent: string; AFunc: TUnaryFunc); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + + TExprUnary32FuncSym = class(TExprAbstractFuncSym) + private + FFunc: TUnary32Func; + public + constructor Create(const AIdent: string; AFunc: TUnary32Func); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + + TExprUnary64FuncSym = class(TExprAbstractFuncSym) + private + FFunc: TUnary64Func; + public + constructor Create(const AIdent: string; AFunc: TUnary64Func); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + + {$IFDEF SUPPORTS_EXTENDED} + TExprUnary80FuncSym = class(TExprAbstractFuncSym) + private + FFunc: TUnary80Func; + public + constructor Create(const AIdent: string; AFunc: TUnary80Func); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + {$ENDIF SUPPORTS_EXTENDED} + + TExprBinaryFuncSym = class(TExprAbstractFuncSym) + private + FFunc: TBinaryFunc; + public + constructor Create(const AIdent: string; AFunc: TBinaryFunc); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + + TExprBinary32FuncSym = class(TExprAbstractFuncSym) + private + FFunc: TBinary32Func; + public + constructor Create(const AIdent: string; AFunc: TBinary32Func); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + + TExprBinary64FuncSym = class(TExprAbstractFuncSym) + private + FFunc: TBinary64Func; + public + constructor Create(const AIdent: string; AFunc: TBinary64Func); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + + {$IFDEF SUPPORTS_EXTENDED} + TExprBinary80FuncSym = class(TExprAbstractFuncSym) + private + FFunc: TBinary80Func; + public + constructor Create(const AIdent: string; AFunc: TBinary80Func); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + {$ENDIF SUPPORTS_EXTENDED} + + TExprTernaryFuncSym = class(TExprAbstractFuncSym) + private + FFunc: TTernaryFunc; + public + constructor Create(const AIdent: string; AFunc: TTernaryFunc); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + + TExprTernary32FuncSym = class(TExprAbstractFuncSym) + private + FFunc: TTernary32Func; + public + constructor Create(const AIdent: string; AFunc: TTernary32Func); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + + TExprTernary64FuncSym = class(TExprAbstractFuncSym) + private + FFunc: TTernary64Func; + public + constructor Create(const AIdent: string; AFunc: TTernary64Func); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + + {$IFDEF SUPPORTS_EXTENDED} + TExprTernary80FuncSym = class(TExprAbstractFuncSym) + private + FFunc: TTernary80Func; + public + constructor Create(const AIdent: string; AFunc: TTernary80Func); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + {$ENDIF SUPPORTS_EXTENDED} + + TEasyEvaluator = class(TObject) + private + FOwnContext: TExprHashContext; + FExtContextSet: TExprSetContext; + FInternalContextSet: TExprSetContext; + protected + property InternalContextSet: TExprSetContext read FInternalContextSet; + public + constructor Create; + destructor Destroy; override; + + procedure AddVar(const AName: string; var AVar: TFloat32); overload; + procedure AddVar(const AName: string; var AVar: TFloat64); overload; + {$IFDEF SUPPORTS_EXTENDED} + procedure AddVar(const AName: string; var AVar: TFloat80); overload; + {$ENDIF SUPPORTS_EXTENDED} + + procedure AddConst(const AName: string; AConst: TFloat32); overload; + procedure AddConst(const AName: string; AConst: TFloat64); overload; + {$IFDEF SUPPORTS_EXTENDED} + procedure AddConst(const AName: string; AConst: TFloat80); overload; + {$ENDIF SUPPORTS_EXTENDED} + + procedure AddFunc(const AName: string; AFunc: TFloat32Func); overload; + procedure AddFunc(const AName: string; AFunc: TFloat64Func); overload; + {$IFDEF SUPPORTS_EXTENDED} + procedure AddFunc(const AName: string; AFunc: TFloat80Func); overload; + {$ENDIF SUPPORTS_EXTENDED} + procedure AddFunc(const AName: string; AFunc: TUnary32Func); overload; + procedure AddFunc(const AName: string; AFunc: TUnary64Func); overload; + {$IFDEF SUPPORTS_EXTENDED} + procedure AddFunc(const AName: string; AFunc: TUnary80Func); overload; + {$ENDIF SUPPORTS_EXTENDED} + procedure AddFunc(const AName: string; AFunc: TBinary32Func); overload; + procedure AddFunc(const AName: string; AFunc: TBinary64Func); overload; + {$IFDEF SUPPORTS_EXTENDED} + procedure AddFunc(const AName: string; AFunc: TBinary80Func); overload; + {$ENDIF SUPPORTS_EXTENDED} + procedure AddFunc(const AName: string; AFunc: TTernary32Func); overload; + procedure AddFunc(const AName: string; AFunc: TTernary64Func); overload; + {$IFDEF SUPPORTS_EXTENDED} + procedure AddFunc(const AName: string; AFunc: TTernary80Func); overload; + {$ENDIF SUPPORTS_EXTENDED} + procedure Remove(const AName: string); + + procedure Clear; virtual; + property ExtContextSet: TExprSetContext read FExtContextSet; + end; + + TEvaluator = class(TEasyEvaluator) + private + FLexer: TExprSimpleLexer; + FParser: TExprEvalParser; + public + constructor Create; + destructor Destroy; override; + function Evaluate(const AExpr: string): TFloat; + end; + + TCompiledEvaluator = class(TEasyEvaluator) + private + FExpr: string; + FVirtMach: TExprVirtMach; + public + constructor Create; + destructor Destroy; override; + procedure Compile(const AExpr: string); + function Evaluate: TFloat; + end; + + { TODO : change this definition to be just a normal function pointer, not + a closure; will require a small executable memory allocater, and a + couple of injected instructions. Similar concept to + Forms.MakeObjectInstance. + + This will allow compiled expressions to be used as functions in + contexts. Parameters won't be supported, though; I'll think about + this. } + + TCompiledExpression = function: TFloat of object; + + TExpressionCompiler = class(TEasyEvaluator) + private + FExprHash: TStringHashMap; + public + constructor Create; + destructor Destroy; override; + function Compile(const AExpr: string): TCompiledExpression; + procedure Remove(const AExpr: string); + procedure Delete(ACompiledExpression: TCompiledExpression); + procedure Clear; override; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF SUPPORTS_INLINE} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, // inline of AnsiSameText + System.Types, // inline TObjectList.Remove + {$ELSE ~HAS_UNITSCOPE} + Windows, // inline of AnsiSameText + {$ENDIF ~HAS_UNITSCOPE} + {$ENDIF SUPPORTS_INLINE} + {$IFDEF HAS_UNITSCOPE} + System.Math, + {$ELSE ~HAS_UNITSCOPE} + Math, + {$ENDIF ~HAS_UNITSCOPE} + JclStrings; + +{$IFDEF RTL150_UP} +var + FFormatSettings: TFormatSettings; +{$ENDIF RTL150_UP} + +//=== { TExprHashContext } =================================================== + +constructor TExprHashContext.Create(ACaseSensitive: Boolean; AHashSize: Integer); +begin + inherited Create; + if ACaseSensitive then + FHashMap := TStringHashMap.Create(CaseSensitiveTraits, AHashSize) + else + FHashMap := TStringHashMap.Create(CaseInsensitiveTraits, AHashSize); +end; + +destructor TExprHashContext.Destroy; +begin + FHashMap.Iterate(nil, Iterate_FreeObjects); + FHashMap.Free; + inherited Destroy; +end; + +procedure TExprHashContext.Add(ASymbol: TExprSym); +begin + FHashMap.Add(ASymbol.Ident, ASymbol); +end; + +procedure TExprHashContext.Remove(const AName: string); +begin + TObject(FHashMap.Remove(AName)).Free; +end; + +function TExprHashContext.Find(const AName: string): TExprSym; +begin + Result := nil; + if not FHashMap.Find(AName, Result) then + Result := nil; +end; + +//=== { TExprSetContext } ==================================================== + +constructor TExprSetContext.Create(AOwnsContexts: Boolean); +begin + inherited Create; + FOwnsContexts := AOwnsContexts; + FList := TList.Create; +end; + +destructor TExprSetContext.Destroy; +begin + if FOwnsContexts then + ClearObjectList(FList); + FList.Free; + inherited Destroy; +end; + +procedure TExprSetContext.Add(AContext: TExprContext); +begin + FList.Add(AContext); +end; + +procedure TExprSetContext.Delete(AIndex: Integer); +begin + if FOwnsContexts then + TObject(FList[AIndex]).Free; + FList.Delete(AIndex); +end; + +function TExprSetContext.Extract(AContext: TExprContext): TExprContext; +begin + Result := AContext; + FList.Remove(AContext); +end; + +function TExprSetContext.Find(const AName: string): TExprSym; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + begin + Result := Contexts[I].Find(AName); + if Result <> nil then + Break; + end; +end; + +function TExprSetContext.GetContexts(AIndex: Integer): TExprContext; +begin + Result := TExprContext(FList[AIndex]); +end; + +function TExprSetContext.GetCount: Integer; +begin + Result := FList.Count; +end; + +procedure TExprSetContext.Remove(AContext: TExprContext); +begin + FList.Remove(AContext); + if FOwnsContexts then + AContext.Free; +end; + +//=== { TExprSym } =========================================================== + +constructor TExprSym.Create(const AIdent: string); +begin + inherited Create; + FIdent := AIdent; +end; + +//=== { TExprLexer } ========================================================= + +constructor TExprLexer.Create; +begin + inherited Create; + Reset; +end; + +procedure TExprLexer.Reset; +begin + NextTok; +end; + +//=== { TExprCompileParser } ================================================= + +constructor TExprCompileParser.Create(ALexer: TExprLexer; ANodeFactory: TExprNodeFactory); +begin + inherited Create; + FLexer := ALexer; + FNodeFactory := ANodeFactory; +end; + +function TExprCompileParser.Compile: TExprNode; +begin + Result := CompileExprLevel0(False); +end; + +function TExprCompileParser.CompileExprLevel0(ASkip: Boolean): TExprNode; +begin + Result := CompileExprLevel1(ASkip); + + { Utilize some of these compound instructions to test DAG optimization + techniques later on. + + Playing a few games after much hard work, too. + Functional programming is fun! :-> BJK } + while True do + case Lexer.CurrTok of + etEqualTo: // = + Result := NodeFactory.CompareEqual(Result, CompileExprLevel1(True)); + etNotEqual: // <> + Result := NodeFactory.CompareNotEqual(Result, CompileExprLevel1(True)); + etLessThan: // < + Result := NodeFactory.CompareLess(Result, CompileExprLevel1(True)); + etLessEqual: // <= + Result := NodeFactory.CompareLessEqual(Result, CompileExprLevel1(True)); + etGreaterThan: // > + Result := NodeFactory.CompareGreater(Result, CompileExprLevel1(True)); + etGreaterEqual: // >= + Result := NodeFactory.CompareGreaterEqual(Result, CompileExprLevel1(True)); + etIdentifier: // cmp + if AnsiSameText(Lexer.TokenAsString, 'cmp') then + Result := NodeFactory.Compare(Result, CompileExprLevel1(True)) + else + Break; + else + Break; + end; +end; + +function TExprCompileParser.CompileExprLevel1(ASkip: Boolean): TExprNode; +begin + Result := CompileExprLevel2(ASkip); + + while True do + case Lexer.CurrTok of + etPlus: + Result := NodeFactory.Add(Result, CompileExprLevel2(True)); + etMinus: + Result := NodeFactory.Subtract(Result, CompileExprLevel2(True)); + etIdentifier: // or, xor, bor, bxor + if AnsiSameText(Lexer.TokenAsString, 'or') then + Result := NodeFactory.LogicalOr(Result, CompileExprLevel2(True)) + else + if AnsiSameText(Lexer.TokenAsString, 'xor') then + Result := NodeFactory.LogicalXor(Result, CompileExprLevel2(True)) + else + if AnsiSameText(Lexer.TokenAsString, 'bor') then + Result := NodeFactory.BitwiseOr(Result, CompileExprLevel2(True)) + else + if AnsiSameText(Lexer.TokenAsString, 'bxor') then + Result := NodeFactory.BitwiseXor(Result, CompileExprLevel2(True)) + else + Break; + else + Break; + end; +end; + +function TExprCompileParser.CompileExprLevel2(ASkip: Boolean): TExprNode; +begin + Result := CompileExprLevel3(ASkip); + + while True do + case Lexer.CurrTok of + etAsterisk: + Result := NodeFactory.Multiply(Result, CompileExprLevel3(True)); + etForwardSlash: + Result := NodeFactory.Divide(Result, CompileExprLevel3(True)); + etIdentifier: // div, mod, and, shl, shr, band + if AnsiSameText(Lexer.TokenAsString, 'div') then + Result := NodeFactory.IntegerDivide(Result, CompileExprLevel3(True)) + else + if AnsiSameText(Lexer.TokenAsString, 'mod') then + Result := NodeFactory.Modulo(Result, CompileExprLevel3(True)) + else + if AnsiSameText(Lexer.TokenAsString, 'and') then + Result := NodeFactory.LogicalAnd(Result, CompileExprLevel3(True)) + else + if AnsiSameText(Lexer.TokenAsString, 'shl') then + Result := NodeFactory.ShiftLeft(Result, CompileExprLevel3(True)) + else + if AnsiSameText(Lexer.TokenAsString, 'shr') then + Result := NodeFactory.ShiftRight(Result, CompileExprLevel3(True)) + else + if AnsiSameText(Lexer.TokenAsString, 'band') then + Result := NodeFactory.BitwiseAnd(Result, CompileExprLevel3(True)) + else + Break; + else + Break; + end; +end; + +function TExprCompileParser.CompileExprLevel3(ASkip: Boolean): TExprNode; +begin + Result := CompileExprLevel4(ASkip); + + while True do + case Lexer.CurrTok of + etArrow: + Result := NodeFactory.Power(Result, CompileExprLevel4(True)); + else + Break; + end; +end; + +function TExprCompileParser.CompileExprLevel4(ASkip: Boolean): TExprNode; +begin + if ASkip then + Lexer.NextTok; + + case Lexer.CurrTok of + etPlus: + Result := CompileExprLevel4(True); + etMinus: + Result := NodeFactory.Negate(CompileExprLevel4(True)); + etIdentifier: // not, bnot + if AnsiSameText(Lexer.TokenAsString, 'not') then + Result := NodeFactory.LogicalNot(CompileExprLevel4(True)) + else + if AnsiSameText(Lexer.TokenAsString, 'bnot') then + Result := NodeFactory.BitwiseNot(CompileExprLevel4(True)) + else + Result := CompileFactor; + else + Result := CompileFactor; + end; +end; + +function TExprCompileParser.CompileFactor: TExprNode; +var + Number: TFloat; +begin + case Lexer.CurrTok of + etIdentifier: + Result := CompileIdentFactor; + etLParen: + begin + Result := CompileExprLevel0(True); + if Lexer.CurrTok <> etRParen then + raise EJclExprEvalError.CreateRes(@RsExprEvalRParenExpected); + Lexer.NextTok; + end; + etNumber: + begin + Number := Lexer.TokenAsNumber; + Lexer.NextTok; + while Lexer.CurrTok = etPercent do + begin + Number := Number / 100; + Lexer.NextTok; + end; + Result := NodeFactory.LoadConst(Number); + end; + else + raise EJclExprEvalError.CreateRes(@RsExprEvalFactorExpected); + end; +end; + +function TExprCompileParser.CompileIdentFactor: TExprNode; +var + Sym: TExprSym; + oldCompileParser: TExprCompileParser; + oldLexer: TExprLexer; + oldNodeFactory: TExprNodeFactory; +begin + { find symbol } + if FContext = nil then + raise EJclExprEvalError.CreateResFmt(@RsExprEvalUnknownSymbol, + [Lexer.TokenAsString]); + Sym := FContext.Find(Lexer.TokenAsString); + if Sym = nil then + raise EJclExprEvalError.CreateResFmt(@RsExprEvalUnknownSymbol, + [Lexer.TokenAsString]); + + Lexer.NextTok; + + { set symbol properties } + oldCompileParser := Sym.CompileParser; + oldLexer := Sym.Lexer; + oldNodeFactory := Sym.NodeFactory; + Sym.FLexer := Lexer; + Sym.FCompileParser := Self; + Sym.FNodeFactory := NodeFactory; + try + { compile symbol } + Result := Sym.Compile; + finally + Sym.FLexer := oldLexer; + Sym.FCompileParser := oldCompileParser; + Sym.FNodeFactory := oldNodeFactory; + end; +end; + +//=== { TExprEvalParser } ==================================================== + +constructor TExprEvalParser.Create(ALexer: TExprLexer); +begin + inherited Create; + FLexer := ALexer; +end; + +function TExprEvalParser.Evaluate: TFloat; +begin + Result := EvalExprLevel0(False); + + if (Lexer.CurrTok <> etEof) then + begin + raise EJclExprEvalError.CreateResFmt(@RsExprEvalUnknownSymbol, + [Lexer.TokenAsString]); + end; +end; + +function TExprEvalParser.EvalExprLevel0(ASkip: Boolean): TFloat; +var + RightValue: TFloat; +begin + Result := EvalExprLevel1(ASkip); + + while True do + case Lexer.CurrTok of + etEqualTo: // = + if Result = EvalExprLevel1(True) then + Result := 1.0 + else + Result := 0.0; + etNotEqual: // <> + if Result <> EvalExprLevel1(True) then + Result := 1.0 + else + Result := 0.0; + etLessThan: // < + if Result < EvalExprLevel1(True) then + Result := 1.0 + else + Result := 0.0; + etLessEqual: // <= + if Result <= EvalExprLevel1(True) then + Result := 1.0 + else + Result := 0.0; + etGreaterThan: // > + if Result > EvalExprLevel1(True) then + Result := 1.0 + else + Result := 0.0; + etGreaterEqual: // >= + if Result >= EvalExprLevel1(True) then + Result := 1.0 + else + Result := 0.0; + etIdentifier: // cmp + if AnsiSameText(Lexer.TokenAsString, 'cmp') then + begin + RightValue := EvalExprLevel1(True); + if Result > RightValue then + Result := 1.0 + else + if Result = RightValue then + Result := 0.0 + else + Result := -1.0; + end + else + Break; + else + Break; + end; +end; + +function TExprEvalParser.EvalExprLevel1(ASkip: Boolean): TFloat; +begin + Result := EvalExprLevel2(ASkip); + + while True do + case Lexer.CurrTok of + etPlus: + Result := Result + EvalExprLevel2(True); + etMinus: + Result := Result - EvalExprLevel2(True); + etIdentifier: // or, xor, bor, bxor + if AnsiSameText(Lexer.TokenAsString, 'or') then + begin + if (EvalExprLevel2(True) <> 0) or (Result <> 0) then // prevent boolean optimizations, EvalTerm must be called + Result := 1.0 + else + Result := 0.0; + end + else + if AnsiSameText(Lexer.TokenAsString, 'xor') then + begin + if (Result <> 0) xor (EvalExprLevel2(True) <> 0) then + Result := 1.0 + else + result := 0.0; + end + else + if AnsiSameText(Lexer.TokenAsString, 'bor') then + Result := Round(Result) or Round(EvalExprLevel2(True)) + else + if AnsiSameText(Lexer.TokenAsString, 'bxor') then + Result := Round(Result) xor Round(EvalExprLevel2(True)) + else + Break; + else + Break; + end; +end; + +function TExprEvalParser.EvalExprLevel2(ASkip: Boolean): TFloat; +begin + Result := EvalExprLevel3(ASkip); + + while True do + case Lexer.CurrTok of + etAsterisk: + Result := Result * EvalExprLevel3(True); + etForwardSlash: + Result := Result / EvalExprLevel3(True); + etIdentifier: // div, mod, and, shl, shr, band + if AnsiSameText(Lexer.TokenAsString, 'div') then + Result := Round(Result) div Round(EvalExprLevel3(True)) + else + if AnsiSameText(Lexer.TokenAsString, 'mod') then + Result := Round(Result) mod Round(EvalExprLevel3(True)) + else + if AnsiSameText(Lexer.TokenAsString, 'and') then + begin + if (EvalExprLevel3(True) <> 0) and (Result <> 0) then // prevent boolean optimizations, EvalTerm must be called + Result := 1.0 + else + Result := 0.0; + end + else + if AnsiSameText(Lexer.TokenAsString, 'shl') then + Result := Round(Result) shl Round(EvalExprLevel3(True)) + else + if AnsiSameText(Lexer.TokenAsString, 'shr') then + Result := Round(Result) shr Round(EvalExprLevel3(True)) + else + if AnsiSameText(Lexer.TokenAsString, 'band') then + Result := Round(Result) and Round(EvalExprLevel3(True)) + else + Break; + else + Break; + end; +end; + +function TExprEvalParser.EvalExprLevel3(ASkip: Boolean): TFloat; +begin + Result := EvalExprLevel4(ASkip); + + while True do + case Lexer.CurrTok of + etArrow: + Result := Power(Result, EvalExprLevel4(True)); + else + Break; + end; +end; + + +function TExprEvalParser.EvalExprLevel4(ASkip: Boolean): TFloat; +begin + if ASkip then + Lexer.NextTok; + + case Lexer.CurrTok of + etPlus: + Result := EvalExprLevel4(True); + etMinus: + Result := -EvalExprLevel4(True); + etIdentifier: // not, bnot + if AnsiSameText(Lexer.TokenAsString, 'not') then + begin + if EvalExprLevel4(True) <> 0.0 then + Result := 0.0 + else + Result := 1.0; + end + else + if AnsiSameText(Lexer.TokenAsString, 'bnot') then + Result := not Round(EvalExprLevel4(True)) + else + Result := EvalFactor; + else + Result := EvalFactor; + end; +end; + +function TExprEvalParser.EvalFactor: TFloat; +begin + case Lexer.CurrTok of + etIdentifier: + Result := EvalIdentFactor; + etLParen: + begin + Result := EvalExprLevel0(True); + if Lexer.CurrTok <> etRParen then + raise EJclExprEvalError.CreateRes(@RsExprEvalRParenExpected); + Lexer.NextTok; + end; + etNumber: + begin + Result := Lexer.TokenAsNumber; + Lexer.NextTok; + while Lexer.CurrTok = etPercent do + begin + Result := Result / 100; + Lexer.NextTok; + end; + end; + else + raise EJclExprEvalError.CreateRes(@RsExprEvalFactorExpected); + end; +end; + +function TExprEvalParser.EvalIdentFactor: TFloat; +var + Sym: TExprSym; + oldEvalParser: TExprEvalParser; + oldLexer: TExprLexer; +begin + { find symbol } + if Context = nil then + raise EJclExprEvalError.CreateResFmt(@RsExprEvalUnknownSymbol, + [Lexer.TokenAsString]); + Sym := FContext.Find(Lexer.TokenAsString); + if Sym = nil then + raise EJclExprEvalError.CreateResFmt(@RsExprEvalUnknownSymbol, + [Lexer.TokenAsString]); + + Lexer.NextTok; + + { set symbol properties } + oldEvalParser := Sym.FEvalParser; + oldLexer := Sym.Lexer; + Sym.FLexer := Lexer; + Sym.FEvalParser := Self; + try + { evaluate symbol } + Result := Sym.Evaluate; + finally + Sym.FLexer := oldLexer; + Sym.FEvalParser := oldEvalParser; + end; +end; + +//=== { TExprSimpleLexer } =================================================== + +constructor TExprSimpleLexer.Create(const ABuf: string); +begin + FBuf := ABuf; + inherited Create; +end; + +procedure TExprSimpleLexer.NextTok; +const + CharToTokenMap: array [AnsiChar] of TExprToken = + ( + {#0..#31} + etInvalid, etInvalid, etInvalid, etInvalid, etInvalid, etInvalid, etInvalid, etInvalid, + etInvalid, etInvalid, etInvalid, etInvalid, etInvalid, etInvalid, etInvalid, etInvalid, + etInvalid, etInvalid, etInvalid, etInvalid, etInvalid, etInvalid, etInvalid, etInvalid, + etInvalid, etInvalid, etInvalid, etInvalid, etInvalid, etInvalid, etInvalid, etInvalid, + {#32} etInvalid, + {#33} etBang, {#34} etDoubleQuote, {#35} etHash, {#36} etDollar, + {#37} etPercent, {#38} etAmpersand, {#39} etSingleQuote, {#40} etLParen, + {#41} etRParen, {#42} etAsterisk, {#43} etPlus, {#44} etComma, + {#45} etMinus, {#46} etDot, {#47} etForwardSlash, + // 48..57 - numbers... + etInvalid, etInvalid, etInvalid, etInvalid, + etInvalid, etInvalid, etInvalid, etInvalid, + etInvalid, etInvalid, + {#58} etColon, {#59} etSemiColon, {#60} etLessThan, {#61} etEqualTo, + {#62} etGreaterThan, {#63} etQuestion, {#64} etAt, + // 65..90 - capital letters... + etInvalid, etInvalid, etInvalid, etInvalid, + etInvalid, etInvalid, etInvalid, etInvalid, + etInvalid, etInvalid, etInvalid, etInvalid, + etInvalid, etInvalid, etInvalid, etInvalid, + etInvalid, etInvalid, etInvalid, etInvalid, + etInvalid, etInvalid, etInvalid, etInvalid, + etInvalid, etInvalid, + {#91} etLBracket, {#92} etBackSlash, {#93} etRBracket, {#94} etArrow, + etInvalid, // 95 - underscore + {#96} etBackTick, + // 97..122 - small letters... + etInvalid, etInvalid, etInvalid, etInvalid, + etInvalid, etInvalid, etInvalid, etInvalid, + etInvalid, etInvalid, etInvalid, etInvalid, + etInvalid, etInvalid, etInvalid, etInvalid, + etInvalid, etInvalid, etInvalid, etInvalid, + etInvalid, etInvalid, etInvalid, etInvalid, + etInvalid, etInvalid, + {#123} etLBrace, + {#124} etPipe, {#125} etRBrace, {#126} etTilde, {#127} et127, + {#128} etEuro, {#129} et129, {#130} et130, {#131} et131, + {#132} et132, {#133} et133, {#134} et134, {#135} et135, + {#136} et136, {#137} et137, {#138} et138, {#139} et139, + {#140} et140, {#141} et141, {#142} et142, {#143} et143, + {#144} et144, {#145} et145, {#146} et146, {#147} et147, + {#148} et148, {#149} et149, {#150} et150, {#151} et151, + {#152} et152, {#153} et153, {#154} et154, {#155} et155, + {#156} et156, {#157} et157, {#158} et158, {#159} et159, + {#160} et160, {#161} et161, {#162} et162, {#163} et163, + {#164} et164, {#165} et165, {#166} et166, {#167} et167, + {#168} et168, {#169} et169, {#170} et170, {#171} et171, + {#172} et172, {#173} et173, {#174} et174, {#175} et175, + {#176} et176, {#177} et177, {#178} et178, {#179} et179, + {#180} et180, {#181} et181, {#182} et182, {#183} et183, + {#184} et184, {#185} et185, {#186} et186, {#187} et187, + {#188} et188, {#189} et189, {#190} et190, {#191} et191, + {#192} et192, {#193} et193, {#194} et194, {#195} et195, + {#196} et196, {#197} et197, {#198} et198, {#199} et199, + {#200} et200, {#201} et201, {#202} et202, {#203} et203, + {#204} et204, {#205} et205, {#206} et206, {#207} et207, + {#208} et208, {#209} et209, {#210} et210, {#211} et211, + {#212} et212, {#213} et213, {#214} et214, {#215} et215, + {#216} et216, {#217} et217, {#218} et218, {#219} et219, + {#220} et220, {#221} et221, {#222} et222, {#223} et223, + {#224} et224, {#225} et225, {#226} et226, {#227} et227, + {#228} et228, {#229} et229, {#230} et230, {#231} et231, + {#232} et232, {#233} et233, {#234} et234, {#235} et235, + {#236} et236, {#237} et237, {#238} et238, {#239} et239, + {#240} et240, {#241} et241, {#242} et242, {#243} et243, + {#244} et244, {#245} et245, {#246} et246, {#247} et247, + {#248} et248, {#249} et249, {#250} et250, {#251} et251, + {#252} et252, {#253} et253, {#254} et254, {#255} et255 + ); +var + { register variable optimization } + cp: PChar; + start: PChar; + {$IFNDEF RTL150_UP} + OldSep: Char; + {$ENDIF !RTL150_UP} +begin + cp := FCurrPos; + + { skip whitespace } + while CharIsWhiteSpace(cp^) do + Inc(cp); + + { determine token type } + case cp^ of + #0: + FCurrTok := etEof; + 'a'..'z', 'A'..'Z', '_': + begin + start := cp; + Inc(cp); + while CharIsValidIdentifierLetter(cp^) do + Inc(cp); + SetString(FTokenAsString, start, cp - start); + FCurrTok := etIdentifier; + end; + '0'..'9': + begin + start := cp; + + { read in integer part of mantissa } + while CharIsDigit(cp^) do + Inc(cp); + + { check for and read in fraction part of mantissa } + if cp^ = '.' then + begin + Inc(cp); + while CharIsDigit(cp^) do + Inc(cp); + end; + + { check for and read in exponent } + if (cp^ = 'e') or (cp^ = 'E') then + begin + Inc(cp); + if (cp^ = '+') or (cp^ = '-') then + Inc(cp); + while CharIsDigit(cp^) do + Inc(cp); + end; + + { evaluate number } + SetString(FTokenAsString, start, cp - start); + {$IFNDEF RTL150_UP} + OldSep := DecimalSeparator; + try + DecimalSeparator := '.'; + {$ENDIF ~RTL150_UP} + + FTokenAsNumber := StrToFloat(FTokenAsString{$IFDEF RTL150_UP}, FFormatSettings{$ENDIF RTL150_UP}); + {$IFNDEF RTL150_UP} + finally + DecimalSeparator := OldSep; + end; + {$ENDIF ~RTL150_UP} + + FCurrTok := etNumber; + end; + '<': + begin + Inc(cp); + case cp^ of + '=': + begin + FCurrTok := etLessEqual; + Inc(cp); + end; + '>': + begin + FCurrTok := etNotEqual; + Inc(cp); + end; + else + FCurrTok := etLessThan; + end; + end; + '>': + begin + Inc(cp); + if cp^ = '=' then + begin + FCurrTok := etGreaterEqual; + Inc(cp); + end + else + FCurrTok := etGreaterThan; + end; + else + { map character to token } + if Word(cp^) < 256 then + FCurrTok := CharToTokenMap[AnsiChar(cp^)] + else + FCurrTok := etInvalid; + Inc(cp); + end; + + FCurrPos := cp; +end; + +procedure TExprSimpleLexer.Reset; +begin + FCurrPos := PChar(FBuf); + inherited Reset; +end; + +procedure TExprSimpleLexer.SetBuf(const ABuf: string); +begin + FBuf := ABuf; + Reset; +end; + +//=== { TExprNode } ========================================================== + +constructor TExprNode.Create(const ADepList: array of TExprNode); +var + I: Integer; +begin + inherited Create; + FDepList := TList.Create; + for I := Low(ADepList) to High(ADepList) do + AddDep(ADepList[I]); +end; + +destructor TExprNode.Destroy; +begin + FDepList.Free; + inherited Destroy; +end; + +procedure TExprNode.AddDep(ADep: TExprNode); +begin + FDepList.Add(ADep); +end; + +function TExprNode.GetDepCount: Integer; +begin + Result := FDepList.Count; +end; + +function TExprNode.GetDeps(AIndex: Integer): TExprNode; +begin + Result := TExprNode(FDepList[AIndex]); +end; + +//=== { TExprNodeFactory } =================================================== + +function TExprNodeFactory.LoadVar(ALoc: PFloat32): TExprNode; +begin + Result := LoadVar32(ALoc); +end; + +function TExprNodeFactory.LoadVar(ALoc: PFloat64): TExprNode; +begin + Result := LoadVar64(ALoc); +end; + +{$IFDEF SUPPORTS_EXTENDED} +function TExprNodeFactory.LoadVar(ALoc: PFloat80): TExprNode; +begin + Result := LoadVar80(ALoc); +end; +{$ENDIF SUPPORTS_EXTENDED} + +function TExprNodeFactory.LoadConst(AValue: TFloat32): TExprNode; +begin + Result := LoadConst32(AValue); +end; + +function TExprNodeFactory.LoadConst(AValue: TFloat64): TExprNode; +begin + Result := LoadConst64(AValue); +end; + +{$IFDEF SUPPORTS_EXTENDED} +function TExprNodeFactory.LoadConst(AValue: TFloat80): TExprNode; +begin + Result := LoadConst80(AValue); +end; +{$ENDIF SUPPORTS_EXTENDED} + +//=== { TEvaluator } ========================================================= + +constructor TEvaluator.Create; +begin + inherited Create; + + FLexer := TExprSimpleLexer.Create(''); + FParser := TExprEvalParser.Create(FLexer); + + FParser.Context := InternalContextSet; +end; + +destructor TEvaluator.Destroy; +begin + FParser.Free; + FLexer.Free; + inherited Destroy; +end; + +function TEvaluator.Evaluate(const AExpr: string): TFloat; +begin + FLexer.Buf := AExpr; + Result := FParser.Evaluate; +end; + +//=== { TExprVirtMachOp } ==================================================== + +function TExprVirtMachOp.GetOutputLoc: PFloat; +begin + Result := @FOutput; +end; + +//=== Virtual machine operators follow ======================================= + +type + { abstract base for var readers } + TExprVarVmOp = class(TExprVirtMachOp) + private + FVarLoc: Pointer; + public + constructor Create(AVarLoc: Pointer); + end; + + { the var readers } + + TExprVar32VmOp = class(TExprVarVmOp) + public + procedure Execute; override; + end; + + TExprVar64VmOp = class(TExprVarVmOp) + public + procedure Execute; override; + end; + + {$IFDEF SUPPORTS_EXTENDED} + TExprVar80VmOp = class(TExprVarVmOp) + public + procedure Execute; override; + end; + {$ENDIF SUPPORTS_EXTENDED} + + { the const holder } + TExprConstVmOp = class(TExprVirtMachOp) + public + constructor Create(AValue: TFloat); + { null function } + procedure Execute; override; + end; + + { abstract unary operator } + TExprUnaryVmOp = class(TExprVirtMachOp) + protected + FInput: PFloat; + public + constructor Create(AInput: PFloat); + property Input: PFloat read FInput write FInput; + end; + + TExprUnaryVmOpClass = class of TExprUnaryVmOp; + + { abstract binary operator } + TExprBinaryVmOp = class(TExprVirtMachOp) + protected + FLeft: PFloat; + FRight: PFloat; + public + constructor Create(ALeft, ARight: PFloat); + property Left: PFloat read FLeft write FLeft; + property Right: PFloat read FRight write FRight; + end; + + TExprBinaryVmOpClass = class of TExprBinaryVmOp; + + { the 4 basic binary operators } + + TExprAddVmOp = class(TExprBinaryVmOp) + public + procedure Execute; override; + end; + + TExprSubtractVmOp = class(TExprBinaryVmOp) + public + procedure Execute; override; + end; + + TExprMultiplyVmOp = class(TExprBinaryVmOp) + public + procedure Execute; override; + end; + + TExprDivideVmOp = class(TExprBinaryVmOp) + public + procedure Execute; override; + end; + + TExprPowerVmOp = class(TExprBinaryVmOp) + public + procedure Execute; override; + end; + + TExprCompareVmOp = class(TExprBinaryVmOp) + public + procedure Execute; override; + end; + + TExprGreaterVmOp = class(TExprBinaryVmOp) + public + procedure Execute; override; + end; + + TExprGreaterEqualVmOp = class(TExprBinaryVmOp) + public + procedure Execute; override; + end; + + TExprLessVmOp = class(TExprBinaryVmOp) + public + procedure Execute; override; + end; + + TExprLessEqualVmOp = class(TExprBinaryVmOp) + public + procedure Execute; override; + end; + + TExprEqualVmOp = class(TExprBinaryVmOp) + public + procedure Execute; override; + end; + + TExprNotEqualVmOp = class(TExprBinaryVmOp) + public + procedure Execute; override; + end; + + TExprIntegerDivideVmOp = class(TExprBinaryVmOp) + public + procedure Execute; override; + end; + + TExprModuloVmOp = class(TExprBinaryVmOp) + public + procedure Execute; override; + end; + + TExprShiftLeftVmOp = class(TExprBinaryVmOp) + public + procedure Execute; override; + end; + + TExprShiftRightVmOp = class(TExprBinaryVmOp) + public + procedure Execute; override; + end; + + TExprBitwiseAndVmOp = class(TExprBinaryVmOp) + public + procedure Execute; override; + end; + + TExprBitwiseOrVmOp = class(TExprBinaryVmOp) + public + procedure Execute; override; + end; + + TExprBitwiseXorVmOp = class(TExprBinaryVmOp) + public + procedure Execute; override; + end; + + TExprLogicalAndVmOp = class(TExprBinaryVmOp) + public + procedure Execute; override; + end; + + TExprLogicalOrVmOp = class(TExprBinaryVmOp) + public + procedure Execute; override; + end; + + TExprLogicalXorVmOp = class(TExprBinaryVmOp) + public + procedure Execute; override; + end; + + { the unary operators } + + TExprNegateVmOp = class(TExprUnaryVmOp) + public + procedure Execute; override; + end; + + TExprLogicalNotVmOp = class(TExprUnaryVmOp) + public + procedure Execute; override; + end; + + TExprBitwiseNotVmOp = class(TExprUnaryVmOp) + public + procedure Execute; override; + end; + + { function calls } + + TExprCallFloatVmOp = class(TExprVirtMachOp) + private + FFunc: TFloatFunc; + public + constructor Create(AFunc: TFloatFunc); + procedure Execute; override; + end; + + TExprCallFloat32VmOp = class(TExprVirtMachOp) + private + FFunc: TFloat32Func; + public + constructor Create(AFunc: TFloat32Func); + procedure Execute; override; + end; + + TExprCallFloat64VmOp = class(TExprVirtMachOp) + private + FFunc: TFloat64Func; + public + constructor Create(AFunc: TFloat64Func); + procedure Execute; override; + end; + + {$IFDEF SUPPORTS_EXTENDED} + TExprCallFloat80VmOp = class(TExprVirtMachOp) + private + FFunc: TFloat80Func; + public + constructor Create(AFunc: TFloat80Func); + procedure Execute; override; + end; + {$ENDIF SUPPORTS_EXTENDED} + + TExprCallUnaryVmOp = class(TExprVirtMachOp) + private + FFunc: TUnaryFunc; + FX: PFloat; + public + constructor Create(AFunc: TUnaryFunc; X: PFloat); + procedure Execute; override; + end; + + TExprCallUnary32VmOp = class(TExprVirtMachOp) + private + FFunc: TUnary32Func; + FX: PFloat; + public + constructor Create(AFunc: TUnary32Func; X: PFloat); + procedure Execute; override; + end; + + TExprCallUnary64VmOp = class(TExprVirtMachOp) + private + FFunc: TUnary64Func; + FX: PFloat; + public + constructor Create(AFunc: TUnary64Func; X: PFloat); + procedure Execute; override; + end; + + {$IFDEF SUPPORTS_EXTENDED} + TExprCallUnary80VmOp = class(TExprVirtMachOp) + private + FFunc: TUnary80Func; + FX: PFloat; + public + constructor Create(AFunc: TUnary80Func; X: PFloat); + procedure Execute; override; + end; + {$ENDIF SUPPORTS_EXTENDED} + + TExprCallBinaryVmOp = class(TExprVirtMachOp) + private + FFunc: TBinaryFunc; + FX, FY: PFloat; + public + constructor Create(AFunc: TBinaryFunc; X, Y: PFloat); + procedure Execute; override; + end; + + TExprCallBinary32VmOp = class(TExprVirtMachOp) + private + FFunc: TBinary32Func; + FX, FY: PFloat; + public + constructor Create(AFunc: TBinary32Func; X, Y: PFloat); + procedure Execute; override; + end; + + TExprCallBinary64VmOp = class(TExprVirtMachOp) + private + FFunc: TBinary64Func; + FX, FY: PFloat; + public + constructor Create(AFunc: TBinary64Func; X, Y: PFloat); + procedure Execute; override; + end; + + {$IFDEF SUPPORTS_EXTENDED} + TExprCallBinary80VmOp = class(TExprVirtMachOp) + private + FFunc: TBinary80Func; + FX, FY: PFloat; + public + constructor Create(AFunc: TBinary80Func; X, Y: PFloat); + procedure Execute; override; + end; + {$ENDIF SUPPORTS_EXTENDED} + + TExprCallTernaryVmOp = class(TExprVirtMachOp) + private + FFunc: TTernaryFunc; + FX, FY, FZ: PFloat; + public + constructor Create(AFunc: TTernaryFunc; X, Y, Z: PFloat); + procedure Execute; override; + end; + + TExprCallTernary32VmOp = class(TExprVirtMachOp) + private + FFunc: TTernary32Func; + FX, FY, FZ: PFloat; + public + constructor Create(AFunc: TTernary32Func; X, Y, Z: PFloat); + procedure Execute; override; + end; + + TExprCallTernary64VmOp = class(TExprVirtMachOp) + private + FFunc: TTernary64Func; + FX, FY, FZ: PFloat; + public + constructor Create(AFunc: TTernary64Func; X, Y, Z: PFloat); + procedure Execute; override; + end; + + {$IFDEF SUPPORTS_EXTENDED} + TExprCallTernary80VmOp = class(TExprVirtMachOp) + private + FFunc: TTernary80Func; + FX, FY, FZ: PFloat; + public + constructor Create(AFunc: TTernary80Func; X, Y, Z: PFloat); + procedure Execute; override; + end; + {$ENDIF SUPPORTS_EXTENDED} + +//=== { TExprVar32VmOp } ===================================================== + +procedure TExprVar32VmOp.Execute; +begin + FOutput := PFloat32(FVarLoc)^; +end; + +//=== { TExprVar64VmOp } ===================================================== + +procedure TExprVar64VmOp.Execute; +begin + FOutput := PFloat64(FVarLoc)^; +end; + +{$IFDEF SUPPORTS_EXTENDED} + +//=== { TExprVar80VmOp } ===================================================== + +procedure TExprVar80VmOp.Execute; +begin + FOutput := PFloat80(FVarLoc)^; +end; + +{$ENDIF SUPPORTS_EXTENDED} + +//=== { TExprConstVmOp } ===================================================== + +constructor TExprConstVmOp.Create(AValue: TFloat); +begin + inherited Create; + FOutput := AValue; +end; + +procedure TExprConstVmOp.Execute; +begin +end; + +//=== { TExprUnaryVmOp } ===================================================== + +constructor TExprUnaryVmOp.Create(AInput: PFloat); +begin + inherited Create; + FInput := AInput; +end; + +//=== { TExprBinaryVmOp } ==================================================== + +constructor TExprBinaryVmOp.Create(ALeft, ARight: PFloat); +begin + inherited Create; + FLeft := ALeft; + FRight := ARight; +end; + +//=== { TExprAddVmOp } ======================================================= +procedure TExprAddVmOp.Execute; +begin + FOutput := FLeft^ + FRight^; +end; + +//=== { TExprSubtractVmOp } ================================================== + +procedure TExprSubtractVmOp.Execute; +begin + FOutput := FLeft^ - FRight^; +end; + +//=== { TExprMultiplyVmOp } ================================================== + +procedure TExprMultiplyVmOp.Execute; +begin + FOutput := FLeft^ * FRight^; +end; + +//=== { TExprDivideVmOp } ==================================================== + +procedure TExprDivideVmOp.Execute; +begin + FOutput := FLeft^ / FRight^; +end; + +//=== { TExprPowerVmOp } ==================================================== + +procedure TExprPowerVmOp.Execute; +begin + FOutput := Power(FLeft^ , FRight^); +end; + +//=== { TExprCompareVmOp } =================================================== + +procedure TExprCompareVmOp.Execute; +begin + if FLeft^ < FRight^ then + FOutput := -1.0 + else + if FLeft^ > FRight^ then + FOutput := 1.0 + else + FOutput := 0.0; +end; + +//=== { TExprCmpGreaterVmOp } ================================================ + +procedure TExprGreaterVmOp.Execute; +begin + if FLeft^ > FRight^ then + FOutput := 1.0 + else + FOutput := 0.0; +end; + +//=== { TExprCmpGreaterEqualVmOp } =========================================== + +procedure TExprGreaterEqualVmOp.Execute; +begin + if FLeft^ >= FRight^ then + FOutput := 1.0 + else + FOutput := 0.0; +end; + +//=== { TExprCmpLessVmOp } =================================================== + +procedure TExprLessVmOp.Execute; +begin + if FLeft^ < FRight^ then + FOutput := 1.0 + else + FOutput := 0.0; +end; + +// === { TExprCmpLessEqualVmOp } ============================================= + +procedure TExprLessEqualVmOp.Execute; +begin + if FLeft^ <= FRight^ then + FOutput := 1.0 + else + FOutput := 0.0; +end; + +//=== { TExprCmpEqualVmOp } ================================================== + +procedure TExprEqualVmOp.Execute; +begin + if FLeft^ = FRight^ then + FOutput := 1.0 + else + FOutput := 0.0; +end; + +//=== { TExprCmpNotEqualVmOp } =============================================== + +procedure TExprNotEqualVmOp.Execute; +begin + if FLeft^ <> FRight^ then + FOutput := 1.0 + else + FOutput := 0.0; +end; + +//=== { TExprDivVmOp } ======================================================= + +procedure TExprIntegerDivideVmOp.Execute; +begin + FOutput := Round(FLeft^) div Round(FRight^); +end; + +//=== { TExprModVmOp } ======================================================= + +procedure TExprModuloVmOp.Execute; +begin + FOutput := Round(FLeft^) mod Round(FRight^); +end; + +//=== { TExprShiftLeftVmOp } ================================================= + +procedure TExprShiftLeftVmOp.Execute; +begin + FOutput := Round(FLeft^) shl Round(FRight^); +end; + +//=== { TExprShiftRightVmOp } ================================================ + +procedure TExprShiftRightVmOp.Execute; +begin + FOutput := Round(FLeft^) shr Round(FRight^); +end; + +//=== { TExprBitwiseAndVmOp } ================================================ + +procedure TExprBitwiseAndVmOp.Execute; +begin + FOutput := Round(FLeft^) and Round(FRight^); +end; + +//=== { TExprOrVmOp } ======================================================== + +procedure TExprBitwiseOrVmOp.Execute; +begin + FOutput := Round(FLeft^) or Round(FRight^); +end; + +//=== { TExprXorVmOp } ======================================================= + +procedure TExprBitwiseXorVmOp.Execute; +begin + FOutput := Round(FLeft^) xor Round(FRight^); +end; + +//=== { TExprLogicalAndVmOp } ================================================ + +procedure TExprLogicalAndVmOp.Execute; +begin + if (FLeft^ <> 0.0) and (FRight^ <> 0) then + FOutput := 1.0 + else + FOutput := 0.0; +end; + +//=== { TExprLogicalOrVmOp } ================================================= + +procedure TExprLogicalOrVmOp.Execute; +begin + if (FLeft^ <> 0.0) or (FRight^ <> 0) then + FOutput := 1.0 + else + FOutput := 0.0; +end; + +//=== { TExprLogicalXorVmOp } ================================================ + +procedure TExprLogicalXorVmOp.Execute; +begin + if (FLeft^ <> 0.0) xor (FRight^ <> 0) then + FOutput := 1.0 + else + FOutput := 0.0; +end; + +//=== { TExprNegateVmOp } ==================================================== + +procedure TExprNegateVmOp.Execute; +begin + FOutput := - FInput^; +end; + +//=== { TExprLogicalNotVmOp } ================================================ + +procedure TExprLogicalNotVmOp.Execute; +begin + if FInput^ <> 0.0 then + FOutput := 0.0 + else + FOutput := 1.0; +end; + +//=== { TExprBitwiseNotVmOp } ================================================ + +procedure TExprBitwiseNotVmOp.Execute; +begin + FOutput := not Round(FInput^); +end; + +//=== { TExprVarVmOp } ======================================================= + +constructor TExprVarVmOp.Create(AVarLoc: Pointer); +begin + inherited Create; + FVarLoc := AVarLoc; +end; + +//=== { TExprCallFloatVmOp } ================================================= + +constructor TExprCallFloatVmOp.Create(AFunc: TFloatFunc); +begin + inherited Create; + FFunc := AFunc; +end; + +procedure TExprCallFloatVmOp.Execute; +begin + FOutput := FFunc; +end; + +//=== { TExprCallFloat32VmOp } =============================================== + +constructor TExprCallFloat32VmOp.Create(AFunc: TFloat32Func); +begin + inherited Create; + FFunc := AFunc; +end; + +procedure TExprCallFloat32VmOp.Execute; +begin + FOutput := FFunc; +end; + +//=== { TExprCallFloat64VmOp } =============================================== + +constructor TExprCallFloat64VmOp.Create(AFunc: TFloat64Func); +begin + inherited Create; + FFunc := AFunc; +end; + +procedure TExprCallFloat64VmOp.Execute; +begin + FOutput := FFunc; +end; + +{$IFDEF SUPPORTS_EXTENDED} + +//=== { TExprCallFloat80VmOp } =============================================== + +constructor TExprCallFloat80VmOp.Create(AFunc: TFloat80Func); +begin + inherited Create; + FFunc := AFunc; +end; + +procedure TExprCallFloat80VmOp.Execute; +begin + FOutput := FFunc; +end; + +{$ENDIF SUPPORTS_EXTENDED} + +//=== { TExprCallUnaryVmOp } ================================================= + +constructor TExprCallUnaryVmOp.Create(AFunc: TUnaryFunc; X: PFloat); +begin + inherited Create; + FFunc := AFunc; + FX := X; +end; + +procedure TExprCallUnaryVmOp.Execute; +begin + FOutput := FFunc(FX^); +end; + +//=== { TExprCallUnary32VmOp } =============================================== + +constructor TExprCallUnary32VmOp.Create(AFunc: TUnary32Func; X: PFloat); +begin + inherited Create; + FFunc := AFunc; + FX := X; +end; + +procedure TExprCallUnary32VmOp.Execute; +begin + FOutput := FFunc(FX^); +end; + +//=== { TExprCallUnary64VmOp } =============================================== + +constructor TExprCallUnary64VmOp.Create(AFunc: TUnary64Func; X: PFloat); +begin + inherited Create; + FFunc := AFunc; + FX := X; +end; + +procedure TExprCallUnary64VmOp.Execute; +begin + FOutput := FFunc(FX^); +end; + +{$IFDEF SUPPORTS_EXTENDED} + +//=== { TExprCallUnary80VmOp } =============================================== + +constructor TExprCallUnary80VmOp.Create(AFunc: TUnary80Func; X: PFloat); +begin + inherited Create; + FFunc := AFunc; + FX := X; +end; + +procedure TExprCallUnary80VmOp.Execute; +begin + FOutput := FFunc(FX^); +end; + +{$ENDIF SUPPORTS_EXTENDED} + +//=== { TExprCallBinaryVmOp } ================================================ + +constructor TExprCallBinaryVmOp.Create(AFunc: TBinaryFunc; X, Y: PFloat); +begin + inherited Create; + FFunc := AFunc; + FX := X; + FY := Y; +end; + +procedure TExprCallBinaryVmOp.Execute; +begin + FOutput := FFunc(FX^, FY^); +end; + +//=== { TExprCallBinary32VmOp } ============================================== + +constructor TExprCallBinary32VmOp.Create(AFunc: TBinary32Func; X, Y: PFloat); +begin + inherited Create; + FFunc := AFunc; + FX := X; + FY := Y; +end; + +procedure TExprCallBinary32VmOp.Execute; +begin + FOutput := FFunc(FX^, FY^); +end; + +//=== { TExprCallBinary64VmOp } ============================================== + +constructor TExprCallBinary64VmOp.Create(AFunc: TBinary64Func; X, Y: PFloat); +begin + inherited Create; + FFunc := AFunc; + FX := X; + FY := Y; +end; + +procedure TExprCallBinary64VmOp.Execute; +begin + FOutput := FFunc(FX^, FY^); +end; + +{$IFDEF SUPPORTS_EXTENDED} + +//=== { TExprCallBinary80VmOp } ============================================== + +constructor TExprCallBinary80VmOp.Create(AFunc: TBinary80Func; X, Y: PFloat); +begin + inherited Create; + FFunc := AFunc; + FX := X; + FY := Y; +end; + +procedure TExprCallBinary80VmOp.Execute; +begin + FOutput := FFunc(FX^, FY^); +end; + +{$ENDIF SUPPORTS_EXTENDED} + +//=== { TExprCallTernaryVmOp } =============================================== + +constructor TExprCallTernaryVmOp.Create(AFunc: TTernaryFunc; X, Y, Z: PFloat); +begin + inherited Create; + FFunc := AFunc; + FX := X; + FY := Y; + FZ := Z; +end; + +procedure TExprCallTernaryVmOp.Execute; +begin + FOutput := FFunc(FX^, FY^, FZ^); +end; + +//=== { TExprCallTernary32VmOp } ============================================= + +constructor TExprCallTernary32VmOp.Create(AFunc: TTernary32Func; X, Y, Z: PFloat); +begin + inherited Create; + FFunc := AFunc; + FX := X; + FY := Y; + FZ := Z; +end; + +procedure TExprCallTernary32VmOp.Execute; +begin + FOutput := FFunc(FX^, FY^, FZ^); +end; + +//=== { TExprCallTernary64VmOp } ============================================= + +constructor TExprCallTernary64VmOp.Create(AFunc: TTernary64Func; X, Y, Z: PFloat); +begin + inherited Create; + FFunc := AFunc; + FX := X; + FY := Y; + FZ := Z; +end; + +procedure TExprCallTernary64VmOp.Execute; +begin + FOutput := FFunc(FX^, FY^, FZ^); +end; + +{$IFDEF SUPPORTS_EXTENDED} + +//=== { TExprCallTernary80VmOp } ============================================= + +constructor TExprCallTernary80VmOp.Create(AFunc: TTernary80Func; X, Y, Z: PFloat); +begin + inherited Create; + FFunc := AFunc; + FX := X; + FY := Y; + FZ := Z; +end; + +procedure TExprCallTernary80VmOp.Execute; +begin + FOutput := FFunc(FX^, FY^, FZ^); +end; + +{$ENDIF SUPPORTS_EXTENDED} + +{ End of virtual machine operators } + +//=== { TExprVirtMach } ====================================================== + +constructor TExprVirtMach.Create; +begin + inherited Create; + FCodeList := TList.Create; + FConstList := TList.Create; +end; + +destructor TExprVirtMach.Destroy; +begin + FreeObjectList(FCodeList); + FreeObjectList(FConstList); + inherited Destroy; +end; + +function TExprVirtMach.Execute: TFloat; +type + PExprVirtMachOp = ^TExprVirtMachOp; +var + I: Integer; + pop: PExprVirtMachOp; +begin + if FCodeList.Count <> 0 then + begin + { The code that follows is the same as this, but a lot faster + for I := 0 to FCodeList.Count - 1 do + TExprVirtMachOp(FCodeList[I]).Execute; } + I := FCodeList.Count; + pop := @FCodeList.List{$IFNDEF RTL230_UP}^{$ENDIF !RTL230_UP}[0]; + while I > 0 do + begin + pop^.Execute; + Inc(pop); + Dec(I); + end; + Result := TExprVirtMachOp(FCodeList[FCodeList.Count - 1]).FOutput; + end + else + begin + if (FConstList.Count = 1) then + Result := TExprVirtMachOp(FConstList[0]).FOutput + else + Result := 0; + end; +end; + +procedure TExprVirtMach.Add(AOp: TExprVirtMachOp); +begin + FCodeList.Add(AOp); +end; + +procedure TExprVirtMach.AddConst(AOp: TExprVirtMachOp); +begin + FConstList.Add(AOp); +end; + +procedure TExprVirtMach.Clear; +begin + ClearObjectList(FCodeList); + ClearObjectList(FConstList); +end; + +//=== { TExprVirtMachNode } ================================================== + +type + TExprVirtMachNode = class(TExprNode) + private + FExprVmCode: TExprVirtMachOp; + function GetVmDeps(AIndex: Integer): TExprVirtMachNode; + public + procedure GenCode(AVirtMach: TExprVirtMach); virtual; abstract; + + property ExprVmCode: TExprVirtMachOp read FExprVmCode; + + { this property saves typecasting to access ExprVmCode } + property VmDeps[AIndex: Integer]: TExprVirtMachNode read GetVmDeps; default; + end; + +function TExprVirtMachNode.GetVmDeps(AIndex: Integer): TExprVirtMachNode; +begin + Result := TExprVirtMachNode(FDepList[AIndex]); +end; + +//=== Concrete expression nodes for virtual machine ========================== + +type + TExprUnaryVmNode = class(TExprVirtMachNode) + private + FUnaryClass: TExprUnaryVmOpClass; + public + constructor Create(AUnaryClass: TExprUnaryVmOpClass; + const ADeps: array of TExprNode); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + + TExprBinaryVmNode = class(TExprVirtMachNode) + private + FBinaryClass: TExprBinaryVmOpClass; + public + constructor Create(ABinaryClass: TExprBinaryVmOpClass; + const ADeps: array of TExprNode); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + + TExprConstVmNode = class(TExprVirtMachNode) + private + FValue: TFloat; + public + constructor Create(AValue: TFloat); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + + TExprVar32VmNode = class(TExprVirtMachNode) + private + FValue: PFloat32; + public + constructor Create(AValue: PFloat32); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + + TExprVar64VmNode = class(TExprVirtMachNode) + private + FValue: PFloat64; + public + constructor Create(AValue: PFloat64); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + + {$IFDEF SUPPORTS_EXTENDED} + TExprVar80VmNode = class(TExprVirtMachNode) + private + FValue: PFloat80; + public + constructor Create(AValue: PFloat80); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + {$ENDIF SUPPORTS_EXTENDED} + + TExprCallFloatVmNode = class(TExprVirtMachNode) + private + FFunc: TFloatFunc; + public + constructor Create(AFunc: TFloatFunc); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + + TExprCallFloat32VmNode = class(TExprVirtMachNode) + private + FFunc: TFloat32Func; + public + constructor Create(AFunc: TFloat32Func); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + + TExprCallFloat64VmNode = class(TExprVirtMachNode) + private + FFunc: TFloat64Func; + public + constructor Create(AFunc: TFloat64Func); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + + {$IFDEF SUPPORTS_EXTENDED} + TExprCallFloat80VmNode = class(TExprVirtMachNode) + private + FFunc: TFloat80Func; + public + constructor Create(AFunc: TFloat80Func); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + {$ENDIF SUPPORTS_EXTENDED} + + TExprCallUnaryVmNode = class(TExprVirtMachNode) + private + FFunc: TUnaryFunc; + public + constructor Create(AFunc: TUnaryFunc; X: TExprNode); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + + TExprCallUnary32VmNode = class(TExprVirtMachNode) + private + FFunc: TUnary32Func; + public + constructor Create(AFunc: TUnary32Func; X: TExprNode); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + + TExprCallUnary64VmNode = class(TExprVirtMachNode) + private + FFunc: TUnary64Func; + public + constructor Create(AFunc: TUnary64Func; X: TExprNode); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + + {$IFDEF SUPPORTS_EXTENDED} + TExprCallUnary80VmNode = class(TExprVirtMachNode) + private + FFunc: TUnary80Func; + public + constructor Create(AFunc: TUnary80Func; X: TExprNode); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + {$ENDIF SUPPORTS_EXTENDED} + + TExprCallBinaryVmNode = class(TExprVirtMachNode) + private + FFunc: TBinaryFunc; + public + constructor Create(AFunc: TBinaryFunc; X, Y: TExprNode); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + + TExprCallBinary32VmNode = class(TExprVirtMachNode) + private + FFunc: TBinary32Func; + public + constructor Create(AFunc: TBinary32Func; X, Y: TExprNode); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + + TExprCallBinary64VmNode = class(TExprVirtMachNode) + private + FFunc: TBinary64Func; + public + constructor Create(AFunc: TBinary64Func; X, Y: TExprNode); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + + {$IFDEF SUPPORTS_EXTENDED} + TExprCallBinary80VmNode = class(TExprVirtMachNode) + private + FFunc: TBinary80Func; + public + constructor Create(AFunc: TBinary80Func; X, Y: TExprNode); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + {$ENDIF SUPPORTS_EXTENDED} + + TExprCallTernaryVmNode = class(TExprVirtMachNode) + private + FFunc: TTernaryFunc; + public + constructor Create(AFunc: TTernaryFunc; X, Y, Z: TExprNode); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + + TExprCallTernary32VmNode = class(TExprVirtMachNode) + private + FFunc: TTernary32Func; + public + constructor Create(AFunc: TTernary32Func; X, Y, Z: TExprNode); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + + TExprCallTernary64VmNode = class(TExprVirtMachNode) + private + FFunc: TTernary64Func; + public + constructor Create(AFunc: TTernary64Func; X, Y, Z: TExprNode); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + + {$IFDEF SUPPORTS_EXTENDED} + TExprCallTernary80VmNode = class(TExprVirtMachNode) + private + FFunc: TTernary80Func; + public + constructor Create(AFunc: TTernary80Func; X, Y, Z: TExprNode); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + {$ENDIF SUPPORTS_EXTENDED} + +//== { TExprUnaryVmNode } ==================================================== + +constructor TExprUnaryVmNode.Create(AUnaryClass: TExprUnaryVmOpClass; const ADeps: array of TExprNode); +begin + FUnaryClass := AUnaryClass; + inherited Create(ADeps); + Assert(FDepList.Count = 1); +end; + +procedure TExprUnaryVmNode.GenCode(AVirtMach: TExprVirtMach); +begin + FExprVmCode := FUnaryClass.Create(VmDeps[0].ExprVmCode.OutputLoc); + AVirtMach.Add(FExprVmCode); +end; + +//=== { TExprBinaryVmNode } ================================================== + +constructor TExprBinaryVmNode.Create(ABinaryClass: TExprBinaryVmOpClass; const ADeps: array of TExprNode); +begin + FBinaryClass := ABinaryClass; + inherited Create(ADeps); + Assert(FDepList.Count = 2); +end; + +procedure TExprBinaryVmNode.GenCode(AVirtMach: TExprVirtMach); +begin + FExprVmCode := FBinaryClass.Create( + VmDeps[0].ExprVmCode.OutputLoc, + VmDeps[1].ExprVmCode.OutputLoc); + AVirtMach.Add(FExprVmCode); +end; + +//=== { TExprConstVmNode } ================================================== + +constructor TExprConstVmNode.Create(AValue: TFloat); +begin + FValue := AValue; + inherited Create([]); +end; + +procedure TExprConstVmNode.GenCode(AVirtMach: TExprVirtMach); +begin + FExprVmCode := TExprConstVmOp.Create(FValue); + AVirtMach.AddConst(FExprVmCode); +end; + +//=== { TExprVar32VmNode } =================================================== + +constructor TExprVar32VmNode.Create(AValue: PFloat32); +begin + FValue := AValue; + inherited Create([]); +end; + +procedure TExprVar32VmNode.GenCode(AVirtMach: TExprVirtMach); +begin + FExprVmCode := TExprVar32VmOp.Create(FValue); + AVirtMach.Add(FExprVmCode); +end; + +//=== { TExprVar64VmNode } =================================================== + +constructor TExprVar64VmNode.Create(AValue: PFloat64); +begin + FValue := AValue; + inherited Create([]); +end; + +procedure TExprVar64VmNode.GenCode(AVirtMach: TExprVirtMach); +begin + FExprVmCode := TExprVar64VmOp.Create(FValue); + AVirtMach.Add(FExprVmCode); +end; + +{$IFDEF SUPPORTS_EXTENDED} + +//=== { TExprVar80VmNode } =================================================== + +constructor TExprVar80VmNode.Create(AValue: PFloat80); +begin + FValue := AValue; + inherited Create([]); +end; + +procedure TExprVar80VmNode.GenCode(AVirtMach: TExprVirtMach); +begin + FExprVmCode := TExprVar80VmOp.Create(FValue); + AVirtMach.Add(FExprVmCode); +end; + +{$ENDIF SUPPORTS_EXTENDED} + +{ End of expression nodes for virtual machine } + +//=== { TExprVirtMachNodeFactory } =========================================== + +constructor TExprVirtMachNodeFactory.Create; +begin + inherited Create; + FNodeList := TList.Create; +end; + +destructor TExprVirtMachNodeFactory.Destroy; +begin + FreeObjectList(FNodeList); + inherited Destroy; +end; + +function TExprVirtMachNodeFactory.AddNode(ANode: TExprNode): TExprNode; +begin + Result := ANode; + FNodeList.Add(ANode); +end; + +procedure TExprVirtMachNodeFactory.GenCode(AVirtMach: TExprVirtMach); +begin + { TODO : optimize the expression tree into a DAG (i.e. find CSEs) and + evaluate constant subexpressions, implement strength reduction, etc. } + + { TODO : move optimization logic (as far as possible) into ancestor classes + once tested and interfaces are solid, so that other evaluation strategies + can take advantage of these optimizations. } + + DoClean(AVirtMach); + DoConsts(AVirtMach); + DoCode(AVirtMach); +end; + +function TExprVirtMachNodeFactory.LoadVar32(ALoc: PFloat32): TExprNode; +begin + Result := AddNode(TExprVar32VmNode.Create(ALoc)); +end; + +function TExprVirtMachNodeFactory.LoadVar64(ALoc: PFloat64): TExprNode; +begin + Result := AddNode(TExprVar64VmNode.Create(ALoc)); +end; + +{$IFDEF SUPPORTS_EXTENDED} +function TExprVirtMachNodeFactory.LoadVar80(ALoc: PFloat80): TExprNode; +begin + Result := AddNode(TExprVar80VmNode.Create(ALoc)); +end; +{$ENDIF SUPPORTS_EXTENDED} + +function TExprVirtMachNodeFactory.LoadConst32(AValue: TFloat32): TExprNode; +begin + Result := AddNode(TExprConstVmNode.Create(AValue)); +end; + +function TExprVirtMachNodeFactory.LoadConst64(AValue: TFloat64): TExprNode; +begin + Result := AddNode(TExprConstVmNode.Create(AValue)); +end; + +{$IFDEF SUPPORTS_EXTENDED} +function TExprVirtMachNodeFactory.LoadConst80(AValue: TFloat80): TExprNode; +begin + Result := AddNode(TExprConstVmNode.Create(AValue)); +end; +{$ENDIF SUPPORTS_EXTENDED} + +function TExprVirtMachNodeFactory.Add(ALeft, ARight: TExprNode): TExprNode; +begin + Result := AddNode(TExprBinaryVmNode.Create(TExprAddVmOp, [ALeft, ARight])); +end; + +function TExprVirtMachNodeFactory.Subtract(ALeft, ARight: TExprNode): TExprNode; +begin + Result := AddNode(TExprBinaryVmNode.Create(TExprSubtractVmOp, [ALeft, ARight])); +end; + +function TExprVirtMachNodeFactory.Multiply(ALeft, ARight: TExprNode): TExprNode; +begin + Result := AddNode(TExprBinaryVmNode.Create(TExprMultiplyVmOp, [ALeft, ARight])); +end; + +function TExprVirtMachNodeFactory.Divide(ALeft, ARight: TExprNode): TExprNode; +begin + Result := AddNode(TExprBinaryVmNode.Create(TExprDivideVmOp, [ALeft, ARight])); +end; + +function TExprVirtMachNodeFactory.IntegerDivide(ALeft, ARight: TExprNode): TExprNode; +begin + Result := AddNode(TExprBinaryVmNode.Create(TExprIntegerDivideVmOp, [ALeft, ARight])); +end; + +function TExprVirtMachNodeFactory.Modulo(ALeft, ARight: TExprNode): TExprNode; +begin + Result := AddNode(TExprBinaryVmNode.Create(TExprModuloVmOp, [ALeft, ARight])); +end; + +function TExprVirtMachNodeFactory.Negate(AValue: TExprNode): TExprNode; +begin + Result := AddNode(TExprUnaryVmNode.Create(TExprNegateVmOp, [AValue])); +end; + +function TExprVirtMachNodeFactory.Power(ALeft, ARight: TExprNode): TExprNode; +begin + Result := AddNode(TExprBinaryVmNode.Create(TExprPowerVmOp, [ALeft, ARight])); +end; + +procedure TExprVirtMachNodeFactory.DoClean(AVirtMach: TExprVirtMach); +var + I: Integer; +begin + { clean up in preparation for code generation } + AVirtMach.Clear; + for I := 0 to FNodeList.Count - 1 do + TExprVirtMachNode(FNodeList[I]).FExprVmCode := nil; +end; + +procedure TExprVirtMachNodeFactory.DoConsts(AVirtMach: TExprVirtMach); +var + I: Integer; + Node: TExprVirtMachNode; +begin + { process consts } + for I := 0 to FNodeList.Count - 1 do + begin + Node := TExprVirtMachNode(FNodeList[I]); + if (Node is TExprConstVmNode) and (Node.ExprVmCode = nil) then + Node.GenCode(AVirtMach); + end; +end; + +procedure TExprVirtMachNodeFactory.DoCode(AVirtMach: TExprVirtMach); +var + I: Integer; + Node: TExprVirtMachNode; +begin + { process code } + for I := 0 to FNodeList.Count - 1 do + begin + Node := TExprVirtMachNode(FNodeList[I]); + if Node.ExprVmCode = nil then + Node.GenCode(AVirtMach); + end; +end; + +function TExprVirtMachNodeFactory.CallFloatFunc(AFunc: TFloatFunc): TExprNode; +begin + Result := AddNode(TExprCallFloatVmNode.Create(AFunc)); +end; + +function TExprVirtMachNodeFactory.CallFloat32Func(AFunc: TFloat32Func): TExprNode; +begin + Result := AddNode(TExprCallFloat32VmNode.Create(AFunc)); +end; + +function TExprVirtMachNodeFactory.CallFloat64Func(AFunc: TFloat64Func): TExprNode; +begin + Result := AddNode(TExprCallFloat64VmNode.Create(AFunc)); +end; + +{$IFDEF SUPPORTS_EXTENDED} +function TExprVirtMachNodeFactory.CallFloat80Func(AFunc: TFloat80Func): TExprNode; +begin + Result := AddNode(TExprCallFloat80VmNode.Create(AFunc)); +end; +{$ENDIF SUPPORTS_EXTENDED} + +function TExprVirtMachNodeFactory.CallUnaryFunc(AFunc: TUnaryFunc; X: TExprNode): TExprNode; +begin + Result := AddNode(TExprCallUnaryVmNode.Create(AFunc, X)); +end; + +function TExprVirtMachNodeFactory.CallUnary32Func(AFunc: TUnary32Func; X: TExprNode): TExprNode; +begin + Result := AddNode(TExprCallUnary32VmNode.Create(AFunc, X)); +end; + +function TExprVirtMachNodeFactory.CallUnary64Func(AFunc: TUnary64Func; X: TExprNode): TExprNode; +begin + Result := AddNode(TExprCallUnary64VmNode.Create(AFunc, X)); +end; + +{$IFDEF SUPPORTS_EXTENDED} +function TExprVirtMachNodeFactory.CallUnary80Func(AFunc: TUnary80Func; X: TExprNode): TExprNode; +begin + Result := AddNode(TExprCallUnary80VmNode.Create(AFunc, X)); +end; +{$ENDIF SUPPORTS_EXTENDED} + +function TExprVirtMachNodeFactory.CallBinaryFunc(AFunc: TBinaryFunc; X, Y: TExprNode): TExprNode; +begin + Result := AddNode(TExprCallBinaryVmNode.Create(AFunc, X, Y)); +end; + +function TExprVirtMachNodeFactory.CallBinary32Func(AFunc: TBinary32Func; X, Y: TExprNode): TExprNode; +begin + Result := AddNode(TExprCallBinary32VmNode.Create(AFunc, X, Y)); +end; + +function TExprVirtMachNodeFactory.CallBinary64Func(AFunc: TBinary64Func; X, Y: TExprNode): TExprNode; +begin + Result := AddNode(TExprCallBinary64VmNode.Create(AFunc, X, Y)); +end; + +{$IFDEF SUPPORTS_EXTENDED} +function TExprVirtMachNodeFactory.CallBinary80Func(AFunc: TBinary80Func; X, Y: TExprNode): TExprNode; +begin + Result := AddNode(TExprCallBinary80VmNode.Create(AFunc, X, Y)); +end; +{$ENDIF SUPPORTS_EXTENDED} + +function TExprVirtMachNodeFactory.CallTernaryFunc(AFunc: TTernaryFunc; X, Y, Z: TExprNode): TExprNode; +begin + Result := AddNode(TExprCallTernaryVmNode.Create(AFunc, X, Y, Z)); +end; + +function TExprVirtMachNodeFactory.CallTernary32Func(AFunc: TTernary32Func; X, Y, Z: TExprNode): TExprNode; +begin + Result := AddNode(TExprCallTernary32VmNode.Create(AFunc, X, Y, Z)); +end; + +function TExprVirtMachNodeFactory.CallTernary64Func(AFunc: TTernary64Func; X, Y, Z: TExprNode): TExprNode; +begin + Result := AddNode(TExprCallTernary64VmNode.Create(AFunc, X, Y, Z)); +end; + +{$IFDEF SUPPORTS_EXTENDED} +function TExprVirtMachNodeFactory.CallTernary80Func(AFunc: TTernary80Func; X, Y, Z: TExprNode): TExprNode; +begin + Result := AddNode(TExprCallTernary80VmNode.Create(AFunc, X, Y, Z)); +end; +{$ENDIF SUPPORTS_EXTENDED} + +function TExprVirtMachNodeFactory.Compare(ALeft, ARight: TExprNode): TExprNode; +begin + Result := AddNode(TExprBinaryVmNode.Create(TExprCompareVmOp, [ALeft, ARight])); +end; + +function TExprVirtMachNodeFactory.CompareEqual(ALeft, ARight: TExprNode): TExprNode; +begin + Result := AddNode(TExprBinaryVmNode.Create(TExprEqualVmOp, [ALeft, ARight])); +end; + +function TExprVirtMachNodeFactory.CompareNotEqual(ALeft, ARight: TExprNode): TExprNode; +begin + Result := AddNode(TExprBinaryVmNode.Create(TExprNotEqualVmOp, [ALeft, ARight])); +end; + +function TExprVirtMachNodeFactory.CompareLess(ALeft, ARight: TExprNode): TExprNode; +begin + Result := AddNode(TExprBinaryVmNode.Create(TExprLessVmOp, [ALeft, ARight])); +end; + +function TExprVirtMachNodeFactory.CompareLessEqual(ALeft, ARight: TExprNode): TExprNode; +begin + Result := AddNode(TExprBinaryVmNode.Create(TExprLessEqualVmOp, [ALeft, ARight])); +end; + +function TExprVirtMachNodeFactory.CompareGreater(ALeft, ARight: TExprNode): TExprNode; +begin + Result := AddNode(TExprBinaryVmNode.Create(TExprGreaterVmOp, [ALeft, ARight])); +end; + +function TExprVirtMachNodeFactory.CompareGreaterEqual(ALeft, ARight: TExprNode): TExprNode; +begin + Result := AddNode(TExprBinaryVmNode.Create(TExprGreaterEqualVmOp, [ALeft, ARight])); +end; + +function TExprVirtMachNodeFactory.LogicalAnd(ALeft, ARight: TExprNode): TExprNode; +begin + Result := AddNode(TExprBinaryVmNode.Create(TExprLogicalAndVmOp, [ALeft, ARight])); +end; + +function TExprVirtMachNodeFactory.LogicalOr(ALeft, ARight: TExprNode): TExprNode; +begin + Result := AddNode(TExprBinaryVmNode.Create(TExprLogicalOrVmOp, [ALeft, ARight])); +end; + +function TExprVirtMachNodeFactory.LogicalXor(ALeft, ARight: TExprNode): TExprNode; +begin + Result := AddNode(TExprBinaryVmNode.Create(TExprLogicalXorVmOp, [ALeft, ARight])); +end; + +function TExprVirtMachNodeFactory.LogicalNot(AValue: TExprNode): TExprNode; +begin + Result := AddNode(TExprUnaryVmNode.Create(TExprLogicalNotVmOp, [AValue])); +end; + +function TExprVirtMachNodeFactory.BitwiseAnd(ALeft, ARight: TExprNode): TExprNode; +begin + Result := AddNode(TExprBinaryVmNode.Create(TExprBitwiseAndVmOp, [ALeft, ARight])); +end; + +function TExprVirtMachNodeFactory.BitwiseOr(ALeft, ARight: TExprNode): TExprNode; +begin + Result := AddNode(TExprBinaryVmNode.Create(TExprBitwiseOrVmOp, [ALeft, ARight])); +end; + +function TExprVirtMachNodeFactory.BitwiseXor(ALeft, ARight: TExprNode): TExprNode; +begin + Result := AddNode(TExprBinaryVmNode.Create(TExprBitwiseXorVmOp, [ALeft, ARight])); +end; + +function TExprVirtMachNodeFactory.BitwiseNot(AValue: TExprNode): TExprNode; +begin + Result := AddNode(TExprUnaryVmNode.Create(TExprBitwiseNotVmOp, [AValue])); +end; + +function TExprVirtMachNodeFactory.ShiftLeft(ALeft, ARight: TExprNode): TExprNode; +begin + Result := AddNode(TExprBinaryVmNode.Create(TExprShiftLeftVmOp, [ALeft, ARight])); +end; + +function TExprVirtMachNodeFactory.ShiftRight(ALeft, ARight: TExprNode): TExprNode; +begin + Result := AddNode(TExprBinaryVmNode.Create(TExprShiftRightVmOp, [ALeft, ARight])); +end; + +//=== { TCompiledEvaluator } ================================================= + +constructor TCompiledEvaluator.Create; +begin + inherited Create; + FVirtMach := TExprVirtMach.Create; +end; + +destructor TCompiledEvaluator.Destroy; +begin + FVirtMach.Free; + inherited Destroy; +end; + +procedure TCompiledEvaluator.Compile(const AExpr: string); +var + Lex: TExprSimpleLexer; + Parse: TExprCompileParser; + NodeFactory: TExprVirtMachNodeFactory; +begin + if AExpr <> FExpr then + begin + FExpr := AExpr; + FVirtMach.Clear; + + Parse := nil; + NodeFactory := nil; + Lex := TExprSimpleLexer.Create(FExpr); + try + NodeFactory := TExprVirtMachNodeFactory.Create; + Parse := TExprCompileParser.Create(Lex, NodeFactory); + Parse.Context := InternalContextSet; + Parse.Compile; + NodeFactory.GenCode(FVirtMach); + finally + Parse.Free; + NodeFactory.Free; + Lex.Free; + end; + end; +end; + +function TCompiledEvaluator.Evaluate: TFloat; +begin + Result := FVirtMach.Execute; +end; + +//=== { TExprVar32Sym } ====================================================== + +constructor TExprVar32Sym.Create(const AIdent: string; ALoc: PFloat32); +begin + Assert(ALoc <> nil); + FLoc := ALoc; + inherited Create(AIdent); +end; + +function TExprVar32Sym.Compile: TExprNode; +begin + Result := NodeFactory.LoadVar32(FLoc); +end; + +function TExprVar32Sym.Evaluate: TFloat; +begin + Result := FLoc^; +end; + +//=== { TExprVar64Sym } ====================================================== + +constructor TExprVar64Sym.Create(const AIdent: string; ALoc: PFloat64); +begin + Assert(ALoc <> nil); + FLoc := ALoc; + inherited Create(AIdent); +end; + +function TExprVar64Sym.Compile: TExprNode; +begin + Result := NodeFactory.LoadVar64(FLoc); +end; + +function TExprVar64Sym.Evaluate: TFloat; +begin + Result := FLoc^; +end; + +{$IFDEF SUPPORTS_EXTENDED} + +//=== { TExprVar80Sym } ====================================================== + +constructor TExprVar80Sym.Create(const AIdent: string; ALoc: PFloat80); +begin + Assert(ALoc <> nil); + FLoc := ALoc; + inherited Create(AIdent); +end; + +function TExprVar80Sym.Compile: TExprNode; +begin + Result := NodeFactory.LoadVar80(FLoc); +end; + +function TExprVar80Sym.Evaluate: TFloat; +begin + Result := FLoc^; +end; + +{$ENDIF SUPPORTS_EXTENDED} + +//=== { TExprCallFloatVmNode } =============================================== + +constructor TExprCallFloatVmNode.Create(AFunc: TFloatFunc); +begin + FFunc := AFunc; + inherited Create([]); +end; + +procedure TExprCallFloatVmNode.GenCode(AVirtMach: TExprVirtMach); +begin + FExprVmCode := TExprCallFloatVmOp.Create(FFunc); + AVirtMach.Add(FExprVmCode); +end; + +//=== { TExprCallFloat32VmNode } ============================================= + +constructor TExprCallFloat32VmNode.Create(AFunc: TFloat32Func); +begin + FFunc := AFunc; + inherited Create([]); +end; + +procedure TExprCallFloat32VmNode.GenCode(AVirtMach: TExprVirtMach); +begin + FExprVmCode := TExprCallFloat32VmOp.Create(FFunc); + AVirtMach.Add(FExprVmCode); +end; + +//=== { TExprCallFloat64VmNode } ============================================= + +constructor TExprCallFloat64VmNode.Create(AFunc: TFloat64Func); +begin + FFunc := AFunc; + inherited Create([]); +end; + +procedure TExprCallFloat64VmNode.GenCode(AVirtMach: TExprVirtMach); +begin + FExprVmCode := TExprCallFloat64VmOp.Create(FFunc); + AVirtMach.Add(FExprVmCode); +end; + +{$IFDEF SUPPORTS_EXTENDED} + +//=== { TExprCallFloat80VmNode } ============================================= + +constructor TExprCallFloat80VmNode.Create(AFunc: TFloat80Func); +begin + FFunc := AFunc; + inherited Create([]); +end; + +procedure TExprCallFloat80VmNode.GenCode(AVirtMach: TExprVirtMach); +begin + FExprVmCode := TExprCallFloat80VmOp.Create(FFunc); + AVirtMach.Add(FExprVmCode); +end; + +{$ENDIF SUPPORTS_EXTENDED} + +//=== { TExprCallUnaryVmNode } =============================================== + +constructor TExprCallUnaryVmNode.Create(AFunc: TUnaryFunc; X: TExprNode); +begin + FFunc := AFunc; + inherited Create([X]); +end; + +procedure TExprCallUnaryVmNode.GenCode(AVirtMach: TExprVirtMach); +begin + FExprVmCode := TExprCallUnaryVmOp.Create( + FFunc, + VmDeps[0].ExprVmCode.OutputLoc); + AVirtMach.Add(FExprVmCode); +end; + +//=== { TExprCallUnary32VmNode } ============================================= + +constructor TExprCallUnary32VmNode.Create(AFunc: TUnary32Func; X: TExprNode); +begin + FFunc := AFunc; + inherited Create([X]); +end; + +procedure TExprCallUnary32VmNode.GenCode(AVirtMach: TExprVirtMach); +begin + FExprVmCode := TExprCallUnary32VmOp.Create( + FFunc, + VmDeps[0].ExprVmCode.OutputLoc); + AVirtMach.Add(FExprVmCode); +end; + +//=== { TExprCallUnary64VmNode } ============================================= + +constructor TExprCallUnary64VmNode.Create(AFunc: TUnary64Func; X: TExprNode); +begin + FFunc := AFunc; + inherited Create([X]); +end; + +procedure TExprCallUnary64VmNode.GenCode(AVirtMach: TExprVirtMach); +begin + FExprVmCode := TExprCallUnary64VmOp.Create( + FFunc, + VmDeps[0].ExprVmCode.OutputLoc); + AVirtMach.Add(FExprVmCode); +end; + +{$IFDEF SUPPORTS_EXTENDED} + +//=== { TExprCallUnary80VmNode } ============================================= + +constructor TExprCallUnary80VmNode.Create(AFunc: TUnary80Func; X: TExprNode); +begin + FFunc := AFunc; + inherited Create([X]); +end; + +procedure TExprCallUnary80VmNode.GenCode(AVirtMach: TExprVirtMach); +begin + FExprVmCode := TExprCallUnary80VmOp.Create( + FFunc, + VmDeps[0].ExprVmCode.OutputLoc); + AVirtMach.Add(FExprVmCode); +end; + +{$ENDIF SUPPORTS_EXTENDED} + +//=== { TExprCallBinaryVmNode } ============================================== + +constructor TExprCallBinaryVmNode.Create(AFunc: TBinaryFunc; X, Y: TExprNode); +begin + FFunc := AFunc; + inherited Create([X, Y]); +end; + +procedure TExprCallBinaryVmNode.GenCode(AVirtMach: TExprVirtMach); +begin + FExprVmCode := TExprCallBinaryVmOp.Create( + FFunc, + VmDeps[0].ExprVmCode.OutputLoc, + VmDeps[1].ExprVmCode.OutputLoc); + AVirtMach.Add(FExprVmCode); +end; + +//=== { TExprCallBinary32VmNode } ============================================ + +constructor TExprCallBinary32VmNode.Create(AFunc: TBinary32Func; X, Y: TExprNode); +begin + FFunc := AFunc; + inherited Create([X, Y]); +end; + +procedure TExprCallBinary32VmNode.GenCode(AVirtMach: TExprVirtMach); +begin + FExprVmCode := TExprCallBinary32VmOp.Create( + FFunc, + VmDeps[0].ExprVmCode.OutputLoc, + VmDeps[1].ExprVmCode.OutputLoc); + AVirtMach.Add(FExprVmCode); +end; + +//=== { TExprCallBinary64VmNode } ============================================ + +constructor TExprCallBinary64VmNode.Create(AFunc: TBinary64Func; X, Y: TExprNode); +begin + FFunc := AFunc; + inherited Create([X, Y]); +end; + +procedure TExprCallBinary64VmNode.GenCode(AVirtMach: TExprVirtMach); +begin + FExprVmCode := TExprCallBinary64VmOp.Create( + FFunc, + VmDeps[0].ExprVmCode.OutputLoc, + VmDeps[1].ExprVmCode.OutputLoc); + AVirtMach.Add(FExprVmCode); +end; + +{$IFDEF SUPPORTS_EXTENDED} + +//=== { TExprCallBinary80VmNode } ============================================ + +constructor TExprCallBinary80VmNode.Create(AFunc: TBinary80Func; X, Y: TExprNode); +begin + FFunc := AFunc; + inherited Create([X, Y]); +end; + +procedure TExprCallBinary80VmNode.GenCode(AVirtMach: TExprVirtMach); +begin + FExprVmCode := TExprCallBinary80VmOp.Create( + FFunc, + VmDeps[0].ExprVmCode.OutputLoc, + VmDeps[1].ExprVmCode.OutputLoc); + AVirtMach.Add(FExprVmCode); +end; + +{$ENDIF SUPPORTS_EXTENDED} + +//=== { TExprCallTernaryVmNode } ============================================= + +constructor TExprCallTernaryVmNode.Create(AFunc: TTernaryFunc; X, Y, Z: TExprNode); +begin + FFunc := AFunc; + inherited Create([X, Y, Z]); +end; + +procedure TExprCallTernaryVmNode.GenCode(AVirtMach: TExprVirtMach); +begin + FExprVmCode := TExprCallTernaryVmOp.Create( + FFunc, + VmDeps[0].ExprVmCode.OutputLoc, + VmDeps[1].ExprVmCode.OutputLoc, + VmDeps[2].ExprVmCode.OutputLoc); + AVirtMach.Add(FExprVmCode); +end; + +//=== { TExprCallTernary32VmNode } =========================================== + +constructor TExprCallTernary32VmNode.Create(AFunc: TTernary32Func; X, Y, Z: TExprNode); +begin + FFunc := AFunc; + inherited Create([X, Y, Z]); +end; + +procedure TExprCallTernary32VmNode.GenCode(AVirtMach: TExprVirtMach); +begin + FExprVmCode := TExprCallTernary32VmOp.Create( + FFunc, + VmDeps[0].ExprVmCode.OutputLoc, + VmDeps[1].ExprVmCode.OutputLoc, + VmDeps[2].ExprVmCode.OutputLoc); + AVirtMach.Add(FExprVmCode); +end; + +//=== { TExprCallTernary64VmNode } =========================================== + +constructor TExprCallTernary64VmNode.Create(AFunc: TTernary64Func; X, Y, Z: TExprNode); +begin + FFunc := AFunc; + inherited Create([X, Y, Z]); +end; + +procedure TExprCallTernary64VmNode.GenCode(AVirtMach: TExprVirtMach); +begin + FExprVmCode := TExprCallTernary64VmOp.Create( + FFunc, + VmDeps[0].ExprVmCode.OutputLoc, + VmDeps[1].ExprVmCode.OutputLoc, + VmDeps[2].ExprVmCode.OutputLoc); + AVirtMach.Add(FExprVmCode); +end; + +{$IFDEF SUPPORTS_EXTENDED} + +//=== { TExprCallTernary80VmNode } =========================================== + +constructor TExprCallTernary80VmNode.Create(AFunc: TTernary80Func; X, Y, Z: TExprNode); +begin + FFunc := AFunc; + inherited Create([X, Y, Z]); +end; + +procedure TExprCallTernary80VmNode.GenCode(AVirtMach: TExprVirtMach); +begin + FExprVmCode := TExprCallTernary80VmOp.Create( + FFunc, + VmDeps[0].ExprVmCode.OutputLoc, + VmDeps[1].ExprVmCode.OutputLoc, + VmDeps[2].ExprVmCode.OutputLoc); + AVirtMach.Add(FExprVmCode); +end; + +{$ENDIF SUPPORTS_EXTENDED} + +//=== { TExprAbstractFuncSym } =============================================== + +function TExprAbstractFuncSym.CompileFirstArg: TExprNode; +begin + if Lexer.CurrTok <> etLParen then + raise EJclExprEvalError.CreateRes(@RsExprEvalFirstArg); + Result := CompileParser.CompileExprLevel0(True); +end; + +function TExprAbstractFuncSym.CompileNextArg: TExprNode; +begin + if Lexer.CurrTok <> etComma then + raise EJclExprEvalError.CreateRes(@RsExprEvalNextArg); + Result := CompileParser.CompileExprLevel0(True); +end; + +function TExprAbstractFuncSym.EvalFirstArg: TFloat; +begin + if Lexer.CurrTok <> etLParen then + raise EJclExprEvalError.CreateRes(@RsExprEvalFirstArg); + Result := EvalParser.EvalExprLevel0(True); +end; + +function TExprAbstractFuncSym.EvalNextArg: TFloat; +begin + if Lexer.CurrTok <> etComma then + raise EJclExprEvalError.CreateRes(@RsExprEvalNextArg); + Result := EvalParser.EvalExprLevel0(True); +end; + +procedure TExprAbstractFuncSym.EndArgs; +begin + if Lexer.CurrTok <> etRParen then + raise EJclExprEvalError.CreateRes(@RsExprEvalEndArgs); + Lexer.NextTok; +end; + +//=== { TExprFuncSym } ======================================================= + +constructor TExprFuncSym.Create(const AIdent: string; AFunc: TFloatFunc); +begin + Assert(Assigned(AFunc)); + inherited Create(AIdent); + FFunc := AFunc; +end; + +function TExprFuncSym.Compile: TExprNode; +begin + Result := NodeFactory.CallFloatFunc(FFunc); +end; + +function TExprFuncSym.Evaluate: TFloat; +begin + Result := FFunc; +end; + +//=== { TExprFloat32FuncSym } ================================================ + +constructor TExprFloat32FuncSym.Create(const AIdent: string; AFunc: TFloat32Func); +begin + Assert(Assigned(AFunc)); + inherited Create(AIdent); + FFunc := AFunc; +end; + +function TExprFloat32FuncSym.Compile: TExprNode; +begin + Result := NodeFactory.CallFloat32Func(FFunc); +end; + +function TExprFloat32FuncSym.Evaluate: TFloat; +begin + Result := FFunc; +end; + +//=== { TExprFloat64FuncSym } ================================================ + +constructor TExprFloat64FuncSym.Create(const AIdent: string; AFunc: TFloat64Func); +begin + Assert(Assigned(AFunc)); + inherited Create(AIdent); + FFunc := AFunc; +end; + +function TExprFloat64FuncSym.Compile: TExprNode; +begin + Result := NodeFactory.CallFloat64Func(FFunc); +end; + +function TExprFloat64FuncSym.Evaluate: TFloat; +begin + Result := FFunc; +end; + +{$IFDEF SUPPORTS_EXTENDED} + +//=== { TExprFloat80FuncSym } ================================================ + +constructor TExprFloat80FuncSym.Create(const AIdent: string; AFunc: TFloat80Func); +begin + Assert(Assigned(AFunc)); + inherited Create(AIdent); + FFunc := AFunc; +end; + +function TExprFloat80FuncSym.Compile: TExprNode; +begin + Result := NodeFactory.CallFloat80Func(FFunc); +end; + +function TExprFloat80FuncSym.Evaluate: TFloat; +begin + Result := FFunc; +end; + +{$ENDIF SUPPORTS_EXTENDED} + +//=== { TExprUnaryFuncSym } ================================================== + +constructor TExprUnaryFuncSym.Create(const AIdent: string; AFunc: TUnaryFunc); +begin + Assert(Assigned(AFunc)); + inherited Create(AIdent); + FFunc := AFunc; +end; + +function TExprUnaryFuncSym.Compile: TExprNode; +var + X: TExprNode; +begin + X := CompileFirstArg; + EndArgs; + Result := NodeFactory.CallUnaryFunc(FFunc, X); +end; + +function TExprUnaryFuncSym.Evaluate: TFloat; +var + X: TFloat; +begin + X := EvalFirstArg; + EndArgs; + Result := FFunc(X); +end; + +//=== { TExprUnary32FuncSym } ================================================ + +constructor TExprUnary32FuncSym.Create(const AIdent: string; AFunc: TUnary32Func); +begin + Assert(Assigned(AFunc)); + inherited Create(AIdent); + FFunc := AFunc; +end; + +function TExprUnary32FuncSym.Compile: TExprNode; +var + X: TExprNode; +begin + X := CompileFirstArg; + EndArgs; + Result := NodeFactory.CallUnary32Func(FFunc, X); +end; + +function TExprUnary32FuncSym.Evaluate: TFloat; +var + X: TFloat; +begin + X := EvalFirstArg; + EndArgs; + Result := FFunc(X); +end; + +//=== { TExprUnary64FuncSym } ================================================ + +constructor TExprUnary64FuncSym.Create(const AIdent: string; AFunc: TUnary64Func); +begin + Assert(Assigned(AFunc)); + inherited Create(AIdent); + FFunc := AFunc; +end; + +function TExprUnary64FuncSym.Compile: TExprNode; +var + X: TExprNode; +begin + X := CompileFirstArg; + EndArgs; + Result := NodeFactory.CallUnary64Func(FFunc, X); +end; + +function TExprUnary64FuncSym.Evaluate: TFloat; +var + X: TFloat; +begin + X := EvalFirstArg; + EndArgs; + Result := FFunc(X); +end; + +{$IFDEF SUPPORTS_EXTENDED} + +//=== { TExprUnary80FuncSym } ================================================ + +constructor TExprUnary80FuncSym.Create(const AIdent: string; AFunc: TUnary80Func); +begin + Assert(Assigned(AFunc)); + inherited Create(AIdent); + FFunc := AFunc; +end; + +function TExprUnary80FuncSym.Compile: TExprNode; +var + X: TExprNode; +begin + X := CompileFirstArg; + EndArgs; + Result := NodeFactory.CallUnary80Func(FFunc, X); +end; + +function TExprUnary80FuncSym.Evaluate: TFloat; +var + X: TFloat; +begin + X := EvalFirstArg; + EndArgs; + Result := FFunc(X); +end; + +{$ENDIF SUPPORTS_EXTENDED} + +//=== { TExprBinaryFuncSym } ================================================= + +constructor TExprBinaryFuncSym.Create(const AIdent: string; AFunc: TBinaryFunc); +begin + Assert(Assigned(AFunc)); + inherited Create(AIdent); + FFunc := AFunc; +end; + +function TExprBinaryFuncSym.Compile: TExprNode; +var + X, Y: TExprNode; +begin + // must be called this way, because evaluation order of function + // parameters is not defined; we need CompileFirstArg to be called + // first. + X := CompileFirstArg; + Y := CompileNextArg; + EndArgs; + Result := NodeFactory.CallBinaryFunc(FFunc, X, Y); +end; + +function TExprBinaryFuncSym.Evaluate: TFloat; +var + X, Y: TFloat; +begin + X := EvalFirstArg; + Y := EvalNextArg; + EndArgs; + Result := FFunc(X, Y); +end; + +//=== { TExprBinary32FuncSym } =============================================== + +constructor TExprBinary32FuncSym.Create(const AIdent: string; AFunc: TBinary32Func); +begin + Assert(Assigned(AFunc)); + inherited Create(AIdent); + FFunc := AFunc; +end; + +function TExprBinary32FuncSym.Compile: TExprNode; +var + X, Y: TExprNode; +begin + X := CompileFirstArg; + Y := CompileNextArg; + EndArgs; + Result := NodeFactory.CallBinary32Func(FFunc, X, Y); +end; + +function TExprBinary32FuncSym.Evaluate: TFloat; +var + X, Y: TFloat; +begin + X := EvalFirstArg; + Y := EvalNextArg; + EndArgs; + Result := FFunc(X, Y); +end; + +//=== { TExprBinary64FuncSym } =============================================== + +constructor TExprBinary64FuncSym.Create(const AIdent: string; AFunc: TBinary64Func); +begin + Assert(Assigned(AFunc)); + inherited Create(AIdent); + FFunc := AFunc; +end; + +function TExprBinary64FuncSym.Compile: TExprNode; +var + X, Y: TExprNode; +begin + X := CompileFirstArg; + Y := CompileNextArg; + EndArgs; + Result := NodeFactory.CallBinary64Func(FFunc, X, Y); +end; + +function TExprBinary64FuncSym.Evaluate: TFloat; +var + X, Y: TFloat; +begin + X := EvalFirstArg; + Y := EvalNextArg; + EndArgs; + Result := FFunc(X, Y); +end; + +{$IFDEF SUPPORTS_EXTENDED} + +//=== { TExprBinary80FuncSym } =============================================== + +constructor TExprBinary80FuncSym.Create(const AIdent: string; AFunc: TBinary80Func); +begin + Assert(Assigned(AFunc)); + inherited Create(AIdent); + FFunc := AFunc; +end; + +function TExprBinary80FuncSym.Compile: TExprNode; +var + X, Y: TExprNode; +begin + X := CompileFirstArg; + Y := CompileNextArg; + EndArgs; + Result := NodeFactory.CallBinary80Func(FFunc, X, Y); +end; + +function TExprBinary80FuncSym.Evaluate: TFloat; +var + X, Y: TFloat; +begin + X := EvalFirstArg; + Y := EvalNextArg; + EndArgs; + Result := FFunc(X, Y); +end; + +{$ENDIF SUPPORTS_EXTENDED} + +//=== { TExprTernaryFuncSym } ================================================ + +constructor TExprTernaryFuncSym.Create(const AIdent: string; AFunc: TTernaryFunc); +begin + Assert(Assigned(AFunc)); + inherited Create(AIdent); + FFunc := AFunc; +end; + +function TExprTernaryFuncSym.Compile: TExprNode; +var + X, Y, Z: TExprNode; +begin + X := CompileFirstArg; + Y := CompileNextArg; + Z := CompileNextArg; + EndArgs; + Result := NodeFactory.CallTernaryFunc(FFunc, X, Y, Z); +end; + +function TExprTernaryFuncSym.Evaluate: TFloat; +var + X, Y, Z: TFloat; +begin + X := EvalFirstArg; + Y := EvalNextArg; + Z := EvalNextArg; + EndArgs; + Result := FFunc(X, Y, Z); +end; + +//=== { TExprTernary32FuncSym } ============================================== + +constructor TExprTernary32FuncSym.Create(const AIdent: string; AFunc: TTernary32Func); +begin + Assert(Assigned(AFunc)); + inherited Create(AIdent); + FFunc := AFunc; +end; + +function TExprTernary32FuncSym.Compile: TExprNode; +var + X, Y, Z: TExprNode; +begin + X := CompileFirstArg; + Y := CompileNextArg; + Z := CompileNextArg; + EndArgs; + Result := NodeFactory.CallTernary32Func(FFunc, X, Y, Z); +end; + +function TExprTernary32FuncSym.Evaluate: TFloat; +var + X, Y, Z: TFloat; +begin + X := EvalFirstArg; + Y := EvalNextArg; + Z := EvalNextArg; + EndArgs; + Result := FFunc(X, Y, Z); +end; + +//=== { TExprTernary64FuncSym } ============================================== + +constructor TExprTernary64FuncSym.Create(const AIdent: string; AFunc: TTernary64Func); +begin + Assert(Assigned(AFunc)); + inherited Create(AIdent); + FFunc := AFunc; +end; + +function TExprTernary64FuncSym.Compile: TExprNode; +var + X, Y, Z: TExprNode; +begin + X := CompileFirstArg; + Y := CompileNextArg; + Z := CompileNextArg; + EndArgs; + Result := NodeFactory.CallTernary64Func(FFunc, X, Y, Z); +end; + +function TExprTernary64FuncSym.Evaluate: TFloat; +var + X, Y, Z: TFloat; +begin + X := EvalFirstArg; + Y := EvalNextArg; + Z := EvalNextArg; + EndArgs; + Result := FFunc(X, Y, Z); +end; + +{$IFDEF SUPPORTS_EXTENDED} + +//=== { TExprTernary80FuncSym } ============================================== + +constructor TExprTernary80FuncSym.Create(const AIdent: string; AFunc: TTernary80Func); +begin + Assert(Assigned(AFunc)); + inherited Create(AIdent); + FFunc := AFunc; +end; + +function TExprTernary80FuncSym.Compile: TExprNode; +var + X, Y, Z: TExprNode; +begin + X := CompileFirstArg; + Y := CompileNextArg; + Z := CompileNextArg; + EndArgs; + Result := NodeFactory.CallTernary80Func(FFunc, X, Y, Z); +end; + +function TExprTernary80FuncSym.Evaluate: TFloat; +var + X, Y, Z: TFloat; +begin + X := EvalFirstArg; + Y := EvalNextArg; + Z := EvalNextArg; + EndArgs; + Result := FFunc(X, Y, Z); +end; + +{$ENDIF SUPPORTS_EXTENDED} + +//=== { TExprConstSym } ====================================================== + +constructor TExprConstSym.Create(const AIdent: string; AValue: TFloat); +begin + inherited Create(AIdent); + FValue := AValue; +end; + +function TExprConstSym.Compile: TExprNode; +begin + Result := NodeFactory.LoadConst(FValue); +end; + +function TExprConstSym.Evaluate: TFloat; +begin + Result := FValue; +end; + +//=== { TExprConst32Sym } ==================================================== + +constructor TExprConst32Sym.Create(const AIdent: string; AValue: TFloat32); +begin + inherited Create(AIdent); + FValue := AValue; +end; + +function TExprConst32Sym.Compile: TExprNode; +begin + Result := NodeFactory.LoadConst(FValue); +end; + +function TExprConst32Sym.Evaluate: TFloat; +begin + Result := FValue; +end; + +//=== { TExprConst64Sym } ==================================================== + +constructor TExprConst64Sym.Create(const AIdent: string; AValue: TFloat64); +begin + inherited Create(AIdent); + FValue := AValue; +end; + +function TExprConst64Sym.Compile: TExprNode; +begin + Result := NodeFactory.LoadConst(FValue); +end; + +function TExprConst64Sym.Evaluate: TFloat; +begin + Result := FValue; +end; + +{$IFDEF SUPPORTS_EXTENDED} + +//=== { TExprConst80Sym } ==================================================== + +constructor TExprConst80Sym.Create(const AIdent: string; AValue: TFloat80); +begin + inherited Create(AIdent); + FValue := AValue; +end; + +function TExprConst80Sym.Compile: TExprNode; +begin + Result := NodeFactory.LoadConst(FValue); +end; + +function TExprConst80Sym.Evaluate: TFloat; +begin + Result := FValue; +end; + +{$ENDIF SUPPORTS_EXTENDED} + +//=== { TEasyEvaluator } ===================================================== + +constructor TEasyEvaluator.Create; +begin + inherited Create; + FOwnContext := TExprHashContext.Create(False, cExprEvalHashSize); + FExtContextSet := TExprSetContext.Create(False); + FInternalContextSet := TExprSetContext.Create(False); + + // user added names get precedence over external context's names + FInternalContextSet.Add(FExtContextSet); + FInternalContextSet.Add(FOwnContext); +end; + +destructor TEasyEvaluator.Destroy; +begin + FInternalContextSet.Free; + FOwnContext.Free; + FExtContextSet.Free; + inherited Destroy; +end; + +{$IFDEF SUPPORTS_EXTENDED} +procedure TEasyEvaluator.AddConst(const AName: string; AConst: TFloat80); +begin + FOwnContext.Add(TExprConst80Sym.Create(AName, AConst)); +end; +{$ENDIF SUPPORTS_EXTENDED} + +procedure TEasyEvaluator.AddConst(const AName: string; AConst: TFloat64); +begin + FOwnContext.Add(TExprConst64Sym.Create(AName, AConst)); +end; + +procedure TEasyEvaluator.AddConst(const AName: string; AConst: TFloat32); +begin + FOwnContext.Add(TExprConst32Sym.Create(AName, AConst)); +end; + +procedure TEasyEvaluator.AddVar(const AName: string; var AVar: TFloat32); +begin + FOwnContext.Add(TExprVar32Sym.Create(AName, @AVar)); +end; + +procedure TEasyEvaluator.AddVar(const AName: string; var AVar: TFloat64); +begin + FOwnContext.Add(TExprVar64Sym.Create(AName, @AVar)); +end; + +{$IFDEF SUPPORTS_EXTENDED} +procedure TEasyEvaluator.AddVar(const AName: string; var AVar: TFloat80); +begin + FOwnContext.Add(TExprVar80Sym.Create(AName, @AVar)); +end; +{$ENDIF SUPPORTS_EXTENDED} + +procedure TEasyEvaluator.AddFunc(const AName: string; AFunc: TFloat32Func); +begin + FOwnContext.Add(TExprFloat32FuncSym.Create(AName, AFunc)); +end; + +procedure TEasyEvaluator.AddFunc(const AName: string; AFunc: TFloat64Func); +begin + FOwnContext.Add(TExprFloat64FuncSym.Create(AName, AFunc)); +end; + +{$IFDEF SUPPORTS_EXTENDED} +procedure TEasyEvaluator.AddFunc(const AName: string; AFunc: TFloat80Func); +begin + FOwnContext.Add(TExprFloat80FuncSym.Create(AName, AFunc)); +end; +{$ENDIF SUPPORTS_EXTENDED} + +procedure TEasyEvaluator.AddFunc(const AName: string; AFunc: TUnary32Func); +begin + FOwnContext.Add(TExprUnary32FuncSym.Create(AName, AFunc)); +end; + +procedure TEasyEvaluator.AddFunc(const AName: string; AFunc: TUnary64Func); +begin + FOwnContext.Add(TExprUnary64FuncSym.Create(AName, AFunc)); +end; + +{$IFDEF SUPPORTS_EXTENDED} +procedure TEasyEvaluator.AddFunc(const AName: string; AFunc: TUnary80Func); +begin + FOwnContext.Add(TExprUnary80FuncSym.Create(AName, AFunc)); +end; +{$ENDIF SUPPORTS_EXTENDED} + +procedure TEasyEvaluator.AddFunc(const AName: string; AFunc: TBinary32Func); +begin + FOwnContext.Add(TExprBinary32FuncSym.Create(AName, AFunc)); +end; + +procedure TEasyEvaluator.AddFunc(const AName: string; AFunc: TBinary64Func); +begin + FOwnContext.Add(TExprBinary64FuncSym.Create(AName, AFunc)); +end; + +{$IFDEF SUPPORTS_EXTENDED} +procedure TEasyEvaluator.AddFunc(const AName: string; AFunc: TBinary80Func); +begin + FOwnContext.Add(TExprBinary80FuncSym.Create(AName, AFunc)); +end; +{$ENDIF SUPPORTS_EXTENDED} + +procedure TEasyEvaluator.AddFunc(const AName: string; AFunc: TTernary32Func); +begin + FOwnContext.Add(TExprTernary32FuncSym.Create(AName, AFunc)); +end; + +procedure TEasyEvaluator.AddFunc(const AName: string; AFunc: TTernary64Func); +begin + FOwnContext.Add(TExprTernary64FuncSym.Create(AName, AFunc)); +end; + +{$IFDEF SUPPORTS_EXTENDED} +procedure TEasyEvaluator.AddFunc(const AName: string; AFunc: TTernary80Func); +begin + FOwnContext.Add(TExprTernary80FuncSym.Create(AName, AFunc)); +end; +{$ENDIF SUPPORTS_EXTENDED} + +procedure TEasyEvaluator.Clear; +begin + FOwnContext.FHashMap.Iterate(nil, Iterate_FreeObjects); + FOwnContext.FHashMap.Clear; +end; + +procedure TEasyEvaluator.Remove(const AName: string); +begin + FOwnContext.Remove(AName); +end; + +//=== { TInternalCompiledExpression } ======================================== + +type + TInternalCompiledExpression = class(TObject) + private + FVirtMach: TExprVirtMach; + FRefCount: Integer; + public + constructor Create(AVirtMach: TExprVirtMach); + destructor Destroy; override; + property VirtMach: TExprVirtMach read FVirtMach; + property RefCount: Integer read FRefCount write FRefCount; + end; + +constructor TInternalCompiledExpression.Create(AVirtMach: TExprVirtMach); +begin + inherited Create; + FVirtMach := AVirtMach; +end; + +destructor TInternalCompiledExpression.Destroy; +begin + FVirtMach.Free; + inherited Destroy; +end; + +//=== { TExpressionCompiler } ================================================ + +constructor TExpressionCompiler.Create; +begin + FExprHash := TStringHashMap.Create(CaseInsensitiveTraits, + cExprEvalHashSize); + inherited Create; +end; + +destructor TExpressionCompiler.Destroy; +begin + FExprHash.Iterate(nil, Iterate_FreeObjects); + FExprHash.Free; + inherited Destroy; +end; + +function TExpressionCompiler.Compile(const AExpr: string): TCompiledExpression; +var + Ice: TInternalCompiledExpression; + Vm: TExprVirtMach; + Parser: TExprCompileParser; + Lexer: TExprSimpleLexer; + NodeFactory: TExprVirtMachNodeFactory; +begin + Ice := nil; + if FExprHash.Find(AExpr, Ice) then + begin + // expression already exists, add reference + Result := Ice.VirtMach.Execute; + Ice.RefCount := Ice.RefCount + 1; + end + else + begin + // compile fresh expression + Parser := nil; + NodeFactory := nil; + Lexer := TExprSimpleLexer.Create(AExpr); + try + NodeFactory := TExprVirtMachNodeFactory.Create; + Parser := TExprCompileParser.Create(Lexer, NodeFactory); + Parser.Context := InternalContextSet; + Parser.Compile; + + Ice := nil; + Vm := TExprVirtMach.Create; + try + NodeFactory.GenCode(Vm); + Ice := TInternalCompiledExpression.Create(Vm); + Ice.RefCount := 1; + FExprHash.Add(AExpr, Ice); + except + Ice.Free; + Vm.Free; + raise; + end; + finally + NodeFactory.Free; + Parser.Free; + Lexer.Free; + end; + + Result := Ice.VirtMach.Execute; + end; +end; + +type + PIceFindResult = ^TIceFindResult; + TIceFindResult = record + Found: Boolean; + Ce: TCompiledExpression; + Ice: TInternalCompiledExpression; + Expr: string; + end; + +function IterateFindIce(AUserData: Pointer; const AStr: string; var APtr: Pointer): Boolean; +var + PIfr: PIceFindResult; + Ice: TInternalCompiledExpression; + Ce: TCompiledExpression; +begin + PIfr := AUserData; + Ice := APtr; + Ce := Ice.VirtMach.Execute; + + if (TMethod(PIfr^.Ce).Code = TMethod(Ce).Code) and + (TMethod(PIfr^.Ce).Data = TMethod(Ce).Data) then + begin + PIfr^.Found := True; + PIfr^.Ice := Ice; + PIfr^.Expr := AStr; + Result := False; + end else + Result := True; +end; + +procedure TExpressionCompiler.Delete(ACompiledExpression: TCompiledExpression); +var + Ifr: TIceFindResult; +begin + with Ifr do + begin + Found := False; + Ce := ACompiledExpression; + Ice := nil; + Expr := ''; + FExprHash.Iterate(@Ifr, IterateFindIce); + if not Found then + raise EJclExprEvalError.CreateRes(@RsExprEvalExprPtrNotFound); + Remove(Expr); + end; +end; + +procedure TExpressionCompiler.Remove(const AExpr: string); +var + Ice: TInternalCompiledExpression; +begin + Ice := nil; + if not FExprHash.Find(AExpr, Ice) then + raise EJclExprEvalError.CreateResFmt(@RsExprEvalExprNotFound, [AExpr]); + + Ice.RefCount := Ice.RefCount - 1; + Assert(Ice.RefCount >= 0, LoadResString(@RsExprEvalExprRefCountAssertion)); + if Ice.RefCount = 0 then + begin + Ice.Free; + FExprHash.Remove(AExpr); + end; +end; + +procedure TExpressionCompiler.Clear; +begin + FExprHash.Iterate(nil, Iterate_FreeObjects); + FExprHash.Clear; + inherited Clear; +end; + +initialization + {$IFDEF RTL150_UP} + FFormatSettings.DecimalSeparator := '.'; + {$ENDIF RTL150_UP} + +{$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclFileUtils.pas b/3rdParty/JCL/source/common/JclFileUtils.pas index 0832890c..06b9cb52 100644 --- a/3rdParty/JCL/source/common/JclFileUtils.pas +++ b/3rdParty/JCL/source/common/JclFileUtils.pas @@ -1,7067 +1,7069 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is JclFileUtils.pas. } -{ } -{ The Initial Developer of the Original Code is Marcel van Brakel. } -{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. All rights reserved. } -{ } -{ Contributors: } -{ Andre Snepvangers (asnepvangers) } -{ Andreas Hausladen (ahuser) } -{ Anthony Steele } -{ Rik Barker (rikbarker) } -{ Azret Botash } -{ Charlie Calvert } -{ David Hervieux } -{ Florent Ouchet (outchy) } -{ Jean-Fabien Connault (cycocrew) } -{ Jens Fudickar (jfudickar) } -{ JohnML } -{ John Molyneux } -{ Marcel Bestebroer } -{ Marcel van Brakel } -{ Massimo Maria Ghisalberti } -{ Matthias Thoma (mthoma) } -{ Olivier Sannier (obones) } -{ Pelle F. S. Liljendal } -{ Robert Marquardt (marquardt) } -{ Robert Rossmair (rrossmair) } -{ Rudy Velthuis } -{ Scott Price } -{ Wim De Cleen } -{ } -{**************************************************************************************************} -{ } -{ This unit contains routines and classes for working with files, directories and path strings. } -{ Additionally it contains wrapper classes for file mapping objects and version resources. } -{ Generically speaking, everything that has to do with files and directories. Note that filesystem } -{ specific functionality has been extracted into external units, for example JclNTFS which } -{ contains NTFS specific utility routines, and that the JclShell unit contains some file related } -{ routines as well but they are specific to the Windows shell. } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -unit JclFileUtils; - -{$I jcl.inc} -{$I crossplatform.inc} - -interface - -uses - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - {$IFDEF HAS_UNIT_LIBC} - Libc, - {$ENDIF HAS_UNIT_LIBC} - {$IFDEF HAS_UNITSCOPE} - {$IFDEF MSWINDOWS} - Winapi.Windows, JclWin32, - {$ENDIF MSWINDOWS} - System.Classes, System.SysUtils, - {$ELSE ~HAS_UNITSCOPE} - {$IFDEF MSWINDOWS} - Windows, JclWin32, - {$ENDIF MSWINDOWS} - Classes, SysUtils, - {$ENDIF ~HAS_UNITSCOPE} - JclBase, JclSysUtils; - -// Path Manipulation -// -// Various support routines for working with path strings. For example, building a path from -// elements or extracting the elements from a path, interpretation of paths and transformations of -// paths. -const - {$IFDEF UNIX} - // renamed to DirDelimiter - // PathSeparator = '/'; - DirDelimiter = '/'; - DirSeparator = ':'; - {$ENDIF UNIX} - {$IFDEF MSWINDOWS} - PathDevicePrefix = '\\.\'; - // renamed to DirDelimiter - // PathSeparator = '\'; - DirDelimiter = '\'; - DirSeparator = ';'; - PathUncPrefix = '\\'; - {$ENDIF MSWINDOWS} - - faSymLink = $00000040 {$IFDEF SUPPORTS_PLATFORM} platform {$ENDIF}; // defined since D7 - faNormalFile = $00000080; - faTemporary = $00000100 {$IFDEF SUPPORTS_PLATFORM} platform {$ENDIF}; - faSparseFile = $00000200 {$IFDEF SUPPORTS_PLATFORM} platform {$ENDIF}; - faReparsePoint = $00000400 {$IFDEF SUPPORTS_PLATFORM} platform {$ENDIF}; - faCompressed = $00000800 {$IFDEF SUPPORTS_PLATFORM} platform {$ENDIF}; - faOffline = $00001000 {$IFDEF SUPPORTS_PLATFORM} platform {$ENDIF}; - faNotContentIndexed = $00002000 {$IFDEF SUPPORTS_PLATFORM} platform {$ENDIF}; - faEncrypted = $00004000 {$IFDEF SUPPORTS_PLATFORM} platform {$ENDIF}; - - // Note: faVolumeID is potentially dangerous and its usage has been discontinued - // Please see QC report 6003 for details, available online at this URL: - // http://qc.embarcadero.com/wc/qcmain.aspx?d=6003 - faRejectedByDefault = faHidden + faSysFile + faDirectory; - faWindowsSpecific = faArchive + faTemporary + faSparseFile + faReparsePoint + - faCompressed + faOffline + faNotContentIndexed + faEncrypted; - faUnixSpecific = faSymLink; - -type - TCompactPath = ({cpBegin, }cpCenter, cpEnd); - -function CharIsDriveLetter(const C: char): Boolean; -function CharIsInvalidFileNameCharacter(const C: Char): Boolean; -function CharIsInvalidPathCharacter(const C: Char): Boolean; - -function PathAddSeparator(const Path: string): string; -function PathAddExtension(const Path, Extension: string): string; -function PathAppend(const Path, Append: string): string; -function PathBuildRoot(const Drive: Byte): string; -function PathCanonicalize(const Path: string): string; -function PathCommonPrefix(const Path1, Path2: string): Integer; -{$IFDEF MSWINDOWS} -function PathCompactPath(const DC: HDC; const Path: string; const Width: Integer; - CmpFmt: TCompactPath): string; -{$ENDIF MSWINDOWS} -procedure PathExtractElements(const Source: string; var Drive, Path, FileName, Ext: string); -function PathExtractFileDirFixed(const S: string): string; -function PathExtractFileNameNoExt(const Path: string): string; -function PathExtractPathDepth(const Path: string; Depth: Integer): string; -function PathGetDepth(const Path: string): Integer; -{$IFDEF MSWINDOWS} -function PathGetLongName(const Path: string): string; -function PathGetShortName(const Path: string): string; -{$ENDIF MSWINDOWS} -function PathGetRelativePath(Origin, Destination: string): string; -function PathGetTempPath: string; -function PathIsAbsolute(const Path: string): Boolean; -function PathIsChild(const Path, Base: string): Boolean; -function PathIsEqualOrChild(const Path, Base: string): Boolean; -function PathIsDiskDevice(const Path: string): Boolean; -function PathIsUNC(const Path: string): Boolean; -function PathRemoveSeparator(const Path: string): string; -function PathRemoveExtension(const Path: string): string; - -// Windows Vista uses localized path names in the Windows Explorer but these -// folders do not really exist on disk. This causes all I/O operations to fail -// if the user specifies such a localized directory like "C:\Benutzer\MyName\Bilder" -// instead of the physical folder "C:\Users\MyName\Pictures". -// These two functions allow to convert the user's input from localized to -// physical paths and vice versa. -function PathGetPhysicalPath(const LocalizedPath: string): string; -function PathGetLocalizedPath(const PhysicalPath: string): string; - -// Files and Directories -// -// Routines for working with files and directories. Includes routines to extract various file -// attributes or update them, volume locking and routines for creating temporary files. -type - TDelTreeProgress = function (const FileName: string; Attr: DWORD): Boolean; - TFileListOption = (flFullNames, flRecursive, flMaskedSubfolders); - TFileListOptions = set of TFileListOption; - TJclAttributeMatch = (amAny, amExact, amSubSetOf, amSuperSetOf, amCustom); - TFileMatchFunc = function(const Attr: Integer; const FileInfo: TSearchRec): Boolean; - TFileHandler = procedure (const FileName: string) of object; - TFileHandlerEx = procedure (const Directory: string; const FileInfo: TSearchRec) of object; - TFileInfoHandlerEx = procedure (const FileInfo: TSearchRec) of object; - -function BuildFileList(const Path: string; const Attr: Integer; const List: TStrings; IncludeDirectoryName: Boolean = - False): Boolean; -function AdvBuildFileList(const Path: string; const Attr: Integer; const Files: TStrings; - const AttributeMatch: TJclAttributeMatch = amSuperSetOf; const Options: TFileListOptions = []; - const SubfoldersMask: string = ''; const FileMatchFunc: TFileMatchFunc = nil): Boolean; -function VerifyFileAttributeMask(var RejectedAttributes, RequiredAttributes: Integer): Boolean; -function IsFileAttributeMatch(FileAttributes, RejectedAttributes, - RequiredAttributes: Integer): Boolean; -function FileAttributesStr(const FileInfo: TSearchRec): string; -function IsFileNameMatch(FileName: string; const Mask: string; - const CaseSensitive: Boolean = {$IFDEF MSWINDOWS} False {$ELSE} True {$ENDIF}): Boolean; -procedure EnumFiles(const Path: string; HandleFile: TFileHandlerEx; - RejectedAttributes: Integer = faRejectedByDefault; RequiredAttributes: Integer = 0; - Abort: PBoolean = nil); overload; -procedure EnumFiles(const Path: string; HandleFile: TFileInfoHandlerEx; - RejectedAttributes: Integer = faRejectedByDefault; RequiredAttributes: Integer = 0; - Abort: PBoolean = nil); overload; -procedure EnumDirectories(const Root: string; const HandleDirectory: TFileHandler; - const IncludeHiddenDirectories: Boolean = False; const SubDirectoriesMask: string = ''; - Abort: PBoolean = nil {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}); -{$IFDEF MSWINDOWS} -procedure CreateEmptyFile(const FileName: string); -function CloseVolume(var Volume: THandle): Boolean; -{$IFNDEF FPC} -function DeleteDirectory(const DirectoryName: string; MoveToRecycleBin: Boolean): Boolean; -function CopyDirectory(ExistingDirectoryName, NewDirectoryName: string): Boolean; -function MoveDirectory(ExistingDirectoryName, NewDirectoryName: string): Boolean; -{$ENDIF ~FPC} -function DelTree(const Path: string): Boolean; -function DelTreeEx(const Path: string; AbortOnFailure: Boolean; Progress: TDelTreeProgress): Boolean; -function DiskInDrive(Drive: Char): Boolean; -{$ENDIF MSWINDOWS} -function DirectoryExists(const Name: string {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}): Boolean; -function FileCreateTemp(var Prefix: string): THandle; -function FileBackup(const FileName: string; Move: Boolean = False): Boolean; -function FileCopy(const ExistingFileName, NewFileName: string; ReplaceExisting: Boolean = False): Boolean; -function FileDateTime(const FileName: string): TDateTime; -function FileDelete(const FileName: string; MoveToRecycleBin: Boolean = False): Boolean; -function FileExists(const FileName: string): Boolean; -/// procedure FileHistory Creates a list of history files of a specified -/// source file. Each version of the file get's an extention .~~ The file with -/// the lowest number is the youngest file. -/// -/// (string) Name of the source file -/// (string) Folder where the history files should be -/// created. If no folder is defined the folder of the source file is used. -/// (Integer) Max number of files -/// (TDateTime) Timestamp how old the file has to be to -/// create a new history version. For example: NOW-1/24 => Only once per hour a new -/// history file is created. Default 0 means allways -/// (boolean) Flag to define that the history file -/// extention should replace the current extention or should be added at the -/// end -/// -procedure FileHistory(const FileName: string; HistoryPath: string = ''; MaxHistoryCount: Integer = 100; MinFileDate: - TDateTime = 0; ReplaceExtention: Boolean = true); -function FileMove(const ExistingFileName, NewFileName: string; ReplaceExisting: Boolean = False): Boolean; -function FileRestore(const FileName: string): Boolean; -function GetBackupFileName(const FileName: string): string; -function IsBackupFileName(const FileName: string): Boolean; -function FileGetDisplayName(const FileName: string): string; -function FileGetGroupName(const FileName: string {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}): string; -function FileGetOwnerName(const FileName: string {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}): string; -function FileGetSize(const FileName: string): Int64; -function FileGetTempName(const Prefix: string): string; -{$IFDEF MSWINDOWS} -function FileGetTypeName(const FileName: string): string; -{$ENDIF MSWINDOWS} -function FindUnusedFileName(FileName: string; const FileExt: string; NumberPrefix: string = ''): string; -function ForceDirectories(Name: string): Boolean; -function GetDirectorySize(const Path: string): Int64; -{$IFDEF MSWINDOWS} -function GetDriveTypeStr(const Drive: Char): string; -function GetFileAgeCoherence(const FileName: string): Boolean; -{$ENDIF MSWINDOWS} -procedure GetFileAttributeList(const Items: TStrings; const Attr: Integer); -{$IFDEF MSWINDOWS} -procedure GetFileAttributeListEx(const Items: TStrings; const Attr: Integer); -{$ENDIF MSWINDOWS} -function GetFileInformation(const FileName: string; out FileInfo: TSearchRec): Boolean; overload; -function GetFileInformation(const FileName: string): TSearchRec; overload; -{$IFDEF UNIX} -function GetFileStatus(const FileName: string; out StatBuf: TStatBuf64; - const ResolveSymLinks: Boolean): Integer; -{$ENDIF UNIX} -{$IFDEF MSWINDOWS} -function GetFileLastWrite(const FileName: string): TFileTime; overload; -function GetFileLastWrite(const FileName: string; out LocalTime: TDateTime): Boolean; overload; -function GetFileLastAccess(const FileName: string): TFileTime; overload; -function GetFileLastAccess(const FileName: string; out LocalTime: TDateTime): Boolean; overload; -function GetFileCreation(const FileName: string): TFileTime; overload; -function GetFileCreation(const FileName: string; out LocalTime: TDateTime): Boolean; overload; -{$ENDIF MSWINDOWS} -{$IFDEF UNIX} -function GetFileLastWrite(const FileName: string; out TimeStamp: Integer; ResolveSymLinks: Boolean = True): Boolean; overload; -function GetFileLastWrite(const FileName: string; out LocalTime: TDateTime; ResolveSymLinks: Boolean = True): Boolean; overload; -function GetFileLastWrite(const FileName: string; ResolveSymLinks: Boolean = True): Integer; overload; -function GetFileLastAccess(const FileName: string; out TimeStamp: Integer; ResolveSymLinks: Boolean = True): Boolean; overload; -function GetFileLastAccess(const FileName: string; out LocalTime: TDateTime; ResolveSymLinks: Boolean = True): Boolean; overload; -function GetFileLastAccess(const FileName: string; ResolveSymLinks: Boolean = True): Integer; overload; -function GetFileLastAttrChange(const FileName: string; out TimeStamp: Integer; ResolveSymLinks: Boolean = True): Boolean; overload; -function GetFileLastAttrChange(const FileName: string; out LocalTime: TDateTime; ResolveSymLinks: Boolean = True): Boolean; overload; -function GetFileLastAttrChange(const FileName: string; ResolveSymLinks: Boolean = True): Integer; overload; -{$ENDIF UNIX} -function GetModulePath(const Module: HMODULE): string; -function GetSizeOfFile(const FileName: string): Int64; overload; -function GetSizeOfFile(const FileInfo: TSearchRec): Int64; overload; -{$IFDEF MSWINDOWS} -function GetSizeOfFile(Handle: THandle): Int64; overload; -function GetStandardFileInfo(const FileName: string): TWin32FileAttributeData; -{$ENDIF MSWINDOWS} -function IsDirectory(const FileName: string {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}): Boolean; -function IsRootDirectory(const CanonicFileName: string): Boolean; -{$IFDEF MSWINDOWS} -function LockVolume(const Volume: string; var Handle: THandle): Boolean; -function OpenVolume(const Drive: Char): THandle; -function SetDirLastWrite(const DirName: string; const DateTime: TDateTime; RequireBackupRestorePrivileges: Boolean = True): Boolean; -function SetDirLastAccess(const DirName: string; const DateTime: TDateTime; RequireBackupRestorePrivileges: Boolean = True): Boolean; -function SetDirCreation(const DirName: string; const DateTime: TDateTime; RequireBackupRestorePrivileges: Boolean = True): Boolean; -{$ENDIF MSWINDOWS} -function SetFileLastWrite(const FileName: string; const DateTime: TDateTime): Boolean; -function SetFileLastAccess(const FileName: string; const DateTime: TDateTime): Boolean; -{$IFDEF MSWINDOWS} -function SetFileCreation(const FileName: string; const DateTime: TDateTime): Boolean; -procedure ShredFile(const FileName: string; Times: Integer = 1); -function UnlockVolume(var Handle: THandle): Boolean; -{$ENDIF MSWINDOWS} - -{$IFDEF UNIX} -function CreateSymbolicLink(const Name, Target: string): Boolean; -{ This function gets the value of the symbolic link filename. } -function SymbolicLinkTarget(const Name: string): string; -{$ENDIF UNIX} - -// TJclFileAttributeMask -// -// File search helper class, allows to specify required/rejected attributes -type - TAttributeInterest = (aiIgnored, aiRejected, aiRequired); - - TJclCustomFileAttrMask = class(TPersistent) - private - FRequiredAttr: Integer; - FRejectedAttr: Integer; - function GetAttr(Index: Integer): TAttributeInterest; - procedure SetAttr(Index: Integer; const Value: TAttributeInterest); - procedure ReadRequiredAttributes(Reader: TReader); - procedure ReadRejectedAttributes(Reader: TReader); - procedure WriteRequiredAttributes(Writer: TWriter); - procedure WriteRejectedAttributes(Writer: TWriter); - protected - procedure DefineProperties(Filer: TFiler); override; - property ReadOnly: TAttributeInterest index faReadOnly - read GetAttr write SetAttr stored False; - property Hidden: TAttributeInterest index faHidden - read GetAttr write SetAttr stored False; - property System: TAttributeInterest index faSysFile - read GetAttr write SetAttr stored False; - property Directory: TAttributeInterest index faDirectory - read GetAttr write SetAttr stored False; - property SymLink: TAttributeInterest index faSymLink - read GetAttr write SetAttr stored False; - property Normal: TAttributeInterest index faNormalFile - read GetAttr write SetAttr stored False; - property Archive: TAttributeInterest index faArchive - read GetAttr write SetAttr stored False; - property Temporary: TAttributeInterest index faTemporary - read GetAttr write SetAttr stored False; - property SparseFile: TAttributeInterest index faSparseFile - read GetAttr write SetAttr stored False; - property ReparsePoint: TAttributeInterest index faReparsePoint - read GetAttr write SetAttr stored False; - property Compressed: TAttributeInterest index faCompressed - read GetAttr write SetAttr stored False; - property OffLine: TAttributeInterest index faOffline - read GetAttr write SetAttr stored False; - property NotContentIndexed: TAttributeInterest index faNotContentIndexed - read GetAttr write SetAttr stored False; - property Encrypted: TAttributeInterest index faEncrypted - read GetAttr write SetAttr stored False; - public - constructor Create; - procedure Assign(Source: TPersistent); override; - procedure Clear; - function Match(FileAttributes: Integer): Boolean; overload; - function Match(const FileInfo: TSearchRec): Boolean; overload; - property Required: Integer read FRequiredAttr write FRequiredAttr; - property Rejected: Integer read FRejectedAttr write FRejectedAttr; - property Attribute[Index: Integer]: TAttributeInterest read GetAttr write SetAttr; default; - end; - - TJclFileAttributeMask = class(TJclCustomFileAttrMask) - private - procedure ReadVolumeID(Reader: TReader); - protected - procedure DefineProperties(Filer: TFiler); override; - published - property ReadOnly; - property Hidden; - property System; - property Directory; - property Normal; - {$IFDEF UNIX} - property SymLink; - {$ENDIF UNIX} - {$IFDEF MSWINDOWS} - property Archive; - property Temporary; - property SparseFile; - property ReparsePoint; - property Compressed; - property OffLine; - property NotContentIndexed; - property Encrypted; - {$ENDIF MSWINDOWS} - end; - -type - TFileSearchOption = (fsIncludeSubDirectories, fsIncludeHiddenSubDirectories, fsLastChangeAfter, - fsLastChangeBefore, fsMaxSize, fsMinSize); - TFileSearchOptions = set of TFileSearchOption; - TFileSearchTaskID = Integer; - TFileSearchTerminationEvent = procedure (const ID: TFileSearchTaskID; const Aborted: Boolean) of object; - TFileEnumeratorSyncMode = (smPerFile, smPerDirectory); - -// IJclFileSearchOptions -// -// Interface for file search options -type - IJclFileSearchOptions = interface - ['{B73D9E3D-34C5-4DA9-88EF-4CA730328FC9}'] - function GetAttributeMask: TJclFileAttributeMask; - function GetCaseSensitiveSearch: Boolean; - function GetRootDirectories: TStrings; - function GetRootDirectory: string; - function GetFileMask: string; - function GetFileMasks: TStrings; - function GetFileSizeMax: Int64; - function GetFileSizeMin: Int64; - function GetIncludeSubDirectories: Boolean; - function GetIncludeHiddenSubDirectories: Boolean; - function GetLastChangeAfter: TDateTime; - function GetLastChangeBefore: TDateTime; - function GetLastChangeAfterStr: string; - function GetLastChangeBeforeStr: string; - function GetSubDirectoryMask: string; - function GetOption(const Option: TFileSearchOption): Boolean; - function GetOptions: TFileSearchoptions; - procedure SetAttributeMask(const Value: TJclFileAttributeMask); - procedure SetCaseSensitiveSearch(const Value: Boolean); - procedure SetRootDirectories(const Value: TStrings); - procedure SetRootDirectory(const Value: string); - procedure SetFileMask(const Value: string); - procedure SetFileMasks(const Value: TStrings); - procedure SetFileSizeMax(const Value: Int64); - procedure SetFileSizeMin(const Value: Int64); - procedure SetIncludeSubDirectories(const Value: Boolean); - procedure SetIncludeHiddenSubDirectories(const Value: Boolean); - procedure SetLastChangeAfter(const Value: TDateTime); - procedure SetLastChangeBefore(const Value: TDateTime); - procedure SetLastChangeAfterStr(const Value: string); - procedure SetLastChangeBeforeStr(const Value: string); - procedure SetOption(const Option: TFileSearchOption; const Value: Boolean); - procedure SetOptions(const Value: TFileSearchOptions); - procedure SetSubDirectoryMask(const Value: string); - // properties - property CaseSensitiveSearch: Boolean read GetCaseSensitiveSearch write SetCaseSensitiveSearch; - property RootDirectories: TStrings read GetRootDirectories write SetRootDirectories; - property RootDirectory: string read GetRootDirectory write SetRootDirectory; - property FileMask: string read GetFileMask write SetFileMask; - property SubDirectoryMask: string read GetSubDirectoryMask write SetSubDirectoryMask; - property AttributeMask: TJclFileAttributeMask read GetAttributeMask write SetAttributeMask; - property FileSizeMin: Int64 read GetFileSizeMin write SetFileSizeMin; - property FileSizeMax: Int64 read GetFileSizeMax write SetFileSizeMax; // default InvalidFileSize; - property LastChangeAfter: TDateTime read GetLastChangeAfter write SetLastChangeAfter; - property LastChangeBefore: TDateTime read GetLastChangeBefore write SetLastChangeBefore; - property LastChangeAfterAsString: string read GetLastChangeAfterStr write SetLastChangeAfterStr; - property LastChangeBeforeAsString: string read GetLastChangeBeforeStr write SetLastChangeBeforeStr; - property IncludeSubDirectories: Boolean read GetIncludeSubDirectories - write SetIncludeSubDirectories; - property IncludeHiddenSubDirectories: Boolean read GetIncludeHiddenSubDirectories - write SetIncludeHiddenSubDirectories; - end; - -// IJclFileSearchOptions -// -// Interface for file search options -type - TJclFileSearchOptions = class(TJclInterfacedPersistent, IJclFileSearchOptions) - protected - FFileMasks: TStringList; - FRootDirectories: TStringList; - FSubDirectoryMask: string; - FAttributeMask: TJclFileAttributeMask; - FFileSizeMin: Int64; - FFileSizeMax: Int64; - FLastChangeBefore: TDateTime; - FLastChangeAfter: TDateTime; - FOptions: TFileSearchOptions; - FCaseSensitiveSearch: Boolean; - function IsLastChangeAfterStored: Boolean; - function IsLastChangeBeforeStored: Boolean; - public - constructor Create; - destructor Destroy; override; - procedure Assign(Source: TPersistent); override; - - { IJclFileSearchOptions } - function GetAttributeMask: TJclFileAttributeMask; - function GetCaseSensitiveSearch: Boolean; - function GetRootDirectories: TStrings; - function GetRootDirectory: string; - function GetFileMask: string; - function GetFileMasks: TStrings; - function GetFileSizeMax: Int64; - function GetFileSizeMin: Int64; - function GetIncludeSubDirectories: Boolean; - function GetIncludeHiddenSubDirectories: Boolean; - function GetLastChangeAfter: TDateTime; - function GetLastChangeBefore: TDateTime; - function GetLastChangeAfterStr: string; - function GetLastChangeBeforeStr: string; - function GetSubDirectoryMask: string; - function GetOption(const Option: TFileSearchOption): Boolean; - function GetOptions: TFileSearchoptions; - procedure SetAttributeMask(const Value: TJclFileAttributeMask); - procedure SetCaseSensitiveSearch(const Value: Boolean); - procedure SetRootDirectories(const Value: TStrings); - procedure SetRootDirectory(const Value: string); - procedure SetFileMask(const Value: string); - procedure SetFileMasks(const Value: TStrings); - procedure SetFileSizeMax(const Value: Int64); - procedure SetFileSizeMin(const Value: Int64); - procedure SetIncludeSubDirectories(const Value: Boolean); - procedure SetIncludeHiddenSubDirectories(const Value: Boolean); - procedure SetLastChangeAfter(const Value: TDateTime); - procedure SetLastChangeBefore(const Value: TDateTime); - procedure SetLastChangeAfterStr(const Value: string); - procedure SetLastChangeBeforeStr(const Value: string); - procedure SetOption(const Option: TFileSearchOption; const Value: Boolean); - procedure SetOptions(const Value: TFileSearchOptions); - procedure SetSubDirectoryMask(const Value: string); - published - property CaseSensitiveSearch: Boolean read GetCaseSensitiveSearch write SetCaseSensitiveSearch - default {$IFDEF MSWINDOWS} False {$ELSE} True {$ENDIF}; - property FileMasks: TStrings read GetFileMasks write SetFileMasks; - property RootDirectories: TStrings read GetRootDirectories write SetRootDirectories; - property RootDirectory: string read GetRootDirectory write SetRootDirectory; - property SubDirectoryMask: string read FSubDirectoryMask write FSubDirectoryMask; - property AttributeMask: TJclFileAttributeMask read FAttributeMask write SetAttributeMask; - property FileSizeMin: Int64 read FFileSizeMin write FFileSizeMin; - property FileSizeMax: Int64 read FFileSizeMax write FFileSizeMax; - property LastChangeAfter: TDateTime read FLastChangeAfter write FLastChangeAfter - stored IsLastChangeAfterStored; - property LastChangeBefore: TDateTime read FLastChangeBefore write FLastChangeBefore - stored IsLastChangeBeforeStored; - property Options: TFileSearchOptions read FOptions write FOptions - default [fsIncludeSubDirectories]; - end; - -// IJclFileEnumerator -// -// Interface for thread-based file search -type - IJclFileEnumerator = interface(IJclFileSearchOptions) - ['{F7E747ED-1C41-441F-B25B-BB314E00C4E9}'] - // property access methods - function GetRunningTasks: Integer; - function GetSynchronizationMode: TFileEnumeratorSyncMode; - function GetOnEnterDirectory: TFileHandler; - function GetOnTerminateTask: TFileSearchTerminationEvent; - procedure SetSynchronizationMode(const Value: TFileEnumeratorSyncMode); - procedure SetOnEnterDirectory(const Value: TFileHandler); - procedure SetOnTerminateTask(const Value: TFileSearchTerminationEvent); - // other methods - function FillList(List: TStrings): TFileSearchTaskID; - function ForEach(Handler: TFileHandler): TFileSearchTaskID; overload; - function ForEach(Handler: TFileHandlerEx): TFileSearchTaskID; overload; - procedure StopTask(ID: TFileSearchTaskID); - procedure StopAllTasks(Silently: Boolean = False); // Silently: Don't call OnTerminateTask - // properties - property RunningTasks: Integer read GetRunningTasks; - property SynchronizationMode: TFileEnumeratorSyncMode read GetSynchronizationMode - write SetSynchronizationMode; - property OnEnterDirectory: TFileHandler read GetOnEnterDirectory write SetOnEnterDirectory; - property OnTerminateTask: TFileSearchTerminationEvent read GetOnTerminateTask - write SetOnTerminateTask; - end; - -// TJclFileEnumerator -// -// Class for thread-based file search -type - TJclFileEnumerator = class(TJclFileSearchOptions, IInterface, IJclFileSearchOptions, IJclFileEnumerator) - private - FTasks: TList; - FOnEnterDirectory: TFileHandler; - FOnTerminateTask: TFileSearchTerminationEvent; - FNextTaskID: TFileSearchTaskID; - FSynchronizationMode: TFileEnumeratorSyncMode; - function GetNextTaskID: TFileSearchTaskID; - protected - function CreateTask: TThread; - procedure TaskTerminated(Sender: TObject); - property NextTaskID: TFileSearchTaskID read GetNextTaskID; - public - constructor Create; - destructor Destroy; override; - - { IJclFileEnumerator } - function GetRunningTasks: Integer; - function GetSynchronizationMode: TFileEnumeratorSyncMode; - function GetOnEnterDirectory: TFileHandler; - function GetOnTerminateTask: TFileSearchTerminationEvent; - procedure SetSynchronizationMode(const Value: TFileEnumeratorSyncMode); - procedure SetOnEnterDirectory(const Value: TFileHandler); - procedure SetOnTerminateTask(const Value: TFileSearchTerminationEvent); - - procedure Assign(Source: TPersistent); override; - function FillList(List: TStrings): TFileSearchTaskID; - function ForEach(Handler: TFileHandler): TFileSearchTaskID; overload; - function ForEach(Handler: TFileHandlerEx): TFileSearchTaskID; overload; - procedure StopTask(ID: TFileSearchTaskID); - procedure StopAllTasks(Silently: Boolean = False); // Silently: Don't call OnTerminateTask - property FileMask: string read GetFileMask write SetFileMask; - property IncludeSubDirectories: Boolean - read GetIncludeSubDirectories write SetIncludeSubDirectories; - property IncludeHiddenSubDirectories: Boolean - read GetIncludeHiddenSubDirectories write SetIncludeHiddenSubDirectories; - property SearchOption[const Option: TFileSearchOption]: Boolean read GetOption write SetOption; - property LastChangeAfterAsString: string read GetLastChangeAfterStr write SetLastChangeAfterStr; - property LastChangeBeforeAsString: string read GetLastChangeBeforeStr write SetLastChangeBeforeStr; - published - property RunningTasks: Integer read GetRunningTasks; - property SynchronizationMode: TFileEnumeratorSyncMode read FSynchronizationMode write FSynchronizationMode - default smPerDirectory; - property OnEnterDirectory: TFileHandler read FOnEnterDirectory write FOnEnterDirectory; - property OnTerminateTask: TFileSearchTerminationEvent read FOnTerminateTask write FOnTerminateTask; - end; - -function FileSearch: IJclFileEnumerator; - -{$IFDEF MSWINDOWS} - -// TFileVersionInfo -// -// Class that enables reading the version information stored in a PE file. - -type - TFileFlag = (ffDebug, ffInfoInferred, ffPatched, ffPreRelease, ffPrivateBuild, ffSpecialBuild); - TFileFlags = set of TFileFlag; - - PLangIdRec = ^TLangIdRec; - TLangIdRec = packed record - case Integer of - 0: ( - LangId: Word; - CodePage: Word); - 1: ( - Pair: DWORD); - end; - - EJclFileVersionInfoError = class(EJclError); - - TJclFileVersionInfo = class(TObject) - private - FBuffer: AnsiString; - FFixedInfo: PVSFixedFileInfo; - FFileFlags: TFileFlags; - FItemList: TStringList; - FItems: TStringList; - FLanguages: array of TLangIdRec; - FLanguageIndex: Integer; - FTranslations: array of TLangIdRec; - function GetFixedInfo: TVSFixedFileInfo; - function GetItems: TStrings; - function GetLanguageCount: Integer; - function GetLanguageIds(Index: Integer): string; - function GetLanguageNames(Index: Integer): string; - function GetLanguages(Index: Integer): TLangIdRec; - function GetTranslationCount: Integer; - function GetTranslations(Index: Integer): TLangIdRec; - procedure SetLanguageIndex(const Value: Integer); - protected - procedure CreateItemsForLanguage; - procedure CheckLanguageIndex(Value: Integer); - procedure ExtractData; - procedure ExtractFlags; - function GetBinFileVersion: string; - function GetBinProductVersion: string; - function GetFileOS: DWORD; - function GetFileSubType: DWORD; - function GetFileType: DWORD; - function GetFileVersionBuild: string; - function GetFileVersionMajor: string; - function GetFileVersionMinor: string; - function GetFileVersionRelease: string; - function GetProductVersionBuild: string; - function GetProductVersionMajor: string; - function GetProductVersionMinor: string; - function GetProductVersionRelease: string; - function GetVersionKeyValue(Index: Integer): string; - public - constructor Attach(VersionInfoData: Pointer; Size: Integer); - constructor Create(const FileName: string); overload; - {$IFDEF MSWINDOWS} - {$IFDEF FPC} - constructor Create(const Window: HWND; Dummy: Pointer = nil); overload; - {$ELSE} - constructor Create(const Window: HWND); overload; - {$ENDIF} - constructor Create(const Module: HMODULE); overload; - {$ENDIF MSWINDOWS} - destructor Destroy; override; - function GetCustomFieldValue(const FieldName: string): string; - class function VersionLanguageId(const LangIdRec: TLangIdRec): string; - class function VersionLanguageName(const LangId: Word): string; - class function FileHasVersionInfo(const FileName: string): boolean; - function TranslationMatchesLanguages(Exact: Boolean = True): Boolean; - property BinFileVersion: string read GetBinFileVersion; - property BinProductVersion: string read GetBinProductVersion; - property Comments: string index 1 read GetVersionKeyValue; - property CompanyName: string index 2 read GetVersionKeyValue; - property FileDescription: string index 3 read GetVersionKeyValue; - property FixedInfo: TVSFixedFileInfo read GetFixedInfo; - property FileFlags: TFileFlags read FFileFlags; - property FileOS: DWORD read GetFileOS; - property FileSubType: DWORD read GetFileSubType; - property FileType: DWORD read GetFileType; - property FileVersion: string index 4 read GetVersionKeyValue; - property FileVersionBuild: string read GetFileVersionBuild; - property FileVersionMajor: string read GetFileVersionMajor; - property FileVersionMinor: string read GetFileVersionMinor; - property FileVersionRelease: string read GetFileVersionRelease; - property Items: TStrings read GetItems; - property InternalName: string index 5 read GetVersionKeyValue; - property LanguageCount: Integer read GetLanguageCount; - property LanguageIds[Index: Integer]: string read GetLanguageIds; - property LanguageIndex: Integer read FLanguageIndex write SetLanguageIndex; - property Languages[Index: Integer]: TLangIdRec read GetLanguages; - property LanguageNames[Index: Integer]: string read GetLanguageNames; - property LegalCopyright: string index 6 read GetVersionKeyValue; - property LegalTradeMarks: string index 7 read GetVersionKeyValue; - property OriginalFilename: string index 8 read GetVersionKeyValue; - property PrivateBuild: string index 12 read GetVersionKeyValue; - property ProductName: string index 9 read GetVersionKeyValue; - property ProductVersion: string index 10 read GetVersionKeyValue; - property ProductVersionBuild: string read GetProductVersionBuild; - property ProductVersionMajor: string read GetProductVersionMajor; - property ProductVersionMinor: string read GetProductVersionMinor; - property ProductVersionRelease: string read GetProductVersionRelease; - property SpecialBuild: string index 11 read GetVersionKeyValue; - property TranslationCount: Integer read GetTranslationCount; - property Translations[Index: Integer]: TLangIdRec read GetTranslations; - end; - -function OSIdentToString(const OSIdent: DWORD): string; -function OSFileTypeToString(const OSFileType: DWORD; const OSFileSubType: DWORD = 0): string; - -function VersionResourceAvailable(const FileName: string): Boolean; overload; -function VersionResourceAvailable(const Window: HWND): Boolean; overload; -function VersionResourceAvailable(const Module: HMODULE): Boolean; overload; - -function WindowToModuleFileName(const Window: HWND): string; -{$ENDIF MSWINDOWS} - -// Version Info formatting -type - TFileVersionFormat = (vfMajorMinor, vfFull); - -function FormatVersionString(const HiV, LoV: Word): string; overload; -function FormatVersionString(const Major, Minor, Build, Revision: Word): string; overload; - -{$IFDEF MSWINDOWS} - -function FormatVersionString(const FixedInfo: TVSFixedFileInfo; VersionFormat: TFileVersionFormat = vfFull): string; overload; - -// Version Info extracting -procedure VersionExtractFileInfo(const FixedInfo: TVSFixedFileInfo; var Major, Minor, Build, Revision: Word); -procedure VersionExtractProductInfo(const FixedInfo: TVSFixedFileInfo; var Major, Minor, Build, Revision: Word); - -// Fixed Version Info routines -function VersionFixedFileInfo(const FileName: string; var FixedInfo: TVSFixedFileInfo): Boolean; -function VersionFixedFileInfoString(const FileName: string; VersionFormat: TFileVersionFormat = vfFull; - const NotAvailableText: string = ''): string; - -{$ENDIF MSWINDOWS} - -// Streams -// -// TStream descendent classes for dealing with temporary files and for using file mapping objects. -type - TJclTempFileStream = class(THandleStream) - private - FFileName: string; - public - constructor Create(const Prefix: string); - destructor Destroy; override; - property FileName: string read FFileName; - end; - -{$IFDEF MSWINDOWS} - - TJclCustomFileMapping = class; - - TJclFileMappingView = class(TCustomMemoryStream) - private - FFileMapping: TJclCustomFileMapping; - FOffsetHigh: Cardinal; - FOffsetLow: Cardinal; - function GetIndex: Integer; - function GetOffset: Int64; - public - constructor Create(const FileMap: TJclCustomFileMapping; - Access, Size: Cardinal; ViewOffset: Int64); - constructor CreateAt(FileMap: TJclCustomFileMapping; Access, - Size: Cardinal; ViewOffset: Int64; Address: Pointer); - destructor Destroy; override; - function Flush(const Count: Cardinal): Boolean; - procedure LoadFromStream(const Stream: TStream); - procedure LoadFromFile(const FileName: string); - function Write(const Buffer; Count: Longint): Longint; override; - property Index: Integer read GetIndex; - property FileMapping: TJclCustomFileMapping read FFileMapping; - property Offset: Int64 read GetOffset; - end; - - TJclFileMappingRoundOffset = (rvDown, rvUp); - - TJclCustomFileMapping = class(TObject) - private - FExisted: Boolean; - FHandle: THandle; - FName: string; - FRoundViewOffset: TJclFileMappingRoundOffset; - FViews: TList; - function GetCount: Integer; - function GetView(Index: Integer): TJclFileMappingView; - protected - procedure ClearViews; - procedure InternalCreate(const FileHandle: THandle; const Name: string; - const Protect: Cardinal; MaximumSize: Int64; SecAttr: PSecurityAttributes); - procedure InternalOpen(const Name: string; const InheritHandle: Boolean; - const DesiredAccess: Cardinal); - public - constructor Create; - constructor Open(const Name: string; const InheritHandle: Boolean; const DesiredAccess: Cardinal); - destructor Destroy; override; - function Add(const Access, Count: Cardinal; const Offset: Int64): Integer; - function AddAt(const Access, Count: Cardinal; const Offset: Int64; const Address: Pointer): Integer; - procedure Delete(const Index: Integer); - function IndexOf(const View: TJclFileMappingView): Integer; - property Count: Integer read GetCount; - property Existed: Boolean read FExisted; - property Handle: THandle read FHandle; - property Name: string read FName; - property RoundViewOffset: TJclFileMappingRoundOffset read FRoundViewOffset write FRoundViewOffset; - property Views[index: Integer]: TJclFileMappingView read GetView; - end; - - TJclFileMapping = class(TJclCustomFileMapping) - private - FFileHandle: THandle; - public - constructor Create(const FileName: string; FileMode: Cardinal; - const Name: string; Protect: Cardinal; const MaximumSize: Int64; - SecAttr: PSecurityAttributes); overload; - constructor Create(const FileHandle: THandle; const Name: string; - Protect: Cardinal; const MaximumSize: Int64; - SecAttr: PSecurityAttributes); overload; - destructor Destroy; override; - property FileHandle: THandle read FFileHandle; - end; - - TJclSwapFileMapping = class(TJclCustomFileMapping) - public - constructor Create(const Name: string; Protect: Cardinal; - const MaximumSize: Int64; SecAttr: PSecurityAttributes); - end; - - TJclFileMappingStream = class(TCustomMemoryStream) - private - FFileHandle: THandle; - FMapping: THandle; - protected - procedure Close; - public - constructor Create(const FileName: string; FileMode: Word = fmOpenRead or fmShareDenyWrite); - destructor Destroy; override; - function Write(const Buffer; Count: Longint): Longint; override; - end; - -{$ENDIF MSWINDOWS} - - TJclMappedTextReaderIndex = (tiNoIndex, tiFull); - - PPAnsiCharArray = ^TPAnsiCharArray; - TPAnsiCharArray = array [0..MaxInt div SizeOf(PAnsiChar) - 1] of PAnsiChar; - - TJclAnsiMappedTextReader = class(TPersistent) - private - FContent: PAnsiChar; - FEnd: PAnsiChar; - FIndex: PPAnsiCharArray; - FIndexOption: TJclMappedTextReaderIndex; - FFreeStream: Boolean; - FLastLineNumber: Integer; - FLastPosition: PAnsiChar; - FLineCount: Integer; - FMemoryStream: TCustomMemoryStream; - FPosition: PAnsiChar; - FSize: Integer; - function GetAsString: AnsiString; - function GetEof: Boolean; - function GetChars(Index: Integer): AnsiChar; - function GetLineCount: Integer; - function GetLines(LineNumber: Integer): AnsiString; - function GetPosition: Integer; - function GetPositionFromLine(LineNumber: Integer): Integer; - procedure SetPosition(const Value: Integer); - protected - procedure AssignTo(Dest: TPersistent); override; - procedure CreateIndex; - procedure Init; - function PtrFromLine(LineNumber: Integer): PAnsiChar; - function StringFromPosition(var StartPos: PAnsiChar): AnsiString; - public - constructor Create(MemoryStream: TCustomMemoryStream; FreeStream: Boolean = True; - const AIndexOption: TJclMappedTextReaderIndex = tiNoIndex); overload; - constructor Create(const FileName: TFileName; - const AIndexOption: TJclMappedTextReaderIndex = tiNoIndex); overload; - destructor Destroy; override; - procedure GoBegin; - function Read: AnsiChar; - function ReadLn: AnsiString; - property AsString: AnsiString read GetAsString; - property Chars[Index: Integer]: AnsiChar read GetChars; - property Content: PAnsiChar read FContent; - property Eof: Boolean read GetEof; - property IndexOption: TJclMappedTextReaderIndex read FIndexOption; - property Lines[LineNumber: Integer]: AnsiString read GetLines; - property LineCount: Integer read GetLineCount; - property PositionFromLine[LineNumber: Integer]: Integer read GetPositionFromLine; - property Position: Integer read GetPosition write SetPosition; - property Size: Integer read FSize; - end; - - PPWideCharArray = ^TPWideCharArray; - TPWideCharArray = array [0..MaxInt div SizeOf(PWideChar) - 1] of PWideChar; - - TJclWideMappedTextReader = class(TPersistent) - private - FContent: PWideChar; - FEnd: PWideChar; - FIndex: PPWideCharArray; - FIndexOption: TJclMappedTextReaderIndex; - FFreeStream: Boolean; - FLastLineNumber: Integer; - FLastPosition: PWideChar; - FLineCount: Integer; - FMemoryStream: TCustomMemoryStream; - FPosition: PWideChar; - FSize: Integer; - function GetAsString: WideString; - function GetEof: Boolean; - function GetChars(Index: Integer): WideChar; - function GetLineCount: Integer; - function GetLines(LineNumber: Integer): WideString; - function GetPosition: Integer; - function GetPositionFromLine(LineNumber: Integer): Integer; - procedure SetPosition(const Value: Integer); - protected - procedure AssignTo(Dest: TPersistent); override; - procedure CreateIndex; - procedure Init; - function PtrFromLine(LineNumber: Integer): PWideChar; - function StringFromPosition(var StartPos: PWideChar): WideString; - public - constructor Create(MemoryStream: TCustomMemoryStream; FreeStream: Boolean = True; - const AIndexOption: TJclMappedTextReaderIndex = tiNoIndex); overload; - constructor Create(const FileName: TFileName; - const AIndexOption: TJclMappedTextReaderIndex = tiNoIndex); overload; - destructor Destroy; override; - procedure GoBegin; - function Read: WideChar; - function ReadLn: WideString; - property AsString: WideString read GetAsString; - property Chars[Index: Integer]: WideChar read GetChars; - property Content: PWideChar read FContent; - property Eof: Boolean read GetEof; - property IndexOption: TJclMappedTextReaderIndex read FIndexOption; - property Lines[LineNumber: Integer]: WideString read GetLines; - property LineCount: Integer read GetLineCount; - property PositionFromLine[LineNumber: Integer]: Integer read GetPositionFromLine; - property Position: Integer read GetPosition write SetPosition; - property Size: Integer read FSize; - end; - -{ TODO : UNTESTED/UNDOCUMENTED } - -type - TJclFileMaskComparator = class(TObject) - private - FFileMask: string; - FExts: array of string; - FNames: array of string; - FWildChars: array of Byte; - FSeparator: Char; - procedure CreateMultiMasks; - function GetCount: Integer; - function GetExts(Index: Integer): string; - function GetMasks(Index: Integer): string; - function GetNames(Index: Integer): string; - procedure SetFileMask(const Value: string); - procedure SetSeparator(const Value: Char); - public - constructor Create; - function Compare(const NameExt: string): Boolean; - property Count: Integer read GetCount; - property Exts[Index: Integer]: string read GetExts; - property FileMask: string read FFileMask write SetFileMask; - property Masks[Index: Integer]: string read GetMasks; - property Names[Index: Integer]: string read GetNames; - property Separator: Char read FSeparator write SetSeparator; - end; - - EJclPathError = class(EJclError); - EJclFileUtilsError = class(EJclError); - {$IFDEF UNIX} - EJclTempFileStreamError = class(EJclFileUtilsError); - {$ENDIF UNIX} - {$IFDEF MSWINDOWS} - EJclTempFileStreamError = class(EJclWin32Error); - EJclFileMappingError = class(EJclWin32Error); - EJclFileMappingViewError = class(EJclWin32Error); - {$ENDIF MSWINDOWS} - -function SamePath(const Path1, Path2: string): Boolean; - -// functions to add/delete paths from a separated list of paths -// on windows the separator is a semi-colon ';' -// on linux the separator is a colon ':' -// add items at the end -procedure PathListAddItems(var List: string; const Items: string); -// add items at the end if they are not present -procedure PathListIncludeItems(var List: string; const Items: string); -// delete multiple items -procedure PathListDelItems(var List: string; const Items: string); -// delete one item -procedure PathListDelItem(var List: string; const Index: Integer); -// return the number of item -function PathListItemCount(const List: string): Integer; -// return the Nth item -function PathListGetItem(const List: string; const Index: Integer): string; -// set the Nth item -procedure PathListSetItem(var List: string; const Index: Integer; const Value: string); -// return the index of an item -function PathListItemIndex(const List, Item: string): Integer; - - -// additional functions to access the commandline parameters of an application - -// returns the name of the command line parameter at position index, which is -// separated by the given separator, if the first character of the name part -// is one of the AllowedPrefixCharacters, this character will be deleted. -function ParamName(Index: Integer; const Separator: string = '='; - const AllowedPrefixCharacters: string = '-/'; TrimName: Boolean = True): string; -// returns the value of the command line parameter at position index, which is -// separated by the given separator -function ParamValue (Index: Integer; const Separator: string = '='; TrimValue: Boolean = True): string; overload; -// seaches a command line parameter where the namepart is the searchname -// and returns the value which is which by the given separator. -// CaseSensitive defines the search type. if the first character of the name part -// is one of the AllowedPrefixCharacters, this character will be deleted. -function ParamValue (const SearchName: string; const Separator: string = '='; - CaseSensitive: Boolean = False; - const AllowedPrefixCharacters: string = '-/'; TrimValue: Boolean = True): string; overload; -// seaches a command line parameter where the namepart is the searchname -// and returns the position index. if no separator is defined, the full paramstr is compared. -// CaseSensitive defines the search type. if the first character of the name part -// is one of the AllowedPrefixCharacters, this character will be deleted. -function ParamPos (const SearchName: string; const Separator: string = '='; - CaseSensitive: Boolean = False; - const AllowedPrefixCharacters: string = '-/'): Integer; - - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\common'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -uses - {$IFDEF HAS_UNITSCOPE} - System.Types, // inlining of TList.Remove - {$IFDEF HAS_UNIT_CHARACTER} - System.Character, - {$ENDIF HAS_UNIT_CHARACTER} - System.Math, - {$IFDEF MSWINDOWS} - Winapi.ShellApi, Winapi.ActiveX, System.Win.ComObj, Winapi.ShlObj, - JclShell, JclSysInfo, JclSecurity, - {$ENDIF MSWINDOWS} - {$ELSE ~HAS_UNITSCOPE} - {$IFDEF HAS_UNIT_CHARACTER} - Character, - {$ENDIF HAS_UNIT_CHARACTER} - Math, - {$IFDEF MSWINDOWS} - ShellApi, ActiveX, ComObj, ShlObj, - JclShell, JclSysInfo, JclSecurity, - {$ENDIF MSWINDOWS} - {$ENDIF ~HAS_UNITSCOPE} - JclDateTime, JclResources, - JclStrings; - -{ Some general notes: - - This unit redeclares some functions from FileCtrl.pas to avoid a dependency on that unit in the - JCL. The problem is that FileCtrl.pas uses some units (eg Forms.pas) which have ridiculous - initialization requirements. They add 4KB (!) to the executable and roughly 1 second of startup. - That initialization is only necessary for GUI applications and is unacceptable for high - performance services or console apps. - - The routines which query files or directories for their attributes deliberately use FindFirst - even though there may be easier ways to get at the required information. This is because FindFirst - is about the only routine which doesn't cause the file's last modification/accessed time to be - changed which is usually an undesired side-effect. } - -{$IFDEF UNIX} -const - ERROR_NO_MORE_FILES = -1; - INVALID_HANDLE_VALUE = THandle(-1); -{$ENDIF UNIX} - -//=== { TJclTempFileStream } ================================================= - -constructor TJclTempFileStream.Create(const Prefix: string); -var - FileHandle: THandle; -begin - FFileName := Prefix; - FileHandle := FileCreateTemp(FFileName); - // (rom) is it really wise to throw an exception before calling inherited? - if FileHandle = INVALID_HANDLE_VALUE then - raise EJclTempFileStreamError.CreateRes(@RsFileStreamCreate); - inherited Create(FileHandle); -end; - -destructor TJclTempFileStream.Destroy; -begin - if THandle(Handle) <> INVALID_HANDLE_VALUE then - FileClose(Handle); - inherited Destroy; -end; - -//=== { TJclFileMappingView } ================================================ - -{$IFDEF MSWINDOWS} - -constructor TJclFileMappingView.Create(const FileMap: TJclCustomFileMapping; - Access, Size: Cardinal; ViewOffset: Int64); -var - BaseAddress: Pointer; - OffsetLow, OffsetHigh: Cardinal; -begin - inherited Create; - if FileMap = nil then - raise EJclFileMappingViewError.CreateRes(@RsViewNeedsMapping); - FFileMapping := FileMap; - // Offset must be a multiple of system memory allocation granularity - RoundToAllocGranularity64(ViewOffset, FFileMapping.RoundViewOffset = rvUp); - I64ToCardinals(ViewOffset, OffsetLow, OffsetHigh); - FOffsetHigh := OffsetHigh; - FOffsetLow := OffsetLow; - BaseAddress := MapViewOfFile(FFileMapping.Handle, Access, FOffsetHigh, FOffsetLow, Size); - if BaseAddress = nil then - raise EJclFileMappingViewError.CreateRes(@RsCreateFileMappingView); - // If we are mapping a file and size = 0 then MapViewOfFile has mapped the entire file. We must - // figure out the size ourselves before we can call SetPointer. Since in case of failure to - // retrieve the size we raise an exception, we also have to explicitly unmap the view which - // otherwise would have been done by the destructor. - if (Size = 0) and (FileMap is TJclFileMapping) then - begin - Size := GetFileSize(TJclFileMapping(FileMap).FFileHandle, nil); - if Size = DWORD(-1) then - begin - UnMapViewOfFile(BaseAddress); - raise EJclFileMappingViewError.CreateRes(@RsFailedToObtainSize); - end; - end; - SetPointer(BaseAddress, Size); - FFileMapping.FViews.Add(Self); -end; - -constructor TJclFileMappingView.CreateAt(FileMap: TJclCustomFileMapping; - Access, Size: Cardinal; ViewOffset: Int64; Address: Pointer); -var - BaseAddress: Pointer; - OffsetLow, OffsetHigh: Cardinal; -begin - inherited Create; - if FileMap = nil then - raise EJclFileMappingViewError.CreateRes(@RsViewNeedsMapping); - FFileMapping := FileMap; - // Offset must be a multiple of system memory allocation granularity - RoundToAllocGranularity64(ViewOffset, FFileMapping.RoundViewOffset = rvUp); - RoundToAllocGranularityPtr(Address, FFileMapping.RoundViewOffset = rvUp); - I64ToCardinals(ViewOffset, OffsetLow, OffsetHigh); - FOffsetHigh := OffsetHigh; - FOffsetLow := OffsetLow; - BaseAddress := MapViewOfFileEx(FFileMapping.Handle, Access, FOffsetHigh, - FOffsetLow, Size, Address); - if BaseAddress = nil then - raise EJclFileMappingViewError.CreateRes(@RsCreateFileMappingView); - // If we are mapping a file and size = 0 then MapViewOfFile has mapped the entire file. We must - // figure out the size ourselves before we can call SetPointer. Since in case of failure to - // retrieve the size we raise an exception, we also have to explicitly unmap the view which - // otherwise would have been done by the destructor. - if (Size = 0) and (FileMap is TJclFileMapping) then - begin - Size := GetFileSize(TJclFileMapping(FileMap).FFileHandle, nil); - if Size = DWORD(-1) then - begin - UnMapViewOfFile(BaseAddress); - raise EJclFileMappingViewError.CreateRes(@RsFailedToObtainSize); - end; - end; - SetPointer(BaseAddress, Size); - FFileMapping.FViews.Add(Self); -end; - -destructor TJclFileMappingView.Destroy; -var - IndexOfSelf: Integer; -begin - if Memory <> nil then - begin - UnMapViewOfFile(Memory); - SetPointer(nil, 0); - end; - if FFileMapping <> nil then - begin - IndexOfSelf := FFileMapping.IndexOf(Self); - if IndexOfSelf <> -1 then - FFileMapping.FViews.Delete(IndexOfSelf); - end; - inherited Destroy; -end; - -function TJclFileMappingView.Flush(const Count: Cardinal): Boolean; -begin - Result := FlushViewOfFile(Memory, Count); -end; - -function TJclFileMappingView.GetIndex: Integer; -begin - Result := FFileMapping.IndexOf(Self); -end; - -function TJclFileMappingView.GetOffset: Int64; -begin - CardinalsToI64(Result, FOffsetLow, FOffsetHigh); -end; - -procedure TJclFileMappingView.LoadFromFile(const FileName: string); -var - Stream: TFileStream; -begin - Stream := TFileStream.Create(Filename, fmOpenRead or fmShareDenyWrite); - try - LoadFromStream(Stream); - finally - FreeAndNil(Stream); - end; -end; - -procedure TJclFileMappingView.LoadFromStream(const Stream: TStream); -begin - if Stream.Size > Size then - raise EJclFileMappingViewError.CreateRes(@RsLoadFromStreamSize); - Stream.Position := 0; - Stream.ReadBuffer(Memory^, Stream.Size); -end; - -function TJclFileMappingView.Write(const Buffer; Count: Integer): Longint; -begin - Result := 0; - if (Size - Position) >= Count then - begin - System.Move(Buffer, Pointer(TJclAddr(Memory) + TJclAddr(Position))^, Count); - Position := Position + Count; - Result := Count; - end; -end; - -//=== { TJclCustomFileMapping } ============================================== - -constructor TJclCustomFileMapping.Create; -begin - inherited Create; - FViews := TList.Create; - FRoundViewOffset := rvDown; -end; - -constructor TJclCustomFileMapping.Open(const Name: string; - const InheritHandle: Boolean; const DesiredAccess: Cardinal); -begin - Create; - InternalOpen(Name, InheritHandle, DesiredAccess); -end; - -destructor TJclCustomFileMapping.Destroy; -begin - ClearViews; - if FHandle <> 0 then - CloseHandle(FHandle); - FreeAndNil(FViews); - inherited Destroy; -end; - -function TJclCustomFileMapping.Add(const Access, Count: Cardinal; const Offset: Int64): Integer; -var - View: TJclFileMappingView; -begin - // The view adds itself to the FViews list - View := TJclFileMappingView.Create(Self, Access, Count, Offset); - Result := View.Index; -end; - -function TJclCustomFileMapping.AddAt(const Access, Count: Cardinal; - const Offset: Int64; const Address: Pointer): Integer; -var - View: TJclFileMappingView; -begin - // The view adds itself to the FViews list - View := TJclFileMappingView.CreateAt(Self, Access, Count, Offset, Address); - Result := View.Index; -end; - -procedure TJclCustomFileMapping.ClearViews; -var - I: Integer; -begin - // Note that the view destructor removes the view object from the FViews list so we must loop - // downwards from count to 0 - for I := FViews.Count - 1 downto 0 do - TJclFileMappingView(FViews[I]).Free; -end; - -procedure TJclCustomFileMapping.Delete(const Index: Integer); -begin - // Note that the view destructor removes itself from FViews - TJclFileMappingView(FViews[Index]).Free; -end; - -function TJclCustomFileMapping.GetCount: Integer; -begin - Result := FViews.Count; -end; - -function TJclCustomFileMapping.GetView(Index: Integer): TJclFileMappingView; -begin - Result := TJclFileMappingView(FViews.Items[index]); -end; - -function TJclCustomFileMapping.IndexOf(const View: TJclFileMappingView): Integer; -begin - Result := FViews.IndexOf(View); -end; - -procedure TJclCustomFileMapping.InternalCreate(const FileHandle: THandle; - const Name: string; const Protect: Cardinal; MaximumSize: Int64; - SecAttr: PSecurityAttributes); -var - MaximumSizeLow, MaximumSizeHigh: Cardinal; -begin - FName := Name; - I64ToCardinals(MaximumSize, MaximumSizeLow, MaximumSizeHigh); - FHandle := CreateFileMapping(FileHandle, SecAttr, Protect, MaximumSizeHigh, - MaximumSizeLow, PChar(Name)); - if FHandle = 0 then - raise EJclFileMappingError.CreateRes(@RsCreateFileMapping); - FExisted := GetLastError = ERROR_ALREADY_EXISTS; -end; - -procedure TJclCustomFileMapping.InternalOpen(const Name: string; - const InheritHandle: Boolean; const DesiredAccess: Cardinal); -begin - FExisted := True; - FName := Name; - FHandle := OpenFileMapping(DesiredAccess, InheritHandle, PChar(Name)); - if FHandle = 0 then - raise EJclFileMappingError.CreateRes(@RsCreateFileMapping); -end; - -//=== { TJclFileMapping } ==================================================== - -constructor TJclFileMapping.Create(const FileName: string; FileMode: Cardinal; - const Name: string; Protect: Cardinal; const MaximumSize: Int64; - SecAttr: PSecurityAttributes); -begin - FFileHandle := INVALID_HANDLE_VALUE; - inherited Create; - FFileHandle := THandle(FileOpen(FileName, FileMode)); - if FFileHandle = INVALID_HANDLE_VALUE then - raise EJclFileMappingError.CreateRes(@RsFileMappingOpenFile); - InternalCreate(FFileHandle, Name, Protect, MaximumSize, SecAttr); -end; - -constructor TJclFileMapping.Create(const FileHandle: THandle; const Name: string; - Protect: Cardinal; const MaximumSize: Int64; SecAttr: PSecurityAttributes); -begin - FFileHandle := INVALID_HANDLE_VALUE; - inherited Create; - if FileHandle = INVALID_HANDLE_VALUE then - raise EJclFileMappingError.CreateRes(@RsFileMappingInvalidHandle); - InternalCreate(FileHandle, Name, Protect, MaximumSize, SecAttr); - // Duplicate the handle into FFileHandle as opposed to assigning it directly. This will cause - // FFileHandle to retrieve a unique copy which is independent of FileHandle. This makes the - // remainder of the class, especially the destructor, easier. The caller will have to close it's - // own copy of the handle explicitly. - DuplicateHandle(GetCurrentProcess, FileHandle, GetCurrentProcess, - @FFileHandle, 0, False, DUPLICATE_SAME_ACCESS); -end; - -destructor TJclFileMapping.Destroy; -begin - if FFileHandle <> INVALID_HANDLE_VALUE then - CloseHandle(FFileHandle); - inherited Destroy; -end; - -//=== { TJclSwapFileMapping } ================================================ - -constructor TJclSwapFileMapping.Create(const Name: string; Protect: Cardinal; - const MaximumSize: Int64; SecAttr: PSecurityAttributes); -begin - inherited Create; - InternalCreate(INVALID_HANDLE_VALUE, Name, Protect, MaximumSize, SecAttr); -end; - -//=== { TJclFileMappingStream } ============================================== - -constructor TJclFileMappingStream.Create(const FileName: string; FileMode: Word); -var - Protect, Access, Size: DWORD; - BaseAddress: Pointer; -begin - inherited Create; - FFileHandle := THandle(FileOpen(FileName, FileMode)); - if FFileHandle = INVALID_HANDLE_VALUE then - RaiseLastOSError; - if (FileMode and $0F) = fmOpenReadWrite then - begin - Protect := PAGE_WRITECOPY; - Access := FILE_MAP_COPY; - end - else - begin - Protect := PAGE_READONLY; - Access := FILE_MAP_READ; - end; - FMapping := CreateFileMapping(FFileHandle, nil, Protect, 0, 0, nil); - if FMapping = 0 then - begin - Close; - raise EJclFileMappingError.CreateRes(@RsCreateFileMapping); - end; - BaseAddress := MapViewOfFile(FMapping, Access, 0, 0, 0); - if BaseAddress = nil then - begin - Close; - raise EJclFileMappingViewError.CreateRes(@RsCreateFileMappingView); - end; - Size := GetFileSize(FFileHandle, nil); - if Size = DWORD(-1) then - begin - UnMapViewOfFile(BaseAddress); - Close; - raise EJclFileMappingViewError.CreateRes(@RsFailedToObtainSize); - end; - SetPointer(BaseAddress, Size); -end; - -destructor TJclFileMappingStream.Destroy; -begin - Close; - inherited Destroy; -end; - -procedure TJclFileMappingStream.Close; -begin - if Memory <> nil then - begin - UnMapViewOfFile(Memory); - SetPointer(nil, 0); - end; - if FMapping <> 0 then - begin - CloseHandle(FMapping); - FMapping := 0; - end; - if FFileHandle <> INVALID_HANDLE_VALUE then - begin - FileClose(FFileHandle); - FFileHandle := INVALID_HANDLE_VALUE; - end; -end; - -function TJclFileMappingStream.Write(const Buffer; Count: Integer): Longint; -begin - Result := 0; - if (Size - Position) >= Count then - begin - System.Move(Buffer, Pointer(TJclAddr(Memory) + TJclAddr(Position))^, Count); - Position := Position + Count; - Result := Count; - end; -end; - -{$ENDIF MSWINDOWS} - -//=== { TJclAnsiMappedTextReader } =========================================== - -constructor TJclAnsiMappedTextReader.Create(MemoryStream: TCustomMemoryStream; FreeStream: Boolean; - const AIndexOption: TJclMappedTextReaderIndex); -begin - inherited Create; - FMemoryStream := MemoryStream; - FFreeStream := FreeStream; - FIndexOption := AIndexOption; - Init; -end; - -constructor TJclAnsiMappedTextReader.Create(const FileName: TFileName; - const AIndexOption: TJclMappedTextReaderIndex); -begin - inherited Create; - {$IFDEF MSWINDOWS} - FMemoryStream := TJclFileMappingStream.Create(FileName); - {$ELSE ~ MSWINDOWS} - FMemoryStream := TMemoryStream.Create; - TMemoryStream(FMemoryStream).LoadFromFile(FileName); - {$ENDIF ~ MSWINDOWS} - FFreeStream := True; - FIndexOption := AIndexOption; - Init; -end; - -destructor TJclAnsiMappedTextReader.Destroy; -begin - if FFreeStream then - FMemoryStream.Free; - FreeMem(FIndex); - inherited Destroy; -end; - -procedure TJclAnsiMappedTextReader.AssignTo(Dest: TPersistent); -begin - if Dest is TStrings then - begin - GoBegin; - TStrings(Dest).BeginUpdate; - try - while not Eof do - TStrings(Dest).Add(string(ReadLn)); - finally - TStrings(Dest).EndUpdate; - end; - end - else - inherited AssignTo(Dest); -end; - -procedure TJclAnsiMappedTextReader.CreateIndex; -var - P, LastLineStart: PAnsiChar; - I: Integer; -begin - {$RANGECHECKS OFF} - P := FContent; - I := 0; - LastLineStart := P; - while P < FEnd do - begin - // CRLF, CR, LF and LFCR are seen as valid sets of chars for EOL marker - if CharIsReturn(Char(P^)) then - begin - if I and $FFFF = 0 then - ReallocMem(FIndex, (I + $10000) * SizeOf(Pointer)); - FIndex[I] := LastLineStart; - Inc(I); - - case P^ of - NativeLineFeed: - begin - Inc(P); - if (P < FEnd) and (P^ = NativeCarriageReturn) then - Inc(P); - end; - NativeCarriageReturn: - begin - Inc(P); - if (P < FEnd) and (P^ = NativeLineFeed) then - Inc(P); - end; - end; - LastLineStart := P; - end - else - Inc(P); - end; - if P > LastLineStart then - begin - ReallocMem(FIndex, (I + 1) * SizeOf(Pointer)); - FIndex[I] := LastLineStart; - Inc(I); - end - else - ReallocMem(FIndex, I * SizeOf(Pointer)); - FLineCount := I; - {$IFDEF RANGECHECKS_ON} - {$RANGECHECKS ON} - {$ENDIF RANGECHECKS_ON} -end; - -function TJclAnsiMappedTextReader.GetEof: Boolean; -begin - Result := FPosition >= FEnd; -end; - -function TJclAnsiMappedTextReader.GetAsString: AnsiString; -begin - SetString(Result, Content, Size); -end; - -function TJclAnsiMappedTextReader.GetChars(Index: Integer): AnsiChar; -begin - if (Index < 0) or (Index >= Size) then - raise EJclError.CreateRes(@RsFileIndexOutOfRange); - Result := AnsiChar(PByte(FContent + Index)^); -end; - -function TJclAnsiMappedTextReader.GetLineCount: Integer; -var - P: PAnsiChar; -begin - if FLineCount = -1 then - begin - FLineCount := 0; - if FContent < FEnd then - begin - P := FContent; - while P < FEnd do - begin - case P^ of - NativeLineFeed: - begin - Inc(FLineCount); - Inc(P); - if (P < FEnd) and (P^ = NativeCarriageReturn) then - Inc(P); - end; - NativeCarriageReturn: - begin - Inc(FLineCount); - Inc(P); - if (P < FEnd) and (P^ = NativeLineFeed) then - Inc(P); - end; - else - Inc(P); - end; - end; - if (P = FEnd) and (P > FContent) and not CharIsReturn(Char((P-1)^)) then - Inc(FLineCount); - end; - end; - - Result := FLineCount; -end; - -function TJclAnsiMappedTextReader.GetLines(LineNumber: Integer): AnsiString; -var - P: PAnsiChar; -begin - P := PtrFromLine(LineNumber); - Result := StringFromPosition(P); -end; - -function TJclAnsiMappedTextReader.GetPosition: Integer; -begin - Result := FPosition - FContent; -end; - -procedure TJclAnsiMappedTextReader.GoBegin; -begin - Position := 0; -end; - -procedure TJclAnsiMappedTextReader.Init; -begin - FContent := FMemoryStream.Memory; - FSize := FMemoryStream.Size; - FEnd := FContent + FSize; - FPosition := FContent; - FLineCount := -1; - FLastLineNumber := 0; - FLastPosition := FContent; - if IndexOption = tiFull then - CreateIndex; -end; - -function TJclAnsiMappedTextReader.GetPositionFromLine(LineNumber: Integer): Integer; -var - P: PAnsiChar; -begin - P := PtrFromLine(LineNumber); - if P = nil then - Result := -1 - else - Result := P - FContent; -end; - -function TJclAnsiMappedTextReader.PtrFromLine(LineNumber: Integer): PAnsiChar; -var - LineOffset: Integer; -begin - Result := nil; - {$RANGECHECKS OFF} - if (IndexOption <> tiNoIndex) and (LineNumber < FLineCount) and (FIndex[LineNumber] <> nil) then - Result := FIndex[LineNumber] - {$IFDEF RANGECHECKS_ON} - {$RANGECHECKS ON} - {$ENDIF RANGECHECKS_ON} - else - begin - LineOffset := LineNumber - FLastLineNumber; - if (FLineCount <> -1) and (LineNumber > 0) then - begin - if -LineOffset > LineNumber then - begin - FLastLineNumber := 0; - FLastPosition := FContent; - LineOffset := LineNumber; - end - else - if LineOffset > FLineCount - LineNumber then - begin - FLastLineNumber := FLineCount; - FLastPosition := FEnd; - LineOffset := LineNumber - FLineCount; - end; - end; - if LineNumber <= 0 then - Result := FContent - else - if LineOffset = 0 then - Result := FLastPosition - else - if LineOffset > 0 then - begin - Result := FLastPosition; - while (Result < FEnd) and (LineOffset > 0) do - begin - case Result^ of - NativeLineFeed: - begin - Dec(LineOffset); - Inc(Result); - if (Result < FEnd) and (Result^ = NativeCarriageReturn) then - Inc(Result); - end; - NativeCarriageReturn: - begin - Dec(LineOffset); - Inc(Result); - if (Result < FEnd) and (Result^ = NativeLineFeed) then - Inc(Result); - end; - else - Inc(Result); - end; - end; - end - else - if LineOffset < 0 then - begin - Result := FLastPosition; - while (Result > FContent) and (LineOffset < 1) do - begin - Dec(Result); - case Result^ of - NativeLineFeed: - begin - Inc(LineOffset); - if LineOffset >= 1 then - Inc(Result) - else - if (Result > FContent) and ((Result-1)^ = NativeCarriageReturn) then - Dec(Result); - end; - NativeCarriageReturn: - begin - Inc(LineOffset); - if LineOffset >= 1 then - Inc(Result) - else - if (Result > FContent) and ((Result-1)^ = NativeLineFeed) then - Dec(Result); - end; - end; - end; - end; - FLastLineNumber := LineNumber; - FLastPosition := Result; - end; -end; - -function TJclAnsiMappedTextReader.Read: AnsiChar; -begin - if FPosition >= FEnd then - Result := #0 - else - begin - Result := FPosition^; - Inc(FPosition); - end; -end; - -function TJclAnsiMappedTextReader.ReadLn: AnsiString; -begin - Result := StringFromPosition(FPosition); -end; - -procedure TJclAnsiMappedTextReader.SetPosition(const Value: Integer); -begin - FPosition := FContent + Value; -end; - -function TJclAnsiMappedTextReader.StringFromPosition(var StartPos: PAnsiChar): AnsiString; -var - P: PAnsiChar; -begin - if (StartPos = nil) or (StartPos >= FEnd) then - Result := '' - else - begin - P := StartPos; - while (P < FEnd) and (not CharIsReturn(Char(P^))) do - Inc(P); - SetString(Result, StartPos, P - StartPos); - if P < FEnd then - begin - case P^ of - NativeLineFeed: - begin - Inc(P); - if (P < FEnd) and (P^ = NativeCarriageReturn) then - Inc(P); - end; - NativeCarriageReturn: - begin - Inc(P); - if (P < FEnd) and (P^ = NativeLineFeed) then - Inc(P); - end; - end; - end; - StartPos := P; - end; -end; - -//=== { TJclWideMappedTextReader } =========================================== - -constructor TJclWideMappedTextReader.Create(MemoryStream: TCustomMemoryStream; FreeStream: Boolean; - const AIndexOption: TJclMappedTextReaderIndex); -begin - inherited Create; - FMemoryStream := MemoryStream; - FFreeStream := FreeStream; - FIndexOption := AIndexOption; - Init; -end; - -constructor TJclWideMappedTextReader.Create(const FileName: TFileName; - const AIndexOption: TJclMappedTextReaderIndex); -begin - inherited Create; - {$IFDEF MSWINDOWS} - FMemoryStream := TJclFileMappingStream.Create(FileName); - {$ELSE ~ MSWINDOWS} - FMemoryStream := TMemoryStream.Create; - TMemoryStream(FMemoryStream).LoadFromFile(FileName); - {$ENDIF ~ MSWINDOWS} - FFreeStream := True; - FIndexOption := AIndexOption; - Init; -end; - -destructor TJclWideMappedTextReader.Destroy; -begin - if FFreeStream then - FMemoryStream.Free; - FreeMem(FIndex); - inherited Destroy; -end; - -procedure TJclWideMappedTextReader.AssignTo(Dest: TPersistent); -begin - if Dest is TStrings then - begin - GoBegin; - TStrings(Dest).BeginUpdate; - try - while not Eof do - TStrings(Dest).Add(string(ReadLn)); - finally - TStrings(Dest).EndUpdate; - end; - end - else - inherited AssignTo(Dest); -end; - -procedure TJclWideMappedTextReader.CreateIndex; -var - P, LastLineStart: PWideChar; - I: Integer; -begin - {$RANGECHECKS OFF} - P := FContent; - I := 0; - LastLineStart := P; - while P < FEnd do - begin - // CRLF, CR, LF and LFCR are seen as valid sets of chars for EOL marker - if CharIsReturn(Char(P^)) then - begin - if I and $FFFF = 0 then - ReallocMem(FIndex, (I + $10000) * SizeOf(Pointer)); - FIndex[I] := LastLineStart; - Inc(I); - - case P^ of - NativeLineFeed: - begin - Inc(P); - if (P < FEnd) and (P^ = NativeCarriageReturn) then - Inc(P); - end; - NativeCarriageReturn: - begin - Inc(P); - if (P < FEnd) and (P^ = NativeLineFeed) then - Inc(P); - end; - end; - LastLineStart := P; - end - else - Inc(P); - end; - if P > LastLineStart then - begin - ReallocMem(FIndex, (I + 1) * SizeOf(Pointer)); - FIndex[I] := LastLineStart; - Inc(I); - end - else - ReallocMem(FIndex, I * SizeOf(Pointer)); - FLineCount := I; - {$IFDEF RANGECHECKS_ON} - {$RANGECHECKS ON} - {$ENDIF RANGECHECKS_ON} -end; - -function TJclWideMappedTextReader.GetEof: Boolean; -begin - Result := FPosition >= FEnd; -end; - -function TJclWideMappedTextReader.GetAsString: WideString; -begin - SetString(Result, Content, Size); -end; - -function TJclWideMappedTextReader.GetChars(Index: Integer): WideChar; -begin - if (Index < 0) or (Index >= Size) then - raise EJclError.CreateRes(@RsFileIndexOutOfRange); - Result := WideChar(PByte(FContent + Index)^); -end; - -function TJclWideMappedTextReader.GetLineCount: Integer; -var - P: PWideChar; -begin - if FLineCount = -1 then - begin - FLineCount := 0; - if FContent < FEnd then - begin - P := FContent; - while P < FEnd do - begin - case P^ of - NativeLineFeed: - begin - Inc(FLineCount); - Inc(P); - if (P < FEnd) and (P^ = NativeCarriageReturn) then - Inc(P); - end; - NativeCarriageReturn: - begin - Inc(FLineCount); - Inc(P); - if (P < FEnd) and (P^ = NativeLineFeed) then - Inc(P); - end; - else - Inc(P); - end; - end; - if (P = FEnd) and (P > FContent) and not CharIsReturn(Char((P-1)^)) then - Inc(FLineCount); - end; - end; - - Result := FLineCount; -end; - -function TJclWideMappedTextReader.GetLines(LineNumber: Integer): WideString; -var - P: PWideChar; -begin - P := PtrFromLine(LineNumber); - Result := StringFromPosition(P); -end; - -function TJclWideMappedTextReader.GetPosition: Integer; -begin - Result := FPosition - FContent; -end; - -procedure TJclWideMappedTextReader.GoBegin; -begin - Position := 0; -end; - -procedure TJclWideMappedTextReader.Init; -begin - FContent := FMemoryStream.Memory; - FSize := FMemoryStream.Size; - FEnd := FContent + FSize; - FPosition := FContent; - FLineCount := -1; - FLastLineNumber := 0; - FLastPosition := FContent; - if IndexOption = tiFull then - CreateIndex; -end; - -function TJclWideMappedTextReader.GetPositionFromLine(LineNumber: Integer): Integer; -var - P: PWideChar; -begin - P := PtrFromLine(LineNumber); - if P = nil then - Result := -1 - else - Result := P - FContent; -end; - -function TJclWideMappedTextReader.PtrFromLine(LineNumber: Integer): PWideChar; -var - LineOffset: Integer; -begin - Result := nil; - {$RANGECHECKS OFF} - if (IndexOption <> tiNoIndex) and (LineNumber < FLineCount) and (FIndex[LineNumber] <> nil) then - Result := FIndex[LineNumber] - {$IFDEF RANGECHECKS_ON} - {$RANGECHECKS ON} - {$ENDIF RANGECHECKS_ON} - else - begin - LineOffset := LineNumber - FLastLineNumber; - if (FLineCount <> -1) and (LineNumber > 0) then - begin - if -LineOffset > LineNumber then - begin - FLastLineNumber := 0; - FLastPosition := FContent; - LineOffset := LineNumber; - end - else - if LineOffset > FLineCount - LineNumber then - begin - FLastLineNumber := FLineCount; - FLastPosition := FEnd; - LineOffset := LineNumber - FLineCount; - end; - end; - if LineNumber <= 0 then - Result := FContent - else - if LineOffset = 0 then - Result := FLastPosition - else - if LineOffset > 0 then - begin - Result := FLastPosition; - while (Result < FEnd) and (LineOffset > 0) do - begin - case Result^ of - NativeLineFeed: - begin - Dec(LineOffset); - Inc(Result); - if (Result < FEnd) and (Result^ = NativeCarriageReturn) then - Inc(Result); - end; - NativeCarriageReturn: - begin - Dec(LineOffset); - Inc(Result); - if (Result < FEnd) and (Result^ = NativeLineFeed) then - Inc(Result); - end; - else - Inc(Result); - end; - end; - end - else - if LineOffset < 0 then - begin - Result := FLastPosition; - while (Result > FContent) and (LineOffset < 1) do - begin - Dec(Result); - case Result^ of - NativeLineFeed: - begin - Inc(LineOffset); - if LineOffset >= 1 then - Inc(Result) - else - if (Result > FContent) and ((Result-1)^ = NativeCarriageReturn) then - Dec(Result); - end; - NativeCarriageReturn: - begin - Inc(LineOffset); - if LineOffset >= 1 then - Inc(Result) - else - if (Result > FContent) and ((Result-1)^ = NativeLineFeed) then - Dec(Result); - end; - end; - end; - end; - FLastLineNumber := LineNumber; - FLastPosition := Result; - end; -end; - -function TJclWideMappedTextReader.Read: WideChar; -begin - if FPosition >= FEnd then - Result := #0 - else - begin - Result := FPosition^; - Inc(FPosition); - end; -end; - -function TJclWideMappedTextReader.ReadLn: WideString; -begin - Result := StringFromPosition(FPosition); -end; - -procedure TJclWideMappedTextReader.SetPosition(const Value: Integer); -begin - FPosition := FContent + Value; -end; - -function TJclWideMappedTextReader.StringFromPosition(var StartPos: PWideChar): WideString; -var - P: PWideChar; -begin - if (StartPos = nil) or (StartPos >= FEnd) then - Result := '' - else - begin - P := StartPos; - while (P < FEnd) and (not CharIsReturn(Char(P^))) do - Inc(P); - SetString(Result, StartPos, P - StartPos); - if P < FEnd then - begin - case P^ of - NativeLineFeed: - begin - Inc(P); - if (P < FEnd) and (P^ = NativeCarriageReturn) then - Inc(P); - end; - NativeCarriageReturn: - begin - Inc(P); - if (P < FEnd) and (P^ = NativeLineFeed) then - Inc(P); - end; - end; - end; - StartPos := P; - end; -end; - -function CharIsDriveLetter(const C: Char): Boolean; -begin - case C of - 'a'..'z', - 'A'..'Z': - Result := True; - else - Result := False; - end; -end; - -//=== Path manipulation ====================================================== - -function PathAddSeparator(const Path: string): string; -begin - Result := Path; - if (Path = '') or (Path[Length(Path)] <> DirDelimiter) then - Result := Path + DirDelimiter; -end; - -function PathAddExtension(const Path, Extension: string): string; -begin - Result := Path; - // (obones) Extension may not contain the leading dot while ExtractFileExt - // always returns it. Hence the need to use StrEnsurePrefix for the SameText - // test to return an accurate value. - if (Path <> '') and (Extension <> '') and - not SameText(ExtractFileExt(Path), StrEnsurePrefix('.', Extension)) then - begin - if Path[Length(Path)] = '.' then - Delete(Result, Length(Path), 1); - if Extension[1] = '.' then - Result := Result + Extension - else - Result := Result + '.' + Extension; - end; -end; - -function PathAppend(const Path, Append: string): string; -var - PathLength: Integer; - B1, B2: Boolean; -begin - if Append = '' then - Result := Path - else - begin - PathLength := Length(Path); - if PathLength = 0 then - Result := Append - else - begin - // The following code may look a bit complex but all it does is add Append to Path ensuring - // that there is one and only one path separator character between them - B1 := Path[PathLength] = DirDelimiter; - B2 := Append[1] = DirDelimiter; - if B1 and B2 then - Result := Copy(Path, 1, PathLength - 1) + Append - else - begin - if not (B1 or B2) then - Result := Path + DirDelimiter + Append - else - Result := Path + Append; - end; - end; - end; -end; - -function PathBuildRoot(const Drive: Byte): string; -begin - {$IFDEF UNIX} - Result := DirDelimiter; - {$ENDIF UNIX} - {$IFDEF MSWINDOWS} - // Remember, Win32 only allows 'a' to 'z' as drive letters (mapped to 0..25) - if Drive < 26 then - Result := Char(Drive + 65) + ':\' - else - raise EJclPathError.CreateResFmt(@RsPathInvalidDrive, [IntToStr(Drive)]); - {$ENDIF MSWINDOWS} -end; - -function PathCanonicalize(const Path: string): string; -var - List: TStringList; - S: string; - I, K: Integer; - IsAbsolute: Boolean; -begin - I := Pos(':', Path); // for Windows' sake - K := Pos(DirDelimiter, Path); - IsAbsolute := K - I = 1; - if IsAbsolute then begin - if Copy(Path, 1, Length(PathUncPrefix)) = PathUncPrefix then // UNC path - K := 2; - end else - K := I; - if K = 0 then - S := Path - else - S := Copy(Path, K + 1, Length(Path)); - List := TStringList.Create; - try - StrIToStrings(S, DirDelimiter, List, True); - I := 0; - while I < List.Count do - begin - if List[I] = '.' then - List.Delete(I) - else - if (IsAbsolute or (I > 0) and not (List[I-1] = '..')) and (List[I] = '..') then - begin - List.Delete(I); - if I > 0 then - begin - Dec(I); - List.Delete(I); - end; - end - else Inc(I); - end; - Result := StringsToStr(List, DirDelimiter, True); - finally - List.Free; - end; - if K > 0 then - Result := Copy(Path, 1, K) + Result - else - if Result = '' then - Result := '.'; -end; - -function PathCommonPrefix(const Path1, Path2: string): Integer; -var - Index1, Index2: Integer; - LastSeparator, LenS1: Integer; - S1, S2: string; -begin - Result := 0; - if (Path1 <> '') and (Path2 <> '') then - begin - // Initialize P1 to the shortest of the two paths so that the actual comparison loop below can - // use the terminating #0 of that string to terminate the loop. - if Length(Path1) <= Length(Path2) then - begin - S1 := Path1; - S2 := Path2; - end - else - begin - S1 := Path2; - S2 := Path1; - end; - Index1 := 1; - Index2 := 1; - LenS1 := Length(S1); - LastSeparator := 0; - while (S1[Index1] = S2[Index2]) and (Index1 <= LenS1) do - begin - Inc(Result); - if (S1[Index1] = DirDelimiter) or (S1[Index1] = ':') then - LastSeparator := Result; - Inc(Index1); - Inc(Index2); - end; - if (LastSeparator < Result) and (Index1 <= LenS1) then - Result := LastSeparator; - end; -end; - -{$IFDEF MSWINDOWS} -function PathCompactPath(const DC: HDC; const Path: string; - const Width: Integer; CmpFmt: TCompactPath): string; -const - Compacts: array [TCompactPath] of Cardinal = (DT_PATH_ELLIPSIS, DT_END_ELLIPSIS); -var - TextRect: TRect; - Fmt: Cardinal; -begin - Result := ''; - if (DC <> 0) and (Path <> '') and (Width > 0) then - begin - { Here's a note from the Platform SDK to explain the + 5 in the call below: - "If dwDTFormat includes DT_MODIFYSTRING, the function could add up to four additional characters - to this string. The buffer containing the string should be large enough to accommodate these - extra characters." } - SetString(Result, PChar(Path), Length(Path) + 4); - TextRect := Rect(0, 0, Width, 255); - Fmt := DT_MODIFYSTRING or DT_CALCRECT or Compacts[CmpFmt]; - if DrawTextEx(DC, PChar(Result), -1, TextRect, Fmt, nil) <> 0 then - StrResetLength(Result) - else - Result := ''; // in case of error - end; -end; -{$ENDIF MSWINDOWS} - -procedure PathExtractElements(const Source: string; var Drive, Path, FileName, Ext: string); -begin - Drive := ExtractFileDrive(Source); - Path := ExtractFilePath(Source); - // Path includes drive so remove that - if Drive <> '' then - Delete(Path, 1, Length(Drive)); - // add/remove separators - Drive := PathAddSeparator(Drive); - Path := PathRemoveSeparator(Path); - if (Path <> '') and (Path[1] = DirDelimiter) then - Delete(Path, 1, 1); - // and extract the remaining elements - FileName := PathExtractFileNameNoExt(Source); - Ext := ExtractFileExt(Source); -end; - -function PathExtractFileDirFixed(const S: string): string; -begin - Result := PathAddSeparator(ExtractFileDir(S)); -end; - -function PathExtractFileNameNoExt(const Path: string): string; -begin - Result := PathRemoveExtension(ExtractFileName(Path)); -end; - -function PathExtractPathDepth(const Path: string; Depth: Integer): string; -var - List: TStringList; - LocalPath: string; - I: Integer; -begin - List := TStringList.Create; - try - if IsDirectory(Path) then - LocalPath := Path - else - LocalPath := ExtractFilePath(Path); - StrIToStrings(LocalPath, DirDelimiter, List, True); - I := Depth + 1; - if PathIsUNC(LocalPath) then - I := I + 2; - while I < List.Count do - List.Delete(I); - Result := PathAddSeparator(StringsToStr(List, DirDelimiter, True)); - finally - List.Free; - end; -end; - -// Notes: maybe this function should first apply PathCanonicalize() ? - -function PathGetDepth(const Path: string): Integer; -var - List: TStringList; - LocalPath: string; - I, Start: Integer; -begin - Result := 0; - List := TStringList.Create; - try - if IsDirectory(Path) then - LocalPath := Path - else - LocalPath := ExtractFilePath(Path); - StrIToStrings(LocalPath, DirDelimiter, List, False); - if PathIsUNC(LocalPath) then - Start := 1 - else - Start := 0; - for I := Start to List.Count - 1 do - begin - if Pos(':', List[I]) = 0 then - Inc(Result); - end; - finally - List.Free; - end; -end; - -{$IFDEF MSWINDOWS} - -function ShellGetLongPathName(const Path: string): string; -{$IFDEF FPC} -// As of 2004-10-17, FPC's ShlObj unit is just a dummy -begin - Result := Path; -end; -{$ElSE ~FPC} -var - PIDL: PItemIDList; - Desktop: IShellFolder; - {$IFNDEF SUPPORTS_UNICODE} - AnsiName: string; - WideName: array [0..MAX_PATH] of WideChar; - {$ENDIF ~SUPPORTS_UNICODE} - Eaten, Attr: ULONG; // both unused but API requires them (incorrect translation) -begin - Result := Path; - if Path <> '' then - begin - if Succeeded(SHGetDesktopFolder(Desktop)) then - begin - {$IFDEF SUPPORTS_UNICODE} - if Succeeded(Desktop.ParseDisplayName(0, nil, PChar(Path), Eaten, PIDL, Attr)) then - try - SetLength(Result, MAX_PATH); - if SHGetPathFromIDList(PIDL, PChar(Result)) then - StrResetLength(Result); - finally - CoTaskMemFree(PIDL); - end; - {$ELSE ~SUPPORTS_UNICODE} - MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PAnsiChar(Path), -1, WideName, MAX_PATH); - if Succeeded(Desktop.ParseDisplayName(0, nil, WideName, Eaten, PIDL, Attr)) then - try - SetLength(AnsiName, MAX_PATH); - if SHGetPathFromIDList(PIDL, PChar(AnsiName)) then - StrResetLength(AnsiName); - Result := AnsiName; - finally - CoTaskMemFree(PIDL); - end; - {$ENDIF ~SUPPORTS_UNICODE} - end; - end; -end; -{$ENDIF ~FPC} - -{ TODO : Move RTDL code over to JclWin32 when JclWin32 gets overhauled. } -var - _Kernel32Handle: TModuleHandle = INVALID_MODULEHANDLE_VALUE; - _GetLongPathName: function (lpszShortPath: PChar; lpszLongPath: PChar; - cchBuffer: DWORD): DWORD; stdcall; - -function Kernel32Handle: HMODULE; -begin - JclSysUtils.LoadModule(_Kernel32Handle, kernel32); - Result := _Kernel32Handle; -end; - -function RtdlGetLongPathName(const Path: string): string; -begin - Result := Path; - if not Assigned(_GetLongPathName) then - _GetLongPathName := GetModuleSymbol(Kernel32Handle, 'GetLongPathName' + AWSuffix); - if not Assigned(_GetLongPathName) then - Result := ShellGetLongPathName(Path) - else - begin - SetLength(Result, MAX_PATH); - SetLength(Result, _GetLongPathName(PChar(Path), PChar(Result), MAX_PATH)); - end; -end; - -function PathGetLongName(const Path: string): string; -begin - if Pos('::', Path) > 0 then // Path contains '::{}' - Result := ShellGetLongPathName(Path) - else - Result := RtdlGetLongPathName(Path); - - if Result = '' then - Result := Path; -end; - -function PathGetShortName(const Path: string): string; -var - Required: Integer; -begin - Result := Path; - Required := GetShortPathName(PChar(Path), nil, 0); - if Required <> 0 then - begin - SetLength(Result, Required); - Required := GetShortPathName(PChar(Path), PChar(Result), Required); - if (Required <> 0) and (Required = Length(Result) - 1) then - SetLength(Result, Required) - else - Result := Path; - end; -end; - -{$ENDIF MSWINDOWS} - -function PathGetRelativePath(Origin, Destination: string): string; -var - {$IFDEF MSWINDOWS} - OrigDrive: string; - DestDrive: string; - {$ENDIF MSWINDOWS} - OrigList: TStringList; - DestList: TStringList; - DiffIndex: Integer; - I: Integer; - - function StartsFromRoot(const Path: string): Boolean; - {$IFDEF MSWINDOWS} - var - I: Integer; - begin - I := Length(ExtractFileDrive(Path)); - Result := (Length(Path) > I) and (Path[I + 1] = DirDelimiter); - end; - {$ELSE ~MSWINDOWS} - begin - Result := Pos(DirDelimiter, Path) = 1; - end; - {$ENDIF ~MSWINDOWS} - - function Equal(const Path1, Path2: string): Boolean; - begin - {$IFDEF MSWINDOWS} // case insensitive - Result := StrSame(Path1, Path2); - {$ELSE ~MSWINDOWS} // case sensitive - Result := Path1 = Path2; - {$ENDIF ~MSWINDOWS} - end; - -begin - Origin := PathCanonicalize(Origin); - Destination := PathCanonicalize(Destination); - {$IFDEF MSWINDOWS} - OrigDrive := ExtractFileDrive(Origin); - DestDrive := ExtractFileDrive(Destination); - {$ENDIF MSWINDOWS} - if Equal(Origin, Destination) or (Destination = '') then - Result := '.' - else - if Origin = '' then - Result := Destination - else - {$IFDEF MSWINDOWS} - if (DestDrive <> '') and ((OrigDrive = '') or ((OrigDrive <> '') and not Equal(OrigDrive, DestDrive))) then - Result := Destination - else - if (OrigDrive <> '') and (Pos(DirDelimiter, Destination) = 1) - and not Equal(PathUncPrefix,Copy(Destination,1,Length(PathUncPrefix))) then - Result := OrigDrive + Destination // prepend drive part from Origin - else - {$ENDIF MSWINDOWS} - if StartsFromRoot(Origin) and not StartsFromRoot(Destination) then - Result := StrEnsureSuffix(DirDelimiter, Origin) + - StrEnsureNoPrefix(DirDelimiter, Destination) - else - begin - // create a list of paths as separate strings - OrigList := TStringList.Create; - DestList := TStringList.Create; - try - // NOTE: DO NOT USE DELIMITER AND DELIMITEDTEXT FROM - // TSTRINGS, THEY WILL SPLIT PATHS WITH SPACES !!!! - StrToStrings(Origin, DirDelimiter, OrigList, False); - StrToStrings(Destination, DirDelimiter, DestList, False); - begin - // find the first directory that is not the same - DiffIndex := OrigList.Count; - if DestList.Count < DiffIndex then - DiffIndex := DestList.Count; - for I := 0 to DiffIndex - 1 do - if not Equal(OrigList[I], DestList[I]) then - begin - DiffIndex := I; - Break; - end; - Result := StrRepeat('..' + DirDelimiter, OrigList.Count - DiffIndex); - Result := PathRemoveSeparator(Result); - for I := DiffIndex to DestList.Count - 1 do - begin - if Result <> '' then - Result := Result + DirDelimiter; - Result := Result + DestList[i]; - end; - end; - finally - DestList.Free; - OrigList.Free; - end; - end; -end; - -function PathGetTempPath: string; -{$IFDEF MSWINDOWS} -var - BufSize: Cardinal; -begin - BufSize := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetTempPath(0, nil); - SetLength(Result, BufSize); - { TODO : Check length (-1 or not) } - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetTempPath(BufSize, PChar(Result)); - StrResetLength(Result); -end; -{$ENDIF MSWINDOWS} -{$IFDEF UNIX} -begin - Result := GetEnvironmentVariable('TMPDIR'); -end; -{$ENDIF UNIX} - -function PathIsAbsolute(const Path: string): Boolean; -{$IFDEF MSWINDOWS} -var - I: Integer; -{$ENDIF MSWINDOWS} -begin - Result := False; - if Path <> '' then - begin - {$IFDEF UNIX} - Result := (Path[1] = DirDelimiter); - {$ENDIF UNIX} - {$IFDEF MSWINDOWS} - if not PathIsUnc(Path) then - begin - I := 0; - if PathIsDiskDevice(Path) then - I := Length(PathDevicePrefix); - Result := (Length(Path) > I + 2) and CharIsDriveLetter(Path[I + 1]) and - (Path[I + 2] = ':') and (Path[I + 3] = DirDelimiter); - end - else - Result := True; - {$ENDIF MSWINDOWS} - end; -end; - -function PathIsChild(const Path, Base: string): Boolean; -var - L: Integer; - B, P: string; -begin - Result := False; - B := PathRemoveSeparator(Base); - P := PathRemoveSeparator(Path); - // an empty path or one that's not longer than base cannot be a subdirectory - L := Length(B); - if (P = '') or (L >= Length(P)) then - Exit; - {$IFDEF MSWINDOWS} - Result := AnsiSameText(StrLeft(P, L), B) and (P[L+1] = DirDelimiter); - {$ENDIF MSWINDOWS} - {$IFDEF UNIX} - Result := AnsiSameStr(StrLeft(P, L), B) and (P[L+1] = DirDelimiter); - {$ENDIF UNIX} -end; - -function PathIsEqualOrChild(const Path, Base: string): Boolean; -var - L: Integer; - B, P: string; -begin - B := PathRemoveSeparator(Base); - P := PathRemoveSeparator(Path); - // an empty path or one that's not longer than base cannot be a subdirectory - L := Length(B); - {$IFDEF MSWINDOWS} - Result := AnsiSameText(P, B); - {$ENDIF MSWINDOWS} - {$IFDEF UNIX} - Result := AnsiSameStr(P, B); - {$ENDIF UNIX} - if Result or (P = '') or (L >= Length(P)) then - Exit; - {$IFDEF MSWINDOWS} - Result := AnsiSameText(StrLeft(P, L), B) and (P[L+1] = DirDelimiter); - {$ENDIF MSWINDOWS} - {$IFDEF UNIX} - Result := AnsiSameStr(StrLeft(P, L), B) and (P[L+1] = DirDelimiter); - {$ENDIF UNIX} -end; - -function PathIsDiskDevice(const Path: string): Boolean; -{$IFDEF UNIX} -var - FullPath: string; - F: PIOFile; - Buffer: array [0..255] of AnsiChar; - MountEntry: TMountEntry; - FsTypes: TStringList; - - procedure GetAvailableFileSystems(const List: TStrings); - var - F: TextFile; - S: string; - begin - AssignFile(F, '/proc/filesystems'); - Reset(F); - repeat - Readln(F, S); - if Pos('nodev', S) = 0 then // how portable is this ? - List.Add(Trim(S)); - until Eof(F); - List.Add('supermount'); - CloseFile(F); - end; - -begin - Result := False; - - SetLength(FullPath, _POSIX_PATH_MAX); - if realpath(PChar(Path), PChar(FullPath)) = nil then - RaiseLastOSError; - StrResetLength(FullPath); - - FsTypes := TStringList.Create; - try - GetAvailableFileSystems(FsTypes); - F := setmntent(_PATH_MOUNTED, 'r'); // PATH_MOUNTED is deprecated, - // but PATH_MNTTAB is defective in Libc.pas - try - // get drives from mtab - while not Result and (getmntent_r(F, MountEntry, Buffer, SizeOf(Buffer)) <> nil) do - if FsTypes.IndexOf(MountEntry.mnt_type) <> -1 then - Result := MountEntry.mnt_dir = FullPath; - - finally - endmntent(F); - end; - finally - FsTypes.Free; - end; -end; -{$ENDIF UNIX} -{$IFDEF MSWINDOWS} -begin - Result := Copy(Path, 1, Length(PathDevicePrefix)) = PathDevicePrefix; -end; -{$ENDIF MSWINDOWS} - -function CharIsMachineName(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -begin - case C of - 'a'..'z', - 'A'..'Z', - '-', '_', '.': - Result := True; - else - Result := False; - end; -end; - -function CharIsInvalidFileNameCharacter(const C: Char): Boolean; -begin - case C of - '<', '>', '?', '/', '\', ',', '*', '+', '=', '[', ']', '|', ':', ';', '"', '''': - Result := True; - else - Result := False; - end; -end; - -function CharIsInvalidPathCharacter(const C: Char): Boolean; -begin - case C of - '<', '>', '?', - {$IFDEF UNIX} - '/', - {$ELSE} - '\', - {$ENDIF} - ',', '*', '+', '=', '[', ']', '|', ':', ';', '"', '''': - Result := True; - else - Result := False; - end; -end; - -function PathIsUNC(const Path: string): Boolean; - -{$IFDEF MSWINDOWS} - -const - cUNCSuffix = '?\UNC'; - -var - P: PChar; - - function AbsorbSeparator: Boolean; - begin - Result := (P <> nil) and (P^ = DirDelimiter); - if Result then - Inc(P); - end; - - function AbsorbMachineName: Boolean; - var - NonDigitFound: Boolean; - begin - // a valid machine name is a string composed of the set [a-z, A-Z, 0-9, -, _] but it may not - // consist entirely out of numbers - Result := True; - NonDigitFound := False; - while (P^ <> #0) and (P^ <> DirDelimiter) do - begin - if CharIsMachineName(P^) then - begin - NonDigitFound := True; - Inc(P); - end - else - if CharIsDigit(P^) then - Inc(P) - else - begin - Result := False; - Break; - end; - end; - Result := Result and NonDigitFound; - end; - - function AbsorbShareName: Boolean; - begin - // a valid share name is a string composed of a set the set !InvalidCharacters note that a - // leading '$' is valid (indicates a hidden share) - Result := True; - while (P^ <> #0) and (P^ <> DirDelimiter) do - begin - if CharIsInvalidPathCharacter(P^) then - begin - Result := False; - Break; - end; - Inc(P); - end; - end; - -begin - Result := Copy(Path, 1, Length(PathUncPrefix)) = PathUncPrefix; - if Result then - begin - if Copy(Path, 1, Length(PathUncPrefix + cUNCSuffix)) = PathUncPrefix + cUNCSuffix then - P := @Path[Length(PathUncPrefix + cUNCSuffix)] - else - begin - P := @Path[Length(PathUncPrefix)]; - Result := AbsorbSeparator and AbsorbMachineName; - end; - Result := Result and AbsorbSeparator; - if Result then - begin - Result := AbsorbShareName; - // remaining, if anything, is path and or filename (optional) check those? - end; - end; -end; - -{$ENDIF MSWINDOWS} - -{$IFDEF UNIX} - -begin - Result := False; -end; - -{$ENDIF UNIX} - -function PathRemoveSeparator(const Path: string): string; -var - L: Integer; -begin - L := Length(Path); - if (L <> 0) and (Path[L] = DirDelimiter) then - Result := Copy(Path, 1, L - 1) - else - Result := Path; -end; - -function PathRemoveExtension(const Path: string): string; -var - I: Integer; -begin - I := LastDelimiter(':.' + DirDelimiter, Path); - if (I > 0) and (Path[I] = '.') then - Result := Copy(Path, 1, I - 1) - else - Result := Path; -end; - -{$IFDEF MSWINDOWS} - -function SHGetDisplayName(ShellFolder: IShellFolder; PIDL: PItemIDList; ForParsing: Boolean): string; -const - Flags: array[Boolean] of DWORD = (SHGDN_NORMAL, SHGDN_FORPARSING); -var - StrRet: TStrRet; - P: PChar; -begin - Result := ''; - StrRet.utype := 0; - - ShellFolder.GetDisplayNameOf(PIDL, Flags[ForParsing], StrRet); - case StrRet.uType of - STRRET_CSTR: - SetString(Result, StrRet.cStr, lstrlenA(StrRet.cStr)); - STRRET_OFFSET: - begin - P := @PIDL.mkid.abID[StrRet.uOffset - SizeOf(PIDL.mkid.cb)]; - SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset); - end; - STRRET_WSTR: - Result := StrRet.pOleStr; - end; - Result := Copy(Result, 1, lstrlen(PChar(Result))); -end; - -function CutFirstDirectory(var Path: string): string; -var - ps: Integer; -begin - ps := AnsiPos(DirDelimiter, Path); - if ps > 0 then - begin - Result := Copy(Path, 1, ps - 1); - Path := Copy(Path, ps + 1, Length(Path)); - end - else - begin - Result := Path; - Path := ''; - end; -end; - -function PathGetPhysicalPath(const LocalizedPath: string): string; -var - Malloc: IMalloc; - DesktopFolder: IShellFolder; - RootFolder: IShellFolder; - Eaten: Cardinal; - Attributes: Cardinal; - pidl: PItemIDList; - EnumIDL: IEnumIDList; - Drive: WideString; - Featched: Cardinal; - ParsePath: WideString; - Path, Name: string; - Found: Boolean; -begin - if StrCompareRange('\\', LocalizedPath, 1, 2) = 0 then - begin - Result := LocalizedPath; - Exit; - end; - - Drive := ExtractFileDrive(LocalizedPath); - if Drive = '' then - begin - Result := LocalizedPath; - Exit; - end; - Path := Copy(LocalizedPath, Length(Drive) + 2, Length(LocalizedPath)); - ParsePath := Drive; - OLECheck( SHGetMalloc(Malloc) ); - OleCheck( SHGetDesktopFolder(DesktopFolder) ); - while Path <> '' do - begin - Name := CutFirstDirectory(Path); - Found := False; - pidl := nil; - Attributes := 0; - if Succeeded( DesktopFolder.ParseDisplayName(0, nil, PWideChar(ParsePath), Eaten, pidl, Attributes) ) then - begin - OleCheck( DesktopFolder.BindToObject(pidl, nil, IShellFolder, RootFolder) ); - Malloc.Free(pidl); - - OleCheck( RootFolder.EnumObjects(0, SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN, EnumIDL) ); - Featched := 0; - while EnumIDL.Next(1, pidl, Featched) = NOERROR do - begin - if AnsiCompareText(Name, SHGetDisplayName(RootFolder, pidl, False)) = 0 then - begin - ParsePath := SHGetDisplayName(RootFolder, pidl, True); - Malloc.Free(pidl); - Found := True; - Break; - end; - Malloc.Free(pidl); - end; - EnumIDL := nil; - RootFolder := nil; - end; - if not Found then - ParsePath := ParsePath + DirDelimiter + Name; - end; - Result := ParsePath; -end; - -function PathGetLocalizedPath(const PhysicalPath: string): string; -var - Malloc: IMalloc; - DesktopFolder: IShellFolder; - RootFolder: IShellFolder; - Eaten: Cardinal; - Attributes: Cardinal; - pidl: PItemIDList; - EnumIDL: IEnumIDList; - Drive: WideString; - Featched: Cardinal; - ParsePath: WideString; - Path, Name, ParseName, DisplayName: string; - Found: Boolean; -begin - if StrCompareRange('\\', PhysicalPath, 1, 2) = 0 then - begin - Result := PhysicalPath; - Exit; - end; - - Drive := ExtractFileDrive(PhysicalPath); - if Drive = '' then - begin - Result := PhysicalPath; - Exit; - end; - Path := Copy(PhysicalPath, Length(Drive) + 2, Length(PhysicalPath)); - ParsePath := Drive; - Result := Drive; - OLECheck( SHGetMalloc(Malloc) ); - OleCheck( SHGetDesktopFolder(DesktopFolder) ); - while Path <> '' do - begin - Name := CutFirstDirectory(Path); - Found := False; - pidl := nil; - Attributes := 0; - if Succeeded( DesktopFolder.ParseDisplayName(0, nil, PWideChar(ParsePath), Eaten, pidl, Attributes) ) then - begin - OleCheck( DesktopFolder.BindToObject(pidl, nil, IShellFolder, RootFolder) ); - Malloc.Free(pidl); - - OleCheck( RootFolder.EnumObjects(0, SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN, EnumIDL) ); - Featched := 0; - while EnumIDL.Next(1, pidl, Featched) = NOERROR do - begin - ParseName := SHGetDisplayName(RootFolder, pidl, True); - DisplayName := SHGetDisplayName(RootFolder, pidl, False); - Malloc.Free(pidl); - if (AnsiCompareText(Name, ExtractFileName(ParseName)) = 0) or - (AnsiCompareText(Name, DisplayName) = 0) then - begin - Name := DisplayName; - ParsePath := ParseName; - Found := True; - Break; - end; - end; - EnumIDL := nil; - RootFolder := nil; - end; - Result := Result + DirDelimiter + Name; - if not Found then - ParsePath := ParsePath + DirDelimiter + Name; - end; -end; - -{$ELSE ~MSWINDOWS} -function PathGetPhysicalPath(const LocalizedPath: string): string; -begin - Result := LocalizedPath; -end; - -function PathGetLocalizedPath(const PhysicalPath: string): string; -begin - Result := PhysicalPath; -end; -{$ENDIF ~MSWINDOWS} - -//=== Files and Directories ================================================== - - -{* Extended version of JclFileUtils.BuildFileList: - function parameter Path can include multiple FileMasks as: - c:\aaa\*.pas; pro*.dpr; *.d?? - FileMask Seperator = ';' - *} - -function BuildFileList(const Path: string; const Attr: Integer; const List: TStrings; IncludeDirectoryName: Boolean = - False): Boolean; -var - SearchRec: TSearchRec; - IndexMask: Integer; - MaskList: TStringList; - Masks, Directory: string; -begin - Assert(List <> nil); - MaskList := TStringList.Create; - try - {* extract the Directory *} - Directory := ExtractFileDir(Path); - - {* files can be searched in the current directory *} - if Directory <> '' then - begin - Directory := PathAddSeparator(Directory); - {* extract the FileMasks portion out of Path *} - Masks := StrAfter(Directory, Path); - end - else - Masks := Path; - - {* put the Masks into TStringlist *} - StrTokenToStrings(Masks, DirSeparator, MaskList); - - {* search all files in the directory *} - Result := FindFirst(Directory + '*', faAnyFile, SearchRec) = 0; - - List.BeginUpdate; - try - while Result do - begin - {* if the filename matches any mask then it is added to the list *} - for IndexMask := 0 to MaskList.Count - 1 do - if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') - and ((SearchRec.Attr and Attr) = (SearchRec.Attr and faAnyFile)) - and IsFileNameMatch(SearchRec.Name, MaskList.Strings[IndexMask]) then - begin - if IncludeDirectoryName then - List.Add(Directory+SearchRec.Name) - else - List.Add(SearchRec.Name); - Break; - end; - - case FindNext(SearchRec) of - 0: - ; - ERROR_NO_MORE_FILES: - Break; - else - Result := False; - end; - end; - finally - {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindClose(SearchRec); - List.EndUpdate; - end; - finally - MaskList.Free; - end; -end; - -{$IFDEF MSWINDOWS} - -procedure CreateEmptyFile(const FileName: string); -var - Handle: THandle; -begin - Handle := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE, 0, nil, CREATE_ALWAYS, 0, 0); - if Handle <> INVALID_HANDLE_VALUE then - CloseHandle(Handle) - else - RaiseLastOSError; -end; -{$ENDIF MSWINDOWS} - -{$IFDEF MSWINDOWS} - -function CloseVolume(var Volume: THandle): Boolean; -begin - Result := False; - if Volume <> INVALID_HANDLE_VALUE then - begin - Result := CloseHandle(Volume); - if Result then - Volume := INVALID_HANDLE_VALUE; - end; -end; - -{$IFNDEF FPC} // needs JclShell - -function DeleteDirectory(const DirectoryName: string; MoveToRecycleBin: Boolean): Boolean; -begin - if MoveToRecycleBin then - Result := SHDeleteFolder(0, DirectoryName, [doSilent, doAllowUndo]) - else - Result := DelTree(DirectoryName); -end; - -function CopyDirectory(ExistingDirectoryName, NewDirectoryName: string): Boolean; -var - SH: SHFILEOPSTRUCT; -begin - ResetMemory(SH, SizeOf(SH)); - SH.Wnd := 0; - SH.wFunc := FO_COPY; - SH.pFrom := PChar(PathRemoveSeparator(ExistingDirectoryName) + #0); - SH.pTo := PChar(PathRemoveSeparator(NewDirectoryName) + #0); - SH.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR or FOF_SILENT; - Result := SHFileOperation(SH) = 0; -end; - -function MoveDirectory(ExistingDirectoryName, NewDirectoryName: string): Boolean; -var - SH: SHFILEOPSTRUCT; -begin - ResetMemory(SH, SizeOf(SH)); - SH.Wnd := 0; - SH.wFunc := FO_MOVE; - SH.pFrom := PChar(PathRemoveSeparator(ExistingDirectoryName) + #0); - SH.pTo := PChar(PathRemoveSeparator(NewDirectoryName) + #0); - SH.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR or FOF_SILENT; - Result := SHFileOperation(SH) = 0; -end; - -{$ENDIF ~FPC} - -function DelTree(const Path: string): Boolean; -begin - Result := DelTreeEx(Path, False, nil); -end; - -function DelTreeEx(const Path: string; AbortOnFailure: Boolean; Progress: TDelTreeProgress): Boolean; -var - Files: TStringList; - LPath: string; // writable copy of Path - FileName: string; - I: Integer; - PartialResult: Boolean; - Attr: DWORD; -begin - Assert(Path <> '', LoadResString(@RsDelTreePathIsEmpty)); - {$IFNDEF ASSERTIONS_ON} - if Path = '' then - begin - Result := False; - Exit; - end; - {$ENDIF ~ASSERTIONS_ON} - Result := True; - Files := TStringList.Create; - try - LPath := PathRemoveSeparator(Path); - BuildFileList(LPath + '\*.*', faAnyFile, Files); - for I := 0 to Files.Count - 1 do - begin - FileName := LPath + DirDelimiter + Files[I]; - PartialResult := True; - // If the current file is itself a directory then recursively delete it - Attr := GetFileAttributes(PChar(FileName)); - if (Attr <> DWORD(-1)) and ((Attr and FILE_ATTRIBUTE_DIRECTORY) <> 0) then - PartialResult := DelTreeEx(FileName, AbortOnFailure, Progress) - else - begin - if Assigned(Progress) then - PartialResult := Progress(FileName, Attr); - if PartialResult then - begin - // Set attributes to normal in case it's a readonly file - PartialResult := SetFileAttributes(PChar(FileName), FILE_ATTRIBUTE_NORMAL); - if PartialResult then - PartialResult := DeleteFile(FileName); - end; - end; - if not PartialResult then - begin - Result := False; - if AbortOnFailure then - Break; - end; - end; - finally - FreeAndNil(Files); - end; - if Result then - begin - // Finally remove the directory itself - Result := SetFileAttributes(PChar(LPath), FILE_ATTRIBUTE_NORMAL); - if Result then - begin - {$IOCHECKS OFF} - RmDir(LPath); - {$IFDEF IOCHECKS_ON} - {$IOCHECKS ON} - {$ENDIF IOCHECKS_ON} - Result := IOResult = 0; - end; - end; -end; - -{$ENDIF MSWINDOWS} - -{$IFDEF MSWINDOWS} -function DirectoryExists(const Name: string): Boolean; -var - R: DWORD; -begin - R := GetFileAttributes(PChar(Name)); - Result := (R <> DWORD(-1)) and ((R and FILE_ATTRIBUTE_DIRECTORY) <> 0); -end; -{$ENDIF MSWINDOWS} - -{$IFDEF UNIX} -function DirectoryExists(const Name: string; ResolveSymLinks: Boolean): Boolean; -begin - Result := IsDirectory(Name, ResolveSymLinks); -end; -{$ENDIF UNIX} - -{$IFDEF MSWINDOWS} -function DiskInDrive(Drive: Char): Boolean; -var - ErrorMode: Cardinal; -begin - Result := False; - Assert(CharIsDriveLetter(Drive)); - if CharIsDriveLetter(Drive) then - begin - Drive := CharUpper(Drive); - { try to access the drive, it doesn't really matter how we access the drive and as such calling - DiskSize is more or less a random choice. The call to SetErrorMode supresses the system provided - error dialog if there is no disk in the drive and causes the to DiskSize to fail. } - ErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS); - try - Result := DiskSize(Ord(Drive) - $40) <> -1; - finally - SetErrorMode(ErrorMode); - end; - end; -end; -{$ENDIF MSWINDOWS} - -function FileCreateTemp(var Prefix: string): THandle; -{$IFDEF MSWINDOWS} -var - TempName: string; -begin - Result := INVALID_HANDLE_VALUE; - TempName := FileGetTempName(Prefix); - if TempName <> '' then - begin - Result := CreateFile(PChar(TempName), GENERIC_READ or GENERIC_WRITE, 0, nil, - OPEN_EXISTING, FILE_ATTRIBUTE_TEMPORARY or FILE_FLAG_DELETE_ON_CLOSE, 0); - // In certain situations it's possible that CreateFile fails yet the file is actually created, - // therefore explicitly delete it upon failure. - if Result = INVALID_HANDLE_VALUE then - DeleteFile(TempName); - Prefix := TempName; - end; -end; -{$ENDIF MSWINDOWS} -{$IFDEF UNIX} -var - Template: string; -begin - // The mkstemp function generates a unique file name just as mktemp does, but - // it also opens the file for you with open. If successful, it modifies - // template in place and returns a file descriptor for that file open for - // reading and writing. If mkstemp cannot create a uniquely-named file, it - // returns -1. If template does not end with `XXXXXX', mkstemp returns -1 and - // does not modify template. - - // The file is opened using mode 0600. If the file is meant to be used by - // other users this mode must be changed explicitly. - - // Unlike mktemp, mkstemp is actually guaranteed to create a unique file that - // cannot possibly clash with any other program trying to create a temporary - // file. This is because it works by calling open with the O_EXCL flag, which - // says you want to create a new file and get an error if the file already - // exists. - Template := Prefix + 'XXXXXX'; - Result := mkstemp(PChar(Template)); - Prefix := Template; -end; -{$ENDIF UNIX} - -function FileBackup(const FileName: string; Move: Boolean = False): Boolean; -begin - if Move then - Result := FileMove(FileName, GetBackupFileName(FileName), True) - else - Result := FileCopy(FileName, GetBackupFileName(FileName), True); -end; - -function FileCopy(const ExistingFileName, NewFileName: string; ReplaceExisting: Boolean = False): Boolean; -var - {$IFDEF UNIX} - SrcFile, DstFile: file; - Buf: array[0..511] of Byte; - BytesRead: Integer; - {$ENDIF UNIX} - DestFileName: string; -begin - if IsDirectory(NewFileName) then - DestFileName := PathAddSeparator(NewFileName) + ExtractFileName(ExistingFileName) - else - DestFileName := NewFileName; - {$IFDEF MSWINDOWS} - { TODO : Use CopyFileEx where available? } - Result := CopyFile(PChar(ExistingFileName), PChar(DestFileName), not ReplaceExisting); - {$ENDIF MSWINDOWS} - {$IFDEF UNIX} - Result := False; - if not FileExists(DestFileName) or ReplaceExisting then - begin - AssignFile(SrcFile, ExistingFileName); - Reset(SrcFile, 1); - AssignFile(DstFile, DestFileName); - Rewrite(DstFile, 1); - while not Eof(SrcFile) do - begin - BlockRead(SrcFile, Buf, SizeOf(Buf), BytesRead); - BlockWrite(DstFile, Buf, BytesRead); - end; - CloseFile(DstFile); - CloseFile(SrcFile); - Result := True; - end; - {$ENDIF UNIX} -end; - -function FileDateTime(const FileName: string): TDateTime; -{$IFNDEF COMPILER10_UP} -var - Age: Longint; -{$ENDIF !COMPILER10_UP} -begin - {$IFDEF COMPILER10_UP} - if not FileAge(Filename, Result) then - Result := 0; - {$ELSE} - Age := FileAge(FileName); - {$IFDEF MSWINDOWS} - // [roko] -1 is valid FileAge value on Linux - if Age = -1 then - Result := 0 - else - {$ENDIF MSWINDOWS} - Result := FileDateToDateTime(Age); - {$ENDIF COMPILER10_UP} -end; - -function FileDelete(const FileName: string; MoveToRecycleBin: Boolean = False): Boolean; -{$IFDEF MSWINDOWS} -begin - if MoveToRecycleBin then - Result := SHDeleteFiles(0, FileName, [doSilent, doAllowUndo, doFilesOnly]) - else - Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.DeleteFile(PChar(FileName)); -end; -{$ENDIF MSWINDOWS} -{$IFDEF UNIX} - { TODO : implement MoveToRecycleBin for appropriate Desktops (e.g. KDE) } -begin - Result := remove(PChar(FileName)) <> -1; -end; -{$ENDIF UNIX} - -function FileExists(const FileName: string): Boolean; -{$IFDEF MSWINDOWS} -var - Attr: Cardinal; -{$ENDIF MSWINDOWS} -begin - if FileName <> '' then - begin - {$IFDEF MSWINDOWS} - // FileGetSize is very slow, GetFileAttributes is much faster - Attr := GetFileAttributes(Pointer(Filename)); - Result := (Attr <> $FFFFFFFF) and (Attr and FILE_ATTRIBUTE_DIRECTORY = 0); - {$ELSE ~MSWINDOWS} - // Attempt to access the file, doesn't matter how, using FileGetSize is as good as anything else. - Result := FileGetSize(FileName) <> -1; - {$ENDIF ~MSWINDOWS} - end - else - Result := False; -end; - -procedure FileHistory(const FileName: string; HistoryPath: string = ''; MaxHistoryCount: Integer = 100; MinFileDate: - TDateTime = 0; ReplaceExtention: Boolean = true); - - Function Extention (Number : Integer) : String; - begin - Result := inttostr(Number); - while Length(Result) < 3 do - Result := '0' + Result; - Result := '.~'+Result+'~'; - end; - - procedure RenameToNumber(const RenameFileName: string; Number: Integer); - var - f1: string; - f2: string; - begin - f1 := ChangeFileExt(RenameFileName,Extention(Number-1)); - f2 := ChangeFileExt(RenameFileName,Extention(Number)); - if FileExists(f2) then - if Number >= MaxHistoryCount then - if not FileDelete(f2) then - Exception.Create('Unable to delete file "' + f2 + '".') - else - else - RenameToNumber(RenameFileName, Number + 1); - if FileExists(f1) then - if not FileMove(f1, f2, true) then - Exception.Create('Unable to rename file "' + f1 + '" to "' + f2 + '".') - end; - -Var FirstFile : string; -begin - // TODO -cMM: FileHistory default body inserted - if not FileExists(FileName) or (MaxHistoryCount <= 0) then - Exit; - if HistoryPath = '' then - HistoryPath := ExtractFilePath(FileName); - FirstFile := PathAppend(HistoryPath, ExtractFileName(FileName)); - if ReplaceExtention then - FirstFile := ChangeFileExt(FirstFile, Extention(1)) - else - FirstFile := FirstFile+Extention(1); - if (FileDateTime(FirstFile) > MinFileDate) and (MinFileDate <> 0) then - Exit; - RenameToNumber(FirstFile, 2); - FileCopy(FileName, FirstFile, True); -end; - - -function FileMove(const ExistingFileName, NewFileName: string; ReplaceExisting: Boolean = False): Boolean; -{$IFDEF MSWINDOWS} -const - Flag: array[Boolean] of Cardinal = (0, MOVEFILE_REPLACE_EXISTING); -{$ENDIF MSWINDOWS} -begin - {$IFDEF MSWINDOWS} - Result := MoveFileEx(PChar(ExistingFileName), PChar(NewFileName), Flag[ReplaceExisting]); - {$ENDIF MSWINDOWS} - {$IFDEF UNIX} - Result := __rename(PChar(ExistingFileName), PChar(NewFileName)) = 0; - {$ENDIF UNIX} - if not Result then - begin - Result := FileCopy(ExistingFileName, NewFileName, ReplaceExisting); - if Result then - FileDelete(ExistingFileName); - end; -end; - -function FileRestore(const FileName: string): Boolean; -var - TempFileName: string; -begin - Result := False; - TempFileName := FileGetTempName(''); - - if FileMove(GetBackupFileName(FileName), TempFileName, True) then - if FileBackup(FileName, False) then - Result := FileMove(TempFileName, FileName, True); -end; - -function GetBackupFileName(const FileName: string): string; -var - NewExt: string; -begin - NewExt := ExtractFileExt(FileName); - if Length(NewExt) > 0 then - begin - NewExt[1] := '~'; - NewExt := '.' + NewExt - end - else - NewExt := '.~'; - Result := ChangeFileExt(FileName, NewExt); -end; - -function IsBackupFileName(const FileName: string): Boolean; -begin - Result := (pos('.~', ExtractFileExt(FileName)) = 1); -end; - -function FileGetDisplayName(const FileName: string): string; -{$IFDEF MSWINDOWS} -var - FileInfo: TSHFileInfo; -begin - ResetMemory(FileInfo, SizeOf(FileInfo)); - if SHGetFileInfo(PChar(FileName), 0, FileInfo, SizeOf(FileInfo), SHGFI_DISPLAYNAME) <> 0 then - Result := FileInfo.szDisplayName - else - Result := FileName; -end; -{$ELSE ~MSWINDOWS} -begin - { TODO -cHelp : mention this reduced solution } - Result := FileName; -end; -{$ENDIF ~MSWINDOWS} - -function FileGetGroupName(const FileName: string {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}): string; -{$IFDEF MSWINDOWS} -var - DomainName: WideString; - TmpResult: WideString; - pSD: PSecurityDescriptor; - BufSize: DWORD; -begin - if IsWinNT then - begin - BufSize := 0; - GetFileSecurity(PChar(FileName), GROUP_SECURITY_INFORMATION, nil, 0, BufSize); - if BufSize > 0 then - begin - GetMem(pSD, BufSize); - GetFileSecurity(PChar(FileName), GROUP_SECURITY_INFORMATION, - pSD, BufSize, BufSize); - LookupAccountBySid(Pointer(TJclAddr(pSD) + TJclAddr(pSD^.Group)), TmpResult, DomainName, True); - FreeMem(pSD); - Result := Trim(TmpResult); - end; - end; -end; -{$ENDIF ~MSWINDOWS} -{$IFDEF UNIX} -var - Buf: TStatBuf64; - ResultBuf: TGroup; - ResultBufPtr: PGroup; - Buffer: array of Char; -begin - if GetFileStatus(FileName, Buf, ResolveSymLinks) = 0 then - begin - SetLength(Buffer, 128); - while getgrgid_r(Buf.st_gid, ResultBuf, @Buffer[0], Length(Buffer), ResultBufPtr) = ERANGE do - SetLength(Buffer, Length(Buffer) * 2); - Result := ResultBuf.gr_name; - end; -end; -{$ENDIF ~UNIX} - -function FileGetOwnerName(const FileName: string {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}): string; -{$IFDEF MSWINDOWS} -var - DomainName: WideString; - TmpResult: WideString; - pSD: PSecurityDescriptor; - BufSize: DWORD; -begin - if IsWinNT then - begin - BufSize := 0; - GetFileSecurity(PChar(FileName), OWNER_SECURITY_INFORMATION, nil, 0, BufSize); - if BufSize > 0 then - begin - GetMem(pSD, BufSize); - try - GetFileSecurity(PChar(FileName), OWNER_SECURITY_INFORMATION, - pSD, BufSize, BufSize); - LookupAccountBySid(Pointer(TJclAddr(pSD) + TJclAddr(pSD^.Owner)), TmpResult, DomainName, True); - finally - FreeMem(pSD); - end; - Result := Trim(TmpResult); - end; - end; -end; -{$ENDIF ~MSWINDOWS} -{$IFDEF UNIX} -var - Buf: TStatBuf64; - ResultBuf: TPasswordRecord; - ResultBufPtr: PPasswordRecord; - Buffer: array of Char; -begin - if GetFileStatus(FileName, Buf, ResolveSymLinks) = 0 then - begin - SetLength(Buffer, 128); - while getpwuid_r(Buf.st_uid, ResultBuf, @Buffer[0], Length(Buffer), ResultBufPtr) = ERANGE do - SetLength(Buffer, Length(Buffer) * 2); - Result := ResultBuf.pw_name; - end; -end; -{$ENDIF ~UNIX} - -function FileGetSize(const FileName: string): Int64; -{$IFDEF MSWINDOWS} -var - FileAttributesEx: WIN32_FILE_ATTRIBUTE_DATA; - OldMode: Cardinal; - Size: TJclULargeInteger; -begin - Result := -1; - OldMode := SetErrorMode(SEM_FAILCRITICALERRORS); - try - if GetFileAttributesEx(PChar(FileName), GetFileExInfoStandard, @FileAttributesEx) then - begin - Size.LowPart := FileAttributesEx.nFileSizeLow; - Size.HighPart := FileAttributesEx.nFileSizeHigh; - Result := Size.QuadPart; - end; - finally - SetErrorMode(OldMode); - end; -end; -{$ENDIF MSWINDOWS} -{$IFDEF UNIX} -var - Buf: TStatBuf64; -begin - Result := -1; - if GetFileStatus(FileName, Buf, False) = 0 then - Result := Buf.st_size; -end; -{$ENDIF UNIX} - -{$IFDEF MSWINDOWS} -{$IFDEF FPC} -{ TODO : Move this over to JclWin32 when JclWin32 gets overhauled. } -function GetTempFileName(lpPathName, lpPrefixString: PChar; - uUnique: UINT; lpTempFileName: PChar): UINT; stdcall; -external kernel32 name 'GetTempFileNameA'; -{$ENDIF FPC} -{$ENDIF MSWINDOWS} - -function FileGetTempName(const Prefix: string): string; -{$IFDEF MSWINDOWS} -var - TempPath, TempFile: string; - R: Cardinal; -begin - Result := ''; - TempPath := PathGetTempPath; - if TempPath <> '' then - begin - SetLength(TempFile, MAX_PATH); - R := GetTempFileName(PChar(TempPath), PChar(Prefix), 0, PChar(TempFile)); - if R <> 0 then - begin - StrResetLength(TempFile); - Result := TempFile; - end; - end; -end; -{$ENDIF MSWINDOWS} -{$IFDEF UNIX} -// Warning: Between the time the pathname is constructed and the file is created -// another process might have created a file with the same name using tmpnam, -// leading to a possible security hole. The implementation generates names which -// can hardly be predicted, but when opening the file you should use the O_EXCL -// flag. Using tmpfile or mkstemp is a safe way to avoid this problem. -var - P: PChar; -begin - P := tempnam(PChar(PathGetTempPath), PChar(Prefix)); - Result := P; - Libc.free(P); -end; -{$ENDIF UNIX} - -{$IFDEF MSWINDOWS} -function FileGetTypeName(const FileName: string): string; -var - FileInfo: TSHFileInfo; - RetVal: DWORD; -begin - ResetMemory(FileInfo, SizeOf(FileInfo)); - RetVal := SHGetFileInfo(PChar(FileName), 0, FileInfo, SizeOf(FileInfo), - SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES); - if RetVal <> 0 then - Result := FileInfo.szTypeName; - if (RetVal = 0) or (Trim(Result) = '') then - begin - // Lookup failed so mimic explorer behaviour by returning "XYZ File" - Result := ExtractFileExt(FileName); - Delete(Result, 1, 1); - Result := TrimLeft(UpperCase(Result) + LoadResString(@RsDefaultFileTypeName)); - end; -end; -{$ENDIF MSWINDOWS} - -function FindUnusedFileName(FileName: string; const FileExt: string; NumberPrefix: string = ''): string; -var - I: Integer; -begin - Result := PathAddExtension(FileName, FileExt); - if not FileExists(Result) then - Exit; - if SameText(Result, FileName) then - Delete(FileName, Length(FileName) - Length(FileExt) + 1, Length(FileExt)); - I := 0; - repeat - Inc(I); - Result := PathAddExtension(FileName + NumberPrefix + IntToStr(I), FileExt); - until not FileExists(Result); -end; - -// This routine is copied from FileCtrl.pas to avoid dependency on that unit. -// See the remark at the top of this section - -function ForceDirectories(Name: string): Boolean; -var - ExtractPath: string; -begin - Result := True; - if Length(Name) = 0 then - raise EJclFileUtilsError.CreateRes(@RsCannotCreateDir); - Name := PathRemoveSeparator(Name); - {$IFDEF MSWINDOWS} - ExtractPath := ExtractFilePath(Name); - if ((Length(Name) = 2) and (Copy(Name, 2,1) = ':')) or DirectoryExists(Name) or (ExtractPath = Name) then - Exit; - {$ENDIF MSWINDOWS} - {$IFDEF UNIX} - if (Length(Name) = 0) or DirectoryExists(Name) then - Exit; - ExtractPath := ExtractFilePath(Name); - {$ENDIF UNIX} - Result := (ExtractPath = '') or ForceDirectories(ExtractPath); - if Result then - begin - {$IFDEF MSWINDOWS} - SetLastError(ERROR_SUCCESS); - {$ENDIF MSWINDOWS} - Result := Result and CreateDir(Name); - {$IFDEF MSWINDOWS} - Result := Result or (GetLastError = ERROR_ALREADY_EXISTS); - {$ENDIF MSWINDOWS} - end; -end; - -function GetDirectorySize(const Path: string): Int64; - - function RecurseFolder(const Path: string): Int64; - var - F: TSearchRec; - R: Integer; - {$IFDEF MSWINDOWS} - TempSize: TJclULargeInteger; - {$ENDIF MSWINDOWS} - begin - Result := 0; - R := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindFirst(Path + '*.*', faAnyFile, F); - if R = 0 then - try - while R = 0 do - begin - if (F.Name <> '.') and (F.Name <> '..') then - begin - if (F.Attr and faDirectory) = faDirectory then - Inc(Result, RecurseFolder(Path + F.Name + DirDelimiter)) - else - {$IFDEF MSWINDOWS} - begin - TempSize.LowPart := F.FindData.nFileSizeLow; - TempSize.HighPart := F.FindData.nFileSizeHigh; - Inc(Result, TempSize.QuadPart); - end; - {$ENDIF MSWINDOWS} - {$IFDEF UNIX} - // SysUtils.Find* don't perceive files >= 2 GB anyway - Inc(Result, Int64(F.Size)); - {$ENDIF UNIX} - end; - R := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindNext(F); - end; - if R <> ERROR_NO_MORE_FILES then - Abort; - finally - {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindClose(F); - end; - end; - -begin - if not DirectoryExists(PathRemoveSeparator(Path)) then - Result := -1 - else - try - Result := RecurseFolder(PathAddSeparator(Path)) - except - Result := -1; - end; -end; - -{$IFDEF MSWINDOWS} - -function GetDriveTypeStr(const Drive: Char): string; -var - DriveType: Integer; - DriveStr: string; -begin - if not CharIsDriveLetter(Drive) then - raise EJclPathError.CreateResFmt(@RsPathInvalidDrive, [Drive]); - DriveStr := Drive + ':\'; - DriveType := GetDriveType(PChar(DriveStr)); - case DriveType of - DRIVE_REMOVABLE: - Result := LoadResString(@RsRemovableDrive); - DRIVE_FIXED: - Result := LoadResString(@RsHardDisk); - DRIVE_REMOTE: - Result := LoadResString(@RsRemoteDrive); - DRIVE_CDROM: - Result := LoadResString(@RsCDRomDrive); - DRIVE_RAMDISK: - Result := LoadResString(@RsRamDisk); - else - Result := LoadResString(@RsUnknownDrive); - end; -end; - -function GetFileAgeCoherence(const FileName: string): Boolean; -var - FileAttributesEx: WIN32_FILE_ATTRIBUTE_DATA; -begin - Result := False; - if GetFileAttributesEx(PChar(FileName), GetFileExInfoStandard, @FileAttributesEx) then - {$IFDEF FPC} - Result := CompareFileTime(@FileAttributesEx.ftCreationTime, @FileAttributesEx.ftLastWriteTime) <= 0; - {$ELSE ~FPC} - Result := CompareFileTime(FileAttributesEx.ftCreationTime, FileAttributesEx.ftLastWriteTime) <= 0; - {$ENDIF ~FPC} -end; - -{$ENDIF MSWINDOWS} - -procedure GetFileAttributeList(const Items: TStrings; const Attr: Integer); -begin - { TODO : clear list? } - Assert(Assigned(Items)); - if not Assigned(Items) then - Exit; - Items.BeginUpdate; - try - { TODO : differentiate Windows/UNIX idents } - if Attr and faDirectory = faDirectory then - Items.Add(LoadResString(@RsAttrDirectory)); - if Attr and faReadOnly = faReadOnly then - Items.Add(LoadResString(@RsAttrReadOnly)); - if Attr and faSysFile = faSysFile then - Items.Add(LoadResString(@RsAttrSystemFile)); - if Attr and faArchive = faArchive then - Items.Add(LoadResString(@RsAttrArchive)); - if Attr and faAnyFile = faAnyFile then - Items.Add(LoadResString(@RsAttrAnyFile)); - if Attr and faHidden = faHidden then - Items.Add(LoadResString(@RsAttrHidden)); - finally - Items.EndUpdate; - end; -end; - -{$IFDEF MSWINDOWS} - -{ TODO : GetFileAttributeListEx - Unix version } -procedure GetFileAttributeListEx(const Items: TStrings; const Attr: Integer); -begin - { TODO : clear list? } - Assert(Assigned(Items)); - if not Assigned(Items) then - Exit; - Items.BeginUpdate; - try - if Attr and FILE_ATTRIBUTE_READONLY = FILE_ATTRIBUTE_READONLY then - Items.Add(LoadResString(@RsAttrReadOnly)); - if Attr and FILE_ATTRIBUTE_HIDDEN = FILE_ATTRIBUTE_HIDDEN then - Items.Add(LoadResString(@RsAttrHidden)); - if Attr and FILE_ATTRIBUTE_SYSTEM = FILE_ATTRIBUTE_SYSTEM then - Items.Add(LoadResString(@RsAttrSystemFile)); - if Attr and FILE_ATTRIBUTE_DIRECTORY = FILE_ATTRIBUTE_DIRECTORY then - Items.Add(LoadResString(@RsAttrDirectory)); - if Attr and FILE_ATTRIBUTE_ARCHIVE = FILE_ATTRIBUTE_ARCHIVE then - Items.Add(LoadResString(@RsAttrArchive)); - if Attr and FILE_ATTRIBUTE_NORMAL = FILE_ATTRIBUTE_NORMAL then - Items.Add(LoadResString(@RsAttrNormal)); - if Attr and FILE_ATTRIBUTE_TEMPORARY = FILE_ATTRIBUTE_TEMPORARY then - Items.Add(LoadResString(@RsAttrTemporary)); - if Attr and FILE_ATTRIBUTE_COMPRESSED = FILE_ATTRIBUTE_COMPRESSED then - Items.Add(LoadResString(@RsAttrCompressed)); - if Attr and FILE_ATTRIBUTE_OFFLINE = FILE_ATTRIBUTE_OFFLINE then - Items.Add(LoadResString(@RsAttrOffline)); - if Attr and FILE_ATTRIBUTE_ENCRYPTED = FILE_ATTRIBUTE_ENCRYPTED then - Items.Add(LoadResString(@RsAttrEncrypted)); - if Attr and FILE_ATTRIBUTE_REPARSE_POINT = FILE_ATTRIBUTE_REPARSE_POINT then - Items.Add(LoadResString(@RsAttrReparsePoint)); - if Attr and FILE_ATTRIBUTE_SPARSE_FILE = FILE_ATTRIBUTE_SPARSE_FILE then - Items.Add(LoadResString(@RsAttrSparseFile)); - finally - Items.EndUpdate; - end; -end; - -{$ENDIF MSWINDOWS} - -function GetFileInformation(const FileName: string; out FileInfo: TSearchRec): Boolean; -begin - Result := FindFirst(FileName, faAnyFile, FileInfo) = 0; - if Result then - {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindClose(FileInfo); -end; - -function GetFileInformation(const FileName: string): TSearchRec; -begin - if not GetFileInformation(FileName, Result) then - RaiseLastOSError; -end; - -{$IFDEF UNIX} - -{ TODO -cHelp : Author: Robert Rossmair } - -function GetFileStatus(const FileName: string; out StatBuf: TStatBuf64; - const ResolveSymLinks: Boolean): Integer; -begin - if ResolveSymLinks then - Result := stat64(PChar(FileName), StatBuf) - else - Result := lstat64(PChar(FileName), StatBuf); -end; - -{$ENDIF UNIX} - -{$IFDEF MSWINDOWS} - -function GetFileLastWrite(const FileName: string): TFileTime; -begin - Result := GetFileInformation(FileName).FindData.ftLastWriteTime; -end; - -function GetFileLastWrite(const FileName: string; out LocalTime: TDateTime): Boolean; -var - FileInfo: TSearchRec; -begin - Result := GetFileInformation(FileName, FileInfo); - if Result then - LocalTime := FileTimeToLocalDateTime(FileInfo.FindData.ftLastWriteTime); -end; - -{$ENDIF MSWINDOWS} - -{$IFDEF UNIX} - -function GetFileLastWrite(const FileName: string; out TimeStamp: Integer; ResolveSymLinks: Boolean): Boolean; -var - Buf: TStatBuf64; -begin - Result := GetFileStatus(FileName, Buf, ResolveSymLinks) = 0; - if Result then - TimeStamp := Buf.st_mtime -end; - -function GetFileLastWrite(const FileName: string; out LocalTime: TDateTime; ResolveSymLinks: Boolean): Boolean; -var - Buf: TStatBuf64; -begin - Result := GetFileStatus(FileName, Buf, ResolveSymLinks) = 0; - if Result then - LocalTime := FileDateToDateTime(Buf.st_mtime); -end; - -function GetFileLastWrite(const FileName: string; ResolveSymLinks: Boolean): Integer; -var - Buf: TStatBuf64; -begin - if GetFileStatus(FileName, Buf, ResolveSymLinks) = 0 then - Result := Buf.st_mtime - else - Result := -1; -end; - -{$ENDIF UNIX} - -{$IFDEF MSWINDOWS} - -function GetFileLastAccess(const FileName: string): TFileTime; -begin - Result := GetFileInformation(FileName).FindData.ftLastAccessTime; -end; - -function GetFileLastAccess(const FileName: string; out LocalTime: TDateTime): Boolean; -var - FileInfo: TSearchRec; -begin - Result := GetFileInformation(FileName, FileInfo); - if Result then - LocalTime := FileTimeToLocalDateTime(GetFileInformation(FileName).FindData.ftLastAccessTime); -end; - -{$ENDIF MSWINDOWS} - -{$IFDEF UNIX} - -function GetFileLastAccess(const FileName: string; out TimeStamp: Integer; ResolveSymLinks: Boolean): Boolean; -var - Buf: TStatBuf64; -begin - Result := GetFileStatus(FileName, Buf, ResolveSymLinks) = 0; - if Result then - TimeStamp := Buf.st_atime -end; - -function GetFileLastAccess(const FileName: string; out LocalTime: TDateTime; ResolveSymLinks: Boolean): Boolean; -var - Buf: TStatBuf64; -begin - Result := GetFileStatus(FileName, Buf, ResolveSymLinks) = 0; - if Result then - LocalTime := FileDateToDateTime(Buf.st_atime); -end; - -function GetFileLastAccess(const FileName: string; ResolveSymLinks: Boolean): Integer; -var - Buf: TStatBuf64; -begin - if GetFileStatus(FileName, Buf, ResolveSymLinks) = 0 then - Result := Buf.st_atime - else - Result := -1; -end; - -{$ENDIF UNIX} - -{$IFDEF MSWINDOWS} - -function GetFileCreation(const FileName: string): TFileTime; -begin - Result := GetFileInformation(FileName).FindData.ftCreationTime; -end; - -function GetFileCreation(const FileName: string; out LocalTime: TDateTime): Boolean; -var - FileInfo: TSearchRec; -begin - Result := GetFileInformation(FileName, FileInfo); - if Result then - LocalTime := FileTimeToLocalDateTime(GetFileInformation(FileName).FindData.ftCreationTime); -end; - -{$ENDIF MSWINDOWS} - -{$IFDEF UNIX} - -function GetFileLastAttrChange(const FileName: string; out TimeStamp: Integer; ResolveSymLinks: Boolean): Boolean; -var - Buf: TStatBuf64; -begin - Result := GetFileStatus(FileName, Buf, ResolveSymLinks) = 0; - if Result then - TimeStamp := Buf.st_ctime -end; - -function GetFileLastAttrChange(const FileName: string; out LocalTime: TDateTime; ResolveSymLinks: Boolean): Boolean; -var - Buf: TStatBuf64; -begin - Result := GetFileStatus(FileName, Buf, ResolveSymLinks) = 0; - if Result then - LocalTime := FileDateToDateTime(Buf.st_ctime); -end; - -function GetFileLastAttrChange(const FileName: string; ResolveSymLinks: Boolean): Integer; -var - Buf: TStatBuf64; -begin - if GetFileStatus(FileName, Buf, ResolveSymLinks) = 0 then - Result := Buf.st_ctime - else - Result := -1; -end; - -{$ENDIF UNIX} - -function GetModulePath(const Module: HMODULE): string; -var - L: Integer; -begin - L := MAX_PATH + 1; - SetLength(Result, L); - {$IFDEF MSWINDOWS} - L := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetModuleFileName(Module, Pointer(Result), L); - {$ENDIF MSWINDOWS} - {$IFDEF UNIX} - {$IFDEF FPC} - L := 0; // FIXME - {$ELSE ~FPC} - L := GetModuleFileName(Module, Pointer(Result), L); - {$ENDIF ~FPC} - {$ENDIF UNIX} - SetLength(Result, L); -end; - -function GetSizeOfFile(const FileName: string): Int64; -{$IFDEF MSWINDOWS} -var - FileAttributesEx: WIN32_FILE_ATTRIBUTE_DATA; - Size: TJclULargeInteger; -begin - Result := 0; - if GetFileAttributesEx(PChar(FileName), GetFileExInfoStandard, @FileAttributesEx) then - begin - Size.LowPart := FileAttributesEx.nFileSizeLow; - Size.HighPart := FileAttributesEx.nFileSizeHigh; - Result := Size.QuadPart; - end - else - RaiseLastOSError; -end; -{$ENDIF MSWINDOWS} -{$IFDEF UNIX} -var - Buf: TStatBuf64; -begin - if GetFileStatus(FileName, Buf, False) <> 0 then - RaiseLastOSError; - Result := Buf.st_size; -end; -{$ENDIF UNIX} - -{$IFDEF MSWINDOWS} -function GetSizeOfFile(Handle: THandle): Int64; overload; -var - Size: TJclULargeInteger; -begin - Size.LowPart := GetFileSize(Handle, @Size.HighPart); - Result := Size.QuadPart; -end; -{$ENDIF MSWINDOWS} - -function GetSizeOfFile(const FileInfo: TSearchRec): Int64; -{$IFDEF MSWINDOWS} -begin - Int64Rec(Result).Lo := FileInfo.FindData.nFileSizeLow; - Int64Rec(Result).Hi := FileInfo.FindData.nFileSizeHigh; -end; -{$ENDIF MSWINDOWS} -{$IFDEF UNIX} -var - Buf: TStatBuf64; -begin - // rr: Note that SysUtils.FindFirst/Next ignore files >= 2 GB under Linux, - // thus the following code is rather pointless at the moment of this writing. - // We apparently need to write our own set of Findxxx functions to overcome this limitation. - if GetFileStatus(FileInfo.PathOnly + FileInfo.Name, Buf, True) <> 0 then - Result := -1 - else - Result := Buf.st_size -end; -{$ENDIF UNIX} - -{$IFDEF MSWINDOWS} - -{$IFDEF FPC} -{ TODO : Move this over to JclWin32 when JclWin32 gets overhauled. } -function GetFileAttributesEx(lpFileName: PChar; - fInfoLevelId: TGetFileExInfoLevels; lpFileInformation: Pointer): BOOL; stdcall; -external kernel32 name 'GetFileAttributesExA'; -{$ENDIF FPC} - -function GetStandardFileInfo(const FileName: string): TWin32FileAttributeData; -var - Handle: THandle; - FileInfo: TByHandleFileInformation; -begin - Assert(FileName <> ''); - { TODO : Use RTDL-Version of GetFileAttributesEx } - if IsWin95 or IsWin95OSR2 or IsWinNT3 then - begin - Handle := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0); - if Handle <> INVALID_HANDLE_VALUE then - try - FileInfo.dwFileAttributes := 0; - if not GetFileInformationByHandle(Handle, FileInfo) then - raise EJclFileUtilsError.CreateResFmt(@RsFileUtilsAttrUnavailable, [FileName]); - Result.dwFileAttributes := FileInfo.dwFileAttributes; - Result.ftCreationTime := FileInfo.ftCreationTime; - Result.ftLastAccessTime := FileInfo.ftLastAccessTime; - Result.ftLastWriteTime := FileInfo.ftLastWriteTime; - Result.nFileSizeHigh := FileInfo.nFileSizeHigh; - Result.nFileSizeLow := FileInfo.nFileSizeLow; - finally - CloseHandle(Handle); - end - else - raise EJclFileUtilsError.CreateResFmt(@RsFileUtilsAttrUnavailable, [FileName]); - end - else - begin - if not GetFileAttributesEx(PChar(FileName), GetFileExInfoStandard, @Result) then - raise EJclFileUtilsError.CreateResFmt(@RsFileUtilsAttrUnavailable, [FileName]); - end; -end; - -{$ENDIF MSWINDOWS} - -{$IFDEF MSWINDOWS} -function IsDirectory(const FileName: string): Boolean; -var - R: DWORD; -begin - R := GetFileAttributes(PChar(FileName)); - Result := (R <> DWORD(-1)) and ((R and FILE_ATTRIBUTE_DIRECTORY) <> 0); -end; -{$ENDIF MSWINDOWS} -{$IFDEF UNIX} -function IsDirectory(const FileName: string; ResolveSymLinks: Boolean): Boolean; -var - Buf: TStatBuf64; -begin - Result := False; - if GetFileStatus(FileName, Buf, ResolveSymLinks) = 0 then - Result := S_ISDIR(Buf.st_mode); -end; -{$ENDIF UNIX} - -function IsRootDirectory(const CanonicFileName: string): Boolean; -{$IFDEF MSWINDOWS} -var - I: Integer; -begin - I := Pos(':\', CanonicFileName); - Result := (I > 0) and (I + 1 = Length(CanonicFileName)); -end; -{$ENDIF MSWINDOWS} -{$IFDEF UNIX} -begin - Result := CanonicFileName = DirDelimiter; -end; -{$ENDIF UNIX} - -{$IFDEF MSWINDOWS} - -function LockVolume(const Volume: string; var Handle: THandle): Boolean; -var - BytesReturned: DWORD; -begin - Result := False; - Handle := CreateFile(PChar('\\.\' + Volume), GENERIC_READ or GENERIC_WRITE, - FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, - FILE_FLAG_NO_BUFFERING, 0); - if Handle <> INVALID_HANDLE_VALUE then - begin - BytesReturned := 0; - Result := DeviceIoControl(Handle, FSCTL_LOCK_VOLUME, nil, 0, nil, 0, - BytesReturned, nil); - if not Result then - begin - CloseHandle(Handle); - Handle := INVALID_HANDLE_VALUE; - end; - end; -end; - -function OpenVolume(const Drive: Char): THandle; -var - VolumeName: array [0..6] of Char; -begin - VolumeName := '\\.\A:'; - VolumeName[4] := Drive; - Result := CreateFile(VolumeName, GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, - nil, OPEN_EXISTING, 0, 0); -end; - -{$ENDIF MSWINDOWS} - -type - // indicates the file time to set, used by SetFileTimesHelper and SetDirTimesHelper - TFileTimes = (ftLastAccess, ftLastWrite {$IFDEF MSWINDOWS}, ftCreation {$ENDIF}); - -{$IFDEF MSWINDOWS} -function SetFileTimesHelper(const FileName: string; const DateTime: TDateTime; Times: TFileTimes): Boolean; -var - Handle: THandle; - FileTime: TFileTime; - SystemTime: TSystemTime; -begin - Result := False; - Handle := CreateFile(PChar(FileName), GENERIC_WRITE, FILE_SHARE_READ, nil, - OPEN_EXISTING, 0, 0); - if Handle <> INVALID_HANDLE_VALUE then - try - //SysUtils.DateTimeToSystemTime(DateTimeToLocalDateTime(DateTime), SystemTime); - {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.DateTimeToSystemTime(DateTime, SystemTime); - FileTime.dwLowDateTime := 0; - FileTime.dwHighDateTime := 0; - if {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.SystemTimeToFileTime(SystemTime, FileTime) then - begin - case Times of - ftLastAccess: - Result := SetFileTime(Handle, nil, @FileTime, nil); - ftLastWrite: - Result := SetFileTime(Handle, nil, nil, @FileTime); - ftCreation: - Result := SetFileTime(Handle, @FileTime, nil, nil); - end; - end; - finally - CloseHandle(Handle); - end; -end; -{$ENDIF MSWINDOWS} - -{$IFDEF UNIX} -function SetFileTimesHelper(const FileName: string; const DateTime: TDateTime; Times: TFileTimes): Boolean; -var - FileTime: Integer; - StatBuf: TStatBuf64; - TimeBuf: utimbuf; -begin - Result := False; - FileTime := DateTimeToFileDate(DateTime); - if GetFileStatus(FileName, StatBuf, False) = 0 then - begin - TimeBuf.actime := StatBuf.st_atime; - TimeBuf.modtime := StatBuf.st_mtime; - case Times of - ftLastAccess: - TimeBuf.actime := FileTime; - ftLastWrite: - TimeBuf.modtime := FileTime; - end; - Result := utime(PChar(FileName), @TimeBuf) = 0; - end; -end; -{$ENDIF UNIX} - -function SetFileLastAccess(const FileName: string; const DateTime: TDateTime): Boolean; -begin - Result := SetFileTimesHelper(FileName, DateTime, ftLastAccess); -end; - -function SetFileLastWrite(const FileName: string; const DateTime: TDateTime): Boolean; -begin - Result := SetFileTimesHelper(FileName, DateTime, ftLastWrite); -end; - -{$IFDEF MSWINDOWS} - -function SetFileCreation(const FileName: string; const DateTime: TDateTime): Boolean; -begin - Result := SetFileTimesHelper(FileName, DateTime, ftCreation); -end; - -// utility function for SetDirTimesHelper - -function BackupPrivilegesEnabled: Boolean; -begin - Result := IsPrivilegeEnabled(SE_BACKUP_NAME) and IsPrivilegeEnabled(SE_RESTORE_NAME); -end; - -function SetDirTimesHelper(const DirName: string; const DateTime: TDateTime; - Times: TFileTimes; RequireBackupRestorePrivileges: Boolean): Boolean; -var - Handle: THandle; - FileTime: TFileTime; - SystemTime: TSystemTime; -begin - Result := False; - if IsDirectory(DirName) and (not RequireBackupRestorePrivileges or BackupPrivilegesEnabled) then - begin - Handle := CreateFile(PChar(DirName), GENERIC_WRITE, FILE_SHARE_READ, nil, - OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0); - if Handle <> INVALID_HANDLE_VALUE then - try - {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.DateTimeToSystemTime(DateTime, SystemTime); - FileTime.dwLowDateTime := 0; - FileTime.dwHighDateTime := 0; - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.SystemTimeToFileTime(SystemTime, FileTime); - case Times of - ftLastAccess: - Result := SetFileTime(Handle, nil, @FileTime, nil); - ftLastWrite: - Result := SetFileTime(Handle, nil, nil, @FileTime); - ftCreation: - Result := SetFileTime(Handle, @FileTime, nil, nil); - end; - finally - CloseHandle(Handle); - end; - end; -end; - -function SetDirLastWrite(const DirName: string; const DateTime: TDateTime; RequireBackupRestorePrivileges: Boolean = True): Boolean; -begin - Result := SetDirTimesHelper(DirName, DateTime, ftLastWrite, RequireBackupRestorePrivileges); -end; - -function SetDirLastAccess(const DirName: string; const DateTime: TDateTime; RequireBackupRestorePrivileges: Boolean = True): Boolean; -begin - Result := SetDirTimesHelper(DirName, DateTime, ftLastAccess, RequireBackupRestorePrivileges); -end; - -function SetDirCreation(const DirName: string; const DateTime: TDateTime; RequireBackupRestorePrivileges: Boolean = True): Boolean; -begin - Result := SetDirTimesHelper(DirName, DateTime, ftCreation, RequireBackupRestorePrivileges); -end; - -procedure FillByteArray(var Bytes: array of Byte; Count: Cardinal; B: Byte); -begin - FillMemory(@Bytes[0], Count, B); -end; - -procedure ShredFile(const FileName: string; Times: Integer); -const - BUFSIZE = 4096; - ODD_FILL = $C1; - EVEN_FILL = $3E; -var - Fs: TFileStream; - Size: Integer; - N: Integer; - ContentPtr: array of Byte; -begin - Size := FileGetSize(FileName); - if Size > 0 then - begin - if Times < 0 then - Times := 2 - else - Times := Times * 2; - ContentPtr := nil; - Fs := TFileStream.Create(FileName, fmOpenReadWrite); - try - SetLength(ContentPtr, BUFSIZE); - while Times > 0 do - begin - if Times mod 2 = 0 then - FillByteArray(ContentPtr, BUFSIZE, EVEN_FILL) - else - FillByteArray(ContentPtr, BUFSIZE, ODD_FILL); - Fs.Seek(0, soBeginning); - N := Size div BUFSIZE; - while N > 0 do - begin - Fs.Write(ContentPtr[0], BUFSIZE); - Dec(N); - end; - N := Size mod BUFSIZE; - if N > 0 then - Fs.Write(ContentPtr[0], N); - FlushFileBuffers(Fs.Handle); - Dec(Times); - end; - finally - ContentPtr := nil; - Fs.Free; - DeleteFile(FileName); - end; - end - else - DeleteFile(FileName); -end; - -function UnlockVolume(var Handle: THandle): Boolean; -var - BytesReturned: DWORD; -begin - Result := False; - if Handle <> INVALID_HANDLE_VALUE then - begin - BytesReturned := 0; - Result := DeviceIoControl(Handle, FSCTL_UNLOCK_VOLUME, nil, 0, nil, 0, - BytesReturned, nil); - if Result then - begin - CloseHandle(Handle); - Handle := INVALID_HANDLE_VALUE; - end; - end; -end; - -{$ENDIF MSWINDOWS} - -{$IFDEF UNIX} - -function CreateSymbolicLink(const Name, Target: string): Boolean; -begin - Result := symlink(PChar(Target), PChar(Name)) = 0; -end; - -function SymbolicLinkTarget(const Name: string): string; -var - N, BufLen: Integer; -begin - BufLen := 128; - repeat - Inc(BufLen, BufLen); - SetLength(Result, BufLen); - N := readlink(PChar(Name), PChar(Result), BufLen); - if N < 0 then // Error - begin - Result := ''; - Exit; - end; - until N < BufLen; - SetLength(Result, N); -end; - -{$ENDIF UNIX} - -//=== File Version info routines ============================================= - -{$IFDEF MSWINDOWS} - -const - VerKeyNames: array [1..12] of string = - ('Comments', - 'CompanyName', - 'FileDescription', - 'FileVersion', - 'InternalName', - 'LegalCopyright', - 'LegalTradeMarks', - 'OriginalFilename', - 'ProductName', - 'ProductVersion', - 'SpecialBuild', - 'PrivateBuild'); - -function OSIdentToString(const OSIdent: DWORD): string; -begin - case OSIdent of - VOS_UNKNOWN: - Result := LoadResString(@RsVosUnknown); - VOS_DOS: - Result := LoadResString(@RsVosDos); - VOS_OS216: - Result := LoadResString(@RsVosOS216); - VOS_OS232: - Result := LoadResString(@RsVosOS232); - VOS_NT: - Result := LoadResString(@RsVosNT); - VOS__WINDOWS16: - Result := LoadResString(@RsVosWindows16); - VOS__PM16: - Result := LoadResString(@RsVosPM16); - VOS__PM32: - Result := LoadResString(@RsVosPM32); - VOS__WINDOWS32: - Result := LoadResString(@RsVosWindows32); - VOS_DOS_WINDOWS16: - Result := LoadResString(@RsVosDosWindows16); - VOS_DOS_WINDOWS32: - Result := LoadResString(@RsVosDosWindows32); - VOS_OS216_PM16: - Result := LoadResString(@RsVosOS216PM16); - VOS_OS232_PM32: - Result := LoadResString(@RsVosOS232PM32); - VOS_NT_WINDOWS32: - Result := LoadResString(@RsVosNTWindows32); - else - Result := ''; - end; - if Result = '' then - Result := LoadResString(@RsVosUnknown) - else - Result := Format(LoadResString(@RsVosDesignedFor), [Result]); -end; - -function OSFileTypeToString(const OSFileType: DWORD; const OSFileSubType: DWORD): string; -begin - case OSFileType of - VFT_UNKNOWN: - Result := LoadResString(@RsVftUnknown); - VFT_APP: - Result := LoadResString(@RsVftApp); - VFT_DLL: - Result := LoadResString(@RsVftDll); - VFT_DRV: - begin - case OSFileSubType of - VFT2_DRV_PRINTER: - Result := LoadResString(@RsVft2DrvPRINTER); - VFT2_DRV_KEYBOARD: - Result := LoadResString(@RsVft2DrvKEYBOARD); - VFT2_DRV_LANGUAGE: - Result := LoadResString(@RsVft2DrvLANGUAGE); - VFT2_DRV_DISPLAY: - Result := LoadResString(@RsVft2DrvDISPLAY); - VFT2_DRV_MOUSE: - Result := LoadResString(@RsVft2DrvMOUSE); - VFT2_DRV_NETWORK: - Result := LoadResString(@RsVft2DrvNETWORK); - VFT2_DRV_SYSTEM: - Result := LoadResString(@RsVft2DrvSYSTEM); - VFT2_DRV_INSTALLABLE: - Result := LoadResString(@RsVft2DrvINSTALLABLE); - VFT2_DRV_SOUND: - Result := LoadResString(@RsVft2DrvSOUND); - VFT2_DRV_COMM: - Result := LoadResString(@RsVft2DrvCOMM); - else - Result := ''; - end; - Result := Result + ' ' + LoadResString(@RsVftDrv); - end; - VFT_FONT: - begin - case OSFileSubType of - VFT2_FONT_RASTER: - Result := LoadResString(@RsVft2FontRASTER); - VFT2_FONT_VECTOR: - Result := LoadResString(@RsVft2FontVECTOR); - VFT2_FONT_TRUETYPE: - Result := LoadResString(@RsVft2FontTRUETYPE); - else - Result := ''; - end; - Result := Result + ' ' + LoadResString(@RsVftFont); - end; - VFT_VXD: - Result := LoadResString(@RsVftVxd); - VFT_STATIC_LIB: - Result := LoadResString(@RsVftStaticLib); - else - Result := ''; - end; - Result := TrimLeft(Result); -end; - -function VersionResourceAvailable(const FileName: string): Boolean; -var - Size: DWORD; - Handle: DWORD; - Buffer: string; -begin - Result := False; - Handle := 0; - Size := GetFileVersionInfoSize(PChar(FileName), Handle); - if Size > 0 then - begin - SetLength(Buffer, Size); - Result := GetFileVersionInfo(PChar(FileName), Handle, Size, PChar(Buffer)); - end; -end; - -function VersionResourceAvailable(const Window: HWND): Boolean; -begin - Result := VersionResourceAvailable(WindowToModuleFileName(Window)); -end; - -function VersionResourceAvailable(const Module: HMODULE): Boolean; -begin - if Module <> 0 then - Result :=VersionResourceAvailable(GetModulePath(Module)) - else - raise EJclError.CreateResFmt(@RsEModuleNotValid, [Module]); -end; - -function WindowToModuleFileName(const Window: HWND): string; -type - {$IFDEF SUPPORTS_UNICODE} - TGetModuleFileNameEx = function(hProcess: THandle; hModule: HMODULE; FileName: PWideChar; nSize: DWORD): DWORD; stdcall; - TQueryFullProcessImageName = function(HProcess: THandle; dwFlags: DWORD; lpExeName: PWideChar; lpdwSize: PDWORD): BOOL; stdcall; - {$ELSE ~SUPPORTS_UNICODE} - TGetModuleFileNameEx = function(hProcess: THandle; hModule: HMODULE; FileName: PAnsiChar; nSize: DWORD): DWORD; stdcall; - TQueryFullProcessImageName = function(HProcess: THandle; dwFlags: DWORD; lpExeName: PAnsiChar; lpdwSize: PDWORD): BOOL; stdcall; - {$ENDIF ~SUPPORTS_UNICODE} -var - FileName: array[0..300] of Char; - DllHinst: HMODULE; - ProcessID: DWORD; - HProcess: THandle; - GetModuleFileNameExAddress: TGetModuleFileNameEx; - QueryFullProcessImageNameAddress: TQueryFullProcessImageName; - Len: DWORD; -begin - Result := ''; - if Window <> 0 then - begin - if not JclCheckWinVersion(5, 0) then // Win2k or newer required - raise EJclWin32Error.CreateRes(@RsEWindowsVersionNotSupported); - - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetWindowThreadProcessId(Window, @ProcessID); - hProcess := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, false, ProcessID); - if hProcess <> 0 then - begin - try - if JclCheckWinVersion(6, 0) then // WinVista or newer - begin - DllHinst := LoadLibrary('Kernel32.dll'); - if DllHinst <> 0 then - begin - try - {$IFDEF SUPPORTS_UNICODE} - QueryFullProcessImageNameAddress := GetProcAddress(DllHinst, 'QueryFullProcessImageNameW'); - {$ELSE ~SUPPORTS_UNICODE} - QueryFullProcessImageNameAddress := GetProcAddress(DllHinst, 'QueryFullProcessImageNameA'); - {$ENDIF ~SUPPORTS_UNICODE} - if Assigned(QueryFullProcessImageNameAddress) then - begin - Len := Length(FileName); - if QueryFullProcessImageNameAddress(hProcess, 0, FileName, PDWORD(@Len)) then - Result := FileName; - //else - // RaiseLastOSError would be nice, but it didn't raise an exception before the return value was checked - end - else - raise EJclError.CreateResFmt(@RsEFunctionNotFound, ['Kernel32.dll', 'QueryFullProcessImageName']); - finally - FreeLibrary(DllHinst); - end; - end - else - raise EJclError.CreateResFmt(@RsELibraryNotFound, ['Kernel32.dll']); - end - else - begin - DllHinst := LoadLibrary('Psapi.dll'); - if DllHinst <> 0 then - begin - try - {$IFDEF SUPPORTS_UNICODE} - GetModuleFileNameExAddress := GetProcAddress(DllHinst, 'GetModuleFileNameExW'); - {$ELSE ~SUPPORTS_UNICODE} - GetModuleFileNameExAddress := GetProcAddress(DllHinst, 'GetModuleFileNameExA'); - {$ENDIF ~SUPPORTS_UNICODE} - if Assigned(GetModuleFileNameExAddress) then - begin - Len := GetModuleFileNameExAddress(hProcess, 0, FileName, Length(FileName)); - if Len > 0 then - Result := FileName; - //else - // RaiseLastOSError; would be nice, but it didn't raise an exception before the return value was checked - end - else - raise EJclError.CreateResFmt(@RsEFunctionNotFound, ['Psapi.dll', 'GetModuleFileNameEx']); - finally - FreeLibrary(DllHinst); - end; - end - else - raise EJclError.CreateResFmt(@RsELibraryNotFound, ['Psapi.dll']); - end; - finally - CloseHandle(hProcess); - end; - end - else - raise EJclError.CreateResFmt(@RsEProcessNotValid, [ProcessID]); - end - else - raise EJclError.CreateResFmt(@RsEWindowNotValid, [Window]); -end; - -{$ENDIF MSWINDOWS} - -// Version Info formatting -function FormatVersionString(const HiV, LoV: Word): string; -begin - Result := Format('%u.%.2u', [HiV, LoV]); -end; - -function FormatVersionString(const Major, Minor, Build, Revision: Word): string; -begin - Result := Format('%u.%u.%u.%u', [Major, Minor, Build, Revision]); -end; - -{$IFDEF MSWINDOWS} - -function FormatVersionString(const FixedInfo: TVSFixedFileInfo; VersionFormat: TFileVersionFormat): string; -begin - case VersionFormat of - vfMajorMinor: - Result := Format('%u.%u', [HiWord(FixedInfo.dwFileVersionMS), LoWord(FixedInfo.dwFileVersionMS)]); - vfFull: - Result := Format('%u.%u.%u.%u', [HiWord(FixedInfo.dwFileVersionMS), LoWord(FixedInfo.dwFileVersionMS), - HiWord(FixedInfo.dwFileVersionLS), LoWord(FixedInfo.dwFileVersionLS)]); - end; -end; - -// Version Info extracting -procedure VersionExtractFileInfo(const FixedInfo: TVSFixedFileInfo; var Major, Minor, Build, Revision: Word); -begin - Major := HiWord(FixedInfo.dwFileVersionMS); - Minor := LoWord(FixedInfo.dwFileVersionMS); - Build := HiWord(FixedInfo.dwFileVersionLS); - Revision := LoWord(FixedInfo.dwFileVersionLS); -end; - -procedure VersionExtractProductInfo(const FixedInfo: TVSFixedFileInfo; var Major, Minor, Build, Revision: Word); -begin - Major := HiWord(FixedInfo.dwProductVersionMS); - Minor := LoWord(FixedInfo.dwProductVersionMS); - Build := HiWord(FixedInfo.dwProductVersionLS); - Revision := LoWord(FixedInfo.dwProductVersionLS); -end; - -// Fixed Version Info routines -function VersionFixedFileInfo(const FileName: string; var FixedInfo: TVSFixedFileInfo): Boolean; -var - Size, FixInfoLen: DWORD; - Handle: DWORD; - Buffer: string; - FixInfoBuf: PVSFixedFileInfo; -begin - Result := False; - Handle := 0; - Size := GetFileVersionInfoSize(PChar(FileName), Handle); - if Size > 0 then - begin - SetLength(Buffer, Size); - FixInfoLen := 0; - FixInfoBuf := nil; - if GetFileVersionInfo(PChar(FileName), Handle, Size, Pointer(Buffer)) and - VerQueryValue(Pointer(Buffer), DirDelimiter, Pointer(FixInfoBuf), FixInfoLen) and - (FixInfoLen = SizeOf(TVSFixedFileInfo)) then - begin - Result := True; - FixedInfo := FixInfoBuf^; - end; - end; -end; - -function VersionFixedFileInfoString(const FileName: string; VersionFormat: TFileVersionFormat; - const NotAvailableText: string): string; -var - FixedInfo: TVSFixedFileInfo; -begin - FixedInfo.dwSignature := 0; - if VersionFixedFileInfo(FileName, FixedInfo) then - Result := FormatVersionString(FixedInfo, VersionFormat) - else - Result := NotAvailableText; -end; - -//=== { TJclFileVersionInfo } ================================================ - -constructor TJclFileVersionInfo.Attach(VersionInfoData: Pointer; Size: Integer); -begin - SetLength(FBuffer, Size); - CopyMemory(PAnsiChar(FBuffer), VersionInfoData, Size); - ExtractData; -end; - -constructor TJclFileVersionInfo.Create(const FileName: string); -var - Handle: DWORD; - Size: DWORD; -begin - if not FileExists(FileName) then - raise EJclFileVersionInfoError.CreateResFmt(@RsFileUtilsFileDoesNotExist, [FileName]); - Handle := 0; - Size := GetFileVersionInfoSize(PChar(FileName), Handle); - if Size = 0 then - raise EJclFileVersionInfoError.CreateRes(@RsFileUtilsNoVersionInfo); - SetLength(FBuffer, Size); - Win32Check(GetFileVersionInfo(PChar(FileName), Handle, Size, PAnsiChar(FBuffer))); - ExtractData; -end; - -{$IFDEF MSWINDOWS} -{$IFDEF FPC} -constructor TJclFileVersionInfo.Create(const Window: HWND; Dummy: Pointer = nil); -{$ELSE} -constructor TJclFileVersionInfo.Create(const Window: HWND); -{$ENDIF} -begin - Create(WindowToModuleFileName(Window)); -end; - -constructor TJclFileVersionInfo.Create(const Module: HMODULE); -begin - if Module <> 0 then - Create(GetModulePath(Module)) - else - raise EJclError.CreateResFmt(@RsEModuleNotValid, [Module]); -end; -{$ENDIF MSWINDOWS} - -destructor TJclFileVersionInfo.Destroy; -begin - FreeAndNil(FItemList); - FreeAndNil(FItems); - inherited Destroy; -end; - -class function TJclFileVersionInfo.FileHasVersionInfo(const FileName: string): boolean; -var - Dummy: DWord; -begin - Result := GetFileVersionInfoSize(PChar(FileName), Dummy) <> 0; -end; - -procedure TJclFileVersionInfo.CheckLanguageIndex(Value: Integer); -begin - if (Value < 0) or (Value >= LanguageCount) then - raise EJclFileVersionInfoError.CreateRes(@RsFileUtilsLanguageIndex); -end; - -procedure TJclFileVersionInfo.CreateItemsForLanguage; -var - I: Integer; -begin - Items.Clear; - for I := 0 to FItemList.Count - 1 do - if Integer(FItemList.Objects[I]) = FLanguageIndex then - Items.AddObject(FItemList[I], Pointer(FLanguages[FLanguageIndex].Pair)); -end; - -procedure TJclFileVersionInfo.ExtractData; -var - Data, EndOfData: PAnsiChar; - Len, ValueLen, DataType: Word; - HeaderSize: Integer; - Key: string; - Error, IsUnicode: Boolean; - - procedure Padding(var DataPtr: PAnsiChar); - begin - while TJclAddr(DataPtr) and 3 <> 0 do - Inc(DataPtr); - end; - - procedure GetHeader; - var - P: PAnsiChar; - TempKey: PWideChar; - begin - Key := ''; - P := Data; - Len := PWord(P)^; - if Len = 0 then - begin - // do not raise error in the case of resources padded with 0 - while P < EndOfData do - begin - Error := P^ <> #0; - if Error then - Break; - Inc(P); - end; - Exit; - end; - Inc(P, SizeOf(Word)); - ValueLen := PWord(P)^; - Inc(P, SizeOf(Word)); - if IsUnicode then - begin - DataType := PWord(P)^; - Inc(P, SizeOf(Word)); - TempKey := PWideChar(P); - Inc(P, (lstrlenW(TempKey) + 1) * SizeOf(WideChar)); // length + #0#0 - Key := TempKey; - end - else - begin - DataType := 1; - Key := string(PAnsiChar(P)); - Inc(P, lstrlenA(PAnsiChar(P)) + 1); - end; - Padding(P); - HeaderSize := P - Data; - Data := P; - end; - - procedure FixKeyValue; - const - HexNumberCPrefix = '0x'; - var - I: Integer; - begin // GAPI32.DLL version 5.5.2803.1 contanins '04050x04E2' value - repeat - I := Pos(HexNumberCPrefix, Key); - if I > 0 then - Delete(Key, I, Length(HexNumberCPrefix)); - until I = 0; - I := 1; - while I <= Length(Key) do - if CharIsHexDigit(Key[I]) then - Inc(I) - else - Delete(Key, I, 1); - - // Office16\1031\GrooveIntlResource.dll contains a '4094B0' key. Both parts (lang and codepage) - // are missing their leading zero. It should have been '040904B0'. - // The Windows file property dialog falls back to "English (United States) 1252", so do we. - if Length(Key) < 8 then - Key := '040904E4'; - end; - - procedure ProcessStringInfo(Size: Integer); - var - EndPtr, EndStringPtr: PAnsiChar; - LangIndex: Integer; - LangIdRec: TLangIdRec; - Value: string; - begin - EndPtr := Data + Size; - LangIndex := 0; - while not Error and (Data < EndPtr) do - begin - GetHeader; // StringTable - FixKeyValue; - if (ValueLen <> 0) or (Length(Key) <> 8) then - begin - Error := True; - Break; - end; - Padding(Data); - LangIdRec.LangId := StrToIntDef('$' + Copy(Key, 1, 4), 0); - LangIdRec.CodePage := StrToIntDef('$' + Copy(Key, 5, 4), 0); - SetLength(FLanguages, LangIndex + 1); - FLanguages[LangIndex] := LangIdRec; - EndStringPtr := Data + Len - HeaderSize; - while not Error and (Data < EndStringPtr) do - begin - GetHeader; // string - case DataType of - 0: - if ValueLen in [1..4] then - Value := Format('$%.*x', [ValueLen * 2, PInteger(Data)^]) - else - begin - if (ValueLen > 0) and IsUnicode then - Value:=PWideChar(Data) - else - Value := ''; - end; - 1: - if ValueLen = 0 then - Value := '' - else - if IsUnicode then - begin - Value := WideCharLenToString(PWideChar(Data), ValueLen); - StrResetLength(Value); - end - else - Value := string(PAnsiChar(Data)); - else - Error := True; - Break; - end; - Inc(Data, Len - HeaderSize); - Padding(Data); // String.Padding - FItemList.AddObject(Format('%s=%s', [Key, Value]), Pointer(LangIndex)); - end; - Inc(LangIndex); - end; - end; - - procedure ProcessVarInfo; - var - TranslationIndex: Integer; - begin - GetHeader; // Var - if SameText(Key, 'Translation') then - begin - SetLength(FTranslations, ValueLen div SizeOf(TLangIdRec)); - for TranslationIndex := 0 to Length(FTranslations) - 1 do - begin - FTranslations[TranslationIndex] := PLangIdRec(Data)^; - Inc(Data, SizeOf(TLangIdRec)); - end; - end; - end; - -begin - FItemList := TStringList.Create; - FItems := TStringList.Create; - Data := Pointer(FBuffer); - Assert(TJclAddr(Data) mod 4 = 0); - IsUnicode := (PWord(Data + 4)^ in [0, 1]); - Error := True; - GetHeader; - EndOfData := Data + Len - HeaderSize; - if SameText(Key, 'VS_VERSION_INFO') and (ValueLen = SizeOf(TVSFixedFileInfo)) then - begin - FFixedInfo := PVSFixedFileInfo(Data); - Error := FFixedInfo.dwSignature <> $FEEF04BD; - Inc(Data, ValueLen); // VS_FIXEDFILEINFO - Padding(Data); // VS_VERSIONINFO.Padding2 - while not Error and (Data < EndOfData) do - begin - GetHeader; - Inc(Data, ValueLen); // some files (VREDIR.VXD 4.00.1111) has non zero value of ValueLen - Dec(Len, HeaderSize + ValueLen); - if SameText(Key, 'StringFileInfo') then - ProcessStringInfo(Len) - else - if SameText(Key, 'VarFileInfo') then - ProcessVarInfo - else - Break; - end; - ExtractFlags; - CreateItemsForLanguage; - end; - if Error then - raise EJclFileVersionInfoError.CreateRes(@RsFileUtilsNoVersionInfo); -end; - -procedure TJclFileVersionInfo.ExtractFlags; -var - Masked: DWORD; -begin - FFileFlags := []; - Masked := FFixedInfo^.dwFileFlags and FFixedInfo^.dwFileFlagsMask; - if (Masked and VS_FF_DEBUG) <> 0 then - Include(FFileFlags, ffDebug); - if (Masked and VS_FF_INFOINFERRED) <> 0 then - Include(FFileFlags, ffInfoInferred); - if (Masked and VS_FF_PATCHED) <> 0 then - Include(FFileFlags, ffPatched); - if (Masked and VS_FF_PRERELEASE) <> 0 then - Include(FFileFlags, ffPreRelease); - if (Masked and VS_FF_PRIVATEBUILD) <> 0 then - Include(FFileFlags, ffPrivateBuild); - if (Masked and VS_FF_SPECIALBUILD) <> 0 then - Include(FFileFlags, ffSpecialBuild); -end; - -function TJclFileVersionInfo.GetBinFileVersion: string; -begin - Result := Format('%u.%u.%u.%u', [HiWord(FFixedInfo^.dwFileVersionMS), - LoWord(FFixedInfo^.dwFileVersionMS), HiWord(FFixedInfo^.dwFileVersionLS), - LoWord(FFixedInfo^.dwFileVersionLS)]); -end; - -function TJclFileVersionInfo.GetBinProductVersion: string; -begin - Result := Format('%u.%u.%u.%u', [HiWord(FFixedInfo^.dwProductVersionMS), - LoWord(FFixedInfo^.dwProductVersionMS), HiWord(FFixedInfo^.dwProductVersionLS), - LoWord(FFixedInfo^.dwProductVersionLS)]); -end; - -function TJclFileVersionInfo.GetCustomFieldValue(const FieldName: string): string; -var - ItemIndex: Integer; -begin - if FieldName <> '' then - begin - ItemIndex := FItems.IndexOfName(FieldName); - if ItemIndex <> -1 then - //Return the required value, the value the user passed in was found. - Result := FItems.Values[FieldName] - else - raise EJclFileVersionInfoError.CreateResFmt(@RsFileUtilsValueNotFound, [FieldName]); - end - else - raise EJclFileVersionInfoError.CreateRes(@RsFileUtilsEmptyValue); -end; - -function TJclFileVersionInfo.GetFileOS: DWORD; -begin - Result := FFixedInfo^.dwFileOS; -end; - -function TJclFileVersionInfo.GetFileSubType: DWORD; -begin - Result := FFixedInfo^.dwFileSubtype; -end; - -function TJclFileVersionInfo.GetFileType: DWORD; -begin - Result := FFixedInfo^.dwFileType; -end; - -function TJclFileVersionInfo.GetFileVersionBuild: string; -var - Left: Integer; -begin - Result := FileVersion; - StrReplaceChar(Result, ',', '.'); - Left := CharLastPos(Result, '.') + 1; - Result := StrMid(Result, Left, Length(Result) - Left + 1); - Result := Trim(Result); -end; - -function TJclFileVersionInfo.GetFileVersionMajor: string; -begin - Result := FileVersion; - StrReplaceChar(Result, ',', '.'); - Result := StrBefore('.', Result); - Result := Trim(Result); -end; - -function TJclFileVersionInfo.GetFileVersionMinor: string; -var - Left, Right: integer; -begin - Result := FileVersion; - StrReplaceChar(Result, ',', '.'); - Left := CharPos(Result, '.') + 1; // skip major - Right := CharPos(Result, '.', Left) {-1}; - Result := StrMid(Result, Left, Right - Left {+1}); - Result := Trim(Result); -end; - -function TJclFileVersionInfo.GetFileVersionRelease: string; -var - Left, Right: Integer; -begin - Result := FileVersion; - StrReplaceChar(Result, ',', '.'); - Left := CharPos(Result, '.') + 1; // skip major - Left := CharPos(Result, '.', Left) + 1; // skip minor - Right := CharPos(Result, '.', Left) {-1}; - Result := StrMid(Result, Left, Right - Left {+1}); - Result := Trim(Result); -end; - -function TJclFileVersionInfo.GetFixedInfo: TVSFixedFileInfo; -begin - Result := FFixedInfo^; -end; - -function TJclFileVersionInfo.GetItems: TStrings; -begin - Result := FItems; -end; - -function TJclFileVersionInfo.GetLanguageCount: Integer; -begin - Result := Length(FLanguages); -end; - -function TJclFileVersionInfo.GetLanguageIds(Index: Integer): string; -begin - CheckLanguageIndex(Index); - Result := VersionLanguageId(FLanguages[Index]); -end; - -function TJclFileVersionInfo.GetLanguages(Index: Integer): TLangIdRec; -begin - CheckLanguageIndex(Index); - Result := FLanguages[Index]; -end; - -function TJclFileVersionInfo.GetLanguageNames(Index: Integer): string; -begin - CheckLanguageIndex(Index); - Result := VersionLanguageName(FLanguages[Index].LangId); -end; - -function TJclFileVersionInfo.GetTranslationCount: Integer; -begin - Result := Length(FTranslations); -end; - -function TJclFileVersionInfo.GetTranslations(Index: Integer): TLangIdRec; -begin - Result := FTranslations[Index]; -end; - -function TJclFileVersionInfo.GetProductVersionBuild: string; -var - Left: Integer; -begin - Result := ProductVersion; - StrReplaceChar(Result, ',', '.'); - Left := CharLastPos(Result, '.') + 1; - Result := StrMid(Result, Left, Length(Result) - Left + 1); - Result := Trim(Result); -end; - -function TJclFileVersionInfo.GetProductVersionMajor: string; -begin - Result := ProductVersion; - StrReplaceChar(Result, ',', '.'); - Result := StrBefore('.', Result); - Result := Trim(Result); -end; - -function TJclFileVersionInfo.GetProductVersionMinor: string; -var - Left, Right: integer; -begin - Result := ProductVersion; - StrReplaceChar(Result, ',', '.'); - Left := CharPos(Result, '.') + 1; // skip major - Right := CharPos(Result, '.', Left) {-1}; - Result := StrMid(Result, Left, Right - Left {+1}); - Result := Trim(Result); -end; - -function TJclFileVersionInfo.GetProductVersionRelease: string; -var - Left, Right: Integer; -begin - Result := ProductVersion; - StrReplaceChar(Result, ',', '.'); - Left := CharPos(Result, '.') + 1; // skip major - Left := CharPos(Result, '.', Left) + 1; // skip minor - Right := CharPos(Result, '.', Left) {-1}; - Result := StrMid(Result, Left, Right - Left {+1}); - Result := Trim(Result); -end; - -function TJclFileVersionInfo.GetVersionKeyValue(Index: Integer): string; -begin - Result := Items.Values[VerKeyNames[Index]]; -end; - -procedure TJclFileVersionInfo.SetLanguageIndex(const Value: Integer); -begin - CheckLanguageIndex(Value); - if FLanguageIndex <> Value then - begin - FLanguageIndex := Value; - CreateItemsForLanguage; - end; -end; - -function TJclFileVersionInfo.TranslationMatchesLanguages(Exact: Boolean): Boolean; -var - TransIndex, LangIndex: Integer; - TranslationPair: DWORD; -begin - Result := (LanguageCount = TranslationCount) or (not Exact and (TranslationCount > 0)); - if Result then - for TransIndex := 0 to TranslationCount - 1 do - begin - TranslationPair := FTranslations[TransIndex].Pair; - LangIndex := LanguageCount - 1; - while (LangIndex >= 0) and (TranslationPair <> FLanguages[LangIndex].Pair) do - Dec(LangIndex); - if LangIndex < 0 then - begin - Result := False; - Break; - end; - end; -end; - -class function TJclFileVersionInfo.VersionLanguageId(const LangIdRec: TLangIdRec): string; -begin - with LangIdRec do - Result := Format('%.4x%.4x', [LangId, CodePage]); -end; - -class function TJclFileVersionInfo.VersionLanguageName(const LangId: Word): string; -var - R: DWORD; -begin - SetLength(Result, MAX_PATH); - R := VerLanguageName(LangId, PChar(Result), MAX_PATH); - SetLength(Result, R); -end; - -{$ENDIF MSWINDOWS} - -//=== { TJclFileMaskComparator } ============================================= - -constructor TJclFileMaskComparator.Create; -begin - inherited Create; - FSeparator := DirSeparator; -end; - -function TJclFileMaskComparator.Compare(const NameExt: string): Boolean; -var - I: Integer; - NamePart, ExtPart: string; - NameWild, ExtWild: Boolean; -begin - Result := False; - I := StrLastPos('.', NameExt); - if I = 0 then - begin - NamePart := NameExt; - ExtPart := ''; - end - else - begin - NamePart := Copy(NameExt, 1, I - 1); - ExtPart := Copy(NameExt, I + 1, Length(NameExt)); - end; - for I := 0 to Length(FNames) - 1 do - begin - NameWild := FWildChars[I] and 1 = 1; - ExtWild := FWildChars[I] and 2 = 2; - if ((not NameWild and StrSame(FNames[I], NamePart)) or - (NameWild and (StrMatches(FNames[I], NamePart, 1)))) and - ((not ExtWild and StrSame(FExts[I], ExtPart)) or - (ExtWild and (StrMatches(FExts[I], ExtPart, 1)))) then - begin - Result := True; - Break; - end; - end; -end; - -procedure TJclFileMaskComparator.CreateMultiMasks; -var - List: TStringList; - I, N: Integer; - NS, ES: string; -begin - FExts := nil; - FNames := nil; - FWildChars := nil; - List := TStringList.Create; - try - StrToStrings(FFileMask, FSeparator, List); - SetLength(FExts, List.Count); - SetLength(FNames, List.Count); - SetLength(FWildChars, List.Count); - for I := 0 to List.Count - 1 do - begin - N := StrLastPos('.', List[I]); - if N = 0 then - begin - NS := List[I]; - ES := ''; - end - else - begin - NS := Copy(List[I], 1, N - 1); - ES := Copy(List[I], N + 1, 255); - end; - FNames[I] := NS; - FExts[I] := ES; - N := 0; - if StrContainsChars(NS, CharIsWildcard, False) then - N := N or 1; - if StrContainsChars(ES, CharIsWildcard, False) then - N := N or 2; - FWildChars[I] := N; - end; - finally - List.Free; - end; -end; - -function TJclFileMaskComparator.GetCount: Integer; -begin - Result := Length(FWildChars); -end; - -function TJclFileMaskComparator.GetExts(Index: Integer): string; -begin - Result := FExts[Index]; -end; - -function TJclFileMaskComparator.GetMasks(Index: Integer): string; -begin - Result := FNames[Index] + '.' + FExts[Index]; -end; - -function TJclFileMaskComparator.GetNames(Index: Integer): string; -begin - Result := FNames[Index]; -end; - -procedure TJclFileMaskComparator.SetFileMask(const Value: string); -begin - FFileMask := Value; - CreateMultiMasks; -end; - -procedure TJclFileMaskComparator.SetSeparator(const Value: Char); -begin - if FSeparator <> Value then - begin - FSeparator := Value; - CreateMultiMasks; - end; -end; - -function AdvBuildFileList(const Path: string; const Attr: Integer; const Files: TStrings; - const AttributeMatch: TJclAttributeMatch; const Options: TFileListOptions; - const SubfoldersMask: string; const FileMatchFunc: TFileMatchFunc): Boolean; -var - FileMask: string; - RootDir: string; - Folders: TStringList; - CurrentItem: Integer; - Counter: Integer; - FindAttr: Integer; - - procedure BuildFolderList; - var - FindInfo: TSearchRec; - Rslt: Integer; - begin - Counter := Folders.Count - 1; - CurrentItem := 0; - - while CurrentItem <= Counter do - begin - // searching for subfolders (including hidden ones) - Rslt := FindFirst(Folders[CurrentItem] + '*.*', faAnyFile, FindInfo); - try - while Rslt = 0 do - begin - if (FindInfo.Name <> '.') and (FindInfo.Name <> '..') and - (FindInfo.Attr and faDirectory = faDirectory) then - Folders.Add(Folders[CurrentItem] + FindInfo.Name + DirDelimiter); - - Rslt := FindNext(FindInfo); - end; - finally - FindClose(FindInfo); - end; - Counter := Folders.Count - 1; - Inc(CurrentItem); - end; - end; - - procedure FillFileList(CurrentCounter: Integer); - var - FindInfo: TSearchRec; - Rslt: Integer; - CurrentFolder: string; - Matches: Boolean; - begin - CurrentFolder := Folders[CurrentCounter]; - - Rslt := FindFirst(CurrentFolder + FileMask, FindAttr, FindInfo); - - try - while Rslt = 0 do - begin - Matches := False; - - case AttributeMatch of - amAny: - Matches := True; - amExact: - Matches := Attr = FindInfo.Attr; - amSubSetOf: - Matches := (Attr and FindInfo.Attr) = Attr; - amSuperSetOf: - Matches := (Attr and FindInfo.Attr) = FindInfo.Attr; - amCustom: - if Assigned(FileMatchFunc) then - Matches := FileMatchFunc(Attr, FindInfo); - end; - - if Matches then - if flFullNames in Options then - Files.Add(CurrentFolder + FindInfo.Name) - else - Files.Add(FindInfo.Name); - - Rslt := FindNext(FindInfo); - end; - finally - FindClose(FindInfo); - end; - end; - -begin - Assert(Assigned(Files)); - FileMask := ExtractFileName(Path); - RootDir := ExtractFilePath(Path); - - Folders := TStringList.Create; - Files.BeginUpdate; - try - Folders.Add(RootDir); - - case AttributeMatch of - amExact, amSuperSetOf: - FindAttr := Attr; - else - FindAttr := faAnyFile; - end; - - // here's the recursive search for nested folders - - if flRecursive in Options then - BuildFolderList; - - for Counter := 0 to Folders.Count - 1 do - begin - if (((flMaskedSubfolders in Options) and (StrMatches(SubfoldersMask, - Folders[Counter], 1))) or (not (flMaskedSubfolders in Options))) then - FillFileList(Counter); - end; - finally - Folders.Free; - Files.EndUpdate; - end; - Result := True; -end; - -function VerifyFileAttributeMask(var RejectedAttributes, RequiredAttributes: Integer): Boolean; -begin - if RequiredAttributes and faNormalFile <> 0 then - RejectedAttributes := not faNormalFile or RejectedAttributes; - Result := RequiredAttributes and RejectedAttributes = 0; -end; - -function AttributeMatch(FileAttributes, RejectedAttr, RequiredAttr: Integer): Boolean; -begin - if FileAttributes = 0 then - FileAttributes := faNormalFile; - {$IFDEF MSWINDOWS} - RequiredAttr := RequiredAttr and not faUnixSpecific; - {$ENDIF MSWINDOWS} - {$IFDEF UNIX} - RequiredAttr := RequiredAttr and not faWindowsSpecific; - {$ENDIF UNIX} - Result := (FileAttributes and RejectedAttr = 0) - and (FileAttributes and RequiredAttr = RequiredAttr); -end; - -function IsFileAttributeMatch(FileAttributes, RejectedAttributes, - RequiredAttributes: Integer): Boolean; -begin - VerifyFileAttributeMask(RejectedAttributes, RequiredAttributes); - Result := AttributeMatch(FileAttributes, RejectedAttributes, RequiredAttributes); -end; - -function FileAttributesStr(const FileInfo: TSearchRec): string; -{$IFDEF MSWINDOWS} -const - SAllAttrSet = 'rahs'; // readonly, archive, hidden, system - Attributes: array [1..4] of Integer = - (faReadOnly, faArchive, faHidden, faSysFile); -var - I: Integer; -begin - Result := SAllAttrSet; - for I := Low(Attributes) to High(Attributes) do - if (FileInfo.Attr and Attributes[I]) = 0 then - Result[I] := '-'; -end; -{$ENDIF MSWINDOWS} -{$IFDEF UNIX} -const - SAllAttrSet = 'drwxrwxrwx'; -var - I: Integer; - Flag: Cardinal; -begin - Result := SAllAttrSet; - if FileInfo.Attr and faDirectory = 0 then - Result[1] := '-'; // no directory - Flag := 1 shl 8; - for I := 2 to 10 do - begin - if FileInfo.Mode and Flag = 0 then - Result[I] := '-'; - Flag := Flag shr 1; - end; -end; -{$ENDIF UNIX} - -function IsFileNameMatch(FileName: string; const Mask: string; - const CaseSensitive: Boolean): Boolean; -begin - Result := True; - {$IFDEF MSWINDOWS} - if (Mask = '') or (Mask = '*') or (Mask = '*.*') then - Exit; - if Pos('.', FileName) = 0 then - FileName := FileName + '.'; // file names w/o extension match '*.' - {$ENDIF MSWINDOWS} - {$IFDEF UNIX} - if (Mask = '') or (Mask = '*') then - Exit; - {$ENDIF UNIX} - if CaseSensitive then - Result := StrMatches(Mask, FileName) - else - Result := StrMatches(AnsiUpperCase(Mask), AnsiUpperCase(FileName)); -end; - -// author: Robert Rossmair - -function CanonicalizedSearchPath(const Directory: string): string; -begin - Result := PathCanonicalize(Directory); - {$IFDEF MSWINDOWS} - // avoid changing "X:" (current directory on drive X:) into "X:\" (root dir.) - if Result[Length(Result)] <> ':' then - {$ENDIF MSWINDOWS} - Result := PathAddSeparator(Result); - // strip leading "./" resp. ".\" - if Pos('.' + DirDelimiter, Result) = 1 then - Result := Copy(Result, 3, Length(Result) - 2); -end; - -procedure EnumFiles(const Path: string; HandleFile: TFileHandlerEx; - RejectedAttributes: Integer; RequiredAttributes: Integer; Abort: PBoolean); -var - Directory: string; - FileInfo: TSearchRec; - Attr: Integer; - Found: Boolean; -begin - Assert(Assigned(HandleFile)); - Assert(VerifyFileAttributeMask(RejectedAttributes, RequiredAttributes), - LoadResString(@RsFileSearchAttrInconsistency)); - - Directory := ExtractFilePath(Path); - - Attr := faAnyFile and not RejectedAttributes; - - Found := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindFirst(Path, Attr, FileInfo) = 0; - try - while Found do - begin - if (Abort <> nil) and LongBool(Abort^) then - Exit; - if AttributeMatch(FileInfo.Attr, RejectedAttributes, RequiredAttributes) then - if ((FileInfo.Attr and faDirectory = 0) - or ((FileInfo.Name <> '.') and (FileInfo.Name <> '..'))) then - HandleFile(Directory, FileInfo); - Found := FindNext(FileInfo) = 0; - end; - finally - FindClose(FileInfo); - end; -end; - -procedure EnumFiles(const Path: string; HandleFile: TFileInfoHandlerEx; - RejectedAttributes: Integer; RequiredAttributes: Integer; Abort: PBoolean); -var - FileInfo: TSearchRec; - Attr: Integer; - Found: Boolean; -begin - Assert(Assigned(HandleFile)); - Assert(VerifyFileAttributeMask(RejectedAttributes, RequiredAttributes), - LoadResString(@RsFileSearchAttrInconsistency)); - - Attr := faAnyFile and not RejectedAttributes; - - Found := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindFirst(Path, Attr, FileInfo) = 0; - try - while Found do - begin - if (Abort <> nil) and LongBool(Abort^) then - Exit; - if AttributeMatch(FileInfo.Attr, RejectedAttributes, RequiredAttributes) then - if ((FileInfo.Attr and faDirectory = 0) - or ((FileInfo.Name <> '.') and (FileInfo.Name <> '..'))) then - HandleFile(FileInfo); - Found := FindNext(FileInfo) = 0; - end; - finally - FindClose(FileInfo); - end; -end; - -procedure EnumDirectories(const Root: string; const HandleDirectory: TFileHandler; - const IncludeHiddenDirectories: Boolean; const SubDirectoriesMask: string; - Abort: PBoolean {$IFDEF UNIX}; ResolveSymLinks: Boolean {$ENDIF}); -var - RootDir: string; - Attr: Integer; - - procedure Process(const Directory: string); - var - DirInfo: TSearchRec; - SubDir: string; - Found: Boolean; - begin - HandleDirectory(Directory); - - Found := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindFirst(Directory + '*', Attr, DirInfo) = 0; - try - while Found do - begin - if (Abort <> nil) and LongBool(Abort^) then - Exit; - if (DirInfo.Name <> '.') and (DirInfo.Name <> '..') and - {$IFDEF UNIX} - (IncludeHiddenDirectories or (Pos('.', DirInfo.Name) <> 1)) and - ((DirInfo.Attr and faSymLink = 0) or ResolveSymLinks) and - {$ENDIF UNIX} - (DirInfo.Attr and faDirectory <> 0) then - begin - SubDir := Directory + DirInfo.Name + DirDelimiter; - if (SubDirectoriesMask = '') or StrMatches(SubDirectoriesMask, SubDir, Length(RootDir)) then - Process(SubDir); - end; - Found := FindNext(DirInfo) = 0; - end; - finally - FindClose(DirInfo); - end; - end; - -begin - Assert(Assigned(HandleDirectory)); - RootDir := CanonicalizedSearchPath(Root); - - if IncludeHiddenDirectories then - Attr := faDirectory + faHidden // no effect on Linux - else - Attr := faDirectory; - - Process(RootDir); -end; - -//=== { TJclCustomFileAttributeMask } ============================================== - -constructor TJclCustomFileAttrMask.Create; -begin - inherited Create; - FRejectedAttr := faRejectedByDefault; -end; - -procedure TJclCustomFileAttrMask.Assign(Source: TPersistent); -begin - if Source is TJclCustomFileAttrMask then - begin - Required := TJclCustomFileAttrMask(Source).Required; - Rejected := TJclCustomFileAttrMask(Source).Rejected; - end - else - inherited Assign(Source); -end; - -procedure TJclCustomFileAttrMask.Clear; -begin - Rejected := 0; - Required := 0; -end; - -procedure TJclCustomFileAttrMask.DefineProperties(Filer: TFiler); -var - Ancestor: TJclCustomFileAttrMask; - Attr: Integer; -begin - Attr := 0; - Ancestor := TJclCustomFileAttrMask(Filer.Ancestor); - if Assigned(Ancestor) then - Attr := Ancestor.FRequiredAttr; - Filer.DefineProperty('Required', ReadRequiredAttributes, WriteRequiredAttributes, - Attr <> FRequiredAttr); - if Assigned(Ancestor) then - Attr := Ancestor.FRejectedAttr; - Filer.DefineProperty('Rejected', ReadRejectedAttributes, WriteRejectedAttributes, - Attr <> FRejectedAttr); -end; - -function TJclCustomFileAttrMask.Match(FileAttributes: Integer): Boolean; -begin - Result := AttributeMatch(FileAttributes, Rejected, Required); -end; - -function TJclCustomFileAttrMask.Match(const FileInfo: TSearchRec): Boolean; -begin - Result := Match(FileInfo.Attr); -end; - -function TJclCustomFileAttrMask.GetAttr(Index: Integer): TAttributeInterest; -begin - if ((FRequiredAttr and Index) <> 0) or (Index = faNormalFile) and - (FRejectedAttr = not faNormalFile) then - Result := aiRequired - else - if (FRejectedAttr and Index) <> 0 then - Result := aiRejected - else - Result := aiIgnored; -end; - -procedure TJclCustomFileAttrMask.ReadRejectedAttributes(Reader: TReader); -begin - FRejectedAttr := Reader.ReadInteger; -end; - -procedure TJclCustomFileAttrMask.ReadRequiredAttributes(Reader: TReader); -begin - FRequiredAttr := Reader.ReadInteger; -end; - -procedure TJclCustomFileAttrMask.SetAttr(Index: Integer; const Value: TAttributeInterest); -begin - case Value of - aiIgnored: - begin - FRequiredAttr := FRequiredAttr and not Index; - FRejectedAttr := FRejectedAttr and not Index; - end; - aiRejected: - begin - FRequiredAttr := FRequiredAttr and not Index; - FRejectedAttr := FRejectedAttr or Index; - end; - aiRequired: - begin - if Index = faNormalFile then - begin - FRequiredAttr := faNormalFile; - FRejectedAttr := not faNormalFile; - end - else - begin - FRequiredAttr := FRequiredAttr or Index; - FRejectedAttr := FRejectedAttr and not Index; - end; - end; - end; -end; - -procedure TJclCustomFileAttrMask.WriteRejectedAttributes(Writer: TWriter); -begin - Writer.WriteInteger(FRejectedAttr); -end; - -procedure TJclCustomFileAttrMask.WriteRequiredAttributes(Writer: TWriter); -begin - Writer.WriteInteger(FRequiredAttr); -end; - -//=== { TJclFileAttributeMask } ============================================== - -procedure TJclFileAttributeMask.ReadVolumeID(Reader: TReader); -begin - // Nothing, we are not interested in the value of the VolumeID property, - // this procedure and the associated DefineProperty call are here only - // to allow reading legacy DFMs that have this property defined. -end; - -procedure TJclFileAttributeMask.DefineProperties(Filer: TFiler); -begin - inherited DefineProperties(Filer); - - Filer.DefineProperty('VolumeID', ReadVolumeID, nil, False); -end; - -//=== { TJclFileSearchOptions } ============================================== - -constructor TJclFileSearchOptions.Create; -begin - inherited Create; - - FAttributeMask := TJclFileAttributeMask.Create; - FRootDirectories := TStringList.Create; - FRootDirectories.Add('.'); - FFileMasks := TStringList.Create; - FFileMasks.Add('*'); - FSubDirectoryMask := '*'; - FOptions := [fsIncludeSubDirectories]; - FLastChangeAfter := MinDateTime; - FLastChangeBefore := MaxDateTime; - {$IFDEF UNIX} - FCaseSensitiveSearch := True; - {$ENDIF UNIX} -end; - -destructor TJclFileSearchOptions.Destroy; -begin - FAttributeMask.Free; - FFileMasks.Free; - FRootDirectories.Free; - - inherited Destroy; -end; - -procedure TJclFileSearchOptions.Assign(Source: TPersistent); -var - Src: TJclFileSearchOptions; -begin - if Source is TJclFileSearchOptions then - begin - Src := TJclFileSearchOptions(Source); - FCaseSensitiveSearch := Src.FCaseSensitiveSearch; - FileMasks.Assign(Src.FileMasks); - RootDirectory := Src.RootDirectory; - SubDirectoryMask := Src.SubDirectoryMask; - AttributeMask := Src.AttributeMask; - Options := Src.Options; - FileSizeMin := Src.FileSizeMin; - FileSizeMax := Src.FileSizeMax; - LastChangeAfter := Src.LastChangeAfter; - LastChangeBefore := Src.LastChangeBefore; - end - else - inherited Assign(Source); -end; - -function TJclFileSearchOptions.GetAttributeMask: TJclFileAttributeMask; -begin - Result := FAttributeMask; -end; - -function TJclFileSearchOptions.GetCaseSensitiveSearch: Boolean; -begin - Result := FCaseSensitiveSearch; -end; - -function TJclFileSearchOptions.GetFileMask: string; -begin - Result := StringsToStr(FileMasks, DirSeparator, False); -end; - -function TJclFileSearchOptions.GetFileMasks: TStrings; -begin - Result := FFileMasks; -end; - -function TJclFileSearchOptions.GetFileSizeMax: Int64; -begin - Result := FFileSizeMax; -end; - -function TJclFileSearchOptions.GetFileSizeMin: Int64; -begin - Result := FFileSizeMin; -end; - -function TJclFileSearchOptions.GetIncludeHiddenSubDirectories: Boolean; -begin - Result := fsIncludeHiddenSubDirectories in Options; -end; - -function TJclFileSearchOptions.GetIncludeSubDirectories: Boolean; -begin - Result := fsIncludeSubDirectories in Options; -end; - -function TJclFileSearchOptions.GetLastChangeAfter: TDateTime; -begin - Result := FLastChangeAfter; -end; - -function TJclFileSearchOptions.GetLastChangeAfterStr: string; -begin - Result := DateTimeToStr(LastChangeAfter); -end; - -function TJclFileSearchOptions.GetLastChangeBefore: TDateTime; -begin - Result := FLastChangeBefore; -end; - -function TJclFileSearchOptions.GetLastChangeBeforeStr: string; -begin - Result := DateTimeToStr(LastChangeBefore); -end; - -function TJclFileSearchOptions.GetOption( - const Option: TFileSearchOption): Boolean; -begin - Result := Option in FOptions; -end; - -function TJclFileSearchOptions.GetOptions: TFileSearchoptions; -begin - Result := FOptions; -end; - -function TJclFileSearchOptions.GetRootDirectories: TStrings; -begin - Result := FRootDirectories; -end; - -function TJclFileSearchOptions.GetRootDirectory: string; -begin - if FRootDirectories.Count = 1 then - Result := FRootDirectories.Strings[0] - else - Result := ''; -end; - -function TJclFileSearchOptions.GetSubDirectoryMask: string; -begin - Result := FSubDirectoryMask; -end; - -function TJclFileSearchOptions.IsLastChangeAfterStored: Boolean; -begin - Result := FLastChangeAfter <> MinDateTime; -end; - -function TJclFileSearchOptions.IsLastChangeBeforeStored: Boolean; -begin - Result := FLastChangeBefore <> MaxDateTime; -end; - -procedure TJclFileSearchOptions.SetAttributeMask( - const Value: TJclFileAttributeMask); -begin - FAttributeMask.Assign(Value); -end; - -procedure TJclFileSearchOptions.SetCaseSensitiveSearch(const Value: Boolean); -begin - FCaseSensitiveSearch := Value; -end; - -procedure TJclFileSearchOptions.SetFileMask(const Value: string); -begin - { TODO : UNIX : ? } - StrToStrings(Value, DirSeparator, FFileMasks, False); -end; - -procedure TJclFileSearchOptions.SetFileMasks(const Value: TStrings); -begin - FileMasks.Assign(Value); -end; - -procedure TJclFileSearchOptions.SetFileSizeMax(const Value: Int64); -begin - FFileSizeMax := Value; -end; - -procedure TJclFileSearchOptions.SetFileSizeMin(const Value: Int64); -begin - FFileSizeMin := Value; -end; - -procedure TJclFileSearchOptions.SetIncludeHiddenSubDirectories( - const Value: Boolean); -begin - SetOption(fsIncludeHiddenSubDirectories, Value); -end; - -procedure TJclFileSearchOptions.SetIncludeSubDirectories(const Value: Boolean); -begin - SetOption(fsIncludeSubDirectories, Value); -end; - -procedure TJclFileSearchOptions.SetLastChangeAfter(const Value: TDateTime); -begin - FLastChangeAfter := Value; -end; - -procedure TJclFileSearchOptions.SetLastChangeAfterStr(const Value: string); -begin - if Value = '' then - LastChangeAfter := MinDateTime - else - LastChangeAfter := StrToDateTime(Value); -end; - -procedure TJclFileSearchOptions.SetLastChangeBefore(const Value: TDateTime); -begin - FLastChangeBefore := Value; -end; - -procedure TJclFileSearchOptions.SetLastChangeBeforeStr(const Value: string); -begin - if Value = '' then - LastChangeBefore := MaxDateTime - else - LastChangeBefore := StrToDateTime(Value); -end; - -procedure TJclFileSearchOptions.SetOption(const Option: TFileSearchOption; - const Value: Boolean); -begin - if Value then - Include(FOptions, Option) - else - Exclude(FOptions, Option); -end; - -procedure TJclFileSearchOptions.SetOptions(const Value: TFileSearchOptions); -begin - FOptions := Value; -end; - -procedure TJclFileSearchOptions.SetRootDirectories(const Value: TStrings); -begin - FRootDirectories.Assign(Value); -end; - -procedure TJclFileSearchOptions.SetRootDirectory(const Value: string); -begin - FRootDirectories.Clear; - FRootDirectories.Add(Value); -end; - -procedure TJclFileSearchOptions.SetSubDirectoryMask(const Value: string); -begin - FSubDirectoryMask := Value; -end; - -//=== { TEnumFileThread } ==================================================== - -type - TEnumFileThread = class(TThread) - private - FID: TFileSearchTaskID; - FFileMasks: TStringList; - FDirectories: TStrings; - FCurrentDirectory: string; - FSubDirectoryMask: string; - FOnEnterDirectory: TFileHandler; - FFileHandlerEx: TFileHandlerEx; - FFileHandler: TFileHandler; - FInternalDirHandler: TFileHandler; - FInternalFileInfoHandler: TFileInfoHandlerEx; - FFileInfo: TSearchRec; - FRejectedAttr: Integer; - FRequiredAttr: Integer; - FFileSizeMin: Int64; - FFileSizeMax: Int64; - {$IFDEF RTL220_UP} - FFileTimeMin: TDateTime; - FFileTimeMax: TDateTime; - {$ELSE ~RTL220_UP} - FFileTimeMin: Integer; - FFileTimeMax: Integer; - {$ENDIF ~RTL220_UP} - FSynchronizationMode: TFileEnumeratorSyncMode; - FIncludeSubDirectories: Boolean; - FIncludeHiddenSubDirectories: Boolean; - FNotifyOnTermination: Boolean; - FCaseSensitiveSearch: Boolean; - FAllNamesMatch: Boolean; - procedure EnterDirectory; - procedure AsyncProcessDirectory(const Directory: string); - procedure SyncProcessDirectory(const Directory: string); - procedure AsyncProcessFile(const FileInfo: TSearchRec); - procedure SyncProcessFile(const FileInfo: TSearchRec); - function GetDirectories: TStrings; - function GetFileMasks: TStrings; - procedure SetDirectories(const Value: TStrings); - procedure SetFileMasks(const Value: TStrings); - protected - procedure DoTerminate; override; - procedure Execute; override; - function FileMatch: Boolean; - function FileNameMatchesMask: Boolean; - procedure ProcessDirectory; - procedure ProcessDirFiles; - procedure ProcessFile; - property AllNamesMatch: Boolean read FAllNamesMatch; - property CaseSensitiveSearch: Boolean read FCaseSensitiveSearch write FCaseSensitiveSearch; - property FileMasks: TStrings read GetFileMasks write SetFileMasks; - property FileSizeMin: Int64 read FFileSizeMin write FFileSizeMin; - property FileSizeMax: Int64 read FFileSizeMax write FFileSizeMax; - {$IFDEF RTL220_UP} - property FileTimeMin: TDateTime read FFileTimeMin write FFileTimeMin; - property FileTimeMax: TDateTime read FFileTimeMax write FFileTimeMax; - {$ELSE ~RTL220_UP} - property FileTimeMin: Integer read FFileTimeMin write FFileTimeMin; - property FileTimeMax: Integer read FFileTimeMax write FFileTimeMax; - {$ENDIF ~RTL220_UP} - property Directories: TStrings read GetDirectories write SetDirectories; - property IncludeSubDirectories: Boolean - read FIncludeSubDirectories write FIncludeSubDirectories; - property IncludeHiddenSubDirectories: Boolean - read FIncludeHiddenSubDirectories write FIncludeHiddenSubDirectories; - property RejectedAttr: Integer read FRejectedAttr write FRejectedAttr; - property RequiredAttr: Integer read FRequiredAttr write FRequiredAttr; - property SynchronizationMode: TFileEnumeratorSyncMode - read FSynchronizationMode write FSynchronizationMode; - public - constructor Create; - destructor Destroy; override; - property ID: TFileSearchTaskID read FID; - {$IFDEF FPC} // protected property - property Terminated; - {$ENDIF FPC} - end; - -constructor TEnumFileThread.Create; -begin - inherited Create(True); - FDirectories := TStringList.Create; - FFileMasks := TStringList.Create; - {$IFDEF RTL220_UP} - FFileTimeMin := -MaxDouble; - FFileTimeMax := MaxDouble; - {$ELSE ~RTL220_UP} - FFileTimeMin := Low(FFileInfo.Time); - FFileTimeMax := High(FFileInfo.Time); - {$ENDIF ~RTL220_UP} - FFileSizeMax := High(FFileSizeMax); - {$IFDEF MSWINDOWS} - Priority := tpIdle; - {$ENDIF MSWINDOWS} - {$IFDEF UNIX} - {$IFDEF FPC} - Priority := tpIdle; - {$ELSE ~FPC} - Priority := 0; - {$ENDIF ~FPC} - {$ENDIF UNIX} - FreeOnTerminate := True; - FNotifyOnTermination := True; -end; - -destructor TEnumFileThread.Destroy; -begin - FFileMasks.Free; - FDirectories.Free; - inherited Destroy; -end; - -procedure TEnumFileThread.Execute; -var - Index: Integer; -begin - if SynchronizationMode = smPerDirectory then - begin - FInternalDirHandler := SyncProcessDirectory; - FInternalFileInfoHandler := AsyncProcessFile; - end - else // SynchronizationMode = smPerFile - begin - FInternalDirHandler := AsyncProcessDirectory; - FInternalFileInfoHandler := SyncProcessFile; - end; - - if FIncludeSubDirectories then - begin - for Index := 0 to FDirectories.Count - 1 do - EnumDirectories(FDirectories.Strings[Index], FInternalDirHandler, FIncludeHiddenSubDirectories, - FSubDirectoryMask, @Terminated) - end - else - begin - for Index := 0 to FDirectories.Count - 1 do - FInternalDirHandler(CanonicalizedSearchPath(FDirectories.Strings[Index])); - end; -end; - -procedure TEnumFileThread.DoTerminate; -begin - if FNotifyOnTermination then - inherited DoTerminate; -end; - -procedure TEnumFileThread.EnterDirectory; -begin - FOnEnterDirectory(FCurrentDirectory); -end; - -procedure TEnumFileThread.ProcessDirectory; -begin - if Assigned(FOnEnterDirectory) then - EnterDirectory; - ProcessDirFiles; -end; - -procedure TEnumFileThread.AsyncProcessDirectory(const Directory: string); -begin - FCurrentDirectory := Directory; - if Assigned(FOnEnterDirectory) then - Synchronize(EnterDirectory); - ProcessDirFiles; -end; - -procedure TEnumFileThread.SyncProcessDirectory(const Directory: string); -begin - FCurrentDirectory := Directory; - Synchronize(ProcessDirectory); -end; - -procedure TEnumFileThread.ProcessDirFiles; -begin - EnumFiles(FCurrentDirectory + '*', FInternalFileInfoHandler, FRejectedAttr, FRequiredAttr, @Terminated); -end; - -function TEnumFileThread.FileMatch: Boolean; -var - FileSize: Int64; -begin - {$IFDEF RTL220_UP} - Result := FileNameMatchesMask and (FFileInfo.TimeStamp >= FFileTimeMin) and (FFileInfo.TimeStamp <= FFileTimeMax); - {$ELSE ~RTL220_UP} - Result := FileNameMatchesMask and (FFileInfo.Time >= FFileTimeMin) and (FFileInfo.Time <= FFileTimeMax); - {$ENDIF ~RTL220_UP} - if Result then - begin - FileSize := GetSizeOfFile(FFileInfo); - Result := (FileSize >= FFileSizeMin) and (FileSize <= FFileSizeMax); - end; -end; - -function TEnumFileThread.FileNameMatchesMask: Boolean; -var - I: Integer; -begin - Result := AllNamesMatch; - if not Result then - for I := 0 to FileMasks.Count - 1 do - if IsFileNameMatch(FFileInfo.Name, FileMasks[I], CaseSensitiveSearch) then - begin - Result := True; - Break; - end; -end; - -procedure TEnumFileThread.ProcessFile; -begin - if Assigned(FFileHandlerEx) then - FFileHandlerEx(FCurrentDirectory, FFileInfo) - else - FFileHandler(FCurrentDirectory + FFileInfo.Name); -end; - -procedure TEnumFileThread.AsyncProcessFile(const FileInfo: TSearchRec); -begin - FFileInfo := FileInfo; - if FileMatch then - ProcessFile; -end; - -procedure TEnumFileThread.SyncProcessFile(const FileInfo: TSearchRec); -begin - FFileInfo := FileInfo; - if FileMatch then - Synchronize(ProcessFile); -end; - -function TEnumFileThread.GetDirectories: TStrings; -begin - Result := FDirectories; -end; - -function TEnumFileThread.GetFileMasks: TStrings; -begin - Result := FFileMasks; -end; - -procedure TEnumFileThread.SetDirectories(const Value: TStrings); -begin - FDirectories.Assign(Value); -end; - -procedure TEnumFileThread.SetFileMasks(const Value: TStrings); -var - I: Integer; -begin - FAllNamesMatch := Value.Count = 0; - for I := 0 to Value.Count - 1 do - if (Value[I] = '*') {$IFDEF MSWINDOWS} or (Value[I] = '*.*') {$ENDIF} then - begin - FAllNamesMatch := True; - Break; - end; - if FAllNamesMatch then - FileMasks.Clear - else - FileMasks.Assign(Value); -end; - -//=== { TJclFileEnumerator } ================================================= - -constructor TJclFileEnumerator.Create; -begin - inherited Create; - FTasks := TList.Create; -end; - -destructor TJclFileEnumerator.Destroy; -begin - StopAllTasks(True); - FTasks.Free; - inherited Destroy; -end; - -procedure TJclFileEnumerator.Assign(Source: TPersistent); -var - Src: TJclFileEnumerator; -begin - if Source is TJclFileEnumerator then - begin - Src := TJclFileEnumerator(Source); - SynchronizationMode := Src.SynchronizationMode; - OnEnterDirectory := Src.OnEnterDirectory; - OnTerminateTask := Src.OnTerminateTask; - end; - inherited Assign(Source); -end; - -function TJclFileEnumerator.CreateTask: TThread; -var - Task: TEnumFileThread; -begin - Task := TEnumFileThread.Create; - Task.FID := NextTaskID; - Task.CaseSensitiveSearch := FCaseSensitiveSearch; - Task.FileMasks := FileMasks; - Task.Directories := RootDirectories; - Task.RejectedAttr := AttributeMask.Rejected; - Task.RequiredAttr := AttributeMask.Required; - Task.IncludeSubDirectories := IncludeSubDirectories; - Task.IncludeHiddenSubDirectories := IncludeHiddenSubDirectories; - if fsMinSize in Options then - Task.FileSizeMin := FileSizeMin; - if fsMaxSize in Options then - Task.FileSizeMax := FileSizeMax; - if fsLastChangeAfter in Options then - Task.FFileTimeMin := {$IFDEF RTL220_UP}LastChangeAfter{$ELSE}DateTimeToFileDate(LastChangeAfter){$ENDIF}; - if fsLastChangeBefore in Options then - Task.FFileTimeMax := {$IFDEF RTL220_UP}LastChangeBefore{$ELSE}DateTimeToFileDate(LastChangeBefore){$ENDIF}; - Task.SynchronizationMode := SynchronizationMode; - Task.FOnEnterDirectory := OnEnterDirectory; - Task.OnTerminate := TaskTerminated; - FTasks.Add(Task); - if FRefCount > 0 then - _AddRef; - Result := Task; -end; - -function TJclFileEnumerator.FillList(List: TStrings): TFileSearchTaskID; -begin - List.BeginUpdate; - try - Result := ForEach(List.Append); - finally - List.EndUpdate; - end; -end; - -function TJclFileEnumerator.ForEach(Handler: TFileHandlerEx): TFileSearchTaskID; -var - Task: TEnumFileThread; -begin - Task := TEnumFileThread(CreateTask); - Task.FFileHandlerEx := Handler; - Result := Task.ID; - {$IFDEF RTL210_UP} - Task.Suspended := False; - {$ELSE ~RTL210_UP} - Task.Resume; - {$ENDIF ~RTL210_UP} -end; - -function TJclFileEnumerator.ForEach(Handler: TFileHandler): TFileSearchTaskID; -var - Task: TEnumFileThread; -begin - Task := TEnumFileThread(CreateTask); - Task.FFileHandler := Handler; - Result := Task.ID; - {$IFDEF RTL210_UP} - Task.Suspended := False; - {$ELSE ~RTL210_UP} - Task.Resume; - {$ENDIF ~RTL210_UP} -end; - -function TJclFileEnumerator.GetRunningTasks: Integer; -begin - Result := FTasks.Count; -end; - -procedure TJclFileEnumerator.StopTask(ID: TFileSearchTaskID); -var - Task: TEnumFileThread; - I: Integer; -begin - for I := 0 to FTasks.Count - 1 do - begin - Task := TEnumFileThread(FTasks[I]); - if Task.ID = ID then - begin - Task.Terminate; - Break; - end; - end; -end; - -procedure TJclFileEnumerator.StopAllTasks(Silently: Boolean = False); -var - I: Integer; -begin - for I := 0 to FTasks.Count - 1 do - begin - TEnumFileThread(FTasks[I]).FNotifyOnTermination := not Silently; - TEnumFileThread(FTasks[I]).Terminate; - end; -end; - -procedure TJclFileEnumerator.TaskTerminated(Sender: TObject); -begin - FTasks.Remove(Sender); - try - if Assigned(FOnTerminateTask) then - FOnTerminateTask(TEnumFileThread(Sender).ID, TEnumFileThread(Sender).Terminated); - finally - if FRefCount > 0 then - _Release; - end; -end; - -function TJclFileEnumerator.GetNextTaskID: TFileSearchTaskID; -begin - Result := FNextTaskID; - Inc(FNextTaskID); -end; - -function TJclFileEnumerator.GetOnEnterDirectory: TFileHandler; -begin - Result := FOnEnterDirectory; -end; - -function TJclFileEnumerator.GetOnTerminateTask: TFileSearchTerminationEvent; -begin - Result := FOnTerminateTask; -end; - -function TJclFileEnumerator.GetSynchronizationMode: TFileEnumeratorSyncMode; -begin - Result := FSynchronizationMode; -end; - -procedure TJclFileEnumerator.SetOnEnterDirectory( - const Value: TFileHandler); -begin - FOnEnterDirectory := Value; -end; - -procedure TJclFileEnumerator.SetOnTerminateTask( - const Value: TFileSearchTerminationEvent); -begin - FOnTerminateTask := Value; -end; - -procedure TJclFileEnumerator.SetSynchronizationMode( - const Value: TFileEnumeratorSyncMode); -begin - FSynchronizationMode := Value; -end; - -function FileSearch: IJclFileEnumerator; -begin - Result := TJclFileEnumerator.Create; -end; - -function SamePath(const Path1, Path2: string): Boolean; -begin - {$IFDEF MSWINDOWS} - Result := AnsiSameText(PathGetLongName(Path1), PathGetLongName(Path2)); - {$ELSE ~MSWINDOWS} - Result := Path1 = Path2; - {$ENDIF ~MSWINDOWS} -end; - -// add items at the end -procedure PathListAddItems(var List: string; const Items: string); -begin - ListAddItems(List, DirSeparator, Items); -end; - -// add items at the end if they are not present -procedure PathListIncludeItems(var List: string; const Items: string); -var - StrList, NewItems: TStringList; - IndexNew, IndexList: Integer; - Item: string; - Duplicate: Boolean; -begin - StrList := TStringList.Create; - try - StrToStrings(List, DirSeparator, StrList); - - NewItems := TStringList.Create; - try - StrToStrings(Items, DirSeparator, NewItems); - - for IndexNew := 0 to NewItems.Count - 1 do - begin - Item := NewItems.Strings[IndexNew]; - - Duplicate := False; - for IndexList := 0 to StrList.Count - 1 do - if SamePath(Item, StrList.Strings[IndexList]) then - begin - Duplicate := True; - Break; - end; - - if not Duplicate then - StrList.Add(Item); - end; - - List := StringsToStr(StrList, DirSeparator); - finally - NewItems.Free; - end; - finally - StrList.Free; - end; -end; - -// delete multiple items -procedure PathListDelItems(var List: string; const Items: string); -var - StrList, RemItems: TStringList; - IndexRem, IndexList: Integer; - Item: string; -begin - StrList := TStringList.Create; - try - StrToStrings(List, DirSeparator, StrList); - - RemItems := TStringList.Create; - try - StrToStrings(Items, DirSeparator, RemItems); - - for IndexRem := 0 to RemItems.Count - 1 do - begin - Item := RemItems.Strings[IndexRem]; - - for IndexList := StrList.Count - 1 downto 0 do - if SamePath(Item, StrList.Strings[IndexList]) then - StrList.Delete(IndexList); - end; - - List := StringsToStr(StrList, DirSeparator); - finally - RemItems.Free; - end; - finally - StrList.Free; - end; -end; - -// delete one item -procedure PathListDelItem(var List: string; const Index: Integer); -begin - ListDelItem(List, DirSeparator, Index); -end; - -// return the number of item -function PathListItemCount(const List: string): Integer; -begin - Result := ListItemCount(List, DirSeparator); -end; - -// return the Nth item -function PathListGetItem(const List: string; const Index: Integer): string; -begin - Result := ListGetItem(List, DirSeparator, Index); -end; - -// set the Nth item -procedure PathListSetItem(var List: string; const Index: Integer; const Value: string); -begin - ListSetItem(List, DirSeparator, Index, Value); -end; - -// return the index of an item -function PathListItemIndex(const List, Item: string): Integer; -var - StrList: TStringList; - IndexList: Integer; -begin - StrList := TStringList.Create; - try - StrToStrings(List, DirSeparator, StrList); - - Result := -1; - - for IndexList := 0 to StrList.Count - 1 do - if SamePath(StrList.Strings[IndexList], Item) then - begin - Result := IndexList; - Break; - end; - finally - StrList.Free; - end; -end; - - -// additional functions to access the commandline parameters of an application - -// returns the name of the command line parameter at position index, which is -// separated by the given separator, if the first character of the name part -// is one of the AllowedPrefixCharacters, this character will be deleted. -function ParamName(Index: Integer; const Separator: string; - const AllowedPrefixCharacters: string; TrimName: Boolean): string; -var - S: string; - P: Integer; -begin - if (Index > 0) and (Index <= ParamCount) then - begin - S := ParamStr(Index); - if Pos(Copy(S, 1, 1), AllowedPrefixCharacters) > 0 then - S := Copy(S, 2, Length(S) - 1); - P := Pos(Separator, S); - if P > 0 then - S := Copy(S, 1, P - 1); - if TrimName then - S := Trim(S); - Result := S; - end - else - Result := ''; -end; - -// returns the value of the command line parameter at position index, which is -// separated by the given separator -function ParamValue(Index: Integer; const Separator: string; TrimValue: Boolean): string; -var - S: string; - P: Integer; -begin - if (Index > 0) and (Index <= ParamCount) then - begin - S := ParamStr(Index); - P := Pos(Separator, S); - if P > 0 then - S := Copy(S, P + 1, Length(S) - P); - if TrimValue then - S := Trim(S); - Result := S; - end - else - Result := ''; -end; - -// seaches a command line parameter where the namepart is the searchname -// and returns the value which is which by the given separator. -// CaseSensitive defines the search type. if the first character of the name part -// is one of the AllowedPrefixCharacters, this character will be deleted. -function ParamValue(const SearchName: string; const Separator: string; - CaseSensitive: Boolean; const AllowedPrefixCharacters: string; - TrimValue: Boolean): string; -var - Name: string; - SearchS: String; - I: Integer; -begin - Result := ''; - SearchS := Trim(SearchName); - - for I := 1 to ParamCount do - begin - Name := ParamName(I, Separator, AllowedPrefixCharacters, True); - if (CaseSensitive and (Name = SearchS)) or - ((not CaseSensitive) and (CompareText(Name, SearchS) = 0)) then - begin - Result := ParamValue(I, Separator, TrimValue); - Exit; - end; - end; -end; - -// seaches a command line parameter where the namepart is the searchname -// and returns the position index. if no separator is defined, the full paramstr is compared. -// CaseSensitive defines the search type. if the first character of the name part -// is one of the AllowedPrefixCharacters, this character will be deleted. -function ParamPos(const SearchName: string; const Separator: string; - CaseSensitive: Boolean; const AllowedPrefixCharacters: string): Integer; -var - Name: string; - SearchS: string; - I: Integer; -begin - Result := -1; - SearchS := Trim(SearchName); - - for I := 1 to ParamCount do - begin - Name := ParamName(I, Separator, AllowedPrefixCharacters, True); - if (CaseSensitive and (Name = SearchS)) or - ((not CaseSensitive) and (CompareText(Name, SearchS) = 0)) then - begin - Result := I; - Exit; - end; - end; -end; - - -{$IFDEF UNITVERSIONING} -initialization - RegisterUnitVersion(HInstance, UnitVersioning); - -finalization - UnregisterUnitVersion(HInstance); -{$ENDIF UNITVERSIONING} - -end. +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclFileUtils.pas. } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. } +{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. All rights reserved. } +{ } +{ Contributors: } +{ Andre Snepvangers (asnepvangers) } +{ Andreas Hausladen (ahuser) } +{ Anthony Steele } +{ Rik Barker (rikbarker) } +{ Azret Botash } +{ Charlie Calvert } +{ David Hervieux } +{ Florent Ouchet (outchy) } +{ Jean-Fabien Connault (cycocrew) } +{ Jens Fudickar (jfudickar) } +{ JohnML } +{ John Molyneux } +{ Marcel Bestebroer } +{ Marcel van Brakel } +{ Massimo Maria Ghisalberti } +{ Matthias Thoma (mthoma) } +{ Olivier Sannier (obones) } +{ Pelle F. S. Liljendal } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Rudy Velthuis } +{ Scott Price } +{ Wim De Cleen } +{ } +{**************************************************************************************************} +{ } +{ This unit contains routines and classes for working with files, directories and path strings. } +{ Additionally it contains wrapper classes for file mapping objects and version resources. } +{ Generically speaking, everything that has to do with files and directories. Note that filesystem } +{ specific functionality has been extracted into external units, for example JclNTFS which } +{ contains NTFS specific utility routines, and that the JclShell unit contains some file related } +{ routines as well but they are specific to the Windows shell. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclFileUtils; + +{$I jcl.inc} +{$I crossplatform.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + {$IFDEF HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Winapi.Windows, JclWin32, + {$ENDIF MSWINDOWS} + System.Classes, System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Windows, JclWin32, + {$ENDIF MSWINDOWS} + Classes, SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclSysUtils; + +// Path Manipulation +// +// Various support routines for working with path strings. For example, building a path from +// elements or extracting the elements from a path, interpretation of paths and transformations of +// paths. +const + {$IFDEF UNIX} + // renamed to DirDelimiter + // PathSeparator = '/'; + DirDelimiter = '/'; + DirSeparator = ':'; + {$ENDIF UNIX} + {$IFDEF MSWINDOWS} + PathDevicePrefix = '\\.\'; + // renamed to DirDelimiter + // PathSeparator = '\'; + DirDelimiter = '\'; + DirSeparator = ';'; + PathUncPrefix = '\\'; + {$ENDIF MSWINDOWS} + + faSymLink = $00000040 {$IFDEF SUPPORTS_PLATFORM} platform {$ENDIF}; // defined since D7 + faNormalFile = $00000080; + faTemporary = $00000100 {$IFDEF SUPPORTS_PLATFORM} platform {$ENDIF}; + faSparseFile = $00000200 {$IFDEF SUPPORTS_PLATFORM} platform {$ENDIF}; + faReparsePoint = $00000400 {$IFDEF SUPPORTS_PLATFORM} platform {$ENDIF}; + faCompressed = $00000800 {$IFDEF SUPPORTS_PLATFORM} platform {$ENDIF}; + faOffline = $00001000 {$IFDEF SUPPORTS_PLATFORM} platform {$ENDIF}; + faNotContentIndexed = $00002000 {$IFDEF SUPPORTS_PLATFORM} platform {$ENDIF}; + faEncrypted = $00004000 {$IFDEF SUPPORTS_PLATFORM} platform {$ENDIF}; + + // Note: faVolumeID is potentially dangerous and its usage has been discontinued + // Please see QC report 6003 for details, available online at this URL: + // http://qc.embarcadero.com/wc/qcmain.aspx?d=6003 + faRejectedByDefault = faHidden + faSysFile + faDirectory; + faWindowsSpecific = faArchive + faTemporary + faSparseFile + faReparsePoint + + faCompressed + faOffline + faNotContentIndexed + faEncrypted; + faUnixSpecific = faSymLink; + +type + TCompactPath = ({cpBegin, }cpCenter, cpEnd); + +function CharIsDriveLetter(const C: char): Boolean; +function CharIsInvalidFileNameCharacter(const C: Char): Boolean; +function CharIsInvalidPathCharacter(const C: Char): Boolean; + +function PathAddSeparator(const Path: string): string; +function PathAddExtension(const Path, Extension: string): string; +function PathAppend(const Path, Append: string): string; +function PathBuildRoot(const Drive: Byte): string; +function PathCanonicalize(const Path: string): string; +function PathCommonPrefix(const Path1, Path2: string): Integer; +{$IFDEF MSWINDOWS} +function PathCompactPath(const DC: HDC; const Path: string; const Width: Integer; + CmpFmt: TCompactPath): string; +{$ENDIF MSWINDOWS} +procedure PathExtractElements(const Source: string; var Drive, Path, FileName, Ext: string); +function PathExtractFileDirFixed(const S: string): string; +function PathExtractFileNameNoExt(const Path: string): string; +function PathExtractPathDepth(const Path: string; Depth: Integer): string; +function PathGetDepth(const Path: string): Integer; +{$IFDEF MSWINDOWS} +function PathGetLongName(const Path: string): string; +function PathGetShortName(const Path: string): string; +{$ENDIF MSWINDOWS} +function PathGetRelativePath(Origin, Destination: string): string; +function PathGetTempPath: string; +function PathIsAbsolute(const Path: string): Boolean; +function PathIsChild(const Path, Base: string): Boolean; +function PathIsEqualOrChild(const Path, Base: string): Boolean; +function PathIsDiskDevice(const Path: string): Boolean; +function PathIsUNC(const Path: string): Boolean; +function PathRemoveSeparator(const Path: string): string; +function PathRemoveExtension(const Path: string): string; + +// Windows Vista uses localized path names in the Windows Explorer but these +// folders do not really exist on disk. This causes all I/O operations to fail +// if the user specifies such a localized directory like "C:\Benutzer\MyName\Bilder" +// instead of the physical folder "C:\Users\MyName\Pictures". +// These two functions allow to convert the user's input from localized to +// physical paths and vice versa. +function PathGetPhysicalPath(const LocalizedPath: string): string; +function PathGetLocalizedPath(const PhysicalPath: string): string; + +// Files and Directories +// +// Routines for working with files and directories. Includes routines to extract various file +// attributes or update them, volume locking and routines for creating temporary files. +type + TDelTreeProgress = function (const FileName: string; Attr: DWORD): Boolean; + TFileListOption = (flFullNames, flRecursive, flMaskedSubfolders); + TFileListOptions = set of TFileListOption; + TJclAttributeMatch = (amAny, amExact, amSubSetOf, amSuperSetOf, amCustom); + TFileMatchFunc = function(const Attr: Integer; const FileInfo: TSearchRec): Boolean; + TFileHandler = procedure (const FileName: string) of object; + TFileHandlerEx = procedure (const Directory: string; const FileInfo: TSearchRec) of object; + TFileInfoHandlerEx = procedure (const FileInfo: TSearchRec) of object; + +function BuildFileList(const Path: string; const Attr: Integer; const List: TStrings; IncludeDirectoryName: Boolean = + False): Boolean; +function AdvBuildFileList(const Path: string; const Attr: Integer; const Files: TStrings; + const AttributeMatch: TJclAttributeMatch = amSuperSetOf; const Options: TFileListOptions = []; + const SubfoldersMask: string = ''; const FileMatchFunc: TFileMatchFunc = nil): Boolean; +function VerifyFileAttributeMask(var RejectedAttributes, RequiredAttributes: Integer): Boolean; +function IsFileAttributeMatch(FileAttributes, RejectedAttributes, + RequiredAttributes: Integer): Boolean; +function FileAttributesStr(const FileInfo: TSearchRec): string; +function IsFileNameMatch(FileName: string; const Mask: string; + const CaseSensitive: Boolean = {$IFDEF MSWINDOWS} False {$ELSE} True {$ENDIF}): Boolean; +procedure EnumFiles(const Path: string; HandleFile: TFileHandlerEx; + RejectedAttributes: Integer = faRejectedByDefault; RequiredAttributes: Integer = 0; + Abort: PBoolean = nil); overload; +procedure EnumFiles(const Path: string; HandleFile: TFileInfoHandlerEx; + RejectedAttributes: Integer = faRejectedByDefault; RequiredAttributes: Integer = 0; + Abort: PBoolean = nil); overload; +procedure EnumDirectories(const Root: string; const HandleDirectory: TFileHandler; + const IncludeHiddenDirectories: Boolean = False; const SubDirectoriesMask: string = ''; + Abort: PBoolean = nil {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}); +{$IFDEF MSWINDOWS} +procedure CreateEmptyFile(const FileName: string); +function CloseVolume(var Volume: THandle): Boolean; +{$IFNDEF FPC} +function DeleteDirectory(const DirectoryName: string; MoveToRecycleBin: Boolean): Boolean; +function CopyDirectory(ExistingDirectoryName, NewDirectoryName: string): Boolean; +function MoveDirectory(ExistingDirectoryName, NewDirectoryName: string): Boolean; +{$ENDIF ~FPC} +function DelTree(const Path: string): Boolean; +function DelTreeEx(const Path: string; AbortOnFailure: Boolean; Progress: TDelTreeProgress): Boolean; +function DiskInDrive(Drive: Char): Boolean; +{$ENDIF MSWINDOWS} +function DirectoryExists(const Name: string {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}): Boolean; +function FileCreateTemp(var Prefix: string): THandle; +function FileBackup(const FileName: string; Move: Boolean = False): Boolean; +function FileCopy(const ExistingFileName, NewFileName: string; ReplaceExisting: Boolean = False): Boolean; +function FileDateTime(const FileName: string): TDateTime; +function FileDelete(const FileName: string; MoveToRecycleBin: Boolean = False): Boolean; +function FileExists(const FileName: string): Boolean; +/// procedure FileHistory Creates a list of history files of a specified +/// source file. Each version of the file get's an extention .~~ The file with +/// the lowest number is the youngest file. +/// +/// (string) Name of the source file +/// (string) Folder where the history files should be +/// created. If no folder is defined the folder of the source file is used. +/// (Integer) Max number of files +/// (TDateTime) Timestamp how old the file has to be to +/// create a new history version. For example: NOW-1/24 => Only once per hour a new +/// history file is created. Default 0 means allways +/// (boolean) Flag to define that the history file +/// extention should replace the current extention or should be added at the +/// end +/// +procedure FileHistory(const FileName: string; HistoryPath: string = ''; MaxHistoryCount: Integer = 100; MinFileDate: + TDateTime = 0; ReplaceExtention: Boolean = true); +function FileMove(const ExistingFileName, NewFileName: string; ReplaceExisting: Boolean = False): Boolean; +function FileRestore(const FileName: string): Boolean; +function GetBackupFileName(const FileName: string): string; +function IsBackupFileName(const FileName: string): Boolean; +function FileGetDisplayName(const FileName: string): string; +function FileGetGroupName(const FileName: string {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}): string; +function FileGetOwnerName(const FileName: string {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}): string; +function FileGetSize(const FileName: string): Int64; +function FileGetTempName(const Prefix: string): string; +{$IFDEF MSWINDOWS} +function FileGetTypeName(const FileName: string): string; +{$ENDIF MSWINDOWS} +function FindUnusedFileName(FileName: string; const FileExt: string; NumberPrefix: string = ''): string; +function ForceDirectories(Name: string): Boolean; +function GetDirectorySize(const Path: string): Int64; +{$IFDEF MSWINDOWS} +function GetDriveTypeStr(const Drive: Char): string; +function GetFileAgeCoherence(const FileName: string): Boolean; +{$ENDIF MSWINDOWS} +procedure GetFileAttributeList(const Items: TStrings; const Attr: Integer); +{$IFDEF MSWINDOWS} +procedure GetFileAttributeListEx(const Items: TStrings; const Attr: Integer); +{$ENDIF MSWINDOWS} +function GetFileInformation(const FileName: string; out FileInfo: TSearchRec): Boolean; overload; +function GetFileInformation(const FileName: string): TSearchRec; overload; +{$IFDEF UNIX} +function GetFileStatus(const FileName: string; out StatBuf: TStatBuf64; + const ResolveSymLinks: Boolean): Integer; +{$ENDIF UNIX} +{$IFDEF MSWINDOWS} +function GetFileLastWrite(const FileName: string): TFileTime; overload; +function GetFileLastWrite(const FileName: string; out LocalTime: TDateTime): Boolean; overload; +function GetFileLastAccess(const FileName: string): TFileTime; overload; +function GetFileLastAccess(const FileName: string; out LocalTime: TDateTime): Boolean; overload; +function GetFileCreation(const FileName: string): TFileTime; overload; +function GetFileCreation(const FileName: string; out LocalTime: TDateTime): Boolean; overload; +{$ENDIF MSWINDOWS} +{$IFDEF UNIX} +function GetFileLastWrite(const FileName: string; out TimeStamp: Integer; ResolveSymLinks: Boolean = True): Boolean; overload; +function GetFileLastWrite(const FileName: string; out LocalTime: TDateTime; ResolveSymLinks: Boolean = True): Boolean; overload; +function GetFileLastWrite(const FileName: string; ResolveSymLinks: Boolean = True): Integer; overload; +function GetFileLastAccess(const FileName: string; out TimeStamp: Integer; ResolveSymLinks: Boolean = True): Boolean; overload; +function GetFileLastAccess(const FileName: string; out LocalTime: TDateTime; ResolveSymLinks: Boolean = True): Boolean; overload; +function GetFileLastAccess(const FileName: string; ResolveSymLinks: Boolean = True): Integer; overload; +function GetFileLastAttrChange(const FileName: string; out TimeStamp: Integer; ResolveSymLinks: Boolean = True): Boolean; overload; +function GetFileLastAttrChange(const FileName: string; out LocalTime: TDateTime; ResolveSymLinks: Boolean = True): Boolean; overload; +function GetFileLastAttrChange(const FileName: string; ResolveSymLinks: Boolean = True): Integer; overload; +{$ENDIF UNIX} +function GetModulePath(const Module: HMODULE): string; +function GetSizeOfFile(const FileName: string): Int64; overload; +function GetSizeOfFile(const FileInfo: TSearchRec): Int64; overload; +{$IFDEF MSWINDOWS} +function GetSizeOfFile(Handle: THandle): Int64; overload; +function GetStandardFileInfo(const FileName: string): TWin32FileAttributeData; +{$ENDIF MSWINDOWS} +function IsDirectory(const FileName: string {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}): Boolean; +function IsRootDirectory(const CanonicFileName: string): Boolean; +{$IFDEF MSWINDOWS} +function LockVolume(const Volume: string; var Handle: THandle): Boolean; +function OpenVolume(const Drive: Char): THandle; +function SetDirLastWrite(const DirName: string; const DateTime: TDateTime; RequireBackupRestorePrivileges: Boolean = True): Boolean; +function SetDirLastAccess(const DirName: string; const DateTime: TDateTime; RequireBackupRestorePrivileges: Boolean = True): Boolean; +function SetDirCreation(const DirName: string; const DateTime: TDateTime; RequireBackupRestorePrivileges: Boolean = True): Boolean; +{$ENDIF MSWINDOWS} +function SetFileLastWrite(const FileName: string; const DateTime: TDateTime): Boolean; +function SetFileLastAccess(const FileName: string; const DateTime: TDateTime): Boolean; +{$IFDEF MSWINDOWS} +function SetFileCreation(const FileName: string; const DateTime: TDateTime): Boolean; +procedure ShredFile(const FileName: string; Times: Integer = 1); +function UnlockVolume(var Handle: THandle): Boolean; +{$ENDIF MSWINDOWS} + +{$IFDEF UNIX} +function CreateSymbolicLink(const Name, Target: string): Boolean; +{ This function gets the value of the symbolic link filename. } +function SymbolicLinkTarget(const Name: string): string; +{$ENDIF UNIX} + +// TJclFileAttributeMask +// +// File search helper class, allows to specify required/rejected attributes +type + TAttributeInterest = (aiIgnored, aiRejected, aiRequired); + + TJclCustomFileAttrMask = class(TPersistent) + private + FRequiredAttr: Integer; + FRejectedAttr: Integer; + function GetAttr(Index: Integer): TAttributeInterest; + procedure SetAttr(Index: Integer; const Value: TAttributeInterest); + procedure ReadRequiredAttributes(Reader: TReader); + procedure ReadRejectedAttributes(Reader: TReader); + procedure WriteRequiredAttributes(Writer: TWriter); + procedure WriteRejectedAttributes(Writer: TWriter); + protected + procedure DefineProperties(Filer: TFiler); override; + property ReadOnly: TAttributeInterest index faReadOnly + read GetAttr write SetAttr stored False; + property Hidden: TAttributeInterest index faHidden + read GetAttr write SetAttr stored False; + property System: TAttributeInterest index faSysFile + read GetAttr write SetAttr stored False; + property Directory: TAttributeInterest index faDirectory + read GetAttr write SetAttr stored False; + property SymLink: TAttributeInterest index faSymLink + read GetAttr write SetAttr stored False; + property Normal: TAttributeInterest index faNormalFile + read GetAttr write SetAttr stored False; + property Archive: TAttributeInterest index faArchive + read GetAttr write SetAttr stored False; + property Temporary: TAttributeInterest index faTemporary + read GetAttr write SetAttr stored False; + property SparseFile: TAttributeInterest index faSparseFile + read GetAttr write SetAttr stored False; + property ReparsePoint: TAttributeInterest index faReparsePoint + read GetAttr write SetAttr stored False; + property Compressed: TAttributeInterest index faCompressed + read GetAttr write SetAttr stored False; + property OffLine: TAttributeInterest index faOffline + read GetAttr write SetAttr stored False; + property NotContentIndexed: TAttributeInterest index faNotContentIndexed + read GetAttr write SetAttr stored False; + property Encrypted: TAttributeInterest index faEncrypted + read GetAttr write SetAttr stored False; + public + constructor Create; + procedure Assign(Source: TPersistent); override; + procedure Clear; + function Match(FileAttributes: Integer): Boolean; overload; + function Match(const FileInfo: TSearchRec): Boolean; overload; + property Required: Integer read FRequiredAttr write FRequiredAttr; + property Rejected: Integer read FRejectedAttr write FRejectedAttr; + property Attribute[Index: Integer]: TAttributeInterest read GetAttr write SetAttr; default; + end; + + TJclFileAttributeMask = class(TJclCustomFileAttrMask) + private + procedure ReadVolumeID(Reader: TReader); + protected + procedure DefineProperties(Filer: TFiler); override; + published + property ReadOnly; + property Hidden; + property System; + property Directory; + property Normal; + {$IFDEF UNIX} + property SymLink; + {$ENDIF UNIX} + {$IFDEF MSWINDOWS} + property Archive; + property Temporary; + property SparseFile; + property ReparsePoint; + property Compressed; + property OffLine; + property NotContentIndexed; + property Encrypted; + {$ENDIF MSWINDOWS} + end; + +type + TFileSearchOption = (fsIncludeSubDirectories, fsIncludeHiddenSubDirectories, fsLastChangeAfter, + fsLastChangeBefore, fsMaxSize, fsMinSize); + TFileSearchOptions = set of TFileSearchOption; + TFileSearchTaskID = Integer; + TFileSearchTerminationEvent = procedure (const ID: TFileSearchTaskID; const Aborted: Boolean) of object; + TFileEnumeratorSyncMode = (smPerFile, smPerDirectory); + +// IJclFileSearchOptions +// +// Interface for file search options +type + IJclFileSearchOptions = interface + ['{B73D9E3D-34C5-4DA9-88EF-4CA730328FC9}'] + function GetAttributeMask: TJclFileAttributeMask; + function GetCaseSensitiveSearch: Boolean; + function GetRootDirectories: TStrings; + function GetRootDirectory: string; + function GetFileMask: string; + function GetFileMasks: TStrings; + function GetFileSizeMax: Int64; + function GetFileSizeMin: Int64; + function GetIncludeSubDirectories: Boolean; + function GetIncludeHiddenSubDirectories: Boolean; + function GetLastChangeAfter: TDateTime; + function GetLastChangeBefore: TDateTime; + function GetLastChangeAfterStr: string; + function GetLastChangeBeforeStr: string; + function GetSubDirectoryMask: string; + function GetOption(const Option: TFileSearchOption): Boolean; + function GetOptions: TFileSearchoptions; + procedure SetAttributeMask(const Value: TJclFileAttributeMask); + procedure SetCaseSensitiveSearch(const Value: Boolean); + procedure SetRootDirectories(const Value: TStrings); + procedure SetRootDirectory(const Value: string); + procedure SetFileMask(const Value: string); + procedure SetFileMasks(const Value: TStrings); + procedure SetFileSizeMax(const Value: Int64); + procedure SetFileSizeMin(const Value: Int64); + procedure SetIncludeSubDirectories(const Value: Boolean); + procedure SetIncludeHiddenSubDirectories(const Value: Boolean); + procedure SetLastChangeAfter(const Value: TDateTime); + procedure SetLastChangeBefore(const Value: TDateTime); + procedure SetLastChangeAfterStr(const Value: string); + procedure SetLastChangeBeforeStr(const Value: string); + procedure SetOption(const Option: TFileSearchOption; const Value: Boolean); + procedure SetOptions(const Value: TFileSearchOptions); + procedure SetSubDirectoryMask(const Value: string); + // properties + property CaseSensitiveSearch: Boolean read GetCaseSensitiveSearch write SetCaseSensitiveSearch; + property RootDirectories: TStrings read GetRootDirectories write SetRootDirectories; + property RootDirectory: string read GetRootDirectory write SetRootDirectory; + property FileMask: string read GetFileMask write SetFileMask; + property SubDirectoryMask: string read GetSubDirectoryMask write SetSubDirectoryMask; + property AttributeMask: TJclFileAttributeMask read GetAttributeMask write SetAttributeMask; + property FileSizeMin: Int64 read GetFileSizeMin write SetFileSizeMin; + property FileSizeMax: Int64 read GetFileSizeMax write SetFileSizeMax; // default InvalidFileSize; + property LastChangeAfter: TDateTime read GetLastChangeAfter write SetLastChangeAfter; + property LastChangeBefore: TDateTime read GetLastChangeBefore write SetLastChangeBefore; + property LastChangeAfterAsString: string read GetLastChangeAfterStr write SetLastChangeAfterStr; + property LastChangeBeforeAsString: string read GetLastChangeBeforeStr write SetLastChangeBeforeStr; + property IncludeSubDirectories: Boolean read GetIncludeSubDirectories + write SetIncludeSubDirectories; + property IncludeHiddenSubDirectories: Boolean read GetIncludeHiddenSubDirectories + write SetIncludeHiddenSubDirectories; + end; + +// IJclFileSearchOptions +// +// Interface for file search options +type + TJclFileSearchOptions = class(TJclInterfacedPersistent, IJclFileSearchOptions) + protected + FFileMasks: TStringList; + FRootDirectories: TStringList; + FSubDirectoryMask: string; + FAttributeMask: TJclFileAttributeMask; + FFileSizeMin: Int64; + FFileSizeMax: Int64; + FLastChangeBefore: TDateTime; + FLastChangeAfter: TDateTime; + FOptions: TFileSearchOptions; + FCaseSensitiveSearch: Boolean; + function IsLastChangeAfterStored: Boolean; + function IsLastChangeBeforeStored: Boolean; + public + constructor Create; + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + + { IJclFileSearchOptions } + function GetAttributeMask: TJclFileAttributeMask; + function GetCaseSensitiveSearch: Boolean; + function GetRootDirectories: TStrings; + function GetRootDirectory: string; + function GetFileMask: string; + function GetFileMasks: TStrings; + function GetFileSizeMax: Int64; + function GetFileSizeMin: Int64; + function GetIncludeSubDirectories: Boolean; + function GetIncludeHiddenSubDirectories: Boolean; + function GetLastChangeAfter: TDateTime; + function GetLastChangeBefore: TDateTime; + function GetLastChangeAfterStr: string; + function GetLastChangeBeforeStr: string; + function GetSubDirectoryMask: string; + function GetOption(const Option: TFileSearchOption): Boolean; + function GetOptions: TFileSearchoptions; + procedure SetAttributeMask(const Value: TJclFileAttributeMask); + procedure SetCaseSensitiveSearch(const Value: Boolean); + procedure SetRootDirectories(const Value: TStrings); + procedure SetRootDirectory(const Value: string); + procedure SetFileMask(const Value: string); + procedure SetFileMasks(const Value: TStrings); + procedure SetFileSizeMax(const Value: Int64); + procedure SetFileSizeMin(const Value: Int64); + procedure SetIncludeSubDirectories(const Value: Boolean); + procedure SetIncludeHiddenSubDirectories(const Value: Boolean); + procedure SetLastChangeAfter(const Value: TDateTime); + procedure SetLastChangeBefore(const Value: TDateTime); + procedure SetLastChangeAfterStr(const Value: string); + procedure SetLastChangeBeforeStr(const Value: string); + procedure SetOption(const Option: TFileSearchOption; const Value: Boolean); + procedure SetOptions(const Value: TFileSearchOptions); + procedure SetSubDirectoryMask(const Value: string); + published + property CaseSensitiveSearch: Boolean read GetCaseSensitiveSearch write SetCaseSensitiveSearch + default {$IFDEF MSWINDOWS} False {$ELSE} True {$ENDIF}; + property FileMasks: TStrings read GetFileMasks write SetFileMasks; + property RootDirectories: TStrings read GetRootDirectories write SetRootDirectories; + property RootDirectory: string read GetRootDirectory write SetRootDirectory; + property SubDirectoryMask: string read FSubDirectoryMask write FSubDirectoryMask; + property AttributeMask: TJclFileAttributeMask read FAttributeMask write SetAttributeMask; + property FileSizeMin: Int64 read FFileSizeMin write FFileSizeMin; + property FileSizeMax: Int64 read FFileSizeMax write FFileSizeMax; + property LastChangeAfter: TDateTime read FLastChangeAfter write FLastChangeAfter + stored IsLastChangeAfterStored; + property LastChangeBefore: TDateTime read FLastChangeBefore write FLastChangeBefore + stored IsLastChangeBeforeStored; + property Options: TFileSearchOptions read FOptions write FOptions + default [fsIncludeSubDirectories]; + end; + +// IJclFileEnumerator +// +// Interface for thread-based file search +type + IJclFileEnumerator = interface(IJclFileSearchOptions) + ['{F7E747ED-1C41-441F-B25B-BB314E00C4E9}'] + // property access methods + function GetRunningTasks: Integer; + function GetSynchronizationMode: TFileEnumeratorSyncMode; + function GetOnEnterDirectory: TFileHandler; + function GetOnTerminateTask: TFileSearchTerminationEvent; + procedure SetSynchronizationMode(const Value: TFileEnumeratorSyncMode); + procedure SetOnEnterDirectory(const Value: TFileHandler); + procedure SetOnTerminateTask(const Value: TFileSearchTerminationEvent); + // other methods + function FillList(List: TStrings): TFileSearchTaskID; + function ForEach(Handler: TFileHandler): TFileSearchTaskID; overload; + function ForEach(Handler: TFileHandlerEx): TFileSearchTaskID; overload; + procedure StopTask(ID: TFileSearchTaskID); + procedure StopAllTasks(Silently: Boolean = False); // Silently: Don't call OnTerminateTask + // properties + property RunningTasks: Integer read GetRunningTasks; + property SynchronizationMode: TFileEnumeratorSyncMode read GetSynchronizationMode + write SetSynchronizationMode; + property OnEnterDirectory: TFileHandler read GetOnEnterDirectory write SetOnEnterDirectory; + property OnTerminateTask: TFileSearchTerminationEvent read GetOnTerminateTask + write SetOnTerminateTask; + end; + +// TJclFileEnumerator +// +// Class for thread-based file search +type + TJclFileEnumerator = class(TJclFileSearchOptions, IInterface, IJclFileSearchOptions, IJclFileEnumerator) + private + FTasks: TList; + FOnEnterDirectory: TFileHandler; + FOnTerminateTask: TFileSearchTerminationEvent; + FNextTaskID: TFileSearchTaskID; + FSynchronizationMode: TFileEnumeratorSyncMode; + function GetNextTaskID: TFileSearchTaskID; + protected + function CreateTask: TThread; + procedure TaskTerminated(Sender: TObject); + property NextTaskID: TFileSearchTaskID read GetNextTaskID; + public + constructor Create; + destructor Destroy; override; + + { IJclFileEnumerator } + function GetRunningTasks: Integer; + function GetSynchronizationMode: TFileEnumeratorSyncMode; + function GetOnEnterDirectory: TFileHandler; + function GetOnTerminateTask: TFileSearchTerminationEvent; + procedure SetSynchronizationMode(const Value: TFileEnumeratorSyncMode); + procedure SetOnEnterDirectory(const Value: TFileHandler); + procedure SetOnTerminateTask(const Value: TFileSearchTerminationEvent); + + procedure Assign(Source: TPersistent); override; + function FillList(List: TStrings): TFileSearchTaskID; + function ForEach(Handler: TFileHandler): TFileSearchTaskID; overload; + function ForEach(Handler: TFileHandlerEx): TFileSearchTaskID; overload; + procedure StopTask(ID: TFileSearchTaskID); + procedure StopAllTasks(Silently: Boolean = False); // Silently: Don't call OnTerminateTask + property FileMask: string read GetFileMask write SetFileMask; + property IncludeSubDirectories: Boolean + read GetIncludeSubDirectories write SetIncludeSubDirectories; + property IncludeHiddenSubDirectories: Boolean + read GetIncludeHiddenSubDirectories write SetIncludeHiddenSubDirectories; + property SearchOption[const Option: TFileSearchOption]: Boolean read GetOption write SetOption; + property LastChangeAfterAsString: string read GetLastChangeAfterStr write SetLastChangeAfterStr; + property LastChangeBeforeAsString: string read GetLastChangeBeforeStr write SetLastChangeBeforeStr; + published + property RunningTasks: Integer read GetRunningTasks; + property SynchronizationMode: TFileEnumeratorSyncMode read FSynchronizationMode write FSynchronizationMode + default smPerDirectory; + property OnEnterDirectory: TFileHandler read FOnEnterDirectory write FOnEnterDirectory; + property OnTerminateTask: TFileSearchTerminationEvent read FOnTerminateTask write FOnTerminateTask; + end; + +function FileSearch: IJclFileEnumerator; + +{$IFDEF MSWINDOWS} + +// TFileVersionInfo +// +// Class that enables reading the version information stored in a PE file. + +type + TFileFlag = (ffDebug, ffInfoInferred, ffPatched, ffPreRelease, ffPrivateBuild, ffSpecialBuild); + TFileFlags = set of TFileFlag; + + PLangIdRec = ^TLangIdRec; + TLangIdRec = packed record + case Integer of + 0: ( + LangId: Word; + CodePage: Word); + 1: ( + Pair: DWORD); + end; + + EJclFileVersionInfoError = class(EJclError); + + TJclFileVersionInfo = class(TObject) + private + FBuffer: AnsiString; + FFixedInfo: PVSFixedFileInfo; + FFileFlags: TFileFlags; + FItemList: TStringList; + FItems: TStringList; + FLanguages: array of TLangIdRec; + FLanguageIndex: Integer; + FTranslations: array of TLangIdRec; + function GetFixedInfo: TVSFixedFileInfo; + function GetItems: TStrings; + function GetLanguageCount: Integer; + function GetLanguageIds(Index: Integer): string; + function GetLanguageNames(Index: Integer): string; + function GetLanguages(Index: Integer): TLangIdRec; + function GetTranslationCount: Integer; + function GetTranslations(Index: Integer): TLangIdRec; + procedure SetLanguageIndex(const Value: Integer); + protected + procedure CreateItemsForLanguage; + procedure CheckLanguageIndex(Value: Integer); + procedure ExtractData; + procedure ExtractFlags; + function GetBinFileVersion: string; + function GetBinProductVersion: string; + function GetFileOS: DWORD; + function GetFileSubType: DWORD; + function GetFileType: DWORD; + function GetFileVersionBuild: string; + function GetFileVersionMajor: string; + function GetFileVersionMinor: string; + function GetFileVersionRelease: string; + function GetProductVersionBuild: string; + function GetProductVersionMajor: string; + function GetProductVersionMinor: string; + function GetProductVersionRelease: string; + function GetVersionKeyValue(Index: Integer): string; + public + constructor Attach(VersionInfoData: Pointer; Size: Integer); + constructor Create(const FileName: string); overload; + {$IFDEF MSWINDOWS} + {$IFDEF FPC} + constructor Create(const Window: HWND; Dummy: Pointer = nil); overload; + {$ELSE} + constructor Create(const Window: HWND); overload; + {$ENDIF} + constructor Create(const Module: HMODULE); overload; + {$ENDIF MSWINDOWS} + destructor Destroy; override; + function GetCustomFieldValue(const FieldName: string): string; + class function VersionLanguageId(const LangIdRec: TLangIdRec): string; + class function VersionLanguageName(const LangId: Word): string; + class function FileHasVersionInfo(const FileName: string): boolean; + function TranslationMatchesLanguages(Exact: Boolean = True): Boolean; + property BinFileVersion: string read GetBinFileVersion; + property BinProductVersion: string read GetBinProductVersion; + property Comments: string index 1 read GetVersionKeyValue; + property CompanyName: string index 2 read GetVersionKeyValue; + property FileDescription: string index 3 read GetVersionKeyValue; + property FixedInfo: TVSFixedFileInfo read GetFixedInfo; + property FileFlags: TFileFlags read FFileFlags; + property FileOS: DWORD read GetFileOS; + property FileSubType: DWORD read GetFileSubType; + property FileType: DWORD read GetFileType; + property FileVersion: string index 4 read GetVersionKeyValue; + property FileVersionBuild: string read GetFileVersionBuild; + property FileVersionMajor: string read GetFileVersionMajor; + property FileVersionMinor: string read GetFileVersionMinor; + property FileVersionRelease: string read GetFileVersionRelease; + property Items: TStrings read GetItems; + property InternalName: string index 5 read GetVersionKeyValue; + property LanguageCount: Integer read GetLanguageCount; + property LanguageIds[Index: Integer]: string read GetLanguageIds; + property LanguageIndex: Integer read FLanguageIndex write SetLanguageIndex; + property Languages[Index: Integer]: TLangIdRec read GetLanguages; + property LanguageNames[Index: Integer]: string read GetLanguageNames; + property LegalCopyright: string index 6 read GetVersionKeyValue; + property LegalTradeMarks: string index 7 read GetVersionKeyValue; + property OriginalFilename: string index 8 read GetVersionKeyValue; + property PrivateBuild: string index 12 read GetVersionKeyValue; + property ProductName: string index 9 read GetVersionKeyValue; + property ProductVersion: string index 10 read GetVersionKeyValue; + property ProductVersionBuild: string read GetProductVersionBuild; + property ProductVersionMajor: string read GetProductVersionMajor; + property ProductVersionMinor: string read GetProductVersionMinor; + property ProductVersionRelease: string read GetProductVersionRelease; + property SpecialBuild: string index 11 read GetVersionKeyValue; + property TranslationCount: Integer read GetTranslationCount; + property Translations[Index: Integer]: TLangIdRec read GetTranslations; + end; + +function OSIdentToString(const OSIdent: DWORD): string; +function OSFileTypeToString(const OSFileType: DWORD; const OSFileSubType: DWORD = 0): string; + +function VersionResourceAvailable(const FileName: string): Boolean; overload; +function VersionResourceAvailable(const Window: HWND): Boolean; overload; +function VersionResourceAvailable(const Module: HMODULE): Boolean; overload; + +function WindowToModuleFileName(const Window: HWND): string; +{$ENDIF MSWINDOWS} + +// Version Info formatting +type + TFileVersionFormat = (vfMajorMinor, vfFull); + +function FormatVersionString(const HiV, LoV: Word): string; overload; +function FormatVersionString(const Major, Minor, Build, Revision: Word): string; overload; + +{$IFDEF MSWINDOWS} + +function FormatVersionString(const FixedInfo: TVSFixedFileInfo; VersionFormat: TFileVersionFormat = vfFull): string; overload; + +// Version Info extracting +procedure VersionExtractFileInfo(const FixedInfo: TVSFixedFileInfo; var Major, Minor, Build, Revision: Word); +procedure VersionExtractProductInfo(const FixedInfo: TVSFixedFileInfo; var Major, Minor, Build, Revision: Word); + +// Fixed Version Info routines +function VersionFixedFileInfo(const FileName: string; var FixedInfo: TVSFixedFileInfo): Boolean; +function VersionFixedFileInfoString(const FileName: string; VersionFormat: TFileVersionFormat = vfFull; + const NotAvailableText: string = ''): string; + +{$ENDIF MSWINDOWS} + +// Streams +// +// TStream descendent classes for dealing with temporary files and for using file mapping objects. +type + TJclTempFileStream = class(THandleStream) + private + FFileName: string; + public + constructor Create(const Prefix: string); + destructor Destroy; override; + property FileName: string read FFileName; + end; + +{$IFDEF MSWINDOWS} + + TJclCustomFileMapping = class; + + TJclFileMappingView = class(TCustomMemoryStream) + private + FFileMapping: TJclCustomFileMapping; + FOffsetHigh: Cardinal; + FOffsetLow: Cardinal; + function GetIndex: Integer; + function GetOffset: Int64; + public + constructor Create(const FileMap: TJclCustomFileMapping; + Access, Size: Cardinal; ViewOffset: Int64); + constructor CreateAt(FileMap: TJclCustomFileMapping; Access, + Size: Cardinal; ViewOffset: Int64; Address: Pointer); + destructor Destroy; override; + function Flush(const Count: Cardinal): Boolean; + procedure LoadFromStream(const Stream: TStream); + procedure LoadFromFile(const FileName: string); + function Write(const Buffer; Count: Longint): Longint; override; + property Index: Integer read GetIndex; + property FileMapping: TJclCustomFileMapping read FFileMapping; + property Offset: Int64 read GetOffset; + end; + + TJclFileMappingRoundOffset = (rvDown, rvUp); + + TJclCustomFileMapping = class(TObject) + private + FExisted: Boolean; + FHandle: THandle; + FName: string; + FRoundViewOffset: TJclFileMappingRoundOffset; + FViews: TList; + function GetCount: Integer; + function GetView(Index: Integer): TJclFileMappingView; + protected + procedure ClearViews; + procedure InternalCreate(const FileHandle: THandle; const Name: string; + const Protect: Cardinal; MaximumSize: Int64; SecAttr: PSecurityAttributes); + procedure InternalOpen(const Name: string; const InheritHandle: Boolean; + const DesiredAccess: Cardinal); + public + constructor Create; + constructor Open(const Name: string; const InheritHandle: Boolean; const DesiredAccess: Cardinal); + destructor Destroy; override; + function Add(const Access, Count: Cardinal; const Offset: Int64): Integer; + function AddAt(const Access, Count: Cardinal; const Offset: Int64; const Address: Pointer): Integer; + procedure Delete(const Index: Integer); + function IndexOf(const View: TJclFileMappingView): Integer; + property Count: Integer read GetCount; + property Existed: Boolean read FExisted; + property Handle: THandle read FHandle; + property Name: string read FName; + property RoundViewOffset: TJclFileMappingRoundOffset read FRoundViewOffset write FRoundViewOffset; + property Views[index: Integer]: TJclFileMappingView read GetView; + end; + + TJclFileMapping = class(TJclCustomFileMapping) + private + FFileHandle: THandle; + public + constructor Create(const FileName: string; FileMode: Cardinal; + const Name: string; Protect: Cardinal; const MaximumSize: Int64; + SecAttr: PSecurityAttributes); overload; + constructor Create(const FileHandle: THandle; const Name: string; + Protect: Cardinal; const MaximumSize: Int64; + SecAttr: PSecurityAttributes); overload; + destructor Destroy; override; + property FileHandle: THandle read FFileHandle; + end; + + TJclSwapFileMapping = class(TJclCustomFileMapping) + public + constructor Create(const Name: string; Protect: Cardinal; + const MaximumSize: Int64; SecAttr: PSecurityAttributes); + end; + + TJclFileMappingStream = class(TCustomMemoryStream) + private + FFileHandle: THandle; + FMapping: THandle; + protected + procedure Close; + public + constructor Create(const FileName: string; FileMode: Word = fmOpenRead or fmShareDenyWrite); + destructor Destroy; override; + function Write(const Buffer; Count: Longint): Longint; override; + end; + +{$ENDIF MSWINDOWS} + + TJclMappedTextReaderIndex = (tiNoIndex, tiFull); + + PPAnsiCharArray = ^TPAnsiCharArray; + TPAnsiCharArray = array [0..MaxInt div SizeOf(PAnsiChar) - 1] of PAnsiChar; + + TJclAnsiMappedTextReader = class(TPersistent) + private + FContent: PAnsiChar; + FEnd: PAnsiChar; + FIndex: PPAnsiCharArray; + FIndexOption: TJclMappedTextReaderIndex; + FFreeStream: Boolean; + FLastLineNumber: Integer; + FLastPosition: PAnsiChar; + FLineCount: Integer; + FMemoryStream: TCustomMemoryStream; + FPosition: PAnsiChar; + FSize: Integer; + function GetAsString: AnsiString; + function GetEof: Boolean; + function GetChars(Index: Integer): AnsiChar; + function GetLineCount: Integer; + function GetLines(LineNumber: Integer): AnsiString; + function GetPosition: Integer; + function GetPositionFromLine(LineNumber: Integer): Integer; + procedure SetPosition(const Value: Integer); + protected + procedure AssignTo(Dest: TPersistent); override; + procedure CreateIndex; + procedure Init; + function PtrFromLine(LineNumber: Integer): PAnsiChar; + function StringFromPosition(var StartPos: PAnsiChar): AnsiString; + public + constructor Create(MemoryStream: TCustomMemoryStream; FreeStream: Boolean = True; + const AIndexOption: TJclMappedTextReaderIndex = tiNoIndex); overload; + constructor Create(const FileName: TFileName; + const AIndexOption: TJclMappedTextReaderIndex = tiNoIndex); overload; + destructor Destroy; override; + procedure GoBegin; + function Read: AnsiChar; + function ReadLn: AnsiString; + property AsString: AnsiString read GetAsString; + property Chars[Index: Integer]: AnsiChar read GetChars; + property Content: PAnsiChar read FContent; + property Eof: Boolean read GetEof; + property IndexOption: TJclMappedTextReaderIndex read FIndexOption; + property Lines[LineNumber: Integer]: AnsiString read GetLines; + property LineCount: Integer read GetLineCount; + property PositionFromLine[LineNumber: Integer]: Integer read GetPositionFromLine; + property Position: Integer read GetPosition write SetPosition; + property Size: Integer read FSize; + end; + + PPWideCharArray = ^TPWideCharArray; + TPWideCharArray = array [0..MaxInt div SizeOf(PWideChar) - 1] of PWideChar; + + TJclWideMappedTextReader = class(TPersistent) + private + FContent: PWideChar; + FEnd: PWideChar; + FIndex: PPWideCharArray; + FIndexOption: TJclMappedTextReaderIndex; + FFreeStream: Boolean; + FLastLineNumber: Integer; + FLastPosition: PWideChar; + FLineCount: Integer; + FMemoryStream: TCustomMemoryStream; + FPosition: PWideChar; + FSize: Integer; + function GetAsString: WideString; + function GetEof: Boolean; + function GetChars(Index: Integer): WideChar; + function GetLineCount: Integer; + function GetLines(LineNumber: Integer): WideString; + function GetPosition: Integer; + function GetPositionFromLine(LineNumber: Integer): Integer; + procedure SetPosition(const Value: Integer); + protected + procedure AssignTo(Dest: TPersistent); override; + procedure CreateIndex; + procedure Init; + function PtrFromLine(LineNumber: Integer): PWideChar; + function StringFromPosition(var StartPos: PWideChar): WideString; + public + constructor Create(MemoryStream: TCustomMemoryStream; FreeStream: Boolean = True; + const AIndexOption: TJclMappedTextReaderIndex = tiNoIndex); overload; + constructor Create(const FileName: TFileName; + const AIndexOption: TJclMappedTextReaderIndex = tiNoIndex); overload; + destructor Destroy; override; + procedure GoBegin; + function Read: WideChar; + function ReadLn: WideString; + property AsString: WideString read GetAsString; + property Chars[Index: Integer]: WideChar read GetChars; + property Content: PWideChar read FContent; + property Eof: Boolean read GetEof; + property IndexOption: TJclMappedTextReaderIndex read FIndexOption; + property Lines[LineNumber: Integer]: WideString read GetLines; + property LineCount: Integer read GetLineCount; + property PositionFromLine[LineNumber: Integer]: Integer read GetPositionFromLine; + property Position: Integer read GetPosition write SetPosition; + property Size: Integer read FSize; + end; + +{ TODO : UNTESTED/UNDOCUMENTED } + +type + TJclFileMaskComparator = class(TObject) + private + FFileMask: string; + FExts: array of string; + FNames: array of string; + FWildChars: array of Byte; + FSeparator: Char; + procedure CreateMultiMasks; + function GetCount: Integer; + function GetExts(Index: Integer): string; + function GetMasks(Index: Integer): string; + function GetNames(Index: Integer): string; + procedure SetFileMask(const Value: string); + procedure SetSeparator(const Value: Char); + public + constructor Create; + function Compare(const NameExt: string): Boolean; + property Count: Integer read GetCount; + property Exts[Index: Integer]: string read GetExts; + property FileMask: string read FFileMask write SetFileMask; + property Masks[Index: Integer]: string read GetMasks; + property Names[Index: Integer]: string read GetNames; + property Separator: Char read FSeparator write SetSeparator; + end; + + EJclPathError = class(EJclError); + EJclFileUtilsError = class(EJclError); + {$IFDEF UNIX} + EJclTempFileStreamError = class(EJclFileUtilsError); + {$ENDIF UNIX} + {$IFDEF MSWINDOWS} + EJclTempFileStreamError = class(EJclWin32Error); + EJclFileMappingError = class(EJclWin32Error); + EJclFileMappingViewError = class(EJclWin32Error); + {$ENDIF MSWINDOWS} + +function SamePath(const Path1, Path2: string): Boolean; + +// functions to add/delete paths from a separated list of paths +// on windows the separator is a semi-colon ';' +// on linux the separator is a colon ':' +// add items at the end +procedure PathListAddItems(var List: string; const Items: string); +// add items at the end if they are not present +procedure PathListIncludeItems(var List: string; const Items: string); +// delete multiple items +procedure PathListDelItems(var List: string; const Items: string); +// delete one item +procedure PathListDelItem(var List: string; const Index: Integer); +// return the number of item +function PathListItemCount(const List: string): Integer; +// return the Nth item +function PathListGetItem(const List: string; const Index: Integer): string; +// set the Nth item +procedure PathListSetItem(var List: string; const Index: Integer; const Value: string); +// return the index of an item +function PathListItemIndex(const List, Item: string): Integer; + + +// additional functions to access the commandline parameters of an application + +// returns the name of the command line parameter at position index, which is +// separated by the given separator, if the first character of the name part +// is one of the AllowedPrefixCharacters, this character will be deleted. +function ParamName(Index: Integer; const Separator: string = '='; + const AllowedPrefixCharacters: string = '-/'; TrimName: Boolean = True): string; +// returns the value of the command line parameter at position index, which is +// separated by the given separator +function ParamValue (Index: Integer; const Separator: string = '='; TrimValue: Boolean = True): string; overload; +// seaches a command line parameter where the namepart is the searchname +// and returns the value which is which by the given separator. +// CaseSensitive defines the search type. if the first character of the name part +// is one of the AllowedPrefixCharacters, this character will be deleted. +function ParamValue (const SearchName: string; const Separator: string = '='; + CaseSensitive: Boolean = False; + const AllowedPrefixCharacters: string = '-/'; TrimValue: Boolean = True): string; overload; +// seaches a command line parameter where the namepart is the searchname +// and returns the position index. if no separator is defined, the full paramstr is compared. +// CaseSensitive defines the search type. if the first character of the name part +// is one of the AllowedPrefixCharacters, this character will be deleted. +function ParamPos (const SearchName: string; const Separator: string = '='; + CaseSensitive: Boolean = False; + const AllowedPrefixCharacters: string = '-/'): Integer; + + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.Types, // inlining of TList.Remove + {$IFDEF HAS_UNIT_CHARACTER} + System.Character, + {$ENDIF HAS_UNIT_CHARACTER} + System.Math, + {$IFDEF MSWINDOWS} + Winapi.ShellApi, Winapi.ActiveX, System.Win.ComObj, Winapi.ShlObj, + JclShell, JclSysInfo, JclSecurity, + {$ENDIF MSWINDOWS} + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF HAS_UNIT_CHARACTER} + Character, + {$ENDIF HAS_UNIT_CHARACTER} + Math, + {$IFDEF MSWINDOWS} + ShellApi, ActiveX, ComObj, ShlObj, + JclShell, JclSysInfo, JclSecurity, + {$ENDIF MSWINDOWS} + {$ENDIF ~HAS_UNITSCOPE} + JclDateTime, JclResources, + JclStrings; + +{ Some general notes: + + This unit redeclares some functions from FileCtrl.pas to avoid a dependency on that unit in the + JCL. The problem is that FileCtrl.pas uses some units (eg Forms.pas) which have ridiculous + initialization requirements. They add 4KB (!) to the executable and roughly 1 second of startup. + That initialization is only necessary for GUI applications and is unacceptable for high + performance services or console apps. + + The routines which query files or directories for their attributes deliberately use FindFirst + even though there may be easier ways to get at the required information. This is because FindFirst + is about the only routine which doesn't cause the file's last modification/accessed time to be + changed which is usually an undesired side-effect. } + +{$IFDEF UNIX} +const + ERROR_NO_MORE_FILES = -1; + INVALID_HANDLE_VALUE = THandle(-1); +{$ENDIF UNIX} + +//=== { TJclTempFileStream } ================================================= + +constructor TJclTempFileStream.Create(const Prefix: string); +var + FileHandle: THandle; +begin + FFileName := Prefix; + FileHandle := FileCreateTemp(FFileName); + // (rom) is it really wise to throw an exception before calling inherited? + if FileHandle = INVALID_HANDLE_VALUE then + raise EJclTempFileStreamError.CreateRes(@RsFileStreamCreate); + inherited Create(FileHandle); +end; + +destructor TJclTempFileStream.Destroy; +begin + if THandle(Handle) <> INVALID_HANDLE_VALUE then + FileClose(Handle); + inherited Destroy; +end; + +//=== { TJclFileMappingView } ================================================ + +{$IFDEF MSWINDOWS} + +constructor TJclFileMappingView.Create(const FileMap: TJclCustomFileMapping; + Access, Size: Cardinal; ViewOffset: Int64); +var + BaseAddress: Pointer; + OffsetLow, OffsetHigh: Cardinal; +begin + inherited Create; + if FileMap = nil then + raise EJclFileMappingViewError.CreateRes(@RsViewNeedsMapping); + FFileMapping := FileMap; + // Offset must be a multiple of system memory allocation granularity + RoundToAllocGranularity64(ViewOffset, FFileMapping.RoundViewOffset = rvUp); + I64ToCardinals(ViewOffset, OffsetLow, OffsetHigh); + FOffsetHigh := OffsetHigh; + FOffsetLow := OffsetLow; + BaseAddress := MapViewOfFile(FFileMapping.Handle, Access, FOffsetHigh, FOffsetLow, Size); + if BaseAddress = nil then + raise EJclFileMappingViewError.CreateRes(@RsCreateFileMappingView); + // If we are mapping a file and size = 0 then MapViewOfFile has mapped the entire file. We must + // figure out the size ourselves before we can call SetPointer. Since in case of failure to + // retrieve the size we raise an exception, we also have to explicitly unmap the view which + // otherwise would have been done by the destructor. + if (Size = 0) and (FileMap is TJclFileMapping) then + begin + Size := GetFileSize(TJclFileMapping(FileMap).FFileHandle, nil); + if Size = DWORD(-1) then + begin + UnMapViewOfFile(BaseAddress); + raise EJclFileMappingViewError.CreateRes(@RsFailedToObtainSize); + end; + end; + SetPointer(BaseAddress, Size); + FFileMapping.FViews.Add(Self); +end; + +constructor TJclFileMappingView.CreateAt(FileMap: TJclCustomFileMapping; + Access, Size: Cardinal; ViewOffset: Int64; Address: Pointer); +var + BaseAddress: Pointer; + OffsetLow, OffsetHigh: Cardinal; +begin + inherited Create; + if FileMap = nil then + raise EJclFileMappingViewError.CreateRes(@RsViewNeedsMapping); + FFileMapping := FileMap; + // Offset must be a multiple of system memory allocation granularity + RoundToAllocGranularity64(ViewOffset, FFileMapping.RoundViewOffset = rvUp); + RoundToAllocGranularityPtr(Address, FFileMapping.RoundViewOffset = rvUp); + I64ToCardinals(ViewOffset, OffsetLow, OffsetHigh); + FOffsetHigh := OffsetHigh; + FOffsetLow := OffsetLow; + BaseAddress := MapViewOfFileEx(FFileMapping.Handle, Access, FOffsetHigh, + FOffsetLow, Size, Address); + if BaseAddress = nil then + raise EJclFileMappingViewError.CreateRes(@RsCreateFileMappingView); + // If we are mapping a file and size = 0 then MapViewOfFile has mapped the entire file. We must + // figure out the size ourselves before we can call SetPointer. Since in case of failure to + // retrieve the size we raise an exception, we also have to explicitly unmap the view which + // otherwise would have been done by the destructor. + if (Size = 0) and (FileMap is TJclFileMapping) then + begin + Size := GetFileSize(TJclFileMapping(FileMap).FFileHandle, nil); + if Size = DWORD(-1) then + begin + UnMapViewOfFile(BaseAddress); + raise EJclFileMappingViewError.CreateRes(@RsFailedToObtainSize); + end; + end; + SetPointer(BaseAddress, Size); + FFileMapping.FViews.Add(Self); +end; + +destructor TJclFileMappingView.Destroy; +var + IndexOfSelf: Integer; +begin + if Memory <> nil then + begin + UnMapViewOfFile(Memory); + SetPointer(nil, 0); + end; + if FFileMapping <> nil then + begin + IndexOfSelf := FFileMapping.IndexOf(Self); + if IndexOfSelf <> -1 then + FFileMapping.FViews.Delete(IndexOfSelf); + end; + inherited Destroy; +end; + +function TJclFileMappingView.Flush(const Count: Cardinal): Boolean; +begin + Result := FlushViewOfFile(Memory, Count); +end; + +function TJclFileMappingView.GetIndex: Integer; +begin + Result := FFileMapping.IndexOf(Self); +end; + +function TJclFileMappingView.GetOffset: Int64; +begin + CardinalsToI64(Result, FOffsetLow, FOffsetHigh); +end; + +procedure TJclFileMappingView.LoadFromFile(const FileName: string); +var + Stream: TFileStream; +begin + Stream := TFileStream.Create(Filename, fmOpenRead or fmShareDenyWrite); + try + LoadFromStream(Stream); + finally + FreeAndNil(Stream); + end; +end; + +procedure TJclFileMappingView.LoadFromStream(const Stream: TStream); +begin + if Stream.Size > Size then + raise EJclFileMappingViewError.CreateRes(@RsLoadFromStreamSize); + Stream.Position := 0; + Stream.ReadBuffer(Memory^, Stream.Size); +end; + +function TJclFileMappingView.Write(const Buffer; Count: Integer): Longint; +begin + Result := 0; + if (Size - Position) >= Count then + begin + System.Move(Buffer, Pointer(TJclAddr(Memory) + TJclAddr(Position))^, Count); + Position := Position + Count; + Result := Count; + end; +end; + +//=== { TJclCustomFileMapping } ============================================== + +constructor TJclCustomFileMapping.Create; +begin + inherited Create; + FViews := TList.Create; + FRoundViewOffset := rvDown; +end; + +constructor TJclCustomFileMapping.Open(const Name: string; + const InheritHandle: Boolean; const DesiredAccess: Cardinal); +begin + Create; + InternalOpen(Name, InheritHandle, DesiredAccess); +end; + +destructor TJclCustomFileMapping.Destroy; +begin + ClearViews; + if FHandle <> 0 then + CloseHandle(FHandle); + FreeAndNil(FViews); + inherited Destroy; +end; + +function TJclCustomFileMapping.Add(const Access, Count: Cardinal; const Offset: Int64): Integer; +var + View: TJclFileMappingView; +begin + // The view adds itself to the FViews list + View := TJclFileMappingView.Create(Self, Access, Count, Offset); + Result := View.Index; +end; + +function TJclCustomFileMapping.AddAt(const Access, Count: Cardinal; + const Offset: Int64; const Address: Pointer): Integer; +var + View: TJclFileMappingView; +begin + // The view adds itself to the FViews list + View := TJclFileMappingView.CreateAt(Self, Access, Count, Offset, Address); + Result := View.Index; +end; + +procedure TJclCustomFileMapping.ClearViews; +var + I: Integer; +begin + // Note that the view destructor removes the view object from the FViews list so we must loop + // downwards from count to 0 + for I := FViews.Count - 1 downto 0 do + TJclFileMappingView(FViews[I]).Free; +end; + +procedure TJclCustomFileMapping.Delete(const Index: Integer); +begin + // Note that the view destructor removes itself from FViews + TJclFileMappingView(FViews[Index]).Free; +end; + +function TJclCustomFileMapping.GetCount: Integer; +begin + Result := FViews.Count; +end; + +function TJclCustomFileMapping.GetView(Index: Integer): TJclFileMappingView; +begin + Result := TJclFileMappingView(FViews.Items[index]); +end; + +function TJclCustomFileMapping.IndexOf(const View: TJclFileMappingView): Integer; +begin + Result := FViews.IndexOf(View); +end; + +procedure TJclCustomFileMapping.InternalCreate(const FileHandle: THandle; + const Name: string; const Protect: Cardinal; MaximumSize: Int64; + SecAttr: PSecurityAttributes); +var + MaximumSizeLow, MaximumSizeHigh: Cardinal; +begin + FName := Name; + I64ToCardinals(MaximumSize, MaximumSizeLow, MaximumSizeHigh); + FHandle := CreateFileMapping(FileHandle, SecAttr, Protect, MaximumSizeHigh, + MaximumSizeLow, PChar(Name)); + if FHandle = 0 then + raise EJclFileMappingError.CreateRes(@RsCreateFileMapping); + FExisted := GetLastError = ERROR_ALREADY_EXISTS; +end; + +procedure TJclCustomFileMapping.InternalOpen(const Name: string; + const InheritHandle: Boolean; const DesiredAccess: Cardinal); +begin + FExisted := True; + FName := Name; + FHandle := OpenFileMapping(DesiredAccess, InheritHandle, PChar(Name)); + if FHandle = 0 then + raise EJclFileMappingError.CreateRes(@RsCreateFileMapping); +end; + +//=== { TJclFileMapping } ==================================================== + +constructor TJclFileMapping.Create(const FileName: string; FileMode: Cardinal; + const Name: string; Protect: Cardinal; const MaximumSize: Int64; + SecAttr: PSecurityAttributes); +begin + FFileHandle := INVALID_HANDLE_VALUE; + inherited Create; + FFileHandle := THandle(FileOpen(FileName, FileMode)); + if FFileHandle = INVALID_HANDLE_VALUE then + raise EJclFileMappingError.CreateRes(@RsFileMappingOpenFile); + InternalCreate(FFileHandle, Name, Protect, MaximumSize, SecAttr); +end; + +constructor TJclFileMapping.Create(const FileHandle: THandle; const Name: string; + Protect: Cardinal; const MaximumSize: Int64; SecAttr: PSecurityAttributes); +begin + FFileHandle := INVALID_HANDLE_VALUE; + inherited Create; + if FileHandle = INVALID_HANDLE_VALUE then + raise EJclFileMappingError.CreateRes(@RsFileMappingInvalidHandle); + InternalCreate(FileHandle, Name, Protect, MaximumSize, SecAttr); + // Duplicate the handle into FFileHandle as opposed to assigning it directly. This will cause + // FFileHandle to retrieve a unique copy which is independent of FileHandle. This makes the + // remainder of the class, especially the destructor, easier. The caller will have to close it's + // own copy of the handle explicitly. + DuplicateHandle(GetCurrentProcess, FileHandle, GetCurrentProcess, + @FFileHandle, 0, False, DUPLICATE_SAME_ACCESS); +end; + +destructor TJclFileMapping.Destroy; +begin + if FFileHandle <> INVALID_HANDLE_VALUE then + CloseHandle(FFileHandle); + inherited Destroy; +end; + +//=== { TJclSwapFileMapping } ================================================ + +constructor TJclSwapFileMapping.Create(const Name: string; Protect: Cardinal; + const MaximumSize: Int64; SecAttr: PSecurityAttributes); +begin + inherited Create; + InternalCreate(INVALID_HANDLE_VALUE, Name, Protect, MaximumSize, SecAttr); +end; + +//=== { TJclFileMappingStream } ============================================== + +constructor TJclFileMappingStream.Create(const FileName: string; FileMode: Word); +var + Protect, Access, Size: DWORD; + BaseAddress: Pointer; +begin + inherited Create; + FFileHandle := THandle(FileOpen(FileName, FileMode)); + if FFileHandle = INVALID_HANDLE_VALUE then + RaiseLastOSError; + if (FileMode and $0F) = fmOpenReadWrite then + begin + Protect := PAGE_WRITECOPY; + Access := FILE_MAP_COPY; + end + else + begin + Protect := PAGE_READONLY; + Access := FILE_MAP_READ; + end; + FMapping := CreateFileMapping(FFileHandle, nil, Protect, 0, 0, nil); + if FMapping = 0 then + begin + Close; + raise EJclFileMappingError.CreateRes(@RsCreateFileMapping); + end; + BaseAddress := MapViewOfFile(FMapping, Access, 0, 0, 0); + if BaseAddress = nil then + begin + Close; + raise EJclFileMappingViewError.CreateRes(@RsCreateFileMappingView); + end; + Size := GetFileSize(FFileHandle, nil); + if Size = DWORD(-1) then + begin + UnMapViewOfFile(BaseAddress); + Close; + raise EJclFileMappingViewError.CreateRes(@RsFailedToObtainSize); + end; + SetPointer(BaseAddress, Size); +end; + +destructor TJclFileMappingStream.Destroy; +begin + Close; + inherited Destroy; +end; + +procedure TJclFileMappingStream.Close; +begin + if Memory <> nil then + begin + UnMapViewOfFile(Memory); + SetPointer(nil, 0); + end; + if FMapping <> 0 then + begin + CloseHandle(FMapping); + FMapping := 0; + end; + if FFileHandle <> INVALID_HANDLE_VALUE then + begin + FileClose(FFileHandle); + FFileHandle := INVALID_HANDLE_VALUE; + end; +end; + +function TJclFileMappingStream.Write(const Buffer; Count: Integer): Longint; +begin + Result := 0; + if (Size - Position) >= Count then + begin + System.Move(Buffer, Pointer(TJclAddr(Memory) + TJclAddr(Position))^, Count); + Position := Position + Count; + Result := Count; + end; +end; + +{$ENDIF MSWINDOWS} + +//=== { TJclAnsiMappedTextReader } =========================================== + +constructor TJclAnsiMappedTextReader.Create(MemoryStream: TCustomMemoryStream; FreeStream: Boolean; + const AIndexOption: TJclMappedTextReaderIndex); +begin + inherited Create; + FMemoryStream := MemoryStream; + FFreeStream := FreeStream; + FIndexOption := AIndexOption; + Init; +end; + +constructor TJclAnsiMappedTextReader.Create(const FileName: TFileName; + const AIndexOption: TJclMappedTextReaderIndex); +begin + inherited Create; + {$IFDEF MSWINDOWS} + FMemoryStream := TJclFileMappingStream.Create(FileName); + {$ELSE ~ MSWINDOWS} + FMemoryStream := TMemoryStream.Create; + TMemoryStream(FMemoryStream).LoadFromFile(FileName); + {$ENDIF ~ MSWINDOWS} + FFreeStream := True; + FIndexOption := AIndexOption; + Init; +end; + +destructor TJclAnsiMappedTextReader.Destroy; +begin + if FFreeStream then + FMemoryStream.Free; + FreeMem(FIndex); + inherited Destroy; +end; + +procedure TJclAnsiMappedTextReader.AssignTo(Dest: TPersistent); +begin + if Dest is TStrings then + begin + GoBegin; + TStrings(Dest).BeginUpdate; + try + while not Eof do + TStrings(Dest).Add(string(ReadLn)); + finally + TStrings(Dest).EndUpdate; + end; + end + else + inherited AssignTo(Dest); +end; + +procedure TJclAnsiMappedTextReader.CreateIndex; +var + P, LastLineStart: PAnsiChar; + I: Integer; +begin + {$RANGECHECKS OFF} + P := FContent; + I := 0; + LastLineStart := P; + while P < FEnd do + begin + // CRLF, CR, LF and LFCR are seen as valid sets of chars for EOL marker + if CharIsReturn(Char(P^)) then + begin + if I and $FFFF = 0 then + ReallocMem(FIndex, (I + $10000) * SizeOf(Pointer)); + FIndex[I] := LastLineStart; + Inc(I); + + case P^ of + NativeLineFeed: + begin + Inc(P); + if (P < FEnd) and (P^ = NativeCarriageReturn) then + Inc(P); + end; + NativeCarriageReturn: + begin + Inc(P); + if (P < FEnd) and (P^ = NativeLineFeed) then + Inc(P); + end; + end; + LastLineStart := P; + end + else + Inc(P); + end; + if P > LastLineStart then + begin + ReallocMem(FIndex, (I + 1) * SizeOf(Pointer)); + FIndex[I] := LastLineStart; + Inc(I); + end + else + ReallocMem(FIndex, I * SizeOf(Pointer)); + FLineCount := I; + {$IFDEF RANGECHECKS_ON} + {$RANGECHECKS ON} + {$ENDIF RANGECHECKS_ON} +end; + +function TJclAnsiMappedTextReader.GetEof: Boolean; +begin + Result := FPosition >= FEnd; +end; + +function TJclAnsiMappedTextReader.GetAsString: AnsiString; +begin + SetString(Result, Content, Size); +end; + +function TJclAnsiMappedTextReader.GetChars(Index: Integer): AnsiChar; +begin + if (Index < 0) or (Index >= Size) then + raise EJclError.CreateRes(@RsFileIndexOutOfRange); + Result := AnsiChar(PByte(FContent + Index)^); +end; + +function TJclAnsiMappedTextReader.GetLineCount: Integer; +var + P: PAnsiChar; +begin + if FLineCount = -1 then + begin + FLineCount := 0; + if FContent < FEnd then + begin + P := FContent; + while P < FEnd do + begin + case P^ of + NativeLineFeed: + begin + Inc(FLineCount); + Inc(P); + if (P < FEnd) and (P^ = NativeCarriageReturn) then + Inc(P); + end; + NativeCarriageReturn: + begin + Inc(FLineCount); + Inc(P); + if (P < FEnd) and (P^ = NativeLineFeed) then + Inc(P); + end; + else + Inc(P); + end; + end; + if (P = FEnd) and (P > FContent) and not CharIsReturn(Char((P-1)^)) then + Inc(FLineCount); + end; + end; + + Result := FLineCount; +end; + +function TJclAnsiMappedTextReader.GetLines(LineNumber: Integer): AnsiString; +var + P: PAnsiChar; +begin + P := PtrFromLine(LineNumber); + Result := StringFromPosition(P); +end; + +function TJclAnsiMappedTextReader.GetPosition: Integer; +begin + Result := FPosition - FContent; +end; + +procedure TJclAnsiMappedTextReader.GoBegin; +begin + Position := 0; +end; + +procedure TJclAnsiMappedTextReader.Init; +begin + FContent := FMemoryStream.Memory; + FSize := FMemoryStream.Size; + FEnd := FContent + FSize; + FPosition := FContent; + FLineCount := -1; + FLastLineNumber := 0; + FLastPosition := FContent; + if IndexOption = tiFull then + CreateIndex; +end; + +function TJclAnsiMappedTextReader.GetPositionFromLine(LineNumber: Integer): Integer; +var + P: PAnsiChar; +begin + P := PtrFromLine(LineNumber); + if P = nil then + Result := -1 + else + Result := P - FContent; +end; + +function TJclAnsiMappedTextReader.PtrFromLine(LineNumber: Integer): PAnsiChar; +var + LineOffset: Integer; +begin + Result := nil; + {$RANGECHECKS OFF} + if (IndexOption <> tiNoIndex) and (LineNumber < FLineCount) and (FIndex[LineNumber] <> nil) then + Result := FIndex[LineNumber] + {$IFDEF RANGECHECKS_ON} + {$RANGECHECKS ON} + {$ENDIF RANGECHECKS_ON} + else + begin + LineOffset := LineNumber - FLastLineNumber; + if (FLineCount <> -1) and (LineNumber > 0) then + begin + if -LineOffset > LineNumber then + begin + FLastLineNumber := 0; + FLastPosition := FContent; + LineOffset := LineNumber; + end + else + if LineOffset > FLineCount - LineNumber then + begin + FLastLineNumber := FLineCount; + FLastPosition := FEnd; + LineOffset := LineNumber - FLineCount; + end; + end; + if LineNumber <= 0 then + Result := FContent + else + if LineOffset = 0 then + Result := FLastPosition + else + if LineOffset > 0 then + begin + Result := FLastPosition; + while (Result < FEnd) and (LineOffset > 0) do + begin + case Result^ of + NativeLineFeed: + begin + Dec(LineOffset); + Inc(Result); + if (Result < FEnd) and (Result^ = NativeCarriageReturn) then + Inc(Result); + end; + NativeCarriageReturn: + begin + Dec(LineOffset); + Inc(Result); + if (Result < FEnd) and (Result^ = NativeLineFeed) then + Inc(Result); + end; + else + Inc(Result); + end; + end; + end + else + if LineOffset < 0 then + begin + Result := FLastPosition; + while (Result > FContent) and (LineOffset < 1) do + begin + Dec(Result); + case Result^ of + NativeLineFeed: + begin + Inc(LineOffset); + if LineOffset >= 1 then + Inc(Result) + else + if (Result > FContent) and ((Result-1)^ = NativeCarriageReturn) then + Dec(Result); + end; + NativeCarriageReturn: + begin + Inc(LineOffset); + if LineOffset >= 1 then + Inc(Result) + else + if (Result > FContent) and ((Result-1)^ = NativeLineFeed) then + Dec(Result); + end; + end; + end; + end; + FLastLineNumber := LineNumber; + FLastPosition := Result; + end; +end; + +function TJclAnsiMappedTextReader.Read: AnsiChar; +begin + if FPosition >= FEnd then + Result := #0 + else + begin + Result := FPosition^; + Inc(FPosition); + end; +end; + +function TJclAnsiMappedTextReader.ReadLn: AnsiString; +begin + Result := StringFromPosition(FPosition); +end; + +procedure TJclAnsiMappedTextReader.SetPosition(const Value: Integer); +begin + FPosition := FContent + Value; +end; + +function TJclAnsiMappedTextReader.StringFromPosition(var StartPos: PAnsiChar): AnsiString; +var + P: PAnsiChar; +begin + if (StartPos = nil) or (StartPos >= FEnd) then + Result := '' + else + begin + P := StartPos; + while (P < FEnd) and (not CharIsReturn(Char(P^))) do + Inc(P); + SetString(Result, StartPos, P - StartPos); + if P < FEnd then + begin + case P^ of + NativeLineFeed: + begin + Inc(P); + if (P < FEnd) and (P^ = NativeCarriageReturn) then + Inc(P); + end; + NativeCarriageReturn: + begin + Inc(P); + if (P < FEnd) and (P^ = NativeLineFeed) then + Inc(P); + end; + end; + end; + StartPos := P; + end; +end; + +//=== { TJclWideMappedTextReader } =========================================== + +constructor TJclWideMappedTextReader.Create(MemoryStream: TCustomMemoryStream; FreeStream: Boolean; + const AIndexOption: TJclMappedTextReaderIndex); +begin + inherited Create; + FMemoryStream := MemoryStream; + FFreeStream := FreeStream; + FIndexOption := AIndexOption; + Init; +end; + +constructor TJclWideMappedTextReader.Create(const FileName: TFileName; + const AIndexOption: TJclMappedTextReaderIndex); +begin + inherited Create; + {$IFDEF MSWINDOWS} + FMemoryStream := TJclFileMappingStream.Create(FileName); + {$ELSE ~ MSWINDOWS} + FMemoryStream := TMemoryStream.Create; + TMemoryStream(FMemoryStream).LoadFromFile(FileName); + {$ENDIF ~ MSWINDOWS} + FFreeStream := True; + FIndexOption := AIndexOption; + Init; +end; + +destructor TJclWideMappedTextReader.Destroy; +begin + if FFreeStream then + FMemoryStream.Free; + FreeMem(FIndex); + inherited Destroy; +end; + +procedure TJclWideMappedTextReader.AssignTo(Dest: TPersistent); +begin + if Dest is TStrings then + begin + GoBegin; + TStrings(Dest).BeginUpdate; + try + while not Eof do + TStrings(Dest).Add(string(ReadLn)); + finally + TStrings(Dest).EndUpdate; + end; + end + else + inherited AssignTo(Dest); +end; + +procedure TJclWideMappedTextReader.CreateIndex; +var + P, LastLineStart: PWideChar; + I: Integer; +begin + {$RANGECHECKS OFF} + P := FContent; + I := 0; + LastLineStart := P; + while P < FEnd do + begin + // CRLF, CR, LF and LFCR are seen as valid sets of chars for EOL marker + if CharIsReturn(Char(P^)) then + begin + if I and $FFFF = 0 then + ReallocMem(FIndex, (I + $10000) * SizeOf(Pointer)); + FIndex[I] := LastLineStart; + Inc(I); + + case P^ of + NativeLineFeed: + begin + Inc(P); + if (P < FEnd) and (P^ = NativeCarriageReturn) then + Inc(P); + end; + NativeCarriageReturn: + begin + Inc(P); + if (P < FEnd) and (P^ = NativeLineFeed) then + Inc(P); + end; + end; + LastLineStart := P; + end + else + Inc(P); + end; + if P > LastLineStart then + begin + ReallocMem(FIndex, (I + 1) * SizeOf(Pointer)); + FIndex[I] := LastLineStart; + Inc(I); + end + else + ReallocMem(FIndex, I * SizeOf(Pointer)); + FLineCount := I; + {$IFDEF RANGECHECKS_ON} + {$RANGECHECKS ON} + {$ENDIF RANGECHECKS_ON} +end; + +function TJclWideMappedTextReader.GetEof: Boolean; +begin + Result := FPosition >= FEnd; +end; + +function TJclWideMappedTextReader.GetAsString: WideString; +begin + SetString(Result, Content, Size); +end; + +function TJclWideMappedTextReader.GetChars(Index: Integer): WideChar; +begin + if (Index < 0) or (Index >= Size) then + raise EJclError.CreateRes(@RsFileIndexOutOfRange); + Result := WideChar(PByte(FContent + Index)^); +end; + +function TJclWideMappedTextReader.GetLineCount: Integer; +var + P: PWideChar; +begin + if FLineCount = -1 then + begin + FLineCount := 0; + if FContent < FEnd then + begin + P := FContent; + while P < FEnd do + begin + case P^ of + NativeLineFeed: + begin + Inc(FLineCount); + Inc(P); + if (P < FEnd) and (P^ = NativeCarriageReturn) then + Inc(P); + end; + NativeCarriageReturn: + begin + Inc(FLineCount); + Inc(P); + if (P < FEnd) and (P^ = NativeLineFeed) then + Inc(P); + end; + else + Inc(P); + end; + end; + if (P = FEnd) and (P > FContent) and not CharIsReturn(Char((P-1)^)) then + Inc(FLineCount); + end; + end; + + Result := FLineCount; +end; + +function TJclWideMappedTextReader.GetLines(LineNumber: Integer): WideString; +var + P: PWideChar; +begin + P := PtrFromLine(LineNumber); + Result := StringFromPosition(P); +end; + +function TJclWideMappedTextReader.GetPosition: Integer; +begin + Result := FPosition - FContent; +end; + +procedure TJclWideMappedTextReader.GoBegin; +begin + Position := 0; +end; + +procedure TJclWideMappedTextReader.Init; +begin + FContent := FMemoryStream.Memory; + FSize := FMemoryStream.Size; + FEnd := FContent + FSize; + FPosition := FContent; + FLineCount := -1; + FLastLineNumber := 0; + FLastPosition := FContent; + if IndexOption = tiFull then + CreateIndex; +end; + +function TJclWideMappedTextReader.GetPositionFromLine(LineNumber: Integer): Integer; +var + P: PWideChar; +begin + P := PtrFromLine(LineNumber); + if P = nil then + Result := -1 + else + Result := P - FContent; +end; + +function TJclWideMappedTextReader.PtrFromLine(LineNumber: Integer): PWideChar; +var + LineOffset: Integer; +begin + Result := nil; + {$RANGECHECKS OFF} + if (IndexOption <> tiNoIndex) and (LineNumber < FLineCount) and (FIndex[LineNumber] <> nil) then + Result := FIndex[LineNumber] + {$IFDEF RANGECHECKS_ON} + {$RANGECHECKS ON} + {$ENDIF RANGECHECKS_ON} + else + begin + LineOffset := LineNumber - FLastLineNumber; + if (FLineCount <> -1) and (LineNumber > 0) then + begin + if -LineOffset > LineNumber then + begin + FLastLineNumber := 0; + FLastPosition := FContent; + LineOffset := LineNumber; + end + else + if LineOffset > FLineCount - LineNumber then + begin + FLastLineNumber := FLineCount; + FLastPosition := FEnd; + LineOffset := LineNumber - FLineCount; + end; + end; + if LineNumber <= 0 then + Result := FContent + else + if LineOffset = 0 then + Result := FLastPosition + else + if LineOffset > 0 then + begin + Result := FLastPosition; + while (Result < FEnd) and (LineOffset > 0) do + begin + case Result^ of + NativeLineFeed: + begin + Dec(LineOffset); + Inc(Result); + if (Result < FEnd) and (Result^ = NativeCarriageReturn) then + Inc(Result); + end; + NativeCarriageReturn: + begin + Dec(LineOffset); + Inc(Result); + if (Result < FEnd) and (Result^ = NativeLineFeed) then + Inc(Result); + end; + else + Inc(Result); + end; + end; + end + else + if LineOffset < 0 then + begin + Result := FLastPosition; + while (Result > FContent) and (LineOffset < 1) do + begin + Dec(Result); + case Result^ of + NativeLineFeed: + begin + Inc(LineOffset); + if LineOffset >= 1 then + Inc(Result) + else + if (Result > FContent) and ((Result-1)^ = NativeCarriageReturn) then + Dec(Result); + end; + NativeCarriageReturn: + begin + Inc(LineOffset); + if LineOffset >= 1 then + Inc(Result) + else + if (Result > FContent) and ((Result-1)^ = NativeLineFeed) then + Dec(Result); + end; + end; + end; + end; + FLastLineNumber := LineNumber; + FLastPosition := Result; + end; +end; + +function TJclWideMappedTextReader.Read: WideChar; +begin + if FPosition >= FEnd then + Result := #0 + else + begin + Result := FPosition^; + Inc(FPosition); + end; +end; + +function TJclWideMappedTextReader.ReadLn: WideString; +begin + Result := StringFromPosition(FPosition); +end; + +procedure TJclWideMappedTextReader.SetPosition(const Value: Integer); +begin + FPosition := FContent + Value; +end; + +function TJclWideMappedTextReader.StringFromPosition(var StartPos: PWideChar): WideString; +var + P: PWideChar; +begin + if (StartPos = nil) or (StartPos >= FEnd) then + Result := '' + else + begin + P := StartPos; + while (P < FEnd) and (not CharIsReturn(Char(P^))) do + Inc(P); + SetString(Result, StartPos, P - StartPos); + if P < FEnd then + begin + case P^ of + NativeLineFeed: + begin + Inc(P); + if (P < FEnd) and (P^ = NativeCarriageReturn) then + Inc(P); + end; + NativeCarriageReturn: + begin + Inc(P); + if (P < FEnd) and (P^ = NativeLineFeed) then + Inc(P); + end; + end; + end; + StartPos := P; + end; +end; + +function CharIsDriveLetter(const C: Char): Boolean; +begin + case C of + 'a'..'z', + 'A'..'Z': + Result := True; + else + Result := False; + end; +end; + +//=== Path manipulation ====================================================== + +function PathAddSeparator(const Path: string): string; +begin + Result := Path; + if (Path = '') or (Path[Length(Path)] <> DirDelimiter) then + Result := Path + DirDelimiter; +end; + +function PathAddExtension(const Path, Extension: string): string; +begin + Result := Path; + // (obones) Extension may not contain the leading dot while ExtractFileExt + // always returns it. Hence the need to use StrEnsurePrefix for the SameText + // test to return an accurate value. + if (Path <> '') and (Extension <> '') and + not SameText(ExtractFileExt(Path), StrEnsurePrefix('.', Extension)) then + begin + if Path[Length(Path)] = '.' then + Delete(Result, Length(Path), 1); + if Extension[1] = '.' then + Result := Result + Extension + else + Result := Result + '.' + Extension; + end; +end; + +function PathAppend(const Path, Append: string): string; +var + PathLength: Integer; + B1, B2: Boolean; +begin + if Append = '' then + Result := Path + else + begin + PathLength := Length(Path); + if PathLength = 0 then + Result := Append + else + begin + // The following code may look a bit complex but all it does is add Append to Path ensuring + // that there is one and only one path separator character between them + B1 := Path[PathLength] = DirDelimiter; + B2 := Append[1] = DirDelimiter; + if B1 and B2 then + Result := Copy(Path, 1, PathLength - 1) + Append + else + begin + if not (B1 or B2) then + Result := Path + DirDelimiter + Append + else + Result := Path + Append; + end; + end; + end; +end; + +function PathBuildRoot(const Drive: Byte): string; +begin + {$IFDEF UNIX} + Result := DirDelimiter; + {$ENDIF UNIX} + {$IFDEF MSWINDOWS} + // Remember, Win32 only allows 'a' to 'z' as drive letters (mapped to 0..25) + if Drive < 26 then + Result := Char(Drive + 65) + ':\' + else + raise EJclPathError.CreateResFmt(@RsPathInvalidDrive, [IntToStr(Drive)]); + {$ENDIF MSWINDOWS} +end; + +function PathCanonicalize(const Path: string): string; +var + List: TStringList; + S: string; + I, K: Integer; + IsAbsolute: Boolean; +begin + I := Pos(':', Path); // for Windows' sake + K := Pos(DirDelimiter, Path); + IsAbsolute := K - I = 1; + if IsAbsolute then begin + if Copy(Path, 1, Length(PathUncPrefix)) = PathUncPrefix then // UNC path + K := 2; + end else + K := I; + if K = 0 then + S := Path + else + S := Copy(Path, K + 1, Length(Path)); + List := TStringList.Create; + try + StrIToStrings(S, DirDelimiter, List, True); + I := 0; + while I < List.Count do + begin + if List[I] = '.' then + List.Delete(I) + else + if (IsAbsolute or (I > 0) and not (List[I-1] = '..')) and (List[I] = '..') then + begin + List.Delete(I); + if I > 0 then + begin + Dec(I); + List.Delete(I); + end; + end + else Inc(I); + end; + Result := StringsToStr(List, DirDelimiter, True); + finally + List.Free; + end; + if K > 0 then + Result := Copy(Path, 1, K) + Result + else + if Result = '' then + Result := '.'; +end; + +function PathCommonPrefix(const Path1, Path2: string): Integer; +var + Index1, Index2: Integer; + LastSeparator, LenS1: Integer; + S1, S2: string; +begin + Result := 0; + if (Path1 <> '') and (Path2 <> '') then + begin + // Initialize P1 to the shortest of the two paths so that the actual comparison loop below can + // use the terminating #0 of that string to terminate the loop. + if Length(Path1) <= Length(Path2) then + begin + S1 := Path1; + S2 := Path2; + end + else + begin + S1 := Path2; + S2 := Path1; + end; + Index1 := 1; + Index2 := 1; + LenS1 := Length(S1); + LastSeparator := 0; + while (S1[Index1] = S2[Index2]) and (Index1 <= LenS1) do + begin + Inc(Result); + if (S1[Index1] = DirDelimiter) or (S1[Index1] = ':') then + LastSeparator := Result; + Inc(Index1); + Inc(Index2); + end; + if (LastSeparator < Result) and (Index1 <= LenS1) then + Result := LastSeparator; + end; +end; + +{$IFDEF MSWINDOWS} +function PathCompactPath(const DC: HDC; const Path: string; + const Width: Integer; CmpFmt: TCompactPath): string; +const + Compacts: array [TCompactPath] of Cardinal = (DT_PATH_ELLIPSIS, DT_END_ELLIPSIS); +var + TextRect: TRect; + Fmt: Cardinal; +begin + Result := ''; + if (DC <> 0) and (Path <> '') and (Width > 0) then + begin + { Here's a note from the Platform SDK to explain the + 5 in the call below: + "If dwDTFormat includes DT_MODIFYSTRING, the function could add up to four additional characters + to this string. The buffer containing the string should be large enough to accommodate these + extra characters." } + SetString(Result, PChar(Path), Length(Path) + 4); + TextRect := Rect(0, 0, Width, 255); + Fmt := DT_MODIFYSTRING or DT_CALCRECT or Compacts[CmpFmt]; + if DrawTextEx(DC, PChar(Result), -1, TextRect, Fmt, nil) <> 0 then + StrResetLength(Result) + else + Result := ''; // in case of error + end; +end; +{$ENDIF MSWINDOWS} + +procedure PathExtractElements(const Source: string; var Drive, Path, FileName, Ext: string); +begin + Drive := ExtractFileDrive(Source); + Path := ExtractFilePath(Source); + // Path includes drive so remove that + if Drive <> '' then + Delete(Path, 1, Length(Drive)); + // add/remove separators + Drive := PathAddSeparator(Drive); + Path := PathRemoveSeparator(Path); + if (Path <> '') and (Path[1] = DirDelimiter) then + Delete(Path, 1, 1); + // and extract the remaining elements + FileName := PathExtractFileNameNoExt(Source); + Ext := ExtractFileExt(Source); +end; + +function PathExtractFileDirFixed(const S: string): string; +begin + Result := PathAddSeparator(ExtractFileDir(S)); +end; + +function PathExtractFileNameNoExt(const Path: string): string; +begin + Result := PathRemoveExtension(ExtractFileName(Path)); +end; + +function PathExtractPathDepth(const Path: string; Depth: Integer): string; +var + List: TStringList; + LocalPath: string; + I: Integer; +begin + List := TStringList.Create; + try + if IsDirectory(Path) then + LocalPath := Path + else + LocalPath := ExtractFilePath(Path); + StrIToStrings(LocalPath, DirDelimiter, List, True); + I := Depth + 1; + if PathIsUNC(LocalPath) then + I := I + 2; + while I < List.Count do + List.Delete(I); + Result := PathAddSeparator(StringsToStr(List, DirDelimiter, True)); + finally + List.Free; + end; +end; + +// Notes: maybe this function should first apply PathCanonicalize() ? + +function PathGetDepth(const Path: string): Integer; +var + List: TStringList; + LocalPath: string; + I, Start: Integer; +begin + Result := 0; + List := TStringList.Create; + try + if IsDirectory(Path) then + LocalPath := Path + else + LocalPath := ExtractFilePath(Path); + StrIToStrings(LocalPath, DirDelimiter, List, False); + if PathIsUNC(LocalPath) then + Start := 1 + else + Start := 0; + for I := Start to List.Count - 1 do + begin + if Pos(':', List[I]) = 0 then + Inc(Result); + end; + finally + List.Free; + end; +end; + +{$IFDEF MSWINDOWS} + +function ShellGetLongPathName(const Path: string): string; +{$IFDEF FPC} +// As of 2004-10-17, FPC's ShlObj unit is just a dummy +begin + Result := Path; +end; +{$ElSE ~FPC} +var + PIDL: PItemIDList; + Desktop: IShellFolder; + {$IFNDEF SUPPORTS_UNICODE} + AnsiName: string; + WideName: array [0..MAX_PATH] of WideChar; + {$ENDIF ~SUPPORTS_UNICODE} + Eaten, Attr: ULONG; // both unused but API requires them (incorrect translation) +begin + Result := Path; + if Path <> '' then + begin + if Succeeded(SHGetDesktopFolder(Desktop)) then + begin + {$IFDEF SUPPORTS_UNICODE} + if Succeeded(Desktop.ParseDisplayName(0, nil, PChar(Path), Eaten, PIDL, Attr)) then + try + SetLength(Result, MAX_PATH); + if SHGetPathFromIDList(PIDL, PChar(Result)) then + StrResetLength(Result); + finally + CoTaskMemFree(PIDL); + end; + {$ELSE ~SUPPORTS_UNICODE} + MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PAnsiChar(Path), -1, WideName, MAX_PATH); + if Succeeded(Desktop.ParseDisplayName(0, nil, WideName, Eaten, PIDL, Attr)) then + try + SetLength(AnsiName, MAX_PATH); + if SHGetPathFromIDList(PIDL, PChar(AnsiName)) then + StrResetLength(AnsiName); + Result := AnsiName; + finally + CoTaskMemFree(PIDL); + end; + {$ENDIF ~SUPPORTS_UNICODE} + end; + end; +end; +{$ENDIF ~FPC} + +{ TODO : Move RTDL code over to JclWin32 when JclWin32 gets overhauled. } +var + _Kernel32Handle: TModuleHandle = INVALID_MODULEHANDLE_VALUE; + _GetLongPathName: function (lpszShortPath: PChar; lpszLongPath: PChar; + cchBuffer: DWORD): DWORD; stdcall; + +function Kernel32Handle: HMODULE; +begin + JclSysUtils.LoadModule(_Kernel32Handle, kernel32); + Result := _Kernel32Handle; +end; + +function RtdlGetLongPathName(const Path: string): string; +begin + Result := Path; + if not Assigned(_GetLongPathName) then + _GetLongPathName := GetModuleSymbol(Kernel32Handle, 'GetLongPathName' + AWSuffix); + if not Assigned(_GetLongPathName) then + Result := ShellGetLongPathName(Path) + else + begin + SetLength(Result, MAX_PATH); + SetLength(Result, _GetLongPathName(PChar(Path), PChar(Result), MAX_PATH)); + end; +end; + +function PathGetLongName(const Path: string): string; +begin + if Pos('::', Path) > 0 then // Path contains '::{}' + Result := ShellGetLongPathName(Path) + else + Result := RtdlGetLongPathName(Path); + + if Result = '' then + Result := Path; +end; + +function PathGetShortName(const Path: string): string; +var + Required: Integer; +begin + Result := Path; + Required := GetShortPathName(PChar(Path), nil, 0); + if Required <> 0 then + begin + SetLength(Result, Required); + Required := GetShortPathName(PChar(Path), PChar(Result), Required); + if (Required <> 0) and (Required = Length(Result) - 1) then + SetLength(Result, Required) + else + Result := Path; + end; +end; + +{$ENDIF MSWINDOWS} + +function PathGetRelativePath(Origin, Destination: string): string; +var + {$IFDEF MSWINDOWS} + OrigDrive: string; + DestDrive: string; + {$ENDIF MSWINDOWS} + OrigList: TStringList; + DestList: TStringList; + DiffIndex: Integer; + I: Integer; + + function StartsFromRoot(const Path: string): Boolean; + {$IFDEF MSWINDOWS} + var + I: Integer; + begin + I := Length(ExtractFileDrive(Path)); + Result := (Length(Path) > I) and (Path[I + 1] = DirDelimiter); + end; + {$ELSE ~MSWINDOWS} + begin + Result := Pos(DirDelimiter, Path) = 1; + end; + {$ENDIF ~MSWINDOWS} + + function Equal(const Path1, Path2: string): Boolean; + begin + {$IFDEF MSWINDOWS} // case insensitive + Result := StrSame(Path1, Path2); + {$ELSE ~MSWINDOWS} // case sensitive + Result := Path1 = Path2; + {$ENDIF ~MSWINDOWS} + end; + +begin + Origin := PathCanonicalize(Origin); + Destination := PathCanonicalize(Destination); + {$IFDEF MSWINDOWS} + OrigDrive := ExtractFileDrive(Origin); + DestDrive := ExtractFileDrive(Destination); + {$ENDIF MSWINDOWS} + if Equal(Origin, Destination) or (Destination = '') then + Result := '.' + else + if Origin = '' then + Result := Destination + else + {$IFDEF MSWINDOWS} + if (DestDrive <> '') and ((OrigDrive = '') or ((OrigDrive <> '') and not Equal(OrigDrive, DestDrive))) then + Result := Destination + else + if (OrigDrive <> '') and (Pos(DirDelimiter, Destination) = 1) + and not Equal(PathUncPrefix,Copy(Destination,1,Length(PathUncPrefix))) then + Result := OrigDrive + Destination // prepend drive part from Origin + else + {$ENDIF MSWINDOWS} + if StartsFromRoot(Origin) and not StartsFromRoot(Destination) then + Result := StrEnsureSuffix(DirDelimiter, Origin) + + StrEnsureNoPrefix(DirDelimiter, Destination) + else + begin + // create a list of paths as separate strings + OrigList := TStringList.Create; + DestList := TStringList.Create; + try + // NOTE: DO NOT USE DELIMITER AND DELIMITEDTEXT FROM + // TSTRINGS, THEY WILL SPLIT PATHS WITH SPACES !!!! + StrToStrings(Origin, DirDelimiter, OrigList, False); + StrToStrings(Destination, DirDelimiter, DestList, False); + begin + // find the first directory that is not the same + DiffIndex := OrigList.Count; + if DestList.Count < DiffIndex then + DiffIndex := DestList.Count; + for I := 0 to DiffIndex - 1 do + if not Equal(OrigList[I], DestList[I]) then + begin + DiffIndex := I; + Break; + end; + Result := StrRepeat('..' + DirDelimiter, OrigList.Count - DiffIndex); + Result := PathRemoveSeparator(Result); + for I := DiffIndex to DestList.Count - 1 do + begin + if Result <> '' then + Result := Result + DirDelimiter; + Result := Result + DestList[i]; + end; + end; + finally + DestList.Free; + OrigList.Free; + end; + end; +end; + +function PathGetTempPath: string; +{$IFDEF MSWINDOWS} +var + BufSize: Cardinal; +begin + BufSize := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetTempPath(0, nil); + SetLength(Result, BufSize); + { TODO : Check length (-1 or not) } + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetTempPath(BufSize, PChar(Result)); + StrResetLength(Result); +end; +{$ENDIF MSWINDOWS} +{$IFDEF UNIX} +begin + Result := GetEnvironmentVariable('TMPDIR'); +end; +{$ENDIF UNIX} + +function PathIsAbsolute(const Path: string): Boolean; +{$IFDEF MSWINDOWS} +var + I: Integer; +{$ENDIF MSWINDOWS} +begin + Result := False; + if Path <> '' then + begin + {$IFDEF UNIX} + Result := (Path[1] = DirDelimiter); + {$ENDIF UNIX} + {$IFDEF MSWINDOWS} + if not PathIsUnc(Path) then + begin + I := 0; + if PathIsDiskDevice(Path) then + I := Length(PathDevicePrefix); + Result := (Length(Path) > I + 2) and CharIsDriveLetter(Path[I + 1]) and + (Path[I + 2] = ':') and (Path[I + 3] = DirDelimiter); + end + else + Result := True; + {$ENDIF MSWINDOWS} + end; +end; + +function PathIsChild(const Path, Base: string): Boolean; +var + L: Integer; + B, P: string; +begin + Result := False; + B := PathRemoveSeparator(Base); + P := PathRemoveSeparator(Path); + // an empty path or one that's not longer than base cannot be a subdirectory + L := Length(B); + if (P = '') or (L >= Length(P)) then + Exit; + {$IFDEF MSWINDOWS} + Result := AnsiSameText(StrLeft(P, L), B) and (P[L+1] = DirDelimiter); + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + Result := AnsiSameStr(StrLeft(P, L), B) and (P[L+1] = DirDelimiter); + {$ENDIF UNIX} +end; + +function PathIsEqualOrChild(const Path, Base: string): Boolean; +var + L: Integer; + B, P: string; +begin + B := PathRemoveSeparator(Base); + P := PathRemoveSeparator(Path); + // an empty path or one that's not longer than base cannot be a subdirectory + L := Length(B); + {$IFDEF MSWINDOWS} + Result := AnsiSameText(P, B); + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + Result := AnsiSameStr(P, B); + {$ENDIF UNIX} + if Result or (P = '') or (L >= Length(P)) then + Exit; + {$IFDEF MSWINDOWS} + Result := AnsiSameText(StrLeft(P, L), B) and (P[L+1] = DirDelimiter); + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + Result := AnsiSameStr(StrLeft(P, L), B) and (P[L+1] = DirDelimiter); + {$ENDIF UNIX} +end; + +function PathIsDiskDevice(const Path: string): Boolean; +{$IFDEF UNIX} +var + FullPath: string; + F: PIOFile; + Buffer: array [0..255] of AnsiChar; + MountEntry: TMountEntry; + FsTypes: TStringList; + + procedure GetAvailableFileSystems(const List: TStrings); + var + F: TextFile; + S: string; + begin + AssignFile(F, '/proc/filesystems'); + Reset(F); + repeat + Readln(F, S); + if Pos('nodev', S) = 0 then // how portable is this ? + List.Add(Trim(S)); + until Eof(F); + List.Add('supermount'); + CloseFile(F); + end; + +begin + Result := False; + + SetLength(FullPath, _POSIX_PATH_MAX); + if realpath(PChar(Path), PChar(FullPath)) = nil then + RaiseLastOSError; + StrResetLength(FullPath); + + FsTypes := TStringList.Create; + try + GetAvailableFileSystems(FsTypes); + F := setmntent(_PATH_MOUNTED, 'r'); // PATH_MOUNTED is deprecated, + // but PATH_MNTTAB is defective in Libc.pas + try + // get drives from mtab + while not Result and (getmntent_r(F, MountEntry, Buffer, SizeOf(Buffer)) <> nil) do + if FsTypes.IndexOf(MountEntry.mnt_type) <> -1 then + Result := MountEntry.mnt_dir = FullPath; + + finally + endmntent(F); + end; + finally + FsTypes.Free; + end; +end; +{$ENDIF UNIX} +{$IFDEF MSWINDOWS} +begin + Result := Copy(Path, 1, Length(PathDevicePrefix)) = PathDevicePrefix; +end; +{$ENDIF MSWINDOWS} + +function CharIsMachineName(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +begin + case C of + 'a'..'z', + 'A'..'Z', + '-', '_', '.': + Result := True; + else + Result := False; + end; +end; + +function CharIsInvalidFileNameCharacter(const C: Char): Boolean; +begin + case C of + '<', '>', '?', '/', '\', ',', '*', '+', '=', '[', ']', '|', ':', ';', '"', '''': + Result := True; + else + Result := False; + end; +end; + +function CharIsInvalidPathCharacter(const C: Char): Boolean; +begin + case C of + '<', '>', '?', + {$IFDEF UNIX} + '/', + {$ELSE} + '\', + {$ENDIF} + ',', '*', '+', '=', '[', ']', '|', ':', ';', '"', '''': + Result := True; + else + Result := False; + end; +end; + +function PathIsUNC(const Path: string): Boolean; + +{$IFDEF MSWINDOWS} + +const + cUNCSuffix = '?\UNC'; + +var + P: PChar; + + function AbsorbSeparator: Boolean; + begin + Result := (P <> nil) and (P^ = DirDelimiter); + if Result then + Inc(P); + end; + + function AbsorbMachineName: Boolean; + var + NonDigitFound: Boolean; + begin + // a valid machine name is a string composed of the set [a-z, A-Z, 0-9, -, _] but it may not + // consist entirely out of numbers + Result := True; + NonDigitFound := False; + while (P^ <> #0) and (P^ <> DirDelimiter) do + begin + if CharIsMachineName(P^) then + begin + NonDigitFound := True; + Inc(P); + end + else + if CharIsDigit(P^) then + Inc(P) + else + begin + Result := False; + Break; + end; + end; + Result := Result and NonDigitFound; + end; + + function AbsorbShareName: Boolean; + begin + // a valid share name is a string composed of a set the set !InvalidCharacters note that a + // leading '$' is valid (indicates a hidden share) + Result := True; + while (P^ <> #0) and (P^ <> DirDelimiter) do + begin + if CharIsInvalidPathCharacter(P^) then + begin + Result := False; + Break; + end; + Inc(P); + end; + end; + +begin + Result := Copy(Path, 1, Length(PathUncPrefix)) = PathUncPrefix; + if Result then + begin + if Copy(Path, 1, Length(PathUncPrefix + cUNCSuffix)) = PathUncPrefix + cUNCSuffix then + P := @Path[Length(PathUncPrefix + cUNCSuffix)] + else + begin + P := @Path[Length(PathUncPrefix)]; + Result := AbsorbSeparator and AbsorbMachineName; + end; + Result := Result and AbsorbSeparator; + if Result then + begin + Result := AbsorbShareName; + // remaining, if anything, is path and or filename (optional) check those? + end; + end; +end; + +{$ENDIF MSWINDOWS} + +{$IFDEF UNIX} + +begin + Result := False; +end; + +{$ENDIF UNIX} + +function PathRemoveSeparator(const Path: string): string; +var + L: Integer; +begin + L := Length(Path); + if (L <> 0) and (Path[L] = DirDelimiter) then + Result := Copy(Path, 1, L - 1) + else + Result := Path; +end; + +function PathRemoveExtension(const Path: string): string; +var + I: Integer; +begin + I := LastDelimiter(':.' + DirDelimiter, Path); + if (I > 0) and (Path[I] = '.') then + Result := Copy(Path, 1, I - 1) + else + Result := Path; +end; + +{$IFDEF MSWINDOWS} + +function SHGetDisplayName(ShellFolder: IShellFolder; PIDL: PItemIDList; ForParsing: Boolean): string; +const + Flags: array[Boolean] of DWORD = (SHGDN_NORMAL, SHGDN_FORPARSING); +var + StrRet: TStrRet; + P: PChar; +begin + Result := ''; + StrRet.utype := 0; + + ShellFolder.GetDisplayNameOf(PIDL, Flags[ForParsing], StrRet); + case StrRet.uType of + STRRET_CSTR: + SetString(Result, StrRet.cStr, lstrlenA(StrRet.cStr)); + STRRET_OFFSET: + begin + P := @PIDL.mkid.abID[StrRet.uOffset - SizeOf(PIDL.mkid.cb)]; + SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset); + end; + STRRET_WSTR: + Result := StrRet.pOleStr; + end; + Result := Copy(Result, 1, lstrlen(PChar(Result))); +end; + +function CutFirstDirectory(var Path: string): string; +var + ps: Integer; +begin + ps := AnsiPos(DirDelimiter, Path); + if ps > 0 then + begin + Result := Copy(Path, 1, ps - 1); + Path := Copy(Path, ps + 1, Length(Path)); + end + else + begin + Result := Path; + Path := ''; + end; +end; + +function PathGetPhysicalPath(const LocalizedPath: string): string; +var + Malloc: IMalloc; + DesktopFolder: IShellFolder; + RootFolder: IShellFolder; + Eaten: Cardinal; + Attributes: Cardinal; + pidl: PItemIDList; + EnumIDL: IEnumIDList; + Drive: WideString; + Featched: Cardinal; + ParsePath: WideString; + Path, Name: string; + Found: Boolean; +begin + if StrCompareRange('\\', LocalizedPath, 1, 2) = 0 then + begin + Result := LocalizedPath; + Exit; + end; + + Drive := ExtractFileDrive(LocalizedPath); + if Drive = '' then + begin + Result := LocalizedPath; + Exit; + end; + Path := Copy(LocalizedPath, Length(Drive) + 2, Length(LocalizedPath)); + ParsePath := Drive; + OLECheck( SHGetMalloc(Malloc) ); + OleCheck( SHGetDesktopFolder(DesktopFolder) ); + while Path <> '' do + begin + Name := CutFirstDirectory(Path); + Found := False; + pidl := nil; + Attributes := 0; + if Succeeded( DesktopFolder.ParseDisplayName(0, nil, PWideChar(ParsePath), Eaten, pidl, Attributes) ) then + begin + OleCheck( DesktopFolder.BindToObject(pidl, nil, IShellFolder, RootFolder) ); + Malloc.Free(pidl); + + OleCheck( RootFolder.EnumObjects(0, SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN, EnumIDL) ); + Featched := 0; + while EnumIDL.Next(1, pidl, Featched) = NOERROR do + begin + if AnsiCompareText(Name, SHGetDisplayName(RootFolder, pidl, False)) = 0 then + begin + ParsePath := SHGetDisplayName(RootFolder, pidl, True); + Malloc.Free(pidl); + Found := True; + Break; + end; + Malloc.Free(pidl); + end; + EnumIDL := nil; + RootFolder := nil; + end; + if not Found then + ParsePath := ParsePath + DirDelimiter + Name; + end; + Result := ParsePath; +end; + +function PathGetLocalizedPath(const PhysicalPath: string): string; +var + Malloc: IMalloc; + DesktopFolder: IShellFolder; + RootFolder: IShellFolder; + Eaten: Cardinal; + Attributes: Cardinal; + pidl: PItemIDList; + EnumIDL: IEnumIDList; + Drive: WideString; + Featched: Cardinal; + ParsePath: WideString; + Path, Name, ParseName, DisplayName: string; + Found: Boolean; +begin + if StrCompareRange('\\', PhysicalPath, 1, 2) = 0 then + begin + Result := PhysicalPath; + Exit; + end; + + Drive := ExtractFileDrive(PhysicalPath); + if Drive = '' then + begin + Result := PhysicalPath; + Exit; + end; + Path := Copy(PhysicalPath, Length(Drive) + 2, Length(PhysicalPath)); + ParsePath := Drive; + Result := Drive; + OLECheck( SHGetMalloc(Malloc) ); + OleCheck( SHGetDesktopFolder(DesktopFolder) ); + while Path <> '' do + begin + Name := CutFirstDirectory(Path); + Found := False; + pidl := nil; + Attributes := 0; + if Succeeded( DesktopFolder.ParseDisplayName(0, nil, PWideChar(ParsePath), Eaten, pidl, Attributes) ) then + begin + OleCheck( DesktopFolder.BindToObject(pidl, nil, IShellFolder, RootFolder) ); + Malloc.Free(pidl); + + OleCheck( RootFolder.EnumObjects(0, SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN, EnumIDL) ); + Featched := 0; + while EnumIDL.Next(1, pidl, Featched) = NOERROR do + begin + ParseName := SHGetDisplayName(RootFolder, pidl, True); + DisplayName := SHGetDisplayName(RootFolder, pidl, False); + Malloc.Free(pidl); + if (AnsiCompareText(Name, ExtractFileName(ParseName)) = 0) or + (AnsiCompareText(Name, DisplayName) = 0) then + begin + Name := DisplayName; + ParsePath := ParseName; + Found := True; + Break; + end; + end; + EnumIDL := nil; + RootFolder := nil; + end; + Result := Result + DirDelimiter + Name; + if not Found then + ParsePath := ParsePath + DirDelimiter + Name; + end; +end; + +{$ELSE ~MSWINDOWS} +function PathGetPhysicalPath(const LocalizedPath: string): string; +begin + Result := LocalizedPath; +end; + +function PathGetLocalizedPath(const PhysicalPath: string): string; +begin + Result := PhysicalPath; +end; +{$ENDIF ~MSWINDOWS} + +//=== Files and Directories ================================================== + + +{* Extended version of JclFileUtils.BuildFileList: + function parameter Path can include multiple FileMasks as: + c:\aaa\*.pas; pro*.dpr; *.d?? + FileMask Seperator = ';' + *} + +function BuildFileList(const Path: string; const Attr: Integer; const List: TStrings; IncludeDirectoryName: Boolean = + False): Boolean; +var + SearchRec: TSearchRec; + IndexMask: Integer; + MaskList: TStringList; + Masks, Directory: string; +begin + Assert(List <> nil); + MaskList := TStringList.Create; + try + {* extract the Directory *} + Directory := ExtractFileDir(Path); + + {* files can be searched in the current directory *} + if Directory <> '' then + begin + Directory := PathAddSeparator(Directory); + {* extract the FileMasks portion out of Path *} + Masks := StrAfter(Directory, Path); + end + else + Masks := Path; + + {* put the Masks into TStringlist *} + StrTokenToStrings(Masks, DirSeparator, MaskList); + + {* search all files in the directory *} + Result := FindFirst(Directory + '*', faAnyFile, SearchRec) = 0; + + List.BeginUpdate; + try + while Result do + begin + {* if the filename matches any mask then it is added to the list *} + for IndexMask := 0 to MaskList.Count - 1 do + if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') + and ((SearchRec.Attr and Attr) = (SearchRec.Attr and faAnyFile)) + and IsFileNameMatch(SearchRec.Name, MaskList.Strings[IndexMask]) then + begin + if IncludeDirectoryName then + List.Add(Directory+SearchRec.Name) + else + List.Add(SearchRec.Name); + Break; + end; + + case FindNext(SearchRec) of + 0: + ; + ERROR_NO_MORE_FILES: + Break; + else + Result := False; + end; + end; + finally + {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindClose(SearchRec); + List.EndUpdate; + end; + finally + MaskList.Free; + end; +end; + +{$IFDEF MSWINDOWS} + +procedure CreateEmptyFile(const FileName: string); +var + Handle: THandle; +begin + Handle := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE, 0, nil, CREATE_ALWAYS, 0, 0); + if Handle <> INVALID_HANDLE_VALUE then + CloseHandle(Handle) + else + RaiseLastOSError; +end; +{$ENDIF MSWINDOWS} + +{$IFDEF MSWINDOWS} + +function CloseVolume(var Volume: THandle): Boolean; +begin + Result := False; + if Volume <> INVALID_HANDLE_VALUE then + begin + Result := CloseHandle(Volume); + if Result then + Volume := INVALID_HANDLE_VALUE; + end; +end; + +{$IFNDEF FPC} // needs JclShell + +function DeleteDirectory(const DirectoryName: string; MoveToRecycleBin: Boolean): Boolean; +begin + if MoveToRecycleBin then + Result := SHDeleteFolder(0, DirectoryName, [doSilent, doAllowUndo]) + else + Result := DelTree(DirectoryName); +end; + +function CopyDirectory(ExistingDirectoryName, NewDirectoryName: string): Boolean; +var + SH: SHFILEOPSTRUCT; +begin + ResetMemory(SH, SizeOf(SH)); + SH.Wnd := 0; + SH.wFunc := FO_COPY; + SH.pFrom := PChar(PathRemoveSeparator(ExistingDirectoryName) + #0); + SH.pTo := PChar(PathRemoveSeparator(NewDirectoryName) + #0); + SH.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR or FOF_SILENT; + Result := SHFileOperation(SH) = 0; +end; + +function MoveDirectory(ExistingDirectoryName, NewDirectoryName: string): Boolean; +var + SH: SHFILEOPSTRUCT; +begin + ResetMemory(SH, SizeOf(SH)); + SH.Wnd := 0; + SH.wFunc := FO_MOVE; + SH.pFrom := PChar(PathRemoveSeparator(ExistingDirectoryName) + #0); + SH.pTo := PChar(PathRemoveSeparator(NewDirectoryName) + #0); + SH.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR or FOF_SILENT; + Result := SHFileOperation(SH) = 0; +end; + +{$ENDIF ~FPC} + +function DelTree(const Path: string): Boolean; +begin + Result := DelTreeEx(Path, False, nil); +end; + +function DelTreeEx(const Path: string; AbortOnFailure: Boolean; Progress: TDelTreeProgress): Boolean; +var + Files: TStringList; + LPath: string; // writable copy of Path + FileName: string; + I: Integer; + PartialResult: Boolean; + Attr: DWORD; +begin + Assert(Path <> '', LoadResString(@RsDelTreePathIsEmpty)); + {$IFNDEF ASSERTIONS_ON} + if Path = '' then + begin + Result := False; + Exit; + end; + {$ENDIF ~ASSERTIONS_ON} + Result := True; + Files := TStringList.Create; + try + LPath := PathRemoveSeparator(Path); + BuildFileList(LPath + '\*.*', faAnyFile, Files); + for I := 0 to Files.Count - 1 do + begin + FileName := LPath + DirDelimiter + Files[I]; + PartialResult := True; + // If the current file is itself a directory then recursively delete it + Attr := GetFileAttributes(PChar(FileName)); + if (Attr <> DWORD(-1)) and ((Attr and FILE_ATTRIBUTE_DIRECTORY) <> 0) then + PartialResult := DelTreeEx(FileName, AbortOnFailure, Progress) + else + begin + if Assigned(Progress) then + PartialResult := Progress(FileName, Attr); + if PartialResult then + begin + // Set attributes to normal in case it's a readonly file + PartialResult := SetFileAttributes(PChar(FileName), FILE_ATTRIBUTE_NORMAL); + if PartialResult then + PartialResult := DeleteFile(FileName); + end; + end; + if not PartialResult then + begin + Result := False; + if AbortOnFailure then + Break; + end; + end; + finally + FreeAndNil(Files); + end; + if Result then + begin + // Finally remove the directory itself + Result := SetFileAttributes(PChar(LPath), FILE_ATTRIBUTE_NORMAL); + if Result then + begin + {$IOCHECKS OFF} + RmDir(LPath); + {$IFDEF IOCHECKS_ON} + {$IOCHECKS ON} + {$ENDIF IOCHECKS_ON} + Result := IOResult = 0; + end; + end; +end; + +{$ENDIF MSWINDOWS} + +{$IFDEF MSWINDOWS} +function DirectoryExists(const Name: string): Boolean; +var + R: DWORD; +begin + R := GetFileAttributes(PChar(Name)); + Result := (R <> DWORD(-1)) and ((R and FILE_ATTRIBUTE_DIRECTORY) <> 0); +end; +{$ENDIF MSWINDOWS} + +{$IFDEF UNIX} +function DirectoryExists(const Name: string; ResolveSymLinks: Boolean): Boolean; +begin + Result := IsDirectory(Name, ResolveSymLinks); +end; +{$ENDIF UNIX} + +{$IFDEF MSWINDOWS} +function DiskInDrive(Drive: Char): Boolean; +var + ErrorMode: Cardinal; +begin + Result := False; + Assert(CharIsDriveLetter(Drive)); + if CharIsDriveLetter(Drive) then + begin + Drive := CharUpper(Drive); + { try to access the drive, it doesn't really matter how we access the drive and as such calling + DiskSize is more or less a random choice. The call to SetErrorMode supresses the system provided + error dialog if there is no disk in the drive and causes the to DiskSize to fail. } + ErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS); + try + Result := DiskSize(Ord(Drive) - $40) <> -1; + finally + SetErrorMode(ErrorMode); + end; + end; +end; +{$ENDIF MSWINDOWS} + +function FileCreateTemp(var Prefix: string): THandle; +{$IFDEF MSWINDOWS} +var + TempName: string; +begin + Result := INVALID_HANDLE_VALUE; + TempName := FileGetTempName(Prefix); + if TempName <> '' then + begin + Result := CreateFile(PChar(TempName), GENERIC_READ or GENERIC_WRITE, 0, nil, + OPEN_EXISTING, FILE_ATTRIBUTE_TEMPORARY or FILE_FLAG_DELETE_ON_CLOSE, 0); + // In certain situations it's possible that CreateFile fails yet the file is actually created, + // therefore explicitly delete it upon failure. + if Result = INVALID_HANDLE_VALUE then + DeleteFile(TempName); + Prefix := TempName; + end; +end; +{$ENDIF MSWINDOWS} +{$IFDEF UNIX} +var + Template: string; +begin + // The mkstemp function generates a unique file name just as mktemp does, but + // it also opens the file for you with open. If successful, it modifies + // template in place and returns a file descriptor for that file open for + // reading and writing. If mkstemp cannot create a uniquely-named file, it + // returns -1. If template does not end with `XXXXXX', mkstemp returns -1 and + // does not modify template. + + // The file is opened using mode 0600. If the file is meant to be used by + // other users this mode must be changed explicitly. + + // Unlike mktemp, mkstemp is actually guaranteed to create a unique file that + // cannot possibly clash with any other program trying to create a temporary + // file. This is because it works by calling open with the O_EXCL flag, which + // says you want to create a new file and get an error if the file already + // exists. + Template := Prefix + 'XXXXXX'; + Result := mkstemp(PChar(Template)); + Prefix := Template; +end; +{$ENDIF UNIX} + +function FileBackup(const FileName: string; Move: Boolean = False): Boolean; +begin + if Move then + Result := FileMove(FileName, GetBackupFileName(FileName), True) + else + Result := FileCopy(FileName, GetBackupFileName(FileName), True); +end; + +function FileCopy(const ExistingFileName, NewFileName: string; ReplaceExisting: Boolean = False): Boolean; +var + {$IFDEF UNIX} + SrcFile, DstFile: file; + Buf: array[0..511] of Byte; + BytesRead: Integer; + {$ENDIF UNIX} + DestFileName: string; +begin + if IsDirectory(NewFileName) then + DestFileName := PathAddSeparator(NewFileName) + ExtractFileName(ExistingFileName) + else + DestFileName := NewFileName; + {$IFDEF MSWINDOWS} + { TODO : Use CopyFileEx where available? } + Result := CopyFile(PChar(ExistingFileName), PChar(DestFileName), not ReplaceExisting); + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + Result := False; + if not FileExists(DestFileName) or ReplaceExisting then + begin + AssignFile(SrcFile, ExistingFileName); + Reset(SrcFile, 1); + AssignFile(DstFile, DestFileName); + Rewrite(DstFile, 1); + while not Eof(SrcFile) do + begin + BlockRead(SrcFile, Buf, SizeOf(Buf), BytesRead); + BlockWrite(DstFile, Buf, BytesRead); + end; + CloseFile(DstFile); + CloseFile(SrcFile); + Result := True; + end; + {$ENDIF UNIX} +end; + +function FileDateTime(const FileName: string): TDateTime; +{$IFNDEF COMPILER10_UP} +var + Age: Longint; +{$ENDIF !COMPILER10_UP} +begin + {$IFDEF COMPILER10_UP} + if not FileAge(Filename, Result) then + Result := 0; + {$ELSE} + Age := FileAge(FileName); + {$IFDEF MSWINDOWS} + // [roko] -1 is valid FileAge value on Linux + if Age = -1 then + Result := 0 + else + {$ENDIF MSWINDOWS} + Result := FileDateToDateTime(Age); + {$ENDIF COMPILER10_UP} +end; + +function FileDelete(const FileName: string; MoveToRecycleBin: Boolean = False): Boolean; +{$IFDEF MSWINDOWS} +begin + if MoveToRecycleBin then + Result := SHDeleteFiles(0, FileName, [doSilent, doAllowUndo, doFilesOnly]) + else + Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.DeleteFile(PChar(FileName)); +end; +{$ENDIF MSWINDOWS} +{$IFDEF UNIX} + { TODO : implement MoveToRecycleBin for appropriate Desktops (e.g. KDE) } +begin + Result := remove(PChar(FileName)) <> -1; +end; +{$ENDIF UNIX} + +function FileExists(const FileName: string): Boolean; +{$IFDEF MSWINDOWS} +var + Attr: Cardinal; +{$ENDIF MSWINDOWS} +begin + if FileName <> '' then + begin + {$IFDEF MSWINDOWS} + // FileGetSize is very slow, GetFileAttributes is much faster + Attr := GetFileAttributes(Pointer(Filename)); + Result := (Attr <> $FFFFFFFF) and (Attr and FILE_ATTRIBUTE_DIRECTORY = 0); + {$ELSE ~MSWINDOWS} + // Attempt to access the file, doesn't matter how, using FileGetSize is as good as anything else. + Result := FileGetSize(FileName) <> -1; + {$ENDIF ~MSWINDOWS} + end + else + Result := False; +end; + +procedure FileHistory(const FileName: string; HistoryPath: string = ''; MaxHistoryCount: Integer = 100; MinFileDate: + TDateTime = 0; ReplaceExtention: Boolean = true); + + Function Extention (Number : Integer) : String; + begin + Result := inttostr(Number); + while Length(Result) < 3 do + Result := '0' + Result; + Result := '.~'+Result+'~'; + end; + + procedure RenameToNumber(const RenameFileName: string; Number: Integer); + var + f1: string; + f2: string; + begin + f1 := ChangeFileExt(RenameFileName,Extention(Number-1)); + f2 := ChangeFileExt(RenameFileName,Extention(Number)); + if FileExists(f2) then + if Number >= MaxHistoryCount then + if not FileDelete(f2) then + Exception.Create('Unable to delete file "' + f2 + '".') + else + else + RenameToNumber(RenameFileName, Number + 1); + if FileExists(f1) then + if not FileMove(f1, f2, true) then + Exception.Create('Unable to rename file "' + f1 + '" to "' + f2 + '".') + end; + +Var FirstFile : string; +begin + // TODO -cMM: FileHistory default body inserted + if not FileExists(FileName) or (MaxHistoryCount <= 0) then + Exit; + if HistoryPath = '' then + HistoryPath := ExtractFilePath(FileName); + FirstFile := PathAppend(HistoryPath, ExtractFileName(FileName)); + if ReplaceExtention then + FirstFile := ChangeFileExt(FirstFile, Extention(1)) + else + FirstFile := FirstFile+Extention(1); + if (FileDateTime(FirstFile) > MinFileDate) and (MinFileDate <> 0) then + Exit; + RenameToNumber(FirstFile, 2); + FileCopy(FileName, FirstFile, True); +end; + + +function FileMove(const ExistingFileName, NewFileName: string; ReplaceExisting: Boolean = False): Boolean; +{$IFDEF MSWINDOWS} +const + Flag: array[Boolean] of Cardinal = (0, MOVEFILE_REPLACE_EXISTING); +{$ENDIF MSWINDOWS} +begin + {$IFDEF MSWINDOWS} + Result := MoveFileEx(PChar(ExistingFileName), PChar(NewFileName), Flag[ReplaceExisting]); + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + Result := __rename(PChar(ExistingFileName), PChar(NewFileName)) = 0; + {$ENDIF UNIX} + if not Result then + begin + Result := FileCopy(ExistingFileName, NewFileName, ReplaceExisting); + if Result then + FileDelete(ExistingFileName); + end; +end; + +function FileRestore(const FileName: string): Boolean; +var + TempFileName: string; +begin + Result := False; + TempFileName := FileGetTempName(''); + + if FileMove(GetBackupFileName(FileName), TempFileName, True) then + if FileBackup(FileName, False) then + Result := FileMove(TempFileName, FileName, True); +end; + +function GetBackupFileName(const FileName: string): string; +var + NewExt: string; +begin + NewExt := ExtractFileExt(FileName); + if Length(NewExt) > 0 then + begin + NewExt[1] := '~'; + NewExt := '.' + NewExt + end + else + NewExt := '.~'; + Result := ChangeFileExt(FileName, NewExt); +end; + +function IsBackupFileName(const FileName: string): Boolean; +begin + Result := (pos('.~', ExtractFileExt(FileName)) = 1); +end; + +function FileGetDisplayName(const FileName: string): string; +{$IFDEF MSWINDOWS} +var + FileInfo: TSHFileInfo; +begin + ResetMemory(FileInfo, SizeOf(FileInfo)); + if SHGetFileInfo(PChar(FileName), 0, FileInfo, SizeOf(FileInfo), SHGFI_DISPLAYNAME) <> 0 then + Result := FileInfo.szDisplayName + else + Result := FileName; +end; +{$ELSE ~MSWINDOWS} +begin + { TODO -cHelp : mention this reduced solution } + Result := FileName; +end; +{$ENDIF ~MSWINDOWS} + +function FileGetGroupName(const FileName: string {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}): string; +{$IFDEF MSWINDOWS} +var + DomainName: WideString; + TmpResult: WideString; + pSD: PSecurityDescriptor; + BufSize: DWORD; +begin + if IsWinNT then + begin + BufSize := 0; + GetFileSecurity(PChar(FileName), GROUP_SECURITY_INFORMATION, nil, 0, BufSize); + if BufSize > 0 then + begin + GetMem(pSD, BufSize); + GetFileSecurity(PChar(FileName), GROUP_SECURITY_INFORMATION, + pSD, BufSize, BufSize); + LookupAccountBySid(Pointer(TJclAddr(pSD) + TJclAddr(pSD^.Group)), TmpResult, DomainName, True); + FreeMem(pSD); + Result := Trim(TmpResult); + end; + end; +end; +{$ENDIF ~MSWINDOWS} +{$IFDEF UNIX} +var + Buf: TStatBuf64; + ResultBuf: TGroup; + ResultBufPtr: PGroup; + Buffer: array of Char; +begin + if GetFileStatus(FileName, Buf, ResolveSymLinks) = 0 then + begin + SetLength(Buffer, 128); + while getgrgid_r(Buf.st_gid, ResultBuf, @Buffer[0], Length(Buffer), ResultBufPtr) = ERANGE do + SetLength(Buffer, Length(Buffer) * 2); + Result := ResultBuf.gr_name; + end; +end; +{$ENDIF ~UNIX} + +function FileGetOwnerName(const FileName: string {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}): string; +{$IFDEF MSWINDOWS} +var + DomainName: WideString; + TmpResult: WideString; + pSD: PSecurityDescriptor; + BufSize: DWORD; +begin + if IsWinNT then + begin + BufSize := 0; + GetFileSecurity(PChar(FileName), OWNER_SECURITY_INFORMATION, nil, 0, BufSize); + if BufSize > 0 then + begin + GetMem(pSD, BufSize); + try + GetFileSecurity(PChar(FileName), OWNER_SECURITY_INFORMATION, + pSD, BufSize, BufSize); + LookupAccountBySid(Pointer(TJclAddr(pSD) + TJclAddr(pSD^.Owner)), TmpResult, DomainName, True); + finally + FreeMem(pSD); + end; + Result := Trim(TmpResult); + end; + end; +end; +{$ENDIF ~MSWINDOWS} +{$IFDEF UNIX} +var + Buf: TStatBuf64; + ResultBuf: TPasswordRecord; + ResultBufPtr: PPasswordRecord; + Buffer: array of Char; +begin + if GetFileStatus(FileName, Buf, ResolveSymLinks) = 0 then + begin + SetLength(Buffer, 128); + while getpwuid_r(Buf.st_uid, ResultBuf, @Buffer[0], Length(Buffer), ResultBufPtr) = ERANGE do + SetLength(Buffer, Length(Buffer) * 2); + Result := ResultBuf.pw_name; + end; +end; +{$ENDIF ~UNIX} + +function FileGetSize(const FileName: string): Int64; +{$IFDEF MSWINDOWS} +var + FileAttributesEx: WIN32_FILE_ATTRIBUTE_DATA; + OldMode: Cardinal; + Size: TJclULargeInteger; +begin + Result := -1; + OldMode := SetErrorMode(SEM_FAILCRITICALERRORS); + try + if GetFileAttributesEx(PChar(FileName), GetFileExInfoStandard, @FileAttributesEx) then + begin + Size.LowPart := FileAttributesEx.nFileSizeLow; + Size.HighPart := FileAttributesEx.nFileSizeHigh; + Result := Size.QuadPart; + end; + finally + SetErrorMode(OldMode); + end; +end; +{$ENDIF MSWINDOWS} +{$IFDEF UNIX} +var + Buf: TStatBuf64; +begin + Result := -1; + if GetFileStatus(FileName, Buf, False) = 0 then + Result := Buf.st_size; +end; +{$ENDIF UNIX} + +{$IFDEF MSWINDOWS} +{$IFDEF FPC} +{ TODO : Move this over to JclWin32 when JclWin32 gets overhauled. } +function GetTempFileName(lpPathName, lpPrefixString: PChar; + uUnique: UINT; lpTempFileName: PChar): UINT; stdcall; +external kernel32 name 'GetTempFileNameA'; +{$ENDIF FPC} +{$ENDIF MSWINDOWS} + +function FileGetTempName(const Prefix: string): string; +{$IFDEF MSWINDOWS} +var + TempPath, TempFile: string; + R: Cardinal; +begin + Result := ''; + TempPath := PathGetTempPath; + if TempPath <> '' then + begin + SetLength(TempFile, MAX_PATH); + R := GetTempFileName(PChar(TempPath), PChar(Prefix), 0, PChar(TempFile)); + if R <> 0 then + begin + StrResetLength(TempFile); + Result := TempFile; + end; + end; +end; +{$ENDIF MSWINDOWS} +{$IFDEF UNIX} +// Warning: Between the time the pathname is constructed and the file is created +// another process might have created a file with the same name using tmpnam, +// leading to a possible security hole. The implementation generates names which +// can hardly be predicted, but when opening the file you should use the O_EXCL +// flag. Using tmpfile or mkstemp is a safe way to avoid this problem. +var + P: PChar; +begin + P := tempnam(PChar(PathGetTempPath), PChar(Prefix)); + Result := P; + Libc.free(P); +end; +{$ENDIF UNIX} + +{$IFDEF MSWINDOWS} +function FileGetTypeName(const FileName: string): string; +var + FileInfo: TSHFileInfo; + RetVal: DWORD; +begin + ResetMemory(FileInfo, SizeOf(FileInfo)); + RetVal := SHGetFileInfo(PChar(FileName), 0, FileInfo, SizeOf(FileInfo), + SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES); + if RetVal <> 0 then + Result := FileInfo.szTypeName; + if (RetVal = 0) or (Trim(Result) = '') then + begin + // Lookup failed so mimic explorer behaviour by returning "XYZ File" + Result := ExtractFileExt(FileName); + Delete(Result, 1, 1); + Result := TrimLeft(UpperCase(Result) + LoadResString(@RsDefaultFileTypeName)); + end; +end; +{$ENDIF MSWINDOWS} + +function FindUnusedFileName(FileName: string; const FileExt: string; NumberPrefix: string = ''): string; +var + I: Integer; +begin + Result := PathAddExtension(FileName, FileExt); + if not FileExists(Result) then + Exit; + if SameText(Result, FileName) then + Delete(FileName, Length(FileName) - Length(FileExt) + 1, Length(FileExt)); + I := 0; + repeat + Inc(I); + Result := PathAddExtension(FileName + NumberPrefix + IntToStr(I), FileExt); + until not FileExists(Result); +end; + +// This routine is copied from FileCtrl.pas to avoid dependency on that unit. +// See the remark at the top of this section + +function ForceDirectories(Name: string): Boolean; +var + ExtractPath: string; +begin + Result := True; + if Length(Name) = 0 then + raise EJclFileUtilsError.CreateRes(@RsCannotCreateDir); + Name := PathRemoveSeparator(Name); + {$IFDEF MSWINDOWS} + ExtractPath := ExtractFilePath(Name); + if ((Length(Name) = 2) and (Copy(Name, 2,1) = ':')) or DirectoryExists(Name) or (ExtractPath = Name) then + Exit; + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + if (Length(Name) = 0) or DirectoryExists(Name) then + Exit; + ExtractPath := ExtractFilePath(Name); + {$ENDIF UNIX} + Result := (ExtractPath = '') or ForceDirectories(ExtractPath); + if Result then + begin + {$IFDEF MSWINDOWS} + SetLastError(ERROR_SUCCESS); + {$ENDIF MSWINDOWS} + Result := Result and CreateDir(Name); + {$IFDEF MSWINDOWS} + Result := Result or (GetLastError = ERROR_ALREADY_EXISTS); + {$ENDIF MSWINDOWS} + end; +end; + +function GetDirectorySize(const Path: string): Int64; + + function RecurseFolder(const Path: string): Int64; + var + F: TSearchRec; + R: Integer; + {$IFDEF MSWINDOWS} + TempSize: TJclULargeInteger; + {$ENDIF MSWINDOWS} + begin + Result := 0; + R := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindFirst(Path + '*.*', faAnyFile, F); + if R = 0 then + try + while R = 0 do + begin + if (F.Name <> '.') and (F.Name <> '..') then + begin + if (F.Attr and faDirectory) = faDirectory then + Inc(Result, RecurseFolder(Path + F.Name + DirDelimiter)) + else + {$IFDEF MSWINDOWS} + begin + TempSize.LowPart := F.FindData.nFileSizeLow; + TempSize.HighPart := F.FindData.nFileSizeHigh; + Inc(Result, TempSize.QuadPart); + end; + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + // SysUtils.Find* don't perceive files >= 2 GB anyway + Inc(Result, Int64(F.Size)); + {$ENDIF UNIX} + end; + R := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindNext(F); + end; + if R <> ERROR_NO_MORE_FILES then + Abort; + finally + {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindClose(F); + end; + end; + +begin + if not DirectoryExists(PathRemoveSeparator(Path)) then + Result := -1 + else + try + Result := RecurseFolder(PathAddSeparator(Path)) + except + Result := -1; + end; +end; + +{$IFDEF MSWINDOWS} + +function GetDriveTypeStr(const Drive: Char): string; +var + DriveType: Integer; + DriveStr: string; +begin + if not CharIsDriveLetter(Drive) then + raise EJclPathError.CreateResFmt(@RsPathInvalidDrive, [Drive]); + DriveStr := Drive + ':\'; + DriveType := GetDriveType(PChar(DriveStr)); + case DriveType of + DRIVE_REMOVABLE: + Result := LoadResString(@RsRemovableDrive); + DRIVE_FIXED: + Result := LoadResString(@RsHardDisk); + DRIVE_REMOTE: + Result := LoadResString(@RsRemoteDrive); + DRIVE_CDROM: + Result := LoadResString(@RsCDRomDrive); + DRIVE_RAMDISK: + Result := LoadResString(@RsRamDisk); + else + Result := LoadResString(@RsUnknownDrive); + end; +end; + +function GetFileAgeCoherence(const FileName: string): Boolean; +var + FileAttributesEx: WIN32_FILE_ATTRIBUTE_DATA; +begin + Result := False; + if GetFileAttributesEx(PChar(FileName), GetFileExInfoStandard, @FileAttributesEx) then + {$IFDEF FPC} + Result := CompareFileTime(@FileAttributesEx.ftCreationTime, @FileAttributesEx.ftLastWriteTime) <= 0; + {$ELSE ~FPC} + Result := CompareFileTime(FileAttributesEx.ftCreationTime, FileAttributesEx.ftLastWriteTime) <= 0; + {$ENDIF ~FPC} +end; + +{$ENDIF MSWINDOWS} + +procedure GetFileAttributeList(const Items: TStrings; const Attr: Integer); +begin + { TODO : clear list? } + Assert(Assigned(Items)); + if not Assigned(Items) then + Exit; + Items.BeginUpdate; + try + { TODO : differentiate Windows/UNIX idents } + if Attr and faDirectory = faDirectory then + Items.Add(LoadResString(@RsAttrDirectory)); + if Attr and faReadOnly = faReadOnly then + Items.Add(LoadResString(@RsAttrReadOnly)); + if Attr and faSysFile = faSysFile then + Items.Add(LoadResString(@RsAttrSystemFile)); + if Attr and faArchive = faArchive then + Items.Add(LoadResString(@RsAttrArchive)); + if Attr and faAnyFile = faAnyFile then + Items.Add(LoadResString(@RsAttrAnyFile)); + if Attr and faHidden = faHidden then + Items.Add(LoadResString(@RsAttrHidden)); + finally + Items.EndUpdate; + end; +end; + +{$IFDEF MSWINDOWS} + +{ TODO : GetFileAttributeListEx - Unix version } +procedure GetFileAttributeListEx(const Items: TStrings; const Attr: Integer); +begin + { TODO : clear list? } + Assert(Assigned(Items)); + if not Assigned(Items) then + Exit; + Items.BeginUpdate; + try + if Attr and FILE_ATTRIBUTE_READONLY = FILE_ATTRIBUTE_READONLY then + Items.Add(LoadResString(@RsAttrReadOnly)); + if Attr and FILE_ATTRIBUTE_HIDDEN = FILE_ATTRIBUTE_HIDDEN then + Items.Add(LoadResString(@RsAttrHidden)); + if Attr and FILE_ATTRIBUTE_SYSTEM = FILE_ATTRIBUTE_SYSTEM then + Items.Add(LoadResString(@RsAttrSystemFile)); + if Attr and FILE_ATTRIBUTE_DIRECTORY = FILE_ATTRIBUTE_DIRECTORY then + Items.Add(LoadResString(@RsAttrDirectory)); + if Attr and FILE_ATTRIBUTE_ARCHIVE = FILE_ATTRIBUTE_ARCHIVE then + Items.Add(LoadResString(@RsAttrArchive)); + if Attr and FILE_ATTRIBUTE_NORMAL = FILE_ATTRIBUTE_NORMAL then + Items.Add(LoadResString(@RsAttrNormal)); + if Attr and FILE_ATTRIBUTE_TEMPORARY = FILE_ATTRIBUTE_TEMPORARY then + Items.Add(LoadResString(@RsAttrTemporary)); + if Attr and FILE_ATTRIBUTE_COMPRESSED = FILE_ATTRIBUTE_COMPRESSED then + Items.Add(LoadResString(@RsAttrCompressed)); + if Attr and FILE_ATTRIBUTE_OFFLINE = FILE_ATTRIBUTE_OFFLINE then + Items.Add(LoadResString(@RsAttrOffline)); + if Attr and FILE_ATTRIBUTE_ENCRYPTED = FILE_ATTRIBUTE_ENCRYPTED then + Items.Add(LoadResString(@RsAttrEncrypted)); + if Attr and FILE_ATTRIBUTE_REPARSE_POINT = FILE_ATTRIBUTE_REPARSE_POINT then + Items.Add(LoadResString(@RsAttrReparsePoint)); + if Attr and FILE_ATTRIBUTE_SPARSE_FILE = FILE_ATTRIBUTE_SPARSE_FILE then + Items.Add(LoadResString(@RsAttrSparseFile)); + finally + Items.EndUpdate; + end; +end; + +{$ENDIF MSWINDOWS} + +function GetFileInformation(const FileName: string; out FileInfo: TSearchRec): Boolean; +begin + Result := FindFirst(FileName, faAnyFile, FileInfo) = 0; + if Result then + {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindClose(FileInfo); +end; + +function GetFileInformation(const FileName: string): TSearchRec; +begin + if not GetFileInformation(FileName, Result) then + RaiseLastOSError; +end; + +{$IFDEF UNIX} + +{ TODO -cHelp : Author: Robert Rossmair } + +function GetFileStatus(const FileName: string; out StatBuf: TStatBuf64; + const ResolveSymLinks: Boolean): Integer; +begin + if ResolveSymLinks then + Result := stat64(PChar(FileName), StatBuf) + else + Result := lstat64(PChar(FileName), StatBuf); +end; + +{$ENDIF UNIX} + +{$IFDEF MSWINDOWS} + +function GetFileLastWrite(const FileName: string): TFileTime; +begin + Result := GetFileInformation(FileName).FindData.ftLastWriteTime; +end; + +function GetFileLastWrite(const FileName: string; out LocalTime: TDateTime): Boolean; +var + FileInfo: TSearchRec; +begin + Result := GetFileInformation(FileName, FileInfo); + if Result then + LocalTime := FileTimeToLocalDateTime(FileInfo.FindData.ftLastWriteTime); +end; + +{$ENDIF MSWINDOWS} + +{$IFDEF UNIX} + +function GetFileLastWrite(const FileName: string; out TimeStamp: Integer; ResolveSymLinks: Boolean): Boolean; +var + Buf: TStatBuf64; +begin + Result := GetFileStatus(FileName, Buf, ResolveSymLinks) = 0; + if Result then + TimeStamp := Buf.st_mtime +end; + +function GetFileLastWrite(const FileName: string; out LocalTime: TDateTime; ResolveSymLinks: Boolean): Boolean; +var + Buf: TStatBuf64; +begin + Result := GetFileStatus(FileName, Buf, ResolveSymLinks) = 0; + if Result then + LocalTime := FileDateToDateTime(Buf.st_mtime); +end; + +function GetFileLastWrite(const FileName: string; ResolveSymLinks: Boolean): Integer; +var + Buf: TStatBuf64; +begin + if GetFileStatus(FileName, Buf, ResolveSymLinks) = 0 then + Result := Buf.st_mtime + else + Result := -1; +end; + +{$ENDIF UNIX} + +{$IFDEF MSWINDOWS} + +function GetFileLastAccess(const FileName: string): TFileTime; +begin + Result := GetFileInformation(FileName).FindData.ftLastAccessTime; +end; + +function GetFileLastAccess(const FileName: string; out LocalTime: TDateTime): Boolean; +var + FileInfo: TSearchRec; +begin + Result := GetFileInformation(FileName, FileInfo); + if Result then + LocalTime := FileTimeToLocalDateTime(GetFileInformation(FileName).FindData.ftLastAccessTime); +end; + +{$ENDIF MSWINDOWS} + +{$IFDEF UNIX} + +function GetFileLastAccess(const FileName: string; out TimeStamp: Integer; ResolveSymLinks: Boolean): Boolean; +var + Buf: TStatBuf64; +begin + Result := GetFileStatus(FileName, Buf, ResolveSymLinks) = 0; + if Result then + TimeStamp := Buf.st_atime +end; + +function GetFileLastAccess(const FileName: string; out LocalTime: TDateTime; ResolveSymLinks: Boolean): Boolean; +var + Buf: TStatBuf64; +begin + Result := GetFileStatus(FileName, Buf, ResolveSymLinks) = 0; + if Result then + LocalTime := FileDateToDateTime(Buf.st_atime); +end; + +function GetFileLastAccess(const FileName: string; ResolveSymLinks: Boolean): Integer; +var + Buf: TStatBuf64; +begin + if GetFileStatus(FileName, Buf, ResolveSymLinks) = 0 then + Result := Buf.st_atime + else + Result := -1; +end; + +{$ENDIF UNIX} + +{$IFDEF MSWINDOWS} + +function GetFileCreation(const FileName: string): TFileTime; +begin + Result := GetFileInformation(FileName).FindData.ftCreationTime; +end; + +function GetFileCreation(const FileName: string; out LocalTime: TDateTime): Boolean; +var + FileInfo: TSearchRec; +begin + Result := GetFileInformation(FileName, FileInfo); + if Result then + LocalTime := FileTimeToLocalDateTime(GetFileInformation(FileName).FindData.ftCreationTime); +end; + +{$ENDIF MSWINDOWS} + +{$IFDEF UNIX} + +function GetFileLastAttrChange(const FileName: string; out TimeStamp: Integer; ResolveSymLinks: Boolean): Boolean; +var + Buf: TStatBuf64; +begin + Result := GetFileStatus(FileName, Buf, ResolveSymLinks) = 0; + if Result then + TimeStamp := Buf.st_ctime +end; + +function GetFileLastAttrChange(const FileName: string; out LocalTime: TDateTime; ResolveSymLinks: Boolean): Boolean; +var + Buf: TStatBuf64; +begin + Result := GetFileStatus(FileName, Buf, ResolveSymLinks) = 0; + if Result then + LocalTime := FileDateToDateTime(Buf.st_ctime); +end; + +function GetFileLastAttrChange(const FileName: string; ResolveSymLinks: Boolean): Integer; +var + Buf: TStatBuf64; +begin + if GetFileStatus(FileName, Buf, ResolveSymLinks) = 0 then + Result := Buf.st_ctime + else + Result := -1; +end; + +{$ENDIF UNIX} + +function GetModulePath(const Module: HMODULE): string; +var + L: Integer; +begin + L := MAX_PATH + 1; + SetLength(Result, L); + {$IFDEF MSWINDOWS} + L := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetModuleFileName(Module, Pointer(Result), L); + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + {$IFDEF FPC} + L := 0; // FIXME + {$ELSE ~FPC} + L := GetModuleFileName(Module, Pointer(Result), L); + {$ENDIF ~FPC} + {$ENDIF UNIX} + SetLength(Result, L); +end; + +function GetSizeOfFile(const FileName: string): Int64; +{$IFDEF MSWINDOWS} +var + FileAttributesEx: WIN32_FILE_ATTRIBUTE_DATA; + Size: TJclULargeInteger; +begin + {$IFNDEF COMPILER37_UP} + Result := 0; + {$ENDIF ~COMPILER37_UP} + if GetFileAttributesEx(PChar(FileName), GetFileExInfoStandard, @FileAttributesEx) then + begin + Size.LowPart := FileAttributesEx.nFileSizeLow; + Size.HighPart := FileAttributesEx.nFileSizeHigh; + Result := Size.QuadPart; + end + else + RaiseLastOSError; +end; +{$ENDIF MSWINDOWS} +{$IFDEF UNIX} +var + Buf: TStatBuf64; +begin + if GetFileStatus(FileName, Buf, False) <> 0 then + RaiseLastOSError; + Result := Buf.st_size; +end; +{$ENDIF UNIX} + +{$IFDEF MSWINDOWS} +function GetSizeOfFile(Handle: THandle): Int64; overload; +var + Size: TJclULargeInteger; +begin + Size.LowPart := GetFileSize(Handle, @Size.HighPart); + Result := Size.QuadPart; +end; +{$ENDIF MSWINDOWS} + +function GetSizeOfFile(const FileInfo: TSearchRec): Int64; +{$IFDEF MSWINDOWS} +begin + Int64Rec(Result).Lo := FileInfo.FindData.nFileSizeLow; + Int64Rec(Result).Hi := FileInfo.FindData.nFileSizeHigh; +end; +{$ENDIF MSWINDOWS} +{$IFDEF UNIX} +var + Buf: TStatBuf64; +begin + // rr: Note that SysUtils.FindFirst/Next ignore files >= 2 GB under Linux, + // thus the following code is rather pointless at the moment of this writing. + // We apparently need to write our own set of Findxxx functions to overcome this limitation. + if GetFileStatus(FileInfo.PathOnly + FileInfo.Name, Buf, True) <> 0 then + Result := -1 + else + Result := Buf.st_size +end; +{$ENDIF UNIX} + +{$IFDEF MSWINDOWS} + +{$IFDEF FPC} +{ TODO : Move this over to JclWin32 when JclWin32 gets overhauled. } +function GetFileAttributesEx(lpFileName: PChar; + fInfoLevelId: TGetFileExInfoLevels; lpFileInformation: Pointer): BOOL; stdcall; +external kernel32 name 'GetFileAttributesExA'; +{$ENDIF FPC} + +function GetStandardFileInfo(const FileName: string): TWin32FileAttributeData; +var + Handle: THandle; + FileInfo: TByHandleFileInformation; +begin + Assert(FileName <> ''); + { TODO : Use RTDL-Version of GetFileAttributesEx } + if IsWin95 or IsWin95OSR2 or IsWinNT3 then + begin + Handle := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0); + if Handle <> INVALID_HANDLE_VALUE then + try + FileInfo.dwFileAttributes := 0; + if not GetFileInformationByHandle(Handle, FileInfo) then + raise EJclFileUtilsError.CreateResFmt(@RsFileUtilsAttrUnavailable, [FileName]); + Result.dwFileAttributes := FileInfo.dwFileAttributes; + Result.ftCreationTime := FileInfo.ftCreationTime; + Result.ftLastAccessTime := FileInfo.ftLastAccessTime; + Result.ftLastWriteTime := FileInfo.ftLastWriteTime; + Result.nFileSizeHigh := FileInfo.nFileSizeHigh; + Result.nFileSizeLow := FileInfo.nFileSizeLow; + finally + CloseHandle(Handle); + end + else + raise EJclFileUtilsError.CreateResFmt(@RsFileUtilsAttrUnavailable, [FileName]); + end + else + begin + if not GetFileAttributesEx(PChar(FileName), GetFileExInfoStandard, @Result) then + raise EJclFileUtilsError.CreateResFmt(@RsFileUtilsAttrUnavailable, [FileName]); + end; +end; + +{$ENDIF MSWINDOWS} + +{$IFDEF MSWINDOWS} +function IsDirectory(const FileName: string): Boolean; +var + R: DWORD; +begin + R := GetFileAttributes(PChar(FileName)); + Result := (R <> DWORD(-1)) and ((R and FILE_ATTRIBUTE_DIRECTORY) <> 0); +end; +{$ENDIF MSWINDOWS} +{$IFDEF UNIX} +function IsDirectory(const FileName: string; ResolveSymLinks: Boolean): Boolean; +var + Buf: TStatBuf64; +begin + Result := False; + if GetFileStatus(FileName, Buf, ResolveSymLinks) = 0 then + Result := S_ISDIR(Buf.st_mode); +end; +{$ENDIF UNIX} + +function IsRootDirectory(const CanonicFileName: string): Boolean; +{$IFDEF MSWINDOWS} +var + I: Integer; +begin + I := Pos(':\', CanonicFileName); + Result := (I > 0) and (I + 1 = Length(CanonicFileName)); +end; +{$ENDIF MSWINDOWS} +{$IFDEF UNIX} +begin + Result := CanonicFileName = DirDelimiter; +end; +{$ENDIF UNIX} + +{$IFDEF MSWINDOWS} + +function LockVolume(const Volume: string; var Handle: THandle): Boolean; +var + BytesReturned: DWORD; +begin + Result := False; + Handle := CreateFile(PChar('\\.\' + Volume), GENERIC_READ or GENERIC_WRITE, + FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, + FILE_FLAG_NO_BUFFERING, 0); + if Handle <> INVALID_HANDLE_VALUE then + begin + BytesReturned := 0; + Result := DeviceIoControl(Handle, FSCTL_LOCK_VOLUME, nil, 0, nil, 0, + BytesReturned, nil); + if not Result then + begin + CloseHandle(Handle); + Handle := INVALID_HANDLE_VALUE; + end; + end; +end; + +function OpenVolume(const Drive: Char): THandle; +var + VolumeName: array [0..6] of Char; +begin + VolumeName := '\\.\A:'; + VolumeName[4] := Drive; + Result := CreateFile(VolumeName, GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, + nil, OPEN_EXISTING, 0, 0); +end; + +{$ENDIF MSWINDOWS} + +type + // indicates the file time to set, used by SetFileTimesHelper and SetDirTimesHelper + TFileTimes = (ftLastAccess, ftLastWrite {$IFDEF MSWINDOWS}, ftCreation {$ENDIF}); + +{$IFDEF MSWINDOWS} +function SetFileTimesHelper(const FileName: string; const DateTime: TDateTime; Times: TFileTimes): Boolean; +var + Handle: THandle; + FileTime: TFileTime; + SystemTime: TSystemTime; +begin + Result := False; + Handle := CreateFile(PChar(FileName), GENERIC_WRITE, FILE_SHARE_READ, nil, + OPEN_EXISTING, 0, 0); + if Handle <> INVALID_HANDLE_VALUE then + try + //SysUtils.DateTimeToSystemTime(DateTimeToLocalDateTime(DateTime), SystemTime); + {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.DateTimeToSystemTime(DateTime, SystemTime); + FileTime.dwLowDateTime := 0; + FileTime.dwHighDateTime := 0; + if {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.SystemTimeToFileTime(SystemTime, FileTime) then + begin + case Times of + ftLastAccess: + Result := SetFileTime(Handle, nil, @FileTime, nil); + ftLastWrite: + Result := SetFileTime(Handle, nil, nil, @FileTime); + ftCreation: + Result := SetFileTime(Handle, @FileTime, nil, nil); + end; + end; + finally + CloseHandle(Handle); + end; +end; +{$ENDIF MSWINDOWS} + +{$IFDEF UNIX} +function SetFileTimesHelper(const FileName: string; const DateTime: TDateTime; Times: TFileTimes): Boolean; +var + FileTime: Integer; + StatBuf: TStatBuf64; + TimeBuf: utimbuf; +begin + Result := False; + FileTime := DateTimeToFileDate(DateTime); + if GetFileStatus(FileName, StatBuf, False) = 0 then + begin + TimeBuf.actime := StatBuf.st_atime; + TimeBuf.modtime := StatBuf.st_mtime; + case Times of + ftLastAccess: + TimeBuf.actime := FileTime; + ftLastWrite: + TimeBuf.modtime := FileTime; + end; + Result := utime(PChar(FileName), @TimeBuf) = 0; + end; +end; +{$ENDIF UNIX} + +function SetFileLastAccess(const FileName: string; const DateTime: TDateTime): Boolean; +begin + Result := SetFileTimesHelper(FileName, DateTime, ftLastAccess); +end; + +function SetFileLastWrite(const FileName: string; const DateTime: TDateTime): Boolean; +begin + Result := SetFileTimesHelper(FileName, DateTime, ftLastWrite); +end; + +{$IFDEF MSWINDOWS} + +function SetFileCreation(const FileName: string; const DateTime: TDateTime): Boolean; +begin + Result := SetFileTimesHelper(FileName, DateTime, ftCreation); +end; + +// utility function for SetDirTimesHelper + +function BackupPrivilegesEnabled: Boolean; +begin + Result := IsPrivilegeEnabled(SE_BACKUP_NAME) and IsPrivilegeEnabled(SE_RESTORE_NAME); +end; + +function SetDirTimesHelper(const DirName: string; const DateTime: TDateTime; + Times: TFileTimes; RequireBackupRestorePrivileges: Boolean): Boolean; +var + Handle: THandle; + FileTime: TFileTime; + SystemTime: TSystemTime; +begin + Result := False; + if IsDirectory(DirName) and (not RequireBackupRestorePrivileges or BackupPrivilegesEnabled) then + begin + Handle := CreateFile(PChar(DirName), GENERIC_WRITE, FILE_SHARE_READ, nil, + OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0); + if Handle <> INVALID_HANDLE_VALUE then + try + {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.DateTimeToSystemTime(DateTime, SystemTime); + FileTime.dwLowDateTime := 0; + FileTime.dwHighDateTime := 0; + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.SystemTimeToFileTime(SystemTime, FileTime); + case Times of + ftLastAccess: + Result := SetFileTime(Handle, nil, @FileTime, nil); + ftLastWrite: + Result := SetFileTime(Handle, nil, nil, @FileTime); + ftCreation: + Result := SetFileTime(Handle, @FileTime, nil, nil); + end; + finally + CloseHandle(Handle); + end; + end; +end; + +function SetDirLastWrite(const DirName: string; const DateTime: TDateTime; RequireBackupRestorePrivileges: Boolean = True): Boolean; +begin + Result := SetDirTimesHelper(DirName, DateTime, ftLastWrite, RequireBackupRestorePrivileges); +end; + +function SetDirLastAccess(const DirName: string; const DateTime: TDateTime; RequireBackupRestorePrivileges: Boolean = True): Boolean; +begin + Result := SetDirTimesHelper(DirName, DateTime, ftLastAccess, RequireBackupRestorePrivileges); +end; + +function SetDirCreation(const DirName: string; const DateTime: TDateTime; RequireBackupRestorePrivileges: Boolean = True): Boolean; +begin + Result := SetDirTimesHelper(DirName, DateTime, ftCreation, RequireBackupRestorePrivileges); +end; + +procedure FillByteArray(var Bytes: array of Byte; Count: Cardinal; B: Byte); +begin + FillMemory(@Bytes[0], Count, B); +end; + +procedure ShredFile(const FileName: string; Times: Integer); +const + BUFSIZE = 4096; + ODD_FILL = $C1; + EVEN_FILL = $3E; +var + Fs: TFileStream; + Size: Integer; + N: Integer; + ContentPtr: array of Byte; +begin + Size := FileGetSize(FileName); + if Size > 0 then + begin + if Times < 0 then + Times := 2 + else + Times := Times * 2; + ContentPtr := nil; + Fs := TFileStream.Create(FileName, fmOpenReadWrite); + try + SetLength(ContentPtr, BUFSIZE); + while Times > 0 do + begin + if Times mod 2 = 0 then + FillByteArray(ContentPtr, BUFSIZE, EVEN_FILL) + else + FillByteArray(ContentPtr, BUFSIZE, ODD_FILL); + Fs.Seek(0, soBeginning); + N := Size div BUFSIZE; + while N > 0 do + begin + Fs.Write(ContentPtr[0], BUFSIZE); + Dec(N); + end; + N := Size mod BUFSIZE; + if N > 0 then + Fs.Write(ContentPtr[0], N); + FlushFileBuffers(Fs.Handle); + Dec(Times); + end; + finally + ContentPtr := nil; + Fs.Free; + DeleteFile(FileName); + end; + end + else + DeleteFile(FileName); +end; + +function UnlockVolume(var Handle: THandle): Boolean; +var + BytesReturned: DWORD; +begin + Result := False; + if Handle <> INVALID_HANDLE_VALUE then + begin + BytesReturned := 0; + Result := DeviceIoControl(Handle, FSCTL_UNLOCK_VOLUME, nil, 0, nil, 0, + BytesReturned, nil); + if Result then + begin + CloseHandle(Handle); + Handle := INVALID_HANDLE_VALUE; + end; + end; +end; + +{$ENDIF MSWINDOWS} + +{$IFDEF UNIX} + +function CreateSymbolicLink(const Name, Target: string): Boolean; +begin + Result := symlink(PChar(Target), PChar(Name)) = 0; +end; + +function SymbolicLinkTarget(const Name: string): string; +var + N, BufLen: Integer; +begin + BufLen := 128; + repeat + Inc(BufLen, BufLen); + SetLength(Result, BufLen); + N := readlink(PChar(Name), PChar(Result), BufLen); + if N < 0 then // Error + begin + Result := ''; + Exit; + end; + until N < BufLen; + SetLength(Result, N); +end; + +{$ENDIF UNIX} + +//=== File Version info routines ============================================= + +{$IFDEF MSWINDOWS} + +const + VerKeyNames: array [1..12] of string = + ('Comments', + 'CompanyName', + 'FileDescription', + 'FileVersion', + 'InternalName', + 'LegalCopyright', + 'LegalTradeMarks', + 'OriginalFilename', + 'ProductName', + 'ProductVersion', + 'SpecialBuild', + 'PrivateBuild'); + +function OSIdentToString(const OSIdent: DWORD): string; +begin + case OSIdent of + VOS_UNKNOWN: + Result := LoadResString(@RsVosUnknown); + VOS_DOS: + Result := LoadResString(@RsVosDos); + VOS_OS216: + Result := LoadResString(@RsVosOS216); + VOS_OS232: + Result := LoadResString(@RsVosOS232); + VOS_NT: + Result := LoadResString(@RsVosNT); + VOS__WINDOWS16: + Result := LoadResString(@RsVosWindows16); + VOS__PM16: + Result := LoadResString(@RsVosPM16); + VOS__PM32: + Result := LoadResString(@RsVosPM32); + VOS__WINDOWS32: + Result := LoadResString(@RsVosWindows32); + VOS_DOS_WINDOWS16: + Result := LoadResString(@RsVosDosWindows16); + VOS_DOS_WINDOWS32: + Result := LoadResString(@RsVosDosWindows32); + VOS_OS216_PM16: + Result := LoadResString(@RsVosOS216PM16); + VOS_OS232_PM32: + Result := LoadResString(@RsVosOS232PM32); + VOS_NT_WINDOWS32: + Result := LoadResString(@RsVosNTWindows32); + else + Result := ''; + end; + if Result = '' then + Result := LoadResString(@RsVosUnknown) + else + Result := Format(LoadResString(@RsVosDesignedFor), [Result]); +end; + +function OSFileTypeToString(const OSFileType: DWORD; const OSFileSubType: DWORD): string; +begin + case OSFileType of + VFT_UNKNOWN: + Result := LoadResString(@RsVftUnknown); + VFT_APP: + Result := LoadResString(@RsVftApp); + VFT_DLL: + Result := LoadResString(@RsVftDll); + VFT_DRV: + begin + case OSFileSubType of + VFT2_DRV_PRINTER: + Result := LoadResString(@RsVft2DrvPRINTER); + VFT2_DRV_KEYBOARD: + Result := LoadResString(@RsVft2DrvKEYBOARD); + VFT2_DRV_LANGUAGE: + Result := LoadResString(@RsVft2DrvLANGUAGE); + VFT2_DRV_DISPLAY: + Result := LoadResString(@RsVft2DrvDISPLAY); + VFT2_DRV_MOUSE: + Result := LoadResString(@RsVft2DrvMOUSE); + VFT2_DRV_NETWORK: + Result := LoadResString(@RsVft2DrvNETWORK); + VFT2_DRV_SYSTEM: + Result := LoadResString(@RsVft2DrvSYSTEM); + VFT2_DRV_INSTALLABLE: + Result := LoadResString(@RsVft2DrvINSTALLABLE); + VFT2_DRV_SOUND: + Result := LoadResString(@RsVft2DrvSOUND); + VFT2_DRV_COMM: + Result := LoadResString(@RsVft2DrvCOMM); + else + Result := ''; + end; + Result := Result + ' ' + LoadResString(@RsVftDrv); + end; + VFT_FONT: + begin + case OSFileSubType of + VFT2_FONT_RASTER: + Result := LoadResString(@RsVft2FontRASTER); + VFT2_FONT_VECTOR: + Result := LoadResString(@RsVft2FontVECTOR); + VFT2_FONT_TRUETYPE: + Result := LoadResString(@RsVft2FontTRUETYPE); + else + Result := ''; + end; + Result := Result + ' ' + LoadResString(@RsVftFont); + end; + VFT_VXD: + Result := LoadResString(@RsVftVxd); + VFT_STATIC_LIB: + Result := LoadResString(@RsVftStaticLib); + else + Result := ''; + end; + Result := TrimLeft(Result); +end; + +function VersionResourceAvailable(const FileName: string): Boolean; +var + Size: DWORD; + Handle: DWORD; + Buffer: string; +begin + Result := False; + Handle := 0; + Size := GetFileVersionInfoSize(PChar(FileName), Handle); + if Size > 0 then + begin + SetLength(Buffer, Size); + Result := GetFileVersionInfo(PChar(FileName), Handle, Size, PChar(Buffer)); + end; +end; + +function VersionResourceAvailable(const Window: HWND): Boolean; +begin + Result := VersionResourceAvailable(WindowToModuleFileName(Window)); +end; + +function VersionResourceAvailable(const Module: HMODULE): Boolean; +begin + if Module <> 0 then + Result :=VersionResourceAvailable(GetModulePath(Module)) + else + raise EJclError.CreateResFmt(@RsEModuleNotValid, [Module]); +end; + +function WindowToModuleFileName(const Window: HWND): string; +type + {$IFDEF SUPPORTS_UNICODE} + TGetModuleFileNameEx = function(hProcess: THandle; hModule: HMODULE; FileName: PWideChar; nSize: DWORD): DWORD; stdcall; + TQueryFullProcessImageName = function(HProcess: THandle; dwFlags: DWORD; lpExeName: PWideChar; lpdwSize: PDWORD): BOOL; stdcall; + {$ELSE ~SUPPORTS_UNICODE} + TGetModuleFileNameEx = function(hProcess: THandle; hModule: HMODULE; FileName: PAnsiChar; nSize: DWORD): DWORD; stdcall; + TQueryFullProcessImageName = function(HProcess: THandle; dwFlags: DWORD; lpExeName: PAnsiChar; lpdwSize: PDWORD): BOOL; stdcall; + {$ENDIF ~SUPPORTS_UNICODE} +var + FileName: array[0..300] of Char; + DllHinst: HMODULE; + ProcessID: DWORD; + HProcess: THandle; + GetModuleFileNameExAddress: TGetModuleFileNameEx; + QueryFullProcessImageNameAddress: TQueryFullProcessImageName; + Len: DWORD; +begin + Result := ''; + if Window <> 0 then + begin + if not JclCheckWinVersion(5, 0) then // Win2k or newer required + raise EJclWin32Error.CreateRes(@RsEWindowsVersionNotSupported); + + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetWindowThreadProcessId(Window, @ProcessID); + hProcess := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, false, ProcessID); + if hProcess <> 0 then + begin + try + if JclCheckWinVersion(6, 0) then // WinVista or newer + begin + DllHinst := LoadLibrary('Kernel32.dll'); + if DllHinst <> 0 then + begin + try + {$IFDEF SUPPORTS_UNICODE} + QueryFullProcessImageNameAddress := GetProcAddress(DllHinst, 'QueryFullProcessImageNameW'); + {$ELSE ~SUPPORTS_UNICODE} + QueryFullProcessImageNameAddress := GetProcAddress(DllHinst, 'QueryFullProcessImageNameA'); + {$ENDIF ~SUPPORTS_UNICODE} + if Assigned(QueryFullProcessImageNameAddress) then + begin + Len := Length(FileName); + if QueryFullProcessImageNameAddress(hProcess, 0, FileName, PDWORD(@Len)) then + Result := FileName; + //else + // RaiseLastOSError would be nice, but it didn't raise an exception before the return value was checked + end + else + raise EJclError.CreateResFmt(@RsEFunctionNotFound, ['Kernel32.dll', 'QueryFullProcessImageName']); + finally + FreeLibrary(DllHinst); + end; + end + else + raise EJclError.CreateResFmt(@RsELibraryNotFound, ['Kernel32.dll']); + end + else + begin + DllHinst := LoadLibrary('Psapi.dll'); + if DllHinst <> 0 then + begin + try + {$IFDEF SUPPORTS_UNICODE} + GetModuleFileNameExAddress := GetProcAddress(DllHinst, 'GetModuleFileNameExW'); + {$ELSE ~SUPPORTS_UNICODE} + GetModuleFileNameExAddress := GetProcAddress(DllHinst, 'GetModuleFileNameExA'); + {$ENDIF ~SUPPORTS_UNICODE} + if Assigned(GetModuleFileNameExAddress) then + begin + Len := GetModuleFileNameExAddress(hProcess, 0, FileName, Length(FileName)); + if Len > 0 then + Result := FileName; + //else + // RaiseLastOSError; would be nice, but it didn't raise an exception before the return value was checked + end + else + raise EJclError.CreateResFmt(@RsEFunctionNotFound, ['Psapi.dll', 'GetModuleFileNameEx']); + finally + FreeLibrary(DllHinst); + end; + end + else + raise EJclError.CreateResFmt(@RsELibraryNotFound, ['Psapi.dll']); + end; + finally + CloseHandle(hProcess); + end; + end + else + raise EJclError.CreateResFmt(@RsEProcessNotValid, [ProcessID]); + end + else + raise EJclError.CreateResFmt(@RsEWindowNotValid, [Window]); +end; + +{$ENDIF MSWINDOWS} + +// Version Info formatting +function FormatVersionString(const HiV, LoV: Word): string; +begin + Result := Format('%u.%.2u', [HiV, LoV]); +end; + +function FormatVersionString(const Major, Minor, Build, Revision: Word): string; +begin + Result := Format('%u.%u.%u.%u', [Major, Minor, Build, Revision]); +end; + +{$IFDEF MSWINDOWS} + +function FormatVersionString(const FixedInfo: TVSFixedFileInfo; VersionFormat: TFileVersionFormat): string; +begin + case VersionFormat of + vfMajorMinor: + Result := Format('%u.%u', [HiWord(FixedInfo.dwFileVersionMS), LoWord(FixedInfo.dwFileVersionMS)]); + vfFull: + Result := Format('%u.%u.%u.%u', [HiWord(FixedInfo.dwFileVersionMS), LoWord(FixedInfo.dwFileVersionMS), + HiWord(FixedInfo.dwFileVersionLS), LoWord(FixedInfo.dwFileVersionLS)]); + end; +end; + +// Version Info extracting +procedure VersionExtractFileInfo(const FixedInfo: TVSFixedFileInfo; var Major, Minor, Build, Revision: Word); +begin + Major := HiWord(FixedInfo.dwFileVersionMS); + Minor := LoWord(FixedInfo.dwFileVersionMS); + Build := HiWord(FixedInfo.dwFileVersionLS); + Revision := LoWord(FixedInfo.dwFileVersionLS); +end; + +procedure VersionExtractProductInfo(const FixedInfo: TVSFixedFileInfo; var Major, Minor, Build, Revision: Word); +begin + Major := HiWord(FixedInfo.dwProductVersionMS); + Minor := LoWord(FixedInfo.dwProductVersionMS); + Build := HiWord(FixedInfo.dwProductVersionLS); + Revision := LoWord(FixedInfo.dwProductVersionLS); +end; + +// Fixed Version Info routines +function VersionFixedFileInfo(const FileName: string; var FixedInfo: TVSFixedFileInfo): Boolean; +var + Size, FixInfoLen: DWORD; + Handle: DWORD; + Buffer: string; + FixInfoBuf: PVSFixedFileInfo; +begin + Result := False; + Handle := 0; + Size := GetFileVersionInfoSize(PChar(FileName), Handle); + if Size > 0 then + begin + SetLength(Buffer, Size); + FixInfoLen := 0; + FixInfoBuf := nil; + if GetFileVersionInfo(PChar(FileName), Handle, Size, Pointer(Buffer)) and + VerQueryValue(Pointer(Buffer), DirDelimiter, Pointer(FixInfoBuf), FixInfoLen) and + (FixInfoLen = SizeOf(TVSFixedFileInfo)) then + begin + Result := True; + FixedInfo := FixInfoBuf^; + end; + end; +end; + +function VersionFixedFileInfoString(const FileName: string; VersionFormat: TFileVersionFormat; + const NotAvailableText: string): string; +var + FixedInfo: TVSFixedFileInfo; +begin + FixedInfo.dwSignature := 0; + if VersionFixedFileInfo(FileName, FixedInfo) then + Result := FormatVersionString(FixedInfo, VersionFormat) + else + Result := NotAvailableText; +end; + +//=== { TJclFileVersionInfo } ================================================ + +constructor TJclFileVersionInfo.Attach(VersionInfoData: Pointer; Size: Integer); +begin + SetLength(FBuffer, Size); + CopyMemory(PAnsiChar(FBuffer), VersionInfoData, Size); + ExtractData; +end; + +constructor TJclFileVersionInfo.Create(const FileName: string); +var + Handle: DWORD; + Size: DWORD; +begin + if not FileExists(FileName) then + raise EJclFileVersionInfoError.CreateResFmt(@RsFileUtilsFileDoesNotExist, [FileName]); + Handle := 0; + Size := GetFileVersionInfoSize(PChar(FileName), Handle); + if Size = 0 then + raise EJclFileVersionInfoError.CreateRes(@RsFileUtilsNoVersionInfo); + SetLength(FBuffer, Size); + Win32Check(GetFileVersionInfo(PChar(FileName), Handle, Size, PAnsiChar(FBuffer))); + ExtractData; +end; + +{$IFDEF MSWINDOWS} +{$IFDEF FPC} +constructor TJclFileVersionInfo.Create(const Window: HWND; Dummy: Pointer = nil); +{$ELSE} +constructor TJclFileVersionInfo.Create(const Window: HWND); +{$ENDIF} +begin + Create(WindowToModuleFileName(Window)); +end; + +constructor TJclFileVersionInfo.Create(const Module: HMODULE); +begin + if Module <> 0 then + Create(GetModulePath(Module)) + else + raise EJclError.CreateResFmt(@RsEModuleNotValid, [Module]); +end; +{$ENDIF MSWINDOWS} + +destructor TJclFileVersionInfo.Destroy; +begin + FreeAndNil(FItemList); + FreeAndNil(FItems); + inherited Destroy; +end; + +class function TJclFileVersionInfo.FileHasVersionInfo(const FileName: string): boolean; +var + Dummy: DWord; +begin + Result := GetFileVersionInfoSize(PChar(FileName), Dummy) <> 0; +end; + +procedure TJclFileVersionInfo.CheckLanguageIndex(Value: Integer); +begin + if (Value < 0) or (Value >= LanguageCount) then + raise EJclFileVersionInfoError.CreateRes(@RsFileUtilsLanguageIndex); +end; + +procedure TJclFileVersionInfo.CreateItemsForLanguage; +var + I: Integer; +begin + Items.Clear; + for I := 0 to FItemList.Count - 1 do + if Integer(FItemList.Objects[I]) = FLanguageIndex then + Items.AddObject(FItemList[I], Pointer(FLanguages[FLanguageIndex].Pair)); +end; + +procedure TJclFileVersionInfo.ExtractData; +var + Data, EndOfData: PAnsiChar; + Len, ValueLen, DataType: Word; + HeaderSize: Integer; + Key: string; + Error, IsUnicode: Boolean; + + procedure Padding(var DataPtr: PAnsiChar); + begin + while TJclAddr(DataPtr) and 3 <> 0 do + Inc(DataPtr); + end; + + procedure GetHeader; + var + P: PAnsiChar; + TempKey: PWideChar; + begin + Key := ''; + P := Data; + Len := PWord(P)^; + if Len = 0 then + begin + // do not raise error in the case of resources padded with 0 + while P < EndOfData do + begin + Error := P^ <> #0; + if Error then + Break; + Inc(P); + end; + Exit; + end; + Inc(P, SizeOf(Word)); + ValueLen := PWord(P)^; + Inc(P, SizeOf(Word)); + if IsUnicode then + begin + DataType := PWord(P)^; + Inc(P, SizeOf(Word)); + TempKey := PWideChar(P); + Inc(P, (lstrlenW(TempKey) + 1) * SizeOf(WideChar)); // length + #0#0 + Key := TempKey; + end + else + begin + DataType := 1; + Key := string(PAnsiChar(P)); + Inc(P, lstrlenA(PAnsiChar(P)) + 1); + end; + Padding(P); + HeaderSize := P - Data; + Data := P; + end; + + procedure FixKeyValue; + const + HexNumberCPrefix = '0x'; + var + I: Integer; + begin // GAPI32.DLL version 5.5.2803.1 contanins '04050x04E2' value + repeat + I := Pos(HexNumberCPrefix, Key); + if I > 0 then + Delete(Key, I, Length(HexNumberCPrefix)); + until I = 0; + I := 1; + while I <= Length(Key) do + if CharIsHexDigit(Key[I]) then + Inc(I) + else + Delete(Key, I, 1); + + // Office16\1031\GrooveIntlResource.dll contains a '4094B0' key. Both parts (lang and codepage) + // are missing their leading zero. It should have been '040904B0'. + // The Windows file property dialog falls back to "English (United States) 1252", so do we. + if Length(Key) < 8 then + Key := '040904E4'; + end; + + procedure ProcessStringInfo(Size: Integer); + var + EndPtr, EndStringPtr: PAnsiChar; + LangIndex: Integer; + LangIdRec: TLangIdRec; + Value: string; + begin + EndPtr := Data + Size; + LangIndex := 0; + while not Error and (Data < EndPtr) do + begin + GetHeader; // StringTable + FixKeyValue; + if (ValueLen <> 0) or (Length(Key) <> 8) then + begin + Error := True; + Break; + end; + Padding(Data); + LangIdRec.LangId := StrToIntDef('$' + Copy(Key, 1, 4), 0); + LangIdRec.CodePage := StrToIntDef('$' + Copy(Key, 5, 4), 0); + SetLength(FLanguages, LangIndex + 1); + FLanguages[LangIndex] := LangIdRec; + EndStringPtr := Data + Len - HeaderSize; + while not Error and (Data < EndStringPtr) do + begin + GetHeader; // string + case DataType of + 0: + if ValueLen in [1..4] then + Value := Format('$%.*x', [ValueLen * 2, PInteger(Data)^]) + else + begin + if (ValueLen > 0) and IsUnicode then + Value:=PWideChar(Data) + else + Value := ''; + end; + 1: + if ValueLen = 0 then + Value := '' + else + if IsUnicode then + begin + Value := WideCharLenToString(PWideChar(Data), ValueLen); + StrResetLength(Value); + end + else + Value := string(PAnsiChar(Data)); + else + Error := True; + Break; + end; + Inc(Data, Len - HeaderSize); + Padding(Data); // String.Padding + FItemList.AddObject(Format('%s=%s', [Key, Value]), Pointer(LangIndex)); + end; + Inc(LangIndex); + end; + end; + + procedure ProcessVarInfo; + var + TranslationIndex: Integer; + begin + GetHeader; // Var + if SameText(Key, 'Translation') then + begin + SetLength(FTranslations, ValueLen div SizeOf(TLangIdRec)); + for TranslationIndex := 0 to Length(FTranslations) - 1 do + begin + FTranslations[TranslationIndex] := PLangIdRec(Data)^; + Inc(Data, SizeOf(TLangIdRec)); + end; + end; + end; + +begin + FItemList := TStringList.Create; + FItems := TStringList.Create; + Data := Pointer(FBuffer); + Assert(TJclAddr(Data) mod 4 = 0); + IsUnicode := (PWord(Data + 4)^ in [0, 1]); + Error := True; + GetHeader; + EndOfData := Data + Len - HeaderSize; + if SameText(Key, 'VS_VERSION_INFO') and (ValueLen = SizeOf(TVSFixedFileInfo)) then + begin + FFixedInfo := PVSFixedFileInfo(Data); + Error := FFixedInfo.dwSignature <> $FEEF04BD; + Inc(Data, ValueLen); // VS_FIXEDFILEINFO + Padding(Data); // VS_VERSIONINFO.Padding2 + while not Error and (Data < EndOfData) do + begin + GetHeader; + Inc(Data, ValueLen); // some files (VREDIR.VXD 4.00.1111) has non zero value of ValueLen + Dec(Len, HeaderSize + ValueLen); + if SameText(Key, 'StringFileInfo') then + ProcessStringInfo(Len) + else + if SameText(Key, 'VarFileInfo') then + ProcessVarInfo + else + Break; + end; + ExtractFlags; + CreateItemsForLanguage; + end; + if Error then + raise EJclFileVersionInfoError.CreateRes(@RsFileUtilsNoVersionInfo); +end; + +procedure TJclFileVersionInfo.ExtractFlags; +var + Masked: DWORD; +begin + FFileFlags := []; + Masked := FFixedInfo^.dwFileFlags and FFixedInfo^.dwFileFlagsMask; + if (Masked and VS_FF_DEBUG) <> 0 then + Include(FFileFlags, ffDebug); + if (Masked and VS_FF_INFOINFERRED) <> 0 then + Include(FFileFlags, ffInfoInferred); + if (Masked and VS_FF_PATCHED) <> 0 then + Include(FFileFlags, ffPatched); + if (Masked and VS_FF_PRERELEASE) <> 0 then + Include(FFileFlags, ffPreRelease); + if (Masked and VS_FF_PRIVATEBUILD) <> 0 then + Include(FFileFlags, ffPrivateBuild); + if (Masked and VS_FF_SPECIALBUILD) <> 0 then + Include(FFileFlags, ffSpecialBuild); +end; + +function TJclFileVersionInfo.GetBinFileVersion: string; +begin + Result := Format('%u.%u.%u.%u', [HiWord(FFixedInfo^.dwFileVersionMS), + LoWord(FFixedInfo^.dwFileVersionMS), HiWord(FFixedInfo^.dwFileVersionLS), + LoWord(FFixedInfo^.dwFileVersionLS)]); +end; + +function TJclFileVersionInfo.GetBinProductVersion: string; +begin + Result := Format('%u.%u.%u.%u', [HiWord(FFixedInfo^.dwProductVersionMS), + LoWord(FFixedInfo^.dwProductVersionMS), HiWord(FFixedInfo^.dwProductVersionLS), + LoWord(FFixedInfo^.dwProductVersionLS)]); +end; + +function TJclFileVersionInfo.GetCustomFieldValue(const FieldName: string): string; +var + ItemIndex: Integer; +begin + if FieldName <> '' then + begin + ItemIndex := FItems.IndexOfName(FieldName); + if ItemIndex <> -1 then + //Return the required value, the value the user passed in was found. + Result := FItems.Values[FieldName] + else + raise EJclFileVersionInfoError.CreateResFmt(@RsFileUtilsValueNotFound, [FieldName]); + end + else + raise EJclFileVersionInfoError.CreateRes(@RsFileUtilsEmptyValue); +end; + +function TJclFileVersionInfo.GetFileOS: DWORD; +begin + Result := FFixedInfo^.dwFileOS; +end; + +function TJclFileVersionInfo.GetFileSubType: DWORD; +begin + Result := FFixedInfo^.dwFileSubtype; +end; + +function TJclFileVersionInfo.GetFileType: DWORD; +begin + Result := FFixedInfo^.dwFileType; +end; + +function TJclFileVersionInfo.GetFileVersionBuild: string; +var + Left: Integer; +begin + Result := FileVersion; + StrReplaceChar(Result, ',', '.'); + Left := CharLastPos(Result, '.') + 1; + Result := StrMid(Result, Left, Length(Result) - Left + 1); + Result := Trim(Result); +end; + +function TJclFileVersionInfo.GetFileVersionMajor: string; +begin + Result := FileVersion; + StrReplaceChar(Result, ',', '.'); + Result := StrBefore('.', Result); + Result := Trim(Result); +end; + +function TJclFileVersionInfo.GetFileVersionMinor: string; +var + Left, Right: integer; +begin + Result := FileVersion; + StrReplaceChar(Result, ',', '.'); + Left := CharPos(Result, '.') + 1; // skip major + Right := CharPos(Result, '.', Left) {-1}; + Result := StrMid(Result, Left, Right - Left {+1}); + Result := Trim(Result); +end; + +function TJclFileVersionInfo.GetFileVersionRelease: string; +var + Left, Right: Integer; +begin + Result := FileVersion; + StrReplaceChar(Result, ',', '.'); + Left := CharPos(Result, '.') + 1; // skip major + Left := CharPos(Result, '.', Left) + 1; // skip minor + Right := CharPos(Result, '.', Left) {-1}; + Result := StrMid(Result, Left, Right - Left {+1}); + Result := Trim(Result); +end; + +function TJclFileVersionInfo.GetFixedInfo: TVSFixedFileInfo; +begin + Result := FFixedInfo^; +end; + +function TJclFileVersionInfo.GetItems: TStrings; +begin + Result := FItems; +end; + +function TJclFileVersionInfo.GetLanguageCount: Integer; +begin + Result := Length(FLanguages); +end; + +function TJclFileVersionInfo.GetLanguageIds(Index: Integer): string; +begin + CheckLanguageIndex(Index); + Result := VersionLanguageId(FLanguages[Index]); +end; + +function TJclFileVersionInfo.GetLanguages(Index: Integer): TLangIdRec; +begin + CheckLanguageIndex(Index); + Result := FLanguages[Index]; +end; + +function TJclFileVersionInfo.GetLanguageNames(Index: Integer): string; +begin + CheckLanguageIndex(Index); + Result := VersionLanguageName(FLanguages[Index].LangId); +end; + +function TJclFileVersionInfo.GetTranslationCount: Integer; +begin + Result := Length(FTranslations); +end; + +function TJclFileVersionInfo.GetTranslations(Index: Integer): TLangIdRec; +begin + Result := FTranslations[Index]; +end; + +function TJclFileVersionInfo.GetProductVersionBuild: string; +var + Left: Integer; +begin + Result := ProductVersion; + StrReplaceChar(Result, ',', '.'); + Left := CharLastPos(Result, '.') + 1; + Result := StrMid(Result, Left, Length(Result) - Left + 1); + Result := Trim(Result); +end; + +function TJclFileVersionInfo.GetProductVersionMajor: string; +begin + Result := ProductVersion; + StrReplaceChar(Result, ',', '.'); + Result := StrBefore('.', Result); + Result := Trim(Result); +end; + +function TJclFileVersionInfo.GetProductVersionMinor: string; +var + Left, Right: integer; +begin + Result := ProductVersion; + StrReplaceChar(Result, ',', '.'); + Left := CharPos(Result, '.') + 1; // skip major + Right := CharPos(Result, '.', Left) {-1}; + Result := StrMid(Result, Left, Right - Left {+1}); + Result := Trim(Result); +end; + +function TJclFileVersionInfo.GetProductVersionRelease: string; +var + Left, Right: Integer; +begin + Result := ProductVersion; + StrReplaceChar(Result, ',', '.'); + Left := CharPos(Result, '.') + 1; // skip major + Left := CharPos(Result, '.', Left) + 1; // skip minor + Right := CharPos(Result, '.', Left) {-1}; + Result := StrMid(Result, Left, Right - Left {+1}); + Result := Trim(Result); +end; + +function TJclFileVersionInfo.GetVersionKeyValue(Index: Integer): string; +begin + Result := Items.Values[VerKeyNames[Index]]; +end; + +procedure TJclFileVersionInfo.SetLanguageIndex(const Value: Integer); +begin + CheckLanguageIndex(Value); + if FLanguageIndex <> Value then + begin + FLanguageIndex := Value; + CreateItemsForLanguage; + end; +end; + +function TJclFileVersionInfo.TranslationMatchesLanguages(Exact: Boolean): Boolean; +var + TransIndex, LangIndex: Integer; + TranslationPair: DWORD; +begin + Result := (LanguageCount = TranslationCount) or (not Exact and (TranslationCount > 0)); + if Result then + for TransIndex := 0 to TranslationCount - 1 do + begin + TranslationPair := FTranslations[TransIndex].Pair; + LangIndex := LanguageCount - 1; + while (LangIndex >= 0) and (TranslationPair <> FLanguages[LangIndex].Pair) do + Dec(LangIndex); + if LangIndex < 0 then + begin + Result := False; + Break; + end; + end; +end; + +class function TJclFileVersionInfo.VersionLanguageId(const LangIdRec: TLangIdRec): string; +begin + with LangIdRec do + Result := Format('%.4x%.4x', [LangId, CodePage]); +end; + +class function TJclFileVersionInfo.VersionLanguageName(const LangId: Word): string; +var + R: DWORD; +begin + SetLength(Result, MAX_PATH); + R := VerLanguageName(LangId, PChar(Result), MAX_PATH); + SetLength(Result, R); +end; + +{$ENDIF MSWINDOWS} + +//=== { TJclFileMaskComparator } ============================================= + +constructor TJclFileMaskComparator.Create; +begin + inherited Create; + FSeparator := DirSeparator; +end; + +function TJclFileMaskComparator.Compare(const NameExt: string): Boolean; +var + I: Integer; + NamePart, ExtPart: string; + NameWild, ExtWild: Boolean; +begin + Result := False; + I := StrLastPos('.', NameExt); + if I = 0 then + begin + NamePart := NameExt; + ExtPart := ''; + end + else + begin + NamePart := Copy(NameExt, 1, I - 1); + ExtPart := Copy(NameExt, I + 1, Length(NameExt)); + end; + for I := 0 to Length(FNames) - 1 do + begin + NameWild := FWildChars[I] and 1 = 1; + ExtWild := FWildChars[I] and 2 = 2; + if ((not NameWild and StrSame(FNames[I], NamePart)) or + (NameWild and (StrMatches(FNames[I], NamePart, 1)))) and + ((not ExtWild and StrSame(FExts[I], ExtPart)) or + (ExtWild and (StrMatches(FExts[I], ExtPart, 1)))) then + begin + Result := True; + Break; + end; + end; +end; + +procedure TJclFileMaskComparator.CreateMultiMasks; +var + List: TStringList; + I, N: Integer; + NS, ES: string; +begin + FExts := nil; + FNames := nil; + FWildChars := nil; + List := TStringList.Create; + try + StrToStrings(FFileMask, FSeparator, List); + SetLength(FExts, List.Count); + SetLength(FNames, List.Count); + SetLength(FWildChars, List.Count); + for I := 0 to List.Count - 1 do + begin + N := StrLastPos('.', List[I]); + if N = 0 then + begin + NS := List[I]; + ES := ''; + end + else + begin + NS := Copy(List[I], 1, N - 1); + ES := Copy(List[I], N + 1, 255); + end; + FNames[I] := NS; + FExts[I] := ES; + N := 0; + if StrContainsChars(NS, CharIsWildcard, False) then + N := N or 1; + if StrContainsChars(ES, CharIsWildcard, False) then + N := N or 2; + FWildChars[I] := N; + end; + finally + List.Free; + end; +end; + +function TJclFileMaskComparator.GetCount: Integer; +begin + Result := Length(FWildChars); +end; + +function TJclFileMaskComparator.GetExts(Index: Integer): string; +begin + Result := FExts[Index]; +end; + +function TJclFileMaskComparator.GetMasks(Index: Integer): string; +begin + Result := FNames[Index] + '.' + FExts[Index]; +end; + +function TJclFileMaskComparator.GetNames(Index: Integer): string; +begin + Result := FNames[Index]; +end; + +procedure TJclFileMaskComparator.SetFileMask(const Value: string); +begin + FFileMask := Value; + CreateMultiMasks; +end; + +procedure TJclFileMaskComparator.SetSeparator(const Value: Char); +begin + if FSeparator <> Value then + begin + FSeparator := Value; + CreateMultiMasks; + end; +end; + +function AdvBuildFileList(const Path: string; const Attr: Integer; const Files: TStrings; + const AttributeMatch: TJclAttributeMatch; const Options: TFileListOptions; + const SubfoldersMask: string; const FileMatchFunc: TFileMatchFunc): Boolean; +var + FileMask: string; + RootDir: string; + Folders: TStringList; + CurrentItem: Integer; + Counter: Integer; + FindAttr: Integer; + + procedure BuildFolderList; + var + FindInfo: TSearchRec; + Rslt: Integer; + begin + Counter := Folders.Count - 1; + CurrentItem := 0; + + while CurrentItem <= Counter do + begin + // searching for subfolders (including hidden ones) + Rslt := FindFirst(Folders[CurrentItem] + '*.*', faAnyFile, FindInfo); + try + while Rslt = 0 do + begin + if (FindInfo.Name <> '.') and (FindInfo.Name <> '..') and + (FindInfo.Attr and faDirectory = faDirectory) then + Folders.Add(Folders[CurrentItem] + FindInfo.Name + DirDelimiter); + + Rslt := FindNext(FindInfo); + end; + finally + FindClose(FindInfo); + end; + Counter := Folders.Count - 1; + Inc(CurrentItem); + end; + end; + + procedure FillFileList(CurrentCounter: Integer); + var + FindInfo: TSearchRec; + Rslt: Integer; + CurrentFolder: string; + Matches: Boolean; + begin + CurrentFolder := Folders[CurrentCounter]; + + Rslt := FindFirst(CurrentFolder + FileMask, FindAttr, FindInfo); + + try + while Rslt = 0 do + begin + Matches := False; + + case AttributeMatch of + amAny: + Matches := True; + amExact: + Matches := Attr = FindInfo.Attr; + amSubSetOf: + Matches := (Attr and FindInfo.Attr) = Attr; + amSuperSetOf: + Matches := (Attr and FindInfo.Attr) = FindInfo.Attr; + amCustom: + if Assigned(FileMatchFunc) then + Matches := FileMatchFunc(Attr, FindInfo); + end; + + if Matches then + if flFullNames in Options then + Files.Add(CurrentFolder + FindInfo.Name) + else + Files.Add(FindInfo.Name); + + Rslt := FindNext(FindInfo); + end; + finally + FindClose(FindInfo); + end; + end; + +begin + Assert(Assigned(Files)); + FileMask := ExtractFileName(Path); + RootDir := ExtractFilePath(Path); + + Folders := TStringList.Create; + Files.BeginUpdate; + try + Folders.Add(RootDir); + + case AttributeMatch of + amExact, amSuperSetOf: + FindAttr := Attr; + else + FindAttr := faAnyFile; + end; + + // here's the recursive search for nested folders + + if flRecursive in Options then + BuildFolderList; + + for Counter := 0 to Folders.Count - 1 do + begin + if (((flMaskedSubfolders in Options) and (StrMatches(SubfoldersMask, + Folders[Counter], 1))) or (not (flMaskedSubfolders in Options))) then + FillFileList(Counter); + end; + finally + Folders.Free; + Files.EndUpdate; + end; + Result := True; +end; + +function VerifyFileAttributeMask(var RejectedAttributes, RequiredAttributes: Integer): Boolean; +begin + if RequiredAttributes and faNormalFile <> 0 then + RejectedAttributes := not faNormalFile or RejectedAttributes; + Result := RequiredAttributes and RejectedAttributes = 0; +end; + +function AttributeMatch(FileAttributes, RejectedAttr, RequiredAttr: Integer): Boolean; +begin + if FileAttributes = 0 then + FileAttributes := faNormalFile; + {$IFDEF MSWINDOWS} + RequiredAttr := RequiredAttr and not faUnixSpecific; + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + RequiredAttr := RequiredAttr and not faWindowsSpecific; + {$ENDIF UNIX} + Result := (FileAttributes and RejectedAttr = 0) + and (FileAttributes and RequiredAttr = RequiredAttr); +end; + +function IsFileAttributeMatch(FileAttributes, RejectedAttributes, + RequiredAttributes: Integer): Boolean; +begin + VerifyFileAttributeMask(RejectedAttributes, RequiredAttributes); + Result := AttributeMatch(FileAttributes, RejectedAttributes, RequiredAttributes); +end; + +function FileAttributesStr(const FileInfo: TSearchRec): string; +{$IFDEF MSWINDOWS} +const + SAllAttrSet = 'rahs'; // readonly, archive, hidden, system + Attributes: array [1..4] of Integer = + (faReadOnly, faArchive, faHidden, faSysFile); +var + I: Integer; +begin + Result := SAllAttrSet; + for I := Low(Attributes) to High(Attributes) do + if (FileInfo.Attr and Attributes[I]) = 0 then + Result[I] := '-'; +end; +{$ENDIF MSWINDOWS} +{$IFDEF UNIX} +const + SAllAttrSet = 'drwxrwxrwx'; +var + I: Integer; + Flag: Cardinal; +begin + Result := SAllAttrSet; + if FileInfo.Attr and faDirectory = 0 then + Result[1] := '-'; // no directory + Flag := 1 shl 8; + for I := 2 to 10 do + begin + if FileInfo.Mode and Flag = 0 then + Result[I] := '-'; + Flag := Flag shr 1; + end; +end; +{$ENDIF UNIX} + +function IsFileNameMatch(FileName: string; const Mask: string; + const CaseSensitive: Boolean): Boolean; +begin + Result := True; + {$IFDEF MSWINDOWS} + if (Mask = '') or (Mask = '*') or (Mask = '*.*') then + Exit; + if Pos('.', FileName) = 0 then + FileName := FileName + '.'; // file names w/o extension match '*.' + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + if (Mask = '') or (Mask = '*') then + Exit; + {$ENDIF UNIX} + if CaseSensitive then + Result := StrMatches(Mask, FileName) + else + Result := StrMatches(AnsiUpperCase(Mask), AnsiUpperCase(FileName)); +end; + +// author: Robert Rossmair + +function CanonicalizedSearchPath(const Directory: string): string; +begin + Result := PathCanonicalize(Directory); + {$IFDEF MSWINDOWS} + // avoid changing "X:" (current directory on drive X:) into "X:\" (root dir.) + if Result[Length(Result)] <> ':' then + {$ENDIF MSWINDOWS} + Result := PathAddSeparator(Result); + // strip leading "./" resp. ".\" + if Pos('.' + DirDelimiter, Result) = 1 then + Result := Copy(Result, 3, Length(Result) - 2); +end; + +procedure EnumFiles(const Path: string; HandleFile: TFileHandlerEx; + RejectedAttributes: Integer; RequiredAttributes: Integer; Abort: PBoolean); +var + Directory: string; + FileInfo: TSearchRec; + Attr: Integer; + Found: Boolean; +begin + Assert(Assigned(HandleFile)); + Assert(VerifyFileAttributeMask(RejectedAttributes, RequiredAttributes), + LoadResString(@RsFileSearchAttrInconsistency)); + + Directory := ExtractFilePath(Path); + + Attr := faAnyFile and not RejectedAttributes; + + Found := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindFirst(Path, Attr, FileInfo) = 0; + try + while Found do + begin + if (Abort <> nil) and LongBool(Abort^) then + Exit; + if AttributeMatch(FileInfo.Attr, RejectedAttributes, RequiredAttributes) then + if ((FileInfo.Attr and faDirectory = 0) + or ((FileInfo.Name <> '.') and (FileInfo.Name <> '..'))) then + HandleFile(Directory, FileInfo); + Found := FindNext(FileInfo) = 0; + end; + finally + FindClose(FileInfo); + end; +end; + +procedure EnumFiles(const Path: string; HandleFile: TFileInfoHandlerEx; + RejectedAttributes: Integer; RequiredAttributes: Integer; Abort: PBoolean); +var + FileInfo: TSearchRec; + Attr: Integer; + Found: Boolean; +begin + Assert(Assigned(HandleFile)); + Assert(VerifyFileAttributeMask(RejectedAttributes, RequiredAttributes), + LoadResString(@RsFileSearchAttrInconsistency)); + + Attr := faAnyFile and not RejectedAttributes; + + Found := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindFirst(Path, Attr, FileInfo) = 0; + try + while Found do + begin + if (Abort <> nil) and LongBool(Abort^) then + Exit; + if AttributeMatch(FileInfo.Attr, RejectedAttributes, RequiredAttributes) then + if ((FileInfo.Attr and faDirectory = 0) + or ((FileInfo.Name <> '.') and (FileInfo.Name <> '..'))) then + HandleFile(FileInfo); + Found := FindNext(FileInfo) = 0; + end; + finally + FindClose(FileInfo); + end; +end; + +procedure EnumDirectories(const Root: string; const HandleDirectory: TFileHandler; + const IncludeHiddenDirectories: Boolean; const SubDirectoriesMask: string; + Abort: PBoolean {$IFDEF UNIX}; ResolveSymLinks: Boolean {$ENDIF}); +var + RootDir: string; + Attr: Integer; + + procedure Process(const Directory: string); + var + DirInfo: TSearchRec; + SubDir: string; + Found: Boolean; + begin + HandleDirectory(Directory); + + Found := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindFirst(Directory + '*', Attr, DirInfo) = 0; + try + while Found do + begin + if (Abort <> nil) and LongBool(Abort^) then + Exit; + if (DirInfo.Name <> '.') and (DirInfo.Name <> '..') and + {$IFDEF UNIX} + (IncludeHiddenDirectories or (Pos('.', DirInfo.Name) <> 1)) and + ((DirInfo.Attr and faSymLink = 0) or ResolveSymLinks) and + {$ENDIF UNIX} + (DirInfo.Attr and faDirectory <> 0) then + begin + SubDir := Directory + DirInfo.Name + DirDelimiter; + if (SubDirectoriesMask = '') or StrMatches(SubDirectoriesMask, SubDir, Length(RootDir)) then + Process(SubDir); + end; + Found := FindNext(DirInfo) = 0; + end; + finally + FindClose(DirInfo); + end; + end; + +begin + Assert(Assigned(HandleDirectory)); + RootDir := CanonicalizedSearchPath(Root); + + if IncludeHiddenDirectories then + Attr := faDirectory + faHidden // no effect on Linux + else + Attr := faDirectory; + + Process(RootDir); +end; + +//=== { TJclCustomFileAttributeMask } ============================================== + +constructor TJclCustomFileAttrMask.Create; +begin + inherited Create; + FRejectedAttr := faRejectedByDefault; +end; + +procedure TJclCustomFileAttrMask.Assign(Source: TPersistent); +begin + if Source is TJclCustomFileAttrMask then + begin + Required := TJclCustomFileAttrMask(Source).Required; + Rejected := TJclCustomFileAttrMask(Source).Rejected; + end + else + inherited Assign(Source); +end; + +procedure TJclCustomFileAttrMask.Clear; +begin + Rejected := 0; + Required := 0; +end; + +procedure TJclCustomFileAttrMask.DefineProperties(Filer: TFiler); +var + Ancestor: TJclCustomFileAttrMask; + Attr: Integer; +begin + Attr := 0; + Ancestor := TJclCustomFileAttrMask(Filer.Ancestor); + if Assigned(Ancestor) then + Attr := Ancestor.FRequiredAttr; + Filer.DefineProperty('Required', ReadRequiredAttributes, WriteRequiredAttributes, + Attr <> FRequiredAttr); + if Assigned(Ancestor) then + Attr := Ancestor.FRejectedAttr; + Filer.DefineProperty('Rejected', ReadRejectedAttributes, WriteRejectedAttributes, + Attr <> FRejectedAttr); +end; + +function TJclCustomFileAttrMask.Match(FileAttributes: Integer): Boolean; +begin + Result := AttributeMatch(FileAttributes, Rejected, Required); +end; + +function TJclCustomFileAttrMask.Match(const FileInfo: TSearchRec): Boolean; +begin + Result := Match(FileInfo.Attr); +end; + +function TJclCustomFileAttrMask.GetAttr(Index: Integer): TAttributeInterest; +begin + if ((FRequiredAttr and Index) <> 0) or (Index = faNormalFile) and + (FRejectedAttr = not faNormalFile) then + Result := aiRequired + else + if (FRejectedAttr and Index) <> 0 then + Result := aiRejected + else + Result := aiIgnored; +end; + +procedure TJclCustomFileAttrMask.ReadRejectedAttributes(Reader: TReader); +begin + FRejectedAttr := Reader.ReadInteger; +end; + +procedure TJclCustomFileAttrMask.ReadRequiredAttributes(Reader: TReader); +begin + FRequiredAttr := Reader.ReadInteger; +end; + +procedure TJclCustomFileAttrMask.SetAttr(Index: Integer; const Value: TAttributeInterest); +begin + case Value of + aiIgnored: + begin + FRequiredAttr := FRequiredAttr and not Index; + FRejectedAttr := FRejectedAttr and not Index; + end; + aiRejected: + begin + FRequiredAttr := FRequiredAttr and not Index; + FRejectedAttr := FRejectedAttr or Index; + end; + aiRequired: + begin + if Index = faNormalFile then + begin + FRequiredAttr := faNormalFile; + FRejectedAttr := not faNormalFile; + end + else + begin + FRequiredAttr := FRequiredAttr or Index; + FRejectedAttr := FRejectedAttr and not Index; + end; + end; + end; +end; + +procedure TJclCustomFileAttrMask.WriteRejectedAttributes(Writer: TWriter); +begin + Writer.WriteInteger(FRejectedAttr); +end; + +procedure TJclCustomFileAttrMask.WriteRequiredAttributes(Writer: TWriter); +begin + Writer.WriteInteger(FRequiredAttr); +end; + +//=== { TJclFileAttributeMask } ============================================== + +procedure TJclFileAttributeMask.ReadVolumeID(Reader: TReader); +begin + // Nothing, we are not interested in the value of the VolumeID property, + // this procedure and the associated DefineProperty call are here only + // to allow reading legacy DFMs that have this property defined. +end; + +procedure TJclFileAttributeMask.DefineProperties(Filer: TFiler); +begin + inherited DefineProperties(Filer); + + Filer.DefineProperty('VolumeID', ReadVolumeID, nil, False); +end; + +//=== { TJclFileSearchOptions } ============================================== + +constructor TJclFileSearchOptions.Create; +begin + inherited Create; + + FAttributeMask := TJclFileAttributeMask.Create; + FRootDirectories := TStringList.Create; + FRootDirectories.Add('.'); + FFileMasks := TStringList.Create; + FFileMasks.Add('*'); + FSubDirectoryMask := '*'; + FOptions := [fsIncludeSubDirectories]; + FLastChangeAfter := MinDateTime; + FLastChangeBefore := MaxDateTime; + {$IFDEF UNIX} + FCaseSensitiveSearch := True; + {$ENDIF UNIX} +end; + +destructor TJclFileSearchOptions.Destroy; +begin + FAttributeMask.Free; + FFileMasks.Free; + FRootDirectories.Free; + + inherited Destroy; +end; + +procedure TJclFileSearchOptions.Assign(Source: TPersistent); +var + Src: TJclFileSearchOptions; +begin + if Source is TJclFileSearchOptions then + begin + Src := TJclFileSearchOptions(Source); + FCaseSensitiveSearch := Src.FCaseSensitiveSearch; + FileMasks.Assign(Src.FileMasks); + RootDirectory := Src.RootDirectory; + SubDirectoryMask := Src.SubDirectoryMask; + AttributeMask := Src.AttributeMask; + Options := Src.Options; + FileSizeMin := Src.FileSizeMin; + FileSizeMax := Src.FileSizeMax; + LastChangeAfter := Src.LastChangeAfter; + LastChangeBefore := Src.LastChangeBefore; + end + else + inherited Assign(Source); +end; + +function TJclFileSearchOptions.GetAttributeMask: TJclFileAttributeMask; +begin + Result := FAttributeMask; +end; + +function TJclFileSearchOptions.GetCaseSensitiveSearch: Boolean; +begin + Result := FCaseSensitiveSearch; +end; + +function TJclFileSearchOptions.GetFileMask: string; +begin + Result := StringsToStr(FileMasks, DirSeparator, False); +end; + +function TJclFileSearchOptions.GetFileMasks: TStrings; +begin + Result := FFileMasks; +end; + +function TJclFileSearchOptions.GetFileSizeMax: Int64; +begin + Result := FFileSizeMax; +end; + +function TJclFileSearchOptions.GetFileSizeMin: Int64; +begin + Result := FFileSizeMin; +end; + +function TJclFileSearchOptions.GetIncludeHiddenSubDirectories: Boolean; +begin + Result := fsIncludeHiddenSubDirectories in Options; +end; + +function TJclFileSearchOptions.GetIncludeSubDirectories: Boolean; +begin + Result := fsIncludeSubDirectories in Options; +end; + +function TJclFileSearchOptions.GetLastChangeAfter: TDateTime; +begin + Result := FLastChangeAfter; +end; + +function TJclFileSearchOptions.GetLastChangeAfterStr: string; +begin + Result := DateTimeToStr(LastChangeAfter); +end; + +function TJclFileSearchOptions.GetLastChangeBefore: TDateTime; +begin + Result := FLastChangeBefore; +end; + +function TJclFileSearchOptions.GetLastChangeBeforeStr: string; +begin + Result := DateTimeToStr(LastChangeBefore); +end; + +function TJclFileSearchOptions.GetOption( + const Option: TFileSearchOption): Boolean; +begin + Result := Option in FOptions; +end; + +function TJclFileSearchOptions.GetOptions: TFileSearchoptions; +begin + Result := FOptions; +end; + +function TJclFileSearchOptions.GetRootDirectories: TStrings; +begin + Result := FRootDirectories; +end; + +function TJclFileSearchOptions.GetRootDirectory: string; +begin + if FRootDirectories.Count = 1 then + Result := FRootDirectories.Strings[0] + else + Result := ''; +end; + +function TJclFileSearchOptions.GetSubDirectoryMask: string; +begin + Result := FSubDirectoryMask; +end; + +function TJclFileSearchOptions.IsLastChangeAfterStored: Boolean; +begin + Result := FLastChangeAfter <> MinDateTime; +end; + +function TJclFileSearchOptions.IsLastChangeBeforeStored: Boolean; +begin + Result := FLastChangeBefore <> MaxDateTime; +end; + +procedure TJclFileSearchOptions.SetAttributeMask( + const Value: TJclFileAttributeMask); +begin + FAttributeMask.Assign(Value); +end; + +procedure TJclFileSearchOptions.SetCaseSensitiveSearch(const Value: Boolean); +begin + FCaseSensitiveSearch := Value; +end; + +procedure TJclFileSearchOptions.SetFileMask(const Value: string); +begin + { TODO : UNIX : ? } + StrToStrings(Value, DirSeparator, FFileMasks, False); +end; + +procedure TJclFileSearchOptions.SetFileMasks(const Value: TStrings); +begin + FileMasks.Assign(Value); +end; + +procedure TJclFileSearchOptions.SetFileSizeMax(const Value: Int64); +begin + FFileSizeMax := Value; +end; + +procedure TJclFileSearchOptions.SetFileSizeMin(const Value: Int64); +begin + FFileSizeMin := Value; +end; + +procedure TJclFileSearchOptions.SetIncludeHiddenSubDirectories( + const Value: Boolean); +begin + SetOption(fsIncludeHiddenSubDirectories, Value); +end; + +procedure TJclFileSearchOptions.SetIncludeSubDirectories(const Value: Boolean); +begin + SetOption(fsIncludeSubDirectories, Value); +end; + +procedure TJclFileSearchOptions.SetLastChangeAfter(const Value: TDateTime); +begin + FLastChangeAfter := Value; +end; + +procedure TJclFileSearchOptions.SetLastChangeAfterStr(const Value: string); +begin + if Value = '' then + LastChangeAfter := MinDateTime + else + LastChangeAfter := StrToDateTime(Value); +end; + +procedure TJclFileSearchOptions.SetLastChangeBefore(const Value: TDateTime); +begin + FLastChangeBefore := Value; +end; + +procedure TJclFileSearchOptions.SetLastChangeBeforeStr(const Value: string); +begin + if Value = '' then + LastChangeBefore := MaxDateTime + else + LastChangeBefore := StrToDateTime(Value); +end; + +procedure TJclFileSearchOptions.SetOption(const Option: TFileSearchOption; + const Value: Boolean); +begin + if Value then + Include(FOptions, Option) + else + Exclude(FOptions, Option); +end; + +procedure TJclFileSearchOptions.SetOptions(const Value: TFileSearchOptions); +begin + FOptions := Value; +end; + +procedure TJclFileSearchOptions.SetRootDirectories(const Value: TStrings); +begin + FRootDirectories.Assign(Value); +end; + +procedure TJclFileSearchOptions.SetRootDirectory(const Value: string); +begin + FRootDirectories.Clear; + FRootDirectories.Add(Value); +end; + +procedure TJclFileSearchOptions.SetSubDirectoryMask(const Value: string); +begin + FSubDirectoryMask := Value; +end; + +//=== { TEnumFileThread } ==================================================== + +type + TEnumFileThread = class(TThread) + private + FID: TFileSearchTaskID; + FFileMasks: TStringList; + FDirectories: TStrings; + FCurrentDirectory: string; + FSubDirectoryMask: string; + FOnEnterDirectory: TFileHandler; + FFileHandlerEx: TFileHandlerEx; + FFileHandler: TFileHandler; + FInternalDirHandler: TFileHandler; + FInternalFileInfoHandler: TFileInfoHandlerEx; + FFileInfo: TSearchRec; + FRejectedAttr: Integer; + FRequiredAttr: Integer; + FFileSizeMin: Int64; + FFileSizeMax: Int64; + {$IFDEF RTL220_UP} + FFileTimeMin: TDateTime; + FFileTimeMax: TDateTime; + {$ELSE ~RTL220_UP} + FFileTimeMin: Integer; + FFileTimeMax: Integer; + {$ENDIF ~RTL220_UP} + FSynchronizationMode: TFileEnumeratorSyncMode; + FIncludeSubDirectories: Boolean; + FIncludeHiddenSubDirectories: Boolean; + FNotifyOnTermination: Boolean; + FCaseSensitiveSearch: Boolean; + FAllNamesMatch: Boolean; + procedure EnterDirectory; + procedure AsyncProcessDirectory(const Directory: string); + procedure SyncProcessDirectory(const Directory: string); + procedure AsyncProcessFile(const FileInfo: TSearchRec); + procedure SyncProcessFile(const FileInfo: TSearchRec); + function GetDirectories: TStrings; + function GetFileMasks: TStrings; + procedure SetDirectories(const Value: TStrings); + procedure SetFileMasks(const Value: TStrings); + protected + procedure DoTerminate; override; + procedure Execute; override; + function FileMatch: Boolean; + function FileNameMatchesMask: Boolean; + procedure ProcessDirectory; + procedure ProcessDirFiles; + procedure ProcessFile; + property AllNamesMatch: Boolean read FAllNamesMatch; + property CaseSensitiveSearch: Boolean read FCaseSensitiveSearch write FCaseSensitiveSearch; + property FileMasks: TStrings read GetFileMasks write SetFileMasks; + property FileSizeMin: Int64 read FFileSizeMin write FFileSizeMin; + property FileSizeMax: Int64 read FFileSizeMax write FFileSizeMax; + {$IFDEF RTL220_UP} + property FileTimeMin: TDateTime read FFileTimeMin write FFileTimeMin; + property FileTimeMax: TDateTime read FFileTimeMax write FFileTimeMax; + {$ELSE ~RTL220_UP} + property FileTimeMin: Integer read FFileTimeMin write FFileTimeMin; + property FileTimeMax: Integer read FFileTimeMax write FFileTimeMax; + {$ENDIF ~RTL220_UP} + property Directories: TStrings read GetDirectories write SetDirectories; + property IncludeSubDirectories: Boolean + read FIncludeSubDirectories write FIncludeSubDirectories; + property IncludeHiddenSubDirectories: Boolean + read FIncludeHiddenSubDirectories write FIncludeHiddenSubDirectories; + property RejectedAttr: Integer read FRejectedAttr write FRejectedAttr; + property RequiredAttr: Integer read FRequiredAttr write FRequiredAttr; + property SynchronizationMode: TFileEnumeratorSyncMode + read FSynchronizationMode write FSynchronizationMode; + public + constructor Create; + destructor Destroy; override; + property ID: TFileSearchTaskID read FID; + {$IFDEF FPC} // protected property + property Terminated; + {$ENDIF FPC} + end; + +constructor TEnumFileThread.Create; +begin + inherited Create(True); + FDirectories := TStringList.Create; + FFileMasks := TStringList.Create; + {$IFDEF RTL220_UP} + FFileTimeMin := -MaxDouble; + FFileTimeMax := MaxDouble; + {$ELSE ~RTL220_UP} + FFileTimeMin := Low(FFileInfo.Time); + FFileTimeMax := High(FFileInfo.Time); + {$ENDIF ~RTL220_UP} + FFileSizeMax := High(FFileSizeMax); + {$IFDEF MSWINDOWS} + Priority := tpIdle; + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + {$IFDEF FPC} + Priority := tpIdle; + {$ELSE ~FPC} + Priority := 0; + {$ENDIF ~FPC} + {$ENDIF UNIX} + FreeOnTerminate := True; + FNotifyOnTermination := True; +end; + +destructor TEnumFileThread.Destroy; +begin + FFileMasks.Free; + FDirectories.Free; + inherited Destroy; +end; + +procedure TEnumFileThread.Execute; +var + Index: Integer; +begin + if SynchronizationMode = smPerDirectory then + begin + FInternalDirHandler := SyncProcessDirectory; + FInternalFileInfoHandler := AsyncProcessFile; + end + else // SynchronizationMode = smPerFile + begin + FInternalDirHandler := AsyncProcessDirectory; + FInternalFileInfoHandler := SyncProcessFile; + end; + + if FIncludeSubDirectories then + begin + for Index := 0 to FDirectories.Count - 1 do + EnumDirectories(FDirectories.Strings[Index], FInternalDirHandler, FIncludeHiddenSubDirectories, + FSubDirectoryMask, @Terminated) + end + else + begin + for Index := 0 to FDirectories.Count - 1 do + FInternalDirHandler(CanonicalizedSearchPath(FDirectories.Strings[Index])); + end; +end; + +procedure TEnumFileThread.DoTerminate; +begin + if FNotifyOnTermination then + inherited DoTerminate; +end; + +procedure TEnumFileThread.EnterDirectory; +begin + FOnEnterDirectory(FCurrentDirectory); +end; + +procedure TEnumFileThread.ProcessDirectory; +begin + if Assigned(FOnEnterDirectory) then + EnterDirectory; + ProcessDirFiles; +end; + +procedure TEnumFileThread.AsyncProcessDirectory(const Directory: string); +begin + FCurrentDirectory := Directory; + if Assigned(FOnEnterDirectory) then + Synchronize(EnterDirectory); + ProcessDirFiles; +end; + +procedure TEnumFileThread.SyncProcessDirectory(const Directory: string); +begin + FCurrentDirectory := Directory; + Synchronize(ProcessDirectory); +end; + +procedure TEnumFileThread.ProcessDirFiles; +begin + EnumFiles(FCurrentDirectory + '*', FInternalFileInfoHandler, FRejectedAttr, FRequiredAttr, @Terminated); +end; + +function TEnumFileThread.FileMatch: Boolean; +var + FileSize: Int64; +begin + {$IFDEF RTL220_UP} + Result := FileNameMatchesMask and (FFileInfo.TimeStamp >= FFileTimeMin) and (FFileInfo.TimeStamp <= FFileTimeMax); + {$ELSE ~RTL220_UP} + Result := FileNameMatchesMask and (FFileInfo.Time >= FFileTimeMin) and (FFileInfo.Time <= FFileTimeMax); + {$ENDIF ~RTL220_UP} + if Result then + begin + FileSize := GetSizeOfFile(FFileInfo); + Result := (FileSize >= FFileSizeMin) and (FileSize <= FFileSizeMax); + end; +end; + +function TEnumFileThread.FileNameMatchesMask: Boolean; +var + I: Integer; +begin + Result := AllNamesMatch; + if not Result then + for I := 0 to FileMasks.Count - 1 do + if IsFileNameMatch(FFileInfo.Name, FileMasks[I], CaseSensitiveSearch) then + begin + Result := True; + Break; + end; +end; + +procedure TEnumFileThread.ProcessFile; +begin + if Assigned(FFileHandlerEx) then + FFileHandlerEx(FCurrentDirectory, FFileInfo) + else + FFileHandler(FCurrentDirectory + FFileInfo.Name); +end; + +procedure TEnumFileThread.AsyncProcessFile(const FileInfo: TSearchRec); +begin + FFileInfo := FileInfo; + if FileMatch then + ProcessFile; +end; + +procedure TEnumFileThread.SyncProcessFile(const FileInfo: TSearchRec); +begin + FFileInfo := FileInfo; + if FileMatch then + Synchronize(ProcessFile); +end; + +function TEnumFileThread.GetDirectories: TStrings; +begin + Result := FDirectories; +end; + +function TEnumFileThread.GetFileMasks: TStrings; +begin + Result := FFileMasks; +end; + +procedure TEnumFileThread.SetDirectories(const Value: TStrings); +begin + FDirectories.Assign(Value); +end; + +procedure TEnumFileThread.SetFileMasks(const Value: TStrings); +var + I: Integer; +begin + FAllNamesMatch := Value.Count = 0; + for I := 0 to Value.Count - 1 do + if (Value[I] = '*') {$IFDEF MSWINDOWS} or (Value[I] = '*.*') {$ENDIF} then + begin + FAllNamesMatch := True; + Break; + end; + if FAllNamesMatch then + FileMasks.Clear + else + FileMasks.Assign(Value); +end; + +//=== { TJclFileEnumerator } ================================================= + +constructor TJclFileEnumerator.Create; +begin + inherited Create; + FTasks := TList.Create; +end; + +destructor TJclFileEnumerator.Destroy; +begin + StopAllTasks(True); + FTasks.Free; + inherited Destroy; +end; + +procedure TJclFileEnumerator.Assign(Source: TPersistent); +var + Src: TJclFileEnumerator; +begin + if Source is TJclFileEnumerator then + begin + Src := TJclFileEnumerator(Source); + SynchronizationMode := Src.SynchronizationMode; + OnEnterDirectory := Src.OnEnterDirectory; + OnTerminateTask := Src.OnTerminateTask; + end; + inherited Assign(Source); +end; + +function TJclFileEnumerator.CreateTask: TThread; +var + Task: TEnumFileThread; +begin + Task := TEnumFileThread.Create; + Task.FID := NextTaskID; + Task.CaseSensitiveSearch := FCaseSensitiveSearch; + Task.FileMasks := FileMasks; + Task.Directories := RootDirectories; + Task.RejectedAttr := AttributeMask.Rejected; + Task.RequiredAttr := AttributeMask.Required; + Task.IncludeSubDirectories := IncludeSubDirectories; + Task.IncludeHiddenSubDirectories := IncludeHiddenSubDirectories; + if fsMinSize in Options then + Task.FileSizeMin := FileSizeMin; + if fsMaxSize in Options then + Task.FileSizeMax := FileSizeMax; + if fsLastChangeAfter in Options then + Task.FFileTimeMin := {$IFDEF RTL220_UP}LastChangeAfter{$ELSE}DateTimeToFileDate(LastChangeAfter){$ENDIF}; + if fsLastChangeBefore in Options then + Task.FFileTimeMax := {$IFDEF RTL220_UP}LastChangeBefore{$ELSE}DateTimeToFileDate(LastChangeBefore){$ENDIF}; + Task.SynchronizationMode := SynchronizationMode; + Task.FOnEnterDirectory := OnEnterDirectory; + Task.OnTerminate := TaskTerminated; + FTasks.Add(Task); + if FRefCount > 0 then + _AddRef; + Result := Task; +end; + +function TJclFileEnumerator.FillList(List: TStrings): TFileSearchTaskID; +begin + List.BeginUpdate; + try + Result := ForEach(List.Append); + finally + List.EndUpdate; + end; +end; + +function TJclFileEnumerator.ForEach(Handler: TFileHandlerEx): TFileSearchTaskID; +var + Task: TEnumFileThread; +begin + Task := TEnumFileThread(CreateTask); + Task.FFileHandlerEx := Handler; + Result := Task.ID; + {$IFDEF RTL210_UP} + Task.Suspended := False; + {$ELSE ~RTL210_UP} + Task.Resume; + {$ENDIF ~RTL210_UP} +end; + +function TJclFileEnumerator.ForEach(Handler: TFileHandler): TFileSearchTaskID; +var + Task: TEnumFileThread; +begin + Task := TEnumFileThread(CreateTask); + Task.FFileHandler := Handler; + Result := Task.ID; + {$IFDEF RTL210_UP} + Task.Suspended := False; + {$ELSE ~RTL210_UP} + Task.Resume; + {$ENDIF ~RTL210_UP} +end; + +function TJclFileEnumerator.GetRunningTasks: Integer; +begin + Result := FTasks.Count; +end; + +procedure TJclFileEnumerator.StopTask(ID: TFileSearchTaskID); +var + Task: TEnumFileThread; + I: Integer; +begin + for I := 0 to FTasks.Count - 1 do + begin + Task := TEnumFileThread(FTasks[I]); + if Task.ID = ID then + begin + Task.Terminate; + Break; + end; + end; +end; + +procedure TJclFileEnumerator.StopAllTasks(Silently: Boolean = False); +var + I: Integer; +begin + for I := 0 to FTasks.Count - 1 do + begin + TEnumFileThread(FTasks[I]).FNotifyOnTermination := not Silently; + TEnumFileThread(FTasks[I]).Terminate; + end; +end; + +procedure TJclFileEnumerator.TaskTerminated(Sender: TObject); +begin + FTasks.Remove(Sender); + try + if Assigned(FOnTerminateTask) then + FOnTerminateTask(TEnumFileThread(Sender).ID, TEnumFileThread(Sender).Terminated); + finally + if FRefCount > 0 then + _Release; + end; +end; + +function TJclFileEnumerator.GetNextTaskID: TFileSearchTaskID; +begin + Result := FNextTaskID; + Inc(FNextTaskID); +end; + +function TJclFileEnumerator.GetOnEnterDirectory: TFileHandler; +begin + Result := FOnEnterDirectory; +end; + +function TJclFileEnumerator.GetOnTerminateTask: TFileSearchTerminationEvent; +begin + Result := FOnTerminateTask; +end; + +function TJclFileEnumerator.GetSynchronizationMode: TFileEnumeratorSyncMode; +begin + Result := FSynchronizationMode; +end; + +procedure TJclFileEnumerator.SetOnEnterDirectory( + const Value: TFileHandler); +begin + FOnEnterDirectory := Value; +end; + +procedure TJclFileEnumerator.SetOnTerminateTask( + const Value: TFileSearchTerminationEvent); +begin + FOnTerminateTask := Value; +end; + +procedure TJclFileEnumerator.SetSynchronizationMode( + const Value: TFileEnumeratorSyncMode); +begin + FSynchronizationMode := Value; +end; + +function FileSearch: IJclFileEnumerator; +begin + Result := TJclFileEnumerator.Create; +end; + +function SamePath(const Path1, Path2: string): Boolean; +begin + {$IFDEF MSWINDOWS} + Result := AnsiSameText(PathGetLongName(Path1), PathGetLongName(Path2)); + {$ELSE ~MSWINDOWS} + Result := Path1 = Path2; + {$ENDIF ~MSWINDOWS} +end; + +// add items at the end +procedure PathListAddItems(var List: string; const Items: string); +begin + ListAddItems(List, DirSeparator, Items); +end; + +// add items at the end if they are not present +procedure PathListIncludeItems(var List: string; const Items: string); +var + StrList, NewItems: TStringList; + IndexNew, IndexList: Integer; + Item: string; + Duplicate: Boolean; +begin + StrList := TStringList.Create; + try + StrToStrings(List, DirSeparator, StrList); + + NewItems := TStringList.Create; + try + StrToStrings(Items, DirSeparator, NewItems); + + for IndexNew := 0 to NewItems.Count - 1 do + begin + Item := NewItems.Strings[IndexNew]; + + Duplicate := False; + for IndexList := 0 to StrList.Count - 1 do + if SamePath(Item, StrList.Strings[IndexList]) then + begin + Duplicate := True; + Break; + end; + + if not Duplicate then + StrList.Add(Item); + end; + + List := StringsToStr(StrList, DirSeparator); + finally + NewItems.Free; + end; + finally + StrList.Free; + end; +end; + +// delete multiple items +procedure PathListDelItems(var List: string; const Items: string); +var + StrList, RemItems: TStringList; + IndexRem, IndexList: Integer; + Item: string; +begin + StrList := TStringList.Create; + try + StrToStrings(List, DirSeparator, StrList); + + RemItems := TStringList.Create; + try + StrToStrings(Items, DirSeparator, RemItems); + + for IndexRem := 0 to RemItems.Count - 1 do + begin + Item := RemItems.Strings[IndexRem]; + + for IndexList := StrList.Count - 1 downto 0 do + if SamePath(Item, StrList.Strings[IndexList]) then + StrList.Delete(IndexList); + end; + + List := StringsToStr(StrList, DirSeparator); + finally + RemItems.Free; + end; + finally + StrList.Free; + end; +end; + +// delete one item +procedure PathListDelItem(var List: string; const Index: Integer); +begin + ListDelItem(List, DirSeparator, Index); +end; + +// return the number of item +function PathListItemCount(const List: string): Integer; +begin + Result := ListItemCount(List, DirSeparator); +end; + +// return the Nth item +function PathListGetItem(const List: string; const Index: Integer): string; +begin + Result := ListGetItem(List, DirSeparator, Index); +end; + +// set the Nth item +procedure PathListSetItem(var List: string; const Index: Integer; const Value: string); +begin + ListSetItem(List, DirSeparator, Index, Value); +end; + +// return the index of an item +function PathListItemIndex(const List, Item: string): Integer; +var + StrList: TStringList; + IndexList: Integer; +begin + StrList := TStringList.Create; + try + StrToStrings(List, DirSeparator, StrList); + + Result := -1; + + for IndexList := 0 to StrList.Count - 1 do + if SamePath(StrList.Strings[IndexList], Item) then + begin + Result := IndexList; + Break; + end; + finally + StrList.Free; + end; +end; + + +// additional functions to access the commandline parameters of an application + +// returns the name of the command line parameter at position index, which is +// separated by the given separator, if the first character of the name part +// is one of the AllowedPrefixCharacters, this character will be deleted. +function ParamName(Index: Integer; const Separator: string; + const AllowedPrefixCharacters: string; TrimName: Boolean): string; +var + S: string; + P: Integer; +begin + if (Index > 0) and (Index <= ParamCount) then + begin + S := ParamStr(Index); + if Pos(Copy(S, 1, 1), AllowedPrefixCharacters) > 0 then + S := Copy(S, 2, Length(S) - 1); + P := Pos(Separator, S); + if P > 0 then + S := Copy(S, 1, P - 1); + if TrimName then + S := Trim(S); + Result := S; + end + else + Result := ''; +end; + +// returns the value of the command line parameter at position index, which is +// separated by the given separator +function ParamValue(Index: Integer; const Separator: string; TrimValue: Boolean): string; +var + S: string; + P: Integer; +begin + if (Index > 0) and (Index <= ParamCount) then + begin + S := ParamStr(Index); + P := Pos(Separator, S); + if P > 0 then + S := Copy(S, P + 1, Length(S) - P); + if TrimValue then + S := Trim(S); + Result := S; + end + else + Result := ''; +end; + +// seaches a command line parameter where the namepart is the searchname +// and returns the value which is which by the given separator. +// CaseSensitive defines the search type. if the first character of the name part +// is one of the AllowedPrefixCharacters, this character will be deleted. +function ParamValue(const SearchName: string; const Separator: string; + CaseSensitive: Boolean; const AllowedPrefixCharacters: string; + TrimValue: Boolean): string; +var + Name: string; + SearchS: String; + I: Integer; +begin + Result := ''; + SearchS := Trim(SearchName); + + for I := 1 to ParamCount do + begin + Name := ParamName(I, Separator, AllowedPrefixCharacters, True); + if (CaseSensitive and (Name = SearchS)) or + ((not CaseSensitive) and (CompareText(Name, SearchS) = 0)) then + begin + Result := ParamValue(I, Separator, TrimValue); + Exit; + end; + end; +end; + +// seaches a command line parameter where the namepart is the searchname +// and returns the position index. if no separator is defined, the full paramstr is compared. +// CaseSensitive defines the search type. if the first character of the name part +// is one of the AllowedPrefixCharacters, this character will be deleted. +function ParamPos(const SearchName: string; const Separator: string; + CaseSensitive: Boolean; const AllowedPrefixCharacters: string): Integer; +var + Name: string; + SearchS: string; + I: Integer; +begin + Result := -1; + SearchS := Trim(SearchName); + + for I := 1 to ParamCount do + begin + Name := ParamName(I, Separator, AllowedPrefixCharacters, True); + if (CaseSensitive and (Name = SearchS)) or + ((not CaseSensitive) and (CompareText(Name, SearchS) = 0)) then + begin + Result := I; + Exit; + end; + end; +end; + + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclHashMaps.pas b/3rdParty/JCL/source/common/JclHashMaps.pas new file mode 100644 index 00000000..380b69ad --- /dev/null +++ b/3rdParty/JCL/source/common/JclHashMaps.pas @@ -0,0 +1,31315 @@ +{**************************************************************************************************} +{ WARNING: JEDI preprocessor generated unit. Do not edit. } +{**************************************************************************************************} + +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is HashMap.pas. } +{ } +{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } +{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } +{ All rights reserved. } +{ } +{ Contributors: } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclHashMaps; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Classes, + {$ENDIF ~HAS_UNITSCOPE} + JclAlgorithms, + JclBase, JclSynch, + JclContainerIntf, JclAbstractContainers, JclArrayLists, JclArraySets; + + +type + TJclIntfIntfHashMapEntry = record + Key: IInterface; + Value: IInterface; + end; + + TJclIntfIntfHashMapEntryArray = array of TJclIntfIntfHashMapEntry; + + TJclIntfIntfHashMapBucket = class + public + Size: Integer; + Entries: TJclIntfIntfHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclIntfIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclIntfIntfHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclIntfIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclIntfIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclIntfIntfHashMap = class(TJclIntfAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclIntfContainer, + IJclIntfIntfMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: IInterface): IInterface; + function FreeValue(var Value: IInterface): IInterface; + function KeysEqual(const A, B: IInterface): Boolean; + function ValuesEqual(const A, B: IInterface): Boolean; + private + FBuckets: array of TJclIntfIntfHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclIntfIntfMap } + procedure Clear; + function ContainsKey(const Key: IInterface): Boolean; + function ContainsValue(const Value: IInterface): Boolean; + function Extract(const Key: IInterface): IInterface; + function GetValue(const Key: IInterface): IInterface; + function IsEmpty: Boolean; + function KeyOfValue(const Value: IInterface): IInterface; + function KeySet: IJclIntfSet; + function Keys: IJclIntfCollection; + function MapEquals(const AMap: IJclIntfIntfMap): Boolean; + procedure PutAll(const AMap: IJclIntfIntfMap); + procedure PutValue(const Key: IInterface; const Value: IInterface); + function Remove(const Key: IInterface): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + end; + + TJclAnsiStrIntfHashMapEntry = record + Key: AnsiString; + Value: IInterface; + end; + + TJclAnsiStrIntfHashMapEntryArray = array of TJclAnsiStrIntfHashMapEntry; + + TJclAnsiStrIntfHashMapBucket = class + public + Size: Integer; + Entries: TJclAnsiStrIntfHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclAnsiStrIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclAnsiStrIntfHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclAnsiStrIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclAnsiStrIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclAnsiStrIntfHashMap = class(TJclAnsiStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclStrBaseContainer, IJclAnsiStrContainer, IJclIntfContainer, + IJclAnsiStrIntfMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: AnsiString): AnsiString; + function FreeValue(var Value: IInterface): IInterface; + function KeysEqual(const A, B: AnsiString): Boolean; + function ValuesEqual(const A, B: IInterface): Boolean; + private + FBuckets: array of TJclAnsiStrIntfHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclAnsiStrIntfMap } + procedure Clear; + function ContainsKey(const Key: AnsiString): Boolean; + function ContainsValue(const Value: IInterface): Boolean; + function Extract(const Key: AnsiString): IInterface; + function GetValue(const Key: AnsiString): IInterface; + function IsEmpty: Boolean; + function KeyOfValue(const Value: IInterface): AnsiString; + function KeySet: IJclAnsiStrSet; + function Keys: IJclAnsiStrCollection; + function MapEquals(const AMap: IJclAnsiStrIntfMap): Boolean; + procedure PutAll(const AMap: IJclAnsiStrIntfMap); + procedure PutValue(const Key: AnsiString; const Value: IInterface); + function Remove(const Key: AnsiString): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + end; + + TJclIntfAnsiStrHashMapEntry = record + Key: IInterface; + Value: AnsiString; + end; + + TJclIntfAnsiStrHashMapEntryArray = array of TJclIntfAnsiStrHashMapEntry; + + TJclIntfAnsiStrHashMapBucket = class + public + Size: Integer; + Entries: TJclIntfAnsiStrHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclIntfAnsiStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclIntfAnsiStrHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclIntfAnsiStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclIntfAnsiStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclIntfAnsiStrHashMap = class(TJclAnsiStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclStrBaseContainer, IJclIntfContainer, IJclAnsiStrContainer, + IJclIntfAnsiStrMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: IInterface): IInterface; + function FreeValue(var Value: AnsiString): AnsiString; + function Hash(const AInterface: IInterface): Integer; reintroduce; + function KeysEqual(const A, B: IInterface): Boolean; + function ValuesEqual(const A, B: AnsiString): Boolean; + private + FBuckets: array of TJclIntfAnsiStrHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclIntfAnsiStrMap } + procedure Clear; + function ContainsKey(const Key: IInterface): Boolean; + function ContainsValue(const Value: AnsiString): Boolean; + function Extract(const Key: IInterface): AnsiString; + function GetValue(const Key: IInterface): AnsiString; + function IsEmpty: Boolean; + function KeyOfValue(const Value: AnsiString): IInterface; + function KeySet: IJclIntfSet; + function Keys: IJclIntfCollection; + function MapEquals(const AMap: IJclIntfAnsiStrMap): Boolean; + procedure PutAll(const AMap: IJclIntfAnsiStrMap); + procedure PutValue(const Key: IInterface; const Value: AnsiString); + function Remove(const Key: IInterface): AnsiString; + function Size: Integer; + function Values: IJclAnsiStrCollection; + end; + + TJclAnsiStrAnsiStrHashMapEntry = record + Key: AnsiString; + Value: AnsiString; + end; + + TJclAnsiStrAnsiStrHashMapEntryArray = array of TJclAnsiStrAnsiStrHashMapEntry; + + TJclAnsiStrAnsiStrHashMapBucket = class + public + Size: Integer; + Entries: TJclAnsiStrAnsiStrHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclAnsiStrAnsiStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclAnsiStrAnsiStrHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclAnsiStrAnsiStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclAnsiStrAnsiStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclAnsiStrAnsiStrHashMap = class(TJclAnsiStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclStrBaseContainer, IJclAnsiStrContainer, + IJclAnsiStrAnsiStrMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: AnsiString): AnsiString; + function FreeValue(var Value: AnsiString): AnsiString; + function KeysEqual(const A, B: AnsiString): Boolean; + function ValuesEqual(const A, B: AnsiString): Boolean; + private + FBuckets: array of TJclAnsiStrAnsiStrHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclAnsiStrAnsiStrMap } + procedure Clear; + function ContainsKey(const Key: AnsiString): Boolean; + function ContainsValue(const Value: AnsiString): Boolean; + function Extract(const Key: AnsiString): AnsiString; + function GetValue(const Key: AnsiString): AnsiString; + function IsEmpty: Boolean; + function KeyOfValue(const Value: AnsiString): AnsiString; + function KeySet: IJclAnsiStrSet; + function Keys: IJclAnsiStrCollection; + function MapEquals(const AMap: IJclAnsiStrAnsiStrMap): Boolean; + procedure PutAll(const AMap: IJclAnsiStrAnsiStrMap); + procedure PutValue(const Key: AnsiString; const Value: AnsiString); + function Remove(const Key: AnsiString): AnsiString; + function Size: Integer; + function Values: IJclAnsiStrCollection; + end; + + TJclWideStrIntfHashMapEntry = record + Key: WideString; + Value: IInterface; + end; + + TJclWideStrIntfHashMapEntryArray = array of TJclWideStrIntfHashMapEntry; + + TJclWideStrIntfHashMapBucket = class + public + Size: Integer; + Entries: TJclWideStrIntfHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclWideStrIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclWideStrIntfHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclWideStrIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclWideStrIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclWideStrIntfHashMap = class(TJclWideStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclStrBaseContainer, IJclWideStrContainer, IJclIntfContainer, + IJclWideStrIntfMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: WideString): WideString; + function FreeValue(var Value: IInterface): IInterface; + function KeysEqual(const A, B: WideString): Boolean; + function ValuesEqual(const A, B: IInterface): Boolean; + private + FBuckets: array of TJclWideStrIntfHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclWideStrIntfMap } + procedure Clear; + function ContainsKey(const Key: WideString): Boolean; + function ContainsValue(const Value: IInterface): Boolean; + function Extract(const Key: WideString): IInterface; + function GetValue(const Key: WideString): IInterface; + function IsEmpty: Boolean; + function KeyOfValue(const Value: IInterface): WideString; + function KeySet: IJclWideStrSet; + function Keys: IJclWideStrCollection; + function MapEquals(const AMap: IJclWideStrIntfMap): Boolean; + procedure PutAll(const AMap: IJclWideStrIntfMap); + procedure PutValue(const Key: WideString; const Value: IInterface); + function Remove(const Key: WideString): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + end; + + TJclIntfWideStrHashMapEntry = record + Key: IInterface; + Value: WideString; + end; + + TJclIntfWideStrHashMapEntryArray = array of TJclIntfWideStrHashMapEntry; + + TJclIntfWideStrHashMapBucket = class + public + Size: Integer; + Entries: TJclIntfWideStrHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclIntfWideStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclIntfWideStrHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclIntfWideStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclIntfWideStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclIntfWideStrHashMap = class(TJclWideStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclStrBaseContainer, IJclIntfContainer, IJclWideStrContainer, + IJclIntfWideStrMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: IInterface): IInterface; + function FreeValue(var Value: WideString): WideString; + function Hash(const AInterface: IInterface): Integer; reintroduce; + function KeysEqual(const A, B: IInterface): Boolean; + function ValuesEqual(const A, B: WideString): Boolean; + private + FBuckets: array of TJclIntfWideStrHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclIntfWideStrMap } + procedure Clear; + function ContainsKey(const Key: IInterface): Boolean; + function ContainsValue(const Value: WideString): Boolean; + function Extract(const Key: IInterface): WideString; + function GetValue(const Key: IInterface): WideString; + function IsEmpty: Boolean; + function KeyOfValue(const Value: WideString): IInterface; + function KeySet: IJclIntfSet; + function Keys: IJclIntfCollection; + function MapEquals(const AMap: IJclIntfWideStrMap): Boolean; + procedure PutAll(const AMap: IJclIntfWideStrMap); + procedure PutValue(const Key: IInterface; const Value: WideString); + function Remove(const Key: IInterface): WideString; + function Size: Integer; + function Values: IJclWideStrCollection; + end; + + TJclWideStrWideStrHashMapEntry = record + Key: WideString; + Value: WideString; + end; + + TJclWideStrWideStrHashMapEntryArray = array of TJclWideStrWideStrHashMapEntry; + + TJclWideStrWideStrHashMapBucket = class + public + Size: Integer; + Entries: TJclWideStrWideStrHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclWideStrWideStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclWideStrWideStrHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclWideStrWideStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclWideStrWideStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclWideStrWideStrHashMap = class(TJclWideStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclStrBaseContainer, IJclWideStrContainer, + IJclWideStrWideStrMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: WideString): WideString; + function FreeValue(var Value: WideString): WideString; + function KeysEqual(const A, B: WideString): Boolean; + function ValuesEqual(const A, B: WideString): Boolean; + private + FBuckets: array of TJclWideStrWideStrHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclWideStrWideStrMap } + procedure Clear; + function ContainsKey(const Key: WideString): Boolean; + function ContainsValue(const Value: WideString): Boolean; + function Extract(const Key: WideString): WideString; + function GetValue(const Key: WideString): WideString; + function IsEmpty: Boolean; + function KeyOfValue(const Value: WideString): WideString; + function KeySet: IJclWideStrSet; + function Keys: IJclWideStrCollection; + function MapEquals(const AMap: IJclWideStrWideStrMap): Boolean; + procedure PutAll(const AMap: IJclWideStrWideStrMap); + procedure PutValue(const Key: WideString; const Value: WideString); + function Remove(const Key: WideString): WideString; + function Size: Integer; + function Values: IJclWideStrCollection; + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclUnicodeStrIntfHashMapEntry = record + Key: UnicodeString; + Value: IInterface; + end; + + TJclUnicodeStrIntfHashMapEntryArray = array of TJclUnicodeStrIntfHashMapEntry; + + TJclUnicodeStrIntfHashMapBucket = class + public + Size: Integer; + Entries: TJclUnicodeStrIntfHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclUnicodeStrIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclUnicodeStrIntfHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclUnicodeStrIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclUnicodeStrIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclUnicodeStrIntfHashMap = class(TJclUnicodeStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclStrBaseContainer, IJclUnicodeStrContainer, IJclIntfContainer, + IJclUnicodeStrIntfMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: UnicodeString): UnicodeString; + function FreeValue(var Value: IInterface): IInterface; + function KeysEqual(const A, B: UnicodeString): Boolean; + function ValuesEqual(const A, B: IInterface): Boolean; + private + FBuckets: array of TJclUnicodeStrIntfHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclUnicodeStrIntfMap } + procedure Clear; + function ContainsKey(const Key: UnicodeString): Boolean; + function ContainsValue(const Value: IInterface): Boolean; + function Extract(const Key: UnicodeString): IInterface; + function GetValue(const Key: UnicodeString): IInterface; + function IsEmpty: Boolean; + function KeyOfValue(const Value: IInterface): UnicodeString; + function KeySet: IJclUnicodeStrSet; + function Keys: IJclUnicodeStrCollection; + function MapEquals(const AMap: IJclUnicodeStrIntfMap): Boolean; + procedure PutAll(const AMap: IJclUnicodeStrIntfMap); + procedure PutValue(const Key: UnicodeString; const Value: IInterface); + function Remove(const Key: UnicodeString): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclIntfUnicodeStrHashMapEntry = record + Key: IInterface; + Value: UnicodeString; + end; + + TJclIntfUnicodeStrHashMapEntryArray = array of TJclIntfUnicodeStrHashMapEntry; + + TJclIntfUnicodeStrHashMapBucket = class + public + Size: Integer; + Entries: TJclIntfUnicodeStrHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclIntfUnicodeStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclIntfUnicodeStrHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclIntfUnicodeStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclIntfUnicodeStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclIntfUnicodeStrHashMap = class(TJclUnicodeStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclStrBaseContainer, IJclIntfContainer, IJclUnicodeStrContainer, + IJclIntfUnicodeStrMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: IInterface): IInterface; + function FreeValue(var Value: UnicodeString): UnicodeString; + function Hash(const AInterface: IInterface): Integer; reintroduce; + function KeysEqual(const A, B: IInterface): Boolean; + function ValuesEqual(const A, B: UnicodeString): Boolean; + private + FBuckets: array of TJclIntfUnicodeStrHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclIntfUnicodeStrMap } + procedure Clear; + function ContainsKey(const Key: IInterface): Boolean; + function ContainsValue(const Value: UnicodeString): Boolean; + function Extract(const Key: IInterface): UnicodeString; + function GetValue(const Key: IInterface): UnicodeString; + function IsEmpty: Boolean; + function KeyOfValue(const Value: UnicodeString): IInterface; + function KeySet: IJclIntfSet; + function Keys: IJclIntfCollection; + function MapEquals(const AMap: IJclIntfUnicodeStrMap): Boolean; + procedure PutAll(const AMap: IJclIntfUnicodeStrMap); + procedure PutValue(const Key: IInterface; const Value: UnicodeString); + function Remove(const Key: IInterface): UnicodeString; + function Size: Integer; + function Values: IJclUnicodeStrCollection; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclUnicodeStrUnicodeStrHashMapEntry = record + Key: UnicodeString; + Value: UnicodeString; + end; + + TJclUnicodeStrUnicodeStrHashMapEntryArray = array of TJclUnicodeStrUnicodeStrHashMapEntry; + + TJclUnicodeStrUnicodeStrHashMapBucket = class + public + Size: Integer; + Entries: TJclUnicodeStrUnicodeStrHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclUnicodeStrUnicodeStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclUnicodeStrUnicodeStrHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclUnicodeStrUnicodeStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclUnicodeStrUnicodeStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclUnicodeStrUnicodeStrHashMap = class(TJclUnicodeStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclStrBaseContainer, IJclUnicodeStrContainer, + IJclUnicodeStrUnicodeStrMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: UnicodeString): UnicodeString; + function FreeValue(var Value: UnicodeString): UnicodeString; + function KeysEqual(const A, B: UnicodeString): Boolean; + function ValuesEqual(const A, B: UnicodeString): Boolean; + private + FBuckets: array of TJclUnicodeStrUnicodeStrHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclUnicodeStrUnicodeStrMap } + procedure Clear; + function ContainsKey(const Key: UnicodeString): Boolean; + function ContainsValue(const Value: UnicodeString): Boolean; + function Extract(const Key: UnicodeString): UnicodeString; + function GetValue(const Key: UnicodeString): UnicodeString; + function IsEmpty: Boolean; + function KeyOfValue(const Value: UnicodeString): UnicodeString; + function KeySet: IJclUnicodeStrSet; + function Keys: IJclUnicodeStrCollection; + function MapEquals(const AMap: IJclUnicodeStrUnicodeStrMap): Boolean; + procedure PutAll(const AMap: IJclUnicodeStrUnicodeStrMap); + procedure PutValue(const Key: UnicodeString; const Value: UnicodeString); + function Remove(const Key: UnicodeString): UnicodeString; + function Size: Integer; + function Values: IJclUnicodeStrCollection; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + TJclStrIntfHashMapEntry = TJclAnsiStrIntfHashMapEntry; + TJclStrIntfHashMapBucket = TJclAnsiStrIntfHashMapBucket; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TJclStrIntfHashMapEntry = TJclWideStrIntfHashMapEntry; + TJclStrIntfHashMapBucket = TJclWideStrIntfHashMapBucket; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TJclStrIntfHashMapEntry = TJclUnicodeStrIntfHashMapEntry; + TJclStrIntfHashMapBucket = TJclUnicodeStrIntfHashMapBucket; + {$ENDIF CONTAINER_UNICODESTR} + + {$IFDEF CONTAINER_ANSISTR} + TJclStrIntfHashMap = TJclAnsiStrIntfHashMap; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TJclStrIntfHashMap = TJclWideStrIntfHashMap; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TJclStrIntfHashMap = TJclUnicodeStrIntfHashMap; + {$ENDIF CONTAINER_UNICODESTR} + + {$IFDEF CONTAINER_ANSISTR} + TJclIntfStrHashMapEntry = TJclIntfAnsiStrHashMapEntry; + TJclIntfStrHashMapBucket = TJclIntfAnsiStrHashMapBucket; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TJclIntfStrHashMapEntry = TJclIntfWideStrHashMapEntry; + TJclIntfStrHashMapBucket = TJclIntfWideStrHashMapBucket; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TJclIntfStrHashMapEntry = TJclIntfUnicodeStrHashMapEntry; + TJclIntfStrHashMapBucket = TJclIntfUnicodeStrHashMapBucket; + {$ENDIF CONTAINER_UNICODESTR} + + {$IFDEF CONTAINER_ANSISTR} + TJclIntfStrHashMap = TJclIntfAnsiStrHashMap; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TJclIntfStrHashMap = TJclIntfWideStrHashMap; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TJclIntfStrHashMap = TJclIntfUnicodeStrHashMap; + {$ENDIF CONTAINER_UNICODESTR} + + {$IFDEF CONTAINER_ANSISTR} + TJclStrStrHashMapEntry = TJclAnsiStrAnsiStrHashMapEntry; + TJclStrStrHashMapBucket = TJclAnsiStrAnsiStrHashMapBucket; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TJclStrStrHashMapEntry = TJclWideStrWideStrHashMapEntry; + TJclStrStrHashMapBucket = TJclWideStrWideStrHashMapBucket; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TJclStrStrHashMapEntry = TJclUnicodeStrUnicodeStrHashMapEntry; + TJclStrStrHashMapBucket = TJclUnicodeStrUnicodeStrHashMapBucket; + {$ENDIF CONTAINER_UNICODESTR} + + {$IFDEF CONTAINER_ANSISTR} + TJclStrStrHashMap = TJclAnsiStrAnsiStrHashMap; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TJclStrStrHashMap = TJclWideStrWideStrHashMap; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TJclStrStrHashMap = TJclUnicodeStrUnicodeStrHashMap; + {$ENDIF CONTAINER_UNICODESTR} + + TJclSingleIntfHashMapEntry = record + Key: Single; + Value: IInterface; + end; + + TJclSingleIntfHashMapEntryArray = array of TJclSingleIntfHashMapEntry; + + TJclSingleIntfHashMapBucket = class + public + Size: Integer; + Entries: TJclSingleIntfHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclSingleIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclSingleIntfHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclSingleIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclSingleIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclSingleIntfHashMap = class(TJclSingleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclSingleContainer, IJclIntfContainer, + IJclSingleIntfMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: Single): Single; + function FreeValue(var Value: IInterface): IInterface; + function KeysEqual(const A, B: Single): Boolean; + function ValuesEqual(const A, B: IInterface): Boolean; + private + FBuckets: array of TJclSingleIntfHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclSingleIntfMap } + procedure Clear; + function ContainsKey(const Key: Single): Boolean; + function ContainsValue(const Value: IInterface): Boolean; + function Extract(const Key: Single): IInterface; + function GetValue(const Key: Single): IInterface; + function IsEmpty: Boolean; + function KeyOfValue(const Value: IInterface): Single; + function KeySet: IJclSingleSet; + function Keys: IJclSingleCollection; + function MapEquals(const AMap: IJclSingleIntfMap): Boolean; + procedure PutAll(const AMap: IJclSingleIntfMap); + procedure PutValue(const Key: Single; const Value: IInterface); + function Remove(const Key: Single): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + end; + + TJclIntfSingleHashMapEntry = record + Key: IInterface; + Value: Single; + end; + + TJclIntfSingleHashMapEntryArray = array of TJclIntfSingleHashMapEntry; + + TJclIntfSingleHashMapBucket = class + public + Size: Integer; + Entries: TJclIntfSingleHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclIntfSingleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclIntfSingleHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclIntfSingleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclIntfSingleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclIntfSingleHashMap = class(TJclSingleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclIntfContainer, IJclSingleContainer, + IJclIntfSingleMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: IInterface): IInterface; + function FreeValue(var Value: Single): Single; + function Hash(const AInterface: IInterface): Integer; reintroduce; + function KeysEqual(const A, B: IInterface): Boolean; + function ValuesEqual(const A, B: Single): Boolean; + private + FBuckets: array of TJclIntfSingleHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclIntfSingleMap } + procedure Clear; + function ContainsKey(const Key: IInterface): Boolean; + function ContainsValue(const Value: Single): Boolean; + function Extract(const Key: IInterface): Single; + function GetValue(const Key: IInterface): Single; + function IsEmpty: Boolean; + function KeyOfValue(const Value: Single): IInterface; + function KeySet: IJclIntfSet; + function Keys: IJclIntfCollection; + function MapEquals(const AMap: IJclIntfSingleMap): Boolean; + procedure PutAll(const AMap: IJclIntfSingleMap); + procedure PutValue(const Key: IInterface; const Value: Single); + function Remove(const Key: IInterface): Single; + function Size: Integer; + function Values: IJclSingleCollection; + end; + + TJclSingleSingleHashMapEntry = record + Key: Single; + Value: Single; + end; + + TJclSingleSingleHashMapEntryArray = array of TJclSingleSingleHashMapEntry; + + TJclSingleSingleHashMapBucket = class + public + Size: Integer; + Entries: TJclSingleSingleHashMapEntryArray; + procedure InitializeArrayAfterMove(var List: TJclSingleSingleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure MoveArray(var List: TJclSingleSingleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclSingleSingleHashMap = class(TJclSingleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclSingleContainer, + IJclSingleSingleMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: Single): Single; + function FreeValue(var Value: Single): Single; + function KeysEqual(const A, B: Single): Boolean; + function ValuesEqual(const A, B: Single): Boolean; + private + FBuckets: array of TJclSingleSingleHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclSingleSingleMap } + procedure Clear; + function ContainsKey(const Key: Single): Boolean; + function ContainsValue(const Value: Single): Boolean; + function Extract(const Key: Single): Single; + function GetValue(const Key: Single): Single; + function IsEmpty: Boolean; + function KeyOfValue(const Value: Single): Single; + function KeySet: IJclSingleSet; + function Keys: IJclSingleCollection; + function MapEquals(const AMap: IJclSingleSingleMap): Boolean; + procedure PutAll(const AMap: IJclSingleSingleMap); + procedure PutValue(const Key: Single; const Value: Single); + function Remove(const Key: Single): Single; + function Size: Integer; + function Values: IJclSingleCollection; + end; + + TJclDoubleIntfHashMapEntry = record + Key: Double; + Value: IInterface; + end; + + TJclDoubleIntfHashMapEntryArray = array of TJclDoubleIntfHashMapEntry; + + TJclDoubleIntfHashMapBucket = class + public + Size: Integer; + Entries: TJclDoubleIntfHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclDoubleIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclDoubleIntfHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclDoubleIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclDoubleIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclDoubleIntfHashMap = class(TJclDoubleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclDoubleContainer, IJclIntfContainer, + IJclDoubleIntfMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: Double): Double; + function FreeValue(var Value: IInterface): IInterface; + function KeysEqual(const A, B: Double): Boolean; + function ValuesEqual(const A, B: IInterface): Boolean; + private + FBuckets: array of TJclDoubleIntfHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclDoubleIntfMap } + procedure Clear; + function ContainsKey(const Key: Double): Boolean; + function ContainsValue(const Value: IInterface): Boolean; + function Extract(const Key: Double): IInterface; + function GetValue(const Key: Double): IInterface; + function IsEmpty: Boolean; + function KeyOfValue(const Value: IInterface): Double; + function KeySet: IJclDoubleSet; + function Keys: IJclDoubleCollection; + function MapEquals(const AMap: IJclDoubleIntfMap): Boolean; + procedure PutAll(const AMap: IJclDoubleIntfMap); + procedure PutValue(const Key: Double; const Value: IInterface); + function Remove(const Key: Double): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + end; + + TJclIntfDoubleHashMapEntry = record + Key: IInterface; + Value: Double; + end; + + TJclIntfDoubleHashMapEntryArray = array of TJclIntfDoubleHashMapEntry; + + TJclIntfDoubleHashMapBucket = class + public + Size: Integer; + Entries: TJclIntfDoubleHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclIntfDoubleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclIntfDoubleHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclIntfDoubleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclIntfDoubleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclIntfDoubleHashMap = class(TJclDoubleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclIntfContainer, IJclDoubleContainer, + IJclIntfDoubleMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: IInterface): IInterface; + function FreeValue(var Value: Double): Double; + function Hash(const AInterface: IInterface): Integer; reintroduce; + function KeysEqual(const A, B: IInterface): Boolean; + function ValuesEqual(const A, B: Double): Boolean; + private + FBuckets: array of TJclIntfDoubleHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclIntfDoubleMap } + procedure Clear; + function ContainsKey(const Key: IInterface): Boolean; + function ContainsValue(const Value: Double): Boolean; + function Extract(const Key: IInterface): Double; + function GetValue(const Key: IInterface): Double; + function IsEmpty: Boolean; + function KeyOfValue(const Value: Double): IInterface; + function KeySet: IJclIntfSet; + function Keys: IJclIntfCollection; + function MapEquals(const AMap: IJclIntfDoubleMap): Boolean; + procedure PutAll(const AMap: IJclIntfDoubleMap); + procedure PutValue(const Key: IInterface; const Value: Double); + function Remove(const Key: IInterface): Double; + function Size: Integer; + function Values: IJclDoubleCollection; + end; + + TJclDoubleDoubleHashMapEntry = record + Key: Double; + Value: Double; + end; + + TJclDoubleDoubleHashMapEntryArray = array of TJclDoubleDoubleHashMapEntry; + + TJclDoubleDoubleHashMapBucket = class + public + Size: Integer; + Entries: TJclDoubleDoubleHashMapEntryArray; + procedure InitializeArrayAfterMove(var List: TJclDoubleDoubleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure MoveArray(var List: TJclDoubleDoubleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclDoubleDoubleHashMap = class(TJclDoubleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclDoubleContainer, + IJclDoubleDoubleMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: Double): Double; + function FreeValue(var Value: Double): Double; + function KeysEqual(const A, B: Double): Boolean; + function ValuesEqual(const A, B: Double): Boolean; + private + FBuckets: array of TJclDoubleDoubleHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclDoubleDoubleMap } + procedure Clear; + function ContainsKey(const Key: Double): Boolean; + function ContainsValue(const Value: Double): Boolean; + function Extract(const Key: Double): Double; + function GetValue(const Key: Double): Double; + function IsEmpty: Boolean; + function KeyOfValue(const Value: Double): Double; + function KeySet: IJclDoubleSet; + function Keys: IJclDoubleCollection; + function MapEquals(const AMap: IJclDoubleDoubleMap): Boolean; + procedure PutAll(const AMap: IJclDoubleDoubleMap); + procedure PutValue(const Key: Double; const Value: Double); + function Remove(const Key: Double): Double; + function Size: Integer; + function Values: IJclDoubleCollection; + end; + + TJclExtendedIntfHashMapEntry = record + Key: Extended; + Value: IInterface; + end; + + TJclExtendedIntfHashMapEntryArray = array of TJclExtendedIntfHashMapEntry; + + TJclExtendedIntfHashMapBucket = class + public + Size: Integer; + Entries: TJclExtendedIntfHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclExtendedIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclExtendedIntfHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclExtendedIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclExtendedIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclExtendedIntfHashMap = class(TJclExtendedAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclExtendedContainer, IJclIntfContainer, + IJclExtendedIntfMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: Extended): Extended; + function FreeValue(var Value: IInterface): IInterface; + function KeysEqual(const A, B: Extended): Boolean; + function ValuesEqual(const A, B: IInterface): Boolean; + private + FBuckets: array of TJclExtendedIntfHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclExtendedIntfMap } + procedure Clear; + function ContainsKey(const Key: Extended): Boolean; + function ContainsValue(const Value: IInterface): Boolean; + function Extract(const Key: Extended): IInterface; + function GetValue(const Key: Extended): IInterface; + function IsEmpty: Boolean; + function KeyOfValue(const Value: IInterface): Extended; + function KeySet: IJclExtendedSet; + function Keys: IJclExtendedCollection; + function MapEquals(const AMap: IJclExtendedIntfMap): Boolean; + procedure PutAll(const AMap: IJclExtendedIntfMap); + procedure PutValue(const Key: Extended; const Value: IInterface); + function Remove(const Key: Extended): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + end; + + TJclIntfExtendedHashMapEntry = record + Key: IInterface; + Value: Extended; + end; + + TJclIntfExtendedHashMapEntryArray = array of TJclIntfExtendedHashMapEntry; + + TJclIntfExtendedHashMapBucket = class + public + Size: Integer; + Entries: TJclIntfExtendedHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclIntfExtendedHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclIntfExtendedHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclIntfExtendedHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclIntfExtendedHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclIntfExtendedHashMap = class(TJclExtendedAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclIntfContainer, IJclExtendedContainer, + IJclIntfExtendedMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: IInterface): IInterface; + function FreeValue(var Value: Extended): Extended; + function Hash(const AInterface: IInterface): Integer; reintroduce; + function KeysEqual(const A, B: IInterface): Boolean; + function ValuesEqual(const A, B: Extended): Boolean; + private + FBuckets: array of TJclIntfExtendedHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclIntfExtendedMap } + procedure Clear; + function ContainsKey(const Key: IInterface): Boolean; + function ContainsValue(const Value: Extended): Boolean; + function Extract(const Key: IInterface): Extended; + function GetValue(const Key: IInterface): Extended; + function IsEmpty: Boolean; + function KeyOfValue(const Value: Extended): IInterface; + function KeySet: IJclIntfSet; + function Keys: IJclIntfCollection; + function MapEquals(const AMap: IJclIntfExtendedMap): Boolean; + procedure PutAll(const AMap: IJclIntfExtendedMap); + procedure PutValue(const Key: IInterface; const Value: Extended); + function Remove(const Key: IInterface): Extended; + function Size: Integer; + function Values: IJclExtendedCollection; + end; + + TJclExtendedExtendedHashMapEntry = record + Key: Extended; + Value: Extended; + end; + + TJclExtendedExtendedHashMapEntryArray = array of TJclExtendedExtendedHashMapEntry; + + TJclExtendedExtendedHashMapBucket = class + public + Size: Integer; + Entries: TJclExtendedExtendedHashMapEntryArray; + procedure InitializeArrayAfterMove(var List: TJclExtendedExtendedHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure MoveArray(var List: TJclExtendedExtendedHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclExtendedExtendedHashMap = class(TJclExtendedAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclExtendedContainer, + IJclExtendedExtendedMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: Extended): Extended; + function FreeValue(var Value: Extended): Extended; + function KeysEqual(const A, B: Extended): Boolean; + function ValuesEqual(const A, B: Extended): Boolean; + private + FBuckets: array of TJclExtendedExtendedHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclExtendedExtendedMap } + procedure Clear; + function ContainsKey(const Key: Extended): Boolean; + function ContainsValue(const Value: Extended): Boolean; + function Extract(const Key: Extended): Extended; + function GetValue(const Key: Extended): Extended; + function IsEmpty: Boolean; + function KeyOfValue(const Value: Extended): Extended; + function KeySet: IJclExtendedSet; + function Keys: IJclExtendedCollection; + function MapEquals(const AMap: IJclExtendedExtendedMap): Boolean; + procedure PutAll(const AMap: IJclExtendedExtendedMap); + procedure PutValue(const Key: Extended; const Value: Extended); + function Remove(const Key: Extended): Extended; + function Size: Integer; + function Values: IJclExtendedCollection; + end; + + {$IFDEF MATH_SINGLE_PRECISION} + TJclFloatIntfHashMapEntry = TJclSingleIntfHashMapEntry; + TJclFloatIntfHashMapBucket = TJclSingleIntfHashMapBucket; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TJclFloatIntfHashMapEntry = TJclDoubleIntfHashMapEntry; + TJclFloatIntfHashMapBucket = TJclDoubleIntfHashMapBucket; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TJclFloatIntfHashMapEntry = TJclExtendedIntfHashMapEntry; + TJclFloatIntfHashMapBucket = TJclExtendedIntfHashMapBucket; + {$ENDIF MATH_EXTENDED_PRECISION} + + {$IFDEF MATH_SINGLE_PRECISION} + TJclFloatIntfHashMap = TJclSingleIntfHashMap; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TJclFloatIntfHashMap = TJclDoubleIntfHashMap; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TJclFloatIntfHashMap = TJclExtendedIntfHashMap; + {$ENDIF MATH_EXTENDED_PRECISION} + + {$IFDEF MATH_SINGLE_PRECISION} + TJclIntfFloatHashMapEntry = TJclIntfSingleHashMapEntry; + TJclIntfFloatHashMapBucket = TJclIntfSingleHashMapBucket; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TJclIntfFloatHashMapEntry = TJclIntfDoubleHashMapEntry; + TJclIntfFloatHashMapBucket = TJclIntfDoubleHashMapBucket; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TJclIntfFloatHashMapEntry = TJclIntfExtendedHashMapEntry; + TJclIntfFloatHashMapBucket = TJclIntfExtendedHashMapBucket; + {$ENDIF MATH_EXTENDED_PRECISION} + + {$IFDEF MATH_SINGLE_PRECISION} + TJclIntfFloatHashMap = TJclIntfSingleHashMap; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TJclIntfFloatHashMap = TJclIntfDoubleHashMap; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TJclIntfFloatHashMap = TJclIntfExtendedHashMap; + {$ENDIF MATH_EXTENDED_PRECISION} + + {$IFDEF MATH_SINGLE_PRECISION} + TJclFloatFloatHashMapEntry = TJclSingleSingleHashMapEntry; + TJclFloatFloatHashMapBucket = TJclSingleSingleHashMapBucket; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TJclFloatFloatHashMapEntry = TJclDoubleDoubleHashMapEntry; + TJclFloatFloatHashMapBucket = TJclDoubleDoubleHashMapBucket; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TJclFloatFloatHashMapEntry = TJclExtendedExtendedHashMapEntry; + TJclFloatFloatHashMapBucket = TJclExtendedExtendedHashMapBucket; + {$ENDIF MATH_EXTENDED_PRECISION} + + {$IFDEF MATH_SINGLE_PRECISION} + TJclFloatFloatHashMap = TJclSingleSingleHashMap; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TJclFloatFloatHashMap = TJclDoubleDoubleHashMap; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TJclFloatFloatHashMap = TJclExtendedExtendedHashMap; + {$ENDIF MATH_EXTENDED_PRECISION} + + TJclIntegerIntfHashMapEntry = record + Key: Integer; + Value: IInterface; + end; + + TJclIntegerIntfHashMapEntryArray = array of TJclIntegerIntfHashMapEntry; + + TJclIntegerIntfHashMapBucket = class + public + Size: Integer; + Entries: TJclIntegerIntfHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclIntegerIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclIntegerIntfHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclIntegerIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclIntegerIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclIntegerIntfHashMap = class(TJclIntegerAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclIntegerContainer, IJclIntfContainer, + IJclIntegerIntfMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: Integer): Integer; + function FreeValue(var Value: IInterface): IInterface; + function KeysEqual(A, B: Integer): Boolean; + function ValuesEqual(const A, B: IInterface): Boolean; + private + FBuckets: array of TJclIntegerIntfHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclIntegerIntfMap } + procedure Clear; + function ContainsKey(Key: Integer): Boolean; + function ContainsValue(const Value: IInterface): Boolean; + function Extract(Key: Integer): IInterface; + function GetValue(Key: Integer): IInterface; + function IsEmpty: Boolean; + function KeyOfValue(const Value: IInterface): Integer; + function KeySet: IJclIntegerSet; + function Keys: IJclIntegerCollection; + function MapEquals(const AMap: IJclIntegerIntfMap): Boolean; + procedure PutAll(const AMap: IJclIntegerIntfMap); + procedure PutValue(Key: Integer; const Value: IInterface); + function Remove(Key: Integer): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + end; + + TJclIntfIntegerHashMapEntry = record + Key: IInterface; + Value: Integer; + end; + + TJclIntfIntegerHashMapEntryArray = array of TJclIntfIntegerHashMapEntry; + + TJclIntfIntegerHashMapBucket = class + public + Size: Integer; + Entries: TJclIntfIntegerHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclIntfIntegerHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclIntfIntegerHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclIntfIntegerHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclIntfIntegerHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclIntfIntegerHashMap = class(TJclIntegerAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclIntfContainer, IJclIntegerContainer, + IJclIntfIntegerMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: IInterface): IInterface; + function FreeValue(var Value: Integer): Integer; + function Hash(const AInterface: IInterface): Integer; reintroduce; + function KeysEqual(const A, B: IInterface): Boolean; + function ValuesEqual(A, B: Integer): Boolean; + private + FBuckets: array of TJclIntfIntegerHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclIntfIntegerMap } + procedure Clear; + function ContainsKey(const Key: IInterface): Boolean; + function ContainsValue(Value: Integer): Boolean; + function Extract(const Key: IInterface): Integer; + function GetValue(const Key: IInterface): Integer; + function IsEmpty: Boolean; + function KeyOfValue(Value: Integer): IInterface; + function KeySet: IJclIntfSet; + function Keys: IJclIntfCollection; + function MapEquals(const AMap: IJclIntfIntegerMap): Boolean; + procedure PutAll(const AMap: IJclIntfIntegerMap); + procedure PutValue(const Key: IInterface; Value: Integer); + function Remove(const Key: IInterface): Integer; + function Size: Integer; + function Values: IJclIntegerCollection; + end; + + TJclIntegerIntegerHashMapEntry = record + Key: Integer; + Value: Integer; + end; + + TJclIntegerIntegerHashMapEntryArray = array of TJclIntegerIntegerHashMapEntry; + + TJclIntegerIntegerHashMapBucket = class + public + Size: Integer; + Entries: TJclIntegerIntegerHashMapEntryArray; + procedure InitializeArrayAfterMove(var List: TJclIntegerIntegerHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure MoveArray(var List: TJclIntegerIntegerHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclIntegerIntegerHashMap = class(TJclIntegerAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclIntegerContainer, + IJclIntegerIntegerMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: Integer): Integer; + function FreeValue(var Value: Integer): Integer; + function KeysEqual(A, B: Integer): Boolean; + function ValuesEqual(A, B: Integer): Boolean; + private + FBuckets: array of TJclIntegerIntegerHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclIntegerIntegerMap } + procedure Clear; + function ContainsKey(Key: Integer): Boolean; + function ContainsValue(Value: Integer): Boolean; + function Extract(Key: Integer): Integer; + function GetValue(Key: Integer): Integer; + function IsEmpty: Boolean; + function KeyOfValue(Value: Integer): Integer; + function KeySet: IJclIntegerSet; + function Keys: IJclIntegerCollection; + function MapEquals(const AMap: IJclIntegerIntegerMap): Boolean; + procedure PutAll(const AMap: IJclIntegerIntegerMap); + procedure PutValue(Key: Integer; Value: Integer); + function Remove(Key: Integer): Integer; + function Size: Integer; + function Values: IJclIntegerCollection; + end; + + TJclCardinalIntfHashMapEntry = record + Key: Cardinal; + Value: IInterface; + end; + + TJclCardinalIntfHashMapEntryArray = array of TJclCardinalIntfHashMapEntry; + + TJclCardinalIntfHashMapBucket = class + public + Size: Integer; + Entries: TJclCardinalIntfHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclCardinalIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclCardinalIntfHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclCardinalIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclCardinalIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclCardinalIntfHashMap = class(TJclCardinalAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclCardinalContainer, IJclIntfContainer, + IJclCardinalIntfMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: Cardinal): Cardinal; + function FreeValue(var Value: IInterface): IInterface; + function KeysEqual(A, B: Cardinal): Boolean; + function ValuesEqual(const A, B: IInterface): Boolean; + private + FBuckets: array of TJclCardinalIntfHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclCardinalIntfMap } + procedure Clear; + function ContainsKey(Key: Cardinal): Boolean; + function ContainsValue(const Value: IInterface): Boolean; + function Extract(Key: Cardinal): IInterface; + function GetValue(Key: Cardinal): IInterface; + function IsEmpty: Boolean; + function KeyOfValue(const Value: IInterface): Cardinal; + function KeySet: IJclCardinalSet; + function Keys: IJclCardinalCollection; + function MapEquals(const AMap: IJclCardinalIntfMap): Boolean; + procedure PutAll(const AMap: IJclCardinalIntfMap); + procedure PutValue(Key: Cardinal; const Value: IInterface); + function Remove(Key: Cardinal): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + end; + + TJclIntfCardinalHashMapEntry = record + Key: IInterface; + Value: Cardinal; + end; + + TJclIntfCardinalHashMapEntryArray = array of TJclIntfCardinalHashMapEntry; + + TJclIntfCardinalHashMapBucket = class + public + Size: Integer; + Entries: TJclIntfCardinalHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclIntfCardinalHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclIntfCardinalHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclIntfCardinalHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclIntfCardinalHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclIntfCardinalHashMap = class(TJclCardinalAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclIntfContainer, IJclCardinalContainer, + IJclIntfCardinalMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: IInterface): IInterface; + function FreeValue(var Value: Cardinal): Cardinal; + function Hash(const AInterface: IInterface): Integer; reintroduce; + function KeysEqual(const A, B: IInterface): Boolean; + function ValuesEqual(A, B: Cardinal): Boolean; + private + FBuckets: array of TJclIntfCardinalHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclIntfCardinalMap } + procedure Clear; + function ContainsKey(const Key: IInterface): Boolean; + function ContainsValue(Value: Cardinal): Boolean; + function Extract(const Key: IInterface): Cardinal; + function GetValue(const Key: IInterface): Cardinal; + function IsEmpty: Boolean; + function KeyOfValue(Value: Cardinal): IInterface; + function KeySet: IJclIntfSet; + function Keys: IJclIntfCollection; + function MapEquals(const AMap: IJclIntfCardinalMap): Boolean; + procedure PutAll(const AMap: IJclIntfCardinalMap); + procedure PutValue(const Key: IInterface; Value: Cardinal); + function Remove(const Key: IInterface): Cardinal; + function Size: Integer; + function Values: IJclCardinalCollection; + end; + + TJclCardinalCardinalHashMapEntry = record + Key: Cardinal; + Value: Cardinal; + end; + + TJclCardinalCardinalHashMapEntryArray = array of TJclCardinalCardinalHashMapEntry; + + TJclCardinalCardinalHashMapBucket = class + public + Size: Integer; + Entries: TJclCardinalCardinalHashMapEntryArray; + procedure InitializeArrayAfterMove(var List: TJclCardinalCardinalHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure MoveArray(var List: TJclCardinalCardinalHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclCardinalCardinalHashMap = class(TJclCardinalAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclCardinalContainer, + IJclCardinalCardinalMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: Cardinal): Cardinal; + function FreeValue(var Value: Cardinal): Cardinal; + function KeysEqual(A, B: Cardinal): Boolean; + function ValuesEqual(A, B: Cardinal): Boolean; + private + FBuckets: array of TJclCardinalCardinalHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclCardinalCardinalMap } + procedure Clear; + function ContainsKey(Key: Cardinal): Boolean; + function ContainsValue(Value: Cardinal): Boolean; + function Extract(Key: Cardinal): Cardinal; + function GetValue(Key: Cardinal): Cardinal; + function IsEmpty: Boolean; + function KeyOfValue(Value: Cardinal): Cardinal; + function KeySet: IJclCardinalSet; + function Keys: IJclCardinalCollection; + function MapEquals(const AMap: IJclCardinalCardinalMap): Boolean; + procedure PutAll(const AMap: IJclCardinalCardinalMap); + procedure PutValue(Key: Cardinal; Value: Cardinal); + function Remove(Key: Cardinal): Cardinal; + function Size: Integer; + function Values: IJclCardinalCollection; + end; + + TJclInt64IntfHashMapEntry = record + Key: Int64; + Value: IInterface; + end; + + TJclInt64IntfHashMapEntryArray = array of TJclInt64IntfHashMapEntry; + + TJclInt64IntfHashMapBucket = class + public + Size: Integer; + Entries: TJclInt64IntfHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclInt64IntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclInt64IntfHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclInt64IntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclInt64IntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclInt64IntfHashMap = class(TJclInt64AbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclInt64Container, IJclIntfContainer, + IJclInt64IntfMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: Int64): Int64; + function FreeValue(var Value: IInterface): IInterface; + function KeysEqual(const A, B: Int64): Boolean; + function ValuesEqual(const A, B: IInterface): Boolean; + private + FBuckets: array of TJclInt64IntfHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclInt64IntfMap } + procedure Clear; + function ContainsKey(const Key: Int64): Boolean; + function ContainsValue(const Value: IInterface): Boolean; + function Extract(const Key: Int64): IInterface; + function GetValue(const Key: Int64): IInterface; + function IsEmpty: Boolean; + function KeyOfValue(const Value: IInterface): Int64; + function KeySet: IJclInt64Set; + function Keys: IJclInt64Collection; + function MapEquals(const AMap: IJclInt64IntfMap): Boolean; + procedure PutAll(const AMap: IJclInt64IntfMap); + procedure PutValue(const Key: Int64; const Value: IInterface); + function Remove(const Key: Int64): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + end; + + TJclIntfInt64HashMapEntry = record + Key: IInterface; + Value: Int64; + end; + + TJclIntfInt64HashMapEntryArray = array of TJclIntfInt64HashMapEntry; + + TJclIntfInt64HashMapBucket = class + public + Size: Integer; + Entries: TJclIntfInt64HashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclIntfInt64HashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclIntfInt64HashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclIntfInt64HashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclIntfInt64HashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclIntfInt64HashMap = class(TJclInt64AbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclIntfContainer, IJclInt64Container, + IJclIntfInt64Map) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: IInterface): IInterface; + function FreeValue(var Value: Int64): Int64; + function Hash(const AInterface: IInterface): Integer; reintroduce; + function KeysEqual(const A, B: IInterface): Boolean; + function ValuesEqual(const A, B: Int64): Boolean; + private + FBuckets: array of TJclIntfInt64HashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclIntfInt64Map } + procedure Clear; + function ContainsKey(const Key: IInterface): Boolean; + function ContainsValue(const Value: Int64): Boolean; + function Extract(const Key: IInterface): Int64; + function GetValue(const Key: IInterface): Int64; + function IsEmpty: Boolean; + function KeyOfValue(const Value: Int64): IInterface; + function KeySet: IJclIntfSet; + function Keys: IJclIntfCollection; + function MapEquals(const AMap: IJclIntfInt64Map): Boolean; + procedure PutAll(const AMap: IJclIntfInt64Map); + procedure PutValue(const Key: IInterface; const Value: Int64); + function Remove(const Key: IInterface): Int64; + function Size: Integer; + function Values: IJclInt64Collection; + end; + + TJclInt64Int64HashMapEntry = record + Key: Int64; + Value: Int64; + end; + + TJclInt64Int64HashMapEntryArray = array of TJclInt64Int64HashMapEntry; + + TJclInt64Int64HashMapBucket = class + public + Size: Integer; + Entries: TJclInt64Int64HashMapEntryArray; + procedure InitializeArrayAfterMove(var List: TJclInt64Int64HashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure MoveArray(var List: TJclInt64Int64HashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclInt64Int64HashMap = class(TJclInt64AbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclInt64Container, + IJclInt64Int64Map) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: Int64): Int64; + function FreeValue(var Value: Int64): Int64; + function KeysEqual(const A, B: Int64): Boolean; + function ValuesEqual(const A, B: Int64): Boolean; + private + FBuckets: array of TJclInt64Int64HashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclInt64Int64Map } + procedure Clear; + function ContainsKey(const Key: Int64): Boolean; + function ContainsValue(const Value: Int64): Boolean; + function Extract(const Key: Int64): Int64; + function GetValue(const Key: Int64): Int64; + function IsEmpty: Boolean; + function KeyOfValue(const Value: Int64): Int64; + function KeySet: IJclInt64Set; + function Keys: IJclInt64Collection; + function MapEquals(const AMap: IJclInt64Int64Map): Boolean; + procedure PutAll(const AMap: IJclInt64Int64Map); + procedure PutValue(const Key: Int64; const Value: Int64); + function Remove(const Key: Int64): Int64; + function Size: Integer; + function Values: IJclInt64Collection; + end; + + TJclPtrIntfHashMapEntry = record + Key: Pointer; + Value: IInterface; + end; + + TJclPtrIntfHashMapEntryArray = array of TJclPtrIntfHashMapEntry; + + TJclPtrIntfHashMapBucket = class + public + Size: Integer; + Entries: TJclPtrIntfHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclPtrIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclPtrIntfHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclPtrIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclPtrIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclPtrIntfHashMap = class(TJclPtrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclPtrContainer, IJclIntfContainer, + IJclPtrIntfMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: Pointer): Pointer; + function FreeValue(var Value: IInterface): IInterface; + function KeysEqual(A, B: Pointer): Boolean; + function ValuesEqual(const A, B: IInterface): Boolean; + private + FBuckets: array of TJclPtrIntfHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclPtrIntfMap } + procedure Clear; + function ContainsKey(Key: Pointer): Boolean; + function ContainsValue(const Value: IInterface): Boolean; + function Extract(Key: Pointer): IInterface; + function GetValue(Key: Pointer): IInterface; + function IsEmpty: Boolean; + function KeyOfValue(const Value: IInterface): Pointer; + function KeySet: IJclPtrSet; + function Keys: IJclPtrCollection; + function MapEquals(const AMap: IJclPtrIntfMap): Boolean; + procedure PutAll(const AMap: IJclPtrIntfMap); + procedure PutValue(Key: Pointer; const Value: IInterface); + function Remove(Key: Pointer): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + end; + + TJclIntfPtrHashMapEntry = record + Key: IInterface; + Value: Pointer; + end; + + TJclIntfPtrHashMapEntryArray = array of TJclIntfPtrHashMapEntry; + + TJclIntfPtrHashMapBucket = class + public + Size: Integer; + Entries: TJclIntfPtrHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclIntfPtrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclIntfPtrHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclIntfPtrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclIntfPtrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclIntfPtrHashMap = class(TJclPtrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclIntfContainer, IJclPtrContainer, + IJclIntfPtrMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: IInterface): IInterface; + function FreeValue(var Value: Pointer): Pointer; + function Hash(const AInterface: IInterface): Integer; reintroduce; + function KeysEqual(const A, B: IInterface): Boolean; + function ValuesEqual(A, B: Pointer): Boolean; + private + FBuckets: array of TJclIntfPtrHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclIntfPtrMap } + procedure Clear; + function ContainsKey(const Key: IInterface): Boolean; + function ContainsValue(Value: Pointer): Boolean; + function Extract(const Key: IInterface): Pointer; + function GetValue(const Key: IInterface): Pointer; + function IsEmpty: Boolean; + function KeyOfValue(Value: Pointer): IInterface; + function KeySet: IJclIntfSet; + function Keys: IJclIntfCollection; + function MapEquals(const AMap: IJclIntfPtrMap): Boolean; + procedure PutAll(const AMap: IJclIntfPtrMap); + procedure PutValue(const Key: IInterface; Value: Pointer); + function Remove(const Key: IInterface): Pointer; + function Size: Integer; + function Values: IJclPtrCollection; + end; + + TJclPtrPtrHashMapEntry = record + Key: Pointer; + Value: Pointer; + end; + + TJclPtrPtrHashMapEntryArray = array of TJclPtrPtrHashMapEntry; + + TJclPtrPtrHashMapBucket = class + public + Size: Integer; + Entries: TJclPtrPtrHashMapEntryArray; + procedure InitializeArrayAfterMove(var List: TJclPtrPtrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure MoveArray(var List: TJclPtrPtrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclPtrPtrHashMap = class(TJclPtrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclPtrContainer, + IJclPtrPtrMap) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: Pointer): Pointer; + function FreeValue(var Value: Pointer): Pointer; + function KeysEqual(A, B: Pointer): Boolean; + function ValuesEqual(A, B: Pointer): Boolean; + private + FBuckets: array of TJclPtrPtrHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclPtrPtrMap } + procedure Clear; + function ContainsKey(Key: Pointer): Boolean; + function ContainsValue(Value: Pointer): Boolean; + function Extract(Key: Pointer): Pointer; + function GetValue(Key: Pointer): Pointer; + function IsEmpty: Boolean; + function KeyOfValue(Value: Pointer): Pointer; + function KeySet: IJclPtrSet; + function Keys: IJclPtrCollection; + function MapEquals(const AMap: IJclPtrPtrMap): Boolean; + procedure PutAll(const AMap: IJclPtrPtrMap); + procedure PutValue(Key: Pointer; Value: Pointer); + function Remove(Key: Pointer): Pointer; + function Size: Integer; + function Values: IJclPtrCollection; + end; + + TJclIntfHashMapEntry = record + Key: IInterface; + Value: TObject; + end; + + TJclIntfHashMapEntryArray = array of TJclIntfHashMapEntry; + + TJclIntfHashMapBucket = class + public + Size: Integer; + Entries: TJclIntfHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclIntfHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclIntfHashMap = class(TJclIntfAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclIntfContainer, IJclContainer, IJclValueOwner, + IJclIntfMap) + private + FOwnsValues: Boolean; + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: IInterface): IInterface; + function KeysEqual(const A, B: IInterface): Boolean; + function ValuesEqual(A, B: TObject): Boolean; + public + { IJclValueOwner } + function FreeValue(var Value: TObject): TObject; + function GetOwnsValues: Boolean; + property OwnsValues: Boolean read FOwnsValues; + private + FBuckets: array of TJclIntfHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer; AOwnsValues: Boolean); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclIntfMap } + procedure Clear; + function ContainsKey(const Key: IInterface): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Extract(const Key: IInterface): TObject; + function GetValue(const Key: IInterface): TObject; + function IsEmpty: Boolean; + function KeyOfValue(Value: TObject): IInterface; + function KeySet: IJclIntfSet; + function Keys: IJclIntfCollection; + function MapEquals(const AMap: IJclIntfMap): Boolean; + procedure PutAll(const AMap: IJclIntfMap); + procedure PutValue(const Key: IInterface; Value: TObject); + function Remove(const Key: IInterface): TObject; + function Size: Integer; + function Values: IJclCollection; + end; + + TJclAnsiStrHashMapEntry = record + Key: AnsiString; + Value: TObject; + end; + + TJclAnsiStrHashMapEntryArray = array of TJclAnsiStrHashMapEntry; + + TJclAnsiStrHashMapBucket = class + public + Size: Integer; + Entries: TJclAnsiStrHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclAnsiStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclAnsiStrHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclAnsiStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclAnsiStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclAnsiStrHashMap = class(TJclAnsiStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclStrBaseContainer, IJclAnsiStrContainer, IJclContainer, IJclValueOwner, + IJclAnsiStrMap) + private + FOwnsValues: Boolean; + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: AnsiString): AnsiString; + function KeysEqual(const A, B: AnsiString): Boolean; + function ValuesEqual(A, B: TObject): Boolean; + public + { IJclValueOwner } + function FreeValue(var Value: TObject): TObject; + function GetOwnsValues: Boolean; + property OwnsValues: Boolean read FOwnsValues; + private + FBuckets: array of TJclAnsiStrHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer; AOwnsValues: Boolean); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclAnsiStrMap } + procedure Clear; + function ContainsKey(const Key: AnsiString): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Extract(const Key: AnsiString): TObject; + function GetValue(const Key: AnsiString): TObject; + function IsEmpty: Boolean; + function KeyOfValue(Value: TObject): AnsiString; + function KeySet: IJclAnsiStrSet; + function Keys: IJclAnsiStrCollection; + function MapEquals(const AMap: IJclAnsiStrMap): Boolean; + procedure PutAll(const AMap: IJclAnsiStrMap); + procedure PutValue(const Key: AnsiString; Value: TObject); + function Remove(const Key: AnsiString): TObject; + function Size: Integer; + function Values: IJclCollection; + end; + + TJclWideStrHashMapEntry = record + Key: WideString; + Value: TObject; + end; + + TJclWideStrHashMapEntryArray = array of TJclWideStrHashMapEntry; + + TJclWideStrHashMapBucket = class + public + Size: Integer; + Entries: TJclWideStrHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclWideStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclWideStrHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclWideStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclWideStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclWideStrHashMap = class(TJclWideStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclStrBaseContainer, IJclWideStrContainer, IJclContainer, IJclValueOwner, + IJclWideStrMap) + private + FOwnsValues: Boolean; + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: WideString): WideString; + function KeysEqual(const A, B: WideString): Boolean; + function ValuesEqual(A, B: TObject): Boolean; + public + { IJclValueOwner } + function FreeValue(var Value: TObject): TObject; + function GetOwnsValues: Boolean; + property OwnsValues: Boolean read FOwnsValues; + private + FBuckets: array of TJclWideStrHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer; AOwnsValues: Boolean); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclWideStrMap } + procedure Clear; + function ContainsKey(const Key: WideString): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Extract(const Key: WideString): TObject; + function GetValue(const Key: WideString): TObject; + function IsEmpty: Boolean; + function KeyOfValue(Value: TObject): WideString; + function KeySet: IJclWideStrSet; + function Keys: IJclWideStrCollection; + function MapEquals(const AMap: IJclWideStrMap): Boolean; + procedure PutAll(const AMap: IJclWideStrMap); + procedure PutValue(const Key: WideString; Value: TObject); + function Remove(const Key: WideString): TObject; + function Size: Integer; + function Values: IJclCollection; + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclUnicodeStrHashMapEntry = record + Key: UnicodeString; + Value: TObject; + end; + + TJclUnicodeStrHashMapEntryArray = array of TJclUnicodeStrHashMapEntry; + + TJclUnicodeStrHashMapBucket = class + public + Size: Integer; + Entries: TJclUnicodeStrHashMapEntryArray; + procedure FinalizeArrayBeforeMove(var List: TJclUnicodeStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: TJclUnicodeStrHashMapEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: TJclUnicodeStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: TJclUnicodeStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclUnicodeStrHashMap = class(TJclUnicodeStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclStrBaseContainer, IJclUnicodeStrContainer, IJclContainer, IJclValueOwner, + IJclUnicodeStrMap) + private + FOwnsValues: Boolean; + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: UnicodeString): UnicodeString; + function KeysEqual(const A, B: UnicodeString): Boolean; + function ValuesEqual(A, B: TObject): Boolean; + public + { IJclValueOwner } + function FreeValue(var Value: TObject): TObject; + function GetOwnsValues: Boolean; + property OwnsValues: Boolean read FOwnsValues; + private + FBuckets: array of TJclUnicodeStrHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer; AOwnsValues: Boolean); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclUnicodeStrMap } + procedure Clear; + function ContainsKey(const Key: UnicodeString): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Extract(const Key: UnicodeString): TObject; + function GetValue(const Key: UnicodeString): TObject; + function IsEmpty: Boolean; + function KeyOfValue(Value: TObject): UnicodeString; + function KeySet: IJclUnicodeStrSet; + function Keys: IJclUnicodeStrCollection; + function MapEquals(const AMap: IJclUnicodeStrMap): Boolean; + procedure PutAll(const AMap: IJclUnicodeStrMap); + procedure PutValue(const Key: UnicodeString; Value: TObject); + function Remove(const Key: UnicodeString): TObject; + function Size: Integer; + function Values: IJclCollection; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + TJclStrHashMapEntry = TJclAnsiStrHashMapEntry; + TJclStrHashMapBucket = TJclAnsiStrHashMapBucket; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TJclStrHashMapEntry = TJclWideStrHashMapEntry; + TJclStrHashMapBucket = TJclWideStrHashMapBucket; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TJclStrHashMapEntry = TJclUnicodeStrHashMapEntry; + TJclStrHashMapBucket = TJclUnicodeStrHashMapBucket; + {$ENDIF CONTAINER_UNICODESTR} + + {$IFDEF CONTAINER_ANSISTR} + TJclStrHashMap = TJclAnsiStrHashMap; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TJclStrHashMap = TJclWideStrHashMap; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TJclStrHashMap = TJclUnicodeStrHashMap; + {$ENDIF CONTAINER_UNICODESTR} + + TJclSingleHashMapEntry = record + Key: Single; + Value: TObject; + end; + + TJclSingleHashMapEntryArray = array of TJclSingleHashMapEntry; + + TJclSingleHashMapBucket = class + public + Size: Integer; + Entries: TJclSingleHashMapEntryArray; + procedure InitializeArrayAfterMove(var List: TJclSingleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure MoveArray(var List: TJclSingleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclSingleHashMap = class(TJclSingleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclSingleContainer, IJclContainer, IJclValueOwner, + IJclSingleMap) + private + FOwnsValues: Boolean; + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: Single): Single; + function KeysEqual(const A, B: Single): Boolean; + function ValuesEqual(A, B: TObject): Boolean; + public + { IJclValueOwner } + function FreeValue(var Value: TObject): TObject; + function GetOwnsValues: Boolean; + property OwnsValues: Boolean read FOwnsValues; + private + FBuckets: array of TJclSingleHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer; AOwnsValues: Boolean); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclSingleMap } + procedure Clear; + function ContainsKey(const Key: Single): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Extract(const Key: Single): TObject; + function GetValue(const Key: Single): TObject; + function IsEmpty: Boolean; + function KeyOfValue(Value: TObject): Single; + function KeySet: IJclSingleSet; + function Keys: IJclSingleCollection; + function MapEquals(const AMap: IJclSingleMap): Boolean; + procedure PutAll(const AMap: IJclSingleMap); + procedure PutValue(const Key: Single; Value: TObject); + function Remove(const Key: Single): TObject; + function Size: Integer; + function Values: IJclCollection; + end; + + TJclDoubleHashMapEntry = record + Key: Double; + Value: TObject; + end; + + TJclDoubleHashMapEntryArray = array of TJclDoubleHashMapEntry; + + TJclDoubleHashMapBucket = class + public + Size: Integer; + Entries: TJclDoubleHashMapEntryArray; + procedure InitializeArrayAfterMove(var List: TJclDoubleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure MoveArray(var List: TJclDoubleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclDoubleHashMap = class(TJclDoubleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclDoubleContainer, IJclContainer, IJclValueOwner, + IJclDoubleMap) + private + FOwnsValues: Boolean; + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: Double): Double; + function KeysEqual(const A, B: Double): Boolean; + function ValuesEqual(A, B: TObject): Boolean; + public + { IJclValueOwner } + function FreeValue(var Value: TObject): TObject; + function GetOwnsValues: Boolean; + property OwnsValues: Boolean read FOwnsValues; + private + FBuckets: array of TJclDoubleHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer; AOwnsValues: Boolean); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclDoubleMap } + procedure Clear; + function ContainsKey(const Key: Double): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Extract(const Key: Double): TObject; + function GetValue(const Key: Double): TObject; + function IsEmpty: Boolean; + function KeyOfValue(Value: TObject): Double; + function KeySet: IJclDoubleSet; + function Keys: IJclDoubleCollection; + function MapEquals(const AMap: IJclDoubleMap): Boolean; + procedure PutAll(const AMap: IJclDoubleMap); + procedure PutValue(const Key: Double; Value: TObject); + function Remove(const Key: Double): TObject; + function Size: Integer; + function Values: IJclCollection; + end; + + TJclExtendedHashMapEntry = record + Key: Extended; + Value: TObject; + end; + + TJclExtendedHashMapEntryArray = array of TJclExtendedHashMapEntry; + + TJclExtendedHashMapBucket = class + public + Size: Integer; + Entries: TJclExtendedHashMapEntryArray; + procedure InitializeArrayAfterMove(var List: TJclExtendedHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure MoveArray(var List: TJclExtendedHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclExtendedHashMap = class(TJclExtendedAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclExtendedContainer, IJclContainer, IJclValueOwner, + IJclExtendedMap) + private + FOwnsValues: Boolean; + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: Extended): Extended; + function KeysEqual(const A, B: Extended): Boolean; + function ValuesEqual(A, B: TObject): Boolean; + public + { IJclValueOwner } + function FreeValue(var Value: TObject): TObject; + function GetOwnsValues: Boolean; + property OwnsValues: Boolean read FOwnsValues; + private + FBuckets: array of TJclExtendedHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer; AOwnsValues: Boolean); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclExtendedMap } + procedure Clear; + function ContainsKey(const Key: Extended): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Extract(const Key: Extended): TObject; + function GetValue(const Key: Extended): TObject; + function IsEmpty: Boolean; + function KeyOfValue(Value: TObject): Extended; + function KeySet: IJclExtendedSet; + function Keys: IJclExtendedCollection; + function MapEquals(const AMap: IJclExtendedMap): Boolean; + procedure PutAll(const AMap: IJclExtendedMap); + procedure PutValue(const Key: Extended; Value: TObject); + function Remove(const Key: Extended): TObject; + function Size: Integer; + function Values: IJclCollection; + end; + + {$IFDEF MATH_SINGLE_PRECISION} + TJclFloatHashMapEntry = TJclSingleHashMapEntry; + TJclFloatHashMapBucket = TJclSingleHashMapBucket; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TJclFloatHashMapEntry = TJclDoubleHashMapEntry; + TJclFloatHashMapBucket = TJclDoubleHashMapBucket; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TJclFloatHashMapEntry = TJclExtendedHashMapEntry; + TJclFloatHashMapBucket = TJclExtendedHashMapBucket; + {$ENDIF MATH_EXTENDED_PRECISION} + + {$IFDEF MATH_SINGLE_PRECISION} + TJclFloatHashMap = TJclSingleHashMap; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TJclFloatHashMap = TJclDoubleHashMap; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TJclFloatHashMap = TJclExtendedHashMap; + {$ENDIF MATH_EXTENDED_PRECISION} + + TJclIntegerHashMapEntry = record + Key: Integer; + Value: TObject; + end; + + TJclIntegerHashMapEntryArray = array of TJclIntegerHashMapEntry; + + TJclIntegerHashMapBucket = class + public + Size: Integer; + Entries: TJclIntegerHashMapEntryArray; + procedure InitializeArrayAfterMove(var List: TJclIntegerHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure MoveArray(var List: TJclIntegerHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclIntegerHashMap = class(TJclIntegerAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclIntegerContainer, IJclContainer, IJclValueOwner, + IJclIntegerMap) + private + FOwnsValues: Boolean; + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: Integer): Integer; + function KeysEqual(A, B: Integer): Boolean; + function ValuesEqual(A, B: TObject): Boolean; + public + { IJclValueOwner } + function FreeValue(var Value: TObject): TObject; + function GetOwnsValues: Boolean; + property OwnsValues: Boolean read FOwnsValues; + private + FBuckets: array of TJclIntegerHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer; AOwnsValues: Boolean); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclIntegerMap } + procedure Clear; + function ContainsKey(Key: Integer): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Extract(Key: Integer): TObject; + function GetValue(Key: Integer): TObject; + function IsEmpty: Boolean; + function KeyOfValue(Value: TObject): Integer; + function KeySet: IJclIntegerSet; + function Keys: IJclIntegerCollection; + function MapEquals(const AMap: IJclIntegerMap): Boolean; + procedure PutAll(const AMap: IJclIntegerMap); + procedure PutValue(Key: Integer; Value: TObject); + function Remove(Key: Integer): TObject; + function Size: Integer; + function Values: IJclCollection; + end; + + TJclCardinalHashMapEntry = record + Key: Cardinal; + Value: TObject; + end; + + TJclCardinalHashMapEntryArray = array of TJclCardinalHashMapEntry; + + TJclCardinalHashMapBucket = class + public + Size: Integer; + Entries: TJclCardinalHashMapEntryArray; + procedure InitializeArrayAfterMove(var List: TJclCardinalHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure MoveArray(var List: TJclCardinalHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclCardinalHashMap = class(TJclCardinalAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclCardinalContainer, IJclContainer, IJclValueOwner, + IJclCardinalMap) + private + FOwnsValues: Boolean; + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: Cardinal): Cardinal; + function KeysEqual(A, B: Cardinal): Boolean; + function ValuesEqual(A, B: TObject): Boolean; + public + { IJclValueOwner } + function FreeValue(var Value: TObject): TObject; + function GetOwnsValues: Boolean; + property OwnsValues: Boolean read FOwnsValues; + private + FBuckets: array of TJclCardinalHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer; AOwnsValues: Boolean); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclCardinalMap } + procedure Clear; + function ContainsKey(Key: Cardinal): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Extract(Key: Cardinal): TObject; + function GetValue(Key: Cardinal): TObject; + function IsEmpty: Boolean; + function KeyOfValue(Value: TObject): Cardinal; + function KeySet: IJclCardinalSet; + function Keys: IJclCardinalCollection; + function MapEquals(const AMap: IJclCardinalMap): Boolean; + procedure PutAll(const AMap: IJclCardinalMap); + procedure PutValue(Key: Cardinal; Value: TObject); + function Remove(Key: Cardinal): TObject; + function Size: Integer; + function Values: IJclCollection; + end; + + TJclInt64HashMapEntry = record + Key: Int64; + Value: TObject; + end; + + TJclInt64HashMapEntryArray = array of TJclInt64HashMapEntry; + + TJclInt64HashMapBucket = class + public + Size: Integer; + Entries: TJclInt64HashMapEntryArray; + procedure InitializeArrayAfterMove(var List: TJclInt64HashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure MoveArray(var List: TJclInt64HashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclInt64HashMap = class(TJclInt64AbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclInt64Container, IJclContainer, IJclValueOwner, + IJclInt64Map) + private + FOwnsValues: Boolean; + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: Int64): Int64; + function KeysEqual(const A, B: Int64): Boolean; + function ValuesEqual(A, B: TObject): Boolean; + public + { IJclValueOwner } + function FreeValue(var Value: TObject): TObject; + function GetOwnsValues: Boolean; + property OwnsValues: Boolean read FOwnsValues; + private + FBuckets: array of TJclInt64HashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer; AOwnsValues: Boolean); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclInt64Map } + procedure Clear; + function ContainsKey(const Key: Int64): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Extract(const Key: Int64): TObject; + function GetValue(const Key: Int64): TObject; + function IsEmpty: Boolean; + function KeyOfValue(Value: TObject): Int64; + function KeySet: IJclInt64Set; + function Keys: IJclInt64Collection; + function MapEquals(const AMap: IJclInt64Map): Boolean; + procedure PutAll(const AMap: IJclInt64Map); + procedure PutValue(const Key: Int64; Value: TObject); + function Remove(const Key: Int64): TObject; + function Size: Integer; + function Values: IJclCollection; + end; + + TJclPtrHashMapEntry = record + Key: Pointer; + Value: TObject; + end; + + TJclPtrHashMapEntryArray = array of TJclPtrHashMapEntry; + + TJclPtrHashMapBucket = class + public + Size: Integer; + Entries: TJclPtrHashMapEntryArray; + procedure InitializeArrayAfterMove(var List: TJclPtrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure MoveArray(var List: TJclPtrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclPtrHashMap = class(TJclPtrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclPtrContainer, IJclContainer, IJclValueOwner, + IJclPtrMap) + private + FOwnsValues: Boolean; + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function FreeKey(var Key: Pointer): Pointer; + function KeysEqual(A, B: Pointer): Boolean; + function ValuesEqual(A, B: TObject): Boolean; + public + { IJclValueOwner } + function FreeValue(var Value: TObject): TObject; + function GetOwnsValues: Boolean; + property OwnsValues: Boolean read FOwnsValues; + private + FBuckets: array of TJclPtrHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer; AOwnsValues: Boolean); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclPtrMap } + procedure Clear; + function ContainsKey(Key: Pointer): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Extract(Key: Pointer): TObject; + function GetValue(Key: Pointer): TObject; + function IsEmpty: Boolean; + function KeyOfValue(Value: TObject): Pointer; + function KeySet: IJclPtrSet; + function Keys: IJclPtrCollection; + function MapEquals(const AMap: IJclPtrMap): Boolean; + procedure PutAll(const AMap: IJclPtrMap); + procedure PutValue(Key: Pointer; Value: TObject); + function Remove(Key: Pointer): TObject; + function Size: Integer; + function Values: IJclCollection; + end; + + TJclHashMapEntry = record + Key: TObject; + Value: TObject; + end; + + TJclHashMapEntryArray = array of TJclHashMapEntry; + + TJclHashMapBucket = class + public + Size: Integer; + Entries: TJclHashMapEntryArray; + procedure InitializeArrayAfterMove(var List: TJclHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure MoveArray(var List: TJclHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclHashMap = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclContainer, IJclKeyOwner, IJclValueOwner, + IJclMap) + private + FOwnsKeys: Boolean; + FOwnsValues: Boolean; + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function Hash(AObject: TObject): Integer; + function KeysEqual(A, B: TObject): Boolean; + function ValuesEqual(A, B: TObject): Boolean; + public + { IJclKeyOwner } + function FreeKey(var Key: TObject): TObject; + function GetOwnsKeys: Boolean; + property OwnsKeys: Boolean read FOwnsKeys; + { IJclValueOwner } + function FreeValue(var Value: TObject): TObject; + function GetOwnsValues: Boolean; + property OwnsValues: Boolean read FOwnsValues; + private + FBuckets: array of TJclHashMapBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclMap } + procedure Clear; + function ContainsKey(Key: TObject): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Extract(Key: TObject): TObject; + function GetValue(Key: TObject): TObject; + function IsEmpty: Boolean; + function KeyOfValue(Value: TObject): TObject; + function KeySet: IJclSet; + function Keys: IJclCollection; + function MapEquals(const AMap: IJclMap): Boolean; + procedure PutAll(const AMap: IJclMap); + procedure PutValue(Key: TObject; Value: TObject); + function Remove(Key: TObject): TObject; + function Size: Integer; + function Values: IJclCollection; + end; + + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + + TJclHashEntry = record + Key: TKey; + Value: TValue; + end; + + TJclBucket = class + public + type + THashEntryArray = array of TJclHashEntry; + public + Size: Integer; + Entries: THashEntryArray; + procedure FinalizeArrayBeforeMove(var List: THashEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArray(var List: THashEntryArray; FromIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure InitializeArrayAfterMove(var List: THashEntryArray; FromIndex, ToIndex, Count: SizeInt); + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + + procedure MoveArray(var List: THashEntryArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclHashMap = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclPairOwner, + IJclMap) + protected + type + TBucket = TJclBucket; + private + FOwnsKeys: Boolean; + FOwnsValues: Boolean; + protected + function Hash(const AKey: TKey): Integer; virtual; abstract; + function KeysEqual(const A, B: TKey): Boolean; virtual; abstract; + function ValuesEqual(const A, B: TValue): Boolean; virtual; abstract; + function CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; virtual; abstract; + function CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; virtual; abstract; + function CreateEmptyKeyList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; virtual; abstract; + public + { IJclPairOwner } + function FreeKey(var Key: TKey): TKey; + function FreeValue(var Value: TValue): TValue; + function GetOwnsKeys: Boolean; + function GetOwnsValues: Boolean; + property OwnsKeys: Boolean read FOwnsKeys; + property OwnsValues: Boolean read FOwnsValues; + private + FBuckets: array of TBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclMap } + procedure Clear; + function ContainsKey(const Key: TKey): Boolean; + function ContainsValue(const Value: TValue): Boolean; + function Extract(const Key: TKey): TValue; + function GetValue(const Key: TKey): TValue; + function IsEmpty: Boolean; + function KeyOfValue(const Value: TValue): TKey; + function KeySet: IJclSet; + function Keys: IJclCollection; + function MapEquals(const AMap: IJclMap): Boolean; + procedure PutAll(const AMap: IJclMap); + procedure PutValue(const Key: TKey; const Value: TValue); + function Remove(const Key: TKey): TValue; + function Size: Integer; + function Values: IJclCollection; + end; + + // E = external helper to compare and hash items + // KeyComparer is used only when getting KeySet + // GetHashCode and Equals methods of KeyEqualityComparer are used + // GetHashCode of ValueEqualityComparer is not used + TJclHashMapE = class(TJclHashMap, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, IJclMap, IJclPairOwner) + protected + type + TArrayList = TJclArrayListE; + TArraySet = TJclArraySetE; + TArrayKeyList = TJclArrayListE; + private + FKeyEqualityComparer: IJclEqualityComparer; + FKeyHashConverter: IJclHashConverter; + FKeyComparer: IJclComparer; + FValueEqualityComparer: IJclEqualityComparer; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function Hash(const AKey: TKey): Integer; override; + function KeysEqual(const A, B: TKey): Boolean; override; + function ValuesEqual(const A, B: TValue): Boolean; override; + function CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; override; + function CreateEmptyKeyList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; override; + public + constructor Create(const AKeyEqualityComparer: IJclEqualityComparer; + const AKeyHashConverter: IJclHashConverter; const AValueEqualityComparer: IJclEqualityComparer; + const AKeyComparer: IJclComparer; ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean); + + property KeyEqualityComparer: IJclEqualityComparer read FKeyEqualityComparer write FKeyEqualityComparer; + property KeyHashConverter: IJclHashConverter read FKeyHashConverter write FKeyHashConverter; + property KeyComparer: IJclComparer read FKeyComparer write FKeyComparer; + property ValueEqualityComparer: IJclEqualityComparer read FValueEqualityComparer write FValueEqualityComparer; + end; + + // F = Functions to compare and hash items + // KeyComparer is used only when getting KeySet + TJclHashMapF = class(TJclHashMap, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, IJclMap, IJclPairOwner) + protected + type + TArrayList = TJclArrayListF; + TArraySet = TJclArraySetF; + TArrayKeyList = TJclArrayListF; + private + FKeyEqualityCompare: TEqualityCompare; + FKeyHash: THashConvert; + FKeyCompare: TCompare; + FValueEqualityCompare: TEqualityCompare; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function Hash(const AKey: TKey): Integer; override; + function KeysEqual(const A, B: TKey): Boolean; override; + function ValuesEqual(const A, B: TValue): Boolean; override; + function CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; override; + function CreateEmptyKeyList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; override; + public + constructor Create(AKeyEqualityCompare: TEqualityCompare; AKeyHash: THashConvert; + AValueEqualityCompare: TEqualityCompare; AKeyCompare: TCompare; + ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean); + + property KeyEqualityCompare: TEqualityCompare read FKeyEqualityCompare write FKeyEqualityCompare; + property KeyCompare: TCompare read FKeyCompare write FKeyCompare; + property KeyHash: THashConvert read FKeyHash write FKeyHash; + property ValueEqualityCompare: TEqualityCompare read FValueEqualityCompare write FValueEqualityCompare; + end; + + // I = items can compare themselves to an other, items can create hash value from themselves + TJclHashMapI, IEquatable, IHashable; TValue: IEquatable> = class(TJclHashMap, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, + IJclMap, IJclPairOwner) + protected + type + TArrayList = TJclArrayListI; + TArraySet = TJclArraySetI; + TArrayKeyList = TJclArrayListI; + protected + function Hash(const AKey: TKey): Integer; override; + function KeysEqual(const A, B: TKey): Boolean; override; + function ValuesEqual(const A, B: TValue): Boolean; override; + function CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; override; + function CreateEmptyKeyList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; override; + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +{$IFDEF BCB} +{$IFDEF WIN64} + {$HPPEMIT '#ifdef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #undef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #define JclHashMaps_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT '#endif'} + + {$HPPEMIT END '#ifdef JclHashMaps_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #define MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #undef JclHashMaps_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END '#endif'} +{$ENDIF WIN64} +{$ENDIF BCB} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclResources; + +//=== { TJclIntfIntfHashMapBucket } ========================================== + +procedure TJclIntfIntfHashMapBucket.FinalizeArrayBeforeMove(var List: TJclIntfIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntfIntfHashMapBucket.InitializeArray(var List: TJclIntfIntfHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntfIntfHashMapBucket.InitializeArrayAfterMove(var List: TJclIntfIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntfIntfHashMapBucket.MoveArray(var List: TJclIntfIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclIntfIntfHashMap } ========================================== + +constructor TJclIntfIntfHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclIntfIntfHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfIntfHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclIntfIntfHashMapBucket; + ADest: TJclIntfIntfHashMap; + AMap: IJclIntfIntfMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclIntfIntfHashMap then + begin + ADest := TJclIntfIntfHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclIntfIntfHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclIntfIntfMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfIntfHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclIntfIntfHashMap then + TJclIntfIntfHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclIntfIntfHashMap.Clear; +var + I, J: Integer; + Bucket: TJclIntfIntfHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfHashMap.ContainsKey(const Key: IInterface): Boolean; +var + I: Integer; + Bucket: TJclIntfIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfHashMap.ContainsValue(const Value: IInterface): Boolean; +var + I, J: Integer; + Bucket: TJclIntfIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfHashMap.Extract(const Key: IInterface): IInterface; +var + Bucket: TJclIntfIntfHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfHashMap.GetValue(const Key: IInterface): IInterface; +var + I: Integer; + Bucket: TJclIntfIntfHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntfIntfHashMap.KeyOfValue(const Value: IInterface): IInterface; +var + I, J: Integer; + Bucket: TJclIntfIntfHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfHashMap.KeySet: IJclIntfSet; +var + I, J: Integer; + Bucket: TJclIntfIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfHashMap.Keys: IJclIntfCollection; +var + I, J: Integer; + Bucket: TJclIntfIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfHashMap.MapEquals(const AMap: IJclIntfIntfMap): Boolean; +var + I, J: Integer; + Bucket: TJclIntfIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfIntfHashMap.Pack; +var + I: Integer; + Bucket: TJclIntfIntfHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfIntfHashMap.PutAll(const AMap: IJclIntfIntfMap); +var + It: IJclIntfIterator; + Key: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfIntfHashMap.PutValue(const Key: IInterface; const Value: IInterface); +var + Index: Integer; + Bucket: TJclIntfIntfHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, nil) and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclIntfIntfHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfHashMap.Remove(const Key: IInterface): IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfIntfHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfIntfHashMap.Values: IJclIntfCollection; +var + I, J: Integer; + Bucket: TJclIntfIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfIntfHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclIntfIntfHashMap.FreeKey(var Key: IInterface): IInterface; +begin + Result := Key; + Key := nil; +end; + +function TJclIntfIntfHashMap.FreeValue(var Value: IInterface): IInterface; +begin + Result := Value; + Value := nil; +end; + +function TJclIntfIntfHashMap.KeysEqual(const A, B: IInterface): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclIntfIntfHashMap.ValuesEqual(const A, B: IInterface): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +//=== { TJclAnsiStrIntfHashMapBucket } ========================================== + +procedure TJclAnsiStrIntfHashMapBucket.FinalizeArrayBeforeMove(var List: TJclAnsiStrIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclAnsiStrIntfHashMapBucket.InitializeArray(var List: TJclAnsiStrIntfHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclAnsiStrIntfHashMapBucket.InitializeArrayAfterMove(var List: TJclAnsiStrIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclAnsiStrIntfHashMapBucket.MoveArray(var List: TJclAnsiStrIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclAnsiStrIntfHashMap } ========================================== + +constructor TJclAnsiStrIntfHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclAnsiStrIntfHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclAnsiStrIntfHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclAnsiStrIntfHashMapBucket; + ADest: TJclAnsiStrIntfHashMap; + AMap: IJclAnsiStrIntfMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclAnsiStrIntfHashMap then + begin + ADest := TJclAnsiStrIntfHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclAnsiStrIntfHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclAnsiStrIntfMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrIntfHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclAnsiStrIntfHashMap then + TJclAnsiStrIntfHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclAnsiStrIntfHashMap.Clear; +var + I, J: Integer; + Bucket: TJclAnsiStrIntfHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfHashMap.ContainsKey(const Key: AnsiString): Boolean; +var + I: Integer; + Bucket: TJclAnsiStrIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfHashMap.ContainsValue(const Value: IInterface): Boolean; +var + I, J: Integer; + Bucket: TJclAnsiStrIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfHashMap.Extract(const Key: AnsiString): IInterface; +var + Bucket: TJclAnsiStrIntfHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfHashMap.GetValue(const Key: AnsiString): IInterface; +var + I: Integer; + Bucket: TJclAnsiStrIntfHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclAnsiStrIntfHashMap.KeyOfValue(const Value: IInterface): AnsiString; +var + I, J: Integer; + Bucket: TJclAnsiStrIntfHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := ''; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfHashMap.KeySet: IJclAnsiStrSet; +var + I, J: Integer; + Bucket: TJclAnsiStrIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclAnsiStrArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfHashMap.Keys: IJclAnsiStrCollection; +var + I, J: Integer; + Bucket: TJclAnsiStrIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclAnsiStrArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfHashMap.MapEquals(const AMap: IJclAnsiStrIntfMap): Boolean; +var + I, J: Integer; + Bucket: TJclAnsiStrIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrIntfHashMap.Pack; +var + I: Integer; + Bucket: TJclAnsiStrIntfHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrIntfHashMap.PutAll(const AMap: IJclAnsiStrIntfMap); +var + It: IJclAnsiStrIterator; + Key: AnsiString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrIntfHashMap.PutValue(const Key: AnsiString; const Value: IInterface); +var + Index: Integer; + Bucket: TJclAnsiStrIntfHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, '') and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclAnsiStrIntfHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfHashMap.Remove(const Key: AnsiString): IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrIntfHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclAnsiStrIntfHashMap.Values: IJclIntfCollection; +var + I, J: Integer; + Bucket: TJclAnsiStrIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclAnsiStrIntfHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclAnsiStrIntfHashMap.FreeKey(var Key: AnsiString): AnsiString; +begin + Result := Key; + Key := ''; +end; + +function TJclAnsiStrIntfHashMap.FreeValue(var Value: IInterface): IInterface; +begin + Result := Value; + Value := nil; +end; + +function TJclAnsiStrIntfHashMap.KeysEqual(const A, B: AnsiString): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclAnsiStrIntfHashMap.ValuesEqual(const A, B: IInterface): Boolean; +begin + Result := IntfSimpleEqualityCompare(A, B); +end; + +//=== { TJclIntfAnsiStrHashMapBucket } ========================================== + +procedure TJclIntfAnsiStrHashMapBucket.FinalizeArrayBeforeMove(var List: TJclIntfAnsiStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntfAnsiStrHashMapBucket.InitializeArray(var List: TJclIntfAnsiStrHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntfAnsiStrHashMapBucket.InitializeArrayAfterMove(var List: TJclIntfAnsiStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntfAnsiStrHashMapBucket.MoveArray(var List: TJclIntfAnsiStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclIntfAnsiStrHashMap } ========================================== + +constructor TJclIntfAnsiStrHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclIntfAnsiStrHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfAnsiStrHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclIntfAnsiStrHashMapBucket; + ADest: TJclIntfAnsiStrHashMap; + AMap: IJclIntfAnsiStrMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclIntfAnsiStrHashMap then + begin + ADest := TJclIntfAnsiStrHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclIntfAnsiStrHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclIntfAnsiStrMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfAnsiStrHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclIntfAnsiStrHashMap then + TJclIntfAnsiStrHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclIntfAnsiStrHashMap.Clear; +var + I, J: Integer; + Bucket: TJclIntfAnsiStrHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrHashMap.ContainsKey(const Key: IInterface): Boolean; +var + I: Integer; + Bucket: TJclIntfAnsiStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrHashMap.ContainsValue(const Value: AnsiString): Boolean; +var + I, J: Integer; + Bucket: TJclIntfAnsiStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrHashMap.Extract(const Key: IInterface): AnsiString; +var + Bucket: TJclIntfAnsiStrHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := ''; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := ''; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrHashMap.GetValue(const Key: IInterface): AnsiString; +var + I: Integer; + Bucket: TJclIntfAnsiStrHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := ''; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntfAnsiStrHashMap.KeyOfValue(const Value: AnsiString): IInterface; +var + I, J: Integer; + Bucket: TJclIntfAnsiStrHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrHashMap.KeySet: IJclIntfSet; +var + I, J: Integer; + Bucket: TJclIntfAnsiStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrHashMap.Keys: IJclIntfCollection; +var + I, J: Integer; + Bucket: TJclIntfAnsiStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrHashMap.MapEquals(const AMap: IJclIntfAnsiStrMap): Boolean; +var + I, J: Integer; + Bucket: TJclIntfAnsiStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfAnsiStrHashMap.Pack; +var + I: Integer; + Bucket: TJclIntfAnsiStrHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfAnsiStrHashMap.PutAll(const AMap: IJclIntfAnsiStrMap); +var + It: IJclIntfIterator; + Key: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfAnsiStrHashMap.PutValue(const Key: IInterface; const Value: AnsiString); +var + Index: Integer; + Bucket: TJclIntfAnsiStrHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, nil) and not ValuesEqual(Value, '')) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclIntfAnsiStrHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrHashMap.Remove(const Key: IInterface): AnsiString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfAnsiStrHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfAnsiStrHashMap.Values: IJclAnsiStrCollection; +var + I, J: Integer; + Bucket: TJclIntfAnsiStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclAnsiStrArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfAnsiStrHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclIntfAnsiStrHashMap.FreeKey(var Key: IInterface): IInterface; +begin + Result := Key; + Key := nil; +end; + +function TJclIntfAnsiStrHashMap.FreeValue(var Value: AnsiString): AnsiString; +begin + Result := Value; + Value := ''; +end; + +function TJclIntfAnsiStrHashMap.Hash(const AInterface: IInterface): Integer; +begin + Result := IntfSimpleHashConvert(AInterface); +end; + +function TJclIntfAnsiStrHashMap.KeysEqual(const A, B: IInterface): Boolean; +begin + Result := IntfSimpleEqualityCompare(A, B); +end; + +function TJclIntfAnsiStrHashMap.ValuesEqual(const A, B: AnsiString): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +//=== { TJclAnsiStrAnsiStrHashMapBucket } ========================================== + +procedure TJclAnsiStrAnsiStrHashMapBucket.FinalizeArrayBeforeMove(var List: TJclAnsiStrAnsiStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclAnsiStrAnsiStrHashMapBucket.InitializeArray(var List: TJclAnsiStrAnsiStrHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclAnsiStrAnsiStrHashMapBucket.InitializeArrayAfterMove(var List: TJclAnsiStrAnsiStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclAnsiStrAnsiStrHashMapBucket.MoveArray(var List: TJclAnsiStrAnsiStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclAnsiStrAnsiStrHashMap } ========================================== + +constructor TJclAnsiStrAnsiStrHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclAnsiStrAnsiStrHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclAnsiStrAnsiStrHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclAnsiStrAnsiStrHashMapBucket; + ADest: TJclAnsiStrAnsiStrHashMap; + AMap: IJclAnsiStrAnsiStrMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclAnsiStrAnsiStrHashMap then + begin + ADest := TJclAnsiStrAnsiStrHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclAnsiStrAnsiStrHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclAnsiStrAnsiStrMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrAnsiStrHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclAnsiStrAnsiStrHashMap then + TJclAnsiStrAnsiStrHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclAnsiStrAnsiStrHashMap.Clear; +var + I, J: Integer; + Bucket: TJclAnsiStrAnsiStrHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrHashMap.ContainsKey(const Key: AnsiString): Boolean; +var + I: Integer; + Bucket: TJclAnsiStrAnsiStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrHashMap.ContainsValue(const Value: AnsiString): Boolean; +var + I, J: Integer; + Bucket: TJclAnsiStrAnsiStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrHashMap.Extract(const Key: AnsiString): AnsiString; +var + Bucket: TJclAnsiStrAnsiStrHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := ''; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := ''; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrHashMap.GetValue(const Key: AnsiString): AnsiString; +var + I: Integer; + Bucket: TJclAnsiStrAnsiStrHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := ''; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclAnsiStrAnsiStrHashMap.KeyOfValue(const Value: AnsiString): AnsiString; +var + I, J: Integer; + Bucket: TJclAnsiStrAnsiStrHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := ''; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrHashMap.KeySet: IJclAnsiStrSet; +var + I, J: Integer; + Bucket: TJclAnsiStrAnsiStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclAnsiStrArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrHashMap.Keys: IJclAnsiStrCollection; +var + I, J: Integer; + Bucket: TJclAnsiStrAnsiStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclAnsiStrArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrHashMap.MapEquals(const AMap: IJclAnsiStrAnsiStrMap): Boolean; +var + I, J: Integer; + Bucket: TJclAnsiStrAnsiStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrAnsiStrHashMap.Pack; +var + I: Integer; + Bucket: TJclAnsiStrAnsiStrHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrAnsiStrHashMap.PutAll(const AMap: IJclAnsiStrAnsiStrMap); +var + It: IJclAnsiStrIterator; + Key: AnsiString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrAnsiStrHashMap.PutValue(const Key: AnsiString; const Value: AnsiString); +var + Index: Integer; + Bucket: TJclAnsiStrAnsiStrHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, '') and not ValuesEqual(Value, '')) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclAnsiStrAnsiStrHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrHashMap.Remove(const Key: AnsiString): AnsiString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrAnsiStrHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclAnsiStrAnsiStrHashMap.Values: IJclAnsiStrCollection; +var + I, J: Integer; + Bucket: TJclAnsiStrAnsiStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclAnsiStrArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclAnsiStrAnsiStrHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclAnsiStrAnsiStrHashMap.FreeKey(var Key: AnsiString): AnsiString; +begin + Result := Key; + Key := ''; +end; + +function TJclAnsiStrAnsiStrHashMap.FreeValue(var Value: AnsiString): AnsiString; +begin + Result := Value; + Value := ''; +end; + +function TJclAnsiStrAnsiStrHashMap.KeysEqual(const A, B: AnsiString): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclAnsiStrAnsiStrHashMap.ValuesEqual(const A, B: AnsiString): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +//=== { TJclWideStrIntfHashMapBucket } ========================================== + +procedure TJclWideStrIntfHashMapBucket.FinalizeArrayBeforeMove(var List: TJclWideStrIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclWideStrIntfHashMapBucket.InitializeArray(var List: TJclWideStrIntfHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclWideStrIntfHashMapBucket.InitializeArrayAfterMove(var List: TJclWideStrIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclWideStrIntfHashMapBucket.MoveArray(var List: TJclWideStrIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclWideStrIntfHashMap } ========================================== + +constructor TJclWideStrIntfHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclWideStrIntfHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclWideStrIntfHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclWideStrIntfHashMapBucket; + ADest: TJclWideStrIntfHashMap; + AMap: IJclWideStrIntfMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclWideStrIntfHashMap then + begin + ADest := TJclWideStrIntfHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclWideStrIntfHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclWideStrIntfMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrIntfHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclWideStrIntfHashMap then + TJclWideStrIntfHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclWideStrIntfHashMap.Clear; +var + I, J: Integer; + Bucket: TJclWideStrIntfHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfHashMap.ContainsKey(const Key: WideString): Boolean; +var + I: Integer; + Bucket: TJclWideStrIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfHashMap.ContainsValue(const Value: IInterface): Boolean; +var + I, J: Integer; + Bucket: TJclWideStrIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfHashMap.Extract(const Key: WideString): IInterface; +var + Bucket: TJclWideStrIntfHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfHashMap.GetValue(const Key: WideString): IInterface; +var + I: Integer; + Bucket: TJclWideStrIntfHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclWideStrIntfHashMap.KeyOfValue(const Value: IInterface): WideString; +var + I, J: Integer; + Bucket: TJclWideStrIntfHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := ''; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfHashMap.KeySet: IJclWideStrSet; +var + I, J: Integer; + Bucket: TJclWideStrIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclWideStrArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfHashMap.Keys: IJclWideStrCollection; +var + I, J: Integer; + Bucket: TJclWideStrIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclWideStrArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfHashMap.MapEquals(const AMap: IJclWideStrIntfMap): Boolean; +var + I, J: Integer; + Bucket: TJclWideStrIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrIntfHashMap.Pack; +var + I: Integer; + Bucket: TJclWideStrIntfHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrIntfHashMap.PutAll(const AMap: IJclWideStrIntfMap); +var + It: IJclWideStrIterator; + Key: WideString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrIntfHashMap.PutValue(const Key: WideString; const Value: IInterface); +var + Index: Integer; + Bucket: TJclWideStrIntfHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, '') and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclWideStrIntfHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfHashMap.Remove(const Key: WideString): IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrIntfHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclWideStrIntfHashMap.Values: IJclIntfCollection; +var + I, J: Integer; + Bucket: TJclWideStrIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclWideStrIntfHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclWideStrIntfHashMap.FreeKey(var Key: WideString): WideString; +begin + Result := Key; + Key := ''; +end; + +function TJclWideStrIntfHashMap.FreeValue(var Value: IInterface): IInterface; +begin + Result := Value; + Value := nil; +end; + +function TJclWideStrIntfHashMap.KeysEqual(const A, B: WideString): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclWideStrIntfHashMap.ValuesEqual(const A, B: IInterface): Boolean; +begin + Result := IntfSimpleEqualityCompare(A, B); +end; + +//=== { TJclIntfWideStrHashMapBucket } ========================================== + +procedure TJclIntfWideStrHashMapBucket.FinalizeArrayBeforeMove(var List: TJclIntfWideStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntfWideStrHashMapBucket.InitializeArray(var List: TJclIntfWideStrHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntfWideStrHashMapBucket.InitializeArrayAfterMove(var List: TJclIntfWideStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntfWideStrHashMapBucket.MoveArray(var List: TJclIntfWideStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclIntfWideStrHashMap } ========================================== + +constructor TJclIntfWideStrHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclIntfWideStrHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfWideStrHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclIntfWideStrHashMapBucket; + ADest: TJclIntfWideStrHashMap; + AMap: IJclIntfWideStrMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclIntfWideStrHashMap then + begin + ADest := TJclIntfWideStrHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclIntfWideStrHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclIntfWideStrMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfWideStrHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclIntfWideStrHashMap then + TJclIntfWideStrHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclIntfWideStrHashMap.Clear; +var + I, J: Integer; + Bucket: TJclIntfWideStrHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrHashMap.ContainsKey(const Key: IInterface): Boolean; +var + I: Integer; + Bucket: TJclIntfWideStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrHashMap.ContainsValue(const Value: WideString): Boolean; +var + I, J: Integer; + Bucket: TJclIntfWideStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrHashMap.Extract(const Key: IInterface): WideString; +var + Bucket: TJclIntfWideStrHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := ''; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := ''; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrHashMap.GetValue(const Key: IInterface): WideString; +var + I: Integer; + Bucket: TJclIntfWideStrHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := ''; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntfWideStrHashMap.KeyOfValue(const Value: WideString): IInterface; +var + I, J: Integer; + Bucket: TJclIntfWideStrHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrHashMap.KeySet: IJclIntfSet; +var + I, J: Integer; + Bucket: TJclIntfWideStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrHashMap.Keys: IJclIntfCollection; +var + I, J: Integer; + Bucket: TJclIntfWideStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrHashMap.MapEquals(const AMap: IJclIntfWideStrMap): Boolean; +var + I, J: Integer; + Bucket: TJclIntfWideStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfWideStrHashMap.Pack; +var + I: Integer; + Bucket: TJclIntfWideStrHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfWideStrHashMap.PutAll(const AMap: IJclIntfWideStrMap); +var + It: IJclIntfIterator; + Key: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfWideStrHashMap.PutValue(const Key: IInterface; const Value: WideString); +var + Index: Integer; + Bucket: TJclIntfWideStrHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, nil) and not ValuesEqual(Value, '')) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclIntfWideStrHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrHashMap.Remove(const Key: IInterface): WideString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfWideStrHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfWideStrHashMap.Values: IJclWideStrCollection; +var + I, J: Integer; + Bucket: TJclIntfWideStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclWideStrArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfWideStrHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclIntfWideStrHashMap.FreeKey(var Key: IInterface): IInterface; +begin + Result := Key; + Key := nil; +end; + +function TJclIntfWideStrHashMap.FreeValue(var Value: WideString): WideString; +begin + Result := Value; + Value := ''; +end; + +function TJclIntfWideStrHashMap.Hash(const AInterface: IInterface): Integer; +begin + Result := IntfSimpleHashConvert(AInterface); +end; + +function TJclIntfWideStrHashMap.KeysEqual(const A, B: IInterface): Boolean; +begin + Result := IntfSimpleEqualityCompare(A, B); +end; + +function TJclIntfWideStrHashMap.ValuesEqual(const A, B: WideString): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +//=== { TJclWideStrWideStrHashMapBucket } ========================================== + +procedure TJclWideStrWideStrHashMapBucket.FinalizeArrayBeforeMove(var List: TJclWideStrWideStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclWideStrWideStrHashMapBucket.InitializeArray(var List: TJclWideStrWideStrHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclWideStrWideStrHashMapBucket.InitializeArrayAfterMove(var List: TJclWideStrWideStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclWideStrWideStrHashMapBucket.MoveArray(var List: TJclWideStrWideStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclWideStrWideStrHashMap } ========================================== + +constructor TJclWideStrWideStrHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclWideStrWideStrHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclWideStrWideStrHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclWideStrWideStrHashMapBucket; + ADest: TJclWideStrWideStrHashMap; + AMap: IJclWideStrWideStrMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclWideStrWideStrHashMap then + begin + ADest := TJclWideStrWideStrHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclWideStrWideStrHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclWideStrWideStrMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrWideStrHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclWideStrWideStrHashMap then + TJclWideStrWideStrHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclWideStrWideStrHashMap.Clear; +var + I, J: Integer; + Bucket: TJclWideStrWideStrHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrHashMap.ContainsKey(const Key: WideString): Boolean; +var + I: Integer; + Bucket: TJclWideStrWideStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrHashMap.ContainsValue(const Value: WideString): Boolean; +var + I, J: Integer; + Bucket: TJclWideStrWideStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrHashMap.Extract(const Key: WideString): WideString; +var + Bucket: TJclWideStrWideStrHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := ''; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := ''; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrHashMap.GetValue(const Key: WideString): WideString; +var + I: Integer; + Bucket: TJclWideStrWideStrHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := ''; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclWideStrWideStrHashMap.KeyOfValue(const Value: WideString): WideString; +var + I, J: Integer; + Bucket: TJclWideStrWideStrHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := ''; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrHashMap.KeySet: IJclWideStrSet; +var + I, J: Integer; + Bucket: TJclWideStrWideStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclWideStrArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrHashMap.Keys: IJclWideStrCollection; +var + I, J: Integer; + Bucket: TJclWideStrWideStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclWideStrArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrHashMap.MapEquals(const AMap: IJclWideStrWideStrMap): Boolean; +var + I, J: Integer; + Bucket: TJclWideStrWideStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrWideStrHashMap.Pack; +var + I: Integer; + Bucket: TJclWideStrWideStrHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrWideStrHashMap.PutAll(const AMap: IJclWideStrWideStrMap); +var + It: IJclWideStrIterator; + Key: WideString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrWideStrHashMap.PutValue(const Key: WideString; const Value: WideString); +var + Index: Integer; + Bucket: TJclWideStrWideStrHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, '') and not ValuesEqual(Value, '')) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclWideStrWideStrHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrHashMap.Remove(const Key: WideString): WideString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrWideStrHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclWideStrWideStrHashMap.Values: IJclWideStrCollection; +var + I, J: Integer; + Bucket: TJclWideStrWideStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclWideStrArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclWideStrWideStrHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclWideStrWideStrHashMap.FreeKey(var Key: WideString): WideString; +begin + Result := Key; + Key := ''; +end; + +function TJclWideStrWideStrHashMap.FreeValue(var Value: WideString): WideString; +begin + Result := Value; + Value := ''; +end; + +function TJclWideStrWideStrHashMap.KeysEqual(const A, B: WideString): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclWideStrWideStrHashMap.ValuesEqual(const A, B: WideString): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrIntfHashMapBucket } ========================================== + +procedure TJclUnicodeStrIntfHashMapBucket.FinalizeArrayBeforeMove(var List: TJclUnicodeStrIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclUnicodeStrIntfHashMapBucket.InitializeArray(var List: TJclUnicodeStrIntfHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclUnicodeStrIntfHashMapBucket.InitializeArrayAfterMove(var List: TJclUnicodeStrIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclUnicodeStrIntfHashMapBucket.MoveArray(var List: TJclUnicodeStrIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + + +{$ENDIF SUPPORTS_UNICODE_STRING} + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrIntfHashMap } ========================================== + +constructor TJclUnicodeStrIntfHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclUnicodeStrIntfHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclUnicodeStrIntfHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclUnicodeStrIntfHashMapBucket; + ADest: TJclUnicodeStrIntfHashMap; + AMap: IJclUnicodeStrIntfMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclUnicodeStrIntfHashMap then + begin + ADest := TJclUnicodeStrIntfHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclUnicodeStrIntfHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclUnicodeStrIntfMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrIntfHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclUnicodeStrIntfHashMap then + TJclUnicodeStrIntfHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclUnicodeStrIntfHashMap.Clear; +var + I, J: Integer; + Bucket: TJclUnicodeStrIntfHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfHashMap.ContainsKey(const Key: UnicodeString): Boolean; +var + I: Integer; + Bucket: TJclUnicodeStrIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfHashMap.ContainsValue(const Value: IInterface): Boolean; +var + I, J: Integer; + Bucket: TJclUnicodeStrIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfHashMap.Extract(const Key: UnicodeString): IInterface; +var + Bucket: TJclUnicodeStrIntfHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfHashMap.GetValue(const Key: UnicodeString): IInterface; +var + I: Integer; + Bucket: TJclUnicodeStrIntfHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclUnicodeStrIntfHashMap.KeyOfValue(const Value: IInterface): UnicodeString; +var + I, J: Integer; + Bucket: TJclUnicodeStrIntfHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := ''; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfHashMap.KeySet: IJclUnicodeStrSet; +var + I, J: Integer; + Bucket: TJclUnicodeStrIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclUnicodeStrArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfHashMap.Keys: IJclUnicodeStrCollection; +var + I, J: Integer; + Bucket: TJclUnicodeStrIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclUnicodeStrArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfHashMap.MapEquals(const AMap: IJclUnicodeStrIntfMap): Boolean; +var + I, J: Integer; + Bucket: TJclUnicodeStrIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrIntfHashMap.Pack; +var + I: Integer; + Bucket: TJclUnicodeStrIntfHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrIntfHashMap.PutAll(const AMap: IJclUnicodeStrIntfMap); +var + It: IJclUnicodeStrIterator; + Key: UnicodeString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrIntfHashMap.PutValue(const Key: UnicodeString; const Value: IInterface); +var + Index: Integer; + Bucket: TJclUnicodeStrIntfHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, '') and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclUnicodeStrIntfHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfHashMap.Remove(const Key: UnicodeString): IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrIntfHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclUnicodeStrIntfHashMap.Values: IJclIntfCollection; +var + I, J: Integer; + Bucket: TJclUnicodeStrIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclUnicodeStrIntfHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclUnicodeStrIntfHashMap.FreeKey(var Key: UnicodeString): UnicodeString; +begin + Result := Key; + Key := ''; +end; + +function TJclUnicodeStrIntfHashMap.FreeValue(var Value: IInterface): IInterface; +begin + Result := Value; + Value := nil; +end; + +function TJclUnicodeStrIntfHashMap.KeysEqual(const A, B: UnicodeString): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclUnicodeStrIntfHashMap.ValuesEqual(const A, B: IInterface): Boolean; +begin + Result := IntfSimpleEqualityCompare(A, B); +end; + +{$ENDIF SUPPORTS_UNICODE_STRING} + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclIntfUnicodeStrHashMapBucket } ========================================== + +procedure TJclIntfUnicodeStrHashMapBucket.FinalizeArrayBeforeMove(var List: TJclIntfUnicodeStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntfUnicodeStrHashMapBucket.InitializeArray(var List: TJclIntfUnicodeStrHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntfUnicodeStrHashMapBucket.InitializeArrayAfterMove(var List: TJclIntfUnicodeStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntfUnicodeStrHashMapBucket.MoveArray(var List: TJclIntfUnicodeStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + + +{$ENDIF SUPPORTS_UNICODE_STRING} + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclIntfUnicodeStrHashMap } ========================================== + +constructor TJclIntfUnicodeStrHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclIntfUnicodeStrHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfUnicodeStrHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclIntfUnicodeStrHashMapBucket; + ADest: TJclIntfUnicodeStrHashMap; + AMap: IJclIntfUnicodeStrMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclIntfUnicodeStrHashMap then + begin + ADest := TJclIntfUnicodeStrHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclIntfUnicodeStrHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclIntfUnicodeStrMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfUnicodeStrHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclIntfUnicodeStrHashMap then + TJclIntfUnicodeStrHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclIntfUnicodeStrHashMap.Clear; +var + I, J: Integer; + Bucket: TJclIntfUnicodeStrHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrHashMap.ContainsKey(const Key: IInterface): Boolean; +var + I: Integer; + Bucket: TJclIntfUnicodeStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrHashMap.ContainsValue(const Value: UnicodeString): Boolean; +var + I, J: Integer; + Bucket: TJclIntfUnicodeStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrHashMap.Extract(const Key: IInterface): UnicodeString; +var + Bucket: TJclIntfUnicodeStrHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := ''; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := ''; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrHashMap.GetValue(const Key: IInterface): UnicodeString; +var + I: Integer; + Bucket: TJclIntfUnicodeStrHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := ''; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntfUnicodeStrHashMap.KeyOfValue(const Value: UnicodeString): IInterface; +var + I, J: Integer; + Bucket: TJclIntfUnicodeStrHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrHashMap.KeySet: IJclIntfSet; +var + I, J: Integer; + Bucket: TJclIntfUnicodeStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrHashMap.Keys: IJclIntfCollection; +var + I, J: Integer; + Bucket: TJclIntfUnicodeStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrHashMap.MapEquals(const AMap: IJclIntfUnicodeStrMap): Boolean; +var + I, J: Integer; + Bucket: TJclIntfUnicodeStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfUnicodeStrHashMap.Pack; +var + I: Integer; + Bucket: TJclIntfUnicodeStrHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfUnicodeStrHashMap.PutAll(const AMap: IJclIntfUnicodeStrMap); +var + It: IJclIntfIterator; + Key: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfUnicodeStrHashMap.PutValue(const Key: IInterface; const Value: UnicodeString); +var + Index: Integer; + Bucket: TJclIntfUnicodeStrHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, nil) and not ValuesEqual(Value, '')) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclIntfUnicodeStrHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrHashMap.Remove(const Key: IInterface): UnicodeString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfUnicodeStrHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfUnicodeStrHashMap.Values: IJclUnicodeStrCollection; +var + I, J: Integer; + Bucket: TJclIntfUnicodeStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclUnicodeStrArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfUnicodeStrHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclIntfUnicodeStrHashMap.FreeKey(var Key: IInterface): IInterface; +begin + Result := Key; + Key := nil; +end; + +function TJclIntfUnicodeStrHashMap.FreeValue(var Value: UnicodeString): UnicodeString; +begin + Result := Value; + Value := ''; +end; + +function TJclIntfUnicodeStrHashMap.Hash(const AInterface: IInterface): Integer; +begin + Result := IntfSimpleHashConvert(AInterface); +end; + +function TJclIntfUnicodeStrHashMap.KeysEqual(const A, B: IInterface): Boolean; +begin + Result := IntfSimpleEqualityCompare(A, B); +end; + +function TJclIntfUnicodeStrHashMap.ValuesEqual(const A, B: UnicodeString): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +{$ENDIF SUPPORTS_UNICODE_STRING} + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrUnicodeStrHashMapBucket } ========================================== + +procedure TJclUnicodeStrUnicodeStrHashMapBucket.FinalizeArrayBeforeMove(var List: TJclUnicodeStrUnicodeStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclUnicodeStrUnicodeStrHashMapBucket.InitializeArray(var List: TJclUnicodeStrUnicodeStrHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclUnicodeStrUnicodeStrHashMapBucket.InitializeArrayAfterMove(var List: TJclUnicodeStrUnicodeStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclUnicodeStrUnicodeStrHashMapBucket.MoveArray(var List: TJclUnicodeStrUnicodeStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + + +{$ENDIF SUPPORTS_UNICODE_STRING} + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrUnicodeStrHashMap } ========================================== + +constructor TJclUnicodeStrUnicodeStrHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclUnicodeStrUnicodeStrHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclUnicodeStrUnicodeStrHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclUnicodeStrUnicodeStrHashMapBucket; + ADest: TJclUnicodeStrUnicodeStrHashMap; + AMap: IJclUnicodeStrUnicodeStrMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclUnicodeStrUnicodeStrHashMap then + begin + ADest := TJclUnicodeStrUnicodeStrHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclUnicodeStrUnicodeStrHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclUnicodeStrUnicodeStrMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrUnicodeStrHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclUnicodeStrUnicodeStrHashMap then + TJclUnicodeStrUnicodeStrHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclUnicodeStrUnicodeStrHashMap.Clear; +var + I, J: Integer; + Bucket: TJclUnicodeStrUnicodeStrHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrHashMap.ContainsKey(const Key: UnicodeString): Boolean; +var + I: Integer; + Bucket: TJclUnicodeStrUnicodeStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrHashMap.ContainsValue(const Value: UnicodeString): Boolean; +var + I, J: Integer; + Bucket: TJclUnicodeStrUnicodeStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrHashMap.Extract(const Key: UnicodeString): UnicodeString; +var + Bucket: TJclUnicodeStrUnicodeStrHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := ''; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := ''; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrHashMap.GetValue(const Key: UnicodeString): UnicodeString; +var + I: Integer; + Bucket: TJclUnicodeStrUnicodeStrHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := ''; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclUnicodeStrUnicodeStrHashMap.KeyOfValue(const Value: UnicodeString): UnicodeString; +var + I, J: Integer; + Bucket: TJclUnicodeStrUnicodeStrHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := ''; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrHashMap.KeySet: IJclUnicodeStrSet; +var + I, J: Integer; + Bucket: TJclUnicodeStrUnicodeStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclUnicodeStrArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrHashMap.Keys: IJclUnicodeStrCollection; +var + I, J: Integer; + Bucket: TJclUnicodeStrUnicodeStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclUnicodeStrArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrHashMap.MapEquals(const AMap: IJclUnicodeStrUnicodeStrMap): Boolean; +var + I, J: Integer; + Bucket: TJclUnicodeStrUnicodeStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrUnicodeStrHashMap.Pack; +var + I: Integer; + Bucket: TJclUnicodeStrUnicodeStrHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrUnicodeStrHashMap.PutAll(const AMap: IJclUnicodeStrUnicodeStrMap); +var + It: IJclUnicodeStrIterator; + Key: UnicodeString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrUnicodeStrHashMap.PutValue(const Key: UnicodeString; const Value: UnicodeString); +var + Index: Integer; + Bucket: TJclUnicodeStrUnicodeStrHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, '') and not ValuesEqual(Value, '')) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclUnicodeStrUnicodeStrHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrHashMap.Remove(const Key: UnicodeString): UnicodeString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrUnicodeStrHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclUnicodeStrUnicodeStrHashMap.Values: IJclUnicodeStrCollection; +var + I, J: Integer; + Bucket: TJclUnicodeStrUnicodeStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclUnicodeStrArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclUnicodeStrUnicodeStrHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclUnicodeStrUnicodeStrHashMap.FreeKey(var Key: UnicodeString): UnicodeString; +begin + Result := Key; + Key := ''; +end; + +function TJclUnicodeStrUnicodeStrHashMap.FreeValue(var Value: UnicodeString): UnicodeString; +begin + Result := Value; + Value := ''; +end; + +function TJclUnicodeStrUnicodeStrHashMap.KeysEqual(const A, B: UnicodeString): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclUnicodeStrUnicodeStrHashMap.ValuesEqual(const A, B: UnicodeString): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +{$ENDIF SUPPORTS_UNICODE_STRING} + +//=== { TJclSingleIntfHashMapBucket } ========================================== + +procedure TJclSingleIntfHashMapBucket.FinalizeArrayBeforeMove(var List: TJclSingleIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclSingleIntfHashMapBucket.InitializeArray(var List: TJclSingleIntfHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclSingleIntfHashMapBucket.InitializeArrayAfterMove(var List: TJclSingleIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclSingleIntfHashMapBucket.MoveArray(var List: TJclSingleIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclSingleIntfHashMap } ========================================== + +constructor TJclSingleIntfHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclSingleIntfHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclSingleIntfHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclSingleIntfHashMapBucket; + ADest: TJclSingleIntfHashMap; + AMap: IJclSingleIntfMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclSingleIntfHashMap then + begin + ADest := TJclSingleIntfHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclSingleIntfHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclSingleIntfMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleIntfHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclSingleIntfHashMap then + TJclSingleIntfHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclSingleIntfHashMap.Clear; +var + I, J: Integer; + Bucket: TJclSingleIntfHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfHashMap.ContainsKey(const Key: Single): Boolean; +var + I: Integer; + Bucket: TJclSingleIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfHashMap.ContainsValue(const Value: IInterface): Boolean; +var + I, J: Integer; + Bucket: TJclSingleIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfHashMap.Extract(const Key: Single): IInterface; +var + Bucket: TJclSingleIntfHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfHashMap.GetValue(const Key: Single): IInterface; +var + I: Integer; + Bucket: TJclSingleIntfHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclSingleIntfHashMap.KeyOfValue(const Value: IInterface): Single; +var + I, J: Integer; + Bucket: TJclSingleIntfHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0.0; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfHashMap.KeySet: IJclSingleSet; +var + I, J: Integer; + Bucket: TJclSingleIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclSingleArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfHashMap.Keys: IJclSingleCollection; +var + I, J: Integer; + Bucket: TJclSingleIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclSingleArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfHashMap.MapEquals(const AMap: IJclSingleIntfMap): Boolean; +var + I, J: Integer; + Bucket: TJclSingleIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleIntfHashMap.Pack; +var + I: Integer; + Bucket: TJclSingleIntfHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleIntfHashMap.PutAll(const AMap: IJclSingleIntfMap); +var + It: IJclSingleIterator; + Key: Single; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleIntfHashMap.PutValue(const Key: Single; const Value: IInterface); +var + Index: Integer; + Bucket: TJclSingleIntfHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, 0.0) and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclSingleIntfHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfHashMap.Remove(const Key: Single): IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleIntfHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclSingleIntfHashMap.Values: IJclIntfCollection; +var + I, J: Integer; + Bucket: TJclSingleIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclSingleIntfHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclSingleIntfHashMap.FreeKey(var Key: Single): Single; +begin + Result := Key; + Key := 0.0; +end; + +function TJclSingleIntfHashMap.FreeValue(var Value: IInterface): IInterface; +begin + Result := Value; + Value := nil; +end; + +function TJclSingleIntfHashMap.KeysEqual(const A, B: Single): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclSingleIntfHashMap.ValuesEqual(const A, B: IInterface): Boolean; +begin + Result := IntfSimpleEqualityCompare(A, B); +end; + +//=== { TJclIntfSingleHashMapBucket } ========================================== + +procedure TJclIntfSingleHashMapBucket.FinalizeArrayBeforeMove(var List: TJclIntfSingleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntfSingleHashMapBucket.InitializeArray(var List: TJclIntfSingleHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntfSingleHashMapBucket.InitializeArrayAfterMove(var List: TJclIntfSingleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntfSingleHashMapBucket.MoveArray(var List: TJclIntfSingleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclIntfSingleHashMap } ========================================== + +constructor TJclIntfSingleHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclIntfSingleHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfSingleHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclIntfSingleHashMapBucket; + ADest: TJclIntfSingleHashMap; + AMap: IJclIntfSingleMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclIntfSingleHashMap then + begin + ADest := TJclIntfSingleHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclIntfSingleHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclIntfSingleMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfSingleHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclIntfSingleHashMap then + TJclIntfSingleHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclIntfSingleHashMap.Clear; +var + I, J: Integer; + Bucket: TJclIntfSingleHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleHashMap.ContainsKey(const Key: IInterface): Boolean; +var + I: Integer; + Bucket: TJclIntfSingleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleHashMap.ContainsValue(const Value: Single): Boolean; +var + I, J: Integer; + Bucket: TJclIntfSingleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleHashMap.Extract(const Key: IInterface): Single; +var + Bucket: TJclIntfSingleHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0.0; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := 0.0; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleHashMap.GetValue(const Key: IInterface): Single; +var + I: Integer; + Bucket: TJclIntfSingleHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0.0; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntfSingleHashMap.KeyOfValue(const Value: Single): IInterface; +var + I, J: Integer; + Bucket: TJclIntfSingleHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleHashMap.KeySet: IJclIntfSet; +var + I, J: Integer; + Bucket: TJclIntfSingleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleHashMap.Keys: IJclIntfCollection; +var + I, J: Integer; + Bucket: TJclIntfSingleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleHashMap.MapEquals(const AMap: IJclIntfSingleMap): Boolean; +var + I, J: Integer; + Bucket: TJclIntfSingleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfSingleHashMap.Pack; +var + I: Integer; + Bucket: TJclIntfSingleHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfSingleHashMap.PutAll(const AMap: IJclIntfSingleMap); +var + It: IJclIntfIterator; + Key: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfSingleHashMap.PutValue(const Key: IInterface; const Value: Single); +var + Index: Integer; + Bucket: TJclIntfSingleHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, nil) and not ValuesEqual(Value, 0.0)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclIntfSingleHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleHashMap.Remove(const Key: IInterface): Single; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfSingleHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfSingleHashMap.Values: IJclSingleCollection; +var + I, J: Integer; + Bucket: TJclIntfSingleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclSingleArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfSingleHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclIntfSingleHashMap.FreeKey(var Key: IInterface): IInterface; +begin + Result := Key; + Key := nil; +end; + +function TJclIntfSingleHashMap.FreeValue(var Value: Single): Single; +begin + Result := Value; + Value := 0.0; +end; + +function TJclIntfSingleHashMap.Hash(const AInterface: IInterface): Integer; +begin + Result := IntfSimpleHashConvert(AInterface); +end; + +function TJclIntfSingleHashMap.KeysEqual(const A, B: IInterface): Boolean; +begin + Result := IntfSimpleEqualityCompare(A, B); +end; + +function TJclIntfSingleHashMap.ValuesEqual(const A, B: Single): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +//=== { TJclSingleSingleHashMapBucket } ========================================== + +procedure TJclSingleSingleHashMapBucket.InitializeArrayAfterMove(var List: TJclSingleSingleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclSingleSingleHashMapBucket.MoveArray(var List: TJclSingleSingleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclSingleSingleHashMap } ========================================== + +constructor TJclSingleSingleHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclSingleSingleHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclSingleSingleHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclSingleSingleHashMapBucket; + ADest: TJclSingleSingleHashMap; + AMap: IJclSingleSingleMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclSingleSingleHashMap then + begin + ADest := TJclSingleSingleHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclSingleSingleHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclSingleSingleMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleSingleHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclSingleSingleHashMap then + TJclSingleSingleHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclSingleSingleHashMap.Clear; +var + I, J: Integer; + Bucket: TJclSingleSingleHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleHashMap.ContainsKey(const Key: Single): Boolean; +var + I: Integer; + Bucket: TJclSingleSingleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleHashMap.ContainsValue(const Value: Single): Boolean; +var + I, J: Integer; + Bucket: TJclSingleSingleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleHashMap.Extract(const Key: Single): Single; +var + Bucket: TJclSingleSingleHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0.0; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := 0.0; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleHashMap.GetValue(const Key: Single): Single; +var + I: Integer; + Bucket: TJclSingleSingleHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0.0; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclSingleSingleHashMap.KeyOfValue(const Value: Single): Single; +var + I, J: Integer; + Bucket: TJclSingleSingleHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0.0; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleHashMap.KeySet: IJclSingleSet; +var + I, J: Integer; + Bucket: TJclSingleSingleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclSingleArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleHashMap.Keys: IJclSingleCollection; +var + I, J: Integer; + Bucket: TJclSingleSingleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclSingleArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleHashMap.MapEquals(const AMap: IJclSingleSingleMap): Boolean; +var + I, J: Integer; + Bucket: TJclSingleSingleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleSingleHashMap.Pack; +var + I: Integer; + Bucket: TJclSingleSingleHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleSingleHashMap.PutAll(const AMap: IJclSingleSingleMap); +var + It: IJclSingleIterator; + Key: Single; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleSingleHashMap.PutValue(const Key: Single; const Value: Single); +var + Index: Integer; + Bucket: TJclSingleSingleHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, 0.0) and not ValuesEqual(Value, 0.0)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclSingleSingleHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleHashMap.Remove(const Key: Single): Single; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleSingleHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclSingleSingleHashMap.Values: IJclSingleCollection; +var + I, J: Integer; + Bucket: TJclSingleSingleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclSingleArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclSingleSingleHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclSingleSingleHashMap.FreeKey(var Key: Single): Single; +begin + Result := Key; + Key := 0.0; +end; + +function TJclSingleSingleHashMap.FreeValue(var Value: Single): Single; +begin + Result := Value; + Value := 0.0; +end; + +function TJclSingleSingleHashMap.KeysEqual(const A, B: Single): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclSingleSingleHashMap.ValuesEqual(const A, B: Single): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +//=== { TJclDoubleIntfHashMapBucket } ========================================== + +procedure TJclDoubleIntfHashMapBucket.FinalizeArrayBeforeMove(var List: TJclDoubleIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclDoubleIntfHashMapBucket.InitializeArray(var List: TJclDoubleIntfHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclDoubleIntfHashMapBucket.InitializeArrayAfterMove(var List: TJclDoubleIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclDoubleIntfHashMapBucket.MoveArray(var List: TJclDoubleIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclDoubleIntfHashMap } ========================================== + +constructor TJclDoubleIntfHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclDoubleIntfHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclDoubleIntfHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclDoubleIntfHashMapBucket; + ADest: TJclDoubleIntfHashMap; + AMap: IJclDoubleIntfMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclDoubleIntfHashMap then + begin + ADest := TJclDoubleIntfHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclDoubleIntfHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclDoubleIntfMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleIntfHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclDoubleIntfHashMap then + TJclDoubleIntfHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclDoubleIntfHashMap.Clear; +var + I, J: Integer; + Bucket: TJclDoubleIntfHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfHashMap.ContainsKey(const Key: Double): Boolean; +var + I: Integer; + Bucket: TJclDoubleIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfHashMap.ContainsValue(const Value: IInterface): Boolean; +var + I, J: Integer; + Bucket: TJclDoubleIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfHashMap.Extract(const Key: Double): IInterface; +var + Bucket: TJclDoubleIntfHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfHashMap.GetValue(const Key: Double): IInterface; +var + I: Integer; + Bucket: TJclDoubleIntfHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclDoubleIntfHashMap.KeyOfValue(const Value: IInterface): Double; +var + I, J: Integer; + Bucket: TJclDoubleIntfHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0.0; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfHashMap.KeySet: IJclDoubleSet; +var + I, J: Integer; + Bucket: TJclDoubleIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclDoubleArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfHashMap.Keys: IJclDoubleCollection; +var + I, J: Integer; + Bucket: TJclDoubleIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclDoubleArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfHashMap.MapEquals(const AMap: IJclDoubleIntfMap): Boolean; +var + I, J: Integer; + Bucket: TJclDoubleIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleIntfHashMap.Pack; +var + I: Integer; + Bucket: TJclDoubleIntfHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleIntfHashMap.PutAll(const AMap: IJclDoubleIntfMap); +var + It: IJclDoubleIterator; + Key: Double; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleIntfHashMap.PutValue(const Key: Double; const Value: IInterface); +var + Index: Integer; + Bucket: TJclDoubleIntfHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, 0.0) and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclDoubleIntfHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfHashMap.Remove(const Key: Double): IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleIntfHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclDoubleIntfHashMap.Values: IJclIntfCollection; +var + I, J: Integer; + Bucket: TJclDoubleIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclDoubleIntfHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclDoubleIntfHashMap.FreeKey(var Key: Double): Double; +begin + Result := Key; + Key := 0.0; +end; + +function TJclDoubleIntfHashMap.FreeValue(var Value: IInterface): IInterface; +begin + Result := Value; + Value := nil; +end; + +function TJclDoubleIntfHashMap.KeysEqual(const A, B: Double): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclDoubleIntfHashMap.ValuesEqual(const A, B: IInterface): Boolean; +begin + Result := IntfSimpleEqualityCompare(A, B); +end; + +//=== { TJclIntfDoubleHashMapBucket } ========================================== + +procedure TJclIntfDoubleHashMapBucket.FinalizeArrayBeforeMove(var List: TJclIntfDoubleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntfDoubleHashMapBucket.InitializeArray(var List: TJclIntfDoubleHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntfDoubleHashMapBucket.InitializeArrayAfterMove(var List: TJclIntfDoubleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntfDoubleHashMapBucket.MoveArray(var List: TJclIntfDoubleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclIntfDoubleHashMap } ========================================== + +constructor TJclIntfDoubleHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclIntfDoubleHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfDoubleHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclIntfDoubleHashMapBucket; + ADest: TJclIntfDoubleHashMap; + AMap: IJclIntfDoubleMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclIntfDoubleHashMap then + begin + ADest := TJclIntfDoubleHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclIntfDoubleHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclIntfDoubleMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfDoubleHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclIntfDoubleHashMap then + TJclIntfDoubleHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclIntfDoubleHashMap.Clear; +var + I, J: Integer; + Bucket: TJclIntfDoubleHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleHashMap.ContainsKey(const Key: IInterface): Boolean; +var + I: Integer; + Bucket: TJclIntfDoubleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleHashMap.ContainsValue(const Value: Double): Boolean; +var + I, J: Integer; + Bucket: TJclIntfDoubleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleHashMap.Extract(const Key: IInterface): Double; +var + Bucket: TJclIntfDoubleHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0.0; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := 0.0; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleHashMap.GetValue(const Key: IInterface): Double; +var + I: Integer; + Bucket: TJclIntfDoubleHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0.0; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntfDoubleHashMap.KeyOfValue(const Value: Double): IInterface; +var + I, J: Integer; + Bucket: TJclIntfDoubleHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleHashMap.KeySet: IJclIntfSet; +var + I, J: Integer; + Bucket: TJclIntfDoubleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleHashMap.Keys: IJclIntfCollection; +var + I, J: Integer; + Bucket: TJclIntfDoubleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleHashMap.MapEquals(const AMap: IJclIntfDoubleMap): Boolean; +var + I, J: Integer; + Bucket: TJclIntfDoubleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfDoubleHashMap.Pack; +var + I: Integer; + Bucket: TJclIntfDoubleHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfDoubleHashMap.PutAll(const AMap: IJclIntfDoubleMap); +var + It: IJclIntfIterator; + Key: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfDoubleHashMap.PutValue(const Key: IInterface; const Value: Double); +var + Index: Integer; + Bucket: TJclIntfDoubleHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, nil) and not ValuesEqual(Value, 0.0)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclIntfDoubleHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleHashMap.Remove(const Key: IInterface): Double; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfDoubleHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfDoubleHashMap.Values: IJclDoubleCollection; +var + I, J: Integer; + Bucket: TJclIntfDoubleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclDoubleArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfDoubleHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclIntfDoubleHashMap.FreeKey(var Key: IInterface): IInterface; +begin + Result := Key; + Key := nil; +end; + +function TJclIntfDoubleHashMap.FreeValue(var Value: Double): Double; +begin + Result := Value; + Value := 0.0; +end; + +function TJclIntfDoubleHashMap.Hash(const AInterface: IInterface): Integer; +begin + Result := IntfSimpleHashConvert(AInterface); +end; + +function TJclIntfDoubleHashMap.KeysEqual(const A, B: IInterface): Boolean; +begin + Result := IntfSimpleEqualityCompare(A, B); +end; + +function TJclIntfDoubleHashMap.ValuesEqual(const A, B: Double): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +//=== { TJclDoubleDoubleHashMapBucket } ========================================== + +procedure TJclDoubleDoubleHashMapBucket.InitializeArrayAfterMove(var List: TJclDoubleDoubleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclDoubleDoubleHashMapBucket.MoveArray(var List: TJclDoubleDoubleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclDoubleDoubleHashMap } ========================================== + +constructor TJclDoubleDoubleHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclDoubleDoubleHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclDoubleDoubleHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclDoubleDoubleHashMapBucket; + ADest: TJclDoubleDoubleHashMap; + AMap: IJclDoubleDoubleMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclDoubleDoubleHashMap then + begin + ADest := TJclDoubleDoubleHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclDoubleDoubleHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclDoubleDoubleMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleDoubleHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclDoubleDoubleHashMap then + TJclDoubleDoubleHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclDoubleDoubleHashMap.Clear; +var + I, J: Integer; + Bucket: TJclDoubleDoubleHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleHashMap.ContainsKey(const Key: Double): Boolean; +var + I: Integer; + Bucket: TJclDoubleDoubleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleHashMap.ContainsValue(const Value: Double): Boolean; +var + I, J: Integer; + Bucket: TJclDoubleDoubleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleHashMap.Extract(const Key: Double): Double; +var + Bucket: TJclDoubleDoubleHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0.0; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := 0.0; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleHashMap.GetValue(const Key: Double): Double; +var + I: Integer; + Bucket: TJclDoubleDoubleHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0.0; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclDoubleDoubleHashMap.KeyOfValue(const Value: Double): Double; +var + I, J: Integer; + Bucket: TJclDoubleDoubleHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0.0; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleHashMap.KeySet: IJclDoubleSet; +var + I, J: Integer; + Bucket: TJclDoubleDoubleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclDoubleArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleHashMap.Keys: IJclDoubleCollection; +var + I, J: Integer; + Bucket: TJclDoubleDoubleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclDoubleArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleHashMap.MapEquals(const AMap: IJclDoubleDoubleMap): Boolean; +var + I, J: Integer; + Bucket: TJclDoubleDoubleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleDoubleHashMap.Pack; +var + I: Integer; + Bucket: TJclDoubleDoubleHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleDoubleHashMap.PutAll(const AMap: IJclDoubleDoubleMap); +var + It: IJclDoubleIterator; + Key: Double; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleDoubleHashMap.PutValue(const Key: Double; const Value: Double); +var + Index: Integer; + Bucket: TJclDoubleDoubleHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, 0.0) and not ValuesEqual(Value, 0.0)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclDoubleDoubleHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleHashMap.Remove(const Key: Double): Double; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleDoubleHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclDoubleDoubleHashMap.Values: IJclDoubleCollection; +var + I, J: Integer; + Bucket: TJclDoubleDoubleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclDoubleArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclDoubleDoubleHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclDoubleDoubleHashMap.FreeKey(var Key: Double): Double; +begin + Result := Key; + Key := 0.0; +end; + +function TJclDoubleDoubleHashMap.FreeValue(var Value: Double): Double; +begin + Result := Value; + Value := 0.0; +end; + +function TJclDoubleDoubleHashMap.KeysEqual(const A, B: Double): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclDoubleDoubleHashMap.ValuesEqual(const A, B: Double): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +//=== { TJclExtendedIntfHashMapBucket } ========================================== + +procedure TJclExtendedIntfHashMapBucket.FinalizeArrayBeforeMove(var List: TJclExtendedIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclExtendedIntfHashMapBucket.InitializeArray(var List: TJclExtendedIntfHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclExtendedIntfHashMapBucket.InitializeArrayAfterMove(var List: TJclExtendedIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclExtendedIntfHashMapBucket.MoveArray(var List: TJclExtendedIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclExtendedIntfHashMap } ========================================== + +constructor TJclExtendedIntfHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclExtendedIntfHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclExtendedIntfHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclExtendedIntfHashMapBucket; + ADest: TJclExtendedIntfHashMap; + AMap: IJclExtendedIntfMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclExtendedIntfHashMap then + begin + ADest := TJclExtendedIntfHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclExtendedIntfHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclExtendedIntfMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedIntfHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclExtendedIntfHashMap then + TJclExtendedIntfHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclExtendedIntfHashMap.Clear; +var + I, J: Integer; + Bucket: TJclExtendedIntfHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfHashMap.ContainsKey(const Key: Extended): Boolean; +var + I: Integer; + Bucket: TJclExtendedIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfHashMap.ContainsValue(const Value: IInterface): Boolean; +var + I, J: Integer; + Bucket: TJclExtendedIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfHashMap.Extract(const Key: Extended): IInterface; +var + Bucket: TJclExtendedIntfHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfHashMap.GetValue(const Key: Extended): IInterface; +var + I: Integer; + Bucket: TJclExtendedIntfHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclExtendedIntfHashMap.KeyOfValue(const Value: IInterface): Extended; +var + I, J: Integer; + Bucket: TJclExtendedIntfHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0.0; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfHashMap.KeySet: IJclExtendedSet; +var + I, J: Integer; + Bucket: TJclExtendedIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclExtendedArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfHashMap.Keys: IJclExtendedCollection; +var + I, J: Integer; + Bucket: TJclExtendedIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclExtendedArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfHashMap.MapEquals(const AMap: IJclExtendedIntfMap): Boolean; +var + I, J: Integer; + Bucket: TJclExtendedIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedIntfHashMap.Pack; +var + I: Integer; + Bucket: TJclExtendedIntfHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedIntfHashMap.PutAll(const AMap: IJclExtendedIntfMap); +var + It: IJclExtendedIterator; + Key: Extended; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedIntfHashMap.PutValue(const Key: Extended; const Value: IInterface); +var + Index: Integer; + Bucket: TJclExtendedIntfHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, 0.0) and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclExtendedIntfHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfHashMap.Remove(const Key: Extended): IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedIntfHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclExtendedIntfHashMap.Values: IJclIntfCollection; +var + I, J: Integer; + Bucket: TJclExtendedIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclExtendedIntfHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclExtendedIntfHashMap.FreeKey(var Key: Extended): Extended; +begin + Result := Key; + Key := 0.0; +end; + +function TJclExtendedIntfHashMap.FreeValue(var Value: IInterface): IInterface; +begin + Result := Value; + Value := nil; +end; + +function TJclExtendedIntfHashMap.KeysEqual(const A, B: Extended): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclExtendedIntfHashMap.ValuesEqual(const A, B: IInterface): Boolean; +begin + Result := IntfSimpleEqualityCompare(A, B); +end; + +//=== { TJclIntfExtendedHashMapBucket } ========================================== + +procedure TJclIntfExtendedHashMapBucket.FinalizeArrayBeforeMove(var List: TJclIntfExtendedHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntfExtendedHashMapBucket.InitializeArray(var List: TJclIntfExtendedHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntfExtendedHashMapBucket.InitializeArrayAfterMove(var List: TJclIntfExtendedHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntfExtendedHashMapBucket.MoveArray(var List: TJclIntfExtendedHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclIntfExtendedHashMap } ========================================== + +constructor TJclIntfExtendedHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclIntfExtendedHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfExtendedHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclIntfExtendedHashMapBucket; + ADest: TJclIntfExtendedHashMap; + AMap: IJclIntfExtendedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclIntfExtendedHashMap then + begin + ADest := TJclIntfExtendedHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclIntfExtendedHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclIntfExtendedMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfExtendedHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclIntfExtendedHashMap then + TJclIntfExtendedHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclIntfExtendedHashMap.Clear; +var + I, J: Integer; + Bucket: TJclIntfExtendedHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedHashMap.ContainsKey(const Key: IInterface): Boolean; +var + I: Integer; + Bucket: TJclIntfExtendedHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedHashMap.ContainsValue(const Value: Extended): Boolean; +var + I, J: Integer; + Bucket: TJclIntfExtendedHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedHashMap.Extract(const Key: IInterface): Extended; +var + Bucket: TJclIntfExtendedHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0.0; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := 0.0; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedHashMap.GetValue(const Key: IInterface): Extended; +var + I: Integer; + Bucket: TJclIntfExtendedHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0.0; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntfExtendedHashMap.KeyOfValue(const Value: Extended): IInterface; +var + I, J: Integer; + Bucket: TJclIntfExtendedHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedHashMap.KeySet: IJclIntfSet; +var + I, J: Integer; + Bucket: TJclIntfExtendedHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedHashMap.Keys: IJclIntfCollection; +var + I, J: Integer; + Bucket: TJclIntfExtendedHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedHashMap.MapEquals(const AMap: IJclIntfExtendedMap): Boolean; +var + I, J: Integer; + Bucket: TJclIntfExtendedHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfExtendedHashMap.Pack; +var + I: Integer; + Bucket: TJclIntfExtendedHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfExtendedHashMap.PutAll(const AMap: IJclIntfExtendedMap); +var + It: IJclIntfIterator; + Key: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfExtendedHashMap.PutValue(const Key: IInterface; const Value: Extended); +var + Index: Integer; + Bucket: TJclIntfExtendedHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, nil) and not ValuesEqual(Value, 0.0)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclIntfExtendedHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedHashMap.Remove(const Key: IInterface): Extended; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfExtendedHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfExtendedHashMap.Values: IJclExtendedCollection; +var + I, J: Integer; + Bucket: TJclIntfExtendedHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclExtendedArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfExtendedHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclIntfExtendedHashMap.FreeKey(var Key: IInterface): IInterface; +begin + Result := Key; + Key := nil; +end; + +function TJclIntfExtendedHashMap.FreeValue(var Value: Extended): Extended; +begin + Result := Value; + Value := 0.0; +end; + +function TJclIntfExtendedHashMap.Hash(const AInterface: IInterface): Integer; +begin + Result := IntfSimpleHashConvert(AInterface); +end; + +function TJclIntfExtendedHashMap.KeysEqual(const A, B: IInterface): Boolean; +begin + Result := IntfSimpleEqualityCompare(A, B); +end; + +function TJclIntfExtendedHashMap.ValuesEqual(const A, B: Extended): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +//=== { TJclExtendedExtendedHashMapBucket } ========================================== + +procedure TJclExtendedExtendedHashMapBucket.InitializeArrayAfterMove(var List: TJclExtendedExtendedHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclExtendedExtendedHashMapBucket.MoveArray(var List: TJclExtendedExtendedHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclExtendedExtendedHashMap } ========================================== + +constructor TJclExtendedExtendedHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclExtendedExtendedHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclExtendedExtendedHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclExtendedExtendedHashMapBucket; + ADest: TJclExtendedExtendedHashMap; + AMap: IJclExtendedExtendedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclExtendedExtendedHashMap then + begin + ADest := TJclExtendedExtendedHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclExtendedExtendedHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclExtendedExtendedMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedExtendedHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclExtendedExtendedHashMap then + TJclExtendedExtendedHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclExtendedExtendedHashMap.Clear; +var + I, J: Integer; + Bucket: TJclExtendedExtendedHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedHashMap.ContainsKey(const Key: Extended): Boolean; +var + I: Integer; + Bucket: TJclExtendedExtendedHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedHashMap.ContainsValue(const Value: Extended): Boolean; +var + I, J: Integer; + Bucket: TJclExtendedExtendedHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedHashMap.Extract(const Key: Extended): Extended; +var + Bucket: TJclExtendedExtendedHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0.0; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := 0.0; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedHashMap.GetValue(const Key: Extended): Extended; +var + I: Integer; + Bucket: TJclExtendedExtendedHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0.0; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclExtendedExtendedHashMap.KeyOfValue(const Value: Extended): Extended; +var + I, J: Integer; + Bucket: TJclExtendedExtendedHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0.0; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedHashMap.KeySet: IJclExtendedSet; +var + I, J: Integer; + Bucket: TJclExtendedExtendedHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclExtendedArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedHashMap.Keys: IJclExtendedCollection; +var + I, J: Integer; + Bucket: TJclExtendedExtendedHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclExtendedArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedHashMap.MapEquals(const AMap: IJclExtendedExtendedMap): Boolean; +var + I, J: Integer; + Bucket: TJclExtendedExtendedHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedExtendedHashMap.Pack; +var + I: Integer; + Bucket: TJclExtendedExtendedHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedExtendedHashMap.PutAll(const AMap: IJclExtendedExtendedMap); +var + It: IJclExtendedIterator; + Key: Extended; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedExtendedHashMap.PutValue(const Key: Extended; const Value: Extended); +var + Index: Integer; + Bucket: TJclExtendedExtendedHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, 0.0) and not ValuesEqual(Value, 0.0)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclExtendedExtendedHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedHashMap.Remove(const Key: Extended): Extended; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedExtendedHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclExtendedExtendedHashMap.Values: IJclExtendedCollection; +var + I, J: Integer; + Bucket: TJclExtendedExtendedHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclExtendedArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclExtendedExtendedHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclExtendedExtendedHashMap.FreeKey(var Key: Extended): Extended; +begin + Result := Key; + Key := 0.0; +end; + +function TJclExtendedExtendedHashMap.FreeValue(var Value: Extended): Extended; +begin + Result := Value; + Value := 0.0; +end; + +function TJclExtendedExtendedHashMap.KeysEqual(const A, B: Extended): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclExtendedExtendedHashMap.ValuesEqual(const A, B: Extended): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +//=== { TJclIntegerIntfHashMapBucket } ========================================== + +procedure TJclIntegerIntfHashMapBucket.FinalizeArrayBeforeMove(var List: TJclIntegerIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntegerIntfHashMapBucket.InitializeArray(var List: TJclIntegerIntfHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntegerIntfHashMapBucket.InitializeArrayAfterMove(var List: TJclIntegerIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntegerIntfHashMapBucket.MoveArray(var List: TJclIntegerIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclIntegerIntfHashMap } ========================================== + +constructor TJclIntegerIntfHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclIntegerIntfHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntegerIntfHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclIntegerIntfHashMapBucket; + ADest: TJclIntegerIntfHashMap; + AMap: IJclIntegerIntfMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclIntegerIntfHashMap then + begin + ADest := TJclIntegerIntfHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclIntegerIntfHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclIntegerIntfMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerIntfHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclIntegerIntfHashMap then + TJclIntegerIntfHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclIntegerIntfHashMap.Clear; +var + I, J: Integer; + Bucket: TJclIntegerIntfHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfHashMap.ContainsKey(Key: Integer): Boolean; +var + I: Integer; + Bucket: TJclIntegerIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfHashMap.ContainsValue(const Value: IInterface): Boolean; +var + I, J: Integer; + Bucket: TJclIntegerIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfHashMap.Extract(Key: Integer): IInterface; +var + Bucket: TJclIntegerIntfHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfHashMap.GetValue(Key: Integer): IInterface; +var + I: Integer; + Bucket: TJclIntegerIntfHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntegerIntfHashMap.KeyOfValue(const Value: IInterface): Integer; +var + I, J: Integer; + Bucket: TJclIntegerIntfHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfHashMap.KeySet: IJclIntegerSet; +var + I, J: Integer; + Bucket: TJclIntegerIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntegerArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfHashMap.Keys: IJclIntegerCollection; +var + I, J: Integer; + Bucket: TJclIntegerIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntegerArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfHashMap.MapEquals(const AMap: IJclIntegerIntfMap): Boolean; +var + I, J: Integer; + Bucket: TJclIntegerIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerIntfHashMap.Pack; +var + I: Integer; + Bucket: TJclIntegerIntfHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerIntfHashMap.PutAll(const AMap: IJclIntegerIntfMap); +var + It: IJclIntegerIterator; + Key: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerIntfHashMap.PutValue(Key: Integer; const Value: IInterface); +var + Index: Integer; + Bucket: TJclIntegerIntfHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, 0) and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclIntegerIntfHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfHashMap.Remove(Key: Integer): IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerIntfHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntegerIntfHashMap.Values: IJclIntfCollection; +var + I, J: Integer; + Bucket: TJclIntegerIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntegerIntfHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclIntegerIntfHashMap.FreeKey(var Key: Integer): Integer; +begin + Result := Key; + Key := 0; +end; + +function TJclIntegerIntfHashMap.FreeValue(var Value: IInterface): IInterface; +begin + Result := Value; + Value := nil; +end; + +function TJclIntegerIntfHashMap.KeysEqual(A, B: Integer): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclIntegerIntfHashMap.ValuesEqual(const A, B: IInterface): Boolean; +begin + Result := IntfSimpleEqualityCompare(A, B); +end; + +//=== { TJclIntfIntegerHashMapBucket } ========================================== + +procedure TJclIntfIntegerHashMapBucket.FinalizeArrayBeforeMove(var List: TJclIntfIntegerHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntfIntegerHashMapBucket.InitializeArray(var List: TJclIntfIntegerHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntfIntegerHashMapBucket.InitializeArrayAfterMove(var List: TJclIntfIntegerHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntfIntegerHashMapBucket.MoveArray(var List: TJclIntfIntegerHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclIntfIntegerHashMap } ========================================== + +constructor TJclIntfIntegerHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclIntfIntegerHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfIntegerHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclIntfIntegerHashMapBucket; + ADest: TJclIntfIntegerHashMap; + AMap: IJclIntfIntegerMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclIntfIntegerHashMap then + begin + ADest := TJclIntfIntegerHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclIntfIntegerHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclIntfIntegerMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfIntegerHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclIntfIntegerHashMap then + TJclIntfIntegerHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclIntfIntegerHashMap.Clear; +var + I, J: Integer; + Bucket: TJclIntfIntegerHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerHashMap.ContainsKey(const Key: IInterface): Boolean; +var + I: Integer; + Bucket: TJclIntfIntegerHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerHashMap.ContainsValue(Value: Integer): Boolean; +var + I, J: Integer; + Bucket: TJclIntfIntegerHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerHashMap.Extract(const Key: IInterface): Integer; +var + Bucket: TJclIntfIntegerHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := 0; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerHashMap.GetValue(const Key: IInterface): Integer; +var + I: Integer; + Bucket: TJclIntfIntegerHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntfIntegerHashMap.KeyOfValue(Value: Integer): IInterface; +var + I, J: Integer; + Bucket: TJclIntfIntegerHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerHashMap.KeySet: IJclIntfSet; +var + I, J: Integer; + Bucket: TJclIntfIntegerHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerHashMap.Keys: IJclIntfCollection; +var + I, J: Integer; + Bucket: TJclIntfIntegerHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerHashMap.MapEquals(const AMap: IJclIntfIntegerMap): Boolean; +var + I, J: Integer; + Bucket: TJclIntfIntegerHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfIntegerHashMap.Pack; +var + I: Integer; + Bucket: TJclIntfIntegerHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfIntegerHashMap.PutAll(const AMap: IJclIntfIntegerMap); +var + It: IJclIntfIterator; + Key: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfIntegerHashMap.PutValue(const Key: IInterface; Value: Integer); +var + Index: Integer; + Bucket: TJclIntfIntegerHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, nil) and not ValuesEqual(Value, 0)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclIntfIntegerHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerHashMap.Remove(const Key: IInterface): Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfIntegerHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfIntegerHashMap.Values: IJclIntegerCollection; +var + I, J: Integer; + Bucket: TJclIntfIntegerHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntegerArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfIntegerHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclIntfIntegerHashMap.FreeKey(var Key: IInterface): IInterface; +begin + Result := Key; + Key := nil; +end; + +function TJclIntfIntegerHashMap.FreeValue(var Value: Integer): Integer; +begin + Result := Value; + Value := 0; +end; + +function TJclIntfIntegerHashMap.Hash(const AInterface: IInterface): Integer; +begin + Result := IntfSimpleHashConvert(AInterface); +end; + +function TJclIntfIntegerHashMap.KeysEqual(const A, B: IInterface): Boolean; +begin + Result := IntfSimpleEqualityCompare(A, B); +end; + +function TJclIntfIntegerHashMap.ValuesEqual(A, B: Integer): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +//=== { TJclIntegerIntegerHashMapBucket } ========================================== + +procedure TJclIntegerIntegerHashMapBucket.InitializeArrayAfterMove(var List: TJclIntegerIntegerHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclIntegerIntegerHashMapBucket.MoveArray(var List: TJclIntegerIntegerHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclIntegerIntegerHashMap } ========================================== + +constructor TJclIntegerIntegerHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclIntegerIntegerHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntegerIntegerHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclIntegerIntegerHashMapBucket; + ADest: TJclIntegerIntegerHashMap; + AMap: IJclIntegerIntegerMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclIntegerIntegerHashMap then + begin + ADest := TJclIntegerIntegerHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclIntegerIntegerHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclIntegerIntegerMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerIntegerHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclIntegerIntegerHashMap then + TJclIntegerIntegerHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclIntegerIntegerHashMap.Clear; +var + I, J: Integer; + Bucket: TJclIntegerIntegerHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerHashMap.ContainsKey(Key: Integer): Boolean; +var + I: Integer; + Bucket: TJclIntegerIntegerHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerHashMap.ContainsValue(Value: Integer): Boolean; +var + I, J: Integer; + Bucket: TJclIntegerIntegerHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerHashMap.Extract(Key: Integer): Integer; +var + Bucket: TJclIntegerIntegerHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := 0; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerHashMap.GetValue(Key: Integer): Integer; +var + I: Integer; + Bucket: TJclIntegerIntegerHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntegerIntegerHashMap.KeyOfValue(Value: Integer): Integer; +var + I, J: Integer; + Bucket: TJclIntegerIntegerHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerHashMap.KeySet: IJclIntegerSet; +var + I, J: Integer; + Bucket: TJclIntegerIntegerHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntegerArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerHashMap.Keys: IJclIntegerCollection; +var + I, J: Integer; + Bucket: TJclIntegerIntegerHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntegerArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerHashMap.MapEquals(const AMap: IJclIntegerIntegerMap): Boolean; +var + I, J: Integer; + Bucket: TJclIntegerIntegerHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerIntegerHashMap.Pack; +var + I: Integer; + Bucket: TJclIntegerIntegerHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerIntegerHashMap.PutAll(const AMap: IJclIntegerIntegerMap); +var + It: IJclIntegerIterator; + Key: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerIntegerHashMap.PutValue(Key: Integer; Value: Integer); +var + Index: Integer; + Bucket: TJclIntegerIntegerHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, 0) and not ValuesEqual(Value, 0)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclIntegerIntegerHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerHashMap.Remove(Key: Integer): Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerIntegerHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntegerIntegerHashMap.Values: IJclIntegerCollection; +var + I, J: Integer; + Bucket: TJclIntegerIntegerHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntegerArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntegerIntegerHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclIntegerIntegerHashMap.FreeKey(var Key: Integer): Integer; +begin + Result := Key; + Key := 0; +end; + +function TJclIntegerIntegerHashMap.FreeValue(var Value: Integer): Integer; +begin + Result := Value; + Value := 0; +end; + +function TJclIntegerIntegerHashMap.KeysEqual(A, B: Integer): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclIntegerIntegerHashMap.ValuesEqual(A, B: Integer): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +//=== { TJclCardinalIntfHashMapBucket } ========================================== + +procedure TJclCardinalIntfHashMapBucket.FinalizeArrayBeforeMove(var List: TJclCardinalIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclCardinalIntfHashMapBucket.InitializeArray(var List: TJclCardinalIntfHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclCardinalIntfHashMapBucket.InitializeArrayAfterMove(var List: TJclCardinalIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclCardinalIntfHashMapBucket.MoveArray(var List: TJclCardinalIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclCardinalIntfHashMap } ========================================== + +constructor TJclCardinalIntfHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclCardinalIntfHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclCardinalIntfHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclCardinalIntfHashMapBucket; + ADest: TJclCardinalIntfHashMap; + AMap: IJclCardinalIntfMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclCardinalIntfHashMap then + begin + ADest := TJclCardinalIntfHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclCardinalIntfHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclCardinalIntfMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalIntfHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclCardinalIntfHashMap then + TJclCardinalIntfHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclCardinalIntfHashMap.Clear; +var + I, J: Integer; + Bucket: TJclCardinalIntfHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfHashMap.ContainsKey(Key: Cardinal): Boolean; +var + I: Integer; + Bucket: TJclCardinalIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfHashMap.ContainsValue(const Value: IInterface): Boolean; +var + I, J: Integer; + Bucket: TJclCardinalIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfHashMap.Extract(Key: Cardinal): IInterface; +var + Bucket: TJclCardinalIntfHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfHashMap.GetValue(Key: Cardinal): IInterface; +var + I: Integer; + Bucket: TJclCardinalIntfHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclCardinalIntfHashMap.KeyOfValue(const Value: IInterface): Cardinal; +var + I, J: Integer; + Bucket: TJclCardinalIntfHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfHashMap.KeySet: IJclCardinalSet; +var + I, J: Integer; + Bucket: TJclCardinalIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclCardinalArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfHashMap.Keys: IJclCardinalCollection; +var + I, J: Integer; + Bucket: TJclCardinalIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclCardinalArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfHashMap.MapEquals(const AMap: IJclCardinalIntfMap): Boolean; +var + I, J: Integer; + Bucket: TJclCardinalIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalIntfHashMap.Pack; +var + I: Integer; + Bucket: TJclCardinalIntfHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalIntfHashMap.PutAll(const AMap: IJclCardinalIntfMap); +var + It: IJclCardinalIterator; + Key: Cardinal; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalIntfHashMap.PutValue(Key: Cardinal; const Value: IInterface); +var + Index: Integer; + Bucket: TJclCardinalIntfHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, 0) and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclCardinalIntfHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfHashMap.Remove(Key: Cardinal): IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalIntfHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclCardinalIntfHashMap.Values: IJclIntfCollection; +var + I, J: Integer; + Bucket: TJclCardinalIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclCardinalIntfHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclCardinalIntfHashMap.FreeKey(var Key: Cardinal): Cardinal; +begin + Result := Key; + Key := 0; +end; + +function TJclCardinalIntfHashMap.FreeValue(var Value: IInterface): IInterface; +begin + Result := Value; + Value := nil; +end; + +function TJclCardinalIntfHashMap.KeysEqual(A, B: Cardinal): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclCardinalIntfHashMap.ValuesEqual(const A, B: IInterface): Boolean; +begin + Result := IntfSimpleEqualityCompare(A, B); +end; + +//=== { TJclIntfCardinalHashMapBucket } ========================================== + +procedure TJclIntfCardinalHashMapBucket.FinalizeArrayBeforeMove(var List: TJclIntfCardinalHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntfCardinalHashMapBucket.InitializeArray(var List: TJclIntfCardinalHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntfCardinalHashMapBucket.InitializeArrayAfterMove(var List: TJclIntfCardinalHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntfCardinalHashMapBucket.MoveArray(var List: TJclIntfCardinalHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclIntfCardinalHashMap } ========================================== + +constructor TJclIntfCardinalHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclIntfCardinalHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfCardinalHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclIntfCardinalHashMapBucket; + ADest: TJclIntfCardinalHashMap; + AMap: IJclIntfCardinalMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclIntfCardinalHashMap then + begin + ADest := TJclIntfCardinalHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclIntfCardinalHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclIntfCardinalMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfCardinalHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclIntfCardinalHashMap then + TJclIntfCardinalHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclIntfCardinalHashMap.Clear; +var + I, J: Integer; + Bucket: TJclIntfCardinalHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalHashMap.ContainsKey(const Key: IInterface): Boolean; +var + I: Integer; + Bucket: TJclIntfCardinalHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalHashMap.ContainsValue(Value: Cardinal): Boolean; +var + I, J: Integer; + Bucket: TJclIntfCardinalHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalHashMap.Extract(const Key: IInterface): Cardinal; +var + Bucket: TJclIntfCardinalHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := 0; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalHashMap.GetValue(const Key: IInterface): Cardinal; +var + I: Integer; + Bucket: TJclIntfCardinalHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntfCardinalHashMap.KeyOfValue(Value: Cardinal): IInterface; +var + I, J: Integer; + Bucket: TJclIntfCardinalHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalHashMap.KeySet: IJclIntfSet; +var + I, J: Integer; + Bucket: TJclIntfCardinalHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalHashMap.Keys: IJclIntfCollection; +var + I, J: Integer; + Bucket: TJclIntfCardinalHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalHashMap.MapEquals(const AMap: IJclIntfCardinalMap): Boolean; +var + I, J: Integer; + Bucket: TJclIntfCardinalHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfCardinalHashMap.Pack; +var + I: Integer; + Bucket: TJclIntfCardinalHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfCardinalHashMap.PutAll(const AMap: IJclIntfCardinalMap); +var + It: IJclIntfIterator; + Key: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfCardinalHashMap.PutValue(const Key: IInterface; Value: Cardinal); +var + Index: Integer; + Bucket: TJclIntfCardinalHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, nil) and not ValuesEqual(Value, 0)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclIntfCardinalHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalHashMap.Remove(const Key: IInterface): Cardinal; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfCardinalHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfCardinalHashMap.Values: IJclCardinalCollection; +var + I, J: Integer; + Bucket: TJclIntfCardinalHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclCardinalArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfCardinalHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclIntfCardinalHashMap.FreeKey(var Key: IInterface): IInterface; +begin + Result := Key; + Key := nil; +end; + +function TJclIntfCardinalHashMap.FreeValue(var Value: Cardinal): Cardinal; +begin + Result := Value; + Value := 0; +end; + +function TJclIntfCardinalHashMap.Hash(const AInterface: IInterface): Integer; +begin + Result := IntfSimpleHashConvert(AInterface); +end; + +function TJclIntfCardinalHashMap.KeysEqual(const A, B: IInterface): Boolean; +begin + Result := IntfSimpleEqualityCompare(A, B); +end; + +function TJclIntfCardinalHashMap.ValuesEqual(A, B: Cardinal): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +//=== { TJclCardinalCardinalHashMapBucket } ========================================== + +procedure TJclCardinalCardinalHashMapBucket.InitializeArrayAfterMove(var List: TJclCardinalCardinalHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclCardinalCardinalHashMapBucket.MoveArray(var List: TJclCardinalCardinalHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclCardinalCardinalHashMap } ========================================== + +constructor TJclCardinalCardinalHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclCardinalCardinalHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclCardinalCardinalHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclCardinalCardinalHashMapBucket; + ADest: TJclCardinalCardinalHashMap; + AMap: IJclCardinalCardinalMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclCardinalCardinalHashMap then + begin + ADest := TJclCardinalCardinalHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclCardinalCardinalHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclCardinalCardinalMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalCardinalHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclCardinalCardinalHashMap then + TJclCardinalCardinalHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclCardinalCardinalHashMap.Clear; +var + I, J: Integer; + Bucket: TJclCardinalCardinalHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalHashMap.ContainsKey(Key: Cardinal): Boolean; +var + I: Integer; + Bucket: TJclCardinalCardinalHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalHashMap.ContainsValue(Value: Cardinal): Boolean; +var + I, J: Integer; + Bucket: TJclCardinalCardinalHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalHashMap.Extract(Key: Cardinal): Cardinal; +var + Bucket: TJclCardinalCardinalHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := 0; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalHashMap.GetValue(Key: Cardinal): Cardinal; +var + I: Integer; + Bucket: TJclCardinalCardinalHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclCardinalCardinalHashMap.KeyOfValue(Value: Cardinal): Cardinal; +var + I, J: Integer; + Bucket: TJclCardinalCardinalHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalHashMap.KeySet: IJclCardinalSet; +var + I, J: Integer; + Bucket: TJclCardinalCardinalHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclCardinalArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalHashMap.Keys: IJclCardinalCollection; +var + I, J: Integer; + Bucket: TJclCardinalCardinalHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclCardinalArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalHashMap.MapEquals(const AMap: IJclCardinalCardinalMap): Boolean; +var + I, J: Integer; + Bucket: TJclCardinalCardinalHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalCardinalHashMap.Pack; +var + I: Integer; + Bucket: TJclCardinalCardinalHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalCardinalHashMap.PutAll(const AMap: IJclCardinalCardinalMap); +var + It: IJclCardinalIterator; + Key: Cardinal; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalCardinalHashMap.PutValue(Key: Cardinal; Value: Cardinal); +var + Index: Integer; + Bucket: TJclCardinalCardinalHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, 0) and not ValuesEqual(Value, 0)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclCardinalCardinalHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalHashMap.Remove(Key: Cardinal): Cardinal; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalCardinalHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclCardinalCardinalHashMap.Values: IJclCardinalCollection; +var + I, J: Integer; + Bucket: TJclCardinalCardinalHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclCardinalArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclCardinalCardinalHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclCardinalCardinalHashMap.FreeKey(var Key: Cardinal): Cardinal; +begin + Result := Key; + Key := 0; +end; + +function TJclCardinalCardinalHashMap.FreeValue(var Value: Cardinal): Cardinal; +begin + Result := Value; + Value := 0; +end; + +function TJclCardinalCardinalHashMap.KeysEqual(A, B: Cardinal): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclCardinalCardinalHashMap.ValuesEqual(A, B: Cardinal): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +//=== { TJclInt64IntfHashMapBucket } ========================================== + +procedure TJclInt64IntfHashMapBucket.FinalizeArrayBeforeMove(var List: TJclInt64IntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclInt64IntfHashMapBucket.InitializeArray(var List: TJclInt64IntfHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclInt64IntfHashMapBucket.InitializeArrayAfterMove(var List: TJclInt64IntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclInt64IntfHashMapBucket.MoveArray(var List: TJclInt64IntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclInt64IntfHashMap } ========================================== + +constructor TJclInt64IntfHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclInt64IntfHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclInt64IntfHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclInt64IntfHashMapBucket; + ADest: TJclInt64IntfHashMap; + AMap: IJclInt64IntfMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclInt64IntfHashMap then + begin + ADest := TJclInt64IntfHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclInt64IntfHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclInt64IntfMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64IntfHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclInt64IntfHashMap then + TJclInt64IntfHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclInt64IntfHashMap.Clear; +var + I, J: Integer; + Bucket: TJclInt64IntfHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfHashMap.ContainsKey(const Key: Int64): Boolean; +var + I: Integer; + Bucket: TJclInt64IntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfHashMap.ContainsValue(const Value: IInterface): Boolean; +var + I, J: Integer; + Bucket: TJclInt64IntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfHashMap.Extract(const Key: Int64): IInterface; +var + Bucket: TJclInt64IntfHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfHashMap.GetValue(const Key: Int64): IInterface; +var + I: Integer; + Bucket: TJclInt64IntfHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclInt64IntfHashMap.KeyOfValue(const Value: IInterface): Int64; +var + I, J: Integer; + Bucket: TJclInt64IntfHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfHashMap.KeySet: IJclInt64Set; +var + I, J: Integer; + Bucket: TJclInt64IntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclInt64ArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfHashMap.Keys: IJclInt64Collection; +var + I, J: Integer; + Bucket: TJclInt64IntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclInt64ArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfHashMap.MapEquals(const AMap: IJclInt64IntfMap): Boolean; +var + I, J: Integer; + Bucket: TJclInt64IntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64IntfHashMap.Pack; +var + I: Integer; + Bucket: TJclInt64IntfHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64IntfHashMap.PutAll(const AMap: IJclInt64IntfMap); +var + It: IJclInt64Iterator; + Key: Int64; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64IntfHashMap.PutValue(const Key: Int64; const Value: IInterface); +var + Index: Integer; + Bucket: TJclInt64IntfHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, 0) and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclInt64IntfHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfHashMap.Remove(const Key: Int64): IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64IntfHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclInt64IntfHashMap.Values: IJclIntfCollection; +var + I, J: Integer; + Bucket: TJclInt64IntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclInt64IntfHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclInt64IntfHashMap.FreeKey(var Key: Int64): Int64; +begin + Result := Key; + Key := 0; +end; + +function TJclInt64IntfHashMap.FreeValue(var Value: IInterface): IInterface; +begin + Result := Value; + Value := nil; +end; + +function TJclInt64IntfHashMap.KeysEqual(const A, B: Int64): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclInt64IntfHashMap.ValuesEqual(const A, B: IInterface): Boolean; +begin + Result := IntfSimpleEqualityCompare(A, B); +end; + +//=== { TJclIntfInt64HashMapBucket } ========================================== + +procedure TJclIntfInt64HashMapBucket.FinalizeArrayBeforeMove(var List: TJclIntfInt64HashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntfInt64HashMapBucket.InitializeArray(var List: TJclIntfInt64HashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntfInt64HashMapBucket.InitializeArrayAfterMove(var List: TJclIntfInt64HashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntfInt64HashMapBucket.MoveArray(var List: TJclIntfInt64HashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclIntfInt64HashMap } ========================================== + +constructor TJclIntfInt64HashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclIntfInt64HashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfInt64HashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclIntfInt64HashMapBucket; + ADest: TJclIntfInt64HashMap; + AMap: IJclIntfInt64Map; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclIntfInt64HashMap then + begin + ADest := TJclIntfInt64HashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclIntfInt64HashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclIntfInt64Map, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfInt64HashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclIntfInt64HashMap then + TJclIntfInt64HashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclIntfInt64HashMap.Clear; +var + I, J: Integer; + Bucket: TJclIntfInt64HashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64HashMap.ContainsKey(const Key: IInterface): Boolean; +var + I: Integer; + Bucket: TJclIntfInt64HashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64HashMap.ContainsValue(const Value: Int64): Boolean; +var + I, J: Integer; + Bucket: TJclIntfInt64HashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64HashMap.Extract(const Key: IInterface): Int64; +var + Bucket: TJclIntfInt64HashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := 0; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64HashMap.GetValue(const Key: IInterface): Int64; +var + I: Integer; + Bucket: TJclIntfInt64HashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64HashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntfInt64HashMap.KeyOfValue(const Value: Int64): IInterface; +var + I, J: Integer; + Bucket: TJclIntfInt64HashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64HashMap.KeySet: IJclIntfSet; +var + I, J: Integer; + Bucket: TJclIntfInt64HashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64HashMap.Keys: IJclIntfCollection; +var + I, J: Integer; + Bucket: TJclIntfInt64HashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64HashMap.MapEquals(const AMap: IJclIntfInt64Map): Boolean; +var + I, J: Integer; + Bucket: TJclIntfInt64HashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfInt64HashMap.Pack; +var + I: Integer; + Bucket: TJclIntfInt64HashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfInt64HashMap.PutAll(const AMap: IJclIntfInt64Map); +var + It: IJclIntfIterator; + Key: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfInt64HashMap.PutValue(const Key: IInterface; const Value: Int64); +var + Index: Integer; + Bucket: TJclIntfInt64HashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, nil) and not ValuesEqual(Value, 0)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclIntfInt64HashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64HashMap.Remove(const Key: IInterface): Int64; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfInt64HashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64HashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfInt64HashMap.Values: IJclInt64Collection; +var + I, J: Integer; + Bucket: TJclIntfInt64HashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclInt64ArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64HashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfInt64HashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclIntfInt64HashMap.FreeKey(var Key: IInterface): IInterface; +begin + Result := Key; + Key := nil; +end; + +function TJclIntfInt64HashMap.FreeValue(var Value: Int64): Int64; +begin + Result := Value; + Value := 0; +end; + +function TJclIntfInt64HashMap.Hash(const AInterface: IInterface): Integer; +begin + Result := IntfSimpleHashConvert(AInterface); +end; + +function TJclIntfInt64HashMap.KeysEqual(const A, B: IInterface): Boolean; +begin + Result := IntfSimpleEqualityCompare(A, B); +end; + +function TJclIntfInt64HashMap.ValuesEqual(const A, B: Int64): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +//=== { TJclInt64Int64HashMapBucket } ========================================== + +procedure TJclInt64Int64HashMapBucket.InitializeArrayAfterMove(var List: TJclInt64Int64HashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclInt64Int64HashMapBucket.MoveArray(var List: TJclInt64Int64HashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclInt64Int64HashMap } ========================================== + +constructor TJclInt64Int64HashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclInt64Int64HashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclInt64Int64HashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclInt64Int64HashMapBucket; + ADest: TJclInt64Int64HashMap; + AMap: IJclInt64Int64Map; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclInt64Int64HashMap then + begin + ADest := TJclInt64Int64HashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclInt64Int64HashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclInt64Int64Map, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64Int64HashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclInt64Int64HashMap then + TJclInt64Int64HashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclInt64Int64HashMap.Clear; +var + I, J: Integer; + Bucket: TJclInt64Int64HashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64HashMap.ContainsKey(const Key: Int64): Boolean; +var + I: Integer; + Bucket: TJclInt64Int64HashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64HashMap.ContainsValue(const Value: Int64): Boolean; +var + I, J: Integer; + Bucket: TJclInt64Int64HashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64HashMap.Extract(const Key: Int64): Int64; +var + Bucket: TJclInt64Int64HashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := 0; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64HashMap.GetValue(const Key: Int64): Int64; +var + I: Integer; + Bucket: TJclInt64Int64HashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64HashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclInt64Int64HashMap.KeyOfValue(const Value: Int64): Int64; +var + I, J: Integer; + Bucket: TJclInt64Int64HashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64HashMap.KeySet: IJclInt64Set; +var + I, J: Integer; + Bucket: TJclInt64Int64HashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclInt64ArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64HashMap.Keys: IJclInt64Collection; +var + I, J: Integer; + Bucket: TJclInt64Int64HashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclInt64ArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64HashMap.MapEquals(const AMap: IJclInt64Int64Map): Boolean; +var + I, J: Integer; + Bucket: TJclInt64Int64HashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64Int64HashMap.Pack; +var + I: Integer; + Bucket: TJclInt64Int64HashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64Int64HashMap.PutAll(const AMap: IJclInt64Int64Map); +var + It: IJclInt64Iterator; + Key: Int64; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64Int64HashMap.PutValue(const Key: Int64; const Value: Int64); +var + Index: Integer; + Bucket: TJclInt64Int64HashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, 0) and not ValuesEqual(Value, 0)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclInt64Int64HashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64HashMap.Remove(const Key: Int64): Int64; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64Int64HashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64HashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclInt64Int64HashMap.Values: IJclInt64Collection; +var + I, J: Integer; + Bucket: TJclInt64Int64HashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclInt64ArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64HashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclInt64Int64HashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclInt64Int64HashMap.FreeKey(var Key: Int64): Int64; +begin + Result := Key; + Key := 0; +end; + +function TJclInt64Int64HashMap.FreeValue(var Value: Int64): Int64; +begin + Result := Value; + Value := 0; +end; + +function TJclInt64Int64HashMap.KeysEqual(const A, B: Int64): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclInt64Int64HashMap.ValuesEqual(const A, B: Int64): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +//=== { TJclPtrIntfHashMapBucket } ========================================== + +procedure TJclPtrIntfHashMapBucket.FinalizeArrayBeforeMove(var List: TJclPtrIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclPtrIntfHashMapBucket.InitializeArray(var List: TJclPtrIntfHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclPtrIntfHashMapBucket.InitializeArrayAfterMove(var List: TJclPtrIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclPtrIntfHashMapBucket.MoveArray(var List: TJclPtrIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclPtrIntfHashMap } ========================================== + +constructor TJclPtrIntfHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclPtrIntfHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclPtrIntfHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclPtrIntfHashMapBucket; + ADest: TJclPtrIntfHashMap; + AMap: IJclPtrIntfMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclPtrIntfHashMap then + begin + ADest := TJclPtrIntfHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclPtrIntfHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclPtrIntfMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrIntfHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclPtrIntfHashMap then + TJclPtrIntfHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclPtrIntfHashMap.Clear; +var + I, J: Integer; + Bucket: TJclPtrIntfHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfHashMap.ContainsKey(Key: Pointer): Boolean; +var + I: Integer; + Bucket: TJclPtrIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfHashMap.ContainsValue(const Value: IInterface): Boolean; +var + I, J: Integer; + Bucket: TJclPtrIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfHashMap.Extract(Key: Pointer): IInterface; +var + Bucket: TJclPtrIntfHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfHashMap.GetValue(Key: Pointer): IInterface; +var + I: Integer; + Bucket: TJclPtrIntfHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclPtrIntfHashMap.KeyOfValue(const Value: IInterface): Pointer; +var + I, J: Integer; + Bucket: TJclPtrIntfHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfHashMap.KeySet: IJclPtrSet; +var + I, J: Integer; + Bucket: TJclPtrIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclPtrArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfHashMap.Keys: IJclPtrCollection; +var + I, J: Integer; + Bucket: TJclPtrIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclPtrArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfHashMap.MapEquals(const AMap: IJclPtrIntfMap): Boolean; +var + I, J: Integer; + Bucket: TJclPtrIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrIntfHashMap.Pack; +var + I: Integer; + Bucket: TJclPtrIntfHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrIntfHashMap.PutAll(const AMap: IJclPtrIntfMap); +var + It: IJclPtrIterator; + Key: Pointer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrIntfHashMap.PutValue(Key: Pointer; const Value: IInterface); +var + Index: Integer; + Bucket: TJclPtrIntfHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, nil) and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclPtrIntfHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfHashMap.Remove(Key: Pointer): IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrIntfHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclPtrIntfHashMap.Values: IJclIntfCollection; +var + I, J: Integer; + Bucket: TJclPtrIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclPtrIntfHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclPtrIntfHashMap.FreeKey(var Key: Pointer): Pointer; +begin + Result := Key; + Key := nil; +end; + +function TJclPtrIntfHashMap.FreeValue(var Value: IInterface): IInterface; +begin + Result := Value; + Value := nil; +end; + +function TJclPtrIntfHashMap.KeysEqual(A, B: Pointer): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclPtrIntfHashMap.ValuesEqual(const A, B: IInterface): Boolean; +begin + Result := IntfSimpleEqualityCompare(A, B); +end; + +//=== { TJclIntfPtrHashMapBucket } ========================================== + +procedure TJclIntfPtrHashMapBucket.FinalizeArrayBeforeMove(var List: TJclIntfPtrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntfPtrHashMapBucket.InitializeArray(var List: TJclIntfPtrHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntfPtrHashMapBucket.InitializeArrayAfterMove(var List: TJclIntfPtrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntfPtrHashMapBucket.MoveArray(var List: TJclIntfPtrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclIntfPtrHashMap } ========================================== + +constructor TJclIntfPtrHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclIntfPtrHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfPtrHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclIntfPtrHashMapBucket; + ADest: TJclIntfPtrHashMap; + AMap: IJclIntfPtrMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclIntfPtrHashMap then + begin + ADest := TJclIntfPtrHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclIntfPtrHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclIntfPtrMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfPtrHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclIntfPtrHashMap then + TJclIntfPtrHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclIntfPtrHashMap.Clear; +var + I, J: Integer; + Bucket: TJclIntfPtrHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrHashMap.ContainsKey(const Key: IInterface): Boolean; +var + I: Integer; + Bucket: TJclIntfPtrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrHashMap.ContainsValue(Value: Pointer): Boolean; +var + I, J: Integer; + Bucket: TJclIntfPtrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrHashMap.Extract(const Key: IInterface): Pointer; +var + Bucket: TJclIntfPtrHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrHashMap.GetValue(const Key: IInterface): Pointer; +var + I: Integer; + Bucket: TJclIntfPtrHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntfPtrHashMap.KeyOfValue(Value: Pointer): IInterface; +var + I, J: Integer; + Bucket: TJclIntfPtrHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrHashMap.KeySet: IJclIntfSet; +var + I, J: Integer; + Bucket: TJclIntfPtrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrHashMap.Keys: IJclIntfCollection; +var + I, J: Integer; + Bucket: TJclIntfPtrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrHashMap.MapEquals(const AMap: IJclIntfPtrMap): Boolean; +var + I, J: Integer; + Bucket: TJclIntfPtrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfPtrHashMap.Pack; +var + I: Integer; + Bucket: TJclIntfPtrHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfPtrHashMap.PutAll(const AMap: IJclIntfPtrMap); +var + It: IJclIntfIterator; + Key: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfPtrHashMap.PutValue(const Key: IInterface; Value: Pointer); +var + Index: Integer; + Bucket: TJclIntfPtrHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, nil) and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclIntfPtrHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrHashMap.Remove(const Key: IInterface): Pointer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfPtrHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfPtrHashMap.Values: IJclPtrCollection; +var + I, J: Integer; + Bucket: TJclIntfPtrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclPtrArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfPtrHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclIntfPtrHashMap.FreeKey(var Key: IInterface): IInterface; +begin + Result := Key; + Key := nil; +end; + +function TJclIntfPtrHashMap.FreeValue(var Value: Pointer): Pointer; +begin + Result := Value; + Value := nil; +end; + +function TJclIntfPtrHashMap.Hash(const AInterface: IInterface): Integer; +begin + Result := IntfSimpleHashConvert(AInterface); +end; + +function TJclIntfPtrHashMap.KeysEqual(const A, B: IInterface): Boolean; +begin + Result := IntfSimpleEqualityCompare(A, B); +end; + +function TJclIntfPtrHashMap.ValuesEqual(A, B: Pointer): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +//=== { TJclPtrPtrHashMapBucket } ========================================== + +procedure TJclPtrPtrHashMapBucket.InitializeArrayAfterMove(var List: TJclPtrPtrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclPtrPtrHashMapBucket.MoveArray(var List: TJclPtrPtrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclPtrPtrHashMap } ========================================== + +constructor TJclPtrPtrHashMap.Create(ACapacity: Integer); +begin + inherited Create; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclPtrPtrHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclPtrPtrHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclPtrPtrHashMapBucket; + ADest: TJclPtrPtrHashMap; + AMap: IJclPtrPtrMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclPtrPtrHashMap then + begin + ADest := TJclPtrPtrHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclPtrPtrHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclPtrPtrMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrPtrHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclPtrPtrHashMap then + TJclPtrPtrHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclPtrPtrHashMap.Clear; +var + I, J: Integer; + Bucket: TJclPtrPtrHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrHashMap.ContainsKey(Key: Pointer): Boolean; +var + I: Integer; + Bucket: TJclPtrPtrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrHashMap.ContainsValue(Value: Pointer): Boolean; +var + I, J: Integer; + Bucket: TJclPtrPtrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrHashMap.Extract(Key: Pointer): Pointer; +var + Bucket: TJclPtrPtrHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrHashMap.GetValue(Key: Pointer): Pointer; +var + I: Integer; + Bucket: TJclPtrPtrHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclPtrPtrHashMap.KeyOfValue(Value: Pointer): Pointer; +var + I, J: Integer; + Bucket: TJclPtrPtrHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrHashMap.KeySet: IJclPtrSet; +var + I, J: Integer; + Bucket: TJclPtrPtrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclPtrArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrHashMap.Keys: IJclPtrCollection; +var + I, J: Integer; + Bucket: TJclPtrPtrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclPtrArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrHashMap.MapEquals(const AMap: IJclPtrPtrMap): Boolean; +var + I, J: Integer; + Bucket: TJclPtrPtrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrPtrHashMap.Pack; +var + I: Integer; + Bucket: TJclPtrPtrHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrPtrHashMap.PutAll(const AMap: IJclPtrPtrMap); +var + It: IJclPtrIterator; + Key: Pointer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrPtrHashMap.PutValue(Key: Pointer; Value: Pointer); +var + Index: Integer; + Bucket: TJclPtrPtrHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, nil) and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclPtrPtrHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrHashMap.Remove(Key: Pointer): Pointer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrPtrHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclPtrPtrHashMap.Values: IJclPtrCollection; +var + I, J: Integer; + Bucket: TJclPtrPtrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclPtrArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclPtrPtrHashMap.Create(FCapacity); + AssignPropertiesTo(Result); +end; + +function TJclPtrPtrHashMap.FreeKey(var Key: Pointer): Pointer; +begin + Result := Key; + Key := nil; +end; + +function TJclPtrPtrHashMap.FreeValue(var Value: Pointer): Pointer; +begin + Result := Value; + Value := nil; +end; + +function TJclPtrPtrHashMap.KeysEqual(A, B: Pointer): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclPtrPtrHashMap.ValuesEqual(A, B: Pointer): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +//=== { TJclIntfHashMapBucket } ========================================== + +procedure TJclIntfHashMapBucket.FinalizeArrayBeforeMove(var List: TJclIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntfHashMapBucket.InitializeArray(var List: TJclIntfHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntfHashMapBucket.InitializeArrayAfterMove(var List: TJclIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntfHashMapBucket.MoveArray(var List: TJclIntfHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclIntfHashMap } ========================================== + +constructor TJclIntfHashMap.Create(ACapacity: Integer; AOwnsValues: Boolean); +begin + inherited Create; + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclIntfHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclIntfHashMapBucket; + ADest: TJclIntfHashMap; + AMap: IJclIntfMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclIntfHashMap then + begin + ADest := TJclIntfHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclIntfHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclIntfMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclIntfHashMap then + TJclIntfHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclIntfHashMap.Clear; +var + I, J: Integer; + Bucket: TJclIntfHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashMap.ContainsKey(const Key: IInterface): Boolean; +var + I: Integer; + Bucket: TJclIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashMap.ContainsValue(Value: TObject): Boolean; +var + I, J: Integer; + Bucket: TJclIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashMap.Extract(const Key: IInterface): TObject; +var + Bucket: TJclIntfHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashMap.GetValue(const Key: IInterface): TObject; +var + I: Integer; + Bucket: TJclIntfHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntfHashMap.KeyOfValue(Value: TObject): IInterface; +var + I, J: Integer; + Bucket: TJclIntfHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashMap.KeySet: IJclIntfSet; +var + I, J: Integer; + Bucket: TJclIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashMap.Keys: IJclIntfCollection; +var + I, J: Integer; + Bucket: TJclIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashMap.MapEquals(const AMap: IJclIntfMap): Boolean; +var + I, J: Integer; + Bucket: TJclIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfHashMap.Pack; +var + I: Integer; + Bucket: TJclIntfHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfHashMap.PutAll(const AMap: IJclIntfMap); +var + It: IJclIntfIterator; + Key: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfHashMap.PutValue(const Key: IInterface; Value: TObject); +var + Index: Integer; + Bucket: TJclIntfHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, nil) and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclIntfHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashMap.Remove(const Key: IInterface): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfHashMap.Values: IJclCollection; +var + I, J: Integer; + Bucket: TJclIntfHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfHashMap.Create(FCapacity, False); + AssignPropertiesTo(Result); +end; + +function TJclIntfHashMap.FreeKey(var Key: IInterface): IInterface; +begin + Result := Key; + Key := nil; +end; + +function TJclIntfHashMap.FreeValue(var Value: TObject): TObject; +begin + if FOwnsValues then + begin + Result := nil; + FreeAndNil(Value); + end + else + begin + Result := Value; + Value := nil; + end; +end; + +function TJclIntfHashMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +function TJclIntfHashMap.KeysEqual(const A, B: IInterface): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclIntfHashMap.ValuesEqual(A, B: TObject): Boolean; +begin + Result := SimpleEqualityCompare(A, B); +end; + +//=== { TJclAnsiStrHashMapBucket } ========================================== + +procedure TJclAnsiStrHashMapBucket.FinalizeArrayBeforeMove(var List: TJclAnsiStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclAnsiStrHashMapBucket.InitializeArray(var List: TJclAnsiStrHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclAnsiStrHashMapBucket.InitializeArrayAfterMove(var List: TJclAnsiStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclAnsiStrHashMapBucket.MoveArray(var List: TJclAnsiStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclAnsiStrHashMap } ========================================== + +constructor TJclAnsiStrHashMap.Create(ACapacity: Integer; AOwnsValues: Boolean); +begin + inherited Create; + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclAnsiStrHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclAnsiStrHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclAnsiStrHashMapBucket; + ADest: TJclAnsiStrHashMap; + AMap: IJclAnsiStrMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclAnsiStrHashMap then + begin + ADest := TJclAnsiStrHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclAnsiStrHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclAnsiStrMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclAnsiStrHashMap then + TJclAnsiStrHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclAnsiStrHashMap.Clear; +var + I, J: Integer; + Bucket: TJclAnsiStrHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashMap.ContainsKey(const Key: AnsiString): Boolean; +var + I: Integer; + Bucket: TJclAnsiStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashMap.ContainsValue(Value: TObject): Boolean; +var + I, J: Integer; + Bucket: TJclAnsiStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashMap.Extract(const Key: AnsiString): TObject; +var + Bucket: TJclAnsiStrHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashMap.GetValue(const Key: AnsiString): TObject; +var + I: Integer; + Bucket: TJclAnsiStrHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclAnsiStrHashMap.KeyOfValue(Value: TObject): AnsiString; +var + I, J: Integer; + Bucket: TJclAnsiStrHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := ''; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashMap.KeySet: IJclAnsiStrSet; +var + I, J: Integer; + Bucket: TJclAnsiStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclAnsiStrArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashMap.Keys: IJclAnsiStrCollection; +var + I, J: Integer; + Bucket: TJclAnsiStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclAnsiStrArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashMap.MapEquals(const AMap: IJclAnsiStrMap): Boolean; +var + I, J: Integer; + Bucket: TJclAnsiStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrHashMap.Pack; +var + I: Integer; + Bucket: TJclAnsiStrHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrHashMap.PutAll(const AMap: IJclAnsiStrMap); +var + It: IJclAnsiStrIterator; + Key: AnsiString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrHashMap.PutValue(const Key: AnsiString; Value: TObject); +var + Index: Integer; + Bucket: TJclAnsiStrHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, '') and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclAnsiStrHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashMap.Remove(const Key: AnsiString): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclAnsiStrHashMap.Values: IJclCollection; +var + I, J: Integer; + Bucket: TJclAnsiStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclAnsiStrHashMap.Create(FCapacity, False); + AssignPropertiesTo(Result); +end; + +function TJclAnsiStrHashMap.FreeKey(var Key: AnsiString): AnsiString; +begin + Result := Key; + Key := ''; +end; + +function TJclAnsiStrHashMap.FreeValue(var Value: TObject): TObject; +begin + if FOwnsValues then + begin + Result := nil; + FreeAndNil(Value); + end + else + begin + Result := Value; + Value := nil; + end; +end; + +function TJclAnsiStrHashMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +function TJclAnsiStrHashMap.KeysEqual(const A, B: AnsiString): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclAnsiStrHashMap.ValuesEqual(A, B: TObject): Boolean; +begin + Result := SimpleEqualityCompare(A, B); +end; + +//=== { TJclWideStrHashMapBucket } ========================================== + +procedure TJclWideStrHashMapBucket.FinalizeArrayBeforeMove(var List: TJclWideStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclWideStrHashMapBucket.InitializeArray(var List: TJclWideStrHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclWideStrHashMapBucket.InitializeArrayAfterMove(var List: TJclWideStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclWideStrHashMapBucket.MoveArray(var List: TJclWideStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclWideStrHashMap } ========================================== + +constructor TJclWideStrHashMap.Create(ACapacity: Integer; AOwnsValues: Boolean); +begin + inherited Create; + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclWideStrHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclWideStrHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclWideStrHashMapBucket; + ADest: TJclWideStrHashMap; + AMap: IJclWideStrMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclWideStrHashMap then + begin + ADest := TJclWideStrHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclWideStrHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclWideStrMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclWideStrHashMap then + TJclWideStrHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclWideStrHashMap.Clear; +var + I, J: Integer; + Bucket: TJclWideStrHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashMap.ContainsKey(const Key: WideString): Boolean; +var + I: Integer; + Bucket: TJclWideStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashMap.ContainsValue(Value: TObject): Boolean; +var + I, J: Integer; + Bucket: TJclWideStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashMap.Extract(const Key: WideString): TObject; +var + Bucket: TJclWideStrHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashMap.GetValue(const Key: WideString): TObject; +var + I: Integer; + Bucket: TJclWideStrHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclWideStrHashMap.KeyOfValue(Value: TObject): WideString; +var + I, J: Integer; + Bucket: TJclWideStrHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := ''; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashMap.KeySet: IJclWideStrSet; +var + I, J: Integer; + Bucket: TJclWideStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclWideStrArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashMap.Keys: IJclWideStrCollection; +var + I, J: Integer; + Bucket: TJclWideStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclWideStrArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashMap.MapEquals(const AMap: IJclWideStrMap): Boolean; +var + I, J: Integer; + Bucket: TJclWideStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrHashMap.Pack; +var + I: Integer; + Bucket: TJclWideStrHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrHashMap.PutAll(const AMap: IJclWideStrMap); +var + It: IJclWideStrIterator; + Key: WideString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrHashMap.PutValue(const Key: WideString; Value: TObject); +var + Index: Integer; + Bucket: TJclWideStrHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, '') and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclWideStrHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashMap.Remove(const Key: WideString): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclWideStrHashMap.Values: IJclCollection; +var + I, J: Integer; + Bucket: TJclWideStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclWideStrHashMap.Create(FCapacity, False); + AssignPropertiesTo(Result); +end; + +function TJclWideStrHashMap.FreeKey(var Key: WideString): WideString; +begin + Result := Key; + Key := ''; +end; + +function TJclWideStrHashMap.FreeValue(var Value: TObject): TObject; +begin + if FOwnsValues then + begin + Result := nil; + FreeAndNil(Value); + end + else + begin + Result := Value; + Value := nil; + end; +end; + +function TJclWideStrHashMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +function TJclWideStrHashMap.KeysEqual(const A, B: WideString): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclWideStrHashMap.ValuesEqual(A, B: TObject): Boolean; +begin + Result := SimpleEqualityCompare(A, B); +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrHashMapBucket } ========================================== + +procedure TJclUnicodeStrHashMapBucket.FinalizeArrayBeforeMove(var List: TJclUnicodeStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclUnicodeStrHashMapBucket.InitializeArray(var List: TJclUnicodeStrHashMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclUnicodeStrHashMapBucket.InitializeArrayAfterMove(var List: TJclUnicodeStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclUnicodeStrHashMapBucket.MoveArray(var List: TJclUnicodeStrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + + +{$ENDIF SUPPORTS_UNICODE_STRING} + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrHashMap } ========================================== + +constructor TJclUnicodeStrHashMap.Create(ACapacity: Integer; AOwnsValues: Boolean); +begin + inherited Create; + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclUnicodeStrHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclUnicodeStrHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclUnicodeStrHashMapBucket; + ADest: TJclUnicodeStrHashMap; + AMap: IJclUnicodeStrMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclUnicodeStrHashMap then + begin + ADest := TJclUnicodeStrHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclUnicodeStrHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclUnicodeStrMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclUnicodeStrHashMap then + TJclUnicodeStrHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclUnicodeStrHashMap.Clear; +var + I, J: Integer; + Bucket: TJclUnicodeStrHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashMap.ContainsKey(const Key: UnicodeString): Boolean; +var + I: Integer; + Bucket: TJclUnicodeStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashMap.ContainsValue(Value: TObject): Boolean; +var + I, J: Integer; + Bucket: TJclUnicodeStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashMap.Extract(const Key: UnicodeString): TObject; +var + Bucket: TJclUnicodeStrHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashMap.GetValue(const Key: UnicodeString): TObject; +var + I: Integer; + Bucket: TJclUnicodeStrHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclUnicodeStrHashMap.KeyOfValue(Value: TObject): UnicodeString; +var + I, J: Integer; + Bucket: TJclUnicodeStrHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := ''; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashMap.KeySet: IJclUnicodeStrSet; +var + I, J: Integer; + Bucket: TJclUnicodeStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclUnicodeStrArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashMap.Keys: IJclUnicodeStrCollection; +var + I, J: Integer; + Bucket: TJclUnicodeStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclUnicodeStrArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashMap.MapEquals(const AMap: IJclUnicodeStrMap): Boolean; +var + I, J: Integer; + Bucket: TJclUnicodeStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrHashMap.Pack; +var + I: Integer; + Bucket: TJclUnicodeStrHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrHashMap.PutAll(const AMap: IJclUnicodeStrMap); +var + It: IJclUnicodeStrIterator; + Key: UnicodeString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrHashMap.PutValue(const Key: UnicodeString; Value: TObject); +var + Index: Integer; + Bucket: TJclUnicodeStrHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, '') and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclUnicodeStrHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashMap.Remove(const Key: UnicodeString): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclUnicodeStrHashMap.Values: IJclCollection; +var + I, J: Integer; + Bucket: TJclUnicodeStrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclUnicodeStrHashMap.Create(FCapacity, False); + AssignPropertiesTo(Result); +end; + +function TJclUnicodeStrHashMap.FreeKey(var Key: UnicodeString): UnicodeString; +begin + Result := Key; + Key := ''; +end; + +function TJclUnicodeStrHashMap.FreeValue(var Value: TObject): TObject; +begin + if FOwnsValues then + begin + Result := nil; + FreeAndNil(Value); + end + else + begin + Result := Value; + Value := nil; + end; +end; + +function TJclUnicodeStrHashMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +function TJclUnicodeStrHashMap.KeysEqual(const A, B: UnicodeString): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclUnicodeStrHashMap.ValuesEqual(A, B: TObject): Boolean; +begin + Result := SimpleEqualityCompare(A, B); +end; + +{$ENDIF SUPPORTS_UNICODE_STRING} + +//=== { TJclSingleHashMapBucket } ========================================== + +procedure TJclSingleHashMapBucket.InitializeArrayAfterMove(var List: TJclSingleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclSingleHashMapBucket.MoveArray(var List: TJclSingleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclSingleHashMap } ========================================== + +constructor TJclSingleHashMap.Create(ACapacity: Integer; AOwnsValues: Boolean); +begin + inherited Create; + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclSingleHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclSingleHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclSingleHashMapBucket; + ADest: TJclSingleHashMap; + AMap: IJclSingleMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclSingleHashMap then + begin + ADest := TJclSingleHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclSingleHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclSingleMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclSingleHashMap then + TJclSingleHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclSingleHashMap.Clear; +var + I, J: Integer; + Bucket: TJclSingleHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashMap.ContainsKey(const Key: Single): Boolean; +var + I: Integer; + Bucket: TJclSingleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashMap.ContainsValue(Value: TObject): Boolean; +var + I, J: Integer; + Bucket: TJclSingleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashMap.Extract(const Key: Single): TObject; +var + Bucket: TJclSingleHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashMap.GetValue(const Key: Single): TObject; +var + I: Integer; + Bucket: TJclSingleHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclSingleHashMap.KeyOfValue(Value: TObject): Single; +var + I, J: Integer; + Bucket: TJclSingleHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0.0; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashMap.KeySet: IJclSingleSet; +var + I, J: Integer; + Bucket: TJclSingleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclSingleArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashMap.Keys: IJclSingleCollection; +var + I, J: Integer; + Bucket: TJclSingleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclSingleArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashMap.MapEquals(const AMap: IJclSingleMap): Boolean; +var + I, J: Integer; + Bucket: TJclSingleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleHashMap.Pack; +var + I: Integer; + Bucket: TJclSingleHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleHashMap.PutAll(const AMap: IJclSingleMap); +var + It: IJclSingleIterator; + Key: Single; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleHashMap.PutValue(const Key: Single; Value: TObject); +var + Index: Integer; + Bucket: TJclSingleHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, 0.0) and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclSingleHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashMap.Remove(const Key: Single): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclSingleHashMap.Values: IJclCollection; +var + I, J: Integer; + Bucket: TJclSingleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclSingleHashMap.Create(FCapacity, False); + AssignPropertiesTo(Result); +end; + +function TJclSingleHashMap.FreeKey(var Key: Single): Single; +begin + Result := Key; + Key := 0.0; +end; + +function TJclSingleHashMap.FreeValue(var Value: TObject): TObject; +begin + if FOwnsValues then + begin + Result := nil; + FreeAndNil(Value); + end + else + begin + Result := Value; + Value := nil; + end; +end; + +function TJclSingleHashMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +function TJclSingleHashMap.KeysEqual(const A, B: Single): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclSingleHashMap.ValuesEqual(A, B: TObject): Boolean; +begin + Result := SimpleEqualityCompare(A, B); +end; + +//=== { TJclDoubleHashMapBucket } ========================================== + +procedure TJclDoubleHashMapBucket.InitializeArrayAfterMove(var List: TJclDoubleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclDoubleHashMapBucket.MoveArray(var List: TJclDoubleHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclDoubleHashMap } ========================================== + +constructor TJclDoubleHashMap.Create(ACapacity: Integer; AOwnsValues: Boolean); +begin + inherited Create; + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclDoubleHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclDoubleHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclDoubleHashMapBucket; + ADest: TJclDoubleHashMap; + AMap: IJclDoubleMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclDoubleHashMap then + begin + ADest := TJclDoubleHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclDoubleHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclDoubleMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclDoubleHashMap then + TJclDoubleHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclDoubleHashMap.Clear; +var + I, J: Integer; + Bucket: TJclDoubleHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashMap.ContainsKey(const Key: Double): Boolean; +var + I: Integer; + Bucket: TJclDoubleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashMap.ContainsValue(Value: TObject): Boolean; +var + I, J: Integer; + Bucket: TJclDoubleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashMap.Extract(const Key: Double): TObject; +var + Bucket: TJclDoubleHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashMap.GetValue(const Key: Double): TObject; +var + I: Integer; + Bucket: TJclDoubleHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclDoubleHashMap.KeyOfValue(Value: TObject): Double; +var + I, J: Integer; + Bucket: TJclDoubleHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0.0; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashMap.KeySet: IJclDoubleSet; +var + I, J: Integer; + Bucket: TJclDoubleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclDoubleArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashMap.Keys: IJclDoubleCollection; +var + I, J: Integer; + Bucket: TJclDoubleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclDoubleArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashMap.MapEquals(const AMap: IJclDoubleMap): Boolean; +var + I, J: Integer; + Bucket: TJclDoubleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleHashMap.Pack; +var + I: Integer; + Bucket: TJclDoubleHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleHashMap.PutAll(const AMap: IJclDoubleMap); +var + It: IJclDoubleIterator; + Key: Double; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleHashMap.PutValue(const Key: Double; Value: TObject); +var + Index: Integer; + Bucket: TJclDoubleHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, 0.0) and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclDoubleHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashMap.Remove(const Key: Double): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclDoubleHashMap.Values: IJclCollection; +var + I, J: Integer; + Bucket: TJclDoubleHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclDoubleHashMap.Create(FCapacity, False); + AssignPropertiesTo(Result); +end; + +function TJclDoubleHashMap.FreeKey(var Key: Double): Double; +begin + Result := Key; + Key := 0.0; +end; + +function TJclDoubleHashMap.FreeValue(var Value: TObject): TObject; +begin + if FOwnsValues then + begin + Result := nil; + FreeAndNil(Value); + end + else + begin + Result := Value; + Value := nil; + end; +end; + +function TJclDoubleHashMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +function TJclDoubleHashMap.KeysEqual(const A, B: Double): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclDoubleHashMap.ValuesEqual(A, B: TObject): Boolean; +begin + Result := SimpleEqualityCompare(A, B); +end; + +//=== { TJclExtendedHashMapBucket } ========================================== + +procedure TJclExtendedHashMapBucket.InitializeArrayAfterMove(var List: TJclExtendedHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclExtendedHashMapBucket.MoveArray(var List: TJclExtendedHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclExtendedHashMap } ========================================== + +constructor TJclExtendedHashMap.Create(ACapacity: Integer; AOwnsValues: Boolean); +begin + inherited Create; + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclExtendedHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclExtendedHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclExtendedHashMapBucket; + ADest: TJclExtendedHashMap; + AMap: IJclExtendedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclExtendedHashMap then + begin + ADest := TJclExtendedHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclExtendedHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclExtendedMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclExtendedHashMap then + TJclExtendedHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclExtendedHashMap.Clear; +var + I, J: Integer; + Bucket: TJclExtendedHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashMap.ContainsKey(const Key: Extended): Boolean; +var + I: Integer; + Bucket: TJclExtendedHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashMap.ContainsValue(Value: TObject): Boolean; +var + I, J: Integer; + Bucket: TJclExtendedHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashMap.Extract(const Key: Extended): TObject; +var + Bucket: TJclExtendedHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashMap.GetValue(const Key: Extended): TObject; +var + I: Integer; + Bucket: TJclExtendedHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclExtendedHashMap.KeyOfValue(Value: TObject): Extended; +var + I, J: Integer; + Bucket: TJclExtendedHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0.0; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashMap.KeySet: IJclExtendedSet; +var + I, J: Integer; + Bucket: TJclExtendedHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclExtendedArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashMap.Keys: IJclExtendedCollection; +var + I, J: Integer; + Bucket: TJclExtendedHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclExtendedArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashMap.MapEquals(const AMap: IJclExtendedMap): Boolean; +var + I, J: Integer; + Bucket: TJclExtendedHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedHashMap.Pack; +var + I: Integer; + Bucket: TJclExtendedHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedHashMap.PutAll(const AMap: IJclExtendedMap); +var + It: IJclExtendedIterator; + Key: Extended; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedHashMap.PutValue(const Key: Extended; Value: TObject); +var + Index: Integer; + Bucket: TJclExtendedHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, 0.0) and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclExtendedHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashMap.Remove(const Key: Extended): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclExtendedHashMap.Values: IJclCollection; +var + I, J: Integer; + Bucket: TJclExtendedHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclExtendedHashMap.Create(FCapacity, False); + AssignPropertiesTo(Result); +end; + +function TJclExtendedHashMap.FreeKey(var Key: Extended): Extended; +begin + Result := Key; + Key := 0.0; +end; + +function TJclExtendedHashMap.FreeValue(var Value: TObject): TObject; +begin + if FOwnsValues then + begin + Result := nil; + FreeAndNil(Value); + end + else + begin + Result := Value; + Value := nil; + end; +end; + +function TJclExtendedHashMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +function TJclExtendedHashMap.KeysEqual(const A, B: Extended): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclExtendedHashMap.ValuesEqual(A, B: TObject): Boolean; +begin + Result := SimpleEqualityCompare(A, B); +end; + +//=== { TJclIntegerHashMapBucket } ========================================== + +procedure TJclIntegerHashMapBucket.InitializeArrayAfterMove(var List: TJclIntegerHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclIntegerHashMapBucket.MoveArray(var List: TJclIntegerHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclIntegerHashMap } ========================================== + +constructor TJclIntegerHashMap.Create(ACapacity: Integer; AOwnsValues: Boolean); +begin + inherited Create; + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclIntegerHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntegerHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclIntegerHashMapBucket; + ADest: TJclIntegerHashMap; + AMap: IJclIntegerMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclIntegerHashMap then + begin + ADest := TJclIntegerHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclIntegerHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclIntegerMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclIntegerHashMap then + TJclIntegerHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclIntegerHashMap.Clear; +var + I, J: Integer; + Bucket: TJclIntegerHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashMap.ContainsKey(Key: Integer): Boolean; +var + I: Integer; + Bucket: TJclIntegerHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashMap.ContainsValue(Value: TObject): Boolean; +var + I, J: Integer; + Bucket: TJclIntegerHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashMap.Extract(Key: Integer): TObject; +var + Bucket: TJclIntegerHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashMap.GetValue(Key: Integer): TObject; +var + I: Integer; + Bucket: TJclIntegerHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntegerHashMap.KeyOfValue(Value: TObject): Integer; +var + I, J: Integer; + Bucket: TJclIntegerHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashMap.KeySet: IJclIntegerSet; +var + I, J: Integer; + Bucket: TJclIntegerHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntegerArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashMap.Keys: IJclIntegerCollection; +var + I, J: Integer; + Bucket: TJclIntegerHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntegerArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashMap.MapEquals(const AMap: IJclIntegerMap): Boolean; +var + I, J: Integer; + Bucket: TJclIntegerHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerHashMap.Pack; +var + I: Integer; + Bucket: TJclIntegerHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerHashMap.PutAll(const AMap: IJclIntegerMap); +var + It: IJclIntegerIterator; + Key: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerHashMap.PutValue(Key: Integer; Value: TObject); +var + Index: Integer; + Bucket: TJclIntegerHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, 0) and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclIntegerHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashMap.Remove(Key: Integer): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntegerHashMap.Values: IJclCollection; +var + I, J: Integer; + Bucket: TJclIntegerHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntegerHashMap.Create(FCapacity, False); + AssignPropertiesTo(Result); +end; + +function TJclIntegerHashMap.FreeKey(var Key: Integer): Integer; +begin + Result := Key; + Key := 0; +end; + +function TJclIntegerHashMap.FreeValue(var Value: TObject): TObject; +begin + if FOwnsValues then + begin + Result := nil; + FreeAndNil(Value); + end + else + begin + Result := Value; + Value := nil; + end; +end; + +function TJclIntegerHashMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +function TJclIntegerHashMap.KeysEqual(A, B: Integer): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclIntegerHashMap.ValuesEqual(A, B: TObject): Boolean; +begin + Result := SimpleEqualityCompare(A, B); +end; + +//=== { TJclCardinalHashMapBucket } ========================================== + +procedure TJclCardinalHashMapBucket.InitializeArrayAfterMove(var List: TJclCardinalHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclCardinalHashMapBucket.MoveArray(var List: TJclCardinalHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclCardinalHashMap } ========================================== + +constructor TJclCardinalHashMap.Create(ACapacity: Integer; AOwnsValues: Boolean); +begin + inherited Create; + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclCardinalHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclCardinalHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclCardinalHashMapBucket; + ADest: TJclCardinalHashMap; + AMap: IJclCardinalMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclCardinalHashMap then + begin + ADest := TJclCardinalHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclCardinalHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclCardinalMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclCardinalHashMap then + TJclCardinalHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclCardinalHashMap.Clear; +var + I, J: Integer; + Bucket: TJclCardinalHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashMap.ContainsKey(Key: Cardinal): Boolean; +var + I: Integer; + Bucket: TJclCardinalHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashMap.ContainsValue(Value: TObject): Boolean; +var + I, J: Integer; + Bucket: TJclCardinalHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashMap.Extract(Key: Cardinal): TObject; +var + Bucket: TJclCardinalHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashMap.GetValue(Key: Cardinal): TObject; +var + I: Integer; + Bucket: TJclCardinalHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclCardinalHashMap.KeyOfValue(Value: TObject): Cardinal; +var + I, J: Integer; + Bucket: TJclCardinalHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashMap.KeySet: IJclCardinalSet; +var + I, J: Integer; + Bucket: TJclCardinalHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclCardinalArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashMap.Keys: IJclCardinalCollection; +var + I, J: Integer; + Bucket: TJclCardinalHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclCardinalArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashMap.MapEquals(const AMap: IJclCardinalMap): Boolean; +var + I, J: Integer; + Bucket: TJclCardinalHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalHashMap.Pack; +var + I: Integer; + Bucket: TJclCardinalHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalHashMap.PutAll(const AMap: IJclCardinalMap); +var + It: IJclCardinalIterator; + Key: Cardinal; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalHashMap.PutValue(Key: Cardinal; Value: TObject); +var + Index: Integer; + Bucket: TJclCardinalHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, 0) and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclCardinalHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashMap.Remove(Key: Cardinal): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclCardinalHashMap.Values: IJclCollection; +var + I, J: Integer; + Bucket: TJclCardinalHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclCardinalHashMap.Create(FCapacity, False); + AssignPropertiesTo(Result); +end; + +function TJclCardinalHashMap.FreeKey(var Key: Cardinal): Cardinal; +begin + Result := Key; + Key := 0; +end; + +function TJclCardinalHashMap.FreeValue(var Value: TObject): TObject; +begin + if FOwnsValues then + begin + Result := nil; + FreeAndNil(Value); + end + else + begin + Result := Value; + Value := nil; + end; +end; + +function TJclCardinalHashMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +function TJclCardinalHashMap.KeysEqual(A, B: Cardinal): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclCardinalHashMap.ValuesEqual(A, B: TObject): Boolean; +begin + Result := SimpleEqualityCompare(A, B); +end; + +//=== { TJclInt64HashMapBucket } ========================================== + +procedure TJclInt64HashMapBucket.InitializeArrayAfterMove(var List: TJclInt64HashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclInt64HashMapBucket.MoveArray(var List: TJclInt64HashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclInt64HashMap } ========================================== + +constructor TJclInt64HashMap.Create(ACapacity: Integer; AOwnsValues: Boolean); +begin + inherited Create; + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclInt64HashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclInt64HashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclInt64HashMapBucket; + ADest: TJclInt64HashMap; + AMap: IJclInt64Map; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclInt64HashMap then + begin + ADest := TJclInt64HashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclInt64HashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclInt64Map, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64HashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclInt64HashMap then + TJclInt64HashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclInt64HashMap.Clear; +var + I, J: Integer; + Bucket: TJclInt64HashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashMap.ContainsKey(const Key: Int64): Boolean; +var + I: Integer; + Bucket: TJclInt64HashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashMap.ContainsValue(Value: TObject): Boolean; +var + I, J: Integer; + Bucket: TJclInt64HashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashMap.Extract(const Key: Int64): TObject; +var + Bucket: TJclInt64HashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashMap.GetValue(const Key: Int64): TObject; +var + I: Integer; + Bucket: TJclInt64HashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclInt64HashMap.KeyOfValue(Value: TObject): Int64; +var + I, J: Integer; + Bucket: TJclInt64HashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashMap.KeySet: IJclInt64Set; +var + I, J: Integer; + Bucket: TJclInt64HashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclInt64ArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashMap.Keys: IJclInt64Collection; +var + I, J: Integer; + Bucket: TJclInt64HashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclInt64ArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashMap.MapEquals(const AMap: IJclInt64Map): Boolean; +var + I, J: Integer; + Bucket: TJclInt64HashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64HashMap.Pack; +var + I: Integer; + Bucket: TJclInt64HashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64HashMap.PutAll(const AMap: IJclInt64Map); +var + It: IJclInt64Iterator; + Key: Int64; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64HashMap.PutValue(const Key: Int64; Value: TObject); +var + Index: Integer; + Bucket: TJclInt64HashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, 0) and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclInt64HashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashMap.Remove(const Key: Int64): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64HashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclInt64HashMap.Values: IJclCollection; +var + I, J: Integer; + Bucket: TJclInt64HashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclInt64HashMap.Create(FCapacity, False); + AssignPropertiesTo(Result); +end; + +function TJclInt64HashMap.FreeKey(var Key: Int64): Int64; +begin + Result := Key; + Key := 0; +end; + +function TJclInt64HashMap.FreeValue(var Value: TObject): TObject; +begin + if FOwnsValues then + begin + Result := nil; + FreeAndNil(Value); + end + else + begin + Result := Value; + Value := nil; + end; +end; + +function TJclInt64HashMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +function TJclInt64HashMap.KeysEqual(const A, B: Int64): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclInt64HashMap.ValuesEqual(A, B: TObject): Boolean; +begin + Result := SimpleEqualityCompare(A, B); +end; + +//=== { TJclPtrHashMapBucket } ========================================== + +procedure TJclPtrHashMapBucket.InitializeArrayAfterMove(var List: TJclPtrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclPtrHashMapBucket.MoveArray(var List: TJclPtrHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclPtrHashMap } ========================================== + +constructor TJclPtrHashMap.Create(ACapacity: Integer; AOwnsValues: Boolean); +begin + inherited Create; + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclPtrHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclPtrHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclPtrHashMapBucket; + ADest: TJclPtrHashMap; + AMap: IJclPtrMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclPtrHashMap then + begin + ADest := TJclPtrHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclPtrHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclPtrMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclPtrHashMap then + TJclPtrHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclPtrHashMap.Clear; +var + I, J: Integer; + Bucket: TJclPtrHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashMap.ContainsKey(Key: Pointer): Boolean; +var + I: Integer; + Bucket: TJclPtrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashMap.ContainsValue(Value: TObject): Boolean; +var + I, J: Integer; + Bucket: TJclPtrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashMap.Extract(Key: Pointer): TObject; +var + Bucket: TJclPtrHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashMap.GetValue(Key: Pointer): TObject; +var + I: Integer; + Bucket: TJclPtrHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclPtrHashMap.KeyOfValue(Value: TObject): Pointer; +var + I, J: Integer; + Bucket: TJclPtrHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashMap.KeySet: IJclPtrSet; +var + I, J: Integer; + Bucket: TJclPtrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclPtrArraySet.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashMap.Keys: IJclPtrCollection; +var + I, J: Integer; + Bucket: TJclPtrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclPtrArrayList.Create(FSize); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashMap.MapEquals(const AMap: IJclPtrMap): Boolean; +var + I, J: Integer; + Bucket: TJclPtrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrHashMap.Pack; +var + I: Integer; + Bucket: TJclPtrHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrHashMap.PutAll(const AMap: IJclPtrMap); +var + It: IJclPtrIterator; + Key: Pointer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrHashMap.PutValue(Key: Pointer; Value: TObject); +var + Index: Integer; + Bucket: TJclPtrHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, nil) and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclPtrHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashMap.Remove(Key: Pointer): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclPtrHashMap.Values: IJclCollection; +var + I, J: Integer; + Bucket: TJclPtrHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclPtrHashMap.Create(FCapacity, False); + AssignPropertiesTo(Result); +end; + +function TJclPtrHashMap.FreeKey(var Key: Pointer): Pointer; +begin + Result := Key; + Key := nil; +end; + +function TJclPtrHashMap.FreeValue(var Value: TObject): TObject; +begin + if FOwnsValues then + begin + Result := nil; + FreeAndNil(Value); + end + else + begin + Result := Value; + Value := nil; + end; +end; + +function TJclPtrHashMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +function TJclPtrHashMap.KeysEqual(A, B: Pointer): Boolean; +begin + Result := ItemsEqual(A, B); +end; + +function TJclPtrHashMap.ValuesEqual(A, B: TObject): Boolean; +begin + Result := SimpleEqualityCompare(A, B); +end; + +//=== { TJclHashMapBucket } ========================================== + +procedure TJclHashMapBucket.InitializeArrayAfterMove(var List: TJclHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclHashMapBucket.MoveArray(var List: TJclHashMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclHashMap } ========================================== + +constructor TJclHashMap.Create(ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean); +begin + inherited Create; + FOwnsKeys := AOwnsKeys; + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclHashMapBucket; + ADest: TJclHashMap; + AMap: IJclMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclHashMap then + begin + ADest := TJclHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclHashMapBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclHashMap then + TJclHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclHashMap.Clear; +var + I, J: Integer; + Bucket: TJclHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashMap.ContainsKey(Key: TObject): Boolean; +var + I: Integer; + Bucket: TJclHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashMap.ContainsValue(Value: TObject): Boolean; +var + I, J: Integer; + Bucket: TJclHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashMap.Extract(Key: TObject): TObject; +var + Bucket: TJclHashMapBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := nil; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashMap.GetValue(Key: TObject): TObject; +var + I: Integer; + Bucket: TJclHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclHashMap.KeyOfValue(Value: TObject): TObject; +var + I, J: Integer; + Bucket: TJclHashMapBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashMap.KeySet: IJclSet; +var + I, J: Integer; + Bucket: TJclHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArraySet.Create(FSize, False); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashMap.Keys: IJclCollection; +var + I, J: Integer; + Bucket: TJclHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashMap.MapEquals(const AMap: IJclMap): Boolean; +var + I, J: Integer; + Bucket: TJclHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclHashMap.Pack; +var + I: Integer; + Bucket: TJclHashMapBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclHashMap.PutAll(const AMap: IJclMap); +var + It: IJclIterator; + Key: TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclHashMap.PutValue(Key: TObject; Value: TObject); +var + Index: Integer; + Bucket: TJclHashMapBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, nil) and not ValuesEqual(Value, nil)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TJclHashMapBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashMap.Remove(Key: TObject): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclHashMap.Values: IJclCollection; +var + I, J: Integer; + Bucket: TJclHashMapBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclHashMap.Create(FCapacity, False, False); + AssignPropertiesTo(Result); +end; + +function TJclHashMap.FreeKey(var Key: TObject): TObject; +begin + if FOwnsKeys then + begin + Result := nil; + FreeAndNil(Key); + end + else + begin + Result := Key; + Key := nil; + end; +end; + +function TJclHashMap.FreeValue(var Value: TObject): TObject; +begin + if FOwnsValues then + begin + Result := nil; + FreeAndNil(Value); + end + else + begin + Result := Value; + Value := nil; + end; +end; + +function TJclHashMap.GetOwnsKeys: Boolean; +begin + Result := FOwnsKeys; +end; + +function TJclHashMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +function TJclHashMap.Hash(AObject: TObject): Integer; +begin + Result := SimpleHashConvert(AObject); +end; + +function TJclHashMap.KeysEqual(A, B: TObject): Boolean; +begin + Result := SimpleEqualityCompare(A, B); +end; + +function TJclHashMap.ValuesEqual(A, B: TObject): Boolean; +begin + Result := SimpleEqualityCompare(A, B); +end; + + +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +//=== { TJclBucket } ========================================== + +procedure TJclBucket.FinalizeArrayBeforeMove(var List: THashEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclBucket.InitializeArray(var List: THashEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclBucket.InitializeArrayAfterMove(var List: THashEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclBucket.MoveArray(var List: THashEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +//=== { TJclHashMap } ========================================== + +constructor TJclHashMap.Create(ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean); +begin + inherited Create; + + FOwnsKeys := AOwnsKeys; + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclHashMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclHashMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TBucket; + ADest: TJclHashMap; + AMap: IJclMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclHashMap then + begin + ADest := TJclHashMap(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclMap, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclHashMap.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclHashMap then + TJclHashMap(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclHashMap.Clear; +var + I, J: Integer; + Bucket: TBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashMap.ContainsKey(const Key: TKey): Boolean; +var + I: Integer; + Bucket: TBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashMap.ContainsValue(const Value: TValue): Boolean; +var + I, J: Integer; + Bucket: TBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashMap.Extract(const Key: TKey): TValue; +var + Bucket: TBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Default(TValue); + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := Default(TValue); + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashMap.GetValue(const Key: TKey): TValue; +var + I: Integer; + Bucket: TBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := Default(TValue); + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashMap.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclHashMap.KeyOfValue(const Value: TValue): TKey; +var + I, J: Integer; + Bucket: TBucket; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := Default(TKey); + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashMap.KeySet: IJclSet; +var + I, J: Integer; + Bucket: TBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := CreateEmptyArraySet(FSize, False); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashMap.Keys: IJclCollection; +var + I, J: Integer; + Bucket: TBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := CreateEmptyKeyList(FSize, False); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashMap.MapEquals(const AMap: IJclMap): Boolean; +var + I, J: Integer; + Bucket: TBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclHashMap.Pack; +var + I: Integer; + Bucket: TBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclHashMap.PutAll(const AMap: IJclMap); +var + It: IJclIterator; + Key: TKey; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclHashMap.PutValue(const Key: TKey; const Value: TValue); +var + Index: Integer; + Bucket: TBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or (not KeysEqual(Key, Default(TKey)) and not ValuesEqual(Value, Default(TValue))) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := TBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashMap.Remove(const Key: TKey): TValue; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclHashMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclHashMap.Values: IJclCollection; +var + I, J: Integer; + Bucket: TBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := CreateEmptyArrayList(FSize, False); + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashMap.FreeKey(var Key: TKey): TKey; +begin + if FOwnsKeys then + begin + Result := Default(TKey); + FreeAndNilIfObject(Key); + end + else + begin + Result := Key; + Key := Default(TKey); + end; +end; + +function TJclHashMap.FreeValue(var Value: TValue): TValue; +begin + if FOwnsValues then + begin + Result := Default(TValue); + FreeAndNilIfObject(Value); + end + else + begin + Result := Value; + Value := Default(TValue); + end; +end; + +function TJclHashMap.GetOwnsKeys: Boolean; +begin + Result := FOwnsKeys; +end; + +function TJclHashMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +//=== { TJclHashMapE } ========================================= + +constructor TJclHashMapE.Create(const AKeyEqualityComparer: IJclEqualityComparer; + const AKeyHashConverter: IJclHashConverter; const AValueEqualityComparer: IJclEqualityComparer; + const AKeyComparer: IJclComparer; ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean); +begin + inherited Create(ACapacity, AOwnsKeys, AOwnsValues); + FKeyEqualityComparer := AKeyEqualityComparer; + FKeyHashConverter := AKeyHashConverter; + FValueEqualityComparer := AValueEqualityComparer; + FKeyComparer := AKeyComparer; +end; + +procedure TJclHashMapE.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclHashMapE; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclHashMapE then + begin + ADest := TJclHashMapE(Dest); + ADest.FKeyEqualityComparer := FKeyEqualityComparer; + ADest.FKeyHashConverter := FKeyHashConverter; + ADest.FValueEqualityComparer := FValueEqualityComparer; + ADest.FKeyComparer := FKeyComparer; + end; +end; + +function TJclHashMapE.CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; +begin + Result := TArrayList.Create(ValueEqualityComparer, ACapacity, AOwnsObjects); +end; + +function TJclHashMapE.CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; +begin + Result := TArraySet.Create(KeyComparer, ACapacity, AOwnsObjects); +end; + +function TJclHashMapE.CreateEmptyKeyList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; +begin + Result := TArrayKeyList.Create(KeyEqualityComparer, ACapacity, AOwnsObjects); +end; + +function TJclHashMapE.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclHashMapE.Create(KeyEqualityComparer, KeyHashConverter, ValueEqualityComparer, + KeyComparer, FCapacity, False, False); + AssignPropertiesTo(Result); +end; + +function TJclHashMapE.Hash(const AKey: TKey): Integer; +begin + if KeyEqualityComparer = nil then + raise EJclNoHashConverterError.Create; + Result := KeyHashConverter.Hash(AKey); +end; + +function TJclHashMapE.KeysEqual(const A, B: TKey): Boolean; +begin + if KeyEqualityComparer = nil then + raise EJclNoEqualityComparerError.Create; + Result := KeyEqualityComparer.ItemsEqual(A, B); +end; + +function TJclHashMapE.ValuesEqual(const A, B: TValue): Boolean; +begin + if ValueEqualityComparer = nil then + raise EJclNoEqualityComparerError.Create; + Result := ValueEqualityComparer.ItemsEqual(A, B); +end; + +//=== { TJclHashMapF } ========================================= + +constructor TJclHashMapF.Create(AKeyEqualityCompare: TEqualityCompare; + AKeyHash: THashConvert; AValueEqualityCompare: TEqualityCompare; AKeyCompare: TCompare; + ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean); +begin + inherited Create(ACapacity, AOwnsKeys, AOwnsValues); + FKeyEqualityCompare := AKeyEqualityCompare; + FKeyHash := AKeyHash; + FValueEqualityCompare := AValueEqualityCompare; + FKeyCompare := AKeyCompare; +end; + +procedure TJclHashMapF.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclHashMapF; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclHashMapF then + begin + ADest := TJclHashMapF(Dest); + ADest.FKeyEqualityCompare := FKeyEqualityCompare; + ADest.FKeyHash := FKeyHash; + ADest.FValueEqualityCompare := FValueEqualityCompare; + ADest.FKeyCompare := FKeyCompare; + end; +end; + +function TJclHashMapF.CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; +begin + Result := TArrayList.Create(ValueEqualityCompare, ACapacity, AOwnsObjects); +end; + +function TJclHashMapF.CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; +begin + Result := TArraySet.Create(KeyCompare, ACapacity, AOwnsObjects); +end; + +function TJclHashMapF.CreateEmptyKeyList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; +begin + Result := TArrayKeyList.Create(KeyEqualityCompare, ACapacity, AOwnsObjects); +end; + +function TJclHashMapF.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclHashMapF.Create(KeyEqualityCompare, KeyHash, ValueEqualityCompare, KeyCompare, FCapacity, + False, False); + AssignPropertiesTo(Result); +end; + +function TJclHashMapF.Hash(const AKey: TKey): Integer; +begin + if not Assigned(KeyHash) then + raise EJclNoHashConverterError.Create; + Result := KeyHash(AKey); +end; + +function TJclHashMapF.KeysEqual(const A, B: TKey): Boolean; +begin + if not Assigned(KeyEqualityCompare) then + raise EJclNoEqualityComparerError.Create; + Result := KeyEqualityCompare(A, B); +end; + +function TJclHashMapF.ValuesEqual(const A, B: TValue): Boolean; +begin + if not Assigned(ValueEqualityCompare) then + raise EJclNoEqualityComparerError.Create; + Result := ValueEqualityCompare(A, B); +end; + +//=== { TJclHashMapI } ========================================= + +function TJclHashMapI.CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; +begin + Result := TArrayList.Create(ACapacity, AOwnsObjects); +end; + +function TJclHashMapI.CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; +begin + Result := TArraySet.Create(ACapacity, AOwnsObjects); +end; + +function TJclHashMapI.CreateEmptyKeyList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; +begin + Result := TArrayKeyList.Create(ACapacity, AOwnsObjects); +end; + +function TJclHashMapI.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclHashMapI.Create(FCapacity, False, False); + AssignPropertiesTo(Result); +end; + +function TJclHashMapI.Hash(const AKey: TKey): Integer; +begin + Result := AKey.GetHashCode; +end; + +function TJclHashMapI.KeysEqual(const A, B: TKey): Boolean; +begin + Result := A.Equals(B); +end; + +function TJclHashMapI.ValuesEqual(const A, B: TValue): Boolean; +begin + Result := A.Equals(B); +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclHashSets.pas b/3rdParty/JCL/source/common/JclHashSets.pas new file mode 100644 index 00000000..04a07faa --- /dev/null +++ b/3rdParty/JCL/source/common/JclHashSets.pas @@ -0,0 +1,14141 @@ +{**************************************************************************************************} +{ WARNING: JEDI preprocessor generated unit. Do not edit. } +{**************************************************************************************************} + +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is HashSet.pas. } +{ } +{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } +{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } +{ All rights reserved. } +{ } +{ Contributors: } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclHashSets; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, System.Classes, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, Classes, + {$ENDIF ~HAS_UNITSCOPE} + JclAlgorithms, + JclBase, JclAbstractContainers, JclContainerIntf, JclSynch; + + +type + TItrStart = (isFirst, isLast); + + TJclIntfHashSetBucket = class + public + Size: Integer; + Entries: TDynIInterfaceArray; + end; + + TJclIntfHashSet = class(TJclIntfAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclIntfContainer, IJclIntfFlatContainer, IJclIntfEqualityComparer, IJclIntfHashConverter, + IJclIntfCollection, IJclIntfSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FBuckets: array of TJclIntfHashSetBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); overload; + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclIntfCollection } + function Add(const AInterface: IInterface): Boolean; + function AddAll(const ACollection: IJclIntfCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclIntfCollection): Boolean; + function Contains(const AInterface: IInterface): Boolean; + function ContainsAll(const ACollection: IJclIntfCollection): Boolean; + function Extract(const AInterface: IInterface): Boolean; + function ExtractAll(const ACollection: IJclIntfCollection): Boolean; + function First: IJclIntfIterator; + function IsEmpty: Boolean; + function Last: IJclIntfIterator; + function Remove(const AInterface: IInterface): Boolean; + function RemoveAll(const ACollection: IJclIntfCollection): Boolean; + function RetainAll(const ACollection: IJclIntfCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIntfIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclIntfSet } + procedure Intersect(const ACollection: IJclIntfCollection); + procedure Subtract(const ACollection: IJclIntfCollection); + procedure Union(const ACollection: IJclIntfCollection); + end; + + TJclIntfHashSetIterator = class(TJclAbstractIterator, IJclIntfIterator) + protected + FBucketIndex: Integer; + FItemIndex: Integer; + FStart: TItrStart; + FOwnHashSet: TJclIntfHashSet; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnHashSet: TJclIntfHashSet; ABucketIndex: Integer; AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); + { IJclIntfIterator } + function Add(const AInterface: IInterface): Boolean; + procedure Extract; + function GetObject: IInterface; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AInterface: IInterface): Boolean; + function IteratorEquals(const AIterator: IJclIntfIterator): Boolean; + function Next: IInterface; + function NextIndex: Integer; + function Previous: IInterface; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetObject(const AInterface: IInterface); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: IInterface read GetObject; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclAnsiStrHashSetBucket = class + public + Size: Integer; + Entries: TDynAnsiStringArray; + end; + + TJclAnsiStrHashSet = class(TJclAnsiStrAbstractCollection, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclAnsiStrContainer, IJclAnsiStrFlatContainer, IJclAnsiStrEqualityComparer, IJclAnsiStrHashConverter, IJclStrBaseContainer, + IJclAnsiStrCollection, IJclAnsiStrSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FBuckets: array of TJclAnsiStrHashSetBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); overload; + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclAnsiStrCollection } + function Add(const AString: AnsiString): Boolean; override; + function AddAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + procedure Clear; override; + function CollectionEquals(const ACollection: IJclAnsiStrCollection): Boolean; override; + function Contains(const AString: AnsiString): Boolean; override; + function ContainsAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + function Extract(const AString: AnsiString): Boolean; override; + function ExtractAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + function First: IJclAnsiStrIterator; override; + function IsEmpty: Boolean; override; + function Last: IJclAnsiStrIterator; override; + function Remove(const AString: AnsiString): Boolean; override; + function RemoveAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + function RetainAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + function Size: Integer; override; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclAnsiStrIterator; override; + {$ENDIF SUPPORTS_FOR_IN} + { IJclAnsiStrSet } + procedure Intersect(const ACollection: IJclAnsiStrCollection); + procedure Subtract(const ACollection: IJclAnsiStrCollection); + procedure Union(const ACollection: IJclAnsiStrCollection); + end; + + TJclAnsiStrHashSetIterator = class(TJclAbstractIterator, IJclAnsiStrIterator) + protected + FBucketIndex: Integer; + FItemIndex: Integer; + FStart: TItrStart; + FOwnHashSet: TJclAnsiStrHashSet; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnHashSet: TJclAnsiStrHashSet; ABucketIndex: Integer; AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); + { IJclAnsiStrIterator } + function Add(const AString: AnsiString): Boolean; + procedure Extract; + function GetString: AnsiString; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AString: AnsiString): Boolean; + function IteratorEquals(const AIterator: IJclAnsiStrIterator): Boolean; + function Next: AnsiString; + function NextIndex: Integer; + function Previous: AnsiString; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetString(const AString: AnsiString); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: AnsiString read GetString; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclWideStrHashSetBucket = class + public + Size: Integer; + Entries: TDynWideStringArray; + end; + + TJclWideStrHashSet = class(TJclWideStrAbstractCollection, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclWideStrContainer, IJclWideStrFlatContainer, IJclWideStrEqualityComparer, IJclWideStrHashConverter, IJclStrBaseContainer, + IJclWideStrCollection, IJclWideStrSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FBuckets: array of TJclWideStrHashSetBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); overload; + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclWideStrCollection } + function Add(const AString: WideString): Boolean; override; + function AddAll(const ACollection: IJclWideStrCollection): Boolean; override; + procedure Clear; override; + function CollectionEquals(const ACollection: IJclWideStrCollection): Boolean; override; + function Contains(const AString: WideString): Boolean; override; + function ContainsAll(const ACollection: IJclWideStrCollection): Boolean; override; + function Extract(const AString: WideString): Boolean; override; + function ExtractAll(const ACollection: IJclWideStrCollection): Boolean; override; + function First: IJclWideStrIterator; override; + function IsEmpty: Boolean; override; + function Last: IJclWideStrIterator; override; + function Remove(const AString: WideString): Boolean; override; + function RemoveAll(const ACollection: IJclWideStrCollection): Boolean; override; + function RetainAll(const ACollection: IJclWideStrCollection): Boolean; override; + function Size: Integer; override; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclWideStrIterator; override; + {$ENDIF SUPPORTS_FOR_IN} + { IJclWideStrSet } + procedure Intersect(const ACollection: IJclWideStrCollection); + procedure Subtract(const ACollection: IJclWideStrCollection); + procedure Union(const ACollection: IJclWideStrCollection); + end; + + TJclWideStrHashSetIterator = class(TJclAbstractIterator, IJclWideStrIterator) + protected + FBucketIndex: Integer; + FItemIndex: Integer; + FStart: TItrStart; + FOwnHashSet: TJclWideStrHashSet; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnHashSet: TJclWideStrHashSet; ABucketIndex: Integer; AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); + { IJclWideStrIterator } + function Add(const AString: WideString): Boolean; + procedure Extract; + function GetString: WideString; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AString: WideString): Boolean; + function IteratorEquals(const AIterator: IJclWideStrIterator): Boolean; + function Next: WideString; + function NextIndex: Integer; + function Previous: WideString; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetString(const AString: WideString); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: WideString read GetString; + {$ENDIF SUPPORTS_FOR_IN} + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclUnicodeStrHashSetBucket = class + public + Size: Integer; + Entries: TDynUnicodeStringArray; + end; + + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclUnicodeStrHashSet = class(TJclUnicodeStrAbstractCollection, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclUnicodeStrContainer, IJclUnicodeStrFlatContainer, IJclUnicodeStrEqualityComparer, IJclUnicodeStrHashConverter, IJclStrBaseContainer, + IJclUnicodeStrCollection, IJclUnicodeStrSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FBuckets: array of TJclUnicodeStrHashSetBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); overload; + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclUnicodeStrCollection } + function Add(const AString: UnicodeString): Boolean; override; + function AddAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + procedure Clear; override; + function CollectionEquals(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function Contains(const AString: UnicodeString): Boolean; override; + function ContainsAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function Extract(const AString: UnicodeString): Boolean; override; + function ExtractAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function First: IJclUnicodeStrIterator; override; + function IsEmpty: Boolean; override; + function Last: IJclUnicodeStrIterator; override; + function Remove(const AString: UnicodeString): Boolean; override; + function RemoveAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function RetainAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function Size: Integer; override; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclUnicodeStrIterator; override; + {$ENDIF SUPPORTS_FOR_IN} + { IJclUnicodeStrSet } + procedure Intersect(const ACollection: IJclUnicodeStrCollection); + procedure Subtract(const ACollection: IJclUnicodeStrCollection); + procedure Union(const ACollection: IJclUnicodeStrCollection); + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclUnicodeStrHashSetIterator = class(TJclAbstractIterator, IJclUnicodeStrIterator) + protected + FBucketIndex: Integer; + FItemIndex: Integer; + FStart: TItrStart; + FOwnHashSet: TJclUnicodeStrHashSet; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnHashSet: TJclUnicodeStrHashSet; ABucketIndex: Integer; AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); + { IJclUnicodeStrIterator } + function Add(const AString: UnicodeString): Boolean; + procedure Extract; + function GetString: UnicodeString; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AString: UnicodeString): Boolean; + function IteratorEquals(const AIterator: IJclUnicodeStrIterator): Boolean; + function Next: UnicodeString; + function NextIndex: Integer; + function Previous: UnicodeString; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetString(const AString: UnicodeString); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: UnicodeString read GetString; + {$ENDIF SUPPORTS_FOR_IN} + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + TJclStrHashSetBucket = TJclAnsiStrHashSetBucket; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TJclStrHashSetBucket = TJclWideStrHashSetBucket; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TJclStrHashSetBucket = TJclUnicodeStrHashSetBucket; + {$ENDIF CONTAINER_UNICODESTR} + + {$IFDEF CONTAINER_ANSISTR} + TJclStrHashSet = TJclAnsiStrHashSet; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TJclStrHashSet = TJclWideStrHashSet; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TJclStrHashSet = TJclUnicodeStrHashSet; + {$ENDIF CONTAINER_UNICODESTR} + + {$IFDEF CONTAINER_ANSISTR} + TJclStrHashSetIterator = TJclAnsiStrHashSetIterator; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TJclStrHashSetIterator = TJclWideStrHashSetIterator; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TJclStrHashSetIterator = TJclUnicodeStrHashSetIterator; + {$ENDIF CONTAINER_UNICODESTR} + + TJclSingleHashSetBucket = class + public + Size: Integer; + Entries: TDynSingleArray; + end; + + TJclSingleHashSet = class(TJclSingleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclSingleContainer, IJclSingleFlatContainer, IJclSingleEqualityComparer, IJclSingleHashConverter, + IJclSingleCollection, IJclSingleSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FBuckets: array of TJclSingleHashSetBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); overload; + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclSingleCollection } + function Add(const AValue: Single): Boolean; + function AddAll(const ACollection: IJclSingleCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclSingleCollection): Boolean; + function Contains(const AValue: Single): Boolean; + function ContainsAll(const ACollection: IJclSingleCollection): Boolean; + function Extract(const AValue: Single): Boolean; + function ExtractAll(const ACollection: IJclSingleCollection): Boolean; + function First: IJclSingleIterator; + function IsEmpty: Boolean; + function Last: IJclSingleIterator; + function Remove(const AValue: Single): Boolean; + function RemoveAll(const ACollection: IJclSingleCollection): Boolean; + function RetainAll(const ACollection: IJclSingleCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclSingleIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclSingleSet } + procedure Intersect(const ACollection: IJclSingleCollection); + procedure Subtract(const ACollection: IJclSingleCollection); + procedure Union(const ACollection: IJclSingleCollection); + end; + + TJclSingleHashSetIterator = class(TJclAbstractIterator, IJclSingleIterator) + protected + FBucketIndex: Integer; + FItemIndex: Integer; + FStart: TItrStart; + FOwnHashSet: TJclSingleHashSet; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnHashSet: TJclSingleHashSet; ABucketIndex: Integer; AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); + { IJclSingleIterator } + function Add(const AValue: Single): Boolean; + procedure Extract; + function GetValue: Single; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AValue: Single): Boolean; + function IteratorEquals(const AIterator: IJclSingleIterator): Boolean; + function Next: Single; + function NextIndex: Integer; + function Previous: Single; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(const AValue: Single); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Single read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclDoubleHashSetBucket = class + public + Size: Integer; + Entries: TDynDoubleArray; + end; + + TJclDoubleHashSet = class(TJclDoubleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclDoubleContainer, IJclDoubleFlatContainer, IJclDoubleEqualityComparer, IJclDoubleHashConverter, + IJclDoubleCollection, IJclDoubleSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FBuckets: array of TJclDoubleHashSetBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); overload; + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclDoubleCollection } + function Add(const AValue: Double): Boolean; + function AddAll(const ACollection: IJclDoubleCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclDoubleCollection): Boolean; + function Contains(const AValue: Double): Boolean; + function ContainsAll(const ACollection: IJclDoubleCollection): Boolean; + function Extract(const AValue: Double): Boolean; + function ExtractAll(const ACollection: IJclDoubleCollection): Boolean; + function First: IJclDoubleIterator; + function IsEmpty: Boolean; + function Last: IJclDoubleIterator; + function Remove(const AValue: Double): Boolean; + function RemoveAll(const ACollection: IJclDoubleCollection): Boolean; + function RetainAll(const ACollection: IJclDoubleCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclDoubleIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclDoubleSet } + procedure Intersect(const ACollection: IJclDoubleCollection); + procedure Subtract(const ACollection: IJclDoubleCollection); + procedure Union(const ACollection: IJclDoubleCollection); + end; + + TJclDoubleHashSetIterator = class(TJclAbstractIterator, IJclDoubleIterator) + protected + FBucketIndex: Integer; + FItemIndex: Integer; + FStart: TItrStart; + FOwnHashSet: TJclDoubleHashSet; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnHashSet: TJclDoubleHashSet; ABucketIndex: Integer; AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); + { IJclDoubleIterator } + function Add(const AValue: Double): Boolean; + procedure Extract; + function GetValue: Double; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AValue: Double): Boolean; + function IteratorEquals(const AIterator: IJclDoubleIterator): Boolean; + function Next: Double; + function NextIndex: Integer; + function Previous: Double; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(const AValue: Double); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Double read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclExtendedHashSetBucket = class + public + Size: Integer; + Entries: TDynExtendedArray; + end; + + TJclExtendedHashSet = class(TJclExtendedAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclExtendedContainer, IJclExtendedFlatContainer, IJclExtendedEqualityComparer, IJclExtendedHashConverter, + IJclExtendedCollection, IJclExtendedSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FBuckets: array of TJclExtendedHashSetBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); overload; + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclExtendedCollection } + function Add(const AValue: Extended): Boolean; + function AddAll(const ACollection: IJclExtendedCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclExtendedCollection): Boolean; + function Contains(const AValue: Extended): Boolean; + function ContainsAll(const ACollection: IJclExtendedCollection): Boolean; + function Extract(const AValue: Extended): Boolean; + function ExtractAll(const ACollection: IJclExtendedCollection): Boolean; + function First: IJclExtendedIterator; + function IsEmpty: Boolean; + function Last: IJclExtendedIterator; + function Remove(const AValue: Extended): Boolean; + function RemoveAll(const ACollection: IJclExtendedCollection): Boolean; + function RetainAll(const ACollection: IJclExtendedCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclExtendedIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclExtendedSet } + procedure Intersect(const ACollection: IJclExtendedCollection); + procedure Subtract(const ACollection: IJclExtendedCollection); + procedure Union(const ACollection: IJclExtendedCollection); + end; + + TJclExtendedHashSetIterator = class(TJclAbstractIterator, IJclExtendedIterator) + protected + FBucketIndex: Integer; + FItemIndex: Integer; + FStart: TItrStart; + FOwnHashSet: TJclExtendedHashSet; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnHashSet: TJclExtendedHashSet; ABucketIndex: Integer; AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); + { IJclExtendedIterator } + function Add(const AValue: Extended): Boolean; + procedure Extract; + function GetValue: Extended; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AValue: Extended): Boolean; + function IteratorEquals(const AIterator: IJclExtendedIterator): Boolean; + function Next: Extended; + function NextIndex: Integer; + function Previous: Extended; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(const AValue: Extended); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Extended read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + {$IFDEF MATH_SINGLE_PRECISION} + TJclFloatHashSetBucket = TJclSingleHashSetBucket; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TJclFloatHashSetBucket = TJclDoubleHashSetBucket; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TJclFloatHashSetBucket = TJclExtendedHashSetBucket; + {$ENDIF MATH_EXTENDED_PRECISION} + + {$IFDEF MATH_SINGLE_PRECISION} + TJclFloatHashSet = TJclSingleHashSet; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TJclFloatHashSet = TJclDoubleHashSet; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TJclFloatHashSet = TJclExtendedHashSet; + {$ENDIF MATH_EXTENDED_PRECISION} + + {$IFDEF MATH_SINGLE_PRECISION} + TJclFloatHashSetIterator = TJclSingleHashSetIterator; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TJclFloatHashSetIterator = TJclDoubleHashSetIterator; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TJclFloatHashSetIterator = TJclExtendedHashSetIterator; + {$ENDIF MATH_EXTENDED_PRECISION} + + TJclIntegerHashSetBucket = class + public + Size: Integer; + Entries: TDynIntegerArray; + end; + + TJclIntegerHashSet = class(TJclIntegerAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclIntegerContainer, IJclIntegerFlatContainer, IJclIntegerEqualityComparer, IJclIntegerHashConverter, + IJclIntegerCollection, IJclIntegerSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FBuckets: array of TJclIntegerHashSetBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); overload; + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclIntegerCollection } + function Add(AValue: Integer): Boolean; + function AddAll(const ACollection: IJclIntegerCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclIntegerCollection): Boolean; + function Contains(AValue: Integer): Boolean; + function ContainsAll(const ACollection: IJclIntegerCollection): Boolean; + function Extract(AValue: Integer): Boolean; + function ExtractAll(const ACollection: IJclIntegerCollection): Boolean; + function First: IJclIntegerIterator; + function IsEmpty: Boolean; + function Last: IJclIntegerIterator; + function Remove(AValue: Integer): Boolean; + function RemoveAll(const ACollection: IJclIntegerCollection): Boolean; + function RetainAll(const ACollection: IJclIntegerCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIntegerIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclIntegerSet } + procedure Intersect(const ACollection: IJclIntegerCollection); + procedure Subtract(const ACollection: IJclIntegerCollection); + procedure Union(const ACollection: IJclIntegerCollection); + end; + + TJclIntegerHashSetIterator = class(TJclAbstractIterator, IJclIntegerIterator) + protected + FBucketIndex: Integer; + FItemIndex: Integer; + FStart: TItrStart; + FOwnHashSet: TJclIntegerHashSet; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnHashSet: TJclIntegerHashSet; ABucketIndex: Integer; AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); + { IJclIntegerIterator } + function Add(AValue: Integer): Boolean; + procedure Extract; + function GetValue: Integer; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(AValue: Integer): Boolean; + function IteratorEquals(const AIterator: IJclIntegerIterator): Boolean; + function Next: Integer; + function NextIndex: Integer; + function Previous: Integer; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(AValue: Integer); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Integer read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclCardinalHashSetBucket = class + public + Size: Integer; + Entries: TDynCardinalArray; + end; + + TJclCardinalHashSet = class(TJclCardinalAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclCardinalContainer, IJclCardinalFlatContainer, IJclCardinalEqualityComparer, IJclCardinalHashConverter, + IJclCardinalCollection, IJclCardinalSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FBuckets: array of TJclCardinalHashSetBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); overload; + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclCardinalCollection } + function Add(AValue: Cardinal): Boolean; + function AddAll(const ACollection: IJclCardinalCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclCardinalCollection): Boolean; + function Contains(AValue: Cardinal): Boolean; + function ContainsAll(const ACollection: IJclCardinalCollection): Boolean; + function Extract(AValue: Cardinal): Boolean; + function ExtractAll(const ACollection: IJclCardinalCollection): Boolean; + function First: IJclCardinalIterator; + function IsEmpty: Boolean; + function Last: IJclCardinalIterator; + function Remove(AValue: Cardinal): Boolean; + function RemoveAll(const ACollection: IJclCardinalCollection): Boolean; + function RetainAll(const ACollection: IJclCardinalCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclCardinalIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclCardinalSet } + procedure Intersect(const ACollection: IJclCardinalCollection); + procedure Subtract(const ACollection: IJclCardinalCollection); + procedure Union(const ACollection: IJclCardinalCollection); + end; + + TJclCardinalHashSetIterator = class(TJclAbstractIterator, IJclCardinalIterator) + protected + FBucketIndex: Integer; + FItemIndex: Integer; + FStart: TItrStart; + FOwnHashSet: TJclCardinalHashSet; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnHashSet: TJclCardinalHashSet; ABucketIndex: Integer; AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); + { IJclCardinalIterator } + function Add(AValue: Cardinal): Boolean; + procedure Extract; + function GetValue: Cardinal; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(AValue: Cardinal): Boolean; + function IteratorEquals(const AIterator: IJclCardinalIterator): Boolean; + function Next: Cardinal; + function NextIndex: Integer; + function Previous: Cardinal; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(AValue: Cardinal); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Cardinal read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclInt64HashSetBucket = class + public + Size: Integer; + Entries: TDynInt64Array; + end; + + TJclInt64HashSet = class(TJclInt64AbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclInt64Container, IJclInt64FlatContainer, IJclInt64EqualityComparer, IJclInt64HashConverter, + IJclInt64Collection, IJclInt64Set) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FBuckets: array of TJclInt64HashSetBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); overload; + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclInt64Collection } + function Add(const AValue: Int64): Boolean; + function AddAll(const ACollection: IJclInt64Collection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclInt64Collection): Boolean; + function Contains(const AValue: Int64): Boolean; + function ContainsAll(const ACollection: IJclInt64Collection): Boolean; + function Extract(const AValue: Int64): Boolean; + function ExtractAll(const ACollection: IJclInt64Collection): Boolean; + function First: IJclInt64Iterator; + function IsEmpty: Boolean; + function Last: IJclInt64Iterator; + function Remove(const AValue: Int64): Boolean; + function RemoveAll(const ACollection: IJclInt64Collection): Boolean; + function RetainAll(const ACollection: IJclInt64Collection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclInt64Iterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclInt64Set } + procedure Intersect(const ACollection: IJclInt64Collection); + procedure Subtract(const ACollection: IJclInt64Collection); + procedure Union(const ACollection: IJclInt64Collection); + end; + + TJclInt64HashSetIterator = class(TJclAbstractIterator, IJclInt64Iterator) + protected + FBucketIndex: Integer; + FItemIndex: Integer; + FStart: TItrStart; + FOwnHashSet: TJclInt64HashSet; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnHashSet: TJclInt64HashSet; ABucketIndex: Integer; AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); + { IJclInt64Iterator } + function Add(const AValue: Int64): Boolean; + procedure Extract; + function GetValue: Int64; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AValue: Int64): Boolean; + function IteratorEquals(const AIterator: IJclInt64Iterator): Boolean; + function Next: Int64; + function NextIndex: Integer; + function Previous: Int64; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(const AValue: Int64); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Int64 read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclPtrHashSetBucket = class + public + Size: Integer; + Entries: TDynPointerArray; + end; + + TJclPtrHashSet = class(TJclPtrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclPtrContainer, IJclPtrFlatContainer, IJclPtrEqualityComparer, IJclPtrHashConverter, + IJclPtrCollection, IJclPtrSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FBuckets: array of TJclPtrHashSetBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); overload; + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclPtrCollection } + function Add(APtr: Pointer): Boolean; + function AddAll(const ACollection: IJclPtrCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclPtrCollection): Boolean; + function Contains(APtr: Pointer): Boolean; + function ContainsAll(const ACollection: IJclPtrCollection): Boolean; + function Extract(APtr: Pointer): Boolean; + function ExtractAll(const ACollection: IJclPtrCollection): Boolean; + function First: IJclPtrIterator; + function IsEmpty: Boolean; + function Last: IJclPtrIterator; + function Remove(APtr: Pointer): Boolean; + function RemoveAll(const ACollection: IJclPtrCollection): Boolean; + function RetainAll(const ACollection: IJclPtrCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclPtrIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclPtrSet } + procedure Intersect(const ACollection: IJclPtrCollection); + procedure Subtract(const ACollection: IJclPtrCollection); + procedure Union(const ACollection: IJclPtrCollection); + end; + + TJclPtrHashSetIterator = class(TJclAbstractIterator, IJclPtrIterator) + protected + FBucketIndex: Integer; + FItemIndex: Integer; + FStart: TItrStart; + FOwnHashSet: TJclPtrHashSet; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnHashSet: TJclPtrHashSet; ABucketIndex: Integer; AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); + { IJclPtrIterator } + function Add(APtr: Pointer): Boolean; + procedure Extract; + function GetPointer: Pointer; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(APtr: Pointer): Boolean; + function IteratorEquals(const AIterator: IJclPtrIterator): Boolean; + function Next: Pointer; + function NextIndex: Integer; + function Previous: Pointer; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetPointer(APtr: Pointer); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Pointer read GetPointer; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclHashSetBucket = class + public + Size: Integer; + Entries: TDynObjectArray; + end; + + TJclHashSet = class(TJclAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclContainer, IJclFlatContainer, IJclEqualityComparer, IJclHashConverter, IJclObjectOwner, + IJclCollection, IJclSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FBuckets: array of TJclHashSetBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer; AOwnsObjects: Boolean); overload; + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclCollection } + function Add(AObject: TObject): Boolean; + function AddAll(const ACollection: IJclCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclCollection): Boolean; + function Contains(AObject: TObject): Boolean; + function ContainsAll(const ACollection: IJclCollection): Boolean; + function Extract(AObject: TObject): Boolean; + function ExtractAll(const ACollection: IJclCollection): Boolean; + function First: IJclIterator; + function IsEmpty: Boolean; + function Last: IJclIterator; + function Remove(AObject: TObject): Boolean; + function RemoveAll(const ACollection: IJclCollection): Boolean; + function RetainAll(const ACollection: IJclCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclSet } + procedure Intersect(const ACollection: IJclCollection); + procedure Subtract(const ACollection: IJclCollection); + procedure Union(const ACollection: IJclCollection); + end; + + TJclHashSetIterator = class(TJclAbstractIterator, IJclIterator) + protected + FBucketIndex: Integer; + FItemIndex: Integer; + FStart: TItrStart; + FOwnHashSet: TJclHashSet; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnHashSet: TJclHashSet; ABucketIndex: Integer; AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); + { IJclIterator } + function Add(AObject: TObject): Boolean; + procedure Extract; + function GetObject: TObject; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(AObject: TObject): Boolean; + function IteratorEquals(const AIterator: IJclIterator): Boolean; + function Next: TObject; + function NextIndex: Integer; + function Previous: TObject; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetObject(AObject: TObject); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: TObject read GetObject; + {$ENDIF SUPPORTS_FOR_IN} + end; + + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + + TJclHashSetBucket = class + public + type + TDynArray = array of T; + public + Size: Integer; + Entries: TDynArray; + procedure MoveArray(var List: TDynArray; FromIndex, ToIndex, Count: SizeInt); + end; + + TJclHashSet = class(TJclAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclContainer, IJclFlatContainer, IJclEqualityComparer, IJclHashConverter, IJclItemOwner, + IJclCollection, IJclSet) + private + FBuckets: array of TJclHashSetBucket; + FHashToRangeFunction: TJclHashToRangeFunction; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer; AOwnsItems: Boolean); overload; + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclCollection } + function Add(const AItem: T): Boolean; + function AddAll(const ACollection: IJclCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclCollection): Boolean; + function Contains(const AItem: T): Boolean; + function ContainsAll(const ACollection: IJclCollection): Boolean; + function Extract(const AItem: T): Boolean; + function ExtractAll(const ACollection: IJclCollection): Boolean; + function First: IJclIterator; + function IsEmpty: Boolean; + function Last: IJclIterator; + function Remove(const AItem: T): Boolean; + function RemoveAll(const ACollection: IJclCollection): Boolean; + function RetainAll(const ACollection: IJclCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclSet } + procedure Intersect(const ACollection: IJclCollection); + procedure Subtract(const ACollection: IJclCollection); + procedure Union(const ACollection: IJclCollection); + end; + + TJclHashSetIterator = class(TJclAbstractIterator, IJclIterator) + protected + FBucketIndex: Integer; + FItemIndex: Integer; + FStart: TItrStart; + FOwnHashSet: TJclHashSet; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnHashSet: TJclHashSet; ABucketIndex: Integer; AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); + { IJclIterator } + function Add(const AItem: T): Boolean; + procedure Extract; + function GetItem: T; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AItem: T): Boolean; + function IteratorEquals(const AIterator: IJclIterator): Boolean; + function Next: T; + function NextIndex: Integer; + function Previous: T; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetItem(const AItem: T); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: T read GetItem; + {$ENDIF SUPPORTS_FOR_IN} + end; + + // E = External helper to compare items for equality + TJclHashSetE = class(TJclHashSet, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, + IJclEqualityComparer, IJclHashConverter, IJclItemOwner, IJclCollection, IJclSet) + private + FEqualityComparer: IJclEqualityComparer; + FHashConverter: IJclHashConverter; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AEqualityComparer: IJclEqualityComparer; const AHashConverter: IJclHashConverter; + ACapacity: Integer; AOwnsItems: Boolean); overload; + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + property EqualityComparer: IJclEqualityComparer read FEqualityComparer write FEqualityComparer; + { IJclHashConverter } + function Hash(const AItem: T): Integer; override; + property HashConverter: IJclHashConverter read FHashConverter write FHashConverter; + end; + + // F = Function to compare items for equality + TJclHashSetF = class(TJclHashSet, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, + IJclEqualityComparer, IJclHashConverter, IJclItemOwner, + IJclCollection, IJclSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AEqualityCompare: TEqualityCompare; const AHashConvert: THashConvert; + ACapacity: Integer; AOwnsItems: Boolean); overload; + end; + + // I = Items can compare themselves to others + TJclHashSetI, IHashable> = class(TJclHashSet, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, + IJclEqualityComparer, IJclHashConverter, IJclItemOwner, + IJclCollection, IJclSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + { IJclHashConverter } + function Hash(const AItem: T): Integer; override; + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +{$IFDEF BCB} +{$IFDEF WIN64} + {$HPPEMIT '#ifdef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #undef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #define JclHashSets_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT '#endif'} + + {$HPPEMIT END '#ifdef JclHashSets_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #define MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #undef JclHashSets_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END '#endif'} +{$ENDIF WIN64} +{$ENDIF BCB} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +//=== { TJclIntfHashSet } ==================================================== + +constructor TJclIntfHashSet.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclIntfHashSet.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclIntfHashSet.Add(const AInterface: IInterface): Boolean; +var + Index: Integer; + Bucket: TJclIntfHashSetBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if FAllowDefaultElements or (not ItemsEqual(AInterface, nil)) then + begin + Index := FHashToRangeFunction(Hash(AInterface), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AInterface) then + Exit; + end + else + begin + Bucket := TJclIntfHashSetBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size] := AInterface; + Inc(Bucket.Size); + Inc(FSize); + Result := True; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashSet.AddAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfHashSet.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclIntfHashSetBucket; + ADest: TJclIntfHashSet; + ACollection: IJclIntfCollection; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclIntfHashSet then + begin + ADest := TJclIntfHashSet(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclIntfHashSetBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + NewBucket.Entries[J] := SelfBucket.Entries[J]; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclIntfCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfHashSet.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclIntfHashSet then + TJclIntfHashSet(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclIntfHashSet.Clear; +var + I, J: Integer; + Bucket: TJclIntfHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + FreeObject(Bucket.Entries[J]); + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashSet.CollectionEquals(const ACollection: IJclIntfCollection): Boolean; +var + I, J: Integer; + It: IJclIntfIterator; + Bucket: TJclIntfHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if not ItemsEqual(Bucket.Entries[J], It.Next) then + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashSet.Contains(const AInterface: IInterface): Boolean; +var + I: Integer; + Bucket: TJclIntfHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(AInterface), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AInterface) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashSet.ContainsAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashSet.Extract(const AInterface: IInterface): Boolean; +var + Bucket: TJclIntfHashSetBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(AInterface), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AInterface) then + begin + Result := True; + Bucket.Entries[I] := nil; + if I < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashSet.ExtractAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashSet.First: IJclIntfIterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclIntfHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := 0; + ABucket := nil; + while ABucketIndex < FCapacity do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := 0 + else + AItemIndex := -1; + Result := TJclIntfHashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isFirst); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclIntfHashSet.GetEnumerator: IJclIntfIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +procedure TJclIntfHashSet.Intersect(const ACollection: IJclIntfCollection); +begin + RetainAll(ACollection); +end; + +function TJclIntfHashSet.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntfHashSet.Last: IJclIntfIterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclIntfHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := FCapacity - 1; + ABucket := nil; + while ABucketIndex >= 0 do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := ABucket.Size - 1 + else + AItemIndex := -1; + Result := TJclIntfHashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isLast); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfHashSet.Pack; +var + I: Integer; + Bucket: TJclIntfHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashSet.Remove(const AInterface: IInterface): Boolean; +var + Extracted: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AInterface); + if Result then + begin + Extracted := AInterface; + FreeObject(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashSet.RemoveAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashSet.RetainAll(const ACollection: IJclIntfCollection): Boolean; +var + I, J, NewCapacity: Integer; + Bucket: TJclIntfHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := Bucket.Size - 1 downto 0 do + if not ACollection.Contains(Bucket.Entries[I]) then + begin + Bucket.Entries[J] := FreeObject(Bucket.Entries[J]); + if J < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, J + 1, J, Bucket.Size - J - 1); + Dec(Bucket.Size); + Dec(FSize); + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfHashSet.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashSet.Size: Integer; +begin + Result := FSize; +end; + +procedure TJclIntfHashSet.Subtract(const ACollection: IJclIntfCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclIntfHashSet.Union(const ACollection: IJclIntfCollection); +begin + AddAll(ACollection); +end; + + +function TJclIntfHashSet.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfHashSet.Create(Size); + AssignPropertiesTo(Result); +end; + +//=== { TJclIntfHashSetIterator } ============================================ + +constructor TJclIntfHashSetIterator.Create(AOwnHashSet: TJclIntfHashSet; + ABucketIndex, AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnHashSet := AOwnHashSet; + FBucketIndex := ABucketIndex; + FItemIndex := AItemIndex; + FStart := AStart; +end; + +function TJclIntfHashSetIterator.Add(const AInterface: IInterface): Boolean; +begin + Result := FOwnHashSet.Add(AInterface); +end; + +procedure TJclIntfHashSetIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclIntfHashSetIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclIntfHashSetIterator then + begin + ADest := TJclIntfHashSetIterator(Dest); + ADest.FBucketIndex := FBucketIndex; + ADest.FItemIndex := FItemIndex; + ADest.FOwnHashSet := FOwnHashSet; + ADest.FStart := FStart; + end; +end; + +function TJclIntfHashSetIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclIntfHashSetIterator.Create(FOwnHashSet, FBucketIndex, FItemIndex, Valid, FStart); +end; + +procedure TJclIntfHashSetIterator.Extract; +var + AInterface: IInterface; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + AInterface := GetObject; + Valid := False; + FOwnHashSet.Extract(AInterface); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashSetIterator.GetObject: IInterface; +var + ABucket: TJclIntfHashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := nil; + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashSetIterator.HasNext: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclIntfHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex < (ABucket.Size - 1)) or + ((not SkipCurrent) and (AItemIndex < ABucket.Size)) then + Exit; + end; + AItemIndex := 0; + Inc(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashSetIterator.HasPrevious: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclIntfHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex > 0) or + ((not SkipCurrent) and (AItemIndex >= 0)) then + Exit; + end; + AItemIndex := MaxInt; + Dec(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashSetIterator.Insert(const AInterface: IInterface): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclIntfHashSetIterator.IteratorEquals(const AIterator: IJclIntfIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclIntfHashSetIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclIntfHashSetIterator then + begin + ItrObj := TJclIntfHashSetIterator(Obj); + Result := (FOwnHashSet = ItrObj.FOwnHashSet) and (FBucketIndex = ItrObj.FBucketIndex) and (FItemIndex = ItrObj.FItemIndex) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclIntfHashSetIterator.MoveNext: Boolean; +var + ABucket: TJclIntfHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity); + if Result then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + Result := (ABucket <> nil) and (FItemIndex < ABucket.Size); + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclIntfHashSetIterator.Next: IInterface; +var + ABucket: TJclIntfHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := nil; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashSetIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclIntfHashSetIterator.Previous: IInterface; +var + ABucket: TJclIntfHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < 0) then + FItemIndex := ABucket.Size - 1; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex >= 0) and (FItemIndex < ABucket.Size) then + Break; + if (FItemIndex > 0) and (FItemIndex < ABucket.Size) then + begin + Dec(FItemIndex); + Break; + end; + end; + FItemIndex := -1; + Dec(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := nil; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfHashSetIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclIntfHashSetIterator.Remove; +begin + +end; + +procedure TJclIntfHashSetIterator.Reset; +var + ABucket: TJclIntfHashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + FBucketIndex := 0; + ABucket := nil; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := 0 + else + FItemIndex := -1; + end; + isLast: + begin + FBucketIndex := FOwnHashSet.FCapacity - 1; + ABucket := nil; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := ABucket.Size - 1 + else + FItemIndex := -1; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfHashSetIterator.SetObject(const AInterface: IInterface); +begin + raise EJclOperationNotSupportedError.Create; +end; +//=== { TJclAnsiStrHashSet } ==================================================== + +constructor TJclAnsiStrHashSet.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclAnsiStrHashSet.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclAnsiStrHashSet.Add(const AString: AnsiString): Boolean; +var + Index: Integer; + Bucket: TJclAnsiStrHashSetBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if FAllowDefaultElements or (not ItemsEqual(AString, '')) then + begin + Index := FHashToRangeFunction(Hash(AString), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AString) then + Exit; + end + else + begin + Bucket := TJclAnsiStrHashSetBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size] := AString; + Inc(Bucket.Size); + Inc(FSize); + Result := True; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashSet.AddAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrHashSet.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclAnsiStrHashSetBucket; + ADest: TJclAnsiStrHashSet; + ACollection: IJclAnsiStrCollection; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclAnsiStrHashSet then + begin + ADest := TJclAnsiStrHashSet(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclAnsiStrHashSetBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + NewBucket.Entries[J] := SelfBucket.Entries[J]; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclAnsiStrCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrHashSet.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclAnsiStrHashSet then + TJclAnsiStrHashSet(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclAnsiStrHashSet.Clear; +var + I, J: Integer; + Bucket: TJclAnsiStrHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + FreeString(Bucket.Entries[J]); + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashSet.CollectionEquals(const ACollection: IJclAnsiStrCollection): Boolean; +var + I, J: Integer; + It: IJclAnsiStrIterator; + Bucket: TJclAnsiStrHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if not ItemsEqual(Bucket.Entries[J], It.Next) then + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashSet.Contains(const AString: AnsiString): Boolean; +var + I: Integer; + Bucket: TJclAnsiStrHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(AString), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AString) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashSet.ContainsAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashSet.Extract(const AString: AnsiString): Boolean; +var + Bucket: TJclAnsiStrHashSetBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(AString), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AString) then + begin + Result := True; + Bucket.Entries[I] := ''; + if I < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashSet.ExtractAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashSet.First: IJclAnsiStrIterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclAnsiStrHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := 0; + ABucket := nil; + while ABucketIndex < FCapacity do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := 0 + else + AItemIndex := -1; + Result := TJclAnsiStrHashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isFirst); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclAnsiStrHashSet.GetEnumerator: IJclAnsiStrIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +procedure TJclAnsiStrHashSet.Intersect(const ACollection: IJclAnsiStrCollection); +begin + RetainAll(ACollection); +end; + +function TJclAnsiStrHashSet.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclAnsiStrHashSet.Last: IJclAnsiStrIterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclAnsiStrHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := FCapacity - 1; + ABucket := nil; + while ABucketIndex >= 0 do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := ABucket.Size - 1 + else + AItemIndex := -1; + Result := TJclAnsiStrHashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isLast); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrHashSet.Pack; +var + I: Integer; + Bucket: TJclAnsiStrHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashSet.Remove(const AString: AnsiString): Boolean; +var + Extracted: AnsiString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AString); + if Result then + begin + Extracted := AString; + FreeString(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashSet.RemoveAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashSet.RetainAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + I, J, NewCapacity: Integer; + Bucket: TJclAnsiStrHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := Bucket.Size - 1 downto 0 do + if not ACollection.Contains(Bucket.Entries[I]) then + begin + Bucket.Entries[J] := FreeString(Bucket.Entries[J]); + if J < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, J + 1, J, Bucket.Size - J - 1); + Dec(Bucket.Size); + Dec(FSize); + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrHashSet.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashSet.Size: Integer; +begin + Result := FSize; +end; + +procedure TJclAnsiStrHashSet.Subtract(const ACollection: IJclAnsiStrCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclAnsiStrHashSet.Union(const ACollection: IJclAnsiStrCollection); +begin + AddAll(ACollection); +end; + + +function TJclAnsiStrHashSet.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclAnsiStrHashSet.Create(Size); + AssignPropertiesTo(Result); +end; + +//=== { TJclAnsiStrHashSetIterator } ============================================ + +constructor TJclAnsiStrHashSetIterator.Create(AOwnHashSet: TJclAnsiStrHashSet; + ABucketIndex, AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnHashSet := AOwnHashSet; + FBucketIndex := ABucketIndex; + FItemIndex := AItemIndex; + FStart := AStart; +end; + +function TJclAnsiStrHashSetIterator.Add(const AString: AnsiString): Boolean; +begin + Result := FOwnHashSet.Add(AString); +end; + +procedure TJclAnsiStrHashSetIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclAnsiStrHashSetIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclAnsiStrHashSetIterator then + begin + ADest := TJclAnsiStrHashSetIterator(Dest); + ADest.FBucketIndex := FBucketIndex; + ADest.FItemIndex := FItemIndex; + ADest.FOwnHashSet := FOwnHashSet; + ADest.FStart := FStart; + end; +end; + +function TJclAnsiStrHashSetIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclAnsiStrHashSetIterator.Create(FOwnHashSet, FBucketIndex, FItemIndex, Valid, FStart); +end; + +procedure TJclAnsiStrHashSetIterator.Extract; +var + AString: AnsiString; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + AString := GetString; + Valid := False; + FOwnHashSet.Extract(AString); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashSetIterator.GetString: AnsiString; +var + ABucket: TJclAnsiStrHashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := ''; + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashSetIterator.HasNext: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclAnsiStrHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex < (ABucket.Size - 1)) or + ((not SkipCurrent) and (AItemIndex < ABucket.Size)) then + Exit; + end; + AItemIndex := 0; + Inc(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashSetIterator.HasPrevious: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclAnsiStrHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex > 0) or + ((not SkipCurrent) and (AItemIndex >= 0)) then + Exit; + end; + AItemIndex := MaxInt; + Dec(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashSetIterator.Insert(const AString: AnsiString): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclAnsiStrHashSetIterator.IteratorEquals(const AIterator: IJclAnsiStrIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclAnsiStrHashSetIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclAnsiStrHashSetIterator then + begin + ItrObj := TJclAnsiStrHashSetIterator(Obj); + Result := (FOwnHashSet = ItrObj.FOwnHashSet) and (FBucketIndex = ItrObj.FBucketIndex) and (FItemIndex = ItrObj.FItemIndex) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclAnsiStrHashSetIterator.MoveNext: Boolean; +var + ABucket: TJclAnsiStrHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity); + if Result then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + Result := (ABucket <> nil) and (FItemIndex < ABucket.Size); + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclAnsiStrHashSetIterator.Next: AnsiString; +var + ABucket: TJclAnsiStrHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := ''; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashSetIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclAnsiStrHashSetIterator.Previous: AnsiString; +var + ABucket: TJclAnsiStrHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < 0) then + FItemIndex := ABucket.Size - 1; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex >= 0) and (FItemIndex < ABucket.Size) then + Break; + if (FItemIndex > 0) and (FItemIndex < ABucket.Size) then + begin + Dec(FItemIndex); + Break; + end; + end; + FItemIndex := -1; + Dec(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := ''; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrHashSetIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclAnsiStrHashSetIterator.Remove; +begin + +end; + +procedure TJclAnsiStrHashSetIterator.Reset; +var + ABucket: TJclAnsiStrHashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + FBucketIndex := 0; + ABucket := nil; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := 0 + else + FItemIndex := -1; + end; + isLast: + begin + FBucketIndex := FOwnHashSet.FCapacity - 1; + ABucket := nil; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := ABucket.Size - 1 + else + FItemIndex := -1; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrHashSetIterator.SetString(const AString: AnsiString); +begin + raise EJclOperationNotSupportedError.Create; +end; +//=== { TJclWideStrHashSet } ==================================================== + +constructor TJclWideStrHashSet.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclWideStrHashSet.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclWideStrHashSet.Add(const AString: WideString): Boolean; +var + Index: Integer; + Bucket: TJclWideStrHashSetBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if FAllowDefaultElements or (not ItemsEqual(AString, '')) then + begin + Index := FHashToRangeFunction(Hash(AString), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AString) then + Exit; + end + else + begin + Bucket := TJclWideStrHashSetBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size] := AString; + Inc(Bucket.Size); + Inc(FSize); + Result := True; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashSet.AddAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrHashSet.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclWideStrHashSetBucket; + ADest: TJclWideStrHashSet; + ACollection: IJclWideStrCollection; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclWideStrHashSet then + begin + ADest := TJclWideStrHashSet(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclWideStrHashSetBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + NewBucket.Entries[J] := SelfBucket.Entries[J]; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclWideStrCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrHashSet.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclWideStrHashSet then + TJclWideStrHashSet(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclWideStrHashSet.Clear; +var + I, J: Integer; + Bucket: TJclWideStrHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + FreeString(Bucket.Entries[J]); + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashSet.CollectionEquals(const ACollection: IJclWideStrCollection): Boolean; +var + I, J: Integer; + It: IJclWideStrIterator; + Bucket: TJclWideStrHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if not ItemsEqual(Bucket.Entries[J], It.Next) then + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashSet.Contains(const AString: WideString): Boolean; +var + I: Integer; + Bucket: TJclWideStrHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(AString), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AString) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashSet.ContainsAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashSet.Extract(const AString: WideString): Boolean; +var + Bucket: TJclWideStrHashSetBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(AString), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AString) then + begin + Result := True; + Bucket.Entries[I] := ''; + if I < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashSet.ExtractAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashSet.First: IJclWideStrIterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclWideStrHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := 0; + ABucket := nil; + while ABucketIndex < FCapacity do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := 0 + else + AItemIndex := -1; + Result := TJclWideStrHashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isFirst); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclWideStrHashSet.GetEnumerator: IJclWideStrIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +procedure TJclWideStrHashSet.Intersect(const ACollection: IJclWideStrCollection); +begin + RetainAll(ACollection); +end; + +function TJclWideStrHashSet.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclWideStrHashSet.Last: IJclWideStrIterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclWideStrHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := FCapacity - 1; + ABucket := nil; + while ABucketIndex >= 0 do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := ABucket.Size - 1 + else + AItemIndex := -1; + Result := TJclWideStrHashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isLast); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrHashSet.Pack; +var + I: Integer; + Bucket: TJclWideStrHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashSet.Remove(const AString: WideString): Boolean; +var + Extracted: WideString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AString); + if Result then + begin + Extracted := AString; + FreeString(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashSet.RemoveAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashSet.RetainAll(const ACollection: IJclWideStrCollection): Boolean; +var + I, J, NewCapacity: Integer; + Bucket: TJclWideStrHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := Bucket.Size - 1 downto 0 do + if not ACollection.Contains(Bucket.Entries[I]) then + begin + Bucket.Entries[J] := FreeString(Bucket.Entries[J]); + if J < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, J + 1, J, Bucket.Size - J - 1); + Dec(Bucket.Size); + Dec(FSize); + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrHashSet.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashSet.Size: Integer; +begin + Result := FSize; +end; + +procedure TJclWideStrHashSet.Subtract(const ACollection: IJclWideStrCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclWideStrHashSet.Union(const ACollection: IJclWideStrCollection); +begin + AddAll(ACollection); +end; + + +function TJclWideStrHashSet.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclWideStrHashSet.Create(Size); + AssignPropertiesTo(Result); +end; + +//=== { TJclWideStrHashSetIterator } ============================================ + +constructor TJclWideStrHashSetIterator.Create(AOwnHashSet: TJclWideStrHashSet; + ABucketIndex, AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnHashSet := AOwnHashSet; + FBucketIndex := ABucketIndex; + FItemIndex := AItemIndex; + FStart := AStart; +end; + +function TJclWideStrHashSetIterator.Add(const AString: WideString): Boolean; +begin + Result := FOwnHashSet.Add(AString); +end; + +procedure TJclWideStrHashSetIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclWideStrHashSetIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclWideStrHashSetIterator then + begin + ADest := TJclWideStrHashSetIterator(Dest); + ADest.FBucketIndex := FBucketIndex; + ADest.FItemIndex := FItemIndex; + ADest.FOwnHashSet := FOwnHashSet; + ADest.FStart := FStart; + end; +end; + +function TJclWideStrHashSetIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclWideStrHashSetIterator.Create(FOwnHashSet, FBucketIndex, FItemIndex, Valid, FStart); +end; + +procedure TJclWideStrHashSetIterator.Extract; +var + AString: WideString; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + AString := GetString; + Valid := False; + FOwnHashSet.Extract(AString); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashSetIterator.GetString: WideString; +var + ABucket: TJclWideStrHashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := ''; + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashSetIterator.HasNext: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclWideStrHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex < (ABucket.Size - 1)) or + ((not SkipCurrent) and (AItemIndex < ABucket.Size)) then + Exit; + end; + AItemIndex := 0; + Inc(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashSetIterator.HasPrevious: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclWideStrHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex > 0) or + ((not SkipCurrent) and (AItemIndex >= 0)) then + Exit; + end; + AItemIndex := MaxInt; + Dec(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashSetIterator.Insert(const AString: WideString): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclWideStrHashSetIterator.IteratorEquals(const AIterator: IJclWideStrIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclWideStrHashSetIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclWideStrHashSetIterator then + begin + ItrObj := TJclWideStrHashSetIterator(Obj); + Result := (FOwnHashSet = ItrObj.FOwnHashSet) and (FBucketIndex = ItrObj.FBucketIndex) and (FItemIndex = ItrObj.FItemIndex) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclWideStrHashSetIterator.MoveNext: Boolean; +var + ABucket: TJclWideStrHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity); + if Result then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + Result := (ABucket <> nil) and (FItemIndex < ABucket.Size); + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclWideStrHashSetIterator.Next: WideString; +var + ABucket: TJclWideStrHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := ''; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashSetIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclWideStrHashSetIterator.Previous: WideString; +var + ABucket: TJclWideStrHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < 0) then + FItemIndex := ABucket.Size - 1; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex >= 0) and (FItemIndex < ABucket.Size) then + Break; + if (FItemIndex > 0) and (FItemIndex < ABucket.Size) then + begin + Dec(FItemIndex); + Break; + end; + end; + FItemIndex := -1; + Dec(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := ''; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrHashSetIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclWideStrHashSetIterator.Remove; +begin + +end; + +procedure TJclWideStrHashSetIterator.Reset; +var + ABucket: TJclWideStrHashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + FBucketIndex := 0; + ABucket := nil; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := 0 + else + FItemIndex := -1; + end; + isLast: + begin + FBucketIndex := FOwnHashSet.FCapacity - 1; + ABucket := nil; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := ABucket.Size - 1 + else + FItemIndex := -1; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrHashSetIterator.SetString(const AString: WideString); +begin + raise EJclOperationNotSupportedError.Create; +end; +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrHashSet } ==================================================== + +constructor TJclUnicodeStrHashSet.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclUnicodeStrHashSet.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclUnicodeStrHashSet.Add(const AString: UnicodeString): Boolean; +var + Index: Integer; + Bucket: TJclUnicodeStrHashSetBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if FAllowDefaultElements or (not ItemsEqual(AString, '')) then + begin + Index := FHashToRangeFunction(Hash(AString), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AString) then + Exit; + end + else + begin + Bucket := TJclUnicodeStrHashSetBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size] := AString; + Inc(Bucket.Size); + Inc(FSize); + Result := True; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashSet.AddAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrHashSet.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclUnicodeStrHashSetBucket; + ADest: TJclUnicodeStrHashSet; + ACollection: IJclUnicodeStrCollection; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclUnicodeStrHashSet then + begin + ADest := TJclUnicodeStrHashSet(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclUnicodeStrHashSetBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + NewBucket.Entries[J] := SelfBucket.Entries[J]; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclUnicodeStrCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrHashSet.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclUnicodeStrHashSet then + TJclUnicodeStrHashSet(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclUnicodeStrHashSet.Clear; +var + I, J: Integer; + Bucket: TJclUnicodeStrHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + FreeString(Bucket.Entries[J]); + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashSet.CollectionEquals(const ACollection: IJclUnicodeStrCollection): Boolean; +var + I, J: Integer; + It: IJclUnicodeStrIterator; + Bucket: TJclUnicodeStrHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if not ItemsEqual(Bucket.Entries[J], It.Next) then + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashSet.Contains(const AString: UnicodeString): Boolean; +var + I: Integer; + Bucket: TJclUnicodeStrHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(AString), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AString) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashSet.ContainsAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashSet.Extract(const AString: UnicodeString): Boolean; +var + Bucket: TJclUnicodeStrHashSetBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(AString), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AString) then + begin + Result := True; + Bucket.Entries[I] := ''; + if I < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashSet.ExtractAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashSet.First: IJclUnicodeStrIterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclUnicodeStrHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := 0; + ABucket := nil; + while ABucketIndex < FCapacity do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := 0 + else + AItemIndex := -1; + Result := TJclUnicodeStrHashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isFirst); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclUnicodeStrHashSet.GetEnumerator: IJclUnicodeStrIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +procedure TJclUnicodeStrHashSet.Intersect(const ACollection: IJclUnicodeStrCollection); +begin + RetainAll(ACollection); +end; + +function TJclUnicodeStrHashSet.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclUnicodeStrHashSet.Last: IJclUnicodeStrIterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclUnicodeStrHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := FCapacity - 1; + ABucket := nil; + while ABucketIndex >= 0 do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := ABucket.Size - 1 + else + AItemIndex := -1; + Result := TJclUnicodeStrHashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isLast); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrHashSet.Pack; +var + I: Integer; + Bucket: TJclUnicodeStrHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashSet.Remove(const AString: UnicodeString): Boolean; +var + Extracted: UnicodeString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AString); + if Result then + begin + Extracted := AString; + FreeString(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashSet.RemoveAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashSet.RetainAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + I, J, NewCapacity: Integer; + Bucket: TJclUnicodeStrHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := Bucket.Size - 1 downto 0 do + if not ACollection.Contains(Bucket.Entries[I]) then + begin + Bucket.Entries[J] := FreeString(Bucket.Entries[J]); + if J < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, J + 1, J, Bucket.Size - J - 1); + Dec(Bucket.Size); + Dec(FSize); + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrHashSet.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashSet.Size: Integer; +begin + Result := FSize; +end; + +procedure TJclUnicodeStrHashSet.Subtract(const ACollection: IJclUnicodeStrCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclUnicodeStrHashSet.Union(const ACollection: IJclUnicodeStrCollection); +begin + AddAll(ACollection); +end; + + +function TJclUnicodeStrHashSet.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclUnicodeStrHashSet.Create(Size); + AssignPropertiesTo(Result); +end; + +{$ENDIF SUPPORTS_UNICODE_STRING} + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrHashSetIterator } ============================================ + +constructor TJclUnicodeStrHashSetIterator.Create(AOwnHashSet: TJclUnicodeStrHashSet; + ABucketIndex, AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnHashSet := AOwnHashSet; + FBucketIndex := ABucketIndex; + FItemIndex := AItemIndex; + FStart := AStart; +end; + +function TJclUnicodeStrHashSetIterator.Add(const AString: UnicodeString): Boolean; +begin + Result := FOwnHashSet.Add(AString); +end; + +procedure TJclUnicodeStrHashSetIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclUnicodeStrHashSetIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclUnicodeStrHashSetIterator then + begin + ADest := TJclUnicodeStrHashSetIterator(Dest); + ADest.FBucketIndex := FBucketIndex; + ADest.FItemIndex := FItemIndex; + ADest.FOwnHashSet := FOwnHashSet; + ADest.FStart := FStart; + end; +end; + +function TJclUnicodeStrHashSetIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclUnicodeStrHashSetIterator.Create(FOwnHashSet, FBucketIndex, FItemIndex, Valid, FStart); +end; + +procedure TJclUnicodeStrHashSetIterator.Extract; +var + AString: UnicodeString; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + AString := GetString; + Valid := False; + FOwnHashSet.Extract(AString); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashSetIterator.GetString: UnicodeString; +var + ABucket: TJclUnicodeStrHashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := ''; + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashSetIterator.HasNext: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclUnicodeStrHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex < (ABucket.Size - 1)) or + ((not SkipCurrent) and (AItemIndex < ABucket.Size)) then + Exit; + end; + AItemIndex := 0; + Inc(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashSetIterator.HasPrevious: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclUnicodeStrHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex > 0) or + ((not SkipCurrent) and (AItemIndex >= 0)) then + Exit; + end; + AItemIndex := MaxInt; + Dec(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashSetIterator.Insert(const AString: UnicodeString): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclUnicodeStrHashSetIterator.IteratorEquals(const AIterator: IJclUnicodeStrIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclUnicodeStrHashSetIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclUnicodeStrHashSetIterator then + begin + ItrObj := TJclUnicodeStrHashSetIterator(Obj); + Result := (FOwnHashSet = ItrObj.FOwnHashSet) and (FBucketIndex = ItrObj.FBucketIndex) and (FItemIndex = ItrObj.FItemIndex) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclUnicodeStrHashSetIterator.MoveNext: Boolean; +var + ABucket: TJclUnicodeStrHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity); + if Result then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + Result := (ABucket <> nil) and (FItemIndex < ABucket.Size); + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclUnicodeStrHashSetIterator.Next: UnicodeString; +var + ABucket: TJclUnicodeStrHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := ''; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashSetIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclUnicodeStrHashSetIterator.Previous: UnicodeString; +var + ABucket: TJclUnicodeStrHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < 0) then + FItemIndex := ABucket.Size - 1; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex >= 0) and (FItemIndex < ABucket.Size) then + Break; + if (FItemIndex > 0) and (FItemIndex < ABucket.Size) then + begin + Dec(FItemIndex); + Break; + end; + end; + FItemIndex := -1; + Dec(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := ''; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrHashSetIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclUnicodeStrHashSetIterator.Remove; +begin + +end; + +procedure TJclUnicodeStrHashSetIterator.Reset; +var + ABucket: TJclUnicodeStrHashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + FBucketIndex := 0; + ABucket := nil; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := 0 + else + FItemIndex := -1; + end; + isLast: + begin + FBucketIndex := FOwnHashSet.FCapacity - 1; + ABucket := nil; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := ABucket.Size - 1 + else + FItemIndex := -1; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrHashSetIterator.SetString(const AString: UnicodeString); +begin + raise EJclOperationNotSupportedError.Create; +end; + +{$ENDIF SUPPORTS_UNICODE_STRING} +//=== { TJclSingleHashSet } ==================================================== + +constructor TJclSingleHashSet.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclSingleHashSet.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclSingleHashSet.Add(const AValue: Single): Boolean; +var + Index: Integer; + Bucket: TJclSingleHashSetBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if FAllowDefaultElements or (not ItemsEqual(AValue, 0.0)) then + begin + Index := FHashToRangeFunction(Hash(AValue), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AValue) then + Exit; + end + else + begin + Bucket := TJclSingleHashSetBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size] := AValue; + Inc(Bucket.Size); + Inc(FSize); + Result := True; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashSet.AddAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleHashSet.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclSingleHashSetBucket; + ADest: TJclSingleHashSet; + ACollection: IJclSingleCollection; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclSingleHashSet then + begin + ADest := TJclSingleHashSet(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclSingleHashSetBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + NewBucket.Entries[J] := SelfBucket.Entries[J]; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclSingleCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleHashSet.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclSingleHashSet then + TJclSingleHashSet(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclSingleHashSet.Clear; +var + I, J: Integer; + Bucket: TJclSingleHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + FreeSingle(Bucket.Entries[J]); + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashSet.CollectionEquals(const ACollection: IJclSingleCollection): Boolean; +var + I, J: Integer; + It: IJclSingleIterator; + Bucket: TJclSingleHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if not ItemsEqual(Bucket.Entries[J], It.Next) then + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashSet.Contains(const AValue: Single): Boolean; +var + I: Integer; + Bucket: TJclSingleHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(AValue), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AValue) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashSet.ContainsAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashSet.Extract(const AValue: Single): Boolean; +var + Bucket: TJclSingleHashSetBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(AValue), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AValue) then + begin + Result := True; + Bucket.Entries[I] := 0.0; + if I < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashSet.ExtractAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashSet.First: IJclSingleIterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclSingleHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := 0; + ABucket := nil; + while ABucketIndex < FCapacity do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := 0 + else + AItemIndex := -1; + Result := TJclSingleHashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isFirst); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclSingleHashSet.GetEnumerator: IJclSingleIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +procedure TJclSingleHashSet.Intersect(const ACollection: IJclSingleCollection); +begin + RetainAll(ACollection); +end; + +function TJclSingleHashSet.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclSingleHashSet.Last: IJclSingleIterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclSingleHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := FCapacity - 1; + ABucket := nil; + while ABucketIndex >= 0 do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := ABucket.Size - 1 + else + AItemIndex := -1; + Result := TJclSingleHashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isLast); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleHashSet.Pack; +var + I: Integer; + Bucket: TJclSingleHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashSet.Remove(const AValue: Single): Boolean; +var + Extracted: Single; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeSingle(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashSet.RemoveAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashSet.RetainAll(const ACollection: IJclSingleCollection): Boolean; +var + I, J, NewCapacity: Integer; + Bucket: TJclSingleHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := Bucket.Size - 1 downto 0 do + if not ACollection.Contains(Bucket.Entries[I]) then + begin + Bucket.Entries[J] := FreeSingle(Bucket.Entries[J]); + if J < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, J + 1, J, Bucket.Size - J - 1); + Dec(Bucket.Size); + Dec(FSize); + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleHashSet.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashSet.Size: Integer; +begin + Result := FSize; +end; + +procedure TJclSingleHashSet.Subtract(const ACollection: IJclSingleCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclSingleHashSet.Union(const ACollection: IJclSingleCollection); +begin + AddAll(ACollection); +end; + + +function TJclSingleHashSet.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclSingleHashSet.Create(Size); + AssignPropertiesTo(Result); +end; + +//=== { TJclSingleHashSetIterator } ============================================ + +constructor TJclSingleHashSetIterator.Create(AOwnHashSet: TJclSingleHashSet; + ABucketIndex, AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnHashSet := AOwnHashSet; + FBucketIndex := ABucketIndex; + FItemIndex := AItemIndex; + FStart := AStart; +end; + +function TJclSingleHashSetIterator.Add(const AValue: Single): Boolean; +begin + Result := FOwnHashSet.Add(AValue); +end; + +procedure TJclSingleHashSetIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclSingleHashSetIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclSingleHashSetIterator then + begin + ADest := TJclSingleHashSetIterator(Dest); + ADest.FBucketIndex := FBucketIndex; + ADest.FItemIndex := FItemIndex; + ADest.FOwnHashSet := FOwnHashSet; + ADest.FStart := FStart; + end; +end; + +function TJclSingleHashSetIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclSingleHashSetIterator.Create(FOwnHashSet, FBucketIndex, FItemIndex, Valid, FStart); +end; + +procedure TJclSingleHashSetIterator.Extract; +var + AValue: Single; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + AValue := GetValue; + Valid := False; + FOwnHashSet.Extract(AValue); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashSetIterator.GetValue: Single; +var + ABucket: TJclSingleHashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := 0.0; + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashSetIterator.HasNext: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclSingleHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex < (ABucket.Size - 1)) or + ((not SkipCurrent) and (AItemIndex < ABucket.Size)) then + Exit; + end; + AItemIndex := 0; + Inc(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashSetIterator.HasPrevious: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclSingleHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex > 0) or + ((not SkipCurrent) and (AItemIndex >= 0)) then + Exit; + end; + AItemIndex := MaxInt; + Dec(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashSetIterator.Insert(const AValue: Single): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclSingleHashSetIterator.IteratorEquals(const AIterator: IJclSingleIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclSingleHashSetIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclSingleHashSetIterator then + begin + ItrObj := TJclSingleHashSetIterator(Obj); + Result := (FOwnHashSet = ItrObj.FOwnHashSet) and (FBucketIndex = ItrObj.FBucketIndex) and (FItemIndex = ItrObj.FItemIndex) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclSingleHashSetIterator.MoveNext: Boolean; +var + ABucket: TJclSingleHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity); + if Result then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + Result := (ABucket <> nil) and (FItemIndex < ABucket.Size); + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclSingleHashSetIterator.Next: Single; +var + ABucket: TJclSingleHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := 0.0; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashSetIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclSingleHashSetIterator.Previous: Single; +var + ABucket: TJclSingleHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < 0) then + FItemIndex := ABucket.Size - 1; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex >= 0) and (FItemIndex < ABucket.Size) then + Break; + if (FItemIndex > 0) and (FItemIndex < ABucket.Size) then + begin + Dec(FItemIndex); + Break; + end; + end; + FItemIndex := -1; + Dec(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := 0.0; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleHashSetIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclSingleHashSetIterator.Remove; +begin + +end; + +procedure TJclSingleHashSetIterator.Reset; +var + ABucket: TJclSingleHashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + FBucketIndex := 0; + ABucket := nil; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := 0 + else + FItemIndex := -1; + end; + isLast: + begin + FBucketIndex := FOwnHashSet.FCapacity - 1; + ABucket := nil; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := ABucket.Size - 1 + else + FItemIndex := -1; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleHashSetIterator.SetValue(const AValue: Single); +begin + raise EJclOperationNotSupportedError.Create; +end; +//=== { TJclDoubleHashSet } ==================================================== + +constructor TJclDoubleHashSet.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclDoubleHashSet.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclDoubleHashSet.Add(const AValue: Double): Boolean; +var + Index: Integer; + Bucket: TJclDoubleHashSetBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if FAllowDefaultElements or (not ItemsEqual(AValue, 0.0)) then + begin + Index := FHashToRangeFunction(Hash(AValue), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AValue) then + Exit; + end + else + begin + Bucket := TJclDoubleHashSetBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size] := AValue; + Inc(Bucket.Size); + Inc(FSize); + Result := True; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashSet.AddAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleHashSet.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclDoubleHashSetBucket; + ADest: TJclDoubleHashSet; + ACollection: IJclDoubleCollection; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclDoubleHashSet then + begin + ADest := TJclDoubleHashSet(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclDoubleHashSetBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + NewBucket.Entries[J] := SelfBucket.Entries[J]; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclDoubleCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleHashSet.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclDoubleHashSet then + TJclDoubleHashSet(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclDoubleHashSet.Clear; +var + I, J: Integer; + Bucket: TJclDoubleHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + FreeDouble(Bucket.Entries[J]); + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashSet.CollectionEquals(const ACollection: IJclDoubleCollection): Boolean; +var + I, J: Integer; + It: IJclDoubleIterator; + Bucket: TJclDoubleHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if not ItemsEqual(Bucket.Entries[J], It.Next) then + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashSet.Contains(const AValue: Double): Boolean; +var + I: Integer; + Bucket: TJclDoubleHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(AValue), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AValue) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashSet.ContainsAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashSet.Extract(const AValue: Double): Boolean; +var + Bucket: TJclDoubleHashSetBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(AValue), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AValue) then + begin + Result := True; + Bucket.Entries[I] := 0.0; + if I < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashSet.ExtractAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashSet.First: IJclDoubleIterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclDoubleHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := 0; + ABucket := nil; + while ABucketIndex < FCapacity do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := 0 + else + AItemIndex := -1; + Result := TJclDoubleHashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isFirst); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclDoubleHashSet.GetEnumerator: IJclDoubleIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +procedure TJclDoubleHashSet.Intersect(const ACollection: IJclDoubleCollection); +begin + RetainAll(ACollection); +end; + +function TJclDoubleHashSet.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclDoubleHashSet.Last: IJclDoubleIterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclDoubleHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := FCapacity - 1; + ABucket := nil; + while ABucketIndex >= 0 do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := ABucket.Size - 1 + else + AItemIndex := -1; + Result := TJclDoubleHashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isLast); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleHashSet.Pack; +var + I: Integer; + Bucket: TJclDoubleHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashSet.Remove(const AValue: Double): Boolean; +var + Extracted: Double; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeDouble(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashSet.RemoveAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashSet.RetainAll(const ACollection: IJclDoubleCollection): Boolean; +var + I, J, NewCapacity: Integer; + Bucket: TJclDoubleHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := Bucket.Size - 1 downto 0 do + if not ACollection.Contains(Bucket.Entries[I]) then + begin + Bucket.Entries[J] := FreeDouble(Bucket.Entries[J]); + if J < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, J + 1, J, Bucket.Size - J - 1); + Dec(Bucket.Size); + Dec(FSize); + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleHashSet.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashSet.Size: Integer; +begin + Result := FSize; +end; + +procedure TJclDoubleHashSet.Subtract(const ACollection: IJclDoubleCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclDoubleHashSet.Union(const ACollection: IJclDoubleCollection); +begin + AddAll(ACollection); +end; + + +function TJclDoubleHashSet.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclDoubleHashSet.Create(Size); + AssignPropertiesTo(Result); +end; + +//=== { TJclDoubleHashSetIterator } ============================================ + +constructor TJclDoubleHashSetIterator.Create(AOwnHashSet: TJclDoubleHashSet; + ABucketIndex, AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnHashSet := AOwnHashSet; + FBucketIndex := ABucketIndex; + FItemIndex := AItemIndex; + FStart := AStart; +end; + +function TJclDoubleHashSetIterator.Add(const AValue: Double): Boolean; +begin + Result := FOwnHashSet.Add(AValue); +end; + +procedure TJclDoubleHashSetIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclDoubleHashSetIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclDoubleHashSetIterator then + begin + ADest := TJclDoubleHashSetIterator(Dest); + ADest.FBucketIndex := FBucketIndex; + ADest.FItemIndex := FItemIndex; + ADest.FOwnHashSet := FOwnHashSet; + ADest.FStart := FStart; + end; +end; + +function TJclDoubleHashSetIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclDoubleHashSetIterator.Create(FOwnHashSet, FBucketIndex, FItemIndex, Valid, FStart); +end; + +procedure TJclDoubleHashSetIterator.Extract; +var + AValue: Double; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + AValue := GetValue; + Valid := False; + FOwnHashSet.Extract(AValue); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashSetIterator.GetValue: Double; +var + ABucket: TJclDoubleHashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := 0.0; + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashSetIterator.HasNext: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclDoubleHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex < (ABucket.Size - 1)) or + ((not SkipCurrent) and (AItemIndex < ABucket.Size)) then + Exit; + end; + AItemIndex := 0; + Inc(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashSetIterator.HasPrevious: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclDoubleHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex > 0) or + ((not SkipCurrent) and (AItemIndex >= 0)) then + Exit; + end; + AItemIndex := MaxInt; + Dec(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashSetIterator.Insert(const AValue: Double): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclDoubleHashSetIterator.IteratorEquals(const AIterator: IJclDoubleIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclDoubleHashSetIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclDoubleHashSetIterator then + begin + ItrObj := TJclDoubleHashSetIterator(Obj); + Result := (FOwnHashSet = ItrObj.FOwnHashSet) and (FBucketIndex = ItrObj.FBucketIndex) and (FItemIndex = ItrObj.FItemIndex) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclDoubleHashSetIterator.MoveNext: Boolean; +var + ABucket: TJclDoubleHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity); + if Result then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + Result := (ABucket <> nil) and (FItemIndex < ABucket.Size); + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclDoubleHashSetIterator.Next: Double; +var + ABucket: TJclDoubleHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := 0.0; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashSetIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclDoubleHashSetIterator.Previous: Double; +var + ABucket: TJclDoubleHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < 0) then + FItemIndex := ABucket.Size - 1; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex >= 0) and (FItemIndex < ABucket.Size) then + Break; + if (FItemIndex > 0) and (FItemIndex < ABucket.Size) then + begin + Dec(FItemIndex); + Break; + end; + end; + FItemIndex := -1; + Dec(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := 0.0; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleHashSetIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclDoubleHashSetIterator.Remove; +begin + +end; + +procedure TJclDoubleHashSetIterator.Reset; +var + ABucket: TJclDoubleHashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + FBucketIndex := 0; + ABucket := nil; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := 0 + else + FItemIndex := -1; + end; + isLast: + begin + FBucketIndex := FOwnHashSet.FCapacity - 1; + ABucket := nil; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := ABucket.Size - 1 + else + FItemIndex := -1; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleHashSetIterator.SetValue(const AValue: Double); +begin + raise EJclOperationNotSupportedError.Create; +end; +//=== { TJclExtendedHashSet } ==================================================== + +constructor TJclExtendedHashSet.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclExtendedHashSet.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclExtendedHashSet.Add(const AValue: Extended): Boolean; +var + Index: Integer; + Bucket: TJclExtendedHashSetBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if FAllowDefaultElements or (not ItemsEqual(AValue, 0.0)) then + begin + Index := FHashToRangeFunction(Hash(AValue), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AValue) then + Exit; + end + else + begin + Bucket := TJclExtendedHashSetBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size] := AValue; + Inc(Bucket.Size); + Inc(FSize); + Result := True; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashSet.AddAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedHashSet.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclExtendedHashSetBucket; + ADest: TJclExtendedHashSet; + ACollection: IJclExtendedCollection; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclExtendedHashSet then + begin + ADest := TJclExtendedHashSet(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclExtendedHashSetBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + NewBucket.Entries[J] := SelfBucket.Entries[J]; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclExtendedCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedHashSet.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclExtendedHashSet then + TJclExtendedHashSet(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclExtendedHashSet.Clear; +var + I, J: Integer; + Bucket: TJclExtendedHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + FreeExtended(Bucket.Entries[J]); + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashSet.CollectionEquals(const ACollection: IJclExtendedCollection): Boolean; +var + I, J: Integer; + It: IJclExtendedIterator; + Bucket: TJclExtendedHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if not ItemsEqual(Bucket.Entries[J], It.Next) then + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashSet.Contains(const AValue: Extended): Boolean; +var + I: Integer; + Bucket: TJclExtendedHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(AValue), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AValue) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashSet.ContainsAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashSet.Extract(const AValue: Extended): Boolean; +var + Bucket: TJclExtendedHashSetBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(AValue), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AValue) then + begin + Result := True; + Bucket.Entries[I] := 0.0; + if I < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashSet.ExtractAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashSet.First: IJclExtendedIterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclExtendedHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := 0; + ABucket := nil; + while ABucketIndex < FCapacity do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := 0 + else + AItemIndex := -1; + Result := TJclExtendedHashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isFirst); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclExtendedHashSet.GetEnumerator: IJclExtendedIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +procedure TJclExtendedHashSet.Intersect(const ACollection: IJclExtendedCollection); +begin + RetainAll(ACollection); +end; + +function TJclExtendedHashSet.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclExtendedHashSet.Last: IJclExtendedIterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclExtendedHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := FCapacity - 1; + ABucket := nil; + while ABucketIndex >= 0 do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := ABucket.Size - 1 + else + AItemIndex := -1; + Result := TJclExtendedHashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isLast); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedHashSet.Pack; +var + I: Integer; + Bucket: TJclExtendedHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashSet.Remove(const AValue: Extended): Boolean; +var + Extracted: Extended; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeExtended(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashSet.RemoveAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashSet.RetainAll(const ACollection: IJclExtendedCollection): Boolean; +var + I, J, NewCapacity: Integer; + Bucket: TJclExtendedHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := Bucket.Size - 1 downto 0 do + if not ACollection.Contains(Bucket.Entries[I]) then + begin + Bucket.Entries[J] := FreeExtended(Bucket.Entries[J]); + if J < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, J + 1, J, Bucket.Size - J - 1); + Dec(Bucket.Size); + Dec(FSize); + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedHashSet.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashSet.Size: Integer; +begin + Result := FSize; +end; + +procedure TJclExtendedHashSet.Subtract(const ACollection: IJclExtendedCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclExtendedHashSet.Union(const ACollection: IJclExtendedCollection); +begin + AddAll(ACollection); +end; + + +function TJclExtendedHashSet.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclExtendedHashSet.Create(Size); + AssignPropertiesTo(Result); +end; + +//=== { TJclExtendedHashSetIterator } ============================================ + +constructor TJclExtendedHashSetIterator.Create(AOwnHashSet: TJclExtendedHashSet; + ABucketIndex, AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnHashSet := AOwnHashSet; + FBucketIndex := ABucketIndex; + FItemIndex := AItemIndex; + FStart := AStart; +end; + +function TJclExtendedHashSetIterator.Add(const AValue: Extended): Boolean; +begin + Result := FOwnHashSet.Add(AValue); +end; + +procedure TJclExtendedHashSetIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclExtendedHashSetIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclExtendedHashSetIterator then + begin + ADest := TJclExtendedHashSetIterator(Dest); + ADest.FBucketIndex := FBucketIndex; + ADest.FItemIndex := FItemIndex; + ADest.FOwnHashSet := FOwnHashSet; + ADest.FStart := FStart; + end; +end; + +function TJclExtendedHashSetIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclExtendedHashSetIterator.Create(FOwnHashSet, FBucketIndex, FItemIndex, Valid, FStart); +end; + +procedure TJclExtendedHashSetIterator.Extract; +var + AValue: Extended; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + AValue := GetValue; + Valid := False; + FOwnHashSet.Extract(AValue); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashSetIterator.GetValue: Extended; +var + ABucket: TJclExtendedHashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := 0.0; + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashSetIterator.HasNext: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclExtendedHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex < (ABucket.Size - 1)) or + ((not SkipCurrent) and (AItemIndex < ABucket.Size)) then + Exit; + end; + AItemIndex := 0; + Inc(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashSetIterator.HasPrevious: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclExtendedHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex > 0) or + ((not SkipCurrent) and (AItemIndex >= 0)) then + Exit; + end; + AItemIndex := MaxInt; + Dec(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashSetIterator.Insert(const AValue: Extended): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclExtendedHashSetIterator.IteratorEquals(const AIterator: IJclExtendedIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclExtendedHashSetIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclExtendedHashSetIterator then + begin + ItrObj := TJclExtendedHashSetIterator(Obj); + Result := (FOwnHashSet = ItrObj.FOwnHashSet) and (FBucketIndex = ItrObj.FBucketIndex) and (FItemIndex = ItrObj.FItemIndex) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclExtendedHashSetIterator.MoveNext: Boolean; +var + ABucket: TJclExtendedHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity); + if Result then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + Result := (ABucket <> nil) and (FItemIndex < ABucket.Size); + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclExtendedHashSetIterator.Next: Extended; +var + ABucket: TJclExtendedHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := 0.0; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashSetIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclExtendedHashSetIterator.Previous: Extended; +var + ABucket: TJclExtendedHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < 0) then + FItemIndex := ABucket.Size - 1; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex >= 0) and (FItemIndex < ABucket.Size) then + Break; + if (FItemIndex > 0) and (FItemIndex < ABucket.Size) then + begin + Dec(FItemIndex); + Break; + end; + end; + FItemIndex := -1; + Dec(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := 0.0; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedHashSetIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclExtendedHashSetIterator.Remove; +begin + +end; + +procedure TJclExtendedHashSetIterator.Reset; +var + ABucket: TJclExtendedHashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + FBucketIndex := 0; + ABucket := nil; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := 0 + else + FItemIndex := -1; + end; + isLast: + begin + FBucketIndex := FOwnHashSet.FCapacity - 1; + ABucket := nil; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := ABucket.Size - 1 + else + FItemIndex := -1; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedHashSetIterator.SetValue(const AValue: Extended); +begin + raise EJclOperationNotSupportedError.Create; +end; +//=== { TJclIntegerHashSet } ==================================================== + +constructor TJclIntegerHashSet.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclIntegerHashSet.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclIntegerHashSet.Add(AValue: Integer): Boolean; +var + Index: Integer; + Bucket: TJclIntegerHashSetBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if FAllowDefaultElements or (not ItemsEqual(AValue, 0)) then + begin + Index := FHashToRangeFunction(Hash(AValue), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AValue) then + Exit; + end + else + begin + Bucket := TJclIntegerHashSetBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size] := AValue; + Inc(Bucket.Size); + Inc(FSize); + Result := True; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashSet.AddAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerHashSet.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclIntegerHashSetBucket; + ADest: TJclIntegerHashSet; + ACollection: IJclIntegerCollection; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclIntegerHashSet then + begin + ADest := TJclIntegerHashSet(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclIntegerHashSetBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + NewBucket.Entries[J] := SelfBucket.Entries[J]; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclIntegerCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerHashSet.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclIntegerHashSet then + TJclIntegerHashSet(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclIntegerHashSet.Clear; +var + I, J: Integer; + Bucket: TJclIntegerHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + FreeInteger(Bucket.Entries[J]); + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashSet.CollectionEquals(const ACollection: IJclIntegerCollection): Boolean; +var + I, J: Integer; + It: IJclIntegerIterator; + Bucket: TJclIntegerHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if not ItemsEqual(Bucket.Entries[J], It.Next) then + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashSet.Contains(AValue: Integer): Boolean; +var + I: Integer; + Bucket: TJclIntegerHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(AValue), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AValue) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashSet.ContainsAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashSet.Extract(AValue: Integer): Boolean; +var + Bucket: TJclIntegerHashSetBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(AValue), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AValue) then + begin + Result := True; + Bucket.Entries[I] := 0; + if I < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashSet.ExtractAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashSet.First: IJclIntegerIterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclIntegerHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := 0; + ABucket := nil; + while ABucketIndex < FCapacity do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := 0 + else + AItemIndex := -1; + Result := TJclIntegerHashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isFirst); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclIntegerHashSet.GetEnumerator: IJclIntegerIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +procedure TJclIntegerHashSet.Intersect(const ACollection: IJclIntegerCollection); +begin + RetainAll(ACollection); +end; + +function TJclIntegerHashSet.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntegerHashSet.Last: IJclIntegerIterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclIntegerHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := FCapacity - 1; + ABucket := nil; + while ABucketIndex >= 0 do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := ABucket.Size - 1 + else + AItemIndex := -1; + Result := TJclIntegerHashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isLast); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerHashSet.Pack; +var + I: Integer; + Bucket: TJclIntegerHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashSet.Remove(AValue: Integer): Boolean; +var + Extracted: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeInteger(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashSet.RemoveAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashSet.RetainAll(const ACollection: IJclIntegerCollection): Boolean; +var + I, J, NewCapacity: Integer; + Bucket: TJclIntegerHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := Bucket.Size - 1 downto 0 do + if not ACollection.Contains(Bucket.Entries[I]) then + begin + Bucket.Entries[J] := FreeInteger(Bucket.Entries[J]); + if J < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, J + 1, J, Bucket.Size - J - 1); + Dec(Bucket.Size); + Dec(FSize); + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerHashSet.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashSet.Size: Integer; +begin + Result := FSize; +end; + +procedure TJclIntegerHashSet.Subtract(const ACollection: IJclIntegerCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclIntegerHashSet.Union(const ACollection: IJclIntegerCollection); +begin + AddAll(ACollection); +end; + + +function TJclIntegerHashSet.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntegerHashSet.Create(Size); + AssignPropertiesTo(Result); +end; + +//=== { TJclIntegerHashSetIterator } ============================================ + +constructor TJclIntegerHashSetIterator.Create(AOwnHashSet: TJclIntegerHashSet; + ABucketIndex, AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnHashSet := AOwnHashSet; + FBucketIndex := ABucketIndex; + FItemIndex := AItemIndex; + FStart := AStart; +end; + +function TJclIntegerHashSetIterator.Add(AValue: Integer): Boolean; +begin + Result := FOwnHashSet.Add(AValue); +end; + +procedure TJclIntegerHashSetIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclIntegerHashSetIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclIntegerHashSetIterator then + begin + ADest := TJclIntegerHashSetIterator(Dest); + ADest.FBucketIndex := FBucketIndex; + ADest.FItemIndex := FItemIndex; + ADest.FOwnHashSet := FOwnHashSet; + ADest.FStart := FStart; + end; +end; + +function TJclIntegerHashSetIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclIntegerHashSetIterator.Create(FOwnHashSet, FBucketIndex, FItemIndex, Valid, FStart); +end; + +procedure TJclIntegerHashSetIterator.Extract; +var + AValue: Integer; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + AValue := GetValue; + Valid := False; + FOwnHashSet.Extract(AValue); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashSetIterator.GetValue: Integer; +var + ABucket: TJclIntegerHashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := 0; + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashSetIterator.HasNext: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclIntegerHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex < (ABucket.Size - 1)) or + ((not SkipCurrent) and (AItemIndex < ABucket.Size)) then + Exit; + end; + AItemIndex := 0; + Inc(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashSetIterator.HasPrevious: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclIntegerHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex > 0) or + ((not SkipCurrent) and (AItemIndex >= 0)) then + Exit; + end; + AItemIndex := MaxInt; + Dec(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashSetIterator.Insert(AValue: Integer): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclIntegerHashSetIterator.IteratorEquals(const AIterator: IJclIntegerIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclIntegerHashSetIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclIntegerHashSetIterator then + begin + ItrObj := TJclIntegerHashSetIterator(Obj); + Result := (FOwnHashSet = ItrObj.FOwnHashSet) and (FBucketIndex = ItrObj.FBucketIndex) and (FItemIndex = ItrObj.FItemIndex) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclIntegerHashSetIterator.MoveNext: Boolean; +var + ABucket: TJclIntegerHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity); + if Result then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + Result := (ABucket <> nil) and (FItemIndex < ABucket.Size); + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclIntegerHashSetIterator.Next: Integer; +var + ABucket: TJclIntegerHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := 0; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashSetIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclIntegerHashSetIterator.Previous: Integer; +var + ABucket: TJclIntegerHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < 0) then + FItemIndex := ABucket.Size - 1; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex >= 0) and (FItemIndex < ABucket.Size) then + Break; + if (FItemIndex > 0) and (FItemIndex < ABucket.Size) then + begin + Dec(FItemIndex); + Break; + end; + end; + FItemIndex := -1; + Dec(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := 0; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerHashSetIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclIntegerHashSetIterator.Remove; +begin + +end; + +procedure TJclIntegerHashSetIterator.Reset; +var + ABucket: TJclIntegerHashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + FBucketIndex := 0; + ABucket := nil; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := 0 + else + FItemIndex := -1; + end; + isLast: + begin + FBucketIndex := FOwnHashSet.FCapacity - 1; + ABucket := nil; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := ABucket.Size - 1 + else + FItemIndex := -1; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerHashSetIterator.SetValue(AValue: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; +//=== { TJclCardinalHashSet } ==================================================== + +constructor TJclCardinalHashSet.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclCardinalHashSet.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclCardinalHashSet.Add(AValue: Cardinal): Boolean; +var + Index: Integer; + Bucket: TJclCardinalHashSetBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if FAllowDefaultElements or (not ItemsEqual(AValue, 0)) then + begin + Index := FHashToRangeFunction(Hash(AValue), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AValue) then + Exit; + end + else + begin + Bucket := TJclCardinalHashSetBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size] := AValue; + Inc(Bucket.Size); + Inc(FSize); + Result := True; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashSet.AddAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalHashSet.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclCardinalHashSetBucket; + ADest: TJclCardinalHashSet; + ACollection: IJclCardinalCollection; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclCardinalHashSet then + begin + ADest := TJclCardinalHashSet(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclCardinalHashSetBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + NewBucket.Entries[J] := SelfBucket.Entries[J]; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclCardinalCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalHashSet.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclCardinalHashSet then + TJclCardinalHashSet(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclCardinalHashSet.Clear; +var + I, J: Integer; + Bucket: TJclCardinalHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + FreeCardinal(Bucket.Entries[J]); + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashSet.CollectionEquals(const ACollection: IJclCardinalCollection): Boolean; +var + I, J: Integer; + It: IJclCardinalIterator; + Bucket: TJclCardinalHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if not ItemsEqual(Bucket.Entries[J], It.Next) then + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashSet.Contains(AValue: Cardinal): Boolean; +var + I: Integer; + Bucket: TJclCardinalHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(AValue), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AValue) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashSet.ContainsAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashSet.Extract(AValue: Cardinal): Boolean; +var + Bucket: TJclCardinalHashSetBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(AValue), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AValue) then + begin + Result := True; + Bucket.Entries[I] := 0; + if I < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashSet.ExtractAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashSet.First: IJclCardinalIterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclCardinalHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := 0; + ABucket := nil; + while ABucketIndex < FCapacity do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := 0 + else + AItemIndex := -1; + Result := TJclCardinalHashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isFirst); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclCardinalHashSet.GetEnumerator: IJclCardinalIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +procedure TJclCardinalHashSet.Intersect(const ACollection: IJclCardinalCollection); +begin + RetainAll(ACollection); +end; + +function TJclCardinalHashSet.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclCardinalHashSet.Last: IJclCardinalIterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclCardinalHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := FCapacity - 1; + ABucket := nil; + while ABucketIndex >= 0 do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := ABucket.Size - 1 + else + AItemIndex := -1; + Result := TJclCardinalHashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isLast); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalHashSet.Pack; +var + I: Integer; + Bucket: TJclCardinalHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashSet.Remove(AValue: Cardinal): Boolean; +var + Extracted: Cardinal; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeCardinal(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashSet.RemoveAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashSet.RetainAll(const ACollection: IJclCardinalCollection): Boolean; +var + I, J, NewCapacity: Integer; + Bucket: TJclCardinalHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := Bucket.Size - 1 downto 0 do + if not ACollection.Contains(Bucket.Entries[I]) then + begin + Bucket.Entries[J] := FreeCardinal(Bucket.Entries[J]); + if J < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, J + 1, J, Bucket.Size - J - 1); + Dec(Bucket.Size); + Dec(FSize); + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalHashSet.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashSet.Size: Integer; +begin + Result := FSize; +end; + +procedure TJclCardinalHashSet.Subtract(const ACollection: IJclCardinalCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclCardinalHashSet.Union(const ACollection: IJclCardinalCollection); +begin + AddAll(ACollection); +end; + + +function TJclCardinalHashSet.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclCardinalHashSet.Create(Size); + AssignPropertiesTo(Result); +end; + +//=== { TJclCardinalHashSetIterator } ============================================ + +constructor TJclCardinalHashSetIterator.Create(AOwnHashSet: TJclCardinalHashSet; + ABucketIndex, AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnHashSet := AOwnHashSet; + FBucketIndex := ABucketIndex; + FItemIndex := AItemIndex; + FStart := AStart; +end; + +function TJclCardinalHashSetIterator.Add(AValue: Cardinal): Boolean; +begin + Result := FOwnHashSet.Add(AValue); +end; + +procedure TJclCardinalHashSetIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclCardinalHashSetIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclCardinalHashSetIterator then + begin + ADest := TJclCardinalHashSetIterator(Dest); + ADest.FBucketIndex := FBucketIndex; + ADest.FItemIndex := FItemIndex; + ADest.FOwnHashSet := FOwnHashSet; + ADest.FStart := FStart; + end; +end; + +function TJclCardinalHashSetIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclCardinalHashSetIterator.Create(FOwnHashSet, FBucketIndex, FItemIndex, Valid, FStart); +end; + +procedure TJclCardinalHashSetIterator.Extract; +var + AValue: Cardinal; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + AValue := GetValue; + Valid := False; + FOwnHashSet.Extract(AValue); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashSetIterator.GetValue: Cardinal; +var + ABucket: TJclCardinalHashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := 0; + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashSetIterator.HasNext: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclCardinalHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex < (ABucket.Size - 1)) or + ((not SkipCurrent) and (AItemIndex < ABucket.Size)) then + Exit; + end; + AItemIndex := 0; + Inc(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashSetIterator.HasPrevious: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclCardinalHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex > 0) or + ((not SkipCurrent) and (AItemIndex >= 0)) then + Exit; + end; + AItemIndex := MaxInt; + Dec(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashSetIterator.Insert(AValue: Cardinal): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclCardinalHashSetIterator.IteratorEquals(const AIterator: IJclCardinalIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclCardinalHashSetIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclCardinalHashSetIterator then + begin + ItrObj := TJclCardinalHashSetIterator(Obj); + Result := (FOwnHashSet = ItrObj.FOwnHashSet) and (FBucketIndex = ItrObj.FBucketIndex) and (FItemIndex = ItrObj.FItemIndex) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclCardinalHashSetIterator.MoveNext: Boolean; +var + ABucket: TJclCardinalHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity); + if Result then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + Result := (ABucket <> nil) and (FItemIndex < ABucket.Size); + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclCardinalHashSetIterator.Next: Cardinal; +var + ABucket: TJclCardinalHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := 0; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashSetIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclCardinalHashSetIterator.Previous: Cardinal; +var + ABucket: TJclCardinalHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < 0) then + FItemIndex := ABucket.Size - 1; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex >= 0) and (FItemIndex < ABucket.Size) then + Break; + if (FItemIndex > 0) and (FItemIndex < ABucket.Size) then + begin + Dec(FItemIndex); + Break; + end; + end; + FItemIndex := -1; + Dec(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := 0; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalHashSetIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclCardinalHashSetIterator.Remove; +begin + +end; + +procedure TJclCardinalHashSetIterator.Reset; +var + ABucket: TJclCardinalHashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + FBucketIndex := 0; + ABucket := nil; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := 0 + else + FItemIndex := -1; + end; + isLast: + begin + FBucketIndex := FOwnHashSet.FCapacity - 1; + ABucket := nil; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := ABucket.Size - 1 + else + FItemIndex := -1; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalHashSetIterator.SetValue(AValue: Cardinal); +begin + raise EJclOperationNotSupportedError.Create; +end; +//=== { TJclInt64HashSet } ==================================================== + +constructor TJclInt64HashSet.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclInt64HashSet.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclInt64HashSet.Add(const AValue: Int64): Boolean; +var + Index: Integer; + Bucket: TJclInt64HashSetBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if FAllowDefaultElements or (not ItemsEqual(AValue, 0)) then + begin + Index := FHashToRangeFunction(Hash(AValue), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AValue) then + Exit; + end + else + begin + Bucket := TJclInt64HashSetBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size] := AValue; + Inc(Bucket.Size); + Inc(FSize); + Result := True; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashSet.AddAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64HashSet.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclInt64HashSetBucket; + ADest: TJclInt64HashSet; + ACollection: IJclInt64Collection; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclInt64HashSet then + begin + ADest := TJclInt64HashSet(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclInt64HashSetBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + NewBucket.Entries[J] := SelfBucket.Entries[J]; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclInt64Collection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64HashSet.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclInt64HashSet then + TJclInt64HashSet(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclInt64HashSet.Clear; +var + I, J: Integer; + Bucket: TJclInt64HashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + FreeInt64(Bucket.Entries[J]); + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashSet.CollectionEquals(const ACollection: IJclInt64Collection): Boolean; +var + I, J: Integer; + It: IJclInt64Iterator; + Bucket: TJclInt64HashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if not ItemsEqual(Bucket.Entries[J], It.Next) then + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashSet.Contains(const AValue: Int64): Boolean; +var + I: Integer; + Bucket: TJclInt64HashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(AValue), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AValue) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashSet.ContainsAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashSet.Extract(const AValue: Int64): Boolean; +var + Bucket: TJclInt64HashSetBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(AValue), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AValue) then + begin + Result := True; + Bucket.Entries[I] := 0; + if I < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashSet.ExtractAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashSet.First: IJclInt64Iterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclInt64HashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := 0; + ABucket := nil; + while ABucketIndex < FCapacity do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := 0 + else + AItemIndex := -1; + Result := TJclInt64HashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isFirst); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclInt64HashSet.GetEnumerator: IJclInt64Iterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +procedure TJclInt64HashSet.Intersect(const ACollection: IJclInt64Collection); +begin + RetainAll(ACollection); +end; + +function TJclInt64HashSet.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclInt64HashSet.Last: IJclInt64Iterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclInt64HashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := FCapacity - 1; + ABucket := nil; + while ABucketIndex >= 0 do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := ABucket.Size - 1 + else + AItemIndex := -1; + Result := TJclInt64HashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isLast); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64HashSet.Pack; +var + I: Integer; + Bucket: TJclInt64HashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashSet.Remove(const AValue: Int64): Boolean; +var + Extracted: Int64; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeInt64(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashSet.RemoveAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashSet.RetainAll(const ACollection: IJclInt64Collection): Boolean; +var + I, J, NewCapacity: Integer; + Bucket: TJclInt64HashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := Bucket.Size - 1 downto 0 do + if not ACollection.Contains(Bucket.Entries[I]) then + begin + Bucket.Entries[J] := FreeInt64(Bucket.Entries[J]); + if J < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, J + 1, J, Bucket.Size - J - 1); + Dec(Bucket.Size); + Dec(FSize); + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64HashSet.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashSet.Size: Integer; +begin + Result := FSize; +end; + +procedure TJclInt64HashSet.Subtract(const ACollection: IJclInt64Collection); +begin + RemoveAll(ACollection); +end; + +procedure TJclInt64HashSet.Union(const ACollection: IJclInt64Collection); +begin + AddAll(ACollection); +end; + + +function TJclInt64HashSet.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclInt64HashSet.Create(Size); + AssignPropertiesTo(Result); +end; + +//=== { TJclInt64HashSetIterator } ============================================ + +constructor TJclInt64HashSetIterator.Create(AOwnHashSet: TJclInt64HashSet; + ABucketIndex, AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnHashSet := AOwnHashSet; + FBucketIndex := ABucketIndex; + FItemIndex := AItemIndex; + FStart := AStart; +end; + +function TJclInt64HashSetIterator.Add(const AValue: Int64): Boolean; +begin + Result := FOwnHashSet.Add(AValue); +end; + +procedure TJclInt64HashSetIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclInt64HashSetIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclInt64HashSetIterator then + begin + ADest := TJclInt64HashSetIterator(Dest); + ADest.FBucketIndex := FBucketIndex; + ADest.FItemIndex := FItemIndex; + ADest.FOwnHashSet := FOwnHashSet; + ADest.FStart := FStart; + end; +end; + +function TJclInt64HashSetIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclInt64HashSetIterator.Create(FOwnHashSet, FBucketIndex, FItemIndex, Valid, FStart); +end; + +procedure TJclInt64HashSetIterator.Extract; +var + AValue: Int64; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + AValue := GetValue; + Valid := False; + FOwnHashSet.Extract(AValue); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashSetIterator.GetValue: Int64; +var + ABucket: TJclInt64HashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := 0; + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashSetIterator.HasNext: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclInt64HashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex < (ABucket.Size - 1)) or + ((not SkipCurrent) and (AItemIndex < ABucket.Size)) then + Exit; + end; + AItemIndex := 0; + Inc(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashSetIterator.HasPrevious: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclInt64HashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex > 0) or + ((not SkipCurrent) and (AItemIndex >= 0)) then + Exit; + end; + AItemIndex := MaxInt; + Dec(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashSetIterator.Insert(const AValue: Int64): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclInt64HashSetIterator.IteratorEquals(const AIterator: IJclInt64Iterator): Boolean; +var + Obj: TObject; + ItrObj: TJclInt64HashSetIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclInt64HashSetIterator then + begin + ItrObj := TJclInt64HashSetIterator(Obj); + Result := (FOwnHashSet = ItrObj.FOwnHashSet) and (FBucketIndex = ItrObj.FBucketIndex) and (FItemIndex = ItrObj.FItemIndex) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclInt64HashSetIterator.MoveNext: Boolean; +var + ABucket: TJclInt64HashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity); + if Result then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + Result := (ABucket <> nil) and (FItemIndex < ABucket.Size); + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclInt64HashSetIterator.Next: Int64; +var + ABucket: TJclInt64HashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := 0; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashSetIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclInt64HashSetIterator.Previous: Int64; +var + ABucket: TJclInt64HashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < 0) then + FItemIndex := ABucket.Size - 1; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex >= 0) and (FItemIndex < ABucket.Size) then + Break; + if (FItemIndex > 0) and (FItemIndex < ABucket.Size) then + begin + Dec(FItemIndex); + Break; + end; + end; + FItemIndex := -1; + Dec(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := 0; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64HashSetIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclInt64HashSetIterator.Remove; +begin + +end; + +procedure TJclInt64HashSetIterator.Reset; +var + ABucket: TJclInt64HashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + FBucketIndex := 0; + ABucket := nil; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := 0 + else + FItemIndex := -1; + end; + isLast: + begin + FBucketIndex := FOwnHashSet.FCapacity - 1; + ABucket := nil; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := ABucket.Size - 1 + else + FItemIndex := -1; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64HashSetIterator.SetValue(const AValue: Int64); +begin + raise EJclOperationNotSupportedError.Create; +end; +//=== { TJclPtrHashSet } ==================================================== + +constructor TJclPtrHashSet.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclPtrHashSet.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclPtrHashSet.Add(APtr: Pointer): Boolean; +var + Index: Integer; + Bucket: TJclPtrHashSetBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if FAllowDefaultElements or (not ItemsEqual(APtr, nil)) then + begin + Index := FHashToRangeFunction(Hash(APtr), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], APtr) then + Exit; + end + else + begin + Bucket := TJclPtrHashSetBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size] := APtr; + Inc(Bucket.Size); + Inc(FSize); + Result := True; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashSet.AddAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrHashSet.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclPtrHashSetBucket; + ADest: TJclPtrHashSet; + ACollection: IJclPtrCollection; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclPtrHashSet then + begin + ADest := TJclPtrHashSet(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclPtrHashSetBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + NewBucket.Entries[J] := SelfBucket.Entries[J]; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclPtrCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrHashSet.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclPtrHashSet then + TJclPtrHashSet(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclPtrHashSet.Clear; +var + I, J: Integer; + Bucket: TJclPtrHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + FreePointer(Bucket.Entries[J]); + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashSet.CollectionEquals(const ACollection: IJclPtrCollection): Boolean; +var + I, J: Integer; + It: IJclPtrIterator; + Bucket: TJclPtrHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if not ItemsEqual(Bucket.Entries[J], It.Next) then + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashSet.Contains(APtr: Pointer): Boolean; +var + I: Integer; + Bucket: TJclPtrHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(APtr), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], APtr) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashSet.ContainsAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashSet.Extract(APtr: Pointer): Boolean; +var + Bucket: TJclPtrHashSetBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(APtr), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], APtr) then + begin + Result := True; + Bucket.Entries[I] := nil; + if I < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashSet.ExtractAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashSet.First: IJclPtrIterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclPtrHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := 0; + ABucket := nil; + while ABucketIndex < FCapacity do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := 0 + else + AItemIndex := -1; + Result := TJclPtrHashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isFirst); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclPtrHashSet.GetEnumerator: IJclPtrIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +procedure TJclPtrHashSet.Intersect(const ACollection: IJclPtrCollection); +begin + RetainAll(ACollection); +end; + +function TJclPtrHashSet.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclPtrHashSet.Last: IJclPtrIterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclPtrHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := FCapacity - 1; + ABucket := nil; + while ABucketIndex >= 0 do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := ABucket.Size - 1 + else + AItemIndex := -1; + Result := TJclPtrHashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isLast); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrHashSet.Pack; +var + I: Integer; + Bucket: TJclPtrHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashSet.Remove(APtr: Pointer): Boolean; +var + Extracted: Pointer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(APtr); + if Result then + begin + Extracted := APtr; + FreePointer(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashSet.RemoveAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashSet.RetainAll(const ACollection: IJclPtrCollection): Boolean; +var + I, J, NewCapacity: Integer; + Bucket: TJclPtrHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := Bucket.Size - 1 downto 0 do + if not ACollection.Contains(Bucket.Entries[I]) then + begin + Bucket.Entries[J] := FreePointer(Bucket.Entries[J]); + if J < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, J + 1, J, Bucket.Size - J - 1); + Dec(Bucket.Size); + Dec(FSize); + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrHashSet.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashSet.Size: Integer; +begin + Result := FSize; +end; + +procedure TJclPtrHashSet.Subtract(const ACollection: IJclPtrCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclPtrHashSet.Union(const ACollection: IJclPtrCollection); +begin + AddAll(ACollection); +end; + + +function TJclPtrHashSet.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclPtrHashSet.Create(Size); + AssignPropertiesTo(Result); +end; + +//=== { TJclPtrHashSetIterator } ============================================ + +constructor TJclPtrHashSetIterator.Create(AOwnHashSet: TJclPtrHashSet; + ABucketIndex, AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnHashSet := AOwnHashSet; + FBucketIndex := ABucketIndex; + FItemIndex := AItemIndex; + FStart := AStart; +end; + +function TJclPtrHashSetIterator.Add(APtr: Pointer): Boolean; +begin + Result := FOwnHashSet.Add(APtr); +end; + +procedure TJclPtrHashSetIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclPtrHashSetIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclPtrHashSetIterator then + begin + ADest := TJclPtrHashSetIterator(Dest); + ADest.FBucketIndex := FBucketIndex; + ADest.FItemIndex := FItemIndex; + ADest.FOwnHashSet := FOwnHashSet; + ADest.FStart := FStart; + end; +end; + +function TJclPtrHashSetIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPtrHashSetIterator.Create(FOwnHashSet, FBucketIndex, FItemIndex, Valid, FStart); +end; + +procedure TJclPtrHashSetIterator.Extract; +var + APtr: Pointer; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + APtr := GetPointer; + Valid := False; + FOwnHashSet.Extract(APtr); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashSetIterator.GetPointer: Pointer; +var + ABucket: TJclPtrHashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := nil; + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashSetIterator.HasNext: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclPtrHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex < (ABucket.Size - 1)) or + ((not SkipCurrent) and (AItemIndex < ABucket.Size)) then + Exit; + end; + AItemIndex := 0; + Inc(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashSetIterator.HasPrevious: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclPtrHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex > 0) or + ((not SkipCurrent) and (AItemIndex >= 0)) then + Exit; + end; + AItemIndex := MaxInt; + Dec(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashSetIterator.Insert(APtr: Pointer): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclPtrHashSetIterator.IteratorEquals(const AIterator: IJclPtrIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclPtrHashSetIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclPtrHashSetIterator then + begin + ItrObj := TJclPtrHashSetIterator(Obj); + Result := (FOwnHashSet = ItrObj.FOwnHashSet) and (FBucketIndex = ItrObj.FBucketIndex) and (FItemIndex = ItrObj.FItemIndex) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclPtrHashSetIterator.MoveNext: Boolean; +var + ABucket: TJclPtrHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity); + if Result then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + Result := (ABucket <> nil) and (FItemIndex < ABucket.Size); + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclPtrHashSetIterator.Next: Pointer; +var + ABucket: TJclPtrHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := nil; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashSetIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclPtrHashSetIterator.Previous: Pointer; +var + ABucket: TJclPtrHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < 0) then + FItemIndex := ABucket.Size - 1; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex >= 0) and (FItemIndex < ABucket.Size) then + Break; + if (FItemIndex > 0) and (FItemIndex < ABucket.Size) then + begin + Dec(FItemIndex); + Break; + end; + end; + FItemIndex := -1; + Dec(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := nil; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrHashSetIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclPtrHashSetIterator.Remove; +begin + +end; + +procedure TJclPtrHashSetIterator.Reset; +var + ABucket: TJclPtrHashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + FBucketIndex := 0; + ABucket := nil; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := 0 + else + FItemIndex := -1; + end; + isLast: + begin + FBucketIndex := FOwnHashSet.FCapacity - 1; + ABucket := nil; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := ABucket.Size - 1 + else + FItemIndex := -1; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrHashSetIterator.SetPointer(APtr: Pointer); +begin + raise EJclOperationNotSupportedError.Create; +end; +//=== { TJclHashSet } ==================================================== + +constructor TJclHashSet.Create(ACapacity: Integer; AOwnsObjects: Boolean); +begin + inherited Create(AOwnsObjects); + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclHashSet.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclHashSet.Add(AObject: TObject): Boolean; +var + Index: Integer; + Bucket: TJclHashSetBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if FAllowDefaultElements or (not ItemsEqual(AObject, nil)) then + begin + Index := FHashToRangeFunction(Hash(AObject), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AObject) then + Exit; + end + else + begin + Bucket := TJclHashSetBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size] := AObject; + Inc(Bucket.Size); + Inc(FSize); + Result := True; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSet.AddAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclHashSet.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclHashSetBucket; + ADest: TJclHashSet; + ACollection: IJclCollection; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclHashSet then + begin + ADest := TJclHashSet(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclHashSetBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + NewBucket.Entries[J] := SelfBucket.Entries[J]; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclHashSet.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclHashSet then + TJclHashSet(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclHashSet.Clear; +var + I, J: Integer; + Bucket: TJclHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + FreeObject(Bucket.Entries[J]); + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSet.CollectionEquals(const ACollection: IJclCollection): Boolean; +var + I, J: Integer; + It: IJclIterator; + Bucket: TJclHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if not ItemsEqual(Bucket.Entries[J], It.Next) then + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSet.Contains(AObject: TObject): Boolean; +var + I: Integer; + Bucket: TJclHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(AObject), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AObject) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSet.ContainsAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSet.Extract(AObject: TObject): Boolean; +var + Bucket: TJclHashSetBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(AObject), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AObject) then + begin + Result := True; + Bucket.Entries[I] := nil; + if I < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSet.ExtractAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSet.First: IJclIterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := 0; + ABucket := nil; + while ABucketIndex < FCapacity do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := 0 + else + AItemIndex := -1; + Result := TJclHashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isFirst); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclHashSet.GetEnumerator: IJclIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +procedure TJclHashSet.Intersect(const ACollection: IJclCollection); +begin + RetainAll(ACollection); +end; + +function TJclHashSet.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclHashSet.Last: IJclIterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := FCapacity - 1; + ABucket := nil; + while ABucketIndex >= 0 do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := ABucket.Size - 1 + else + AItemIndex := -1; + Result := TJclHashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isLast); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclHashSet.Pack; +var + I: Integer; + Bucket: TJclHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSet.Remove(AObject: TObject): Boolean; +var + Extracted: TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AObject); + if Result then + begin + Extracted := AObject; + FreeObject(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSet.RemoveAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSet.RetainAll(const ACollection: IJclCollection): Boolean; +var + I, J, NewCapacity: Integer; + Bucket: TJclHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := Bucket.Size - 1 downto 0 do + if not ACollection.Contains(Bucket.Entries[I]) then + begin + Bucket.Entries[J] := FreeObject(Bucket.Entries[J]); + if J < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, J + 1, J, Bucket.Size - J - 1); + Dec(Bucket.Size); + Dec(FSize); + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclHashSet.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSet.Size: Integer; +begin + Result := FSize; +end; + +procedure TJclHashSet.Subtract(const ACollection: IJclCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclHashSet.Union(const ACollection: IJclCollection); +begin + AddAll(ACollection); +end; + + +function TJclHashSet.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclHashSet.Create(Size, False); + AssignPropertiesTo(Result); +end; + +//=== { TJclHashSetIterator } ============================================ + +constructor TJclHashSetIterator.Create(AOwnHashSet: TJclHashSet; + ABucketIndex, AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnHashSet := AOwnHashSet; + FBucketIndex := ABucketIndex; + FItemIndex := AItemIndex; + FStart := AStart; +end; + +function TJclHashSetIterator.Add(AObject: TObject): Boolean; +begin + Result := FOwnHashSet.Add(AObject); +end; + +procedure TJclHashSetIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclHashSetIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclHashSetIterator then + begin + ADest := TJclHashSetIterator(Dest); + ADest.FBucketIndex := FBucketIndex; + ADest.FItemIndex := FItemIndex; + ADest.FOwnHashSet := FOwnHashSet; + ADest.FStart := FStart; + end; +end; + +function TJclHashSetIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclHashSetIterator.Create(FOwnHashSet, FBucketIndex, FItemIndex, Valid, FStart); +end; + +procedure TJclHashSetIterator.Extract; +var + AObject: TObject; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + AObject := GetObject; + Valid := False; + FOwnHashSet.Extract(AObject); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSetIterator.GetObject: TObject; +var + ABucket: TJclHashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := nil; + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSetIterator.HasNext: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex < (ABucket.Size - 1)) or + ((not SkipCurrent) and (AItemIndex < ABucket.Size)) then + Exit; + end; + AItemIndex := 0; + Inc(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSetIterator.HasPrevious: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex > 0) or + ((not SkipCurrent) and (AItemIndex >= 0)) then + Exit; + end; + AItemIndex := MaxInt; + Dec(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSetIterator.Insert(AObject: TObject): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclHashSetIterator.IteratorEquals(const AIterator: IJclIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclHashSetIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclHashSetIterator then + begin + ItrObj := TJclHashSetIterator(Obj); + Result := (FOwnHashSet = ItrObj.FOwnHashSet) and (FBucketIndex = ItrObj.FBucketIndex) and (FItemIndex = ItrObj.FItemIndex) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclHashSetIterator.MoveNext: Boolean; +var + ABucket: TJclHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity); + if Result then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + Result := (ABucket <> nil) and (FItemIndex < ABucket.Size); + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclHashSetIterator.Next: TObject; +var + ABucket: TJclHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := nil; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSetIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclHashSetIterator.Previous: TObject; +var + ABucket: TJclHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < 0) then + FItemIndex := ABucket.Size - 1; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex >= 0) and (FItemIndex < ABucket.Size) then + Break; + if (FItemIndex > 0) and (FItemIndex < ABucket.Size) then + begin + Dec(FItemIndex); + Break; + end; + end; + FItemIndex := -1; + Dec(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := nil; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSetIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclHashSetIterator.Remove; +begin + +end; + +procedure TJclHashSetIterator.Reset; +var + ABucket: TJclHashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + FBucketIndex := 0; + ABucket := nil; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := 0 + else + FItemIndex := -1; + end; + isLast: + begin + FBucketIndex := FOwnHashSet.FCapacity - 1; + ABucket := nil; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := ABucket.Size - 1 + else + FItemIndex := -1; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclHashSetIterator.SetObject(AObject: TObject); +begin + raise EJclOperationNotSupportedError.Create; +end; + +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +//=== { TJclHashSetBucket } ================================================= + +procedure TJclHashSetBucket.MoveArray(var List: TDynArray; FromIndex, ToIndex, Count: SizeInt); +var + I: SizeInt; +begin + if FromIndex < ToIndex then + begin + for I := Count - 1 downto 0 do + List[ToIndex + I] := List[FromIndex + I]; + + if (ToIndex - FromIndex) < Count then + // overlapped source and target + for I := 0 to ToIndex - FromIndex - 1 do + List[FromIndex + I] := Default(T) + else + // independent + for I := 0 to Count - 1 do + List[FromIndex + I] := Default(T); + end + else + begin + for I := 0 to Count - 1 do + List[ToIndex + I] := List[FromIndex + I]; + + if (FromIndex - ToIndex) < Count then + // overlapped source and target + for I := Count - FromIndex + ToIndex to Count - 1 do + List[FromIndex + I] := Default(T) + else + // independent + for I := 0 to Count - 1 do + List[FromIndex + I] := Default(T); + end; +end; + +//=== { TJclHashSet } ==================================================== + +constructor TJclHashSet.Create(ACapacity: Integer; AOwnsItems: Boolean); +begin + inherited Create(AOwnsItems); + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor TJclHashSet.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclHashSet.Add(const AItem: T): Boolean; +var + Index: Integer; + Bucket: TJclHashSetBucket; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if FAllowDefaultElements or (not ItemsEqual(AItem, Default(T))) then + begin + Index := FHashToRangeFunction(Hash(AItem), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AItem) then + Exit; + end + else + begin + Bucket := TJclHashSetBucket.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size] := AItem; + Inc(Bucket.Size); + Inc(FSize); + Result := True; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSet.AddAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclHashSet.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: TJclHashSetBucket; + ADest: TJclHashSet; + ACollection: IJclCollection; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + inherited AssignDataTo(Dest); + if Dest is TJclHashSet then + begin + ADest := TJclHashSet(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := TJclHashSetBucket.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + NewBucket.Entries[J] := SelfBucket.Entries[J]; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), IJclCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclHashSet.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclHashSet then + TJclHashSet(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure TJclHashSet.Clear; +var + I, J: Integer; + Bucket: TJclHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + FreeItem(Bucket.Entries[J]); + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSet.CollectionEquals(const ACollection: IJclCollection): Boolean; +var + I, J: Integer; + It: IJclIterator; + Bucket: TJclHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if not ItemsEqual(Bucket.Entries[J], It.Next) then + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSet.Contains(const AItem: T): Boolean; +var + I: Integer; + Bucket: TJclHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(AItem), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AItem) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSet.ContainsAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSet.Extract(const AItem: T): Boolean; +var + Bucket: TJclHashSetBucket; + I, NewCapacity: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(AItem), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], AItem) then + begin + Result := True; + Bucket.Entries[I] := Default(T); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSet.ExtractAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSet.First: IJclIterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := 0; + ABucket := nil; + while ABucketIndex < FCapacity do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := 0 + else + AItemIndex := -1; + Result := TJclHashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isFirst); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclHashSet.GetEnumerator: IJclIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +procedure TJclHashSet.Intersect(const ACollection: IJclCollection); +begin + RetainAll(ACollection); +end; + +function TJclHashSet.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclHashSet.Last: IJclIterator; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclHashSetBucket; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + ABucketIndex := FCapacity - 1; + ABucket := nil; + while ABucketIndex >= 0 do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := ABucket.Size - 1 + else + AItemIndex := -1; + Result := TJclHashSetIterator.Create(Self, ABucketIndex, AItemIndex, False, isLast); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclHashSet.Pack; +var + I: Integer; + Bucket: TJclHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSet.Remove(const AItem: T): Boolean; +var + Extracted: T; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AItem); + if Result then + begin + Extracted := AItem; + FreeItem(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSet.RemoveAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSet.RetainAll(const ACollection: IJclCollection): Boolean; +var + I, J, NewCapacity: Integer; + Bucket: TJclHashSetBucket; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := Bucket.Size - 1 downto 0 do + if not ACollection.Contains(Bucket.Entries[I]) then + begin + Bucket.Entries[J] := FreeItem(Bucket.Entries[J]); + if J < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, J + 1, J, Bucket.Size - J - 1); + Dec(Bucket.Size); + Dec(FSize); + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclHashSet.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSet.Size: Integer; +begin + Result := FSize; +end; + +procedure TJclHashSet.Subtract(const ACollection: IJclCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclHashSet.Union(const ACollection: IJclCollection); +begin + AddAll(ACollection); +end; + +//=== { TJclHashSetIterator } ============================================ + +constructor TJclHashSetIterator.Create(AOwnHashSet: TJclHashSet; + ABucketIndex, AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnHashSet := AOwnHashSet; + FBucketIndex := ABucketIndex; + FItemIndex := AItemIndex; + FStart := AStart; +end; + +function TJclHashSetIterator.Add(const AItem: T): Boolean; +begin + Result := FOwnHashSet.Add(AItem); +end; + +procedure TJclHashSetIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclHashSetIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclHashSetIterator then + begin + ADest := TJclHashSetIterator(Dest); + ADest.FBucketIndex := FBucketIndex; + ADest.FItemIndex := FItemIndex; + ADest.FOwnHashSet := FOwnHashSet; + ADest.FStart := FStart; + end; +end; + +function TJclHashSetIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclHashSetIterator.Create(FOwnHashSet, FBucketIndex, FItemIndex, Valid, FStart); +end; + +procedure TJclHashSetIterator.Extract; +var + AItem: T; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + AItem := GetItem; + Valid := False; + FOwnHashSet.Extract(AItem); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSetIterator.GetItem: T; +var + ABucket: TJclHashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := Default(T); + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSetIterator.HasNext: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex < (ABucket.Size - 1)) or + ((not SkipCurrent) and (AItemIndex < ABucket.Size)) then + Exit; + end; + AItemIndex := 0; + Inc(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSetIterator.HasPrevious: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: TJclHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex > 0) or + ((not SkipCurrent) and (AItemIndex >= 0)) then + Exit; + end; + AItemIndex := MaxInt; + Dec(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSetIterator.Insert(const AItem: T): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function TJclHashSetIterator.IteratorEquals(const AIterator: IJclIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclHashSetIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclHashSetIterator then + begin + ItrObj := TJclHashSetIterator(Obj); + Result := (FOwnHashSet = ItrObj.FOwnHashSet) and (FBucketIndex = ItrObj.FBucketIndex) and (FItemIndex = ItrObj.FItemIndex) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclHashSetIterator.MoveNext: Boolean; +var + ABucket: TJclHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity); + if Result then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + Result := (ABucket <> nil) and (FItemIndex < ABucket.Size); + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclHashSetIterator.Next: T; +var + ABucket: TJclHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := Default(T); + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSetIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclHashSetIterator.Previous: T; +var + ABucket: TJclHashSetBucket; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < 0) then + FItemIndex := ABucket.Size - 1; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex >= 0) and (FItemIndex < ABucket.Size) then + Break; + if (FItemIndex > 0) and (FItemIndex < ABucket.Size) then + begin + Dec(FItemIndex); + Break; + end; + end; + FItemIndex := -1; + Dec(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := Default(T); + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclHashSetIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclHashSetIterator.Remove; +begin + +end; + +procedure TJclHashSetIterator.Reset; +var + ABucket: TJclHashSetBucket; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + FBucketIndex := 0; + ABucket := nil; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := 0 + else + FItemIndex := -1; + end; + isLast: + begin + FBucketIndex := FOwnHashSet.FCapacity - 1; + ABucket := nil; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := ABucket.Size - 1 + else + FItemIndex := -1; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclHashSetIterator.SetItem(const AItem: T); +begin + raise EJclOperationNotSupportedError.Create; +end; + +//=== { TJclHashSetE } ==================================================== + +constructor TJclHashSetE.Create(const AEqualityComparer: IJclEqualityComparer; + const AHashConverter: IJclHashConverter; ACapacity: Integer; AOwnsItems: Boolean); +begin + inherited Create(ACapacity, AOwnsItems); + FEqualityComparer := AEqualityComparer; + FHashConverter := AHashConverter; +end; + +procedure TJclHashSetE.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclHashSetE; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclHashSetE then + begin + ADest := TJclHashSetE(Dest); + ADest.FEqualityComparer := FEqualityComparer; + ADest.FHashConverter := FHashConverter; + end; +end; + +function TJclHashSetE.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclHashSetE.Create(EqualityComparer, HashConverter, FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclHashSetE.ItemsEqual(const A, B: T): Boolean; +begin + if EqualityComparer <> nil then + Result := EqualityComparer.ItemsEqual(A, B) + else + Result := inherited ItemsEqual(A, B); +end; + +function TJclHashSetE.Hash(const AItem: T): Integer; +begin + if HashConverter <> nil then + Result := HashConverter.Hash(AItem) + else + Result := inherited Hash(AItem); +end; + +//=== { TJclHashSetF } ==================================================== + +constructor TJclHashSetF.Create(const AEqualityCompare: TEqualityCompare; + const AHashConvert: THashConvert; ACapacity: Integer; AOwnsItems: Boolean); +begin + inherited Create(ACapacity, AOwnsItems); + SetEqualityCompare(AEqualityCompare); + SetHashConvert(AHashConvert); +end; + +function TJclHashSetF.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclHashSetF.Create(EqualityCompare, HashConvert, FSize, False); + AssignPropertiesTo(Result); +end; + +//=== { TJclHashSetI } ==================================================== + +function TJclHashSetI.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclHashSetI.Create(FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclHashSetI.ItemsEqual(const A, B: T): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + Result := A.Equals(B); +end; + +function TJclHashSetI.Hash(const AItem: T): Integer; +begin + if Assigned(FHashConvert) then + Result := FHashConvert(AItem) + else + Result := AItem.GetHashCode; +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclIDEUtils.pas b/3rdParty/JCL/source/common/JclIDEUtils.pas new file mode 100644 index 00000000..c7883007 --- /dev/null +++ b/3rdParty/JCL/source/common/JclIDEUtils.pas @@ -0,0 +1,5419 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is DelphiInstall.pas. } +{ } +{ The Initial Developer of the Original Code is Petr Vones. Portions created by Petr Vones are } +{ Copyright (C) of Petr Vones. All Rights Reserved. } +{ } +{ Contributor(s): } +{ Andreas Hausladen (ahuser) } +{ Florent Ouchet (outchy) } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) - crossplatform & BCB support } +{ Uwe Schuster (uschuster) } +{ } +{**************************************************************************************************} +{ } +{ Routines for getting information about installed versions of Delphi/C++Builder and performing } +{ basic installation tasks. } +{ } +{ Important notes for C#Builder 1 and Delphi 8: } +{ These products were not shipped with their native compilers, but the toolkit to build design } +{ packages is available in codecentral (http://cc.embarcadero.com): } +{ - "IDE Integration pack for C#Builder 1.0" http://cc.embarcadero.com/Item/21334 } +{ - "IDE Integration pack for Delphi 8" http://cc.embarcadero.com/Item/21333 } +{ It's recommended to extract zip files using the standard pattern of Delphi directories: } +{ - Binary files go to \bin (DCC32.EXE, RLINK32.DLL and lnkdfm7*.dll) } +{ - Compiler files go to \lib (designide.dcp, rtl.dcp, SysInit.dcu, vcl.dcp, vclactnband.dcp, } +{ vcljpg.dcp and vclx.dcp) } +{ - ToolsAPI files go to \source\ToolsAPI (PaletteAPI.pas, PropInspAPI.pas and ToolsAPI.pas) } +{ Don't mix C#Builder 1 files with Delphi 8 and vice-versa otherwise the compilation will fail } +{ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! } +{ !!!!!!!! The DCPPath for these releases have to $(BDS)\lib !!!!!!!!! } +{ !!!!!!!! or the directory where compiler files were extracted !!!!!!!!! } +{ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! } +{ The default BPL output directory for these products is set to $(BDSPROJECTSDIR)\bpl, it may not } +{ exist since the product installers don't create it } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclIDEUtils; + +{$I jcl.inc} +{$I crossplatform.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Winapi.Windows, Winapi.ShlObj, JclHelpUtils, + {$ENDIF MSWINDOWS} + System.Classes, System.SysUtils, System.IniFiles, System.Contnrs, + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Windows, ShlObj, JclHelpUtils, + {$ENDIF MSWINDOWS} + Classes, SysUtils, IniFiles, Contnrs, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclSysUtils, JclCompilerUtils; + +// Various definitions +type + EJclBorRADException = class(EJclError); + + TJclBorRADToolKind = (brDelphi, brCppBuilder, brBorlandDevStudio); + TJclBorRADToolEdition = (deSTD, dePRO, deCSS, deARC); + TJclBorRADToolPath = string; + +const + SupportedDelphiVersions = [5, 6, 7, 8, 9, 10, 11, 12, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 37]; + SupportedBCBVersions = [5, 6, 10, 11, 12, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 37]; + SupportedBDSVersions = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 37]; + + // Object Repository + BorRADToolRepositoryPagesSection = 'Repository Pages'; + + BorRADToolRepositoryDialogsPage = 'Dialogs'; + BorRADToolRepositoryFormsPage = 'Forms'; + BorRADToolRepositoryProjectsPage = 'Projects'; + BorRADToolRepositoryDataModulesPage = 'Data Modules'; + + BorRADToolRepositoryObjectType = 'Type'; + BorRADToolRepositoryFormTemplate = 'FormTemplate'; + BorRADToolRepositoryProjectTemplate = 'ProjectTemplate'; + BorRADToolRepositoryObjectName = 'Name'; + BorRADToolRepositoryObjectPage = 'Page'; + BorRADToolRepositoryObjectIcon = 'Icon'; + BorRADToolRepositoryObjectDescr = 'Description'; + BorRADToolRepositoryObjectAuthor = 'Author'; + BorRADToolRepositoryObjectAncestor = 'Ancestor'; + BorRADToolRepositoryObjectDesigner = 'Designer'; // Delphi 6+ only + BorRADToolRepositoryDesignerDfm = 'dfm'; + BorRADToolRepositoryDesignerXfm = 'xfm'; + BorRADToolRepositoryObjectNewForm = 'DefaultNewForm'; + BorRADToolRepositoryObjectMainForm = 'DefaultMainForm'; + + CompilerExtensionDCP = '.dcp'; + CompilerExtensionBPI = '.bpi'; + CompilerExtensionLIB = '.lib'; + CompilerExtensionTDS = '.tds'; + CompilerExtensionMAP = '.map'; + CompilerExtensionDRC = '.drc'; + CompilerExtensionDEF = '.def'; + SourceExtensionCPP = '.cpp'; + SourceExtensionH = '.h'; + SourceExtensionPAS = '.pas'; + SourceExtensionDFM = '.dfm'; + SourceExtensionXFM = '.xfm'; + SourceDescriptionPAS = 'Pascal source file'; + SourceDescriptionCPP = 'C++ source file'; + + DesignerVCL = 'VCL'; + DesignerCLX = 'CLX'; + + ProjectTypePackage = 'package'; + ProjectTypeLibrary = 'library'; + ProjectTypeProgram = 'program'; + + Personality32Bit = '32 bit'; + Personality64Bit = '64 bit'; + PersonalityDelphi = 'Delphi'; + PersonalityDelphiOSX = 'Delphi for OSX'; + PersonalityDelphiiOSSimulator = 'Delphi for iOSSimulator'; + PersonalityDelphiiOSDevice = 'Delphi for iOS'; + PersonalityDelphiAndroid = 'Delphi for Android'; + PersonalityDelphiLinux = 'Delphi for Linux'; + PersonalityDelphiDotNet = 'Delphi.net'; + PersonalityBCB = 'C++Builder'; + PersonalityCSB = 'C#Builder'; + PersonalityVB = 'Visual Basic'; + PersonalityDesign = 'Design'; + PersonalityUnknown = 'Unknown personality'; + PersonalityBDS = 'Borland Developer Studio'; + + BorRADToolEditionIDs: array [TJclBorRADToolEdition] of PChar = + ('STD', 'PRO', 'CSS', 'ARC'); // 'ARC' is an assumption + + BDSPlatformWin32 = 'Win32'; + BDSPlatformWin64 = 'Win64'; + BDSPlatformWin64x = 'Win64x'; + BDSPlatformOSX32 = 'OSX32'; + BDSPlatformOSX64 = 'OSX64'; + BDSPlatformiOSSimulator = 'iOSSimulator'; + BDSPlatformiOSDevice32 = 'iOSDevice32'; + BDSPlatformiOSDevice64 = 'iOSDevice64'; + BDSPlatformAndroid32 = 'Android32'; + BDSPlatformAndroid64 = 'Android64'; + BDSPlatformLinux64 = 'Linux64'; + +// Installed versions information classes +type + TJclBorPersonality = (bpDelphi32, bpDelphi64, bpDelphiOSX32, bpDelphiOSX64, + bpDelphiAndroid32, bpDelphiAndroid64, bpDelphiiOSDevice32, bpDelphiiOSDevice64, bpDelphiiOSSimulator, + bpDelphiLinux64, bpBCBuilder32, bpBCBuilder64, + bpDelphiNet32, bpDelphiNet64, bpCSBuilder32, bpCSBuilder64, + bpVisualBasic32, bpVisualBasic64, bpDesign, bpUnknown); + + TJclBorPersonalities = set of TJclBorPersonality; + + TJclBorDesigner = (bdVCL, bdCLX); + + TJclBorDesigners = set of TJClBorDesigner; + + TJclBDSPlatform = (bpWin32, bpWin32c, bpWin64, bpWin64x, bpOSX32, bpOSX64, bpAndroid32, bpAndroid64, bpiOSDevice32, + bpiOSDevice64, bpiOSSimulator, bpLinux64); + +const + JclBorPersonalityDescription: array [TJclBorPersonality] of string = + ( + Personality32Bit + ' ' + PersonalityDelphi, + Personality64Bit + ' ' + PersonalityDelphi, + Personality32Bit + ' ' + PersonalityDelphiOSX, + Personality64Bit + ' ' + PersonalityDelphiOSX, + Personality32Bit + ' ' + PersonalityDelphiAndroid, + Personality64Bit + ' ' + PersonalityDelphiAndroid, + Personality32Bit + ' ' + PersonalityDelphiiOSDevice, + Personality64Bit + ' ' + PersonalityDelphiiOSDevice, + Personality32Bit + ' ' + PersonalityDelphiiOSSimulator, + Personality64Bit + ' ' + PersonalityDelphiLinux, + Personality32Bit + ' ' + PersonalityBCB, + Personality64Bit + ' ' + PersonalityBCB, + Personality32Bit + ' ' + PersonalityDelphiDotNet, + Personality64Bit + ' ' + PersonalityDelphiDotNet, + Personality32Bit + ' ' + PersonalityCSB, + Personality64Bit + ' ' + PersonalityCSB, + Personality32Bit + ' ' + PersonalityVB, + Personality64Bit + ' ' + PersonalityVB, + PersonalityDesign, + PersonalityUnknown + ); + + JclBorDesignerDescription: array [TJclBorDesigner] of string = + (DesignerVCL, DesignerCLX); + JclBorDesignerFormExtension: array [TJclBorDesigner] of string = + (SourceExtensionDFM, SourceExtensionXFM); + +type + TJclBorRADToolInstallation = class; + + TJclBorRADToolInstallationObject = class(TInterfacedObject) + private + FInstallation: TJclBorRADToolInstallation; + public + constructor Create(AInstallation: TJclBorRADToolInstallation); + property Installation: TJclBorRADToolInstallation read FInstallation; + end; + + TJclBorRADToolIdeTool = class(TJclBorRADToolInstallationObject) + private + FKey: string; + function GetCount: Integer; + function GetParameters(Index: Integer): string; + function GetPath(Index: Integer): string; + function GetTitle(Index: Integer): string; + function GetWorkingDir(Index: Integer): string; + procedure SetCount(const Value: Integer); + procedure SetParameters(Index: Integer; const Value: string); + procedure SetPath(Index: Integer; const Value: string); + procedure SetTitle(Index: Integer; const Value: string); + procedure SetWorkingDir(Index: Integer; const Value: string); + protected + procedure CheckIndex(Index: Integer); + public + constructor Create(AInstallation: TJclBorRADToolInstallation); + property Count: Integer read GetCount write SetCount; + function IndexOfPath(const Value: string): Integer; + function IndexOfTitle(const Value: string): Integer; + procedure RemoveIndex(const Index: Integer); + property Key: string read FKey; + property Title[Index: Integer]: string read GetTitle write SetTitle; + property Path[Index: Integer]: string read GetPath write SetPath; + property Parameters[Index: Integer]: string read GetParameters write SetParameters; + property WorkingDir[Index: Integer]: string read GetWorkingDir write SetWorkingDir; + end; + + TJclBorRADToolIdePackages = class(TJclBorRADToolInstallationObject) + private + FDisabledPackages32: TStringList; + FDisabledPackages64: TStringList; + FKnownPackages32: TStringList; + FKnownIDEPackages32: TStringList; + FExperts32: TStringList; + FKnownPackages64: TStringList; + FKnownIDEPackages64: TStringList; + FExperts64: TStringList; + function GetCount(x64: Boolean): Integer; + function GetIDECount(x64: Boolean): Integer; + function GetExpertCount(x64: Boolean): Integer; + function GetPackageDescriptions(Index: Integer; x64: Boolean): string; + function GetIDEPackageDescriptions(Index: Integer; x64: Boolean): string; + function GetExpertDescriptions(Index: Integer; x64: Boolean): string; + function GetPackageDisabled(Index: Integer; x64: Boolean): Boolean; + function GetPackageFileNames(Index: Integer; x64: Boolean): string; + function GetIDEPackageFileNames(Index: Integer; x64: Boolean): string; + function GetExpertFileNames(Index: Integer; x64: Boolean): string; + function GetDisabledPackagesKeyName(x64: Boolean): string; + function GetKnownPackagesKeyName(x64: Boolean): string; + function GetKnownIDEPackagesKeyName(x64: Boolean): string; + function GetExpertsKeyName(x64: Boolean): string; + + function GetDisabledPackages(x64: Boolean): TStringList; + function GetExperts(x64: Boolean): TStringList; + function GetKnownIDEPackages(x64: Boolean): TStringList; + function GetKnownPackages(x64: Boolean): TStringList; + protected + function PackageEntryToFileName(const Entry: string): string; + procedure ReadPackages; + procedure RemoveDisabled(const FileName: string; x64: Boolean); + public + constructor Create(AInstallation: TJclBorRADToolInstallation); + destructor Destroy; override; + function AddPackage(const FileName, Description: string; x64: Boolean): Boolean; + function AddIDEPackage(const FileName, Description: string; x64: Boolean): Boolean; + function AddExpert(const FileName, Description: string; x64: Boolean): Boolean; + function RemovePackage(const FileName: string; x64: Boolean): Boolean; + function RemoveIDEPackage(const FileName: string; x64: Boolean): Boolean; + function RemoveExpert(const FileName: string; x64: Boolean): Boolean; + property Count[x64: Boolean]: Integer read GetCount; + property IDECount[x64: Boolean]: Integer read GetIDECount; + property ExpertCount[x64: Boolean]: Integer read GetExpertCount; + property PackageDescriptions[Index: Integer; x64: Boolean]: string read GetPackageDescriptions; + property IDEPackageDescriptions[Index: Integer; x64: Boolean]: string read GetIDEPackageDescriptions; + property ExpertDescriptions[Index: Integer; x64: Boolean]: string read GetExpertDescriptions; + property PackageFileNames[Index: Integer; x64: Boolean]: string read GetPackageFileNames; + property IDEPackageFileNames[Index: Integer; x64: Boolean]: string read GetIDEPackageFileNames; + property ExpertFileNames[Index: Integer; x64: Boolean]: string read GetExpertFileNames; + property PackageDisabled[Index: Integer; x64: Boolean]: Boolean read GetPackageDisabled; + end; + + TJclBorRADToolPalette = class(TJclBorRADToolInstallationObject) + private + FKey: string; + FTabNames: TStringList; + function GetComponentsOnTab(Index: Integer): string; + function GetHiddenComponentsOnTab(Index: Integer): string; + function GetTabNameCount: Integer; + function GetTabNames(Index: Integer): string; + procedure ReadTabNames; + public + constructor Create(AInstallation: TJclBorRADToolInstallation); + destructor Destroy; override; + procedure ComponentsOnTabToStrings(Index: Integer; Strings: TStrings; IncludeUnitName: Boolean = False; + IncludeHiddenComponents: Boolean = True); + function DeleteTabName(const TabName: string): Boolean; + function TabNameExists(const TabName: string): Boolean; + property ComponentsOnTab[Index: Integer]: string read GetComponentsOnTab; + property HiddenComponentsOnTab[Index: Integer]: string read GetHiddenComponentsOnTab; + property Key: string read FKey; + property TabNames[Index: Integer]: string read GetTabNames; + property TabNameCount: Integer read GetTabNameCount; + end; + + TJclBorRADToolRepository = class(TJclBorRADToolInstallationObject) + private + FIniFile: TIniFile; + FFileName: string; + FPages: TStringList; + function GetIniFile: TIniFile; + function GetPages: TStrings; + public + constructor Create(AInstallation: TJclBorRADToolInstallation); + destructor Destroy; override; + procedure AddObject(const FileName, ObjectType, PageName, ObjectName, IconFileName, Description, + Author, Designer: string; const Ancestor: string = ''); + procedure CloseIniFile; + function FindPage(const Name: string; OptionalIndex: Integer): string; + procedure RemoveObjects(const PartialPath, FileName, ObjectType: string); + property FileName: string read FFileName; + property IniFile: TIniFile read GetIniFile; + property Pages: TStrings read GetPages; + end; + + TCommandLineTool = (clAsm, clBcc32, clBcc32c, clBcc64, clBcc64x, clDcc32, clDcc64, clDccOSX32, clDccOSX64, clDcciOSSimulator, + clDcciOS32, clDcciOS64, clDccArm32, clDccArm64, clDccLinux64, clDccIL, clMake, clProj2Mak); + TCommandLineTools = set of TCommandLineTool; + + TJclBorRADToolInstallationClass = class of TJclBorRADToolInstallation; + + TJclBorRADToolInstallation = class(TObject) + private + FConfigData: TCustomIniFile; + FConfigDataLocation: string; + FRootKey: Cardinal; + FGlobals: TStringList; + FRootDir: string; + FBinFolderName: string; + FBCC: TJclBCC32; + FBCC32: TJclBCC32; + FDCC: TJclDCC32; + FDCC32: TJclDCC32; + FBpr2Mak: TJclBpr2Mak; + FMake: IJclCommandLineTool; + FEditionStr: string; + FEdition: TJclBorRADToolEdition; + FEnvironmentVariables: TStringList; + FIdePackages: TJclBorRADToolIdePackages; + FIdeTools: TJclBorRADToolIdeTool; + FInstalledUpdatePack: Integer; + {$IFDEF MSWINDOWS} + FOpenHelp: TJclBorlandOpenHelp; + {$ENDIF MSWINDOWS} + FPalette: TJclBorRADToolPalette; + FRepository: TJclBorRADToolRepository; + FIDEVersionNumber: Integer; // Delphi 7: 7, Delphi 2006: 4, Delphi Delphi 2007: 5, Delphi 2009: 6 + FIDEVersionNumberStr: string; + FIDEPackageVersionNumber: Integer; // Delphi 7: 7, Delphi 2006: 10; Delphi 2007: 11, Delphi 2009: 12, Delphi XE6: 20 + FPackageVersionNumber: Integer; // Delphi 7: 7, Dephi 2006: 10, Delphi 2007: 10 (non-breaking release), Delphi 2009: 12, Delphi XE6: 20 + FDCCVersion: Single; + FMapCreate: Boolean; + {$IFDEF MSWINDOWS} + FJdbgCreate: Boolean; + FJdbgInsert: Boolean; + FMapDelete: Boolean; + {$ENDIF MSWINDOWS} + FCommandLineTools: TCommandLineTools; + FPersonalities: TJclBorPersonalities; + FOutputCallback: TTextHandler; + function GetSupportsLibSuffix: Boolean; + function GetBCC: TJclBCC32; + function GetBCC32: TJclBCC32; + function GetDCC: TJclDCC32; + function GetDCC32: TJclDCC32; + function GetBpr2Mak: TJclBpr2Mak; + function GetMake: IJclCommandLineTool; + function GetDescription: string; + function GetEditionAsText: string; + function GetIdeExeFileName: string; + function GetGlobals: TStrings; + function GetIdeExeBuildNumber: string; + function GetIdePackages: TJclBorRADToolIdePackages; + function GetIsTurboExplorer: Boolean; + function GetLatestUpdatePack: Integer; + function GetPalette: TJclBorRADToolPalette; + function GetRepository: TJclBorRADToolRepository; + function GetUpdateNeeded: Boolean; + function GetDefaultBDSCommonDir: string; + function GetIDEPackageVersionNumberStr: string; + function GetPackageVersionNumberStr: string; + procedure SetBCC(const Value: TJclBCC32); + procedure SetDCC(const Value: TJclDCC32); + protected + function ProcessMapFile(const BinaryFileName: string): Boolean; + + // compilation functions + function CompileDelphiPackage(const PackageName, BPLPath, DCPPath: string): Boolean; overload; virtual; + function CompileDelphiPackage(const PackageName, BPLPath, DCPPath, ExtraOptions: string): Boolean; + overload; virtual; + function CompileDelphiProject(const ProjectName, OutputDir, DcpSearchPath: string): Boolean; virtual; + function CompileBCBPackage(const PackageName, BPLPath, DCPPath: string): Boolean; virtual; + function CompileBCBProject(const ProjectName, OutputDir, DcpSearchPath: string): Boolean; virtual; + + // installation (=compilation+registration) / uninstallation(=unregistration+deletion) functions + function InstallDelphiPackage(const PackageName, BPLPath, DCPPath: string): Boolean; virtual; + function UninstallDelphiPackage(const PackageName, BPLPath, DCPPath: string): Boolean; virtual; + function InstallBCBPackage(const PackageName, BPLPath, DCPPath: string): Boolean; virtual; + function UninstallBCBPackage(const PackageName, BPLPath, DCPPath: string): Boolean; virtual; + function InstallDelphiIdePackage(const PackageName, BPLPath, DCPPath: string): Boolean; virtual; + function UninstallDelphiIdePackage(const PackageName, BPLPath, DCPPath: string): Boolean; virtual; + function InstallBCBIdePackage(const PackageName, BPLPath, DCPPath: string): Boolean; virtual; + function UninstallBCBIdePackage(const PackageName, BPLPath, DCPPath: string): Boolean; virtual; + function InstallDelphiExpert(const ProjectName, OutputDir, DcpSearchPath: string): Boolean; virtual; + function UninstallDelphiExpert(const ProjectName, OutputDir: string): Boolean; virtual; + function InstallBCBExpert(const ProjectName, OutputDir, DcpSearchPath: string): Boolean; virtual; + function UninstallBCBExpert(const ProjectName, OutputDir: string): Boolean; virtual; + + procedure ReadInformation; + //function AddMissingPathItems(var Path: string; const NewPath: string): Boolean; + function RemoveFromPath(var Path: string; const ItemsToRemove: string): Boolean; + function GetDCPOutputPath(APlatform: TJclBDSPlatform): string; virtual; + function GetBPLOutputPath(APlatform: TJclBDSPlatform): string; virtual; + function GetEnvironmentVariables: TStrings; virtual; + function GetVclIncludeDir(APlatform: TJclBDSPlatform): string; virtual; + function GetName: string; virtual; + procedure OutputString(const AText: string); + function OutputFileDelete(const FileName: string): Boolean; + procedure SetOutputCallback(const Value: TTextHandler); virtual; + + function GetDebugDCUPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; virtual; + function GetRawDebugDCUPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; virtual; + procedure SetRawDebugDCUPath(APlatform: TJclBDSPlatform; const Value: TJclBorRADToolPath); virtual; + function GetLibrarySearchPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; virtual; + function GetRawLibrarySearchPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; virtual; + procedure SetRawLibrarySearchPath(APlatform: TJclBDSPlatform; const Value: TJclBorRADToolPath); virtual; + function GetLibraryBrowsingPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; virtual; + function GetRawLibraryBrowsingPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; virtual; + procedure SetRawLibraryBrowsingPath(APlatform: TJclBDSPlatform; const Value: TJclBorRADToolPath); virtual; + + function GetLibFolderName(APlatform: TJclBDSPlatform): string; virtual; + function GetObjFolderName(APlatform: TJclBDSPlatform): string; virtual; + function GetLibDebugFolderName(APlatform: TJclBDSPlatform): string; virtual; + + function GetValid: Boolean; virtual; + function GetIsDcc64: Boolean; virtual; + function GetLongPathBug: Boolean; + function GetCompilerSettingsFormat: TJclCompilerSettingsFormat; + function GetSupportsNoConfig: Boolean; + function GetSupportsPlatform: Boolean; + + procedure CheckPlatform(APlatform: TJclBDSPlatform); + procedure CheckCBuilderPlatform(APlatform: TJclBDSPlatform); + public + constructor Create(const AConfigDataLocation: string; ARootKey: Cardinal = 0); virtual; + + destructor Destroy; override; + class procedure ExtractPaths(const Path: TJclBorRADToolPath; List: TStrings); + class function GetLatestUpdatePackForVersion(Version: Integer): Integer; virtual; + class function PackageSourceFileExtension: string; virtual; + class function ProjectSourceFileExtension: string; virtual; + class function RadToolKind: TJclBorRadToolKind; virtual; + {class} function RadToolName: string; virtual; + function AnyInstanceRunning: Boolean; + function AddToDebugDCUPath(const Path: string; APlatform: TJclBDSPlatform): Boolean; + function AddToLibrarySearchPath(const Path: string; APlatform: TJclBDSPlatform): Boolean; + function AddToLibraryBrowsingPath(const Path: string; APlatform: TJclBDSPlatform): Boolean; + function FindFolderInPath(Folder: string; List: TStrings): Integer; + + class function AdjustPathForWin64X(const Path: string): string; + + // package functions + // install = package compile + registration + // uninstall = unregistration + deletion + function CompilePackage(const PackageName, BPLPath, DCPPath: string): Boolean; overload; virtual; + function CompilePackage(const PackageName, BPLPath, DCPPath, ExtraOptions: string): Boolean; overload; virtual; + function InstallPackage(const PackageName, BPLPath, DCPPath: string): Boolean; virtual; + function UninstallPackage(const PackageName, BPLPath, DCPPath: string): Boolean; virtual; + function InstallIDEPackage(const PackageName, BPLPath, DCPPath: string): Boolean; virtual; + function UninstallIDEPackage(const PackageName, BPLPath, DCPPath: string): Boolean; virtual; + + // project functions + function CompileProject(const ProjectName, OutputDir, DcpSearchPath: string): Boolean; virtual; + // expert functions + // install = project compile + registration + // uninstall = unregistration + deletion + function InstallExpert(const ProjectName, OutputDir, DcpSearchPath: string): Boolean; virtual; + function UninstallExpert(const ProjectName, OutputDir: string): Boolean; virtual; + + // registration/unregistration functions + function RegisterPackage(const BinaryFileName, Description: string): Boolean; overload; virtual; + function RegisterPackage(const PackageName, BPLPath, Description: string): Boolean; overload; virtual; + function UnregisterPackage(const BinaryFileName: string): Boolean; overload; virtual; + function UnregisterPackage(const PackageName, BPLPath: string): Boolean; overload; virtual; + function RegisterIDEPackage(const BinaryFileName, Description: string): Boolean; overload; virtual; + function RegisterIDEPackage(const PackageName, BPLPath, Description: string): Boolean; overload; virtual; + function UnregisterIDEPackage(const BinaryFileName: string): Boolean; overload; virtual; + function UnregisterIDEPackage(const PackageName, BPLPath: string): Boolean; overload; virtual; + function RegisterExpert(const BinaryFileName, Description: string): Boolean; overload; virtual; + function RegisterExpert(const ProjectName, OutputDir, Description: string): Boolean; overload; virtual; + function UnregisterExpert(const BinaryFileName: string): Boolean; overload; virtual; + function UnregisterExpert(const ProjectName, OutputDir: string): Boolean; overload; virtual; + + function GetDefaultProjectsDir: string; virtual; + function GetCommonProjectsDir: string; virtual; + function RemoveFromDebugDCUPath(const Path: string; APlatform: TJclBDSPlatform): Boolean; + function RemoveFromLibrarySearchPath(const Path: string; APlatform: TJclBDSPlatform): Boolean; + function RemoveFromLibraryBrowsingPath(const Path: string; APlatform: TJclBDSPlatform): Boolean; + function SubstitutePath(const Path: string): string; + function SupportsVisualCLX: Boolean; + function SupportsVCL: Boolean; + property LibFolderName[APlatform: TJclBDSPlatform]: string read GetLibFolderName; + property ObjFolderName[APlatform: TJclBDSPlatform]: string read GetObjFolderName; + property LibDebugFolderName[APlatform: TJclBDSPlatform]: string read GetLibDebugFolderName; + // Command line tools + property CommandLineTools: TCommandLineTools read FCommandLineTools; + property BCC: TJclBCC32 read GetBCC write SetBCC; + property BCC32: TJclBCC32 read GetBCC32; + property DCC: TJclDCC32 read GetDCC write SetDCC; + property DCC32: TJclDCC32 read GetDCC32; + property Bpr2Mak: TJclBpr2Mak read GetBpr2Mak; + property Make: IJclCommandLineTool read GetMake; + // Paths + property BinFolderName: string read FBinFolderName; + property BPLOutputPath[APlatform: TJclBDSPlatform]: string read GetBPLOutputPath; + property DebugDCUPath[APlatform: TJclBDSPlatform]: TJclBorRADToolPath read GetDebugDCUPath {$IFDEF KEEP_DEPRECATED}write SetRawDebugDCUPath{$ENDIF}; + property RawDebugDCUPath[APlatform: TJclBDSPlatform]: TJclBorRADToolPath read GetRawDebugDCUPath write SetRawDebugDCUPath; + property DCPOutputPath[APlatform: TJclBDSPlatform]: string read GetDCPOutputPath; + property DefaultProjectsDir: string read GetDefaultProjectsDir; + property CommonProjectsDir: string read GetCommonProjectsDir; + // + property Description: string read GetDescription; + property Edition: TJclBorRADToolEdition read FEdition; + property EditionAsText: string read GetEditionAsText; + property EnvironmentVariables: TStrings read GetEnvironmentVariables; + property IdePackages: TJclBorRADToolIdePackages read GetIdePackages; + property IdeTools: TJclBorRADToolIdeTool read FIdeTools; + property IdeExeBuildNumber: string read GetIdeExeBuildNumber; + property IdeExeFileName: string read GetIdeExeFileName; + property InstalledUpdatePack: Integer read FInstalledUpdatePack; + property LatestUpdatePack: Integer read GetLatestUpdatePack; + property LibrarySearchPath[APlatform: TJclBDSPlatform]: TJclBorRADToolPath read GetLibrarySearchPath {$IFDEF KEEP_DEPRECATED}write SetRawLibrarySearchPath{$ENDIF}; + property RawLibrarySearchPath[APlatform: TJclBDSPlatform]: TJclBorRADToolPath read GetRawLibrarySearchPath write SetRawLibrarySearchPath; + property LibraryBrowsingPath[APlatform: TJclBDSPlatform]: TJclBorRADToolPath read GetLibraryBrowsingPath {$IFDEF KEEP_DEPRECATED}write SetRawLibraryBrowsingPath{$ENDIF}; + property RawLibraryBrowsingPath[APlatform: TJclBDSPlatform]: TJclBorRADToolPath read GetRawLibraryBrowsingPath write SetRawLibraryBrowsingPath; + {$IFDEF MSWINDOWS} + property OpenHelp: TJclBorlandOpenHelp read FOpenHelp; + {$ENDIF MSWINDOWS} + property MapCreate: Boolean read FMapCreate write FMapCreate; + {$IFDEF MSWINDOWS} + property JdbgCreate: Boolean read FJdbgCreate write FJdbgCreate; + property JdbgInsert: Boolean read FJdbgInsert write FJdbgInsert; + property MapDelete: Boolean read FMapDelete write FMapDelete; + {$ENDIF MSWINDOWS} + property ConfigData: TCustomIniFile read FConfigData; + property ConfigDataLocation: string read FConfigDataLocation; + property Globals: TStrings read GetGlobals; + property Name: string read GetName; + property Palette: TJclBorRADToolPalette read GetPalette; + property Repository: TJclBorRADToolRepository read GetRepository; + property RootDir: string read FRootDir; + property UpdateNeeded: Boolean read GetUpdateNeeded; + property Valid: Boolean read GetValid; + property VclIncludeDir[APlatform: TJclBDSPlatform]: string read GetVclIncludeDir; + property IDEVersionNumber: Integer read FIDEVersionNumber; + property IDEVersionNumberStr: string read FIDEVersionNumberStr; + property VersionNumber: Integer read FIDEVersionNumber; + property VersionNumberStr: string read FIDEVersionNumberStr; + property DCCVersion: Single read FDCCVersion; + property IDEPackageVersionNumber: Integer read FIDEPackageVersionNumber; + property IDEPackageVersionNumberStr: string read GetIDEPackageVersionNumberStr; + property PackageVersionNumber: Integer read FPackageVersionNumber; + property PackageVersionNumberStr: string read GetPackageVersionNumberStr; + property Personalities: TJclBorPersonalities read FPersonalities; + property SupportsLibSuffix: Boolean read GetSupportsLibSuffix; + property OutputCallback: TTextHandler read FOutputCallback write SetOutputCallback; + property IsTurboExplorer: Boolean read GetIsTurboExplorer; + property RootKey: Cardinal read FRootKey; + property LongPathBug: Boolean read GetLongPathBug; + property CompilerSettingsFormat: TJclCompilerSettingsFormat read GetCompilerSettingsFormat; + property SupportsNoConfig: Boolean read GetSupportsNoConfig; + property SupportsPlatform: Boolean read GetSupportsPlatform; + property IsDcc64: Boolean read GetIsDcc64; + end; + + TJclBCBInstallation = class(TJclBorRADToolInstallation) + protected + function GetEnvironmentVariables: TStrings; override; + public + constructor Create(const AConfigDataLocation: string; ARootKey: Cardinal = 0); override; + destructor Destroy; override; + class function PackageSourceFileExtension: string; override; + class function ProjectSourceFileExtension: string; override; + class function RadToolKind: TJclBorRadToolKind; override; + {class }function RadToolName: string; override; + class function GetLatestUpdatePackForVersion(Version: Integer): Integer; override; + end; + + TJclDelphiInstallation = class(TJclBorRADToolInstallation) + protected + function GetEnvironmentVariables: TStrings; override; + public + constructor Create(const AConfigDataLocation: string; ARootKey: Cardinal = 0); override; + destructor Destroy; override; + class function PackageSourceFileExtension: string; override; + class function ProjectSourceFileExtension: string; override; + class function RadToolKind: TJclBorRadToolKind; override; + class function GetLatestUpdatePackForVersion(Version: Integer): Integer; override; + function InstallPackage(const PackageName, BPLPath, DCPPath: string): Boolean; reintroduce; + {class }function RadToolName: string; override; + end; + + {$IFDEF MSWINDOWS} + TJclBDSInstallation = class(TJclBorRADToolInstallation) + private + FDualPackageInstallation: Boolean; + FHelp2Manager: TJclHelp2Manager; + FDCCIL: TJclDCCIL; + FDCC64: TJclDCC64; + FDCCOSX32: TJclDCCOSX32; + FDCCOSX64: TJclDCCOSX64; + FDCCiOSSimulator: TJclDCCiOSSimulator; + FDCCiOS32: TJclDCCiOS32; + FDCCiOS64: TJclDCCiOS64; + FDCCArm32: TJclDCCArm32; + FDCCArm64: TJclDCCArm64; + FDCCLinux64: TJclDCCLinux64; + FBCC32C: TJclBCC32C; + FBCC64: TJclBCC64; + FBCC64X: TJclBCC64X; + FPdbCreate: Boolean; + procedure SetDualPackageInstallation(const Value: Boolean); + function GetCppPathsKeyName(APlatform: TJclBDSPlatform): string; + function GetCppBrowsingPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; + function GetRawCppBrowsingPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; + function GetCppSearchPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; + function GetRawCppSearchPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; + function GetCppLibraryPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; + function GetRawCppLibraryPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; + function GetCppIncludePath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; + function GetRawCppIncludePath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; + procedure SetRawCppBrowsingPath(APlatform: TJclBDSPlatform; const Value: TJclBorRADToolPath); + procedure SetRawCppSearchPath(APlatform: TJclBDSPlatform; const Value: TJclBorRADToolPath); + procedure SetRawCppLibraryPath(APlatform: TJclBDSPlatform; const Value: TJclBorRADToolPath); + procedure SetRawCppIncludePath(APlatform: TJclBDSPlatform; const Value: TJclBorRADToolPath); + function GetMaxDelphiCLRVersion: string; + function GetDCC64: TJclDCC64; + function GetDCCOSX32: TJclDCCOSX32; + function GetDCCOSX64: TJclDCCOSX64; + function GetDCCiOSSimulator: TJclDCCiOSSimulator; + function GetDCCiOS32: TJclDCCiOS32; + function GetDCCiOS64: TJclDCCiOS64; + function GetDCCArm32: TJclDCCArm32; + function GetDCCArm64: TJclDCCArm64; + function GetDCCLinux64: TJclDCCLinux64; + function GetDCCIL: TJclDCCIL; + function GetBCC32c: TJclBCC32C; + function GetBCC64: TJclBCC64; + function GetBCC64x: TJclBCC64x; + + function GetMsBuildEnvOptionsFileName: string; + function GetMsBuildEnvironmentFileName: string; + function GetMsBuildEnvOption(const OptionName: string; APlatform: TJclBDSPlatform; Raw: Boolean): string; + procedure SetMsBuildEnvOption(const OptionName, Value: string; APlatform: TJclBDSPlatform); + function GetBDSPlatformStr(APlatform: TJclBDSPlatform): string; + function GetBDSPlatformValueNameSuffixStr(APlatform: TJclBDSPlatform): string; + class procedure InterpretSetVariable(const Line: string; Variables: TStrings); + protected + function GetDCPOutputPath(APlatform: TJclBDSPlatform): string; override; + function GetBPLOutputPath(APlatform: TJclBDSPlatform): string; override; + function GetEnvironmentVariables: TStrings; override; + function CompileDelphiPackage(const PackageName, BPLPath, DCPPath, ExtraOptions: string): Boolean; override; + function CompileDelphiProject(const ProjectName, OutputDir: string; + const DcpSearchPath: string): Boolean; override; + function GetVclIncludeDir(APlatform: TJclBDSPlatform): string; override; + function GetName: string; override; + procedure SetOutputCallback(const Value: TTextHandler); override; + function GetLibDebugFolderName(APlatform: TJclBDSPlatform): string; override; + function GetLibFolderName(APlatform: TJclBDSPlatform): string; override; + + function GetDebugDCUPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; override; + function GetRawDebugDCUPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; override; + procedure SetRawDebugDCUPath(APlatform: TJclBDSPlatform; const Value: TJclBorRADToolPath); override; + function GetLibrarySearchPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; override; + function GetRawLibrarySearchPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; override; + procedure SetRawLibrarySearchPath(APlatform: TJclBDSPlatform; const Value: TJclBorRADToolPath); override; + function GetLibraryBrowsingPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; override; + function GetRawLibraryBrowsingPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; override; + procedure SetRawLibraryBrowsingPath(APlatform: TJclBDSPlatform; const Value: TJclBorRADToolPath); override; + + function GetValid: Boolean; override; + function GetIsDcc64: Boolean; override; + public + constructor Create(const AConfigDataLocation: string; ARootKey: Cardinal = 0); override; + destructor Destroy; override; + class function PackageSourceFileExtension: string; override; + class function ProjectSourceFileExtension: string; override; + class function RadToolKind: TJclBorRadToolKind; override; + class function GetLatestUpdatePackForVersion(Version: Integer): Integer; override; + function GetDefaultProjectsDir: string; override; + function GetCommonProjectsDir: string; override; + class function GetDefaultProjectsDirectory(const RootDir: string; IDEVersionNumber: Integer): string; + class function GetCommonProjectsDirectory(const RootDir: string; IDEVersionNumber: Integer): string; + class procedure GetRADStudioVars(const RootDir: string; IDEVersionNumber: Integer; Variables: TStrings); + class function GetRADStudioVarsFileName(const RootDir: string; IDEVersionNumber: Integer): TFileName; + {class }function RadToolName: string; overload; override; + class function RadToolName(IDEVersionNumber: Integer): string; reintroduce; overload; + + function AddToCppSearchPath(const Path: string; APlatform: TJclBDSPlatform): Boolean; + function AddToCppBrowsingPath(const Path: string; APlatform: TJclBDSPlatform): Boolean; + function AddToCppLibraryPath(const Path: string; APlatform: TJclBDSPlatform): Boolean; + function AddToCppIncludePath(const Path: string; APlatform: TJclBDSPlatform): Boolean; + function RemoveFromCppSearchPath(const Path: string; APlatform: TJclBDSPlatform): Boolean; + function RemoveFromCppBrowsingPath(const Path: string; APlatform: TJclBDSPlatform): Boolean; + function RemoveFromCppLibraryPath(const Path: string; APlatform: TJclBDSPlatform): Boolean; + function RemoveFromCppIncludePath(const Path: string; APlatform: TJclBDSPlatform): Boolean; + + property CppSearchPath[APlatform: TJclBDSPlatform]: TJclBorRADToolPath read GetCppSearchPath {$IFDEF KEEP_DEPRECATED}write SetRawCppSearchPath{$ENDIF}; + property RawCppSearchPath[APlatform: TJclBDSPlatform]: TJclBorRADToolPath read GetRawCppSearchPath write SetRawCppSearchPath; + property CppBrowsingPath[APlatform: TJclBDSPlatform]: TJclBorRADToolPath read GetCppBrowsingPath {$IFDEF KEEP_DEPRECATED}write SetRawCppBrowsingPath{$ENDIF}; + property RawCppBrowsingPath[APlatform: TJclBDSPlatform]: TJclBorRADToolPath read GetRawCppBrowsingPath write SetRawCppBrowsingPath; + // Only exists in BDS 5 and upper + property CppLibraryPath[APlatform: TJclBDSPlatform]: TJclBorRADToolPath read GetCppLibraryPath {$IFDEF KEEP_DEPRECATED}write SetRawCppLibraryPath{$ENDIF}; + property RawCppLibraryPath[APlatform: TJclBDSPlatform]: TJclBorRADToolPath read GetRawCppLibraryPath write SetRawCppLibraryPath; + property CppIncludePath[APlatform: TJclBDSPlatform]: TJclBorRADToolPath read GetCppIncludePath {$IFDEF KEEP_DEPRECATED}write SetRawCppIncludePath{$ENDIF}; + property RawCppIncludePath[APlatform: TJclBDSPlatform]: TJclBorRADToolPath read GetRawCppIncludePath write SetRawCppIncludePath; + + function RegisterPackage(const BinaryFileName, Description: string): Boolean; override; + function UnregisterPackage(const BinaryFileName: string): Boolean; override; + function CleanPackageCache(const BinaryFileName: string): Boolean; + + function CompileDelphiDotNetProject(const ProjectName, OutputDir: string; PEFormat: TJclBDSPlatform = bpWin32; + const ExtraOptions: string = ''): Boolean; + + property DualPackageInstallation: Boolean read FDualPackageInstallation write SetDualPackageInstallation; + property Help2Manager: TJclHelp2Manager read FHelp2Manager; + property DCC64: TJclDCC64 read GetDCC64; + property DCCOSX32: TJclDCCOSX32 read GetDCCOSX32; + property DCCOSX64: TJclDCCOSX64 read GetDCCOSX64; + property DCCiOSSimulator: TJclDCCiOSSimulator read GetDCCiOSSimulator; + property DCCiOS32: TJclDCCiOS32 read GetDCCiOS32; + property DCCiOS64: TJclDCCiOS64 read GetDCCiOS64; + property DCCArm32: TJclDCCArm32 read GetDCCArm32; + property DCCArm64: TJclDCCArm64 read GetDCCArm64; + property DCCLinux64: TJclDCCLinux64 read GetDCCLinux64; + property BCC32C: TJclBCC32C read GetBCC32C; + property BCC64: TJclBCC64 read GetBCC64; + property BCC64X: TJclBCC64X read GetBCC64X; + property DCCIL: TJclDCCIL read GetDCCIL; + property MaxDelphiCLRVersion: string read GetMaxDelphiCLRVersion; + property PdbCreate: Boolean read FPdbCreate write FPdbCreate; + end; + {$ENDIF MSWINDOWS} + + TTraverseMethod = function(Installation: TJclBorRADToolInstallation): Boolean of object; + + TJclBorRADToolInstallations = class(TObject) + private + FList: TObjectList; + function GetBDSInstallationFromVersion(VersionNumber: Integer): TJclBorRADToolInstallation; + function GetBDSVersionInstalled(VersionNumber: Integer): Boolean; + function GetCount: Integer; + function GetInstallations(Index: Integer): TJclBorRADToolInstallation; + function GetBCBVersionInstalled(VersionNumber: Integer): Boolean; + function GetDelphiVersionInstalled(VersionNumber: Integer): Boolean; + function GetBCBInstallationFromVersion(VersionNumber: Integer): TJclBorRADToolInstallation; + function GetDelphiInstallationFromVersion(VersionNumber: Integer): TJclBorRADToolInstallation; + protected + procedure ReadInstallations; + public + constructor Create; + destructor Destroy; override; + function AnyInstanceRunning: Boolean; + function AnyUpdatePackNeeded(var Text: string): Boolean; + function Iterate(TraverseMethod: TTraverseMethod): Boolean; + property Count: Integer read GetCount; + property Installations[Index: Integer]: TJclBorRADToolInstallation read GetInstallations; default; + property BCBInstallationFromVersion[VersionNumber: Integer]: TJclBorRADToolInstallation + read GetBCBInstallationFromVersion; + property DelphiInstallationFromVersion[VersionNumber: Integer]: TJclBorRADToolInstallation + read GetDelphiInstallationFromVersion; + property BDSInstallationFromVersion[VersionNumber: Integer]: TJclBorRADToolInstallation + read GetBDSInstallationFromVersion; + property BCBVersionInstalled[VersionNumber: Integer]: Boolean read GetBCBVersionInstalled; + property DelphiVersionInstalled[VersionNumber: Integer]: Boolean read GetDelphiVersionInstalled; + property BDSVersionInstalled[VersionNumber: Integer]: Boolean read GetBDSVersionInstalled; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysConst, + {$IFDEF MSWINDOWS} + System.Win.Registry, + JclRegistry, + JclDebug, + {$ENDIF MSWINDOWS} + {$ELSE ~HAS_UNITSCOPE} + SysConst, + {$IFDEF MSWINDOWS} + Registry, + JclRegistry, + JclDebug, + {$ENDIF MSWINDOWS} + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + JclFileUtils, JclLogic, JclDevToolsResources, + JclAnsiStrings, JclWideStrings, JclStrings, + JclSysInfo, JclMsBuild, JclSimpleXml; + +// Internal + +{$IFDEF MSWINDOWS} +type + TBDSVersionInfo = record + Name: PResStringRec; + VersionStr: string; + DCCVersion: Single; + IDEVersion: Integer; + IDEPkgVersion: Integer; + PkgVersion: Integer; + CoreIdeVersion: string; + Supported: Boolean; + end; + PBDSVersionInfo = ^TBDSVersionInfo; +{$ENDIF MSWINDOWS} + +const + {$IFDEF MSWINDOWS} + BCBKeyName = '\SOFTWARE\Borland\C++Builder'; + BDSKeyName = '\SOFTWARE\Borland\BDS'; + CDSKeyName = '\SOFTWARE\CodeGear\BDS'; + EDSKeyName = '\SOFTWARE\Embarcadero\BDS'; + DelphiKeyName = '\SOFTWARE\Borland\Delphi'; + + RADStudioDirName = 'RAD Studio'; + RADStudio14UpDirName = 'Embarcadero\Studio'; + + BDSVersions: array [0..22] of TBDSVersionInfo = ( + ( + Name: @RsCSharpName; + VersionStr: '1.0'; + DCCVersion: 0.0; + IDEVersion: 1; + IDEPkgVersion: 1; + PkgVersion: 1; + CoreIdeVersion: '71'; + Supported: True), + ( + Name: @RsDelphiName; + VersionStr: '8'; + DCCVersion: 15.0; // Delphi 8 used the Delphi 7 compiler + IDEVersion: 2; + IDEPkgVersion: 8; + PkgVersion: 7; + CoreIdeVersion: '71'; + Supported: True), + ( + Name: @RsDelphiName; + VersionStr: '2005'; + DCCVersion: 17.0; + IDEVersion: 3; + IDEPkgVersion: 9; + PkgVersion: 9; + CoreIdeVersion: '90'; + Supported: True), + ( + Name: @RsBDSName; + VersionStr: '2006'; + DCCVersion: 18.0; + IDEVersion: 4; + IDEPkgVersion: 10; + PkgVersion: 10; + CoreIdeVersion: '100'; + Supported: True), + ( + Name: @RsRSName; + VersionStr: '2007'; + DCCVersion: 18.5; + IDEVersion: 5; + IDEPkgVersion: 11; // Delphi 2007 IDE is 11 but runtime are 10 + PkgVersion: 10; + CoreIdeVersion: '100'; + Supported: True), + ( + Name: @RsRSName; + VersionStr: '2009'; + DCCVersion: 20.0; // Delphi.NET 2009 is 19.0 + IDEVersion: 6; + IDEPkgVersion: 12; + PkgVersion: 12; + CoreIdeVersion: '120'; + Supported: True), + ( + Name: @RsRSName; + VersionStr: '2010'; + DCCVersion: 21.0; + IDEVersion: 7; + IDEPkgVersion: 14; + PkgVersion: 14; + CoreIdeVersion: '140'; + Supported: True), + ( + Name: @RsRSName; + VersionStr: 'XE'; + DCCVersion: 22.0; + IDEVersion: 8; + IDEPkgVersion: 15; + PkgVersion: 15; + CoreIdeVersion: '150'; + Supported: True), + ( + Name: @RsRSName; + VersionStr: 'XE2'; + DCCVersion: 23.0; + IDEVersion: 9; + IDEPkgVersion: 16; + PkgVersion: 16; + CoreIdeVersion: '160'; + Supported: True), + ( + Name: @RsRSName; + VersionStr: 'XE3'; + DCCVersion: 24.0; + IDEVersion: 10; + IDEPkgVersion: 17; + PkgVersion: 17; + CoreIdeVersion: '170'; + Supported: True), + ( + Name: @RsRSName; + VersionStr: 'XE4'; + DCCVersion: 25.0; + IDEVersion: 11; + IDEPkgVersion: 18; + PkgVersion: 18; + CoreIdeVersion: '180'; + Supported: True), + ( + Name: @RsRSName; + VersionStr: 'XE5'; + DCCVersion: 26.0; + IDEVersion: 12; + IDEPkgVersion: 19; + PkgVersion: 19; + CoreIdeVersion: '190'; + Supported: True), + ( + Name: @RsRSName; + VersionStr: 'XE6'; + DCCVersion: 27.0; + IDEVersion: 14; + IDEPkgVersion: 20; + PkgVersion: 20; + CoreIdeVersion: '200'; + Supported: True), + ( + Name: @RsRSName; + VersionStr: 'XE7'; + DCCVersion: 28.0; + IDEVersion: 15; + IDEPkgVersion: 21; + PkgVersion: 21; + CoreIdeVersion: '210'; + Supported: True), + ( + Name: @RsRSName; + VersionStr: 'XE8'; + DCCVersion: 29.0; + IDEVersion: 16; + IDEPkgVersion: 22; + PkgVersion: 22; + CoreIdeVersion: '220'; + Supported: True), + ( + Name: @RsRSName; + VersionStr: '10'; + DCCVersion: 30.0; + IDEVersion: 17; + IDEPkgVersion: 23; + PkgVersion: 23; + CoreIdeVersion: '230'; + Supported: True), + ( + Name: @RsRSName; + VersionStr: '10.1'; + DCCVersion: 31.0; + IDEVersion: 18; + IDEPkgVersion: 24; + PkgVersion: 24; + CoreIdeVersion: '240'; + Supported: True), + ( + Name: @RsRSName; + VersionStr: '10.2'; + DCCVersion: 32.0; + IDEVersion: 19; + IDEPkgVersion: 25; + PkgVersion: 25; + CoreIdeVersion: '250'; + Supported: True), + ( + Name: @RsRSName; + VersionStr: '10.3'; + DCCVersion: 33.0; + IDEVersion: 20; + IDEPkgVersion: 26; + PkgVersion: 26; + CoreIdeVersion: '260'; + Supported: True), + ( + Name: @RsRSName; + VersionStr: '10.4'; + DCCVersion: 34.0; + IDEVersion: 21; + IDEPkgVersion: 27; + PkgVersion: 27; + CoreIdeVersion: '270'; + Supported: True), + ( + Name: @RsRSName; + VersionStr: '11'; + DCCVersion: 35.0; + IDEVersion: 22; + IDEPkgVersion: 28; + PkgVersion: 28; + CoreIdeVersion: '280'; + Supported: True), + ( + Name: @RsRSName; + VersionStr: '12'; + DCCVersion: 36.0; + IDEVersion: 23; + IDEPkgVersion: 29; + PkgVersion: 29; + CoreIdeVersion: '290'; + Supported: True), + ( + Name: @RsRSName; + VersionStr: '13'; + DCCVersion: 37.0; + IDEVersion: 37; + IDEPkgVersion: 37; + PkgVersion: 37; + CoreIdeVersion: '370'; + Supported: True) + ); + {$ENDIF MSWINDOWS} + + RootDirValueName = 'RootDir'; + + EditionValueName = 'Edition'; + VersionValueName = 'Version'; + + DebuggingKeyName = 'Debugging'; + DebugDCUPathValueName = 'Debug DCUs Path'; + + GlobalsKeyName = 'Globals'; + + LibraryKeyName = 'Library'; + LibrarySearchPathValueName = 'Search Path'; + LibraryBrowsingPathValueName = 'Browsing Path'; + LibraryBPLOutputValueName = 'Package DPL Output'; + LibraryDCPOutputValueName = 'Package DCP Output'; + BDSDebugDCUPathValueName = 'Debug DCU Path'; + + CppPathsKeyName = 'CppPaths'; + CppPathsV5UpperKeyName = 'C++\Paths'; + CppBrowsingPathValueName = 'BrowsingPath'; + CppSearchPathValueName = 'SearchPath'; + CppLibraryPathValueName = 'LibraryPath'; + CppIncludePathValueName = 'IncludePath'; + + TransferKeyName = 'Transfer'; + TransferCountValueName = 'Count'; + TransferPathValueName = 'Path%d'; + TransferParamsValueName = 'Params%d'; + TransferTitleValueName = 'Title%d'; + TransferWorkDirValueName = 'WorkingDir%d'; + + DisabledPackagesBaseKeyName = 'Disabled Packages'; + DisabledPackagesx64keyNameSuffix = ' x64'; + EnvVariablesKeyName = 'Environment Variables'; + EnvVariableBDSValueName = 'BDS'; + EnvVariableBDSPROJDIRValueName = 'BDSPROJECTSDIR'; + EnvVariableBDSCOMDIRValueName = 'BDSCOMMONDIR'; + KnownPackagesBaseKeyName = 'Known Packages'; + KnownIDEPackagesBaseKeyName = 'Known IDE Packages'; + KnownPackagesx64KeyNameSuffix = ' x64'; + ExpertsBaseKeyName = 'Experts'; + Expertsx64KeyNameSuffix = ' x64'; + PackageCacheKeyName = 'Package Cache'; + + PaletteKeyName = 'Palette'; + PaletteHiddenTag = '.Hidden'; + + {$IFDEF MSWINDOWS} + VclIncludeDirName = '%s\Include\Vcl\'; + {$IFDEF BCB} + BorRADToolRepositoryFileName = 'bcb.dro'; + {$ELSE BCB} + BorRADToolRepositoryFileName = 'delphi32.dro'; + {$ENDIF BCB} + {$ENDIF MSWINDOWS} + + // MsBuild options + MsBuildWin32DCPOutputNodeName = 'Win32DCPOutput'; + MsBuildWin32LibraryPathNodeName = 'Win32LibraryPath'; + MsBuildWin32BrowsingPathNodeName = 'Win32BrowsingPath'; + MsBuildWin32DebugDCUPathNodeName = 'Win32DebugDCUPath'; + MsBuildWin32DLLOutputPathNodeName = 'Win32DLLOutputPath'; + MsBuildDelphiDCPOutputNodeName = 'DelphiDCPOutput'; + MsBuildDelphiLibraryPathNodeName = 'DelphiLibraryPath'; + MsBuildDelphiBrowsingPathNodeName = 'DelphiBrowsingPath'; + MsBuildDelphiDebugDCUPathNodeName = 'DelphiDebugDCUPath'; + MsBuildDelphiDLLOutputPathNodeName = 'DelphiDLLOutputPath'; + MsBuildDelphiHPPOutputPathNodeName = 'DelphiHPPOutputPath'; + MsBuildCBuilderBPLOutputPathNodeName = 'CBuilderBPLOutputPath'; + MsBuildCBuilderBrowsingPathNodeName = 'CBuilderBrowsingPath'; + MsBuildCBuilderLibraryPathNodeName = 'CBuilderLibraryPath'; + MsBuildCBuilderIncludePathNodeName = 'CBuilderIncludePath'; + + Clang32Suffix = '_Clang32'; + +{$IFDEF MSWINDOWS} + +type + WideStringArray = array of WideString; + + TLoadResRec = record + EnglishStr: WideStringArray; + ResId: array of Integer; + end; + PLoadResRec = ^TLoadResRec; + +// helper function to find strings in current string table +function LoadResCallBack(hModule: HMODULE; lpszType, lpszName: PChar; + lParam: PLoadResRec): BOOL; stdcall; +var + ResInfo, ResHData, ResSize, ResIndex: Cardinal; + ResData: PWord; + StrLength: Word; + StrIndex, ResOffset, MatchCount, MatchLen: Integer; +begin + Result := True; + MatchCount := 0; + + ResInfo := FindResource(hModule, lpszName, lpszType); + if ResInfo <> 0 then + begin + ResHData := LoadResource(hModule, ResInfo); + if ResHData <> 0 then + begin + ResData := LockResource(ResHData); + if Assigned(ResData) then + begin + ResSize := SizeofResource(hModule, ResInfo) div 2; + ResIndex := 0; + ResOffset := 0; + while ResIndex < ResSize do + begin + StrLength := ResData^; + Inc(ResData); + Inc(ResIndex); + // for each requested strings + for StrIndex := Low(lParam^.EnglishStr) to High(lParam^.EnglishStr) do + begin + MatchLen := Length(lParam^.EnglishStr[StrIndex]); + if (lParam^.ResId[StrIndex] = 0) and (StrLength = MatchLen) + and (StrLICompW(PWideChar(lParam^.EnglishStr[StrIndex]), PWideChar(ResData), MatchLen) = 0) then + begin // http://support.microsoft.com/kb/q196774/ + lParam^.ResId[StrIndex] := (PWord(@lpszName)^ - 1) * 16 + ResOffset; + Inc(MatchCount); + if MatchCount = Length(lParam^.EnglishStr) then + begin + Result := False; + Break; // all requests were translated to ResId + end; + end; + end; + Inc(ResOffset); + Inc(ResData, StrLength); + Inc(ResIndex, StrLength); + end; + end; + end; + end; +end; + +function LoadResStrings(const BaseBinName: string; + const ResEn: array of WideString): WideStringArray; +var + H: HMODULE; + LocaleName: array [0..4] of Char; + FileName: string; + Index, NbRes: Integer; + LoadResRec: TLoadResRec; +begin + NbRes := Length(ResEn); + SetLength(LoadResRec.EnglishStr, NbRes); + SetLength(LoadResRec.ResId, NbRes); + SetLength(Result, NbRes); + + for Index := Low(ResEn) to High(ResEn) do + LoadResRec.EnglishStr[Index] := ResEn[Index]; + + H := LoadLibraryEx(PChar(ChangeFileExt(BaseBinName, BinaryExtensionPackage)), 0, + LOAD_LIBRARY_AS_DATAFILE or DONT_RESOLVE_DLL_REFERENCES); + if H <> 0 then + try + EnumResourceNames(H, RT_STRING, @LoadResCallBack, LPARAM(@LoadResRec)); + finally + FreeLibrary(H); + end; + + FileName := ''; + + ResetMemory(LocaleName, SizeOf(LocaleName)); + GetLocaleInfo(GetThreadLocale, LOCALE_SABBREVLANGNAME, LocaleName, Length(LocaleName)); + if LocaleName[0] <> #0 then + begin + FileName := BaseBinName; + if FileExists(FileName + LocaleName) then + FileName := FileName + LocaleName + else + begin + LocaleName[2] := #0; + if FileExists(FileName + LocaleName) then + FileName := FileName + LocaleName + else + FileName := ''; + end; + end; + + if FileName <> '' then + begin + H := LoadLibraryEx(PChar(FileName), 0, LOAD_LIBRARY_AS_DATAFILE or DONT_RESOLVE_DLL_REFERENCES); + if H <> 0 then + try + for Index := 0 to NbRes - 1 do + begin + SetLength(Result[Index], 1024); + SetLength(Result[Index], + LoadStringW(H, LoadResRec.ResId[Index], PWideChar(Result[Index]), Length(Result[Index]) - 1)); + end; + finally + FreeLibrary(H); + end; + end + else + Result := LoadResRec.EnglishStr; +end; + +function GetBDSVersionByIDEVersion(IDEVersion: Integer): PBDSVersionInfo; +var + BDSVersionIndex: Integer; + BDSVersion: PBDSVersionInfo; +begin + Result := nil; + for BDSVersionIndex := Low(BDSVersions) to High(BDSVersions) do + begin + BDSVersion := @BDSVersions[BDSVersionIndex]; + if IDEVersion = BDSVersion.IDEVersion then + Result := BDSVersion; + end; +end; + +{$ENDIF MSWINDOWS} + +//=== { TJclBorRADToolInstallationObject } =================================== + +constructor TJclBorRADToolInstallationObject.Create(AInstallation: TJclBorRADToolInstallation); +begin + FInstallation := AInstallation; +end; + +//== { TJclBorRADToolIdeTool } =============================================== + +constructor TJclBorRADToolIdeTool.Create(AInstallation: TJclBorRADToolInstallation); +begin + inherited Create(AInstallation); + FKey := TransferKeyName; +end; + +procedure TJclBorRADToolIdeTool.CheckIndex(Index: Integer); +begin + if (Index < 0) or (Index >= Count) then + raise EJclError.CreateRes(@RsEIndexOufOfRange); +end; + +function TJclBorRADToolIdeTool.GetCount: Integer; +begin + Result := Installation.ConfigData.ReadInteger(Key, TransferCountValueName, 0); +end; + +function TJclBorRADToolIdeTool.GetParameters(Index: Integer): string; +begin + CheckIndex(Index); + Result := Installation.ConfigData.ReadString(Key, Format(TransferParamsValueName, [Index]), ''); +end; + +function TJclBorRADToolIdeTool.GetPath(Index: Integer): string; +begin + CheckIndex(Index); + Result := Installation.ConfigData.ReadString(Key, Format(TransferPathValueName, [Index]), ''); +end; + +function TJclBorRADToolIdeTool.GetTitle(Index: Integer): string; +begin + CheckIndex(Index); + Result := Installation.ConfigData.ReadString(Key, Format(TransferTitleValueName, [Index]), ''); +end; + +function TJclBorRADToolIdeTool.GetWorkingDir(Index: Integer): string; +begin + CheckIndex(Index); + Result := Installation.ConfigData.ReadString(Key, Format(TransferWorkDirValueName, [Index]), ''); +end; + +function TJclBorRADToolIdeTool.IndexOfPath(const Value: string): Integer; +var + I: Integer; +begin + Result := -1; + for I := 0 to Count - 1 do + if SamePath(Path[I], Value) then + begin + Result := I; + Break; + end; +end; + +function TJclBorRADToolIdeTool.IndexOfTitle(const Value: string): Integer; +var + I: Integer; +begin + Result := -1; + for I := 0 to Count - 1 do + if Title[I] = Value then + begin + Result := I; + Break; + end; +end; + +procedure TJclBorRADToolIdeTool.RemoveIndex(const Index: Integer); +var + I: Integer; +begin + for I := Index to Count - 2 do + begin + Parameters[I] := Parameters[I + 1]; + Path[I] := Path[I + 1]; + Title[I] := Title[I + 1]; + WorkingDir[Index] := WorkingDir[I + 1]; + end; + Count := Count - 1; +end; + +procedure TJclBorRADToolIdeTool.SetCount(const Value: Integer); +begin + if Value > Count then + Installation.ConfigData.WriteInteger(Key, TransferCountValueName, Value); +end; + +procedure TJclBorRADToolIdeTool.SetParameters(Index: Integer; const Value: string); +begin + CheckIndex(Index); + Installation.ConfigData.WriteString(Key, Format(TransferParamsValueName, [Index]), Value); +end; + +procedure TJclBorRADToolIdeTool.SetPath(Index: Integer; const Value: string); +begin + CheckIndex(Index); + Installation.ConfigData.WriteString(Key, Format(TransferPathValueName, [Index]), Value); +end; + +procedure TJclBorRADToolIdeTool.SetTitle(Index: Integer; const Value: string); +begin + CheckIndex(Index); + Installation.ConfigData.WriteString(Key, Format(TransferTitleValueName, [Index]), Value); +end; + +procedure TJclBorRADToolIdeTool.SetWorkingDir(Index: Integer; const Value: string); +begin + CheckIndex(Index); + Installation.ConfigData.WriteString(Key, Format(TransferWorkDirValueName, [Index]), Value); +end; + +//=== { TJclBorRADToolIdePackages } ========================================== + +constructor TJclBorRADToolIdePackages.Create(AInstallation: TJclBorRADToolInstallation); +begin + inherited Create(AInstallation); + FDisabledPackages32 := TStringList.Create; + FDisabledPackages32.Sorted := True; + FDisabledPackages32.Duplicates := dupIgnore; + FDisabledPackages64 := TStringList.Create; + FDisabledPackages64.Sorted := True; + FDisabledPackages64.Duplicates := dupIgnore; + FKnownPackages32 := TStringList.Create; + FKnownPackages32.Sorted := True; + FKnownPackages32.Duplicates := dupIgnore; + FKnownIDEPackages32 := TStringList.Create; + FKnownIDEPackages32.Sorted := True; + FKnownIDEPackages32.Duplicates := dupIgnore; + FExperts32 := TStringList.Create; + FExperts32.Sorted := True; + FExperts32.Duplicates := dupIgnore; + FKnownPackages64 := TStringList.Create; + FKnownPackages64.Sorted := True; + FKnownPackages64.Duplicates := dupIgnore; + FKnownIDEPackages64 := TStringList.Create; + FKnownIDEPackages64.Sorted := True; + FKnownIDEPackages64.Duplicates := dupIgnore; + FExperts64 := TStringList.Create; + FExperts64.Sorted := True; + FExperts64.Duplicates := dupIgnore; + ReadPackages; +end; + +destructor TJclBorRADToolIdePackages.Destroy; +begin + FreeAndNil(FDisabledPackages32); + FreeAndNil(FDisabledPackages64); + FreeAndNil(FKnownPackages32); + FreeAndNil(FKnownIDEPackages32); + FreeAndNil(FExperts32); + FreeAndNil(FKnownPackages64); + FreeAndNil(FKnownIDEPackages64); + FreeAndNil(FExperts64); + inherited Destroy; +end; + +function TJclBorRADToolIdePackages.AddPackage(const FileName, Description: string; x64: Boolean): Boolean; +begin + Result := True; + RemoveDisabled(FileName, x64); + Installation.ConfigData.WriteString(GetKnownPackagesKeyName(x64), FileName, Description); + ReadPackages; +end; + +function TJclBorRADToolIdePackages.AddExpert(const FileName, Description: string; x64: Boolean): Boolean; +begin + Result := True; + RemoveDisabled(FileName, x64); + Installation.ConfigData.WriteString(GetExpertsKeyName(x64), Description, FileName); + ReadPackages; +end; + +function TJclBorRADToolIdePackages.AddIDEPackage(const FileName, Description: string; x64: Boolean): Boolean; +begin + Result := True; + RemoveDisabled(FileName, x64); + Installation.ConfigData.WriteString(GetKnownIDEPackagesKeyName(x64), FileName, Description); + ReadPackages; +end; + +function TJclBorRADToolIdePackages.GetCount(x64: Boolean): Integer; +begin + Result := GetKnownPackages(x64).Count; +end; + +function TJclBorRADToolIdePackages.GetDisabledPackages( + x64: Boolean): TStringList; +begin + if x64 then + Result := FDisabledPackages64 + else + Result := FDisabledPackages32; +end; + +function TJclBorRADToolIdePackages.GetDisabledPackagesKeyName( + x64: Boolean): string; +begin + Result := DisabledPackagesBaseKeyName + Iff(x64, DisabledPackagesx64KeyNameSuffix, ''); +end; + +function TJclBorRADToolIdePackages.GetExpertCount(x64: Boolean): Integer; +begin + Result := GetExperts(x64).Count; +end; + +function TJclBorRADToolIdePackages.GetExpertDescriptions(Index: Integer; x64: Boolean): string; +begin + Result := GetExperts(x64).Names[Index]; +end; + +function TJclBorRADToolIdePackages.GetExpertFileNames(Index: Integer; x64: Boolean): string; +begin + Result := PackageEntryToFileName(GetExperts(x64).Values[GetExperts(x64).Names[Index]]); +end; + +function TJclBorRADToolIdePackages.GetExperts(x64: Boolean): TStringList; +begin + if x64 then + Result := FExperts64 + else + Result := FExperts32; +end; + +function TJclBorRADToolIdePackages.GetExpertsKeyName(x64: Boolean): string; +begin + Result := ExpertsBaseKeyName + Iff(x64, Expertsx64KeyNameSuffix, ''); +end; + +function TJclBorRADToolIdePackages.GetIDECount(x64: Boolean): Integer; +begin + Result := GetKnownIDEPackages(x64).Count; +end; + +function TJclBorRADToolIdePackages.GetPackageDescriptions(Index: Integer; x64: Boolean): string; +begin + Result := GetKnownPackages(x64).Values[GetKnownPackages(x64).Names[Index]]; +end; + +function TJclBorRADToolIdePackages.GetIDEPackageDescriptions(Index: Integer; x64: Boolean): string; +begin + Result := GetKnownIDEPackages(x64).Values[GetKnownIDEPackages(x64).Names[Index]]; +end; + +function TJclBorRADToolIdePackages.GetPackageDisabled(Index: Integer; x64: Boolean): Boolean; +begin + Result := Boolean(GetKnownPackages(x64).Objects[Index]); +end; + +function TJclBorRADToolIdePackages.GetPackageFileNames(Index: Integer; x64: Boolean): string; +begin + Result := PackageEntryToFileName(GetKnownPackages(x64).Names[Index]); +end; + +function TJclBorRADToolIdePackages.GetIDEPackageFileNames(Index: Integer; x64: Boolean): string; +begin + Result := PackageEntryToFileName(GetKnownIDEPackages(x64).Names[Index]); +end; + +function TJclBorRADToolIdePackages.GetKnownIDEPackages( + x64: Boolean): TStringList; +begin + if x64 then + Result := FKnownIDEPackages64 + else + Result := FKnownIDEPackages32; +end; + +function TJclBorRADToolIdePackages.GetKnownIDEPackagesKeyName(x64: Boolean): string; +begin + Result := KnownIDEPackagesBaseKeyName + Iff(x64, KnownPackagesx64KeyNameSuffix, ''); +end; + +function TJclBorRADToolIdePackages.GetKnownPackages(x64: Boolean): TStringList; +begin + if x64 then + Result := FKnownPackages64 + else + Result := FKnownPackages32; +end; + +function TJclBorRADToolIdePackages.GetKnownPackagesKeyName(x64: Boolean): string; +begin + Result := KnownPackagesBaseKeyName + Iff(x64, KnownPackagesx64KeyNameSuffix, ''); +end; + +function TJclBorRADToolIdePackages.PackageEntryToFileName(const Entry: string): string; +begin + Result := Installation.SubstitutePath(Entry); +end; + +procedure TJclBorRADToolIdePackages.ReadPackages; +var + I: Integer; + + procedure ReadPackageList(const Name: string; List: TStringList); + var + ListIsSorted: Boolean; + begin + ListIsSorted := List.Sorted; + List.Sorted := False; + List.Clear; + Installation.ConfigData.ReadSectionValues(Name, List); + List.Sorted := ListIsSorted; + end; + +begin + if Installation.RadToolKind = brBorlandDevStudio then + ReadPackageList(GetKnownIDEPackagesKeyName(False), FKnownIDEPackages32); + ReadPackageList(GetKnownPackagesKeyName(False), FKnownPackages32); + + ReadPackageList(GetDisabledPackagesKeyName(False), FDisabledPackages32); + ReadPackageList(GetExpertsKeyName(False), FExperts32); + for I := 0 to GetCount(False) - 1 do + if FDisabledPackages32.IndexOfName(FKnownPackages32.Names[I]) <> -1 then + FKnownPackages32.Objects[I] := Pointer(True); + + if Installation.IDEVersionNumber >= 23 then + begin + ReadPackageList(GetKnownIDEPackagesKeyName(True), FKnownIDEPackages64); + ReadPackageList(GetKnownPackagesKeyName(True), FKnownPackages64); + ReadPackageList(GetDisabledPackagesKeyName(True), FDisabledPackages64); + ReadPackageList(GetExpertsKeyName(True), FExperts64); + + for I := 0 to GetCount(True) - 1 do + if FDisabledPackages64.IndexOfName(FKnownPackages64.Names[I]) <> -1 then + FKnownPackages64.Objects[I] := Pointer(True); + end; + +end; + +procedure TJclBorRADToolIdePackages.RemoveDisabled(const FileName: string; x64: Boolean); +var + DisabledPackages: TStringList; + I: Integer; +begin + DisabledPackages := GetDisabledPackages(x64); + for I := 0 to DisabledPackages.Count - 1 do + if SamePath(FileName, PackageEntryToFileName(DisabledPackages.Names[I])) then + begin + Installation.ConfigData.DeleteKey(GetDisabledPackagesKeyName(x64), DisabledPackages.Names[I]); + ReadPackages; + Break; + end; +end; + +function TJclBorRADToolIdePackages.RemoveExpert(const FileName: string; x64: Boolean): Boolean; +var + Experts: TStringList; + I: Integer; + KnownExpertDescription, KnownExpert, KnownExpertFileName: string; +begin + Result := False; + + Experts := GetExperts(x64); + for I := 0 to Experts.Count - 1 do + begin + KnownExpertDescription := Experts.Names[I]; + KnownExpert := Experts.Values[KnownExpertDescription]; + KnownExpertFileName := PackageEntryToFileName(KnownExpert); + if SamePath(FileName, KnownExpertFileName) then + begin + RemoveDisabled(KnownExpertFileName, x64); + Installation.ConfigData.DeleteKey(GetExpertsKeyName(x64), KnownExpertDescription); + ReadPackages; + Result := True; + Break; + end; + end; +end; + +function TJclBorRADToolIdePackages.RemovePackage(const FileName: string; x64: Boolean): Boolean; +var + KnownPackages: TStringList; + I: Integer; + KnownPackage, KnownPackageFileName: string; +begin + Result := False; + + KnownPackages := GetKnownPackages(x64); + for I := 0 to KnownPackages.Count - 1 do + begin + KnownPackage := KnownPackages.Names[I]; + KnownPackageFileName := PackageEntryToFileName(KnownPackage); + if SamePath(FileName, KnownPackageFileName) then + begin + RemoveDisabled(KnownPackageFileName, x64); + Installation.ConfigData.DeleteKey(GetKnownPackagesKeyName(x64), KnownPackage); + ReadPackages; + Result := True; + Break; + end; + end; +end; + +function TJclBorRADToolIdePackages.RemoveIDEPackage(const FileName: string; x64: Boolean): Boolean; +var + KnownIDEPackages: TStringList; + I: Integer; + KnownIDEPackage, KnownIDEPackageFileName: string; +begin + Result := False; + + KnownIDEPackages := GetKnownIDEPackages(x64); + for I := 0 to KnownIDEPackages.Count - 1 do + begin + KnownIDEPackage := KnownIDEPackages.Names[I]; + KnownIDEPackageFileName := PackageEntryToFileName(KnownIDEPackage); + if SamePath(FileName, KnownIDEPackageFileName) then + begin + RemoveDisabled(KnownIDEPackageFileName, x64); + Installation.ConfigData.DeleteKey(GetKnownIDEPackagesKeyName(x64), KnownIDEPackage); + ReadPackages; + Result := True; + Break; + end; + end; +end; + +//=== { TJclBorRADToolPalette } ============================================== + +constructor TJclBorRADToolPalette.Create(AInstallation: TJclBorRADToolInstallation); +begin + inherited Create(AInstallation); + FKey := PaletteKeyName; + FTabNames := TStringList.Create; + FTabNames.Sorted := True; + ReadTabNames; +end; + +destructor TJclBorRADToolPalette.Destroy; +begin + FreeAndNil(FTabNames); + inherited Destroy; +end; + +procedure TJclBorRADToolPalette.ComponentsOnTabToStrings(Index: Integer; Strings: TStrings; + IncludeUnitName: Boolean; IncludeHiddenComponents: Boolean); +var + TempList: TStringList; + + procedure ProcessList(Hidden: Boolean); + var + D, I: Integer; + List, S: string; + begin + if Hidden then + List := HiddenComponentsOnTab[Index] + else + List := ComponentsOnTab[Index]; + List := StrEnsureSuffix(';', List); + while Length(List) > 1 do + begin + D := Pos(';', List); + S := Trim(Copy(List, 1, D - 1)); + if not IncludeUnitName then + Delete(S, 1, Pos('.', S)); + if Hidden then + begin + I := TempList.IndexOf(S); + if I = -1 then + TempList.AddObject(S, Pointer(True)) + else + TempList.Objects[I] := Pointer(True); + end + else + TempList.Add(S); + Delete(List, 1, D); + end; + end; + +begin + TempList := TStringList.Create; + try + TempList.Duplicates := dupError; + ProcessList(False); + TempList.Sorted := True; + if IncludeHiddenComponents then + ProcessList(True); + Strings.AddStrings(TempList); + finally + TempList.Free; + end; +end; + +function TJclBorRADToolPalette.DeleteTabName(const TabName: string): Boolean; +var + I: Integer; +begin + I := FTabNames.IndexOf(TabName); + Result := I >= 0; + if Result then + begin + Installation.ConfigData.DeleteKey(Key, FTabNames[I]); + Installation.ConfigData.DeleteKey(Key, FTabNames[I] + PaletteHiddenTag); + FTabNames.Delete(I); + end; +end; + +function TJclBorRADToolPalette.GetComponentsOnTab(Index: Integer): string; +begin + Result := Installation.ConfigData.ReadString(Key, FTabNames[Index], ''); +end; + +function TJclBorRADToolPalette.GetHiddenComponentsOnTab(Index: Integer): string; +begin + Result := Installation.ConfigData.ReadString(Key, FTabNames[Index] + PaletteHiddenTag, ''); +end; + +function TJclBorRADToolPalette.GetTabNameCount: Integer; +begin + Result := FTabNames.Count; +end; + +function TJclBorRADToolPalette.GetTabNames(Index: Integer): string; +begin + Result := FTabNames[Index]; +end; + +procedure TJclBorRADToolPalette.ReadTabNames; +var + TempList: TStringList; + I: Integer; + S: string; +begin + if Installation.ConfigData.SectionExists(Key) then + begin + TempList := TStringList.Create; + try + Installation.ConfigData.ReadSection(Key, TempList); + for I := 0 to TempList.Count - 1 do + begin + S := TempList[I]; + if Pos(PaletteHiddenTag, S) = 0 then + FTabNames.Add(S); + end; + finally + TempList.Free; + end; + end; +end; + +function TJclBorRADToolPalette.TabNameExists(const TabName: string): Boolean; +begin + Result := FTabNames.IndexOf(TabName) <> -1; +end; + +//=== { TJclBorRADToolRepository } =========================================== + +constructor TJclBorRADToolRepository.Create(AInstallation: TJclBorRADToolInstallation); +begin + inherited Create(AInstallation); + FFileName := AInstallation.BinFolderName + BorRADToolRepositoryFileName; + FPages := TStringList.Create; + IniFile.ReadSection(BorRADToolRepositoryPagesSection, FPages); + CloseIniFile; +end; + +destructor TJclBorRADToolRepository.Destroy; +begin + FreeAndNil(FPages); + FreeAndNil(FIniFile); + inherited Destroy; +end; + +procedure TJclBorRADToolRepository.AddObject(const FileName, ObjectType, PageName, ObjectName, + IconFileName, Description, Author, Designer: string; const Ancestor: string); +var + SectionName: string; +begin + GetIniFile; + SectionName := AnsiUpperCase(PathRemoveExtension(FileName)); + FIniFile.EraseSection(FileName); + FIniFile.EraseSection(SectionName); + FIniFile.WriteString(SectionName, BorRADToolRepositoryObjectType, ObjectType); + FIniFile.WriteString(SectionName, BorRADToolRepositoryObjectName, ObjectName); + FIniFile.WriteString(SectionName, BorRADToolRepositoryObjectPage, PageName); + FIniFile.WriteString(SectionName, BorRADToolRepositoryObjectIcon, IconFileName); + FIniFile.WriteString(SectionName, BorRADToolRepositoryObjectDescr, Description); + FIniFile.WriteString(SectionName, BorRADToolRepositoryObjectAuthor, Author); + if Ancestor <> '' then + FIniFile.WriteString(SectionName, BorRADToolRepositoryObjectAncestor, Ancestor); + if (Installation.RadToolKind = brBorlandDevStudio) or (Installation.VersionNumber >= 6) then + FIniFile.WriteString(SectionName, BorRADToolRepositoryObjectDesigner, Designer); + FIniFile.WriteBool(SectionName, BorRADToolRepositoryObjectNewForm, False); + FIniFile.WriteBool(SectionName, BorRADToolRepositoryObjectMainForm, False); + CloseIniFile; +end; + +procedure TJclBorRADToolRepository.CloseIniFile; +begin + FreeAndNil(FIniFile); +end; + +function TJclBorRADToolRepository.FindPage(const Name: string; OptionalIndex: Integer): string; +var + I: Integer; +begin + I := Pages.IndexOf(Name); + if I >= 0 then + Result := Pages[I] + else + if OptionalIndex < Pages.Count then + Result := Pages[OptionalIndex] + else + Result := ''; +end; + +function TJclBorRADToolRepository.GetIniFile: TIniFile; +begin + if not Assigned(FIniFile) then + FIniFile := TIniFile.Create(FileName); + Result := FIniFile; +end; + +function TJclBorRADToolRepository.GetPages: TStrings; +begin + Result := FPages; +end; + +procedure TJclBorRADToolRepository.RemoveObjects(const PartialPath, FileName, ObjectType: string); +var + Sections: TStringList; + I: Integer; + SectionName, FileNamePart, PathPart, DialogFileName: string; +begin + Sections := TStringList.Create; + try + GetIniFile; + FIniFile.ReadSections(Sections); + for I := 0 to Sections.Count - 1 do + begin + SectionName := Sections[I]; + if FIniFile.ReadString(SectionName, BorRADToolRepositoryObjectType, '') = ObjectType then + begin + FileNamePart := PathExtractFileNameNoExt(SectionName); + PathPart := StrRight(PathAddSeparator(ExtractFilePath(SectionName)), Length(PartialPath)); + DialogFileName := PathExtractFileNameNoExt(FileName); + if StrSame(FileNamePart, DialogFileName) and StrSame(PathPart, PartialPath) then + FIniFile.EraseSection(SectionName); + end; + end; + finally + Sections.Free; + end; +end; + +//=== { TJclBorRADToolInstallation } ========================================= + +constructor TJclBorRADToolInstallation.Create(const AConfigDataLocation: string; ARootKey: Cardinal); +{$IFDEF MSWINDOWS} +var + HelpPrefix: string; +{$ENDIF MSWINDOWS} +begin + inherited Create; + FConfigDataLocation := AConfigDataLocation; + FConfigData := TRegistryIniFile.Create(AConfigDataLocation); + if ARootKey = 0 then + FRootKey := Cardinal(HKCU) + else + FRootKey := ARootKey; + TRegistryIniFile(FConfigData).RegIniFile.Access := TRegistryIniFile(FConfigData).RegIniFile.Access {$IFDEF RTL210_UP}or KEY_WOW64_32KEY{$ENDIF RTL210_UP}; + TRegistryIniFile(FConfigData).RegIniFile.RootKey := RootKey; + TRegistryIniFile(FConfigData).RegIniFile.OpenKey(AConfigDataLocation, True); + FGlobals := TStringList.Create; + ReadInformation; + FIdeTools := TJclBorRADToolIdeTool.Create(Self); + {$IFDEF MSWINDOWS} + case RadToolKind of + brDelphi: + if VersionNumber <= 6 then + HelpPrefix := 'delphi' + IntToStr(VersionNumber) + else + HelpPrefix := 'd' + IntToStr(VersionNumber); + brCppBuilder: + HelpPrefix := 'bcb' + IntToStr(VersionNumber); + else + HelpPrefix := ''; + end; + FOpenHelp := TJclBorlandOpenHelp.Create(RootDir, HelpPrefix); + {$ENDIF ~MSWINDOWS} + FMapCreate := False; + {$IFDEF MSWINDOWS} + FJdbgCreate := False; + FJdbgInsert := False; + FMapDelete := False; + if FileExists(BinFolderName + AsmExeName) then + Include(FCommandLineTools, clAsm); + {$ENDIF ~MSWINDOWS} + if FileExists(BinFolderName + BCC32ExeName) then + Include(FCommandLineTools, clBcc32); + if FileExists(BinFolderName + BCC32CExeName) then + Include(FCommandLineTools, clBcc32c); + if FileExists(BinFolderName + BCC64ExeName) then + Include(FCommandLineTools, clBcc64); + if FileExists(PathAddSeparator(PathRemoveSeparator(BinFolderName) + '64') + BCC64XExeName) then + Include(FCommandLineTools, clBcc64x); + if FileExists(BinFolderName + DCC32ExeName) then + Include(FCommandLineTools, clDcc32); + if FileExists(BinFolderName + DCC64ExeName) then + Include(FCommandLineTools, clDcc64); + if FileExists(BinFolderName + DCCOSX32ExeName) then + Include(FCommandLineTools, clDccOSX32); + if FileExists(BinFolderName + DCCOSX64ExeName) then + Include(FCommandLineTools, clDccOSX64); + if FileExists(BinFolderName + DCCiOSSimulatorExeName) then + Include(FCommandLineTools, clDcciOSSimulator); + if FileExists(BinFolderName + DCCiOS32ExeName) then + Include(FCommandLineTools, clDcciOS32); + if FileExists(BinFolderName + DCCiOS64ExeName) then + Include(FCommandLineTools, clDcciOS64); + if FileExists(BinFolderName + DCCArm32ExeName) then + Include(FCommandLineTools, clDccArm32); + if FileExists(BinFolderName + DCCArm64ExeName) then + Include(FCommandLineTools, clDccArm64); + if FileExists(BinFolderName + DCCLinux64ExeName) then + Include(FCommandLineTools, clDccLinux64); + {$IFDEF MSWINDOWS} + if FileExists(BinFolderName + DCCILExeName) then + Include(FCommandLineTools, clDccIL); + {$ENDIF ~MSWINDOWS} + if FileExists(BinFolderName + MakeExeName) then + Include(FCommandLineTools, clMake); + if FileExists(BinFolderName + Bpr2MakExeName) then + Include(FCommandLineTools, clProj2Mak); +end; + +destructor TJclBorRADToolInstallation.Destroy; +begin + FreeAndNil(FRepository); + FreeAndNil(FDCC32); + FreeAndNil(FBCC32); + FreeAndNil(FBpr2Mak); + FreeAndNil(FIdePackages); + FreeAndNil(FIdeTools); + {$IFDEF MSWINDOWS} + FreeAndNil(FOpenHelp); + {$ENDIF MSWINDOWS} + FreeAndNil(FPalette); + FreeAndNil(FGlobals); + FreeAndNil(FEnvironmentVariables); + FreeAndNil(FConfigData); + inherited Destroy; +end; + +function TJclBorRADToolInstallation.AddToDebugDCUPath(const Path: string; APlatform: TJclBDSPlatform): Boolean; +var + TempRawDebugDCUPath: TJclBorRADToolPath; +begin + CheckPlatform(APlatform); + + if Path <> '' then + begin + TempRawDebugDCUPath := RawDebugDCUPath[APlatform]; + PathListIncludeItems(TempRawDebugDCUPath, Path); + Result := True; + RawDebugDCUPath[APlatform] := TempRawDebugDCUPath; + end + else + Result := False; +end; + +function TJclBorRADToolInstallation.AddToLibrarySearchPath(const Path: string; APlatform: TJclBDSPlatform): Boolean; +var + TempRawLibraryPath: TJclBorRADToolPath; +begin + CheckPlatform(APlatform); + + if Path <> '' then + begin + TempRawLibraryPath := RawLibrarySearchPath[APlatform]; + PathListIncludeItems(TempRawLibraryPath, Path); + Result := True; + RawLibrarySearchPath[APlatform] := TempRawLibraryPath; + end + else + Result := False; +end; + +class function TJclBorRADToolInstallation.AdjustPathForWin64X( + const Path: string): string; +begin + Result := StringReplace(Path, '\win64', '\win64x', [rfIgnoreCase]); +end; + +function TJclBorRADToolInstallation.AddToLibraryBrowsingPath(const Path: string; APlatform: TJclBDSPlatform): Boolean; +var + TempRawLibraryPath: TJclBorRADToolPath; +begin + CheckPlatform(APlatform); + + if Path <> '' then + begin + TempRawLibraryPath := RawLibraryBrowsingPath[APlatform]; + PathListIncludeItems(TempRawLibraryPath, Path); + Result := True; + RawLibraryBrowsingPath[APlatform] := TempRawLibraryPath; + + case APlatform of + bpWin32: + if clBcc32c in CommandLineTools then + Result := Result and AddToLibraryBrowsingPath(Path, bpWin32c); + bpWin64: + if clBcc64x in CommandLineTools then + Result := Result and AddToLibraryBrowsingPath(AdjustPathForWin64X(Path), bpWin64x); + end; + end + else + Result := False; +end; + +function TJclBorRADToolInstallation.AnyInstanceRunning: Boolean; +var + Processes: TStringList; + I: Integer; +begin + Result := False; + Processes := TStringList.Create; + try + if RunningProcessesList(Processes) then + begin + for I := 0 to Processes.Count - 1 do + if AnsiSameText(IdeExeFileName, Processes[I]) then + begin + Result := True; + Break; + end; + end; + finally + Processes.Free; + end; +end; + +class procedure TJclBorRADToolInstallation.ExtractPaths(const Path: TJclBorRADToolPath; List: TStrings); +begin + StrToStrings(Path, PathSep, List); +end; + +procedure TJclBorRADToolInstallation.CheckCBuilderPlatform(APlatform: TJclBDSPlatform); +begin + if ((APlatform = bpWin32) and not (bpBCBuilder32 in Personalities)) or + ((APlatform = bpWin64) and not (bpBCBuilder64 in Personalities)) or + ((APlatform = bpWin64x) and not (bpBCBuilder64 in Personalities)) then + raise EJclBorRADException.CreateRes(@RsEPlatformNotValid); +end; + +procedure TJclBorRADToolInstallation.CheckPlatform(APlatform: TJclBDSPlatform); +begin + if ((APlatform = bpWin32) and ([bpDelphi32,bpBCBuilder32] * Personalities = [])) or + ((APlatform = bpWin32c) and ([bpBCBuilder32] * Personalities = [])) or + ((APlatform = bpWin64) and ([bpDelphi64,bpBCBuilder64] * Personalities = [])) or + ((APlatform = bpWin64x) and ([bpBCBuilder64] * Personalities = [])) or + ((APlatform = bpOSX32) and ([bpDelphiOSX32] * Personalities = [])) or + ((APlatform = bpOSX64) and ([bpDelphiOSX64] * Personalities = [])) or + ((APlatform = bpiOSSimulator) and ([bpDelphiiOSSimulator] * Personalities = [])) or + ((APlatform = bpiOSDevice32) and ([bpDelphiiOSDevice32] * Personalities = [])) or + ((APlatform = bpiOSDevice64) and ([bpDelphiiOSDevice64] * Personalities = [])) or + ((APlatform = bpAndroid32) and ([bpDelphiAndroid32] * Personalities = [])) or + ((APlatform = bpAndroid64) and ([bpDelphiAndroid64] * Personalities = [])) or + ((APlatform = bpLinux64) and ([bpDelphiLinux64] * Personalities = [])) then + raise EJclBorRADException.CreateRes(@RsEPlatformNotValid); +end; + +function TJclBorRADToolInstallation.CompileBCBPackage(const PackageName, BPLPath, DCPPath: string): Boolean; +var + SaveDir, PackagePath, MakeFileName: string; +begin + OutputString(Format(LoadResString(@RsCompilingPackage), [PackageName])); + + if not IsBCBPackage(PackageName) then + raise EJclBorRADException.CreateResFmt(@RsENotABCBPackage, [PackageName]); + + PackagePath := PathRemoveSeparator(ExtractFilePath(PackageName)); + SaveDir := GetCurrentDir; + SetCurrentDir(PackagePath); + try + MakeFileName := StrTrimQuotes(ChangeFileExt(PackageName, '.mak')); + if clProj2Mak in CommandLineTools then // let bpr2mak generate make file from .bpk + Result := Bpr2Mak.Execute(StringsToStr(Bpr2Mak.Options, ' ') + ' ' + ExtractFileName(PackageName)) + else + // If make file exists (and doesn't need to be created by bpr2mak) + Result := FileExists(MakeFileName); + + if MapCreate then + Make.Options.Add('-DMAPFLAGS=-s'); + + Result := Result and + Make.Execute(Format('%s -f%s', [StringsToStr(Make.Options, ' '), StrDoubleQuote(MakeFileName)])) and + ProcessMapFile(BinaryFileName(BPLPath, PackageName)); + finally + SetCurrentDir(SaveDir); + end; + + if Result then + OutputString(LoadResString(@RsCompilationOk)) + else + OutputString(LoadResString(@RsCompilationFailed)); +end; + +function TJclBorRADToolInstallation.CompileBCBProject(const ProjectName, OutputDir, DcpSearchPath: string): Boolean; +var + SaveDir, PackagePath, MakeFileName: string; +begin + OutputString(Format(LoadResString(@RsCompilingProject), [ProjectName])); + + if not IsBCBProject(ProjectName) then + raise EJclBorRADException.CreateResFmt(@RsENotADelphiProject, [ProjectName]); + + PackagePath := PathRemoveSeparator(ExtractFilePath(ProjectName)); + SaveDir := GetCurrentDir; + SetCurrentDir(PackagePath); + try + MakeFileName := StrTrimQuotes(ChangeFileExt(ProjectName, '.mak')); + if clProj2Mak in CommandLineTools then // let bpr2mak generate make file from .bpk + Result := Bpr2Mak.Execute(StringsToStr(Bpr2Mak.Options, ' ') + ' ' + ExtractFileName(ProjectName)) + else + // If make file exists (and doesn't need to be created by bpr2mak) + Result := FileExists(MakeFileName); + + if MapCreate then + Make.Options.Add('-DMAPFLAGS=-s'); + + Result := Result and + Make.Execute(Format('%s -f%s', [StringsToStr(Make.Options, ' '), StrDoubleQuote(MakeFileName)])) and + ProcessMapFile(BinaryFileName(OutputDir, ProjectName)); + finally + SetCurrentDir(SaveDir); + end; + + if Result then + OutputString(LoadResString(@RsCompilationOk)) + else + OutputString(LoadResString(@RsCompilationFailed)); +end; + +function TJclBorRADToolInstallation.CompileDelphiPackage(const PackageName, + BPLPath, DCPPath: string): Boolean; +begin + Result := CompileDelphiPackage(PackageName, BPLPath, DCPPath, ''); +end; + +function TJclBorRADToolInstallation.CompileDelphiPackage(const PackageName, + BPLPath, DCPPath, ExtraOptions: string): Boolean; +var + NewOptions: string; +begin + OutputString(Format(LoadResString(@RsCompilingPackage), [PackageName])); + + if not IsDelphiPackage(PackageName) then + raise EJclBorRADException.CreateResFmt(@RsENotADelphiPackage, [PackageName]); + + if MapCreate then + NewOptions := ExtraOptions + ' -GD' + else + NewOptions := ExtraOptions; + + Result := DCC.MakePackage(PackageName, BPLPath, DCPPath, NewOptions) and + ProcessMapFile(BinaryFileName(BPLPath, PackageName)); + + if Result then + OutputString(LoadResString(@RsCompilationOk)) + else + OutputString(LoadResString(@RsCompilationFailed)); +end; + +function TJclBorRADToolInstallation.CompileDelphiProject(const ProjectName, + OutputDir, DcpSearchPath: string): Boolean; +var + ExtraOptions: string; +begin + OutputString(Format(LoadResString(@RsCompilingProject), [ProjectName])); + + if not IsDelphiProject(ProjectName) then + raise EJclBorRADException.CreateResFmt(@RsENotADelphiProject, [ProjectName]); + + if MapCreate then + ExtraOptions := '-GD' + else + ExtraOptions := ''; + + Result := DCC32.MakeProject(ProjectName, OutputDir, DcpSearchPath, ExtraOptions) and + ProcessMapFile(BinaryFileName(OutputDir, ProjectName)); + + if Result then + OutputString(LoadResString(@RsCompilationOk)) + else + OutputString(LoadResString(@RsCompilationFailed)); +end; + +function TJclBorRADToolInstallation.CompilePackage(const PackageName, BPLPath, + DCPPath: string): Boolean; +begin + Result := CompilePackage(PackageName, BPLPath, DCPPath, ''); +end; + +function TJclBorRADToolInstallation.CompilePackage(const PackageName, BPLPath, + DCPPath, ExtraOptions: string): Boolean; +var + PackageExtension: string; +begin + PackageExtension := ExtractFileExt(PackageName); + if SameText(PackageExtension, SourceExtensionBCBPackage) then + Result := CompileBCBPackage(PackageName, BPLPath, DCPPath) + else + if SameText(PackageExtension, SourceExtensionDelphiPackage) then + Result := CompileDelphiPackage(PackageName, BPLPath, DCPPath, ExtraOptions) + else + raise EJclBorRadException.CreateResFmt(@RsEUnknownPackageExtension, [PackageExtension]); +end; + +function TJclBorRADToolInstallation.CompileProject(const ProjectName, + OutputDir, DcpSearchPath: string): Boolean; +var + ProjectExtension: string; +begin + ProjectExtension := ExtractFileExt(ProjectName); + if SameText(ProjectExtension, SourceExtensionBCBProject) then + Result := CompileBCBProject(ProjectName, OutputDir, DcpSearchPath) + else + if SameText(ProjectExtension, SourceExtensionDelphiProject) then + Result := CompileDelphiProject(ProjectName, OutputDir, DcpSearchPath) + else + raise EJclBorRadException.CreateResFmt(@RsEUnknownProjectExtension, [ProjectExtension]); +end; + +function TJclBorRADToolInstallation.FindFolderInPath(Folder: string; List: TStrings): Integer; +var + I: Integer; +begin + Result := -1; + Folder := PathRemoveSeparator(Folder); + for I := 0 to List.Count - 1 do + if SamePath(Folder, PathRemoveSeparator(SubstitutePath(List[I]))) then + begin + Result := I; + Break; + end; +end; + +function TJclBorRADToolInstallation.GetBPLOutputPath(APlatform: TJclBDSPlatform): string; +begin + CheckPlatform(APlatform); + Result := SubstitutePath(ConfigData.ReadString(LibraryKeyName, LibraryBPLOutputValueName, '')); +end; + +function TJclBorRADToolInstallation.GetBpr2Mak: TJclBpr2Mak; +begin + if not Assigned(FBpr2Mak) then + begin + if not (clProj2Mak in CommandLineTools) then + raise EJclBorRadException.CreateResFmt(@RsENotFound, [Bpr2MakExeName]); + FBpr2Mak := TJclBpr2Mak.Create(BinFolderName, LongPathBug, CompilerSettingsFormat); + end; + Result := FBpr2Mak; +end; + +function TJclBorRADToolInstallation.GetBCC: TJclBCC32; +begin + if Assigned(FBCC) then + Result := FBCC + else + Result := BCC32; +end; + +function TJclBorRADToolInstallation.GetBCC32: TJclBCC32; +begin + if not Assigned(FBCC32) then + begin + if not (clBcc32 in CommandLineTools) then + raise EJclBorRadException.CreateResFmt(@RsENotFound, [Bcc32ExeName]); + FBCC32 := TJclBCC32.Create(BinFolderName, LongPathBug, CompilerSettingsFormat); + end; + Result := FBCC32; +end; + +function TJclBorRADToolInstallation.GetCommonProjectsDir: string; +begin + Result := DefaultProjectsDir; +end; + +function TJclBorRADToolInstallation.GetCompilerSettingsFormat: TJclCompilerSettingsFormat; +begin + if (RadToolKind = brBorlandDevStudio) and (VersionNumber >= 5) then + Result := csfMsBuild + else + if RadToolKind = brBorlandDevStudio then + Result := csfBDSProj + else + Result := csfDOF; +end; + +function TJclBorRADToolInstallation.GetDCC: TJclDCC32; +begin + if Assigned(FDCC) then + Result := FDCC + else + Result := DCC32; +end; + +function TJclBorRADToolInstallation.GetDCC32: TJclDCC32; +begin + if not Assigned(FDCC32) then + begin + if not (clDcc32 in CommandLineTools) then + raise EJclBorRadException.CreateResFmt(@RsENotFound, [Dcc32ExeName]); + FDCC32 := TJclDCC32.Create(BinFolderName, LongPathBug, DCCVersion, CompilerSettingsFormat, + SupportsNoConfig, SupportsPlatform, DCPOutputPath[bpWin32], LibFolderName[bpWin32], LibDebugFolderName[bpWin32], ObjFolderName[bpWin32]); + FDCC32.OnEnvironmentVariables := GetEnvironmentVariables; + end; + Result := FDCC32; +end; + +function TJclBorRADToolInstallation.GetDCPOutputPath(APlatform: TJclBDSPlatform): string; +begin + CheckPlatform(APlatform); + Result := SubstitutePath(ConfigData.ReadString(LibraryKeyName, LibraryDCPOutputValueName, '')); +end; + +function TJclBorRADToolInstallation.GetDebugDCUPath(APlatform: TJclBDSPlatform): string; +begin + CheckPlatform(APlatform); + Result := ConfigData.ReadString(DebuggingKeyName, DebugDCUPathValueName, ''); +end; + +function TJclBorRADToolInstallation.GetDefaultProjectsDir: string; +begin + Result := Globals.Values['DefaultProjectsDirectory']; + if Result = '' then + Result := PathAddSeparator(RootDir) + 'Projects'; +end; + +function TJclBorRADToolInstallation.GetDescription: TJclBorRADToolPath; +begin + Result := Format('%s %s', [Name, EditionAsText]); + if InstalledUpdatePack > 0 then + Result := Result + ' ' + Format(LoadResString(@RsUpdatePackName), [InstalledUpdatePack]); +end; + +function TJclBorRADToolInstallation.GetEditionAsText: string; +begin + Result := FEditionStr; + if Length(FEditionStr) = 3 then + case Edition of + deSTD: + if (VersionNumber >= 6) or (RadToolKind = brBorlandDevStudio) then + Result := LoadResString(@RsPersonal) + else + Result := LoadResString(@RsStandard); + dePRO: + Result := LoadResString(@RsProfessional); + deCSS: + if (VersionNumber >= 5) or (RadToolKind = brBorlandDevStudio) then + Result := LoadResString(@RsEnterprise) + else + Result := LoadResString(@RsClientServer); + deARC: + Result := LoadResString(@RsArchitect); + end; +end; + +function TJclBorRADToolInstallation.GetDefaultBDSCommonDir: string; +const + CSIDL_COMMON_DOCUMENTS = $002E; // All Users\Documents +var + CommonDocuments: array[0..MAX_PATH] of Char; +begin + Result := GetEnvironmentVariable(EnvVariableBDSCOMDIRValueName); + if (RadToolKind = brBorlandDevStudio) and + SHGetSpecialFolderPath(GetActiveWindow, CommonDocuments, CSIDL_COMMON_DOCUMENTS, False) then + if IDEVersionNumber >= 14 then // XE6+ + Result := IncludeTrailingPathDelimiter(CommonDocuments) + RADStudio14UpDirName + PathDelim + Format('%d.0', [IDEVersionNumber]) + else if IDEVersionNumber >= 6 then // Delphi 2009+ + Result := IncludeTrailingPathDelimiter(CommonDocuments) + RADStudioDirName + PathDelim + Format('%d.0', [IDEVersionNumber]); +end; + +function TJclBorRADToolInstallation.GetEnvironmentVariables: TStrings; +var + EnvNames: TStringList; + EnvVarKeyName, EnvVarValue: string; + I: Integer; +begin + if FEnvironmentVariables = nil then + begin + FEnvironmentVariables := TStringList.Create; + + // at first get system environment variables + JclSysInfo.GetEnvironmentVars(FEnvironmentVariables, True); + + // Overwrite BDSCommonDir because it conflicts with older versions and + // the RAD Studio 2009 setup doesn't update the environment variable anymore + if (RadToolKind = brBorlandDevStudio) and (IDEVersionNumber >= 6) then + FEnvironmentVariables.Values[EnvVariableBDSCOMDIRValueName] := GetDefaultBDSCommonDir; + + // read environment variable overrides + if ((VersionNumber >= 6) or (RadToolKind = brBorlandDevStudio)) and + ConfigData.SectionExists(EnvVariablesKeyName) then + begin + EnvNames := TStringList.Create; + try + ConfigData.ReadSection(EnvVariablesKeyName, EnvNames); + for I := 0 to EnvNames.Count - 1 do + begin + EnvVarKeyName := EnvNames[I]; + EnvVarValue := ConfigData.ReadString(EnvVariablesKeyName, EnvVarKeyName, ''); + ExpandEnvironmentVarCustom(EnvVarValue, FEnvironmentVariables); + FEnvironmentVariables.Values[EnvVarKeyName] := EnvVarValue; + end; + finally + EnvNames.Free; + end; + end; + + // remove empty environment variables + for I := FEnvironmentVariables.count-1 downto 0 do + if FEnvironmentVariables.Names[I] = EmptyStr then + FEnvironmentVariables.Delete(I); + end; + Result := FEnvironmentVariables; +end; + +function TJclBorRADToolInstallation.GetGlobals: TStrings; +begin + Result := FGlobals; +end; + +function TJclBorRADToolInstallation.GetIdeExeFileName: string; +begin + Result := Globals.Values['App']; +end; + +function TJclBorRADToolInstallation.GetIdeExeBuildNumber: string; +begin + Result := VersionFixedFileInfoString(IdeExeFileName, vfFull); +end; + +function TJclBorRADToolInstallation.GetIdePackages: TJclBorRADToolIdePackages; +begin + if not Assigned(FIdePackages) then + FIdePackages := TJclBorRADToolIdePackages.Create(Self); + Result := FIdePackages; +end; + +function TJclBorRADToolInstallation.GetIsDcc64: Boolean; +begin + Result := False; +end; + +function TJclBorRADToolInstallation.GetIsTurboExplorer: Boolean; +begin + Result := (RadToolKind = brBorlandDevStudio) and (VersionNumber = 4) and not (clDcc32 in CommandLineTools); +end; + +function TJclBorRADToolInstallation.GetLatestUpdatePack: Integer; +begin + Result := GetLatestUpdatePackForVersion(VersionNumber); +end; + +class function TJclBorRADToolInstallation.GetLatestUpdatePackForVersion(Version: Integer): Integer; +begin + {$IFDEF MSWINDOWS} + raise EAbstractError.CreateResFmt(@SAbstractError, ['']); // BCB doesn't support abstract keyword + // dummy; BCB doesn't like abstract class functions + {$ELSE MSWINDOWS} + Result := 0; + {$ENDIF MSWINDOWS} +end; + +function TJclBorRADToolInstallation.GetLibrarySearchPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; +begin + CheckPlatform(APlatform); + Result := ConfigData.ReadString(LibraryKeyName, LibrarySearchPathValueName, ''); +end; + +function TJclBorRADToolInstallation.GetLongPathBug: Boolean; +begin + Result := (RadToolKind in [brDelphi, brCppBuilder]) or (VersionNumber < 3); +end; + +function TJclBorRADToolInstallation.GetMake: IJclCommandLineTool; +begin + if not Assigned(FMake) then + begin + if not (clMake in CommandLineTools) then + raise EJclBorRadException.CreateResFmt(@RsENotFound, [MakeExeName]); + FMake := TJclBorlandMake.Create(BinFolderName, LongPathBug, CompilerSettingsFormat); + // Set option "-l+", which enables use of long command lines. Should be + // default, but there have been reports indicating that's not always the case. + FMake.Options.Add('-l+'); + end; + Result := FMake; +end; + +function TJclBorRADToolInstallation.GetLibDebugFolderName(APlatform: TJclBDSPlatform): string; +begin + CheckPlatform(APlatform); + Result := LibFolderName[APlatform] + PathAddSeparator('debug'); +end; + +function TJclBorRADToolInstallation.GetLibFolderName(APlatform: TJclBDSPlatform): string; +begin + CheckPlatform(APlatform); + Result := PathAddSeparator(RootDir) + PathAddSeparator('lib'); +end; + +function TJclBorRADToolInstallation.GetLibraryBrowsingPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; +begin + CheckPlatform(APlatform); + Result := ConfigData.ReadString(LibraryKeyName, LibraryBrowsingPathValueName, ''); +end; + +function TJclBorRADToolInstallation.GetName: string; +begin + Result := Format('%s %d', [RADToolName, IDEVersionNumber]); +end; + +function TJclBorRADToolInstallation.GetObjFolderName(APlatform: TJclBDSPlatform): string; +begin + CheckPlatform(APlatform); + Result := LibFolderName[APlatform] + PathAddSeparator('obj'); + if not DirectoryExists(Result) then + Result := ''; +end; + +function TJclBorRADToolInstallation.GetIDEPackageVersionNumberStr: string; +var + Value: Integer; +begin + Value := IDEPackageVersionNumber; + if Value > 0 then + Result := IntToStr(Value) + '0' + else + Result := ''; +end; + +function TJclBorRADToolInstallation.GetPackageVersionNumberStr: string; +var + Value: Integer; +begin + Value := PackageVersionNumber; + if Value > 0 then + Result := IntToStr(Value) + '0' + else + Result := ''; +end; + +function TJclBorRADToolInstallation.GetPalette: TJclBorRADToolPalette; +begin + if not Assigned(FPalette) then + FPalette := TJclBorRADToolPalette.Create(Self); + Result := FPalette; +end; + +function TJclBorRADToolInstallation.GetRawDebugDCUPath(APlatform: TJclBDSPlatform): string; +begin + CheckPlatform(APlatform); + Result := GetDebugDCUPath(APlatform); +end; + +function TJclBorRADToolInstallation.GetRawLibrarySearchPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; +begin + CheckPlatform(APlatform); + Result := GetLibrarySearchPath(APlatform); +end; + +function TJclBorRADToolInstallation.GetRawLibraryBrowsingPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; +begin + CheckPlatform(APlatform); + Result := GetLibraryBrowsingPath(APlatform); +end; + +function TJclBorRADToolInstallation.GetRepository: TJclBorRADToolRepository; +begin + if not Assigned(FRepository) then + FRepository := TJclBorRADToolRepository.Create(Self); + Result := FRepository; +end; + +function TJclBorRADToolInstallation.GetSupportsLibSuffix: Boolean; +begin + Result := (RadToolKind = brBorlandDevStudio) or (VersionNumber >= 6); +end; + +function TJclBorRADToolInstallation.GetSupportsNoConfig: Boolean; +begin + Result := (RadToolKind = brBorlandDevStudio) and (VersionNumber >= 4); +end; + +function TJclBorRADToolInstallation.GetSupportsPlatform: Boolean; +begin + Result := (RadToolKind = brBorlandDevStudio) and (VersionNumber >= 9); +end; + +function TJclBorRADToolInstallation.GetUpdateNeeded: Boolean; +begin + Result := InstalledUpdatePack < LatestUpdatePack; +end; + +function TJclBorRADToolInstallation.GetValid: Boolean; +begin + Result := (ConfigData.FileName <> '') and (RootDir <> '') and FileExists(IdeExeFileName); +end; + +function TJclBorRADToolInstallation.GetVclIncludeDir(APlatform: TJclBDSPlatform): string; +begin + CheckCBuilderPlatform(APlatform); + Result := Format(VclIncludeDirName, [RootDir]); + if not DirectoryExists(Result) then + Result := ''; +end; + +function TJclBorRADToolInstallation.InstallBCBExpert(const ProjectName, OutputDir, DcpSearchPath: string): Boolean; +var + Unused, Description: string; +begin + OutputString(Format(LoadResString(@RsExpertInstallationStarted), [ProjectName])); + + GetBPRFileInfo(ProjectName, Unused, @Description); + + Result := CompileBCBProject(ProjectName, OutputDir, DcpSearchPath) and + RegisterExpert(BinaryFileName(OutputDir, ProjectName), Description); + + OutputString(LoadResString(@RsExpertInstallationFinished)); +end; + +function TJclBorRADToolInstallation.InstallBCBIdePackage(const PackageName, BPLPath, DCPPath: string): Boolean; +var + RunOnly: Boolean; + Unused, Description: string; +begin + OutputString(Format(LoadResString(@RsIdePackageInstallationStarted), [PackageName])); + + GetBPKFileInfo(PackageName, RunOnly, @Unused, @Description); + if RunOnly then + raise EJclBorRadException.CreateResFmt(@RsECannotInstallRunOnly, [PackageName]); + + Result := CompileBCBPackage(PackageName, BPLPath, DCPPath) and + RegisterIdePackage(BinaryFileName(BPLPath, PackageName), Description); + + OutputString(LoadResString(@RsIdePackageInstallationFinished)); +end; + +function TJclBorRADToolInstallation.InstallBCBPackage(const PackageName, BPLPath, DCPPath: string): Boolean; +var + RunOnly: Boolean; + Unused, Description: string; +begin + OutputString(Format(LoadResString(@RsPackageInstallationStarted), [PackageName])); + + GetBPKFileInfo(PackageName, RunOnly, @Unused, @Description); + if RunOnly then + raise EJclBorRadException.CreateResFmt(@RsECannotInstallRunOnly, [PackageName]); + + Result := CompileBCBPackage(PackageName, BPLPath, DCPPath) and + RegisterPackage(BinaryFileName(BPLPath, PackageName), Description); + + OutputString(LoadResString(@RsPackageInstallationFinished)); +end; + +function TJclBorRADToolInstallation.InstallDelphiExpert(const ProjectName, OutputDir, DcpSearchPath: string): Boolean; +var + BaseName: string; +begin + OutputString(Format(LoadResString(@RsExpertInstallationStarted), [ProjectName])); + + BaseName := PathExtractFileNameNoExt(ProjectName); + + Result := CompileDelphiProject(ProjectName, OutputDir, DcpSearchPath) and + RegisterExpert(BinaryFileName(OutputDir, ProjectName), BaseName); + + OutputString(LoadResString(@RsExpertInstallationFinished)); +end; + +function TJclBorRADToolInstallation.InstallDelphiIdePackage(const PackageName, BPLPath, DCPPath: string): Boolean; +var + RunOnly: Boolean; + Unused, Description: string; +begin + OutputString(Format(LoadResString(@RsIdePackageInstallationStarted), [PackageName])); + + GetDPKFileInfo(PackageName, RunOnly, @Unused, @Description); + if RunOnly then + raise EJclBorRadException.CreateResFmt(@RsECannotInstallRunOnly, [PackageName]); + + Result := CompileDelphiPackage(PackageName, BPLPath, DCPPath) and + RegisterIdePackage(BinaryFileName(BPLPath, PackageName), Description); + + OutputString(LoadResString(@RsIdePackageInstallationFinished)); +end; + +function TJclBorRADToolInstallation.InstallDelphiPackage(const PackageName, BPLPath, DCPPath: string): Boolean; +var + RunOnly: Boolean; + Unused, Description: string; +begin + OutputString(Format(LoadResString(@RsPackageInstallationStarted), [PackageName])); + + GetDPKFileInfo(PackageName, RunOnly, @Unused, @Description); + if RunOnly then + raise EJclBorRadException.CreateResFmt(@RsECannotInstallRunOnly, [PackageName]); + + Result := CompileDelphiPackage(PackageName, BPLPath, DCPPath) and + RegisterPackage(BinaryFileName(BPLPath, PackageName), Description); + + OutputString(LoadResString(@RsPackageInstallationFinished)); +end; + +function TJclBorRADToolInstallation.InstallExpert(const ProjectName, OutputDir, DcpSearchPath: string): Boolean; +var + ProjectExtension: string; +begin + ProjectExtension := ExtractFileExt(ProjectName); + if SameText(ProjectExtension, SourceExtensionBCBProject) then + Result := InstallBCBExpert(ProjectName, OutputDir, DcpSearchPath) + else + if SameText(ProjectExtension, SourceExtensionDelphiProject) then + Result := InstallDelphiExpert(ProjectName, OutputDir, DcpSearchPath) + else + raise EJclBorRADException.CreateResFmt(@RsEUnknownProjectExtension, [ProjectExtension]); +end; + +function TJclBorRADToolInstallation.InstallIDEPackage(const PackageName, BPLPath, DCPPath: string): Boolean; +var + PackageExtension: string; +begin + PackageExtension := ExtractFileExt(PackageName); + if SameText(PackageExtension, SourceExtensionBCBPackage) then + Result := InstallBCBIdePackage(PackageName, BPLPath, DCPPath) + else + if SameText(PackageExtension, SourceExtensionDelphiPackage) then + Result := InstallDelphiIdePackage(PackageName, BPLPath, DCPPath) + else + raise EJclBorRADException.CreateResFmt(@RsEUnknownIdePackageExtension, [PackageExtension]); +end; + +function TJclBorRADToolInstallation.InstallPackage(const PackageName, BPLPath, DCPPath: string): Boolean; +var + PackageExtension: string; +begin + PackageExtension := ExtractFileExt(PackageName); + if SameText(PackageExtension, SourceExtensionBCBPackage) then + Result := InstallBCBPackage(PackageName, BPLPath, DCPPath) + else + if SameText(PackageExtension, SourceExtensionDelphiPackage) then + Result := InstallDelphiPackage(PackageName, BPLPath, DCPPath) + else + raise EJclBorRADException.CreateResFmt(@RsEUnknownPackageExtension, [PackageExtension]); +end; + +function TJclBorRADToolInstallation.ProcessMapFile(const BinaryFileName: string): Boolean; +{$IFDEF MSWINDOWS} +var + MAPFileName, LinkerBugUnit: string; + MAPFileSize, JclDebugDataSize: Integer; +{$ENDIF MSWINDOWS} +begin + {$IFDEF MSWINDOWS} + if JdbgCreate then + begin + MAPFileName := ChangeFileExt(BinaryFileName, CompilerExtensionMAP); + + if JdbgInsert then + begin + OutputString(Format(LoadResString(@RsInsertingJdbg), [BinaryFileName])); + Result := InsertDebugDataIntoExecutableFile(BinaryFileName, MAPFileName, + LinkerBugUnit, MAPFileSize, JclDebugDataSize); + OutputString(Format(LoadResString(@RsJdbgInfo), [LinkerBugUnit, MAPFileSize, JclDebugDataSize])); + end + else + begin + OutputString(Format(LoadResString(@RsCreatingJdbg), [BinaryFileName])); + Result := ConvertMapFileToJdbgFile(MAPFileName); + end; + if Result then + begin + OutputString(LoadResString(@RsJdbgInfoOk)); + if MapDelete then + OutputFileDelete(MAPFileName); + end + else + OutputString(LoadResString(@RsJdbgInfoFailed)); + end + else + Result := True; + {$ELSE MSWINDOWS} + Result := True; + {$ENDIF MSWINDOWS} +end; + +function TJclBorRADToolInstallation.OutputFileDelete(const FileName: string): Boolean; +begin + OutputString(Format(LoadResString(@RsDeletingFile), [FileName])); + Result := FileDelete(FileName); + if Result then + OutputString(LoadResString(@RsFileDeletionOk)) + else + OutputString(LoadResString(@RsFileDeletionFailed)); +end; + +procedure TJclBorRADToolInstallation.OutputString(const AText: string); +begin + if Assigned(FOutputCallback) then + OutputCallback(AText); +end; + +class function TJclBorRADToolInstallation.PackageSourceFileExtension: string; +begin + {$IFDEF MSWINDOWS} + raise EAbstractError.CreateResFmt(@SAbstractError, ['']); // BCB doesn't support abstract keyword + {$ELSE MSWINDOWS} + Result := ''; + {$ENDIF MSWINDOWS} +end; + +class function TJclBorRADToolInstallation.ProjectSourceFileExtension: string; +begin + {$IFDEF MSWINDOWS} + raise EAbstractError.CreateResFmt(@SAbstractError, ['']); // BCB doesn't support abstract keyword + {$ELSE MSWINDOWS} + Result := ''; + {$ENDIF MSWINDOWS} +end; + +class function TJclBorRADToolInstallation.RADToolKind: TJclBorRADToolKind; +begin + {$IFDEF MSWINDOWS} + raise EAbstractError.CreateResFmt(@SAbstractError, ['']); // BCB doesn't support abstract keyword + {$ELSE MSWINDOWS} + Result := brDelphi; + {$ENDIF MSWINDOWS} +end; + +{class }function TJclBorRADToolInstallation.RADToolName: string; +begin + {$IFDEF MSWINDOWS} + raise EAbstractError.CreateResFmt(@SAbstractError, ['']); // BCB doesn't support abstract keyword + {$ELSE MSWINDOWS} + Result := ''; + {$ENDIF MSWINDOWS} +end; + +procedure TJclBorRADToolInstallation.ReadInformation; + function FormatVersionNumber(const Num: Integer): string; + begin + Result := ''; + case RadToolKind of + brDelphi: + Result := Format('d%d', [Num]); + brCppBuilder: + Result := Format('c%d', [Num]); + brBorlandDevStudio: + case Num of + 1: + Result := 'cs1'; + else + if Num >= 37 then + Result := Format('d%d', [Num]) // BDS37 is now all synchronized again + else if (Num < 7) or (Num > 12) then + Result := Format('d%d', [Num + 6]) // BDS 2 goes to D8 and BDS 14 goes to D20 + else + Result := Format('d%d', [Num + 7]); // BDS 7 goes to D14 + end; + end; + end; + +const + BinDir = 'bin\'; + UpdateKeyName = 'Update #'; + BDSUpdateKeyName = 'UpdatePackInstalled'; +var + KeyLen, I: Integer; + Key, GlobalKey: string; + Ed: TJclBorRADToolEdition; + GlobalsBuffer: TStrings; + Version: Extended; + BDSVersion: PBDSVersionInfo; +begin + Key := ConfigData.FileName; + GlobalKey := StrEnsureSuffix('\', Key) + GlobalsKeyName; + GlobalsBuffer := TStringList.Create; + try + // overriden settings first + RegGetValueNamesAndValues(HKCU, GlobalKey, GlobalsBuffer); + Globals.AddStrings(GlobalsBuffer); + RegGetValueNamesAndValues(HKCU, Key, GlobalsBuffer); + Globals.AddStrings(GlobalsBuffer); + RegGetValueNamesAndValues(HKLM, GlobalKey, GlobalsBuffer); + Globals.AddStrings(GlobalsBuffer); + RegGetValueNamesAndValues(HKLM, Key, GlobalsBuffer); + Globals.AddStrings(GlobalsBuffer); + finally + GlobalsBuffer.Free; + end; + + I := StrLastPos('\', Key); + if I > 0 then + Key := Copy(Key, I + 1, Length(Key) - I); + + Key := StrReplaceChar(Key, '.', {$IFDEF RTL220_UP}FormatSettings.{$ENDIF}DecimalSeparator); + Version := StrToFloatSafe(Key); + if Frac(Version) = 0 then + FIDEVersionNumber := Round(Version) + else + FIDEVersionNumber := 0; + + FIDEVersionNumberStr := FormatVersionNumber(VersionNumber); + + if RadToolKind = brBorlandDevStudio then + begin + BDSVersion := GetBDSVersionByIDEVersion(IDEVersionNumber); + if Assigned(BDSVersion) then + begin + FPackageVersionNumber := BDSVersion.PkgVersion; + FIDEPackageVersionNumber := BDSVersion.IDEPkgVersion; + FDCCVersion := BDSVersion.DCCVersion; + end; + end + else + begin + FIDEPackageVersionNumber := IDEVersionNumber; + FPackageVersionNumber := IDEVersionNumber; + FDCCVersion := 8 + IDEVersionNumber; // Delphi 1.0 = Compiler 8.0 + end; + + FRootDir := PathRemoveSeparator(Globals.Values[RootDirValueName]); + FBinFolderName := PathAddSeparator(RootDir) + BinDir; + + FEditionStr := Globals.Values[EditionValueName]; + if FEditionStr = '' then + FEditionStr := Globals.Values[VersionValueName]; + { TODO : Edition detection for BDS } + for Ed := Low(Ed) to High(Ed) do + if StrIPos(BorRADToolEditionIDs[Ed], FEditionStr) = 1 then + FEdition := Ed; + + if RadToolKind = brBorlandDevStudio then + FInstalledUpdatePack := StrToIntDef(Globals.Values[BDSUpdateKeyName], 0) + else + for I := 0 to Globals.Count - 1 do + begin + Key := Globals.Names[I]; + KeyLen := Length(UpdateKeyName); + if (Pos(UpdateKeyName, Key) = 1) and (Length(Key) > KeyLen) and StrIsDigit(Key[KeyLen + 1]) then + FInstalledUpdatePack := Max(FInstalledUpdatePack, Integer(Ord(Key[KeyLen + 1]) - 48)); + end; +end; + +function TJclBorRADToolInstallation.RegisterExpert(const ProjectName, OutputDir, Description: string): Boolean; +begin + Result := RegisterExpert(BinaryFileName(OutputDir, ProjectName), Description); +end; + +function TJclBorRADToolInstallation.RegisterExpert(const BinaryFileName, Description: string): Boolean; +var + InternalDescription: string; +begin + OutputString(Format(LoadResString(@RsRegisteringExpert), [BinaryFileName])); + + if Description = '' then + InternalDescription := PathExtractFileNameNoExt(BinaryFileName) + else + InternalDescription := Description; + + Result := IdePackages.AddExpert(BinaryFileName, InternalDescription, GetIsDcc64); + if Result then + OutputString(LoadResString(@RsRegistrationOk)) + else + OutputString(LoadResString(@RsRegistrationFailed)); +end; + +function TJclBorRADToolInstallation.RegisterIDEPackage(const PackageName, BPLPath, Description: string): Boolean; +begin + Result := RegisterIDEPackage(BinaryFileName(BPLPath, PackageName), Description); +end; + +function TJclBorRADToolInstallation.RegisterIDEPackage(const BinaryFileName, Description: string): Boolean; +var + InternalDescription: string; +begin + OutputString(Format(LoadResString(@RsRegisteringIdePackage), [BinaryFileName])); + + if Description = '' then + InternalDescription := PathExtractFileNameNoExt(BinaryFileName) + else + InternalDescription := Description; + + Result := IdePackages.AddIDEPackage(BinaryFileName, InternalDescription, GetIsDcc64); + if Result then + OutputString(LoadResString(@RsRegistrationOk)) + else + OutputString(LoadResString(@RsRegistrationFailed)); +end; + +function TJclBorRADToolInstallation.RegisterPackage(const PackageName, BPLPath, Description: string): Boolean; +begin + Result := RegisterPackage(BinaryFileName(BPLPath, PackageName), Description); +end; + +function TJclBorRADToolInstallation.RegisterPackage(const BinaryFileName, Description: string): Boolean; +var + InternalDescription: string; +begin + OutputString(Format(LoadResString(@RsRegisteringPackage), [BinaryFileName])); + + if Description = '' then + InternalDescription := PathExtractFileNameNoExt(BinaryFileName) + else + InternalDescription := Description; + + Result := IdePackages.AddPackage(BinaryFileName, InternalDescription, GetIsDcc64); + if Result then + OutputString(LoadResString(@RsRegistrationOk)) + else + OutputString(LoadResString(@RsRegistrationFailed)); +end; + +function TJclBorRADToolInstallation.RemoveFromDebugDCUPath(const Path: string; APlatform: TJclBDSPlatform): Boolean; +var + TempRawDebugDCUPath: TJclBorRADToolPath; +begin + CheckPlatform(APlatform); + + TempRawDebugDCUPath := RawDebugDCUPath[APlatform]; + Result := RemoveFromPath(TempRawDebugDCUPath, Path); + RawDebugDCUPath[APlatform] := TempRawDebugDCUPath; +end; + +function TJclBorRADToolInstallation.RemoveFromLibrarySearchPath(const Path: string; APlatform: TJclBDSPlatform): Boolean; +var + TempRawLibraryPath: TJclBorRADToolPath; +begin + CheckPlatform(APlatform); + + TempRawLibraryPath := RawLibrarySearchPath[APlatform]; + Result := RemoveFromPath(TempRawLibraryPath, Path); + RawLibrarySearchPath[APlatform] := TempRawLibraryPath; +end; + +function TJclBorRADToolInstallation.RemoveFromLibraryBrowsingPath(const Path: string; APlatform: TJclBDSPlatform): Boolean; +var + TempRawLibraryPath: TJclBorRADToolPath; +begin + CheckPlatform(APlatform); + + TempRawLibraryPath := RawLibraryBrowsingPath[APlatform]; + Result := RemoveFromPath(TempRawLibraryPath, Path); + RawLibraryBrowsingPath[APlatform] := TempRawLibraryPath; +end; + +function TJclBorRADToolInstallation.RemoveFromPath(var Path: string; const ItemsToRemove: string): Boolean; +var + PathItems, RemoveItems: TStringList; + Folder: string; + I, J: Integer; +begin + Result := False; + PathItems := nil; + RemoveItems := nil; + try + PathItems := TStringList.Create; + RemoveItems := TStringList.Create; + ExtractPaths(Path, PathItems); + ExtractPaths(ItemsToRemove, RemoveItems); + for I := 0 to RemoveItems.Count - 1 do + begin + Folder := RemoveItems[I]; + J := FindFolderInPath(Folder, PathItems); + if J <> -1 then + begin + PathItems.Delete(J); + Result := True; + end; + end; + Path := StringsToStr(PathItems, PathSep, False); + finally + PathItems.Free; + RemoveItems.Free; + end; +end; + +procedure TJclBorRADToolInstallation.SetBCC(const Value: TJclBCC32); +begin + FBCC := Value; +end; + +procedure TJclBorRADToolInstallation.SetDCC(const Value: TJclDCC32); +begin + FDCC := Value; +end; + +procedure TJclBorRADToolInstallation.SetOutputCallback(const Value: TTextHandler); +begin + FOutputCallback := Value; + //if clAsm in CommandLineTools then + // Asm.OutputCallback := Value; + if clBcc32 in CommandLineTools then + Bcc32.OutputCallback := Value; + if clDcc32 in CommandLineTools then + Dcc32.OutputCallback := Value; + //if clDccIL in CommandLineTools then + // DccIL.OutputCallback := Value; + if clMake in CommandLineTools then + Make.OutputCallback := Value; + if clProj2Mak in CommandLineTools then + Bpr2Mak.OutputCallback := Value; +end; + +procedure TJclBorRADToolInstallation.SetRawDebugDCUPath(APlatform: TJclBDSPlatform; const Value: TJclBorRADToolPath); +begin + CheckPlatform(APlatform); + ConfigData.WriteString(DebuggingKeyName, DebugDCUPathValueName, Value); +end; + +procedure TJclBorRADToolInstallation.SetRawLibrarySearchPath(APlatform: TJclBDSPlatform; const Value: TJclBorRADToolPath); +begin + CheckPlatform(APlatform); + ConfigData.WriteString(LibraryKeyName, LibrarySearchPathValueName, Value); +end; + +procedure TJclBorRADToolInstallation.SetRawLibraryBrowsingPath(APlatform: TJclBDSPlatform; const Value: TJclBorRADToolPath); +begin + CheckPlatform(APlatform); + ConfigData.WriteString(LibraryKeyName, LibraryBrowsingPathValueName, Value); +end; + +function TJclBorRADToolInstallation.SubstitutePath(const Path: string): string; +var + I: Integer; + Name: string; +begin + Result := Path; + if Pos('$(', Result) > 0 then + with EnvironmentVariables do + for I := 0 to Count - 1 do + begin + Name := Names[I]; + Result := StringReplace(Result, Format('$(%s)', [Name]), Values[Name], [rfReplaceAll, rfIgnoreCase]); + end; + // remove duplicate path delimiters '\\' + Result := StringReplace(Result, DirDelimiter + DirDelimiter, DirDelimiter, [rfReplaceAll]); +end; + +function TJclBorRADToolInstallation.SupportsVCL: Boolean; +const + VclDcp = 'vcl.dcp'; +begin + Result := ((RadToolKind <> brBorlandDevStudio) and (VersionNumber = 5)) or + FileExists(LibFolderName[bpWin32] + VclDcp) or FileExists(ObjFolderName[bpWin32] + VclDcp); +end; + +function TJclBorRADToolInstallation.SupportsVisualCLX: Boolean; +const + VisualClxDcp = 'visualclx.dcp'; +begin + Result := (Edition <> deSTD) and (VersionNumber in [6, 7]) and (RadToolKind <> brBorlandDevStudio) and + (FileExists(LibFolderName[bpWin32] + VisualClxDcp) or FileExists(ObjFolderName[bpWin32] + VisualClxDcp)); +end; + +function TJclBorRADToolInstallation.UninstallBCBExpert(const ProjectName, OutputDir: string): Boolean; +var + DllFileName: string; +begin + OutputString(Format(LoadResString(@RsExpertUninstallationStarted), [ProjectName])); + + if not IsBCBProject(ProjectName) then + raise EJclBorRADException.CreateResFmt(@RsENotABCBProject, [ProjectName]); + + DllFileName := BinaryFileName(OutputDir, ProjectName); + // important: remove from experts /before/ deleting; + // otherwise PathGetLongPathName won't work + Result := UnregisterExpert(DllFileName); + + if Result then + OutputFileDelete(DllFileName); + + OutputString(LoadResString(@RsExpertUninstallationFinished)); +end; + +function TJclBorRADToolInstallation.UninstallBCBIdePackage(const PackageName, BPLPath, DCPPath: string): Boolean; +var + MAPFileName, TDSFileName, + BPIFileName, LIBFileName, BPLFileName: string; + RunOnly: Boolean; +begin + OutputString(Format(LoadResString(@RsIdePackageUninstallationStarted), [PackageName])); + + if not IsBCBPackage(PackageName) then + raise EJclBorRADException.CreateResFmt(@RsENotABCBPackage, [PackageName]); + + GetBPKFileInfo(PackageName, RunOnly); + + BPLFileName := BinaryFileName(BPLPath, PackageName); + + // important: remove from IDE packages /before/ deleting; + // otherwise PathGetLongPathName won't work + Result := (RunOnly or UnregisterIdePackage(BPLFileName)); + + // Don't delete binaries if removal of design time package failed + if Result then + begin + OutputFileDelete(BPLFileName); + + BPIFileName := PathAddSeparator(DCPPath) + PathExtractFileNameNoExt(PackageName) + CompilerExtensionBPI; + OutputFileDelete(BPIFileName); + + LIBFileName := ChangeFileExt(BPIFileName, CompilerExtensionLIB); + OutputFileDelete(LIBFileName); + + MAPFileName := ChangeFileExt(BPLFileName, CompilerExtensionMAP); + OutputFileDelete(MAPFileName); + + TDSFileName := ChangeFileExt(BPLFileName, CompilerExtensionTDS); + OutputFileDelete(TDSFileName); + end; + + OutputString(LoadResString(@RsIdePackageUninstallationFinished)); +end; + +function TJclBorRADToolInstallation.UninstallBCBPackage(const PackageName, BPLPath, DCPPath: string): Boolean; +var + MAPFileName, TDSFileName, TmpBinaryFileName, + BPIFileName, LIBFileName, BPLFileName: string; + RunOnly: Boolean; +begin + OutputString(Format(LoadResString(@RsPackageUninstallationStarted), [PackageName])); + + if not IsBCBPackage(PackageName) then + raise EJclBorRADException.CreateResFmt(@RsENotABCBPackage, [PackageName]); + + GetBPKFileInfo(PackageName, RunOnly, @TmpBinaryFileName); + + BPLFileName := BinaryFileName(BPLPath, PackageName); + + // important: remove from IDE packages /before/ deleting; + // otherwise PathGetLongPathName won't work + Result := (RunOnly or UnregisterPackage(BPLFileName)); + + // Don't delete binaries if removal of design time package failed + if Result then + begin + OutputFileDelete(BPLFileName); + + BPIFileName := PathAddSeparator(DCPPath) + PathExtractFileNameNoExt(PackageName) + CompilerExtensionBPI; + OutputFileDelete(BPIFileName); + + LIBFileName := ChangeFileExt(BPIFileName, CompilerExtensionLIB); + OutputFileDelete(LIBFileName); + + MAPFileName := ChangeFileExt(BPLFileName, CompilerExtensionMAP); + OutputFileDelete(MAPFileName); + + TDSFileName := ChangeFileExt(BPLFileName, CompilerExtensionTDS); + OutputFileDelete(TDSFileName); + end; + + OutputString(LoadResString(@RsPackageUninstallationFinished)); +end; + +function TJclBorRADToolInstallation.UninstallDelphiExpert(const ProjectName, OutputDir: string): Boolean; +var + DllFileName: string; +begin + OutputString(Format(LoadResString(@RsExpertUninstallationStarted), [ProjectName])); + + if not IsDelphiProject(ProjectName) then + raise EJclBorRADException.CreateResFmt(@RsENotADelphiProject, [ProjectName]); + + DllFileName := BinaryFileName(OutputDir, ProjectName); + // important: remove from experts /before/ deleting; + // otherwise PathGetLongPathName won't work + Result := UnregisterExpert(DllFileName); + + if Result then + OutputFileDelete(DllFileName); + + OutputString(LoadResString(@RsExpertUninstallationFinished)); +end; + +function TJclBorRADToolInstallation.UninstallDelphiIdePackage(const PackageName, BPLPath, DCPPath: string): Boolean; +var + MAPFileName, + BPLFileName, DCPFileName: string; + BaseName: string; + RunOnly: Boolean; +begin + OutputString(Format(LoadResString(@RsIdePackageUninstallationStarted), [PackageName])); + + if not IsDelphiPackage(PackageName) then + raise EJclBorRADException.CreateResFmt(@RsENotADelphiPackage, [PackageName]); + + GetDPKFileInfo(PackageName, RunOnly); + BaseName := PathExtractFileNameNoExt(PackageName); + + BPLFileName := BinaryFileName(BPLPath, PackageName); + + // important: remove from IDE packages /before/ deleting; + // otherwise PathGetLongPathName won't work + Result := RunOnly or UnregisterIdePackage(BPLFileName); + + // Don't delete binaries if removal of design time package failed + if Result then + begin + OutputFileDelete(BPLFileName); + + DCPFileName := PathAddSeparator(DCPPath) + BaseName + CompilerExtensionDCP; + OutputFileDelete(DCPFileName); + + MAPFileName := ChangeFileExt(BPLFileName, CompilerExtensionMAP); + OutputFileDelete(MAPFileName); + end; + + OutputString(LoadResString(@RsIdePackageUninstallationFinished)); +end; + +function TJclBorRADToolInstallation.UninstallDelphiPackage(const PackageName, BPLPath, DCPPath: string): Boolean; +var + MAPFileName, BPLFileName, DCPFileName: string; + BaseName: string; + RunOnly: Boolean; +begin + OutputString(Format(LoadResString(@RsPackageUninstallationStarted), [PackageName])); + + if not IsDelphiPackage(PackageName) then + raise EJclBorRADException.CreateResFmt(@RsENotADelphiPackage, [PackageName]); + + GetDPKFileInfo(PackageName, RunOnly); + BaseName := PathExtractFileNameNoExt(PackageName); + + BPLFileName := BinaryFileName(BPLPath, PackageName); + + // important: remove from IDE packages /before/ deleting; + // otherwise PathGetLongPathName won't work + Result := RunOnly or UnregisterPackage(BPLFileName); + + // Don't delete binaries if removal of design time package failed + if Result then + begin + OutputFileDelete(BPLFileName); + + DCPFileName := PathAddSeparator(DCPPath) + BaseName + CompilerExtensionDCP; + OutputFileDelete(DCPFileName); + + MAPFileName := ChangeFileExt(BPLFileName, CompilerExtensionMAP); + OutputFileDelete(MAPFileName); + end; + + OutputString(LoadResString(@RsPackageUninstallationFinished)); +end; + +function TJclBorRADToolInstallation.UninstallExpert(const ProjectName, OutputDir: string): Boolean; +var + ProjectExtension: string; +begin + ProjectExtension := ExtractFileExt(ProjectName); + if SameText(ProjectExtension, SourceExtensionBCBProject) then + Result := UninstallBCBExpert(ProjectName, OutputDir) + else + if SameText(ProjectExtension, SourceExtensionDelphiProject) then + Result := UninstallDelphiExpert(ProjectName, OutputDir) + else + raise EJclBorRadException.CreateResFmt(@RsEUnknownProjectExtension, [ProjectExtension]); +end; + +function TJclBorRADToolInstallation.UninstallIDEPackage(const PackageName, BPLPath, DCPPath: string): Boolean; +var + PackageExtension: string; +begin + PackageExtension := ExtractFileExt(PackageName); + if SameText(PackageExtension, SourceExtensionBCBPackage) then + Result := UninstallBCBIdePackage(PackageName, BPLPath, DCPPath) + else + if SameText(PackageExtension, SourceExtensionDelphiPackage) then + Result := UninstallDelphiIdePackage(PackageName, BPLPath, DCPPath) + else + raise EJclBorRadException.CreateResFmt(@RsEUnknownIdePackageExtension, [PackageExtension]); +end; + +function TJclBorRADToolInstallation.UninstallPackage(const PackageName, BPLPath, DCPPath: string): Boolean; +var + PackageExtension: string; +begin + PackageExtension := ExtractFileExt(PackageName); + if SameText(PackageExtension, SourceExtensionBCBPackage) then + Result := UninstallBCBPackage(PackageName, BPLPath, DCPPath) + else + if SameText(PackageExtension, SourceExtensionDelphiPackage) then + Result := UninstallDelphiPackage(PackageName, BPLPath, DCPPath) + else + raise EJclBorRadException.CreateResFmt(@RsEUnknownPackageExtension, [PackageExtension]); +end; + +function TJclBorRADToolInstallation.UnregisterExpert(const ProjectName, OutputDir: string): Boolean; +begin + Result := UnregisterExpert(BinaryFileName(OutputDir, ProjectName)); +end; + +function TJclBorRADToolInstallation.UnregisterExpert(const BinaryFileName: string): Boolean; +begin + OutputString(Format(LoadResString(@RsUnregisteringExpert), [BinaryFileName])); + + Result := IdePackages.RemoveExpert(BinaryFileName, GetIsDcc64); + if Result then + OutputString(LoadResString(@RsUnregistrationOk)) + else + OutputString(LoadResString(@RsUnregistrationFailed)); +end; + +function TJclBorRADToolInstallation.UnregisterIDEPackage(const PackageName, BPLPath: string): Boolean; +begin + Result := UnregisterIDEPackage(BinaryFileName(BPLPath, PackageName)); +end; + +function TJclBorRADToolInstallation.UnregisterIDEPackage(const BinaryFileName: string): Boolean; +begin + OutputString(Format(LoadResString(@RsUnregisteringIDEPackage), [BinaryFileName])); + + Result := IdePackages.RemoveIDEPackage(BinaryFileName, GetIsDcc64); + if Result then + OutputString(LoadResString(@RsUnregistrationOk)) + else + OutputString(LoadResString(@RsUnregistrationFailed)); +end; + +function TJclBorRADToolInstallation.UnregisterPackage(const PackageName, BPLPath: string): Boolean; +begin + Result := UnregisterPackage(BinaryFileName(BPLPath, PackageName)); +end; + +function TJclBorRADToolInstallation.UnregisterPackage(const BinaryFileName: string): Boolean; +begin + OutputString(Format(LoadResString(@RsUnregisteringPackage), [BinaryFileName])); + + Result := IdePackages.RemovePackage(BinaryFileName, GetIsDcc64); + if Result then + OutputString(LoadResString(@RsUnregistrationOk)) + else + OutputString(LoadResString(@RsUnregistrationFailed)); +end; + +//=== { TJclBCBInstallation } ================================================ + +constructor TJclBCBInstallation.Create(const AConfigDataLocation: string; ARootKey: Cardinal); +begin + inherited Create(AConfigDataLocation, ARootKey); + FPersonalities := [bpBCBuilder32]; + if clDcc32 in CommandLineTools then + Include(FPersonalities, bpDelphi32); +end; + +destructor TJclBCBInstallation.Destroy; +begin + inherited Destroy; +end; + +function TJclBCBInstallation.GetEnvironmentVariables: TStrings; +begin + Result := inherited GetEnvironmentVariables; + if Assigned(Result) then + Result.Values['BCB'] := PathRemoveSeparator(RootDir); +end; + +class function TJclBCBInstallation.GetLatestUpdatePackForVersion(Version: Integer): Integer; +begin + case Version of + 5: + Result := 0; + 6: + Result := 4; + 10: + Result := 0; + else + Result := 0; + end; +end; + +class function TJclBCBInstallation.PackageSourceFileExtension: string; +begin + Result := SourceExtensionBCBPackage; +end; + +class function TJclBCBInstallation.ProjectSourceFileExtension: string; +begin + Result := SourceExtensionBCBProject; +end; + +class function TJclBCBInstallation.RadToolKind: TJclBorRadToolKind; +begin + Result := brCppBuilder; +end; + +function TJclBCBInstallation.RADToolName: string; +begin + Result := LoadResString(@RsBCBName); +end; + +//=== { TJclDelphiInstallation } ============================================= + +constructor TJclDelphiInstallation.Create(const AConfigDataLocation: string; ARootKey: Cardinal); +begin + inherited Create(AConfigDataLocation, ARootKey); + FPersonalities := [bpDelphi32]; +end; + +destructor TJclDelphiInstallation.Destroy; +begin + inherited Destroy; +end; + +function TJclDelphiInstallation.GetEnvironmentVariables: TStrings; +begin + Result := inherited GetEnvironmentVariables; + if Assigned(Result) then + Result.Values['DELPHI'] := PathRemoveSeparator(RootDir); +end; + +class function TJclDelphiInstallation.GetLatestUpdatePackForVersion(Version: Integer): Integer; +begin + case Version of + 5: + Result := 1; + 6: + Result := 2; + 7: + Result := 0; + else + Result := 0; + end; +end; + +function TJclDelphiInstallation.InstallPackage(const PackageName, BPLPath, DCPPath: string): Boolean; +begin + Result := InstallDelphiPackage(PackageName, BPLPath, DCPPath); +end; + +class function TJclDelphiInstallation.PackageSourceFileExtension: string; +begin + Result := SourceExtensionDelphiPackage; +end; + +class function TJclDelphiInstallation.ProjectSourceFileExtension: string; +begin + Result := SourceExtensionDelphiProject; +end; + +class function TJclDelphiInstallation.RadToolKind: TJclBorRadToolKind; +begin + Result := brDelphi; +end; + +function TJclDelphiInstallation.RADToolName: string; +begin + Result := LoadResString(@RsDelphiName); +end; + +//=== { TJclBDSInstallation } ================================================== + +{$IFDEF MSWINDOWS} + +constructor TJclBDSInstallation.Create(const AConfigDataLocation: string; ARootKey: Cardinal = 0); +const + PersonalitiesSection = 'Personalities'; +begin + inherited Create(AConfigDataLocation, ARootKey); + FHelp2Manager := TJclHelp2Manager.Create(IDEVersionNumber); + + if ConfigData.ReadString(PersonalitiesSection, 'C#Builder', '') <> '' then + Include(FPersonalities, bpCSBuilder32); + if ConfigData.ReadString(PersonalitiesSection, 'BCB', '') <> '' then + Include(FPersonalities, bpBCBuilder32); + if ConfigData.ReadString(PersonalitiesSection, 'Delphi.Win32', '') <> '' then + Include(FPersonalities, bpDelphi32); + if (ConfigData.ReadString(PersonalitiesSection, 'Delphi.NET', '') <> '') or + (ConfigData.ReadString(PersonalitiesSection, 'Delphi8', '') <> '') then + begin + Include(FPersonalities, bpDelphiNet32); + if VersionNumber >= 5 then + Include(FPersonalities, bpDelphiNet64); + end; + + // It may happen that some updates deploy bcc32c.exe even when the C++ Builder personality is not available + // in which case we consider that the exe is absent to avoid inconsistency in the build process + // Also, it is not possible to have C++ Builder 64 without installing the 32 bit personality, we then also + // exclude anything C++x64 related in that case as bcc64(x).exe can also be deployed by an update. + if not (bpBCBuilder32 in Personalities) then + begin + Exclude(FCommandLineTools, clBcc32c); + Exclude(FCommandLineTools, clBcc64); + Exclude(FCommandLineTools, clBcc64x); + + Exclude(FPersonalities, bpBCBuilder64); + end; + + if clDcc32 in CommandLineTools then + Include(FPersonalities, bpDelphi32); + if clDcc64 in CommandLineTools then + Include(FPersonalities, bpDelphi64); + if clDccOSX32 in CommandLineTools then + Include(FPersonalities, bpDelphiOSX32); + if clDccOSX64 in CommandLineTools then + Include(FPersonalities, bpDelphiOSX64); + if clDcciOSSimulator in CommandLineTools then + Include(FPersonalities, bpDelphiiOSSimulator); + if clDcciOS32 in CommandLineTools then + Include(FPersonalities, bpDelphiiOSDevice32); + if clDcciOS64 in CommandLineTools then + Include(FPersonalities, bpDelphiiOSDevice64); + if clDccArm32 in CommandLineTools then + Include(FPersonalities, bpDelphiAndroid32); + if clDccArm64 in CommandLineTools then + Include(FPersonalities, bpDelphiAndroid64); + if clDccLinux64 in CommandLineTools then + Include(FPersonalities, bpDelphiLinux64); + if clBcc64 in CommandLineTools then + Include(FPersonalities, bpBCBuilder64); + if clBcc64x in CommandLineTools then + Include(FPersonalities, bpBCBuilder64); +end; + +destructor TJclBDSInstallation.Destroy; +begin + FreeAndNil(FDCCIL); + FreeAndNil(FDCC64); + FreeAndNil(FBCC64); + FreeAndNil(FBCC64X); + FreeAndNil(FDCCOSX32); + FreeAndNil(FDCCOSX64); + FreeAndNil(FDCCiOSSimulator); + FreeAndNil(FDCCiOS32); + FreeAndNil(FDCCiOS64); + FreeAndNil(FDCCArm32); + FreeAndNil(FDCCArm64); + FreeAndNil(FDCCLinux64); + FreeAndNil(FHelp2Manager); + inherited Destroy; +end; + +function TJclBDSInstallation.AddToCppBrowsingPath(const Path: string; APlatform: TJclBDSPlatform): Boolean; +var + TempRawCppPath: TJclBorRADToolPath; +begin + CheckCBuilderPlatform(APlatform); + + if Path <> '' then + begin + TempRawCppPath := RawCppBrowsingPath[APlatform]; + PathListIncludeItems(TempRawCppPath, Path); + Result := True; + RawCppBrowsingPath[APlatform] := TempRawCppPath; + + case APlatform of + bpWin32: + if clBcc32c in CommandLineTools then + Result := Result and AddToCppBrowsingPath(Path, bpWin32c); + bpWin64: + if clBcc64x in CommandLineTools then + Result := Result and AddToCppBrowsingPath(Path, bpWin64x); + end; + end + else + Result := False; +end; + +function TJclBDSInstallation.AddToCppSearchPath(const Path: string; APlatform: TJclBDSPlatform): Boolean; +var + TempRawCppPath: TJclBorRADToolPath; +begin + CheckCBuilderPlatform(APlatform); + + if Path <> '' then + begin + TempRawCppPath := RawCppSearchPath[APlatform]; + PathListIncludeItems(TempRawCppPath, Path); + Result := True; + RawCppSearchPath[APlatform] := TempRawCppPath; + + case APlatform of + bpWin32: + if clBcc32c in CommandLineTools then + Result := Result and AddToCppSearchPath(Path, bpWin32c); + bpWin64: + if clBcc64x in CommandLineTools then + Result := Result and AddToCppSearchPath(AdjustPathForWin64X(Path), bpWin64x); + end; + end + else + Result := False; +end; + +function TJclBDSInstallation.AddToCppLibraryPath(const Path: string; APlatform: TJclBDSPlatform): Boolean; +var + TempRawLibraryPath: TJclBorRADToolPath; +begin + CheckCBuilderPlatform(APlatform); + + if (IDEVersionNumber >= 5) and (Path <> '') then + begin + TempRawLibraryPath := RawCppLibraryPath[APlatform]; + PathListIncludeItems(TempRawLibraryPath, Path); + Result := True; + RawCppLibraryPath[APlatform] := TempRawLibraryPath; + + case APlatform of + bpWin32: + if clBcc32c in CommandLineTools then + Result := Result and AddToCppLibraryPath(Path, bpWin32c); + bpWin64: + if clBcc64x in CommandLineTools then + Result := Result and AddToCppLibraryPath(AdjustPathForWin64X(Path), bpWin64x); + end; + end + else + Result := False; +end; + +function TJclBDSInstallation.AddToCppIncludePath(const Path: string; APlatform: TJclBDSPlatform): Boolean; +var + TempRawIncludePath: TJclBorRADToolPath; +begin + CheckCBuilderPlatform(APlatform); + + if (IDEVersionNumber >= 5) and (Path <> '') then + begin + TempRawIncludePath := RawCppIncludePath[APlatform]; + PathListIncludeItems(TempRawIncludePath, Path); + Result := True; + RawCppIncludePath[APlatform] := TempRawIncludePath; + + case APlatform of + bpWin32: + if clBcc32c in CommandLineTools then + Result := Result and AddToCppIncludePath(Path, bpWin32c); + bpWin64: + if clBcc64x in CommandLineTools then + Result := Result and AddToCppIncludePath(Path, bpWin64x); + end; + end + else + Result := False; +end; + +function TJclBDSInstallation.CleanPackageCache(const BinaryFileName: string): Boolean; +var + FileName, KeyName: string; +begin + Result := True; + + if VersionNumber >= 3 then + begin + FileName := ExtractFileName(BinaryFileName); + + try + OutputString(Format(LoadResString(@RsCleaningPackageCache), [FileName])); + KeyName := PathAddSeparator(ConfigDataLocation) + PackageCacheKeyName + '\' + FileName; + + if RegKeyExists(RootKey, KeyName) then + Result := RegDeleteKeyTree(RootKey, KeyName); + + if Result then + OutputString(LoadResString(@RsCleaningOk)) + else + OutputString(LoadResString(@RsCleaningFailed)); + except + // trap possible exceptions + end; + end; +end; + +function TJclBDSInstallation.CompileDelphiDotNetProject(const ProjectName, + OutputDir: string; PEFormat: TJclBDSPlatform; const ExtraOptions: string): Boolean; +var + DCCILOptions, PlatformOption, PdbOption: string; +begin + if VersionNumber >= 2 then // C#Builder 1 doesn't have any Delphi.net compiler + begin + if IsDelphiProject(ProjectName) then + OutputString(Format(LoadResString(@RsCompilingProject), [ProjectName])) + else + if IsDelphiPackage(ProjectName) then + OutputString(Format(LoadResString(@RsCompilingPackage), [ProjectName])) + else + raise EJclBorRADException.CreateResFmt(@RsENotADelphiProject, [ProjectName]); + + PlatformOption := ''; + case PEFormat of + bpWin32: + if VersionNumber >= 3 then + PlatformOption := 'x86'; + bpWin64: + if VersionNumber >= 3 then + PlatformOption := 'x64' + else + raise EJclBorRADException.CreateRes(@RsEWin64PlatformNotValid); + bpOSX32: + raise EJclBorRADException.CreateRes(@RsEOSXPlatformNotValid); + else + raise EJclBorRADException.CreateRes(@RsEPlatformNotValid); + end; + + if PdbCreate then + PdbOption := '-V' + else + PdbOption := ''; + + DCCILOptions := Format('%s --platform:%s %s', [ExtraOptions, PlatformOption, PdbOption]); + + Result := DCCIL.MakeProject(ProjectName, OutputDir, DCCILOptions); + + if Result then + OutputString(LoadResString(@RsCompilationOk)) + else + OutputString(LoadResString(@RsCompilationFailed)); + end + else + raise EJclBorRADException.CreateRes(@RsENoSupportedPersonality); +end; + +function TJclBDSInstallation.CompileDelphiPackage(const PackageName, BPLPath, DCPPath, ExtraOptions: string): Boolean; +var + NewOptions: string; +begin + if DualPackageInstallation then + begin + if not (bpBCBuilder32 in Personalities) then + raise EJclBorRadException.CreateResFmt(@RsEDualPackageNotSupported, [Name]); + + NewOptions := Format('%s -JL -NB"%s" -NO"%s"', + [ExtraOptions, PathRemoveSeparator(DcpPath), + PathRemoveSeparator(DcpPath)]); + end + else + NewOptions := ExtraOptions; + + Result := inherited CompileDelphiPackage(PackageName, BPLPath, DCPPath, NewOptions); +end; + +function TJclBDSInstallation.CompileDelphiProject(const ProjectName, OutputDir, DcpSearchPath: string): Boolean; +var + ExtraOptions: string; +begin + if VersionNumber <= 2 then + begin + OutputString(Format(LoadResString(@RsCompilingProject), [ProjectName])); + + if not IsDelphiProject(ProjectName) then + raise EJclBorRADException.CreateResFmt(@RsENotADelphiProject, [ProjectName]); + + if MapCreate then + ExtraOptions := '-GD' + else + ExtraOptions := ''; + + Result := DCC32.MakeProject(ProjectName, OutputDir, DcpSearchPath, ExtraOptions) and + ProcessMapFile(BinaryFileName(OutputDir, ProjectName)); + + if Result then + OutputString(LoadResString(@RsCompilationOk)) + else + OutputString(LoadResString(@RsCompilationFailed)); + end + else + Result := inherited CompileDelphiProject(ProjectName, DcpSearchPath, OutputDir); +end; + +function TJclBDSInstallation.GetBDSPlatformValueNameSuffixStr(APlatform: TJclBDSPlatform): string; +begin + Result := ''; + case APlatform of + bpWin32, bpWin64, bpWin64x, bpOSX32, bpOSX64, bpAndroid32, bpAndroid64, bpiOSDevice32, bpiOSDevice64, bpiOSSimulator, bpLinux64: + Result := ''; + bpWin32c: + Result := Clang32Suffix; + else + raise EJclBorRADException.CreateRes(@RsEPlatformNotValid); + end; +end; + +function TJclBDSInstallation.GetBDSPlatformStr(APlatform: TJclBDSPlatform): string; +begin + Result := ''; + case APlatform of + bpWin32: + Result := BDSPlatformWin32; + bpWin32c: + Result := BDSPlatformWin32; // same key name, the IDE uses the Clang32Suffix suffix in value names + bpWin64: + Result := BDSPlatformWin64; + bpWin64x: + Result := BDSPlatformWin64x; + bpOSX32: + Result := BDSPlatformOSX32; + bpOSX64: + Result := BDSPlatformOSX64; + bpAndroid32: + Result := BDSPlatformAndroid32; + bpAndroid64: + Result := BDSPlatformAndroid64; + bpiOSDevice32: + Result := BDSPlatformiOSDevice32; + bpiOSDevice64: + Result := BDSPlatformiOSDevice64; + bpiOSSimulator: + Result := BDSPlatformiOSSimulator; + bpLinux64: + Result := BDSPlatformLinux64; + else + raise EJclBorRADException.CreateRes(@RsEPlatformNotValid); + end; +end; + +function TJclBDSInstallation.GetBPLOutputPath(APlatform: TJclBDSPlatform): string; +begin + CheckPlatform(APlatform); + + // BDS 1 (C#Builder 1) and BDS 2 (Delphi 8) don't have a valid BPL output path + // set in the registry + case IDEVersionNumber of + 1, 2: + Result := PathAddSeparator(GetDefaultProjectsDir) + 'bpl'; + 3, 4: + Result := inherited GetBPLOutputPath(APlatform); + 5, 6, 7: + begin + Result := GetMsBuildEnvOption(MsBuildCBuilderBPLOutputPathNodeName, APlatform, False); + if Result = '' then + Result := GetMsBuildEnvOption(MsBuildWin32DLLOutputPathNodeName, APlatform, False); + end; + else + Result := GetMsBuildEnvOption(MsBuildCBuilderBPLOutputPathNodeName, APlatform, False); + if Result = '' then + Result := GetMsBuildEnvOption(MsBuildDelphiDLLOutputPathNodeName, APlatform, False); + end; +end; + +function TJclBDSInstallation.GetCommonProjectsDir: string; +begin + Result := GetCommonProjectsDirectory(RootDir, IDEVersionNumber); +end; + +class function TJclBDSInstallation.GetCommonProjectsDirectory(const RootDir: string; + IDEVersionNumber: Integer): string; +var + Variables: TStrings; + BDSVersion: PBDSVersionInfo; +begin + if IDEVersionNumber >= 5 then + begin + Result := ''; + + Variables := TStringList.Create; + try + GetRADStudioVars(RootDir, IDEVersionNumber, Variables); + Result := Variables.Values[EnvVariableBDSCOMDIRValueName]; + finally + Variables.Free; + end; + + if Result = '' then + begin + BDSVersion := GetBDSVersionByIDEVersion(IDEVersionNumber); + Result := LoadResStrings(RootDir + '\Bin\coreide' + BDSVersion.CoreIdeVersion + '.', + ['RAD Studio'])[0]; + + Result := Format('%s%s%d.0', + [PathAddSeparator(GetCommonDocumentsFolder), PathAddSeparator(Result), IDEVersionNumber]); + end; + end + else + Result := GetDefaultProjectsDirectory(RootDir, IDEVersionNumber); +end; + +function TJclBDSInstallation.GetCppPathsKeyName(APlatform: TJclBDSPlatform): string; +begin + if IDEVersionNumber >= 5 then + begin + Result := CppPathsV5UpperKeyName; + if (IDEVersionNumber >= 9) then + Result := PathAddSeparator(Result) + GetBDSPlatformStr(APlatform); + end + else + begin + Result := CppPathsKeyName; + end; +end; + +function TJclBDSInstallation.GetCppBrowsingPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; +begin + CheckCBuilderPlatform(APlatform); + if IDEVersionNumber >= 5 then + // use EnvOptions.proj + Result := GetMsBuildEnvOption(MsBuildCBuilderBrowsingPathNodeName, APlatform, False) + else + Result := ConfigData.ReadString(GetCppPathsKeyName(APlatform), CppBrowsingPathValueName, ''); +end; + +function TJclBDSInstallation.GetCppSearchPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; +begin + CheckCBuilderPlatform(APlatform); + // CPP search path is only in the registry + Result := ConfigData.ReadString(GetCppPathsKeyName(APlatform), CppSearchPathValueName, ''); +end; + +function TJclBDSInstallation.GetCppLibraryPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; +begin + CheckCBuilderPlatform(APlatform); + if IDEVersionNumber >= 5 then + // use EnvOptions.proj + Result := GetMsBuildEnvOption(MsBuildCBuilderLibraryPathNodeName, APlatform, False) + else + Result := ConfigData.ReadString(GetCppPathsKeyName(APlatform), CppLibraryPathValueName, ''); +end; + +function TJclBDSInstallation.GetCppIncludePath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; +begin + CheckCBuilderPlatform(APlatform); + if IDEVersionNumber >= 5 then + // use EnvOptions.proj + Result := GetMsBuildEnvOption(MsBuildCBuilderIncludePathNodeName, APlatform, False) + else + Result := ConfigData.ReadString(GetCppPathsKeyName(APlatform), CppIncludePathValueName, ''); +end; + +function TJclBDSInstallation.GetDCC64: TJclDCC64; +begin + if not Assigned(FDCC64) then + begin + if not (clDcc64 in CommandLineTools) then + raise EJclBorRadException.CreateResFmt(@RsENotFound, [Dcc64ExeName]); + FDCC64 := TJclDCC64.Create(BinFolderName, LongPathBug, DCCVersion, CompilerSettingsFormat, + SupportsNoConfig, SupportsPlatform, DCPOutputPath[bpWin64], LibFolderName[bpWin64], + LibDebugFolderName[bpWin64], ObjFolderName[bpWin64]); + end; + Result := FDCC64; +end; + +function TJclBDSInstallation.GetDCCOSX32: TJclDCCOSX32; +begin + if not Assigned(FDCCOSX32) then + begin + if not (clDccOSX32 in CommandLineTools) then + raise EJclBorRadException.CreateResFmt(@RsENotFound, [DccOSX32ExeName]); + FDCCOSX32 := TJclDCCOSX32.Create(BinFolderName, LongPathBug, DCCVersion, CompilerSettingsFormat, + SupportsNoConfig, SupportsPlatform, DCPOutputPath[bpOSX32], LibFolderName[bpOSX32], + LibDebugFolderName[bpOSX32], ObjFolderName[bpOSX32]); + end; + Result := FDCCOSX32; +end; + +function TJclBDSInstallation.GetDCCOSX64: TJclDCCOSX64; +begin + if not Assigned(FDCCOSX64) then + begin + if not (clDccOSX64 in CommandLineTools) then + raise EJclBorRadException.CreateResFmt(@RsENotFound, [DccOSX64ExeName]); + FDCCOSX64 := TJclDCCOSX64.Create(BinFolderName, LongPathBug, DCCVersion, CompilerSettingsFormat, + SupportsNoConfig, SupportsPlatform, DCPOutputPath[bpOSX64], LibFolderName[bpOSX64], + LibDebugFolderName[bpOSX64], ObjFolderName[bpOSX64]); + end; + Result := FDCCOSX64; +end; + +function TJclBDSInstallation.GetDCCiOSSimulator: TJclDCCiOSSimulator; +begin + if not Assigned(FDCCiOSSimulator) then + begin + if not (clDcciOSSimulator in CommandLineTools) then + raise EJclBorRadException.CreateResFmt(@RsENotFound, [DCCiOSSimulatorExeName]); + FDCCiOSSimulator := TJclDCCiOSSimulator.Create(BinFolderName, LongPathBug, DCCVersion, CompilerSettingsFormat, + SupportsNoConfig, SupportsPlatform, DCPOutputPath[bpiOSSimulator], LibFolderName[bpiOSSimulator], + LibDebugFolderName[bpiOSSimulator], ObjFolderName[bpiOSSimulator]); + end; + Result := FDCCiOSSimulator; +end; + +function TJclBDSInstallation.GetDCCiOS32: TJclDCCiOS32; +begin + if not Assigned(FDCCiOS32) then + begin + if not (clDcciOS32 in CommandLineTools) then + raise EJclBorRadException.CreateResFmt(@RsENotFound, [DCCiOS32ExeName]); + FDCCiOS32 := TJclDCCiOS32.Create(BinFolderName, LongPathBug, DCCVersion, CompilerSettingsFormat, + SupportsNoConfig, SupportsPlatform, DCPOutputPath[bpiOSDevice32], LibFolderName[bpiOSDevice32], + LibDebugFolderName[bpiOSDevice32], ObjFolderName[bpiOSDevice32]); + end; + Result := FDCCiOS32; +end; + +function TJclBDSInstallation.GetDCCiOS64: TJclDCCiOS64; +begin + if not Assigned(FDCCiOS64) then + begin + if not (clDcciOS64 in CommandLineTools) then + raise EJclBorRadException.CreateResFmt(@RsENotFound, [DCCiOS64ExeName]); + FDCCiOS64 := TJclDCCiOS64.Create(BinFolderName, LongPathBug, DCCVersion, CompilerSettingsFormat, + SupportsNoConfig, SupportsPlatform, DCPOutputPath[bpiOSDevice64], LibFolderName[bpiOSDevice64], + LibDebugFolderName[bpiOSDevice64], ObjFolderName[bpiOSDevice64]); + end; + Result := FDCCiOS64; +end; + +function TJclBDSInstallation.GetDCCArm32: TJclDCCArm32; +begin + if not Assigned(FDCCArm32) then + begin + if not (clDccArm32 in CommandLineTools) then + raise EJclBorRadException.CreateResFmt(@RsENotFound, [DCCArm32ExeName]); + FDCCArm32 := TJclDCCArm32.Create(BinFolderName, LongPathBug, DCCVersion, CompilerSettingsFormat, + SupportsNoConfig, SupportsPlatform, DCPOutputPath[bpAndroid32], LibFolderName[bpAndroid32], + LibDebugFolderName[bpAndroid32], ObjFolderName[bpAndroid32]); + end; + Result := FDCCArm32; +end; + +function TJclBDSInstallation.GetDCCArm64: TJclDCCArm64; +begin + if not Assigned(FDCCArm64) then + begin + if not (clDccArm64 in CommandLineTools) then + raise EJclBorRadException.CreateResFmt(@RsENotFound, [DCCArm64ExeName]); + FDCCArm64 := TJclDCCArm64.Create(BinFolderName, LongPathBug, DCCVersion, CompilerSettingsFormat, + SupportsNoConfig, SupportsPlatform, DCPOutputPath[bpAndroid64], LibFolderName[bpAndroid64], + LibDebugFolderName[bpAndroid64], ObjFolderName[bpAndroid64]); + end; + Result := FDCCArm64; +end; + +function TJclBDSInstallation.GetDCCLinux64: TJclDCCLinux64; +begin + if not Assigned(FDCCLinux64) then + begin + if not (clDccLinux64 in CommandLineTools) then + raise EJclBorRadException.CreateResFmt(@RsENotFound, [DCCLinux64ExeName]); + FDCCLinux64 := TJclDCCLinux64.Create(BinFolderName, LongPathBug, DCCVersion, CompilerSettingsFormat, + SupportsNoConfig, SupportsPlatform, DCPOutputPath[bpLinux64], LibFolderName[bpLinux64], + LibDebugFolderName[bpLinux64], ObjFolderName[bpLinux64]); + end; + Result := FDCCLinux64; +end; + +function TJclBDSInstallation.GetBCC32C: TJclBCC32C; +begin + if not Assigned(FBCC32C) then + begin + if not (clBcc32c in CommandLineTools) then + raise EJclBorRadException.CreateResFmt(@RsENotFound, [Bcc32cExeName]); + FBCC32C := TJclBCC32C.Create(BinFolderName, LongPathBug, CompilerSettingsFormat); + //SupportsNoConfig, SupportsPlatform, DCPOutputPath[bpWin32c], LibFolderName[bpWin32c], + //LibDebugFolderName[bpWin32c], ObjFolderName[bpWin32c]); + end; + Result := FBCC32C; +end; + +function TJclBDSInstallation.GetBCC64: TJclBCC64; +begin + if not Assigned(FBCC64) then + begin + if not (clBcc64 in CommandLineTools) then + raise EJclBorRadException.CreateResFmt(@RsENotFound, [Bcc64ExeName]); + FBCC64 := TJclBCC64.Create(BinFolderName, LongPathBug, CompilerSettingsFormat); + //SupportsNoConfig, SupportsPlatform, DCPOutputPath[bpWin64], LibFolderName[bpWin64], + //LibDebugFolderName[bpWin64], ObjFolderName[bpWin64]); + end; + Result := FBCC64; +end; + +function TJclBDSInstallation.GetBCC64X: TJclBCC64X; +begin + if not Assigned(FBCC64X) then + begin + if not (clBcc64x in CommandLineTools) then + raise EJclBorRadException.CreateResFmt(@RsENotFound, [Bcc64xExeName]); + FBCC64X := TJclBCC64X.Create(PathAddSeparator(PathRemoveSeparator(BinFolderName) + '64'), LongPathBug, CompilerSettingsFormat); + //SupportsNoConfig, SupportsPlatform, DCPOutputPath[bpWin64x], LibFolderName[bpWin64x], + //LibDebugFolderName[bpWin64x], ObjFolderName[bpWin64x]); + end; + Result := FBCC64X; +end; + +function TJclBDSInstallation.GetDCCIL: TJclDCCIL; +begin + if not Assigned(FDCCIL) then + begin + if not (clDccIL in CommandLineTools) then + raise EJclBorRadException.CreateResFmt(@RsENotFound, [DccILExeName]); + FDCCIL := TJclDCCIL.Create(BinFolderName, LongPathBug, DCCVersion, CompilerSettingsFormat, + SupportsNoConfig, SupportsPlatform, DCPOutputPath[bpWin32], LibFolderName[bpWin32], LibDebugFolderName[bpWin32], ObjFolderName[bpWin32]); + end; + Result := FDCCIL; +end; + +function TJclBDSInstallation.GetDCPOutputPath(APlatform: TJclBDSPlatform): string; +begin + CheckPlatform(APlatform); + + case IDEVersionNumber of + 1, 2: + // hard-coded + Result := PathAddSeparator(RootDir) + 'lib'; + 3, 4: + // use registry + Result := inherited GetDCPOutputPath(APlatform); + 5, 6, 7: + // use EnvOptions.proj + Result := GetMsBuildEnvOption(MsBuildWin32DCPOutputNodeName, APlatform, False); + else + // use EnvOptions.proj + Result := GetMsBuildEnvOption(MsBuildDelphiDCPOutputNodeName, APlatform, False); + end; +end; + +function TJclBDSInstallation.GetDebugDCUPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; +begin + CheckPlatform(APlatform); + + if IDEVersionNumber >= 8 then + begin + // use EnvOptions.proj + Result := GetMsBuildEnvOption(MsBuildDelphiDebugDCUPathNodeName, APlatform, False); + if Result = '' then + begin + //Fallback to registry when EnvOptions.prj is not updated + Result := ConfigData.ReadString(LibraryKeyName + '\' + GetBDSPlatformStr(APlatform), BDSDebugDCUPathValueName, ''); + end; + end + else + if IDEVersionNumber >= 5 then + // use EnvOptions.proj + Result := GetMsBuildEnvOption(MsBuildWin32DebugDCUPathNodeName, APlatform, False) + else + // use registry + Result := ConfigData.ReadString(LibraryKeyName, BDSDebugDCUPathValueName, ''); +end; + +function TJclBDSInstallation.GetDefaultProjectsDir: string; +begin + Result := GetDefaultProjectsDirectory(RootDir, IDEVersionNumber); +end; + +class function TJclBDSInstallation.GetDefaultProjectsDirectory(const RootDir: string; + IDEVersionNumber: Integer): string; +var + LocStr: WideStringArray; + BDSVersion: PBDSVersionInfo; +begin + BDSVersion := GetBDSVersionByIDEVersion(IDEVersionNumber); + LocStr := LoadResStrings(RootDir + '\Bin\coreide' + BDSVersion.CoreIdeVersion + '.', + ['Borland Studio Projects', 'RAD Studio', 'Projects']); + + if IDEVersionNumber < 5 then + Result := LocStr[0] + else + Result := LocStr[1] + NativeBackslash + LocStr[2]; + + Result := PathAddSeparator(GetPersonalFolder) + Result; +end; + +function TJclBDSInstallation.GetEnvironmentVariables: TStrings; +var + UserVariables: TStrings; + Index: Integer; + EnvOptionName, EnvOptionValue: string; +begin + if not Assigned(FEnvironmentVariables) then + begin + Result := inherited GetEnvironmentVariables; + if Assigned(Result) and (IDEVersionNumber >= 5) then + begin + UserVariables := TStringList.Create; + try + UserVariables.Assign(Result); + Result.Clear; + GetRADStudioVars(RootDir, IDEVersionNumber, Result); + for Index := 0 to UserVariables.Count - 1 do + begin + EnvOptionName := UserVariables.Names[Index]; + EnvOptionValue := UserVariables.Values[EnvOptionName]; + ExpandEnvironmentVarCustom(EnvOptionValue, Result); + Result.Values[EnvOptionName] := EnvOptionValue; + end; + finally + UserVariables.Free; + end; + end + else + if Assigned(Result) then + begin + // adding default values + if Result.Values[EnvVariableBDSValueName] = '' then + Result.Values[EnvVariableBDSValueName] := PathRemoveSeparator(RootDir); + if Result.Values[EnvVariableBDSPROJDIRValueName] = '' then + Result.Values[EnvVariableBDSPROJDIRValueName] := DefaultProjectsDir; + if Result.Values[EnvVariableBDSCOMDIRValueName] = '' then + Result.Values[EnvVariableBDSCOMDIRValueName] := CommonProjectsDir; + end; + end + else + Result := FEnvironmentVariables; +end; + +function TJclBDSInstallation.GetIsDcc64: Boolean; +begin + Result := FDCC = FDCC64; +end; + +class function TJclBDSInstallation.GetLatestUpdatePackForVersion(Version: Integer): Integer; +begin + case Version of + 9: + Result := 1; // personal version is only update pack 1 + 10: + Result := 1; // update 1 is out + else + Result := 0; + end; +end; + +function TJclBDSInstallation.GetLibDebugFolderName(APlatform: TJclBDSPlatform): string; +begin + CheckPlatform(APlatform); + + if (RadToolKind = brBorlandDevStudio) and (VersionNumber >= 8) then + Result := PathAddSeparator(RootDir) + PathAddSeparator('lib\' + GetBDSPlatformStr(APlatform) + '\debug') + else + Result := inherited GetLibDebugFolderName(APlatform); +end; + +function TJclBDSInstallation.GetLibFolderName(APlatform: TJclBDSPlatform): string; +begin + CheckPlatform(APlatform); + + if (RadToolKind = brBorlandDevStudio) and (VersionNumber >= 8) then + Result := PathAddSeparator(RootDir) + PathAddSeparator('lib\' + GetBDSPlatformStr(APlatform) + '\release') + else + Result := inherited GetLibFolderName(APlatform); +end; + +class procedure TJclBDSInstallation.InterpretSetVariable(const Line: string; Variables: TStrings); + + function SkipWhitespaces(P: PChar): PChar; + begin + Result := P; + while True do + case Result^ of + #1..#32: Inc(Result); + else + Break; + end; + end; + + function SkipWhitespacesAndAtSign(P: PChar): PChar; + begin + Result := P; + while True do + case Result^ of + #1..#32, '@': Inc(Result); + else + Break; + end; + end; + +var + F, P: PChar; + VarName, VarValue: string; + S: string; +begin + // parse "[@]set name=value" + + F := SkipWhitespacesAndAtSign(PChar(Line)); + P := F; + while P^ > #32 do + Inc(P); + if (P^ <> #0) and (StrLIComp('set', F, P - F) = 0) then + begin + // extract Variablen name + P := SkipWhitespaces(P); + F := P; + while (P^ <> #0) and (P^ <> '=') do + Inc(P); + if P^ <> #0 then // "set Variable" only outputs the variables so ignore it + begin + SetString(VarName, F, P - F); // the batch interpreter includes trailing whitespaces and so do we + if VarName <> '' then + begin + // extract variable value and resolve macros + VarValue := ''; + F := P + 1; + P := F; + while P^ <> #0 do + begin + // fast forward + while True do + begin + case P^ of + #0, '%': Break; + end; + Inc(P); + end; + + if P^ = #0 then + Break; + + // append already parsed substring + if P - F > 0 then + begin + SetString(S, F, P - F); + VarValue := VarValue + S; + end; + + // append resolved macro + Inc(P); + F := P; + while (P^ <> #0) and (P^ <> '%') do + Inc(P); + SetString(S, F, P - F); + VarValue := VarValue + Variables.Values[S]; + + if P^ <> #0 then + Inc(P); + F := P; + end; + + // append remaining substring + if P - F > 0 then + begin + SetString(S, F, P - F); + VarValue := VarValue + S; + end; + + Variables.Values[VarName] := VarValue; + if VarValue = '' then // empty VarValue removes the item from Variables but we must keep the overwrite for correctness + Variables.Add(VarName + '='); + end; + end; + end; +end; + +class procedure TJclBDSInstallation.GetRADStudioVars(const RootDir: string; IDEVersionNumber: Integer; Variables: TStrings); +var + Lines: TStrings; + I: Integer; +begin + if IDEVersionNumber >= 5 then + begin + GetEnvironmentVars(Variables); + + // Parse the rsvars.bat what is much faster than creating a cmd.exe process that could even fail + // to start leaving the user with an empty "RsVarsError" string. (Mantis #6282) + Lines := TStringList.Create; + try + Lines.LoadFromFile(GetRADStudioVarsFileName(RootDir, IDEVersionNumber)); + // Interpret "[@]SET ...=..." + for I := 0 to Lines.Count - 1 do + InterpretSetVariable(Lines[I], Variables); + finally + Lines.Free; + end; + end; +end; + +class function TJclBDSInstallation.GetRADStudioVarsFileName(const RootDir: string; IDEVersionNumber: Integer): TFileName; +begin + if IDEVersionNumber >= 5 then + Result := Format('%s%sbin%srsvars.bat', [RootDir, DirDelimiter, DirDelimiter]) + else + raise EJclBorRADException.CreateResFmt(@RsERsVars, [RadToolName(IDEVersionNumber), IDEVersionNumber, LoadResString(@RsMsBuildNotSupported)]); +end; + +function TJclBDSInstallation.GetValid: Boolean; +begin + Result := inherited GetValid; + if Result and (IDEVersionNumber >= 5) then + Result := FileExists(GetMsBuildEnvOptionsFileName) and FileExists(GetRADStudioVarsFileName(RootDir, IDEVersionNumber)); +end; + +function TJclBDSInstallation.GetLibraryBrowsingPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; +begin + CheckPlatform(APlatform); + + if IDEVersionNumber >= 8 then + begin + // use EnvOptions.proj + Result := GetMsBuildEnvOption(MsBuildDelphiBrowsingPathNodeName, APlatform, False); + if Result = '' then + begin + //Fallback to registry when EnvOptions.prj is not updated + Result := ConfigData.ReadString(LibraryKeyName + '\' + GetBDSPlatformStr(APlatform), LibraryBrowsingPathValueName, ''); + end; + end + else + if IDEVersionNumber >= 5 then + // use EnvOptions.proj + Result := GetMsBuildEnvOption(MsBuildWin32BrowsingPathNodeName, APlatform, False) + else + // use registry + Result := inherited GetLibraryBrowsingPath(APlatform); +end; + +function TJclBDSInstallation.GetLibrarySearchPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; +begin + CheckPlatform(APlatform); + + if IDEVersionNumber >= 8 then + begin + // use EnvOptions.proj + Result := GetMsBuildEnvOption(MsBuildDelphiLibraryPathNodeName, APlatform, False); + if Result = '' then + begin + //Fallback to registry when EnvOptions.prj is not updated + Result := ConfigData.ReadString(LibraryKeyName + '\' + GetBDSPlatformStr(APlatform), LibrarySearchPathValueName, ''); + end; + end + else + if IDEVersionNumber >= 5 then + // use EnvOptions.proj + Result := GetMsBuildEnvOption(MsBuildWin32LibraryPathNodeName, APlatform, False) + else + // use registry + Result := inherited GetLibrarySearchPath(APlatform); +end; + +function TJclBDSInstallation.GetMaxDelphiCLRVersion: string; +begin + Result := DCCIL.MaxCLRVersion; +end; + +function TJclBDSInstallation.GetName: string; +var + BDSVersion: PBDSVersionInfo; +begin + BDSVersion := GetBDSVersionByIDEVersion(IDEVersionNumber); + if Assigned(BDSVersion) then + Result := Format('%s %s', [RadToolName, BDSVersion.VersionStr]) + else + Result := Format('%s ***%d***', [RadToolName, IDEVersionNumber]); +end; + +function TJclBDSInstallation.GetMsBuildEnvironmentFileName: string; +begin + Result := PathAddSeparator(ExtractFilePath(GetMsBuildEnvOptionsFileName)) + 'environment.proj'; +end; + +function TJclBDSInstallation.GetMsBuildEnvOption(const OptionName: string; APlatform: TJclBDSPlatform; Raw: Boolean): string; +var + EnvOptions: TJclMsBuildParser; + MsBuildEnvironmentFileName: string; +begin + Result := ''; + + if IDEVersionNumber < 5 then + raise EJclBorRADException.CreateResFmt(@RsERsVars, [RadToolName(IDEVersionNumber), IDEVersionNumber, LoadResString(@RsMsBuildNotSupported)]); + + MsBuildEnvironmentFileName := GetMsBuildEnvironmentFileName; + + if FileExists(MsBuildEnvironmentFileName) then + EnvOptions := TJclMsBuildParser.Create(GetMsBuildEnvOptionsFileName, [MsBuildEnvironmentFileName]) + else + EnvOptions := TJclMsBuildParser.Create(GetMsBuildEnvOptionsFileName); + try + EnvOptions.Init; + + // add custom "environment" variables + EnvOptions.Properties.MergeEnvironmentProperties(EnvironmentVariables); + + if SupportsPlatform then + EnvOptions.Properties.GlobalProperties.Values['Platform'] := GetBDSPlatformStr(APlatform); + EnvOptions.Parse; + + if Raw then + Result := EnvOptions.Properties.RawValues[OptionName] + else + Result := EnvOptions.Properties.Values[OptionName]; + finally + EnvOptions.Free; + end; +end; + +function TJclBDSInstallation.GetMsBuildEnvOptionsFileName: string; +var + AppdataFolder: string; +begin + if IDEVersionNumber >= 5 then + begin + if (RootKey = 0) or (RootKey = HKCU) then + AppdataFolder := GetAppdataFolder + else + AppdataFolder := RegReadString(RootKey, 'Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders', 'AppData'); + + if IDEVersionNumber >= 8 then + Result := Format('%sEmbarcadero\BDS\%d.0\EnvOptions.proj', + [PathAddSeparator(AppdataFolder), IDEVersionNumber]) + else + if IDEVersionNumber >= 6 then + Result := Format('%sCodeGear\BDS\%d.0\EnvOptions.proj', + [PathAddSeparator(AppdataFolder), IDEVersionNumber]) + else + Result := Format('%sBorland\BDS\%d.0\EnvOptions.proj', + [PathAddSeparator(AppdataFolder), IDEVersionNumber]); + end + else + raise EJclBorRADException.CreateRes(@RsMsBuildNotSupported); +end; + +function TJclBDSInstallation.GetRawCppBrowsingPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; +begin + CheckCBuilderPlatform(APlatform); + + if IDEVersionNumber >= 5 then + // use EnvOptions.proj + Result := GetMsBuildEnvOption(MsBuildCBuilderBrowsingPathNodeName + GetBDSPlatformValueNameSuffixStr(APlatform), APlatform, True) + else + Result := ConfigData.ReadString(GetCppPathsKeyName(APlatform), CppBrowsingPathValueName + GetBDSPlatformValueNameSuffixStr(APlatform), ''); +end; + +function TJclBDSInstallation.GetRawCppSearchPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; +begin + CheckCBuilderPlatform(APlatform); + + Result := GetCppSearchPath(APlatform); +end; + +function TJclBDSInstallation.GetRawCppLibraryPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; +begin + CheckCBuilderPlatform(APlatform); + + if IDEVersionNumber >= 5 then + // use EnvOptions.proj + Result := GetMsBuildEnvOption(MsBuildCBuilderLibraryPathNodeName + GetBDSPlatformValueNameSuffixStr(APlatform), APlatform, True) + else + Result := ConfigData.ReadString(GetCppPathsKeyName(APlatform), CppLibraryPathValueName + GetBDSPlatformValueNameSuffixStr(APlatform), ''); +end; + +function TJclBDSInstallation.GetRawCppIncludePath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; +begin + CheckCBuilderPlatform(APlatform); + + if IDEVersionNumber >= 5 then + // use EnvOptions.proj + Result := GetMsBuildEnvOption(MsBuildCBuilderIncludePathNodeName + GetBDSPlatformValueNameSuffixStr(APlatform), APlatform, True) + else + Result := ConfigData.ReadString(GetCppPathsKeyName(APlatform), CppIncludePathValueName + GetBDSPlatformValueNameSuffixStr(APlatform), ''); +end; + +function TJclBDSInstallation.GetRawDebugDCUPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; +begin + CheckPlatform(APlatform); + + if IDEVersionNumber >= 8 then + begin + // use EnvOptions.proj + Result := GetMsBuildEnvOption(MsBuildDelphiDebugDCUPathNodeName, APlatform, True); + if Result = '' then + begin + //Fallback to registry when EnvOptions.prj is not updated + Result := ConfigData.ReadString(LibraryKeyName + '\' + GetBDSPlatformStr(APlatform), BDSDebugDCUPathValueName, ''); + end; + end + else + if IDEVersionNumber >= 5 then + // use EnvOptions.proj + Result := GetMsBuildEnvOption(MsBuildWin32DebugDCUPathNodeName, APlatform, True) + else + // use registry + Result := ConfigData.ReadString(LibraryKeyName, BDSDebugDCUPathValueName, ''); +end; + +function TJclBDSInstallation.GetRawLibraryBrowsingPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; +begin + CheckPlatform(APlatform); + + if IDEVersionNumber >= 8 then + begin + // use EnvOptions.proj + Result := GetMsBuildEnvOption(MsBuildDelphiBrowsingPathNodeName, APlatform, True); + if Result = '' then + begin + //Fallback to registry when EnvOptions.prj is not updated + Result := ConfigData.ReadString(LibraryKeyName + '\' + GetBDSPlatformStr(APlatform), LibraryBrowsingPathValueName, ''); + end; + end + else + if IDEVersionNumber >= 5 then + // use EnvOptions.proj + Result := GetMsBuildEnvOption(MsBuildWin32BrowsingPathNodeName, APlatform, True) + else + // use registry + Result := inherited GetRawLibraryBrowsingPath(APlatform); +end; + +function TJclBDSInstallation.GetRawLibrarySearchPath(APlatform: TJclBDSPlatform): TJclBorRADToolPath; +begin + CheckPlatform(APlatform); + + if IDEVersionNumber >= 8 then + begin + // use EnvOptions.proj + Result := GetMsBuildEnvOption(MsBuildDelphiLibraryPathNodeName, APlatform, True); + if Result = '' then + begin + //Fallback to registry when EnvOptions.prj is not updated + Result := ConfigData.ReadString(LibraryKeyName + '\' + GetBDSPlatformStr(APlatform), LibrarySearchPathValueName, ''); + end; + end + else + if IDEVersionNumber >= 5 then + // use EnvOptions.proj + Result := GetMsBuildEnvOption(MsBuildWin32LibraryPathNodeName, APlatform, True) + else + // use registry + Result := inherited GetRawLibrarySearchPath(APlatform); +end; + +function TJclBDSInstallation.GetVclIncludeDir(APlatform: TJclBDSPlatform): string; +begin + CheckCBuilderPlatform(APlatform); + + if (RadToolKind = brBorlandDevStudio) and (IDEVersionNumber >= 8) then + begin + CheckPlatform(APlatform); + Result := GetMsBuildEnvOption(MsBuildDelphiHPPOutputPathNodeName, APlatform, False); + if Result = '' then + Result := SubstitutePath('$(BDSCOMMONDIR)\hpp'); + end + else + Result := inherited GetVclIncludeDir(APlatform); +end; + +class function TJclBDSInstallation.PackageSourceFileExtension: string; +begin + Result := SourceExtensionDelphiPackage; +end; + +class function TJclBDSInstallation.ProjectSourceFileExtension: string; +begin + Result := SourceExtensionDelphiProject; +end; + +class function TJclBDSInstallation.RadToolKind: TJclBorRadToolKind; +begin + Result := brBorlandDevStudio; +end; + +class function TJclBDSInstallation.RadToolName( + IDEVersionNumber: Integer): string; +var + BDSVersion: PBDSVersionInfo; +begin + BDSVersion := GetBDSVersionByIDEVersion(IDEVersionNumber); + if Assigned(BDSVersion) then + Result := LoadResString(BDSVersion.Name) + else + Result := LoadResString(@RsBDSName); +end; + +function TJclBDSInstallation.RadToolName: string; +var + BDSVersion: PBDSVersionInfo; +begin + // The name comes from IDEVersionNumber + Result := RadToolName(IDEVersionNumber); + + BDSVersion := GetBDSVersionByIDEVersion(IDEVersionNumber); + if Assigned(BDSVersion) then + begin + // IDE Version 5 comes in three flavors: + // - Delphi only (Spacely) + // - C++Builder only (Cogswell) + // - Delphi and C++Builder + if (IDEVersionNumber = 5) and (Personalities = [bpDelphi32]) then + Result := LoadResString(@RsDelphiName) + else + if (IDEVersionNumber = 5) and (Personalities = [bpBCBuilder32]) then + Result := LoadResString(@RsBCBName); + end; +end; + +function TJclBDSInstallation.RegisterPackage(const BinaryFileName, Description: string): Boolean; +begin + if VersionNumber >= 3 then + CleanPackageCache(BinaryFileName); + + Result := inherited RegisterPackage(BinaryFileName, Description); +end; + +function TJclBDSInstallation.RemoveFromCppBrowsingPath(const Path: string; APlatform: TJclBDSPlatform): Boolean; +var + TempRawCppPath: TJclBorRADToolPath; +begin + CheckCBuilderPlatform(APlatform); + + if Path <> '' then + begin + TempRawCppPath := RawCppBrowsingPath[APlatform]; + Result := RemoveFromPath(TempRawCppPath, Path); + RawCppBrowsingPath[APlatform] := TempRawCppPath; + + case APlatform of + bpWin32: + if clBcc32c in CommandLineTools then + Result := Result and RemoveFromCppBrowsingPath(Path, bpWin32c); + bpWin64: + if clBcc64x in CommandLineTools then + Result := Result and RemoveFromCppBrowsingPath(Path, bpWin64x); + end; + end + else + Result := False; +end; + +function TJclBDSInstallation.RemoveFromCppSearchPath(const Path: string; APlatform: TJclBDSPlatform): Boolean; +var + TempRawCppPath: TJclBorRADToolPath; +begin + CheckCBuilderPlatform(APlatform); + + if Path <> '' then + begin + TempRawCppPath := RawCppSearchPath[APlatform]; + Result := RemoveFromPath(TempRawCppPath, Path); + RawCppSearchPath[APlatform] := TempRawCppPath; + + case APlatform of + bpWin32: + if clBcc32c in CommandLineTools then + Result := Result and RemoveFromCppSearchPath(Path, bpWin32c); + bpWin64: + if clBcc64x in CommandLineTools then + Result := Result and RemoveFromCppSearchPath(AdjustPathForWin64X(Path), bpWin64x); + end; + end + else + Result := False; +end; + +function TJclBDSInstallation.RemoveFromCppLibraryPath(const Path: string; APlatform: TJclBDSPlatform): Boolean; +var + TempRawLibraryPath: TJclBorRADToolPath; +begin + CheckCBuilderPlatform(APlatform); + + if (IDEVersionNumber >= 5) and (Path <> '') then + begin + TempRawLibraryPath := RawCppLibraryPath[APlatform]; + Result := RemoveFromPath(TempRawLibraryPath, Path); + RawCppLibraryPath[APlatform] := TempRawLibraryPath; + + case APlatform of + bpWin32: + if clBcc32c in CommandLineTools then + Result := Result and RemoveFromCppLibraryPath(Path, bpWin32c); + bpWin64: + if clBcc64x in CommandLineTools then + Result := Result and RemoveFromCppLibraryPath(AdjustPathForWin64X(Path), bpWin64x); + end; + end + else + Result := False; +end; + +function TJclBDSInstallation.RemoveFromCppIncludePath(const Path: string; APlatform: TJclBDSPlatform): Boolean; +var + TempRawIncludePath: TJclBorRADToolPath; +begin + CheckCBuilderPlatform(APlatform); + + if (IDEVersionNumber >= 5) and (Path <> '') then + begin + TempRawIncludePath := RawCppIncludePath[APlatform]; + Result := RemoveFromPath(TempRawIncludePath, Path); + RawCppIncludePath[APlatform] := TempRawIncludePath; + + case APlatform of + bpWin32: + if clBcc32c in CommandLineTools then + Result := Result and RemoveFromCppIncludePath(Path, bpWin32c); + bpWin64: + if clBcc64x in CommandLineTools then + Result := Result and RemoveFromCppIncludePath(Path, bpWin64x); + end; + end + else + Result := False; +end; + +procedure TJclBDSInstallation.SetDualPackageInstallation(const Value: Boolean); +begin + if Value and not (bpBCBuilder32 in Personalities) then + raise EJclBorRadException.CreateResFmt(@RsEDualPackageNotSupported, [Name]); + FDualPackageInstallation := Value; +end; + +procedure TJclBDSInstallation.SetMsBuildEnvOption(const OptionName, Value: string; APlatform: TJclBDSPlatform); +var + EnvOptionsFileName, BakEnvOptionsFileName: string; + EnvOptions: TJclMsBuildParser; +begin + if IDEVersionNumber < 5 then + raise EJclBorRADException.CreateResFmt(@RsERsVars, [RadToolName(IDEVersionNumber), IDEVersionNumber, LoadResString(@RsMsBuildNotSupported)]); + + EnvOptionsFileName := GetMsBuildEnvOptionsFileName; + EnvOptions := TJclMsBuildParser.Create(EnvOptionsFileName); + try + EnvOptions.Init; + + // add custom "environment" variables + EnvOptions.Properties.EnvironmentProperties.Assign(EnvironmentVariables); + + if SupportsPlatform then + EnvOptions.Properties.GlobalProperties.Values['Platform'] := GetBDSPlatformStr(APlatform); + EnvOptions.Parse; + + EnvOptions.Properties.RawValues[OptionName] := Value; + + { Do not overwrite the original file if something goes wrong } + BakEnvOptionsFileName := EnvOptionsFileName + '.bak'; + DeleteFile(BakEnvOptionsFileName); + RenameFile(EnvOptionsFileName, BakEnvOptionsFileName); + try + EnvOptions.Xml.Options := EnvOptions.Xml.Options + [sxoDoNotSaveProlog]; + EnvOptions.Save; + DeleteFile(BakEnvOptionsFileName); + except + DeleteFile(EnvOptionsFileName); + RenameFile(BakEnvOptionsFileName, EnvOptionsFileName); + raise; + end; + finally + EnvOptions.Free; + end; +end; + +procedure TJclBDSInstallation.SetOutputCallback(const Value: TTextHandler); +begin + inherited SetOutputCallback(Value); + if clDcc64 in CommandLineTools then + DCC64.OutputCallback := Value; + if clDccOSX32 in CommandLineTools then + DCCOSX32.OutputCallback := Value; + if clDccOSX64 in CommandLineTools then + DCCOSX64.OutputCallback := Value; + if clDcciOSSimulator in CommandLineTools then + DCCiOSSimulator.OutputCallback := Value; + if clDcciOS32 in CommandLineTools then + DCCiOS32.OutputCallback := Value; + if clDcciOS64 in CommandLineTools then + DCCiOS64.OutputCallback := Value; + if clDccArm32 in CommandLineTools then + DCCArm32.OutputCallback := Value; + if clDccArm64 in CommandLineTools then + DCCArm64.OutputCallback := Value; + if clDccLinux64 in CommandLineTools then + DCCLinux64.OutputCallback := Value; + if clBcc64 in CommandLineTools then + BCC64.OutputCallback := Value; + if clDccIL in CommandLineTools then + DCCIL.OutputCallback := Value; +end; + +procedure TJclBDSInstallation.SetRawCppBrowsingPath(APlatform: TJclBDSPlatform; const Value: TJclBorRADToolPath); +begin + CheckCBuilderPlatform(APlatform); + + // update registry + ConfigData.WriteString(GetCppPathsKeyName(APlatform), CppBrowsingPathValueName + GetBDSPlatformValueNameSuffixStr(APlatform), Value); + // update EnvOptions.dproj + if IDEVersionNumber >= 5 then + SetMsBuildEnvOption(MsBuildCBuilderBrowsingPathNodeName + GetBDSPlatformValueNameSuffixStr(APlatform), Value, APlatform); +end; + +procedure TJclBDSInstallation.SetRawCppSearchPath(APlatform: TJclBDSPlatform; const Value: TJclBorRADToolPath); +begin + CheckCBuilderPlatform(APlatform); + ConfigData.WriteString(GetCppPathsKeyName(APlatform), CppSearchPathValueName, Value); +end; + +procedure TJclBDSInstallation.SetRawCppLibraryPath(APlatform: TJclBDSPlatform; const Value: TJclBorRADToolPath); +begin + CheckCBuilderPlatform(APlatform); + + // update registry + ConfigData.WriteString(GetCppPathsKeyName(APlatform), CppLibraryPathValueName + GetBDSPlatformValueNameSuffixStr(APlatform), Value); + // update EnvOptions.dproj + if IDEVersionNumber >= 5 then + SetMsBuildEnvOption(MsBuildCBuilderLibraryPathNodeName + GetBDSPlatformValueNameSuffixStr(APlatform), Value, APlatform); +end; + +procedure TJclBDSInstallation.SetRawCppIncludePath(APlatform: TJclBDSPlatform; const Value: TJclBorRADToolPath); +begin + CheckCBuilderPlatform(APlatform); + + if IDEVersionNumber >= 5 then + begin + // update registry + ConfigData.WriteString(GetCppPathsKeyName(APlatform), CppIncludePathValueName + GetBDSPlatformValueNameSuffixStr(APlatform), Value); + // update EnvOptions.dproj + SetMsBuildEnvOption(MsBuildCBuilderIncludePathNodeName + GetBDSPlatformValueNameSuffixStr(APlatform), Value, APlatform); + end; +end; + +procedure TJclBDSInstallation.SetRawDebugDCUPath(APlatform: TJclBDSPlatform; const Value: TJclBorRADToolPath); +begin + CheckPlatform(APlatform); + + if IDEVersionNumber >= 9 then + begin + // update registry + ConfigData.WriteString(LibraryKeyName + '\' + GetBDSPlatformStr(APlatform), BDSDebugDCUPathValueName, Value); + // update EnvOptions.dproj + SetMsBuildEnvOption(MsBuildDelphiDebugDCUPathNodeName, Value, APlatform); + end + else + begin + // update registry + ConfigData.WriteString(LibraryKeyName, BDSDebugDCUPathValueName, Value); + // update EnvOptions.dproj + if IDEVersionNumber >= 8 then + SetMsBuildEnvOption(MsBuildDelphiDebugDCUPathNodeName, Value, APlatform) + else + if IDEVersionNumber >= 5 then + SetMsBuildEnvOption(MsBuildWin32DebugDCUPathNodeName, Value, APlatform); + end; +end; + +procedure TJclBDSInstallation.SetRawLibraryBrowsingPath(APlatform: TJclBDSPlatform; const Value: TJclBorRADToolPath); +begin + CheckPlatform(APlatform); + + if IDEVersionNumber >= 9 then + begin + // update registry + ConfigData.WriteString(LibraryKeyName + '\' + GetBDSPlatformStr(APlatform), LibraryBrowsingPathValueName, Value); + // update EnvOptions.dproj + SetMsBuildEnvOption(MsBuildDelphiBrowsingPathNodeName, Value, APlatform); + end + else + begin + // update registry + ConfigData.WriteString(LibraryKeyName, LibraryBrowsingPathValueName, Value); + // update EnvOptions.dproj + if IDEVersionNumber >= 8 then + SetMsBuildEnvOption(MsBuildDelphiBrowsingPathNodeName, Value, APlatform) + else + if IDEVersionNumber >= 5 then + SetMsBuildEnvOption(MsBuildWin32BrowsingPathNodeName, Value, APlatform); + end; +end; + +procedure TJclBDSInstallation.SetRawLibrarySearchPath(APlatform: TJclBDSPlatform; const Value: TJclBorRADToolPath); +begin + CheckPlatform(APlatform); + + if IDEVersionNumber >= 9 then + begin + // update registry + ConfigData.WriteString(LibraryKeyName + '\' + GetBDSPlatformStr(APlatform), LibrarySearchPathValueName, Value); + // update EnvOptions.dproj + SetMsBuildEnvOption(MsBuildDelphiLibraryPathNodeName, Value, APlatform); + end + else + begin + // update registry + ConfigData.WriteString(LibraryKeyName, LibrarySearchPathValueName, Value); + // update EnvOptions.dproj + if IDEVersionNumber >= 8 then + SetMsBuildEnvOption(MsBuildDelphiLibraryPathNodeName, Value, APlatform) + else + if IDEVersionNumber >= 5 then + SetMsBuildEnvOption(MsBuildWin32LibraryPathNodeName, Value, APlatform); + end; +end; + +function TJclBDSInstallation.UnregisterPackage(const BinaryFileName: string): Boolean; +begin + if IDEVersionNumber >= 3 then + CleanPackageCache(BinaryFileName); + Result := inherited UnregisterPackage(BinaryFileName); +end; + +{$ENDIF MSWINDOWS} + +//=== { TJclBorRADToolInstallations } ======================================== + +constructor TJclBorRADToolInstallations.Create; +begin + FList := TObjectList.Create; + ReadInstallations; +end; + +destructor TJclBorRADToolInstallations.Destroy; +begin + FreeAndNil(FList); + inherited Destroy; +end; + +function TJclBorRADToolInstallations.AnyInstanceRunning: Boolean; +var + I: Integer; +begin + Result := False; + for I := 0 to Count - 1 do + if Installations[I].AnyInstanceRunning then + begin + Result := True; + Break; + end; +end; + +function TJclBorRADToolInstallations.AnyUpdatePackNeeded(var Text: string): Boolean; +var + I: Integer; +begin + Result := False; + for I := 0 to Count - 1 do + if Installations[I].UpdateNeeded then + begin + Result := True; + Text := Format(LoadResString(@RsNeedUpdate), [Installations[I].LatestUpdatePack, Installations[I].Name]); + Break; + end; +end; + +function TJclBorRADToolInstallations.GetCount: Integer; +begin + Result := FList.Count; +end; + +function TJclBorRADToolInstallations.GetBCBInstallationFromVersion(VersionNumber: Integer): TJclBorRADToolInstallation; +var + I: Integer; +begin + Result := nil; + for I := 0 to Count - 1 do + case Installations[I].RadToolKind of + brCppBuilder: + if Installations[I].IDEVersionNumber = VersionNumber then + begin + Result := Installations[I]; + Break; + end; + brBorlandDevStudio: + if Installations[I].IDEPackageVersionNumber = VersionNumber then + begin + Result := Installations[I]; + Break; + end; + end; +end; + +function TJclBorRADToolInstallations.GetDelphiInstallationFromVersion( + VersionNumber: Integer): TJclBorRADToolInstallation; +var + I: Integer; +begin + Result := nil; + for I := 0 to Count - 1 do + case Installations[I].RadToolKind of + brDelphi: + if Installations[I].IDEVersionNumber = VersionNumber then + begin + Result := Installations[I]; + Break; + end; + brBorlandDevStudio: + if Installations[I].IDEPackageVersionNumber = VersionNumber then + begin + Result := Installations[I]; + Break; + end; + end; +end; + +function TJclBorRADToolInstallations.GetInstallations(Index: Integer): TJclBorRADToolInstallation; +begin + Result := TJclBorRADToolInstallation(FList[Index]); +end; + +function TJclBorRADToolInstallations.GetBCBVersionInstalled(VersionNumber: Integer): Boolean; +begin + Result := BCBInstallationFromVersion[VersionNumber] <> nil; +end; + +function TJclBorRADToolInstallations.GetBDSInstallationFromVersion(VersionNumber: Integer): TJclBorRADToolInstallation; +var + I: Integer; +begin + Result := nil; + for I := 0 to Count - 1 do + if (Installations[I].IDEVersionNumber = VersionNumber) and + (Installations[I].RadToolKind = brBorlandDevStudio) then + begin + Result := Installations[I]; + Break; + end; +end; + +function TJclBorRADToolInstallations.GetBDSVersionInstalled(VersionNumber: Integer): Boolean; +begin + Result := BDSInstallationFromVersion[VersionNumber] <> nil; +end; + +function TJclBorRADToolInstallations.GetDelphiVersionInstalled(VersionNumber: Integer): Boolean; +begin + Result := DelphiInstallationFromVersion[VersionNumber] <> nil; +end; + +function TJclBorRADToolInstallations.Iterate(TraverseMethod: TTraverseMethod): Boolean; +var + I: Integer; +begin + Result := True; + for I := 0 to Count - 1 do + Result := Result and TraverseMethod(Installations[I]); +end; + +procedure TJclBorRADToolInstallations.ReadInstallations; +var + VersionNumbers: TStringList; + PreviousRegWOW64AccessMode: TJclRegWOW64Access; + + function EnumVersions(const KeyName: string; const Personalities: array of string; + CreateClass: TJclBorRADToolInstallationClass): Boolean; + var + I, J: Integer; + VersionKeyName, PersonalitiesKeyName: string; + PersonalitiesList: TStrings; + Installation: TJclBorRADToolInstallation; + begin + Result := False; + if RegKeyExists(HKEY_LOCAL_MACHINE, KeyName) and + RegGetKeyNames(HKEY_LOCAL_MACHINE, KeyName, VersionNumbers) then + for I := 0 to VersionNumbers.Count - 1 do + if StrIsSubSet(VersionNumbers[I], CharIsFracDigit) then + begin + VersionKeyName := KeyName + DirDelimiter + VersionNumbers[I]; + if RegKeyExists(HKEY_LOCAL_MACHINE, VersionKeyName) then + begin + if Length(Personalities) = 0 then + begin + try + Installation := CreateClass.Create(VersionKeyName); + if Installation.Valid then + FList.Add(Installation); + finally + Result := True; + end; + end + else + begin + PersonalitiesList := TStringList.Create; + try + PersonalitiesKeyName := VersionKeyName + '\Personalities'; + if RegKeyExists(HKEY_LOCAL_MACHINE, PersonalitiesKeyName) then + RegGetValueNames(HKEY_LOCAL_MACHINE, PersonalitiesKeyName, PersonalitiesList); + + for J := Low(Personalities) to High(Personalities) do + if PersonalitiesList.IndexOf(Personalities[J]) >= 0 then + begin + try + Installation := CreateClass.Create(VersionKeyName); + if Installation.Valid then + FList.Add(Installation) + else + Installation.Free; + finally + Result := True; + end; + Break; + end; + finally + PersonalitiesList.Free; + end; + end; + end; + end; + end; + +begin + FList.Clear; + PreviousRegWOW64AccessMode := RegGetWOW64AccessMode; + VersionNumbers := TStringList.Create; + try + RegSetWOW64AccessMode(ra32Key); + EnumVersions(DelphiKeyName, [], TJclDelphiInstallation); + EnumVersions(BCBKeyName, [], TJclBCBInstallation); + EnumVersions(BDSKeyName, ['Delphi.Win32', 'BCB', 'Delphi8', 'C#Builder'], TJclBDSInstallation); + EnumVersions(CDSKeyName, ['Delphi.Win32', 'BCB', 'Delphi8', 'C#Builder'], TJclBDSInstallation); + EnumVersions(EDSKeyName, ['Delphi.Win32', 'BCB', 'Delphi8', 'C#Builder'], TJclBDSInstallation); + finally + RegSetWOW64AccessMode(PreviousRegWOW64AccessMode); + VersionNumbers.Free; + end; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclIniFiles.pas b/3rdParty/JCL/source/common/JclIniFiles.pas index 8fb68681..82984b9b 100644 --- a/3rdParty/JCL/source/common/JclIniFiles.pas +++ b/3rdParty/JCL/source/common/JclIniFiles.pas @@ -1,191 +1,191 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is JclIniFiles.pas. } -{ } -{ The Initial Developer of the Original Code is John C Molyneux. } -{ Portions created by John C Molyneux are Copyright (C) John C Molyneux. } -{ } -{ Contributors: } -{ Eric S. Fisher } -{ John C Molyneux } -{ Petr Vones (pvones) } -{ Robert Marquardt (marquardt) } -{ Robert Rossmair (rrossmair) } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -unit JclIniFiles; - -{$I jcl.inc} - -interface - -uses - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - {$IFDEF HAS_UNITSCOPE} - System.SysUtils, System.Classes, System.IniFiles; - {$ELSE ~HAS_UNITSCOPE} - SysUtils, Classes, IniFiles; - {$ENDIF ~HAS_UNITSCOPE} - -// Initialization (ini) Files -function IniReadBool(const FileName, Section, Line: string): Boolean; // John C Molyneux -function IniReadInteger(const FileName, Section, Line: string): Integer; // John C Molyneux -function IniReadString(const FileName, Section, Line: string): string; // John C Molyneux -procedure IniWriteBool(const FileName, Section, Line: string; Value: Boolean); // John C Molyneux -procedure IniWriteInteger(const FileName, Section, Line: string; Value: Integer); // John C Molyneux -procedure IniWriteString(const FileName, Section, Line, Value: string); // John C Molyneux - -// Initialization (ini) Files helper routines -procedure IniReadStrings(IniFile: TCustomIniFile; const Section: string; Strings: TStrings); -procedure IniWriteStrings(IniFile: TCustomIniFile; const Section: string; Strings: TStrings); - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\common'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -// Initialization Files -function IniReadBool(const FileName, Section, Line: string): Boolean; -var - Ini: TIniFile; -begin - Ini := TIniFile.Create(FileName); - try - Result := Ini.ReadBool(Section, Line, False); - finally - Ini.Free; - end; -end; - -function IniReadInteger(const FileName, Section, Line: string): Integer; -var - Ini: TIniFile; -begin - Ini := TIniFile.Create(FileName); - try - Result := Ini.ReadInteger(Section, Line, 0); - finally - Ini.Free; - end; -end; - -function IniReadString(const FileName, Section, Line: string): string; -var - Ini: TIniFile; -begin - Ini := TIniFile.Create(FileName); - try - Result := Ini.ReadString(Section, Line, ''); - finally - Ini.Free; - end; -end; - -procedure IniWriteBool(const FileName, Section, Line: string; Value: Boolean); -var - Ini: TIniFile; -begin - Ini := TIniFile.Create(FileName); - try - Ini.WriteBool(Section, Line, Value); - finally - Ini.Free; - end; -end; - -procedure IniWriteInteger(const FileName, Section, Line: string; Value: Integer); -var - Ini: TIniFile; -begin - Ini := TIniFile.Create(FileName); - try - Ini.WriteInteger(Section, Line, Value); - finally - Ini.Free; - end; -end; - -procedure IniWriteString(const FileName, Section, Line, Value: string); -var - Ini: TIniFile; -begin - Ini := TIniFile.Create(FileName); - try - Ini.WriteString(Section, Line, Value); - finally - Ini.Free; - end; -end; - -// Initialization (ini) Files helper routines -const - ItemCountName = 'Count'; - -procedure IniReadStrings(IniFile: TCustomIniFile; const Section: string; Strings: TStrings); -var - Count, I: Integer; -begin - with IniFile do - begin - Strings.BeginUpdate; - try - Strings.Clear; - Count := ReadInteger(Section, ItemCountName, 0); - for I := 0 to Count - 1 do - Strings.Add(ReadString(Section, IntToStr(I), '')); - finally - Strings.EndUpdate; - end; - end; -end; - -procedure IniWriteStrings(IniFile: TCustomIniFile; const Section: string; Strings: TStrings); -var - I: Integer; -begin - with IniFile do - begin - EraseSection(Section); - WriteInteger(Section, ItemCountName, Strings.Count); - for I := 0 to Strings.Count - 1 do - WriteString(Section, IntToStr(I), Strings[I]); - end; -end; - -{$IFDEF UNITVERSIONING} -initialization - RegisterUnitVersion(HInstance, UnitVersioning); - -finalization - UnregisterUnitVersion(HInstance); -{$ENDIF UNITVERSIONING} - -end. +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclIniFiles.pas. } +{ } +{ The Initial Developer of the Original Code is John C Molyneux. } +{ Portions created by John C Molyneux are Copyright (C) John C Molyneux. } +{ } +{ Contributors: } +{ Eric S. Fisher } +{ John C Molyneux } +{ Petr Vones (pvones) } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclIniFiles; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, System.Classes, System.IniFiles; + {$ELSE ~HAS_UNITSCOPE} + SysUtils, Classes, IniFiles; + {$ENDIF ~HAS_UNITSCOPE} + +// Initialization (ini) Files +function IniReadBool(const FileName, Section, Line: string): Boolean; // John C Molyneux +function IniReadInteger(const FileName, Section, Line: string): Integer; // John C Molyneux +function IniReadString(const FileName, Section, Line: string): string; // John C Molyneux +procedure IniWriteBool(const FileName, Section, Line: string; Value: Boolean); // John C Molyneux +procedure IniWriteInteger(const FileName, Section, Line: string; Value: Integer); // John C Molyneux +procedure IniWriteString(const FileName, Section, Line, Value: string); // John C Molyneux + +// Initialization (ini) Files helper routines +procedure IniReadStrings(IniFile: TCustomIniFile; const Section: string; Strings: TStrings); +procedure IniWriteStrings(IniFile: TCustomIniFile; const Section: string; Strings: TStrings); + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +// Initialization Files +function IniReadBool(const FileName, Section, Line: string): Boolean; +var + Ini: TIniFile; +begin + Ini := TIniFile.Create(FileName); + try + Result := Ini.ReadBool(Section, Line, False); + finally + Ini.Free; + end; +end; + +function IniReadInteger(const FileName, Section, Line: string): Integer; +var + Ini: TIniFile; +begin + Ini := TIniFile.Create(FileName); + try + Result := Ini.ReadInteger(Section, Line, 0); + finally + Ini.Free; + end; +end; + +function IniReadString(const FileName, Section, Line: string): string; +var + Ini: TIniFile; +begin + Ini := TIniFile.Create(FileName); + try + Result := Ini.ReadString(Section, Line, ''); + finally + Ini.Free; + end; +end; + +procedure IniWriteBool(const FileName, Section, Line: string; Value: Boolean); +var + Ini: TIniFile; +begin + Ini := TIniFile.Create(FileName); + try + Ini.WriteBool(Section, Line, Value); + finally + Ini.Free; + end; +end; + +procedure IniWriteInteger(const FileName, Section, Line: string; Value: Integer); +var + Ini: TIniFile; +begin + Ini := TIniFile.Create(FileName); + try + Ini.WriteInteger(Section, Line, Value); + finally + Ini.Free; + end; +end; + +procedure IniWriteString(const FileName, Section, Line, Value: string); +var + Ini: TIniFile; +begin + Ini := TIniFile.Create(FileName); + try + Ini.WriteString(Section, Line, Value); + finally + Ini.Free; + end; +end; + +// Initialization (ini) Files helper routines +const + ItemCountName = 'Count'; + +procedure IniReadStrings(IniFile: TCustomIniFile; const Section: string; Strings: TStrings); +var + Count, I: Integer; +begin + with IniFile do + begin + Strings.BeginUpdate; + try + Strings.Clear; + Count := ReadInteger(Section, ItemCountName, 0); + for I := 0 to Count - 1 do + Strings.Add(ReadString(Section, IntToStr(I), '')); + finally + Strings.EndUpdate; + end; + end; +end; + +procedure IniWriteStrings(IniFile: TCustomIniFile; const Section: string; Strings: TStrings); +var + I: Integer; +begin + with IniFile do + begin + EraseSection(Section); + WriteInteger(Section, ItemCountName, Strings.Count); + for I := 0 to Strings.Count - 1 do + WriteString(Section, IntToStr(I), Strings[I]); + end; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclLinkedLists.pas b/3rdParty/JCL/source/common/JclLinkedLists.pas new file mode 100644 index 00000000..3a93f5bf --- /dev/null +++ b/3rdParty/JCL/source/common/JclLinkedLists.pas @@ -0,0 +1,17713 @@ +{**************************************************************************************************} +{ WARNING: JEDI preprocessor generated unit. Do not edit. } +{**************************************************************************************************} + +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is LinkedList.pas. } +{ } +{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } +{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } +{ All rights reserved. } +{ } +{ Contributors: } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclLinkedLists; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF SUPPORTS_GENERICS} + JclAlgorithms, + {$ENDIF SUPPORTS_GENERICS} + {$IFDEF HAS_UNITSCOPE} + System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Classes, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclAbstractContainers, JclContainerIntf, JclSynch; + + +type + TItrStart = (isFirst, isLast); + + TJclIntfLinkedListItem = class + public + Value: IInterface; + Next: TJclIntfLinkedListItem; + Previous: TJclIntfLinkedListItem; + end; + + TJclIntfLinkedList = class(TJclIntfAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclIntfContainer, + IJclIntfFlatContainer, IJclIntfEqualityComparer, + IJclIntfCollection, IJclIntfList) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FStart: TJclIntfLinkedListItem; + FEnd: TJclIntfLinkedListItem; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(const ACollection: IJclIntfCollection); + destructor Destroy; override; + { IJclIntfCollection } + function Add(const AInterface: IInterface): Boolean; + function AddAll(const ACollection: IJclIntfCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclIntfCollection): Boolean; + function Contains(const AInterface: IInterface): Boolean; + function ContainsAll(const ACollection: IJclIntfCollection): Boolean; + function Extract(const AInterface: IInterface): Boolean; + function ExtractAll(const ACollection: IJclIntfCollection): Boolean; + function First: IJclIntfIterator; + function IsEmpty: Boolean; + function Last: IJclIntfIterator; + function Remove(const AInterface: IInterface): Boolean; + function RemoveAll(const ACollection: IJclIntfCollection): Boolean; + function RetainAll(const ACollection: IJclIntfCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIntfIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclIntfList } + function Delete(Index: Integer): IInterface; + function ExtractIndex(Index: Integer): IInterface; + function GetObject(Index: Integer): IInterface; + function IndexOf(const AInterface: IInterface): Integer; + function Insert(Index: Integer; const AInterface: IInterface): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclIntfCollection): Boolean; + function LastIndexOf(const AInterface: IInterface): Integer; + procedure SetObject(Index: Integer; const AInterface: IInterface); + function SubList(First, Count: Integer): IJclIntfList; + end; + + TJclIntfLinkedListIterator = class(TJclAbstractIterator, IJclIntfIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: TJclIntfLinkedListItem; + FStart: TItrStart; + FOwnList: TJclIntfLinkedList; + FEqualityComparer: IJclIntfEqualityComparer; + public + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclIntfLinkedList; ACursor: TJclIntfLinkedListItem; AValid: Boolean; AStart: TItrStart); + { IJclIntfIterator } + function Add(const AInterface: IInterface): Boolean; + procedure Extract; + function GetObject: IInterface; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AInterface: IInterface): Boolean; + function IteratorEquals(const AIterator: IJclIntfIterator): Boolean; + function Next: IInterface; + function NextIndex: Integer; + function Previous: IInterface; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetObject(const AInterface: IInterface); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: IInterface read GetObject; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclAnsiStrLinkedListItem = class + public + Value: AnsiString; + Next: TJclAnsiStrLinkedListItem; + Previous: TJclAnsiStrLinkedListItem; + end; + + TJclAnsiStrLinkedList = class(TJclAnsiStrAbstractCollection, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclAnsiStrContainer, + IJclAnsiStrFlatContainer, IJclAnsiStrEqualityComparer, IJclStrBaseContainer, + IJclAnsiStrCollection, IJclAnsiStrList) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FStart: TJclAnsiStrLinkedListItem; + FEnd: TJclAnsiStrLinkedListItem; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(const ACollection: IJclAnsiStrCollection); + destructor Destroy; override; + { IJclAnsiStrCollection } + function Add(const AString: AnsiString): Boolean; override; + function AddAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + procedure Clear; override; + function CollectionEquals(const ACollection: IJclAnsiStrCollection): Boolean; override; + function Contains(const AString: AnsiString): Boolean; override; + function ContainsAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + function Extract(const AString: AnsiString): Boolean; override; + function ExtractAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + function First: IJclAnsiStrIterator; override; + function IsEmpty: Boolean; override; + function Last: IJclAnsiStrIterator; override; + function Remove(const AString: AnsiString): Boolean; override; + function RemoveAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + function RetainAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + function Size: Integer; override; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclAnsiStrIterator; override; + {$ENDIF SUPPORTS_FOR_IN} + { IJclAnsiStrList } + function Delete(Index: Integer): AnsiString; + function ExtractIndex(Index: Integer): AnsiString; + function GetString(Index: Integer): AnsiString; + function IndexOf(const AString: AnsiString): Integer; + function Insert(Index: Integer; const AString: AnsiString): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclAnsiStrCollection): Boolean; + function LastIndexOf(const AString: AnsiString): Integer; + procedure SetString(Index: Integer; const AString: AnsiString); + function SubList(First, Count: Integer): IJclAnsiStrList; + end; + + TJclAnsiStrLinkedListIterator = class(TJclAbstractIterator, IJclAnsiStrIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: TJclAnsiStrLinkedListItem; + FStart: TItrStart; + FOwnList: TJclAnsiStrLinkedList; + FEqualityComparer: IJclAnsiStrEqualityComparer; + public + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclAnsiStrLinkedList; ACursor: TJclAnsiStrLinkedListItem; AValid: Boolean; AStart: TItrStart); + { IJclAnsiStrIterator } + function Add(const AString: AnsiString): Boolean; + procedure Extract; + function GetString: AnsiString; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AString: AnsiString): Boolean; + function IteratorEquals(const AIterator: IJclAnsiStrIterator): Boolean; + function Next: AnsiString; + function NextIndex: Integer; + function Previous: AnsiString; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetString(const AString: AnsiString); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: AnsiString read GetString; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclWideStrLinkedListItem = class + public + Value: WideString; + Next: TJclWideStrLinkedListItem; + Previous: TJclWideStrLinkedListItem; + end; + + TJclWideStrLinkedList = class(TJclWideStrAbstractCollection, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclWideStrContainer, + IJclWideStrFlatContainer, IJclWideStrEqualityComparer, IJclStrBaseContainer, + IJclWideStrCollection, IJclWideStrList) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FStart: TJclWideStrLinkedListItem; + FEnd: TJclWideStrLinkedListItem; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(const ACollection: IJclWideStrCollection); + destructor Destroy; override; + { IJclWideStrCollection } + function Add(const AString: WideString): Boolean; override; + function AddAll(const ACollection: IJclWideStrCollection): Boolean; override; + procedure Clear; override; + function CollectionEquals(const ACollection: IJclWideStrCollection): Boolean; override; + function Contains(const AString: WideString): Boolean; override; + function ContainsAll(const ACollection: IJclWideStrCollection): Boolean; override; + function Extract(const AString: WideString): Boolean; override; + function ExtractAll(const ACollection: IJclWideStrCollection): Boolean; override; + function First: IJclWideStrIterator; override; + function IsEmpty: Boolean; override; + function Last: IJclWideStrIterator; override; + function Remove(const AString: WideString): Boolean; override; + function RemoveAll(const ACollection: IJclWideStrCollection): Boolean; override; + function RetainAll(const ACollection: IJclWideStrCollection): Boolean; override; + function Size: Integer; override; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclWideStrIterator; override; + {$ENDIF SUPPORTS_FOR_IN} + { IJclWideStrList } + function Delete(Index: Integer): WideString; + function ExtractIndex(Index: Integer): WideString; + function GetString(Index: Integer): WideString; + function IndexOf(const AString: WideString): Integer; + function Insert(Index: Integer; const AString: WideString): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclWideStrCollection): Boolean; + function LastIndexOf(const AString: WideString): Integer; + procedure SetString(Index: Integer; const AString: WideString); + function SubList(First, Count: Integer): IJclWideStrList; + end; + + TJclWideStrLinkedListIterator = class(TJclAbstractIterator, IJclWideStrIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: TJclWideStrLinkedListItem; + FStart: TItrStart; + FOwnList: TJclWideStrLinkedList; + FEqualityComparer: IJclWideStrEqualityComparer; + public + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclWideStrLinkedList; ACursor: TJclWideStrLinkedListItem; AValid: Boolean; AStart: TItrStart); + { IJclWideStrIterator } + function Add(const AString: WideString): Boolean; + procedure Extract; + function GetString: WideString; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AString: WideString): Boolean; + function IteratorEquals(const AIterator: IJclWideStrIterator): Boolean; + function Next: WideString; + function NextIndex: Integer; + function Previous: WideString; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetString(const AString: WideString); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: WideString read GetString; + {$ENDIF SUPPORTS_FOR_IN} + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclUnicodeStrLinkedListItem = class + public + Value: UnicodeString; + Next: TJclUnicodeStrLinkedListItem; + Previous: TJclUnicodeStrLinkedListItem; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclUnicodeStrLinkedList = class(TJclUnicodeStrAbstractCollection, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclUnicodeStrContainer, + IJclUnicodeStrFlatContainer, IJclUnicodeStrEqualityComparer, IJclStrBaseContainer, + IJclUnicodeStrCollection, IJclUnicodeStrList) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FStart: TJclUnicodeStrLinkedListItem; + FEnd: TJclUnicodeStrLinkedListItem; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(const ACollection: IJclUnicodeStrCollection); + destructor Destroy; override; + { IJclUnicodeStrCollection } + function Add(const AString: UnicodeString): Boolean; override; + function AddAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + procedure Clear; override; + function CollectionEquals(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function Contains(const AString: UnicodeString): Boolean; override; + function ContainsAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function Extract(const AString: UnicodeString): Boolean; override; + function ExtractAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function First: IJclUnicodeStrIterator; override; + function IsEmpty: Boolean; override; + function Last: IJclUnicodeStrIterator; override; + function Remove(const AString: UnicodeString): Boolean; override; + function RemoveAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function RetainAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function Size: Integer; override; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclUnicodeStrIterator; override; + {$ENDIF SUPPORTS_FOR_IN} + { IJclUnicodeStrList } + function Delete(Index: Integer): UnicodeString; + function ExtractIndex(Index: Integer): UnicodeString; + function GetString(Index: Integer): UnicodeString; + function IndexOf(const AString: UnicodeString): Integer; + function Insert(Index: Integer; const AString: UnicodeString): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclUnicodeStrCollection): Boolean; + function LastIndexOf(const AString: UnicodeString): Integer; + procedure SetString(Index: Integer; const AString: UnicodeString); + function SubList(First, Count: Integer): IJclUnicodeStrList; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclUnicodeStrLinkedListIterator = class(TJclAbstractIterator, IJclUnicodeStrIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: TJclUnicodeStrLinkedListItem; + FStart: TItrStart; + FOwnList: TJclUnicodeStrLinkedList; + FEqualityComparer: IJclUnicodeStrEqualityComparer; + public + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclUnicodeStrLinkedList; ACursor: TJclUnicodeStrLinkedListItem; AValid: Boolean; AStart: TItrStart); + { IJclUnicodeStrIterator } + function Add(const AString: UnicodeString): Boolean; + procedure Extract; + function GetString: UnicodeString; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AString: UnicodeString): Boolean; + function IteratorEquals(const AIterator: IJclUnicodeStrIterator): Boolean; + function Next: UnicodeString; + function NextIndex: Integer; + function Previous: UnicodeString; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetString(const AString: UnicodeString); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: UnicodeString read GetString; + {$ENDIF SUPPORTS_FOR_IN} + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + TJclStrLinkedListItem = TJclAnsiStrLinkedListItem; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TJclStrLinkedListItem = TJclWideStrLinkedListItem; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TJclStrLinkedListItem = TJclUnicodeStrLinkedListItem; + {$ENDIF CONTAINER_UNICODESTR} + + {$IFDEF CONTAINER_ANSISTR} + TJclStrLinkedList = TJclAnsiStrLinkedList; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TJclStrLinkedList = TJclWideStrLinkedList; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TJclStrLinkedList = TJclUnicodeStrLinkedList; + {$ENDIF CONTAINER_UNICODESTR} + + {$IFDEF CONTAINER_ANSISTR} + TJclStrLinkedListIterator = TJclAnsiStrLinkedListIterator; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TJclStrLinkedListIterator = TJclWideStrLinkedListIterator; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TJclStrLinkedListIterator = TJclUnicodeStrLinkedListIterator; + {$ENDIF CONTAINER_UNICODESTR} + + TJclSingleLinkedListItem = class + public + Value: Single; + Next: TJclSingleLinkedListItem; + Previous: TJclSingleLinkedListItem; + end; + + TJclSingleLinkedList = class(TJclSingleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclSingleContainer, + IJclSingleFlatContainer, IJclSingleEqualityComparer, + IJclSingleCollection, IJclSingleList) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FStart: TJclSingleLinkedListItem; + FEnd: TJclSingleLinkedListItem; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(const ACollection: IJclSingleCollection); + destructor Destroy; override; + { IJclSingleCollection } + function Add(const AValue: Single): Boolean; + function AddAll(const ACollection: IJclSingleCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclSingleCollection): Boolean; + function Contains(const AValue: Single): Boolean; + function ContainsAll(const ACollection: IJclSingleCollection): Boolean; + function Extract(const AValue: Single): Boolean; + function ExtractAll(const ACollection: IJclSingleCollection): Boolean; + function First: IJclSingleIterator; + function IsEmpty: Boolean; + function Last: IJclSingleIterator; + function Remove(const AValue: Single): Boolean; + function RemoveAll(const ACollection: IJclSingleCollection): Boolean; + function RetainAll(const ACollection: IJclSingleCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclSingleIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclSingleList } + function Delete(Index: Integer): Single; + function ExtractIndex(Index: Integer): Single; + function GetValue(Index: Integer): Single; + function IndexOf(const AValue: Single): Integer; + function Insert(Index: Integer; const AValue: Single): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclSingleCollection): Boolean; + function LastIndexOf(const AValue: Single): Integer; + procedure SetValue(Index: Integer; const AValue: Single); + function SubList(First, Count: Integer): IJclSingleList; + end; + + TJclSingleLinkedListIterator = class(TJclAbstractIterator, IJclSingleIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: TJclSingleLinkedListItem; + FStart: TItrStart; + FOwnList: TJclSingleLinkedList; + FEqualityComparer: IJclSingleEqualityComparer; + public + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclSingleLinkedList; ACursor: TJclSingleLinkedListItem; AValid: Boolean; AStart: TItrStart); + { IJclSingleIterator } + function Add(const AValue: Single): Boolean; + procedure Extract; + function GetValue: Single; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AValue: Single): Boolean; + function IteratorEquals(const AIterator: IJclSingleIterator): Boolean; + function Next: Single; + function NextIndex: Integer; + function Previous: Single; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(const AValue: Single); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Single read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclDoubleLinkedListItem = class + public + Value: Double; + Next: TJclDoubleLinkedListItem; + Previous: TJclDoubleLinkedListItem; + end; + + TJclDoubleLinkedList = class(TJclDoubleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclDoubleContainer, + IJclDoubleFlatContainer, IJclDoubleEqualityComparer, + IJclDoubleCollection, IJclDoubleList) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FStart: TJclDoubleLinkedListItem; + FEnd: TJclDoubleLinkedListItem; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(const ACollection: IJclDoubleCollection); + destructor Destroy; override; + { IJclDoubleCollection } + function Add(const AValue: Double): Boolean; + function AddAll(const ACollection: IJclDoubleCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclDoubleCollection): Boolean; + function Contains(const AValue: Double): Boolean; + function ContainsAll(const ACollection: IJclDoubleCollection): Boolean; + function Extract(const AValue: Double): Boolean; + function ExtractAll(const ACollection: IJclDoubleCollection): Boolean; + function First: IJclDoubleIterator; + function IsEmpty: Boolean; + function Last: IJclDoubleIterator; + function Remove(const AValue: Double): Boolean; + function RemoveAll(const ACollection: IJclDoubleCollection): Boolean; + function RetainAll(const ACollection: IJclDoubleCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclDoubleIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclDoubleList } + function Delete(Index: Integer): Double; + function ExtractIndex(Index: Integer): Double; + function GetValue(Index: Integer): Double; + function IndexOf(const AValue: Double): Integer; + function Insert(Index: Integer; const AValue: Double): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclDoubleCollection): Boolean; + function LastIndexOf(const AValue: Double): Integer; + procedure SetValue(Index: Integer; const AValue: Double); + function SubList(First, Count: Integer): IJclDoubleList; + end; + + TJclDoubleLinkedListIterator = class(TJclAbstractIterator, IJclDoubleIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: TJclDoubleLinkedListItem; + FStart: TItrStart; + FOwnList: TJclDoubleLinkedList; + FEqualityComparer: IJclDoubleEqualityComparer; + public + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclDoubleLinkedList; ACursor: TJclDoubleLinkedListItem; AValid: Boolean; AStart: TItrStart); + { IJclDoubleIterator } + function Add(const AValue: Double): Boolean; + procedure Extract; + function GetValue: Double; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AValue: Double): Boolean; + function IteratorEquals(const AIterator: IJclDoubleIterator): Boolean; + function Next: Double; + function NextIndex: Integer; + function Previous: Double; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(const AValue: Double); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Double read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclExtendedLinkedListItem = class + public + Value: Extended; + Next: TJclExtendedLinkedListItem; + Previous: TJclExtendedLinkedListItem; + end; + + TJclExtendedLinkedList = class(TJclExtendedAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclExtendedContainer, + IJclExtendedFlatContainer, IJclExtendedEqualityComparer, + IJclExtendedCollection, IJclExtendedList) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FStart: TJclExtendedLinkedListItem; + FEnd: TJclExtendedLinkedListItem; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(const ACollection: IJclExtendedCollection); + destructor Destroy; override; + { IJclExtendedCollection } + function Add(const AValue: Extended): Boolean; + function AddAll(const ACollection: IJclExtendedCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclExtendedCollection): Boolean; + function Contains(const AValue: Extended): Boolean; + function ContainsAll(const ACollection: IJclExtendedCollection): Boolean; + function Extract(const AValue: Extended): Boolean; + function ExtractAll(const ACollection: IJclExtendedCollection): Boolean; + function First: IJclExtendedIterator; + function IsEmpty: Boolean; + function Last: IJclExtendedIterator; + function Remove(const AValue: Extended): Boolean; + function RemoveAll(const ACollection: IJclExtendedCollection): Boolean; + function RetainAll(const ACollection: IJclExtendedCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclExtendedIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclExtendedList } + function Delete(Index: Integer): Extended; + function ExtractIndex(Index: Integer): Extended; + function GetValue(Index: Integer): Extended; + function IndexOf(const AValue: Extended): Integer; + function Insert(Index: Integer; const AValue: Extended): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclExtendedCollection): Boolean; + function LastIndexOf(const AValue: Extended): Integer; + procedure SetValue(Index: Integer; const AValue: Extended); + function SubList(First, Count: Integer): IJclExtendedList; + end; + + TJclExtendedLinkedListIterator = class(TJclAbstractIterator, IJclExtendedIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: TJclExtendedLinkedListItem; + FStart: TItrStart; + FOwnList: TJclExtendedLinkedList; + FEqualityComparer: IJclExtendedEqualityComparer; + public + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclExtendedLinkedList; ACursor: TJclExtendedLinkedListItem; AValid: Boolean; AStart: TItrStart); + { IJclExtendedIterator } + function Add(const AValue: Extended): Boolean; + procedure Extract; + function GetValue: Extended; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AValue: Extended): Boolean; + function IteratorEquals(const AIterator: IJclExtendedIterator): Boolean; + function Next: Extended; + function NextIndex: Integer; + function Previous: Extended; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(const AValue: Extended); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Extended read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + {$IFDEF MATH_SINGLE_PRECISION} + TJclFloatLinkedListItem = TJclSingleLinkedListItem; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TJclFloatLinkedListItem = TJclDoubleLinkedListItem; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TJclFloatLinkedListItem = TJclExtendedLinkedListItem; + {$ENDIF MATH_EXTENDED_PRECISION} + + {$IFDEF MATH_SINGLE_PRECISION} + TJclFloatLinkedList = TJclSingleLinkedList; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TJclFloatLinkedList = TJclDoubleLinkedList; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TJclFloatLinkedList = TJclExtendedLinkedList; + {$ENDIF MATH_EXTENDED_PRECISION} + + {$IFDEF MATH_SINGLE_PRECISION} + TJclFloatLinkedListIterator = TJclSingleLinkedListIterator; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TJclFloatLinkedListIterator = TJclDoubleLinkedListIterator; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TJclFloatLinkedListIterator = TJclExtendedLinkedListIterator; + {$ENDIF MATH_EXTENDED_PRECISION} + + TJclIntegerLinkedListItem = class + public + Value: Integer; + Next: TJclIntegerLinkedListItem; + Previous: TJclIntegerLinkedListItem; + end; + + TJclIntegerLinkedList = class(TJclIntegerAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclIntegerContainer, + IJclIntegerFlatContainer, IJclIntegerEqualityComparer, + IJclIntegerCollection, IJclIntegerList) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FStart: TJclIntegerLinkedListItem; + FEnd: TJclIntegerLinkedListItem; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(const ACollection: IJclIntegerCollection); + destructor Destroy; override; + { IJclIntegerCollection } + function Add(AValue: Integer): Boolean; + function AddAll(const ACollection: IJclIntegerCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclIntegerCollection): Boolean; + function Contains(AValue: Integer): Boolean; + function ContainsAll(const ACollection: IJclIntegerCollection): Boolean; + function Extract(AValue: Integer): Boolean; + function ExtractAll(const ACollection: IJclIntegerCollection): Boolean; + function First: IJclIntegerIterator; + function IsEmpty: Boolean; + function Last: IJclIntegerIterator; + function Remove(AValue: Integer): Boolean; + function RemoveAll(const ACollection: IJclIntegerCollection): Boolean; + function RetainAll(const ACollection: IJclIntegerCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIntegerIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclIntegerList } + function Delete(Index: Integer): Integer; + function ExtractIndex(Index: Integer): Integer; + function GetValue(Index: Integer): Integer; + function IndexOf(AValue: Integer): Integer; + function Insert(Index: Integer; AValue: Integer): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclIntegerCollection): Boolean; + function LastIndexOf(AValue: Integer): Integer; + procedure SetValue(Index: Integer; AValue: Integer); + function SubList(First, Count: Integer): IJclIntegerList; + end; + + TJclIntegerLinkedListIterator = class(TJclAbstractIterator, IJclIntegerIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: TJclIntegerLinkedListItem; + FStart: TItrStart; + FOwnList: TJclIntegerLinkedList; + FEqualityComparer: IJclIntegerEqualityComparer; + public + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclIntegerLinkedList; ACursor: TJclIntegerLinkedListItem; AValid: Boolean; AStart: TItrStart); + { IJclIntegerIterator } + function Add(AValue: Integer): Boolean; + procedure Extract; + function GetValue: Integer; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(AValue: Integer): Boolean; + function IteratorEquals(const AIterator: IJclIntegerIterator): Boolean; + function Next: Integer; + function NextIndex: Integer; + function Previous: Integer; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(AValue: Integer); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Integer read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclCardinalLinkedListItem = class + public + Value: Cardinal; + Next: TJclCardinalLinkedListItem; + Previous: TJclCardinalLinkedListItem; + end; + + TJclCardinalLinkedList = class(TJclCardinalAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclCardinalContainer, + IJclCardinalFlatContainer, IJclCardinalEqualityComparer, + IJclCardinalCollection, IJclCardinalList) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FStart: TJclCardinalLinkedListItem; + FEnd: TJclCardinalLinkedListItem; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(const ACollection: IJclCardinalCollection); + destructor Destroy; override; + { IJclCardinalCollection } + function Add(AValue: Cardinal): Boolean; + function AddAll(const ACollection: IJclCardinalCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclCardinalCollection): Boolean; + function Contains(AValue: Cardinal): Boolean; + function ContainsAll(const ACollection: IJclCardinalCollection): Boolean; + function Extract(AValue: Cardinal): Boolean; + function ExtractAll(const ACollection: IJclCardinalCollection): Boolean; + function First: IJclCardinalIterator; + function IsEmpty: Boolean; + function Last: IJclCardinalIterator; + function Remove(AValue: Cardinal): Boolean; + function RemoveAll(const ACollection: IJclCardinalCollection): Boolean; + function RetainAll(const ACollection: IJclCardinalCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclCardinalIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclCardinalList } + function Delete(Index: Integer): Cardinal; + function ExtractIndex(Index: Integer): Cardinal; + function GetValue(Index: Integer): Cardinal; + function IndexOf(AValue: Cardinal): Integer; + function Insert(Index: Integer; AValue: Cardinal): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclCardinalCollection): Boolean; + function LastIndexOf(AValue: Cardinal): Integer; + procedure SetValue(Index: Integer; AValue: Cardinal); + function SubList(First, Count: Integer): IJclCardinalList; + end; + + TJclCardinalLinkedListIterator = class(TJclAbstractIterator, IJclCardinalIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: TJclCardinalLinkedListItem; + FStart: TItrStart; + FOwnList: TJclCardinalLinkedList; + FEqualityComparer: IJclCardinalEqualityComparer; + public + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclCardinalLinkedList; ACursor: TJclCardinalLinkedListItem; AValid: Boolean; AStart: TItrStart); + { IJclCardinalIterator } + function Add(AValue: Cardinal): Boolean; + procedure Extract; + function GetValue: Cardinal; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(AValue: Cardinal): Boolean; + function IteratorEquals(const AIterator: IJclCardinalIterator): Boolean; + function Next: Cardinal; + function NextIndex: Integer; + function Previous: Cardinal; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(AValue: Cardinal); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Cardinal read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclInt64LinkedListItem = class + public + Value: Int64; + Next: TJclInt64LinkedListItem; + Previous: TJclInt64LinkedListItem; + end; + + TJclInt64LinkedList = class(TJclInt64AbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclInt64Container, + IJclInt64FlatContainer, IJclInt64EqualityComparer, + IJclInt64Collection, IJclInt64List) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FStart: TJclInt64LinkedListItem; + FEnd: TJclInt64LinkedListItem; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(const ACollection: IJclInt64Collection); + destructor Destroy; override; + { IJclInt64Collection } + function Add(const AValue: Int64): Boolean; + function AddAll(const ACollection: IJclInt64Collection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclInt64Collection): Boolean; + function Contains(const AValue: Int64): Boolean; + function ContainsAll(const ACollection: IJclInt64Collection): Boolean; + function Extract(const AValue: Int64): Boolean; + function ExtractAll(const ACollection: IJclInt64Collection): Boolean; + function First: IJclInt64Iterator; + function IsEmpty: Boolean; + function Last: IJclInt64Iterator; + function Remove(const AValue: Int64): Boolean; + function RemoveAll(const ACollection: IJclInt64Collection): Boolean; + function RetainAll(const ACollection: IJclInt64Collection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclInt64Iterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclInt64List } + function Delete(Index: Integer): Int64; + function ExtractIndex(Index: Integer): Int64; + function GetValue(Index: Integer): Int64; + function IndexOf(const AValue: Int64): Integer; + function Insert(Index: Integer; const AValue: Int64): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclInt64Collection): Boolean; + function LastIndexOf(const AValue: Int64): Integer; + procedure SetValue(Index: Integer; const AValue: Int64); + function SubList(First, Count: Integer): IJclInt64List; + end; + + TJclInt64LinkedListIterator = class(TJclAbstractIterator, IJclInt64Iterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: TJclInt64LinkedListItem; + FStart: TItrStart; + FOwnList: TJclInt64LinkedList; + FEqualityComparer: IJclInt64EqualityComparer; + public + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclInt64LinkedList; ACursor: TJclInt64LinkedListItem; AValid: Boolean; AStart: TItrStart); + { IJclInt64Iterator } + function Add(const AValue: Int64): Boolean; + procedure Extract; + function GetValue: Int64; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AValue: Int64): Boolean; + function IteratorEquals(const AIterator: IJclInt64Iterator): Boolean; + function Next: Int64; + function NextIndex: Integer; + function Previous: Int64; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(const AValue: Int64); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Int64 read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclPtrLinkedListItem = class + public + Value: Pointer; + Next: TJclPtrLinkedListItem; + Previous: TJclPtrLinkedListItem; + end; + + TJclPtrLinkedList = class(TJclPtrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclPtrContainer, + IJclPtrFlatContainer, IJclPtrEqualityComparer, + IJclPtrCollection, IJclPtrList) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FStart: TJclPtrLinkedListItem; + FEnd: TJclPtrLinkedListItem; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(const ACollection: IJclPtrCollection); + destructor Destroy; override; + { IJclPtrCollection } + function Add(APtr: Pointer): Boolean; + function AddAll(const ACollection: IJclPtrCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclPtrCollection): Boolean; + function Contains(APtr: Pointer): Boolean; + function ContainsAll(const ACollection: IJclPtrCollection): Boolean; + function Extract(APtr: Pointer): Boolean; + function ExtractAll(const ACollection: IJclPtrCollection): Boolean; + function First: IJclPtrIterator; + function IsEmpty: Boolean; + function Last: IJclPtrIterator; + function Remove(APtr: Pointer): Boolean; + function RemoveAll(const ACollection: IJclPtrCollection): Boolean; + function RetainAll(const ACollection: IJclPtrCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclPtrIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclPtrList } + function Delete(Index: Integer): Pointer; + function ExtractIndex(Index: Integer): Pointer; + function GetPointer(Index: Integer): Pointer; + function IndexOf(APtr: Pointer): Integer; + function Insert(Index: Integer; APtr: Pointer): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclPtrCollection): Boolean; + function LastIndexOf(APtr: Pointer): Integer; + procedure SetPointer(Index: Integer; APtr: Pointer); + function SubList(First, Count: Integer): IJclPtrList; + end; + + TJclPtrLinkedListIterator = class(TJclAbstractIterator, IJclPtrIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: TJclPtrLinkedListItem; + FStart: TItrStart; + FOwnList: TJclPtrLinkedList; + FEqualityComparer: IJclPtrEqualityComparer; + public + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclPtrLinkedList; ACursor: TJclPtrLinkedListItem; AValid: Boolean; AStart: TItrStart); + { IJclPtrIterator } + function Add(APtr: Pointer): Boolean; + procedure Extract; + function GetPointer: Pointer; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(APtr: Pointer): Boolean; + function IteratorEquals(const AIterator: IJclPtrIterator): Boolean; + function Next: Pointer; + function NextIndex: Integer; + function Previous: Pointer; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetPointer(APtr: Pointer); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Pointer read GetPointer; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclLinkedListItem = class + public + Value: TObject; + Next: TJclLinkedListItem; + Previous: TJclLinkedListItem; + end; + + TJclLinkedList = class(TJclAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclContainer, + IJclFlatContainer, IJclEqualityComparer, IJclObjectOwner, + IJclCollection, IJclList) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FStart: TJclLinkedListItem; + FEnd: TJclLinkedListItem; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(const ACollection: IJclCollection; AOwnsObjects: Boolean); + destructor Destroy; override; + { IJclCollection } + function Add(AObject: TObject): Boolean; + function AddAll(const ACollection: IJclCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclCollection): Boolean; + function Contains(AObject: TObject): Boolean; + function ContainsAll(const ACollection: IJclCollection): Boolean; + function Extract(AObject: TObject): Boolean; + function ExtractAll(const ACollection: IJclCollection): Boolean; + function First: IJclIterator; + function IsEmpty: Boolean; + function Last: IJclIterator; + function Remove(AObject: TObject): Boolean; + function RemoveAll(const ACollection: IJclCollection): Boolean; + function RetainAll(const ACollection: IJclCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclList } + function Delete(Index: Integer): TObject; + function ExtractIndex(Index: Integer): TObject; + function GetObject(Index: Integer): TObject; + function IndexOf(AObject: TObject): Integer; + function Insert(Index: Integer; AObject: TObject): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclCollection): Boolean; + function LastIndexOf(AObject: TObject): Integer; + procedure SetObject(Index: Integer; AObject: TObject); + function SubList(First, Count: Integer): IJclList; + end; + + TJclLinkedListIterator = class(TJclAbstractIterator, IJclIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: TJclLinkedListItem; + FStart: TItrStart; + FOwnList: TJclLinkedList; + FEqualityComparer: IJclEqualityComparer; + public + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclLinkedList; ACursor: TJclLinkedListItem; AValid: Boolean; AStart: TItrStart); + { IJclIterator } + function Add(AObject: TObject): Boolean; + procedure Extract; + function GetObject: TObject; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(AObject: TObject): Boolean; + function IteratorEquals(const AIterator: IJclIterator): Boolean; + function Next: TObject; + function NextIndex: Integer; + function Previous: TObject; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetObject(AObject: TObject); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: TObject read GetObject; + {$ENDIF SUPPORTS_FOR_IN} + end; + + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + + TJclLinkedListItem = class + public + Value: T; + Next: TJclLinkedListItem; + Previous: TJclLinkedListItem; + end; + + TJclLinkedListIterator = class; + + TJclLinkedList = class(TJclAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclContainer, + IJclFlatContainer, IJclEqualityComparer,IJclItemOwner, + IJclCollection, IJclList) + protected + type + TLinkedListItem = TJclLinkedListItem; + TLinkedListIterator = TJclLinkedListIterator; + private + FStart: TLinkedListItem; + FEnd: TLinkedListItem; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(const ACollection: IJclCollection; AOwnsItems: Boolean); + destructor Destroy; override; + { IJclCollection } + function Add(const AItem: T): Boolean; + function AddAll(const ACollection: IJclCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclCollection): Boolean; + function Contains(const AItem: T): Boolean; + function ContainsAll(const ACollection: IJclCollection): Boolean; + function Extract(const AItem: T): Boolean; + function ExtractAll(const ACollection: IJclCollection): Boolean; + function First: IJclIterator; + function IsEmpty: Boolean; + function Last: IJclIterator; + function Remove(const AItem: T): Boolean; + function RemoveAll(const ACollection: IJclCollection): Boolean; + function RetainAll(const ACollection: IJclCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclList } + function Delete(Index: Integer): T; + function ExtractIndex(Index: Integer): T; + function GetItem(Index: Integer): T; + function IndexOf(const AItem: T): Integer; + function Insert(Index: Integer; const AItem: T): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclCollection): Boolean; + function LastIndexOf(const AItem: T): Integer; + procedure SetItem(Index: Integer; const AItem: T); + function SubList(First, Count: Integer): IJclList; + end; + + TJclLinkedListIterator = class(TJclAbstractIterator, IJclIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: TJclLinkedList.TLinkedListItem; + FStart: TItrStart; + FOwnList: TJclLinkedList; + FEqualityComparer: IJclEqualityComparer; + public + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; + public + constructor Create(AOwnList: TJclLinkedList; ACursor: TJclLinkedList.TLinkedListItem; AValid: Boolean; AStart: TItrStart); + { IJclIterator } + function Add(const AItem: T): Boolean; + procedure Extract; + function GetItem: T; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AItem: T): Boolean; + function IteratorEquals(const AIterator: IJclIterator): Boolean; + function Next: T; + function NextIndex: Integer; + function Previous: T; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetItem(const AItem: T); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: T read GetItem; + {$ENDIF SUPPORTS_FOR_IN} + end; + + // E = External helper to compare items + // GetHashCode is never called + TJclLinkedListE = class(TJclLinkedList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclContainer, IJclCollection, IJclList, IJclEqualityComparer, + IJclItemOwner) + private + FEqualityComparer: IJclEqualityComparer; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AEqualityComparer: IJclEqualityComparer; const ACollection: IJclCollection; + AOwnsItems: Boolean); + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + property EqualityComparer: IJclEqualityComparer read FEqualityComparer write FEqualityComparer; + end; + + // F = Function to compare items for equality + TJclLinkedListF = class(TJclLinkedList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclContainer, IJclCollection, IJclList, IJclEqualityComparer, + IJclItemOwner) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AEqualityCompare: TEqualityCompare; const ACollection: IJclCollection; + AOwnsItems: Boolean); + end; + + // I = Items can compare themselves to an other + TJclLinkedListI> = class(TJclLinkedList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclContainer, IJclCollection, IJclList, IJclEqualityComparer, + IJclItemOwner) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +{$IFDEF BCB} +{$IFDEF WIN64} + {$HPPEMIT '#ifdef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #undef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #define JclLinkedLists_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT '#endif'} + + {$HPPEMIT END '#ifdef JclLinkedLists_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #define MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #undef JclLinkedLists_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END '#endif'} +{$ENDIF WIN64} +{$ENDIF BCB} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +//=== { TJclIntfLinkedList } ================================================== + +constructor TJclIntfLinkedList.Create(const ACollection: IJclIntfCollection); +begin + inherited Create(); + FStart := nil; + FEnd := nil; + if ACollection <> nil then + AddAll(ACollection); +end; + +destructor TJclIntfLinkedList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclIntfLinkedList.Add(const AInterface: IInterface): Boolean; +var + NewItem: TJclIntfLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AInterface, nil); + if Result then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(AInterface, NewItem.Value) then + begin + Result := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if Result then + begin + NewItem := TJclIntfLinkedListItem.Create; + NewItem.Value := AInterface; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfLinkedList.AddAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; + Item: IInterface; + AddItem: Boolean; + NewItem: TJclIntfLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, nil); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(Item, NewItem.Value) then + begin + AddItem := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if AddItem then + begin + NewItem := TJclIntfLinkedListItem.Create; + NewItem.Value := Item; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + Result := AddItem and Result; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfLinkedList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ACollection: IJclIntfCollection; +begin + inherited AssignDataTo(Dest); + if Supports(IInterface(Dest), IJclIntfCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclIntfLinkedList.Clear; +var + Old, Current: TJclIntfLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Current := FStart; + while Current <> nil do + begin + FreeObject(Current.Value); + Old := Current; + Current := Current.Next; + Old.Free; + end; + FSize := 0; + + //Daniele Teti 27/12/2004 + FStart := nil; + FEnd := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfLinkedList.CollectionEquals(const ACollection: IJclIntfCollection): Boolean; +var + It, ItSelf: IJclIntfIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext and It.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfLinkedList.Contains(const AInterface: IInterface): Boolean; +var + Current: TJclIntfLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, AInterface) then + begin + Result := True; + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfLinkedList.ContainsAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfLinkedList.Delete(Index: Integer): IInterface; +var + Current: TJclIntfLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := FreeObject(Current.Value); + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfLinkedList.Extract(const AInterface: IInterface): Boolean; +var + Current: TJclIntfLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, AInterface) then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Current.Value := nil; + Current.Free; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfLinkedList.ExtractAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfLinkedList.ExtractIndex(Index: Integer): IInterface; +var + Current: TJclIntfLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := Current.Value; + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfLinkedList.First: IJclIntfIterator; +begin + Result := TJclIntfLinkedListIterator.Create(Self, FStart, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclIntfLinkedList.GetEnumerator: IJclIntfIterator; +begin + Result := TJclIntfLinkedListIterator.Create(Self, FStart, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclIntfLinkedList.GetObject(Index: Integer): IInterface; +var + Current: TJclIntfLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + Result := Current.Value + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfLinkedList.IndexOf(const AInterface: IInterface): Integer; +var + Current: TJclIntfLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Current := FStart; + Result := 0; + while (Current <> nil) and not ItemsEqual(Current.Value, AInterface) do + begin + Inc(Result); + Current := Current.Next; + end; + if Current = nil then + Result := -1; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfLinkedList.Insert(Index: Integer; const AInterface: IInterface): Boolean; +var + Current, NewItem: TJclIntfLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AInterface, nil); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(AInterface, Current.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if Result then + begin + NewItem := TJclIntfLinkedListItem.Create; + NewItem.Value := AInterface; + if Index = 0 then + begin + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end + else + if Index = FSize then + begin + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfLinkedList.InsertAll(Index: Integer; const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; + Current, NewItem, Test: TJclIntfLinkedListItem; + AddItem: Boolean; + Item: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + if Index = 0 then + begin + It := ACollection.Last; + while It.HasPrevious do + begin + Item := It.Previous; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, nil); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclIntfLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + if Index = Size then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, nil); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclIntfLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Previous := FEnd; + if FEnd <> nil then + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, nil); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclIntfLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfLinkedList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntfLinkedList.Last: IJclIntfIterator; +begin + Result := TJclIntfLinkedListIterator.Create(Self, FEnd, False, isLast); +end; + +function TJclIntfLinkedList.LastIndexOf(const AInterface: IInterface): Integer; +var + Current: TJclIntfLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + if FEnd <> nil then + begin + Current := FEnd; + Result := FSize - 1; + while (Current <> nil) and not ItemsEqual(Current.Value, AInterface) do + begin + Dec(Result); + Current := Current.Previous; + end; + if Current = nil then + Result := -1; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfLinkedList.Remove(const AInterface: IInterface): Boolean; +var + Extracted: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AInterface); + if Result then + begin + Extracted := AInterface; + FreeObject(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfLinkedList.RemoveAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfLinkedList.RetainAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfLinkedList.SetObject(Index: Integer; const AInterface: IInterface); +var + Current: TJclIntfLinkedListItem; + ReplaceItem: Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AInterface, nil); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(AInterface, Current.Value) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if ReplaceItem then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + FreeObject(Current.Value); + Current.Value := AInterface; + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfLinkedList.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfLinkedList.SubList(First, Count: Integer): IJclIntfList; +var + Current: TJclIntfLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := CreateEmptyContainer as IJclIntfList; + Current := FStart; + while (Current <> nil) and (First > 0) do + begin + Dec(First); + Current := Current.Next; + end; + while (Current <> nil) and (Count > 0) do + begin + Result.Add(Current.Value); + Dec(Count); + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfLinkedList.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfLinkedList.Create(nil); + AssignPropertiesTo(Result); +end; + +//=== { TJclIntfLinkedListIterator } ============================================================ + +constructor TJclIntfLinkedListIterator.Create(AOwnList: TJclIntfLinkedList; ACursor: TJclIntfLinkedListItem; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnList := AOwnList; + FStart := AStart; + FEqualityComparer := AOwnList as IJclIntfEqualityComparer; +end; + +function TJclIntfLinkedListIterator.Add(const AInterface: IInterface): Boolean; +begin + Result := FOwnList.Add(AInterface); +end; + +procedure TJclIntfLinkedListIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclIntfLinkedListIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclIntfLinkedListIterator then + begin + ADest := TJclIntfLinkedListIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnList := FOwnList; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclIntfLinkedListIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclIntfLinkedListIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclIntfLinkedListIterator.Extract; +var + OldCursor: TJclIntfLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfLinkedListIterator.GetObject: IInterface; +begin + CheckValid; + Result := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnList.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); +end; + +function TJclIntfLinkedListIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Next <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfLinkedListIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Previous <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfLinkedListIterator.Insert(const AInterface: IInterface): Boolean; +var + NewCursor: TJclIntfLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := FCursor <> nil; + if Result then + begin + Result := FOwnList.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AInterface, nil); + if Result then + begin + case FOwnList.Duplicates of + dupIgnore: + Result := not FOwnList.Contains(AInterface); + dupAccept: + Result := True; + dupError: + begin + Result := FOwnList.Contains(AInterface); + if not Result then + raise EJclDuplicateElementError.Create; + end; + end; + if Result then + begin + NewCursor := TJclIntfLinkedListItem.Create; + NewCursor.Value := AInterface; + NewCursor.Next := FCursor; + NewCursor.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := NewCursor; + FCursor.Previous := NewCursor; + FCursor := NewCursor; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfLinkedListIterator.IteratorEquals(const AIterator: IJclIntfIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclIntfLinkedListIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclIntfLinkedListIterator then + begin + ItrObj := TJclIntfLinkedListIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclIntfLinkedListIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclIntfLinkedListIterator.Next: IInterface; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfLinkedListIterator.NextIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclIntfLinkedListIterator.Previous: IInterface; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Previous + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfLinkedListIterator.PreviousIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclIntfLinkedListIterator.Remove; +var + OldCursor: TJclIntfLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + FCursor.Value := nil; + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfLinkedListIterator.Reset; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + while (FCursor <> nil) and (FCursor.Previous <> nil) do + FCursor := FCursor.Previous; + end; + isLast: + begin + while (FCursor <> nil) and (FCursor.Next <> nil) do + FCursor := FCursor.Next; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfLinkedListIterator.SetObject(const AInterface: IInterface); +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + FCursor.Value := nil; + FCursor.Value := AInterface; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclAnsiStrLinkedList } ================================================== + +constructor TJclAnsiStrLinkedList.Create(const ACollection: IJclAnsiStrCollection); +begin + inherited Create(); + FStart := nil; + FEnd := nil; + if ACollection <> nil then + AddAll(ACollection); +end; + +destructor TJclAnsiStrLinkedList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclAnsiStrLinkedList.Add(const AString: AnsiString): Boolean; +var + NewItem: TJclAnsiStrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AString, ''); + if Result then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(AString, NewItem.Value) then + begin + Result := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if Result then + begin + NewItem := TJclAnsiStrLinkedListItem.Create; + NewItem.Value := AString; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrLinkedList.AddAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; + Item: AnsiString; + AddItem: Boolean; + NewItem: TJclAnsiStrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, ''); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(Item, NewItem.Value) then + begin + AddItem := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if AddItem then + begin + NewItem := TJclAnsiStrLinkedListItem.Create; + NewItem.Value := Item; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + Result := AddItem and Result; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrLinkedList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ACollection: IJclAnsiStrCollection; +begin + inherited AssignDataTo(Dest); + if Supports(IInterface(Dest), IJclAnsiStrCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclAnsiStrLinkedList.Clear; +var + Old, Current: TJclAnsiStrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Current := FStart; + while Current <> nil do + begin + FreeString(Current.Value); + Old := Current; + Current := Current.Next; + Old.Free; + end; + FSize := 0; + + //Daniele Teti 27/12/2004 + FStart := nil; + FEnd := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrLinkedList.CollectionEquals(const ACollection: IJclAnsiStrCollection): Boolean; +var + It, ItSelf: IJclAnsiStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext and It.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrLinkedList.Contains(const AString: AnsiString): Boolean; +var + Current: TJclAnsiStrLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, AString) then + begin + Result := True; + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrLinkedList.ContainsAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrLinkedList.Delete(Index: Integer): AnsiString; +var + Current: TJclAnsiStrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := ''; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := FreeString(Current.Value); + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrLinkedList.Extract(const AString: AnsiString): Boolean; +var + Current: TJclAnsiStrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, AString) then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Current.Value := ''; + Current.Free; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrLinkedList.ExtractAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrLinkedList.ExtractIndex(Index: Integer): AnsiString; +var + Current: TJclAnsiStrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := ''; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := Current.Value; + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrLinkedList.First: IJclAnsiStrIterator; +begin + Result := TJclAnsiStrLinkedListIterator.Create(Self, FStart, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclAnsiStrLinkedList.GetEnumerator: IJclAnsiStrIterator; +begin + Result := TJclAnsiStrLinkedListIterator.Create(Self, FStart, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclAnsiStrLinkedList.GetString(Index: Integer): AnsiString; +var + Current: TJclAnsiStrLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + Result := Current.Value + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrLinkedList.IndexOf(const AString: AnsiString): Integer; +var + Current: TJclAnsiStrLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Current := FStart; + Result := 0; + while (Current <> nil) and not ItemsEqual(Current.Value, AString) do + begin + Inc(Result); + Current := Current.Next; + end; + if Current = nil then + Result := -1; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrLinkedList.Insert(Index: Integer; const AString: AnsiString): Boolean; +var + Current, NewItem: TJclAnsiStrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AString, ''); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(AString, Current.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if Result then + begin + NewItem := TJclAnsiStrLinkedListItem.Create; + NewItem.Value := AString; + if Index = 0 then + begin + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end + else + if Index = FSize then + begin + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrLinkedList.InsertAll(Index: Integer; const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; + Current, NewItem, Test: TJclAnsiStrLinkedListItem; + AddItem: Boolean; + Item: AnsiString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + if Index = 0 then + begin + It := ACollection.Last; + while It.HasPrevious do + begin + Item := It.Previous; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, ''); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclAnsiStrLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + if Index = Size then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, ''); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclAnsiStrLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Previous := FEnd; + if FEnd <> nil then + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, ''); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclAnsiStrLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrLinkedList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclAnsiStrLinkedList.Last: IJclAnsiStrIterator; +begin + Result := TJclAnsiStrLinkedListIterator.Create(Self, FEnd, False, isLast); +end; + +function TJclAnsiStrLinkedList.LastIndexOf(const AString: AnsiString): Integer; +var + Current: TJclAnsiStrLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + if FEnd <> nil then + begin + Current := FEnd; + Result := FSize - 1; + while (Current <> nil) and not ItemsEqual(Current.Value, AString) do + begin + Dec(Result); + Current := Current.Previous; + end; + if Current = nil then + Result := -1; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrLinkedList.Remove(const AString: AnsiString): Boolean; +var + Extracted: AnsiString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AString); + if Result then + begin + Extracted := AString; + FreeString(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrLinkedList.RemoveAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrLinkedList.RetainAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrLinkedList.SetString(Index: Integer; const AString: AnsiString); +var + Current: TJclAnsiStrLinkedListItem; + ReplaceItem: Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AString, ''); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(AString, Current.Value) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if ReplaceItem then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + FreeString(Current.Value); + Current.Value := AString; + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrLinkedList.Size: Integer; +begin + Result := FSize; +end; + +function TJclAnsiStrLinkedList.SubList(First, Count: Integer): IJclAnsiStrList; +var + Current: TJclAnsiStrLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := CreateEmptyContainer as IJclAnsiStrList; + Current := FStart; + while (Current <> nil) and (First > 0) do + begin + Dec(First); + Current := Current.Next; + end; + while (Current <> nil) and (Count > 0) do + begin + Result.Add(Current.Value); + Dec(Count); + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrLinkedList.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclAnsiStrLinkedList.Create(nil); + AssignPropertiesTo(Result); +end; + +//=== { TJclAnsiStrLinkedListIterator } ============================================================ + +constructor TJclAnsiStrLinkedListIterator.Create(AOwnList: TJclAnsiStrLinkedList; ACursor: TJclAnsiStrLinkedListItem; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnList := AOwnList; + FStart := AStart; + FEqualityComparer := AOwnList as IJclAnsiStrEqualityComparer; +end; + +function TJclAnsiStrLinkedListIterator.Add(const AString: AnsiString): Boolean; +begin + Result := FOwnList.Add(AString); +end; + +procedure TJclAnsiStrLinkedListIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclAnsiStrLinkedListIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclAnsiStrLinkedListIterator then + begin + ADest := TJclAnsiStrLinkedListIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnList := FOwnList; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclAnsiStrLinkedListIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclAnsiStrLinkedListIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclAnsiStrLinkedListIterator.Extract; +var + OldCursor: TJclAnsiStrLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrLinkedListIterator.GetString: AnsiString; +begin + CheckValid; + Result := ''; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnList.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); +end; + +function TJclAnsiStrLinkedListIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Next <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrLinkedListIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Previous <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrLinkedListIterator.Insert(const AString: AnsiString): Boolean; +var + NewCursor: TJclAnsiStrLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := FCursor <> nil; + if Result then + begin + Result := FOwnList.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, ''); + if Result then + begin + case FOwnList.Duplicates of + dupIgnore: + Result := not FOwnList.Contains(AString); + dupAccept: + Result := True; + dupError: + begin + Result := FOwnList.Contains(AString); + if not Result then + raise EJclDuplicateElementError.Create; + end; + end; + if Result then + begin + NewCursor := TJclAnsiStrLinkedListItem.Create; + NewCursor.Value := AString; + NewCursor.Next := FCursor; + NewCursor.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := NewCursor; + FCursor.Previous := NewCursor; + FCursor := NewCursor; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrLinkedListIterator.IteratorEquals(const AIterator: IJclAnsiStrIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclAnsiStrLinkedListIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclAnsiStrLinkedListIterator then + begin + ItrObj := TJclAnsiStrLinkedListIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclAnsiStrLinkedListIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclAnsiStrLinkedListIterator.Next: AnsiString; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := ''; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrLinkedListIterator.NextIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclAnsiStrLinkedListIterator.Previous: AnsiString; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Previous + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := ''; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrLinkedListIterator.PreviousIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclAnsiStrLinkedListIterator.Remove; +var + OldCursor: TJclAnsiStrLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + FCursor.Value := ''; + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrLinkedListIterator.Reset; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + while (FCursor <> nil) and (FCursor.Previous <> nil) do + FCursor := FCursor.Previous; + end; + isLast: + begin + while (FCursor <> nil) and (FCursor.Next <> nil) do + FCursor := FCursor.Next; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrLinkedListIterator.SetString(const AString: AnsiString); +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + FCursor.Value := ''; + FCursor.Value := AString; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclWideStrLinkedList } ================================================== + +constructor TJclWideStrLinkedList.Create(const ACollection: IJclWideStrCollection); +begin + inherited Create(); + FStart := nil; + FEnd := nil; + if ACollection <> nil then + AddAll(ACollection); +end; + +destructor TJclWideStrLinkedList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclWideStrLinkedList.Add(const AString: WideString): Boolean; +var + NewItem: TJclWideStrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AString, ''); + if Result then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(AString, NewItem.Value) then + begin + Result := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if Result then + begin + NewItem := TJclWideStrLinkedListItem.Create; + NewItem.Value := AString; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrLinkedList.AddAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; + Item: WideString; + AddItem: Boolean; + NewItem: TJclWideStrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, ''); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(Item, NewItem.Value) then + begin + AddItem := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if AddItem then + begin + NewItem := TJclWideStrLinkedListItem.Create; + NewItem.Value := Item; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + Result := AddItem and Result; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrLinkedList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ACollection: IJclWideStrCollection; +begin + inherited AssignDataTo(Dest); + if Supports(IInterface(Dest), IJclWideStrCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclWideStrLinkedList.Clear; +var + Old, Current: TJclWideStrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Current := FStart; + while Current <> nil do + begin + FreeString(Current.Value); + Old := Current; + Current := Current.Next; + Old.Free; + end; + FSize := 0; + + //Daniele Teti 27/12/2004 + FStart := nil; + FEnd := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrLinkedList.CollectionEquals(const ACollection: IJclWideStrCollection): Boolean; +var + It, ItSelf: IJclWideStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext and It.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrLinkedList.Contains(const AString: WideString): Boolean; +var + Current: TJclWideStrLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, AString) then + begin + Result := True; + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrLinkedList.ContainsAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrLinkedList.Delete(Index: Integer): WideString; +var + Current: TJclWideStrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := ''; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := FreeString(Current.Value); + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrLinkedList.Extract(const AString: WideString): Boolean; +var + Current: TJclWideStrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, AString) then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Current.Value := ''; + Current.Free; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrLinkedList.ExtractAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrLinkedList.ExtractIndex(Index: Integer): WideString; +var + Current: TJclWideStrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := ''; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := Current.Value; + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrLinkedList.First: IJclWideStrIterator; +begin + Result := TJclWideStrLinkedListIterator.Create(Self, FStart, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclWideStrLinkedList.GetEnumerator: IJclWideStrIterator; +begin + Result := TJclWideStrLinkedListIterator.Create(Self, FStart, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclWideStrLinkedList.GetString(Index: Integer): WideString; +var + Current: TJclWideStrLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + Result := Current.Value + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrLinkedList.IndexOf(const AString: WideString): Integer; +var + Current: TJclWideStrLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Current := FStart; + Result := 0; + while (Current <> nil) and not ItemsEqual(Current.Value, AString) do + begin + Inc(Result); + Current := Current.Next; + end; + if Current = nil then + Result := -1; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrLinkedList.Insert(Index: Integer; const AString: WideString): Boolean; +var + Current, NewItem: TJclWideStrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AString, ''); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(AString, Current.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if Result then + begin + NewItem := TJclWideStrLinkedListItem.Create; + NewItem.Value := AString; + if Index = 0 then + begin + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end + else + if Index = FSize then + begin + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrLinkedList.InsertAll(Index: Integer; const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; + Current, NewItem, Test: TJclWideStrLinkedListItem; + AddItem: Boolean; + Item: WideString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + if Index = 0 then + begin + It := ACollection.Last; + while It.HasPrevious do + begin + Item := It.Previous; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, ''); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclWideStrLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + if Index = Size then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, ''); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclWideStrLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Previous := FEnd; + if FEnd <> nil then + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, ''); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclWideStrLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrLinkedList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclWideStrLinkedList.Last: IJclWideStrIterator; +begin + Result := TJclWideStrLinkedListIterator.Create(Self, FEnd, False, isLast); +end; + +function TJclWideStrLinkedList.LastIndexOf(const AString: WideString): Integer; +var + Current: TJclWideStrLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + if FEnd <> nil then + begin + Current := FEnd; + Result := FSize - 1; + while (Current <> nil) and not ItemsEqual(Current.Value, AString) do + begin + Dec(Result); + Current := Current.Previous; + end; + if Current = nil then + Result := -1; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrLinkedList.Remove(const AString: WideString): Boolean; +var + Extracted: WideString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AString); + if Result then + begin + Extracted := AString; + FreeString(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrLinkedList.RemoveAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrLinkedList.RetainAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrLinkedList.SetString(Index: Integer; const AString: WideString); +var + Current: TJclWideStrLinkedListItem; + ReplaceItem: Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AString, ''); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(AString, Current.Value) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if ReplaceItem then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + FreeString(Current.Value); + Current.Value := AString; + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrLinkedList.Size: Integer; +begin + Result := FSize; +end; + +function TJclWideStrLinkedList.SubList(First, Count: Integer): IJclWideStrList; +var + Current: TJclWideStrLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := CreateEmptyContainer as IJclWideStrList; + Current := FStart; + while (Current <> nil) and (First > 0) do + begin + Dec(First); + Current := Current.Next; + end; + while (Current <> nil) and (Count > 0) do + begin + Result.Add(Current.Value); + Dec(Count); + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrLinkedList.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclWideStrLinkedList.Create(nil); + AssignPropertiesTo(Result); +end; + +//=== { TJclWideStrLinkedListIterator } ============================================================ + +constructor TJclWideStrLinkedListIterator.Create(AOwnList: TJclWideStrLinkedList; ACursor: TJclWideStrLinkedListItem; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnList := AOwnList; + FStart := AStart; + FEqualityComparer := AOwnList as IJclWideStrEqualityComparer; +end; + +function TJclWideStrLinkedListIterator.Add(const AString: WideString): Boolean; +begin + Result := FOwnList.Add(AString); +end; + +procedure TJclWideStrLinkedListIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclWideStrLinkedListIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclWideStrLinkedListIterator then + begin + ADest := TJclWideStrLinkedListIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnList := FOwnList; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclWideStrLinkedListIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclWideStrLinkedListIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclWideStrLinkedListIterator.Extract; +var + OldCursor: TJclWideStrLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrLinkedListIterator.GetString: WideString; +begin + CheckValid; + Result := ''; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnList.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); +end; + +function TJclWideStrLinkedListIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Next <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrLinkedListIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Previous <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrLinkedListIterator.Insert(const AString: WideString): Boolean; +var + NewCursor: TJclWideStrLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := FCursor <> nil; + if Result then + begin + Result := FOwnList.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, ''); + if Result then + begin + case FOwnList.Duplicates of + dupIgnore: + Result := not FOwnList.Contains(AString); + dupAccept: + Result := True; + dupError: + begin + Result := FOwnList.Contains(AString); + if not Result then + raise EJclDuplicateElementError.Create; + end; + end; + if Result then + begin + NewCursor := TJclWideStrLinkedListItem.Create; + NewCursor.Value := AString; + NewCursor.Next := FCursor; + NewCursor.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := NewCursor; + FCursor.Previous := NewCursor; + FCursor := NewCursor; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrLinkedListIterator.IteratorEquals(const AIterator: IJclWideStrIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclWideStrLinkedListIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclWideStrLinkedListIterator then + begin + ItrObj := TJclWideStrLinkedListIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclWideStrLinkedListIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclWideStrLinkedListIterator.Next: WideString; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := ''; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrLinkedListIterator.NextIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclWideStrLinkedListIterator.Previous: WideString; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Previous + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := ''; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrLinkedListIterator.PreviousIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclWideStrLinkedListIterator.Remove; +var + OldCursor: TJclWideStrLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + FCursor.Value := ''; + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrLinkedListIterator.Reset; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + while (FCursor <> nil) and (FCursor.Previous <> nil) do + FCursor := FCursor.Previous; + end; + isLast: + begin + while (FCursor <> nil) and (FCursor.Next <> nil) do + FCursor := FCursor.Next; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrLinkedListIterator.SetString(const AString: WideString); +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + FCursor.Value := ''; + FCursor.Value := AString; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrLinkedList } ================================================== + +constructor TJclUnicodeStrLinkedList.Create(const ACollection: IJclUnicodeStrCollection); +begin + inherited Create(); + FStart := nil; + FEnd := nil; + if ACollection <> nil then + AddAll(ACollection); +end; + +destructor TJclUnicodeStrLinkedList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclUnicodeStrLinkedList.Add(const AString: UnicodeString): Boolean; +var + NewItem: TJclUnicodeStrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AString, ''); + if Result then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(AString, NewItem.Value) then + begin + Result := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if Result then + begin + NewItem := TJclUnicodeStrLinkedListItem.Create; + NewItem.Value := AString; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrLinkedList.AddAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; + Item: UnicodeString; + AddItem: Boolean; + NewItem: TJclUnicodeStrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, ''); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(Item, NewItem.Value) then + begin + AddItem := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if AddItem then + begin + NewItem := TJclUnicodeStrLinkedListItem.Create; + NewItem.Value := Item; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + Result := AddItem and Result; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrLinkedList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ACollection: IJclUnicodeStrCollection; +begin + inherited AssignDataTo(Dest); + if Supports(IInterface(Dest), IJclUnicodeStrCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclUnicodeStrLinkedList.Clear; +var + Old, Current: TJclUnicodeStrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Current := FStart; + while Current <> nil do + begin + FreeString(Current.Value); + Old := Current; + Current := Current.Next; + Old.Free; + end; + FSize := 0; + + //Daniele Teti 27/12/2004 + FStart := nil; + FEnd := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrLinkedList.CollectionEquals(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It, ItSelf: IJclUnicodeStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext and It.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrLinkedList.Contains(const AString: UnicodeString): Boolean; +var + Current: TJclUnicodeStrLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, AString) then + begin + Result := True; + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrLinkedList.ContainsAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrLinkedList.Delete(Index: Integer): UnicodeString; +var + Current: TJclUnicodeStrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := ''; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := FreeString(Current.Value); + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrLinkedList.Extract(const AString: UnicodeString): Boolean; +var + Current: TJclUnicodeStrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, AString) then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Current.Value := ''; + Current.Free; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrLinkedList.ExtractAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrLinkedList.ExtractIndex(Index: Integer): UnicodeString; +var + Current: TJclUnicodeStrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := ''; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := Current.Value; + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrLinkedList.First: IJclUnicodeStrIterator; +begin + Result := TJclUnicodeStrLinkedListIterator.Create(Self, FStart, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclUnicodeStrLinkedList.GetEnumerator: IJclUnicodeStrIterator; +begin + Result := TJclUnicodeStrLinkedListIterator.Create(Self, FStart, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclUnicodeStrLinkedList.GetString(Index: Integer): UnicodeString; +var + Current: TJclUnicodeStrLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + Result := Current.Value + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrLinkedList.IndexOf(const AString: UnicodeString): Integer; +var + Current: TJclUnicodeStrLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Current := FStart; + Result := 0; + while (Current <> nil) and not ItemsEqual(Current.Value, AString) do + begin + Inc(Result); + Current := Current.Next; + end; + if Current = nil then + Result := -1; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrLinkedList.Insert(Index: Integer; const AString: UnicodeString): Boolean; +var + Current, NewItem: TJclUnicodeStrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AString, ''); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(AString, Current.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if Result then + begin + NewItem := TJclUnicodeStrLinkedListItem.Create; + NewItem.Value := AString; + if Index = 0 then + begin + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end + else + if Index = FSize then + begin + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrLinkedList.InsertAll(Index: Integer; const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; + Current, NewItem, Test: TJclUnicodeStrLinkedListItem; + AddItem: Boolean; + Item: UnicodeString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + if Index = 0 then + begin + It := ACollection.Last; + while It.HasPrevious do + begin + Item := It.Previous; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, ''); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclUnicodeStrLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + if Index = Size then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, ''); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclUnicodeStrLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Previous := FEnd; + if FEnd <> nil then + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, ''); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclUnicodeStrLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrLinkedList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclUnicodeStrLinkedList.Last: IJclUnicodeStrIterator; +begin + Result := TJclUnicodeStrLinkedListIterator.Create(Self, FEnd, False, isLast); +end; + +function TJclUnicodeStrLinkedList.LastIndexOf(const AString: UnicodeString): Integer; +var + Current: TJclUnicodeStrLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + if FEnd <> nil then + begin + Current := FEnd; + Result := FSize - 1; + while (Current <> nil) and not ItemsEqual(Current.Value, AString) do + begin + Dec(Result); + Current := Current.Previous; + end; + if Current = nil then + Result := -1; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrLinkedList.Remove(const AString: UnicodeString): Boolean; +var + Extracted: UnicodeString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AString); + if Result then + begin + Extracted := AString; + FreeString(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrLinkedList.RemoveAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrLinkedList.RetainAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrLinkedList.SetString(Index: Integer; const AString: UnicodeString); +var + Current: TJclUnicodeStrLinkedListItem; + ReplaceItem: Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AString, ''); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(AString, Current.Value) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if ReplaceItem then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + FreeString(Current.Value); + Current.Value := AString; + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrLinkedList.Size: Integer; +begin + Result := FSize; +end; + +function TJclUnicodeStrLinkedList.SubList(First, Count: Integer): IJclUnicodeStrList; +var + Current: TJclUnicodeStrLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := CreateEmptyContainer as IJclUnicodeStrList; + Current := FStart; + while (Current <> nil) and (First > 0) do + begin + Dec(First); + Current := Current.Next; + end; + while (Current <> nil) and (Count > 0) do + begin + Result.Add(Current.Value); + Dec(Count); + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrLinkedList.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclUnicodeStrLinkedList.Create(nil); + AssignPropertiesTo(Result); +end; + +{$ENDIF SUPPORTS_UNICODE_STRING} + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrLinkedListIterator } ============================================================ + +constructor TJclUnicodeStrLinkedListIterator.Create(AOwnList: TJclUnicodeStrLinkedList; ACursor: TJclUnicodeStrLinkedListItem; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnList := AOwnList; + FStart := AStart; + FEqualityComparer := AOwnList as IJclUnicodeStrEqualityComparer; +end; + +function TJclUnicodeStrLinkedListIterator.Add(const AString: UnicodeString): Boolean; +begin + Result := FOwnList.Add(AString); +end; + +procedure TJclUnicodeStrLinkedListIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclUnicodeStrLinkedListIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclUnicodeStrLinkedListIterator then + begin + ADest := TJclUnicodeStrLinkedListIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnList := FOwnList; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclUnicodeStrLinkedListIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclUnicodeStrLinkedListIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclUnicodeStrLinkedListIterator.Extract; +var + OldCursor: TJclUnicodeStrLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrLinkedListIterator.GetString: UnicodeString; +begin + CheckValid; + Result := ''; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnList.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); +end; + +function TJclUnicodeStrLinkedListIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Next <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrLinkedListIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Previous <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrLinkedListIterator.Insert(const AString: UnicodeString): Boolean; +var + NewCursor: TJclUnicodeStrLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := FCursor <> nil; + if Result then + begin + Result := FOwnList.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, ''); + if Result then + begin + case FOwnList.Duplicates of + dupIgnore: + Result := not FOwnList.Contains(AString); + dupAccept: + Result := True; + dupError: + begin + Result := FOwnList.Contains(AString); + if not Result then + raise EJclDuplicateElementError.Create; + end; + end; + if Result then + begin + NewCursor := TJclUnicodeStrLinkedListItem.Create; + NewCursor.Value := AString; + NewCursor.Next := FCursor; + NewCursor.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := NewCursor; + FCursor.Previous := NewCursor; + FCursor := NewCursor; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrLinkedListIterator.IteratorEquals(const AIterator: IJclUnicodeStrIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclUnicodeStrLinkedListIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclUnicodeStrLinkedListIterator then + begin + ItrObj := TJclUnicodeStrLinkedListIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclUnicodeStrLinkedListIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclUnicodeStrLinkedListIterator.Next: UnicodeString; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := ''; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrLinkedListIterator.NextIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclUnicodeStrLinkedListIterator.Previous: UnicodeString; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Previous + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := ''; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrLinkedListIterator.PreviousIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclUnicodeStrLinkedListIterator.Remove; +var + OldCursor: TJclUnicodeStrLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + FCursor.Value := ''; + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrLinkedListIterator.Reset; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + while (FCursor <> nil) and (FCursor.Previous <> nil) do + FCursor := FCursor.Previous; + end; + isLast: + begin + while (FCursor <> nil) and (FCursor.Next <> nil) do + FCursor := FCursor.Next; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrLinkedListIterator.SetString(const AString: UnicodeString); +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + FCursor.Value := ''; + FCursor.Value := AString; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +//=== { TJclSingleLinkedList } ================================================== + +constructor TJclSingleLinkedList.Create(const ACollection: IJclSingleCollection); +begin + inherited Create(); + FStart := nil; + FEnd := nil; + if ACollection <> nil then + AddAll(ACollection); +end; + +destructor TJclSingleLinkedList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclSingleLinkedList.Add(const AValue: Single): Boolean; +var + NewItem: TJclSingleLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if Result then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(AValue, NewItem.Value) then + begin + Result := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if Result then + begin + NewItem := TJclSingleLinkedListItem.Create; + NewItem.Value := AValue; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleLinkedList.AddAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; + Item: Single; + AddItem: Boolean; + NewItem: TJclSingleLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, 0.0); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(Item, NewItem.Value) then + begin + AddItem := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if AddItem then + begin + NewItem := TJclSingleLinkedListItem.Create; + NewItem.Value := Item; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + Result := AddItem and Result; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleLinkedList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ACollection: IJclSingleCollection; +begin + inherited AssignDataTo(Dest); + if Supports(IInterface(Dest), IJclSingleCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclSingleLinkedList.Clear; +var + Old, Current: TJclSingleLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Current := FStart; + while Current <> nil do + begin + FreeSingle(Current.Value); + Old := Current; + Current := Current.Next; + Old.Free; + end; + FSize := 0; + + //Daniele Teti 27/12/2004 + FStart := nil; + FEnd := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleLinkedList.CollectionEquals(const ACollection: IJclSingleCollection): Boolean; +var + It, ItSelf: IJclSingleIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext and It.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleLinkedList.Contains(const AValue: Single): Boolean; +var + Current: TJclSingleLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, AValue) then + begin + Result := True; + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleLinkedList.ContainsAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleLinkedList.Delete(Index: Integer): Single; +var + Current: TJclSingleLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := FreeSingle(Current.Value); + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleLinkedList.Extract(const AValue: Single): Boolean; +var + Current: TJclSingleLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, AValue) then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Current.Value := 0.0; + Current.Free; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleLinkedList.ExtractAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleLinkedList.ExtractIndex(Index: Integer): Single; +var + Current: TJclSingleLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := Current.Value; + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleLinkedList.First: IJclSingleIterator; +begin + Result := TJclSingleLinkedListIterator.Create(Self, FStart, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclSingleLinkedList.GetEnumerator: IJclSingleIterator; +begin + Result := TJclSingleLinkedListIterator.Create(Self, FStart, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclSingleLinkedList.GetValue(Index: Integer): Single; +var + Current: TJclSingleLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + Result := Current.Value + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleLinkedList.IndexOf(const AValue: Single): Integer; +var + Current: TJclSingleLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Current := FStart; + Result := 0; + while (Current <> nil) and not ItemsEqual(Current.Value, AValue) do + begin + Inc(Result); + Current := Current.Next; + end; + if Current = nil then + Result := -1; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleLinkedList.Insert(Index: Integer; const AValue: Single): Boolean; +var + Current, NewItem: TJclSingleLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(AValue, Current.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if Result then + begin + NewItem := TJclSingleLinkedListItem.Create; + NewItem.Value := AValue; + if Index = 0 then + begin + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end + else + if Index = FSize then + begin + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleLinkedList.InsertAll(Index: Integer; const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; + Current, NewItem, Test: TJclSingleLinkedListItem; + AddItem: Boolean; + Item: Single; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + if Index = 0 then + begin + It := ACollection.Last; + while It.HasPrevious do + begin + Item := It.Previous; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, 0.0); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclSingleLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + if Index = Size then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, 0.0); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclSingleLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Previous := FEnd; + if FEnd <> nil then + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, 0.0); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclSingleLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleLinkedList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclSingleLinkedList.Last: IJclSingleIterator; +begin + Result := TJclSingleLinkedListIterator.Create(Self, FEnd, False, isLast); +end; + +function TJclSingleLinkedList.LastIndexOf(const AValue: Single): Integer; +var + Current: TJclSingleLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + if FEnd <> nil then + begin + Current := FEnd; + Result := FSize - 1; + while (Current <> nil) and not ItemsEqual(Current.Value, AValue) do + begin + Dec(Result); + Current := Current.Previous; + end; + if Current = nil then + Result := -1; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleLinkedList.Remove(const AValue: Single): Boolean; +var + Extracted: Single; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeSingle(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleLinkedList.RemoveAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleLinkedList.RetainAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleLinkedList.SetValue(Index: Integer; const AValue: Single); +var + Current: TJclSingleLinkedListItem; + ReplaceItem: Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(AValue, Current.Value) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if ReplaceItem then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + FreeSingle(Current.Value); + Current.Value := AValue; + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleLinkedList.Size: Integer; +begin + Result := FSize; +end; + +function TJclSingleLinkedList.SubList(First, Count: Integer): IJclSingleList; +var + Current: TJclSingleLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := CreateEmptyContainer as IJclSingleList; + Current := FStart; + while (Current <> nil) and (First > 0) do + begin + Dec(First); + Current := Current.Next; + end; + while (Current <> nil) and (Count > 0) do + begin + Result.Add(Current.Value); + Dec(Count); + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleLinkedList.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclSingleLinkedList.Create(nil); + AssignPropertiesTo(Result); +end; + +//=== { TJclSingleLinkedListIterator } ============================================================ + +constructor TJclSingleLinkedListIterator.Create(AOwnList: TJclSingleLinkedList; ACursor: TJclSingleLinkedListItem; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnList := AOwnList; + FStart := AStart; + FEqualityComparer := AOwnList as IJclSingleEqualityComparer; +end; + +function TJclSingleLinkedListIterator.Add(const AValue: Single): Boolean; +begin + Result := FOwnList.Add(AValue); +end; + +procedure TJclSingleLinkedListIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclSingleLinkedListIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclSingleLinkedListIterator then + begin + ADest := TJclSingleLinkedListIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnList := FOwnList; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclSingleLinkedListIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclSingleLinkedListIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclSingleLinkedListIterator.Extract; +var + OldCursor: TJclSingleLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleLinkedListIterator.GetValue: Single; +begin + CheckValid; + Result := 0.0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnList.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); +end; + +function TJclSingleLinkedListIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Next <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleLinkedListIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Previous <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleLinkedListIterator.Insert(const AValue: Single): Boolean; +var + NewCursor: TJclSingleLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := FCursor <> nil; + if Result then + begin + Result := FOwnList.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0); + if Result then + begin + case FOwnList.Duplicates of + dupIgnore: + Result := not FOwnList.Contains(AValue); + dupAccept: + Result := True; + dupError: + begin + Result := FOwnList.Contains(AValue); + if not Result then + raise EJclDuplicateElementError.Create; + end; + end; + if Result then + begin + NewCursor := TJclSingleLinkedListItem.Create; + NewCursor.Value := AValue; + NewCursor.Next := FCursor; + NewCursor.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := NewCursor; + FCursor.Previous := NewCursor; + FCursor := NewCursor; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleLinkedListIterator.IteratorEquals(const AIterator: IJclSingleIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclSingleLinkedListIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclSingleLinkedListIterator then + begin + ItrObj := TJclSingleLinkedListIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclSingleLinkedListIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclSingleLinkedListIterator.Next: Single; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := 0.0; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleLinkedListIterator.NextIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclSingleLinkedListIterator.Previous: Single; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Previous + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := 0.0; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleLinkedListIterator.PreviousIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclSingleLinkedListIterator.Remove; +var + OldCursor: TJclSingleLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + FCursor.Value := 0.0; + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleLinkedListIterator.Reset; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + while (FCursor <> nil) and (FCursor.Previous <> nil) do + FCursor := FCursor.Previous; + end; + isLast: + begin + while (FCursor <> nil) and (FCursor.Next <> nil) do + FCursor := FCursor.Next; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleLinkedListIterator.SetValue(const AValue: Single); +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + FCursor.Value := 0.0; + FCursor.Value := AValue; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclDoubleLinkedList } ================================================== + +constructor TJclDoubleLinkedList.Create(const ACollection: IJclDoubleCollection); +begin + inherited Create(); + FStart := nil; + FEnd := nil; + if ACollection <> nil then + AddAll(ACollection); +end; + +destructor TJclDoubleLinkedList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclDoubleLinkedList.Add(const AValue: Double): Boolean; +var + NewItem: TJclDoubleLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if Result then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(AValue, NewItem.Value) then + begin + Result := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if Result then + begin + NewItem := TJclDoubleLinkedListItem.Create; + NewItem.Value := AValue; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleLinkedList.AddAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; + Item: Double; + AddItem: Boolean; + NewItem: TJclDoubleLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, 0.0); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(Item, NewItem.Value) then + begin + AddItem := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if AddItem then + begin + NewItem := TJclDoubleLinkedListItem.Create; + NewItem.Value := Item; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + Result := AddItem and Result; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleLinkedList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ACollection: IJclDoubleCollection; +begin + inherited AssignDataTo(Dest); + if Supports(IInterface(Dest), IJclDoubleCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclDoubleLinkedList.Clear; +var + Old, Current: TJclDoubleLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Current := FStart; + while Current <> nil do + begin + FreeDouble(Current.Value); + Old := Current; + Current := Current.Next; + Old.Free; + end; + FSize := 0; + + //Daniele Teti 27/12/2004 + FStart := nil; + FEnd := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleLinkedList.CollectionEquals(const ACollection: IJclDoubleCollection): Boolean; +var + It, ItSelf: IJclDoubleIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext and It.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleLinkedList.Contains(const AValue: Double): Boolean; +var + Current: TJclDoubleLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, AValue) then + begin + Result := True; + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleLinkedList.ContainsAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleLinkedList.Delete(Index: Integer): Double; +var + Current: TJclDoubleLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := FreeDouble(Current.Value); + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleLinkedList.Extract(const AValue: Double): Boolean; +var + Current: TJclDoubleLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, AValue) then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Current.Value := 0.0; + Current.Free; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleLinkedList.ExtractAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleLinkedList.ExtractIndex(Index: Integer): Double; +var + Current: TJclDoubleLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := Current.Value; + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleLinkedList.First: IJclDoubleIterator; +begin + Result := TJclDoubleLinkedListIterator.Create(Self, FStart, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclDoubleLinkedList.GetEnumerator: IJclDoubleIterator; +begin + Result := TJclDoubleLinkedListIterator.Create(Self, FStart, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclDoubleLinkedList.GetValue(Index: Integer): Double; +var + Current: TJclDoubleLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + Result := Current.Value + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleLinkedList.IndexOf(const AValue: Double): Integer; +var + Current: TJclDoubleLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Current := FStart; + Result := 0; + while (Current <> nil) and not ItemsEqual(Current.Value, AValue) do + begin + Inc(Result); + Current := Current.Next; + end; + if Current = nil then + Result := -1; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleLinkedList.Insert(Index: Integer; const AValue: Double): Boolean; +var + Current, NewItem: TJclDoubleLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(AValue, Current.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if Result then + begin + NewItem := TJclDoubleLinkedListItem.Create; + NewItem.Value := AValue; + if Index = 0 then + begin + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end + else + if Index = FSize then + begin + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleLinkedList.InsertAll(Index: Integer; const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; + Current, NewItem, Test: TJclDoubleLinkedListItem; + AddItem: Boolean; + Item: Double; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + if Index = 0 then + begin + It := ACollection.Last; + while It.HasPrevious do + begin + Item := It.Previous; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, 0.0); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclDoubleLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + if Index = Size then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, 0.0); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclDoubleLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Previous := FEnd; + if FEnd <> nil then + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, 0.0); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclDoubleLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleLinkedList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclDoubleLinkedList.Last: IJclDoubleIterator; +begin + Result := TJclDoubleLinkedListIterator.Create(Self, FEnd, False, isLast); +end; + +function TJclDoubleLinkedList.LastIndexOf(const AValue: Double): Integer; +var + Current: TJclDoubleLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + if FEnd <> nil then + begin + Current := FEnd; + Result := FSize - 1; + while (Current <> nil) and not ItemsEqual(Current.Value, AValue) do + begin + Dec(Result); + Current := Current.Previous; + end; + if Current = nil then + Result := -1; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleLinkedList.Remove(const AValue: Double): Boolean; +var + Extracted: Double; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeDouble(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleLinkedList.RemoveAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleLinkedList.RetainAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleLinkedList.SetValue(Index: Integer; const AValue: Double); +var + Current: TJclDoubleLinkedListItem; + ReplaceItem: Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(AValue, Current.Value) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if ReplaceItem then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + FreeDouble(Current.Value); + Current.Value := AValue; + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleLinkedList.Size: Integer; +begin + Result := FSize; +end; + +function TJclDoubleLinkedList.SubList(First, Count: Integer): IJclDoubleList; +var + Current: TJclDoubleLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := CreateEmptyContainer as IJclDoubleList; + Current := FStart; + while (Current <> nil) and (First > 0) do + begin + Dec(First); + Current := Current.Next; + end; + while (Current <> nil) and (Count > 0) do + begin + Result.Add(Current.Value); + Dec(Count); + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleLinkedList.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclDoubleLinkedList.Create(nil); + AssignPropertiesTo(Result); +end; + +//=== { TJclDoubleLinkedListIterator } ============================================================ + +constructor TJclDoubleLinkedListIterator.Create(AOwnList: TJclDoubleLinkedList; ACursor: TJclDoubleLinkedListItem; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnList := AOwnList; + FStart := AStart; + FEqualityComparer := AOwnList as IJclDoubleEqualityComparer; +end; + +function TJclDoubleLinkedListIterator.Add(const AValue: Double): Boolean; +begin + Result := FOwnList.Add(AValue); +end; + +procedure TJclDoubleLinkedListIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclDoubleLinkedListIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclDoubleLinkedListIterator then + begin + ADest := TJclDoubleLinkedListIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnList := FOwnList; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclDoubleLinkedListIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclDoubleLinkedListIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclDoubleLinkedListIterator.Extract; +var + OldCursor: TJclDoubleLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleLinkedListIterator.GetValue: Double; +begin + CheckValid; + Result := 0.0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnList.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); +end; + +function TJclDoubleLinkedListIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Next <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleLinkedListIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Previous <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleLinkedListIterator.Insert(const AValue: Double): Boolean; +var + NewCursor: TJclDoubleLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := FCursor <> nil; + if Result then + begin + Result := FOwnList.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0); + if Result then + begin + case FOwnList.Duplicates of + dupIgnore: + Result := not FOwnList.Contains(AValue); + dupAccept: + Result := True; + dupError: + begin + Result := FOwnList.Contains(AValue); + if not Result then + raise EJclDuplicateElementError.Create; + end; + end; + if Result then + begin + NewCursor := TJclDoubleLinkedListItem.Create; + NewCursor.Value := AValue; + NewCursor.Next := FCursor; + NewCursor.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := NewCursor; + FCursor.Previous := NewCursor; + FCursor := NewCursor; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleLinkedListIterator.IteratorEquals(const AIterator: IJclDoubleIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclDoubleLinkedListIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclDoubleLinkedListIterator then + begin + ItrObj := TJclDoubleLinkedListIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclDoubleLinkedListIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclDoubleLinkedListIterator.Next: Double; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := 0.0; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleLinkedListIterator.NextIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclDoubleLinkedListIterator.Previous: Double; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Previous + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := 0.0; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleLinkedListIterator.PreviousIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclDoubleLinkedListIterator.Remove; +var + OldCursor: TJclDoubleLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + FCursor.Value := 0.0; + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleLinkedListIterator.Reset; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + while (FCursor <> nil) and (FCursor.Previous <> nil) do + FCursor := FCursor.Previous; + end; + isLast: + begin + while (FCursor <> nil) and (FCursor.Next <> nil) do + FCursor := FCursor.Next; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleLinkedListIterator.SetValue(const AValue: Double); +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + FCursor.Value := 0.0; + FCursor.Value := AValue; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclExtendedLinkedList } ================================================== + +constructor TJclExtendedLinkedList.Create(const ACollection: IJclExtendedCollection); +begin + inherited Create(); + FStart := nil; + FEnd := nil; + if ACollection <> nil then + AddAll(ACollection); +end; + +destructor TJclExtendedLinkedList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclExtendedLinkedList.Add(const AValue: Extended): Boolean; +var + NewItem: TJclExtendedLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if Result then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(AValue, NewItem.Value) then + begin + Result := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if Result then + begin + NewItem := TJclExtendedLinkedListItem.Create; + NewItem.Value := AValue; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedLinkedList.AddAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; + Item: Extended; + AddItem: Boolean; + NewItem: TJclExtendedLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, 0.0); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(Item, NewItem.Value) then + begin + AddItem := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if AddItem then + begin + NewItem := TJclExtendedLinkedListItem.Create; + NewItem.Value := Item; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + Result := AddItem and Result; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedLinkedList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ACollection: IJclExtendedCollection; +begin + inherited AssignDataTo(Dest); + if Supports(IInterface(Dest), IJclExtendedCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclExtendedLinkedList.Clear; +var + Old, Current: TJclExtendedLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Current := FStart; + while Current <> nil do + begin + FreeExtended(Current.Value); + Old := Current; + Current := Current.Next; + Old.Free; + end; + FSize := 0; + + //Daniele Teti 27/12/2004 + FStart := nil; + FEnd := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedLinkedList.CollectionEquals(const ACollection: IJclExtendedCollection): Boolean; +var + It, ItSelf: IJclExtendedIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext and It.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedLinkedList.Contains(const AValue: Extended): Boolean; +var + Current: TJclExtendedLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, AValue) then + begin + Result := True; + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedLinkedList.ContainsAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedLinkedList.Delete(Index: Integer): Extended; +var + Current: TJclExtendedLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := FreeExtended(Current.Value); + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedLinkedList.Extract(const AValue: Extended): Boolean; +var + Current: TJclExtendedLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, AValue) then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Current.Value := 0.0; + Current.Free; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedLinkedList.ExtractAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedLinkedList.ExtractIndex(Index: Integer): Extended; +var + Current: TJclExtendedLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := Current.Value; + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedLinkedList.First: IJclExtendedIterator; +begin + Result := TJclExtendedLinkedListIterator.Create(Self, FStart, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclExtendedLinkedList.GetEnumerator: IJclExtendedIterator; +begin + Result := TJclExtendedLinkedListIterator.Create(Self, FStart, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclExtendedLinkedList.GetValue(Index: Integer): Extended; +var + Current: TJclExtendedLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + Result := Current.Value + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedLinkedList.IndexOf(const AValue: Extended): Integer; +var + Current: TJclExtendedLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Current := FStart; + Result := 0; + while (Current <> nil) and not ItemsEqual(Current.Value, AValue) do + begin + Inc(Result); + Current := Current.Next; + end; + if Current = nil then + Result := -1; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedLinkedList.Insert(Index: Integer; const AValue: Extended): Boolean; +var + Current, NewItem: TJclExtendedLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(AValue, Current.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if Result then + begin + NewItem := TJclExtendedLinkedListItem.Create; + NewItem.Value := AValue; + if Index = 0 then + begin + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end + else + if Index = FSize then + begin + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedLinkedList.InsertAll(Index: Integer; const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; + Current, NewItem, Test: TJclExtendedLinkedListItem; + AddItem: Boolean; + Item: Extended; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + if Index = 0 then + begin + It := ACollection.Last; + while It.HasPrevious do + begin + Item := It.Previous; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, 0.0); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclExtendedLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + if Index = Size then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, 0.0); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclExtendedLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Previous := FEnd; + if FEnd <> nil then + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, 0.0); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclExtendedLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedLinkedList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclExtendedLinkedList.Last: IJclExtendedIterator; +begin + Result := TJclExtendedLinkedListIterator.Create(Self, FEnd, False, isLast); +end; + +function TJclExtendedLinkedList.LastIndexOf(const AValue: Extended): Integer; +var + Current: TJclExtendedLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + if FEnd <> nil then + begin + Current := FEnd; + Result := FSize - 1; + while (Current <> nil) and not ItemsEqual(Current.Value, AValue) do + begin + Dec(Result); + Current := Current.Previous; + end; + if Current = nil then + Result := -1; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedLinkedList.Remove(const AValue: Extended): Boolean; +var + Extracted: Extended; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeExtended(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedLinkedList.RemoveAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedLinkedList.RetainAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedLinkedList.SetValue(Index: Integer; const AValue: Extended); +var + Current: TJclExtendedLinkedListItem; + ReplaceItem: Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(AValue, Current.Value) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if ReplaceItem then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + FreeExtended(Current.Value); + Current.Value := AValue; + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedLinkedList.Size: Integer; +begin + Result := FSize; +end; + +function TJclExtendedLinkedList.SubList(First, Count: Integer): IJclExtendedList; +var + Current: TJclExtendedLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := CreateEmptyContainer as IJclExtendedList; + Current := FStart; + while (Current <> nil) and (First > 0) do + begin + Dec(First); + Current := Current.Next; + end; + while (Current <> nil) and (Count > 0) do + begin + Result.Add(Current.Value); + Dec(Count); + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedLinkedList.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclExtendedLinkedList.Create(nil); + AssignPropertiesTo(Result); +end; + +//=== { TJclExtendedLinkedListIterator } ============================================================ + +constructor TJclExtendedLinkedListIterator.Create(AOwnList: TJclExtendedLinkedList; ACursor: TJclExtendedLinkedListItem; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnList := AOwnList; + FStart := AStart; + FEqualityComparer := AOwnList as IJclExtendedEqualityComparer; +end; + +function TJclExtendedLinkedListIterator.Add(const AValue: Extended): Boolean; +begin + Result := FOwnList.Add(AValue); +end; + +procedure TJclExtendedLinkedListIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclExtendedLinkedListIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclExtendedLinkedListIterator then + begin + ADest := TJclExtendedLinkedListIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnList := FOwnList; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclExtendedLinkedListIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclExtendedLinkedListIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclExtendedLinkedListIterator.Extract; +var + OldCursor: TJclExtendedLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedLinkedListIterator.GetValue: Extended; +begin + CheckValid; + Result := 0.0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnList.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); +end; + +function TJclExtendedLinkedListIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Next <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedLinkedListIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Previous <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedLinkedListIterator.Insert(const AValue: Extended): Boolean; +var + NewCursor: TJclExtendedLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := FCursor <> nil; + if Result then + begin + Result := FOwnList.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0); + if Result then + begin + case FOwnList.Duplicates of + dupIgnore: + Result := not FOwnList.Contains(AValue); + dupAccept: + Result := True; + dupError: + begin + Result := FOwnList.Contains(AValue); + if not Result then + raise EJclDuplicateElementError.Create; + end; + end; + if Result then + begin + NewCursor := TJclExtendedLinkedListItem.Create; + NewCursor.Value := AValue; + NewCursor.Next := FCursor; + NewCursor.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := NewCursor; + FCursor.Previous := NewCursor; + FCursor := NewCursor; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedLinkedListIterator.IteratorEquals(const AIterator: IJclExtendedIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclExtendedLinkedListIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclExtendedLinkedListIterator then + begin + ItrObj := TJclExtendedLinkedListIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclExtendedLinkedListIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclExtendedLinkedListIterator.Next: Extended; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := 0.0; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedLinkedListIterator.NextIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclExtendedLinkedListIterator.Previous: Extended; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Previous + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := 0.0; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedLinkedListIterator.PreviousIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclExtendedLinkedListIterator.Remove; +var + OldCursor: TJclExtendedLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + FCursor.Value := 0.0; + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedLinkedListIterator.Reset; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + while (FCursor <> nil) and (FCursor.Previous <> nil) do + FCursor := FCursor.Previous; + end; + isLast: + begin + while (FCursor <> nil) and (FCursor.Next <> nil) do + FCursor := FCursor.Next; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedLinkedListIterator.SetValue(const AValue: Extended); +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + FCursor.Value := 0.0; + FCursor.Value := AValue; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclIntegerLinkedList } ================================================== + +constructor TJclIntegerLinkedList.Create(const ACollection: IJclIntegerCollection); +begin + inherited Create(); + FStart := nil; + FEnd := nil; + if ACollection <> nil then + AddAll(ACollection); +end; + +destructor TJclIntegerLinkedList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclIntegerLinkedList.Add(AValue: Integer): Boolean; +var + NewItem: TJclIntegerLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if Result then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(AValue, NewItem.Value) then + begin + Result := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if Result then + begin + NewItem := TJclIntegerLinkedListItem.Create; + NewItem.Value := AValue; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerLinkedList.AddAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; + Item: Integer; + AddItem: Boolean; + NewItem: TJclIntegerLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, 0); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(Item, NewItem.Value) then + begin + AddItem := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if AddItem then + begin + NewItem := TJclIntegerLinkedListItem.Create; + NewItem.Value := Item; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + Result := AddItem and Result; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerLinkedList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ACollection: IJclIntegerCollection; +begin + inherited AssignDataTo(Dest); + if Supports(IInterface(Dest), IJclIntegerCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclIntegerLinkedList.Clear; +var + Old, Current: TJclIntegerLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Current := FStart; + while Current <> nil do + begin + FreeInteger(Current.Value); + Old := Current; + Current := Current.Next; + Old.Free; + end; + FSize := 0; + + //Daniele Teti 27/12/2004 + FStart := nil; + FEnd := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerLinkedList.CollectionEquals(const ACollection: IJclIntegerCollection): Boolean; +var + It, ItSelf: IJclIntegerIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext and It.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerLinkedList.Contains(AValue: Integer): Boolean; +var + Current: TJclIntegerLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, AValue) then + begin + Result := True; + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerLinkedList.ContainsAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerLinkedList.Delete(Index: Integer): Integer; +var + Current: TJclIntegerLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := FreeInteger(Current.Value); + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerLinkedList.Extract(AValue: Integer): Boolean; +var + Current: TJclIntegerLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, AValue) then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Current.Value := 0; + Current.Free; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerLinkedList.ExtractAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerLinkedList.ExtractIndex(Index: Integer): Integer; +var + Current: TJclIntegerLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := Current.Value; + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerLinkedList.First: IJclIntegerIterator; +begin + Result := TJclIntegerLinkedListIterator.Create(Self, FStart, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclIntegerLinkedList.GetEnumerator: IJclIntegerIterator; +begin + Result := TJclIntegerLinkedListIterator.Create(Self, FStart, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclIntegerLinkedList.GetValue(Index: Integer): Integer; +var + Current: TJclIntegerLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + Result := Current.Value + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerLinkedList.IndexOf(AValue: Integer): Integer; +var + Current: TJclIntegerLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Current := FStart; + Result := 0; + while (Current <> nil) and not ItemsEqual(Current.Value, AValue) do + begin + Inc(Result); + Current := Current.Next; + end; + if Current = nil then + Result := -1; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerLinkedList.Insert(Index: Integer; AValue: Integer): Boolean; +var + Current, NewItem: TJclIntegerLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(AValue, Current.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if Result then + begin + NewItem := TJclIntegerLinkedListItem.Create; + NewItem.Value := AValue; + if Index = 0 then + begin + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end + else + if Index = FSize then + begin + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerLinkedList.InsertAll(Index: Integer; const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; + Current, NewItem, Test: TJclIntegerLinkedListItem; + AddItem: Boolean; + Item: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + if Index = 0 then + begin + It := ACollection.Last; + while It.HasPrevious do + begin + Item := It.Previous; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, 0); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclIntegerLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + if Index = Size then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, 0); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclIntegerLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Previous := FEnd; + if FEnd <> nil then + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, 0); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclIntegerLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerLinkedList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntegerLinkedList.Last: IJclIntegerIterator; +begin + Result := TJclIntegerLinkedListIterator.Create(Self, FEnd, False, isLast); +end; + +function TJclIntegerLinkedList.LastIndexOf(AValue: Integer): Integer; +var + Current: TJclIntegerLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + if FEnd <> nil then + begin + Current := FEnd; + Result := FSize - 1; + while (Current <> nil) and not ItemsEqual(Current.Value, AValue) do + begin + Dec(Result); + Current := Current.Previous; + end; + if Current = nil then + Result := -1; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerLinkedList.Remove(AValue: Integer): Boolean; +var + Extracted: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeInteger(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerLinkedList.RemoveAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerLinkedList.RetainAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerLinkedList.SetValue(Index: Integer; AValue: Integer); +var + Current: TJclIntegerLinkedListItem; + ReplaceItem: Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(AValue, Current.Value) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if ReplaceItem then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + FreeInteger(Current.Value); + Current.Value := AValue; + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerLinkedList.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntegerLinkedList.SubList(First, Count: Integer): IJclIntegerList; +var + Current: TJclIntegerLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := CreateEmptyContainer as IJclIntegerList; + Current := FStart; + while (Current <> nil) and (First > 0) do + begin + Dec(First); + Current := Current.Next; + end; + while (Current <> nil) and (Count > 0) do + begin + Result.Add(Current.Value); + Dec(Count); + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerLinkedList.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntegerLinkedList.Create(nil); + AssignPropertiesTo(Result); +end; + +//=== { TJclIntegerLinkedListIterator } ============================================================ + +constructor TJclIntegerLinkedListIterator.Create(AOwnList: TJclIntegerLinkedList; ACursor: TJclIntegerLinkedListItem; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnList := AOwnList; + FStart := AStart; + FEqualityComparer := AOwnList as IJclIntegerEqualityComparer; +end; + +function TJclIntegerLinkedListIterator.Add(AValue: Integer): Boolean; +begin + Result := FOwnList.Add(AValue); +end; + +procedure TJclIntegerLinkedListIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclIntegerLinkedListIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclIntegerLinkedListIterator then + begin + ADest := TJclIntegerLinkedListIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnList := FOwnList; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclIntegerLinkedListIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclIntegerLinkedListIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclIntegerLinkedListIterator.Extract; +var + OldCursor: TJclIntegerLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerLinkedListIterator.GetValue: Integer; +begin + CheckValid; + Result := 0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnList.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); +end; + +function TJclIntegerLinkedListIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Next <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerLinkedListIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Previous <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerLinkedListIterator.Insert(AValue: Integer): Boolean; +var + NewCursor: TJclIntegerLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := FCursor <> nil; + if Result then + begin + Result := FOwnList.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0); + if Result then + begin + case FOwnList.Duplicates of + dupIgnore: + Result := not FOwnList.Contains(AValue); + dupAccept: + Result := True; + dupError: + begin + Result := FOwnList.Contains(AValue); + if not Result then + raise EJclDuplicateElementError.Create; + end; + end; + if Result then + begin + NewCursor := TJclIntegerLinkedListItem.Create; + NewCursor.Value := AValue; + NewCursor.Next := FCursor; + NewCursor.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := NewCursor; + FCursor.Previous := NewCursor; + FCursor := NewCursor; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerLinkedListIterator.IteratorEquals(const AIterator: IJclIntegerIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclIntegerLinkedListIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclIntegerLinkedListIterator then + begin + ItrObj := TJclIntegerLinkedListIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclIntegerLinkedListIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclIntegerLinkedListIterator.Next: Integer; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := 0; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerLinkedListIterator.NextIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclIntegerLinkedListIterator.Previous: Integer; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Previous + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := 0; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerLinkedListIterator.PreviousIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclIntegerLinkedListIterator.Remove; +var + OldCursor: TJclIntegerLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + FCursor.Value := 0; + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerLinkedListIterator.Reset; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + while (FCursor <> nil) and (FCursor.Previous <> nil) do + FCursor := FCursor.Previous; + end; + isLast: + begin + while (FCursor <> nil) and (FCursor.Next <> nil) do + FCursor := FCursor.Next; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerLinkedListIterator.SetValue(AValue: Integer); +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + FCursor.Value := 0; + FCursor.Value := AValue; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclCardinalLinkedList } ================================================== + +constructor TJclCardinalLinkedList.Create(const ACollection: IJclCardinalCollection); +begin + inherited Create(); + FStart := nil; + FEnd := nil; + if ACollection <> nil then + AddAll(ACollection); +end; + +destructor TJclCardinalLinkedList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclCardinalLinkedList.Add(AValue: Cardinal): Boolean; +var + NewItem: TJclCardinalLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if Result then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(AValue, NewItem.Value) then + begin + Result := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if Result then + begin + NewItem := TJclCardinalLinkedListItem.Create; + NewItem.Value := AValue; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalLinkedList.AddAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; + Item: Cardinal; + AddItem: Boolean; + NewItem: TJclCardinalLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, 0); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(Item, NewItem.Value) then + begin + AddItem := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if AddItem then + begin + NewItem := TJclCardinalLinkedListItem.Create; + NewItem.Value := Item; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + Result := AddItem and Result; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalLinkedList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ACollection: IJclCardinalCollection; +begin + inherited AssignDataTo(Dest); + if Supports(IInterface(Dest), IJclCardinalCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclCardinalLinkedList.Clear; +var + Old, Current: TJclCardinalLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Current := FStart; + while Current <> nil do + begin + FreeCardinal(Current.Value); + Old := Current; + Current := Current.Next; + Old.Free; + end; + FSize := 0; + + //Daniele Teti 27/12/2004 + FStart := nil; + FEnd := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalLinkedList.CollectionEquals(const ACollection: IJclCardinalCollection): Boolean; +var + It, ItSelf: IJclCardinalIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext and It.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalLinkedList.Contains(AValue: Cardinal): Boolean; +var + Current: TJclCardinalLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, AValue) then + begin + Result := True; + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalLinkedList.ContainsAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalLinkedList.Delete(Index: Integer): Cardinal; +var + Current: TJclCardinalLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := FreeCardinal(Current.Value); + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalLinkedList.Extract(AValue: Cardinal): Boolean; +var + Current: TJclCardinalLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, AValue) then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Current.Value := 0; + Current.Free; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalLinkedList.ExtractAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalLinkedList.ExtractIndex(Index: Integer): Cardinal; +var + Current: TJclCardinalLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := Current.Value; + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalLinkedList.First: IJclCardinalIterator; +begin + Result := TJclCardinalLinkedListIterator.Create(Self, FStart, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclCardinalLinkedList.GetEnumerator: IJclCardinalIterator; +begin + Result := TJclCardinalLinkedListIterator.Create(Self, FStart, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclCardinalLinkedList.GetValue(Index: Integer): Cardinal; +var + Current: TJclCardinalLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + Result := Current.Value + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalLinkedList.IndexOf(AValue: Cardinal): Integer; +var + Current: TJclCardinalLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Current := FStart; + Result := 0; + while (Current <> nil) and not ItemsEqual(Current.Value, AValue) do + begin + Inc(Result); + Current := Current.Next; + end; + if Current = nil then + Result := -1; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalLinkedList.Insert(Index: Integer; AValue: Cardinal): Boolean; +var + Current, NewItem: TJclCardinalLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(AValue, Current.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if Result then + begin + NewItem := TJclCardinalLinkedListItem.Create; + NewItem.Value := AValue; + if Index = 0 then + begin + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end + else + if Index = FSize then + begin + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalLinkedList.InsertAll(Index: Integer; const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; + Current, NewItem, Test: TJclCardinalLinkedListItem; + AddItem: Boolean; + Item: Cardinal; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + if Index = 0 then + begin + It := ACollection.Last; + while It.HasPrevious do + begin + Item := It.Previous; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, 0); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclCardinalLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + if Index = Size then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, 0); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclCardinalLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Previous := FEnd; + if FEnd <> nil then + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, 0); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclCardinalLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalLinkedList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclCardinalLinkedList.Last: IJclCardinalIterator; +begin + Result := TJclCardinalLinkedListIterator.Create(Self, FEnd, False, isLast); +end; + +function TJclCardinalLinkedList.LastIndexOf(AValue: Cardinal): Integer; +var + Current: TJclCardinalLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + if FEnd <> nil then + begin + Current := FEnd; + Result := FSize - 1; + while (Current <> nil) and not ItemsEqual(Current.Value, AValue) do + begin + Dec(Result); + Current := Current.Previous; + end; + if Current = nil then + Result := -1; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalLinkedList.Remove(AValue: Cardinal): Boolean; +var + Extracted: Cardinal; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeCardinal(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalLinkedList.RemoveAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalLinkedList.RetainAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalLinkedList.SetValue(Index: Integer; AValue: Cardinal); +var + Current: TJclCardinalLinkedListItem; + ReplaceItem: Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(AValue, Current.Value) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if ReplaceItem then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + FreeCardinal(Current.Value); + Current.Value := AValue; + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalLinkedList.Size: Integer; +begin + Result := FSize; +end; + +function TJclCardinalLinkedList.SubList(First, Count: Integer): IJclCardinalList; +var + Current: TJclCardinalLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := CreateEmptyContainer as IJclCardinalList; + Current := FStart; + while (Current <> nil) and (First > 0) do + begin + Dec(First); + Current := Current.Next; + end; + while (Current <> nil) and (Count > 0) do + begin + Result.Add(Current.Value); + Dec(Count); + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalLinkedList.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclCardinalLinkedList.Create(nil); + AssignPropertiesTo(Result); +end; + +//=== { TJclCardinalLinkedListIterator } ============================================================ + +constructor TJclCardinalLinkedListIterator.Create(AOwnList: TJclCardinalLinkedList; ACursor: TJclCardinalLinkedListItem; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnList := AOwnList; + FStart := AStart; + FEqualityComparer := AOwnList as IJclCardinalEqualityComparer; +end; + +function TJclCardinalLinkedListIterator.Add(AValue: Cardinal): Boolean; +begin + Result := FOwnList.Add(AValue); +end; + +procedure TJclCardinalLinkedListIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclCardinalLinkedListIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclCardinalLinkedListIterator then + begin + ADest := TJclCardinalLinkedListIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnList := FOwnList; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclCardinalLinkedListIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclCardinalLinkedListIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclCardinalLinkedListIterator.Extract; +var + OldCursor: TJclCardinalLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalLinkedListIterator.GetValue: Cardinal; +begin + CheckValid; + Result := 0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnList.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); +end; + +function TJclCardinalLinkedListIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Next <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalLinkedListIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Previous <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalLinkedListIterator.Insert(AValue: Cardinal): Boolean; +var + NewCursor: TJclCardinalLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := FCursor <> nil; + if Result then + begin + Result := FOwnList.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0); + if Result then + begin + case FOwnList.Duplicates of + dupIgnore: + Result := not FOwnList.Contains(AValue); + dupAccept: + Result := True; + dupError: + begin + Result := FOwnList.Contains(AValue); + if not Result then + raise EJclDuplicateElementError.Create; + end; + end; + if Result then + begin + NewCursor := TJclCardinalLinkedListItem.Create; + NewCursor.Value := AValue; + NewCursor.Next := FCursor; + NewCursor.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := NewCursor; + FCursor.Previous := NewCursor; + FCursor := NewCursor; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalLinkedListIterator.IteratorEquals(const AIterator: IJclCardinalIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclCardinalLinkedListIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclCardinalLinkedListIterator then + begin + ItrObj := TJclCardinalLinkedListIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclCardinalLinkedListIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclCardinalLinkedListIterator.Next: Cardinal; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := 0; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalLinkedListIterator.NextIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclCardinalLinkedListIterator.Previous: Cardinal; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Previous + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := 0; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalLinkedListIterator.PreviousIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclCardinalLinkedListIterator.Remove; +var + OldCursor: TJclCardinalLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + FCursor.Value := 0; + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalLinkedListIterator.Reset; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + while (FCursor <> nil) and (FCursor.Previous <> nil) do + FCursor := FCursor.Previous; + end; + isLast: + begin + while (FCursor <> nil) and (FCursor.Next <> nil) do + FCursor := FCursor.Next; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalLinkedListIterator.SetValue(AValue: Cardinal); +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + FCursor.Value := 0; + FCursor.Value := AValue; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclInt64LinkedList } ================================================== + +constructor TJclInt64LinkedList.Create(const ACollection: IJclInt64Collection); +begin + inherited Create(); + FStart := nil; + FEnd := nil; + if ACollection <> nil then + AddAll(ACollection); +end; + +destructor TJclInt64LinkedList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclInt64LinkedList.Add(const AValue: Int64): Boolean; +var + NewItem: TJclInt64LinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if Result then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(AValue, NewItem.Value) then + begin + Result := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if Result then + begin + NewItem := TJclInt64LinkedListItem.Create; + NewItem.Value := AValue; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64LinkedList.AddAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; + Item: Int64; + AddItem: Boolean; + NewItem: TJclInt64LinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, 0); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(Item, NewItem.Value) then + begin + AddItem := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if AddItem then + begin + NewItem := TJclInt64LinkedListItem.Create; + NewItem.Value := Item; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + Result := AddItem and Result; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64LinkedList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ACollection: IJclInt64Collection; +begin + inherited AssignDataTo(Dest); + if Supports(IInterface(Dest), IJclInt64Collection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclInt64LinkedList.Clear; +var + Old, Current: TJclInt64LinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Current := FStart; + while Current <> nil do + begin + FreeInt64(Current.Value); + Old := Current; + Current := Current.Next; + Old.Free; + end; + FSize := 0; + + //Daniele Teti 27/12/2004 + FStart := nil; + FEnd := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64LinkedList.CollectionEquals(const ACollection: IJclInt64Collection): Boolean; +var + It, ItSelf: IJclInt64Iterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext and It.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64LinkedList.Contains(const AValue: Int64): Boolean; +var + Current: TJclInt64LinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, AValue) then + begin + Result := True; + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64LinkedList.ContainsAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64LinkedList.Delete(Index: Integer): Int64; +var + Current: TJclInt64LinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := FreeInt64(Current.Value); + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64LinkedList.Extract(const AValue: Int64): Boolean; +var + Current: TJclInt64LinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, AValue) then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Current.Value := 0; + Current.Free; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64LinkedList.ExtractAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64LinkedList.ExtractIndex(Index: Integer): Int64; +var + Current: TJclInt64LinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := Current.Value; + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64LinkedList.First: IJclInt64Iterator; +begin + Result := TJclInt64LinkedListIterator.Create(Self, FStart, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclInt64LinkedList.GetEnumerator: IJclInt64Iterator; +begin + Result := TJclInt64LinkedListIterator.Create(Self, FStart, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclInt64LinkedList.GetValue(Index: Integer): Int64; +var + Current: TJclInt64LinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + Result := Current.Value + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64LinkedList.IndexOf(const AValue: Int64): Integer; +var + Current: TJclInt64LinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Current := FStart; + Result := 0; + while (Current <> nil) and not ItemsEqual(Current.Value, AValue) do + begin + Inc(Result); + Current := Current.Next; + end; + if Current = nil then + Result := -1; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64LinkedList.Insert(Index: Integer; const AValue: Int64): Boolean; +var + Current, NewItem: TJclInt64LinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(AValue, Current.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if Result then + begin + NewItem := TJclInt64LinkedListItem.Create; + NewItem.Value := AValue; + if Index = 0 then + begin + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end + else + if Index = FSize then + begin + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64LinkedList.InsertAll(Index: Integer; const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; + Current, NewItem, Test: TJclInt64LinkedListItem; + AddItem: Boolean; + Item: Int64; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + if Index = 0 then + begin + It := ACollection.Last; + while It.HasPrevious do + begin + Item := It.Previous; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, 0); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclInt64LinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + if Index = Size then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, 0); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclInt64LinkedListItem.Create; + NewItem.Value := Item; + NewItem.Previous := FEnd; + if FEnd <> nil then + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, 0); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclInt64LinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64LinkedList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclInt64LinkedList.Last: IJclInt64Iterator; +begin + Result := TJclInt64LinkedListIterator.Create(Self, FEnd, False, isLast); +end; + +function TJclInt64LinkedList.LastIndexOf(const AValue: Int64): Integer; +var + Current: TJclInt64LinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + if FEnd <> nil then + begin + Current := FEnd; + Result := FSize - 1; + while (Current <> nil) and not ItemsEqual(Current.Value, AValue) do + begin + Dec(Result); + Current := Current.Previous; + end; + if Current = nil then + Result := -1; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64LinkedList.Remove(const AValue: Int64): Boolean; +var + Extracted: Int64; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeInt64(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64LinkedList.RemoveAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64LinkedList.RetainAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64LinkedList.SetValue(Index: Integer; const AValue: Int64); +var + Current: TJclInt64LinkedListItem; + ReplaceItem: Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(AValue, Current.Value) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if ReplaceItem then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + FreeInt64(Current.Value); + Current.Value := AValue; + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64LinkedList.Size: Integer; +begin + Result := FSize; +end; + +function TJclInt64LinkedList.SubList(First, Count: Integer): IJclInt64List; +var + Current: TJclInt64LinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := CreateEmptyContainer as IJclInt64List; + Current := FStart; + while (Current <> nil) and (First > 0) do + begin + Dec(First); + Current := Current.Next; + end; + while (Current <> nil) and (Count > 0) do + begin + Result.Add(Current.Value); + Dec(Count); + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64LinkedList.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclInt64LinkedList.Create(nil); + AssignPropertiesTo(Result); +end; + +//=== { TJclInt64LinkedListIterator } ============================================================ + +constructor TJclInt64LinkedListIterator.Create(AOwnList: TJclInt64LinkedList; ACursor: TJclInt64LinkedListItem; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnList := AOwnList; + FStart := AStart; + FEqualityComparer := AOwnList as IJclInt64EqualityComparer; +end; + +function TJclInt64LinkedListIterator.Add(const AValue: Int64): Boolean; +begin + Result := FOwnList.Add(AValue); +end; + +procedure TJclInt64LinkedListIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclInt64LinkedListIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclInt64LinkedListIterator then + begin + ADest := TJclInt64LinkedListIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnList := FOwnList; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclInt64LinkedListIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclInt64LinkedListIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclInt64LinkedListIterator.Extract; +var + OldCursor: TJclInt64LinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64LinkedListIterator.GetValue: Int64; +begin + CheckValid; + Result := 0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnList.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); +end; + +function TJclInt64LinkedListIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Next <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64LinkedListIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Previous <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64LinkedListIterator.Insert(const AValue: Int64): Boolean; +var + NewCursor: TJclInt64LinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := FCursor <> nil; + if Result then + begin + Result := FOwnList.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0); + if Result then + begin + case FOwnList.Duplicates of + dupIgnore: + Result := not FOwnList.Contains(AValue); + dupAccept: + Result := True; + dupError: + begin + Result := FOwnList.Contains(AValue); + if not Result then + raise EJclDuplicateElementError.Create; + end; + end; + if Result then + begin + NewCursor := TJclInt64LinkedListItem.Create; + NewCursor.Value := AValue; + NewCursor.Next := FCursor; + NewCursor.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := NewCursor; + FCursor.Previous := NewCursor; + FCursor := NewCursor; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64LinkedListIterator.IteratorEquals(const AIterator: IJclInt64Iterator): Boolean; +var + Obj: TObject; + ItrObj: TJclInt64LinkedListIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclInt64LinkedListIterator then + begin + ItrObj := TJclInt64LinkedListIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclInt64LinkedListIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclInt64LinkedListIterator.Next: Int64; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := 0; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64LinkedListIterator.NextIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclInt64LinkedListIterator.Previous: Int64; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Previous + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := 0; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64LinkedListIterator.PreviousIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclInt64LinkedListIterator.Remove; +var + OldCursor: TJclInt64LinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + FCursor.Value := 0; + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64LinkedListIterator.Reset; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + while (FCursor <> nil) and (FCursor.Previous <> nil) do + FCursor := FCursor.Previous; + end; + isLast: + begin + while (FCursor <> nil) and (FCursor.Next <> nil) do + FCursor := FCursor.Next; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64LinkedListIterator.SetValue(const AValue: Int64); +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + FCursor.Value := 0; + FCursor.Value := AValue; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclPtrLinkedList } ================================================== + +constructor TJclPtrLinkedList.Create(const ACollection: IJclPtrCollection); +begin + inherited Create(); + FStart := nil; + FEnd := nil; + if ACollection <> nil then + AddAll(ACollection); +end; + +destructor TJclPtrLinkedList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclPtrLinkedList.Add(APtr: Pointer): Boolean; +var + NewItem: TJclPtrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(APtr, nil); + if Result then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(APtr, NewItem.Value) then + begin + Result := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if Result then + begin + NewItem := TJclPtrLinkedListItem.Create; + NewItem.Value := APtr; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrLinkedList.AddAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; + Item: Pointer; + AddItem: Boolean; + NewItem: TJclPtrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, nil); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(Item, NewItem.Value) then + begin + AddItem := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if AddItem then + begin + NewItem := TJclPtrLinkedListItem.Create; + NewItem.Value := Item; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + Result := AddItem and Result; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrLinkedList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ACollection: IJclPtrCollection; +begin + inherited AssignDataTo(Dest); + if Supports(IInterface(Dest), IJclPtrCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclPtrLinkedList.Clear; +var + Old, Current: TJclPtrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Current := FStart; + while Current <> nil do + begin + FreePointer(Current.Value); + Old := Current; + Current := Current.Next; + Old.Free; + end; + FSize := 0; + + //Daniele Teti 27/12/2004 + FStart := nil; + FEnd := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrLinkedList.CollectionEquals(const ACollection: IJclPtrCollection): Boolean; +var + It, ItSelf: IJclPtrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext and It.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrLinkedList.Contains(APtr: Pointer): Boolean; +var + Current: TJclPtrLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, APtr) then + begin + Result := True; + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrLinkedList.ContainsAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrLinkedList.Delete(Index: Integer): Pointer; +var + Current: TJclPtrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := FreePointer(Current.Value); + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrLinkedList.Extract(APtr: Pointer): Boolean; +var + Current: TJclPtrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, APtr) then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Current.Value := nil; + Current.Free; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrLinkedList.ExtractAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrLinkedList.ExtractIndex(Index: Integer): Pointer; +var + Current: TJclPtrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := Current.Value; + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrLinkedList.First: IJclPtrIterator; +begin + Result := TJclPtrLinkedListIterator.Create(Self, FStart, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclPtrLinkedList.GetEnumerator: IJclPtrIterator; +begin + Result := TJclPtrLinkedListIterator.Create(Self, FStart, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclPtrLinkedList.GetPointer(Index: Integer): Pointer; +var + Current: TJclPtrLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + Result := Current.Value + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrLinkedList.IndexOf(APtr: Pointer): Integer; +var + Current: TJclPtrLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Current := FStart; + Result := 0; + while (Current <> nil) and not ItemsEqual(Current.Value, APtr) do + begin + Inc(Result); + Current := Current.Next; + end; + if Current = nil then + Result := -1; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrLinkedList.Insert(Index: Integer; APtr: Pointer): Boolean; +var + Current, NewItem: TJclPtrLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(APtr, nil); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(APtr, Current.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if Result then + begin + NewItem := TJclPtrLinkedListItem.Create; + NewItem.Value := APtr; + if Index = 0 then + begin + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end + else + if Index = FSize then + begin + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrLinkedList.InsertAll(Index: Integer; const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; + Current, NewItem, Test: TJclPtrLinkedListItem; + AddItem: Boolean; + Item: Pointer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + if Index = 0 then + begin + It := ACollection.Last; + while It.HasPrevious do + begin + Item := It.Previous; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, nil); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclPtrLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + if Index = Size then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, nil); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclPtrLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Previous := FEnd; + if FEnd <> nil then + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, nil); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclPtrLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrLinkedList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclPtrLinkedList.Last: IJclPtrIterator; +begin + Result := TJclPtrLinkedListIterator.Create(Self, FEnd, False, isLast); +end; + +function TJclPtrLinkedList.LastIndexOf(APtr: Pointer): Integer; +var + Current: TJclPtrLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + if FEnd <> nil then + begin + Current := FEnd; + Result := FSize - 1; + while (Current <> nil) and not ItemsEqual(Current.Value, APtr) do + begin + Dec(Result); + Current := Current.Previous; + end; + if Current = nil then + Result := -1; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrLinkedList.Remove(APtr: Pointer): Boolean; +var + Extracted: Pointer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(APtr); + if Result then + begin + Extracted := APtr; + FreePointer(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrLinkedList.RemoveAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrLinkedList.RetainAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrLinkedList.SetPointer(Index: Integer; APtr: Pointer); +var + Current: TJclPtrLinkedListItem; + ReplaceItem: Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + ReplaceItem := FAllowDefaultElements or not ItemsEqual(APtr, nil); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(APtr, Current.Value) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if ReplaceItem then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + FreePointer(Current.Value); + Current.Value := APtr; + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrLinkedList.Size: Integer; +begin + Result := FSize; +end; + +function TJclPtrLinkedList.SubList(First, Count: Integer): IJclPtrList; +var + Current: TJclPtrLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := CreateEmptyContainer as IJclPtrList; + Current := FStart; + while (Current <> nil) and (First > 0) do + begin + Dec(First); + Current := Current.Next; + end; + while (Current <> nil) and (Count > 0) do + begin + Result.Add(Current.Value); + Dec(Count); + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrLinkedList.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclPtrLinkedList.Create(nil); + AssignPropertiesTo(Result); +end; + +//=== { TJclPtrLinkedListIterator } ============================================================ + +constructor TJclPtrLinkedListIterator.Create(AOwnList: TJclPtrLinkedList; ACursor: TJclPtrLinkedListItem; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnList := AOwnList; + FStart := AStart; + FEqualityComparer := AOwnList as IJclPtrEqualityComparer; +end; + +function TJclPtrLinkedListIterator.Add(APtr: Pointer): Boolean; +begin + Result := FOwnList.Add(APtr); +end; + +procedure TJclPtrLinkedListIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclPtrLinkedListIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclPtrLinkedListIterator then + begin + ADest := TJclPtrLinkedListIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnList := FOwnList; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclPtrLinkedListIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPtrLinkedListIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclPtrLinkedListIterator.Extract; +var + OldCursor: TJclPtrLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrLinkedListIterator.GetPointer: Pointer; +begin + CheckValid; + Result := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnList.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); +end; + +function TJclPtrLinkedListIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Next <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrLinkedListIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Previous <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrLinkedListIterator.Insert(APtr: Pointer): Boolean; +var + NewCursor: TJclPtrLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := FCursor <> nil; + if Result then + begin + Result := FOwnList.AllowDefaultElements or not FEqualityComparer.ItemsEqual(APtr, nil); + if Result then + begin + case FOwnList.Duplicates of + dupIgnore: + Result := not FOwnList.Contains(APtr); + dupAccept: + Result := True; + dupError: + begin + Result := FOwnList.Contains(APtr); + if not Result then + raise EJclDuplicateElementError.Create; + end; + end; + if Result then + begin + NewCursor := TJclPtrLinkedListItem.Create; + NewCursor.Value := APtr; + NewCursor.Next := FCursor; + NewCursor.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := NewCursor; + FCursor.Previous := NewCursor; + FCursor := NewCursor; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrLinkedListIterator.IteratorEquals(const AIterator: IJclPtrIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclPtrLinkedListIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclPtrLinkedListIterator then + begin + ItrObj := TJclPtrLinkedListIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclPtrLinkedListIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclPtrLinkedListIterator.Next: Pointer; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrLinkedListIterator.NextIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclPtrLinkedListIterator.Previous: Pointer; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Previous + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrLinkedListIterator.PreviousIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclPtrLinkedListIterator.Remove; +var + OldCursor: TJclPtrLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + FCursor.Value := nil; + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrLinkedListIterator.Reset; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + while (FCursor <> nil) and (FCursor.Previous <> nil) do + FCursor := FCursor.Previous; + end; + isLast: + begin + while (FCursor <> nil) and (FCursor.Next <> nil) do + FCursor := FCursor.Next; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrLinkedListIterator.SetPointer(APtr: Pointer); +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + FCursor.Value := nil; + FCursor.Value := APtr; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclLinkedList } ================================================== + +constructor TJclLinkedList.Create(const ACollection: IJclCollection; AOwnsObjects: Boolean); +begin + inherited Create(AOwnsObjects); + FStart := nil; + FEnd := nil; + if ACollection <> nil then + AddAll(ACollection); +end; + +destructor TJclLinkedList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclLinkedList.Add(AObject: TObject): Boolean; +var + NewItem: TJclLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AObject, nil); + if Result then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(AObject, NewItem.Value) then + begin + Result := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if Result then + begin + NewItem := TJclLinkedListItem.Create; + NewItem.Value := AObject; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.AddAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; + Item: TObject; + AddItem: Boolean; + NewItem: TJclLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, nil); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(Item, NewItem.Value) then + begin + AddItem := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if AddItem then + begin + NewItem := TJclLinkedListItem.Create; + NewItem.Value := Item; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + Result := AddItem and Result; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclLinkedList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ACollection: IJclCollection; +begin + inherited AssignDataTo(Dest); + if Supports(IInterface(Dest), IJclCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclLinkedList.Clear; +var + Old, Current: TJclLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Current := FStart; + while Current <> nil do + begin + FreeObject(Current.Value); + Old := Current; + Current := Current.Next; + Old.Free; + end; + FSize := 0; + + //Daniele Teti 27/12/2004 + FStart := nil; + FEnd := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.CollectionEquals(const ACollection: IJclCollection): Boolean; +var + It, ItSelf: IJclIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext and It.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.Contains(AObject: TObject): Boolean; +var + Current: TJclLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, AObject) then + begin + Result := True; + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.ContainsAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.Delete(Index: Integer): TObject; +var + Current: TJclLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := FreeObject(Current.Value); + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.Extract(AObject: TObject): Boolean; +var + Current: TJclLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, AObject) then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Current.Value := nil; + Current.Free; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.ExtractAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.ExtractIndex(Index: Integer): TObject; +var + Current: TJclLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := Current.Value; + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.First: IJclIterator; +begin + Result := TJclLinkedListIterator.Create(Self, FStart, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclLinkedList.GetEnumerator: IJclIterator; +begin + Result := TJclLinkedListIterator.Create(Self, FStart, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclLinkedList.GetObject(Index: Integer): TObject; +var + Current: TJclLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + Result := Current.Value + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.IndexOf(AObject: TObject): Integer; +var + Current: TJclLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Current := FStart; + Result := 0; + while (Current <> nil) and not ItemsEqual(Current.Value, AObject) do + begin + Inc(Result); + Current := Current.Next; + end; + if Current = nil then + Result := -1; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.Insert(Index: Integer; AObject: TObject): Boolean; +var + Current, NewItem: TJclLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AObject, nil); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(AObject, Current.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if Result then + begin + NewItem := TJclLinkedListItem.Create; + NewItem.Value := AObject; + if Index = 0 then + begin + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end + else + if Index = FSize then + begin + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.InsertAll(Index: Integer; const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; + Current, NewItem, Test: TJclLinkedListItem; + AddItem: Boolean; + Item: TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + if Index = 0 then + begin + It := ACollection.Last; + while It.HasPrevious do + begin + Item := It.Previous; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, nil); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + if Index = Size then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, nil); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Previous := FEnd; + if FEnd <> nil then + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, nil); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TJclLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclLinkedList.Last: IJclIterator; +begin + Result := TJclLinkedListIterator.Create(Self, FEnd, False, isLast); +end; + +function TJclLinkedList.LastIndexOf(AObject: TObject): Integer; +var + Current: TJclLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + if FEnd <> nil then + begin + Current := FEnd; + Result := FSize - 1; + while (Current <> nil) and not ItemsEqual(Current.Value, AObject) do + begin + Dec(Result); + Current := Current.Previous; + end; + if Current = nil then + Result := -1; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.Remove(AObject: TObject): Boolean; +var + Extracted: TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AObject); + if Result then + begin + Extracted := AObject; + FreeObject(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.RemoveAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.RetainAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclLinkedList.SetObject(Index: Integer; AObject: TObject); +var + Current: TJclLinkedListItem; + ReplaceItem: Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AObject, nil); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(AObject, Current.Value) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if ReplaceItem then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + FreeObject(Current.Value); + Current.Value := AObject; + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.Size: Integer; +begin + Result := FSize; +end; + +function TJclLinkedList.SubList(First, Count: Integer): IJclList; +var + Current: TJclLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := CreateEmptyContainer as IJclList; + Current := FStart; + while (Current <> nil) and (First > 0) do + begin + Dec(First); + Current := Current.Next; + end; + while (Current <> nil) and (Count > 0) do + begin + Result.Add(Current.Value); + Dec(Count); + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclLinkedList.Create(nil, False); + AssignPropertiesTo(Result); +end; + +//=== { TJclLinkedListIterator } ============================================================ + +constructor TJclLinkedListIterator.Create(AOwnList: TJclLinkedList; ACursor: TJclLinkedListItem; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnList := AOwnList; + FStart := AStart; + FEqualityComparer := AOwnList as IJclEqualityComparer; +end; + +function TJclLinkedListIterator.Add(AObject: TObject): Boolean; +begin + Result := FOwnList.Add(AObject); +end; + +procedure TJclLinkedListIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclLinkedListIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclLinkedListIterator then + begin + ADest := TJclLinkedListIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnList := FOwnList; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclLinkedListIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclLinkedListIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclLinkedListIterator.Extract; +var + OldCursor: TJclLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedListIterator.GetObject: TObject; +begin + CheckValid; + Result := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnList.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); +end; + +function TJclLinkedListIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Next <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedListIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Previous <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedListIterator.Insert(AObject: TObject): Boolean; +var + NewCursor: TJclLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := FCursor <> nil; + if Result then + begin + Result := FOwnList.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AObject, nil); + if Result then + begin + case FOwnList.Duplicates of + dupIgnore: + Result := not FOwnList.Contains(AObject); + dupAccept: + Result := True; + dupError: + begin + Result := FOwnList.Contains(AObject); + if not Result then + raise EJclDuplicateElementError.Create; + end; + end; + if Result then + begin + NewCursor := TJclLinkedListItem.Create; + NewCursor.Value := AObject; + NewCursor.Next := FCursor; + NewCursor.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := NewCursor; + FCursor.Previous := NewCursor; + FCursor := NewCursor; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedListIterator.IteratorEquals(const AIterator: IJclIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclLinkedListIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclLinkedListIterator then + begin + ItrObj := TJclLinkedListIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclLinkedListIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclLinkedListIterator.Next: TObject; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedListIterator.NextIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclLinkedListIterator.Previous: TObject; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Previous + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedListIterator.PreviousIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclLinkedListIterator.Remove; +var + OldCursor: TJclLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + (FownList as IJclObjectOwner).FreeObject(FCursor.Value); + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclLinkedListIterator.Reset; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + while (FCursor <> nil) and (FCursor.Previous <> nil) do + FCursor := FCursor.Previous; + end; + isLast: + begin + while (FCursor <> nil) and (FCursor.Next <> nil) do + FCursor := FCursor.Next; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclLinkedListIterator.SetObject(AObject: TObject); +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + (FownList as IJclObjectOwner).FreeObject(FCursor.Value); + FCursor.Value := AObject; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + + +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +//=== { TJclLinkedList } ================================================== + +constructor TJclLinkedList.Create(const ACollection: IJclCollection; AOwnsItems: Boolean); +begin + inherited Create(AOwnsItems); + FStart := nil; + FEnd := nil; + if ACollection <> nil then + AddAll(ACollection); +end; + +destructor TJclLinkedList.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclLinkedList.Add(const AItem: T): Boolean; +var + NewItem: TLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AItem, Default(T)); + if Result then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(AItem, NewItem.Value) then + begin + Result := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if Result then + begin + NewItem := TLinkedListItem.Create; + NewItem.Value := AItem; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.AddAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; + Item: T; + AddItem: Boolean; + NewItem: TLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, Default(T)); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(Item, NewItem.Value) then + begin + AddItem := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if AddItem then + begin + NewItem := TLinkedListItem.Create; + NewItem.Value := Item; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + Result := AddItem and Result; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclLinkedList.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ACollection: IJclCollection; +begin + inherited AssignDataTo(Dest); + if Supports(IInterface(Dest), IJclCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclLinkedList.Clear; +var + Old, Current: TLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Current := FStart; + while Current <> nil do + begin + FreeItem(Current.Value); + Old := Current; + Current := Current.Next; + Old.Free; + end; + FSize := 0; + + //Daniele Teti 27/12/2004 + FStart := nil; + FEnd := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.CollectionEquals(const ACollection: IJclCollection): Boolean; +var + It, ItSelf: IJclIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext and It.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.Contains(const AItem: T): Boolean; +var + Current: TLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, AItem) then + begin + Result := True; + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.ContainsAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.Delete(Index: Integer): T; +var + Current: TLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Default(T); + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := FreeItem(Current.Value); + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.Extract(const AItem: T): Boolean; +var + Current: TLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, AItem) then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Current.Value := Default(T); + Current.Free; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.ExtractAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.ExtractIndex(Index: Integer): T; +var + Current: TLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Default(T); + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := Current.Value; + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.First: IJclIterator; +begin + Result := TLinkedListIterator.Create(Self, FStart, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclLinkedList.GetEnumerator: IJclIterator; +begin + Result := TLinkedListIterator.Create(Self, FStart, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclLinkedList.GetItem(Index: Integer): T; +var + Current: TLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := Default(T); + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + Result := Current.Value + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.IndexOf(const AItem: T): Integer; +var + Current: TLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Current := FStart; + Result := 0; + while (Current <> nil) and not ItemsEqual(Current.Value, AItem) do + begin + Inc(Result); + Current := Current.Next; + end; + if Current = nil then + Result := -1; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.Insert(Index: Integer; const AItem: T): Boolean; +var + Current, NewItem: TLinkedListItem; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AItem, Default(T)); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(AItem, Current.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if Result then + begin + NewItem := TLinkedListItem.Create; + NewItem.Value := AItem; + if Index = 0 then + begin + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end + else + if Index = FSize then + begin + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.InsertAll(Index: Integer; const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; + Current, NewItem, Test: TLinkedListItem; + AddItem: Boolean; + Item: T; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + if Index = 0 then + begin + It := ACollection.Last; + while It.HasPrevious do + begin + Item := It.Previous; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, Default(T)); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + if Index = Size then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, Default(T)); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Previous := FEnd; + if FEnd <> nil then + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, Default(T)); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := TLinkedListItem.Create; + NewItem.Value := Item; + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclLinkedList.Last: IJclIterator; +begin + Result := TLinkedListIterator.Create(Self, FEnd, False, isLast); +end; + +function TJclLinkedList.LastIndexOf(const AItem: T): Integer; +var + Current: TLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + if FEnd <> nil then + begin + Current := FEnd; + Result := FSize - 1; + while (Current <> nil) and not ItemsEqual(Current.Value, AItem) do + begin + Dec(Result); + Current := Current.Previous; + end; + if Current = nil then + Result := -1; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.Remove(const AItem: T): Boolean; +var + Extracted: T; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AItem); + if Result then + begin + Extracted := AItem; + FreeItem(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.RemoveAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.RetainAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclLinkedList.SetItem(Index: Integer; const AItem: T); +var + Current: TLinkedListItem; + ReplaceItem: Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AItem, Default(T)); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(AItem, Current.Value) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if ReplaceItem then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + FreeItem(Current.Value); + Current.Value := AItem; + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedList.Size: Integer; +begin + Result := FSize; +end; + +function TJclLinkedList.SubList(First, Count: Integer): IJclList; +var + Current: TLinkedListItem; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := CreateEmptyContainer as IJclList; + Current := FStart; + while (Current <> nil) and (First > 0) do + begin + Dec(First); + Current := Current.Next; + end; + while (Current <> nil) and (Count > 0) do + begin + Result.Add(Current.Value); + Dec(Count); + Current := Current.Next; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclLinkedListIterator } ============================================================ + +constructor TJclLinkedListIterator.Create(AOwnList: TJclLinkedList; ACursor: TJclLinkedList.TLinkedListItem; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnList := AOwnList; + FStart := AStart; + FEqualityComparer := AOwnList as IJclEqualityComparer; +end; + +function TJclLinkedListIterator.Add(const AItem: T): Boolean; +begin + Result := FOwnList.Add(AItem); +end; + +procedure TJclLinkedListIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclLinkedListIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclLinkedListIterator then + begin + ADest := TJclLinkedListIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnList := FOwnList; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclLinkedListIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclLinkedListIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclLinkedListIterator.Extract; +var + OldCursor: TJclLinkedList.TLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedListIterator.GetItem: T; +begin + CheckValid; + Result := Default(T); + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnList.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); +end; + +function TJclLinkedListIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Next <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedListIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := (FCursor <> nil) and (FCursor.Previous <> nil) + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedListIterator.Insert(const AItem: T): Boolean; +var + NewCursor: TJclLinkedList.TLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := FCursor <> nil; + if Result then + begin + Result := FOwnList.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AItem, Default(T)); + if Result then + begin + case FOwnList.Duplicates of + dupIgnore: + Result := not FOwnList.Contains(AItem); + dupAccept: + Result := True; + dupError: + begin + Result := FOwnList.Contains(AItem); + if not Result then + raise EJclDuplicateElementError.Create; + end; + end; + if Result then + begin + NewCursor := TJclLinkedList.TLinkedListItem.Create; + NewCursor.Value := AItem; + NewCursor.Next := FCursor; + NewCursor.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := NewCursor; + FCursor.Previous := NewCursor; + FCursor := NewCursor; + end; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedListIterator.IteratorEquals(const AIterator: IJclIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclLinkedListIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclLinkedListIterator then + begin + ItrObj := TJclLinkedListIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclLinkedListIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclLinkedListIterator.Next: T; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := Default(T); + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedListIterator.NextIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclLinkedListIterator.Previous: T; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Previous + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := Default(T); + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclLinkedListIterator.PreviousIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclLinkedListIterator.Remove; +var + OldCursor: TJclLinkedList.TLinkedListItem; +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + (FownList as IJclItemOwner).FreeItem(FCursor.Value); + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclLinkedListIterator.Reset; +begin + {$IFDEF THREADSAFE} + FOwnList.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + while (FCursor <> nil) and (FCursor.Previous <> nil) do + FCursor := FCursor.Previous; + end; + isLast: + begin + while (FCursor <> nil) and (FCursor.Next <> nil) do + FCursor := FCursor.Next; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnList.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclLinkedListIterator.SetItem(const AItem: T); +begin + if FOwnList.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnList.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + (FownList as IJclItemOwner).FreeItem(FCursor.Value); + FCursor.Value := AItem; + {$IFDEF THREADSAFE} + finally + FOwnList.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclLinkedListE } ================================================= + +constructor TJclLinkedListE.Create(const AEqualityComparer: IJclEqualityComparer; + const ACollection: IJclCollection; AOwnsItems: Boolean); +begin + inherited Create(ACollection, AOwnsItems); + FEqualityComparer := AEqualityComparer; +end; + +procedure TJclLinkedListE.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclLinkedListE then + TJclLinkedListE(Dest).FEqualityComparer := FEqualityComparer; +end; + +function TJclLinkedListE.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclLinkedListE.Create(EqualityComparer, nil, False); + AssignPropertiesTo(Result); +end; + +function TJclLinkedListE.ItemsEqual(const A, B: T): Boolean; +begin + if EqualityComparer <> nil then + Result := EqualityComparer.ItemsEqual(A, B) + else + Result := inherited ItemsEqual(A, B); +end; + +//=== { TJclLinkedListF } ================================================= + +constructor TJclLinkedListF.Create(const AEqualityCompare: TEqualityCompare; + const ACollection: IJclCollection; AOwnsItems: Boolean); +begin + inherited Create(ACollection, AOwnsItems); + SetEqualityCompare(AEqualityCompare); +end; + +function TJclLinkedListF.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclLinkedListF.Create(EqualityCompare, nil, False); + AssignPropertiesTo(Result); +end; + +//=== { TJclLinkedListI } ================================================= + +function TJclLinkedListI.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclLinkedListI.Create(nil, False); + AssignPropertiesTo(Result); +end; + +function TJclLinkedListI.ItemsEqual(const A, B: T): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + Result := A.Equals(B); +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclLogic.pas b/3rdParty/JCL/source/common/JclLogic.pas index e9ab5bcc..1a3587e5 100644 --- a/3rdParty/JCL/source/common/JclLogic.pas +++ b/3rdParty/JCL/source/common/JclLogic.pas @@ -1,2427 +1,2427 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is JclLogic.pas. } -{ } -{ The Initial Developer of the Original Code is Marcel van Brakel. } -{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. All rights reserved. } -{ } -{ Contributor(s): } -{ Marcel Bestebroer (marcelb) } -{ Marcel van Brakel } -{ ESB Consultancy } -{ Martin Kimmings } -{ Robert Marquardt (marquardt) } -{ Chris Morris } -{ Andreas Schmidt shmia at bizerba.de } -{ Michael Schnell } -{ Matthias Thoma (mthoma) } -{ Petr Vones (pvones) } -{ } -{**************************************************************************************************} -{ } -{ Various routines to perform various arithmetic and logical operations on one or more ordinal } -{ values (integer numbers). This includes various bit manipulation routines, min/max testing and } -{ conversion to string. } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -{.$DEFINE PUREPASCAL} - -unit JclLogic; - -{$I jcl.inc} -{$RANGECHECKS OFF} - -interface - -{$IFDEF UNITVERSIONING} -uses - JclUnitVersioning; -{$ENDIF UNITVERSIONING} - -// Conversion -function OrdToBinary(Value: Byte): string; overload; -function OrdToBinary(Value: ShortInt): string; overload; -function OrdToBinary(Value: SmallInt): string; overload; -function OrdToBinary(Value: Word): string; overload; -function OrdToBinary(Value: Integer): string; overload; -function OrdToBinary(Value: Cardinal): string; overload; -function OrdToBinary(Value: Int64): string; overload; - -// Bit manipulation -type - TBitRange = Byte; - TBooleanArray = array of Boolean; - -function BitsHighest(X: Byte): Integer; overload; -function BitsHighest(X: ShortInt): Integer; overload; -function BitsHighest(X: SmallInt): Integer; overload; -function BitsHighest(X: Word): Integer; overload; -function BitsHighest(X: Integer): Integer; overload; -function BitsHighest(X: Cardinal): Integer; overload; -function BitsHighest(X: Int64): Integer; overload; - -function BitsLowest(X: Byte): Integer; overload; -function BitsLowest(X: Shortint): Integer; overload; -function BitsLowest(X: Smallint): Integer; overload; -function BitsLowest(X: Word): Integer; overload; -function BitsLowest(X: Cardinal): Integer; overload; -function BitsLowest(X: Integer): Integer; overload; -function BitsLowest(X: Int64): Integer; overload; - -function ClearBit(const Value: Byte; const Bit: TBitRange): Byte; overload; -function ClearBit(const Value: Shortint; const Bit: TBitRange): Shortint; overload; -function ClearBit(const Value: Smallint; const Bit: TBitRange): Smallint; overload; -function ClearBit(const Value: Word; const Bit: TBitRange): Word; overload; -function ClearBit(const Value: Integer; const Bit: TBitRange): Integer; overload; -function ClearBit(const Value: Cardinal; const Bit: TBitRange): Cardinal; overload; -function ClearBit(const Value: Int64; const Bit: TBitRange): Int64; overload; -procedure ClearBitBuffer(var Value; const Bit: Cardinal); overload; -{$IFDEF CPU64} -procedure ClearBitBuffer(var Value; const Bit: Int64); overload; -{$ENDIF CPU64} - -function CountBitsSet(X: Byte): Integer; overload; -function CountBitsSet(X: Word): Integer; overload; -function CountBitsSet(X: Smallint): Integer; overload; -function CountBitsSet(X: ShortInt): Integer; overload; -function CountBitsSet(X: Integer): Integer; overload; -function CountBitsSet(X: Cardinal): Integer; overload; -function CountBitsSet(X: Int64): Integer; overload; -function CountBitsSet(P: Pointer; Count: Cardinal): Cardinal; overload; - -function CountBitsCleared(X: Byte): Integer; overload; -function CountBitsCleared(X: Shortint): Integer; overload; -function CountBitsCleared(X: Smallint): Integer; overload; -function CountBitsCleared(X: Word): Integer; overload; -function CountBitsCleared(X: Integer): Integer; overload; -function CountBitsCleared(X: Cardinal): Integer; overload; -function CountBitsCleared(X: Int64): Integer; overload; -function CountBitsCleared(P: Pointer; Count: Cardinal): Cardinal; overload; - -function LRot(const Value: Byte; const Count: TBitRange): Byte; overload; -function LRot(const Value: Word; const Count: TBitRange): Word; overload; -function LRot(const Value: Integer; const Count: TBitRange): Integer; overload; -function LRot(const Value: Int64; const Count: TBitRange): Int64; overload; -function ReverseBits(Value: Byte): Byte; overload; -function ReverseBits(Value: Shortint): Shortint; overload; -function ReverseBits(Value: Smallint): Smallint; overload; -function ReverseBits(Value: Word): Word; overload; -function ReverseBits(Value: Integer): Integer; overload; -function ReverseBits(Value: Cardinal): Cardinal; overload; -function ReverseBits(Value: Int64): Int64; overload; -function ReverseBits(P: Pointer; Count: Integer): Pointer; overload; - -function RRot(const Value: Byte; const Count: TBitRange): Byte; overload; -function RRot(const Value: Word; const Count: TBitRange): Word; overload; -function RRot(const Value: Integer; const Count: TBitRange): Integer; overload; -function RRot(const Value: Int64; const Count: TBitRange): Int64; overload; - -function Sar(const Value: Shortint; const Count: TBitRange): Shortint; overload; -function Sar(const Value: Smallint; const Count: TBitRange): Smallint; overload; -function Sar(const Value: Integer; const Count: TBitRange): Integer; overload; - -function SetBit(const Value: Byte; const Bit: TBitRange): Byte; overload; -function SetBit(const Value: Shortint; const Bit: TBitRange): Shortint; overload; -function SetBit(const Value: Smallint; const Bit: TBitRange): Smallint; overload; -function SetBit(const Value: Word; const Bit: TBitRange): Word; overload; -function SetBit(const Value: Cardinal; const Bit: TBitRange): Cardinal; overload; -function SetBit(const Value: Integer; const Bit: TBitRange): Integer; overload; -function SetBit(const Value: Int64; const Bit: TBitRange): Int64; overload; -procedure SetBitBuffer(var Value; const Bit: Cardinal); overload; -{$IFDEF CPU64} -procedure SetBitBuffer(var Value; const Bit: Int64); overload; -{$ENDIF CPU64} - -function TestBit(const Value: Byte; const Bit: TBitRange): Boolean; overload; -function TestBit(const Value: Shortint; const Bit: TBitRange): Boolean; overload; -function TestBit(const Value: Smallint; const Bit: TBitRange): Boolean; overload; -function TestBit(const Value: Word; const Bit: TBitRange): Boolean; overload; -function TestBit(const Value: Cardinal; const Bit: TBitRange): Boolean; overload; -function TestBit(const Value: Integer; const Bit: TBitRange): Boolean; overload; -function TestBit(const Value: Int64; const Bit: TBitRange): Boolean; overload; -function TestBitBuffer(const Value; const Bit: Cardinal): Boolean; overload; -{$IFDEF CPU64} -function TestBitBuffer(const Value; const Bit: Int64): Boolean; overload; -{$ENDIF CPU64} - -function TestBits(const Value, Mask: Byte): Boolean; overload; -function TestBits(const Value, Mask: Shortint): Boolean; overload; -function TestBits(const Value, Mask: Smallint): Boolean; overload; -function TestBits(const Value, Mask: Word): Boolean; overload; -function TestBits(const Value, Mask: Cardinal): Boolean; overload; -function TestBits(const Value, Mask: Integer): Boolean; overload; -function TestBits(const Value, Mask: Int64): Boolean; overload; - -function ToggleBit(const Value: Byte; const Bit: TBitRange): Byte; overload; -function ToggleBit(const Value: Shortint; const Bit: TBitRange): Shortint; overload; -function ToggleBit(const Value: Smallint; const Bit: TBitRange): Smallint; overload; -function ToggleBit(const Value: Word; const Bit: TBitRange): Word; overload; -function ToggleBit(const Value: Cardinal; const Bit: TBitRange): Cardinal; overload; -function ToggleBit(const Value: Integer; const Bit: TBitRange): Integer; overload; -function ToggleBit(const Value: Int64; const Bit: TBitRange): Int64; overload; -procedure ToggleBitBuffer(var Value; const Bit: Cardinal); overload; -{$IFDEF CPU64} -procedure ToggleBitBuffer(var Value; const Bit: Int64); overload; -{$ENDIF CPU64} - -procedure BooleansToBits(var Dest: Byte; const B: TBooleanArray); overload; -procedure BooleansToBits(var Dest: Word; const B: TBooleanArray); overload; -procedure BooleansToBits(var Dest: Integer; const B: TBooleanArray); overload; -procedure BooleansToBits(var Dest: Int64; const B: TBooleanArray); overload; - -procedure BitsToBooleans(const Bits: Byte; var B: TBooleanArray; AllBits: Boolean = False); overload; -procedure BitsToBooleans(const Bits: Word; var B: TBooleanArray; AllBits: Boolean = False); overload; -procedure BitsToBooleans(const Bits: Integer; var B: TBooleanArray; AllBits: Boolean = False); overload; -procedure BitsToBooleans(const Bits: Int64; var B: TBooleanArray; AllBits: Boolean = False); overload; - -function BitsNeeded(const X: Byte): Integer; overload; -function BitsNeeded(const X: Word): Integer; overload; -function BitsNeeded(const X: Integer): Integer; overload; -function BitsNeeded(const X: Int64): Integer; overload; - -function Digits(const X: Cardinal): Integer; - -function ReverseBytes(Value: Word): Word; overload; -function ReverseBytes(Value: Smallint): Smallint; overload; -function ReverseBytes(Value: Integer): Integer; overload; -function ReverseBytes(Value: Cardinal): Cardinal; overload; -function ReverseBytes(Value: Int64): Int64; overload; -function ReverseBytes(P: Pointer; Count: Integer): Pointer; overload; - -// Arithmetic -procedure SwapOrd(var I, J: Byte); overload; -procedure SwapOrd(var I, J: Shortint); overload; -procedure SwapOrd(var I, J: Smallint); overload; -procedure SwapOrd(var I, J: Word); overload; -procedure SwapOrd(var I, J: Integer); overload; -procedure SwapOrd(var I, J: Cardinal); overload; -procedure SwapOrd(var I, J: Int64); overload; - -function IncLimit(var B: Byte; const Limit: Byte; const Incr: Byte = 1): Byte; overload; -function IncLimit(var B: Shortint; const Limit: Shortint; const Incr: Shortint = 1): Shortint; overload; -function IncLimit(var B: Smallint; const Limit: Smallint; const Incr: Smallint = 1): Smallint; overload; -function IncLimit(var B: Word; const Limit: Word; const Incr: Word = 1): Word; overload; -function IncLimit(var B: Integer; const Limit: Integer; const Incr: Integer = 1): Integer; overload; -function IncLimit(var B: Cardinal; const Limit: Cardinal; const Incr: Cardinal = 1): Cardinal; overload; -function IncLimit(var B: Int64; const Limit: Int64; const Incr: Int64 = 1): Int64; overload; - -function DecLimit(var B: Byte; const Limit: Byte; const Decr: Byte = 1): Byte; overload; -function DecLimit(var B: Shortint; const Limit: Shortint; const Decr: Shortint = 1): Shortint; overload; -function DecLimit(var B: Smallint; const Limit: Smallint; const Decr: Smallint = 1): Smallint; overload; -function DecLimit(var B: Word; const Limit: Word; const Decr: Word = 1): Word; overload; -function DecLimit(var B: Integer; const Limit: Integer; const Decr: Integer = 1): Integer; overload; -function DecLimit(var B: Cardinal; const Limit: Cardinal; const Decr: Cardinal = 1): Cardinal; overload; -function DecLimit(var B: Int64; const Limit: Int64; const Decr: Int64 = 1): Int64; overload; - -function IncLimitClamp(var B: Byte; const Limit: Byte; const Incr: Byte = 1): Byte; overload; -function IncLimitClamp(var B: Shortint; const Limit: Shortint; const Incr: Shortint = 1): Shortint; overload; -function IncLimitClamp(var B: Smallint; const Limit: Smallint; const Incr: Smallint = 1): Smallint; overload; -function IncLimitClamp(var B: Word; const Limit: Word; const Incr: Word = 1): Word; overload; -function IncLimitClamp(var B: Integer; const Limit: Integer; const Incr: Integer = 1): Integer; overload; -function IncLimitClamp(var B: Cardinal; const Limit: Cardinal; const Incr: Cardinal = 1): Cardinal; overload; -function IncLimitClamp(var B: Int64; const Limit: Int64; const Incr: Int64 = 1): Int64; overload; - -function DecLimitClamp(var B: Byte; const Limit: Byte; const Decr: Byte = 1): Byte; overload; -function DecLimitClamp(var B: Shortint; const Limit: Shortint; const Decr: Shortint = 1): Shortint; overload; -function DecLimitClamp(var B: Smallint; const Limit: Smallint; const Decr: Smallint = 1): Smallint; overload; -function DecLimitClamp(var B: Word; const Limit: Word; const Decr: Word = 1): Word; overload; -function DecLimitClamp(var B: Integer; const Limit: Integer; const Decr: Integer = 1): Integer; overload; -function DecLimitClamp(var B: Cardinal; const Limit: Cardinal; const Decr: Cardinal = 1): Cardinal; overload; -function DecLimitClamp(var B: Int64; const Limit: Int64; const Decr: Int64 = 1): Int64; overload; - -function Max(const B1, B2: Byte): Byte; overload; -function Max(const B1, B2: Shortint): Shortint; overload; -function Max(const B1, B2: Smallint): Smallint; overload; -function Max(const B1, B2: Word): Word; overload; -function Max(const B1, B2: Integer): Integer; overload; -function Max(const B1, B2: Cardinal): Cardinal; overload; -function Max(const B1, B2: Int64): Int64; overload; - -function Min(const B1, B2: Byte): Byte; overload; -function Min(const B1, B2: Shortint): Shortint; overload; -function Min(const B1, B2: Smallint): Smallint; overload; -function Min(const B1, B2: Word): Word; overload; -function Min(const B1, B2: Integer): Integer; overload; -function Min(const B1, B2: Cardinal): Cardinal; overload; -function Min(const B1, B2: Int64): Int64; overload; - -const - // Constants defining the number of bits in each Integer type - - BitsPerNibble = 4; - BitsPerByte = 8; - BitsPerShortint = SizeOf(Shortint) * BitsPerByte; - BitsPerSmallint = SizeOf(Smallint) * BitsPerByte; - BitsPerWord = SizeOf(Word) * BitsPerByte; - BitsPerInteger = SizeOf(Integer) * BitsPerByte; - BitsPerCardinal = SizeOf(Cardinal) * BitsPerByte; - BitsPerInt64 = SizeOf(Int64) * BitsPerByte; - - // Constants defining the number of nibbles in each Integer type - - NibblesPerByte = BitsPerByte div BitsPerNibble; - NibblesPerShortint = SizeOf(Shortint) * NibblesPerByte; - NibblesPerSmallint = SizeOf(Smallint) * NibblesPerByte; - NibblesPerWord = SizeOf(Word) * NibblesPerByte; - NibblesPerInteger = SizeOf(Integer) * NibblesPerByte; - NibblesPerCardinal = SizeOf(Cardinal) * NibblesPerByte; - NibblesPerInt64 = SizeOf(Int64) * NibblesPerByte; - - // Constants defining a mask with all bits set for each Integer type - - NibbleMask = $F; - ByteMask = Byte($FF); - ShortintMask = Shortint($FF); - SmallintMask = Smallint($FFFF); - WordMask = Word($FFFF); - IntegerMask = Integer($FFFFFFFF); - CardinalMask = Cardinal($FFFFFFFF); - Int64Mask = Int64($FFFFFFFFFFFFFFFF); - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\common'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -uses - JclBase; - -// Conversion -function OrdToBinary(Value: Byte): string; -var - I: Integer; -begin - SetLength(Result, BitsPerByte); - for I := Length(Result) - 1 downto 0 do - begin - Result[I + 1] := Chr(48 + (Value and $00000001)); - Value := Value shr 1; - end; -end; - -function OrdToBinary(Value: Shortint): string; -var - I: Integer; -begin - SetLength(Result, BitsPerShortint); - for I := Length(Result) - 1 downto 0 do - begin - Result[I + 1] := Chr(48 + (Value and $00000001)); - Value := Value shr 1; - end; -end; - -function OrdToBinary(Value: Smallint): string; -var - I: Integer; - S: Smallint; -begin - SetLength(Result, BitsPerSmallint); - S := Value; - for I := Length(Result) - 1 downto 0 do - begin - Result[I + 1] := Chr(48 + (S and $00000001)); - S := S shr 1; - end; -end; - -function OrdToBinary(Value: Word): string; -var - I: Integer; -begin - SetLength(Result, BitsPerWord); - for I := Length(Result) - 1 downto 0 do - begin - Result[I + 1] := Chr(48 + (Value and $00000001)); - Value := Value shr 1; - end; -end; - -function OrdToBinary(Value: Integer): string; -var - I: Integer; -begin - SetLength(Result, BitsPerInteger); - for I := Length(Result) - 1 downto 0 do - begin - Result[I + 1] := Chr(48 + (Value and $00000001)); - Value := Value shr 1; - end; -end; - -function OrdToBinary(Value: Cardinal): string; -var - I: Integer; -begin - SetLength(Result, BitsPerCardinal); - for I := Length(Result) - 1 downto 0 do - begin - Result[I + 1] := Chr(48 + (Value and $00000001)); - Value := Value shr 1; - end; -end; - -function OrdToBinary(Value: Int64): string; -var - I: Integer; -begin - SetLength(Result, BitsPerInt64); - for I := Length(Result) - 1 downto 0 do - begin - Result[I + 1] := Chr(48 + (Value and Int64(1))); - Value := Value shr Int64(1); - end; -end; - - -// Bit manipulation -function BitsHighest(X: Cardinal): Integer; -asm - {$IFDEF CPU32} - // --> EAX X - // <-- EAX - MOV ECX, EAX - MOV EAX, -1 - BSR EAX, ECX - JNZ @@End - MOV EAX, -1 -@@End: - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> ECX X - // <-- RAX - MOV EAX, -1 - MOV R10D, EAX - BSR EAX, ECX - CMOVZ EAX, R10D - {$ENDIF CPU64} -end; - -function BitsHighest(X: Integer): Integer; -asm - {$IFDEF CPU32} - // --> EAX X - // <-- EAX - MOV ECX, EAX - MOV EAX, -1 - BSR EAX, ECX - JNZ @@End - MOV EAX, -1 -@@End: - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> ECX X - // <-- RAX - MOV EAX, -1 - MOV R10D, EAX - BSR EAX, ECX - CMOVZ EAX, R10D - {$ENDIF CPU64} -end; - -function BitsHighest(X: Byte): Integer; -begin - Result := BitsHighest(Cardinal(X)); -end; - -function BitsHighest(X: Word): Integer; -begin - Result := BitsHighest(Cardinal(X)); -end; - -function BitsHighest(X: SmallInt): Integer; -begin - Result := BitsHighest(Integer(X)); -end; - -function BitsHighest(X: ShortInt): Integer; -begin - Result := BitsHighest(Integer(X)); -end; - -function BitsHighest(X: Int64): Integer; -{$IFDEF CPU32} -begin - if TJclULargeInteger(X).HighPart = 0 then - Result := BitsHighest(TJclULargeInteger(X).LowPart) - else - Result := BitsHighest(TJclULargeInteger(X).HighPart) + 32; -end; -{$ENDIF CPU32} -{$IFDEF CPU64} -asm - // --> RCX X - // <-- RAX - - // this is much shorter than "MOV RAX, -1" - XOR RAX, RAX - DEC EAX - - MOV R10, RAX - BSR RAX, RCX - CMOVZ RAX, R10 -end; -{$ENDIF CPU64} - -function BitsLowest(X: Cardinal): Integer; -asm - {$IFDEF CPU32} - // --> EAX X - // <-- EAX - MOV ECX, EAX - MOV EAX, -1 - BSF EAX, ECX - JNZ @@End - MOV EAX, -1 -@@End: - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> RCX X - // <-- EAX - MOV EAX, -1 - MOV R10D, EAX - BSF EAX, ECX - CMOVZ EAX, R10D - {$ENDIF CPU64} -end; - -function BitsLowest(X: Integer): Integer; -asm - {$IFDEF CPU32} - // --> EAX X - // <-- EAX - MOV ECX, EAX - MOV EAX, -1 - BSF EAX, ECX - JNZ @@End - MOV EAX, -1 -@@End: - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> RCX X - // <-- EAX - MOV EAX, -1 - MOV R10D, EAX - BSF EAX, ECX - CMOVZ EAX, R10D - {$ENDIF CPU64} -end; - -function BitsLowest(X: Byte): Integer; -begin - Result := BitsLowest(Cardinal(X)); -end; - -function BitsLowest(X: Shortint): Integer; -begin - Result := BitsLowest(Integer(X)); -end; - -function BitsLowest(X: Smallint): Integer; -begin - Result := BitsLowest(Integer(X)); -end; - -function BitsLowest(X: Word): Integer; -begin - Result := BitsLowest(Cardinal(X)); -end; - -function BitsLowest(X: Int64): Integer; -{$IFDEF CPU32} -begin - if TJclULargeInteger(X).LowPart = 0 then - Result := BitsLowest(TJclULargeInteger(X).HighPart) + 32 - else - Result := BitsLowest(TJclULargeInteger(X).LowPart); -end; -{$ENDIF CPU32} -{$IFDEF CPU64} -asm - // --> RCX X - // <-- RAX - - // this is much shorter than "MOV RAX, -1" - XOR RAX, RAX - DEC EAX - - MOV R10, RAX - BSF RAX, RCX - CMOVZ RAX, R10 -end; -{$ENDIF CPU64} - -function ClearBit(const Value: Byte; const Bit: TBitRange): Byte; -asm - // 32 --> AL Value - // DL Bit - // <-- AL Result - // 64 --> CL Value - // DL Bit - // <-- AL Result - AND EDX, BitsPerByte - 1 // modulo BitsPerByte - {$IFDEF CPU64} - MOVZX EAX, CL - {$ENDIF CPU64} - BTR EAX, EDX -end; - -function ClearBit(const Value: Shortint; const Bit: TBitRange): Shortint; -asm - // 32 --> AL Value - // DL Bit - // <-- AL Result - // 64 --> CL Value - // DL Bit - // <-- AL Result - AND EDX, BitsPerShortint - 1 // modulo BitsPerShortint - {$IFDEF CPU64} - MOVZX EAX, CL - {$ENDIF CPU64} - BTR EAX, EDX -end; - -function ClearBit(const Value: Smallint; const Bit: TBitRange): Smallint; -asm - // 32 --> AX Value - // DL Bit - // <-- AX Result - // 64 --> CX Value - // DL Bit - // <-- AX Result - AND EDX, BitsPerSmallint - 1 // modulo BitsPerSmallint - {$IFDEF CPU64} - MOVZX EAX, CX - {$ENDIF CPU64} - BTR EAX, EDX -end; - -function ClearBit(const Value: Word; const Bit: TBitRange): Word; -asm - // 32 --> AX Value - // DL Bit - // <-- AX Result - // 64 --> CX Value - // DL Bit - // <-- AX Result - AND EDX, BitsPerWord - 1 // modulo BitsPerWord - {$IFDEF CPU64} - MOVZX EAX, CX - {$ENDIF CPU64} - BTR EAX, EDX -end; - -function ClearBit(const Value: Cardinal; const Bit: TBitRange): Cardinal; -asm - // 32 --> EAX Value - // DL Bit - // <-- EAX Result - // 64 --> ECX Value - // DL Bit - // <-- EAX Result - {$IFDEF CPU64} - MOV EAX, ECX - {$ENDIF CPU64} - BTR EAX, EDX -end; - -function ClearBit(const Value: Integer; const Bit: TBitRange): Integer; -asm - // 32 --> EAX Value - // DL Bit - // <-- EAX Result - // 64 --> ECX Value - // DL Bit - // <-- EAX Result - {$IFDEF CPU64} - MOV EAX, ECX - {$ENDIF CPU64} - BTR EAX, EDX -end; - -function ClearBit(const Value: Int64; const Bit: TBitRange): Int64; -{$IFDEF CPU32} -begin - Result := Value and not (Int64(1) shl (Bit and (BitsPerInt64 - 1))); -end; -{$ENDIF CPU32} -{$IFDEF CPU64} -asm - // --> RCX Value - // DL Bit - // <-- RAX Result - MOV RAX, RCX - BTR RAX, RDX -end; -{$ENDIF CPU64} - -procedure ClearBitBuffer(var Value; const Bit: Cardinal); -{$IFDEF PUREPASCAL} -var - P: PByte; - BitOfs: TBitRange; -begin - P := Addr(Value); - Inc(P, Bit div 8); - BitOfs := Bit mod 8; - P^ := ClearBit(P^, BitOfs); -end; -{$ELSE ~PUREPASCAL} -asm - // 32 --> EAX Value - // EDX Bit - // 64 --> RCX Value - // EDX Bit - BTR [Value], Bit -end; -{$ENDIF ~PUREPASCAL} - -{$IFDEF CPU64} -procedure ClearBitBuffer(var Value; const Bit: Int64); -{$IFDEF PUREPASCAL} -var - P: PByte; - BitOfs: TBitRange; -begin - P := Addr(Value); - Inc(P, Bit div 8); - BitOfs := Bit mod 8; - P^ := ClearBit(P^, BitOfs); -end; -{$ELSE ~PUREPASCAL} -asm - // 64 --> RCX Value - // RDX Bit - BTR [Value], Bit -end; -{$ENDIF ~PUREPASCAL} -{$ENDIF CPU64} - -const - BitSetPerNibble: array[0..15] of Integer = (0,1,1,2,1,2,2,3,1,2,2,3,2,3,3,4); - -function CountBitsSet(X: Cardinal): Integer; -var - Index: Integer; -begin - Result := 0; - for Index := 0 to NibblesPerCardinal - 1 do - begin - Inc(Result, BitSetPerNibble[X and $F]); - X := X shr BitsPerNibble; - end; -end; - -function CountBitsSet(X: Byte): Integer; -begin - Result := BitSetPerNibble[X shr BitsPerNibble] + BitSetPerNibble[X and $F]; -end; - -function CountBitsSet(X: Word): Integer; -var - Index: Integer; -begin - Result := 0; - for Index := 0 to NibblesPerWord - 1 do - begin - Inc(Result, BitSetPerNibble[X and $F]); - X := X shr BitsPerNibble; - end; -end; - -function CountBitsSet(X: Smallint): Integer; -var - Index: Integer; -begin - Result := 0; - for Index := 0 to NibblesPerSmallint - 1 do - begin - Inc(Result, BitSetPerNibble[X and $F]); - X := X shr BitsPerNibble; - end; -end; - -function CountBitsSet(X: ShortInt): Integer; -begin - Result := BitSetPerNibble[X shr BitsPerNibble] + BitSetPerNibble[X and $F]; -end; - -function CountBitsSet(X: Integer): Integer; -var - Index: Integer; -begin - Result := 0; - for Index := 0 to NibblesPerInteger - 1 do - begin - Inc(Result, BitSetPerNibble[X and $F]); - X := X shr BitsPerNibble; - end; -end; - -function CountBitsSet(P: Pointer; Count: Cardinal): Cardinal; -var - b: Byte; -begin - Result := 0; - while Count > 0 do - begin - b := PByte(P)^; - - // lower Nibble - Inc(Result, BitSetPerNibble[b and $0F]); - // upper Nibble - Inc(Result, BitSetPerNibble[b shr BitsPerNibble]); - - Dec(Count); - Inc(PByte(P)); - end; -end; - -function CountBitsSet(X: Int64): Integer; -begin - Result := CountBitsSet(TJclULargeInteger(X).LowPart) + CountBitsSet(TJclULargeInteger(X).HighPart); -end; - -function CountBitsCleared(X: Byte): Integer; -begin - Result := BitsPerByte - CountBitsSet(Byte(X)); -end; - -function CountBitsCleared(X: Shortint): Integer; -begin - Result := BitsPerShortint - CountBitsSet(Byte(X)); -end; - -function CountBitsCleared(X: Smallint): Integer; -begin - Result := BitsPerSmallint - CountBitsSet(Word(X)); -end; - -function CountBitsCleared(X: Word): Integer; -begin - Result := BitsPerWord - CountBitsSet(Word(X)); -end; - -function CountBitsCleared(X: Integer): Integer; -begin - Result := BitsPerInteger - CountBitsSet(Integer(X)); -end; - -function CountBitsCleared(X: Cardinal): Integer; -begin - Result := BitsPerCardinal - CountBitsSet(Cardinal(X)); -end; - -function CountBitsCleared(X: Int64): Integer; -begin - Result := BitsPerInt64 - CountBitsSet(Int64(X)); -end; - -function CountBitsCleared(P: Pointer; Count: Cardinal): Cardinal; -begin - Result := Count * BitsPerByte - CountBitsSet(P, Count); -end; - -function LRot(const Value: Byte; const Count: TBitRange): Byte; -asm - {$IFDEF CPU32} - // --> AL Value - // DL Count - // <-- AL Result - MOV CL, DL - ROL AL, CL - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> CL Value - // DL Count - // <-- AL Result - MOV AL, CL - MOV CL, DL - ROL AL, CL - {$ENDIF CPU64} -end; - -function LRot(const Value: Word; const Count: TBitRange): Word; -asm - {$IFDEF CPU32} - // --> AX Value - // DL Count - // <-- AX Result - MOV CL, DL - ROL AX, CL - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> CX Value - // DL Count - // <-- AX Result - MOV AX, CX - MOV CL, DL - ROL AX, CL - {$ENDIF CPU64} -end; - -function LRot(const Value: Integer; const Count: TBitRange): Integer; -asm - {$IFDEF CPU32} - // --> EAX Value - // DL Count - // <-- EAX Result - MOV CL, DL - ROL EAX, CL - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> ECX Value - // DL Count - // <-- EAX Result - MOV EAX, ECX - MOV CL, DL - ROL EAX, CL - {$ENDIF CPU64} -end; - -function LRot(const Value: Int64; const Count: TBitRange): Int64; -{$IFDEF CPU32} -asm - // --> Value on stack - // AL Count - // <-- EDX:EAX Result - - PUSH ESI - PUSH EDI - - MOV CL, Count - MOV EDX, DWORD PTR [Value + 4] - MOV EAX, DWORD PTR [Value] - - // Count := Count mod 64 - AND CL, $3F - JZ @@End - - CMP CL, 32 - JL @@RolBits - - // Count >= 32: "rol Count" = "rol 32" + "rol (32 - Count)" -@@Swap: - // "rol 32" - XCHG EAX, EDX - // Count := 32 - Count - SUB CL, 32 - -@@RolBits: - MOV EDI, EDX - MOV ESI, EAX - - // shift the bits - SHL EDX, CL - SHL EAX, CL - - // CounterShiftCount := 32 - Count - NEG CL - ADD CL, 32 - // bitwise-or the counter shifted bits - SHR EDI, CL - SHR ESI, CL - OR EAX, EDI - OR EDX, ESI - -@@End: - POP EDI - POP ESI -end; -{$ENDIF CPU32} -{$IFDEF CPU64} -asm - // --> RCX Value - // DL Count - // <-- RAX Result - MOV RAX, RCX - MOV CL, DL - ROL RAX, CL -end; -{$ENDIF CPU64} - -function RRot(const Value: Int64; const Count: TBitRange): Int64; -{$IFDEF CPU32} -begin - Result := LRot(Value, 64 - (Count and $3F)); -end; -{$ENDIF CPU32} -{$IFDEF CPU64} -asm - // --> RCX Value - // DL Count - // <-- RAX Result - MOV RAX, RCX - MOV CL, DL - ROR RAX, CL -end; -{$ENDIF CPU64} - -const - // Lookup table of bit reversed nibbles, used by simple overloads of ReverseBits - RevNibbles: array [0..NibbleMask] of Byte = - ($0, $8, $4, $C, $2, $A, $6, $E, $1, $9, $5, $D, $3, $B, $7, $F); - -function ReverseBits(Value: Byte): Byte; -begin - Result := RevNibbles[Value shr BitsPerNibble] or - (RevNibbles[Value and NibbleMask] shl BitsPerNibble); -end; - -function ReverseBits(Value: Shortint): Shortint; -begin - Result := RevNibbles[Byte(Value) shr BitsPerNibble] or - (RevNibbles[Value and NibbleMask] shl BitsPerNibble); -end; - -function ReverseBits(Value: Smallint): Smallint; -begin - Result := ReverseBits(Word(Value)); -end; - -function ReverseBits(Value: Word): Word; -var - I: Integer; -begin - Result := 0; - for I := 0 to NibblesPerWord - 1 do - begin - Result := (Result shl BitsPerNibble) or RevNibbles[Value and NibbleMask]; - Value := Value shr BitsPerNibble; - end; -end; - -function ReverseBits(Value: Integer): Integer; -var - I: Integer; -begin - Result := 0; - for I := 0 to NibblesPerInteger - 1 do - begin - Result := (Result shl BitsPerNibble) or RevNibbles[Value and NibbleMask]; - Value := Value shr BitsPerNibble; - end; -end; - -function ReverseBits(Value: Cardinal): Cardinal; -var - I: Integer; -begin - Result := 0; - for I := 0 to NibblesPerCardinal - 1 do - begin - Result := (Result shl BitsPerNibble) or RevNibbles[Value and NibbleMask]; - Value := Value shr BitsPerNibble; - end; -end; - -function ReverseBits(Value: Int64): Int64; -begin - TJclULargeInteger(Result).LowPart := ReverseBits(TJclULargeInteger(Value).HighPart); - TJclULargeInteger(Result).HighPart := ReverseBits(TJclULargeInteger(Value).LowPart); -end; - -const - // Lookup table of reversed bytes, used by pointer overload of ReverseBits - ReverseTable: array [0..ByteMask] of Byte = ( - $00, $80, $40, $C0, $20, $A0, $60, $E0, - $10, $90, $50, $D0, $30, $B0, $70, $F0, - $08, $88, $48, $C8, $28, $A8, $68, $E8, - $18, $98, $58, $D8, $38, $B8, $78, $F8, - $04, $84, $44, $C4, $24, $A4, $64, $E4, - $14, $94, $54, $D4, $34, $B4, $74, $F4, - $0C, $8C, $4C, $CC, $2C, $AC, $6C, $EC, - $1C, $9C, $5C, $DC, $3C, $BC, $7C, $FC, - $02, $82, $42, $C2, $22, $A2, $62, $E2, - $12, $92, $52, $D2, $32, $B2, $72, $F2, - $0A, $8A, $4A, $CA, $2A, $AA, $6A, $EA, - $1A, $9A, $5A, $DA, $3A, $BA, $7A, $FA, - $06, $86, $46, $C6, $26, $A6, $66, $E6, - $16, $96, $56, $D6, $36, $B6, $76, $F6, - $0E, $8E, $4E, $CE, $2E, $AE, $6E, $EE, - $1E, $9E, $5E, $DE, $3E, $BE, $7E, $FE, - $01, $81, $41, $C1, $21, $A1, $61, $E1, - $11, $91, $51, $D1, $31, $B1, $71, $F1, - $09, $89, $49, $C9, $29, $A9, $69, $E9, - $19, $99, $59, $D9, $39, $B9, $79, $F9, - $05, $85, $45, $C5, $25, $A5, $65, $E5, - $15, $95, $55, $D5, $35, $B5, $75, $F5, - $0D, $8D, $4D, $CD, $2D, $AD, $6D, $ED, - $1D, $9D, $5D, $DD, $3D, $BD, $7D, $FD, - $03, $83, $43, $C3, $23, $A3, $63, $E3, - $13, $93, $53, $D3, $33, $B3, $73, $F3, - $0B, $8B, $4B, $CB, $2B, $AB, $6B, $EB, - $1B, $9B, $5B, $DB, $3B, $BB, $7B, $FB, - $07, $87, $47, $C7, $27, $A7, $67, $E7, - $17, $97, $57, $D7, $37, $B7, $77, $F7, - $0F, $8F, $4F, $CF, $2F, $AF, $6F, $EF, - $1F, $9F, $5F, $DF, $3F, $BF, $7F, $FF); - -function ReverseBits(P: Pointer; Count: Integer): Pointer; -var - P1, P2: PByte; - T: Byte; -begin - if (P <> nil) and (Count > 0) then - begin - P1 := P; - P2 := P; - Inc(P2, Count - 1); - while TJclAddr(P1) < TJclAddr(P2) do - begin - T := ReverseTable[P1^]; - P1^ := ReverseTable[P2^]; - P2^ := T; - Inc(P1); - Dec(P2); - end; - if P1 = P2 then - P1^ := ReverseTable[P1^]; - end; - Result := P; -end; - -function RRot(const Value: Byte; const Count: TBitRange): Byte; -asm - {$IFDEF CPU32} - // --> AL Value - // DL Count - // <-- AL Result - MOV CL, DL - ROR AL, CL - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> CL Value - // DL Count - // <-- AL Result - MOV AL, CL - MOV CL, DL - ROR AL, CL - {$ENDIF CPU64} -end; - -function RRot(const Value: Word; const Count: TBitRange): Word; -asm - {$IFDEF CPU32} - // --> AX Value - // DL Count - // <-- AX Result - MOV CL, DL - ROR AX, CL - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> CX Value - // DL Count - // <-- AX Result - MOV AX, CX - MOV CL, DL - ROR AX, CL - {$ENDIF CPU64} -end; - -function RRot(const Value: Integer; const Count: TBitRange): Integer; -asm - {$IFDEF CPU32} - // --> EAX Value - // DL Count - // <-- EAX Result - MOV CL, DL - ROR EAX, CL - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> ECX Value - // DL Count - // <-- EAX Result - MOV EAX, ECX - MOV CL, DL - ROR EAX, CL - {$ENDIF CPU64} -end; - -function Sar(const Value: Shortint; const Count: TBitRange): Shortint; -asm - {$IFDEF CPU32} - // --> AL Value - // DL Count - // <-- AL Result - MOV CL, DL - SAR AL, CL - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> CL Value - // DL Count - // <-- AL Result - MOV AL, CL - MOV CL, DL - SAR AL, CL - {$ENDIF CPU64} -end; - -function Sar(const Value: Smallint; const Count: TBitRange): Smallint; -asm - {$IFDEF CPU32} - // --> AX Value - // DL Count - // <-- AX Result - MOV CL, DL - SAR AX, CL - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> CX Value - // DL Count - // <-- AX Result - MOV AX, CX - MOV CL, DL - SAR AX, CL - {$ENDIF CPU64} -end; - -function Sar(const Value: Integer; const Count: TBitRange): Integer; -asm - {$IFDEF CPU32} - // --> EAX Value - // DL Count - // <-- EAX Result - MOV CL, DL - SAR EAX, CL - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> ECX Value - // DL Count - // <-- EAX Result - MOV EAX, ECX - MOV CL, DL - SAR EAX, CL - {$ENDIF CPU64} -end; - -function SetBit(const Value: Byte; const Bit: TBitRange): Byte; -asm - // 32 --> AL Value - // DL Bit - // <-- AL Result - // 64 --> CL Value - // DL Bit - // <-- AL Result - AND EDX, BitsPerByte - 1 // modulo BitsPerByte - {$IFDEF CPU64} - MOVZX EAX, CL - {$ENDIF CPU64} - BTS EAX, EDX -end; - -function SetBit(const Value: Shortint; const Bit: TBitRange): Shortint; -asm - // 32 --> AL Value - // DL Bit - // <-- AL Result - // 64 --> CL Value - // DL Bit - // <-- AL Result - AND EDX, BitsPerShortInt - 1 // modulo BitsPerShortInt - {$IFDEF CPU64} - MOVZX EAX, CL - {$ENDIF CPU64} - BTS EAX, EDX -end; - -function SetBit(const Value: Smallint; const Bit: TBitRange): Smallint; -asm - // 32 --> AX Value - // DL Bit - // <-- AX Result - // 64 --> CX Value - // DL Bit - // <-- AX Result - AND EDX, BitsPerSmallInt - 1 // modulo BitsPerSmallInt - {$IFDEF CPU64} - MOVZX EAX, CX - {$ENDIF CPU64} - BTS EAX, EDX -end; - -function SetBit(const Value: Word; const Bit: TBitRange): Word; -asm - // 32 --> AX Value - // DL Bit - // <-- AX Result - // 64 --> CX Value - // DL Bit - // <-- AX Result - AND EDX, BitsPerWord - 1 // modulo BitsPerWord - {$IFDEF CPU64} - MOVZX EAX, CX - {$ENDIF CPU64} - BTS EAX, EDX -end; - -function SetBit(const Value: Cardinal; const Bit: TBitRange): Cardinal; -asm - // 32 --> EAX Value - // DL Bit - // <-- EAX Result - // 64 --> ECX Value - // DL Bit - // <-- EAX Result - {$IFDEF CPU64} - MOV EAX, ECX - {$ENDIF CPU64} - BTS EAX, EDX -end; - -function SetBit(const Value: Integer; const Bit: TBitRange): Integer; -asm - // 32 --> EAX Value - // DL Bit - // <-- EAX Result - // 64 --> ECX Value - // DL Bit - // <-- EAX Result - {$IFDEF CPU64} - MOV EAX, ECX - {$ENDIF CPU64} - BTS EAX, EDX -end; - -function SetBit(const Value: Int64; const Bit: TBitRange): Int64; -{$IFDEF CPU32} -begin - Result := Value or (Int64(1) shl (Bit and (BitsPerInt64 - 1))); -end; -{$ENDIF CPU32} -{$IFDEF CPU64} -asm - // --> RCX Value - // DL Bit - // <-- RAX Result - MOV RAX, RCX - BTS RAX, RDX -end; -{$ENDIF CPU64} - -procedure SetBitBuffer(var Value; const Bit: Cardinal); -{$IFDEF PUREPASCAL} -var - P: PByte; - BitOfs: TBitRange; -begin - P := Addr(Value); - Inc(P, Bit div 8); - BitOfs := Bit mod 8; - P^ := SetBit(P^, BitOfs); -end; -{$ELSE ~PUREPASCAL} -asm - BTS [Value], Bit -end; -{$ENDIF ~PUREPASCAL} - -{$IFDEF CPU64} -procedure SetBitBuffer(var Value; const Bit: Int64); -{$IFDEF PUREPASCAL} -var - P: PByte; - BitOfs: TBitRange; -begin - P := Addr(Value); - Inc(P, Bit div 8); - BitOfs := Bit mod 8; - P^ := SetBit(P^, BitOfs); -end; -{$ELSE ~PUREPASCAL} -asm - BTS [Value], Bit -end; -{$ENDIF ~PUREPASCAL} -{$ENDIF CPU64} - -function TestBit(const Value: Byte; const Bit: TBitRange): Boolean; -{$IFDEF PUREPASCAL} -begin - Result := (Value shr (Bit and (BitsPerByte - 1))) and 1 <> 0; -end; -{$ELSE ~PUREPASCAL} -asm - // 32 --> AL Value - // DL Bit - // <-- AL Result - // 64 --> CL Value - // DL Bit - // <-- AL Result - AND EDX, BitsPerByte - 1 // modulo BitsPerByte - {$IFDEF CPU64} - MOVZX EAX, CL - {$ENDIF CPU64} - BT EAX, EDX - SETC AL -end; -{$ENDIF ~PUREPASCAL} - -function TestBit(const Value: Shortint; const Bit: TBitRange): Boolean; -{$IFDEF PUREPASCAL} -begin - Result := (Value shr (Bit and (BitsPerShortint - 1))) and 1 <> 0; -end; -{$ELSE ~PUREPASCAL} -asm - // 32 --> AL Value - // DL Bit - // <-- AL Result - // 64 --> CL Value - // DL Bit - // <-- AL Result - AND EDX, BitsPerShortInt - 1 // modulo BitsPerShortInt - {$IFDEF CPU64} - MOVZX EAX, CL - {$ENDIF CPU64} - BT EAX, EDX - SETC AL -end; -{$ENDIF ~PUREPASCAL} - -function TestBit(const Value: Smallint; const Bit: TBitRange): Boolean; -{$IFDEF PUREPASCAL} -begin - Result := (Value shr (Bit and (BitsPerSmallint - 1))) and 1 <> 0; -end; -{$ELSE ~PUREPASCAL} -asm - // 32 --> AX Value - // DL Bit - // <-- AX Result - // 64 --> CX Value - // DL Bit - // <-- AX Result - AND EDX, BitsPerSmallInt - 1 // modulo BitsPerSmallInt - {$IFDEF CPU64} - MOVZX EAX, CX - {$ENDIF CPU64} - BT EAX, EDX - SETC AL -end; -{$ENDIF ~PUREPASCAL} - -function TestBit(const Value: Word; const Bit: TBitRange): Boolean; -{$IFDEF PUREPASCAL} -begin - Result := (Value shr (Bit and (BitsPerWord - 1))) and 1 <> 0; -end; -{$ELSE ~PUREPASCAL} -asm - // 32 --> AX Value - // DL Bit - // <-- AX Result - // 64 --> CX Value - // DL Bit - // <-- AX Result - AND EDX, BitsPerWord - 1 // modulo BitsPerWord - {$IFDEF CPU64} - MOVZX EAX, CX - {$ENDIF CPU64} - BT EAX, EDX - SETC AL -end; -{$ENDIF ~PUREPASCAL} - -function TestBit(const Value: Cardinal; const Bit: TBitRange): Boolean; -{$IFDEF PUREPASCAL} -begin - Result := (Value shr (Bit and (BitsPerCardinal - 1))) and 1 <> 0; -end; -{$ELSE ~PUREPASCAL} -asm - // 32 --> EAX Value - // DL Bit - // <-- EAX Result - // 64 --> ECX Value - // DL Bit - // <-- EAX Result - {$IFDEF CPU64} - MOV EAX, ECX - {$ENDIF CPU64} - BT EAX, EDX - SETC AL -end; -{$ENDIF ~PUREPASCAL} - -function TestBit(const Value: Integer; const Bit: TBitRange): Boolean; -{$IFDEF PUREPASCAL} -begin - Result := (Value shr (Bit and (BitsPerInteger - 1))) and 1 <> 0; -end; -{$ELSE ~PUREPASCAL} -asm - // 32 --> EAX Value - // DL Bit - // <-- EAX Result - // 64 --> ECX Value - // DL Bit - // <-- EAX Result - {$IFDEF CPU64} - MOV EAX, ECX - {$ENDIF CPU64} - BT EAX, EDX - SETC AL -end; -{$ENDIF ~PUREPASCAL} - -function TestBit(const Value: Int64; const Bit: TBitRange): Boolean; -{$IFDEF CPU32} -begin - Result := (Value shr (Bit and (BitsPerInt64 - 1))) and 1 <> 0; -end; -{$ENDIF CPU32} -{$IFDEF CPU64} -asm - // --> RCX Value - // DL Bit - // <-- RAX Result - MOV RAX, RCX - BT RAX, RDX - SETC AL -end; -{$ENDIF ~PUREPASCAL} - -function TestBitBuffer(const Value; const Bit: Cardinal): Boolean; -{$IFDEF PUREPASCAL} -var - P: PByte; - BitOfs: TBitRange; -begin - P := Addr(Value); - Inc(P, Bit div 8); - BitOfs := Bit mod 8; - Result := TestBit(P^, BitOfs); -end; -{$ELSE ~PUREPASCAL} -asm - BT [Value], Bit - SETC AL -end; -{$ENDIF ~PUREPASCAL} - -{$IFDEF CPU64} -function TestBitBuffer(const Value; const Bit: Int64): Boolean; -{$IFDEF PUREPASCAL} -var - P: PByte; - BitOfs: TBitRange; -begin - P := Addr(Value); - Inc(P, Bit div 8); - BitOfs := Bit mod 8; - Result := TestBit(P^, BitOfs); -end; -{$ELSE ~PUREPASCAL} -asm - BT [Value], Bit - SETC AL -end; -{$ENDIF ~PUREPASCAL} -{$ENDIF CPU64} - -function TestBits(const Value, Mask: Byte): Boolean; -begin - Result := (Value and Mask) = Mask; -end; - -function TestBits(const Value, Mask: Shortint): Boolean; -begin - Result := (Value and Mask) = Mask; -end; - -function TestBits(const Value, Mask: Smallint): Boolean; -begin - Result := (Value and Mask) = Mask; -end; - -function TestBits(const Value, Mask: Word): Boolean; -begin - Result := (Value and Mask) = Mask; -end; - -function TestBits(const Value, Mask: Cardinal): Boolean; -begin - Result := (Value and Mask) = Mask; -end; - -function TestBits(const Value, Mask: Integer): Boolean; -begin - Result := (Value and Mask) = Mask; -end; - -function TestBits(const Value, Mask: Int64): Boolean; -begin - Result := (Value and Mask) = Mask; -end; - -function ToggleBit(const Value: Byte; const Bit: TBitRange): Byte; -{$IFDEF PUREPASCAL} -begin - Result := Value xor (1 shl (Bit and (BitsPerByte - 1))); -end; -{$ELSE ~PUREPASCAL} -asm - // 32 --> AL Value - // DL Bit - // <-- AL Result - // 64 --> CL Value - // DL Bit - // <-- AL Result - AND EDX, BitsPerByte - 1 // modulo BitsPerByte - {$IFDEF CPU64} - MOVZX EAX, CL - {$ENDIF CPU64} - BTC EAX, EDX -end; -{$ENDIF ~PUREPASCAL} - -function ToggleBit(const Value: Shortint; const Bit: TBitRange): Shortint; -{$IFDEF PUREPASCAL} -begin - Result := Value xor (1 shl (Bit and (BitsPerShortint - 1))); -end; -{$ELSE ~PUREPASCAL} -asm - // 32 --> AL Value - // DL Bit - // <-- AL Result - // 64 --> CL Value - // DL Bit - // <-- AL Result - AND EDX, BitsPerShortInt - 1 // modulo BitsPerShortInt - {$IFDEF CPU64} - MOVZX EAX, CL - {$ENDIF CPU64} - BTC EAX, EDX -end; -{$ENDIF ~PUREPASCAL} - -function ToggleBit(const Value: Smallint; const Bit: TBitRange): Smallint; -{$IFDEF PUREPASCAL} -begin - Result := Value xor (1 shl (Bit and (BitsPerSmallint - 1))); -end; -{$ELSE ~PUREPASCAL} -asm - // 32 --> AX Value - // DL Bit - // <-- AX Result - // 64 --> CX Value - // DL Bit - // <-- AX Result - AND EDX, BitsPerSmallInt - 1 // modulo BitsPerSmallInt - {$IFDEF CPU64} - MOVZX EAX, CX - {$ENDIF CPU64} - BTC EAX, EDX -end; -{$ENDIF ~PUREPASCAL} - -function ToggleBit(const Value: Word; const Bit: TBitRange): Word; -{$IFDEF PUREPASCAL} -begin - Result := Value xor (1 shl (Bit and (BitsPerWord - 1))); -end; -{$ELSE ~PUREPASCAL} -asm - // 32 --> AX Value - // DL Bit - // <-- AX Result - // 64 --> CX Value - // DL Bit - // <-- AX Result - AND EDX, BitsPerWord - 1 // modulo BitsPerWord - {$IFDEF CPU64} - MOVZX EAX, CX - {$ENDIF CPU64} - BTC EAX, EDX -end; -{$ENDIF ~PUREPASCAL} - -function ToggleBit(const Value: Cardinal; const Bit: TBitRange): Cardinal; -{$IFDEF PUREPASCAL} -begin - Result := Value xor (1 shl (Bit and (BitsPerCardinal - 1))); -end; -{$ELSE ~PUREPASCAL} -asm - // 32 --> EAX Value - // DL Bit - // <-- EAX Result - // 64 --> ECX Value - // DL Bit - // <-- EAX Result - {$IFDEF CPU64} - MOV EAX, ECX - {$ENDIF CPU64} - BTC EAX, EDX -end; -{$ENDIF ~PUREPASCAL} - -function ToggleBit(const Value: Integer; const Bit: TBitRange): Integer; -{$IFDEF PUREPASCAL} -begin - Result := Value xor (1 shl (Bit and (BitsPerInteger - 1))); -end; -{$ELSE ~PUREPASCAL} -asm - // 32 --> EAX Value - // DL Bit - // <-- EAX Result - // 64 --> ECX Value - // DL Bit - // <-- EAX Result - {$IFDEF CPU64} - MOV EAX, ECX - {$ENDIF CPU64} - BTC EAX, EDX -end; -{$ENDIF ~PUREPASCAL} - -function ToggleBit(const Value: Int64; const Bit: TBitRange): Int64; -{$IFDEF CPU32} -begin - Result := Value xor (Int64(1) shl (Bit and (BitsPerInt64 - 1))); -end; -{$ENDIF CPU32} -{$IFDEF CPU64} -asm - // --> RCX Value - // DL Bit - // <-- RAX Result - MOV RAX, RCX - BTC RAX, RDX -end; -{$ENDIF CPU64} - -procedure ToggleBitBuffer(var Value; const Bit: Cardinal); -{$IFDEF PUREPASCAL} -var - P: PByte; - BitOfs: TBitRange; -begin - P := Addr(Value); - Inc(P, Bit div 8); - BitOfs := Bit mod 8; - P^ := ToggleBit(P^, BitOfs); -end; -{$ELSE ~PUREPASCAL} -asm - BTC [Value], Bit -end; -{$ENDIF ~PUREPASCAL} - -{$IFDEF CPU64} -procedure ToggleBitBuffer(var Value; const Bit: Int64); -{$IFDEF PUREPASCAL} -var - P: PByte; - BitOfs: TBitRange; -begin - P := Addr(Value); - Inc(P, Bit div 8); - BitOfs := Bit mod 8; - P^ := ToggleBit(P^, BitOfs); -end; -{$ELSE ~PUREPASCAL} -asm - BTC [Value], Bit -end; -{$ENDIF ~PUREPASCAL} -{$ENDIF CPU64} - -procedure BooleansToBits(var Dest: Byte; const B: TBooleanArray); -var - I, H: Integer; -begin - Dest := 0; - H := Min(Byte(BitsPerByte - 1), High(B)); - for I := 0 to H do - if B[I] then - Dest := SetBit(Dest, TBitRange(I)); -end; - -procedure BooleansToBits(var Dest: Word; const B: TBooleanArray); -var - I, H: Integer; -begin - Dest := 0; - H := Min(Word(BitsPerWord - 1), High(B)); - for I := 0 to H do - if B[I] then - Dest := SetBit(Dest, TBitRange(I)); -end; - -procedure BooleansToBits(var Dest: Integer; const B: TBooleanArray); -var - I, H: Integer; -begin - Dest := 0; - H := Min(Integer(BitsPerInteger - 1), High(B)); - for I := 0 to H do - if B[I] then - Dest := SetBit(Dest, TBitRange(I)); -end; - -procedure BooleansToBits(var Dest: Int64; const B: TBooleanArray); -var - I, H: Integer; -begin - Dest := 0; - H := Min(Int64(BitsPerInt64 - 1), High(B)); - for I := 0 to H do - if B[I] then - Dest := SetBit(Dest, TBitRange(I)); -end; - -procedure BitsToBooleans(const Bits: Byte; var B: TBooleanArray; AllBits: Boolean); -var - I: Integer; -begin - if AllBits then - SetLength(B, BitsPerByte) - else - SetLength(B, BitsNeeded(Bits)); - for I := 0 to High(B) do - B[I] := TestBit(Bits, TBitRange(I)); -end; - -procedure BitsToBooleans(const Bits: Word; var B: TBooleanArray; AllBits: Boolean); -var - I: Integer; -begin - if AllBits then - SetLength(B, BitsPerWord) - else - SetLength(B, BitsNeeded(Bits)); - for I := 0 to High(B) do - B[I] := TestBit(Bits, TBitRange(I)); -end; - -procedure BitsToBooleans(const Bits: Integer; var B: TBooleanArray; AllBits: Boolean); -var - I: Integer; -begin - if AllBits then - SetLength(B, BitsPerInteger) - else - SetLength(B, BitsNeeded(Bits)); - for I := 0 to High(B) do - B[I] := TestBit(Bits, TBitRange(I)); -end; - -procedure BitsToBooleans(const Bits: Int64; var B: TBooleanArray; AllBits: Boolean); -var - I: Integer; -begin - if AllBits then - SetLength(B, BitsPerInt64) - else - SetLength(B, BitsNeeded(Bits)); - for I := 0 to High(B) do - B[I] := TestBit(Bits, TBitRange(I)); -end; - -function Digits(const X: Cardinal): Integer; -var - Val: Cardinal; -begin - Result := 0; - Val := X; - repeat - Inc(Result); - Val := Val div 10; - until Val = 0; -end; - -function BitsNeeded(const X: Byte): Integer; -begin - Result := BitsHighest(X) + 1; - if Result = 0 then - Result := 1; -end; - -function BitsNeeded(const X: Word): Integer; -begin - Result := BitsHighest(X) + 1; - if Result = 0 then - Result := 1; -end; - -function BitsNeeded(const X: Integer): Integer; -begin - Result := BitsHighest(X) + 1; - if Result = 0 then - Result := 1; -end; - -function BitsNeeded(const X: Int64): Integer; -begin - Result := BitsHighest(X) + 1; - if Result = 0 then - Result := 1; -end; - -function ReverseBytes(Value: Word): Word; -{$IFDEF PUREPASCAL} -begin - Result := (Value shr 8) or (Value shl 8); -end; -{$ELSE ~PUREPASCAL} -asm - {$IFDEF CPU32} - // --> AX Value - // <-- AX Value - XCHG AL, AH - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> CX Value - // <-- AX Value - MOV AH, CL - MOV AL, CH - {$ENDIF CPU64} -end; -{$ENDIF ~PUREPASCAL} - -function ReverseBytes(Value: Smallint): Smallint; -{$IFDEF PUREPASCAL} -asm - XCHG AL, AH -end; -{$ELSE ~PUREPASCAL} -asm - {$IFDEF CPU32} - // --> AX Value - // <-- AX Value - XCHG AL, AH - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> CX Value - // <-- AX Value - MOV AH, CL - MOV AL, CH - {$ENDIF CPU64} -end; -{$ENDIF ~PUREPASCAL} - -function ReverseBytes(Value: Integer): Integer; -{$IFDEF PUREPASCAL} -begin - Result := (Value shr 24) or (Value shl 24) or ((Value and $00FF0000) shr 8) or ((Value and $0000FF00) shl 8); -end; -{$ELSE ~PUREPASCAL} -asm - {$IFDEF CPU32} - // --> EAX Value - // <-- EAX Value - BSWAP EAX - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> ECX Value - // <-- EAX Value - MOV EAX, ECX - BSWAP EAX - {$ENDIF CPU64} -end; -{$ENDIF ~PUREPASCAL} - -function ReverseBytes(Value: Cardinal): Cardinal; -{$IFDEF PUREPASCAL} -begin - Result := (Value shr 24) or (Value shl 24) or ((Value and $00FF0000) shr 8) or ((Value and $0000FF00) shl 8); -end; -{$ELSE ~PUREPASCAL} -asm - {$IFDEF CPU32} - // --> EAX Value - // <-- EAX Value - BSWAP EAX - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> ECX Value - // <-- EAX Value - MOV EAX, ECX - BSWAP EAX - {$ENDIF CPU64} -end; -{$ENDIF ~PUREPASCAL} - -function ReverseBytes(Value: Int64): Int64; -{$IFDEF CPU32} -var - Lo, Hi: Cardinal; -begin - // low and hi DWORD swap - Lo := TJclULargeInteger(Value).HighPart; - Hi := TJclULargeInteger(Value).LowPart; - TJclULargeInteger(Result).HighPart := (Hi shr 24) or (Hi shl 24) or ((Hi and $00FF0000) shr 8) or ((Hi and $0000FF00) shl 8); - TJclULargeInteger(Result).LowPart := (Lo shr 24) or (Lo shl 24) or ((Lo and $00FF0000) shr 8) or ((Lo and $0000FF00) shl 8); -end; -{$ENDIF CPU32} -{$IFDEF CPU64} -asm - // --> RCX Value - // <-- RAX Result - MOV RAX, RCX - BSWAP RAX -end; -{$ENDIF CPU64} - -function ReverseBytes(P: Pointer; Count: Integer): Pointer; -var - P1, P2: PByte; - T: Byte; -begin - if (P <> nil) and (Count > 0) then - begin - P1 := P; - P2 := P; - Inc(P2, Count - 1); - while TJclAddr(P1) < TJclAddr(P2) do - begin - T := P1^; - P1^ := P2^; - P2^ := T; - Inc(P1); - Dec(P2); - end; - end; - Result := P; -end; - -// Arithmetic -procedure SwapOrd(var I, J: Byte); -var - T: Byte; -begin - T := I; - I := J; - J := T; -end; - -procedure SwapOrd(var I, J: Cardinal); -var - T: Cardinal; -begin - T := I; - I := J; - J := T; -end; - -procedure SwapOrd(var I, J: Integer); -var - T: Integer; -begin - T := I; - I := J; - J := T; -end; - -procedure SwapOrd(var I, J: Int64); -var - T: Int64; -begin - T := I; - I := J; - J := T; -end; - -procedure SwapOrd(var I, J: Shortint); -var - T: Shortint; -begin - T := I; - I := J; - J := T; -end; - -procedure SwapOrd(var I, J: Smallint); -var - T: Smallint; -begin - T := I; - I := J; - J := T; -end; - -procedure SwapOrd(var I, J: Word); -var - T: Word; -begin - T := I; - I := J; - J := T; -end; - -function IncLimit(var B: Byte; const Limit, Incr: Byte): Byte; -begin - if (B + Incr) <= Limit then - Inc(B, Incr); - Result := B; -end; - -function IncLimit(var B: Shortint; const Limit, Incr: Shortint): Shortint; -begin - if (B + Incr) <= Limit then - Inc(B, Incr); - Result := B; -end; - -function IncLimit(var B: Smallint; const Limit, Incr: Smallint): Smallint; -begin - if (B + Incr) <= Limit then - Inc(B, Incr); - Result := B; -end; - -function IncLimit(var B: Word; const Limit, Incr: Word): Word; -begin - if (B + Incr) <= Limit then - Inc(B, Incr); - Result := B; -end; - -function IncLimit(var B: Integer; const Limit, Incr: Integer): Integer; -begin - if (B + Incr) <= Limit then - Inc(B, Incr); - Result := B; -end; - -function IncLimit(var B: Cardinal; const Limit, Incr: Cardinal): Cardinal; -begin - if (B + Incr) <= Limit then - Inc(B, Incr); - Result := B; -end; - -function IncLimit(var B: Int64; const Limit, Incr: Int64): Int64; -begin - if (B + Incr) <= Limit then - Inc(B, Incr); - Result := B; -end; - -function DecLimit(var B: Byte; const Limit, Decr: Byte): Byte; -begin - if (B - Decr) >= Limit then - Dec(B, Decr); - Result := B; -end; - -function DecLimit(var B: Shortint; const Limit, Decr: Shortint): shortint; -begin - if (B - Decr) >= Limit then - Dec(B, Decr); - Result := B; -end; - -function DecLimit(var B: Smallint; const Limit, Decr: Smallint): Smallint; -begin - if (B - Decr) >= Limit then - Dec(B, Decr); - Result := B; -end; - -function DecLimit(var B: Word; const Limit, Decr: Word): Word; -begin - if (B - Decr) >= Limit then - Dec(B, Decr); - Result := B; -end; - -function DecLimit(var B: Integer; const Limit, Decr: Integer): Integer; -begin - if (B - Decr) >= Limit then - Dec(B, Decr); - Result := B; -end; - -function DecLimit(var B: Cardinal; const Limit, Decr: Cardinal): Cardinal; -begin - if (B - Decr) >= Limit then - Dec(B, Decr); - Result := B; -end; - -function DecLimit(var B: Int64; const Limit, Decr: Int64): Int64; -begin - if (B - Decr) >= Limit then - Dec(B, Decr); - Result := B; -end; - -function IncLimitClamp(var B: Byte; const Limit, Incr: Byte): Byte; -begin - if (B + Incr) <= Limit then - Inc(B, Incr) - else - B := Limit; - Result := B; -end; - -function IncLimitClamp(var B: Shortint; const Limit, Incr: Shortint): Shortint; -begin - if (B + Incr) <= Limit then - Inc(B, Incr) - else - B := Limit; - Result := B; -end; - -function IncLimitClamp(var B: Smallint; const Limit, Incr: Smallint): Smallint; -begin - if (B + Incr) <= Limit then - Inc(B, Incr) - else - B := Limit; - Result := B; -end; - -function IncLimitClamp(var B: Word; const Limit, Incr: Word): Word; -begin - if (B + Incr) <= Limit then - Inc(B, Incr) - else - B := Limit; - Result := B; -end; - -function IncLimitClamp(var B: Integer; const Limit, Incr: Integer): Integer; -begin - if (B + Incr) <= Limit then - Inc(B, Incr) - else - B := Limit; - Result := B; -end; - -function IncLimitClamp(var B: Cardinal; const Limit, Incr: Cardinal): Cardinal; -begin - if (B + Incr) <= Limit then - Inc(B, Incr) - else - B := Limit; - Result := B; -end; - -function IncLimitClamp(var B: Int64; const Limit, Incr: Int64): Int64; -begin - if (B + Incr) <= Limit then - Inc(B, Incr) - else - B := Limit; - Result := B; -end; - -function DecLimitClamp(var B: Byte; const Limit, Decr: Byte): Byte; -begin - if (B - Decr) >= Limit then - Dec(B, Decr) - else - B := Limit; - Result := B; -end; - -function DecLimitClamp(var B: Shortint; const Limit, Decr: Shortint): Shortint; -begin - if (B - Decr) >= Limit then - Dec(B, Decr) - else - B := Limit; - Result := B; -end; - -function DecLimitClamp(var B: Smallint; const Limit, Decr: Smallint): Smallint; -begin - if (B - Decr) >= Limit then - Dec(B, Decr) - else - B := Limit; - Result := B; -end; - -function DecLimitClamp(var B: Word; const Limit, Decr: Word): Word; -begin - if (B - Decr) >= Limit then - Dec(B, Decr) - else - B := Limit; - Result := B; -end; - -function DecLimitClamp(var B: Integer; const Limit, Decr: Integer): Integer; -begin - if (B - Decr) >= Limit then - Dec(B, Decr) - else - B := Limit; - Result := B; -end; - -function DecLimitClamp(var B: Cardinal; const Limit, Decr: Cardinal): Cardinal; -begin - if (B - Decr) >= Limit then - Dec(B, Decr) - else - B := Limit; - Result := B; -end; - -function DecLimitClamp(var B: Int64; const Limit, Decr: Int64): Int64; -begin - if (B - Decr) >= Limit then - Dec(B, Decr) - else - B := Limit; - Result := B; -end; - -function Max(const B1, B2: Byte): Byte; -begin - if B1 > B2 then - Result := B1 - else - Result := B2; -end; - -function Min(const B1, B2: Byte): Byte; -begin - if B1 < B2 then - Result := B1 - else - Result := B2; -end; - -function Max(const B1, B2: Shortint): Shortint; -begin - if B1 > B2 then - Result := B1 - else - Result := B2; -end; - -function Max(const B1, B2: Smallint): Smallint; -begin - if B1 > B2 then - Result := B1 - else - Result := B2; -end; - -function Min(const B1, B2: Shortint): Shortint; -begin - if B1 < B2 then - Result := B1 - else - Result := B2; -end; - -function Min(const B1, B2: Smallint): Smallint; -begin - if B1 < B2 then - Result := B1 - else - Result := B2; -end; - -function Max(const B1, B2: Word): Word; -begin - if B1 > B2 then - Result := B1 - else - Result := B2; -end; - -function Max(const B1, B2: Int64): Int64; -begin - if B1 > B2 then - Result := B1 - else - Result := B2; -end; - -function Min(const B1, B2: Word): Word; -begin - if B1 < B2 then - Result := B1 - else - Result := B2; -end; - -function Max(const B1, B2: Integer): Integer; -begin - if B1 > B2 then - Result := B1 - else - Result := B2; -end; - -function Min(const B1, B2: Integer): Integer; -begin - if B1 < B2 then - Result := B1 - else - Result := B2; -end; - -function Max(const B1, B2: Cardinal): Cardinal; -begin - if B1 > B2 then - Result := B1 - else - Result := B2; -end; - -function Min(const B1, B2: Cardinal): Cardinal; -begin - if B1 < B2 then - Result := B1 - else - Result := B2; -end; - -function Min(const B1, B2: Int64): Int64; -begin - if B1 < B2 then - Result := B1 - else - Result := B2; -end; - -{$IFDEF UNITVERSIONING} -initialization - RegisterUnitVersion(HInstance, UnitVersioning); - -finalization - UnregisterUnitVersion(HInstance); -{$ENDIF UNITVERSIONING} - -end. +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclLogic.pas. } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. } +{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. All rights reserved. } +{ } +{ Contributor(s): } +{ Marcel Bestebroer (marcelb) } +{ Marcel van Brakel } +{ ESB Consultancy } +{ Martin Kimmings } +{ Robert Marquardt (marquardt) } +{ Chris Morris } +{ Andreas Schmidt shmia at bizerba.de } +{ Michael Schnell } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ } +{**************************************************************************************************} +{ } +{ Various routines to perform various arithmetic and logical operations on one or more ordinal } +{ values (integer numbers). This includes various bit manipulation routines, min/max testing and } +{ conversion to string. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +{.$DEFINE PUREPASCAL} + +unit JclLogic; + +{$I jcl.inc} +{$RANGECHECKS OFF} + +interface + +{$IFDEF UNITVERSIONING} +uses + JclUnitVersioning; +{$ENDIF UNITVERSIONING} + +// Conversion +function OrdToBinary(Value: Byte): string; overload; +function OrdToBinary(Value: ShortInt): string; overload; +function OrdToBinary(Value: SmallInt): string; overload; +function OrdToBinary(Value: Word): string; overload; +function OrdToBinary(Value: Integer): string; overload; +function OrdToBinary(Value: Cardinal): string; overload; +function OrdToBinary(Value: Int64): string; overload; + +// Bit manipulation +type + TBitRange = Byte; + TBooleanArray = array of Boolean; + +function BitsHighest(X: Byte): Integer; overload; +function BitsHighest(X: ShortInt): Integer; overload; +function BitsHighest(X: SmallInt): Integer; overload; +function BitsHighest(X: Word): Integer; overload; +function BitsHighest(X: Integer): Integer; overload; +function BitsHighest(X: Cardinal): Integer; overload; +function BitsHighest(X: Int64): Integer; overload; + +function BitsLowest(X: Byte): Integer; overload; +function BitsLowest(X: Shortint): Integer; overload; +function BitsLowest(X: Smallint): Integer; overload; +function BitsLowest(X: Word): Integer; overload; +function BitsLowest(X: Cardinal): Integer; overload; +function BitsLowest(X: Integer): Integer; overload; +function BitsLowest(X: Int64): Integer; overload; + +function ClearBit(const Value: Byte; const Bit: TBitRange): Byte; overload; +function ClearBit(const Value: Shortint; const Bit: TBitRange): Shortint; overload; +function ClearBit(const Value: Smallint; const Bit: TBitRange): Smallint; overload; +function ClearBit(const Value: Word; const Bit: TBitRange): Word; overload; +function ClearBit(const Value: Integer; const Bit: TBitRange): Integer; overload; +function ClearBit(const Value: Cardinal; const Bit: TBitRange): Cardinal; overload; +function ClearBit(const Value: Int64; const Bit: TBitRange): Int64; overload; +procedure ClearBitBuffer(var Value; const Bit: Cardinal); overload; +{$IFDEF CPU64} +procedure ClearBitBuffer(var Value; const Bit: Int64); overload; +{$ENDIF CPU64} + +function CountBitsSet(X: Byte): Integer; overload; +function CountBitsSet(X: Word): Integer; overload; +function CountBitsSet(X: Smallint): Integer; overload; +function CountBitsSet(X: ShortInt): Integer; overload; +function CountBitsSet(X: Integer): Integer; overload; +function CountBitsSet(X: Cardinal): Integer; overload; +function CountBitsSet(X: Int64): Integer; overload; +function CountBitsSet(P: Pointer; Count: Cardinal): Cardinal; overload; + +function CountBitsCleared(X: Byte): Integer; overload; +function CountBitsCleared(X: Shortint): Integer; overload; +function CountBitsCleared(X: Smallint): Integer; overload; +function CountBitsCleared(X: Word): Integer; overload; +function CountBitsCleared(X: Integer): Integer; overload; +function CountBitsCleared(X: Cardinal): Integer; overload; +function CountBitsCleared(X: Int64): Integer; overload; +function CountBitsCleared(P: Pointer; Count: Cardinal): Cardinal; overload; + +function LRot(const Value: Byte; const Count: TBitRange): Byte; overload; +function LRot(const Value: Word; const Count: TBitRange): Word; overload; +function LRot(const Value: Integer; const Count: TBitRange): Integer; overload; +function LRot(const Value: Int64; const Count: TBitRange): Int64; overload; +function ReverseBits(Value: Byte): Byte; overload; +function ReverseBits(Value: Shortint): Shortint; overload; +function ReverseBits(Value: Smallint): Smallint; overload; +function ReverseBits(Value: Word): Word; overload; +function ReverseBits(Value: Integer): Integer; overload; +function ReverseBits(Value: Cardinal): Cardinal; overload; +function ReverseBits(Value: Int64): Int64; overload; +function ReverseBits(P: Pointer; Count: Integer): Pointer; overload; + +function RRot(const Value: Byte; const Count: TBitRange): Byte; overload; +function RRot(const Value: Word; const Count: TBitRange): Word; overload; +function RRot(const Value: Integer; const Count: TBitRange): Integer; overload; +function RRot(const Value: Int64; const Count: TBitRange): Int64; overload; + +function Sar(const Value: Shortint; const Count: TBitRange): Shortint; overload; +function Sar(const Value: Smallint; const Count: TBitRange): Smallint; overload; +function Sar(const Value: Integer; const Count: TBitRange): Integer; overload; + +function SetBit(const Value: Byte; const Bit: TBitRange): Byte; overload; +function SetBit(const Value: Shortint; const Bit: TBitRange): Shortint; overload; +function SetBit(const Value: Smallint; const Bit: TBitRange): Smallint; overload; +function SetBit(const Value: Word; const Bit: TBitRange): Word; overload; +function SetBit(const Value: Cardinal; const Bit: TBitRange): Cardinal; overload; +function SetBit(const Value: Integer; const Bit: TBitRange): Integer; overload; +function SetBit(const Value: Int64; const Bit: TBitRange): Int64; overload; +procedure SetBitBuffer(var Value; const Bit: Cardinal); overload; +{$IFDEF CPU64} +procedure SetBitBuffer(var Value; const Bit: Int64); overload; +{$ENDIF CPU64} + +function TestBit(const Value: Byte; const Bit: TBitRange): Boolean; overload; +function TestBit(const Value: Shortint; const Bit: TBitRange): Boolean; overload; +function TestBit(const Value: Smallint; const Bit: TBitRange): Boolean; overload; +function TestBit(const Value: Word; const Bit: TBitRange): Boolean; overload; +function TestBit(const Value: Cardinal; const Bit: TBitRange): Boolean; overload; +function TestBit(const Value: Integer; const Bit: TBitRange): Boolean; overload; +function TestBit(const Value: Int64; const Bit: TBitRange): Boolean; overload; +function TestBitBuffer(const Value; const Bit: Cardinal): Boolean; overload; +{$IFDEF CPU64} +function TestBitBuffer(const Value; const Bit: Int64): Boolean; overload; +{$ENDIF CPU64} + +function TestBits(const Value, Mask: Byte): Boolean; overload; +function TestBits(const Value, Mask: Shortint): Boolean; overload; +function TestBits(const Value, Mask: Smallint): Boolean; overload; +function TestBits(const Value, Mask: Word): Boolean; overload; +function TestBits(const Value, Mask: Cardinal): Boolean; overload; +function TestBits(const Value, Mask: Integer): Boolean; overload; +function TestBits(const Value, Mask: Int64): Boolean; overload; + +function ToggleBit(const Value: Byte; const Bit: TBitRange): Byte; overload; +function ToggleBit(const Value: Shortint; const Bit: TBitRange): Shortint; overload; +function ToggleBit(const Value: Smallint; const Bit: TBitRange): Smallint; overload; +function ToggleBit(const Value: Word; const Bit: TBitRange): Word; overload; +function ToggleBit(const Value: Cardinal; const Bit: TBitRange): Cardinal; overload; +function ToggleBit(const Value: Integer; const Bit: TBitRange): Integer; overload; +function ToggleBit(const Value: Int64; const Bit: TBitRange): Int64; overload; +procedure ToggleBitBuffer(var Value; const Bit: Cardinal); overload; +{$IFDEF CPU64} +procedure ToggleBitBuffer(var Value; const Bit: Int64); overload; +{$ENDIF CPU64} + +procedure BooleansToBits(var Dest: Byte; const B: TBooleanArray); overload; +procedure BooleansToBits(var Dest: Word; const B: TBooleanArray); overload; +procedure BooleansToBits(var Dest: Integer; const B: TBooleanArray); overload; +procedure BooleansToBits(var Dest: Int64; const B: TBooleanArray); overload; + +procedure BitsToBooleans(const Bits: Byte; var B: TBooleanArray; AllBits: Boolean = False); overload; +procedure BitsToBooleans(const Bits: Word; var B: TBooleanArray; AllBits: Boolean = False); overload; +procedure BitsToBooleans(const Bits: Integer; var B: TBooleanArray; AllBits: Boolean = False); overload; +procedure BitsToBooleans(const Bits: Int64; var B: TBooleanArray; AllBits: Boolean = False); overload; + +function BitsNeeded(const X: Byte): Integer; overload; +function BitsNeeded(const X: Word): Integer; overload; +function BitsNeeded(const X: Integer): Integer; overload; +function BitsNeeded(const X: Int64): Integer; overload; + +function Digits(const X: Cardinal): Integer; + +function ReverseBytes(Value: Word): Word; overload; +function ReverseBytes(Value: Smallint): Smallint; overload; +function ReverseBytes(Value: Integer): Integer; overload; +function ReverseBytes(Value: Cardinal): Cardinal; overload; +function ReverseBytes(Value: Int64): Int64; overload; +function ReverseBytes(P: Pointer; Count: Integer): Pointer; overload; + +// Arithmetic +procedure SwapOrd(var I, J: Byte); overload; +procedure SwapOrd(var I, J: Shortint); overload; +procedure SwapOrd(var I, J: Smallint); overload; +procedure SwapOrd(var I, J: Word); overload; +procedure SwapOrd(var I, J: Integer); overload; +procedure SwapOrd(var I, J: Cardinal); overload; +procedure SwapOrd(var I, J: Int64); overload; + +function IncLimit(var B: Byte; const Limit: Byte; const Incr: Byte = 1): Byte; overload; +function IncLimit(var B: Shortint; const Limit: Shortint; const Incr: Shortint = 1): Shortint; overload; +function IncLimit(var B: Smallint; const Limit: Smallint; const Incr: Smallint = 1): Smallint; overload; +function IncLimit(var B: Word; const Limit: Word; const Incr: Word = 1): Word; overload; +function IncLimit(var B: Integer; const Limit: Integer; const Incr: Integer = 1): Integer; overload; +function IncLimit(var B: Cardinal; const Limit: Cardinal; const Incr: Cardinal = 1): Cardinal; overload; +function IncLimit(var B: Int64; const Limit: Int64; const Incr: Int64 = 1): Int64; overload; + +function DecLimit(var B: Byte; const Limit: Byte; const Decr: Byte = 1): Byte; overload; +function DecLimit(var B: Shortint; const Limit: Shortint; const Decr: Shortint = 1): Shortint; overload; +function DecLimit(var B: Smallint; const Limit: Smallint; const Decr: Smallint = 1): Smallint; overload; +function DecLimit(var B: Word; const Limit: Word; const Decr: Word = 1): Word; overload; +function DecLimit(var B: Integer; const Limit: Integer; const Decr: Integer = 1): Integer; overload; +function DecLimit(var B: Cardinal; const Limit: Cardinal; const Decr: Cardinal = 1): Cardinal; overload; +function DecLimit(var B: Int64; const Limit: Int64; const Decr: Int64 = 1): Int64; overload; + +function IncLimitClamp(var B: Byte; const Limit: Byte; const Incr: Byte = 1): Byte; overload; +function IncLimitClamp(var B: Shortint; const Limit: Shortint; const Incr: Shortint = 1): Shortint; overload; +function IncLimitClamp(var B: Smallint; const Limit: Smallint; const Incr: Smallint = 1): Smallint; overload; +function IncLimitClamp(var B: Word; const Limit: Word; const Incr: Word = 1): Word; overload; +function IncLimitClamp(var B: Integer; const Limit: Integer; const Incr: Integer = 1): Integer; overload; +function IncLimitClamp(var B: Cardinal; const Limit: Cardinal; const Incr: Cardinal = 1): Cardinal; overload; +function IncLimitClamp(var B: Int64; const Limit: Int64; const Incr: Int64 = 1): Int64; overload; + +function DecLimitClamp(var B: Byte; const Limit: Byte; const Decr: Byte = 1): Byte; overload; +function DecLimitClamp(var B: Shortint; const Limit: Shortint; const Decr: Shortint = 1): Shortint; overload; +function DecLimitClamp(var B: Smallint; const Limit: Smallint; const Decr: Smallint = 1): Smallint; overload; +function DecLimitClamp(var B: Word; const Limit: Word; const Decr: Word = 1): Word; overload; +function DecLimitClamp(var B: Integer; const Limit: Integer; const Decr: Integer = 1): Integer; overload; +function DecLimitClamp(var B: Cardinal; const Limit: Cardinal; const Decr: Cardinal = 1): Cardinal; overload; +function DecLimitClamp(var B: Int64; const Limit: Int64; const Decr: Int64 = 1): Int64; overload; + +function Max(const B1, B2: Byte): Byte; overload; +function Max(const B1, B2: Shortint): Shortint; overload; +function Max(const B1, B2: Smallint): Smallint; overload; +function Max(const B1, B2: Word): Word; overload; +function Max(const B1, B2: Integer): Integer; overload; +function Max(const B1, B2: Cardinal): Cardinal; overload; +function Max(const B1, B2: Int64): Int64; overload; + +function Min(const B1, B2: Byte): Byte; overload; +function Min(const B1, B2: Shortint): Shortint; overload; +function Min(const B1, B2: Smallint): Smallint; overload; +function Min(const B1, B2: Word): Word; overload; +function Min(const B1, B2: Integer): Integer; overload; +function Min(const B1, B2: Cardinal): Cardinal; overload; +function Min(const B1, B2: Int64): Int64; overload; + +const + // Constants defining the number of bits in each Integer type + + BitsPerNibble = 4; + BitsPerByte = 8; + BitsPerShortint = SizeOf(Shortint) * BitsPerByte; + BitsPerSmallint = SizeOf(Smallint) * BitsPerByte; + BitsPerWord = SizeOf(Word) * BitsPerByte; + BitsPerInteger = SizeOf(Integer) * BitsPerByte; + BitsPerCardinal = SizeOf(Cardinal) * BitsPerByte; + BitsPerInt64 = SizeOf(Int64) * BitsPerByte; + + // Constants defining the number of nibbles in each Integer type + + NibblesPerByte = BitsPerByte div BitsPerNibble; + NibblesPerShortint = SizeOf(Shortint) * NibblesPerByte; + NibblesPerSmallint = SizeOf(Smallint) * NibblesPerByte; + NibblesPerWord = SizeOf(Word) * NibblesPerByte; + NibblesPerInteger = SizeOf(Integer) * NibblesPerByte; + NibblesPerCardinal = SizeOf(Cardinal) * NibblesPerByte; + NibblesPerInt64 = SizeOf(Int64) * NibblesPerByte; + + // Constants defining a mask with all bits set for each Integer type + + NibbleMask = $F; + ByteMask = Byte($FF); + ShortintMask = Shortint($FF); + SmallintMask = Smallint($FFFF); + WordMask = Word($FFFF); + IntegerMask = Integer($FFFFFFFF); + CardinalMask = Cardinal($FFFFFFFF); + Int64Mask = Int64($FFFFFFFFFFFFFFFF); + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + JclBase; + +// Conversion +function OrdToBinary(Value: Byte): string; +var + I: Integer; +begin + SetLength(Result, BitsPerByte); + for I := Length(Result) - 1 downto 0 do + begin + Result[I + 1] := Chr(48 + (Value and $00000001)); + Value := Value shr 1; + end; +end; + +function OrdToBinary(Value: Shortint): string; +var + I: Integer; +begin + SetLength(Result, BitsPerShortint); + for I := Length(Result) - 1 downto 0 do + begin + Result[I + 1] := Chr(48 + (Value and $00000001)); + Value := Value shr 1; + end; +end; + +function OrdToBinary(Value: Smallint): string; +var + I: Integer; + S: Smallint; +begin + SetLength(Result, BitsPerSmallint); + S := Value; + for I := Length(Result) - 1 downto 0 do + begin + Result[I + 1] := Chr(48 + (S and $00000001)); + S := S shr 1; + end; +end; + +function OrdToBinary(Value: Word): string; +var + I: Integer; +begin + SetLength(Result, BitsPerWord); + for I := Length(Result) - 1 downto 0 do + begin + Result[I + 1] := Chr(48 + (Value and $00000001)); + Value := Value shr 1; + end; +end; + +function OrdToBinary(Value: Integer): string; +var + I: Integer; +begin + SetLength(Result, BitsPerInteger); + for I := Length(Result) - 1 downto 0 do + begin + Result[I + 1] := Chr(48 + (Value and $00000001)); + Value := Value shr 1; + end; +end; + +function OrdToBinary(Value: Cardinal): string; +var + I: Integer; +begin + SetLength(Result, BitsPerCardinal); + for I := Length(Result) - 1 downto 0 do + begin + Result[I + 1] := Chr(48 + (Value and $00000001)); + Value := Value shr 1; + end; +end; + +function OrdToBinary(Value: Int64): string; +var + I: Integer; +begin + SetLength(Result, BitsPerInt64); + for I := Length(Result) - 1 downto 0 do + begin + Result[I + 1] := Chr(48 + (Value and Int64(1))); + Value := Value shr Int64(1); + end; +end; + + +// Bit manipulation +function BitsHighest(X: Cardinal): Integer; +asm + {$IFDEF CPU32} + // --> EAX X + // <-- EAX + MOV ECX, EAX + MOV EAX, -1 + BSR EAX, ECX + JNZ @@End + MOV EAX, -1 +@@End: + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> ECX X + // <-- RAX + MOV EAX, -1 + MOV R10D, EAX + BSR EAX, ECX + CMOVZ EAX, R10D + {$ENDIF CPU64} +end; + +function BitsHighest(X: Integer): Integer; +asm + {$IFDEF CPU32} + // --> EAX X + // <-- EAX + MOV ECX, EAX + MOV EAX, -1 + BSR EAX, ECX + JNZ @@End + MOV EAX, -1 +@@End: + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> ECX X + // <-- RAX + MOV EAX, -1 + MOV R10D, EAX + BSR EAX, ECX + CMOVZ EAX, R10D + {$ENDIF CPU64} +end; + +function BitsHighest(X: Byte): Integer; +begin + Result := BitsHighest(Cardinal(X)); +end; + +function BitsHighest(X: Word): Integer; +begin + Result := BitsHighest(Cardinal(X)); +end; + +function BitsHighest(X: SmallInt): Integer; +begin + Result := BitsHighest(Integer(X)); +end; + +function BitsHighest(X: ShortInt): Integer; +begin + Result := BitsHighest(Integer(X)); +end; + +function BitsHighest(X: Int64): Integer; +{$IFDEF CPU32} +begin + if TJclULargeInteger(X).HighPart = 0 then + Result := BitsHighest(TJclULargeInteger(X).LowPart) + else + Result := BitsHighest(TJclULargeInteger(X).HighPart) + 32; +end; +{$ENDIF CPU32} +{$IFDEF CPU64} +asm + // --> RCX X + // <-- RAX + + // this is much shorter than "MOV RAX, -1" + XOR RAX, RAX + DEC EAX + + MOV R10, RAX + BSR RAX, RCX + CMOVZ RAX, R10 +end; +{$ENDIF CPU64} + +function BitsLowest(X: Cardinal): Integer; +asm + {$IFDEF CPU32} + // --> EAX X + // <-- EAX + MOV ECX, EAX + MOV EAX, -1 + BSF EAX, ECX + JNZ @@End + MOV EAX, -1 +@@End: + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> RCX X + // <-- EAX + MOV EAX, -1 + MOV R10D, EAX + BSF EAX, ECX + CMOVZ EAX, R10D + {$ENDIF CPU64} +end; + +function BitsLowest(X: Integer): Integer; +asm + {$IFDEF CPU32} + // --> EAX X + // <-- EAX + MOV ECX, EAX + MOV EAX, -1 + BSF EAX, ECX + JNZ @@End + MOV EAX, -1 +@@End: + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> RCX X + // <-- EAX + MOV EAX, -1 + MOV R10D, EAX + BSF EAX, ECX + CMOVZ EAX, R10D + {$ENDIF CPU64} +end; + +function BitsLowest(X: Byte): Integer; +begin + Result := BitsLowest(Cardinal(X)); +end; + +function BitsLowest(X: Shortint): Integer; +begin + Result := BitsLowest(Integer(X)); +end; + +function BitsLowest(X: Smallint): Integer; +begin + Result := BitsLowest(Integer(X)); +end; + +function BitsLowest(X: Word): Integer; +begin + Result := BitsLowest(Cardinal(X)); +end; + +function BitsLowest(X: Int64): Integer; +{$IFDEF CPU32} +begin + if TJclULargeInteger(X).LowPart = 0 then + Result := BitsLowest(TJclULargeInteger(X).HighPart) + 32 + else + Result := BitsLowest(TJclULargeInteger(X).LowPart); +end; +{$ENDIF CPU32} +{$IFDEF CPU64} +asm + // --> RCX X + // <-- RAX + + // this is much shorter than "MOV RAX, -1" + XOR RAX, RAX + DEC EAX + + MOV R10, RAX + BSF RAX, RCX + CMOVZ RAX, R10 +end; +{$ENDIF CPU64} + +function ClearBit(const Value: Byte; const Bit: TBitRange): Byte; +asm + // 32 --> AL Value + // DL Bit + // <-- AL Result + // 64 --> CL Value + // DL Bit + // <-- AL Result + AND EDX, BitsPerByte - 1 // modulo BitsPerByte + {$IFDEF CPU64} + MOVZX EAX, CL + {$ENDIF CPU64} + BTR EAX, EDX +end; + +function ClearBit(const Value: Shortint; const Bit: TBitRange): Shortint; +asm + // 32 --> AL Value + // DL Bit + // <-- AL Result + // 64 --> CL Value + // DL Bit + // <-- AL Result + AND EDX, BitsPerShortint - 1 // modulo BitsPerShortint + {$IFDEF CPU64} + MOVZX EAX, CL + {$ENDIF CPU64} + BTR EAX, EDX +end; + +function ClearBit(const Value: Smallint; const Bit: TBitRange): Smallint; +asm + // 32 --> AX Value + // DL Bit + // <-- AX Result + // 64 --> CX Value + // DL Bit + // <-- AX Result + AND EDX, BitsPerSmallint - 1 // modulo BitsPerSmallint + {$IFDEF CPU64} + MOVZX EAX, CX + {$ENDIF CPU64} + BTR EAX, EDX +end; + +function ClearBit(const Value: Word; const Bit: TBitRange): Word; +asm + // 32 --> AX Value + // DL Bit + // <-- AX Result + // 64 --> CX Value + // DL Bit + // <-- AX Result + AND EDX, BitsPerWord - 1 // modulo BitsPerWord + {$IFDEF CPU64} + MOVZX EAX, CX + {$ENDIF CPU64} + BTR EAX, EDX +end; + +function ClearBit(const Value: Cardinal; const Bit: TBitRange): Cardinal; +asm + // 32 --> EAX Value + // DL Bit + // <-- EAX Result + // 64 --> ECX Value + // DL Bit + // <-- EAX Result + {$IFDEF CPU64} + MOV EAX, ECX + {$ENDIF CPU64} + BTR EAX, EDX +end; + +function ClearBit(const Value: Integer; const Bit: TBitRange): Integer; +asm + // 32 --> EAX Value + // DL Bit + // <-- EAX Result + // 64 --> ECX Value + // DL Bit + // <-- EAX Result + {$IFDEF CPU64} + MOV EAX, ECX + {$ENDIF CPU64} + BTR EAX, EDX +end; + +function ClearBit(const Value: Int64; const Bit: TBitRange): Int64; +{$IFDEF CPU32} +begin + Result := Value and not (Int64(1) shl (Bit and (BitsPerInt64 - 1))); +end; +{$ENDIF CPU32} +{$IFDEF CPU64} +asm + // --> RCX Value + // DL Bit + // <-- RAX Result + MOV RAX, RCX + BTR RAX, RDX +end; +{$ENDIF CPU64} + +procedure ClearBitBuffer(var Value; const Bit: Cardinal); +{$IFDEF PUREPASCAL} +var + P: PByte; + BitOfs: TBitRange; +begin + P := Addr(Value); + Inc(P, Bit div 8); + BitOfs := Bit mod 8; + P^ := ClearBit(P^, BitOfs); +end; +{$ELSE ~PUREPASCAL} +asm + // 32 --> EAX Value + // EDX Bit + // 64 --> RCX Value + // EDX Bit + BTR [Value], Bit +end; +{$ENDIF ~PUREPASCAL} + +{$IFDEF CPU64} +procedure ClearBitBuffer(var Value; const Bit: Int64); +{$IFDEF PUREPASCAL} +var + P: PByte; + BitOfs: TBitRange; +begin + P := Addr(Value); + Inc(P, Bit div 8); + BitOfs := Bit mod 8; + P^ := ClearBit(P^, BitOfs); +end; +{$ELSE ~PUREPASCAL} +asm + // 64 --> RCX Value + // RDX Bit + BTR [Value], Bit +end; +{$ENDIF ~PUREPASCAL} +{$ENDIF CPU64} + +const + BitSetPerNibble: array[0..15] of Integer = (0,1,1,2,1,2,2,3,1,2,2,3,2,3,3,4); + +function CountBitsSet(X: Cardinal): Integer; +var + Index: Integer; +begin + Result := 0; + for Index := 0 to NibblesPerCardinal - 1 do + begin + Inc(Result, BitSetPerNibble[X and $F]); + X := X shr BitsPerNibble; + end; +end; + +function CountBitsSet(X: Byte): Integer; +begin + Result := BitSetPerNibble[X shr BitsPerNibble] + BitSetPerNibble[X and $F]; +end; + +function CountBitsSet(X: Word): Integer; +var + Index: Integer; +begin + Result := 0; + for Index := 0 to NibblesPerWord - 1 do + begin + Inc(Result, BitSetPerNibble[X and $F]); + X := X shr BitsPerNibble; + end; +end; + +function CountBitsSet(X: Smallint): Integer; +var + Index: Integer; +begin + Result := 0; + for Index := 0 to NibblesPerSmallint - 1 do + begin + Inc(Result, BitSetPerNibble[X and $F]); + X := X shr BitsPerNibble; + end; +end; + +function CountBitsSet(X: ShortInt): Integer; +begin + Result := BitSetPerNibble[X shr BitsPerNibble] + BitSetPerNibble[X and $F]; +end; + +function CountBitsSet(X: Integer): Integer; +var + Index: Integer; +begin + Result := 0; + for Index := 0 to NibblesPerInteger - 1 do + begin + Inc(Result, BitSetPerNibble[X and $F]); + X := X shr BitsPerNibble; + end; +end; + +function CountBitsSet(P: Pointer; Count: Cardinal): Cardinal; +var + b: Byte; +begin + Result := 0; + while Count > 0 do + begin + b := PByte(P)^; + + // lower Nibble + Inc(Result, BitSetPerNibble[b and $0F]); + // upper Nibble + Inc(Result, BitSetPerNibble[b shr BitsPerNibble]); + + Dec(Count); + Inc(PByte(P)); + end; +end; + +function CountBitsSet(X: Int64): Integer; +begin + Result := CountBitsSet(TJclULargeInteger(X).LowPart) + CountBitsSet(TJclULargeInteger(X).HighPart); +end; + +function CountBitsCleared(X: Byte): Integer; +begin + Result := BitsPerByte - CountBitsSet(Byte(X)); +end; + +function CountBitsCleared(X: Shortint): Integer; +begin + Result := BitsPerShortint - CountBitsSet(Byte(X)); +end; + +function CountBitsCleared(X: Smallint): Integer; +begin + Result := BitsPerSmallint - CountBitsSet(Word(X)); +end; + +function CountBitsCleared(X: Word): Integer; +begin + Result := BitsPerWord - CountBitsSet(Word(X)); +end; + +function CountBitsCleared(X: Integer): Integer; +begin + Result := BitsPerInteger - CountBitsSet(Integer(X)); +end; + +function CountBitsCleared(X: Cardinal): Integer; +begin + Result := BitsPerCardinal - CountBitsSet(Cardinal(X)); +end; + +function CountBitsCleared(X: Int64): Integer; +begin + Result := BitsPerInt64 - CountBitsSet(Int64(X)); +end; + +function CountBitsCleared(P: Pointer; Count: Cardinal): Cardinal; +begin + Result := Count * BitsPerByte - CountBitsSet(P, Count); +end; + +function LRot(const Value: Byte; const Count: TBitRange): Byte; +asm + {$IFDEF CPU32} + // --> AL Value + // DL Count + // <-- AL Result + MOV CL, DL + ROL AL, CL + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> CL Value + // DL Count + // <-- AL Result + MOV AL, CL + MOV CL, DL + ROL AL, CL + {$ENDIF CPU64} +end; + +function LRot(const Value: Word; const Count: TBitRange): Word; +asm + {$IFDEF CPU32} + // --> AX Value + // DL Count + // <-- AX Result + MOV CL, DL + ROL AX, CL + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> CX Value + // DL Count + // <-- AX Result + MOV AX, CX + MOV CL, DL + ROL AX, CL + {$ENDIF CPU64} +end; + +function LRot(const Value: Integer; const Count: TBitRange): Integer; +asm + {$IFDEF CPU32} + // --> EAX Value + // DL Count + // <-- EAX Result + MOV CL, DL + ROL EAX, CL + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> ECX Value + // DL Count + // <-- EAX Result + MOV EAX, ECX + MOV CL, DL + ROL EAX, CL + {$ENDIF CPU64} +end; + +function LRot(const Value: Int64; const Count: TBitRange): Int64; +{$IFDEF CPU32} +asm + // --> Value on stack + // AL Count + // <-- EDX:EAX Result + + PUSH ESI + PUSH EDI + + MOV CL, Count + MOV EDX, DWORD PTR [Value + 4] + MOV EAX, DWORD PTR [Value] + + // Count := Count mod 64 + AND CL, $3F + JZ @@End + + CMP CL, 32 + JL @@RolBits + + // Count >= 32: "rol Count" = "rol 32" + "rol (32 - Count)" +@@Swap: + // "rol 32" + XCHG EAX, EDX + // Count := 32 - Count + SUB CL, 32 + +@@RolBits: + MOV EDI, EDX + MOV ESI, EAX + + // shift the bits + SHL EDX, CL + SHL EAX, CL + + // CounterShiftCount := 32 - Count + NEG CL + ADD CL, 32 + // bitwise-or the counter shifted bits + SHR EDI, CL + SHR ESI, CL + OR EAX, EDI + OR EDX, ESI + +@@End: + POP EDI + POP ESI +end; +{$ENDIF CPU32} +{$IFDEF CPU64} +asm + // --> RCX Value + // DL Count + // <-- RAX Result + MOV RAX, RCX + MOV CL, DL + ROL RAX, CL +end; +{$ENDIF CPU64} + +function RRot(const Value: Int64; const Count: TBitRange): Int64; +{$IFDEF CPU32} +begin + Result := LRot(Value, 64 - (Count and $3F)); +end; +{$ENDIF CPU32} +{$IFDEF CPU64} +asm + // --> RCX Value + // DL Count + // <-- RAX Result + MOV RAX, RCX + MOV CL, DL + ROR RAX, CL +end; +{$ENDIF CPU64} + +const + // Lookup table of bit reversed nibbles, used by simple overloads of ReverseBits + RevNibbles: array [0..NibbleMask] of Byte = + ($0, $8, $4, $C, $2, $A, $6, $E, $1, $9, $5, $D, $3, $B, $7, $F); + +function ReverseBits(Value: Byte): Byte; +begin + Result := RevNibbles[Value shr BitsPerNibble] or + (RevNibbles[Value and NibbleMask] shl BitsPerNibble); +end; + +function ReverseBits(Value: Shortint): Shortint; +begin + Result := RevNibbles[Byte(Value) shr BitsPerNibble] or + (RevNibbles[Value and NibbleMask] shl BitsPerNibble); +end; + +function ReverseBits(Value: Smallint): Smallint; +begin + Result := ReverseBits(Word(Value)); +end; + +function ReverseBits(Value: Word): Word; +var + I: Integer; +begin + Result := 0; + for I := 0 to NibblesPerWord - 1 do + begin + Result := (Result shl BitsPerNibble) or RevNibbles[Value and NibbleMask]; + Value := Value shr BitsPerNibble; + end; +end; + +function ReverseBits(Value: Integer): Integer; +var + I: Integer; +begin + Result := 0; + for I := 0 to NibblesPerInteger - 1 do + begin + Result := (Result shl BitsPerNibble) or RevNibbles[Value and NibbleMask]; + Value := Value shr BitsPerNibble; + end; +end; + +function ReverseBits(Value: Cardinal): Cardinal; +var + I: Integer; +begin + Result := 0; + for I := 0 to NibblesPerCardinal - 1 do + begin + Result := (Result shl BitsPerNibble) or RevNibbles[Value and NibbleMask]; + Value := Value shr BitsPerNibble; + end; +end; + +function ReverseBits(Value: Int64): Int64; +begin + TJclULargeInteger(Result).LowPart := ReverseBits(TJclULargeInteger(Value).HighPart); + TJclULargeInteger(Result).HighPart := ReverseBits(TJclULargeInteger(Value).LowPart); +end; + +const + // Lookup table of reversed bytes, used by pointer overload of ReverseBits + ReverseTable: array [0..ByteMask] of Byte = ( + $00, $80, $40, $C0, $20, $A0, $60, $E0, + $10, $90, $50, $D0, $30, $B0, $70, $F0, + $08, $88, $48, $C8, $28, $A8, $68, $E8, + $18, $98, $58, $D8, $38, $B8, $78, $F8, + $04, $84, $44, $C4, $24, $A4, $64, $E4, + $14, $94, $54, $D4, $34, $B4, $74, $F4, + $0C, $8C, $4C, $CC, $2C, $AC, $6C, $EC, + $1C, $9C, $5C, $DC, $3C, $BC, $7C, $FC, + $02, $82, $42, $C2, $22, $A2, $62, $E2, + $12, $92, $52, $D2, $32, $B2, $72, $F2, + $0A, $8A, $4A, $CA, $2A, $AA, $6A, $EA, + $1A, $9A, $5A, $DA, $3A, $BA, $7A, $FA, + $06, $86, $46, $C6, $26, $A6, $66, $E6, + $16, $96, $56, $D6, $36, $B6, $76, $F6, + $0E, $8E, $4E, $CE, $2E, $AE, $6E, $EE, + $1E, $9E, $5E, $DE, $3E, $BE, $7E, $FE, + $01, $81, $41, $C1, $21, $A1, $61, $E1, + $11, $91, $51, $D1, $31, $B1, $71, $F1, + $09, $89, $49, $C9, $29, $A9, $69, $E9, + $19, $99, $59, $D9, $39, $B9, $79, $F9, + $05, $85, $45, $C5, $25, $A5, $65, $E5, + $15, $95, $55, $D5, $35, $B5, $75, $F5, + $0D, $8D, $4D, $CD, $2D, $AD, $6D, $ED, + $1D, $9D, $5D, $DD, $3D, $BD, $7D, $FD, + $03, $83, $43, $C3, $23, $A3, $63, $E3, + $13, $93, $53, $D3, $33, $B3, $73, $F3, + $0B, $8B, $4B, $CB, $2B, $AB, $6B, $EB, + $1B, $9B, $5B, $DB, $3B, $BB, $7B, $FB, + $07, $87, $47, $C7, $27, $A7, $67, $E7, + $17, $97, $57, $D7, $37, $B7, $77, $F7, + $0F, $8F, $4F, $CF, $2F, $AF, $6F, $EF, + $1F, $9F, $5F, $DF, $3F, $BF, $7F, $FF); + +function ReverseBits(P: Pointer; Count: Integer): Pointer; +var + P1, P2: PByte; + T: Byte; +begin + if (P <> nil) and (Count > 0) then + begin + P1 := P; + P2 := P; + Inc(P2, Count - 1); + while TJclAddr(P1) < TJclAddr(P2) do + begin + T := ReverseTable[P1^]; + P1^ := ReverseTable[P2^]; + P2^ := T; + Inc(P1); + Dec(P2); + end; + if P1 = P2 then + P1^ := ReverseTable[P1^]; + end; + Result := P; +end; + +function RRot(const Value: Byte; const Count: TBitRange): Byte; +asm + {$IFDEF CPU32} + // --> AL Value + // DL Count + // <-- AL Result + MOV CL, DL + ROR AL, CL + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> CL Value + // DL Count + // <-- AL Result + MOV AL, CL + MOV CL, DL + ROR AL, CL + {$ENDIF CPU64} +end; + +function RRot(const Value: Word; const Count: TBitRange): Word; +asm + {$IFDEF CPU32} + // --> AX Value + // DL Count + // <-- AX Result + MOV CL, DL + ROR AX, CL + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> CX Value + // DL Count + // <-- AX Result + MOV AX, CX + MOV CL, DL + ROR AX, CL + {$ENDIF CPU64} +end; + +function RRot(const Value: Integer; const Count: TBitRange): Integer; +asm + {$IFDEF CPU32} + // --> EAX Value + // DL Count + // <-- EAX Result + MOV CL, DL + ROR EAX, CL + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> ECX Value + // DL Count + // <-- EAX Result + MOV EAX, ECX + MOV CL, DL + ROR EAX, CL + {$ENDIF CPU64} +end; + +function Sar(const Value: Shortint; const Count: TBitRange): Shortint; +asm + {$IFDEF CPU32} + // --> AL Value + // DL Count + // <-- AL Result + MOV CL, DL + SAR AL, CL + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> CL Value + // DL Count + // <-- AL Result + MOV AL, CL + MOV CL, DL + SAR AL, CL + {$ENDIF CPU64} +end; + +function Sar(const Value: Smallint; const Count: TBitRange): Smallint; +asm + {$IFDEF CPU32} + // --> AX Value + // DL Count + // <-- AX Result + MOV CL, DL + SAR AX, CL + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> CX Value + // DL Count + // <-- AX Result + MOV AX, CX + MOV CL, DL + SAR AX, CL + {$ENDIF CPU64} +end; + +function Sar(const Value: Integer; const Count: TBitRange): Integer; +asm + {$IFDEF CPU32} + // --> EAX Value + // DL Count + // <-- EAX Result + MOV CL, DL + SAR EAX, CL + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> ECX Value + // DL Count + // <-- EAX Result + MOV EAX, ECX + MOV CL, DL + SAR EAX, CL + {$ENDIF CPU64} +end; + +function SetBit(const Value: Byte; const Bit: TBitRange): Byte; +asm + // 32 --> AL Value + // DL Bit + // <-- AL Result + // 64 --> CL Value + // DL Bit + // <-- AL Result + AND EDX, BitsPerByte - 1 // modulo BitsPerByte + {$IFDEF CPU64} + MOVZX EAX, CL + {$ENDIF CPU64} + BTS EAX, EDX +end; + +function SetBit(const Value: Shortint; const Bit: TBitRange): Shortint; +asm + // 32 --> AL Value + // DL Bit + // <-- AL Result + // 64 --> CL Value + // DL Bit + // <-- AL Result + AND EDX, BitsPerShortInt - 1 // modulo BitsPerShortInt + {$IFDEF CPU64} + MOVZX EAX, CL + {$ENDIF CPU64} + BTS EAX, EDX +end; + +function SetBit(const Value: Smallint; const Bit: TBitRange): Smallint; +asm + // 32 --> AX Value + // DL Bit + // <-- AX Result + // 64 --> CX Value + // DL Bit + // <-- AX Result + AND EDX, BitsPerSmallInt - 1 // modulo BitsPerSmallInt + {$IFDEF CPU64} + MOVZX EAX, CX + {$ENDIF CPU64} + BTS EAX, EDX +end; + +function SetBit(const Value: Word; const Bit: TBitRange): Word; +asm + // 32 --> AX Value + // DL Bit + // <-- AX Result + // 64 --> CX Value + // DL Bit + // <-- AX Result + AND EDX, BitsPerWord - 1 // modulo BitsPerWord + {$IFDEF CPU64} + MOVZX EAX, CX + {$ENDIF CPU64} + BTS EAX, EDX +end; + +function SetBit(const Value: Cardinal; const Bit: TBitRange): Cardinal; +asm + // 32 --> EAX Value + // DL Bit + // <-- EAX Result + // 64 --> ECX Value + // DL Bit + // <-- EAX Result + {$IFDEF CPU64} + MOV EAX, ECX + {$ENDIF CPU64} + BTS EAX, EDX +end; + +function SetBit(const Value: Integer; const Bit: TBitRange): Integer; +asm + // 32 --> EAX Value + // DL Bit + // <-- EAX Result + // 64 --> ECX Value + // DL Bit + // <-- EAX Result + {$IFDEF CPU64} + MOV EAX, ECX + {$ENDIF CPU64} + BTS EAX, EDX +end; + +function SetBit(const Value: Int64; const Bit: TBitRange): Int64; +{$IFDEF CPU32} +begin + Result := Value or (Int64(1) shl (Bit and (BitsPerInt64 - 1))); +end; +{$ENDIF CPU32} +{$IFDEF CPU64} +asm + // --> RCX Value + // DL Bit + // <-- RAX Result + MOV RAX, RCX + BTS RAX, RDX +end; +{$ENDIF CPU64} + +procedure SetBitBuffer(var Value; const Bit: Cardinal); +{$IFDEF PUREPASCAL} +var + P: PByte; + BitOfs: TBitRange; +begin + P := Addr(Value); + Inc(P, Bit div 8); + BitOfs := Bit mod 8; + P^ := SetBit(P^, BitOfs); +end; +{$ELSE ~PUREPASCAL} +asm + BTS [Value], Bit +end; +{$ENDIF ~PUREPASCAL} + +{$IFDEF CPU64} +procedure SetBitBuffer(var Value; const Bit: Int64); +{$IFDEF PUREPASCAL} +var + P: PByte; + BitOfs: TBitRange; +begin + P := Addr(Value); + Inc(P, Bit div 8); + BitOfs := Bit mod 8; + P^ := SetBit(P^, BitOfs); +end; +{$ELSE ~PUREPASCAL} +asm + BTS [Value], Bit +end; +{$ENDIF ~PUREPASCAL} +{$ENDIF CPU64} + +function TestBit(const Value: Byte; const Bit: TBitRange): Boolean; +{$IFDEF PUREPASCAL} +begin + Result := (Value shr (Bit and (BitsPerByte - 1))) and 1 <> 0; +end; +{$ELSE ~PUREPASCAL} +asm + // 32 --> AL Value + // DL Bit + // <-- AL Result + // 64 --> CL Value + // DL Bit + // <-- AL Result + AND EDX, BitsPerByte - 1 // modulo BitsPerByte + {$IFDEF CPU64} + MOVZX EAX, CL + {$ENDIF CPU64} + BT EAX, EDX + SETC AL +end; +{$ENDIF ~PUREPASCAL} + +function TestBit(const Value: Shortint; const Bit: TBitRange): Boolean; +{$IFDEF PUREPASCAL} +begin + Result := (Value shr (Bit and (BitsPerShortint - 1))) and 1 <> 0; +end; +{$ELSE ~PUREPASCAL} +asm + // 32 --> AL Value + // DL Bit + // <-- AL Result + // 64 --> CL Value + // DL Bit + // <-- AL Result + AND EDX, BitsPerShortInt - 1 // modulo BitsPerShortInt + {$IFDEF CPU64} + MOVZX EAX, CL + {$ENDIF CPU64} + BT EAX, EDX + SETC AL +end; +{$ENDIF ~PUREPASCAL} + +function TestBit(const Value: Smallint; const Bit: TBitRange): Boolean; +{$IFDEF PUREPASCAL} +begin + Result := (Value shr (Bit and (BitsPerSmallint - 1))) and 1 <> 0; +end; +{$ELSE ~PUREPASCAL} +asm + // 32 --> AX Value + // DL Bit + // <-- AX Result + // 64 --> CX Value + // DL Bit + // <-- AX Result + AND EDX, BitsPerSmallInt - 1 // modulo BitsPerSmallInt + {$IFDEF CPU64} + MOVZX EAX, CX + {$ENDIF CPU64} + BT EAX, EDX + SETC AL +end; +{$ENDIF ~PUREPASCAL} + +function TestBit(const Value: Word; const Bit: TBitRange): Boolean; +{$IFDEF PUREPASCAL} +begin + Result := (Value shr (Bit and (BitsPerWord - 1))) and 1 <> 0; +end; +{$ELSE ~PUREPASCAL} +asm + // 32 --> AX Value + // DL Bit + // <-- AX Result + // 64 --> CX Value + // DL Bit + // <-- AX Result + AND EDX, BitsPerWord - 1 // modulo BitsPerWord + {$IFDEF CPU64} + MOVZX EAX, CX + {$ENDIF CPU64} + BT EAX, EDX + SETC AL +end; +{$ENDIF ~PUREPASCAL} + +function TestBit(const Value: Cardinal; const Bit: TBitRange): Boolean; +{$IFDEF PUREPASCAL} +begin + Result := (Value shr (Bit and (BitsPerCardinal - 1))) and 1 <> 0; +end; +{$ELSE ~PUREPASCAL} +asm + // 32 --> EAX Value + // DL Bit + // <-- EAX Result + // 64 --> ECX Value + // DL Bit + // <-- EAX Result + {$IFDEF CPU64} + MOV EAX, ECX + {$ENDIF CPU64} + BT EAX, EDX + SETC AL +end; +{$ENDIF ~PUREPASCAL} + +function TestBit(const Value: Integer; const Bit: TBitRange): Boolean; +{$IFDEF PUREPASCAL} +begin + Result := (Value shr (Bit and (BitsPerInteger - 1))) and 1 <> 0; +end; +{$ELSE ~PUREPASCAL} +asm + // 32 --> EAX Value + // DL Bit + // <-- EAX Result + // 64 --> ECX Value + // DL Bit + // <-- EAX Result + {$IFDEF CPU64} + MOV EAX, ECX + {$ENDIF CPU64} + BT EAX, EDX + SETC AL +end; +{$ENDIF ~PUREPASCAL} + +function TestBit(const Value: Int64; const Bit: TBitRange): Boolean; +{$IFDEF CPU32} +begin + Result := (Value shr (Bit and (BitsPerInt64 - 1))) and 1 <> 0; +end; +{$ENDIF CPU32} +{$IFDEF CPU64} +asm + // --> RCX Value + // DL Bit + // <-- RAX Result + MOV RAX, RCX + BT RAX, RDX + SETC AL +end; +{$ENDIF ~PUREPASCAL} + +function TestBitBuffer(const Value; const Bit: Cardinal): Boolean; +{$IFDEF PUREPASCAL} +var + P: PByte; + BitOfs: TBitRange; +begin + P := Addr(Value); + Inc(P, Bit div 8); + BitOfs := Bit mod 8; + Result := TestBit(P^, BitOfs); +end; +{$ELSE ~PUREPASCAL} +asm + BT [Value], Bit + SETC AL +end; +{$ENDIF ~PUREPASCAL} + +{$IFDEF CPU64} +function TestBitBuffer(const Value; const Bit: Int64): Boolean; +{$IFDEF PUREPASCAL} +var + P: PByte; + BitOfs: TBitRange; +begin + P := Addr(Value); + Inc(P, Bit div 8); + BitOfs := Bit mod 8; + Result := TestBit(P^, BitOfs); +end; +{$ELSE ~PUREPASCAL} +asm + BT [Value], Bit + SETC AL +end; +{$ENDIF ~PUREPASCAL} +{$ENDIF CPU64} + +function TestBits(const Value, Mask: Byte): Boolean; +begin + Result := (Value and Mask) = Mask; +end; + +function TestBits(const Value, Mask: Shortint): Boolean; +begin + Result := (Value and Mask) = Mask; +end; + +function TestBits(const Value, Mask: Smallint): Boolean; +begin + Result := (Value and Mask) = Mask; +end; + +function TestBits(const Value, Mask: Word): Boolean; +begin + Result := (Value and Mask) = Mask; +end; + +function TestBits(const Value, Mask: Cardinal): Boolean; +begin + Result := (Value and Mask) = Mask; +end; + +function TestBits(const Value, Mask: Integer): Boolean; +begin + Result := (Value and Mask) = Mask; +end; + +function TestBits(const Value, Mask: Int64): Boolean; +begin + Result := (Value and Mask) = Mask; +end; + +function ToggleBit(const Value: Byte; const Bit: TBitRange): Byte; +{$IFDEF PUREPASCAL} +begin + Result := Value xor (1 shl (Bit and (BitsPerByte - 1))); +end; +{$ELSE ~PUREPASCAL} +asm + // 32 --> AL Value + // DL Bit + // <-- AL Result + // 64 --> CL Value + // DL Bit + // <-- AL Result + AND EDX, BitsPerByte - 1 // modulo BitsPerByte + {$IFDEF CPU64} + MOVZX EAX, CL + {$ENDIF CPU64} + BTC EAX, EDX +end; +{$ENDIF ~PUREPASCAL} + +function ToggleBit(const Value: Shortint; const Bit: TBitRange): Shortint; +{$IFDEF PUREPASCAL} +begin + Result := Value xor (1 shl (Bit and (BitsPerShortint - 1))); +end; +{$ELSE ~PUREPASCAL} +asm + // 32 --> AL Value + // DL Bit + // <-- AL Result + // 64 --> CL Value + // DL Bit + // <-- AL Result + AND EDX, BitsPerShortInt - 1 // modulo BitsPerShortInt + {$IFDEF CPU64} + MOVZX EAX, CL + {$ENDIF CPU64} + BTC EAX, EDX +end; +{$ENDIF ~PUREPASCAL} + +function ToggleBit(const Value: Smallint; const Bit: TBitRange): Smallint; +{$IFDEF PUREPASCAL} +begin + Result := Value xor (1 shl (Bit and (BitsPerSmallint - 1))); +end; +{$ELSE ~PUREPASCAL} +asm + // 32 --> AX Value + // DL Bit + // <-- AX Result + // 64 --> CX Value + // DL Bit + // <-- AX Result + AND EDX, BitsPerSmallInt - 1 // modulo BitsPerSmallInt + {$IFDEF CPU64} + MOVZX EAX, CX + {$ENDIF CPU64} + BTC EAX, EDX +end; +{$ENDIF ~PUREPASCAL} + +function ToggleBit(const Value: Word; const Bit: TBitRange): Word; +{$IFDEF PUREPASCAL} +begin + Result := Value xor (1 shl (Bit and (BitsPerWord - 1))); +end; +{$ELSE ~PUREPASCAL} +asm + // 32 --> AX Value + // DL Bit + // <-- AX Result + // 64 --> CX Value + // DL Bit + // <-- AX Result + AND EDX, BitsPerWord - 1 // modulo BitsPerWord + {$IFDEF CPU64} + MOVZX EAX, CX + {$ENDIF CPU64} + BTC EAX, EDX +end; +{$ENDIF ~PUREPASCAL} + +function ToggleBit(const Value: Cardinal; const Bit: TBitRange): Cardinal; +{$IFDEF PUREPASCAL} +begin + Result := Value xor (1 shl (Bit and (BitsPerCardinal - 1))); +end; +{$ELSE ~PUREPASCAL} +asm + // 32 --> EAX Value + // DL Bit + // <-- EAX Result + // 64 --> ECX Value + // DL Bit + // <-- EAX Result + {$IFDEF CPU64} + MOV EAX, ECX + {$ENDIF CPU64} + BTC EAX, EDX +end; +{$ENDIF ~PUREPASCAL} + +function ToggleBit(const Value: Integer; const Bit: TBitRange): Integer; +{$IFDEF PUREPASCAL} +begin + Result := Value xor (1 shl (Bit and (BitsPerInteger - 1))); +end; +{$ELSE ~PUREPASCAL} +asm + // 32 --> EAX Value + // DL Bit + // <-- EAX Result + // 64 --> ECX Value + // DL Bit + // <-- EAX Result + {$IFDEF CPU64} + MOV EAX, ECX + {$ENDIF CPU64} + BTC EAX, EDX +end; +{$ENDIF ~PUREPASCAL} + +function ToggleBit(const Value: Int64; const Bit: TBitRange): Int64; +{$IFDEF CPU32} +begin + Result := Value xor (Int64(1) shl (Bit and (BitsPerInt64 - 1))); +end; +{$ENDIF CPU32} +{$IFDEF CPU64} +asm + // --> RCX Value + // DL Bit + // <-- RAX Result + MOV RAX, RCX + BTC RAX, RDX +end; +{$ENDIF CPU64} + +procedure ToggleBitBuffer(var Value; const Bit: Cardinal); +{$IFDEF PUREPASCAL} +var + P: PByte; + BitOfs: TBitRange; +begin + P := Addr(Value); + Inc(P, Bit div 8); + BitOfs := Bit mod 8; + P^ := ToggleBit(P^, BitOfs); +end; +{$ELSE ~PUREPASCAL} +asm + BTC [Value], Bit +end; +{$ENDIF ~PUREPASCAL} + +{$IFDEF CPU64} +procedure ToggleBitBuffer(var Value; const Bit: Int64); +{$IFDEF PUREPASCAL} +var + P: PByte; + BitOfs: TBitRange; +begin + P := Addr(Value); + Inc(P, Bit div 8); + BitOfs := Bit mod 8; + P^ := ToggleBit(P^, BitOfs); +end; +{$ELSE ~PUREPASCAL} +asm + BTC [Value], Bit +end; +{$ENDIF ~PUREPASCAL} +{$ENDIF CPU64} + +procedure BooleansToBits(var Dest: Byte; const B: TBooleanArray); +var + I, H: Integer; +begin + Dest := 0; + H := Min(Byte(BitsPerByte - 1), High(B)); + for I := 0 to H do + if B[I] then + Dest := SetBit(Dest, TBitRange(I)); +end; + +procedure BooleansToBits(var Dest: Word; const B: TBooleanArray); +var + I, H: Integer; +begin + Dest := 0; + H := Min(Word(BitsPerWord - 1), High(B)); + for I := 0 to H do + if B[I] then + Dest := SetBit(Dest, TBitRange(I)); +end; + +procedure BooleansToBits(var Dest: Integer; const B: TBooleanArray); +var + I, H: Integer; +begin + Dest := 0; + H := Min(Integer(BitsPerInteger - 1), High(B)); + for I := 0 to H do + if B[I] then + Dest := SetBit(Dest, TBitRange(I)); +end; + +procedure BooleansToBits(var Dest: Int64; const B: TBooleanArray); +var + I, H: Integer; +begin + Dest := 0; + H := Min(Int64(BitsPerInt64 - 1), High(B)); + for I := 0 to H do + if B[I] then + Dest := SetBit(Dest, TBitRange(I)); +end; + +procedure BitsToBooleans(const Bits: Byte; var B: TBooleanArray; AllBits: Boolean); +var + I: Integer; +begin + if AllBits then + SetLength(B, BitsPerByte) + else + SetLength(B, BitsNeeded(Bits)); + for I := 0 to High(B) do + B[I] := TestBit(Bits, TBitRange(I)); +end; + +procedure BitsToBooleans(const Bits: Word; var B: TBooleanArray; AllBits: Boolean); +var + I: Integer; +begin + if AllBits then + SetLength(B, BitsPerWord) + else + SetLength(B, BitsNeeded(Bits)); + for I := 0 to High(B) do + B[I] := TestBit(Bits, TBitRange(I)); +end; + +procedure BitsToBooleans(const Bits: Integer; var B: TBooleanArray; AllBits: Boolean); +var + I: Integer; +begin + if AllBits then + SetLength(B, BitsPerInteger) + else + SetLength(B, BitsNeeded(Bits)); + for I := 0 to High(B) do + B[I] := TestBit(Bits, TBitRange(I)); +end; + +procedure BitsToBooleans(const Bits: Int64; var B: TBooleanArray; AllBits: Boolean); +var + I: Integer; +begin + if AllBits then + SetLength(B, BitsPerInt64) + else + SetLength(B, BitsNeeded(Bits)); + for I := 0 to High(B) do + B[I] := TestBit(Bits, TBitRange(I)); +end; + +function Digits(const X: Cardinal): Integer; +var + Val: Cardinal; +begin + Result := 0; + Val := X; + repeat + Inc(Result); + Val := Val div 10; + until Val = 0; +end; + +function BitsNeeded(const X: Byte): Integer; +begin + Result := BitsHighest(X) + 1; + if Result = 0 then + Result := 1; +end; + +function BitsNeeded(const X: Word): Integer; +begin + Result := BitsHighest(X) + 1; + if Result = 0 then + Result := 1; +end; + +function BitsNeeded(const X: Integer): Integer; +begin + Result := BitsHighest(X) + 1; + if Result = 0 then + Result := 1; +end; + +function BitsNeeded(const X: Int64): Integer; +begin + Result := BitsHighest(X) + 1; + if Result = 0 then + Result := 1; +end; + +function ReverseBytes(Value: Word): Word; +{$IFDEF PUREPASCAL} +begin + Result := (Value shr 8) or (Value shl 8); +end; +{$ELSE ~PUREPASCAL} +asm + {$IFDEF CPU32} + // --> AX Value + // <-- AX Value + XCHG AL, AH + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> CX Value + // <-- AX Value + MOV AH, CL + MOV AL, CH + {$ENDIF CPU64} +end; +{$ENDIF ~PUREPASCAL} + +function ReverseBytes(Value: Smallint): Smallint; +{$IFDEF PUREPASCAL} +asm + XCHG AL, AH +end; +{$ELSE ~PUREPASCAL} +asm + {$IFDEF CPU32} + // --> AX Value + // <-- AX Value + XCHG AL, AH + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> CX Value + // <-- AX Value + MOV AH, CL + MOV AL, CH + {$ENDIF CPU64} +end; +{$ENDIF ~PUREPASCAL} + +function ReverseBytes(Value: Integer): Integer; +{$IFDEF PUREPASCAL} +begin + Result := (Value shr 24) or (Value shl 24) or ((Value and $00FF0000) shr 8) or ((Value and $0000FF00) shl 8); +end; +{$ELSE ~PUREPASCAL} +asm + {$IFDEF CPU32} + // --> EAX Value + // <-- EAX Value + BSWAP EAX + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> ECX Value + // <-- EAX Value + MOV EAX, ECX + BSWAP EAX + {$ENDIF CPU64} +end; +{$ENDIF ~PUREPASCAL} + +function ReverseBytes(Value: Cardinal): Cardinal; +{$IFDEF PUREPASCAL} +begin + Result := (Value shr 24) or (Value shl 24) or ((Value and $00FF0000) shr 8) or ((Value and $0000FF00) shl 8); +end; +{$ELSE ~PUREPASCAL} +asm + {$IFDEF CPU32} + // --> EAX Value + // <-- EAX Value + BSWAP EAX + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> ECX Value + // <-- EAX Value + MOV EAX, ECX + BSWAP EAX + {$ENDIF CPU64} +end; +{$ENDIF ~PUREPASCAL} + +function ReverseBytes(Value: Int64): Int64; +{$IFDEF CPU32} +var + Lo, Hi: Cardinal; +begin + // low and hi DWORD swap + Lo := TJclULargeInteger(Value).HighPart; + Hi := TJclULargeInteger(Value).LowPart; + TJclULargeInteger(Result).HighPart := (Hi shr 24) or (Hi shl 24) or ((Hi and $00FF0000) shr 8) or ((Hi and $0000FF00) shl 8); + TJclULargeInteger(Result).LowPart := (Lo shr 24) or (Lo shl 24) or ((Lo and $00FF0000) shr 8) or ((Lo and $0000FF00) shl 8); +end; +{$ENDIF CPU32} +{$IFDEF CPU64} +asm + // --> RCX Value + // <-- RAX Result + MOV RAX, RCX + BSWAP RAX +end; +{$ENDIF CPU64} + +function ReverseBytes(P: Pointer; Count: Integer): Pointer; +var + P1, P2: PByte; + T: Byte; +begin + if (P <> nil) and (Count > 0) then + begin + P1 := P; + P2 := P; + Inc(P2, Count - 1); + while TJclAddr(P1) < TJclAddr(P2) do + begin + T := P1^; + P1^ := P2^; + P2^ := T; + Inc(P1); + Dec(P2); + end; + end; + Result := P; +end; + +// Arithmetic +procedure SwapOrd(var I, J: Byte); +var + T: Byte; +begin + T := I; + I := J; + J := T; +end; + +procedure SwapOrd(var I, J: Cardinal); +var + T: Cardinal; +begin + T := I; + I := J; + J := T; +end; + +procedure SwapOrd(var I, J: Integer); +var + T: Integer; +begin + T := I; + I := J; + J := T; +end; + +procedure SwapOrd(var I, J: Int64); +var + T: Int64; +begin + T := I; + I := J; + J := T; +end; + +procedure SwapOrd(var I, J: Shortint); +var + T: Shortint; +begin + T := I; + I := J; + J := T; +end; + +procedure SwapOrd(var I, J: Smallint); +var + T: Smallint; +begin + T := I; + I := J; + J := T; +end; + +procedure SwapOrd(var I, J: Word); +var + T: Word; +begin + T := I; + I := J; + J := T; +end; + +function IncLimit(var B: Byte; const Limit, Incr: Byte): Byte; +begin + if (B + Incr) <= Limit then + Inc(B, Incr); + Result := B; +end; + +function IncLimit(var B: Shortint; const Limit, Incr: Shortint): Shortint; +begin + if (B + Incr) <= Limit then + Inc(B, Incr); + Result := B; +end; + +function IncLimit(var B: Smallint; const Limit, Incr: Smallint): Smallint; +begin + if (B + Incr) <= Limit then + Inc(B, Incr); + Result := B; +end; + +function IncLimit(var B: Word; const Limit, Incr: Word): Word; +begin + if (B + Incr) <= Limit then + Inc(B, Incr); + Result := B; +end; + +function IncLimit(var B: Integer; const Limit, Incr: Integer): Integer; +begin + if (B + Incr) <= Limit then + Inc(B, Incr); + Result := B; +end; + +function IncLimit(var B: Cardinal; const Limit, Incr: Cardinal): Cardinal; +begin + if (B + Incr) <= Limit then + Inc(B, Incr); + Result := B; +end; + +function IncLimit(var B: Int64; const Limit, Incr: Int64): Int64; +begin + if (B + Incr) <= Limit then + Inc(B, Incr); + Result := B; +end; + +function DecLimit(var B: Byte; const Limit, Decr: Byte): Byte; +begin + if (B - Decr) >= Limit then + Dec(B, Decr); + Result := B; +end; + +function DecLimit(var B: Shortint; const Limit, Decr: Shortint): shortint; +begin + if (B - Decr) >= Limit then + Dec(B, Decr); + Result := B; +end; + +function DecLimit(var B: Smallint; const Limit, Decr: Smallint): Smallint; +begin + if (B - Decr) >= Limit then + Dec(B, Decr); + Result := B; +end; + +function DecLimit(var B: Word; const Limit, Decr: Word): Word; +begin + if (B - Decr) >= Limit then + Dec(B, Decr); + Result := B; +end; + +function DecLimit(var B: Integer; const Limit, Decr: Integer): Integer; +begin + if (B - Decr) >= Limit then + Dec(B, Decr); + Result := B; +end; + +function DecLimit(var B: Cardinal; const Limit, Decr: Cardinal): Cardinal; +begin + if (B - Decr) >= Limit then + Dec(B, Decr); + Result := B; +end; + +function DecLimit(var B: Int64; const Limit, Decr: Int64): Int64; +begin + if (B - Decr) >= Limit then + Dec(B, Decr); + Result := B; +end; + +function IncLimitClamp(var B: Byte; const Limit, Incr: Byte): Byte; +begin + if (B + Incr) <= Limit then + Inc(B, Incr) + else + B := Limit; + Result := B; +end; + +function IncLimitClamp(var B: Shortint; const Limit, Incr: Shortint): Shortint; +begin + if (B + Incr) <= Limit then + Inc(B, Incr) + else + B := Limit; + Result := B; +end; + +function IncLimitClamp(var B: Smallint; const Limit, Incr: Smallint): Smallint; +begin + if (B + Incr) <= Limit then + Inc(B, Incr) + else + B := Limit; + Result := B; +end; + +function IncLimitClamp(var B: Word; const Limit, Incr: Word): Word; +begin + if (B + Incr) <= Limit then + Inc(B, Incr) + else + B := Limit; + Result := B; +end; + +function IncLimitClamp(var B: Integer; const Limit, Incr: Integer): Integer; +begin + if (B + Incr) <= Limit then + Inc(B, Incr) + else + B := Limit; + Result := B; +end; + +function IncLimitClamp(var B: Cardinal; const Limit, Incr: Cardinal): Cardinal; +begin + if (B + Incr) <= Limit then + Inc(B, Incr) + else + B := Limit; + Result := B; +end; + +function IncLimitClamp(var B: Int64; const Limit, Incr: Int64): Int64; +begin + if (B + Incr) <= Limit then + Inc(B, Incr) + else + B := Limit; + Result := B; +end; + +function DecLimitClamp(var B: Byte; const Limit, Decr: Byte): Byte; +begin + if (B - Decr) >= Limit then + Dec(B, Decr) + else + B := Limit; + Result := B; +end; + +function DecLimitClamp(var B: Shortint; const Limit, Decr: Shortint): Shortint; +begin + if (B - Decr) >= Limit then + Dec(B, Decr) + else + B := Limit; + Result := B; +end; + +function DecLimitClamp(var B: Smallint; const Limit, Decr: Smallint): Smallint; +begin + if (B - Decr) >= Limit then + Dec(B, Decr) + else + B := Limit; + Result := B; +end; + +function DecLimitClamp(var B: Word; const Limit, Decr: Word): Word; +begin + if (B - Decr) >= Limit then + Dec(B, Decr) + else + B := Limit; + Result := B; +end; + +function DecLimitClamp(var B: Integer; const Limit, Decr: Integer): Integer; +begin + if (B - Decr) >= Limit then + Dec(B, Decr) + else + B := Limit; + Result := B; +end; + +function DecLimitClamp(var B: Cardinal; const Limit, Decr: Cardinal): Cardinal; +begin + if (B - Decr) >= Limit then + Dec(B, Decr) + else + B := Limit; + Result := B; +end; + +function DecLimitClamp(var B: Int64; const Limit, Decr: Int64): Int64; +begin + if (B - Decr) >= Limit then + Dec(B, Decr) + else + B := Limit; + Result := B; +end; + +function Max(const B1, B2: Byte): Byte; +begin + if B1 > B2 then + Result := B1 + else + Result := B2; +end; + +function Min(const B1, B2: Byte): Byte; +begin + if B1 < B2 then + Result := B1 + else + Result := B2; +end; + +function Max(const B1, B2: Shortint): Shortint; +begin + if B1 > B2 then + Result := B1 + else + Result := B2; +end; + +function Max(const B1, B2: Smallint): Smallint; +begin + if B1 > B2 then + Result := B1 + else + Result := B2; +end; + +function Min(const B1, B2: Shortint): Shortint; +begin + if B1 < B2 then + Result := B1 + else + Result := B2; +end; + +function Min(const B1, B2: Smallint): Smallint; +begin + if B1 < B2 then + Result := B1 + else + Result := B2; +end; + +function Max(const B1, B2: Word): Word; +begin + if B1 > B2 then + Result := B1 + else + Result := B2; +end; + +function Max(const B1, B2: Int64): Int64; +begin + if B1 > B2 then + Result := B1 + else + Result := B2; +end; + +function Min(const B1, B2: Word): Word; +begin + if B1 < B2 then + Result := B1 + else + Result := B2; +end; + +function Max(const B1, B2: Integer): Integer; +begin + if B1 > B2 then + Result := B1 + else + Result := B2; +end; + +function Min(const B1, B2: Integer): Integer; +begin + if B1 < B2 then + Result := B1 + else + Result := B2; +end; + +function Max(const B1, B2: Cardinal): Cardinal; +begin + if B1 > B2 then + Result := B1 + else + Result := B2; +end; + +function Min(const B1, B2: Cardinal): Cardinal; +begin + if B1 < B2 then + Result := B1 + else + Result := B2; +end; + +function Min(const B1, B2: Int64): Int64; +begin + if B1 < B2 then + Result := B1 + else + Result := B2; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclMIDI.pas b/3rdParty/JCL/source/common/JclMIDI.pas new file mode 100644 index 00000000..4c38010a --- /dev/null +++ b/3rdParty/JCL/source/common/JclMIDI.pas @@ -0,0 +1,830 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclMIDI.pas. } +{ } +{ The Initial Developer of the Original Code is Robert Rossmair. } +{ Portions created by Robert Rossmair are Copyright (C) Robert Rossmair. All rights reserved. } +{ } +{ Contributor(s): } +{ Robert Rossmair } +{ } +{**************************************************************************************************} +{ } +{ Platform-independent MIDI declarations } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclMIDI; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Classes, + {$ENDIF ~HAS_UNITSCOPE} + JclBase; + +// manifest constants for MIDI message protocol +const + // MIDI Status Bytes for Channel Voice Messages + MIDIMsgNoteOff = $80; + MIDIMsgNoteOn = $90; + MIDIMsgPolyKeyPressure = $A0; + MIDIMsgControlChange = $B0; + MIDIMsgProgramChange = $C0; + MIDIMsgChannelKeyPressure = $D0; + MIDIMsgAftertouch = MIDIMsgChannelKeyPressure; // Synonym + MIDIMsgPitchWheelChange = $E0; + // MIDI Status Bytes for System Common Messages + MIDIMsgSysEx = $F0; + MIDIMsgMTCQtrFrame = $F1; // MIDI Time Code Qtr. Frame + MIDIMsgSongPositionPtr = $F2; + MIDIMsgSongSelect = $F3; + MIDIMsgTuneRequest = $F6; + MIDIMsgEOX = $F7; // marks end of system exclusive message + + // MIDI Status Bytes for System Real-Time Messages + MIDIMsgTimingClock = $F8; + MIDIMsgStartSequence = $FA; + MIDIMsgContinueSequence = $FB; + MIDIMsgStopSequence = $FC; + MIDIMsgActiveSensing = $FE; + MIDIMsgSystemReset = $FF; + + // MIDICC...: MIDI Control Change Messages + + // Continuous Controllers MSB + MIDICCBankSelect = $00; + MIDICCModulationWheel = $01; + MIDICCBreathControl = $02; + MIDICCFootController = $04; + MIDICCPortamentoTime = $05; + MIDICCDataEntry = $06; + MIDICCChannelVolume = $07; + MIDICCMainVolume = MIDICCChannelVolume; + MIDICCBalance = $08; + MIDICCPan = $0A; + MIDICCExpression = $0B; + MIDICCEffectControl = $0C; + MIDICCEffectControl2 = $0D; + MIDICCGeneralPurpose1 = $10; + MIDICCGeneralPurpose2 = $11; + MIDICCGeneralPurpose3 = $12; + MIDICCGeneralPurpose4 = $13; + // Continuous Controllers LSB + MIDICCBankSelectLSB = $20; + MIDICCModulationWheelLSB = $21; + MIDICCBreathControlLSB = $22; + MIDICCFootControllerLSB = $24; + MIDICCPortamentoTimeLSB = $25; + MIDICCDataEntryLSB = $26; + MIDICCChannelVolumeLSB = $27; + MIDICCMainVolumeLSB = MIDICCChannelVolumeLSB; + MIDICCBalanceLSB = $28; + MIDICCPanLSB = $2A; + MIDICCExpressionLSB = $2B; + MIDICCEffectControlLSB = $2C; + MIDICCEffectControl2LSB = $2D; + MIDICCGeneralPurpose1LSB = $30; + MIDICCGeneralPurpose2LSB = $31; + MIDICCGeneralPurpose3LSB = $32; + MIDICCGeneralPurpose4LSB = $33; + // Switches + MIDICCSustain = $40; + MIDICCPortamento = $41; + MIDICCSustenuto = $42; + MIDICCSoftPedal = $43; + MIDICCLegato = $44; + MIDICCHold2 = $45; + + MIDICCSound1 = $46; // (Sound Variation) + MIDICCSound2 = $47; // (Timbre/Harmonic Intens.) + MIDICCSound3 = $48; // (Release Time) + MIDICCSound4 = $49; // (Attack Time) + MIDICCSound5 = $4A; // (Brightness) + MIDICCSound6 = $4B; // (Decay Time) + MIDICCSound7 = $4C; // (Vibrato Rate) + MIDICCSound8 = $4D; // (Vibrato Depth) + MIDICCSound9 = $4E; // (Vibrato Delay) + MIDICCSound10 = $4F; // + + MIDICCGeneralPurpose5 = $50; + MIDICCGeneralPurpose6 = $51; + MIDICCGeneralPurpose7 = $52; + MIDICCGeneralPurpose8 = $53; + MIDICCPortamentoControl = $54; + + MIDICCReverbSendLevel = $5B; + MIDICCEffects2Depth = $5C; + MIDICCTremoloDepth = MIDICCEffects2Depth; + MIDICCChorusSendLevel = $5D; + MIDICCEffects4Depth = $5E; + MIDICCCelesteDepth = MIDICCEffects4Depth; + MIDICCEffects5Depth = $5F; + MIDICCPhaserDepth = MIDICCEffects5Depth; + + MIDICCDataEntryInc = $60; + MIDICCDataEntryDec = $61; + MIDICCNonRegParamNumLSB = $62; + MIDICCNonRegParamNumMSB = $63; + MIDICCRegParamNumLSB = $64; + MIDICCRegParamNumMSB = $65; + +// Registered Parameter Numbers [CC# 65H,64H] +// ----------------------------------------------------------- +// CC#65 (MSB) | CC#64 (LSB) | Function +// Hex|Dec| | Hex|Dec| | +// - - - - - - | - - - - - - |- - - - - - - - - - - - - - - - +// 00 = 0 | 00 = 0 | Pitch Bend Sensitivity +// 00 = 0 | 01 = 1 | Channel Fine Tuning +// 00 = 0 | 02 = 2 | Channel Coarse Tuning +// 00 = 0 | 03 = 3 | Tuning Program Change +// 00 = 0 | 04 = 4 | Tuning Bank Select + + // Channel Mode Messages (Control Change >= $78) + MIDICCAllSoundOff = $78; + MIDICCResetAllControllers = $79; + MIDICCLocalControl = $7A; + MIDICCAllNotesOff = $7B; + + MIDICCOmniModeOff = $7C; + MIDICCOmniModeOn = $7D; + MIDICCMonoModeOn = $7E; + MIDICCPolyModeOn = $7F; + +type + TMIDIChannel = 1..16; + TMIDIDataByte = 0..$7F; // 7 bits + TMIDIDataWord = 0..$3FFF; // 14 bits + TMIDIStatusByte = $80..$FF; + TMIDIVelocity = TMIDIDataByte; + TMIDIKey = TMIDIDataByte; + TMIDINote = TMIDIKey; + +const + // Helper definitions + MIDIDataMask = $7F; + MIDIDataWordMask = $3FFF; + MIDIChannelMsgMask = $F0; + MIDIInvalidStatus = TMIDIStatusByte(0); + BitsPerMIDIDataByte = 7; + BitsPerMIDIDataWord = BitsPerMIDIDataByte * 2; + MIDIPitchWheelCenter = 1 shl (BitsPerMIDIDataWord - 1); + +type + TMIDINotes = set of TMIDINote; + + TSingleNoteTuningData = packed record + case Integer of + 0: + (Key: TMIDINote; Frequency: array [0..2] of TMIDIDataByte); + 1: + (DWord: LongWord); + end; + + EJclMIDIError = class(EJclError); + +// MIDI Out + IJclMIDIOut = interface + ['{A29C3EBD-EB70-4C72-BEC5-700AF57FD4C8}'] + // property access methods + function GetActiveNotes(Channel: TMIDIChannel): TMIDINotes; + function GetName: string; + function GetMIDIStatus: TMIDIStatusByte; + function GetRunningStatusEnabled: Boolean; + procedure SetRunningStatusEnabled(const Value: Boolean); + // General message send method + procedure SendMessage(const Data: array of Byte); + // Channel Voice Messages + procedure SendNoteOff(Channel: TMIDIChannel; Key: TMIDINote; Velocity: TMIDIDataByte = $40); + procedure SendNoteOn(Channel: TMIDIChannel; Key: TMIDINote; Velocity: TMIDIDataByte); + procedure SendPolyphonicKeyPressure(Channel: TMIDIChannel; Key: TMIDINote; Value: TMIDIDataByte); + procedure SendControlChange(Channel: TMIDIChannel; ControllerNum, Value: TMIDIDataByte); + // High Resolution "macro" for controller numbers <= $13, sends upper 7 bits first, + // lower 7 bits per additional LSB message afterwards + procedure SendControlChangeHR(Channel: TMIDIChannel; ControllerNum: TMIDIDataByte; Value: TMIDIDataWord); + procedure SendSwitchChange(Channel: TMIDIChannel; ControllerNum: TMIDIDataByte; Value: Boolean); + procedure SendProgramChange(Channel: TMIDIChannel; ProgramNum: TMIDIDataByte); + procedure SendChannelPressure(Channel: TMIDIChannel; Value: TMIDIDataByte); + procedure SendPitchWheelChange(Channel: TMIDIChannel; Value: TMIDIDataWord); + procedure SendPitchWheelPos(Channel: TMIDIChannel; Value: Single); + // Control Change Messages + procedure SelectProgram(Channel: TMIDIChannel; BankNum: TMIDIDataWord; ProgramNum: TMIDIDataByte); + procedure SendModulationWheelChange(Channel: TMIDIChannel; Value: TMidiDataByte); + procedure SendBreathControlChange(Channel: TMIDIChannel; Value: TMidiDataByte); + procedure SendFootControllerChange(Channel: TMIDIChannel; Value: TMidiDataByte); + procedure SendPortamentoTimeChange(Channel: TMIDIChannel; Value: TMidiDataByte); + procedure SendDataEntry(Channel: TMIDIChannel; Value: TMidiDataByte); + procedure SendChannelVolumeChange(Channel: TMIDIChannel; Value: TMidiDataByte); + procedure SendBalanceChange(Channel: TMIDIChannel; Value: TMidiDataByte); + procedure SendPanChange(Channel: TMIDIChannel; Value: TMidiDataByte); + procedure SendExpressionChange(Channel: TMIDIChannel; Value: TMidiDataByte); + // "high resolution" variants + procedure SendModulationWheelChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord); + procedure SendBreathControlChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord); + procedure SendFootControllerChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord); + procedure SendPortamentoTimeChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord); + procedure SendDataEntryHR(Channel: TMIDIChannel; Value: TMidiDataWord); + procedure SendChannelVolumeChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord); + procedure SendBalanceChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord); + procedure SendPanChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord); + procedure SendExpressionChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord); + // Control Change Messages: Switches + procedure SwitchSustain(Channel: TMIDIChannel; Value: Boolean); + procedure SwitchPortamento(Channel: TMIDIChannel; Value: Boolean); + procedure SwitchSostenuto(Channel: TMIDIChannel; Value: Boolean); + procedure SwitchSoftPedal(Channel: TMIDIChannel; Value: Boolean); + procedure SwitchLegato(Channel: TMIDIChannel; Value: Boolean); + procedure SwitchHold2(Channel: TMIDIChannel; Value: Boolean); + // Channel Mode Messages + procedure SwitchAllSoundOff(Channel: TMIDIChannel); + procedure ResetAllControllers(Channel: TMIDIChannel); + procedure SwitchLocalControl(Channel: TMIDIChannel; Value: Boolean); + procedure SwitchAllNotesOff(Channel: TMIDIChannel); + procedure SwitchOmniModeOff(Channel: TMIDIChannel); + procedure SwitchOmniModeOn(Channel: TMIDIChannel); + procedure SwitchMonoModeOn(Channel: TMIDIChannel; ChannelCount: Integer); + procedure SwitchPolyModeOn(Channel: TMIDIChannel); + // + procedure SendSingleNoteTuningChange(const TargetDeviceID, TuningProgramNum: TMidiDataByte; + const TuningData: array of TSingleNoteTuningData); + function NoteIsOn(Channel: TMIDIChannel; Key: TMIDINote): Boolean; + procedure SwitchActiveNotesOff(Channel: TMIDIChannel); overload; + procedure SwitchActiveNotesOff; overload; + // Properties + property ActiveNotes[Channel: TMIDIChannel]: TMIDINotes read GetActiveNotes; + property Name: string read GetName; + property LocalControl[Channel: TMIDIChannel]: Boolean write SwitchLocalControl; + property MIDIStatus: TMIDIStatusByte read GetMIDIStatus; + // Tribute to some braindead devices which cannot handle running status (e.g. ESS Solo 1 Win2k driver) + property RunningStatusEnabled: Boolean read GetRunningStatusEnabled write SetRunningStatusEnabled; + end; + + // Abstract MIDI Out device class + TJclMIDIOut = class(TInterfacedObject, IJclMIDIOut) + private + FMIDIStatus: TMIDIStatusByte; + FRunningStatusEnabled: Boolean; + FActiveNotes: array [TMIDIChannel] of TMIDINotes; + protected + function IsRunningStatus(StatusByte: TMIDIStatusByte): Boolean; + procedure SendChannelMessage(Msg: TMIDIStatusByte; Channel: TMIDIChannel; + Data1, Data2: TMIDIDataByte); + procedure DoSendMessage(const Data: array of Byte); virtual; abstract; + public + destructor Destroy; override; + { IJclMIDIOut } + // property access methods + function GetActiveNotes(Channel: TMIDIChannel): TMIDINotes; + function GetName: string; virtual; abstract; + function GetMIDIStatus: TMIDIStatusByte; + function GetRunningStatusEnabled: Boolean; + procedure SetRunningStatusEnabled(const Value: Boolean); + // General message send method + procedure SendMessage(const Data: array of Byte); // Channel Voice Messages + procedure SendNoteOff(Channel: TMIDIChannel; Key: TMIDINote; Velocity: TMIDIDataByte = $40); + procedure SendNoteOn(Channel: TMIDIChannel; Key: TMIDINote; Velocity: TMIDIDataByte); + procedure SendPolyphonicKeyPressure(Channel: TMIDIChannel; Key: TMIDINote; Value: TMIDIDataByte); + procedure SendControlChange(Channel: TMIDIChannel; ControllerNum, Value: TMIDIDataByte); + procedure SendControlChangeHR(Channel: TMIDIChannel; ControllerNum: TMIDIDataByte; Value: TMIDIDataWord); + procedure SendSwitchChange(Channel: TMIDIChannel; ControllerNum: TMIDIDataByte; Value: Boolean); + procedure SendProgramChange(Channel: TMIDIChannel; ProgramNum: TMIDIDataByte); + procedure SendChannelPressure(Channel: TMIDIChannel; Value: TMIDIDataByte); + procedure SendPitchWheelChange(Channel: TMIDIChannel; Value: TMIDIDataWord); + procedure SendPitchWheelPos(Channel: TMIDIChannel; Value: Single); + // Control Change Messages + procedure SelectProgram(Channel: TMIDIChannel; BankNum: TMIDIDataWord; ProgramNum: TMIDIDataByte); + procedure SendModulationWheelChange(Channel: TMIDIChannel; Value: TMidiDataByte); + procedure SendBreathControlChange(Channel: TMIDIChannel; Value: TMidiDataByte); + procedure SendFootControllerChange(Channel: TMIDIChannel; Value: TMidiDataByte); + procedure SendPortamentoTimeChange(Channel: TMIDIChannel; Value: TMidiDataByte); + procedure SendDataEntry(Channel: TMIDIChannel; Value: TMidiDataByte); + procedure SendChannelVolumeChange(Channel: TMIDIChannel; Value: TMidiDataByte); + procedure SendBalanceChange(Channel: TMIDIChannel; Value: TMidiDataByte); + procedure SendPanChange(Channel: TMIDIChannel; Value: TMidiDataByte); + procedure SendExpressionChange(Channel: TMIDIChannel; Value: TMidiDataByte); + // ...high Resolution + procedure SendModulationWheelChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord); + procedure SendBreathControlChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord); + procedure SendFootControllerChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord); + procedure SendPortamentoTimeChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord); + procedure SendDataEntryHR(Channel: TMIDIChannel; Value: TMidiDataWord); + procedure SendChannelVolumeChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord); + procedure SendBalanceChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord); + procedure SendPanChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord); + procedure SendExpressionChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord); + // Control Change Messages: Switches + procedure SwitchSustain(Channel: TMIDIChannel; Value: Boolean); + procedure SwitchPortamento(Channel: TMIDIChannel; Value: Boolean); + procedure SwitchSostenuto(Channel: TMIDIChannel; Value: Boolean); + procedure SwitchSoftPedal(Channel: TMIDIChannel; Value: Boolean); + procedure SwitchLegato(Channel: TMIDIChannel; Value: Boolean); + procedure SwitchHold2(Channel: TMIDIChannel; Value: Boolean); + // Channel Mode Messages + procedure SwitchAllSoundOff(Channel: TMIDIChannel); + procedure ResetAllControllers(Channel: TMIDIChannel); + procedure SwitchLocalControl(Channel: TMIDIChannel; Value: Boolean); + procedure SwitchAllNotesOff(Channel: TMIDIChannel); + procedure SwitchOmniModeOff(Channel: TMIDIChannel); + procedure SwitchOmniModeOn(Channel: TMIDIChannel); + procedure SwitchMonoModeOn(Channel: TMIDIChannel; ChannelCount: Integer); + procedure SwitchPolyModeOn(Channel: TMIDIChannel); + // + procedure SendSingleNoteTuningChange(const TargetDeviceID, TuningProgramNum: TMidiDataByte; + const TuningData: array of TSingleNoteTuningData); + function NoteIsOn(Channel: TMIDIChannel; Key: TMIDINote): Boolean; + procedure SwitchActiveNotesOff(Channel: TMIDIChannel); overload; + procedure SwitchActiveNotesOff; overload; + property ActiveNotes[Channel: TMIDIChannel]: TMIDINotes read GetActiveNotes; + property Name: string read GetName; + property RunningStatusEnabled: Boolean read GetRunningStatusEnabled write SetRunningStatusEnabled; + end; + +function MIDIOut(DeviceID: Cardinal = 0): IJclMIDIOut; +procedure GetMidiOutputs(const List: TStrings); +function MIDISingleNoteTuningData(Key: TMIDINote; Frequency: Single): TSingleNoteTuningData; +function MIDINoteToStr(Note: TMIDINote): string; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + JclWinMIDI, + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + //JclUnixMIDI, + {$ENDIF UNIX} + JclResources; + +{$IFDEF UNIX} +procedure ErrorNotImplemented; +begin + raise EJclInternalError.CreateRes(@RsMidiNotImplemented); +end; +{$ENDIF UNIX} + +function MIDIOut(DeviceID: Cardinal = 0): IJclMIDIOut; +begin + Result := nil; + {$IFDEF MSWINDOWS} + Result := JclWinMIDI.MIDIOut(DeviceID); + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + { TODO -oRobert Rossmair : Unix MIDI Out } + //Result := JclUnixMIDI.MidiOut(DeviceID); + ErrorNotImplemented; + {$ENDIF UNIX} +end; + +procedure GetMidiOutputs(const List: TStrings); +begin + {$IFDEF MSWINDOWS} + JclWinMIDI.GetMidiOutputs(List); + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + { TODO -oRobert Rossmair : Unix GetMIDIOutputs } + //JclUnixMIDI.GetMidiOutputs(List); + ErrorNotImplemented; + {$ENDIF UNIX} +end; + +function MIDISingleNoteTuningData(Key: TMIDINote; Frequency: Single): TSingleNoteTuningData; +var + F: Cardinal; +begin + Result.Key := Key; + F := Trunc(Frequency * (1 shl BitsPerMIDIDataWord)); + Result.Frequency[0] := (F shr BitsPerMIDIDataWord) and MIDIDataMask; + Result.Frequency[1] := (F shr BitsPerMIDIDataByte) and MIDIDataMask; + Result.Frequency[2] := F and MIDIDataMask; +end; + +procedure CheckMIDIChannelNum(Channel: TMIDIChannel); +begin + if (Integer(Channel) < Low(TMIDIChannel)) or (Integer(Channel) > High(TMIDIChannel)) then + raise EJclMIDIError.CreateResFmt(@RsMidiInvalidChannelNum, [Channel]); +end; + +function MIDINoteToStr(Note: TMIDINote): string; +const + HalftonesPerOctave = 12; +begin + case Note mod HalftonesPerOctave of + 0: + Result := LoadResString(@RsOctaveC); + 1: + Result := LoadResString(@RsOctaveCSharp); + 2: + Result := LoadResString(@RsOctaveD); + 3: + Result := LoadResString(@RsOctaveDSharp); + 4: + Result := LoadResString(@RsOctaveE); + 5: + Result := LoadResString(@RsOctaveF); + 6: + Result := LoadResString(@RsOctaveFSharp); + 7: + Result := LoadResString(@RsOctaveG); + 8: + Result := LoadResString(@RsOctaveGSharp); + 9: + Result := LoadResString(@RsOctaveA); + 10: + Result := LoadResString(@RsOctaveASharp); + 11: + Result := LoadResString(@RsOctaveB); + end; + Result := Format('%s%d', [Result, Note div HalftonesPerOctave - 2]); +end; + +// TJclMIDIOut +destructor TJclMIDIOut.Destroy; +begin + SwitchActiveNotesOff; + inherited Destroy; +end; + +function TJclMIDIOut.GetActiveNotes(Channel: TMIDIChannel): TMIDINotes; +begin + CheckMIDIChannelNum(Channel); + Result := FActiveNotes[Channel]; +end; + +procedure TJclMIDIOut.SendChannelMessage(Msg: TMIDIStatusByte; + Channel: TMIDIChannel; Data1, Data2: TMIDIDataByte); +begin + SendMessage([Msg or (Channel - Low(Channel)), Data1, Data2]); +end; + +function TJclMIDIOut.GetRunningStatusEnabled: Boolean; +begin + Result := FRunningStatusEnabled; +end; + +function TJclMIDIOut.NoteIsOn(Channel: TMIDIChannel; Key: TMIDINote): Boolean; +begin + Result := Key in FActiveNotes[Channel]; +end; + +procedure TJclMIDIOut.SendNoteOff(Channel: TMIDIChannel; Key: TMIDINote; Velocity: TMIDIDataByte); +begin + SendChannelMessage(MIDIMsgNoteOff, Channel, Key, Velocity); + Exclude(FActiveNotes[Channel], Key); +end; + +procedure TJclMIDIOut.SendNoteOn(Channel: TMIDIChannel; Key: TMIDINote; Velocity: TMIDIDataByte); +begin + SendChannelMessage(MIDIMsgNoteOn, Channel, Key, Velocity); + Include(FActiveNotes[Channel], Key); +end; + +procedure TJclMIDIOut.SendPolyphonicKeyPressure(Channel: TMIDIChannel; + Key: TMIDINote; Value: TMIDIDataByte); +begin + SendChannelMessage(MIDIMsgPolyKeyPressure, Channel, Key, Value); +end; + +procedure TJclMIDIOut.SendControlChange(Channel: TMIDIChannel; ControllerNum, Value: TMIDIDataByte); +begin + SendChannelMessage(MIDIMsgControlChange, Channel, ControllerNum, Value); +end; + +procedure TJclMIDIOut.SendControlChangeHR(Channel: TMIDIChannel; ControllerNum: TMIDIDataByte; + Value: TMIDIDataWord); +begin + SendControlChange(Channel, ControllerNum, Value shr BitsPerMIDIDataByte and MIDIDataMask); + if ControllerNum <= $13 then + SendControlChange(Channel, ControllerNum or $20, Value and MIDIDataMask); +end; + +procedure TJclMIDIOut.SendSwitchChange(Channel: TMIDIChannel; ControllerNum: TMIDIDataByte; Value: Boolean); +const + DataByte: array [Boolean] of Byte = ($00, $7F); +begin + SendChannelMessage(MIDIMsgControlChange, Channel, ControllerNum, DataByte[Value]); +end; + +procedure TJclMIDIOut.SendProgramChange(Channel: TMIDIChannel; ProgramNum: TMIDIDataByte); +begin + SendChannelMessage(MIDIMsgProgramChange, Channel, ProgramNum, 0); +end; + +procedure TJclMIDIOut.SendChannelPressure(Channel: TMIDIChannel; Value: TMIDIDataByte); +begin + SendChannelMessage(MIDIMsgChannelKeyPressure, Channel, Value, 0); +end; + +procedure TJclMIDIOut.SendPitchWheelChange(Channel: TMIDIChannel; Value: TMIDIDataWord); +begin + SendChannelMessage(MIDIMsgPitchWheelChange, Channel, Value and MidiDataMask, Value shr BitsPerMIDIDataByte); +end; + +procedure TJclMIDIOut.SendPitchWheelPos(Channel: TMIDIChannel; Value: Single); +var + Temp: TMIDIDataWord; +begin + if Value < 0 then + Temp := Round(Value * (1 shl 13)) + else + Temp := Round(Value * (1 shl 13 - 1)); + SendPitchWheelChange(Channel, Temp); +end; + +procedure TJclMIDIOut.SwitchAllSoundOff(Channel: TMIDIChannel); +begin + SendControlChange(Channel, MIDICCAllSoundOff, 0); +end; + +procedure TJclMIDIOut.SwitchLocalControl(Channel: TMIDIChannel; Value: Boolean); +begin + SendSwitchChange(Channel, MIDICCLocalControl, Value); +end; + +procedure TJclMIDIOut.ResetAllControllers(Channel: TMIDIChannel); +begin + SendControlChange(Channel, MIDICCResetAllControllers, 0); +end; + +procedure TJclMIDIOut.SwitchAllNotesOff(Channel: TMIDIChannel); +begin + CheckMIDIChannelNum(Channel); + SendControlChange(Channel, MIDICCAllNotesOff, 0); + FActiveNotes[Channel] := []; +end; + +procedure TJclMIDIOut.SetRunningStatusEnabled(const Value: Boolean); +begin + FMIDIStatus := MIDIInvalidStatus; + FRunningStatusEnabled := Value; +end; + +procedure TJclMIDIOut.SendSingleNoteTuningChange(const TargetDeviceID, TuningProgramNum: TMidiDataByte; + const TuningData: array of TSingleNoteTuningData); +var + BufSize, Count: Integer; + Buf: array of Byte; +begin + Count := Length(TuningData); + BufSize := 8 + Count * SizeOf(TSingleNoteTuningData); + SetLength(Buf, BufSize); + Buf[0] := MIDIMsgSysEx; // Universal Real Time SysEx header, first byte + Buf[1] := $7F; // second byte + Buf[2] := TargetDeviceID; // ID of target device (?) + Buf[3] := 8; // sub-ID#1 (MIDI Tuning) + Buf[4] := 2; // sub-ID#2 (note change) + Buf[5] := TuningProgramNum; // tuning program number (0 – 127) + Buf[6] := Count; + Move(TuningData, Buf[7], Count * SizeOf(TSingleNoteTuningData)); + Buf[BufSize - 1] := MIDIMsgEOX; + SendMessage(Buf); +end; + +procedure TJclMIDIOut.SwitchActiveNotesOff(Channel: TMIDIChannel); +var + Note: TMIDINote; +begin + CheckMIDIChannelNum(Channel); + if FActiveNotes[Channel] <> [] then + for Note := Low(Note) to High(Note) do + if Note in FActiveNotes[Channel] then + SendNoteOff(Channel, Note, $7F); +end; + +procedure TJclMIDIOut.SwitchActiveNotesOff; +var + Channel: TMIDIChannel; +begin + for Channel := Low(Channel) to High(Channel) do + SwitchActiveNotesOff(Channel); +end; + +procedure TJclMIDIOut.SelectProgram(Channel: TMIDIChannel; + BankNum: TMIDIDataWord; ProgramNum: TMIDIDataByte); +begin + SendControlChangeHR(Channel, MIDICCBankSelect, BankNum); + SendProgramChange(Channel, ProgramNum); +end; + +procedure TJclMIDIOut.SendMessage(const Data: array of Byte); +begin + if IsRunningStatus(Data[0]) then + {$IFDEF FPC} + DoSendMessage(PJclByteArray(@Data[1])^) + {$ELSE ~FPC} + DoSendMessage(Slice(Data, 1)) + {$ENDIF ~FPC} + else + DoSendMessage(Data); +end; + +function TJclMIDIOut.GetMIDIStatus: TMIDIStatusByte; +begin + Result := FMIDIStatus; +end; + +function TJclMIDIOut.IsRunningStatus(StatusByte: TMIDIStatusByte): Boolean; +begin + Result := (StatusByte = FMIDIStatus) and + ((StatusByte and $F0) <> $F0) and // is channel message + RunningStatusEnabled; +end; + +procedure TJclMIDIOut.SendBalanceChange(Channel: TMIDIChannel; Value: TMidiDataByte); +begin + SendControlChange(Channel, MIDICCBalance, Value); +end; + +procedure TJclMIDIOut.SendBalanceChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord); +begin + SendControlChangeHR(Channel, MIDICCBalance, Value); +end; + +procedure TJclMIDIOut.SendBreathControlChange(Channel: TMIDIChannel; Value: TMidiDataByte); +begin + SendControlChange(Channel, MIDICCBreathControl, Value); +end; + +procedure TJclMIDIOut.SendBreathControlChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord); +begin + SendControlChangeHR(Channel, MIDICCBreathControl, Value); +end; + +procedure TJclMIDIOut.SendDataEntry(Channel: TMIDIChannel; Value: TMidiDataByte); +begin + SendControlChange(Channel, MIDICCDataEntry, Value); +end; + +procedure TJclMIDIOut.SendDataEntryHR(Channel: TMIDIChannel; Value: TMidiDataWord); +begin + SendControlChangeHR(Channel, MIDICCDataEntry, Value); +end; + +procedure TJclMIDIOut.SendExpressionChange(Channel: TMIDIChannel; Value: TMidiDataByte); +begin + SendControlChange(Channel, MIDICCExpression, Value); +end; + +procedure TJclMIDIOut.SendExpressionChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord); +begin + SendControlChangeHR(Channel, MIDICCExpression, Value); +end; + +procedure TJclMIDIOut.SendFootControllerChange(Channel: TMIDIChannel; Value: TMidiDataByte); +begin + SendControlChange(Channel, MIDICCFootController, Value); +end; + +procedure TJclMIDIOut.SendFootControllerChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord); +begin + SendControlChangeHR(Channel, MIDICCFootController, Value); +end; + +procedure TJclMIDIOut.SwitchHold2(Channel: TMIDIChannel; Value: Boolean); +begin + SendSwitchChange(Channel, MIDICCHold2, Value); +end; + +procedure TJclMIDIOut.SwitchLegato(Channel: TMIDIChannel; Value: Boolean); +begin + SendSwitchChange(Channel, MIDICCLegato, Value); +end; + +procedure TJclMIDIOut.SendChannelVolumeChange(Channel: TMIDIChannel; + Value: TMidiDataByte); +begin + SendControlChange(Channel, MIDICCChannelVolume, Value); +end; + +procedure TJclMIDIOut.SendChannelVolumeChangeHR(Channel: TMIDIChannel; + Value: TMidiDataWord); +begin + SendControlChangeHR(Channel, MIDICCChannelVolume, Value); +end; + +procedure TJclMIDIOut.SendModulationWheelChange(Channel: TMIDIChannel; + Value: TMidiDataByte); +begin + SendControlChange(Channel, MIDICCModulationWheel, Value); +end; + +procedure TJclMIDIOut.SendModulationWheelChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord); +begin + SendControlChangeHR(Channel, MIDICCModulationWheel, Value); +end; + +procedure TJclMIDIOut.SendPanChange(Channel: TMIDIChannel; Value: TMidiDataByte); +begin + SendControlChange(Channel, MIDICCPan, Value); +end; + +procedure TJclMIDIOut.SendPanChangeHR(Channel: TMIDIChannel; Value: TMidiDataWord); +begin + SendControlChangeHR(Channel, MIDICCPan, Value); +end; + +procedure TJclMIDIOut.SwitchPortamento(Channel: TMIDIChannel; Value: Boolean); +begin + SendSwitchChange(Channel, MIDICCPortamento, Value); +end; + +procedure TJclMIDIOut.SendPortamentoTimeChange(Channel: TMIDIChannel; + Value: TMidiDataByte); +begin + SendControlChange(Channel, MIDICCPortamentoTime, Value); +end; + +procedure TJclMIDIOut.SendPortamentoTimeChangeHR(Channel: TMIDIChannel; + Value: TMidiDataWord); +begin + SendControlChangeHR(Channel, MIDICCPortamentoTime, Value); +end; + +procedure TJclMIDIOut.SwitchSoftPedal(Channel: TMIDIChannel; Value: Boolean); +begin + SendSwitchChange(Channel, MIDICCSoftPedal, Value); +end; + +procedure TJclMIDIOut.SwitchSustain(Channel: TMIDIChannel; Value: Boolean); +begin + SendSwitchChange(Channel, MIDICCSustain, Value); +end; + +procedure TJclMIDIOut.SwitchSostenuto(Channel: TMIDIChannel; Value: Boolean); +begin + SendSwitchChange(Channel, MIDICCSustenuto, Value); +end; + +procedure TJclMIDIOut.SwitchOmniModeOff(Channel: TMIDIChannel); +begin + SendControlChange(Channel, MIDICCOmniModeOff, 0); + FActiveNotes[Channel] := []; // implicit All Notes Off +end; + +procedure TJclMIDIOut.SwitchOmniModeOn(Channel: TMIDIChannel); +begin + SendControlChange(Channel, MIDICCOmniModeOn, 0); + FActiveNotes[Channel] := []; // implicit All Notes Off +end; + +procedure TJclMIDIOut.SwitchMonoModeOn(Channel: TMIDIChannel; ChannelCount: Integer); +begin + SendControlChange(Channel, MIDICCMonoModeOn, ChannelCount); + FActiveNotes[Channel] := []; // implicit All Notes Off +end; + +procedure TJclMIDIOut.SwitchPolyModeOn(Channel: TMIDIChannel); +begin + SendControlChange(Channel, MIDICCPolyModeOn, 0); + FActiveNotes[Channel] := []; // implicit All Notes Off +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclMath.pas b/3rdParty/JCL/source/common/JclMath.pas index 4e5212c4..8d110291 100644 --- a/3rdParty/JCL/source/common/JclMath.pas +++ b/3rdParty/JCL/source/common/JclMath.pas @@ -1,4876 +1,4876 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is JclMath.pas. } -{ } -{ The Initial Developers of the Original Code are Clayton Collie, David Butler, ESB Consultancy, } -{ Jean Debord, Marcel van Brakel and Michael Schnell. } -{ Portions created by these individuals are Copyright (C) of these individuals. } -{ All Rights Reserved. } -{ } -{ Contributors: } -{ Ernesto Benestante } -{ Marcel van Brakel } -{ Aleksei Koudinov } -{ Robert Marquardt (marquardt) } -{ Robert Rossmair (rrossmair) } -{ Matthias Thoma (mthoma) } -{ Mark Vaughan } -{ Andreas Hausladen } -{ unknown } -{ } -{**************************************************************************************************} -{ } -{ Various mathematics classes and routines. Includes prime numbers, rational numbers, } -{ complex numbers, generic floating point routines, hyperbolic and transcendenatal routines, } -{ NAN and INF support and more. } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -unit JclMath; - -{$I jcl.inc} - -interface - -uses - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - {$IFDEF HAS_UNITSCOPE} - System.SysUtils, System.Classes, - {$ELSE ~HAS_UNITSCOPE} - SysUtils, Classes, - {$ENDIF ~HAS_UNITSCOPE} - JclBase; - -{ Mathematical constants } - -const - Bernstein: Float = 0.2801694990238691330364364912307; // Bernstein constant - Cbrt2: Float = 1.2599210498948731647672106072782; // CubeRoot(2) - Cbrt3: Float = 1.4422495703074083823216383107801; // CubeRoot(3) - Cbrt10: Float = 2.1544346900318837217592935665194; // CubeRoot(10) - Cbrt100: Float = 4.6415888336127788924100763509194; // CubeRoot(100) - CbrtPi: Float = 1.4645918875615232630201425272638; // CubeRoot(PI) - Catalan: Float = 0.9159655941772190150546035149324; // Catalan constant - Pi: Float = 3.1415926535897932384626433832795; // PI - PiOn2: Float = 1.5707963267948966192313216916398; // PI / 2 - PiOn3: Float = 1.0471975511965977461542144610932; // PI / 3 - PiOn4: Float = 0.78539816339744830961566084581988; // PI / 4 - Sqrt2: Float = 1.4142135623730950488016887242097; // Sqrt(2) - Sqrt3: Float = 1.7320508075688772935274463415059; // Sqrt(3) - Sqrt5: Float = 2.2360679774997896964091736687313; // Sqrt(5) - Sqrt10: Float = 3.1622776601683793319988935444327; // Sqrt(10) - SqrtPi: Float = 1.7724538509055160272981674833411; // Sqrt(PI) - Sqrt2Pi: Float = 2.506628274631000502415765284811; // Sqrt(2 * PI) - TwoPi: Float = 6.283185307179586476925286766559; // 2 * PI - ThreePi: Float = 9.4247779607693797153879301498385; // 3 * PI - Ln2: Float = 0.69314718055994530941723212145818; // Ln(2) - Ln10: Float = 2.3025850929940456840179914546844; // Ln(10) - LnPi: Float = 1.1447298858494001741434273513531; // Ln(PI) - Log2: Float = 0.30102999566398119521373889472449; // Log10(2) - Log3: Float = 0.47712125471966243729502790325512; // Log10(3) - LogPi: Float = 0.4971498726941338543512682882909; // Log10(PI) - LogE: Float = 0.43429448190325182765112891891661; // Log10(E) - E: Float = 2.7182818284590452353602874713527; // Natural constant - hLn2Pi: Float = 0.91893853320467274178032973640562; // Ln(2*PI)/2 - inv2Pi: Float = 0.15915494309189533576888376337251436203445964574046; // 0.5 / Pi - TwoToPower63: Float = 9223372036854775808.0; // 2^63 - GoldenMean: Float = 1.618033988749894848204586834365638; // GoldenMean - EulerMascheroni: Float = 0.5772156649015328606065120900824; // Euler GAMMA - -const - MaxAngle: Float = 9223372036854775808.0; // 2^63 Rad - - {$IFDEF MATH_EXTENDED_PRECISION} - MaxTanH: Float = 5678.2617031470719747459655389854; // Ln(2^16384)/2 - MaxFactorial = 1754; - MaxFloatingPoint: Float = 1.189731495357231765085759326628E+4932; // 2^16384 - MinFloatingPoint: Float = 3.3621031431120935062626778173218E-4932; // 2^(-16382) - {$ENDIF MATH_EXTENDED_PRECISION} - {$IFDEF MATH_DOUBLE_PRECISION} - MaxTanH: Float = 354.89135644669199842162284618659; // Ln(2^1024)/2 - MaxFactorial = 170; - MaxFloatingPoint: Float = 1.797693134862315907729305190789E+308; // 2^1024 - MinFloatingPoint: Float = 2.2250738585072013830902327173324E-308; // 2^(-1022) - {$ENDIF MATH_DOUBLE_PRECISION} - {$IFDEF MATH_SINGLE_PRECISION} - MaxTanH: Float = 44.361419555836499802702855773323; // Ln(2^128)/2 - MaxFactorial = 33; - MaxFloatingPoint: Float = 3.4028236692093846346337460743177E+38; // 2^128 - MinFloatingPoint: Float = 1.1754943508222875079687365372222E-38; // 2^(-126) - {$ENDIF MATH_SINGLE_PRECISION} - -const - PiExt = 3.1415926535897932384626433832795; - RatioDegToRad : Extended = PiExt / 180.0; - RatioRadToDeg : Extended = 180.0 / PiExt; - RatioGradToRad : Extended = PiExt / 200.0; - RatioRadToGrad : Extended = 200.0 / PiExt; - RatioDegToGrad : Extended = 200.0 / 180.0; - RatioGradToDeg : Extended = 180.0 / 200.0; - -var - PrecisionTolerance: Float = 0.0000001; - EpsSingle: Single; - EpsDouble: Double; - {$IFDEF SUPPORTS_EXTENDED} - EpsExtended: Extended; - {$ENDIF SUPPORTS_EXTENDED} - Epsilon: Float; - ThreeEpsSingle: Single; - ThreeEpsDouble: Double; - {$IFDEF SUPPORTS_EXTENDED} - ThreeEpsExtended: Extended; - {$ENDIF SUPPORTS_EXTENDED} - ThreeEpsilon: Float; - -type - TPrimalityTestMethod = (ptTrialDivision {$IFDEF CPU32}, ptRabinMiller{$ENDIF CPU32}); - -// swaps 2 bytes -procedure SwapOrd(var X, Y: Integer); {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - -// converts double to hex -function DoubleToHex(const D: Double): string; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -// converts hex to double -function HexToDouble(const Hex: string): Double; - -// Converts degrees to radians. -{$IFDEF SUPPORTS_EXTENDED} -function DegToRad(const Value: Extended): Extended; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -{$ENDIF SUPPORTS_EXTENDED} -function DegToRad(const Value: Double): Double; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function DegToRad(const Value: Single): Single; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -procedure FastDegToRad; - -// Converts radians to degrees. -{$IFDEF SUPPORTS_EXTENDED} -function RadToDeg(const Value: Extended): Extended; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -{$ENDIF SUPPORTS_EXTENDED} -function RadToDeg(const Value: Double): Double; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function RadToDeg(const Value: Single): Single; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -procedure FastRadToDeg; - -// Converts grads to radians. -{$IFDEF SUPPORTS_EXTENDED} -function GradToRad(const Value: Extended): Extended; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -{$ENDIF SUPPORTS_EXTENDED} -function GradToRad(const Value: Double): Double; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function GradToRad(const Value: Single): Single; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -procedure FastGradToRad; - -// Converts radians to grads. -{$IFDEF SUPPORTS_EXTENDED} -function RadToGrad(const Value: Extended): Extended; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -{$ENDIF SUPPORTS_EXTENDED} -function RadToGrad(const Value: Double): Double; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function RadToGrad(const Value: Single): Single; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -procedure FastRadToGrad; - -// Converts degrees to grads. -{$IFDEF SUPPORTS_EXTENDED} -function DegToGrad(const Value: Extended): Extended; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -{$ENDIF SUPPORTS_EXTENDED} -function DegToGrad(const Value: Double): Double; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function DegToGrad(const Value: Single): Single; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -procedure FastDegToGrad; - -// Converts grads to degrees. -{$IFDEF SUPPORTS_EXTENDED} -function GradToDeg(const Value: Extended): Extended; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -{$ENDIF SUPPORTS_EXTENDED} -function GradToDeg(const Value: Double): Double; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function GradToDeg(const Value: Single): Single; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -procedure FastGradToDeg; - -{ Logarithmic } - -function LogBase10(X: Float): Float; -function LogBase2(X: Float): Float; -function LogBaseN(Base, X: Float): Float; - -{ Transcendental } - -function ArcCos(X: Float): Float; -function ArcCot(X: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function ArcCsc(X: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function ArcSec(X: Float): Float; -function ArcSin(X: Float): Float; -function ArcTan(X: Float): Float; -function ArcTan2(Y, X: Float): Float; -function Cos(X: Float): Float; overload; -function Cot(X: Float): Float; overload; -function Coversine(X: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function Csc(X: Float): Float; overload; -function Exsecans(X: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function Haversine(X: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function Sec(X: Float): Float; overload; -function Sin(X: Float): Float; overload; -procedure SinCos(X: Single; out Sin, Cos: Single); overload; -procedure SinCos(X: Double; out Sin, Cos: Double); overload; -{$IFDEF SUPPORTS_EXTENDED} -procedure SinCos(X: Extended; out Sin, Cos: Extended); overload; -{$ENDIF SUPPORTS_EXTENDED} -function Tan(X: Float): Float; overload; -function Versine(X: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - -{ Hyperbolic } - -function ArcCosH(X: Float): Float; -function ArcCotH(X: Float): Float; -function ArcCscH(X: Float): Float; -function ArcSecH(X: Float): Float; -function ArcSinH(X: Float): Float; -function ArcTanH(X: Float): Float; -function CosH(X: Float): Float; overload; -function CotH(X: Float): Float; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function CscH(X: Float): Float; overload; -function SecH(X: Float): Float; overload; -function SinH(X: Float): Float; overload; {IFDEF SUPPORTS_INLINE inline; ENDIF} -function TanH(X: Float): Float; overload; - -{ Coordinate conversion } - -function DegMinSecToFloat(const Degs, Mins, Secs: Float): Float; // obsolete (see JclUnitConv) -procedure FloatToDegMinSec(const X: Float; var Degs, Mins, Secs: Float); // obsolete (see JclUnitConv) - -{ Exponential } - -function Exp(const X: Float): Float; overload; -function Power(const Base, Exponent: Float): Float; overload; -function PowerInt(const X: Float; N: Integer): Float; overload; -function TenToY(const Y: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function TruncPower(const Base, Exponent: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function TwoToY(const Y: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - -{ Floating point numbers support routines } - -function IsFloatZero(const X: Float): Boolean; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function FloatsEqual(const X, Y: Float): Boolean; -function MaxFloat(const X, Y: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function MinFloat(const X, Y: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function ModFloat(const X, Y: Float): Float; -function RemainderFloat(const X, Y: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function SetPrecisionTolerance(NewTolerance: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -procedure SwapFloats(var X, Y: Float); {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -procedure CalcMachineEpsSingle; -procedure CalcMachineEpsDouble; -{$IFDEF SUPPORTS_EXTENDED} -procedure CalcMachineEpsExtended; -{$ENDIF SUPPORTS_EXTENDED} -procedure CalcMachineEps; -procedure SetPrecisionToleranceToEpsilon; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - -{ Miscellaneous } - -function Ackermann(const A, B: Integer): Integer; -function Ceiling(const X: Float): Integer; -function CommercialRound(const X: Float): Int64; -function Factorial(const N: Integer): Float; -function Fibonacci(const N: Integer): Integer; -function Floor(const X: Float): Integer; -function GCD(X, Y: Cardinal): Cardinal; -function ISqrt(const I: Smallint): Smallint; -function LCM(const X, Y: Cardinal): Cardinal; - -/// -/// Get the next multiple of a given multiplicator which is higher than -/// the number given. Example: Num = 21, Multiplicator = 5, Result is 25 -/// -function NearestHigherMultiple(Num, Multiplicator: Integer): Integer; overload; -/// -/// Get the next multiple of a given multiplicator which is higher than -/// the number given. Example: Num = 21, Multiplicator = 5, Result is 25 -/// -function NearestHigherMultiple(Num, Multiplicator: Int64): Int64; overload; -/// -/// Get the next multiple of a given multiplicator which is higher than -/// the number given. Example: Num = 21, Multiplicator = 5, Result is 25 -/// -function NearestHigherMultiple(Num: Float; Multiplicator: Integer): Integer; overload -/// -/// Get the next multiple of a given multiplicator which is higher than -/// the number given. Example: Num = 21, Multiplicator = 5, Result is 25 -/// -function NearestHigherMultiple(Num: Float; Multiplicator: Int64): Int64; overload; -/// -/// Get the next multiple of a given multiplicator which is lower than -/// the number given. Example: Num = 24, Multiplicator = 5, Result is 20 -/// -function NearestLowerMultiple(Num, Multiplicator: Integer): Integer; overload; -/// -/// Get the next multiple of a given multiplicator which is lower than -/// the number given. Example: Num = 24, Multiplicator = 5, Result is 20 -/// -function NearestLowerMultiple(Num, Multiplicator: Int64): Int64; overload; -/// -/// Get the next multiple of a given multiplicator which is lower than -/// the number given. Example: Num = 24, Multiplicator = 5, Result is 20 -/// -function NearestLowerMultiple(Num: Float; Multiplicator: Integer): Integer; overload; -/// -/// Get the next multiple of a given multiplicator which is lower than -/// the number given. Example: Num = 24, Multiplicator = 5, Result is 20 -/// -function NearestLowerMultiple(Num: Float; Multiplicator: Int64): Int64; overload; - -function NormalizeAngle(const Angle: Float): Float; -function Pythagoras(const X, Y: Float): Float; -function Sgn(const X: Float): Integer; -function Signe(const X, Y: Float): Float; - -{ Ranges } -function EnsureRange(const AValue, AMin, AMax: Integer): Integer; overload; -function EnsureRange(const AValue, AMin, AMax: Int64): Int64; overload; -function EnsureRange(const AValue, AMin, AMax: Double): Double; overload; - -{ Prime numbers } - -function IsRelativePrime(const X, Y: Cardinal): Boolean; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function IsPrimeTD(N: Cardinal): Boolean; -{$IFDEF CPU32} -function IsPrimeRM(N: Cardinal): Boolean; -{$ENDIF CPU32} -function IsPrimeFactor(const F, N: Cardinal): Boolean; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function PrimeFactors(N: Cardinal): TDynCardinalArray; - -var - IsPrime: function(N: Cardinal): Boolean = IsPrimeTD; - -procedure SetPrimalityTest(const Method: TPrimalityTestMethod); - -{ Floating point value classification } - -type - TFloatingPointClass = - ( - fpZero, // zero - fpNormal, // normal finite <> 0 - fpDenormal, // denormalized finite - fpInfinite, // infinite - fpNaN, // not a number - fpInvalid, // unsupported floating point format - fpEmpty // should not happen - ); - -const - Infinity = 1/0; // tricky - {$EXTERNALSYM Infinity} - NaN = 0/0; // tricky - {$EXTERNALSYM NaN} - NegInfinity = -Infinity; - {$EXTERNALSYM NegInfinity} - -{$IFDEF WIN64} -{$HPPEMIT 'static const double Infinity = 1.0 / 0.0;'} -{$HPPEMIT 'static const double NaN = 0.0 / 0.0;'} -{$HPPEMIT 'static const double NegInfinity = -1.0 / 0.0;'} -{$ELSE} -{$HPPEMIT 'static const Infinity = 1.0 / 0.0;'} -{$HPPEMIT 'static const NaN = 0.0 / 0.0;'} -{$HPPEMIT 'static const NegInfinity = -1.0 / 0.0;'} -{$ENDIF WIN64} - -{$IFDEF CPU32} - -function FloatingPointClass(const Value: Single): TFloatingPointClass; overload; -function FloatingPointClass(const Value: Double): TFloatingPointClass; overload; -{$IFDEF SUPPORTS_EXTENDED} -function FloatingPointClass(const Value: Extended): TFloatingPointClass; overload; -{$ENDIF SUPPORTS_EXTENDED} - -{ NaN and INF support } - -type - TNaNTag = type Integer; - -const - LowValidNaNTag = -$3FFFFF; - HighValidNaNTag = $3FFFFE; - -function IsInfinite(const Value: Single): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function IsInfinite(const Value: Double): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -{$IFDEF SUPPORTS_EXTENDED} -function IsInfinite(const Value: Extended): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -{$ENDIF SUPPORTS_EXTENDED} - -function IsNaN(const Value: Single): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function IsNaN(const Value: Double): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -{$IFDEF SUPPORTS_EXTENDED} -function IsNaN(const Value: Extended): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -{$ENDIF SUPPORTS_EXTENDED} - -function IsSpecialValue(const X: Float): Boolean; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - -procedure MakeQuietNaN(var X: Single; Tag: TNaNTag = 0); overload; -procedure MakeQuietNaN(var X: Double; Tag: TNaNTag = 0); overload; -{$IFDEF SUPPORTS_EXTENDED} -procedure MakeQuietNaN(var X: Extended; Tag: TNaNTag = 0); overload; -{$ENDIF SUPPORTS_EXTENDED} - -procedure MakeSignalingNaN(var X: Single; Tag: TNaNTag = 0); overload; -procedure MakeSignalingNaN(var X: Double; Tag: TNaNTag = 0); overload; -{$IFDEF SUPPORTS_EXTENDED} -procedure MakeSignalingNaN(var X: Extended; Tag: TNaNTag = 0); overload; -{$ENDIF SUPPORTS_EXTENDED} - -{ Mine*Buffer fills "Buffer" with consecutive tagged signaling NaNs. - - This allows for real number arrays which enforce initialization: any attempt - to load an uninitialized array element into the FPU will raise an exception - either of class EInvalidOp (Windows 9x/ME) or EJclNaNSignal (Windows NT). - - Under Windows NT it is thus possible to derive the violating array index from - the EJclNaNSignal object's Tag property. } - -procedure MineSingleBuffer(var Buffer; Count: Integer; StartTag: TNaNTag = 0); -procedure MineDoubleBuffer(var Buffer; Count: Integer; StartTag: TNaNTag = 0); - -function MinedSingleArray(Length: Integer): TDynSingleArray; -function MinedDoubleArray(Length: Integer): TDynDoubleArray; - -function GetNaNTag(const NaN: Single): TNaNTag; overload; -function GetNaNTag(const NaN: Double): TNaNTag; overload; -{$IFDEF SUPPORTS_EXTENDED} -function GetNaNTag(const NaN: Extended): TNaNTag; overload; -{$ENDIF SUPPORTS_EXTENDED} - -{$ENDIF CPU32} - -{ Set support } - -type - TJclASet = class(TObject) - public - function GetBit(const Idx: Integer): Boolean; virtual; abstract; - procedure SetBit(const Idx: Integer; const Value: Boolean); virtual; abstract; - procedure Clear; virtual; abstract; - procedure Invert; virtual; abstract; - function GetRange(const Low, High: Integer; const Value: Boolean): Boolean; virtual; abstract; - procedure SetRange(const Low, High: Integer; const Value: Boolean); virtual; abstract; - end; - -type - TJclFlatSet = class(TJclASet) - private - FBits: TBits; - public - constructor Create; - destructor Destroy; override; - procedure Clear; override; - procedure Invert; override; - procedure SetRange(const Low, High: Integer; const Value: Boolean); override; - function GetBit(const Idx: Integer): Boolean; override; - function GetRange(const Low, High: Integer; const Value: Boolean): Boolean; override; - procedure SetBit(const Idx: Integer; const Value: Boolean); override; - end; - -type - {$IFNDEF FPC} - TPointerArray = array [0..MaxLongint div 256] of Pointer; - PPointerArray = ^TPointerArray; - {$ENDIF ~FPC} - TDelphiSet = set of Byte; // 256 elements - PDelphiSet = ^TDelphiSet; - -const - EmptyDelphiSet: TDelphiSet = []; - CompleteDelphiSet: TDelphiSet = [0..255]; - -type - TJclSparseFlatSet = class(TJclASet) - private - FSetList: PPointerArray; - FSetListEntries: Integer; - public - destructor Destroy; override; - procedure Clear; override; - procedure Invert; override; - function GetBit(const Idx: Integer): Boolean; override; - procedure SetBit(const Idx: Integer; const Value: Boolean); override; - procedure SetRange(const Low, High: Integer; const Value: Boolean); override; - function GetRange(const Low, High: Integer; const Value: Boolean): Boolean; override; - end; - -{ Rational numbers } - -type - TJclRational = class(TObject) - private - FT: Integer; - FN: Integer; - function GetAsString: string; - procedure SetAsString(const S: string); - function GetAsFloat: Float; - procedure SetAsFloat(const R: Float); - protected - procedure Simplify; - public - constructor Create; overload; - constructor Create(const R: Float); overload; - constructor Create(const Numerator: Integer; const Denominator: Integer = 1); overload; - - property Numerator: Integer read FT; - property Denominator: Integer read FN; - property AsString: string read GetAsString write SetAsString; - property AsFloat: Float read GetAsFloat write SetAsFloat; - - procedure Assign(const R: TJclRational); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - procedure Assign(const R: Float); overload; - procedure Assign(const Numerator: Integer; const Denominator: Integer = 1); overload; - - procedure AssignZero; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - procedure AssignOne; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - function Duplicate: TJclRational; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - - function IsEqual(const R: TJclRational): Boolean; reintroduce; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - function IsEqual(const Numerator: Integer; const Denominator: Integer = 1) : Boolean; reintroduce; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - function IsEqual(const R: Float): Boolean; reintroduce; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - - function IsZero: Boolean; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - function IsOne: Boolean; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - - procedure Add(const R: TJclRational); overload; - procedure Add(const V: Float); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - procedure Add(const V: Integer); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - - procedure Subtract(const R: TJclRational); overload; - procedure Subtract(const V: Float); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - procedure Subtract(const V: Integer); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - - procedure Negate; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - procedure Abs; - function Sgn: Integer; - - procedure Multiply(const R: TJclRational); overload; - procedure Multiply(const V: Float); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - procedure Multiply(const V: Integer); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - - procedure Reciprocal; - - procedure Divide(const R: TJclRational); overload; - procedure Divide(const V: Float); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - procedure Divide(const V: Integer); overload; - - procedure Sqrt; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - procedure Sqr; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - - procedure Power(const R: TJclRational); overload; - procedure Power(const V: Integer); overload; - procedure Power(const V: Float); overload; - end; - -type - EJclMathError = class(EJclError); - - {$IFDEF CPU32} - EJclNaNSignal = class(EJclMathError) - private - FTag: TNaNTag; - public - constructor Create(ATag: TNaNTag; Dummy: Boolean = False); - property Tag: TNaNTag read FTag; - end; - {$ENDIF CPU32} - -procedure DomainCheck(Err: Boolean); - -{ Checksums } - -function GetParity(Buffer: TDynByteArray; Len: Integer): Boolean; overload; -function GetParity(Buffer: PByte; Len: Integer): Boolean; overload; - -{ CRC-16 } - -type - TCrc16Table = array [0..255] of Word; - -var - // CRC16Polynom = $1021; - Crc16DefaultTable: TCrc16Table = ( - $0000, $1021, $2042, $3063, $4084, $50A5, $60C6, $70E7, - $8108, $9129, $A14A, $B16B, $C18C, $D1AD, $E1CE, $F1EF, - $1231, $0210, $3273, $2252, $52B5, $4294, $72F7, $62D6, - $9339, $8318, $B37B, $A35A, $D3BD, $C39C, $F3FF, $E3DE, - $2462, $3443, $0420, $1401, $64E6, $74C7, $44A4, $5485, - $A56A, $B54B, $8528, $9509, $E5EE, $F5CF, $C5AC, $D58D, - $3653, $2672, $1611, $0630, $76D7, $66F6, $5695, $46B4, - $B75B, $A77A, $9719, $8738, $F7DF, $E7FE, $D79D, $C7BC, - $48C4, $58E5, $6886, $78A7, $0840, $1861, $2802, $3823, - $C9CC, $D9ED, $E98E, $F9AF, $8948, $9969, $A90A, $B92B, - $5AF5, $4AD4, $7AB7, $6A96, $1A71, $0A50, $3A33, $2A12, - $DBFD, $CBDC, $FBBF, $EB9E, $9B79, $8B58, $BB3B, $AB1A, - $6CA6, $7C87, $4CE4, $5CC5, $2C22, $3C03, $0C60, $1C41, - $EDAE, $FD8F, $CDEC, $DDCD, $AD2A, $BD0B, $8D68, $9D49, - $7E97, $6EB6, $5ED5, $4EF4, $3E13, $2E32, $1E51, $0E70, - $FF9F, $EFBE, $DFDD, $CFFC, $BF1B, $AF3A, $9F59, $8F78, - $9188, $81A9, $B1CA, $A1EB, $D10C, $C12D, $F14E, $E16F, - $1080, $00A1, $30C2, $20E3, $5004, $4025, $7046, $6067, - $83B9, $9398, $A3FB, $B3DA, $C33D, $D31C, $E37F, $F35E, - $02B1, $1290, $22F3, $32D2, $4235, $5214, $6277, $7256, - $B5EA, $A5CB, $95A8, $8589, $F56E, $E54F, $D52C, $C50D, - $34E2, $24C3, $14A0, $0481, $7466, $6447, $5424, $4405, - $A7DB, $B7FA, $8799, $97B8, $E75F, $F77E, $C71D, $D73C, - $26D3, $36F2, $0691, $16B0, $6657, $7676, $4615, $5634, - $D94C, $C96D, $F90E, $E92F, $99C8, $89E9, $B98A, $A9AB, - $5844, $4865, $7806, $6827, $18C0, $08E1, $3882, $28A3, - $CB7D, $DB5C, $EB3F, $FB1E, $8BF9, $9BD8, $ABBB, $BB9A, - $4A75, $5A54, $6A37, $7A16, $0AF1, $1AD0, $2AB3, $3A92, - $FD2E, $ED0F, $DD6C, $CD4D, $BDAA, $AD8B, $9DE8, $8DC9, - $7C26, $6C07, $5C64, $4C45, $3CA2, $2C83, $1CE0, $0CC1, - $EF1F, $FF3E, $CF5D, $DF7C, $AF9B, $BFBA, $8FD9, $9FF8, - $6E17, $7E36, $4E55, $5E74, $2E93, $3EB2, $0ED1, $1EF0 - ); - Crc16DefaultStart: Cardinal = $FFFF; - -const - Crc16PolynomCCITT = $1021; - Crc16PolynomIBM = $8005; - Crc16Bits = 16; - Crc16Bytes = 2; - Crc16HighBit = $8000; - NotCrc16HighBit = $7FFF; - -// for backward compatibility (default polynom = CCITT = $1021) -function Crc16_P(X: PJclByteArray; N: Integer; Crc: Word = 0): Word; overload; -function Crc16(const X: array of Byte; N: Integer; Crc: Word = 0): Word; overload; -function Crc16_A(const X: array of Byte; Crc: Word = 0): Word; overload; - -function CheckCrc16_P(X: PJclByteArray; N: Integer; Crc: Word): Integer; overload; -function CheckCrc16(var X: array of Byte; N: Integer; Crc: Word): Integer; overload; -function CheckCrc16_A(var X: array of Byte; Crc: Word): Integer; overload; - -// change the default polynom -procedure InitCrc16(Polynom, Start: Word); overload; - -// arbitrary polynom -function Crc16_P(const Crc16Table: TCrc16Table; X: PJclByteArray; N: Integer; Crc: Word = 0): Word; overload; -function Crc16(const Crc16Table: TCrc16Table; const X: array of Byte; N: Integer; Crc: Word = 0): Word; overload; -function Crc16_A(const Crc16Table: TCrc16Table; const X: array of Byte; Crc: Word = 0): Word; overload; - -function CheckCrc16_P(const Crc16Table: TCrc16Table; X: PJclByteArray; N: Integer; Crc: Word): Integer; overload; -function CheckCrc16(const Crc16Table: TCrc16Table; var X: array of Byte; N: Integer; Crc: Word): Integer; overload; -function CheckCrc16_A(const Crc16Table: TCrc16Table; var X: array of Byte; Crc: Word): Integer; overload; - -// initialize a table -procedure InitCrc16(Polynom, Start: Word; out Crc16Table: TCrc16Table); overload; - -{ CRC-32 } - -type - TCrc32Table = array [0..255] of Cardinal; - -var - // CRC32Polynom = $04C11DB7; - Crc32DefaultTable: TCrc32Table = ( - $00000000, $04C11DB7, $09823B6E, $0D4326D9, $130476DC, $17C56B6B, $1A864DB2, $1E475005, - $2608EDB8, $22C9F00F, $2F8AD6D6, $2B4BCB61, $350C9B64, $31CD86D3, $3C8EA00A, $384FBDBD, - $4C11DB70, $48D0C6C7, $4593E01E, $4152FDA9, $5F15ADAC, $5BD4B01B, $569796C2, $52568B75, - $6A1936C8, $6ED82B7F, $639B0DA6, $675A1011, $791D4014, $7DDC5DA3, $709F7B7A, $745E66CD, - $9823B6E0, $9CE2AB57, $91A18D8E, $95609039, $8B27C03C, $8FE6DD8B, $82A5FB52, $8664E6E5, - $BE2B5B58, $BAEA46EF, $B7A96036, $B3687D81, $AD2F2D84, $A9EE3033, $A4AD16EA, $A06C0B5D, - $D4326D90, $D0F37027, $DDB056FE, $D9714B49, $C7361B4C, $C3F706FB, $CEB42022, $CA753D95, - $F23A8028, $F6FB9D9F, $FBB8BB46, $FF79A6F1, $E13EF6F4, $E5FFEB43, $E8BCCD9A, $EC7DD02D, - $34867077, $30476DC0, $3D044B19, $39C556AE, $278206AB, $23431B1C, $2E003DC5, $2AC12072, - $128E9DCF, $164F8078, $1B0CA6A1, $1FCDBB16, $018AEB13, $054BF6A4, $0808D07D, $0CC9CDCA, - $7897AB07, $7C56B6B0, $71159069, $75D48DDE, $6B93DDDB, $6F52C06C, $6211E6B5, $66D0FB02, - $5E9F46BF, $5A5E5B08, $571D7DD1, $53DC6066, $4D9B3063, $495A2DD4, $44190B0D, $40D816BA, - $ACA5C697, $A864DB20, $A527FDF9, $A1E6E04E, $BFA1B04B, $BB60ADFC, $B6238B25, $B2E29692, - $8AAD2B2F, $8E6C3698, $832F1041, $87EE0DF6, $99A95DF3, $9D684044, $902B669D, $94EA7B2A, - $E0B41DE7, $E4750050, $E9362689, $EDF73B3E, $F3B06B3B, $F771768C, $FA325055, $FEF34DE2, - $C6BCF05F, $C27DEDE8, $CF3ECB31, $CBFFD686, $D5B88683, $D1799B34, $DC3ABDED, $D8FBA05A, - $690CE0EE, $6DCDFD59, $608EDB80, $644FC637, $7A089632, $7EC98B85, $738AAD5C, $774BB0EB, - $4F040D56, $4BC510E1, $46863638, $42472B8F, $5C007B8A, $58C1663D, $558240E4, $51435D53, - $251D3B9E, $21DC2629, $2C9F00F0, $285E1D47, $36194D42, $32D850F5, $3F9B762C, $3B5A6B9B, - $0315D626, $07D4CB91, $0A97ED48, $0E56F0FF, $1011A0FA, $14D0BD4D, $19939B94, $1D528623, - $F12F560E, $F5EE4BB9, $F8AD6D60, $FC6C70D7, $E22B20D2, $E6EA3D65, $EBA91BBC, $EF68060B, - $D727BBB6, $D3E6A601, $DEA580D8, $DA649D6F, $C423CD6A, $C0E2D0DD, $CDA1F604, $C960EBB3, - $BD3E8D7E, $B9FF90C9, $B4BCB610, $B07DABA7, $AE3AFBA2, $AAFBE615, $A7B8C0CC, $A379DD7B, - $9B3660C6, $9FF77D71, $92B45BA8, $9675461F, $8832161A, $8CF30BAD, $81B02D74, $857130C3, - $5D8A9099, $594B8D2E, $5408ABF7, $50C9B640, $4E8EE645, $4A4FFBF2, $470CDD2B, $43CDC09C, - $7B827D21, $7F436096, $7200464F, $76C15BF8, $68860BFD, $6C47164A, $61043093, $65C52D24, - $119B4BE9, $155A565E, $18197087, $1CD86D30, $029F3D35, $065E2082, $0B1D065B, $0FDC1BEC, - $3793A651, $3352BBE6, $3E119D3F, $3AD08088, $2497D08D, $2056CD3A, $2D15EBE3, $29D4F654, - $C5A92679, $C1683BCE, $CC2B1D17, $C8EA00A0, $D6AD50A5, $D26C4D12, $DF2F6BCB, $DBEE767C, - $E3A1CBC1, $E760D676, $EA23F0AF, $EEE2ED18, $F0A5BD1D, $F464A0AA, $F9278673, $FDE69BC4, - $89B8FD09, $8D79E0BE, $803AC667, $84FBDBD0, $9ABC8BD5, $9E7D9662, $933EB0BB, $97FFAD0C, - $AFB010B1, $AB710D06, $A6322BDF, $A2F33668, $BCB4666D, $B8757BDA, $B5365D03, $B1F740B4 - ); - Crc32DefaultStart: Cardinal = $FFFFFFFF; - -const - Crc32PolynomIEEE = $04C11DB7; - Crc32PolynomCastagnoli = $1EDC6F41; - Crc32Koopman = $741B8CD7; - Crc32Bits = 32; - Crc32Bytes = 4; - Crc32HighBit = $80000000; - NotCrc32HighBit = $7FFFFFFF; - -// for backward compatibility (default polynom = IEEE = $04C11DB7) -function Crc32_P(X: PJclByteArray; N: Integer; Crc: Cardinal = 0): Cardinal; overload; -function Crc32(const X: array of Byte; N: Integer; Crc: Cardinal = 0): Cardinal; overload; -function Crc32_A(const X: array of Byte; Crc: Cardinal = 0): Cardinal; overload; - -function CheckCrc32_P(X: PJclByteArray; N: Integer; Crc: Cardinal): Integer; overload; -function CheckCrc32(var X: array of Byte; N: Integer; Crc: Cardinal): Integer; overload; -function CheckCrc32_A(var X: array of Byte; Crc: Cardinal): Integer; overload; - -// change the default polynom -procedure InitCrc32(Polynom, Start: Cardinal); overload; - -// arbitrary polynom -function Crc32_P(const Crc32Table: TCrc32Table; X: PJclByteArray; N: Integer; Crc: Cardinal = 0): Cardinal; overload; -function Crc32(const Crc32Table: TCrc32Table; const X: array of Byte; N: Integer; Crc: Cardinal = 0): Cardinal; overload; -function Crc32_A(const Crc32Table: TCrc32Table; const X: array of Byte; Crc: Cardinal = 0): Cardinal; overload; - -function CheckCrc32_P(const Crc32Table: TCrc32Table; X: PJclByteArray; N: Integer; Crc: Cardinal): Integer; overload; -function CheckCrc32(const Crc32Table: TCrc32Table; var X: array of Byte; N: Integer; Crc: Cardinal): Integer; overload; -function CheckCrc32_A(const Crc32Table: TCrc32Table; var X: array of Byte; Crc: Cardinal): Integer; overload; - -// initialize a table -procedure InitCrc32(Polynom, Start: Cardinal; out Crc32Table: TCrc32Table); overload; - -{ Complex numbers } - -type - TRectComplex = record - Re: Float; - Im: Float; - {$IFDEF SUPPORTS_CLASS_OPERATORS} - class operator Implicit(const Value: Float): TRectComplex; - class operator Equal(const Z1, Z2: TRectComplex): Boolean; - class operator NotEqual(const Z1, Z2: TRectComplex): Boolean; - class operator Add(const Z1, Z2: TRectComplex): TRectComplex; - class operator Subtract(const Z1, Z2: TRectComplex): TRectComplex; - class operator Multiply(const Z1, Z2: TRectComplex): TRectComplex; - class operator Divide(const Z1, Z2: TRectComplex): TRectComplex; - class operator Negative(const Z: TRectComplex): TRectComplex; - class operator Positive(const Z: TRectComplex): TRectComplex; - function AsString: string; - function Conjugate: TRectComplex; - function IsZero: Boolean; - function IsInfinite: Boolean; - {$ENDIF SUPPORTS_CLASS_OPERATORS} - end; - - TPolarComplex = record - Radius: Float; - Angle: Float; - {$IFDEF SUPPORTS_CLASS_OPERATORS} - class operator Implicit(const Value: Float): TPolarComplex; - class operator Implicit(const Z: TPolarComplex): TRectComplex; - class operator Implicit(const Z: TRectComplex): TPolarComplex; - {$IFNDEF CPPBUILDER} - // OK with Delphi, but will yield errors in .hpp files: - class operator Explicit(const Z: TPolarComplex): TRectComplex; - class operator Explicit(const Z: TRectComplex): TPolarComplex; - {$ENDIF CPPBUILDER} - class operator Equal(const Z1, Z2: TPolarComplex): Boolean; - class operator NotEqual(const Z1, Z2: TPolarComplex): Boolean; - class operator Add(const Z1, Z2: TPolarComplex): TRectComplex; - class operator Subtract(const Z1, Z2: TPolarComplex): TRectComplex; - class operator Multiply(const Z1, Z2: TPolarComplex): TPolarComplex; - class operator Divide(const Z1, Z2: TPolarComplex): TPolarComplex; - class operator Negative(const Z: TPolarComplex): TPolarComplex; - class operator Positive(const Z: TPolarComplex): TPolarComplex; - function AsString: string; - function Conjugate: TPolarComplex; - function IsZero: Boolean; - function IsInfinite: Boolean; - function Power(const Exponent: TRectComplex): TPolarComplex; overload; - function Power(const Exponent: Float): TPolarComplex; overload; - function Power(const Exponent: Integer): TPolarComplex; overload; - // computes the kth nth root, k in 1..n - function Root(const K, N: Cardinal): TPolarComplex; - {$ENDIF SUPPORTS_CLASS_OPERATORS} - end; - -{$IFDEF DEBUG} -var - // accumulated count of (computational costly) TRectComplex <-> TPolarComplex conversions - ComplexTypeConversions: Cardinal; -{$ENDIF DEBUG} - -// sets format string for ComplexToStr(TRectComplex) and TRectComplex.AsString -procedure SetRectComplexFormatStr(const S: string); -// sets format string for ComplexToStr(TPolarComplex) and TPolarComplex.AsString -procedure SetPolarComplexFormatStr(const S: string); - -function ComplexToStr(const Z: TRectComplex): string; overload; -function ComplexToStr(const Z: TPolarComplex): string; overload; - -function RectComplex(const Re: Float; const Im: Float = 0): TRectComplex; overload; -function RectComplex(const Z: TPolarComplex): TRectComplex; overload; -function PolarComplex(const Radius: Float; const Angle: Float = 0): TPolarComplex; overload; -function PolarComplex(const Z: TRectComplex): TPolarComplex; overload; - -function Equal(const Z1, Z2: TRectComplex): Boolean; overload; -function Equal(const Z1, Z2: TPolarComplex): Boolean; overload; - -function IsZero(const Z: TRectComplex): Boolean; overload; -function IsZero(const Z: TPolarComplex): Boolean; overload; -{$IFDEF CPU32} -function IsInfinite(const Z: TRectComplex): Boolean; overload; -function IsInfinite(const Z: TPolarComplex): Boolean; overload; -{$ENDIF CPU32} - -function Norm(const Z: TRectComplex): Float; overload; -function Norm(const Z: TPolarComplex): Float; overload; -function AbsSqr(const Z: TRectComplex): Float; overload; -function AbsSqr(const Z: TPolarComplex): Float; overload; -function Conjugate(const Z: TRectComplex): TRectComplex; overload; -function Conjugate(const Z: TPolarComplex): TPolarComplex; overload; -function Inv(const Z: TRectComplex): TRectComplex; overload; -function Inv(const Z: TPolarComplex): TPolarComplex; overload; -function Neg(const Z: TRectComplex): TRectComplex; overload; -function Neg(const Z: TPolarComplex): TPolarComplex; overload; - -function Sum(const Z1, Z2: TRectComplex): TRectComplex; overload; -function Sum(const Z: array of TRectComplex): TRectComplex; overload; -function Diff(const Z1, Z2: TRectComplex): TRectComplex; -function Product(const Z1, Z2: TRectComplex): TRectComplex; overload; -function Product(const Z1, Z2: TPolarComplex): TPolarComplex; overload; -function Product(const Z: array of TPolarComplex): TPolarComplex; overload; -function Quotient(const Z1, Z2: TRectComplex): TRectComplex; overload; -function Quotient(const Z1, Z2: TPolarComplex): TPolarComplex; overload; - -function Ln(const Z: TPolarComplex): TRectComplex; -function Exp(const Z: TRectComplex): TPolarComplex; overload; -function Power(const Z: TPolarComplex; const Exponent: TRectComplex): TPolarComplex; overload; -function Power(const Z: TPolarComplex; const Exponent: Float): TPolarComplex; overload; -function PowerInt(const Z: TPolarComplex; const Exponent: Integer): TPolarComplex; overload; -// a complex number has n different nth roots in the complex plane -// Root() computes the kth nth root, k in 1..n -function Root(const Z: TPolarComplex; const K, N: Cardinal): TPolarComplex; - -function Cos(const Z: TRectComplex): TRectComplex; overload; -function Sin(const Z: TRectComplex): TRectComplex; overload; -function Tan(const Z: TRectComplex): TRectComplex; overload; -function Cot(const Z: TRectComplex): TRectComplex; overload; -function Sec(const Z: TRectComplex): TRectComplex; overload; -function Csc(const Z: TRectComplex): TRectComplex; overload; - -function CosH(const Z: TRectComplex): TRectComplex; overload; -function SinH(const Z: TRectComplex): TRectComplex; overload; -function TanH(const Z: TRectComplex): TRectComplex; overload; -function CotH(const Z: TRectComplex): TRectComplex; overload; -function SecH(const Z: TRectComplex): TRectComplex; overload; -function CscH(const Z: TRectComplex): TRectComplex; overload; - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\common'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -{$IFDEF DELPHI64_TEMPORARY} - {$DEFINE USE_MATH_UNIT} -{$ENDIF DELPHI64_TEMPORARY} - -uses - {$IFDEF HAS_UNITSCOPE} - {$IFDEF MSWINDOWS} - {$IFNDEF FPC} - Winapi.Windows, - {$ENDIF ~FPC} - {$ENDIF MSWINDOWS} - {$ELSE ~HAS_UNITSCOPE} - {$IFDEF MSWINDOWS} - {$IFNDEF FPC} - Windows, - {$ENDIF ~FPC} - {$ENDIF MSWINDOWS} - {$ENDIF ~HAS_UNITSCOPE} - {$IFDEF USE_MATH_UNIT} - System.Math, - {$ENDIF USE_MATH_UNIT} - Jcl8087, - JclResources, - JclSynch; - -// Note (rrossmair): Usage of the "assembler" directive seems to be an Free Pascal requirement -// (it's obsolete in Delphi since v. 2 I believe). - -// Internal helper routines -// Linux: Get Global Offset Table (GOT) adress for Position Independent Code -// (PIC, used by shared objects) - -{$IFDEF PIC} -function GetGOT: Pointer; export; -begin - asm - {$IFDEF CPU32} - MOV Result, EBX - {$ENDIF CPU32} - {$IFDEF CPU64} - XOR Result, RBX - {$ENDIF CPU64} - end; -end; -{$ENDIF PIC} - -// to keep name space usage low -const - JclMathSgn: function(const X: Float): Integer = Sgn; - JclMathPower: function(const Base, Exponent: Float): Float = Power; - -// to be independent from JclLogic - -function Min(const X, Y: Integer): Integer; -begin - if X < Y then - Result := X - else - Result := Y; -end; - -// to be independent from JCLLogic - -procedure SwapOrd(var X, Y: Integer); -var - Temp: Integer; -begin - Temp := X; - X := Y; - Y := Temp; -end; - -function DoubleToHex(const D: Double): string; -var - Overlay: array [1..2] of Longint absolute D; -begin - // Look at element 2 before element 1 because of "Little Endian" order. - Result := IntToHex(Overlay[2], 8) + IntToHex(Overlay[1], 8); -end; - -function HexToDouble(const Hex: string): Double; -var - D: Double; - Overlay: array [1..2] of Longint absolute D; -begin - if Length(Hex) <> 16 then - raise EJclMathError.CreateRes(@RsUnexpectedValue); - Overlay[1] := StrToInt('$' + Copy(Hex, 9, 8)); - Overlay[2] := StrToInt('$' + Copy(Hex, 1, 8)); - Result := D; -end; - -// Converts degrees to radians. - -{$IFDEF SUPPORTS_EXTENDED} -function DegToRad(const Value: Extended): Extended; -begin - Result := Value * RatioDegToRad; -end; -{$ENDIF SUPPORTS_EXTENDED} - -function DegToRad(const Value: Double): Double; -begin - Result := Value * RatioDegToRad; -end; - -function DegToRad(const Value: Single): Single; -begin - Result := Value * RatioDegToRad; -end; - -// Expects degrees in ST(0), leaves radians in ST(0) -// ST(0) := ST(0) * PI / 180 -procedure FastDegToRad; assembler; -asm - {$IFDEF PIC} - CALL GetGOT - {$IFDEF CPU32} - FLD [EAX][RatioDegToRad] - {$ENDIF CPU32} - {$IFDEF CPU64} - FLD [RAX][RatioDegToRad] - {$ENDIF CPU64} - {$ELSE ~PIC} - FLD [RatioDegToRad] - {$ENDIF ~PIC} - FMULP - FWAIT -end; - -// Converts radians to degrees. - -{$IFDEF SUPPORTS_EXTENDED} -function RadToDeg(const Value: Extended): Extended; -begin - Result := Value * RatioRadToDeg; -end; -{$ENDIF SUPPORTS_EXTENDED} - -function RadToDeg(const Value: Double): Double; -begin - Result := Value * RatioRadToDeg; -end; - -function RadToDeg(const Value: Single): Single; -begin - Result := Value * RatioRadToDeg; -end; - -// Expects radians in ST(0), leaves degrees in ST(0) -// ST(0) := ST(0) * (180 / PI); -procedure FastRadToDeg; assembler; -asm - {$IFDEF PIC} - CALL GetGOT - {$IFDEF CPU32} - FLD [EAX][RatioRadToDeg] - {$ENDIF CPU32} - {$IFDEF CPU64} - FLD [RAX][RatioRadToDeg] - {$ENDIF CPU64} - {$ELSE ~PIC} - FLD [RatioRadToDeg] - {$ENDIF ~PIC} - FMULP - FWAIT -end; - -// Converts grads to radians. - -{$IFDEF SUPPORTS_EXTENDED} -function GradToRad(const Value: Extended): Extended; -begin - Result := Value * RatioGradToRad; -end; -{$ENDIF SUPPORTS_EXTENDED} - -function GradToRad(const Value: Double): Double; -begin - Result := Value * RatioGradToRad; -end; - -function GradToRad(const Value: Single): Single; -begin - Result := Value * RatioGradToRad; -end; - -// Expects grads in ST(0), leaves radians in ST(0) -// ST(0) := ST(0) * PI / 200 -procedure FastGradToRad; assembler; -asm - {$IFDEF PIC} - CALL GetGOT - {$IFDEF CPU32} - FLD [EAX][RatioGradToRad] - {$ENDIF CPU32} - {$IFDEF CPU64} - FLD [RAX][RatioGradToRad] - {$ENDIF CPU64} - {$ELSE ~PIC} - FLD [RatioGradToRad] - {$ENDIF ~PIC} - FMULP - FWAIT -end; - -// Converts radians to grads. - -{$IFDEF SUPPORTS_EXTENDED} -function RadToGrad(const Value: Extended): Extended; -begin - Result := Value * RatioRadToGrad; -end; -{$ENDIF SUPPORTS_EXTENDED} - -function RadToGrad(const Value: Double): Double; -begin - Result := Value * RatioRadToGrad; -end; - -function RadToGrad(const Value: Single): Single; -begin - Result := Value * RatioRadToGrad; -end; - -// Expects radians in ST(0), leaves grads in ST(0) -// ST(0) := ST(0) * (200 / PI); -procedure FastRadToGrad; assembler; -asm - {$IFDEF PIC} - CALL GetGOT - {$IFDEF CPU32} - FLD [EAX][RatioRadToGrad] - {$ENDIF CPU32} - {$IFDEF CPU64} - FLD [RAX][RatioRadToGrad] - {$ENDIF CPU64} - {$ELSE ~PIC} - FLD [RatioRadToGrad] - {$ENDIF ~PIC} - FMULP - FWAIT -end; - -// Converts degrees to grads. - -{$IFDEF SUPPORTS_EXTENDED} -function DegToGrad(const Value: Extended): Extended; -begin - Result := Value * RatioDegToGrad; -end; -{$ENDIF SUPPORTS_EXTENDED} - -function DegToGrad(const Value: Double): Double; -begin - Result := Value * RatioDegToGrad; -end; - -function DegToGrad(const Value: Single): Single; -begin - Result := Value * RatioDegToGrad; -end; - -// Expects Degrees in ST(0), leaves grads in ST(0) -// ST(0) := ST(0) * (200 / 180); -procedure FastDegToGrad; assembler; -asm - {$IFDEF PIC} - CALL GetGOT - {$IFDEF CPU32} - FLD [EAX][RatioDegToGrad] - {$ENDIF CPU32} - {$IFDEF CPU64} - FLD [RAX][RatioDegToGrad] - {$ENDIF CPU64} - {$ELSE ~PIC} - FLD [RatioDegToGrad] - {$ENDIF ~PIC} - FMULP - FWAIT -end; - -// Converts grads to degrees. - -{$IFDEF SUPPORTS_EXTENDED} -function GradToDeg(const Value: Extended): Extended; -begin - Result := Value * RatioGradToDeg; -end; -{$ENDIF SUPPORTS_EXTENDED} - -function GradToDeg(const Value: Double): Double; -begin - Result := Value * RatioGradToDeg; -end; - -function GradToDeg(const Value: Single): Single; -begin - Result := Value * RatioGradToDeg; -end; - -// Expects grads in ST(0), leaves radians in ST(0) -// ST(0) := ST(0) * PI / 200 -procedure FastGradToDeg; assembler; -asm - {$IFDEF PIC} - CALL GetGOT - {$IFDEF CPU32} - FLD [EAX][RatioGradToDeg] - {$ENDIF CPU32} - {$IFDEF CPU64} - FLD [RAX][RatioGradToDeg] - {$ENDIF CPU64} - {$ELSE ~PIC} - FLD [RatioGradToDeg] - {$ENDIF ~PIC} - FMULP - FWAIT -end; - -procedure DomainCheck(Err: Boolean); -begin - if Err then - raise EJclMathError.CreateRes(@RsMathDomainError); -end; - -//=== Logarithmic ============================================================ - -function LogBase10(X: Float): Float; -begin - DomainCheck(X <= 0.0); - {$IFDEF USE_MATH_UNIT} - Result := System.Math.Log10(X); - {$ELSE ~USE_MATH_UNIT} - asm - FLDLG2 - FLD X - FYL2X - FWAIT - FSTP Result - end; - {$ENDIF ~USE_MATH_UNIT} -end; - -function LogBase2(X: Float): Float; -begin - DomainCheck(X <= 0.0); - {$IFDEF USE_MATH_UNIT} - Result := System.Math.Log2(X); - {$ELSE ~USE_MATH_UNIT} - asm - FLD1 - FLD X - FYL2X - FWAIT - FSTP Result - end; - {$ENDIF ~USE_MATH_UNIT} -end; - -function LogBaseN(Base, X: Float): Float; -begin - DomainCheck((X <= 0.0) or (Base <= 0.0) or (Base = 1.0)); - {$IFDEF USE_MATH_UNIT} - Result := System.Math.LogN(Base, X); - {$ELSE ~USE_MATH_UNIT} - asm - FLD1 - FLD X - FYL2X - FLD1 - FLD Base - FYL2X - FDIVP ST(1), ST(0) - FWAIT - FSTP Result - end; - {$ENDIF ~USE_MATH_UNIT} -end; - -//=== Transcendental ========================================================= - -function ArcCos(X: Float): Float; -begin - DomainCheck(Abs(X) > 1.0); - {$IFDEF USE_MATH_UNIT} - Result := System.Math.ArcCos(X); - {$ELSE ~USE_MATH_UNIT} - asm - FLD X - FLD ST(0) - FMUL ST(0), ST(0) - FLD1 - FSUBRP ST(1), ST(0) - FSQRT - FXCH - FPATAN - FWAIT - FSTP Result - end; - {$ENDIF ~USE_MATH_UNIT} -end; - -function ArcCot(X: Float): Float; -begin - DomainCheck(X = 0); - Result := ArcTan(1 / X); -end; - -function ArcCsc(X: Float): Float; -begin - Result := ArcSec(X / Sqrt(X * X -1)); -end; - -function ArcSec(X: Float): Float; -begin - DomainCheck((X > -1) and (X < 1)); - {$IFDEF USE_MATH_UNIT} - Result := System.Math.ArcSec(X); - {$ELSE ~USE_MATH_UNIT} - // FArcTan(Sqrt(X*X - 1)); - asm - FLD1 - FLD X - FLD ST(0) - FMULP - FSUBRP ST(1), ST(0) - FSQRT - FLD1 - FPATAN - FWAIT - FSTP Result - end; - {$ENDIF ~USE_MATH_UNIT} -end; - -function ArcSin(X: Float): Float; -begin - DomainCheck(Abs(X) > 1.0); - {$IFDEF USE_MATH_UNIT} - Result := System.Math.ArcSin(X); - {$ELSE ~USE_MATH_UNIT} - asm - FLD X - FLD ST(0) - FMUL ST(0), ST(0) - FLD1 - FSUBRP ST(1), ST(0) - FSQRT - FPATAN - FWAIT - FSTP Result - end; - {$ENDIF ~USE_MATH_UNIT} -end; - -{$IFDEF CPU32} -function ArcTan(X: Float): Float; assembler; -asm - FLD X - FLD1 - FPATAN - FWAIT -end; -{$ENDIF CPU32} - -{$IFDEF CPU64} -function ArcTan(X: Float): Float; -begin - {$IFDEF USE_MATH_UNIT} - System.Error(rePlatformNotImplemented); - Result := NaN; - {$ELSE ~USE_MATH_UNIT} - asm - FLD X - FLD1 - FPATAN - FWAIT - FSTP Result - end; - {$ENDIF ~USE_MATH_UNIT} -end; -{$ENDIF CPU64} - -{$IFDEF CPU32} -function ArcTan2(Y, X: Float): Float; assembler; -asm - FLD Y - FLD X - FPATAN - FWAIT -end; -{$ENDIF CPU32} - -{$IFDEF CPU64} -function ArcTan2(Y, X: Float): Float; -begin - {$IFDEF USE_MATH_UNIT} - Result := System.Math.ArcTan2(Y, X); - {$ELSE ~USE_MATH_UNIT} - asm - FLD Y - FLD X - FPATAN - FWAIT - FSTP Result - end; - {$ENDIF ~USE_MATH_UNIT} -end; -{$ENDIF CPU64} - -function Cos(X: Float): Float; -begin - DomainCheck(Abs(X) > MaxAngle); - {$IFDEF USE_MATH_UNIT} - System.Error(rePlatformNotImplemented); - Result := NaN; - {$ELSE ~USE_MATH_UNIT} - asm - FLD X - FCOS - FWAIT - FSTP Result - end; - {$ENDIF ~USE_MATH_UNIT} -end; - -function Cot(X: Float): Float; -begin - DomainCheck(Abs(X) > MaxAngle); - {$IFDEF USE_MATH_UNIT} - Result := System.Math.Cot(X); - {$ELSE ~USE_MATH_UNIT} - { TODO : Cot = 1 / Tan -> Tan(X) <> 0.0 } - asm - FLD X - FPTAN - FDIVRP ST(1), ST(0) - FWAIT - FSTP Result - end; - {$ENDIF ~USE_MATH_UNIT} -end; - -function Coversine(X: Float): Float; -begin - Result := 1 - JclMath.Sin(X); -end; - -function Csc(X: Float): Float; -var - Y: Float; -begin - DomainCheck(Abs(X) > MaxAngle); - - Y := JclMath.Sin(X); - DomainCheck(Y = 0.0); - Result := 1.0 / Y; -end; - -function Exsecans(X: Float): Float; -begin - Result := JclMath.Sec(X) - 1; -end; - -function Haversine(X: Float): Float; -begin - Result := 0.5 * (1 - JclMath.Cos(X)); -end; - -function Sec(X: Float): Float; -begin - DomainCheck(Abs(X) > MaxAngle); - {$IFDEF USE_MATH_UNIT} - Result := System.Math.Sec(X); - {$ELSE ~USE_MATH_UNIT} - { TODO : Sec = 1 / Cos -> Cos(X) <> 0! } - asm - FLD X - FCOS - FLD1 - FDIVRP ST(1), ST(0) - FWAIT - FSTP Result - end; - {$ENDIF ~USE_MATH_UNIT} -end; - -function Sin(X: Float): Float; -begin - {$IFNDEF MATH_EXT_SPECIALVALUES} - DomainCheck(Abs(X) > MaxAngle); - {$ENDIF ~MATH_EXT_SPECIALVALUES} - {$IFDEF USE_MATH_UNIT} - System.Error(rePlatformNotImplemented); - Result := NaN; - {$ELSE ~USE_MATH_UNIT} - asm - FLD X - FSIN - FWAIT - FSTP Result - end; - {$ENDIF ~USE_MATH_UNIT} -end; - -{$IFDEF SUPPORTS_EXTENDED} -procedure SinCos(X: Extended; out Sin, Cos: Extended); -begin - DomainCheck(Abs(X) > MaxAngle); - {$IFDEF USE_MATH_UNIT} - System.Math.SinCos(X, Sin, Cos); - {$ELSE ~USE_MATH_UNIT} - asm - FLD X - {$IFDEF CPU32} - MOV EDX, Cos - MOV EAX, Sin - FSINCOS - FSTP Extended PTR [EDX] - FSTP Extended PTR [EAX] - {$ENDIF CPU32} - {$IFDEF CPU64} - MOV RDX, Cos - MOV RAX, Sin - FSINCOS - FSTP Extended PTR [RDX] - FSTP Extended PTR [RAX] - {$ENDIF CPU64} - FWAIT - end; - {$ENDIF ~USE_MATH_UNIT} -end; -{$ENDIF SUPPORTS_EXTENDED} - -procedure SinCos(X: Double; out Sin, Cos: Double); -begin - DomainCheck(Abs(X) > MaxAngle); - {$IFDEF USE_MATH_UNIT} - System.Math.SinCos(X, Sin, Cos); - {$ELSE ~USE_MATH_UNIT} - asm - FLD X - {$IFDEF CPU32} - MOV EDX, Cos - MOV EAX, Sin - FSINCOS - FSTP Double PTR [EDX] - FSTP Double PTR [EAX] - {$ENDIF CPU32} - {$IFDEF CPU64} - MOV RDX, Cos - MOV RAX, Sin - FSINCOS - FSTP Double PTR [RDX] - FSTP Double PTR [RAX] - {$ENDIF CPU64} - FWAIT - end; - {$ENDIF ~USE_MATH_UNIT} -end; - -procedure SinCos(X: Single; out Sin, Cos: Single); -begin - DomainCheck(Abs(X) > MaxAngle); - {$IFDEF USE_MATH_UNIT} - System.Math.SinCos(X, Sin, Cos); - {$ELSE ~USE_MATH_UNIT} - asm - FLD X - {$IFDEF CPU32} - MOV EDX, Cos - MOV EAX, Sin - FSINCOS - FSTP Single PTR [EDX] - FSTP Single PTR [EAX] - {$ENDIF CPU32} - {$IFDEF CPU64} - MOV RDX, Cos - MOV RAX, Sin - FSINCOS - FSTP Single PTR [RDX] - FSTP Single PTR [RAX] - {$ENDIF CPU64} - FWAIT - end; - {$ENDIF ~USE_MATH_UNIT} -end; - -function Tan(X: Float): Float; -begin - DomainCheck(Abs(X) > MaxAngle); - {$IFDEF USE_MATH_UNIT} - Result := System.Math.Tan(X); - {$ELSE ~USE_MATH_UNIT} - asm - FLD X - FPTAN - FSTP ST(0) - FWAIT - FSTP Result - end; - {$ENDIF ~USE_MATH_UNIT} -end; - -function Versine(X: Float): Float; -begin - Result := 1 - JclMath.Cos(X); -end; - -//=== Hyperbolic ============================================================= - -function ArcCosH(X: Float): Float; -begin - DomainCheck(X < 1.0); - {$IFDEF USE_MATH_UNIT} - Result := System.Math.ArcCosh(X); - {$ELSE ~USE_MATH_UNIT} - asm - FLDLN2 - FLD X - FLD ST(0) - FMUL ST(0), ST(0) - FLD1 - FSUBP ST(1), ST(0) - FSQRT - FADDP ST(1), ST(0) - FYL2X - FSTP Result - end; - {$ENDIF ~USE_MATH_UNIT} -end; - -function ArcCotH(X: Float): Float; -begin - DomainCheck(Abs(X) = 1.0); - Result := 0.5 * System.Ln((X + 1.0) / (X - 1.0)); -end; - -function ArcCscH(X: Float): Float; -begin - DomainCheck(X = 0); - Result := System.Ln((Sgn(X) * Sqrt(Sqr(X) + 1.0) + 1.0) / X); -end; - -function ArcSecH(X: Float): Float; -begin - DomainCheck(Abs(X) > 1.0); - Result := System.Ln((Sqrt(1.0 - Sqr(X)) + 1.0) / X); -end; - -{$IFDEF CPU32} -function ArcSinH(X: Float): Float; assembler; -asm - FLDLN2 - FLD X - FLD ST(0) - FMUL ST(0), ST(0) - FLD1 - FADDP ST(1), ST(0) - FSQRT - FADDP ST(1), ST(0) - FYL2X -end; -{$ENDIF CPU32} - -{$IFDEF CPU64} -function ArcSinH(X: Float): Float; -begin - {$IFDEF USE_MATH_UNIT} - Result := System.Math.ArcSinh(X); - {$ELSE ~USE_MATH_UNIT} - asm - FLDLN2 - FLD X - FLD ST(0) - FMUL ST(0), ST(0) - FLD1 - FADDP ST(1), ST(0) - FSQRT - FADDP ST(1), ST(0) - FYL2X - FSTP Result - end; - {$ENDIF ~USE_MATH_UNIT} -end; -{$ENDIF CPU64} - -function ArcTanH(X: Float): Float; -begin - DomainCheck(Abs(X) >= 1.0); - {$IFDEF USE_MATH_UNIT} - Result := System.Math.ArcTanh(X); - {$ELSE ~USE_MATH_UNIT} - asm - FLDLN2 - FLD X - FLD ST(0) - FLD1 - FADDP ST(1), ST(0) - FXCH - FLD1 - FSUBRP ST(1), ST(0) - FDIVP ST(1), ST(0) - FSQRT - FYL2X - FWAIT - FSTP Result - end; - {$ENDIF ~USE_MATH_UNIT} -end; - -function CosH(X: Float): Float; -{$IFDEF PUREPASCAL} -begin - Result := 0.5 * (Exp(X) + Exp(-X)); -end; -{$ELSE ~PUREPASCAL} -const - RoundDown: Word = $177F; - OneHalf: Float = 0.5; -{$IFNDEF USE_MATH_UNIT} -var - ControlWW: Word; -{$ENDIF ~USE_MATH_UNIT} -begin - {$IFDEF USE_MATH_UNIT} - Result := System.Math.Cosh(X); - {$ELSE ~USE_MATH_UNIT} - asm - {$IFDEF PIC} - CALL GetGOT - {$ENDIF PIC} - FLD X { TODO : Legal values for X? } - FLDL2E - FMULP ST(1), ST(0) - FSTCW ControlWW - {$IFDEF PIC} - {$IFDEF CPU32} - FLDCW [EAX].RoundDown - {$ENDIF CPU32} - {$IFDEF CPU64} - FLDCW [RAX].RoundDown - {$ENDIF CPU64} - {$ELSE ~PIC} - FLDCW RoundDown - {$ENDIF ~PIC} - FLD ST(0) - FRNDINT - FLDCW ControlWW - FXCH - FSUB ST(0), ST(1) - F2XM1 - FLD1 - FADDP ST(1), ST(0) - FSCALE - FST ST(1) - FLD1 - FDIVRP ST(1), ST(0) - FADDP ST(1), ST(0) - {$IFDEF PIC} - {$IFDEF CPU32} - FLD [EAX].OneHalf - {$ENDIF CPU32} - {$IFDEF CPU64} - FLD [RAX].OneHalf - {$ENDIF CPU64} - {$ELSE ~PIC} - FLD OneHalf - {$ENDIF ~PIC} - FMULP ST(1), ST(0) - FWAIT - FSTP Result - end; - {$ENDIF ~USE_MATH_UNIT} -end; -{$ENDIF ~PUREPASCAL} - -function CotH(X: Float): Float; -begin - Result := 1 / JclMath.TanH(X); -end; - -function CscH(X: Float): Float; -begin - Result := JclMath.Exp(X) - JclMath.Exp(-X); - DomainCheck(Result = 0.0); - Result := 2.0 / Result; -end; - -function SecH(X: Float): Float; -begin - Result := JclMath.Exp(X) + JclMath.Exp(-X); - DomainCheck(Result = 0.0); - Result := 2.0 / Result; -end; - -function SinH(X: Float): Float; -{$IFDEF PUREPASCAL} -begin - Result := 0.5 * (JclMath.Exp(X) - JclMath.Exp(-X)); -end; -{$ELSE ~PUREPASCAL} -const - RoundDown: Word = $177F; - OneHalf: Float = 0.5; -{$IFNDEF USE_MATH_UNIT} -var - ControlWW: Word; -{$ENDIF ~USE_MATH_UNIT} -begin - {$IFDEF USE_MATH_UNIT} - Result := System.Math.Sinh(X); - {$ELSE ~USE_MATH_UNIT} - asm - {$IFDEF PIC} - CALL GetGOT - {$ENDIF PIC} - FLD X { TODO : Legal values for X? } - FLDL2E - FMULP ST(1), ST(0) - FSTCW ControlWW - {$IFDEF PIC} - {$IFDEF CPU32} - FLDCW [EAX].RoundDown - {$ENDIF CPU32} - {$IFDEF CPU64} - FLDCW [RAX].RoundDown - {$ENDIF CPU64} - {$ELSE ~PIC} - FLDCW RoundDown - {$ENDIF ~PIC} - FLD ST(0) - FRNDINT - FLDCW ControlWW - FXCH - FSUB ST(0), ST(1) - F2XM1 - FLD1 - FADDP ST(1), ST(0) - FSCALE - FST ST(1) - FLD1 - FDIVRP ST(1), ST(0) - FSUBP ST(1), ST(0) - {$IFDEF PIC} - {$IFDEF CPU32} - FLD [EAX].OneHalf - {$ENDIF CPU32} - {$IFDEF CPU64} - FLD [RAX].OneHalf - {$ENDIF CPU64} - {$ELSE ~PIC} - FLD OneHalf - {$ENDIF ~PIC} - FMULP ST(1), ST(0) - FWAIT - FSTP Result - end; - {$ENDIF ~USE_MATH_UNIT} -end; -{$ENDIF ~PUREPASCAL} - -function TanH(X: Float): Float; -begin - if X > MaxTanH then - Result := 1.0 - else - begin - if X < -MaxTanH then - Result := -1.0 - else - begin - Result := JclMath.Exp(X); - Result := Result * Result; - Result := (Result - 1.0) / (Result + 1.0); - end; - end; -end; - -//=== Coordinate conversion ================================================== - -function DegMinSecToFloat(const Degs, Mins, Secs: Float): Float; // obsolete -begin - Result := Degs + (Mins / 60.0) + (Secs / 3600.0); -end; - -procedure FloatToDegMinSec(const X: Float; var Degs, Mins, Secs: Float); // obsolete -var - Y: Float; -begin - Degs := System.Int(X); - Y := Frac(X) * 60; - Mins := System.Int(Y); - Secs := Frac(Y) * 60; -end; - -//=== Exponential ============================================================ - -function Exp(const X: Float): Float; -begin - {$IFDEF MATH_EXT_EXTREMEVALUES} - {$IFDEF CPU32} - if IsSpecialValue(X) then - begin - if IsNaN(X) or (X = Infinity) then - Result := X - else - Result := 0; - Exit; - end; - {$ENDIF CPU32} - {$ENDIF MATH_EXT_EXTREMEVALUES} - - Result := System.Exp(X); -end; - -function Power(const Base, Exponent: Float): Float; -var - IsAnInteger, IsOdd: Boolean; -begin - if (Exponent = 0.0) or (Base = 1.0) then - Result := 1 - else - if Base = 0.0 then - begin - if Exponent > 0.0 then - Result := 0.0 - else - {$IFDEF MATH_EXT_EXTREMEVALUES} - Result := Infinity; - {$ELSE ~MATH_EXT_EXTREMEVALUES} - raise EJclMathError.CreateRes(@RsPowerInfinite); - {$ENDIF ~MATH_EXT_EXTREMEVALUES} - end - else - if Base > 0.0 then - Result := JclMath.Exp(Exponent * System.Ln(Base)) - else - begin - IsAnInteger := (Frac(Exponent) = 0.0); - if IsAnInteger then - begin - Result := JclMath.Exp(Exponent * System.Ln(Abs(Base))); - IsOdd := Abs(Round(ModFloat(Exponent, 2))) = 1; - if IsOdd then - Result := -Result; - end - else - raise EJclMathError.CreateRes(@RsPowerComplex); - end; -end; - -function PowerInt(const X: Float; N: Integer): Float; -var - M: Integer; - T: Float; - Xc: Float; -begin - if X = 0.0 then - begin - if N = 0 then - Result := 1.0 - else - if N > 0 then - Result := 0.0 - else - Result := MaxFloatingPoint; - Exit; - end; - - if N = 0 then - begin - Result := 1.0; - Exit; - end; - - // Legendre's algorithm for minimizing the number of multiplications - T := 1.0; - M := Abs(N); - Xc := X; - repeat - if Odd(M) then - begin - Dec(M); - T := T * Xc; - end - else - begin - M := M div 2; - Xc := Sqr(Xc); - end; - until M = 0; - - if N > 0 then - Result := T - else - Result := 1.0 / T; -end; - -function TenToY(const Y: Float): Float; -begin - if Y = 0.0 then - Result := 1.0 - else - Result := JclMath.Exp(Y * Ln10); -end; - -function TruncPower(const Base, Exponent: Float): Float; -begin - if Base > 0 then - Result := JclMath.Power(Base, Exponent) - else - Result := 0; -end; - -function TwoToY(const Y: Float): Float; -begin - if Y = 0.0 then - Result := 1.0 - else - Result := JclMath.Exp(Y * Ln2); -end; - -//=== Floating point support routines ======================================== - -function IsFloatZero(const X: Float): Boolean; -begin - Result := Abs(X) < PrecisionTolerance; -end; - -function FloatsEqual(const X, Y: Float): Boolean; -begin - try - if Y = 0 then - // catch exact equality - Result := (X = Y) or (Abs(1 - Y/X ) <= PrecisionTolerance) - else - // catch exact equality - Result := (X = Y) or (Abs(1 - X/Y ) <= PrecisionTolerance); - except - Result := False; // catch real rare overflow e.g. 1.0e3000/1.0e-3000 - end -end; - -function MaxFloat(const X, Y: Float): Float; -begin - if X < Y then - Result := Y - else - Result := X; -end; - -function MinFloat(const X, Y: Float): Float; -begin - if X > Y then - Result := Y - else - Result := X; -end; - -function ModFloat(const X, Y: Float): Float; -var - Z: Float; -begin - Result := X / Y; - Z := System.Int(Result); - if Frac(Result) < 0.0 then - Z := Z - 1.0; - Result := X - Y * Z; -end; - -function RemainderFloat(const X, Y: Float): Float; -begin - Result := X - System.Int(X / Y) * Y; -end; - -procedure SwapFloats(var X, Y: Float); -var - T: Float; -begin - T := X; - X := Y; - Y := T; -end; - -procedure CalcMachineEpsSingle; -var - One: Single; - T: Single; -begin - One := 1.0; - EpsSingle := One; - repeat - EpsSingle := 0.5 * EpsSingle; - T := One + EpsSingle; - until One = T; - EpsSingle := 2.0 * EpsSingle; - ThreeEpsSingle := 3.0 * EpsSingle; -end; - -procedure CalcMachineEpsDouble; -var - One: Double; - T: Double; -begin - One := 1.0; - EpsDouble := One; - repeat - EpsDouble := 0.5 * EpsDouble; - T := One + EpsDouble; - until One = T; - EpsDouble := 2.0 * EpsDouble; - ThreeEpsDouble := 3.0 * EpsDouble; -end; - -{$IFDEF SUPPORTS_EXTENDED} -procedure CalcMachineEpsExtended; -var - One: Extended; - T: Extended; -begin - One := 1.0; - EpsExtended := One; - repeat - EpsExtended := 0.5 * EpsExtended; - T := One + EpsExtended; - until One = T; - EpsExtended := 2.0 * EpsExtended; - ThreeEpsExtended := 3.0 * EpsExtended; -end; -{$ENDIF SUPPORTS_EXTENDED} - -procedure CalcMachineEps; -begin - {$IFDEF MATH_EXTENDED_PRECISION} - CalcMachineEpsExtended; - Epsilon := EpsExtended; - ThreeEpsilon := ThreeEpsExtended; - {$ENDIF MATH_EXTENDED_PRECISION} - {$IFDEF MATH_DOUBLE_PRECISION} - CalcMachineEpsDouble; - Epsilon := EpsDouble; - ThreeEpsilon := ThreeEpsDouble; - {$ENDIF MATH_DOUBLE_PRECISION} - {$IFDEF MATH_SINGLE_PRECISION} - CalcMachineEpsSingle; - Epsilon := EpsSingle; - ThreeEpsilon := ThreeEpsSingle; - {$ENDIF MATH_SINGLE_PRECISION} -end; - -procedure SetPrecisionToleranceToEpsilon; -begin - CalcMachineEps; - PrecisionTolerance := Epsilon; -end; - -function SetPrecisionTolerance(NewTolerance: Float): Float; -begin - Result := PrecisionTolerance; - PrecisionTolerance := NewTolerance; -end; - -//=== Miscellaneous ========================================================== - -function Ceiling(const X: Float): Integer; -begin - Result := Integer(Trunc(X)); - if Frac(X) > 0 then - Inc(Result); -end; - -function CommercialRound(const X: Float): Int64; -begin - Result := Trunc(X); - if Frac(Abs(X)) >= 0.5 then - Result := Result + Sgn(X); -end; - -const - PreCompFactsCount = 33; // all factorials that fit in a Single - - {$IFDEF MATH_SINGLE_PRECISION} - PreCompFacts: array [0..PreCompFactsCount] of Float = - ( - 1.0, - 1.0, - 2.0, - 6.0, - 24.0, - 120.0, - 720.0, - 5040.0, - 40320.0, - 362880.0, - 3628800.0, - 39916800.0, - 479001600.0, - 6227020800.0, - 87178289152.0, - 1307674279936.0, - 20922788478976.0, - 355687414628352.0, - 6.4023735304192E15, - 1.21645096004223E17, - 2.43290202316367E18, - 5.10909408371697E19, - 1.12400072480601E21, - 2.58520174445945E22, - 6.20448454699065E23, - 1.55112110792462E25, - 4.03291499589617E26, - 1.08888704151327E28, - 3.04888371623715E29, - 8.8417630793192E30, - 2.65252889961724E32, - 8.22283968552752E33, - 2.63130869936881E35, - 8.68331850984666E36 - ); - {$ENDIF MATH_SINGLE_PRECISION} - {$IFDEF MATH_DOUBLE_PRECISION} - PreCompFacts: array [0..PreCompFactsCount] of Float = - ( - 1.0, - 1.0, - 2.0, - 6.0, - 24.0, - 120.0, - 720.0, - 5040.0, - 40320.0, - 362880.0, - 3628800.0, - 39916800.0, - 479001600.0, - 6227020800.0, - 87178291200.0, - 1307674368000.0, - 20922789888000.0, - 355687428096000.0, - 6.402373705728E15, - 1.21645100408832E17, - 2.43290200817664E18, - 5.10909421717094E19, - 1.12400072777761E21, - 2.5852016738885E22, - 6.20448401733239E23, - 1.5511210043331E25, - 4.03291461126606E26, - 1.08888694504184E28, - 3.04888344611714E29, - 8.8417619937397E30, - 2.65252859812191E32, - 8.22283865417792E33, - 2.63130836933694E35, - 8.68331761881189E36 - ); - {$ENDIF MATH_DOUBLE_PRECISION} - {$IFDEF MATH_EXTENDED_PRECISION} - PreCompFacts: array [0..PreCompFactsCount] of Float = - ( - 1.0, - 1.0, - 2.0, - 6.0, - 24.0, - 120.0, - 720.0, - 5040.0, - 40320.0, - 362880.0, - 3628800.0, - 39916800.0, - 479001600.0, - 6227020800.0, - 87178291200.0, - 1307674368000.0, - 20922789888000.0, - 355687428096000.0, - 6.402373705728E15, - 1.21645100408832E17, - 2.43290200817664E18, - 5.10909421717094E19, - 1.12400072777761E21, - 2.5852016738885E22, - 6.20448401733239E23, - 1.5511210043331E25, - 4.03291461126606E26, - 1.08888694504184E28, - 3.04888344611714E29, - 8.8417619937397E30, - 2.65252859812191E32, - 8.22283865417792E33, - 2.63130836933694E35, - 8.68331761881189E36 - ); - {$ENDIF MATH_EXTENDED_PRECISION} - -function Factorial(const N: Integer): Float; -var - I: Integer; -begin - if (N < 0) or (N > MaxFactorial) then - Result := 0.0 - else - begin - if N <= PreCompFactsCount then - Result := PreCompFacts[N] - else - begin { TODO : Change following by: Gamma(N + 1) } - Result := PreCompFacts[PreCompFactsCount]; - for I := PreCompFactsCount + 1 to N do - Result := Result * I; - end; - end; -end; - -function Floor(const X: Float): Integer; -begin - Result := Integer(Trunc(X)); - if Frac(X) < 0 then - Dec(Result); -end; - -function GCD(X, Y: Cardinal): Cardinal; -{$IFDEF PUREPASCAL} -begin - Result := X; - while Y <> 0 do - begin - X := Result; - Result := Y; - Y := X mod Y; - end; -end; -{$ELSE ~PUREPASCAL} -assembler; -{ Euclid's algorithm } -asm - // 32 --> EAX X - // EDX Y - // <-- EAX Result - // 64 --> ECX X - // EDX Y - // <-- EAX Result - {$IFDEF CPU64} - MOV EAX, ECX - {$ENDIF CPU64} - JMP @01 // We start with EAX <- X, EDX <- Y, and check to see if Y=0 -@00: - MOV ECX, EDX // ECX <- EDX prepare for division - XOR EDX, EDX // clear EDX for Division - DIV ECX // EAX <- EDX:EAX div ECX, EDX <- EDX:EAX mod ECX - MOV EAX, ECX // EAX <- ECX, and repeat if EDX <> 0 -@01: - AND EDX, EDX // test to see if EDX is zero, without changing EDX - JNZ @00 // when EDX is zero EAX has the Result -end; -{$ENDIF ~PUREPASCAL} - -function ISqrt(const I: Smallint): Smallint; -{$IFDEF PUREPASCAL} -var - b, d: Smallint; -begin - Result := -1; - d := -1; - b := 0; - repeat - Inc(Result); - Inc(d, 2); - b := b + d; - until b > I; -end; -{$ELSE ~PUREPASCAL} -assembler; -asm - // 32 --> AX I - // <-- AX Result - // 64 --> CX I - // <-- AX Result - {$IFDEF CPU32} - PUSH EBX - MOV CX, AX // load argument - {$ENDIF CPU32} - {$IFDEF CPU64} - PUSH RBX - {$ENDIF CPU64} - - MOV AX, -1 // init Result - CWD // init odd numbers to -1 - XOR BX, BX // init perfect squares to 0 -@LOOP: - INC AX // increment Result - INC DX // compute - INC DX // next odd number - ADD BX, DX // next perfect square - CMP BX, CX // perfect square > argument ? - JBE @LOOP // until square greater than argument - - {$IFDEF CPU32} - POP EBX - {$ENDIF CPU32} - {$IFDEF CPU64} - POP RBX - {$ENDIF CPU64} -end; -{$ENDIF ~PUREPASCAL} - -function LCM(const X, Y: Cardinal): Cardinal; -var - E: Cardinal; -begin - E := GCD(X, Y); - if E > 0 then - Result := (X div E) * Y - else - Result := 0; -end; - -function NearestHigherMultiple(Num, Multiplicator: Integer): Integer; -begin - Result := Ceiling(Num / Multiplicator)*Multiplicator; -end; - -function NearestHigherMultiple(Num, Multiplicator: Int64): Int64; -begin - Result := Ceiling(Num / Multiplicator)*Multiplicator; -end; - -function NearestHigherMultiple(Num: Float; Multiplicator: Integer): Integer; -begin - Result := Ceiling(Num / Multiplicator)*Multiplicator; -end; - -function NearestHigherMultiple(Num: Float; Multiplicator: Int64): Int64; -begin - Result := Ceiling(Num / Multiplicator)*Multiplicator; -end; - -function NearestLowerMultiple(Num, Multiplicator: Integer): Integer; -begin - Result := Floor(Num / Multiplicator)*Multiplicator; -end; - -function NearestLowerMultiple(Num, Multiplicator: Int64): Int64; -begin - Result := Floor(Num / Multiplicator)*Multiplicator; -end; - -function NearestLowerMultiple(Num: Float; Multiplicator: Integer): Integer; -begin - Result := Floor(Num / Multiplicator)*Multiplicator; -end; - -function NearestLowerMultiple(Num: Float; Multiplicator: Int64): Int64; -begin - Result := Floor(Num / Multiplicator)*Multiplicator; -end; - -function NormalizeAngle(const Angle: Float): Float; -begin - Result := Angle; - if Result = 0 then - Exit; - - {$IFDEF MATH_ANGLE_DEGREES} - Result := DegToRad(Result); - {$ENDIF MATH_ANGLE_DEGREES} - {$IFDEF MATH_ANGLE_GRADS} - Result := GradToRad(Result); - {$ENDIF MATH_ANGLE_GRADS} - - if (Result < -Pi) or (Result >= Pi) then - begin - Result := Frac(Result * Inv2Pi); - if Result < 0 then - Result := Result + 1.0 - else - Result := Result - 1.0; - Result := Result * TwoPi; - end; - - {$IFDEF MATH_ANGLE_DEGREES} - Result := RadToDeg(Result); - {$ENDIF MATH_ANGLE_DEGREES} - {$IFDEF MATH_ANGLE_GRADS} - Result := RadToGrad(Result); - {$ENDIF MATH_ANGLE_GRADS} -end; - -function Pythagoras(const X, Y: Float): Float; -var - AbsX, AbsY: Float; -begin - AbsX := Abs(X); - AbsY := Abs(Y); - - if AbsX > AbsY then - Result := AbsX * Sqrt(1.0 + Sqr(AbsY / AbsX)) - else - if AbsY = 0.0 then - Result := 0.0 - else - Result := AbsY * Sqrt(1.0 + Sqr(AbsX / AbsY)); -end; - -function Sgn(const X: Float): Integer; -begin - if X > 0.0 then - Result := 1 - else - if X < 0.0 then - Result := -1 - else - Result := 0; -end; - -function Signe(const X, Y: Float): Float; -begin - if X > 0.0 then - begin - if Y > 0.0 then - Result := X - else - Result := -X; - end - else - begin - if Y < 0.0 then - Result := X - else - Result := -X; - end; -end; - -function Ackermann(const A, B: Integer): Integer; -begin - if A = 0 then - begin - Result := B + 1; - Exit; - end; - - if B = 0 then - Result := Ackermann(A - 1, 1) - else - Result := Ackermann(A - 1, Ackermann(A, B - 1)); -end; - -function Fibonacci(const N: Integer): Integer; -var - I: Integer; - P1, P2: Integer; -begin - Assert(N >= 0); - Result := 0; - P1 := 1; - P2 := 1; - - if (N = 1) or (N = 2) then - Result := 1 - else - for I := 3 to N do - begin - Result := P1 + P2; - P1 := P2; - P2 := Result; - end; -end; - -//=== { TJclFlatSet } ======================================================== - -constructor TJclFlatSet.Create; -begin - inherited Create; - FBits := TBits.Create; -end; - -destructor TJclFlatSet.Destroy; -begin - FBits.Free; - FBits := nil; - inherited Destroy; -end; - -procedure TJclFlatSet.Clear; -begin - FBits.Size := 0; -end; - -procedure TJclFlatSet.Invert; -var - I: Integer; -begin - for I := 0 to FBits.Size - 1 do - FBits[I] := not FBits[I]; -end; - -procedure TJclFlatSet.SetRange(const Low, High: Integer; const Value: Boolean); -var - I: Integer; -begin - for I := High downto Low do - FBits[I] := Value; -end; - -function TJclFlatSet.GetBit(const Idx: Integer): Boolean; -begin - Result := FBits[Idx]; -end; - -function TJclFlatSet.GetRange(const Low, High: Integer; const Value: Boolean): Boolean; -var - I: Integer; -begin - if not Value and (High >= FBits.Size) then - begin - Result := False; - Exit; - end; - for I := Low to Min(High, FBits.Size - 1) do - if FBits[I] <> Value then - begin - Result := False; - Exit; - end; - Result := True; -end; - -procedure TJclFlatSet.SetBit(const Idx: Integer; const Value: Boolean); -begin - FBits[Idx] := Value; -end; - -//== { TJclSparseFlatSet } =================================================== - -destructor TJclSparseFlatSet.Destroy; -begin - Clear; - inherited Destroy; -end; - -procedure TJclSparseFlatSet.Clear; -var - F: Integer; -begin - if FSetList <> nil then - begin - for F := 0 to FSetListEntries - 1 do - if FSetList^[F] <> nil then - Dispose(PDelphiSet(FSetList^[F])); - FreeMem(FSetList, FSetListEntries * SizeOf(Pointer)); - FSetList := nil; - FSetListEntries := 0; - end; -end; - -procedure TJclSparseFlatSet.Invert; -var - F: Integer; -begin - for F := 0 to FSetListEntries - 1 do - if FSetList^[F] <> nil then - PDelphiSet(FSetList^[F])^ := CompleteDelphiSet - PDelphiSet(FSetList^[F])^; -end; - -function TJclSparseFlatSet.GetBit(const Idx: Integer): Boolean; -var - SetIdx: Integer; -begin - SetIdx := Idx shr 8; - Result := (SetIdx < FSetListEntries) and (FSetList^[SetIdx] <> nil) and - (Byte(Idx and $FF) in PDelphiSet(FSetList^[SetIdx])^); -end; - -procedure TJclSparseFlatSet.SetBit(const Idx: Integer; const Value: Boolean); -var - I, SetIdx: Integer; - S: PDelphiSet; -begin - SetIdx := Idx shr 8; - if SetIdx >= FSetListEntries then - if Value then - begin - I := FSetListEntries; - FSetListEntries := SetIdx + 1; - ReallocMem(FSetList, FSetListEntries * SizeOf(Pointer)); - FillChar(FSetList^[I], (FSetListEntries - I) * SizeOf(Pointer), #0); - end - else - Exit; - S := FSetList^[SetIdx]; - if S = nil then - if Value then - begin - New(S); - S^ := []; - FSetList^[SetIdx] := S; - end - else - Exit; - Include(S^, Byte(Idx and $FF)); -end; - -procedure TJclSparseFlatSet.SetRange(const Low, High: Integer; const Value: Boolean); -var - I, LowSet, HighSet: Integer; - - procedure SetValue(const S: TDelphiSet; const SetIdx: Integer); - var - D: PDelphiSet; - begin - D := FSetList^[SetIdx]; - if D = nil then - begin - if Value then - begin - New(D); - D^ := S; - FSetList^[SetIdx] := D; - end; - end - else - if Value then - D^ := D^ + S - else - D^ := D^ - S; - end; - -begin - LowSet := Low shr 8; - HighSet := High shr 8; - if HighSet >= FSetListEntries then - begin - I := FSetListEntries; - FSetListEntries := HighSet + 1; - ReallocMem(FSetList, FSetListEntries * SizeOf(Pointer)); - FillChar(FSetList^[I], (FSetListEntries - I) * SizeOf(Pointer), #0); - end; - if LowSet = HighSet then - SetValue([Byte(Low and $FF)..Byte(High and $FF)], LowSet) - else - begin - SetValue([Byte(Low and $FF)..$FF], LowSet); - SetValue([0..Byte(High and $FF)], HighSet); - for I := LowSet + 1 to HighSet - 1 do - SetValue(CompleteDelphiSet, I); - end; -end; - -function TJclSparseFlatSet.GetRange(const Low, High: Integer; const Value: Boolean): Boolean; -var - I: Integer; -begin - if not Value and (High >= FSetListEntries) then - begin - Result := False; - Exit; - end; - for I := Low to Min(High, FSetListEntries) do - if GetBit(I) <> Value then - begin - Result := False; - Exit; - end; - Result := True; -end; - -//=== Ranges ================================================================= - -function EnsureRange(const AValue, AMin, AMax: Integer): Integer; -begin - Result := AValue; - Assert(AMin <= AMax); - if Result < AMin then - Result := AMin; - if Result > AMax then - Result := AMax; -end; - -function EnsureRange(const AValue, AMin, AMax: Int64): Int64; -begin - Result := AValue; - Assert(AMin <= AMax); - if Result < AMin then - Result := AMin; - if Result > AMax then - Result := AMax; -end; - -function EnsureRange(const AValue, AMin, AMax: Double): Double; -begin - Result := AValue; - Assert(AMin <= AMax); - if Result < AMin then - Result := AMin; - if Result > AMax then - Result := AMax; -end; - -//=== Prime numbers ========================================================== - -const - PrimeCacheLimit = 65537; // 4K lookup table. Note: Sqr(65537) > MaxLongint - -var - PrimeSet: TJclFlatSet = nil; - -procedure InitPrimeSet; -var - I, J, MaxI, MaxJ : Integer; -begin - PrimeSet := TJclFlatSet.Create; - PrimeSet.SetRange(1, PrimeCacheLimit div 2, True); - PrimeSet.SetBit(0, False); // 1 is no prime - MaxI := Trunc(Sqrt(PrimeCacheLimit)); - I := 3; - repeat - if PrimeSet.GetBit(I div 2) then - begin - MaxJ := PrimeCacheLimit div I; - J := 3; - repeat - PrimeSet.SetBit((I*J) div 2, False); - Inc(J,2); - until J > MaxJ; - end; - Inc(I, 2); - until I > MaxI; -end; - -function IsPrimeTD(N: Cardinal): Boolean; -{ Trial Division Algorithm } -var - I, Max: Cardinal; - R: Extended; -begin - if N = 2 then - begin - Result := True; - Exit; - end; - if (N and 1) = 0 then //Zero or even - begin - Result := False; - Exit; - end; - if PrimeSet = nil then // initialize look-up table - InitPrimeSet; - if N <= PrimeCacheLimit then // do look-up - Result := PrimeSet.GetBit(N div 2) - else - begin // calculate - R := N; - Max := Round(Sqrt (R)); - if Max > PrimeCacheLimit then - begin - raise EJclMathError.CreateRes(@RsUnexpectedValue); - Exit; - end; - I := 1; - repeat - Inc(I,2); - if PrimeSet.GetBit(I div 2) then - if N mod I = 0 then - begin - Result := False; - Exit; - end; - until I >= Max; - Result := True; - end; -end; - -{$IFDEF CPU32} -// OF: need a complete rewrite for CPU64 -// OF: why is there less pop than push? - -{ Rabin-Miller Strong Primality Test } - -function IsPrimeRM(N: Cardinal): Boolean; assembler; -asm - // 32 --> EAX N - // <-- AL Result - TEST EAX,1 // Odd(N) ?? - JNZ @@1 - CMP EAX,2 // N == 2 ?? - SETE AL - RET -@@1: CMP EAX,73 - JBE @@C - PUSH ESI - PUSH EDI - PUSH EBX - PUSH EBP - PUSH EAX // save N as Param for @@5 - MOV EBP, EAX - DEC EBP // M == N -1, Exponent - MOV ECX,32 // calc remaining Bits of M and shift M' - MOV ESI,EBP -@@2: DEC ECX - SHL ESI,1 - JNC @@2 - PUSH ECX // save Bits as Param for @@5 - PUSH ESI // save M' as Param for @@5 - CMP EAX,08A8D7Fh // N >= 9080191 ?? - JAE @@3 -// now if (N < 9080191) and SPP(31, N) and SPP(73, N) then N is prime - MOV EAX,31 - CALL @@5 - JC @@4 - MOV EAX,73 - PUSH OFFSET @@4 - JMP @@5 -// now if (N < 4759123141) and SPP(2, N) and SPP(7, N) and SPP(61, N) then N is prime -@@3: MOV EAX,2 - CALL @@5 - JC @@4 - MOV EAX,7 - CALL @@5 - JC @@4 - MOV EAX,61 - CALL @@5 -@@4: SETNC AL - ADD ESP,4 * 3 - POP EBP - POP EBX - POP EDI - POP ESI - RET -// do a Strong Pseudo Prime Test -@@5: - MOV EBX,[ESP + 12] // N on stack - MOV ECX,[ESP + 8] // remaining Bits - MOV ESI,[ESP + 4] // M' - MOV EDI,EAX // T = b, temp. Base -@@6: DEC ECX - MUL EAX - DIV EBX - MOV EAX,EDX - SHL ESI,1 - JNC @@7 - MUL EDI - DIV EBX - AND ESI,ESI - MOV EAX,EDX -@@7: JNZ @@6 - CMP EAX,1 // b^((N -1)(2^s)) mod N == 1 mod N ?? - JE @@A -@@8: CMP EAX,EBP // b^((N -1)(2^s)) mod N == -1 mod N ?? - JE @@A - DEC ECX // second part to 2^s - JNG @@9 - MUL EAX - DIV EBX - CMP EDX,1 - MOV EAX,EDX - JNE @@8 -@@9: STC -@@A: RET -@@B: DB 3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73 -@@C: MOV ECX,19 - MOV EDX,OFFSET @@B -@@D: CMP AL,[EDX + ECX] - JE @@E - DEC ECX - JNL @@D -@@E: SETE AL -end; -{$ENDIF CPU32} - -function PrimeFactors(N: Cardinal): TDynCardinalArray; -var - I, L, Max: Cardinal; - R: Extended; -begin - SetLength(Result, 0); - if N <= 1 then - Exit - else - begin - if PrimeSet = nil then - InitPrimeSet; - L := 0; - R := N; - R := Sqrt(R); - Max := Round(R); // only one factor can be > Sqrt (N) - if N mod 2 = 0 then // test even at first - begin // 2 is a prime factor - Inc(L); - SetLength(Result, L); - Result[L - 1] := 2; - repeat - N := N div 2; - if N = 1 then // no more factors - Exit; - until N mod 2 <> 0; - end; - I := 3; // test all odd factors - repeat - if (N mod I = 0) and IsPrime(I) then - begin // I is a prime factor - Inc(L); - SetLength(Result, L); - Result[L - 1] := I; - repeat - N := N div I; - if N = 1 then // no more factors - Exit; - until N mod I <> 0; - end; - Inc(I, 2); - until I > Max; - Inc(L); // final factor (> Sqrt(N)) - SetLength(Result, L); - Result[L - 1] := N; - end; -end; - -function IsPrimeFactor(const F, N: Cardinal): Boolean; -begin - Result := (N mod F = 0) and IsPrime(F); -end; - -function IsRelativePrime(const X, Y: Cardinal): Boolean; -begin - Result := GCD(X, Y) = 1; -end; - -procedure SetPrimalityTest(const Method: TPrimalityTestMethod); -begin - case Method of - ptTrialDivision: - IsPrime := IsPrimeTD; - {$IFDEF CPU32} - ptRabinMiller: - IsPrime := IsPrimeRM; - {$ENDIF CPU32} - end; -end; - -{$IFDEF CPU32} - -//=== Floating point value classification ==================================== - -type - TC3C2C0 = 0..6; - -const - FPClasses: array [TC3C2C0] of TFloatingPointClass = - ( - fpInvalid, - fpNaN, - fpNormal, - fpInfinite, - fpZero, - fpEmpty, - fpDenormal - ); - -// _C3C2C0 returns the set of condition code flags C0, C2, and C3 of the FPU status word -// to indicate the class of value or number in register ST(0) as follows: -// C0 in Bit 0 of EAX -// C2 in Bit 1 of EAX -// C3 in Bit 2 of EAX - -function _C3C2C0: TC3C2C0; assembler; -// In: ST(0) Value to examine -asm - FXAM - XOR EDX, EDX - FNSTSW AX - FFREE ST(0) - FINCSTP - BT EAX, 14 // C3 - RCL EDX, 1 - BT EAX, 10 // C2 - RCL EDX, 1 - BT EAX, 8 // C0 - RCL EDX, 1 - MOV EAX, EDX -end; - -function C3C2C0(const Value: Single): TC3C2C0; overload; assembler; -asm - FLD Value - CALL _C3C2C0 -end; - -function C3C2C0(const Value: Double): TC3C2C0; overload; assembler; -asm - FLD Value - CALL _C3C2C0 -end; - -{$IFDEF SUPPORTS_EXTENDED} -function C3C2C0(const Value: Extended): TC3C2C0; overload; assembler; -asm - FLD Value - CALL _C3C2C0 -end; -{$ENDIF SUPPORTS_EXTENDED} - -function FloatingPointClass(const Value: Single): TFloatingPointClass; overload; -begin - Result := FPClasses[C3C2C0(Value)]; -end; - -function FloatingPointClass(const Value: Double): TFloatingPointClass; overload; -begin - Result := FPClasses[C3C2C0(Value)]; -end; - -{$IFDEF SUPPORTS_EXTENDED} -function FloatingPointClass(const Value: Extended): TFloatingPointClass; overload; -begin - Result := FPClasses[C3C2C0(Value)]; -end; -{$ENDIF SUPPORTS_EXTENDED} - -//=== NaN and Infinity support =============================================== - -function IsInfinite(const Value: Single): Boolean; overload; -begin - Result := FloatingPointClass(Value) = fpInfinite; -end; - -function IsInfinite(const Value: Double): Boolean; overload; -begin - Result := FloatingPointClass(Value) = fpInfinite; -end; - -{$IFDEF SUPPORTS_EXTENDED} -function IsInfinite(const Value: Extended): Boolean; overload; -begin - Result := FloatingPointClass(Value) = fpInfinite; -end; -{$ENDIF SUPPORTS_EXTENDED} - -const - sSignBit = 31; - dSignBit = 63; - xSignBit = 79; - -type - TSingleBits = set of 0..sSignBit; - TDoubleBits = set of 0..dSignBit; - TExtendedBits = set of 0..xSignBit; - - sFractionBits = 0..22; // Single type fraction bits - dFractionBits = 0..51; // Double type fraction bits - xFractionBits = 0..62; // Extended type fraction bits - - sExponentBits = 23..sSignBit-1; - dExponentBits = 52..dSignBit-1; - xExponentBits = 64..xSignBit-1; - - {$IFNDEF FPC} - QWord = Int64; - {$ENDIF ~FPC} - - PExtendedRec = ^TExtendedRec; - TExtendedRec = packed record - Significand: QWord; - Exponent: Word; - end; - -const - ZeroTag = $3FFFFF; - InvalidTag = TNaNTag($80000000); - NaNTagMask = $3FFFFF; - - sNaNQuietFlag = High(sFractionBits); - dNaNQuietFlag = High(dFractionBits); - xNaNQuietFlag = High(xFractionBits); - - dNaNTagShift = High(dFractionBits) - High(sFractionBits); - xNaNTagShift = High(xFractionBits) - High(sFractionBits); - - sNaNBits = $7F800000; - dNaNBits = $7FF0000000000000; - - sQuietNaNBits = sNaNBits or (1 shl sNaNQuietFlag); - dQuietNaNBits = dNaNBits or (Int64(1) shl dNaNQuietFlag); - -function IsNaN(const Value: Single): Boolean; overload; -begin - Result := FloatingPointClass(Value) = fpNaN; -end; - -function IsNaN(const Value: Double): Boolean; overload; -begin - Result := FloatingPointClass(Value) = fpNaN; -end; - -{$IFDEF SUPPORTS_EXTENDED} -function IsNaN(const Value: Extended): Boolean; overload; -begin - Result := FloatingPointClass(Value) = fpNaN; -end; -{$ENDIF SUPPORTS_EXTENDED} - -procedure CheckNaN(const Value: Single); overload; -var - SaveExMask: T8087Exceptions; -begin - SaveExMask := Mask8087Exceptions([emInvalidOp]); - try - if FloatingPointClass(Value) <> fpNaN then - raise EJclMathError.CreateRes(@RsNoNaN); - finally - SetMasked8087Exceptions(SaveExMask); - end; -end; - -procedure CheckNaN(const Value: Double); overload; -var - SaveExMask: T8087Exceptions; -begin - SaveExMask := Mask8087Exceptions([emInvalidOp]); - try - if FloatingPointClass(Value) <> fpNaN then - raise EJclMathError.CreateRes(@RsNoNaN); - finally - SetMasked8087Exceptions(SaveExMask); - end; -end; - -{$IFDEF SUPPORTS_EXTENDED} -procedure CheckNaN(const Value: Extended); overload; -var - SaveExMask: T8087Exceptions; -begin - SaveExMask := Mask8087Exceptions([emInvalidOp]); - try - if FloatingPointClass(Value) <> fpNaN then - raise EJclMathError.CreateRes(@RsNoNaN); - finally - SetMasked8087Exceptions(SaveExMask); - end; -end; -{$ENDIF SUPPORTS_EXTENDED} - -function GetNaNTag(const NaN: Single): TNaNTag; -var - Temp: Integer; -begin - CheckNaN(NaN); - Temp := PLongint(@NaN)^ and NaNTagMask; - if sSignBit in TSingleBits(NaN) then - Result := -Temp - else - if Temp = ZeroTag then - Result := 0 - else - Result := Temp; -end; - -function GetNaNTag(const NaN: Double): TNaNTag; -var - Temp: Integer; -begin - CheckNaN(NaN); - Temp := (PInt64(@NaN)^ shr dNaNTagShift) and NaNTagMask; - {$IFDEF FPC} - if Int64(NaN) < 0 then - {$ELSE ~FPC} - if dSignBit in TDoubleBits(NaN) then - {$ENDIF ~FPC} - Result := -Temp - else - if Temp = ZeroTag then - Result := 0 - else - Result := Temp; -end; - -{$IFDEF SUPPORTS_EXTENDED} -function GetNaNTag(const NaN: Extended): TNaNTag; -var - Temp: Integer; -begin - CheckNaN(NaN); - Temp := (PExtendedRec(@NaN)^.Significand shr xNaNTagShift) and NaNTagMask; - {$IFDEF FPC} - if (TExtendedRec(NaN).Exponent and $8000) <> 0 then - {$ELSE ~FPC} - if xSignBit in TExtendedBits(NaN) then - {$ENDIF ~FPC} - Result := -Temp - else - if Temp = ZeroTag then - Result := 0 - else - Result := Temp; -end; -{$ENDIF SUPPORTS_EXTENDED} - -{$IFDEF MSWINDOWS} -// ExceptObjProc is not used in FPC -{$IFNDEF FPC} - -type - TRealType = (rtUndef, rtSingle, rtDouble, rtExtended); - - { ExceptionInformation record for FPU exceptions under WinNT, - where documented? } - PFPUExceptionInfo = ^TFPUExceptionInfo; - TFPUExceptionInfo = packed record - Unknown: array [0..7] of Longint; - ControlWord: Word; - Dummy1: Word; - StatusWord: Word; - Dummy2: Word; - TagWord: Word; - Dummy3: Word; - InstructionPtr: Pointer; - UnknownW: Word; - OpCode: Word; // Note: 5 most significant bits of first opcode byte - // (always 11011b) not stored in FPU opcode register - OperandPtr: Pointer; - UnknownL: Longint; - end; - - TExceptObjProc = function(P: PExceptionRecord): Exception; - -var - PrevExceptObjProc: TExceptObjProc; - ExceptObjProcInitialized: Integer = 0; - -function GetExceptionObject(P: PExceptionRecord): Exception; -var - Tag: TNaNTag; - FPUExceptInfo: PFPUExceptionInfo; - OPtr: Pointer; - OType: TRealType; - - function GetOperandType(OpCode: Word): TRealType; - var - NNN: 0..7; - begin - Result := rtUndef; - NNN := (Lo(OpCode) shr 3) and 7; // NNN field of ModR/M byte - if Lo(OpCode) <= $BF then - case Hi(OpCode) of // 3 least significant bits of first opcode byte - 0: - Result := rtSingle; - 1: - if NNN < 4 then - Result := rtSingle; - // Extended signaling NaNs don't cause exceptions on FLD/FST(P) ?! - 3: - if NNN = 5 then - Result := rtExtended; - 4: - Result := rtDouble; - 5: - if NNN = 0 then - Result := rtDouble; - end; - end; - -begin - Tag := InvalidTag; // shut up compiler warning - OType := rtUndef; - if P^.ExceptionCode = STATUS_FLOAT_INVALID_OPERATION then - begin - FPUExceptInfo := @P^.ExceptionInformation; - OPtr := FPUExceptInfo^.OperandPtr; - OType := GetOperandType(FPUExceptInfo^.OpCode); - case OType of - rtSingle: - Tag := GetNaNTag(PSingle(OPtr)^); - rtDouble: - Tag := GetNaNTag(PDouble(OPtr)^); - rtExtended: - Tag := GetNaNTag(PExtended(OPtr)^); - end; - end; - - if OType = rtUndef then - Result := PrevExceptObjProc(P) - else - Result := EJclNaNSignal.Create(Tag); -end; - -procedure InitExceptObjProc; -begin - if LockedExchange(ExceptObjProcInitialized, 1) = 0 then - if Win32Platform = VER_PLATFORM_WIN32_NT then - {$IFDEF RTL200_UP} // Delphi 2009+ - PrevExceptObjProc := InterlockedExchangePointer(ExceptObjProc, @GetExceptionObject); - {$ELSE} - PrevExceptObjProc := Pointer(InterlockedExchange(Integer(ExceptObjProc), Integer(@GetExceptionObject))); - {$ENDIF RTL200_UP} -end; -{$ENDIF ~FPC} -{$ENDIF MSWINDOWS} - -procedure CheckTag(Tag: TNaNTag); -begin - if (Tag < LowValidNaNTag) or (Tag > HighValidNaNTag) then - raise EJclMathError.CreateResFmt(@RsNaNTagError, [Tag]); -end; - -procedure MakeQuietNaN(var X: Single; Tag: TNaNTag); -var - Bits: LongWord; -begin - CheckTag(Tag); - if Tag = 0 then - Bits := ZeroTag or sQuietNaNBits - else - Bits := Abs(Tag) or sQuietNaNBits; - if Tag < 0 then - Include(TSingleBits(Bits), sSignBit); - PLongWord(@X)^ := Bits; -end; - -procedure MakeQuietNaN(var X: Double; Tag: TNaNTag); -var - Bits: Int64; -begin - CheckTag(Tag); - if Tag = 0 then - Bits := ZeroTag - else - Bits := Abs(Tag); - PInt64(@X)^ := (Bits shl dNaNTagShift) or dQuietNaNBits; - if Tag < 0 then - {$IFDEF FPC} - QWord(X) := QWord(X) or (1 shl dSignBit); - {$ELSE ~FPC} - Include(TDoubleBits(X), dSignBit); - {$ENDIF ~FPC} -end; - -{$IFDEF SUPPORTS_EXTENDED} -procedure MakeQuietNaN(var X: Extended; Tag: TNaNTag); -const - QuietNaNSignificand = $C000000000000000; - QuietNaNExponent = $7FFF; -var - Bits: Int64; -begin - CheckTag(Tag); - if Tag = 0 then - Bits := ZeroTag - else - Bits := Abs(Tag); - TExtendedRec(X).Significand := (Bits shl xNaNTagShift) or QuietNaNSignificand; - TExtendedRec(X).Exponent := QuietNaNExponent; - if Tag < 0 then - {$IFDEF FPC} - TExtendedRec(X).Exponent := TExtendedRec(X).Exponent or $8000; - {$ELSE ~FPC} - Include(TExtendedBits(X), xSignBit); - {$ENDIF ~FPC} -end; -{$ENDIF SUPPORTS_EXTENDED} - -procedure MakeSignalingNaN(var X: Single; Tag: TNaNTag); -begin - {$IFDEF MSWINDOWS} - {$IFNDEF FPC} - InitExceptObjProc; - {$ENDIF ~FPC} - {$ENDIF MSWINDOWS} - MakeQuietNaN(X, Tag); - Exclude(TSingleBits(X), sNaNQuietFlag); -end; - -procedure MakeSignalingNaN(var X: Double; Tag: TNaNTag); -begin - {$IFDEF MSWINDOWS} - {$IFNDEF FPC} - InitExceptObjProc; - {$ENDIF ~FPC} - {$ENDIF MSWINDOWS} - {$IFDEF FPC} - MakeQuietNaN(X, Tag); - QWord(X) := QWord(X) and not (1 shl dNaNQuietFlag); - {$ELSE ~FPC} - MakeQuietNaN(X, Tag); - Exclude(TDoubleBits(X), dNaNQuietFlag); - {$ENDIF ~FPC} -end; - -{$IFDEF SUPPORTS_EXTENDED} -procedure MakeSignalingNaN(var X: Extended; Tag: TNaNTag); -begin - {$IFDEF FPC} - MakeQuietNaN(X, Tag); - TExtendedRec(X).Significand := TExtendedRec(X).Significand and not (1 shl xNaNQuietFlag); - {$ELSE ~FPC} - {$IFDEF MSWINDOWS} - InitExceptObjProc; - {$ENDIF MSWINDOWS} - MakeQuietNaN(X, Tag); - Exclude(TExtendedBits(X), xNaNQuietFlag); - {$ENDIF ~FPC} -end; -{$ENDIF SUPPORTS_EXTENDED} - -procedure MineSingleBuffer(var Buffer; Count: Integer; StartTag: TNaNTag); -var - Tag, StopTag: TNaNTag; - P: PLongint; -begin - {$IFDEF MSWINDOWS} - {$IFNDEF FPC} - InitExceptObjProc; - {$ENDIF ~FPC} - {$ENDIF MSWINDOWS} - StopTag := StartTag + Count - 1; - CheckTag(StartTag); - CheckTag(StopTag); - P := @Buffer; - for Tag := StartTag to StopTag do - begin - if Tag > 0 then - P^ := sNaNBits or Tag - else - if Tag < 0 then - P^ := sNaNBits or Longint($80000000) or -Tag - else - P^ := sNaNBits or ZeroTag; - Inc(P); - end; -end; - -procedure MineDoubleBuffer(var Buffer; Count: Integer; StartTag: TNaNTag); -var - Tag, StopTag: TNaNTag; - P: PInt64; -begin - {$IFDEF MSWINDOWS} - {$IFNDEF FPC} - InitExceptObjProc; - {$ENDIF ~FPC} - {$ENDIF MSWINDOWS} - StopTag := StartTag + Count - 1; - CheckTag(StartTag); - CheckTag(StopTag); - P := @Buffer; - for Tag := StartTag to StopTag do - begin - if Tag > 0 then - P^ := dNaNBits or (Int64(Tag) shl dNaNTagShift) - else - if Tag < 0 then - P^ := dNaNBits or $8000000000000000 or (Int64(-Tag) shl dNaNTagShift) - else - P^ := dNaNBits or (Int64(ZeroTag) shl dNaNTagShift); - Inc(P); - end; -end; - -function MinedSingleArray(Length: Integer): TDynSingleArray; -begin - SetLength(Result, Length); - MineSingleBuffer(Result[0], Length, 0); -end; - -function MinedDoubleArray(Length: Integer): TDynDoubleArray; -begin - SetLength(Result, Length); - MineDoubleBuffer(Result[0], Length, 0); -end; - -function IsSpecialValue(const X: Float): Boolean; -begin - Result := IsNaN(X) or IsInfinite(X); -end; - -//=== { EJclNaNSignal } ====================================================== - -constructor EJclNaNSignal.Create(ATag: TNaNTag; Dummy: Boolean); -begin - FTag := ATag; - CreateResFmt(@RsNaNSignal, [ATag]); -end; - -{$ENDIF CPU32} - -//=== { TJclRational } ======================================================= - -constructor TJclRational.Create(const Numerator: Integer; const Denominator: Integer); -begin - inherited Create; - Assign(Numerator, Denominator); -end; - -constructor TJclRational.Create; -begin - inherited Create; - AssignZero; -end; - -constructor TJclRational.Create(const R: Float); -begin - inherited Create; - Assign(R); -end; - -procedure TJclRational.Simplify; -var - I: Integer; -begin - if FN < 0 then - begin - FT := -FT; - FN := -FN; - end; - - if (FT = 1) or (FN = 1) or (FT = 0) then - Exit; - - I := GCD(System.Abs(FT), FN); - FT := FT div I; - FN := FN div I; -end; - -procedure TJclRational.Assign(const Numerator: Integer; const Denominator: Integer); -begin - if Denominator = 0 then - raise EJclMathError.CreateRes(@RsInvalidRational); - FT := Numerator; - FN := Denominator; - if FN <> 1 then - Simplify; -end; - -procedure TJclRational.Assign(const R: TJclRational); -begin - FT := R.FT; - FN := R.FN; -end; - -procedure TJclRational.Assign(const R: Float); -var - T: TJclRational; - Z: Integer; - - function CalcFrac(const R: Float; const Level: Integer): TJclRational; - var - I: Float; - Z: Integer; - begin - if IsFloatZero(R) or (Level = 12) then // 0 (if Level = 12 we get an approximation) - Result := TJclRational.Create - else - if FloatsEqual(R, 1.0) then // 1 - begin - Result := TJclRational.Create; - Result.AssignOne; - end - else - if IsFloatZero(Frac(R * 1E8)) then // terminating decimal (<8) - Result := TJclRational.Create(Trunc(R * 1E8), 100000000) - else - begin // recursive process - I := 1.0 / R; - Result := CalcFrac(Frac(I), Level + 1); - Z := Trunc(I); - Result.Add(Z); - Result.Reciprocal; - end; - end; - -begin - T := CalcFrac(Frac(R), 1); - try - Z := Trunc(R); - T.Add(Z); - Assign(T); - finally - T.Free; - end; -end; - -procedure TJclRational.AssignOne; -begin - FT := 1; - FN := 1; -end; - -procedure TJclRational.AssignZero; -begin - FT := 0; - FN := 1; -end; - -function TJclRational.IsEqual(const Numerator: Integer; const Denominator: Integer): Boolean; -var - R: TJclRational; -begin - R := TJclRational.Create(Numerator, Denominator); - Result := IsEqual(R); - R.Free; -end; - -function TJclRational.IsEqual(const R: TJclRational): Boolean; -begin - Result := (FT = R.FT) and (FN = R.FN); -end; - -function TJclRational.IsEqual(const R: Float): Boolean; -begin - Result := FloatsEqual(R, GetAsFloat); -end; - -function TJclRational.IsOne: Boolean; -begin - Result := (FT = 1) and (FN = 1); -end; - -function TJclRational.IsZero: Boolean; -begin - Result := FT = 0; -end; - -function TJclRational.Duplicate: TJclRational; -begin - Result := TJclRational.Create(FT, FN); -end; - -procedure TJclRational.SetAsFloat(const R: Float); -begin - Assign(R); -end; - -procedure TJclRational.SetAsString(const S: string); -var - F: Integer; -begin - F := Pos('/', S); - if F = 0 then - Assign(StrToFloat(S)) - else - Assign(StrToInt(Trim(Copy(S,1,F - 1))), StrToInt(Trim(Copy(S, F + 1,Length(s))))); -end; - -function TJclRational.GetAsFloat: Float; -begin - Result := FT / FN; -end; - -function TJclRational.GetAsString: string; -begin - Result := IntToStr(FT) + '/' + IntToStr(FN); -end; - -procedure TJclRational.Add(const R: TJclRational); -begin - FT := FT * R.FN + R.FT * FN; - FN := FN * R.FN; - Simplify; -end; - -procedure TJclRational.Add(const V: Integer); -begin - Inc(FT, FN * V); -end; - -procedure TJclRational.Add(const V: Float); -begin - Assign(GetAsFloat + V); -end; - -procedure TJclRational.Subtract(const V: Float); -begin - Assign(GetAsFloat - V); -end; - -procedure TJclRational.Subtract(const R: TJclRational); -begin - FT := FT * R.FN - R.FT * FN; - FN := FN * R.FN; - Simplify; -end; - -procedure TJclRational.Subtract(const V: Integer); -begin - Dec(FT, FN * V); -end; - -procedure TJclRational.Negate; -begin - FT := -FT; -end; - -procedure TJclRational.Abs; -begin - FT := System.Abs(FT); - FN := System.Abs(FN); -end; - -function TJclRational.Sgn: Integer; -begin - if FT = 0 then - Result := 0 - else - begin - if JclMathSgn(FT) = JclMathSgn(FN) then - Result := 1 - else - Result := -1; - end; -end; - -procedure TJclRational.Divide(const V: Integer); -begin - if V = 0 then - raise EJclMathError.CreateRes(@RsDivByZero); - - FN := FN * V; - Simplify; -end; - -procedure TJclRational.Divide(const R: TJclRational); -begin - if R.FT = 0 then - raise EJclMathError.CreateRes(@RsRationalDivByZero); - - FT := FT * R.FN; - FN := FN * R.FT; - Simplify; -end; - -procedure TJclRational.Divide(const V: Float); -begin - Assign(GetAsFloat / V); -end; - -procedure TJclRational.Reciprocal; -begin - if FT = 0 then - raise EJclMathError.CreateRes(@RsRationalDivByZero); - - SwapOrd(FT, FN); -end; - -procedure TJclRational.Multiply(const R: TJclRational); -begin - FT := FT * R.FT; - FN := FN * R.FN; - Simplify; -end; - -procedure TJclRational.Multiply(const V: Integer); -begin - FT := FT * V; - Simplify; -end; - -procedure TJclRational.Multiply(const V: Float); -begin - Assign(GetAsFloat * V); -end; - -procedure TJclRational.Power(const R: TJclRational); -begin - Assign(JclMathPower(GetAsFloat, R.GetAsFloat)); -end; - -procedure TJclRational.Power(const V: Integer); -var - T, N: Extended; -begin - T := FT; - N := FN; - FT := Round(JclMathPower(T, V)); - FN := Round(JclMathPower(N, V)); -end; - -procedure TJclRational.Power(const V: Float); -begin - Assign(JclMathPower(FT, V) / JclMathPower(FN, V)); -end; - -procedure TJclRational.Sqrt; -begin - Assign(System.Sqrt(FT / FN)); -end; - -procedure TJclRational.Sqr; -begin - FT := System.Sqr(FT); - FN := System.Sqr(FN); -end; - -//=== Checksums ============================================================== - -// See also: CountBitsSet in JclLogic (bug fixing etc.) - similar algorithm! - -function GetParity(Buffer: TDynByteArray; Len: Integer): Boolean; -const - lu: packed array [0..15] of Byte = - (0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4); -var - b: Byte; - BitsSet: Cardinal; - Index: Cardinal; -begin - BitsSet := 0; - Index := 0; - if Len > Length(Buffer) then - Len := Length(Buffer); - while Len > 0 do - begin - b := Buffer[Index]; - // lower Nibble - Inc(BitsSet, lu[b and $0F]); - // upper Nibble - Inc(BitsSet, lu[b shr 4]); - - Dec(Len); - Inc(Index); - end; - - Result := (BitsSet mod 2) = 0; -end; - -function GetParity(Buffer: PByte; Len: Integer): Boolean; -const - lu: packed array [0..15] of Byte = - (0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4); -var - b: Byte; - BitsSet: Cardinal; -begin - BitsSet := 0; - while Len > 0 do - begin - b := PByte(Buffer)^; - // lower Nibble - Inc(BitsSet, lu[b and $0F]); - // upper Nibble - Inc(BitsSet, lu[b shr 4]); - - Dec(Len); - Inc(PByte(Buffer)); - end; - - Result := (BitsSet mod 2) = 0; -end; - -// CRC 16 - -function Crc16Corr(const Crc16Table: TCrc16Table; Crc: Word; N: Integer): Integer; -var - I: Integer; -// CrcX : Cardinal; -begin - // calculate Syndrome -// CrcX := CrC; - for I := 1 to Crc16Bytes do - // a 16 bit value shr 8 is a Byte, explictit type conversion to Byte adds an ASM instruction - Crc := Crc16Table[Crc shr (CRC16Bits - 8)] xor Word(Crc shl 8); - I := -1; - repeat - Inc(I); - if (Crc and 1) <> 0 then - Crc := ((Crc xor Crc16Table[1]) shr 1) or Crc16HighBit -// Crc16Table[1] = Crc16Polynom - else - Crc := (Crc shr 1) and NotCrc16HighBit; - until (Crc = Crc16HighBit) or (I = (N + Crc16Bytes) * 8); - if Crc <> Crc16HighBit then - Result := -1000 // not correctable - else - // I = No. of single faulty bit - // (high bit first, - // starting from lowest with CRC bits) - Result := I - Crc16Bits; - // Result < 0 faulty CRC-bit - // Result >= 0 No. of faulty data bit -end; - -function Crc16_P(const Crc16Table: TCrc16Table; X: PJclByteArray; N: Integer; Crc: Word): Word; -var - I: Integer; -begin - Result := Crc16DefaultStart; - for I := 0 to N - 1 do // The CRC Bytes are located at the end of the information - // a 16 bit value shr 8 is a Byte, explictit type conversion to Byte adds an ASM instruction - Result := Crc16Table[Result shr (CRC16Bits - 8)] xor Word((Result shl 8)) xor X[I]; - for I := 0 to Crc16Bytes - 1 do - begin - // a 16 bit value shr 8 is a Byte, explictit type conversion to Byte adds an ASM instruction - Result := Crc16Table[Result shr (CRC16Bits-8)] xor Word((Result shl 8)) xor (Crc shr (CRC16Bits-8)); - Crc := Word(Crc shl 8); - end; -end; - -function Crc16_P(X: PJclByteArray; N: Integer; Crc: Word): Word; -begin - Result := Crc16_P(Crc16DefaultTable, X, N, Crc); -end; - -function CheckCrc16_P(const Crc16Table: TCrc16Table; X: PJclByteArray; N: Integer; Crc: Word): Integer; -// checks and corrects a single bit in up to 2^15-16 Bit -> 2^12-2 = 4094 Byte -var - I, J: Integer; - C: Byte; -begin - Crc := Crc16_P(Crc16Table, X, N, Crc); - if Crc = 0 then - Result := 0 // No CRC-error - else - begin - J := Crc16Corr(Crc16Table, Crc, N); - if J < -(Crc16Bytes * 8 + 1) then - Result := -1 // non-correctable error (more than one wrong bit) - else - begin - if J < 0 then - Result := 1 // one faulty Bit in CRC itself - else - begin // Bit J is faulty - I := J and 7; // I <= 7 (faulty Bit in Byte) - C := 1 shl I; // C <= 128 - I := J shr 3; // I: Index of faulty Byte - X[N - 1 - I] := X[N - 1 - I] xor C; // correct faulty bit - Result := 1; // Correctable error - end; - end; - end; -end; - -function CheckCrc16_P(X: PJclByteArray; N: Integer; Crc: Word): Integer; -begin - Result := CheckCrc16_P(Crc16DefaultTable, X, N, Crc); -end; - -function Crc16(const Crc16Table: TCrc16Table; const X: array of Byte; N: Integer; Crc: Word): Word; -begin - Result := Crc16_P(Crc16Table, @X, N, Crc); -end; - -function Crc16(const X: array of Byte; N: Integer; Crc: Word): Word; -begin - Result := Crc16_P(Crc16DefaultTable, @X, N, Crc); -end; - -function CheckCrc16(const Crc16Table: TCrc16Table; var X: array of Byte; N: Integer; Crc: Word): Integer; -begin - Result := CheckCRC16_P(Crc16Table, @X, N, CRC); -end; - -function CheckCrc16(var X: array of Byte; N: Integer; Crc: Word): Integer; -begin - Result := CheckCRC16_P(Crc16DefaultTable, @X, N, CRC); -end; - -function Crc16_A(const Crc16Table: TCrc16Table; const X: array of Byte; Crc: Word): Word; -begin - Result := Crc16_P(Crc16Table, @X, Length(X), Crc); -end; - -function Crc16_A(const X: array of Byte; Crc: Word): Word; -begin - Result := Crc16_P(Crc16DefaultTable, @X, Length(X), Crc); -end; - -function CheckCrc16_A(const Crc16Table: TCrc16Table; var X: array of Byte; Crc: Word): Integer; -begin - Result := CheckCrc16_P(Crc16Table, @X, Length(X), Crc); -end; - -function CheckCrc16_A(var X: array of Byte; Crc: Word): Integer; -begin - Result := CheckCrc16_P(Crc16DefaultTable, @X, Length(X), Crc); -end; - -// The CRC Table can be generated like this: -// const Crc16Start0 = 0; !! - -function Crc16_Bitwise(const X: array of Byte; N: Integer; Crc: Word; Polynom: Word): Word; -const - Crc16Start0 = 0; //Generating the table -var - I, J: Integer; - Sr, SrHighBit: Word; - B: Byte; -begin - Sr := Crc16Start0; - SrHighBit := 0; - for I := 0 to N - 1 + Crc16Bytes do - begin - if I >= N then - begin - B := Crc shr (Crc16Bits - 8); - Crc := Crc shl 8; - end - else - B := X[I]; - for J := 1 to 8 do - begin - if SrHighBit <> 0 then - Sr := Sr xor Polynom; - SrHighBit := Sr and Crc16HighBit; - Sr := (Word (Sr shl 1)) or ((B shr 7) and 1); - B := Byte(B shl 1); - end; - end; - if SrHighBit <> 0 then - Sr := Sr xor Polynom; - Result := Sr; -end; - -procedure InitCrc16(Polynom, Start: Word; out Crc16Table: TCrc16Table); -var - X: array [0..0] of Byte; - I: Integer; -begin - for I := 0 to 255 do - begin - X[0] := I; - Crc16Table[I] := Crc16_Bitwise(X, 1, 0, Polynom); { only with crcstart=0 !!!!} - end; - Crc16DefaultStart := Start; -end; - -procedure InitCrc16(Polynom, Start: Word); -begin - InitCrc16(Polynom, Start, Crc16DefaultTable); -end; - -// CRC 32 - -function Crc32Corr(const Crc32Table: TCrc32Table; Crc: Cardinal; N: Integer): Integer; -var - I: Integer; -begin - // calculate Syndrome - for I := 1 to Crc32Bytes do - Crc := Crc32Table[Crc shr (CRC32Bits - 8)] xor (Crc shl 8); - I := -1; - repeat - Inc(I); - if (Crc and 1) <> 0 then - Crc := ((Crc xor Crc32Table[1]) shr 1) or Crc32HighBit -// Crc32Table[1] = Crc32Polynom - else - Crc := (Crc shr 1) and NotCrc32HighBit; - until (Crc = Crc32HighBit) or (I = (N + Crc32Bytes) * 8); - if Crc <> Crc32HighBit then - Result := -1000 // not correctable - else - // I = No. of single faulty bit - // (high bit first, - // starting from lowest with CRC bits) - Result := I - Crc32Bits; - // Result < 0 faulty CRC-bit - // Result >= 0 No. of faulty data bit -end; - -function Crc32_P(const Crc32Table: TCrc32Table; X: PJclByteArray; N: Integer; Crc: Cardinal): Cardinal; -var - I: Integer; -begin - Result := Crc32DefaultStart; - for I := 0 to N - 1 do // The CRC Bytes are located at the end of the information - // a 32 bit value shr 24 is a Byte, explictit type conversion to Byte adds an ASM instruction - Result := Crc32Table[Result shr (CRC32Bits-8)] xor (Result shl 8) xor X[I]; - for I := 0 to Crc32Bytes - 1 do - begin - // a 32 bit value shr 24 is a Byte, explictit type conversion to Byte adds an ASM instruction - Result := Crc32Table[Result shr (CRC32Bits-8)] xor (Result shl 8) xor (Crc shr (CRC32Bits-8)); - Crc := Crc shl 8; - end; -end; - -function Crc32_P(X: PJclByteArray; N: Integer; Crc: Cardinal): Cardinal; -begin - Result := Crc32_P(Crc32DefaultTable, X, N, Crc); -end; - -function CheckCrc32_P(const Crc32Table: TCrc32Table; X: PJclByteArray; N: Integer; Crc: Cardinal): Integer; -// checks and corrects a single bit in up to 2^31-32 Bit -> 2^28-4 = 268435452 Byte -var - I, J: Integer; - C: Byte; -begin - Crc := Crc32_P(Crc32Table, X, N, Crc); - if Crc = 0 then - Result := 0 // No CRC-error - else - begin - J := Crc32Corr(Crc32Table, Crc, N); - if J < -(Crc32Bytes * 8 + 1) then - Result := -1 // non-correctable error (more than one wrong bit) - else - begin - if J < 0 then - Result := 1 // one faulty Bit in CRC itself - else - begin // Bit J is faulty - I := J and 7; // I <= 7 (faulty Bit in Byte) - C := 1 shl I; // C <= 128 - I := J shr 3; // I: Index of faulty Byte - X[N - 1 - I] := X[N - 1 - I] xor C; // correct faulty bit - Result := 1; // Correctable error - end; - end; - end; -end; - -function CheckCrc32_P(X: PJclByteArray; N: Integer; Crc: Cardinal): Integer; -begin - Result := CheckCrc32_P(Crc32DefaultTable, X, N, Crc); -end; - -function Crc32(const Crc32Table: TCrc32Table; const X: array of Byte; N: Integer; Crc: Cardinal): Cardinal; -begin - Result := Crc32_P(Crc32Table, @X, N, Crc); -end; - -function Crc32(const X: array of Byte; N: Integer; Crc: Cardinal): Cardinal; -begin - Result := Crc32_P(Crc32DefaultTable, @X, N, Crc); -end; - -function CheckCrc32(const Crc32Table: TCrc32Table; var X: array of Byte; N: Integer; Crc: Cardinal): Integer; -begin - Result := CheckCRC32_P(Crc32Table, @X, N, CRC); -end; - -function CheckCrc32(var X: array of Byte; N: Integer; Crc: Cardinal): Integer; -begin - Result := CheckCRC32_P(Crc32DefaultTable, @X, N, CRC); -end; - -function Crc32_A(const Crc32Table: TCrc32Table; const X: array of Byte; Crc: Cardinal): Cardinal; -begin - Result := Crc32_P(Crc32Table, @X, Length(X), Crc); -end; - -function Crc32_A(const X: array of Byte; Crc: Cardinal): Cardinal; -begin - Result := Crc32_P(Crc32DefaultTable, @X, Length(X), Crc); -end; - -function CheckCrc32_A(const Crc32Table: TCrc32Table; var X: array of Byte; Crc: Cardinal): Integer; -begin - Result := CheckCrc32_P(Crc32Table, @X, Length(X), Crc); -end; - -function CheckCrc32_A(var X: array of Byte; Crc: Cardinal): Integer; -begin - Result := CheckCrc32_P(Crc32DefaultTable, @X, Length(X), Crc); -end; - -// The CRC Table can be generated like this: -// const Crc32Start0 = 0; !! - -function Crc32_Bitwise(const X: array of Byte; N: Integer; Crc: Cardinal; Polynom: Cardinal) : Cardinal; -const - Crc32Start0 = 0; //Generating the table -var - I, J: Integer; - Sr, SrHighBit: Cardinal; - B: Byte; -begin - Sr := Crc32Start0; - SrHighBit := 0; - for I := 0 to N - 1 + Crc32Bytes do - begin - if I >= N then - begin - B := Crc shr (Crc32Bits - 8); - Crc := Crc shl 8; - end - else - B := X[I]; - for J := 1 to 8 do - begin - if SrHighBit <> 0 then - Sr := Sr xor Polynom; - SrHighBit := Sr and Crc32HighBit; - Sr := (Sr shl 1) or ((B shr 7) and 1); - B := Byte(B shl 1); - end - end; - - if SrHighBit <> 0 then - Sr := Sr xor Polynom; - Result := Sr; -end; - -procedure InitCrc32(Polynom, Start: Cardinal; out Crc32Table: TCrc32Table); -var - X: array [0..0] of Byte; - I: Integer; -begin - for I := 0 to 255 do - begin - X[0] := I; - Crc32Table[I] := Crc32_Bitwise(X, 1, 0, Polynom); - end; - Crc32DefaultStart := Start; -end; - -procedure InitCrc32(Polynom, Start: Cardinal); -begin - InitCrc32(Polynom, Start, Crc32DefaultTable); -end; - -//=== complex numbers support ================================================ - -const - RectOne: TRectComplex = (Re: 1.0; Im: 0.0); - RectZero: TRectComplex = (Re: 0.0; Im: 0.0); - -var - RectComplexFormatStr: string = '%g + %gi'; - PolarComplexFormatStr: string = '%g e^%gi'; - -procedure SetRectComplexFormatStr(const S: string); -begin - RectComplexFormatStr := S; -end; - -procedure SetPolarComplexFormatStr(const S: string); -begin - PolarComplexFormatStr := S; -end; - -function ComplexToStr(const Z: TRectComplex): string; -begin - Result := Format(RectComplexFormatStr, [Z.Re, Z.Im]); -end; - -function ComplexToStr(const Z: TPolarComplex): string; -begin - Result := Format(PolarComplexFormatStr, [Z.Radius, Z.Angle]); -end; - -function RectComplex(const Re: Float; const Im: Float = 0): TRectComplex; -begin - Result.Re := Re; - Result.Im := Im; -end; - -function RectComplex(const Z: TPolarComplex): TRectComplex; -var - ASin, ACos: Float; -begin - {$IFDEF DEBUG} - Inc(ComplexTypeConversions); - {$ENDIF DEBUG} - JclMath.SinCos(Z.Angle, ASin, ACos); - Result.Re := Z.Radius * ACos; - Result.Im := Z.Radius * ASin; -end; - -function PolarComplex(const Radius: Float; const Angle: Float = 0): TPolarComplex; -begin - if Radius < 0 then - begin - Result.Radius := -Radius; - Result.Angle := Pi; - end - else - begin - Result.Radius := Radius; - Result.Angle := 0.0; - end; -end; - -function PolarComplex(const Z: TRectComplex): TPolarComplex; -begin - {$IFDEF DEBUG} - Inc(ComplexTypeConversions); - {$ENDIF DEBUG} - Result.Radius := Norm(Z); - Result.Angle := ArcTan2(Z.Im, Z.Re); -end; - -function Equal(const Z1, Z2: TRectComplex): Boolean; -begin - Result := (Z1.Re = Z2.Re) and (Z1.Im = Z2.Im); -end; - -function Equal(const Z1, Z2: TPolarComplex): Boolean; -begin - Result := (Z1.Radius = Z2.Radius) - and ((Z1.Radius = 0) or IsFloatZero(NormalizeAngle(Z1.Angle - Z2.Angle))); -end; - -function IsZero(const Z: TRectComplex): Boolean; -begin - Result := IsFloatZero(Z.Re) and IsFloatZero(Z.Im); -end; - -function IsZero(const Z: TPolarComplex): Boolean; -begin - Result := IsFloatZero(Z.Radius); -end; - -{$IFDEF CPU32} - -function IsInfinite(const Z: TRectComplex): Boolean; -begin - Result := IsInfinite(Z.Re) or IsInfinite(Z.Im); -end; - -function IsInfinite(const Z: TPolarComplex): Boolean; -begin - Result := IsInfinite(Z.Radius); -end; - -{$ENDIF CPU32} - -function Norm(const Z: TRectComplex): Float; -begin - Result := Sqrt(Sqr(Z.Re) + Sqr(Z.Im)); -end; - -function Norm(const Z: TPolarComplex): Float; -begin - Result := Z.Radius; -end; - -function AbsSqr(const Z: TRectComplex): Float; -begin - Result := Sqr(Z.Re) + Sqr(Z.Im); -end; - -function AbsSqr(const Z: TPolarComplex): Float; -begin - Result := Sqr(Z.Radius); -end; - -function Conjugate(const Z: TRectComplex): TRectComplex; -begin - Result.Re := Z.Re; - Result.Im := -Z.Im; -end; - -function Conjugate(const Z: TPolarComplex): TPolarComplex; -begin - Result.Radius := Z.Radius; - Result.Angle := -Z.Angle; -end; - -function Inv(const Z: TRectComplex): TRectComplex; -var - Denom: Float; -begin - Denom := Sqr(Z.Re) + Sqr(Z.Im); - Result.Re := Z.Re / Denom; - Result.Im := -Z.Im / Denom; -end; - -function Inv(const Z: TPolarComplex): TPolarComplex; -begin - Result.Radius := 1 / Z.Radius; - Result.Angle := - Z.Angle; -end; - -function Neg(const Z: TRectComplex): TRectComplex; -begin - Result.Re := -Z.Re; - Result.Im := -Z.Im; -end; - -function Neg(const Z: TPolarComplex): TPolarComplex; -begin - Result.Radius := Z.Radius; - Result.Angle := NormalizeAngle(Z.Angle + Pi); -end; - -function Sum(const Z1, Z2: TRectComplex): TRectComplex; -begin - Result.Re := Z1.Re + Z2.Re; - Result.Im := Z1.Im + Z2.Im; -end; - -function Sum(const Z: array of TRectComplex): TRectComplex; -var - I: Integer; -begin - Result := RectZero; - for I := Low(Z) to High(Z) do - begin - Result.Re := Result.Re + Z[I].Re; - Result.Im := Result.Im + Z[I].Im; - end; -end; - -function Diff(const Z1, Z2: TRectComplex): TRectComplex; -begin - Result.Re := Z1.Re - Z2.Re; - Result.Im := Z1.Im - Z2.Im; -end; - -function Product(const Z1, Z2: TRectComplex): TRectComplex; -begin - Result.Re := Z1.Re * Z2.Re - Z1.Im * Z2.Im; - Result.Im := Z1.Re * Z2.Im + Z1.Im * Z2.Re; -end; - -function Product(const Z1, Z2: TPolarComplex): TPolarComplex; -begin - Result.Radius := Z1.Radius * Z2.Radius; - Result.Angle := NormalizeAngle(Z1.Angle + Z2.Angle); -end; - -function Product(const Z: array of TPolarComplex): TPolarComplex; -var - I: Integer; -begin - Result.Radius := 1.0; - Result.Angle := 0; - for I := Low(Z) to High(Z) do - begin - Result.Radius := Result.Radius * Z[I].Radius; - Result.Angle := Result.Angle + Z[I].Angle; - end; - Result.Angle := NormalizeAngle(Result.Angle); -end; - - -function Quotient(const Z1, Z2: TRectComplex): TRectComplex; -var - Denom: Float; -begin - Denom := Sqr(Z2.Re) + Sqr(Z2.Im); - Result.Re := (Z1.Re * Z2.Re + Z1.Im * Z2.Im) / Denom; - Result.Im := (Z1.Im * Z2.Re - Z1.Re * Z2.Im) / Denom; -end; - -function Quotient(const Z1, Z2: TPolarComplex): TPolarComplex; -begin - Result.Radius := Z1.Radius / Z2.Radius; - Result.Angle := NormalizeAngle(Z1.Angle - Z2.Angle); -end; - -function Ln(const Z: TPolarComplex): TRectComplex; -begin - Result.Re := System.Ln(Z.Radius); - Result.Im := NormalizeAngle(Z.Angle); -end; - -function Exp(const Z: TRectComplex): TPolarComplex; -begin - Result.Radius := System.Exp(Z.Re); - Result.Angle := Z.Im; -end; - -function Power(const Z: TPolarComplex; const Exponent: Float): TPolarComplex; -begin - Result.Radius := JclMath.Power(Z.Radius, Exponent); - Result.Angle := NormalizeAngle(Exponent * Z.Angle); -end; - -function Power(const Z: TPolarComplex; const Exponent: TRectComplex): TPolarComplex; -begin - Result := Exp(Product(Exponent, Ln(Z))); -end; - -function PowerInt(const Z: TPolarComplex; const Exponent: Integer): TPolarComplex; -begin - Result.Radius := PowerInt(Z.Radius, Exponent); - Result.Angle := NormalizeAngle(Exponent * Z.Angle); -end; - -function Root(const Z: TPolarComplex; const K, N: Cardinal): TPolarComplex; -begin - Result.Radius := JclMath.Power(Z.Radius, 1.0 / N); - Result.Angle := NormalizeAngle((Z.Angle + K * TwoPi) / N); -end; - -//=== complex trigonometric functions ======================================== - -function Cos(const Z: TRectComplex): TRectComplex; -var - ACos, ASin: Float; -begin - JclMath.SinCos(Z.Re, ASin, ACos); - Result.Re := ACos * JclMath.CosH(Z.Im); - Result.Im := -ASin * JclMath.SinH(Z.Im); -end; - -function Sin(const Z: TRectComplex): TRectComplex; -var - ACos, ASin: Float; -begin - JclMath.SinCos(Z.Re, ASin, ACos); - Result.Re := ASin * JclMath.CosH(Z.Im); - Result.Im := ACos * JclMath.SinH(Z.Im); -end; - -function Tan(const Z: TRectComplex): TRectComplex; -var - Denom: Float; - ACos, ASin: Float; -begin - JclMath.SinCos(2.0 * Z.Re, ASin, ACos); - Denom := ACos + JclMath.CosH(2.0 * Z.Im); - Result.Re := ASin / Denom; - Result.Im := JclMath.SinH(2.0 * Z.Im) / Denom; -end; - -function Cot(const Z: TRectComplex): TRectComplex; -var - Denom: Float; - ACos, ASin: Float; -begin - JclMath.SinCos(2.0 * Z.Re, ASin, ACos); - Denom := JclMath.CosH(2.0 * Z.Im) - ACos; - Result.Re := ASin / Denom; - Result.Im := -JclMath.SinH(2.0 * Z.Im) / Denom; -end; - -function Sec(const Z: TRectComplex): TRectComplex; -begin - Result := Quotient(RectOne, Cos(Z)); -end; - -function Csc(const Z: TRectComplex): TRectComplex; -begin - Result := Quotient(RectOne, Sin(Z)); -end; - -//=== complex hyperbolic functions =========================================== - -function CosH(const Z: TRectComplex): TRectComplex; -var - ACos, ASin: Float; -begin - JclMath.SinCos(Z.Im, ASin, ACos); - Result.Re := JclMath.CosH(Z.Re) * ACos; - Result.Im := JclMath.SinH(Z.Re) * ASin; -end; - -function SinH(const Z: TRectComplex): TRectComplex; -var - ACos, ASin: Float; -begin - JclMath.SinCos(Z.Im, ASin, ACos); - Result.Re := JclMath.SinH(Z.Re) * ACos; - Result.Im := JclMath.CosH(Z.Re) * ASin; -end; - -function TanH(const Z: TRectComplex): TRectComplex; -var - Denom: Float; - ACos, ASin: Float; -begin - JclMath.SinCos(2.0 * Z.Im, ASin, ACos); - Denom := JclMath.CosH(2.0 * Z.Re) + ACos; - Result.Re := JclMath.SinH(2.0 * Z.Re) / Denom; - Result.Im := ASin / Denom; -end; - -function CotH(const Z: TRectComplex): TRectComplex; -var - Denom: Float; - ACos, ASin: Float; -begin - JclMath.SinCos(2.0 * Z.Im, ASin, ACos); - Denom := JclMath.CosH(2.0 * Z.Re) - ACos; - Result.Re := JclMath.SinH(2.0 * Z.Re) / Denom; - Result.Im := -ASin / Denom; -end; - -function SecH(const Z: TRectComplex): TRectComplex; -begin - Result := Quotient(RectOne, CosH(Z)); -end; - -function CscH(const Z: TRectComplex): TRectComplex; -begin - Result := Quotient(RectOne, SinH(Z)); -end; - -{$IFDEF SUPPORTS_CLASS_OPERATORS} - -{ TRectComplex } - -class operator TRectComplex.Implicit(const Value: Float): TRectComplex; -begin - Result := RectComplex(Value); -end; - -class operator TRectComplex.Equal(const Z1, Z2: TRectComplex): Boolean; -begin - Result := Equal(Z1, Z2); -end; - -class operator TRectComplex.NotEqual(const Z1, Z2: TRectComplex): Boolean; -begin - Result := not Equal(Z1, Z2); -end; - -class operator TRectComplex.Add(const Z1, Z2: TRectComplex): TRectComplex; -begin - Result := Sum(Z1, Z2); -end; - -class operator TRectComplex.Subtract(const Z1, Z2: TRectComplex): TRectComplex; -begin - Result := Diff(Z1, Z2); -end; - -class operator TRectComplex.Multiply(const Z1, Z2: TRectComplex): TRectComplex; -begin - Result := Product(Z1, Z2); -end; - -class operator TRectComplex.Divide(const Z1, Z2: TRectComplex): TRectComplex; -begin - Result := Quotient(Z1, Z2); -end; - -class operator TRectComplex.Negative(const Z: TRectComplex): TRectComplex; -begin - Result := Neg(Z); -end; - -class operator TRectComplex.Positive(const Z: TRectComplex): TRectComplex; -begin - Result := Z; -end; - -function TRectComplex.AsString: string; -begin - Result := ComplexToStr(Self); -end; - -function TRectComplex.Conjugate: TRectComplex; -begin - Result := JclMath.Conjugate(Self); -end; - -function TRectComplex.IsZero: Boolean; -begin - Result := JclMath.IsZero(Self); -end; - -function TRectComplex.IsInfinite: Boolean; -begin - {$IFDEF DELPHI64_TEMPORARY} - //IsInfinite is disabled for 64-bit, because BASM is not 64-bit compatible (see logmessage of public repo @3070) - System.Error(rePlatformNotImplemented); - Result := False; - {$ELSE ~DELPHI64_TEMPORARY} - Result := JclMath.IsInfinite(Self); - {$ENDIF ~DELPHI64_TEMPORARY} -end; - -{ TPolarComplex } - -class operator TPolarComplex.Implicit(const Value: Float): TPolarComplex; -begin - Result := PolarComplex(Value); -end; - -class operator TPolarComplex.Implicit(const Z: TPolarComplex): TRectComplex; -begin - Result := RectComplex(Z); -end; - -class operator TPolarComplex.Implicit(const Z: TRectComplex): TPolarComplex; -begin - Result := PolarComplex(Z); -end; - -{$IFNDEF CPPBUILDER} -class operator TPolarComplex.Explicit(const Z: TPolarComplex): TRectComplex; -begin - Result := RectComplex(Z); -end; - -class operator TPolarComplex.Explicit(const Z: TRectComplex): TPolarComplex; -begin - Result := PolarComplex(Z); -end; -{$ENDIF CPPBUILDER} - -class operator TPolarComplex.Equal(const Z1, Z2: TPolarComplex): Boolean; -begin - Result := Equal(Z1, Z2); -end; - -class operator TPolarComplex.NotEqual(const Z1, Z2: TPolarComplex): Boolean; -begin - Result := not Equal(Z1, Z2); -end; - -class operator TPolarComplex.Add(const Z1, Z2: TPolarComplex): TRectComplex; -begin - Result := Sum(Z1, Z2); -end; - -class operator TPolarComplex.Subtract(const Z1, Z2: TPolarComplex): TRectComplex; -begin - Result := Diff(Z1, Z2); -end; - -class operator TPolarComplex.Multiply(const Z1, Z2: TPolarComplex): TPolarComplex; -begin - Result := Product(Z1, Z2); -end; - -class operator TPolarComplex.Divide(const Z1, Z2: TPolarComplex): TPolarComplex; -begin - Result := Quotient(Z1, Z2); -end; - -class operator TPolarComplex.Negative(const Z: TPolarComplex): TPolarComplex; -begin - Result := Neg(Z); -end; - -class operator TPolarComplex.Positive(const Z: TPolarComplex): TPolarComplex; -begin - Result := Z; -end; - -function TPolarComplex.AsString: string; -begin - Result := ComplexToStr(Self); -end; - -function TPolarComplex.Conjugate: TPolarComplex; -begin - Result := JclMath.Conjugate(Self); -end; - -function TPolarComplex.IsZero: Boolean; -begin - Result := JclMath.IsZero(Self); -end; - -function TPolarComplex.IsInfinite: Boolean; -begin - {$IFDEF DELPHI64_TEMPORARY} - //IsInfinite is disabled for 64-bit, because BASM is not 64-bit compatible (see logmessage of public repo @3070) - System.Error(rePlatformNotImplemented); - Result := False; - {$ELSE ~DELPHI64_TEMPORARY} - Result := JclMath.IsInfinite(Self); - {$ENDIF ~DELPHI64_TEMPORARY} -end; - -function TPolarComplex.Power(const Exponent: TRectComplex): TPolarComplex; -begin - Result := JclMath.Power(Self, Exponent); -end; - -function TPolarComplex.Power(const Exponent: Float): TPolarComplex; -begin - Result := JclMath.Power(Self, Exponent); -end; - -function TPolarComplex.Power(const Exponent: Integer): TPolarComplex; -begin - Result := JclMath.PowerInt(Self, Exponent); -end; - -function TPolarComplex.Root(const K, N: Cardinal): TPolarComplex; -begin - Result := JclMath.Root(Self, K, N); -end; - -{$ENDIF SUPPORTS_CLASS_OPERATORS} - -{$IFDEF UNITVERSIONING} -initialization - RegisterUnitVersion(HInstance, UnitVersioning); - -finalization - UnregisterUnitVersion(HInstance); -{$ENDIF UNITVERSIONING} - -end. +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclMath.pas. } +{ } +{ The Initial Developers of the Original Code are Clayton Collie, David Butler, ESB Consultancy, } +{ Jean Debord, Marcel van Brakel and Michael Schnell. } +{ Portions created by these individuals are Copyright (C) of these individuals. } +{ All Rights Reserved. } +{ } +{ Contributors: } +{ Ernesto Benestante } +{ Marcel van Brakel } +{ Aleksei Koudinov } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Matthias Thoma (mthoma) } +{ Mark Vaughan } +{ Andreas Hausladen } +{ unknown } +{ } +{**************************************************************************************************} +{ } +{ Various mathematics classes and routines. Includes prime numbers, rational numbers, } +{ complex numbers, generic floating point routines, hyperbolic and transcendenatal routines, } +{ NAN and INF support and more. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclMath; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, System.Classes, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, Classes, + {$ENDIF ~HAS_UNITSCOPE} + JclBase; + +{ Mathematical constants } + +const + Bernstein: Float = 0.2801694990238691330364364912307; // Bernstein constant + Cbrt2: Float = 1.2599210498948731647672106072782; // CubeRoot(2) + Cbrt3: Float = 1.4422495703074083823216383107801; // CubeRoot(3) + Cbrt10: Float = 2.1544346900318837217592935665194; // CubeRoot(10) + Cbrt100: Float = 4.6415888336127788924100763509194; // CubeRoot(100) + CbrtPi: Float = 1.4645918875615232630201425272638; // CubeRoot(PI) + Catalan: Float = 0.9159655941772190150546035149324; // Catalan constant + Pi: Float = 3.1415926535897932384626433832795; // PI + PiOn2: Float = 1.5707963267948966192313216916398; // PI / 2 + PiOn3: Float = 1.0471975511965977461542144610932; // PI / 3 + PiOn4: Float = 0.78539816339744830961566084581988; // PI / 4 + Sqrt2: Float = 1.4142135623730950488016887242097; // Sqrt(2) + Sqrt3: Float = 1.7320508075688772935274463415059; // Sqrt(3) + Sqrt5: Float = 2.2360679774997896964091736687313; // Sqrt(5) + Sqrt10: Float = 3.1622776601683793319988935444327; // Sqrt(10) + SqrtPi: Float = 1.7724538509055160272981674833411; // Sqrt(PI) + Sqrt2Pi: Float = 2.506628274631000502415765284811; // Sqrt(2 * PI) + TwoPi: Float = 6.283185307179586476925286766559; // 2 * PI + ThreePi: Float = 9.4247779607693797153879301498385; // 3 * PI + Ln2: Float = 0.69314718055994530941723212145818; // Ln(2) + Ln10: Float = 2.3025850929940456840179914546844; // Ln(10) + LnPi: Float = 1.1447298858494001741434273513531; // Ln(PI) + Log2: Float = 0.30102999566398119521373889472449; // Log10(2) + Log3: Float = 0.47712125471966243729502790325512; // Log10(3) + LogPi: Float = 0.4971498726941338543512682882909; // Log10(PI) + LogE: Float = 0.43429448190325182765112891891661; // Log10(E) + E: Float = 2.7182818284590452353602874713527; // Natural constant + hLn2Pi: Float = 0.91893853320467274178032973640562; // Ln(2*PI)/2 + inv2Pi: Float = 0.15915494309189533576888376337251436203445964574046; // 0.5 / Pi + TwoToPower63: Float = 9223372036854775808.0; // 2^63 + GoldenMean: Float = 1.618033988749894848204586834365638; // GoldenMean + EulerMascheroni: Float = 0.5772156649015328606065120900824; // Euler GAMMA + +const + MaxAngle: Float = 9223372036854775808.0; // 2^63 Rad + + {$IFDEF MATH_EXTENDED_PRECISION} + MaxTanH: Float = 5678.2617031470719747459655389854; // Ln(2^16384)/2 + MaxFactorial = 1754; + MaxFloatingPoint: Float = 1.189731495357231765085759326628E+4932; // 2^16384 + MinFloatingPoint: Float = 3.3621031431120935062626778173218E-4932; // 2^(-16382) + {$ENDIF MATH_EXTENDED_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + MaxTanH: Float = 354.89135644669199842162284618659; // Ln(2^1024)/2 + MaxFactorial = 170; + MaxFloatingPoint: Float = 1.797693134862315907729305190789E+308; // 2^1024 + MinFloatingPoint: Float = 2.2250738585072013830902327173324E-308; // 2^(-1022) + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_SINGLE_PRECISION} + MaxTanH: Float = 44.361419555836499802702855773323; // Ln(2^128)/2 + MaxFactorial = 33; + MaxFloatingPoint: Float = 3.4028236692093846346337460743177E+38; // 2^128 + MinFloatingPoint: Float = 1.1754943508222875079687365372222E-38; // 2^(-126) + {$ENDIF MATH_SINGLE_PRECISION} + +const + PiExt = 3.1415926535897932384626433832795; + RatioDegToRad : Extended = PiExt / 180.0; + RatioRadToDeg : Extended = 180.0 / PiExt; + RatioGradToRad : Extended = PiExt / 200.0; + RatioRadToGrad : Extended = 200.0 / PiExt; + RatioDegToGrad : Extended = 200.0 / 180.0; + RatioGradToDeg : Extended = 180.0 / 200.0; + +var + PrecisionTolerance: Float = 0.0000001; + EpsSingle: Single; + EpsDouble: Double; + {$IFDEF SUPPORTS_EXTENDED} + EpsExtended: Extended; + {$ENDIF SUPPORTS_EXTENDED} + Epsilon: Float; + ThreeEpsSingle: Single; + ThreeEpsDouble: Double; + {$IFDEF SUPPORTS_EXTENDED} + ThreeEpsExtended: Extended; + {$ENDIF SUPPORTS_EXTENDED} + ThreeEpsilon: Float; + +type + TPrimalityTestMethod = (ptTrialDivision {$IFDEF CPU32}, ptRabinMiller{$ENDIF CPU32}); + +// swaps 2 bytes +procedure SwapOrd(var X, Y: Integer); {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + +// converts double to hex +function DoubleToHex(const D: Double): string; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +// converts hex to double +function HexToDouble(const Hex: string): Double; + +// Converts degrees to radians. +{$IFDEF SUPPORTS_EXTENDED} +function DegToRad(const Value: Extended): Extended; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +{$ENDIF SUPPORTS_EXTENDED} +function DegToRad(const Value: Double): Double; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function DegToRad(const Value: Single): Single; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +procedure FastDegToRad; + +// Converts radians to degrees. +{$IFDEF SUPPORTS_EXTENDED} +function RadToDeg(const Value: Extended): Extended; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +{$ENDIF SUPPORTS_EXTENDED} +function RadToDeg(const Value: Double): Double; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function RadToDeg(const Value: Single): Single; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +procedure FastRadToDeg; + +// Converts grads to radians. +{$IFDEF SUPPORTS_EXTENDED} +function GradToRad(const Value: Extended): Extended; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +{$ENDIF SUPPORTS_EXTENDED} +function GradToRad(const Value: Double): Double; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function GradToRad(const Value: Single): Single; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +procedure FastGradToRad; + +// Converts radians to grads. +{$IFDEF SUPPORTS_EXTENDED} +function RadToGrad(const Value: Extended): Extended; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +{$ENDIF SUPPORTS_EXTENDED} +function RadToGrad(const Value: Double): Double; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function RadToGrad(const Value: Single): Single; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +procedure FastRadToGrad; + +// Converts degrees to grads. +{$IFDEF SUPPORTS_EXTENDED} +function DegToGrad(const Value: Extended): Extended; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +{$ENDIF SUPPORTS_EXTENDED} +function DegToGrad(const Value: Double): Double; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function DegToGrad(const Value: Single): Single; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +procedure FastDegToGrad; + +// Converts grads to degrees. +{$IFDEF SUPPORTS_EXTENDED} +function GradToDeg(const Value: Extended): Extended; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +{$ENDIF SUPPORTS_EXTENDED} +function GradToDeg(const Value: Double): Double; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function GradToDeg(const Value: Single): Single; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +procedure FastGradToDeg; + +{ Logarithmic } + +function LogBase10(X: Float): Float; +function LogBase2(X: Float): Float; +function LogBaseN(Base, X: Float): Float; + +{ Transcendental } + +function ArcCos(X: Float): Float; +function ArcCot(X: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function ArcCsc(X: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function ArcSec(X: Float): Float; +function ArcSin(X: Float): Float; +function ArcTan(X: Float): Float; +function ArcTan2(Y, X: Float): Float; +function Cos(X: Float): Float; overload; +function Cot(X: Float): Float; overload; +function Coversine(X: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function Csc(X: Float): Float; overload; +function Exsecans(X: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function Haversine(X: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function Sec(X: Float): Float; overload; +function Sin(X: Float): Float; overload; +procedure SinCos(X: Single; out Sin, Cos: Single); overload; +procedure SinCos(X: Double; out Sin, Cos: Double); overload; +{$IFDEF SUPPORTS_EXTENDED} +procedure SinCos(X: Extended; out Sin, Cos: Extended); overload; +{$ENDIF SUPPORTS_EXTENDED} +function Tan(X: Float): Float; overload; +function Versine(X: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + +{ Hyperbolic } + +function ArcCosH(X: Float): Float; +function ArcCotH(X: Float): Float; +function ArcCscH(X: Float): Float; +function ArcSecH(X: Float): Float; +function ArcSinH(X: Float): Float; +function ArcTanH(X: Float): Float; +function CosH(X: Float): Float; overload; +function CotH(X: Float): Float; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function CscH(X: Float): Float; overload; +function SecH(X: Float): Float; overload; +function SinH(X: Float): Float; overload; {IFDEF SUPPORTS_INLINE inline; ENDIF} +function TanH(X: Float): Float; overload; + +{ Coordinate conversion } + +function DegMinSecToFloat(const Degs, Mins, Secs: Float): Float; // obsolete (see JclUnitConv) +procedure FloatToDegMinSec(const X: Float; var Degs, Mins, Secs: Float); // obsolete (see JclUnitConv) + +{ Exponential } + +function Exp(const X: Float): Float; overload; +function Power(const Base, Exponent: Float): Float; overload; +function PowerInt(const X: Float; N: Integer): Float; overload; +function TenToY(const Y: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function TruncPower(const Base, Exponent: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function TwoToY(const Y: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + +{ Floating point numbers support routines } + +function IsFloatZero(const X: Float): Boolean; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function FloatsEqual(const X, Y: Float): Boolean; +function MaxFloat(const X, Y: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function MinFloat(const X, Y: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function ModFloat(const X, Y: Float): Float; +function RemainderFloat(const X, Y: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function SetPrecisionTolerance(NewTolerance: Float): Float; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +procedure SwapFloats(var X, Y: Float); {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +procedure CalcMachineEpsSingle; +procedure CalcMachineEpsDouble; +{$IFDEF SUPPORTS_EXTENDED} +procedure CalcMachineEpsExtended; +{$ENDIF SUPPORTS_EXTENDED} +procedure CalcMachineEps; +procedure SetPrecisionToleranceToEpsilon; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + +{ Miscellaneous } + +function Ackermann(const A, B: Integer): Integer; +function Ceiling(const X: Float): Integer; +function CommercialRound(const X: Float): Int64; +function Factorial(const N: Integer): Float; +function Fibonacci(const N: Integer): Integer; +function Floor(const X: Float): Integer; +function GCD(X, Y: Cardinal): Cardinal; +function ISqrt(const I: Smallint): Smallint; +function LCM(const X, Y: Cardinal): Cardinal; + +/// +/// Get the next multiple of a given multiplicator which is higher than +/// the number given. Example: Num = 21, Multiplicator = 5, Result is 25 +/// +function NearestHigherMultiple(Num, Multiplicator: Integer): Integer; overload; +/// +/// Get the next multiple of a given multiplicator which is higher than +/// the number given. Example: Num = 21, Multiplicator = 5, Result is 25 +/// +function NearestHigherMultiple(Num, Multiplicator: Int64): Int64; overload; +/// +/// Get the next multiple of a given multiplicator which is higher than +/// the number given. Example: Num = 21, Multiplicator = 5, Result is 25 +/// +function NearestHigherMultiple(Num: Float; Multiplicator: Integer): Integer; overload +/// +/// Get the next multiple of a given multiplicator which is higher than +/// the number given. Example: Num = 21, Multiplicator = 5, Result is 25 +/// +function NearestHigherMultiple(Num: Float; Multiplicator: Int64): Int64; overload; +/// +/// Get the next multiple of a given multiplicator which is lower than +/// the number given. Example: Num = 24, Multiplicator = 5, Result is 20 +/// +function NearestLowerMultiple(Num, Multiplicator: Integer): Integer; overload; +/// +/// Get the next multiple of a given multiplicator which is lower than +/// the number given. Example: Num = 24, Multiplicator = 5, Result is 20 +/// +function NearestLowerMultiple(Num, Multiplicator: Int64): Int64; overload; +/// +/// Get the next multiple of a given multiplicator which is lower than +/// the number given. Example: Num = 24, Multiplicator = 5, Result is 20 +/// +function NearestLowerMultiple(Num: Float; Multiplicator: Integer): Integer; overload; +/// +/// Get the next multiple of a given multiplicator which is lower than +/// the number given. Example: Num = 24, Multiplicator = 5, Result is 20 +/// +function NearestLowerMultiple(Num: Float; Multiplicator: Int64): Int64; overload; + +function NormalizeAngle(const Angle: Float): Float; +function Pythagoras(const X, Y: Float): Float; +function Sgn(const X: Float): Integer; +function Signe(const X, Y: Float): Float; + +{ Ranges } +function EnsureRange(const AValue, AMin, AMax: Integer): Integer; overload; +function EnsureRange(const AValue, AMin, AMax: Int64): Int64; overload; +function EnsureRange(const AValue, AMin, AMax: Double): Double; overload; + +{ Prime numbers } + +function IsRelativePrime(const X, Y: Cardinal): Boolean; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function IsPrimeTD(N: Cardinal): Boolean; +{$IFDEF CPU32} +function IsPrimeRM(N: Cardinal): Boolean; +{$ENDIF CPU32} +function IsPrimeFactor(const F, N: Cardinal): Boolean; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function PrimeFactors(N: Cardinal): TDynCardinalArray; + +var + IsPrime: function(N: Cardinal): Boolean = IsPrimeTD; + +procedure SetPrimalityTest(const Method: TPrimalityTestMethod); + +{ Floating point value classification } + +type + TFloatingPointClass = + ( + fpZero, // zero + fpNormal, // normal finite <> 0 + fpDenormal, // denormalized finite + fpInfinite, // infinite + fpNaN, // not a number + fpInvalid, // unsupported floating point format + fpEmpty // should not happen + ); + +const + Infinity = 1/0; // tricky + {$EXTERNALSYM Infinity} + NaN = 0/0; // tricky + {$EXTERNALSYM NaN} + NegInfinity = -Infinity; + {$EXTERNALSYM NegInfinity} + +{$IFDEF WIN64} +{$HPPEMIT 'static const double Infinity = 1.0 / 0.0;'} +{$HPPEMIT 'static const double NaN = 0.0 / 0.0;'} +{$HPPEMIT 'static const double NegInfinity = -1.0 / 0.0;'} +{$ELSE} +{$HPPEMIT 'static const Infinity = 1.0 / 0.0;'} +{$HPPEMIT 'static const NaN = 0.0 / 0.0;'} +{$HPPEMIT 'static const NegInfinity = -1.0 / 0.0;'} +{$ENDIF WIN64} + +{$IFDEF CPU32} + +function FloatingPointClass(const Value: Single): TFloatingPointClass; overload; +function FloatingPointClass(const Value: Double): TFloatingPointClass; overload; +{$IFDEF SUPPORTS_EXTENDED} +function FloatingPointClass(const Value: Extended): TFloatingPointClass; overload; +{$ENDIF SUPPORTS_EXTENDED} + +{ NaN and INF support } + +type + TNaNTag = type Integer; + +const + LowValidNaNTag = -$3FFFFF; + HighValidNaNTag = $3FFFFE; + +function IsInfinite(const Value: Single): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function IsInfinite(const Value: Double): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +{$IFDEF SUPPORTS_EXTENDED} +function IsInfinite(const Value: Extended): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +{$ENDIF SUPPORTS_EXTENDED} + +function IsNaN(const Value: Single): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function IsNaN(const Value: Double): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +{$IFDEF SUPPORTS_EXTENDED} +function IsNaN(const Value: Extended): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +{$ENDIF SUPPORTS_EXTENDED} + +function IsSpecialValue(const X: Float): Boolean; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + +procedure MakeQuietNaN(var X: Single; Tag: TNaNTag = 0); overload; +procedure MakeQuietNaN(var X: Double; Tag: TNaNTag = 0); overload; +{$IFDEF SUPPORTS_EXTENDED} +procedure MakeQuietNaN(var X: Extended; Tag: TNaNTag = 0); overload; +{$ENDIF SUPPORTS_EXTENDED} + +procedure MakeSignalingNaN(var X: Single; Tag: TNaNTag = 0); overload; +procedure MakeSignalingNaN(var X: Double; Tag: TNaNTag = 0); overload; +{$IFDEF SUPPORTS_EXTENDED} +procedure MakeSignalingNaN(var X: Extended; Tag: TNaNTag = 0); overload; +{$ENDIF SUPPORTS_EXTENDED} + +{ Mine*Buffer fills "Buffer" with consecutive tagged signaling NaNs. + + This allows for real number arrays which enforce initialization: any attempt + to load an uninitialized array element into the FPU will raise an exception + either of class EInvalidOp (Windows 9x/ME) or EJclNaNSignal (Windows NT). + + Under Windows NT it is thus possible to derive the violating array index from + the EJclNaNSignal object's Tag property. } + +procedure MineSingleBuffer(var Buffer; Count: Integer; StartTag: TNaNTag = 0); +procedure MineDoubleBuffer(var Buffer; Count: Integer; StartTag: TNaNTag = 0); + +function MinedSingleArray(Length: Integer): TDynSingleArray; +function MinedDoubleArray(Length: Integer): TDynDoubleArray; + +function GetNaNTag(const NaN: Single): TNaNTag; overload; +function GetNaNTag(const NaN: Double): TNaNTag; overload; +{$IFDEF SUPPORTS_EXTENDED} +function GetNaNTag(const NaN: Extended): TNaNTag; overload; +{$ENDIF SUPPORTS_EXTENDED} + +{$ENDIF CPU32} + +{ Set support } + +type + TJclASet = class(TObject) + public + function GetBit(const Idx: Integer): Boolean; virtual; abstract; + procedure SetBit(const Idx: Integer; const Value: Boolean); virtual; abstract; + procedure Clear; virtual; abstract; + procedure Invert; virtual; abstract; + function GetRange(const Low, High: Integer; const Value: Boolean): Boolean; virtual; abstract; + procedure SetRange(const Low, High: Integer; const Value: Boolean); virtual; abstract; + end; + +type + TJclFlatSet = class(TJclASet) + private + FBits: TBits; + public + constructor Create; + destructor Destroy; override; + procedure Clear; override; + procedure Invert; override; + procedure SetRange(const Low, High: Integer; const Value: Boolean); override; + function GetBit(const Idx: Integer): Boolean; override; + function GetRange(const Low, High: Integer; const Value: Boolean): Boolean; override; + procedure SetBit(const Idx: Integer; const Value: Boolean); override; + end; + +type + {$IFNDEF FPC} + TPointerArray = array [0..MaxLongint div 256] of Pointer; + PPointerArray = ^TPointerArray; + {$ENDIF ~FPC} + TDelphiSet = set of Byte; // 256 elements + PDelphiSet = ^TDelphiSet; + +const + EmptyDelphiSet: TDelphiSet = []; + CompleteDelphiSet: TDelphiSet = [0..255]; + +type + TJclSparseFlatSet = class(TJclASet) + private + FSetList: PPointerArray; + FSetListEntries: Integer; + public + destructor Destroy; override; + procedure Clear; override; + procedure Invert; override; + function GetBit(const Idx: Integer): Boolean; override; + procedure SetBit(const Idx: Integer; const Value: Boolean); override; + procedure SetRange(const Low, High: Integer; const Value: Boolean); override; + function GetRange(const Low, High: Integer; const Value: Boolean): Boolean; override; + end; + +{ Rational numbers } + +type + TJclRational = class(TObject) + private + FT: Integer; + FN: Integer; + function GetAsString: string; + procedure SetAsString(const S: string); + function GetAsFloat: Float; + procedure SetAsFloat(const R: Float); + protected + procedure Simplify; + public + constructor Create; overload; + constructor Create(const R: Float); overload; + constructor Create(const Numerator: Integer; const Denominator: Integer = 1); overload; + + property Numerator: Integer read FT; + property Denominator: Integer read FN; + property AsString: string read GetAsString write SetAsString; + property AsFloat: Float read GetAsFloat write SetAsFloat; + + procedure Assign(const R: TJclRational); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + procedure Assign(const R: Float); overload; + procedure Assign(const Numerator: Integer; const Denominator: Integer = 1); overload; + + procedure AssignZero; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + procedure AssignOne; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + function Duplicate: TJclRational; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + + function IsEqual(const R: TJclRational): Boolean; reintroduce; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + function IsEqual(const Numerator: Integer; const Denominator: Integer = 1) : Boolean; reintroduce; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + function IsEqual(const R: Float): Boolean; reintroduce; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + + function IsZero: Boolean; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + function IsOne: Boolean; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + + procedure Add(const R: TJclRational); overload; + procedure Add(const V: Float); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + procedure Add(const V: Integer); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + + procedure Subtract(const R: TJclRational); overload; + procedure Subtract(const V: Float); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + procedure Subtract(const V: Integer); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + + procedure Negate; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + procedure Abs; + function Sgn: Integer; + + procedure Multiply(const R: TJclRational); overload; + procedure Multiply(const V: Float); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + procedure Multiply(const V: Integer); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + + procedure Reciprocal; + + procedure Divide(const R: TJclRational); overload; + procedure Divide(const V: Float); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + procedure Divide(const V: Integer); overload; + + procedure Sqrt; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + procedure Sqr; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + + procedure Power(const R: TJclRational); overload; + procedure Power(const V: Integer); overload; + procedure Power(const V: Float); overload; + end; + +type + EJclMathError = class(EJclError); + + {$IFDEF CPU32} + EJclNaNSignal = class(EJclMathError) + private + FTag: TNaNTag; + public + constructor Create(ATag: TNaNTag; Dummy: Boolean = False); + property Tag: TNaNTag read FTag; + end; + {$ENDIF CPU32} + +procedure DomainCheck(Err: Boolean); + +{ Checksums } + +function GetParity(Buffer: TDynByteArray; Len: Integer): Boolean; overload; +function GetParity(Buffer: PByte; Len: Integer): Boolean; overload; + +{ CRC-16 } + +type + TCrc16Table = array [0..255] of Word; + +var + // CRC16Polynom = $1021; + Crc16DefaultTable: TCrc16Table = ( + $0000, $1021, $2042, $3063, $4084, $50A5, $60C6, $70E7, + $8108, $9129, $A14A, $B16B, $C18C, $D1AD, $E1CE, $F1EF, + $1231, $0210, $3273, $2252, $52B5, $4294, $72F7, $62D6, + $9339, $8318, $B37B, $A35A, $D3BD, $C39C, $F3FF, $E3DE, + $2462, $3443, $0420, $1401, $64E6, $74C7, $44A4, $5485, + $A56A, $B54B, $8528, $9509, $E5EE, $F5CF, $C5AC, $D58D, + $3653, $2672, $1611, $0630, $76D7, $66F6, $5695, $46B4, + $B75B, $A77A, $9719, $8738, $F7DF, $E7FE, $D79D, $C7BC, + $48C4, $58E5, $6886, $78A7, $0840, $1861, $2802, $3823, + $C9CC, $D9ED, $E98E, $F9AF, $8948, $9969, $A90A, $B92B, + $5AF5, $4AD4, $7AB7, $6A96, $1A71, $0A50, $3A33, $2A12, + $DBFD, $CBDC, $FBBF, $EB9E, $9B79, $8B58, $BB3B, $AB1A, + $6CA6, $7C87, $4CE4, $5CC5, $2C22, $3C03, $0C60, $1C41, + $EDAE, $FD8F, $CDEC, $DDCD, $AD2A, $BD0B, $8D68, $9D49, + $7E97, $6EB6, $5ED5, $4EF4, $3E13, $2E32, $1E51, $0E70, + $FF9F, $EFBE, $DFDD, $CFFC, $BF1B, $AF3A, $9F59, $8F78, + $9188, $81A9, $B1CA, $A1EB, $D10C, $C12D, $F14E, $E16F, + $1080, $00A1, $30C2, $20E3, $5004, $4025, $7046, $6067, + $83B9, $9398, $A3FB, $B3DA, $C33D, $D31C, $E37F, $F35E, + $02B1, $1290, $22F3, $32D2, $4235, $5214, $6277, $7256, + $B5EA, $A5CB, $95A8, $8589, $F56E, $E54F, $D52C, $C50D, + $34E2, $24C3, $14A0, $0481, $7466, $6447, $5424, $4405, + $A7DB, $B7FA, $8799, $97B8, $E75F, $F77E, $C71D, $D73C, + $26D3, $36F2, $0691, $16B0, $6657, $7676, $4615, $5634, + $D94C, $C96D, $F90E, $E92F, $99C8, $89E9, $B98A, $A9AB, + $5844, $4865, $7806, $6827, $18C0, $08E1, $3882, $28A3, + $CB7D, $DB5C, $EB3F, $FB1E, $8BF9, $9BD8, $ABBB, $BB9A, + $4A75, $5A54, $6A37, $7A16, $0AF1, $1AD0, $2AB3, $3A92, + $FD2E, $ED0F, $DD6C, $CD4D, $BDAA, $AD8B, $9DE8, $8DC9, + $7C26, $6C07, $5C64, $4C45, $3CA2, $2C83, $1CE0, $0CC1, + $EF1F, $FF3E, $CF5D, $DF7C, $AF9B, $BFBA, $8FD9, $9FF8, + $6E17, $7E36, $4E55, $5E74, $2E93, $3EB2, $0ED1, $1EF0 + ); + Crc16DefaultStart: Cardinal = $FFFF; + +const + Crc16PolynomCCITT = $1021; + Crc16PolynomIBM = $8005; + Crc16Bits = 16; + Crc16Bytes = 2; + Crc16HighBit = $8000; + NotCrc16HighBit = $7FFF; + +// for backward compatibility (default polynom = CCITT = $1021) +function Crc16_P(X: PJclByteArray; N: Integer; Crc: Word = 0): Word; overload; +function Crc16(const X: array of Byte; N: Integer; Crc: Word = 0): Word; overload; +function Crc16_A(const X: array of Byte; Crc: Word = 0): Word; overload; + +function CheckCrc16_P(X: PJclByteArray; N: Integer; Crc: Word): Integer; overload; +function CheckCrc16(var X: array of Byte; N: Integer; Crc: Word): Integer; overload; +function CheckCrc16_A(var X: array of Byte; Crc: Word): Integer; overload; + +// change the default polynom +procedure InitCrc16(Polynom, Start: Word); overload; + +// arbitrary polynom +function Crc16_P(const Crc16Table: TCrc16Table; X: PJclByteArray; N: Integer; Crc: Word = 0): Word; overload; +function Crc16(const Crc16Table: TCrc16Table; const X: array of Byte; N: Integer; Crc: Word = 0): Word; overload; +function Crc16_A(const Crc16Table: TCrc16Table; const X: array of Byte; Crc: Word = 0): Word; overload; + +function CheckCrc16_P(const Crc16Table: TCrc16Table; X: PJclByteArray; N: Integer; Crc: Word): Integer; overload; +function CheckCrc16(const Crc16Table: TCrc16Table; var X: array of Byte; N: Integer; Crc: Word): Integer; overload; +function CheckCrc16_A(const Crc16Table: TCrc16Table; var X: array of Byte; Crc: Word): Integer; overload; + +// initialize a table +procedure InitCrc16(Polynom, Start: Word; out Crc16Table: TCrc16Table); overload; + +{ CRC-32 } + +type + TCrc32Table = array [0..255] of Cardinal; + +var + // CRC32Polynom = $04C11DB7; + Crc32DefaultTable: TCrc32Table = ( + $00000000, $04C11DB7, $09823B6E, $0D4326D9, $130476DC, $17C56B6B, $1A864DB2, $1E475005, + $2608EDB8, $22C9F00F, $2F8AD6D6, $2B4BCB61, $350C9B64, $31CD86D3, $3C8EA00A, $384FBDBD, + $4C11DB70, $48D0C6C7, $4593E01E, $4152FDA9, $5F15ADAC, $5BD4B01B, $569796C2, $52568B75, + $6A1936C8, $6ED82B7F, $639B0DA6, $675A1011, $791D4014, $7DDC5DA3, $709F7B7A, $745E66CD, + $9823B6E0, $9CE2AB57, $91A18D8E, $95609039, $8B27C03C, $8FE6DD8B, $82A5FB52, $8664E6E5, + $BE2B5B58, $BAEA46EF, $B7A96036, $B3687D81, $AD2F2D84, $A9EE3033, $A4AD16EA, $A06C0B5D, + $D4326D90, $D0F37027, $DDB056FE, $D9714B49, $C7361B4C, $C3F706FB, $CEB42022, $CA753D95, + $F23A8028, $F6FB9D9F, $FBB8BB46, $FF79A6F1, $E13EF6F4, $E5FFEB43, $E8BCCD9A, $EC7DD02D, + $34867077, $30476DC0, $3D044B19, $39C556AE, $278206AB, $23431B1C, $2E003DC5, $2AC12072, + $128E9DCF, $164F8078, $1B0CA6A1, $1FCDBB16, $018AEB13, $054BF6A4, $0808D07D, $0CC9CDCA, + $7897AB07, $7C56B6B0, $71159069, $75D48DDE, $6B93DDDB, $6F52C06C, $6211E6B5, $66D0FB02, + $5E9F46BF, $5A5E5B08, $571D7DD1, $53DC6066, $4D9B3063, $495A2DD4, $44190B0D, $40D816BA, + $ACA5C697, $A864DB20, $A527FDF9, $A1E6E04E, $BFA1B04B, $BB60ADFC, $B6238B25, $B2E29692, + $8AAD2B2F, $8E6C3698, $832F1041, $87EE0DF6, $99A95DF3, $9D684044, $902B669D, $94EA7B2A, + $E0B41DE7, $E4750050, $E9362689, $EDF73B3E, $F3B06B3B, $F771768C, $FA325055, $FEF34DE2, + $C6BCF05F, $C27DEDE8, $CF3ECB31, $CBFFD686, $D5B88683, $D1799B34, $DC3ABDED, $D8FBA05A, + $690CE0EE, $6DCDFD59, $608EDB80, $644FC637, $7A089632, $7EC98B85, $738AAD5C, $774BB0EB, + $4F040D56, $4BC510E1, $46863638, $42472B8F, $5C007B8A, $58C1663D, $558240E4, $51435D53, + $251D3B9E, $21DC2629, $2C9F00F0, $285E1D47, $36194D42, $32D850F5, $3F9B762C, $3B5A6B9B, + $0315D626, $07D4CB91, $0A97ED48, $0E56F0FF, $1011A0FA, $14D0BD4D, $19939B94, $1D528623, + $F12F560E, $F5EE4BB9, $F8AD6D60, $FC6C70D7, $E22B20D2, $E6EA3D65, $EBA91BBC, $EF68060B, + $D727BBB6, $D3E6A601, $DEA580D8, $DA649D6F, $C423CD6A, $C0E2D0DD, $CDA1F604, $C960EBB3, + $BD3E8D7E, $B9FF90C9, $B4BCB610, $B07DABA7, $AE3AFBA2, $AAFBE615, $A7B8C0CC, $A379DD7B, + $9B3660C6, $9FF77D71, $92B45BA8, $9675461F, $8832161A, $8CF30BAD, $81B02D74, $857130C3, + $5D8A9099, $594B8D2E, $5408ABF7, $50C9B640, $4E8EE645, $4A4FFBF2, $470CDD2B, $43CDC09C, + $7B827D21, $7F436096, $7200464F, $76C15BF8, $68860BFD, $6C47164A, $61043093, $65C52D24, + $119B4BE9, $155A565E, $18197087, $1CD86D30, $029F3D35, $065E2082, $0B1D065B, $0FDC1BEC, + $3793A651, $3352BBE6, $3E119D3F, $3AD08088, $2497D08D, $2056CD3A, $2D15EBE3, $29D4F654, + $C5A92679, $C1683BCE, $CC2B1D17, $C8EA00A0, $D6AD50A5, $D26C4D12, $DF2F6BCB, $DBEE767C, + $E3A1CBC1, $E760D676, $EA23F0AF, $EEE2ED18, $F0A5BD1D, $F464A0AA, $F9278673, $FDE69BC4, + $89B8FD09, $8D79E0BE, $803AC667, $84FBDBD0, $9ABC8BD5, $9E7D9662, $933EB0BB, $97FFAD0C, + $AFB010B1, $AB710D06, $A6322BDF, $A2F33668, $BCB4666D, $B8757BDA, $B5365D03, $B1F740B4 + ); + Crc32DefaultStart: Cardinal = $FFFFFFFF; + +const + Crc32PolynomIEEE = $04C11DB7; + Crc32PolynomCastagnoli = $1EDC6F41; + Crc32Koopman = $741B8CD7; + Crc32Bits = 32; + Crc32Bytes = 4; + Crc32HighBit = $80000000; + NotCrc32HighBit = $7FFFFFFF; + +// for backward compatibility (default polynom = IEEE = $04C11DB7) +function Crc32_P(X: PJclByteArray; N: Integer; Crc: Cardinal = 0): Cardinal; overload; +function Crc32(const X: array of Byte; N: Integer; Crc: Cardinal = 0): Cardinal; overload; +function Crc32_A(const X: array of Byte; Crc: Cardinal = 0): Cardinal; overload; + +function CheckCrc32_P(X: PJclByteArray; N: Integer; Crc: Cardinal): Integer; overload; +function CheckCrc32(var X: array of Byte; N: Integer; Crc: Cardinal): Integer; overload; +function CheckCrc32_A(var X: array of Byte; Crc: Cardinal): Integer; overload; + +// change the default polynom +procedure InitCrc32(Polynom, Start: Cardinal); overload; + +// arbitrary polynom +function Crc32_P(const Crc32Table: TCrc32Table; X: PJclByteArray; N: Integer; Crc: Cardinal = 0): Cardinal; overload; +function Crc32(const Crc32Table: TCrc32Table; const X: array of Byte; N: Integer; Crc: Cardinal = 0): Cardinal; overload; +function Crc32_A(const Crc32Table: TCrc32Table; const X: array of Byte; Crc: Cardinal = 0): Cardinal; overload; + +function CheckCrc32_P(const Crc32Table: TCrc32Table; X: PJclByteArray; N: Integer; Crc: Cardinal): Integer; overload; +function CheckCrc32(const Crc32Table: TCrc32Table; var X: array of Byte; N: Integer; Crc: Cardinal): Integer; overload; +function CheckCrc32_A(const Crc32Table: TCrc32Table; var X: array of Byte; Crc: Cardinal): Integer; overload; + +// initialize a table +procedure InitCrc32(Polynom, Start: Cardinal; out Crc32Table: TCrc32Table); overload; + +{ Complex numbers } + +type + TRectComplex = record + Re: Float; + Im: Float; + {$IFDEF SUPPORTS_CLASS_OPERATORS} + class operator Implicit(const Value: Float): TRectComplex; + class operator Equal(const Z1, Z2: TRectComplex): Boolean; + class operator NotEqual(const Z1, Z2: TRectComplex): Boolean; + class operator Add(const Z1, Z2: TRectComplex): TRectComplex; + class operator Subtract(const Z1, Z2: TRectComplex): TRectComplex; + class operator Multiply(const Z1, Z2: TRectComplex): TRectComplex; + class operator Divide(const Z1, Z2: TRectComplex): TRectComplex; + class operator Negative(const Z: TRectComplex): TRectComplex; + class operator Positive(const Z: TRectComplex): TRectComplex; + function AsString: string; + function Conjugate: TRectComplex; + function IsZero: Boolean; + function IsInfinite: Boolean; + {$ENDIF SUPPORTS_CLASS_OPERATORS} + end; + + TPolarComplex = record + Radius: Float; + Angle: Float; + {$IFDEF SUPPORTS_CLASS_OPERATORS} + class operator Implicit(const Value: Float): TPolarComplex; + class operator Implicit(const Z: TPolarComplex): TRectComplex; + class operator Implicit(const Z: TRectComplex): TPolarComplex; + {$IFNDEF CPPBUILDER} + // OK with Delphi, but will yield errors in .hpp files: + class operator Explicit(const Z: TPolarComplex): TRectComplex; + class operator Explicit(const Z: TRectComplex): TPolarComplex; + {$ENDIF CPPBUILDER} + class operator Equal(const Z1, Z2: TPolarComplex): Boolean; + class operator NotEqual(const Z1, Z2: TPolarComplex): Boolean; + class operator Add(const Z1, Z2: TPolarComplex): TRectComplex; + class operator Subtract(const Z1, Z2: TPolarComplex): TRectComplex; + class operator Multiply(const Z1, Z2: TPolarComplex): TPolarComplex; + class operator Divide(const Z1, Z2: TPolarComplex): TPolarComplex; + class operator Negative(const Z: TPolarComplex): TPolarComplex; + class operator Positive(const Z: TPolarComplex): TPolarComplex; + function AsString: string; + function Conjugate: TPolarComplex; + function IsZero: Boolean; + function IsInfinite: Boolean; + function Power(const Exponent: TRectComplex): TPolarComplex; overload; + function Power(const Exponent: Float): TPolarComplex; overload; + function Power(const Exponent: Integer): TPolarComplex; overload; + // computes the kth nth root, k in 1..n + function Root(const K, N: Cardinal): TPolarComplex; + {$ENDIF SUPPORTS_CLASS_OPERATORS} + end; + +{$IFDEF DEBUG} +var + // accumulated count of (computational costly) TRectComplex <-> TPolarComplex conversions + ComplexTypeConversions: Cardinal; +{$ENDIF DEBUG} + +// sets format string for ComplexToStr(TRectComplex) and TRectComplex.AsString +procedure SetRectComplexFormatStr(const S: string); +// sets format string for ComplexToStr(TPolarComplex) and TPolarComplex.AsString +procedure SetPolarComplexFormatStr(const S: string); + +function ComplexToStr(const Z: TRectComplex): string; overload; +function ComplexToStr(const Z: TPolarComplex): string; overload; + +function RectComplex(const Re: Float; const Im: Float = 0): TRectComplex; overload; +function RectComplex(const Z: TPolarComplex): TRectComplex; overload; +function PolarComplex(const Radius: Float; const Angle: Float = 0): TPolarComplex; overload; +function PolarComplex(const Z: TRectComplex): TPolarComplex; overload; + +function Equal(const Z1, Z2: TRectComplex): Boolean; overload; +function Equal(const Z1, Z2: TPolarComplex): Boolean; overload; + +function IsZero(const Z: TRectComplex): Boolean; overload; +function IsZero(const Z: TPolarComplex): Boolean; overload; +{$IFDEF CPU32} +function IsInfinite(const Z: TRectComplex): Boolean; overload; +function IsInfinite(const Z: TPolarComplex): Boolean; overload; +{$ENDIF CPU32} + +function Norm(const Z: TRectComplex): Float; overload; +function Norm(const Z: TPolarComplex): Float; overload; +function AbsSqr(const Z: TRectComplex): Float; overload; +function AbsSqr(const Z: TPolarComplex): Float; overload; +function Conjugate(const Z: TRectComplex): TRectComplex; overload; +function Conjugate(const Z: TPolarComplex): TPolarComplex; overload; +function Inv(const Z: TRectComplex): TRectComplex; overload; +function Inv(const Z: TPolarComplex): TPolarComplex; overload; +function Neg(const Z: TRectComplex): TRectComplex; overload; +function Neg(const Z: TPolarComplex): TPolarComplex; overload; + +function Sum(const Z1, Z2: TRectComplex): TRectComplex; overload; +function Sum(const Z: array of TRectComplex): TRectComplex; overload; +function Diff(const Z1, Z2: TRectComplex): TRectComplex; +function Product(const Z1, Z2: TRectComplex): TRectComplex; overload; +function Product(const Z1, Z2: TPolarComplex): TPolarComplex; overload; +function Product(const Z: array of TPolarComplex): TPolarComplex; overload; +function Quotient(const Z1, Z2: TRectComplex): TRectComplex; overload; +function Quotient(const Z1, Z2: TPolarComplex): TPolarComplex; overload; + +function Ln(const Z: TPolarComplex): TRectComplex; +function Exp(const Z: TRectComplex): TPolarComplex; overload; +function Power(const Z: TPolarComplex; const Exponent: TRectComplex): TPolarComplex; overload; +function Power(const Z: TPolarComplex; const Exponent: Float): TPolarComplex; overload; +function PowerInt(const Z: TPolarComplex; const Exponent: Integer): TPolarComplex; overload; +// a complex number has n different nth roots in the complex plane +// Root() computes the kth nth root, k in 1..n +function Root(const Z: TPolarComplex; const K, N: Cardinal): TPolarComplex; + +function Cos(const Z: TRectComplex): TRectComplex; overload; +function Sin(const Z: TRectComplex): TRectComplex; overload; +function Tan(const Z: TRectComplex): TRectComplex; overload; +function Cot(const Z: TRectComplex): TRectComplex; overload; +function Sec(const Z: TRectComplex): TRectComplex; overload; +function Csc(const Z: TRectComplex): TRectComplex; overload; + +function CosH(const Z: TRectComplex): TRectComplex; overload; +function SinH(const Z: TRectComplex): TRectComplex; overload; +function TanH(const Z: TRectComplex): TRectComplex; overload; +function CotH(const Z: TRectComplex): TRectComplex; overload; +function SecH(const Z: TRectComplex): TRectComplex; overload; +function CscH(const Z: TRectComplex): TRectComplex; overload; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +{$IFDEF DELPHI64_TEMPORARY} + {$DEFINE USE_MATH_UNIT} +{$ENDIF DELPHI64_TEMPORARY} + +uses + {$IFDEF HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + {$IFNDEF FPC} + Winapi.Windows, + {$ENDIF ~FPC} + {$ENDIF MSWINDOWS} + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + {$IFNDEF FPC} + Windows, + {$ENDIF ~FPC} + {$ENDIF MSWINDOWS} + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF USE_MATH_UNIT} + System.Math, + {$ENDIF USE_MATH_UNIT} + Jcl8087, + JclResources, + JclSynch; + +// Note (rrossmair): Usage of the "assembler" directive seems to be an Free Pascal requirement +// (it's obsolete in Delphi since v. 2 I believe). + +// Internal helper routines +// Linux: Get Global Offset Table (GOT) adress for Position Independent Code +// (PIC, used by shared objects) + +{$IFDEF PIC} +function GetGOT: Pointer; export; +begin + asm + {$IFDEF CPU32} + MOV Result, EBX + {$ENDIF CPU32} + {$IFDEF CPU64} + XOR Result, RBX + {$ENDIF CPU64} + end; +end; +{$ENDIF PIC} + +// to keep name space usage low +const + JclMathSgn: function(const X: Float): Integer = Sgn; + JclMathPower: function(const Base, Exponent: Float): Float = Power; + +// to be independent from JclLogic + +function Min(const X, Y: Integer): Integer; +begin + if X < Y then + Result := X + else + Result := Y; +end; + +// to be independent from JCLLogic + +procedure SwapOrd(var X, Y: Integer); +var + Temp: Integer; +begin + Temp := X; + X := Y; + Y := Temp; +end; + +function DoubleToHex(const D: Double): string; +var + Overlay: array [1..2] of Longint absolute D; +begin + // Look at element 2 before element 1 because of "Little Endian" order. + Result := IntToHex(Overlay[2], 8) + IntToHex(Overlay[1], 8); +end; + +function HexToDouble(const Hex: string): Double; +var + D: Double; + Overlay: array [1..2] of Longint absolute D; +begin + if Length(Hex) <> 16 then + raise EJclMathError.CreateRes(@RsUnexpectedValue); + Overlay[1] := StrToInt('$' + Copy(Hex, 9, 8)); + Overlay[2] := StrToInt('$' + Copy(Hex, 1, 8)); + Result := D; +end; + +// Converts degrees to radians. + +{$IFDEF SUPPORTS_EXTENDED} +function DegToRad(const Value: Extended): Extended; +begin + Result := Value * RatioDegToRad; +end; +{$ENDIF SUPPORTS_EXTENDED} + +function DegToRad(const Value: Double): Double; +begin + Result := Value * RatioDegToRad; +end; + +function DegToRad(const Value: Single): Single; +begin + Result := Value * RatioDegToRad; +end; + +// Expects degrees in ST(0), leaves radians in ST(0) +// ST(0) := ST(0) * PI / 180 +procedure FastDegToRad; assembler; +asm + {$IFDEF PIC} + CALL GetGOT + {$IFDEF CPU32} + FLD [EAX][RatioDegToRad] + {$ENDIF CPU32} + {$IFDEF CPU64} + FLD [RAX][RatioDegToRad] + {$ENDIF CPU64} + {$ELSE ~PIC} + FLD [RatioDegToRad] + {$ENDIF ~PIC} + FMULP + FWAIT +end; + +// Converts radians to degrees. + +{$IFDEF SUPPORTS_EXTENDED} +function RadToDeg(const Value: Extended): Extended; +begin + Result := Value * RatioRadToDeg; +end; +{$ENDIF SUPPORTS_EXTENDED} + +function RadToDeg(const Value: Double): Double; +begin + Result := Value * RatioRadToDeg; +end; + +function RadToDeg(const Value: Single): Single; +begin + Result := Value * RatioRadToDeg; +end; + +// Expects radians in ST(0), leaves degrees in ST(0) +// ST(0) := ST(0) * (180 / PI); +procedure FastRadToDeg; assembler; +asm + {$IFDEF PIC} + CALL GetGOT + {$IFDEF CPU32} + FLD [EAX][RatioRadToDeg] + {$ENDIF CPU32} + {$IFDEF CPU64} + FLD [RAX][RatioRadToDeg] + {$ENDIF CPU64} + {$ELSE ~PIC} + FLD [RatioRadToDeg] + {$ENDIF ~PIC} + FMULP + FWAIT +end; + +// Converts grads to radians. + +{$IFDEF SUPPORTS_EXTENDED} +function GradToRad(const Value: Extended): Extended; +begin + Result := Value * RatioGradToRad; +end; +{$ENDIF SUPPORTS_EXTENDED} + +function GradToRad(const Value: Double): Double; +begin + Result := Value * RatioGradToRad; +end; + +function GradToRad(const Value: Single): Single; +begin + Result := Value * RatioGradToRad; +end; + +// Expects grads in ST(0), leaves radians in ST(0) +// ST(0) := ST(0) * PI / 200 +procedure FastGradToRad; assembler; +asm + {$IFDEF PIC} + CALL GetGOT + {$IFDEF CPU32} + FLD [EAX][RatioGradToRad] + {$ENDIF CPU32} + {$IFDEF CPU64} + FLD [RAX][RatioGradToRad] + {$ENDIF CPU64} + {$ELSE ~PIC} + FLD [RatioGradToRad] + {$ENDIF ~PIC} + FMULP + FWAIT +end; + +// Converts radians to grads. + +{$IFDEF SUPPORTS_EXTENDED} +function RadToGrad(const Value: Extended): Extended; +begin + Result := Value * RatioRadToGrad; +end; +{$ENDIF SUPPORTS_EXTENDED} + +function RadToGrad(const Value: Double): Double; +begin + Result := Value * RatioRadToGrad; +end; + +function RadToGrad(const Value: Single): Single; +begin + Result := Value * RatioRadToGrad; +end; + +// Expects radians in ST(0), leaves grads in ST(0) +// ST(0) := ST(0) * (200 / PI); +procedure FastRadToGrad; assembler; +asm + {$IFDEF PIC} + CALL GetGOT + {$IFDEF CPU32} + FLD [EAX][RatioRadToGrad] + {$ENDIF CPU32} + {$IFDEF CPU64} + FLD [RAX][RatioRadToGrad] + {$ENDIF CPU64} + {$ELSE ~PIC} + FLD [RatioRadToGrad] + {$ENDIF ~PIC} + FMULP + FWAIT +end; + +// Converts degrees to grads. + +{$IFDEF SUPPORTS_EXTENDED} +function DegToGrad(const Value: Extended): Extended; +begin + Result := Value * RatioDegToGrad; +end; +{$ENDIF SUPPORTS_EXTENDED} + +function DegToGrad(const Value: Double): Double; +begin + Result := Value * RatioDegToGrad; +end; + +function DegToGrad(const Value: Single): Single; +begin + Result := Value * RatioDegToGrad; +end; + +// Expects Degrees in ST(0), leaves grads in ST(0) +// ST(0) := ST(0) * (200 / 180); +procedure FastDegToGrad; assembler; +asm + {$IFDEF PIC} + CALL GetGOT + {$IFDEF CPU32} + FLD [EAX][RatioDegToGrad] + {$ENDIF CPU32} + {$IFDEF CPU64} + FLD [RAX][RatioDegToGrad] + {$ENDIF CPU64} + {$ELSE ~PIC} + FLD [RatioDegToGrad] + {$ENDIF ~PIC} + FMULP + FWAIT +end; + +// Converts grads to degrees. + +{$IFDEF SUPPORTS_EXTENDED} +function GradToDeg(const Value: Extended): Extended; +begin + Result := Value * RatioGradToDeg; +end; +{$ENDIF SUPPORTS_EXTENDED} + +function GradToDeg(const Value: Double): Double; +begin + Result := Value * RatioGradToDeg; +end; + +function GradToDeg(const Value: Single): Single; +begin + Result := Value * RatioGradToDeg; +end; + +// Expects grads in ST(0), leaves radians in ST(0) +// ST(0) := ST(0) * PI / 200 +procedure FastGradToDeg; assembler; +asm + {$IFDEF PIC} + CALL GetGOT + {$IFDEF CPU32} + FLD [EAX][RatioGradToDeg] + {$ENDIF CPU32} + {$IFDEF CPU64} + FLD [RAX][RatioGradToDeg] + {$ENDIF CPU64} + {$ELSE ~PIC} + FLD [RatioGradToDeg] + {$ENDIF ~PIC} + FMULP + FWAIT +end; + +procedure DomainCheck(Err: Boolean); +begin + if Err then + raise EJclMathError.CreateRes(@RsMathDomainError); +end; + +//=== Logarithmic ============================================================ + +function LogBase10(X: Float): Float; +begin + DomainCheck(X <= 0.0); + {$IFDEF USE_MATH_UNIT} + Result := System.Math.Log10(X); + {$ELSE ~USE_MATH_UNIT} + asm + FLDLG2 + FLD X + FYL2X + FWAIT + FSTP Result + end; + {$ENDIF ~USE_MATH_UNIT} +end; + +function LogBase2(X: Float): Float; +begin + DomainCheck(X <= 0.0); + {$IFDEF USE_MATH_UNIT} + Result := System.Math.Log2(X); + {$ELSE ~USE_MATH_UNIT} + asm + FLD1 + FLD X + FYL2X + FWAIT + FSTP Result + end; + {$ENDIF ~USE_MATH_UNIT} +end; + +function LogBaseN(Base, X: Float): Float; +begin + DomainCheck((X <= 0.0) or (Base <= 0.0) or (Base = 1.0)); + {$IFDEF USE_MATH_UNIT} + Result := System.Math.LogN(Base, X); + {$ELSE ~USE_MATH_UNIT} + asm + FLD1 + FLD X + FYL2X + FLD1 + FLD Base + FYL2X + FDIVP ST(1), ST(0) + FWAIT + FSTP Result + end; + {$ENDIF ~USE_MATH_UNIT} +end; + +//=== Transcendental ========================================================= + +function ArcCos(X: Float): Float; +begin + DomainCheck(Abs(X) > 1.0); + {$IFDEF USE_MATH_UNIT} + Result := System.Math.ArcCos(X); + {$ELSE ~USE_MATH_UNIT} + asm + FLD X + FLD ST(0) + FMUL ST(0), ST(0) + FLD1 + FSUBRP ST(1), ST(0) + FSQRT + FXCH + FPATAN + FWAIT + FSTP Result + end; + {$ENDIF ~USE_MATH_UNIT} +end; + +function ArcCot(X: Float): Float; +begin + DomainCheck(X = 0); + Result := ArcTan(1 / X); +end; + +function ArcCsc(X: Float): Float; +begin + Result := ArcSec(X / Sqrt(X * X -1)); +end; + +function ArcSec(X: Float): Float; +begin + DomainCheck((X > -1) and (X < 1)); + {$IFDEF USE_MATH_UNIT} + Result := System.Math.ArcSec(X); + {$ELSE ~USE_MATH_UNIT} + // FArcTan(Sqrt(X*X - 1)); + asm + FLD1 + FLD X + FLD ST(0) + FMULP + FSUBRP ST(1), ST(0) + FSQRT + FLD1 + FPATAN + FWAIT + FSTP Result + end; + {$ENDIF ~USE_MATH_UNIT} +end; + +function ArcSin(X: Float): Float; +begin + DomainCheck(Abs(X) > 1.0); + {$IFDEF USE_MATH_UNIT} + Result := System.Math.ArcSin(X); + {$ELSE ~USE_MATH_UNIT} + asm + FLD X + FLD ST(0) + FMUL ST(0), ST(0) + FLD1 + FSUBRP ST(1), ST(0) + FSQRT + FPATAN + FWAIT + FSTP Result + end; + {$ENDIF ~USE_MATH_UNIT} +end; + +{$IFDEF CPU32} +function ArcTan(X: Float): Float; assembler; +asm + FLD X + FLD1 + FPATAN + FWAIT +end; +{$ENDIF CPU32} + +{$IFDEF CPU64} +function ArcTan(X: Float): Float; +begin + {$IFDEF USE_MATH_UNIT} + System.Error(rePlatformNotImplemented); + Result := NaN; + {$ELSE ~USE_MATH_UNIT} + asm + FLD X + FLD1 + FPATAN + FWAIT + FSTP Result + end; + {$ENDIF ~USE_MATH_UNIT} +end; +{$ENDIF CPU64} + +{$IFDEF CPU32} +function ArcTan2(Y, X: Float): Float; assembler; +asm + FLD Y + FLD X + FPATAN + FWAIT +end; +{$ENDIF CPU32} + +{$IFDEF CPU64} +function ArcTan2(Y, X: Float): Float; +begin + {$IFDEF USE_MATH_UNIT} + Result := System.Math.ArcTan2(Y, X); + {$ELSE ~USE_MATH_UNIT} + asm + FLD Y + FLD X + FPATAN + FWAIT + FSTP Result + end; + {$ENDIF ~USE_MATH_UNIT} +end; +{$ENDIF CPU64} + +function Cos(X: Float): Float; +begin + DomainCheck(Abs(X) > MaxAngle); + {$IFDEF USE_MATH_UNIT} + System.Error(rePlatformNotImplemented); + Result := NaN; + {$ELSE ~USE_MATH_UNIT} + asm + FLD X + FCOS + FWAIT + FSTP Result + end; + {$ENDIF ~USE_MATH_UNIT} +end; + +function Cot(X: Float): Float; +begin + DomainCheck(Abs(X) > MaxAngle); + {$IFDEF USE_MATH_UNIT} + Result := System.Math.Cot(X); + {$ELSE ~USE_MATH_UNIT} + { TODO : Cot = 1 / Tan -> Tan(X) <> 0.0 } + asm + FLD X + FPTAN + FDIVRP ST(1), ST(0) + FWAIT + FSTP Result + end; + {$ENDIF ~USE_MATH_UNIT} +end; + +function Coversine(X: Float): Float; +begin + Result := 1 - JclMath.Sin(X); +end; + +function Csc(X: Float): Float; +var + Y: Float; +begin + DomainCheck(Abs(X) > MaxAngle); + + Y := JclMath.Sin(X); + DomainCheck(Y = 0.0); + Result := 1.0 / Y; +end; + +function Exsecans(X: Float): Float; +begin + Result := JclMath.Sec(X) - 1; +end; + +function Haversine(X: Float): Float; +begin + Result := 0.5 * (1 - JclMath.Cos(X)); +end; + +function Sec(X: Float): Float; +begin + DomainCheck(Abs(X) > MaxAngle); + {$IFDEF USE_MATH_UNIT} + Result := System.Math.Sec(X); + {$ELSE ~USE_MATH_UNIT} + { TODO : Sec = 1 / Cos -> Cos(X) <> 0! } + asm + FLD X + FCOS + FLD1 + FDIVRP ST(1), ST(0) + FWAIT + FSTP Result + end; + {$ENDIF ~USE_MATH_UNIT} +end; + +function Sin(X: Float): Float; +begin + {$IFNDEF MATH_EXT_SPECIALVALUES} + DomainCheck(Abs(X) > MaxAngle); + {$ENDIF ~MATH_EXT_SPECIALVALUES} + {$IFDEF USE_MATH_UNIT} + System.Error(rePlatformNotImplemented); + Result := NaN; + {$ELSE ~USE_MATH_UNIT} + asm + FLD X + FSIN + FWAIT + FSTP Result + end; + {$ENDIF ~USE_MATH_UNIT} +end; + +{$IFDEF SUPPORTS_EXTENDED} +procedure SinCos(X: Extended; out Sin, Cos: Extended); +begin + DomainCheck(Abs(X) > MaxAngle); + {$IFDEF USE_MATH_UNIT} + System.Math.SinCos(X, Sin, Cos); + {$ELSE ~USE_MATH_UNIT} + asm + FLD X + {$IFDEF CPU32} + MOV EDX, Cos + MOV EAX, Sin + FSINCOS + FSTP Extended PTR [EDX] + FSTP Extended PTR [EAX] + {$ENDIF CPU32} + {$IFDEF CPU64} + MOV RDX, Cos + MOV RAX, Sin + FSINCOS + FSTP Extended PTR [RDX] + FSTP Extended PTR [RAX] + {$ENDIF CPU64} + FWAIT + end; + {$ENDIF ~USE_MATH_UNIT} +end; +{$ENDIF SUPPORTS_EXTENDED} + +procedure SinCos(X: Double; out Sin, Cos: Double); +begin + DomainCheck(Abs(X) > MaxAngle); + {$IFDEF USE_MATH_UNIT} + System.Math.SinCos(X, Sin, Cos); + {$ELSE ~USE_MATH_UNIT} + asm + FLD X + {$IFDEF CPU32} + MOV EDX, Cos + MOV EAX, Sin + FSINCOS + FSTP Double PTR [EDX] + FSTP Double PTR [EAX] + {$ENDIF CPU32} + {$IFDEF CPU64} + MOV RDX, Cos + MOV RAX, Sin + FSINCOS + FSTP Double PTR [RDX] + FSTP Double PTR [RAX] + {$ENDIF CPU64} + FWAIT + end; + {$ENDIF ~USE_MATH_UNIT} +end; + +procedure SinCos(X: Single; out Sin, Cos: Single); +begin + DomainCheck(Abs(X) > MaxAngle); + {$IFDEF USE_MATH_UNIT} + System.Math.SinCos(X, Sin, Cos); + {$ELSE ~USE_MATH_UNIT} + asm + FLD X + {$IFDEF CPU32} + MOV EDX, Cos + MOV EAX, Sin + FSINCOS + FSTP Single PTR [EDX] + FSTP Single PTR [EAX] + {$ENDIF CPU32} + {$IFDEF CPU64} + MOV RDX, Cos + MOV RAX, Sin + FSINCOS + FSTP Single PTR [RDX] + FSTP Single PTR [RAX] + {$ENDIF CPU64} + FWAIT + end; + {$ENDIF ~USE_MATH_UNIT} +end; + +function Tan(X: Float): Float; +begin + DomainCheck(Abs(X) > MaxAngle); + {$IFDEF USE_MATH_UNIT} + Result := System.Math.Tan(X); + {$ELSE ~USE_MATH_UNIT} + asm + FLD X + FPTAN + FSTP ST(0) + FWAIT + FSTP Result + end; + {$ENDIF ~USE_MATH_UNIT} +end; + +function Versine(X: Float): Float; +begin + Result := 1 - JclMath.Cos(X); +end; + +//=== Hyperbolic ============================================================= + +function ArcCosH(X: Float): Float; +begin + DomainCheck(X < 1.0); + {$IFDEF USE_MATH_UNIT} + Result := System.Math.ArcCosh(X); + {$ELSE ~USE_MATH_UNIT} + asm + FLDLN2 + FLD X + FLD ST(0) + FMUL ST(0), ST(0) + FLD1 + FSUBP ST(1), ST(0) + FSQRT + FADDP ST(1), ST(0) + FYL2X + FSTP Result + end; + {$ENDIF ~USE_MATH_UNIT} +end; + +function ArcCotH(X: Float): Float; +begin + DomainCheck(Abs(X) = 1.0); + Result := 0.5 * System.Ln((X + 1.0) / (X - 1.0)); +end; + +function ArcCscH(X: Float): Float; +begin + DomainCheck(X = 0); + Result := System.Ln((Sgn(X) * Sqrt(Sqr(X) + 1.0) + 1.0) / X); +end; + +function ArcSecH(X: Float): Float; +begin + DomainCheck(Abs(X) > 1.0); + Result := System.Ln((Sqrt(1.0 - Sqr(X)) + 1.0) / X); +end; + +{$IFDEF CPU32} +function ArcSinH(X: Float): Float; assembler; +asm + FLDLN2 + FLD X + FLD ST(0) + FMUL ST(0), ST(0) + FLD1 + FADDP ST(1), ST(0) + FSQRT + FADDP ST(1), ST(0) + FYL2X +end; +{$ENDIF CPU32} + +{$IFDEF CPU64} +function ArcSinH(X: Float): Float; +begin + {$IFDEF USE_MATH_UNIT} + Result := System.Math.ArcSinh(X); + {$ELSE ~USE_MATH_UNIT} + asm + FLDLN2 + FLD X + FLD ST(0) + FMUL ST(0), ST(0) + FLD1 + FADDP ST(1), ST(0) + FSQRT + FADDP ST(1), ST(0) + FYL2X + FSTP Result + end; + {$ENDIF ~USE_MATH_UNIT} +end; +{$ENDIF CPU64} + +function ArcTanH(X: Float): Float; +begin + DomainCheck(Abs(X) >= 1.0); + {$IFDEF USE_MATH_UNIT} + Result := System.Math.ArcTanh(X); + {$ELSE ~USE_MATH_UNIT} + asm + FLDLN2 + FLD X + FLD ST(0) + FLD1 + FADDP ST(1), ST(0) + FXCH + FLD1 + FSUBRP ST(1), ST(0) + FDIVP ST(1), ST(0) + FSQRT + FYL2X + FWAIT + FSTP Result + end; + {$ENDIF ~USE_MATH_UNIT} +end; + +function CosH(X: Float): Float; +{$IFDEF PUREPASCAL} +begin + Result := 0.5 * (Exp(X) + Exp(-X)); +end; +{$ELSE ~PUREPASCAL} +const + RoundDown: Word = $177F; + OneHalf: Float = 0.5; +{$IFNDEF USE_MATH_UNIT} +var + ControlWW: Word; +{$ENDIF ~USE_MATH_UNIT} +begin + {$IFDEF USE_MATH_UNIT} + Result := System.Math.Cosh(X); + {$ELSE ~USE_MATH_UNIT} + asm + {$IFDEF PIC} + CALL GetGOT + {$ENDIF PIC} + FLD X { TODO : Legal values for X? } + FLDL2E + FMULP ST(1), ST(0) + FSTCW ControlWW + {$IFDEF PIC} + {$IFDEF CPU32} + FLDCW [EAX].RoundDown + {$ENDIF CPU32} + {$IFDEF CPU64} + FLDCW [RAX].RoundDown + {$ENDIF CPU64} + {$ELSE ~PIC} + FLDCW RoundDown + {$ENDIF ~PIC} + FLD ST(0) + FRNDINT + FLDCW ControlWW + FXCH + FSUB ST(0), ST(1) + F2XM1 + FLD1 + FADDP ST(1), ST(0) + FSCALE + FST ST(1) + FLD1 + FDIVRP ST(1), ST(0) + FADDP ST(1), ST(0) + {$IFDEF PIC} + {$IFDEF CPU32} + FLD [EAX].OneHalf + {$ENDIF CPU32} + {$IFDEF CPU64} + FLD [RAX].OneHalf + {$ENDIF CPU64} + {$ELSE ~PIC} + FLD OneHalf + {$ENDIF ~PIC} + FMULP ST(1), ST(0) + FWAIT + FSTP Result + end; + {$ENDIF ~USE_MATH_UNIT} +end; +{$ENDIF ~PUREPASCAL} + +function CotH(X: Float): Float; +begin + Result := 1 / JclMath.TanH(X); +end; + +function CscH(X: Float): Float; +begin + Result := JclMath.Exp(X) - JclMath.Exp(-X); + DomainCheck(Result = 0.0); + Result := 2.0 / Result; +end; + +function SecH(X: Float): Float; +begin + Result := JclMath.Exp(X) + JclMath.Exp(-X); + DomainCheck(Result = 0.0); + Result := 2.0 / Result; +end; + +function SinH(X: Float): Float; +{$IFDEF PUREPASCAL} +begin + Result := 0.5 * (JclMath.Exp(X) - JclMath.Exp(-X)); +end; +{$ELSE ~PUREPASCAL} +const + RoundDown: Word = $177F; + OneHalf: Float = 0.5; +{$IFNDEF USE_MATH_UNIT} +var + ControlWW: Word; +{$ENDIF ~USE_MATH_UNIT} +begin + {$IFDEF USE_MATH_UNIT} + Result := System.Math.Sinh(X); + {$ELSE ~USE_MATH_UNIT} + asm + {$IFDEF PIC} + CALL GetGOT + {$ENDIF PIC} + FLD X { TODO : Legal values for X? } + FLDL2E + FMULP ST(1), ST(0) + FSTCW ControlWW + {$IFDEF PIC} + {$IFDEF CPU32} + FLDCW [EAX].RoundDown + {$ENDIF CPU32} + {$IFDEF CPU64} + FLDCW [RAX].RoundDown + {$ENDIF CPU64} + {$ELSE ~PIC} + FLDCW RoundDown + {$ENDIF ~PIC} + FLD ST(0) + FRNDINT + FLDCW ControlWW + FXCH + FSUB ST(0), ST(1) + F2XM1 + FLD1 + FADDP ST(1), ST(0) + FSCALE + FST ST(1) + FLD1 + FDIVRP ST(1), ST(0) + FSUBP ST(1), ST(0) + {$IFDEF PIC} + {$IFDEF CPU32} + FLD [EAX].OneHalf + {$ENDIF CPU32} + {$IFDEF CPU64} + FLD [RAX].OneHalf + {$ENDIF CPU64} + {$ELSE ~PIC} + FLD OneHalf + {$ENDIF ~PIC} + FMULP ST(1), ST(0) + FWAIT + FSTP Result + end; + {$ENDIF ~USE_MATH_UNIT} +end; +{$ENDIF ~PUREPASCAL} + +function TanH(X: Float): Float; +begin + if X > MaxTanH then + Result := 1.0 + else + begin + if X < -MaxTanH then + Result := -1.0 + else + begin + Result := JclMath.Exp(X); + Result := Result * Result; + Result := (Result - 1.0) / (Result + 1.0); + end; + end; +end; + +//=== Coordinate conversion ================================================== + +function DegMinSecToFloat(const Degs, Mins, Secs: Float): Float; // obsolete +begin + Result := Degs + (Mins / 60.0) + (Secs / 3600.0); +end; + +procedure FloatToDegMinSec(const X: Float; var Degs, Mins, Secs: Float); // obsolete +var + Y: Float; +begin + Degs := System.Int(X); + Y := Frac(X) * 60; + Mins := System.Int(Y); + Secs := Frac(Y) * 60; +end; + +//=== Exponential ============================================================ + +function Exp(const X: Float): Float; +begin + {$IFDEF MATH_EXT_EXTREMEVALUES} + {$IFDEF CPU32} + if IsSpecialValue(X) then + begin + if IsNaN(X) or (X = Infinity) then + Result := X + else + Result := 0; + Exit; + end; + {$ENDIF CPU32} + {$ENDIF MATH_EXT_EXTREMEVALUES} + + Result := System.Exp(X); +end; + +function Power(const Base, Exponent: Float): Float; +var + IsAnInteger, IsOdd: Boolean; +begin + if (Exponent = 0.0) or (Base = 1.0) then + Result := 1 + else + if Base = 0.0 then + begin + if Exponent > 0.0 then + Result := 0.0 + else + {$IFDEF MATH_EXT_EXTREMEVALUES} + Result := Infinity; + {$ELSE ~MATH_EXT_EXTREMEVALUES} + raise EJclMathError.CreateRes(@RsPowerInfinite); + {$ENDIF ~MATH_EXT_EXTREMEVALUES} + end + else + if Base > 0.0 then + Result := JclMath.Exp(Exponent * System.Ln(Base)) + else + begin + IsAnInteger := (Frac(Exponent) = 0.0); + if IsAnInteger then + begin + Result := JclMath.Exp(Exponent * System.Ln(Abs(Base))); + IsOdd := Abs(Round(ModFloat(Exponent, 2))) = 1; + if IsOdd then + Result := -Result; + end + else + raise EJclMathError.CreateRes(@RsPowerComplex); + end; +end; + +function PowerInt(const X: Float; N: Integer): Float; +var + M: Integer; + T: Float; + Xc: Float; +begin + if X = 0.0 then + begin + if N = 0 then + Result := 1.0 + else + if N > 0 then + Result := 0.0 + else + Result := MaxFloatingPoint; + Exit; + end; + + if N = 0 then + begin + Result := 1.0; + Exit; + end; + + // Legendre's algorithm for minimizing the number of multiplications + T := 1.0; + M := Abs(N); + Xc := X; + repeat + if Odd(M) then + begin + Dec(M); + T := T * Xc; + end + else + begin + M := M div 2; + Xc := Sqr(Xc); + end; + until M = 0; + + if N > 0 then + Result := T + else + Result := 1.0 / T; +end; + +function TenToY(const Y: Float): Float; +begin + if Y = 0.0 then + Result := 1.0 + else + Result := JclMath.Exp(Y * Ln10); +end; + +function TruncPower(const Base, Exponent: Float): Float; +begin + if Base > 0 then + Result := JclMath.Power(Base, Exponent) + else + Result := 0; +end; + +function TwoToY(const Y: Float): Float; +begin + if Y = 0.0 then + Result := 1.0 + else + Result := JclMath.Exp(Y * Ln2); +end; + +//=== Floating point support routines ======================================== + +function IsFloatZero(const X: Float): Boolean; +begin + Result := Abs(X) < PrecisionTolerance; +end; + +function FloatsEqual(const X, Y: Float): Boolean; +begin + try + if Y = 0 then + // catch exact equality + Result := (X = Y) or (Abs(1 - Y/X ) <= PrecisionTolerance) + else + // catch exact equality + Result := (X = Y) or (Abs(1 - X/Y ) <= PrecisionTolerance); + except + Result := False; // catch real rare overflow e.g. 1.0e3000/1.0e-3000 + end +end; + +function MaxFloat(const X, Y: Float): Float; +begin + if X < Y then + Result := Y + else + Result := X; +end; + +function MinFloat(const X, Y: Float): Float; +begin + if X > Y then + Result := Y + else + Result := X; +end; + +function ModFloat(const X, Y: Float): Float; +var + Z: Float; +begin + Result := X / Y; + Z := System.Int(Result); + if Frac(Result) < 0.0 then + Z := Z - 1.0; + Result := X - Y * Z; +end; + +function RemainderFloat(const X, Y: Float): Float; +begin + Result := X - System.Int(X / Y) * Y; +end; + +procedure SwapFloats(var X, Y: Float); +var + T: Float; +begin + T := X; + X := Y; + Y := T; +end; + +procedure CalcMachineEpsSingle; +var + One: Single; + T: Single; +begin + One := 1.0; + EpsSingle := One; + repeat + EpsSingle := 0.5 * EpsSingle; + T := One + EpsSingle; + until One = T; + EpsSingle := 2.0 * EpsSingle; + ThreeEpsSingle := 3.0 * EpsSingle; +end; + +procedure CalcMachineEpsDouble; +var + One: Double; + T: Double; +begin + One := 1.0; + EpsDouble := One; + repeat + EpsDouble := 0.5 * EpsDouble; + T := One + EpsDouble; + until One = T; + EpsDouble := 2.0 * EpsDouble; + ThreeEpsDouble := 3.0 * EpsDouble; +end; + +{$IFDEF SUPPORTS_EXTENDED} +procedure CalcMachineEpsExtended; +var + One: Extended; + T: Extended; +begin + One := 1.0; + EpsExtended := One; + repeat + EpsExtended := 0.5 * EpsExtended; + T := One + EpsExtended; + until One = T; + EpsExtended := 2.0 * EpsExtended; + ThreeEpsExtended := 3.0 * EpsExtended; +end; +{$ENDIF SUPPORTS_EXTENDED} + +procedure CalcMachineEps; +begin + {$IFDEF MATH_EXTENDED_PRECISION} + CalcMachineEpsExtended; + Epsilon := EpsExtended; + ThreeEpsilon := ThreeEpsExtended; + {$ENDIF MATH_EXTENDED_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + CalcMachineEpsDouble; + Epsilon := EpsDouble; + ThreeEpsilon := ThreeEpsDouble; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_SINGLE_PRECISION} + CalcMachineEpsSingle; + Epsilon := EpsSingle; + ThreeEpsilon := ThreeEpsSingle; + {$ENDIF MATH_SINGLE_PRECISION} +end; + +procedure SetPrecisionToleranceToEpsilon; +begin + CalcMachineEps; + PrecisionTolerance := Epsilon; +end; + +function SetPrecisionTolerance(NewTolerance: Float): Float; +begin + Result := PrecisionTolerance; + PrecisionTolerance := NewTolerance; +end; + +//=== Miscellaneous ========================================================== + +function Ceiling(const X: Float): Integer; +begin + Result := Integer(Trunc(X)); + if Frac(X) > 0 then + Inc(Result); +end; + +function CommercialRound(const X: Float): Int64; +begin + Result := Trunc(X); + if Frac(Abs(X)) >= 0.5 then + Result := Result + Sgn(X); +end; + +const + PreCompFactsCount = 33; // all factorials that fit in a Single + + {$IFDEF MATH_SINGLE_PRECISION} + PreCompFacts: array [0..PreCompFactsCount] of Float = + ( + 1.0, + 1.0, + 2.0, + 6.0, + 24.0, + 120.0, + 720.0, + 5040.0, + 40320.0, + 362880.0, + 3628800.0, + 39916800.0, + 479001600.0, + 6227020800.0, + 87178289152.0, + 1307674279936.0, + 20922788478976.0, + 355687414628352.0, + 6.4023735304192E15, + 1.21645096004223E17, + 2.43290202316367E18, + 5.10909408371697E19, + 1.12400072480601E21, + 2.58520174445945E22, + 6.20448454699065E23, + 1.55112110792462E25, + 4.03291499589617E26, + 1.08888704151327E28, + 3.04888371623715E29, + 8.8417630793192E30, + 2.65252889961724E32, + 8.22283968552752E33, + 2.63130869936881E35, + 8.68331850984666E36 + ); + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + PreCompFacts: array [0..PreCompFactsCount] of Float = + ( + 1.0, + 1.0, + 2.0, + 6.0, + 24.0, + 120.0, + 720.0, + 5040.0, + 40320.0, + 362880.0, + 3628800.0, + 39916800.0, + 479001600.0, + 6227020800.0, + 87178291200.0, + 1307674368000.0, + 20922789888000.0, + 355687428096000.0, + 6.402373705728E15, + 1.21645100408832E17, + 2.43290200817664E18, + 5.10909421717094E19, + 1.12400072777761E21, + 2.5852016738885E22, + 6.20448401733239E23, + 1.5511210043331E25, + 4.03291461126606E26, + 1.08888694504184E28, + 3.04888344611714E29, + 8.8417619937397E30, + 2.65252859812191E32, + 8.22283865417792E33, + 2.63130836933694E35, + 8.68331761881189E36 + ); + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + PreCompFacts: array [0..PreCompFactsCount] of Float = + ( + 1.0, + 1.0, + 2.0, + 6.0, + 24.0, + 120.0, + 720.0, + 5040.0, + 40320.0, + 362880.0, + 3628800.0, + 39916800.0, + 479001600.0, + 6227020800.0, + 87178291200.0, + 1307674368000.0, + 20922789888000.0, + 355687428096000.0, + 6.402373705728E15, + 1.21645100408832E17, + 2.43290200817664E18, + 5.10909421717094E19, + 1.12400072777761E21, + 2.5852016738885E22, + 6.20448401733239E23, + 1.5511210043331E25, + 4.03291461126606E26, + 1.08888694504184E28, + 3.04888344611714E29, + 8.8417619937397E30, + 2.65252859812191E32, + 8.22283865417792E33, + 2.63130836933694E35, + 8.68331761881189E36 + ); + {$ENDIF MATH_EXTENDED_PRECISION} + +function Factorial(const N: Integer): Float; +var + I: Integer; +begin + if (N < 0) or (N > MaxFactorial) then + Result := 0.0 + else + begin + if N <= PreCompFactsCount then + Result := PreCompFacts[N] + else + begin { TODO : Change following by: Gamma(N + 1) } + Result := PreCompFacts[PreCompFactsCount]; + for I := PreCompFactsCount + 1 to N do + Result := Result * I; + end; + end; +end; + +function Floor(const X: Float): Integer; +begin + Result := Integer(Trunc(X)); + if Frac(X) < 0 then + Dec(Result); +end; + +function GCD(X, Y: Cardinal): Cardinal; +{$IFDEF PUREPASCAL} +begin + Result := X; + while Y <> 0 do + begin + X := Result; + Result := Y; + Y := X mod Y; + end; +end; +{$ELSE ~PUREPASCAL} +assembler; +{ Euclid's algorithm } +asm + // 32 --> EAX X + // EDX Y + // <-- EAX Result + // 64 --> ECX X + // EDX Y + // <-- EAX Result + {$IFDEF CPU64} + MOV EAX, ECX + {$ENDIF CPU64} + JMP @01 // We start with EAX <- X, EDX <- Y, and check to see if Y=0 +@00: + MOV ECX, EDX // ECX <- EDX prepare for division + XOR EDX, EDX // clear EDX for Division + DIV ECX // EAX <- EDX:EAX div ECX, EDX <- EDX:EAX mod ECX + MOV EAX, ECX // EAX <- ECX, and repeat if EDX <> 0 +@01: + AND EDX, EDX // test to see if EDX is zero, without changing EDX + JNZ @00 // when EDX is zero EAX has the Result +end; +{$ENDIF ~PUREPASCAL} + +function ISqrt(const I: Smallint): Smallint; +{$IFDEF PUREPASCAL} +var + b, d: Smallint; +begin + Result := -1; + d := -1; + b := 0; + repeat + Inc(Result); + Inc(d, 2); + b := b + d; + until b > I; +end; +{$ELSE ~PUREPASCAL} +assembler; +asm + // 32 --> AX I + // <-- AX Result + // 64 --> CX I + // <-- AX Result + {$IFDEF CPU32} + PUSH EBX + MOV CX, AX // load argument + {$ENDIF CPU32} + {$IFDEF CPU64} + PUSH RBX + {$ENDIF CPU64} + + MOV AX, -1 // init Result + CWD // init odd numbers to -1 + XOR BX, BX // init perfect squares to 0 +@LOOP: + INC AX // increment Result + INC DX // compute + INC DX // next odd number + ADD BX, DX // next perfect square + CMP BX, CX // perfect square > argument ? + JBE @LOOP // until square greater than argument + + {$IFDEF CPU32} + POP EBX + {$ENDIF CPU32} + {$IFDEF CPU64} + POP RBX + {$ENDIF CPU64} +end; +{$ENDIF ~PUREPASCAL} + +function LCM(const X, Y: Cardinal): Cardinal; +var + E: Cardinal; +begin + E := GCD(X, Y); + if E > 0 then + Result := (X div E) * Y + else + Result := 0; +end; + +function NearestHigherMultiple(Num, Multiplicator: Integer): Integer; +begin + Result := Ceiling(Num / Multiplicator)*Multiplicator; +end; + +function NearestHigherMultiple(Num, Multiplicator: Int64): Int64; +begin + Result := Ceiling(Num / Multiplicator)*Multiplicator; +end; + +function NearestHigherMultiple(Num: Float; Multiplicator: Integer): Integer; +begin + Result := Ceiling(Num / Multiplicator)*Multiplicator; +end; + +function NearestHigherMultiple(Num: Float; Multiplicator: Int64): Int64; +begin + Result := Ceiling(Num / Multiplicator)*Multiplicator; +end; + +function NearestLowerMultiple(Num, Multiplicator: Integer): Integer; +begin + Result := Floor(Num / Multiplicator)*Multiplicator; +end; + +function NearestLowerMultiple(Num, Multiplicator: Int64): Int64; +begin + Result := Floor(Num / Multiplicator)*Multiplicator; +end; + +function NearestLowerMultiple(Num: Float; Multiplicator: Integer): Integer; +begin + Result := Floor(Num / Multiplicator)*Multiplicator; +end; + +function NearestLowerMultiple(Num: Float; Multiplicator: Int64): Int64; +begin + Result := Floor(Num / Multiplicator)*Multiplicator; +end; + +function NormalizeAngle(const Angle: Float): Float; +begin + Result := Angle; + if Result = 0 then + Exit; + + {$IFDEF MATH_ANGLE_DEGREES} + Result := DegToRad(Result); + {$ENDIF MATH_ANGLE_DEGREES} + {$IFDEF MATH_ANGLE_GRADS} + Result := GradToRad(Result); + {$ENDIF MATH_ANGLE_GRADS} + + if (Result < -Pi) or (Result >= Pi) then + begin + Result := Frac(Result * Inv2Pi); + if Result < 0 then + Result := Result + 1.0 + else + Result := Result - 1.0; + Result := Result * TwoPi; + end; + + {$IFDEF MATH_ANGLE_DEGREES} + Result := RadToDeg(Result); + {$ENDIF MATH_ANGLE_DEGREES} + {$IFDEF MATH_ANGLE_GRADS} + Result := RadToGrad(Result); + {$ENDIF MATH_ANGLE_GRADS} +end; + +function Pythagoras(const X, Y: Float): Float; +var + AbsX, AbsY: Float; +begin + AbsX := Abs(X); + AbsY := Abs(Y); + + if AbsX > AbsY then + Result := AbsX * Sqrt(1.0 + Sqr(AbsY / AbsX)) + else + if AbsY = 0.0 then + Result := 0.0 + else + Result := AbsY * Sqrt(1.0 + Sqr(AbsX / AbsY)); +end; + +function Sgn(const X: Float): Integer; +begin + if X > 0.0 then + Result := 1 + else + if X < 0.0 then + Result := -1 + else + Result := 0; +end; + +function Signe(const X, Y: Float): Float; +begin + if X > 0.0 then + begin + if Y > 0.0 then + Result := X + else + Result := -X; + end + else + begin + if Y < 0.0 then + Result := X + else + Result := -X; + end; +end; + +function Ackermann(const A, B: Integer): Integer; +begin + if A = 0 then + begin + Result := B + 1; + Exit; + end; + + if B = 0 then + Result := Ackermann(A - 1, 1) + else + Result := Ackermann(A - 1, Ackermann(A, B - 1)); +end; + +function Fibonacci(const N: Integer): Integer; +var + I: Integer; + P1, P2: Integer; +begin + Assert(N >= 0); + Result := 0; + P1 := 1; + P2 := 1; + + if (N = 1) or (N = 2) then + Result := 1 + else + for I := 3 to N do + begin + Result := P1 + P2; + P1 := P2; + P2 := Result; + end; +end; + +//=== { TJclFlatSet } ======================================================== + +constructor TJclFlatSet.Create; +begin + inherited Create; + FBits := TBits.Create; +end; + +destructor TJclFlatSet.Destroy; +begin + FBits.Free; + FBits := nil; + inherited Destroy; +end; + +procedure TJclFlatSet.Clear; +begin + FBits.Size := 0; +end; + +procedure TJclFlatSet.Invert; +var + I: Integer; +begin + for I := 0 to FBits.Size - 1 do + FBits[I] := not FBits[I]; +end; + +procedure TJclFlatSet.SetRange(const Low, High: Integer; const Value: Boolean); +var + I: Integer; +begin + for I := High downto Low do + FBits[I] := Value; +end; + +function TJclFlatSet.GetBit(const Idx: Integer): Boolean; +begin + Result := FBits[Idx]; +end; + +function TJclFlatSet.GetRange(const Low, High: Integer; const Value: Boolean): Boolean; +var + I: Integer; +begin + if not Value and (High >= FBits.Size) then + begin + Result := False; + Exit; + end; + for I := Low to Min(High, FBits.Size - 1) do + if FBits[I] <> Value then + begin + Result := False; + Exit; + end; + Result := True; +end; + +procedure TJclFlatSet.SetBit(const Idx: Integer; const Value: Boolean); +begin + FBits[Idx] := Value; +end; + +//== { TJclSparseFlatSet } =================================================== + +destructor TJclSparseFlatSet.Destroy; +begin + Clear; + inherited Destroy; +end; + +procedure TJclSparseFlatSet.Clear; +var + F: Integer; +begin + if FSetList <> nil then + begin + for F := 0 to FSetListEntries - 1 do + if FSetList^[F] <> nil then + Dispose(PDelphiSet(FSetList^[F])); + FreeMem(FSetList, FSetListEntries * SizeOf(Pointer)); + FSetList := nil; + FSetListEntries := 0; + end; +end; + +procedure TJclSparseFlatSet.Invert; +var + F: Integer; +begin + for F := 0 to FSetListEntries - 1 do + if FSetList^[F] <> nil then + PDelphiSet(FSetList^[F])^ := CompleteDelphiSet - PDelphiSet(FSetList^[F])^; +end; + +function TJclSparseFlatSet.GetBit(const Idx: Integer): Boolean; +var + SetIdx: Integer; +begin + SetIdx := Idx shr 8; + Result := (SetIdx < FSetListEntries) and (FSetList^[SetIdx] <> nil) and + (Byte(Idx and $FF) in PDelphiSet(FSetList^[SetIdx])^); +end; + +procedure TJclSparseFlatSet.SetBit(const Idx: Integer; const Value: Boolean); +var + I, SetIdx: Integer; + S: PDelphiSet; +begin + SetIdx := Idx shr 8; + if SetIdx >= FSetListEntries then + if Value then + begin + I := FSetListEntries; + FSetListEntries := SetIdx + 1; + ReallocMem(FSetList, FSetListEntries * SizeOf(Pointer)); + FillChar(FSetList^[I], (FSetListEntries - I) * SizeOf(Pointer), #0); + end + else + Exit; + S := FSetList^[SetIdx]; + if S = nil then + if Value then + begin + New(S); + S^ := []; + FSetList^[SetIdx] := S; + end + else + Exit; + Include(S^, Byte(Idx and $FF)); +end; + +procedure TJclSparseFlatSet.SetRange(const Low, High: Integer; const Value: Boolean); +var + I, LowSet, HighSet: Integer; + + procedure SetValue(const S: TDelphiSet; const SetIdx: Integer); + var + D: PDelphiSet; + begin + D := FSetList^[SetIdx]; + if D = nil then + begin + if Value then + begin + New(D); + D^ := S; + FSetList^[SetIdx] := D; + end; + end + else + if Value then + D^ := D^ + S + else + D^ := D^ - S; + end; + +begin + LowSet := Low shr 8; + HighSet := High shr 8; + if HighSet >= FSetListEntries then + begin + I := FSetListEntries; + FSetListEntries := HighSet + 1; + ReallocMem(FSetList, FSetListEntries * SizeOf(Pointer)); + FillChar(FSetList^[I], (FSetListEntries - I) * SizeOf(Pointer), #0); + end; + if LowSet = HighSet then + SetValue([Byte(Low and $FF)..Byte(High and $FF)], LowSet) + else + begin + SetValue([Byte(Low and $FF)..$FF], LowSet); + SetValue([0..Byte(High and $FF)], HighSet); + for I := LowSet + 1 to HighSet - 1 do + SetValue(CompleteDelphiSet, I); + end; +end; + +function TJclSparseFlatSet.GetRange(const Low, High: Integer; const Value: Boolean): Boolean; +var + I: Integer; +begin + if not Value and (High >= FSetListEntries) then + begin + Result := False; + Exit; + end; + for I := Low to Min(High, FSetListEntries) do + if GetBit(I) <> Value then + begin + Result := False; + Exit; + end; + Result := True; +end; + +//=== Ranges ================================================================= + +function EnsureRange(const AValue, AMin, AMax: Integer): Integer; +begin + Result := AValue; + Assert(AMin <= AMax); + if Result < AMin then + Result := AMin; + if Result > AMax then + Result := AMax; +end; + +function EnsureRange(const AValue, AMin, AMax: Int64): Int64; +begin + Result := AValue; + Assert(AMin <= AMax); + if Result < AMin then + Result := AMin; + if Result > AMax then + Result := AMax; +end; + +function EnsureRange(const AValue, AMin, AMax: Double): Double; +begin + Result := AValue; + Assert(AMin <= AMax); + if Result < AMin then + Result := AMin; + if Result > AMax then + Result := AMax; +end; + +//=== Prime numbers ========================================================== + +const + PrimeCacheLimit = 65537; // 4K lookup table. Note: Sqr(65537) > MaxLongint + +var + PrimeSet: TJclFlatSet = nil; + +procedure InitPrimeSet; +var + I, J, MaxI, MaxJ : Integer; +begin + PrimeSet := TJclFlatSet.Create; + PrimeSet.SetRange(1, PrimeCacheLimit div 2, True); + PrimeSet.SetBit(0, False); // 1 is no prime + MaxI := Trunc(Sqrt(PrimeCacheLimit)); + I := 3; + repeat + if PrimeSet.GetBit(I div 2) then + begin + MaxJ := PrimeCacheLimit div I; + J := 3; + repeat + PrimeSet.SetBit((I*J) div 2, False); + Inc(J,2); + until J > MaxJ; + end; + Inc(I, 2); + until I > MaxI; +end; + +function IsPrimeTD(N: Cardinal): Boolean; +{ Trial Division Algorithm } +var + I, Max: Cardinal; + R: Extended; +begin + if N = 2 then + begin + Result := True; + Exit; + end; + if (N and 1) = 0 then //Zero or even + begin + Result := False; + Exit; + end; + if PrimeSet = nil then // initialize look-up table + InitPrimeSet; + if N <= PrimeCacheLimit then // do look-up + Result := PrimeSet.GetBit(N div 2) + else + begin // calculate + R := N; + Max := Round(Sqrt (R)); + if Max > PrimeCacheLimit then + begin + raise EJclMathError.CreateRes(@RsUnexpectedValue); + Exit; + end; + I := 1; + repeat + Inc(I,2); + if PrimeSet.GetBit(I div 2) then + if N mod I = 0 then + begin + Result := False; + Exit; + end; + until I >= Max; + Result := True; + end; +end; + +{$IFDEF CPU32} +// OF: need a complete rewrite for CPU64 +// OF: why is there less pop than push? + +{ Rabin-Miller Strong Primality Test } + +function IsPrimeRM(N: Cardinal): Boolean; assembler; +asm + // 32 --> EAX N + // <-- AL Result + TEST EAX,1 // Odd(N) ?? + JNZ @@1 + CMP EAX,2 // N == 2 ?? + SETE AL + RET +@@1: CMP EAX,73 + JBE @@C + PUSH ESI + PUSH EDI + PUSH EBX + PUSH EBP + PUSH EAX // save N as Param for @@5 + MOV EBP, EAX + DEC EBP // M == N -1, Exponent + MOV ECX,32 // calc remaining Bits of M and shift M' + MOV ESI,EBP +@@2: DEC ECX + SHL ESI,1 + JNC @@2 + PUSH ECX // save Bits as Param for @@5 + PUSH ESI // save M' as Param for @@5 + CMP EAX,08A8D7Fh // N >= 9080191 ?? + JAE @@3 +// now if (N < 9080191) and SPP(31, N) and SPP(73, N) then N is prime + MOV EAX,31 + CALL @@5 + JC @@4 + MOV EAX,73 + PUSH OFFSET @@4 + JMP @@5 +// now if (N < 4759123141) and SPP(2, N) and SPP(7, N) and SPP(61, N) then N is prime +@@3: MOV EAX,2 + CALL @@5 + JC @@4 + MOV EAX,7 + CALL @@5 + JC @@4 + MOV EAX,61 + CALL @@5 +@@4: SETNC AL + ADD ESP,4 * 3 + POP EBP + POP EBX + POP EDI + POP ESI + RET +// do a Strong Pseudo Prime Test +@@5: + MOV EBX,[ESP + 12] // N on stack + MOV ECX,[ESP + 8] // remaining Bits + MOV ESI,[ESP + 4] // M' + MOV EDI,EAX // T = b, temp. Base +@@6: DEC ECX + MUL EAX + DIV EBX + MOV EAX,EDX + SHL ESI,1 + JNC @@7 + MUL EDI + DIV EBX + AND ESI,ESI + MOV EAX,EDX +@@7: JNZ @@6 + CMP EAX,1 // b^((N -1)(2^s)) mod N == 1 mod N ?? + JE @@A +@@8: CMP EAX,EBP // b^((N -1)(2^s)) mod N == -1 mod N ?? + JE @@A + DEC ECX // second part to 2^s + JNG @@9 + MUL EAX + DIV EBX + CMP EDX,1 + MOV EAX,EDX + JNE @@8 +@@9: STC +@@A: RET +@@B: DB 3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73 +@@C: MOV ECX,19 + MOV EDX,OFFSET @@B +@@D: CMP AL,[EDX + ECX] + JE @@E + DEC ECX + JNL @@D +@@E: SETE AL +end; +{$ENDIF CPU32} + +function PrimeFactors(N: Cardinal): TDynCardinalArray; +var + I, L, Max: Cardinal; + R: Extended; +begin + SetLength(Result, 0); + if N <= 1 then + Exit + else + begin + if PrimeSet = nil then + InitPrimeSet; + L := 0; + R := N; + R := Sqrt(R); + Max := Round(R); // only one factor can be > Sqrt (N) + if N mod 2 = 0 then // test even at first + begin // 2 is a prime factor + Inc(L); + SetLength(Result, L); + Result[L - 1] := 2; + repeat + N := N div 2; + if N = 1 then // no more factors + Exit; + until N mod 2 <> 0; + end; + I := 3; // test all odd factors + repeat + if (N mod I = 0) and IsPrime(I) then + begin // I is a prime factor + Inc(L); + SetLength(Result, L); + Result[L - 1] := I; + repeat + N := N div I; + if N = 1 then // no more factors + Exit; + until N mod I <> 0; + end; + Inc(I, 2); + until I > Max; + Inc(L); // final factor (> Sqrt(N)) + SetLength(Result, L); + Result[L - 1] := N; + end; +end; + +function IsPrimeFactor(const F, N: Cardinal): Boolean; +begin + Result := (N mod F = 0) and IsPrime(F); +end; + +function IsRelativePrime(const X, Y: Cardinal): Boolean; +begin + Result := GCD(X, Y) = 1; +end; + +procedure SetPrimalityTest(const Method: TPrimalityTestMethod); +begin + case Method of + ptTrialDivision: + IsPrime := IsPrimeTD; + {$IFDEF CPU32} + ptRabinMiller: + IsPrime := IsPrimeRM; + {$ENDIF CPU32} + end; +end; + +{$IFDEF CPU32} + +//=== Floating point value classification ==================================== + +type + TC3C2C0 = 0..6; + +const + FPClasses: array [TC3C2C0] of TFloatingPointClass = + ( + fpInvalid, + fpNaN, + fpNormal, + fpInfinite, + fpZero, + fpEmpty, + fpDenormal + ); + +// _C3C2C0 returns the set of condition code flags C0, C2, and C3 of the FPU status word +// to indicate the class of value or number in register ST(0) as follows: +// C0 in Bit 0 of EAX +// C2 in Bit 1 of EAX +// C3 in Bit 2 of EAX + +function _C3C2C0: TC3C2C0; assembler; +// In: ST(0) Value to examine +asm + FXAM + XOR EDX, EDX + FNSTSW AX + FFREE ST(0) + FINCSTP + BT EAX, 14 // C3 + RCL EDX, 1 + BT EAX, 10 // C2 + RCL EDX, 1 + BT EAX, 8 // C0 + RCL EDX, 1 + MOV EAX, EDX +end; + +function C3C2C0(const Value: Single): TC3C2C0; overload; assembler; +asm + FLD Value + CALL _C3C2C0 +end; + +function C3C2C0(const Value: Double): TC3C2C0; overload; assembler; +asm + FLD Value + CALL _C3C2C0 +end; + +{$IFDEF SUPPORTS_EXTENDED} +function C3C2C0(const Value: Extended): TC3C2C0; overload; assembler; +asm + FLD Value + CALL _C3C2C0 +end; +{$ENDIF SUPPORTS_EXTENDED} + +function FloatingPointClass(const Value: Single): TFloatingPointClass; overload; +begin + Result := FPClasses[C3C2C0(Value)]; +end; + +function FloatingPointClass(const Value: Double): TFloatingPointClass; overload; +begin + Result := FPClasses[C3C2C0(Value)]; +end; + +{$IFDEF SUPPORTS_EXTENDED} +function FloatingPointClass(const Value: Extended): TFloatingPointClass; overload; +begin + Result := FPClasses[C3C2C0(Value)]; +end; +{$ENDIF SUPPORTS_EXTENDED} + +//=== NaN and Infinity support =============================================== + +function IsInfinite(const Value: Single): Boolean; overload; +begin + Result := FloatingPointClass(Value) = fpInfinite; +end; + +function IsInfinite(const Value: Double): Boolean; overload; +begin + Result := FloatingPointClass(Value) = fpInfinite; +end; + +{$IFDEF SUPPORTS_EXTENDED} +function IsInfinite(const Value: Extended): Boolean; overload; +begin + Result := FloatingPointClass(Value) = fpInfinite; +end; +{$ENDIF SUPPORTS_EXTENDED} + +const + sSignBit = 31; + dSignBit = 63; + xSignBit = 79; + +type + TSingleBits = set of 0..sSignBit; + TDoubleBits = set of 0..dSignBit; + TExtendedBits = set of 0..xSignBit; + + sFractionBits = 0..22; // Single type fraction bits + dFractionBits = 0..51; // Double type fraction bits + xFractionBits = 0..62; // Extended type fraction bits + + sExponentBits = 23..sSignBit-1; + dExponentBits = 52..dSignBit-1; + xExponentBits = 64..xSignBit-1; + + {$IFNDEF FPC} + QWord = Int64; + {$ENDIF ~FPC} + + PExtendedRec = ^TExtendedRec; + TExtendedRec = packed record + Significand: QWord; + Exponent: Word; + end; + +const + ZeroTag = $3FFFFF; + InvalidTag = TNaNTag($80000000); + NaNTagMask = $3FFFFF; + + sNaNQuietFlag = High(sFractionBits); + dNaNQuietFlag = High(dFractionBits); + xNaNQuietFlag = High(xFractionBits); + + dNaNTagShift = High(dFractionBits) - High(sFractionBits); + xNaNTagShift = High(xFractionBits) - High(sFractionBits); + + sNaNBits = $7F800000; + dNaNBits = $7FF0000000000000; + + sQuietNaNBits = sNaNBits or (1 shl sNaNQuietFlag); + dQuietNaNBits = dNaNBits or (Int64(1) shl dNaNQuietFlag); + +function IsNaN(const Value: Single): Boolean; overload; +begin + Result := FloatingPointClass(Value) = fpNaN; +end; + +function IsNaN(const Value: Double): Boolean; overload; +begin + Result := FloatingPointClass(Value) = fpNaN; +end; + +{$IFDEF SUPPORTS_EXTENDED} +function IsNaN(const Value: Extended): Boolean; overload; +begin + Result := FloatingPointClass(Value) = fpNaN; +end; +{$ENDIF SUPPORTS_EXTENDED} + +procedure CheckNaN(const Value: Single); overload; +var + SaveExMask: T8087Exceptions; +begin + SaveExMask := Mask8087Exceptions([emInvalidOp]); + try + if FloatingPointClass(Value) <> fpNaN then + raise EJclMathError.CreateRes(@RsNoNaN); + finally + SetMasked8087Exceptions(SaveExMask); + end; +end; + +procedure CheckNaN(const Value: Double); overload; +var + SaveExMask: T8087Exceptions; +begin + SaveExMask := Mask8087Exceptions([emInvalidOp]); + try + if FloatingPointClass(Value) <> fpNaN then + raise EJclMathError.CreateRes(@RsNoNaN); + finally + SetMasked8087Exceptions(SaveExMask); + end; +end; + +{$IFDEF SUPPORTS_EXTENDED} +procedure CheckNaN(const Value: Extended); overload; +var + SaveExMask: T8087Exceptions; +begin + SaveExMask := Mask8087Exceptions([emInvalidOp]); + try + if FloatingPointClass(Value) <> fpNaN then + raise EJclMathError.CreateRes(@RsNoNaN); + finally + SetMasked8087Exceptions(SaveExMask); + end; +end; +{$ENDIF SUPPORTS_EXTENDED} + +function GetNaNTag(const NaN: Single): TNaNTag; +var + Temp: Integer; +begin + CheckNaN(NaN); + Temp := PLongint(@NaN)^ and NaNTagMask; + if sSignBit in TSingleBits(NaN) then + Result := -Temp + else + if Temp = ZeroTag then + Result := 0 + else + Result := Temp; +end; + +function GetNaNTag(const NaN: Double): TNaNTag; +var + Temp: Integer; +begin + CheckNaN(NaN); + Temp := (PInt64(@NaN)^ shr dNaNTagShift) and NaNTagMask; + {$IFDEF FPC} + if Int64(NaN) < 0 then + {$ELSE ~FPC} + if dSignBit in TDoubleBits(NaN) then + {$ENDIF ~FPC} + Result := -Temp + else + if Temp = ZeroTag then + Result := 0 + else + Result := Temp; +end; + +{$IFDEF SUPPORTS_EXTENDED} +function GetNaNTag(const NaN: Extended): TNaNTag; +var + Temp: Integer; +begin + CheckNaN(NaN); + Temp := (PExtendedRec(@NaN)^.Significand shr xNaNTagShift) and NaNTagMask; + {$IFDEF FPC} + if (TExtendedRec(NaN).Exponent and $8000) <> 0 then + {$ELSE ~FPC} + if xSignBit in TExtendedBits(NaN) then + {$ENDIF ~FPC} + Result := -Temp + else + if Temp = ZeroTag then + Result := 0 + else + Result := Temp; +end; +{$ENDIF SUPPORTS_EXTENDED} + +{$IFDEF MSWINDOWS} +// ExceptObjProc is not used in FPC +{$IFNDEF FPC} + +type + TRealType = (rtUndef, rtSingle, rtDouble, rtExtended); + + { ExceptionInformation record for FPU exceptions under WinNT, + where documented? } + PFPUExceptionInfo = ^TFPUExceptionInfo; + TFPUExceptionInfo = packed record + Unknown: array [0..7] of Longint; + ControlWord: Word; + Dummy1: Word; + StatusWord: Word; + Dummy2: Word; + TagWord: Word; + Dummy3: Word; + InstructionPtr: Pointer; + UnknownW: Word; + OpCode: Word; // Note: 5 most significant bits of first opcode byte + // (always 11011b) not stored in FPU opcode register + OperandPtr: Pointer; + UnknownL: Longint; + end; + + TExceptObjProc = function(P: PExceptionRecord): Exception; + +var + PrevExceptObjProc: TExceptObjProc; + ExceptObjProcInitialized: Integer = 0; + +function GetExceptionObject(P: PExceptionRecord): Exception; +var + Tag: TNaNTag; + FPUExceptInfo: PFPUExceptionInfo; + OPtr: Pointer; + OType: TRealType; + + function GetOperandType(OpCode: Word): TRealType; + var + NNN: 0..7; + begin + Result := rtUndef; + NNN := (Lo(OpCode) shr 3) and 7; // NNN field of ModR/M byte + if Lo(OpCode) <= $BF then + case Hi(OpCode) of // 3 least significant bits of first opcode byte + 0: + Result := rtSingle; + 1: + if NNN < 4 then + Result := rtSingle; + // Extended signaling NaNs don't cause exceptions on FLD/FST(P) ?! + 3: + if NNN = 5 then + Result := rtExtended; + 4: + Result := rtDouble; + 5: + if NNN = 0 then + Result := rtDouble; + end; + end; + +begin + Tag := InvalidTag; // shut up compiler warning + OType := rtUndef; + if P^.ExceptionCode = STATUS_FLOAT_INVALID_OPERATION then + begin + FPUExceptInfo := @P^.ExceptionInformation; + OPtr := FPUExceptInfo^.OperandPtr; + OType := GetOperandType(FPUExceptInfo^.OpCode); + case OType of + rtSingle: + Tag := GetNaNTag(PSingle(OPtr)^); + rtDouble: + Tag := GetNaNTag(PDouble(OPtr)^); + rtExtended: + Tag := GetNaNTag(PExtended(OPtr)^); + end; + end; + + if OType = rtUndef then + Result := PrevExceptObjProc(P) + else + Result := EJclNaNSignal.Create(Tag); +end; + +procedure InitExceptObjProc; +begin + if LockedExchange(ExceptObjProcInitialized, 1) = 0 then + if Win32Platform = VER_PLATFORM_WIN32_NT then + {$IFDEF RTL200_UP} // Delphi 2009+ + PrevExceptObjProc := InterlockedExchangePointer(ExceptObjProc, @GetExceptionObject); + {$ELSE} + PrevExceptObjProc := Pointer(InterlockedExchange(Integer(ExceptObjProc), Integer(@GetExceptionObject))); + {$ENDIF RTL200_UP} +end; +{$ENDIF ~FPC} +{$ENDIF MSWINDOWS} + +procedure CheckTag(Tag: TNaNTag); +begin + if (Tag < LowValidNaNTag) or (Tag > HighValidNaNTag) then + raise EJclMathError.CreateResFmt(@RsNaNTagError, [Tag]); +end; + +procedure MakeQuietNaN(var X: Single; Tag: TNaNTag); +var + Bits: LongWord; +begin + CheckTag(Tag); + if Tag = 0 then + Bits := ZeroTag or sQuietNaNBits + else + Bits := Abs(Tag) or sQuietNaNBits; + if Tag < 0 then + Include(TSingleBits(Bits), sSignBit); + PLongWord(@X)^ := Bits; +end; + +procedure MakeQuietNaN(var X: Double; Tag: TNaNTag); +var + Bits: Int64; +begin + CheckTag(Tag); + if Tag = 0 then + Bits := ZeroTag + else + Bits := Abs(Tag); + PInt64(@X)^ := (Bits shl dNaNTagShift) or dQuietNaNBits; + if Tag < 0 then + {$IFDEF FPC} + QWord(X) := QWord(X) or (1 shl dSignBit); + {$ELSE ~FPC} + Include(TDoubleBits(X), dSignBit); + {$ENDIF ~FPC} +end; + +{$IFDEF SUPPORTS_EXTENDED} +procedure MakeQuietNaN(var X: Extended; Tag: TNaNTag); +const + QuietNaNSignificand = $C000000000000000; + QuietNaNExponent = $7FFF; +var + Bits: Int64; +begin + CheckTag(Tag); + if Tag = 0 then + Bits := ZeroTag + else + Bits := Abs(Tag); + TExtendedRec(X).Significand := (Bits shl xNaNTagShift) or QuietNaNSignificand; + TExtendedRec(X).Exponent := QuietNaNExponent; + if Tag < 0 then + {$IFDEF FPC} + TExtendedRec(X).Exponent := TExtendedRec(X).Exponent or $8000; + {$ELSE ~FPC} + Include(TExtendedBits(X), xSignBit); + {$ENDIF ~FPC} +end; +{$ENDIF SUPPORTS_EXTENDED} + +procedure MakeSignalingNaN(var X: Single; Tag: TNaNTag); +begin + {$IFDEF MSWINDOWS} + {$IFNDEF FPC} + InitExceptObjProc; + {$ENDIF ~FPC} + {$ENDIF MSWINDOWS} + MakeQuietNaN(X, Tag); + Exclude(TSingleBits(X), sNaNQuietFlag); +end; + +procedure MakeSignalingNaN(var X: Double; Tag: TNaNTag); +begin + {$IFDEF MSWINDOWS} + {$IFNDEF FPC} + InitExceptObjProc; + {$ENDIF ~FPC} + {$ENDIF MSWINDOWS} + {$IFDEF FPC} + MakeQuietNaN(X, Tag); + QWord(X) := QWord(X) and not (1 shl dNaNQuietFlag); + {$ELSE ~FPC} + MakeQuietNaN(X, Tag); + Exclude(TDoubleBits(X), dNaNQuietFlag); + {$ENDIF ~FPC} +end; + +{$IFDEF SUPPORTS_EXTENDED} +procedure MakeSignalingNaN(var X: Extended; Tag: TNaNTag); +begin + {$IFDEF FPC} + MakeQuietNaN(X, Tag); + TExtendedRec(X).Significand := TExtendedRec(X).Significand and not (1 shl xNaNQuietFlag); + {$ELSE ~FPC} + {$IFDEF MSWINDOWS} + InitExceptObjProc; + {$ENDIF MSWINDOWS} + MakeQuietNaN(X, Tag); + Exclude(TExtendedBits(X), xNaNQuietFlag); + {$ENDIF ~FPC} +end; +{$ENDIF SUPPORTS_EXTENDED} + +procedure MineSingleBuffer(var Buffer; Count: Integer; StartTag: TNaNTag); +var + Tag, StopTag: TNaNTag; + P: PLongint; +begin + {$IFDEF MSWINDOWS} + {$IFNDEF FPC} + InitExceptObjProc; + {$ENDIF ~FPC} + {$ENDIF MSWINDOWS} + StopTag := StartTag + Count - 1; + CheckTag(StartTag); + CheckTag(StopTag); + P := @Buffer; + for Tag := StartTag to StopTag do + begin + if Tag > 0 then + P^ := sNaNBits or Tag + else + if Tag < 0 then + P^ := sNaNBits or Longint($80000000) or -Tag + else + P^ := sNaNBits or ZeroTag; + Inc(P); + end; +end; + +procedure MineDoubleBuffer(var Buffer; Count: Integer; StartTag: TNaNTag); +var + Tag, StopTag: TNaNTag; + P: PInt64; +begin + {$IFDEF MSWINDOWS} + {$IFNDEF FPC} + InitExceptObjProc; + {$ENDIF ~FPC} + {$ENDIF MSWINDOWS} + StopTag := StartTag + Count - 1; + CheckTag(StartTag); + CheckTag(StopTag); + P := @Buffer; + for Tag := StartTag to StopTag do + begin + if Tag > 0 then + P^ := dNaNBits or (Int64(Tag) shl dNaNTagShift) + else + if Tag < 0 then + P^ := dNaNBits or $8000000000000000 or (Int64(-Tag) shl dNaNTagShift) + else + P^ := dNaNBits or (Int64(ZeroTag) shl dNaNTagShift); + Inc(P); + end; +end; + +function MinedSingleArray(Length: Integer): TDynSingleArray; +begin + SetLength(Result, Length); + MineSingleBuffer(Result[0], Length, 0); +end; + +function MinedDoubleArray(Length: Integer): TDynDoubleArray; +begin + SetLength(Result, Length); + MineDoubleBuffer(Result[0], Length, 0); +end; + +function IsSpecialValue(const X: Float): Boolean; +begin + Result := IsNaN(X) or IsInfinite(X); +end; + +//=== { EJclNaNSignal } ====================================================== + +constructor EJclNaNSignal.Create(ATag: TNaNTag; Dummy: Boolean); +begin + FTag := ATag; + CreateResFmt(@RsNaNSignal, [ATag]); +end; + +{$ENDIF CPU32} + +//=== { TJclRational } ======================================================= + +constructor TJclRational.Create(const Numerator: Integer; const Denominator: Integer); +begin + inherited Create; + Assign(Numerator, Denominator); +end; + +constructor TJclRational.Create; +begin + inherited Create; + AssignZero; +end; + +constructor TJclRational.Create(const R: Float); +begin + inherited Create; + Assign(R); +end; + +procedure TJclRational.Simplify; +var + I: Integer; +begin + if FN < 0 then + begin + FT := -FT; + FN := -FN; + end; + + if (FT = 1) or (FN = 1) or (FT = 0) then + Exit; + + I := GCD(System.Abs(FT), FN); + FT := FT div I; + FN := FN div I; +end; + +procedure TJclRational.Assign(const Numerator: Integer; const Denominator: Integer); +begin + if Denominator = 0 then + raise EJclMathError.CreateRes(@RsInvalidRational); + FT := Numerator; + FN := Denominator; + if FN <> 1 then + Simplify; +end; + +procedure TJclRational.Assign(const R: TJclRational); +begin + FT := R.FT; + FN := R.FN; +end; + +procedure TJclRational.Assign(const R: Float); +var + T: TJclRational; + Z: Integer; + + function CalcFrac(const R: Float; const Level: Integer): TJclRational; + var + I: Float; + Z: Integer; + begin + if IsFloatZero(R) or (Level = 12) then // 0 (if Level = 12 we get an approximation) + Result := TJclRational.Create + else + if FloatsEqual(R, 1.0) then // 1 + begin + Result := TJclRational.Create; + Result.AssignOne; + end + else + if IsFloatZero(Frac(R * 1E8)) then // terminating decimal (<8) + Result := TJclRational.Create(Trunc(R * 1E8), 100000000) + else + begin // recursive process + I := 1.0 / R; + Result := CalcFrac(Frac(I), Level + 1); + Z := Trunc(I); + Result.Add(Z); + Result.Reciprocal; + end; + end; + +begin + T := CalcFrac(Frac(R), 1); + try + Z := Trunc(R); + T.Add(Z); + Assign(T); + finally + T.Free; + end; +end; + +procedure TJclRational.AssignOne; +begin + FT := 1; + FN := 1; +end; + +procedure TJclRational.AssignZero; +begin + FT := 0; + FN := 1; +end; + +function TJclRational.IsEqual(const Numerator: Integer; const Denominator: Integer): Boolean; +var + R: TJclRational; +begin + R := TJclRational.Create(Numerator, Denominator); + Result := IsEqual(R); + R.Free; +end; + +function TJclRational.IsEqual(const R: TJclRational): Boolean; +begin + Result := (FT = R.FT) and (FN = R.FN); +end; + +function TJclRational.IsEqual(const R: Float): Boolean; +begin + Result := FloatsEqual(R, GetAsFloat); +end; + +function TJclRational.IsOne: Boolean; +begin + Result := (FT = 1) and (FN = 1); +end; + +function TJclRational.IsZero: Boolean; +begin + Result := FT = 0; +end; + +function TJclRational.Duplicate: TJclRational; +begin + Result := TJclRational.Create(FT, FN); +end; + +procedure TJclRational.SetAsFloat(const R: Float); +begin + Assign(R); +end; + +procedure TJclRational.SetAsString(const S: string); +var + F: Integer; +begin + F := Pos('/', S); + if F = 0 then + Assign(StrToFloat(S)) + else + Assign(StrToInt(Trim(Copy(S,1,F - 1))), StrToInt(Trim(Copy(S, F + 1,Length(s))))); +end; + +function TJclRational.GetAsFloat: Float; +begin + Result := FT / FN; +end; + +function TJclRational.GetAsString: string; +begin + Result := IntToStr(FT) + '/' + IntToStr(FN); +end; + +procedure TJclRational.Add(const R: TJclRational); +begin + FT := FT * R.FN + R.FT * FN; + FN := FN * R.FN; + Simplify; +end; + +procedure TJclRational.Add(const V: Integer); +begin + Inc(FT, FN * V); +end; + +procedure TJclRational.Add(const V: Float); +begin + Assign(GetAsFloat + V); +end; + +procedure TJclRational.Subtract(const V: Float); +begin + Assign(GetAsFloat - V); +end; + +procedure TJclRational.Subtract(const R: TJclRational); +begin + FT := FT * R.FN - R.FT * FN; + FN := FN * R.FN; + Simplify; +end; + +procedure TJclRational.Subtract(const V: Integer); +begin + Dec(FT, FN * V); +end; + +procedure TJclRational.Negate; +begin + FT := -FT; +end; + +procedure TJclRational.Abs; +begin + FT := System.Abs(FT); + FN := System.Abs(FN); +end; + +function TJclRational.Sgn: Integer; +begin + if FT = 0 then + Result := 0 + else + begin + if JclMathSgn(FT) = JclMathSgn(FN) then + Result := 1 + else + Result := -1; + end; +end; + +procedure TJclRational.Divide(const V: Integer); +begin + if V = 0 then + raise EJclMathError.CreateRes(@RsDivByZero); + + FN := FN * V; + Simplify; +end; + +procedure TJclRational.Divide(const R: TJclRational); +begin + if R.FT = 0 then + raise EJclMathError.CreateRes(@RsRationalDivByZero); + + FT := FT * R.FN; + FN := FN * R.FT; + Simplify; +end; + +procedure TJclRational.Divide(const V: Float); +begin + Assign(GetAsFloat / V); +end; + +procedure TJclRational.Reciprocal; +begin + if FT = 0 then + raise EJclMathError.CreateRes(@RsRationalDivByZero); + + SwapOrd(FT, FN); +end; + +procedure TJclRational.Multiply(const R: TJclRational); +begin + FT := FT * R.FT; + FN := FN * R.FN; + Simplify; +end; + +procedure TJclRational.Multiply(const V: Integer); +begin + FT := FT * V; + Simplify; +end; + +procedure TJclRational.Multiply(const V: Float); +begin + Assign(GetAsFloat * V); +end; + +procedure TJclRational.Power(const R: TJclRational); +begin + Assign(JclMathPower(GetAsFloat, R.GetAsFloat)); +end; + +procedure TJclRational.Power(const V: Integer); +var + T, N: Extended; +begin + T := FT; + N := FN; + FT := Round(JclMathPower(T, V)); + FN := Round(JclMathPower(N, V)); +end; + +procedure TJclRational.Power(const V: Float); +begin + Assign(JclMathPower(FT, V) / JclMathPower(FN, V)); +end; + +procedure TJclRational.Sqrt; +begin + Assign(System.Sqrt(FT / FN)); +end; + +procedure TJclRational.Sqr; +begin + FT := System.Sqr(FT); + FN := System.Sqr(FN); +end; + +//=== Checksums ============================================================== + +// See also: CountBitsSet in JclLogic (bug fixing etc.) - similar algorithm! + +function GetParity(Buffer: TDynByteArray; Len: Integer): Boolean; +const + lu: packed array [0..15] of Byte = + (0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4); +var + b: Byte; + BitsSet: Cardinal; + Index: Cardinal; +begin + BitsSet := 0; + Index := 0; + if Len > Length(Buffer) then + Len := Length(Buffer); + while Len > 0 do + begin + b := Buffer[Index]; + // lower Nibble + Inc(BitsSet, lu[b and $0F]); + // upper Nibble + Inc(BitsSet, lu[b shr 4]); + + Dec(Len); + Inc(Index); + end; + + Result := (BitsSet mod 2) = 0; +end; + +function GetParity(Buffer: PByte; Len: Integer): Boolean; +const + lu: packed array [0..15] of Byte = + (0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4); +var + b: Byte; + BitsSet: Cardinal; +begin + BitsSet := 0; + while Len > 0 do + begin + b := PByte(Buffer)^; + // lower Nibble + Inc(BitsSet, lu[b and $0F]); + // upper Nibble + Inc(BitsSet, lu[b shr 4]); + + Dec(Len); + Inc(PByte(Buffer)); + end; + + Result := (BitsSet mod 2) = 0; +end; + +// CRC 16 + +function Crc16Corr(const Crc16Table: TCrc16Table; Crc: Word; N: Integer): Integer; +var + I: Integer; +// CrcX : Cardinal; +begin + // calculate Syndrome +// CrcX := CrC; + for I := 1 to Crc16Bytes do + // a 16 bit value shr 8 is a Byte, explictit type conversion to Byte adds an ASM instruction + Crc := Crc16Table[Crc shr (CRC16Bits - 8)] xor Word(Crc shl 8); + I := -1; + repeat + Inc(I); + if (Crc and 1) <> 0 then + Crc := ((Crc xor Crc16Table[1]) shr 1) or Crc16HighBit +// Crc16Table[1] = Crc16Polynom + else + Crc := (Crc shr 1) and NotCrc16HighBit; + until (Crc = Crc16HighBit) or (I = (N + Crc16Bytes) * 8); + if Crc <> Crc16HighBit then + Result := -1000 // not correctable + else + // I = No. of single faulty bit + // (high bit first, + // starting from lowest with CRC bits) + Result := I - Crc16Bits; + // Result < 0 faulty CRC-bit + // Result >= 0 No. of faulty data bit +end; + +function Crc16_P(const Crc16Table: TCrc16Table; X: PJclByteArray; N: Integer; Crc: Word): Word; +var + I: Integer; +begin + Result := Crc16DefaultStart; + for I := 0 to N - 1 do // The CRC Bytes are located at the end of the information + // a 16 bit value shr 8 is a Byte, explictit type conversion to Byte adds an ASM instruction + Result := Crc16Table[Result shr (CRC16Bits - 8)] xor Word((Result shl 8)) xor X[I]; + for I := 0 to Crc16Bytes - 1 do + begin + // a 16 bit value shr 8 is a Byte, explictit type conversion to Byte adds an ASM instruction + Result := Crc16Table[Result shr (CRC16Bits-8)] xor Word((Result shl 8)) xor (Crc shr (CRC16Bits-8)); + Crc := Word(Crc shl 8); + end; +end; + +function Crc16_P(X: PJclByteArray; N: Integer; Crc: Word): Word; +begin + Result := Crc16_P(Crc16DefaultTable, X, N, Crc); +end; + +function CheckCrc16_P(const Crc16Table: TCrc16Table; X: PJclByteArray; N: Integer; Crc: Word): Integer; +// checks and corrects a single bit in up to 2^15-16 Bit -> 2^12-2 = 4094 Byte +var + I, J: Integer; + C: Byte; +begin + Crc := Crc16_P(Crc16Table, X, N, Crc); + if Crc = 0 then + Result := 0 // No CRC-error + else + begin + J := Crc16Corr(Crc16Table, Crc, N); + if J < -(Crc16Bytes * 8 + 1) then + Result := -1 // non-correctable error (more than one wrong bit) + else + begin + if J < 0 then + Result := 1 // one faulty Bit in CRC itself + else + begin // Bit J is faulty + I := J and 7; // I <= 7 (faulty Bit in Byte) + C := 1 shl I; // C <= 128 + I := J shr 3; // I: Index of faulty Byte + X[N - 1 - I] := X[N - 1 - I] xor C; // correct faulty bit + Result := 1; // Correctable error + end; + end; + end; +end; + +function CheckCrc16_P(X: PJclByteArray; N: Integer; Crc: Word): Integer; +begin + Result := CheckCrc16_P(Crc16DefaultTable, X, N, Crc); +end; + +function Crc16(const Crc16Table: TCrc16Table; const X: array of Byte; N: Integer; Crc: Word): Word; +begin + Result := Crc16_P(Crc16Table, @X, N, Crc); +end; + +function Crc16(const X: array of Byte; N: Integer; Crc: Word): Word; +begin + Result := Crc16_P(Crc16DefaultTable, @X, N, Crc); +end; + +function CheckCrc16(const Crc16Table: TCrc16Table; var X: array of Byte; N: Integer; Crc: Word): Integer; +begin + Result := CheckCRC16_P(Crc16Table, @X, N, CRC); +end; + +function CheckCrc16(var X: array of Byte; N: Integer; Crc: Word): Integer; +begin + Result := CheckCRC16_P(Crc16DefaultTable, @X, N, CRC); +end; + +function Crc16_A(const Crc16Table: TCrc16Table; const X: array of Byte; Crc: Word): Word; +begin + Result := Crc16_P(Crc16Table, @X, Length(X), Crc); +end; + +function Crc16_A(const X: array of Byte; Crc: Word): Word; +begin + Result := Crc16_P(Crc16DefaultTable, @X, Length(X), Crc); +end; + +function CheckCrc16_A(const Crc16Table: TCrc16Table; var X: array of Byte; Crc: Word): Integer; +begin + Result := CheckCrc16_P(Crc16Table, @X, Length(X), Crc); +end; + +function CheckCrc16_A(var X: array of Byte; Crc: Word): Integer; +begin + Result := CheckCrc16_P(Crc16DefaultTable, @X, Length(X), Crc); +end; + +// The CRC Table can be generated like this: +// const Crc16Start0 = 0; !! + +function Crc16_Bitwise(const X: array of Byte; N: Integer; Crc: Word; Polynom: Word): Word; +const + Crc16Start0 = 0; //Generating the table +var + I, J: Integer; + Sr, SrHighBit: Word; + B: Byte; +begin + Sr := Crc16Start0; + SrHighBit := 0; + for I := 0 to N - 1 + Crc16Bytes do + begin + if I >= N then + begin + B := Crc shr (Crc16Bits - 8); + Crc := Crc shl 8; + end + else + B := X[I]; + for J := 1 to 8 do + begin + if SrHighBit <> 0 then + Sr := Sr xor Polynom; + SrHighBit := Sr and Crc16HighBit; + Sr := (Word (Sr shl 1)) or ((B shr 7) and 1); + B := Byte(B shl 1); + end; + end; + if SrHighBit <> 0 then + Sr := Sr xor Polynom; + Result := Sr; +end; + +procedure InitCrc16(Polynom, Start: Word; out Crc16Table: TCrc16Table); +var + X: array [0..0] of Byte; + I: Integer; +begin + for I := 0 to 255 do + begin + X[0] := I; + Crc16Table[I] := Crc16_Bitwise(X, 1, 0, Polynom); { only with crcstart=0 !!!!} + end; + Crc16DefaultStart := Start; +end; + +procedure InitCrc16(Polynom, Start: Word); +begin + InitCrc16(Polynom, Start, Crc16DefaultTable); +end; + +// CRC 32 + +function Crc32Corr(const Crc32Table: TCrc32Table; Crc: Cardinal; N: Integer): Integer; +var + I: Integer; +begin + // calculate Syndrome + for I := 1 to Crc32Bytes do + Crc := Crc32Table[Crc shr (CRC32Bits - 8)] xor (Crc shl 8); + I := -1; + repeat + Inc(I); + if (Crc and 1) <> 0 then + Crc := ((Crc xor Crc32Table[1]) shr 1) or Crc32HighBit +// Crc32Table[1] = Crc32Polynom + else + Crc := (Crc shr 1) and NotCrc32HighBit; + until (Crc = Crc32HighBit) or (I = (N + Crc32Bytes) * 8); + if Crc <> Crc32HighBit then + Result := -1000 // not correctable + else + // I = No. of single faulty bit + // (high bit first, + // starting from lowest with CRC bits) + Result := I - Crc32Bits; + // Result < 0 faulty CRC-bit + // Result >= 0 No. of faulty data bit +end; + +function Crc32_P(const Crc32Table: TCrc32Table; X: PJclByteArray; N: Integer; Crc: Cardinal): Cardinal; +var + I: Integer; +begin + Result := Crc32DefaultStart; + for I := 0 to N - 1 do // The CRC Bytes are located at the end of the information + // a 32 bit value shr 24 is a Byte, explictit type conversion to Byte adds an ASM instruction + Result := Crc32Table[Result shr (CRC32Bits-8)] xor (Result shl 8) xor X[I]; + for I := 0 to Crc32Bytes - 1 do + begin + // a 32 bit value shr 24 is a Byte, explictit type conversion to Byte adds an ASM instruction + Result := Crc32Table[Result shr (CRC32Bits-8)] xor (Result shl 8) xor (Crc shr (CRC32Bits-8)); + Crc := Crc shl 8; + end; +end; + +function Crc32_P(X: PJclByteArray; N: Integer; Crc: Cardinal): Cardinal; +begin + Result := Crc32_P(Crc32DefaultTable, X, N, Crc); +end; + +function CheckCrc32_P(const Crc32Table: TCrc32Table; X: PJclByteArray; N: Integer; Crc: Cardinal): Integer; +// checks and corrects a single bit in up to 2^31-32 Bit -> 2^28-4 = 268435452 Byte +var + I, J: Integer; + C: Byte; +begin + Crc := Crc32_P(Crc32Table, X, N, Crc); + if Crc = 0 then + Result := 0 // No CRC-error + else + begin + J := Crc32Corr(Crc32Table, Crc, N); + if J < -(Crc32Bytes * 8 + 1) then + Result := -1 // non-correctable error (more than one wrong bit) + else + begin + if J < 0 then + Result := 1 // one faulty Bit in CRC itself + else + begin // Bit J is faulty + I := J and 7; // I <= 7 (faulty Bit in Byte) + C := 1 shl I; // C <= 128 + I := J shr 3; // I: Index of faulty Byte + X[N - 1 - I] := X[N - 1 - I] xor C; // correct faulty bit + Result := 1; // Correctable error + end; + end; + end; +end; + +function CheckCrc32_P(X: PJclByteArray; N: Integer; Crc: Cardinal): Integer; +begin + Result := CheckCrc32_P(Crc32DefaultTable, X, N, Crc); +end; + +function Crc32(const Crc32Table: TCrc32Table; const X: array of Byte; N: Integer; Crc: Cardinal): Cardinal; +begin + Result := Crc32_P(Crc32Table, @X, N, Crc); +end; + +function Crc32(const X: array of Byte; N: Integer; Crc: Cardinal): Cardinal; +begin + Result := Crc32_P(Crc32DefaultTable, @X, N, Crc); +end; + +function CheckCrc32(const Crc32Table: TCrc32Table; var X: array of Byte; N: Integer; Crc: Cardinal): Integer; +begin + Result := CheckCRC32_P(Crc32Table, @X, N, CRC); +end; + +function CheckCrc32(var X: array of Byte; N: Integer; Crc: Cardinal): Integer; +begin + Result := CheckCRC32_P(Crc32DefaultTable, @X, N, CRC); +end; + +function Crc32_A(const Crc32Table: TCrc32Table; const X: array of Byte; Crc: Cardinal): Cardinal; +begin + Result := Crc32_P(Crc32Table, @X, Length(X), Crc); +end; + +function Crc32_A(const X: array of Byte; Crc: Cardinal): Cardinal; +begin + Result := Crc32_P(Crc32DefaultTable, @X, Length(X), Crc); +end; + +function CheckCrc32_A(const Crc32Table: TCrc32Table; var X: array of Byte; Crc: Cardinal): Integer; +begin + Result := CheckCrc32_P(Crc32Table, @X, Length(X), Crc); +end; + +function CheckCrc32_A(var X: array of Byte; Crc: Cardinal): Integer; +begin + Result := CheckCrc32_P(Crc32DefaultTable, @X, Length(X), Crc); +end; + +// The CRC Table can be generated like this: +// const Crc32Start0 = 0; !! + +function Crc32_Bitwise(const X: array of Byte; N: Integer; Crc: Cardinal; Polynom: Cardinal) : Cardinal; +const + Crc32Start0 = 0; //Generating the table +var + I, J: Integer; + Sr, SrHighBit: Cardinal; + B: Byte; +begin + Sr := Crc32Start0; + SrHighBit := 0; + for I := 0 to N - 1 + Crc32Bytes do + begin + if I >= N then + begin + B := Crc shr (Crc32Bits - 8); + Crc := Crc shl 8; + end + else + B := X[I]; + for J := 1 to 8 do + begin + if SrHighBit <> 0 then + Sr := Sr xor Polynom; + SrHighBit := Sr and Crc32HighBit; + Sr := (Sr shl 1) or ((B shr 7) and 1); + B := Byte(B shl 1); + end + end; + + if SrHighBit <> 0 then + Sr := Sr xor Polynom; + Result := Sr; +end; + +procedure InitCrc32(Polynom, Start: Cardinal; out Crc32Table: TCrc32Table); +var + X: array [0..0] of Byte; + I: Integer; +begin + for I := 0 to 255 do + begin + X[0] := I; + Crc32Table[I] := Crc32_Bitwise(X, 1, 0, Polynom); + end; + Crc32DefaultStart := Start; +end; + +procedure InitCrc32(Polynom, Start: Cardinal); +begin + InitCrc32(Polynom, Start, Crc32DefaultTable); +end; + +//=== complex numbers support ================================================ + +const + RectOne: TRectComplex = (Re: 1.0; Im: 0.0); + RectZero: TRectComplex = (Re: 0.0; Im: 0.0); + +var + RectComplexFormatStr: string = '%g + %gi'; + PolarComplexFormatStr: string = '%g e^%gi'; + +procedure SetRectComplexFormatStr(const S: string); +begin + RectComplexFormatStr := S; +end; + +procedure SetPolarComplexFormatStr(const S: string); +begin + PolarComplexFormatStr := S; +end; + +function ComplexToStr(const Z: TRectComplex): string; +begin + Result := Format(RectComplexFormatStr, [Z.Re, Z.Im]); +end; + +function ComplexToStr(const Z: TPolarComplex): string; +begin + Result := Format(PolarComplexFormatStr, [Z.Radius, Z.Angle]); +end; + +function RectComplex(const Re: Float; const Im: Float = 0): TRectComplex; +begin + Result.Re := Re; + Result.Im := Im; +end; + +function RectComplex(const Z: TPolarComplex): TRectComplex; +var + ASin, ACos: Float; +begin + {$IFDEF DEBUG} + Inc(ComplexTypeConversions); + {$ENDIF DEBUG} + JclMath.SinCos(Z.Angle, ASin, ACos); + Result.Re := Z.Radius * ACos; + Result.Im := Z.Radius * ASin; +end; + +function PolarComplex(const Radius: Float; const Angle: Float = 0): TPolarComplex; +begin + if Radius < 0 then + begin + Result.Radius := -Radius; + Result.Angle := Pi; + end + else + begin + Result.Radius := Radius; + Result.Angle := 0.0; + end; +end; + +function PolarComplex(const Z: TRectComplex): TPolarComplex; +begin + {$IFDEF DEBUG} + Inc(ComplexTypeConversions); + {$ENDIF DEBUG} + Result.Radius := Norm(Z); + Result.Angle := ArcTan2(Z.Im, Z.Re); +end; + +function Equal(const Z1, Z2: TRectComplex): Boolean; +begin + Result := (Z1.Re = Z2.Re) and (Z1.Im = Z2.Im); +end; + +function Equal(const Z1, Z2: TPolarComplex): Boolean; +begin + Result := (Z1.Radius = Z2.Radius) + and ((Z1.Radius = 0) or IsFloatZero(NormalizeAngle(Z1.Angle - Z2.Angle))); +end; + +function IsZero(const Z: TRectComplex): Boolean; +begin + Result := IsFloatZero(Z.Re) and IsFloatZero(Z.Im); +end; + +function IsZero(const Z: TPolarComplex): Boolean; +begin + Result := IsFloatZero(Z.Radius); +end; + +{$IFDEF CPU32} + +function IsInfinite(const Z: TRectComplex): Boolean; +begin + Result := IsInfinite(Z.Re) or IsInfinite(Z.Im); +end; + +function IsInfinite(const Z: TPolarComplex): Boolean; +begin + Result := IsInfinite(Z.Radius); +end; + +{$ENDIF CPU32} + +function Norm(const Z: TRectComplex): Float; +begin + Result := Sqrt(Sqr(Z.Re) + Sqr(Z.Im)); +end; + +function Norm(const Z: TPolarComplex): Float; +begin + Result := Z.Radius; +end; + +function AbsSqr(const Z: TRectComplex): Float; +begin + Result := Sqr(Z.Re) + Sqr(Z.Im); +end; + +function AbsSqr(const Z: TPolarComplex): Float; +begin + Result := Sqr(Z.Radius); +end; + +function Conjugate(const Z: TRectComplex): TRectComplex; +begin + Result.Re := Z.Re; + Result.Im := -Z.Im; +end; + +function Conjugate(const Z: TPolarComplex): TPolarComplex; +begin + Result.Radius := Z.Radius; + Result.Angle := -Z.Angle; +end; + +function Inv(const Z: TRectComplex): TRectComplex; +var + Denom: Float; +begin + Denom := Sqr(Z.Re) + Sqr(Z.Im); + Result.Re := Z.Re / Denom; + Result.Im := -Z.Im / Denom; +end; + +function Inv(const Z: TPolarComplex): TPolarComplex; +begin + Result.Radius := 1 / Z.Radius; + Result.Angle := - Z.Angle; +end; + +function Neg(const Z: TRectComplex): TRectComplex; +begin + Result.Re := -Z.Re; + Result.Im := -Z.Im; +end; + +function Neg(const Z: TPolarComplex): TPolarComplex; +begin + Result.Radius := Z.Radius; + Result.Angle := NormalizeAngle(Z.Angle + Pi); +end; + +function Sum(const Z1, Z2: TRectComplex): TRectComplex; +begin + Result.Re := Z1.Re + Z2.Re; + Result.Im := Z1.Im + Z2.Im; +end; + +function Sum(const Z: array of TRectComplex): TRectComplex; +var + I: Integer; +begin + Result := RectZero; + for I := Low(Z) to High(Z) do + begin + Result.Re := Result.Re + Z[I].Re; + Result.Im := Result.Im + Z[I].Im; + end; +end; + +function Diff(const Z1, Z2: TRectComplex): TRectComplex; +begin + Result.Re := Z1.Re - Z2.Re; + Result.Im := Z1.Im - Z2.Im; +end; + +function Product(const Z1, Z2: TRectComplex): TRectComplex; +begin + Result.Re := Z1.Re * Z2.Re - Z1.Im * Z2.Im; + Result.Im := Z1.Re * Z2.Im + Z1.Im * Z2.Re; +end; + +function Product(const Z1, Z2: TPolarComplex): TPolarComplex; +begin + Result.Radius := Z1.Radius * Z2.Radius; + Result.Angle := NormalizeAngle(Z1.Angle + Z2.Angle); +end; + +function Product(const Z: array of TPolarComplex): TPolarComplex; +var + I: Integer; +begin + Result.Radius := 1.0; + Result.Angle := 0; + for I := Low(Z) to High(Z) do + begin + Result.Radius := Result.Radius * Z[I].Radius; + Result.Angle := Result.Angle + Z[I].Angle; + end; + Result.Angle := NormalizeAngle(Result.Angle); +end; + + +function Quotient(const Z1, Z2: TRectComplex): TRectComplex; +var + Denom: Float; +begin + Denom := Sqr(Z2.Re) + Sqr(Z2.Im); + Result.Re := (Z1.Re * Z2.Re + Z1.Im * Z2.Im) / Denom; + Result.Im := (Z1.Im * Z2.Re - Z1.Re * Z2.Im) / Denom; +end; + +function Quotient(const Z1, Z2: TPolarComplex): TPolarComplex; +begin + Result.Radius := Z1.Radius / Z2.Radius; + Result.Angle := NormalizeAngle(Z1.Angle - Z2.Angle); +end; + +function Ln(const Z: TPolarComplex): TRectComplex; +begin + Result.Re := System.Ln(Z.Radius); + Result.Im := NormalizeAngle(Z.Angle); +end; + +function Exp(const Z: TRectComplex): TPolarComplex; +begin + Result.Radius := System.Exp(Z.Re); + Result.Angle := Z.Im; +end; + +function Power(const Z: TPolarComplex; const Exponent: Float): TPolarComplex; +begin + Result.Radius := JclMath.Power(Z.Radius, Exponent); + Result.Angle := NormalizeAngle(Exponent * Z.Angle); +end; + +function Power(const Z: TPolarComplex; const Exponent: TRectComplex): TPolarComplex; +begin + Result := Exp(Product(Exponent, Ln(Z))); +end; + +function PowerInt(const Z: TPolarComplex; const Exponent: Integer): TPolarComplex; +begin + Result.Radius := PowerInt(Z.Radius, Exponent); + Result.Angle := NormalizeAngle(Exponent * Z.Angle); +end; + +function Root(const Z: TPolarComplex; const K, N: Cardinal): TPolarComplex; +begin + Result.Radius := JclMath.Power(Z.Radius, 1.0 / N); + Result.Angle := NormalizeAngle((Z.Angle + K * TwoPi) / N); +end; + +//=== complex trigonometric functions ======================================== + +function Cos(const Z: TRectComplex): TRectComplex; +var + ACos, ASin: Float; +begin + JclMath.SinCos(Z.Re, ASin, ACos); + Result.Re := ACos * JclMath.CosH(Z.Im); + Result.Im := -ASin * JclMath.SinH(Z.Im); +end; + +function Sin(const Z: TRectComplex): TRectComplex; +var + ACos, ASin: Float; +begin + JclMath.SinCos(Z.Re, ASin, ACos); + Result.Re := ASin * JclMath.CosH(Z.Im); + Result.Im := ACos * JclMath.SinH(Z.Im); +end; + +function Tan(const Z: TRectComplex): TRectComplex; +var + Denom: Float; + ACos, ASin: Float; +begin + JclMath.SinCos(2.0 * Z.Re, ASin, ACos); + Denom := ACos + JclMath.CosH(2.0 * Z.Im); + Result.Re := ASin / Denom; + Result.Im := JclMath.SinH(2.0 * Z.Im) / Denom; +end; + +function Cot(const Z: TRectComplex): TRectComplex; +var + Denom: Float; + ACos, ASin: Float; +begin + JclMath.SinCos(2.0 * Z.Re, ASin, ACos); + Denom := JclMath.CosH(2.0 * Z.Im) - ACos; + Result.Re := ASin / Denom; + Result.Im := -JclMath.SinH(2.0 * Z.Im) / Denom; +end; + +function Sec(const Z: TRectComplex): TRectComplex; +begin + Result := Quotient(RectOne, Cos(Z)); +end; + +function Csc(const Z: TRectComplex): TRectComplex; +begin + Result := Quotient(RectOne, Sin(Z)); +end; + +//=== complex hyperbolic functions =========================================== + +function CosH(const Z: TRectComplex): TRectComplex; +var + ACos, ASin: Float; +begin + JclMath.SinCos(Z.Im, ASin, ACos); + Result.Re := JclMath.CosH(Z.Re) * ACos; + Result.Im := JclMath.SinH(Z.Re) * ASin; +end; + +function SinH(const Z: TRectComplex): TRectComplex; +var + ACos, ASin: Float; +begin + JclMath.SinCos(Z.Im, ASin, ACos); + Result.Re := JclMath.SinH(Z.Re) * ACos; + Result.Im := JclMath.CosH(Z.Re) * ASin; +end; + +function TanH(const Z: TRectComplex): TRectComplex; +var + Denom: Float; + ACos, ASin: Float; +begin + JclMath.SinCos(2.0 * Z.Im, ASin, ACos); + Denom := JclMath.CosH(2.0 * Z.Re) + ACos; + Result.Re := JclMath.SinH(2.0 * Z.Re) / Denom; + Result.Im := ASin / Denom; +end; + +function CotH(const Z: TRectComplex): TRectComplex; +var + Denom: Float; + ACos, ASin: Float; +begin + JclMath.SinCos(2.0 * Z.Im, ASin, ACos); + Denom := JclMath.CosH(2.0 * Z.Re) - ACos; + Result.Re := JclMath.SinH(2.0 * Z.Re) / Denom; + Result.Im := -ASin / Denom; +end; + +function SecH(const Z: TRectComplex): TRectComplex; +begin + Result := Quotient(RectOne, CosH(Z)); +end; + +function CscH(const Z: TRectComplex): TRectComplex; +begin + Result := Quotient(RectOne, SinH(Z)); +end; + +{$IFDEF SUPPORTS_CLASS_OPERATORS} + +{ TRectComplex } + +class operator TRectComplex.Implicit(const Value: Float): TRectComplex; +begin + Result := RectComplex(Value); +end; + +class operator TRectComplex.Equal(const Z1, Z2: TRectComplex): Boolean; +begin + Result := Equal(Z1, Z2); +end; + +class operator TRectComplex.NotEqual(const Z1, Z2: TRectComplex): Boolean; +begin + Result := not Equal(Z1, Z2); +end; + +class operator TRectComplex.Add(const Z1, Z2: TRectComplex): TRectComplex; +begin + Result := Sum(Z1, Z2); +end; + +class operator TRectComplex.Subtract(const Z1, Z2: TRectComplex): TRectComplex; +begin + Result := Diff(Z1, Z2); +end; + +class operator TRectComplex.Multiply(const Z1, Z2: TRectComplex): TRectComplex; +begin + Result := Product(Z1, Z2); +end; + +class operator TRectComplex.Divide(const Z1, Z2: TRectComplex): TRectComplex; +begin + Result := Quotient(Z1, Z2); +end; + +class operator TRectComplex.Negative(const Z: TRectComplex): TRectComplex; +begin + Result := Neg(Z); +end; + +class operator TRectComplex.Positive(const Z: TRectComplex): TRectComplex; +begin + Result := Z; +end; + +function TRectComplex.AsString: string; +begin + Result := ComplexToStr(Self); +end; + +function TRectComplex.Conjugate: TRectComplex; +begin + Result := JclMath.Conjugate(Self); +end; + +function TRectComplex.IsZero: Boolean; +begin + Result := JclMath.IsZero(Self); +end; + +function TRectComplex.IsInfinite: Boolean; +begin + {$IFDEF DELPHI64_TEMPORARY} + //IsInfinite is disabled for 64-bit, because BASM is not 64-bit compatible (see logmessage of public repo @3070) + System.Error(rePlatformNotImplemented); + Result := False; + {$ELSE ~DELPHI64_TEMPORARY} + Result := JclMath.IsInfinite(Self); + {$ENDIF ~DELPHI64_TEMPORARY} +end; + +{ TPolarComplex } + +class operator TPolarComplex.Implicit(const Value: Float): TPolarComplex; +begin + Result := PolarComplex(Value); +end; + +class operator TPolarComplex.Implicit(const Z: TPolarComplex): TRectComplex; +begin + Result := RectComplex(Z); +end; + +class operator TPolarComplex.Implicit(const Z: TRectComplex): TPolarComplex; +begin + Result := PolarComplex(Z); +end; + +{$IFNDEF CPPBUILDER} +class operator TPolarComplex.Explicit(const Z: TPolarComplex): TRectComplex; +begin + Result := RectComplex(Z); +end; + +class operator TPolarComplex.Explicit(const Z: TRectComplex): TPolarComplex; +begin + Result := PolarComplex(Z); +end; +{$ENDIF CPPBUILDER} + +class operator TPolarComplex.Equal(const Z1, Z2: TPolarComplex): Boolean; +begin + Result := Equal(Z1, Z2); +end; + +class operator TPolarComplex.NotEqual(const Z1, Z2: TPolarComplex): Boolean; +begin + Result := not Equal(Z1, Z2); +end; + +class operator TPolarComplex.Add(const Z1, Z2: TPolarComplex): TRectComplex; +begin + Result := Sum(Z1, Z2); +end; + +class operator TPolarComplex.Subtract(const Z1, Z2: TPolarComplex): TRectComplex; +begin + Result := Diff(Z1, Z2); +end; + +class operator TPolarComplex.Multiply(const Z1, Z2: TPolarComplex): TPolarComplex; +begin + Result := Product(Z1, Z2); +end; + +class operator TPolarComplex.Divide(const Z1, Z2: TPolarComplex): TPolarComplex; +begin + Result := Quotient(Z1, Z2); +end; + +class operator TPolarComplex.Negative(const Z: TPolarComplex): TPolarComplex; +begin + Result := Neg(Z); +end; + +class operator TPolarComplex.Positive(const Z: TPolarComplex): TPolarComplex; +begin + Result := Z; +end; + +function TPolarComplex.AsString: string; +begin + Result := ComplexToStr(Self); +end; + +function TPolarComplex.Conjugate: TPolarComplex; +begin + Result := JclMath.Conjugate(Self); +end; + +function TPolarComplex.IsZero: Boolean; +begin + Result := JclMath.IsZero(Self); +end; + +function TPolarComplex.IsInfinite: Boolean; +begin + {$IFDEF DELPHI64_TEMPORARY} + //IsInfinite is disabled for 64-bit, because BASM is not 64-bit compatible (see logmessage of public repo @3070) + System.Error(rePlatformNotImplemented); + Result := False; + {$ELSE ~DELPHI64_TEMPORARY} + Result := JclMath.IsInfinite(Self); + {$ENDIF ~DELPHI64_TEMPORARY} +end; + +function TPolarComplex.Power(const Exponent: TRectComplex): TPolarComplex; +begin + Result := JclMath.Power(Self, Exponent); +end; + +function TPolarComplex.Power(const Exponent: Float): TPolarComplex; +begin + Result := JclMath.Power(Self, Exponent); +end; + +function TPolarComplex.Power(const Exponent: Integer): TPolarComplex; +begin + Result := JclMath.PowerInt(Self, Exponent); +end; + +function TPolarComplex.Root(const K, N: Cardinal): TPolarComplex; +begin + Result := JclMath.Root(Self, K, N); +end; + +{$ENDIF SUPPORTS_CLASS_OPERATORS} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclMime.pas b/3rdParty/JCL/source/common/JclMime.pas new file mode 100644 index 00000000..ee39827e --- /dev/null +++ b/3rdParty/JCL/source/common/JclMime.pas @@ -0,0 +1,939 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclMime.pas. } +{ } +{ The Initial Developer of the Original Code is Ralf Junker. } +{ Portions created by Ralf Junker are Copyright (C) Ralf Junker. All rights reserved. } +{ } +{ Contributors: } +{ Marcel van Brakel } +{ Ralf Junker } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ edbored } +{ } +{**************************************************************************************************} +{ } +{ Lightning fast Mime (Base64) Encoding and Decoding routines. Coded by Ralf Junker } +{ (ralfjunker att gmx dott de). } +{ } +{**************************************************************************************************} +{ Migration Guide from JCL 1.90 and older: } +{ } +{ These new functions now support line breaks (CRLF) as required by RFC 2045. } +{ Inserting line breaks is the default behaviour in RFC 2045 therefor the encoding functions now } +{ encode with line breaks. } +{ } +{ This may require changes to your code: } +{ Encoding without inserting line breaks is possible using the corresponding NoCRLF procedures: } +{ } +{ MimeEncode => MimeEncodeNoCRLF } +{ MimeEncodeString => MimeEncodeStringNoCRLF } +{ MimeEncodeStream => MimeEncodeStreamNoCRLF } +{ MimeEncodedSize => MimeEncodedSizeNoCRLF } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclMime; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, System.Classes, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, Classes, + {$ENDIF ~HAS_UNITSCOPE} + JclBase; + +function MimeEncodeString(const S: AnsiString): AnsiString; +function MimeEncodeStringNoCRLF(const S: AnsiString): AnsiString; +function MimeDecodeString(const S: AnsiString): AnsiString; +function MimeEncodedSize(const InputSize: SizeInt): SizeInt; +function MimeEncodedSizeNoCRLF(const InputSize: SizeInt): SizeInt; +function MimeDecodedSize(const InputSize: SizeInt): SizeInt; +procedure DecodeHttpBasicAuthentication(const BasicCredentials: AnsiString; + out UserId, PassWord: AnsiString); + +procedure MimeEncode(const InputBuffer: TDynByteArray; InputOffset: SizeInt; + const InputByteCount: SizeInt; out OutputBuffer: TDynByteArray; OutputOffset: SizeInt = 0); overload; +procedure MimeEncodeNoCRLF(const InputBuffer: TDynByteArray; InputOffset: SizeInt; + const InputByteCount: SizeInt; out OutputBuffer: TDynByteArray; OutputOffset: SizeInt = 0); overload; +procedure MimeEncodeFullLines(const InputBuffer: TDynByteArray; InputOffset: SizeInt; + const InputByteCount: SizeInt; out OutputBuffer: TDynByteArray; OutputOffset: SizeInt = 0); overload; +function MimeDecode(const InputBuffer: TDynByteArray; InputOffset: SizeInt; + const InputByteCount: SizeInt; out OutputBuffer: TDynByteArray; OutputOffset: SizeInt = 0): SizeInt; overload; +function MimeDecodePartial(const InputBuffer: TDynByteArray; InputOffset: SizeInt; + const InputByteCount: SizeInt; out OutputBuffer: TDynByteArray; OutputOffset: SizeInt; + var ByteBuffer: Cardinal; var ByteBufferSpace: Cardinal): SizeInt; overload; +function MimeDecodePartialEnd(out OutputBuffer: TDynByteArray; OutputOffset: SizeInt; + const ByteBuffer: Cardinal; const ByteBufferSpace: Cardinal): SizeInt; overload; + +procedure MimeEncode(const InputBuffer: TDynByteArray; const InputByteCount: SizeInt; + out OutputBuffer: TDynByteArray); overload; +procedure MimeEncodeNoCRLF(const InputBuffer: TDynByteArray; const InputByteCount: SizeInt; + out OutputBuffer: TDynByteArray); overload; +procedure MimeEncodeFullLines(const InputBuffer: TDynByteArray; const InputByteCount: SizeInt; + out OutputBuffer: TDynByteArray); overload; +function MimeDecode(const InputBuffer: TDynByteArray; const InputByteCount: SizeInt; + out OutputBuffer: TDynByteArray): SizeInt; overload; +function MimeDecodePartial(const InputBuffer: TDynByteArray; const InputByteCount: SizeInt; + out OutputBuffer: TDynByteArray; var ByteBuffer: Cardinal; var ByteBufferSpace: Cardinal): SizeInt; overload; +function MimeDecodePartialEnd(out OutputBuffer: TDynByteArray; const ByteBuffer: Cardinal; + const ByteBufferSpace: Cardinal): SizeInt; overload; + +procedure MimeEncode(const InputBuffer; const InputByteCount: SizeInt; out OutputBuffer); overload; +procedure MimeEncodeNoCRLF(const InputBuffer; const InputByteCount: SizeInt; out OutputBuffer); overload; +procedure MimeEncodeFullLines(const InputBuffer; const InputByteCount: SizeInt; out OutputBuffer); overload; +function MimeDecode(const InputBuffer; const InputByteCount: SizeInt; out OutputBuffer): SizeInt; overload; +function MimeDecodePartial(const InputBuffer; const InputByteCount: SizeInt; out OutputBuffer; + var ByteBuffer: Cardinal; var ByteBufferSpace: Cardinal): SizeInt; overload; +function MimeDecodePartialEnd(out OutputBuffer; const ByteBuffer: Cardinal; + const ByteBufferSpace: Cardinal): SizeInt; overload; + +procedure MimeEncodeFile(const InputFileName, OutputFileName: TFileName); +procedure MimeEncodeFileNoCRLF(const InputFileName, OutputFileName: TFileName); +procedure MimeDecodeFile(const InputFileName, OutputFileName: TFileName); +procedure MimeEncodeStream(const InputStream: TStream; const OutputStream: TStream); +procedure MimeEncodeStreamNoCRLF(const InputStream: TStream; const OutputStream: TStream); +procedure MimeDecodeStream(const InputStream: TStream; const OutputStream: TStream); + +const + MIME_ENCODED_LINE_BREAK = 76; + MIME_DECODED_LINE_BREAK = MIME_ENCODED_LINE_BREAK div 4 * 3; + MIME_BUFFER_SIZE = MIME_DECODED_LINE_BREAK * 3 * 4 * 4; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +// Caution: For MimeEncodeStream and all other kinds of multi-buffered +// Mime encodings (i.e. Files etc.), BufferSize must be set to a multiple of 3. +// Even though the implementation of the Mime decoding routines below +// do not require a particular buffer size, they work fastest with sizes of +// multiples of four. The chosen size is a multiple of 3 and of 4 as well. +// The following numbers are, in addition, also divisible by 1024: +// $2400, $3000, $3C00, $4800, $5400, $6000, $6C00. + +const + { The mime encoding table. Do not alter. } + MIME_ENCODE_TABLE: array [0..63] of Byte = ( + 065, 066, 067, 068, 069, 070, 071, 072, // 00 - 07 + 073, 074, 075, 076, 077, 078, 079, 080, // 08 - 15 + 081, 082, 083, 084, 085, 086, 087, 088, // 16 - 23 + 089, 090, 097, 098, 099, 100, 101, 102, // 24 - 31 + 103, 104, 105, 106, 107, 108, 109, 110, // 32 - 39 + 111, 112, 113, 114, 115, 116, 117, 118, // 40 - 47 + 119, 120, 121, 122, 048, 049, 050, 051, // 48 - 55 + 052, 053, 054, 055, 056, 057, 043, 047); // 56 - 63 + + MIME_PAD_CHAR = Byte('='); + + MIME_DECODE_TABLE: array [Byte] of Byte = ( + 255, 255, 255, 255, 255, 255, 255, 255, // 0 - 7 + 255, 255, 255, 255, 255, 255, 255, 255, // 8 - 15 + 255, 255, 255, 255, 255, 255, 255, 255, // 16 - 23 + 255, 255, 255, 255, 255, 255, 255, 255, // 24 - 31 + 255, 255, 255, 255, 255, 255, 255, 255, // 32 - 39 + 255, 255, 255, 062, 255, 255, 255, 063, // 40 - 47 + 052, 053, 054, 055, 056, 057, 058, 059, // 48 - 55 + 060, 061, 255, 255, 255, 255, 255, 255, // 56 - 63 + 255, 000, 001, 002, 003, 004, 005, 006, // 64 - 71 + 007, 008, 009, 010, 011, 012, 013, 014, // 72 - 79 + 015, 016, 017, 018, 019, 020, 021, 022, // 80 - 87 + 023, 024, 025, 255, 255, 255, 255, 255, // 88 - 95 + 255, 026, 027, 028, 029, 030, 031, 032, // 96 - 103 + 033, 034, 035, 036, 037, 038, 039, 040, // 104 - 111 + 041, 042, 043, 044, 045, 046, 047, 048, // 112 - 119 + 049, 050, 051, 255, 255, 255, 255, 255, // 120 - 127 + 255, 255, 255, 255, 255, 255, 255, 255, + 255, 255, 255, 255, 255, 255, 255, 255, + 255, 255, 255, 255, 255, 255, 255, 255, + 255, 255, 255, 255, 255, 255, 255, 255, + 255, 255, 255, 255, 255, 255, 255, 255, + 255, 255, 255, 255, 255, 255, 255, 255, + 255, 255, 255, 255, 255, 255, 255, 255, + 255, 255, 255, 255, 255, 255, 255, 255, + 255, 255, 255, 255, 255, 255, 255, 255, + 255, 255, 255, 255, 255, 255, 255, 255, + 255, 255, 255, 255, 255, 255, 255, 255, + 255, 255, 255, 255, 255, 255, 255, 255, + 255, 255, 255, 255, 255, 255, 255, 255, + 255, 255, 255, 255, 255, 255, 255, 255, + 255, 255, 255, 255, 255, 255, 255, 255, + 255, 255, 255, 255, 255, 255, 255, 255); + +procedure MimeEncode(const InputBuffer: TDynByteArray; const InputByteCount: SizeInt; + out OutputBuffer: TDynByteArray); +begin + MimeEncode(InputBuffer, 0, InputByteCount, OutputBuffer, 0); +end; + +procedure MimeEncodeNoCRLF(const InputBuffer: TDynByteArray; const InputByteCount: SizeInt; + out OutputBuffer: TDynByteArray); +begin + MimeEncodeNoCRLF(InputBuffer, 0, InputByteCount, OutputBuffer, 0); +end; + +procedure MimeEncodeFullLines(const InputBuffer: TDynByteArray; const InputByteCount: SizeInt; + out OutputBuffer: TDynByteArray); +begin + MimeEncodeFullLines(InputBuffer, 0, InputByteCount, OutputBuffer, 0); +end; + +function MimeDecode(const InputBuffer: TDynByteArray; const InputByteCount: SizeInt; + out OutputBuffer: TDynByteArray): SizeInt; +begin + Result := MimeDecode(InputBuffer, 0, InputByteCount, OutputBuffer, 0); +end; + +function MimeDecodePartial(const InputBuffer: TDynByteArray; const InputByteCount: SizeInt; + out OutputBuffer: TDynByteArray; var ByteBuffer: Cardinal; var ByteBufferSpace: Cardinal): SizeInt; +begin + Result := MimeDecodePartial(InputBuffer, 0, InputByteCount, OutputBuffer, 0, ByteBuffer, ByteBufferSpace); +end; + +function MimeDecodePartialEnd(out OutputBuffer: TDynByteArray; const ByteBuffer: Cardinal; + const ByteBufferSpace: Cardinal): SizeInt; +begin + Result := MimeDecodePartialEnd(OutputBuffer, 0, ByteBuffer, ByteBufferSpace); +end; + +type + PByte4 = ^TByte4; + TByte4 = packed record + B1: Byte; + B2: Byte; + B3: Byte; + B4: Byte; + end; + + PByte3 = ^TByte3; + TByte3 = packed record + B1: Byte; + B2: Byte; + B3: Byte; + end; + +// Wrapper functions & procedures +function MimeEncodeString(const S: AnsiString): AnsiString; +var + L: SizeInt; +begin + if S <> '' then + begin + L := Length(S); + SetLength(Result, MimeEncodedSize(L)); + MimeEncode(PAnsiChar(S)^, L, PAnsiChar(Result)^); + end + else + Result := ''; +end; + +function MimeEncodeStringNoCRLF(const S: AnsiString): AnsiString; +var + L: SizeInt; +begin + if S <> '' then + begin + L := Length(S); + SetLength(Result, MimeEncodedSizeNoCRLF(L)); + MimeEncodeNoCRLF(PAnsiChar(S)^, L, PAnsiChar(Result)^); + end + else + Result := ''; +end; + +function MimeDecodeString(const S: AnsiString): AnsiString; +var + ByteBuffer, ByteBufferSpace: Cardinal; + L: SizeInt; + P, R: PAnsiChar; +begin + if S <> '' then + begin + L := Length(S); + SetLength(Result, MimeDecodedSize(L)); + ByteBuffer := 0; + ByteBufferSpace := 4; + P := PAnsiChar(S); + R := PAnsiChar(Result); + L := MimeDecodePartial(P^, L, R^, ByteBuffer, ByteBufferSpace); + Inc(R, L); + Inc(L, MimeDecodePartialEnd(R^, ByteBuffer, ByteBufferSpace)); + SetLength(Result, L); + end + else + Result := ''; +end; + +procedure DecodeHttpBasicAuthentication(const BasicCredentials: AnsiString; out UserId, PassWord: AnsiString); +const + LBasic = 6; { Length ('Basic ') } +var + DecodedPtr, P: PAnsiChar; + I, L: SizeInt; +begin + UserId := ''; + PassWord := ''; + + P := PAnsiChar(BasicCredentials); + if P = nil then + Exit; + + L := Length(BasicCredentials); + if L <= LBasic then + Exit; + + Dec(L, LBasic); + Inc(P, LBasic); + + GetMem(DecodedPtr, MimeDecodedSize(L)); + L := MimeDecode(P^, L, DecodedPtr^); + + { Look for colon (':'). } + I := 0; + P := DecodedPtr; + while (L > 0) and (P[I] <> ':') do + begin + Inc(I); + Dec(L); + end; + + { Store UserId and Password. } + SetString(UserId, DecodedPtr, I); + if L > 1 then + SetString(PassWord, DecodedPtr + I + 1, L - 1) + else + PassWord := ''; + + FreeMem(DecodedPtr); +end; + +// Helper functions +function MimeEncodedSize(const InputSize: SizeInt): SizeInt; +begin + if InputSize > 0 then + Result := (InputSize + 2) div 3 * 4 + (InputSize - 1) div MIME_DECODED_LINE_BREAK * 2 + else + Result := InputSize; +end; + +function MimeEncodedSizeNoCRLF(const InputSize: SizeInt): SizeInt; +begin + Result := (InputSize + 2) div 3 * 4; +end; + +function MimeDecodedSize(const InputSize: SizeInt): SizeInt; +begin + Result := (InputSize + 3) div 4 * 3; +end; + + +// Primary functions & procedures +procedure MimeEncode(const InputBuffer: TDynByteArray; InputOffset: SizeInt; + const InputByteCount: SizeInt; + out OutputBuffer: TDynByteArray; OutputOffset: SizeInt); +var + IDelta, ODelta: SizeInt; +begin + MimeEncodeFullLines(InputBuffer, InputOffset, InputByteCount, OutputBuffer, OutputOffset); + IDelta := InputByteCount div MIME_DECODED_LINE_BREAK; // Number of lines processed so far. + ODelta := IDelta * (MIME_ENCODED_LINE_BREAK + 2); + IDelta := IDelta * MIME_DECODED_LINE_BREAK; + MimeEncodeNoCRLF(InputBuffer, InputOffset + IDelta, InputByteCount - IDelta, OutputBuffer, OutputOffset + ODelta); +end; + +// Primary functions & procedures +procedure MimeEncode(const InputBuffer; const InputByteCount: SizeInt; out OutputBuffer); +var + IDelta, ODelta: SizeInt; + I, O: PByte; +begin + MimeEncodeFullLines(InputBuffer, InputByteCount, OutputBuffer); + IDelta := InputByteCount div MIME_DECODED_LINE_BREAK; // Number of lines processed so far. + ODelta := IDelta * (MIME_ENCODED_LINE_BREAK + 2); + IDelta := IDelta * MIME_DECODED_LINE_BREAK; + I := @InputBuffer; + Inc(I, IDelta); + O := @OutputBuffer; + Inc(O, ODelta); + MimeEncodeNoCRLF(I^, InputByteCount - IDelta, O^); +end; + +procedure MimeEncodeFullLines(const InputBuffer: TDynByteArray; InputOffset: SizeInt; + const InputByteCount: SizeInt; out OutputBuffer: TDynByteArray; OutputOffset: SizeInt); +var + B: SizeInt; + InnerLimit, OuterLimit: TJclAddr; + InIndex: TJclAddr; + OutIndex: TJclAddr; +begin + { Do we have enough input to encode a full line? } + if InputByteCount < MIME_DECODED_LINE_BREAK then + Exit; + + InIndex := InputOffset; + OutIndex := OutputOffset; + + InnerLimit := InIndex; + Inc(InnerLimit, MIME_DECODED_LINE_BREAK); + + OuterLimit := InIndex; + Inc(OuterLimit, InputByteCount); + + { Multiple line loop. } + repeat + { Single line loop. } + repeat + { Read 3 bytes from InputBuffer. } + B := InputBuffer[InIndex + 0]; + B := B shl 8; + B := B or InputBuffer[InIndex + 1]; + B := B shl 8; + B := B or InputBuffer[InIndex + 2]; + Inc(InIndex, 3); + { Write 4 bytes to OutputBuffer (in reverse order). } + OutputBuffer[OutIndex + 3] := MIME_ENCODE_TABLE[B and $3F]; + B := B shr 6; + OutputBuffer[OutIndex + 2] := MIME_ENCODE_TABLE[B and $3F]; + B := B shr 6; + OutputBuffer[OutIndex + 1] := MIME_ENCODE_TABLE[B and $3F]; + B := B shr 6; + OutputBuffer[OutIndex + 0] := MIME_ENCODE_TABLE[B]; + Inc(OutIndex, 3); + until InIndex >= InnerLimit; + + { Write line break (CRLF). } + OutputBuffer[OutIndex + 0] := 13; + OutputBuffer[OutIndex + 1] := 10; + Inc(OutIndex, 2); + + Inc(InnerLimit, MIME_DECODED_LINE_BREAK); + until InnerLimit > OuterLimit; +end; + +procedure MimeEncodeFullLines(const InputBuffer; const InputByteCount: SizeInt; out OutputBuffer); +var + B: Cardinal; + InnerLimit, OuterLimit: TJclAddr; + InPtr: PByte3; + OutPtr: PByte4; +begin + { Do we have enough input to encode a full line? } + if InputByteCount < MIME_DECODED_LINE_BREAK then + Exit; + + InPtr := @InputBuffer; + OutPtr := @OutputBuffer; + + InnerLimit := TJclAddr(InPtr); + Inc(InnerLimit, MIME_DECODED_LINE_BREAK); + + OuterLimit := TJclAddr(InPtr); + Inc(OuterLimit, InputByteCount); + + { Multiple line loop. } + repeat + { Single line loop. } + repeat + { Read 3 bytes from InputBuffer. } + B := InPtr^.B1; + B := B shl 8; + B := B or InPtr^.B2; + B := B shl 8; + B := B or InPtr^.B3; + Inc(InPtr); + { Write 4 bytes to OutputBuffer (in reverse order). } + OutPtr^.B4 := MIME_ENCODE_TABLE[B and $3F]; + B := B shr 6; + OutPtr^.B3 := MIME_ENCODE_TABLE[B and $3F]; + B := B shr 6; + OutPtr^.B2 := MIME_ENCODE_TABLE[B and $3F]; + B := B shr 6; + OutPtr^.B1 := MIME_ENCODE_TABLE[B]; + Inc(OutPtr); + until TJclAddr(InPtr) >= InnerLimit; + + { Write line break (CRLF). } + OutPtr^.B1 := 13; + OutPtr^.B2 := 10; + Inc(TJclAddr(OutPtr), 2); + + Inc(InnerLimit, MIME_DECODED_LINE_BREAK); + until InnerLimit > OuterLimit; +end; + +procedure MimeEncodeNoCRLF(const InputBuffer: TDynByteArray; InputOffset: SizeInt; + const InputByteCount: SizeInt; out OutputBuffer: TDynByteArray; OutputOffset: SizeInt); +var + B: SizeInt; + InnerLimit, OuterLimit: TJclAddr; + InIndex: TJclAddr; + OutIndex: TJclAddr; +begin + if InputByteCount = 0 then + Exit; + + InIndex := InputOffset; + OutIndex := OutputOffset; + + OuterLimit := InputByteCount div 3 * 3; + + InnerLimit := InIndex; + Inc(InnerLimit, OuterLimit); + + { Last line loop. } + while InIndex < InnerLimit do + begin + { Read 3 bytes from InputBuffer. } + B := InputBuffer[InIndex + 0]; + B := B shl 8; + B := B or InputBuffer[InIndex + 1]; + B := B shl 8; + B := B or InputBuffer[InIndex + 2]; + Inc(InIndex, 3); + { Write 4 bytes to OutputBuffer (in reverse order). } + OutputBuffer[OutIndex + 3] := MIME_ENCODE_TABLE[B and $3F]; + B := B shr 6; + OutputBuffer[OutIndex + 2] := MIME_ENCODE_TABLE[B and $3F]; + B := B shr 6; + OutputBuffer[OutIndex + 1] := MIME_ENCODE_TABLE[B and $3F]; + B := B shr 6; + OutputBuffer[OutIndex + 0] := MIME_ENCODE_TABLE[B]; + Inc(OutIndex, 3); + end; + + { End of data & padding. } + case TJclAddr(InputByteCount) - OuterLimit of + 1: + begin + B := InputBuffer[InIndex + 0]; + B := B shl 4; + OutputBuffer[OutIndex + 1] := MIME_ENCODE_TABLE[B and $3F]; + B := B shr 6; + OutputBuffer[OutIndex + 0] := MIME_ENCODE_TABLE[B]; + OutputBuffer[OutIndex + 2] := MIME_PAD_CHAR; { Pad remaining 2 bytes. } + OutputBuffer[OutIndex + 3] := MIME_PAD_CHAR; + end; + 2: + begin + B := InputBuffer[InIndex + 0]; + B := B shl 8; + B := B or InputBuffer[InIndex + 1]; + B := B shl 2; + OutputBuffer[OutIndex + 2] := MIME_ENCODE_TABLE[B and $3F]; + B := B shr 6; + OutputBuffer[OutIndex + 1] := MIME_ENCODE_TABLE[B and $3F]; + B := B shr 6; + OutputBuffer[OutIndex + 0] := MIME_ENCODE_TABLE[B]; + OutputBuffer[OutIndex + 3] := MIME_PAD_CHAR; { Pad remaining byte. } + end; + end; +end; + +procedure MimeEncodeNoCRLF(const InputBuffer; const InputByteCount: SizeInt; out OutputBuffer); +var + B: Cardinal; + InnerLimit, OuterLimit: TJclAddr; + InPtr: PByte3; + OutPtr: PByte4; +begin + if InputByteCount = 0 then + Exit; + + InPtr := @InputBuffer; + OutPtr := @OutputBuffer; + + OuterLimit := InputByteCount div 3 * 3; + + InnerLimit := TJclAddr(InPtr); + Inc(InnerLimit, OuterLimit); + + { Last line loop. } + while TJclAddr(InPtr) < TJclAddr(InnerLimit) do + begin + { Read 3 bytes from InputBuffer. } + B := InPtr^.B1; + B := B shl 8; + B := B or InPtr^.B2; + B := B shl 8; + B := B or InPtr^.B3; + Inc(InPtr); + { Write 4 bytes to OutputBuffer (in reverse order). } + OutPtr^.B4 := MIME_ENCODE_TABLE[B and $3F]; + B := B shr 6; + OutPtr^.B3 := MIME_ENCODE_TABLE[B and $3F]; + B := B shr 6; + OutPtr^.B2 := MIME_ENCODE_TABLE[B and $3F]; + B := B shr 6; + OutPtr^.B1 := MIME_ENCODE_TABLE[B]; + Inc(OutPtr); + end; + + { End of data & padding. } + case TJclAddr(InputByteCount) - OuterLimit of + 1: + begin + B := InPtr^.B1; + B := B shl 4; + OutPtr.B2 := MIME_ENCODE_TABLE[B and $3F]; + B := B shr 6; + OutPtr.B1 := MIME_ENCODE_TABLE[B]; + OutPtr.B3 := MIME_PAD_CHAR; { Pad remaining 2 bytes. } + OutPtr.B4 := MIME_PAD_CHAR; + end; + 2: + begin + B := InPtr^.B1; + B := B shl 8; + B := B or InPtr^.B2; + B := B shl 2; + OutPtr.B3 := MIME_ENCODE_TABLE[B and $3F]; + B := B shr 6; + OutPtr.B2 := MIME_ENCODE_TABLE[B and $3F]; + B := B shr 6; + OutPtr.B1 := MIME_ENCODE_TABLE[B]; + OutPtr.B4 := MIME_PAD_CHAR; { Pad remaining byte. } + end; + end; +end; + +// Decoding Core +function MimeDecode(const InputBuffer: TDynByteArray; InputOffset: SizeInt; + const InputByteCount: SizeInt; out OutputBuffer: TDynByteArray; OutputOffset: SizeInt): SizeInt; +var + ByteBuffer, ByteBufferSpace: Cardinal; +begin + ByteBuffer := 0; + ByteBufferSpace := 4; + Result := MimeDecodePartial(InputBuffer, InputOffset, InputByteCount, OutputBuffer, OutputOffset, ByteBuffer, ByteBufferSpace); + Inc(Result, MimeDecodePartialEnd(OutputBuffer, OutputOffset + Result, ByteBuffer, ByteBufferSpace)); +end; + +// Decoding Core +function MimeDecode(const InputBuffer; const InputByteCount: SizeInt; out OutputBuffer): SizeInt; +var + ByteBuffer, ByteBufferSpace: Cardinal; + O: PByte; +begin + ByteBuffer := 0; + ByteBufferSpace := 4; + Result := MimeDecodePartial(InputBuffer, InputByteCount, OutputBuffer, ByteBuffer, ByteBufferSpace); + O := @OutputBuffer; + Inc(O, Result); + Inc(Result, MimeDecodePartialEnd(O^, ByteBuffer, ByteBufferSpace)); +end; + +function MimeDecodePartial(const InputBuffer: TDynByteArray; InputOffset: SizeInt; + const InputByteCount: SizeInt; out OutputBuffer: TDynByteArray; OutputOffset: SizeInt; + var ByteBuffer: Cardinal; var ByteBufferSpace: Cardinal): SizeInt; +var + LByteBuffer, LByteBufferSpace, C: Cardinal; + InIndex, OuterLimit: TJclAddr; + OutIndex: TJclAddr; +begin + if InputByteCount > 0 then + begin + InIndex := InputOffset; + OuterLimit := InIndex + TJclAddr(InputByteCount); + OutIndex := OutputOffset; + LByteBuffer := ByteBuffer; + LByteBufferSpace := ByteBufferSpace; + while InIndex < OuterLimit do + begin + { Read from InputBuffer. } + C := MIME_DECODE_TABLE[InputBuffer[InIndex]]; + Inc(InIndex); + if C = $FF then + Continue; + LByteBuffer := LByteBuffer shl 6; + LByteBuffer := LByteBuffer or C; + Dec(LByteBufferSpace); + { Have we read 4 bytes from InputBuffer? } + if LByteBufferSpace <> 0 then + Continue; + + { Write 3 bytes to OutputBuffer (in reverse order). } + OutputBuffer[OutIndex + 2] := Byte(LByteBuffer); + LByteBuffer := LByteBuffer shr 8; + OutputBuffer[OutIndex + 1] := Byte(LByteBuffer); + LByteBuffer := LByteBuffer shr 8; + OutputBuffer[OutIndex + 0] := Byte(LByteBuffer); + LByteBuffer := 0; + Inc(OutIndex, 3); + LByteBufferSpace := 4; + end; + ByteBuffer := LByteBuffer; + ByteBufferSpace := LByteBufferSpace; + Result := OutIndex - TJclAddr(OutputOffset); + end + else + Result := 0; +end; + +function MimeDecodePartial(const InputBuffer; const InputByteCount: SizeInt; out OutputBuffer; + var ByteBuffer: Cardinal; var ByteBufferSpace: Cardinal): SizeInt; +var + LByteBuffer, LByteBufferSpace, C: Cardinal; + InPtr, OuterLimit: PByte; + OutPtr: PByte3; +begin + if InputByteCount > 0 then + begin + InPtr := @InputBuffer; + OuterLimit := Pointer(TJclAddr(InPtr) + TJclAddr(InputByteCount)); + OutPtr := @OutputBuffer; + LByteBuffer := ByteBuffer; + LByteBufferSpace := ByteBufferSpace; + while InPtr <> OuterLimit do + begin + { Read from InputBuffer. } + C := MIME_DECODE_TABLE[InPtr^]; + Inc(InPtr); + if C = $FF then + Continue; + LByteBuffer := LByteBuffer shl 6; + LByteBuffer := LByteBuffer or C; + Dec(LByteBufferSpace); + { Have we read 4 bytes from InputBuffer? } + if LByteBufferSpace <> 0 then + Continue; + + { Write 3 bytes to OutputBuffer (in reverse order). } + OutPtr^.B3 := Byte(LByteBuffer); + LByteBuffer := LByteBuffer shr 8; + OutPtr^.B2 := Byte(LByteBuffer); + LByteBuffer := LByteBuffer shr 8; + OutPtr^.B1 := Byte(LByteBuffer); + LByteBuffer := 0; + Inc(OutPtr); + LByteBufferSpace := 4; + end; + ByteBuffer := LByteBuffer; + ByteBufferSpace := LByteBufferSpace; + Result := SizeInt(TJclAddr(OutPtr) - TJclAddr(@OutputBuffer)); + end + else + Result := 0; +end; + +function MimeDecodePartialEnd(out OutputBuffer: TDynByteArray; OutputOffset: SizeInt; + const ByteBuffer: Cardinal; const ByteBufferSpace: Cardinal): SizeInt; +var + LByteBuffer: Cardinal; +begin + case ByteBufferSpace of + 1: + begin + LByteBuffer := ByteBuffer shr 2; + OutputBuffer[OutputOffset + 1] := Byte(LByteBuffer); + LByteBuffer := LByteBuffer shr 8; + OutputBuffer[OutputOffset + 0] := Byte(LByteBuffer); + Result := 2; + end; + 2: + begin + LByteBuffer := ByteBuffer shr 4; + OutputBuffer[OutputOffset + 0] := Byte(LByteBuffer); + Result := 1; + end; + else + Result := 0; + end; +end; + +function MimeDecodePartialEnd(out OutputBuffer; const ByteBuffer: Cardinal; + const ByteBufferSpace: Cardinal): SizeInt; +var + LByteBuffer: Cardinal; +begin + case ByteBufferSpace of + 1: + begin + LByteBuffer := ByteBuffer shr 2; + PByte3(@OutputBuffer)^.B2 := Byte(LByteBuffer); + LByteBuffer := LByteBuffer shr 8; + PByte3(@OutputBuffer)^.B1 := Byte(LByteBuffer); + Result := 2; + end; + 2: + begin + LByteBuffer := ByteBuffer shr 4; + PByte3(@OutputBuffer)^.B1 := Byte(LByteBuffer); + Result := 1; + end; + else + Result := 0; + end; +end; + +// File Encoding & Decoding +procedure MimeEncodeFile(const InputFileName, OutputFileName: TFileName); +var + InputStream, OutputStream: TFileStream; +begin + InputStream := TFileStream.Create(InputFileName, fmOpenRead or fmShareDenyWrite); + try + OutputStream := TFileStream.Create(OutputFileName, fmCreate); + try + MimeEncodeStream(InputStream, OutputStream); + finally + OutputStream.Free; + end; + finally + InputStream.Free; + end; +end; + +procedure MimeEncodeFileNoCRLF(const InputFileName, OutputFileName: TFileName); +var + InputStream, OutputStream: TFileStream; +begin + InputStream := TFileStream.Create(InputFileName, fmOpenRead or fmShareDenyWrite); + try + OutputStream := TFileStream.Create(OutputFileName, fmCreate); + try + MimeEncodeStreamNoCRLF(InputStream, OutputStream); + finally + OutputStream.Free; + end; + finally + InputStream.Free; + end; +end; + +procedure MimeDecodeFile(const InputFileName, OutputFileName: TFileName); +var + InputStream, OutputStream: TFileStream; +begin + InputStream := TFileStream.Create(InputFileName, fmOpenRead or fmShareDenyWrite); + try + OutputStream := TFileStream.Create(OutputFileName, fmCreate); + try + MimeDecodeStream(InputStream, OutputStream); + finally + OutputStream.Free; + end; + finally + InputStream.Free; + end; +end; + +// Stream Encoding & Decoding +procedure MimeEncodeStream(const InputStream: TStream; const OutputStream: TStream); +var + InputBuffer: array [0..MIME_BUFFER_SIZE - 1] of Byte; + OutputBuffer: array [0..(MIME_BUFFER_SIZE + 2) div 3 * 4 + MIME_BUFFER_SIZE div MIME_DECODED_LINE_BREAK * 2 - 1] of Byte; + BytesRead: SizeInt; + IDelta, ODelta: SizeInt; + I, O: PByte; +begin + InputBuffer[0] := 0; + BytesRead := InputStream.Read(InputBuffer, SizeOf(InputBuffer)); + + while BytesRead = Length(InputBuffer) do + begin + MimeEncodeFullLines(InputBuffer, Length(InputBuffer), OutputBuffer); + OutputStream.Write(OutputBuffer, Length(OutputBuffer)); + BytesRead := InputStream.Read(InputBuffer, Length(InputBuffer)); + end; + + MimeEncodeFullLines(InputBuffer, BytesRead, OutputBuffer); + + IDelta := BytesRead div MIME_DECODED_LINE_BREAK; // Number of lines processed. + ODelta := IDelta * (MIME_ENCODED_LINE_BREAK + 2); + IDelta := IDelta * MIME_DECODED_LINE_BREAK; + + I := @InputBuffer; + Inc(I, IDelta); + O := @OutputBuffer; + Inc(O, ODelta); + + MimeEncodeNoCRLF(I^, BytesRead - IDelta, O^); + + OutputStream.Write(OutputBuffer, MimeEncodedSize(BytesRead)); +end; + +procedure MimeEncodeStreamNoCRLF(const InputStream: TStream; const OutputStream: TStream); +var + InputBuffer: array [0..MIME_BUFFER_SIZE - 1] of Byte; + OutputBuffer: array [0..((MIME_BUFFER_SIZE + 2) div 3) * 4 - 1] of Byte; + BytesRead: SizeInt; +begin + InputBuffer[0] := 0; + BytesRead := InputStream.Read(InputBuffer, SizeOf(InputBuffer)); + + while BytesRead = Length(InputBuffer) do + begin + MimeEncodeNoCRLF(InputBuffer, Length(InputBuffer), OutputBuffer); + OutputStream.Write(OutputBuffer, Length(OutputBuffer)); + BytesRead := InputStream.Read(InputBuffer, Length(InputBuffer)); + end; + + MimeEncodeNoCRLF(InputBuffer, BytesRead, OutputBuffer); + OutputStream.Write(OutputBuffer, MimeEncodedSizeNoCRLF(BytesRead)); +end; + +procedure MimeDecodeStream(const InputStream: TStream; const OutputStream: TStream); +var + ByteBuffer, ByteBufferSpace: Cardinal; + InputBuffer: array [0..MIME_BUFFER_SIZE - 1] of Byte; + OutputBuffer: array [0..(MIME_BUFFER_SIZE + 3) div 4 * 3 - 1] of Byte; + BytesRead: SizeInt; +begin + ByteBuffer := 0; + ByteBufferSpace := 4; + InputBuffer[0] := 0; + BytesRead := InputStream.Read(InputBuffer, SizeOf(InputBuffer)); + + while BytesRead > 0 do + begin + OutputStream.Write(OutputBuffer, MimeDecodePartial(InputBuffer, BytesRead, OutputBuffer, ByteBuffer, ByteBufferSpace)); + BytesRead := InputStream.Read(InputBuffer, Length(InputBuffer)); + end; + OutputStream.Write(OutputBuffer, MimeDecodePartialEnd(OutputBuffer, ByteBuffer, ByteBufferSpace)); +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclNotify.pas b/3rdParty/JCL/source/common/JclNotify.pas new file mode 100644 index 00000000..d2160764 --- /dev/null +++ b/3rdParty/JCL/source/common/JclNotify.pas @@ -0,0 +1,450 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclNotify.pas. } +{ } +{ The Initial Developer of the Original Code is Marcel Bestebroer. } +{ Portions created by Marcel Bestebroer are Copyright Marcel Bestebroer. All rights reserved. } +{ } +{ Contributors: } +{ - } +{ } +{**************************************************************************************************} +{ } +{ This unit contains generic JCL notification/listener pattern interfaces and base implementations } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclNotify; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclBase, + {$IFDEF THREADSAFE} + JclSynch, + {$ENDIF THREADSAFE} + {$IFDEF HAS_UNITSCOPE} + System.Classes; + {$ELSE ~HAS_UNITSCOPE} + Classes; + {$ENDIF ~HAS_UNITSCOPE} + + { The following interfaces provide a basic notifier/listener setup. Whenever code issues a notification through the + IJclNotifier.Notify method, all listeners registered with the notifier will receive the message (through the + listener's Notification method). Since this setup doesn't care which or how many listeners are actually responding, + it can greatly simplify code that need some form of notification. } +type + // forward declarations + IJclListener = interface; + IJclNotificationMessage = interface; + IJclNotifier = interface; + + IJclListener = interface + ['{26A52ECC-4C22-4B71-BC88-D0EB98AF4ED5}'] + procedure Notification(msg: IJclNotificationMessage); stdcall; + end; + + IJclNotificationMessage = interface + ['{2618CCC6-0C7D-47EE-9A91-7A7F5264385D}'] + end; + + IJclNotifier = interface + ['{CAAD7814-DD04-497C-91AC-558C2D5BFF81}'] + procedure Add(listener: IJclListener); stdcall; + procedure Remove(listener: IJclListener); stdcall; + procedure Notify(msg: IJclNotificationMessage); stdcall; + end; + + { The following classes provide a basic notifier/listener implementation. Note that using one of these classes does + not imply the usage of the related classes; the notifier can be used in conjection with any class implementing + IJclListener and vice versa. } +type + TJclBaseListener = class (TInterfacedObject, IJclListener) + public + { IJclListener } + procedure Notification(msg: IJclNotificationMessage); virtual; stdcall; + end; + + TJclBaseNotificationMessage = class (TInterfacedObject, IJclNotificationMessage) + end; + + TJclBaseNotifier = class (TInterfacedObject, IJclNotifier) + public + constructor Create; + destructor Destroy; override; + private + FListeners: TInterfaceList; + {$IFDEF THREADSAFE} + FSynchronizer: TJclMultiReadExclusiveWrite; + {$ENDIF THREADSAFE} + public + { IJclNotifier } + procedure Add(listener: IJclListener); stdcall; + procedure Notify(msg: IJclNotificationMessage); stdcall; + procedure Remove(listener: IJclListener); stdcall; + end; + +type + TJclMethodArray = array of TMethod; + + // base class for all object methods broadcasts + TJclMethodBroadCast = class + protected + FHandlers: TJclMethodArray; + FHandlerCount: Integer; + function GetHandler(Index: Integer): TMethod; + public + function AddHandler(const AHandler: TMethod): Integer; + procedure RemoveHandler(const AHandler: TMethod); + procedure DeleteHandler(Index: Integer); + property HandlerCount: Integer read FHandlerCount; + end; + + // This class broadcasts a notification event to a list of handlers + TJclNotifyEventBroadcast = class(TJclMethodBroadCast) + protected + function GetHandler(Index: Integer): TNotifyEvent; + public + function AddHandler(const AHandler: TNotifyEvent): Integer; + procedure RemoveHandler(const AHandler: TNotifyEvent); + procedure Notify(Sender: TObject); + property Handlers[Index: Integer]: TNotifyEvent read GetHandler; + end; + + TJclProcedureEvent = procedure of object; + + // This class broadcasts an event to a list of handlers + TJclProcedureEventBroadcast = class(TJclMethodBroadCast) + protected + function GetHandler(Index: Integer): TJclProcedureEvent; + public + function AddHandler(const AHandler: TJclProcedureEvent): Integer; + procedure RemoveHandler(const AHandler: TJclProcedureEvent); + procedure CallAllProcedures; + property Handlers[Index: Integer]: TJclProcedureEvent read GetHandler; + end; + + TJclBooleanProcedureEvent = procedure(Value: Boolean) of object; + + // This class broadcasts an event to a list of handlers + TJclBooleanProcedureEventBroadcast = class(TJclMethodBroadCast) + protected + function GetHandler(Index: Integer): TJclBooleanProcedureEvent; + public + function AddHandler(const AHandler: TJclBooleanProcedureEvent): Integer; + procedure RemoveHandler(const AHandler: TJclBooleanProcedureEvent); + procedure CallAllProcedures(Value: Boolean); + property Handlers[Index: Integer]: TJclBooleanProcedureEvent read GetHandler; + end; + + TJclBooleanEvent = function: Boolean of object; + + // This class broadcasts a predicate to a list of handlers + TJclBooleanEventBroadcast = class(TJclMethodBroadCast) + protected + function GetHandler(Index: Integer): TJclBooleanEvent; + public + function AddHandler(const AHandler: TJclBooleanEvent): Integer; + procedure RemoveHandler(const AHandler: TJclBooleanEvent); + function LogicalAnd: Boolean; + property Handlers[Index: Integer]: TJclBooleanEvent read GetHandler; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +//=== { TJclBaseNotifier } =================================================== + +constructor TJclBaseNotifier.Create; +begin + inherited Create; + FListeners := TInterfaceList.Create; + {$IFDEF THREADSAFE} + FSynchronizer := TJclMultiReadExclusiveWrite.Create(mpReaders); + {$ENDIF THREADSAFE} +end; + +destructor TJclBaseNotifier.Destroy; +begin + {$IFDEF THREADSAFE} + FSynchronizer.BeginWrite; + try + {$ENDIF THREADSAFE} + FreeAndNil(FListeners); + {$IFDEF THREADSAFE} + finally + FSynchronizer.EndWrite; + FreeAndNil(FSynchronizer); + end; + {$ENDIF THREADSAFE} + inherited Destroy; +end; + +procedure TJclBaseNotifier.Add(listener: IJclListener); +begin + {$IFDEF THREADSAFE} + FSynchronizer.BeginWrite; + try + {$ENDIF THREADSAFE} + if FListeners.IndexOf(listener) < 0 then + FListeners.Add(listener); + {$IFDEF THREADSAFE} + finally + FSynchronizer.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclBaseNotifier.Notify(msg: IJclNotificationMessage); +var + idx: Integer; +begin + {$IFDEF THREADSAFE} + FSynchronizer.BeginRead; + try + {$ENDIF THREADSAFE} + for idx := 0 to FListeners.Count - 1 do + IJclListener(FListeners[idx]).Notification(msg); + {$IFDEF THREADSAFE} + finally + FSynchronizer.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclBaseNotifier.Remove(listener: IJclListener); +var + idx: Integer; +begin + {$IFDEF THREADSAFE} + FSynchronizer.BeginWrite; + try + {$ENDIF THREADSAFE} + idx := FListeners.IndexOf(listener); + if idx >= 0 then + FListeners.Delete(idx); + {$IFDEF THREADSAFE} + finally + FSynchronizer.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclBaseListener } =================================================== + +procedure TJclBaseListener.Notification(msg: IJclNotificationMessage); +begin + // do nothing; descendants should override this method to process incoming notifications +end; + +//=== { TNotifyEventBroadcast } ============================================== + +function TJclMethodBroadcast.AddHandler( + const AHandler: TMethod): Integer; +var + HandlerLength: Integer; +begin + HandlerLength := Length(FHandlers); + if FHandlerCount >= HandlerLength then + begin + if HandlerLength > 0 then + HandlerLength := HandlerLength * 2 + else + HandlerLength := 4; + SetLength(FHandlers, HandlerLength); + end; + Result := FHandlerCount; + Inc(FHandlerCount); + FHandlers[Result] := AHandler; +end; + +procedure TJclMethodBroadcast.DeleteHandler(Index: Integer); +var + I: Integer; + HandlerLength: Integer; +begin + for I := Index to FHandlerCount - 2 do + FHandlers[I] := FHandlers[I + 1]; + + HandlerLength := Length(FHandlers); + Dec(FHandlerCount); + if (FHandlerCount > 0) and ((2 * FHandlerCount) < HandlerLength) then + begin + HandlerLength := HandlerLength div 2; + SetLength(FHandlers, HandlerLength); + end; +end; + +function TJclMethodBroadcast.GetHandler(Index: Integer): TMethod; +begin + Result := FHandlers[Index]; +end; + +procedure TJclMethodBroadcast.RemoveHandler(const AHandler: TMethod); +var + Index: Integer; +begin + for Index := FHandlerCount - 1 downto 0 do + if (TMethod(FHandlers[Index]).Code = TMethod(AHandler).Code) and + (TMethod(FHandlers[Index]).Data = TMethod(AHandler).Data) then + DeleteHandler(Index); +end; + +//=== { TJclNotifyEventBroadcast } =========================================== + +function TJclNotifyEventBroadcast.AddHandler( + const AHandler: TNotifyEvent): Integer; +begin + Result := inherited AddHandler(TMethod(AHandler)); +end; + +function TJclNotifyEventBroadcast.GetHandler(Index: Integer): TNotifyEvent; +begin + Result := TNotifyEvent(inherited GetHandler(Index)); +end; + +procedure TJclNotifyEventBroadcast.Notify(Sender: TObject); +var + Index: Integer; +begin + for Index := 0 to FHandlerCount - 1 do + TNotifyEvent(FHandlers[Index])(Sender); +end; + +procedure TJclNotifyEventBroadcast.RemoveHandler(const AHandler: TNotifyEvent); +begin + inherited RemoveHandler(TMethod(AHandler)); +end; + +//=== { TJclProcedureBroadcast } ============================================= + +function TJclProcedureEventBroadcast.AddHandler( + const AHandler: TJclProcedureEvent): Integer; +begin + Result := inherited AddHandler(TMethod(AHandler)); +end; + +function TJclProcedureEventBroadcast.GetHandler(Index: Integer): TJclProcedureEvent; +begin + Result := TJclProcedureEvent(inherited GetHandler(Index)); +end; + +procedure TJclProcedureEventBroadcast.CallAllProcedures; +var + Index: Integer; +begin + for Index := 0 to FHandlerCount - 1 do + TJclProcedureEvent(FHandlers[Index]); +end; + +procedure TJclProcedureEventBroadcast.RemoveHandler(const AHandler: TJclProcedureEvent); +begin + inherited RemoveHandler(TMethod(AHandler)); +end; + +//=== { TJclBooleanProcedureBroadcast } ============================================= + +function TJclBooleanProcedureEventBroadcast.AddHandler( + const AHandler: TJclBooleanProcedureEvent): Integer; +begin + Result := inherited AddHandler(TMethod(AHandler)); +end; + +function TJclBooleanProcedureEventBroadcast.GetHandler(Index: Integer): TJclBooleanProcedureEvent; +begin + Result := TJclBooleanProcedureEvent(inherited GetHandler(Index)); +end; + +procedure TJclBooleanProcedureEventBroadcast.CallAllProcedures(Value: Boolean); +var + Index: Integer; +begin + for Index := 0 to FHandlerCount - 1 do + TJclBooleanProcedureEvent(FHandlers[Index])(Value); +end; + +procedure TJclBooleanProcedureEventBroadcast.RemoveHandler(const AHandler: TJclBooleanProcedureEvent); +begin + inherited RemoveHandler(TMethod(AHandler)); +end; + +//=== { TJclBooleanEventBroadcast } ========================================== + +function TJclBooleanEventBroadcast.AddHandler( + const AHandler: TJclBooleanEvent): Integer; +begin + Result := inherited AddHandler(TMethod(AHandler)); +end; + +function TJclBooleanEventBroadcast.GetHandler(Index: Integer): TJclBooleanEvent; +begin + Result := TJclBooleanEvent(inherited GetHandler(Index)); +end; + +function TJclBooleanEventBroadcast.LogicalAnd: Boolean; +var + Index: Integer; +begin + Result := True; + for Index := 0 to FHandlerCount - 1 do + begin + Result := TJclBooleanEvent(FHandlers[Index]); + if not Result then + Break; + end; +end; + +procedure TJclBooleanEventBroadcast.RemoveHandler( + const AHandler: TJclBooleanEvent); +begin + inherited RemoveHandler(TMethod(AHandler)); +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclPCRE.pas b/3rdParty/JCL/source/common/JclPCRE.pas index 562311a0..697fef4a 100644 --- a/3rdParty/JCL/source/common/JclPCRE.pas +++ b/3rdParty/JCL/source/common/JclPCRE.pas @@ -1,1338 +1,1338 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is JclPCRE.pas. } -{ } -{ The Initial Developer of the Original Code is Peter Thornqvist. } -{ Portions created by Peter Thornqvist are Copyright (C) of Peter Thornqvist. All rights reserved. } -{ } -{ Contributor(s): } -{ Robert Rossmair (rrossmair) } -{ Mario R. Carro } -{ Florent Ouchet (outchy) } -{ } -{**************************************************************************************************} -{ } -{ Class wrapper for PCRE (PERL Compatible Regular Expression) } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -unit JclPCRE; - -{$I jcl.inc} - -{$RANGECHECKS OFF} - -interface - -uses - pcre, - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - {$IFDEF HAS_UNIT_LIBC} - Libc, - {$ENDIF HAS_UNIT_LIBC} - {$IFDEF HAS_UNITSCOPE} - System.Classes, System.SysUtils, - {$IFDEF PCRE_RTL} - System.RegularExpressionsAPI, - {$ENDIF PCRE_RTL} - {$ELSE ~HAS_UNITSCOPE} - Classes, SysUtils, - {$IFDEF PCRE_RTL} - RegularExpressionsAPI, - {$ENDIF PCRE_RTL} - {$ENDIF ~HAS_UNITSCOPE} - JclBase, JclStringConversions; - -const - JCL_PCRE_CALLOUT_NOERROR = 0; - JCL_PCRE_CALLOUT_FAILCONTINUE = 1; - - JCL_PCRE_ERROR_NOJIT = -996; - JCL_PCRE_ERROR_NOUTF8 = -997; - JCL_PCRE_ERROR_NOUTF16 = -997; - JCL_PCRE_ERROR_CALLOUTERROR = -998; - JCL_PCRE_ERROR_STUDYFAILED = -999; - -type - EPCREError = class(EJclError) - private - FErrorCode: Integer; - public - constructor CreateRes(ResStringRec: PResStringRec; ErrorCode: Integer); - property ErrorCode: Integer read FErrorCode; - end; - - TPCREIntArray = array [0 .. 0] of Integer; - PPCREIntArray = ^TPCREIntArray; - - TJclRegExOption = (roIgnoreCase, roMultiLine, roDotAll, roExtended, - roAnchored, roDollarEndOnly, roExtra, roNotBOL, roNotEOL, roUnGreedy, - roNotEmpty, roUTF8, roNoAutoCapture, roNoUTF8Check, roAutoCallout, - roPartial, roDfaShortest, roDfaRestart, roFirstLine, roDupNames, - roNewLineCR, roNewLineLF, roNewLineCRLF, roNewLineAny, roBSRAnyCRLF, - roBSRUnicode, roJavascriptCompat, roNoStartOptimize, roPartialHard, - roNotEmptyAtStart, roUCP); - TJclRegExOptions = set of TJclRegExOption; - -const - roUTF16 = roUTF8; - roNoUTF16Check = roNoUTF8Check; - -type - TJclRegExBase = class; - - TJclCaptureRange = record - FirstPos: Integer; - LastPos: Integer; - end; - - TJclRegExCallout = procedure (Sender: TJclRegExBase; - Index, MatchStart, SubjectPos, LastCapture, PatternPos, NextItemLength: Integer; - var ErrorCode: Integer) of object; - TPCRECalloutIndex = 0 .. 255; - - TJclRegExBase = class(TObject) - private - FOptions: TJclRegExOptions; - FPattern: string; - FDfaMode: Boolean; - FSubject: string; - - FViewChanges: Boolean; - FChangedCaptures: TList; - FResultValues: array of string; - - FErrorCode: Integer; - FErrorMessage: string; - FErrorOffset: Integer; - - FVector: PPCREIntArray; - FVectorSize: Integer; - FCaptureCount: Integer; - - FOnCallout: TJclRegExCallout; - - protected - function GetResult: string; virtual; - function GetCapture(Index: Integer): string; virtual; abstract; - procedure SetCapture(Index: Integer; const Value: string); virtual; - function GetCaptureRange(Index: Integer): TJclCaptureRange; virtual; abstract; - function GetNamedCapture(const Name: string): string; virtual; abstract; - procedure SetNamedCapture(const Name, Value: string); virtual; abstract; - function GetCaptureNameCount: Integer; virtual; abstract; - function GetCaptureName(Index: Integer): string; virtual; abstract; - function GetAPIOptions(RunTime, DFA: Boolean): Integer; virtual; - - function SupportsWideChar: Boolean; virtual; - public - destructor Destroy; override; - - property Options: TJclRegExOptions read FOptions write FOptions; - function Compile(const Pattern: string; Study: Boolean; - UserLocale: Boolean = False; JITCompile: Boolean = False): Boolean; virtual; abstract; - property Pattern: string read FPattern; - property DfaMode: Boolean read FDfaMode write FDfaMode; - function Match(const Subject: string; StartOffset: Cardinal = 1): Boolean; virtual; abstract; - property Subject: string read FSubject; - property Result: string read GetResult; - - property ViewChanges: Boolean read FViewChanges write FViewChanges; - property CaptureCount: Integer read FCaptureCount write FCaptureCount; - property Captures[Index: Integer]: string read GetCapture write SetCapture; - property CaptureRanges[Index: Integer]: TJclCaptureRange read GetCaptureRange; - - property NamedCaptures[const Name: string]: string - read GetNamedCapture write SetNamedCapture; - property CaptureNameCount: Integer read GetCaptureNameCount; - property CaptureNames[Index: Integer]: string read GetCaptureName; - function IndexOfName(const Name: string): Integer; virtual; abstract; - function IsNameValid(const Name: string): Boolean; virtual; abstract; - - property ErrorCode: Integer read FErrorCode; - property ErrorMessage: string read FErrorMessage; - property ErrorOffset: Integer read FErrorOffset; - - property OnCallout: TJclRegExCallout read FOnCallout write FOnCallout; - end; - - {$IFDEF PCRE_8} - TJclAnsiRegEx = class(TJclRegExBase) - private - FCode: PPCRE; - FExtra: PPCREExtra; - protected - function CalloutHandler(var CalloutBlock: pcre_callout_block): Integer; - function GetAPIOptions(RunTime, DFA: Boolean): Integer; override; - function GetCapture(Index: Integer): string; override; - function GetCaptureName(Index: Integer): string; override; - function GetCaptureNameCount: Integer; override; - function GetCaptureRange(Index: Integer): TJclCaptureRange; override; - function GetNamedCapture(const Name: string): string; override; - procedure SetNamedCapture(const Name, Value: string); override; - public - destructor Destroy; override; - function Compile(const Pattern: string; Study: Boolean; - UserLocale: Boolean = False; JITCompile: Boolean = False): Boolean; override; - function Match(const Subject: string; StartOffset: Cardinal = 1): Boolean; override; - function IndexOfName(const Name: string): Integer; override; - function IsNameValid(const Name: string): Boolean; override; - end; - - TJclAnsiRegExOption = TJclRegExOption; - TJclAnsiRegExOptions = TJclRegExOptions; - TJclAnsiCaptureRange = TJclCaptureRange; - TJclAnsiRegExCallout = TJclRegExCallout; - {$ENDIF PCRE_8} - - {$IFDEF PCRE_16} - TJclWideRegEx = class(TJclRegExBase) - private - FCode: PPCRE16; - FExtra: PPCRE16Extra; - protected - function CalloutHandler(var CalloutBlock: pcre16_callout_block): Integer; - function GetAPIOptions(RunTime, DFA: Boolean): Integer; override; - function GetCapture(Index: Integer): string; override; - function GetCaptureName(Index: Integer): string; override; - function GetCaptureNameCount: Integer; override; - function GetCaptureRange(Index: Integer): TJclCaptureRange; override; - function GetNamedCapture(const Name: string): string; override; - procedure SetNamedCapture(const Name, Value: string); override; - function SupportsWideChar: Boolean; override; - public - destructor Destroy; override; - function Compile(const Pattern: string; Study: Boolean; - UserLocale: Boolean = False; JITCompile: Boolean = False): Boolean; override; - function Match(const Subject: string; StartOffset: Cardinal = 1): Boolean; override; - function IndexOfName(const Name: string): Integer; override; - function IsNameValid(const Name: string): Boolean; override; - end; - - TJclWideRegExOption = TJclRegExOption; - TJclWideRegExOptions = TJclRegExOptions; - TJclWideCaptureRange = TJclCaptureRange; - TJclWideRegExCallout = TJclRegExCallout; - {$ENDIF PCRE_16} - - {$IFDEF JCL_PCRE_8} - TJclRegEx = TJclAnsiRegEx; - {$ENDIF JCL_PCRE_8} - {$IFDEF JCL_PCRE_16} - TJclRegEx = TJclWideRegEx; - {$ENDIF JCL_PCRE_16} - -{$IFDEF PCRE_8} -procedure InitializeLocaleSupport; -procedure TerminateLocaleSupport; -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} -procedure InitializeLocaleSupport16; -procedure TerminateLocaleSupport16; -{$ENDIF PCRE_16} - -{$IFDEF JCL_PCRE} -// Args is an array of pairs (CaptureIndex, Value) or (CaptureName, Value). -// For example: NewIp := StrReplaceRegEx(DirIP, '(\d+)\.(\d+)\.(\d+)\.(\d+)', [3, '128', 4, '254']); -function StrReplaceRegEx(const Subject, Pattern: string; Args: array of const): string; -{$ENDIF JCL_PCRE} - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\common'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -uses - {$IFDEF HAS_UNITSCOPE} - System.SysConst, - {$ELSE ~HAS_UNITSCOPE} - SysConst, - {$ENDIF ~HAS_UNITSCOPE} - JclResources; - -function EncodeAnsiString(const S: string; ToUTF8: Boolean): AnsiString; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -begin - if ToUTF8 then - Result := StringToUTF8(S) - else - Result := AnsiString(S); -end; - -function EncodeWideString(const S: string; ToUTF16: Boolean): WideString; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -begin - if ToUTF16 then - Result := StringToUTF16(S) - else - Result := WideString(S); -end; - -function DecodeAnsiString(const S: AnsiString; IsUTF8: Boolean): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -begin - if IsUTF8 then - Result := UTF8ToString(S) - else - Result := string(S); -end; - -function DecodeWideString(const S: WideString; IsUTF16: Boolean): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -begin - if IsUTF16 then - Result := UTF16ToString(S) - else - Result := string(S); -end; - -function TranslateAnsiIndex(const S: string; ToUTF8: Boolean; Index: SizeInt): SizeInt; -var - UTF8Buffer: TUTF8String; - UTF8Pos, StrPos, StrLen: SizeInt; - Ch: UCS4; -begin - if ToUTF8 then - begin - SetLength(UTF8Buffer, 6); - StrPos := 1; - StrLen := Length(S); - while (StrPos > 0) and (StrPos <= StrLen) and (Index > 1) do - begin - UTF8Pos := 1; - Ch := StringGetNextChar(S, StrPos); - if (StrPos > 0) and UTF8SetNextChar(UTF8Buffer, UTF8Pos, Ch) and (UTF8Pos > 0) then - Dec(Index, UTF8Pos - 1); - end; - if StrPos <= 0 then - raise EJclUnexpectedEOSequenceError.Create - else - if StrPos > StrLen then - Result := StrLen + 1 - else - Result := StrPos; - end - else - Result := Index; -end; - -function TranslateWideIndex(const S: string; ToUTF16: Boolean; Index: SizeInt): SizeInt; -var - UTF16Buffer: TUTF16String; - UTF16Pos, StrPos, StrLen: SizeInt; - Ch: UCS4; -begin - if ToUTF16 then - begin - SetLength(UTF16Buffer, 2); - StrPos := 1; - StrLen := Length(S); - while (StrPos > 0) and (StrPos <= StrLen) and (Index > 1) do - begin - UTF16Pos := 1; - Ch := StringGetNextChar(S, StrPos); - if (StrPos > 0) and UTF16SetNextChar(UTF16Buffer, UTF16Pos, Ch) and (UTF16Pos > 0) then - Dec(Index, UTF16Pos - 1); - end; - if StrPos <= 0 then - raise EJclUnexpectedEOSequenceError.Create - else - if StrPos > StrLen then - Result := StrLen + 1 - else - Result := StrPos; - end - else - Result := Index; -end; - -{$IFDEF JCL_PCRE} -var - {$IFDEF PCRE_8} - GTables: PAnsiChar; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - GTables16: PAnsiChar; - {$ENDIF PCRE_16} -{$ENDIF JCL_PCRE} - -{$IFDEF RTL230_UP} - {$IFDEF PCRE_RTL} - {$DEFINE PCRE_EXPORT_CDECL} - {$ENDIF PCRE_RTL} -{$ENDIF RTL230_UP} - -type - {$IFDEF PCRE_RTL} - {$IFDEF BDS10_UP} - TPCREGetMemInteger = NativeUInt; - {$ELSE ~BDS10_UP} - TPCREGetMemInteger = Integer; - {$ENDIF ~BDS10_UP} - {$ELSE ~PCRE_RTL} - TPCREGetMemInteger = SizeInt; - {$ENDIF ~PCRE_RTL} - -function JclPCREGetMem(Size: TPCREGetMemInteger): Pointer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -begin - GetMem(Result, Size); -end; - -function JclPCRE16GetMem(Size: SizeInt): Pointer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -begin - GetMem(Result, Size); -end; - -procedure JclPCREFreeMem(P: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -begin - FreeMem(P); -end; - -procedure JclPCRE16FreeMem(P: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -begin - FreeMem(P); -end; - -{$IFDEF PCRE_8} -function JclPCRECallout(var callout_block: pcre_callout_block): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -begin - Result := TJclAnsiRegEx(callout_block.callout_data).CalloutHandler(callout_block); -end; -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} -function JclPCRE16Callout(var callout_block: pcre16_callout_block): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -begin - Result := TJclWideRegEx(callout_block.callout_data).CalloutHandler(callout_block); -end; -{$ENDIF PCRE_16} - -function PCRECheck(Value: Integer; Wide: Boolean): Boolean; -var - PErr: PResStringRec; -begin - Result := Value >= 0; - if Result then Exit; - - case Value of - PCRE_ERROR_NOMATCH: - PErr := @RsErrNoMatch; - PCRE_ERROR_NULL: - PErr := @RsErrNull; - PCRE_ERROR_BADOPTION: - PErr := @RsErrBadOption; - PCRE_ERROR_BADMAGIC: - PErr := @RsErrBadMagic; - PCRE_ERROR_UNKNOWN_NODE: - PErr := @RsErrUnknownNode; - PCRE_ERROR_NOMEMORY: - PErr := @RsErrNoMemory; - PCRE_ERROR_NOSUBSTRING: - PErr := @RsErrNoSubString; - PCRE_ERROR_MATCHLIMIT: - PErr := @RsErrMatchLimit; - PCRE_ERROR_CALLOUT: - PErr := @RsErrCallout; - PCRE_ERROR_BADUTF8: - if Wide then - PErr := @RsErrBadUTF16 - else - PErr := @RsErrBadUTF8; - PCRE_ERROR_BADUTF8_OFFSET: - if Wide then - PErr := @RsErrBadUTF16Offset - else - PErr := @RsErrBadUTF8Offset; - PCRE_ERROR_PARTIAL: - PErr := @RsErrPartial; - PCRE_ERROR_BADPARTIAL: - PErr := @RsErrBadPartial; - PCRE_ERROR_INTERNAL: - PErr := @RsErrInternal; - PCRE_ERROR_BADCOUNT: - PErr := @RsErrBadCount; - PCRE_ERROR_DFA_UITEM: - PErr := @RsErrDfaUItem; - PCRE_ERROR_DFA_UCOND: - PErr := @RsErrDfaUCond; - PCRE_ERROR_DFA_UMLIMIT: - PErr := @RsErrDfaUMLimit; - PCRE_ERROR_DFA_WSSIZE: - PErr := @RsErrDfaWSSize; - PCRE_ERROR_DFA_RECURSE: - PErr := @RsErrDfaRecurse; - PCRE_ERROR_RECURSIONLIMIT: - PErr := @RsErrRecursionLimit; - PCRE_ERROR_NULLWSLIMIT: - PErr := @RsErrNullWsLimit; - PCRE_ERROR_BADNEWLINE: - PErr := @RsErrBadNewLine; - {$IFNDEF PCRE_RTL} - PCRE_ERROR_BADOFFSET: - PErr := @RsErrBadOffset; - PCRE_ERROR_SHORTUTF8: - if Wide then - PErr := @RsErrShortUTF16 - else - PErr := @RsErrShortUTF8; - PCRE_ERROR_RECURSELOOP: - PErr := @RsErrRecurseLoop; - PCRE_ERROR_JITSTACKLIMIT: - PErr := @RsErrJITStackLimit; - PCRE_ERROR_BADMODE: - PErr := @RsErrBadMode; - PCRE_ERROR_BADENDIANNESS: - PErr := @RsErrBadEndianness; - PCRE_ERROR_DFA_BADRESTART: - PErr := @RsErrBadRestart; - {$ENDIF ~PCRE_RTL} - JCL_PCRE_ERROR_STUDYFAILED: - PErr := @RsErrStudyFailed; - JCL_PCRE_ERROR_CALLOUTERROR: - PErr := @RsErrCalloutError; - JCL_PCRE_ERROR_NOUTF8: - if Wide then - PErr := @RsErrNoUTF16Support - else - PErr := @RsErrNoUTF8Support; - JCL_PCRE_ERROR_NOJIT: - PErr := @RsErrNoJITSupport; - else - PErr := @RsErrUnknownError; - end; - - raise EPCREError.CreateRes(PErr, Value); -end; - -//=== { TJclRegEx } =========================================================== - -destructor TJclRegExBase.Destroy; -begin - if Assigned(FVector) then - FreeMem(FVector); - if Assigned(FChangedCaptures) then - FChangedCaptures.Free; - - inherited Destroy; -end; - -function TJclRegExBase.GetAPIOptions(RunTime, DFA: Boolean): Integer; -const - {$IFDEF PCRE_RTL} - PCRE_PARTIAL_HARD = $08000000; - PCRE_NOTEMPTY_ATSTART = $10000000; - PCRE_UCP = $20000000; - {$ENDIF PCRE_RTL} - { roIgnoreCase, roMultiLine, roDotAll, roExtended, - roAnchored, roDollarEndOnly, roExtra, roNotBOL, roNotEOL, roUnGreedy, - roNotEmpty, roUTF8, roNoAutoCapture, roNoUTF8Check, roAutoCallout, - roPartial, roDfaShortest, roDfaRestart, roFirstLine, roDupNames, - roNewLineCR, roNewLineLF, roNewLineCRLF, roNewLineAny, roBSRAnyCRLF, - roBSRUnicode, roJavascriptCompat, roNoStartOptimize, roPartialHard, - roNotEmptyAtStart, roUCP } - cDesignOptions: array [TJclRegExOption] of Integer = - (PCRE_CASELESS, PCRE_MULTILINE, PCRE_DOTALL, PCRE_EXTENDED, PCRE_ANCHORED, - PCRE_DOLLAR_ENDONLY, PCRE_EXTRA, 0, 0, PCRE_UNGREEDY, 0, PCRE_UTF8, - PCRE_NO_AUTO_CAPTURE, PCRE_NO_UTF8_CHECK, PCRE_AUTO_CALLOUT, 0, 0, 0, - PCRE_FIRSTLINE, PCRE_DUPNAMES, PCRE_NEWLINE_CR, PCRE_NEWLINE_LF, - PCRE_NEWLINE_CRLF, PCRE_NEWLINE_ANY, PCRE_BSR_ANYCRLF, PCRE_BSR_UNICODE, - PCRE_JAVASCRIPT_COMPAT, PCRE_NO_START_OPTIMIZE, 0, 0, PCRE_UCP); - cRunOptions: array [TJclRegExOption] of Integer = - (0, 0, 0, 0, PCRE_ANCHORED, 0, 0, PCRE_NOTBOL, PCRE_NOTEOL, - 0, PCRE_NOTEMPTY, 0, 0, PCRE_NO_UTF8_CHECK, 0, PCRE_PARTIAL, 0, 0, - 0, 0, PCRE_NEWLINE_CR, PCRE_NEWLINE_LF, PCRE_NEWLINE_CRLF, - PCRE_NEWLINE_ANY, PCRE_BSR_ANYCRLF, PCRE_BSR_UNICODE, - 0, PCRE_NO_START_OPTIMIZE, PCRE_PARTIAL_HARD, - PCRE_NOTEMPTY_ATSTART, 0); - cDFARunOptions: array [TJclRegExOption] of Integer = - (0, 0, 0, 0, PCRE_ANCHORED, 0, 0, PCRE_NOTBOL, PCRE_NOTEOL, - 0, PCRE_NOTEMPTY, 0, 0, PCRE_NO_UTF8_CHECK, 0, PCRE_PARTIAL, - PCRE_DFA_SHORTEST, PCRE_DFA_RESTART, 0, 0, PCRE_NEWLINE_CR, - PCRE_NEWLINE_LF, PCRE_NEWLINE_CRLF, PCRE_NEWLINE_ANY, PCRE_BSR_ANYCRLF, - PCRE_BSR_UNICODE, 0, PCRE_NO_START_OPTIMIZE, PCRE_PARTIAL_HARD, - PCRE_NOTEMPTY_ATSTART, 0); -var - I: TJclRegExOption; -begin - Result := 0; - if RunTime and DFA then - begin - for I := Low(TJclRegExOption) to High(TJclRegExOption) do - if I in Options then - Result := Result or cDFARunOptions[I]; - end - else - if RunTime then - begin - for I := Low(TJclRegExOption) to High(TJclRegExOption) do - if I in Options then - Result := Result or cRunOptions[I]; - end - else - begin - for I := Low(TJclRegExOption) to High(TJclRegExOption) do - if I in Options then - Result := Result or cDesignOptions[I]; - end; -end; - -function TJclRegExBase.GetResult: string; -var - Index, CaptureIndex: Integer; - Pos: Integer; - Range: TJclCaptureRange; -begin - if Assigned(FChangedCaptures) and (FChangedCaptures.Count > 0) then - begin - Pos := 1; - Result := ''; - for Index := 0 to FChangedCaptures.Count - 1 do - begin - CaptureIndex := SizeInt(FChangedCaptures[Index]); - Range := GetCaptureRange(CaptureIndex); - - Result := Result + - Copy(FSubject, Pos, Range.FirstPos - Pos) + - FResultValues[CaptureIndex]; - - Pos := Range.LastPos + 1; - end; - if Pos <= Length(FSubject) then - Result := Result + Copy(FSubject, Pos, Length(FSubject) - Pos + 1); - end - else - Result := FSubject; -end; - -procedure TJclRegExBase.SetCapture(Index: Integer; const Value: string); -begin - if (Index < 0) or (Index >= FCaptureCount) then - PCRECheck(PCRE_ERROR_NOSUBSTRING, SupportsWideChar) - else - begin - if (not Assigned(FChangedCaptures)) or (FChangedCaptures.Count = 0) then - begin - if not Assigned(FChangedCaptures) then - FChangedCaptures := TList.Create; - - // Always resize to the max length to avoid repeated allocations. - FChangedCaptures.Capacity := FCaptureCount; - SetLength(FResultValues, FCaptureCount); - end; - - if FChangedCaptures.IndexOf(Pointer(SizeInt(Index))) < 0 then - FChangedCaptures.Add(Pointer(SizeInt(Index))); - FResultValues[Index] := Value; - end; -end; - -function TJclRegExBase.SupportsWideChar: Boolean; -begin - Result := False; -end; - -{$IFDEF PCRE_8} -procedure InitializeLocaleSupport; -begin - if not Assigned(GTables) then - GTables := pcre_maketables; -end; - -procedure TerminateLocaleSupport; -begin - if Assigned(GTables) then - begin - CallPCREFree(GTables); - GTables := nil; - end; -end; -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} -procedure InitializeLocaleSupport16; -begin - if not Assigned(GTables16) then - GTables16 := pcre16_maketables; -end; - -procedure TerminateLocaleSupport16; -begin - if Assigned(GTables16) then - begin - CallPCRE16Free(GTables16); - GTables16 := nil; - end; -end; -{$ENDIF PCRE_16} - -{$IFDEF JCL_PCRE} -// TODO: Better/specific error messages, show index when available. -function StrReplaceRegEx(const Subject, Pattern: string; Args: array of const): string; - - function ArgToString(Index: Integer): string; - begin - // TODO: Any other type? - case TVarRec(Args[Index]).VType of - vtPChar: - Result := string(AnsiString(TVarRec(Args[Index]).VPChar)); - vtPWideChar: - Result := string(WideString(TVarRec(Args[Index]).VPWideChar)); - vtString: - Result := string(TVarRec(Args[Index]).VString^); - vtAnsiString: - Result := string(AnsiString(TVarRec(Args[Index]).VAnsiString)); - vtWideString: - Result := string(WideString(TVarRec(Args[Index]).VWideString)); - {$IFDEF SUPPORTS_UNICODE_STRING} - vtUnicodeString: - Result := string(UnicodeString(TVarRec(Args[Index]).VUnicodeString)); - {$ENDIF SUPPORTS_UNICODE_STRING} - vtChar: - Result := string(AnsiString(TVarRec(Args[Index]).VChar)); - vtWideChar: - Result := string(WideString(TVarRec(Args[Index]).VWideChar)); - else - raise EConvertError.Create(SInvalidFormat); - end; - end; - -var - Re: TJclRegExBase; - Index, ArgIndex: Integer; - Value: string; -begin - if Odd(Length(Args)) then - raise EConvertError.Create(SArgumentMissing) - else - begin - Re := TJclRegEx.Create; - try - if Re.Compile(Pattern, False) and Re.Match(Subject) then - begin - for Index := 0 to Length(Args) div 2 - 1 do - begin - ArgIndex := Index * 2; - Value := ArgToString(ArgIndex + 1); - - if TVarRec(Args[ArgIndex]).VType = vtInteger then - Re.Captures[TVarRec(Args[ArgIndex]).VInteger] := Value - else - Re.NamedCaptures[ArgToString(ArgIndex)] := Value; - end; - - Result := Re.Result; - end - else - raise EConvertError.Create(SInvalidFormat); - finally - Re.Free; - end; - end; -end; -{$ENDIF JCL_PCRE} - -//=== { EPCREError } ========================================================= - -constructor EPCREError.CreateRes(ResStringRec: PResStringRec; ErrorCode: Integer); -begin - FErrorCode := ErrorCode; - inherited CreateRes(ResStringRec); -end; - -procedure LibNotLoadedHandler; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -begin - raise EPCREError.CreateRes(@RsErrLibNotLoaded, 0); -end; - -{$IFDEF PCRE_8} - -//=== { TJclAnsiRegEx } ====================================================== - -destructor TJclAnsiRegEx.Destroy; -begin - if Assigned(FCode) then - CallPCREFree(FCode); - if Assigned(FExtra) then - {$IFDEF PCRE_RTL} - CallPCREFree(FExtra); - {$ELSE ~PCRE_RTL} - pcre_free_study(FExtra); - {$ENDIF ~PCRE_RTL} - inherited Destroy; -end; - -function TJclAnsiRegEx.CalloutHandler(var CalloutBlock: pcre_callout_block): Integer; -begin - try - Result := JCL_PCRE_CALLOUT_NOERROR; - if Assigned(FOnCallout) then - begin - with CalloutBlock do - begin - FCaptureCount := capture_top; - FOnCallout(Self, callout_number, start_match + 1, current_position + 1, - capture_last, pattern_position + 1, next_item_length, Result); - end; - end; - except - on E: Exception do - begin - FErrorMessage := E.Message; - Result := JCL_PCRE_ERROR_CALLOUTERROR; - end; - end; -end; - -function TJclAnsiRegEx.Compile(const Pattern: string; Study, UserLocale, JITCompile: Boolean): Boolean; -var - ErrMsgPtr: PAnsiChar; - Tables: PAnsiChar; - StudyOptions: Integer; - {$IFNDEF PCRE_RTL} - ConfigJIT: Integer; - {$ENDIF ~PCRE_RTL} -begin - if UserLocale then - begin - InitializeLocaleSupport; - Tables := GTables; - end - else - Tables := nil; - - FPattern := Pattern; - if FPattern = '' then - PCRECheck(PCRE_ERROR_NULL, SupportsWideChar); - - if Assigned(FCode) then - begin - CallPCREFree(FCode); - FCode := nil; - end; - FCode := pcre_compile2(PAnsiChar(EncodeAnsiString(FPattern, roUTF8 in Options)), GetAPIOptions(False, DfaMode), - @FErrorCode, @ErrMsgPtr, @FErrorOffset, Tables); - Inc(FErrorOffset); - FErrorMessage := string(AnsiString(ErrMsgPtr)); - Result := Assigned(FCode); - if Result then - begin - if Study then - begin - {$IFDEF PCRE_RTL} - if Assigned(FExtra) then - CallPCREFree(FExtra); - if JITCompile then - raise EPCREError.CreateRes(@RsErrNoJITSupport, 0); - StudyOptions := 0; - {$ELSE ~PCRE_RTL} - if Assigned(FExtra) then - pcre_free_study(FExtra); - if JITCompile then - begin - PCRECheck(pcre_config(PCRE_CONFIG_JIT, @ConfigJIT), SupportsWideChar); - if ConfigJIT = 0 then - raise EPCREError.CreateRes(@RsErrNoJITSupport, 0); - StudyOptions := PCRE_STUDY_JIT_COMPILE; - end - else - StudyOptions := 0; - {$ENDIF ~PCRE_RTL} - FExtra := pcre_study(FCode, StudyOptions, @ErrMsgPtr); - Result := Assigned(FExtra) or (not Assigned(ErrMsgPtr)); - if not Result then - begin - FErrorCode := JCL_PCRE_ERROR_STUDYFAILED; - FErrorMessage := string(AnsiString(ErrMsgPtr)); - end; - end; - - if FDfaMode then - FVectorSize := FCaptureCount - else - begin - PCRECheck(pcre_fullinfo(FCode, FExtra, PCRE_INFO_CAPTURECOUNT, @FCaptureCount), SupportsWideChar); - FVectorSize := (FCaptureCount + 1) * 3; - end; - ReAllocMem(FVector, FVectorSize * SizeOf(FVector[0])); - end; -end; - -function TJclAnsiRegEx.GetAPIOptions(RunTime, DFA: Boolean): Integer; -var - ConfigUTF8: Integer; -begin - PCRECheck(pcre_config(PCRE_CONFIG_UTF8, @ConfigUTF8), SupportsWideChar); - if (roUTF8 in Options) and (ConfigUTF8 = 0) then - PCRECheck(JCL_PCRE_ERROR_NOUTF8, SupportsWideChar); - - Result := inherited GetAPIOptions(RunTime, DFA); -end; - -function TJclAnsiRegEx.GetCapture(Index: Integer): string; -var - FromPos, ToPos: SizeInt; -begin - if (Index < 0) or (Index >= FCaptureCount) then - PCRECheck(PCRE_ERROR_NOSUBSTRING, SupportsWideChar) - else - begin - if FViewChanges and (FChangedCaptures.IndexOf(Pointer(SizeInt(Index))) >= 0) then - begin - Result := FResultValues[Index]; - Exit; - end; - - Index := Index * 2; - FromPos := TranslateAnsiIndex(FSubject, roUTF8 in Options, FVector^[Index] + 1); - ToPos := TranslateAnsiIndex(FSubject, roUTF8 in Options, FVector^[Index + 1] + 1) - 1; - Result := Copy(FSubject, FromPos, ToPos - FromPos + 1); - end; -end; - -function TJclAnsiRegEx.GetCaptureNameCount: Integer; -begin - PCRECheck(pcre_fullinfo(FCode, FExtra, PCRE_INFO_NAMECOUNT, @Result), SupportsWideChar); -end; - -function TJclAnsiRegEx.GetCaptureName(Index: Integer): string; -var - NameTable: PAnsiChar; - EntrySize: Integer; -begin - PCRECheck(pcre_fullinfo(FCode, FExtra, PCRE_INFO_NAMETABLE, @NameTable), SupportsWideChar); - PCRECheck(pcre_fullinfo(FCode, FExtra, PCRE_INFO_NAMEENTRYSIZE, @EntrySize), SupportsWideChar); - - NameTable := NameTable + EntrySize * Index + 2; - Result := DecodeAnsiString(AnsiString(NameTable), roUTF8 in Options); -end; - -function TJclAnsiRegEx.GetCaptureRange(Index: Integer): TJclCaptureRange; -begin - if (Index < 0) or (Index >= FCaptureCount) then - PCRECheck(PCRE_ERROR_NOSUBSTRING, SupportsWideChar) - else - begin - Index := Index * 2; - Result.FirstPos := TranslateAnsiIndex(FSubject, roUTF8 in Options, FVector^[Index] + 1); - Result.LastPos := TranslateAnsiIndex(FSubject, roUTF8 in Options, FVector^[Index + 1] + 1) - 1; - end; -end; - -function TJclAnsiRegEx.GetNamedCapture(const Name: string): string; -var - Index: Integer; -begin - Index := pcre_get_stringnumber(FCode, PAnsiChar(EncodeAnsiString(Name, roUTF8 in Options))); - PCRECheck(Index, SupportsWideChar); - - Result := GetCapture(Index); -end; - -function TJclAnsiRegEx.IndexOfName(const Name: string): Integer; -begin - Result := pcre_get_stringnumber(FCode, PAnsiChar(EncodeAnsiString(Name, roUTF8 in Options))); -end; - -function TJclAnsiRegEx.IsNameValid(const Name: string): Boolean; -begin - Result := pcre_get_stringnumber(FCode, PAnsiChar(EncodeAnsiString(Name, roUTF8 in Options))) >= 0; -end; - -function TJclAnsiRegEx.Match(const Subject: string; StartOffset: Cardinal): Boolean; -var - LocalExtra: real_pcre_extra; - Extra: Pointer; - WorkSpace: array [0 .. 19] of Integer; - ExecRslt: Integer; - EncodedSubject: AnsiString; -begin - if Assigned(FOnCallout) then - begin - if Assigned(FExtra) then - begin - LocalExtra.flags := PCRE_EXTRA_STUDY_DATA or PCRE_EXTRA_CALLOUT_DATA; - LocalExtra.study_data := FExtra; - end - else - LocalExtra.flags := PCRE_EXTRA_CALLOUT_DATA; - LocalExtra.callout_data := Self; - Extra := @LocalExtra; - SetPCRECalloutCallback(JclPCRECallout); - end - else - begin - Extra := FExtra; - SetPCRECalloutCallback(nil); - end; - - FSubject := Subject; - if Assigned(FChangedCaptures) then - FChangedCaptures.Clear; - EncodedSubject := EncodeAnsiString(FSubject, roUTF8 in Options); - - // convert index - if roUTF8 in Options then - StartOffset := Length(EncodeAnsiString(Copy(FSubject, 1, StartOffset - 1), True)) + 1; - - if FDfaMode then - begin - ExecRslt := pcre_dfa_exec(FCode, Extra, PAnsiChar(EncodedSubject), Length(EncodedSubject), - StartOffset - 1, GetAPIOptions(True, DfaMode), PInteger(FVector), FVectorSize, @Workspace, 20); - end - else - begin - ExecRslt := pcre_exec(FCode, Extra, PAnsiChar(EncodedSubject), Length(EncodedSubject), - StartOffset - 1, GetAPIOptions(True, DfaMode), PInteger(FVector), FVectorSize); - end; - Result := ExecRslt >= 0; - if Result then - begin - FCaptureCount := ExecRslt; - FErrorCode := 0; - end - else - begin - FErrorCode := ExecRslt; - if FErrorCode <> PCRE_ERROR_NOMATCH then - PCRECheck(FErrorCode, SupportsWideChar); - end; -end; - -procedure TJclAnsiRegEx.SetNamedCapture(const Name, Value: string); -var - Index: Integer; -begin - Index := pcre_get_stringnumber(FCode, PAnsiChar(EncodeAnsiString(Name, roUTF8 in Options))); - PCRECheck(Index, SupportsWideChar); - - SetCapture(Index, Value); -end; - -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} - -//=== { TJclWideRegEx } ====================================================== - -destructor TJclWideRegEx.Destroy; -begin - if Assigned(FCode) then - CallPCRE16Free(FCode); - if Assigned(FExtra) then - {$IFDEF PCRE_RTL} - CallPCRE16Free(FExtra); - {$ELSE ~PCRE_RTL} - pcre16_free_study(FExtra); - {$ENDIF ~PCRE_RTL} - inherited Destroy; -end; - -function TJclWideRegEx.CalloutHandler(var CalloutBlock: pcre16_callout_block): Integer; -begin - try - Result := JCL_PCRE_CALLOUT_NOERROR; - if Assigned(FOnCallout) then - begin - with CalloutBlock do - begin - FCaptureCount := capture_top; - FOnCallout(Self, callout_number, start_match + 1, current_position + 1, - capture_last, pattern_position + 1, next_item_length, Result); - end; - end; - except - on E: Exception do - begin - FErrorMessage := E.Message; - Result := JCL_PCRE_ERROR_CALLOUTERROR; - end; - end; -end; - -function TJclWideRegEx.Compile(const Pattern: string; Study, UserLocale, JITCompile: Boolean): Boolean; -var - ErrMsgPtr: PAnsiChar; - Tables: PAnsiChar; - StudyOptions: Integer; - {$IFNDEF PCRE_RTL} - ConfigJIT: Integer; - {$ENDIF ~PCRE_RTL} -begin - if UserLocale then - begin - InitializeLocaleSupport16; - Tables := GTables16; - end - else - Tables := nil; - - FPattern := Pattern; - if FPattern = '' then - PCRECheck(PCRE_ERROR_NULL, SupportsWideChar); - - if Assigned(FCode) then - begin - CallPCRE16Free(FCode); - FCode := nil; - end; - FCode := pcre16_compile2(PWideChar(EncodeWideString(FPattern, roUTF16 in Options)), GetAPIOptions(False, DfaMode), - @FErrorCode, @ErrMsgPtr, @FErrorOffset, Tables); - Inc(FErrorOffset); - FErrorMessage := string(AnsiString(ErrMsgPtr)); - Result := Assigned(FCode); - if Result then - begin - if Study then - begin - {$IFDEF PCRE_RTL} - if Assigned(FExtra) then - CallPCRE16Free(FExtra); - if JITCompile then - raise EPCREError.CreateRes(@RsErrNoJITSupport, 0); - StudyOptions := 0; - {$ELSE ~PCRE_RTL} - if Assigned(FExtra) then - pcre16_free_study(FExtra); - if JITCompile then - begin - PCRECheck(pcre16_config(PCRE_CONFIG_JIT, @ConfigJIT), SupportsWideChar); - if ConfigJIT = 0 then - raise EPCREError.CreateRes(@RsErrNoJITSupport, 0); - StudyOptions := PCRE_STUDY_JIT_COMPILE; - end - else - StudyOptions := 0; - {$ENDIF ~PCRE_RTL} - FExtra := pcre16_study(FCode, StudyOptions, @ErrMsgPtr); - Result := Assigned(FExtra) or (not Assigned(ErrMsgPtr)); - if not Result then - begin - FErrorCode := JCL_PCRE_ERROR_STUDYFAILED; - FErrorMessage := string(AnsiString(ErrMsgPtr)); - end; - end; - - if FDfaMode then - FVectorSize := FCaptureCount - else - begin - PCRECheck(pcre16_fullinfo(FCode, FExtra, PCRE_INFO_CAPTURECOUNT, @FCaptureCount), SupportsWideChar); - FVectorSize := (FCaptureCount + 1) * 3; - end; - ReAllocMem(FVector, FVectorSize * SizeOf(FVector[0])); - end; -end; - -function TJclWideRegEx.GetAPIOptions(RunTime, DFA: Boolean): Integer; -var - ConfigUTF16: Integer; -begin - PCRECheck(pcre16_config(PCRE_CONFIG_UTF16, @ConfigUTF16), SupportsWideChar); - if (roUTF16 in Options) and (ConfigUTF16 = 0) then - PCRECheck(JCL_PCRE_ERROR_NOUTF16, SupportsWideChar); - - Result := inherited GetAPIOptions(RunTime, DFA); -end; - -function TJclWideRegEx.GetCapture(Index: Integer): string; -var - FromPos, ToPos: SizeInt; -begin - if (Index < 0) or (Index >= FCaptureCount) then - PCRECheck(PCRE_ERROR_NOSUBSTRING, SupportsWideChar) - else - begin - if FViewChanges and (FChangedCaptures.IndexOf(Pointer(SizeInt(Index))) >= 0) then - begin - Result := FResultValues[Index]; - Exit; - end; - - Index := Index * 2; - FromPos := TranslateWideIndex(FSubject, roUTF16 in Options, FVector^[Index] + 1); - ToPos := TranslateWideIndex(FSubject, roUTF16 in Options, FVector^[Index + 1] + 1) - 1; - Result := Copy(FSubject, FromPos, ToPos - FromPos + 1); - end; -end; - -function TJclWideRegEx.GetCaptureName(Index: Integer): string; -var - NameTable: PWideChar; - EntrySize: Integer; -begin - PCRECheck(pcre16_fullinfo(FCode, FExtra, PCRE_INFO_NAMETABLE, @NameTable), SupportsWideChar); - PCRECheck(pcre16_fullinfo(FCode, FExtra, PCRE_INFO_NAMEENTRYSIZE, @EntrySize), SupportsWideChar); - - NameTable := NameTable + EntrySize * Index + 1; - Result := DecodeWideString(WideString(NameTable), roUTF16 in Options); -end; - -function TJclWideRegEx.GetCaptureNameCount: Integer; -begin - PCRECheck(pcre16_fullinfo(FCode, FExtra, PCRE_INFO_NAMECOUNT, @Result), SupportsWideChar); -end; - -function TJclWideRegEx.GetCaptureRange(Index: Integer): TJclCaptureRange; -begin - if (Index < 0) or (Index >= FCaptureCount) then - PCRECheck(PCRE_ERROR_NOSUBSTRING, SupportsWideChar) - else - begin - Index := Index * 2; - Result.FirstPos := TranslateWideIndex(FSubject, roUTF16 in Options, FVector^[Index] + 1); - Result.LastPos := TranslateWideIndex(FSubject, roUTF16 in Options, FVector^[Index + 1] + 1) - 1; - end; -end; - -function TJclWideRegEx.GetNamedCapture(const Name: string): string; -var - Index: Integer; -begin - Index := pcre16_get_stringnumber(FCode, PWideChar(EncodeWideString(Name, roUTF16 in Options))); - PCRECheck(Index, SupportsWideChar); - - Result := GetCapture(Index); -end; - -function TJclWideRegEx.IndexOfName(const Name: string): Integer; -begin - Result := pcre16_get_stringnumber(FCode, PWideChar(EncodeWideString(Name, roUTF16 in Options))); -end; - -function TJclWideRegEx.IsNameValid(const Name: string): Boolean; -begin - Result := pcre16_get_stringnumber(FCode, PWideChar(EncodeWideString(Name, roUTF16 in Options))) >= 0; -end; - -function TJclWideRegEx.Match(const Subject: string; StartOffset: Cardinal): Boolean; -var - LocalExtra: real_pcre16_extra; - Extra: Pointer; - WorkSpace: array [0 .. 19] of Integer; - ExecRslt: Integer; - EncodedSubject: WideString; -begin - if Assigned(FOnCallout) then - begin - if Assigned(FExtra) then - begin - LocalExtra.flags := PCRE_EXTRA_STUDY_DATA or PCRE_EXTRA_CALLOUT_DATA; - LocalExtra.study_data := FExtra; - end - else - LocalExtra.flags := PCRE_EXTRA_CALLOUT_DATA; - LocalExtra.callout_data := Self; - Extra := @LocalExtra; - SetPCRE16CalloutCallback(JclPCRE16Callout); - end - else - begin - Extra := FExtra; - SetPCRE16CalloutCallback(nil); - end; - - FSubject := Subject; - if Assigned(FChangedCaptures) then - FChangedCaptures.Clear; - EncodedSubject := EncodeWideString(FSubject, roUTF16 in Options); - - // convert index - if roUTF16 in Options then - StartOffset := Length(EncodeWideString(Copy(FSubject, 1, StartOffset - 1), True)) + 1; - - if FDfaMode then - begin - ExecRslt := pcre16_dfa_exec(FCode, Extra, PWideChar(EncodedSubject), Length(EncodedSubject), - StartOffset - 1, GetAPIOptions(True, DfaMode), PInteger(FVector), FVectorSize, @Workspace, 20); - end - else - begin - ExecRslt := pcre16_exec(FCode, Extra, PWideChar(EncodedSubject), Length(EncodedSubject), - StartOffset - 1, GetAPIOptions(True, DfaMode), PInteger(FVector), FVectorSize); - end; - Result := ExecRslt >= 0; - if Result then - begin - FCaptureCount := ExecRslt; - FErrorCode := 0; - end - else - begin - FErrorCode := ExecRslt; - if FErrorCode <> PCRE_ERROR_NOMATCH then - PCRECheck(FErrorCode, SupportsWideChar); - end; -end; - -procedure TJclWideRegEx.SetNamedCapture(const Name, Value: string); -var - Index: Integer; -begin - Index := pcre16_get_stringnumber(FCode, PWideChar(EncodeWideString(Name, roUTF16 in Options))); - PCRECheck(Index, SupportsWideChar); - - SetCapture(Index, Value); -end; - -function TJclWideRegEx.SupportsWideChar: Boolean; -begin - Result := True; -end; -{$ENDIF PCRE_16} - -initialization - {$IFNDEF PCRE_RTL} - pcre.LibNotLoadedHandler := LibNotLoadedHandler; - {$ENDIF ~PCRE_RTL} - if LoadPCRE then - begin - {$IFDEF PCRE_8} - SetPCREMallocCallback(JclPCREGetMem); - SetPCREFreeCallback(JclPCREFreeMem); - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - SetPCRE16MallocCallback(JclPCRE16GetMem); - SetPCRE16FreeCallback(JclPCRE16FreeMem); - {$ENDIF PCRE_16} - end; - {$IFDEF UNITVERSIONING} - RegisterUnitVersion(HInstance, UnitVersioning); - {$ENDIF UNITVERSIONING} - -finalization - {$IFDEF PCRE_8} - TerminateLocaleSupport; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - TerminateLocaleSupport16; - {$ENDIF PCRE_16} - {$IFDEF UNITVERSIONING} - UnregisterUnitVersion(HInstance); - {$ENDIF UNITVERSIONING} - UnloadPCRE; - -end. - +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclPCRE.pas. } +{ } +{ The Initial Developer of the Original Code is Peter Thornqvist. } +{ Portions created by Peter Thornqvist are Copyright (C) of Peter Thornqvist. All rights reserved. } +{ } +{ Contributor(s): } +{ Robert Rossmair (rrossmair) } +{ Mario R. Carro } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ Class wrapper for PCRE (PERL Compatible Regular Expression) } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclPCRE; + +{$I jcl.inc} + +{$RANGECHECKS OFF} + +interface + +uses + pcre, + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + {$IFDEF HAS_UNITSCOPE} + System.Classes, System.SysUtils, + {$IFDEF PCRE_RTL} + System.RegularExpressionsAPI, + {$ENDIF PCRE_RTL} + {$ELSE ~HAS_UNITSCOPE} + Classes, SysUtils, + {$IFDEF PCRE_RTL} + RegularExpressionsAPI, + {$ENDIF PCRE_RTL} + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclStringConversions; + +const + JCL_PCRE_CALLOUT_NOERROR = 0; + JCL_PCRE_CALLOUT_FAILCONTINUE = 1; + + JCL_PCRE_ERROR_NOJIT = -996; + JCL_PCRE_ERROR_NOUTF8 = -997; + JCL_PCRE_ERROR_NOUTF16 = -997; + JCL_PCRE_ERROR_CALLOUTERROR = -998; + JCL_PCRE_ERROR_STUDYFAILED = -999; + +type + EPCREError = class(EJclError) + private + FErrorCode: Integer; + public + constructor CreateRes(ResStringRec: PResStringRec; ErrorCode: Integer); + property ErrorCode: Integer read FErrorCode; + end; + + TPCREIntArray = array [0 .. 0] of Integer; + PPCREIntArray = ^TPCREIntArray; + + TJclRegExOption = (roIgnoreCase, roMultiLine, roDotAll, roExtended, + roAnchored, roDollarEndOnly, roExtra, roNotBOL, roNotEOL, roUnGreedy, + roNotEmpty, roUTF8, roNoAutoCapture, roNoUTF8Check, roAutoCallout, + roPartial, roDfaShortest, roDfaRestart, roFirstLine, roDupNames, + roNewLineCR, roNewLineLF, roNewLineCRLF, roNewLineAny, roBSRAnyCRLF, + roBSRUnicode, roJavascriptCompat, roNoStartOptimize, roPartialHard, + roNotEmptyAtStart, roUCP); + TJclRegExOptions = set of TJclRegExOption; + +const + roUTF16 = roUTF8; + roNoUTF16Check = roNoUTF8Check; + +type + TJclRegExBase = class; + + TJclCaptureRange = record + FirstPos: Integer; + LastPos: Integer; + end; + + TJclRegExCallout = procedure (Sender: TJclRegExBase; + Index, MatchStart, SubjectPos, LastCapture, PatternPos, NextItemLength: Integer; + var ErrorCode: Integer) of object; + TPCRECalloutIndex = 0 .. 255; + + TJclRegExBase = class(TObject) + private + FOptions: TJclRegExOptions; + FPattern: string; + FDfaMode: Boolean; + FSubject: string; + + FViewChanges: Boolean; + FChangedCaptures: TList; + FResultValues: array of string; + + FErrorCode: Integer; + FErrorMessage: string; + FErrorOffset: Integer; + + FVector: PPCREIntArray; + FVectorSize: Integer; + FCaptureCount: Integer; + + FOnCallout: TJclRegExCallout; + + protected + function GetResult: string; virtual; + function GetCapture(Index: Integer): string; virtual; abstract; + procedure SetCapture(Index: Integer; const Value: string); virtual; + function GetCaptureRange(Index: Integer): TJclCaptureRange; virtual; abstract; + function GetNamedCapture(const Name: string): string; virtual; abstract; + procedure SetNamedCapture(const Name, Value: string); virtual; abstract; + function GetCaptureNameCount: Integer; virtual; abstract; + function GetCaptureName(Index: Integer): string; virtual; abstract; + function GetAPIOptions(RunTime, DFA: Boolean): Integer; virtual; + + function SupportsWideChar: Boolean; virtual; + public + destructor Destroy; override; + + property Options: TJclRegExOptions read FOptions write FOptions; + function Compile(const Pattern: string; Study: Boolean; + UserLocale: Boolean = False; JITCompile: Boolean = False): Boolean; virtual; abstract; + property Pattern: string read FPattern; + property DfaMode: Boolean read FDfaMode write FDfaMode; + function Match(const Subject: string; StartOffset: Cardinal = 1): Boolean; virtual; abstract; + property Subject: string read FSubject; + property Result: string read GetResult; + + property ViewChanges: Boolean read FViewChanges write FViewChanges; + property CaptureCount: Integer read FCaptureCount write FCaptureCount; + property Captures[Index: Integer]: string read GetCapture write SetCapture; + property CaptureRanges[Index: Integer]: TJclCaptureRange read GetCaptureRange; + + property NamedCaptures[const Name: string]: string + read GetNamedCapture write SetNamedCapture; + property CaptureNameCount: Integer read GetCaptureNameCount; + property CaptureNames[Index: Integer]: string read GetCaptureName; + function IndexOfName(const Name: string): Integer; virtual; abstract; + function IsNameValid(const Name: string): Boolean; virtual; abstract; + + property ErrorCode: Integer read FErrorCode; + property ErrorMessage: string read FErrorMessage; + property ErrorOffset: Integer read FErrorOffset; + + property OnCallout: TJclRegExCallout read FOnCallout write FOnCallout; + end; + + {$IFDEF PCRE_8} + TJclAnsiRegEx = class(TJclRegExBase) + private + FCode: PPCRE; + FExtra: PPCREExtra; + protected + function CalloutHandler(var CalloutBlock: pcre_callout_block): Integer; + function GetAPIOptions(RunTime, DFA: Boolean): Integer; override; + function GetCapture(Index: Integer): string; override; + function GetCaptureName(Index: Integer): string; override; + function GetCaptureNameCount: Integer; override; + function GetCaptureRange(Index: Integer): TJclCaptureRange; override; + function GetNamedCapture(const Name: string): string; override; + procedure SetNamedCapture(const Name, Value: string); override; + public + destructor Destroy; override; + function Compile(const Pattern: string; Study: Boolean; + UserLocale: Boolean = False; JITCompile: Boolean = False): Boolean; override; + function Match(const Subject: string; StartOffset: Cardinal = 1): Boolean; override; + function IndexOfName(const Name: string): Integer; override; + function IsNameValid(const Name: string): Boolean; override; + end; + + TJclAnsiRegExOption = TJclRegExOption; + TJclAnsiRegExOptions = TJclRegExOptions; + TJclAnsiCaptureRange = TJclCaptureRange; + TJclAnsiRegExCallout = TJclRegExCallout; + {$ENDIF PCRE_8} + + {$IFDEF PCRE_16} + TJclWideRegEx = class(TJclRegExBase) + private + FCode: PPCRE16; + FExtra: PPCRE16Extra; + protected + function CalloutHandler(var CalloutBlock: pcre16_callout_block): Integer; + function GetAPIOptions(RunTime, DFA: Boolean): Integer; override; + function GetCapture(Index: Integer): string; override; + function GetCaptureName(Index: Integer): string; override; + function GetCaptureNameCount: Integer; override; + function GetCaptureRange(Index: Integer): TJclCaptureRange; override; + function GetNamedCapture(const Name: string): string; override; + procedure SetNamedCapture(const Name, Value: string); override; + function SupportsWideChar: Boolean; override; + public + destructor Destroy; override; + function Compile(const Pattern: string; Study: Boolean; + UserLocale: Boolean = False; JITCompile: Boolean = False): Boolean; override; + function Match(const Subject: string; StartOffset: Cardinal = 1): Boolean; override; + function IndexOfName(const Name: string): Integer; override; + function IsNameValid(const Name: string): Boolean; override; + end; + + TJclWideRegExOption = TJclRegExOption; + TJclWideRegExOptions = TJclRegExOptions; + TJclWideCaptureRange = TJclCaptureRange; + TJclWideRegExCallout = TJclRegExCallout; + {$ENDIF PCRE_16} + + {$IFDEF JCL_PCRE_8} + TJclRegEx = TJclAnsiRegEx; + {$ENDIF JCL_PCRE_8} + {$IFDEF JCL_PCRE_16} + TJclRegEx = TJclWideRegEx; + {$ENDIF JCL_PCRE_16} + +{$IFDEF PCRE_8} +procedure InitializeLocaleSupport; +procedure TerminateLocaleSupport; +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} +procedure InitializeLocaleSupport16; +procedure TerminateLocaleSupport16; +{$ENDIF PCRE_16} + +{$IFDEF JCL_PCRE} +// Args is an array of pairs (CaptureIndex, Value) or (CaptureName, Value). +// For example: NewIp := StrReplaceRegEx(DirIP, '(\d+)\.(\d+)\.(\d+)\.(\d+)', [3, '128', 4, '254']); +function StrReplaceRegEx(const Subject, Pattern: string; Args: array of const): string; +{$ENDIF JCL_PCRE} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysConst, + {$ELSE ~HAS_UNITSCOPE} + SysConst, + {$ENDIF ~HAS_UNITSCOPE} + JclResources; + +function EncodeAnsiString(const S: string; ToUTF8: Boolean): AnsiString; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +begin + if ToUTF8 then + Result := StringToUTF8(S) + else + Result := AnsiString(S); +end; + +function EncodeWideString(const S: string; ToUTF16: Boolean): WideString; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +begin + if ToUTF16 then + Result := StringToUTF16(S) + else + Result := WideString(S); +end; + +function DecodeAnsiString(const S: AnsiString; IsUTF8: Boolean): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +begin + if IsUTF8 then + Result := UTF8ToString(S) + else + Result := string(S); +end; + +function DecodeWideString(const S: WideString; IsUTF16: Boolean): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +begin + if IsUTF16 then + Result := UTF16ToString(S) + else + Result := string(S); +end; + +function TranslateAnsiIndex(const S: string; ToUTF8: Boolean; Index: SizeInt): SizeInt; +var + UTF8Buffer: TUTF8String; + UTF8Pos, StrPos, StrLen: SizeInt; + Ch: UCS4; +begin + if ToUTF8 then + begin + SetLength(UTF8Buffer, 6); + StrPos := 1; + StrLen := Length(S); + while (StrPos > 0) and (StrPos <= StrLen) and (Index > 1) do + begin + UTF8Pos := 1; + Ch := StringGetNextChar(S, StrPos); + if (StrPos > 0) and UTF8SetNextChar(UTF8Buffer, UTF8Pos, Ch) and (UTF8Pos > 0) then + Dec(Index, UTF8Pos - 1); + end; + if StrPos <= 0 then + raise EJclUnexpectedEOSequenceError.Create + else + if StrPos > StrLen then + Result := StrLen + 1 + else + Result := StrPos; + end + else + Result := Index; +end; + +function TranslateWideIndex(const S: string; ToUTF16: Boolean; Index: SizeInt): SizeInt; +var + UTF16Buffer: TUTF16String; + UTF16Pos, StrPos, StrLen: SizeInt; + Ch: UCS4; +begin + if ToUTF16 then + begin + SetLength(UTF16Buffer, 2); + StrPos := 1; + StrLen := Length(S); + while (StrPos > 0) and (StrPos <= StrLen) and (Index > 1) do + begin + UTF16Pos := 1; + Ch := StringGetNextChar(S, StrPos); + if (StrPos > 0) and UTF16SetNextChar(UTF16Buffer, UTF16Pos, Ch) and (UTF16Pos > 0) then + Dec(Index, UTF16Pos - 1); + end; + if StrPos <= 0 then + raise EJclUnexpectedEOSequenceError.Create + else + if StrPos > StrLen then + Result := StrLen + 1 + else + Result := StrPos; + end + else + Result := Index; +end; + +{$IFDEF JCL_PCRE} +var + {$IFDEF PCRE_8} + GTables: PAnsiChar; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + GTables16: PAnsiChar; + {$ENDIF PCRE_16} +{$ENDIF JCL_PCRE} + +{$IFDEF RTL230_UP} + {$IFDEF PCRE_RTL} + {$DEFINE PCRE_EXPORT_CDECL} + {$ENDIF PCRE_RTL} +{$ENDIF RTL230_UP} + +type + {$IFDEF PCRE_RTL} + {$IFDEF BDS10_UP} + TPCREGetMemInteger = NativeUInt; + {$ELSE ~BDS10_UP} + TPCREGetMemInteger = Integer; + {$ENDIF ~BDS10_UP} + {$ELSE ~PCRE_RTL} + TPCREGetMemInteger = SizeInt; + {$ENDIF ~PCRE_RTL} + +function JclPCREGetMem(Size: TPCREGetMemInteger): Pointer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +begin + GetMem(Result, Size); +end; + +function JclPCRE16GetMem(Size: SizeInt): Pointer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +begin + GetMem(Result, Size); +end; + +procedure JclPCREFreeMem(P: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +begin + FreeMem(P); +end; + +procedure JclPCRE16FreeMem(P: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +begin + FreeMem(P); +end; + +{$IFDEF PCRE_8} +function JclPCRECallout(var callout_block: pcre_callout_block): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +begin + Result := TJclAnsiRegEx(callout_block.callout_data).CalloutHandler(callout_block); +end; +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} +function JclPCRE16Callout(var callout_block: pcre16_callout_block): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +begin + Result := TJclWideRegEx(callout_block.callout_data).CalloutHandler(callout_block); +end; +{$ENDIF PCRE_16} + +function PCRECheck(Value: Integer; Wide: Boolean): Boolean; +var + PErr: PResStringRec; +begin + Result := Value >= 0; + if Result then Exit; + + case Value of + PCRE_ERROR_NOMATCH: + PErr := @RsErrNoMatch; + PCRE_ERROR_NULL: + PErr := @RsErrNull; + PCRE_ERROR_BADOPTION: + PErr := @RsErrBadOption; + PCRE_ERROR_BADMAGIC: + PErr := @RsErrBadMagic; + PCRE_ERROR_UNKNOWN_NODE: + PErr := @RsErrUnknownNode; + PCRE_ERROR_NOMEMORY: + PErr := @RsErrNoMemory; + PCRE_ERROR_NOSUBSTRING: + PErr := @RsErrNoSubString; + PCRE_ERROR_MATCHLIMIT: + PErr := @RsErrMatchLimit; + PCRE_ERROR_CALLOUT: + PErr := @RsErrCallout; + PCRE_ERROR_BADUTF8: + if Wide then + PErr := @RsErrBadUTF16 + else + PErr := @RsErrBadUTF8; + PCRE_ERROR_BADUTF8_OFFSET: + if Wide then + PErr := @RsErrBadUTF16Offset + else + PErr := @RsErrBadUTF8Offset; + PCRE_ERROR_PARTIAL: + PErr := @RsErrPartial; + PCRE_ERROR_BADPARTIAL: + PErr := @RsErrBadPartial; + PCRE_ERROR_INTERNAL: + PErr := @RsErrInternal; + PCRE_ERROR_BADCOUNT: + PErr := @RsErrBadCount; + PCRE_ERROR_DFA_UITEM: + PErr := @RsErrDfaUItem; + PCRE_ERROR_DFA_UCOND: + PErr := @RsErrDfaUCond; + PCRE_ERROR_DFA_UMLIMIT: + PErr := @RsErrDfaUMLimit; + PCRE_ERROR_DFA_WSSIZE: + PErr := @RsErrDfaWSSize; + PCRE_ERROR_DFA_RECURSE: + PErr := @RsErrDfaRecurse; + PCRE_ERROR_RECURSIONLIMIT: + PErr := @RsErrRecursionLimit; + PCRE_ERROR_NULLWSLIMIT: + PErr := @RsErrNullWsLimit; + PCRE_ERROR_BADNEWLINE: + PErr := @RsErrBadNewLine; + {$IFNDEF PCRE_RTL} + PCRE_ERROR_BADOFFSET: + PErr := @RsErrBadOffset; + PCRE_ERROR_SHORTUTF8: + if Wide then + PErr := @RsErrShortUTF16 + else + PErr := @RsErrShortUTF8; + PCRE_ERROR_RECURSELOOP: + PErr := @RsErrRecurseLoop; + PCRE_ERROR_JITSTACKLIMIT: + PErr := @RsErrJITStackLimit; + PCRE_ERROR_BADMODE: + PErr := @RsErrBadMode; + PCRE_ERROR_BADENDIANNESS: + PErr := @RsErrBadEndianness; + PCRE_ERROR_DFA_BADRESTART: + PErr := @RsErrBadRestart; + {$ENDIF ~PCRE_RTL} + JCL_PCRE_ERROR_STUDYFAILED: + PErr := @RsErrStudyFailed; + JCL_PCRE_ERROR_CALLOUTERROR: + PErr := @RsErrCalloutError; + JCL_PCRE_ERROR_NOUTF8: + if Wide then + PErr := @RsErrNoUTF16Support + else + PErr := @RsErrNoUTF8Support; + JCL_PCRE_ERROR_NOJIT: + PErr := @RsErrNoJITSupport; + else + PErr := @RsErrUnknownError; + end; + + raise EPCREError.CreateRes(PErr, Value); +end; + +//=== { TJclRegEx } =========================================================== + +destructor TJclRegExBase.Destroy; +begin + if Assigned(FVector) then + FreeMem(FVector); + if Assigned(FChangedCaptures) then + FChangedCaptures.Free; + + inherited Destroy; +end; + +function TJclRegExBase.GetAPIOptions(RunTime, DFA: Boolean): Integer; +const + {$IFDEF PCRE_RTL} + PCRE_PARTIAL_HARD = $08000000; + PCRE_NOTEMPTY_ATSTART = $10000000; + PCRE_UCP = $20000000; + {$ENDIF PCRE_RTL} + { roIgnoreCase, roMultiLine, roDotAll, roExtended, + roAnchored, roDollarEndOnly, roExtra, roNotBOL, roNotEOL, roUnGreedy, + roNotEmpty, roUTF8, roNoAutoCapture, roNoUTF8Check, roAutoCallout, + roPartial, roDfaShortest, roDfaRestart, roFirstLine, roDupNames, + roNewLineCR, roNewLineLF, roNewLineCRLF, roNewLineAny, roBSRAnyCRLF, + roBSRUnicode, roJavascriptCompat, roNoStartOptimize, roPartialHard, + roNotEmptyAtStart, roUCP } + cDesignOptions: array [TJclRegExOption] of Integer = + (PCRE_CASELESS, PCRE_MULTILINE, PCRE_DOTALL, PCRE_EXTENDED, PCRE_ANCHORED, + PCRE_DOLLAR_ENDONLY, PCRE_EXTRA, 0, 0, PCRE_UNGREEDY, 0, PCRE_UTF8, + PCRE_NO_AUTO_CAPTURE, PCRE_NO_UTF8_CHECK, PCRE_AUTO_CALLOUT, 0, 0, 0, + PCRE_FIRSTLINE, PCRE_DUPNAMES, PCRE_NEWLINE_CR, PCRE_NEWLINE_LF, + PCRE_NEWLINE_CRLF, PCRE_NEWLINE_ANY, PCRE_BSR_ANYCRLF, PCRE_BSR_UNICODE, + PCRE_JAVASCRIPT_COMPAT, PCRE_NO_START_OPTIMIZE, 0, 0, PCRE_UCP); + cRunOptions: array [TJclRegExOption] of Integer = + (0, 0, 0, 0, PCRE_ANCHORED, 0, 0, PCRE_NOTBOL, PCRE_NOTEOL, + 0, PCRE_NOTEMPTY, 0, 0, PCRE_NO_UTF8_CHECK, 0, PCRE_PARTIAL, 0, 0, + 0, 0, PCRE_NEWLINE_CR, PCRE_NEWLINE_LF, PCRE_NEWLINE_CRLF, + PCRE_NEWLINE_ANY, PCRE_BSR_ANYCRLF, PCRE_BSR_UNICODE, + 0, PCRE_NO_START_OPTIMIZE, PCRE_PARTIAL_HARD, + PCRE_NOTEMPTY_ATSTART, 0); + cDFARunOptions: array [TJclRegExOption] of Integer = + (0, 0, 0, 0, PCRE_ANCHORED, 0, 0, PCRE_NOTBOL, PCRE_NOTEOL, + 0, PCRE_NOTEMPTY, 0, 0, PCRE_NO_UTF8_CHECK, 0, PCRE_PARTIAL, + PCRE_DFA_SHORTEST, PCRE_DFA_RESTART, 0, 0, PCRE_NEWLINE_CR, + PCRE_NEWLINE_LF, PCRE_NEWLINE_CRLF, PCRE_NEWLINE_ANY, PCRE_BSR_ANYCRLF, + PCRE_BSR_UNICODE, 0, PCRE_NO_START_OPTIMIZE, PCRE_PARTIAL_HARD, + PCRE_NOTEMPTY_ATSTART, 0); +var + I: TJclRegExOption; +begin + Result := 0; + if RunTime and DFA then + begin + for I := Low(TJclRegExOption) to High(TJclRegExOption) do + if I in Options then + Result := Result or cDFARunOptions[I]; + end + else + if RunTime then + begin + for I := Low(TJclRegExOption) to High(TJclRegExOption) do + if I in Options then + Result := Result or cRunOptions[I]; + end + else + begin + for I := Low(TJclRegExOption) to High(TJclRegExOption) do + if I in Options then + Result := Result or cDesignOptions[I]; + end; +end; + +function TJclRegExBase.GetResult: string; +var + Index, CaptureIndex: Integer; + Pos: Integer; + Range: TJclCaptureRange; +begin + if Assigned(FChangedCaptures) and (FChangedCaptures.Count > 0) then + begin + Pos := 1; + Result := ''; + for Index := 0 to FChangedCaptures.Count - 1 do + begin + CaptureIndex := SizeInt(FChangedCaptures[Index]); + Range := GetCaptureRange(CaptureIndex); + + Result := Result + + Copy(FSubject, Pos, Range.FirstPos - Pos) + + FResultValues[CaptureIndex]; + + Pos := Range.LastPos + 1; + end; + if Pos <= Length(FSubject) then + Result := Result + Copy(FSubject, Pos, Length(FSubject) - Pos + 1); + end + else + Result := FSubject; +end; + +procedure TJclRegExBase.SetCapture(Index: Integer; const Value: string); +begin + if (Index < 0) or (Index >= FCaptureCount) then + PCRECheck(PCRE_ERROR_NOSUBSTRING, SupportsWideChar) + else + begin + if (not Assigned(FChangedCaptures)) or (FChangedCaptures.Count = 0) then + begin + if not Assigned(FChangedCaptures) then + FChangedCaptures := TList.Create; + + // Always resize to the max length to avoid repeated allocations. + FChangedCaptures.Capacity := FCaptureCount; + SetLength(FResultValues, FCaptureCount); + end; + + if FChangedCaptures.IndexOf(Pointer(SizeInt(Index))) < 0 then + FChangedCaptures.Add(Pointer(SizeInt(Index))); + FResultValues[Index] := Value; + end; +end; + +function TJclRegExBase.SupportsWideChar: Boolean; +begin + Result := False; +end; + +{$IFDEF PCRE_8} +procedure InitializeLocaleSupport; +begin + if not Assigned(GTables) then + GTables := pcre_maketables; +end; + +procedure TerminateLocaleSupport; +begin + if Assigned(GTables) then + begin + CallPCREFree(GTables); + GTables := nil; + end; +end; +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} +procedure InitializeLocaleSupport16; +begin + if not Assigned(GTables16) then + GTables16 := pcre16_maketables; +end; + +procedure TerminateLocaleSupport16; +begin + if Assigned(GTables16) then + begin + CallPCRE16Free(GTables16); + GTables16 := nil; + end; +end; +{$ENDIF PCRE_16} + +{$IFDEF JCL_PCRE} +// TODO: Better/specific error messages, show index when available. +function StrReplaceRegEx(const Subject, Pattern: string; Args: array of const): string; + + function ArgToString(Index: Integer): string; + begin + // TODO: Any other type? + case TVarRec(Args[Index]).VType of + vtPChar: + Result := string(AnsiString(TVarRec(Args[Index]).VPChar)); + vtPWideChar: + Result := string(WideString(TVarRec(Args[Index]).VPWideChar)); + vtString: + Result := string(TVarRec(Args[Index]).VString^); + vtAnsiString: + Result := string(AnsiString(TVarRec(Args[Index]).VAnsiString)); + vtWideString: + Result := string(WideString(TVarRec(Args[Index]).VWideString)); + {$IFDEF SUPPORTS_UNICODE_STRING} + vtUnicodeString: + Result := string(UnicodeString(TVarRec(Args[Index]).VUnicodeString)); + {$ENDIF SUPPORTS_UNICODE_STRING} + vtChar: + Result := string(AnsiString(TVarRec(Args[Index]).VChar)); + vtWideChar: + Result := string(WideString(TVarRec(Args[Index]).VWideChar)); + else + raise EConvertError.Create(SInvalidFormat); + end; + end; + +var + Re: TJclRegExBase; + Index, ArgIndex: Integer; + Value: string; +begin + if Odd(Length(Args)) then + raise EConvertError.Create(SArgumentMissing) + else + begin + Re := TJclRegEx.Create; + try + if Re.Compile(Pattern, False) and Re.Match(Subject) then + begin + for Index := 0 to Length(Args) div 2 - 1 do + begin + ArgIndex := Index * 2; + Value := ArgToString(ArgIndex + 1); + + if TVarRec(Args[ArgIndex]).VType = vtInteger then + Re.Captures[TVarRec(Args[ArgIndex]).VInteger] := Value + else + Re.NamedCaptures[ArgToString(ArgIndex)] := Value; + end; + + Result := Re.Result; + end + else + raise EConvertError.Create(SInvalidFormat); + finally + Re.Free; + end; + end; +end; +{$ENDIF JCL_PCRE} + +//=== { EPCREError } ========================================================= + +constructor EPCREError.CreateRes(ResStringRec: PResStringRec; ErrorCode: Integer); +begin + FErrorCode := ErrorCode; + inherited CreateRes(ResStringRec); +end; + +procedure LibNotLoadedHandler; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +begin + raise EPCREError.CreateRes(@RsErrLibNotLoaded, 0); +end; + +{$IFDEF PCRE_8} + +//=== { TJclAnsiRegEx } ====================================================== + +destructor TJclAnsiRegEx.Destroy; +begin + if Assigned(FCode) then + CallPCREFree(FCode); + if Assigned(FExtra) then + {$IFDEF PCRE_RTL} + CallPCREFree(FExtra); + {$ELSE ~PCRE_RTL} + pcre_free_study(FExtra); + {$ENDIF ~PCRE_RTL} + inherited Destroy; +end; + +function TJclAnsiRegEx.CalloutHandler(var CalloutBlock: pcre_callout_block): Integer; +begin + try + Result := JCL_PCRE_CALLOUT_NOERROR; + if Assigned(FOnCallout) then + begin + with CalloutBlock do + begin + FCaptureCount := capture_top; + FOnCallout(Self, callout_number, start_match + 1, current_position + 1, + capture_last, pattern_position + 1, next_item_length, Result); + end; + end; + except + on E: Exception do + begin + FErrorMessage := E.Message; + Result := JCL_PCRE_ERROR_CALLOUTERROR; + end; + end; +end; + +function TJclAnsiRegEx.Compile(const Pattern: string; Study, UserLocale, JITCompile: Boolean): Boolean; +var + ErrMsgPtr: PAnsiChar; + Tables: PAnsiChar; + StudyOptions: Integer; + {$IFNDEF PCRE_RTL} + ConfigJIT: Integer; + {$ENDIF ~PCRE_RTL} +begin + if UserLocale then + begin + InitializeLocaleSupport; + Tables := GTables; + end + else + Tables := nil; + + FPattern := Pattern; + if FPattern = '' then + PCRECheck(PCRE_ERROR_NULL, SupportsWideChar); + + if Assigned(FCode) then + begin + CallPCREFree(FCode); + FCode := nil; + end; + FCode := pcre_compile2(PAnsiChar(EncodeAnsiString(FPattern, roUTF8 in Options)), GetAPIOptions(False, DfaMode), + @FErrorCode, @ErrMsgPtr, @FErrorOffset, Tables); + Inc(FErrorOffset); + FErrorMessage := string(AnsiString(ErrMsgPtr)); + Result := Assigned(FCode); + if Result then + begin + if Study then + begin + {$IFDEF PCRE_RTL} + if Assigned(FExtra) then + CallPCREFree(FExtra); + if JITCompile then + raise EPCREError.CreateRes(@RsErrNoJITSupport, 0); + StudyOptions := 0; + {$ELSE ~PCRE_RTL} + if Assigned(FExtra) then + pcre_free_study(FExtra); + if JITCompile then + begin + PCRECheck(pcre_config(PCRE_CONFIG_JIT, @ConfigJIT), SupportsWideChar); + if ConfigJIT = 0 then + raise EPCREError.CreateRes(@RsErrNoJITSupport, 0); + StudyOptions := PCRE_STUDY_JIT_COMPILE; + end + else + StudyOptions := 0; + {$ENDIF ~PCRE_RTL} + FExtra := pcre_study(FCode, StudyOptions, @ErrMsgPtr); + Result := Assigned(FExtra) or (not Assigned(ErrMsgPtr)); + if not Result then + begin + FErrorCode := JCL_PCRE_ERROR_STUDYFAILED; + FErrorMessage := string(AnsiString(ErrMsgPtr)); + end; + end; + + if FDfaMode then + FVectorSize := FCaptureCount + else + begin + PCRECheck(pcre_fullinfo(FCode, FExtra, PCRE_INFO_CAPTURECOUNT, @FCaptureCount), SupportsWideChar); + FVectorSize := (FCaptureCount + 1) * 3; + end; + ReAllocMem(FVector, FVectorSize * SizeOf(FVector[0])); + end; +end; + +function TJclAnsiRegEx.GetAPIOptions(RunTime, DFA: Boolean): Integer; +var + ConfigUTF8: Integer; +begin + PCRECheck(pcre_config(PCRE_CONFIG_UTF8, @ConfigUTF8), SupportsWideChar); + if (roUTF8 in Options) and (ConfigUTF8 = 0) then + PCRECheck(JCL_PCRE_ERROR_NOUTF8, SupportsWideChar); + + Result := inherited GetAPIOptions(RunTime, DFA); +end; + +function TJclAnsiRegEx.GetCapture(Index: Integer): string; +var + FromPos, ToPos: SizeInt; +begin + if (Index < 0) or (Index >= FCaptureCount) then + PCRECheck(PCRE_ERROR_NOSUBSTRING, SupportsWideChar) + else + begin + if FViewChanges and (FChangedCaptures.IndexOf(Pointer(SizeInt(Index))) >= 0) then + begin + Result := FResultValues[Index]; + Exit; + end; + + Index := Index * 2; + FromPos := TranslateAnsiIndex(FSubject, roUTF8 in Options, FVector^[Index] + 1); + ToPos := TranslateAnsiIndex(FSubject, roUTF8 in Options, FVector^[Index + 1] + 1) - 1; + Result := Copy(FSubject, FromPos, ToPos - FromPos + 1); + end; +end; + +function TJclAnsiRegEx.GetCaptureNameCount: Integer; +begin + PCRECheck(pcre_fullinfo(FCode, FExtra, PCRE_INFO_NAMECOUNT, @Result), SupportsWideChar); +end; + +function TJclAnsiRegEx.GetCaptureName(Index: Integer): string; +var + NameTable: PAnsiChar; + EntrySize: Integer; +begin + PCRECheck(pcre_fullinfo(FCode, FExtra, PCRE_INFO_NAMETABLE, @NameTable), SupportsWideChar); + PCRECheck(pcre_fullinfo(FCode, FExtra, PCRE_INFO_NAMEENTRYSIZE, @EntrySize), SupportsWideChar); + + NameTable := NameTable + EntrySize * Index + 2; + Result := DecodeAnsiString(AnsiString(NameTable), roUTF8 in Options); +end; + +function TJclAnsiRegEx.GetCaptureRange(Index: Integer): TJclCaptureRange; +begin + if (Index < 0) or (Index >= FCaptureCount) then + PCRECheck(PCRE_ERROR_NOSUBSTRING, SupportsWideChar) + else + begin + Index := Index * 2; + Result.FirstPos := TranslateAnsiIndex(FSubject, roUTF8 in Options, FVector^[Index] + 1); + Result.LastPos := TranslateAnsiIndex(FSubject, roUTF8 in Options, FVector^[Index + 1] + 1) - 1; + end; +end; + +function TJclAnsiRegEx.GetNamedCapture(const Name: string): string; +var + Index: Integer; +begin + Index := pcre_get_stringnumber(FCode, PAnsiChar(EncodeAnsiString(Name, roUTF8 in Options))); + PCRECheck(Index, SupportsWideChar); + + Result := GetCapture(Index); +end; + +function TJclAnsiRegEx.IndexOfName(const Name: string): Integer; +begin + Result := pcre_get_stringnumber(FCode, PAnsiChar(EncodeAnsiString(Name, roUTF8 in Options))); +end; + +function TJclAnsiRegEx.IsNameValid(const Name: string): Boolean; +begin + Result := pcre_get_stringnumber(FCode, PAnsiChar(EncodeAnsiString(Name, roUTF8 in Options))) >= 0; +end; + +function TJclAnsiRegEx.Match(const Subject: string; StartOffset: Cardinal): Boolean; +var + LocalExtra: real_pcre_extra; + Extra: Pointer; + WorkSpace: array [0 .. 19] of Integer; + ExecRslt: Integer; + EncodedSubject: AnsiString; +begin + if Assigned(FOnCallout) then + begin + if Assigned(FExtra) then + begin + LocalExtra.flags := PCRE_EXTRA_STUDY_DATA or PCRE_EXTRA_CALLOUT_DATA; + LocalExtra.study_data := FExtra; + end + else + LocalExtra.flags := PCRE_EXTRA_CALLOUT_DATA; + LocalExtra.callout_data := Self; + Extra := @LocalExtra; + SetPCRECalloutCallback(JclPCRECallout); + end + else + begin + Extra := FExtra; + SetPCRECalloutCallback(nil); + end; + + FSubject := Subject; + if Assigned(FChangedCaptures) then + FChangedCaptures.Clear; + EncodedSubject := EncodeAnsiString(FSubject, roUTF8 in Options); + + // convert index + if roUTF8 in Options then + StartOffset := Length(EncodeAnsiString(Copy(FSubject, 1, StartOffset - 1), True)) + 1; + + if FDfaMode then + begin + ExecRslt := pcre_dfa_exec(FCode, Extra, PAnsiChar(EncodedSubject), Length(EncodedSubject), + StartOffset - 1, GetAPIOptions(True, DfaMode), PInteger(FVector), FVectorSize, @Workspace, 20); + end + else + begin + ExecRslt := pcre_exec(FCode, Extra, PAnsiChar(EncodedSubject), Length(EncodedSubject), + StartOffset - 1, GetAPIOptions(True, DfaMode), PInteger(FVector), FVectorSize); + end; + Result := ExecRslt >= 0; + if Result then + begin + FCaptureCount := ExecRslt; + FErrorCode := 0; + end + else + begin + FErrorCode := ExecRslt; + if FErrorCode <> PCRE_ERROR_NOMATCH then + PCRECheck(FErrorCode, SupportsWideChar); + end; +end; + +procedure TJclAnsiRegEx.SetNamedCapture(const Name, Value: string); +var + Index: Integer; +begin + Index := pcre_get_stringnumber(FCode, PAnsiChar(EncodeAnsiString(Name, roUTF8 in Options))); + PCRECheck(Index, SupportsWideChar); + + SetCapture(Index, Value); +end; + +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} + +//=== { TJclWideRegEx } ====================================================== + +destructor TJclWideRegEx.Destroy; +begin + if Assigned(FCode) then + CallPCRE16Free(FCode); + if Assigned(FExtra) then + {$IFDEF PCRE_RTL} + CallPCRE16Free(FExtra); + {$ELSE ~PCRE_RTL} + pcre16_free_study(FExtra); + {$ENDIF ~PCRE_RTL} + inherited Destroy; +end; + +function TJclWideRegEx.CalloutHandler(var CalloutBlock: pcre16_callout_block): Integer; +begin + try + Result := JCL_PCRE_CALLOUT_NOERROR; + if Assigned(FOnCallout) then + begin + with CalloutBlock do + begin + FCaptureCount := capture_top; + FOnCallout(Self, callout_number, start_match + 1, current_position + 1, + capture_last, pattern_position + 1, next_item_length, Result); + end; + end; + except + on E: Exception do + begin + FErrorMessage := E.Message; + Result := JCL_PCRE_ERROR_CALLOUTERROR; + end; + end; +end; + +function TJclWideRegEx.Compile(const Pattern: string; Study, UserLocale, JITCompile: Boolean): Boolean; +var + ErrMsgPtr: PAnsiChar; + Tables: PAnsiChar; + StudyOptions: Integer; + {$IFNDEF PCRE_RTL} + ConfigJIT: Integer; + {$ENDIF ~PCRE_RTL} +begin + if UserLocale then + begin + InitializeLocaleSupport16; + Tables := GTables16; + end + else + Tables := nil; + + FPattern := Pattern; + if FPattern = '' then + PCRECheck(PCRE_ERROR_NULL, SupportsWideChar); + + if Assigned(FCode) then + begin + CallPCRE16Free(FCode); + FCode := nil; + end; + FCode := pcre16_compile2(PWideChar(EncodeWideString(FPattern, roUTF16 in Options)), GetAPIOptions(False, DfaMode), + @FErrorCode, @ErrMsgPtr, @FErrorOffset, Tables); + Inc(FErrorOffset); + FErrorMessage := string(AnsiString(ErrMsgPtr)); + Result := Assigned(FCode); + if Result then + begin + if Study then + begin + {$IFDEF PCRE_RTL} + if Assigned(FExtra) then + CallPCRE16Free(FExtra); + if JITCompile then + raise EPCREError.CreateRes(@RsErrNoJITSupport, 0); + StudyOptions := 0; + {$ELSE ~PCRE_RTL} + if Assigned(FExtra) then + pcre16_free_study(FExtra); + if JITCompile then + begin + PCRECheck(pcre16_config(PCRE_CONFIG_JIT, @ConfigJIT), SupportsWideChar); + if ConfigJIT = 0 then + raise EPCREError.CreateRes(@RsErrNoJITSupport, 0); + StudyOptions := PCRE_STUDY_JIT_COMPILE; + end + else + StudyOptions := 0; + {$ENDIF ~PCRE_RTL} + FExtra := pcre16_study(FCode, StudyOptions, @ErrMsgPtr); + Result := Assigned(FExtra) or (not Assigned(ErrMsgPtr)); + if not Result then + begin + FErrorCode := JCL_PCRE_ERROR_STUDYFAILED; + FErrorMessage := string(AnsiString(ErrMsgPtr)); + end; + end; + + if FDfaMode then + FVectorSize := FCaptureCount + else + begin + PCRECheck(pcre16_fullinfo(FCode, FExtra, PCRE_INFO_CAPTURECOUNT, @FCaptureCount), SupportsWideChar); + FVectorSize := (FCaptureCount + 1) * 3; + end; + ReAllocMem(FVector, FVectorSize * SizeOf(FVector[0])); + end; +end; + +function TJclWideRegEx.GetAPIOptions(RunTime, DFA: Boolean): Integer; +var + ConfigUTF16: Integer; +begin + PCRECheck(pcre16_config(PCRE_CONFIG_UTF16, @ConfigUTF16), SupportsWideChar); + if (roUTF16 in Options) and (ConfigUTF16 = 0) then + PCRECheck(JCL_PCRE_ERROR_NOUTF16, SupportsWideChar); + + Result := inherited GetAPIOptions(RunTime, DFA); +end; + +function TJclWideRegEx.GetCapture(Index: Integer): string; +var + FromPos, ToPos: SizeInt; +begin + if (Index < 0) or (Index >= FCaptureCount) then + PCRECheck(PCRE_ERROR_NOSUBSTRING, SupportsWideChar) + else + begin + if FViewChanges and (FChangedCaptures.IndexOf(Pointer(SizeInt(Index))) >= 0) then + begin + Result := FResultValues[Index]; + Exit; + end; + + Index := Index * 2; + FromPos := TranslateWideIndex(FSubject, roUTF16 in Options, FVector^[Index] + 1); + ToPos := TranslateWideIndex(FSubject, roUTF16 in Options, FVector^[Index + 1] + 1) - 1; + Result := Copy(FSubject, FromPos, ToPos - FromPos + 1); + end; +end; + +function TJclWideRegEx.GetCaptureName(Index: Integer): string; +var + NameTable: PWideChar; + EntrySize: Integer; +begin + PCRECheck(pcre16_fullinfo(FCode, FExtra, PCRE_INFO_NAMETABLE, @NameTable), SupportsWideChar); + PCRECheck(pcre16_fullinfo(FCode, FExtra, PCRE_INFO_NAMEENTRYSIZE, @EntrySize), SupportsWideChar); + + NameTable := NameTable + EntrySize * Index + 1; + Result := DecodeWideString(WideString(NameTable), roUTF16 in Options); +end; + +function TJclWideRegEx.GetCaptureNameCount: Integer; +begin + PCRECheck(pcre16_fullinfo(FCode, FExtra, PCRE_INFO_NAMECOUNT, @Result), SupportsWideChar); +end; + +function TJclWideRegEx.GetCaptureRange(Index: Integer): TJclCaptureRange; +begin + if (Index < 0) or (Index >= FCaptureCount) then + PCRECheck(PCRE_ERROR_NOSUBSTRING, SupportsWideChar) + else + begin + Index := Index * 2; + Result.FirstPos := TranslateWideIndex(FSubject, roUTF16 in Options, FVector^[Index] + 1); + Result.LastPos := TranslateWideIndex(FSubject, roUTF16 in Options, FVector^[Index + 1] + 1) - 1; + end; +end; + +function TJclWideRegEx.GetNamedCapture(const Name: string): string; +var + Index: Integer; +begin + Index := pcre16_get_stringnumber(FCode, PWideChar(EncodeWideString(Name, roUTF16 in Options))); + PCRECheck(Index, SupportsWideChar); + + Result := GetCapture(Index); +end; + +function TJclWideRegEx.IndexOfName(const Name: string): Integer; +begin + Result := pcre16_get_stringnumber(FCode, PWideChar(EncodeWideString(Name, roUTF16 in Options))); +end; + +function TJclWideRegEx.IsNameValid(const Name: string): Boolean; +begin + Result := pcre16_get_stringnumber(FCode, PWideChar(EncodeWideString(Name, roUTF16 in Options))) >= 0; +end; + +function TJclWideRegEx.Match(const Subject: string; StartOffset: Cardinal): Boolean; +var + LocalExtra: real_pcre16_extra; + Extra: Pointer; + WorkSpace: array [0 .. 19] of Integer; + ExecRslt: Integer; + EncodedSubject: WideString; +begin + if Assigned(FOnCallout) then + begin + if Assigned(FExtra) then + begin + LocalExtra.flags := PCRE_EXTRA_STUDY_DATA or PCRE_EXTRA_CALLOUT_DATA; + LocalExtra.study_data := FExtra; + end + else + LocalExtra.flags := PCRE_EXTRA_CALLOUT_DATA; + LocalExtra.callout_data := Self; + Extra := @LocalExtra; + SetPCRE16CalloutCallback(JclPCRE16Callout); + end + else + begin + Extra := FExtra; + SetPCRE16CalloutCallback(nil); + end; + + FSubject := Subject; + if Assigned(FChangedCaptures) then + FChangedCaptures.Clear; + EncodedSubject := EncodeWideString(FSubject, roUTF16 in Options); + + // convert index + if roUTF16 in Options then + StartOffset := Length(EncodeWideString(Copy(FSubject, 1, StartOffset - 1), True)) + 1; + + if FDfaMode then + begin + ExecRslt := pcre16_dfa_exec(FCode, Extra, PWideChar(EncodedSubject), Length(EncodedSubject), + StartOffset - 1, GetAPIOptions(True, DfaMode), PInteger(FVector), FVectorSize, @Workspace, 20); + end + else + begin + ExecRslt := pcre16_exec(FCode, Extra, PWideChar(EncodedSubject), Length(EncodedSubject), + StartOffset - 1, GetAPIOptions(True, DfaMode), PInteger(FVector), FVectorSize); + end; + Result := ExecRslt >= 0; + if Result then + begin + FCaptureCount := ExecRslt; + FErrorCode := 0; + end + else + begin + FErrorCode := ExecRslt; + if FErrorCode <> PCRE_ERROR_NOMATCH then + PCRECheck(FErrorCode, SupportsWideChar); + end; +end; + +procedure TJclWideRegEx.SetNamedCapture(const Name, Value: string); +var + Index: Integer; +begin + Index := pcre16_get_stringnumber(FCode, PWideChar(EncodeWideString(Name, roUTF16 in Options))); + PCRECheck(Index, SupportsWideChar); + + SetCapture(Index, Value); +end; + +function TJclWideRegEx.SupportsWideChar: Boolean; +begin + Result := True; +end; +{$ENDIF PCRE_16} + +initialization + {$IFNDEF PCRE_RTL} + pcre.LibNotLoadedHandler := LibNotLoadedHandler; + {$ENDIF ~PCRE_RTL} + if LoadPCRE then + begin + {$IFDEF PCRE_8} + SetPCREMallocCallback(JclPCREGetMem); + SetPCREFreeCallback(JclPCREFreeMem); + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + SetPCRE16MallocCallback(JclPCRE16GetMem); + SetPCRE16FreeCallback(JclPCRE16FreeMem); + {$ENDIF PCRE_16} + end; + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF PCRE_8} + TerminateLocaleSupport; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + TerminateLocaleSupport16; + {$ENDIF PCRE_16} + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + UnloadPCRE; + +end. + diff --git a/3rdParty/JCL/source/common/JclPreProcessorAlgorithmsTemplates.pas b/3rdParty/JCL/source/common/JclPreProcessorAlgorithmsTemplates.pas new file mode 100644 index 00000000..120895aa --- /dev/null +++ b/3rdParty/JCL/source/common/JclPreProcessorAlgorithmsTemplates.pas @@ -0,0 +1,483 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclAlgorithmsTemplates.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. } +{ } +{ Contributors: } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclPreProcessorAlgorithmsTemplates; + +interface + +{$I jcl.inc} + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclPreProcessorContainerTypes, + JclPreProcessorContainerTemplates, + JclPreProcessorContainer1DTemplates; + +type + TJclAlgorithmsIntParams = class(TJclContainerInterfaceParams) + protected + // function CodeUnit: string; override; + end; + + TJclAlgorithmsIntProcParams = class(TJclAlgorithmsIntParams) + protected + FOverload: string; + public + property Overload: string read FOverload write FOverload; + end; + + TJclAlgorithmsImpProcParams = class(TJclContainerImplementationParams) + protected + // function CodeUnit: string; override; + end; + + (* MOVEARRAYINT(MOVEARRAYPROCEDURENAME, DYNARRAYTYPENAME, OVERLOAD) *) + TJclMoveArrayIntParams = class(TJclAlgorithmsIntProcParams) + published + property Overload; + property MoveArrayProcedureName: string index taMoveArrayProcedureName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property DynArrayTypeName: string index taDynArrayTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* MOVEARRAYIMP(MOVEARRAYPROCEDURENAME, DYNARRAYTYPENAME, DEFAULTVALUE) *) + TJclMoveArrayImpParams = class(TJclAlgorithmsImpProcParams) + published + property MoveArrayProcedureName: string index taMoveArrayProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + property DynArrayTypeName: string index taDynArrayTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property DefaultValue: string index taDefaultValue read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* ITERATEINT(ITERATEPROCEDURENAME, ITRINTERFACENAME, ITERATEPROCEDURETYPENAME, OVERLOAD) *) + TJclIterateIntParams = class(TJclAlgorithmsIntProcParams) + published + property Overload; + property IterateProcedureName: string index taIterateProcedureName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property IterateProcedureTypeName: string index taIterateProcedureTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* ITERATEIMP(ITERATEPROCEDURENAME, ITRINTERFACENAME, ITERATEPROCEDURETYPENAME) *) + TJclIterateImpParams = class(TJclAlgorithmsImpProcParams) + published + property IterateProcedureName: string index taIterateProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property IterateProcedureTypeName: string index taIterateProcedureTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* APPLYINT(APPLYPROCEDURENAME, ITRINTERFACENAME, APPLYFUNCTIONTYPENAME, OVERLOAD) *) + TJclApplyIntParams = class(TJclAlgorithmsIntProcParams) + published + property Overload; + property ApplyProcedureName: string index taApplyProcedureName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ApplyFunctionTypeName: string index taApplyFunctionTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* APPLYIMP(APPLYPROCEDURENAME, ITRINTERFACENAME, APPLYFUNCTIONNAME, SETTERPROCEDURENAME) *) + TJclApplyImpParams = class(TJclAlgorithmsImpProcParams) + published + property ApplyProcedureName: string index taApplyProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ApplyFunctionTypeName: string index taApplyFunctionTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* SIMPLECOMPAREINT(SIMPLECOMPAREFUNCTIONNAME, CONSTKEYWORD, TYPENAME) *) + TJclSimpleCompareIntParams = class(TJclAlgorithmsIntParams) + published + property SimpleCompareFunctionName: string index taSimpleCompareFunctionName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* SIMPLEEQUALITYCOMPAREINT(SIMPLEEQUALITYCOMPAREFUNCTIONNAME, CONSTKEYWORD, TYPENAME) *) + TJclSimpleEqualityCompareIntParams = class(TJclAlgorithmsIntParams) + published + property SimpleEqualityCompareFunctionName: string index taSimpleEqualityCompareFunctionName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* SIMPLEHASHCONVERTINT(SIMPLEHASHCONVERTFUNCTIONNAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME) *) + TJclSimpleHashConvertIntParams = class(TJclAlgorithmsIntParams) + published + property SimpleHashConvertFunctionName: string index taSimpleHashConvertFunctionName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* FINDINT(FINDFUNCTIONNAME, ITRINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, COMPAREFUNCTIONTYPENAME, OVERLOAD) *) + TJclFindIntParams = class(TJclAlgorithmsIntProcParams) + published + property FindFunctionName: string index taFindFunctionName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property CompareFunctionTypeName: string index taCompareFunctionTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* FINDIMP(FINDFUNCTIONNAME, ITRINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, COMPAREFUNCTIONTYPENAME) *) + TJclFindImpParams = class(TJclAlgorithmsImpProcParams) + published + property FindFunctionName: string index taFindFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property CompareFunctionTypeName: string index taCompareFunctionTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* FINDEQINT(FINDFUNCTIONNAME,ITRINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, CALLBACKTYPE, OVERLOAD) *) + TJclFindEqIntParams = class(TJclAlgorithmsIntProcParams) + published + property FindFunctionName: string index taFindFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property EqualityCompareFunctionTypeName: string index taEqualityCompareFunctionTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* FINDEQIMP(FINDFUNCTIONNAME, ITRINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, EQUALITYCOMPAREFUNCTIONTYPENAME) *) + TJclFindEqImpParams = class(TJclAlgorithmsImpProcParams) + published + property FindFunctionName: string index taFindFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property EqualityCompareFunctionTypeName: string index taEqualityCompareFunctionTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* COUNTOBJECTINT(COUNTOBJECTFUNCTIONNAME, ITRINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, COMPAREFUNCTIONTYPENAME, OVERLOAD) *) + TJclCountObjectIntParams = class(TJclAlgorithmsIntProcParams) + published + property CountObjectFunctionName: string index taCountObjectFunctionName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property CompareFunctionTypeName: string index taCompareFunctionTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* COUNTOBJECTIMP(COUNTOBJECTFUNCTIONNAME, ITRINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, COMPAREFUNCTIONTYPENAME) *) + TJclCountObjectImpParams = class(TJclAlgorithmsImpProcParams) + published + property CountObjectFunctionName: string index taCountObjectFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property CompareFunctionTypeName: string index taCompareFunctionTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* COUNTOBJECTEQINT(COUNTOBJECTFUNCTIONNAME, ITRINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, EQUALITYCOMPAREFUNCTIONTYPENAME, OVERLOAD) *) + TJclCountObjectEqIntParams = class(TJclAlgorithmsIntProcParams) + published + property CountObjectFunctionName: string index taCountObjectFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property EqualityCompareFunctionTypeName: string index taEqualityCompareFunctionTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* COUNTOBJECTEQIMP(COUNTOBJECTFUNCTIONNAME, ITRINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, EQUALITYCOMPAREFUNCTIONTYPENAME) *) + TJclCountObjectEqImpParams = class(TJclAlgorithmsImpProcParams) + published + property CountObjectFunctionName: string index taCountObjectFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property EqualityCompareFunctionTypeName: string index taEqualityCompareFunctionTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* COPYINT(COPYPROCEDURENAME, ITRINTERFACENAME, OVERLOAD) *) + TJclCopyIntParams = class(TJclAlgorithmsIntProcParams) + published + property CopyProcedureName: string index taCopyProcedureName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* COPYIMP(COPYPROCEDURENAME, ITRINTERFACENAME, SETTERPROCEDURENAME) *) + TJclCopyImpParams = class(TJclAlgorithmsImpProcParams) + published + property CopyProcedureName: string index taCopyProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* GENERATEINT(GENERATEPROCEDURENAME, LISTINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, OVERLOAD) *) + TJclGenerateIntParams = class(TJclAlgorithmsIntProcParams) + published + property GenerateProcedureName: string index taGenerateProcedureName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ListInterfaceName: string index taListInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* GENERATEIMP(GENERATEPROCEDURENAME, LISTINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME) *) + TJclGenerateImpParams = class(TJclAlgorithmsImpProcParams) + published + property GenerateProcedureName: string index taGenerateProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + property ListInterfaceName: string index taListInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* FILLINT(FILLPROCEDURENAME, ITRINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, OVERLOAD) *) + TJclFillIntParams = class(TJclAlgorithmsIntProcParams) + published + property FillProcedureName: string index taFillProcedureName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* FILLIMP(FILLPROCEDURENAME, ITRINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, SETTERPROCEDURENAME) *) + TJclFillImpParams = class(TJclAlgorithmsImpProcParams) + published + property FillProcedureName: string index taFillProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* REVERSEINT(REVERSEPROCEDURENAME, ITRINTERFACENAME, OVERLOAD) *) + TJclReverseIntParams = class(TJclAlgorithmsIntProcParams) + published + property ReverseProcedureName: string index taReverseProcedureName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* REVERSEIMP(REVERSEPROCEDURENAME, ITRINTERFACENAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) *) + TJclReverseImpParams = class(TJclAlgorithmsImpProcParams) + published + property ReverseProcedureName: string index taReverseProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* SORTINT(SORTPROCEDURENAME, LISTINTERFACENAME, LEFT, RIGHT, COMPAREFUNCTIONTYPENAME, OVERLOAD) *) + TJclSortIntParams = class(TJclAlgorithmsIntProcParams) + private + FLeft: string; + FRight: string; + function GetLeft: string; + function GetRight: string; + function IsLeftStored: Boolean; + function IsRightStored: Boolean; + published + property SortProcedureName: string index taSortProcedureName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ListInterfaceName: string index taListInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property Left: string read GetLeft write FLeft stored IsLeftStored; + property Right: string read GetRight write FRight stored IsRightStored; + property CompareFunctionTypeName: string index taCompareFunctionTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* QUICKSORTINT(QUICKSORTPROCEDURENAME, LISTINTERFACENAME, LEFT, RIGHT, COMPAREFUNCTIONTYPENAME, OVERLOAD) *) + TJclQuickSortIntParams = class(TJclAlgorithmsIntProcParams) + private + FLeft: string; + FRight: string; + function GetLeft: string; + function GetRight: string; + function IsLeftStored: Boolean; + function IsRightStored: Boolean; + published + property QuickSortProcedureName: string index taQuickSortProcedureName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ListInterfaceName: string index taListInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property Left: string read GetLeft write FLeft stored IsLeftStored; + property Right: string read GetRight write FRight stored IsRightStored; + property CompareFunctionTypeName: string index taCompareFunctionTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* QUICKSORTIMP(QUICKSORTPROCEDURENAME, LISTINTERFACENAME, LEFT, RIGHT, COMPAREFUNCTIONTYPENAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) *) + TJclQuickSortImpParams = class(TJclAlgorithmsImpProcParams) + private + function GetLeft: string; + function GetRight: string; + procedure SetLeft(const Value: string); + procedure SetRight(const Value: string); + published + property QuickSortProcedureName: string index taQuickSortProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + property ListInterfaceName: string index taListInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property Left: string read GetLeft write SetLeft stored False; + property Right: string read GetRight write SetRight stored False; + property CompareFunctionTypeName: string index taCompareFunctionTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +procedure RegisterJclContainers; +begin + RegisterContainerParams('MOVEARRAYINT', TJclMoveArrayIntParams); + RegisterContainerParams('ITERATEINT', TJclIterateIntParams); + RegisterContainerParams('APPLYINT', TJclApplyIntParams); + RegisterContainerParams('SIMPLECOMPAREINT', TJclSimpleCompareIntParams); + RegisterContainerParams('SIMPLEEQUALITYCOMPAREINT', TJclSimpleEqualityCompareIntParams); + RegisterContainerParams('SIMPLEHASHCONVERTINT', TJclSimpleHashConvertIntParams); + RegisterContainerParams('FINDINT', TJclFindIntParams); + RegisterContainerParams('FINDEQINT', TJclFindEqIntParams); + RegisterContainerParams('COUNTOBJECTINT', TJclCountObjectIntParams); + RegisterContainerParams('COUNTOBJECTEQINT', TJclCountObjectEqIntParams); + RegisterContainerParams('COPYINT', TJclCopyIntParams); + RegisterContainerParams('GENERATEINT', TJclGenerateIntParams); + RegisterContainerParams('FILLINT', TJclFillIntParams); + RegisterContainerParams('REVERSEINT', TJclReverseIntParams); + RegisterContainerParams('SORTINT', TJclSortIntParams); + RegisterContainerParams('QUICKSORTINT', TJclQuickSortIntParams); + + RegisterContainerParams('MOVEARRAYIMP', TJclMoveArrayImpParams, TJclMoveArrayIntParams); + RegisterContainerParams('ITERATEIMP', TJclIterateImpParams, TJclIterateIntParams); + RegisterContainerParams('APPLYIMP', TJclApplyImpParams, TJclApplyIntParams); + RegisterContainerParams('FINDIMP', TJclFindImpParams, TJclFindIntParams); + RegisterContainerParams('FINDEQIMP', TJclFindEqImpParams, TJclFindEqIntParams); + RegisterContainerParams('COUNTOBJECTIMP', TJclCountObjectImpParams, TJclCountObjectIntParams); + RegisterContainerParams('COUNTOBJECTEQIMP', TJclCountObjectEqImpParams, TJclCountObjectEqIntParams); + RegisterContainerParams('COPYIMP', TJclCopyImpParams, TJclCopyIntParams); + RegisterContainerParams('GENERATEIMP', TJclGenerateImpParams, TJclGenerateIntParams); + RegisterContainerParams('FILLIMP', TJclFillImpParams, TJclFillIntParams); + RegisterContainerParams('REVERSEIMP', TJclReverseImpParams, TJclReverseIntParams); + RegisterContainerParams('QUICKSORTIMP', TJclQuickSortImpParams, TJclQuickSortIntParams); +end; + +//=== { TJclSortIntParams } ================================================== + +function TJclSortIntParams.GetLeft: string; +begin + Result := FLeft; + if Result = '' then + Result := 'L'; +end; + +function TJclSortIntParams.GetRight: string; +begin + Result := FRight; + if Result = '' then + Result := 'R'; +end; + +function TJclSortIntParams.IsLeftStored: Boolean; +begin + Result := FLeft <> ''; +end; + +function TJclSortIntParams.IsRightStored: Boolean; +begin + Result := FRight <> ''; +end; + +//=== { TJclQuickSortIntParams } ============================================= + +function TJclQuickSortIntParams.GetLeft: string; +begin + Result := FLeft; + if Result = '' then + Result := 'L'; +end; + +function TJclQuickSortIntParams.GetRight: string; +begin + Result := FRight; + if Result = '' then + Result := 'R'; +end; + +function TJclQuickSortIntParams.IsLeftStored: Boolean; +begin + Result := FLeft <> ''; +end; + +function TJclQuickSortIntParams.IsRightStored: Boolean; +begin + Result := FRight <> ''; +end; + +//=== { TJclQuickSortImpParams } ============================================= + +function TJclQuickSortImpParams.GetLeft: string; +begin + Result := (InterfaceParams as TJclQuickSortIntParams).Left; +end; + +function TJclQuickSortImpParams.GetRight: string; +begin + Result := (InterfaceParams as TJclQuickSortIntParams).Right; +end; + +procedure TJclQuickSortImpParams.SetLeft(const Value: string); +begin + (InterfaceParams as TJclQuickSortIntParams).Left := Value; +end; + +procedure TJclQuickSortImpParams.SetRight(const Value: string); +begin + (InterfaceParams as TJclQuickSortIntParams).Right := Value; +end; + +initialization + RegisterJclContainers; + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclPreProcessorArrayListsTemplates.pas b/3rdParty/JCL/source/common/JclPreProcessorArrayListsTemplates.pas new file mode 100644 index 00000000..0cf20a0f --- /dev/null +++ b/3rdParty/JCL/source/common/JclPreProcessorArrayListsTemplates.pas @@ -0,0 +1,207 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclArrayListsTemplates.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. } +{ } +{ Contributors: } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclPreProcessorArrayListsTemplates; + +interface + +{$I jcl.inc} + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclPreProcessorContainerTypes, + JclPreProcessorContainerTemplates, + JclPreProcessorContainer1DTemplates; + +type + (* JCLARRAYLISTINT(SELFCLASSNAME, ANCESTORCLASSNAME, BASECONTAINERINTERFACENAME, + FLATCONTAINERINTERFACENAME, COLLECTIONINTERFACENAME, LISTINTERFACENAME, + ARRAYINTERFACENAME, ITRINTERFACENAME, DYNARRAYTYPE, EQUALITYCOMPARERINTERFACENAME, + INTERFACEADDITIONAL, SECTIONADDITIONAL, COLLECTIONFLAGS, OWNERSHIPDECLARATION, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) *) + TJclArrayListIntParams = class(TJclCollectionInterfaceParams) + protected + // function CodeUnit: string; override; + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property SelfClassName: string index taArrayListClassName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property AncestorClassName; + property BaseContainerInterfaceName: string index taContainerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property FlatContainerInterfaceName: string index taFlatContainerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property CollectionInterfaceName: string index taCollectionInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property EqualityComparerInterfaceName: string index taEqualityComparerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ListInterfaceName: string index taListInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ArrayInterfaceName: string index taArrayInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property DynArrayType: string index taDynArrayTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property InterfaceAdditional; + property SectionAdditional; + property CollectionFlags; + property OwnershipDeclaration; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* JCLARRAYLISTITRINT(SELFCLASSNAME, ITRINTERFACENAME, LISTCLASSNAME, CONSTKEYWORD, PARAMETERNAME, + TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) *) + TJclArrayListItrIntParams = class(TJclContainerInterfaceParams) + protected + // function CodeUnit: string; override; + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property SelfClassName: string index taArrayIteratorClassName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ListClassName: string index taArrayListClassName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* JCLARRAYLISTIMP(SELFCLASSNAME, OWNERSHIPDECLARATION, OWNERSHIPPARAMETERNAME, COLLECTIONINTERFACENAME, + ITRINTERFACENAME, ITRCLASSNAME, LISTINTERFACENAME, MOVEARRAYPROCEDURENAME, + CONSTKEYWORD, PARAMETERNAME, GETTERFUNCTIONNAME, + SETTERPROCEDURENAME, RELEASERFUNCTIONNAME, TYPENAME, DEFAULTVALUE) *) + TJclArrayListImpParams = class(TJclCollectionImplementationParams) + protected + // function CodeUnit: string; override; + public + function GetConstructorParameters: string; override; + function GetSelfClassName: string; override; + published + property SelfClassName: string index taArrayListClassName read GetTypeAttribute write SetTypeAttribute stored False; + property OwnershipDeclaration; + property OwnershipParameterName: string index taOwnershipParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property CollectionInterfaceName: string index taCollectionInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrClassName: string index taArrayIteratorClassName read GetTypeAttribute write SetTypeAttribute stored False; + property ListInterfaceName: string index taListInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property MoveArrayProcedureName: string index taMoveArrayProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + property ReleaserFunctionName: string index taReleaserFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property DefaultValue: string index taDefaultValue read GetTypeAttribute write SetTypeAttribute stored False; + property MacroFooter; + end; + + (* JCLARRAYLISTITRIMP(SELFCLASSNAME, ITRINTERFACENAME, LISTCLASSNAME, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) *) + TJclArrayListItrImpParams = class(TJclContainerImplementationParams) + protected + // function CodeUnit: string; override; + published + property SelfClassName: string index taArrayIteratorClassName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ListClassName: string index taArrayListClassName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclStrings; + +procedure RegisterJclContainers; +begin + RegisterContainerParams('JCLARRAYLISTINT', TJclArrayListIntParams); + RegisterContainerParams('JCLARRAYLISTITRINT', TJclArrayListItrIntParams); + RegisterContainerParams('JCLARRAYLISTIMP', TJclArrayListImpParams, TJclArrayListIntParams); + RegisterContainerParams('JCLARRAYLISTITRIMP', TJclArrayListItrImpParams, TJclArrayListItrIntParams); +end; + +//=== { TJclArrayListIntParams } ============================================= + +function TJclArrayListIntParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taArrayListClassName]; +end; + +//=== { TJclArrayListItrIntParams } ========================================== + +function TJclArrayListItrIntParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taArrayIteratorClassName]; +end; + +//=== { TJclArrayListImpParams } ============================================= + +function TJclArrayListImpParams.GetConstructorParameters: string; +begin + Result := 'FSize'; +end; + +function TJclArrayListImpParams.GetSelfClassName: string; +begin + Result := SelfClassName; +end; + +initialization + RegisterJclContainers; + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclPreProcessorArraySetsTemplates.pas b/3rdParty/JCL/source/common/JclPreProcessorArraySetsTemplates.pas new file mode 100644 index 00000000..4c332f69 --- /dev/null +++ b/3rdParty/JCL/source/common/JclPreProcessorArraySetsTemplates.pas @@ -0,0 +1,152 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclArraySetsTemplates.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. } +{ } +{ Contributors: } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclPreProcessorArraySetsTemplates; + +interface + +{$I jcl.inc} + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclPreProcessorContainerTypes, + JclPreProcessorContainerTemplates, + JclPreProcessorContainer1DTemplates; + +type + (* JCLARRAYSETINT(SELFCLASSNAME, ANCESTORCLASSNAME, BASECONTAINERINTERFACENAME, + FLATCONTAINERINTERFACENAME, COLLECTIONINTERFACENAME, LISTINTERFACENAME, + ARRAYINTERFACENAME, SETINTERFACENAME, EQUALITYCOMPARERINTERFACENAME, + COMPARERINTERFACENAME, INTERFACEADDITIONAL, SECTIONADDITIONAL, + COLLECTIONFLAGS, CONSTKEYWORD, PARAMETERNAME, TYPENAME) *) + TJclArraySetIntParams = class(TJclCollectionInterfaceParams) + protected + // function CodeUnit: string; override; + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property SelfClassName: string index taArraySetClassName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property AncestorClassName: string index taArrayListClassName read GetTypeAttribute write SetTypeAttribute stored False; + property BaseContainerInterfaceName: string index taContainerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property FlatContainerInterfaceName: string index taFlatContainerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property CollectionInterfaceName: string index taCollectionInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property EqualityComparerInterfaceName: string index taEqualityComparerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ComparerInterfaceName: string index taComparerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ListInterfaceName: string index taListInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ArrayInterfaceName: string index taArrayInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property SetInterfaceName: string index taSetInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property InterfaceAdditional; + property SectionAdditional; + property CollectionFlags; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* JCLARRAYSETIMP(SELFCLASSNAME, COLLECTIONINTERFACENAME, ITRINTERFACENAME, CONSTKEYWORD, + PARAMETERNAME, TYPENAME, DEFAULTVALUE, GETTERFUNCTIONNAME) *) + TJclArraySetImpParams = class(TJclCollectionImplementationParams) + protected + // function CodeUnit: string; override; + public + function GetConstructorParameters: string; override; + function GetSelfClassName: string; override; + published + property SelfClassName: string index taArraySetClassName read GetTypeAttribute write SetTypeAttribute stored False; + property CollectionInterfaceName: string index taCollectionInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property DefaultValue: string index taDefaultValue read GetTypeAttribute write SetTypeAttribute stored False; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property MacroFooter; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclStrings; + +procedure RegisterJclContainers; +begin + RegisterContainerParams('JCLARRAYSETINT', TJclArraySetIntParams); + RegisterContainerParams('JCLARRAYSETIMP', TJclArraySetImpParams, TJclArraySetIntParams); +end; + +//=== { TJclArraySetIntParams } ============================================== + +function TJclArraySetIntParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taArraySetClassName]; +end; + +//=== { TJclArraySetImpParams } ============================================== + +function TJclArraySetImpParams.GetConstructorParameters: string; +begin + Result := 'Size'; +end; + +function TJclArraySetImpParams.GetSelfClassName: string; +begin + Result := SelfClassName; +end; + +initialization + RegisterJclContainers; + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclPreProcessorBinaryTreesTemplates.pas b/3rdParty/JCL/source/common/JclPreProcessorBinaryTreesTemplates.pas new file mode 100644 index 00000000..e16ef185 --- /dev/null +++ b/3rdParty/JCL/source/common/JclPreProcessorBinaryTreesTemplates.pas @@ -0,0 +1,300 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclBinaryTreesTemplates.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. } +{ } +{ Contributors: } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclPreProcessorBinaryTreesTemplates; + +interface + +{$I jcl.inc} + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclPreProcessorContainerTypes, + JclPreProcessorContainerTemplates, + JclPreProcessorContainer1DTemplates; + +type + (* JCLBINARYTREETYPESINT(NODETYPENAME, TYPENAME) *) + TJclBinaryTreeTypeIntParams = class(TJclContainerInterfaceParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property NodeTypeName: string index taBinaryTreeNodeTypeName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* JCLBINARYTREEINT(NODETYPENAME, SELFCLASSNAME, ANCESTORCLASSNAME, BASECONTAINERINTERFACENAME, + FLATCONTAINERINTERFACENAME, COLLECTIONINTERFACENAME, + TREEINTERFACENAME, STDITRINTERFACENAME, TREEITRINTERFACENAME, + EQUALITYCOMPARERINTERFACENAME, COMPARERINTERFACENAME, INTERFACEADDITIONAL, + SECTIONADDITIONAL, CONSTRUCTORPARAMETERS, COLLECTIONFLAGS, CONSTKEYWORD, + PARAMETERNAME, TYPENAME) *) + TJclBinaryTreeIntParams = class(TJclCollectionInterfaceParams) + private + FConstructorDeclarations: string; + protected + // function CodeUnit: string; override; + function GetConstructorDeclarations: string; + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + procedure ResetDefault(Value: Boolean); override; + published + property NodeTypeName: string index taBinaryTreeNodeTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property SelfClassName: string index taBinaryTreeClassName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property AncestorClassName; + property BaseContainerInterfaceName: string index taContainerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property FlatContainerInterfaceName: string index taFlatContainerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property CollectionInterfaceName: string index taCollectionInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property CompareFunctionTypeName: string index taCompareFunctionTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property EqualityComparerInterfaceName: string index taEqualityComparerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ComparerInterfaceName: string index taComparerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property TreeInterfaceName: string index taTreeInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property StdItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property TreeItrInterfaceName: string index taTreeIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property InterfaceAdditional; + property SectionAdditional; + property ConstructorDeclarations: string read GetConstructorDeclarations write FConstructorDeclarations; + property OwnershipDeclaration; + property CollectionFlags; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* JCLBINARYTREEITRINT(BASEITRCLASSNAME, PREORDERITRCLASSNAME, INORDERITRCLASSNAME, POSTORDERITRCLASSNAME, + STDITRINTERFACENAME, STDTREEITRINTERFACENAME, BINTREEITRINTERFACENAME, + TREECLASSNAME, EQUALITYCOMPARERINTERFACENAME, NODETYPENAME, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) *) + TJclBinaryTreeItrIntParams = class(TJclContainerInterfaceParams) + protected + // function CodeUnit: string; override; + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property BaseItrClassName: string index taBinaryTreeBaseIteratorClassName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property PreOrderItrClassName: string index taBinaryTreePreOrderIteratorClassName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property InOrderItrClassName: string index taBinaryTreeInOrderIteratorClassName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property PostOrderItrClassName: string index taBinaryTreePostOrderIteratorClassName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property StdItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property StdTreeItrInterfaceName: string index taTreeIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property BinTreeItrInterfaceName: string index taBinaryTreeIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property TreeClassName: string index taBinaryTreeClassName read GetTypeAttribute write SetTypeAttribute stored False; + property EqualityComparerInterfaceName: string index taEqualityComparerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property NodeTypeName: string index taBinaryTreeNodeTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* JCLBINARYTREEIMP(SELFCLASSNAME, NODETYPENAME, PREORDERITRCLASSNAME, INORDERITRCLASSNAME, + POSTORDERITRCLASSNAME, COLLECTIONINTERFACENAME, STDITRINTERFACENAME, + TREEITRINTERFACENAME, CONSTRUCTORPARAMETERS, CONSTRUCTORASSIGNMENTS, + OWNERSHIPPARAMETERNAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, + RELEASERFUNCTIONNAME) *) + TJclBinaryTreeImpParams = class(TJclCollectionImplementationParams) + private + FConstructorAssignments: string; + FConstructorDeclarations: string; + protected + // function CodeUnit: string; override; + function GetConstructorAssignments: string; + function GetConstructorDeclarations: string; + public + function GetConstructorParameters: string; override; + function GetSelfClassName: string; override; + procedure ResetDefault(Value: Boolean); override; + published + property SelfClassName: string index taBinaryTreeClassName read GetTypeAttribute write SetTypeAttribute stored False; + property NodeTypeName: string index taBinaryTreeNodeTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property PreOrderItrClassName: string index taBinaryTreePreOrderIteratorClassName read GetTypeAttribute write SetTypeAttribute stored False; + property InOrderItrClassName: string index taBinaryTreeInOrderIteratorClassName read GetTypeAttribute write SetTypeAttribute stored False; + property PostOrderItrClassName: string index taBinaryTreePostOrderIteratorClassName read GetTypeAttribute write SetTypeAttribute stored False; + property CollectionInterfaceName: string index taCollectionInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property StdItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property TreeItrInterfaceName: string index taTreeIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstructorDeclarations: string read GetConstructorDeclarations write FConstructorDeclarations; + property ConstructorAssignments: string read GetConstructorAssignments write FConstructorAssignments; + property CompareFunctionTypeName: string index taCompareFunctionTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property OwnershipDeclaration; + property OwnershipParameterName: string index taOwnershipParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property ReleaserFunctionName: string index taReleaserFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property DefaultValue: string index taDefaultValue read GetTypeAttribute write SetTypeAttribute stored False; + property MacroFooter; + end; + + (* JCLBINARYTREEITRIMP(BASEITRCLASSNAME, PREORDERITRCLASSNAME, INORDERITRCLASSNAME, POSTORDERITRCLASSNAME, + STDITRINTERFACENAME, TREECLASSNAME, EQUALITYCOMPARERINTERFACENAME, + NODETYPENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, + GETTERFUNCTIONNAME, SETTERPROCEDURENAME, RELEASERFUNCTIONNAME) *) + TJclBinaryTreeItrImpParams = class(TJclContainerImplementationParams) + protected + // function CodeUnit: string; override; + published + property BaseItrClassName: string index taBinaryTreeBaseIteratorClassName read GetTypeAttribute write SetTypeAttribute stored False; + property PreOrderItrClassName: string index taBinaryTreePreOrderIteratorClassName read GetTypeAttribute write SetTypeAttribute stored False; + property InOrderItrClassName: string index taBinaryTreeInOrderIteratorClassName read GetTypeAttribute write SetTypeAttribute stored False; + property PostOrderItrClassName: string index taBinaryTreePostOrderIteratorClassName read GetTypeAttribute write SetTypeAttribute stored False; + property StdItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property TreeClassName: string index taBinaryTreeClassName read GetTypeAttribute write SetTypeAttribute stored False; + property EqualityComparerInterfaceName: string index taEqualityComparerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property NodeTypeName: string index taBinaryTreeNodeTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property DefaultValue: string index taDefaultValue read GetTypeAttribute write SetTypeAttribute stored False; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + property ReleaserFunctionName: string index taReleaserFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclStrings; + +procedure RegisterJclContainers; +begin + RegisterContainerParams('JCLBINARYTREETYPESINT', TJclBinaryTreeTypeIntParams); + RegisterContainerParams('JCLBINARYTREEINT', TJclBinaryTreeIntParams); + RegisterContainerParams('JCLBINARYTREEITRINT', TJclBinaryTreeItrIntParams); + RegisterContainerParams('JCLBINARYTREEIMP', TJclBinaryTreeImpParams, TJclBinaryTreeIntParams); + RegisterContainerParams('JCLBINARYTREEITRIMP', TJclBinaryTreeItrImpParams, TJclBinaryTreeItrIntParams); +end; + +//=== { TJclBinaryTreeTypeIntParams } ======================================== + +function TJclBinaryTreeTypeIntParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taBinaryTreeNodeTypeName]; +end; + +//=== { TJclBinaryTreeIntParams } ============================================ + +function TJclBinaryTreeIntParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taBinaryTreeClassName]; +end; + +function TJclBinaryTreeIntParams.GetConstructorDeclarations: string; +begin + Result := FConstructorDeclarations; + if (Result = '') and TypeInfo.KnownType then + Result := 'ACompare: ' + CompareFunctionTypeName; +end; + +procedure TJclBinaryTreeIntParams.ResetDefault(Value: Boolean); +begin + inherited ResetDefault(Value); + FConstructorDeclarations := ''; + if not Value then + FConstructorDeclarations := GetConstructorDeclarations; +end; + +//=== { TJclBinaryTreeItrIntParams } ========================================= + +function TJclBinaryTreeItrIntParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taBinaryTreeBaseIteratorClassName, taBinaryTreePreOrderIteratorClassName, + taBinaryTreeInOrderIteratorClassName, taBinaryTreePostOrderIteratorClassName]; +end; + +//=== { TJclBinaryTreeImpParams } ============================================ + +function TJclBinaryTreeImpParams.GetConstructorAssignments: string; +begin + Result := FConstructorAssignments; + if (Result = '') and TypeInfo.KnownType then + Result := NativeLineBreak + ' SetCompare(ACompare);'; +end; + +function TJclBinaryTreeImpParams.GetConstructorDeclarations: string; +begin + Result := FConstructorDeclarations; + if (Result = '') and TypeInfo.KnownType then + Result := 'ACompare: ' + CompareFunctionTypeName; +end; + +function TJclBinaryTreeImpParams.GetConstructorParameters: string; +begin + Result := 'Compare'; +end; + +function TJclBinaryTreeImpParams.GetSelfClassName: string; +begin + Result := SelfClassName; +end; + +procedure TJclBinaryTreeImpParams.ResetDefault(Value: Boolean); +begin + inherited ResetDefault(Value); + FConstructorAssignments := ''; + FConstructorDeclarations := ''; + if not Value then + begin + FConstructorAssignments := GetConstructorAssignments; + FConstructorDeclarations := GetConstructorDeclarations; + end; +end; + +initialization + RegisterJclContainers; + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclPreProcessorContainer1DTemplates.pas b/3rdParty/JCL/source/common/JclPreProcessorContainer1DTemplates.pas new file mode 100644 index 00000000..307f07f0 --- /dev/null +++ b/3rdParty/JCL/source/common/JclPreProcessorContainer1DTemplates.pas @@ -0,0 +1,531 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclContainer1DTemplates.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. } +{ } +{ Contributors: } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclPreProcessorContainer1DTemplates; + +interface + +{$I jcl.inc} + +uses + {$IFDEF HAS_UNITSCOPE} + System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Classes, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclBase, + JclPreProcessorContainerTypes; + +{$TYPEINFO ON} + +type + TJclContainerTypeInfo = class + private + FCustomTypeAttributes: TTypeAttributes; + FKnownTypeAttributes: PKnownTypeAttributes; + FOnKnownTypeChange: TNotifyEvent; + function GetCustomTypeAttribute(Index: TTypeAttributeID): string; + function GetTypeName: string; + protected + function GetFloatType: Boolean; + function GetKnownType: Boolean; + function GetOwnershipDeclaration: string; + function GetStringType: Boolean; + function GetTObjectType: Boolean; + function GetTypeAttribute(Index: TTypeAttributeID): string; + procedure SetKnownType(Value: Boolean); + procedure SetTypeAttribute(Index: TTypeAttributeID; const Value: string); + procedure SetTypeName(const Value: string); + public + property FloatType: Boolean read GetFloatType; + property KnownType: Boolean read GetKnownType write SetKnownType; + property StringType: Boolean read GetStringType; + property TObjectType: Boolean read GetTObjectType; + property KnownTypeAttributes: PKnownTypeAttributes read FKnownTypeAttributes; + property CustomTypeAttributes[Index: TTypeAttributeID]: string read GetCustomTypeAttribute; + property TypeAttributes[Index: TTypeAttributeID]: string read GetTypeAttribute write SetTypeAttribute; + property TypeName: string read GetTypeName write SetTypeName stored True; + property OwnershipDeclaration: string read GetOwnershipDeclaration; + property OnKnownTypeChange: TNotifyEvent read FOnKnownTypeChange write FOnKnownTypeChange; + end; + + TJclContainerInterfaceParams = class(TJclInterfaceParams) + private + FTypeInfo: TJclContainerTypeInfo; + protected + function GetOwnershipDeclaration: string; virtual; + function GetTypeAttribute(Index: TTypeAttributeID): string; + function IsTypeAttributeStored(Index: TTypeAttributeID): Boolean; + procedure SetTypeAttribute(Index: TTypeAttributeID; const Value: string); + public + property TypeInfo: TJclContainerTypeInfo read FTypeInfo write FTypeInfo; + property OwnershipDeclaration: string read GetOwnershipDeclaration; + end; + + TJclClassInterfaceParams = class(TJclContainerInterfaceParams) + protected + FAncestorClassName: string; + FInterfaceAdditional: string; + FSectionAdditional: string; + function GetAncestorClassName: string; virtual; + function GetInterfaceAdditional: string; virtual; + function GetSectionAdditional: string; virtual; + public + property AncestorClassName: string read GetAncestorClassName write FAncestorClassName; + property InterfaceAdditional: string read GetInterfaceAdditional write FInterfaceAdditional; + property SectionAdditional: string read GetSectionAdditional write FSectionAdditional; + end; + + TJclCollectionInterfaceParams = class(TJclClassInterfaceParams) + protected + FCollectionFlags: string; + function GetAncestorClassName: string; override; + function GetCollectionFlags: string; virtual; + public + property CollectionFlags: string read GetCollectionFlags write FCollectionFlags; + end; + + TJclTypeParams = class(TJclContainerInterfaceParams) + published + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property Condition: string index taCondition read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property Defines: string index taDefines read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property Undefs: string index taUndefs read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property Alias: string index taAlias read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property AliasCondition: string index taAliasCondition read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property DefaultValue: string index taDefaultValue read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property OwnershipParameterName: string index taOwnershipParameterName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ReleaserFunctionName: string index taReleaserFunctionName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property DynArrayTypeName: string index taDynArrayTypeName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ArrayPropertyName: string index taArrayPropertyName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property BaseContainerClassName: string index taBaseContainerClassName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property BaseCollectionClassName: string index taBaseCollectionClassName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ContainerInterfaceName: string index taContainerInterfaceName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ContainerInterfaceGUID: string index taContainerInterfaceGUID read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property FlatContainerInterfaceName: string index taFlatContainerInterfaceName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property FlatContainerInterfaceGUID: string index taFlatContainerInterfaceGUID read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + end; + + TJclContainerImplementationParams = class(TJclImplementationParams) + private + function GetTypeInfo: TJclContainerTypeInfo; + protected + function GetOwnershipDeclaration: string; virtual; + function GetTypeAttribute(Index: TTypeAttributeID): string; + function IsTypeAttributeStored(Index: TTypeAttributeID): Boolean; + procedure SetTypeAttribute(Index: TTypeAttributeID; const Value: string); + public + property OwnershipDeclaration: string read GetOwnershipDeclaration; + property TypeInfo: TJclContainerTypeInfo read GetTypeInfo; + end; + + TJclClassImplementationParams = class(TJclContainerImplementationParams) + protected + FMacroFooter: string; + function GetConstructorParameters: string; virtual; abstract; + function GetSelfClassName: string; virtual; abstract; + public + function GetMacroFooter: string; override; + procedure ResetDefault(Value: Boolean); override; + property MacroFooter: string read GetMacroFooter write FMacroFooter; + end; + + TJclCollectionImplementationParams = class(TJclClassImplementationParams) + + end; + +{$IFNDEF TYPEINFO_ON} + {$TYPEINFO OFF} +{$ENDIF ~TYPEINFO_ON} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Winapi.Windows, + {$ENDIF MSWINDOWS} + {$IFDEF HAS_UNIT_RTLCONSTS} + System.RTLConsts, + {$ENDIF HAS_UNIT_RTLCONSTS} + System.TypInfo, + System.SysUtils, + Winapi.ActiveX, + System.Win.ComObj, + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + {$IFDEF HAS_UNIT_RTLCONSTS} + RTLConsts, + {$ENDIF HAS_UNIT_RTLCONSTS} + TypInfo, + SysUtils, + ActiveX, + ComObj, + {$ENDIF ~HAS_UNITSCOPE} + JclRTTI, + JclSysUtils, + JclContainerIntf, + JclPreProcessorContainerKnownTypes, + JclPreProcessorContainerTemplates; + +procedure RegisterJclContainers; +begin + RegisterContainerParams('', TJclTypeParams); +end; + +//=== { TJclContainerTypeInfo } ============================================== + +function TJclContainerTypeInfo.GetTypeAttribute(Index: TTypeAttributeID): string; +begin + if (Index >= Low(TTypeAttributeID)) and (Index <= High(TTypeAttributeID)) then + begin + if FCustomTypeAttributes[Index] = '' then + begin + if Assigned(FKnownTypeAttributes) then + Result := FKnownTypeAttributes^[Index] + else + Result := Format(TypeAttributeInfos[Index].DefaultValue, [TypeName]); + end + else + Result := FCustomTypeAttributes[Index]; + end + else + begin + System.Error(reRangeError); + Result := ''; + end; +end; + +function TJclContainerTypeInfo.GetTypeName: string; +begin + Result := FCustomTypeAttributes[taTypeName]; +end; + +function TJclContainerTypeInfo.GetCustomTypeAttribute(Index: TTypeAttributeID): string; +begin + if (Index >= Low(TTypeAttributeID)) and (Index <= High(TTypeAttributeID)) then + Result := FCustomTypeAttributes[Index] + else + begin + System.Error(reRangeError); + Result := ''; + end; +end; + +function TJclContainerTypeInfo.GetFloatType: Boolean; +begin + Result := KnownType; + if Result then + Result := (TypeName = SingleKnownType[taTypeName]) or + (TypeName = DoubleKnownType[taTypeName]) or + (TypeName = ExtendedKnownType[taTypeName]) or + (TypeName = FloatKnownType[taTypeName]); +end; + +function TJclContainerTypeInfo.GetKnownType: Boolean; +var + Index: TTypeAttributeID; +begin + Result := Assigned(FKnownTypeAttributes); + for Index := Low(TTypeAttributeID) to High(TTypeAttributeID) do + if Index <> taTypeName then + begin + Result := Result and (FCustomTypeAttributes[Index] = ''); + if not Result then + Break; + end; +end; + +function TJclContainerTypeInfo.GetOwnershipDeclaration: string; +begin + Result := GetTypeAttribute(taOwnershipParameterName); + if Result <> '' then + Result := Format('%s: Boolean', [Result]); +end; + +function TJclContainerTypeInfo.GetTObjectType: Boolean; +begin + Result := KnownType and (TypeName = TObjectKnownType[taTypeName]); +end; + +function TJclContainerTypeInfo.GetStringType: Boolean; +begin + Result := KnownType; + if Result then + Result := (TypeName = AnsiStringKnownType[taTypeName]) or + (TypeName = WideStringKnownType[taTypeName]) or + (TypeName = UnicodeStringKnownType[taTypeName]) or + (TypeName = StringKnownType[taTypeName]); +end; + +procedure TJclContainerTypeInfo.SetKnownType(Value: Boolean); +var + Index: TTypeAttributeID; + NewGUID: TGUID; +begin + if Value then + begin + // reset to default values + for Index := Low(TTypeAttributeID) to High(TTypeAttributeID) do + if Index <> taTypeName then + FCustomTypeAttributes[Index] := ''; + end + else + if {not Value and} Assigned(FKnownTypeAttributes) then + begin + // copy with new GUIDs + for Index := Low(TTypeAttributeID) to High(TTypeAttributeID) do + if Index <> taTypeName then + begin + if TypeAttributeInfos[Index].IsGUID then + begin + OleCheck(CoCreateGuid(NewGUID)); + FCustomTypeAttributes[Index] := GUIDToString(NewGUID); + end + else + FCustomTypeAttributes[Index] := FKnownTypeAttributes[Index]; + end; + end + else + begin + {not Value and not Assigned(FKnownTypeAttributes)} + // default names with new GUIDs + for Index := Low(TTypeAttributeID) to High(TTypeAttributeID) do + if Index <> taTypeName then + begin + if TypeAttributeInfos[Index].IsGUID then + begin + OleCheck(CoCreateGuid(NewGUID)); + FCustomTypeAttributes[Index] := GUIDToString(NewGUID); + end + else + FCustomTypeAttributes[Index] := Format(TypeAttributeInfos[Index].DefaultValue, [TypeName]); + end; + end; + if Assigned(FOnKnownTypeChange) then + FOnKnownTypeChange(Self); +end; + +procedure TJclContainerTypeInfo.SetTypeAttribute(Index: TTypeAttributeID; + const Value: string); +begin + if (Index >= Low(TTypeAttributeID)) and (Index <= High(TTypeAttributeID)) then + FCustomTypeAttributes[Index] := Value + else + System.Error(reRangeError); +end; + +procedure TJclContainerTypeInfo.SetTypeName(const Value: string); +begin + FCustomTypeAttributes[taTypeName] := Value; + FKnownTypeAttributes := IsKnownType(Value); + if Assigned(FKnownTypeAttributes) then + SetKnownType(True); +end; + +//=== { TJclContainerInterfaceParams } ======================================= + +function TJclContainerInterfaceParams.GetOwnershipDeclaration: string; +begin + Result := TypeInfo.OwnershipDeclaration; + if Result <> '' then + Result := '; ' + Result; +end; + +function TJclContainerInterfaceParams.GetTypeAttribute(Index: TTypeAttributeID): string; +begin + Result := TypeInfo.TypeAttributes[Index]; +end; + +function TJclContainerInterfaceParams.IsTypeAttributeStored(Index: TTypeAttributeID): Boolean; +begin + Result := TypeInfo.CustomTypeAttributes[Index] <> ''; +end; + +procedure TJclContainerInterfaceParams.SetTypeAttribute(Index: TTypeAttributeID; + const Value: string); +begin + TypeInfo.TypeAttributes[Index] := Value; +end; + +//=== { TJclClassInterfaceParams } =========================================== + +function TJclClassInterfaceParams.GetAncestorClassName: string; +begin + Result := FAncestorClassName; + if Result = '' then + Result := TypeInfo.TypeAttributes[taBaseContainerClassName]; +end; + +function TJclClassInterfaceParams.GetInterfaceAdditional: string; +begin + Result := FInterfaceAdditional; + if Result = '' then + begin + if TypeInfo.StringType then + Result := ' IJclStrBaseContainer,' + else + if TypeInfo.TObjectType then + Result := ' IJclObjectOwner,'; + end; +end; + +function TJclClassInterfaceParams.GetSectionAdditional: string; +begin + Result := FSectionAdditional; + if (Result = '') and TypeInfo.KnownType then + Result := NativeLineBreak + + 'protected' + NativeLineBreak + + ' function CreateEmptyContainer: TJclAbstractContainerBase; override;'; +end; + +//=== { TJclCollectionInterfaceParams } ====================================== + +function TJclCollectionInterfaceParams.GetAncestorClassName: string; +begin + Result := FAncestorClassName; + if Result = '' then + begin + if TypeInfo.TypeAttributes[taBaseCollectionClassName] <> '' then + Result := TypeInfo.TypeAttributes[taBaseCollectionClassName] + else + Result := inherited GetAncestorClassName; + end; +end; + +function TJclCollectionInterfaceParams.GetCollectionFlags: string; +begin + Result := FCollectionFlags; + if (Result = '') and (TypeInfo.TypeAttributes[taBaseCollectionClassName] <> '') then + Result := ' override;'; +end; + +//=== { TJclContainerImplementationParams } ======================================= + +function TJclContainerImplementationParams.GetOwnershipDeclaration: string; +begin + Result := (InterfaceParams as TJclContainerInterfaceParams).OwnershipDeclaration; +end; + +function TJclContainerImplementationParams.GetTypeAttribute(Index: TTypeAttributeID): string; +begin + Result := (InterfaceParams as TJclContainerInterfaceParams).GetTypeAttribute(Index); +end; + +function TJclContainerImplementationParams.GetTypeInfo: TJclContainerTypeInfo; +begin + Result := (InterfaceParams as TJclContainerInterfaceParams).TypeInfo; +end; + +function TJclContainerImplementationParams.IsTypeAttributeStored(Index: TTypeAttributeID): Boolean; +begin + Result := (InterfaceParams as TJclContainerInterfaceParams).IsTypeAttributeStored(Index); +end; + +procedure TJclContainerImplementationParams.SetTypeAttribute(Index: TTypeAttributeID; + const Value: string); +begin + (InterfaceParams as TJclContainerInterfaceParams).SetTypeAttribute(Index, Value); +end; + +//=== { TJclClassImplementationParams } ====================================== + +function TJclClassImplementationParams.GetMacroFooter: string; +var + Ownership, SelfClassName, ConstructorParameters: string; +begin + if GetTypeAttribute(taOwnershipParameterName) <> '' then + Ownership := 'False' + else + Ownership := ''; + + SelfClassName := GetSelfClassName; + ConstructorParameters := GetConstructorParameters; + + Result := FMacroFooter; + + if (Result = '') and TypeInfo.KnownType then + begin + if (ConstructorParameters <> '') and (Ownership <> '') then + ConstructorParameters := ConstructorParameters + ', ' + Ownership + else + if ConstructorParameters = '' then + ConstructorParameters := Ownership; + if ConstructorParameters <> '' then + ConstructorParameters := '(' + ConstructorParameters + ')'; + Result := Format(NativeLineBreak + NativeLineBreak + + 'function %s.CreateEmptyContainer: TJclAbstractContainerBase;' + NativeLineBreak + + 'begin' + NativeLineBreak + + ' Result := %s.Create%s;' + NativeLineBreak + + ' AssignPropertiesTo(Result);' + NativeLineBreak + + 'end;' + NativeLineBreak, + [SelfClassName, SelfClassName, ConstructorParameters]); + end; +end; + +procedure TJclClassImplementationParams.ResetDefault(Value: Boolean); +begin + inherited ResetDefault(Value); + FMacroFooter := ''; + if not Value then + FMacroFooter := GetMacroFooter; +end; + +initialization + RegisterJclContainers; + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclPreProcessorContainer2DTemplates.pas b/3rdParty/JCL/source/common/JclPreProcessorContainer2DTemplates.pas new file mode 100644 index 00000000..5f0f107c --- /dev/null +++ b/3rdParty/JCL/source/common/JclPreProcessorContainer2DTemplates.pas @@ -0,0 +1,767 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclContainer2DTemplates.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. } +{ } +{ Contributors: } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclPreProcessorContainer2DTemplates; + +interface + +{$I jcl.inc} + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclBase, + JclPreProcessorContainerTypes, + JclPreProcessorContainer1DTemplates; + +{$TYPEINFO ON} + +type + TJclContainerMapInfo = class + private + FCustomMapAttributes: TMapAttributes; + FKnownMapAttributes: PKnownMapAttributes; + FValueTypeInfo: TJclContainerTypeInfo; + FKeyTypeInfo: TJclContainerTypeInfo; + function GetCustomMapAttribute(Index: TMapAttributeID): string; + function GetKeyAttribute(Index: TKeyAttributeID): string; + function GetValueAttribute(Index: TValueAttributeID): string; + procedure SetKeyAttribute(Index: TKeyAttributeID; const Value: string); + procedure SetValueAttribute(Index: TValueAttributeID; + const Value: string); + function GetKeyOwnershipDeclaration: string; + function GetValueOwnershipDeclaration: string; + protected + function GetKnownMap: Boolean; + function GetMapAttribute(Index: TMapAttributeID): string; + function IsMapAttributeStored(Index: TMapAttributeID): Boolean; + procedure SetKnownMap(Value: Boolean); + procedure SetMapAttribute(Index: TMapAttributeID; const Value: string); + procedure TypeKnownTypeChange(Sender: TObject); + public + constructor Create; + destructor Destroy; override; + property KnownMap: Boolean read GetKnownMap write SetKnownMap; + property KnownMapAttributes: PKnownMapAttributes read FKnownMapAttributes; + property CustomMapAttributes[Index: TMapAttributeID]: string read GetCustomMapAttribute; + property MapAttributes[Index: TMapAttributeID]: string read GetMapAttribute write SetMapAttribute; + property KeyAttributes[Index: TKeyAttributeID]: string read GetKeyAttribute write SetKeyAttribute; + property KeyTypeInfo: TJclContainerTypeInfo read FKeyTypeInfo; + property KeyOwnershipDeclaration: string read GetKeyOwnershipDeclaration; + property ValueAttributes[Index: TValueAttributeID]: string read GetValueAttribute write SetValueAttribute; + property ValueTypeInfo: TJclContainerTypeInfo read FValueTypeInfo; + property ValueOwnershipDeclaration: string read GetValueOwnershipDeclaration; + end; + + TJclMapInterfaceParams = class(TJclInterfaceParams) + private + FMapInfo: TJclContainerMapInfo; + function GetKeyOwnershipDeclaration: string; + function GetValueOwnershipDeclaration: string; + protected + function GetKeyAttribute(Index: TKeyAttributeID): string; + function GetMapAttribute(Index: TMapAttributeID): string; + function GetValueAttribute(Index: TValueAttributeID): string; + function IsMapAttributeStored(Index: TMapAttributeID): Boolean; + procedure SetKeyAttribute(Index: TKeyAttributeID; const Value: string); + procedure SetMapAttribute(Index: TMapAttributeID; const Value: string); + procedure SetValueAttribute(Index: TValueAttributeID; const Value: string); + public + property KeyOwnershipDeclaration: string read GetKeyOwnershipDeclaration; + property MapInfo: TJclContainerMapInfo read FMapInfo write FMapInfo; + property ValueOwnershipDeclaration: string read GetValueOwnershipDeclaration; + end; + + TJclMapClassInterfaceParams = class(TJclMapInterfaceParams) + protected + FInterfaceAdditional: string; + FSectionAdditional: string; + function GetInterfaceAdditional: string; virtual; + function GetSectionAdditional: string; virtual; + function GetComparisonSectionAdditional: string; virtual; abstract; + public + property InterfaceAdditional: string read GetInterfaceAdditional write FInterfaceAdditional; + property SectionAdditional: string read GetSectionAdditional write FSectionAdditional; + property KeyTypeName: string index kaKeyTypeName read GetKeyAttribute write SetKeyAttribute stored False; + property ValueTypeName: string index vaValueTypeName read GetValueAttribute write SetValueAttribute stored False; + end; + + TJclMapImplementationParams = class(TJclImplementationParams) + private + function GetKeyOwnershipDeclaration: string; + function GetValueOwnershipDeclaration: string; + function GetMapInfo: TJclContainerMapInfo; + protected + function GetKeyAttribute(Index: TKeyAttributeID): string; + function GetMapAttribute(Index: TMapAttributeID): string; + function GetValueAttribute(Index: TValueAttributeID): string; + procedure SetKeyAttribute(Index: TKeyAttributeID; const Value: string); + procedure SetMapAttribute(Index: TMapAttributeID; const Value: string); + procedure SetValueAttribute(Index: TValueAttributeID; const Value: string); + public + property KeyOwnershipDeclaration: string read GetKeyOwnershipDeclaration; + property ValueOwnershipDeclaration: string read GetValueOwnershipDeclaration; + property MapInfo: TJclContainerMapInfo read GetMapInfo; + end; + + TJclMapClassImplementationParams = class(TJclMapImplementationParams) + protected + FCreateKeySet: string; + FCreateKeyCollection: string; + FCreateValueCollection: string; + FMacroFooter: string; + FOwnershipAssignments: string; + function GetCreateKeySet: string; + function GetCreateKeyCollection: string; + function GetCreateValueCollection: string; + function GetOwnershipAssignment: string; + function GetSelfClassName: string; virtual; abstract; + public + function GetConstructorParameters: string; virtual; abstract; + function GetMacroFooter: string; override; + procedure ResetDefault(Value: Boolean); override; + property MacroFooter: string read GetMacroFooter write FMacroFooter; + property KeyTypeName: string index kaKeyTypeName read GetKeyAttribute write SetKeyAttribute stored False; + property KeyDefault: string index kaKeyDefaultValue read GetKeyAttribute write SetKeyAttribute stored False; + property KeyArraySetClassName: string index kaKeyArraySetClassName read GetKeyAttribute write SetKeyAttribute stored False; + property KeyArrayListClassName: string index kaKeyArrayListClassName read GetKeyAttribute write SetKeyAttribute stored False; + property ValueTypeName: string index vaValueTypeName read GetValueAttribute write SetValueAttribute stored False; + property ValueDefault: string index vaValueDefaultValue read GetValueAttribute write SetValueAttribute stored False; + property ValueArrayListClassName: string index vaValueArrayListClassName read GetValueAttribute write SetValueAttribute stored False; + property OwnershipAssignments: string read GetOwnershipAssignment write FOwnershipAssignments; + property CreateKeySet: string read GetCreateKeySet write FCreateKeySet; + property CreateKeyCollection: string read GetCreateKeyCollection write FCreateKeyCollection; + property CreateValueCollection: string read GetCreateValueCollection write FCreateValueCollection; + end; + +{$IFNDEF TYPEINFO_ON} + {$TYPEINFO OFF} +{$ENDIF ~TYPEINFO_ON} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.TypInfo, + System.SysUtils, + Winapi.ActiveX, + System.Win.ComObj, + {$ELSE ~HAS_UNITSCOPE} + TypInfo, + SysUtils, + ActiveX, + ComObj, + {$ENDIF ~HAS_UNITSCOPE} + JclRTTI, + JclSysUtils, + JclContainerIntf, + JclPreProcessorContainerKnownMaps; + +//=== { TJclContainerMapInfo } =============================================== + +constructor TJclContainerMapInfo.Create; +begin + inherited Create; + FKeyTypeInfo := TJclContainerTypeInfo.Create; + FKeyTypeInfo.OnKnownTypeChange := TypeKnownTypeChange; + FValueTypeInfo := TJclContainerTypeInfo.Create; + FValueTypeInfo.OnKnownTypeChange := TypeKnownTypeChange; +end; + +destructor TJclContainerMapInfo.Destroy; +begin + FKeyTypeInfo.Free; + FValueTypeInfo.Free; + inherited Destroy; +end; + +function TJclContainerMapInfo.GetCustomMapAttribute(Index: TMapAttributeID): string; +begin + if (Index >= Low(TMapAttributeID)) and (Index <= High(TMapAttributeID)) then + Result := FCustomMapAttributes[Index] + else + begin + Error(reRangeError); + Result := ''; + end; +end; + +function TJclContainerMapInfo.GetKeyAttribute(Index: TKeyAttributeID): string; +begin + if Index = kaKeyTypeName then + Result := KeyTypeInfo.TypeName + else + if (Index >= Low(TKeyAttributeID)) and (Index <= High(TKeyAttributeID)) then + Result := KeyTypeInfo.TypeAttributes[KeyAttributeInfos[Index]] + else + begin + Error(reRangeError); + Result := ''; + end; +end; + +function TJclContainerMapInfo.GetKeyOwnershipDeclaration: string; +begin + Result := GetKeyAttribute(kaKeyOwnershipParameterName); + if Result <> '' then + Result := 'AOwnsKeys: Boolean'; +end; + +function TJclContainerMapInfo.GetKnownMap: Boolean; +var + Index: TMapAttributeID; +begin + Result := Assigned(FKnownMapAttributes) and KeyTypeInfo.KnownType and ValueTypeInfo.KnownType; + for Index := Low(TMapAttributeID) to High(TMapAttributeID) do + begin + Result := Result and (FCustomMapAttributes[Index] = ''); + if not Result then + Break; + end; +end; + +function TJclContainerMapInfo.GetMapAttribute( + Index: TMapAttributeID): string; +begin + if (Index >= Low(TMapAttributeID)) and (Index <= High(TMapAttributeID)) then + begin + if FCustomMapAttributes[Index] = '' then + begin + if Assigned(FKnownMapAttributes) then + Result := FKnownMapAttributes^.MapAttributes[Index] + else + Result := Format(MapAttributeInfos[Index].DefaultValue, [KeyTypeInfo.TypeName, ValueTypeInfo.TypeName]); + end + else + Result := FCustomMapAttributes[Index]; + end + else + begin + Error(reRangeError); + Result := ''; + end; +end; + +function TJclContainerMapInfo.GetValueAttribute(Index: TValueAttributeID): string; +begin + if Index = vaValueTypeName then + Result := ValueTypeInfo.TypeName + else + if (Index >= Low(TValueAttributeID)) and (Index <= High(TValueAttributeID)) then + Result := ValueTypeInfo.TypeAttributes[ValueAttributeInfos[Index]] + else + begin + Error(reRangeError); + Result := ''; + end; +end; + +function TJclContainerMapInfo.GetValueOwnershipDeclaration: string; +begin + Result := GetValueAttribute(vaValueOwnershipParameterName); + if Result <> '' then + Result := 'AOwnsValues: Boolean'; +end; + +function TJclContainerMapInfo.IsMapAttributeStored(Index: TMapAttributeID): Boolean; +begin + if (Index >= Low(TMapAttributeID)) and (Index <= High(TMapAttributeID)) then + Result := FCustomMapAttributes[Index] <> '' + else + begin + Error(reRangeError); + Result := False; + end; +end; + +procedure TJclContainerMapInfo.SetKeyAttribute(Index: TKeyAttributeID; + const Value: string); +begin + if Index = kaKeyTypeName then + KeyTypeInfo.TypeName := Value + else + if (Index >= Low(TKeyAttributeID)) and (Index <= High(TKeyAttributeID)) then + KeyTypeInfo.TypeAttributes[KeyAttributeInfos[Index]] := Value + else + Error(reRangeError); +end; + +procedure TJclContainerMapInfo.SetKnownMap(Value: Boolean); +var + Index: TMapAttributeID; + NewGUID: TGUID; +begin + if Value then + begin + // reset to default values + for Index := Low(TMapAttributeID) to High(TMapAttributeID) do + FCustomMapAttributes[Index] := ''; + end + else + if {not Value and} Assigned(FKnownMapAttributes) then + begin + // copy with new GUIDs + for Index := Low(TMapAttributeID) to High(TMapAttributeID) do + begin + if MapAttributeInfos[Index].IsGUID then + begin + OleCheck(CoCreateGuid(NewGUID)); + FCustomMapAttributes[Index] := GUIDToString(NewGUID); + end + else + FCustomMapAttributes[Index] := FKnownMapAttributes^.MapAttributes[Index]; + end; + end + else + begin + {not Value and not Assigned(FKnownTypeAttributes)} + // default names with new GUIDs + for Index := Low(TMapAttributeID) to High(TMapAttributeID) do + begin + if MapAttributeInfos[Index].IsGUID then + begin + OleCheck(CoCreateGuid(NewGUID)); + FCustomMapAttributes[Index] := GUIDToString(NewGUID); + end + else + FCustomMapAttributes[Index] := Format(MapAttributeInfos[Index].DefaultValue, + [KeyTypeInfo.TypeName, ValueTypeInfo.TypeName]); + end; + end; +end; + +procedure TJclContainerMapInfo.SetMapAttribute(Index: TMapAttributeID; + const Value: string); +begin + if (Index >= Low(TMapAttributeID)) and (Index <= High(TMapAttributeID)) then + FCustomMapAttributes[Index] := Value + else + Error(reRangeError); +end; + +procedure TJclContainerMapInfo.SetValueAttribute(Index: TValueAttributeID; + const Value: string); +begin + if Index = vaValueTypeName then + ValueTypeInfo.TypeName := Value + else + if (Index >= Low(TValueAttributeID)) and (Index <= High(TValueAttributeID)) then + ValueTypeInfo.TypeAttributes[ValueAttributeInfos[Index]] := Value + else + Error(reRangeError); +end; + +procedure TJclContainerMapInfo.TypeKnownTypeChange(Sender: TObject); +begin + if KeyTypeInfo.KnownType and ValueTypeInfo.KnownType then + begin + FKnownMapAttributes := IsKnownMap(KeyTypeInfo.TypeName, ValueTypeInfo.TypeName); + SetKnownMap(True); + end; +end; + +//=== { TJclMapInterfaceParams } ============================================= + +function TJclMapInterfaceParams.GetKeyAttribute(Index: TKeyAttributeID): string; +begin + Result := MapInfo.KeyAttributes[Index]; +end; + +function TJclMapInterfaceParams.GetKeyOwnershipDeclaration: string; +begin + Result := MapInfo.KeyOwnershipDeclaration; + if Result <> '' then + Result := '; ' + Result; +end; + +function TJclMapInterfaceParams.GetMapAttribute( + Index: TMapAttributeID): string; +begin + Result := MapInfo.MapAttributes[Index]; +end; + +function TJclMapInterfaceParams.GetValueAttribute( + Index: TValueAttributeID): string; +begin + Result := MapInfo.ValueAttributes[Index]; +end; + +function TJclMapInterfaceParams.GetValueOwnershipDeclaration: string; +begin + Result := MapInfo.ValueOwnershipDeclaration; + if Result <> '' then + Result := '; ' + Result; +end; + +function TJclMapInterfaceParams.IsMapAttributeStored( + Index: TMapAttributeID): Boolean; +begin + Result := MapInfo.CustomMapAttributes[Index] <> ''; +end; + +procedure TJclMapInterfaceParams.SetKeyAttribute(Index: TKeyAttributeID; + const Value: string); +begin + MapInfo.KeyAttributes[Index] := Value; +end; + +procedure TJclMapInterfaceParams.SetMapAttribute(Index: TMapAttributeID; + const Value: string); +begin + MapInfo.MapAttributes[Index] := Value; +end; + +procedure TJclMapInterfaceParams.SetValueAttribute(Index: TValueAttributeID; + const Value: string); +begin + MapInfo.ValueAttributes[Index] := Value; +end; + +//=== { TJclMapClassInterfaceParams } ======================================== + +function TJclMapClassInterfaceParams.GetInterfaceAdditional: string; +begin + Result := FInterfaceAdditional; + if Result = '' then + begin + if MapInfo.KeyTypeInfo.StringType or MapInfo.ValueTypeInfo.StringType then + Result := ' IJclStrBaseContainer,'; + if MapInfo.KeyTypeInfo.TypeAttributes[taContainerInterfaceName] <> '' then + Result := Format('%s %s,', [Result, MapInfo.KeyTypeInfo.TypeAttributes[taContainerInterfaceName]]); + if (MapInfo.KeyTypeInfo.TypeName <> MapInfo.ValueTypeInfo.TypeName) and (MapInfo.ValueTypeInfo.TypeAttributes[taContainerInterfaceName] <> '') then + Result := Format('%s %s,', [Result, MapInfo.ValueTypeInfo.TypeAttributes[taContainerInterfaceName]]); + if MapInfo.KeyTypeInfo.TObjectType then + Result := Result + ' IJclKeyOwner,'; + if MapInfo.ValueTypeInfo.TObjectType then + Result := Result + ' IJclValueOwner,'; + end; +end; + +function TJclMapClassInterfaceParams.GetSectionAdditional: string; +begin + Result := FSectionAdditional; + if (Result = '') and MapInfo.KnownMap then + begin + Result := NativeLineBreak + + 'protected' + NativeLineBreak + + ' function CreateEmptyContainer: TJclAbstractContainerBase; override;' + NativeLineBreak; + + if not MapInfo.KeyTypeInfo.TObjectType then + Result := Format('%s function FreeKey(var Key: %s): %s;' + NativeLineBreak, + [Result, KeyTypeName, KeyTypeName]); + if not MapInfo.ValueTypeInfo.TObjectType then + Result := Format('%s function FreeValue(var Value: %s): %s;' + NativeLineBreak, + [Result, ValueTypeName, ValueTypeName]); + + Result := Result + GetComparisonSectionAdditional; + + if MapInfo.KeyTypeInfo.TObjectType or MapInfo.ValueTypeInfo.TObjectType then + begin + if MapInfo.ValueTypeInfo.TObjectType then + Result := ' FOwnsValues: Boolean;' + Result; + if MapInfo.KeyTypeInfo.TObjectType then + Result := ' FOwnsKeys: Boolean;' + NativeLineBreak + Result; + Result := NativeLineBreak + 'private' + NativeLineBreak + Result + NativeLineBreak + 'public' + NativeLineBreak; + if MapInfo.KeyTypeInfo.TObjectType then + Result := Result + ' { IJclKeyOwner }' + NativeLineBreak + + ' function FreeKey(var Key: TObject): TObject;' + NativeLineBreak + + ' function GetOwnsKeys: Boolean;' + NativeLineBreak + + ' property OwnsKeys: Boolean read FOwnsKeys;'; + if MapInfo.KeyTypeInfo.TObjectType and MapInfo.ValueTypeInfo.TObjectType then + Result := Result + NativeLineBreak; + if MapInfo.ValueTypeInfo.TObjectType then + Result := Result + ' { IJclValueOwner }' + NativeLineBreak + + ' function FreeValue(var Value: TObject): TObject;' + NativeLineBreak + + ' function GetOwnsValues: Boolean;' + NativeLineBreak + + ' property OwnsValues: Boolean read FOwnsValues;'; + end; + end +end; + +//=== { TJclMapImplementationParams } ======================================== + +function TJclMapImplementationParams.GetKeyAttribute( + Index: TKeyAttributeID): string; +begin + Result := (InterfaceParams as TJclMapInterfaceParams).GetKeyAttribute(Index); +end; + +function TJclMapImplementationParams.GetKeyOwnershipDeclaration: string; +begin + Result := (InterfaceParams as TJclMapInterfaceParams).GetKeyOwnershipDeclaration; +end; + +function TJclMapImplementationParams.GetMapAttribute( + Index: TMapAttributeID): string; +begin + Result := (InterfaceParams as TJclMapInterfaceParams).GetMapAttribute(Index); +end; + +function TJclMapImplementationParams.GetMapInfo: TJclContainerMapInfo; +begin + Result := (InterfaceParams as TJclMapInterfaceParams).MapInfo; +end; + +function TJclMapImplementationParams.GetValueAttribute( + Index: TValueAttributeID): string; +begin + Result := (InterfaceParams as TJclMapInterfaceParams).GetValueAttribute(Index); +end; + +function TJclMapImplementationParams.GetValueOwnershipDeclaration: string; +begin + Result := (InterfaceParams as TJclMapInterfaceParams).GetValueOwnershipDeclaration; +end; + +procedure TJclMapImplementationParams.SetKeyAttribute(Index: TKeyAttributeID; + const Value: string); +begin + (InterfaceParams as TJclMapInterfaceParams).SetKeyAttribute(Index, Value); +end; + +procedure TJclMapImplementationParams.SetMapAttribute(Index: TMapAttributeID; + const Value: string); +begin + (InterfaceParams as TJclMapInterfaceParams).SetMapAttribute(Index, Value); +end; + +procedure TJclMapImplementationParams.SetValueAttribute( + Index: TValueAttributeID; const Value: string); +begin + (InterfaceParams as TJclMapInterfaceParams).SetValueAttribute(Index, Value); +end; + +//=== { TJclMapClassImplementationParams } =================================== + +function TJclMapClassImplementationParams.GetCreateKeySet: string; +var + Ownership: string; +begin + Result := FCreateKeySet; + if Result = '' then + begin + if MapInfo.KeyTypeInfo.TypeAttributes[taOwnershipParameterName] <> '' then + Ownership := ', False' + else + Ownership := ''; + Result := Format('%s.Create(FSize%s)', [KeyArraySetClassName, Ownership]); + end; +end; + +function TJclMapClassImplementationParams.GetCreateKeyCollection: string; +var + Ownership: string; +begin + Result := FCreateKeyCollection; + if Result = '' then + begin + if MapInfo.KeyTypeInfo.TypeAttributes[taOwnershipParameterName] <> '' then + Ownership := ', False' + else + Ownership := ''; + Result := Format('%s.Create(FSize%s)', [KeyArrayListClassName, Ownership]); + end; +end; + +function TJclMapClassImplementationParams.GetCreateValueCollection: string; +var + Ownership: string; +begin + Result := FCreateValueCollection; + if Result = '' then + begin + if MapInfo.ValueTypeInfo.TypeAttributes[taOwnershipParameterName] <> '' then + Ownership := ', False' + else + Ownership := ''; + Result := Format('%s.Create(FSize%s)', [ValueArrayListClassName, Ownership]); + end; +end; + +function TJclMapClassImplementationParams.GetMacroFooter: string; +var + Ownership, SelfClassName, ConstructorParameters, + FuncBody: string; +begin + Result := FMacroFooter; + + if (Result = '') and MapInfo.KnownMap then + begin + if GetKeyAttribute(kaKeyOwnershipParameterName) <> '' then + begin + if GetValueAttribute(vaValueOwnershipParameterName) <> '' then + Ownership := 'False, False' + else + Ownership := 'False'; + end + else + begin + if GetValueAttribute(vaValueOwnershipParameterName) <> '' then + Ownership := 'False' + else + Ownership := ''; + end; + + SelfClassName := GetSelfClassName; + ConstructorParameters := GetConstructorParameters; + + if (ConstructorParameters <> '') and (Ownership <> '') then + ConstructorParameters := ConstructorParameters + ', ' + Ownership + else + if ConstructorParameters = '' then + ConstructorParameters := Ownership; + if ConstructorParameters <> '' then + ConstructorParameters := '(' + ConstructorParameters + ')'; + Result := Format(NativeLineBreak + NativeLineBreak + + 'function %s.CreateEmptyContainer: TJclAbstractContainerBase;' + NativeLineBreak + + 'begin' + NativeLineBreak + + ' Result := %s.Create%s;' + NativeLineBreak + + ' AssignPropertiesTo(Result);' + NativeLineBreak + + 'end;' + NativeLineBreak, + [SelfClassName, SelfClassName, ConstructorParameters]); + + if MapInfo.KeyTypeInfo.TObjectType then + FuncBody := Format(' if FOwnsKeys then' + NativeLineBreak + + ' begin' + NativeLineBreak + + ' Result := %s;' + NativeLineBreak + + ' FreeAndNil(Key);' + NativeLineBreak + + ' end' + NativeLineBreak + + ' else' + NativeLineBreak + + ' begin' + NativeLineBreak + + ' Result := Key;' + NativeLineBreak + + ' Key := %s;' + NativeLineBreak + + ' end;' + NativeLineBreak, + [KeyDefault, KeyDefault]) + else + FuncBody := Format(' Result := Key;' + NativeLineBreak + + ' Key := %s;' + NativeLineBreak, [KeyDefault]); + + Result := Format('%s' + NativeLineBreak + + 'function %s.FreeKey(var Key: %s): %s;' + NativeLineBreak + + 'begin' + NativeLineBreak + + '%s' + + 'end;' + NativeLineBreak, + [Result, SelfClassName, KeyTypeName, KeyTypeName, FuncBody]); + + if MapInfo.ValueTypeInfo.TObjectType then + FuncBody := Format(' if FOwnsValues then' + NativeLineBreak + + ' begin' + NativeLineBreak + + ' Result := %s;' + NativeLineBreak + + ' FreeAndNil(Value);' + NativeLineBreak + + ' end' + NativeLineBreak + + ' else' + NativeLineBreak + + ' begin' + NativeLineBreak + + ' Result := Value;' + NativeLineBreak + + ' Value := %s;' + NativeLineBreak + + ' end;' + NativeLineBreak, + [ValueDefault, ValueDefault]) + else + FuncBody := Format(' Result := Value;' + NativeLineBreak + + ' Value := %s;' + NativeLineBreak, [ValueDefault]); + + Result := Format('%s' + NativeLineBreak + + 'function %s.FreeValue(var Value: %s): %s;' + NativeLineBreak + + 'begin' + NativeLineBreak + + '%s' + + 'end;' + NativeLineBreak, + [Result, SelfClassName, ValueTypeName, ValueTypeName, FuncBody]); + + if MapInfo.KeyTypeInfo.TObjectType then + begin + Result := Format('%s' + NativeLineBreak + + 'function %s.GetOwnsKeys: Boolean;' + NativeLineBreak + + 'begin' + NativeLineBreak + + ' Result := FOwnsKeys;' + NativeLineBreak + + 'end;' + NativeLineBreak, + [Result, SelfClassName]); + end; + + if MapInfo.ValueTypeInfo.TObjectType then + begin + Result := Format('%s' + NativeLineBreak + + 'function %s.GetOwnsValues: Boolean;' + NativeLineBreak + + 'begin' + NativeLineBreak + + ' Result := FOwnsValues;' + NativeLineBreak + + 'end;' + NativeLineBreak, + [Result, SelfClassName]); + end; + end; +end; + +function TJclMapClassImplementationParams.GetOwnershipAssignment: string; +begin + Result := FOwnershipAssignments; + if Result = '' then + begin + if MapInfo.KeyTypeInfo.TObjectType then + Result := NativeLineBreak + ' FOwnsKeys := AOwnsKeys;'; + if MapInfo.ValueTypeInfo.TObjectType then + Result := Result + NativeLineBreak + ' FOwnsValues := AOwnsValues;'; + end; +end; + +procedure TJclMapClassImplementationParams.ResetDefault(Value: Boolean); +begin + inherited ResetDefault(Value); + FCreateKeySet := ''; + FCreateValueCollection := ''; + FMacroFooter := ''; + FOwnershipAssignments := ''; + if not Value then + begin + FCreateKeySet := GetCreateKeySet; + FCreateValueCollection := GetCreateValueCollection; + FMacroFooter := GetMacroFooter; + FOwnershipAssignments := GetOwnershipAssignment; + end; +end; + +initialization + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclPreProcessorContainerIntfTemplates.pas b/3rdParty/JCL/source/common/JclPreProcessorContainerIntfTemplates.pas new file mode 100644 index 00000000..0b4af979 --- /dev/null +++ b/3rdParty/JCL/source/common/JclPreProcessorContainerIntfTemplates.pas @@ -0,0 +1,659 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclContainerIntfTemplates.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. } +{ } +{ Contributors: } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclPreProcessorContainerIntfTemplates; + +interface + +{$I jcl.inc} + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclPreProcessorContainerTypes, + JclPreProcessorContainerTemplates, + JclPreProcessorContainer1DTemplates, + JclPreProcessorContainer2DTemplates; + +type + TJclContainerIntf1DParams = class(TJclContainerInterfaceParams) + protected + // function CodeUnit: string; override; + end; + + TJclContainerIntf2DParams = class(TJclMapInterfaceParams) + protected + // function CodeUnit: string; override; + end; + + TJclContainerIntfAncestorParams = class(TJclContainerIntf1DParams) + protected + FAncestorName: string; + function GetAncestorName: string; virtual; + function IsAncestorNameStored: Boolean; + public + property AncestorName: string read GetAncestorName write FAncestorName stored IsAncestorNameStored; + end; + + TJclContainerIntfFlatAncestorParams = class(TJclContainerIntfAncestorParams) + protected + function GetAncestorName: string; override; + end; + + (* ITERPROCEDURE(ITERATEPROCEDURETYPENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME) *) + TJclIterProcedureParams = class(TJclContainerIntf1DParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property IterateProcedureTypeName: string index taIterateProcedureTypeName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* APPLYFUNCTION(APPLYFUNCTIONTYPENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME) *) + TJclApplyFunctionParams = class(TJclContainerIntf1DParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property ApplyFunctionTypeName: string index taApplyFunctionTypeName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* COMPAREFUNCTION(COMPAREFUNCTIONTYPENAME, CONSTKEYWORD, TYPENAME) *) + TJclCompareFunctionParams = class(TJclContainerIntf1DParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property CompareFunctionTypeName: string index taCompareFunctionTypeName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* EQUALITYCOMPAREFUNCTION(EQUALITYCOMPAREFUNCTIONTYPENAME, CONSTKEYWORD, TYPENAME) *) + TJclEqualityCompareFunctionParams = class(TJclContainerIntf1DParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property EqualityCompareFunctionTypeName: string index taEqualityCompareFunctionTypeName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* HASHFUNCTION(HASHCONVERTFUNCTIONTYPENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME) *) + TJclHashFunctionParams = class(TJclContainerIntf1DParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property HashConvertFunctionTypeName: string index taHashConvertFunctionTypeName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* SORTPROC(SORTPROCEDURETYPENAME, LISTINTERFACENAME, COMPAREFUNCTIONTYPENAME) *) + TJclSortFunctionParams = class(TJclContainerIntf1DParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property SortProcedureTypeName: string index taSortProcedureTypeName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ListInterfaceName: string index taListInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property CompareFunctionTypeName: string index taCompareFunctionTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* EQUALITYCOMPARER(INTERFACENAME, GUID, EQUALITYCOMPAREFUNCTIONTYPENAME, CONSTKEYWORD, TYPENAME) *) + TJclEqualityComparerParams = class(TJclContainerIntf1DParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property InterfaceName: string index taEqualityComparerInterfaceName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property GUID: string index taEqualityComparerInterfaceGUID read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property EqualityCompareFunctionTypeName: string index taEqualityCompareFunctionTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* COMPARER(INTERFACENAME, GUID, COMPAREFUNCTIONTYPENAME, CONSTKEYWORD, TYPENAME) *) + TJclComparerParams = class(TJclContainerIntf1DParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property InterfaceName: string index taComparerInterfaceName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property GUID: string index taComparerInterfaceGUID read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property CompareFunctionTypeName: string index taCompareFunctionTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* HASHCONVERTER(INTERFACENAME, GUID, HASHCONVERTFUNCTIONTYPENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME) *) + TJclHashConverterParams = class(TJclContainerIntf1DParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property InterfaceName: string index taHashConverterInterfaceName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property GUID: string index taHashConverterInterfaceGUID read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property HashConvertFunctionTypeName: string index taHashConvertFunctionTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* RELEASEEVENT(EVENTTYPENAME, PARAMETERNAME, TYPENAME) *) + TJclReleaseEventParams = class(TJclContainerIntf1DParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property EventTypeName: string index taReleaseEventTypeName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* OWNER(INTERFACENAME, ANCESTORNAME, GUID, RELEASERFUNCTIONNAME, RELEASEEVENTNAME, RELEASEEVENTTYPENAME, PARAMETERNAME, TYPENAME, OWNERADDITIONAL) *) + TJclOwnerParams = class(TJclContainerIntfAncestorParams) + protected + FOwnerAdditional: string; + function GetAncestorName: string; override; + function GetOwnerAdditional: string; + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property InterfaceName: string index taOwnershipInterfaceName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property AncestorName; + property GUID: string index taOwnershipInterfaceGUID read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ReleaserFunctionName: string index taReleaserFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property ReleaseEventName: string index taReleaseEventName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ReleaseEventTypeName: string index taReleaseEventTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property OwnerAdditional: string read GetOwnerAdditional write FOwnerAdditional; + end; + + (* ITERATOR(INTERFACENAME, ANCESTORNAME, GUID, CONSTKEYWORD, PARAMETERNAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) *) + TJclIteratorParams = class(TJclContainerIntfAncestorParams) + protected + function GetAncestorName: string; override; + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property InterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property AncestorName; + property GUID: string index taIteratorInterfaceGUID read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* TREEITERATOR(INTERFACENAME, ANCESTORNAME, GUID, CONSTKEYWORD, PARAMETERNAME, TYPENAME) *) + TJclTreeIteratorParams = class(TJclContainerIntf1DParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property InterfaceName: string index taTreeIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property AncestorName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property GUID: string index taTreeIteratorInterfaceGUID read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* BINTREEITERATOR(INTERFACENAME, ANCESTORNAME, GUID, TYPENAME) *) + TJclBinaryTreeIteratorParams = class(TJclContainerIntf1DParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property InterfaceName: string index taBinaryTreeIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property AncestorName: string index taTreeIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property GUID: string index taBinaryTreeIteratorInterfaceGUID read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* COLLECTION(INTERFACENAME, ANCESTORNAME, GUID, CONSTKEYWORD, PARAMETERNAME, TYPENAME, ITRNAME) *) + TJclCollectionParams = class(TJclContainerIntfFlatAncestorParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property InterfaceName: string index taCollectionInterfaceName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property AncestorName; + property GUID: string index taCollectionInterfaceGUID read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* LIST(INTERFACENAME, ANCESTORNAME, GUID, CONSTKEYWORD, PARAMETERNAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME, ARRAYPROPERTYNAME) *) + TJclListParams = class(TJclContainerIntf1DParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property InterfaceName: string index taListInterfaceName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ListInterfaceName: string index taListInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property AncestorName: string index taCollectionInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property CollectionInterfaceName: string index taCollectionInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property GUID: string index taListInterfaceGUID read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + property ArrayPropertyName: string index taArrayPropertyName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* ARRAY(INTERFACENAME, ANCESTORNAME, GUID, CONSTKEYWORD, PARAMETERNAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME, ARRAYPROPERTYNAME) *) + TJclArrayParams = class(TJclContainerIntf1DParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property InterfaceName: string index taArrayInterfaceName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property AncestorName: string index taListInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property GUID: string index taArrayInterfaceGUID read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + property ArrayPropertyName: string index taArrayPropertyName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* SET(INTERFACENAME, ANCESTORNAME, GUID) *) + TJclSetParams = class(TJclContainerIntf1DParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property InterfaceName: string index taSetInterfaceName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property SetInterfaceName: string index taSetInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property AncestorName: string index taCollectionInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property CollectionInterfaceName: string index taCollectionInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property GUID: string index taSetInterfaceGUID read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + end; + + (* TREE(INTERFACENAME, ANCESTORNAME, GUID, ITRNAME) *) + TJclTreeParams = class(TJclContainerIntf1DParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property InterfaceName: string index taTreeInterfaceName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property AncestorName: string index taCollectionInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property GUID: string index taTreeInterfaceGUID read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ItrName: string index taTreeIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* MAP(INTERFACENAME, ANCESTORNAME, GUID, KEYCONSTKEYWORD, KEYTYPENAME, KEYSETNAME, + VALUECONSTKEYWORD, VALUETYPENAME, VALUECOLLECTIONNAME) *) + TJclMapParams = class(TJclContainerIntf2DParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property InterfaceName: string index maMapInterfaceName read GetMapAttribute write SetMapAttribute stored IsMapAttributeStored; + property AncestorName: string index maMapInterfaceAncestorName read GetMapAttribute write SetMapAttribute stored IsMapAttributeStored; + property GUID: string index maMapInterfaceGUID read GetMapAttribute write SetMapAttribute stored IsMapAttributeStored; + property ConstKeyword: string index kaKeyConstKeyword read GetKeyAttribute write SetKeyAttribute stored False; + property TypeName: string index kaKeyTypeName read GetKeyAttribute write SetKeyAttribute stored False; + property SetName: string index kaKeySetInterfaceName read GetKeyAttribute write SetKeyAttribute stored False; + property CollectionName: string index vaValueCollectionInterfaceName read GetValueAttribute write SetValueAttribute stored False; + property KeyConstKeyword: string index kaKeyConstKeyword read GetKeyAttribute write SetKeyAttribute stored False; + property KeyTypeName: string index kaKeyTypeName read GetKeyAttribute write SetKeyAttribute stored False; + property KeySetName: string index kaKeySetInterfaceName read GetKeyAttribute write SetKeyAttribute stored False; + property ValueConstKeyword: string index vaValueConstKeyword read GetValueAttribute write SetValueAttribute stored False; + property ValueTypeName: string index vaValueTypeName read GetValueAttribute write SetValueAttribute stored False; + property ValueCollectionName: string index vaValueCollectionInterfaceName read GetValueAttribute write SetValueAttribute stored False; + end; + + (* QUEUE(INTERFACENAME, ANCESTORNAME, GUID, CONSTKEYWORD, PARAMETERNAME, TYPENAME) *) + TJclQueueParams = class(TJclContainerIntfAncestorParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property InterfaceName: string index taQueueInterfaceName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property AncestorName; + property GUID: string index taQueueInterfaceGUID read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* SORTEDMAP(INTERFACENAME, ANCESTORNAME, GUID, KEYCONSTKEYWORD, KEYTYPENAME) *) + TJclSortedMapParams = class(TJclContainerIntf2DParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property InterfaceName: string index maSortedMapInterfaceName read GetMapAttribute write SetMapAttribute stored IsMapAttributeStored; + property AncestorName: string index maMapInterfaceName read GetMapAttribute write SetMapAttribute stored False; + property GUID: string index maSortedMapInterfaceGUID read GetMapAttribute write SetMapAttribute stored IsMapAttributeStored; + property KeyConstKeyword: string index kaKeyConstKeyword read GetKeyAttribute write SetKeyAttribute stored False; + property KeyTypeName: string index kaKeyTypeName read GetKeyAttribute write SetKeyAttribute stored False; + end; + + (* SORTEDSET(INTERFACENAME, ANCESTORNAME, GUID, CONSTKEYWORD, TYPENAME) *) + TJclSortedSetParams = class(TJclContainerIntf1DParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property InterfaceName: string index taSortedSetInterfaceName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property AncestorName: string index taSetInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property GUID: string index taSortedSetInterfaceGUID read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* STACK(INTERFACENAME, ANCESTORNAME, GUID, CONSTKEYWORD, PARAMETERNAME, TYPENAME) *) + TJclStackParams = class(TJclContainerIntfAncestorParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property InterfaceName: string index taStackInterfaceName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property AncestorName; + property GUID: string index taStackInterfaceGUID read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + JclStrings; + +procedure RegisterJclContainers; +begin + RegisterContainerParams('ITERPROCEDURE', TJclIterProcedureParams); + RegisterContainerParams('APPLYFUNCTION', TJclApplyFunctionParams); + RegisterContainerParams('COMPAREFUNCTION', TJclCompareFunctionParams); + RegisterContainerParams('EQUALITYCOMPAREFUNCTION', TJclEqualityCompareFunctionParams); + RegisterContainerParams('HASHFUNCTION', TJclHashFunctionParams); + RegisterContainerParams('SORTPROC', TJclSortFunctionParams); + RegisterContainerParams('EQUALITYCOMPARER', TJclEqualityComparerParams); + RegisterContainerParams('COMPARER', TJclComparerParams); + RegisterContainerParams('HASHCONVERTER', TJclHashConverterParams); + RegisterContainerParams('RELEASEEVENT', TJclReleaseEventParams); + RegisterContainerParams('OWNER', TJclOwnerParams); + RegisterContainerParams('ITERATOR', TJclIteratorParams); + RegisterContainerParams('TREEITERATOR', TJclTreeIteratorParams); + RegisterContainerParams('BINTREEITERATOR', TJclBinaryTreeIteratorParams); + RegisterContainerParams('COLLECTION', TJclCollectionParams); + RegisterContainerParams('LIST', TJclListParams); + RegisterContainerParams('ARRAY', TJclArrayParams); + RegisterContainerParams('SET', TJclSetParams); + RegisterContainerParams('TREE', TJclTreeParams); + RegisterContainerParams('MAP', TJclMapParams); + RegisterContainerParams('QUEUE', TJclQueueParams); + RegisterContainerParams('SORTEDMAP', TJclSortedMapParams); + RegisterContainerParams('SORTEDSET', TJclSortedSetParams); + RegisterContainerParams('STACK', TJclStackParams); +end; + +//=== { TJclContainerIntfAncestorParams } ==================================== + +function TJclContainerIntfAncestorParams.GetAncestorName: string; +begin + Result := FAncestorName; + if Result = '' then + Result := TypeInfo.TypeAttributes[taContainerInterfaceName]; + if Result = '' then + Result := 'IJclBaseContainer'; +end; + +function TJclContainerIntfAncestorParams.IsAncestorNameStored: Boolean; +begin + Result := FAncestorName <> ''; +end; + +//=== { TJclIteratorParams } ================================================= + +function TJclIteratorParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taIteratorInterfaceName]; +end; + +function TJclIteratorParams.GetAncestorName: string; +begin + Result := FAncestorName; + if Result = '' then + Result := 'IJclAbstractIterator'; +end; + +//=== { TJclContainerIntfFlatAncestorParams } ================================ + +function TJclContainerIntfFlatAncestorParams.GetAncestorName: string; +begin + Result := FAncestorName; + if Result = '' then + Result := TypeInfo.TypeAttributes[taFlatContainerInterfaceName]; + if Result = '' then + Result := TypeInfo.TypeAttributes[taContainerInterfaceName]; + if Result = '' then + Result := 'IJclBaseContainer'; +end; + +//=== { TJclIterProcedureParams } ============================================ + +function TJclIterProcedureParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taIterateProcedureTypeName]; +end; + +//=== { TJclApplyFunctionParams } ============================================ + +function TJclApplyFunctionParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taApplyFunctionTypeName]; +end; + +//=== { TJclCompareFunctionParams } ========================================== + +function TJclCompareFunctionParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taCompareFunctionTypeName]; +end; + +//=== { TJclEqualityCompareFunctionParams } ================================== + +function TJclEqualityCompareFunctionParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taEqualityCompareFunctionTypeName]; +end; + +//=== { TJclHashFunctionParams } ============================================= + +function TJclHashFunctionParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taHashConvertFunctionTypeName]; +end; + +//=== { TJclSortFunctionParams } ============================================= + +function TJclSortFunctionParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taSortProcedureTypeName]; +end; + +//=== { TJclEqualityComparerParams } ========================================= + +function TJclEqualityComparerParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taEqualityComparerInterfaceName]; +end; + +//=== { TJclComparerParams } ================================================= + +function TJclComparerParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taComparerInterfaceName]; +end; + +//=== { TJclHashConverterParams } ============================================ + +function TJclHashConverterParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taHashConverterInterfaceName]; +end; + +//=== { TJclReleaseEventParams } ============================================= + +function TJclReleaseEventParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taReleaseEventTypeName]; +end; + +//=== { TJclOwnerParams } ==================================================== + +function TJclOwnerParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taOwnershipInterfaceName]; +end; + +function TJclOwnerParams.GetAncestorName: string; +begin + Result := FAncestorName; + if Result = '' then + Result := 'IInterface'; +end; + +function TJclOwnerParams.GetOwnerAdditional: string; +begin + Result := FOwnerAdditional; + if (Result = '') and TypeInfo.TObjectType then + Result := NativeLineBreak + + ' function GetOwnsObjects: Boolean;' + NativeLineBreak + + ' property OwnsObjects: Boolean read GetOwnsObjects;'; +end; + +//=== { TJclTreeIteratorParams } ============================================= + +function TJclTreeIteratorParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taTreeIteratorInterfaceName]; +end; + +//=== { TJclBinaryTreeIteratorParams } ======================================= + +function TJclBinaryTreeIteratorParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taBinaryTreeIteratorInterfaceName]; +end; + +//=== { TJclCollectionParams } =============================================== + +function TJclCollectionParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taCollectionInterfaceName]; +end; + +//=== { TJclListParams } ===================================================== + +function TJclListParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taListInterfaceName]; +end; + +//=== { TJclArrayParams } ==================================================== + +function TJclArrayParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taArrayInterfaceName]; +end; + +//=== { TJclSetParams } ====================================================== + +function TJclSetParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taSetInterfaceName]; +end; + +//=== { TJclTreeParams } ===================================================== + +function TJclTreeParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taTreeInterfaceName]; +end; + +//=== { TJclMapParams } ===================================================== + +function TJclMapParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [maMapInterfaceName]; +end; + +//=== { TJclQueueParams } ==================================================== + +function TJclQueueParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taQueueInterfaceName]; +end; + +//=== { TJclSortedMapParams } ================================================ + +function TJclSortedMapParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [maSortedMapInterfaceName]; +end; + +//=== { TJclSortedSetParams } ================================================ + +function TJclSortedSetParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taSortedSetInterfaceName]; +end; + +//=== { TJclStackParams } ==================================================== + +function TJclStackParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taStackInterfaceName]; +end; + +initialization + RegisterJclContainers; + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclPreProcessorContainerKnownMaps.pas b/3rdParty/JCL/source/common/JclPreProcessorContainerKnownMaps.pas new file mode 100644 index 00000000..3b6b9262 --- /dev/null +++ b/3rdParty/JCL/source/common/JclPreProcessorContainerKnownMaps.pas @@ -0,0 +1,1105 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclContainerKnownMaps.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. } +{ } +{ Contributors: } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclPreProcessorContainerKnownMaps; + +interface + +{$I jcl.inc} + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclPreProcessorContainerTypes, + JclPreProcessorContainerKnownTypes; + +const + IInterfaceIInterfaceKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclIntfIntfMap', + {maMapInterfaceGUID} '{01D05399-4A05-4F3E-92F4-0C236BE77019}', + {maMapInterfaceAncestorName} 'IJclBaseContainer', + {maSortedMapInterfaceName} 'IJclIntfIntfSortedMap', + {maSortedMapInterfaceGUID} '{265A6EB2-4BB3-459F-8813-360FD32A4971}', + {maMapAncestorClassName} 'TJclIntfAbstractContainer', + {maHashMapEntryTypeName} 'TJclIntfIntfHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclIntfIntfHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclIntfIntfHashMapBucket', + {maHashMapClassName} 'TJclIntfIntfHashMap', + {maSortedMapEntryTypeName} 'TJclIntfIntfSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclIntfIntfSortedMapEntryArray', + {maSortedMapClassName} 'TJclIntfIntfSortedMap' ); + KeyAttributes: @IInterfaceKnownType; + ValueAttributes: @IInterfaceKnownType); + + AnsiStringIInterfaceKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclAnsiStrIntfMap', + {maMapInterfaceGUID} '{A4788A96-281A-4924-AA24-03776DDAAD8A}', + {maMapInterfaceAncestorName} 'IJclAnsiStrContainer', + {maSortedMapInterfaceName} 'IJclAnsiStrIntfSortedMap', + {maSortedMapInterfaceGUID} '{706D1C91-5416-4FDC-B6B1-F4C1E8CFCD38}', + {maMapAncestorClassName} 'TJclAnsiStrAbstractContainer', + {maHashMapEntryTypeName} 'TJclAnsiStrIntfHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclAnsiStrIntfHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclAnsiStrIntfHashMapBucket', + {maHashMapClassName} 'TJclAnsiStrIntfHashMap', + {maSortedMapEntryTypeName} 'TJclAnsiStrIntfSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclAnsiStrIntfSortedMapEntryArray', + {maSortedMapClassName} 'TJclAnsiStrIntfSortedMap' ); + KeyAttributes: @AnsiStringKnownType; + ValueAttributes: @IInterfaceKnownType); + + WideStringIInterfaceKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclWideStrIntfMap', + {maMapInterfaceGUID} '{C959AB76-9CF0-4C2C-A2C6-8A1846563FAF}', + {maMapInterfaceAncestorName} 'IJclWideStrContainer', + {maSortedMapInterfaceName} 'IJclWideStrIntfSortedMap', + {maSortedMapInterfaceGUID} '{299FDCFD-2DB7-4D64-BF18-EE3668316430}', + {maMapAncestorClassName} 'TJclWideStrAbstractContainer', + {maHashMapEntryTypeName} 'TJclWideStrIntfHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclWideStrIntfHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclWideStrIntfHashMapBucket', + {maHashMapClassName} 'TJclWideStrIntfHashMap', + {maSortedMapEntryTypeName} 'TJclWideStrIntfSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclWideStrIntfSortedMapEntryArray', + {maSortedMapClassName} 'TJclWideStrIntfSortedMap' ); + KeyAttributes: @WideStringKnownType; + ValueAttributes: @IInterfaceKnownType); + + UnicodeStringIInterfaceKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclUnicodeStrIntfMap', + {maMapInterfaceGUID} '{C83D4F5E-8E66-41E9-83F6-338B44F24BE6}', + {maMapInterfaceAncestorName} 'IJclUnicodeStrContainer', + {maSortedMapInterfaceName} 'IJclUnicodeStrIntfSortedMap', + {maSortedMapInterfaceGUID} '{25FDE916-730D-449A-BA29-852D8A0470B6}', + {maMapAncestorClassName} 'TJclUnicodeStrAbstractContainer', + {maHashMapEntryTypeName} 'TJclUnicodeStrIntfHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclUnicodeStrIntfHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclUnicodeStrIntfHashMapBucket', + {maHashMapClassName} 'TJclUnicodeStrIntfHashMap', + {maSortedMapEntryTypeName} 'TJclUnicodeStrIntfSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclUnicodeStrIntfSortedMapEntryArray', + {maSortedMapClassName} 'TJclUnicodeStrIntfSortedMap' ); + KeyAttributes: @UnicodeStringKnownType; + ValueAttributes: @IInterfaceKnownType); + + StringIInterfaceKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclStrIntfMap', + {maMapInterfaceGUID} '', + {maMapInterfaceAncestorName} 'IJclStrBaseContainer', + {maSortedMapInterfaceName} 'IJclStrIntfSortedMap', + {maSortedMapInterfaceGUID} '', + {maMapAncestorClassName} 'TJclStrAbstractContainer', + {maHashMapEntryTypeName} 'TJclStrIntfHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclStrIntfHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclStrIntfHashMapBucket', + {maHashMapClassName} 'TJclStrIntfHashMap', + {maSortedMapEntryTypeName} 'TJclStrIntfSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclStrIntfSortedMapEntryArray', + {maSortedMapClassName} 'TJclStrIntfSortedMap' ); + KeyAttributes: @StringKnownType; + ValueAttributes: @IInterfaceKnownType); + + IInterfaceAnsiStringKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclIntfAnsiStrMap', + {maMapInterfaceGUID} '{B10E324A-1D98-42FF-B9B4-7F99044591B2}', + {maMapInterfaceAncestorName} 'IJclAnsiStrContainer', + {maSortedMapInterfaceName} 'IJclIntfAnsiStrSortedMap', + {maSortedMapInterfaceGUID} '{96E6AC5E-8C40-4795-9C8A-CFD098B58680}', + {maMapAncestorClassName} 'TJclAnsiStrAbstractContainer', + {maHashMapEntryTypeName} 'TJclIntfAnsiStrHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclIntfAnsiStrHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclIntfAnsiStrHashMapBucket', + {maHashMapClassName} 'TJclIntfAnsiStrHashMap', + {maSortedMapEntryTypeName} 'TJclIntfAnsiStrSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclIntfAnsiStrSortedMapEntryArray', + {maSortedMapClassName} 'TJclIntfAnsiStrSortedMap' ); + KeyAttributes: @IInterfaceKnownType; + ValueAttributes: @AnsiStringKnownType); + + IInterfaceWideStringKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclIntfWideStrMap', + {maMapInterfaceGUID} '{D9FD7887-B840-4636-8A8F-E586663E332C}', + {maMapInterfaceAncestorName} 'IJclWideStrContainer', + {maSortedMapInterfaceName} 'IJclIntfWideStrSortedMap', + {maSortedMapInterfaceGUID} '{FBE3AD2E-2781-4DC0-9E80-027027380E21}', + {maMapAncestorClassName} 'TJclWideStrAbstractContainer', + {maHashMapEntryTypeName} 'TJclIntfWideStrHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclIntfWideStrHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclIntfWideStrHashMapBucket', + {maHashMapClassName} 'TJclIntfWideStrHashMap', + {maSortedMapEntryTypeName} 'TJclIntfWideStrSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclIntfWideStrSortedMapEntryArray', + {maSortedMapClassName} 'TJclIntfWideStrSortedMap' ); + KeyAttributes: @IInterfaceKnownType; + ValueAttributes: @WideStringKnownType); + + IInterfaceUnicodeStringKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclIntfUnicodeStrMap', + {maMapInterfaceGUID} '{40F8B873-B763-4A3C-8EC4-31DB3404BF73}', + {maMapInterfaceAncestorName} 'IJclUnicodeStrContainer', + {maSortedMapInterfaceName} 'IJclIntfUnicodeStrSortedMap', + {maSortedMapInterfaceGUID} '{B0B0CB9B-268B-40D2-94A8-0B8B5BE2E1AC}', + {maMapAncestorClassName} 'TJclUnicodeStrAbstractContainer', + {maHashMapEntryTypeName} 'TJclIntfUnicodeStrHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclIntfUnicodeStrHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclIntfUnicodeStrHashMapBucket', + {maHashMapClassName} 'TJclIntfUnicodeStrHashMap', + {maSortedMapEntryTypeName} 'TJclIntfUnicodeStrSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclIntfUnicodeStrSortedMapEntryArray', + {maSortedMapClassName} 'TJclIntfUnicodeStrSortedMap' ); + KeyAttributes: @IInterfaceKnownType; + ValueAttributes: @UnicodeStringKnownType); + + IInterfaceStringKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclIntfStrMap', + {maMapInterfaceGUID} '', + {maMapInterfaceAncestorName} 'IJclStrBaseContainer', + {maSortedMapInterfaceName} 'IJclIntfStrSortedMap', + {maSortedMapInterfaceGUID} '', + {maMapAncestorClassName} 'TJclStrAbstractContainer', + {maHashMapEntryTypeName} 'TJclIntfStrHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclIntfStrHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclIntfStrHashMapBucket', + {maHashMapClassName} 'TJclIntfStrHashMap', + {maSortedMapEntryTypeName} 'TJclIntfStrSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclIntfStrSortedMapEntryArray', + {maSortedMapClassName} 'TJclIntfStrSortedMap' ); + KeyAttributes: @IInterfaceKnownType; + ValueAttributes: @StringKnownType); + + AnsiStringAnsiStringKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclAnsiStrAnsiStrMap', + {maMapInterfaceGUID} '{B01D6C80-E120-4BC2-AA93-3DEE18A19B7A}', + {maMapInterfaceAncestorName} 'IJclAnsiStrContainer', + {maSortedMapInterfaceName} 'IJclAnsiStrAnsiStrSortedMap', + {maSortedMapInterfaceGUID} '{4F457799-5D03-413D-A46C-067DC4200CC3}', + {maMapAncestorClassName} 'TJclAnsiStrAbstractContainer', + {maHashMapEntryTypeName} 'TJclAnsiStrAnsiStrHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclAnsiStrAnsiStrHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclAnsiStrAnsiStrHashMapBucket', + {maHashMapClassName} 'TJclAnsiStrAnsiStrHashMap', + {maSortedMapEntryTypeName} 'TJclAnsiStrAnsiStrSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclAnsiStrAnsiStrSortedMapEntryArray', + {maSortedMapClassName} 'TJclAnsiStrAnsiStrSortedMap' ); + KeyAttributes: @AnsiStringKnownType; + ValueAttributes: @AnsiStringKnownType); + + WideStringWideStringKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclWideStrWideStrMap', + {maMapInterfaceGUID} '{8E8D2735-C4FB-4F00-8802-B2102BCE3644}', + {maMapInterfaceAncestorName} 'IJclWideStrContainer', + {maSortedMapInterfaceName} 'IJclWideStrWideStrSortedMap', + {maSortedMapInterfaceGUID} '{3B0757B2-2290-4AFA-880D-F9BA600E501E}', + {maMapAncestorClassName} 'TJclWideStrAbstractContainer', + {maHashMapEntryTypeName} 'TJclWideStrWideStrHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclWideStrWideStrHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclWideStrWideStrHashMapBucket', + {maHashMapClassName} 'TJclWideStrWideStrHashMap', + {maSortedMapEntryTypeName} 'TJclWideStrWideStrSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclWideStrWideStrSortedMapEntryArray', + {maSortedMapClassName} 'TJclWideStrWideStrSortedMap' ); + KeyAttributes: @WideStringKnownType; + ValueAttributes: @WideStringKnownType); + + UnicodeStringUnicodeStringKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclUnicodeStrUnicodeStrMap', + {maMapInterfaceGUID} '{557E1CBD-06AC-41C2-BAED-253709CBD0AE}', + {maMapInterfaceAncestorName} 'IJclUnicodeStrContainer', + {maSortedMapInterfaceName} 'IJclUnicodeStrUnicodeStrSortedMap', + {maSortedMapInterfaceGUID} '{D8EACC5D-B31E-47A8-9CC9-32B15A79CACA}', + {maMapAncestorClassName} 'TJclUnicodeStrAbstractContainer', + {maHashMapEntryTypeName} 'TJclUnicodeStrUnicodeStrHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclUnicodeStrUnicodeStrHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclUnicodeStrUnicodeStrHashMapBucket', + {maHashMapClassName} 'TJclUnicodeStrUnicodeStrHashMap', + {maSortedMapEntryTypeName} 'TJclUnicodeStrUnicodeStrSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclUnicodeStrUnicodeStrSortedMapEntryArray', + {maSortedMapClassName} 'TJclUnicodeStrUnicodeStrSortedMap' ); + KeyAttributes: @UnicodeStringKnownType; + ValueAttributes: @UnicodeStringKnownType); + + StringStringKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclStrStrMap', + {maMapInterfaceGUID} '', + {maMapInterfaceAncestorName} 'IJclStrBaseContainer', + {maSortedMapInterfaceName} 'IJclStrStrSortedMap', + {maSortedMapInterfaceGUID} '', + {maMapAncestorClassName} 'TJclStrAbstractContainer', + {maHashMapEntryTypeName} 'TJclStrStrHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclStrStrHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclStrStrHashMapBucket', + {maHashMapClassName} 'TJclStrStrHashMap', + {maSortedMapEntryTypeName} 'TJclStrStrSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclStrStrSortedMapEntryArray', + {maSortedMapClassName} 'TJclStrStrSortedMap' ); + KeyAttributes: @StringKnownType; + ValueAttributes: @StringKnownType); + + SingleIInterfaceKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclSingleIntfMap', + {maMapInterfaceGUID} '{5F5E9E8B-E648-450B-B6C0-0EC65CC2D0BA}', + {maMapInterfaceAncestorName} 'IJclSingleContainer', + {maSortedMapInterfaceName} 'IJclSingleIntfSortedMap', + {maSortedMapInterfaceGUID} '{83D57068-7B8E-453E-B35B-2AB4B594A7A9}', + {maMapAncestorClassName} 'TJclSingleAbstractContainer', + {maHashMapEntryTypeName} 'TJclSingleIntfHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclSingleIntfHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclSingleIntfHashMapBucket', + {maHashMapClassName} 'TJclSingleIntfHashMap', + {maSortedMapEntryTypeName} 'TJclSingleIntfSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclSingleIntfSortedMapEntryArray', + {maSortedMapClassName} 'TJclSingleIntfSortedMap' ); + KeyAttributes: @SingleKnownType; + ValueAttributes: @IInterfaceKnownType); + + IInterfaceSingleKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclIntfSingleMap', + {maMapInterfaceGUID} '{234D1618-FB0E-46F5-A70D-5106163A90F7}', + {maMapInterfaceAncestorName} 'IJclSingleContainer', + {maSortedMapInterfaceName} 'IJclIntfSingleSortedMap', + {maSortedMapInterfaceGUID} '{B07FA192-3466-4F2A-BBF0-2DC0100B08A8}', + {maMapAncestorClassName} 'TJclSingleAbstractContainer', + {maHashMapEntryTypeName} 'TJclIntfSingleHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclIntfSingleHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclIntfSingleHashMapBucket', + {maHashMapClassName} 'TJclIntfSingleHashMap', + {maSortedMapEntryTypeName} 'TJclIntfSingleSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclIntfSingleSortedMapEntryArray', + {maSortedMapClassName} 'TJclIntfSingleSortedMap' ); + KeyAttributes: @IInterfaceKnownType; + ValueAttributes: @SingleKnownType); + + SingleSingleKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclSingleSingleMap', + {maMapInterfaceGUID} '{AEB0008F-F3CF-4055-A7F3-A330D312F03F}', + {maMapInterfaceAncestorName} 'IJclSingleContainer', + {maSortedMapInterfaceName} 'IJclSingleSingleSortedMap', + {maSortedMapInterfaceGUID} '{7C6EA0B4-959D-44D5-915F-99DFC1753B00}', + {maMapAncestorClassName} 'TJclSingleAbstractContainer', + {maHashMapEntryTypeName} 'TJclSingleSingleHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclSingleSingleHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclSingleSingleHashMapBucket', + {maHashMapClassName} 'TJclSingleSingleHashMap', + {maSortedMapEntryTypeName} 'TJclSingleSingleSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclSingleSingleSortedMapEntryArray', + {maSortedMapClassName} 'TJclSingleSingleSortedMap' ); + KeyAttributes: @SingleKnownType; + ValueAttributes: @SingleKnownType); + + DoubleIInterfaceKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclDoubleIntfMap', + {maMapInterfaceGUID} '{08968FFB-36C6-4FBA-BC09-3DCA2B5D7A50}', + {maMapInterfaceAncestorName} 'IJclDoubleContainer', + {maSortedMapInterfaceName} 'IJclDoubleIntfSortedMap', + {maSortedMapInterfaceGUID} '{F36C5F4F-4F8C-4943-AA35-41623D3C21E9}', + {maMapAncestorClassName} 'TJclDoubleAbstractContainer', + {maHashMapEntryTypeName} 'TJclDoubleIntfHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclDoubleIntfHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclDoubleIntfHashMapBucket', + {maHashMapClassName} 'TJclDoubleIntfHashMap', + {maSortedMapEntryTypeName} 'TJclDoubleIntfSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclDoubleIntfSortedMapEntryArray', + {maSortedMapClassName} 'TJclDoubleIntfSortedMap' ); + KeyAttributes: @DoubleKnownType; + ValueAttributes: @IInterfaceKnownType); + + IInterfaceDoubleKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclIntfDoubleMap', + {maMapInterfaceGUID} '{B23DAF6A-6DC5-4DDD-835C-CD4633DDA010}', + {maMapInterfaceAncestorName} 'IJclDoubleContainer', + {maSortedMapInterfaceName} 'IJclIntfDoubleSortedMap', + {maSortedMapInterfaceGUID} '{0F16ADAE-F499-4857-B5EA-6F3CC9009DBA}', + {maMapAncestorClassName} 'TJclDoubleAbstractContainer', + {maHashMapEntryTypeName} 'TJclIntfDoubleHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclIntfDoubleHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclIntfDoubleHashMapBucket', + {maHashMapClassName} 'TJclIntfDoubleHashMap', + {maSortedMapEntryTypeName} 'TJclIntfDoubleSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclIntfDoubleSortedMapEntryArray', + {maSortedMapClassName} 'TJclIntfDoubleSortedMap' ); + KeyAttributes: @IInterfaceKnownType; + ValueAttributes: @DoubleKnownType); + + DoubleDoubleKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclDoubleDoubleMap', + {maMapInterfaceGUID} '{329A03B8-0B6B-4FE3-87C5-4B63447A5FFD}', + {maMapInterfaceAncestorName} 'IJclDoubleContainer', + {maSortedMapInterfaceName} 'IJclDoubleDoubleSortedMap', + {maSortedMapInterfaceGUID} '{855C858B-74CF-4338-872B-AF88A02DB537}', + {maMapAncestorClassName} 'TJclDoubleAbstractContainer', + {maHashMapEntryTypeName} 'TJclDoubleDoubleHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclDoubleDoubleHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclDoubleDoubleHashMapBucket', + {maHashMapClassName} 'TJclDoubleDoubleHashMap', + {maSortedMapEntryTypeName} 'TJclDoubleDoubleSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclDoubleDoubleSortedMapEntryArray', + {maSortedMapClassName} 'TJclDoubleDoubleSortedMap' ); + KeyAttributes: @DoubleKnownType; + ValueAttributes: @DoubleKnownType); + + ExtendedIInterfaceKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclExtendedIntfMap', + {maMapInterfaceGUID} '{7C0731E0-C9AB-4378-B1B0-8CE3DD60AD41}', + {maMapInterfaceAncestorName} 'IJclExtendedContainer', + {maSortedMapInterfaceName} 'IJclExtendedIntfSortedMap', + {maSortedMapInterfaceGUID} '{A30B8835-A319-4776-9A11-D1EEF60B9C26}', + {maMapAncestorClassName} 'TJclExtendedAbstractContainer', + {maHashMapEntryTypeName} 'TJclExtendedIntfHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclExtendedIntfHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclExtendedIntfHashMapBucket', + {maHashMapClassName} 'TJclExtendedIntfHashMap', + {maSortedMapEntryTypeName} 'TJclExtendedIntfSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclExtendedIntfSortedMapEntryArray', + {maSortedMapClassName} 'TJclExtendedIntfSortedMap' ); + KeyAttributes: @ExtendedKnownType; + ValueAttributes: @IInterfaceKnownType); + + IInterfaceExtendedKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclIntfExtendedMap', + {maMapInterfaceGUID} '{479FCE5A-2D8A-44EE-96BC-E8DA3187DBD8}', + {maMapInterfaceAncestorName} 'IJclExtendedContainer', + {maSortedMapInterfaceName} 'IJclIntfExtendedSortedMap', + {maSortedMapInterfaceGUID} '{3493D6C4-3075-48B6-8E99-CB0000D3978C}', + {maMapAncestorClassName} 'TJclExtendedAbstractContainer', + {maHashMapEntryTypeName} 'TJclIntfExtendedHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclIntfExtendedHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclIntfExtendedHashMapBucket', + {maHashMapClassName} 'TJclIntfExtendedHashMap', + {maSortedMapEntryTypeName} 'TJclIntfExtendedSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclIntfExtendedSortedMapEntryArray', + {maSortedMapClassName} 'TJclIntfExtendedSortedMap' ); + KeyAttributes: @IInterfaceKnownType; + ValueAttributes: @ExtendedKnownType); + + ExtendedExtendedKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclExtendedExtendedMap', + {maMapInterfaceGUID} '{962C2B09-8CF5-44E8-A21A-4A7DAFB72A11}', + {maMapInterfaceAncestorName} 'IJclExtendedContainer', + {maSortedMapInterfaceName} 'IJclExtendedExtendedSortedMap', + {maSortedMapInterfaceGUID} '{8CAA505C-D9BB-47E7-92EC-6043DC4AF42C}', + {maMapAncestorClassName} 'TJclExtendedAbstractContainer', + {maHashMapEntryTypeName} 'TJclExtendedExtendedHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclExtendedExtendedHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclExtendedExtendedHashMapBucket', + {maHashMapClassName} 'TJclExtendedExtendedHashMap', + {maSortedMapEntryTypeName} 'TJclExtendedExtendedSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclExtendedExtendedSortedMapEntryArray', + {maSortedMapClassName} 'TJclExtendedExtendedSortedMap' ); + KeyAttributes: @ExtendedKnownType; + ValueAttributes: @ExtendedKnownType); + + FloatIInterfaceKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclFloatIntfMap', + {maMapInterfaceGUID} '', + {maMapInterfaceAncestorName} 'IJclFloatContainer', + {maSortedMapInterfaceName} 'IJclFloatIntfSortedMap', + {maSortedMapInterfaceGUID} '', + {maMapAncestorClassName} 'TJclFloatAbstractContainer', + {maHashMapEntryTypeName} 'TJclFloatIntfHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclFloatIntfHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclFloatIntfHashMapBucket', + {maHashMapClassName} 'TJclFloatIntfHashMap', + {maSortedMapEntryTypeName} 'TJclFloatIntfSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclFloatIntfSortedMapEntryArray', + {maSortedMapClassName} 'TJclFloatIntfSortedMap' ); + KeyAttributes: @FloatKnownType; + ValueAttributes: @IInterfaceKnownType); + + IInterfaceFloatKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclIntfFloatMap', + {maMapInterfaceGUID} '', + {maMapInterfaceAncestorName} 'IJclFloatContainer', + {maSortedMapInterfaceName} 'IJclIntfFloatSortedMap', + {maSortedMapInterfaceGUID} '', + {maMapAncestorClassName} 'TJclFloatAbstractContainer', + {maHashMapEntryTypeName} 'TJclIntfFloatHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclIntfFloatHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclIntfFloatHashMapBucket', + {maHashMapClassName} 'TJclIntfFloatHashMap', + {maSortedMapEntryTypeName} 'TJclIntfFloatSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclIntfFloatSortedMapEntryArray', + {maSortedMapClassName} 'TJclIntfFloatSortedMap' ); + KeyAttributes: @IInterfaceKnownType; + ValueAttributes: @FloatKnownType); + + FloatFloatKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclFloatFloatMap', + {maMapInterfaceGUID} '', + {maMapInterfaceAncestorName} 'IJclFloatContainer', + {maSortedMapInterfaceName} 'IJclFloatFloatSortedMap', + {maSortedMapInterfaceGUID} '{8CAA505C-D9BB-47E7-92EC-6043DC4AF42C}', + {maMapAncestorClassName} 'TJclFloatAbstractContainer', + {maHashMapEntryTypeName} 'TJclFloatFloatHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclFloatFloatHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclFloatFloatHashMapBucket', + {maHashMapClassName} 'TJclFloatFloatHashMap', + {maSortedMapEntryTypeName} 'TJclFloatFloatSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclFloatFloatSortedMapEntryArray', + {maSortedMapClassName} 'TJclFloatFloatSortedMap' ); + KeyAttributes: @FloatKnownType; + ValueAttributes: @FloatKnownType); + + IntegerIInterfaceKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclIntegerIntfMap', + {maMapInterfaceGUID} '{E535FE65-AC88-49D3-BEF2-FB30D92C2FA6}', + {maMapInterfaceAncestorName} 'IJclBaseContainer', + {maSortedMapInterfaceName} 'IJclIntegerIntfSortedMap', + {maSortedMapInterfaceGUID} '{8B22802C-61F2-4DA5-B1E9-DBB7840E7996}', + {maMapAncestorClassName} 'TJclIntegerAbstractContainer', + {maHashMapEntryTypeName} 'TJclIntegerIntfHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclIntegerIntfHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclIntegerIntfHashMapBucket', + {maHashMapClassName} 'TJclIntegerIntfHashMap', + {maSortedMapEntryTypeName} 'TJclIntegerIntfSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclIntegerIntfSortedMapEntryArray', + {maSortedMapClassName} 'TJclIntegerIntfSortedMap' ); + KeyAttributes: @IntegerKnownType; + ValueAttributes: @IInterfaceKnownType); + + IInterfaceIntegerKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclIntfIntegerMap', + {maMapInterfaceGUID} '{E01DA012-BEE0-4259-8E30-0A7A1A87BED0}', + {maMapInterfaceAncestorName} 'IJclBaseContainer', + {maSortedMapInterfaceName} 'IJclIntfIntegerSortedMap', + {maSortedMapInterfaceGUID} '{8D3C9B7E-772D-409B-A58C-0CABFAFDEFF0}', + {maMapAncestorClassName} 'TJclIntegerAbstractContainer', + {maHashMapEntryTypeName} 'TJclIntfIntegerHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclIntfIntegerHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclIntfIntegerHashMapBucket', + {maHashMapClassName} 'TJclIntfIntegerHashMap', + {maSortedMapEntryTypeName} 'TJclIntfIntegerSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclIntfIntegerSortedMapEntryArray', + {maSortedMapClassName} 'TJclIntfIntegerSortedMap' ); + KeyAttributes: @IInterfaceKnownType; + ValueAttributes: @IntegerKnownType); + + IntegerIntegerKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclIntegerIntegerMap', + {maMapInterfaceGUID} '{23A46BC0-DF8D-4BD2-89D2-4DACF1EC73A1}', + {maMapInterfaceAncestorName} 'IJclBaseContainer', + {maSortedMapInterfaceName} 'IJclIntegerIntegerSortedMap', + {maSortedMapInterfaceGUID} '{8A8BA17A-F468-469C-AF99-77D64C802F7A}', + {maMapAncestorClassName} 'TJclIntegerAbstractContainer', + {maHashMapEntryTypeName} 'TJclIntegerIntegerHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclIntegerIntegerHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclIntegerIntegerHashMapBucket', + {maHashMapClassName} 'TJclIntegerIntegerHashMap', + {maSortedMapEntryTypeName} 'TJclIntegerIntegerSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclIntegerIntegerSortedMapEntryArray', + {maSortedMapClassName} 'TJclIntegerIntegerSortedMap' ); + KeyAttributes: @IntegerKnownType; + ValueAttributes: @IntegerKnownType); + + CardinalIInterfaceKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclCardinalIntfMap', + {maMapInterfaceGUID} '{80D39FB1-0D10-49CE-8AF3-1CD98A1D4F6C}', + {maMapInterfaceAncestorName} 'IJclBaseContainer', + {maSortedMapInterfaceName} 'IJclCardinalIntfSortedMap', + {maSortedMapInterfaceGUID} '{BAE97425-4F2E-461B-88DD-F83D27657AFA}', + {maMapAncestorClassName} 'TJclCardinalAbstractContainer', + {maHashMapEntryTypeName} 'TJclCardinalIntfHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclCardinalIntfHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclCardinalIntfHashMapBucket', + {maHashMapClassName} 'TJclCardinalIntfHashMap', + {maSortedMapEntryTypeName} 'TJclCardinalIntfSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclCardinalIntfSortedMapEntryArray', + {maSortedMapClassName} 'TJclCardinalIntfSortedMap' ); + KeyAttributes: @CardinalKnownType; + ValueAttributes: @IInterfaceKnownType); + + IInterfaceCardinalKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclIntfCardinalMap', + {maMapInterfaceGUID} '{E1A724AB-6BDA-45F0-AE21-5E7E789A751B}', + {maMapInterfaceAncestorName} 'IJclBaseContainer', + {maSortedMapInterfaceName} 'IJclIntfCardinalSortedMap', + {maSortedMapInterfaceGUID} '{BC66BACF-23AE-48C4-9573-EDC3B5110BE7}', + {maMapAncestorClassName} 'TJclCardinalAbstractContainer', + {maHashMapEntryTypeName} 'TJclIntfCardinalHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclIntfCardinalHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclIntfCardinalHashMapBucket', + {maHashMapClassName} 'TJclIntfCardinalHashMap', + {maSortedMapEntryTypeName} 'TJclIntfCardinalSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclIntfCardinalSortedMapEntryArray', + {maSortedMapClassName} 'TJclIntfCardinalSortedMap' ); + KeyAttributes: @IInterfaceKnownType; + ValueAttributes: @CardinalKnownType); + + CardinalCardinalKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclCardinalCardinalMap', + {maMapInterfaceGUID} '{1CD3F54C-F92F-4AF4-82B2-0829C08AA83B}', + {maMapInterfaceAncestorName} 'IJclBaseContainer', + {maSortedMapInterfaceName} 'IJclCardinalCardinalSortedMap', + {maSortedMapInterfaceGUID} '{182ACDA4-7D74-4D29-BB5C-4C8189DA774E}', + {maMapAncestorClassName} 'TJclCardinalAbstractContainer', + {maHashMapEntryTypeName} 'TJclCardinalCardinalHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclCardinalCardinalHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclCardinalCardinalHashMapBucket', + {maHashMapClassName} 'TJclCardinalCardinalHashMap', + {maSortedMapEntryTypeName} 'TJclCardinalCardinalSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclCardinalCardinalSortedMapEntryArray', + {maSortedMapClassName} 'TJclCardinalCardinalSortedMap' ); + KeyAttributes: @CardinalKnownType; + ValueAttributes: @CardinalKnownType); + + Int64IInterfaceKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclInt64IntfMap', + {maMapInterfaceGUID} '{B64FB2D1-8D45-4367-B950-98D3D05AC6A0}', + {maMapInterfaceAncestorName} 'IJclBaseContainer', + {maSortedMapInterfaceName} 'IJclInt64IntfSortedMap', + {maSortedMapInterfaceGUID} '{24391756-FB02-4901-81E3-A37738B73DAD}', + {maMapAncestorClassName} 'TJclInt64AbstractContainer', + {maHashMapEntryTypeName} 'TJclInt64IntfHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclInt64IntfHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclInt64IntfHashMapBucket', + {maHashMapClassName} 'TJclInt64IntfHashMap', + {maSortedMapEntryTypeName} 'TJclInt64IntfSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclInt64IntfSortedMapEntryArray', + {maSortedMapClassName} 'TJclInt64IntfSortedMap' ); + KeyAttributes: @Int64KnownType; + ValueAttributes: @IInterfaceKnownType); + + IInterfaceInt64KnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclIntfInt64Map', + {maMapInterfaceGUID} '{9886BEE3-D15B-45D2-A3FB-4D3A0ADEC8AC}', + {maMapInterfaceAncestorName} 'IJclBaseContainer', + {maSortedMapInterfaceName} 'IJclIntfInt64SortedMap', + {maSortedMapInterfaceGUID} '{6E2AB647-59CC-4609-82E8-6AE75AED80CA}', + {maMapAncestorClassName} 'TJclInt64AbstractContainer', + {maHashMapEntryTypeName} 'TJclIntfInt64HashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclIntfInt64HashMapEntryArray', + {maHashMapBucketTypeName} 'TJclIntfInt64HashMapBucket', + {maHashMapClassName} 'TJclIntfInt64HashMap', + {maSortedMapEntryTypeName} 'TJclIntfInt64SortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclIntfInt64SortedMapEntryArray', + {maSortedMapClassName} 'TJclIntfInt64SortedMap' ); + KeyAttributes: @IInterfaceKnownType; + ValueAttributes: @Int64KnownType); + + Int64Int64KnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclInt64Int64Map', + {maMapInterfaceGUID} '{EF2A2726-408A-4984-9971-DDC1B6EFC9F5}', + {maMapInterfaceAncestorName} 'IJclBaseContainer', + {maSortedMapInterfaceName} 'IJclInt64Int64SortedMap', + {maSortedMapInterfaceGUID} '{168581D2-9DD3-46D0-934E-EA0CCE5E3C0C}', + {maMapAncestorClassName} 'TJclInt64AbstractContainer', + {maHashMapEntryTypeName} 'TJclInt64Int64HashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclInt64Int64HashMapEntryArray', + {maHashMapBucketTypeName} 'TJclInt64Int64HashMapBucket', + {maHashMapClassName} 'TJclInt64Int64HashMap', + {maSortedMapEntryTypeName} 'TJclInt64Int64SortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclInt64Int64SortedMapEntryArray', + {maSortedMapClassName} 'TJclInt64Int64SortedMap' ); + KeyAttributes: @Int64KnownType; + ValueAttributes: @Int64KnownType); + + PointerIInterfaceKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclPtrIntfMap', + {maMapInterfaceGUID} '{B7C48542-39A0-453F-8F03-8C8CFAB0DCCF}', + {maMapInterfaceAncestorName} 'IJclBaseContainer', + {maSortedMapInterfaceName} 'IJclPtrIntfSortedMap', + {maSortedMapInterfaceGUID} '{6D7B8042-3CBC-4C8F-98B5-69AFAA104532}', + {maMapAncestorClassName} 'TJclPtrAbstractContainer', + {maHashMapEntryTypeName} 'TJclPtrIntfHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclPtrIntfHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclPtrIntfHashMapBucket', + {maHashMapClassName} 'TJclPtrIntfHashMap', + {maSortedMapEntryTypeName} 'TJclPtrIntfSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclPtrIntfSortedMapEntryArray', + {maSortedMapClassName} 'TJclPtrIntfSortedMap' ); + KeyAttributes: @PointerKnownType; + ValueAttributes: @IInterfaceKnownType); + + IInterfacePointerKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclIntfPtrMap', + {maMapInterfaceGUID} '{DA51D823-58DB-4D7C-9B8E-07E0FD560B57}', + {maMapInterfaceAncestorName} 'IJclBaseContainer', + {maSortedMapInterfaceName} 'IJclIntfPtrSortedMap', + {maSortedMapInterfaceGUID} '{B054BDA2-536F-4C16-B6BB-BB64FA0818B3}', + {maMapAncestorClassName} 'TJclPtrAbstractContainer', + {maHashMapEntryTypeName} 'TJclIntfPtrHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclIntfPtrHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclIntfPtrHashMapBucket', + {maHashMapClassName} 'TJclIntfPtrHashMap', + {maSortedMapEntryTypeName} 'TJclIntfPtrSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclIntfPtrSortedMapEntryArray', + {maSortedMapClassName} 'TJclIntfPtrSortedMap' ); + KeyAttributes: @IInterfaceKnownType; + ValueAttributes: @PointerKnownType); + + PointerPointerKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclPtrPtrMap', + {maMapInterfaceGUID} '{1200CB0F-A766-443F-9030-5A804C11B798}', + {maMapInterfaceAncestorName} 'IJclBaseContainer', + {maSortedMapInterfaceName} 'IJclPtrPtrSortedMap', + {maSortedMapInterfaceGUID} '{F1FAE922-0212-41D0-BB4E-76A8AB2CAB86}', + {maMapAncestorClassName} 'TJclPtrAbstractContainer', + {maHashMapEntryTypeName} 'TJclPtrPtrHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclPtrPtrHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclPtrPtrHashMapBucket', + {maHashMapClassName} 'TJclPtrPtrHashMap', + {maSortedMapEntryTypeName} 'TJclPtrPtrSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclPtrPtrSortedMapEntryArray', + {maSortedMapClassName} 'TJclPtrPtrSortedMap' ); + KeyAttributes: @PointerKnownType; + ValueAttributes: @PointerKnownType); + + IInterfaceTObjectKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclIntfMap', + {maMapInterfaceGUID} '{C70570C6-EDDB-47B4-9003-C637B486731D}', + {maMapInterfaceAncestorName} 'IJclBaseContainer', + {maSortedMapInterfaceName} 'IJclIntfSortedMap', + {maSortedMapInterfaceGUID} '{3CED1477-B958-4109-9BDA-7C84B9E063B2}', + {maMapAncestorClassName} 'TJclIntfAbstractContainer', + {maHashMapEntryTypeName} 'TJclIntfHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclIntfHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclIntfHashMapBucket', + {maHashMapClassName} 'TJclIntfHashMap', + {maSortedMapEntryTypeName} 'TJclIntfSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclIntfSortedMapEntryArray', + {maSortedMapClassName} 'TJclIntfSortedMap' ); + KeyAttributes: @IInterfaceKnownType; + ValueAttributes: @TObjectKnownType); + + AnsiStringTObjectKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclAnsiStrMap', + {maMapInterfaceGUID} '{A7D0A882-6952-496D-A258-23D47DDCCBC4}', + {maMapInterfaceAncestorName} 'IJclAnsiStrContainer', + {maSortedMapInterfaceName} 'IJclAnsiStrSortedMap', + {maSortedMapInterfaceGUID} '{573F98E3-EBCD-4F28-8F35-96A7366CBF47}', + {maMapAncestorClassName} 'TJclAnsiStrAbstractContainer', + {maHashMapEntryTypeName} 'TJclAnsiStrHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclAnsiStrHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclAnsiStrHashMapBucket', + {maHashMapClassName} 'TJclAnsiStrHashMap', + {maSortedMapEntryTypeName} 'TJclAnsiStrSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclAnsiStrSortedMapEntryArray', + {maSortedMapClassName} 'TJclAnsiStrSortedMap' ); + KeyAttributes: @AnsiStringKnownType; + ValueAttributes: @TObjectKnownType); + + WideStringTObjectKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclWideStrMap', + {maMapInterfaceGUID} '{ACE8E6B4-5A56-4753-A2C6-BAE195A56B63}', + {maMapInterfaceAncestorName} 'IJclWideStrContainer', + {maSortedMapInterfaceName} 'IJclWideStrSortedMap', + {maSortedMapInterfaceGUID} '{B3021EFC-DE25-4B4B-A896-ACE823CD5C01}', + {maMapAncestorClassName} 'TJclWideStrAbstractContainer', + {maHashMapEntryTypeName} 'TJclWideStrHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclWideStrHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclWideStrHashMapBucket', + {maHashMapClassName} 'TJclWideStrHashMap', + {maSortedMapEntryTypeName} 'TJclWideStrSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclWideStrSortedMapEntryArray', + {maSortedMapClassName} 'TJclWideStrSortedMap' ); + KeyAttributes: @WideStringKnownType; + ValueAttributes: @TObjectKnownType); + + UnicodeStringTObjectKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclUnicodeStrMap', + {maMapInterfaceGUID} '{4328E033-9B92-40C6-873D-A6982CFC2B95}', + {maMapInterfaceAncestorName} 'IJclUnicodeStrContainer', + {maSortedMapInterfaceName} 'IJclUnicodeStrSortedMap', + {maSortedMapInterfaceGUID} '{5510B8FC-3439-4211-8D1F-5EDD9A56D3E3}', + {maMapAncestorClassName} 'TJclUnicodeStrAbstractContainer', + {maHashMapEntryTypeName} 'TJclUnicodeStrHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclUnicodeStrHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclUnicodeStrHashMapBucket', + {maHashMapClassName} 'TJclUnicodeStrHashMap', + {maSortedMapEntryTypeName} 'TJclUnicodeStrSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclUnicodeStrSortedMapEntryArray', + {maSortedMapClassName} 'TJclUnicodeStrSortedMap' ); + KeyAttributes: @UnicodeStringKnownType; + ValueAttributes: @TObjectKnownType); + + StringTObjectKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclStrMap', + {maMapInterfaceGUID} '', + {maMapInterfaceAncestorName} 'IJclStrBaseContainer', + {maSortedMapInterfaceName} 'IJclStrSortedMap', + {maSortedMapInterfaceGUID} '', + {maMapAncestorClassName} 'TJclStrAbstractContainer', + {maHashMapEntryTypeName} 'TJclStrHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclStrHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclStrHashMapBucket', + {maHashMapClassName} 'TJclStrHashMap', + {maSortedMapEntryTypeName} 'TJclStrSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclStrSortedMapEntryArray', + {maSortedMapClassName} 'TJclStrSortedMap' ); + KeyAttributes: @StringKnownType; + ValueAttributes: @TObjectKnownType); + + SingleTObjectKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclSingleMap', + {maMapInterfaceGUID} '{C501920A-F252-4F94-B142-1F05AE06C3D2}', + {maMapInterfaceAncestorName} 'IJclSingleContainer', + {maSortedMapInterfaceName} 'IJclSingleSortedMap', + {maSortedMapInterfaceGUID} '{8C1A12BE-A7F2-4351-90B7-25DB0AAF5F94}', + {maMapAncestorClassName} 'TJclSingleAbstractContainer', + {maHashMapEntryTypeName} 'TJclSingleHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclSingleHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclSingleHashMapBucket', + {maHashMapClassName} 'TJclSingleHashMap', + {maSortedMapEntryTypeName} 'TJclSingleSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclSingleSortedMapEntryArray', + {maSortedMapClassName} 'TJclSingleSortedMap' ); + KeyAttributes: @SingleKnownType; + ValueAttributes: @TObjectKnownType); + + DoubleTObjectKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclDoubleMap', + {maMapInterfaceGUID} '{B1B994AC-49C9-418B-814B-43BAD706F355}', + {maMapInterfaceAncestorName} 'IJclDoubleContainer', + {maSortedMapInterfaceName} 'IJclDoubleSortedMap', + {maSortedMapInterfaceGUID} '{8018D66B-AA54-4016-84FC-3E780FFCC38B}', + {maMapAncestorClassName} 'TJclDoubleAbstractContainer', + {maHashMapEntryTypeName} 'TJclDoubleHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclDoubleHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclDoubleHashMapBucket', + {maHashMapClassName} 'TJclDoubleHashMap', + {maSortedMapEntryTypeName} 'TJclDoubleSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclDoubleSortedMapEntryArray', + {maSortedMapClassName} 'TJclDoubleSortedMap' ); + KeyAttributes: @DoubleKnownType; + ValueAttributes: @TObjectKnownType); + + ExtendedTObjectKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclExtendedMap', + {maMapInterfaceGUID} '{3BCC8C87-A186-45E8-9B37-0B8E85120434}', + {maMapInterfaceAncestorName} 'IJclExtendedContainer', + {maSortedMapInterfaceName} 'IJclExtendedSortedMap', + {maSortedMapInterfaceGUID} '{2B82C65A-B3EF-477D-BEC0-3D8620A226B1}', + {maMapAncestorClassName} 'TJclExtendedAbstractContainer', + {maHashMapEntryTypeName} 'TJclExtendedHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclExtendedHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclExtendedHashMapBucket', + {maHashMapClassName} 'TJclExtendedHashMap', + {maSortedMapEntryTypeName} 'TJclExtendedSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclExtendedSortedMapEntryArray', + {maSortedMapClassName} 'TJclExtendedSortedMap' ); + KeyAttributes: @ExtendedKnownType; + ValueAttributes: @TObjectKnownType); + + FloatTObjectKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclFloatMap', + {maMapInterfaceGUID} '', + {maMapInterfaceAncestorName} 'IJclFloatContainer', + {maSortedMapInterfaceName} 'IJclFloatSortedMap', + {maSortedMapInterfaceGUID} '', + {maMapAncestorClassName} 'TJclFloatAbstractContainer', + {maHashMapEntryTypeName} 'TJclFloatHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclFloatHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclFloatHashMapBucket', + {maHashMapClassName} 'TJclFloatHashMap', + {maSortedMapEntryTypeName} 'TJclFloatSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclFloatSortedMapEntryArray', + {maSortedMapClassName} 'TJclFloatSortedMap' ); + KeyAttributes: @FloatKnownType; + ValueAttributes: @TObjectKnownType); + + IntegerTObjectKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclIntegerMap', + {maMapInterfaceGUID} '{D6FA5D64-A4AF-4419-9981-56BA79BF8770}', + {maMapInterfaceAncestorName} 'IJclBaseContainer', + {maSortedMapInterfaceName} 'IJclIntegerSortedMap', + {maSortedMapInterfaceGUID} '{DD7B4C5E-6D51-44CC-9328-B38396A7E1C9}', + {maMapAncestorClassName} 'TJclIntegerAbstractContainer', + {maHashMapEntryTypeName} 'TJclIntegerHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclIntegerHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclIntegerHashMapBucket', + {maHashMapClassName} 'TJclIntegerHashMap', + {maSortedMapEntryTypeName} 'TJclIntegerSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclIntegerSortedMapEntryArray', + {maSortedMapClassName} 'TJclIntegerSortedMap' ); + KeyAttributes: @IntegerKnownType; + ValueAttributes: @TObjectKnownType); + + CardinalTObjectKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclCardinalMap', + {maMapInterfaceGUID} '{A2F92F4F-11CB-4DB2-932F-F10A14237126}', + {maMapInterfaceAncestorName} 'IJclBaseContainer', + {maSortedMapInterfaceName} 'IJclCardinalSortedMap', + {maSortedMapInterfaceGUID} '{4AEAF81F-D72E-4499-B10E-3D017F39915E}', + {maMapAncestorClassName} 'TJclCardinalAbstractContainer', + {maHashMapEntryTypeName} 'TJclCardinalHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclCardinalHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclCardinalHashMapBucket', + {maHashMapClassName} 'TJclCardinalHashMap', + {maSortedMapEntryTypeName} 'TJclCardinalSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclCardinalSortedMapEntryArray', + {maSortedMapClassName} 'TJclCardinalSortedMap' ); + KeyAttributes: @CardinalKnownType; + ValueAttributes: @TObjectKnownType); + + Int64TObjectKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclInt64Map', + {maMapInterfaceGUID} '{4C720CE0-7A7C-41D5-BFC1-8D58A47E648F}', + {maMapInterfaceAncestorName} 'IJclBaseContainer', + {maSortedMapInterfaceName} 'IJclInt64SortedMap', + {maSortedMapInterfaceGUID} '{06C03F90-7DE9-4043-AA56-AAE071D8BD50}', + {maMapAncestorClassName} 'TJclInt64AbstractContainer', + {maHashMapEntryTypeName} 'TJclInt64HashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclInt64HashMapEntryArray', + {maHashMapBucketTypeName} 'TJclInt64HashMapBucket', + {maHashMapClassName} 'TJclInt64HashMap', + {maSortedMapEntryTypeName} 'TJclInt64SortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclInt64SortedMapEntryArray', + {maSortedMapClassName} 'TJclInt64SortedMap' ); + KeyAttributes: @Int64KnownType; + ValueAttributes: @TObjectKnownType); + + PointerTObjectKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclPtrMap', + {maMapInterfaceGUID} '{2FE029A9-026C-487D-8204-AD3A28BD2FA2}', + {maMapInterfaceAncestorName} 'IJclBaseContainer', + {maSortedMapInterfaceName} 'IJclPtrSortedMap', + {maSortedMapInterfaceGUID} '{578918DB-6A4A-4A9D-B44E-AE3E8FF70818}', + {maMapAncestorClassName} 'TJclPtrAbstractContainer', + {maHashMapEntryTypeName} 'TJclPtrHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclPtrHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclPtrHashMapBucket', + {maHashMapClassName} 'TJclPtrHashMap', + {maSortedMapEntryTypeName} 'TJclPtrSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclPtrSortedMapEntryArray', + {maSortedMapClassName} 'TJclPtrSortedMap' ); + KeyAttributes: @PointerKnownType; + ValueAttributes: @TObjectKnownType); + + TObjectTObjectKnownMap: TKnownMapAttributes = + (MapAttributes: + ( {maMapInterfaceName} 'IJclMap', + {maMapInterfaceGUID} '{A7D0A882-6952-496D-A258-23D47DDCCBC4}', + {maMapInterfaceAncestorName} 'IJclBaseContainer', + {maSortedMapInterfaceName} 'IJclSortedMap', + {maSortedMapInterfaceGUID} '{F317A70F-7851-49C2-9DCF-092D8F4D4F98}', + {maMapAncestorClassName} 'TJclAbstractContainerBase', + {maHashMapEntryTypeName} 'TJclHashMapEntry', + {maHashMapEntryArrayTypeName} 'TJclHashMapEntryArray', + {maHashMapBucketTypeName} 'TJclHashMapBucket', + {maHashMapClassName} 'TJclHashMap', + {maSortedMapEntryTypeName} 'TJclSortedMapEntry', + {maSortedMapEntryArrayTypeName} 'TJclSortedMapEntryArray', + {maSortedMapClassName} 'TJclSortedMap' ); + KeyAttributes: @TObjectKnownType; + ValueAttributes: @TObjectKnownType); + + KnownAllMaps: array[0..50] of PKnownMapAttributes = + ( @IInterfaceIInterfaceKnownMap, + @AnsiStringIInterfaceKnownMap, + @IInterfaceAnsiStringKnownMap, + @AnsiStringAnsiStringKnownMap, + @WideStringIInterfaceKnownMap, + @IInterfaceWideStringKnownMap, + @WideStringWideStringKnownMap, + @UnicodeStringIInterfaceKnownMap, + @IInterfaceUnicodeStringKnownMap, + @UnicodeStringUnicodeStringKnownMap, + @StringIInterfaceKnownMap, + @IInterfaceStringKnownMap, + @StringStringKnownMap, + @SingleIInterfaceKnownMap, + @IInterfaceSingleKnownMap, + @SingleSingleKnownMap, + @DoubleIInterfaceKnownMap, + @IInterfaceDoubleKnownMap, + @DoubleDoubleKnownMap, + @ExtendedIInterfaceKnownMap, + @IInterfaceExtendedKnownMap, + @ExtendedExtendedKnownMap, + @FloatIInterfaceKnownMap, + @IInterfaceFloatKnownMap, + @FloatFloatKnownMap, + @IntegerIInterfaceKnownMap, + @IInterfaceIntegerKnownMap, + @IntegerIntegerKnownMap, + @CardinalIInterfaceKnownMap, + @IInterfaceCardinalKnownMap, + @CardinalCardinalKnownMap, + @Int64IInterfaceKnownMap, + @IInterfaceInt64KnownMap, + @Int64Int64KnownMap, + @PointerIInterfaceKnownMap, + @IInterfacePointerKnownMap, + @PointerPointerKnownMap, + @IInterfaceTObjectKnownMap, + @AnsiStringTObjectKnownMap, + @WideStringTObjectKnownMap, + @UnicodeStringTObjectKnownMap, + @StringTObjectKnownMap, + @SingleTObjectKnownMap, + @DoubleTObjectKnownMap, + @ExtendedTObjectKnownMap, + @FloatTObjectKnownMap, + @IntegerTObjectKnownMap, + @CardinalTObjectKnownMap, + @Int64TObjectKnownMap, + @PointerTObjectKnownMap, + @TObjectTObjectKnownMap ); + + // same as previous, except without compiler magic types (string) and type aliases (float) + KnownTrueMaps: array[0..42] of PKnownMapAttributes = + ( @IInterfaceIInterfaceKnownMap, + @AnsiStringIInterfaceKnownMap, + @IInterfaceAnsiStringKnownMap, + @AnsiStringAnsiStringKnownMap, + @WideStringIInterfaceKnownMap, + @IInterfaceWideStringKnownMap, + @WideStringWideStringKnownMap, + @UnicodeStringIInterfaceKnownMap, + @IInterfaceUnicodeStringKnownMap, + @UnicodeStringUnicodeStringKnownMap, + @SingleIInterfaceKnownMap, + @IInterfaceSingleKnownMap, + @SingleSingleKnownMap, + @DoubleIInterfaceKnownMap, + @IInterfaceDoubleKnownMap, + @DoubleDoubleKnownMap, + @ExtendedIInterfaceKnownMap, + @IInterfaceExtendedKnownMap, + @ExtendedExtendedKnownMap, + @IntegerIInterfaceKnownMap, + @IInterfaceIntegerKnownMap, + @IntegerIntegerKnownMap, + @CardinalIInterfaceKnownMap, + @IInterfaceCardinalKnownMap, + @CardinalCardinalKnownMap, + @Int64IInterfaceKnownMap, + @IInterfaceInt64KnownMap, + @Int64Int64KnownMap, + @PointerIInterfaceKnownMap, + @IInterfacePointerKnownMap, + @PointerPointerKnownMap, + @IInterfaceTObjectKnownMap, + @AnsiStringTObjectKnownMap, + @WideStringTObjectKnownMap, + @UnicodeStringTObjectKnownMap, + @SingleTObjectKnownMap, + @DoubleTObjectKnownMap, + @ExtendedTObjectKnownMap, + @IntegerTObjectKnownMap, + @CardinalTObjectKnownMap, + @Int64TObjectKnownMap, + @PointerTObjectKnownMap, + @TObjectTObjectKnownMap ); + +function IsKnownMap(const KeyName, ValueName: string): PKnownMapAttributes; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +function IsKnownMap(const KeyName, ValueName: string): PKnownMapAttributes; +var + I: Integer; +begin + Result := nil; + for I := Low(KnownAllMaps) to High(KnownAllMaps) do + if SameText(KeyName, KnownAllMaps[I]^.KeyAttributes[taTypeName]) and + SameText(ValueName, KnownAllMaps[I]^.ValueAttributes[taTypeName]) then + begin + Result := KnownAllMaps[I]; + Break; + end; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclPreProcessorContainerKnownTypes.pas b/3rdParty/JCL/source/common/JclPreProcessorContainerKnownTypes.pas new file mode 100644 index 00000000..f5cdb4a6 --- /dev/null +++ b/3rdParty/JCL/source/common/JclPreProcessorContainerKnownTypes.pas @@ -0,0 +1,1517 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclContainerKnownTypes.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. } +{ } +{ Contributors: } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclPreProcessorContainerKnownTypes; + +interface + +{$I jcl.inc} + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclPreProcessorContainerTypes; + +const + IInterfaceKnownType: TKnownTypeAttributes = + ({taTypeName} 'IInterface', + {taCondition} '', + {taDefines} 'REFCOUNTED', + {taUndefs} 'ZEROINIT;GENERIC', + {taAlias} '', + {taAliasCondition} '', + {taDefaultValue} 'nil', + {taConstKeyword} 'const ', + {taOwnershipParameterName} '', + {taOwnershipInterfaceName} 'IJclIntfOwner', + {taOwnershipInterfaceGUID} '{17C1D3FB-BB32-48F2-BD1C-D43EA05A86A8}', + {taReleaserFunctionName} 'FreeObject', + {taReleaseEventName} 'OnFreeObject', + {taReleaseEventTypeName} 'TFreeIntfEvent', + {taGetterFunctionName} 'GetObject', + {taSetterProcedureName} 'SetObject', + {taParameterName} 'AInterface', + {taDynArrayTypeName} 'TDynIInterfaceArray', + {taMoveArrayProcedureName} 'MoveArray', + {taArrayPropertyName} 'Objects', + {taBaseContainerClassName} 'TJclIntfAbstractContainer', + {taBaseCollectionClassName} '', + {taIterateProcedureTypeName} 'TIntfIterateProcedure', + {taIterateProcedureName} 'Iterate', + {taApplyFunctionTypeName} 'TIntfApplyFunction', + {taApplyProcedureName} 'Apply', + {taCompareFunctionTypeName} 'TIntfCompare', + {taSimpleCompareFunctionName} 'IntfSimpleCompare', + {taEqualityCompareFunctionTypeName} 'TIntfEqualityCompare', + {taSimpleEqualityCompareFunctionName} 'IntfSimpleEqualityCompare', + {taHashConvertFunctionTypeName} 'TIntfHashConvert', + {taSimpleHashConvertFunctionName} 'IntfSimpleHashConvert', + {taContainerInterfaceName} 'IJclIntfContainer', + {taContainerInterfaceGUID} '{44F10075-9702-4DCA-9731-D8990F234A74}', + {taFlatContainerInterfaceName} 'IJclIntfFlatContainer', + {taFlatContainerInterfaceGUID} '{15116007-6BB8-4D9D-8249-C2F49D4AB3EA}', + {taEqualityComparerInterfaceName} 'IJclIntfEqualityComparer', + {taEqualityComparerInterfaceGUID} '{5CC2DF51-BE56-4D02-A171-31BAAC097632}', + {taComparerInterfaceName} 'IJclIntfComparer', + {taComparerInterfaceGUID} '{EB41B843-184B-420D-B5DA-27D055B4CD55}', + {taHashConverterInterfaceName} 'IJclIntfHashConverter', + {taHashConverterInterfaceGUID} '{7BAA0791-3B45-4D0F-9CD8-D13B81694786}', + {taIteratorInterfaceName} 'IJclIntfIterator', + {taIteratorInterfaceGUID} '{E121A98A-7C43-4587-806B-9189E8B2F106}', + {taBinaryTreeIteratorInterfaceName} 'IJclIntfBinaryTreeIterator', + {taBinaryTreeIteratorInterfaceGUID} '{8BE874B2-0075-4EE0-8F49-665FC894D923}', + {taBinaryTreeNodeTypeName} 'TJclIntfBinaryNode', + {taBinaryTreeClassName} 'TJclIntfBinaryTree', + {taBinaryTreeBaseIteratorClassName} 'TJclIntfBinaryTreeIterator', + {taBinaryTreePreOrderIteratorClassName} 'TJclPreOrderIntfBinaryTreeIterator', + {taBinaryTreeInOrderIteratorClassName} 'TJclInOrderIntfBinaryTreeIterator', + {taBinaryTreePostOrderIteratorClassName} 'TJclPostOrderIntfBinaryTreeIterator', + {taCollectionInterfaceName} 'IJclIntfCollection', + {taCollectionInterfaceGUID} '{8E178463-4575-487A-B4D5-DC2AED3C7ACA}', + {taListInterfaceName} 'IJclIntfList', + {taListInterfaceGUID} '{E14EDA4B-1DAA-4013-9E6C-CDCB365C7CF9}', + {taSortProcedureTypeName} 'TIntfSortProc', + {taSortProcedureName} 'Sort', + {taQuickSortProcedureName} 'QuickSort', + {taFindFunctionName} 'Find', + {taCountObjectFunctionName} 'CountObject', + {taCopyProcedureName} 'Copy', + {taGenerateProcedureName} 'Generate', + {taFillProcedureName} 'Fill', + {taReverseProcedureName} 'Reverse', + {taArrayInterfaceName} 'IJclIntfArray', + {taArrayInterfaceGUID} '{B055B427-7817-43FC-97D4-AD1845643D63}', + {taArrayListClassName} 'TJclIntfArrayList', + {taArrayIteratorClassName} 'TJclIntfArrayIterator', + {taLinkedListItemClassName} 'TJclIntfLinkedListItem', + {taLinkedListClassName} 'TJclIntfLinkedList', + {taLinkedListIteratorClassName} 'TJclIntfLinkedListIterator', + {taVectorClassName} 'TJclIntfVector', + {taVectorIteratorClassName} 'TJclIntfVectorIterator', + {taSetInterfaceName} 'IJclIntfSet', + {taSetInterfaceGUID} '{E2D28852-9774-49B7-A739-5DBA2B705924}', + {taArraySetClassName} 'TJclIntfArraySet', + {taHashSetBucketTypeName} 'TJclIntfHashSetBucket', + {taHashSetClassName} 'TJclIntfHashSet', + {taHashSetIteratorClassName} 'TJclIntfHashSetIterator', + {taTreeIteratorInterfaceName} 'IJclIntfTreeIterator', + {taTreeIteratorInterfaceGUID} '{C97379BF-C6A9-4A90-9D7A-152E9BAD314F}', + {taTreeInterfaceName} 'IJclIntfTree', + {taTreeInterfaceGUID} '{5A21688F-113D-41B4-A17C-54BDB0BD6559}', + {taTreeNodeClassName} 'TJclIntfTreeNode', + {taTreeClassName} 'TJclIntfTree', + {taTreeBaseIteratorClassName} 'TJclIntfTreeIterator', + {taTreePreOrderIteratorClassName} 'TJclPreOrderIntfTreeIterator', + {taTreePostOrderIteratorClassName} 'TJclPostOrderIntfTreeIterator', + {taQueueInterfaceName} 'IJclIntfQueue', + {taQueueInterfaceGUID} '{B88756FE-5553-4106-957E-3E33120BFA99}', + {taQueueClassName} 'TJclIntfQueue', + {taSortedSetInterfaceName} 'IJclIntfSortedSet', + {taSortedSetInterfaceGUID} '{159BE5A7-7349-42FF-BE55-9CA1B9DBA991}', + {taStackInterfaceName} 'IJclIntfStack', + {taStackInterfaceGUID} '{CA1DC7A1-8D8F-4A5D-81D1-0FE32E9A4E84}', + {taStackClassName} 'TJclIntfStack' + ); + + AnsiStringKnownType: TKnownTypeAttributes = + ({taTypeName} 'AnsiString', + {taCondition} '', + {taDefines} 'REFCOUNTED', + {taUndefs} 'ZEROINIT;GENERIC', + {taAlias} 'string', + {taAliasCondition} 'CONTAINER_ANSISTR', + {taDefaultValue} '''''', + {taConstKeyword} 'const ', + {taOwnershipParameterName} '', + {taOwnershipInterfaceName} 'IJclAnsiStrOwner', + {taOwnershipInterfaceGUID} '{4F64F1F6-766A-4CFA-B51B-654116E308A8}', + {taReleaserFunctionName} 'FreeString', + {taReleaseEventName} 'OnFreeString', + {taReleaseEventTypeName} 'TFreeAnsiStrEvent', + {taGetterFunctionName} 'GetString', + {taSetterProcedureName} 'SetString', + {taParameterName} 'AString', + {taDynArrayTypeName} 'TDynAnsiStringArray', + {taMoveArrayProcedureName} 'MoveArray', + {taArrayPropertyName} 'Strings', + {taBaseContainerClassName} 'TJclAnsiStrAbstractContainer', + {taBaseCollectionClassName} 'TJclAnsiStrAbstractCollection', + {taIterateProcedureTypeName} 'TAnsiStrIterateProcedure', + {taIterateProcedureName} 'Iterate', + {taApplyFunctionTypeName} 'TAnsiStrApplyFunction', + {taApplyProcedureName} 'Apply', + {taCompareFunctionTypeName} 'TAnsiStrCompare', + {taSimpleCompareFunctionName} 'AnsiStrSimpleCompare', + {taEqualityCompareFunctionTypeName} 'TAnsiStrEqualityCompare', + {taSimpleEqualityCompareFunctionName} 'AnsiStrSimpleEqualityCompare', + {taHashConvertFunctionTypeName} 'TAnsiStrHashConvert', + {taSimpleHashConvertFunctionName} 'AnsiStrSimpleHashConvert', + {taContainerInterfaceName} 'IJclAnsiStrContainer', + {taContainerInterfaceGUID} '{F8239357-B96F-46F1-A48E-B5DF25B5F1FA}', + {taFlatContainerInterfaceName} 'IJclAnsiStrFlatContainer', + {taFlatContainerInterfaceGUID} '{8A45A4D4-6317-4CDF-8314-C3E5CC6899F4}', + {taEqualityComparerInterfaceName} 'IJclAnsiStrEqualityComparer', + {taEqualityComparerInterfaceGUID} '{E3DB9016-F0D0-4CE0-B156-4C5DCA47FD3B}', + {taComparerInterfaceName} 'IJclAnsiStrComparer', + {taComparerInterfaceGUID} '{09063CBB-9226-4734-B2A0-A178C2343176}', + {taHashConverterInterfaceName} 'IJclAnsiStrHashConverter', + {taHashConverterInterfaceGUID} '{9841014E-8A31-4C79-8AD5-EB03C4E85533}', + {taIteratorInterfaceName} 'IJclAnsiStrIterator', + {taIteratorInterfaceGUID} '{D5D4B681-F902-49C7-B9E1-73007C9D64F0}', + {taBinaryTreeIteratorInterfaceName} 'IJclAnsiStrBinaryTreeIterator', + {taBinaryTreeIteratorInterfaceGUID} '{34A4A300-042C-43A9-AC23-8FC1B76BFB25}', + {taBinaryTreeNodeTypeName} 'TJclAnsiStrBinaryNode', + {taBinaryTreeClassName} 'TJclAnsiStrBinaryTree', + {taBinaryTreeBaseIteratorClassName} 'TJclAnsiStrBinaryTreeIterator', + {taBinaryTreePreOrderIteratorClassName} 'TJclPreOrderAnsiStrBinaryTreeIterator', + {taBinaryTreeInOrderIteratorClassName} 'TJclInOrderAnsiStrBinaryTreeIterator', + {taBinaryTreePostOrderIteratorClassName} 'TJclPostOrderAnsiStrBinaryTreeIterator', + {taCollectionInterfaceName} 'IJclAnsiStrCollection', + {taCollectionInterfaceGUID} '{3E3CFC19-E8AF-4DD7-91FA-2DF2895FC7B9}', + {taListInterfaceName} 'IJclAnsiStrList', + {taListInterfaceGUID} '{07DD7644-EAC6-4059-99FC-BEB7FBB73186}', + {taSortProcedureTypeName} 'TAnsiStrSortProc', + {taSortProcedureName} 'Sort', + {taQuickSortProcedureName} 'QuickSort', + {taFindFunctionName} 'Find', + {taCountObjectFunctionName} 'CountObject', + {taCopyProcedureName} 'Copy', + {taGenerateProcedureName} 'Generate', + {taFillProcedureName} 'Fill', + {taReverseProcedureName} 'Reverse', + {taArrayInterfaceName} 'IJclAnsiStrArray', + {taArrayInterfaceGUID} '{4953EA83-9288-4537-9D10-544D1C992B62}', + {taArrayListClassName} 'TJclAnsiStrArrayList', + {taArrayIteratorClassName} 'TJclAnsiStrArrayIterator', + {taLinkedListItemClassName} 'TJclAnsiStrLinkedListItem', + {taLinkedListClassName} 'TJclAnsiStrLinkedList', + {taLinkedListIteratorClassName} 'TJclAnsiStrLinkedListIterator', + {taVectorClassName} 'TJclAnsiStrVector', + {taVectorIteratorClassName} 'TJclAnsiStrVectorIterator', + {taSetInterfaceName} 'IJclAnsiStrSet', + {taSetInterfaceGUID} '{72204D85-2B68-4914-B9F2-09E5180C12E9}', + {taArraySetClassName} 'TJclAnsiStrArraySet', + {taHashSetBucketTypeName} 'TJclAnsiStrHashSetBucket', + {taHashSetClassName} 'TJclAnsiStrHashSet', + {taHashSetIteratorClassName} 'TJclAnsiStrHashSetIterator', + {taTreeIteratorInterfaceName} 'IJclAnsiStrTreeIterator', + {taTreeIteratorInterfaceGUID} '{66BC5C76-758C-4E72-ABF1-EB02CF851C6D}', + {taTreeInterfaceName} 'IJclAnsiStrTree', + {taTreeInterfaceGUID} '{1E1896C0-0497-47DF-83AF-A9422084636C}', + {taTreeNodeClassName} 'TJclAnsiStrTreeNode', + {taTreeClassName} 'TJclAnsiStrTree', + {taTreeBaseIteratorClassName} 'TJclAnsiStrTreeIterator', + {taTreePreOrderIteratorClassName} 'TJclPreOrderAnsiStrTreeIterator', + {taTreePostOrderIteratorClassName} 'TJclPostOrderAnsiStrTreeIterator', + {taQueueInterfaceName} 'IJclAnsiStrQueue', + {taQueueInterfaceGUID} '{5BA0ED9A-5AF3-4F79-9D80-34FA7FF15D1F}', + {taQueueClassName} 'TJclAnsiStrQueue', + {taSortedSetInterfaceName} 'IJclAnsiStrSortedSet', + {taSortedSetInterfaceGUID} '{03198146-F967-4310-868B-7AD3D52D5CBE}', + {taStackInterfaceName} 'IJclAnsiStrStack', + {taStackInterfaceGUID} '{649BB74C-D7BE-40D9-9F4E-32DDC3F13F3B}', + {taStackClassName} 'TJclAnsiStrStack' + ); + + WideStringKnownType: TKnownTypeAttributes = + ({taTypeName} 'WideString', + {taCondition} '', + {taDefines} 'REFCOUNTED', + {taUndefs} 'ZEROINIT;GENERIC', + {taAlias} 'string', + {taAliasCondition} 'CONTAINER_WIDESTR', + {taDefaultValue} '''''', + {taConstKeyword} 'const ', + {taOwnershipParameterName} '', + {taOwnershipInterfaceName} 'IJclWideStrOwner', + {taOwnershipInterfaceGUID} '{282B7A64-BCD0-4EAE-8776-4EF92D7E3D8B}', + {taReleaserFunctionName} 'FreeString', + {taReleaseEventName} 'OnFreeString', + {taReleaseEventTypeName} 'TFreeWideStrEvent', + {taGetterFunctionName} 'GetString', + {taSetterProcedureName} 'SetString', + {taParameterName} 'AString', + {taDynArrayTypeName} 'TDynWideStringArray', + {taMoveArrayProcedureName} 'MoveArray', + {taArrayPropertyName} 'Strings', + {taBaseContainerClassName} 'TJclWideStrAbstractContainer', + {taBaseCollectionClassName} 'TJclWideStrAbstractCollection', + {taIterateProcedureTypeName} 'TWideStrIterateProcedure', + {taIterateProcedureName} 'Iterate', + {taApplyFunctionTypeName} 'TWideStrApplyFunction', + {taApplyProcedureName} 'Apply', + {taCompareFunctionTypeName} 'TWideStrCompare', + {taSimpleCompareFunctionName} 'WideStrSimpleCompare', + {taEqualityCompareFunctionTypeName} 'TWideStrEqualityCompare', + {taSimpleEqualityCompareFunctionName} 'WideStrSimpleEqualityCompare', + {taHashConvertFunctionTypeName} 'TWideStrHashConvert', + {taSimpleHashConvertFunctionName} 'WideStrSimpleHashConvert', + {taContainerInterfaceName} 'IJclWideStrContainer', + {taContainerInterfaceGUID} '{875E1AC4-CA22-46BC-8999-048E5B9BF11D}', + {taFlatContainerInterfaceName} 'IJclWideStrFlatContainer', + {taFlatContainerInterfaceGUID} '{5B001B93-CA1C-47A8-98B8-451CCB444930}', + {taEqualityComparerInterfaceName} 'IJclWideStrEqualityComparer', + {taEqualityComparerInterfaceGUID} '{2E5696C9-8374-4347-9DC9-B3722F47F5FB}', + {taComparerInterfaceName} 'IJclWideStrComparer', + {taComparerInterfaceGUID} '{7A24AEDA-25B1-4E73-B2E9-5D74011E4C9C}', + {taHashConverterInterfaceName} 'IJclWideStrHashConverter', + {taHashConverterInterfaceGUID} '{2584118F-19AE-443E-939B-0DB18BCD0117}', + {taIteratorInterfaceName} 'IJclWideStrIterator', + {taIteratorInterfaceGUID} '{F03BC7D4-CCDA-4C4A-AF3A-E51FDCDE8ADE}', + {taBinaryTreeIteratorInterfaceName} 'IJclWideStrBinaryTreeIterator', + {taBinaryTreeIteratorInterfaceGUID} '{17C08EB9-6880-469E-878A-8F5EBFE905B1}', + {taBinaryTreeNodeTypeName} 'TJclWideStrBinaryNode', + {taBinaryTreeClassName} 'TJclWideStrBinaryTree', + {taBinaryTreeBaseIteratorClassName} 'TJclWideStrBinaryTreeIterator', + {taBinaryTreePreOrderIteratorClassName} 'TJclPreOrderWideStrBinaryTreeIterator', + {taBinaryTreeInOrderIteratorClassName} 'TJclInOrderWideStrBinaryTreeIterator', + {taBinaryTreePostOrderIteratorClassName} 'TJclPostOrderWideStrBinaryTreeIterator', + {taCollectionInterfaceName} 'IJclWideStrCollection', + {taCollectionInterfaceGUID} '{CDCC0F94-4DD0-4F25-B441-6AE55D5C7466}', + {taListInterfaceName} 'IJclWideStrList', + {taListInterfaceGUID} '{C9955874-6AC0-4CE0-8CC0-606A3F1702C6}', + {taSortProcedureTypeName} 'TWideStrSortProc', + {taSortProcedureName} 'Sort', + {taQuickSortProcedureName} 'QuickSort', + {taFindFunctionName} 'Find', + {taCountObjectFunctionName} 'CountObject', + {taCopyProcedureName} 'Copy', + {taGenerateProcedureName} 'Generate', + {taFillProcedureName} 'Fill', + {taReverseProcedureName} 'Reverse', + {taArrayInterfaceName} 'IJclWideStrArray', + {taArrayInterfaceGUID} '{3CE09F9A-5CB4-4867-80D5-C2313D278D69}', + {taArrayListClassName} 'TJclWideStrArrayList', + {taArrayIteratorClassName} 'TJclWideStrArrayIterator', + {taLinkedListItemClassName} 'TJclWideStrLinkedListItem', + {taLinkedListClassName} 'TJclWideStrLinkedList', + {taLinkedListIteratorClassName} 'TJclWideStrLinkedListIterator', + {taVectorClassName} 'TJclWideStrVector', + {taVectorIteratorClassName} 'TJclWideStrVectorIterator', + {taSetInterfaceName} 'IJclWideStrSet', + {taSetInterfaceGUID} '{08009E0A-ABDD-46AB-8CEE-407D4723E17C}', + {taArraySetClassName} 'TJclWideStrArraySet', + {taHashSetBucketTypeName} 'TJclWideStrHashSetBucket', + {taHashSetClassName} 'TJclWideStrHashSet', + {taHashSetIteratorClassName} 'TJclWideStrHashSetIterator', + {taTreeIteratorInterfaceName} 'IJclWideStrTreeIterator', + {taTreeIteratorInterfaceGUID} '{B3168A3B-5A90-4ABF-855F-3D2B3AB6EE7F}', + {taTreeInterfaceName} 'IJclWideStrTree', + {taTreeInterfaceGUID} '{E325615A-7A20-4788-87FA-9051002CCD91}', + {taTreeNodeClassName} 'TJclWideStrTreeNode', + {taTreeClassName} 'TJclWideStrTree', + {taTreeBaseIteratorClassName} 'TJclWideStrTreeIterator', + {taTreePreOrderIteratorClassName} 'TJclPreOrderWideStrTreeIterator', + {taTreePostOrderIteratorClassName} 'TJclPostOrderWideStrTreeIterator', + {taQueueInterfaceName} 'IJclWideStrQueue', + {taQueueInterfaceGUID} '{058BBFB7-E9B9-44B5-B676-D5B5B9A79BEF}', + {taQueueClassName} 'TJclWideStrQueue', + {taSortedSetInterfaceName} 'IJclWideStrSortedSet', + {taSortedSetInterfaceGUID} '{ED9567E2-C1D3-4C00-A1D4-90D5C7E27C2D}', + {taStackInterfaceName} 'IJclWideStrStack', + {taStackInterfaceGUID} '{B2C3B165-33F1-4B7D-A2EC-0B19D12CE33C}', + {taStackClassName} 'TJclWideStrStack' + ); + + UnicodeStringKnownType: TKnownTypeAttributes = + ({taTypeName} 'UnicodeString', + {taCondition} 'SUPPORTS_UNICODE_STRING', + {taDefines} 'REFCOUNTED', + {taUndefs} 'ZEROINIT;GENERIC', + {taAlias} 'string', + {taAliasCondition} 'CONTAINER_UNICODESTR', + {taDefaultValue} '''''', + {taConstKeyword} 'const ', + {taOwnershipParameterName} '', + {taOwnershipInterfaceName} 'IJclUnicodeStrOwner', + {taOwnershipInterfaceGUID} '{07F402E6-DD97-4AA4-83D8-4CCD419FCCFC}', + {taReleaserFunctionName} 'FreeString', + {taReleaseEventName} 'OnFreeString', + {taReleaseEventTypeName} 'TFreeUnicodeStrEvent', + {taGetterFunctionName} 'GetString', + {taSetterProcedureName} 'SetString', + {taParameterName} 'AString', + {taDynArrayTypeName} 'TDynUnicodeStringArray', + {taMoveArrayProcedureName} 'MoveArray', + {taArrayPropertyName} 'Strings', + {taBaseContainerClassName} 'TJclUnicodeStrAbstractContainer', + {taBaseCollectionClassName} 'TJclUnicodeStrAbstractCollection', + {taIterateProcedureTypeName} 'TUnicodeStrIterateProcedure', + {taIterateProcedureName} 'Iterate', + {taApplyFunctionTypeName} 'TUnicodeStrApplyFunction', + {taApplyProcedureName} 'Apply', + {taCompareFunctionTypeName} 'TUnicodeStrCompare', + {taSimpleCompareFunctionName} 'UnicodeStrSimpleCompare', + {taEqualityCompareFunctionTypeName} 'TUnicodeStrEqualityCompare', + {taSimpleEqualityCompareFunctionName} 'UnicodeStrSimpleEqualityCompare', + {taHashConvertFunctionTypeName} 'TUnicodeStrHashConvert', + {taSimpleHashConvertFunctionName} 'UnicodeStrSimpleHashConvert', + {taContainerInterfaceName} 'IJclUnicodeStrContainer', + {taContainerInterfaceGUID} '{619BA29F-5E05-464D-B472-1C8453DBC707}', + {taFlatContainerInterfaceName} 'IJclUnicodeStrFlatContainer', + {taFlatContainerInterfaceGUID} '{3343D73E-4ADC-458E-8289-A4B83D1479D1}', + {taEqualityComparerInterfaceName} 'IJclUnicodeStrEqualityComparer', + {taEqualityComparerInterfaceGUID} '{EDFCC1C7-79DB-4F58-BD64-5016B44EEAC0}', + {taComparerInterfaceName} 'IJclUnicodeStrComparer', + {taComparerInterfaceGUID} '{E81E2705-0CA0-4DBD-BECC-5F9AA623A6E4}', + {taHashConverterInterfaceName} 'IJclUnicodeStrHashConverter', + {taHashConverterInterfaceGUID} '{08CD8171-DBAF-405F-9802-46D955C8BBE6}', + {taIteratorInterfaceName} 'IJclUnicodeStrIterator', + {taIteratorInterfaceGUID} '{B913FFDC-792A-48FB-B58E-763EFDEBA15C}', + {taBinaryTreeIteratorInterfaceName} 'IJclUnicodeStrBinaryTreeIterator', + {taBinaryTreeIteratorInterfaceGUID} '{CA32B126-AD4B-4C33-BC47-52B09FE093BE}', + {taBinaryTreeNodeTypeName} 'TJclUnicodeStrBinaryNode', + {taBinaryTreeClassName} 'TJclUnicodeStrBinaryTree', + {taBinaryTreeBaseIteratorClassName} 'TJclUnicodeStrBinaryTreeIterator', + {taBinaryTreePreOrderIteratorClassName} 'TJclPreOrderUnicodeStrBinaryTreeIterator', + {taBinaryTreeInOrderIteratorClassName} 'TJclInOrderUnicodeStrBinaryTreeIterator', + {taBinaryTreePostOrderIteratorClassName} 'TJclPostOrderUnicodeStrBinaryTreeIterator', + {taCollectionInterfaceName} 'IJclUnicodeStrCollection', + {taCollectionInterfaceGUID} '{82EA7DDE-4EBF-4E0D-A380-CAF8A24C1A0D}', + {taListInterfaceName} 'IJclUnicodeStrList', + {taListInterfaceGUID} '{F4307EB4-D66E-4656-AC56-50883D0F2C83}', + {taSortProcedureTypeName} 'TUnicodeStrSortProc', + {taSortProcedureName} 'Sort', + {taQuickSortProcedureName} 'QuickSort', + {taFindFunctionName} 'Find', + {taCountObjectFunctionName} 'CountObject', + {taCopyProcedureName} 'Copy', + {taGenerateProcedureName} 'Generate', + {taFillProcedureName} 'Fill', + {taReverseProcedureName} 'Reverse', + {taArrayInterfaceName} 'IJclUnicodeStrArray', + {taArrayInterfaceGUID} '{24312E5B-B61D-485C-9E57-AC36C93D8159}', + {taArrayListClassName} 'TJclUnicodeStrArrayList', + {taArrayIteratorClassName} 'TJclUnicodeStrArrayIterator', + {taLinkedListItemClassName} 'TJclUnicodeStrLinkedListItem', + {taLinkedListClassName} 'TJclUnicodeStrLinkedList', + {taLinkedListIteratorClassName} 'TJclUnicodeStrLinkedListIterator', + {taVectorClassName} 'TJclUnicodeStrVector', + {taVectorIteratorClassName} 'TJclUnicodeStrVectorIterator', + {taSetInterfaceName} 'IJclUnicodeStrSet', + {taSetInterfaceGUID} '{440E9BCB-341F-40B6-8AED-479B2E98C92A}', + {taArraySetClassName} 'TJclUnicodeStrArraySet', + {taHashSetBucketTypeName} 'TJclUnicodeStrHashSetBucket', + {taHashSetClassName} 'TJclUnicodeStrHashSet', + {taHashSetIteratorClassName} 'TJclUnicodeStrHashSetIterator', + {taTreeIteratorInterfaceName} 'IJclUnicodeStrTreeIterator', + {taTreeIteratorInterfaceGUID} '{0B0A60DE-0403-4EE1-B1F0-10D849924CF8}', + {taTreeInterfaceName} 'IJclUnicodeStrTree', + {taTreeInterfaceGUID} '{A378BC36-1FB1-4330-A335-037DD370E81B}', + {taTreeNodeClassName} 'TJclUnicodeStrTreeNode', + {taTreeClassName} 'TJclUnicodeStrTree', + {taTreeBaseIteratorClassName} 'TJclUnicodeStrTreeIterator', + {taTreePreOrderIteratorClassName} 'TJclPreOrderUnicodeStrTreeIterator', + {taTreePostOrderIteratorClassName} 'TJclPostOrderUnicodeStrTreeIterator', + {taQueueInterfaceName} 'IJclUnicodeStrQueue', + {taQueueInterfaceGUID} '{94A09E52-424A-486E-846B-9C2C52DC3A8F}', + {taQueueClassName} 'TJclUnicodeStrQueue', + {taSortedSetInterfaceName} 'IJclUnicodeStrSortedSet', + {taSortedSetInterfaceGUID} '{172BCD6F-D23C-4014-9C8C-A77A27D6E881}', + {taStackInterfaceName} 'IJclUnicodeStrStack', + {taStackInterfaceGUID} '{BC046C3D-E3D2-42BA-A96D-054834A70404}', + {taStackClassName} 'TJclUnicodeStrStack' + ); + + StringKnownType: TKnownTypeAttributes = + ({taTypeName} 'string', + {taCondition} '', + {taDefines} 'REFCOUNTED', + {taUndefs} 'ZEROINIT;GENERIC', + {taAlias} '', + {taAliasCondition} '', + {taDefaultValue} '''''', + {taConstKeyword} 'const ', + {taOwnershipParameterName} '', + {taOwnershipInterfaceName} 'IJclStrOwner', + {taOwnershipInterfaceGUID} '', + {taReleaserFunctionName} '', + {taReleaseEventName} '', + {taReleaseEventTypeName} 'TFreeStrEvent', + {taGetterFunctionName} 'GetString', + {taSetterProcedureName} 'SetString', + {taParameterName} 'AString', + {taDynArrayTypeName} 'TDynStringArray', + {taMoveArrayProcedureName} 'MoveArray', + {taArrayPropertyName} 'Strings', + {taBaseContainerClassName} '', + {taBaseCollectionClassName} '', + {taIterateProcedureTypeName} 'TStrIterateProcedure', + {taIterateProcedureName} 'Iterate', + {taApplyFunctionTypeName} 'TStrApplyFunction', + {taApplyProcedureName} 'Apply', + {taCompareFunctionTypeName} 'TStrCompare', + {taSimpleCompareFunctionName} 'StrSimpleCompare', + {taEqualityCompareFunctionTypeName} 'TStrEqualityCompare', + {taSimpleEqualityCompareFunctionName} 'StrSimpleEqualityCompare', + {taHashConvertFunctionTypeName} 'TStrHashConvert', + {taSimpleHashConvertFunctionName} 'StrSimpleHashConvert', + {taContainerInterfaceName} '', + {taContainerInterfaceGUID} '', + {taFlatContainerInterfaceName} '', + {taFlatContainerInterfaceGUID} '', + {taEqualityComparerInterfaceName} 'IJclStrEqualityComparer', + {taEqualityComparerInterfaceGUID} '', + {taComparerInterfaceName} 'IJclStrComparer', + {taComparerInterfaceGUID} '', + {taHashConverterInterfaceName} 'IJclStrHashConverter', + {taHashConverterInterfaceGUID} '', + {taIteratorInterfaceName} 'IJclStrIterator', + {taIteratorInterfaceGUID} '', + {taBinaryTreeIteratorInterfaceName} 'IJclStrBinaryTreeIterator', + {taBinaryTreeIteratorInterfaceGUID} '', + {taBinaryTreeNodeTypeName} 'TJclStrBinaryNode', + {taBinaryTreeClassName} 'TJclStrBinaryTree', + {taBinaryTreeBaseIteratorClassName} 'TJclStrBinaryTreeIterator', + {taBinaryTreePreOrderIteratorClassName} 'TJclPreOrderStrBinaryTreeIterator', + {taBinaryTreeInOrderIteratorClassName} 'TJclInOrderStrBinaryTreeIterator', + {taBinaryTreePostOrderIteratorClassName} 'TJclPostOrderStrBinaryTreeIterator', + {taCollectionInterfaceName} 'IJclStrCollection', + {taCollectionInterfaceGUID} '', + {taListInterfaceName} 'IJclStrList', + {taListInterfaceGUID} '', + {taSortProcedureTypeName} 'TStrSortProc', + {taSortProcedureName} 'Sort', + {taQuickSortProcedureName} 'QuickSort', + {taFindFunctionName} 'Find', + {taCountObjectFunctionName} 'CountObject', + {taCopyProcedureName} 'Copy', + {taGenerateProcedureName} 'Generate', + {taFillProcedureName} 'Fill', + {taReverseProcedureName} 'Reverse', + {taArrayInterfaceName} 'IJclStrArray', + {taArrayInterfaceGUID} '', + {taArrayListClassName} 'TJclStrArrayList', + {taArrayIteratorClassName} 'TJclStrArrayIterator', + {taLinkedListItemClassName} 'TJclStrLinkedListItem', + {taLinkedListClassName} 'TJclStrLinkedList', + {taLinkedListIteratorClassName} 'TJclStrLinkedListIterator', + {taVectorClassName} 'TJclStrVector', + {taVectorIteratorClassName} 'TJclStrVectorIterator', + {taSetInterfaceName} 'IJclStrSet', + {taSetInterfaceGUID} '', + {taArraySetClassName} 'TJclStrArraySet', + {taHashSetBucketTypeName} 'TJclStrHashSetBucket', + {taHashSetClassName} 'TJclStrHashSet', + {taHashSetIteratorClassName} 'TJclStrHashSetIterator', + {taTreeIteratorInterfaceName} 'IJclStrTreeIterator', + {taTreeIteratorInterfaceGUID} '', + {taTreeInterfaceName} 'IJclStrTree', + {taTreeInterfaceGUID} '', + {taTreeNodeClassName} 'TJclStrTreeNode', + {taTreeClassName} 'TJclStrTree', + {taTreeBaseIteratorClassName} 'TJclStrTreeIterator', + {taTreePreOrderIteratorClassName} 'TJclPreOrderStrTreeIterator', + {taTreePostOrderIteratorClassName} 'TJclPostOrderStrTreeIterator', + {taQueueInterfaceName} 'IJclStrQueue', + {taQueueInterfaceGUID} '', + {taQueueClassName} 'TJclStrQueue', + {taSortedSetInterfaceName} 'IJclStrSortedSet', + {taSortedSetInterfaceGUID} '', + {taStackInterfaceName} 'IJclStrStack', + {taStackInterfaceGUID} '', + {taStackClassName} 'TJclStrStack' + ); + + SingleKnownType: TKnownTypeAttributes = + ({taTypeName} 'Single', + {taCondition} '', + {taDefines} 'ZEROINIT', + {taUndefs} 'GENERIC;REFCOUNTED', + {taAlias} 'Float', + {taAliasCondition} 'MATH_SINGLE_PRECISION', + {taDefaultValue} '0.0', + {taConstKeyword} 'const ', + {taOwnershipParameterName} '', + {taOwnershipInterfaceName} 'IJclSingleOwner', + {taOwnershipInterfaceGUID} '{B002C201-70D7-4FA8-B44A-6D18E82580E5}', + {taReleaserFunctionName} 'FreeSingle', + {taReleaseEventName} 'OnFreeSingle', + {taReleaseEventTypeName} 'TFreeSingleEvent', + {taGetterFunctionName} 'GetValue', + {taSetterProcedureName} 'SetValue', + {taParameterName} 'AValue', + {taDynArrayTypeName} 'TDynSingleArray', + {taMoveArrayProcedureName} 'MoveArray', + {taArrayPropertyName} 'Values', + {taBaseContainerClassName} 'TJclSingleAbstractContainer', + {taBaseCollectionClassName} '', + {taIterateProcedureTypeName} 'TSingleIterateProcedure', + {taIterateProcedureName} 'Iterate', + {taApplyFunctionTypeName} 'TSingleApplyFunction', + {taApplyProcedureName} 'Apply', + {taCompareFunctionTypeName} 'TSingleCompare', + {taSimpleCompareFunctionName} 'SingleSimpleCompare', + {taEqualityCompareFunctionTypeName} 'TSingleEqualityCompare', + {taSimpleEqualityCompareFunctionName} 'SingleSimpleEqualityCompare', + {taHashConvertFunctionTypeName} 'TSingleHashConvert', + {taSimpleHashConvertFunctionName} 'SingleSimpleHashConvert', + {taContainerInterfaceName} 'IJclSingleContainer', + {taContainerInterfaceGUID} '{22BE88BD-87D1-4B4D-9FAB-F1B6D555C6A9}', + {taFlatContainerInterfaceName} 'IJclSingleFlatContainer', + {taFlatContainerInterfaceGUID} '{F16955E8-94D2-4201-809B-CC2EA39B5FDD}', + {taEqualityComparerInterfaceName} 'IJclSingleEqualityComparer', + {taEqualityComparerInterfaceGUID} '{4835BC5B-1A87-4864-BFE1-778F3BAF26B1}', + {taComparerInterfaceName} 'IJclSingleComparer', + {taComparerInterfaceGUID} '{008225CE-075E-4450-B9DE-9863CB6D347C}', + {taHashConverterInterfaceName} 'IJclSingleHashConverter', + {taHashConverterInterfaceGUID} '{20F0E481-F1D2-48B6-A95D-FBB56AF119F5}', + {taIteratorInterfaceName} 'IJclSingleIterator', + {taIteratorInterfaceGUID} '{FD1124F8-CB2B-4AD7-B12D-C05702F4204B}', + {taBinaryTreeIteratorInterfaceName} 'IJclSingleBinaryTreeIterator', + {taBinaryTreeIteratorInterfaceGUID} '{BC6FFB13-FA1C-4077-8273-F25A3119168B}', + {taBinaryTreeNodeTypeName} 'TJclSingleBinaryNode', + {taBinaryTreeClassName} 'TJclSingleBinaryTree', + {taBinaryTreeBaseIteratorClassName} 'TJclSingleBinaryTreeIterator', + {taBinaryTreePreOrderIteratorClassName} 'TJclPreOrderSingleBinaryTreeIterator', + {taBinaryTreeInOrderIteratorClassName} 'TJclInOrderSingleBinaryTreeIterator', + {taBinaryTreePostOrderIteratorClassName} 'TJclPostOrderSingleBinaryTreeIterator', + {taCollectionInterfaceName} 'IJclSingleCollection', + {taCollectionInterfaceGUID} '{1D34D474-6588-441E-B2B3-8C021A37ED89}', + {taListInterfaceName} 'IJclSingleList', + {taListInterfaceGUID} '{D081324C-70A4-4AAC-BA42-7557F0262826}', + {taSortProcedureTypeName} 'TSingleSortProc', + {taSortProcedureName} 'Sort', + {taQuickSortProcedureName} 'QuickSort', + {taFindFunctionName} 'Find', + {taCountObjectFunctionName} 'CountObject', + {taCopyProcedureName} 'Copy', + {taGenerateProcedureName} 'Generate', + {taFillProcedureName} 'Fill', + {taReverseProcedureName} 'Reverse', + {taArrayInterfaceName} 'IJclSingleArray', + {taArrayInterfaceGUID} '{B96E2A4D-D750-4B65-B975-C619A05A29F6}', + {taArrayListClassName} 'TJclSingleArrayList', + {taArrayIteratorClassName} 'TJclSingleArrayIterator', + {taLinkedListItemClassName} 'TJclSingleLinkedListItem', + {taLinkedListClassName} 'TJclSingleLinkedList', + {taLinkedListIteratorClassName} 'TJclSingleLinkedListIterator', + {taVectorClassName} 'TJclSingleVector', + {taVectorIteratorClassName} 'TJclSingleVectorIterator', + {taSetInterfaceName} 'IJclSingleSet', + {taSetInterfaceGUID} '{36E34A78-6A29-4503-97D5-4BF53538CEC0}', + {taArraySetClassName} 'TJclSingleArraySet', + {taHashSetBucketTypeName} 'TJclSingleHashSetBucket', + {taHashSetClassName} 'TJclSingleHashSet', + {taHashSetIteratorClassName} 'TJclSingleHashSetIterator', + {taTreeIteratorInterfaceName} 'IJclSingleTreeIterator', + {taTreeIteratorInterfaceGUID} '{17BFDE9D-DBF7-4DC8-AC74-919C717B4726}', + {taTreeInterfaceName} 'IJclSingleTree', + {taTreeInterfaceGUID} '{A90A51BC-EBD7-40D3-B0A0-C9987E7A83D0}', + {taTreeNodeClassName} 'TJclSingleTreeNode', + {taTreeClassName} 'TJclSingleTree', + {taTreeBaseIteratorClassName} 'TJclSingleTreeIterator', + {taTreePreOrderIteratorClassName} 'TJclPreOrderSingleTreeIterator', + {taTreePostOrderIteratorClassName} 'TJclPostOrderSingleTreeIterator', + {taQueueInterfaceName} 'IJclSingleQueue', + {taQueueInterfaceGUID} '{67D74314-9967-4C99-8A48-6E0ADD73EC29}', + {taQueueClassName} 'TJclSingleQueue', + {taSortedSetInterfaceName} 'IJclSingleSortedSet', + {taSortedSetInterfaceGUID} '{65EDA801-9E04-4119-BF9E-D7DD4AF82144}', + {taStackInterfaceName} 'IJclSingleStack', + {taStackInterfaceGUID} '{8DCE45C8-B5B3-43AB-BA08-DAD531CEB9CF}', + {taStackClassName} 'TJclSingleStack' + ); + + DoubleKnownType: TKnownTypeAttributes = + ({taTypeName} 'Double', + {taCondition} '', + {taDefines} 'ZEROINIT', + {taUndefs} 'GENERIC;REFCOUNTED', + {taAlias} 'Float', + {taAliasCondition} 'MATH_DOUBLE_PRECISION', + {taDefaultValue} '0.0', + {taConstKeyword} 'const ', + {taOwnershipParameterName} '', + {taOwnershipInterfaceName} 'IJclDoubleOwner', + {taOwnershipInterfaceGUID} '{3BEFEDB0-C904-4400-ABEF-40FC928BB258}', + {taReleaserFunctionName} 'FreeDouble', + {taReleaseEventName} 'OnFreeDouble', + {taReleaseEventTypeName} 'TFreeDoubleEvent', + {taGetterFunctionName} 'GetValue', + {taSetterProcedureName} 'SetValue', + {taParameterName} 'AValue', + {taDynArrayTypeName} 'TDynDoubleArray', + {taMoveArrayProcedureName} 'MoveArray', + {taArrayPropertyName} 'Values', + {taBaseContainerClassName} 'TJclDoubleAbstractContainer', + {taBaseCollectionClassName} '', + {taIterateProcedureTypeName} 'TDoubleIterateProcedure', + {taIterateProcedureName} 'Iterate', + {taApplyFunctionTypeName} 'TDoubleApplyFunction', + {taApplyProcedureName} 'Apply', + {taCompareFunctionTypeName} 'TDoubleCompare', + {taSimpleCompareFunctionName} 'DoubleSimpleCompare', + {taEqualityCompareFunctionTypeName} 'TDoubleEqualityCompare', + {taSimpleEqualityCompareFunctionName} 'DoubleSimpleEqualityCompare', + {taHashConvertFunctionTypeName} 'TDoubleHashConvert', + {taSimpleHashConvertFunctionName} 'DoubleSimpleHashConvert', + {taContainerInterfaceName} 'IJclDoubleContainer', + {taContainerInterfaceGUID} '{372B9354-DF6D-4CAA-A5A9-C50E1FEE5525}', + {taFlatContainerInterfaceName} 'IJclDoubleFlatContainer', + {taFlatContainerInterfaceGUID} '{2F0252CE-7471-45CA-8C8D-FD3925507C00}', + {taEqualityComparerInterfaceName} 'IJclDoubleEqualityComparer', + {taEqualityComparerInterfaceGUID} '{15F0A9F0-D5DC-4978-8CDB-53B6E510262C}', + {taComparerInterfaceName} 'IJclDoubleComparer', + {taComparerInterfaceGUID} '{BC245D7F-7EB9-43D0-81B4-EE215486A5AA}', + {taHashConverterInterfaceName} 'IJclDoubleHashConverter', + {taHashConverterInterfaceGUID} '{193A2881-535B-4AF4-B0C3-6845A2800F80}', + {taIteratorInterfaceName} 'IJclDoubleIterator', + {taIteratorInterfaceGUID} '{004C154A-281C-4DA7-BF64-F3EE80ACF640}', + {taBinaryTreeIteratorInterfaceName} 'IJclDoubleBinaryTreeIterator', + {taBinaryTreeIteratorInterfaceGUID} '{CE48083C-D60C-4315-BC14-8CE77AC3269E}', + {taBinaryTreeNodeTypeName} 'TJclDoubleBinaryNode', + {taBinaryTreeClassName} 'TJclDoubleBinaryTree', + {taBinaryTreeBaseIteratorClassName} 'TJclDoubleBinaryTreeIterator', + {taBinaryTreePreOrderIteratorClassName} 'TJclPreOrderDoubleBinaryTreeIterator', + {taBinaryTreeInOrderIteratorClassName} 'TJclInOrderDoubleBinaryTreeIterator', + {taBinaryTreePostOrderIteratorClassName} 'TJclPostOrderDoubleBinaryTreeIterator', + {taCollectionInterfaceName} 'IJclDoubleCollection', + {taCollectionInterfaceGUID} '{E54C7717-C33A-4F1B-860C-4F60F303EAD3}', + {taListInterfaceName} 'IJclDoubleList', + {taListInterfaceGUID} '{ECA58515-3903-4312-9486-3214E03F35AB}', + {taSortProcedureTypeName} 'TDoubleSortProc', + {taSortProcedureName} 'Sort', + {taQuickSortProcedureName} 'QuickSort', + {taFindFunctionName} 'Find', + {taCountObjectFunctionName} 'CountObject', + {taCopyProcedureName} 'Copy', + {taGenerateProcedureName} 'Generate', + {taFillProcedureName} 'Fill', + {taReverseProcedureName} 'Reverse', + {taArrayInterfaceName} 'IJclDoubleArray', + {taArrayInterfaceGUID} '{67E66324-9757-4E85-8ECD-53396910FB39}', + {taArrayListClassName} 'TJclDoubleArrayList', + {taArrayIteratorClassName} 'TJclDoubleArrayIterator', + {taLinkedListItemClassName} 'TJclDoubleLinkedListItem', + {taLinkedListClassName} 'TJclDoubleLinkedList', + {taLinkedListIteratorClassName} 'TJclDoubleLinkedListIterator', + {taVectorClassName} 'TJclDoubleVector', + {taVectorIteratorClassName} 'TJclDoubleVectorIterator', + {taSetInterfaceName} 'IJclDoubleSet', + {taSetInterfaceGUID} '{4E1E4847-E934-4811-A26C-5FC8E772A623}', + {taArraySetClassName} 'TJclDoubleArraySet', + {taHashSetBucketTypeName} 'TJclDoubleHashSetBucket', + {taHashSetClassName} 'TJclDoubleHashSet', + {taHashSetIteratorClassName} 'TJclDoubleHashSetIterator', + {taTreeIteratorInterfaceName} 'IJclDoubleTreeIterator', + {taTreeIteratorInterfaceGUID} '{EB39B84E-D3C5-496E-A521-B8BF24579252}', + {taTreeInterfaceName} 'IJclDoubleTree', + {taTreeInterfaceGUID} '{69DA85B1-A0DD-407B-B5CF-5EB7C6D4B82D}', + {taTreeNodeClassName} 'TJclDoubleTreeNode', + {taTreeClassName} 'TJclDoubleTree', + {taTreeBaseIteratorClassName} 'TJclDoubleTreeIterator', + {taTreePreOrderIteratorClassName} 'TJclPreOrderDoubleTreeIterator', + {taTreePostOrderIteratorClassName} 'TJclPostOrderDoubleTreeIterator', + {taQueueInterfaceName} 'IJclDoubleQueue', + {taQueueInterfaceGUID} '{FA1B6D25-3456-4963-87DC-5A2E53B2963F}', + {taQueueClassName} 'TJclDoubleQueue', + {taSortedSetInterfaceName} 'IJclDoubleSortedSet', + {taSortedSetInterfaceGUID} '{DA0E689F-BAFE-4BCE-85E4-C38E780BC84C}', + {taStackInterfaceName} 'IJclDoubleStack', + {taStackInterfaceGUID} '{46DF2701-16F0-453C-B938-F04E9C1CEBF8}', + {taStackClassName} 'TJclDoubleStack' + ); + + ExtendedKnownType: TKnownTypeAttributes = + ({taTypeName} 'Extended', + {taCondition} '', + {taDefines} 'ZEROINIT', + {taUndefs} 'GENERIC;REFCOUNTED', + {taAlias} 'Float', + {taAliasCondition} 'MATH_EXTENDED_PRECISION', + {taDefaultValue} '0.0', + {taConstKeyword} 'const ', + {taOwnershipParameterName} '', + {taOwnershipInterfaceName} 'IJclExtendedOwner', + {taOwnershipInterfaceGUID} '{4501B203-6784-479D-8A8E-FBE3E1249CCF}', + {taReleaserFunctionName} 'FreeExtended', + {taReleaseEventName} 'OnFreeExtended', + {taReleaseEventTypeName} 'TFreeExtendedEvent', + {taGetterFunctionName} 'GetValue', + {taSetterProcedureName} 'SetValue', + {taParameterName} 'AValue', + {taDynArrayTypeName} 'TDynExtendedArray', + {taMoveArrayProcedureName} 'MoveArray', + {taArrayPropertyName} 'Values', + {taBaseContainerClassName} 'TJclExtendedAbstractContainer', + {taBaseCollectionClassName} '', + {taIterateProcedureTypeName} 'TExtendedIterateProcedure', + {taIterateProcedureName} 'Iterate', + {taApplyFunctionTypeName} 'TExtendedApplyFunction', + {taApplyProcedureName} 'Apply', + {taCompareFunctionTypeName} 'TExtendedCompare', + {taSimpleCompareFunctionName} 'ExtendedSimpleCompare', + {taEqualityCompareFunctionTypeName} 'TExtendedEqualityCompare', + {taSimpleEqualityCompareFunctionName} 'ExtendedSimpleEqualityCompare', + {taHashConvertFunctionTypeName} 'TExtendedHashConvert', + {taSimpleHashConvertFunctionName} 'ExtendedSimpleHashConvert', + {taContainerInterfaceName} 'IJclExtendedContainer', + {taContainerInterfaceGUID} '{431A6482-FD5C-45A7-BE53-339A3CF75AC9}', + {taFlatContainerInterfaceName} 'IJclExtendedFlatContainer', + {taFlatContainerInterfaceGUID} '{1D3F48A2-001E-48F7-8A54-B9F4CE837523}', + {taEqualityComparerInterfaceName} 'IJclExtendedEqualityComparer', + {taEqualityComparerInterfaceGUID} '{149883D5-4138-4570-8C5C-99F186B7E646}', + {taComparerInterfaceName} 'IJclExtendedComparer', + {taComparerInterfaceGUID} '{92657C66-C18D-4BF8-A538-A3B0140320BB}', + {taHashConverterInterfaceName} 'IJclExtendedHashConverter', + {taHashConverterInterfaceGUID} '{77CECDB9-2774-4FDC-8E5A-A80325626434}', + {taIteratorInterfaceName} 'IJclExtendedIterator', + {taIteratorInterfaceGUID} '{B89877A5-DED4-4CD9-AB90-C7D062111DE0}', + {taBinaryTreeIteratorInterfaceName} 'IJclExtendedBinaryTreeIterator', + {taBinaryTreeIteratorInterfaceGUID} '{8A9FAE2A-5EF5-4165-8E8D-51F2102A4580}', + {taBinaryTreeNodeTypeName} 'TJclExtendedBinaryNode', + {taBinaryTreeClassName} 'TJclExtendedBinaryTree', + {taBinaryTreeBaseIteratorClassName} 'TJclExtendedBinaryTreeIterator', + {taBinaryTreePreOrderIteratorClassName} 'TJclPreOrderExtendedBinaryTreeIterator', + {taBinaryTreeInOrderIteratorClassName} 'TJclInOrderExtendedBinaryTreeIterator', + {taBinaryTreePostOrderIteratorClassName} 'TJclPostOrderExtendedBinaryTreeIterator', + {taCollectionInterfaceName} 'IJclExtendedCollection', + {taCollectionInterfaceGUID} '{2A1341CB-B997-4E3B-B1CA-6D60AE853C55}', + {taListInterfaceName} 'IJclExtendedList', + {taListInterfaceGUID} '{7463F954-F8DF-4B02-A284-FCB98746248E}', + {taSortProcedureTypeName} 'TExtendedSortProc', + {taSortProcedureName} 'Sort', + {taQuickSortProcedureName} 'QuickSort', + {taFindFunctionName} 'Find', + {taCountObjectFunctionName} 'CountObject', + {taCopyProcedureName} 'Copy', + {taGenerateProcedureName} 'Generate', + {taFillProcedureName} 'Fill', + {taReverseProcedureName} 'Reverse', + {taArrayInterfaceName} 'IJclExtendedArray', + {taArrayInterfaceGUID} '{A3693A89-3E57-41B3-9A92-F6CBB64F89AB}', + {taArrayListClassName} 'TJclExtendedArrayList', + {taArrayIteratorClassName} 'TJclExtendedArrayIterator', + {taLinkedListItemClassName} 'TJclExtendedLinkedListItem', + {taLinkedListClassName} 'TJclExtendedLinkedList', + {taLinkedListIteratorClassName} 'TJclExtendedLinkedListIterator', + {taVectorClassName} 'TJclExtendedVector', + {taVectorIteratorClassName} 'TJclExtendedVectorIterator', + {taSetInterfaceName} 'IJclExtendedSet', + {taSetInterfaceGUID} '{3B9CF52D-1C49-4388-A7B3-9BEE1821FFD4}', + {taArraySetClassName} 'TJclExtendedArraySet', + {taHashSetBucketTypeName} 'TJclExtendedHashSetBucket', + {taHashSetClassName} 'TJclExtendedHashSet', + {taHashSetIteratorClassName} 'TJclExtendedHashSetIterator', + {taTreeIteratorInterfaceName} 'IJclExtendedTreeIterator', + {taTreeIteratorInterfaceGUID} '{1B40A544-FC5D-454C-8E42-CE17B015E65C}', + {taTreeInterfaceName} 'IJclExtendedTree', + {taTreeInterfaceGUID} '{9ACCCAFD-B617-43DC-AAF9-916BE324A17E}', + {taTreeNodeClassName} 'TJclExtendedTreeNode', + {taTreeClassName} 'TJclExtendedTree', + {taTreeBaseIteratorClassName} 'TJclExtendedTreeIterator', + {taTreePreOrderIteratorClassName} 'TJclPreOrderExtendedTreeIterator', + {taTreePostOrderIteratorClassName} 'TJclPostOrderExtendedTreeIterator', + {taQueueInterfaceName} 'IJclExtendedQueue', + {taQueueInterfaceGUID} '{76F349C0-7681-4BE8-9E94-280C962780D8}', + {taQueueClassName} 'TJclExtendedQueue', + {taSortedSetInterfaceName} 'IJclExtendedSortedSet', + {taSortedSetInterfaceGUID} '{A9875ED3-81A4-43A3-86BB-3429F51B278B}', + {taStackInterfaceName} 'IJclExtendedStack', + {taStackInterfaceGUID} '{A2A30585-F561-4757-ABE1-CA511AE72CC5}', + {taStackClassName} 'TJclExtendedStack' + ); + + FloatKnownType: TKnownTypeAttributes = + ({taTypeName} 'Float', + {taCondition} '', + {taDefines} 'ZEROINIT', + {taUndefs} 'GENERIC;REFCOUNTED', + {taAlias} '', + {taAliasCondition} '', + {taDefaultValue} '0.0', + {taConstKeyword} 'const ', + {taOwnershipParameterName} '', + {taOwnershipInterfaceName} 'IJclFloatOwner', + {taOwnershipInterfaceGUID} '', + {taReleaserFunctionName} '', + {taReleaseEventName} '', + {taReleaseEventTypeName} 'TFreeFloatEvent', + {taGetterFunctionName} 'GetValue', + {taSetterProcedureName} 'SetValue', + {taParameterName} 'AValue', + {taDynArrayTypeName} 'TDynFloatArray', + {taMoveArrayProcedureName} 'MoveArray', + {taArrayPropertyName} 'Values', + {taBaseContainerClassName} '', + {taBaseCollectionClassName} '', + {taIterateProcedureTypeName} 'TFloatIterateProcedure', + {taIterateProcedureName} 'Iterate', + {taApplyFunctionTypeName} 'TFloatApplyFunction', + {taApplyProcedureName} 'Apply', + {taCompareFunctionTypeName} 'TFloatCompare', + {taSimpleCompareFunctionName} 'FloatSimpleCompare', + {taEqualityCompareFunctionTypeName} 'TFloatEqualityCompare', + {taSimpleEqualityCompareFunctionName} 'FloatSimpleEqualityCompare', + {taHashConvertFunctionTypeName} 'TFloatHashConvert', + {taSimpleHashConvertFunctionName} 'FloatSimpleHashConvert', + {taContainerInterfaceName} 'IJclFloatContainer', + {taContainerInterfaceGUID} '', + {taFlatContainerInterfaceName} 'IJclFloatFlatContainer', + {taFlatContainerInterfaceGUID} '', + {taEqualityComparerInterfaceName} 'IJclFloatEqualityComparer', + {taEqualityComparerInterfaceGUID} '', + {taComparerInterfaceName} 'IJclFloatComparer', + {taComparerInterfaceGUID} '', + {taHashConverterInterfaceName} 'IJclFloatHashConverter', + {taHashConverterInterfaceGUID} '', + {taIteratorInterfaceName} 'IJclFloatIterator', + {taIteratorInterfaceGUID} '', + {taBinaryTreeIteratorInterfaceName} 'IJclFloatBinaryTreeIterator', + {taBinaryTreeIteratorInterfaceGUID} '', + {taBinaryTreeNodeTypeName} 'TJclFloatBinaryNode', + {taBinaryTreeClassName} 'TJclFloatBinaryTree', + {taBinaryTreeBaseIteratorClassName} 'TJclFloatBinaryTreeIterator', + {taBinaryTreePreOrderIteratorClassName} 'TJclPreOrderFloatBinaryTreeIterator', + {taBinaryTreeInOrderIteratorClassName} 'TJclInOrderFloatBinaryTreeIterator', + {taBinaryTreePostOrderIteratorClassName} 'TJclPostOrderFloatBinaryTreeIterator', + {taCollectionInterfaceName} 'IJclFloatCollection', + {taCollectionInterfaceGUID} '', + {taListInterfaceName} 'IJclFloatList', + {taListInterfaceGUID} '', + {taSortProcedureTypeName} 'TFloatSortProc', + {taSortProcedureName} 'Sort', + {taQuickSortProcedureName} 'QuickSort', + {taFindFunctionName} 'Find', + {taCountObjectFunctionName} 'CountObject', + {taCopyProcedureName} 'Copy', + {taGenerateProcedureName} 'Generate', + {taFillProcedureName} 'Fill', + {taReverseProcedureName} 'Reverse', + {taArrayInterfaceName} 'IJclFloatArray', + {taArrayInterfaceGUID} '', + {taArrayListClassName} 'TJclFloatArrayList', + {taArrayIteratorClassName} 'TJclFloatArrayIterator', + {taLinkedListItemClassName} 'TJclFloatLinkedListItem', + {taLinkedListClassName} 'TJclFloatLinkedList', + {taLinkedListIteratorClassName} 'TJclFloatLinkedListIterator', + {taVectorClassName} 'TJclFloatVector', + {taVectorIteratorClassName} 'TJclFloatVectorIterator', + {taSetInterfaceName} 'IJclFloatSet', + {taSetInterfaceGUID} '', + {taArraySetClassName} 'TJclFloatArraySet', + {taHashSetBucketTypeName} 'TJclFloatHashSetBucket', + {taHashSetClassName} 'TJclFloatHashSet', + {taHashSetIteratorClassName} 'TJclFloatHashSetIterator', + {taTreeIteratorInterfaceName} 'IJclFloatTreeIterator', + {taTreeIteratorInterfaceGUID} '', + {taTreeInterfaceName} 'IJclFloatTree', + {taTreeInterfaceGUID} '', + {taTreeNodeClassName} 'TJclFloatTreeNode', + {taTreeClassName} 'TJclFloatTree', + {taTreeBaseIteratorClassName} 'TJclFloatTreeIterator', + {taTreePreOrderIteratorClassName} 'TJclPreOrderFloatTreeIterator', + {taTreePostOrderIteratorClassName} 'TJclPostOrderFloatTreeIterator', + {taQueueInterfaceName} 'IJclFloatQueue', + {taQueueInterfaceGUID} '', + {taQueueClassName} 'TJclFloatQueue', + {taSortedSetInterfaceName} 'IJclFloatSortedSet', + {taSortedSetInterfaceGUID} '', + {taStackInterfaceName} 'IJclFloatStack', + {taStackInterfaceGUID} '', + {taStackClassName} 'TJclFloatStack' + ); + + IntegerKnownType: TKnownTypeAttributes = + ({taTypeName} 'Integer', + {taCondition} '', + {taDefines} 'ZEROINIT', + {taUndefs} 'GENERIC;REFCOUNTED', + {taAlias} '', + {taAliasCondition} '', + {taDefaultValue} '0', + {taConstKeyword} '', + {taOwnershipParameterName} '', + {taOwnershipInterfaceName} 'IJclIntegerOwner', + {taOwnershipInterfaceGUID} '{00E37ECB-0FF0-4833-8143-EB7FBEF9E208}', + {taReleaserFunctionName} 'FreeInteger', + {taReleaseEventName} 'OnFreeInteger', + {taReleaseEventTypeName} 'TFreeIntegerEvent', + {taGetterFunctionName} 'GetValue', + {taSetterProcedureName} 'SetValue', + {taParameterName} 'AValue', + {taDynArrayTypeName} 'TDynIntegerArray', + {taMoveArrayProcedureName} 'MoveArray', + {taArrayPropertyName} 'Values', + {taBaseContainerClassName} 'TJclIntegerAbstractContainer', + {taBaseCollectionClassName} '', + {taIterateProcedureTypeName} 'TIntegerIterateProcedure', + {taIterateProcedureName} 'Iterate', + {taApplyFunctionTypeName} 'TIntegerApplyFunction', + {taApplyProcedureName} 'Apply', + {taCompareFunctionTypeName} 'TIntegerCompare', + {taSimpleCompareFunctionName} 'IntegerSimpleCompare', + {taEqualityCompareFunctionTypeName} 'TIntegerEqualityCompare', + {taSimpleEqualityCompareFunctionName} 'IntegerSimpleEqualityCompare', + {taHashConvertFunctionTypeName} 'TIntegerHashConvert', + {taSimpleHashConvertFunctionName} 'IntegerSimpleHashConvert', + {taContainerInterfaceName} 'IJclIntegerContainer', + {taContainerInterfaceGUID} '{3BAF5447-9835-43A4-9FF3-E5EA7D43A7D1}', + {taFlatContainerInterfaceName} 'IJclIntegerFlatContainer', + {taFlatContainerInterfaceGUID} '{EF4EFCD9-60CB-4525-9D20-18E55291F7CF}', + {taEqualityComparerInterfaceName} 'IJclIntegerEqualityComparer', + {taEqualityComparerInterfaceGUID} '{AABC35E6-A779-4A44-B748-27BFCB34FDFB}', + {taComparerInterfaceName} 'IJclIntegerComparer', + {taComparerInterfaceGUID} '{362C3A6A-CBC1-4D5F-8652-158913DC9865}', + {taHashConverterInterfaceName} 'IJclIntegerHashConverter', + {taHashConverterInterfaceGUID} '{92C540B2-C16C-47E4-995A-644BE71878B1}', + {taIteratorInterfaceName} 'IJclIntegerIterator', + {taIteratorInterfaceGUID} '{1406A991-4574-48A1-83FE-2EDCA03908BE}', + {taBinaryTreeIteratorInterfaceName} 'IJclIntegerBinaryTreeIterator', + {taBinaryTreeIteratorInterfaceGUID} '{FE2BF57D-D10D-4B0C-903D-BB61700FBA0A}', + {taBinaryTreeNodeTypeName} 'TJclIntegerBinaryNode', + {taBinaryTreeClassName} 'TJclIntegerBinaryTree', + {taBinaryTreeBaseIteratorClassName} 'TJclIntegerBinaryTreeIterator', + {taBinaryTreePreOrderIteratorClassName} 'TJclPreOrderIntegerBinaryTreeIterator', + {taBinaryTreeInOrderIteratorClassName} 'TJclInOrderIntegerBinaryTreeIterator', + {taBinaryTreePostOrderIteratorClassName} 'TJclPostOrderIntegerBinaryTreeIterator', + {taCollectionInterfaceName} 'IJclIntegerCollection', + {taCollectionInterfaceGUID} '{AF69890D-22D1-4D89-8FFD-5FAD7E0638BA}', + {taListInterfaceName} 'IJclIntegerList', + {taListInterfaceGUID} '{339BE91B-557D-4CE0-A854-1CBD4FE31725}', + {taSortProcedureTypeName} 'TIntegerSortProc', + {taSortProcedureName} 'Sort', + {taQuickSortProcedureName} 'QuickSort', + {taFindFunctionName} 'Find', + {taCountObjectFunctionName} 'CountObject', + {taCopyProcedureName} 'Copy', + {taGenerateProcedureName} 'Generate', + {taFillProcedureName} 'Fill', + {taReverseProcedureName} 'Reverse', + {taArrayInterfaceName} 'IJclIntegerArray', + {taArrayInterfaceGUID} '{2B7C8B33-C0BD-4EC3-9764-63866E174781}', + {taArrayListClassName} 'TJclIntegerArrayList', + {taArrayIteratorClassName} 'TJclIntegerArrayIterator', + {taLinkedListItemClassName} 'TJclIntegerLinkedListItem', + {taLinkedListClassName} 'TJclIntegerLinkedList', + {taLinkedListIteratorClassName} 'TJclIntegerLinkedListIterator', + {taVectorClassName} 'TJclIntegerVector', + {taVectorIteratorClassName} 'TJclIntegerVectorIterator', + {taSetInterfaceName} 'IJclIntegerSet', + {taSetInterfaceGUID} '{5E4D29AF-F508-465B-9008-D11FF82F25FE}', + {taArraySetClassName} 'TJclIntegerArraySet', + {taHashSetBucketTypeName} 'TJclIntegerHashSetBucket', + {taHashSetClassName} 'TJclIntegerHashSet', + {taHashSetIteratorClassName} 'TJclIntegerHashSetIterator', + {taTreeIteratorInterfaceName} 'IJclIntegerTreeIterator', + {taTreeIteratorInterfaceGUID} '{88EDC5C5-CA41-41AF-9838-AA19D07E69F5}', + {taTreeInterfaceName} 'IJclIntegerTree', + {taTreeInterfaceGUID} '{40A6F934-E5F3-4C74-AC02-227035C8C3C6}', + {taTreeNodeClassName} 'TJclIntegerTreeNode', + {taTreeClassName} 'TJclIntegerTree', + {taTreeBaseIteratorClassName} 'TJclIntegerTreeIterator', + {taTreePreOrderIteratorClassName} 'TJclPreOrderIntegerTreeIterator', + {taTreePostOrderIteratorClassName} 'TJclPostOrderIntegerTreeIterator', + {taQueueInterfaceName} 'IJclIntegerQueue', + {taQueueInterfaceGUID} '{4C4E174E-5D19-44CE-A248-B5589A9B68DF}', + {taQueueClassName} 'TJclIntegerQueue', + {taSortedSetInterfaceName} 'IJclIntegerSortedSet', + {taSortedSetInterfaceGUID} '{E086C54B-4FA3-426D-AC4E-FF8E8CA3D663}', + {taStackInterfaceName} 'IJclIntegerStack', + {taStackInterfaceGUID} '{9190BF0E-5B0C-4D6C-A107-20A933C9B56A}', + {taStackClassName} 'TJclIntegerStack' + ); + + CardinalKnownType: TKnownTypeAttributes = + ({taTypeName} 'Cardinal', + {taCondition} '', + {taDefines} 'ZEROINIT', + {taUndefs} 'GENERIC;REFCOUNTED', + {taAlias} '', + {taAliasCondition} '', + {taDefaultValue} '0', + {taConstKeyword} '', + {taOwnershipParameterName} '', + {taOwnershipInterfaceName} 'IJclCardinalOwner', + {taOwnershipInterfaceGUID} '{27B3EDEF-0ACD-4592-95F2-52A1DF5E7A39}', + {taReleaserFunctionName} 'FreeCardinal', + {taReleaseEventName} 'OnFreeCardinal', + {taReleaseEventTypeName} 'TFreeCardinalEvent', + {taGetterFunctionName} 'GetValue', + {taSetterProcedureName} 'SetValue', + {taParameterName} 'AValue', + {taDynArrayTypeName} 'TDynCardinalArray', + {taMoveArrayProcedureName} 'MoveArray', + {taArrayPropertyName} 'Values', + {taBaseContainerClassName} 'TJclCardinalAbstractContainer', + {taBaseCollectionClassName} '', + {taIterateProcedureTypeName} 'TCardinalIterateProcedure', + {taIterateProcedureName} 'Iterate', + {taApplyFunctionTypeName} 'TCardinalApplyFunction', + {taApplyProcedureName} 'Apply', + {taCompareFunctionTypeName} 'TCardinalCompare', + {taSimpleCompareFunctionName} 'CardinalSimpleCompare', + {taEqualityCompareFunctionTypeName} 'TCardinalEqualityCompare', + {taSimpleEqualityCompareFunctionName} 'CardinalSimpleEqualityCompare', + {taHashConvertFunctionTypeName} 'TCardinalHashConvert', + {taSimpleHashConvertFunctionName} 'CardinalSimpleHashConvert', + {taContainerInterfaceName} 'IJclCardinalContainer', + {taContainerInterfaceGUID} '{01DF05CF-62E9-46B3-8BC1-2830EEF43644}', + {taFlatContainerInterfaceName} 'IJclCardinalFlatContainer', + {taFlatContainerInterfaceGUID} '{79E48B80-3215-47D0-A1B5-D74C495AC9D1}', + {taEqualityComparerInterfaceName} 'IJclCardinalEqualityComparer', + {taEqualityComparerInterfaceGUID} '{B2DECF81-6ECE-4D9F-80E1-C8C884DB407C}', + {taComparerInterfaceName} 'IJclCardinalComparer', + {taComparerInterfaceGUID} '{56E44725-00B9-4530-8CC2-72DCA9171EE0}', + {taHashConverterInterfaceName} 'IJclCardinalHashConverter', + {taHashConverterInterfaceGUID} '{2DF04C8A-16B8-4712-BC5D-AD35014EC9F7}', + {taIteratorInterfaceName} 'IJclCardinalIterator', + {taIteratorInterfaceGUID} '{72847A34-C8C4-4592-9447-CEB8161E33AD}', + {taBinaryTreeIteratorInterfaceName} 'IJclCardinalBinaryTreeIterator', + {taBinaryTreeIteratorInterfaceGUID} '{AAA358F5-95A1-480F-8E2A-09028BA6C397}', + {taBinaryTreeNodeTypeName} 'TJclCardinalBinaryNode', + {taBinaryTreeClassName} 'TJclCardinalBinaryTree', + {taBinaryTreeBaseIteratorClassName} 'TJclCardinalBinaryTreeIterator', + {taBinaryTreePreOrderIteratorClassName} 'TJclPreOrderCardinalBinaryTreeIterator', + {taBinaryTreeInOrderIteratorClassName} 'TJclInOrderCardinalBinaryTreeIterator', + {taBinaryTreePostOrderIteratorClassName} 'TJclPostOrderCardinalBinaryTreeIterator', + {taCollectionInterfaceName} 'IJclCardinalCollection', + {taCollectionInterfaceGUID} '{CFBD0344-58C8-4FA2-B4D7-D21D77DFBF80}', + {taListInterfaceName} 'IJclCardinalList', + {taListInterfaceGUID} '{02B09EA8-DE6F-4A18-AA57-C3533E6AC4E3}', + {taSortProcedureTypeName} 'TCardinalSortProc', + {taSortProcedureName} 'Sort', + {taQuickSortProcedureName} 'QuickSort', + {taFindFunctionName} 'Find', + {taCountObjectFunctionName} 'CountObject', + {taCopyProcedureName} 'Copy', + {taGenerateProcedureName} 'Generate', + {taFillProcedureName} 'Fill', + {taReverseProcedureName} 'Reverse', + {taArrayInterfaceName} 'IJclCardinalArray', + {taArrayInterfaceGUID} '{C451F2F8-65C6-4C29-99A0-CC9C15356418}', + {taArrayListClassName} 'TJclCardinalArrayList', + {taArrayIteratorClassName} 'TJclCardinalArrayIterator', + {taLinkedListItemClassName} 'TJclCardinalLinkedListItem', + {taLinkedListClassName} 'TJclCardinalLinkedList', + {taLinkedListIteratorClassName} 'TJclCardinalLinkedListIterator', + {taVectorClassName} 'TJclCardinalVector', + {taVectorIteratorClassName} 'TJclCardinalVectorIterator', + {taSetInterfaceName} 'IJclCardinalSet', + {taSetInterfaceGUID} '{09858637-CE8F-42E6-97E0-2786CD68387B}', + {taArraySetClassName} 'TJclCardinalArraySet', + {taHashSetBucketTypeName} 'TJclCardinalHashSetBucket', + {taHashSetClassName} 'TJclCardinalHashSet', + {taHashSetIteratorClassName} 'TJclCardinalHashSetIterator', + {taTreeIteratorInterfaceName} 'IJclCardinalTreeIterator', + {taTreeIteratorInterfaceGUID} '{FDBF493F-F79D-46EB-A59D-7193B6E6A860}', + {taTreeInterfaceName} 'IJclCardinalTree', + {taTreeInterfaceGUID} '{6C76C668-50C8-42A2-B72B-79BF102E270D}', + {taTreeNodeClassName} 'TJclCardinalTreeNode', + {taTreeClassName} 'TJclCardinalTree', + {taTreeBaseIteratorClassName} 'TJclCardinalTreeIterator', + {taTreePreOrderIteratorClassName} 'TJclPreOrderCardinalTreeIterator', + {taTreePostOrderIteratorClassName} 'TJclPostOrderCardinalTreeIterator', + {taQueueInterfaceName} 'IJclCardinalQueue', + {taQueueInterfaceGUID} '{CC1D4358-E259-4FB0-BA83-5180A0F8A6C0}', + {taQueueClassName} 'TJclCardinalQueue', + {taSortedSetInterfaceName} 'IJclCardinalSortedSet', + {taSortedSetInterfaceGUID} '{2D7995C6-A784-48B6-87E9-55D394A72362}', + {taStackInterfaceName} 'IJclCardinalStack', + {taStackInterfaceGUID} '{94F9EDB3-602B-49CE-9990-0AFDAC556F83}', + {taStackClassName} 'TJclCardinalStack' + ); + + Int64KnownType: TKnownTypeAttributes = + ({taTypeName} 'Int64', + {taCondition} '', + {taDefines} 'ZEROINIT', + {taUndefs} 'GENERIC;REFCOUNTED', + {taAlias} '', + {taAliasCondition} '', + {taDefaultValue} '0', + {taConstKeyword} 'const ', + {taOwnershipParameterName} '', + {taOwnershipInterfaceName} 'IJclInt64Owner', + {taOwnershipInterfaceGUID} '{7D4A1375-057A-42B8-8DAA-52DE30058864}', + {taReleaserFunctionName} 'FreeInt64', + {taReleaseEventName} 'OnFreeInt64', + {taReleaseEventTypeName} 'TFreeInt64Event', + {taGetterFunctionName} 'GetValue', + {taSetterProcedureName} 'SetValue', + {taParameterName} 'AValue', + {taDynArrayTypeName} 'TDynInt64Array', + {taMoveArrayProcedureName} 'MoveArray', + {taArrayPropertyName} 'Values', + {taBaseContainerClassName} 'TJclInt64AbstractContainer', + {taBaseCollectionClassName} '', + {taIterateProcedureTypeName} 'TInt64IterateProcedure', + {taIterateProcedureName} 'Iterate', + {taApplyFunctionTypeName} 'TInt64ApplyFunction', + {taApplyProcedureName} 'Apply', + {taCompareFunctionTypeName} 'TInt64Compare', + {taSimpleCompareFunctionName} 'Int64SimpleCompare', + {taEqualityCompareFunctionTypeName} 'TInt64EqualityCompare', + {taSimpleEqualityCompareFunctionName} 'Int64SimpleEqualityCompare', + {taHashConvertFunctionTypeName} 'TInt64HashConvert', + {taSimpleHashConvertFunctionName} 'Int64SimpleHashConvert', + {taContainerInterfaceName} 'IJclInt64Container', + {taContainerInterfaceGUID} '{B560B2B6-F8C7-45F0-A5E5-920AA61C1540}', + {taFlatContainerInterfaceName} 'IJclInt64FlatContainer', + {taFlatContainerInterfaceGUID} '{E740B9EF-7342-4CEF-B7FB-96C5267F5738}', + {taEqualityComparerInterfaceName} 'IJclInt64EqualityComparer', + {taEqualityComparerInterfaceGUID} '{8B2825E2-0C81-42BA-AC0D-104344CE7E56}', + {taComparerInterfaceName} 'IJclInt64Comparer', + {taComparerInterfaceGUID} '{87C935BF-3A42-4F1F-A474-9C823939EE1C}', + {taHashConverterInterfaceName} 'IJclInt64HashConverter', + {taHashConverterInterfaceGUID} '{96CF2A71-9185-4E26-B283-457ABC3584E7}', + {taIteratorInterfaceName} 'IJclInt64Iterator', + {taIteratorInterfaceGUID} '{573E5A51-BF76-43D7-9F93-46305BED20A8}', + {taBinaryTreeIteratorInterfaceName} 'IJclInt64BinaryTreeIterator', + {taBinaryTreeIteratorInterfaceGUID} '{5605E164-5CDD-40B1-9323-DE1CB584E289}', + {taBinaryTreeNodeTypeName} 'TJclInt64BinaryNode', + {taBinaryTreeClassName} 'TJclInt64BinaryTree', + {taBinaryTreeBaseIteratorClassName} 'TJclInt64BinaryTreeIterator', + {taBinaryTreePreOrderIteratorClassName} 'TJclPreOrderInt64BinaryTreeIterator', + {taBinaryTreeInOrderIteratorClassName} 'TJclInOrderInt64BinaryTreeIterator', + {taBinaryTreePostOrderIteratorClassName} 'TJclPostOrderInt64BinaryTreeIterator', + {taCollectionInterfaceName} 'IJclInt64Collection', + {taCollectionInterfaceGUID} '{93A45BDE-3C4C-48D6-9874-5322914DFDDA}', + {taListInterfaceName} 'IJclInt64List', + {taListInterfaceGUID} '{E8D49200-91D3-4BD0-A59B-B93EC7E2074B}', + {taSortProcedureTypeName} 'TInt64SortProc', + {taSortProcedureName} 'Sort', + {taQuickSortProcedureName} 'QuickSort', + {taFindFunctionName} 'Find', + {taCountObjectFunctionName} 'CountObject', + {taCopyProcedureName} 'Copy', + {taGenerateProcedureName} 'Generate', + {taFillProcedureName} 'Fill', + {taReverseProcedureName} 'Reverse', + {taArrayInterfaceName} 'IJclInt64Array', + {taArrayInterfaceGUID} '{D947C43D-2D04-442A-A707-39EDE7D96FC9}', + {taArrayListClassName} 'TJclInt64ArrayList', + {taArrayIteratorClassName} 'TJclInt64ArrayIterator', + {taLinkedListItemClassName} 'TJclInt64LinkedListItem', + {taLinkedListClassName} 'TJclInt64LinkedList', + {taLinkedListIteratorClassName} 'TJclInt64LinkedListIterator', + {taVectorClassName} 'TJclInt64Vector', + {taVectorIteratorClassName} 'TJclInt64VectorIterator', + {taSetInterfaceName} 'IJclInt64Set', + {taSetInterfaceGUID} '{ACB3127A-48EE-4F9F-B988-6AE9057780E9}', + {taArraySetClassName} 'TJclInt64ArraySet', + {taHashSetBucketTypeName} 'TJclInt64HashSetBucket', + {taHashSetClassName} 'TJclInt64HashSet', + {taHashSetIteratorClassName} 'TJclInt64HashSetIterator', + {taTreeIteratorInterfaceName} 'IJclInt64TreeIterator', + {taTreeIteratorInterfaceGUID} '{C5A5E504-E19B-43AC-90B9-E4B8984BFA23}', + {taTreeInterfaceName} 'IJclInt64Tree', + {taTreeInterfaceGUID} '{1925B973-8B75-4A79-A993-DF2598FF19BE}', + {taTreeNodeClassName} 'TJclInt64TreeNode', + {taTreeClassName} 'TJclInt64Tree', + {taTreeBaseIteratorClassName} 'TJclInt64TreeIterator', + {taTreePreOrderIteratorClassName} 'TJclPreOrderInt64TreeIterator', + {taTreePostOrderIteratorClassName} 'TJclPostOrderInt64TreeIterator', + {taQueueInterfaceName} 'IJclInt64Queue', + {taQueueInterfaceGUID} '{96B620BB-9A90-43D5-82A7-2D818A11C8E1}', + {taQueueClassName} 'TJclInt64Queue', + {taSortedSetInterfaceName} 'IJclInt64SortedSet', + {taSortedSetInterfaceGUID} '{4C1C3FCA-6169-4A2F-B044-91AC2AA2E954}', + {taStackInterfaceName} 'IJclInt64Stack', + {taStackInterfaceGUID} '{D689EB8F-2746-40E9-AD1B-7E656475FC64}', + {taStackClassName} 'TJclInt64Stack' + ); + + PointerKnownType: TKnownTypeAttributes = + ({taTypeName} 'Pointer', + {taCondition} '', + {taDefines} 'ZEROINIT', + {taUndefs} 'GENERIC;REFCOUNTED', + {taAlias} '', + {taAliasCondition} '', + {taDefaultValue} 'nil', + {taConstKeyword} '', + {taOwnershipParameterName} '', + {taOwnershipInterfaceName} 'IJclPtrOwner', + {taOwnershipInterfaceGUID} '{28340328-34AD-4632-9BAC-A7387A822200}', + {taReleaserFunctionName} 'FreePointer', + {taReleaseEventName} 'OnFreePointer', + {taReleaseEventTypeName} 'TFreePtrEvent', + {taGetterFunctionName} 'GetPointer', + {taSetterProcedureName} 'SetPointer', + {taParameterName} 'APtr', + {taDynArrayTypeName} 'TDynPointerArray', + {taMoveArrayProcedureName} 'MoveArray', + {taArrayPropertyName} 'Pointers', + {taBaseContainerClassName} 'TJclPtrAbstractContainer', + {taBaseCollectionClassName} '', + {taIterateProcedureTypeName} 'TPtrIterateProcedure', + {taIterateProcedureName} 'Iterate', + {taApplyFunctionTypeName} 'TPtrApplyFunction', + {taApplyProcedureName} 'Apply', + {taCompareFunctionTypeName} 'TPtrCompare', + {taSimpleCompareFunctionName} 'PtrSimpleCompare', + {taEqualityCompareFunctionTypeName} 'TPtrEqualityCompare', + {taSimpleEqualityCompareFunctionName} 'PtrSimpleEqualityCompare', + {taHashConvertFunctionTypeName} 'TPtrHashConvert', + {taSimpleHashConvertFunctionName} 'PtrSimpleHashConvert', + {taContainerInterfaceName} 'IJclPtrContainer', + {taContainerInterfaceGUID} '{E8DD2A85-1E12-4605-B517-7E3121C5624F}', + {taFlatContainerInterfaceName} 'IJclPtrFlatContainer', + {taFlatContainerInterfaceGUID} '{43C41789-DE71-4DA5-B4AC-3F53EB9459CD}', + {taEqualityComparerInterfaceName} 'IJclPtrEqualityComparer', + {taEqualityComparerInterfaceGUID} '{C6B7CBF9-ECD9-4D70-85CC-4E2367A1D806}', + {taComparerInterfaceName} 'IJclPtrComparer', + {taComparerInterfaceGUID} '{85557D4C-A036-477E-BA73-B5EEF43A8696}', + {taHashConverterInterfaceName} 'IJclPtrHashConverter', + {taHashConverterInterfaceGUID} '{D704CC67-CFED-44E6-9504-65D5E468FCAF}', + {taIteratorInterfaceName} 'IJclPtrIterator', + {taIteratorInterfaceGUID} '{62B5501C-07AA-4D00-A85B-713B39912CDF}', + {taBinaryTreeIteratorInterfaceName} 'IJclPtrBinaryTreeIterator', + {taBinaryTreeIteratorInterfaceGUID} '{75D3DF0D-C491-43F7-B078-E658197E8051}', + {taBinaryTreeNodeTypeName} 'TJclPtrBinaryNode', + {taBinaryTreeClassName} 'TJclPtrBinaryTree', + {taBinaryTreeBaseIteratorClassName} 'TJclPtrBinaryTreeIterator', + {taBinaryTreePreOrderIteratorClassName} 'TJclPreOrderPtrBinaryTreeIterator', + {taBinaryTreeInOrderIteratorClassName} 'TJclInOrderPtrBinaryTreeIterator', + {taBinaryTreePostOrderIteratorClassName} 'TJclPostOrderPtrBinaryTreeIterator', + {taCollectionInterfaceName} 'IJclPtrCollection', + {taCollectionInterfaceGUID} '{02E909A7-5B1D-40D4-82EA-A0CD97D5C811}', + {taListInterfaceName} 'IJclPtrList', + {taListInterfaceGUID} '{2CF5CF1F-C012-480C-A4CE-38BDAFB15D05}', + {taSortProcedureTypeName} 'TPtrSortProc', + {taSortProcedureName} 'Sort', + {taQuickSortProcedureName} 'QuickSort', + {taFindFunctionName} 'Find', + {taCountObjectFunctionName} 'CountObject', + {taCopyProcedureName} 'Copy', + {taGenerateProcedureName} 'Generate', + {taFillProcedureName} 'Fill', + {taReverseProcedureName} 'Reverse', + {taArrayInterfaceName} 'IJclPtrArray', + {taArrayInterfaceGUID} '{D43E8D18-26B3-41A2-8D52-ED7EA2FE1AB7}', + {taArrayListClassName} 'TJclPtrArrayList', + {taArrayIteratorClassName} 'TJclPtrArrayIterator', + {taLinkedListItemClassName} 'TJclPtrLinkedListItem', + {taLinkedListClassName} 'TJclPtrLinkedList', + {taLinkedListIteratorClassName} 'TJclPtrLinkedListIterator', + {taVectorClassName} 'TJclPtrVector', + {taVectorIteratorClassName} 'TJclPtrVectorIterator', + {taSetInterfaceName} 'IJclPtrSet', + {taSetInterfaceGUID} '{26717C68-4F83-4CCB-973A-7324FBD09632}', + {taArraySetClassName} 'TJclPtrArraySet', + {taHashSetBucketTypeName} 'TJclPtrHashSetBucket', + {taHashSetClassName} 'TJclPtrHashSet', + {taHashSetIteratorClassName} 'TJclPtrHashSetIterator', + {taTreeIteratorInterfaceName} 'IJclPtrTreeIterator', + {taTreeIteratorInterfaceGUID} '{ED4C08E6-60FC-4ED3-BD19-E6605B9BD943}', + {taTreeInterfaceName} 'IJclPtrTree', + {taTreeInterfaceGUID} '{2C1ACA3E-3F23-4E3C-984D-151CF9776E14}', + {taTreeNodeClassName} 'TJclPtrTreeNode', + {taTreeClassName} 'TJclPtrTree', + {taTreeBaseIteratorClassName} 'TJclPtrTreeIterator', + {taTreePreOrderIteratorClassName} 'TJclPreOrderPtrTreeIterator', + {taTreePostOrderIteratorClassName} 'TJclPostOrderPtrTreeIterator', + {taQueueInterfaceName} 'IJclPtrQueue', + {taQueueInterfaceGUID} '{1052DD37-3035-4C44-A793-54AC4B9C0B29}', + {taQueueClassName} 'TJclPtrQueue', + {taSortedSetInterfaceName} 'IJclPtrSortedSet', + {taSortedSetInterfaceGUID} '{F3A3183C-0820-425C-9446-E0838F0ADAD8}', + {taStackInterfaceName} 'IJclPtrStack', + {taStackInterfaceGUID} '{AD11D06C-E0E1-4EDE-AA2F-BC8BDD972B73}', + {taStackClassName} 'TJclPtrStack' + ); + + TObjectKnownType: TKnownTypeAttributes = + ({taTypeName} 'TObject', + {taCondition} '', + {taDefines} 'OWNABLE;ZEROINIT', + {taUndefs} 'GENERIC;REFCOUNTED', + {taAlias} '', + {taAliasCondition} '', + {taDefaultValue} 'nil', + {taConstKeyword} '', + {taOwnershipParameterName} 'AOwnsObjects', + {taOwnershipInterfaceName} 'IJclObjectOwner', + {taOwnershipInterfaceGUID} '{5157EA13-924E-4A56-995D-36956441025C}', + {taReleaserFunctionName} 'FreeObject', + {taReleaseEventName} 'OnFreeObject', + {taReleaseEventTypeName} 'TFreeObjectEvent', + {taGetterFunctionName} 'GetObject', + {taSetterProcedureName} 'SetObject', + {taParameterName} 'AObject', + {taDynArrayTypeName} 'TDynObjectArray', + {taMoveArrayProcedureName} 'MoveArray', + {taArrayPropertyName} 'Objects', + {taBaseContainerClassName} 'TJclAbstractContainer', + {taBaseCollectionClassName} '', + {taIterateProcedureTypeName} 'TIterateProcedure', + {taIterateProcedureName} 'Iterate', + {taApplyFunctionTypeName} 'TApplyFunction', + {taApplyProcedureName} 'Apply', + {taCompareFunctionTypeName} 'TCompare', + {taSimpleCompareFunctionName} 'SimpleCompare', + {taEqualityCompareFunctionTypeName} 'TEqualityCompare', + {taSimpleEqualityCompareFunctionName} 'SimpleEqualityCompare', + {taHashConvertFunctionTypeName} 'THashConvert', + {taSimpleHashConvertFunctionName} 'SimpleHashConvert', + {taContainerInterfaceName} 'IJclContainer', + {taContainerInterfaceGUID} '{A9EBED03-4993-426A-8449-30D98DC2AC90}', + {taFlatContainerInterfaceName} 'IJclFlatContainer', + {taFlatContainerInterfaceGUID} '{0A070B6F-54A1-4B3D-A4E4-CFFAE2C7C57B}', + {taEqualityComparerInterfaceName} 'IJclEqualityComparer', + {taEqualityComparerInterfaceGUID} '{82C67986-8365-44AB-8D56-7B0CF4F6B918}', + {taComparerInterfaceName} 'IJclComparer', + {taComparerInterfaceGUID} '{7B376028-56DC-4C4A-86A9-1AC19E3EDF75}', + {taHashConverterInterfaceName} 'IJclHashConverter', + {taHashConverterInterfaceGUID} '{2D0DD6F4-162E-41D6-8A34-489E7EACABCD}', + {taIteratorInterfaceName} 'IJclIterator', + {taIteratorInterfaceGUID} '{997DF9B7-9AA2-4239-8B94-14DFFD26D790}', + {taBinaryTreeIteratorInterfaceName} 'IJclBinaryTreeIterator', + {taBinaryTreeIteratorInterfaceGUID} '{821DE28D-631C-4F23-A0B2-CC0F35B4C64D}', + {taBinaryTreeNodeTypeName} 'TJclBinaryNode', + {taBinaryTreeClassName} 'TJclBinaryTree', + {taBinaryTreeBaseIteratorClassName} 'TJclBinaryTreeIterator', + {taBinaryTreePreOrderIteratorClassName} 'TJclPreOrderBinaryTreeIterator', + {taBinaryTreeInOrderIteratorClassName} 'TJclInOrderBinaryTreeIterator', + {taBinaryTreePostOrderIteratorClassName} 'TJclPostOrderBinaryTreeIterator', + {taCollectionInterfaceName} 'IJclCollection', + {taCollectionInterfaceGUID} '{58947EF1-CD21-4DD1-AE3D-225C3AAD7EE5}', + {taListInterfaceName} 'IJclList', + {taListInterfaceGUID} '{8ABC70AC-5C06-43EA-AFE0-D066379BCC28}', + {taSortProcedureTypeName} 'TSortProc', + {taSortProcedureName} 'Sort', + {taQuickSortProcedureName} 'QuickSort', + {taFindFunctionName} 'Find', + {taCountObjectFunctionName} 'CountObject', + {taCopyProcedureName} 'Copy', + {taGenerateProcedureName} 'Generate', + {taFillProcedureName} 'Fill', + {taReverseProcedureName} 'Reverse', + {taArrayInterfaceName} 'IJclArray', + {taArrayInterfaceGUID} '{A69F6D35-54B2-4361-852E-097ED75E648A}', + {taArrayListClassName} 'TJclArrayList', + {taArrayIteratorClassName} 'TJclArrayIterator', + {taLinkedListItemClassName} 'TJclLinkedListItem', + {taLinkedListClassName} 'TJclLinkedList', + {taLinkedListIteratorClassName} 'TJclLinkedListIterator', + {taVectorClassName} 'TJclVector', + {taVectorIteratorClassName} 'TJclVectorIterator', + {taSetInterfaceName} 'IJclSet', + {taSetInterfaceGUID} '{0B7CDB90-8588-4260-A54C-D87101C669EA}', + {taArraySetClassName} 'TJclArraySet', + {taHashSetBucketTypeName} 'TJclHashSetBucket', + {taHashSetClassName} 'TJclHashSet', + {taHashSetIteratorClassName} 'TJclHashSetIterator', + {taTreeIteratorInterfaceName} 'IJclTreeIterator', + {taTreeIteratorInterfaceGUID} '{8B4863B0-B6B9-426E-B5B8-7AF71D264237}', + {taTreeInterfaceName} 'IJclTree', + {taTreeInterfaceGUID} '{B0C658CC-FEF5-4178-A4C5-442C0DEDE207}', + {taTreeNodeClassName} 'TJclTreeNode', + {taTreeClassName} 'TJclTree', + {taTreeBaseIteratorClassName} 'TJclTreeIterator', + {taTreePreOrderIteratorClassName} 'TJclPreOrderTreeIterator', + {taTreePostOrderIteratorClassName} 'TJclPostOrderTreeIterator', + {taQueueInterfaceName} 'IJclQueue', + {taQueueInterfaceGUID} '{7D0F9DE4-71EA-46EF-B879-88BCFD5D9610}', + {taQueueClassName} 'TJclQueue', + {taSortedSetInterfaceName} 'IJclSortedSet', + {taSortedSetInterfaceGUID} '{A3D23E76-ADE9-446C-9B97-F49FCE895D9F}', + {taStackInterfaceName} 'IJclStack', + {taStackInterfaceGUID} '{E07E0BD8-A831-41B9-B9A0-7199BD4873B9}', + {taStackClassName} 'TJclStack' + ); + + KnownAllTypes: array[0..13] of PKnownTypeAttributes = + ( @IInterfaceKnownType, + @AnsiStringKnownType, + @WideStringKnownType, + @UnicodeStringKnownType, + @StringKnownType, + @SingleKnownType, + @DoubleKnownType, + @ExtendedKnownType, + @FloatKnownType, + @IntegerKnownType, + @CardinalKnownType, + @Int64KnownType, + @PointerKnownType, + @TObjectKnownType ); + + // same as previous, except without compiler magic types (string) and type aliases (float) + KnownTrueTypes: array[0..11] of PKnownTypeAttributes = + ( @IInterfaceKnownType, + @AnsiStringKnownType, + @WideStringKnownType, + @UnicodeStringKnownType, + @SingleKnownType, + @DoubleKnownType, + @ExtendedKnownType, + @IntegerKnownType, + @CardinalKnownType, + @Int64KnownType, + @PointerKnownType, + @TObjectKnownType ); + +function IsKnownType(const TypeName: string): PKnownTypeAttributes; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +function IsKnownType(const TypeName: string): PKnownTypeAttributes; +var + I: Integer; +begin + Result := nil; + for I := Low(KnownAllTypes) to High(KnownAllTypes) do + if SameText(TypeName, KnownAllTypes[I]^[taTypeName]) then + begin + Result := KnownAllTypes[I]; + Break; + end; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclPreProcessorContainerTemplates.pas b/3rdParty/JCL/source/common/JclPreProcessorContainerTemplates.pas new file mode 100644 index 00000000..2960530b --- /dev/null +++ b/3rdParty/JCL/source/common/JclPreProcessorContainerTemplates.pas @@ -0,0 +1,703 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclContainerTemplates.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. } +{ } +{ Contributors: } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclPreProcessorContainerTemplates; + +interface + +{$I jcl.inc} + +uses + {$IFDEF HAS_UNITSCOPE} + System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Classes, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclBase, + JclIDEUtils, + JclPreProcessorTemplates, + JclPreProcessorContainerTypes, + JclPreProcessorContainer1DTemplates, + JclPreProcessorContainer2DTemplates; + +{$TYPEINFO ON} + +type + TJclContainerParams = class(TJclTemplateParams) + private + FTypeInfo: TJclContainerTypeInfo; + FAllTypeIndex: Integer; + FTrueTypeIndex: Integer; + FMapInfo: TJclContainerMapInfo; + FAllMapIndex: Integer; + FTrueMapIndex: Integer; + function GetAllTypeCount: Integer; + function GetHelpAllTypeCount: Integer; + function GetTrueTypeCount: Integer; + function GetHelpTrueTypeCount: Integer; + procedure SetAllTypeIndex(const Value: Integer); + procedure SetTrueTypeIndex(const Value: Integer); + function GetAllMapCount: Integer; + function GetHelpAllMapCount: Integer; + function GetTrueMapCount: Integer; + function GetHelpTrueMapCount: Integer; + procedure SetAllMapIndex(const Value: Integer); + procedure SetMapTypeIndex(const Value: Integer); + protected + function ProcessConditional(const MacroText: string; ContainerTypeInfo: TJclContainerTypeInfo): string; + procedure ProcessDefines(const Prefix, Defines, Undefs: string); + public + constructor Create; + destructor Destroy; override; + function ExpandMacro(const AName: string; const ParamValues: TDynStringArray): string; override; + published + property AllTypeIndex: Integer read FAllTypeIndex write SetAllTypeIndex; + property AllTypeCount: Integer read GetAllTypeCount; + property HelpAllTypeCount: Integer read GetHelpAllTypeCount; + property TrueTypeIndex: Integer read FTrueTypeIndex write SetTrueTypeIndex; + property TrueTypeCount: Integer read GetTrueTypeCount; + property HelpTrueTypeCount: Integer read GetHelpTrueTypeCount; + property AllMapIndex: Integer read FAllMapIndex write SetAllMapIndex; + property AllMapCount: Integer read GetAllMapCount; + property HelpAllMapCount: Integer read GetHelpAllMapCount; + property TrueMapIndex: Integer read FTrueMapIndex write SetMapTypeIndex; + property TrueMapCount: Integer read GetTrueMapCount; + property HelpTrueMapCount: Integer read GetHelpTrueMapCount; + end; + +{$IFNDEF TYPEINFO_ON} + {$TYPEINFO OFF} +{$ENDIF ~TYPEINFO_ON} + +procedure RegisterContainerParams(const PrototypeName: string; + InterfaceParamsClass: TJclInterfaceParamsClass); overload; +procedure RegisterContainerParams(const PrototypeName: string; + ImplementationParamsClass: TJclImplementationParamsClass; + InterfaceParamsClass: TJclInterfaceParamsClass); overload; +procedure FindContainerParams(const PrototypeName: string; + out InterfaceParamsClass: TJclInterfaceParamsClass; + out ImplementationParamsClass: TJclImplementationParamsClass); + +procedure CheckJclContainers; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Winapi.Windows, + {$ENDIF MSWINDOWS} + System.TypInfo, + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + TypInfo, + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclRTTI, + JclSysUtils, + JclStrings, + JclContainerIntf, + JclPreProcessorContainerKnownTypes, + JclPreProcessorContainerKnownMaps; + +type + TInterfaceParamsRec = record + ParamsName: string; + ParamsCount: Integer; + ParamsClass: TJclInterfaceParamsClass; + end; + + TImplementationParamsRec = record + ParamsName: string; + ParamsCount: Integer; + ParamsClass: TJclImplementationParamsClass; + InterfaceParamsClass: TJclInterfaceParamsClass; + end; + +var + GlobalInterfaceParams: array of TInterfaceParamsRec; + GlobalImplementationParams: array of TImplementationParamsRec; + GlobalTypeAttributeHandlers: array [TAllTypeAttributeID] of TJclInterfaceParamsClass; + GlobalTypeAttributeDependencies: array [TAllTypeAttributeID] of TAllTypeAttributeIDs; + +procedure ClearRegisteredContainers; +var + AttributeID: TAllTypeAttributeID; +begin + SetLength(GlobalInterfaceParams, 0); + SetLength(GlobalImplementationParams, 0); + // avoid spurious errors while recompiling installed package in the IDE + // for some reasons the GlobalTypeAttributeHandlers and GlobalAttirbuteDependencies + // are not clean when the package is reloaded + for AttributeID := Low(AttributeID) to High(AttributeID) do + begin + GlobalTypeAttributeHandlers[AttributeID] := nil; + GlobalTypeAttributeDependencies[AttributeID] := []; + end; +end; + +procedure RegisterContainerParams(const PrototypeName: string; + InterfaceParamsClass: TJclInterfaceParamsClass); +var + PropList: PPropList; + PropInfo: PPropInfo; + PropCount, Index: Integer; + Dependencies: TAllTypeAttributeIDs; +begin + // avoid duplicate registrations + for Index := Low(GlobalInterfaceParams) to High(GlobalInterfaceParams) do + if (GlobalInterfaceParams[Index].ParamsName = PrototypeName) then + Exit; + + PropCount := GetStringPropList(InterfaceParamsClass.ClassInfo, PropList); + if PropCount > 0 then + begin + try + Dependencies := []; + for Index := 0 to PropCount - 1 do + begin + PropInfo := PropList^[Index]; + if (PropInfo^.Index > 0) and (PropInfo^.StoredProc = nil) then + Include(Dependencies, TAllTypeAttributeID(PropInfo^.Index)); + end; + for Index := 0 to PropCount - 1 do + begin + PropInfo := PropList^[Index]; + if (PropInfo^.Index > 0) and (PropInfo^.StoredProc <> nil) then + begin + if Assigned(GlobalTypeAttributeHandlers[TAllTypeAttributeID(PropInfo^.Index)]) then + raise EJclContainerException.CreateFmt('Duplicate handler for attribute %s: %s and %s', + [GetEnumName(TypeInfo(TAllTypeAttributeID), PropInfo^.Index), + GlobalTypeAttributeHandlers[TAllTypeAttributeID(PropInfo^.Index)].ClassName, + InterfaceParamsClass.ClassName]); + GlobalTypeAttributeHandlers[TAllTypeAttributeID(PropInfo^.Index)] := InterfaceParamsClass; + GlobalTypeAttributeDependencies[TAllTypeAttributeID(PropInfo^.Index)] := Dependencies; + end; + end; + if PrototypeName <> '' then + begin + Index := Length(GlobalInterfaceParams); + SetLength(GlobalInterfaceParams, Index + 1); + GlobalInterfaceParams[Index].ParamsName := PrototypeName; + GlobalInterfaceParams[Index].ParamsCount := PropCount; + GlobalInterfaceParams[Index].ParamsClass := InterfaceParamsClass; + end; + finally + FreeMem(PropList); + end; + end; +end; + +procedure RegisterContainerParams(const PrototypeName: string; + ImplementationParamsClass: TJclImplementationParamsClass; + InterfaceParamsClass: TJclInterfaceParamsClass); +var + PropList: PPropList; + PropCount, Index: Integer; + PropInfo: PPropInfo; +begin + // avoid duplicate registrations + for Index := Low(GlobalImplementationParams) to High(GlobalImplementationParams) do + if (GlobalImplementationParams[Index].ParamsName = PrototypeName) then + Exit; + + PropCount := GetStringPropList(ImplementationParamsClass.ClassInfo, PropList); + if PropCount > 0 then + begin + try + for Index := 0 to PropCount - 1 do + begin + PropInfo := PropList^[Index]; + if (PropInfo^.Index > 0) and (PropInfo^.StoredProc <> nil) then + raise EJclContainerException.CreateFmt('Invalid interface handler for attribute %s in %s', + [GetEnumName(TypeInfo(TAllTypeAttributeID), PropInfo^.Index), + ImplementationParamsClass.ClassName]); + end; + if PrototypeName <> '' then + begin + Index := Length(GlobalImplementationParams); + SetLength(GlobalImplementationParams, Index + 1); + GlobalImplementationParams[Index].ParamsName := PrototypeName; + GlobalImplementationParams[Index].ParamsCount := PropCount; + GlobalImplementationParams[Index].ParamsClass := ImplementationParamsClass; + GlobalImplementationParams[Index].InterfaceParamsClass := InterfaceParamsClass; + end; + finally + FreeMem(PropList); + end; + end; +end; + +procedure FindContainerParams(const PrototypeName: string; + out InterfaceParamsClass: TJclInterfaceParamsClass; + out ImplementationParamsClass: TJclImplementationParamsClass); +var + ParamsCount, Index: Integer; + MacroName: string; +begin + InterfaceParamsClass := nil; + ImplementationParamsClass := nil; + Index := Pos('`', PrototypeName); + if Index > 0 then + begin + MacroName := Copy(PrototypeName, 1, Index - 1); + ParamsCount := StrToInt(Copy(PrototypeName, Index + 1, Length(PrototypeName) - Index)); + end + else + begin + MacroName := PrototypeName; + ParamsCount := -1; + end; + InterfaceParamsClass := nil; + ImplementationParamsClass := nil; + for Index := Low(GlobalInterfaceParams) to High(GlobalInterfaceParams) do + if AnsiSameText(MacroName, GlobalInterfaceParams[Index].ParamsName) and + ((ParamsCount = -1) or (ParamsCount = GlobalInterfaceParams[Index].ParamsCount)) then + begin + InterfaceParamsClass := GlobalInterfaceParams[Index].ParamsClass; + ImplementationParamsClass := nil; + Exit; + end; + for Index := Low(GlobalImplementationParams) to High(GlobalImplementationParams) do + if AnsiSameText(MacroName, GlobalImplementationParams[Index].ParamsName) and + ((ParamsCount = -1) or (ParamsCount = GlobalImplementationParams[Index].ParamsCount)) then + begin + InterfaceParamsClass := GlobalImplementationParams[Index].InterfaceParamsClass; + ImplementationParamsClass := GlobalImplementationParams[Index].ParamsClass; + Exit; + end; +end; + +procedure CheckJclContainers; +var + Index: TAllTypeAttributeID; +begin + for Index := Low(TAllTypeAttributeID) to High(TAllTypeAttributeID) do + if (Index <> taTypeName) and (Index <> maMapAncestorClassName) and + // exclude key and value attribute ID that are aliases to standard type ID + ((Index < Low(TKeyAttributeID)) or (Index > High(TKeyAttributeID))) and + ((Index < Low(TValueAttributeID)) or (Index > High(TValueAttributeID))) and + (GlobalTypeAttributeHandlers[Index] = nil) then + raise EJclContainerException.CreateFmt('No handler found for attribute %s', + [GetEnumName(TypeInfo(TAllTypeAttributeID), Integer(Index))]); +end; + +//function FindContainerParams(TypeInformationID: TTypeAttributeID): TJclContainerParamsClass; overload; +//begin + +//end; + +//function FindContainerParams(const PrototypeName: string): TJclContainerParamsClass; overload; +//begin + +//end; + +//=== { TJclContainerParams } ================================================ + +constructor TJclContainerParams.Create; +begin + inherited Create; + FTypeInfo := TJclContainerTypeInfo.Create; + FMapInfo := TJclContainerMapInfo.Create; +end; + +destructor TJclContainerParams.Destroy; +begin + FMapInfo.Free; + FTypeInfo.Free; + inherited Destroy; +end; + +function TJclContainerParams.ExpandMacro(const AName: string; + const ParamValues: TDynStringArray): string; +var + InterfaceParamsClass: TJclInterfaceParamsClass; + ImplementationParamsClass: TJclImplementationParamsClass; + InterfaceParams: TJclInterfaceParams; + ImplementationParams: TJclImplementationParams; + AMacroName, AMacroText: string; + AMacro: IJclStrList; + AMacroParams: TDynWideStringArray; + Params: array of TVarRec; + Index: Integer; + PropInfo: PPropInfo; + AliasAttributeID: TAllTypeAttributeID; + AliasAttributeIDs: TAllTypeAttributeIDs; + AliasTypeIndex, AliasMapIndex: Integer; + AliasTypeAttributes: PKnownTypeAttributes; + AliasMapAttributes: PKnownMapAttributes; +begin + SetLength(AMacroParams, 0); + FindContainerParams(AName, InterfaceParamsClass, ImplementationParamsClass); + if InterfaceParamsClass <> nil then + begin + InterfaceParams := InterfaceParamsClass.Create; + if InterfaceParams is TJclContainerInterfaceParams then + TJclContainerInterfaceParams(InterfaceParams).TypeInfo := FTypeInfo; + if InterfaceParams is TJclMapInterfaceParams then + TJclMapInterfaceParams(InterfaceParams).MapInfo := FMapInfo; + if ImplementationParamsClass <> nil then + ImplementationParams := ImplementationParamsClass.Create(InterfaceParams) + else + ImplementationParams := nil; + try + AMacroName := Format('%s`%d', [AName, Length(ParamValues)]); + AMacro := FindMacro(AMacroName); + // the macro text is the last item, previous items are the macro parameter names + AMacroText := AMacro.Strings[AMacro.Size - 1]; + AMacroParams := AssociateParameters(AMacro.SubList(0, AMacro.Size - 1), ParamValues); + + if ImplementationParams <> nil then + AliasAttributeIDs := [] + else + AliasAttributeIDs := InterfaceParams.AliasAttributeIDs; + + Result := ''; + + if AliasAttributeIDs <> [] then + begin + // this is an alias declaration + // replace the macro with some predefined text + if (InterfaceParams is TJclContainerInterfaceParams) and FTypeInfo.KnownType then + begin + for AliasTypeIndex := Low(KnownAllTypes) to High(KnownAllTypes) do + begin + AliasTypeAttributes := KnownAllTypes[AliasTypeIndex]; + if AliasTypeAttributes^[taAlias] = FTypeInfo.TypeName then + begin + Result := Format('%s{$IFDEF %s}%s', [Result, AliasTypeAttributes^[taAliasCondition], NativeLineBreak]); + for AliasAttributeID := Low(AliasAttributeID) to High(AliasAttributeID) do + if AliasAttributeID in AliasAttributeIDs then + begin + Result := Format('%s%s = %s;%s', + [Result, FTypeInfo.TypeAttributes[AliasAttributeID], AliasTypeAttributes^[AliasAttributeID], NativeLineBreak]); + end; + Result := Format('%s{$ENDIF %s}%s', [Result, AliasTypeAttributes^[taAliasCondition], NativeLineBreak]); + end; + end; + end + else + if (InterfaceParams is TJclMapInterfaceParams) and FMapInfo.KnownMap then + begin + for AliasMapIndex := Low(KnownAllMaps) to High(KnownAllMaps) do + begin + AliasMapAttributes := KnownAllMaps[AliasMapIndex]; + // key alias + if (AliasMapAttributes^.KeyAttributes[taAlias] = FMapInfo.KeyTypeInfo.TypeName) and + (AliasMapAttributes^.ValueAttributes[taTypeName] = FMapInfo.ValueTypeInfo.TypeName) then + begin + Result := Format('%s{$IFDEF %s}%s', [Result, AliasMapAttributes^.KeyAttributes[taAliasCondition], NativeLineBreak]); + for AliasAttributeID := Low(AliasAttributeID) to High(AliasAttributeID) do + if AliasAttributeID in AliasAttributeIDs then + begin + Result := Format('%s%s = %s;%s', + [Result, FMapInfo.MapAttributes[AliasAttributeID], AliasMapAttributes^.MapAttributes[AliasAttributeID], NativeLineBreak]); + end; + Result := Format('%s{$ENDIF %s}%s', [Result, AliasMapAttributes^.KeyAttributes[taAliasCondition], NativeLineBreak]); + end + else + // value alias + if (AliasMapAttributes^.ValueAttributes[taAlias] = FMapInfo.ValueTypeInfo.TypeName) and + (AliasMapAttributes^.KeyAttributes[taTypeName] = FMapInfo.KeyTypeInfo.TypeName) then + begin + Result := Format('%s{$IFDEF %s}%s', [Result, AliasMapAttributes^.ValueAttributes[taAliasCondition], NativeLineBreak]); + for AliasAttributeID := Low(AliasAttributeID) to High(AliasAttributeID) do + if AliasAttributeID in AliasAttributeIDs then + begin + Result := Format('%s%s = %s;%s', + [Result, FMapInfo.MapAttributes[AliasAttributeID], AliasMapAttributes^.MapAttributes[AliasAttributeID], NativeLineBreak]); + end; + Result := Format('%s{$ENDIF %s}%s', [Result, AliasMapAttributes^.ValueAttributes[taAliasCondition], NativeLineBreak]); + end + else + // both aliases + if (AliasMapAttributes^.KeyAttributes[taAlias] = FMapInfo.KeyTypeInfo.TypeName) and + (AliasMapAttributes^.ValueAttributes[taAlias] = FMapInfo.ValueTypeInfo.TypeName) then + begin + if AliasMapAttributes^.KeyAttributes[taAliasCondition] <> AliasMapAttributes^.ValueAttributes[taAliasCondition] then + Result := Format('%s{$IFDEF %s}%s{$IFDEF %s}%s', + [Result, + AliasMapAttributes^.KeyAttributes[taAliasCondition], NativeLineBreak, + AliasMapAttributes^.ValueAttributes[taAliasCondition], NativeLineBreak]) + else + Result := Format('%s{$IFDEF %s}%s', [Result, AliasMapAttributes^.KeyAttributes[taAliasCondition], NativeLineBreak]); + for AliasAttributeID := Low(AliasAttributeID) to High(AliasAttributeID) do + if AliasAttributeID in AliasAttributeIDs then + begin + Result := Format('%s%s = %s;%s', + [Result, FMapInfo.MapAttributes[AliasAttributeID], AliasMapAttributes^.MapAttributes[AliasAttributeID], NativeLineBreak]); + end; + if AliasMapAttributes^.KeyAttributes[taAliasCondition] <> AliasMapAttributes^.ValueAttributes[taAliasCondition] then + Result := Format('%s{$ENDIF %s}%s{$ENDIF %s}%s', + [Result, + AliasMapAttributes^.KeyAttributes[taAliasCondition], NativeLineBreak, + AliasMapAttributes^.ValueAttributes[taAliasCondition], NativeLineBreak]) + else + Result := Format('%s{$ENDIF %s}%s', [Result, AliasMapAttributes^.KeyAttributes[taAliasCondition], NativeLineBreak]); + end; + end; + end; + end; + + if Result = '' then + begin + // expand the macro + SetLength(Params, Length(ParamValues)); + for Index := Low(ParamValues) to High(ParamValues) do + begin + if AMacroParams[Index] = '' then + begin + // default to params + if Assigned(ImplementationParams) then + begin + PropInfo := GetPropInfo(ImplementationParams, AMacro.Strings[Index]); + if Assigned(PropInfo) then + {$IFDEF COMPILER8_UP} + AMacroParams[Index] := GetPropValue(ImplementationParams, PropInfo); + {$ELSE ~COMPILER8_UP} + AMacroParams[Index] := GetPropValue(ImplementationParams, AMacro.Strings[Index]); + {$ENDIF ~COMPILER8_UP} + end + else + begin + PropInfo := GetPropInfo(InterfaceParams, AMacro.Strings[Index]); + if Assigned(PropInfo) then + {$IFDEF COMPILER8_UP} + AMacroParams[Index] := GetPropValue(InterfaceParams, PropInfo) + {$ELSE ~COMPILER8_UP} + AMacroParams[Index] := GetPropValue(InterfaceParams, AMacro.Strings[Index]) + {$ENDIF ~COMPILER8_UP} + else + Beep; + end; + end; + Params[Index].VType := vtPWideChar; + Params[Index].VPWideChar := PWideChar(AMacroParams[Index]); + end; + Result := Format(AMacroText, Params); + end; + if Assigned(ImplementationParams) then + Result := ImplementationParams.GetMacroHeader + Result + ImplementationParams.GetMacroFooter + else + Result := InterfaceParams.GetMacroHeader + Result + InterfaceParams.GetMacroFooter; + + // process conditional defines + if (InterfaceParams is TJclMapInterfaceParams) and FMapInfo.KnownMap then + begin + ProcessDefines('KEY', + FMapInfo.KeyTypeInfo.TypeAttributes[taDefines], + FMapInfo.KeyTypeInfo.TypeAttributes[taUndefs]); + ProcessDefines('VALUE', + FMapInfo.ValueTypeInfo.TypeAttributes[taDefines], + FMapInfo.ValueTypeInfo.TypeAttributes[taUndefs]); + Result := ProcessConditional(Result, FMapInfo.KeyTypeInfo); + if FMapInfo.KeyTypeInfo.TypeAttributes[taCondition] <> FMapInfo.ValueTypeInfo.TypeAttributes[taCondition] then + Result := ProcessConditional(Result, FMapInfo.ValueTypeInfo); + end + else + if (InterfaceParams is TJclContainerInterfaceParams) and FTypeInfo.KnownType then + begin + ProcessDefines('', + FTypeInfo.TypeAttributes[taDefines], + FTypeInfo.TypeAttributes[taUndefs]); + Result := ProcessConditional(Result, FTypeInfo); + end; + finally + ImplementationParams.Free; + InterfaceParams.Free; + end; + end + else + Result := inherited ExpandMacro(AName, ParamValues); +end; + +function TJclContainerParams.GetAllMapCount: Integer; +begin + Result := Length(KnownAllMaps); +end; + +function TJclContainerParams.GetHelpAllMapCount: Integer; +begin + Result := Length(KnownAllMaps) - 1; +end; + +function TJclContainerParams.GetAllTypeCount: Integer; +begin + Result := Length(KnownAllTypes); +end; + +function TJclContainerParams.GetHelpAllTypeCount: Integer; +begin + Result := Length(KnownAllTypes) - 1; +end; + +function TJclContainerParams.GetTrueMapCount: Integer; +begin + Result := Length(KnownTrueMaps); +end; + +function TJclContainerParams.GetHelpTrueMapCount: Integer; +begin + Result := Length(KnownTrueMaps) - 1; +end; + +function TJclContainerParams.GetTrueTypeCount: Integer; +begin + Result := Length(KnownTrueTypes); +end; + +function TJclContainerParams.GetHelpTrueTypeCount: Integer; +begin + Result := Length(KnownTrueTypes) - 1; +end; + +function TJclContainerParams.ProcessConditional(const MacroText: string; ContainerTypeInfo: TJclContainerTypeInfo): string; +var + Condition: string; +begin + Result := MacroText; + Condition := ContainerTypeInfo.TypeAttributes[taCondition]; + if Condition <> '' then + Result := Format('{$IFDEF %s}%s%s%s{$ENDIF %s}%s', + [Condition, NativeLineBreak, + Result, NativeLineBreak, + Condition, NativeLineBreak]); +end; + +procedure TJclContainerParams.ProcessDefines(const Prefix, Defines, Undefs: string); +var + DefineList: TStrings; + I: Integer; +begin + DefineList := TStringList.Create; + try + StrToStrings(Defines, ';', DefineList, False); + for I := 0 to DefineList.Count - 1 do + Define(Prefix + DefineList.Strings[I]); + StrToStrings(Undefs, ';', DefineList, False); + for I := 0 to DefineList.Count - 1 do + Undef(Prefix + DefineList.Strings[I]); + finally + DefineList.Free; + end; +end; + +procedure TJclContainerParams.SetAllMapIndex(const Value: Integer); +begin + FAllMapIndex := Value; + if (Value >= Low(KnownAllMaps)) and (Value <= High(KnownAllMaps)) then + begin + FMapInfo.KeyTypeInfo.TypeName := KnownAllMaps[Value]^.KeyAttributes[taTypeName]; + FMapInfo.ValueTypeInfo.TypeName := KnownAllMaps[Value]^.ValueAttributes[taTypeName]; + FMapInfo.KnownMap := True; + end + else + begin + FMapInfo.KeyTypeInfo.TypeName := ''; + FMapInfo.ValueTypeInfo.TypeName := ''; + FMapInfo.KnownMap := False; + end; +end; + +procedure TJclContainerParams.SetAllTypeIndex(const Value: Integer); +begin + FAllTypeIndex := Value; + if (Value >= Low(KnownAllTypes)) and (Value <= High(KnownAllTypes)) then + begin + FTypeInfo.TypeName := KnownAllTypes[Value]^[taTypeName]; + FTypeInfo.KnownType := True; + end + else + begin + FTypeInfo.TypeName := ''; + FTypeInfo.KnownType := False; + end; +end; + +procedure TJclContainerParams.SetMapTypeIndex(const Value: Integer); +begin + FTrueMapIndex := Value; + if (Value >= Low(KnownTrueMaps)) and (Value <= High(KnownTrueMaps)) then + begin + FMapInfo.KeyTypeInfo.TypeName := KnownTrueMaps[Value]^.KeyAttributes[taTypeName]; + FMapInfo.ValueTypeInfo.TypeName := KnownTrueMaps[Value]^.ValueAttributes[taTypeName]; + FMapInfo.KnownMap := True; + end + else + begin + FMapInfo.KeyTypeInfo.TypeName := ''; + FMapInfo.ValueTypeInfo.TypeName := ''; + FMapInfo.KnownMap := False; + end; +end; + +procedure TJclContainerParams.SetTrueTypeIndex(const Value: Integer); +begin + FTrueTypeIndex := Value; + if (Value >= Low(KnownTrueTypes)) and (Value <= High(KnownTrueTypes)) then + begin + FTypeInfo.TypeName := KnownTrueTypes[Value]^[taTypeName]; + FTypeInfo.KnownType := True; + end + else + begin + FTypeInfo.TypeName := ''; + FTypeInfo.KnownType := False; + end; +end; + +initialization + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + ClearRegisteredContainers; + +end. diff --git a/3rdParty/JCL/source/common/JclPreProcessorContainerTypes.pas b/3rdParty/JCL/source/common/JclPreProcessorContainerTypes.pas new file mode 100644 index 00000000..d040fb76 --- /dev/null +++ b/3rdParty/JCL/source/common/JclPreProcessorContainerTypes.pas @@ -0,0 +1,471 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclContainerTypes.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. } +{ } +{ Contributors: } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclPreProcessorContainerTypes; + +interface + +{$I jcl.inc} + +uses + JclBase, + JclPreProcessorTemplates, + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclNotify; + + +type + TAllTypeAttributeID = ( + // attributes for 1-D containers + taTypeName, + taCondition, // condition while expanding macros, will be emitted + taDefines, // list of defines while expanding macros, won't be emitted + taUndefs, // list of undefs while expanding macros, won't be emitted + taAlias, + taAliasCondition, + taDefaultValue, + taConstKeyword, + taOwnershipParameterName, + taOwnershipInterfaceName, + taOwnershipInterfaceGUID, + taReleaserFunctionName, + taReleaseEventName, + taReleaseEventTypeName, + taGetterFunctionName, + taSetterProcedureName, + taParameterName, + taDynArrayTypeName, + taMoveArrayProcedureName, + taArrayPropertyName, + taBaseContainerClassName, + taBaseCollectionClassName, + taIterateProcedureTypeName, + taIterateProcedureName, + taApplyFunctionTypeName, + taApplyProcedureName, + taCompareFunctionTypeName, + taSimpleCompareFunctionName, + taEqualityCompareFunctionTypeName, + taSimpleEqualityCompareFunctionName, + taHashConvertFunctionTypeName, + taSimpleHashConvertFunctionName, + taContainerInterfaceName, + taContainerInterfaceGUID, + taFlatContainerInterfaceName, + taFlatContainerInterfaceGUID, + taEqualityComparerInterfaceName, + taEqualityComparerInterfaceGUID, + taComparerInterfaceName, + taComparerInterfaceGUID, + taHashConverterInterfaceName, + taHashConverterInterfaceGUID, + taIteratorInterfaceName, + taIteratorInterfaceGUID, + taBinaryTreeIteratorInterfaceName, + taBinaryTreeIteratorInterfaceGUID, + taBinaryTreeNodeTypeName, + taBinaryTreeClassName, + taBinaryTreeBaseIteratorClassName, + taBinaryTreePreOrderIteratorClassName, + taBinaryTreeInOrderIteratorClassName, + taBinaryTreePostOrderIteratorClassName, + taCollectionInterfaceName, + taCollectionInterfaceGUID, + taListInterfaceName, + taListInterfaceGUID, + taSortProcedureTypeName, + taSortProcedureName, + taQuickSortProcedureName, + taFindFunctionName, + taCountObjectFunctionName, + taCopyProcedureName, + taGenerateProcedureName, + taFillProcedureName, + taReverseProcedureName, + taArrayInterfaceName, + taArrayInterfaceGUID, + taArrayListClassName, + taArrayIteratorClassName, + taLinkedListItemClassName, + taLinkedListClassName, + taLinkedListIteratorClassName, + taVectorClassName, + taVectorIteratorClassName, + taSetInterfaceName, + taSetInterfaceGUID, + taArraySetClassName, + taHashSetBucketTypeName, + taHashSetClassName, + taHashSetIteratorClassName, + taTreeIteratorInterfaceName, + taTreeIteratorInterfaceGUID, + taTreeInterfaceName, + taTreeInterfaceGUID, + taTreeNodeClassName, + taTreeClassName, + taTreeBaseIteratorClassName, + taTreePreOrderIteratorClassName, + taTreePostOrderIteratorClassName, + taQueueInterfaceName, + taQueueInterfaceGUID, + taQueueClassName, + taSortedSetInterfaceName, + taSortedSetInterfaceGUID, + taStackInterfaceName, + taStackInterfaceGUID, + taStackClassName, + // attributes for 2-D containers (maps) + kaKeyTypeName, + kaKeyOwnershipParameterName, + kaKeyConstKeyword, + kaKeyParameterName, + kaKeyDefaultValue, + kaKeySimpleCompareFunctionName, + kaKeySimpleEqualityCompareFunctionName, + kaKeySimpleHashConvertFunctionName, + kaKeyBaseContainerClassName, + kaKeyIteratorInterfaceName, + kaKeySetInterfaceName, + kaKeyCollectionInterfaceName, + kaKeyArrayListClassName, + kaKeyArraySetClassName, + vaValueTypeName, + vaValueOwnershipParameterName, + vaValueConstKeyword, + vaValueDefaultValue, + vaValueSimpleCompareFunctionName, + vaValueSimpleEqualityCompareFunctionName, + vaValueBaseContainerClassName, + vaValueCollectionInterfaceName, + vaValueArrayListClassName, + maMapInterfaceName, + maMapInterfaceGUID, + maMapInterfaceAncestorName, + maSortedMapInterfaceName, + maSortedMapInterfaceGUID, + maMapAncestorClassName, + maHashMapEntryTypeName, + maHashMapEntryArrayTypeName, + maHashMapBucketTypeName, + maHashMapClassName, + maSortedMapEntryTypeName, + maSortedMapEntryArrayTypeName, + maSortedMapClassName); + TAllTypeAttributeIDs = set of TAllTypeAttributeID; + + TTypeAttributeID = taTypeName..taStackClassName; + {$EXTERNALSYM TTypeAttributeID} + {$HPPEMIT '#define TTypeAttributeID int'} + + TTypeAttributes = array [TTypeAttributeID] of string; + + TKnownTypeAttributes = TTypeAttributes; + PKnownTypeAttributes = ^TKnownTypeAttributes; + + TKeyAttributeID = kaKeyTypeName..kaKeyArraySetClassName; + {$EXTERNALSYM TKeyAttributeID} + {$HPPEMIT '#define TKeyAttributeID int'} + + TValueAttributeID = vaValueTypeName..vaValueArrayListClassName; + {$EXTERNALSYM TValueAttributeID} + {$HPPEMIT '#define TValueAttributeID int'} + + TMapAttributeID = maMapInterfaceName..maSortedMapClassName; + {$EXTERNALSYM TMapAttributeID} + {$HPPEMIT '#define TMapAttributeID int'} + + TMapAttributes = array [TMapAttributeID] of string; + + TKnownMapAttributes = record + MapAttributes: TMapAttributes; + KeyAttributes: PKnownTypeAttributes; + ValueAttributes: PKnownTypeAttributes; + end; + PKnownMapAttributes = ^TKnownMapAttributes; + + TTypeAttributeInfo = record + IsGUID: Boolean; + DefaultValue: string; + end; + +const + TypeAttributeInfos: array [TTypeAttributeID] of TTypeAttributeInfo = + ( {TypeName} (IsGUID: False; DefaultValue: ''), + {Condition} (IsGUID: False; DefaultValue: ''), + {Defines} (IsGUID: False; DefaultValue: ''), + {Undefs} (IsGUID: False; DefaultValue: ''), + {Alias} (IsGUID: False; DefaultValue: ''), + {AliasCondition} (IsGUID: False; DefaultValue: ''), + {DefaultValue} (IsGUID: False; DefaultValue: ''), + {ConstKeyword} (IsGUID: False; DefaultValue: ''), + {OwnershipParameterName} (IsGUID: False; DefaultValue: ''), + {OwnershipInterfaceName} (IsGUID: False; DefaultValue: 'IJcl%sOwner'), + {OwnershipInterfaceGUID} (IsGUID: True; DefaultValue: ''), + {ReleaserFunctionName} (IsGUID: False; DefaultValue: 'Free%s'), + {ReleaseEventName} (IsGUID: False; DefaultValue: 'OnFree%s'), + {ReleaseEventTypeName} (IsGUID: False; DefaultValue: 'TFree%sEvent'), + {GetterFunctionName} (IsGUID: False; DefaultValue: 'Get%s'), + {SetterProcedureName} (IsGUID: False; DefaultValue: 'Set%s'), + {ParameterName} (IsGUID: False; DefaultValue: 'A%s'), + {DynArrayTypeName} (IsGUID: False; DefaultValue: 'TDyn%sArray'), + {MoveArrayProcedureName} (IsGUID: False; DefaultValue: 'MoveArray'), + {ArrayParameterName} (IsGUID: False; DefaultValue: '%ss'), + {BaseContainerClassName} (IsGUID: False; DefaultValue: ''), + {BaseCollectionClassName} (IsGUID: False; DefaultValue: ''), + {IterateProcedureTypeName} (IsGUID: False; DefaultValue: 'T%sIterateFunction'), + {IterateProcedureName} (IsGUID: False; DefaultValue: 'Iterate'), + {ApplyFunctionTypeName} (IsGUID: False; DefaultValue: 'T%sApplyFunction'), + {ApplyProcedureName} (IsGUID: False; DefaultValue: 'Apply'), + {CompareFunctionTypeName} (IsGUID: False; DefaultValue: 'T%sCompareFunction'), + {SimpleCompareFunctionName} (IsGUID: False; DefaultValue: '%sSimpleCompare'), + {EqualityCompareFunctionTypeName} (IsGUID: False; DefaultValue: 'T%sEqualityCompare'), + {SimpleEqualityCompareFunctionName} (IsGUID: False; DefaultValue: '%sSimpleCompare'), + {HashConvertFunctionTypeName} (IsGUID: False; DefaultValue: 'T%sHashConvert'), + {SimpleHashConvertFunctionName} (IsGUID: False; DefaultValue: '%sSimpleHashConvert'), + {ContainerInterfaceName} (IsGUID: False; DefaultValue: ''), + {ContainerInterfaceGUID} (IsGUID: True; DefaultValue: ''), + {FlatContainerInterfaceName} (IsGUID: False; DefaultValue: ''), + {FlatContainerInterfaceGUID} (IsGUID: True; DefaultValue: ''), + {EqualityComparerInterfaceName} (IsGUID: False; DefaultValue: 'IJcl%sEqualityComparer'), + {EqualityComparerInterfaceGUID} (IsGUID: True; DefaultValue: ''), + {ComparerInterfaceName} (IsGUID: False; DefaultValue: 'IJcl%sComparer'), + {ComparerInterfaceGUID} (IsGUID: True; DefaultValue: ''), + {HashConverterInterfaceName} (IsGUID: False; DefaultValue: 'IJcl%sHashConverter'), + {HashConverterInterfaceGUID} (IsGUID: True; DefaultValue: ''), + {IteratorInterfaceName} (IsGUID: False; DefaultValue: 'IJcl%sIterator'), + {IteratorInterfaceGUID} (IsGUID: True; DefaultValue: ''), + {BinaryTreeIteratorInterfaceName} (IsGUID: False; DefaultValue: 'IJcl%sBinaryTreeIterator'), + {BinaryTreeIteratorInterfaceGUID} (IsGUID: True; DefaultValue: ''), + {BinaryTreeNodeTypeName} (IsGUID: False; DefaultValue: 'TJcl%sBinaryNode'), + {BinaryTreeClassName} (IsGUID: False; DefaultValue: 'TJcl%sBinaryTree'), + {BinaryTreeBaseIteratorClassName} (IsGUID: False; DefaultValue: 'TJcl%sBinaryTreeIterator'), + {BinaryTreePreOrderIteratorClassName} (IsGUID: False; DefaultValue: 'TJclPreOrder%sBinaryTreeIterator'), + {BinaryTreeInOrderIteratorClassName} (IsGUID: False; DefaultValue: 'TJclInOrder%sBinaryTreeIterator'), + {BinaryTreePostOrderIteratorClassName} (IsGUID: False; DefaultValue: 'TJclPostOrder%sBinaryTreeIterator'), + {CollectionInterfaceName} (IsGUID: False; DefaultValue: 'IJcl%sCollection'), + {CollectionInterfaceGUID} (IsGUID: True; DefaultValue: ''), + {ListInterfaceName} (IsGUID: False; DefaultValue: 'IJcl%sList'), + {ListInterfaceGUID} (IsGUID: True; DefaultValue: ''), + {SortProcedureTypeName} (IsGUID: False; DefaultValue: 'T%sSortProc'), + {SortProcedureName} (IsGUID: False; DefaultValue: 'Sort'), + {QuickSortProcedureName} (IsGUID: False; DefaultValue: 'QuickSort'), + {FindFunctionName} (IsGUID: False; DefaultValue: 'Find'), + {CountObjectFunctionName} (IsGUID: False; DefaultValue: 'CountObject'), + {CopyProcedureName} (IsGUID: False; DefaultValue: 'Copy'), + {GenerateProcedureName} (IsGUID: False; DefaultValue: 'Generate'), + {FillProcedureName} (IsGUID: False; DefaultValue: 'Fill'), + {ReverseProcedureName} (IsGUID: False; DefaultValue: 'Reverse'), + {ArrayInterfaceName} (IsGUID: False; DefaultValue: 'IJcl%sArray'), + {ArrayInterfaceGUID} (IsGUID: True; DefaultValue: ''), + {ArrayListClassName} (IsGUID: False; DefaultValue: 'TJcl%sArrayList'), + {ArrayIteratorClassName} (IsGUID: False; DefaultValue: 'TJcl%sArrayIterator'), + {LinkedListItemTypeName} (IsGUID: False; DefaultValue: 'TJcl%sLinkedListItem'), + {LinkedListClassName} (IsGUID: False; DefaultValue: 'TJcl%sLinkedList'), + {LinkedListIteratorClassName} (IsGUID: False; DefaultValue: 'TJcl%sLinkedListIterator'), + {VectorClassName} (IsGUID: False; DefaultValue: 'TJcl%sVector'), + {VectorIteratorClassName} (IsGUID: False; DefaultValue: 'TJcl%sVectorIterator'), + {SetInterfaceName} (IsGUID: False; DefaultValue: 'IJcl%sSet'), + {SetInterfaceGUID} (IsGUID: True; DefaultValue: ''), + {ArraySetClassName} (IsGUID: False; DefaultValue: 'TJcl%sArraySet'), + {HashSetBucketTypeName} (IsGUID: False; DefaultValue: 'TJcl%sHashSetBucket'), + {HashSetClassName} (IsGUID: False; DefaultValue: 'TJcl%sHashSet'), + {HashSetIteratorClassName} (IsGUID: False; DefaultValue: 'TJcl%sHashSetIterator'), + {TreeIteratorInterfaceName} (IsGUID: False; DefaultValue: 'IJcl%sTreeIterator'), + {TreeIteratorInterfaceGUID} (IsGUID: True; DefaultValue: ''), + {TreeInterfaceName} (IsGUID: False; DefaultValue: 'IJcl%sTree'), + {TreeInterfaceGUID} (IsGUID: True; DefaultValue: ''), + {TreeNodeClassName} (IsGUID: False; DefaultValue: 'TJcl%sTreeNode'), + {TreeClassName} (IsGUID: False; DefaultValue: 'TJcl%sTree'), + {TreeBaseIteratorClassName} (IsGUID: False; DefaultValue: 'TJcl%sTreeIterator'), + {TreePreOrderIteratorClassName} (IsGUID: False; DefaultValue: 'TJclPreOrder%sTreeIterator'), + {TreePostOrderIteratorClassName} (IsGUID: False; DefaultValue: 'TJclPostOrder%sTreeIterator'), + {QueueInterfaceName} (IsGUID: False; DefaultValue: 'IJcl%sQueue'), + {QueueInterfaceGUID} (IsGUID: True; DefaultValue: ''), + {QueueClassName} (IsGUID: False; DefaultValue: 'TJcl%sQueue'), + {SortedSetInterfaceName} (IsGUID: False; DefaultValue: 'IJcl%sSortedSet'), + {SortedSetInterfaceGUID} (IsGUID: True; DefaultValue: ''), + {StackInterfaceName} (IsGUID: False; DefaultValue: 'IJcl%sStack'), + {StackInterfaceGUID} (IsGUID: True; DefaultValue: ''), + {StackClassName} (IsGUID: False; DefaultValue: 'TJcl%sStack') ); + + KeyAttributeInfos: array [TKeyAttributeID] of TTypeAttributeID = + ( {KeyTypeName} taTypeName, + {KeyOwnershipParameterName} taOwnershipParameterName, + {KeyConstKeyword} taConstKeyword, + {KeyParameterName} taParameterName, + {KeyDefaultValue} taDefaultValue, + {KeySimpleCompareFunctionName} taSimpleCompareFunctionName, + {KeySimpleEqualityCompareFunctionName} taSimpleEqualityCompareFunctionName, + {KeySimpleHashConvertFunctionName} taSimpleHashConvertFunctionName, + {KeyBaseContainerClassName} taBaseContainerClassName, + {KeyIteratorInterfaceName} taIteratorInterfaceName, + {KeySetInterfaceName} taSetInterfaceName, + {KeyCollectionInterfaceName} taCollectionInterfaceName, + {KeyArrayListClassName} taArrayListClassName, + {KeyArraySetClassName} taArraySetClassName); + + ValueAttributeInfos: array [TValueAttributeID] of TTypeAttributeID = + ( {ValueTypeName} taTypeName, + {ValueOwnershipParameterName} taOwnershipParameterName, + {ValueConstKeyword} taConstKeyword, + {ValueDefaultValue} taDefaultValue, + {ValueSimpleCompareFunctionName} taSimpleCompareFunctionName, + {ValueSimpleEqualityCompareFunctionName} taSimpleEqualityCompareFunctionName, + {ValueBaseContainerClassName} taBaseContainerClassName, + {ValueCollectionInterfaceName} taCollectionInterfaceName, + {ValueArrayListClassName} taArrayListClassName); + + MapAttributeInfos: array [TMapAttributeID] of TTypeAttributeInfo = + ( {MapInterfaceName} (IsGUID: False; DefaultValue: 'TJcl%s%sMap'), + {MapInterfaceGUID} (IsGUID: True; DefaultValue: ''), + {MapInterfaceAncestorName} (IsGUID: False; DefaultValue: 'IJclBaseContainer'), + {SortedMapInterfaceName} (IsGUID: False; DefaultValue: 'TJcl%s%sSortedMap'), + {SortedMapInterfaceGUID} (IsGUID: True; DefaultValue: ''), + {MapAncestorClassName} (IsGUID: False; DefaultValue: 'TJclContainer'), + {HashMapEntryTypeName} (IsGUID: False; DefaultValue: 'TJcl%s%sHashEntry'), + {HashMapEntryArrayTypeName} (IsGUID: False; DefaultValue: 'TJcl%s%sHashEntryArray'), + {HashMapBucketTypeName} (IsGUID: False; DefaultValue: 'TJcl%s%sHashBucket'), + {HashMapClassName} (IsGUID: False; DefaultValue: 'TJcl%s%sHashMap'), + {SortedMapEntryTypeName} (IsGUID: False; DefaultValue: 'TJcl%s%sSortedEntry'), + {SortedMapEntryArrayTypeName} (IsGUID: False; DefaultValue: 'TJcl%s%sSortedEntryArray'), + {SortedMapClassName} (IsGUID: False; DefaultValue: 'TJcl%s%sSortedMap') ); + +type + EJclContainerException = class(EJclError); + + TCodeLocation = (clDefault, clAtCursor, clInterface, clImplementation); + + TJclMacroParams = class + private + // FCodeLocation: TCodeLocation; + // FCodeUnit: string; + protected + // function CodeLocation: string; virtual; + // function CodeUnit: string; virtual; + public + function IsDefault: Boolean; virtual; + procedure ResetDefault(Value: Boolean); virtual; + + // this function returns some text to be emitted at the beginning of the macro + function GetMacroHeader: string; virtual; + // this function returns some text to be emitted at the end of the macro + function GetMacroFooter: string; virtual; + + // procedure InterfaceUnitDependencies(Units: TStrings); virtual; + // procedure ImplementationUnitDependencies(Units: TStrings); virtual; + + // property CodeLocation: TCodeLocation read GetCodeLocation write FCodeLocation; + // property CodeUnit: string read GetCodeUnit write FCodeUnit; + end; + + TJclInterfaceParams = class(TJclMacroParams) + public + // this function returns the attribute ID when alias declarations should be emitted + // taTypeName is ignored + function AliasAttributeIDs: TAllTypeAttributeIDs; virtual; + end; + + TJclInterfaceParamsClass = class of TJclInterfaceParams; + + TJclImplementationParams = class(TJclMacroParams) + private + FInterfaceParams: TJclInterfaceParams; + public + constructor Create(AInterfaceParams: TJclInterfaceParams); + property InterfaceParams: TJclInterfaceParams read FInterfaceParams; + end; + + TJclImplementationParamsClass = class of TJclImplementationParams; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +//=== { TJclMacroParams } ==================================================== + +function TJclMacroParams.GetMacroFooter: string; +begin + // override to customize + Result := ''; +end; + +function TJclMacroParams.GetMacroHeader: string; +begin + // override to customize + Result := ''; +end; + +function TJclMacroParams.IsDefault: Boolean; +begin + // default if no properties are marked as "stored" + Result := True; +end; + +procedure TJclMacroParams.ResetDefault(Value: Boolean); +begin + // override to customize +end; + +//=== { TJclInterfaceParams } ================================================ + +function TJclInterfaceParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := []; +end; + +//=== { TJclImplementationParams } =========================================== + +constructor TJclImplementationParams.Create(AInterfaceParams: TJclInterfaceParams); +begin + inherited Create; + FInterfaceParams := AInterfaceParams; +end; + + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclPreProcessorExcDlgTemplates.pas b/3rdParty/JCL/source/common/JclPreProcessorExcDlgTemplates.pas new file mode 100644 index 00000000..e69e376a --- /dev/null +++ b/3rdParty/JCL/source/common/JclPreProcessorExcDlgTemplates.pas @@ -0,0 +1,265 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclOtaExcDlgRepository.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. } +{ } +{ Contributors: } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclPreProcessorExcDlgTemplates; + +interface + +{$I jcl.inc} + +uses + {$IFDEF HAS_UNITSCOPE} + System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Classes, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclIDEUtils, + JclPreProcessorTemplates; + +type + TJclExcDlgParams = class(TJclTemplateParams) + private + FHookDll: Boolean; + FFileName: string; + FCodeDetails: Boolean; + FModuleName: Boolean; + FModuleOffset: Boolean; + FDelayedTrace: Boolean; + FFormName: string; + FLogFile: Boolean; + FLogFileName: string; + FAutoSaveWorkingDirectory: Boolean; + FAutoSaveApplicationDirectory: Boolean; + FAutoSaveDesktopDirectory: Boolean; + FLogSaveDialog: Boolean; + FAddressOffset: Boolean; + FVirtualAddress: Boolean; + FActivePersonality: TJclBorPersonality; + FLanguage: TJclBorPersonality; + FLanguages: TJclBorPersonalities; + FRawData: Boolean; + FSendEMail: Boolean; + FEMailAddress: string; + FFormAncestor: string; + FModalDialog: Boolean; + FSizeableDialog: Boolean; + FEMailSubject: string; + FDesigner: TJclBorDesigner; + FModuleList: Boolean; + FUnitVersioning: Boolean; + FOSInfo: Boolean; + FActiveControls: Boolean; + FDisableIfDebuggerAttached: Boolean; + FStackList: Boolean; + FAutoScrollBars: Boolean; + FCatchMainThread: Boolean; + FAllThreads: Boolean; + FAllRegisteredThreads: Boolean; + FMainExceptionThreads: Boolean; + FExceptionThread: Boolean; + FMainThread: Boolean; + FTraceEAbort: Boolean; + FIgnoredExceptions: TStrings; + FIgnoredExceptionsIndex: Integer; + FTraceAllExceptions: Boolean; + function GetIgnoredExceptionsCount: Integer; + function GetReportAllThreads: Boolean; + function GetReportExceptionThread: Boolean; + function GetReportMainThread: Boolean; + function GetIgnoredException: string; + public + constructor Create; reintroduce; + destructor Destroy; override; + published + // file options + property Language: TJclBorPersonality read FLanguage write FLanguage; + property Languages: TJclBorPersonalities read FLanguages write FLanguages; + property ActivePersonality: TJclBorPersonality read FActivePersonality + write FActivePersonality; + property FileName: string read FFileName write FFileName; + property FormName: string read FFormName write FFormName; + property FormAncestor: string read FFormAncestor write FFormAncestor; + property Designer: TJclBorDesigner read FDesigner write FDesigner; + // form options + property ModalDialog: Boolean read FModalDialog write FModalDialog; + property SendEMail: Boolean read FSendEMail write FSendEMail; + property EMailAddress: string read FEMailAddress write FEMailAddress; + property EMailSubject: string read FEMailSubject write FEMailSubject; + property SizeableDialog: Boolean read FSizeableDialog write FSizeableDialog; + property AutoScrollBars: Boolean read FAutoScrollBars write FAutoScrollBars; + // system options + property DelayedTrace: Boolean read FDelayedTrace write FDelayedTrace; + property HookDll: Boolean read FHookDll write FHookDll; + property OSInfo: Boolean read FOSInfo write FOSInfo; + property ModuleList: Boolean read FModuleList write FModuleList; + property UnitVersioning: Boolean read FUnitVersioning write FUnitVersioning; + property ActiveControls: Boolean read FActiveControls write FActiveControls; + property CatchMainThread: Boolean read FCatchMainThread write FCatchMainThread; + property DisableIfDebuggerAttached: Boolean read FDisableIfDebuggerAttached write FDisableIfDebuggerAttached; + // log options + property LogFile: Boolean read FLogFile write FLogFile; + property LogFileName: string read FLogFileName write FLogFileName; + property AutoSaveWorkingDirectory: Boolean read FAutoSaveWorkingDirectory write FAutoSaveWorkingDirectory; + property AutoSaveApplicationDirectory: Boolean read FAutoSaveApplicationDirectory write FAutoSaveApplicationDirectory; + property AutoSaveDesktopDirectory: Boolean read FAutoSaveDesktopDirectory write FAutoSaveDesktopDirectory; + property LogSaveDialog: Boolean read FLogSaveDialog write FLogSaveDialog; + // ignored exceptions + property TraceAllExceptions: Boolean read FTraceAllExceptions + write FTraceAllExceptions; + property TraceEAbort: Boolean read FTraceEAbort write FTraceEAbort; + property IgnoredException: string read GetIgnoredException; + property IgnoredExceptions: TStrings read FIgnoredExceptions write FIgnoredExceptions; + property IgnoredExceptionsIndex: Integer read FIgnoredExceptionsIndex write FIgnoredExceptionsIndex; + property IgnoredExceptionsCount: Integer read GetIgnoredExceptionsCount; + // trace options + property StackList: Boolean read FStackList write FStackList; + property RawData: Boolean read FRawData write FRawData; + property ModuleName: Boolean read FModuleName write FModuleName; + property ModuleOffset: Boolean read FModuleOffset write FModuleOffset; + // thread options (mutually exclusives) + property AllThreads: Boolean read FAllThreads write FAllThreads; + property AllRegisterThreads: Boolean read FAllRegisteredThreads write FAllRegisteredThreads; + property MainExceptionThreads: Boolean read FMainExceptionThreads write FMainExceptionThreads; + property ExceptionThread: Boolean read FExceptionThread write FExceptionThread; + property MainThread: Boolean read FMainThread write FMainThread; + // composite properties + property ReportMainThread: Boolean read GetReportMainThread; + property ReportAllThreads: Boolean read GetReportAllThreads; + property ReportExceptionThread: Boolean read GetReportExceptionThread; + //property AddressOffset: Boolean read FAddressOffset write FAddressOffset; + property CodeDetails: Boolean read FCodeDetails write FCodeDetails; + property VirtualAddress: Boolean read FVirtualAddress write FVirtualAddress; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +//=== { TJclExcDlgParams } =================================================== + +constructor TJclExcDlgParams.Create; +begin + inherited Create; + + FHookDll := True; + FLanguage := bpUnknown; + FLanguages := [bpUnknown]; + FFileName := ''; + FCodeDetails := True; + FModuleName := True; + FModuleOffset := False; + FDelayedTrace := True; + FFormName := 'ExceptionDialog'; + FFormAncestor := 'TForm'; + FLogFile := False; + FLogFileName := 'ExtractFileName(Application.ExeName) + ''-exception-'' + FormatDateTime(''yyyy-mm-dd'', Date) + ''.log'''; + FAutoSaveWorkingDirectory := False; + FAutoSaveApplicationDirectory := False; + FAutoSaveDesktopDirectory := False; + FLogSaveDialog := False; + FAddressOffset := True; + FVirtualAddress := False; + FActivePersonality := bpUnknown; + FRawData := False; + FSendEMail := False; + FEMailAddress := ''; + FEMailSubject := ''; + FModalDialog := True; + FSizeableDialog := False; + FDesigner := bdVCL; + FModuleList := True; + FUnitVersioning := True; + FOSInfo := True; + FActiveControls := True; + FDisableIfDebuggerAttached := False; + FStackList := True; + FAutoScrollBars := True; + FCatchMainThread := False; + FTraceEAbort := False; + FTraceAllExceptions := False; + FIgnoredExceptions := TStringList.Create; + FAllThreads := True; + FAllRegisteredThreads := False; + FMainExceptionThreads := False; + FExceptionThread := False; + FMainThread := False; +end; + +destructor TJclExcDlgParams.Destroy; +begin + FIgnoredExceptions.Free; + inherited Destroy; +end; + +function TJclExcDlgParams.GetIgnoredException: string; +begin + Result := FIgnoredExceptions.Strings[FIgnoredExceptionsIndex]; +end; + +function TJclExcDlgParams.GetIgnoredExceptionsCount: Integer; +begin + Result := FIgnoredExceptions.Count; +end; + +function TJclExcDlgParams.GetReportAllThreads: Boolean; +begin + Result := FAllThreads or FAllRegisteredThreads; +end; + +function TJclExcDlgParams.GetReportExceptionThread: Boolean; +begin + Result := FExceptionThread or FMainExceptionThreads; +end; + +function TJclExcDlgParams.GetReportMainThread: Boolean; +begin + Result := FMainThread or FMainExceptionThreads or FAllThreads or FAllRegisteredThreads; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclPreProcessorHashMapsTemplates.pas b/3rdParty/JCL/source/common/JclPreProcessorHashMapsTemplates.pas new file mode 100644 index 00000000..e15e03d9 --- /dev/null +++ b/3rdParty/JCL/source/common/JclPreProcessorHashMapsTemplates.pas @@ -0,0 +1,268 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclHashMapsTemplates.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. } +{ } +{ Contributors: } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclPreProcessorHashMapsTemplates; + +interface + +{$I jcl.inc} + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclPreProcessorContainerTypes, + JclPreProcessorContainerTemplates, + JclPreProcessorContainer2DTemplates; + +type + (* JCLHASHMAPTYPESINT(ENTRYTYPENAME, ENTRYARRAYTYPENAME, BUCKETTYPENAME, KEYTYPENAME, VALUETYPENAME) *) + TJclHashMapTypeIntParams = class(TJclMapInterfaceParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property EntryTypeName: string index maHashMapEntryTypeName read GetMapAttribute write SetMapAttribute stored IsMapAttributeStored; + property EntryArrayTypeName: string index maHashMapEntryArrayTypeName read GetMapAttribute write SetMapAttribute stored IsMapAttributeStored; + property BucketTypeName: string index maHashMapBucketTypeName read GetMapAttribute write SetMapAttribute stored IsMapAttributeStored; + property KeyTypeName: string index kaKeyTypeName read GetKeyAttribute write SetKeyAttribute stored False; + property ValueTypeName: string index vaValueTypeName read GetValueAttribute write SetValueAttribute stored False; + end; + + (* JCLHASHMAPINT(BUCKETTYPENAME, SELFCLASSNAME, ANCESTORNAME, MAPINTERFACENAME, KEYSETINTERFACENAME, + KEYCOLLECTIONINTERFACENAME, + VALUECOLLECTIONINTERFACENAME, INTERFACEADDITIONAL, SECTIONADDITIONAL, + KEYOWNERSHIPDECLARATION, VALUEOWNERSHIPDECLARATION, KEYCONSTKEYWORD, + KEYTYPENAME, VALUECONSTKEYWORD, VALUETYPENAME) *) + TJclHashMapIntParams = class(TJclMapClassInterfaceParams) + protected + // function CodeUnit: string; override; + function GetComparisonSectionAdditional: string; override; + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property BucketTypeName: string index maHashMapBucketTypeName read GetMapAttribute write SetMapAttribute stored False; + property SelfClassName: string index maHashMapClassName read GetMapAttribute write SetMapAttribute stored IsMapAttributeStored; + property AncestorName: string index maMapAncestorClassName read GetMapAttribute write SetMapAttribute stored False; + property MapInterfaceName: string index maMapInterfaceName read GetMapAttribute write SetMapAttribute stored False; + property KeySetInterfaceName: string index kaKeySetInterfaceName read GetKeyAttribute write SetKeyAttribute stored False; + property KeyCollectionInterfaceName: string index kaKeyCollectionInterfaceName read GetKeyAttribute write SetKeyAttribute stored False; + property ValueCollectionInterfaceName: string index vaValueCollectionInterfaceName read GetValueAttribute write SetValueAttribute stored False; + property InterfaceAdditional; + property SectionAdditional; + property KeyOwnershipDeclaration; + property ValueOwnershipDeclaration; + property KeyConstKeyword: string index kaKeyConstKeyword read GetKeyAttribute write SetKeyAttribute stored False; + property KeyTypeName; + property ValueConstKeyword: string index vaValueConstKeyword read GetValueAttribute write SetValueAttribute stored False; + property ValueTypeName; + end; + + (* JCLHASHMAPTYPESIMP(ENTRYARRAYTYPENAME, BUCKETTYPENAME, KEYDEFAULT, VALUEDEFAULT) *) + TJclHashMapTypeImpParams = class(TJclMapImplementationParams) + published + property EntryArrayTypeName: string index maHashMapEntryArrayTypeName read GetMapAttribute write SetMapAttribute stored False; + property BucketTypeName: string index maHashMapBucketTypeName read GetMapAttribute write SetMapAttribute stored False; + property KeyDefault: string index kaKeyDefaultValue read GetKeyAttribute write SetKeyAttribute stored False; + property ValueDefault: string index vaValueDefaultValue read GetValueAttribute write SetValueAttribute stored False; + end; + + (* JCLHASHMAPIMP(SELFCLASSNAME, BUCKETTYPENAME, + MAPINTERFACENAME, KEYSETINTERFACENAME, KEYCOLLECTIONINTERFACENAME, KEYITRINTERFACENAME, VALUECOLLECTIONINTERFACENAME, + KEYOWNERSHIPDECLARATION, VALUEOWNERSHIPDECLARATION, OWNERSHIPASSIGNMENTS, + KEYCONSTKEYWORD, KEYTYPENAME, KEYDEFAULT, VALUECONSTKEYWORD, VALUETYPENAME, VALUEDEFAULT, + CREATEKEYSET, CREATEKEYCOLLECTION, CREATEVALUECOLLECTION) *) + TJclHashMapImpParams = class(TJclMapClassImplementationParams) + protected + // function CodeUnit: string; override; + public + function GetConstructorParameters: string; override; + function GetMacroFooter: string; override; + function GetSelfClassName: string; override; + published + property SelfClassName: string index maHashMapClassName read GetMapAttribute write SetMapAttribute stored False; + property AncestorClassName: string index maMapAncestorClassName read GetMapAttribute write SetMapAttribute stored False; + property BucketTypeName: string index maHashMapBucketTypeName read GetMapAttribute write SetMapAttribute stored False; + property MapInterfaceName: string index maMapInterfaceName read GetMapAttribute write SetMapAttribute stored False; + property KeySetInterfaceName: string index kaKeySetInterfaceName read GetKeyAttribute write SetKeyAttribute stored False; + property KeyCollectionInterfaceName: string index kaKeyCollectionInterfaceName read GetKeyAttribute write SetKeyAttribute stored False; + property KeyArraySetClassName; + property KeyItrInterfaceName: string index kaKeyIteratorInterfaceName read GetKeyAttribute write SetKeyAttribute stored False; + property ValueCollectionInterfaceName: string index vaValueCollectionInterfaceName read GetValueAttribute write SetValueAttribute stored False; + property ValueArrayListClassName; + property KeyOwnershipDeclaration; + property ValueOwnershipDeclaration; + property OwnershipAssignments; + property KeyConstKeyword: string index kaKeyConstKeyword read GetKeyAttribute write SetKeyAttribute stored False; + property KeyParameterName: string index kaKeyParameterName read GetKeyAttribute write SetKeyAttribute stored False; + property KeyTypeName; + property KeyDefault; + property KeySimpleEqualityCompareFunctionName: string index kaKeySimpleEqualityCompareFunctionName read GetKeyAttribute write SetKeyAttribute stored False; + property KeySimpleHashConvertFunctionName: string index kaKeySimpleHashConvertFunctionName read GetKeyAttribute write SetKeyAttribute stored False; + property KeyBaseContainer: string index kaKeyBaseContainerClassName read GetKeyAttribute write SetKeyAttribute stored False; + property ValueConstKeyword: string index vaValueConstKeyword read GetValueAttribute write SetValueAttribute stored False; + property ValueTypeName; + property ValueDefault; + property ValueSimpleEqualityCompareFunctionName: string index vaValueSimpleEqualityCompareFunctionName read GetValueAttribute write SetValueAttribute stored False; + property ValueBaseContainerClassName: string index vaValueBaseContainerClassName read GetValueAttribute write SetValueAttribute stored False; + property CreateKeySet; + property CreateKeyCollection; + property CreateValueCollection; + property MacroFooter; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclStrings; + +procedure RegisterJclContainers; +begin + RegisterContainerParams('JCLHASHMAPTYPESINT', TJclHashMapTypeIntParams); + RegisterContainerParams('JCLHASHMAPTYPESIMP', TJclHashMapTypeImpParams, TJclHashMapTypeIntParams); + RegisterContainerParams('JCLHASHMAPINT', TJclHashMapIntParams); + RegisterContainerParams('JCLHASHMAPIMP', TJclHashMapImpParams, TJclHashMapIntParams); +end; + +//=== { TJclHashMapTypeIntParams } =========================================== + +function TJclHashMapTypeIntParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [maHashMapEntryTypeName, maHashMapBucketTypeName]; +end; + +//=== { TJclHashMapIntParams } =============================================== + +function TJclHashMapIntParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [maHashMapClassName]; +end; + +function TJclHashMapIntParams.GetComparisonSectionAdditional: string; +begin + Result := ''; + if AncestorName <> MapInfo.KeyTypeInfo.TypeAttributes[taBaseContainerClassName] then + begin + Result := Format('%s function Hash(%s%s: %s): Integer;', + [Result, MapInfo.KeyTypeInfo.TypeAttributes[taConstKeyword], + MapInfo.KeyTypeInfo.TypeAttributes[taParameterName], KeyTypeName]); + if AncestorName <> 'TJclAbstractContainerBase' then + Result := Result + ' reintroduce;' + NativeLineBreak + else + Result := Result + NativeLineBreak; + end; + Result := Format('%s function KeysEqual(%sA, B: %s): Boolean;' + NativeLineBreak + + ' function ValuesEqual(%sA, B: %s): Boolean;', + [Result, KeyConstKeyword, KeyTypeName, ValueConstKeyword, ValueTypeName]); +end; + +//=== { TJclHashMapImpParams } =============================================== + +function TJclHashMapImpParams.GetConstructorParameters: string; +begin + Result := 'FCapacity'; +end; + +function TJclHashMapImpParams.GetMacroFooter: string; +var + FuncName: string; +begin + Result := inherited GetMacroFooter; + if (FMacroFooter = '') and MapInfo.KnownMap then + begin + if AncestorClassName <> KeyBaseContainer then + begin + Result := Format('%s' + NativeLineBreak + + 'function %s.Hash(%s%s: %s): Integer;' + NativeLineBreak + + 'begin' + NativeLineBreak + + ' Result := %s(%s);' + NativeLineBreak + + 'end;' + NativeLineBreak, + [Result, SelfClassName, KeyConstKeyword, KeyParameterName, KeyTypeName, + KeySimpleHashConvertFunctionName, KeyParameterName]); + end; + + if AncestorClassName = KeyBaseContainer then + FuncName := 'ItemsEqual' + else + FuncName := KeySimpleEqualityCompareFunctionName; + + Result := Format('%s' + NativeLineBreak + + 'function %s.KeysEqual(%sA, B: %s): Boolean;' + NativeLineBreak + + 'begin' + NativeLineBreak + + ' Result := %s(A, B);' + NativeLineBreak + + 'end;' + NativeLineBreak, + [Result, SelfClassName, KeyConstKeyword, KeyTypeName, FuncName]); + + if AncestorClassName = ValueBaseContainerClassName then + FuncName := 'ItemsEqual' + else + FuncName := ValueSimpleEqualityCompareFunctionName; + + Result := Format('%s' + NativeLineBreak + + 'function %s.ValuesEqual(%sA, B: %s): Boolean;' + NativeLineBreak + + 'begin' + NativeLineBreak + + ' Result := %s(A, B);' + NativeLineBreak + + 'end;' + NativeLineBreak, + [Result, SelfClassName, ValueConstKeyword, ValueTypeName, FuncName]); + end; +end; + +function TJclHashMapImpParams.GetSelfClassName: string; +begin + Result := SelfClassName; +end; + +initialization + RegisterJclContainers; + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclPreProcessorHashSetsTemplates.pas b/3rdParty/JCL/source/common/JclPreProcessorHashSetsTemplates.pas new file mode 100644 index 00000000..9fd45874 --- /dev/null +++ b/3rdParty/JCL/source/common/JclPreProcessorHashSetsTemplates.pas @@ -0,0 +1,223 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclArraySetsTemplates.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. } +{ } +{ Contributors: } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclPreProcessorHashSetsTemplates; + +interface + +{$I jcl.inc} + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclPreProcessorContainerTypes, + JclPreProcessorContainerTemplates, + JclPreProcessorContainer1DTemplates; + +type + (* JCLHASHSETTYPESINT(BUCKETTYPENAME, TYPENAME) *) + TJclHashSetTypeIntParams = class(TJclContainerInterfaceParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property BucketTypeName: string index taHashSetBucketTypeName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property DynArrayTypeName: string index taDynArrayTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* JCLHASHSETINT(SELFCLASSNAME, ANCESTORCLASSNAME, BASECONTAINERINTERFACENAME, + FLATCONTAINERINTERFACENAME, BUCKETTYPENAME, + COLLECTIONINTERFACENAME, SETINTERFACENAME, ITRINTERFACENAME, + EQUALITYCOMPARERINTERFACENAME, HASHCONVERTERINTERFACENAME, INTERFACEADDITIONAL, + SECTIONADDITIONAL, COLLECTIONFLAGS, CONSTKEYWORD, PARAMETERNAME, TYPENAME) *) + TJclHashSetIntParams = class(TJclCollectionInterfaceParams) + protected + // function CodeUnit: string; override; + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property SelfClassName: string index taHashSetClassName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property AncestorClassName; + property BaseContainerInterfaceName: string index taContainerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property FlatContainerInterfaceName: string index taFlatContainerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property BucketTypeName: string index taHashSetBucketTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property CollectionInterfaceName: string index taCollectionInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property EqualityComparerInterfaceName: string index taEqualityComparerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property HashConverterInterfaceName: string index taHashConverterInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ListInterfaceName: string index taListInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ArrayInterfaceName: string index taArrayInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property SetInterfaceName: string index taSetInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property InterfaceAdditional; + property SectionAdditional; + property CollectionFlags; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property OwnershipDeclaration; + end; + + (* JCLHASHSETITRINT(SELFCLASSNAME, ITRINTERFACENAME, HASHSETCLASSNAME, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) *) + TJclHashSetItrIntParams = class(TJclClassInterfaceParams) + protected + // function CodeUnit: string; override; + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property SelfClassName: string index taHashSetIteratorClassName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property HashSetClassName: string index taHashSetClassName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* JCLHASHSETIMP(SELFCLASSNAME, BUCKETTYPENAME, OWNERSHIPDECLARATION, OWNERSHIPPARAMETERNAME, + COLLECTIONINTERFACENAME, ITRCLASSNAME, ITRINTERFACENAME, MOVEARRAYPROCEDURENAME, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, RELEASERFUNCTIONNAME) *) + TJclHashSetImpParams = class(TJclCollectionImplementationParams) + protected + // function CodeUnit: string; override; + public + function GetConstructorParameters: string; override; + function GetSelfClassName: string; override; + published + property SelfClassName: string index taHashSetClassName read GetTypeAttribute write SetTypeAttribute stored False; + property BucketTypeName: string index taHashSetBucketTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property OwnershipDeclaration; + property OwnershipParameterName: string index taOwnershipParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property CollectionInterfaceName: string index taCollectionInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrClassName: string index taHashSetIteratorClassName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property MoveArrayProcedureName: string index taMoveArrayProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property DefaultValue: string index taDefaultValue read GetTypeAttribute write SetTypeAttribute stored False; + property ReleaserFunctionName: string index taReleaserFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property MacroFooter; + end; + + (* JCLHASHSETITRIMP(SELFCLASSNAME, HASHSETCLASSNAME, BUCKETTYPENAME, ITRINTERFACENAME, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) *) + TJclHashSetItrImpParams = class(TJclContainerImplementationParams) + protected + // function CodeUnit: string; override; + published + property SelfClassName: string index taHashSetIteratorClassName read GetTypeAttribute write SetTypeAttribute stored False; + property HashSetClassName: string index taHashSetClassName read GetTypeAttribute write SetTypeAttribute stored False; + property BucketTypeName: string index taHashSetBucketTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property DefaultValue: string index taDefaultValue read GetTypeAttribute write SetTypeAttribute stored False; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclStrings; + +procedure RegisterJclContainers; +begin + RegisterContainerParams('JCLHASHSETTYPEINT', TJclHashSetTypeIntParams); + RegisterContainerParams('JCLHASHSETINT', TJclHashSetIntParams); + RegisterContainerParams('JCLHASHSETITRINT', TJclHashSetItrIntParams); + RegisterContainerParams('JCLHASHSETIMP', TJclHashSetImpParams, TJclHashSetIntParams); + RegisterContainerParams('JCLHASHSETITRIMP', TJclHashSetItrImpParams, TJclHashSetItrIntParams); +end; + +//=== { TJclHashSetTypeIntParams } =========================================== + +function TJclHashSetTypeIntParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taHashSetBucketTypeName]; +end; + +//=== { TJclHashSetIntParams } =============================================== + +function TJclHashSetIntParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taHashSetClassName]; +end; + +//=== { TJclHashSetItrIntParams } ============================================ + +function TJclHashSetItrIntParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taHashSetIteratorClassName]; +end; + +//=== { TJclHashSetImpParams } =============================================== + +function TJclHashSetImpParams.GetConstructorParameters: string; +begin + Result := 'Size'; +end; + +function TJclHashSetImpParams.GetSelfClassName: string; +begin + Result := SelfClassName; +end; + +initialization + RegisterJclContainers; + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclPreProcessorLexer.pas b/3rdParty/JCL/source/common/JclPreProcessorLexer.pas new file mode 100644 index 00000000..172a31af --- /dev/null +++ b/3rdParty/JCL/source/common/JclPreProcessorLexer.pas @@ -0,0 +1,449 @@ +{ **************************************************************************** } +{ } +{ Pascal PreProcessor Lexer } +{ Copyright (c) 2001 Barry Kelly. } +{ barry_j_kelly@hotmail.com } +{ } +{ The contents of this file are subject to the Mozilla Public License } +{ Version 1.1 (the "License"); you may not use this file except in } +{ compliance with the License. You may obtain a copy of the License at } +{ http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" } +{ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the } +{ License for the specific language governing rights and limitations } +{ under the License. } +{ } +{ The Original Code is PppLexer.pas } +{ } +{ The Initial Developer of the Original Code is Barry Kelly. } +{ Portions created by Barry Kelly are Copyright (C) 2001 } +{ Barry Kelly. All Rights Reserved. } +{ } +{ Contributors: } +{ Robert Rossmair (rrossmair) } +{ Florent Ouchet } +{ } +{ Alternatively, the contents of this file may be used under the terms } +{ of the Lesser GNU Public License (the "LGPL License"), in which case } +{ the provisions of LGPL License are applicable instead of those } +{ above. If you wish to allow use of your version of this file only } +{ under the terms of the LPGL License and not to allow others to use } +{ your version of this file under the MPL, indicate your decision by } +{ deleting the provisions above and replace them with the notice and } +{ other provisions required by the LGPL License. If you do not delete } +{ the provisions above, a recipient may use your version of this file } +{ under either the MPL or the LPGL License. } +{ } +{ **************************************************************************** } +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{ **************************************************************************** } +{ } +{ JppLexer differs from the original unit in that it provides a separate } +{ token for line breaks, ptEol. That makes it much easier to remove } +{ orphaned line breaks after conditional compilation symbol resolution, } +{ see unit JppParser. } +{ } +{ **************************************************************************** } + +unit JclPreProcessorLexer; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, System.Classes, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, Classes, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclStrHashMap, JclStrings; + +type + TJppToken = (ptEof, ptComment, ptText, ptEol, + ptDefine, ptUndef, ptIfdef, ptIfndef, ptIfopt, ptElse, ptEndif, + ptInclude, ptJppDefineMacro, ptJppExpandMacro, ptJppUndefMacro, + ptJppGetStrValue, ptJppGetIntValue, ptJppGetBoolValue, + ptJppSetStrValue, ptJppSetIntValue, ptJppSetBoolValue, ptJppLoop, + // same as $DEFINE and $UNDEF but they will not be written to the final file + ptJppDefine, ptJppUndef); + + EJppLexerError = class(EJclError); + + TJppLexer = class + private + FBuf: string; + FTokenHash: TStringHashMap; + FCurrPos: PChar; + FCurrLine: Integer; + FCurrTok: TJppToken; + FTokenAsString: string; + FRawComment: string; + FIgnoreUnterminatedStrings: Boolean; + public + constructor Create(const ABuffer: string; AIgnoreUnterminatedStrings: Boolean = False); + destructor Destroy; override; + + procedure Error(const AMsg: string); + procedure NextTok; + procedure Reset; + property CurrTok: TJppToken read FCurrTok; + { TokenAsString is the preprocessor symbol for $IFDEF & $IFNDEF, + and the file name for $I and $INCLUDE, and is the actual text + for ptComment and ptText. } + property TokenAsString: string read FTokenAsString; + { The raw comment for $IFDEF, etc. when TokenAsString becomes the + file name / preprocessor symbol. } + property RawComment: string read FRawComment; + { Do not raise exceptions when strings are not terminated } + property IgnoreUnterminatedStrings: Boolean read FIgnoreUnterminatedStrings write FIgnoreUnterminatedStrings; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +{ TJppLexer } + +constructor TJppLexer.Create(const ABuffer: string; AIgnoreUnterminatedStrings: Boolean); + + procedure AddToken(const AIdent: string; AValue: TJppToken); + var + x: Integer; + begin + x := Ord(AValue); + FTokenHash.Add(AIdent, x); + end; + +begin + inherited Create; + FIgnoreUnterminatedStrings := AIgnoreUnterminatedStrings; + + FTokenHash := TStringHashMap.Create(CaseInsensitiveTraits, 19); + + AddToken('i', ptInclude); + AddToken('include', ptInclude); + AddToken('ifdef', ptIfdef); + AddToken('ifndef', ptIfndef); + AddToken('ifopt', ptIfopt); + AddToken('else', ptElse); + AddToken('endif', ptEndif); + AddToken('define', ptDefine); + AddToken('undef', ptUndef); + AddToken('jppdefinemacro', ptjppDefineMacro); + AddToken('jppexpandmacro', ptJppExpandMacro); + AddToken('jppundefmacro', ptJppUndefMacro); + AddToken('jppstrvalue', ptJppGetStrValue); // backward compatibility + AddToken('jppintvalue', ptJppGetIntValue); // backward compatibility + AddToken('jppboolvalue', ptJppGetBoolValue); // backward compatibility + AddToken('jppgetstrvalue', ptJppGetStrValue); + AddToken('jppgetintvalue', ptJppGetIntValue); + AddToken('jppgetboolvalue', ptJppGetBoolValue); + AddToken('jppsetstrvalue', ptJppSetStrValue); + AddToken('jppsetintvalue', ptJppSetIntValue); + AddToken('jppsetboolvalue', ptJppSetBoolValue); + AddToken('jpploop', ptJppLoop); + AddToken('jppdefine', ptJppDefine); + AddToken('jppundef', ptJppUndef); + + FBuf := ABuffer; + Reset; +end; + +destructor TJppLexer.Destroy; +begin + FTokenHash.Free; + inherited; +end; + +procedure TJppLexer.Error(const AMsg: string); +begin + if not IgnoreUnterminatedStrings then + raise EJppLexerError.CreateFmt('(%d): %s', [FCurrLine, AMsg]); +end; + +procedure TJppLexer.NextTok; + + procedure HandleDirective(APos: PChar); + + { needs to be special, because it checks for not * or } + function ReadString(cp: PChar; var ident: string): PChar; + var + start: PChar; + begin + if cp^ = '"' then + begin + Inc(cp); + start := cp; + while (cp^ <> #0) and (cp^ <> #10) and (cp^ <> #13) and (cp^ <> '"') do + Inc(cp); + if (cp^ = #0) or (cp^ = #10) or (cp^ = #13) then + Error('Unterminated string'); + SetString(ident, start, cp - start); + Result := cp + 1; + end + else + begin + start := cp; + while (not CharIsSpace(cp^)) and (cp^ <> '*') and (cp^ <> '}') do + Inc(cp); + if cp^ = #0 then + Error('Unterminated string'); + SetString(ident, start, cp - start); + Result := cp; + end; + end; + + var + BPos, start: PChar; + ident: string; + tokInt: Integer; + begin + Assert(APos^ = '$'); + Inc(APos); + start := APos; + + { read identifier } + while CharIsValidIdentifierLetter(APos^) do + Inc(APos); + SetString(ident, start, APos - start); + + { find identifier in hash map } + if FTokenHash.Find(ident, tokInt) then + begin + FCurrTok := TJppToken(tokInt); + + case FCurrTok of + ptDefine, + ptUndef, + ptIfdef, + ptIfndef, + ptJppDefine, + ptJppUndef, + ptJppGetStrValue, + ptJppGetIntValue, + ptJppGetBoolValue, + ptJppSetStrValue, + ptJppSetIntValue, + ptJppSetBoolValue: + begin + BPos := APos; + StrSkipChars(BPos, CharIsWhiteSpace); + StrIdent(BPos, FTokenAsString); + end; + ptInclude: + begin + BPos := APos; + StrSkipChars(BPos, CharIsWhiteSpace); + ReadString(BPos, FTokenAsString); + end; + end; + end + else + { other directives must pass through; therefore call them text } + FCurrTok := ptText; + end; + +var + cp, start: PChar; + cl: Integer; + Eol: Boolean; +label + Label_NormalText; +begin + { register variables optimization } + cp := FCurrPos; + cl := FCurrLine; + + { determine token type } + case cp^ of + + { the buck stops here } + #0: + begin + FCurrTok := ptEof; + Exit; + end; + + { possible Standard Pascal comment } + '(': + begin + if (cp + 1)^ <> '*' then + goto Label_NormalText; + start := cp; + Inc(cp, 2); + while True do + begin + case cp^ of + #0: + Break; + #10: + Inc(cl); + '*': + if (cp + 1)^ = ')' then + Break; + end; + Inc(cp); + end; + if cp^ = '*' then + Inc(cp, 2); // get whole of comment, including trailing '*)' + SetString(FTokenAsString, start, cp - start); + FCurrTok := ptComment; + end; + + { possible line comment } + '/': + begin + if (cp + 1)^ <> '/' then + goto Label_NormalText; + start := cp; + Inc(cp, 2); + while True do + case cp^ of + #0, #13, #10: + Break; + else + Inc(cp); + end; + { if cp^ is #10, we leave it in, to avoid formatting cock-ups } + SetString(FTokenAsString, start, cp - start); + FCurrTok := ptComment; + end; + + { pascal comment } + '{': + begin + start := cp; + while True do + begin + case cp^ of + #0, '}': + Break; + #10: + Inc(cl); + end; + Inc(cp); + end; + if cp^ = '}' then + Inc(cp); + SetString(FTokenAsString, start, cp - start); + FCurrTok := ptComment; + end; + else +Label_NormalText: + { process normal text; passes straight through until next comment or eof } + start := cp; + + Eol := False; + if cp^ = #13 then + begin + Eol := True; + Inc(cp); + end; + if cp^ = #10 then + begin + Eol := True; + Inc(cp); + end; + + if Eol then + Inc(cl) + else + while True do + begin + case cp^ of + #0, #10, #13: + Break; + '{': + Break; + '/': + if (cp + 1)^ = '/' then + Break; + '(': + if (cp + 1)^ = '*' then + Break; + + { must handle strings separately; there can be no comments in strings } + '''': + begin + Inc(cp); + while True do + case cp^ of + #0, #10: + begin + FCurrLine := cl; + Error('String not terminated'); + Break; + end; + '''': + Break; + else + Inc(cp); + end; { of '''' case } + end; + end; + Inc(cp); + end; + SetString(FTokenAsString, start, cp - start); + if Eol then + FCurrTok := ptEol + else + FCurrTok := ptText; + end; + + { find out if we have a special directive } + if FCurrTok = ptComment then + begin + FRawComment := FTokenAsString; + case (start + 1)^ of + '$': // {$ + HandleDirective(start + 1); + + '*': // (*$ + if (start + 2)^ = '$' then + HandleDirective(start + 2); + '/': // do nothing + ; + end; + end; + + { restore register variables } + FCurrPos := cp; + FCurrLine := cl; +end; + +procedure TJppLexer.Reset; +begin + FCurrPos := PChar(FBuf); + FCurrLine := 1; + NextTok; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclPreProcessorLinkedListsTemplates.pas b/3rdParty/JCL/source/common/JclPreProcessorLinkedListsTemplates.pas new file mode 100644 index 00000000..12e78905 --- /dev/null +++ b/3rdParty/JCL/source/common/JclPreProcessorLinkedListsTemplates.pas @@ -0,0 +1,260 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclLinkedListsTemplates.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. } +{ } +{ Contributors: } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclPreProcessorLinkedListsTemplates; + +interface + +{$I jcl.inc} + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclPreProcessorContainerTypes, + JclPreProcessorContainerTemplates, + JclPreProcessorContainer1DTemplates; + +type + (* JCLLINKEDLISTTYPESINT(ITEMCLASSNAME, TYPENAME) *) + TJclLinkedListTypeIntParams = class(TJclContainerInterfaceParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property ItemClassName: string index taLinkedListItemClassName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* JCLLINKEDLISTINT(ITEMCLASSNAME, SELFCLASSNAME, ANCESTORCLASSNAME, + BASECONTAINTERINTERFACENAME, FLATCONTAINERINTERFACENAME, COLLECTIONINTERFACENAME, + LISTINTERFACENAME, ITRINTERFACENAME, EQUALITYCOMPARERINTERFACENAME, + INTERFACEADDITIONAL, SECTIONADDITIONAL, + COLLECTIONFLAGS, OWNERSHIPDECLARATION, CONSTKEYWORD, PARAMETERNAME, + TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) *) + TJclLinkedListIntParams = class(TJclCollectionInterfaceParams) + protected + // function CodeUnit: string; override; + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property ItemClassName: string index taLinkedListItemClassName read GetTypeAttribute write SetTypeAttribute stored False; + property SelfClassName: string index taLinkedListClassName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property AncestorClassName; + property BaseContainerInterfaceName: string index taContainerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property FlatContainerInterfaceName: string index taFlatContainerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property CollectionInterfaceName: string index taCollectionInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ListInterfaceName: string index taListInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property EqualityComparerInterfaceName: string index taEqualityComparerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property InterfaceAdditional; + property SectionAdditional; + property CollectionFlags; + property OwnershipDeclaration; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* JCLLINKEDLISTITRINT(SELFCLASSNAME, ITRINTERFACENAME, LISTCLASSNAME, EQUALITYCOMPARERINTERFACENAME, + ITEMCLASSNAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, + GETTERFUNCTIONNAME, SETTERPROCEDURENAME) *) + TJclLinkedListItrIntParams = class(TJclContainerInterfaceParams) + protected + // function CodeUnit: string; override; + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property SelfClassName: string index taLinkedListIteratorClassName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ListClassName: string index taLinkedListClassName read GetTypeAttribute write SetTypeAttribute stored False; + property EqualityComparerInterfaceName: string index taEqualityComparerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ItemClassName: string index taLinkedListItemClassName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property DefaultValue: string index taDefaultValue read GetTypeAttribute write SetTypeAttribute stored False; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* JCLLINKEDLISTIMP(SELFCLASSNAME, ITEMCLASSNAME, COLLECTIONINTERFACENAME, LISTINTERFACENAME, + ITRINTERFACENAME, ITRCLASSNAME, OWNERSHIPDECLARATION, OWNERSHIPPARAMETERNAME, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, + GETTERFUNCTIONNAME, SETTERPROCEDURENAME, RELEASERFUNCTIONNAME) *) + TJclLinkedListImpParams = class(TJclCollectionImplementationParams) + protected + // function CodeUnit: string; override; + public + function GetConstructorParameters: string; override; + function GetSelfClassName: string; override; + published + property SelfClassName: string index taLinkedListClassName read GetTypeAttribute write SetTypeAttribute stored False; + property ItemClassName: string index taLinkedListItemClassName read GetTypeAttribute write SetTypeAttribute stored False; + property CollectionInterfaceName: string index taCollectionInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ListInterfaceName: string index taListInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrClassName: string index taLinkedListIteratorClassName read GetTypeAttribute write SetTypeAttribute stored False; + property OwnershipDeclaration; + property OwnershipParameterName: string index taOwnershipParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property DefaultValue: string index taDefaultValue read GetTypeAttribute write SetTypeAttribute stored False; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + property ReleaserFunctionName: string index taReleaserFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property MacroFooter; + end; + + (* JCLLINKEDLISTITRIMP(SELFCLASSNAME, ITRINTERFACENAME, LISTCLASSNAME, EQUALITYCOMPARERINTERFACENAME, + ITEMCLASSNAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, + GETTERFUNCTIONNAME, SETTERPROCEDURENAME, RELEASERCALL) *) + TJclLinkedListItrImpParams = class(TJclContainerImplementationParams) + private + FReleaserCall: string; + function GetReleaserCall: string; + protected + // function CodeUnit: string; override; + public + procedure ResetDefault(Value: Boolean); override; + published + property SelfClassName: string index taLinkedListIteratorClassName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ListClassName: string index taLinkedListClassName read GetTypeAttribute write SetTypeAttribute stored False; + property EqualityComparerInterfaceName: string index taEqualityComparerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ItemClassName: string index taLinkedListItemClassName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property DefaultValue: string index taDefaultValue read GetTypeAttribute write SetTypeAttribute stored False; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + property ReleaserCall: string read GetReleaserCall write FReleaserCall; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclStrings; + +procedure RegisterJclContainers; +begin + RegisterContainerParams('JCLLINKEDLISTTYPESINT', TJclLinkedListTypeIntParams); + RegisterContainerParams('JCLLINKEDLISTINT', TJclLinkedListIntParams); + RegisterContainerParams('JCLLINKEDLISTITRINT', TJclLinkedListItrIntParams); + RegisterContainerParams('JCLLINKEDLISTIMP', TJclLinkedListImpParams, TJclLinkedListIntParams); + RegisterContainerParams('JCLLINKEDLISTITRIMP', TJclLinkedListItrImpParams, TJclLinkedListItrIntParams); +end; + +//=== { TJclLinkedListTypeIntParams } ======================================== + +function TJclLinkedListTypeIntParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taLinkedListItemClassName]; +end; + +//=== { TJclLinkedListIntParams } ============================================ + +function TJclLinkedListIntParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taLinkedListClassName]; +end; + +//=== { TJclLinkedListItrIntParams } ========================================= + +function TJclLinkedListItrIntParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taLinkedListIteratorClassName]; +end; + +//=== { TJclLinkedListImpParams } ============================================ + +function TJclLinkedListImpParams.GetConstructorParameters: string; +begin + Result := 'nil'; +end; + +function TJclLinkedListImpParams.GetSelfClassName: string; +begin + Result := SelfClassName; +end; + +//=== { TJclLinkedListItrImpParams } ========================================= + +function TJclLinkedListItrImpParams.GetReleaserCall: string; +begin + Result := FReleaserCall; + if (Result = '') and TypeInfo.KnownType then + begin + if TypeInfo.TObjectType then + Result := '(FownList as IJclObjectOwner).FreeObject(FCursor.Value);' + else + Result := Format('FCursor.Value := %s;', [TypeInfo.TypeAttributes[taDefaultValue]]); + end; +end; + +procedure TJclLinkedListItrImpParams.ResetDefault(Value: Boolean); +begin + inherited ResetDefault(Value); + FReleaserCall := ''; + if not Value then + FReleaserCall := GetReleaserCall; +end; + +initialization + RegisterJclContainers; + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclPreProcessorParser.pas b/3rdParty/JCL/source/common/JclPreProcessorParser.pas new file mode 100644 index 00000000..f58fd43c --- /dev/null +++ b/3rdParty/JCL/source/common/JclPreProcessorParser.pas @@ -0,0 +1,1584 @@ +{ **************************************************************************** } +{ } +{ Pascal PreProcessor Parser } +{ Copyright (c) 2001 Barry Kelly. } +{ barry_j_kelly@hotmail.com } +{ } +{ The contents of this file are subject to the Mozilla Public License } +{ Version 1.1 (the "License"); you may not use this file except in } +{ compliance with the License. You may obtain a copy of the License at } +{ http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" } +{ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the } +{ License for the specific language governing rights and limitations } +{ under the License. } +{ } +{ The Original Code is PppParser.pas } +{ } +{ The Initial Developer of the Original Code is Barry Kelly. } +{ Portions created by Barry Kelly are Copyright (C) 2001 } +{ Barry Kelly. All Rights Reserved. } +{ } +{ Contributors: } +{ Robert Rossmair, } +{ Peter Thörnqvist, } +{ Florent Ouchet } +{ } +{ Alternatively, the contents of this file may be used under the terms } +{ of the Lesser GNU Public License (the "LGPL License"), in which case } +{ the provisions of LGPL License are applicable instead of those } +{ above. If you wish to allow use of your version of this file only } +{ under the terms of the LPGL License and not to allow others to use } +{ your version of this file under the MPL, indicate your decision by } +{ deleting the provisions above and replace them with the notice and } +{ other provisions required by the LGPL License. If you do not delete } +{ the provisions above, a recipient may use your version of this file } +{ under either the MPL or the LPGL License. } +{ } +{ **************************************************************************** } +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{ **************************************************************************** } + +unit JclPreProcessorParser; + +{$I jcl.inc} + +interface + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, System.Classes, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, Classes, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclBase, JclContainerIntf, JclPreProcessorLexer; + +type + TPppState = class; + + EPppParserError = class(EJclError); + + TJppParser = class + private + FLexer: TJppLexer; + FState: TPppState; + FResult: string; + FResultLen: Integer; + FLineBreakPos: Integer; + FAllWhiteSpaceIn: Boolean; + FAllWhiteSpaceOut: Boolean; + protected + procedure AddResult(const S: string; FixIndent: Boolean = False; ForceRecurseTest: Boolean = False); + function IsExcludedInclude(const FileName: string): Boolean; + + procedure NextToken; + + procedure ParseText; + procedure ParseCondition(Token: TJppToken); + function ParseInclude: string; + + procedure ParseDefine(Skip: Boolean); + procedure ParseUndef(Skip: Boolean); + + procedure ParseDefineMacro; + procedure ParseExpandMacro; + procedure ParseUndefMacro; + + procedure ParseGetBoolValue; + procedure ParseGetIntValue; + procedure ParseGetStrValue; + procedure ParseLoop; + procedure ParseSetBoolValue; + procedure ParseSetIntValue; + procedure ParseSetStrValue; + public + constructor Create(const ABuffer: string; APppState: TPppState); + destructor Destroy; override; + function Parse: string; + + property Lexer: TJppLexer read FLexer; + property State: TPppState read FState; + end; + + EPppState = class(EJclError); + + TPppOption = (poProcessIncludes, poProcessDefines, poStripComments, + poProcessMacros, poProcessValues, poNoWarningHeader, poKeepTabAndSpaces, + poIgnoreUnterminatedStrings); + TPppOptions = set of TPppOption; + + TTriState = (ttUnknown, ttUndef, ttDefined); + + TPppStateItem = class + public + DefinedKeywords: IJclStrMap; + ExcludedFiles: IJclStrList; + Macros: IJclStrIntfMap; + SearchPath: IJclStrList; + TriState: TTriState; + end; + + TPppStateItemClass = class of TPppStateItem; + + TPppProvider = class(TPersistent) + protected + function GetBoolValue(const Name: string): Boolean; virtual; abstract; + function GetDefine(const ASymbol: string): TTriState; virtual; abstract; + function GetIntegerValue(const Name: string): Integer; virtual; abstract; + function GetStringValue(const Name: string): string; virtual; abstract; + procedure SetBoolValue(const Name: string; Value: Boolean); virtual; abstract; + procedure SetDefine(const ASymbol: string; const Value: TTriState); virtual; abstract; + procedure SetIntegerValue(const Name: string; Value: Integer); virtual; abstract; + procedure SetStringValue(const Name, Value: string); virtual; abstract; + public + property Defines[const ASymbol: string]: TTriState read GetDefine write SetDefine; + property BoolValues[const Name: string]: Boolean read GetBoolValue write SetBoolValue; + property StringValues[const Name: string]: string read GetStringValue write SetStringValue; + property IntegerValues[const Name: string]: Integer read GetIntegerValue write SetIntegerValue; + end; + + TPppState = class(TPppProvider) + private + FStateStack: IJclStack; + FOptions: TPppOptions; + function InternalPeekDefines: IJclStrMap; + function InternalPeekExcludedFiles: IJclStrList; + function InternalPeekMacros: IJclStrIntfMap; + function InternalPeekSearchPath: IJclStrList; + function InternalPeekTriState: TTriState; + procedure InternalSetTriState(Value: TTriState); + protected + class function StateItemClass: TPppStateItemClass; virtual; + procedure InternalPushState(FromStateItem, ToStateItem: TPppStateItem); virtual; + function PeekStateItem: TPppStateItem; + + function GetOptions: TPppOptions; + procedure SetOptions(AOptions: TPppOptions); + + function FindMacro(const AMacroName: string): IJclStrList; + function AssociateParameters(const ParamNames: IJclStrList; + const ParamValues: TDynStringArray): TDynWideStringArray; + + function GetBoolValue(const Name: string): Boolean; override; + function GetDefine(const ASymbol: string): TTriState; override; + function GetIntegerValue(const Name: string): Integer; override; + function GetStringValue(const Name: string): string; override; + procedure SetBoolValue(const Name: string; Value: Boolean); override; + procedure SetDefine(const ASymbol: string; const Value: TTriState); override; + procedure SetIntegerValue(const Name: string; Value: Integer); override; + procedure SetStringValue(const Name, Value: string); override; + public + constructor Create; + destructor Destroy; override; + + procedure AfterConstruction; override; + + { PushState is called at the start of every unit, and PopState at the + end. This means that any declarations like $DEFINE will be file-local + in scope. } + procedure PushState; + procedure PopState; + + property TriState: TTriState read InternalPeekTriState write InternalSetTriState; + + procedure Define(const ASymbol: string); + procedure Undef(const ASymbol: string); + + function FindFile(const AName: string): TStream; + procedure AddToSearchPath(const AName: string); + + procedure AddFileToExclusionList(const AName: string); + function IsFileExcluded(const AName: string): Boolean; + + function ExpandMacro(const AName: string; const ParamValues: TDynStringArray): string; virtual; + procedure DefineMacro(const AName: string; const ParamNames: TDynStringArray; + const Value: string); + procedure UndefMacro(const AName: string; const ParamNames: TDynStringArray); + + property Options: TPppOptions read GetOptions write SetOptions; + end; + + TPppStateClass = class of TPppState; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.TypInfo, + {$ELSE ~HAS_UNITSCOPE} + TypInfo, + {$ENDIF ~HAS_UNITSCOPE} + JclStrings, JclStreams, JclSysUtils, JclArrayLists, JclHashMaps, JclStacks; + +function AllWhiteSpace(P: PChar; KeepTabAndSpaces: Boolean): Boolean; +var + I: Integer; +begin + Result := True; + for I := 1 to StrLen(P) do + case P^ of + NativeTab, NativeSpace: + if KeepTabAndSpaces then + begin + Result := False; + Break; + end + else + Inc(P); + NativeLineFeed, NativeCarriageReturn: + Inc(P); + else + Result := False; + Break; + end; +end; + +function ParseMacro(const MacroText: string; var MacroName: string; var ParamNames: TDynStringArray; + ParamDeclaration: Boolean): Integer; +var + I, J: Integer; + Comment: Boolean; + ParenthesisCount: Integer; + MacroTextLen: Integer; + MacroParenthesis, MacroBracket: Boolean; +begin + MacroTextLen := Length(MacroText); + I := 1; + while (I <= MacroTextLen) and not CharIsSpace(MacroText[I]) do + Inc(I); + while (I <= MacroTextLen) and CharIsSpace(MacroText[I]) do + Inc(I); + J := I; + while (J <= MacroTextLen) and CharIsValidIdentifierLetter(MacroText[J]) do + Inc(J); + MacroName := Copy(MacroText, I, J - I); + + if J <= MacroTextLen then + begin + SetLength(ParamNames, 0); + MacroParenthesis := MacroText[J] = '('; + MacroBracket := MacroText[J] = '['; + if MacroParenthesis or MacroBracket then + begin + Inc(J); + if ParamDeclaration then + begin + repeat + while (J <= MacroTextLen) and CharIsSpace(MacroText[J]) do + Inc(J); + I := J; + while (I <= MacroTextLen) and CharIsValidIdentifierLetter(MacroText[I]) do + Inc(I); + SetLength(ParamNames, Length(ParamNames) + 1); + ParamNames[High(ParamNames)] := Copy(MacroText, J, I - J); + while (I <= MacroTextLen) and CharIsSpace(MacroText[I]) do + Inc(I); + if (I <= MacroTextLen) then + begin + if MacroParenthesis then + case MacroText[I] of + ',': + Inc(I); + ')': ; + else + raise EPppParserError.CreateFmt('invalid parameter declaration in macro "%s"', [MacroText]); + end; + if MacroBracket then + case MacroText[I] of + '|': + Inc(I); + ']': ; + else + raise EPppParserError.CreateFmt('invalid parameter declaration in macro "%s"', [MacroText]); + end; + end; + J := I; + until (J > MacroTextLen) or (MacroParenthesis and (MacroText[J] = ')')) or (MacroBracket and (MacroText[J] = ']')); + end + else + begin + repeat + I := J; + Comment := False; + ParenthesisCount := 0; + + while I <= MacroTextLen do + begin + case MacroText[I] of + NativeSingleQuote: + Comment := not Comment; + '(': + if not Comment then + Inc(ParenthesisCount); + ')': + begin + if MacroParenthesis and (not Comment) and (ParenthesisCount = 0) then + Break; + if not Comment then + Dec(ParenthesisCount); + end; + ']': + if MacroBracket and (not Comment) and (ParenthesisCount = 0) then + Break; + NativeBackslash: + if (not Comment) and (ParenthesisCount = 0) and (I < MacroTextLen) and (MacroText[i + 1] = NativeComma) then + Inc(I); + NativeComma: + if MacroParenthesis and (not Comment) and (ParenthesisCount = 0) then + Break; + '|': + if MacroBracket and (not Comment) and (ParenthesisCount = 0) then + Break; + end; + Inc(I); + end; + SetLength(ParamNames, Length(ParamNames) + 1); + ParamNames[High(ParamNames)] := Copy(MacroText, J, I - J); + StrReplace(ParamNames[High(ParamNames)], '\,', ',', [rfReplaceAll]); + if MacroParenthesis then + begin + if (I < MacroTextLen) and (MacroText[I] = ')') then + begin + J := I; + Break; + end; + if (I < MacroTextLen) and (MacroText[I] = ',') then + Inc(I); + end; + if MacroBracket then + begin + if (I < MacroTextLen) and (MacroText[I] = ']') then + begin + J := I; + Break; + end; + if (I < MacroTextLen) and (MacroText[I] = '|') then + Inc(I); + end; + J := I; + until J > MacroTextLen; + end; + if J <= MacroTextLen then + begin + if MacroParenthesis and (MacroText[J] = ')') then + Inc(J) // skip ) + else + if MacroBracket and (MacroText[J] = ']') then + Inc(J) // skip ] + else + raise EPppParserError.CreateFmt('Unterminated list of arguments for macro "%s"', [MacroText]); + end; + end + else + begin + while (J <= MacroTextLen) and CharIsSpace(MacroText[J]) do + Inc(J); + end; + end; + Result := J; +end; + +{ TJppParser } + +constructor TJppParser.Create(const ABuffer: string; APppState: TPppState); +begin + inherited Create; + Assert(APppState <> nil); + + FLexer := TJppLexer.Create(ABuffer, poIgnoreUnterminatedStrings in APppState.Options); + FState := APppState; + FState.Undef('PROTOTYPE'); +end; + +destructor TJppParser.Destroy; +begin + FLexer.Free; + inherited Destroy; +end; + +procedure TJppParser.AddResult(const S: string; FixIndent, ForceRecurseTest: Boolean); +var + I, J: Integer; + LinePrefix, AResult, Line: string; + TempMemoryStream: TMemoryStream; + TempStringStream: TJclAutoStream; + TempLexer: TJppLexer; + TempParser: TJppParser; + Lines: TStrings; + Recurse: Boolean; +begin + if State.TriState = ttUndef then + Exit; + + AResult := S; + // recurse macro expanding + if (AResult <> '') and (ForceRecurseTest or (StrIPos('$JPP', AResult) > 0)) then + begin + try + Recurse := False; + TempLexer := TJppLexer.Create(AResult, poIgnoreUnterminatedStrings in State.Options); + try + State.PushState; + while True do + begin + case TempLexer.CurrTok of + ptEof: + Break; + ptDefine, + ptJppDefine, + ptUndef, + ptJppUndef: + if poProcessDefines in State.Options then + begin + Recurse := True; + Break; + end; + ptIfdef, ptIfndef: + if (poProcessDefines in State.Options) and (State.Defines[TempLexer.TokenAsString] in [ttDefined, ttUndef]) then + begin + Recurse := True; + Break; + end; + ptJppDefineMacro, + ptJppExpandMacro, + ptJppUndefMacro: + if poProcessMacros in State.Options then + begin + Recurse := True; + Break; + end; + ptJppGetStrValue, + ptJppGetIntValue, + ptJppGetBoolValue, + ptJppSetStrValue, + ptJppSetIntValue, + ptJppSetBoolValue, + ptJppLoop: + if poProcessValues in State.Options then + begin + Recurse := True; + Break; + end; + end; + TempLexer.NextTok; + end; + finally + State.PopState; + TempLexer.Free; + end; + if Recurse then + begin + TempMemoryStream := TMemoryStream.Create; + try + TempStringStream := TJclAutoStream.Create(TempMemoryStream); + try + TempStringStream.WriteString(AResult, 1, Length(AResult)); + TempStringStream.Seek(0, soBeginning); + TempParser := TJppParser.Create(TempStringStream.ReadString, State); + try + AResult := TempParser.Parse; + finally + TempParser.Free; + end; + finally + TempStringStream.Free; + end; + finally + TempMemoryStream.Free; + end; + end; + except + // The text might not be well-formed Pascal source and + // thus exceptions might be raised, in such case, just add the text without recursion + AResult := S; + end; + end; + if FixIndent and (AResult <> '') then + begin + // find the number of white space at the beginning of the current line (indentation level) + I := FResultLen + 1; + while (I > 1) and not CharIsReturn(FResult[I - 1]) do + Dec(I); + J := I; + while (J <= FResultLen) and CharIsWhiteSpace(FResult[J]) do + Inc(J); + LinePrefix := StrRepeat(NativeSpace, J - I); + + Lines := TStringList.Create; + try + StrToStrings(AResult, NativeLineBreak, Lines); + if not (poKeepTabAndSpaces in State.Options) then + begin + // remove first empty lines + while Lines.Count > 0 do + begin + if Lines.Strings[0] = '' then + Lines.Delete(0) + else + Break; + end; + // remove last empty lines + for I := Lines.Count - 1 downto 0 do + begin + if Lines.Strings[I] = '' then + Lines.Delete(I) + else + Break; + end; + end; + // fix line offsets + if LinePrefix <> '' then + for I := 1 to Lines.Count - 1 do + begin + Line := Lines.Strings[I]; + if Line <> '' then + Lines.Strings[I] := LinePrefix + Line; + end; + AResult := StringsToStr(Lines, NativeLineBreak); + finally + Lines.Free; + end; + end; + if AResult <> '' then + begin + while FResultLen + Length(AResult) > Length(FResult) do + SetLength(FResult, Length(FResult) * 2); + Move(AResult[1], FResult[FResultLen + 1], Length(AResult) * SizeOf(Char)); + FAllWhiteSpaceOut := FAllWhiteSpaceOut and AllWhiteSpace(PChar(AResult), poKeepTabAndSpaces in State.Options); + Inc(FResultLen, Length(AResult)); + end; +end; + +function TJppParser.IsExcludedInclude(const FileName: string): Boolean; +begin + Result := State.IsFileExcluded(FileName); +end; + +procedure TJppParser.NextToken; +begin + Lexer.NextTok; + + if State.TriState = ttUndef then + Exit; + + case Lexer.CurrTok of + ptEof, ptEol: + // do not change FAllWhiteSpaceIn + ; + ptComment: + FAllWhiteSpaceIn := False; + ptText: + FAllWhiteSpaceIn := FAllWhiteSpaceIn and AllWhiteSpace(PChar(Lexer.TokenAsString), poKeepTabAndSpaces in State.Options); + ptDefine, + ptUndef, + ptIfdef, + ptIfndef, + ptIfopt, + ptElse, + ptEndif, + ptJppDefine, + ptJppUndef, + ptJppDefineMacro, + ptJppExpandMacro, + ptJppUndefMacro, + ptJppGetStrValue, + ptJppGetIntValue, + ptJppGetBoolValue, + ptJppSetStrValue, + ptJppSetIntValue, + ptJppSetBoolValue, + ptJppLoop: + FAllWhiteSpaceIn := False; + ptInclude: + FAllWhiteSpaceIn := IsExcludedInclude(Lexer.TokenAsString); + else + // Error + end; +end; + +function TJppParser.Parse: string; +begin + FLexer.Reset; + SetLength(FResult, 64 * 1024); + FillChar(FResult[1], Length(FResult) * SizeOf(Char), 0); + FResultLen := 0; + FLineBreakPos := 1; + FAllWhiteSpaceOut := True; + + ParseText; + SetLength(FResult, FResultLen); + Result := FResult; +end; + +procedure TJppParser.ParseCondition(Token: TJppToken); + procedure PushAndExecute(NewTriState: TTriState); + var + NeedPush: Boolean; + begin + NeedPush := State.TriState <> NewTriState; + if NeedPush then + State.PushState; + try + State.TriState := NewTriState; + NextToken; + ParseText; + finally + if NeedPush then + State.PopState; + end; + end; +var + Condition: string; + ConditionTriState: TTriState; +begin + Condition := Lexer.TokenAsString; + ConditionTriState := State.Defines[Condition]; + // parse the first part of the $IFDEF or $IFNDEF + case ConditionTriState of + ttUnknown: + begin + State.PushState; + try + // preserve the $IFDEF or $IFNDEF + AddResult(Lexer.RawComment); + // assume that the symbol is defined in the $IFDEF + if Token = ptIfdef then + State.Define(Condition) + else + // assume that the symbol is not defined in the $IFNDEF + if Token = ptIfndef then + State.Undef(Condition); + NextToken; + ParseText; + finally + State.PopState; + end; + end; + ttUndef: + if Token = ptIfdef then + PushAndExecute(ttUndef) + else + if Token = ptIfndef then + PushAndExecute(ttDefined); + ttDefined: + if Token = ptIfdef then + PushAndExecute(ttDefined) + else + if Token = ptIfndef then + PushAndExecute(ttUndef); + end; + // part the second part of the $IFDEF or $IFNDEF if any + if Lexer.CurrTok = ptElse then + begin + case ConditionTriState of + ttUnknown: + begin + State.PushState; + try + // preserve the $ELSE + AddResult(Lexer.RawComment); + // assume that the symbol is not defined after the $IFDEF + if Token = ptIfdef then + State.Undef(Condition) + else + // assume that the symbol is defined after the $IFNDEF + if Token = ptIfndef then + State.Define(Condition); + NextToken; + ParseText; + finally + State.PopState; + end; + end; + ttUndef: + begin + if Token = ptIfdef then + PushAndExecute(ttDefined) + else + if Token = ptIfndef then + PushAndExecute(ttUndef); + //State.Defines[Condition] := ttDefined; + end; + ttDefined: + begin + if Token = ptIfdef then + PushAndExecute(ttUndef) + else + if Token = ptIfndef then + PushAndExecute(ttDefined); + //State.Defines[Condition] := ttUndef; + end; + end; + end; + if Lexer.CurrTok <> ptEndif then + Lexer.Error('$ENDIF expected'); + case ConditionTriState of + ttUnknown: + // preserve the $ENDIF + AddResult(Lexer.RawComment); + ttUndef: ; + ttDefined: ; + end; + NextToken; +end; + +procedure TJppParser.ParseDefine(Skip: Boolean); +var + Condition: string; +begin + Condition := Lexer.TokenAsString; + case State.Defines[Condition] of + // the symbol is not defined + ttUnknown, + ttUndef: + begin + State.Defines[Lexer.TokenAsString] := ttDefined; + if not Skip then + AddResult(Lexer.RawComment); + end; + // the symbol is already defined, always skip it + ttDefined: ; + end; + NextToken; +end; + +procedure TJppParser.ParseDefineMacro; +var + I, J: Integer; + MacroText, MacroName, MacroValue: string; + ParamNames: TDynStringArray; +begin + MacroText := Lexer.TokenAsString; + I := ParseMacro(MacroText, MacroName, ParamNames, True); + if I <= Length(MacroText) then + begin + if Copy(MacroText, I, Length(NativeLineBreak)) = NativeLineBreak then + Inc(I, Length(NativeLineBreak)); + J := Length(MacroText); + if MacroText[J] = ')' then + Dec(J); + MacroValue := Copy(MacroText, I, J - I); + State.DefineMacro(MacroName, ParamNames, MacroValue); + end; + NextToken; +end; + +procedure TJppParser.ParseExpandMacro; +var + MacroText, MacroName, AResult: string; + ParamNames: TDynStringArray; +begin + MacroText := Lexer.TokenAsString; + ParseMacro(MacroText, MacroName, ParamNames, False); + // macros are expanded in a sub-state + State.PushState; + try + AResult := State.ExpandMacro(MacroName, ParamNames); + // add result to buffer + AddResult(AResult, True, True); + finally + State.PopState; + end; + NextToken; +end; + +procedure TJppParser.ParseUndef(Skip: Boolean); +var + Condition: string; +begin + Condition := Lexer.TokenAsString; + case State.Defines[Condition] of + // the symbol is not defined + ttUnknown, + ttDefined: + begin + State.Defines[Lexer.TokenAsString] := ttUndef; + if not Skip then + AddResult(Lexer.RawComment); + end; + // the symbol is already defined, skip it + ttUndef: ; + end; + NextToken; +end; + +procedure TJppParser.ParseUndefMacro; +var + MacroText, MacroName: string; + ParamNames: TDynStringArray; +begin + MacroText := Lexer.TokenAsString; + ParseMacro(MacroText, MacroName, ParamNames, True); + State.UndefMacro(MacroName, ParamNames); + NextToken; +end; + +function TJppParser.ParseInclude: string; +var + oldLexer, newLexer: TJppLexer; + fsIn: TStream; + ssIn: TJclAutoStream; +begin + Result := ''; + Assert(Lexer.TokenAsString <> ''); + { we must prevent case of $I- & $I+ becoming file names } + if (Lexer.TokenAsString[1] = '-') + or (Lexer.TokenAsString[1] = '+') + or IsExcludedInclude(Lexer.TokenAsString) then + Result := Lexer.RawComment + else + begin + fsIn := nil; + ssIn := nil; + newLexer := nil; + + oldLexer := Lexer; + try + try + fsIn := FState.FindFile(Lexer.TokenAsString); + except + on e: Exception do + Lexer.Error(e.Message); + end; + ssIn := TJclAutoStream.Create(fsIn); + newLexer := TJppLexer.Create(ssIn.ReadString, poIgnoreUnterminatedStrings in State.Options); + FLexer := newLexer; + ParseText; + finally + FLexer := oldLexer; + ssIn.Free; + fsIn.Free; + newLexer.Free; + end; + end; + NextToken; +end; + +procedure TJppParser.ParseGetStrValue; +var + Name: string; +begin + Name := Lexer.TokenAsString; + AddResult(State.StringValues[Name]); + NextToken; +end; + +procedure TJppParser.ParseGetIntValue; +var + Name: string; +begin + Name := Lexer.TokenAsString; + AddResult(IntToStr(State.IntegerValues[Name])); + NextToken; +end; + +procedure TJppParser.ParseGetBoolValue; +var + Name: string; +begin + Name := Lexer.TokenAsString; + AddResult(BoolToStr(State.BoolValues[Name], True)); + NextToken; +end; + +procedure TJppParser.ParseLoop; +var + I, J, RepeatIndex, RepeatCount: Integer; + RepeatText, IndexName, CountName: string; +begin + I := 1; + RepeatText := Lexer.RawComment; + while (I <= Length(RepeatText)) and not CharIsWhiteSpace(RepeatText[I]) do + Inc(I); + while (I <= Length(RepeatText)) and CharIsWhiteSpace(RepeatText[I]) do + Inc(I); + J := I; + while (J <= Length(RepeatText)) and CharIsValidIdentifierLetter(RepeatText[J]) do + Inc(J); + IndexName := Copy(RepeatText, I, J - I); + while (J <= Length(RepeatText)) and CharIsWhiteSpace(RepeatText[J]) do + Inc(J); + I := J; + while (J <= Length(RepeatText)) and CharIsValidIdentifierLetter(RepeatText[I]) do + Inc(I); + CountName := Copy(RepeatText, J, I - J); + + J := Length(RepeatText); + if RepeatText[J] = ')' then + Dec(J); + RepeatText := Copy(RepeatText, I, J - I); + RepeatCount := State.IntegerValues[CountName]; + for RepeatIndex := 0 to RepeatCount - 1 do + begin + State.IntegerValues[IndexName] := RepeatIndex; + AddResult(RepeatText); + end; + State.IntegerValues[IndexName] := -1; + NextToken; +end; + +procedure TJppParser.ParseSetStrValue; +var + I, J: Integer; + Text, Name, Value: string; +begin + I := 1; + Text := Lexer.RawComment; + while (I <= Length(Text)) and not CharIsWhiteSpace(Text[I]) do + Inc(I); + while (I <= Length(Text)) and CharIsWhiteSpace(Text[I]) do + Inc(I); + J := I; + while (J <= Length(Text)) and CharIsValidIdentifierLetter(Text[J]) do + Inc(J); + Name := Copy(Text, I, J - I); + while (J <= Length(Text)) and CharIsWhiteSpace(Text[J]) do + Inc(J); + I := Length(Text); + if Text[I] = ')' then + Dec(I); + Value := Copy(Text, J, I - J); + State.StringValues[Name] := Value; + NextToken; +end; + +procedure TJppParser.ParseSetIntValue; +var + I, J: Integer; + Text, Name, Value: string; +begin + I := 1; + Text := Lexer.RawComment; + while (I <= Length(Text)) and not CharIsWhiteSpace(Text[I]) do + Inc(I); + while (I <= Length(Text)) and CharIsWhiteSpace(Text[I]) do + Inc(I); + J := I; + while (J <= Length(Text)) and CharIsValidIdentifierLetter(Text[J]) do + Inc(J); + Name := Copy(Text, I, J - I); + while (J <= Length(Text)) and CharIsWhiteSpace(Text[J]) do + Inc(J); + I := Length(Text); + if Text[I] = ')' then + Dec(I); + Value := Copy(Text, J, I - J); + State.IntegerValues[Name] := StrToInt(Value); + NextToken; +end; + +procedure TJppParser.ParseSetBoolValue; +var + I, J: Integer; + Text, Name, Value: string; +begin + I := 1; + Text := Lexer.RawComment; + while (I <= Length(Text)) and not CharIsWhiteSpace(Text[I]) do + Inc(I); + while (I <= Length(Text)) and CharIsWhiteSpace(Text[I]) do + Inc(I); + J := I; + while (J <= Length(Text)) and CharIsValidIdentifierLetter(Text[J]) do + Inc(J); + Name := Copy(Text, I, J - I); + while (J <= Length(Text)) and CharIsWhiteSpace(Text[J]) do + Inc(J); + I := Length(Text); + if Text[I] = ')' then + Dec(I); + Value := Copy(Text, J, I - J); + State.BoolValues[Name] := StrToBoolean(Value); + NextToken; +end; + +procedure TJppParser.ParseText; + + procedure AddRawComment; + begin + AddResult(Lexer.RawComment); + NextToken; + end; + + procedure DeleteCurrentLineIfOrphaned; + begin + if not FAllWhiteSpaceIn and FAllWhiteSpaceOut then + if FLineBreakPos <= FResultLen then + begin + FResultLen := FLineBreakPos - 1; + FResult[FResultLen + 1] := #0; + end; + end; + +begin + while True do + case Lexer.CurrTok of + ptComment: + begin + if not (poStripComments in State.Options) then + AddResult(Lexer.TokenAsString); + NextToken; + end; + + ptEof: + begin + DeleteCurrentLineIfOrphaned; + Break; + end; + + ptEol: + begin + AddResult(Lexer.TokenAsString); + DeleteCurrentLineIfOrphaned; + FLineBreakPos := FResultLen + 1; + FAllWhiteSpaceIn := True; + FAllWhiteSpaceOut := True; + NextToken; + end; + + ptText: + begin + AddResult(Lexer.TokenAsString); + NextToken; + end; + + ptDefine, ptJppDefine, ptUndef, ptJppUndef, ptIfdef, ptIfndef, ptIfopt: + if poProcessDefines in State.Options then + case Lexer.CurrTok of + ptDefine: + ParseDefine(False); + ptJppDefine: + ParseDefine(True); + ptUndef: + ParseUndef(False); + ptJppUndef: + ParseUndef(True); + ptIfdef: + ParseCondition(ptIfdef); + ptIfndef: + ParseCondition(ptIfndef); + ptIfopt: + ParseCondition(ptIfopt); + end + else + AddRawComment; + + ptElse, ptEndif: + if poProcessDefines in State.Options then + Break + else + AddRawComment; + + ptInclude: + if poProcessIncludes in State.Options then + AddResult(ParseInclude) + else + AddRawComment; + + ptJppDefineMacro, ptJppExpandMacro, ptJppUndefMacro: + if State.TriState = ttUndef then + NextToken + else + if poProcessMacros in State.Options then + case Lexer.CurrTok of + ptJppDefineMacro: + ParseDefineMacro; + ptJppExpandMacro: + ParseExpandMacro; + ptJppUndefMacro: + ParseUndefMacro; + end + else + AddRawComment; + + ptJppGetStrValue, + ptJppGetIntValue, + ptJppGetBoolValue, + ptJppSetStrValue, + ptJppSetIntValue, + ptJppSetBoolValue, + ptJppLoop: + if State.TriState = ttUndef then + NextToken + else + if poProcessValues in State.Options then + case Lexer.CurrTok of + ptJppGetStrValue: + ParseGetStrValue; + ptJppGetIntValue: + ParseGetIntValue; + ptJppGetBoolValue: + ParseGetBoolValue; + ptJppSetStrValue: + ParseSetStrValue; + ptJppSetIntValue: + ParseSetIntValue; + ptJppSetBoolValue: + ParseSetBoolValue; + ptJppLoop: + ParseLoop; + end + else + AddRawComment; + else + Break; + end; +end; + +//=== { TPppState } ========================================================== + +constructor TPppState.Create; +begin + inherited Create; + FStateStack := TJclStack.Create(16, True); +end; + +destructor TPppState.Destroy; +begin + FStateStack := nil; + inherited Destroy; +end; + +procedure TPppState.AddFileToExclusionList(const AName: string); +begin + InternalPeekExcludedFiles.Add(AName); +end; + +procedure TPppState.AddToSearchPath(const AName: string); +begin + InternalPeekSearchPath.Add(AName); +end; + +procedure TPppState.AfterConstruction; +var + StateItem: TPppStateItem; +begin + StateItem := StateItemClass.Create; + InternalPushState(nil, StateItem); + FStateStack.Push(StateItem); +end; + +function TPppState.AssociateParameters(const ParamNames: IJclStrList; + const ParamValues: TDynStringArray): TDynWideStringArray; +var + StrParams: TStrings; + AssociationByName: Boolean; + Index, ParamIndex: Integer; + AParamName, AParamText: string; +begin + SetLength(Result, Length(ParamValues)); + AssociationByName := True; + StrParams := TStringList.Create; + try + for Index := Low(ParamValues) to High(ParamValues) do + begin + StrParams.Add(ParamValues[Index]); + AParamName := StrParams.Names[Index]; + if Assigned(ParamNames) and (AParamName <> '') then + begin + // verify parameter names + ParamIndex := ParamNames.IndexOf(AParamName); + if ParamIndex < 0 then + AssociationByName := False; + end + else + AssociationByName := False; + end; + for Index := Low(ParamValues) to High(ParamValues) do + begin + if AssociationByName then + AParamText := StrParams.Values[ParamNames.Strings[Index]] + else + AParamText := StrParams.Strings[Index]; + Result[Index] := WideString(AParamText); + end; + finally + StrParams.Free; + end; +end; + +function TPppState.ExpandMacro(const AName: string; + const ParamValues: TDynStringArray): string; +var + AMacro: IJclStrList; + AMacroName, AMacroText: string; + Index: Integer; + Params: array of TVarRec; + AMacroParams: TDynWideStringArray; +begin + AMacroName := Format('%s`%d', [AName, Length(ParamValues)]); + AMacro := FindMacro(AMacroName); + // the macro text is the last item, previous items are the macro parameter names + AMacroText := AMacro.Strings[AMacro.Size - 1]; + AMacroParams := AssociateParameters(AMacro.SubList(0, AMacro.Size - 1), ParamValues); + + SetLength(Params, Length(ParamValues)); + for Index := Low(ParamValues) to High(ParamValues) do + begin + Params[Index].VType := vtPWideChar; + Params[Index].VPWideChar := PWideChar(AMacroParams[Index]); + end; + Result := Format(AMacroText, Params); +end; + +procedure TPppState.Define(const ASymbol: string); +begin + Defines[ASymbol] := ttDefined; +end; + +procedure TPppState.DefineMacro(const AName: string; + const ParamNames: TDynStringArray; const Value: string); +var + AMacro: IJclStrList; + AMacros: IJclStrIntfMap; + AMacroNames: IJclStrIterator; + AMacroName, AMacroFormat: string; + Index: Integer; +begin + AMacros := InternalPeekMacros; + AMacroName := Format('%s`%d', [AName, Length(ParamNames)]); + AMacroNames := AMacros.KeySet.First; + while AMacroNames.HasNext do + if JclStrings.StrSame(AMacroNames.Next, AMacroName) then + raise EPppState.CreateFmt('macro "%s" is already defined', [AName]); + AMacroFormat := Value; + AMacro := TJclStrArrayList.Create(16); + for Index := Low(ParamNames) to High(ParamNames) do + begin + StrReplace(AMacroFormat, ParamNames[Index], '%' + IntToStr(Index) + ':s', [rfReplaceAll, rfIgnoreCase]); + // the first elements in the list are the macro parameter names + AMacro.Add(ParamNames[Index]); + end; + // the macro text is the last element in the list + AMacro.Add(AMacroFormat); + AMacros.Items[AMacroName] := AMacro; +end; + +function TPppState.FindFile(const AName: string): TStream; +var + i: Integer; + fn: string; + Found: Boolean; + ASearchPath: IJclStrList; +begin + ASearchPath := InternalPeekSearchPath; + fn := AName; + Found := FileExists(fn); + if not Found then + for i := 0 to ASearchPath.Size - 1 do + begin + fn := ASearchPath.Strings[i] + PathDelim + AName; + if FileExists(fn) then + begin + Found := True; + Break; + end; + end; + if not Found then + raise EPppState.CreateFmt('File not found: %s', [AName]); + Result := TFileStream.Create(fn, fmOpenRead or fmShareDenyWrite); +end; + +function TPppState.FindMacro(const AMacroName: string): IJclStrList; +var + AMacros: IJclStrIntfMap; + AMacroNames: IJclStrIterator; +begin + AMacros := InternalPeekMacros; + AMacroNames := AMacros.KeySet.First; + while AMacroNames.HasNext do + begin + if JclStrings.StrSame(AMacroNames.Next, AMacroName) then + begin + Result := AMacros.Items[AMacroNames.GetString] as IJclStrList; + Exit; + end; + end; + raise EPppState.CreateFmt('unknown macro "%s"', [AMacroName]); +end; + +function TPppState.GetBoolValue(const Name: string): Boolean; +var + VariantValue: Variant; +begin + VariantValue := GetPropValue(Self, Name); + Result := Boolean(VariantValue); +end; + +function TPppState.GetIntegerValue(const Name: string): Integer; +var + VariantValue: Variant; +begin + VariantValue := GetPropValue(Self, Name); + Result := Integer(VariantValue); +end; + +function TPppState.GetStringValue(const Name: string): string; +var + VariantValue: Variant; +begin + VariantValue := GetPropValue(Self, Name, True); + Result := string(VariantValue); +end; + +function TPppState.GetOptions: TPppOptions; +begin + Result := FOptions; +end; + +function TPppState.GetDefine(const ASymbol: string): TTriState; +var + ADefines: IJclStrMap; + ASymbolNames: IJclStrIterator; + PI: PPropInfo; + PV: Variant; +begin + Result := ttUnknown; + ADefines := InternalPeekDefines; + ASymbolNames := ADefines.KeySet.First; + while ASymbolNames.HasNext do + begin + if JclStrings.StrSame(ASymbolNames.Next, ASymbol) then + begin + Result := TTriState(ADefines.Items[ASymbolNames.GetString]); + Break; + end; + end; + if Result = ttUnknown then + begin + PI := GetPropInfo(Self, ASymbol); + if Assigned(PI) then + begin + {$IFDEF COMPILER8_UP} + PV := GetPropValue(Self, PI); + {$ELSE ~COMPILER8_UP} + PV := GetPropValue(Self, PI^.Name); + {$ENDIF ~COMPILER8_UP} + if Boolean(PV) then + Result := ttDefined + else + Result := ttUndef; + end; + end; +end; + +function TPppState.InternalPeekDefines: IJclStrMap; +begin + Result := PeekStateItem.DefinedKeywords; +end; + +function TPppState.InternalPeekExcludedFiles: IJclStrList; +begin + Result := PeekStateItem.ExcludedFiles; +end; + +function TPppState.InternalPeekMacros: IJclStrIntfMap; +begin + Result := PeekStateItem.Macros; +end; + +function TPppState.InternalPeekSearchPath: IJclStrList; +begin + Result := PeekStateItem.SearchPath; +end; + +function TPppState.InternalPeekTriState: TTriState; +begin + Result := PeekStateItem.TriState; +end; + +procedure TPppState.InternalPushState(FromStateItem, ToStateItem: TPppStateItem); +begin + if Assigned(FromStateItem) then + begin + // clone + ToStateItem.DefinedKeywords := (FromStateItem.DefinedKeywords as IJclIntfCloneable).IntfClone as IJclStrMap; + ToStateItem.ExcludedFiles := (FromStateItem.ExcludedFiles as IJclIntfCloneable).IntfClone as IJclStrList; + ToStateItem.Macros := (FromStateItem.Macros as IJclIntfCloneable).IntfClone as IJclStrIntfMap; + ToStateItem.SearchPath := (FromStateItem.SearchPath as IJclIntfCloneable).IntfClone as IJclStrList; + ToStateItem.TriState := FromStateItem.TriState; + end + else + begin + // create the first item + ToStateItem.DefinedKeywords := TJclStrHashMap.Create(16, False); + ToStateItem.ExcludedFiles := TJclStrArrayList.Create(16); + ToStateItem.Macros := TJclStrIntfHashMap.Create(16); + ToStateItem.SearchPath := TJclStrArrayList.Create(16); + ToStateItem.TriState := ttDefined; + end; +end; + +procedure TPppState.InternalSetTriState(Value: TTriState); +var + APppStateItem: TPppStateItem; +begin + APppStateItem := PeekStateItem; + if APppStateItem.TriState <> ttUndef then + APppStateItem.TriState := Value; +end; + +function TPppState.IsFileExcluded(const AName: string): Boolean; +var + AExcludedFiles: IJclStrList; + AFileNames: IJclStrIterator; +begin + AExcludedFiles := InternalPeekExcludedFiles; + AFileNames := AExcludedFiles.First; + Result := False; + while AFileNames.HasNext do + begin + if JclStrings.StrSame(AFileNames.Next, AName) then + begin + Result := True; + Break; + end; + end; +end; + +function TPppState.PeekStateItem: TPppStateItem; +begin + if FStateStack.Empty then + raise EPppState.Create('Internal error: PPP State stack is empty'); + Result := FStateStack.Peek as TPppStateItem; +end; + +procedure TPppState.PopState; +begin + if FStateStack.Size <= 1 then + raise EPppState.Create('Internal error: PPP State stack underflow'); + FStateStack.Pop.Free; +end; + +procedure TPppState.PushState; +var + FromStateItem, ToStateItem: TPppStateItem; +begin + FromStateItem := PeekStateItem; + ToStateItem := StateItemClass.Create; + InternalPushState(FromStateItem, ToStateItem); + FStateStack.Push(ToStateItem); +end; + +procedure TPppState.SetOptions(AOptions: TPppOptions); +begin + FOptions := AOptions; +end; + +procedure TPppState.SetBoolValue(const Name: string; Value: Boolean); +var + VariantValue: Variant; +begin + VariantValue := Value; + SetPropValue(Self, Name, VariantValue); +end; + +procedure TPppState.SetDefine(const ASymbol: string; + const Value: TTriState); +var + ADefines: IJclStrMap; + ASymbolNames: IJclStrIterator; + PI: PPropInfo; +begin + ADefines := InternalPeekDefines; + ASymbolNames := ADefines.KeySet.First; + while ASymbolNames.HasNext do + begin + if JclStrings.StrSame(ASymbolNames.Next, ASymbol) then + begin + ADefines.Items[ASymbolNames.GetString] := TObject(Value); + Exit; + end; + end; + if Value <> ttUnknown then + begin + PI := GetPropInfo(Self, ASymbol); + if Assigned(PI) then + begin + if Value = ttDefined then + {$IFDEF COMPILER8_UP} + SetPropValue(Self, PI, True) + {$ELSE ~COMPILER8_UP} + SetPropValue(Self, PI^.Name, True) + {$ENDIF ~COMPILER8_UP} + else + {$IFDEF COMPILER8_UP} + SetPropValue(Self, PI, False); + {$ELSE ~COMPILER8_UP} + SetPropValue(Self, PI^.Name, False); + {$ENDIF ~COMPILER8_UP} + Exit; + end; + end; + ADefines.Items[ASymbol] := TObject(Value); +end; + +procedure TPppState.SetIntegerValue(const Name: string; Value: Integer); +var + VariantValue: Variant; +begin + VariantValue := Value; + SetPropValue(Self, Name, VariantValue); +end; + +procedure TPppState.SetStringValue(const Name, Value: string); +var + VariantValue: Variant; +begin + VariantValue := Value; + SetPropValue(Self, Name, VariantValue); +end; + +class function TPppState.StateItemClass: TPppStateItemClass; +begin + Result := TPppStateItem; +end; + +procedure TPppState.Undef(const ASymbol: string); +begin + Defines[ASymbol] := ttUndef; +end; + +procedure TPppState.UndefMacro(const AName: string; const ParamNames: TDynStringArray); +var + AMacros: IJclStrIntfMap; + AMacroNames: IJclStrIterator; + AMacroName: string; +begin + AMacros := InternalPeekMacros; + AMacroName := Format('%s`%d', [AName, Length(ParamNames)]); + AMacroNames := AMacros.KeySet.First; + while AMacroNames.HasNext do + if JclStrings.StrSame(AMacroNames.Next, AMacroName) then + AMacros.Remove(AMacroNames.GetString); +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclPreProcessorQueuesTemplates.pas b/3rdParty/JCL/source/common/JclPreProcessorQueuesTemplates.pas new file mode 100644 index 00000000..3a0031b2 --- /dev/null +++ b/3rdParty/JCL/source/common/JclPreProcessorQueuesTemplates.pas @@ -0,0 +1,147 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclQueuesTemplates.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. } +{ } +{ Contributors: } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclPreProcessorQueuesTemplates; + +interface + +{$I jcl.inc} + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclPreProcessorContainerTypes, + JclPreProcessorContainerTemplates, + JclPreProcessorContainer1DTemplates; + +type + (* JCLQUEUEINT(SELFCLASSNAME, QUEUEINTERFACENAME, ANCESTORCLASSNAME, DYNARRAYTYPENAME, + EQUALITYCOMPARERINTERFACENAME, INTERFACEADDITIONAL, SECTIONADDITIONAL, + OWNERSHIPDECLARATION, CONSTKEYWORD, PARAMETERNAME, TYPENAME) *) + TJclQueueIntParams = class(TJclClassInterfaceParams) + protected + // function CodeUnit: string; override; + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property SelfClassName: string index taQueueClassName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property BaseContainerInterfaceName: string index taContainerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property QueueInterfaceName: string index taQueueInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property AncestorClassName; + property DynArrayTypeName: string index taDynArrayTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property EqualityComparerInterfaceName: string index taEqualityComparerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property InterfaceAdditional; + property SectionAdditional; + property OwnershipDeclaration; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* JCLQUEUEIMP(SELFCLASSNAME, OWNERSHIPDECLARATION, OWNERSHIPPARAMETERNAME, MOVEARRAYPROCEDURENAME, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, RELEASERFUNCTIONNAME) *) + TJclQueueImpParams = class(TJclClassImplementationParams) + protected + // function CodeUnit: string; override; + public + function GetConstructorParameters: string; override; + function GetSelfClassName: string; override; + published + property SelfClassName: string index taQueueClassName read GetTypeAttribute write SetTypeAttribute stored False; + property OwnershipDeclaration; + property OwnershipParameterName: string index taOwnershipParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property MoveArrayProcedureName: string index taMoveArrayProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property DefaultValue: string index taDefaultValue read GetTypeAttribute write SetTypeAttribute stored False; + property ReleaserFunctionName: string index taReleaserFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property MacroFooter; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclStrings; + +procedure RegisterJclContainers; +begin + RegisterContainerParams('JCLQUEUEINT', TJclQueueIntParams); + RegisterContainerParams('JCLQUEUEIMP', TJclQueueImpParams, TJclQueueIntParams); +end; + +//=== { TJclQueueIntParams } ================================================= + +function TJclQueueIntParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taQueueClassName]; +end; + +//=== { TJclQueueImpParams } ================================================= + +function TJclQueueImpParams.GetConstructorParameters: string; +begin + Result := 'Size + 1'; +end; + +function TJclQueueImpParams.GetSelfClassName: string; +begin + Result := SelfClassName; +end; + +initialization + RegisterJclContainers; + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclPreProcessorSortedMapsTemplates.pas b/3rdParty/JCL/source/common/JclPreProcessorSortedMapsTemplates.pas new file mode 100644 index 00000000..a3715887 --- /dev/null +++ b/3rdParty/JCL/source/common/JclPreProcessorSortedMapsTemplates.pas @@ -0,0 +1,237 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclSortedMapsTemplates.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. } +{ } +{ Contributors: } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclPreProcessorSortedMapsTemplates; + +interface + +{$I jcl.inc} + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclPreProcessorContainerTypes, + JclPreProcessorContainerTemplates, + JclPreProcessorContainer2DTemplates; + +type + (* JCLSORTEDMAPTYPESINT(ENTRYTYPENAME, ENTRYARRAYTYPENAME, KEYTYPENAME, VALUETYPENAME) *) + TJclSortedMapTypeIntParams = class(TJclMapInterfaceParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property EntryTypeName: string index maSortedMapEntryTypeName read GetMapAttribute write SetMapAttribute stored IsMapAttributeStored; + property EntryArrayTypeName: string index maSortedMapEntryArrayTypeName read GetMapAttribute write SetMapAttribute stored IsMapAttributeStored; + property KeyTypeName: string index kaKeyTypeName read GetKeyAttribute write SetKeyAttribute stored False; + property ValueTypeName: string index vaValueTypeName read GetValueAttribute write SetValueAttribute stored False; + end; + + (* JCLSORTEDMAPINT(ENTRYTYPENAME, ENTRYARRAYTYPENAME, SELFCLASSNAME, ANCESTORNAME, + STDMAPINTERFACENAME, SORTEDMAPINTERFACENAME, + KEYSETINTERFACENAME, VALUECOLLECTIONINTERFACENAME, + INTERFACEADDITIONAL, SECTIONADDITIONAL, KEYOWNERSHIPDECLARATION, + VALUEOWNERSHIPDECLARATION, KEYCONSTKEYWORD, KEYTYPENAME, + VALUECONSTKEYWORD, VALUETYPENAME) *) + TJclSortedMapIntParams = class(TJclMapClassInterfaceParams) + protected + // function CodeUnit: string; override; + //function GetInterfaceAdditional: string; override; + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + function GetComparisonSectionAdditional: string; override; + published + property EntryTypeName: string index maSortedMapEntryTypeName read GetMapAttribute write SetMapAttribute stored False; + property EntryArrayTypeName: string index maSortedMapEntryArrayTypeName read GetMapAttribute write SetMapAttribute stored False; + property SelfClassName: string index maSortedMapClassName read GetMapAttribute write SetMapAttribute stored IsMapAttributeStored; + property AncestorName: string index maMapAncestorClassName read GetMapAttribute write SetMapAttribute stored False; + property StdMapInterfaceName: string index maMapInterfaceName read GetMapAttribute write SetMapAttribute stored False; + property SortedMapInterfaceName: string index maSortedMapInterfaceName read GetMapAttribute write SetMapAttribute stored False; + property KeySetInterfaceName: string index kaKeySetInterfaceName read GetKeyAttribute write SetKeyAttribute stored False; + property ValueCollectionInterfaceName: string index vaValueCollectionInterfaceName read GetValueAttribute write SetValueAttribute stored False; + property InterfaceAdditional; + property SectionAdditional; + property KeyOwnershipDeclaration; + property ValueOwnershipDeclaration; + property KeyConstKeyword: string index kaKeyConstKeyword read GetKeyAttribute write SetKeyAttribute stored False; + property KeyTypeName; + property ValueConstKeyword: string index vaValueConstKeyword read GetValueAttribute write SetValueAttribute stored False; + property ValueTypeName; + end; + + (* JCLSORTEDMAPIMP(ENTRYTYPENAME, ENTRYARRAYTYPENAME, SELFCLASSNAME, + STDMAPINTERFACENAME, SORTEDMAPINTERFACENAME, + KEYSETINTERFACENAME, KEYITRINTERFACENAME, + VALUECOLLECTIONINTERFACENAME, + KEYOWNERSHIPDECLARATION, VALUEOWNERSHIPDECLARATION, + OWNERSHIPASSIGNMENTS, KEYCONSTKEYWORD, KEYTYPENAME, KEYDEFAULT, + VALUECONSTKEYWORD, VALUETYPENAME, VALUEDEFAULT, + CREATEKEYSET, CREATEVALUECOLLECTION) *) + TJclSortedMapImpParams = class(TJclMapClassImplementationParams) + protected + // function CodeUnit: string; override; + public + function GetConstructorParameters: string; override; + function GetMacroFooter: string; override; + function GetSelfClassName: string; override; + published + property EntryTypeName: string index maSortedMapEntryTypeName read GetMapAttribute write SetMapAttribute stored False; + property EntryArrayTypeName: string index maSortedMapEntryArrayTypeName read GetMapAttribute write SetMapAttribute stored False; + property SelfClassName: string index maSortedMapClassName read GetMapAttribute write SetMapAttribute stored False; + property AncestorClassName: string index maMapAncestorClassName read GetMapAttribute write SetMapAttribute stored False; + property StdMapInterfaceName: string index maMapInterfaceName read GetMapAttribute write SetMapAttribute stored False; + property SortedMapInterfaceName: string index maSortedMapInterfaceName read GetMapAttribute write SetMapAttribute stored False; + property KeySetInterfaceName: string index kaKeySetInterfaceName read GetKeyAttribute write SetKeyAttribute stored False; + property KeyItrInterfaceName: string index kaKeyIteratorInterfaceName read GetKeyAttribute write SetKeyAttribute stored False; + property ValueCollectionInterfaceName: string index vaValueCollectionInterfaceName read GetValueAttribute write SetValueAttribute stored False; + property KeyOwnershipDeclaration; + property ValueOwnershipDeclaration; + property OwnershipAssignments; + property KeyConstKeyword: string index kaKeyConstKeyword read GetKeyAttribute write SetKeyAttribute stored False; + property KeyTypeName; + property KeyDefault; + property KeySimpleCompareFunctionName: string index kaKeySimpleCompareFunctionName read GetKeyAttribute write SetKeyAttribute stored False; + property KeyBaseContainer: string index kaKeyBaseContainerClassName read GetKeyAttribute write SetKeyAttribute stored False; + property ValueConstKeyword: string index vaValueConstKeyword read GetValueAttribute write SetValueAttribute stored False; + property ValueTypeName; + property ValueDefault; + property ValueSimpleCompareFunctionName: string index vaValueSimpleCompareFunctionName read GetValueAttribute write SetValueAttribute stored False; + property ValueBaseContainerClassName: string index vaValueBaseContainerClassName read GetValueAttribute write SetValueAttribute stored False; + property CreateKeySet; + property CreateValueCollection; + property MacroFooter; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclStrings; + +procedure RegisterJclContainers; +begin + RegisterContainerParams('JCLSORTEDMAPTYPESINT', TJclSortedMapTypeIntParams); + RegisterContainerParams('JCLSORTEDMAPINT', TJclSortedMapIntParams); + RegisterContainerParams('JCLSORTEDMAPIMP', TJclSortedMapImpParams, TJclSortedMapIntParams); +end; + +//=== { TJclSortedMapTypeIntParams } ========================================= + +function TJclSortedMapTypeIntParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [maSortedMapEntryTypeName]; +end; + +//=== { TJclSortedMapIntParams } ============================================= + +function TJclSortedMapIntParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [maSortedMapClassName]; +end; + +function TJclSortedMapIntParams.GetComparisonSectionAdditional: string; +begin + Result := Format(' function KeysCompare(%sA, B: %s): Integer;' + NativeLineBreak + + ' function ValuesCompare(%sA, B: %s): Integer;', + [KeyConstKeyword, KeyTypeName, ValueConstKeyword, ValueTypeName]); +end; + +//=== { TJclSortedMapImpParams } ============================================= + +function TJclSortedMapImpParams.GetConstructorParameters: string; +begin + Result := 'FSize'; +end; + +function TJclSortedMapImpParams.GetMacroFooter: string; +var + FuncName: string; +begin + Result := inherited GetMacroFooter; + if (FMacroFooter = '') and MapInfo.KnownMap then + begin + if AncestorClassName = KeyBaseContainer then + FuncName := 'ItemsCompare' + else + FuncName := KeySimpleCompareFunctionName; + + Result := Format('%s' + NativeLineBreak + + 'function %s.KeysCompare(%sA, B: %s): Integer;' + NativeLineBreak + + 'begin' + NativeLineBreak + + ' Result := %s(A, B);' + NativeLineBreak + + 'end;' + NativeLineBreak, + [Result, SelfClassName, KeyConstKeyword, KeyTypeName, FuncName]); + + if AncestorClassName = ValueBaseContainerClassName then + FuncName := 'ItemsCompare' + else + FuncName := ValueSimpleCompareFunctionName; + + Result := Format('%s' + NativeLineBreak + + 'function %s.ValuesCompare(%sA, B: %s): Integer;' + NativeLineBreak + + 'begin' + NativeLineBreak + + ' Result := %s(A, B);' + NativeLineBreak + + 'end;' + NativeLineBreak, + [Result, SelfClassName, ValueConstKeyword, ValueTypeName, FuncName]); + end; +end; + +function TJclSortedMapImpParams.GetSelfClassName: string; +begin + Result := SelfClassName; +end; + +initialization + RegisterJclContainers; + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclPreProcessorStacksTemplates.pas b/3rdParty/JCL/source/common/JclPreProcessorStacksTemplates.pas new file mode 100644 index 00000000..d0ad0ae5 --- /dev/null +++ b/3rdParty/JCL/source/common/JclPreProcessorStacksTemplates.pas @@ -0,0 +1,146 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclStacksTemplates.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. } +{ } +{ Contributors: } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclPreProcessorStacksTemplates; + +interface + +{$I jcl.inc} + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclPreProcessorContainerTypes, + JclPreProcessorContainerTemplates, + JclPreProcessorContainer1DTemplates; + +type + (* JCLSTACKINT(SELFCLASSNAME, BASECONTAINERINTERFACENAME, STACKINTERFACENAME, ANCESTORCLASSNAME, DYNARRAYTYPENAME, + EQUALITYCOMPARERINTERFACENAME, INTERFACEADDITIONAL, SECTIONADDITIONAL, + OWNERSHIPDECLARATION, CONSTKEYWORD, PARAMETERNAME, TYPENAME) *) + TJclStackIntParams = class(TJclClassInterfaceParams) + protected + // function CodeUnit: string; override; + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property SelfClassName: string index taStackClassName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property BaseContainerInterfaceName: string index taContainerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property StackInterfaceName: string index taStackInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property EqualityComparerInterfaceName: string index taEqualityComparerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property AncestorClassName; + property DynArrayTypeName: string index taDynArrayTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property InterfaceAdditional; + property SectionAdditional; + property OwnershipDeclaration; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* JCLSTACKIMP(SELFCLASSNAME, OWNERSHIPDECLARATION, OWNERSHIPPARAMETERNAME, CONSTKEYWORD, + PARAMETERNAME, TYPENAME, DEFAULTVALUE, RELEASERFUNCTIONNAME) *) + TJclStackImpParams = class(TJclClassImplementationParams) + protected + // function CodeUnit: string; override; + public + function GetConstructorParameters: string; override; + function GetSelfClassName: string; override; + published + property SelfClassName: string index taStackClassName read GetTypeAttribute write SetTypeAttribute stored False; + property OwnershipDeclaration; + property OwnershipParameterName: string index taOwnershipParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property DefaultValue: string index taDefaultValue read GetTypeAttribute write SetTypeAttribute stored False; + property ReleaserFunctionName: string index taReleaserFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property MacroFooter; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclStrings; + +procedure RegisterJclContainers; +begin + RegisterContainerParams('JCLSTACKINT', TJclStackIntParams); + RegisterContainerParams('JCLSTACKIMP', TJclStackImpParams, TJclStackIntParams); +end; + +//=== { TJclStackIntParams } ================================================= + +function TJclStackIntParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taStackClassName]; +end; + +//=== { TJclStackImpParams } ================================================= + +function TJclStackImpParams.GetConstructorParameters: string; +begin + Result := 'FSize'; +end; + +function TJclStackImpParams.GetSelfClassName: string; +begin + Result := SelfClassName; +end; + +initialization + RegisterJclContainers; + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclPreProcessorTemplates.pas b/3rdParty/JCL/source/common/JclPreProcessorTemplates.pas new file mode 100644 index 00000000..ed258568 --- /dev/null +++ b/3rdParty/JCL/source/common/JclPreProcessorTemplates.pas @@ -0,0 +1,145 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclOtaTemplates.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. } +{ } +{ Contributors: } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclPreProcessorTemplates; + +interface + +{$I jcl.inc} + +uses + {$IFDEF HAS_UNITSCOPE} + System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Classes, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclPreProcessorParser; + +type + TJclTemplateParams = class(TPppState) + public + constructor Create; + end; + +const + ModulePattern = '%MODULENAME%'; + FormPattern = '%FORMNAME%'; + AncestorPattern = '%ANCESTORNAME%'; + +function GetFinalFormContent(const Content, FormIdent, + AncestorIdent: string): string; +function GetFinalHeaderContent(const Content, ModuleIdent, FormIdent, + AncestorIdent: string): string; +function GetFinalSourceContent(const Content, ModuleIdent, FormIdent, + AncestorIdent: string): string; + +function ApplyTemplate(const Template: string; const Params: TJclTemplateParams): string; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + System.TypInfo, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + TypInfo, + {$ENDIF ~HAS_UNITSCOPE} + JclStrings, JclSysUtils; + +//=== { TJclTemplateParams } ================================================= + +constructor TJclTemplateParams.Create; +begin + inherited Create; + Options := Options + [poProcessDefines, poProcessMacros, poProcessValues]; +end; + +function GetFinalFormContent(const Content, FormIdent, + AncestorIdent: string): string; +begin + Result := StringReplace(Content, FormPattern, FormIdent, [rfReplaceAll, rfIgnoreCase]); + Result := StringReplace(Result, AncestorPattern, AncestorIdent, [rfReplaceAll, rfIgnoreCase]); +end; + +function GetFinalHeaderContent(const Content, ModuleIdent, FormIdent, + AncestorIdent: string): string; +begin + Result := StringReplace(Content, FormPattern, FormIdent, [rfReplaceAll, rfIgnoreCase]); + Result := StringReplace(Result, AncestorPattern, AncestorIdent, [rfReplaceAll, rfIgnoreCase]); + Result := StringReplace(Result, ModulePattern, ModuleIdent, [rfReplaceAll, rfIgnoreCase]); +end; + +function GetFinalSourceContent(const Content, ModuleIdent, FormIdent, AncestorIdent: string): string; +begin + Result := StringReplace(Content, FormPattern, FormIdent, [rfReplaceAll, rfIgnoreCase]); + Result := StringReplace(Result, AncestorPattern, AncestorIdent, [rfReplaceAll, rfIgnoreCase]); + Result := StringReplace(Result, ModulePattern, ModuleIdent, [rfReplaceAll, rfIgnoreCase]); +end; + +function ApplyTemplate(const Template: string; const Params: TJclTemplateParams): string; +var + JppParser: TJppParser; +begin + Params.PushState; + try + JppParser := TJppParser.Create(Template, Params); + try + Result := JppParser.Parse; + finally + JppParser.Free; + end; + finally + Params.PopState; + end; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclPreProcessorTreesTemplates.pas b/3rdParty/JCL/source/common/JclPreProcessorTreesTemplates.pas new file mode 100644 index 00000000..c3a91644 --- /dev/null +++ b/3rdParty/JCL/source/common/JclPreProcessorTreesTemplates.pas @@ -0,0 +1,264 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclTreesTemplates.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. } +{ } +{ Contributors: } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclPreProcessorTreesTemplates; + +interface + +{$I jcl.inc} + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclPreProcessorContainerTypes, + JclPreProcessorContainerTemplates, + JclPreProcessorContainer1DTemplates; + +type + (* JCLTREETYPESINT(NODETYPENAME, EQUALITYCOMPARERINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME) *) + TJclTreeTypeIntParams = class(TJclContainerInterfaceParams) + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property NodeTypeName: string index taTreeNodeClassName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property EqualityComparerInterfaceName: string index taEqualityComparerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* JCLTREEINT(NODETYPENAME, SELFCLASSNAME, ANCESTORCLASSNAME, + BASECONTAINERINTERFACENAME, FLATCONTAINERINTERFACENAME, EQUALITYCOMPARERINTERFACENAME, + COLLECTIONINTERFACENAME, TREEINTERFACENAME, STDITRINTERFACENAME, TREEITRINTERFACENAME, + INTERFACEADDITIONAL, SECTIONADDITIONAL, COLLECTIONFLAGS, OWNERSHIPDECLARATION, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE) *) + TJclTreeIntParams = class(TJclCollectionInterfaceParams) + protected + // function CodeUnit: string; override; + function GetOwnershipDeclaration: string; override; + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property NodeTypeName: string index taTreeNodeClassName read GetTypeAttribute write SetTypeAttribute stored False; + property SelfClassName: string index taTreeClassName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property AncestorClassName; + property BaseContainerInterfaceName: string index taContainerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property FlatContainerInterfaceName: string index taFlatContainerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property EqualityComparerInterfaceName: string index taEqualityComparerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property CollectionInterfaceName: string index taCollectionInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property TreeInterfaceName: string index taTreeInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property StdItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property TreeItrInterfaceName: string index taTreeIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property InterfaceAdditional; + property SectionAdditional; + property OwnershipDeclaration; + property CollectionFlags; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property DefaultValue: string index taDefaultValue read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* JCLTREEITRINT(BASEITRCLASSNAME, PREORDERITRCLASSNAME, POSTORDERITRCLASSNAME, NODETYPENAME, + TREECLASSNAME, STDITRINTERFACENAME, TREEITRINTERFACENAME, EQUALITYCOMPARERINTERFACENAME, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) *) + TJclTreeItrIntParams = class(TJclContainerInterfaceParams) + protected + // function CodeUnit: string; override; + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property BaseItrClassName: string index taTreeBaseIteratorClassName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property PreOrderItrClassName: string index taTreePreOrderIteratorClassName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property PostOrderItrClassName: string index taTreePostOrderIteratorClassName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property NodeTypeName: string index taTreeNodeClassName read GetTypeAttribute write SetTypeAttribute stored False; + property TreeClassName: string index taTreeClassName read GetTypeAttribute write SetTypeAttribute stored False; + property StdItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property TreeItrInterfaceName: string index taTreeIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property EqualityComparerInterfaceName: string index taEqualityComparerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property DefaultValue: string index taDefaultValue read GetTypeAttribute write SetTypeAttribute stored False; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* JCLTREETYPESIMP(NODETYPENAME, EQUALITYCOMPARERINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME) *) + TJclTreeTypeImpParams = class(TJclContainerImplementationParams) + published + property NodeTypeName: string index taTreeNodeClassName read GetTypeAttribute write SetTypeAttribute stored False; + property EqualityComparerInterfaceName: string index taEqualityComparerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* JCLTREEIMP(NODETYPENAME, SELFCLASSNAME, PREORDERITRCLASSNAME, POSTORDERITRCLASSNAME, + COLLECTIONINTERFACENAME, STDITRINTERFACENAME, TREEITRINTERFACENAME, + EQUALITYCOMPARERINTERFACENAME, OWNERSHIPDECLARATION, OWNERSHIPPARAMETERNAME, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, RELEASERFUNCTIONNAME) *) + TJclTreeImpParams = class(TJclCollectionImplementationParams) + protected + // function CodeUnit: string; override; + function GetConstructorParameters: string; override; + function GetSelfClassName: string; override; + function GetOwnershipDeclaration: string; override; + published + property SelfClassName: string index taTreeClassName read GetTypeAttribute write SetTypeAttribute stored False; + property NodeTypeName: string index taTreeNodeClassName read GetTypeAttribute write SetTypeAttribute stored False; + property PreOrderItrClassName: string index taTreePreOrderIteratorClassName read GetTypeAttribute write SetTypeAttribute stored False; + property PostOrderItrClassName: string index taTreePostOrderIteratorClassName read GetTypeAttribute write SetTypeAttribute stored False; + property CollectionInterfaceName: string index taCollectionInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property StdItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property TreeItrInterfaceName: string index taTreeIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property EqualityComparerInterfaceName: string index taEqualityComparerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property OwnershipDeclaration; + property OwnershipParameterName: string index taOwnershipParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property DefaultValue: string index taDefaultValue read GetTypeAttribute write SetTypeAttribute stored False; + property ReleaserFunctionName: string index taReleaserFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property MacroFooter; + end; + + (* JCLTREEITRIMP(BASEITRCLASSNAME, PREORDERITRCLASSNAME, POSTORDERITRCLASSNAME, NODETYPENAME, TREECLASSNAME, + STDITRINTERFACENAME, TREEITRINTERFACENAME, EQUALITYCOMPARERINTERFACENAME, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, GETTERFUNCTIONNAME, SETTERPROCEDURENAME, RELEASERFUNCTIONNAME) *) + TJclTreeItrImpParams = class(TJclContainerImplementationParams) + protected + // function CodeUnit: string; override; + published + property BaseItrClassName: string index taTreeBaseIteratorClassName read GetTypeAttribute write SetTypeAttribute stored False; + property PreOrderItrClassName: string index taTreePreOrderIteratorClassName read GetTypeAttribute write SetTypeAttribute stored False; + property PostOrderItrClassName: string index taTreePostOrderIteratorClassName read GetTypeAttribute write SetTypeAttribute stored False; + property NodeTypeName: string index taTreeNodeClassName read GetTypeAttribute write SetTypeAttribute stored False; + property TreeClassName: string index taTreeClassName read GetTypeAttribute write SetTypeAttribute stored False; + property StdItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property TreeItrInterfaceName: string index taTreeIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property EqualityComparerInterfaceName: string index taEqualityComparerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property DefaultValue: string index taDefaultValue read GetTypeAttribute write SetTypeAttribute stored False; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + property ReleaserFunctionName: string index taReleaserFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclStrings; + +procedure RegisterJclContainers; +begin + RegisterContainerParams('JCLTREETYPESINT', TJclTreeTypeIntParams); + RegisterContainerParams('JCLTREETYPESIMP', TJclTreeTypeImpParams, TJclTreeTypeIntParams); + RegisterContainerParams('JCLTREEINT', TJclTreeIntParams); + RegisterContainerParams('JCLTREEITRINT', TJclTreeItrIntParams); + RegisterContainerParams('JCLTREEIMP', TJclTreeImpParams, TJclTreeIntParams); + RegisterContainerParams('JCLTREEITRIMP', TJclTreeItrImpParams, TJclTreeItrIntParams); +end; + +//=== { TJclTreeTypeIntParams } ============================================== + +function TJclTreeTypeIntParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taTreeNodeClassName]; +end; + +//=== { TJclTreeIntParams } ================================================== + +function TJclTreeIntParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taTreeClassName]; +end; + +function TJclTreeIntParams.GetOwnershipDeclaration: string; +begin + Result := TypeInfo.OwnershipDeclaration; +end; + +//=== { TJclTreeItrIntParams } =============================================== + +function TJclTreeItrIntParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taTreeBaseIteratorClassName, taTreePreOrderIteratorClassName, + taTreePostOrderIteratorClassName]; +end; + +//=== { TJclTreeImpParams } ================================================== + +function TJclTreeImpParams.GetConstructorParameters: string; +begin + Result := ''; +end; + +function TJclTreeImpParams.GetOwnershipDeclaration: string; +begin + Result := TypeInfo.OwnershipDeclaration; +end; + +function TJclTreeImpParams.GetSelfClassName: string; +begin + Result := SelfClassName; +end; + +initialization + RegisterJclContainers; + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclPreProcessorVectorsTemplates.pas b/3rdParty/JCL/source/common/JclPreProcessorVectorsTemplates.pas new file mode 100644 index 00000000..31ee273b --- /dev/null +++ b/3rdParty/JCL/source/common/JclPreProcessorVectorsTemplates.pas @@ -0,0 +1,207 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclVectorsTemplates.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. } +{ } +{ Contributors: } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclPreProcessorVectorsTemplates; + +interface + +{$I jcl.inc} + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclPreProcessorContainerTypes, + JclPreProcessorContainerTemplates, + JclPreProcessorContainer1DTemplates; + +type + (* JCLVECTORINT(SELFCLASSNAME, ANCESTORCLASSNAME, BASECONTAINERINTERFACENAME, + FLATCONTAINERINTERFACENAME, COLLECTIONINTERFACENAME, LISTINTERFACENAME, + ARRAYINTERFACENAME, ITRINTERFACENAME, EQUALITYCOMPARERINTERFACENAME, + INTERFACEADDITIONAL, SECTIONADDITIONAL, COLLECTIONFLAGS, OWNERSHIPDECLARATION, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, DYNARRAYTYPE, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) *) + TJclVectorIntParams = class(TJclCollectionInterfaceParams) + protected + // function CodeUnit: string; override; + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property SelfClassName: string index taVectorClassName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property AncestorClassName; + property BaseContainerInterfaceName: string index taContainerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property FlatContainerInterfaceName: string index taFlatContainerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property CollectionInterfaceName: string index taCollectionInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property EqualityComparerInterfaceName: string index taEqualityComparerInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ListInterfaceName: string index taListInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ArrayInterfaceName: string index taArrayInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property InterfaceAdditional; + property SectionAdditional; + property CollectionFlags; + property OwnershipDeclaration; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property DynArrayType: string index taDynArrayTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* JCLVECTORITRINT(SELFCLASSNAME, ITRINTERFACENAME, LISTCLASSNAME, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) *) + TJclVectorItrIntParams = class(TJclContainerInterfaceParams) + protected + // function CodeUnit: string; override; + public + function AliasAttributeIDs: TAllTypeAttributeIDs; override; + published + property SelfClassName: string index taVectorIteratorClassName read GetTypeAttribute write SetTypeAttribute stored IsTypeAttributeStored; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ListClassName: string index taVectorClassName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + end; + + (* JCLVECTORIMP(SELFCLASSNAME, COLLECTIONINTERFACENAME, LISTINTERFACENAME, ITRINTERFACENAME, + ITRCLASSNAME, OWNERSHIPDECLARATION, OWNERSHIPPARAMETERNAME, MOVEARRAYPROCEDURENAME, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, + GETTERFUNCTIONNAME, SETTERPROCEDURENAME, RELEASERFUNCTIONNAME) *) + TJclVectorImpParams = class(TJclCollectionImplementationParams) + protected + // function CodeUnit: string; override; + public + function GetConstructorParameters: string; override; + function GetSelfClassName: string; override; + published + property SelfClassName: string index taVectorClassName read GetTypeAttribute write SetTypeAttribute stored False; + property CollectionInterfaceName: string index taCollectionInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ListInterfaceName: string index taListInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrClassName: string index taVectorIteratorClassName read GetTypeAttribute write SetTypeAttribute stored False; + property OwnershipDeclaration; + property OwnershipParameterName: string index taOwnershipParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property MoveArrayProcedureName: string index taMoveArrayProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property DefaultValue: string index taDefaultValue read GetTypeAttribute write SetTypeAttribute stored False; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + property ReleaserFunctionName: string index taReleaserFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property MacroFooter; + end; + + (* JCLVECTORITRIMP(SELFCLASSNAME, ITRINTERFACENAME, LISTCLASSNAME, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) *) + TJclVectorItrImpParams = class(TJclContainerImplementationParams) + protected + // function CodeUnit: string; override; + published + property SelfClassName: string index taVectorIteratorClassName read GetTypeAttribute write SetTypeAttribute stored False; + property ItrInterfaceName: string index taIteratorInterfaceName read GetTypeAttribute write SetTypeAttribute stored False; + property ListClassName: string index taVectorClassName read GetTypeAttribute write SetTypeAttribute stored False; + property ConstKeyword: string index taConstKeyword read GetTypeAttribute write SetTypeAttribute stored False; + property ParameterName: string index taParameterName read GetTypeAttribute write SetTypeAttribute stored False; + property TypeName: string index taTypeName read GetTypeAttribute write SetTypeAttribute stored False; + property GetterFunctionName: string index taGetterFunctionName read GetTypeAttribute write SetTypeAttribute stored False; + property SetterProcedureName: string index taSetterProcedureName read GetTypeAttribute write SetTypeAttribute stored False; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclStrings; + +procedure RegisterJclContainers; +begin + RegisterContainerParams('JCLVECTORINT', TJclVectorIntParams); + RegisterContainerParams('JCLVECTORITRINT', TJclVectorItrIntParams); + RegisterContainerParams('JCLVECTORIMP', TJclVectorImpParams, TJclVectorIntParams); + RegisterContainerParams('JCLVECTORITRIMP', TJclVectorItrImpParams, TJclVectorItrIntParams); +end; + +//=== { TJclVectorIntParams } ================================================ + +function TJclVectorIntParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taVectorClassName]; +end; + +//=== { TJclVectorItrIntParams } ============================================= + +function TJclVectorItrIntParams.AliasAttributeIDs: TAllTypeAttributeIDs; +begin + Result := [taVectorIteratorClassName]; +end; + +//=== { TJclVectorImpParams } ================================================ + +function TJclVectorImpParams.GetConstructorParameters: string; +begin + Result := 'FSize'; +end; + +function TJclVectorImpParams.GetSelfClassName: string; +begin + Result := SelfClassName; +end; + +initialization + RegisterJclContainers; + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclQueues.pas b/3rdParty/JCL/source/common/JclQueues.pas new file mode 100644 index 00000000..ce7c3dc4 --- /dev/null +++ b/3rdParty/JCL/source/common/JclQueues.pas @@ -0,0 +1,4722 @@ +{**************************************************************************************************} +{ WARNING: JEDI preprocessor generated unit. Do not edit. } +{**************************************************************************************************} + +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is Queue.pas. } +{ } +{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } +{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } +{ All rights reserved. } +{ } +{ Contributors: } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclQueues; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclAlgorithms, + JclBase, JclAbstractContainers, JclContainerIntf, JclSynch; + + +type + TJclIntfQueue = class(TJclIntfAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclIntfContainer, IJclIntfEqualityComparer, + IJclIntfQueue) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElements: TDynIInterfaceArray; + FHead: Integer; + FTail: Integer; + protected + procedure AutoGrow; override; + procedure AutoPack; override; + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + { IJclGrowable } + procedure Grow; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclIntfQueue } + procedure Clear; + function Contains(const AInterface: IInterface): Boolean; + function Dequeue: IInterface; + function Empty: Boolean; + function Enqueue(const AInterface: IInterface): Boolean; + function Peek: IInterface; + function Size: Integer; + end; + + TJclAnsiStrQueue = class(TJclAnsiStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclAnsiStrContainer, IJclAnsiStrEqualityComparer, IJclStrBaseContainer, + IJclAnsiStrQueue) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElements: TDynAnsiStringArray; + FHead: Integer; + FTail: Integer; + protected + procedure AutoGrow; override; + procedure AutoPack; override; + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + { IJclGrowable } + procedure Grow; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclAnsiStrQueue } + procedure Clear; + function Contains(const AString: AnsiString): Boolean; + function Dequeue: AnsiString; + function Empty: Boolean; + function Enqueue(const AString: AnsiString): Boolean; + function Peek: AnsiString; + function Size: Integer; + end; + + TJclWideStrQueue = class(TJclWideStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclWideStrContainer, IJclWideStrEqualityComparer, IJclStrBaseContainer, + IJclWideStrQueue) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElements: TDynWideStringArray; + FHead: Integer; + FTail: Integer; + protected + procedure AutoGrow; override; + procedure AutoPack; override; + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + { IJclGrowable } + procedure Grow; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclWideStrQueue } + procedure Clear; + function Contains(const AString: WideString): Boolean; + function Dequeue: WideString; + function Empty: Boolean; + function Enqueue(const AString: WideString): Boolean; + function Peek: WideString; + function Size: Integer; + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclUnicodeStrQueue = class(TJclUnicodeStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclUnicodeStrContainer, IJclUnicodeStrEqualityComparer, IJclStrBaseContainer, + IJclUnicodeStrQueue) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElements: TDynUnicodeStringArray; + FHead: Integer; + FTail: Integer; + protected + procedure AutoGrow; override; + procedure AutoPack; override; + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + { IJclGrowable } + procedure Grow; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclUnicodeStrQueue } + procedure Clear; + function Contains(const AString: UnicodeString): Boolean; + function Dequeue: UnicodeString; + function Empty: Boolean; + function Enqueue(const AString: UnicodeString): Boolean; + function Peek: UnicodeString; + function Size: Integer; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + TJclStrQueue = TJclAnsiStrQueue; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TJclStrQueue = TJclWideStrQueue; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TJclStrQueue = TJclUnicodeStrQueue; + {$ENDIF CONTAINER_UNICODESTR} + + TJclSingleQueue = class(TJclSingleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclSingleContainer, IJclSingleEqualityComparer, + IJclSingleQueue) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElements: TDynSingleArray; + FHead: Integer; + FTail: Integer; + protected + procedure AutoGrow; override; + procedure AutoPack; override; + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + { IJclGrowable } + procedure Grow; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclSingleQueue } + procedure Clear; + function Contains(const AValue: Single): Boolean; + function Dequeue: Single; + function Empty: Boolean; + function Enqueue(const AValue: Single): Boolean; + function Peek: Single; + function Size: Integer; + end; + + TJclDoubleQueue = class(TJclDoubleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclDoubleContainer, IJclDoubleEqualityComparer, + IJclDoubleQueue) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElements: TDynDoubleArray; + FHead: Integer; + FTail: Integer; + protected + procedure AutoGrow; override; + procedure AutoPack; override; + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + { IJclGrowable } + procedure Grow; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclDoubleQueue } + procedure Clear; + function Contains(const AValue: Double): Boolean; + function Dequeue: Double; + function Empty: Boolean; + function Enqueue(const AValue: Double): Boolean; + function Peek: Double; + function Size: Integer; + end; + + TJclExtendedQueue = class(TJclExtendedAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclExtendedContainer, IJclExtendedEqualityComparer, + IJclExtendedQueue) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElements: TDynExtendedArray; + FHead: Integer; + FTail: Integer; + protected + procedure AutoGrow; override; + procedure AutoPack; override; + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + { IJclGrowable } + procedure Grow; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclExtendedQueue } + procedure Clear; + function Contains(const AValue: Extended): Boolean; + function Dequeue: Extended; + function Empty: Boolean; + function Enqueue(const AValue: Extended): Boolean; + function Peek: Extended; + function Size: Integer; + end; + + {$IFDEF MATH_SINGLE_PRECISION} + TJclFloatQueue = TJclSingleQueue; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TJclFloatQueue = TJclDoubleQueue; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TJclFloatQueue = TJclExtendedQueue; + {$ENDIF MATH_EXTENDED_PRECISION} + + TJclIntegerQueue = class(TJclIntegerAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclIntegerContainer, IJclIntegerEqualityComparer, + IJclIntegerQueue) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElements: TDynIntegerArray; + FHead: Integer; + FTail: Integer; + protected + procedure AutoGrow; override; + procedure AutoPack; override; + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + { IJclGrowable } + procedure Grow; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclIntegerQueue } + procedure Clear; + function Contains(AValue: Integer): Boolean; + function Dequeue: Integer; + function Empty: Boolean; + function Enqueue(AValue: Integer): Boolean; + function Peek: Integer; + function Size: Integer; + end; + + TJclCardinalQueue = class(TJclCardinalAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclCardinalContainer, IJclCardinalEqualityComparer, + IJclCardinalQueue) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElements: TDynCardinalArray; + FHead: Integer; + FTail: Integer; + protected + procedure AutoGrow; override; + procedure AutoPack; override; + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + { IJclGrowable } + procedure Grow; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclCardinalQueue } + procedure Clear; + function Contains(AValue: Cardinal): Boolean; + function Dequeue: Cardinal; + function Empty: Boolean; + function Enqueue(AValue: Cardinal): Boolean; + function Peek: Cardinal; + function Size: Integer; + end; + + TJclInt64Queue = class(TJclInt64AbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclInt64Container, IJclInt64EqualityComparer, + IJclInt64Queue) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElements: TDynInt64Array; + FHead: Integer; + FTail: Integer; + protected + procedure AutoGrow; override; + procedure AutoPack; override; + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + { IJclGrowable } + procedure Grow; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclInt64Queue } + procedure Clear; + function Contains(const AValue: Int64): Boolean; + function Dequeue: Int64; + function Empty: Boolean; + function Enqueue(const AValue: Int64): Boolean; + function Peek: Int64; + function Size: Integer; + end; + + TJclPtrQueue = class(TJclPtrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclPtrContainer, IJclPtrEqualityComparer, + IJclPtrQueue) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElements: TDynPointerArray; + FHead: Integer; + FTail: Integer; + protected + procedure AutoGrow; override; + procedure AutoPack; override; + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + { IJclGrowable } + procedure Grow; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclPtrQueue } + procedure Clear; + function Contains(APtr: Pointer): Boolean; + function Dequeue: Pointer; + function Empty: Boolean; + function Enqueue(APtr: Pointer): Boolean; + function Peek: Pointer; + function Size: Integer; + end; + + TJclQueue = class(TJclAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclContainer, IJclEqualityComparer, IJclObjectOwner, + IJclQueue) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElements: TDynObjectArray; + FHead: Integer; + FTail: Integer; + protected + procedure AutoGrow; override; + procedure AutoPack; override; + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer; AOwnsObjects: Boolean); + destructor Destroy; override; + { IJclGrowable } + procedure Grow; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclQueue } + procedure Clear; + function Contains(AObject: TObject): Boolean; + function Dequeue: TObject; + function Empty: Boolean; + function Enqueue(AObject: TObject): Boolean; + function Peek: TObject; + function Size: Integer; + end; + + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + + TJclQueue = class(TJclAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclContainer, IJclEqualityComparer, IJclItemOwner, + IJclQueue) + protected + type + TDynArray = array of T; + procedure MoveArray(var List: TDynArray; FromIndex, ToIndex, Count: SizeInt); + private + FElements: TDynArray; + FHead: Integer; + FTail: Integer; + protected + procedure AutoGrow; override; + procedure AutoPack; override; + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer; AOwnsItems: Boolean); + destructor Destroy; override; + { IJclGrowable } + procedure Grow; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclQueue } + procedure Clear; + function Contains(const AItem: T): Boolean; + function Dequeue: T; + function Empty: Boolean; + function Enqueue(const AItem: T): Boolean; + function Peek: T; + function Size: Integer; + end; + + // E = external helper to compare items for equality (GetHashCode is not used) + TJclQueueE = class(TJclQueue, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, IJclQueue, IJclItemOwner) + private + FEqualityComparer: IEqualityComparer; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AEqualityComparer: IEqualityComparer; ACapacity: Integer; AOwnsItems: Boolean); + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + property EqualityComparer: IEqualityComparer read FEqualityComparer write FEqualityComparer; + end; + + // F = function to compare items for equality + TJclQueueF = class(TJclQueue, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, IJclQueue, IJclItemOwner) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(AEqualityCompare: TEqualityCompare; ACapacity: Integer; AOwnsItems: Boolean); + end; + + // I = items can compare themselves to an other + TJclQueueI> = class(TJclQueue, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, IJclQueue, IJclItemOwner) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +{$IFDEF BCB} +{$IFDEF WIN64} + {$HPPEMIT '#ifdef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #undef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #define JclQueues_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT '#endif'} + + {$HPPEMIT END '#ifdef JclQueues_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #define MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #undef JclQueues_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END '#endif'} +{$ENDIF WIN64} +{$ENDIF BCB} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +//=== { TJclIntfQueue } ======================================================= + +constructor TJclIntfQueue.Create(ACapacity: Integer); +begin + inherited Create(); + FHead := 0; + FTail := 0; + SetCapacity(ACapacity); +end; + +destructor TJclIntfQueue.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfQueue.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclIntfQueue; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntfQueue then + begin + ADest := TJclIntfQueue(Dest); + ADest.Clear; + ADest.SetCapacity(Size + 1); + I := FHead; + while I <> FTail do + begin + ADest.Enqueue(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + end; +end; + +procedure TJclIntfQueue.AutoGrow; +begin + SetCapacity(CalcGrowCapacity(FCapacity, Size + 1)); +end; + +procedure TJclIntfQueue.AutoPack; +begin + SetCapacity(CalcPackCapacity(FCapacity, Size + 1)); +end; + +procedure TJclIntfQueue.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + I := FHead; + while I <> FTail do + begin + FreeObject(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + FHead := 0; + FTail := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfQueue.Contains(const AInterface: IInterface): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + I := FHead; + while I <> FTail do + begin + if ItemsEqual(FElements[I], AInterface) then + begin + Result := True; + Break; + end; + Inc(I); + if I = FCapacity then + I := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfQueue.Dequeue: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + if FTail <> FHead then + begin + Result := FElements[FHead]; + FElements[FHead] := nil; + Inc(FHead); + if FHead = FCapacity then + FHead := 0; + AutoPack; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfQueue.Empty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FTail = FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfQueue.Enqueue(const AInterface: IInterface): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (FTail = (FHead - 1)) or (FTail = (FHead + FCapacity - 1)) then + AutoGrow; + Result := (FTail <> (FHead - 1)) and (FTail <> (FHead + FCapacity - 1)); + if Result then + begin + FElements[FTail] := AInterface; + Inc(FTail); + if FTail = FCapacity then + FTail := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfQueue.Grow; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfQueue.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfQueue.Peek: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FTail <> FHead then + Result := FElements[FHead] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfQueue.SetCapacity(Value: Integer); +var + NewHead: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < 1 then + raise EJclIllegalQueueCapacityError.Create; + if Value <= Size then + raise EJclOutOfBoundsError.Create; + + if FHead > FTail then // looped + begin + NewHead := FHead + Value - FCapacity; + if Value > FCapacity then + // growing + SetLength(FElements, Value); + MoveArray(FElements, FHead, NewHead, FCapacity - FHead); + if FCapacity > Value then + // packing + SetLength(FElements, Value); + FHead := NewHead; + end + else + begin + // unlooped + if Value < FCapacity then + begin + MoveArray(FElements, FHead, 0, FTail - FHead); + Dec(FTail, FHead); + FHead := 0; + end; + SetLength(FElements, Value); + end; + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfQueue.Size: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FHead > FTail then + Result := FCapacity - FHead + FTail // looped + else + Result := FTail - FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfQueue.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfQueue.Create(Size + 1); + AssignPropertiesTo(Result); +end; + +//=== { TJclAnsiStrQueue } ======================================================= + +constructor TJclAnsiStrQueue.Create(ACapacity: Integer); +begin + inherited Create(); + FHead := 0; + FTail := 0; + SetCapacity(ACapacity); +end; + +destructor TJclAnsiStrQueue.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclAnsiStrQueue.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclAnsiStrQueue; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclAnsiStrQueue then + begin + ADest := TJclAnsiStrQueue(Dest); + ADest.Clear; + ADest.SetCapacity(Size + 1); + I := FHead; + while I <> FTail do + begin + ADest.Enqueue(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + end; +end; + +procedure TJclAnsiStrQueue.AutoGrow; +begin + SetCapacity(CalcGrowCapacity(FCapacity, Size + 1)); +end; + +procedure TJclAnsiStrQueue.AutoPack; +begin + SetCapacity(CalcPackCapacity(FCapacity, Size + 1)); +end; + +procedure TJclAnsiStrQueue.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + I := FHead; + while I <> FTail do + begin + FreeString(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + FHead := 0; + FTail := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrQueue.Contains(const AString: AnsiString): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + I := FHead; + while I <> FTail do + begin + if ItemsEqual(FElements[I], AString) then + begin + Result := True; + Break; + end; + Inc(I); + if I = FCapacity then + I := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrQueue.Dequeue: AnsiString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := ''; + if FTail <> FHead then + begin + Result := FElements[FHead]; + FElements[FHead] := ''; + Inc(FHead); + if FHead = FCapacity then + FHead := 0; + AutoPack; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrQueue.Empty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FTail = FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrQueue.Enqueue(const AString: AnsiString): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (FTail = (FHead - 1)) or (FTail = (FHead + FCapacity - 1)) then + AutoGrow; + Result := (FTail <> (FHead - 1)) and (FTail <> (FHead + FCapacity - 1)); + if Result then + begin + FElements[FTail] := AString; + Inc(FTail); + if FTail = FCapacity then + FTail := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrQueue.Grow; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrQueue.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrQueue.Peek: AnsiString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if FTail <> FHead then + Result := FElements[FHead] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrQueue.SetCapacity(Value: Integer); +var + NewHead: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < 1 then + raise EJclIllegalQueueCapacityError.Create; + if Value <= Size then + raise EJclOutOfBoundsError.Create; + + if FHead > FTail then // looped + begin + NewHead := FHead + Value - FCapacity; + if Value > FCapacity then + // growing + SetLength(FElements, Value); + MoveArray(FElements, FHead, NewHead, FCapacity - FHead); + if FCapacity > Value then + // packing + SetLength(FElements, Value); + FHead := NewHead; + end + else + begin + // unlooped + if Value < FCapacity then + begin + MoveArray(FElements, FHead, 0, FTail - FHead); + Dec(FTail, FHead); + FHead := 0; + end; + SetLength(FElements, Value); + end; + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrQueue.Size: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FHead > FTail then + Result := FCapacity - FHead + FTail // looped + else + Result := FTail - FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrQueue.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclAnsiStrQueue.Create(Size + 1); + AssignPropertiesTo(Result); +end; + +//=== { TJclWideStrQueue } ======================================================= + +constructor TJclWideStrQueue.Create(ACapacity: Integer); +begin + inherited Create(); + FHead := 0; + FTail := 0; + SetCapacity(ACapacity); +end; + +destructor TJclWideStrQueue.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclWideStrQueue.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclWideStrQueue; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclWideStrQueue then + begin + ADest := TJclWideStrQueue(Dest); + ADest.Clear; + ADest.SetCapacity(Size + 1); + I := FHead; + while I <> FTail do + begin + ADest.Enqueue(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + end; +end; + +procedure TJclWideStrQueue.AutoGrow; +begin + SetCapacity(CalcGrowCapacity(FCapacity, Size + 1)); +end; + +procedure TJclWideStrQueue.AutoPack; +begin + SetCapacity(CalcPackCapacity(FCapacity, Size + 1)); +end; + +procedure TJclWideStrQueue.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + I := FHead; + while I <> FTail do + begin + FreeString(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + FHead := 0; + FTail := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrQueue.Contains(const AString: WideString): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + I := FHead; + while I <> FTail do + begin + if ItemsEqual(FElements[I], AString) then + begin + Result := True; + Break; + end; + Inc(I); + if I = FCapacity then + I := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrQueue.Dequeue: WideString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := ''; + if FTail <> FHead then + begin + Result := FElements[FHead]; + FElements[FHead] := ''; + Inc(FHead); + if FHead = FCapacity then + FHead := 0; + AutoPack; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrQueue.Empty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FTail = FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrQueue.Enqueue(const AString: WideString): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (FTail = (FHead - 1)) or (FTail = (FHead + FCapacity - 1)) then + AutoGrow; + Result := (FTail <> (FHead - 1)) and (FTail <> (FHead + FCapacity - 1)); + if Result then + begin + FElements[FTail] := AString; + Inc(FTail); + if FTail = FCapacity then + FTail := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrQueue.Grow; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrQueue.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrQueue.Peek: WideString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if FTail <> FHead then + Result := FElements[FHead] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrQueue.SetCapacity(Value: Integer); +var + NewHead: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < 1 then + raise EJclIllegalQueueCapacityError.Create; + if Value <= Size then + raise EJclOutOfBoundsError.Create; + + if FHead > FTail then // looped + begin + NewHead := FHead + Value - FCapacity; + if Value > FCapacity then + // growing + SetLength(FElements, Value); + MoveArray(FElements, FHead, NewHead, FCapacity - FHead); + if FCapacity > Value then + // packing + SetLength(FElements, Value); + FHead := NewHead; + end + else + begin + // unlooped + if Value < FCapacity then + begin + MoveArray(FElements, FHead, 0, FTail - FHead); + Dec(FTail, FHead); + FHead := 0; + end; + SetLength(FElements, Value); + end; + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrQueue.Size: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FHead > FTail then + Result := FCapacity - FHead + FTail // looped + else + Result := FTail - FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrQueue.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclWideStrQueue.Create(Size + 1); + AssignPropertiesTo(Result); +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrQueue } ======================================================= + +constructor TJclUnicodeStrQueue.Create(ACapacity: Integer); +begin + inherited Create(); + FHead := 0; + FTail := 0; + SetCapacity(ACapacity); +end; + +destructor TJclUnicodeStrQueue.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclUnicodeStrQueue.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclUnicodeStrQueue; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclUnicodeStrQueue then + begin + ADest := TJclUnicodeStrQueue(Dest); + ADest.Clear; + ADest.SetCapacity(Size + 1); + I := FHead; + while I <> FTail do + begin + ADest.Enqueue(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + end; +end; + +procedure TJclUnicodeStrQueue.AutoGrow; +begin + SetCapacity(CalcGrowCapacity(FCapacity, Size + 1)); +end; + +procedure TJclUnicodeStrQueue.AutoPack; +begin + SetCapacity(CalcPackCapacity(FCapacity, Size + 1)); +end; + +procedure TJclUnicodeStrQueue.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + I := FHead; + while I <> FTail do + begin + FreeString(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + FHead := 0; + FTail := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrQueue.Contains(const AString: UnicodeString): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + I := FHead; + while I <> FTail do + begin + if ItemsEqual(FElements[I], AString) then + begin + Result := True; + Break; + end; + Inc(I); + if I = FCapacity then + I := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrQueue.Dequeue: UnicodeString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := ''; + if FTail <> FHead then + begin + Result := FElements[FHead]; + FElements[FHead] := ''; + Inc(FHead); + if FHead = FCapacity then + FHead := 0; + AutoPack; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrQueue.Empty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FTail = FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrQueue.Enqueue(const AString: UnicodeString): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (FTail = (FHead - 1)) or (FTail = (FHead + FCapacity - 1)) then + AutoGrow; + Result := (FTail <> (FHead - 1)) and (FTail <> (FHead + FCapacity - 1)); + if Result then + begin + FElements[FTail] := AString; + Inc(FTail); + if FTail = FCapacity then + FTail := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrQueue.Grow; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrQueue.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrQueue.Peek: UnicodeString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if FTail <> FHead then + Result := FElements[FHead] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrQueue.SetCapacity(Value: Integer); +var + NewHead: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < 1 then + raise EJclIllegalQueueCapacityError.Create; + if Value <= Size then + raise EJclOutOfBoundsError.Create; + + if FHead > FTail then // looped + begin + NewHead := FHead + Value - FCapacity; + if Value > FCapacity then + // growing + SetLength(FElements, Value); + MoveArray(FElements, FHead, NewHead, FCapacity - FHead); + if FCapacity > Value then + // packing + SetLength(FElements, Value); + FHead := NewHead; + end + else + begin + // unlooped + if Value < FCapacity then + begin + MoveArray(FElements, FHead, 0, FTail - FHead); + Dec(FTail, FHead); + FHead := 0; + end; + SetLength(FElements, Value); + end; + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrQueue.Size: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FHead > FTail then + Result := FCapacity - FHead + FTail // looped + else + Result := FTail - FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrQueue.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclUnicodeStrQueue.Create(Size + 1); + AssignPropertiesTo(Result); +end; + +{$ENDIF SUPPORTS_UNICODE_STRING} + +//=== { TJclSingleQueue } ======================================================= + +constructor TJclSingleQueue.Create(ACapacity: Integer); +begin + inherited Create(); + FHead := 0; + FTail := 0; + SetCapacity(ACapacity); +end; + +destructor TJclSingleQueue.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclSingleQueue.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclSingleQueue; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclSingleQueue then + begin + ADest := TJclSingleQueue(Dest); + ADest.Clear; + ADest.SetCapacity(Size + 1); + I := FHead; + while I <> FTail do + begin + ADest.Enqueue(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + end; +end; + +procedure TJclSingleQueue.AutoGrow; +begin + SetCapacity(CalcGrowCapacity(FCapacity, Size + 1)); +end; + +procedure TJclSingleQueue.AutoPack; +begin + SetCapacity(CalcPackCapacity(FCapacity, Size + 1)); +end; + +procedure TJclSingleQueue.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + I := FHead; + while I <> FTail do + begin + FreeSingle(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + FHead := 0; + FTail := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleQueue.Contains(const AValue: Single): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + I := FHead; + while I <> FTail do + begin + if ItemsEqual(FElements[I], AValue) then + begin + Result := True; + Break; + end; + Inc(I); + if I = FCapacity then + I := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleQueue.Dequeue: Single; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FTail <> FHead then + begin + Result := FElements[FHead]; + FElements[FHead] := 0.0; + Inc(FHead); + if FHead = FCapacity then + FHead := 0; + AutoPack; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleQueue.Empty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FTail = FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleQueue.Enqueue(const AValue: Single): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (FTail = (FHead - 1)) or (FTail = (FHead + FCapacity - 1)) then + AutoGrow; + Result := (FTail <> (FHead - 1)) and (FTail <> (FHead + FCapacity - 1)); + if Result then + begin + FElements[FTail] := AValue; + Inc(FTail); + if FTail = FCapacity then + FTail := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleQueue.Grow; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleQueue.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleQueue.Peek: Single; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FTail <> FHead then + Result := FElements[FHead] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleQueue.SetCapacity(Value: Integer); +var + NewHead: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < 1 then + raise EJclIllegalQueueCapacityError.Create; + if Value <= Size then + raise EJclOutOfBoundsError.Create; + + if FHead > FTail then // looped + begin + NewHead := FHead + Value - FCapacity; + if Value > FCapacity then + // growing + SetLength(FElements, Value); + MoveArray(FElements, FHead, NewHead, FCapacity - FHead); + if FCapacity > Value then + // packing + SetLength(FElements, Value); + FHead := NewHead; + end + else + begin + // unlooped + if Value < FCapacity then + begin + MoveArray(FElements, FHead, 0, FTail - FHead); + Dec(FTail, FHead); + FHead := 0; + end; + SetLength(FElements, Value); + end; + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleQueue.Size: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FHead > FTail then + Result := FCapacity - FHead + FTail // looped + else + Result := FTail - FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleQueue.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclSingleQueue.Create(Size + 1); + AssignPropertiesTo(Result); +end; + +//=== { TJclDoubleQueue } ======================================================= + +constructor TJclDoubleQueue.Create(ACapacity: Integer); +begin + inherited Create(); + FHead := 0; + FTail := 0; + SetCapacity(ACapacity); +end; + +destructor TJclDoubleQueue.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclDoubleQueue.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclDoubleQueue; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclDoubleQueue then + begin + ADest := TJclDoubleQueue(Dest); + ADest.Clear; + ADest.SetCapacity(Size + 1); + I := FHead; + while I <> FTail do + begin + ADest.Enqueue(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + end; +end; + +procedure TJclDoubleQueue.AutoGrow; +begin + SetCapacity(CalcGrowCapacity(FCapacity, Size + 1)); +end; + +procedure TJclDoubleQueue.AutoPack; +begin + SetCapacity(CalcPackCapacity(FCapacity, Size + 1)); +end; + +procedure TJclDoubleQueue.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + I := FHead; + while I <> FTail do + begin + FreeDouble(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + FHead := 0; + FTail := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleQueue.Contains(const AValue: Double): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + I := FHead; + while I <> FTail do + begin + if ItemsEqual(FElements[I], AValue) then + begin + Result := True; + Break; + end; + Inc(I); + if I = FCapacity then + I := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleQueue.Dequeue: Double; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FTail <> FHead then + begin + Result := FElements[FHead]; + FElements[FHead] := 0.0; + Inc(FHead); + if FHead = FCapacity then + FHead := 0; + AutoPack; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleQueue.Empty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FTail = FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleQueue.Enqueue(const AValue: Double): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (FTail = (FHead - 1)) or (FTail = (FHead + FCapacity - 1)) then + AutoGrow; + Result := (FTail <> (FHead - 1)) and (FTail <> (FHead + FCapacity - 1)); + if Result then + begin + FElements[FTail] := AValue; + Inc(FTail); + if FTail = FCapacity then + FTail := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleQueue.Grow; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleQueue.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleQueue.Peek: Double; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FTail <> FHead then + Result := FElements[FHead] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleQueue.SetCapacity(Value: Integer); +var + NewHead: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < 1 then + raise EJclIllegalQueueCapacityError.Create; + if Value <= Size then + raise EJclOutOfBoundsError.Create; + + if FHead > FTail then // looped + begin + NewHead := FHead + Value - FCapacity; + if Value > FCapacity then + // growing + SetLength(FElements, Value); + MoveArray(FElements, FHead, NewHead, FCapacity - FHead); + if FCapacity > Value then + // packing + SetLength(FElements, Value); + FHead := NewHead; + end + else + begin + // unlooped + if Value < FCapacity then + begin + MoveArray(FElements, FHead, 0, FTail - FHead); + Dec(FTail, FHead); + FHead := 0; + end; + SetLength(FElements, Value); + end; + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleQueue.Size: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FHead > FTail then + Result := FCapacity - FHead + FTail // looped + else + Result := FTail - FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleQueue.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclDoubleQueue.Create(Size + 1); + AssignPropertiesTo(Result); +end; + +//=== { TJclExtendedQueue } ======================================================= + +constructor TJclExtendedQueue.Create(ACapacity: Integer); +begin + inherited Create(); + FHead := 0; + FTail := 0; + SetCapacity(ACapacity); +end; + +destructor TJclExtendedQueue.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclExtendedQueue.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclExtendedQueue; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclExtendedQueue then + begin + ADest := TJclExtendedQueue(Dest); + ADest.Clear; + ADest.SetCapacity(Size + 1); + I := FHead; + while I <> FTail do + begin + ADest.Enqueue(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + end; +end; + +procedure TJclExtendedQueue.AutoGrow; +begin + SetCapacity(CalcGrowCapacity(FCapacity, Size + 1)); +end; + +procedure TJclExtendedQueue.AutoPack; +begin + SetCapacity(CalcPackCapacity(FCapacity, Size + 1)); +end; + +procedure TJclExtendedQueue.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + I := FHead; + while I <> FTail do + begin + FreeExtended(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + FHead := 0; + FTail := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedQueue.Contains(const AValue: Extended): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + I := FHead; + while I <> FTail do + begin + if ItemsEqual(FElements[I], AValue) then + begin + Result := True; + Break; + end; + Inc(I); + if I = FCapacity then + I := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedQueue.Dequeue: Extended; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FTail <> FHead then + begin + Result := FElements[FHead]; + FElements[FHead] := 0.0; + Inc(FHead); + if FHead = FCapacity then + FHead := 0; + AutoPack; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedQueue.Empty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FTail = FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedQueue.Enqueue(const AValue: Extended): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (FTail = (FHead - 1)) or (FTail = (FHead + FCapacity - 1)) then + AutoGrow; + Result := (FTail <> (FHead - 1)) and (FTail <> (FHead + FCapacity - 1)); + if Result then + begin + FElements[FTail] := AValue; + Inc(FTail); + if FTail = FCapacity then + FTail := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedQueue.Grow; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedQueue.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedQueue.Peek: Extended; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FTail <> FHead then + Result := FElements[FHead] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedQueue.SetCapacity(Value: Integer); +var + NewHead: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < 1 then + raise EJclIllegalQueueCapacityError.Create; + if Value <= Size then + raise EJclOutOfBoundsError.Create; + + if FHead > FTail then // looped + begin + NewHead := FHead + Value - FCapacity; + if Value > FCapacity then + // growing + SetLength(FElements, Value); + MoveArray(FElements, FHead, NewHead, FCapacity - FHead); + if FCapacity > Value then + // packing + SetLength(FElements, Value); + FHead := NewHead; + end + else + begin + // unlooped + if Value < FCapacity then + begin + MoveArray(FElements, FHead, 0, FTail - FHead); + Dec(FTail, FHead); + FHead := 0; + end; + SetLength(FElements, Value); + end; + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedQueue.Size: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FHead > FTail then + Result := FCapacity - FHead + FTail // looped + else + Result := FTail - FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedQueue.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclExtendedQueue.Create(Size + 1); + AssignPropertiesTo(Result); +end; + +//=== { TJclIntegerQueue } ======================================================= + +constructor TJclIntegerQueue.Create(ACapacity: Integer); +begin + inherited Create(); + FHead := 0; + FTail := 0; + SetCapacity(ACapacity); +end; + +destructor TJclIntegerQueue.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntegerQueue.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclIntegerQueue; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntegerQueue then + begin + ADest := TJclIntegerQueue(Dest); + ADest.Clear; + ADest.SetCapacity(Size + 1); + I := FHead; + while I <> FTail do + begin + ADest.Enqueue(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + end; +end; + +procedure TJclIntegerQueue.AutoGrow; +begin + SetCapacity(CalcGrowCapacity(FCapacity, Size + 1)); +end; + +procedure TJclIntegerQueue.AutoPack; +begin + SetCapacity(CalcPackCapacity(FCapacity, Size + 1)); +end; + +procedure TJclIntegerQueue.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + I := FHead; + while I <> FTail do + begin + FreeInteger(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + FHead := 0; + FTail := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerQueue.Contains(AValue: Integer): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + I := FHead; + while I <> FTail do + begin + if ItemsEqual(FElements[I], AValue) then + begin + Result := True; + Break; + end; + Inc(I); + if I = FCapacity then + I := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerQueue.Dequeue: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0; + if FTail <> FHead then + begin + Result := FElements[FHead]; + FElements[FHead] := 0; + Inc(FHead); + if FHead = FCapacity then + FHead := 0; + AutoPack; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerQueue.Empty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FTail = FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerQueue.Enqueue(AValue: Integer): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (FTail = (FHead - 1)) or (FTail = (FHead + FCapacity - 1)) then + AutoGrow; + Result := (FTail <> (FHead - 1)) and (FTail <> (FHead + FCapacity - 1)); + if Result then + begin + FElements[FTail] := AValue; + Inc(FTail); + if FTail = FCapacity then + FTail := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerQueue.Grow; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerQueue.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerQueue.Peek: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if FTail <> FHead then + Result := FElements[FHead] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerQueue.SetCapacity(Value: Integer); +var + NewHead: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < 1 then + raise EJclIllegalQueueCapacityError.Create; + if Value <= Size then + raise EJclOutOfBoundsError.Create; + + if FHead > FTail then // looped + begin + NewHead := FHead + Value - FCapacity; + if Value > FCapacity then + // growing + SetLength(FElements, Value); + MoveArray(FElements, FHead, NewHead, FCapacity - FHead); + if FCapacity > Value then + // packing + SetLength(FElements, Value); + FHead := NewHead; + end + else + begin + // unlooped + if Value < FCapacity then + begin + MoveArray(FElements, FHead, 0, FTail - FHead); + Dec(FTail, FHead); + FHead := 0; + end; + SetLength(FElements, Value); + end; + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerQueue.Size: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FHead > FTail then + Result := FCapacity - FHead + FTail // looped + else + Result := FTail - FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerQueue.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntegerQueue.Create(Size + 1); + AssignPropertiesTo(Result); +end; + +//=== { TJclCardinalQueue } ======================================================= + +constructor TJclCardinalQueue.Create(ACapacity: Integer); +begin + inherited Create(); + FHead := 0; + FTail := 0; + SetCapacity(ACapacity); +end; + +destructor TJclCardinalQueue.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclCardinalQueue.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclCardinalQueue; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclCardinalQueue then + begin + ADest := TJclCardinalQueue(Dest); + ADest.Clear; + ADest.SetCapacity(Size + 1); + I := FHead; + while I <> FTail do + begin + ADest.Enqueue(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + end; +end; + +procedure TJclCardinalQueue.AutoGrow; +begin + SetCapacity(CalcGrowCapacity(FCapacity, Size + 1)); +end; + +procedure TJclCardinalQueue.AutoPack; +begin + SetCapacity(CalcPackCapacity(FCapacity, Size + 1)); +end; + +procedure TJclCardinalQueue.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + I := FHead; + while I <> FTail do + begin + FreeCardinal(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + FHead := 0; + FTail := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalQueue.Contains(AValue: Cardinal): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + I := FHead; + while I <> FTail do + begin + if ItemsEqual(FElements[I], AValue) then + begin + Result := True; + Break; + end; + Inc(I); + if I = FCapacity then + I := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalQueue.Dequeue: Cardinal; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0; + if FTail <> FHead then + begin + Result := FElements[FHead]; + FElements[FHead] := 0; + Inc(FHead); + if FHead = FCapacity then + FHead := 0; + AutoPack; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalQueue.Empty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FTail = FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalQueue.Enqueue(AValue: Cardinal): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (FTail = (FHead - 1)) or (FTail = (FHead + FCapacity - 1)) then + AutoGrow; + Result := (FTail <> (FHead - 1)) and (FTail <> (FHead + FCapacity - 1)); + if Result then + begin + FElements[FTail] := AValue; + Inc(FTail); + if FTail = FCapacity then + FTail := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalQueue.Grow; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalQueue.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalQueue.Peek: Cardinal; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if FTail <> FHead then + Result := FElements[FHead] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalQueue.SetCapacity(Value: Integer); +var + NewHead: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < 1 then + raise EJclIllegalQueueCapacityError.Create; + if Value <= Size then + raise EJclOutOfBoundsError.Create; + + if FHead > FTail then // looped + begin + NewHead := FHead + Value - FCapacity; + if Value > FCapacity then + // growing + SetLength(FElements, Value); + MoveArray(FElements, FHead, NewHead, FCapacity - FHead); + if FCapacity > Value then + // packing + SetLength(FElements, Value); + FHead := NewHead; + end + else + begin + // unlooped + if Value < FCapacity then + begin + MoveArray(FElements, FHead, 0, FTail - FHead); + Dec(FTail, FHead); + FHead := 0; + end; + SetLength(FElements, Value); + end; + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalQueue.Size: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FHead > FTail then + Result := FCapacity - FHead + FTail // looped + else + Result := FTail - FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalQueue.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclCardinalQueue.Create(Size + 1); + AssignPropertiesTo(Result); +end; + +//=== { TJclInt64Queue } ======================================================= + +constructor TJclInt64Queue.Create(ACapacity: Integer); +begin + inherited Create(); + FHead := 0; + FTail := 0; + SetCapacity(ACapacity); +end; + +destructor TJclInt64Queue.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclInt64Queue.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclInt64Queue; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclInt64Queue then + begin + ADest := TJclInt64Queue(Dest); + ADest.Clear; + ADest.SetCapacity(Size + 1); + I := FHead; + while I <> FTail do + begin + ADest.Enqueue(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + end; +end; + +procedure TJclInt64Queue.AutoGrow; +begin + SetCapacity(CalcGrowCapacity(FCapacity, Size + 1)); +end; + +procedure TJclInt64Queue.AutoPack; +begin + SetCapacity(CalcPackCapacity(FCapacity, Size + 1)); +end; + +procedure TJclInt64Queue.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + I := FHead; + while I <> FTail do + begin + FreeInt64(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + FHead := 0; + FTail := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Queue.Contains(const AValue: Int64): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + I := FHead; + while I <> FTail do + begin + if ItemsEqual(FElements[I], AValue) then + begin + Result := True; + Break; + end; + Inc(I); + if I = FCapacity then + I := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Queue.Dequeue: Int64; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0; + if FTail <> FHead then + begin + Result := FElements[FHead]; + FElements[FHead] := 0; + Inc(FHead); + if FHead = FCapacity then + FHead := 0; + AutoPack; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Queue.Empty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FTail = FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Queue.Enqueue(const AValue: Int64): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (FTail = (FHead - 1)) or (FTail = (FHead + FCapacity - 1)) then + AutoGrow; + Result := (FTail <> (FHead - 1)) and (FTail <> (FHead + FCapacity - 1)); + if Result then + begin + FElements[FTail] := AValue; + Inc(FTail); + if FTail = FCapacity then + FTail := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64Queue.Grow; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64Queue.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Queue.Peek: Int64; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if FTail <> FHead then + Result := FElements[FHead] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64Queue.SetCapacity(Value: Integer); +var + NewHead: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < 1 then + raise EJclIllegalQueueCapacityError.Create; + if Value <= Size then + raise EJclOutOfBoundsError.Create; + + if FHead > FTail then // looped + begin + NewHead := FHead + Value - FCapacity; + if Value > FCapacity then + // growing + SetLength(FElements, Value); + MoveArray(FElements, FHead, NewHead, FCapacity - FHead); + if FCapacity > Value then + // packing + SetLength(FElements, Value); + FHead := NewHead; + end + else + begin + // unlooped + if Value < FCapacity then + begin + MoveArray(FElements, FHead, 0, FTail - FHead); + Dec(FTail, FHead); + FHead := 0; + end; + SetLength(FElements, Value); + end; + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Queue.Size: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FHead > FTail then + Result := FCapacity - FHead + FTail // looped + else + Result := FTail - FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Queue.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclInt64Queue.Create(Size + 1); + AssignPropertiesTo(Result); +end; + +//=== { TJclPtrQueue } ======================================================= + +constructor TJclPtrQueue.Create(ACapacity: Integer); +begin + inherited Create(); + FHead := 0; + FTail := 0; + SetCapacity(ACapacity); +end; + +destructor TJclPtrQueue.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclPtrQueue.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclPtrQueue; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclPtrQueue then + begin + ADest := TJclPtrQueue(Dest); + ADest.Clear; + ADest.SetCapacity(Size + 1); + I := FHead; + while I <> FTail do + begin + ADest.Enqueue(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + end; +end; + +procedure TJclPtrQueue.AutoGrow; +begin + SetCapacity(CalcGrowCapacity(FCapacity, Size + 1)); +end; + +procedure TJclPtrQueue.AutoPack; +begin + SetCapacity(CalcPackCapacity(FCapacity, Size + 1)); +end; + +procedure TJclPtrQueue.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + I := FHead; + while I <> FTail do + begin + FreePointer(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + FHead := 0; + FTail := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrQueue.Contains(APtr: Pointer): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + I := FHead; + while I <> FTail do + begin + if ItemsEqual(FElements[I], APtr) then + begin + Result := True; + Break; + end; + Inc(I); + if I = FCapacity then + I := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrQueue.Dequeue: Pointer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + if FTail <> FHead then + begin + Result := FElements[FHead]; + FElements[FHead] := nil; + Inc(FHead); + if FHead = FCapacity then + FHead := 0; + AutoPack; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrQueue.Empty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FTail = FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrQueue.Enqueue(APtr: Pointer): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (FTail = (FHead - 1)) or (FTail = (FHead + FCapacity - 1)) then + AutoGrow; + Result := (FTail <> (FHead - 1)) and (FTail <> (FHead + FCapacity - 1)); + if Result then + begin + FElements[FTail] := APtr; + Inc(FTail); + if FTail = FCapacity then + FTail := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrQueue.Grow; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrQueue.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrQueue.Peek: Pointer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FTail <> FHead then + Result := FElements[FHead] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrQueue.SetCapacity(Value: Integer); +var + NewHead: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < 1 then + raise EJclIllegalQueueCapacityError.Create; + if Value <= Size then + raise EJclOutOfBoundsError.Create; + + if FHead > FTail then // looped + begin + NewHead := FHead + Value - FCapacity; + if Value > FCapacity then + // growing + SetLength(FElements, Value); + MoveArray(FElements, FHead, NewHead, FCapacity - FHead); + if FCapacity > Value then + // packing + SetLength(FElements, Value); + FHead := NewHead; + end + else + begin + // unlooped + if Value < FCapacity then + begin + MoveArray(FElements, FHead, 0, FTail - FHead); + Dec(FTail, FHead); + FHead := 0; + end; + SetLength(FElements, Value); + end; + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrQueue.Size: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FHead > FTail then + Result := FCapacity - FHead + FTail // looped + else + Result := FTail - FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrQueue.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclPtrQueue.Create(Size + 1); + AssignPropertiesTo(Result); +end; + +//=== { TJclQueue } ======================================================= + +constructor TJclQueue.Create(ACapacity: Integer; AOwnsObjects: Boolean); +begin + inherited Create(AOwnsObjects); + FHead := 0; + FTail := 0; + SetCapacity(ACapacity); +end; + +destructor TJclQueue.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclQueue.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclQueue; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclQueue then + begin + ADest := TJclQueue(Dest); + ADest.Clear; + ADest.SetCapacity(Size + 1); + I := FHead; + while I <> FTail do + begin + ADest.Enqueue(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + end; +end; + +procedure TJclQueue.AutoGrow; +begin + SetCapacity(CalcGrowCapacity(FCapacity, Size + 1)); +end; + +procedure TJclQueue.AutoPack; +begin + SetCapacity(CalcPackCapacity(FCapacity, Size + 1)); +end; + +procedure TJclQueue.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + I := FHead; + while I <> FTail do + begin + FreeObject(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + FHead := 0; + FTail := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclQueue.Contains(AObject: TObject): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + I := FHead; + while I <> FTail do + begin + if ItemsEqual(FElements[I], AObject) then + begin + Result := True; + Break; + end; + Inc(I); + if I = FCapacity then + I := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclQueue.Dequeue: TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + if FTail <> FHead then + begin + Result := FElements[FHead]; + FElements[FHead] := nil; + Inc(FHead); + if FHead = FCapacity then + FHead := 0; + AutoPack; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclQueue.Empty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FTail = FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclQueue.Enqueue(AObject: TObject): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (FTail = (FHead - 1)) or (FTail = (FHead + FCapacity - 1)) then + AutoGrow; + Result := (FTail <> (FHead - 1)) and (FTail <> (FHead + FCapacity - 1)); + if Result then + begin + FElements[FTail] := AObject; + Inc(FTail); + if FTail = FCapacity then + FTail := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclQueue.Grow; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclQueue.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclQueue.Peek: TObject; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FTail <> FHead then + Result := FElements[FHead] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclQueue.SetCapacity(Value: Integer); +var + NewHead: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < 1 then + raise EJclIllegalQueueCapacityError.Create; + if Value <= Size then + raise EJclOutOfBoundsError.Create; + + if FHead > FTail then // looped + begin + NewHead := FHead + Value - FCapacity; + if Value > FCapacity then + // growing + SetLength(FElements, Value); + MoveArray(FElements, FHead, NewHead, FCapacity - FHead); + if FCapacity > Value then + // packing + SetLength(FElements, Value); + FHead := NewHead; + end + else + begin + // unlooped + if Value < FCapacity then + begin + MoveArray(FElements, FHead, 0, FTail - FHead); + Dec(FTail, FHead); + FHead := 0; + end; + SetLength(FElements, Value); + end; + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclQueue.Size: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FHead > FTail then + Result := FCapacity - FHead + FTail // looped + else + Result := FTail - FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclQueue.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclQueue.Create(Size + 1, False); + AssignPropertiesTo(Result); +end; + + +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +//=== { TJclQueue } ======================================================= + +constructor TJclQueue.Create(ACapacity: Integer; AOwnsItems: Boolean); +begin + inherited Create(AOwnsItems); + FHead := 0; + FTail := 0; + SetCapacity(ACapacity); +end; + +destructor TJclQueue.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclQueue.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclQueue; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclQueue then + begin + ADest := TJclQueue(Dest); + ADest.Clear; + ADest.SetCapacity(Size + 1); + I := FHead; + while I <> FTail do + begin + ADest.Enqueue(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + end; +end; + +procedure TJclQueue.AutoGrow; +begin + SetCapacity(CalcGrowCapacity(FCapacity, Size + 1)); +end; + +procedure TJclQueue.AutoPack; +begin + SetCapacity(CalcPackCapacity(FCapacity, Size + 1)); +end; + +procedure TJclQueue.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + I := FHead; + while I <> FTail do + begin + FreeItem(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + FHead := 0; + FTail := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclQueue.Contains(const AItem: T): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + I := FHead; + while I <> FTail do + begin + if ItemsEqual(FElements[I], AItem) then + begin + Result := True; + Break; + end; + Inc(I); + if I = FCapacity then + I := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclQueue.Dequeue: T; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Default(T); + if FTail <> FHead then + begin + Result := FElements[FHead]; + FElements[FHead] := Default(T); + Inc(FHead); + if FHead = FCapacity then + FHead := 0; + AutoPack; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclQueue.Empty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FTail = FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclQueue.Enqueue(const AItem: T): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (FTail = (FHead - 1)) or (FTail = (FHead + FCapacity - 1)) then + AutoGrow; + Result := (FTail <> (FHead - 1)) and (FTail <> (FHead + FCapacity - 1)); + if Result then + begin + FElements[FTail] := AItem; + Inc(FTail); + if FTail = FCapacity then + FTail := 0; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclQueue.Grow; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclQueue.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + SetCapacity(Size + 1); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclQueue.Peek: T; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := Default(T); + if FTail <> FHead then + Result := FElements[FHead] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclQueue.SetCapacity(Value: Integer); +var + NewHead: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < 1 then + raise EJclIllegalQueueCapacityError.Create; + if Value <= Size then + raise EJclOutOfBoundsError.Create; + + if FHead > FTail then // looped + begin + NewHead := FHead + Value - FCapacity; + if Value > FCapacity then + // growing + SetLength(FElements, Value); + MoveArray(FElements, FHead, NewHead, FCapacity - FHead); + if FCapacity > Value then + // packing + SetLength(FElements, Value); + FHead := NewHead; + end + else + begin + // unlooped + if Value < FCapacity then + begin + MoveArray(FElements, FHead, 0, FTail - FHead); + Dec(FTail, FHead); + FHead := 0; + end; + SetLength(FElements, Value); + end; + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclQueue.Size: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FHead > FTail then + Result := FCapacity - FHead + FTail // looped + else + Result := FTail - FHead; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclQueue.MoveArray(var List: TDynArray; FromIndex, ToIndex, Count: SizeInt); +var + I: SizeInt; +begin + if FromIndex < ToIndex then + begin + for I := Count - 1 downto 0 do + List[ToIndex + I] := List[FromIndex + I]; + + if (ToIndex - FromIndex) < Count then + // overlapped source and target + for I := 0 to ToIndex - FromIndex - 1 do + List[FromIndex + I] := Default(T) + else + // independent + for I := 0 to Count - 1 do + List[FromIndex + I] := Default(T); + end + else + begin + for I := 0 to Count - 1 do + List[ToIndex + I] := List[FromIndex + I]; + + if (FromIndex - ToIndex) < Count then + // overlapped source and target + for I := Count - FromIndex + ToIndex to Count - 1 do + List[FromIndex + I] := Default(T) + else + // independent + for I := 0 to Count - 1 do + List[FromIndex + I] := Default(T); + end; +end; + +//=== { TJclQueueE } ====================================================== + +constructor TJclQueueE.Create(const AEqualityComparer: IEqualityComparer; + ACapacity: Integer; AOwnsItems: Boolean); +begin + inherited Create(ACapacity, AOwnsItems); + FEqualityComparer := AEqualityComparer; +end; + +procedure TJclQueueE.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclQueueE then + TJclQueueE(Dest).FEqualityComparer := FEqualityComparer; +end; + +function TJclQueueE.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclQueueE.Create(EqualityComparer, Size + 1, False); + AssignPropertiesTo(Result); +end; + +function TJclQueueE.ItemsEqual(const A, B: T): Boolean; +begin + if EqualityComparer <> nil then + Result := EqualityComparer.Equals(A, B) + else + Result := inherited ItemsEqual(A, B); +end; + +//=== { TJclQueueF } ====================================================== + +constructor TJclQueueF.Create(AEqualityCompare: TEqualityCompare; + ACapacity: Integer; AOwnsItems: Boolean); +begin + inherited Create(ACapacity, AOwnsItems); + SetEqualityCompare(AEqualityCompare); +end; + +function TJclQueueF.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclQueueF.Create(EqualityCompare, Size + 1, False); + AssignPropertiesTo(Result); +end; + +//=== { TJclQueueI } ====================================================== + +function TJclQueueI.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclQueueI.Create(Size + 1, False); + AssignPropertiesTo(Result); +end; + +function TJclQueueI.ItemsEqual(const A, B: T): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + Result := A.Equals(B); +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclRTTI.pas b/3rdParty/JCL/source/common/JclRTTI.pas new file mode 100644 index 00000000..9fa98f8b --- /dev/null +++ b/3rdParty/JCL/source/common/JclRTTI.pas @@ -0,0 +1,2983 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclRTTI.pas. } +{ } +{ The Initial Developer of the Original Code is Marcel Bestebroer. } +{ Portions created Marcel Bestebroer are Copyright (C) Marcel Bestebroer. All rights reserved. } +{ } +{ Contributor(s): } +{ Theo Bebekis } +{ Marcel Bestebroer (marcelb) } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ } +{**************************************************************************************************} +{ } +{ Various RunTime Type Information routines. Includes retrieving RTTI information for different } +{ types, declaring/generating new types, data conversion to user displayable values and 'is'/'as' } +{ operator hooking. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclRTTI; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.Types, + {$IFDEF MSWINDOWS} + Winapi.Windows, + {$ENDIF MSWINDOWS} + System.Classes, System.SysUtils, System.TypInfo, + {$ELSE ~HAS_UNITSCOPE} + Types, + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + Classes, SysUtils, TypInfo, + {$ENDIF ~HAS_UNITSCOPE} + JclBase; + +type + // TypeInfo writing + IJclInfoWriter = interface + ['{7DAD522D-46EA-11D5-B0C0-4854E825F345}'] + function GetWrap: Integer; + procedure SetWrap(const Value: Integer); + procedure Write(const S: string); + procedure Writeln(const S: string = ''); + procedure Indent; + procedure Outdent; + property Wrap: Integer read GetWrap write SetWrap; + end; + + TJclInfoWriter = class(TInterfacedObject, IJclInfoWriter) + private + FCurLine: string; + FIndentLevel: Integer; + FWrap: Integer; + protected + procedure DoWrap; + procedure DoWriteCompleteLines; + procedure PrimWrite(const S: string); virtual; abstract; + + property CurLine: string read FCurLine write FCurLine; + property IndentLevel: Integer read FIndentLevel write FIndentLevel; + public + constructor Create(const AWrap: Integer = 80); + destructor Destroy; override; + { IJclInfoWriter } + function GetWrap: Integer; + procedure SetWrap(const Value: Integer); + procedure Write(const S: string); + procedure Writeln(const S: string = ''); + procedure Indent; + procedure Outdent; + property Wrap: Integer read GetWrap write SetWrap; + end; + + TJclInfoStringsWriter = class(TJclInfoWriter) + private + FStrings: TStrings; + protected + procedure PrimWrite(const S: string); override; + public + constructor Create(const AStrings: TStrings; const AWrap: Integer = 80); + + property Strings: TStrings read FStrings; + end; + + // TypeInfo retrieval + IJclBaseInfo = interface + ['{84E57A52-7219-4248-BDC7-4AACBFE2002D}'] + procedure WriteTo(const Dest: IJclInfoWriter); + procedure DeclarationTo(const Dest: IJclInfoWriter); + end; + + IJclTypeInfo = interface(IJclBaseInfo) + ['{7DAD5220-46EA-11D5-B0C0-4854E825F345}'] + function GetName: string; + function GetTypeData: PTypeData; + function GetTypeInfo: PTypeInfo; + function GetTypeKind: TTypeKind; + + property Name: string read GetName; + property TypeData: PTypeData read GetTypeData; + property TypeInfo: PTypeInfo read GetTypeInfo; + property TypeKind: TTypeKind read GetTypeKind; + end; + + TJclTypeInfo = class(TInterfacedObject, IJclBaseInfo, IJclTypeInfo) + private + FTypeData: PTypeData; + FTypeInfo: PTypeInfo; + public + constructor Create(ATypeInfo: PTypeInfo); + { IJclBaseInfo } + procedure WriteTo(const Dest: IJclInfoWriter); virtual; + procedure DeclarationTo(const Dest: IJclInfoWriter); virtual; + { IJclTypeInfo } + function GetName: string; + function GetTypeData: PTypeData; + function GetTypeInfo: PTypeInfo; + function GetTypeKind: TTypeKind; + property Name: string read GetName; + property TypeData: PTypeData read GetTypeData; + property TypeInfo: PTypeInfo read GetTypeInfo; + property TypeKind: TTypeKind read GetTypeKind; + end; + + // for all values that can be serialized to/deserialized from strings + IJclValueTypeInfo = interface(IJclTypeInfo) + ['{522C6E39-F917-4C92-B085-223BD68C377F}'] + function SaveValueToString(AnObj: TObject; const PropName: string): string; + procedure LoadValueFromString(AnObj: TObject; const PropName, Value: string); + end; + + // Ordinal types + IJclOrdinalTypeInfo = interface(IJclValueTypeInfo) + ['{7DAD5221-46EA-11D5-B0C0-4854E825F345}'] + function GetOrdinalType: TOrdType; + + property OrdinalType: TOrdType read GetOrdinalType; + end; + + TJclOrdinalTypeInfo = class(TJclTypeInfo, IJclBaseInfo, IJclTypeInfo, + IJclValueTypeInfo, IJclOrdinalTypeInfo) + public + { IJclBaseInfo } + procedure WriteTo(const Dest: IJclInfoWriter); override; + { IJclValueTypeInfo } + function SaveValueToString(AnObj: TObject; const PropName: string): string; + procedure LoadValueFromString(AnObj: TObject; const PropName, Value: string); + { IJclOrdinalTypeInfo } + function GetOrdinalType: TOrdType; + property OrdinalType: TOrdType read GetOrdinalType; + end; + + IJclOrdinalRangeTypeInfo = interface(IJclOrdinalTypeInfo) + ['{7DAD5222-46EA-11D5-B0C0-4854E825F345}'] + function GetMinValue: Int64; + function GetMaxValue: Int64; + + property MinValue: Int64 read GetMinValue; + property MaxValue: Int64 read GetMaxValue; + end; + + TJclOrdinalRangeTypeInfo = class(TJclOrdinalTypeInfo, IJclBaseInfo, IJclTypeInfo, + IJclValueTypeInfo, IJclOrdinalTypeInfo, IJclOrdinalRangeTypeInfo) + public + { IJclBaseInfo } + procedure WriteTo(const Dest: IJclInfoWriter); override; + procedure DeclarationTo(const Dest: IJclInfoWriter); override; + { IJclOrdinalRangeTypeInfo } + function GetMinValue: Int64; + function GetMaxValue: Int64; + property MinValue: Int64 read GetMinValue; + property MaxValue: Int64 read GetMaxValue; + end; + + IJclEnumerationTypeInfo = interface(IJclOrdinalRangeTypeInfo) + ['{7DAD5223-46EA-11D5-B0C0-4854E825F345}'] + function GetBaseType: IJclEnumerationTypeInfo; + function GetNames(const I: Integer): string; + function GetUnitName: string; + + function IndexOfName(const Name: string): Integer; + + property BaseType: IJclEnumerationTypeInfo read GetBaseType; + property Names[const I: Integer]: string read GetNames; default; + property UnitName: string read GetUnitName; + end; + + TJclEnumerationTypeInfo = class(TJclOrdinalRangeTypeInfo, IJclBaseInfo, IJclTypeInfo, + IJclValueTypeInfo, IJclOrdinalTypeInfo, IJclOrdinalRangeTypeInfo, IJclEnumerationTypeInfo) + public + { IJclBaseInfo } + procedure WriteTo(const Dest: IJclInfoWriter); override; + procedure DeclarationTo(const Dest: IJclInfoWriter); override; + { IJclValueTypeInfo } + function SaveValueToString(AnObj: TObject; const PropName: string): string; + procedure LoadValueFromString(AnObj: TObject; const PropName, Value: string); + { IJclEnumerationTypeInfo } + function GetBaseType: IJclEnumerationTypeInfo; + function GetNames(const I: Integer): string; + function GetUnitName: string; + function IndexOfName(const Name: string): Integer; + property BaseType: IJclEnumerationTypeInfo read GetBaseType; + property Names[const I: Integer]: string read GetNames; default; + end; + + IJclSetTypeInfo = interface(IJclOrdinalTypeInfo) + ['{7DAD5224-46EA-11D5-B0C0-4854E825F345}'] + function GetBaseType: IJclOrdinalTypeInfo; + + procedure GetAsList(const Value; const WantRanges: Boolean; + const Strings: TStrings); + procedure SetAsList(out Value; const Strings: TStrings); + + property BaseType: IJclOrdinalTypeInfo read GetBaseType; + end; + + TJclSetTypeInfo = class(TJclOrdinalTypeInfo, IJclBaseInfo, IJclTypeInfo, + IJclValueTypeInfo, IJclOrdinalTypeInfo, IJclSetTypeInfo) + public + { IJclBaseInfo } + procedure WriteTo(const Dest: IJclInfoWriter); override; + procedure DeclarationTo(const Dest: IJclInfoWriter); override; + { IJclValueInfo } + function SaveValueToString(AnObj: TObject; const PropName: string): string; + procedure LoadValueFromString(AnObj: TObject; const PropName, Value: string); + { IJclSetTypeInfo } + function GetBaseType: IJclOrdinalTypeInfo; + procedure GetAsList(const Value; const WantRanges: Boolean; + const Strings: TStrings); + procedure SetAsList(out Value; const Strings: TStrings); + property BaseType: IJclOrdinalTypeInfo read GetBaseType; + end; + + // Float types + IJclFloatTypeInfo = interface(IJclValueTypeInfo) + ['{7DAD5225-46EA-11D5-B0C0-4854E825F345}'] + function GetFloatType: TFloatType; + + property FloatType: TFloatType read GetFloatType; + end; + + TJclFloatTypeInfo = class(TJclTypeInfo, IJclBaseInfo, IJclTypeInfo, + IJclValueTypeInfo, IJclFloatTypeInfo) + public + { IJclBaseInfo } + procedure WriteTo(const Dest: IJclInfoWriter); override; + procedure DeclarationTo(const Dest: IJclInfoWriter); override; + { IJclValueInfo } + function SaveValueToString(AnObj: TObject; const PropName: string): string; + procedure LoadValueFromString(AnObj: TObject; const PropName, Value: string); + { IJclFloatTypeInfo } + function GetFloatType: TFloatType; + property FloatType: TFloatType read GetFloatType; + end; + + // Short string types + IJclStringTypeInfo = interface(IJclValueTypeInfo) + ['{7DAD5226-46EA-11D5-B0C0-4854E825F345}'] + function GetMaxLength: Integer; + + property MaxLength: Integer read GetMaxLength; + end; + + TJclStringTypeInfo = class(TJclTypeInfo, IJclBaseInfo, IJclTypeInfo, + IJclValueTypeInfo, IJclStringTypeInfo) + public + { IJclBaseInfo } + procedure WriteTo(const Dest: IJclInfoWriter); override; + procedure DeclarationTo(const Dest: IJclInfoWriter); override; + { IJclValueInfo } + function SaveValueToString(AnObj: TObject; const PropName: string): string; + procedure LoadValueFromString(AnObj: TObject; const PropName, Value: string); + { IJclStringTypeInfo } + function GetMaxLength: Integer; + property MaxLength: Integer read GetMaxLength; + end; + + // Class types + TJclPropSpecKind = (pskNone, pskStaticMethod, pskVirtualMethod, pskField, + pskConstant); + + IJclPropInfo = interface + ['{7DAD5227-46EA-11D5-B0C0-4854E825F345}'] + function GetPropInfo: PPropInfo; + function GetPropType: IJclTypeInfo; + function GetReader: Pointer; + function GetWriter: Pointer; + function GetStoredProc: Pointer; + function GetIndex: Integer; + function GetDefault: Longint; + function GetNameIndex: Smallint; + function GetName: string; + function GetReaderType: TJclPropSpecKind; + function GetWriterType: TJclPropSpecKind; + function GetStoredType: TJclPropSpecKind; + function GetReaderValue: TJclAddr; + function GetWriterValue: TJclAddr; + function GetStoredValue: TJclAddr; + + function IsStored(const AInstance: TObject): Boolean; + function HasDefault: Boolean; + function HasIndex: Boolean; + + function SaveValueToString(AnObj: TObject): string; + procedure LoadValueFromString(AnObj: TObject; const Value: string); + + property PropInfo: PPropInfo read GetPropInfo; + property PropType: IJclTypeInfo read GetPropType; + property Reader: Pointer read GetReader; + property Writer: Pointer read GetWriter; + property StoredProc: Pointer read GetStoredProc; + property ReaderType: TJclPropSpecKind read GetReaderType; + property WriterType: TJclPropSpecKind read GetWriterType; + property StoredType: TJclPropSpecKind read GetStoredType; + property ReaderValue: TJclAddr read GetReaderValue; + property WriterValue: TJclAddr read GetWriterValue; + property StoredValue: TJclAddr read GetStoredValue; + property Index: Integer read GetIndex; + property Default: Longint read GetDefault; + property NameIndex: Smallint read GetNameIndex; + property Name: string read GetName; + end; + + TJclPropInfo = class(TInterfacedObject, IJclPropInfo) + private + FPropInfo: PPropInfo; + public + constructor Create(const APropInfo: PPropInfo); + { IJclPropInfo } + function GetPropInfo: PPropInfo; + function GetPropType: IJclTypeInfo; + function GetReader: Pointer; + function GetWriter: Pointer; + function GetStoredProc: Pointer; + function GetIndex: Integer; + function GetDefault: Longint; + function GetNameIndex: Smallint; + function GetName: string; + function GetSpecKind(const Value: TJclAddr): TJclPropSpecKind; + function GetSpecValue(const Value: TJclAddr): TJclAddr; + function GetReaderType: TJclPropSpecKind; + function GetWriterType: TJclPropSpecKind; + function GetStoredType: TJclPropSpecKind; + function GetReaderValue: TJclAddr; + function GetWriterValue: TJclAddr; + function GetStoredValue: TJclAddr; + + function IsStored(const AInstance: TObject): Boolean; + function HasDefault: Boolean; + function HasIndex: Boolean; + + function SaveValueToString(AnObj: TObject): string; + procedure LoadValueFromString(AnObj: TObject; const Value: string); + + property PropInfo: PPropInfo read GetPropInfo; + property PropType: IJclTypeInfo read GetPropType; + property Reader: Pointer read GetReader; + property Writer: Pointer read GetWriter; + property StoredProc: Pointer read GetStoredProc; + property ReaderType: TJclPropSpecKind read GetReaderType; + property WriterType: TJclPropSpecKind read GetWriterType; + property StoredType: TJclPropSpecKind read GetStoredType; + property ReaderValue: TJclAddr read GetReaderValue; + property WriterValue: TJclAddr read GetWriterValue; + property StoredValue: TJclAddr read GetStoredValue; + property Index: Integer read GetIndex; + property Default: Longint read GetDefault; + property NameIndex: Smallint read GetNameIndex; + property Name: string read GetName; + end; + + IJclObjPropInfo = interface(IJclPropInfo) + function GetAbsoluteName: string; + function GetInstance: TObject; + function IsStored: Boolean; overload; + + function SaveValueToString: string; + procedure LoadValueFromString(const Value: string); + + property AbsoluteName: string read GetAbsoluteName; + property Instance: TObject read GetInstance; + end; + + IJclObjPropInfoArray = array of IJclObjPropInfo; + + TJclObjPropInfo = class(TJclPropInfo, IJclPropInfo, IJclObjPropInfo) + private + FPrefix: string; + FInstance: TObject; + public + constructor Create(const APropInfo: PPropInfo; const APrefix: string; AInstance: TObject); + { IJclObjPropInfo } + function GetAbsoluteName: string; + function GetInstance: TObject; + function IsStored: Boolean; overload; + function SaveValueToString: string; overload; + procedure LoadValueFromString(const Value: string); overload; + end; + + IJclClassTypeInfo = interface(IJclValueTypeInfo) + ['{7DAD5228-46EA-11D5-B0C0-4854E825F345}'] + function GetClassRef: TClass; + function GetParent: IJclClassTypeInfo; + function GetTotalPropertyCount: Integer; + function GetPropertyCount: Integer; + function GetProperties(const PropIdx: Integer): IJclPropInfo; + function GetPropNames(const Name: string): IJclPropInfo; + function GetUnitName: string; + + property ClassRef: TClass read GetClassRef; + property Parent: IJclClassTypeInfo read GetParent; + property TotalPropertyCount: Integer read GetTotalPropertyCount; + property PropertyCount: Integer read GetPropertyCount; + property Properties[const PropIdx: Integer]: IJclPropInfo read GetProperties; + property PropNames[const Name: string]: IJclPropInfo read GetPropNames; + property UnitName: string read GetUnitName; + end; + + TJclClassTypeInfo = class(TJclTypeInfo, IJclBaseInfo, IJclTypeInfo, + IJclValueTypeInfo, IJclClassTypeInfo) + public + { IJclBaseInfo } + procedure WriteTo(const Dest: IJclInfoWriter); override; + procedure DeclarationTo(const Dest: IJclInfoWriter); override; + { IJclValueInfo } + function SaveValueToString(AnObj: TObject; const PropName: string): string; + procedure LoadValueFromString(AnObj: TObject; const PropName, Value: string); + { IJclClassTypeInfo } + function GetClassRef: TClass; + function GetParent: IJclClassTypeInfo; + function GetTotalPropertyCount: Integer; + function GetPropertyCount: Integer; + function GetProperties(const PropIdx: Integer): IJclPropInfo; + function GetPropNames(const Name: string): IJclPropInfo; + function GetUnitName: string; + property ClassRef: TClass read GetClassRef; + property Parent: IJclClassTypeInfo read GetParent; + property TotalPropertyCount: Integer read GetTotalPropertyCount; + property PropertyCount: Integer read GetPropertyCount; + property Properties[const PropIdx: Integer]: IJclPropInfo read GetProperties; + property PropNames[const Name: string]: IJclPropInfo read GetPropNames; + end; + + IJclObjClassTypeInfo = interface(IJclClassTypeInfo) + ['{5BF4383D-7FDD-4494-88CC-849D72B5E142}'] + function GetInstance: TObject; + function GetObjProperties(const PropIdx: Integer): IJclObjPropInfo; + function GetObjPropNames(const Name: string): IJclObjPropInfo; + + function SaveValueToString(const PropName: string): string; overload; + procedure LoadValueFromString(const PropName, Value: string); overload; + + property Instance: TObject read GetInstance; + property ObjProperties[const PropIdx: Integer]: IJclObjPropInfo read GetObjProperties; + property ObjPropNames[const Name: string]: IJclObjPropInfo read GetObjPropNames; + end; + + TJclObjClassTypeInfo = class(TJclClassTypeInfo, IJclBaseInfo, IJclTypeInfo, + IJclValueTypeInfo, IJclClassTypeInfo, IJclObjClassTypeInfo) + private + FPrefix: string; + FInstance: TObject; + public + constructor Create(const ATypeInfo: PTypeInfo; const APrefix: string; AInstance: TObject); + { IJclObjClassTypeInfo } + function GetInstance: TObject; + function GetObjProperties(const PropIdx: Integer): IJclObjPropInfo; + function GetObjPropNames(const Name: string): IJclObjPropInfo; + function SaveValueToString(const PropName: string): string; overload; + procedure LoadValueFromString(const PropName, Value: string); overload; + end; + + // Event types + IJclEventParamInfo = interface + ['{7DAD5229-46EA-11D5-B0C0-4854E825F345}'] + function GetFlags: TParamFlags; + function GetName: string; + function GetRecSize: Integer; + function GetTypeName: string; + function GetParam: Pointer; + + property Flags: TParamFlags read GetFlags; + property Name: string read GetName; + property RecSize: Integer read GetRecSize; + property TypeName: string read GetTypeName; + property Param: Pointer read GetParam; + end; + + TJclEventParamInfo = class(TInterfacedObject, IJclEventParamInfo) + private + FParam: Pointer; + public + constructor Create(const AParam: Pointer); + { IJclEventParamInfo } + function GetFlags: TParamFlags; + function GetName: string; + function GetRecSize: Integer; + function GetTypeName: string; + function GetParam: Pointer; + property Flags: TParamFlags read GetFlags; + property Name: string read GetName; + property RecSize: Integer read GetRecSize; + property TypeName: string read GetTypeName; + property Param: Pointer read GetParam; + end; + + IJclEventTypeInfo = interface(IJclTypeInfo) + ['{7DAD522A-46EA-11D5-B0C0-4854E825F345}'] + function GetMethodKind: TMethodKind; + function GetParameterCount: Integer; + function GetParameters(const ParamIdx: Integer): IJclEventParamInfo; + function GetResultTypeName: string; + + property MethodKind: TMethodKind read GetMethodKind; + property ParameterCount: Integer read GetParameterCount; + property Parameters[const ParamIdx: Integer]: IJclEventParamInfo + read GetParameters; + property ResultTypeName: string read GetResultTypeName; + end; + + TJclEventTypeInfo = class(TJclTypeInfo, IJclBaseInfo, IJclTypeInfo, IJclEventTypeInfo) + public + { IJclBaseInfo } + procedure WriteTo(const Dest: IJclInfoWriter); override; + procedure DeclarationTo(const Dest: IJclInfoWriter); override; + { IJclEventTypeInfo } + function GetMethodKind: TMethodKind; + function GetParameterCount: Integer; + function GetParameters(const ParamIdx: Integer): IJclEventParamInfo; + function GetResultTypeName: string; + property MethodKind: TMethodKind read GetMethodKind; + property ParameterCount: Integer read GetParameterCount; + property Parameters[const ParamIdx: Integer]: IJclEventParamInfo + read GetParameters; + property ResultTypeName: string read GetResultTypeName; + end; + + // Interface types + IJclInterfaceTypeInfo = interface(IJclTypeInfo) + ['{7DAD522B-46EA-11D5-B0C0-4854E825F345}'] + function GetParent: IJclInterfaceTypeInfo; + function GetFlags: TIntfFlagsBase; + function GetGUID: TGUID; + function GetPropertyCount: Integer; + function GetUnitName: string; + + property Parent: IJclInterfaceTypeInfo read GetParent; + property Flags: TIntfFlagsBase read GetFlags; + property GUID: TGUID read GetGUID; + property PropertyCount: Integer read GetPropertyCount; + property UnitName: string read GetUnitName; + end; + + TJclInterfaceTypeInfo = class(TJclTypeInfo, IJclBaseInfo, IJclTypeInfo, + IJclInterfaceTypeInfo) + public + { IJclBaseInfo } + procedure WriteTo(const Dest: IJclInfoWriter); override; + procedure DeclarationTo(const Dest: IJclInfoWriter); override; + { IJclInterfaceTypeInfo } + function GetParent: IJclInterfaceTypeInfo; + function GetFlags: TIntfFlagsBase; + function GetGUID: TGUID; + function GetPropertyCount: Integer; + function GetUnitName: string; + property Parent: IJclInterfaceTypeInfo read GetParent; + property Flags: TIntfFlagsBase read GetFlags; + property GUID: TGUID read GetGUID; + property PropertyCount: Integer read GetPropertyCount; + end; + + // Int64 types + IJclInt64TypeInfo = interface(IJclValueTypeInfo) + ['{7DAD522C-46EA-11D5-B0C0-4854E825F345}'] + function GetMinValue: Int64; + function GetMaxValue: Int64; + + property MinValue: Int64 read GetMinValue; + property MaxValue: Int64 read GetMaxValue; + end; + + TJclInt64TypeInfo = class(TJclTypeInfo, IJclBaseInfo, IJclTypeInfo, + IJclValueTypeInfo, IJclInt64TypeInfo) + public + { IJclBaseInfo } + procedure WriteTo(const Dest: IJclInfoWriter); override; + procedure DeclarationTo(const Dest: IJclInfoWriter); override; + { IJclValueInfo } + function SaveValueToString(AnObj: TObject; const PropName: string): string; + procedure LoadValueFromString(AnObj: TObject; const PropName, Value: string); + { IJclInt64TypeInfo } + function GetMinValue: Int64; + function GetMaxValue: Int64; + property MinValue: Int64 read GetMinValue; + property MaxValue: Int64 read GetMaxValue; + end; + + // Dynamic array types + IJclDynArrayTypeInfo = interface(IJclTypeInfo) + ['{7DAD522E-46EA-11D5-B0C0-4854E825F345}'] + function GetElementSize: Longint; + function GetElementType: IJclTypeInfo; + function GetElementsNeedCleanup: Boolean; + function GetVarType: Integer; + function GetUnitName: string; + + property ElementSize: Longint read GetElementSize; + property ElementType: IJclTypeInfo read GetElementType; + property ElementsNeedCleanup: Boolean read GetElementsNeedCleanup; + property VarType: Integer read GetVarType; + property UnitName: string read GetUnitName; + end; + + TJclDynArrayTypeInfo = class(TJclTypeInfo, IJclBaseInfo, IJclTypeInfo, + IJclDynArrayTypeInfo) + public + { IJclBaseInfo } + procedure WriteTo(const Dest: IJclInfoWriter); override; + procedure DeclarationTo(const Dest: IJclInfoWriter); override; + { IJclDynArrayTypeInfo } + function GetElementSize: Longint; + function GetElementType: IJclTypeInfo; + function GetElementsNeedCleanup: Boolean; + function GetVarType: Integer; + function GetUnitName: string; + property ElementSize: Longint read GetElementSize; + property ElementType: IJclTypeInfo read GetElementType; + property ElementsNeedCleanup: Boolean read GetElementsNeedCleanup; + property VarType: Integer read GetVarType; + end; + + EJclRTTIError = class(EJclError); + +function JclTypeInfo(ATypeInfo: PTypeInfo): IJclTypeInfo; + +// Enumeration types +const + PREFIX_CUT_LOWERCASE = 255; + PREFIX_CUT_EQUAL = 254; + + MaxPrefixCut = 250; + +function JclEnumValueToIdent(TypeInfo: PTypeInfo; const Value): string; + +function JclGenerateEnumType(const TypeName: ShortString; + const Literals: array of string): PTypeInfo; +function JclGenerateEnumTypeBasedOn(const TypeName: ShortString; + BaseType: PTypeInfo; const PrefixCut: Byte): PTypeInfo; +function JclGenerateSubRange(BaseType: PTypeInfo; const TypeName: string; + const MinValue, MaxValue: Integer): PTypeInfo; + + +// Integer types +function JclStrToTypedInt(Value: string; TypeInfo: PTypeInfo): Integer; +function JclTypedIntToStr(Value: Integer; TypeInfo: PTypeInfo): string; + +// Sets +function JclSetToList(TypeInfo: PTypeInfo; const Value; const WantBrackets: Boolean; const WantRanges: Boolean; + const Strings: TStrings): string; +function JclSetToStr(TypeInfo: PTypeInfo; const Value; const WantBrackets: Boolean = False; + const WantRanges: Boolean = False): string; +procedure JclStrToSet(TypeInfo: PTypeInfo; var SetVar; const Value: string); +procedure JclIntToSet(TypeInfo: PTypeInfo; var SetVar; const Value: Integer); +function JclSetToInt(TypeInfo: PTypeInfo; const SetVar): Integer; +function JclGenerateSetType(BaseType: PTypeInfo; const TypeName: ShortString): PTypeInfo; + +// User generated type info managment +procedure RemoveTypeInfo(TypeInfo: PTypeInfo); + +// Is/As hooking +function JclIsClass(const AnObj: TObject; const AClass: TClass): Boolean; +function JclIsClassByName(const AnObj: TObject; const AClass: TClass): Boolean; + +// returns all properties of type string (kind = tkLString or kind = tkUString when Unicode is enabled) +function GetStringPropList(TypeInfo: PTypeInfo; out PropList: PPropList): Integer; + +// returns all object properties +function GetObjectProperties(AnObj: TObject; Recurse: Boolean = False): IJclObjPropInfoArray; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysConst, + {$ELSE ~HAS_UNITSCOPE} + SysConst, + {$ENDIF ~HAS_UNITSCOPE} + JclLogic, JclResources, JclStrings, JclSysUtils; + +//=== { TJclInfoWriter } ===================================================== + +constructor TJclInfoWriter.Create(const AWrap: Integer); +begin + inherited Create; + Wrap := AWrap; +end; + +destructor TJclInfoWriter.Destroy; +begin + if CurLine <> '' then + Writeln(''); + inherited Destroy; +end; + +function TJclInfoWriter.GetWrap: Integer; +begin + Result := FWrap; +end; + +procedure TJclInfoWriter.SetWrap(const Value: Integer); +begin + FWrap := Value; +end; + +procedure TJclInfoWriter.DoWrap; +const + WrapChars : TSetOfAnsiChar = [#0..' ', '-']; +var + TmpLines: TStringList; + I: Integer; + TmpLines2: TStringList; + EndedInCRLF: Boolean; + LineBreakLength: Integer; +begin + LineBreakLength := Length(NativeLineBreak); + EndedInCRLF := Copy(CurLine, Length(CurLine) - LineBreakLength + 1, LineBreakLength) = NativeLineBreak; + TmpLines := TStringList.Create; + try + TmpLines.Text := CurLine; + TmpLines2 := TStringList.Create; + try + I := TmpLines.Count-1; + if not EndedInCRLF then + Dec(I); + while I >= 0 do + begin + TmpLines[I] := StringOfChar(' ', 2 * IndentLevel) + TmpLines[I]; + if (Wrap > 0) and (Length(TmpLines[I]) > Wrap) then + begin + TmpLines2.Text := WrapText( + TmpLines[I], + NativeLineBreak + StringOfChar(' ', 2 * (IndentLevel+1)), + WrapChars, + Wrap); + TmpLines.Delete(I); + TmpLines.Insert(I, Copy(TmpLines2.Text, 1, + Length(TmpLines2.Text) - 2)); + end; + Dec(I); + end; + CurLine := TmpLines.Text; + if not EndedInCRLF then + Delete(FCurLine, Length(FCurLine) - LineBreakLength + 1, LineBreakLength); + finally + TmpLines2.Free; + end; + finally + TmpLines.Free; + end; +end; + +procedure TJclInfoWriter.DoWriteCompleteLines; +var + CRLFPos: Integer; +begin + CRLFPos := StrLastPos(NativeLineBreak, CurLine); + if CRLFPos > 0 then + begin + PrimWrite(Copy(CurLine, 1, CRLFPos-1)); + Delete(FCurLine, 1, CRLFPos+1); + end; +end; + +procedure TJclInfoWriter.Indent; +begin + IndentLevel := IndentLevel + 1; +end; + +procedure TJclInfoWriter.Outdent; +begin + IndentLevel := IndentLevel - 1; +end; + +procedure TJclInfoWriter.Write(const S: string); +begin + CurLine := CurLine + S; + DoWrap; + DoWriteCompleteLines; +end; + +procedure TJclInfoWriter.Writeln(const S: string); +begin + Write(S + NativeLineBreak); +end; + +//=== { TJclInfoStringsWriter } ============================================== + +constructor TJclInfoStringsWriter.Create(const AStrings: TStrings; + const AWrap: Integer); +begin + inherited Create(AWrap); + FStrings := AStrings; +end; + +procedure TJclInfoStringsWriter.PrimWrite(const S: string); +begin + Strings.Add(S); +end; + +//=== { TJclTypeInfo } ======================================================= + +constructor TJclTypeInfo.Create(ATypeInfo: PTypeInfo); +begin + inherited Create; + FTypeInfo := ATypeInfo; + FTypeData := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}TypInfo.GetTypeData(ATypeInfo); +end; + +function TJclTypeInfo.GetName: string; +begin + Result := string(TypeInfo.Name); +end; + +function TJclTypeInfo.GetTypeData: PTypeData; +begin + Result := FTypeData; +end; + +function TJclTypeInfo.GetTypeInfo: PTypeInfo; +begin + Result := FTypeInfo; +end; + +function TJclTypeInfo.GetTypeKind: TTypeKind; +begin + Result := TypeInfo.Kind; +end; + +procedure TJclTypeInfo.WriteTo(const Dest: IJclInfoWriter); +begin + Dest.Writeln(LoadResString(@RsRTTIName) + Name); + Dest.Writeln(LoadResString(@RsRTTITypeKind) + JclEnumValueToIdent(System.TypeInfo(TTypeKind), + TypeInfo.Kind)); + Dest.Writeln(Format(LoadResString(@RsRTTITypeInfoAt), [TypeInfo])); +end; + +procedure TJclTypeInfo.DeclarationTo(const Dest: IJclInfoWriter); +begin + Dest.Write(Format(LoadResString(@RsDeclarationFormat), [Name])); +end; + +//=== { TJclOrdinalTypeInfo } ================================================ + +function TJclOrdinalTypeInfo.GetOrdinalType: TOrdType; +begin + Result := TypeData.OrdType; +end; + +procedure TJclOrdinalTypeInfo.LoadValueFromString(AnObj: TObject; + const PropName, Value: string); +begin + SetOrdProp(AnObj, PropName, StrToInt(Value)); +end; + +procedure TJclOrdinalTypeInfo.WriteTo(const Dest: IJclInfoWriter); +begin + inherited WriteTo(Dest); + Dest.Writeln(LoadResString(@RsRTTIOrdinalType) + + JclEnumValueToIdent(System.TypeInfo(TOrdType), TypeData.OrdType)); +end; + +function TJclOrdinalTypeInfo.SaveValueToString(AnObj: TObject; + const PropName: string): string; +begin + Result := IntToStr(GetOrdProp(AnObj, PropName)); +end; + +//=== { TJclOrdinalRangeTypeInfo } =========================================== + +function TJclOrdinalRangeTypeInfo.GetMinValue: Int64; +begin + if OrdinalType = otULong then + Result := Longword(TypeData.MinValue) + else + Result := TypeData.MinValue; +end; + +function TJclOrdinalRangeTypeInfo.GetMaxValue: Int64; +begin + if OrdinalType = otULong then + Result := Longword(TypeData.MaxValue) + else + Result := TypeData.MaxValue; +end; + +procedure TJclOrdinalRangeTypeInfo.WriteTo(const Dest: IJclInfoWriter); +begin + inherited WriteTo(Dest); + Dest.Writeln(LoadResString(@RsRTTIMinValue) + IntToStr(MinValue)); + Dest.Writeln(LoadResString(@RsRTTIMaxValue) + IntToStr(MaxValue)); +end; + +procedure TJclOrdinalRangeTypeInfo.DeclarationTo(const Dest: IJclInfoWriter); +const + cRange = '..'; +begin + Dest.Write(Name + ' = '); + if TypeInfo.Kind in [tkChar, tkWChar] then + begin + if (MinValue < Ord(' ')) or (MinValue > Ord('~')) then + Dest.Write('#' + IntToStr(MinValue) + cRange) + else + Dest.Write('''' + Chr(Byte(MinValue)) + '''' + cRange); + if (MaxValue < Ord(' ')) or (MaxValue > Ord('~')) then + Dest.Write('#' + IntToStr(MaxValue)) + else + Dest.Write('''' + Chr(Byte(MaxValue)) + ''''); + end + else + Dest.Write(IntToStr(MinValue) + '..' + IntToStr(MaxValue)); + Dest.Writeln('; // ' + JclEnumValueToIdent(System.TypeInfo(TOrdType), TypeData.OrdType)); +end; + +//=== { TJclEnumerationTypeInfo } ============================================ + +function TJclEnumerationTypeInfo.GetBaseType: IJclEnumerationTypeInfo; +begin + if TypeData.BaseType{$IFDEF BORLAND}^{$ENDIF} = TypeInfo then + Result := Self + else + Result := TJclEnumerationTypeInfo.Create(TypeData.BaseType{$IFDEF BORLAND}^{$ENDIF}); +end; + +function TJclEnumerationTypeInfo.GetNames(const I: Integer): string; +var + Base: IJclEnumerationTypeInfo; + Idx: Integer; + P: ^ShortString; +begin + Base := BaseType; + Idx := I; + P := @Base.TypeData.NameList; + while Idx <> 0 do + begin + Inc(TJclAddr(P), Length(P^) + 1); + Dec(Idx); + end; + Result := string(P^); +end; + +function TJclEnumerationTypeInfo.GetUnitName: string; +var + I: Integer; + P: ^ShortString; +begin + if BaseType.TypeInfo = TypeInfo then + begin + I := MaxValue - MinValue; + P := @TypeData.NameList; + while I >= 0 do + begin + Inc(TJclAddr(P), Length(P^) + 1); + Dec(I); + end; + Result := string(P^); + end + else + Result := string(TypeData.NameList); +end; + +function TJclEnumerationTypeInfo.IndexOfName(const Name: string): Integer; +begin + Result := MaxValue; + while (Result >= MinValue) and + not AnsiSameText(Name, Names[Result]) do + Dec(Result); + if Result < MinValue then + Result := -1; +end; + +procedure TJclEnumerationTypeInfo.LoadValueFromString(AnObj: TObject; + const PropName, Value: string); +begin + SetEnumProp(AnObj, PropName, Value); +end; + +procedure TJclEnumerationTypeInfo.WriteTo(const Dest: IJclInfoWriter); +var + Idx: Integer; + Prefix: string; +begin + inherited WriteTo(Dest); + Dest.Writeln(LoadResString(@RsRTTIUnitName) + GetUnitName); + Dest.Write(LoadResString(@RsRTTINameList)); + Prefix := '('; + for Idx := MinValue to MaxValue do + begin + Dest.Write(Prefix + Names[Idx]); + Prefix := ', '; + end; + Dest.Writeln(')'); +end; + +function TJclEnumerationTypeInfo.SaveValueToString(AnObj: TObject; + const PropName: string): string; +begin + Result := GetEnumProp(AnObj, PropName); +end; + +procedure TJclEnumerationTypeInfo.DeclarationTo(const Dest: IJclInfoWriter); +var + Prefix: string; + I: Integer; +begin + if Name[1] <> '.' then + Dest.Write(Name + ' = '); + if BaseType.TypeInfo = TypeInfo then + begin + Dest.Write('('); + Prefix := ''; + for I := MinValue to MaxValue do + begin + Dest.Write(Prefix + Names[I]); + Prefix := ', '; + end; + Dest.Write(')'); + end + else + Dest.Write(Names[MinValue] + ' .. ' + Names[MaxValue]); + if Name[1] <> '.' then + begin + Dest.Write('; // ' + JclEnumValueToIdent(System.TypeInfo(TOrdType), TypeData.OrdType)); + Dest.Writeln(''); + end; +end; + +//=== { TJclSetTypeInfo } ==================================================== + +function TJclSetTypeInfo.GetBaseType: IJclOrdinalTypeInfo; +begin + Result := JclTypeInfo(TypeData.CompType{$IFDEF BORLAND}^{$ENDIF}) as IJclOrdinalTypeInfo; +end; + +procedure TJclSetTypeInfo.LoadValueFromString(AnObj: TObject; const PropName, + Value: string); +begin + SetSetProp(AnObj, PropName, Value); +end; + +procedure TJclSetTypeInfo.GetAsList(const Value; const WantRanges: Boolean; + const Strings: TStrings); +var + BaseInfo: IJclOrdinalRangeTypeInfo; + FirstBit: Byte; + LastBit: Byte; + Bit: Byte; + StartBit: Integer; + + procedure AddRange; + var + FirstOrdNum: Int64; + LastOrdNum: Int64; + OrdNum: Int64; + begin + FirstOrdNum := (StartBit - FirstBit) + BaseInfo.MinValue; + LastOrdNum := (Bit - 1 - FirstBit) + BaseInfo.MinValue; + if WantRanges and (LastOrdNum <> FirstOrdNum) then + begin + if BaseInfo.TypeKind = tkEnumeration then + Strings.Add((BaseInfo as IJclEnumerationTypeInfo).Names[FirstOrdNum] + + ' .. ' + (BaseInfo as IJclEnumerationTypeInfo).Names[LastOrdNum]) + else + Strings.Add(IntToStr(FirstOrdNum) + ' .. ' + IntToStr(LastOrdNum)); + end + else + begin + OrdNum := FirstOrdNum; + while OrdNum <= LastOrdNum do + begin + if BaseInfo.TypeKind = tkEnumeration then + Strings.Add((BaseInfo as IJclEnumerationTypeInfo).Names[OrdNum]) + else + Strings.Add(IntToStr(OrdNum)); + Inc(OrdNum); + end; + end; + end; + +begin + BaseInfo := BaseType as IJclOrdinalRangeTypeInfo; + FirstBit := BaseInfo.MinValue mod 8; + LastBit := BaseInfo.MaxValue - (BaseInfo.MinValue - FirstBit); + Bit := FirstBit; + StartBit := -1; + Strings.BeginUpdate; + try + while Bit <= LastBit do + begin + if TestBitBuffer(Value, Bit) then + begin + if StartBit = -1 then + StartBit := Bit; + end + else + begin + if StartBit <> -1 then + begin + AddRange; + StartBit := -1; + end; + end; + Inc(Bit); + end; + if StartBit <> -1 then + AddRange; + finally + Strings.EndUpdate; + end; +end; + +procedure TJclSetTypeInfo.SetAsList(out Value; const Strings: TStrings); +var + BaseInfo: IJclOrdinalRangeTypeInfo; + FirstBit: Integer; + I: Integer; + FirstIdent: string; + LastIdent: string; + RangePos: Integer; + FirstOrd: Int64; + LastOrd: Int64; + CurOrd: Integer; + + procedure ClearValue; + var + LastBit: Integer; + ByteCount: Integer; + begin + LastBit := BaseInfo.MaxValue - BaseInfo.MinValue + 1 + FirstBit; + ByteCount := (LastBit - FirstBit) div 8; + if LastBit mod 8 <> 0 then + Inc(ByteCount); + ResetMemory(Value, ByteCount); + end; + +begin + BaseInfo := BaseType as IJclOrdinalRangeTypeInfo; + FirstBit := BaseInfo.MinValue mod 8; + ClearValue; + Strings.BeginUpdate; + try + for I := 0 to Strings.Count - 1 do + begin + if Trim(Strings[I]) <> '' then + begin + FirstIdent := Trim(Strings[I]); + RangePos := Pos('..', FirstIdent); + if RangePos > 0 then + begin + LastIdent := Trim(StrRestOf(FirstIdent, RangePos + 2)); + FirstIdent := Trim(Copy(FirstIdent, 1, RangePos - 1)); + end + else + LastIdent := FirstIdent; + if BaseInfo.TypeKind = tkEnumeration then + begin + FirstOrd := (BaseInfo as IJclEnumerationTypeInfo).IndexOfName(FirstIdent); + LastOrd := (BaseInfo as IJclEnumerationTypeInfo).IndexOfName(LastIdent); + if FirstOrd = -1 then + raise EJclRTTIError.CreateResFmt(@RsRTTIUnknownIdentifier, [FirstIdent]); + if LastOrd = -1 then + raise EJclRTTIError.CreateResFmt(@RsRTTIUnknownIdentifier, [LastIdent]); + end + else + begin + FirstOrd := StrToInt(FirstIdent); + LastOrd := StrToInt(LastIdent); + end; + Dec(FirstOrd, BaseInfo.MinValue); + Dec(LastOrd, BaseInfo.MinValue); + for CurOrd := FirstOrd to LastOrd do + SetBitBuffer(Value, CurOrd + FirstBit); + end; + end; + finally + Strings.EndUpdate; + end; +end; + +procedure TJclSetTypeInfo.WriteTo(const Dest: IJclInfoWriter); +begin + inherited WriteTo(Dest); + Dest.Writeln(LoadResString(@RsRTTIBasedOn)); + Dest.Indent; + try + BaseType.WriteTo(Dest); + finally + Dest.Outdent; + end; +end; + +function TJclSetTypeInfo.SaveValueToString(AnObj: TObject; + const PropName: string): string; +begin + Result := GetSetProp(AnObj, PropName); +end; + +procedure TJclSetTypeInfo.DeclarationTo(const Dest: IJclInfoWriter); +var + Base: IJclOrdinalTypeInfo; + BaseEnum: IJclEnumerationTypeInfo; +begin + if Name[1] <> '.' then + Dest.Write(Name + ' = set of '); + Base := BaseType; + + if Base.Name[1] = '.' then + begin + if Base.QueryInterface(IJclEnumerationTypeInfo, BaseEnum) = S_OK then + BaseEnum.DeclarationTo(Dest) + else + Dest.Write(LoadResString(@RsRTTITypeError)); + end + else + Dest.Write(Base.Name); + if Name[1] <> '.' then + begin + Dest.Write('; // ' + JclEnumValueToIdent(System.TypeInfo(TOrdType), TypeData.OrdType)); + Dest.Writeln(''); + end; +end; + +//=== { TJclFloatTypeInfo } ================================================== + +function TJclFloatTypeInfo.GetFloatType: TFloatType; +begin + Result := TypeData.FloatType; +end; + +procedure TJclFloatTypeInfo.LoadValueFromString(AnObj: TObject; const PropName, + Value: string); +begin + SetFloatProp(AnObj, PropName, StrToFloat(Value)); +end; + +procedure TJclFloatTypeInfo.WriteTo(const Dest: IJclInfoWriter); +begin + inherited WriteTo(Dest); + Dest.Writeln(LoadResString(@RsRTTIFloatType) + + JclEnumValueToIdent(System.TypeInfo(TFloatType), TypeData.FloatType)); +end; + +function TJclFloatTypeInfo.SaveValueToString(AnObj: TObject; + const PropName: string): string; +begin + Result := FloatToStr(GetFloatProp(AnObj, PropName)); +end; + +procedure TJclFloatTypeInfo.DeclarationTo(const Dest: IJclInfoWriter); +var + S: string; + FT: TFloatType; +begin + FT := FloatType; + S := StrRestOf(JclEnumValueToIdent(System.TypeInfo(TFloatType), FT), 3); + Dest.Writeln(Name + ' = type ' + S + ';'); +end; + +//=== { TJclStringTypeInfo } ================================================= + +function TJclStringTypeInfo.GetMaxLength: Integer; +begin + if FTypeInfo^.Kind = tkString then + Result := TypeData.MaxLength + else + Result := 0; +end; + +procedure TJclStringTypeInfo.LoadValueFromString(AnObj: TObject; const PropName, + Value: string); +begin + SetStrProp(AnObj, PropName, Value); +end; + +procedure TJclStringTypeInfo.WriteTo(const Dest: IJclInfoWriter); +begin + inherited WriteTo(Dest); + if FTypeInfo^.Kind = tkString then + Dest.Writeln(LoadResString(@RsRTTIMaxLen) + IntToStr(MaxLength)); +end; + +function TJclStringTypeInfo.SaveValueToString(AnObj: TObject; + const PropName: string): string; +begin + Result := GetStrProp(AnObj, PropName); +end; + +procedure TJclStringTypeInfo.DeclarationTo(const Dest: IJclInfoWriter); +begin + if Name[1] <> '.' then + Dest.Write(Name + ' = '); + + {$IFDEF SUPPORTS_UNICODE_STRING} + if FTypeInfo^.Kind = tkUString then + Dest.Write('UnicodeString') + else + {$ENDIF SUPPORTS_UNICODE_STRING} + if FTypeInfo^.Kind = tkLString then + Dest.Write('AnsiString') + else + if FTypeInfo^.Kind = tkWString then + Dest.Write('WideString') + else + Dest.Write('string[' + IntToStr(MaxLength) + ']'); + + if Name[1] <> '.' then + Dest.Writeln(';'); +end; + +//=== { TJclPropInfo } ======================================================= + +constructor TJclPropInfo.Create(const APropInfo: PPropInfo); +begin + inherited Create; + FPropInfo := APropInfo; +end; + +function TJclPropInfo.GetPropInfo: PPropInfo; +begin + Result := FPropInfo; +end; + +function TJclPropInfo.GetPropType: IJclTypeInfo; +begin + Result := JclTypeInfo(PropInfo.PropType{$IFDEF BORLAND}^{$ENDIF}); +end; + +function TJclPropInfo.GetReader: Pointer; +begin + Result := PropInfo.GetProc; +end; + +function TJclPropInfo.GetWriter: Pointer; +begin + Result := PropInfo.SetProc; +end; + +function TJclPropInfo.GetStoredProc: Pointer; +begin + Result := PropInfo.StoredProc; +end; + +function TJclPropInfo.GetIndex: Integer; +begin + Result := PropInfo.Index; +end; + +function TJclPropInfo.GetDefault: Longint; +begin + Result := PropInfo.Default; +end; + +function TJclPropInfo.GetNameIndex: Smallint; +begin + Result := PropInfo.NameIndex; +end; + +function TJclPropInfo.GetName: string; +begin + Result := string(PropInfo.Name); +end; + +function TJclPropInfo.GetSpecKind(const Value: TJclAddr): TJclPropSpecKind; +var + P: Integer; +begin + {$IFDEF CPU32} + P := Value shr 24; + {$ENDIF CPU32} + {$IFDEF CPU64} + P := Value shr 56; + {$ENDIF CPU64} + case P of + $00: + if Value < 2 then + Result := pskConstant + else + Result := pskStaticMethod; + $FE: + Result := pskVirtualMethod; + $FF: + Result := pskField; + else + Result := pskStaticMethod; + end; +end; + +function TJclPropInfo.GetSpecValue(const Value: TJclAddr): TJclAddr; +begin + case GetSpecKind(Value) of + pskStaticMethod, pskConstant: + Result := Value; + pskVirtualMethod: + {$IFDEF CPU32} + Result := Value and $0000FFFF; + {$ENDIF CPU32} + {$IFDEF CPU64} + Result := Value and $0000FFFFFFFFFFFF; + {$ENDIF CPU64} + pskField: + {$IFDEF CPU32} + Result := Value and $00FFFFFF; + {$ENDIF CPU32} + {$IFDEF CPU64} + Result := Value and $00FFFFFFFFFFFFFF; + {$ENDIF CPU64} + else + Result := 0; + end; +end; + +function TJclPropInfo.GetReaderType: TJclPropSpecKind; +begin + Result := GetSpecKind(TJclAddr(Reader)); +end; + +function TJclPropInfo.GetWriterType: TJclPropSpecKind; +begin + Result := GetSpecKind(TJclAddr(Writer)); +end; + +function TJclPropInfo.GetStoredType: TJclPropSpecKind; +begin + Result := GetSpecKind(TJclAddr(StoredProc)); +end; + +function TJclPropInfo.GetReaderValue: TJclAddr; +begin + Result := GetSpecValue(TJclAddr(Reader)); +end; + +function TJclPropInfo.GetWriterValue: TJclAddr; +begin + Result := GetSpecValue(TJclAddr(Writer)); +end; + +function TJclPropInfo.GetStoredValue: TJclAddr; +begin + Result := GetSpecValue(TJclAddr(StoredProc)); +end; + +function TJclPropInfo.IsStored(const AInstance: TObject): Boolean; +begin + Result := IsStoredProp(AInstance, FPropInfo); +end; + +procedure TJclPropInfo.LoadValueFromString(AnObj: TObject; const Value: string); +var + APropType: IJclTypeInfo; + AValueInfo: IJclValueTypeInfo; +begin + APropType := PropType; + if Supports(APropType, IJclValueTypeInfo, AValueInfo) then + AValueInfo.LoadValueFromString(AnObj, Name, Value) + else + raise EJclRTTIError.CreateResFmt(@RsRTTINoStringValue, [Name, APropType.Name]); +end; + +function TJclPropInfo.SaveValueToString(AnObj: TObject): string; +var + APropType: IJclTypeInfo; + AValueInfo: IJclValueTypeInfo; +begin + APropType := PropType; + if Supports(APropType, IJclValueTypeInfo, AValueInfo) then + Result := AValueInfo.SaveValueToString(AnObj, Name) + else + raise EJclRTTIError.CreateResFmt(@RsRTTINoStringValue, [Name, APropType.Name]); +end; + +function TJclPropInfo.HasDefault: Boolean; +begin + Result := Longword(Default) <> $80000000; +end; + +function TJclPropInfo.HasIndex: Boolean; +begin + Result := Longword(Index) <> $80000000; +end; + +//=== { TJclObjPropInfo } ==================================================== + +constructor TJclObjPropInfo.Create(const APropInfo: PPropInfo; + const APrefix: string; AInstance: TObject); +begin + inherited Create(APropInfo); + FPrefix := APrefix; + FInstance := AInstance; +end; + +function TJclObjPropInfo.GetAbsoluteName: string; +begin + if FPrefix <> '' then + Result := FPrefix + '.' + Name + else + Result := Name; +end; + +function TJclObjPropInfo.GetInstance: TObject; +begin + Result := FInstance; +end; + +function TJclObjPropInfo.IsStored: Boolean; +begin + Result := IsStoredProp(FInstance, Name); +end; + +procedure TJclObjPropInfo.LoadValueFromString(const Value: string); +begin + LoadValueFromString(FInstance, Value); +end; + +function TJclObjPropInfo.SaveValueToString: string; +begin + Result := SaveValueToString(FInstance); +end; + +//=== { TJclClassTypeInfo } ================================================== + +function TJclClassTypeInfo.GetClassRef: TClass; +begin + Result := TypeData.ClassType; +end; + +function TJclClassTypeInfo.GetParent: IJclClassTypeInfo; +begin + if (TypeData.ParentInfo <> nil) {$IFDEF BORLAND}and (TypeData.ParentInfo^ <> nil){$ENDIF BORLAND} then + Result := JclTypeInfo(TypeData.ParentInfo{$IFDEF BORLAND}^{$ENDIF}) as IJclClassTypeInfo + else + Result := nil; +end; + +function TJclClassTypeInfo.GetTotalPropertyCount: Integer; +begin + Result := TypeData.PropCount; +end; + +function TJclClassTypeInfo.GetPropertyCount: Integer; +var + PropData: ^TPropData; +begin + PropData := @TypeData.UnitName; + Inc(TJclAddr(PropData), 1 + Length(GetUnitName)); + Result := PropData.PropCount; +end; + +function TJclClassTypeInfo.GetProperties(const PropIdx: Integer): IJclPropInfo; +var + PropData: ^TPropData; + Prop: PPropInfo; + Idx: Integer; + RecSize: Integer; +begin + PropData := @TypeData.UnitName; + Inc(TJclAddr(PropData), 1 + Length(GetUnitName)); + if PropIdx + 1 > PropData.PropCount then + Result := Parent.Properties[PropIdx - PropData.PropCount] + else + begin + Prop := PPropInfo(PropData); + Inc(TJclAddr(Prop), 2); + if PropIdx > 0 then + begin + RecSize := SizeOf(TPropInfo) - SizeOf(ShortString); + Idx := PropIdx; + while Idx > 0 do + begin + Inc(TJclAddr(Prop), RecSize); + Inc(TJclAddr(Prop), 1 + PByte(Prop)^); + Dec(Idx); + end; + end; + Result := TJclPropInfo.Create(Prop); + end; +end; + +function TJclClassTypeInfo.GetPropNames(const Name: string): IJclPropInfo; +var + PropInfo: PPropInfo; +begin + PropInfo := GetPropInfo(TypeInfo, Name); + if PropInfo <> nil then + Result := TJclPropInfo.Create(PropInfo) + else + Result := nil; +end; + +function TJclClassTypeInfo.GetUnitName: string; +begin + Result := string(TypeData.UnitName); +end; + +procedure TJclClassTypeInfo.LoadValueFromString(AnObj: TObject; const PropName, + Value: string); +var + DotPos: Integer; + BaseObj: TObject; + Prefix: string; + ValueInfo: IJclValueTypeInfo; +begin + DotPos := CharPos(PropName, '.'); + if DotPos = 0 then + raise EJclRTTIError.CreateResFmt(@RsRTTINoStringValue, [PropName, Name]); + Prefix := StrLeft(PropName, DotPos - 1); + BaseObj := GetObjectProp(AnObj, Prefix); + if Assigned(BaseObj) and Supports(PropNames[Prefix], IJclValueTypeInfo, ValueInfo) then + ValueInfo.LoadValueFromString(BaseObj, StrRestOf(PropName, DotPos + 1), Value) + else + raise EJclRTTIError.CreateResFmt(@RsRTTINoStringValue, [PropName, Name]); +end; + +function TJclClassTypeInfo.SaveValueToString(AnObj: TObject; + const PropName: string): string; +var + DotPos: Integer; + BaseObj: TObject; + Prefix: string; + ValueInfo: IJclValueTypeInfo; +begin + DotPos := CharPos(PropName, '.'); + if DotPos = 0 then + raise EJclRTTIError.CreateResFmt(@RsRTTINoStringValue, [PropName, Name]); + Prefix := StrLeft(PropName, DotPos - 1); + BaseObj := GetObjectProp(AnObj, Prefix); + if Assigned(BaseObj) and Supports(PropNames[Prefix], IJclValueTypeInfo, ValueInfo) then + Result := ValueInfo.SaveValueToString(BaseObj, StrRestOf(PropName, DotPos + 1)) + else + raise EJclRTTIError.CreateResFmt(@RsRTTINoStringValue, [PropName, Name]); +end; + +procedure TJclClassTypeInfo.WriteTo(const Dest: IJclInfoWriter); +const + cFmt1 = '[%s %d]'; + cFmt2 = '[%s %s $%p]'; + cFmt3 = '[%s=%s]'; + cFmt4 = '[%s=%s $%p]'; +var + I: Integer; + Prop: IJclPropInfo; +begin + inherited WriteTo(Dest); + Dest.Writeln(LoadResString(@RsRTTIClassName) + ClassRef.ClassName); + Dest.Writeln(LoadResString(@RsRTTIParent) + Parent.ClassRef.ClassName); + Dest.Writeln(LoadResString(@RsRTTIUnitName) + GetUnitName); + Dest.Writeln(LoadResString(@RsRTTIPropCount) + IntToStr(PropertyCount) + ' (' + + IntToStr(TotalPropertyCount) + ')'); + Dest.Indent; + try + for I := 0 to PropertyCount-1 do + begin + Prop := Properties[I]; + Dest.Writeln(Prop.Name + ': ' + Prop.PropType.Name); + Dest.Indent; + try + if Prop.HasIndex then + Dest.Writeln(Format(cFmt1, [LoadResString(@RsRTTIIndex), Prop.Index])); + if Prop.HasDefault then + Dest.Writeln(Format(cFmt1, [LoadResString(@RsRTTIDefault), Prop.Default])); + case Prop.ReaderType of + pskStaticMethod: + Dest.Writeln(Format(cFmt2, [LoadResString(@RsRTTIPropRead), LoadResString(@RsRTTIStaticMethod), + Pointer(Prop.ReaderValue)])); + pskField: + Dest.Writeln(Format(cFmt2, [LoadResString(@RsRTTIPropRead), LoadResString(@RsRTTIField), + Pointer(Prop.ReaderValue)])); + pskVirtualMethod: + Dest.Writeln(Format(cFmt2, [LoadResString(@RsRTTIPropRead), LoadResString(@RsRTTIVirtualMethod), + Pointer(Prop.ReaderValue)])); + end; + case Prop.WriterType of + pskStaticMethod: + Dest.Writeln(Format(cFmt2, [LoadResString(@RsRTTIPropWrite), LoadResString(@RsRTTIStaticMethod), + Pointer(Prop.WriterValue)])); + pskField: + Dest.Writeln(Format(cFmt2, [LoadResString(@RsRTTIPropWrite), LoadResString(@RsRTTIField), + Pointer(Prop.WriterValue)])); + pskVirtualMethod: + Dest.Writeln(Format(cFmt2, [LoadResString(@RsRTTIPropWrite), LoadResString(@RsRTTIVirtualMethod), + Pointer(Prop.WriterValue)])); + end; + case Prop.StoredType of + pskConstant: + if Boolean(Prop.StoredValue) then + Dest.Writeln(Format(cFmt3, [LoadResString(@RsRTTIPropStored), LoadResString(@RsRTTITrue)])) + else + Dest.Writeln(Format(cFmt3, [LoadResString(@RsRTTIPropStored), LoadResString(@RsRTTIFalse)])); + pskStaticMethod: + Dest.Writeln(Format(cFmt4, [LoadResString(@RsRTTIPropStored), LoadResString(@RsRTTIStaticMethod), + Pointer(Prop.StoredValue)])); + pskField: + Dest.Writeln(Format(cFmt4, [LoadResString(@RsRTTIPropStored), LoadResString(@RsRTTIField), + Pointer(Prop.StoredValue)])); + pskVirtualMethod: + Dest.Writeln(Format(cFmt4, [LoadResString(@RsRTTIPropStored), LoadResString(@RsRTTIVirtualMethod), + Pointer(Prop.StoredValue)])); + end; + finally + Dest.Outdent; + end; + end; + finally + Dest.Outdent; + end; +end; + +procedure TJclClassTypeInfo.DeclarationTo(const Dest: IJclInfoWriter); +var + IntfTbl: PInterfaceTable; + I: Integer; + Prop: IJclPropInfo; +begin + if (Parent <> nil) and + not AnsiSameText(Parent.Name, 'TObject') then + begin + Dest.Write(Name + ' = class(' + Parent.Name); + IntfTbl := ClassRef.GetInterfaceTable; + if IntfTbl <> nil then + for I := 0 to IntfTbl.EntryCount-1 do + {$IFDEF FPC}if IntfTbl.Entries[I].IID <> nil then{$ENDIF FPC} + Dest.Write(', [''' + JclGUIDToString(IntfTbl.Entries[I].IID{$IFDEF FPC}^{$ENDIF}) + ''']'); + Dest.Writeln(') // unit ' + GetUnitName); + end + else + Dest.Writeln(Name + ' = class // unit ' + GetUnitName); + if PropertyCount > 0 then + begin + Dest.Writeln('published'); + Dest.Indent; + try + for I := 0 to PropertyCount-1 do + begin + Prop := Properties[I]; + Dest.Write('property ' + Prop.Name + ': ' + Prop.PropType.Name); + if Prop.HasIndex then + Dest.Write(Format(' index %d', [Prop.Index])); + + case Prop.ReaderType of + pskStaticMethod: + Dest.Write(Format(' read [static method $%p]', [Pointer(Prop.ReaderValue)])); + pskField: + Dest.Write(Format(' read [field $%p]', [Pointer(Prop.ReaderValue)])); + pskVirtualMethod: + Dest.Write(Format(' read [virtual method $%p]', [Pointer(Prop.ReaderValue)])); + end; + + case Prop.WriterType of + pskStaticMethod: + Dest.Write(Format(' write [static method $%p]', [Pointer(Prop.WriterValue)])); + pskField: + Dest.Write(Format(' write [field $%p]', [Pointer(Prop.WriterValue)])); + pskVirtualMethod: + Dest.Write(Format(' write [virtual method $%p]', [Pointer(Prop.WriterValue)])); + end; + + case Prop.StoredType of + pskConstant: + if Boolean(Prop.StoredValue) then + Dest.Write(' stored = True') + else + Dest.Write(' stored = False'); + pskStaticMethod: + Dest.Write(Format(' stored = [static method $%p]', [Pointer(Prop.StoredValue)])); + pskField: + Dest.Write(Format(' stored = [field $%p]', [Pointer(Prop.StoredValue)])); + pskVirtualMethod: + Dest.Write(Format(' stored = [virtual method $%p]', [Pointer(Prop.StoredValue)])); + end; + if Prop.HasDefault then + Dest.Write(' default ' + IntToStr(Prop.Default)); + Dest.Writeln(';'); + end; + finally + Dest.Outdent; + end; + end; + Dest.Writeln('end;'); +end; + +//=== { TJclObjClassTypeInfo } =============================================== + +constructor TJclObjClassTypeInfo.Create(const ATypeInfo: PTypeInfo; + const APrefix: string; AInstance: TObject); +begin + inherited Create(ATypeInfo); + FPrefix := APrefix; + FInstance := AInstance; +end; + +function TJclObjClassTypeInfo.GetInstance: TObject; +begin + Result := FInstance; +end; + +function TJclObjClassTypeInfo.GetObjProperties( + const PropIdx: Integer): IJclObjPropInfo; +var + PropData: ^TPropData; + Prop: PPropInfo; + Idx: Integer; + RecSize: Integer; +begin + PropData := @TypeData.UnitName; + Inc(TJclAddr(PropData), 1 + Length(GetUnitName)); + Prop := PPropInfo(PropData); + Inc(TJclAddr(Prop), 2); + if PropIdx > 0 then + begin + RecSize := SizeOf(TPropInfo) - SizeOf(ShortString); + Idx := PropIdx; + while Idx > 0 do + begin + Inc(TJclAddr(Prop), RecSize); + Inc(TJclAddr(Prop), 1 + PByte(Prop)^); + Dec(Idx); + end; + end; + Result := TJclObjPropInfo.Create(Prop, FPrefix, FInstance); +end; + +function TJclObjClassTypeInfo.GetObjPropNames( + const Name: string): IJclObjPropInfo; +var + PropInfo: PPropInfo; + DotPos: Integer; + Prefix, Suffix: string; + SubClassTypeInfo: IJclObjClassTypeInfo; + AInstance: TObject; +begin + DotPos := CharPos(Name, '.'); + if DotPos > 0 then + begin + Prefix := StrLeft(Name, DotPos - 1); + Suffix := StrRestOf(Name, DotPos + 1); + PropInfo := GetPropInfo(TypeInfo, Prefix); + if (PropInfo <> nil) and (PropInfo.PropType^.Kind = tkClass) then + begin + if FPrefix <> '' then + Prefix := FPrefix + '.' + Prefix; + AInstance := GetObjectProp(FInstance, PropInfo); + if AInstance <> nil then + begin + SubClassTypeInfo := TJclObjClassTypeInfo.Create(PropInfo.PropType{$IFDEF BORLAND}^{$ENDIF}, Prefix, AInstance); + Result := SubClassTypeInfo.ObjPropNames[Suffix]; + end + else + Result := nil; + end + else + Result := nil; + end + else + begin + PropInfo := GetPropInfo(TypeInfo, Name); + if PropInfo <> nil then + Result := TJclObjPropInfo.Create(PropInfo, FPrefix, FInstance) + else + Result := nil; + end; +end; + +procedure TJclObjClassTypeInfo.LoadValueFromString(const PropName, + Value: string); +var + ObjPropInfo: IJclObjPropInfo; +begin + ObjPropInfo := GetObjPropNames(PropName); + if Assigned(ObjPropInfo) then + ObjPropInfo.LoadValueFromString(Value) + else + raise EJclRTTIError.CreateResFmt(@RsRTTINoStringValue, [Name, PropName]); +end; + +function TJclObjClassTypeInfo.SaveValueToString(const PropName: string): string; +var + ObjPropInfo: IJclObjPropInfo; +begin + ObjPropInfo := GetObjPropNames(PropName); + if Assigned(ObjPropInfo) then + Result := ObjPropInfo.SaveValueToString + else + raise EJclRTTIError.CreateResFmt(@RsRTTINoStringValue, [Name, PropName]); +end; + +//=== { TJclEventParamInfo } ================================================= + +constructor TJclEventParamInfo.Create(const AParam: Pointer); +begin + inherited Create; + FParam := AParam; +end; + +function TJclEventParamInfo.GetFlags: TParamFlags; +type + PParamFlags = ^TParamFlags; +begin + Result := PParamFlags(Param)^; +end; + +function TJclEventParamInfo.GetName: string; +var + PName: PShortString; +begin + PName := Param; + Inc(TJclAddr(PName)); + Result := string(PName^); +end; + +function TJclEventParamInfo.GetRecSize: Integer; +begin + Result := 3 + Length(Name) + Length(TypeName); +end; + +function TJclEventParamInfo.GetTypeName: string; +var + PName: PShortString; +begin + PName := Param; + Inc(TJclAddr(PName)); + Inc(TJclAddr(PName), PByte(PName)^ + 1); + Result := string(PName^); +end; + +function TJclEventParamInfo.GetParam: Pointer; +begin + Result := FParam; +end; + +//=== { TJclEventTypeInfo } ================================================== + +function TJclEventTypeInfo.GetMethodKind: TMethodKind; +begin + Result := TypeData.MethodKind; +end; + +function TJclEventTypeInfo.GetParameterCount: Integer; +begin + Result := TypeData.ParamCount; +end; + +function TJclEventTypeInfo.GetParameters(const ParamIdx: Integer): IJclEventParamInfo; +var + I: Integer; + Param: Pointer; +begin + Result := nil; + Param := @TypeData.ParamList[0]; + I := ParamIdx; + while I >= 0 do + begin + Result := TJclEventParamInfo.Create(Param); + Inc(TJclAddr(Param), Result.RecSize); + Dec(I); + end; +end; + +function TJclEventTypeInfo.GetResultTypeName: string; +var + LastParam: IJclEventParamInfo; + ResPtr: PShortString; +begin + if MethodKind = mkFunction then + begin + if ParameterCount > 0 then + begin + LastParam := Parameters[ParameterCount-1]; + ResPtr := Pointer(TJclAddr(LastParam.Param) + TJclAddr(LastParam.RecSize)); + end + else + ResPtr := @TypeData.ParamList[0]; + Result := string(ResPtr^); + end + else + Result := ''; +end; + +procedure TJclEventTypeInfo.WriteTo(const Dest: IJclInfoWriter); +var + I: Integer; + Param: IJclEventParamInfo; + ParamFlags: TParamFlags; +begin + inherited WriteTo(Dest); + Dest.Writeln(LoadResString(@RsRTTIMethodKind) + + JclEnumValueToIdent(System.TypeInfo(TMethodKind), TypeData.MethodKind)); + Dest.Writeln(LoadResString(@RsRTTIParamCount) + IntToStr(ParameterCount)); + Dest.Indent; + try + for I := 0 to ParameterCount-1 do + begin + if I > 0 then + Dest.Writeln(''); + Param := Parameters[I]; + ParamFlags := Param.Flags; + Dest.Writeln(LoadResString(@RsRTTIName) + Param.Name); + Dest.Writeln(LoadResString(@RsRTTIType) + Param.TypeName); + Dest.Writeln(LoadResString(@RsRTTIFlags) + + JclSetToStr(System.TypeInfo(TParamFlags), ParamFlags, True, False)); + end; + finally + Dest.Outdent; + end; + if MethodKind = mkFunction then + Dest.Writeln(LoadResString(@RsRTTIReturnType) + ResultTypeName); +end; + +procedure TJclEventTypeInfo.DeclarationTo(const Dest: IJclInfoWriter); +var + Prefix: string; + I: Integer; + Param: IJclEventParamInfo; +begin + Dest.Write(Name + ' = '); + if MethodKind = mkFunction then + Dest.Write('function') + else + Dest.Write('procedure'); + Prefix := '('; + for I := 0 to ParameterCount-1 do + begin + Dest.Write(Prefix); + Prefix := '; '; + Param := Parameters[I]; + if pfVar in Param.Flags then + Dest.Write(LoadResString(@RsRTTIVar)) + else + if pfConst in Param.Flags then + Dest.Write(LoadResString(@RsRTTIConst)) + else + if pfOut in Param.Flags then + Dest.Write(LoadResString(@RsRTTIOut)); + Dest.Write(Param.Name); + if Param.TypeName <> '' then + begin + Dest.Write(': '); + if pfArray in Param.Flags then + Dest.Write(LoadResString(@RsRTTIArrayOf)); + if AnsiSameText(Param.TypeName, 'TVarRec') and (pfArray in Param.Flags) then + Dest.Write(TrimRight(LoadResString(@RsRTTIConst))) + else + Dest.Write(Param.TypeName); + end; + end; + if ParameterCount <> 0 then + Dest.Write(')'); + if MethodKind = mkFunction then + Dest.Write(': ' + ResultTypeName); + Dest.Writeln(' of object;'); +end; + +//=== { TJclInterfaceTypeInfo } ============================================== + +function TJclInterfaceTypeInfo.GetParent: IJclInterfaceTypeInfo; +begin + if (TypeData.IntfParent <> nil) {$IFDEF BORLAND}and (TypeData.IntfParent^ <> nil){$ENDIF BORLAND} then + Result := JclTypeInfo(TypeData.IntfParent{$IFDEF BORLAND}^{$ENDIF}) as IJclInterfaceTypeInfo + else + Result := nil; +end; + +function TJclInterfaceTypeInfo.GetFlags: TIntfFlagsBase; +begin + Result := TypeData.IntfFlags; +end; + +const + NullGUID: TGUID = '{00000000-0000-0000-0000-000000000000}'; + +function TJclInterfaceTypeInfo.GetGUID: TGUID; +begin + if ifHasGuid in Flags then + Result := TypeData.Guid + else + Result := NullGUID; +end; + +function TJclInterfaceTypeInfo.GetPropertyCount: Integer; +var + PropData: ^TPropData; +begin + PropData := @TypeData.IntfUnit; + Inc(TJclAddr(PropData), 1 + Length(GetUnitName)); + Result := PropData.PropCount; +end; + +function TJclInterfaceTypeInfo.GetUnitName: string; +begin + Result := string(TypeData.IntfUnit); +end; + +procedure TJclInterfaceTypeInfo.WriteTo(const Dest: IJclInfoWriter); +var + IntfFlags: TIntfFlagsBase; +begin + inherited WriteTo(Dest); + if ifHasGuid in Flags then + Dest.Writeln(LoadResString(@RsRTTIGUID) + JclGuidToString(GUID)); + IntfFlags := Flags; + Dest.Writeln(LoadResString(@RsRTTIFlags) + JclSetToStr(System.TypeInfo(TIntfFlagsBase), + IntfFlags, True, False)); + Dest.Writeln(LoadResString(@RsRTTIUnitName) + GetUnitName); + if Parent <> nil then + Dest.Writeln(LoadResString(@RsRTTIParent) + Parent.Name); + Dest.Writeln(LoadResString(@RsRTTIPropCount) + IntToStr(PropertyCount)); +end; + +procedure TJclInterfaceTypeInfo.DeclarationTo(const Dest: IJclInfoWriter); +begin + Dest.Write(Name + ' = '); + if ifDispInterface in Flags then + Dest.Write('dispinterface') + else + Dest.Write('interface'); + if (Parent <> nil) and not (ifDispInterface in Flags) and not + AnsiSameText(Parent.Name, 'IUnknown') then + Dest.Write('(' + Parent.Name + ')'); + Dest.Writeln(' // unit ' + GetUnitName); + Dest.Indent; + try + if ifHasGuid in Flags then + Dest.Writeln('[''' + JclGuidToString(GUID) + ''']'); + finally + Dest.Outdent; + Dest.Writeln('end;'); + end; +end; + +//=== { TJclInt64TypeInfo } ================================================== + +function TJclInt64TypeInfo.GetMinValue: Int64; +begin + Result := TypeData.MinInt64Value; +end; + +procedure TJclInt64TypeInfo.LoadValueFromString(AnObj: TObject; const PropName, + Value: string); +begin + SetInt64Prop(AnObj, PropName, StrToInt(Value)); +end; + +function TJclInt64TypeInfo.GetMaxValue: Int64; +begin + Result := TypeData.MaxInt64Value; +end; + +procedure TJclInt64TypeInfo.WriteTo(const Dest: IJclInfoWriter); +begin + inherited WriteTo(Dest); + Dest.Writeln(LoadResString(@RsRTTIMinValue) + IntToStr(MinValue)); + Dest.Writeln(LoadResString(@RsRTTIMaxValue) + IntToStr(MaxValue)); +end; + +function TJclInt64TypeInfo.SaveValueToString(AnObj: TObject; + const PropName: string): string; +begin + Result := IntToStr(GetInt64Prop(AnObj, PropName)); +end; + +procedure TJclInt64TypeInfo.DeclarationTo(const Dest: IJclInfoWriter); +begin + Dest.Writeln(Name + ' = ' + IntToStr(MinValue) + ' .. ' + IntToStr(MaxValue) + ';'); +end; + +//=== { TJclDynArrayTypeInfo } =============================================== + +function TJclDynArrayTypeInfo.GetElementSize: Longint; +begin + Result := TypeData.elSize; +end; + +function TJclDynArrayTypeInfo.GetElementType: IJclTypeInfo; +begin + if TypeData.elType = nil then + begin + if TypeData.elType2 <> nil then + Result := JclTypeInfo(TypeData.elType2^) + else + Result := nil; + end + else + Result := JclTypeInfo(TypeData.elType^); +end; + +function TJclDynArrayTypeInfo.GetElementsNeedCleanup: Boolean; +begin + Result := TypeData.elType <> nil; +end; + +function TJclDynArrayTypeInfo.GetVarType: Integer; +begin + Result := TypeData.varType; +end; + +function TJclDynArrayTypeInfo.GetUnitName: string; +begin + Result := string(TypeData.DynUnitName); +end; + +procedure TJclDynArrayTypeInfo.WriteTo(const Dest: IJclInfoWriter); +begin + inherited WriteTo(Dest); + Dest.Writeln(LoadResString(@RsRTTIElSize) + IntToStr(ElementSize)); + if ElementType = nil then + Dest.Writeln(LoadResString(@RsRTTIElType) + RsRTTITypeError) + else + if ElementType.Name[1] <> '.' then + Dest.Writeln(LoadResString(@RsRTTIElType) + ElementType.Name) + else + begin + Dest.Writeln(LoadResString(@RsRTTIElType)); + Dest.Indent; + try + ElementType.WriteTo(Dest); + finally + Dest.Outdent; + end; + end; + Dest.Write(LoadResString(@RsRTTIElNeedCleanup)); + if ElementsNeedCleanup then + Dest.Writeln(LoadResString(@RsRTTITrue)) + else + Dest.Writeln(LoadResString(@RsRTTIFalse)); + Dest.Writeln(LoadResString(@RsRTTIVarType) + IntToStr(VarType)); + Dest.Writeln(LoadResString(@RsRTTIUnitName) + GetUnitName); +end; + +procedure TJclDynArrayTypeInfo.DeclarationTo(const Dest: IJclInfoWriter); +begin + if Name[1] <> '.' then + Dest.Write(Name + ' = ' + LoadResString(@RsRTTIArrayOf)) + else + Dest.Write(LoadResString(@RsRTTIArrayOf)); + if ElementType = nil then + Dest.Write(LoadResString(@RsRTTITypeError)) + else + if ElementType.Name[1] = '.' then + ElementType.DeclarationTo(Dest) + else + Dest.Write(ElementType.Name); + if Name[1] <> '.' then + Dest.Writeln('; // Unit ' + GetUnitName); +end; + +//=== Typeinfo retrieval ===================================================== + +function JclTypeInfo(ATypeInfo: PTypeInfo): IJclTypeInfo; +begin + case ATypeInfo.Kind of + tkInteger, tkChar, tkWChar: + Result := TJclOrdinalRangeTypeInfo.Create(ATypeInfo); + tkEnumeration: + Result := TJclEnumerationTypeInfo.Create(ATypeInfo); + tkSet: + Result := TJclSetTypeInfo.Create(ATypeInfo); + tkFloat: + Result := TJclFloatTypeInfo.Create(ATypeInfo); + tkString, + tkLString, + {$IFDEF SUPPORTS_UNICODE_STRING} + tkUString, + {$ENDIF SUPPORTS_UNICODE_STRING} + tkWString: + Result := TJclStringTypeInfo.Create(ATypeInfo); + tkClass: + Result := TJclClassTypeInfo.Create(ATypeInfo); + tkMethod: + Result := TJclEventTypeInfo.Create(ATypeInfo); + tkInterface: + Result := TJclInterfaceTypeInfo.Create(ATypeInfo); + tkInt64: + Result := TJclInt64TypeInfo.Create(ATypeInfo); + tkDynArray: + Result := TJclDynArrayTypeInfo.Create(ATypeInfo); + else + Result := TJclTypeInfo.Create(ATypeInfo); + end; +end; + +//=== User generated type info managment ===================================== + +var + TypeList: TThreadList; + +type + PTypeItem = ^TTypeItem; + TTypeItem = record + TypeInfo: PTypeInfo; + RefCount: Integer; + end; + +procedure FreeTypeData(const TypeInfo: PTypeInfo); +var + TD: PTypeData; +begin + TD := GetTypeData(TypeInfo); + if TypeInfo.Kind = tkSet then + RemoveTypeInfo(TD^.CompType{$IFDEF BORLAND}^{$ENDIF}) + else + if (TypeInfo.Kind = tkEnumeration) and (TD^.BaseType{$IFDEF BORLAND}^{$ENDIF} <> TypeInfo) then + RemoveTypeInfo(GetTypeData(TypeInfo)^.BaseType{$IFDEF BORLAND}^{$ENDIF}); + FreeMem(GetTypeData(TypeInfo)^.BaseType); + FreeMem(TypeInfo); +end; + +procedure AddType(const TypeInfo: PTypeInfo); +var + Item: PTypeItem; +begin + New(Item); + try + Item.TypeInfo := TypeInfo; + Item.RefCount := 1; + TypeList.Add(Item); + except + Dispose(Item); + raise; + end; +end; + +procedure DeleteType(const TypeItem: PTypeItem); +begin + FreeTypeData(TypeItem.TypeInfo); + TypeList.Remove(TypeItem); + Dispose(TypeItem); +end; + +procedure DoRefType(const TypeInfo: PTypeInfo; Add: Integer); +var + I: Integer; + List: TList; +begin + List := TypeList.LockList; + try + I := List.Count-1; + while (I >= 0) and (PTypeItem(List[I]).TypeInfo <> TypeInfo) do + Dec(I); + if I > -1 then + Inc(PTypeItem(List[I]).RefCount, Add); + finally + TypeList.UnlockList; + end; +end; + +procedure ReferenceType(const TypeInfo: PTypeInfo); +begin + DoRefType(TypeInfo, 1); +end; + +procedure DeReferenceType(const TypeInfo: PTypeInfo); +begin + DoRefType(TypeInfo, -1); +end; + +procedure ClearInfoList; +var + L: TList; +begin + L := TypeList.LockList; + try + while L.Count > 0 do + RemoveTypeInfo(PTypeItem(L[L.Count-1])^.TypeInfo); + finally + TypeList.UnlockList; + end; +end; + +procedure NewInfoItem(const TypeInfo: PTypeInfo); +begin + TypeList.Add(TypeInfo); +end; + +procedure RemoveTypeInfo(TypeInfo: PTypeInfo); +var + I: Integer; + List: TList; + Item: PTypeItem; +begin + Item := nil; + List := TypeList.LockList; + try + I := List.Count-1; + while (I >= 0) and (PTypeItem(List[I]).TypeInfo <> TypeInfo) do + Dec(I); + if I > -1 then + Item := PTypeItem(List[I]); + finally + TypeList.UnlockList; + end; + if Item <> nil then + begin + Dec(Item.RefCount); + if Item.RefCount <= 0 then + DeleteType(Item); + end; +end; + +//=== Enumerations =========================================================== + +function JclEnumValueToIdent(TypeInfo: PTypeInfo; + const Value): string; +var + MinEnum: Integer; + MaxEnum: Integer; + EnumVal: Int64; + OrdType: TOrdType; +begin + OrdType := GetTypeData(TypeInfo).OrdType; + MinEnum := GetTypeData(TypeInfo).MinValue; + MaxEnum := GetTypeData(TypeInfo).MaxValue; + case OrdType of + otSByte: + EnumVal := Smallint(Value); + otUByte: + EnumVal := Byte(Value); + otSWord: + EnumVal := Shortint(Value); + otUWord: + EnumVal := Word(Value); + otSLong: + EnumVal := Integer(Value); + otULong: + EnumVal := Longword(Value); + else + EnumVal := 0; + end; + // Check range... + if (EnumVal < MinEnum) or (EnumVal > MaxEnum) then + Result := Format(LoadResString(@RsRTTIValueOutOfRange), + [LoadResString(@RsRTTIOrdinal) + IntToStr(EnumVal), + GetEnumName(TypeInfo, MinEnum), GetEnumName(TypeInfo, MaxEnum)]) + else + Result := GetEnumName(TypeInfo, EnumVal); +end; + +function JclGenerateEnumType(const TypeName: ShortString; + const Literals: array of string): PTypeInfo; +var + StringSize: Integer; + I: Integer; + TypeData: PTypeData; + CurName: PShortString; +begin + StringSize := 0; + for I := Low(Literals) to High(Literals) do + StringSize := StringSize + 1 + Length(Literals[I]); + Result := AllocMem(SizeOf(TTypeInfo) + SizeOf(TOrdType) + + (2*SizeOf(Integer)) + SizeOf(PPTypeInfo) + + StringSize + 1); + try + with Result^ do + begin + Kind := tkEnumeration; + Name := TypeName; + end; + TypeData := GetTypeData(Result); + TypeData^.BaseType := AllocMem(SizeOf(Pointer)); + if Length(Literals) < 256 then + TypeData^.OrdType := otUByte + else + if Length(Literals) < 65536 then + TypeData^.OrdType := otUWord + else + TypeData^.OrdType := otULong; + TypeData^.MinValue := 0; + TypeData^.MaxValue := Length(Literals)-1; + TypeData^.BaseType{$IFDEF BORLAND}^{$ENDIF} := Result; // No sub-range: basetype points to itself + CurName := @TypeData^.NameList; + for I := Low(Literals) to High(Literals) do + begin + CurName^ := ShortString(Literals[I]); + Inc(TJclAddr(CurName), Length(Literals[I])+1); + end; + CurName^ := ''; // Unit name unknown + AddType(Result); + except + try + ReallocMem(Result, 0); + except + Result := nil; + end; + raise; + end; +end; + +function JclGenerateEnumTypeBasedOn(const TypeName: ShortString; + BaseType: PTypeInfo; const PrefixCut: Byte): PTypeInfo; +var + BaseInfo: IJclTypeInfo; + BaseKind: TTypeKind; + Literals: array of string; + I: Integer; + S: string; +begin + BaseInfo := JclTypeInfo(BaseType); + BaseKind := BaseInfo.TypeKind; + if BaseInfo.TypeKind <> tkEnumeration then + raise EJclRTTIError.CreateResFmt(@RsRTTIInvalidBaseType, [BaseInfo.Name, + JclEnumValueToIdent(System.TypeInfo(TTypeKind), BaseKind)]); + with BaseInfo as IJclEnumerationTypeInfo do + begin + SetLength(Literals, MaxValue - MinValue + 1); + for I := MinValue to MaxValue do + begin + S := Names[I]; + if PrefixCut = PREFIX_CUT_LOWERCASE then + while (Length(S) > 0) and CharIsLower(S[1]) do + Delete(S, 1, 1); + if (PrefixCut > 0) and (PrefixCut < MaxPrefixCut) then + Delete(S, 1, PrefixCut); + if S = '' then + S := Names[I]; + Literals[I- MinValue] := S; + end; + if PrefixCut = PREFIX_CUT_EQUAL then + begin + S := Literals[High(Literals)]; + I := High(Literals)-1; + while (I >= 0) and (S > '') do + begin + while Copy(Literals[I], 1, Length(S)) <> S do + Delete(S, Length(S), 1); + Dec(I); + end; + if S > '' then + for I := Low(Literals) to High(Literals) do + begin + Literals[I] := StrRestOf(Literals[I], Length(S)); + if Literals[I] = '' then + Literals[I] := Names[I + MinValue]; + end; + end; + end; + Result := JclGenerateEnumType(TypeName, Literals); +end; + +function JclGenerateSubRange(BaseType: PTypeInfo; const TypeName: string; + const MinValue, MaxValue: Integer): PTypeInfo; +var + TypeData: PTypeData; +begin + Result := AllocMem(SizeOf(TTypeInfo) + SizeOf(TOrdType) + + (2*SizeOf(Integer)) + SizeOf(PPTypeInfo)); + try + with Result^ do + begin + Kind := BaseType^.Kind; + Name := ShortString(TypeName); + end; + TypeData := GetTypeData(Result); + TypeData^.OrdType := GetTypeData(BaseType)^.OrdType; + TypeData^.MinValue := MinValue; + TypeData^.MaxValue := MaxValue; + TypeData^.BaseType := AllocMem(SizeOf(Pointer)); + TypeData^.BaseType{$IFDEF BORLAND}^{$ENDIF} := BaseType; + AddType(Result); + except + try + ReallocMem(Result, 0); + except + Result := nil; + end; + raise; + end; + ReferenceType(BaseType); +end; + +//=== Integers =============================================================== + +function JclStrToTypedInt(Value: string; TypeInfo: PTypeInfo): Integer; +var + Conv: TIdentToInt; + HaveConversion: Boolean; + Info: IJclTypeInfo; + RangeInfo: IJclOrdinalRangeTypeInfo; + TmpVal: Int64; +begin + if TypeInfo <> nil then + Conv := FindIdentToInt(TypeInfo) + else + Conv := nil; + Result := 0; + HaveConversion := (@Conv <> nil) and Conv(Value, Result); + if not HaveConversion then + begin + if TypeInfo <> nil then + begin + Info := JclTypeInfo(TypeInfo); + if Info.QueryInterface(IJclOrdinalRangeTypeInfo, RangeInfo) <> S_OK then + RangeInfo := nil; + TmpVal := StrToInt64(Value); + if (RangeInfo <> nil) and ((TmpVal < RangeInfo.MinValue) or + (TmpVal > RangeInfo.MaxValue)) then + raise EConvertError.CreateResFmt(@RsRTTIValueOutOfRange, + [Value, IntToStr(RangeInfo.MinValue), IntToStr(RangeInfo.MaxValue)]); + Result := Integer(TmpVal); + end + else + Result := StrToInt(Value) + end; +end; + +function JclTypedIntToStr(Value: Integer; TypeInfo: PTypeInfo): string; +var + Conv: TIntToIdent; + HaveConversion: Boolean; +begin + if TypeInfo <> nil then + Conv := FindIntToIdent(TypeInfo) + else + Conv := nil; + Result := ''; + HaveConversion := (@Conv <> nil) and Conv(Value, Result); + if not HaveConversion then + begin + if (TypeInfo <> nil) and (GetTypeData(TypeInfo).OrdType = otULong) then + Result := IntToStr(Int64(Cardinal(Value))) + else + Result := IntToStr(Value) + end; +end; + +//=== Sets =================================================================== + +function JclSetToList(TypeInfo: PTypeInfo; const Value; const WantBrackets: Boolean; const WantRanges: Boolean; + const Strings: TStrings): string; +var + SetType: IJclSetTypeInfo; + I: Integer; +begin + I := Strings.Count; + Result := ''; + SetType := JclTypeInfo(TypeInfo) as IJclSetTypeInfo; + SetType.GetAsList(Value, WantRanges, Strings); + for I := I to Strings.Count - 1 do + begin + if Result <> '' then + Result := Result + ', ' + Strings[I] + else + Result := Result + Strings[I]; + end; + if WantBrackets then + Result := '[' + Result + ']'; +end; + +function JclSetToStr(TypeInfo: PTypeInfo; const Value; const WantBrackets: Boolean; const WantRanges: Boolean): string; +var + Dummy: TStringList; +begin + Dummy := TStringList.Create; + try + Result := JclSetToList(TypeInfo, Value, WantBrackets, WantRanges, Dummy); + finally + Dummy.Free; + end; +end; + +procedure JclStrToSet(TypeInfo: PTypeInfo; var SetVar; const Value: string); +var + SetInfo: IJclSetTypeInfo; + S: TStringList; +begin + SetInfo := JclTypeInfo(TypeInfo) as IJclSetTypeInfo; + S := TStringList.Create; + try + StrToStrings(Value, ',', S); + if S.Count > 0 then + begin + if S[0][1] = '[' then + begin + S[0] := Copy(S[0], 2, Length(S[0])); + S[S.Count-1] := Copy(S[S.Count-1], 1, + Length(S[S.Count-1]) - 1); + end; + end; + SetInfo.SetAsList(SetVar, S); + finally + S.Free; + end; +end; + +procedure JclIntToSet(TypeInfo: PTypeInfo; var SetVar; const Value: Integer); +var + BitShift: Integer; + TmpInt64: Int64; + EnumMin: Integer; + EnumMax: Integer; + ResBytes: Integer; + CompType: PTypeInfo; +begin + CompType := GetTypeData(TypeInfo).CompType{$IFDEF BORLAND}^{$ENDIF}; + EnumMin := GetTypeData(CompType).MinValue; + BitShift := EnumMin mod 8; + TmpInt64 := Longword(Value) shl BitShift; + EnumMax := GetTypeData(CompType).MaxValue; + ResBytes := (EnumMax div 8) - (EnumMin div 8) + 1; + Move(TmpInt64, SetVar, ResBytes); +end; + +function JclSetToInt(TypeInfo: PTypeInfo; const SetVar): Integer; +var + BitShift: Integer; + TmpInt64: Int64; + EnumMin: Integer; + EnumMax: Integer; + ResBytes: Integer; + CompType: PTypeInfo; +begin + CompType := GetTypeData(TypeInfo).CompType{$IFDEF BORLAND}^{$ENDIF}; + EnumMin := GetTypeData(CompType).MinValue; + EnumMax := GetTypeData(CompType).MaxValue; + ResBytes := (EnumMax div 8) - (EnumMin div 8) + 1; + BitShift := EnumMin mod 8; + if (EnumMax - EnumMin) > 32 then + raise EJclRTTIError.CreateResFmt(@RsRTTISetValueOutOfRange, + [IntToStr(EnumMax - EnumMin) + ' ' + LoadResString(@RsRTTIBits)]); + Result := 0; + TmpInt64 := 0; + Move(SetVar, TmpInt64, ResBytes + 1); + TmpInt64 := TmpInt64 shr BitShift; + Move(TmpInt64, Result, ResBytes); +end; + +function JclGenerateSetType(BaseType: PTypeInfo; + const TypeName: ShortString): PTypeInfo; +var + TypeData: PTypeData; + ValCount: Integer; +begin + Result := AllocMem(SizeOf(TTypeInfo) + SizeOf(TOrdType) + SizeOf(PPTypeInfo)); + try + with Result^ do + begin + Kind := tkSet; + Name := TypeName; + end; + with GetTypeData(BaseType)^ do + ValCount := MaxValue - MinValue + (MinValue mod 8); + TypeData := GetTypeData(Result); + case ValCount of + 0..8: + TypeData^.OrdType := otUByte; + 9..16: + TypeData^.OrdType := otUWord; + 17..32: + TypeData^.OrdType := otULong; + 33..64: + Byte(TypeData^.OrdType) := 8; + 65..128: + Byte(TypeData^.OrdType) := 16; + 129..256: + Byte(TypeData^.OrdType) := 32; + else + Byte(TypeData^.OrdType) := 255; + end; + {$IFDEF BORLAND} + TypeData^.CompType := AllocMem(SizeOf(Pointer)); + TypeData^.CompType^ := BaseType; + {$ENDIF BORLAND} + {$IFDEF FPC} + TypeData^.CompType := BaseType; + {$ENDIF FPC} + AddType(Result); + except + try + ReallocMem(Result, 0); + except + Result := nil; + end; + raise; + end; + ReferenceType(BaseType); +end; + +//=== Is/As hooking ========================================================== + +// Copied from System.pas (_IsClass function) + +function JclIsClass(const AnObj: TObject; const AClass: TClass): Boolean; +asm + {$IFDEF CPU32} + // 32 --> EAX AnObj + // EDX AClass + // <-- AL Result + TEST EAX,EAX + JE @@exit +@@loop: + MOV EAX,[EAX] + CMP EAX,EDX + JE @@success + MOV EAX,[EAX].vmtParent + TEST EAX,EAX + {$ENDIF CPU32} + {$IFDEF CPU64} + // 64 --> RCX AnObj + // RDX AClass + // <-- AL Result + MOV RAX,RCX + TEST RAX,RAX + JE @@exit +@@loop: + MOV RAX,[RAX] + CMP RAX,RDX + JE @@success + MOV RAX,[RAX].vmtParent + TEST RAX,RAX + {$ENDIF CPU64} + JNE @@loop + JMP @@exit +@@success: + MOV AL,1 +@@exit: +end; + +function JclIsClassByName(const AnObj: TObject; const AClass: TClass): Boolean; +var + CurClass: TClass; + CurClass2: TClass; +begin + Result := AnObj <> nil; + if Result then + begin + CurClass := AnObj.ClassType; + Result := False; + while not Result and (CurClass <> nil) do + begin + Result := CurClass.ClassNameIs(AClass.ClassName); + if not Result then + CurClass := CurClass.ClassParent; + end; + if CurClass <> nil then + CurClass := CurClass.ClassParent; + CurClass2 := AClass.ClassParent; + while Result and (CurClass <> nil) and (CurClass2 <> nil) do + begin + Result := CurClass.ClassNameIs(CurClass2.ClassName); + if Result then + begin + CurClass := CurClass.ClassParent; + CurClass2 := CurClass2.ClassParent; + end; + end; + Result := Result and (CurClass = CurClass2); + end; +end; + +function JclAsClass(const AnObj: TObject; const AClass: TClass): TObject; +begin + if (AnObj = nil) or (AnObj is AClass) then + Result := AnObj + else + raise EInvalidCast.CreateRes(@SInvalidCast); +end; + +function GetStringPropList(TypeInfo: PTypeInfo; out PropList: PPropList): Integer; +begin + PropList := nil; + {$IFDEF SUPPORTS_UNICODE_STRING} + Result := GetPropList(TypeInfo, [tkUString], PropList); + if Result > 0 then + begin + GetMem(PropList, Result * SizeOf(PropList[0])); + Result := GetPropList(TypeInfo, [tkUString], PropList); + end; + {$ELSE ~SUPPORTS_UNICODE_STRING} + Result := GetPropList(TypeInfo, [tkLString], PropList); + if Result > 0 then + begin + GetMem(PropList, Result * SizeOf(PropList[0])); + Result := GetPropList(TypeInfo, [tkLString], PropList); + end; + {$ENDIF ~SUPPORTS_UNICODE_STRING} +end; + +function GetObjectProperties(AnObj: TObject; Recurse: Boolean): IJclObjPropInfoArray; + + procedure InternalGetObjectProperties(var PropCount: SizeInt; Current: TObject; const Prefix: string); + var + I, C: Integer; + PropList: PPropList; + SubObject: TObject; + AbsoluteName: string; + begin + if Assigned(Current) then + begin + C := GetPropList(Current, PropList); + try + for I := 0 to C - 1 do + begin + if PropCount = Length(Result) then + SetLength(Result, Length(Result) * 2); + Result[PropCount] := TJclObjPropInfo.Create(PropList[I], Prefix, Current); + Inc(PropCount); + + if Recurse and (PropList[I]^.PropType^.Kind = tkClass) then + begin + SubObject := GetObjectProp(Current, PropList[I]); + if Prefix <> '' then + AbsoluteName := string(Prefix + '.' + string(PropList[I]^.Name)) + else + AbsoluteName := string(PropList[I]^.Name); + InternalGetObjectProperties(PropCount, SubObject, AbsoluteName); + end; + end; + finally + if C > 0 then + FreeMem(PropList); + end; + end; + end; + +var + PropCount: SizeInt; +begin + PropCount := 0; + SetLength(Result, 16); + InternalGetObjectProperties(PropCount, AnObj, ''); + SetLength(Result, PropCount); +end; + +initialization + TypeList := TThreadList.Create; + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + ClearInfoList; + FreeAndNil(TypeList); + +end. diff --git a/3rdParty/JCL/source/common/JclResources.pas b/3rdParty/JCL/source/common/JclResources.pas index 07507632..64092e44 100644 --- a/3rdParty/JCL/source/common/JclResources.pas +++ b/3rdParty/JCL/source/common/JclResources.pas @@ -1,2106 +1,2107 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is JclResources.pas. } -{ } -{ The Initial Developer of the Original Code is Marcel van Brakel. } -{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. All rights reserved. } -{ } -{ Contributors: } -{ Alexei Koudinov } -{ Barry Kelly } -{ Flier Lu (flier) } -{ Florent Ouchet (outchy) } -{ Jean-Fabien Connault (cycocrew) } -{ Marcel Bestebroer } -{ Marcel van Brakel } -{ Matthias Thoma (mthoma) } -{ Peter Friese } -{ Petr Vones (pvones) } -{ Raymond Alexander (rayspostbox3) } -{ Robert Marquardt (marquardt) } -{ Robert Rossmair (rrossmair) } -{ Scott Price (scottprice) } -{ Uwe Schuster (uschuster) } -{ } -{**************************************************************************************************} -{ } -{ Unit which provides a central place for all resource strings used in the JCL } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -unit JclResources; - -{$I jcl.inc} - -interface - -{$IFDEF UNITVERSIONING} -uses - JclUnitVersioning; -{$ENDIF UNITVERSIONING} - -//=== JclBase ================================================================ -resourcestring - RsCantConvertAddr64 = 'The address %s%.16x cannot be converted to 32 bit'; - RsEReplacementChar = 'Failed to get ANSI replacement character'; - -//=== JclCharsets ============================================================ -resourcestring - RsENoCharset = 'No matching charset'; - -//=== JclCIL ================================================================= -resourcestring - RsInstructionStreamInvalid = 'Invalid IL instruction stream'; - RsCILNamenop = 'nop'; - RsCILNamebreak = 'break'; - RsCILNameldarg0 = 'ldarg.0'; - RsCILNameldarg1 = 'ldarg.1'; - RsCILNameldarg2 = 'ldarg.2'; - RsCILNameldarg3 = 'ldarg.3'; - RsCILNameldloc0 = 'ldloc.0'; - RsCILNameldloc1 = 'ldloc.1'; - RsCILNameldloc2 = 'ldloc.2'; - RsCILNameldloc3 = 'ldloc.3'; - RsCILNamestloc0 = 'stloc.0'; - RsCILNamestloc1 = 'stloc.1'; - RsCILNamestloc2 = 'stloc.2'; - RsCILNamestloc3 = 'stloc.3'; - RsCILNameldargs = 'ldarg.s'; - RsCILNameldargas = 'ldarga.s'; - RsCILNamestargs = 'starg.s'; - RsCILNameldlocs = 'ldloc.s'; - RsCILNameldlocas = 'ldloca.s'; - RsCILNamestlocs = 'stloc.s'; - RsCILNameldnull = 'ldnull'; - RsCILNameldci4m1 = 'ldc.i4.m1'; - RsCILNameldci40 = 'ldc.i4.0'; - RsCILNameldci41 = 'ldc.i4.1'; - RsCILNameldci42 = 'ldc.i4.2'; - RsCILNameldci43 = 'ldc.i4.3'; - RsCILNameldci44 = 'ldc.i4.4'; - RsCILNameldci45 = 'ldc.i4.5'; - RsCILNameldci46 = 'ldc.i4.6'; - RsCILNameldci47 = 'ldc.i4.7'; - RsCILNameldci48 = 'ldc.i4.8'; - RsCILNameldci4s = 'ldc.i4.s'; - RsCILNameldci4 = 'ldc.i4'; - RsCILNameldci8 = 'ldc.i8'; - RsCILNameldcr4 = 'ldc.r4'; - RsCILNameldcr8 = 'ldc.r8'; - RsCILNameunused1 = 'unused'; - RsCILNamedup = 'dup'; - RsCILNamepop = 'pop'; - RsCILNamejmp = 'jmp'; - RsCILNamecall = 'call'; - RsCILNamecalli = 'calli'; - RsCILNameret = 'ret'; - RsCILNamebrs = 'br.s'; - RsCILNamebrfalses = 'brfalse.s'; - RsCILNamebrtrues = 'brtrue.s'; - RsCILNamebeqs = 'beq.s'; - RsCILNamebges = 'bge.s'; - RsCILNamebgts = 'bgt.s'; - RsCILNamebles = 'ble.s'; - RsCILNameblts = 'blt.s'; - RsCILNamebneuns = 'bne.un.s'; - RsCILNamebgeuns = 'bge.un.s'; - RsCILNamebgtuns = 'bgt.un.s'; - RsCILNamebleuns = 'ble.un.s'; - RsCILNamebltuns = 'blt.un.s'; - RsCILNamebr = 'br'; - RsCILNamebrfalse = 'brfalse'; - RsCILNamebrtrue = 'brtrue'; - RsCILNamebeq = 'beq'; - RsCILNamebge = 'bge'; - RsCILNamebgt = 'bgt'; - RsCILNameble = 'ble'; - RsCILNameblt = 'blt'; - RsCILNamebneun = 'bne.un'; - RsCILNamebgeun = 'bge.un'; - RsCILNamebgtun = 'bgt.un'; - RsCILNamebleun = 'ble.un'; - RsCILNamebltun = 'blt.un'; - RsCILNameswitch = 'switch'; - RsCILNameldindi1 = 'ldind.i1'; - RsCILNameldindu1 = 'ldind.u1'; - RsCILNameldindi2 = 'ldind.i2'; - RsCILNameldindu2 = 'ldind.u2'; - RsCILNameldindi4 = 'ldind.i4'; - RsCILNameldindu4 = 'ldind.u4'; - RsCILNameldindi8 = 'ldind.i8'; - RsCILNameldindi = 'ldind.i'; - RsCILNameldindr4 = 'ldind.r4'; - RsCILNameldindr8 = 'ldind.r8'; - RsCILNameldindref = 'ldind.ref'; - RsCILNamestindref = 'stind.ref'; - RsCILNamestindi1 = 'stind.i1'; - RsCILNamestindi2 = 'stind.i2'; - RsCILNamestindi4 = 'stind.i4'; - RsCILNamestindi8 = 'stind.i8'; - RsCILNamestindr4 = 'stind.r4'; - RsCILNamestindr8 = 'stind.r8'; - RsCILNameadd = 'add'; - RsCILNamesub = 'sub'; - RsCILNamemul = 'mul'; - RsCILNamediv = 'div'; - RsCILNamedivun = 'div.un'; - RsCILNamerem = 'rem'; - RsCILNameremun = 'rem.un'; - RsCILNameand = 'and'; - RsCILNameor = 'or'; - RsCILNamexor = 'xor'; - RsCILNameshl = 'shl'; - RsCILNameshr = 'shr'; - RsCILNameshrun = 'shr.un'; - RsCILNameneg = 'neg'; - RsCILNamenot = 'not'; - RsCILNameconvi1 = 'conv.i1'; - RsCILNameconvi2 = 'conv.i2'; - RsCILNameconvi4 = 'conv.i4'; - RsCILNameconvi8 = 'conv.i8'; - RsCILNameconvr4 = 'conv.r4'; - RsCILNameconvr8 = 'conv.r8'; - RsCILNameconvu4 = 'conv.u4'; - RsCILNameconvu8 = 'conv.u8'; - RsCILNamecallvirt = 'callvirt'; - RsCILNamecpobj = 'cpobj'; - RsCILNameldobj = 'ldobj'; - RsCILNameldstr = 'ldstr'; - RsCILNamenewobj = 'newobj'; - RsCILNamecastclass = 'castclass'; - RsCILNameisinst = 'isinst'; - RsCILNameconvrun = 'conv.r.un'; - RsCILNameunused2 = 'unused'; - RsCILNameunused3 = 'unused'; - RsCILNameunbox = 'unbox'; - RsCILNamethrow = 'throw'; - RsCILNameldfld = 'ldfld'; - RsCILNameldflda = 'ldflda'; - RsCILNamestfld = 'stfld'; - RsCILNameldsfld = 'ldsfld'; - RsCILNameldsflda = 'ldsflda'; - RsCILNamestsfld = 'stsfld'; - RsCILNamestobj = 'stobj'; - RsCILNameconvovfi1un = 'conv.ovf.i1.un'; - RsCILNameconvovfi2un = 'conv.ovf.i2.un'; - RsCILNameconvovfi4un = 'conv.ovf.i4.un'; - RsCILNameconvovfi8un = 'conv.ovf.i8.un'; - RsCILNameconvovfu1un = 'conv.ovf.u1.un'; - RsCILNameconvovfu2un = 'conv.ovf.u2.un'; - RsCILNameconvovfu4un = 'conv.ovf.u4.un'; - RsCILNameconvovfu8un = 'conv.ovf.u8.un'; - RsCILNameconvovfiun = 'conv.ovf.i.un'; - RsCILNameconvovfuun = 'conv.ovf.u.un'; - RsCILNamebox = 'box'; - RsCILNamenewarr = 'newarr'; - RsCILNameldlen = 'ldlen'; - RsCILNameldelema = 'ldelema'; - RsCILNameldelemi1 = 'ldelem.i1'; - RsCILNameldelemu1 = 'ldelem.u1'; - RsCILNameldelemi2 = 'ldelem.i2'; - RsCILNameldelemu2 = 'ldelem.u2'; - RsCILNameldelemi4 = 'ldelem.i4'; - RsCILNameldelemu4 = 'ldelem.u4'; - RsCILNameldelemi8 = 'ldelem.i8'; - RsCILNameldelemi = 'ldelem.i'; - RsCILNameldelemr4 = 'ldelem.r4'; - RsCILNameldelemr8 = 'ldelem.r8'; - RsCILNameldelemref = 'ldelem.ref'; - RsCILNamestelemi = 'stelem.i'; - RsCILNamestelemi1 = 'stelem.i1'; - RsCILNamestelemi2 = 'stelem.i2'; - RsCILNamestelemi4 = 'stelem.i4'; - RsCILNamestelemi8 = 'stelem.i8'; - RsCILNamestelemr4 = 'stelem.r4'; - RsCILNamestelemr8 = 'stelem.r8'; - RsCILNamestelemref = 'stelem.ref'; - RsCILNameunused4 = 'unused'; - RsCILNameunused5 = 'unused'; - RsCILNameunused6 = 'unused'; - RsCILNameunused7 = 'unused'; - RsCILNameunused8 = 'unused'; - RsCILNameunused9 = 'unused'; - RsCILNameunused10 = 'unused'; - RsCILNameunused11 = 'unused'; - RsCILNameunused12 = 'unused'; - RsCILNameunused13 = 'unused'; - RsCILNameunused14 = 'unused'; - RsCILNameunused15 = 'unused'; - RsCILNameunused16 = 'unused'; - RsCILNameunused17 = 'unused'; - RsCILNameunused18 = 'unused'; - RsCILNameunused19 = 'unused'; - RsCILNameconvovfi1 = 'conv.ovf.i1'; - RsCILNameconvovfu1 = 'conv.ovf.u1'; - RsCILNameconvovfi2 = 'conv.ovf.i2'; - RsCILNameconvovfu2 = 'conv.ovf.u2'; - RsCILNameconvovfi4 = 'conv.ovf.i4'; - RsCILNameconvovfu4 = 'conv.ovf.u4'; - RsCILNameconvovfi8 = 'conv.ovf.i8'; - RsCILNameconvovfu8 = 'conv.ovf.u8'; - RsCILNameunused20 = 'unused'; - RsCILNameunused21 = 'unused'; - RsCILNameunused22 = 'unused'; - RsCILNameunused23 = 'unused'; - RsCILNameunused24 = 'unused'; - RsCILNameunused25 = 'unused'; - RsCILNameunused26 = 'unused'; - RsCILNamerefanyval = 'refanyval'; - RsCILNameckfinite = 'ckfinite'; - RsCILNameunused27 = 'unused'; - RsCILNameunused28 = 'unused'; - RsCILNamemkrefany = 'mkrefany'; - RsCILNameunused29 = 'unused'; - RsCILNameunused30 = 'unused'; - RsCILNameunused31 = 'unused'; - RsCILNameunused32 = 'unused'; - RsCILNameunused33 = 'unused'; - RsCILNameunused34 = 'unused'; - RsCILNameunused35 = 'unused'; - RsCILNameunused36 = 'unused'; - RsCILNameunused37 = 'unused'; - RsCILNameldtoken = 'ldtoken'; - RsCILNameconvu2 = 'conv.u2'; - RsCILNameconvu1 = 'conv.u1'; - RsCILNameconvi = 'conv.i'; - RsCILNameconvovfi = 'conv.ovf.i'; - RsCILNameconvovfu = 'conv.ovf.u'; - RsCILNameaddovf = 'add.ovf'; - RsCILNameaddovfun = 'add.ovf.un'; - RsCILNamemulovf = 'mul.ovf'; - RsCILNamemulovfun = 'mul.ovf.un'; - RsCILNamesubovf = 'sub.ovf'; - RsCILNamesubovfun = 'sub.ovf.un'; - RsCILNameendfinally = 'endfinally'; - RsCILNameleave = 'leave'; - RsCILNameleaves = 'leave.s'; - RsCILNamestindi = 'stind.i'; - RsCILNameconvu = 'conv.u'; - RsCILNameunused38 = 'unused'; - RsCILNameunused39 = 'unused'; - RsCILNameunused40 = 'unused'; - RsCILNameunused41 = 'unused'; - RsCILNameunused42 = 'unused'; - RsCILNameunused43 = 'unused'; - RsCILNameunused44 = 'unused'; - RsCILNameunused45 = 'unused'; - RsCILNameunused46 = 'unused'; - RsCILNameunused47 = 'unused'; - RsCILNameunused48 = 'unused'; - RsCILNameunused49 = 'unused'; - RsCILNameunused50 = 'unused'; - RsCILNameunused51 = 'unused'; - RsCILNameunused52 = 'unused'; - RsCILNameunused53 = 'unused'; - RsCILNameunused54 = 'unused'; - RsCILNameunused55 = 'unused'; - RsCILNameunused56 = 'unused'; - RsCILNameunused57 = 'unused'; - RsCILNameunused58 = 'unused'; - RsCILNameunused59 = 'unused'; - RsCILNameunused60 = 'unused'; - RsCILNameprefix7 = 'prefix7'; - RsCILNameprefix6 = 'prefix6'; - RsCILNameprefix5 = 'prefix5'; - RsCILNameprefix4 = 'prefix4'; - RsCILNameprefix3 = 'prefix3'; - RsCILNameprefix2 = 'prefix2'; - RsCILNameprefix1 = 'prefix1'; - RsCILNameprefixref = 'prefixref'; - RsCILNamearglist = 'arglist'; - RsCILNameceq = 'ceq'; - RsCILNamecgt = 'cgt'; - RsCILNamecgtun = 'cgt.un'; - RsCILNameclt = 'clt'; - RsCILNamecltun = 'clt.un'; - RsCILNameldftn = 'ldftn'; - RsCILNameldvirtftn = 'ldvirtftn'; - RsCILNameunused61 = 'unused'; - RsCILNameldarg = 'ldarg'; - RsCILNameldarga = 'ldarga'; - RsCILNamestarg = 'starg'; - RsCILNameldloc = 'ldloc'; - RsCILNameldloca = 'ldloca'; - RsCILNamestloc = 'stloc'; - RsCILNamelocalloc = 'localloc'; - RsCILNameunused62 = 'unused'; - RsCILNameendfilter = 'endfilter'; - RsCILNameunaligned = 'unaligned.'; - RsCILNamevolatile = 'volatile.'; - RsCILNametail = 'tail.'; - RsCILNameinitobj = 'initobj'; - RsCILNameunused63 = 'unused'; - RsCILNamecpblk = 'cpblk'; - RsCILNameinitblk = 'initblk'; - RsCILNameunused64 = 'unused'; - RsCILNamerethrow = 'rethrow'; - RsCILNameunused65 = 'unused'; - RsCILNamesizeof = 'sizeof'; - RsCILNamerefanytype = 'refanytype'; - RsCILNameunused66 = 'unused'; - RsCILNameunused67 = 'unused'; - RsCILNameunused68 = 'unused'; - RsCILNameunused69 = 'unused'; - RsCILNameunused70 = 'unused'; - - RsCILCmdnop = 'no operation'; - RsCILCmdbreak = 'breakpoint instruction'; - RsCILCmdldarg0 = 'load argument onto the stack'; - RsCILCmdldarg1 = 'load argument onto the stack'; - RsCILCmdldarg2 = 'load argument onto the stack'; - RsCILCmdldarg3 = 'load argument onto the stack'; - RsCILCmdldloc0 = 'load local variable onto the stack'; - RsCILCmdldloc1 = 'load local variable onto the stack'; - RsCILCmdldloc2 = 'load local variable onto the stack'; - RsCILCmdldloc3 = 'load local variable onto the stack'; - RsCILCmdstloc0 = 'pop value from stack to local variable'; - RsCILCmdstloc1 = 'pop value from stack to local variable'; - RsCILCmdstloc2 = 'pop value from stack to local variable'; - RsCILCmdstloc3 = 'pop value from stack to local variable'; - RsCILCmdldargs = 'load argument onto the stack'; - RsCILCmdldargas = 'load an argument address'; - RsCILCmdstargs = 'store a value in an argument slot'; - RsCILCmdldlocs = 'load local variable onto the stack'; - RsCILCmdldlocas = 'load local variable address'; - RsCILCmdstlocs = 'pop value from stack to local variable'; - RsCILCmdldnull = 'load a null pointer'; - RsCILCmdldci4m1 = 'load numeric constant'; - RsCILCmdldci40 = 'load numeric constant'; - RsCILCmdldci41 = 'load numeric constant'; - RsCILCmdldci42 = 'load numeric constant'; - RsCILCmdldci43 = 'load numeric constant'; - RsCILCmdldci44 = 'load numeric constant'; - RsCILCmdldci45 = 'load numeric constant'; - RsCILCmdldci46 = 'load numeric constant'; - RsCILCmdldci47 = 'load numeric constant'; - RsCILCmdldci48 = 'load numeric constant'; - RsCILCmdldci4s = 'load numeric constant'; - RsCILCmdldci4 = 'load numeric constant'; - RsCILCmdldci8 = 'load numeric constant'; - RsCILCmdldcr4 = 'load numeric constant'; - RsCILCmdldcr8 = 'load numeric constant'; - RsCILCmdunused1 = ''; - RsCILCmddup = 'duplicate the top value of the stack'; - RsCILCmdpop = 'remove the top element of the stack'; - RsCILCmdjmp = 'jump to method'; - RsCILCmdcall = 'call a method'; - RsCILCmdcalli = 'indirect method call'; - RsCILCmdret = 'return from method'; - RsCILCmdbrs = 'unconditional branch'; - RsCILCmdbrfalses = 'branch on false, null, or zero'; - RsCILCmdbrtrues = 'branch on non-false or non-null'; - RsCILCmdbeqs = 'branch on equal'; - RsCILCmdbges = 'branch on greater than or equal to'; - RsCILCmdbgts = 'branch on greater than'; - RsCILCmdbles = 'branch on less than or equal to'; - RsCILCmdblts = 'branch on less than'; - RsCILCmdbneuns = 'branch on not equal or unordered'; - RsCILCmdbgeuns = 'branch on greater than or equal to, unsigned or unordered'; - RsCILCmdbgtuns = 'branch on greater than, unsigned or unordered'; - RsCILCmdbleuns = 'branch on less than or equal to, unsigned or unordered'; - RsCILCmdbltuns = 'branch on less than, unsigned or unordered'; - RsCILCmdbr = 'unconditional branch'; - RsCILCmdbrfalse = 'branch on false, null, or zero'; - RsCILCmdbrtrue = 'branch on non-false or non-null'; - RsCILCmdbeq = 'branch on equal'; - RsCILCmdbge = 'branch on greater than or equal to'; - RsCILCmdbgt = 'branch on greater than'; - RsCILCmdble = 'branch on less than or equal to'; - RsCILCmdblt = 'branch on less than'; - RsCILCmdbneun = 'branch on not equal or unordered'; - RsCILCmdbgeun = 'branch on greater than or equal to, unsigned or unordered'; - RsCILCmdbgtun = 'branch on greater than, unsigned or unordered'; - RsCILCmdbleun = 'branch on less than or equal to, unsigned or unordered'; - RsCILCmdbltun = 'branch on less than, unsigned or unordered'; - RsCILCmdswitch = 'table switch on value'; - RsCILCmdldindi1 = 'load value indirect onto the stack'; - RsCILCmdldindu1 = 'load value indirect onto the stack'; - RsCILCmdldindi2 = 'load value indirect onto the stack'; - RsCILCmdldindu2 = 'load value indirect onto the stack'; - RsCILCmdldindi4 = 'load value indirect onto the stack'; - RsCILCmdldindu4 = 'load value indirect onto the stack'; - RsCILCmdldindi8 = 'load value indirect onto the stack'; - RsCILCmdldindi = 'load value indirect onto the stack'; - RsCILCmdldindr4 = 'load value indirect onto the stack'; - RsCILCmdldindr8 = 'load value indirect onto the stack'; - RsCILCmdldindref = 'load value indirect onto the stack'; - RsCILCmdstindref = 'store value indirect from stack'; - RsCILCmdstindi1 = 'store value indirect from stack'; - RsCILCmdstindi2 = 'store value indirect from stack'; - RsCILCmdstindi4 = 'store value indirect from stack'; - RsCILCmdstindi8 = 'store value indirect from stack'; - RsCILCmdstindr4 = 'store value indirect from stack'; - RsCILCmdstindr8 = 'store value indirect from stack'; - RsCILCmdadd = 'add numeric values'; - RsCILCmdsub = 'subtract numeric values'; - RsCILCmdmul = 'multiply values'; - RsCILCmddiv = 'divide values'; - RsCILCmddivun = 'divide integer values, unsigned'; - RsCILCmdrem = 'compute remainder'; - RsCILCmdremun = 'compute integer remainder, unsigned'; - RsCILCmdand = 'bitwise AND'; - RsCILCmdor = 'bitwise OR'; - RsCILCmdxor = 'bitwise XOR'; - RsCILCmdshl = 'shift integer left'; - RsCILCmdshr = 'shift integer right'; - RsCILCmdshrun = 'shift integer right, unsigned'; - RsCILCmdneg = 'negate'; - RsCILCmdnot = 'bitwise complement'; - RsCILCmdconvi1 = 'data conversion'; - RsCILCmdconvi2 = 'data conversion'; - RsCILCmdconvi4 = 'data conversion'; - RsCILCmdconvi8 = 'data conversion'; - RsCILCmdconvr4 = 'data conversion'; - RsCILCmdconvr8 = 'data conversion'; - RsCILCmdconvu4 = 'data conversion'; - RsCILCmdconvu8 = 'data conversion'; - RsCILCmdcallvirt = 'call a method associated, at runtime, with an object'; - RsCILCmdcpobj = 'copy a value type'; - RsCILCmdldobj = 'copy value type to the stack'; - RsCILCmdldstr = 'load a literal string'; - RsCILCmdnewobj = 'create a new object'; - RsCILCmdcastclass = 'cast an object to a class'; - RsCILCmdisinst = 'test if an object is an instance of a class or interface'; - RsCILCmdconvrun = 'data conversion'; - RsCILCmdunused2 = ''; - RsCILCmdunused3 = ''; - RsCILCmdunbox = 'Convert boxed value type to its raw form'; - RsCILCmdthrow = 'throw an exception'; - RsCILCmdldfld = 'load field of an object'; - RsCILCmdldflda = 'load field address'; - RsCILCmdstfld = 'store into a field of an object'; - RsCILCmdldsfld = 'load static field of a class'; - RsCILCmdldsflda = 'load static field address'; - RsCILCmdstsfld = 'store a static field of a class'; - RsCILCmdstobj = 'store a value type from the stack into memory'; - RsCILCmdconvovfi1un = 'unsigned data conversion with overflow detection'; - RsCILCmdconvovfi2un = 'unsigned data conversion with overflow detection'; - RsCILCmdconvovfi4un = 'unsigned data conversion with overflow detection'; - RsCILCmdconvovfi8un = 'unsigned data conversion with overflow detection'; - RsCILCmdconvovfu1un = 'unsigned data conversion with overflow detection'; - RsCILCmdconvovfu2un = 'unsigned data conversion with overflow detection'; - RsCILCmdconvovfu4un = 'unsigned data conversion with overflow detection'; - RsCILCmdconvovfu8un = 'unsigned data conversion with overflow detection'; - RsCILCmdconvovfiun = 'unsigned data conversion with overflow detection'; - RsCILCmdconvovfuun = 'unsigned data conversion with overflow detection'; - RsCILCmdbox = 'convert value type to object reference'; - RsCILCmdnewarr = 'create a zero-based, one-dimensional array'; - RsCILCmdldlen = 'load the length of an array'; - RsCILCmdldelema = 'load address of an element of an array'; - RsCILCmdldelemi1 = 'load an element of an array'; - RsCILCmdldelemu1 = 'load an element of an array'; - RsCILCmdldelemi2 = 'load an element of an array'; - RsCILCmdldelemu2 = 'load an element of an array'; - RsCILCmdldelemi4 = 'load an element of an array'; - RsCILCmdldelemu4 = 'load an element of an array'; - RsCILCmdldelemi8 = 'load an element of an array'; - RsCILCmdldelemi = 'load an element of an array'; - RsCILCmdldelemr4 = 'load an element of an array'; - RsCILCmdldelemr8 = 'load an element of an array'; - RsCILCmdldelemref = 'load an element of an array'; - RsCILCmdstelemi = 'store an element of an array'; - RsCILCmdstelemi1 = 'store an element of an array'; - RsCILCmdstelemi2 = 'store an element of an array'; - RsCILCmdstelemi4 = 'store an element of an array'; - RsCILCmdstelemi8 = 'store an element of an array'; - RsCILCmdstelemr4 = 'store an element of an array'; - RsCILCmdstelemr8 = 'store an element of an array'; - RsCILCmdstelemref = 'store an element of an array'; - RsCILCmdunused4 = ''; - RsCILCmdunused5 = ''; - RsCILCmdunused6 = ''; - RsCILCmdunused7 = ''; - RsCILCmdunused8 = ''; - RsCILCmdunused9 = ''; - RsCILCmdunused10 = ''; - RsCILCmdunused11 = ''; - RsCILCmdunused12 = ''; - RsCILCmdunused13 = ''; - RsCILCmdunused14 = ''; - RsCILCmdunused15 = ''; - RsCILCmdunused16 = ''; - RsCILCmdunused17 = ''; - RsCILCmdunused18 = ''; - RsCILCmdunused19 = ''; - RsCILCmdconvovfi1 = 'data conversion with overflow detection'; - RsCILCmdconvovfu1 = 'data conversion with overflow detection'; - RsCILCmdconvovfi2 = 'data conversion with overflow detection'; - RsCILCmdconvovfu2 = 'data conversion with overflow detection'; - RsCILCmdconvovfi4 = 'data conversion with overflow detection'; - RsCILCmdconvovfu4 = 'data conversion with overflow detection'; - RsCILCmdconvovfi8 = 'data conversion with overflow detection'; - RsCILCmdconvovfu8 = 'data conversion with overflow detection'; - RsCILCmdunused20 = ''; - RsCILCmdunused21 = ''; - RsCILCmdunused22 = ''; - RsCILCmdunused23 = ''; - RsCILCmdunused24 = ''; - RsCILCmdunused25 = ''; - RsCILCmdunused26 = ''; - RsCILCmdrefanyval = 'load the address out of a typed reference'; - RsCILCmdckfinite = 'check for a finite real number'; - RsCILCmdunused27 = ''; - RsCILCmdunused28 = ''; - RsCILCmdmkrefany = 'push a typed reference on the stack'; - RsCILCmdunused29 = ''; - RsCILCmdunused30 = ''; - RsCILCmdunused31 = ''; - RsCILCmdunused32 = ''; - RsCILCmdunused33 = ''; - RsCILCmdunused34 = ''; - RsCILCmdunused35 = ''; - RsCILCmdunused36 = ''; - RsCILCmdunused37 = ''; - RsCILCmdldtoken = 'load the runtime representation of a metadata token'; - RsCILCmdconvu2 = 'data conversion'; - RsCILCmdconvu1 = 'data conversion'; - RsCILCmdconvi = 'data conversion'; - RsCILCmdconvovfi = 'data conversion with overflow detection'; - RsCILCmdconvovfu = 'data conversion with overflow detection'; - RsCILCmdaddovf = 'add integer values with overflow check'; - RsCILCmdaddovfun = 'add integer values with overflow check'; - RsCILCmdmulovf = 'multiply integer values with overflow check'; - RsCILCmdmulovfun = 'multiply integer values with overflow check'; - RsCILCmdsubovf = 'subtract integer values, checking for overflow'; - RsCILCmdsubovfun = 'subtract integer values, checking for overflow'; - RsCILCmdendfinally = 'end the finally or fault clause of an exception block'; - RsCILCmdleave = 'exit a protected region of code'; - RsCILCmdleaves = 'exit a protected region of code'; - RsCILCmdstindi = 'store value indirect from stack'; - RsCILCmdconvu = 'data conversion'; - RsCILCmdunused38 = ''; - RsCILCmdunused39 = ''; - RsCILCmdunused40 = ''; - RsCILCmdunused41 = ''; - RsCILCmdunused42 = ''; - RsCILCmdunused43 = ''; - RsCILCmdunused44 = ''; - RsCILCmdunused45 = ''; - RsCILCmdunused46 = ''; - RsCILCmdunused47 = ''; - RsCILCmdunused48 = ''; - RsCILCmdunused49 = ''; - RsCILCmdunused50 = ''; - RsCILCmdunused51 = ''; - RsCILCmdunused52 = ''; - RsCILCmdunused53 = ''; - RsCILCmdunused54 = ''; - RsCILCmdunused55 = ''; - RsCILCmdunused56 = ''; - RsCILCmdunused57 = ''; - RsCILCmdunused58 = ''; - RsCILCmdunused59 = ''; - RsCILCmdunused60 = ''; - RsCILCmdprefix7 = ''; - RsCILCmdprefix6 = ''; - RsCILCmdprefix5 = ''; - RsCILCmdprefix4 = ''; - RsCILCmdprefix3 = ''; - RsCILCmdprefix2 = ''; - RsCILCmdprefix1 = ''; - RsCILCmdprefixref = ''; - RsCILCmdarglist = 'get argument list'; - RsCILCmdceq = 'compare equal'; - RsCILCmdcgt = 'compare greater than'; - RsCILCmdcgtun = 'compare greater than, unsigned or unordered'; - RsCILCmdclt = 'compare less than'; - RsCILCmdcltun = 'compare less than, unsigned or unordered'; - RsCILCmdldftn = 'load method pointer'; - RsCILCmdldvirtftn = 'load a virtual method pointer'; - RsCILCmdunused61 = ''; - RsCILCmdldarg = 'load argument onto the stack'; - RsCILCmdldarga = 'load an argument address'; - RsCILCmdstarg = 'store a value in an argument slot'; - RsCILCmdldloc = 'load local variable onto the stack'; - RsCILCmdldloca = 'load local variable address'; - RsCILCmdstloc = 'pop value from stack to local variable'; - RsCILCmdlocalloc = 'allocate space in the local dynamic memory pool'; - RsCILCmdunused62 = ''; - RsCILCmdendfilter = 'end filter clause of SEH'; - RsCILCmdunaligned = 'pointer instruction may be unaligned'; - RsCILCmdvolatile = 'pointer reference is volatile'; - RsCILCmdtail = 'call terminates current method'; - RsCILCmdinitobj = 'initialize a value type'; - RsCILCmdunused63 = ''; - RsCILCmdcpblk = 'copy data from memory to memory'; - RsCILCmdinitblk = 'initialize a block of memory to a value'; - RsCILCmdunused64 = ''; - RsCILCmdrethrow = 'rethrow the current exception'; - RsCILCmdunused65 = ''; - RsCILCmdsizeof = 'load the size in bytes of a value type'; - RsCILCmdrefanytype = 'load the type out of a typed reference'; - RsCILCmdunused66 = ''; - RsCILCmdunused67 = ''; - RsCILCmdunused68 = ''; - RsCILCmdunused69 = ''; - RsCILCmdunused70 = ''; - - RsCILDescrnop = 'Do nothing'; - RsCILDescrbreak = 'inform a debugger that a breakpoint has been reached.'; - RsCILDescrldarg0 = 'Load argument 0 onto stack'; - RsCILDescrldarg1 = 'Load argument 1 onto stack'; - RsCILDescrldarg2 = 'Load argument 2 onto stack'; - RsCILDescrldarg3 = 'Load argument 3 onto stack'; - RsCILDescrldloc0 = 'Load local variable 0 onto stack.'; - RsCILDescrldloc1 = 'Load local variable 1 onto stack.'; - RsCILDescrldloc2 = 'Load local variable 2 onto stack.'; - RsCILDescrldloc3 = 'Load local variable 3 onto stack.'; - RsCILDescrstloc0 = 'Pop value from stack into local variable 0.'; - RsCILDescrstloc1 = 'Pop value from stack into local variable 1.'; - RsCILDescrstloc2 = 'Pop value from stack into local variable 2.'; - RsCILDescrstloc3 = 'Pop value from stack into local variable 3.'; - RsCILDescrldargs = 'Load argument numbered num onto stack, short form.'; - RsCILDescrldargas = 'fetch the address of argument argNum, short form'; - RsCILDescrstargs = 'Store a value to the argument numbered num, short form'; - RsCILDescrldlocs = 'Load local variable of index indx onto stack, short form.'; - RsCILDescrldlocas = 'Load address of local variable with index indx, short form'; - RsCILDescrstlocs = 'Pop value from stack into local variable indx, short form.'; - RsCILDescrldnull = 'Push null reference on the stack'; - RsCILDescrldci4m1 = 'Push -1 onto the stack as int32.'; - RsCILDescrldci40 = 'Push 0 onto the stack as int32.'; - RsCILDescrldci41 = 'Push 1 onto the stack as int32.'; - RsCILDescrldci42 = 'Push 2 onto the stack as int32.'; - RsCILDescrldci43 = 'Push 3 onto the stack as int32.'; - RsCILDescrldci44 = 'Push 4 onto the stack as int32.'; - RsCILDescrldci45 = 'Push 5 onto the stack as int32.'; - RsCILDescrldci46 = 'Push 6 onto the stack as int32.'; - RsCILDescrldci47 = 'Push 7 onto the stack as int32.'; - RsCILDescrldci48 = 'Push 8 onto the stack as int32.'; - RsCILDescrldci4s = 'Push num onto the stack as int32, short form.'; - RsCILDescrldci4 = 'Push num of type int32 onto the stack as int32.'; - RsCILDescrldci8 = 'Push num of type int64 onto the stack as int64.'; - RsCILDescrldcr4 = 'Push num of type float32 onto the stack as F.'; - RsCILDescrldcr8 = 'Push num of type float64 onto the stack as F.'; - RsCILDescrunused1 = ''; - RsCILDescrdup = 'duplicate value on the top of the stack'; - RsCILDescrpop = 'pop a value from the stack'; - RsCILDescrjmp = 'Exit current method and jump to specified method'; - RsCILDescrcall = 'Call method described by method'; - RsCILDescrcalli = 'Call method indicated on the stack with arguments described by callsitedescr.'; - RsCILDescrret = 'Return from method, possibly returning a value'; - RsCILDescrbrs = 'branch to target, short form'; - RsCILDescrbrfalses = 'branch to target if value is zero (false), short form'; - RsCILDescrbrtrues = 'branch to target if value is non-zero (true), short form'; - RsCILDescrbeqs = 'branch to target if equal, short form'; - RsCILDescrbges = 'branch to target if greater than or equal to, short form'; - RsCILDescrbgts = 'branch to target if greater than, short form'; - RsCILDescrbles = 'branch to target if less than or equal to, short form'; - RsCILDescrblts = 'branch to target if less than'; - RsCILDescrbneuns = 'branch to target if unequal or unordered, short form'; - RsCILDescrbgeuns = 'branch to target if greater than or equal to (unsigned or unordered), short form'; - RsCILDescrbgtuns = 'branch to target if greater than (unsigned or unordered), short form'; - RsCILDescrbleuns = 'branch to target if less than or equal to (unsigned or unordered), short form'; - RsCILDescrbltuns = 'Branch to target if less than (unsigned or unordered), short form'; - RsCILDescrbr = 'branch to target '; - RsCILDescrbrfalse = 'branch to target if value is zero (false)'; - RsCILDescrbrtrue = 'branch to target if value is non-zero (true)'; - RsCILDescrbeq = 'branch to target if equal'; - RsCILDescrbge = 'branch to target if greater than or equal to'; - RsCILDescrbgt = 'branch to target if greater than'; - RsCILDescrble = 'branch to target if less than or equal to'; - RsCILDescrblt = 'branch to target if less than'; - RsCILDescrbneun = 'branch to target if unequal or unordered'; - RsCILDescrbgeun = 'branch to target if greater than or equal to (unsigned or unordered)'; - RsCILDescrbgtun = 'branch to target if greater than (unsigned or unordered)'; - RsCILDescrbleun = 'branch to target if less than or equal to (unsigned or unordered)'; - RsCILDescrbltun = 'Branch to target if less than (unsigned or unordered) '; - RsCILDescrswitch = 'jump to one of n values'; - RsCILDescrldindi1 = 'Indirect load value of type int8 as int32 on the stack.'; - RsCILDescrldindu1 = 'Indirect load value of type unsigned int8 as int32 on the stack.'; - RsCILDescrldindi2 = 'Indirect load value of type int16 as int32 on the stack.'; - RsCILDescrldindu2 = 'Indirect load value of type unsigned int16 as int32 on the stack.'; - RsCILDescrldindi4 = 'Indirect load value of type int32 as int32 on the stack.'; - RsCILDescrldindu4 = 'Indirect load value of type unsigned int32 as int32 on the stack.'; - RsCILDescrldindi8 = 'Indirect load value of type int64 as int64 on the stack.'; - RsCILDescrldindi = 'Indirect load value of type native int as native int on the stack'; - RsCILDescrldindr4 = 'Indirect load value of type float32 as F on the stack.'; - RsCILDescrldindr8 = 'Indirect load value of type float64 as F on the stack.'; - RsCILDescrldindref = 'Indirect load value of type object ref as O on the stack.'; - RsCILDescrstindref = 'Store value of type object ref (type O) into memory at address'; - RsCILDescrstindi1 = 'Store value of type int8 into memory at address'; - RsCILDescrstindi2 = 'Store value of type int16 into memory at address'; - RsCILDescrstindi4 = 'Store value of type int32 into memory at address'; - RsCILDescrstindi8 = 'Store value of type int64 into memory at address'; - RsCILDescrstindr4 = 'Store value of type float32 into memory at address'; - RsCILDescrstindr8 = 'Store value of type float64 into memory at address'; - RsCILDescradd = 'Add two values, returning a new value'; - RsCILDescrsub = 'Subtract value2 from value1, returning a new value'; - RsCILDescrmul = 'Multiply values'; - RsCILDescrdiv = 'Divide two values to return a quotient or floating-point result'; - RsCILDescrdivun = 'Divide two values, unsigned, returning a quotient'; - RsCILDescrrem = 'Remainder of dividing value1 by value2'; - RsCILDescrremun = 'Remainder of unsigned dividing value1 by value2'; - RsCILDescrand = 'Bitwise AND of two integral values, returns an integral value'; - RsCILDescror = 'Bitwise OR of two integer values, returns an integer.'; - RsCILDescrxor = 'Bitwise XOR of integer values, returns an integer'; - RsCILDescrshl = 'Shift an integer to the left (shifting in zeros)'; - RsCILDescrshr = 'Shift an integer right, (shift in sign), return an integer'; - RsCILDescrshrun = 'Shift an integer right, (shift in zero), return an integer'; - RsCILDescrneg = 'Negate value'; - RsCILDescrnot = 'Bitwise complement'; - RsCILDescrconvi1 = 'Convert to int8, pushing int32 on stack'; - RsCILDescrconvi2 = 'Convert to int16, pushing int32 on stack'; - RsCILDescrconvi4 = 'Convert to int32, pushing int32 on stack'; - RsCILDescrconvi8 = 'Convert to int64, pushing int64 on stack'; - RsCILDescrconvr4 = 'Convert to float32, pushing F on stack'; - RsCILDescrconvr8 = 'Convert to float64, pushing F on stack'; - RsCILDescrconvu4 = 'Convert to unsigned int32, pushing int32 on stack'; - RsCILDescrconvu8 = 'Convert to unsigned int64, pushing int64 on stack'; - RsCILDescrcallvirt = 'Call a method associated with obj'; - RsCILDescrcpobj = 'Copy a value type from srcValObj to destValObj'; - RsCILDescrldobj = 'Copy instance of value type classTok to the stack.'; - RsCILDescrldstr = 'push a string object for the literal string '; - RsCILDescrnewobj = 'allocate an uninitialized object or value type and call ctor '; - RsCILDescrcastclass = 'Cast obj to class'; - RsCILDescrisinst = 'test if object is an instance of class, returning NULL or an instance of that class or interface'; - RsCILDescrconvrun = 'Convert unsigned integer to floating-point, pushing F on stack'; - RsCILDescrunused2 = ''; - RsCILDescrunused3 = ''; - RsCILDescrunbox = 'Extract the value type data from obj, its boxed representation'; - RsCILDescrthrow = 'Throw an exception'; - RsCILDescrldfld = 'Push the value of field of object, or value type, obj, onto the stack'; - RsCILDescrldflda = 'Push the address of field of object obj on the stack'; - RsCILDescrstfld = 'Replace the value of field of the object obj with val'; - RsCILDescrldsfld = 'Push the value of field on the stack'; - RsCILDescrldsflda = 'Push the address of the static field, field, on the stack'; - RsCILDescrstsfld = 'Replace the value of field with val'; - RsCILDescrstobj = 'Store a value of type classTok from the stack into memory'; - RsCILDescrconvovfi1un = 'Convert unsigned to an int8 (on the stack as int32) and throw an exception on overflow'; - RsCILDescrconvovfi2un = 'Convert unsigned to an int16 (on the stack as int32) and throw an exception on overflow'; - RsCILDescrconvovfi4un = 'Convert unsigned to an int32 (on the stack as int32) and throw an exception on overflow'; - RsCILDescrconvovfi8un = 'Convert unsigned to an int64 (on the stack as int64) and throw an exception on overflow'; - RsCILDescrconvovfu1un = 'Convert unsigned to an unsigned int8 (on the stack as int32) and throw an exception on overflow'; - RsCILDescrconvovfu2un = 'Convert unsigned to an unsigned int16 (on the stack as int32) and throw an exception on overflow'; - RsCILDescrconvovfu4un = 'Convert unsigned to an unsigned int32 (on the stack as int32) and throw an exception on overflow'; - RsCILDescrconvovfu8un = 'Convert unsigned to an unsigned int64 (on the stack as int64) and throw an exception on overflow'; - RsCILDescrconvovfiun = 'Convert unsigned to a native int (on the stack as native int) and throw an exception on overflow'; - RsCILDescrconvovfuun = 'Convert unsigned to a native unsigned int (on the stack as native int) and throw an exception on overflow'; - RsCILDescrbox = 'Convert valueType to a true object reference'; - RsCILDescrnewarr = 'create a new array with elements of type etype'; - RsCILDescrldlen = 'push the length (of type native unsigned int) of array on the stack'; - RsCILDescrldelema = 'Load the address of element at index onto the top of the stack'; - RsCILDescrldelemi1 = 'Load the element with type int8 at index onto the top of the stack as an int32'; - RsCILDescrldelemu1 = 'Load the element with type unsigned int8 at index onto the top of the stack as an int32'; - RsCILDescrldelemi2 = 'Load the element with type int16 at index onto the top of the stack as an int32'; - RsCILDescrldelemu2 = 'Load the element with type unsigned int16 at index onto the top of the stack as an int32'; - RsCILDescrldelemi4 = 'Load the element with type int32 at index onto the top of the stack as an int32'; - RsCILDescrldelemu4 = 'Load the element with type unsigned int32 at index onto the top of the stack as an int32 (alias for ldelem.i4)'; - RsCILDescrldelemi8 = 'Load the element with type int64 at index onto the top of the stack as an int64'; - RsCILDescrldelemi = 'Load the element with type native int at index onto the top of the stack as an native int'; - RsCILDescrldelemr4 = 'Load the element with type float32 at index onto the top of the stack as an F'; - RsCILDescrldelemr8 = 'Load the element with type float64 at index onto the top of the stack as an F'; - RsCILDescrldelemref = 'Load the element of type object, at index onto the top of the stack as an O'; - RsCILDescrstelemi = 'Replace array element at index with the i value on the stack'; - RsCILDescrstelemi1 = 'Replace array element at index with the int8 value on the stack'; - RsCILDescrstelemi2 = 'Replace array element at index with the int16 value on the stack'; - RsCILDescrstelemi4 = 'Replace array element at index with the int32 value on the stack'; - RsCILDescrstelemi8 = 'Replace array element at index with the int64 value on the stack'; - RsCILDescrstelemr4 = 'Replace array element at index with the float32 value on the stack'; - RsCILDescrstelemr8 = 'Replace array element at index with the float64 value on the stack'; - RsCILDescrstelemref = 'Replace array element at index with the ref value on the stack'; - RsCILDescrunused4 = ''; - RsCILDescrunused5 = ''; - RsCILDescrunused6 = ''; - RsCILDescrunused7 = ''; - RsCILDescrunused8 = ''; - RsCILDescrunused9 = ''; - RsCILDescrunused10 = ''; - RsCILDescrunused11 = ''; - RsCILDescrunused12 = ''; - RsCILDescrunused13 = ''; - RsCILDescrunused14 = ''; - RsCILDescrunused15 = ''; - RsCILDescrunused16 = ''; - RsCILDescrunused17 = ''; - RsCILDescrunused18 = ''; - RsCILDescrunused19 = ''; - RsCILDescrconvovfi1 = 'Convert to an int8 (on the stack as int32) and throw an exception on overflow '; - RsCILDescrconvovfu1 = 'Convert to a unsigned int8 (on the stack as int32) and throw an exception on overflow '; - RsCILDescrconvovfi2 = 'Convert to an int16 (on the stack as int32) and throw an exception on overflow '; - RsCILDescrconvovfu2 = 'Convert to a unsigned int16 (on the stack as int32) and throw an exception on overflow '; - RsCILDescrconvovfi4 = 'Convert to an int32 (on the stack as int32) and throw an exception on overflow '; - RsCILDescrconvovfu4 = 'Convert to a unsigned int32 (on the stack as int32) and throw an exception on overflow '; - RsCILDescrconvovfi8 = 'Convert to an int64 (on the stack as int64) and throw an exception on overflow '; - RsCILDescrconvovfu8 = 'Convert to a unsigned int64 (on the stack as int64) and throw an exception on overflow '; - RsCILDescrunused20 = ''; - RsCILDescrunused21 = ''; - RsCILDescrunused22 = ''; - RsCILDescrunused23 = ''; - RsCILDescrunused24 = ''; - RsCILDescrunused25 = ''; - RsCILDescrunused26 = ''; - RsCILDescrrefanyval = 'Push the address stored in a typed reference'; - RsCILDescrckfinite = 'throw ArithmeticException if value is not a finite number'; - RsCILDescrunused27 = ''; - RsCILDescrunused28 = ''; - RsCILDescrmkrefany = 'push a typed reference to ptr of type class onto the stack'; - RsCILDescrunused29 = ''; - RsCILDescrunused30 = ''; - RsCILDescrunused31 = ''; - RsCILDescrunused32 = ''; - RsCILDescrunused33 = ''; - RsCILDescrunused34 = ''; - RsCILDescrunused35 = ''; - RsCILDescrunused36 = ''; - RsCILDescrunused37 = ''; - RsCILDescrldtoken = 'Convert metadata token to its runtime representation'; - RsCILDescrconvu2 = 'Convert to unsigned int16, pushing int32 on stack'; - RsCILDescrconvu1 = 'Convert to unsigned int8, pushing int32 on stack'; - RsCILDescrconvi = 'Convert to native int, pushing native int on stack'; - RsCILDescrconvovfi = 'Convert to an native int (on the stack as native int) and throw an exception on overflow'; - RsCILDescrconvovfu = 'Convert to a native unsigned int (on the stack as native int) and throw an exception on overflow'; - RsCILDescraddovf = 'Add signed integer values with overflow check. '; - RsCILDescraddovfun = 'Add unsigned integer values with overflow check.'; - RsCILDescrmulovf = 'Multiply signed integer values. Signed result must fit in same size'; - RsCILDescrmulovfun = 'Multiply unsigned integer values. Unsigned result must fit in same size'; - RsCILDescrsubovf = 'Subtract native int from an native int. Signed result must fit in same size'; - RsCILDescrsubovfun = 'Subtract native unsigned int from a native unsigned int. Unsigned result must fit in same size'; - RsCILDescrendfinally = 'End finally clause of an exception block'; - RsCILDescrleave = 'Exit a protected region of code.'; - RsCILDescrleaves = 'Exit a protected region of code, short form'; - RsCILDescrstindi = 'Store value of type native int into memory at address'; - RsCILDescrconvu = 'Convert to native unsigned int, pushing native int on stack'; - RsCILDescrunused38 = ''; - RsCILDescrunused39 = ''; - RsCILDescrunused40 = ''; - RsCILDescrunused41 = ''; - RsCILDescrunused42 = ''; - RsCILDescrunused43 = ''; - RsCILDescrunused44 = ''; - RsCILDescrunused45 = ''; - RsCILDescrunused46 = ''; - RsCILDescrunused47 = ''; - RsCILDescrunused48 = ''; - RsCILDescrunused49 = ''; - RsCILDescrunused50 = ''; - RsCILDescrunused51 = ''; - RsCILDescrunused52 = ''; - RsCILDescrunused53 = ''; - RsCILDescrunused54 = ''; - RsCILDescrunused55 = ''; - RsCILDescrunused56 = ''; - RsCILDescrunused57 = ''; - RsCILDescrunused58 = ''; - RsCILDescrunused59 = ''; - RsCILDescrunused60 = ''; - RsCILDescrprefix7 = ''; - RsCILDescrprefix6 = ''; - RsCILDescrprefix5 = ''; - RsCILDescrprefix4 = ''; - RsCILDescrprefix3 = ''; - RsCILDescrprefix2 = ''; - RsCILDescrprefix1 = ''; - RsCILDescrprefixref = ''; - RsCILDescrarglist = 'return argument list handle for the current method '; - RsCILDescrceq = 'push 1 (of type int32) if value1 equals value2, else 0'; - RsCILDescrcgt = 'push 1 (of type int32) if value1 > value2, else 0'; - RsCILDescrcgtun = 'push 1 (of type int32) if value1 > value2, unsigned or unordered, else 0'; - RsCILDescrclt = 'push 1 (of type int32) if value1 < value2, else 0'; - RsCILDescrcltun = 'push 1 (of type int32) if value1 < value2, unsigned or unordered, else 0'; - RsCILDescrldftn = 'Push a pointer to a method referenced by method on the stack'; - RsCILDescrldvirtftn = 'Push address of virtual method mthd on the stack'; - RsCILDescrunused61 = ''; - RsCILDescrldarg = 'Load argument numbered num onto stack.'; - RsCILDescrldarga = 'fetch the address of argument argNum.'; - RsCILDescrstarg = 'Store a value to the argument numbered num'; - RsCILDescrldloc = 'Load local variable of index indx onto stack.'; - RsCILDescrldloca = 'Load address of local variable with index indx'; - RsCILDescrstloc = 'Pop value from stack into local variable indx.'; - RsCILDescrlocalloc = 'Allocate space from the local memory pool.'; - RsCILDescrunused62 = ''; - RsCILDescrendfilter = 'End filter clause of SEH exception handling'; - RsCILDescrunaligned = 'Subsequent pointer instruction may be unaligned'; - RsCILDescrvolatile = 'Subsequent pointer reference is volatile'; - RsCILDescrtail = 'Subsequent call terminates current method'; - RsCILDescrinitobj = 'Initialize a value type'; - RsCILDescrunused63 = ''; - RsCILDescrcpblk = 'Copy data from memory to memory'; - RsCILDescrinitblk = 'Set a block of memory to a given byte'; - RsCILDescrunused64 = ''; - RsCILDescrrethrow = 'Rethrow the current exception'; - RsCILDescrunused65 = ''; - RsCILDescrsizeof = 'Push the size, in bytes, of a value type as a unsigned int32'; - RsCILDescrrefanytype = 'Push the type token stored in a typed reference'; - RsCILDescrunused66 = ''; - RsCILDescrunused67 = ''; - RsCILDescrunused68 = ''; - RsCILDescrunused69 = ''; - RsCILDescrunused70 = ''; - -//=== JclCLR ================================================================= -resourcestring - RsClrCopyright = '// Delphi-JEDI .NET Framework IL Disassembler. Version 0.1' + sLineBreak + - '// Project JEDI Code Library (JCL) Team. All rights reserved.' + sLineBreak; - RsUnknownTableFmt = '%s%s'; - RsUnknownTable = 'Unknown table - '; - -//=== JclCOM ================================================================= -resourcestring - RsComInvalidParam = 'An invalid parameter was passed to the routine. If a parameter was ' + - 'expected, it might be an unassigned item or nil pointer'; - RsComFailedStreamRead = 'Failed to read all of the data from the specified stream'; - RsComFailedStreamWrite = 'Failed to write all of the data into the specified stream'; - -//=== JclComplex ============================================================= -resourcestring - RsComplexInvalidString = 'Failed to create a complex number from the string provided'; - -//=== JclCompression ========================================================= -resourcestring - RsCompressionReadNotSupported = 'read is not an supported operation.'; - RsCompressionWriteNotSupported = 'write is not an supported operation.'; - RsCompressionResetNotSupported = 'reset is not an supported operation.'; - RsCompressionSeekNotSupported = 'seek is not an supported operation.'; - RsCompressionUserAbort = 'User abort'; - RsCompressionZLibZErrNo = 'zlib returned: ERRNO'; - RsCompressionZLibZStreamError = 'zlib returned: Stream error'; - RsCompressionZLibZDataError = 'zlib returned: data error'; - RsCompressionZLibZMemError = 'zlib returned: memory error'; - RsCompressionZLibZBufError = 'zlib returned: buffer error'; - RsCompressionZLibZVersionError = 'zlib returned: version error'; - RsCompressionZLibError = 'zLib returned: unknown error (%d)'; - RsCompressionGZIPInvalidID = 'gzip: Invalid ID (ID1=%.2x; ID2=%.2x)'; - RsCompressionGZIPUnsupportedCM = 'gzip: unsupported compression method (%d)'; - RsCompressionGZIPHeaderCRC = 'gzip: CRC failed, header is damaged'; - RsCompressionGZIPDecompressing = 'gzip: this property is not readable when the data are being decompressed'; - RsCompressionGZIPNotDecompressed = 'gzip: this property is not readable until the data are fully decompressed'; - RsCompressionGZIPDataTruncated = 'gzip: data are truncated'; - RsCompressionGZIPInternalError = 'gzip: internal error'; - RsCompressionGZIPDataCRCFailed = 'gzip: CRC failed, data are damaged'; - RsCompressionGZIPExtraFieldTooLong = 'gzip: extra field is too long'; - RsCompressionGZIPBadString = 'gzip: the string contains null chars'; - RsCompressionBZIP2SequenceError = 'bzip2 returned: sequence error'; - RsCompressionBZIP2ParameterError = 'bzip2 returned: parameter error'; - RsCompressionBZIP2MemoryError = 'bzip2 returned: memory error'; - RsCompressionBZIP2DataError = 'bzip2 returned: data error'; - RsCompressionBZIP2HeaderError = 'bzip2 returned: header error'; - RsCompressionBZIP2IOError = 'bzip2 returned: IO error'; - RsCompressionBZIP2EOFError = 'bzip2 returned: unexpected end of file'; - RsCompressionBZIP2OutBuffError = 'bzip2 returned: out buffer is too small'; - RsCompressionBZIP2ConfigError = 'bzip2 returned: configuration error'; - RsCompressionBZIP2Error = 'bzip2 returned: unknown error (%d)'; - RsCompressionUnavailableProperty = 'Property is not available'; - RsCompressionCompressingError = 'Operation is not supported while compressing'; - RsCompressionDecompressingError = 'Operation is not supported while decompressing'; - RsCompressionNoFileName = 'File name not supplied'; - RsCompressionUnsupportedMethod = 'Unsupported method'; - RsCompressionDataError = 'Data error'; - RsCompressionCRCError = 'CRC error'; - RsCompressionNoNestedArchive = 'Nested archive is not supported'; - RsCompressionUnknownError = 'Unknown error'; - RsCompression7zLoadError = 'Sevenzip: Failed to load 7z.dll'; - RsCompression7zReturnError = 'Sevenzip: Error result (%.8x) "%s"'; - RsCompression7zUnassignedStream = 'Sevenzip: Stream object is not assigned'; - RsCompression7zOutArchiveError = 'Sevenzip: Failed to get out archive interface for class %s'; - RsCompression7zInArchiveError = 'Sevenzip: Failed to get in archive interface for class %s'; - RsCompression7zUnknownValueType = 'Sevenzip: Unknown value type (%d) for property ID %d'; - RsCompression7zOnlyCurrentFile = 'Sevenzip: Only properties for current file can be retreived'; - RsCompression7zWindows = 'Windows'; - RsCompression7zUnix = 'Unix'; - RsCompressionZipName = 'Zip archive'; - RsCompressionZipExtensions = '*.zip;' + // Basic ZIP file - '*.jar;*.ear;*.war;' + // JAVA files - '*.cbz;' + //Comic reader files - ZIP version - '*.apk;' + // Android application package - '*.wsz;*.wal;' + // Winamp Skins - '*.xpi;*.crx;' + // Firefox, Chrome extensions - '*.dfsz;' + // ??? - '*.pcv;' + // MozBackup file - '*.bsz;' + // BSplayer skin - '*.mskin;' + // Maxthon skin - '*.wmz;' + // Windows Media Player skin - '*.ipa;' + // iPhone/iPad application - '*.docx;*.xlsx;*.pptx;' + // MsOffice - '*.sxw;*.sxi;*.sxt;*.sxd;*.sxc;*.sxm;*.sxg;*.stw;*.sti;*.std;*.stc;' + // OpenOffice.org 1.x documents and templates - '*.odh;*.odd;*.odt;*.odm;*.ods;*.ots;*.odg;*.otg;*.odp;*.otp;*.odf;*.odb'; // OpenOffice.org 2.x/3.x docs and templates - RsCompressionBZip2Name = 'BZip2 archive'; - RsCompressionBZip2Extensions = '*.bz2;*.bzip2;*.tbz2;*.tbz'; - RsCompressionBZip2SubExtensions = '.tbz2=.tar;.tbz=.tar'; - RsCompressionRarName = 'Rar archive'; - RsCompressionRarExtensions = '*.rar;*.r00;'+ - '*.cbr'; // Comic reader file - RAR version - RsCompressionArjName = 'Arj archive'; - RsCompressionArjExtensions = '*.arj'; - RsCompressionZName = 'Z archive'; - RsCompressionZExtensions = '*.z;*.taz'; - RsCompressionZSubExtensions = '.taz=.tar'; - RsCompressionLzhName = 'Lzh archive'; - RsCompressionLzhExtensions = '*.lzh;*.lha'; - RsCompression7zName = '7z archive'; - RsCompression7zExtensions = '*.7z'; - RsCompressionCabName = 'Cab archive'; - RsCompressionCabExtensions = '*.cab;'+ - '*.fwp'; // FrontPage Web Package - RsCompressionNsisName = 'Nsis archive'; - RsCompressionNsisExtensions = '*.nsis'; - RsCompressionLzmaName = 'Lzma archive'; - RsCompressionLzmaExtensions = '*.lzma'; - RsCompressionLzma86Name = 'Lzma86 archive'; - RsCompressionLzma86Extensions = '*.lzma86'; - RsCompressionPeName = 'Pe archive'; - RsCompressionPeExtensions = '*.exe;*.dll;*.sys;*.bpl'; - RsCompressionElfName = 'Elf archive'; - // TODO: extension might be *.*, but then TJclCompressionStreamFormats.FindDecompressFormat can fail - RsCompressionElfExtensions = '*.'; - RsCompressionMachoName = 'Mach-O archive'; - // TODO: extension might be *.*, but then TJclCompressionStreamFormats.FindDecompressFormat can fail - RsCompressionMachoExtensions = '*.'; - RsCompressionUdfName = 'Udf archive'; - RsCompressionUdfExtensions = '*.iso;*.img'; - RsCompressionXarName = 'Xar archive'; - RsCompressionXarExtensions = '*.xar;'+ - '*.safariextz'; // Safari extensions - RsCompressionMubName = 'Mub archive'; - // TODO: extension might be *.*, but then TJclCompressionStreamFormats.FindDecompressFormat can fail - RsCompressionMubExtensions = '*.'; - RsCompressionHfsName = 'Hfs archive'; - RsCompressionHfsExtensions = '*.hfs'; - RsCompressionDmgName = 'Dmg archive'; - RsCompressionDmgExtensions = '*.dmg'; - RsCompressionCompoundName = 'Compound archive'; - RsCompressionCompoundExtensions = '*.msi;*.msp;*.doc;*.xls;*.ppt'; - RsCompressionWimName = 'Wim archive'; - RsCompressionWimExtensions = '*.wim;*.swm'; - RsCompressionIsoName = 'Iso archive'; - RsCompressionIsoExtensions = '*.iso;*.img'; - RsCompressionChmName = 'Chm archive'; - RsCompressionChmExtensions = '*.chm;*.chi;*.chq;*.chw;*.hxs;*.hxi;*.hxr;*.hxq;*.hxw;*.lit'; - RsCompressionSplitName = 'Split archive'; - RsCompressionSplitExtensions = '*.001'; - RsCompressionRpmName = 'Rpm archive'; - RsCompressionRpmExtensions = '*.rpm'; - RsCompressionDebName = 'Deb archive'; - RsCompressionDebExtensions = '*.deb'; - RsCompressionCpioName = 'Cpio archive'; - RsCompressionCpioExtensions = '*.cpio'; - RsCompressionTarName = 'Tar archive'; - RsCompressionTarExtensions = '*.tar'; - RsCompressionGZipName = 'GZip archive'; - RsCompressionGZipExtensions = '*.gz;*.gzip;*.tgz;*.tpz'; - RsCompressionGZipSubExtensions = '.tgz=.tar;.tpz=.tar'; - RsCompressionXzName = 'Xz archive'; - RsCompressionXzExtensions = '*.xz;*.txz'; - RsCompressionXzSubExtensions = '.txz=.tar'; - RsCompressionNtfsName = 'Ntfs archive'; - RsCompressionNtfsExtensions = '*.ntfs;*.img'; - RsCompressionFatName = 'Fat archive'; - RsCompressionFatExtensions = '*.fat;*.img'; - RsCompressionMbrName = 'Mbr archive'; - RsCompressionMbrExtensions = '*.mbr'; - RsCompressionVhdName = 'Vhd archive'; - RsCompressionVhdExtensions = '*.vhd'; - RsCompressionVhdSubExtensions = '.vhd=.mbr'; - RsCompressionFlvName = 'Flv archive'; - RsCompressionFlvExtensions = '*.flv'; - RsCompressionMsLZName = 'MsLZ archive'; - // TODO: extension might be *.*, but then TJclCompressionStreamFormats.FindDecompressFormat can fail - RsCompressionMsLZExtensions = '*.'; - RsCompressionSwfName = 'Swf archive'; - RsCompressionSwfExtensions = '*.swf'; - RsCompressionSwfcName = 'Swf archive'; - RsCompressionSwfcExtensions = '*.swf'; - RsCompressionApmName = 'APM archive'; - RsCompressionApmExtensions = '*.'; - RsCompressionPpmdName = 'PPMD archive'; - RsCompressionPpmdExtensions = '*.pmd'; - RsCompressionTEName = 'Terse Executable'; - RsCompressionTEExtensions = '*.te'; - RsCompressionUEFIcName = 'UEFIc archive'; - RsCompressionUEFIcExtensions = '*.scap'; - RsCompressionUEFIsName = 'UEFIs archive'; - RsCompressionUEFIsExtensions = '*.'; - RsCompressionSquashFSName = 'SquashFS archive'; - RsCompressionSquashFSExtensions = '*.squashfs'; - RsCompressionCramFSName = 'CramFS archive'; - RsCompressionCramFSExtensions = '*.cramfs'; - RsCompressionExtName = 'Ext filesystem archive'; - RsCompressionExtExtensions = '*.ext;*.ext2;*.ext3;*.ext4;*.img'; - RsCompressionVMDKName = 'Virtual Machine Disk archive'; - RsCompressionVMDKExtensions = '*.vmdk'; - RsCompressionVDIName = 'Virtual Disk Image archive'; - RsCompressionVDIExtensions = '*.vdi'; - RsCompressionQcowName = 'QEMU Copy On Write archive'; - RsCompressionQcowExtensions = '*.qcow;*.qcow2;*.qcow2c'; - RsCompressionGPTName = 'GUID Partition Table archive'; - RsCompressionGPTExtensions = '*.gpt;*.mbr'; - RsCompressionRar5Name = 'RAR v5 archive'; - RsCompressionRar5Extensions = '*.rar;*.r00'; - RsCompressionIHexName = 'IHex archive'; - RsCompressionIHexExtensions = '*.ihex'; - RsCompressionHxsName = 'Help 2.0 archive'; - RsCompressionHxsExtensions = '*.hxs;*.hxi;*.hxr;*.hxq;*.hxw;*.lit'; - RsCompressionDuplicate = 'The file %s already exists in the archive'; - RsCompressionReplaceError = 'At least one compression volume could not be replaced after an archive out-of-place update'; - -//=== JclConsole ============================================================= -resourcestring - RsCannotRaiseSignal = 'Cannot raise %s signal.'; - -//=== JclContainerIntf ======================================================= -resourcestring - RsEOutOfBounds = 'Out of bounds'; - RsEOperationNotSupported = 'Operation not supported'; - RsEValueNotFound = 'Value %s not found'; - RsEDuplicateElement = 'Duplicate element'; - RsENoCollection = 'Collection not assigned'; - RsEIllegalQueueCapacity = 'Illegal queue capacity'; - RsEIllegalStateOperation = 'Illegal state operation'; - RsENoEqualityComparer = 'Item equality comparer is not assigned'; - RsENoComparer = 'Item comparer is not assigned'; - RsENoHashConverter = 'Hash converter is not assigned'; - RsEAssignError = 'Assignation error'; - RsEReadOnlyError = 'Container is read-only'; - -//=== JclCounter ============================================================= -resourcestring - RsNoCounter = 'No high performance counters supported'; - -//=== JclDateTime ============================================================ -resourcestring - RsMakeUTCTime = 'Error converting to UTC time. Time zone could not be determined'; - RsDateConversion = 'Error illegal date or time format'; - -//=== JclDebug =============================================================== -resourcestring - RsUnknownFunctionAt = 'Unknown function at %s'; - -//=== JclCppException ======================================================== -resourcestring - RsCppUnhandledExceptionMsg = 'Unhandled C++ exception of type ''%s'' occurred'; - -//=== JclDotNet ============================================================== -resourcestring - RsEUnknownCLRVersion = '"%s" is not a known CLR version'; - -//=== JclExprEval ============================================================ -resourcestring - RsExprEvalRParenExpected = 'Parse error: '')'' expected'; - RsExprEvalFactorExpected = 'Parse error: Factor expected'; - RsExprEvalUnknownSymbol = 'Parse error: Unknown symbol: ''%s'''; - - RsExprEvalFirstArg = 'Parse error: ''('' and function''s first parameter expected'; - RsExprEvalNextArg = 'Parse error: '','' and another parameter expected'; - RsExprEvalEndArgs = 'Parse error: '')'' to close function''s parameters expected'; - - RsExprEvalExprNotFound = 'Expression compiler error: Expression ''%s'' not found'; - RsExprEvalExprPtrNotFound = 'Expression compiler error: Expression pointer not found'; - RsExprEvalExprRefCountAssertion = 'Expression compiler error: expression refcount < 0'; - -//=== JclFileUtils =========================================================== -resourcestring - // Path manipulation - RsPathInvalidDrive = '%s is not a valid drive'; - - // Files and directories - RsFileUtilsAttrUnavailable = 'Unable to retrieve attributes of %s'; - - RsCannotCreateDir = 'Unable to create directory'; - RsDelTreePathIsEmpty = 'DelTree: Path is empty'; - RsFileSearchAttrInconsistency = 'Some file search attributes are required AND rejected!'; - RsEWindowsVersionNotSupported = 'This Windows version is not supported'; - RsEWindowNotValid = 'The window with handle %d is not valid'; - RsEProcessNotValid = 'The process with ID %d is not valid'; - RsEModuleNotValid = 'The module with handle %d is not valid'; - - // TJclFileVersionInfo - RsFileUtilsNoVersionInfo = 'File contains no version information'; - RsFileUtilsFileDoesNotExist = 'The file %s does not exist'; - RsFileUtilsLanguageIndex = 'Illegal language index'; - RsFileUtilsEmptyValue = 'No value was supplied'; - RsFileUtilsValueNotFound = 'The value %s was not found.'; - // Strings returned from OSIdentTOString() - RsVosUnknown = 'Unknown'; - RsVosDos = 'MS-DOS'; - RsVosOS216 = '16-bit OS/2'; - RsVosOS232 = '32-bit OS/2'; - RsVosNT = 'Windows NT'; - RsVosWindows16 = '16-bit Windows'; - RsVosPM16 = '16-bit PM'; - RsVosPM32 = '32-bit PM'; - RsVosWindows32 = '32-bit Windows'; - RsVosDosWindows16 = '16-bit Windows, running on MS-DOS'; - RsVosDosWindows32 = 'Win32 API, running on MS-DOS'; - RsVosOS216PM16 = '16-bit PM, running on 16-bit OS/2'; - RsVosOS232PM32 = '32-bit PM, running on 32-bit OS/2'; - RsVosNTWindows32 = 'Win32 API, running on Windows/NT'; - RsVosDesignedFor = 'Designed for %s'; - - // Strings returned from OSFileTypeToString() - RsVftUnknown = 'Unknown'; - RsVftApp = 'Application'; - RsVftDll = 'Library'; - RsVftDrv = 'Driver'; - RsVftFont = 'Font'; - RsVftVxd = 'Virtual device'; - RsVftStaticLib = 'Static-link library'; - RsVft2DrvPRINTER = 'Printer'; - RsVft2DrvKEYBOARD = 'Keyboard'; - RsVft2DrvLANGUAGE = 'Language'; - RsVft2DrvDISPLAY = 'Display'; - RsVft2DrvMOUSE = 'Mouse'; - RsVft2DrvNETWORK = 'Network'; - RsVft2DrvSYSTEM = 'System'; - RsVft2DrvINSTALLABLE = 'Installable'; - RsVft2DrvSOUND = 'Sound'; - RsVft2DrvCOMM = 'Communications'; - RsVft2FontRASTER = 'Raster'; - RsVft2FontVECTOR = 'Vector'; - RsVft2FontTRUETYPE = 'TrueType'; - - // TJclFileStream - RsFileStreamCreate = 'Unable to create temporary file stream'; - - // TJclFileMapping - RsCreateFileMapping = 'Failed to create FileMapping'; - RsCreateFileMappingView = 'Failed to create FileMappingView'; - RsLoadFromStreamSize = 'Not enough space in View in procedure LoadFromStream'; - RsFileMappingInvalidHandle = 'Invalid file handle'; - RsViewNeedsMapping = 'FileMap argument of TJclFileMappingView constructor cannot be nil'; - RsFailedToObtainSize = 'Failed to obtain size of file'; - - // GetDriveTypeStr() - RsUnknownDrive = 'Unknown drive type'; - RsRemovableDrive = 'Removable Drive'; - RsHardDisk = 'Hard Disk'; - RsRemoteDrive = 'Remote Drive'; - RsCDRomDrive = 'CD-ROM'; - RsRamDisk = 'RAM-Disk'; - - // GetFileAttributeList() - RsAttrDirectory = 'Directory'; - RsAttrReadOnly = 'ReadOnly'; - RsAttrSystemFile = 'SystemFile'; - RsAttrVolumeID = 'Volume ID'; - RsAttrArchive = 'Archive'; - RsAttrAnyFile = 'AnyFile'; - RsAttrHidden = 'Hidden'; - - // GetFileAttributeListEx() - RsAttrNormal = 'Normal'; - RsAttrTemporary = 'Temporary'; - RsAttrCompressed = 'Compressed'; - RsAttrOffline = 'Offline'; - RsAttrEncrypted = 'Encrypted'; - RsAttrReparsePoint = 'Reparse Point'; - RsAttrSparseFile = 'Sparse'; - - // TJclFileMapping.Create - RsFileMappingOpenFile = 'Unable to open the file'; - - // TJclMappedTextReader - RsFileIndexOutOfRange = 'Index of out range'; - - // FileGetTypeName() - RsDefaultFileTypeName = ' File'; - -//=== JclMapi ================================================================ -resourcestring - RsMapiError = 'MAPI Error: (%d) "%s"'; - RsMapiMissingExport = 'Function "%s" is not exported by client'; - RsMapiInvalidIndex = 'Index is out ot range'; - RsMapiMailNoClient = 'No Simple MAPI client installed, cannot send the message'; - - RsMapiErrUSER_ABORT = 'User abort'; - RsMapiErrFAILURE = 'General MAPI failure'; - RsMapiErrLOGIN_FAILURE = 'MAPI login failure'; - RsMapiErrDISK_FULL = 'Disk full'; - RsMapiErrINSUFFICIENT_MEMORY = 'Insufficient memory'; - RsMapiErrACCESS_DENIED = 'Access denied'; - RsMapiErrTOO_MANY_SESSIONS = 'Too many sessions'; - RsMapiErrTOO_MANY_FILES = 'Too many files were specified'; - RsMapiErrTOO_MANY_RECIPIENTS = 'Too many recipients were specified'; - RsMapiErrATTACHMENT_NOT_FOUND = 'A specified attachment was not found'; - RsMapiErrATTACHMENT_OPEN_FAILURE = 'Attachment open failure'; - RsMapiErrATTACHMENT_WRITE_FAILURE = 'Attachment write failure'; - RsMapiErrUNKNOWN_RECIPIENT = 'Unknown recipient'; - RsMapiErrBAD_RECIPTYPE = 'Bad recipient type'; - RsMapiErrNO_MESSAGES = 'No messages'; - RsMapiErrINVALID_MESSAGE = 'Invalid message'; - RsMapiErrTEXT_TOO_LARGE = 'Text too large'; - RsMapiErrINVALID_SESSION = 'Invalid session'; - RsMapiErrTYPE_NOT_SUPPORTED = 'Type not supported'; - RsMapiErrAMBIGUOUS_RECIPIENT = 'A recipient was specified ambiguously'; - RsMapiErrMESSAGE_IN_USE = 'Message in use'; - RsMapiErrNETWORK_FAILURE = 'Network failure'; - RsMapiErrINVALID_EDITFIELDS = 'Invalid edit fields'; - RsMapiErrINVALID_RECIPS = 'Invalid recipients'; - RsMapiErrNOT_SUPPORTED = 'Not supported'; - - RsMapiMailORIG = 'From'; - RsMapiMailTO = 'To'; - RsMapiMailCC = 'Cc'; - RsMapiMailBCC = 'Bcc'; - RsMapiMailSubject = 'Subject'; - -//=== JclMath ================================================================ -resourcestring - RsMathDomainError = 'Domain check failure in JclMath'; - RsEmptyArray = 'Empty array is not allowed as input parameter'; - RsNonPositiveArray = 'Input array contains non-positive or zero values'; - RsUnexpectedValue = 'Unexpected data value'; - RsInvalidRational = 'Invalid rational number'; - RsDivByZero = 'Division by zero'; - RsRationalDivByZero = 'Rational division by zero'; - RsNoNaN = 'NaN expected'; - RsNaNTagError = 'NaN Tag value %d out of range'; - RsNaNSignal = 'NaN signaling %d'; - RsPowerInfinite = 'Power function: Result is infinite'; - RsPowerComplex = 'Power function: Result is complex'; - -//=== JclMetadata ============================================================ -resourcestring - RsUnknownClassLayout = 'Unknown class layout - $%.8x'; - RsUnknownStringFormatting = 'Unknown string formatting - $%.8x'; - RsInvalidSignatureData = 'Invalid compressed signature data - %.2x %.2x %.2x %.2x'; - RsUnknownManifestResource = 'Unknown manifest resource visibility - %d'; - RsNoLocalVarSig = 'Signature %s is not LocalVarSig'; - RsLocalVarSigOutOfRange = 'LocalVarSig count %d is out of range [1..$$FFFE]'; - -//=== JclMIDI ================================================================ -resourcestring - RsOctaveC = 'C'; - RsOctaveCSharp = 'C#'; - RsOctaveD = 'D'; - RsOctaveDSharp = 'D#'; - RsOctaveE = 'E'; - RsOctaveF = 'F'; - RsOctaveFSharp = 'F#'; - RsOctaveG = 'G'; - RsOctaveGSharp = 'G#'; - RsOctaveA = 'A'; - RsOctaveASharp = 'A#'; - RsOctaveB = 'B'; - - RsMidiInvalidChannelNum = 'Invalid MIDI channel number (%d)'; - {$IFDEF UNIX} - RsMidiNotImplemented = 'JclMidi: MIDI I/O for Unix not (yet) implemented'; - {$ENDIF UNIX} - -//=== JclMiscel ============================================================== -resourcestring - // CreateProcAsUser - RsCreateProcNTRequiredError = 'Windows NT required'; - RsCreateProcBuild1057Error = 'NT version 3.51 build 1057 or later required'; - - RsCreateProcPrivilegeMissing = 'This account does not have the privilege "%s" (%s)'; - RsCreateProcLogonUserError = 'LogonUser failed'; - RsCreateProcAccessDenied = 'Access denied'; - RsCreateProcLogonFailed = 'Unable to logon'; - RsCreateProcSetStationSecurityError = 'Cannot set WindowStation "%s" security.'; - RsCreateProcSetDesktopSecurityError = 'Cannot set Desktop "%s" security.'; - RsCreateProcPrivilegesMissing = 'This account does not have one (or more) of ' + - 'the following privileges: ' + '"%s"(%s)' + sLineBreak + '"%s"(%s)' + sLineBreak; - RsCreateProcCommandNotFound = 'Command or filename not found: "%s"'; - RsCreateProcFailed = 'CreateProcessAsUser failed'; - -//=== JclMultimedia ========================================================== -resourcestring - // Multimedia timer - RsMmTimerGetCaps = 'Error retrieving multimedia timer device capabilities'; - RsMmSetEvent = 'Error setting multimedia event timer'; - RsMmInconsistentId = 'Multimedia timer callback was called with inconsistent Id'; - RsMmTimerActive = 'This operation cannot be performed while the timer is active'; - - // Audio Mixer - RsMmMixerSource = 'Source'; - RsMmMixerDestination = 'Destination'; - RsMmMixerUndefined = 'Undefined'; - RsMmMixerDigital = 'Digital'; - RsMmMixerLine = 'Line'; - RsMmMixerMonitor = 'Monitor'; - RsMmMixerSpeakers = 'Speakers'; - RsMmMixerHeadphones = 'Headphones'; - RsMmMixerTelephone = 'Telephone'; - RsMmMixerWaveIn = 'Waveform-audio input'; - RsMmMixerVoiceIn = 'Voice input'; - RsMmMixerMicrophone = 'Microphone'; - RsMmMixerSynthesizer = 'Synthesizer'; - RsMmMixerCompactDisc = 'Compact disc'; - RsMmMixerPcSpeaker = 'PC speaker'; - RsMmMixerWaveOut = 'Waveform-audio output'; - RsMmMixerAuxiliary = 'Auxiliary audio line'; - RsMmMixerAnalog = 'Analog'; - RsMmMixerNoDevices = 'No mixer device found'; - RsMmMixerCtlNotFound = 'Line control (%s, %.8x) not found'; - - // EJclMciError - RsMmUnknownError = 'Unknown MCI error No. %d'; - RsMmMciErrorPrefix = 'MCI-Error: '; - - // CD audio routines - RsMmNoCdAudio = 'Cannot open CDAUDIO-Device'; - RsMmCdTrackNo = 'Track: %.2u'; - RsMMCdTimeFormat = '%2u:%.2u'; - RsMMTrackAudio = 'Audio'; - RsMMTrackOther = 'Other'; - -//=== JclNTFS ================================================================ -resourcestring - RsInvalidArgument = '%s: Invalid argument <%s>'; - RsNtfsUnableToDeleteSymbolicLink = 'Unable to delete temporary symbolic link'; - RsEUnableToCreatePropertyStorage = 'Unable to create property storage'; - RsEIncomatibleDataFormat = 'Incompatible data format'; - -//=== JclPCRE ================================================================ -resourcestring - RsErrNoMatch = 'No match'; - RsErrNull = 'Required value is null'; - RsErrBadOption = 'Bad option'; - RsErrBadMagic = 'Bad magic'; - RsErrUnknownNode = 'Unknown node'; - RsErrNoMemory = 'Out of memory'; - RsErrNoSubString = 'No substring'; - RsErrMatchLimit = 'Match limit'; - RsErrCallout = 'Callout'; - RsErrBadUTF8 = 'Bad UTF-8'; - RsErrBadUTF16 = 'Bad UTF-16'; - RsErrBadUTF8Offset = 'Bad UTF-8 offset'; - RsErrBadUTF16Offset = 'Bad UTF-16 offset'; - RsErrPartial = 'Partial'; - RsErrBadPartial = 'Bad partial'; - RsErrInternal = 'Internal'; - RsErrBadCount = 'Bad count'; - RsErrDfaUItem = 'DFA UItem'; - RsErrDfaUCond = 'DFA UCond'; - RsErrDfaUMLimit = 'DFA UMLimit'; - RsErrDfaWSSize = 'DFA WSSize'; - RsErrDfaRecurse = 'DFA Recurse'; - RsErrRecursionLimit = 'Recursion limit'; - RsErrNullWsLimit = 'Null WS limit'; - RsErrBadNewLine = 'Bad new line'; - RsErrBadOffset = 'Bad offset'; - RsErrShortUTF8 = 'Short UTF-8'; - RsErrShortUTF16 = 'Short UTF-16'; - RsErrRecurseLoop = 'Recurse loop'; - RsErrJITStackLimit = 'JIT stack limit'; - RsErrLibNotLoaded = 'PCRE library not loaded'; - RsErrMemFuncNotSet = 'PCRE memory management functions not set'; - RsErrStudyFailed = 'Study failed'; - RsErrCalloutError = 'Unhandled exception in callout'; - RsErrUnknownError = 'Unknown error'; - RsErrNoUTF8Support = 'No UTF-8 support in this version of PCRE'; - RsErrNoUTF16Support = 'No UTF-16 support in this version of PCRE'; - RsErrNoJITSupport = 'No JIT support in this version of PCRE'; - RsErrBadMode = 'Bad Mode'; - RsErrBadEndianness = 'Bad endianness'; - RsErrBadRestart = 'Bad Restart'; - -//=== JclPeImage ============================================================= -resourcestring - RsPeReadOnlyStream = 'Stream is read-only'; - - // TJclPeImage - RsPeCantOpen = 'Cannot open file "%s"'; - RsPeNotPE = 'This is not a PE format'; - RsPeUnknownTarget = 'Unknown PE target'; - RsPeNotResDir = 'Not a resource directory'; - RsPeNotAvailableForAttached = 'Feature is not available for attached images'; - RsPeSectionNotFound = 'Section "%s" not found'; - - // PE directory names - RsPeImg_00 = 'Exports'; - RsPeImg_01 = 'Imports'; - RsPeImg_02 = 'Resources'; - RsPeImg_03 = 'Exceptions'; - RsPeImg_04 = 'Security'; - RsPeImg_05 = 'Base Relocations'; - RsPeImg_06 = 'Debug'; - RsPeImg_07 = 'Description'; - RsPeImg_08 = 'Machine Value'; - RsPeImg_09 = 'TLS'; - RsPeImg_10 = 'Load configuration'; - RsPeImg_11 = 'Bound Import'; - RsPeImg_12 = 'IAT'; - RsPeImg_13 = 'Delay load import'; - RsPeImg_14 = 'COM run-time'; - RsPeImg_Reserved = 'reserved [%.2d]'; - - // NT Header names - RsPeSignature = 'Signature'; - RsPeMachine = 'Machine'; - RsPeNumberOfSections = 'Number of Sections'; - RsPeTimeDateStamp = 'Time Date Stamp'; - RsPePointerToSymbolTable = 'Symbols Pointer'; - RsPeNumberOfSymbols = 'Number of Symbols'; - RsPeSizeOfOptionalHeader = 'Size of Optional Header'; - RsPeCharacteristics = 'Characteristics'; - RsPeMagic = 'Magic'; - RsPeLinkerVersion = 'Linker Version'; - RsPeSizeOfCode = 'Size of Code'; - RsPeSizeOfInitializedData = 'Size of Initialized Data'; - RsPeSizeOfUninitializedData = 'Size of Uninitialized Data'; - RsPeAddressOfEntryPoint = 'Address of Entry Point'; - RsPeBaseOfCode = 'Base of Code'; - RsPeBaseOfData = 'Base of Data'; - RsPeImageBase = 'Image Base'; - RsPeSectionAlignment = 'Section Alignment'; - RsPeFileAlignment = 'File Alignment'; - RsPeOperatingSystemVersion = 'Operating System Version'; - RsPeImageVersion = 'Image Version'; - RsPeSubsystemVersion = 'Subsystem Version'; - RsPeWin32VersionValue = 'Win32 Version'; - RsPeSizeOfImage = 'Size of Image'; - RsPeSizeOfHeaders = 'Size of Headers'; - RsPeCheckSum = 'CheckSum'; - RsPeSubsystem = 'Subsystem'; - RsPeDllCharacteristics = 'Dll Characteristics'; - RsPeSizeOfStackReserve = 'Size of Stack Reserve'; - RsPeSizeOfStackCommit = 'Size of Stack Commit'; - RsPeSizeOfHeapReserve = 'Size of Heap Reserve'; - RsPeSizeOfHeapCommit = 'Size of Heap Commit'; - RsPeLoaderFlags = 'Loader Flags'; - RsPeNumberOfRvaAndSizes = 'Number of RVA'; - - // Load config names - RsPeVersion = 'Version'; - RsPeGlobalFlagsClear = 'GlobalFlagsClear'; - RsPeGlobalFlagsSet = 'GlobalFlagsSet'; - RsPeCriticalSectionDefaultTimeout = 'CriticalSectionDefaultTimeout'; - RsPeDeCommitFreeBlockThreshold = 'DeCommitFreeBlockThreshold'; - RsPeDeCommitTotalFreeThreshold = 'DeCommitTotalFreeThreshold'; - RsPeLockPrefixTable = 'LockPrefixTable'; - RsPeMaximumAllocationSize = 'MaximumAllocationSize'; - RsPeVirtualMemoryThreshold = 'VirtualMemoryThreshold'; - RsPeProcessHeapFlags = 'ProcessHeapFlags'; - RsPeProcessAffinityMask = 'ProcessAffinityMask'; - RsPeCSDVersion = 'CSDVersion'; - RsPeReserved = 'Reserved'; - RsPeEditList = 'EditList'; - - // Machine names - RsPeMACHINE_UNKNOWN = 'Unknown'; - RsPeMACHINE_I386 = 'Intel 386'; - RsPeMACHINE_R3000 = 'MIPS little-endian R3000'; - RsPeMACHINE_R4000 = 'MIPS little-endian R4000'; - RsPeMACHINE_R10000 = 'MIPS little-endian R10000'; - RsPeMACHINE_WCEMIPSV2 = 'MIPS little-endian WCE v2'; - RsPeMACHINE_ALPHA = 'Alpha_AXP'; - RsPeMACHINE_SH3 = 'SH3 little-endian'; - RsPeMACHINE_SH3DSP = 'SH3 DSP'; - RsPeMACHINE_SH3E = 'SH3E little-endian'; - RsPeMACHINE_SH4 = 'SH4 little-endian'; - RsPeMACHINE_SH5 = 'SH5'; - RsPeMACHINE_ARM = 'ARM Little-Endian'; - RsPeMACHINE_THUMB = 'THUMB'; - RsPeMACHINE_AM33 = 'AM33'; - RsPeMACHINE_POWERPC = 'IBM PowerPC Little-Endian'; - RsPeMACHINE_POWERPCFP = 'IBM PowerPC FP'; - RsPeMACHINE_IA64 = 'Intel 64'; - RsPeMACHINE_MIPS16 = 'MIPS16'; - RsPeMACHINE_AMPHA64 = 'ALPHA64'; - RsPeMACHINE_MIPSFPU = 'MIPSFPU'; - RsPeMACHINE_MIPSFPU16 = 'MIPSFPU16'; - RsPeMACHINE_TRICORE = 'Infineon'; - RsPeMACHINE_CEF = 'CEF'; - RsPeMACHINE_EBC = 'EFI Byte Code'; - RsPeMACHINE_AMD64 = 'AMD64 (K8)'; - RsPeMACHINE_M32R = 'M32R little-endian'; - RsPeMACHINE_CEE = 'CEE'; - - // Subsystem names - RsPeSUBSYSTEM_UNKNOWN = 'Unknown'; - RsPeSUBSYSTEM_NATIVE = 'Native'; - RsPeSUBSYSTEM_WINDOWS_GUI = 'GUI'; - RsPeSUBSYSTEM_WINDOWS_CUI = 'Console'; - RsPeSUBSYSTEM_OS2_CUI = 'OS/2'; - RsPeSUBSYSTEM_POSIX_CUI = 'Posix'; - RsPeSUBSYSTEM_RESERVED8 = 'Reserved 8'; - - // Debug symbol type names - RsPeDEBUG_UNKNOWN = 'UNKNOWN'; - RsPeDEBUG_COFF = 'COFF'; - RsPeDEBUG_CODEVIEW = 'CODEVIEW'; - RsPeDEBUG_FPO = 'FPO'; - RsPeDEBUG_MISC = 'MISC'; - RsPeDEBUG_EXCEPTION = 'EXCEPTION'; - RsPeDEBUG_FIXUP = 'FIXUP'; - RsPeDEBUG_OMAP_TO_SRC = 'OMAP_TO_SRC'; - RsPeDEBUG_OMAP_FROM_SRC = 'OMAP_FROM_SRC'; - RsPeDEBUG_BORLAND = 'BORLAND'; - - // TJclPePackageInfo.PackageModuleTypeToString - RsPePkgExecutable = 'Executable'; - RsPePkgPackage = 'Package'; - PsPePkgLibrary = 'Library'; - - // TJclPePackageInfo.PackageOptionsToString - RsPePkgNeverBuild = 'NeverBuild'; - RsPePkgDesignOnly = 'DesignOnly'; - RsPePkgRunOnly = 'RunOnly'; - RsPePkgIgnoreDupUnits = 'IgnoreDupUnits'; - - // TJclPePackageInfo.ProducerToString - RsPePkgV3Produced = 'Delphi 3 or C++ Builder 3'; - RsPePkgProducerUndefined = 'Undefined'; - RsPePkgBCB4Produced = 'C++ Builder 4 or later'; - RsPePkgDelphi4Produced = 'Delphi 4 or later'; - - // TJclPePackageInfo.UnitInfoFlagsToString - RsPePkgMain = 'Main'; - RsPePkgWeak = 'Weak'; - RsPePkgOrgWeak = 'OrgWeak'; - RsPePkgImplicit = 'Implicit'; - -//=== JclRegistry ============================================================ -resourcestring - RsUnableToOpenKeyRead = 'Unable to open key "%s\%s" for read'; - RsUnableToOpenKeyWrite = 'Unable to open key "%s\%s" for write'; - RsUnableToAccessValue = 'Unable to open key "%s\%s" and access value "%s"'; - RsWrongDataType = '"%s\%s\%s" is of wrong kind or size'; - RsInconsistentPath = '"%s" does not match RootKey'; - -//=== JclRTTI ================================================================ -resourcestring - RsRTTISetValueOutOfRange = 'Set value over %s does not fit into a 32-bit integer.'; - RsRTTIValueOutOfRange = 'Value %s out of range %s..%s.'; - RsRTTIUnknownIdentifier = 'Unknown identifier ''%s''.'; - RsRTTIInvalidBaseType = 'Invalid base type (%s is of type %s).'; - RsRTTINoStringValue = 'The property %s of type %s has no string value'; - - RsRTTIVar = 'var '; - RsRTTIConst = 'const '; - RsRTTIArrayOf = 'array of '; - RsRTTIOut = 'out '; - RsRTTIBits = 'bits'; - RsRTTIOrdinal = 'ordinal='; - RsRTTITrue = 'True'; - RsRTTIFalse = 'False'; - RsRTTITypeError = '???'; - RsRTTITypeInfoAt = 'Type info: %p'; - - RsRTTIPropRead = 'read'; - RsRTTIPropWrite = 'write'; - RsRTTIPropStored = 'stored'; - - RsRTTIField = 'field'; - RsRTTIStaticMethod = 'static method'; - RsRTTIVirtualMethod = 'virtual method'; - - RsRTTIIndex = 'index'; - RsRTTIDefault = 'default'; - - RsRTTIName = 'Name: '; - RsRTTIType = 'Type: '; - RsRTTIFlags = 'Flags: '; - RsRTTIGUID = 'GUID: '; - RsRTTITypeKind = 'Type kind: '; - RsRTTIOrdinalType = 'Ordinal type: '; - RsRTTIMinValue = 'Min value: '; - RsRTTIMaxValue = 'Max value: '; - RsRTTINameList = 'Names: '; - RsRTTIClassName = 'Class name: '; - RsRTTIParent = 'Parent: '; - RsRTTIPropCount = 'Property count: '; - RsRTTIUnitName = 'Unit name: '; - RsRTTIBasedOn = 'Based on: '; - RsRTTIFloatType = 'Float type: '; - RsRTTIMethodKind = 'Method kind: '; - RsRTTIParamCount = 'Parameter count: '; - RsRTTIReturnType = 'Return type: '; - RsRTTIMaxLen = 'Max length: '; - RsRTTIElSize = 'Element size: '; - RsRTTIElType = 'Element type: '; - RsRTTIElNeedCleanup = 'Elements need clean up: '; - RsRTTIVarType = 'Variant type: '; - - RsDeclarationFormat = '// Declaration for ''%s'' not supported.'; - -//=== JclSchedule ============================================================ -resourcestring - RsScheduleInvalidTime = 'Invalid time specification'; - RsScheduleEndBeforeStart = 'End time can not be before start time'; - RsScheduleIntervalZero = 'Interval should be larger than 0'; - RsScheduleNoDaySpecified = 'At least one day of the week should be specified'; - RsScheduleIndexValueSup = 'Property IndexValue not supported for current IndexKind'; - RsScheduleIndexValueZero = 'IndexValue can not be 0'; - RsScheduleDayNotSupported = 'Property Day not supported for current IndexKind'; - RsScheduleDayInRange = 'Day values should fall in the range 1 .. 31'; - RsScheduleMonthInRange = 'Month values should fall in the range 1 .. 12'; - -//=== JclSecurity ============================================================ -resourcestring - RsInvalidSID = 'Invalid SID'; - RsSIDBufferTooSmall = 'SID buffer too small.'; - RsLsaError = 'LSA Error: NT Status = %.8x, message: %s'; - -//=== JclSimpleXml =========================================================== -resourcestring - RsEInvalidXMLElementUnexpectedCharacte = - 'Invalid XML Element: Unexpected character in property declaration ("%s" found at position %d)'; - RsEInvalidXMLElementUnexpectedCharacte_ = - 'Invalid XML Element: Unexpected character in property declaration. Expecting " or '' but "%s" found at position %d'; - RsEUnexpectedValueForLPos = 'Unexpected value for lPos at position %d'; - RsEInvalidXMLElementExpectedBeginningO = 'Invalid XML Element: Expected beginning of tag but "%s" found at position %d'; - RsEInvalidXMLElementExpectedEndOfTagBu = 'Invalid XML Element: Expected end of tag but "%s" found at position %d'; - RsEInvalidXMLElementMalformedTagFoundn = 'Invalid XML Element: malformed tag found (no valid name) at position %d'; - RsEInvalidXMLElementErroneousEndOfTagE = - 'Invalid XML Element: Erroneous end of tag, expecting but found at position %d'; - RsEInvalidCommentExpectedsButFounds = 'Invalid Comment: expected "%0:s" but found "%1:s" at position %d'; - RsEInvalidCommentNotAllowedInsideComme = 'Invalid Comment: "--" not allowed inside comments at position %d'; - RsEInvalidCommentUnexpectedEndOfData = 'Invalid Comment: Unexpected end of data at position %d'; - RsEInvalidCDATAExpectedsButFounds = 'Invalid CDATA: expected "%0:s" but found "%1:s" at position %d'; - RsEInvalidCDATAUnexpectedEndOfData = 'Invalid CDATA: Unexpected end of data at position %d'; - RsEInvalidHeaderExpectedsButFounds = 'Invalid Header: expected "%0:s" but found "%1:s" at position %d'; - RsEInvalidStylesheetExpectedsButFounds = 'Invalid Stylesheet: expected "%0:s" but found "%1:s" at position %d'; - RsEInvalidStylesheetUnexpectedEndOfDat = 'Invalid Stylesheet: Unexpected end of data at position %d'; - RsEInvalidMSOExpectedsButFounds = 'Invalid MSO: expected "%0:s" but found "%1:s" at position %d'; - RsEInvalidMSOUnexpectedEndOfDat = 'Invalid MSO: Unexpected end of data at position %d'; - RsEInvalidDocumentUnexpectedTextInFile = 'Invalid Document: Unexpected text in file prolog at position %d'; - -//=== JclStatistics ========================================================== -resourcestring - RsInvalidSampleSize = 'Invalid sample size (%d)'; - -//=== JclStreams ============================================================= -resourcestring - RsStreamsCreateError = 'Cannot create file %s'; - RsStreamsOpenError = 'Cannot open file %s'; - RsStreamsSetSizeError = 'Error setting stream size'; - RsStreamsSeekError = 'Error seeking stream'; - RsStreamsCRCError = 'Cyclic Redundency Check (CRC) error: data are damaged'; - -//=== JclStrHashMap ========================================================== -resourcestring - RsStringHashMapMustBeEmpty = 'HashList: must be empty to set size to zero'; - RsStringHashMapDuplicate = 'Duplicate hash list entry: %s'; - RsStringHashMapInvalidNode = 'Tried to remove invalid node: %s'; - RsStringHashMapNoTraits = 'HashList must have traits'; - -//=== JclStrings ============================================================= -resourcestring - RsBlankSearchString = 'Search string cannot be blank'; - RsInvalidEmptyStringItem = 'String list passed to StringsToMultiSz cannot contain empty strings.'; - RsNumericConstantTooLarge = 'Numeric constant too large (%d) at position %d.'; - RsFormatException = 'Format exception'; - RsDotNetFormatNullFormat = 'Format string is null'; - RsArgumentIsNull = 'Argument %d is null'; - RsDotNetFormatArgumentNotSupported = 'Argument type of %d is not supported'; - RsDotNetFormatObjectArgumentNotSupported = 'Argument type (%s) of %d is not supported'; - RsArgumentOutOfRange = 'Argument out of range'; - RsTabs_DuplicatesNotAllowed = 'Duplicate tab stops are not allowed.'; - RsTabs_StopExpected = 'A tab stop was expected but not found.'; - RsTabs_CloseBracketExpected = 'Closing bracket expected.'; - RsTabs_TabWidthExpected = 'Tab width expected.'; - // Default text for the NullReferenceException in .NET - RsArg_NullReferenceException = 'Object reference not set to an instance of an object.'; - -//=== JclStructStorage ======================================================= -resourcestring - RsIStreamNil = 'IStream is nil'; - -//=== JclSynch =============================================================== -resourcestring - RsSynchAttachWin32Handle = 'Invalid handle to TJclWin32HandleObject.Attach'; - RsSynchDuplicateWin32Handle = 'Invalid handle to TJclWin32HandleObject.Duplicate'; - RsSynchInitCriticalSection = 'Failed to initalize critical section'; - RsSynchAttachDispatcher = 'Invalid handle to TJclDispatcherObject.Attach'; - RsSynchCreateEvent = 'Failed to create event'; - RsSynchOpenEvent = 'Failed to open event'; - RsSynchCreateWaitableTimer = 'Failed to create waitable timer'; - RsSynchOpenWaitableTimer = 'Failed to open waitable timer'; - RsSynchCreateSemaphore = 'Failed to create semaphore'; - RsSynchOpenSemaphore = 'Failed to open semaphore'; - RsSynchCreateMutex = 'Failed to create mutex'; - RsSynchOpenMutex = 'Failed to open mutex'; - RsMetSectInvalidParameter = 'An invalid parameter was passed to the constructor.'; - RsMetSectInitialize = 'Failed to initialize the metered section.'; - RsMetSectNameEmpty = 'Name cannot be empty when using the Open constructor.'; - -//=== JclSysInfo ============================================================= -resourcestring - RsSystemProcess = 'System Process'; - RsSystemIdleProcess = 'System Idle Process'; - - RsIntelUnknownCache = 'Unknown cache ID (%.2x)'; - RsIntelCacheDescr00 = 'Null descriptor'; - RsIntelCacheDescr01 = 'Instruction TLB: 4 KByte pages, 4-way set associative, 32 entries'; - RsIntelCacheDescr02 = 'Instruction TLB: 4 MByte pages, 4-way set associative, 2 entries'; - RsIntelCacheDescr03 = 'Data TLB: 4 KByte pages, 4-way set associative, 64 entries'; - RsIntelCacheDescr04 = 'Data TLB: 4 MByte pages, 4-way set associative, 8 entries'; - RsIntelCacheDescr05 = 'Data TLB1: 4 MByte pages, 4-way set associative, 32 entries'; - RsIntelCacheDescr06 = '1st level instruction cache: 8 KBytes, 4-way set associative, 32 byte line size'; - RsIntelCacheDescr08 = '1st level instruction cache: 16 KBytes, 4-way set associative, 32 byte line size'; - RsIntelCacheDescr09 = '1st level instruction cache: 32 KBytes, 4-way set associative, 64 byte line size'; - RsIntelCacheDescr0A = '1st level data cache: 8 KBytes, 2-way set associative, 32 byte line size'; - RsIntelCacheDescr0B = 'Instruction TLB: 4 MByte pages, 4-way set associative, 4 entries'; - RsIntelCacheDescr0C = '1st level data cache: 16 KBytes, 4-way set associative, 32 byte line size'; - RsIntelCacheDescr0D = '1st level data cache: 16 KBytes, 4-way set associative, 64 byte line size'; - RsIntelCacheDescr0E = '1st level data cache: 24 KBytes, 6-way set associative, 64 byte line size'; - RsIntelCacheDescr21 = '2nd level cache: 256 KBytes, 8-way set associative, 64 byte line size'; - RsIntelCacheDescr22 = '3rd level cache: 512 KBytes, 4-way set associative, 64 byte line size, 2 lines per sector'; - RsIntelCacheDescr23 = '3rd level cache: 1 MBytes, 8-way set associative, 64 byte line size, 2 lines per sector'; - RsIntelCacheDescr25 = '3rd level cache: 2 MBytes, 8-way set associative, 64 byte line size, 2 lines per sector'; - RsIntelCacheDescr29 = '3rd level cache: 4 MBytes, 8-way set associative, 64 byte line size, 2 lines per sector'; - RsIntelCacheDescr2C = '1st level data cache: 32 KBytes, 8-way set associative, 64 byte line size'; - RsIntelCacheDescr30 = '1st level instruction cache: 32 KBytes, 8-way set associative, 64 byte line size'; - RsIntelCacheDescr39 = '2nd-level cache: 128 KBytes, 4-way set associative, sectored cache, 64-byte line size'; - RsIntelCacheDescr3A = '2nd-level cache: 192 KBytes, 6-way set associative, sectored cache, 64-byte line size'; - RsIntelCacheDescr3B = '2nd-level cache: 128 KBytes, 2-way set associative, sectored cache, 64-byte line size'; - RsIntelCacheDescr3C = '2nd-level cache: 256 KBytes, 4-way set associative, sectored cache, 64-byte line size'; - RsIntelCacheDescr3D = '2nd-level cache: 384 KBytes, 6-way set associative, sectored cache, 64-byte line size'; - RsIntelCacheDescr3E = '2nd-level cache: 512 KBytes, 4-way set associative, sectored cache, 64-byte line size'; - RsIntelCacheDescr40 = 'No 2nd-level cache or, if processor contains a valid 2nd-level cache, no 3rd-level cache'; - RsIntelCacheDescr41 = '2nd-level cache: 128 KBytes, 4-way set associative, 32 byte line size'; - RsIntelCacheDescr42 = '2nd-level cache: 256 KBytes, 4-way set associative, 32 byte line size'; - RsIntelCacheDescr43 = '2nd-level cache: 512 KBytes, 4-way set associative, 32 byte line size'; - RsIntelCacheDescr44 = '2nd-level cache: 1 MBytes, 4-way set associative, 32 byte line size'; - RsIntelCacheDescr45 = '2nd-level cache: 2 MBytes, 4-way set associative, 32 byte line size'; - RsIntelCacheDescr46 = '3rd-level cache: 4 MBytes, 4-way set associative, 64 byte line size'; - RsIntelCacheDescr47 = '3rd-level cache: 8 MBytes, 4-way set associative, 64 byte line size'; - RsIntelCacheDescr48 = '3rd-level cache: 8 MByte, 8-way set associative, 64 byte line size'; - RsIntelCacheDescr49 = '2nd-level cache: 4 MBytes, 16-way set associative, 64 byte line size'; - RsIntelCacheDescr4A = '3rd-level cache: 6MByte, 12-way set associative, 64 byte line size'; - RsIntelCacheDescr4B = '3rd-level cache: 8MByte, 16-way set associative, 64 byte line size'; - RsIntelCacheDescr4C = '3rd-level cache: 12MByte, 12-way set associative, 64 byte line size'; - RsIntelCacheDescr4D = '3rd-level cache: 16MByte, 16-way set associative, 64 byte line size'; - RsIntelCacheDescr4E = '2nd-level cache: 6MByte, 24-way set associative, 64 byte line size'; - RsIntelCacheDescr4F = 'Instruction TLB: 4 KByte pages, 32 Entries'; - RsIntelCacheDescr50 = 'Instruction TLB: 4 KByte and 2 MByte or 4 MByte pages, 64 Entries'; - RsIntelCacheDescr51 = 'Instruction TLB: 4 KByte and 2 MByte or 4 MByte pages, 128 Entries'; - RsIntelCacheDescr52 = 'Instruction TLB: 4 KByte and 2 MByte or 4 MByte pages, 256 Entries'; - RsIntelCacheDescr55 = 'Instruction TLB: 2-MByte or 4-MByte pages, fully associative, 7 entries'; - RsIntelCacheDescr56 = 'Data TLB0: 4 MByte pages, 4-way set associative, 16 entries'; - RsIntelCacheDescr57 = 'Data TLB0: 4 KByte pages, 4-way associative, 16 entries'; - RsIntelCacheDescr59 = 'Data TLB0: 4 KByte pages, fully associative, 16 entries'; - RsIntelCacheDescr5A = 'Data TLB0: 2 MByte or 4 MByte pages, 4-way set associative, 32 entries'; - RsIntelCacheDescr5B = 'Data TLB: 4 KByte and 4 MByte pages, 64 Entries'; - RsIntelCacheDescr5C = 'Data TLB: 4 KByte and 4 MByte pages, 128 Entries'; - RsIntelCacheDescr5D = 'Data TLB: 4 KByte and 4 MByte pages, 256 Entries'; - RsIntelCacheDescr60 = '1st-level data cache: 16 KByte, 8-way set associative, 64 byte line size'; - RsIntelCacheDescr66 = '1st-level data cache: 8 KBytes, 4-way set associative, 64 byte line size'; - RsIntelCacheDescr67 = '1st-level data cache: 16 KBytes, 4-way set associative, 64 byte line size'; - RsIntelCacheDescr68 = '1st-level data cache: 32 KBytes, 4-way set associative, 64 byte line size'; - RsIntelCacheDescr70 = 'Trace cache: 12 K-Ops, 8-way set associative'; - RsIntelCacheDescr71 = 'Trace cache: 16 K-Ops, 8-way set associative'; - RsIntelCacheDescr72 = 'Trace cache: 32 K-Ops, 8-way set associative'; - RsIntelCacheDescr73 = 'Trace cache: 64 K-Ops, 8-way set associative'; - RsIntelCacheDescr76 = 'Instruction TLB: 2M/4M pages, fully associative, 8 entries'; - RsIntelCacheDescr78 = '2nd-level cache: 1 MBytes, 4-way set associative, 64 bytes line size'; - RsIntelCacheDescr79 = '2nd-level cache: 128 KBytes, 8-way set associative, 64 bytes line size, 2 lines per sector'; - RsIntelCacheDescr7A = '2nd-level cache: 256 KBytes, 8-way set associative, 64 bytes line size, 2 lines per sector'; - RsIntelCacheDescr7B = '2nd-level cache: 512 KBytes, 8-way set associative, 64 bytes line size, 2 lines per sector'; - RsIntelCacheDescr7C = '2nd-level cache: 1 MBytes, 8-way set associative, 64 bytes line size, 2 lines per sector'; - RsIntelCacheDescr7D = '2nd-level cache: 2 MBytes, 8-way set associative, 64 byte line size'; - RsIntelCacheDescr7F = '2nd-level cache: 512 KBytes, 2-way set associative, 64 byte line size'; - RsIntelCacheDescr80 = '2nd-level cache: 512 KBytes, 8-way set associative, 64 byte line size'; - RsIntelCacheDescr82 = '2nd-level cache: 256 KBytes, 8-way associative, 32 byte line size'; - RsIntelCacheDescr83 = '2nd-level cache: 512 KBytes, 8-way associative, 32 byte line size'; - RsIntelCacheDescr84 = '2nd-level cache: 1 MBytes, 8-way associative, 32 byte line size'; - RsIntelCacheDescr85 = '2nd-level cache: 2 MBytes, 8-way associative, 32 byte line size'; - RsIntelCacheDescr86 = '2nd-level cache: 512 KByte, 4-way set associative, 64 byte line size'; - RsIntelCacheDescr87 = '2nd-level cache: 1 MByte, 8-way set associative, 64 byte line size'; - RsIntelCacheDescrB0 = 'Instruction TLB: 4 KByte pages, 4-way set associative, 128 entries'; - RsIntelCacheDescrB1 = 'Instruction TLB: 2 MByte pages, 4-way, 8 entries or 4 MByte pages, 4-way, 4 entries'; - RsIntelCacheDescrB2 = 'Instruction TLB: 4 KByte pages, 4-way set associative, 64 entries'; - RsIntelCacheDescrB3 = 'Data TLB: 4 KByte pages, 4-way set associative, 128 entries'; - RsIntelCacheDescrB4 = 'Data TLB1: 4 KByte pages, 4-way set associative, 256 entries'; - RsIntelCacheDescrBA = 'Data TLB1: 4 KByte pages, 4-way set associative, 64 entries'; - RsIntelCacheDescrC0 = 'Data TLB: 4 KByte and 4 MByte pages, 4-way set associative, 8 entries'; - RsIntelCacheDescrCA = 'Shared 2nd-Level TLB: 4 KByte pages, 4-way associative, 512 entries'; - RsIntelCacheDescrD0 = '3rd-level cache: 512 KByte, 4-way set associative, 64 byte line size'; - RsIntelCacheDescrD1 = '3rd-level cache: 1 MByte, 4-way set associative, 64 byte line size'; - RsIntelCacheDescrD2 = '3rd-level cache: 2 MByte, 4-way set associative, 64 byte line size'; - RsIntelCacheDescrD6 = '3rd-level cache: 1 MByte, 8-way set associative, 64 byte line size'; - RsIntelCacheDescrD7 = '3rd-level cache: 2 MByte, 8-way set associative, 64 byte line size'; - RsIntelCacheDescrD8 = '3rd-level cache: 4 MByte, 8-way set associative, 64 byte line size'; - RsIntelCacheDescrDC = '3rd-level cache: 1.5 MByte, 12-way set associative, 64 byte line size'; - RsIntelCacheDescrDD = '3rd-level cache: 3 MByte, 12-way set associative, 64 byte line size'; - RsIntelCacheDescrDE = '3rd-level cache: 6 MByte, 12-way set associative, 64 byte line size'; - RsIntelCacheDescrE2 = '3rd-level cache: 2 MByte, 16-way set associative, 64 byte line size'; - RsIntelCacheDescrE3 = '3rd-level cache: 4 MByte, 16-way set associative, 64 byte line size'; - RsIntelCacheDescrE4 = '3rd-level cache: 8 MByte, 16-way set associative, 64 byte line size'; - RsIntelCacheDescrEA = '3rd-level cache: 12 MByte, 24-way set associative, 64 byte line size'; - RsIntelCacheDescrEB = '3rd-level cache: 18 MByte, 24-way set associative, 64 byte line size'; - RsIntelCacheDescrEC = '3rd-level cache: 24 MByte, 24-way set associative, 64 byte line size'; - RsIntelCacheDescrF0 = '64-Byte Prefetching'; - RsIntelCacheDescrF1 = '128-Byte Prefetching'; - RsIntelCacheDescrFF = 'CPUID leaf 2 does not report cache descriptor information, use CPUID leaf 4 to query cache parameters'; - - RsUnknownAMDModel = 'Unknown AMD (Model %d)'; - - RsOSVersionWin95 = 'Windows 95'; - RsOSVersionWin95OSR2 = 'Windows 95 OSR2'; - RsOSVersionWin98 = 'Windows 98'; - RsOSVersionWin98SE = 'Windows 98 SE'; - RsOSVersionWinME = 'Windows ME'; - RsOSVersionWinNT3 = 'Windows NT 3.%u'; - RsOSVersionWinNT4 = 'Windows NT 4.%u'; - RsOSVersionWin2000 = 'Windows 2000'; - RsOSVersionWinXP = 'Windows XP'; - RsOSVersionWin2003 = 'Windows Server 2003'; - RsOSVersionWin2003R2 = 'Windows Server 2003 R2'; - RsOSVersionWinXP64 = 'Windows XP x64'; - RsOSVersionWinVista = 'Windows Vista'; - RsOSVersionWinServer2008 = 'Windows Server 2008'; - RsOSVersionWin7 = 'Windows 7'; - RsOSVersionWinServer2008R2 = 'Windows Server 2008 R2'; - RsOSVersionWin8 = 'Windows 8'; - RsOSVersionWin8RT = 'Windows RT'; - RsOSVersionWinServer2012 = 'Windows Server 2012'; - RsOSVersionWin81 = 'Windows 8.1'; - RsOSVersionWin81RT = 'Windows RT 8.1'; - RsOSVersionWinServer2012R2 = 'Windows Server 2012 R2'; - RsOSVersionWin10 = 'Windows 10'; - RsOSVersionWinServer2016 = 'Windows Server 2016'; - RsOSVersionWinServer2019 = 'Windows Server 2019'; - RsOSVersionWinServer2022 = 'Windows Server 2022'; - RsOSVersionWinServer = 'Windows Server'; - RsOSVersionWin11 = 'Windows 11'; - - RsEditionWinXPHome = 'Home Edition'; - RsEditionWinXPPro = 'Professional'; - RsEditionWinXPHomeN = 'Home Edition N'; - RsEditionWinXPProN = 'Professional N'; - RsEditionWinXPHomeK = 'Home Edition K'; - RsEditionWinXPProK = 'Professional K'; - RsEditionWinXPHomeKN = 'Home Edition KN'; - RsEditionWinXPProKN = 'Professional KN'; - RsEditionWinXPStarter = 'Starter Edition'; - RsEditionWinXPMediaCenter = 'Media Center Edition'; - RsEditionWinXPTablet = 'Tablet PC Edition'; - RsEditionWinVistaStarter = 'Starter'; - RsEditionWinVistaHomeBasic = 'Home Basic'; - RsEditionWinVistaHomeBasicN = 'Home Basic N'; - RsEditionWinVistaHomePremium = 'Home Premium'; - RsEditionWinVistaBusiness = 'Business'; - RsEditionWinVistaBusinessN = 'Business N'; - RsEditionWinVistaEnterprise = 'Enterprise'; - RsEditionWinVistaUltimate = 'Ultimate'; - RsEditionWin7Starter = 'Starter'; - RsEditionWin7HomeBasic = 'Home Basic'; - RsEditionWin7HomePremium = 'Home Premium'; - RsEditionWin7Professional = 'Professional'; - RsEditionWin7Enterprise = 'Enterprise'; - RsEditionWin7Ultimate = 'Ultimate'; - RsEditionWin8Pro = 'Pro'; - RsEditionWin8Enterprise = 'Enterprise'; - RsEditionWin8RT = 'RT'; - RsEditionWin81Pro = 'Pro'; - RsEditionWin81Enterprise = 'Enterprise'; - RsEditionWin81RT = 'RT'; - RsEditionWin10Home = 'Home'; - RsEditionWin10Pro = 'Pro'; - RsEditionWin10Enterprise = 'Enterprise'; - RsEditionWin10Education = 'Education'; - - RsProductTypeWorkStation = 'Workstation'; - RsProductTypeServer = 'Server'; - RsProductTypeAdvancedServer = 'Advanced Server'; - RsProductTypePersonal = 'Home Edition'; - RsProductTypeProfessional = 'Professional'; - RsProductTypeDatacenterServer = 'Datacenter Server'; - RsProductTypeEnterprise = 'Enterprise'; - RsProductTypeWebEdition = 'Web Edition'; - - RsEOpenGLInfo = 'GetOpenGLVersion: %s failed'; - RsENetWkstaGetInfo = 'NetWkstaGetInfo failed'; - - {$IFDEF MSWINDOWS} - RsSPInfo = 'SP%u'; - {$ENDIF MSWINDOWS} - - {$IFDEF UNIX} - RsInvalidProcessID = 'Invalid process ID %d'; - {$ENDIF UNIX} - - RsOpenGLInfoError = 'Err'; - -//=== JclSysUtils ============================================================ -resourcestring - RsVMTMemoryWriteError = 'Error writing VMT memory (%s)'; - RsCannotWriteRefStream = 'Can not write to a read-only memory stream'; - RsStringToBoolean = 'Unable to convert the string "%s" to a boolean'; - RsInvalidDigit = 'Invalid base %d digit ''%s'' encountered.'; - RsInvalidDigitValue = 'There is no valid base %d digit for decimal value %d'; - - {$IFDEF UNIX} - RsReadKeyError = 'ReadKey: Problem waiting on stdin'; - {$ENDIF UNIX} - - RsInvalidGUIDString = 'Invalid conversion from string to GUID (%s).'; - - RsInvalidMMFName = 'Invalid MMF name "%s"'; - RsInvalidMMFEmpty = 'The MMF named "%s" cannot be created empty'; - -//=== JclTD32 ================================================================ -resourcestring - RsHasNotTD32Info = 'File [%s] has not TD32 debug information!'; - -//=== JclTimeZones =========================================================== -resourcestring - RsEDaylightSavingsNotSupported = 'Daylight Savings not supported by this timezone'; - RsEAutoAdjustNotEnabled = 'Auto adjust for Daylight Savings is not enabled. Date is not available'; - RsENoCallbackFunc = 'No callback function assigned'; - -//=== JclUnicode ============================================================= -resourcestring - RsUREErrorFmt = '%s%s%s'; - RsUREBaseString = 'Error in regular expression: %s' + sLineBreak; - RsUREUnexpectedEOS = 'Unexpected end of pattern.'; - RsURECharacterClassOpen = 'Character class not closed, '']'' is missing.'; - RsUREUnbalancedGroup = 'Unbalanced group expression, '')'' is missing.'; - RsUREInvalidCharProperty = 'A character property is invalid'; - RsUREInvalidRepeatRange = 'Invalid repetition range.'; - RsURERepeatRangeOpen = 'Repetition range not closed, ''}'' is missing.'; - RsUREExpressionEmpty = 'Expression is empty.'; - RsCategoryUnicodeChar = 'category Unicode character > $FFFFFF found'; - RsCasedUnicodeChar = 'cased Unicode character > $FFFFFF found'; - RsDecomposedUnicodeChar = 'decomposed Unicode character > $FFFFFF found'; - RsCombiningClassUnicodeChar = 'combining class for Unicode character > $FFFFFF found'; - RsEUnexpectedEOSeq = 'Unexpected end of sequence'; - -//=== JclUnitConv ============================================================ -resourcestring - RsTempConvTypeError = 'An invalid type has been provided for the %s parameter'; - RsConvTempBelowAbsoluteZero = 'Temperature can not be below Absolute Zero!'; - -//=== JclWin32 =============================================================== -resourcestring - RsWin32Error = 'Win32 error: %s (%u)%s%s'; - RsELibraryNotFound = 'Library not found: %s'; - RsEFunctionNotFound = 'Function not found: %s.%s'; - -//=== JclWinMidi ============================================================= -resourcestring - RsMidiInUnknownError = 'Unknown MIDI-In error No. %d'; - RsMidiOutUnknownError = 'Unknown MIDI-Out error No. %d'; - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\common'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -{$IFDEF UNITVERSIONING} -initialization - RegisterUnitVersion(HInstance, UnitVersioning); - -finalization - UnregisterUnitVersion(HInstance); -{$ENDIF UNITVERSIONING} - -end. +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclResources.pas. } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. } +{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. All rights reserved. } +{ } +{ Contributors: } +{ Alexei Koudinov } +{ Barry Kelly } +{ Flier Lu (flier) } +{ Florent Ouchet (outchy) } +{ Jean-Fabien Connault (cycocrew) } +{ Marcel Bestebroer } +{ Marcel van Brakel } +{ Matthias Thoma (mthoma) } +{ Peter Friese } +{ Petr Vones (pvones) } +{ Raymond Alexander (rayspostbox3) } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Scott Price (scottprice) } +{ Uwe Schuster (uschuster) } +{ } +{**************************************************************************************************} +{ } +{ Unit which provides a central place for all resource strings used in the JCL } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclResources; + +{$I jcl.inc} + +interface + +{$IFDEF UNITVERSIONING} +uses + JclUnitVersioning; +{$ENDIF UNITVERSIONING} + +//=== JclBase ================================================================ +resourcestring + RsCantConvertAddr64 = 'The address %s%.16x cannot be converted to 32 bit'; + RsEReplacementChar = 'Failed to get ANSI replacement character'; + +//=== JclCharsets ============================================================ +resourcestring + RsENoCharset = 'No matching charset'; + +//=== JclCIL ================================================================= +resourcestring + RsInstructionStreamInvalid = 'Invalid IL instruction stream'; + RsCILNamenop = 'nop'; + RsCILNamebreak = 'break'; + RsCILNameldarg0 = 'ldarg.0'; + RsCILNameldarg1 = 'ldarg.1'; + RsCILNameldarg2 = 'ldarg.2'; + RsCILNameldarg3 = 'ldarg.3'; + RsCILNameldloc0 = 'ldloc.0'; + RsCILNameldloc1 = 'ldloc.1'; + RsCILNameldloc2 = 'ldloc.2'; + RsCILNameldloc3 = 'ldloc.3'; + RsCILNamestloc0 = 'stloc.0'; + RsCILNamestloc1 = 'stloc.1'; + RsCILNamestloc2 = 'stloc.2'; + RsCILNamestloc3 = 'stloc.3'; + RsCILNameldargs = 'ldarg.s'; + RsCILNameldargas = 'ldarga.s'; + RsCILNamestargs = 'starg.s'; + RsCILNameldlocs = 'ldloc.s'; + RsCILNameldlocas = 'ldloca.s'; + RsCILNamestlocs = 'stloc.s'; + RsCILNameldnull = 'ldnull'; + RsCILNameldci4m1 = 'ldc.i4.m1'; + RsCILNameldci40 = 'ldc.i4.0'; + RsCILNameldci41 = 'ldc.i4.1'; + RsCILNameldci42 = 'ldc.i4.2'; + RsCILNameldci43 = 'ldc.i4.3'; + RsCILNameldci44 = 'ldc.i4.4'; + RsCILNameldci45 = 'ldc.i4.5'; + RsCILNameldci46 = 'ldc.i4.6'; + RsCILNameldci47 = 'ldc.i4.7'; + RsCILNameldci48 = 'ldc.i4.8'; + RsCILNameldci4s = 'ldc.i4.s'; + RsCILNameldci4 = 'ldc.i4'; + RsCILNameldci8 = 'ldc.i8'; + RsCILNameldcr4 = 'ldc.r4'; + RsCILNameldcr8 = 'ldc.r8'; + RsCILNameunused1 = 'unused'; + RsCILNamedup = 'dup'; + RsCILNamepop = 'pop'; + RsCILNamejmp = 'jmp'; + RsCILNamecall = 'call'; + RsCILNamecalli = 'calli'; + RsCILNameret = 'ret'; + RsCILNamebrs = 'br.s'; + RsCILNamebrfalses = 'brfalse.s'; + RsCILNamebrtrues = 'brtrue.s'; + RsCILNamebeqs = 'beq.s'; + RsCILNamebges = 'bge.s'; + RsCILNamebgts = 'bgt.s'; + RsCILNamebles = 'ble.s'; + RsCILNameblts = 'blt.s'; + RsCILNamebneuns = 'bne.un.s'; + RsCILNamebgeuns = 'bge.un.s'; + RsCILNamebgtuns = 'bgt.un.s'; + RsCILNamebleuns = 'ble.un.s'; + RsCILNamebltuns = 'blt.un.s'; + RsCILNamebr = 'br'; + RsCILNamebrfalse = 'brfalse'; + RsCILNamebrtrue = 'brtrue'; + RsCILNamebeq = 'beq'; + RsCILNamebge = 'bge'; + RsCILNamebgt = 'bgt'; + RsCILNameble = 'ble'; + RsCILNameblt = 'blt'; + RsCILNamebneun = 'bne.un'; + RsCILNamebgeun = 'bge.un'; + RsCILNamebgtun = 'bgt.un'; + RsCILNamebleun = 'ble.un'; + RsCILNamebltun = 'blt.un'; + RsCILNameswitch = 'switch'; + RsCILNameldindi1 = 'ldind.i1'; + RsCILNameldindu1 = 'ldind.u1'; + RsCILNameldindi2 = 'ldind.i2'; + RsCILNameldindu2 = 'ldind.u2'; + RsCILNameldindi4 = 'ldind.i4'; + RsCILNameldindu4 = 'ldind.u4'; + RsCILNameldindi8 = 'ldind.i8'; + RsCILNameldindi = 'ldind.i'; + RsCILNameldindr4 = 'ldind.r4'; + RsCILNameldindr8 = 'ldind.r8'; + RsCILNameldindref = 'ldind.ref'; + RsCILNamestindref = 'stind.ref'; + RsCILNamestindi1 = 'stind.i1'; + RsCILNamestindi2 = 'stind.i2'; + RsCILNamestindi4 = 'stind.i4'; + RsCILNamestindi8 = 'stind.i8'; + RsCILNamestindr4 = 'stind.r4'; + RsCILNamestindr8 = 'stind.r8'; + RsCILNameadd = 'add'; + RsCILNamesub = 'sub'; + RsCILNamemul = 'mul'; + RsCILNamediv = 'div'; + RsCILNamedivun = 'div.un'; + RsCILNamerem = 'rem'; + RsCILNameremun = 'rem.un'; + RsCILNameand = 'and'; + RsCILNameor = 'or'; + RsCILNamexor = 'xor'; + RsCILNameshl = 'shl'; + RsCILNameshr = 'shr'; + RsCILNameshrun = 'shr.un'; + RsCILNameneg = 'neg'; + RsCILNamenot = 'not'; + RsCILNameconvi1 = 'conv.i1'; + RsCILNameconvi2 = 'conv.i2'; + RsCILNameconvi4 = 'conv.i4'; + RsCILNameconvi8 = 'conv.i8'; + RsCILNameconvr4 = 'conv.r4'; + RsCILNameconvr8 = 'conv.r8'; + RsCILNameconvu4 = 'conv.u4'; + RsCILNameconvu8 = 'conv.u8'; + RsCILNamecallvirt = 'callvirt'; + RsCILNamecpobj = 'cpobj'; + RsCILNameldobj = 'ldobj'; + RsCILNameldstr = 'ldstr'; + RsCILNamenewobj = 'newobj'; + RsCILNamecastclass = 'castclass'; + RsCILNameisinst = 'isinst'; + RsCILNameconvrun = 'conv.r.un'; + RsCILNameunused2 = 'unused'; + RsCILNameunused3 = 'unused'; + RsCILNameunbox = 'unbox'; + RsCILNamethrow = 'throw'; + RsCILNameldfld = 'ldfld'; + RsCILNameldflda = 'ldflda'; + RsCILNamestfld = 'stfld'; + RsCILNameldsfld = 'ldsfld'; + RsCILNameldsflda = 'ldsflda'; + RsCILNamestsfld = 'stsfld'; + RsCILNamestobj = 'stobj'; + RsCILNameconvovfi1un = 'conv.ovf.i1.un'; + RsCILNameconvovfi2un = 'conv.ovf.i2.un'; + RsCILNameconvovfi4un = 'conv.ovf.i4.un'; + RsCILNameconvovfi8un = 'conv.ovf.i8.un'; + RsCILNameconvovfu1un = 'conv.ovf.u1.un'; + RsCILNameconvovfu2un = 'conv.ovf.u2.un'; + RsCILNameconvovfu4un = 'conv.ovf.u4.un'; + RsCILNameconvovfu8un = 'conv.ovf.u8.un'; + RsCILNameconvovfiun = 'conv.ovf.i.un'; + RsCILNameconvovfuun = 'conv.ovf.u.un'; + RsCILNamebox = 'box'; + RsCILNamenewarr = 'newarr'; + RsCILNameldlen = 'ldlen'; + RsCILNameldelema = 'ldelema'; + RsCILNameldelemi1 = 'ldelem.i1'; + RsCILNameldelemu1 = 'ldelem.u1'; + RsCILNameldelemi2 = 'ldelem.i2'; + RsCILNameldelemu2 = 'ldelem.u2'; + RsCILNameldelemi4 = 'ldelem.i4'; + RsCILNameldelemu4 = 'ldelem.u4'; + RsCILNameldelemi8 = 'ldelem.i8'; + RsCILNameldelemi = 'ldelem.i'; + RsCILNameldelemr4 = 'ldelem.r4'; + RsCILNameldelemr8 = 'ldelem.r8'; + RsCILNameldelemref = 'ldelem.ref'; + RsCILNamestelemi = 'stelem.i'; + RsCILNamestelemi1 = 'stelem.i1'; + RsCILNamestelemi2 = 'stelem.i2'; + RsCILNamestelemi4 = 'stelem.i4'; + RsCILNamestelemi8 = 'stelem.i8'; + RsCILNamestelemr4 = 'stelem.r4'; + RsCILNamestelemr8 = 'stelem.r8'; + RsCILNamestelemref = 'stelem.ref'; + RsCILNameunused4 = 'unused'; + RsCILNameunused5 = 'unused'; + RsCILNameunused6 = 'unused'; + RsCILNameunused7 = 'unused'; + RsCILNameunused8 = 'unused'; + RsCILNameunused9 = 'unused'; + RsCILNameunused10 = 'unused'; + RsCILNameunused11 = 'unused'; + RsCILNameunused12 = 'unused'; + RsCILNameunused13 = 'unused'; + RsCILNameunused14 = 'unused'; + RsCILNameunused15 = 'unused'; + RsCILNameunused16 = 'unused'; + RsCILNameunused17 = 'unused'; + RsCILNameunused18 = 'unused'; + RsCILNameunused19 = 'unused'; + RsCILNameconvovfi1 = 'conv.ovf.i1'; + RsCILNameconvovfu1 = 'conv.ovf.u1'; + RsCILNameconvovfi2 = 'conv.ovf.i2'; + RsCILNameconvovfu2 = 'conv.ovf.u2'; + RsCILNameconvovfi4 = 'conv.ovf.i4'; + RsCILNameconvovfu4 = 'conv.ovf.u4'; + RsCILNameconvovfi8 = 'conv.ovf.i8'; + RsCILNameconvovfu8 = 'conv.ovf.u8'; + RsCILNameunused20 = 'unused'; + RsCILNameunused21 = 'unused'; + RsCILNameunused22 = 'unused'; + RsCILNameunused23 = 'unused'; + RsCILNameunused24 = 'unused'; + RsCILNameunused25 = 'unused'; + RsCILNameunused26 = 'unused'; + RsCILNamerefanyval = 'refanyval'; + RsCILNameckfinite = 'ckfinite'; + RsCILNameunused27 = 'unused'; + RsCILNameunused28 = 'unused'; + RsCILNamemkrefany = 'mkrefany'; + RsCILNameunused29 = 'unused'; + RsCILNameunused30 = 'unused'; + RsCILNameunused31 = 'unused'; + RsCILNameunused32 = 'unused'; + RsCILNameunused33 = 'unused'; + RsCILNameunused34 = 'unused'; + RsCILNameunused35 = 'unused'; + RsCILNameunused36 = 'unused'; + RsCILNameunused37 = 'unused'; + RsCILNameldtoken = 'ldtoken'; + RsCILNameconvu2 = 'conv.u2'; + RsCILNameconvu1 = 'conv.u1'; + RsCILNameconvi = 'conv.i'; + RsCILNameconvovfi = 'conv.ovf.i'; + RsCILNameconvovfu = 'conv.ovf.u'; + RsCILNameaddovf = 'add.ovf'; + RsCILNameaddovfun = 'add.ovf.un'; + RsCILNamemulovf = 'mul.ovf'; + RsCILNamemulovfun = 'mul.ovf.un'; + RsCILNamesubovf = 'sub.ovf'; + RsCILNamesubovfun = 'sub.ovf.un'; + RsCILNameendfinally = 'endfinally'; + RsCILNameleave = 'leave'; + RsCILNameleaves = 'leave.s'; + RsCILNamestindi = 'stind.i'; + RsCILNameconvu = 'conv.u'; + RsCILNameunused38 = 'unused'; + RsCILNameunused39 = 'unused'; + RsCILNameunused40 = 'unused'; + RsCILNameunused41 = 'unused'; + RsCILNameunused42 = 'unused'; + RsCILNameunused43 = 'unused'; + RsCILNameunused44 = 'unused'; + RsCILNameunused45 = 'unused'; + RsCILNameunused46 = 'unused'; + RsCILNameunused47 = 'unused'; + RsCILNameunused48 = 'unused'; + RsCILNameunused49 = 'unused'; + RsCILNameunused50 = 'unused'; + RsCILNameunused51 = 'unused'; + RsCILNameunused52 = 'unused'; + RsCILNameunused53 = 'unused'; + RsCILNameunused54 = 'unused'; + RsCILNameunused55 = 'unused'; + RsCILNameunused56 = 'unused'; + RsCILNameunused57 = 'unused'; + RsCILNameunused58 = 'unused'; + RsCILNameunused59 = 'unused'; + RsCILNameunused60 = 'unused'; + RsCILNameprefix7 = 'prefix7'; + RsCILNameprefix6 = 'prefix6'; + RsCILNameprefix5 = 'prefix5'; + RsCILNameprefix4 = 'prefix4'; + RsCILNameprefix3 = 'prefix3'; + RsCILNameprefix2 = 'prefix2'; + RsCILNameprefix1 = 'prefix1'; + RsCILNameprefixref = 'prefixref'; + RsCILNamearglist = 'arglist'; + RsCILNameceq = 'ceq'; + RsCILNamecgt = 'cgt'; + RsCILNamecgtun = 'cgt.un'; + RsCILNameclt = 'clt'; + RsCILNamecltun = 'clt.un'; + RsCILNameldftn = 'ldftn'; + RsCILNameldvirtftn = 'ldvirtftn'; + RsCILNameunused61 = 'unused'; + RsCILNameldarg = 'ldarg'; + RsCILNameldarga = 'ldarga'; + RsCILNamestarg = 'starg'; + RsCILNameldloc = 'ldloc'; + RsCILNameldloca = 'ldloca'; + RsCILNamestloc = 'stloc'; + RsCILNamelocalloc = 'localloc'; + RsCILNameunused62 = 'unused'; + RsCILNameendfilter = 'endfilter'; + RsCILNameunaligned = 'unaligned.'; + RsCILNamevolatile = 'volatile.'; + RsCILNametail = 'tail.'; + RsCILNameinitobj = 'initobj'; + RsCILNameunused63 = 'unused'; + RsCILNamecpblk = 'cpblk'; + RsCILNameinitblk = 'initblk'; + RsCILNameunused64 = 'unused'; + RsCILNamerethrow = 'rethrow'; + RsCILNameunused65 = 'unused'; + RsCILNamesizeof = 'sizeof'; + RsCILNamerefanytype = 'refanytype'; + RsCILNameunused66 = 'unused'; + RsCILNameunused67 = 'unused'; + RsCILNameunused68 = 'unused'; + RsCILNameunused69 = 'unused'; + RsCILNameunused70 = 'unused'; + + RsCILCmdnop = 'no operation'; + RsCILCmdbreak = 'breakpoint instruction'; + RsCILCmdldarg0 = 'load argument onto the stack'; + RsCILCmdldarg1 = 'load argument onto the stack'; + RsCILCmdldarg2 = 'load argument onto the stack'; + RsCILCmdldarg3 = 'load argument onto the stack'; + RsCILCmdldloc0 = 'load local variable onto the stack'; + RsCILCmdldloc1 = 'load local variable onto the stack'; + RsCILCmdldloc2 = 'load local variable onto the stack'; + RsCILCmdldloc3 = 'load local variable onto the stack'; + RsCILCmdstloc0 = 'pop value from stack to local variable'; + RsCILCmdstloc1 = 'pop value from stack to local variable'; + RsCILCmdstloc2 = 'pop value from stack to local variable'; + RsCILCmdstloc3 = 'pop value from stack to local variable'; + RsCILCmdldargs = 'load argument onto the stack'; + RsCILCmdldargas = 'load an argument address'; + RsCILCmdstargs = 'store a value in an argument slot'; + RsCILCmdldlocs = 'load local variable onto the stack'; + RsCILCmdldlocas = 'load local variable address'; + RsCILCmdstlocs = 'pop value from stack to local variable'; + RsCILCmdldnull = 'load a null pointer'; + RsCILCmdldci4m1 = 'load numeric constant'; + RsCILCmdldci40 = 'load numeric constant'; + RsCILCmdldci41 = 'load numeric constant'; + RsCILCmdldci42 = 'load numeric constant'; + RsCILCmdldci43 = 'load numeric constant'; + RsCILCmdldci44 = 'load numeric constant'; + RsCILCmdldci45 = 'load numeric constant'; + RsCILCmdldci46 = 'load numeric constant'; + RsCILCmdldci47 = 'load numeric constant'; + RsCILCmdldci48 = 'load numeric constant'; + RsCILCmdldci4s = 'load numeric constant'; + RsCILCmdldci4 = 'load numeric constant'; + RsCILCmdldci8 = 'load numeric constant'; + RsCILCmdldcr4 = 'load numeric constant'; + RsCILCmdldcr8 = 'load numeric constant'; + RsCILCmdunused1 = ''; + RsCILCmddup = 'duplicate the top value of the stack'; + RsCILCmdpop = 'remove the top element of the stack'; + RsCILCmdjmp = 'jump to method'; + RsCILCmdcall = 'call a method'; + RsCILCmdcalli = 'indirect method call'; + RsCILCmdret = 'return from method'; + RsCILCmdbrs = 'unconditional branch'; + RsCILCmdbrfalses = 'branch on false, null, or zero'; + RsCILCmdbrtrues = 'branch on non-false or non-null'; + RsCILCmdbeqs = 'branch on equal'; + RsCILCmdbges = 'branch on greater than or equal to'; + RsCILCmdbgts = 'branch on greater than'; + RsCILCmdbles = 'branch on less than or equal to'; + RsCILCmdblts = 'branch on less than'; + RsCILCmdbneuns = 'branch on not equal or unordered'; + RsCILCmdbgeuns = 'branch on greater than or equal to, unsigned or unordered'; + RsCILCmdbgtuns = 'branch on greater than, unsigned or unordered'; + RsCILCmdbleuns = 'branch on less than or equal to, unsigned or unordered'; + RsCILCmdbltuns = 'branch on less than, unsigned or unordered'; + RsCILCmdbr = 'unconditional branch'; + RsCILCmdbrfalse = 'branch on false, null, or zero'; + RsCILCmdbrtrue = 'branch on non-false or non-null'; + RsCILCmdbeq = 'branch on equal'; + RsCILCmdbge = 'branch on greater than or equal to'; + RsCILCmdbgt = 'branch on greater than'; + RsCILCmdble = 'branch on less than or equal to'; + RsCILCmdblt = 'branch on less than'; + RsCILCmdbneun = 'branch on not equal or unordered'; + RsCILCmdbgeun = 'branch on greater than or equal to, unsigned or unordered'; + RsCILCmdbgtun = 'branch on greater than, unsigned or unordered'; + RsCILCmdbleun = 'branch on less than or equal to, unsigned or unordered'; + RsCILCmdbltun = 'branch on less than, unsigned or unordered'; + RsCILCmdswitch = 'table switch on value'; + RsCILCmdldindi1 = 'load value indirect onto the stack'; + RsCILCmdldindu1 = 'load value indirect onto the stack'; + RsCILCmdldindi2 = 'load value indirect onto the stack'; + RsCILCmdldindu2 = 'load value indirect onto the stack'; + RsCILCmdldindi4 = 'load value indirect onto the stack'; + RsCILCmdldindu4 = 'load value indirect onto the stack'; + RsCILCmdldindi8 = 'load value indirect onto the stack'; + RsCILCmdldindi = 'load value indirect onto the stack'; + RsCILCmdldindr4 = 'load value indirect onto the stack'; + RsCILCmdldindr8 = 'load value indirect onto the stack'; + RsCILCmdldindref = 'load value indirect onto the stack'; + RsCILCmdstindref = 'store value indirect from stack'; + RsCILCmdstindi1 = 'store value indirect from stack'; + RsCILCmdstindi2 = 'store value indirect from stack'; + RsCILCmdstindi4 = 'store value indirect from stack'; + RsCILCmdstindi8 = 'store value indirect from stack'; + RsCILCmdstindr4 = 'store value indirect from stack'; + RsCILCmdstindr8 = 'store value indirect from stack'; + RsCILCmdadd = 'add numeric values'; + RsCILCmdsub = 'subtract numeric values'; + RsCILCmdmul = 'multiply values'; + RsCILCmddiv = 'divide values'; + RsCILCmddivun = 'divide integer values, unsigned'; + RsCILCmdrem = 'compute remainder'; + RsCILCmdremun = 'compute integer remainder, unsigned'; + RsCILCmdand = 'bitwise AND'; + RsCILCmdor = 'bitwise OR'; + RsCILCmdxor = 'bitwise XOR'; + RsCILCmdshl = 'shift integer left'; + RsCILCmdshr = 'shift integer right'; + RsCILCmdshrun = 'shift integer right, unsigned'; + RsCILCmdneg = 'negate'; + RsCILCmdnot = 'bitwise complement'; + RsCILCmdconvi1 = 'data conversion'; + RsCILCmdconvi2 = 'data conversion'; + RsCILCmdconvi4 = 'data conversion'; + RsCILCmdconvi8 = 'data conversion'; + RsCILCmdconvr4 = 'data conversion'; + RsCILCmdconvr8 = 'data conversion'; + RsCILCmdconvu4 = 'data conversion'; + RsCILCmdconvu8 = 'data conversion'; + RsCILCmdcallvirt = 'call a method associated, at runtime, with an object'; + RsCILCmdcpobj = 'copy a value type'; + RsCILCmdldobj = 'copy value type to the stack'; + RsCILCmdldstr = 'load a literal string'; + RsCILCmdnewobj = 'create a new object'; + RsCILCmdcastclass = 'cast an object to a class'; + RsCILCmdisinst = 'test if an object is an instance of a class or interface'; + RsCILCmdconvrun = 'data conversion'; + RsCILCmdunused2 = ''; + RsCILCmdunused3 = ''; + RsCILCmdunbox = 'Convert boxed value type to its raw form'; + RsCILCmdthrow = 'throw an exception'; + RsCILCmdldfld = 'load field of an object'; + RsCILCmdldflda = 'load field address'; + RsCILCmdstfld = 'store into a field of an object'; + RsCILCmdldsfld = 'load static field of a class'; + RsCILCmdldsflda = 'load static field address'; + RsCILCmdstsfld = 'store a static field of a class'; + RsCILCmdstobj = 'store a value type from the stack into memory'; + RsCILCmdconvovfi1un = 'unsigned data conversion with overflow detection'; + RsCILCmdconvovfi2un = 'unsigned data conversion with overflow detection'; + RsCILCmdconvovfi4un = 'unsigned data conversion with overflow detection'; + RsCILCmdconvovfi8un = 'unsigned data conversion with overflow detection'; + RsCILCmdconvovfu1un = 'unsigned data conversion with overflow detection'; + RsCILCmdconvovfu2un = 'unsigned data conversion with overflow detection'; + RsCILCmdconvovfu4un = 'unsigned data conversion with overflow detection'; + RsCILCmdconvovfu8un = 'unsigned data conversion with overflow detection'; + RsCILCmdconvovfiun = 'unsigned data conversion with overflow detection'; + RsCILCmdconvovfuun = 'unsigned data conversion with overflow detection'; + RsCILCmdbox = 'convert value type to object reference'; + RsCILCmdnewarr = 'create a zero-based, one-dimensional array'; + RsCILCmdldlen = 'load the length of an array'; + RsCILCmdldelema = 'load address of an element of an array'; + RsCILCmdldelemi1 = 'load an element of an array'; + RsCILCmdldelemu1 = 'load an element of an array'; + RsCILCmdldelemi2 = 'load an element of an array'; + RsCILCmdldelemu2 = 'load an element of an array'; + RsCILCmdldelemi4 = 'load an element of an array'; + RsCILCmdldelemu4 = 'load an element of an array'; + RsCILCmdldelemi8 = 'load an element of an array'; + RsCILCmdldelemi = 'load an element of an array'; + RsCILCmdldelemr4 = 'load an element of an array'; + RsCILCmdldelemr8 = 'load an element of an array'; + RsCILCmdldelemref = 'load an element of an array'; + RsCILCmdstelemi = 'store an element of an array'; + RsCILCmdstelemi1 = 'store an element of an array'; + RsCILCmdstelemi2 = 'store an element of an array'; + RsCILCmdstelemi4 = 'store an element of an array'; + RsCILCmdstelemi8 = 'store an element of an array'; + RsCILCmdstelemr4 = 'store an element of an array'; + RsCILCmdstelemr8 = 'store an element of an array'; + RsCILCmdstelemref = 'store an element of an array'; + RsCILCmdunused4 = ''; + RsCILCmdunused5 = ''; + RsCILCmdunused6 = ''; + RsCILCmdunused7 = ''; + RsCILCmdunused8 = ''; + RsCILCmdunused9 = ''; + RsCILCmdunused10 = ''; + RsCILCmdunused11 = ''; + RsCILCmdunused12 = ''; + RsCILCmdunused13 = ''; + RsCILCmdunused14 = ''; + RsCILCmdunused15 = ''; + RsCILCmdunused16 = ''; + RsCILCmdunused17 = ''; + RsCILCmdunused18 = ''; + RsCILCmdunused19 = ''; + RsCILCmdconvovfi1 = 'data conversion with overflow detection'; + RsCILCmdconvovfu1 = 'data conversion with overflow detection'; + RsCILCmdconvovfi2 = 'data conversion with overflow detection'; + RsCILCmdconvovfu2 = 'data conversion with overflow detection'; + RsCILCmdconvovfi4 = 'data conversion with overflow detection'; + RsCILCmdconvovfu4 = 'data conversion with overflow detection'; + RsCILCmdconvovfi8 = 'data conversion with overflow detection'; + RsCILCmdconvovfu8 = 'data conversion with overflow detection'; + RsCILCmdunused20 = ''; + RsCILCmdunused21 = ''; + RsCILCmdunused22 = ''; + RsCILCmdunused23 = ''; + RsCILCmdunused24 = ''; + RsCILCmdunused25 = ''; + RsCILCmdunused26 = ''; + RsCILCmdrefanyval = 'load the address out of a typed reference'; + RsCILCmdckfinite = 'check for a finite real number'; + RsCILCmdunused27 = ''; + RsCILCmdunused28 = ''; + RsCILCmdmkrefany = 'push a typed reference on the stack'; + RsCILCmdunused29 = ''; + RsCILCmdunused30 = ''; + RsCILCmdunused31 = ''; + RsCILCmdunused32 = ''; + RsCILCmdunused33 = ''; + RsCILCmdunused34 = ''; + RsCILCmdunused35 = ''; + RsCILCmdunused36 = ''; + RsCILCmdunused37 = ''; + RsCILCmdldtoken = 'load the runtime representation of a metadata token'; + RsCILCmdconvu2 = 'data conversion'; + RsCILCmdconvu1 = 'data conversion'; + RsCILCmdconvi = 'data conversion'; + RsCILCmdconvovfi = 'data conversion with overflow detection'; + RsCILCmdconvovfu = 'data conversion with overflow detection'; + RsCILCmdaddovf = 'add integer values with overflow check'; + RsCILCmdaddovfun = 'add integer values with overflow check'; + RsCILCmdmulovf = 'multiply integer values with overflow check'; + RsCILCmdmulovfun = 'multiply integer values with overflow check'; + RsCILCmdsubovf = 'subtract integer values, checking for overflow'; + RsCILCmdsubovfun = 'subtract integer values, checking for overflow'; + RsCILCmdendfinally = 'end the finally or fault clause of an exception block'; + RsCILCmdleave = 'exit a protected region of code'; + RsCILCmdleaves = 'exit a protected region of code'; + RsCILCmdstindi = 'store value indirect from stack'; + RsCILCmdconvu = 'data conversion'; + RsCILCmdunused38 = ''; + RsCILCmdunused39 = ''; + RsCILCmdunused40 = ''; + RsCILCmdunused41 = ''; + RsCILCmdunused42 = ''; + RsCILCmdunused43 = ''; + RsCILCmdunused44 = ''; + RsCILCmdunused45 = ''; + RsCILCmdunused46 = ''; + RsCILCmdunused47 = ''; + RsCILCmdunused48 = ''; + RsCILCmdunused49 = ''; + RsCILCmdunused50 = ''; + RsCILCmdunused51 = ''; + RsCILCmdunused52 = ''; + RsCILCmdunused53 = ''; + RsCILCmdunused54 = ''; + RsCILCmdunused55 = ''; + RsCILCmdunused56 = ''; + RsCILCmdunused57 = ''; + RsCILCmdunused58 = ''; + RsCILCmdunused59 = ''; + RsCILCmdunused60 = ''; + RsCILCmdprefix7 = ''; + RsCILCmdprefix6 = ''; + RsCILCmdprefix5 = ''; + RsCILCmdprefix4 = ''; + RsCILCmdprefix3 = ''; + RsCILCmdprefix2 = ''; + RsCILCmdprefix1 = ''; + RsCILCmdprefixref = ''; + RsCILCmdarglist = 'get argument list'; + RsCILCmdceq = 'compare equal'; + RsCILCmdcgt = 'compare greater than'; + RsCILCmdcgtun = 'compare greater than, unsigned or unordered'; + RsCILCmdclt = 'compare less than'; + RsCILCmdcltun = 'compare less than, unsigned or unordered'; + RsCILCmdldftn = 'load method pointer'; + RsCILCmdldvirtftn = 'load a virtual method pointer'; + RsCILCmdunused61 = ''; + RsCILCmdldarg = 'load argument onto the stack'; + RsCILCmdldarga = 'load an argument address'; + RsCILCmdstarg = 'store a value in an argument slot'; + RsCILCmdldloc = 'load local variable onto the stack'; + RsCILCmdldloca = 'load local variable address'; + RsCILCmdstloc = 'pop value from stack to local variable'; + RsCILCmdlocalloc = 'allocate space in the local dynamic memory pool'; + RsCILCmdunused62 = ''; + RsCILCmdendfilter = 'end filter clause of SEH'; + RsCILCmdunaligned = 'pointer instruction may be unaligned'; + RsCILCmdvolatile = 'pointer reference is volatile'; + RsCILCmdtail = 'call terminates current method'; + RsCILCmdinitobj = 'initialize a value type'; + RsCILCmdunused63 = ''; + RsCILCmdcpblk = 'copy data from memory to memory'; + RsCILCmdinitblk = 'initialize a block of memory to a value'; + RsCILCmdunused64 = ''; + RsCILCmdrethrow = 'rethrow the current exception'; + RsCILCmdunused65 = ''; + RsCILCmdsizeof = 'load the size in bytes of a value type'; + RsCILCmdrefanytype = 'load the type out of a typed reference'; + RsCILCmdunused66 = ''; + RsCILCmdunused67 = ''; + RsCILCmdunused68 = ''; + RsCILCmdunused69 = ''; + RsCILCmdunused70 = ''; + + RsCILDescrnop = 'Do nothing'; + RsCILDescrbreak = 'inform a debugger that a breakpoint has been reached.'; + RsCILDescrldarg0 = 'Load argument 0 onto stack'; + RsCILDescrldarg1 = 'Load argument 1 onto stack'; + RsCILDescrldarg2 = 'Load argument 2 onto stack'; + RsCILDescrldarg3 = 'Load argument 3 onto stack'; + RsCILDescrldloc0 = 'Load local variable 0 onto stack.'; + RsCILDescrldloc1 = 'Load local variable 1 onto stack.'; + RsCILDescrldloc2 = 'Load local variable 2 onto stack.'; + RsCILDescrldloc3 = 'Load local variable 3 onto stack.'; + RsCILDescrstloc0 = 'Pop value from stack into local variable 0.'; + RsCILDescrstloc1 = 'Pop value from stack into local variable 1.'; + RsCILDescrstloc2 = 'Pop value from stack into local variable 2.'; + RsCILDescrstloc3 = 'Pop value from stack into local variable 3.'; + RsCILDescrldargs = 'Load argument numbered num onto stack, short form.'; + RsCILDescrldargas = 'fetch the address of argument argNum, short form'; + RsCILDescrstargs = 'Store a value to the argument numbered num, short form'; + RsCILDescrldlocs = 'Load local variable of index indx onto stack, short form.'; + RsCILDescrldlocas = 'Load address of local variable with index indx, short form'; + RsCILDescrstlocs = 'Pop value from stack into local variable indx, short form.'; + RsCILDescrldnull = 'Push null reference on the stack'; + RsCILDescrldci4m1 = 'Push -1 onto the stack as int32.'; + RsCILDescrldci40 = 'Push 0 onto the stack as int32.'; + RsCILDescrldci41 = 'Push 1 onto the stack as int32.'; + RsCILDescrldci42 = 'Push 2 onto the stack as int32.'; + RsCILDescrldci43 = 'Push 3 onto the stack as int32.'; + RsCILDescrldci44 = 'Push 4 onto the stack as int32.'; + RsCILDescrldci45 = 'Push 5 onto the stack as int32.'; + RsCILDescrldci46 = 'Push 6 onto the stack as int32.'; + RsCILDescrldci47 = 'Push 7 onto the stack as int32.'; + RsCILDescrldci48 = 'Push 8 onto the stack as int32.'; + RsCILDescrldci4s = 'Push num onto the stack as int32, short form.'; + RsCILDescrldci4 = 'Push num of type int32 onto the stack as int32.'; + RsCILDescrldci8 = 'Push num of type int64 onto the stack as int64.'; + RsCILDescrldcr4 = 'Push num of type float32 onto the stack as F.'; + RsCILDescrldcr8 = 'Push num of type float64 onto the stack as F.'; + RsCILDescrunused1 = ''; + RsCILDescrdup = 'duplicate value on the top of the stack'; + RsCILDescrpop = 'pop a value from the stack'; + RsCILDescrjmp = 'Exit current method and jump to specified method'; + RsCILDescrcall = 'Call method described by method'; + RsCILDescrcalli = 'Call method indicated on the stack with arguments described by callsitedescr.'; + RsCILDescrret = 'Return from method, possibly returning a value'; + RsCILDescrbrs = 'branch to target, short form'; + RsCILDescrbrfalses = 'branch to target if value is zero (false), short form'; + RsCILDescrbrtrues = 'branch to target if value is non-zero (true), short form'; + RsCILDescrbeqs = 'branch to target if equal, short form'; + RsCILDescrbges = 'branch to target if greater than or equal to, short form'; + RsCILDescrbgts = 'branch to target if greater than, short form'; + RsCILDescrbles = 'branch to target if less than or equal to, short form'; + RsCILDescrblts = 'branch to target if less than'; + RsCILDescrbneuns = 'branch to target if unequal or unordered, short form'; + RsCILDescrbgeuns = 'branch to target if greater than or equal to (unsigned or unordered), short form'; + RsCILDescrbgtuns = 'branch to target if greater than (unsigned or unordered), short form'; + RsCILDescrbleuns = 'branch to target if less than or equal to (unsigned or unordered), short form'; + RsCILDescrbltuns = 'Branch to target if less than (unsigned or unordered), short form'; + RsCILDescrbr = 'branch to target '; + RsCILDescrbrfalse = 'branch to target if value is zero (false)'; + RsCILDescrbrtrue = 'branch to target if value is non-zero (true)'; + RsCILDescrbeq = 'branch to target if equal'; + RsCILDescrbge = 'branch to target if greater than or equal to'; + RsCILDescrbgt = 'branch to target if greater than'; + RsCILDescrble = 'branch to target if less than or equal to'; + RsCILDescrblt = 'branch to target if less than'; + RsCILDescrbneun = 'branch to target if unequal or unordered'; + RsCILDescrbgeun = 'branch to target if greater than or equal to (unsigned or unordered)'; + RsCILDescrbgtun = 'branch to target if greater than (unsigned or unordered)'; + RsCILDescrbleun = 'branch to target if less than or equal to (unsigned or unordered)'; + RsCILDescrbltun = 'Branch to target if less than (unsigned or unordered) '; + RsCILDescrswitch = 'jump to one of n values'; + RsCILDescrldindi1 = 'Indirect load value of type int8 as int32 on the stack.'; + RsCILDescrldindu1 = 'Indirect load value of type unsigned int8 as int32 on the stack.'; + RsCILDescrldindi2 = 'Indirect load value of type int16 as int32 on the stack.'; + RsCILDescrldindu2 = 'Indirect load value of type unsigned int16 as int32 on the stack.'; + RsCILDescrldindi4 = 'Indirect load value of type int32 as int32 on the stack.'; + RsCILDescrldindu4 = 'Indirect load value of type unsigned int32 as int32 on the stack.'; + RsCILDescrldindi8 = 'Indirect load value of type int64 as int64 on the stack.'; + RsCILDescrldindi = 'Indirect load value of type native int as native int on the stack'; + RsCILDescrldindr4 = 'Indirect load value of type float32 as F on the stack.'; + RsCILDescrldindr8 = 'Indirect load value of type float64 as F on the stack.'; + RsCILDescrldindref = 'Indirect load value of type object ref as O on the stack.'; + RsCILDescrstindref = 'Store value of type object ref (type O) into memory at address'; + RsCILDescrstindi1 = 'Store value of type int8 into memory at address'; + RsCILDescrstindi2 = 'Store value of type int16 into memory at address'; + RsCILDescrstindi4 = 'Store value of type int32 into memory at address'; + RsCILDescrstindi8 = 'Store value of type int64 into memory at address'; + RsCILDescrstindr4 = 'Store value of type float32 into memory at address'; + RsCILDescrstindr8 = 'Store value of type float64 into memory at address'; + RsCILDescradd = 'Add two values, returning a new value'; + RsCILDescrsub = 'Subtract value2 from value1, returning a new value'; + RsCILDescrmul = 'Multiply values'; + RsCILDescrdiv = 'Divide two values to return a quotient or floating-point result'; + RsCILDescrdivun = 'Divide two values, unsigned, returning a quotient'; + RsCILDescrrem = 'Remainder of dividing value1 by value2'; + RsCILDescrremun = 'Remainder of unsigned dividing value1 by value2'; + RsCILDescrand = 'Bitwise AND of two integral values, returns an integral value'; + RsCILDescror = 'Bitwise OR of two integer values, returns an integer.'; + RsCILDescrxor = 'Bitwise XOR of integer values, returns an integer'; + RsCILDescrshl = 'Shift an integer to the left (shifting in zeros)'; + RsCILDescrshr = 'Shift an integer right, (shift in sign), return an integer'; + RsCILDescrshrun = 'Shift an integer right, (shift in zero), return an integer'; + RsCILDescrneg = 'Negate value'; + RsCILDescrnot = 'Bitwise complement'; + RsCILDescrconvi1 = 'Convert to int8, pushing int32 on stack'; + RsCILDescrconvi2 = 'Convert to int16, pushing int32 on stack'; + RsCILDescrconvi4 = 'Convert to int32, pushing int32 on stack'; + RsCILDescrconvi8 = 'Convert to int64, pushing int64 on stack'; + RsCILDescrconvr4 = 'Convert to float32, pushing F on stack'; + RsCILDescrconvr8 = 'Convert to float64, pushing F on stack'; + RsCILDescrconvu4 = 'Convert to unsigned int32, pushing int32 on stack'; + RsCILDescrconvu8 = 'Convert to unsigned int64, pushing int64 on stack'; + RsCILDescrcallvirt = 'Call a method associated with obj'; + RsCILDescrcpobj = 'Copy a value type from srcValObj to destValObj'; + RsCILDescrldobj = 'Copy instance of value type classTok to the stack.'; + RsCILDescrldstr = 'push a string object for the literal string '; + RsCILDescrnewobj = 'allocate an uninitialized object or value type and call ctor '; + RsCILDescrcastclass = 'Cast obj to class'; + RsCILDescrisinst = 'test if object is an instance of class, returning NULL or an instance of that class or interface'; + RsCILDescrconvrun = 'Convert unsigned integer to floating-point, pushing F on stack'; + RsCILDescrunused2 = ''; + RsCILDescrunused3 = ''; + RsCILDescrunbox = 'Extract the value type data from obj, its boxed representation'; + RsCILDescrthrow = 'Throw an exception'; + RsCILDescrldfld = 'Push the value of field of object, or value type, obj, onto the stack'; + RsCILDescrldflda = 'Push the address of field of object obj on the stack'; + RsCILDescrstfld = 'Replace the value of field of the object obj with val'; + RsCILDescrldsfld = 'Push the value of field on the stack'; + RsCILDescrldsflda = 'Push the address of the static field, field, on the stack'; + RsCILDescrstsfld = 'Replace the value of field with val'; + RsCILDescrstobj = 'Store a value of type classTok from the stack into memory'; + RsCILDescrconvovfi1un = 'Convert unsigned to an int8 (on the stack as int32) and throw an exception on overflow'; + RsCILDescrconvovfi2un = 'Convert unsigned to an int16 (on the stack as int32) and throw an exception on overflow'; + RsCILDescrconvovfi4un = 'Convert unsigned to an int32 (on the stack as int32) and throw an exception on overflow'; + RsCILDescrconvovfi8un = 'Convert unsigned to an int64 (on the stack as int64) and throw an exception on overflow'; + RsCILDescrconvovfu1un = 'Convert unsigned to an unsigned int8 (on the stack as int32) and throw an exception on overflow'; + RsCILDescrconvovfu2un = 'Convert unsigned to an unsigned int16 (on the stack as int32) and throw an exception on overflow'; + RsCILDescrconvovfu4un = 'Convert unsigned to an unsigned int32 (on the stack as int32) and throw an exception on overflow'; + RsCILDescrconvovfu8un = 'Convert unsigned to an unsigned int64 (on the stack as int64) and throw an exception on overflow'; + RsCILDescrconvovfiun = 'Convert unsigned to a native int (on the stack as native int) and throw an exception on overflow'; + RsCILDescrconvovfuun = 'Convert unsigned to a native unsigned int (on the stack as native int) and throw an exception on overflow'; + RsCILDescrbox = 'Convert valueType to a true object reference'; + RsCILDescrnewarr = 'create a new array with elements of type etype'; + RsCILDescrldlen = 'push the length (of type native unsigned int) of array on the stack'; + RsCILDescrldelema = 'Load the address of element at index onto the top of the stack'; + RsCILDescrldelemi1 = 'Load the element with type int8 at index onto the top of the stack as an int32'; + RsCILDescrldelemu1 = 'Load the element with type unsigned int8 at index onto the top of the stack as an int32'; + RsCILDescrldelemi2 = 'Load the element with type int16 at index onto the top of the stack as an int32'; + RsCILDescrldelemu2 = 'Load the element with type unsigned int16 at index onto the top of the stack as an int32'; + RsCILDescrldelemi4 = 'Load the element with type int32 at index onto the top of the stack as an int32'; + RsCILDescrldelemu4 = 'Load the element with type unsigned int32 at index onto the top of the stack as an int32 (alias for ldelem.i4)'; + RsCILDescrldelemi8 = 'Load the element with type int64 at index onto the top of the stack as an int64'; + RsCILDescrldelemi = 'Load the element with type native int at index onto the top of the stack as an native int'; + RsCILDescrldelemr4 = 'Load the element with type float32 at index onto the top of the stack as an F'; + RsCILDescrldelemr8 = 'Load the element with type float64 at index onto the top of the stack as an F'; + RsCILDescrldelemref = 'Load the element of type object, at index onto the top of the stack as an O'; + RsCILDescrstelemi = 'Replace array element at index with the i value on the stack'; + RsCILDescrstelemi1 = 'Replace array element at index with the int8 value on the stack'; + RsCILDescrstelemi2 = 'Replace array element at index with the int16 value on the stack'; + RsCILDescrstelemi4 = 'Replace array element at index with the int32 value on the stack'; + RsCILDescrstelemi8 = 'Replace array element at index with the int64 value on the stack'; + RsCILDescrstelemr4 = 'Replace array element at index with the float32 value on the stack'; + RsCILDescrstelemr8 = 'Replace array element at index with the float64 value on the stack'; + RsCILDescrstelemref = 'Replace array element at index with the ref value on the stack'; + RsCILDescrunused4 = ''; + RsCILDescrunused5 = ''; + RsCILDescrunused6 = ''; + RsCILDescrunused7 = ''; + RsCILDescrunused8 = ''; + RsCILDescrunused9 = ''; + RsCILDescrunused10 = ''; + RsCILDescrunused11 = ''; + RsCILDescrunused12 = ''; + RsCILDescrunused13 = ''; + RsCILDescrunused14 = ''; + RsCILDescrunused15 = ''; + RsCILDescrunused16 = ''; + RsCILDescrunused17 = ''; + RsCILDescrunused18 = ''; + RsCILDescrunused19 = ''; + RsCILDescrconvovfi1 = 'Convert to an int8 (on the stack as int32) and throw an exception on overflow '; + RsCILDescrconvovfu1 = 'Convert to a unsigned int8 (on the stack as int32) and throw an exception on overflow '; + RsCILDescrconvovfi2 = 'Convert to an int16 (on the stack as int32) and throw an exception on overflow '; + RsCILDescrconvovfu2 = 'Convert to a unsigned int16 (on the stack as int32) and throw an exception on overflow '; + RsCILDescrconvovfi4 = 'Convert to an int32 (on the stack as int32) and throw an exception on overflow '; + RsCILDescrconvovfu4 = 'Convert to a unsigned int32 (on the stack as int32) and throw an exception on overflow '; + RsCILDescrconvovfi8 = 'Convert to an int64 (on the stack as int64) and throw an exception on overflow '; + RsCILDescrconvovfu8 = 'Convert to a unsigned int64 (on the stack as int64) and throw an exception on overflow '; + RsCILDescrunused20 = ''; + RsCILDescrunused21 = ''; + RsCILDescrunused22 = ''; + RsCILDescrunused23 = ''; + RsCILDescrunused24 = ''; + RsCILDescrunused25 = ''; + RsCILDescrunused26 = ''; + RsCILDescrrefanyval = 'Push the address stored in a typed reference'; + RsCILDescrckfinite = 'throw ArithmeticException if value is not a finite number'; + RsCILDescrunused27 = ''; + RsCILDescrunused28 = ''; + RsCILDescrmkrefany = 'push a typed reference to ptr of type class onto the stack'; + RsCILDescrunused29 = ''; + RsCILDescrunused30 = ''; + RsCILDescrunused31 = ''; + RsCILDescrunused32 = ''; + RsCILDescrunused33 = ''; + RsCILDescrunused34 = ''; + RsCILDescrunused35 = ''; + RsCILDescrunused36 = ''; + RsCILDescrunused37 = ''; + RsCILDescrldtoken = 'Convert metadata token to its runtime representation'; + RsCILDescrconvu2 = 'Convert to unsigned int16, pushing int32 on stack'; + RsCILDescrconvu1 = 'Convert to unsigned int8, pushing int32 on stack'; + RsCILDescrconvi = 'Convert to native int, pushing native int on stack'; + RsCILDescrconvovfi = 'Convert to an native int (on the stack as native int) and throw an exception on overflow'; + RsCILDescrconvovfu = 'Convert to a native unsigned int (on the stack as native int) and throw an exception on overflow'; + RsCILDescraddovf = 'Add signed integer values with overflow check. '; + RsCILDescraddovfun = 'Add unsigned integer values with overflow check.'; + RsCILDescrmulovf = 'Multiply signed integer values. Signed result must fit in same size'; + RsCILDescrmulovfun = 'Multiply unsigned integer values. Unsigned result must fit in same size'; + RsCILDescrsubovf = 'Subtract native int from an native int. Signed result must fit in same size'; + RsCILDescrsubovfun = 'Subtract native unsigned int from a native unsigned int. Unsigned result must fit in same size'; + RsCILDescrendfinally = 'End finally clause of an exception block'; + RsCILDescrleave = 'Exit a protected region of code.'; + RsCILDescrleaves = 'Exit a protected region of code, short form'; + RsCILDescrstindi = 'Store value of type native int into memory at address'; + RsCILDescrconvu = 'Convert to native unsigned int, pushing native int on stack'; + RsCILDescrunused38 = ''; + RsCILDescrunused39 = ''; + RsCILDescrunused40 = ''; + RsCILDescrunused41 = ''; + RsCILDescrunused42 = ''; + RsCILDescrunused43 = ''; + RsCILDescrunused44 = ''; + RsCILDescrunused45 = ''; + RsCILDescrunused46 = ''; + RsCILDescrunused47 = ''; + RsCILDescrunused48 = ''; + RsCILDescrunused49 = ''; + RsCILDescrunused50 = ''; + RsCILDescrunused51 = ''; + RsCILDescrunused52 = ''; + RsCILDescrunused53 = ''; + RsCILDescrunused54 = ''; + RsCILDescrunused55 = ''; + RsCILDescrunused56 = ''; + RsCILDescrunused57 = ''; + RsCILDescrunused58 = ''; + RsCILDescrunused59 = ''; + RsCILDescrunused60 = ''; + RsCILDescrprefix7 = ''; + RsCILDescrprefix6 = ''; + RsCILDescrprefix5 = ''; + RsCILDescrprefix4 = ''; + RsCILDescrprefix3 = ''; + RsCILDescrprefix2 = ''; + RsCILDescrprefix1 = ''; + RsCILDescrprefixref = ''; + RsCILDescrarglist = 'return argument list handle for the current method '; + RsCILDescrceq = 'push 1 (of type int32) if value1 equals value2, else 0'; + RsCILDescrcgt = 'push 1 (of type int32) if value1 > value2, else 0'; + RsCILDescrcgtun = 'push 1 (of type int32) if value1 > value2, unsigned or unordered, else 0'; + RsCILDescrclt = 'push 1 (of type int32) if value1 < value2, else 0'; + RsCILDescrcltun = 'push 1 (of type int32) if value1 < value2, unsigned or unordered, else 0'; + RsCILDescrldftn = 'Push a pointer to a method referenced by method on the stack'; + RsCILDescrldvirtftn = 'Push address of virtual method mthd on the stack'; + RsCILDescrunused61 = ''; + RsCILDescrldarg = 'Load argument numbered num onto stack.'; + RsCILDescrldarga = 'fetch the address of argument argNum.'; + RsCILDescrstarg = 'Store a value to the argument numbered num'; + RsCILDescrldloc = 'Load local variable of index indx onto stack.'; + RsCILDescrldloca = 'Load address of local variable with index indx'; + RsCILDescrstloc = 'Pop value from stack into local variable indx.'; + RsCILDescrlocalloc = 'Allocate space from the local memory pool.'; + RsCILDescrunused62 = ''; + RsCILDescrendfilter = 'End filter clause of SEH exception handling'; + RsCILDescrunaligned = 'Subsequent pointer instruction may be unaligned'; + RsCILDescrvolatile = 'Subsequent pointer reference is volatile'; + RsCILDescrtail = 'Subsequent call terminates current method'; + RsCILDescrinitobj = 'Initialize a value type'; + RsCILDescrunused63 = ''; + RsCILDescrcpblk = 'Copy data from memory to memory'; + RsCILDescrinitblk = 'Set a block of memory to a given byte'; + RsCILDescrunused64 = ''; + RsCILDescrrethrow = 'Rethrow the current exception'; + RsCILDescrunused65 = ''; + RsCILDescrsizeof = 'Push the size, in bytes, of a value type as a unsigned int32'; + RsCILDescrrefanytype = 'Push the type token stored in a typed reference'; + RsCILDescrunused66 = ''; + RsCILDescrunused67 = ''; + RsCILDescrunused68 = ''; + RsCILDescrunused69 = ''; + RsCILDescrunused70 = ''; + +//=== JclCLR ================================================================= +resourcestring + RsClrCopyright = '// Delphi-JEDI .NET Framework IL Disassembler. Version 0.1' + sLineBreak + + '// Project JEDI Code Library (JCL) Team. All rights reserved.' + sLineBreak; + RsUnknownTableFmt = '%s%s'; + RsUnknownTable = 'Unknown table - '; + +//=== JclCOM ================================================================= +resourcestring + RsComInvalidParam = 'An invalid parameter was passed to the routine. If a parameter was ' + + 'expected, it might be an unassigned item or nil pointer'; + RsComFailedStreamRead = 'Failed to read all of the data from the specified stream'; + RsComFailedStreamWrite = 'Failed to write all of the data into the specified stream'; + +//=== JclComplex ============================================================= +resourcestring + RsComplexInvalidString = 'Failed to create a complex number from the string provided'; + +//=== JclCompression ========================================================= +resourcestring + RsCompressionReadNotSupported = 'read is not an supported operation.'; + RsCompressionWriteNotSupported = 'write is not an supported operation.'; + RsCompressionResetNotSupported = 'reset is not an supported operation.'; + RsCompressionSeekNotSupported = 'seek is not an supported operation.'; + RsCompressionUserAbort = 'User abort'; + RsCompressionZLibZErrNo = 'zlib returned: ERRNO'; + RsCompressionZLibZStreamError = 'zlib returned: Stream error'; + RsCompressionZLibZDataError = 'zlib returned: data error'; + RsCompressionZLibZMemError = 'zlib returned: memory error'; + RsCompressionZLibZBufError = 'zlib returned: buffer error'; + RsCompressionZLibZVersionError = 'zlib returned: version error'; + RsCompressionZLibError = 'zLib returned: unknown error (%d)'; + RsCompressionGZIPInvalidID = 'gzip: Invalid ID (ID1=%.2x; ID2=%.2x)'; + RsCompressionGZIPUnsupportedCM = 'gzip: unsupported compression method (%d)'; + RsCompressionGZIPHeaderCRC = 'gzip: CRC failed, header is damaged'; + RsCompressionGZIPDecompressing = 'gzip: this property is not readable when the data are being decompressed'; + RsCompressionGZIPNotDecompressed = 'gzip: this property is not readable until the data are fully decompressed'; + RsCompressionGZIPDataTruncated = 'gzip: data are truncated'; + RsCompressionGZIPInternalError = 'gzip: internal error'; + RsCompressionGZIPDataCRCFailed = 'gzip: CRC failed, data are damaged'; + RsCompressionGZIPExtraFieldTooLong = 'gzip: extra field is too long'; + RsCompressionGZIPBadString = 'gzip: the string contains null chars'; + RsCompressionBZIP2SequenceError = 'bzip2 returned: sequence error'; + RsCompressionBZIP2ParameterError = 'bzip2 returned: parameter error'; + RsCompressionBZIP2MemoryError = 'bzip2 returned: memory error'; + RsCompressionBZIP2DataError = 'bzip2 returned: data error'; + RsCompressionBZIP2HeaderError = 'bzip2 returned: header error'; + RsCompressionBZIP2IOError = 'bzip2 returned: IO error'; + RsCompressionBZIP2EOFError = 'bzip2 returned: unexpected end of file'; + RsCompressionBZIP2OutBuffError = 'bzip2 returned: out buffer is too small'; + RsCompressionBZIP2ConfigError = 'bzip2 returned: configuration error'; + RsCompressionBZIP2Error = 'bzip2 returned: unknown error (%d)'; + RsCompressionUnavailableProperty = 'Property is not available'; + RsCompressionCompressingError = 'Operation is not supported while compressing'; + RsCompressionDecompressingError = 'Operation is not supported while decompressing'; + RsCompressionNoFileName = 'File name not supplied'; + RsCompressionUnsupportedMethod = 'Unsupported method'; + RsCompressionDataError = 'Data error'; + RsCompressionCRCError = 'CRC error'; + RsCompressionNoNestedArchive = 'Nested archive is not supported'; + RsCompressionUnknownError = 'Unknown error'; + RsCompression7zLoadError = 'Sevenzip: Failed to load 7z.dll'; + RsCompression7zReturnError = 'Sevenzip: Error result (%.8x) "%s"'; + RsCompression7zUnassignedStream = 'Sevenzip: Stream object is not assigned'; + RsCompression7zOutArchiveError = 'Sevenzip: Failed to get out archive interface for class %s'; + RsCompression7zInArchiveError = 'Sevenzip: Failed to get in archive interface for class %s'; + RsCompression7zUnknownValueType = 'Sevenzip: Unknown value type (%d) for property ID %d'; + RsCompression7zOnlyCurrentFile = 'Sevenzip: Only properties for current file can be retreived'; + RsCompression7zWindows = 'Windows'; + RsCompression7zUnix = 'Unix'; + RsCompressionZipName = 'Zip archive'; + RsCompressionZipExtensions = '*.zip;' + // Basic ZIP file + '*.jar;*.ear;*.war;' + // JAVA files + '*.cbz;' + //Comic reader files - ZIP version + '*.apk;' + // Android application package + '*.wsz;*.wal;' + // Winamp Skins + '*.xpi;*.crx;' + // Firefox, Chrome extensions + '*.dfsz;' + // ??? + '*.pcv;' + // MozBackup file + '*.bsz;' + // BSplayer skin + '*.mskin;' + // Maxthon skin + '*.wmz;' + // Windows Media Player skin + '*.ipa;' + // iPhone/iPad application + '*.docx;*.xlsx;*.pptx;' + // MsOffice + '*.sxw;*.sxi;*.sxt;*.sxd;*.sxc;*.sxm;*.sxg;*.stw;*.sti;*.std;*.stc;' + // OpenOffice.org 1.x documents and templates + '*.odh;*.odd;*.odt;*.odm;*.ods;*.ots;*.odg;*.otg;*.odp;*.otp;*.odf;*.odb'; // OpenOffice.org 2.x/3.x docs and templates + RsCompressionBZip2Name = 'BZip2 archive'; + RsCompressionBZip2Extensions = '*.bz2;*.bzip2;*.tbz2;*.tbz'; + RsCompressionBZip2SubExtensions = '.tbz2=.tar;.tbz=.tar'; + RsCompressionRarName = 'Rar archive'; + RsCompressionRarExtensions = '*.rar;*.r00;'+ + '*.cbr'; // Comic reader file - RAR version + RsCompressionArjName = 'Arj archive'; + RsCompressionArjExtensions = '*.arj'; + RsCompressionZName = 'Z archive'; + RsCompressionZExtensions = '*.z;*.taz'; + RsCompressionZSubExtensions = '.taz=.tar'; + RsCompressionLzhName = 'Lzh archive'; + RsCompressionLzhExtensions = '*.lzh;*.lha'; + RsCompression7zName = '7z archive'; + RsCompression7zExtensions = '*.7z'; + RsCompressionCabName = 'Cab archive'; + RsCompressionCabExtensions = '*.cab;'+ + '*.fwp'; // FrontPage Web Package + RsCompressionNsisName = 'Nsis archive'; + RsCompressionNsisExtensions = '*.nsis'; + RsCompressionLzmaName = 'Lzma archive'; + RsCompressionLzmaExtensions = '*.lzma'; + RsCompressionLzma86Name = 'Lzma86 archive'; + RsCompressionLzma86Extensions = '*.lzma86'; + RsCompressionPeName = 'Pe archive'; + RsCompressionPeExtensions = '*.exe;*.dll;*.sys;*.bpl'; + RsCompressionElfName = 'Elf archive'; + // TODO: extension might be *.*, but then TJclCompressionStreamFormats.FindDecompressFormat can fail + RsCompressionElfExtensions = '*.'; + RsCompressionMachoName = 'Mach-O archive'; + // TODO: extension might be *.*, but then TJclCompressionStreamFormats.FindDecompressFormat can fail + RsCompressionMachoExtensions = '*.'; + RsCompressionUdfName = 'Udf archive'; + RsCompressionUdfExtensions = '*.iso;*.img'; + RsCompressionXarName = 'Xar archive'; + RsCompressionXarExtensions = '*.xar;'+ + '*.safariextz'; // Safari extensions + RsCompressionMubName = 'Mub archive'; + // TODO: extension might be *.*, but then TJclCompressionStreamFormats.FindDecompressFormat can fail + RsCompressionMubExtensions = '*.'; + RsCompressionHfsName = 'Hfs archive'; + RsCompressionHfsExtensions = '*.hfs'; + RsCompressionDmgName = 'Dmg archive'; + RsCompressionDmgExtensions = '*.dmg'; + RsCompressionCompoundName = 'Compound archive'; + RsCompressionCompoundExtensions = '*.msi;*.msp;*.doc;*.xls;*.ppt'; + RsCompressionWimName = 'Wim archive'; + RsCompressionWimExtensions = '*.wim;*.swm'; + RsCompressionIsoName = 'Iso archive'; + RsCompressionIsoExtensions = '*.iso;*.img'; + RsCompressionChmName = 'Chm archive'; + RsCompressionChmExtensions = '*.chm;*.chi;*.chq;*.chw;*.hxs;*.hxi;*.hxr;*.hxq;*.hxw;*.lit'; + RsCompressionSplitName = 'Split archive'; + RsCompressionSplitExtensions = '*.001'; + RsCompressionRpmName = 'Rpm archive'; + RsCompressionRpmExtensions = '*.rpm'; + RsCompressionDebName = 'Deb archive'; + RsCompressionDebExtensions = '*.deb'; + RsCompressionCpioName = 'Cpio archive'; + RsCompressionCpioExtensions = '*.cpio'; + RsCompressionTarName = 'Tar archive'; + RsCompressionTarExtensions = '*.tar'; + RsCompressionGZipName = 'GZip archive'; + RsCompressionGZipExtensions = '*.gz;*.gzip;*.tgz;*.tpz'; + RsCompressionGZipSubExtensions = '.tgz=.tar;.tpz=.tar'; + RsCompressionXzName = 'Xz archive'; + RsCompressionXzExtensions = '*.xz;*.txz'; + RsCompressionXzSubExtensions = '.txz=.tar'; + RsCompressionNtfsName = 'Ntfs archive'; + RsCompressionNtfsExtensions = '*.ntfs;*.img'; + RsCompressionFatName = 'Fat archive'; + RsCompressionFatExtensions = '*.fat;*.img'; + RsCompressionMbrName = 'Mbr archive'; + RsCompressionMbrExtensions = '*.mbr'; + RsCompressionVhdName = 'Vhd archive'; + RsCompressionVhdExtensions = '*.vhd'; + RsCompressionVhdSubExtensions = '.vhd=.mbr'; + RsCompressionFlvName = 'Flv archive'; + RsCompressionFlvExtensions = '*.flv'; + RsCompressionMsLZName = 'MsLZ archive'; + // TODO: extension might be *.*, but then TJclCompressionStreamFormats.FindDecompressFormat can fail + RsCompressionMsLZExtensions = '*.'; + RsCompressionSwfName = 'Swf archive'; + RsCompressionSwfExtensions = '*.swf'; + RsCompressionSwfcName = 'Swf archive'; + RsCompressionSwfcExtensions = '*.swf'; + RsCompressionApmName = 'APM archive'; + RsCompressionApmExtensions = '*.'; + RsCompressionPpmdName = 'PPMD archive'; + RsCompressionPpmdExtensions = '*.pmd'; + RsCompressionTEName = 'Terse Executable'; + RsCompressionTEExtensions = '*.te'; + RsCompressionUEFIcName = 'UEFIc archive'; + RsCompressionUEFIcExtensions = '*.scap'; + RsCompressionUEFIsName = 'UEFIs archive'; + RsCompressionUEFIsExtensions = '*.'; + RsCompressionSquashFSName = 'SquashFS archive'; + RsCompressionSquashFSExtensions = '*.squashfs'; + RsCompressionCramFSName = 'CramFS archive'; + RsCompressionCramFSExtensions = '*.cramfs'; + RsCompressionExtName = 'Ext filesystem archive'; + RsCompressionExtExtensions = '*.ext;*.ext2;*.ext3;*.ext4;*.img'; + RsCompressionVMDKName = 'Virtual Machine Disk archive'; + RsCompressionVMDKExtensions = '*.vmdk'; + RsCompressionVDIName = 'Virtual Disk Image archive'; + RsCompressionVDIExtensions = '*.vdi'; + RsCompressionQcowName = 'QEMU Copy On Write archive'; + RsCompressionQcowExtensions = '*.qcow;*.qcow2;*.qcow2c'; + RsCompressionGPTName = 'GUID Partition Table archive'; + RsCompressionGPTExtensions = '*.gpt;*.mbr'; + RsCompressionRar5Name = 'RAR v5 archive'; + RsCompressionRar5Extensions = '*.rar;*.r00'; + RsCompressionIHexName = 'IHex archive'; + RsCompressionIHexExtensions = '*.ihex'; + RsCompressionHxsName = 'Help 2.0 archive'; + RsCompressionHxsExtensions = '*.hxs;*.hxi;*.hxr;*.hxq;*.hxw;*.lit'; + RsCompressionDuplicate = 'The file %s already exists in the archive'; + RsCompressionReplaceError = 'At least one compression volume could not be replaced after an archive out-of-place update'; + +//=== JclConsole ============================================================= +resourcestring + RsCannotRaiseSignal = 'Cannot raise %s signal.'; + +//=== JclContainerIntf ======================================================= +resourcestring + RsEOutOfBounds = 'Out of bounds'; + RsEOperationNotSupported = 'Operation not supported'; + RsEValueNotFound = 'Value %s not found'; + RsEDuplicateElement = 'Duplicate element'; + RsENoCollection = 'Collection not assigned'; + RsEIllegalQueueCapacity = 'Illegal queue capacity'; + RsEIllegalStateOperation = 'Illegal state operation'; + RsENoEqualityComparer = 'Item equality comparer is not assigned'; + RsENoComparer = 'Item comparer is not assigned'; + RsENoHashConverter = 'Hash converter is not assigned'; + RsEAssignError = 'Assignation error'; + RsEReadOnlyError = 'Container is read-only'; + +//=== JclCounter ============================================================= +resourcestring + RsNoCounter = 'No high performance counters supported'; + +//=== JclDateTime ============================================================ +resourcestring + RsMakeUTCTime = 'Error converting to UTC time. Time zone could not be determined'; + RsDateConversion = 'Error illegal date or time format'; + +//=== JclDebug =============================================================== +resourcestring + RsUnknownFunctionAt = 'Unknown function at %s'; + +//=== JclCppException ======================================================== +resourcestring + RsCppUnhandledExceptionMsg = 'Unhandled C++ exception of type ''%s'' occurred'; + +//=== JclDotNet ============================================================== +resourcestring + RsEUnknownCLRVersion = '"%s" is not a known CLR version'; + +//=== JclExprEval ============================================================ +resourcestring + RsExprEvalRParenExpected = 'Parse error: '')'' expected'; + RsExprEvalFactorExpected = 'Parse error: Factor expected'; + RsExprEvalUnknownSymbol = 'Parse error: Unknown symbol: ''%s'''; + + RsExprEvalFirstArg = 'Parse error: ''('' and function''s first parameter expected'; + RsExprEvalNextArg = 'Parse error: '','' and another parameter expected'; + RsExprEvalEndArgs = 'Parse error: '')'' to close function''s parameters expected'; + + RsExprEvalExprNotFound = 'Expression compiler error: Expression ''%s'' not found'; + RsExprEvalExprPtrNotFound = 'Expression compiler error: Expression pointer not found'; + RsExprEvalExprRefCountAssertion = 'Expression compiler error: expression refcount < 0'; + +//=== JclFileUtils =========================================================== +resourcestring + // Path manipulation + RsPathInvalidDrive = '%s is not a valid drive'; + + // Files and directories + RsFileUtilsAttrUnavailable = 'Unable to retrieve attributes of %s'; + + RsCannotCreateDir = 'Unable to create directory'; + RsDelTreePathIsEmpty = 'DelTree: Path is empty'; + RsFileSearchAttrInconsistency = 'Some file search attributes are required AND rejected!'; + RsEWindowsVersionNotSupported = 'This Windows version is not supported'; + RsEWindowNotValid = 'The window with handle %d is not valid'; + RsEProcessNotValid = 'The process with ID %d is not valid'; + RsEModuleNotValid = 'The module with handle %d is not valid'; + + // TJclFileVersionInfo + RsFileUtilsNoVersionInfo = 'File contains no version information'; + RsFileUtilsFileDoesNotExist = 'The file %s does not exist'; + RsFileUtilsLanguageIndex = 'Illegal language index'; + RsFileUtilsEmptyValue = 'No value was supplied'; + RsFileUtilsValueNotFound = 'The value %s was not found.'; + // Strings returned from OSIdentTOString() + RsVosUnknown = 'Unknown'; + RsVosDos = 'MS-DOS'; + RsVosOS216 = '16-bit OS/2'; + RsVosOS232 = '32-bit OS/2'; + RsVosNT = 'Windows NT'; + RsVosWindows16 = '16-bit Windows'; + RsVosPM16 = '16-bit PM'; + RsVosPM32 = '32-bit PM'; + RsVosWindows32 = '32-bit Windows'; + RsVosDosWindows16 = '16-bit Windows, running on MS-DOS'; + RsVosDosWindows32 = 'Win32 API, running on MS-DOS'; + RsVosOS216PM16 = '16-bit PM, running on 16-bit OS/2'; + RsVosOS232PM32 = '32-bit PM, running on 32-bit OS/2'; + RsVosNTWindows32 = 'Win32 API, running on Windows/NT'; + RsVosDesignedFor = 'Designed for %s'; + + // Strings returned from OSFileTypeToString() + RsVftUnknown = 'Unknown'; + RsVftApp = 'Application'; + RsVftDll = 'Library'; + RsVftDrv = 'Driver'; + RsVftFont = 'Font'; + RsVftVxd = 'Virtual device'; + RsVftStaticLib = 'Static-link library'; + RsVft2DrvPRINTER = 'Printer'; + RsVft2DrvKEYBOARD = 'Keyboard'; + RsVft2DrvLANGUAGE = 'Language'; + RsVft2DrvDISPLAY = 'Display'; + RsVft2DrvMOUSE = 'Mouse'; + RsVft2DrvNETWORK = 'Network'; + RsVft2DrvSYSTEM = 'System'; + RsVft2DrvINSTALLABLE = 'Installable'; + RsVft2DrvSOUND = 'Sound'; + RsVft2DrvCOMM = 'Communications'; + RsVft2FontRASTER = 'Raster'; + RsVft2FontVECTOR = 'Vector'; + RsVft2FontTRUETYPE = 'TrueType'; + + // TJclFileStream + RsFileStreamCreate = 'Unable to create temporary file stream'; + + // TJclFileMapping + RsCreateFileMapping = 'Failed to create FileMapping'; + RsCreateFileMappingView = 'Failed to create FileMappingView'; + RsLoadFromStreamSize = 'Not enough space in View in procedure LoadFromStream'; + RsFileMappingInvalidHandle = 'Invalid file handle'; + RsViewNeedsMapping = 'FileMap argument of TJclFileMappingView constructor cannot be nil'; + RsFailedToObtainSize = 'Failed to obtain size of file'; + + // GetDriveTypeStr() + RsUnknownDrive = 'Unknown drive type'; + RsRemovableDrive = 'Removable Drive'; + RsHardDisk = 'Hard Disk'; + RsRemoteDrive = 'Remote Drive'; + RsCDRomDrive = 'CD-ROM'; + RsRamDisk = 'RAM-Disk'; + + // GetFileAttributeList() + RsAttrDirectory = 'Directory'; + RsAttrReadOnly = 'ReadOnly'; + RsAttrSystemFile = 'SystemFile'; + RsAttrVolumeID = 'Volume ID'; + RsAttrArchive = 'Archive'; + RsAttrAnyFile = 'AnyFile'; + RsAttrHidden = 'Hidden'; + + // GetFileAttributeListEx() + RsAttrNormal = 'Normal'; + RsAttrTemporary = 'Temporary'; + RsAttrCompressed = 'Compressed'; + RsAttrOffline = 'Offline'; + RsAttrEncrypted = 'Encrypted'; + RsAttrReparsePoint = 'Reparse Point'; + RsAttrSparseFile = 'Sparse'; + + // TJclFileMapping.Create + RsFileMappingOpenFile = 'Unable to open the file'; + + // TJclMappedTextReader + RsFileIndexOutOfRange = 'Index of out range'; + + // FileGetTypeName() + RsDefaultFileTypeName = ' File'; + +//=== JclMapi ================================================================ +resourcestring + RsMapiError = 'MAPI Error: (%d) "%s"'; + RsMapiMissingExport = 'Function "%s" is not exported by client'; + RsMapiInvalidIndex = 'Index is out ot range'; + RsMapiMailNoClient = 'No Simple MAPI client installed, cannot send the message'; + + RsMapiErrUSER_ABORT = 'User abort'; + RsMapiErrFAILURE = 'General MAPI failure'; + RsMapiErrLOGIN_FAILURE = 'MAPI login failure'; + RsMapiErrDISK_FULL = 'Disk full'; + RsMapiErrINSUFFICIENT_MEMORY = 'Insufficient memory'; + RsMapiErrACCESS_DENIED = 'Access denied'; + RsMapiErrTOO_MANY_SESSIONS = 'Too many sessions'; + RsMapiErrTOO_MANY_FILES = 'Too many files were specified'; + RsMapiErrTOO_MANY_RECIPIENTS = 'Too many recipients were specified'; + RsMapiErrATTACHMENT_NOT_FOUND = 'A specified attachment was not found'; + RsMapiErrATTACHMENT_OPEN_FAILURE = 'Attachment open failure'; + RsMapiErrATTACHMENT_WRITE_FAILURE = 'Attachment write failure'; + RsMapiErrUNKNOWN_RECIPIENT = 'Unknown recipient'; + RsMapiErrBAD_RECIPTYPE = 'Bad recipient type'; + RsMapiErrNO_MESSAGES = 'No messages'; + RsMapiErrINVALID_MESSAGE = 'Invalid message'; + RsMapiErrTEXT_TOO_LARGE = 'Text too large'; + RsMapiErrINVALID_SESSION = 'Invalid session'; + RsMapiErrTYPE_NOT_SUPPORTED = 'Type not supported'; + RsMapiErrAMBIGUOUS_RECIPIENT = 'A recipient was specified ambiguously'; + RsMapiErrMESSAGE_IN_USE = 'Message in use'; + RsMapiErrNETWORK_FAILURE = 'Network failure'; + RsMapiErrINVALID_EDITFIELDS = 'Invalid edit fields'; + RsMapiErrINVALID_RECIPS = 'Invalid recipients'; + RsMapiErrNOT_SUPPORTED = 'Not supported'; + + RsMapiMailORIG = 'From'; + RsMapiMailTO = 'To'; + RsMapiMailCC = 'Cc'; + RsMapiMailBCC = 'Bcc'; + RsMapiMailSubject = 'Subject'; + +//=== JclMath ================================================================ +resourcestring + RsMathDomainError = 'Domain check failure in JclMath'; + RsEmptyArray = 'Empty array is not allowed as input parameter'; + RsNonPositiveArray = 'Input array contains non-positive or zero values'; + RsUnexpectedValue = 'Unexpected data value'; + RsInvalidRational = 'Invalid rational number'; + RsDivByZero = 'Division by zero'; + RsRationalDivByZero = 'Rational division by zero'; + RsNoNaN = 'NaN expected'; + RsNaNTagError = 'NaN Tag value %d out of range'; + RsNaNSignal = 'NaN signaling %d'; + RsPowerInfinite = 'Power function: Result is infinite'; + RsPowerComplex = 'Power function: Result is complex'; + +//=== JclMetadata ============================================================ +resourcestring + RsUnknownClassLayout = 'Unknown class layout - $%.8x'; + RsUnknownStringFormatting = 'Unknown string formatting - $%.8x'; + RsInvalidSignatureData = 'Invalid compressed signature data - %.2x %.2x %.2x %.2x'; + RsUnknownManifestResource = 'Unknown manifest resource visibility - %d'; + RsNoLocalVarSig = 'Signature %s is not LocalVarSig'; + RsLocalVarSigOutOfRange = 'LocalVarSig count %d is out of range [1..$$FFFE]'; + +//=== JclMIDI ================================================================ +resourcestring + RsOctaveC = 'C'; + RsOctaveCSharp = 'C#'; + RsOctaveD = 'D'; + RsOctaveDSharp = 'D#'; + RsOctaveE = 'E'; + RsOctaveF = 'F'; + RsOctaveFSharp = 'F#'; + RsOctaveG = 'G'; + RsOctaveGSharp = 'G#'; + RsOctaveA = 'A'; + RsOctaveASharp = 'A#'; + RsOctaveB = 'B'; + + RsMidiInvalidChannelNum = 'Invalid MIDI channel number (%d)'; + {$IFDEF UNIX} + RsMidiNotImplemented = 'JclMidi: MIDI I/O for Unix not (yet) implemented'; + {$ENDIF UNIX} + +//=== JclMiscel ============================================================== +resourcestring + // CreateProcAsUser + RsCreateProcNTRequiredError = 'Windows NT required'; + RsCreateProcBuild1057Error = 'NT version 3.51 build 1057 or later required'; + + RsCreateProcPrivilegeMissing = 'This account does not have the privilege "%s" (%s)'; + RsCreateProcLogonUserError = 'LogonUser failed'; + RsCreateProcAccessDenied = 'Access denied'; + RsCreateProcLogonFailed = 'Unable to logon'; + RsCreateProcSetStationSecurityError = 'Cannot set WindowStation "%s" security.'; + RsCreateProcSetDesktopSecurityError = 'Cannot set Desktop "%s" security.'; + RsCreateProcPrivilegesMissing = 'This account does not have one (or more) of ' + + 'the following privileges: ' + '"%s"(%s)' + sLineBreak + '"%s"(%s)' + sLineBreak; + RsCreateProcCommandNotFound = 'Command or filename not found: "%s"'; + RsCreateProcFailed = 'CreateProcessAsUser failed'; + +//=== JclMultimedia ========================================================== +resourcestring + // Multimedia timer + RsMmTimerGetCaps = 'Error retrieving multimedia timer device capabilities'; + RsMmSetEvent = 'Error setting multimedia event timer'; + RsMmInconsistentId = 'Multimedia timer callback was called with inconsistent Id'; + RsMmTimerActive = 'This operation cannot be performed while the timer is active'; + + // Audio Mixer + RsMmMixerSource = 'Source'; + RsMmMixerDestination = 'Destination'; + RsMmMixerUndefined = 'Undefined'; + RsMmMixerDigital = 'Digital'; + RsMmMixerLine = 'Line'; + RsMmMixerMonitor = 'Monitor'; + RsMmMixerSpeakers = 'Speakers'; + RsMmMixerHeadphones = 'Headphones'; + RsMmMixerTelephone = 'Telephone'; + RsMmMixerWaveIn = 'Waveform-audio input'; + RsMmMixerVoiceIn = 'Voice input'; + RsMmMixerMicrophone = 'Microphone'; + RsMmMixerSynthesizer = 'Synthesizer'; + RsMmMixerCompactDisc = 'Compact disc'; + RsMmMixerPcSpeaker = 'PC speaker'; + RsMmMixerWaveOut = 'Waveform-audio output'; + RsMmMixerAuxiliary = 'Auxiliary audio line'; + RsMmMixerAnalog = 'Analog'; + RsMmMixerNoDevices = 'No mixer device found'; + RsMmMixerCtlNotFound = 'Line control (%s, %.8x) not found'; + + // EJclMciError + RsMmUnknownError = 'Unknown MCI error No. %d'; + RsMmMciErrorPrefix = 'MCI-Error: '; + + // CD audio routines + RsMmNoCdAudio = 'Cannot open CDAUDIO-Device'; + RsMmCdTrackNo = 'Track: %.2u'; + RsMMCdTimeFormat = '%2u:%.2u'; + RsMMTrackAudio = 'Audio'; + RsMMTrackOther = 'Other'; + +//=== JclNTFS ================================================================ +resourcestring + RsInvalidArgument = '%s: Invalid argument <%s>'; + RsNtfsUnableToDeleteSymbolicLink = 'Unable to delete temporary symbolic link'; + RsEUnableToCreatePropertyStorage = 'Unable to create property storage'; + RsEIncomatibleDataFormat = 'Incompatible data format'; + +//=== JclPCRE ================================================================ +resourcestring + RsErrNoMatch = 'No match'; + RsErrNull = 'Required value is null'; + RsErrBadOption = 'Bad option'; + RsErrBadMagic = 'Bad magic'; + RsErrUnknownNode = 'Unknown node'; + RsErrNoMemory = 'Out of memory'; + RsErrNoSubString = 'No substring'; + RsErrMatchLimit = 'Match limit'; + RsErrCallout = 'Callout'; + RsErrBadUTF8 = 'Bad UTF-8'; + RsErrBadUTF16 = 'Bad UTF-16'; + RsErrBadUTF8Offset = 'Bad UTF-8 offset'; + RsErrBadUTF16Offset = 'Bad UTF-16 offset'; + RsErrPartial = 'Partial'; + RsErrBadPartial = 'Bad partial'; + RsErrInternal = 'Internal'; + RsErrBadCount = 'Bad count'; + RsErrDfaUItem = 'DFA UItem'; + RsErrDfaUCond = 'DFA UCond'; + RsErrDfaUMLimit = 'DFA UMLimit'; + RsErrDfaWSSize = 'DFA WSSize'; + RsErrDfaRecurse = 'DFA Recurse'; + RsErrRecursionLimit = 'Recursion limit'; + RsErrNullWsLimit = 'Null WS limit'; + RsErrBadNewLine = 'Bad new line'; + RsErrBadOffset = 'Bad offset'; + RsErrShortUTF8 = 'Short UTF-8'; + RsErrShortUTF16 = 'Short UTF-16'; + RsErrRecurseLoop = 'Recurse loop'; + RsErrJITStackLimit = 'JIT stack limit'; + RsErrLibNotLoaded = 'PCRE library not loaded'; + RsErrMemFuncNotSet = 'PCRE memory management functions not set'; + RsErrStudyFailed = 'Study failed'; + RsErrCalloutError = 'Unhandled exception in callout'; + RsErrUnknownError = 'Unknown error'; + RsErrNoUTF8Support = 'No UTF-8 support in this version of PCRE'; + RsErrNoUTF16Support = 'No UTF-16 support in this version of PCRE'; + RsErrNoJITSupport = 'No JIT support in this version of PCRE'; + RsErrBadMode = 'Bad Mode'; + RsErrBadEndianness = 'Bad endianness'; + RsErrBadRestart = 'Bad Restart'; + +//=== JclPeImage ============================================================= +resourcestring + RsPeReadOnlyStream = 'Stream is read-only'; + + // TJclPeImage + RsPeCantOpen = 'Cannot open file "%s"'; + RsPeNotPE = 'This is not a PE format'; + RsPeUnknownTarget = 'Unknown PE target'; + RsPeNotResDir = 'Not a resource directory'; + RsPeNotAvailableForAttached = 'Feature is not available for attached images'; + RsPeSectionNotFound = 'Section "%s" not found'; + + // PE directory names + RsPeImg_00 = 'Exports'; + RsPeImg_01 = 'Imports'; + RsPeImg_02 = 'Resources'; + RsPeImg_03 = 'Exceptions'; + RsPeImg_04 = 'Security'; + RsPeImg_05 = 'Base Relocations'; + RsPeImg_06 = 'Debug'; + RsPeImg_07 = 'Description'; + RsPeImg_08 = 'Machine Value'; + RsPeImg_09 = 'TLS'; + RsPeImg_10 = 'Load configuration'; + RsPeImg_11 = 'Bound Import'; + RsPeImg_12 = 'IAT'; + RsPeImg_13 = 'Delay load import'; + RsPeImg_14 = 'COM run-time'; + RsPeImg_Reserved = 'reserved [%.2d]'; + + // NT Header names + RsPeSignature = 'Signature'; + RsPeMachine = 'Machine'; + RsPeNumberOfSections = 'Number of Sections'; + RsPeTimeDateStamp = 'Time Date Stamp'; + RsPePointerToSymbolTable = 'Symbols Pointer'; + RsPeNumberOfSymbols = 'Number of Symbols'; + RsPeSizeOfOptionalHeader = 'Size of Optional Header'; + RsPeCharacteristics = 'Characteristics'; + RsPeMagic = 'Magic'; + RsPeLinkerVersion = 'Linker Version'; + RsPeSizeOfCode = 'Size of Code'; + RsPeSizeOfInitializedData = 'Size of Initialized Data'; + RsPeSizeOfUninitializedData = 'Size of Uninitialized Data'; + RsPeAddressOfEntryPoint = 'Address of Entry Point'; + RsPeBaseOfCode = 'Base of Code'; + RsPeBaseOfData = 'Base of Data'; + RsPeImageBase = 'Image Base'; + RsPeSectionAlignment = 'Section Alignment'; + RsPeFileAlignment = 'File Alignment'; + RsPeOperatingSystemVersion = 'Operating System Version'; + RsPeImageVersion = 'Image Version'; + RsPeSubsystemVersion = 'Subsystem Version'; + RsPeWin32VersionValue = 'Win32 Version'; + RsPeSizeOfImage = 'Size of Image'; + RsPeSizeOfHeaders = 'Size of Headers'; + RsPeCheckSum = 'CheckSum'; + RsPeSubsystem = 'Subsystem'; + RsPeDllCharacteristics = 'Dll Characteristics'; + RsPeSizeOfStackReserve = 'Size of Stack Reserve'; + RsPeSizeOfStackCommit = 'Size of Stack Commit'; + RsPeSizeOfHeapReserve = 'Size of Heap Reserve'; + RsPeSizeOfHeapCommit = 'Size of Heap Commit'; + RsPeLoaderFlags = 'Loader Flags'; + RsPeNumberOfRvaAndSizes = 'Number of RVA'; + + // Load config names + RsPeVersion = 'Version'; + RsPeGlobalFlagsClear = 'GlobalFlagsClear'; + RsPeGlobalFlagsSet = 'GlobalFlagsSet'; + RsPeCriticalSectionDefaultTimeout = 'CriticalSectionDefaultTimeout'; + RsPeDeCommitFreeBlockThreshold = 'DeCommitFreeBlockThreshold'; + RsPeDeCommitTotalFreeThreshold = 'DeCommitTotalFreeThreshold'; + RsPeLockPrefixTable = 'LockPrefixTable'; + RsPeMaximumAllocationSize = 'MaximumAllocationSize'; + RsPeVirtualMemoryThreshold = 'VirtualMemoryThreshold'; + RsPeProcessHeapFlags = 'ProcessHeapFlags'; + RsPeProcessAffinityMask = 'ProcessAffinityMask'; + RsPeCSDVersion = 'CSDVersion'; + RsPeReserved = 'Reserved'; + RsPeEditList = 'EditList'; + + // Machine names + RsPeMACHINE_UNKNOWN = 'Unknown'; + RsPeMACHINE_I386 = 'Intel 386'; + RsPeMACHINE_R3000 = 'MIPS little-endian R3000'; + RsPeMACHINE_R4000 = 'MIPS little-endian R4000'; + RsPeMACHINE_R10000 = 'MIPS little-endian R10000'; + RsPeMACHINE_WCEMIPSV2 = 'MIPS little-endian WCE v2'; + RsPeMACHINE_ALPHA = 'Alpha_AXP'; + RsPeMACHINE_SH3 = 'SH3 little-endian'; + RsPeMACHINE_SH3DSP = 'SH3 DSP'; + RsPeMACHINE_SH3E = 'SH3E little-endian'; + RsPeMACHINE_SH4 = 'SH4 little-endian'; + RsPeMACHINE_SH5 = 'SH5'; + RsPeMACHINE_ARM = 'ARM Little-Endian'; + RsPeMACHINE_THUMB = 'THUMB'; + RsPeMACHINE_AM33 = 'AM33'; + RsPeMACHINE_POWERPC = 'IBM PowerPC Little-Endian'; + RsPeMACHINE_POWERPCFP = 'IBM PowerPC FP'; + RsPeMACHINE_IA64 = 'Intel 64'; + RsPeMACHINE_MIPS16 = 'MIPS16'; + RsPeMACHINE_AMPHA64 = 'ALPHA64'; + RsPeMACHINE_MIPSFPU = 'MIPSFPU'; + RsPeMACHINE_MIPSFPU16 = 'MIPSFPU16'; + RsPeMACHINE_TRICORE = 'Infineon'; + RsPeMACHINE_CEF = 'CEF'; + RsPeMACHINE_EBC = 'EFI Byte Code'; + RsPeMACHINE_AMD64 = 'AMD64 (K8)'; + RsPeMACHINE_M32R = 'M32R little-endian'; + RsPeMACHINE_CEE = 'CEE'; + + // Subsystem names + RsPeSUBSYSTEM_UNKNOWN = 'Unknown'; + RsPeSUBSYSTEM_NATIVE = 'Native'; + RsPeSUBSYSTEM_WINDOWS_GUI = 'GUI'; + RsPeSUBSYSTEM_WINDOWS_CUI = 'Console'; + RsPeSUBSYSTEM_OS2_CUI = 'OS/2'; + RsPeSUBSYSTEM_POSIX_CUI = 'Posix'; + RsPeSUBSYSTEM_RESERVED8 = 'Reserved 8'; + + // Debug symbol type names + RsPeDEBUG_UNKNOWN = 'UNKNOWN'; + RsPeDEBUG_COFF = 'COFF'; + RsPeDEBUG_CODEVIEW = 'CODEVIEW'; + RsPeDEBUG_FPO = 'FPO'; + RsPeDEBUG_MISC = 'MISC'; + RsPeDEBUG_EXCEPTION = 'EXCEPTION'; + RsPeDEBUG_FIXUP = 'FIXUP'; + RsPeDEBUG_OMAP_TO_SRC = 'OMAP_TO_SRC'; + RsPeDEBUG_OMAP_FROM_SRC = 'OMAP_FROM_SRC'; + RsPeDEBUG_BORLAND = 'BORLAND'; + + // TJclPePackageInfo.PackageModuleTypeToString + RsPePkgExecutable = 'Executable'; + RsPePkgPackage = 'Package'; + PsPePkgLibrary = 'Library'; + + // TJclPePackageInfo.PackageOptionsToString + RsPePkgNeverBuild = 'NeverBuild'; + RsPePkgDesignOnly = 'DesignOnly'; + RsPePkgRunOnly = 'RunOnly'; + RsPePkgIgnoreDupUnits = 'IgnoreDupUnits'; + + // TJclPePackageInfo.ProducerToString + RsPePkgV3Produced = 'Delphi 3 or C++ Builder 3'; + RsPePkgProducerUndefined = 'Undefined'; + RsPePkgBCB4Produced = 'C++ Builder 4 or later'; + RsPePkgDelphi4Produced = 'Delphi 4 or later'; + + // TJclPePackageInfo.UnitInfoFlagsToString + RsPePkgMain = 'Main'; + RsPePkgWeak = 'Weak'; + RsPePkgOrgWeak = 'OrgWeak'; + RsPePkgImplicit = 'Implicit'; + +//=== JclRegistry ============================================================ +resourcestring + RsUnableToOpenKeyRead = 'Unable to open key "%s\%s" for read'; + RsUnableToOpenKeyWrite = 'Unable to open key "%s\%s" for write'; + RsUnableToAccessValue = 'Unable to open key "%s\%s" and access value "%s"'; + RsWrongDataType = '"%s\%s\%s" is of wrong kind or size'; + RsInconsistentPath = '"%s" does not match RootKey'; + +//=== JclRTTI ================================================================ +resourcestring + RsRTTISetValueOutOfRange = 'Set value over %s does not fit into a 32-bit integer.'; + RsRTTIValueOutOfRange = 'Value %s out of range %s..%s.'; + RsRTTIUnknownIdentifier = 'Unknown identifier ''%s''.'; + RsRTTIInvalidBaseType = 'Invalid base type (%s is of type %s).'; + RsRTTINoStringValue = 'The property %s of type %s has no string value'; + + RsRTTIVar = 'var '; + RsRTTIConst = 'const '; + RsRTTIArrayOf = 'array of '; + RsRTTIOut = 'out '; + RsRTTIBits = 'bits'; + RsRTTIOrdinal = 'ordinal='; + RsRTTITrue = 'True'; + RsRTTIFalse = 'False'; + RsRTTITypeError = '???'; + RsRTTITypeInfoAt = 'Type info: %p'; + + RsRTTIPropRead = 'read'; + RsRTTIPropWrite = 'write'; + RsRTTIPropStored = 'stored'; + + RsRTTIField = 'field'; + RsRTTIStaticMethod = 'static method'; + RsRTTIVirtualMethod = 'virtual method'; + + RsRTTIIndex = 'index'; + RsRTTIDefault = 'default'; + + RsRTTIName = 'Name: '; + RsRTTIType = 'Type: '; + RsRTTIFlags = 'Flags: '; + RsRTTIGUID = 'GUID: '; + RsRTTITypeKind = 'Type kind: '; + RsRTTIOrdinalType = 'Ordinal type: '; + RsRTTIMinValue = 'Min value: '; + RsRTTIMaxValue = 'Max value: '; + RsRTTINameList = 'Names: '; + RsRTTIClassName = 'Class name: '; + RsRTTIParent = 'Parent: '; + RsRTTIPropCount = 'Property count: '; + RsRTTIUnitName = 'Unit name: '; + RsRTTIBasedOn = 'Based on: '; + RsRTTIFloatType = 'Float type: '; + RsRTTIMethodKind = 'Method kind: '; + RsRTTIParamCount = 'Parameter count: '; + RsRTTIReturnType = 'Return type: '; + RsRTTIMaxLen = 'Max length: '; + RsRTTIElSize = 'Element size: '; + RsRTTIElType = 'Element type: '; + RsRTTIElNeedCleanup = 'Elements need clean up: '; + RsRTTIVarType = 'Variant type: '; + + RsDeclarationFormat = '// Declaration for ''%s'' not supported.'; + +//=== JclSchedule ============================================================ +resourcestring + RsScheduleInvalidTime = 'Invalid time specification'; + RsScheduleEndBeforeStart = 'End time can not be before start time'; + RsScheduleIntervalZero = 'Interval should be larger than 0'; + RsScheduleNoDaySpecified = 'At least one day of the week should be specified'; + RsScheduleIndexValueSup = 'Property IndexValue not supported for current IndexKind'; + RsScheduleIndexValueZero = 'IndexValue can not be 0'; + RsScheduleDayNotSupported = 'Property Day not supported for current IndexKind'; + RsScheduleDayInRange = 'Day values should fall in the range 1 .. 31'; + RsScheduleMonthInRange = 'Month values should fall in the range 1 .. 12'; + +//=== JclSecurity ============================================================ +resourcestring + RsInvalidSID = 'Invalid SID'; + RsSIDBufferTooSmall = 'SID buffer too small.'; + RsLsaError = 'LSA Error: NT Status = %.8x, message: %s'; + +//=== JclSimpleXml =========================================================== +resourcestring + RsEInvalidXMLElementUnexpectedCharacte = + 'Invalid XML Element: Unexpected character in property declaration ("%s" found at position %d)'; + RsEInvalidXMLElementUnexpectedCharacte_ = + 'Invalid XML Element: Unexpected character in property declaration. Expecting " or '' but "%s" found at position %d'; + RsEUnexpectedValueForLPos = 'Unexpected value for lPos at position %d'; + RsEInvalidXMLElementExpectedBeginningO = 'Invalid XML Element: Expected beginning of tag but "%s" found at position %d'; + RsEInvalidXMLElementExpectedEndOfTagBu = 'Invalid XML Element: Expected end of tag but "%s" found at position %d'; + RsEInvalidXMLElementMalformedTagFoundn = 'Invalid XML Element: malformed tag found (no valid name) at position %d'; + RsEInvalidXMLElementErroneousEndOfTagE = + 'Invalid XML Element: Erroneous end of tag, expecting but found at position %d'; + RsEInvalidCommentExpectedsButFounds = 'Invalid Comment: expected "%0:s" but found "%1:s" at position %d'; + RsEInvalidCommentNotAllowedInsideComme = 'Invalid Comment: "--" not allowed inside comments at position %d'; + RsEInvalidCommentUnexpectedEndOfData = 'Invalid Comment: Unexpected end of data at position %d'; + RsEInvalidCDATAExpectedsButFounds = 'Invalid CDATA: expected "%0:s" but found "%1:s" at position %d'; + RsEInvalidCDATAUnexpectedEndOfData = 'Invalid CDATA: Unexpected end of data at position %d'; + RsEInvalidHeaderExpectedsButFounds = 'Invalid Header: expected "%0:s" but found "%1:s" at position %d'; + RsEInvalidStylesheetExpectedsButFounds = 'Invalid Stylesheet: expected "%0:s" but found "%1:s" at position %d'; + RsEInvalidStylesheetUnexpectedEndOfDat = 'Invalid Stylesheet: Unexpected end of data at position %d'; + RsEInvalidMSOExpectedsButFounds = 'Invalid MSO: expected "%0:s" but found "%1:s" at position %d'; + RsEInvalidMSOUnexpectedEndOfDat = 'Invalid MSO: Unexpected end of data at position %d'; + RsEInvalidDocumentUnexpectedTextInFile = 'Invalid Document: Unexpected text in file prolog at position %d'; + +//=== JclStatistics ========================================================== +resourcestring + RsInvalidSampleSize = 'Invalid sample size (%d)'; + +//=== JclStreams ============================================================= +resourcestring + RsStreamsCreateError = 'Cannot create file %s'; + RsStreamsOpenError = 'Cannot open file %s'; + RsStreamsSetSizeError = 'Error setting stream size'; + RsStreamsSeekError = 'Error seeking stream'; + RsStreamsCRCError = 'Cyclic Redundency Check (CRC) error: data are damaged'; + +//=== JclStrHashMap ========================================================== +resourcestring + RsStringHashMapMustBeEmpty = 'HashList: must be empty to set size to zero'; + RsStringHashMapDuplicate = 'Duplicate hash list entry: %s'; + RsStringHashMapInvalidNode = 'Tried to remove invalid node: %s'; + RsStringHashMapNoTraits = 'HashList must have traits'; + +//=== JclStrings ============================================================= +resourcestring + RsBlankSearchString = 'Search string cannot be blank'; + RsInvalidEmptyStringItem = 'String list passed to StringsToMultiSz cannot contain empty strings.'; + RsNumericConstantTooLarge = 'Numeric constant too large (%d) at position %d.'; + RsFormatException = 'Format exception'; + RsDotNetFormatNullFormat = 'Format string is null'; + RsArgumentIsNull = 'Argument %d is null'; + RsDotNetFormatArgumentNotSupported = 'Argument type of %d is not supported'; + RsDotNetFormatObjectArgumentNotSupported = 'Argument type (%s) of %d is not supported'; + RsArgumentOutOfRange = 'Argument out of range'; + RsTabs_DuplicatesNotAllowed = 'Duplicate tab stops are not allowed.'; + RsTabs_StopExpected = 'A tab stop was expected but not found.'; + RsTabs_CloseBracketExpected = 'Closing bracket expected.'; + RsTabs_TabWidthExpected = 'Tab width expected.'; + // Default text for the NullReferenceException in .NET + RsArg_NullReferenceException = 'Object reference not set to an instance of an object.'; + +//=== JclStructStorage ======================================================= +resourcestring + RsIStreamNil = 'IStream is nil'; + +//=== JclSynch =============================================================== +resourcestring + RsSynchAttachWin32Handle = 'Invalid handle to TJclWin32HandleObject.Attach'; + RsSynchDuplicateWin32Handle = 'Invalid handle to TJclWin32HandleObject.Duplicate'; + RsSynchInitCriticalSection = 'Failed to initalize critical section'; + RsSynchAttachDispatcher = 'Invalid handle to TJclDispatcherObject.Attach'; + RsSynchCreateEvent = 'Failed to create event'; + RsSynchOpenEvent = 'Failed to open event'; + RsSynchCreateWaitableTimer = 'Failed to create waitable timer'; + RsSynchOpenWaitableTimer = 'Failed to open waitable timer'; + RsSynchCreateSemaphore = 'Failed to create semaphore'; + RsSynchOpenSemaphore = 'Failed to open semaphore'; + RsSynchCreateMutex = 'Failed to create mutex'; + RsSynchOpenMutex = 'Failed to open mutex'; + RsMetSectInvalidParameter = 'An invalid parameter was passed to the constructor.'; + RsMetSectInitialize = 'Failed to initialize the metered section.'; + RsMetSectNameEmpty = 'Name cannot be empty when using the Open constructor.'; + +//=== JclSysInfo ============================================================= +resourcestring + RsSystemProcess = 'System Process'; + RsSystemIdleProcess = 'System Idle Process'; + + RsIntelUnknownCache = 'Unknown cache ID (%.2x)'; + RsIntelCacheDescr00 = 'Null descriptor'; + RsIntelCacheDescr01 = 'Instruction TLB: 4 KByte pages, 4-way set associative, 32 entries'; + RsIntelCacheDescr02 = 'Instruction TLB: 4 MByte pages, 4-way set associative, 2 entries'; + RsIntelCacheDescr03 = 'Data TLB: 4 KByte pages, 4-way set associative, 64 entries'; + RsIntelCacheDescr04 = 'Data TLB: 4 MByte pages, 4-way set associative, 8 entries'; + RsIntelCacheDescr05 = 'Data TLB1: 4 MByte pages, 4-way set associative, 32 entries'; + RsIntelCacheDescr06 = '1st level instruction cache: 8 KBytes, 4-way set associative, 32 byte line size'; + RsIntelCacheDescr08 = '1st level instruction cache: 16 KBytes, 4-way set associative, 32 byte line size'; + RsIntelCacheDescr09 = '1st level instruction cache: 32 KBytes, 4-way set associative, 64 byte line size'; + RsIntelCacheDescr0A = '1st level data cache: 8 KBytes, 2-way set associative, 32 byte line size'; + RsIntelCacheDescr0B = 'Instruction TLB: 4 MByte pages, 4-way set associative, 4 entries'; + RsIntelCacheDescr0C = '1st level data cache: 16 KBytes, 4-way set associative, 32 byte line size'; + RsIntelCacheDescr0D = '1st level data cache: 16 KBytes, 4-way set associative, 64 byte line size'; + RsIntelCacheDescr0E = '1st level data cache: 24 KBytes, 6-way set associative, 64 byte line size'; + RsIntelCacheDescr21 = '2nd level cache: 256 KBytes, 8-way set associative, 64 byte line size'; + RsIntelCacheDescr22 = '3rd level cache: 512 KBytes, 4-way set associative, 64 byte line size, 2 lines per sector'; + RsIntelCacheDescr23 = '3rd level cache: 1 MBytes, 8-way set associative, 64 byte line size, 2 lines per sector'; + RsIntelCacheDescr25 = '3rd level cache: 2 MBytes, 8-way set associative, 64 byte line size, 2 lines per sector'; + RsIntelCacheDescr29 = '3rd level cache: 4 MBytes, 8-way set associative, 64 byte line size, 2 lines per sector'; + RsIntelCacheDescr2C = '1st level data cache: 32 KBytes, 8-way set associative, 64 byte line size'; + RsIntelCacheDescr30 = '1st level instruction cache: 32 KBytes, 8-way set associative, 64 byte line size'; + RsIntelCacheDescr39 = '2nd-level cache: 128 KBytes, 4-way set associative, sectored cache, 64-byte line size'; + RsIntelCacheDescr3A = '2nd-level cache: 192 KBytes, 6-way set associative, sectored cache, 64-byte line size'; + RsIntelCacheDescr3B = '2nd-level cache: 128 KBytes, 2-way set associative, sectored cache, 64-byte line size'; + RsIntelCacheDescr3C = '2nd-level cache: 256 KBytes, 4-way set associative, sectored cache, 64-byte line size'; + RsIntelCacheDescr3D = '2nd-level cache: 384 KBytes, 6-way set associative, sectored cache, 64-byte line size'; + RsIntelCacheDescr3E = '2nd-level cache: 512 KBytes, 4-way set associative, sectored cache, 64-byte line size'; + RsIntelCacheDescr40 = 'No 2nd-level cache or, if processor contains a valid 2nd-level cache, no 3rd-level cache'; + RsIntelCacheDescr41 = '2nd-level cache: 128 KBytes, 4-way set associative, 32 byte line size'; + RsIntelCacheDescr42 = '2nd-level cache: 256 KBytes, 4-way set associative, 32 byte line size'; + RsIntelCacheDescr43 = '2nd-level cache: 512 KBytes, 4-way set associative, 32 byte line size'; + RsIntelCacheDescr44 = '2nd-level cache: 1 MBytes, 4-way set associative, 32 byte line size'; + RsIntelCacheDescr45 = '2nd-level cache: 2 MBytes, 4-way set associative, 32 byte line size'; + RsIntelCacheDescr46 = '3rd-level cache: 4 MBytes, 4-way set associative, 64 byte line size'; + RsIntelCacheDescr47 = '3rd-level cache: 8 MBytes, 4-way set associative, 64 byte line size'; + RsIntelCacheDescr48 = '3rd-level cache: 8 MByte, 8-way set associative, 64 byte line size'; + RsIntelCacheDescr49 = '2nd-level cache: 4 MBytes, 16-way set associative, 64 byte line size'; + RsIntelCacheDescr4A = '3rd-level cache: 6MByte, 12-way set associative, 64 byte line size'; + RsIntelCacheDescr4B = '3rd-level cache: 8MByte, 16-way set associative, 64 byte line size'; + RsIntelCacheDescr4C = '3rd-level cache: 12MByte, 12-way set associative, 64 byte line size'; + RsIntelCacheDescr4D = '3rd-level cache: 16MByte, 16-way set associative, 64 byte line size'; + RsIntelCacheDescr4E = '2nd-level cache: 6MByte, 24-way set associative, 64 byte line size'; + RsIntelCacheDescr4F = 'Instruction TLB: 4 KByte pages, 32 Entries'; + RsIntelCacheDescr50 = 'Instruction TLB: 4 KByte and 2 MByte or 4 MByte pages, 64 Entries'; + RsIntelCacheDescr51 = 'Instruction TLB: 4 KByte and 2 MByte or 4 MByte pages, 128 Entries'; + RsIntelCacheDescr52 = 'Instruction TLB: 4 KByte and 2 MByte or 4 MByte pages, 256 Entries'; + RsIntelCacheDescr55 = 'Instruction TLB: 2-MByte or 4-MByte pages, fully associative, 7 entries'; + RsIntelCacheDescr56 = 'Data TLB0: 4 MByte pages, 4-way set associative, 16 entries'; + RsIntelCacheDescr57 = 'Data TLB0: 4 KByte pages, 4-way associative, 16 entries'; + RsIntelCacheDescr59 = 'Data TLB0: 4 KByte pages, fully associative, 16 entries'; + RsIntelCacheDescr5A = 'Data TLB0: 2 MByte or 4 MByte pages, 4-way set associative, 32 entries'; + RsIntelCacheDescr5B = 'Data TLB: 4 KByte and 4 MByte pages, 64 Entries'; + RsIntelCacheDescr5C = 'Data TLB: 4 KByte and 4 MByte pages, 128 Entries'; + RsIntelCacheDescr5D = 'Data TLB: 4 KByte and 4 MByte pages, 256 Entries'; + RsIntelCacheDescr60 = '1st-level data cache: 16 KByte, 8-way set associative, 64 byte line size'; + RsIntelCacheDescr66 = '1st-level data cache: 8 KBytes, 4-way set associative, 64 byte line size'; + RsIntelCacheDescr67 = '1st-level data cache: 16 KBytes, 4-way set associative, 64 byte line size'; + RsIntelCacheDescr68 = '1st-level data cache: 32 KBytes, 4-way set associative, 64 byte line size'; + RsIntelCacheDescr70 = 'Trace cache: 12 K-Ops, 8-way set associative'; + RsIntelCacheDescr71 = 'Trace cache: 16 K-Ops, 8-way set associative'; + RsIntelCacheDescr72 = 'Trace cache: 32 K-Ops, 8-way set associative'; + RsIntelCacheDescr73 = 'Trace cache: 64 K-Ops, 8-way set associative'; + RsIntelCacheDescr76 = 'Instruction TLB: 2M/4M pages, fully associative, 8 entries'; + RsIntelCacheDescr78 = '2nd-level cache: 1 MBytes, 4-way set associative, 64 bytes line size'; + RsIntelCacheDescr79 = '2nd-level cache: 128 KBytes, 8-way set associative, 64 bytes line size, 2 lines per sector'; + RsIntelCacheDescr7A = '2nd-level cache: 256 KBytes, 8-way set associative, 64 bytes line size, 2 lines per sector'; + RsIntelCacheDescr7B = '2nd-level cache: 512 KBytes, 8-way set associative, 64 bytes line size, 2 lines per sector'; + RsIntelCacheDescr7C = '2nd-level cache: 1 MBytes, 8-way set associative, 64 bytes line size, 2 lines per sector'; + RsIntelCacheDescr7D = '2nd-level cache: 2 MBytes, 8-way set associative, 64 byte line size'; + RsIntelCacheDescr7F = '2nd-level cache: 512 KBytes, 2-way set associative, 64 byte line size'; + RsIntelCacheDescr80 = '2nd-level cache: 512 KBytes, 8-way set associative, 64 byte line size'; + RsIntelCacheDescr82 = '2nd-level cache: 256 KBytes, 8-way associative, 32 byte line size'; + RsIntelCacheDescr83 = '2nd-level cache: 512 KBytes, 8-way associative, 32 byte line size'; + RsIntelCacheDescr84 = '2nd-level cache: 1 MBytes, 8-way associative, 32 byte line size'; + RsIntelCacheDescr85 = '2nd-level cache: 2 MBytes, 8-way associative, 32 byte line size'; + RsIntelCacheDescr86 = '2nd-level cache: 512 KByte, 4-way set associative, 64 byte line size'; + RsIntelCacheDescr87 = '2nd-level cache: 1 MByte, 8-way set associative, 64 byte line size'; + RsIntelCacheDescrB0 = 'Instruction TLB: 4 KByte pages, 4-way set associative, 128 entries'; + RsIntelCacheDescrB1 = 'Instruction TLB: 2 MByte pages, 4-way, 8 entries or 4 MByte pages, 4-way, 4 entries'; + RsIntelCacheDescrB2 = 'Instruction TLB: 4 KByte pages, 4-way set associative, 64 entries'; + RsIntelCacheDescrB3 = 'Data TLB: 4 KByte pages, 4-way set associative, 128 entries'; + RsIntelCacheDescrB4 = 'Data TLB1: 4 KByte pages, 4-way set associative, 256 entries'; + RsIntelCacheDescrBA = 'Data TLB1: 4 KByte pages, 4-way set associative, 64 entries'; + RsIntelCacheDescrC0 = 'Data TLB: 4 KByte and 4 MByte pages, 4-way set associative, 8 entries'; + RsIntelCacheDescrCA = 'Shared 2nd-Level TLB: 4 KByte pages, 4-way associative, 512 entries'; + RsIntelCacheDescrD0 = '3rd-level cache: 512 KByte, 4-way set associative, 64 byte line size'; + RsIntelCacheDescrD1 = '3rd-level cache: 1 MByte, 4-way set associative, 64 byte line size'; + RsIntelCacheDescrD2 = '3rd-level cache: 2 MByte, 4-way set associative, 64 byte line size'; + RsIntelCacheDescrD6 = '3rd-level cache: 1 MByte, 8-way set associative, 64 byte line size'; + RsIntelCacheDescrD7 = '3rd-level cache: 2 MByte, 8-way set associative, 64 byte line size'; + RsIntelCacheDescrD8 = '3rd-level cache: 4 MByte, 8-way set associative, 64 byte line size'; + RsIntelCacheDescrDC = '3rd-level cache: 1.5 MByte, 12-way set associative, 64 byte line size'; + RsIntelCacheDescrDD = '3rd-level cache: 3 MByte, 12-way set associative, 64 byte line size'; + RsIntelCacheDescrDE = '3rd-level cache: 6 MByte, 12-way set associative, 64 byte line size'; + RsIntelCacheDescrE2 = '3rd-level cache: 2 MByte, 16-way set associative, 64 byte line size'; + RsIntelCacheDescrE3 = '3rd-level cache: 4 MByte, 16-way set associative, 64 byte line size'; + RsIntelCacheDescrE4 = '3rd-level cache: 8 MByte, 16-way set associative, 64 byte line size'; + RsIntelCacheDescrEA = '3rd-level cache: 12 MByte, 24-way set associative, 64 byte line size'; + RsIntelCacheDescrEB = '3rd-level cache: 18 MByte, 24-way set associative, 64 byte line size'; + RsIntelCacheDescrEC = '3rd-level cache: 24 MByte, 24-way set associative, 64 byte line size'; + RsIntelCacheDescrF0 = '64-Byte Prefetching'; + RsIntelCacheDescrF1 = '128-Byte Prefetching'; + RsIntelCacheDescrFF = 'CPUID leaf 2 does not report cache descriptor information, use CPUID leaf 4 to query cache parameters'; + + RsUnknownAMDModel = 'Unknown AMD (Model %d)'; + + RsOSVersionWin95 = 'Windows 95'; + RsOSVersionWin95OSR2 = 'Windows 95 OSR2'; + RsOSVersionWin98 = 'Windows 98'; + RsOSVersionWin98SE = 'Windows 98 SE'; + RsOSVersionWinME = 'Windows ME'; + RsOSVersionWinNT3 = 'Windows NT 3.%u'; + RsOSVersionWinNT4 = 'Windows NT 4.%u'; + RsOSVersionWin2000 = 'Windows 2000'; + RsOSVersionWinXP = 'Windows XP'; + RsOSVersionWin2003 = 'Windows Server 2003'; + RsOSVersionWin2003R2 = 'Windows Server 2003 R2'; + RsOSVersionWinXP64 = 'Windows XP x64'; + RsOSVersionWinVista = 'Windows Vista'; + RsOSVersionWinServer2008 = 'Windows Server 2008'; + RsOSVersionWin7 = 'Windows 7'; + RsOSVersionWinServer2008R2 = 'Windows Server 2008 R2'; + RsOSVersionWin8 = 'Windows 8'; + RsOSVersionWin8RT = 'Windows RT'; + RsOSVersionWinServer2012 = 'Windows Server 2012'; + RsOSVersionWin81 = 'Windows 8.1'; + RsOSVersionWin81RT = 'Windows RT 8.1'; + RsOSVersionWinServer2012R2 = 'Windows Server 2012 R2'; + RsOSVersionWin10 = 'Windows 10'; + RsOSVersionWinServer2016 = 'Windows Server 2016'; + RsOSVersionWinServer2019 = 'Windows Server 2019'; + RsOSVersionWinServer2022 = 'Windows Server 2022'; + RsOSVersionWinServer2025 = 'Windows Server 2025'; + RsOSVersionWinServer = 'Windows Server'; + RsOSVersionWin11 = 'Windows 11'; + + RsEditionWinXPHome = 'Home Edition'; + RsEditionWinXPPro = 'Professional'; + RsEditionWinXPHomeN = 'Home Edition N'; + RsEditionWinXPProN = 'Professional N'; + RsEditionWinXPHomeK = 'Home Edition K'; + RsEditionWinXPProK = 'Professional K'; + RsEditionWinXPHomeKN = 'Home Edition KN'; + RsEditionWinXPProKN = 'Professional KN'; + RsEditionWinXPStarter = 'Starter Edition'; + RsEditionWinXPMediaCenter = 'Media Center Edition'; + RsEditionWinXPTablet = 'Tablet PC Edition'; + RsEditionWinVistaStarter = 'Starter'; + RsEditionWinVistaHomeBasic = 'Home Basic'; + RsEditionWinVistaHomeBasicN = 'Home Basic N'; + RsEditionWinVistaHomePremium = 'Home Premium'; + RsEditionWinVistaBusiness = 'Business'; + RsEditionWinVistaBusinessN = 'Business N'; + RsEditionWinVistaEnterprise = 'Enterprise'; + RsEditionWinVistaUltimate = 'Ultimate'; + RsEditionWin7Starter = 'Starter'; + RsEditionWin7HomeBasic = 'Home Basic'; + RsEditionWin7HomePremium = 'Home Premium'; + RsEditionWin7Professional = 'Professional'; + RsEditionWin7Enterprise = 'Enterprise'; + RsEditionWin7Ultimate = 'Ultimate'; + RsEditionWin8Pro = 'Pro'; + RsEditionWin8Enterprise = 'Enterprise'; + RsEditionWin8RT = 'RT'; + RsEditionWin81Pro = 'Pro'; + RsEditionWin81Enterprise = 'Enterprise'; + RsEditionWin81RT = 'RT'; + RsEditionWin10Home = 'Home'; + RsEditionWin10Pro = 'Pro'; + RsEditionWin10Enterprise = 'Enterprise'; + RsEditionWin10Education = 'Education'; + + RsProductTypeWorkStation = 'Workstation'; + RsProductTypeServer = 'Server'; + RsProductTypeAdvancedServer = 'Advanced Server'; + RsProductTypePersonal = 'Home Edition'; + RsProductTypeProfessional = 'Professional'; + RsProductTypeDatacenterServer = 'Datacenter Server'; + RsProductTypeEnterprise = 'Enterprise'; + RsProductTypeWebEdition = 'Web Edition'; + + RsEOpenGLInfo = 'GetOpenGLVersion: %s failed'; + RsENetWkstaGetInfo = 'NetWkstaGetInfo failed'; + + {$IFDEF MSWINDOWS} + RsSPInfo = 'SP%u'; + {$ENDIF MSWINDOWS} + + {$IFDEF UNIX} + RsInvalidProcessID = 'Invalid process ID %d'; + {$ENDIF UNIX} + + RsOpenGLInfoError = 'Err'; + +//=== JclSysUtils ============================================================ +resourcestring + RsVMTMemoryWriteError = 'Error writing VMT memory (%s)'; + RsCannotWriteRefStream = 'Can not write to a read-only memory stream'; + RsStringToBoolean = 'Unable to convert the string "%s" to a boolean'; + RsInvalidDigit = 'Invalid base %d digit ''%s'' encountered.'; + RsInvalidDigitValue = 'There is no valid base %d digit for decimal value %d'; + + {$IFDEF UNIX} + RsReadKeyError = 'ReadKey: Problem waiting on stdin'; + {$ENDIF UNIX} + + RsInvalidGUIDString = 'Invalid conversion from string to GUID (%s).'; + + RsInvalidMMFName = 'Invalid MMF name "%s"'; + RsInvalidMMFEmpty = 'The MMF named "%s" cannot be created empty'; + +//=== JclTD32 ================================================================ +resourcestring + RsHasNotTD32Info = 'File [%s] has not TD32 debug information!'; + +//=== JclTimeZones =========================================================== +resourcestring + RsEDaylightSavingsNotSupported = 'Daylight Savings not supported by this timezone'; + RsEAutoAdjustNotEnabled = 'Auto adjust for Daylight Savings is not enabled. Date is not available'; + RsENoCallbackFunc = 'No callback function assigned'; + +//=== JclUnicode ============================================================= +resourcestring + RsUREErrorFmt = '%s%s%s'; + RsUREBaseString = 'Error in regular expression: %s' + sLineBreak; + RsUREUnexpectedEOS = 'Unexpected end of pattern.'; + RsURECharacterClassOpen = 'Character class not closed, '']'' is missing.'; + RsUREUnbalancedGroup = 'Unbalanced group expression, '')'' is missing.'; + RsUREInvalidCharProperty = 'A character property is invalid'; + RsUREInvalidRepeatRange = 'Invalid repetition range.'; + RsURERepeatRangeOpen = 'Repetition range not closed, ''}'' is missing.'; + RsUREExpressionEmpty = 'Expression is empty.'; + RsCategoryUnicodeChar = 'category Unicode character > $FFFFFF found'; + RsCasedUnicodeChar = 'cased Unicode character > $FFFFFF found'; + RsDecomposedUnicodeChar = 'decomposed Unicode character > $FFFFFF found'; + RsCombiningClassUnicodeChar = 'combining class for Unicode character > $FFFFFF found'; + RsEUnexpectedEOSeq = 'Unexpected end of sequence'; + +//=== JclUnitConv ============================================================ +resourcestring + RsTempConvTypeError = 'An invalid type has been provided for the %s parameter'; + RsConvTempBelowAbsoluteZero = 'Temperature can not be below Absolute Zero!'; + +//=== JclWin32 =============================================================== +resourcestring + RsWin32Error = 'Win32 error: %s (%u)%s%s'; + RsELibraryNotFound = 'Library not found: %s'; + RsEFunctionNotFound = 'Function not found: %s.%s'; + +//=== JclWinMidi ============================================================= +resourcestring + RsMidiInUnknownError = 'Unknown MIDI-In error No. %d'; + RsMidiOutUnknownError = 'Unknown MIDI-Out error No. %d'; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclSchedule.pas b/3rdParty/JCL/source/common/JclSchedule.pas new file mode 100644 index 00000000..834f84f6 --- /dev/null +++ b/3rdParty/JCL/source/common/JclSchedule.pas @@ -0,0 +1,1310 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclSchedule.pas. } +{ } +{ The Initial Developer of the Original Code is Marcel Bestebroer. } +{ Portions created Marcel Bestebroer are Copyright (C) Marcel Bestebroer. All rights reserved. } +{ } +{ Contributor(s): } +{ Marcel Bestebroer (marcelb) } +{ Robert Rossmair (rrossmair) } +{ Petr Vones (pvones) } +{ } +{**************************************************************************************************} +{ } +{ This unit contains scheduler classes. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclSchedule; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclBase; + +type + TScheduleRecurringKind = (srkOneShot, srkDaily, srkWeekly, srkMonthly, srkYearly); + TScheduleEndKind = (sekNone, sekDate, sekTriggerCount, sekDayCount); + TScheduleWeekDay = (swdMonday, swdTuesday, swdWednesday, swdThursday, swdFriday, swdSaturday, + swdSunday); + TScheduleWeekDays = set of TScheduleWeekDay; + TScheduleIndexKind = (sikNone, sikDay, sikWeekDay, sikWeekendDay, sikMonday, sikTuesday, + sikWednesday, sikThursday, sikFriday, sikSaturday, sikSunday); + +const + sivFirst = 1; + sivSecond = 2; + sivThird = 3; + sivFourth = 4; + sivLast = -1; + +type + // Forwards + IJclSchedule = interface; + IJclDailySchedule = interface; + IJclWeeklySchedule = interface; + IJclMonthlySchedule = interface; + IJclYearlySchedule = interface; + + EJclScheduleError = class(EJclError); + ESchedule = EJclScheduleError; + + IJclSchedule = interface(IUnknown) + ['{1CC54450-7F84-4F27-B1C1-418C451DAD80}'] + function GetStartDate: TTimeStamp; + function GetRecurringType: TScheduleRecurringKind; + function GetEndType: TScheduleEndKind; + function GetEndDate: TTimeStamp; + function GetEndCount: Cardinal; + procedure SetStartDate(const Value: TTimeStamp); + procedure SetRecurringType(Value: TScheduleRecurringKind); + procedure SetEndType(Value: TScheduleEndKind); + procedure SetEndDate(const Value: TTimeStamp); + procedure SetEndCount(Value: Cardinal); + + function TriggerCount: Cardinal; + function DayCount: Cardinal; + function LastTriggered: TTimeStamp; + + procedure InitToSavedState(const LastTriggerStamp: TTimeStamp; const LastTriggerCount, + LastDayCount: Cardinal); + procedure Reset; + function NextEvent(CountMissedEvents: Boolean = False): TTimeStamp; + function NextEventFrom(const FromEvent: TTimeStamp; CountMissedEvent: Boolean = False): TTimeStamp; + function NextEventFromNow(CountMissedEvents: Boolean = False): TTimeStamp; + + property StartDate: TTimeStamp read GetStartDate write SetStartDate; + property RecurringType: TScheduleRecurringKind read GetRecurringType write SetRecurringType; + property EndType: TScheduleEndKind read GetEndType write SetEndType; + property EndDate: TTimeStamp read GetEndDate write SetEndDate; + property EndCount: Cardinal read GetEndCount write SetEndCount; + end; + + IJclScheduleDayFrequency = interface(IUnknown) + ['{6CF37F0D-56F4-4AE6-BBCA-7B9DFE60F50D}'] + function GetStartTime: Cardinal; + function GetEndTime: Cardinal; + function GetInterval: Cardinal; + procedure SetStartTime(Value: Cardinal); + procedure SetEndTime(Value: Cardinal); + procedure SetInterval(Value: Cardinal); + + property StartTime: Cardinal read GetStartTime write SetStartTime; + property EndTime: Cardinal read GetEndTime write SetEndTime; + property Interval: Cardinal read GetInterval write SetInterval; + end; + + IJclDailySchedule = interface(IUnknown) + ['{540E22C5-BE14-4539-AFB3-E24A67C58D8A}'] + function GetEveryWeekDay: Boolean; + function GetInterval: Cardinal; + procedure SetEveryWeekDay(Value: Boolean); + procedure SetInterval(Value: Cardinal); + + property EveryWeekDay: Boolean read GetEveryWeekDay write SetEveryWeekDay; + property Interval: Cardinal read GetInterval write SetInterval; + end; + + IJclWeeklySchedule = interface(IUnknown) + ['{73F15D99-C6A1-4526-8DE3-A2110E099BBC}'] + function GetDaysOfWeek: TScheduleWeekDays; + function GetInterval: Cardinal; + procedure SetDaysOfWeek(Value: TScheduleWeekDays); + procedure SetInterval(Value: Cardinal); + + property DaysOfWeek: TScheduleWeekDays read GetDaysOfWeek write SetDaysOfWeek; + property Interval: Cardinal read GetInterval write SetInterval; + end; + + IJclMonthlySchedule = interface(IUnknown) + ['{705E17FC-83E6-4385-8D2D-17013052E9B3}'] + function GetIndexKind: TScheduleIndexKind; + function GetIndexValue: Integer; + function GetDay: Cardinal; + function GetInterval: Cardinal; + procedure SetIndexKind(Value: TScheduleIndexKind); + procedure SetIndexValue(Value: Integer); + procedure SetDay(Value: Cardinal); + procedure SetInterval(Value: Cardinal); + + property IndexKind: TScheduleIndexKind read GetIndexKind write SetIndexKind; + property IndexValue: Integer read GetIndexValue write SetIndexValue; + property Day: Cardinal read GetDay write SetDay; + property Interval: Cardinal read GetInterval write SetInterval; + end; + + IJclYearlySchedule = interface(IUnknown) + ['{3E5303B0-FFA0-495A-96BB-14A718A01C1B}'] + function GetIndexKind: TScheduleIndexKind; + function GetIndexValue: Integer; + function GetDay: Cardinal; + function GetMonth: Cardinal; + function GetInterval: Cardinal; + procedure SetIndexKind(Value: TScheduleIndexKind); + procedure SetIndexValue(Value: Integer); + procedure SetDay(Value: Cardinal); + procedure SetMonth(Value: Cardinal); + procedure SetInterval(Value: Cardinal); + + property IndexKind: TScheduleIndexKind read GetIndexKind write SetIndexKind; + property IndexValue: Integer read GetIndexValue write SetIndexValue; + property Day: Cardinal read GetDay write SetDay; + property Month: Cardinal read GetMonth write SetMonth; + property Interval: Cardinal read GetInterval write SetInterval; + end; + +function CreateSchedule: IJclSchedule; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + JclDateTime, JclResources; + +//=== { TJclScheduleAggregate } ============================================== + +type + TJclScheduleAggregate = class(TAggregatedObject) + protected + procedure CheckInterfaceAllowed; + function InterfaceAllowed: Boolean; + function Schedule: IJclSchedule; + class function RecurringType: TScheduleRecurringKind; virtual; + + function ValidStamp(const Stamp: TTimeStamp): Boolean; virtual; abstract; + procedure MakeValidStamp(var Stamp: TTimeStamp); virtual; abstract; + function NextValidStamp(const Stamp: TTimeStamp): TTimeStamp; virtual; abstract; + end; + +procedure TJclScheduleAggregate.CheckInterfaceAllowed; +begin + if not InterfaceAllowed then + RunError(23); // reIntfCastError +end; + +function TJclScheduleAggregate.InterfaceAllowed: Boolean; +begin + Result := Schedule.RecurringType = RecurringType; +end; + +function TJclScheduleAggregate.Schedule: IJclSchedule; +begin + Result := Controller as IJclSchedule; +end; + +class function TJclScheduleAggregate.RecurringType: TScheduleRecurringKind; +begin + Result := srkOneShot; +end; + +//=== { TJclDayFrequency } =================================================== + +type + TJclDayFrequency = class(TAggregatedObject, IJclScheduleDayFrequency, IInterface) + private + FStartTime: Cardinal; + FEndTime: Cardinal; + FInterval: Cardinal; + protected + function ValidStamp(const Stamp: TTimeStamp): Boolean; + function NextValidStamp(const Stamp: TTimeStamp): TTimeStamp; + public + constructor Create(const Controller: IUnknown); + { IJclScheduleDayFrequency } + function GetStartTime: Cardinal; + function GetEndTime: Cardinal; + function GetInterval: Cardinal; + procedure SetStartTime(Value: Cardinal); + procedure SetEndTime(Value: Cardinal); + procedure SetInterval(Value: Cardinal); + + property StartTime: Cardinal read GetStartTime write SetStartTime; + property EndTime: Cardinal read GetEndTime write SetEndTime; + property Interval: Cardinal read GetInterval write SetInterval; + end; + +constructor TJclDayFrequency.Create(const Controller: IUnknown); +begin + inherited Create(Controller); + FStartTime := 0; + FEndTime := HoursToMSecs(24) - 1; + FInterval := 500; +end; + +function TJclDayFrequency.ValidStamp(const Stamp: TTimeStamp): Boolean; +begin + Result := (Cardinal(Stamp.Time) >= FStartTime) and (Cardinal(Stamp.Time) <= FEndTime) and + ((Cardinal(Stamp.Time) - FStartTime) mod FInterval = 0); +end; + +function TJclDayFrequency.NextValidStamp(const Stamp: TTimeStamp): TTimeStamp; +begin + Result := Stamp; + if Stamp.Time < Integer(FStartTime) then + Result.Time := FStartTime + else + if ((Cardinal(Stamp.Time) - FStartTime) mod FInterval) <> 0 then + Result.Time := Stamp.Time + Integer(FInterval-(Cardinal(Stamp.Time) - FStartTime) mod FInterval) + else + Result.Time := Stamp.Time + Integer(FInterval); + if (Result.Time < 0) or (Cardinal(Result.Time) > FEndTime) then + Result := NullStamp; +end; + +function TJclDayFrequency.GetStartTime: Cardinal; +begin + Result := FStartTime; +end; + +function TJclDayFrequency.GetEndTime: Cardinal; +begin + Result := FEndTime; +end; + +function TJclDayFrequency.GetInterval: Cardinal; +begin + Result := FInterval; +end; + +procedure TJclDayFrequency.SetStartTime(Value: Cardinal); +begin + if Value <> FStartTime then + begin + if Value >= Cardinal(HoursToMSecs(24)) then + raise EJclScheduleError.CreateRes(@RsScheduleInvalidTime); + FStartTime := Value; + if EndTime < StartTime then + FEndTime := Value; + end; +end; + +procedure TJclDayFrequency.SetEndTime(Value: Cardinal); +begin + if Value <> FEndTime then + begin + if Value < FStartTime then + raise EJclScheduleError.CreateRes(@RsScheduleEndBeforeStart); + if Value >= Cardinal(HoursToMSecs(24)) then + raise EJclScheduleError.CreateRes(@RsScheduleInvalidTime); + FEndTime := Value; + end; +end; + +procedure TJclDayFrequency.SetInterval(Value: Cardinal); +begin + if Value <> FInterval then + begin + if Value >= Cardinal(HoursToMSecs(24)) then + raise EJclScheduleError.CreateRes(@RsScheduleInvalidTime); + if Value = 0 then + begin + FEndTime := FStartTime; + FInterval := 1; + end + else + FInterval := Value; + end; +end; + +//=== { TJclDailySchedule } ================================================== + +type + TJclDailySchedule = class(TJclScheduleAggregate, IJclDailySchedule, IInterface) + private + FEveryWeekDay: Boolean; + FInterval: Cardinal; + protected + class function RecurringType: TScheduleRecurringKind; override; + + function ValidStamp(const Stamp: TTimeStamp): Boolean; override; + procedure MakeValidStamp(var Stamp: TTimeStamp); override; + function NextValidStamp(const Stamp: TTimeStamp): TTimeStamp; override; + public + constructor Create(const Controller: IUnknown); + { IJclDailySchedule } + function GetEveryWeekDay: Boolean; + function GetInterval: Cardinal; + procedure SetEveryWeekDay(Value: Boolean); + procedure SetInterval(Value: Cardinal); + + property EveryWeekDay: Boolean read GetEveryWeekDay write SetEveryWeekDay; + property Interval: Cardinal read GetInterval write SetInterval; + end; + +constructor TJclDailySchedule.Create(const Controller: IUnknown); +begin + inherited Create(Controller); + FEveryWeekDay := True; + FInterval := 1; +end; + +class function TJclDailySchedule.RecurringType: TScheduleRecurringKind; +begin + Result := srkDaily; +end; + +function TJclDailySchedule.ValidStamp(const Stamp: TTimeStamp): Boolean; +begin + Result := (FEveryWeekDay and (TimeStampDOW(Stamp) < 6)) or + (not FEveryWeekDay and (Cardinal(Stamp.Date - Schedule.StartDate.Date) mod Interval = 0)); +end; + +procedure TJclDailySchedule.MakeValidStamp(var Stamp: TTimeStamp); +begin + if FEveryWeekDay and (TimeStampDOW(Stamp) >= 6) then + Inc(Stamp.Date, 2 - (TimeStampDOW(Stamp) - 6)) + else + if not FEveryWeekDay and (Cardinal(Stamp.Date - Schedule.StartDate.Date) mod Interval <> 0) then + Inc(Stamp.Date, Interval - Cardinal(Stamp.Date - Schedule.StartDate.Date) mod Interval); +end; + +function TJclDailySchedule.NextValidStamp(const Stamp: TTimeStamp): TTimeStamp; +begin + Result := Stamp; + MakeValidStamp(Result); + if EqualTimeStamps(Stamp, Result) then + begin + // Time stamp has not been adjusted (it was valid). Determine the next time stamp + if FEveryWeekDay then + begin + Inc(Result.Date); + MakeValidStamp(Result); // Skip over the weekend. + end + else + Inc(Result.Date, Interval); // always valid as we started with a valid stamp + end; +end; + +function TJclDailySchedule.GetEveryWeekDay: Boolean; +begin + CheckInterfaceAllowed; + Result := FEveryWeekDay; +end; + +function TJclDailySchedule.GetInterval: Cardinal; +begin + CheckInterfaceAllowed; + if EveryWeekDay then + Result := 0 + else + Result := FInterval; +end; + +procedure TJclDailySchedule.SetEveryWeekDay(Value: Boolean); +begin + CheckInterfaceAllowed; + FEveryWeekDay := Value; +end; + +procedure TJclDailySchedule.SetInterval(Value: Cardinal); +begin + CheckInterfaceAllowed; + if Value = 0 then + raise EJclScheduleError.CreateRes(@RsScheduleIntervalZero); + if FEveryWeekDay then + FEveryWeekDay := False; + if Value <> FInterval then + FInterval := Value; +end; + +//=== { TJclWeeklySchedule } ================================================= + +type + TJclWeeklySchedule = class(TJclScheduleAggregate, IJclWeeklySchedule, IInterface) + private + FDaysOfWeek: TScheduleWeekDays; + FInterval: Cardinal; + protected + class function RecurringType: TScheduleRecurringKind; override; + + function ValidStamp(const Stamp: TTimeStamp): Boolean; override; + procedure MakeValidStamp(var Stamp: TTimeStamp); override; + function NextValidStamp(const Stamp: TTimeStamp): TTimeStamp; override; + public + constructor Create(const Controller: IUnknown); + { IJclWeeklySchedule } + function GetDaysOfWeek: TScheduleWeekDays; + function GetInterval: Cardinal; + procedure SetDaysOfWeek(Value: TScheduleWeekDays); + procedure SetInterval(Value: Cardinal); + + property DaysOfWeek: TScheduleWeekDays read GetDaysOfWeek write SetDaysOfWeek; + property Interval: Cardinal read GetInterval write SetInterval; + end; + +constructor TJclWeeklySchedule.Create(const Controller: IUnknown); +begin + inherited Create(Controller); + FDaysOfWeek := [swdMonday]; + FInterval := 1; +end; + +class function TJclWeeklySchedule.RecurringType: TScheduleRecurringKind; +begin + Result := srkWeekly; +end; + +function TJclWeeklySchedule.ValidStamp(const Stamp: TTimeStamp): Boolean; +begin + Result := (TScheduleWeekDay(TimeStampDOW(Stamp)) in DaysOfWeek) and + (Cardinal((Stamp.Date - Schedule.StartDate.Date) div 7) mod Interval = 0); +end; + +procedure TJclWeeklySchedule.MakeValidStamp(var Stamp: TTimeStamp); +begin + while not (TScheduleWeekDay(TimeStampDOW(Stamp) - 1) in DaysOfWeek) do + Inc(Stamp.Date); + if (Stamp.Date - Schedule.StartDate.Date) <> 0 then + begin + if Cardinal((Stamp.Date - Schedule.StartDate.Date) div 7) mod Interval <> 0 then + Inc(Stamp.Date, 7 * (Interval - + (Cardinal((Stamp.Date - Schedule.StartDate.Date) div 7) mod Interval))); + end; +end; + +function TJclWeeklySchedule.NextValidStamp(const Stamp: TTimeStamp): TTimeStamp; +begin + Result := Stamp; + MakeValidStamp(Result); + if EqualTimeStamps(Stamp, Result) then + begin + // Time stamp has not been adjusted (it was valid). Determine the next time stamp + Inc(Result.Date); + MakeValidStamp(Result); // Skip over unwanted days and weeks + end; +end; + +function TJclWeeklySchedule.GetDaysOfWeek: TScheduleWeekDays; +begin + CheckInterfaceAllowed; + Result := FDaysOfWeek; +end; + +function TJclWeeklySchedule.GetInterval: Cardinal; +begin + CheckInterfaceAllowed; + Result := FInterval; +end; + +procedure TJclWeeklySchedule.SetDaysOfWeek(Value: TScheduleWeekDays); +begin + CheckInterfaceAllowed; + if Value = [] then + raise EJclScheduleError.CreateRes(@RsScheduleNoDaySpecified); + FDaysOfWeek := Value; +end; + +procedure TJclWeeklySchedule.SetInterval(Value: Cardinal); +begin + CheckInterfaceAllowed; + if Value = 0 then + raise EJclScheduleError.CreateRes(@RsScheduleIntervalZero); + FInterval := Value; +end; + +//=== { TJclMonthlySchedule } ================================================ + +type + TJclMonthlySchedule = class(TJclScheduleAggregate, IJclMonthlySchedule, IInterface) + private + FIndexKind: TScheduleIndexKind; + FIndexValue: Integer; + FDay: Cardinal; + FInterval: Cardinal; + protected + class function RecurringType: TScheduleRecurringKind; override; + + function ValidStamp(const Stamp: TTimeStamp): Boolean; override; + procedure MakeValidStamp(var Stamp: TTimeStamp); override; + function NextValidStamp(const Stamp: TTimeStamp): TTimeStamp; override; + + function ValidStampMonthIndex(const TYear, TMonth, TDay: Word): Boolean; + procedure MakeValidStampMonthIndex(var TYear, TMonth, TDay: Word); + public + constructor Create(const Controller: IUnknown); + { IJclMonthlySchedule } + function GetIndexKind: TScheduleIndexKind; + function GetIndexValue: Integer; + function GetDay: Cardinal; + function GetInterval: Cardinal; + procedure SetIndexKind(Value: TScheduleIndexKind); + procedure SetIndexValue(Value: Integer); + procedure SetDay(Value: Cardinal); + procedure SetInterval(Value: Cardinal); + + property IndexKind: TScheduleIndexKind read GetIndexKind write SetIndexKind; + property IndexValue: Integer read GetIndexValue write SetIndexValue; + property Day: Cardinal read GetDay write SetDay; + property Interval: Cardinal read GetInterval write SetInterval; + end; + +constructor TJclMonthlySchedule.Create(const Controller: IUnknown); +begin + inherited Create(Controller); + FIndexKind := sikNone; + FIndexValue := sivFirst; + FDay := 1; + FInterval := 1; +end; + +class function TJclMonthlySchedule.RecurringType: TScheduleRecurringKind; +begin + Result := srkMonthly; +end; + +function TJclMonthlySchedule.ValidStamp(const Stamp: TTimeStamp): Boolean; +var + SYear, SMonth, SDay: Word; + TYear, TMonth, TDay: Word; +begin + DecodeDate(TimeStampToDateTime(Schedule.StartDate), SYear, SMonth, SDay); + DecodeDate(TimeStampToDateTime(Stamp), TYear, TMonth, TDay); + Result := (((TYear * 12 + TMonth) - (SYear * 12 + SMonth)) mod Integer(Interval) = 0) and + ValidStampMonthIndex(TYear, TMonth, TDay); +end; + +procedure TJclMonthlySchedule.MakeValidStamp(var Stamp: TTimeStamp); +var + SYear, SMonth, SDay: Word; + TYear, TMonth, TDay: Word; + MonthDiff: Integer; +begin + DecodeDate(TimeStampToDateTime(Schedule.StartDate), SYear, SMonth, SDay); + DecodeDate(TimeStampToDateTime(Stamp), TYear, TMonth, TDay); + MonthDiff := (TYear * 12 + TMonth) - (SYear * 12 + SMonth); + if MonthDiff mod Integer(Interval) <> 0 then + begin + Inc(TMonth, Integer(Interval) - (MonthDiff mod Integer(Interval))); + if TMonth > 12 then + begin + Inc(TYear, TMonth div 12); + TMonth := TMonth mod 12; + end; + TDay := 1; + end; + MakeValidStampMonthIndex(TYear, TMonth, TDay); + while DateTimeToTimeStamp(JclDateTime.EncodeDate(TYear, TMonth, TDay)).Date < Stamp.Date do + begin + Inc(TMonth, Integer(Interval)); + if TMonth > 12 then + begin + Inc(TYear, TMonth div 12); + TMonth := TMonth mod 12; + end; + MakeValidStampMonthIndex(TYear, TMonth, TDay); + end; + Stamp.Date := DateTimeToTimeStamp(JclDateTime.EncodeDate(TYear, TMonth, TDay)).Date; +end; + +function TJclMonthlySchedule.NextValidStamp(const Stamp: TTimeStamp): TTimeStamp; +begin + Result := Stamp; + MakeValidStamp(Result); + if EqualTimeStamps(Stamp, Result) then + begin + // Time stamp has not been adjusted (it was valid). Determine the next time stamp + Inc(Result.Date); + MakeValidStamp(Result); // Skip over unwanted days and months + end; +end; + +function TJclMonthlySchedule.ValidStampMonthIndex(const TYear, TMonth, TDay: Word): Boolean; +var + DIM: Integer; + TempDay: Integer; +begin + DIM := DaysInMonth(JclDateTime.EncodeDate(TYear, TMonth, 1)); + case IndexKind of + sikNone: + Result := (TDay = Day) or ((Integer(Day) > DIM) and (TDay = DIM)); + sikDay: + Result := + ((IndexValue = sivLast) and (TDay = DIM)) or + ((IndexValue <> sivLast) and ( + (TDay = IndexValue) or ( + (IndexValue > DIM) and + (TDay = DIM) + ) or ( + (IndexValue < 0) and ( + (TDay = DIM + 1 + IndexValue) or ( + (-IndexValue > DIM) and + (TDay = 1) + ) + ) + ) + )); + sikWeekDay: + begin + case IndexValue of + sivFirst: + TempDay := FirstWeekDay(TYear, TMonth); + sivLast: + TempDay := LastWeekDay(TYear, TMonth); + else + TempDay := IndexedWeekDay(TYear, TMonth, IndexValue); + if TempDay = 0 then + begin + if IndexValue > 0 then + TempDay := LastWeekDay(TYear, TMonth) + else + if IndexValue < 0 then + TempDay := FirstWeekDay(TYear, TMonth); + end; + end; + Result := TDay = TempDay; + end; + sikWeekendDay: + begin + case IndexValue of + sivFirst: + TempDay := FirstWeekendDay(TYear, TMonth); + sivLast: + TempDay := LastWeekendDay(TYear, TMonth); + else + TempDay := IndexedWeekendDay(TYear, TMonth, IndexValue); + if TempDay = 0 then + begin + if IndexValue > 0 then + TempDay := LastWeekendDay(TYear, TMonth) + else + if IndexValue < 0 then + TempDay := FirstWeekendDay(TYear, TMonth); + end; + end; + Result := TDay = TempDay; + end; + sikMonday..sikSunday: + begin + case IndexValue of + sivFirst: + TempDay := FirstDayOfWeek(TYear, TMonth, Ord(IndexKind) - Ord(sikWeekendDay)); + sivLast: + TempDay := LastDayOfWeek(TYear, TMonth, Ord(IndexKind) - Ord(sikWeekendDay)); + else + TempDay := IndexedDayOfWeek(TYear, TMonth, Ord(IndexKind) - Ord(sikWeekendDay), + IndexValue); + if TempDay = 0 then + begin + if IndexValue > 0 then + TempDay := LastDayOfWeek(TYear, TMonth, Ord(IndexKind) - Ord(sikWeekendDay)) + else + if IndexValue < 0 then + TempDay := FirstDayOfWeek(TYear, TMonth, Ord(IndexKind) - Ord(sikWeekendDay)); + end; + end; + Result := TDay = TempDay; + end; + else + Result := False; + end; +end; + +procedure TJclMonthlySchedule.MakeValidStampMonthIndex(var TYear, TMonth, TDay: Word); +var + DIM: Integer; +begin + DIM := DaysInMonth(JclDateTime.EncodeDate(TYear, TMonth, 1)); + case IndexKind of + sikNone: + begin + TDay := Day; + if Integer(Day) > DIM then + TDay := DIM; + end; + sikDay: + begin + if (IndexValue = sivLast) or (Integer(IndexValue) > DIM) then + TDay := DIM + else + if IndexValue > 0 then + TDay := IndexValue + else + begin + if -IndexValue > DIM then + TDay := 1 + else + TDay := DIM + 1 + IndexValue; + end; + end; + sikWeekDay: + begin + case IndexValue of + sivFirst: + TDay := FirstWeekDay(TYear, TMonth); + sivLast: + TDay := LastWeekDay(TYear, TMonth); + else + begin + TDay := IndexedWeekDay(TYear, TMonth, IndexValue); + if TDay = 0 then + begin + if IndexValue > 0 then + TDay := LastWeekDay(TYear, TMonth) + else + if IndexValue < 0 then + TDay := FirstWeekDay(TYear, TMonth); + end; + end; + end; + end; + sikWeekendDay: + begin + case IndexValue of + sivFirst: + TDay := FirstWeekendDay(TYear, TMonth); + sivLast: + TDay := LastWeekendDay(TYear, TMonth); + else + begin + TDay := IndexedWeekendDay(TYear, TMonth, IndexValue); + if TDay = 0 then + begin + if IndexValue > 0 then + TDay := LastWeekendDay(TYear, TMonth) + else + if IndexValue < 0 then + TDay := FirstWeekendDay(TYear, TMonth); + end; + end; + end; + end; + sikMonday..sikSunday: + begin + case IndexValue of + sivFirst: + TDay := FirstDayOfWeek(TYear, TMonth, Ord(IndexKind) - Ord(sikWeekendDay)); + sivLast: + TDay := LastDayOfWeek(TYear, TMonth, Ord(IndexKind) - Ord(sikWeekendDay)); + else + TDay := IndexedDayOfWeek(TYear, TMonth, Ord(IndexKind) - Ord(sikWeekendDay), + IndexValue); + if TDay = 0 then + begin + if IndexValue > 0 then + TDay := LastDayOfWeek(TYear, TMonth, Ord(IndexKind) - Ord(sikWeekendDay)) + else + if IndexValue < 0 then + TDay := FirstDayOfWeek(TYear, TMonth, Ord(IndexKind) - Ord(sikWeekendDay)); + end; + end; + end; + end; +end; + +function TJclMonthlySchedule.GetIndexKind: TScheduleIndexKind; +begin + CheckInterfaceAllowed; + Result := FIndexKind; +end; + +function TJclMonthlySchedule.GetIndexValue: Integer; +begin + CheckInterfaceAllowed; + if not (FIndexKind in [sikDay .. sikSunday]) then + raise EJclScheduleError.CreateRes(@RsScheduleIndexValueSup); + Result := FIndexValue; +end; + +function TJclMonthlySchedule.GetDay: Cardinal; +begin + CheckInterfaceAllowed; + Result := FDay; +end; + +function TJclMonthlySchedule.GetInterval: Cardinal; +begin + CheckInterfaceAllowed; + Result := FInterval; +end; + +procedure TJclMonthlySchedule.SetIndexKind(Value: TScheduleIndexKind); +begin + CheckInterfaceAllowed; + FIndexKind := Value; +end; + +procedure TJclMonthlySchedule.SetIndexValue(Value: Integer); +begin + CheckInterfaceAllowed; + if not (FIndexKind in [sikDay .. sikSunday]) then + raise EJclScheduleError.CreateRes(@RsScheduleIndexValueSup); + if Value = 0 then + raise EJclScheduleError.CreateRes(@RsScheduleIndexValueZero); + FIndexValue := Value; +end; + +procedure TJclMonthlySchedule.SetDay(Value: Cardinal); +begin + CheckInterfaceAllowed; + if not (FIndexKind in [sikNone]) then + raise EJclScheduleError.CreateRes(@RsScheduleDayNotSupported); + if (Value = 0) or (Value > 31) then + raise EJclScheduleError.CreateRes(@RsScheduleDayInRange); + FDay := Value; +end; + +procedure TJclMonthlySchedule.SetInterval(Value: Cardinal); +begin + CheckInterfaceAllowed; + if Value = 0 then + raise EJclScheduleError.CreateRes(@RsScheduleIntervalZero); + FInterval := Value; +end; + +//=== { TJclYearlySchedule } ================================================= + +type + TJclYearlySchedule = class(TJclMonthlySchedule, IJclYearlySchedule, IInterface) + private + FMonth: Cardinal; + protected + class function RecurringType: TScheduleRecurringKind; override; + + function ValidStamp(const Stamp: TTimeStamp): Boolean; override; + procedure MakeValidStamp(var Stamp: TTimeStamp); override; + function NextValidStamp(const Stamp: TTimeStamp): TTimeStamp; override; + public + constructor Create(const Controller: IUnknown); + { IJclYearlySchedule } + function GetMonth: Cardinal; + procedure SetMonth(Value: Cardinal); + + property Month: Cardinal read GetMonth write SetMonth; + end; + +constructor TJclYearlySchedule.Create(const Controller: IUnknown); +begin + inherited Create(Controller); + FMonth := 1; +end; + +class function TJclYearlySchedule.RecurringType: TScheduleRecurringKind; +begin + Result := srkYearly; +end; + +function TJclYearlySchedule.ValidStamp(const Stamp: TTimeStamp): Boolean; +var + SYear, SMonth, SDay: Word; + TYear, TMonth, TDay: Word; +begin + JclDateTime.DecodeDate(TimeStampToDateTime(Schedule.StartDate), SYear, SMonth, SDay); + JclDateTime.DecodeDate(TimeStampToDateTime(Stamp), TYear, TMonth, TDay); + Result := ((TYear - SYear) mod Integer(Interval) = 0) and (TMonth = Month) and + ValidStampMonthIndex(TYear, TMonth, TDay); +end; + +procedure TJclYearlySchedule.MakeValidStamp(var Stamp: TTimeStamp); +var + SYear, SMonth, SDay: Word; + TYear, TMonth, TDay: Word; + YearDiff: Integer; +begin + JclDateTime.DecodeDate(TimeStampToDateTime(Schedule.StartDate), SYear, SMonth, SDay); + JclDateTime.DecodeDate(TimeStampToDateTime(Stamp), TYear, TMonth, TDay); + YearDiff := TYear - SYear; + if YearDiff mod Integer(Interval) <> 0 then + begin + Inc(TYear, Integer(Interval) - (YearDiff mod Integer(Interval))); + TMonth := Month; + TDay := 1; + end; + MakeValidStampMonthIndex(TYear, TMonth, TDay); + while DateTimeToTimeStamp(JclDateTime.EncodeDate(TYear, TMonth, TDay)).Date < Stamp.Date do + begin + Inc(TYear, Integer(Interval)); + TMonth := Month; + TDay := 1; + MakeValidStampMonthIndex(TYear, TMonth, TDay); + end; + Stamp.Date := DateTimeToTimeStamp(JclDateTime.EncodeDate(TYear, TMonth, TDay)).Date; +end; + +function TJclYearlySchedule.NextValidStamp(const Stamp: TTimeStamp): TTimeStamp; +begin + Result := Stamp; + MakeValidStamp(Result); + if EqualTimeStamps(Stamp, Result) then + begin + // Time stamp has not been adjusted (it was valid). Determine the next time stamp + Inc(Result.Date); + MakeValidStamp(Result); // Skip over unwanted days and months + end; +end; + +function TJclYearlySchedule.GetMonth: Cardinal; +begin + CheckInterfaceAllowed; + Result := FMonth; +end; + +procedure TJclYearlySchedule.SetMonth(Value: Cardinal); +begin + CheckInterfaceAllowed; + if (Value < 1) or (Value > 12) then + raise EJclScheduleError.CreateRes(@RsScheduleMonthInRange); + FMonth := Value; +end; + +//=== { TJclSchedule } ======================================================= + +type + TJclSchedule = class(TInterfacedObject, IJclSchedule, IJclScheduleDayFrequency, IJclDailySchedule, + IJclWeeklySchedule, IJclMonthlySchedule, IJclYearlySchedule) + private + FStartDate: TTimeStamp; + FRecurringType: TScheduleRecurringKind; + FEndType: TScheduleEndKind; + FEndDate: TTimeStamp; + FEndCount: Cardinal; + FDayFrequency: TJclDayFrequency; + FDailySchedule: TJclDailySchedule; + FWeeklySchedule: TJclWeeklySchedule; + FMonthlySchedule: TJclMonthlySchedule; + FYearlySchedule: TJclYearlySchedule; + protected + FTriggerCount: Cardinal; + FDayCount: Cardinal; + FLastEvent: TTimeStamp; + function GetNextEventStamp(const From: TTimeStamp): TTimeStamp; + public + constructor Create; + destructor Destroy; override; + + { IJclSchedule } + function GetStartDate: TTimeStamp; + function GetRecurringType: TScheduleRecurringKind; + function GetEndType: TScheduleEndKind; + function GetEndDate: TTimeStamp; + function GetEndCount: Cardinal; + procedure SetStartDate(const Value: TTimeStamp); + procedure SetRecurringType(Value: TScheduleRecurringKind); + procedure SetEndType(Value: TScheduleEndKind); + procedure SetEndDate(const Value: TTimeStamp); + procedure SetEndCount(Value: Cardinal); + + function TriggerCount: Cardinal; + function DayCount: Cardinal; + function LastTriggered: TTimeStamp; + + procedure InitToSavedState(const LastTriggerStamp: TTimeStamp; const LastTriggerCount, + LastDayCount: Cardinal); + procedure Reset; + function NextEvent(CountMissedEvents: Boolean = False): TTimeStamp; + function NextEventFrom(const FromEvent: TTimeStamp; + CountMissedEvent: Boolean = False): TTimeStamp; + function NextEventFromNow(CountMissedEvents: Boolean = False): TTimeStamp; + + property StartDate: TTimeStamp read GetStartDate write SetStartDate; + property RecurringType: TScheduleRecurringKind read GetRecurringType write SetRecurringType; + property EndType: TScheduleEndKind read GetEndType write SetEndType; + property EndDate: TTimeStamp read GetEndDate write SetEndDate; + property EndCount: Cardinal read GetEndCount write SetEndCount; + + { IJclScheduleDayFrequency } + function GetDayFrequency: IJclScheduleDayFrequency; + property DayFrequency: IJclScheduleDayFrequency read GetDayFrequency implements IJclScheduleDayFrequency; + { IJclDailySchedule } + function GetDailySchedule: IJclDailySchedule; + property DailySchedule: IJclDailySchedule read GetDailySchedule implements IJclDailySchedule; + { IJclWeeklySchedule } + function GetWeeklySchedule: IJclWeeklySchedule; + property WeeklySchedule: IJclWeeklySchedule read GetWeeklySchedule implements IJclWeeklySchedule; + { IJclMonthlySchedule } + function GetMonthlySchedule: IJclMonthlySchedule; + property MonthlySchedule: IJclMonthlySchedule read GetMonthlySchedule implements IJclMonthlySchedule; + { IJclYearlySchedule } + function GetYearlySchedule: IJclYearlySchedule; + property YearlySchedule: IJclYearlySchedule read GetYearlySchedule implements IJclYearlySchedule; + end; + +constructor TJclSchedule.Create; +var + InitialStamp: TTimeStamp; +begin + inherited Create; + FDayFrequency := TJclDayFrequency.Create(Self); + FDailySchedule := TJclDailySchedule.Create(Self); + FWeeklySchedule := TJclWeeklySchedule.Create(Self); + FMonthlySchedule := TJclMonthlySchedule.Create(Self); + FYearlySchedule := TJclYearlySchedule.Create(Self); + InitialStamp := DateTimeToTimeStamp(Now); + InitialStamp.Time := 1000 * (InitialStamp.Time div 1000); // strip of milliseconds + StartDate := InitialStamp; + EndType := sekNone; + RecurringType := srkOneShot; +end; + +destructor TJclSchedule.Destroy; +begin + FreeAndNil(FYearlySchedule); + FreeAndNil(FMonthlySchedule); + FreeAndNil(FWeeklySchedule); + FreeAndNil(FDailySchedule); + FreeAndNil(FDayFrequency); + inherited Destroy; +end; + +function TJclSchedule.GetDayFrequency: IJclScheduleDayFrequency; +begin + Result := FDayFrequency; +end; + +function TJclSchedule.GetDailySchedule: IJclDailySchedule; +begin + Result := FDailySchedule; +end; + +function TJclSchedule.GetWeeklySchedule: IJclWeeklySchedule; +begin + Result := FWeeklySchedule; +end; + +function TJclSchedule.GetMonthlySchedule: IJclMonthlySchedule; +begin + Result := FMonthlySchedule; +end; + +function TJclSchedule.GetYearlySchedule: IJclYearlySchedule; +begin + Result := FYearlySchedule; +end; + +function TJclSchedule.GetNextEventStamp(const From: TTimeStamp): TTimeStamp; +var + UseFrom: TTimeStamp; +begin + Result := NullStamp; + UseFrom := From; + if (From.Date = 0) or (From.Date < StartDate.Date) then + begin + UseFrom := StartDate; + Dec(UseFrom.Time); + end; + case RecurringType of + srkOneShot: + if TriggerCount = 0 then + Result := StartDate; + srkDaily: + begin + Result := FDayFrequency.NextValidStamp(UseFrom); + if IsNullTimeStamp(Result) then + begin + Result.Date := UseFrom.Date; + Result.Time := FDayFrequency.StartTime; + Result := FDailySchedule.NextValidStamp(Result); + end + else + FDailySchedule.MakeValidStamp(Result); + end; + srkWeekly: + begin + Result := FDayFrequency.NextValidStamp(UseFrom); + if IsNullTimeStamp(Result) then + begin + Result.Date := UseFrom.Date; + Result.Time := FDayFrequency.StartTime; + Result := FWeeklySchedule.NextValidStamp(Result); + end + else + FWeeklySchedule.MakeValidStamp(Result); + end; + srkMonthly: + begin + Result := FDayFrequency.NextValidStamp(UseFrom); + if IsNullTimeStamp(Result) then + begin + Result.Date := UseFrom.Date; + Result.Time := FDayFrequency.StartTime; + Result := FMonthlySchedule.NextValidStamp(Result); + end + else + FMonthlySchedule.MakeValidStamp(Result); + end; + srkYearly: + begin + Result := FDayFrequency.NextValidStamp(UseFrom); + if IsNullTimeStamp(Result) then + begin + Result.Date := UseFrom.Date; + Result.Time := FDayFrequency.StartTime; + Result := FYearlySchedule.NextValidStamp(Result); + end + else + FYearlySchedule.MakeValidStamp(Result); + end; + end; + if CompareTimeStamps(Result, UseFrom) < 0 then + Result := NullStamp; + if not IsNullTimeStamp(Result) then + begin + if ((EndType = sekDate) and (CompareTimeStamps(Result, EndDate) > 0)) or + ((EndType = sekDayCount) and (DayCount = EndCount) and (UseFrom.Date <> Result.Date)) or + ((EndType = sekTriggerCount) and (TriggerCount = EndCount)) then + Result := NullStamp + else + begin + Inc(FTriggerCount); + if (UseFrom.Date <> Result.Date) or (DayCount = 0) then + Inc(FDayCount); + FLastEvent := Result; + end; + end; +end; + +function TJclSchedule.GetStartDate: TTimeStamp; +begin + Result := FStartDate; +end; + +function TJclSchedule.GetRecurringType: TScheduleRecurringKind; +begin + Result := FRecurringType; +end; + +function TJclSchedule.GetEndType: TScheduleEndKind; +begin + Result := FEndType; +end; + +function TJclSchedule.GetEndDate: TTimeStamp; +begin + Result := FEndDate; +end; + +function TJclSchedule.GetEndCount: Cardinal; +begin + Result := FEndCount; +end; + +procedure TJclSchedule.SetStartDate(const Value: TTimeStamp); +begin + FStartDate := Value; +end; + +procedure TJclSchedule.SetRecurringType(Value: TScheduleRecurringKind); +begin + FRecurringType := Value; +end; + +procedure TJclSchedule.SetEndType(Value: TScheduleEndKind); +begin + FEndType := Value; +end; + +procedure TJclSchedule.SetEndDate(const Value: TTimeStamp); +begin + FEndDate := Value; +end; + +procedure TJclSchedule.SetEndCount(Value: Cardinal); +begin + FEndCount := Value; +end; + +function TJclSchedule.TriggerCount: Cardinal; +begin + Result := FTriggerCount; +end; + +function TJclSchedule.DayCount: Cardinal; +begin + Result := FDayCount; +end; + +function TJclSchedule.LastTriggered: TTimeStamp; +begin + Result := FLastEvent; +end; + +procedure TJclSchedule.InitToSavedState(const LastTriggerStamp: TTimeStamp; const LastTriggerCount, + LastDayCount: Cardinal); +begin + FLastEvent := LastTriggerStamp; + FTriggerCount := LastTriggerCount; + FDayCount := LastDayCount; +end; + +procedure TJclSchedule.Reset; +begin + FLastEvent := NullStamp; + FTriggerCount := 0; + FDayCount := 0; +end; + +function TJclSchedule.NextEvent(CountMissedEvents: Boolean = False): TTimeStamp; +begin + Result := NextEventFrom(FLastEvent, CountMissedEvents); +end; + +function TJclSchedule.NextEventFrom(const FromEvent: TTimeStamp; + CountMissedEvent: Boolean = False): TTimeStamp; +begin + if CountMissedEvent then + begin + Result := FLastEvent; + repeat + Result := GetNextEventStamp(Result); + until IsNullTimeStamp(Result) or (CompareTimeStamps(FromEvent, Result) <= 0); + end + else + Result := GetNextEventStamp(FromEvent); +end; + +function TJclSchedule.NextEventFromNow(CountMissedEvents: Boolean = False): TTimeStamp; +begin + Result := NextEventFrom(DateTimeToTimeStamp(Now), CountMissedEvents); +end; + +function CreateSchedule: IJclSchedule; +begin + Result := TJclSchedule.Create; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclSimpleXml.pas b/3rdParty/JCL/source/common/JclSimpleXml.pas index 2b0d7ad0..e9faf42a 100644 --- a/3rdParty/JCL/source/common/JclSimpleXml.pas +++ b/3rdParty/JCL/source/common/JclSimpleXml.pas @@ -1,4446 +1,4446 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is JvSimpleXML.PAS, released on 2002-06-03. } -{ } -{ The Initial Developer of the Original Code is Sébastien Buysse [sbuysse att buypin dott com]. } -{ Portions created by Sébastien Buysse are Copyright (C) 2001 Sébastien Buysse. } -{ All Rights Reserved. } -{ } -{ Contributor(s): } -{ Christophe Paris, } -{ Florent Ouchet (move from the JVCL to the JCL) } -{ Teträm } -{ } -{**************************************************************************************************} -{ } -{ This unit contains Xml parser and writter classes } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -// Known Issues: This component does not parse the !DOCTYPE tags but preserves them - -unit JclSimpleXml; - -interface - -{$I jcl.inc} - -uses - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - {$IFDEF HAS_UNITSCOPE} - {$IFDEF HAS_UNIT_RTLCONSTS} - System.RTLConsts, - {$ENDIF HAS_UNIT_RTLCONSTS} - {$IFDEF MSWINDOWS} - Winapi.Windows, // Delphi 2005 inline - {$ENDIF MSWINDOWS} - System.SysUtils, System.Classes, - System.Variants, - System.IniFiles, - System.Contnrs, - {$ELSE ~HAS_UNITSCOPE} - {$IFDEF HAS_UNIT_RTLCONSTS} - RTLConsts, - {$ENDIF HAS_UNIT_RTLCONSTS} - {$IFDEF MSWINDOWS} - Windows, // Delphi 2005 inline - {$ENDIF MSWINDOWS} - SysUtils, Classes, - Variants, - IniFiles, - Contnrs, - {$ENDIF ~HAS_UNITSCOPE} - JclBase, JclStreams; - -type - TJclSimpleItem = class(TObject) - private - FName: string; - protected - procedure SetName(const Value: string); virtual; - public - property Name: string read FName write SetName; - end; - -type - TJclSimpleItemHashedList = class(TObjectList) - private - FNameHash: TStringHash; - FCaseSensitive: Boolean; - function GetSimpleItemByName(const Name: string): TJclSimpleItem; - function GetSimpleItem(Index: Integer): TJclSimpleItem; - procedure SetCaseSensitive(const Value: Boolean); - protected - procedure Notify(Ptr: Pointer; Action: TListNotification); override; - public - constructor Create(ACaseSensitive: Boolean); - destructor Destroy; override; - function Add(Item: TJclSimpleItem): Integer; - function Extract(Item: TJclSimpleItem): TJclSimpleItem; - procedure Clear; override; - function IndexOfSimpleItem(Item: TJclSimpleItem): Integer; - function IndexOfName(const Name: string): Integer; - procedure Insert(Index: Integer; Item: TJclSimpleItem); - procedure InvalidateHash; - procedure Move(CurIndex, NewIndex: Integer); - property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive; - property SimpleItemByNames[const Name: string]: TJclSimpleItem read GetSimpleItemByName; - property SimpleItems[Index: Integer]: TJclSimpleItem read GetSimpleItem; - end; - -type - TJclSimpleData = class(TJclSimpleItem) - private - FValue: string; - FData: Pointer; - protected - function GetBoolValue: Boolean; - procedure SetBoolValue(const Value: Boolean); - function GetFloatValue: Extended; - procedure SetFloatValue(const Value: Extended); - function GetAnsiValue: AnsiString; - procedure SetAnsiValue(const Value: AnsiString); - function GetIntValue: Int64; - procedure SetIntValue(const Value: Int64); - public - constructor Create; overload; virtual; - constructor Create(const AName: string); overload; - constructor Create(const AName, AValue: string); overload; - property Value: string read FValue write FValue; - property AnsiValue: AnsiString read GetAnsiValue write SetAnsiValue; - property IntValue: Int64 read GetIntValue write SetIntValue; - property BoolValue: Boolean read GetBoolValue write SetBoolValue; - property FloatValue: Extended read GetFloatValue write SetFloatValue; - - property Data: Pointer read FData write FData; - end; - -type - TJclSimpleXMLData = class(TJclSimpleData) - private - FNameSpace: string; - public - function FullName:string; - property NameSpace: string read FNameSpace write FNameSpace; - end; - -type - TJclSimpleXML = class; - EJclSimpleXMLError = class(EJclError); - {$TYPEINFO ON} // generate RTTI for published properties - TJclSimpleXMLElem = class; - {$IFNDEF TYPEINFO_ON} - {$TYPEINFO OFF} - {$ENDIF ~TYPEINFO_ON} - TJclSimpleXMLElems = class; - TJclSimpleXMLProps = class; - TJclSimpleXMLElemsProlog = class; - TJclSimpleXMLNamedElems = class; - TJclSimpleXMLElemComment = class; - TJclSimpleXMLElemClassic = class; - TJclSimpleXMLElemCData = class; - TJclSimpleXMLElemDocType = class; - TJclSimpleXMLElemText = class; - TJclSimpleXMLElemHeader = class; - TJclSimpleXMLElemSheet = class; - TJclSimpleXMLElemMSOApplication = class; - TJclOnSimpleXMLParsed = procedure(Sender: TObject; const Name: string) of object; - TJclOnValueParsed = procedure(Sender: TObject; const Name, Value: string) of object; - TJclOnSimpleProgress = procedure(Sender: TObject; const Position, Total: Integer) of object; - - //Those hash stuffs are for future use only - //Plans are to replace current hash by this mechanism - TJclHashKind = (hkList, hkDirect); - PJclHashElem = ^TJclHashElem; - TJclHashElem = packed record - Next: PJclHashElem; - Obj: TObject; - end; - PJclHashRecord = ^TJclHashRecord; - TJclHashList = array [0..25] of PJclHashRecord; - PJclHashList = ^TJclHashList; - TJclHashRecord = packed record - Count: Byte; - case Kind: TJclHashKind of - hkList: (List: PJclHashList); - hkDirect: (FirstElem: PJclHashElem); - end; - - TJclSimpleXMLProp = class(TJclSimpleXMLData) - private - FParent: TJclSimpleXMLElem; - protected - function GetSimpleXML: TJclSimpleXML; - procedure SetName(const Value: string); override; - public - constructor Create(AParent: TJclSimpleXMLElem; const AName, AValue: string); - procedure SaveToStringStream(StringStream: TJclStringStream); - property Parent: TJclSimpleXMLElem read FParent; - property SimpleXML: TJclSimpleXML read GetSimpleXML; - end; - - {$IFDEF SUPPORTS_FOR_IN} - TJclSimpleXMLPropsEnumerator = class - private - FIndex: Integer; - FList: TJclSimpleXMLProps; - public - constructor Create(AList: TJclSimpleXMLProps); - function GetCurrent: TJclSimpleXMLProp; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - function MoveNext: Boolean; - property Current: TJclSimpleXMLProp read GetCurrent; - end; - {$ENDIF SUPPORTS_FOR_IN} - - TJclSimpleXMLProps = class(TObject) - private - FProperties: TStringList; - FParent: TJclSimpleXMLElem; - function GetCount: Integer; - function GetItemNamedDefault(const Name, Default: string): TJclSimpleXMLProp; - function GetItemNamed(const Name: string): TJclSimpleXMLProp; - protected - function GetSimpleXML: TJclSimpleXML; - function GetItem(const Index: Integer): TJclSimpleXMLProp; - procedure DoItemRename(Value: TJclSimpleXMLProp; const Name: string); - procedure Error(const S: string); - procedure FmtError(const S: string; const Args: array of const); - public - constructor Create(AParent: TJclSimpleXMLElem); - destructor Destroy; override; - procedure SortProperties(const Order: array of string); - function Add(const Name, Value: string): TJclSimpleXMLProp; overload; - {$IFDEF SUPPORTS_UNICODE} - function Add(const Name: string; const Value: AnsiString): TJclSimpleXMLProp; overload; - {$ENDIF SUPPORTS_UNICODE} - function Add(const Name: string; const Value: Int64): TJclSimpleXMLProp; overload; - function Add(const Name: string; const Value: Boolean): TJclSimpleXMLProp; overload; - function Insert(const Index: Integer; const Name, Value: string): TJclSimpleXMLProp; overload; - function Insert(const Index: Integer; const Name: string; const Value: Int64): TJclSimpleXMLProp; overload; - function Insert(const Index: Integer; const Name: string; const Value: Boolean): TJclSimpleXMLProp; overload; - procedure Clear; virtual; - procedure Delete(const Index: Integer); overload; - procedure Delete(const Name: string); overload; - {$IFDEF SUPPORTS_FOR_IN} - function GetEnumerator: TJclSimpleXMLPropsEnumerator; - {$ENDIF SUPPORTS_FOR_IN} - function Value(const Name: string; const Default: string = ''): string; - function IntValue(const Name: string; const Default: Int64 = -1): Int64; - function BoolValue(const Name: string; Default: Boolean = True): Boolean; - function FloatValue(const Name: string; const Default: Extended = 0): Extended; - procedure LoadFromStringStream(StringStream: TJclStringStream); - procedure SaveToStringStream(StringStream: TJclStringStream); - property Item[const Index: Integer]: TJclSimpleXMLProp read GetItem; default; - property ItemNamed[const Name: string]: TJclSimpleXMLProp read GetItemNamed; - property Count: Integer read GetCount; - property Parent: TJclSimpleXMLElem read FParent; - end; - - {$IFDEF SUPPORTS_FOR_IN} - TJclSimpleXMLElemsPrologEnumerator = class - private - FIndex: Integer; - FList: TJclSimpleXMLElemsProlog; - public - constructor Create(AList: TJclSimpleXMLElemsProlog); - function GetCurrent: TJclSimpleXMLElem; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - function MoveNext: Boolean; - property Current: TJclSimpleXMLElem read GetCurrent; - end; - {$ENDIF SUPPORTS_FOR_IN} - - TJclSimpleXMLElemsProlog = class(TObject) - private - FElems: TJclSimpleItemHashedList; - function GetCount: Integer; - function GetItem(const Index: Integer): TJclSimpleXMLElem; - function GetEncoding: string; - function GetStandalone: Boolean; - function GetVersion: string; - procedure SetEncoding(const Value: string); - procedure SetStandalone(const Value: Boolean); - procedure SetVersion(const Value: string); - protected - FSimpleXML: TJclSimpleXML; - function FindHeader: TJclSimpleXMLElem; - procedure Error(const S: string); - procedure FmtError(const S: string; const Args: array of const); - public - constructor Create(ASimpleXML: TJclSimpleXML); - destructor Destroy; override; - function AddComment(const AValue: string): TJclSimpleXMLElemComment; - function AddDocType(const AValue: string): TJclSimpleXMLElemDocType; - procedure Clear; - function AddStyleSheet(const AType, AHRef: string): TJclSimpleXMLElemSheet; - function AddMSOApplication(const AProgId : string): TJclSimpleXMLElemMSOApplication; - procedure LoadFromStringStream(StringStream: TJclStringStream); - procedure SaveToStringStream(StringStream: TJclStringStream); - {$IFDEF SUPPORTS_FOR_IN} - function GetEnumerator: TJclSimpleXMLElemsPrologEnumerator; - {$ENDIF SUPPORTS_FOR_IN} - property Item[const Index: Integer]: TJclSimpleXMLElem read GetItem; default; - property Count: Integer read GetCount; - property Encoding: string read GetEncoding write SetEncoding; - property SimpleXML: TJclSimpleXML read FSimpleXML; - property Standalone: Boolean read GetStandalone write SetStandalone; - property Version: string read GetVersion write SetVersion; - end; - - {$IFDEF SUPPORTS_FOR_IN} - TJclSimpleXMLNamedElemsEnumerator = class - private - FIndex: Integer; - FList: TJclSimpleXMLNamedElems; - public - constructor Create(AList: TJclSimpleXMLNamedElems); - function GetCurrent: TJclSimpleXMLElem; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - function MoveNext: Boolean; - property Current: TJclSimpleXMLElem read GetCurrent; - end; - {$ENDIF SUPPORTS_FOR_IN} - - TJclSimpleXMLNamedElems = class(TJclSimpleItem) - private - FElems: TJclSimpleXMLElems; - function GetCount: Integer; - protected - FItems: TList; - function GetItem(const Index: Integer): TJclSimpleXMLElem; - procedure SetName(const Value: string); override; - public - constructor Create(AElems: TJclSimpleXMLElems; const AName: string); - destructor Destroy; override; - - function Add: TJclSimpleXMLElemClassic; overload; - function Add(const Value: string): TJclSimpleXMLElemClassic; overload; - function Add(const Value: Int64): TJclSimpleXMLElemClassic; overload; - function Add(const Value: Boolean): TJclSimpleXMLElemClassic; overload; - function Add(Value: TStream): TJclSimpleXMLElemClassic; overload; - function AddFirst: TJclSimpleXMLElemClassic; - function AddComment(const Value: string): TJclSimpleXMLElemComment; - function AddCData(const Value: string): TJclSimpleXMLElemCData; - function AddText(const Value: string): TJclSimpleXMLElemText; - procedure Clear; virtual; - procedure Delete(const Index: Integer); - procedure Move(const CurIndex, NewIndex: Integer); - function IndexOf(const Value: TJclSimpleXMLElem): Integer; overload; - function IndexOf(const Value: string): Integer; overload; - {$IFDEF SUPPORTS_FOR_IN} - function GetEnumerator: TJclSimpleXMLNamedElemsEnumerator; - {$ENDIF SUPPORTS_FOR_IN} - - property Elems: TJclSimpleXMLElems read FElems; - property Item[const Index: Integer]: TJclSimpleXMLElem read GetItem; default; - property Count: Integer read GetCount; - end; - - {$IFDEF SUPPORTS_FOR_IN} - TJclSimpleXMLElemsEnumerator = class - private - FIndex: Integer; - FList: TJclSimpleXMLElems; - public - constructor Create(AList: TJclSimpleXMLElems); - function GetCurrent: TJclSimpleXMLElem; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - function MoveNext: Boolean; - property Current: TJclSimpleXMLElem read GetCurrent; - end; - {$ENDIF SUPPORTS_FOR_IN} - - TJclSimpleXMLElemCompare = function(Elems: TJclSimpleXMLElems; Index1, Index2: Integer): Integer of object; - TJclSimpleXMLElems = class(TObject) - private - FParent: TJclSimpleXMLElem; - function GetCount: Integer; - function GetItemNamedDefault(const Name, Default: string): TJclSimpleXMLElem; - function GetItemNamed(const Name: string): TJclSimpleXMLElem; - function GetNamedElems(const Name: string): TJclSimpleXMLNamedElems; - protected - FElems: TJclSimpleItemHashedList; - FCompare: TJclSimpleXMLElemCompare; - FNamedElems: TJclSimpleItemHashedList; - function GetItem(const Index: Integer): TJclSimpleXMLElem; - procedure AddChild(const Value: TJclSimpleXMLElem); - procedure AddChildFirst(const Value: TJclSimpleXMLElem); - procedure InsertChild(const Value: TJclSimpleXMLElem; Index: Integer); - procedure DoItemRename(Value: TJclSimpleXMLElem; const Name: string); - procedure CreateElems; - function SimpleCompare(Elems: TJclSimpleXMLElems; Index1, Index2: Integer): Integer; - public - constructor Create(AParent: TJclSimpleXMLElem); - destructor Destroy; override; - - // Use notify to indicate to a list that the given element is removed - // from the list so that it doesn't delete it as well as the one - // that insert it in itself. This method is automatically called - // by AddChild and AddChildFirst if the Container property of the - // given element is set. - procedure Notify(Value: TJclSimpleXMLElem; Operation: TOperation); - - function Add(const Name: string): TJclSimpleXMLElemClassic; overload; - function Add(const Name, Value: string): TJclSimpleXMLElemClassic; overload; - function Add(const Name: string; const Value: Int64): TJclSimpleXMLElemClassic; overload; - function Add(const Name: string; const Value: Boolean): TJclSimpleXMLElemClassic; overload; - function Add(const Name: string; Value: TStream; BufferSize: Integer = 0): TJclSimpleXMLElemClassic; overload; - function Add(Value: TJclSimpleXMLElem): TJclSimpleXMLElem; overload; - function AddFirst(Value: TJclSimpleXMLElem): TJclSimpleXMLElem; overload; - function AddFirst(const Name: string): TJclSimpleXMLElemClassic; overload; - function AddComment(const Name: string; const Value: string): TJclSimpleXMLElemComment; - function AddCData(const Name: string; const Value: string): TJclSimpleXMLElemCData; - function AddText(const Name: string; const Value: string): TJclSimpleXMLElemText; - function Insert(Value: TJclSimpleXMLElem; Index: Integer): TJclSimpleXMLElem; overload; - function Insert(const Name: string; Index: Integer): TJclSimpleXMLElemClassic; overload; - procedure Clear; virtual; - procedure Delete(const Index: Integer); overload; - procedure Delete(const Name: string); overload; - function Remove(Value: TJclSimpleXMLElem): Integer; - procedure Move(const CurIndex, NewIndex: Integer); - {$IFDEF SUPPORTS_FOR_IN} - function GetEnumerator: TJclSimpleXMLElemsEnumerator; - {$ENDIF SUPPORTS_FOR_IN} - function IndexOf(const Value: TJclSimpleXMLElem): Integer; overload; - function IndexOf(const Name: string): Integer; overload; - function Value(const Name: string; const Default: string = ''): string; - function IntValue(const Name: string; const Default: Int64 = -1): Int64; - function FloatValue(const Name: string; const Default: Extended = 0): Extended; - function BoolValue(const Name: string; Default: Boolean = True): Boolean; - procedure BinaryValue(const Name: string; Stream: TStream); - procedure LoadFromStringStream(StringStream: TJclStringStream); - procedure SaveToStringStream(StringStream: TJclStringStream; const Level: string = ''); - procedure Sort; - procedure CustomSort(AFunction: TJclSimpleXMLElemCompare); - property Parent: TJclSimpleXMLElem read FParent; - property Item[const Index: Integer]: TJclSimpleXMLElem read GetItem; default; - property ItemNamed[const Name: string]: TJclSimpleXMLElem read GetItemNamed; - property Count: Integer read GetCount; - property NamedElems[const Name: string]: TJclSimpleXMLNamedElems read GetNamedElems; - end; - - {$TYPEINFO ON} - TJclSimpleXMLElem = class(TJclSimpleXMLData) - private - FParent: TJclSimpleXMLElem; - FSimpleXML: TJclSimpleXML; - function GetHasItems: Boolean; - function GetHasProperties: Boolean; - function GetItemCount: Integer; - function GetPropertyCount: Integer; - protected - FItems: TJclSimpleXMLElems; - FProps: TJclSimpleXMLProps; - function GetChildsCount: Integer; - function GetProps: TJclSimpleXMLProps; - procedure SetName(const Value: string); override; - function GetItems: TJclSimpleXMLElems; - procedure Error(const S: string); - procedure FmtError(const S: string; const Args: array of const); - public - //constructor Create; overload; - //constructor Create(const AName: string); overload; - //constructor Create(const AName, AValue: string); overload; - constructor Create(ASimpleXML: TJclSimpleXML); overload; - destructor Destroy; override; - procedure Assign(Value: TJclSimpleXMLElem); virtual; - procedure Clear; virtual; - procedure LoadFromStringStream(StringStream: TJclStringStream); virtual; abstract; - procedure SaveToStringStream(StringStream: TJclStringStream; const Level: string = ''); virtual; - abstract; - procedure LoadFromString(const Value: string); - function SaveToString: string; - procedure GetBinaryValue(Stream: TStream; BufferSize: Integer = 0); - function GetChildIndex(const AChild: TJclSimpleXMLElem): Integer; - function GetNamedIndex(const AChild: TJclSimpleXMLElem): Integer; - - property SimpleXML: TJclSimpleXML read FSimpleXML; - published - property Parent: TJclSimpleXMLElem read FParent; - property ChildsCount: Integer read GetChildsCount; - property HasItems: Boolean read GetHasItems; - property HasProperties: Boolean read GetHasProperties; - property ItemCount: Integer read GetItemCount; - property PropertyCount: Integer read GetPropertyCount; - property Items: TJclSimpleXMLElems read GetItems; - property Properties: TJclSimpleXMLProps read GetProps; - end; - {$IFNDEF TYPEINFO_ON} - {$TYPEINFO OFF} - {$ENDIF ~TYPEINFO_ON} - TJclSimpleXMLElemClass = class of TJclSimpleXMLElem; - - TJclSimpleXMLElemComment = class(TJclSimpleXMLElem) - public - procedure LoadFromStringStream(StringStream: TJclStringStream); override; - procedure SaveToStringStream(StringStream: TJclStringStream; const Level: string = ''); override; - end; - - TJclSimpleXMLElemClassic = class(TJclSimpleXMLElem) - public - procedure LoadFromStringStream(StringStream: TJclStringStream); override; - procedure SaveToStringStream(StringStream: TJclStringStream; const Level: string = ''); override; - end; - - TJclSimpleXMLElemCData = class(TJclSimpleXMLElem) - public - procedure LoadFromStringStream(StringStream: TJclStringStream); override; - procedure SaveToStringStream(StringStream: TJclStringStream; const Level: string = ''); override; - end; - - TJclSimpleXMLElemText = class(TJclSimpleXMLElem) - public - procedure LoadFromStringStream(StringStream: TJclStringStream); override; - procedure SaveToStringStream(StringStream: TJclStringStream; const Level: string = ''); override; - end; - - TJclSimpleXMLElemProcessingInstruction = class(TJclSimpleXMLElem) - public - procedure LoadFromStringStream(StringStream: TJclStringStream); override; - procedure SaveToStringStream(StringStream: TJclStringStream; const Level: string = ''); override; - end; - - TJclSimpleXMLElemHeader = class(TJclSimpleXMLElemProcessingInstruction) - private - function GetEncoding: string; - function GetStandalone: Boolean; - function GetVersion: string; - procedure SetEncoding(const Value: string); - procedure SetStandalone(const Value: Boolean); - procedure SetVersion(const Value: string); - public - constructor Create; override; - - procedure LoadFromStringStream(StringStream: TJclStringStream); override; - procedure SaveToStringStream(StringStream: TJclStringStream; const Level: string = ''); override; - property Version: string read GetVersion write SetVersion; - property Standalone: Boolean read GetStandalone write SetStandalone; - property Encoding: string read GetEncoding write SetEncoding; - end; - - // for backward compatibility - TJclSimpleXMLElemSheet = class(TJclSimpleXMLElemProcessingInstruction) - end; - - // for backward compatibility - TJclSimpleXMLElemMSOApplication = class(TJclSimpleXMLElemProcessingInstruction) - end; - - TJclSimpleXMLElemDocType = class(TJclSimpleXMLElem) - public - procedure LoadFromStringStream(StringStream: TJclStringStream); override; - procedure SaveToStringStream(StringStream: TJclStringStream; const Level: string = ''); override; - end; - - TJclSimpleXMLOptions = set of (sxoAutoCreate, sxoAutoIndent, sxoAutoEncodeValue, - sxoAutoEncodeEntity, sxoDoNotSaveProlog, sxoTrimPrecedingTextWhitespace, - sxoTrimFollowingTextWhitespace, sxoKeepWhitespace, sxoDoNotSaveBOM, sxoCaseSensitive); - TJclSimpleXMLEncodeEvent = procedure(Sender: TObject; var Value: string) of object; - TJclSimpleXMLEncodeStreamEvent = procedure(Sender: TObject; InStream, OutStream: TStream) of object; - - TJclSimpleXML = class(TObject) - protected - FEncoding: TJclStringEncoding; - FCodePage: Word; - FFileName: TFileName; - FOptions: TJclSimpleXMLOptions; - FRoot: TJclSimpleXMLElemClassic; - FOnTagParsed: TJclOnSimpleXMLParsed; - FOnValue: TJclOnValueParsed; - FOnLoadProg: TJclOnSimpleProgress; - FOnSaveProg: TJclOnSimpleProgress; - FProlog: TJclSimpleXMLElemsProlog; - FSaveCount: Integer; - FSaveCurrent: Integer; - FIndentString: string; - FBaseIndentString: string; - FOnEncodeValue: TJclSimpleXMLEncodeEvent; - FOnDecodeValue: TJclSimpleXMLEncodeEvent; - FOnDecodeStream: TJclSimpleXMLEncodeStreamEvent; - FOnEncodeStream: TJclSimpleXMLEncodeStreamEvent; - procedure SetIndentString(const Value: string); - procedure SetBaseIndentString(const Value: string); - procedure SetRoot(const Value: TJclSimpleXMLElemClassic); - procedure SetFileName(const Value: TFileName); - protected - procedure DoLoadProgress(const APosition, ATotal: Integer); - procedure DoSaveProgress; - procedure DoTagParsed(const AName: string); - procedure DoValueParsed(const AName, AValue: string); - procedure DoEncodeValue(var Value: string); virtual; - procedure DoDecodeValue(var Value: string); virtual; - procedure GetEncodingFromXMLHeader(var Encoding: TJclStringEncoding; var CodePage: Word); - public - constructor Create; - destructor Destroy; override; - procedure LoadFromString(const Value: string); - procedure LoadFromFile(const FileName: TFileName; Encoding: TJclStringEncoding = seAuto; CodePage: Word = CP_ACP); - procedure LoadFromStream(Stream: TStream; Encoding: TJclStringEncoding = seAuto; CodePage: Word = CP_ACP); - procedure LoadFromStringStream(StringStream: TJclStringStream); - procedure LoadFromResourceName(Instance: THandle; const ResName: string; Encoding: TJclStringEncoding = seAuto; CodePage: Word = CP_ACP); - procedure SaveToFile(const FileName: TFileName; Encoding: TJclStringEncoding = seAuto; CodePage: Word = CP_ACP); - procedure SaveToStream(Stream: TStream; Encoding: TJclStringEncoding = seAuto; CodePage: Word = CP_ACP); - procedure SaveToStringStream(StringStream: TJclStringStream); - function SaveToString: string; - function SaveToStringEncoding(Encoding: TJclStringEncoding; CodePage: Word = CP_ACP): string; - property CodePage: Word read FCodePage; - property Prolog: TJclSimpleXMLElemsProlog read FProlog write FProlog; - property Root: TJclSimpleXMLElemClassic read FRoot write SetRoot; - property XMLData: string read SaveToString write LoadFromString; - property FileName: TFileName read FFileName write SetFileName; - property IndentString: string read FIndentString write SetIndentString; - property BaseIndentString: string read FBaseIndentString write SetBaseIndentString; - property Options: TJclSimpleXMLOptions read FOptions write FOptions; - property OnSaveProgress: TJclOnSimpleProgress read FOnSaveProg write FOnSaveProg; - property OnLoadProgress: TJclOnSimpleProgress read FOnLoadProg write FOnLoadProg; - property OnTagParsed: TJclOnSimpleXMLParsed read FOnTagParsed write FOnTagParsed; - property OnValueParsed: TJclOnValueParsed read FOnValue write FOnValue; - property OnEncodeValue: TJclSimpleXMLEncodeEvent read FOnEncodeValue write FOnEncodeValue; - property OnDecodeValue: TJclSimpleXMLEncodeEvent read FOnDecodeValue write FOnDecodeValue; - property OnEncodeStream: TJclSimpleXMLEncodeStreamEvent read FOnEncodeStream write FOnEncodeStream; - property OnDecodeStream: TJclSimpleXMLEncodeStreamEvent read FOnDecodeStream write FOnDecodeStream; - end; - - TXMLVariant = class(TInvokeableVariantType) - public - procedure Clear(var V: TVarData); override; - function IsClear(const V: TVarData): Boolean; override; - procedure Copy(var Dest: TVarData; const Source: TVarData; - const Indirect: Boolean); override; - procedure CastTo(var Dest: TVarData; const Source: TVarData; - const AVarType: TVarType); override; - - function DoFunction(var Dest: TVarData; const V: TVarData; - const Name: string; const Arguments: TVarDataArray): Boolean; override; - function GetProperty(var Dest: TVarData; const V: TVarData; - const Name: string): Boolean; override; - function SetProperty(const V: TVarData; const Name: string; - const Value: TVarData): Boolean; override; - end; - -procedure XMLCreateInto(var ADest: Variant; const AXML: TJclSimpleXMLElem); -function XMLCreate(const AXML: TJclSimpleXMLElem): Variant; overload; -function XMLCreate: Variant; overload; -function VarXML: TVarType; - -// Encodes a string into an internal format: -// any character TAB,LF,CR,#32..#127 is preserved -// all other characters are converted to hex notation except -// for some special characters that are converted to XML entities -function SimpleXMLEncode(const S: string): string; -// Decodes a string encoded with SimpleXMLEncode: -// any character TAB,LF,CR,#32..#127 is preserved -// all other characters and substrings are converted from -// the special XML entities to characters or from hex to characters -// NB! Setting TrimBlanks to true will slow down the process considerably -procedure SimpleXMLDecode(var S: string; TrimBlanks: Boolean); - -function XMLEncode(const S: string): string; -function XMLDecode(const S: string): string; - -// Encodes special characters (', ", <, > and &) into XML entities (@apos;, ", <, > and &) -function EntityEncode(const S: string): string; -// Decodes XML entities (@apos;, ", <, > and &) into special characters (', ", <, > and &) -function EntityDecode(const S: string): string; - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\common'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -uses - {$IFDEF HAS_UNITSCOPE} - System.Types, - {$ENDIF HAS_UNITSCOPE} - JclCharsets, - JclStrings, - JclUnicode, - JclStringConversions, - JclResources; - -const - cBufferSize = 8192; - -var - GlobalXMLVariant: TXMLVariant = nil; - - PreparedNibbleCharMapping: Boolean = False; - NibbleCharMapping: array [Low(Char)..High(Char)] of Byte; - -function XMLVariant: TXMLVariant; -begin - if not Assigned(GlobalXMLVariant) then - GlobalXMLVariant := TXMLVariant.Create; - Result := GlobalXMLVariant; -end; - -procedure AddEntity(var Res: string; var ResIndex, ResLen: Integer; const Entity: string); -var - EntityIndex, EntityLen: Integer; -begin - EntityLen := Length(Entity); - if (ResIndex + EntityLen) > ResLen then - begin - if ResLen <= EntityLen then - ResLen := ResLen * EntityLen - else - ResLen := ResLen * 2; - SetLength(Res, ResLen); - end; - for EntityIndex := 1 to EntityLen do - begin - Res[ResIndex] := Entity[EntityIndex]; - Inc(ResIndex); - end; -end; - -function EntityEncode(const S: string): string; -var - C: Char; - SIndex, SLen, RIndex, RLen: Integer; - Tmp: string; -begin - SLen := Length(S); - RLen := SLen; - RIndex := 1; - SetLength(Tmp, RLen); - for SIndex := 1 to SLen do - begin - C := S[SIndex]; - case C of - '"': - AddEntity(Tmp, RIndex, RLen, '"'); - '&': - AddEntity(Tmp, RIndex, RLen, '&'); - #39: - AddEntity(Tmp, RIndex, RLen, '''); - '<': - AddEntity(Tmp, RIndex, RLen, '<'); - '>': - AddEntity(Tmp, RIndex, RLen, '>'); - else - if RIndex > RLen then - begin - RLen := RLen * 2; - SetLength(Tmp, RLen); - end; - Tmp[RIndex] := C; - Inc(RIndex); - end; - end; - if RIndex > 1 then - SetLength(Tmp, RIndex - 1); - - Result := Tmp; -end; - -function EntityDecode(const S: string): string; -var - I, J, L: Integer; -begin - Result := S; - I := 1; - J := 1; - L := Length(Result); - - while I <= L do - begin - if Result[I] = '&' then - begin - if StrSame(Copy(Result, I, 5), '&') then - begin - Result[J] := '&'; - Inc(J); - Inc(I, 4); - end - else - if StrSame(Copy(Result, I, 4), '<') then - begin - Result[J] := '<'; - Inc(J); - Inc(I, 3); - end - else - if StrSame(Copy(Result, I, 4), '>') then - begin - Result[J] := '>'; - Inc(J); - Inc(I, 3); - end - else - if StrSame(Copy(Result, I, 6), ''') then - begin - Result[J] := #39; - Inc(J); - Inc(I, 5); - end - else - if StrSame(Copy(Result, I, 6), '"') then - begin - Result[J] := '"'; - Inc(J); - Inc(I, 5); - end - else - begin - Result[J] := Result[I]; - Inc(J); - end; - end - else - begin - Result[J] := Result[I]; - Inc(J); - end; - Inc(I); - end; - if J > 1 then - SetLength(Result, J - 1) - else - SetLength(Result, 0); -end; - -function SimpleXMLEncode(const S: string): string; -var - C: Char; - SIndex, SLen, RIndex, RLen: Integer; - Tmp: string; -begin - SLen := Length(S); - RLen := SLen; - RIndex := 1; - SetLength(Tmp, RLen); - for SIndex := 1 to SLen do - begin - C := S[SIndex]; - case C of - '"': - AddEntity(Tmp, RIndex, RLen, '"'); - '&': - AddEntity(Tmp, RIndex, RLen, '&'); - #39: - AddEntity(Tmp, RIndex, RLen, '''); - '<': - AddEntity(Tmp, RIndex, RLen, '<'); - '>': - AddEntity(Tmp, RIndex, RLen, '>'); - NativeNull..NativeBackspace, // NativeTab, NativeLineFeed - NativeVerticalTab..NativeFormFeed, // NativeCarriageReturn - NativeSo..NativeUs, - Char(128)..Char(255): - AddEntity(Tmp, RIndex, RLen, Format('&#x%.2x;', [Ord(C)])); - {$IFDEF SUPPORTS_UNICODE} - Char(256)..High(Char): - AddEntity(Tmp, RIndex, RLen, Format('&#x%.4x;', [Ord(C)])); - {$ENDIF SUPPORTS_UNICODE} - else - if RIndex > RLen then - begin - RLen := RLen * 2; - SetLength(Tmp, RLen); - end; - Tmp[RIndex] := C; - Inc(RIndex); - end; - end; - if RIndex > 1 then - SetLength(Tmp, RIndex - 1); - - Result := Tmp; -end; - -procedure SimpleXMLDecode(var S: string; TrimBlanks: Boolean); - procedure DecodeEntity(var S: string; StringLength: Cardinal; - var ReadIndex, WriteIndex: Cardinal); - const - cHexPrefix: array [Boolean] of string = ('', '$'); - var - I: Cardinal; - Value: Integer; - IsHex: Boolean; - begin - Inc(ReadIndex, 2); - IsHex := (ReadIndex <= StringLength) and ((S[ReadIndex] = 'x') or (S[ReadIndex] = 'X')); - Inc(ReadIndex, Ord(IsHex)); - I := ReadIndex; - while ReadIndex <= StringLength do - begin - if S[ReadIndex] = ';' then - begin - Value := StrToIntDef(cHexPrefix[IsHex] + Copy(S, I, ReadIndex - I), -1); // no characters are less than 0 - if Value >= 0 then - S[WriteIndex] := Chr(Value) - else - ReadIndex := I - (2 + Cardinal(IsHex)); // reset to start - Exit; - end; - Inc(ReadIndex); - end; - ReadIndex := I - (2 + Cardinal(IsHex)); // reset to start - end; - - procedure SkipBlanks(var S: string; StringLength: Cardinal; var ReadIndex: Cardinal); - begin - while ReadIndex < StringLength do - begin - if S[ReadIndex] = NativeCarriageReturn then - S[ReadIndex] := NativeLineFeed - else - if S[ReadIndex + 1] = NativeCarriageReturn then - S[ReadIndex + 1] := NativeLineFeed; - if (S[ReadIndex] < #33) and (S[ReadIndex] = S[ReadIndex + 1]) then - Inc(ReadIndex) - else - Exit; - end; - end; - -var - StringLength, ReadIndex, WriteIndex: Cardinal; -begin - // NB! This procedure replaces the text inplace to speed up the conversion. This - // works because when decoding, the string can only become shorter. This is - // accomplished by keeping track of the current read and write points. - // In addition, the original string length is read only once and passed to the - // inner procedures to speed up conversion as much as possible - ReadIndex := 1; - WriteIndex := 1; - StringLength := Length(S); - while ReadIndex <= StringLength do - begin - // this call lowers conversion speed by ~30%, ie 21MB/sec -> 15MB/sec (repeated tests, various inputs) - if TrimBlanks then - SkipBlanks(S, StringLength, ReadIndex); - if S[ReadIndex] = '&' then - begin - if (ReadIndex < StringLength) and (S[ReadIndex + 1] = '#') then - begin - DecodeEntity(S, StringLength, ReadIndex, WriteIndex); - Inc(WriteIndex); - end - else - if StrSame(Copy(S, ReadIndex, 5), '&') then - begin - S[WriteIndex] := '&'; - Inc(WriteIndex); - Inc(ReadIndex, 4); - end - else - if StrSame(Copy(S, ReadIndex, 4), '<') then - begin - S[WriteIndex] := '<'; - Inc(WriteIndex); - Inc(ReadIndex, 3); - end - else - if StrSame(Copy(S, ReadIndex, 4), '>') then - begin - S[WriteIndex] := '>'; - Inc(WriteIndex); - Inc(ReadIndex, 3); - end - else - if StrSame(Copy(S, ReadIndex, 6), ''') then - begin - S[WriteIndex] := #39; - Inc(WriteIndex); - Inc(ReadIndex, 5); - end - else - if StrSame(Copy(S, ReadIndex, 6), '"') then - begin - S[WriteIndex] := '"'; - Inc(WriteIndex); - Inc(ReadIndex, 5); - end - else - begin - S[WriteIndex] := S[ReadIndex]; - Inc(WriteIndex); - end; - end - else - begin - S[WriteIndex] := S[ReadIndex]; - Inc(WriteIndex); - end; - Inc(ReadIndex); - end; - if WriteIndex > 0 then - SetLength(S, WriteIndex - 1) - else - SetLength(S, 0); - // this call lowers conversion speed by ~65%, ie 21MB/sec -> 7MB/sec (repeated tests, various inputs) -// if TrimBlanks then -// S := AdjustLineBreaks(S); -end; - -function XMLEncode(const S: string): string; -begin - Result := SimpleXMLEncode(S); -end; - -function XMLDecode(const S: string): string; -begin - Result := S; - SimpleXMLDecode(Result, False); -end; - -//=== { TJclSimpleItem } ===================================================== - -procedure TJclSimpleItem.SetName(const Value: string); -begin - FName := Value; -end; - -//=== { TJclSimpleItemHashedList } =========================================== - -procedure TJclSimpleItemHashedList.Clear; -begin - InvalidateHash; - inherited Clear; -end; - -constructor TJclSimpleItemHashedList.Create(ACaseSensitive: Boolean); -begin - inherited Create(True); - FCaseSensitive := ACaseSensitive; -end; - -destructor TJclSimpleItemHashedList.Destroy; -begin - FreeAndNil(FNameHash); - inherited Destroy; -end; - -function TJclSimpleItemHashedList.Add(Item: TJclSimpleItem): Integer; -begin - Result := inherited Add(Item); - if FNameHash <> nil then - begin - if FCaseSensitive then - FNameHash.Add(Item.Name, Result) - else - FNameHash.Add(UpperCase(Item.Name), Result); - end; -end; - -function TJclSimpleItemHashedList.Extract(Item: TJclSimpleItem): TJclSimpleItem; -begin - Result := TJclSimpleItem(inherited Extract(Item)); - InvalidateHash; -end; - -function TJclSimpleItemHashedList.GetSimpleItem(Index: Integer): TJclSimpleItem; -begin - Result := TJclSimpleItem(GetItem(Index)); -end; - -function TJclSimpleItemHashedList.GetSimpleItemByName(const Name: string): TJclSimpleItem; -var - I: Integer; -begin - I := IndexOfName(Name); - if I >= 0 then - Result := TJclSimpleItem(Items[I]) - else - Result := nil; -end; - -function TJclSimpleItemHashedList.IndexOfSimpleItem(Item: TJclSimpleItem): Integer; -begin - Result := IndexOf(Item); -end; - -function TJclSimpleItemHashedList.IndexOfName(const Name: string): Integer; -var - I: Integer; -begin - if FCaseSensitive then - begin - if FNameHash = nil then - begin - FNameHash := TStringHash.Create(8); - for I := 0 to Count - 1 do - FNameHash.Add(TJclSimpleData(Items[I]).Name, I); - end; - Result := FNameHash.ValueOf(Name); - end - else - begin - if FNameHash = nil then - begin - FNameHash := TStringHash.Create(8); - for I := 0 to Count - 1 do - FNameHash.Add(UpperCase(TJclSimpleData(Items[I]).Name), I); - end; - Result := FNameHash.ValueOf(UpperCase(Name)); - end; -end; - -procedure TJclSimpleItemHashedList.Insert(Index: Integer; Item: TJclSimpleItem); -begin - InvalidateHash; - inherited Insert(Index, Item); -end; - -procedure TJclSimpleItemHashedList.InvalidateHash; -begin - FreeAndNil(FNameHash); -end; - -procedure TJclSimpleItemHashedList.Move(CurIndex, NewIndex: Integer); -begin - InvalidateHash; - inherited Move(CurIndex, NewIndex); -end; - -procedure TJclSimpleItemHashedList.Notify(Ptr: Pointer; Action: TListNotification); -begin - if (Action = lnDeleted) and (FNameHash <> nil) then - begin -// Mantis 0006062 Hotfix -// if FCaseSensitive then -// FNameHash.Remove(TJclSimpleItem(Ptr).Name) -// else -// FNameHash.Remove(UpperCase(TJclSimpleItem(Ptr).Name)); - InvalidateHash; - end; - inherited Notify(Ptr, Action); -end; - -procedure TJclSimpleItemHashedList.SetCaseSensitive(const Value: Boolean); -begin - if FCaseSensitive <> Value then - begin - InvalidateHash; - FCaseSensitive := Value; - end; -end; - -//=== { TJclSimpleData } ===================================================== - -constructor TJclSimpleData.Create; -begin - inherited Create; -end; - -constructor TJclSimpleData.Create(const AName: string); -begin - inherited Create; - FName := AName; -end; - -constructor TJclSimpleData.Create(const AName, AValue: string); -begin - inherited Create; - FName := AName; - FValue := AValue; -end; - -function TJclSimpleData.GetAnsiValue: AnsiString; -begin - Result := AnsiString(Value); -end; - -function TJclSimpleData.GetBoolValue: Boolean; -begin - Result := StrToBoolDef(Value, False); -end; - -function TJclSimpleData.GetFloatValue: Extended; -begin - Result := 0.0; - if not TryStrToFloat(Value, Result) then - Result := 0.0; -end; - -function TJclSimpleData.GetIntValue: Int64; -begin - Result := StrToInt64Def(Value, -1); -end; - -procedure TJclSimpleData.SetAnsiValue(const Value: AnsiString); -begin - Self.Value := string(Value); -end; - -procedure TJclSimpleData.SetBoolValue(const Value: Boolean); -begin - FValue := BoolToStr(Value); -end; - -procedure TJclSimpleData.SetFloatValue(const Value: Extended); -begin - FValue := FloatToStr(Value); -end; - -procedure TJclSimpleData.SetIntValue(const Value: Int64); -begin - FValue := IntToStr(Value); -end; - -//=== { TJclSimpleXMLData } ================================================== - -function TJclSimpleXMLData.FullName: string; -begin - if NameSpace <> '' then - Result := NameSpace + ':' + Name - else - Result := Name; -end; - -//=== { TJclSimpleXML } ====================================================== - -constructor TJclSimpleXML.Create; -begin - inherited Create; - FRoot := TJclSimpleXMLElemClassic.Create(Self); - FProlog := TJclSimpleXMLElemsProlog.Create(Self); - FOptions := [sxoAutoIndent, sxoAutoEncodeValue, sxoAutoEncodeEntity]; - FIndentString := ' '; -end; - -destructor TJclSimpleXML.Destroy; -begin - FreeAndNil(FRoot); - FreeAndNil(FProlog); - inherited Destroy; -end; - -procedure TJclSimpleXML.DoDecodeValue(var Value: string); -begin - if sxoAutoEncodeValue in Options then - SimpleXMLDecode(Value, False) - else - if sxoAutoEncodeEntity in Options then - Value := EntityDecode(Value); - if Assigned(FOnDecodeValue) then - FOnDecodeValue(Self, Value); -end; - -procedure TJclSimpleXML.DoEncodeValue(var Value: string); -begin - if Assigned(FOnEncodeValue) then - FOnEncodeValue(Self, Value); - if sxoAutoEncodeValue in Options then - Value := SimpleXMLEncode(Value) - else - if sxoAutoEncodeEntity in Options then - Value := EntityEncode(Value); -end; - -procedure TJclSimpleXML.DoLoadProgress(const APosition, ATotal: Integer); -begin - if Assigned(FOnLoadProg) then - FOnLoadProg(Self, APosition, ATotal); -end; - -procedure TJclSimpleXML.DoSaveProgress; -begin - if Assigned(FOnSaveProg) then - begin - Inc(FSaveCurrent); - FOnSaveProg(Self, FSaveCurrent, FSaveCount); - end; -end; - -procedure TJclSimpleXML.DoTagParsed(const AName: string); -begin - if Assigned(FOnTagParsed) then - FOnTagParsed(Self, AName); -end; - -procedure TJclSimpleXML.DoValueParsed(const AName, AValue: string); -begin - if Assigned(FOnValue) then - FOnValue(Self, AName, AValue); -end; - -procedure TJclSimpleXML.LoadFromFile(const FileName: TFileName; Encoding: TJclStringEncoding; CodePage: Word); -var - Stream: TMemoryStream; -begin - Stream := TMemoryStream.Create; - try - Stream.LoadFromFile(FileName); - LoadFromStream(Stream, Encoding, CodePage); - finally - Stream.Free; - end; -end; - -procedure TJclSimpleXML.LoadFromResourceName(Instance: THandle; const ResName: string; - Encoding: TJclStringEncoding; CodePage: Word); -{$IFNDEF MSWINDOWS} -const - RT_RCDATA = PChar(10); -{$ENDIF !MSWINDOWS} -var - Stream: TResourceStream; -begin - Stream := TResourceStream.Create(Instance, ResName, RT_RCDATA); - try - LoadFromStream(Stream, Encoding, CodePage); - finally - Stream.Free; - end; -end; - -procedure TJclSimpleXML.LoadFromStream(Stream: TStream; Encoding: TJclStringEncoding; CodePage: Word); -var - AOutStream: TStream; - AStringStream: TJclStringStream; - DoFree: Boolean; -begin - FRoot.Clear; - FProlog.Clear; - AOutStream := nil; - DoFree := False; - try - if Assigned(FOnDecodeStream) then - begin - AOutStream := TMemoryStream.Create; - DoFree := True; - FOnDecodeStream(Self, Stream, AOutStream); - AOutStream.Seek(0, soBeginning); - end - else - AOutStream := Stream; - - case Encoding of - seAnsi: - begin - AStringStream := TJclAnsiStream.Create(AOutStream, False); - TJclAnsiStream(AStringStream).CodePage := CodePage; - end; - seUTF8: - AStringStream := TJclUTF8Stream.Create(AOutStream, False); - seUTF16: - AStringStream := TJclUTF16Stream.Create(AOutStream, False); - else - AStringStream := TJclAutoStream.Create(AOutStream, False); - if CodePage <> CP_ACP then - TJclAutoStream(AStringStream).CodePage := CodePage; - end; - try - AStringStream.SkipBOM; - - LoadFromStringStream(AStringStream); - - // save codepage and encoding for future saves - if AStringStream is TJclAutoStream then - begin - FCodePage := TJclAutoStream(AStringStream).CodePage; - FEncoding := TJclAutoStream(AStringStream).Encoding; - end - else - if AStringStream is TJclAnsiStream then - begin - FCodePage := TJclAnsiStream(AStringStream).CodePage; - FEncoding := Encoding; - end - else - begin - FCodePage := CodePage; - FEncoding := Encoding; - end; - finally - AStringStream.Free; - end; - finally - if DoFree then - AOutStream.Free; - end; -end; - -procedure TJclSimpleXML.LoadFromStringStream(StringStream: TJclStringStream); -var - BufferSize: Integer; -begin - if Assigned(FOnLoadProg) then - FOnLoadProg(Self, StringStream.Stream.Position, StringStream.Stream.Size); - - BufferSize := StringStream.BufferSize; - StringStream.BufferSize := 1; - - // Read doctype and so on - FProlog.LoadFromStringStream(StringStream); - - StringStream.BufferSize := BufferSize; - - // Read elements - FRoot.LoadFromStringStream(StringStream); - - if Assigned(FOnLoadProg) then - FOnLoadProg(Self, StringStream.Stream.Position, StringStream.Stream.Size); -end; - -procedure TJclSimpleXML.LoadFromString(const Value: string); -var - Stream: TStringStream; -begin - Stream := TStringStream.Create(Value {$IFDEF SUPPORTS_UNICODE}, TEncoding.Unicode{$ENDIF}); - try - LoadFromStream(Stream {$IFDEF SUPPORTS_UNICODE}, seUTF16, CP_UTF16LE{$ENDIF}); - finally - Stream.Free; - end; -end; - -procedure TJclSimpleXML.GetEncodingFromXMLHeader(var Encoding: TJclStringEncoding; var CodePage: Word); -var - XMLHeader: TJclSimpleXMLElemHeader; - I: Integer; -begin - XMLHeader := nil; - for I := 0 to Prolog.Count - 1 do - if Prolog.Item[I] is TJclSimpleXMLElemHeader then - begin - XMLHeader := TJclSimpleXMLElemHeader(Prolog.Item[I]); - Break; - end; - if Assigned(XMLHeader) then - begin - CodePage := CodePageFromCharsetName(XMLHeader.Encoding); - case CodePage of - CP_UTF8: - Encoding := seUTF8; - CP_UTF16LE: - Encoding := seUTF16; - else - Encoding := seAnsi; - end; - end - else - begin - // restore from previous load - Encoding := FEncoding; - CodePage := FCodePage; - end; -end; - -procedure TJclSimpleXML.SaveToFile(const FileName: TFileName; Encoding: TJclStringEncoding; CodePage: Word); -var - Stream: TMemoryStream; -begin - Stream := TMemoryStream.Create; - try - SaveToStream(Stream, Encoding, CodePage); - Stream.SaveToFile(FileName); - finally - Stream.Free; - end; -end; - -procedure TJclSimpleXML.SaveToStream(Stream: TStream; Encoding: TJclStringEncoding; CodePage: Word); -var - AOutStream: TStream; - AStringStream: TJclStringStream; - DoFree: Boolean; -begin - if Assigned(FOnEncodeStream) then - begin - AOutStream := TMemoryStream.Create; - DoFree := True; - end - else - begin - AOutStream := Stream; - DoFree := False; - end; - try - if Encoding = seAuto then - GetEncodingFromXMLHeader(Encoding, CodePage); - - case Encoding of - seUTF8: - begin - AStringStream := TJclUTF8Stream.Create(AOutStream, False); - FCodePage := CP_UTF8; - end; - seUTF16: - begin - AStringStream := TJclUTF16Stream.Create(AOutStream, False); - FCodePage := CP_UTF16LE; - end - else - AStringStream := TJclAnsiStream.Create(AOutStream); - TJclAnsiStream(AStringStream).CodePage := CodePage; - end; - try - if not (sxoDoNotSaveBOM in Options) then - AStringStream.WriteBOM; - SaveToStringStream(AStringStream); - AStringStream.Flush; - finally - AStringStream.Free; - end; - if Assigned(FOnEncodeStream) then - begin - AOutStream.Seek(0, soBeginning); - FOnEncodeStream(Self, AOutStream, Stream); - end; - finally - if DoFree then - AOutStream.Free; - end; -end; - -procedure TJclSimpleXML.SaveToStringStream(StringStream: TJclStringStream); -var - lCount: Integer; -begin - lCount := Root.ChildsCount + Prolog.Count; - FSaveCount := lCount; - FSaveCurrent := 0; - - if Assigned(FOnSaveProg) then - FOnSaveProg(Self, 0, lCount); - - if not (sxoDoNotSaveProlog in FOptions) then - Prolog.SaveToStringStream(StringStream); - - Root.SaveToStringStream(StringStream, BaseIndentString); - - if Assigned(FOnSaveProg) then - FOnSaveProg(Self, lCount, lCount); -end; - -function TJclSimpleXML.SaveToString: string; -begin - Result := SaveToStringEncoding(seAuto, CP_ACP); -end; - -function TJclSimpleXML.SaveToStringEncoding(Encoding: TJclStringEncoding; CodePage: Word): string; -var - Stream: TStringStream; -begin - {$IFDEF SUPPORTS_UNICODE} - // Use the same logic for seAuto as in SaveToStream for creating the TStringStream. - // Otherwise a Unicode-TStringStream is written to from a TJclAnsiStream proxy. - if Encoding = seAuto then - GetEncodingFromXMLHeader(Encoding, CodePage); - - case Encoding of - seAnsi: - Stream := TStringStream.Create('', TEncoding.{$IFDEF COMPILER16_UP}ANSI{$ELSE}Default{$ENDIF}); - seUTF8: - Stream := TStringStream.Create('', TEncoding.UTF8); - else - //seUTF16: - Stream := TStringStream.Create('', TEncoding.Unicode); - end; - {$ELSE ~SUPPORTS_UNICODE} - Stream := TStringStream.Create(''); - {$ENDIF ~SUPPORTS_UNICODE} - try - SaveToStream(Stream, Encoding, CodePage); - Result := Stream.DataString; - finally - Stream.Free; - end; -end; - -procedure TJclSimpleXML.SetBaseIndentString(const Value: string); -begin - // test if the new value is only made of spaces or tabs - if not StrContainsChars(Value, CharIsWhiteSpace, True) then - Exit; - - FBaseIndentString := Value; -end; - -procedure TJclSimpleXML.SetFileName(const Value: TFileName); -begin - FFileName := Value; - LoadFromFile(Value); -end; - -//=== { TJclSimpleXMLElem } ================================================== - -procedure TJclSimpleXMLElem.Assign(Value: TJclSimpleXMLElem); -var - Elems: TJclSimpleXMLElem; - SrcElem, DestElem: TJclSimpleXMLElem; - I: Integer; - SrcProps, DestProps: TJclSimpleXMLProps; - SrcProp: TJclSimpleXMLProp; - SrcElems, DestElems: TJclSimpleXMLElems; -begin - Clear; - if Value = nil then - Exit; - Elems := TJclSimpleXMLElem(Value); - Name := Elems.Name; - Self.Value := Elems.Value; - SrcProps := Elems.FProps; - if Assigned(SrcProps) then - begin - DestProps := Properties; - for I := 0 to SrcProps.Count - 1 do - begin - SrcProp := SrcProps.Item[I]; - DestProps.Add(SrcProp.Name, SrcProp.Value); - end; - end; - - SrcElems := Elems.FItems; - if Assigned(SrcElems) then - begin - DestElems := Items; - for I := 0 to SrcElems.Count - 1 do - begin - // Create from the class type, so that the virtual constructor is called - // creating an element of the correct class type. - SrcElem := SrcElems.Item[I]; - DestElem := TJclSimpleXMLElemClass(SrcElem.ClassType).Create(SrcElem.Name, SrcElem.Value); - DestElem.Assign(SrcElem); - DestElems.Add(DestElem); - end; - end; -end; - -procedure TJclSimpleXMLElem.Clear; -begin - if FItems <> nil then - FItems.Clear; - if FProps <> nil then - FProps.Clear; -end; - -constructor TJclSimpleXMLElem.Create(ASimpleXML: TJclSimpleXML); -begin - Create; - FSimpleXML := ASimpleXML; -end; - -destructor TJclSimpleXMLElem.Destroy; -begin - FSimpleXML := nil; - FParent := nil; - Clear; - FreeAndNil(FItems); - FreeAndNil(FProps); - inherited Destroy; -end; - -procedure TJclSimpleXMLElem.Error(const S: string); -begin - raise EJclSimpleXMLError.Create(S); -end; - -procedure TJclSimpleXMLElem.FmtError(const S: string; - const Args: array of const); -begin - Error(Format(S, Args)); -end; - -procedure TJclSimpleXMLElem.GetBinaryValue(Stream: TStream; BufferSize: Integer = 0); -var - I, J, ValueLength, RequiredStreamSize: Integer; - Buf: array of Byte; - N1, N2: Byte; - - function NibbleCharToNibble(const AChar: Char): Byte; - begin - case AChar of - '0': Result := 0; - '1': Result := 1; - '2': Result := 2; - '3': Result := 3; - '4': Result := 4; - '5': Result := 5; - '6': Result := 6; - '7': Result := 7; - '8': Result := 8; - '9': Result := 9; - 'a', 'A': Result := 10; - 'b', 'B': Result := 11; - 'c', 'C': Result := 12; - 'd', 'D': Result := 13; - 'e', 'E': Result := 14; - 'f', 'F': Result := 15; - else - Result := 16; - end; - end; - - procedure PrepareNibbleCharMapping; - var - C: Char; - begin - if not PreparedNibbleCharMapping then - begin - for C := Low(Char) to High(Char) do - NibbleCharMapping[C] := NibbleCharToNibble(C); - PreparedNibbleCharMapping := True; - end; - end; - -var - CurrentStreamPosition: Integer; -begin - if BufferSize = 0 then - BufferSize := cBufferSize; - - SetLength(Buf, BufferSize); - PrepareNibbleCharMapping; - I := 1; - J := 0; - ValueLength := Length(Value); - RequiredStreamSize := Stream.Position + ValueLength div 2; - if Stream.Size < RequiredStreamSize then - begin - CurrentStreamPosition := Stream.Position; - Stream.Size := RequiredStreamSize; - Stream.Seek(CurrentStreamPosition, soBeginning); - end; - while I < ValueLength do - begin - //faster replacement for St := '$' + Value[I] + Value[I + 1]; Buf[J] := StrToIntDef(St, 0); - N1 := NibbleCharMapping[Value[I]]; - N2 := NibbleCharMapping[Value[I + 1]]; - Inc(I, 2); - if (N1 > 15) or (N2 > 15) then - Buf[J] := 0 - else - Buf[J] := (N1 shl 4) or N2; - Inc(J); - if J = Length(Buf) - 1 then //Buffered write to speed up the process a little - begin - Stream.Write(Buf[0], J); - J := 0; - end; - end; - Stream.Write(Buf[0], J); -end; - -function TJclSimpleXMLElem.GetChildIndex(const AChild: TJclSimpleXMLElem): Integer; -begin - if FItems = nil then - Result := -1 - else - Result := FItems.FElems.IndexOfSimpleItem(AChild); -end; - -function TJclSimpleXMLElem.GetChildsCount: Integer; -var - I: Integer; -begin - Result := 1; - if FItems <> nil then - for I := 0 to FItems.Count - 1 do - Result := Result + FItems[I].ChildsCount; -end; - -function TJclSimpleXMLElem.GetHasItems: Boolean; -begin - Result := Assigned(FItems) and (FItems.Count > 0); -end; - -function TJclSimpleXMLElem.GetHasProperties: Boolean; -begin - Result := Assigned(FProps) and (FProps.Count > 0); -end; - -function TJclSimpleXMLElem.GetItemCount: Integer; -begin - Result := 0; - if Assigned(FItems) then - Result := FItems.Count; -end; - -function TJclSimpleXMLElem.GetItems: TJclSimpleXMLElems; -begin - if FItems = nil then - FItems := TJclSimpleXMLElems.Create(Self); - Result := FItems; -end; - -function TJclSimpleXMLElem.GetNamedIndex(const AChild: TJclSimpleXMLElem): Integer; -begin - Result := Items.NamedElems[AChild.Name].IndexOf(AChild); -end; - -function TJclSimpleXMLElem.GetPropertyCount: Integer; -begin - Result := 0; - if Assigned(FProps) then - Result := FProps.Count; -end; - -function TJclSimpleXMLElem.GetProps: TJclSimpleXMLProps; -begin - if FProps = nil then - FProps := TJclSimpleXMLProps.Create(Self); - Result := FProps; -end; - -procedure TJclSimpleXMLElem.LoadFromString(const Value: string); -var - Stream: TJclStringStream; - StrStream: TStringStream; -begin - StrStream := TStringStream.Create(Value); - try - Stream := TJclAutoStream.Create(StrStream); - try - LoadFromStringStream(Stream); - finally - Stream.Free; - end; - finally - StrStream.Free; - end; -end; - -function TJclSimpleXMLElem.SaveToString: string; -var - Stream: TJclStringStream; - StrStream: TStringStream; -begin - StrStream := TStringStream.Create(''); - try - Stream := TJclAutoStream.Create(StrStream); - try - SaveToStringStream(Stream); - Stream.Flush; - finally - Stream.Free; - end; - Result := StrStream.DataString; - finally - StrStream.Free; - end; -end; - -procedure TJclSimpleXMLElem.SetName(const Value: string); -begin - if (Value <> Name) and (Value <> '') then - begin - if (Parent <> nil) and (Name <> '') then - Parent.Items.DoItemRename(Self, Value); - inherited SetName(Value); - end; -end; - -//=== { TJclSimpleXMLNamedElemsEnumerator } ================================== - -{$IFDEF SUPPORTS_FOR_IN} -constructor TJclSimpleXMLNamedElemsEnumerator.Create(AList: TJclSimpleXMLNamedElems); -begin - inherited Create; - FIndex := -1; - FList := AList; -end; - -function TJclSimpleXMLNamedElemsEnumerator.GetCurrent: TJclSimpleXMLElem; -begin - Result := FList[FIndex]; -end; - -function TJclSimpleXMLNamedElemsEnumerator.MoveNext: Boolean; -begin - Result := FIndex < FList.Count - 1; - if Result then - Inc(FIndex); -end; -{$ENDIF SUPPORTS_FOR_IN} - -//=== { TJclSimpleXMLNamedElems } ============================================ - -constructor TJclSimpleXMLNamedElems.Create(AElems: TJclSimpleXMLElems; const AName: string); -begin - inherited Create; - FElems := AElems; - FName := AName; - FItems := TList.Create; -end; - -destructor TJclSimpleXMLNamedElems.Destroy; -begin - FItems.Free; - inherited Destroy; -end; - -function TJclSimpleXMLNamedElems.Add(const Value: Int64): TJclSimpleXMLElemClassic; -begin - Result := Elems.Add(Name, Value); -end; - -function TJclSimpleXMLNamedElems.Add(Value: TStream): TJclSimpleXMLElemClassic; -begin - Result := Elems.Add(Name, Value); -end; - -function TJclSimpleXMLNamedElems.Add(const Value: Boolean): TJclSimpleXMLElemClassic; -begin - Result := Elems.Add(Name, Value); -end; - -function TJclSimpleXMLNamedElems.Add: TJclSimpleXMLElemClassic; -begin - Result := Elems.Add(Name); -end; - -function TJclSimpleXMLNamedElems.Add(const Value: string): TJclSimpleXMLElemClassic; -begin - Result := Elems.Add(Name, Value); -end; - -function TJclSimpleXMLNamedElems.AddCData(const Value: string): TJclSimpleXMLElemCData; -begin - Result := Elems.AddCData(Name, Value); -end; - -function TJclSimpleXMLNamedElems.AddComment(const Value: string): TJclSimpleXMLElemComment; -begin - Result := Elems.AddComment(Name, Value); -end; - -function TJclSimpleXMLNamedElems.AddFirst: TJclSimpleXMLElemClassic; -begin - Result := Elems.AddFirst(Name); -end; - -function TJclSimpleXMLNamedElems.AddText(const Value: string): TJclSimpleXMLElemText; -begin - Result := Elems.AddText(Name, Value); -end; - -procedure TJclSimpleXMLNamedElems.Clear; -var - Index: Integer; -begin - for Index := FItems.Count - 1 downto 0 do - Elems.Remove(TJclSimpleXMLElem(FItems.Items[Index])); -end; - -procedure TJclSimpleXMLNamedElems.Delete(const Index: Integer); -begin - if (Index >= 0) and (Index < FItems.Count) then - Elems.Remove(TJclSimpleXMLElem(FItems.Items[Index])); -end; - -function TJclSimpleXMLNamedElems.GetCount: Integer; -begin - Result := FItems.Count; -end; - -{$IFDEF SUPPORTS_FOR_IN} -function TJclSimpleXMLNamedElems.GetEnumerator: TJclSimpleXMLNamedElemsEnumerator; -begin - Result := TJclSimpleXMLNamedElemsEnumerator.Create(Self); -end; -{$ENDIF SUPPORTS_FOR_IN} - -function TJclSimpleXMLNamedElems.GetItem(const Index: Integer): TJclSimpleXMLElem; -begin - if (Index >= 0) then - begin - While (Index >= Count) do - if Assigned(Elems.Parent) and Assigned(Elems.Parent.SimpleXML) and - (sxoAutoCreate in Elems.Parent.SimpleXML.Options) then - Add - else - break; - if Index < Count then - Result := TJclSimpleXMLElem(FItems.Items[Index]) - else - Result := nil; - end - else - Result := nil; -end; - -function TJclSimpleXMLNamedElems.IndexOf(const Value: TJclSimpleXMLElem): Integer; -begin - Result := FItems.IndexOf(Value); -end; - -function TJclSimpleXMLNamedElems.IndexOf(const Value: string): Integer; -var - Index: Integer; - NewItem: TJclSimpleXMLElem; -begin - Result := -1; - for Index := 0 to FItems.Count - 1 do - if TJclSimpleXMLElem(FItems.Items[Index]).Value = Value then - begin - Result := Index; - Break; - end; - if (Result = -1) and (sxoAutoCreate in Elems.Parent.SimpleXML.Options) then - begin - NewItem := Elems.Add(Name, Value); - Result := FItems.IndexOf(NewItem); - end; -end; - -procedure TJclSimpleXMLNamedElems.Move(const CurIndex, NewIndex: Integer); -var - ElemsCurIndex, ElemsNewIndex: Integer; -begin - ElemsCurIndex := Elems.IndexOf(TJclSimpleXMLElem(FItems.Items[CurIndex])); - ElemsNewIndex := Elems.IndexOf(TJclSimpleXMLElem(FItems.Items[NewIndex])); - Elems.Move(ElemsCurIndex, ElemsNewIndex); - FItems.Move(CurIndex, NewIndex); -end; - -procedure TJclSimpleXMLNamedElems.SetName(const Value: string); -begin - raise EJclSimpleXMLError.CreateRes(@SReadOnlyProperty); -end; - -//=== { TJclSimpleXMLElemsEnumerator } ======================================= - -{$IFDEF SUPPORTS_FOR_IN} -constructor TJclSimpleXMLElemsEnumerator.Create(AList: TJclSimpleXMLElems); -begin - inherited Create; - FIndex := -1; - FList := AList; -end; - -function TJclSimpleXMLElemsEnumerator.GetCurrent: TJclSimpleXMLElem; -begin - Result := FList[FIndex]; -end; - -function TJclSimpleXMLElemsEnumerator.MoveNext: Boolean; -begin - Result := FIndex < FList.Count - 1; - if Result then - Inc(FIndex); -end; -{$ENDIF SUPPORTS_FOR_IN} - -//=== { TJclSimpleXMLElems } ================================================= - -function TJclSimpleXMLElems.Add(const Name: string): TJclSimpleXMLElemClassic; -begin - Result := TJclSimpleXMLElemClassic.Create(Name); - AddChild(Result); -end; - -function TJclSimpleXMLElems.Add(const Name, Value: string): TJclSimpleXMLElemClassic; -begin - Result := TJclSimpleXMLElemClassic.Create(Name, Value); - AddChild(Result); -end; - -function TJclSimpleXMLElems.Add(const Name: string; const Value: Int64): TJclSimpleXMLElemClassic; -begin - Result := TJclSimpleXMLElemClassic.Create(Name, IntToStr(Value)); - AddChild(Result); -end; - -function TJclSimpleXMLElems.Add(Value: TJclSimpleXMLElem): TJclSimpleXMLElem; -begin - if Value <> nil then - AddChild(Value); - Result := Value; -end; - -function TJclSimpleXMLElems.Add(const Name: string; const Value: Boolean): TJclSimpleXMLElemClassic; -begin - Result := TJclSimpleXMLElemClassic.Create(Name, BoolToStr(Value)); - AddChild(Result); -end; - -function TJclSimpleXMLElems.Add(const Name: string; Value: TStream; BufferSize: Integer): TJclSimpleXMLElemClassic; -var - Stream: TStringStream; - Buf: array of Byte; - St: string; - I, Count: Integer; -begin - Stream := TStringStream.Create(''); - try - if BufferSize = 0 then - BufferSize := cBufferSize; - - SetLength(Buf, BufferSize); - Buf[0] := 0; - repeat - Count := Value.Read(Buf[0], Length(Buf)); - St := ''; - for I := 0 to Count - 1 do - St := St + IntToHex(Buf[I], 2); - Stream.WriteString(St); - until Count = 0; - Result := TJclSimpleXMLElemClassic.Create(Name, Stream.DataString); - AddChild(Result); - finally - Stream.Free; - end; -end; - -procedure TJclSimpleXMLElems.AddChild(const Value: TJclSimpleXMLElem); -var - NamedIndex: Integer; -begin - CreateElems; - - // If there already is a container, notify it to remove the element - if Assigned(Value.Parent) then - Value.Parent.Items.Notify(Value, opRemove); - - FElems.Add(Value); - - if FNamedElems <> nil then - begin - NamedIndex := FNamedElems.IndexOfName(Value.Name); - if NamedIndex >= 0 then - TJclSimpleXMLNamedElems(FNamedElems.SimpleItems[NamedIndex]).FItems.Add(Value); - end; - - Notify(Value, opInsert); -end; - -procedure TJclSimpleXMLElems.AddChildFirst(const Value: TJclSimpleXMLElem); -var - NamedIndex: Integer; -begin - CreateElems; - - // If there already is a container, notify it to remove the element - if Assigned(Value.Parent) then - Value.Parent.Items.Notify(Value, opRemove); - - FElems.Insert(0, Value); - - if FNamedElems <> nil then - begin - NamedIndex := FNamedElems.IndexOfName(Value.Name); - if NamedIndex >= 0 then - TJclSimpleXMLNamedElems(FNamedElems.SimpleItems[NamedIndex]).FItems.Insert(0, Value); - end; - - Notify(Value, opInsert); -end; - -function TJclSimpleXMLElems.AddFirst(const Name: string): TJclSimpleXMLElemClassic; -begin - Result := TJclSimpleXMLElemClassic.Create(Name); - AddChildFirst(Result); -end; - -function TJclSimpleXMLElems.AddFirst(Value: TJclSimpleXMLElem): TJclSimpleXMLElem; -begin - if Value <> nil then - AddChildFirst(Value); - Result := Value; -end; - -function TJclSimpleXMLElems.AddComment(const Name, - Value: string): TJclSimpleXMLElemComment; -begin - Result := TJclSimpleXMLElemComment.Create(Name, Value); - AddChild(Result); -end; - -function TJclSimpleXMLElems.AddCData(const Name, Value: string): TJclSimpleXMLElemCData; -begin - Result := TJclSimpleXMLElemCData.Create(Name, Value); - AddChild(Result); -end; - -function TJclSimpleXMLElems.AddText(const Name, Value: string): TJclSimpleXMLElemText; -begin - Result := TJclSimpleXMLElemText.Create(Name, Value); - AddChild(Result); -end; - -procedure TJclSimpleXMLElems.BinaryValue(const Name: string; Stream: TStream); -var - Elem: TJclSimpleXMLElem; -begin - Elem := GetItemNamed(Name); - if Elem <> nil then - Elem.GetBinaryValue(Stream); -end; - -function TJclSimpleXMLElems.BoolValue(const Name: string; Default: Boolean): Boolean; -var - Elem: TJclSimpleXMLElem; -begin - try - Elem := GetItemNamedDefault(Name, BoolToStr(Default)); - if (Elem = nil) or (Elem.Value = '') then - Result := Default - else - Result := Elem.BoolValue; - except - Result := Default; - end; -end; - -procedure TJclSimpleXMLElems.Clear; -begin - if FElems <> nil then - FElems.Clear; - if FNamedElems <> nil then - FNamedElems.Clear; -end; - -constructor TJclSimpleXMLElems.Create(AParent: TJclSimpleXMLElem); -begin - inherited Create; - FParent := AParent; -end; - -procedure TJclSimpleXMLElems.CreateElems; -var - CaseSensitive: Boolean; -begin - if FElems = nil then - begin - CaseSensitive := Assigned(Parent) and Assigned(Parent.SimpleXML) - and (sxoCaseSensitive in Parent.SimpleXML.Options); - FElems := TJclSimpleItemHashedList.Create(CaseSensitive); - end; -end; - -procedure TJclSimpleXMLElems.Delete(const Index: Integer); -var - Elem: TJclSimpleXMLElem; - NamedIndex: Integer; -begin - if (FElems <> nil) and (Index >= 0) and (Index < FElems.Count) then - begin - Elem := TJclSimpleXMLElem(FElems.SimpleItems[Index]); - if FNamedElems <> nil then - begin - NamedIndex := FNamedElems.IndexOfName(Elem.Name); - if NamedIndex >= 0 then - TJclSimpleXMLNamedElems(FNamedElems.SimpleItems[NamedIndex]).FItems.Remove(Elem); - end; - FElems.Delete(Index); - end; -end; - -procedure TJclSimpleXMLElems.Delete(const Name: string); -begin - if FElems <> nil then - Delete(FElems.IndexOfName(Name)); -end; - -destructor TJclSimpleXMLElems.Destroy; -begin - FParent := nil; - Clear; - FreeAndNil(FElems); - FreeAndNil(FNamedElems); - inherited Destroy; -end; - -procedure TJclSimpleXMLElems.DoItemRename(Value: TJclSimpleXMLElem; const Name: string); -var - NamedIndex: Integer; -begin - if FNamedElems <> nil then - begin - NamedIndex := FNamedElems.IndexOfName(Value.Name); - if NamedIndex >= 0 then - TJclSimpleXMLNamedElems(FNamedElems.SimpleItems[NamedIndex]).FItems.Remove(Value); - - NamedIndex := FNamedElems.IndexOfName(Name); - if NamedIndex >= 0 then - TJclSimpleXMLNamedElems(FNamedElems.SimpleItems[NamedIndex]).FItems.Add(Value); - end; - FElems.InvalidateHash; -end; - -function TJclSimpleXMLElems.FloatValue(const Name: string; - const Default: Extended): Extended; -var - Elem: TJclSimpleXMLElem; -begin - Elem := GetItemNamedDefault(Name, FloatToStr(Default)); - if Elem = nil then - Result := Default - else - Result := Elem.FloatValue; -end; - -function TJclSimpleXMLElems.GetCount: Integer; -begin - if FElems = nil then - Result := 0 - else - Result := FElems.Count; -end; - -{$IFDEF SUPPORTS_FOR_IN} -function TJclSimpleXMLElems.GetEnumerator: TJclSimpleXMLElemsEnumerator; -begin - Result := TJclSimpleXMLElemsEnumerator.Create(Self); -end; -{$ENDIF SUPPORTS_FOR_IN} - -function TJclSimpleXMLElems.GetItem(const Index: Integer): TJclSimpleXMLElem; -begin - if (FElems = nil) or (Index > FElems.Count) then - Result := nil - else - Result := TJclSimpleXMLElem(FElems.SimpleItems[Index]); -end; - -function TJclSimpleXMLElems.GetItemNamedDefault(const Name, Default: string): TJclSimpleXMLElem; -var - I: Integer; -begin - Result := nil; - if FElems <> nil then - begin - I := FElems.IndexOfName(Name); - if I <> -1 then - Result := TJclSimpleXMLElem(FElems.SimpleItems[I]) - else - if Assigned(Parent) and Assigned(Parent.SimpleXML) and (sxoAutoCreate in Parent.SimpleXML.Options) then - Result := Add(Name, Default); - end - else - if Assigned(Parent) and Assigned(Parent.SimpleXML) and (sxoAutoCreate in Parent.SimpleXML.Options) then - Result := Add(Name, Default); -end; - -function TJclSimpleXMLElems.GetNamedElems(const Name: string): TJclSimpleXMLNamedElems; -var - NamedIndex: Integer; - CaseSensitive: Boolean; -begin - if FNamedElems = nil then - begin - CaseSensitive := Assigned(Parent) and Assigned(Parent.SimpleXML) - and (sxoCaseSensitive in Parent.SimpleXML.Options); - FNamedElems := TJclSimpleItemHashedList.Create(CaseSensitive); - end; - NamedIndex := FNamedElems.IndexOfName(Name); - if NamedIndex = -1 then - begin - Result := TJclSimpleXMLNamedElems.Create(Self, Name); - FNamedElems.Add(Result); - if FElems <> nil then - for NamedIndex := 0 to FElems.Count - 1 do - if FElems.SimpleItems[NamedIndex].Name = Name then - Result.FItems.Add(FElems.SimpleItems[NamedIndex]); - end - else - Result := TJclSimpleXMLNamedElems(FNamedElems.SimpleItems[NamedIndex]); -end; - -function TJclSimpleXMLElems.GetItemNamed(const Name: string): TJclSimpleXMLElem; -begin - Result := GetItemNamedDefault(Name, ''); -end; - -function TJclSimpleXMLElems.IntValue(const Name: string; const Default: Int64): Int64; -var - Elem: TJclSimpleXMLElem; -begin - Elem := GetItemNamedDefault(Name, IntToStr(Default)); - if Elem = nil then - Result := Default - else - Result := Elem.IntValue; -end; - -procedure TJclSimpleXMLElems.LoadFromStringStream(StringStream: TJclStringStream); -type - TReadStatus = (rsWaitingTag, rsReadingTagKind); -var - lPos: TReadStatus; - St: TUCS4Array; - lElem: TJclSimpleXMLElem; - Ch: UCS4; - ContainsText, ContainsWhiteSpace, KeepWhiteSpace: Boolean; - SimpleXML: TJclSimpleXML; -begin - SetLength(St, 0); - lPos := rsWaitingTag; - SimpleXML := Parent.SimpleXML; - KeepWhiteSpace := (SimpleXML <> nil) and (sxoKeepWhitespace in SimpleXML.Options); - ContainsText := False; - ContainsWhiteSpace := False; - - // We read from a stream, thus replacing the existing items - Clear; - - if SimpleXML <> nil then - SimpleXML.DoLoadProgress(StringStream.Stream.Position, StringStream.Stream.Size); - - while StringStream.PeekUCS4(Ch) do - begin - case lPos of - rsWaitingTag: //We are waiting for a tag and thus avoiding spaces - begin - if Ch = Ord('<') then - begin - lPos := rsReadingTagKind; - St := UCS4Array(Ch); - end - else - if UnicodeIsWhiteSpace(Ch) then - ContainsWhiteSpace := True - else - ContainsText := True; - end; - - rsReadingTagKind: //We are trying to determine the kind of the tag - begin - lElem := nil; - case Ch of - Ord('/'): - if UCS4ArrayEquals(St, '<') then - begin // "'), Ord(':'): //This should be a classic tag - begin // " - lElem := TJclSimpleXMLElemClassic.Create; - SetLength(St, 0); - lPos := rsWaitingTag; - end; - else - if ContainsText or (ContainsWhiteSpace and KeepWhiteSpace) then - begin - // inner text - lElem := TJclSimpleXMLElemText.Create; - lPos := rsReadingTagKind; - ContainsText := False; - ContainsWhiteSpace := False; - end - else - begin - if not UCS4ArrayEquals(St, ' nil then - begin - CreateElems; - FElems.Add(lElem); - Notify(lElem, opInsert); - lElem.LoadFromStringStream(StringStream); - end; - end; - end; - end; -end; - -procedure TJclSimpleXMLElems.Notify(Value: TJclSimpleXMLElem; Operation: TOperation); -var - NamedIndex: Integer; -begin - case Operation of - opRemove: - if Value.Parent = Parent then // Only remove if we have it - begin - if FNamedElems <> nil then - begin - NamedIndex := FNamedElems.IndexOfName(Value.Name); - if NamedIndex >= 0 then - TJclSimpleXMLNamedElems(FNamedElems.SimpleItems[NamedIndex]).FItems.Remove(Value); - end; - FElems.Remove(Value); - end; - opInsert: - begin - Value.FParent := Parent; - Value.FSimpleXML := Parent.SimpleXML; - end; - end; -end; - -function TJclSimpleXMLElems.Remove(Value: TJclSimpleXMLElem): Integer; -begin - if FElems = nil - then Result := -1 // like TList.IndexOf(alien) - else begin - Result := FElems.IndexOfSimpleItem(Value); - Notify(Value, opRemove); - end; -end; - -procedure TJclSimpleXMLElems.SaveToStringStream(StringStream: TJclStringStream; - const Level: string); -var - I: Integer; -begin - for I := 0 to Count - 1 do - Item[I].SaveToStringStream(StringStream, Level); -end; - -function TJclSimpleXMLElems.SimpleCompare(Elems: TJclSimpleXMLElems; Index1, - Index2: Integer): Integer; -begin - Result := CompareText(Elems.Item[Index1].Name, Elems.Item[Index2].Name); -end; - -function TJclSimpleXMLElems.Value(const Name, Default: string): string; -var - Elem: TJclSimpleXMLElem; -begin - Result := ''; - Elem := GetItemNamedDefault(Name, Default); - if Elem = nil then - Result := Default - else - Result := Elem.Value; -end; - -procedure TJclSimpleXMLElems.Move(const CurIndex, NewIndex: Integer); -begin - if FElems <> nil then - FElems.Move(CurIndex, NewIndex); -end; - -function TJclSimpleXMLElems.IndexOf(const Value: TJclSimpleXMLElem): Integer; -begin - if FElems = nil then - Result := -1 - else - Result := FElems.IndexOfSimpleItem(Value); -end; - -function TJclSimpleXMLElems.IndexOf(const Name: string): Integer; -begin - if FElems = nil then - Result := -1 - else - Result := FElems.IndexOfName(Name); -end; - -procedure TJclSimpleXMLElems.InsertChild(const Value: TJclSimpleXMLElem; Index: Integer); -var - NamedIndex: Integer; -begin - CreateElems; - - // If there already is a container, notify it to remove the element - if Assigned(Value.Parent) then begin - if (value.parent<>FParent) then begin - if FNamedElems <> nil then begin - NamedIndex := FNamedElems.IndexOfName(Value.Name); - if NamedIndex >= 0 then - TJclSimpleXMLNamedElems(FNamedElems.SimpleItems[NamedIndex]).FItems.Remove(Value); - end; - Value.FParent.items.FElems.Extract(Value); //EW here is the real difference - Value.FParent := nil; - Value.FSimpleXML := nil; - end - else - begin - Value.Parent.Items.Notify(Value, opRemove); - end; - end; - - FElems.Insert(Index, Value); - - if FNamedElems <> nil then - begin - NamedIndex := FNamedElems.IndexOfName(Value.Name); - if NamedIndex >= 0 then - TJclSimpleXMLNamedElems(FNamedElems.SimpleItems[NamedIndex]).FItems.Add(Value); - end; - - Notify(Value, opInsert); -end; - -function TJclSimpleXMLElems.Insert(Value: TJclSimpleXMLElem; - Index: Integer): TJclSimpleXMLElem; -begin - if Value <> nil then - InsertChild(Value, Index); - Result := Value; -end; - -function TJclSimpleXMLElems.Insert(const Name: string; - Index: Integer): TJclSimpleXMLElemClassic; -begin - Result := TJclSimpleXMLElemClassic.Create(Name); - InsertChild(Result, Index); -end; - -procedure QuickSort(Elems: TJclSimpleXMLElems; List: TList; L, R: Integer; - AFunction: TJclSimpleXMLElemCompare); -var - I, J, M: Integer; -begin - repeat - I := L; - J := R; - M := (L + R) shr 1; - repeat - while AFunction(Elems, I, M) < 0 do - Inc(I); - while AFunction(Elems, J, M) > 0 do - Dec(J); - if I < J then - begin - List.Exchange(I, J); - if M = I then - M := J - else if M = J then - M := I; - Inc(I); - Dec(J); - end - else - if I = J then - begin - Inc(I); - Dec(J); - end; - until I > J; - if L < J then - QuickSort(Elems, List, L, J, AFunction); - L := I; - until I >= R; -end; - -procedure TJclSimpleXMLElems.CustomSort(AFunction: TJclSimpleXMLElemCompare); -begin - if FElems <> nil then - QuickSort(Self, FElems, 0, FElems.Count - 1, AFunction); -end; - -procedure TJclSimpleXMLElems.Sort; -begin - CustomSort(SimpleCompare); -end; - -//=== { TJclSimpleXMLPropsEnumerator } ======================================= - -{$IFDEF SUPPORTS_FOR_IN} -constructor TJclSimpleXMLPropsEnumerator.Create(AList: TJclSimpleXMLProps); -begin - inherited Create; - FIndex := -1; - FList := AList; -end; - -function TJclSimpleXMLPropsEnumerator.GetCurrent: TJclSimpleXMLProp; -begin - Result := FList[FIndex]; -end; - -function TJclSimpleXMLPropsEnumerator.MoveNext: Boolean; -begin - Result := FIndex < FList.Count - 1; - if Result then - Inc(FIndex); -end; -{$ENDIF SUPPORTS_FOR_IN} - -//=== { TJclSimpleXMLProps } ================================================= - -function TJclSimpleXMLProps.Add(const Name, Value: string): TJclSimpleXMLProp; -begin - if FProperties = nil then - FProperties := TStringList.Create; - Result := TJclSimpleXMLProp.Create(Parent, Name, Value); - FProperties.AddObject(Name, Result); -end; - -function TJclSimpleXMLProps.Add(const Name: string; const Value: Int64): TJclSimpleXMLProp; -begin - Result := Add(Name, IntToStr(Value)); -end; - -function TJclSimpleXMLProps.Add(const Name: string; const Value: Boolean): TJclSimpleXMLProp; -begin - Result := Add(Name, BoolToStr(Value)); -end; - -{$IFDEF SUPPORTS_UNICODE} -function TJclSimpleXMLProps.Add(const Name: string; - const Value: AnsiString): TJclSimpleXMLProp; -begin - Result := Add(Name, string(Value)); -end; -{$ENDIF SUPPORTS_UNICODE} - -function TJclSimpleXMLProps.Insert(const Index: Integer; const Name, Value: string): TJclSimpleXMLProp; -begin - if FProperties = nil then - FProperties := TStringList.Create; - Result := TJclSimpleXMLProp.Create(Parent, Name, Value); - FProperties.InsertObject(Index, Name, Result); -end; - -function TJclSimpleXMLProps.Insert(const Index: Integer; const Name: string; const Value: Int64): TJclSimpleXMLProp; -begin - Result := Insert(Index, Name, IntToStr(Value)); -end; - -function TJclSimpleXMLProps.Insert(const Index: Integer; const Name: string; const Value: Boolean): TJclSimpleXMLProp; -begin - Result := Insert(Index, Name, BoolToStr(Value)); -end; - -function TJclSimpleXMLProps.BoolValue(const Name: string; Default: Boolean): Boolean; -var - Prop: TJclSimpleXMLProp; -begin - try - Prop := GetItemNamedDefault(Name, BoolToStr(Default)); - if (Prop = nil) or (Prop.Value = '') then - Result := Default - else - Result := Prop.BoolValue; - except - Result := Default; - end; -end; - -procedure TJclSimpleXMLProps.Clear; -var - I: Integer; -begin - if FProperties <> nil then - begin - for I := 0 to FProperties.Count - 1 do - begin - TJclSimpleXMLProp(FProperties.Objects[I]).Free; - FProperties.Objects[I] := nil; - end; - FProperties.Clear; - end; -end; - -procedure TJclSimpleXMLProps.Delete(const Index: Integer); -begin - if (FProperties <> nil) and (Index >= 0) and (Index < FProperties.Count) then - begin - TObject(FProperties.Objects[Index]).Free; - FProperties.Delete(Index); - end; -end; - -constructor TJclSimpleXMLProps.Create(AParent: TJclSimpleXMLElem); -begin - inherited Create; - FParent := AParent; -end; - -procedure TJclSimpleXMLProps.Delete(const Name: string); -begin - if FProperties <> nil then - Delete(FProperties.IndexOf(Name)); -end; - -destructor TJclSimpleXMLProps.Destroy; -begin - FParent := nil; - Clear; - FreeAndNil(FProperties); - inherited Destroy; -end; - -procedure TJclSimpleXMLProps.DoItemRename(Value: TJclSimpleXMLProp; const Name: string); -var - I: Integer; -begin - if FProperties = nil then - Exit; - I := FProperties.IndexOfObject(Value); - if I <> -1 then - FProperties[I] := Name; -end; - -procedure TJclSimpleXMLProps.Error(const S: string); -begin - raise EJclSimpleXMLError.Create(S); -end; - -function TJclSimpleXMLProps.FloatValue(const Name: string; - const Default: Extended): Extended; -var - Prop: TJclSimpleXMLProp; -begin - Prop := GetItemNamedDefault(Name, FloatToStr(Default)); - if Prop = nil then - Result := Default - else - Result := Prop.FloatValue; -end; - -procedure TJclSimpleXMLProps.FmtError(const S: string; - const Args: array of const); -begin - Error(Format(S, Args)); -end; - -function TJclSimpleXMLProps.GetCount: Integer; -begin - if FProperties = nil then - Result := 0 - else - Result := FProperties.Count; -end; - -{$IFDEF SUPPORTS_FOR_IN} -function TJclSimpleXMLProps.GetEnumerator: TJclSimpleXMLPropsEnumerator; -begin - Result := TJclSimpleXMLPropsEnumerator.Create(Self); -end; -{$ENDIF SUPPORTS_FOR_IN} - -function TJclSimpleXMLProps.GetItem(const Index: Integer): TJclSimpleXMLProp; -begin - if FProperties <> nil then - Result := TJclSimpleXMLProp(FProperties.Objects[Index]) - else - Result := nil; -end; - -function TJclSimpleXMLProps.GetItemNamedDefault(const Name, Default: string): TJclSimpleXMLProp; -var - I: Integer; -begin - Result := nil; - if FProperties <> nil then - begin - I := FProperties.IndexOf(Name); - if I <> -1 then - Result := TJclSimpleXMLProp(FProperties.Objects[I]) - else - if Assigned(FParent) and Assigned(FParent.SimpleXML) and (sxoAutoCreate in FParent.SimpleXML.Options) then - Result := Add(Name, Default); - end - else - if Assigned(FParent) and Assigned(FParent.SimpleXML) and (sxoAutoCreate in FParent.SimpleXML.Options) then - begin - Result := Add(Name, Default); - end; -end; - -function TJclSimpleXMLProps.GetItemNamed(const Name: string): TJclSimpleXMLProp; -begin - Result := GetItemNamedDefault(Name, ''); -end; - -function TJclSimpleXMLProps.GetSimpleXML: TJclSimpleXML; -begin - if FParent <> nil then - Result := FParent.SimpleXML - else - Result := nil; -end; - -function TJclSimpleXMLProps.IntValue(const Name: string; const Default: Int64): Int64; -var - Prop: TJclSimpleXMLProp; -begin - Prop := GetItemNamedDefault(Name, IntToStr(Default)); - if Prop = nil then - Result := Default - else - Result := Prop.IntValue; -end; - -procedure TJclSimpleXMLProps.LoadFromStringStream(StringStream: TJclStringStream); -// -//Stop on / or ? or > -type - TPosType = ( - ptWaiting, - ptReadingName, - ptStartingContent, - ptReadingValue, - ptSpaceBeforeEqual - ); -var - lPos: TPosType; - lName, lValue, lNameSpace: TUCS4Array; - sValue: string; - lPropStart: UCS4; - Ch: UCS4; -begin - SetLength(lValue, 0); - SetLength(lNameSpace, 0); - SetLength(lName, 0); - lPropStart := Ord(NativeSpace); - lPos := ptWaiting; - - // We read from a stream, thus replacing the existing properties - Clear; - - while StringStream.PeekUCS4(Ch) do - begin - case lPos of - ptWaiting: //We are waiting for a property - begin - if UnicodeIsWhiteSpace(Ch) then - StringStream.ReadUCS4(Ch) - else - if UnicodeIsIdentifierStart(Ch) or (Ch = Ord('-')) or (Ch = Ord('.')) or (Ch = Ord('_')) then - begin - StringStream.ReadUCS4(Ch); - lName := UCS4Array(Ch); - SetLength(lNameSpace, 0); - lPos := ptReadingName; - end - else - if (Ch = Ord('/')) or (Ch = Ord('>')) or (Ch = Ord('?')) then - // end of properties - Break - else - FmtError(LoadResString(@RsEInvalidXMLElementUnexpectedCharacte), [UCS4ToChar(Ch), StringStream.PeekPosition]); - end; - - ptReadingName: //We are reading a property name - begin - StringStream.ReadUCS4(Ch); - if UnicodeIsIdentifierPart(Ch) or (Ch = Ord('-')) or (Ch = Ord('.')) then - begin - UCS4ArrayConcat(lName, Ch); - end - else - if Ch = Ord(':') then - begin - lNameSpace := lName; - SetLength(lName, 0); - end - else - if Ch = Ord('=') then - lPos := ptStartingContent - else - if UnicodeIsWhiteSpace(Ch) then - lPos := ptSpaceBeforeEqual - else - FmtError(LoadResString(@RsEInvalidXMLElementUnexpectedCharacte), [UCS4ToChar(Ch), StringStream.PeekPosition]); - end; - - ptStartingContent: //We are going to start a property content - begin - StringStream.ReadUCS4(Ch); - if UnicodeIsWhiteSpace(Ch) then - // ignore white space - else - if (Ch = Ord('''')) or (Ch = Ord('"')) then - begin - lPropStart := Ch; - SetLength(lValue, 0); - lPos := ptReadingValue; - end - else - FmtError(LoadResString(@RsEInvalidXMLElementUnexpectedCharacte_), [UCS4ToChar(Ch), StringStream.PeekPosition]); - end; - - ptReadingValue: //We are reading a property - begin - StringStream.ReadUCS4(Ch); - if Ch = lPropStart then - begin - sValue := UCS4ToString(lValue); - if GetSimpleXML <> nil then - GetSimpleXML.DoDecodeValue(sValue); - with Add(UCS4ToString(lName), sValue) do - NameSpace := UCS4ToString(lNameSpace); - lPos := ptWaiting; - end - else - UCS4ArrayConcat(lValue, Ch); - end; - - ptSpaceBeforeEqual: // We are reading the white space between a property name and the = sign - begin - StringStream.ReadUCS4(Ch); - if UnicodeIsWhiteSpace(Ch) then - // more white space, stay in this state and ignore - else - if Ch = Ord('=') then - lPos := ptStartingContent - else - FmtError(LoadResString(@RsEInvalidXMLElementUnexpectedCharacte), [UCS4ToChar(Ch), StringStream.PeekPosition]); - end; - else - Assert(False, RsEUnexpectedValueForLPos); - end; - end; -end; - -procedure TJclSimpleXMLProps.SaveToStringStream(StringStream: TJclStringStream); -var - I: Integer; -begin - for I := 0 to Count - 1 do - Item[I].SaveToStringStream(StringStream); -end; - -procedure TJclSimpleXMLProps.SortProperties(const Order: array of string); -var - I, Index, InsertIndex: Integer; -begin - InsertIndex := 0; - for I := 0 to High(Order) do - begin - Index := FProperties.IndexOf(Order[I]); - if Index <> -1 then - begin - FProperties.Move(Index, InsertIndex); - Inc(InsertIndex); - end; - end; -end; - -function TJclSimpleXMLProps.Value(const Name, Default: string): string; -var - Prop: TJclSimpleXMLProp; -begin - Result := ''; - Prop := GetItemNamedDefault(Name, Default); - if Prop = nil then - Result := Default - else - Result := Prop.Value; -end; - -//=== { TJclSimpleXMLProp } ================================================== - -constructor TJclSimpleXMLProp.Create(AParent: TJclSimpleXMLElem; const AName, AValue: string); -begin - inherited Create(AName, AValue); - FParent := AParent; -end; - -function TJclSimpleXMLProp.GetSimpleXML: TJclSimpleXML; -begin - if FParent <> nil then - Result := FParent.SimpleXML - else - Result := nil; -end; - -procedure TJclSimpleXMLProp.SaveToStringStream(StringStream: TJclStringStream); -var - AEncoder: TJclSimpleXML; - Tmp: string; -begin - AEncoder := GetSimpleXML; - Tmp := Value; - if AEncoder <> nil then - AEncoder.DoEncodeValue(Tmp); - if NameSpace <> '' then - Tmp := Format(' %s:%s="%s"', [NameSpace, Name, Tmp]) - else - Tmp := Format(' %s="%s"', [Name, tmp]); - StringStream.WriteString(Tmp, 1, Length(Tmp)); -end; - -procedure TJclSimpleXMLProp.SetName(const Value: string); -begin - if (Value <> Name) and (Value <> '') then - begin - if (Parent <> nil) and (Name <> '') then - FParent.Properties.DoItemRename(Self, Value); - inherited SetName(Value); - end; -end; - -//=== { TJclSimpleXMLElemClassic } =========================================== - -procedure TJclSimpleXMLElemClassic.LoadFromStringStream(StringStream: TJclStringStream); -// -//foorbeuhbar -//foorbeuhbar -type - TReadStatus = (rsWaitingOpeningTag, rsOpeningName, rsTypeOpeningTag, rsEndSingleTag, - rsWaitingClosingTag1, rsWaitingClosingTag2, rsClosingName); -var - lPos: TReadStatus; - St, lName, lNameSpace: TUCS4Array; - sValue: string; - Ch: UCS4; -begin - SetLength(St, 0); - SetLength(lName, 0); - SetLength(lNameSpace, 0); - sValue := ''; - lPos := rsWaitingOpeningTag; - - if SimpleXML <> nil then - SimpleXML.DoLoadProgress(StringStream.Stream.Position, StringStream.Stream.Size); - - while StringStream.ReadUCS4(Ch) do - begin - case lPos of - rsWaitingOpeningTag: // wait beginning of tag - if Ch = Ord('<') then - lPos := rsOpeningName // read name - else - if not UnicodeIsWhiteSpace(Ch) then - FmtError(LoadResString(@RsEInvalidXMLElementExpectedBeginningO), [UCS4ToChar(Ch), StringStream.PeekPosition]); - - rsOpeningName: - if UnicodeIsIdentifierPart(Ch) or (Ch = Ord('-')) or (Ch = Ord('.')) then - UCS4ArrayConcat(St, Ch) - else - if (Ch = Ord(':')) and (Length(lNameSpace) = 0) then - begin - lNameSpace := St; - SetLength(st, 0); - end - else - if UnicodeIsWhiteSpace(Ch) and (Length(St) = 0) then - // whitespace after "<" (no name) - FmtError(LoadResString(@RsEInvalidXMLElementMalformedTagFoundn), [StringStream.PeekPosition]) - else - if UnicodeIsWhiteSpace(Ch) then - begin - lName := St; - SetLength(St, 0); - Properties.LoadFromStringStream(StringStream); - lPos := rsTypeOpeningTag; - end - else - if Ch = Ord('/') then // single tag - begin - lName := St; - lPos := rsEndSingleTag - end - else - if Ch = Ord('>') then // 2 tags - begin - lName := St; - SetLength(St, 0); - //Load elements - Items.LoadFromStringStream(StringStream); - lPos := rsWaitingClosingTag1; - end - else - // other invalid characters - FmtError(LoadResString(@RsEInvalidXMLElementMalformedTagFoundn), [StringStream.PeekPosition]); - - rsTypeOpeningTag: - if UnicodeIsWhiteSpace(Ch) then - // nothing, spaces after name or properties - else - if Ch = Ord('/') then - lPos := rsEndSingleTag // single tag - else - if Ch = Ord('>') then // 2 tags - begin - //Load elements - Items.LoadFromStringStream(StringStream); - lPos := rsWaitingClosingTag1; - end - else - FmtError(LoadResString(@RsEInvalidXMLElementExpectedEndOfTagBu), [UCS4ToChar(Ch), StringStream.PeekPosition]); - - rsEndSingleTag: - if Ch = Ord('>') then - Break - else - FmtError(LoadResString(@RsEInvalidXMLElementExpectedEndOfTagBu), [UCS4ToChar(Ch), StringStream.PeekPosition]); - - rsWaitingClosingTag1: - if UnicodeIsWhiteSpace(Ch) then - // nothing, spaces before closing tag - else - if Ch = Ord('<') then - lPos := rsWaitingClosingTag2 - else - FmtError(LoadResString(@RsEInvalidXMLElementExpectedEndOfTagBu), [UCS4ToChar(Ch), StringStream.PeekPosition]); - - rsWaitingClosingTag2: - if Ch = Ord('/') then - lPos := rsClosingName - else - FmtError(LoadResString(@RsEInvalidXMLElementExpectedEndOfTagBu), [UCS4ToChar(Ch), StringStream.PeekPosition]); - - rsClosingName: - if UnicodeIsWhiteSpace(Ch) or (Ch = Ord('>')) then - begin - if Length(lNameSpace) > 0 then - begin - if not StrSame(UCS4ToString(lNameSpace) + ':' + UCS4ToString(lName), UCS4ToString(St)) then - FmtError(LoadResString(@RsEInvalidXMLElementErroneousEndOfTagE), [UCS4ToString(lName), UCS4ToString(St), StringStream.PeekPosition]); - end - else - if not UCS4ArrayEquals(lName, St) then - FmtError(LoadResString(@RsEInvalidXMLElementErroneousEndOfTagE), [UCS4ToString(lName), UCS4ToString(St), StringStream.PeekPosition]); - //Set value if only one sub element - //This might reduce speed, but this is for compatibility issues - if (Items.Count = 1) and (Items[0] is TJclSimpleXMLElemText) then - begin - sValue := Items[0].Value; - Items.Clear; - // free some memory - FreeAndNil(FItems); - end; - Break; - end - else - if UnicodeIsIdentifierPart(Ch) or (Ch = Ord('-')) or (Ch = Ord('.')) or (Ch = Ord(':')) then - UCS4ArrayConcat(St, Ch) - else - // other invalid characters - FmtError(LoadResString(@RsEInvalidXMLElementMalformedTagFoundn), [StringStream.PeekPosition]); - end; - end; - - Name := UCS4ToString(lName); - if SimpleXML <> nil then - SimpleXML.DoDecodeValue(sValue); - Value := sValue; - NameSpace := UCS4ToString(lNameSpace); - - if SimpleXML <> nil then - begin - SimpleXML.DoTagParsed(Name); - SimpleXML.DoValueParsed(Name, sValue); - end; -end; - -procedure TJclSimpleXMLElemClassic.SaveToStringStream(StringStream: TJclStringStream; const Level: string); -var - St, AName, tmp: string; - LevelAdd: string; - AutoIndent: Boolean; -begin - if(NameSpace <> '') then - AName := NameSpace + ':' + Name - else - AName := Name; - - if Name <> '' then - begin - if SimpleXML <> nil then - SimpleXML.DoEncodeValue(AName); - St := Level + '<' + AName; - - StringStream.WriteString(St, 1, Length(St)); - if Assigned(FProps) then - FProps.SaveToStringStream(StringStream); - end; - - AutoIndent := (SimpleXML <> nil) and (sxoAutoIndent in SimpleXML.Options); - - if (ItemCount = 0) then - begin - tmp := Value; - if (Name <> '') then - begin - if Value = '' then - begin - if AutoIndent then - St := '/>' + sLineBreak - else - St := '/>'; - end - else - begin - if SimpleXML <> nil then - SimpleXML.DoEncodeValue(tmp); - if AutoIndent then - St := '>' + tmp + '' + sLineBreak - else - St := '>' + tmp + ''; - end; - StringStream.WriteString(St, 1, Length(St)); - end; - end - else - begin - if (Name <> '') then - begin - if AutoIndent then - St := '>' + sLineBreak - else - St := '>'; - StringStream.WriteString(St, 1, Length(St)); - end; - if AutoIndent then - begin - LevelAdd := SimpleXML.IndentString; - end; - FItems.SaveToStringStream(StringStream, Level + LevelAdd); - if Name <> '' then - begin - if AutoIndent then - St := Level + '' + sLineBreak - else - St := Level + ''; - StringStream.WriteString(St, 1, Length(St)); - end; - end; - if SimpleXML <> nil then - SimpleXML.DoSaveProgress; -end; - -//=== { TJclSimpleXMLElemComment } =========================================== - -procedure TJclSimpleXMLElemComment.LoadFromStringStream(StringStream: TJclStringStream); -// -const - CS_START_COMMENT = ''; -var - lPos: Integer; - St: TUCS4Array; - Ch: UCS4; - lOk: Boolean; -begin - SetLength(St, 0); - lPos := 1; - lOk := False; - - if SimpleXML <> nil then - SimpleXML.DoLoadProgress(StringStream.Stream.Position, StringStream.Stream.Size); - - while StringStream.ReadUCS4(Ch) do - begin - case lPos of - 1..4: //' + sLineBreak - else - St := '-->'; - StringStream.WriteString(St, 1, Length(St)); - if SimpleXML <> nil then - SimpleXML.DoSaveProgress; -end; - -//=== { TJclSimpleXMLElemCData } ============================================= - -procedure TJclSimpleXMLElemCData.LoadFromStringStream(StringStream: TJclStringStream); -//Hello, world!]]> -const - CS_START_CDATA = ''; -var - lPos: Integer; - St: TUCS4Array; - Ch: UCS4; - lOk: Boolean; -begin - SetLength(St, 0); - lPos := 1; - lOk := False; - - if SimpleXML <> nil then - SimpleXML.DoLoadProgress(StringStream.Stream.Position, StringStream.Stream.Size); - - while StringStream.ReadUCS4(Ch) do - begin - case lPos of - 1..9: // - if Ch = Ord(CS_STOP_CDATA[lPos]) then - begin - lOk := True; - Break; //End if - end - else - // ]]] - if Ch = Ord(CS_STOP_CDATA[lPos-1]) then - UCS4ArrayConcat(St, Ord(']')) - else - begin - UCS4ArrayConcat(St, Ord(']')); - UCS4ArrayConcat(St, Ord(']')); - UCS4ArrayConcat(St, Ch); - Dec(lPos, 2); - end; - end; - end; - - if not lOk then - FmtError(LoadResString(@RsEInvalidCDATAUnexpectedEndOfData), [StringStream.PeekPosition]); - - Value := UCS4ToString(St); - Name := ''; - - if SimpleXML <> nil then - SimpleXML.DoValueParsed('', Value); -end; - -procedure TJclSimpleXMLElemCData.SaveToStringStream(StringStream: TJclStringStream; const Level: string); -var - St: string; -begin - St := Level + ' '' then - StringStream.WriteString(Value, 1, Length(Value)); - if (SimpleXML <> nil) and (sxoAutoIndent in SimpleXML.Options) then - St := ']]>' + sLineBreak - else - St := ']]>'; - StringStream.WriteString(St, 1, Length(St)); - if SimpleXML <> nil then - SimpleXML.DoSaveProgress; -end; - -//=== { TJclSimpleXMLElemText } ============================================== - -procedure TJclSimpleXMLElemText.LoadFromStringStream(StringStream: TJclStringStream); -var - Ch: UCS4; - USt: TUCS4Array; - St, TrimValue: string; -begin - SetLength(USt, 0); - St := ''; - - if SimpleXML <> nil then - SimpleXML.DoLoadProgress(StringStream.Stream.Position, StringStream.Stream.Size); - - while StringStream.PeekUCS4(Ch) do - begin - case Ch of - Ord('<'): - //Quit text - Break; - else - begin - StringStream.ReadUCS4(Ch); - UCS4ArrayConcat(USt, Ch); - end; - end; - end; - - St := UCS4ToString(USt); - - if Assigned(SimpleXML) then - begin - SimpleXML.DoDecodeValue(St); - - TrimValue := St; - if sxoTrimPrecedingTextWhitespace in SimpleXML.Options then - TrimValue := TrimLeft(TrimValue); - if sxoTrimFollowingTextWhitespace in SimpleXML.Options then - TrimValue := TrimRight(TrimValue); - if (TrimValue <> '') or not (sxoKeepWhitespace in SimpleXML.Options) then - St := TrimValue; - end; - - Value := St; - Name := ''; - - if SimpleXML <> nil then - SimpleXML.DoValueParsed('', St); -end; - -procedure TJclSimpleXMLElemText.SaveToStringStream(StringStream: TJclStringStream; const Level: string); -var - St, tmp: string; -begin - // should never be used - if Value <> '' then - begin - tmp := Value; - if SimpleXML <> nil then - SimpleXML.DoEncodeValue(tmp); - if (SimpleXML <> nil) and (sxoAutoIndent in SimpleXML.Options) then - St := Level + tmp + sLineBreak - else - St := Level + tmp; - StringStream.WriteString(St, 1, Length(St)); - end; - if SimpleXML <> nil then - SimpleXML.DoSaveProgress; -end; - -//=== { TJclSimpleXMLElemProcessingInstruction } ============================= - -procedure TJclSimpleXMLElemProcessingInstruction.LoadFromStringStream( - StringStream: TJclStringStream); -type - TReadStatus = (rsWaitingOpeningTag, rsOpeningTag, rsOpeningName, rsEndTag1, rsEndTag2); -var - lPos: TReadStatus; - lOk: Boolean; - St, lName, lNameSpace: TUCS4Array; - Ch: UCS4; -begin - SetLength(St, 0); - SetLength(lName, 0); - SetLength(lNameSpace, 0); - lPos := rsWaitingOpeningTag; - lOk := False; - - if SimpleXML <> nil then - SimpleXML.DoLoadProgress(StringStream.Stream.Position, StringStream.Stream.Size); - - while StringStream.ReadUCS4(Ch) do - begin - case lPos of - rsWaitingOpeningTag: // wait beginning of tag - if Ch = Ord('<') then - lPos := rsOpeningTag - else - if not UnicodeIsWhiteSpace(Ch) then - FmtError(LoadResString(@RsEInvalidXMLElementExpectedBeginningO), [UCS4ToChar(Ch), StringStream.PeekPosition]); - - rsOpeningTag: - if Ch = Ord('?') then - lPos := rsOpeningName // read name - else - FmtError(LoadResString(@RsEInvalidXMLElementMalformedTagFoundn), [StringStream.PeekPosition]); - - rsOpeningName: - if UnicodeIsIdentifierPart(Ch) or (Ch = Ord('-')) or (Ch = Ord('.')) then - UCS4ArrayConcat(St, Ch) - else - if (Ch = Ord(':')) and (Length(lNameSpace) = 0) then - begin - lNameSpace := St; - SetLength(St, 0); - end - else - if UnicodeIsWhiteSpace(Ch) and (Length(St) = 0) then - // whitespace after "<" (no name) - FmtError(LoadResString(@RsEInvalidXMLElementMalformedTagFoundn), [StringStream.PeekPosition]) - else - if UnicodeIsWhiteSpace(Ch) then - begin - lName := St; - SetLength(St, 0); - Properties.LoadFromStringStream(StringStream); - lPos := rsEndTag1; - end - else - if Ch = Ord('?') then - begin - lName := St; - lPos := rsEndTag2; - end - else - // other invalid characters - FmtError(LoadResString(@RsEInvalidXMLElementMalformedTagFoundn), [StringStream.PeekPosition]); - - rsEndTag1: - if Ch = Ord('?') then - lPos := rsEndTag2 - else - if not UnicodeIsWhiteSpace(Ch) then - FmtError(LoadResString(@RsEInvalidXMLElementExpectedEndOfTagBu), [UCS4ToChar(Ch), StringStream.PeekPosition]); - - rsEndTag2: - if Ch = Ord('>') then - begin - lOk := True; - Break; - end - else - FmtError(LoadResString(@RsEInvalidXMLElementExpectedEndOfTagBu), [UCS4ToChar(Ch), StringStream.PeekPosition]); - end; - end; - - if not lOk then - FmtError(LoadResString(@RsEInvalidCommentUnexpectedEndOfData), [StringStream.PeekPosition]); - - Name := UCS4ToString(lName); - NameSpace := UCS4ToString(lNameSpace); -end; - -procedure TJclSimpleXMLElemProcessingInstruction.SaveToStringStream( - StringStream: TJclStringStream; const Level: string); -var - St: string; -begin - St := Level + ' '' then - St := St + NameSpace + ':' + Name - else - St := St + Name; - StringStream.WriteString(St, 1, Length(St)); - if Assigned(FProps) then - FProps.SaveToStringStream(StringStream); - if (SimpleXML <> nil) and (sxoAutoIndent in SimpleXML.Options) then - St := '?>' + sLineBreak - else - St := '?>'; - StringStream.WriteString(St, 1, Length(St)); - if SimpleXML <> nil then - SimpleXML.DoSaveProgress; -end; - -//=== { TJclSimpleXMLElemHeader } ============================================ - -constructor TJclSimpleXMLElemHeader.Create; -begin - inherited Create; - - Name := 'xml'; -end; - -function TJclSimpleXMLElemHeader.GetEncoding: string; -var - ASimpleXML: TJclSimpleXML; - DefaultCodePage: Word; -begin - ASimpleXML := SimpleXML; - if Assigned(ASimpleXML) then - begin - DefaultCodePage := ASimpleXML.CodePage; - {$IFDEF MSWINDOWS} - if DefaultCodePage = CP_ACP then - DefaultCodePage := GetAcp; - {$ENDIF MSWINDOWS} - end - else - {$IFDEF UNICODE} - DefaultCodePage := CP_UTF16LE; - {$ELSE ~UNICODE} - {$IFDEF MSWINDOWS} - DefaultCodePage := GetACP; - {$ELSE ~MSWINDOWS} - DefaultCodePage := 1252; - {$ENDIF ~MSWINDOWS} - {$ENDIF ~UNICODE} - Result := Properties.Value('encoding', CharsetNameFromCodePage(DefaultCodePage)); -end; - -function TJclSimpleXMLElemHeader.GetStandalone: Boolean; -begin - Result := Properties.Value('standalone') = 'yes'; -end; - -function TJclSimpleXMLElemHeader.GetVersion: string; -begin - Result := Properties.Value('version', '1.0'); -end; - -procedure TJclSimpleXMLElemHeader.LoadFromStringStream(StringStream: TJclStringStream); -// -var - CodePage: Word; - EncodingProp: TJclSimpleXMLProp; -begin - inherited LoadFromStringStream(StringStream); - - if Assigned(FProps) then - EncodingProp := FProps.ItemNamed['encoding'] - else - EncodingProp := nil; - if Assigned(EncodingProp) and (EncodingProp.Value <> '') then - CodePage := CodePageFromCharsetName(EncodingProp.Value) - else - CodePage := CP_ACP; - - // set current stringstream codepage - if StringStream is TJclAutoStream then - TJclAutoStream(StringStream).CodePage := CodePage - else - if StringStream is TJclAnsiStream then - TJclAnsiStream(StringStream).CodePage := CodePage - else - if not (StringStream is TJclUTF8Stream) and not (StringStream is TJclUTF16Stream) then - Error(LoadResString(@RsENoCharset)); -end; - -procedure TJclSimpleXMLElemHeader.SaveToStringStream( - StringStream: TJclStringStream; const Level: string); -begin - SetVersion(GetVersion); - SetEncoding(GetEncoding); - SetStandalone(GetStandalone); - Properties.SortProperties(['version', 'encoding', 'standalone']); - - inherited SaveToStringStream(StringStream, Level); -end; - -procedure TJclSimpleXMLElemHeader.SetEncoding(const Value: string); -var - Prop: TJclSimpleXMLProp; -begin - Prop := Properties.ItemNamed['encoding']; - if Assigned(Prop) then - Prop.Value := Value - else - Properties.Add('encoding', Value); -end; - -procedure TJclSimpleXMLElemHeader.SetStandalone(const Value: Boolean); -var - Prop: TJclSimpleXMLProp; -const - BooleanValues: array [Boolean] of string = ('no', 'yes'); -begin - Prop := Properties.ItemNamed['standalone']; - if Assigned(Prop) then - Prop.Value := BooleanValues[Value] - else - Properties.Add('standalone', BooleanValues[Value]); -end; - -procedure TJclSimpleXMLElemHeader.SetVersion(const Value: string); -var - Prop: TJclSimpleXMLProp; -begin - Prop := Properties.ItemNamed['version']; - if Assigned(Prop) then - Prop.Value := Value - else - // Various XML parsers (including MSIE, Firefox) require the "version" to be the first - Properties.Insert(0, 'version', Value); -end; - -//=== { TJclSimpleXMLElemDocType } =========================================== - -procedure TJclSimpleXMLElemDocType.LoadFromStringStream(StringStream: TJclStringStream); -{ - - -' > -%xx; -]> - - -} -const - CS_START_DOCTYPE = ''); - SetLength(St, 0); - - if SimpleXML <> nil then - SimpleXML.DoLoadProgress(StringStream.Stream.Position, StringStream.Stream.Size); - - while StringStream.ReadUCS4(Ch) do - begin - case lPos of - 1..9: // or > - if lChar = Ch then - begin - if lChar = Ord('>') then - begin - lOk := True; - Break; //This is the end - end - else - begin - UCS4ArrayConcat(St, Ch); - lChar := Ord('>'); - end; - end - else - begin - UCS4ArrayConcat(St, Ch); - if Ch = Ord('[') then - lChar := Ord(']'); - end; - end; - end; - - if not lOk then - FmtError(LoadResString(@RsEInvalidCommentUnexpectedEndOfData), [StringStream.PeekPosition]); - - Name := ''; - Value := StrTrimCharsLeft(UCS4ToString(St), CharIsWhiteSpace); - - if SimpleXML <> nil then - SimpleXML.DoValueParsed('', Value); -end; - -procedure TJclSimpleXMLElemDocType.SaveToStringStream(StringStream: TJclStringStream; - const Level: string); -var - St: string; -begin - if (SimpleXML <> nil) and (sxoAutoIndent in SimpleXML.Options) then - St := Level + '' + sLineBreak - else - St := Level + ''; - StringStream.WriteString(St, 1, Length(St)); - if SimpleXML <> nil then - SimpleXML.DoSaveProgress; -end; - -//=== { TJclSimpleXMLElemsPrologEnumerator } ================================= - -{$IFDEF SUPPORTS_FOR_IN} -constructor TJclSimpleXMLElemsPrologEnumerator.Create(AList: TJclSimpleXMLElemsProlog); -begin - inherited Create; - FIndex := -1; - FList := AList; -end; - -function TJclSimpleXMLElemsPrologEnumerator.GetCurrent: TJclSimpleXMLElem; -begin - Result := FList[FIndex]; -end; - -function TJclSimpleXMLElemsPrologEnumerator.MoveNext: Boolean; -begin - Result := FIndex < FList.Count - 1; - if Result then - Inc(FIndex); -end; -{$ENDIF SUPPORTS_FOR_IN} - -//=== { TJclSimpleXMLElemsProlog } =========================================== - -constructor TJclSimpleXMLElemsProlog.Create(ASimpleXML: TJclSimpleXML); -var - CaseSensitive: Boolean; -begin - inherited Create; - FSimpleXML := ASimpleXML; - CaseSensitive := Assigned(ASimpleXML) and (sxoCaseSensitive in ASimpleXML.Options); - FElems := TJclSimpleItemHashedList.Create(CaseSensitive); -end; - -destructor TJclSimpleXMLElemsProlog.Destroy; -begin - Clear; - FreeAndNil(FElems); - inherited Destroy; -end; - -procedure TJclSimpleXMLElemsProlog.Clear; -begin - FElems.Clear; -end; - -function TJclSimpleXMLElemsProlog.GetCount: Integer; -begin - Result := FElems.Count; -end; - -function TJclSimpleXMLElemsProlog.GetItem(const Index: Integer): TJclSimpleXMLElem; -begin - Result := TJclSimpleXMLElem(FElems.SimpleItems[Index]); -end; - -procedure TJclSimpleXMLElemsProlog.LoadFromStringStream(StringStream: TJclStringStream); -{ - - -]> -Hello, world! - - Hello, world! -} -var - lPos: Integer; - St: TUCS4Array; - lEnd: Boolean; - lElem: TJclSimpleXMLElem; - Ch: UCS4; -begin - SetLength(St, 0); - lPos := 0; - - if SimpleXML <> nil then - SimpleXML.DoLoadProgress(StringStream.Stream.Position, StringStream.Stream.Size); - - while StringStream.PeekUCS4(Ch) do - begin - case lPos of - 0: //We are waiting for a tag and thus avoiding spaces and any BOM - begin - if UnicodeIsWhiteSpace(Ch) then - // still waiting - else - if Ch = Ord('<') then - begin - lPos := 1; - St := UCS4Array(Ch); - end - else - FmtError(LoadResString(@RsEInvalidDocumentUnexpectedTextInFile), [StringStream.PeekPosition]); - end; - 1: //We are trying to determine the kind of the tag - begin - lElem := nil; - lEnd := False; - - if not UCS4ArrayEquals(St, ' 3) and (St[1] = Ord('?')) and UnicodeIsWhiteSpace(St[High(St)]) then - lElem := TJclSimpleXMLElemProcessingInstruction.Create(SimpleXML) - else - if (Length(St) > 1) and (St[1] <> Ord('!')) and (St[1] <> Ord('?')) then - lEnd := True; - - if lEnd then - Break - else - if lElem <> nil then - begin - FElems.Add(lElem); - lElem.LoadFromStringStream(StringStream); - SetLength(St, 0); - lPos := 0; - end; - end; - end; - end; -end; - -procedure TJclSimpleXMLElemsProlog.SaveToStringStream(StringStream: TJclStringStream); -var - I: Integer; -begin - FindHeader; - for I := 0 to Count - 1 do - Item[I].SaveToStringStream(StringStream, ''); -end; - -function VarXML: TVarType; -begin - Result := XMLVariant.VarType; -end; - -procedure XMLCreateInto(var ADest: Variant; const AXML: TJclSimpleXMLElem); -begin - TVarData(ADest).vType := VarXML; - TVarData(ADest).vAny := AXML; -end; - -function XMLCreate(const AXML: TJclSimpleXMLElem): Variant; -begin - XMLCreateInto(Result, AXML); -end; - -function XMLCreate: Variant; -begin - XMLCreateInto(Result, TJclSimpleXMLElemClassic.Create(nil)); -end; - -//=== { TXMLVariant } ======================================================== - -procedure TXMLVariant.CastTo(var Dest: TVarData; const Source: TVarData; - const AVarType: TVarType); -var - StorageStream: TStringStream; - ConversionString: TJclStringStream; -begin - if Source.vType = VarType then - begin - case AVarType of - varOleStr: - begin - StorageStream := TStringStream.Create(''); - try - ConversionString := TJclUTF16Stream.Create(StorageStream, False); - try - ConversionString.WriteBOM; - TJclSimpleXMLElem(Source.vAny).SaveToStringStream(ConversionString, ''); - ConversionString.Flush; - finally - ConversionString.Free; - end; - VarDataFromOleStr(Dest, StorageStream.DataString); - finally - StorageStream.Free; - end; - end; - varString: - begin - StorageStream := TStringStream.Create(''); - try - {$IFDEF SUPPORTS_UNICODE} - ConversionString := TJclUTF16Stream.Create(StorageStream, False); - {$ELSE ~SUPPORTS_UNICODE} - ConversionString := TJclAnsiStream.Create(StorageStream, False); - {$ENDIF ~SUPPORTS_UNICODE} - try - ConversionString.WriteBOM; - TJclSimpleXMLElem(Source.vAny).SaveToStringStream(ConversionString, ''); - ConversionString.Flush; - finally - ConversionString.Free; - end; - VarDataFromStr(Dest, StorageStream.DataString); - finally - StorageStream.Free; - end; - end; - {$IFDEF SUPPORTS_UNICODE_STRING} - varUString: - begin - StorageStream := TStringStream.Create(''); - try - ConversionString := TJclUTF16Stream.Create(StorageStream, False); - try - ConversionString.WriteBOM; - TJclSimpleXMLElem(Source.vAny).SaveToStringStream(ConversionString, ''); - ConversionString.Flush; - finally - ConversionString.Free; - end; - VarDataClear(Dest); - Dest.VUString := nil; - Dest.VType := varUString; - UnicodeString(Dest.VUString) := UnicodeString(StorageStream.DataString); - finally - StorageStream.Free; - end; - end; - {$ENDIF SUPPORTS_UNICODE_STRING} - else - RaiseCastError; - end; - end - else - inherited CastTo(Dest, Source, AVarType); -end; - -procedure TXMLVariant.Clear(var V: TVarData); -begin - V.vType := varEmpty; - V.vAny := nil; -end; - -procedure TXMLVariant.Copy(var Dest: TVarData; const Source: TVarData; - const Indirect: Boolean); -begin - if Indirect and VarDataIsByRef(Source) then - VarDataCopyNoInd(Dest, Source) - else - begin - Dest.vType := Source.vType; - Dest.vAny := Source.vAny; - end; -end; - -function TXMLVariant.DoFunction(var Dest: TVarData; const V: TVarData; - const Name: string; const Arguments: TVarDataArray): Boolean; -var - VXML, LXML: TJclSimpleXMLElem; - VElems: TJclSimpleXMLElems; - I, J, K: Integer; -begin - Result := False; - if (Length(Arguments) = 1) and (Arguments[0].vType in [vtInteger, vtExtended]) then - begin - VXML := TJclSimpleXMLElem(V.VAny); - K := Arguments[0].vInteger; - J := 0; - - if (K > 0) and VXML.HasItems then - begin - VElems := VXML.Items; - for I := 0 to VElems.Count - 1 do - if UpperCase(VElems.Item[I].Name) = Name then - begin - Inc(J); - if J = K then - Break; - end; - end; - - if (J = K) and (J < VXML.ItemCount) then - begin - LXML := VXML.Items[J]; - if LXML <> nil then - begin - Dest.vType := VarXML; - Dest.vAny := Pointer(LXML); - Result := True; - end - end; - end -end; - -function TXMLVariant.GetProperty(var Dest: TVarData; const V: TVarData; - const Name: string): Boolean; -var - VXML, LXML: TJclSimpleXMLElem; - lProp: TJclSimpleXMLProp; -begin - Result := False; - VXML := TJclSimpleXMLElem(V.VAny); - if VXML.HasItems then - begin - LXML := VXML.Items.ItemNamed[Name]; - if LXML <> nil then - begin - Dest.vType := VarXML; - Dest.vAny := Pointer(LXML); - Result := True; - end; - end; - if (not Result) and VXML.HasProperties then - begin - lProp := VXML.Properties.ItemNamed[Name]; - if lProp <> nil then - begin - VarDataFromOleStr(Dest, lProp.Value); - Result := True; - end; - end; -end; - -function TXMLVariant.IsClear(const V: TVarData): Boolean; -var - VXML: TJclSimpleXMLElem; -begin - VXML := TJclSimpleXMLElem(V.VAny); - Result := (VXML = nil) or (not VXML.HasItems); -end; - -function TXMLVariant.SetProperty(const V: TVarData; const Name: string; - const Value: TVarData): Boolean; - - function GetStrValue: string; - begin - try - Result := Value.VOleStr; - except - Result := ''; - end; - end; - -var - VXML, LXML: TJclSimpleXMLElem; - lProp: TJclSimpleXMLProp; -begin - Result := False; - VXML := TJclSimpleXMLElem(V.VAny); - if VXML.HasItems then - begin - LXML := VXML.Items.ItemNamed[Name]; - if LXML <> nil then - begin - LXML.Value := GetStrValue; - Result := True; - end; - end; - if (not Result) and VXML.HasProperties then - begin - lProp := VXML.Properties.ItemNamed[Name]; - if lProp <> nil then - begin - lProp.Value := GetStrValue; - Result := True; - end; - end; -end; - -procedure TJclSimpleXMLElemsProlog.Error(const S: string); -begin - raise EJclSimpleXMLError.Create(S); -end; - -procedure TJclSimpleXMLElemsProlog.FmtError(const S: string; - const Args: array of const); -begin - Error(Format(S, Args)); -end; - -procedure TJclSimpleXML.SetIndentString(const Value: string); -begin - // test if the new value is only made of spaces or tabs - if not StrContainsChars(Value, CharIsWhiteSpace, True) then - Exit; - FIndentString := Value; -end; - -procedure TJclSimpleXML.SetRoot(const Value: TJclSimpleXMLElemClassic); -begin - if Value <> FRoot then - begin -// FRoot.FSimpleXML := nil; - FRoot := Value; -// FRoot.FSimpleXML := Self; - end; -end; - -function TJclSimpleXMLElemsProlog.GetEncoding: string; -var - Elem: TJclSimpleXMLElemHeader; -begin - Elem := TJclSimpleXMLElemHeader(FindHeader); - if Elem <> nil then - Result := Elem.Encoding - else - Result := 'UTF-8'; -end; - -{$IFDEF SUPPORTS_FOR_IN} -function TJclSimpleXMLElemsProlog.GetEnumerator: TJclSimpleXMLElemsPrologEnumerator; -begin - Result := TJclSimpleXMLElemsPrologEnumerator.Create(Self); -end; -{$ENDIF SUPPORTS_FOR_IN} - -function TJclSimpleXMLElemsProlog.GetStandalone: Boolean; -var - Elem: TJclSimpleXMLElemHeader; -begin - Elem := TJclSimpleXMLElemHeader(FindHeader); - if Elem <> nil then - Result := Elem.Standalone - else - Result := False; -end; - -function TJclSimpleXMLElemsProlog.GetVersion: string; -var - Elem: TJclSimpleXMLElemHeader; -begin - Elem := TJclSimpleXMLElemHeader(FindHeader); - if Elem <> nil then - Result := Elem.Version - else - Result := '1.0'; -end; - -procedure TJclSimpleXMLElemsProlog.SetEncoding(const Value: string); -var - Elem: TJclSimpleXMLElemHeader; -begin - Elem := TJclSimpleXMLElemHeader(FindHeader); - if Elem <> nil then - Elem.Encoding := Value; -end; - -procedure TJclSimpleXMLElemsProlog.SetStandalone(const Value: Boolean); -var - Elem: TJclSimpleXMLElemHeader; -begin - Elem := TJclSimpleXMLElemHeader(FindHeader); - if Elem <> nil then - Elem.Standalone := Value; -end; - -procedure TJclSimpleXMLElemsProlog.SetVersion(const Value: string); -var - Elem: TJclSimpleXMLElemHeader; -begin - Elem := TJclSimpleXMLElemHeader(FindHeader); - if Elem <> nil then - Elem.Version := Value; -end; - -function TJclSimpleXMLElemsProlog.FindHeader: TJclSimpleXMLElem; -var - I: Integer; -begin - for I := 0 to Count - 1 do - if Item[I] is TJclSimpleXMLElemHeader then - begin - Result := Item[I]; - Exit; - end; - // (p3) if we get here, an xml header was not found - Result := TJclSimpleXMLElemHeader.Create(SimpleXML); - FElems.Add(Result); -end; - -function TJclSimpleXMLElemsProlog.AddStyleSheet(const AType, AHRef: string): TJclSimpleXMLElemSheet; -begin - // make sure there is an xml header - FindHeader; - Result := TJclSimpleXMLElemSheet.Create('xml-stylesheet'); - Result.Properties.Add('type',AType); - Result.Properties.Add('href',AHRef); - FElems.Add(Result); -end; - -function TJclSimpleXMLElemsProlog.AddMSOApplication(const AProgId : string): TJclSimpleXMLElemMSOApplication; -begin - // make sure there is an xml header - FindHeader; - Result := TJclSimpleXMLElemMSOApplication.Create('mso-application'); - Result.Properties.Add('progid',AProgId); - FElems.Add(Result); -end; - -function TJclSimpleXMLElemsProlog.AddComment(const AValue: string): TJclSimpleXMLElemComment; -begin - // make sure there is an xml header - FindHeader; - Result := TJclSimpleXMLElemComment.Create('', AValue); - FElems.Add(Result); -end; - -function TJclSimpleXMLElemsProlog.AddDocType(const AValue: string): TJclSimpleXMLElemDocType; -begin - // make sure there is an xml header - FindHeader; - Result := TJclSimpleXMLElemDocType.Create('', AValue); - FElems.Add(Result); -end; - -initialization - {$IFDEF UNITVERSIONING} - RegisterUnitVersion(HInstance, UnitVersioning); - {$ENDIF UNITVERSIONING} - -finalization - FreeAndNil(GlobalXMLVariant); - {$IFDEF UNITVERSIONING} - UnregisterUnitVersion(HInstance); - {$ENDIF UNITVERSIONING} - -end. +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JvSimpleXML.PAS, released on 2002-06-03. } +{ } +{ The Initial Developer of the Original Code is Sébastien Buysse [sbuysse att buypin dott com]. } +{ Portions created by Sébastien Buysse are Copyright (C) 2001 Sébastien Buysse. } +{ All Rights Reserved. } +{ } +{ Contributor(s): } +{ Christophe Paris, } +{ Florent Ouchet (move from the JVCL to the JCL) } +{ Teträm } +{ } +{**************************************************************************************************} +{ } +{ This unit contains Xml parser and writter classes } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +// Known Issues: This component does not parse the !DOCTYPE tags but preserves them + +unit JclSimpleXml; + +interface + +{$I jcl.inc} + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + {$IFDEF HAS_UNIT_RTLCONSTS} + System.RTLConsts, + {$ENDIF HAS_UNIT_RTLCONSTS} + {$IFDEF MSWINDOWS} + Winapi.Windows, // Delphi 2005 inline + {$ENDIF MSWINDOWS} + System.SysUtils, System.Classes, + System.Variants, + System.IniFiles, + System.Contnrs, + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF HAS_UNIT_RTLCONSTS} + RTLConsts, + {$ENDIF HAS_UNIT_RTLCONSTS} + {$IFDEF MSWINDOWS} + Windows, // Delphi 2005 inline + {$ENDIF MSWINDOWS} + SysUtils, Classes, + Variants, + IniFiles, + Contnrs, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclStreams; + +type + TJclSimpleItem = class(TObject) + private + FName: string; + protected + procedure SetName(const Value: string); virtual; + public + property Name: string read FName write SetName; + end; + +type + TJclSimpleItemHashedList = class(TObjectList) + private + FNameHash: TStringHash; + FCaseSensitive: Boolean; + function GetSimpleItemByName(const Name: string): TJclSimpleItem; + function GetSimpleItem(Index: Integer): TJclSimpleItem; + procedure SetCaseSensitive(const Value: Boolean); + protected + procedure Notify(Ptr: Pointer; Action: TListNotification); override; + public + constructor Create(ACaseSensitive: Boolean); + destructor Destroy; override; + function Add(Item: TJclSimpleItem): Integer; + function Extract(Item: TJclSimpleItem): TJclSimpleItem; + procedure Clear; override; + function IndexOfSimpleItem(Item: TJclSimpleItem): Integer; + function IndexOfName(const Name: string): Integer; + procedure Insert(Index: Integer; Item: TJclSimpleItem); + procedure InvalidateHash; + procedure Move(CurIndex, NewIndex: Integer); + property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive; + property SimpleItemByNames[const Name: string]: TJclSimpleItem read GetSimpleItemByName; + property SimpleItems[Index: Integer]: TJclSimpleItem read GetSimpleItem; + end; + +type + TJclSimpleData = class(TJclSimpleItem) + private + FValue: string; + FData: Pointer; + protected + function GetBoolValue: Boolean; + procedure SetBoolValue(const Value: Boolean); + function GetFloatValue: Extended; + procedure SetFloatValue(const Value: Extended); + function GetAnsiValue: AnsiString; + procedure SetAnsiValue(const Value: AnsiString); + function GetIntValue: Int64; + procedure SetIntValue(const Value: Int64); + public + constructor Create; overload; virtual; + constructor Create(const AName: string); overload; + constructor Create(const AName, AValue: string); overload; + property Value: string read FValue write FValue; + property AnsiValue: AnsiString read GetAnsiValue write SetAnsiValue; + property IntValue: Int64 read GetIntValue write SetIntValue; + property BoolValue: Boolean read GetBoolValue write SetBoolValue; + property FloatValue: Extended read GetFloatValue write SetFloatValue; + + property Data: Pointer read FData write FData; + end; + +type + TJclSimpleXMLData = class(TJclSimpleData) + private + FNameSpace: string; + public + function FullName:string; + property NameSpace: string read FNameSpace write FNameSpace; + end; + +type + TJclSimpleXML = class; + EJclSimpleXMLError = class(EJclError); + {$TYPEINFO ON} // generate RTTI for published properties + TJclSimpleXMLElem = class; + {$IFNDEF TYPEINFO_ON} + {$TYPEINFO OFF} + {$ENDIF ~TYPEINFO_ON} + TJclSimpleXMLElems = class; + TJclSimpleXMLProps = class; + TJclSimpleXMLElemsProlog = class; + TJclSimpleXMLNamedElems = class; + TJclSimpleXMLElemComment = class; + TJclSimpleXMLElemClassic = class; + TJclSimpleXMLElemCData = class; + TJclSimpleXMLElemDocType = class; + TJclSimpleXMLElemText = class; + TJclSimpleXMLElemHeader = class; + TJclSimpleXMLElemSheet = class; + TJclSimpleXMLElemMSOApplication = class; + TJclOnSimpleXMLParsed = procedure(Sender: TObject; const Name: string) of object; + TJclOnValueParsed = procedure(Sender: TObject; const Name, Value: string) of object; + TJclOnSimpleProgress = procedure(Sender: TObject; const Position, Total: Integer) of object; + + //Those hash stuffs are for future use only + //Plans are to replace current hash by this mechanism + TJclHashKind = (hkList, hkDirect); + PJclHashElem = ^TJclHashElem; + TJclHashElem = packed record + Next: PJclHashElem; + Obj: TObject; + end; + PJclHashRecord = ^TJclHashRecord; + TJclHashList = array [0..25] of PJclHashRecord; + PJclHashList = ^TJclHashList; + TJclHashRecord = packed record + Count: Byte; + case Kind: TJclHashKind of + hkList: (List: PJclHashList); + hkDirect: (FirstElem: PJclHashElem); + end; + + TJclSimpleXMLProp = class(TJclSimpleXMLData) + private + FParent: TJclSimpleXMLElem; + protected + function GetSimpleXML: TJclSimpleXML; + procedure SetName(const Value: string); override; + public + constructor Create(AParent: TJclSimpleXMLElem; const AName, AValue: string); + procedure SaveToStringStream(StringStream: TJclStringStream); + property Parent: TJclSimpleXMLElem read FParent; + property SimpleXML: TJclSimpleXML read GetSimpleXML; + end; + + {$IFDEF SUPPORTS_FOR_IN} + TJclSimpleXMLPropsEnumerator = class + private + FIndex: Integer; + FList: TJclSimpleXMLProps; + public + constructor Create(AList: TJclSimpleXMLProps); + function GetCurrent: TJclSimpleXMLProp; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + function MoveNext: Boolean; + property Current: TJclSimpleXMLProp read GetCurrent; + end; + {$ENDIF SUPPORTS_FOR_IN} + + TJclSimpleXMLProps = class(TObject) + private + FProperties: TStringList; + FParent: TJclSimpleXMLElem; + function GetCount: Integer; + function GetItemNamedDefault(const Name, Default: string): TJclSimpleXMLProp; + function GetItemNamed(const Name: string): TJclSimpleXMLProp; + protected + function GetSimpleXML: TJclSimpleXML; + function GetItem(const Index: Integer): TJclSimpleXMLProp; + procedure DoItemRename(Value: TJclSimpleXMLProp; const Name: string); + procedure Error(const S: string); + procedure FmtError(const S: string; const Args: array of const); + public + constructor Create(AParent: TJclSimpleXMLElem); + destructor Destroy; override; + procedure SortProperties(const Order: array of string); + function Add(const Name, Value: string): TJclSimpleXMLProp; overload; + {$IFDEF SUPPORTS_UNICODE} + function Add(const Name: string; const Value: AnsiString): TJclSimpleXMLProp; overload; + {$ENDIF SUPPORTS_UNICODE} + function Add(const Name: string; const Value: Int64): TJclSimpleXMLProp; overload; + function Add(const Name: string; const Value: Boolean): TJclSimpleXMLProp; overload; + function Insert(const Index: Integer; const Name, Value: string): TJclSimpleXMLProp; overload; + function Insert(const Index: Integer; const Name: string; const Value: Int64): TJclSimpleXMLProp; overload; + function Insert(const Index: Integer; const Name: string; const Value: Boolean): TJclSimpleXMLProp; overload; + procedure Clear; virtual; + procedure Delete(const Index: Integer); overload; + procedure Delete(const Name: string); overload; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: TJclSimpleXMLPropsEnumerator; + {$ENDIF SUPPORTS_FOR_IN} + function Value(const Name: string; const Default: string = ''): string; + function IntValue(const Name: string; const Default: Int64 = -1): Int64; + function BoolValue(const Name: string; Default: Boolean = True): Boolean; + function FloatValue(const Name: string; const Default: Extended = 0): Extended; + procedure LoadFromStringStream(StringStream: TJclStringStream); + procedure SaveToStringStream(StringStream: TJclStringStream); + property Item[const Index: Integer]: TJclSimpleXMLProp read GetItem; default; + property ItemNamed[const Name: string]: TJclSimpleXMLProp read GetItemNamed; + property Count: Integer read GetCount; + property Parent: TJclSimpleXMLElem read FParent; + end; + + {$IFDEF SUPPORTS_FOR_IN} + TJclSimpleXMLElemsPrologEnumerator = class + private + FIndex: Integer; + FList: TJclSimpleXMLElemsProlog; + public + constructor Create(AList: TJclSimpleXMLElemsProlog); + function GetCurrent: TJclSimpleXMLElem; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + function MoveNext: Boolean; + property Current: TJclSimpleXMLElem read GetCurrent; + end; + {$ENDIF SUPPORTS_FOR_IN} + + TJclSimpleXMLElemsProlog = class(TObject) + private + FElems: TJclSimpleItemHashedList; + function GetCount: Integer; + function GetItem(const Index: Integer): TJclSimpleXMLElem; + function GetEncoding: string; + function GetStandalone: Boolean; + function GetVersion: string; + procedure SetEncoding(const Value: string); + procedure SetStandalone(const Value: Boolean); + procedure SetVersion(const Value: string); + protected + FSimpleXML: TJclSimpleXML; + function FindHeader: TJclSimpleXMLElem; + procedure Error(const S: string); + procedure FmtError(const S: string; const Args: array of const); + public + constructor Create(ASimpleXML: TJclSimpleXML); + destructor Destroy; override; + function AddComment(const AValue: string): TJclSimpleXMLElemComment; + function AddDocType(const AValue: string): TJclSimpleXMLElemDocType; + procedure Clear; + function AddStyleSheet(const AType, AHRef: string): TJclSimpleXMLElemSheet; + function AddMSOApplication(const AProgId : string): TJclSimpleXMLElemMSOApplication; + procedure LoadFromStringStream(StringStream: TJclStringStream); + procedure SaveToStringStream(StringStream: TJclStringStream); + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: TJclSimpleXMLElemsPrologEnumerator; + {$ENDIF SUPPORTS_FOR_IN} + property Item[const Index: Integer]: TJclSimpleXMLElem read GetItem; default; + property Count: Integer read GetCount; + property Encoding: string read GetEncoding write SetEncoding; + property SimpleXML: TJclSimpleXML read FSimpleXML; + property Standalone: Boolean read GetStandalone write SetStandalone; + property Version: string read GetVersion write SetVersion; + end; + + {$IFDEF SUPPORTS_FOR_IN} + TJclSimpleXMLNamedElemsEnumerator = class + private + FIndex: Integer; + FList: TJclSimpleXMLNamedElems; + public + constructor Create(AList: TJclSimpleXMLNamedElems); + function GetCurrent: TJclSimpleXMLElem; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + function MoveNext: Boolean; + property Current: TJclSimpleXMLElem read GetCurrent; + end; + {$ENDIF SUPPORTS_FOR_IN} + + TJclSimpleXMLNamedElems = class(TJclSimpleItem) + private + FElems: TJclSimpleXMLElems; + function GetCount: Integer; + protected + FItems: TList; + function GetItem(const Index: Integer): TJclSimpleXMLElem; + procedure SetName(const Value: string); override; + public + constructor Create(AElems: TJclSimpleXMLElems; const AName: string); + destructor Destroy; override; + + function Add: TJclSimpleXMLElemClassic; overload; + function Add(const Value: string): TJclSimpleXMLElemClassic; overload; + function Add(const Value: Int64): TJclSimpleXMLElemClassic; overload; + function Add(const Value: Boolean): TJclSimpleXMLElemClassic; overload; + function Add(Value: TStream): TJclSimpleXMLElemClassic; overload; + function AddFirst: TJclSimpleXMLElemClassic; + function AddComment(const Value: string): TJclSimpleXMLElemComment; + function AddCData(const Value: string): TJclSimpleXMLElemCData; + function AddText(const Value: string): TJclSimpleXMLElemText; + procedure Clear; virtual; + procedure Delete(const Index: Integer); + procedure Move(const CurIndex, NewIndex: Integer); + function IndexOf(const Value: TJclSimpleXMLElem): Integer; overload; + function IndexOf(const Value: string): Integer; overload; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: TJclSimpleXMLNamedElemsEnumerator; + {$ENDIF SUPPORTS_FOR_IN} + + property Elems: TJclSimpleXMLElems read FElems; + property Item[const Index: Integer]: TJclSimpleXMLElem read GetItem; default; + property Count: Integer read GetCount; + end; + + {$IFDEF SUPPORTS_FOR_IN} + TJclSimpleXMLElemsEnumerator = class + private + FIndex: Integer; + FList: TJclSimpleXMLElems; + public + constructor Create(AList: TJclSimpleXMLElems); + function GetCurrent: TJclSimpleXMLElem; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + function MoveNext: Boolean; + property Current: TJclSimpleXMLElem read GetCurrent; + end; + {$ENDIF SUPPORTS_FOR_IN} + + TJclSimpleXMLElemCompare = function(Elems: TJclSimpleXMLElems; Index1, Index2: Integer): Integer of object; + TJclSimpleXMLElems = class(TObject) + private + FParent: TJclSimpleXMLElem; + function GetCount: Integer; + function GetItemNamedDefault(const Name, Default: string): TJclSimpleXMLElem; + function GetItemNamed(const Name: string): TJclSimpleXMLElem; + function GetNamedElems(const Name: string): TJclSimpleXMLNamedElems; + protected + FElems: TJclSimpleItemHashedList; + FCompare: TJclSimpleXMLElemCompare; + FNamedElems: TJclSimpleItemHashedList; + function GetItem(const Index: Integer): TJclSimpleXMLElem; + procedure AddChild(const Value: TJclSimpleXMLElem); + procedure AddChildFirst(const Value: TJclSimpleXMLElem); + procedure InsertChild(const Value: TJclSimpleXMLElem; Index: Integer); + procedure DoItemRename(Value: TJclSimpleXMLElem; const Name: string); + procedure CreateElems; + function SimpleCompare(Elems: TJclSimpleXMLElems; Index1, Index2: Integer): Integer; + public + constructor Create(AParent: TJclSimpleXMLElem); + destructor Destroy; override; + + // Use notify to indicate to a list that the given element is removed + // from the list so that it doesn't delete it as well as the one + // that insert it in itself. This method is automatically called + // by AddChild and AddChildFirst if the Container property of the + // given element is set. + procedure Notify(Value: TJclSimpleXMLElem; Operation: TOperation); + + function Add(const Name: string): TJclSimpleXMLElemClassic; overload; + function Add(const Name, Value: string): TJclSimpleXMLElemClassic; overload; + function Add(const Name: string; const Value: Int64): TJclSimpleXMLElemClassic; overload; + function Add(const Name: string; const Value: Boolean): TJclSimpleXMLElemClassic; overload; + function Add(const Name: string; Value: TStream; BufferSize: Integer = 0): TJclSimpleXMLElemClassic; overload; + function Add(Value: TJclSimpleXMLElem): TJclSimpleXMLElem; overload; + function AddFirst(Value: TJclSimpleXMLElem): TJclSimpleXMLElem; overload; + function AddFirst(const Name: string): TJclSimpleXMLElemClassic; overload; + function AddComment(const Name: string; const Value: string): TJclSimpleXMLElemComment; + function AddCData(const Name: string; const Value: string): TJclSimpleXMLElemCData; + function AddText(const Name: string; const Value: string): TJclSimpleXMLElemText; + function Insert(Value: TJclSimpleXMLElem; Index: Integer): TJclSimpleXMLElem; overload; + function Insert(const Name: string; Index: Integer): TJclSimpleXMLElemClassic; overload; + procedure Clear; virtual; + procedure Delete(const Index: Integer); overload; + procedure Delete(const Name: string); overload; + function Remove(Value: TJclSimpleXMLElem): Integer; + procedure Move(const CurIndex, NewIndex: Integer); + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: TJclSimpleXMLElemsEnumerator; + {$ENDIF SUPPORTS_FOR_IN} + function IndexOf(const Value: TJclSimpleXMLElem): Integer; overload; + function IndexOf(const Name: string): Integer; overload; + function Value(const Name: string; const Default: string = ''): string; + function IntValue(const Name: string; const Default: Int64 = -1): Int64; + function FloatValue(const Name: string; const Default: Extended = 0): Extended; + function BoolValue(const Name: string; Default: Boolean = True): Boolean; + procedure BinaryValue(const Name: string; Stream: TStream); + procedure LoadFromStringStream(StringStream: TJclStringStream); + procedure SaveToStringStream(StringStream: TJclStringStream; const Level: string = ''); + procedure Sort; + procedure CustomSort(AFunction: TJclSimpleXMLElemCompare); + property Parent: TJclSimpleXMLElem read FParent; + property Item[const Index: Integer]: TJclSimpleXMLElem read GetItem; default; + property ItemNamed[const Name: string]: TJclSimpleXMLElem read GetItemNamed; + property Count: Integer read GetCount; + property NamedElems[const Name: string]: TJclSimpleXMLNamedElems read GetNamedElems; + end; + + {$TYPEINFO ON} + TJclSimpleXMLElem = class(TJclSimpleXMLData) + private + FParent: TJclSimpleXMLElem; + FSimpleXML: TJclSimpleXML; + function GetHasItems: Boolean; + function GetHasProperties: Boolean; + function GetItemCount: Integer; + function GetPropertyCount: Integer; + protected + FItems: TJclSimpleXMLElems; + FProps: TJclSimpleXMLProps; + function GetChildsCount: Integer; + function GetProps: TJclSimpleXMLProps; + procedure SetName(const Value: string); override; + function GetItems: TJclSimpleXMLElems; + procedure Error(const S: string); + procedure FmtError(const S: string; const Args: array of const); + public + //constructor Create; overload; + //constructor Create(const AName: string); overload; + //constructor Create(const AName, AValue: string); overload; + constructor Create(ASimpleXML: TJclSimpleXML); overload; + destructor Destroy; override; + procedure Assign(Value: TJclSimpleXMLElem); virtual; + procedure Clear; virtual; + procedure LoadFromStringStream(StringStream: TJclStringStream); virtual; abstract; + procedure SaveToStringStream(StringStream: TJclStringStream; const Level: string = ''); virtual; + abstract; + procedure LoadFromString(const Value: string); + function SaveToString: string; + procedure GetBinaryValue(Stream: TStream; BufferSize: Integer = 0); + function GetChildIndex(const AChild: TJclSimpleXMLElem): Integer; + function GetNamedIndex(const AChild: TJclSimpleXMLElem): Integer; + + property SimpleXML: TJclSimpleXML read FSimpleXML; + published + property Parent: TJclSimpleXMLElem read FParent; + property ChildsCount: Integer read GetChildsCount; + property HasItems: Boolean read GetHasItems; + property HasProperties: Boolean read GetHasProperties; + property ItemCount: Integer read GetItemCount; + property PropertyCount: Integer read GetPropertyCount; + property Items: TJclSimpleXMLElems read GetItems; + property Properties: TJclSimpleXMLProps read GetProps; + end; + {$IFNDEF TYPEINFO_ON} + {$TYPEINFO OFF} + {$ENDIF ~TYPEINFO_ON} + TJclSimpleXMLElemClass = class of TJclSimpleXMLElem; + + TJclSimpleXMLElemComment = class(TJclSimpleXMLElem) + public + procedure LoadFromStringStream(StringStream: TJclStringStream); override; + procedure SaveToStringStream(StringStream: TJclStringStream; const Level: string = ''); override; + end; + + TJclSimpleXMLElemClassic = class(TJclSimpleXMLElem) + public + procedure LoadFromStringStream(StringStream: TJclStringStream); override; + procedure SaveToStringStream(StringStream: TJclStringStream; const Level: string = ''); override; + end; + + TJclSimpleXMLElemCData = class(TJclSimpleXMLElem) + public + procedure LoadFromStringStream(StringStream: TJclStringStream); override; + procedure SaveToStringStream(StringStream: TJclStringStream; const Level: string = ''); override; + end; + + TJclSimpleXMLElemText = class(TJclSimpleXMLElem) + public + procedure LoadFromStringStream(StringStream: TJclStringStream); override; + procedure SaveToStringStream(StringStream: TJclStringStream; const Level: string = ''); override; + end; + + TJclSimpleXMLElemProcessingInstruction = class(TJclSimpleXMLElem) + public + procedure LoadFromStringStream(StringStream: TJclStringStream); override; + procedure SaveToStringStream(StringStream: TJclStringStream; const Level: string = ''); override; + end; + + TJclSimpleXMLElemHeader = class(TJclSimpleXMLElemProcessingInstruction) + private + function GetEncoding: string; + function GetStandalone: Boolean; + function GetVersion: string; + procedure SetEncoding(const Value: string); + procedure SetStandalone(const Value: Boolean); + procedure SetVersion(const Value: string); + public + constructor Create; override; + + procedure LoadFromStringStream(StringStream: TJclStringStream); override; + procedure SaveToStringStream(StringStream: TJclStringStream; const Level: string = ''); override; + property Version: string read GetVersion write SetVersion; + property Standalone: Boolean read GetStandalone write SetStandalone; + property Encoding: string read GetEncoding write SetEncoding; + end; + + // for backward compatibility + TJclSimpleXMLElemSheet = class(TJclSimpleXMLElemProcessingInstruction) + end; + + // for backward compatibility + TJclSimpleXMLElemMSOApplication = class(TJclSimpleXMLElemProcessingInstruction) + end; + + TJclSimpleXMLElemDocType = class(TJclSimpleXMLElem) + public + procedure LoadFromStringStream(StringStream: TJclStringStream); override; + procedure SaveToStringStream(StringStream: TJclStringStream; const Level: string = ''); override; + end; + + TJclSimpleXMLOptions = set of (sxoAutoCreate, sxoAutoIndent, sxoAutoEncodeValue, + sxoAutoEncodeEntity, sxoDoNotSaveProlog, sxoTrimPrecedingTextWhitespace, + sxoTrimFollowingTextWhitespace, sxoKeepWhitespace, sxoDoNotSaveBOM, sxoCaseSensitive); + TJclSimpleXMLEncodeEvent = procedure(Sender: TObject; var Value: string) of object; + TJclSimpleXMLEncodeStreamEvent = procedure(Sender: TObject; InStream, OutStream: TStream) of object; + + TJclSimpleXML = class(TObject) + protected + FEncoding: TJclStringEncoding; + FCodePage: Word; + FFileName: TFileName; + FOptions: TJclSimpleXMLOptions; + FRoot: TJclSimpleXMLElemClassic; + FOnTagParsed: TJclOnSimpleXMLParsed; + FOnValue: TJclOnValueParsed; + FOnLoadProg: TJclOnSimpleProgress; + FOnSaveProg: TJclOnSimpleProgress; + FProlog: TJclSimpleXMLElemsProlog; + FSaveCount: Integer; + FSaveCurrent: Integer; + FIndentString: string; + FBaseIndentString: string; + FOnEncodeValue: TJclSimpleXMLEncodeEvent; + FOnDecodeValue: TJclSimpleXMLEncodeEvent; + FOnDecodeStream: TJclSimpleXMLEncodeStreamEvent; + FOnEncodeStream: TJclSimpleXMLEncodeStreamEvent; + procedure SetIndentString(const Value: string); + procedure SetBaseIndentString(const Value: string); + procedure SetRoot(const Value: TJclSimpleXMLElemClassic); + procedure SetFileName(const Value: TFileName); + protected + procedure DoLoadProgress(const APosition, ATotal: Integer); + procedure DoSaveProgress; + procedure DoTagParsed(const AName: string); + procedure DoValueParsed(const AName, AValue: string); + procedure DoEncodeValue(var Value: string); virtual; + procedure DoDecodeValue(var Value: string); virtual; + procedure GetEncodingFromXMLHeader(var Encoding: TJclStringEncoding; var CodePage: Word); + public + constructor Create; + destructor Destroy; override; + procedure LoadFromString(const Value: string); + procedure LoadFromFile(const FileName: TFileName; Encoding: TJclStringEncoding = seAuto; CodePage: Word = CP_ACP); + procedure LoadFromStream(Stream: TStream; Encoding: TJclStringEncoding = seAuto; CodePage: Word = CP_ACP); + procedure LoadFromStringStream(StringStream: TJclStringStream); + procedure LoadFromResourceName(Instance: THandle; const ResName: string; Encoding: TJclStringEncoding = seAuto; CodePage: Word = CP_ACP); + procedure SaveToFile(const FileName: TFileName; Encoding: TJclStringEncoding = seAuto; CodePage: Word = CP_ACP); + procedure SaveToStream(Stream: TStream; Encoding: TJclStringEncoding = seAuto; CodePage: Word = CP_ACP); + procedure SaveToStringStream(StringStream: TJclStringStream); + function SaveToString: string; + function SaveToStringEncoding(Encoding: TJclStringEncoding; CodePage: Word = CP_ACP): string; + property CodePage: Word read FCodePage; + property Prolog: TJclSimpleXMLElemsProlog read FProlog write FProlog; + property Root: TJclSimpleXMLElemClassic read FRoot write SetRoot; + property XMLData: string read SaveToString write LoadFromString; + property FileName: TFileName read FFileName write SetFileName; + property IndentString: string read FIndentString write SetIndentString; + property BaseIndentString: string read FBaseIndentString write SetBaseIndentString; + property Options: TJclSimpleXMLOptions read FOptions write FOptions; + property OnSaveProgress: TJclOnSimpleProgress read FOnSaveProg write FOnSaveProg; + property OnLoadProgress: TJclOnSimpleProgress read FOnLoadProg write FOnLoadProg; + property OnTagParsed: TJclOnSimpleXMLParsed read FOnTagParsed write FOnTagParsed; + property OnValueParsed: TJclOnValueParsed read FOnValue write FOnValue; + property OnEncodeValue: TJclSimpleXMLEncodeEvent read FOnEncodeValue write FOnEncodeValue; + property OnDecodeValue: TJclSimpleXMLEncodeEvent read FOnDecodeValue write FOnDecodeValue; + property OnEncodeStream: TJclSimpleXMLEncodeStreamEvent read FOnEncodeStream write FOnEncodeStream; + property OnDecodeStream: TJclSimpleXMLEncodeStreamEvent read FOnDecodeStream write FOnDecodeStream; + end; + + TXMLVariant = class(TInvokeableVariantType) + public + procedure Clear(var V: TVarData); override; + function IsClear(const V: TVarData): Boolean; override; + procedure Copy(var Dest: TVarData; const Source: TVarData; + const Indirect: Boolean); override; + procedure CastTo(var Dest: TVarData; const Source: TVarData; + const AVarType: TVarType); override; + + function DoFunction(var Dest: TVarData; const V: TVarData; + const Name: string; const Arguments: TVarDataArray): Boolean; override; + function GetProperty(var Dest: TVarData; const V: TVarData; + const Name: string): Boolean; override; + function SetProperty(const V: TVarData; const Name: string; + const Value: TVarData): Boolean; override; + end; + +procedure XMLCreateInto(var ADest: Variant; const AXML: TJclSimpleXMLElem); +function XMLCreate(const AXML: TJclSimpleXMLElem): Variant; overload; +function XMLCreate: Variant; overload; +function VarXML: TVarType; + +// Encodes a string into an internal format: +// any character TAB,LF,CR,#32..#127 is preserved +// all other characters are converted to hex notation except +// for some special characters that are converted to XML entities +function SimpleXMLEncode(const S: string): string; +// Decodes a string encoded with SimpleXMLEncode: +// any character TAB,LF,CR,#32..#127 is preserved +// all other characters and substrings are converted from +// the special XML entities to characters or from hex to characters +// NB! Setting TrimBlanks to true will slow down the process considerably +procedure SimpleXMLDecode(var S: string; TrimBlanks: Boolean); + +function XMLEncode(const S: string): string; +function XMLDecode(const S: string): string; + +// Encodes special characters (', ", <, > and &) into XML entities (@apos;, ", <, > and &) +function EntityEncode(const S: string): string; +// Decodes XML entities (@apos;, ", <, > and &) into special characters (', ", <, > and &) +function EntityDecode(const S: string): string; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.Types, + {$ENDIF HAS_UNITSCOPE} + JclCharsets, + JclStrings, + JclUnicode, + JclStringConversions, + JclResources; + +const + cBufferSize = 8192; + +var + GlobalXMLVariant: TXMLVariant = nil; + + PreparedNibbleCharMapping: Boolean = False; + NibbleCharMapping: array [Low(Char)..High(Char)] of Byte; + +function XMLVariant: TXMLVariant; +begin + if not Assigned(GlobalXMLVariant) then + GlobalXMLVariant := TXMLVariant.Create; + Result := GlobalXMLVariant; +end; + +procedure AddEntity(var Res: string; var ResIndex, ResLen: Integer; const Entity: string); +var + EntityIndex, EntityLen: Integer; +begin + EntityLen := Length(Entity); + if (ResIndex + EntityLen) > ResLen then + begin + if ResLen <= EntityLen then + ResLen := ResLen * EntityLen + else + ResLen := ResLen * 2; + SetLength(Res, ResLen); + end; + for EntityIndex := 1 to EntityLen do + begin + Res[ResIndex] := Entity[EntityIndex]; + Inc(ResIndex); + end; +end; + +function EntityEncode(const S: string): string; +var + C: Char; + SIndex, SLen, RIndex, RLen: Integer; + Tmp: string; +begin + SLen := Length(S); + RLen := SLen; + RIndex := 1; + SetLength(Tmp, RLen); + for SIndex := 1 to SLen do + begin + C := S[SIndex]; + case C of + '"': + AddEntity(Tmp, RIndex, RLen, '"'); + '&': + AddEntity(Tmp, RIndex, RLen, '&'); + #39: + AddEntity(Tmp, RIndex, RLen, '''); + '<': + AddEntity(Tmp, RIndex, RLen, '<'); + '>': + AddEntity(Tmp, RIndex, RLen, '>'); + else + if RIndex > RLen then + begin + RLen := RLen * 2; + SetLength(Tmp, RLen); + end; + Tmp[RIndex] := C; + Inc(RIndex); + end; + end; + if RIndex > 1 then + SetLength(Tmp, RIndex - 1); + + Result := Tmp; +end; + +function EntityDecode(const S: string): string; +var + I, J, L: Integer; +begin + Result := S; + I := 1; + J := 1; + L := Length(Result); + + while I <= L do + begin + if Result[I] = '&' then + begin + if StrSame(Copy(Result, I, 5), '&') then + begin + Result[J] := '&'; + Inc(J); + Inc(I, 4); + end + else + if StrSame(Copy(Result, I, 4), '<') then + begin + Result[J] := '<'; + Inc(J); + Inc(I, 3); + end + else + if StrSame(Copy(Result, I, 4), '>') then + begin + Result[J] := '>'; + Inc(J); + Inc(I, 3); + end + else + if StrSame(Copy(Result, I, 6), ''') then + begin + Result[J] := #39; + Inc(J); + Inc(I, 5); + end + else + if StrSame(Copy(Result, I, 6), '"') then + begin + Result[J] := '"'; + Inc(J); + Inc(I, 5); + end + else + begin + Result[J] := Result[I]; + Inc(J); + end; + end + else + begin + Result[J] := Result[I]; + Inc(J); + end; + Inc(I); + end; + if J > 1 then + SetLength(Result, J - 1) + else + SetLength(Result, 0); +end; + +function SimpleXMLEncode(const S: string): string; +var + C: Char; + SIndex, SLen, RIndex, RLen: Integer; + Tmp: string; +begin + SLen := Length(S); + RLen := SLen; + RIndex := 1; + SetLength(Tmp, RLen); + for SIndex := 1 to SLen do + begin + C := S[SIndex]; + case C of + '"': + AddEntity(Tmp, RIndex, RLen, '"'); + '&': + AddEntity(Tmp, RIndex, RLen, '&'); + #39: + AddEntity(Tmp, RIndex, RLen, '''); + '<': + AddEntity(Tmp, RIndex, RLen, '<'); + '>': + AddEntity(Tmp, RIndex, RLen, '>'); + NativeNull..NativeBackspace, // NativeTab, NativeLineFeed + NativeVerticalTab..NativeFormFeed, // NativeCarriageReturn + NativeSo..NativeUs, + Char(128)..Char(255): + AddEntity(Tmp, RIndex, RLen, Format('&#x%.2x;', [Ord(C)])); + {$IFDEF SUPPORTS_UNICODE} + Char(256)..High(Char): + AddEntity(Tmp, RIndex, RLen, Format('&#x%.4x;', [Ord(C)])); + {$ENDIF SUPPORTS_UNICODE} + else + if RIndex > RLen then + begin + RLen := RLen * 2; + SetLength(Tmp, RLen); + end; + Tmp[RIndex] := C; + Inc(RIndex); + end; + end; + if RIndex > 1 then + SetLength(Tmp, RIndex - 1); + + Result := Tmp; +end; + +procedure SimpleXMLDecode(var S: string; TrimBlanks: Boolean); + procedure DecodeEntity(var S: string; StringLength: Cardinal; + var ReadIndex, WriteIndex: Cardinal); + const + cHexPrefix: array [Boolean] of string = ('', '$'); + var + I: Cardinal; + Value: Integer; + IsHex: Boolean; + begin + Inc(ReadIndex, 2); + IsHex := (ReadIndex <= StringLength) and ((S[ReadIndex] = 'x') or (S[ReadIndex] = 'X')); + Inc(ReadIndex, Ord(IsHex)); + I := ReadIndex; + while ReadIndex <= StringLength do + begin + if S[ReadIndex] = ';' then + begin + Value := StrToIntDef(cHexPrefix[IsHex] + Copy(S, I, ReadIndex - I), -1); // no characters are less than 0 + if Value >= 0 then + S[WriteIndex] := Chr(Value) + else + ReadIndex := I - (2 + Cardinal(IsHex)); // reset to start + Exit; + end; + Inc(ReadIndex); + end; + ReadIndex := I - (2 + Cardinal(IsHex)); // reset to start + end; + + procedure SkipBlanks(var S: string; StringLength: Cardinal; var ReadIndex: Cardinal); + begin + while ReadIndex < StringLength do + begin + if S[ReadIndex] = NativeCarriageReturn then + S[ReadIndex] := NativeLineFeed + else + if S[ReadIndex + 1] = NativeCarriageReturn then + S[ReadIndex + 1] := NativeLineFeed; + if (S[ReadIndex] < #33) and (S[ReadIndex] = S[ReadIndex + 1]) then + Inc(ReadIndex) + else + Exit; + end; + end; + +var + StringLength, ReadIndex, WriteIndex: Cardinal; +begin + // NB! This procedure replaces the text inplace to speed up the conversion. This + // works because when decoding, the string can only become shorter. This is + // accomplished by keeping track of the current read and write points. + // In addition, the original string length is read only once and passed to the + // inner procedures to speed up conversion as much as possible + ReadIndex := 1; + WriteIndex := 1; + StringLength := Length(S); + while ReadIndex <= StringLength do + begin + // this call lowers conversion speed by ~30%, ie 21MB/sec -> 15MB/sec (repeated tests, various inputs) + if TrimBlanks then + SkipBlanks(S, StringLength, ReadIndex); + if S[ReadIndex] = '&' then + begin + if (ReadIndex < StringLength) and (S[ReadIndex + 1] = '#') then + begin + DecodeEntity(S, StringLength, ReadIndex, WriteIndex); + Inc(WriteIndex); + end + else + if StrSame(Copy(S, ReadIndex, 5), '&') then + begin + S[WriteIndex] := '&'; + Inc(WriteIndex); + Inc(ReadIndex, 4); + end + else + if StrSame(Copy(S, ReadIndex, 4), '<') then + begin + S[WriteIndex] := '<'; + Inc(WriteIndex); + Inc(ReadIndex, 3); + end + else + if StrSame(Copy(S, ReadIndex, 4), '>') then + begin + S[WriteIndex] := '>'; + Inc(WriteIndex); + Inc(ReadIndex, 3); + end + else + if StrSame(Copy(S, ReadIndex, 6), ''') then + begin + S[WriteIndex] := #39; + Inc(WriteIndex); + Inc(ReadIndex, 5); + end + else + if StrSame(Copy(S, ReadIndex, 6), '"') then + begin + S[WriteIndex] := '"'; + Inc(WriteIndex); + Inc(ReadIndex, 5); + end + else + begin + S[WriteIndex] := S[ReadIndex]; + Inc(WriteIndex); + end; + end + else + begin + S[WriteIndex] := S[ReadIndex]; + Inc(WriteIndex); + end; + Inc(ReadIndex); + end; + if WriteIndex > 0 then + SetLength(S, WriteIndex - 1) + else + SetLength(S, 0); + // this call lowers conversion speed by ~65%, ie 21MB/sec -> 7MB/sec (repeated tests, various inputs) +// if TrimBlanks then +// S := AdjustLineBreaks(S); +end; + +function XMLEncode(const S: string): string; +begin + Result := SimpleXMLEncode(S); +end; + +function XMLDecode(const S: string): string; +begin + Result := S; + SimpleXMLDecode(Result, False); +end; + +//=== { TJclSimpleItem } ===================================================== + +procedure TJclSimpleItem.SetName(const Value: string); +begin + FName := Value; +end; + +//=== { TJclSimpleItemHashedList } =========================================== + +procedure TJclSimpleItemHashedList.Clear; +begin + InvalidateHash; + inherited Clear; +end; + +constructor TJclSimpleItemHashedList.Create(ACaseSensitive: Boolean); +begin + inherited Create(True); + FCaseSensitive := ACaseSensitive; +end; + +destructor TJclSimpleItemHashedList.Destroy; +begin + FreeAndNil(FNameHash); + inherited Destroy; +end; + +function TJclSimpleItemHashedList.Add(Item: TJclSimpleItem): Integer; +begin + Result := inherited Add(Item); + if FNameHash <> nil then + begin + if FCaseSensitive then + FNameHash.Add(Item.Name, Result) + else + FNameHash.Add(UpperCase(Item.Name), Result); + end; +end; + +function TJclSimpleItemHashedList.Extract(Item: TJclSimpleItem): TJclSimpleItem; +begin + Result := TJclSimpleItem(inherited Extract(Item)); + InvalidateHash; +end; + +function TJclSimpleItemHashedList.GetSimpleItem(Index: Integer): TJclSimpleItem; +begin + Result := TJclSimpleItem(GetItem(Index)); +end; + +function TJclSimpleItemHashedList.GetSimpleItemByName(const Name: string): TJclSimpleItem; +var + I: Integer; +begin + I := IndexOfName(Name); + if I >= 0 then + Result := TJclSimpleItem(Items[I]) + else + Result := nil; +end; + +function TJclSimpleItemHashedList.IndexOfSimpleItem(Item: TJclSimpleItem): Integer; +begin + Result := IndexOf(Item); +end; + +function TJclSimpleItemHashedList.IndexOfName(const Name: string): Integer; +var + I: Integer; +begin + if FCaseSensitive then + begin + if FNameHash = nil then + begin + FNameHash := TStringHash.Create(8); + for I := 0 to Count - 1 do + FNameHash.Add(TJclSimpleData(Items[I]).Name, I); + end; + Result := FNameHash.ValueOf(Name); + end + else + begin + if FNameHash = nil then + begin + FNameHash := TStringHash.Create(8); + for I := 0 to Count - 1 do + FNameHash.Add(UpperCase(TJclSimpleData(Items[I]).Name), I); + end; + Result := FNameHash.ValueOf(UpperCase(Name)); + end; +end; + +procedure TJclSimpleItemHashedList.Insert(Index: Integer; Item: TJclSimpleItem); +begin + InvalidateHash; + inherited Insert(Index, Item); +end; + +procedure TJclSimpleItemHashedList.InvalidateHash; +begin + FreeAndNil(FNameHash); +end; + +procedure TJclSimpleItemHashedList.Move(CurIndex, NewIndex: Integer); +begin + InvalidateHash; + inherited Move(CurIndex, NewIndex); +end; + +procedure TJclSimpleItemHashedList.Notify(Ptr: Pointer; Action: TListNotification); +begin + if (Action = lnDeleted) and (FNameHash <> nil) then + begin +// Mantis 0006062 Hotfix +// if FCaseSensitive then +// FNameHash.Remove(TJclSimpleItem(Ptr).Name) +// else +// FNameHash.Remove(UpperCase(TJclSimpleItem(Ptr).Name)); + InvalidateHash; + end; + inherited Notify(Ptr, Action); +end; + +procedure TJclSimpleItemHashedList.SetCaseSensitive(const Value: Boolean); +begin + if FCaseSensitive <> Value then + begin + InvalidateHash; + FCaseSensitive := Value; + end; +end; + +//=== { TJclSimpleData } ===================================================== + +constructor TJclSimpleData.Create; +begin + inherited Create; +end; + +constructor TJclSimpleData.Create(const AName: string); +begin + inherited Create; + FName := AName; +end; + +constructor TJclSimpleData.Create(const AName, AValue: string); +begin + inherited Create; + FName := AName; + FValue := AValue; +end; + +function TJclSimpleData.GetAnsiValue: AnsiString; +begin + Result := AnsiString(Value); +end; + +function TJclSimpleData.GetBoolValue: Boolean; +begin + Result := StrToBoolDef(Value, False); +end; + +function TJclSimpleData.GetFloatValue: Extended; +begin + Result := 0.0; + if not TryStrToFloat(Value, Result) then + Result := 0.0; +end; + +function TJclSimpleData.GetIntValue: Int64; +begin + Result := StrToInt64Def(Value, -1); +end; + +procedure TJclSimpleData.SetAnsiValue(const Value: AnsiString); +begin + Self.Value := string(Value); +end; + +procedure TJclSimpleData.SetBoolValue(const Value: Boolean); +begin + FValue := BoolToStr(Value); +end; + +procedure TJclSimpleData.SetFloatValue(const Value: Extended); +begin + FValue := FloatToStr(Value); +end; + +procedure TJclSimpleData.SetIntValue(const Value: Int64); +begin + FValue := IntToStr(Value); +end; + +//=== { TJclSimpleXMLData } ================================================== + +function TJclSimpleXMLData.FullName: string; +begin + if NameSpace <> '' then + Result := NameSpace + ':' + Name + else + Result := Name; +end; + +//=== { TJclSimpleXML } ====================================================== + +constructor TJclSimpleXML.Create; +begin + inherited Create; + FRoot := TJclSimpleXMLElemClassic.Create(Self); + FProlog := TJclSimpleXMLElemsProlog.Create(Self); + FOptions := [sxoAutoIndent, sxoAutoEncodeValue, sxoAutoEncodeEntity]; + FIndentString := ' '; +end; + +destructor TJclSimpleXML.Destroy; +begin + FreeAndNil(FRoot); + FreeAndNil(FProlog); + inherited Destroy; +end; + +procedure TJclSimpleXML.DoDecodeValue(var Value: string); +begin + if sxoAutoEncodeValue in Options then + SimpleXMLDecode(Value, False) + else + if sxoAutoEncodeEntity in Options then + Value := EntityDecode(Value); + if Assigned(FOnDecodeValue) then + FOnDecodeValue(Self, Value); +end; + +procedure TJclSimpleXML.DoEncodeValue(var Value: string); +begin + if Assigned(FOnEncodeValue) then + FOnEncodeValue(Self, Value); + if sxoAutoEncodeValue in Options then + Value := SimpleXMLEncode(Value) + else + if sxoAutoEncodeEntity in Options then + Value := EntityEncode(Value); +end; + +procedure TJclSimpleXML.DoLoadProgress(const APosition, ATotal: Integer); +begin + if Assigned(FOnLoadProg) then + FOnLoadProg(Self, APosition, ATotal); +end; + +procedure TJclSimpleXML.DoSaveProgress; +begin + if Assigned(FOnSaveProg) then + begin + Inc(FSaveCurrent); + FOnSaveProg(Self, FSaveCurrent, FSaveCount); + end; +end; + +procedure TJclSimpleXML.DoTagParsed(const AName: string); +begin + if Assigned(FOnTagParsed) then + FOnTagParsed(Self, AName); +end; + +procedure TJclSimpleXML.DoValueParsed(const AName, AValue: string); +begin + if Assigned(FOnValue) then + FOnValue(Self, AName, AValue); +end; + +procedure TJclSimpleXML.LoadFromFile(const FileName: TFileName; Encoding: TJclStringEncoding; CodePage: Word); +var + Stream: TMemoryStream; +begin + Stream := TMemoryStream.Create; + try + Stream.LoadFromFile(FileName); + LoadFromStream(Stream, Encoding, CodePage); + finally + Stream.Free; + end; +end; + +procedure TJclSimpleXML.LoadFromResourceName(Instance: THandle; const ResName: string; + Encoding: TJclStringEncoding; CodePage: Word); +{$IFNDEF MSWINDOWS} +const + RT_RCDATA = PChar(10); +{$ENDIF !MSWINDOWS} +var + Stream: TResourceStream; +begin + Stream := TResourceStream.Create(Instance, ResName, RT_RCDATA); + try + LoadFromStream(Stream, Encoding, CodePage); + finally + Stream.Free; + end; +end; + +procedure TJclSimpleXML.LoadFromStream(Stream: TStream; Encoding: TJclStringEncoding; CodePage: Word); +var + AOutStream: TStream; + AStringStream: TJclStringStream; + DoFree: Boolean; +begin + FRoot.Clear; + FProlog.Clear; + AOutStream := nil; + DoFree := False; + try + if Assigned(FOnDecodeStream) then + begin + AOutStream := TMemoryStream.Create; + DoFree := True; + FOnDecodeStream(Self, Stream, AOutStream); + AOutStream.Seek(0, soBeginning); + end + else + AOutStream := Stream; + + case Encoding of + seAnsi: + begin + AStringStream := TJclAnsiStream.Create(AOutStream, False); + TJclAnsiStream(AStringStream).CodePage := CodePage; + end; + seUTF8: + AStringStream := TJclUTF8Stream.Create(AOutStream, False); + seUTF16: + AStringStream := TJclUTF16Stream.Create(AOutStream, False); + else + AStringStream := TJclAutoStream.Create(AOutStream, False); + if CodePage <> CP_ACP then + TJclAutoStream(AStringStream).CodePage := CodePage; + end; + try + AStringStream.SkipBOM; + + LoadFromStringStream(AStringStream); + + // save codepage and encoding for future saves + if AStringStream is TJclAutoStream then + begin + FCodePage := TJclAutoStream(AStringStream).CodePage; + FEncoding := TJclAutoStream(AStringStream).Encoding; + end + else + if AStringStream is TJclAnsiStream then + begin + FCodePage := TJclAnsiStream(AStringStream).CodePage; + FEncoding := Encoding; + end + else + begin + FCodePage := CodePage; + FEncoding := Encoding; + end; + finally + AStringStream.Free; + end; + finally + if DoFree then + AOutStream.Free; + end; +end; + +procedure TJclSimpleXML.LoadFromStringStream(StringStream: TJclStringStream); +var + BufferSize: Integer; +begin + if Assigned(FOnLoadProg) then + FOnLoadProg(Self, StringStream.Stream.Position, StringStream.Stream.Size); + + BufferSize := StringStream.BufferSize; + StringStream.BufferSize := 1; + + // Read doctype and so on + FProlog.LoadFromStringStream(StringStream); + + StringStream.BufferSize := BufferSize; + + // Read elements + FRoot.LoadFromStringStream(StringStream); + + if Assigned(FOnLoadProg) then + FOnLoadProg(Self, StringStream.Stream.Position, StringStream.Stream.Size); +end; + +procedure TJclSimpleXML.LoadFromString(const Value: string); +var + Stream: TStringStream; +begin + Stream := TStringStream.Create(Value {$IFDEF SUPPORTS_UNICODE}, TEncoding.Unicode{$ENDIF}); + try + LoadFromStream(Stream {$IFDEF SUPPORTS_UNICODE}, seUTF16, CP_UTF16LE{$ENDIF}); + finally + Stream.Free; + end; +end; + +procedure TJclSimpleXML.GetEncodingFromXMLHeader(var Encoding: TJclStringEncoding; var CodePage: Word); +var + XMLHeader: TJclSimpleXMLElemHeader; + I: Integer; +begin + XMLHeader := nil; + for I := 0 to Prolog.Count - 1 do + if Prolog.Item[I] is TJclSimpleXMLElemHeader then + begin + XMLHeader := TJclSimpleXMLElemHeader(Prolog.Item[I]); + Break; + end; + if Assigned(XMLHeader) then + begin + CodePage := CodePageFromCharsetName(XMLHeader.Encoding); + case CodePage of + CP_UTF8: + Encoding := seUTF8; + CP_UTF16LE: + Encoding := seUTF16; + else + Encoding := seAnsi; + end; + end + else + begin + // restore from previous load + Encoding := FEncoding; + CodePage := FCodePage; + end; +end; + +procedure TJclSimpleXML.SaveToFile(const FileName: TFileName; Encoding: TJclStringEncoding; CodePage: Word); +var + Stream: TMemoryStream; +begin + Stream := TMemoryStream.Create; + try + SaveToStream(Stream, Encoding, CodePage); + Stream.SaveToFile(FileName); + finally + Stream.Free; + end; +end; + +procedure TJclSimpleXML.SaveToStream(Stream: TStream; Encoding: TJclStringEncoding; CodePage: Word); +var + AOutStream: TStream; + AStringStream: TJclStringStream; + DoFree: Boolean; +begin + if Assigned(FOnEncodeStream) then + begin + AOutStream := TMemoryStream.Create; + DoFree := True; + end + else + begin + AOutStream := Stream; + DoFree := False; + end; + try + if Encoding = seAuto then + GetEncodingFromXMLHeader(Encoding, CodePage); + + case Encoding of + seUTF8: + begin + AStringStream := TJclUTF8Stream.Create(AOutStream, False); + FCodePage := CP_UTF8; + end; + seUTF16: + begin + AStringStream := TJclUTF16Stream.Create(AOutStream, False); + FCodePage := CP_UTF16LE; + end + else + AStringStream := TJclAnsiStream.Create(AOutStream); + TJclAnsiStream(AStringStream).CodePage := CodePage; + end; + try + if not (sxoDoNotSaveBOM in Options) then + AStringStream.WriteBOM; + SaveToStringStream(AStringStream); + AStringStream.Flush; + finally + AStringStream.Free; + end; + if Assigned(FOnEncodeStream) then + begin + AOutStream.Seek(0, soBeginning); + FOnEncodeStream(Self, AOutStream, Stream); + end; + finally + if DoFree then + AOutStream.Free; + end; +end; + +procedure TJclSimpleXML.SaveToStringStream(StringStream: TJclStringStream); +var + lCount: Integer; +begin + lCount := Root.ChildsCount + Prolog.Count; + FSaveCount := lCount; + FSaveCurrent := 0; + + if Assigned(FOnSaveProg) then + FOnSaveProg(Self, 0, lCount); + + if not (sxoDoNotSaveProlog in FOptions) then + Prolog.SaveToStringStream(StringStream); + + Root.SaveToStringStream(StringStream, BaseIndentString); + + if Assigned(FOnSaveProg) then + FOnSaveProg(Self, lCount, lCount); +end; + +function TJclSimpleXML.SaveToString: string; +begin + Result := SaveToStringEncoding(seAuto, CP_ACP); +end; + +function TJclSimpleXML.SaveToStringEncoding(Encoding: TJclStringEncoding; CodePage: Word): string; +var + Stream: TStringStream; +begin + {$IFDEF SUPPORTS_UNICODE} + // Use the same logic for seAuto as in SaveToStream for creating the TStringStream. + // Otherwise a Unicode-TStringStream is written to from a TJclAnsiStream proxy. + if Encoding = seAuto then + GetEncodingFromXMLHeader(Encoding, CodePage); + + case Encoding of + seAnsi: + Stream := TStringStream.Create('', TEncoding.{$IFDEF COMPILER16_UP}ANSI{$ELSE}Default{$ENDIF}); + seUTF8: + Stream := TStringStream.Create('', TEncoding.UTF8); + else + //seUTF16: + Stream := TStringStream.Create('', TEncoding.Unicode); + end; + {$ELSE ~SUPPORTS_UNICODE} + Stream := TStringStream.Create(''); + {$ENDIF ~SUPPORTS_UNICODE} + try + SaveToStream(Stream, Encoding, CodePage); + Result := Stream.DataString; + finally + Stream.Free; + end; +end; + +procedure TJclSimpleXML.SetBaseIndentString(const Value: string); +begin + // test if the new value is only made of spaces or tabs + if not StrContainsChars(Value, CharIsWhiteSpace, True) then + Exit; + + FBaseIndentString := Value; +end; + +procedure TJclSimpleXML.SetFileName(const Value: TFileName); +begin + FFileName := Value; + LoadFromFile(Value); +end; + +//=== { TJclSimpleXMLElem } ================================================== + +procedure TJclSimpleXMLElem.Assign(Value: TJclSimpleXMLElem); +var + Elems: TJclSimpleXMLElem; + SrcElem, DestElem: TJclSimpleXMLElem; + I: Integer; + SrcProps, DestProps: TJclSimpleXMLProps; + SrcProp: TJclSimpleXMLProp; + SrcElems, DestElems: TJclSimpleXMLElems; +begin + Clear; + if Value = nil then + Exit; + Elems := TJclSimpleXMLElem(Value); + Name := Elems.Name; + Self.Value := Elems.Value; + SrcProps := Elems.FProps; + if Assigned(SrcProps) then + begin + DestProps := Properties; + for I := 0 to SrcProps.Count - 1 do + begin + SrcProp := SrcProps.Item[I]; + DestProps.Add(SrcProp.Name, SrcProp.Value); + end; + end; + + SrcElems := Elems.FItems; + if Assigned(SrcElems) then + begin + DestElems := Items; + for I := 0 to SrcElems.Count - 1 do + begin + // Create from the class type, so that the virtual constructor is called + // creating an element of the correct class type. + SrcElem := SrcElems.Item[I]; + DestElem := TJclSimpleXMLElemClass(SrcElem.ClassType).Create(SrcElem.Name, SrcElem.Value); + DestElem.Assign(SrcElem); + DestElems.Add(DestElem); + end; + end; +end; + +procedure TJclSimpleXMLElem.Clear; +begin + if FItems <> nil then + FItems.Clear; + if FProps <> nil then + FProps.Clear; +end; + +constructor TJclSimpleXMLElem.Create(ASimpleXML: TJclSimpleXML); +begin + Create; + FSimpleXML := ASimpleXML; +end; + +destructor TJclSimpleXMLElem.Destroy; +begin + FSimpleXML := nil; + FParent := nil; + Clear; + FreeAndNil(FItems); + FreeAndNil(FProps); + inherited Destroy; +end; + +procedure TJclSimpleXMLElem.Error(const S: string); +begin + raise EJclSimpleXMLError.Create(S); +end; + +procedure TJclSimpleXMLElem.FmtError(const S: string; + const Args: array of const); +begin + Error(Format(S, Args)); +end; + +procedure TJclSimpleXMLElem.GetBinaryValue(Stream: TStream; BufferSize: Integer = 0); +var + I, J, ValueLength, RequiredStreamSize: Integer; + Buf: array of Byte; + N1, N2: Byte; + + function NibbleCharToNibble(const AChar: Char): Byte; + begin + case AChar of + '0': Result := 0; + '1': Result := 1; + '2': Result := 2; + '3': Result := 3; + '4': Result := 4; + '5': Result := 5; + '6': Result := 6; + '7': Result := 7; + '8': Result := 8; + '9': Result := 9; + 'a', 'A': Result := 10; + 'b', 'B': Result := 11; + 'c', 'C': Result := 12; + 'd', 'D': Result := 13; + 'e', 'E': Result := 14; + 'f', 'F': Result := 15; + else + Result := 16; + end; + end; + + procedure PrepareNibbleCharMapping; + var + C: Char; + begin + if not PreparedNibbleCharMapping then + begin + for C := Low(Char) to High(Char) do + NibbleCharMapping[C] := NibbleCharToNibble(C); + PreparedNibbleCharMapping := True; + end; + end; + +var + CurrentStreamPosition: Integer; +begin + if BufferSize = 0 then + BufferSize := cBufferSize; + + SetLength(Buf, BufferSize); + PrepareNibbleCharMapping; + I := 1; + J := 0; + ValueLength := Length(Value); + RequiredStreamSize := Stream.Position + ValueLength div 2; + if Stream.Size < RequiredStreamSize then + begin + CurrentStreamPosition := Stream.Position; + Stream.Size := RequiredStreamSize; + Stream.Seek(CurrentStreamPosition, soBeginning); + end; + while I < ValueLength do + begin + //faster replacement for St := '$' + Value[I] + Value[I + 1]; Buf[J] := StrToIntDef(St, 0); + N1 := NibbleCharMapping[Value[I]]; + N2 := NibbleCharMapping[Value[I + 1]]; + Inc(I, 2); + if (N1 > 15) or (N2 > 15) then + Buf[J] := 0 + else + Buf[J] := (N1 shl 4) or N2; + Inc(J); + if J = Length(Buf) - 1 then //Buffered write to speed up the process a little + begin + Stream.Write(Buf[0], J); + J := 0; + end; + end; + Stream.Write(Buf[0], J); +end; + +function TJclSimpleXMLElem.GetChildIndex(const AChild: TJclSimpleXMLElem): Integer; +begin + if FItems = nil then + Result := -1 + else + Result := FItems.FElems.IndexOfSimpleItem(AChild); +end; + +function TJclSimpleXMLElem.GetChildsCount: Integer; +var + I: Integer; +begin + Result := 1; + if FItems <> nil then + for I := 0 to FItems.Count - 1 do + Result := Result + FItems[I].ChildsCount; +end; + +function TJclSimpleXMLElem.GetHasItems: Boolean; +begin + Result := Assigned(FItems) and (FItems.Count > 0); +end; + +function TJclSimpleXMLElem.GetHasProperties: Boolean; +begin + Result := Assigned(FProps) and (FProps.Count > 0); +end; + +function TJclSimpleXMLElem.GetItemCount: Integer; +begin + Result := 0; + if Assigned(FItems) then + Result := FItems.Count; +end; + +function TJclSimpleXMLElem.GetItems: TJclSimpleXMLElems; +begin + if FItems = nil then + FItems := TJclSimpleXMLElems.Create(Self); + Result := FItems; +end; + +function TJclSimpleXMLElem.GetNamedIndex(const AChild: TJclSimpleXMLElem): Integer; +begin + Result := Items.NamedElems[AChild.Name].IndexOf(AChild); +end; + +function TJclSimpleXMLElem.GetPropertyCount: Integer; +begin + Result := 0; + if Assigned(FProps) then + Result := FProps.Count; +end; + +function TJclSimpleXMLElem.GetProps: TJclSimpleXMLProps; +begin + if FProps = nil then + FProps := TJclSimpleXMLProps.Create(Self); + Result := FProps; +end; + +procedure TJclSimpleXMLElem.LoadFromString(const Value: string); +var + Stream: TJclStringStream; + StrStream: TStringStream; +begin + StrStream := TStringStream.Create(Value); + try + Stream := TJclAutoStream.Create(StrStream); + try + LoadFromStringStream(Stream); + finally + Stream.Free; + end; + finally + StrStream.Free; + end; +end; + +function TJclSimpleXMLElem.SaveToString: string; +var + Stream: TJclStringStream; + StrStream: TStringStream; +begin + StrStream := TStringStream.Create(''); + try + Stream := TJclAutoStream.Create(StrStream); + try + SaveToStringStream(Stream); + Stream.Flush; + finally + Stream.Free; + end; + Result := StrStream.DataString; + finally + StrStream.Free; + end; +end; + +procedure TJclSimpleXMLElem.SetName(const Value: string); +begin + if (Value <> Name) and (Value <> '') then + begin + if (Parent <> nil) and (Name <> '') then + Parent.Items.DoItemRename(Self, Value); + inherited SetName(Value); + end; +end; + +//=== { TJclSimpleXMLNamedElemsEnumerator } ================================== + +{$IFDEF SUPPORTS_FOR_IN} +constructor TJclSimpleXMLNamedElemsEnumerator.Create(AList: TJclSimpleXMLNamedElems); +begin + inherited Create; + FIndex := -1; + FList := AList; +end; + +function TJclSimpleXMLNamedElemsEnumerator.GetCurrent: TJclSimpleXMLElem; +begin + Result := FList[FIndex]; +end; + +function TJclSimpleXMLNamedElemsEnumerator.MoveNext: Boolean; +begin + Result := FIndex < FList.Count - 1; + if Result then + Inc(FIndex); +end; +{$ENDIF SUPPORTS_FOR_IN} + +//=== { TJclSimpleXMLNamedElems } ============================================ + +constructor TJclSimpleXMLNamedElems.Create(AElems: TJclSimpleXMLElems; const AName: string); +begin + inherited Create; + FElems := AElems; + FName := AName; + FItems := TList.Create; +end; + +destructor TJclSimpleXMLNamedElems.Destroy; +begin + FItems.Free; + inherited Destroy; +end; + +function TJclSimpleXMLNamedElems.Add(const Value: Int64): TJclSimpleXMLElemClassic; +begin + Result := Elems.Add(Name, Value); +end; + +function TJclSimpleXMLNamedElems.Add(Value: TStream): TJclSimpleXMLElemClassic; +begin + Result := Elems.Add(Name, Value); +end; + +function TJclSimpleXMLNamedElems.Add(const Value: Boolean): TJclSimpleXMLElemClassic; +begin + Result := Elems.Add(Name, Value); +end; + +function TJclSimpleXMLNamedElems.Add: TJclSimpleXMLElemClassic; +begin + Result := Elems.Add(Name); +end; + +function TJclSimpleXMLNamedElems.Add(const Value: string): TJclSimpleXMLElemClassic; +begin + Result := Elems.Add(Name, Value); +end; + +function TJclSimpleXMLNamedElems.AddCData(const Value: string): TJclSimpleXMLElemCData; +begin + Result := Elems.AddCData(Name, Value); +end; + +function TJclSimpleXMLNamedElems.AddComment(const Value: string): TJclSimpleXMLElemComment; +begin + Result := Elems.AddComment(Name, Value); +end; + +function TJclSimpleXMLNamedElems.AddFirst: TJclSimpleXMLElemClassic; +begin + Result := Elems.AddFirst(Name); +end; + +function TJclSimpleXMLNamedElems.AddText(const Value: string): TJclSimpleXMLElemText; +begin + Result := Elems.AddText(Name, Value); +end; + +procedure TJclSimpleXMLNamedElems.Clear; +var + Index: Integer; +begin + for Index := FItems.Count - 1 downto 0 do + Elems.Remove(TJclSimpleXMLElem(FItems.Items[Index])); +end; + +procedure TJclSimpleXMLNamedElems.Delete(const Index: Integer); +begin + if (Index >= 0) and (Index < FItems.Count) then + Elems.Remove(TJclSimpleXMLElem(FItems.Items[Index])); +end; + +function TJclSimpleXMLNamedElems.GetCount: Integer; +begin + Result := FItems.Count; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclSimpleXMLNamedElems.GetEnumerator: TJclSimpleXMLNamedElemsEnumerator; +begin + Result := TJclSimpleXMLNamedElemsEnumerator.Create(Self); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclSimpleXMLNamedElems.GetItem(const Index: Integer): TJclSimpleXMLElem; +begin + if (Index >= 0) then + begin + While (Index >= Count) do + if Assigned(Elems.Parent) and Assigned(Elems.Parent.SimpleXML) and + (sxoAutoCreate in Elems.Parent.SimpleXML.Options) then + Add + else + break; + if Index < Count then + Result := TJclSimpleXMLElem(FItems.Items[Index]) + else + Result := nil; + end + else + Result := nil; +end; + +function TJclSimpleXMLNamedElems.IndexOf(const Value: TJclSimpleXMLElem): Integer; +begin + Result := FItems.IndexOf(Value); +end; + +function TJclSimpleXMLNamedElems.IndexOf(const Value: string): Integer; +var + Index: Integer; + NewItem: TJclSimpleXMLElem; +begin + Result := -1; + for Index := 0 to FItems.Count - 1 do + if TJclSimpleXMLElem(FItems.Items[Index]).Value = Value then + begin + Result := Index; + Break; + end; + if (Result = -1) and (sxoAutoCreate in Elems.Parent.SimpleXML.Options) then + begin + NewItem := Elems.Add(Name, Value); + Result := FItems.IndexOf(NewItem); + end; +end; + +procedure TJclSimpleXMLNamedElems.Move(const CurIndex, NewIndex: Integer); +var + ElemsCurIndex, ElemsNewIndex: Integer; +begin + ElemsCurIndex := Elems.IndexOf(TJclSimpleXMLElem(FItems.Items[CurIndex])); + ElemsNewIndex := Elems.IndexOf(TJclSimpleXMLElem(FItems.Items[NewIndex])); + Elems.Move(ElemsCurIndex, ElemsNewIndex); + FItems.Move(CurIndex, NewIndex); +end; + +procedure TJclSimpleXMLNamedElems.SetName(const Value: string); +begin + raise EJclSimpleXMLError.CreateRes(@SReadOnlyProperty); +end; + +//=== { TJclSimpleXMLElemsEnumerator } ======================================= + +{$IFDEF SUPPORTS_FOR_IN} +constructor TJclSimpleXMLElemsEnumerator.Create(AList: TJclSimpleXMLElems); +begin + inherited Create; + FIndex := -1; + FList := AList; +end; + +function TJclSimpleXMLElemsEnumerator.GetCurrent: TJclSimpleXMLElem; +begin + Result := FList[FIndex]; +end; + +function TJclSimpleXMLElemsEnumerator.MoveNext: Boolean; +begin + Result := FIndex < FList.Count - 1; + if Result then + Inc(FIndex); +end; +{$ENDIF SUPPORTS_FOR_IN} + +//=== { TJclSimpleXMLElems } ================================================= + +function TJclSimpleXMLElems.Add(const Name: string): TJclSimpleXMLElemClassic; +begin + Result := TJclSimpleXMLElemClassic.Create(Name); + AddChild(Result); +end; + +function TJclSimpleXMLElems.Add(const Name, Value: string): TJclSimpleXMLElemClassic; +begin + Result := TJclSimpleXMLElemClassic.Create(Name, Value); + AddChild(Result); +end; + +function TJclSimpleXMLElems.Add(const Name: string; const Value: Int64): TJclSimpleXMLElemClassic; +begin + Result := TJclSimpleXMLElemClassic.Create(Name, IntToStr(Value)); + AddChild(Result); +end; + +function TJclSimpleXMLElems.Add(Value: TJclSimpleXMLElem): TJclSimpleXMLElem; +begin + if Value <> nil then + AddChild(Value); + Result := Value; +end; + +function TJclSimpleXMLElems.Add(const Name: string; const Value: Boolean): TJclSimpleXMLElemClassic; +begin + Result := TJclSimpleXMLElemClassic.Create(Name, BoolToStr(Value)); + AddChild(Result); +end; + +function TJclSimpleXMLElems.Add(const Name: string; Value: TStream; BufferSize: Integer): TJclSimpleXMLElemClassic; +var + Stream: TStringStream; + Buf: array of Byte; + St: string; + I, Count: Integer; +begin + Stream := TStringStream.Create(''); + try + if BufferSize = 0 then + BufferSize := cBufferSize; + + SetLength(Buf, BufferSize); + Buf[0] := 0; + repeat + Count := Value.Read(Buf[0], Length(Buf)); + St := ''; + for I := 0 to Count - 1 do + St := St + IntToHex(Buf[I], 2); + Stream.WriteString(St); + until Count = 0; + Result := TJclSimpleXMLElemClassic.Create(Name, Stream.DataString); + AddChild(Result); + finally + Stream.Free; + end; +end; + +procedure TJclSimpleXMLElems.AddChild(const Value: TJclSimpleXMLElem); +var + NamedIndex: Integer; +begin + CreateElems; + + // If there already is a container, notify it to remove the element + if Assigned(Value.Parent) then + Value.Parent.Items.Notify(Value, opRemove); + + FElems.Add(Value); + + if FNamedElems <> nil then + begin + NamedIndex := FNamedElems.IndexOfName(Value.Name); + if NamedIndex >= 0 then + TJclSimpleXMLNamedElems(FNamedElems.SimpleItems[NamedIndex]).FItems.Add(Value); + end; + + Notify(Value, opInsert); +end; + +procedure TJclSimpleXMLElems.AddChildFirst(const Value: TJclSimpleXMLElem); +var + NamedIndex: Integer; +begin + CreateElems; + + // If there already is a container, notify it to remove the element + if Assigned(Value.Parent) then + Value.Parent.Items.Notify(Value, opRemove); + + FElems.Insert(0, Value); + + if FNamedElems <> nil then + begin + NamedIndex := FNamedElems.IndexOfName(Value.Name); + if NamedIndex >= 0 then + TJclSimpleXMLNamedElems(FNamedElems.SimpleItems[NamedIndex]).FItems.Insert(0, Value); + end; + + Notify(Value, opInsert); +end; + +function TJclSimpleXMLElems.AddFirst(const Name: string): TJclSimpleXMLElemClassic; +begin + Result := TJclSimpleXMLElemClassic.Create(Name); + AddChildFirst(Result); +end; + +function TJclSimpleXMLElems.AddFirst(Value: TJclSimpleXMLElem): TJclSimpleXMLElem; +begin + if Value <> nil then + AddChildFirst(Value); + Result := Value; +end; + +function TJclSimpleXMLElems.AddComment(const Name, + Value: string): TJclSimpleXMLElemComment; +begin + Result := TJclSimpleXMLElemComment.Create(Name, Value); + AddChild(Result); +end; + +function TJclSimpleXMLElems.AddCData(const Name, Value: string): TJclSimpleXMLElemCData; +begin + Result := TJclSimpleXMLElemCData.Create(Name, Value); + AddChild(Result); +end; + +function TJclSimpleXMLElems.AddText(const Name, Value: string): TJclSimpleXMLElemText; +begin + Result := TJclSimpleXMLElemText.Create(Name, Value); + AddChild(Result); +end; + +procedure TJclSimpleXMLElems.BinaryValue(const Name: string; Stream: TStream); +var + Elem: TJclSimpleXMLElem; +begin + Elem := GetItemNamed(Name); + if Elem <> nil then + Elem.GetBinaryValue(Stream); +end; + +function TJclSimpleXMLElems.BoolValue(const Name: string; Default: Boolean): Boolean; +var + Elem: TJclSimpleXMLElem; +begin + try + Elem := GetItemNamedDefault(Name, BoolToStr(Default)); + if (Elem = nil) or (Elem.Value = '') then + Result := Default + else + Result := Elem.BoolValue; + except + Result := Default; + end; +end; + +procedure TJclSimpleXMLElems.Clear; +begin + if FElems <> nil then + FElems.Clear; + if FNamedElems <> nil then + FNamedElems.Clear; +end; + +constructor TJclSimpleXMLElems.Create(AParent: TJclSimpleXMLElem); +begin + inherited Create; + FParent := AParent; +end; + +procedure TJclSimpleXMLElems.CreateElems; +var + CaseSensitive: Boolean; +begin + if FElems = nil then + begin + CaseSensitive := Assigned(Parent) and Assigned(Parent.SimpleXML) + and (sxoCaseSensitive in Parent.SimpleXML.Options); + FElems := TJclSimpleItemHashedList.Create(CaseSensitive); + end; +end; + +procedure TJclSimpleXMLElems.Delete(const Index: Integer); +var + Elem: TJclSimpleXMLElem; + NamedIndex: Integer; +begin + if (FElems <> nil) and (Index >= 0) and (Index < FElems.Count) then + begin + Elem := TJclSimpleXMLElem(FElems.SimpleItems[Index]); + if FNamedElems <> nil then + begin + NamedIndex := FNamedElems.IndexOfName(Elem.Name); + if NamedIndex >= 0 then + TJclSimpleXMLNamedElems(FNamedElems.SimpleItems[NamedIndex]).FItems.Remove(Elem); + end; + FElems.Delete(Index); + end; +end; + +procedure TJclSimpleXMLElems.Delete(const Name: string); +begin + if FElems <> nil then + Delete(FElems.IndexOfName(Name)); +end; + +destructor TJclSimpleXMLElems.Destroy; +begin + FParent := nil; + Clear; + FreeAndNil(FElems); + FreeAndNil(FNamedElems); + inherited Destroy; +end; + +procedure TJclSimpleXMLElems.DoItemRename(Value: TJclSimpleXMLElem; const Name: string); +var + NamedIndex: Integer; +begin + if FNamedElems <> nil then + begin + NamedIndex := FNamedElems.IndexOfName(Value.Name); + if NamedIndex >= 0 then + TJclSimpleXMLNamedElems(FNamedElems.SimpleItems[NamedIndex]).FItems.Remove(Value); + + NamedIndex := FNamedElems.IndexOfName(Name); + if NamedIndex >= 0 then + TJclSimpleXMLNamedElems(FNamedElems.SimpleItems[NamedIndex]).FItems.Add(Value); + end; + FElems.InvalidateHash; +end; + +function TJclSimpleXMLElems.FloatValue(const Name: string; + const Default: Extended): Extended; +var + Elem: TJclSimpleXMLElem; +begin + Elem := GetItemNamedDefault(Name, FloatToStr(Default)); + if Elem = nil then + Result := Default + else + Result := Elem.FloatValue; +end; + +function TJclSimpleXMLElems.GetCount: Integer; +begin + if FElems = nil then + Result := 0 + else + Result := FElems.Count; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclSimpleXMLElems.GetEnumerator: TJclSimpleXMLElemsEnumerator; +begin + Result := TJclSimpleXMLElemsEnumerator.Create(Self); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclSimpleXMLElems.GetItem(const Index: Integer): TJclSimpleXMLElem; +begin + if (FElems = nil) or (Index > FElems.Count) then + Result := nil + else + Result := TJclSimpleXMLElem(FElems.SimpleItems[Index]); +end; + +function TJclSimpleXMLElems.GetItemNamedDefault(const Name, Default: string): TJclSimpleXMLElem; +var + I: Integer; +begin + Result := nil; + if FElems <> nil then + begin + I := FElems.IndexOfName(Name); + if I <> -1 then + Result := TJclSimpleXMLElem(FElems.SimpleItems[I]) + else + if Assigned(Parent) and Assigned(Parent.SimpleXML) and (sxoAutoCreate in Parent.SimpleXML.Options) then + Result := Add(Name, Default); + end + else + if Assigned(Parent) and Assigned(Parent.SimpleXML) and (sxoAutoCreate in Parent.SimpleXML.Options) then + Result := Add(Name, Default); +end; + +function TJclSimpleXMLElems.GetNamedElems(const Name: string): TJclSimpleXMLNamedElems; +var + NamedIndex: Integer; + CaseSensitive: Boolean; +begin + if FNamedElems = nil then + begin + CaseSensitive := Assigned(Parent) and Assigned(Parent.SimpleXML) + and (sxoCaseSensitive in Parent.SimpleXML.Options); + FNamedElems := TJclSimpleItemHashedList.Create(CaseSensitive); + end; + NamedIndex := FNamedElems.IndexOfName(Name); + if NamedIndex = -1 then + begin + Result := TJclSimpleXMLNamedElems.Create(Self, Name); + FNamedElems.Add(Result); + if FElems <> nil then + for NamedIndex := 0 to FElems.Count - 1 do + if FElems.SimpleItems[NamedIndex].Name = Name then + Result.FItems.Add(FElems.SimpleItems[NamedIndex]); + end + else + Result := TJclSimpleXMLNamedElems(FNamedElems.SimpleItems[NamedIndex]); +end; + +function TJclSimpleXMLElems.GetItemNamed(const Name: string): TJclSimpleXMLElem; +begin + Result := GetItemNamedDefault(Name, ''); +end; + +function TJclSimpleXMLElems.IntValue(const Name: string; const Default: Int64): Int64; +var + Elem: TJclSimpleXMLElem; +begin + Elem := GetItemNamedDefault(Name, IntToStr(Default)); + if Elem = nil then + Result := Default + else + Result := Elem.IntValue; +end; + +procedure TJclSimpleXMLElems.LoadFromStringStream(StringStream: TJclStringStream); +type + TReadStatus = (rsWaitingTag, rsReadingTagKind); +var + lPos: TReadStatus; + St: TUCS4Array; + lElem: TJclSimpleXMLElem; + Ch: UCS4; + ContainsText, ContainsWhiteSpace, KeepWhiteSpace: Boolean; + SimpleXML: TJclSimpleXML; +begin + SetLength(St, 0); + lPos := rsWaitingTag; + SimpleXML := Parent.SimpleXML; + KeepWhiteSpace := (SimpleXML <> nil) and (sxoKeepWhitespace in SimpleXML.Options); + ContainsText := False; + ContainsWhiteSpace := False; + + // We read from a stream, thus replacing the existing items + Clear; + + if SimpleXML <> nil then + SimpleXML.DoLoadProgress(StringStream.Stream.Position, StringStream.Stream.Size); + + while StringStream.PeekUCS4(Ch) do + begin + case lPos of + rsWaitingTag: //We are waiting for a tag and thus avoiding spaces + begin + if Ch = Ord('<') then + begin + lPos := rsReadingTagKind; + St := UCS4Array(Ch); + end + else + if UnicodeIsWhiteSpace(Ch) then + ContainsWhiteSpace := True + else + ContainsText := True; + end; + + rsReadingTagKind: //We are trying to determine the kind of the tag + begin + lElem := nil; + case Ch of + Ord('/'): + if UCS4ArrayEquals(St, '<') then + begin // "'), Ord(':'): //This should be a classic tag + begin // " + lElem := TJclSimpleXMLElemClassic.Create; + SetLength(St, 0); + lPos := rsWaitingTag; + end; + else + if ContainsText or (ContainsWhiteSpace and KeepWhiteSpace) then + begin + // inner text + lElem := TJclSimpleXMLElemText.Create; + lPos := rsReadingTagKind; + ContainsText := False; + ContainsWhiteSpace := False; + end + else + begin + if not UCS4ArrayEquals(St, ' nil then + begin + CreateElems; + FElems.Add(lElem); + Notify(lElem, opInsert); + lElem.LoadFromStringStream(StringStream); + end; + end; + end; + end; +end; + +procedure TJclSimpleXMLElems.Notify(Value: TJclSimpleXMLElem; Operation: TOperation); +var + NamedIndex: Integer; +begin + case Operation of + opRemove: + if Value.Parent = Parent then // Only remove if we have it + begin + if FNamedElems <> nil then + begin + NamedIndex := FNamedElems.IndexOfName(Value.Name); + if NamedIndex >= 0 then + TJclSimpleXMLNamedElems(FNamedElems.SimpleItems[NamedIndex]).FItems.Remove(Value); + end; + FElems.Remove(Value); + end; + opInsert: + begin + Value.FParent := Parent; + Value.FSimpleXML := Parent.SimpleXML; + end; + end; +end; + +function TJclSimpleXMLElems.Remove(Value: TJclSimpleXMLElem): Integer; +begin + if FElems = nil + then Result := -1 // like TList.IndexOf(alien) + else begin + Result := FElems.IndexOfSimpleItem(Value); + Notify(Value, opRemove); + end; +end; + +procedure TJclSimpleXMLElems.SaveToStringStream(StringStream: TJclStringStream; + const Level: string); +var + I: Integer; +begin + for I := 0 to Count - 1 do + Item[I].SaveToStringStream(StringStream, Level); +end; + +function TJclSimpleXMLElems.SimpleCompare(Elems: TJclSimpleXMLElems; Index1, + Index2: Integer): Integer; +begin + Result := CompareText(Elems.Item[Index1].Name, Elems.Item[Index2].Name); +end; + +function TJclSimpleXMLElems.Value(const Name, Default: string): string; +var + Elem: TJclSimpleXMLElem; +begin + Result := ''; + Elem := GetItemNamedDefault(Name, Default); + if Elem = nil then + Result := Default + else + Result := Elem.Value; +end; + +procedure TJclSimpleXMLElems.Move(const CurIndex, NewIndex: Integer); +begin + if FElems <> nil then + FElems.Move(CurIndex, NewIndex); +end; + +function TJclSimpleXMLElems.IndexOf(const Value: TJclSimpleXMLElem): Integer; +begin + if FElems = nil then + Result := -1 + else + Result := FElems.IndexOfSimpleItem(Value); +end; + +function TJclSimpleXMLElems.IndexOf(const Name: string): Integer; +begin + if FElems = nil then + Result := -1 + else + Result := FElems.IndexOfName(Name); +end; + +procedure TJclSimpleXMLElems.InsertChild(const Value: TJclSimpleXMLElem; Index: Integer); +var + NamedIndex: Integer; +begin + CreateElems; + + // If there already is a container, notify it to remove the element + if Assigned(Value.Parent) then begin + if (value.parent<>FParent) then begin + if FNamedElems <> nil then begin + NamedIndex := FNamedElems.IndexOfName(Value.Name); + if NamedIndex >= 0 then + TJclSimpleXMLNamedElems(FNamedElems.SimpleItems[NamedIndex]).FItems.Remove(Value); + end; + Value.FParent.items.FElems.Extract(Value); //EW here is the real difference + Value.FParent := nil; + Value.FSimpleXML := nil; + end + else + begin + Value.Parent.Items.Notify(Value, opRemove); + end; + end; + + FElems.Insert(Index, Value); + + if FNamedElems <> nil then + begin + NamedIndex := FNamedElems.IndexOfName(Value.Name); + if NamedIndex >= 0 then + TJclSimpleXMLNamedElems(FNamedElems.SimpleItems[NamedIndex]).FItems.Add(Value); + end; + + Notify(Value, opInsert); +end; + +function TJclSimpleXMLElems.Insert(Value: TJclSimpleXMLElem; + Index: Integer): TJclSimpleXMLElem; +begin + if Value <> nil then + InsertChild(Value, Index); + Result := Value; +end; + +function TJclSimpleXMLElems.Insert(const Name: string; + Index: Integer): TJclSimpleXMLElemClassic; +begin + Result := TJclSimpleXMLElemClassic.Create(Name); + InsertChild(Result, Index); +end; + +procedure QuickSort(Elems: TJclSimpleXMLElems; List: TList; L, R: Integer; + AFunction: TJclSimpleXMLElemCompare); +var + I, J, M: Integer; +begin + repeat + I := L; + J := R; + M := (L + R) shr 1; + repeat + while AFunction(Elems, I, M) < 0 do + Inc(I); + while AFunction(Elems, J, M) > 0 do + Dec(J); + if I < J then + begin + List.Exchange(I, J); + if M = I then + M := J + else if M = J then + M := I; + Inc(I); + Dec(J); + end + else + if I = J then + begin + Inc(I); + Dec(J); + end; + until I > J; + if L < J then + QuickSort(Elems, List, L, J, AFunction); + L := I; + until I >= R; +end; + +procedure TJclSimpleXMLElems.CustomSort(AFunction: TJclSimpleXMLElemCompare); +begin + if FElems <> nil then + QuickSort(Self, FElems, 0, FElems.Count - 1, AFunction); +end; + +procedure TJclSimpleXMLElems.Sort; +begin + CustomSort(SimpleCompare); +end; + +//=== { TJclSimpleXMLPropsEnumerator } ======================================= + +{$IFDEF SUPPORTS_FOR_IN} +constructor TJclSimpleXMLPropsEnumerator.Create(AList: TJclSimpleXMLProps); +begin + inherited Create; + FIndex := -1; + FList := AList; +end; + +function TJclSimpleXMLPropsEnumerator.GetCurrent: TJclSimpleXMLProp; +begin + Result := FList[FIndex]; +end; + +function TJclSimpleXMLPropsEnumerator.MoveNext: Boolean; +begin + Result := FIndex < FList.Count - 1; + if Result then + Inc(FIndex); +end; +{$ENDIF SUPPORTS_FOR_IN} + +//=== { TJclSimpleXMLProps } ================================================= + +function TJclSimpleXMLProps.Add(const Name, Value: string): TJclSimpleXMLProp; +begin + if FProperties = nil then + FProperties := TStringList.Create; + Result := TJclSimpleXMLProp.Create(Parent, Name, Value); + FProperties.AddObject(Name, Result); +end; + +function TJclSimpleXMLProps.Add(const Name: string; const Value: Int64): TJclSimpleXMLProp; +begin + Result := Add(Name, IntToStr(Value)); +end; + +function TJclSimpleXMLProps.Add(const Name: string; const Value: Boolean): TJclSimpleXMLProp; +begin + Result := Add(Name, BoolToStr(Value)); +end; + +{$IFDEF SUPPORTS_UNICODE} +function TJclSimpleXMLProps.Add(const Name: string; + const Value: AnsiString): TJclSimpleXMLProp; +begin + Result := Add(Name, string(Value)); +end; +{$ENDIF SUPPORTS_UNICODE} + +function TJclSimpleXMLProps.Insert(const Index: Integer; const Name, Value: string): TJclSimpleXMLProp; +begin + if FProperties = nil then + FProperties := TStringList.Create; + Result := TJclSimpleXMLProp.Create(Parent, Name, Value); + FProperties.InsertObject(Index, Name, Result); +end; + +function TJclSimpleXMLProps.Insert(const Index: Integer; const Name: string; const Value: Int64): TJclSimpleXMLProp; +begin + Result := Insert(Index, Name, IntToStr(Value)); +end; + +function TJclSimpleXMLProps.Insert(const Index: Integer; const Name: string; const Value: Boolean): TJclSimpleXMLProp; +begin + Result := Insert(Index, Name, BoolToStr(Value)); +end; + +function TJclSimpleXMLProps.BoolValue(const Name: string; Default: Boolean): Boolean; +var + Prop: TJclSimpleXMLProp; +begin + try + Prop := GetItemNamedDefault(Name, BoolToStr(Default)); + if (Prop = nil) or (Prop.Value = '') then + Result := Default + else + Result := Prop.BoolValue; + except + Result := Default; + end; +end; + +procedure TJclSimpleXMLProps.Clear; +var + I: Integer; +begin + if FProperties <> nil then + begin + for I := 0 to FProperties.Count - 1 do + begin + TJclSimpleXMLProp(FProperties.Objects[I]).Free; + FProperties.Objects[I] := nil; + end; + FProperties.Clear; + end; +end; + +procedure TJclSimpleXMLProps.Delete(const Index: Integer); +begin + if (FProperties <> nil) and (Index >= 0) and (Index < FProperties.Count) then + begin + TObject(FProperties.Objects[Index]).Free; + FProperties.Delete(Index); + end; +end; + +constructor TJclSimpleXMLProps.Create(AParent: TJclSimpleXMLElem); +begin + inherited Create; + FParent := AParent; +end; + +procedure TJclSimpleXMLProps.Delete(const Name: string); +begin + if FProperties <> nil then + Delete(FProperties.IndexOf(Name)); +end; + +destructor TJclSimpleXMLProps.Destroy; +begin + FParent := nil; + Clear; + FreeAndNil(FProperties); + inherited Destroy; +end; + +procedure TJclSimpleXMLProps.DoItemRename(Value: TJclSimpleXMLProp; const Name: string); +var + I: Integer; +begin + if FProperties = nil then + Exit; + I := FProperties.IndexOfObject(Value); + if I <> -1 then + FProperties[I] := Name; +end; + +procedure TJclSimpleXMLProps.Error(const S: string); +begin + raise EJclSimpleXMLError.Create(S); +end; + +function TJclSimpleXMLProps.FloatValue(const Name: string; + const Default: Extended): Extended; +var + Prop: TJclSimpleXMLProp; +begin + Prop := GetItemNamedDefault(Name, FloatToStr(Default)); + if Prop = nil then + Result := Default + else + Result := Prop.FloatValue; +end; + +procedure TJclSimpleXMLProps.FmtError(const S: string; + const Args: array of const); +begin + Error(Format(S, Args)); +end; + +function TJclSimpleXMLProps.GetCount: Integer; +begin + if FProperties = nil then + Result := 0 + else + Result := FProperties.Count; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclSimpleXMLProps.GetEnumerator: TJclSimpleXMLPropsEnumerator; +begin + Result := TJclSimpleXMLPropsEnumerator.Create(Self); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclSimpleXMLProps.GetItem(const Index: Integer): TJclSimpleXMLProp; +begin + if FProperties <> nil then + Result := TJclSimpleXMLProp(FProperties.Objects[Index]) + else + Result := nil; +end; + +function TJclSimpleXMLProps.GetItemNamedDefault(const Name, Default: string): TJclSimpleXMLProp; +var + I: Integer; +begin + Result := nil; + if FProperties <> nil then + begin + I := FProperties.IndexOf(Name); + if I <> -1 then + Result := TJclSimpleXMLProp(FProperties.Objects[I]) + else + if Assigned(FParent) and Assigned(FParent.SimpleXML) and (sxoAutoCreate in FParent.SimpleXML.Options) then + Result := Add(Name, Default); + end + else + if Assigned(FParent) and Assigned(FParent.SimpleXML) and (sxoAutoCreate in FParent.SimpleXML.Options) then + begin + Result := Add(Name, Default); + end; +end; + +function TJclSimpleXMLProps.GetItemNamed(const Name: string): TJclSimpleXMLProp; +begin + Result := GetItemNamedDefault(Name, ''); +end; + +function TJclSimpleXMLProps.GetSimpleXML: TJclSimpleXML; +begin + if FParent <> nil then + Result := FParent.SimpleXML + else + Result := nil; +end; + +function TJclSimpleXMLProps.IntValue(const Name: string; const Default: Int64): Int64; +var + Prop: TJclSimpleXMLProp; +begin + Prop := GetItemNamedDefault(Name, IntToStr(Default)); + if Prop = nil then + Result := Default + else + Result := Prop.IntValue; +end; + +procedure TJclSimpleXMLProps.LoadFromStringStream(StringStream: TJclStringStream); +// +//Stop on / or ? or > +type + TPosType = ( + ptWaiting, + ptReadingName, + ptStartingContent, + ptReadingValue, + ptSpaceBeforeEqual + ); +var + lPos: TPosType; + lName, lValue, lNameSpace: TUCS4Array; + sValue: string; + lPropStart: UCS4; + Ch: UCS4; +begin + SetLength(lValue, 0); + SetLength(lNameSpace, 0); + SetLength(lName, 0); + lPropStart := Ord(NativeSpace); + lPos := ptWaiting; + + // We read from a stream, thus replacing the existing properties + Clear; + + while StringStream.PeekUCS4(Ch) do + begin + case lPos of + ptWaiting: //We are waiting for a property + begin + if UnicodeIsWhiteSpace(Ch) then + StringStream.ReadUCS4(Ch) + else + if UnicodeIsIdentifierStart(Ch) or (Ch = Ord('-')) or (Ch = Ord('.')) or (Ch = Ord('_')) then + begin + StringStream.ReadUCS4(Ch); + lName := UCS4Array(Ch); + SetLength(lNameSpace, 0); + lPos := ptReadingName; + end + else + if (Ch = Ord('/')) or (Ch = Ord('>')) or (Ch = Ord('?')) then + // end of properties + Break + else + FmtError(LoadResString(@RsEInvalidXMLElementUnexpectedCharacte), [UCS4ToChar(Ch), StringStream.PeekPosition]); + end; + + ptReadingName: //We are reading a property name + begin + StringStream.ReadUCS4(Ch); + if UnicodeIsIdentifierPart(Ch) or (Ch = Ord('-')) or (Ch = Ord('.')) then + begin + UCS4ArrayConcat(lName, Ch); + end + else + if Ch = Ord(':') then + begin + lNameSpace := lName; + SetLength(lName, 0); + end + else + if Ch = Ord('=') then + lPos := ptStartingContent + else + if UnicodeIsWhiteSpace(Ch) then + lPos := ptSpaceBeforeEqual + else + FmtError(LoadResString(@RsEInvalidXMLElementUnexpectedCharacte), [UCS4ToChar(Ch), StringStream.PeekPosition]); + end; + + ptStartingContent: //We are going to start a property content + begin + StringStream.ReadUCS4(Ch); + if UnicodeIsWhiteSpace(Ch) then + // ignore white space + else + if (Ch = Ord('''')) or (Ch = Ord('"')) then + begin + lPropStart := Ch; + SetLength(lValue, 0); + lPos := ptReadingValue; + end + else + FmtError(LoadResString(@RsEInvalidXMLElementUnexpectedCharacte_), [UCS4ToChar(Ch), StringStream.PeekPosition]); + end; + + ptReadingValue: //We are reading a property + begin + StringStream.ReadUCS4(Ch); + if Ch = lPropStart then + begin + sValue := UCS4ToString(lValue); + if GetSimpleXML <> nil then + GetSimpleXML.DoDecodeValue(sValue); + with Add(UCS4ToString(lName), sValue) do + NameSpace := UCS4ToString(lNameSpace); + lPos := ptWaiting; + end + else + UCS4ArrayConcat(lValue, Ch); + end; + + ptSpaceBeforeEqual: // We are reading the white space between a property name and the = sign + begin + StringStream.ReadUCS4(Ch); + if UnicodeIsWhiteSpace(Ch) then + // more white space, stay in this state and ignore + else + if Ch = Ord('=') then + lPos := ptStartingContent + else + FmtError(LoadResString(@RsEInvalidXMLElementUnexpectedCharacte), [UCS4ToChar(Ch), StringStream.PeekPosition]); + end; + else + Assert(False, RsEUnexpectedValueForLPos); + end; + end; +end; + +procedure TJclSimpleXMLProps.SaveToStringStream(StringStream: TJclStringStream); +var + I: Integer; +begin + for I := 0 to Count - 1 do + Item[I].SaveToStringStream(StringStream); +end; + +procedure TJclSimpleXMLProps.SortProperties(const Order: array of string); +var + I, Index, InsertIndex: Integer; +begin + InsertIndex := 0; + for I := 0 to High(Order) do + begin + Index := FProperties.IndexOf(Order[I]); + if Index <> -1 then + begin + FProperties.Move(Index, InsertIndex); + Inc(InsertIndex); + end; + end; +end; + +function TJclSimpleXMLProps.Value(const Name, Default: string): string; +var + Prop: TJclSimpleXMLProp; +begin + Result := ''; + Prop := GetItemNamedDefault(Name, Default); + if Prop = nil then + Result := Default + else + Result := Prop.Value; +end; + +//=== { TJclSimpleXMLProp } ================================================== + +constructor TJclSimpleXMLProp.Create(AParent: TJclSimpleXMLElem; const AName, AValue: string); +begin + inherited Create(AName, AValue); + FParent := AParent; +end; + +function TJclSimpleXMLProp.GetSimpleXML: TJclSimpleXML; +begin + if FParent <> nil then + Result := FParent.SimpleXML + else + Result := nil; +end; + +procedure TJclSimpleXMLProp.SaveToStringStream(StringStream: TJclStringStream); +var + AEncoder: TJclSimpleXML; + Tmp: string; +begin + AEncoder := GetSimpleXML; + Tmp := Value; + if AEncoder <> nil then + AEncoder.DoEncodeValue(Tmp); + if NameSpace <> '' then + Tmp := Format(' %s:%s="%s"', [NameSpace, Name, Tmp]) + else + Tmp := Format(' %s="%s"', [Name, tmp]); + StringStream.WriteString(Tmp, 1, Length(Tmp)); +end; + +procedure TJclSimpleXMLProp.SetName(const Value: string); +begin + if (Value <> Name) and (Value <> '') then + begin + if (Parent <> nil) and (Name <> '') then + FParent.Properties.DoItemRename(Self, Value); + inherited SetName(Value); + end; +end; + +//=== { TJclSimpleXMLElemClassic } =========================================== + +procedure TJclSimpleXMLElemClassic.LoadFromStringStream(StringStream: TJclStringStream); +// +//foorbeuhbar +//foorbeuhbar +type + TReadStatus = (rsWaitingOpeningTag, rsOpeningName, rsTypeOpeningTag, rsEndSingleTag, + rsWaitingClosingTag1, rsWaitingClosingTag2, rsClosingName); +var + lPos: TReadStatus; + St, lName, lNameSpace: TUCS4Array; + sValue: string; + Ch: UCS4; +begin + SetLength(St, 0); + SetLength(lName, 0); + SetLength(lNameSpace, 0); + sValue := ''; + lPos := rsWaitingOpeningTag; + + if SimpleXML <> nil then + SimpleXML.DoLoadProgress(StringStream.Stream.Position, StringStream.Stream.Size); + + while StringStream.ReadUCS4(Ch) do + begin + case lPos of + rsWaitingOpeningTag: // wait beginning of tag + if Ch = Ord('<') then + lPos := rsOpeningName // read name + else + if not UnicodeIsWhiteSpace(Ch) then + FmtError(LoadResString(@RsEInvalidXMLElementExpectedBeginningO), [UCS4ToChar(Ch), StringStream.PeekPosition]); + + rsOpeningName: + if UnicodeIsIdentifierPart(Ch) or (Ch = Ord('-')) or (Ch = Ord('.')) then + UCS4ArrayConcat(St, Ch) + else + if (Ch = Ord(':')) and (Length(lNameSpace) = 0) then + begin + lNameSpace := St; + SetLength(st, 0); + end + else + if UnicodeIsWhiteSpace(Ch) and (Length(St) = 0) then + // whitespace after "<" (no name) + FmtError(LoadResString(@RsEInvalidXMLElementMalformedTagFoundn), [StringStream.PeekPosition]) + else + if UnicodeIsWhiteSpace(Ch) then + begin + lName := St; + SetLength(St, 0); + Properties.LoadFromStringStream(StringStream); + lPos := rsTypeOpeningTag; + end + else + if Ch = Ord('/') then // single tag + begin + lName := St; + lPos := rsEndSingleTag + end + else + if Ch = Ord('>') then // 2 tags + begin + lName := St; + SetLength(St, 0); + //Load elements + Items.LoadFromStringStream(StringStream); + lPos := rsWaitingClosingTag1; + end + else + // other invalid characters + FmtError(LoadResString(@RsEInvalidXMLElementMalformedTagFoundn), [StringStream.PeekPosition]); + + rsTypeOpeningTag: + if UnicodeIsWhiteSpace(Ch) then + // nothing, spaces after name or properties + else + if Ch = Ord('/') then + lPos := rsEndSingleTag // single tag + else + if Ch = Ord('>') then // 2 tags + begin + //Load elements + Items.LoadFromStringStream(StringStream); + lPos := rsWaitingClosingTag1; + end + else + FmtError(LoadResString(@RsEInvalidXMLElementExpectedEndOfTagBu), [UCS4ToChar(Ch), StringStream.PeekPosition]); + + rsEndSingleTag: + if Ch = Ord('>') then + Break + else + FmtError(LoadResString(@RsEInvalidXMLElementExpectedEndOfTagBu), [UCS4ToChar(Ch), StringStream.PeekPosition]); + + rsWaitingClosingTag1: + if UnicodeIsWhiteSpace(Ch) then + // nothing, spaces before closing tag + else + if Ch = Ord('<') then + lPos := rsWaitingClosingTag2 + else + FmtError(LoadResString(@RsEInvalidXMLElementExpectedEndOfTagBu), [UCS4ToChar(Ch), StringStream.PeekPosition]); + + rsWaitingClosingTag2: + if Ch = Ord('/') then + lPos := rsClosingName + else + FmtError(LoadResString(@RsEInvalidXMLElementExpectedEndOfTagBu), [UCS4ToChar(Ch), StringStream.PeekPosition]); + + rsClosingName: + if UnicodeIsWhiteSpace(Ch) or (Ch = Ord('>')) then + begin + if Length(lNameSpace) > 0 then + begin + if not StrSame(UCS4ToString(lNameSpace) + ':' + UCS4ToString(lName), UCS4ToString(St)) then + FmtError(LoadResString(@RsEInvalidXMLElementErroneousEndOfTagE), [UCS4ToString(lName), UCS4ToString(St), StringStream.PeekPosition]); + end + else + if not UCS4ArrayEquals(lName, St) then + FmtError(LoadResString(@RsEInvalidXMLElementErroneousEndOfTagE), [UCS4ToString(lName), UCS4ToString(St), StringStream.PeekPosition]); + //Set value if only one sub element + //This might reduce speed, but this is for compatibility issues + if (Items.Count = 1) and (Items[0] is TJclSimpleXMLElemText) then + begin + sValue := Items[0].Value; + Items.Clear; + // free some memory + FreeAndNil(FItems); + end; + Break; + end + else + if UnicodeIsIdentifierPart(Ch) or (Ch = Ord('-')) or (Ch = Ord('.')) or (Ch = Ord(':')) then + UCS4ArrayConcat(St, Ch) + else + // other invalid characters + FmtError(LoadResString(@RsEInvalidXMLElementMalformedTagFoundn), [StringStream.PeekPosition]); + end; + end; + + Name := UCS4ToString(lName); + if SimpleXML <> nil then + SimpleXML.DoDecodeValue(sValue); + Value := sValue; + NameSpace := UCS4ToString(lNameSpace); + + if SimpleXML <> nil then + begin + SimpleXML.DoTagParsed(Name); + SimpleXML.DoValueParsed(Name, sValue); + end; +end; + +procedure TJclSimpleXMLElemClassic.SaveToStringStream(StringStream: TJclStringStream; const Level: string); +var + St, AName, tmp: string; + LevelAdd: string; + AutoIndent: Boolean; +begin + if(NameSpace <> '') then + AName := NameSpace + ':' + Name + else + AName := Name; + + if Name <> '' then + begin + if SimpleXML <> nil then + SimpleXML.DoEncodeValue(AName); + St := Level + '<' + AName; + + StringStream.WriteString(St, 1, Length(St)); + if Assigned(FProps) then + FProps.SaveToStringStream(StringStream); + end; + + AutoIndent := (SimpleXML <> nil) and (sxoAutoIndent in SimpleXML.Options); + + if (ItemCount = 0) then + begin + tmp := Value; + if (Name <> '') then + begin + if Value = '' then + begin + if AutoIndent then + St := '/>' + sLineBreak + else + St := '/>'; + end + else + begin + if SimpleXML <> nil then + SimpleXML.DoEncodeValue(tmp); + if AutoIndent then + St := '>' + tmp + '' + sLineBreak + else + St := '>' + tmp + ''; + end; + StringStream.WriteString(St, 1, Length(St)); + end; + end + else + begin + if (Name <> '') then + begin + if AutoIndent then + St := '>' + sLineBreak + else + St := '>'; + StringStream.WriteString(St, 1, Length(St)); + end; + if AutoIndent then + begin + LevelAdd := SimpleXML.IndentString; + end; + FItems.SaveToStringStream(StringStream, Level + LevelAdd); + if Name <> '' then + begin + if AutoIndent then + St := Level + '' + sLineBreak + else + St := Level + ''; + StringStream.WriteString(St, 1, Length(St)); + end; + end; + if SimpleXML <> nil then + SimpleXML.DoSaveProgress; +end; + +//=== { TJclSimpleXMLElemComment } =========================================== + +procedure TJclSimpleXMLElemComment.LoadFromStringStream(StringStream: TJclStringStream); +// +const + CS_START_COMMENT = ''; +var + lPos: Integer; + St: TUCS4Array; + Ch: UCS4; + lOk: Boolean; +begin + SetLength(St, 0); + lPos := 1; + lOk := False; + + if SimpleXML <> nil then + SimpleXML.DoLoadProgress(StringStream.Stream.Position, StringStream.Stream.Size); + + while StringStream.ReadUCS4(Ch) do + begin + case lPos of + 1..4: //' + sLineBreak + else + St := '-->'; + StringStream.WriteString(St, 1, Length(St)); + if SimpleXML <> nil then + SimpleXML.DoSaveProgress; +end; + +//=== { TJclSimpleXMLElemCData } ============================================= + +procedure TJclSimpleXMLElemCData.LoadFromStringStream(StringStream: TJclStringStream); +//Hello, world!]]> +const + CS_START_CDATA = ''; +var + lPos: Integer; + St: TUCS4Array; + Ch: UCS4; + lOk: Boolean; +begin + SetLength(St, 0); + lPos := 1; + lOk := False; + + if SimpleXML <> nil then + SimpleXML.DoLoadProgress(StringStream.Stream.Position, StringStream.Stream.Size); + + while StringStream.ReadUCS4(Ch) do + begin + case lPos of + 1..9: // + if Ch = Ord(CS_STOP_CDATA[lPos]) then + begin + lOk := True; + Break; //End if + end + else + // ]]] + if Ch = Ord(CS_STOP_CDATA[lPos-1]) then + UCS4ArrayConcat(St, Ord(']')) + else + begin + UCS4ArrayConcat(St, Ord(']')); + UCS4ArrayConcat(St, Ord(']')); + UCS4ArrayConcat(St, Ch); + Dec(lPos, 2); + end; + end; + end; + + if not lOk then + FmtError(LoadResString(@RsEInvalidCDATAUnexpectedEndOfData), [StringStream.PeekPosition]); + + Value := UCS4ToString(St); + Name := ''; + + if SimpleXML <> nil then + SimpleXML.DoValueParsed('', Value); +end; + +procedure TJclSimpleXMLElemCData.SaveToStringStream(StringStream: TJclStringStream; const Level: string); +var + St: string; +begin + St := Level + ' '' then + StringStream.WriteString(Value, 1, Length(Value)); + if (SimpleXML <> nil) and (sxoAutoIndent in SimpleXML.Options) then + St := ']]>' + sLineBreak + else + St := ']]>'; + StringStream.WriteString(St, 1, Length(St)); + if SimpleXML <> nil then + SimpleXML.DoSaveProgress; +end; + +//=== { TJclSimpleXMLElemText } ============================================== + +procedure TJclSimpleXMLElemText.LoadFromStringStream(StringStream: TJclStringStream); +var + Ch: UCS4; + USt: TUCS4Array; + St, TrimValue: string; +begin + SetLength(USt, 0); + St := ''; + + if SimpleXML <> nil then + SimpleXML.DoLoadProgress(StringStream.Stream.Position, StringStream.Stream.Size); + + while StringStream.PeekUCS4(Ch) do + begin + case Ch of + Ord('<'): + //Quit text + Break; + else + begin + StringStream.ReadUCS4(Ch); + UCS4ArrayConcat(USt, Ch); + end; + end; + end; + + St := UCS4ToString(USt); + + if Assigned(SimpleXML) then + begin + SimpleXML.DoDecodeValue(St); + + TrimValue := St; + if sxoTrimPrecedingTextWhitespace in SimpleXML.Options then + TrimValue := TrimLeft(TrimValue); + if sxoTrimFollowingTextWhitespace in SimpleXML.Options then + TrimValue := TrimRight(TrimValue); + if (TrimValue <> '') or not (sxoKeepWhitespace in SimpleXML.Options) then + St := TrimValue; + end; + + Value := St; + Name := ''; + + if SimpleXML <> nil then + SimpleXML.DoValueParsed('', St); +end; + +procedure TJclSimpleXMLElemText.SaveToStringStream(StringStream: TJclStringStream; const Level: string); +var + St, tmp: string; +begin + // should never be used + if Value <> '' then + begin + tmp := Value; + if SimpleXML <> nil then + SimpleXML.DoEncodeValue(tmp); + if (SimpleXML <> nil) and (sxoAutoIndent in SimpleXML.Options) then + St := Level + tmp + sLineBreak + else + St := Level + tmp; + StringStream.WriteString(St, 1, Length(St)); + end; + if SimpleXML <> nil then + SimpleXML.DoSaveProgress; +end; + +//=== { TJclSimpleXMLElemProcessingInstruction } ============================= + +procedure TJclSimpleXMLElemProcessingInstruction.LoadFromStringStream( + StringStream: TJclStringStream); +type + TReadStatus = (rsWaitingOpeningTag, rsOpeningTag, rsOpeningName, rsEndTag1, rsEndTag2); +var + lPos: TReadStatus; + lOk: Boolean; + St, lName, lNameSpace: TUCS4Array; + Ch: UCS4; +begin + SetLength(St, 0); + SetLength(lName, 0); + SetLength(lNameSpace, 0); + lPos := rsWaitingOpeningTag; + lOk := False; + + if SimpleXML <> nil then + SimpleXML.DoLoadProgress(StringStream.Stream.Position, StringStream.Stream.Size); + + while StringStream.ReadUCS4(Ch) do + begin + case lPos of + rsWaitingOpeningTag: // wait beginning of tag + if Ch = Ord('<') then + lPos := rsOpeningTag + else + if not UnicodeIsWhiteSpace(Ch) then + FmtError(LoadResString(@RsEInvalidXMLElementExpectedBeginningO), [UCS4ToChar(Ch), StringStream.PeekPosition]); + + rsOpeningTag: + if Ch = Ord('?') then + lPos := rsOpeningName // read name + else + FmtError(LoadResString(@RsEInvalidXMLElementMalformedTagFoundn), [StringStream.PeekPosition]); + + rsOpeningName: + if UnicodeIsIdentifierPart(Ch) or (Ch = Ord('-')) or (Ch = Ord('.')) then + UCS4ArrayConcat(St, Ch) + else + if (Ch = Ord(':')) and (Length(lNameSpace) = 0) then + begin + lNameSpace := St; + SetLength(St, 0); + end + else + if UnicodeIsWhiteSpace(Ch) and (Length(St) = 0) then + // whitespace after "<" (no name) + FmtError(LoadResString(@RsEInvalidXMLElementMalformedTagFoundn), [StringStream.PeekPosition]) + else + if UnicodeIsWhiteSpace(Ch) then + begin + lName := St; + SetLength(St, 0); + Properties.LoadFromStringStream(StringStream); + lPos := rsEndTag1; + end + else + if Ch = Ord('?') then + begin + lName := St; + lPos := rsEndTag2; + end + else + // other invalid characters + FmtError(LoadResString(@RsEInvalidXMLElementMalformedTagFoundn), [StringStream.PeekPosition]); + + rsEndTag1: + if Ch = Ord('?') then + lPos := rsEndTag2 + else + if not UnicodeIsWhiteSpace(Ch) then + FmtError(LoadResString(@RsEInvalidXMLElementExpectedEndOfTagBu), [UCS4ToChar(Ch), StringStream.PeekPosition]); + + rsEndTag2: + if Ch = Ord('>') then + begin + lOk := True; + Break; + end + else + FmtError(LoadResString(@RsEInvalidXMLElementExpectedEndOfTagBu), [UCS4ToChar(Ch), StringStream.PeekPosition]); + end; + end; + + if not lOk then + FmtError(LoadResString(@RsEInvalidCommentUnexpectedEndOfData), [StringStream.PeekPosition]); + + Name := UCS4ToString(lName); + NameSpace := UCS4ToString(lNameSpace); +end; + +procedure TJclSimpleXMLElemProcessingInstruction.SaveToStringStream( + StringStream: TJclStringStream; const Level: string); +var + St: string; +begin + St := Level + ' '' then + St := St + NameSpace + ':' + Name + else + St := St + Name; + StringStream.WriteString(St, 1, Length(St)); + if Assigned(FProps) then + FProps.SaveToStringStream(StringStream); + if (SimpleXML <> nil) and (sxoAutoIndent in SimpleXML.Options) then + St := '?>' + sLineBreak + else + St := '?>'; + StringStream.WriteString(St, 1, Length(St)); + if SimpleXML <> nil then + SimpleXML.DoSaveProgress; +end; + +//=== { TJclSimpleXMLElemHeader } ============================================ + +constructor TJclSimpleXMLElemHeader.Create; +begin + inherited Create; + + Name := 'xml'; +end; + +function TJclSimpleXMLElemHeader.GetEncoding: string; +var + ASimpleXML: TJclSimpleXML; + DefaultCodePage: Word; +begin + ASimpleXML := SimpleXML; + if Assigned(ASimpleXML) then + begin + DefaultCodePage := ASimpleXML.CodePage; + {$IFDEF MSWINDOWS} + if DefaultCodePage = CP_ACP then + DefaultCodePage := GetAcp; + {$ENDIF MSWINDOWS} + end + else + {$IFDEF UNICODE} + DefaultCodePage := CP_UTF16LE; + {$ELSE ~UNICODE} + {$IFDEF MSWINDOWS} + DefaultCodePage := GetACP; + {$ELSE ~MSWINDOWS} + DefaultCodePage := 1252; + {$ENDIF ~MSWINDOWS} + {$ENDIF ~UNICODE} + Result := Properties.Value('encoding', CharsetNameFromCodePage(DefaultCodePage)); +end; + +function TJclSimpleXMLElemHeader.GetStandalone: Boolean; +begin + Result := Properties.Value('standalone') = 'yes'; +end; + +function TJclSimpleXMLElemHeader.GetVersion: string; +begin + Result := Properties.Value('version', '1.0'); +end; + +procedure TJclSimpleXMLElemHeader.LoadFromStringStream(StringStream: TJclStringStream); +// +var + CodePage: Word; + EncodingProp: TJclSimpleXMLProp; +begin + inherited LoadFromStringStream(StringStream); + + if Assigned(FProps) then + EncodingProp := FProps.ItemNamed['encoding'] + else + EncodingProp := nil; + if Assigned(EncodingProp) and (EncodingProp.Value <> '') then + CodePage := CodePageFromCharsetName(EncodingProp.Value) + else + CodePage := CP_ACP; + + // set current stringstream codepage + if StringStream is TJclAutoStream then + TJclAutoStream(StringStream).CodePage := CodePage + else + if StringStream is TJclAnsiStream then + TJclAnsiStream(StringStream).CodePage := CodePage + else + if not (StringStream is TJclUTF8Stream) and not (StringStream is TJclUTF16Stream) then + Error(LoadResString(@RsENoCharset)); +end; + +procedure TJclSimpleXMLElemHeader.SaveToStringStream( + StringStream: TJclStringStream; const Level: string); +begin + SetVersion(GetVersion); + SetEncoding(GetEncoding); + SetStandalone(GetStandalone); + Properties.SortProperties(['version', 'encoding', 'standalone']); + + inherited SaveToStringStream(StringStream, Level); +end; + +procedure TJclSimpleXMLElemHeader.SetEncoding(const Value: string); +var + Prop: TJclSimpleXMLProp; +begin + Prop := Properties.ItemNamed['encoding']; + if Assigned(Prop) then + Prop.Value := Value + else + Properties.Add('encoding', Value); +end; + +procedure TJclSimpleXMLElemHeader.SetStandalone(const Value: Boolean); +var + Prop: TJclSimpleXMLProp; +const + BooleanValues: array [Boolean] of string = ('no', 'yes'); +begin + Prop := Properties.ItemNamed['standalone']; + if Assigned(Prop) then + Prop.Value := BooleanValues[Value] + else + Properties.Add('standalone', BooleanValues[Value]); +end; + +procedure TJclSimpleXMLElemHeader.SetVersion(const Value: string); +var + Prop: TJclSimpleXMLProp; +begin + Prop := Properties.ItemNamed['version']; + if Assigned(Prop) then + Prop.Value := Value + else + // Various XML parsers (including MSIE, Firefox) require the "version" to be the first + Properties.Insert(0, 'version', Value); +end; + +//=== { TJclSimpleXMLElemDocType } =========================================== + +procedure TJclSimpleXMLElemDocType.LoadFromStringStream(StringStream: TJclStringStream); +{ + + +' > +%xx; +]> + + +} +const + CS_START_DOCTYPE = ''); + SetLength(St, 0); + + if SimpleXML <> nil then + SimpleXML.DoLoadProgress(StringStream.Stream.Position, StringStream.Stream.Size); + + while StringStream.ReadUCS4(Ch) do + begin + case lPos of + 1..9: // or > + if lChar = Ch then + begin + if lChar = Ord('>') then + begin + lOk := True; + Break; //This is the end + end + else + begin + UCS4ArrayConcat(St, Ch); + lChar := Ord('>'); + end; + end + else + begin + UCS4ArrayConcat(St, Ch); + if Ch = Ord('[') then + lChar := Ord(']'); + end; + end; + end; + + if not lOk then + FmtError(LoadResString(@RsEInvalidCommentUnexpectedEndOfData), [StringStream.PeekPosition]); + + Name := ''; + Value := StrTrimCharsLeft(UCS4ToString(St), CharIsWhiteSpace); + + if SimpleXML <> nil then + SimpleXML.DoValueParsed('', Value); +end; + +procedure TJclSimpleXMLElemDocType.SaveToStringStream(StringStream: TJclStringStream; + const Level: string); +var + St: string; +begin + if (SimpleXML <> nil) and (sxoAutoIndent in SimpleXML.Options) then + St := Level + '' + sLineBreak + else + St := Level + ''; + StringStream.WriteString(St, 1, Length(St)); + if SimpleXML <> nil then + SimpleXML.DoSaveProgress; +end; + +//=== { TJclSimpleXMLElemsPrologEnumerator } ================================= + +{$IFDEF SUPPORTS_FOR_IN} +constructor TJclSimpleXMLElemsPrologEnumerator.Create(AList: TJclSimpleXMLElemsProlog); +begin + inherited Create; + FIndex := -1; + FList := AList; +end; + +function TJclSimpleXMLElemsPrologEnumerator.GetCurrent: TJclSimpleXMLElem; +begin + Result := FList[FIndex]; +end; + +function TJclSimpleXMLElemsPrologEnumerator.MoveNext: Boolean; +begin + Result := FIndex < FList.Count - 1; + if Result then + Inc(FIndex); +end; +{$ENDIF SUPPORTS_FOR_IN} + +//=== { TJclSimpleXMLElemsProlog } =========================================== + +constructor TJclSimpleXMLElemsProlog.Create(ASimpleXML: TJclSimpleXML); +var + CaseSensitive: Boolean; +begin + inherited Create; + FSimpleXML := ASimpleXML; + CaseSensitive := Assigned(ASimpleXML) and (sxoCaseSensitive in ASimpleXML.Options); + FElems := TJclSimpleItemHashedList.Create(CaseSensitive); +end; + +destructor TJclSimpleXMLElemsProlog.Destroy; +begin + Clear; + FreeAndNil(FElems); + inherited Destroy; +end; + +procedure TJclSimpleXMLElemsProlog.Clear; +begin + FElems.Clear; +end; + +function TJclSimpleXMLElemsProlog.GetCount: Integer; +begin + Result := FElems.Count; +end; + +function TJclSimpleXMLElemsProlog.GetItem(const Index: Integer): TJclSimpleXMLElem; +begin + Result := TJclSimpleXMLElem(FElems.SimpleItems[Index]); +end; + +procedure TJclSimpleXMLElemsProlog.LoadFromStringStream(StringStream: TJclStringStream); +{ + + +]> +Hello, world! + + Hello, world! +} +var + lPos: Integer; + St: TUCS4Array; + lEnd: Boolean; + lElem: TJclSimpleXMLElem; + Ch: UCS4; +begin + SetLength(St, 0); + lPos := 0; + + if SimpleXML <> nil then + SimpleXML.DoLoadProgress(StringStream.Stream.Position, StringStream.Stream.Size); + + while StringStream.PeekUCS4(Ch) do + begin + case lPos of + 0: //We are waiting for a tag and thus avoiding spaces and any BOM + begin + if UnicodeIsWhiteSpace(Ch) then + // still waiting + else + if Ch = Ord('<') then + begin + lPos := 1; + St := UCS4Array(Ch); + end + else + FmtError(LoadResString(@RsEInvalidDocumentUnexpectedTextInFile), [StringStream.PeekPosition]); + end; + 1: //We are trying to determine the kind of the tag + begin + lElem := nil; + lEnd := False; + + if not UCS4ArrayEquals(St, ' 3) and (St[1] = Ord('?')) and UnicodeIsWhiteSpace(St[High(St)]) then + lElem := TJclSimpleXMLElemProcessingInstruction.Create(SimpleXML) + else + if (Length(St) > 1) and (St[1] <> Ord('!')) and (St[1] <> Ord('?')) then + lEnd := True; + + if lEnd then + Break + else + if lElem <> nil then + begin + FElems.Add(lElem); + lElem.LoadFromStringStream(StringStream); + SetLength(St, 0); + lPos := 0; + end; + end; + end; + end; +end; + +procedure TJclSimpleXMLElemsProlog.SaveToStringStream(StringStream: TJclStringStream); +var + I: Integer; +begin + FindHeader; + for I := 0 to Count - 1 do + Item[I].SaveToStringStream(StringStream, ''); +end; + +function VarXML: TVarType; +begin + Result := XMLVariant.VarType; +end; + +procedure XMLCreateInto(var ADest: Variant; const AXML: TJclSimpleXMLElem); +begin + TVarData(ADest).vType := VarXML; + TVarData(ADest).vAny := AXML; +end; + +function XMLCreate(const AXML: TJclSimpleXMLElem): Variant; +begin + XMLCreateInto(Result, AXML); +end; + +function XMLCreate: Variant; +begin + XMLCreateInto(Result, TJclSimpleXMLElemClassic.Create(nil)); +end; + +//=== { TXMLVariant } ======================================================== + +procedure TXMLVariant.CastTo(var Dest: TVarData; const Source: TVarData; + const AVarType: TVarType); +var + StorageStream: TStringStream; + ConversionString: TJclStringStream; +begin + if Source.vType = VarType then + begin + case AVarType of + varOleStr: + begin + StorageStream := TStringStream.Create(''); + try + ConversionString := TJclUTF16Stream.Create(StorageStream, False); + try + ConversionString.WriteBOM; + TJclSimpleXMLElem(Source.vAny).SaveToStringStream(ConversionString, ''); + ConversionString.Flush; + finally + ConversionString.Free; + end; + VarDataFromOleStr(Dest, StorageStream.DataString); + finally + StorageStream.Free; + end; + end; + varString: + begin + StorageStream := TStringStream.Create(''); + try + {$IFDEF SUPPORTS_UNICODE} + ConversionString := TJclUTF16Stream.Create(StorageStream, False); + {$ELSE ~SUPPORTS_UNICODE} + ConversionString := TJclAnsiStream.Create(StorageStream, False); + {$ENDIF ~SUPPORTS_UNICODE} + try + ConversionString.WriteBOM; + TJclSimpleXMLElem(Source.vAny).SaveToStringStream(ConversionString, ''); + ConversionString.Flush; + finally + ConversionString.Free; + end; + VarDataFromStr(Dest, StorageStream.DataString); + finally + StorageStream.Free; + end; + end; + {$IFDEF SUPPORTS_UNICODE_STRING} + varUString: + begin + StorageStream := TStringStream.Create(''); + try + ConversionString := TJclUTF16Stream.Create(StorageStream, False); + try + ConversionString.WriteBOM; + TJclSimpleXMLElem(Source.vAny).SaveToStringStream(ConversionString, ''); + ConversionString.Flush; + finally + ConversionString.Free; + end; + VarDataClear(Dest); + Dest.VUString := nil; + Dest.VType := varUString; + UnicodeString(Dest.VUString) := UnicodeString(StorageStream.DataString); + finally + StorageStream.Free; + end; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + else + RaiseCastError; + end; + end + else + inherited CastTo(Dest, Source, AVarType); +end; + +procedure TXMLVariant.Clear(var V: TVarData); +begin + V.vType := varEmpty; + V.vAny := nil; +end; + +procedure TXMLVariant.Copy(var Dest: TVarData; const Source: TVarData; + const Indirect: Boolean); +begin + if Indirect and VarDataIsByRef(Source) then + VarDataCopyNoInd(Dest, Source) + else + begin + Dest.vType := Source.vType; + Dest.vAny := Source.vAny; + end; +end; + +function TXMLVariant.DoFunction(var Dest: TVarData; const V: TVarData; + const Name: string; const Arguments: TVarDataArray): Boolean; +var + VXML, LXML: TJclSimpleXMLElem; + VElems: TJclSimpleXMLElems; + I, J, K: Integer; +begin + Result := False; + if (Length(Arguments) = 1) and (Arguments[0].vType in [vtInteger, vtExtended]) then + begin + VXML := TJclSimpleXMLElem(V.VAny); + K := Arguments[0].vInteger; + J := 0; + + if (K > 0) and VXML.HasItems then + begin + VElems := VXML.Items; + for I := 0 to VElems.Count - 1 do + if UpperCase(VElems.Item[I].Name) = Name then + begin + Inc(J); + if J = K then + Break; + end; + end; + + if (J = K) and (J < VXML.ItemCount) then + begin + LXML := VXML.Items[J]; + if LXML <> nil then + begin + Dest.vType := VarXML; + Dest.vAny := Pointer(LXML); + Result := True; + end + end; + end +end; + +function TXMLVariant.GetProperty(var Dest: TVarData; const V: TVarData; + const Name: string): Boolean; +var + VXML, LXML: TJclSimpleXMLElem; + lProp: TJclSimpleXMLProp; +begin + Result := False; + VXML := TJclSimpleXMLElem(V.VAny); + if VXML.HasItems then + begin + LXML := VXML.Items.ItemNamed[Name]; + if LXML <> nil then + begin + Dest.vType := VarXML; + Dest.vAny := Pointer(LXML); + Result := True; + end; + end; + if (not Result) and VXML.HasProperties then + begin + lProp := VXML.Properties.ItemNamed[Name]; + if lProp <> nil then + begin + VarDataFromOleStr(Dest, lProp.Value); + Result := True; + end; + end; +end; + +function TXMLVariant.IsClear(const V: TVarData): Boolean; +var + VXML: TJclSimpleXMLElem; +begin + VXML := TJclSimpleXMLElem(V.VAny); + Result := (VXML = nil) or (not VXML.HasItems); +end; + +function TXMLVariant.SetProperty(const V: TVarData; const Name: string; + const Value: TVarData): Boolean; + + function GetStrValue: string; + begin + try + Result := Value.VOleStr; + except + Result := ''; + end; + end; + +var + VXML, LXML: TJclSimpleXMLElem; + lProp: TJclSimpleXMLProp; +begin + Result := False; + VXML := TJclSimpleXMLElem(V.VAny); + if VXML.HasItems then + begin + LXML := VXML.Items.ItemNamed[Name]; + if LXML <> nil then + begin + LXML.Value := GetStrValue; + Result := True; + end; + end; + if (not Result) and VXML.HasProperties then + begin + lProp := VXML.Properties.ItemNamed[Name]; + if lProp <> nil then + begin + lProp.Value := GetStrValue; + Result := True; + end; + end; +end; + +procedure TJclSimpleXMLElemsProlog.Error(const S: string); +begin + raise EJclSimpleXMLError.Create(S); +end; + +procedure TJclSimpleXMLElemsProlog.FmtError(const S: string; + const Args: array of const); +begin + Error(Format(S, Args)); +end; + +procedure TJclSimpleXML.SetIndentString(const Value: string); +begin + // test if the new value is only made of spaces or tabs + if not StrContainsChars(Value, CharIsWhiteSpace, True) then + Exit; + FIndentString := Value; +end; + +procedure TJclSimpleXML.SetRoot(const Value: TJclSimpleXMLElemClassic); +begin + if Value <> FRoot then + begin +// FRoot.FSimpleXML := nil; + FRoot := Value; +// FRoot.FSimpleXML := Self; + end; +end; + +function TJclSimpleXMLElemsProlog.GetEncoding: string; +var + Elem: TJclSimpleXMLElemHeader; +begin + Elem := TJclSimpleXMLElemHeader(FindHeader); + if Elem <> nil then + Result := Elem.Encoding + else + Result := 'UTF-8'; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclSimpleXMLElemsProlog.GetEnumerator: TJclSimpleXMLElemsPrologEnumerator; +begin + Result := TJclSimpleXMLElemsPrologEnumerator.Create(Self); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclSimpleXMLElemsProlog.GetStandalone: Boolean; +var + Elem: TJclSimpleXMLElemHeader; +begin + Elem := TJclSimpleXMLElemHeader(FindHeader); + if Elem <> nil then + Result := Elem.Standalone + else + Result := False; +end; + +function TJclSimpleXMLElemsProlog.GetVersion: string; +var + Elem: TJclSimpleXMLElemHeader; +begin + Elem := TJclSimpleXMLElemHeader(FindHeader); + if Elem <> nil then + Result := Elem.Version + else + Result := '1.0'; +end; + +procedure TJclSimpleXMLElemsProlog.SetEncoding(const Value: string); +var + Elem: TJclSimpleXMLElemHeader; +begin + Elem := TJclSimpleXMLElemHeader(FindHeader); + if Elem <> nil then + Elem.Encoding := Value; +end; + +procedure TJclSimpleXMLElemsProlog.SetStandalone(const Value: Boolean); +var + Elem: TJclSimpleXMLElemHeader; +begin + Elem := TJclSimpleXMLElemHeader(FindHeader); + if Elem <> nil then + Elem.Standalone := Value; +end; + +procedure TJclSimpleXMLElemsProlog.SetVersion(const Value: string); +var + Elem: TJclSimpleXMLElemHeader; +begin + Elem := TJclSimpleXMLElemHeader(FindHeader); + if Elem <> nil then + Elem.Version := Value; +end; + +function TJclSimpleXMLElemsProlog.FindHeader: TJclSimpleXMLElem; +var + I: Integer; +begin + for I := 0 to Count - 1 do + if Item[I] is TJclSimpleXMLElemHeader then + begin + Result := Item[I]; + Exit; + end; + // (p3) if we get here, an xml header was not found + Result := TJclSimpleXMLElemHeader.Create(SimpleXML); + FElems.Add(Result); +end; + +function TJclSimpleXMLElemsProlog.AddStyleSheet(const AType, AHRef: string): TJclSimpleXMLElemSheet; +begin + // make sure there is an xml header + FindHeader; + Result := TJclSimpleXMLElemSheet.Create('xml-stylesheet'); + Result.Properties.Add('type',AType); + Result.Properties.Add('href',AHRef); + FElems.Add(Result); +end; + +function TJclSimpleXMLElemsProlog.AddMSOApplication(const AProgId : string): TJclSimpleXMLElemMSOApplication; +begin + // make sure there is an xml header + FindHeader; + Result := TJclSimpleXMLElemMSOApplication.Create('mso-application'); + Result.Properties.Add('progid',AProgId); + FElems.Add(Result); +end; + +function TJclSimpleXMLElemsProlog.AddComment(const AValue: string): TJclSimpleXMLElemComment; +begin + // make sure there is an xml header + FindHeader; + Result := TJclSimpleXMLElemComment.Create('', AValue); + FElems.Add(Result); +end; + +function TJclSimpleXMLElemsProlog.AddDocType(const AValue: string): TJclSimpleXMLElemDocType; +begin + // make sure there is an xml header + FindHeader; + Result := TJclSimpleXMLElemDocType.Create('', AValue); + FElems.Add(Result); +end; + +initialization + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + FreeAndNil(GlobalXMLVariant); + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclSortedMaps.pas b/3rdParty/JCL/source/common/JclSortedMaps.pas new file mode 100644 index 00000000..25338887 --- /dev/null +++ b/3rdParty/JCL/source/common/JclSortedMaps.pas @@ -0,0 +1,31820 @@ +{**************************************************************************************************} +{ WARNING: JEDI preprocessor generated unit. Do not edit. } +{**************************************************************************************************} + +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclSortedMaps.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet. Portions created by } +{ Florent Ouchet are Copyright (C) Florent Ouchet = record + Key: TKey; + Value: TValue; + end; + + TJclSortedMap = class(TJclAbstractContainerBase, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer, IJclPairOwner, + IJclMap, IJclSortedMap) + + protected + type + TSortedEntry = TJclSortedEntry; + TSortedEntryArray = array of TSortedEntry; + private + FOwnsKeys: Boolean; + FOwnsValues: Boolean; + protected + function KeysCompare(const A, B: TKey): Integer; virtual; abstract; + function ValuesCompare(const A, B: TValue): Integer; virtual; abstract; + function CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; virtual; abstract; + function CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; virtual; abstract; + public + { IJclPairOwner } + function FreeKey(var Key: TKey): TKey; + function FreeValue(var Value: TValue): TValue; + function GetOwnsKeys: Boolean; + function GetOwnsValues: Boolean; + property OwnsKeys: Boolean read FOwnsKeys; + property OwnsValues: Boolean read FOwnsValues; + private + FEntries: TSortedEntryArray; + function BinarySearch(const Key: TKey): Integer; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure MoveArray(var List: TSortedEntryArray; FromIndex, ToIndex, Count: SizeInt); + public + constructor Create(ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean); + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclMap } + procedure Clear; + function ContainsKey(const Key: TKey): Boolean; + function ContainsValue(const Value: TValue): Boolean; + function Extract(const Key: TKey): TValue; + function GetValue(const Key: TKey): TValue; + function IsEmpty: Boolean; + function KeyOfValue(const Value: TValue): TKey; + function KeySet: IJclSet; + function MapEquals(const AMap: IJclMap): Boolean; + procedure PutAll(const AMap: IJclMap); + procedure PutValue(const Key: TKey; const Value: TValue); + function Remove(const Key: TKey): TValue; + function Size: Integer; + function Values: IJclCollection; + { IJclSortedMap } + function FirstKey: TKey; + function HeadMap(const ToKey: TKey): IJclSortedMap; + function LastKey: TKey; + function SubMap(const FromKey, ToKey: TKey): IJclSortedMap; + function TailMap(const FromKey: TKey): IJclSortedMap; + end; + + // E = external helper to compare items + TJclSortedMapE = class(TJclSortedMap, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, IJclMap, IJclSortedMap, IJclPairOwner) + protected + type + TArrayList = TJclArrayListE; + TArraySet = TJclArraySetE; + private + FKeyComparer: IJclComparer; + FValueComparer: IJclComparer; + FValueEqualityComparer: IJclEqualityComparer; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function KeysCompare(const A, B: TKey): Integer; override; + function ValuesCompare(const A, B: TValue): Integer; override; + function CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; override; + public + constructor Create(const AKeyComparer: IJclComparer; const AValueComparer: IJclComparer; + const AValueEqualityComparer: IJclEqualityComparer; ACapacity: Integer; AOwnsValues: Boolean; + AOwnsKeys: Boolean); + + property KeyComparer: IJclComparer read FKeyComparer write FKeyComparer; + property ValueComparer: IJclComparer read FValueComparer write FValueComparer; + property ValueEqualityComparer: IJclEqualityComparer read FValueEqualityComparer write FValueEqualityComparer; + end; + + // F = Functions to compare items + TJclSortedMapF = class(TJclSortedMap, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, IJclMap, IJclSortedMap, IJclPairOwner) + protected + type + TArrayList = TJclArrayListF; + TArraySet = TJclArraySetF; + private + FKeyCompare: TCompare; + FValueCompare: TCompare; + FValueEqualityCompare: TEqualityCompare; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function KeysCompare(const A, B: TKey): Integer; override; + function ValuesCompare(const A, B: TValue): Integer; override; + function CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; override; + public + constructor Create(AKeyCompare: TCompare; AValueCompare: TCompare; + AValueEqualityCompare: TEqualityCompare; ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean); + + property KeyCompare: TCompare read FKeyCompare write FKeyCompare; + property ValueCompare: TCompare read FValueCompare write FValueCompare; + property ValueEqualityCompare: TEqualityCompare read FValueEqualityCompare write FValueEqualityCompare; + end; + + // I = items can compare themselves to an other + TJclSortedMapI; TValue: IComparable, IEquatable> = class(TJclSortedMap, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, + IJclMap, IJclSortedMap, IJclPairOwner) + protected + type + TArrayList = TJclArrayListI; + TArraySet = TJclArraySetI; + protected + function KeysCompare(const A, B: TKey): Integer; override; + function ValuesCompare(const A, B: TValue): Integer; override; + function CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; override; + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +{$IFDEF BCB} +{$IFDEF WIN64} + {$HPPEMIT '#ifdef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #undef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #define JclSortedMaps_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT '#endif'} + + {$HPPEMIT END '#ifdef JclSortedMaps_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #define MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #undef JclSortedMaps_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END '#endif'} +{$ENDIF WIN64} +{$ENDIF BCB} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +//=== { TJclIntfIntfSortedMap } ============================================== + +constructor TJclIntfIntfSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclIntfIntfSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfIntfSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclIntfIntfSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntfIntfSortedMap then + begin + MyDest := TJclIntfIntfSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclIntfIntfSortedMap.BinarySearch(const Key: IInterface): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfIntfSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfSortedMap.ContainsKey(const Key: IInterface): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfSortedMap.ContainsValue(const Value: IInterface): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfSortedMap.FirstKey: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfSortedMap.Extract(const Key: IInterface): IInterface; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfSortedMap.GetValue(const Key: IInterface): IInterface; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfSortedMap.HeadMap(const ToKey: IInterface): IJclIntfIntfSortedMap; +var + ToIndex: Integer; + NewMap: TJclIntfIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfIntfSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfSortedMap.KeyOfValue(const Value: IInterface): IInterface; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfSortedMap.KeySet: IJclIntfSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfSortedMap.LastKey: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfSortedMap.MapEquals(const AMap: IJclIntfIntfMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfIntfSortedMap.FinalizeArrayBeforeMove(var List: TJclIntfIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntfIntfSortedMap.InitializeArray(var List: TJclIntfIntfSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntfIntfSortedMap.InitializeArrayAfterMove(var List: TJclIntfIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntfIntfSortedMap.MoveArray(var List: TJclIntfIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclIntfIntfSortedMap.PutAll(const AMap: IJclIntfIntfMap); +var + It: IJclIntfIterator; + Key: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfIntfSortedMap.PutValue(const Key: IInterface; const Value: IInterface); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, nil) <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfSortedMap.Remove(const Key: IInterface): IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfIntfSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfIntfSortedMap.SubMap(const FromKey, ToKey: IInterface): IJclIntfIntfSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclIntfIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfIntfSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfSortedMap.TailMap(const FromKey: IInterface): IJclIntfIntfSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclIntfIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfIntfSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfSortedMap.Values: IJclIntfCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntfSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfIntfSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclIntfIntfSortedMap.FreeKey(var Key: IInterface): IInterface; +begin + Result := Key; + Key := nil; +end; + +function TJclIntfIntfSortedMap.FreeValue(var Value: IInterface): IInterface; +begin + Result := Value; + Value := nil; +end; + +function TJclIntfIntfSortedMap.KeysCompare(const A, B: IInterface): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclIntfIntfSortedMap.ValuesCompare(const A, B: IInterface): Integer; +begin + Result := ItemsCompare(A, B); +end; + +//=== { TJclAnsiStrIntfSortedMap } ============================================== + +constructor TJclAnsiStrIntfSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclAnsiStrIntfSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclAnsiStrIntfSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclAnsiStrIntfSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclAnsiStrIntfSortedMap then + begin + MyDest := TJclAnsiStrIntfSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclAnsiStrIntfSortedMap.BinarySearch(const Key: AnsiString): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrIntfSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfSortedMap.ContainsKey(const Key: AnsiString): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfSortedMap.ContainsValue(const Value: IInterface): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfSortedMap.FirstKey: AnsiString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfSortedMap.Extract(const Key: AnsiString): IInterface; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfSortedMap.GetValue(const Key: AnsiString): IInterface; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfSortedMap.HeadMap(const ToKey: AnsiString): IJclAnsiStrIntfSortedMap; +var + ToIndex: Integer; + NewMap: TJclAnsiStrIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclAnsiStrIntfSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfSortedMap.KeyOfValue(const Value: IInterface): AnsiString; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := ''; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfSortedMap.KeySet: IJclAnsiStrSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclAnsiStrArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfSortedMap.LastKey: AnsiString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfSortedMap.MapEquals(const AMap: IJclAnsiStrIntfMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrIntfSortedMap.FinalizeArrayBeforeMove(var List: TJclAnsiStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclAnsiStrIntfSortedMap.InitializeArray(var List: TJclAnsiStrIntfSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclAnsiStrIntfSortedMap.InitializeArrayAfterMove(var List: TJclAnsiStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclAnsiStrIntfSortedMap.MoveArray(var List: TJclAnsiStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclAnsiStrIntfSortedMap.PutAll(const AMap: IJclAnsiStrIntfMap); +var + It: IJclAnsiStrIterator; + Key: AnsiString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrIntfSortedMap.PutValue(const Key: AnsiString; const Value: IInterface); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, '') <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfSortedMap.Remove(const Key: AnsiString): IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrIntfSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclAnsiStrIntfSortedMap.SubMap(const FromKey, ToKey: AnsiString): IJclAnsiStrIntfSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclAnsiStrIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclAnsiStrIntfSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfSortedMap.TailMap(const FromKey: AnsiString): IJclAnsiStrIntfSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclAnsiStrIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclAnsiStrIntfSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfSortedMap.Values: IJclIntfCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrIntfSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclAnsiStrIntfSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclAnsiStrIntfSortedMap.FreeKey(var Key: AnsiString): AnsiString; +begin + Result := Key; + Key := ''; +end; + +function TJclAnsiStrIntfSortedMap.FreeValue(var Value: IInterface): IInterface; +begin + Result := Value; + Value := nil; +end; + +function TJclAnsiStrIntfSortedMap.KeysCompare(const A, B: AnsiString): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclAnsiStrIntfSortedMap.ValuesCompare(const A, B: IInterface): Integer; +begin + Result := IntfSimpleCompare(A, B); +end; + +//=== { TJclIntfAnsiStrSortedMap } ============================================== + +constructor TJclIntfAnsiStrSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclIntfAnsiStrSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfAnsiStrSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclIntfAnsiStrSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntfAnsiStrSortedMap then + begin + MyDest := TJclIntfAnsiStrSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclIntfAnsiStrSortedMap.BinarySearch(const Key: IInterface): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfAnsiStrSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrSortedMap.ContainsKey(const Key: IInterface): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrSortedMap.ContainsValue(const Value: AnsiString): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrSortedMap.FirstKey: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrSortedMap.Extract(const Key: IInterface): AnsiString; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := ''; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := ''; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrSortedMap.GetValue(const Key: IInterface): AnsiString; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := ''; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrSortedMap.HeadMap(const ToKey: IInterface): IJclIntfAnsiStrSortedMap; +var + ToIndex: Integer; + NewMap: TJclIntfAnsiStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfAnsiStrSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrSortedMap.KeyOfValue(const Value: AnsiString): IInterface; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrSortedMap.KeySet: IJclIntfSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrSortedMap.LastKey: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrSortedMap.MapEquals(const AMap: IJclIntfAnsiStrMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfAnsiStrSortedMap.FinalizeArrayBeforeMove(var List: TJclIntfAnsiStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntfAnsiStrSortedMap.InitializeArray(var List: TJclIntfAnsiStrSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntfAnsiStrSortedMap.InitializeArrayAfterMove(var List: TJclIntfAnsiStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntfAnsiStrSortedMap.MoveArray(var List: TJclIntfAnsiStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclIntfAnsiStrSortedMap.PutAll(const AMap: IJclIntfAnsiStrMap); +var + It: IJclIntfIterator; + Key: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfAnsiStrSortedMap.PutValue(const Key: IInterface; const Value: AnsiString); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, nil) <> 0) and (ValuesCompare(Value, '') <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrSortedMap.Remove(const Key: IInterface): AnsiString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfAnsiStrSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfAnsiStrSortedMap.SubMap(const FromKey, ToKey: IInterface): IJclIntfAnsiStrSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclIntfAnsiStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfAnsiStrSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrSortedMap.TailMap(const FromKey: IInterface): IJclIntfAnsiStrSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclIntfAnsiStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfAnsiStrSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrSortedMap.Values: IJclAnsiStrCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclAnsiStrArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfAnsiStrSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfAnsiStrSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclIntfAnsiStrSortedMap.FreeKey(var Key: IInterface): IInterface; +begin + Result := Key; + Key := nil; +end; + +function TJclIntfAnsiStrSortedMap.FreeValue(var Value: AnsiString): AnsiString; +begin + Result := Value; + Value := ''; +end; + +function TJclIntfAnsiStrSortedMap.KeysCompare(const A, B: IInterface): Integer; +begin + Result := IntfSimpleCompare(A, B); +end; + +function TJclIntfAnsiStrSortedMap.ValuesCompare(const A, B: AnsiString): Integer; +begin + Result := ItemsCompare(A, B); +end; + +//=== { TJclAnsiStrAnsiStrSortedMap } ============================================== + +constructor TJclAnsiStrAnsiStrSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclAnsiStrAnsiStrSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclAnsiStrAnsiStrSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclAnsiStrAnsiStrSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclAnsiStrAnsiStrSortedMap then + begin + MyDest := TJclAnsiStrAnsiStrSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclAnsiStrAnsiStrSortedMap.BinarySearch(const Key: AnsiString): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrAnsiStrSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrSortedMap.ContainsKey(const Key: AnsiString): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrSortedMap.ContainsValue(const Value: AnsiString): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrSortedMap.FirstKey: AnsiString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrSortedMap.Extract(const Key: AnsiString): AnsiString; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := ''; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := ''; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrSortedMap.GetValue(const Key: AnsiString): AnsiString; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := ''; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrSortedMap.HeadMap(const ToKey: AnsiString): IJclAnsiStrAnsiStrSortedMap; +var + ToIndex: Integer; + NewMap: TJclAnsiStrAnsiStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclAnsiStrAnsiStrSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrSortedMap.KeyOfValue(const Value: AnsiString): AnsiString; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := ''; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrSortedMap.KeySet: IJclAnsiStrSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclAnsiStrArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrSortedMap.LastKey: AnsiString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrSortedMap.MapEquals(const AMap: IJclAnsiStrAnsiStrMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrAnsiStrSortedMap.FinalizeArrayBeforeMove(var List: TJclAnsiStrAnsiStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclAnsiStrAnsiStrSortedMap.InitializeArray(var List: TJclAnsiStrAnsiStrSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclAnsiStrAnsiStrSortedMap.InitializeArrayAfterMove(var List: TJclAnsiStrAnsiStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclAnsiStrAnsiStrSortedMap.MoveArray(var List: TJclAnsiStrAnsiStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclAnsiStrAnsiStrSortedMap.PutAll(const AMap: IJclAnsiStrAnsiStrMap); +var + It: IJclAnsiStrIterator; + Key: AnsiString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrAnsiStrSortedMap.PutValue(const Key: AnsiString; const Value: AnsiString); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, '') <> 0) and (ValuesCompare(Value, '') <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrSortedMap.Remove(const Key: AnsiString): AnsiString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrAnsiStrSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclAnsiStrAnsiStrSortedMap.SubMap(const FromKey, ToKey: AnsiString): IJclAnsiStrAnsiStrSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclAnsiStrAnsiStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclAnsiStrAnsiStrSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrSortedMap.TailMap(const FromKey: AnsiString): IJclAnsiStrAnsiStrSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclAnsiStrAnsiStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclAnsiStrAnsiStrSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrSortedMap.Values: IJclAnsiStrCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclAnsiStrArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrAnsiStrSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclAnsiStrAnsiStrSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclAnsiStrAnsiStrSortedMap.FreeKey(var Key: AnsiString): AnsiString; +begin + Result := Key; + Key := ''; +end; + +function TJclAnsiStrAnsiStrSortedMap.FreeValue(var Value: AnsiString): AnsiString; +begin + Result := Value; + Value := ''; +end; + +function TJclAnsiStrAnsiStrSortedMap.KeysCompare(const A, B: AnsiString): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclAnsiStrAnsiStrSortedMap.ValuesCompare(const A, B: AnsiString): Integer; +begin + Result := ItemsCompare(A, B); +end; + +//=== { TJclWideStrIntfSortedMap } ============================================== + +constructor TJclWideStrIntfSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclWideStrIntfSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclWideStrIntfSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclWideStrIntfSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclWideStrIntfSortedMap then + begin + MyDest := TJclWideStrIntfSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclWideStrIntfSortedMap.BinarySearch(const Key: WideString): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrIntfSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfSortedMap.ContainsKey(const Key: WideString): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfSortedMap.ContainsValue(const Value: IInterface): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfSortedMap.FirstKey: WideString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfSortedMap.Extract(const Key: WideString): IInterface; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfSortedMap.GetValue(const Key: WideString): IInterface; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfSortedMap.HeadMap(const ToKey: WideString): IJclWideStrIntfSortedMap; +var + ToIndex: Integer; + NewMap: TJclWideStrIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclWideStrIntfSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfSortedMap.KeyOfValue(const Value: IInterface): WideString; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := ''; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfSortedMap.KeySet: IJclWideStrSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclWideStrArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfSortedMap.LastKey: WideString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfSortedMap.MapEquals(const AMap: IJclWideStrIntfMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrIntfSortedMap.FinalizeArrayBeforeMove(var List: TJclWideStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclWideStrIntfSortedMap.InitializeArray(var List: TJclWideStrIntfSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclWideStrIntfSortedMap.InitializeArrayAfterMove(var List: TJclWideStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclWideStrIntfSortedMap.MoveArray(var List: TJclWideStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclWideStrIntfSortedMap.PutAll(const AMap: IJclWideStrIntfMap); +var + It: IJclWideStrIterator; + Key: WideString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrIntfSortedMap.PutValue(const Key: WideString; const Value: IInterface); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, '') <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfSortedMap.Remove(const Key: WideString): IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrIntfSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclWideStrIntfSortedMap.SubMap(const FromKey, ToKey: WideString): IJclWideStrIntfSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclWideStrIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclWideStrIntfSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfSortedMap.TailMap(const FromKey: WideString): IJclWideStrIntfSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclWideStrIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclWideStrIntfSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfSortedMap.Values: IJclIntfCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrIntfSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclWideStrIntfSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclWideStrIntfSortedMap.FreeKey(var Key: WideString): WideString; +begin + Result := Key; + Key := ''; +end; + +function TJclWideStrIntfSortedMap.FreeValue(var Value: IInterface): IInterface; +begin + Result := Value; + Value := nil; +end; + +function TJclWideStrIntfSortedMap.KeysCompare(const A, B: WideString): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclWideStrIntfSortedMap.ValuesCompare(const A, B: IInterface): Integer; +begin + Result := IntfSimpleCompare(A, B); +end; + +//=== { TJclIntfWideStrSortedMap } ============================================== + +constructor TJclIntfWideStrSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclIntfWideStrSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfWideStrSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclIntfWideStrSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntfWideStrSortedMap then + begin + MyDest := TJclIntfWideStrSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclIntfWideStrSortedMap.BinarySearch(const Key: IInterface): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfWideStrSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrSortedMap.ContainsKey(const Key: IInterface): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrSortedMap.ContainsValue(const Value: WideString): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrSortedMap.FirstKey: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrSortedMap.Extract(const Key: IInterface): WideString; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := ''; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := ''; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrSortedMap.GetValue(const Key: IInterface): WideString; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := ''; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrSortedMap.HeadMap(const ToKey: IInterface): IJclIntfWideStrSortedMap; +var + ToIndex: Integer; + NewMap: TJclIntfWideStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfWideStrSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrSortedMap.KeyOfValue(const Value: WideString): IInterface; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrSortedMap.KeySet: IJclIntfSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrSortedMap.LastKey: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrSortedMap.MapEquals(const AMap: IJclIntfWideStrMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfWideStrSortedMap.FinalizeArrayBeforeMove(var List: TJclIntfWideStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntfWideStrSortedMap.InitializeArray(var List: TJclIntfWideStrSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntfWideStrSortedMap.InitializeArrayAfterMove(var List: TJclIntfWideStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntfWideStrSortedMap.MoveArray(var List: TJclIntfWideStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclIntfWideStrSortedMap.PutAll(const AMap: IJclIntfWideStrMap); +var + It: IJclIntfIterator; + Key: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfWideStrSortedMap.PutValue(const Key: IInterface; const Value: WideString); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, nil) <> 0) and (ValuesCompare(Value, '') <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrSortedMap.Remove(const Key: IInterface): WideString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfWideStrSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfWideStrSortedMap.SubMap(const FromKey, ToKey: IInterface): IJclIntfWideStrSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclIntfWideStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfWideStrSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrSortedMap.TailMap(const FromKey: IInterface): IJclIntfWideStrSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclIntfWideStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfWideStrSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrSortedMap.Values: IJclWideStrCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclWideStrArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfWideStrSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfWideStrSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclIntfWideStrSortedMap.FreeKey(var Key: IInterface): IInterface; +begin + Result := Key; + Key := nil; +end; + +function TJclIntfWideStrSortedMap.FreeValue(var Value: WideString): WideString; +begin + Result := Value; + Value := ''; +end; + +function TJclIntfWideStrSortedMap.KeysCompare(const A, B: IInterface): Integer; +begin + Result := IntfSimpleCompare(A, B); +end; + +function TJclIntfWideStrSortedMap.ValuesCompare(const A, B: WideString): Integer; +begin + Result := ItemsCompare(A, B); +end; + +//=== { TJclWideStrWideStrSortedMap } ============================================== + +constructor TJclWideStrWideStrSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclWideStrWideStrSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclWideStrWideStrSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclWideStrWideStrSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclWideStrWideStrSortedMap then + begin + MyDest := TJclWideStrWideStrSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclWideStrWideStrSortedMap.BinarySearch(const Key: WideString): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrWideStrSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrSortedMap.ContainsKey(const Key: WideString): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrSortedMap.ContainsValue(const Value: WideString): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrSortedMap.FirstKey: WideString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrSortedMap.Extract(const Key: WideString): WideString; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := ''; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := ''; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrSortedMap.GetValue(const Key: WideString): WideString; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := ''; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrSortedMap.HeadMap(const ToKey: WideString): IJclWideStrWideStrSortedMap; +var + ToIndex: Integer; + NewMap: TJclWideStrWideStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclWideStrWideStrSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrSortedMap.KeyOfValue(const Value: WideString): WideString; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := ''; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrSortedMap.KeySet: IJclWideStrSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclWideStrArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrSortedMap.LastKey: WideString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrSortedMap.MapEquals(const AMap: IJclWideStrWideStrMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrWideStrSortedMap.FinalizeArrayBeforeMove(var List: TJclWideStrWideStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclWideStrWideStrSortedMap.InitializeArray(var List: TJclWideStrWideStrSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclWideStrWideStrSortedMap.InitializeArrayAfterMove(var List: TJclWideStrWideStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclWideStrWideStrSortedMap.MoveArray(var List: TJclWideStrWideStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclWideStrWideStrSortedMap.PutAll(const AMap: IJclWideStrWideStrMap); +var + It: IJclWideStrIterator; + Key: WideString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrWideStrSortedMap.PutValue(const Key: WideString; const Value: WideString); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, '') <> 0) and (ValuesCompare(Value, '') <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrSortedMap.Remove(const Key: WideString): WideString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrWideStrSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclWideStrWideStrSortedMap.SubMap(const FromKey, ToKey: WideString): IJclWideStrWideStrSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclWideStrWideStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclWideStrWideStrSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrSortedMap.TailMap(const FromKey: WideString): IJclWideStrWideStrSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclWideStrWideStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclWideStrWideStrSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrSortedMap.Values: IJclWideStrCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclWideStrArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrWideStrSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclWideStrWideStrSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclWideStrWideStrSortedMap.FreeKey(var Key: WideString): WideString; +begin + Result := Key; + Key := ''; +end; + +function TJclWideStrWideStrSortedMap.FreeValue(var Value: WideString): WideString; +begin + Result := Value; + Value := ''; +end; + +function TJclWideStrWideStrSortedMap.KeysCompare(const A, B: WideString): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclWideStrWideStrSortedMap.ValuesCompare(const A, B: WideString): Integer; +begin + Result := ItemsCompare(A, B); +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrIntfSortedMap } ============================================== + +constructor TJclUnicodeStrIntfSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclUnicodeStrIntfSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclUnicodeStrIntfSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclUnicodeStrIntfSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclUnicodeStrIntfSortedMap then + begin + MyDest := TJclUnicodeStrIntfSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclUnicodeStrIntfSortedMap.BinarySearch(const Key: UnicodeString): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrIntfSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfSortedMap.ContainsKey(const Key: UnicodeString): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfSortedMap.ContainsValue(const Value: IInterface): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfSortedMap.FirstKey: UnicodeString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfSortedMap.Extract(const Key: UnicodeString): IInterface; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfSortedMap.GetValue(const Key: UnicodeString): IInterface; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfSortedMap.HeadMap(const ToKey: UnicodeString): IJclUnicodeStrIntfSortedMap; +var + ToIndex: Integer; + NewMap: TJclUnicodeStrIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclUnicodeStrIntfSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfSortedMap.KeyOfValue(const Value: IInterface): UnicodeString; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := ''; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfSortedMap.KeySet: IJclUnicodeStrSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclUnicodeStrArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfSortedMap.LastKey: UnicodeString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfSortedMap.MapEquals(const AMap: IJclUnicodeStrIntfMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrIntfSortedMap.FinalizeArrayBeforeMove(var List: TJclUnicodeStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclUnicodeStrIntfSortedMap.InitializeArray(var List: TJclUnicodeStrIntfSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclUnicodeStrIntfSortedMap.InitializeArrayAfterMove(var List: TJclUnicodeStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclUnicodeStrIntfSortedMap.MoveArray(var List: TJclUnicodeStrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclUnicodeStrIntfSortedMap.PutAll(const AMap: IJclUnicodeStrIntfMap); +var + It: IJclUnicodeStrIterator; + Key: UnicodeString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrIntfSortedMap.PutValue(const Key: UnicodeString; const Value: IInterface); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, '') <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfSortedMap.Remove(const Key: UnicodeString): IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrIntfSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclUnicodeStrIntfSortedMap.SubMap(const FromKey, ToKey: UnicodeString): IJclUnicodeStrIntfSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclUnicodeStrIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclUnicodeStrIntfSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfSortedMap.TailMap(const FromKey: UnicodeString): IJclUnicodeStrIntfSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclUnicodeStrIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclUnicodeStrIntfSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfSortedMap.Values: IJclIntfCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrIntfSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclUnicodeStrIntfSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclUnicodeStrIntfSortedMap.FreeKey(var Key: UnicodeString): UnicodeString; +begin + Result := Key; + Key := ''; +end; + +function TJclUnicodeStrIntfSortedMap.FreeValue(var Value: IInterface): IInterface; +begin + Result := Value; + Value := nil; +end; + +function TJclUnicodeStrIntfSortedMap.KeysCompare(const A, B: UnicodeString): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclUnicodeStrIntfSortedMap.ValuesCompare(const A, B: IInterface): Integer; +begin + Result := IntfSimpleCompare(A, B); +end; + +{$ENDIF SUPPORTS_UNICODE_STRING} + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclIntfUnicodeStrSortedMap } ============================================== + +constructor TJclIntfUnicodeStrSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclIntfUnicodeStrSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfUnicodeStrSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclIntfUnicodeStrSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntfUnicodeStrSortedMap then + begin + MyDest := TJclIntfUnicodeStrSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclIntfUnicodeStrSortedMap.BinarySearch(const Key: IInterface): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfUnicodeStrSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrSortedMap.ContainsKey(const Key: IInterface): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrSortedMap.ContainsValue(const Value: UnicodeString): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrSortedMap.FirstKey: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrSortedMap.Extract(const Key: IInterface): UnicodeString; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := ''; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := ''; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrSortedMap.GetValue(const Key: IInterface): UnicodeString; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := ''; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrSortedMap.HeadMap(const ToKey: IInterface): IJclIntfUnicodeStrSortedMap; +var + ToIndex: Integer; + NewMap: TJclIntfUnicodeStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfUnicodeStrSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrSortedMap.KeyOfValue(const Value: UnicodeString): IInterface; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrSortedMap.KeySet: IJclIntfSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrSortedMap.LastKey: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrSortedMap.MapEquals(const AMap: IJclIntfUnicodeStrMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfUnicodeStrSortedMap.FinalizeArrayBeforeMove(var List: TJclIntfUnicodeStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntfUnicodeStrSortedMap.InitializeArray(var List: TJclIntfUnicodeStrSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntfUnicodeStrSortedMap.InitializeArrayAfterMove(var List: TJclIntfUnicodeStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntfUnicodeStrSortedMap.MoveArray(var List: TJclIntfUnicodeStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclIntfUnicodeStrSortedMap.PutAll(const AMap: IJclIntfUnicodeStrMap); +var + It: IJclIntfIterator; + Key: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfUnicodeStrSortedMap.PutValue(const Key: IInterface; const Value: UnicodeString); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, nil) <> 0) and (ValuesCompare(Value, '') <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrSortedMap.Remove(const Key: IInterface): UnicodeString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfUnicodeStrSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfUnicodeStrSortedMap.SubMap(const FromKey, ToKey: IInterface): IJclIntfUnicodeStrSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclIntfUnicodeStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfUnicodeStrSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrSortedMap.TailMap(const FromKey: IInterface): IJclIntfUnicodeStrSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclIntfUnicodeStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfUnicodeStrSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrSortedMap.Values: IJclUnicodeStrCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclUnicodeStrArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfUnicodeStrSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfUnicodeStrSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclIntfUnicodeStrSortedMap.FreeKey(var Key: IInterface): IInterface; +begin + Result := Key; + Key := nil; +end; + +function TJclIntfUnicodeStrSortedMap.FreeValue(var Value: UnicodeString): UnicodeString; +begin + Result := Value; + Value := ''; +end; + +function TJclIntfUnicodeStrSortedMap.KeysCompare(const A, B: IInterface): Integer; +begin + Result := IntfSimpleCompare(A, B); +end; + +function TJclIntfUnicodeStrSortedMap.ValuesCompare(const A, B: UnicodeString): Integer; +begin + Result := ItemsCompare(A, B); +end; + +{$ENDIF SUPPORTS_UNICODE_STRING} + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrUnicodeStrSortedMap } ============================================== + +constructor TJclUnicodeStrUnicodeStrSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclUnicodeStrUnicodeStrSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclUnicodeStrUnicodeStrSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclUnicodeStrUnicodeStrSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclUnicodeStrUnicodeStrSortedMap then + begin + MyDest := TJclUnicodeStrUnicodeStrSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclUnicodeStrUnicodeStrSortedMap.BinarySearch(const Key: UnicodeString): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrUnicodeStrSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrSortedMap.ContainsKey(const Key: UnicodeString): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrSortedMap.ContainsValue(const Value: UnicodeString): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrSortedMap.FirstKey: UnicodeString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrSortedMap.Extract(const Key: UnicodeString): UnicodeString; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := ''; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := ''; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrSortedMap.GetValue(const Key: UnicodeString): UnicodeString; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := ''; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrSortedMap.HeadMap(const ToKey: UnicodeString): IJclUnicodeStrUnicodeStrSortedMap; +var + ToIndex: Integer; + NewMap: TJclUnicodeStrUnicodeStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclUnicodeStrUnicodeStrSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrSortedMap.KeyOfValue(const Value: UnicodeString): UnicodeString; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := ''; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrSortedMap.KeySet: IJclUnicodeStrSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclUnicodeStrArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrSortedMap.LastKey: UnicodeString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrSortedMap.MapEquals(const AMap: IJclUnicodeStrUnicodeStrMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrUnicodeStrSortedMap.FinalizeArrayBeforeMove(var List: TJclUnicodeStrUnicodeStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclUnicodeStrUnicodeStrSortedMap.InitializeArray(var List: TJclUnicodeStrUnicodeStrSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclUnicodeStrUnicodeStrSortedMap.InitializeArrayAfterMove(var List: TJclUnicodeStrUnicodeStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclUnicodeStrUnicodeStrSortedMap.MoveArray(var List: TJclUnicodeStrUnicodeStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclUnicodeStrUnicodeStrSortedMap.PutAll(const AMap: IJclUnicodeStrUnicodeStrMap); +var + It: IJclUnicodeStrIterator; + Key: UnicodeString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrUnicodeStrSortedMap.PutValue(const Key: UnicodeString; const Value: UnicodeString); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, '') <> 0) and (ValuesCompare(Value, '') <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrSortedMap.Remove(const Key: UnicodeString): UnicodeString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrUnicodeStrSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclUnicodeStrUnicodeStrSortedMap.SubMap(const FromKey, ToKey: UnicodeString): IJclUnicodeStrUnicodeStrSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclUnicodeStrUnicodeStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclUnicodeStrUnicodeStrSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrSortedMap.TailMap(const FromKey: UnicodeString): IJclUnicodeStrUnicodeStrSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclUnicodeStrUnicodeStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclUnicodeStrUnicodeStrSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrSortedMap.Values: IJclUnicodeStrCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclUnicodeStrArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrUnicodeStrSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclUnicodeStrUnicodeStrSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclUnicodeStrUnicodeStrSortedMap.FreeKey(var Key: UnicodeString): UnicodeString; +begin + Result := Key; + Key := ''; +end; + +function TJclUnicodeStrUnicodeStrSortedMap.FreeValue(var Value: UnicodeString): UnicodeString; +begin + Result := Value; + Value := ''; +end; + +function TJclUnicodeStrUnicodeStrSortedMap.KeysCompare(const A, B: UnicodeString): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclUnicodeStrUnicodeStrSortedMap.ValuesCompare(const A, B: UnicodeString): Integer; +begin + Result := ItemsCompare(A, B); +end; + +{$ENDIF SUPPORTS_UNICODE_STRING} + +//=== { TJclSingleIntfSortedMap } ============================================== + +constructor TJclSingleIntfSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclSingleIntfSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclSingleIntfSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclSingleIntfSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclSingleIntfSortedMap then + begin + MyDest := TJclSingleIntfSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclSingleIntfSortedMap.BinarySearch(const Key: Single): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleIntfSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfSortedMap.ContainsKey(const Key: Single): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfSortedMap.ContainsValue(const Value: IInterface): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfSortedMap.FirstKey: Single; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfSortedMap.Extract(const Key: Single): IInterface; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfSortedMap.GetValue(const Key: Single): IInterface; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfSortedMap.HeadMap(const ToKey: Single): IJclSingleIntfSortedMap; +var + ToIndex: Integer; + NewMap: TJclSingleIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclSingleIntfSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfSortedMap.KeyOfValue(const Value: IInterface): Single; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0.0; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfSortedMap.KeySet: IJclSingleSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclSingleArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfSortedMap.LastKey: Single; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfSortedMap.MapEquals(const AMap: IJclSingleIntfMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleIntfSortedMap.FinalizeArrayBeforeMove(var List: TJclSingleIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclSingleIntfSortedMap.InitializeArray(var List: TJclSingleIntfSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclSingleIntfSortedMap.InitializeArrayAfterMove(var List: TJclSingleIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclSingleIntfSortedMap.MoveArray(var List: TJclSingleIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclSingleIntfSortedMap.PutAll(const AMap: IJclSingleIntfMap); +var + It: IJclSingleIterator; + Key: Single; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleIntfSortedMap.PutValue(const Key: Single; const Value: IInterface); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, 0.0) <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfSortedMap.Remove(const Key: Single): IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleIntfSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclSingleIntfSortedMap.SubMap(const FromKey, ToKey: Single): IJclSingleIntfSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclSingleIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclSingleIntfSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfSortedMap.TailMap(const FromKey: Single): IJclSingleIntfSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclSingleIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclSingleIntfSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfSortedMap.Values: IJclIntfCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleIntfSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclSingleIntfSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclSingleIntfSortedMap.FreeKey(var Key: Single): Single; +begin + Result := Key; + Key := 0.0; +end; + +function TJclSingleIntfSortedMap.FreeValue(var Value: IInterface): IInterface; +begin + Result := Value; + Value := nil; +end; + +function TJclSingleIntfSortedMap.KeysCompare(const A, B: Single): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclSingleIntfSortedMap.ValuesCompare(const A, B: IInterface): Integer; +begin + Result := IntfSimpleCompare(A, B); +end; + +//=== { TJclIntfSingleSortedMap } ============================================== + +constructor TJclIntfSingleSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclIntfSingleSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfSingleSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclIntfSingleSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntfSingleSortedMap then + begin + MyDest := TJclIntfSingleSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclIntfSingleSortedMap.BinarySearch(const Key: IInterface): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfSingleSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleSortedMap.ContainsKey(const Key: IInterface): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleSortedMap.ContainsValue(const Value: Single): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleSortedMap.FirstKey: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleSortedMap.Extract(const Key: IInterface): Single; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := 0.0; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := 0.0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleSortedMap.GetValue(const Key: IInterface): Single; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := 0.0; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleSortedMap.HeadMap(const ToKey: IInterface): IJclIntfSingleSortedMap; +var + ToIndex: Integer; + NewMap: TJclIntfSingleSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfSingleSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleSortedMap.KeyOfValue(const Value: Single): IInterface; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleSortedMap.KeySet: IJclIntfSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleSortedMap.LastKey: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleSortedMap.MapEquals(const AMap: IJclIntfSingleMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfSingleSortedMap.FinalizeArrayBeforeMove(var List: TJclIntfSingleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntfSingleSortedMap.InitializeArray(var List: TJclIntfSingleSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntfSingleSortedMap.InitializeArrayAfterMove(var List: TJclIntfSingleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntfSingleSortedMap.MoveArray(var List: TJclIntfSingleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclIntfSingleSortedMap.PutAll(const AMap: IJclIntfSingleMap); +var + It: IJclIntfIterator; + Key: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfSingleSortedMap.PutValue(const Key: IInterface; const Value: Single); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, nil) <> 0) and (ValuesCompare(Value, 0.0) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleSortedMap.Remove(const Key: IInterface): Single; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfSingleSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfSingleSortedMap.SubMap(const FromKey, ToKey: IInterface): IJclIntfSingleSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclIntfSingleSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfSingleSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleSortedMap.TailMap(const FromKey: IInterface): IJclIntfSingleSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclIntfSingleSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfSingleSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleSortedMap.Values: IJclSingleCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclSingleArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSingleSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfSingleSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclIntfSingleSortedMap.FreeKey(var Key: IInterface): IInterface; +begin + Result := Key; + Key := nil; +end; + +function TJclIntfSingleSortedMap.FreeValue(var Value: Single): Single; +begin + Result := Value; + Value := 0.0; +end; + +function TJclIntfSingleSortedMap.KeysCompare(const A, B: IInterface): Integer; +begin + Result := IntfSimpleCompare(A, B); +end; + +function TJclIntfSingleSortedMap.ValuesCompare(const A, B: Single): Integer; +begin + Result := ItemsCompare(A, B); +end; + +//=== { TJclSingleSingleSortedMap } ============================================== + +constructor TJclSingleSingleSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclSingleSingleSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclSingleSingleSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclSingleSingleSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclSingleSingleSortedMap then + begin + MyDest := TJclSingleSingleSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclSingleSingleSortedMap.BinarySearch(const Key: Single): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleSingleSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleSortedMap.ContainsKey(const Key: Single): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleSortedMap.ContainsValue(const Value: Single): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleSortedMap.FirstKey: Single; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleSortedMap.Extract(const Key: Single): Single; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := 0.0; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := 0.0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleSortedMap.GetValue(const Key: Single): Single; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := 0.0; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleSortedMap.HeadMap(const ToKey: Single): IJclSingleSingleSortedMap; +var + ToIndex: Integer; + NewMap: TJclSingleSingleSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclSingleSingleSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleSortedMap.KeyOfValue(const Value: Single): Single; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0.0; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleSortedMap.KeySet: IJclSingleSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclSingleArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleSortedMap.LastKey: Single; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleSortedMap.MapEquals(const AMap: IJclSingleSingleMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleSingleSortedMap.InitializeArrayAfterMove(var List: TJclSingleSingleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclSingleSingleSortedMap.MoveArray(var List: TJclSingleSingleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclSingleSingleSortedMap.PutAll(const AMap: IJclSingleSingleMap); +var + It: IJclSingleIterator; + Key: Single; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleSingleSortedMap.PutValue(const Key: Single; const Value: Single); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, 0.0) <> 0) and (ValuesCompare(Value, 0.0) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleSortedMap.Remove(const Key: Single): Single; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleSingleSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclSingleSingleSortedMap.SubMap(const FromKey, ToKey: Single): IJclSingleSingleSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclSingleSingleSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclSingleSingleSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleSortedMap.TailMap(const FromKey: Single): IJclSingleSingleSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclSingleSingleSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclSingleSingleSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleSortedMap.Values: IJclSingleCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclSingleArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSingleSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclSingleSingleSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclSingleSingleSortedMap.FreeKey(var Key: Single): Single; +begin + Result := Key; + Key := 0.0; +end; + +function TJclSingleSingleSortedMap.FreeValue(var Value: Single): Single; +begin + Result := Value; + Value := 0.0; +end; + +function TJclSingleSingleSortedMap.KeysCompare(const A, B: Single): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclSingleSingleSortedMap.ValuesCompare(const A, B: Single): Integer; +begin + Result := ItemsCompare(A, B); +end; + +//=== { TJclDoubleIntfSortedMap } ============================================== + +constructor TJclDoubleIntfSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclDoubleIntfSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclDoubleIntfSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclDoubleIntfSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclDoubleIntfSortedMap then + begin + MyDest := TJclDoubleIntfSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclDoubleIntfSortedMap.BinarySearch(const Key: Double): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleIntfSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfSortedMap.ContainsKey(const Key: Double): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfSortedMap.ContainsValue(const Value: IInterface): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfSortedMap.FirstKey: Double; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfSortedMap.Extract(const Key: Double): IInterface; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfSortedMap.GetValue(const Key: Double): IInterface; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfSortedMap.HeadMap(const ToKey: Double): IJclDoubleIntfSortedMap; +var + ToIndex: Integer; + NewMap: TJclDoubleIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclDoubleIntfSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfSortedMap.KeyOfValue(const Value: IInterface): Double; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0.0; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfSortedMap.KeySet: IJclDoubleSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclDoubleArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfSortedMap.LastKey: Double; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfSortedMap.MapEquals(const AMap: IJclDoubleIntfMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleIntfSortedMap.FinalizeArrayBeforeMove(var List: TJclDoubleIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclDoubleIntfSortedMap.InitializeArray(var List: TJclDoubleIntfSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclDoubleIntfSortedMap.InitializeArrayAfterMove(var List: TJclDoubleIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclDoubleIntfSortedMap.MoveArray(var List: TJclDoubleIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclDoubleIntfSortedMap.PutAll(const AMap: IJclDoubleIntfMap); +var + It: IJclDoubleIterator; + Key: Double; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleIntfSortedMap.PutValue(const Key: Double; const Value: IInterface); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, 0.0) <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfSortedMap.Remove(const Key: Double): IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleIntfSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclDoubleIntfSortedMap.SubMap(const FromKey, ToKey: Double): IJclDoubleIntfSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclDoubleIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclDoubleIntfSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfSortedMap.TailMap(const FromKey: Double): IJclDoubleIntfSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclDoubleIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclDoubleIntfSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfSortedMap.Values: IJclIntfCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleIntfSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclDoubleIntfSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclDoubleIntfSortedMap.FreeKey(var Key: Double): Double; +begin + Result := Key; + Key := 0.0; +end; + +function TJclDoubleIntfSortedMap.FreeValue(var Value: IInterface): IInterface; +begin + Result := Value; + Value := nil; +end; + +function TJclDoubleIntfSortedMap.KeysCompare(const A, B: Double): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclDoubleIntfSortedMap.ValuesCompare(const A, B: IInterface): Integer; +begin + Result := IntfSimpleCompare(A, B); +end; + +//=== { TJclIntfDoubleSortedMap } ============================================== + +constructor TJclIntfDoubleSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclIntfDoubleSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfDoubleSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclIntfDoubleSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntfDoubleSortedMap then + begin + MyDest := TJclIntfDoubleSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclIntfDoubleSortedMap.BinarySearch(const Key: IInterface): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfDoubleSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleSortedMap.ContainsKey(const Key: IInterface): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleSortedMap.ContainsValue(const Value: Double): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleSortedMap.FirstKey: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleSortedMap.Extract(const Key: IInterface): Double; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := 0.0; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := 0.0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleSortedMap.GetValue(const Key: IInterface): Double; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := 0.0; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleSortedMap.HeadMap(const ToKey: IInterface): IJclIntfDoubleSortedMap; +var + ToIndex: Integer; + NewMap: TJclIntfDoubleSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfDoubleSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleSortedMap.KeyOfValue(const Value: Double): IInterface; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleSortedMap.KeySet: IJclIntfSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleSortedMap.LastKey: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleSortedMap.MapEquals(const AMap: IJclIntfDoubleMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfDoubleSortedMap.FinalizeArrayBeforeMove(var List: TJclIntfDoubleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntfDoubleSortedMap.InitializeArray(var List: TJclIntfDoubleSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntfDoubleSortedMap.InitializeArrayAfterMove(var List: TJclIntfDoubleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntfDoubleSortedMap.MoveArray(var List: TJclIntfDoubleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclIntfDoubleSortedMap.PutAll(const AMap: IJclIntfDoubleMap); +var + It: IJclIntfIterator; + Key: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfDoubleSortedMap.PutValue(const Key: IInterface; const Value: Double); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, nil) <> 0) and (ValuesCompare(Value, 0.0) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleSortedMap.Remove(const Key: IInterface): Double; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfDoubleSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfDoubleSortedMap.SubMap(const FromKey, ToKey: IInterface): IJclIntfDoubleSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclIntfDoubleSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfDoubleSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleSortedMap.TailMap(const FromKey: IInterface): IJclIntfDoubleSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclIntfDoubleSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfDoubleSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleSortedMap.Values: IJclDoubleCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclDoubleArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfDoubleSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfDoubleSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclIntfDoubleSortedMap.FreeKey(var Key: IInterface): IInterface; +begin + Result := Key; + Key := nil; +end; + +function TJclIntfDoubleSortedMap.FreeValue(var Value: Double): Double; +begin + Result := Value; + Value := 0.0; +end; + +function TJclIntfDoubleSortedMap.KeysCompare(const A, B: IInterface): Integer; +begin + Result := IntfSimpleCompare(A, B); +end; + +function TJclIntfDoubleSortedMap.ValuesCompare(const A, B: Double): Integer; +begin + Result := ItemsCompare(A, B); +end; + +//=== { TJclDoubleDoubleSortedMap } ============================================== + +constructor TJclDoubleDoubleSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclDoubleDoubleSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclDoubleDoubleSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclDoubleDoubleSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclDoubleDoubleSortedMap then + begin + MyDest := TJclDoubleDoubleSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclDoubleDoubleSortedMap.BinarySearch(const Key: Double): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleDoubleSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleSortedMap.ContainsKey(const Key: Double): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleSortedMap.ContainsValue(const Value: Double): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleSortedMap.FirstKey: Double; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleSortedMap.Extract(const Key: Double): Double; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := 0.0; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := 0.0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleSortedMap.GetValue(const Key: Double): Double; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := 0.0; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleSortedMap.HeadMap(const ToKey: Double): IJclDoubleDoubleSortedMap; +var + ToIndex: Integer; + NewMap: TJclDoubleDoubleSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclDoubleDoubleSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleSortedMap.KeyOfValue(const Value: Double): Double; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0.0; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleSortedMap.KeySet: IJclDoubleSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclDoubleArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleSortedMap.LastKey: Double; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleSortedMap.MapEquals(const AMap: IJclDoubleDoubleMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleDoubleSortedMap.InitializeArrayAfterMove(var List: TJclDoubleDoubleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclDoubleDoubleSortedMap.MoveArray(var List: TJclDoubleDoubleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclDoubleDoubleSortedMap.PutAll(const AMap: IJclDoubleDoubleMap); +var + It: IJclDoubleIterator; + Key: Double; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleDoubleSortedMap.PutValue(const Key: Double; const Value: Double); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, 0.0) <> 0) and (ValuesCompare(Value, 0.0) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleSortedMap.Remove(const Key: Double): Double; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleDoubleSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclDoubleDoubleSortedMap.SubMap(const FromKey, ToKey: Double): IJclDoubleDoubleSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclDoubleDoubleSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclDoubleDoubleSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleSortedMap.TailMap(const FromKey: Double): IJclDoubleDoubleSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclDoubleDoubleSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclDoubleDoubleSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleSortedMap.Values: IJclDoubleCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclDoubleArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleDoubleSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclDoubleDoubleSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclDoubleDoubleSortedMap.FreeKey(var Key: Double): Double; +begin + Result := Key; + Key := 0.0; +end; + +function TJclDoubleDoubleSortedMap.FreeValue(var Value: Double): Double; +begin + Result := Value; + Value := 0.0; +end; + +function TJclDoubleDoubleSortedMap.KeysCompare(const A, B: Double): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclDoubleDoubleSortedMap.ValuesCompare(const A, B: Double): Integer; +begin + Result := ItemsCompare(A, B); +end; + +//=== { TJclExtendedIntfSortedMap } ============================================== + +constructor TJclExtendedIntfSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclExtendedIntfSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclExtendedIntfSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclExtendedIntfSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclExtendedIntfSortedMap then + begin + MyDest := TJclExtendedIntfSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclExtendedIntfSortedMap.BinarySearch(const Key: Extended): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedIntfSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfSortedMap.ContainsKey(const Key: Extended): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfSortedMap.ContainsValue(const Value: IInterface): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfSortedMap.FirstKey: Extended; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfSortedMap.Extract(const Key: Extended): IInterface; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfSortedMap.GetValue(const Key: Extended): IInterface; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfSortedMap.HeadMap(const ToKey: Extended): IJclExtendedIntfSortedMap; +var + ToIndex: Integer; + NewMap: TJclExtendedIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclExtendedIntfSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfSortedMap.KeyOfValue(const Value: IInterface): Extended; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0.0; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfSortedMap.KeySet: IJclExtendedSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclExtendedArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfSortedMap.LastKey: Extended; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfSortedMap.MapEquals(const AMap: IJclExtendedIntfMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedIntfSortedMap.FinalizeArrayBeforeMove(var List: TJclExtendedIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclExtendedIntfSortedMap.InitializeArray(var List: TJclExtendedIntfSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclExtendedIntfSortedMap.InitializeArrayAfterMove(var List: TJclExtendedIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclExtendedIntfSortedMap.MoveArray(var List: TJclExtendedIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclExtendedIntfSortedMap.PutAll(const AMap: IJclExtendedIntfMap); +var + It: IJclExtendedIterator; + Key: Extended; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedIntfSortedMap.PutValue(const Key: Extended; const Value: IInterface); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, 0.0) <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfSortedMap.Remove(const Key: Extended): IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedIntfSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclExtendedIntfSortedMap.SubMap(const FromKey, ToKey: Extended): IJclExtendedIntfSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclExtendedIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclExtendedIntfSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfSortedMap.TailMap(const FromKey: Extended): IJclExtendedIntfSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclExtendedIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclExtendedIntfSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfSortedMap.Values: IJclIntfCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedIntfSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclExtendedIntfSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclExtendedIntfSortedMap.FreeKey(var Key: Extended): Extended; +begin + Result := Key; + Key := 0.0; +end; + +function TJclExtendedIntfSortedMap.FreeValue(var Value: IInterface): IInterface; +begin + Result := Value; + Value := nil; +end; + +function TJclExtendedIntfSortedMap.KeysCompare(const A, B: Extended): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclExtendedIntfSortedMap.ValuesCompare(const A, B: IInterface): Integer; +begin + Result := IntfSimpleCompare(A, B); +end; + +//=== { TJclIntfExtendedSortedMap } ============================================== + +constructor TJclIntfExtendedSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclIntfExtendedSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfExtendedSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclIntfExtendedSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntfExtendedSortedMap then + begin + MyDest := TJclIntfExtendedSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclIntfExtendedSortedMap.BinarySearch(const Key: IInterface): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfExtendedSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedSortedMap.ContainsKey(const Key: IInterface): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedSortedMap.ContainsValue(const Value: Extended): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedSortedMap.FirstKey: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedSortedMap.Extract(const Key: IInterface): Extended; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := 0.0; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := 0.0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedSortedMap.GetValue(const Key: IInterface): Extended; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := 0.0; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedSortedMap.HeadMap(const ToKey: IInterface): IJclIntfExtendedSortedMap; +var + ToIndex: Integer; + NewMap: TJclIntfExtendedSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfExtendedSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedSortedMap.KeyOfValue(const Value: Extended): IInterface; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedSortedMap.KeySet: IJclIntfSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedSortedMap.LastKey: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedSortedMap.MapEquals(const AMap: IJclIntfExtendedMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfExtendedSortedMap.FinalizeArrayBeforeMove(var List: TJclIntfExtendedSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntfExtendedSortedMap.InitializeArray(var List: TJclIntfExtendedSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntfExtendedSortedMap.InitializeArrayAfterMove(var List: TJclIntfExtendedSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntfExtendedSortedMap.MoveArray(var List: TJclIntfExtendedSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclIntfExtendedSortedMap.PutAll(const AMap: IJclIntfExtendedMap); +var + It: IJclIntfIterator; + Key: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfExtendedSortedMap.PutValue(const Key: IInterface; const Value: Extended); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, nil) <> 0) and (ValuesCompare(Value, 0.0) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedSortedMap.Remove(const Key: IInterface): Extended; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfExtendedSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfExtendedSortedMap.SubMap(const FromKey, ToKey: IInterface): IJclIntfExtendedSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclIntfExtendedSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfExtendedSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedSortedMap.TailMap(const FromKey: IInterface): IJclIntfExtendedSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclIntfExtendedSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfExtendedSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedSortedMap.Values: IJclExtendedCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclExtendedArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfExtendedSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfExtendedSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclIntfExtendedSortedMap.FreeKey(var Key: IInterface): IInterface; +begin + Result := Key; + Key := nil; +end; + +function TJclIntfExtendedSortedMap.FreeValue(var Value: Extended): Extended; +begin + Result := Value; + Value := 0.0; +end; + +function TJclIntfExtendedSortedMap.KeysCompare(const A, B: IInterface): Integer; +begin + Result := IntfSimpleCompare(A, B); +end; + +function TJclIntfExtendedSortedMap.ValuesCompare(const A, B: Extended): Integer; +begin + Result := ItemsCompare(A, B); +end; + +//=== { TJclExtendedExtendedSortedMap } ============================================== + +constructor TJclExtendedExtendedSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclExtendedExtendedSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclExtendedExtendedSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclExtendedExtendedSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclExtendedExtendedSortedMap then + begin + MyDest := TJclExtendedExtendedSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclExtendedExtendedSortedMap.BinarySearch(const Key: Extended): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedExtendedSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedSortedMap.ContainsKey(const Key: Extended): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedSortedMap.ContainsValue(const Value: Extended): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedSortedMap.FirstKey: Extended; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedSortedMap.Extract(const Key: Extended): Extended; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := 0.0; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := 0.0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedSortedMap.GetValue(const Key: Extended): Extended; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := 0.0; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedSortedMap.HeadMap(const ToKey: Extended): IJclExtendedExtendedSortedMap; +var + ToIndex: Integer; + NewMap: TJclExtendedExtendedSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclExtendedExtendedSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedSortedMap.KeyOfValue(const Value: Extended): Extended; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0.0; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedSortedMap.KeySet: IJclExtendedSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclExtendedArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedSortedMap.LastKey: Extended; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedSortedMap.MapEquals(const AMap: IJclExtendedExtendedMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedExtendedSortedMap.InitializeArrayAfterMove(var List: TJclExtendedExtendedSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclExtendedExtendedSortedMap.MoveArray(var List: TJclExtendedExtendedSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclExtendedExtendedSortedMap.PutAll(const AMap: IJclExtendedExtendedMap); +var + It: IJclExtendedIterator; + Key: Extended; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedExtendedSortedMap.PutValue(const Key: Extended; const Value: Extended); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, 0.0) <> 0) and (ValuesCompare(Value, 0.0) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedSortedMap.Remove(const Key: Extended): Extended; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedExtendedSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclExtendedExtendedSortedMap.SubMap(const FromKey, ToKey: Extended): IJclExtendedExtendedSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclExtendedExtendedSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclExtendedExtendedSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedSortedMap.TailMap(const FromKey: Extended): IJclExtendedExtendedSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclExtendedExtendedSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclExtendedExtendedSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedSortedMap.Values: IJclExtendedCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclExtendedArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedExtendedSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclExtendedExtendedSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclExtendedExtendedSortedMap.FreeKey(var Key: Extended): Extended; +begin + Result := Key; + Key := 0.0; +end; + +function TJclExtendedExtendedSortedMap.FreeValue(var Value: Extended): Extended; +begin + Result := Value; + Value := 0.0; +end; + +function TJclExtendedExtendedSortedMap.KeysCompare(const A, B: Extended): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclExtendedExtendedSortedMap.ValuesCompare(const A, B: Extended): Integer; +begin + Result := ItemsCompare(A, B); +end; + +//=== { TJclIntegerIntfSortedMap } ============================================== + +constructor TJclIntegerIntfSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclIntegerIntfSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntegerIntfSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclIntegerIntfSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntegerIntfSortedMap then + begin + MyDest := TJclIntegerIntfSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclIntegerIntfSortedMap.BinarySearch(Key: Integer): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerIntfSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfSortedMap.ContainsKey(Key: Integer): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfSortedMap.ContainsValue(const Value: IInterface): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfSortedMap.FirstKey: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfSortedMap.Extract(Key: Integer): IInterface; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfSortedMap.GetValue(Key: Integer): IInterface; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfSortedMap.HeadMap(ToKey: Integer): IJclIntegerIntfSortedMap; +var + ToIndex: Integer; + NewMap: TJclIntegerIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntegerIntfSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfSortedMap.KeyOfValue(const Value: IInterface): Integer; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfSortedMap.KeySet: IJclIntegerSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntegerArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfSortedMap.LastKey: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfSortedMap.MapEquals(const AMap: IJclIntegerIntfMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerIntfSortedMap.FinalizeArrayBeforeMove(var List: TJclIntegerIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntegerIntfSortedMap.InitializeArray(var List: TJclIntegerIntfSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntegerIntfSortedMap.InitializeArrayAfterMove(var List: TJclIntegerIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntegerIntfSortedMap.MoveArray(var List: TJclIntegerIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclIntegerIntfSortedMap.PutAll(const AMap: IJclIntegerIntfMap); +var + It: IJclIntegerIterator; + Key: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerIntfSortedMap.PutValue(Key: Integer; const Value: IInterface); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, 0) <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfSortedMap.Remove(Key: Integer): IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerIntfSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntegerIntfSortedMap.SubMap(FromKey, ToKey: Integer): IJclIntegerIntfSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclIntegerIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntegerIntfSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfSortedMap.TailMap(FromKey: Integer): IJclIntegerIntfSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclIntegerIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntegerIntfSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfSortedMap.Values: IJclIntfCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntfSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntegerIntfSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclIntegerIntfSortedMap.FreeKey(var Key: Integer): Integer; +begin + Result := Key; + Key := 0; +end; + +function TJclIntegerIntfSortedMap.FreeValue(var Value: IInterface): IInterface; +begin + Result := Value; + Value := nil; +end; + +function TJclIntegerIntfSortedMap.KeysCompare(A, B: Integer): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclIntegerIntfSortedMap.ValuesCompare(const A, B: IInterface): Integer; +begin + Result := IntfSimpleCompare(A, B); +end; + +//=== { TJclIntfIntegerSortedMap } ============================================== + +constructor TJclIntfIntegerSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclIntfIntegerSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfIntegerSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclIntfIntegerSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntfIntegerSortedMap then + begin + MyDest := TJclIntfIntegerSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclIntfIntegerSortedMap.BinarySearch(const Key: IInterface): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfIntegerSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerSortedMap.ContainsKey(const Key: IInterface): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerSortedMap.ContainsValue(Value: Integer): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerSortedMap.FirstKey: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerSortedMap.Extract(const Key: IInterface): Integer; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := 0; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerSortedMap.GetValue(const Key: IInterface): Integer; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := 0; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerSortedMap.HeadMap(const ToKey: IInterface): IJclIntfIntegerSortedMap; +var + ToIndex: Integer; + NewMap: TJclIntfIntegerSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfIntegerSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerSortedMap.KeyOfValue(Value: Integer): IInterface; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerSortedMap.KeySet: IJclIntfSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerSortedMap.LastKey: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerSortedMap.MapEquals(const AMap: IJclIntfIntegerMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfIntegerSortedMap.FinalizeArrayBeforeMove(var List: TJclIntfIntegerSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntfIntegerSortedMap.InitializeArray(var List: TJclIntfIntegerSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntfIntegerSortedMap.InitializeArrayAfterMove(var List: TJclIntfIntegerSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntfIntegerSortedMap.MoveArray(var List: TJclIntfIntegerSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclIntfIntegerSortedMap.PutAll(const AMap: IJclIntfIntegerMap); +var + It: IJclIntfIterator; + Key: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfIntegerSortedMap.PutValue(const Key: IInterface; Value: Integer); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, nil) <> 0) and (ValuesCompare(Value, 0) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerSortedMap.Remove(const Key: IInterface): Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfIntegerSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfIntegerSortedMap.SubMap(const FromKey, ToKey: IInterface): IJclIntfIntegerSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclIntfIntegerSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfIntegerSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerSortedMap.TailMap(const FromKey: IInterface): IJclIntfIntegerSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclIntfIntegerSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfIntegerSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerSortedMap.Values: IJclIntegerCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntegerArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfIntegerSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfIntegerSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclIntfIntegerSortedMap.FreeKey(var Key: IInterface): IInterface; +begin + Result := Key; + Key := nil; +end; + +function TJclIntfIntegerSortedMap.FreeValue(var Value: Integer): Integer; +begin + Result := Value; + Value := 0; +end; + +function TJclIntfIntegerSortedMap.KeysCompare(const A, B: IInterface): Integer; +begin + Result := IntfSimpleCompare(A, B); +end; + +function TJclIntfIntegerSortedMap.ValuesCompare(A, B: Integer): Integer; +begin + Result := ItemsCompare(A, B); +end; + +//=== { TJclIntegerIntegerSortedMap } ============================================== + +constructor TJclIntegerIntegerSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclIntegerIntegerSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntegerIntegerSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclIntegerIntegerSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntegerIntegerSortedMap then + begin + MyDest := TJclIntegerIntegerSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclIntegerIntegerSortedMap.BinarySearch(Key: Integer): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerIntegerSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerSortedMap.ContainsKey(Key: Integer): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerSortedMap.ContainsValue(Value: Integer): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerSortedMap.FirstKey: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerSortedMap.Extract(Key: Integer): Integer; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := 0; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerSortedMap.GetValue(Key: Integer): Integer; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := 0; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerSortedMap.HeadMap(ToKey: Integer): IJclIntegerIntegerSortedMap; +var + ToIndex: Integer; + NewMap: TJclIntegerIntegerSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntegerIntegerSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerSortedMap.KeyOfValue(Value: Integer): Integer; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerSortedMap.KeySet: IJclIntegerSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntegerArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerSortedMap.LastKey: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerSortedMap.MapEquals(const AMap: IJclIntegerIntegerMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerIntegerSortedMap.InitializeArrayAfterMove(var List: TJclIntegerIntegerSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclIntegerIntegerSortedMap.MoveArray(var List: TJclIntegerIntegerSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclIntegerIntegerSortedMap.PutAll(const AMap: IJclIntegerIntegerMap); +var + It: IJclIntegerIterator; + Key: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerIntegerSortedMap.PutValue(Key: Integer; Value: Integer); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, 0) <> 0) and (ValuesCompare(Value, 0) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerSortedMap.Remove(Key: Integer): Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerIntegerSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntegerIntegerSortedMap.SubMap(FromKey, ToKey: Integer): IJclIntegerIntegerSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclIntegerIntegerSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntegerIntegerSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerSortedMap.TailMap(FromKey: Integer): IJclIntegerIntegerSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclIntegerIntegerSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntegerIntegerSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerSortedMap.Values: IJclIntegerCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntegerArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerIntegerSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntegerIntegerSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclIntegerIntegerSortedMap.FreeKey(var Key: Integer): Integer; +begin + Result := Key; + Key := 0; +end; + +function TJclIntegerIntegerSortedMap.FreeValue(var Value: Integer): Integer; +begin + Result := Value; + Value := 0; +end; + +function TJclIntegerIntegerSortedMap.KeysCompare(A, B: Integer): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclIntegerIntegerSortedMap.ValuesCompare(A, B: Integer): Integer; +begin + Result := ItemsCompare(A, B); +end; + +//=== { TJclCardinalIntfSortedMap } ============================================== + +constructor TJclCardinalIntfSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclCardinalIntfSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclCardinalIntfSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclCardinalIntfSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclCardinalIntfSortedMap then + begin + MyDest := TJclCardinalIntfSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclCardinalIntfSortedMap.BinarySearch(Key: Cardinal): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalIntfSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfSortedMap.ContainsKey(Key: Cardinal): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfSortedMap.ContainsValue(const Value: IInterface): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfSortedMap.FirstKey: Cardinal; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfSortedMap.Extract(Key: Cardinal): IInterface; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfSortedMap.GetValue(Key: Cardinal): IInterface; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfSortedMap.HeadMap(ToKey: Cardinal): IJclCardinalIntfSortedMap; +var + ToIndex: Integer; + NewMap: TJclCardinalIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclCardinalIntfSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfSortedMap.KeyOfValue(const Value: IInterface): Cardinal; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfSortedMap.KeySet: IJclCardinalSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclCardinalArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfSortedMap.LastKey: Cardinal; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfSortedMap.MapEquals(const AMap: IJclCardinalIntfMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalIntfSortedMap.FinalizeArrayBeforeMove(var List: TJclCardinalIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclCardinalIntfSortedMap.InitializeArray(var List: TJclCardinalIntfSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclCardinalIntfSortedMap.InitializeArrayAfterMove(var List: TJclCardinalIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclCardinalIntfSortedMap.MoveArray(var List: TJclCardinalIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclCardinalIntfSortedMap.PutAll(const AMap: IJclCardinalIntfMap); +var + It: IJclCardinalIterator; + Key: Cardinal; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalIntfSortedMap.PutValue(Key: Cardinal; const Value: IInterface); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, 0) <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfSortedMap.Remove(Key: Cardinal): IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalIntfSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclCardinalIntfSortedMap.SubMap(FromKey, ToKey: Cardinal): IJclCardinalIntfSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclCardinalIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclCardinalIntfSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfSortedMap.TailMap(FromKey: Cardinal): IJclCardinalIntfSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclCardinalIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclCardinalIntfSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfSortedMap.Values: IJclIntfCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalIntfSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclCardinalIntfSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclCardinalIntfSortedMap.FreeKey(var Key: Cardinal): Cardinal; +begin + Result := Key; + Key := 0; +end; + +function TJclCardinalIntfSortedMap.FreeValue(var Value: IInterface): IInterface; +begin + Result := Value; + Value := nil; +end; + +function TJclCardinalIntfSortedMap.KeysCompare(A, B: Cardinal): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclCardinalIntfSortedMap.ValuesCompare(const A, B: IInterface): Integer; +begin + Result := IntfSimpleCompare(A, B); +end; + +//=== { TJclIntfCardinalSortedMap } ============================================== + +constructor TJclIntfCardinalSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclIntfCardinalSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfCardinalSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclIntfCardinalSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntfCardinalSortedMap then + begin + MyDest := TJclIntfCardinalSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclIntfCardinalSortedMap.BinarySearch(const Key: IInterface): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfCardinalSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalSortedMap.ContainsKey(const Key: IInterface): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalSortedMap.ContainsValue(Value: Cardinal): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalSortedMap.FirstKey: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalSortedMap.Extract(const Key: IInterface): Cardinal; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := 0; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalSortedMap.GetValue(const Key: IInterface): Cardinal; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := 0; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalSortedMap.HeadMap(const ToKey: IInterface): IJclIntfCardinalSortedMap; +var + ToIndex: Integer; + NewMap: TJclIntfCardinalSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfCardinalSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalSortedMap.KeyOfValue(Value: Cardinal): IInterface; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalSortedMap.KeySet: IJclIntfSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalSortedMap.LastKey: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalSortedMap.MapEquals(const AMap: IJclIntfCardinalMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfCardinalSortedMap.FinalizeArrayBeforeMove(var List: TJclIntfCardinalSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntfCardinalSortedMap.InitializeArray(var List: TJclIntfCardinalSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntfCardinalSortedMap.InitializeArrayAfterMove(var List: TJclIntfCardinalSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntfCardinalSortedMap.MoveArray(var List: TJclIntfCardinalSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclIntfCardinalSortedMap.PutAll(const AMap: IJclIntfCardinalMap); +var + It: IJclIntfIterator; + Key: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfCardinalSortedMap.PutValue(const Key: IInterface; Value: Cardinal); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, nil) <> 0) and (ValuesCompare(Value, 0) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalSortedMap.Remove(const Key: IInterface): Cardinal; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfCardinalSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfCardinalSortedMap.SubMap(const FromKey, ToKey: IInterface): IJclIntfCardinalSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclIntfCardinalSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfCardinalSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalSortedMap.TailMap(const FromKey: IInterface): IJclIntfCardinalSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclIntfCardinalSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfCardinalSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalSortedMap.Values: IJclCardinalCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclCardinalArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfCardinalSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfCardinalSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclIntfCardinalSortedMap.FreeKey(var Key: IInterface): IInterface; +begin + Result := Key; + Key := nil; +end; + +function TJclIntfCardinalSortedMap.FreeValue(var Value: Cardinal): Cardinal; +begin + Result := Value; + Value := 0; +end; + +function TJclIntfCardinalSortedMap.KeysCompare(const A, B: IInterface): Integer; +begin + Result := IntfSimpleCompare(A, B); +end; + +function TJclIntfCardinalSortedMap.ValuesCompare(A, B: Cardinal): Integer; +begin + Result := ItemsCompare(A, B); +end; + +//=== { TJclCardinalCardinalSortedMap } ============================================== + +constructor TJclCardinalCardinalSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclCardinalCardinalSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclCardinalCardinalSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclCardinalCardinalSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclCardinalCardinalSortedMap then + begin + MyDest := TJclCardinalCardinalSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclCardinalCardinalSortedMap.BinarySearch(Key: Cardinal): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalCardinalSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalSortedMap.ContainsKey(Key: Cardinal): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalSortedMap.ContainsValue(Value: Cardinal): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalSortedMap.FirstKey: Cardinal; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalSortedMap.Extract(Key: Cardinal): Cardinal; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := 0; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalSortedMap.GetValue(Key: Cardinal): Cardinal; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := 0; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalSortedMap.HeadMap(ToKey: Cardinal): IJclCardinalCardinalSortedMap; +var + ToIndex: Integer; + NewMap: TJclCardinalCardinalSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclCardinalCardinalSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalSortedMap.KeyOfValue(Value: Cardinal): Cardinal; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalSortedMap.KeySet: IJclCardinalSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclCardinalArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalSortedMap.LastKey: Cardinal; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalSortedMap.MapEquals(const AMap: IJclCardinalCardinalMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalCardinalSortedMap.InitializeArrayAfterMove(var List: TJclCardinalCardinalSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclCardinalCardinalSortedMap.MoveArray(var List: TJclCardinalCardinalSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclCardinalCardinalSortedMap.PutAll(const AMap: IJclCardinalCardinalMap); +var + It: IJclCardinalIterator; + Key: Cardinal; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalCardinalSortedMap.PutValue(Key: Cardinal; Value: Cardinal); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, 0) <> 0) and (ValuesCompare(Value, 0) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalSortedMap.Remove(Key: Cardinal): Cardinal; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalCardinalSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclCardinalCardinalSortedMap.SubMap(FromKey, ToKey: Cardinal): IJclCardinalCardinalSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclCardinalCardinalSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclCardinalCardinalSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalSortedMap.TailMap(FromKey: Cardinal): IJclCardinalCardinalSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclCardinalCardinalSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclCardinalCardinalSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalSortedMap.Values: IJclCardinalCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclCardinalArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalCardinalSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclCardinalCardinalSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclCardinalCardinalSortedMap.FreeKey(var Key: Cardinal): Cardinal; +begin + Result := Key; + Key := 0; +end; + +function TJclCardinalCardinalSortedMap.FreeValue(var Value: Cardinal): Cardinal; +begin + Result := Value; + Value := 0; +end; + +function TJclCardinalCardinalSortedMap.KeysCompare(A, B: Cardinal): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclCardinalCardinalSortedMap.ValuesCompare(A, B: Cardinal): Integer; +begin + Result := ItemsCompare(A, B); +end; + +//=== { TJclInt64IntfSortedMap } ============================================== + +constructor TJclInt64IntfSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclInt64IntfSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclInt64IntfSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclInt64IntfSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclInt64IntfSortedMap then + begin + MyDest := TJclInt64IntfSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclInt64IntfSortedMap.BinarySearch(const Key: Int64): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64IntfSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfSortedMap.ContainsKey(const Key: Int64): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfSortedMap.ContainsValue(const Value: IInterface): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfSortedMap.FirstKey: Int64; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfSortedMap.Extract(const Key: Int64): IInterface; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfSortedMap.GetValue(const Key: Int64): IInterface; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfSortedMap.HeadMap(const ToKey: Int64): IJclInt64IntfSortedMap; +var + ToIndex: Integer; + NewMap: TJclInt64IntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclInt64IntfSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfSortedMap.KeyOfValue(const Value: IInterface): Int64; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfSortedMap.KeySet: IJclInt64Set; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclInt64ArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfSortedMap.LastKey: Int64; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfSortedMap.MapEquals(const AMap: IJclInt64IntfMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64IntfSortedMap.FinalizeArrayBeforeMove(var List: TJclInt64IntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclInt64IntfSortedMap.InitializeArray(var List: TJclInt64IntfSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclInt64IntfSortedMap.InitializeArrayAfterMove(var List: TJclInt64IntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclInt64IntfSortedMap.MoveArray(var List: TJclInt64IntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclInt64IntfSortedMap.PutAll(const AMap: IJclInt64IntfMap); +var + It: IJclInt64Iterator; + Key: Int64; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64IntfSortedMap.PutValue(const Key: Int64; const Value: IInterface); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, 0) <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfSortedMap.Remove(const Key: Int64): IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64IntfSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclInt64IntfSortedMap.SubMap(const FromKey, ToKey: Int64): IJclInt64IntfSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclInt64IntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclInt64IntfSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfSortedMap.TailMap(const FromKey: Int64): IJclInt64IntfSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclInt64IntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclInt64IntfSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfSortedMap.Values: IJclIntfCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64IntfSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclInt64IntfSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclInt64IntfSortedMap.FreeKey(var Key: Int64): Int64; +begin + Result := Key; + Key := 0; +end; + +function TJclInt64IntfSortedMap.FreeValue(var Value: IInterface): IInterface; +begin + Result := Value; + Value := nil; +end; + +function TJclInt64IntfSortedMap.KeysCompare(const A, B: Int64): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclInt64IntfSortedMap.ValuesCompare(const A, B: IInterface): Integer; +begin + Result := IntfSimpleCompare(A, B); +end; + +//=== { TJclIntfInt64SortedMap } ============================================== + +constructor TJclIntfInt64SortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclIntfInt64SortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfInt64SortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclIntfInt64SortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntfInt64SortedMap then + begin + MyDest := TJclIntfInt64SortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclIntfInt64SortedMap.BinarySearch(const Key: IInterface): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfInt64SortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64SortedMap.ContainsKey(const Key: IInterface): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64SortedMap.ContainsValue(const Value: Int64): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64SortedMap.FirstKey: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64SortedMap.Extract(const Key: IInterface): Int64; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := 0; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64SortedMap.GetValue(const Key: IInterface): Int64; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := 0; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64SortedMap.HeadMap(const ToKey: IInterface): IJclIntfInt64SortedMap; +var + ToIndex: Integer; + NewMap: TJclIntfInt64SortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfInt64SortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64SortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64SortedMap.KeyOfValue(const Value: Int64): IInterface; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64SortedMap.KeySet: IJclIntfSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64SortedMap.LastKey: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64SortedMap.MapEquals(const AMap: IJclIntfInt64Map): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfInt64SortedMap.FinalizeArrayBeforeMove(var List: TJclIntfInt64SortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntfInt64SortedMap.InitializeArray(var List: TJclIntfInt64SortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntfInt64SortedMap.InitializeArrayAfterMove(var List: TJclIntfInt64SortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntfInt64SortedMap.MoveArray(var List: TJclIntfInt64SortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclIntfInt64SortedMap.PutAll(const AMap: IJclIntfInt64Map); +var + It: IJclIntfIterator; + Key: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfInt64SortedMap.PutValue(const Key: IInterface; const Value: Int64); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, nil) <> 0) and (ValuesCompare(Value, 0) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64SortedMap.Remove(const Key: IInterface): Int64; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfInt64SortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64SortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfInt64SortedMap.SubMap(const FromKey, ToKey: IInterface): IJclIntfInt64SortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclIntfInt64SortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfInt64SortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64SortedMap.TailMap(const FromKey: IInterface): IJclIntfInt64SortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclIntfInt64SortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfInt64SortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64SortedMap.Values: IJclInt64Collection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclInt64ArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfInt64SortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfInt64SortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclIntfInt64SortedMap.FreeKey(var Key: IInterface): IInterface; +begin + Result := Key; + Key := nil; +end; + +function TJclIntfInt64SortedMap.FreeValue(var Value: Int64): Int64; +begin + Result := Value; + Value := 0; +end; + +function TJclIntfInt64SortedMap.KeysCompare(const A, B: IInterface): Integer; +begin + Result := IntfSimpleCompare(A, B); +end; + +function TJclIntfInt64SortedMap.ValuesCompare(const A, B: Int64): Integer; +begin + Result := ItemsCompare(A, B); +end; + +//=== { TJclInt64Int64SortedMap } ============================================== + +constructor TJclInt64Int64SortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclInt64Int64SortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclInt64Int64SortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclInt64Int64SortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclInt64Int64SortedMap then + begin + MyDest := TJclInt64Int64SortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclInt64Int64SortedMap.BinarySearch(const Key: Int64): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64Int64SortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64SortedMap.ContainsKey(const Key: Int64): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64SortedMap.ContainsValue(const Value: Int64): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64SortedMap.FirstKey: Int64; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64SortedMap.Extract(const Key: Int64): Int64; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := 0; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64SortedMap.GetValue(const Key: Int64): Int64; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := 0; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64SortedMap.HeadMap(const ToKey: Int64): IJclInt64Int64SortedMap; +var + ToIndex: Integer; + NewMap: TJclInt64Int64SortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclInt64Int64SortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64SortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64SortedMap.KeyOfValue(const Value: Int64): Int64; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64SortedMap.KeySet: IJclInt64Set; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclInt64ArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64SortedMap.LastKey: Int64; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64SortedMap.MapEquals(const AMap: IJclInt64Int64Map): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64Int64SortedMap.InitializeArrayAfterMove(var List: TJclInt64Int64SortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclInt64Int64SortedMap.MoveArray(var List: TJclInt64Int64SortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclInt64Int64SortedMap.PutAll(const AMap: IJclInt64Int64Map); +var + It: IJclInt64Iterator; + Key: Int64; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64Int64SortedMap.PutValue(const Key: Int64; const Value: Int64); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, 0) <> 0) and (ValuesCompare(Value, 0) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64SortedMap.Remove(const Key: Int64): Int64; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64Int64SortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64SortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclInt64Int64SortedMap.SubMap(const FromKey, ToKey: Int64): IJclInt64Int64SortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclInt64Int64SortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclInt64Int64SortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64SortedMap.TailMap(const FromKey: Int64): IJclInt64Int64SortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclInt64Int64SortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclInt64Int64SortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64SortedMap.Values: IJclInt64Collection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclInt64ArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Int64SortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclInt64Int64SortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclInt64Int64SortedMap.FreeKey(var Key: Int64): Int64; +begin + Result := Key; + Key := 0; +end; + +function TJclInt64Int64SortedMap.FreeValue(var Value: Int64): Int64; +begin + Result := Value; + Value := 0; +end; + +function TJclInt64Int64SortedMap.KeysCompare(const A, B: Int64): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclInt64Int64SortedMap.ValuesCompare(const A, B: Int64): Integer; +begin + Result := ItemsCompare(A, B); +end; + +//=== { TJclPtrIntfSortedMap } ============================================== + +constructor TJclPtrIntfSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclPtrIntfSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclPtrIntfSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclPtrIntfSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclPtrIntfSortedMap then + begin + MyDest := TJclPtrIntfSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclPtrIntfSortedMap.BinarySearch(Key: Pointer): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrIntfSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfSortedMap.ContainsKey(Key: Pointer): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfSortedMap.ContainsValue(const Value: IInterface): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfSortedMap.FirstKey: Pointer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfSortedMap.Extract(Key: Pointer): IInterface; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfSortedMap.GetValue(Key: Pointer): IInterface; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfSortedMap.HeadMap(ToKey: Pointer): IJclPtrIntfSortedMap; +var + ToIndex: Integer; + NewMap: TJclPtrIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclPtrIntfSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfSortedMap.KeyOfValue(const Value: IInterface): Pointer; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfSortedMap.KeySet: IJclPtrSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclPtrArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfSortedMap.LastKey: Pointer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfSortedMap.MapEquals(const AMap: IJclPtrIntfMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrIntfSortedMap.FinalizeArrayBeforeMove(var List: TJclPtrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclPtrIntfSortedMap.InitializeArray(var List: TJclPtrIntfSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclPtrIntfSortedMap.InitializeArrayAfterMove(var List: TJclPtrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclPtrIntfSortedMap.MoveArray(var List: TJclPtrIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclPtrIntfSortedMap.PutAll(const AMap: IJclPtrIntfMap); +var + It: IJclPtrIterator; + Key: Pointer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrIntfSortedMap.PutValue(Key: Pointer; const Value: IInterface); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, nil) <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfSortedMap.Remove(Key: Pointer): IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrIntfSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclPtrIntfSortedMap.SubMap(FromKey, ToKey: Pointer): IJclPtrIntfSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclPtrIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclPtrIntfSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfSortedMap.TailMap(FromKey: Pointer): IJclPtrIntfSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclPtrIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclPtrIntfSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfSortedMap.Values: IJclIntfCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrIntfSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclPtrIntfSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclPtrIntfSortedMap.FreeKey(var Key: Pointer): Pointer; +begin + Result := Key; + Key := nil; +end; + +function TJclPtrIntfSortedMap.FreeValue(var Value: IInterface): IInterface; +begin + Result := Value; + Value := nil; +end; + +function TJclPtrIntfSortedMap.KeysCompare(A, B: Pointer): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclPtrIntfSortedMap.ValuesCompare(const A, B: IInterface): Integer; +begin + Result := IntfSimpleCompare(A, B); +end; + +//=== { TJclIntfPtrSortedMap } ============================================== + +constructor TJclIntfPtrSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclIntfPtrSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfPtrSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclIntfPtrSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntfPtrSortedMap then + begin + MyDest := TJclIntfPtrSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclIntfPtrSortedMap.BinarySearch(const Key: IInterface): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfPtrSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrSortedMap.ContainsKey(const Key: IInterface): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrSortedMap.ContainsValue(Value: Pointer): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrSortedMap.FirstKey: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrSortedMap.Extract(const Key: IInterface): Pointer; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrSortedMap.GetValue(const Key: IInterface): Pointer; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrSortedMap.HeadMap(const ToKey: IInterface): IJclIntfPtrSortedMap; +var + ToIndex: Integer; + NewMap: TJclIntfPtrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfPtrSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrSortedMap.KeyOfValue(Value: Pointer): IInterface; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrSortedMap.KeySet: IJclIntfSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrSortedMap.LastKey: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrSortedMap.MapEquals(const AMap: IJclIntfPtrMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfPtrSortedMap.FinalizeArrayBeforeMove(var List: TJclIntfPtrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntfPtrSortedMap.InitializeArray(var List: TJclIntfPtrSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntfPtrSortedMap.InitializeArrayAfterMove(var List: TJclIntfPtrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntfPtrSortedMap.MoveArray(var List: TJclIntfPtrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclIntfPtrSortedMap.PutAll(const AMap: IJclIntfPtrMap); +var + It: IJclIntfIterator; + Key: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfPtrSortedMap.PutValue(const Key: IInterface; Value: Pointer); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, nil) <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrSortedMap.Remove(const Key: IInterface): Pointer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfPtrSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfPtrSortedMap.SubMap(const FromKey, ToKey: IInterface): IJclIntfPtrSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclIntfPtrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfPtrSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrSortedMap.TailMap(const FromKey: IInterface): IJclIntfPtrSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclIntfPtrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfPtrSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrSortedMap.Values: IJclPtrCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclPtrArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfPtrSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfPtrSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclIntfPtrSortedMap.FreeKey(var Key: IInterface): IInterface; +begin + Result := Key; + Key := nil; +end; + +function TJclIntfPtrSortedMap.FreeValue(var Value: Pointer): Pointer; +begin + Result := Value; + Value := nil; +end; + +function TJclIntfPtrSortedMap.KeysCompare(const A, B: IInterface): Integer; +begin + Result := IntfSimpleCompare(A, B); +end; + +function TJclIntfPtrSortedMap.ValuesCompare(A, B: Pointer): Integer; +begin + Result := ItemsCompare(A, B); +end; + +//=== { TJclPtrPtrSortedMap } ============================================== + +constructor TJclPtrPtrSortedMap.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclPtrPtrSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclPtrPtrSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclPtrPtrSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclPtrPtrSortedMap then + begin + MyDest := TJclPtrPtrSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclPtrPtrSortedMap.BinarySearch(Key: Pointer): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrPtrSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrSortedMap.ContainsKey(Key: Pointer): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrSortedMap.ContainsValue(Value: Pointer): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrSortedMap.FirstKey: Pointer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrSortedMap.Extract(Key: Pointer): Pointer; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrSortedMap.GetValue(Key: Pointer): Pointer; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrSortedMap.HeadMap(ToKey: Pointer): IJclPtrPtrSortedMap; +var + ToIndex: Integer; + NewMap: TJclPtrPtrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclPtrPtrSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrSortedMap.KeyOfValue(Value: Pointer): Pointer; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrSortedMap.KeySet: IJclPtrSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclPtrArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrSortedMap.LastKey: Pointer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrSortedMap.MapEquals(const AMap: IJclPtrPtrMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrPtrSortedMap.InitializeArrayAfterMove(var List: TJclPtrPtrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclPtrPtrSortedMap.MoveArray(var List: TJclPtrPtrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclPtrPtrSortedMap.PutAll(const AMap: IJclPtrPtrMap); +var + It: IJclPtrIterator; + Key: Pointer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrPtrSortedMap.PutValue(Key: Pointer; Value: Pointer); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, nil) <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrSortedMap.Remove(Key: Pointer): Pointer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrPtrSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclPtrPtrSortedMap.SubMap(FromKey, ToKey: Pointer): IJclPtrPtrSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclPtrPtrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclPtrPtrSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrSortedMap.TailMap(FromKey: Pointer): IJclPtrPtrSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclPtrPtrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclPtrPtrSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrSortedMap.Values: IJclPtrCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclPtrArrayList.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrPtrSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclPtrPtrSortedMap.Create(FSize); + AssignPropertiesTo(Result); +end; + +function TJclPtrPtrSortedMap.FreeKey(var Key: Pointer): Pointer; +begin + Result := Key; + Key := nil; +end; + +function TJclPtrPtrSortedMap.FreeValue(var Value: Pointer): Pointer; +begin + Result := Value; + Value := nil; +end; + +function TJclPtrPtrSortedMap.KeysCompare(A, B: Pointer): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclPtrPtrSortedMap.ValuesCompare(A, B: Pointer): Integer; +begin + Result := ItemsCompare(A, B); +end; + +//=== { TJclIntfSortedMap } ============================================== + +constructor TJclIntfSortedMap.Create(ACapacity: Integer; AOwnsValues: Boolean); +begin + inherited Create(); + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); +end; + +destructor TJclIntfSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclIntfSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntfSortedMap then + begin + MyDest := TJclIntfSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclIntfSortedMap.BinarySearch(const Key: IInterface): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSortedMap.ContainsKey(const Key: IInterface): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSortedMap.ContainsValue(Value: TObject): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSortedMap.FirstKey: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSortedMap.Extract(const Key: IInterface): TObject; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSortedMap.GetValue(const Key: IInterface): TObject; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSortedMap.HeadMap(const ToKey: IInterface): IJclIntfSortedMap; +var + ToIndex: Integer; + NewMap: TJclIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSortedMap.KeyOfValue(Value: TObject): IInterface; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSortedMap.KeySet: IJclIntfSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSortedMap.LastKey: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSortedMap.MapEquals(const AMap: IJclIntfMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfSortedMap.FinalizeArrayBeforeMove(var List: TJclIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclIntfSortedMap.InitializeArray(var List: TJclIntfSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclIntfSortedMap.InitializeArrayAfterMove(var List: TJclIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclIntfSortedMap.MoveArray(var List: TJclIntfSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclIntfSortedMap.PutAll(const AMap: IJclIntfMap); +var + It: IJclIntfIterator; + Key: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfSortedMap.PutValue(const Key: IInterface; Value: TObject); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, nil) <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSortedMap.Remove(const Key: IInterface): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfSortedMap.SubMap(const FromKey, ToKey: IInterface): IJclIntfSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSortedMap.TailMap(const FromKey: IInterface): IJclIntfSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclIntfSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntfSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSortedMap.Values: IJclCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfSortedMap.Create(FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclIntfSortedMap.FreeKey(var Key: IInterface): IInterface; +begin + Result := Key; + Key := nil; +end; + +function TJclIntfSortedMap.FreeValue(var Value: TObject): TObject; +begin + if FOwnsValues then + begin + Result := nil; + FreeAndNil(Value); + end + else + begin + Result := Value; + Value := nil; + end; +end; + +function TJclIntfSortedMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +function TJclIntfSortedMap.KeysCompare(const A, B: IInterface): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclIntfSortedMap.ValuesCompare(A, B: TObject): Integer; +begin + Result := SimpleCompare(A, B); +end; + +//=== { TJclAnsiStrSortedMap } ============================================== + +constructor TJclAnsiStrSortedMap.Create(ACapacity: Integer; AOwnsValues: Boolean); +begin + inherited Create(); + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); +end; + +destructor TJclAnsiStrSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclAnsiStrSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclAnsiStrSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclAnsiStrSortedMap then + begin + MyDest := TJclAnsiStrSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclAnsiStrSortedMap.BinarySearch(const Key: AnsiString): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrSortedMap.ContainsKey(const Key: AnsiString): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrSortedMap.ContainsValue(Value: TObject): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrSortedMap.FirstKey: AnsiString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrSortedMap.Extract(const Key: AnsiString): TObject; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrSortedMap.GetValue(const Key: AnsiString): TObject; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrSortedMap.HeadMap(const ToKey: AnsiString): IJclAnsiStrSortedMap; +var + ToIndex: Integer; + NewMap: TJclAnsiStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclAnsiStrSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrSortedMap.KeyOfValue(Value: TObject): AnsiString; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := ''; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrSortedMap.KeySet: IJclAnsiStrSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclAnsiStrArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrSortedMap.LastKey: AnsiString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrSortedMap.MapEquals(const AMap: IJclAnsiStrMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrSortedMap.FinalizeArrayBeforeMove(var List: TJclAnsiStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclAnsiStrSortedMap.InitializeArray(var List: TJclAnsiStrSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclAnsiStrSortedMap.InitializeArrayAfterMove(var List: TJclAnsiStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclAnsiStrSortedMap.MoveArray(var List: TJclAnsiStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclAnsiStrSortedMap.PutAll(const AMap: IJclAnsiStrMap); +var + It: IJclAnsiStrIterator; + Key: AnsiString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrSortedMap.PutValue(const Key: AnsiString; Value: TObject); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, '') <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrSortedMap.Remove(const Key: AnsiString): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclAnsiStrSortedMap.SubMap(const FromKey, ToKey: AnsiString): IJclAnsiStrSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclAnsiStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclAnsiStrSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrSortedMap.TailMap(const FromKey: AnsiString): IJclAnsiStrSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclAnsiStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclAnsiStrSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrSortedMap.Values: IJclCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclAnsiStrSortedMap.Create(FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclAnsiStrSortedMap.FreeKey(var Key: AnsiString): AnsiString; +begin + Result := Key; + Key := ''; +end; + +function TJclAnsiStrSortedMap.FreeValue(var Value: TObject): TObject; +begin + if FOwnsValues then + begin + Result := nil; + FreeAndNil(Value); + end + else + begin + Result := Value; + Value := nil; + end; +end; + +function TJclAnsiStrSortedMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +function TJclAnsiStrSortedMap.KeysCompare(const A, B: AnsiString): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclAnsiStrSortedMap.ValuesCompare(A, B: TObject): Integer; +begin + Result := SimpleCompare(A, B); +end; + +//=== { TJclWideStrSortedMap } ============================================== + +constructor TJclWideStrSortedMap.Create(ACapacity: Integer; AOwnsValues: Boolean); +begin + inherited Create(); + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); +end; + +destructor TJclWideStrSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclWideStrSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclWideStrSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclWideStrSortedMap then + begin + MyDest := TJclWideStrSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclWideStrSortedMap.BinarySearch(const Key: WideString): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrSortedMap.ContainsKey(const Key: WideString): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrSortedMap.ContainsValue(Value: TObject): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrSortedMap.FirstKey: WideString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrSortedMap.Extract(const Key: WideString): TObject; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrSortedMap.GetValue(const Key: WideString): TObject; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrSortedMap.HeadMap(const ToKey: WideString): IJclWideStrSortedMap; +var + ToIndex: Integer; + NewMap: TJclWideStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclWideStrSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrSortedMap.KeyOfValue(Value: TObject): WideString; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := ''; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrSortedMap.KeySet: IJclWideStrSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclWideStrArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrSortedMap.LastKey: WideString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrSortedMap.MapEquals(const AMap: IJclWideStrMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrSortedMap.FinalizeArrayBeforeMove(var List: TJclWideStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclWideStrSortedMap.InitializeArray(var List: TJclWideStrSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclWideStrSortedMap.InitializeArrayAfterMove(var List: TJclWideStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclWideStrSortedMap.MoveArray(var List: TJclWideStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclWideStrSortedMap.PutAll(const AMap: IJclWideStrMap); +var + It: IJclWideStrIterator; + Key: WideString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrSortedMap.PutValue(const Key: WideString; Value: TObject); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, '') <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrSortedMap.Remove(const Key: WideString): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclWideStrSortedMap.SubMap(const FromKey, ToKey: WideString): IJclWideStrSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclWideStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclWideStrSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrSortedMap.TailMap(const FromKey: WideString): IJclWideStrSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclWideStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclWideStrSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrSortedMap.Values: IJclCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclWideStrSortedMap.Create(FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclWideStrSortedMap.FreeKey(var Key: WideString): WideString; +begin + Result := Key; + Key := ''; +end; + +function TJclWideStrSortedMap.FreeValue(var Value: TObject): TObject; +begin + if FOwnsValues then + begin + Result := nil; + FreeAndNil(Value); + end + else + begin + Result := Value; + Value := nil; + end; +end; + +function TJclWideStrSortedMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +function TJclWideStrSortedMap.KeysCompare(const A, B: WideString): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclWideStrSortedMap.ValuesCompare(A, B: TObject): Integer; +begin + Result := SimpleCompare(A, B); +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrSortedMap } ============================================== + +constructor TJclUnicodeStrSortedMap.Create(ACapacity: Integer; AOwnsValues: Boolean); +begin + inherited Create(); + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); +end; + +destructor TJclUnicodeStrSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclUnicodeStrSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclUnicodeStrSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclUnicodeStrSortedMap then + begin + MyDest := TJclUnicodeStrSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclUnicodeStrSortedMap.BinarySearch(const Key: UnicodeString): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrSortedMap.ContainsKey(const Key: UnicodeString): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrSortedMap.ContainsValue(Value: TObject): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrSortedMap.FirstKey: UnicodeString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrSortedMap.Extract(const Key: UnicodeString): TObject; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrSortedMap.GetValue(const Key: UnicodeString): TObject; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrSortedMap.HeadMap(const ToKey: UnicodeString): IJclUnicodeStrSortedMap; +var + ToIndex: Integer; + NewMap: TJclUnicodeStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclUnicodeStrSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrSortedMap.KeyOfValue(Value: TObject): UnicodeString; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := ''; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrSortedMap.KeySet: IJclUnicodeStrSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclUnicodeStrArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrSortedMap.LastKey: UnicodeString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrSortedMap.MapEquals(const AMap: IJclUnicodeStrMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrSortedMap.FinalizeArrayBeforeMove(var List: TJclUnicodeStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure TJclUnicodeStrSortedMap.InitializeArray(var List: TJclUnicodeStrSortedMapEntryArray; FromIndex, Count: SizeInt); +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure TJclUnicodeStrSortedMap.InitializeArrayAfterMove(var List: TJclUnicodeStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; + +procedure TJclUnicodeStrSortedMap.MoveArray(var List: TJclUnicodeStrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count); + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclUnicodeStrSortedMap.PutAll(const AMap: IJclUnicodeStrMap); +var + It: IJclUnicodeStrIterator; + Key: UnicodeString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrSortedMap.PutValue(const Key: UnicodeString; Value: TObject); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, '') <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrSortedMap.Remove(const Key: UnicodeString): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclUnicodeStrSortedMap.SubMap(const FromKey, ToKey: UnicodeString): IJclUnicodeStrSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclUnicodeStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclUnicodeStrSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrSortedMap.TailMap(const FromKey: UnicodeString): IJclUnicodeStrSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclUnicodeStrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclUnicodeStrSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrSortedMap.Values: IJclCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclUnicodeStrSortedMap.Create(FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclUnicodeStrSortedMap.FreeKey(var Key: UnicodeString): UnicodeString; +begin + Result := Key; + Key := ''; +end; + +function TJclUnicodeStrSortedMap.FreeValue(var Value: TObject): TObject; +begin + if FOwnsValues then + begin + Result := nil; + FreeAndNil(Value); + end + else + begin + Result := Value; + Value := nil; + end; +end; + +function TJclUnicodeStrSortedMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +function TJclUnicodeStrSortedMap.KeysCompare(const A, B: UnicodeString): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclUnicodeStrSortedMap.ValuesCompare(A, B: TObject): Integer; +begin + Result := SimpleCompare(A, B); +end; + +{$ENDIF SUPPORTS_UNICODE_STRING} + +//=== { TJclSingleSortedMap } ============================================== + +constructor TJclSingleSortedMap.Create(ACapacity: Integer; AOwnsValues: Boolean); +begin + inherited Create(); + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); +end; + +destructor TJclSingleSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclSingleSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclSingleSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclSingleSortedMap then + begin + MyDest := TJclSingleSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclSingleSortedMap.BinarySearch(const Key: Single): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSortedMap.ContainsKey(const Key: Single): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSortedMap.ContainsValue(Value: TObject): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSortedMap.FirstKey: Single; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSortedMap.Extract(const Key: Single): TObject; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSortedMap.GetValue(const Key: Single): TObject; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSortedMap.HeadMap(const ToKey: Single): IJclSingleSortedMap; +var + ToIndex: Integer; + NewMap: TJclSingleSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclSingleSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSortedMap.KeyOfValue(Value: TObject): Single; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0.0; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSortedMap.KeySet: IJclSingleSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclSingleArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSortedMap.LastKey: Single; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSortedMap.MapEquals(const AMap: IJclSingleMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleSortedMap.InitializeArrayAfterMove(var List: TJclSingleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclSingleSortedMap.MoveArray(var List: TJclSingleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclSingleSortedMap.PutAll(const AMap: IJclSingleMap); +var + It: IJclSingleIterator; + Key: Single; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleSortedMap.PutValue(const Key: Single; Value: TObject); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, 0.0) <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSortedMap.Remove(const Key: Single): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclSingleSortedMap.SubMap(const FromKey, ToKey: Single): IJclSingleSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclSingleSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclSingleSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSortedMap.TailMap(const FromKey: Single): IJclSingleSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclSingleSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclSingleSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSortedMap.Values: IJclCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclSingleSortedMap.Create(FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclSingleSortedMap.FreeKey(var Key: Single): Single; +begin + Result := Key; + Key := 0.0; +end; + +function TJclSingleSortedMap.FreeValue(var Value: TObject): TObject; +begin + if FOwnsValues then + begin + Result := nil; + FreeAndNil(Value); + end + else + begin + Result := Value; + Value := nil; + end; +end; + +function TJclSingleSortedMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +function TJclSingleSortedMap.KeysCompare(const A, B: Single): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclSingleSortedMap.ValuesCompare(A, B: TObject): Integer; +begin + Result := SimpleCompare(A, B); +end; + +//=== { TJclDoubleSortedMap } ============================================== + +constructor TJclDoubleSortedMap.Create(ACapacity: Integer; AOwnsValues: Boolean); +begin + inherited Create(); + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); +end; + +destructor TJclDoubleSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclDoubleSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclDoubleSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclDoubleSortedMap then + begin + MyDest := TJclDoubleSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclDoubleSortedMap.BinarySearch(const Key: Double): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleSortedMap.ContainsKey(const Key: Double): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleSortedMap.ContainsValue(Value: TObject): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleSortedMap.FirstKey: Double; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleSortedMap.Extract(const Key: Double): TObject; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleSortedMap.GetValue(const Key: Double): TObject; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleSortedMap.HeadMap(const ToKey: Double): IJclDoubleSortedMap; +var + ToIndex: Integer; + NewMap: TJclDoubleSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclDoubleSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleSortedMap.KeyOfValue(Value: TObject): Double; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0.0; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleSortedMap.KeySet: IJclDoubleSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclDoubleArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleSortedMap.LastKey: Double; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleSortedMap.MapEquals(const AMap: IJclDoubleMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleSortedMap.InitializeArrayAfterMove(var List: TJclDoubleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclDoubleSortedMap.MoveArray(var List: TJclDoubleSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclDoubleSortedMap.PutAll(const AMap: IJclDoubleMap); +var + It: IJclDoubleIterator; + Key: Double; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleSortedMap.PutValue(const Key: Double; Value: TObject); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, 0.0) <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleSortedMap.Remove(const Key: Double): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclDoubleSortedMap.SubMap(const FromKey, ToKey: Double): IJclDoubleSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclDoubleSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclDoubleSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleSortedMap.TailMap(const FromKey: Double): IJclDoubleSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclDoubleSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclDoubleSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleSortedMap.Values: IJclCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclDoubleSortedMap.Create(FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclDoubleSortedMap.FreeKey(var Key: Double): Double; +begin + Result := Key; + Key := 0.0; +end; + +function TJclDoubleSortedMap.FreeValue(var Value: TObject): TObject; +begin + if FOwnsValues then + begin + Result := nil; + FreeAndNil(Value); + end + else + begin + Result := Value; + Value := nil; + end; +end; + +function TJclDoubleSortedMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +function TJclDoubleSortedMap.KeysCompare(const A, B: Double): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclDoubleSortedMap.ValuesCompare(A, B: TObject): Integer; +begin + Result := SimpleCompare(A, B); +end; + +//=== { TJclExtendedSortedMap } ============================================== + +constructor TJclExtendedSortedMap.Create(ACapacity: Integer; AOwnsValues: Boolean); +begin + inherited Create(); + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); +end; + +destructor TJclExtendedSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclExtendedSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclExtendedSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclExtendedSortedMap then + begin + MyDest := TJclExtendedSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclExtendedSortedMap.BinarySearch(const Key: Extended): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedSortedMap.ContainsKey(const Key: Extended): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedSortedMap.ContainsValue(Value: TObject): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedSortedMap.FirstKey: Extended; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedSortedMap.Extract(const Key: Extended): TObject; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedSortedMap.GetValue(const Key: Extended): TObject; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedSortedMap.HeadMap(const ToKey: Extended): IJclExtendedSortedMap; +var + ToIndex: Integer; + NewMap: TJclExtendedSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclExtendedSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedSortedMap.KeyOfValue(Value: TObject): Extended; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0.0; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedSortedMap.KeySet: IJclExtendedSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclExtendedArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedSortedMap.LastKey: Extended; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedSortedMap.MapEquals(const AMap: IJclExtendedMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedSortedMap.InitializeArrayAfterMove(var List: TJclExtendedSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclExtendedSortedMap.MoveArray(var List: TJclExtendedSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclExtendedSortedMap.PutAll(const AMap: IJclExtendedMap); +var + It: IJclExtendedIterator; + Key: Extended; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedSortedMap.PutValue(const Key: Extended; Value: TObject); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, 0.0) <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedSortedMap.Remove(const Key: Extended): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclExtendedSortedMap.SubMap(const FromKey, ToKey: Extended): IJclExtendedSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclExtendedSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclExtendedSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedSortedMap.TailMap(const FromKey: Extended): IJclExtendedSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclExtendedSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclExtendedSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedSortedMap.Values: IJclCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclExtendedSortedMap.Create(FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclExtendedSortedMap.FreeKey(var Key: Extended): Extended; +begin + Result := Key; + Key := 0.0; +end; + +function TJclExtendedSortedMap.FreeValue(var Value: TObject): TObject; +begin + if FOwnsValues then + begin + Result := nil; + FreeAndNil(Value); + end + else + begin + Result := Value; + Value := nil; + end; +end; + +function TJclExtendedSortedMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +function TJclExtendedSortedMap.KeysCompare(const A, B: Extended): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclExtendedSortedMap.ValuesCompare(A, B: TObject): Integer; +begin + Result := SimpleCompare(A, B); +end; + +//=== { TJclIntegerSortedMap } ============================================== + +constructor TJclIntegerSortedMap.Create(ACapacity: Integer; AOwnsValues: Boolean); +begin + inherited Create(); + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); +end; + +destructor TJclIntegerSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntegerSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclIntegerSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntegerSortedMap then + begin + MyDest := TJclIntegerSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclIntegerSortedMap.BinarySearch(Key: Integer): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerSortedMap.ContainsKey(Key: Integer): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerSortedMap.ContainsValue(Value: TObject): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerSortedMap.FirstKey: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerSortedMap.Extract(Key: Integer): TObject; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerSortedMap.GetValue(Key: Integer): TObject; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerSortedMap.HeadMap(ToKey: Integer): IJclIntegerSortedMap; +var + ToIndex: Integer; + NewMap: TJclIntegerSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntegerSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerSortedMap.KeyOfValue(Value: TObject): Integer; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerSortedMap.KeySet: IJclIntegerSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclIntegerArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerSortedMap.LastKey: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerSortedMap.MapEquals(const AMap: IJclIntegerMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerSortedMap.InitializeArrayAfterMove(var List: TJclIntegerSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclIntegerSortedMap.MoveArray(var List: TJclIntegerSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclIntegerSortedMap.PutAll(const AMap: IJclIntegerMap); +var + It: IJclIntegerIterator; + Key: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerSortedMap.PutValue(Key: Integer; Value: TObject); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, 0) <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerSortedMap.Remove(Key: Integer): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntegerSortedMap.SubMap(FromKey, ToKey: Integer): IJclIntegerSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclIntegerSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntegerSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerSortedMap.TailMap(FromKey: Integer): IJclIntegerSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclIntegerSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclIntegerSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerSortedMap.Values: IJclCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntegerSortedMap.Create(FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclIntegerSortedMap.FreeKey(var Key: Integer): Integer; +begin + Result := Key; + Key := 0; +end; + +function TJclIntegerSortedMap.FreeValue(var Value: TObject): TObject; +begin + if FOwnsValues then + begin + Result := nil; + FreeAndNil(Value); + end + else + begin + Result := Value; + Value := nil; + end; +end; + +function TJclIntegerSortedMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +function TJclIntegerSortedMap.KeysCompare(A, B: Integer): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclIntegerSortedMap.ValuesCompare(A, B: TObject): Integer; +begin + Result := SimpleCompare(A, B); +end; + +//=== { TJclCardinalSortedMap } ============================================== + +constructor TJclCardinalSortedMap.Create(ACapacity: Integer; AOwnsValues: Boolean); +begin + inherited Create(); + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); +end; + +destructor TJclCardinalSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclCardinalSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclCardinalSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclCardinalSortedMap then + begin + MyDest := TJclCardinalSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclCardinalSortedMap.BinarySearch(Key: Cardinal): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalSortedMap.ContainsKey(Key: Cardinal): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalSortedMap.ContainsValue(Value: TObject): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalSortedMap.FirstKey: Cardinal; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalSortedMap.Extract(Key: Cardinal): TObject; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalSortedMap.GetValue(Key: Cardinal): TObject; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalSortedMap.HeadMap(ToKey: Cardinal): IJclCardinalSortedMap; +var + ToIndex: Integer; + NewMap: TJclCardinalSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclCardinalSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalSortedMap.KeyOfValue(Value: TObject): Cardinal; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalSortedMap.KeySet: IJclCardinalSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclCardinalArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalSortedMap.LastKey: Cardinal; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalSortedMap.MapEquals(const AMap: IJclCardinalMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalSortedMap.InitializeArrayAfterMove(var List: TJclCardinalSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclCardinalSortedMap.MoveArray(var List: TJclCardinalSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclCardinalSortedMap.PutAll(const AMap: IJclCardinalMap); +var + It: IJclCardinalIterator; + Key: Cardinal; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalSortedMap.PutValue(Key: Cardinal; Value: TObject); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, 0) <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalSortedMap.Remove(Key: Cardinal): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclCardinalSortedMap.SubMap(FromKey, ToKey: Cardinal): IJclCardinalSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclCardinalSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclCardinalSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalSortedMap.TailMap(FromKey: Cardinal): IJclCardinalSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclCardinalSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclCardinalSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalSortedMap.Values: IJclCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclCardinalSortedMap.Create(FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclCardinalSortedMap.FreeKey(var Key: Cardinal): Cardinal; +begin + Result := Key; + Key := 0; +end; + +function TJclCardinalSortedMap.FreeValue(var Value: TObject): TObject; +begin + if FOwnsValues then + begin + Result := nil; + FreeAndNil(Value); + end + else + begin + Result := Value; + Value := nil; + end; +end; + +function TJclCardinalSortedMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +function TJclCardinalSortedMap.KeysCompare(A, B: Cardinal): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclCardinalSortedMap.ValuesCompare(A, B: TObject): Integer; +begin + Result := SimpleCompare(A, B); +end; + +//=== { TJclInt64SortedMap } ============================================== + +constructor TJclInt64SortedMap.Create(ACapacity: Integer; AOwnsValues: Boolean); +begin + inherited Create(); + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); +end; + +destructor TJclInt64SortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclInt64SortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclInt64SortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclInt64SortedMap then + begin + MyDest := TJclInt64SortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclInt64SortedMap.BinarySearch(const Key: Int64): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64SortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64SortedMap.ContainsKey(const Key: Int64): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64SortedMap.ContainsValue(Value: TObject): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64SortedMap.FirstKey: Int64; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64SortedMap.Extract(const Key: Int64): TObject; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64SortedMap.GetValue(const Key: Int64): TObject; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64SortedMap.HeadMap(const ToKey: Int64): IJclInt64SortedMap; +var + ToIndex: Integer; + NewMap: TJclInt64SortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclInt64SortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64SortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64SortedMap.KeyOfValue(Value: TObject): Int64; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := 0; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64SortedMap.KeySet: IJclInt64Set; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclInt64ArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64SortedMap.LastKey: Int64; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64SortedMap.MapEquals(const AMap: IJclInt64Map): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64SortedMap.InitializeArrayAfterMove(var List: TJclInt64SortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclInt64SortedMap.MoveArray(var List: TJclInt64SortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclInt64SortedMap.PutAll(const AMap: IJclInt64Map); +var + It: IJclInt64Iterator; + Key: Int64; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64SortedMap.PutValue(const Key: Int64; Value: TObject); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, 0) <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64SortedMap.Remove(const Key: Int64): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64SortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64SortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclInt64SortedMap.SubMap(const FromKey, ToKey: Int64): IJclInt64SortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclInt64SortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclInt64SortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64SortedMap.TailMap(const FromKey: Int64): IJclInt64SortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclInt64SortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclInt64SortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64SortedMap.Values: IJclCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64SortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclInt64SortedMap.Create(FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclInt64SortedMap.FreeKey(var Key: Int64): Int64; +begin + Result := Key; + Key := 0; +end; + +function TJclInt64SortedMap.FreeValue(var Value: TObject): TObject; +begin + if FOwnsValues then + begin + Result := nil; + FreeAndNil(Value); + end + else + begin + Result := Value; + Value := nil; + end; +end; + +function TJclInt64SortedMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +function TJclInt64SortedMap.KeysCompare(const A, B: Int64): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclInt64SortedMap.ValuesCompare(A, B: TObject): Integer; +begin + Result := SimpleCompare(A, B); +end; + +//=== { TJclPtrSortedMap } ============================================== + +constructor TJclPtrSortedMap.Create(ACapacity: Integer; AOwnsValues: Boolean); +begin + inherited Create(); + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); +end; + +destructor TJclPtrSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclPtrSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclPtrSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclPtrSortedMap then + begin + MyDest := TJclPtrSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclPtrSortedMap.BinarySearch(Key: Pointer): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrSortedMap.ContainsKey(Key: Pointer): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrSortedMap.ContainsValue(Value: TObject): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrSortedMap.FirstKey: Pointer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrSortedMap.Extract(Key: Pointer): TObject; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrSortedMap.GetValue(Key: Pointer): TObject; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrSortedMap.HeadMap(ToKey: Pointer): IJclPtrSortedMap; +var + ToIndex: Integer; + NewMap: TJclPtrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclPtrSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrSortedMap.KeyOfValue(Value: TObject): Pointer; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrSortedMap.KeySet: IJclPtrSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclPtrArraySet.Create(FSize); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrSortedMap.LastKey: Pointer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrSortedMap.MapEquals(const AMap: IJclPtrMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrSortedMap.InitializeArrayAfterMove(var List: TJclPtrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclPtrSortedMap.MoveArray(var List: TJclPtrSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclPtrSortedMap.PutAll(const AMap: IJclPtrMap); +var + It: IJclPtrIterator; + Key: Pointer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrSortedMap.PutValue(Key: Pointer; Value: TObject); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, nil) <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrSortedMap.Remove(Key: Pointer): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclPtrSortedMap.SubMap(FromKey, ToKey: Pointer): IJclPtrSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclPtrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclPtrSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrSortedMap.TailMap(FromKey: Pointer): IJclPtrSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclPtrSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclPtrSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrSortedMap.Values: IJclCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclPtrSortedMap.Create(FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclPtrSortedMap.FreeKey(var Key: Pointer): Pointer; +begin + Result := Key; + Key := nil; +end; + +function TJclPtrSortedMap.FreeValue(var Value: TObject): TObject; +begin + if FOwnsValues then + begin + Result := nil; + FreeAndNil(Value); + end + else + begin + Result := Value; + Value := nil; + end; +end; + +function TJclPtrSortedMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +function TJclPtrSortedMap.KeysCompare(A, B: Pointer): Integer; +begin + Result := ItemsCompare(A, B); +end; + +function TJclPtrSortedMap.ValuesCompare(A, B: TObject): Integer; +begin + Result := SimpleCompare(A, B); +end; + +//=== { TJclSortedMap } ============================================== + +constructor TJclSortedMap.Create(ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean); +begin + inherited Create(); + FOwnsKeys := AOwnsKeys; + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); +end; + +destructor TJclSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclSortedMap then + begin + MyDest := TJclSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclSortedMap.BinarySearch(Key: TObject): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.ContainsKey(Key: TObject): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.ContainsValue(Value: TObject): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.FirstKey: TObject; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.Extract(Key: TObject): TObject; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := nil; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := nil; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.GetValue(Key: TObject): TObject; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := nil; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.HeadMap(ToKey: TObject): IJclSortedMap; +var + ToIndex: Integer; + NewMap: TJclSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.KeyOfValue(Value: TObject): TObject; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := nil; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.KeySet: IJclSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArraySet.Create(FSize, False); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.LastKey: TObject; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.MapEquals(const AMap: IJclMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSortedMap.InitializeArrayAfterMove(var List: TJclSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +procedure TJclSortedMap.MoveArray(var List: TJclSortedMapEntryArray; FromIndex, ToIndex, Count: SizeInt); +begin + if Count > 0 then + begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); + end; +end; + +procedure TJclSortedMap.PutAll(const AMap: IJclMap); +var + It: IJclIterator; + Key: TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSortedMap.PutValue(Key: TObject; Value: TObject); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, nil) <> 0) and (ValuesCompare(Value, nil) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.Remove(Key: TObject): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclSortedMap.SubMap(FromKey, ToKey: TObject): IJclSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.TailMap(FromKey: TObject): IJclSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.Values: IJclCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FSize, False); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclSortedMap.Create(FSize, False, False); + AssignPropertiesTo(Result); +end; + +function TJclSortedMap.FreeKey(var Key: TObject): TObject; +begin + if FOwnsKeys then + begin + Result := nil; + FreeAndNil(Key); + end + else + begin + Result := Key; + Key := nil; + end; +end; + +function TJclSortedMap.FreeValue(var Value: TObject): TObject; +begin + if FOwnsValues then + begin + Result := nil; + FreeAndNil(Value); + end + else + begin + Result := Value; + Value := nil; + end; +end; + +function TJclSortedMap.GetOwnsKeys: Boolean; +begin + Result := FOwnsKeys; +end; + +function TJclSortedMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +function TJclSortedMap.KeysCompare(A, B: TObject): Integer; +begin + Result := SimpleCompare(A, B); +end; + +function TJclSortedMap.ValuesCompare(A, B: TObject): Integer; +begin + Result := SimpleCompare(A, B); +end; + + + +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +//=== { TJclSortedMap } ============================================== + +constructor TJclSortedMap.Create(ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean); +begin + inherited Create(); + + FOwnsKeys := AOwnsKeys; + FOwnsValues := AOwnsValues; + SetCapacity(ACapacity); +end; + +destructor TJclSortedMap.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclSortedMap.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: TJclSortedMap; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclSortedMap then + begin + MyDest := TJclSortedMap(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function TJclSortedMap.BinarySearch(const Key: TKey): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSortedMap.Clear; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.ContainsKey(const Key: TKey): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.ContainsValue(const Value: TValue): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.FirstKey: TKey; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := Default(TKey); + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.Extract(const Key: TKey): TValue; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := Default(TValue); + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := Default(TValue); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.GetValue(const Key: TKey): TValue; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Index := BinarySearch(Key); + Result := Default(TValue); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.HeadMap(const ToKey: TKey): IJclSortedMap; +var + ToIndex: Integer; + NewMap: TJclSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclSortedMap; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.IsEmpty: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := FSize = 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.KeyOfValue(const Value: TValue): TKey; +var + Index: Integer; + Found: Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Found := False; + Result := Default(TKey); + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.KeySet: IJclSet; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := CreateEmptyArraySet(FSize, False); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.LastKey: TKey; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := Default(TKey); + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.MapEquals(const AMap: IJclMap): Boolean; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSortedMap.MoveArray(var List: TSortedEntryArray; FromIndex, ToIndex, Count: SizeInt); +var + I: SizeInt; +begin + if FromIndex < ToIndex then + begin + for I := Count - 1 downto 0 do + List[ToIndex + I] := List[FromIndex + I]; + + if (ToIndex - FromIndex) < Count then + // overlapped source and target + for I := 0 to ToIndex - FromIndex - 1 do + List[FromIndex + I] := Default(TSortedEntry) + else + // independent + for I := 0 to Count - 1 do + List[FromIndex + I] := Default(TSortedEntry); + end + else + begin + for I := 0 to Count - 1 do + List[ToIndex + I] := List[FromIndex + I]; + + if (FromIndex - ToIndex) < Count then + // overlapped source and target + for I := Count - FromIndex + ToIndex to Count - 1 do + List[FromIndex + I] := Default(TSortedEntry) + else + // independent + for I := 0 to Count - 1 do + List[FromIndex + I] := Default(TSortedEntry); + end; +end; + +procedure TJclSortedMap.PutAll(const AMap: IJclMap); +var + It: IJclIterator; + Key: TKey; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSortedMap.PutValue(const Key: TKey; const Value: TValue); +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FAllowDefaultElements or ((KeysCompare(Key, Default(TKey)) <> 0) and (ValuesCompare(Value, Default(TValue)) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.Remove(const Key: TKey): TValue; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(Key); + Result := FreeValue(Result); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSortedMap.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.Size: Integer; +begin + Result := FSize; +end; + +function TJclSortedMap.SubMap(const FromKey, ToKey: TKey): IJclSortedMap; +var + FromIndex, ToIndex: Integer; + NewMap: TJclSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.TailMap(const FromKey: TKey): IJclSortedMap; +var + FromIndex, Index: Integer; + NewMap: TJclSortedMap; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + NewMap := CreateEmptyContainer as TJclSortedMap; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.Values: IJclCollection; +var + Index: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := CreateEmptyArrayList(FSize, False); + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSortedMap.FreeKey(var Key: TKey): TKey; +begin + if FOwnsKeys then + begin + Result := Default(TKey); + FreeAndNilIfObject(Key); + end + else + begin + Result := Key; + Key := Default(TKey); + end; +end; + +function TJclSortedMap.FreeValue(var Value: TValue): TValue; +begin + if FOwnsValues then + begin + Result := Default(TValue); + FreeAndNilIfObject(Value); + end + else + begin + Result := Value; + Value := Default(TValue); + end; +end; + +function TJclSortedMap.GetOWnsKeys: Boolean; +begin + Result := FOwnsKeys; +end; + +function TJclSortedMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +//=== { TJclSortedMapE } ======================================= + +constructor TJclSortedMapE.Create(const AKeyComparer: IJclComparer; + const AValueComparer: IJclComparer; const AValueEqualityComparer: IJclEqualityComparer; ACapacity: Integer; + AOwnsValues: Boolean; AOwnsKeys: Boolean); +begin + inherited Create(ACapacity, AOwnsValues, AOwnsKeys); + FKeyComparer := AKeyComparer; + FValueComparer := AValueComparer; + FValueEqualityComparer := AValueEqualityComparer; +end; + +procedure TJclSortedMapE.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclSortedMapE; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclSortedMapE then + begin + ADest := TJclSortedMapE(Dest); + ADest.FKeyComparer := FKeyComparer; + ADest.FValueComparer := FValueComparer; + end; +end; + +function TJclSortedMapE.CreateEmptyArrayList(ACapacity: Integer; + AOwnsObjects: Boolean): IJclCollection; +begin + if FValueEqualityComparer = nil then + raise EJclNoEqualityComparerError.Create; + Result := TArrayList.Create(FValueEqualityComparer, ACapacity, AOwnsObjects); +end; + +function TJclSortedMapE.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclSortedMapE.Create(FKeyComparer, FValueComparer, FValueEqualityComparer, FCapacity, + FOwnsValues, FOwnsKeys); + AssignPropertiesTo(Result); +end; + +function TJclSortedMapE.CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; +begin + Result := TArraySet.Create(FKeyComparer, FCapacity, AOwnsObjects); +end; + +function TJclSortedMapE.KeysCompare(const A, B: TKey): Integer; +begin + if KeyComparer = nil then + raise EJclNoComparerError.Create; + Result := KeyComparer.Compare(A, B); +end; + +function TJclSortedMapE.ValuesCompare(const A, B: TValue): Integer; +begin + if ValueComparer = nil then + raise EJclNoComparerError.Create; + Result := ValueComparer.Compare(A, B); +end; + +//=== { TJclSortedMapF } ======================================= + +constructor TJclSortedMapF.Create(AKeyCompare: TCompare; AValueCompare: TCompare; + AValueEqualityCompare: TEqualityCompare; ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean); +begin + inherited Create(ACapacity, AOwnsValues, AOwnsKeys); + FKeyCompare := AKeyCompare; + FValueCompare := AValueCompare; + FValueEqualityCompare := AValueEqualityCompare; +end; + +procedure TJclSortedMapF.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclSortedMapF; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclSortedMapF then + begin + ADest := TJclSortedMapF(Dest); + ADest.FKeyCompare := FKeyCompare; + ADest.FValueCompare := FValueCompare; + end; +end; + +function TJclSortedMapF.CreateEmptyArrayList(ACapacity: Integer; + AOwnsObjects: Boolean): IJclCollection; +begin + if not Assigned(FValueEqualityCompare) then + raise EJclNoEqualityComparerError.Create; + Result := TArrayList.Create(FValueEqualityCompare, ACapacity, AOwnsObjects); +end; + +function TJclSortedMapF.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclSortedMapF.Create(FKeyCompare, FValueCompare, FValueEqualityCompare, FCapacity, + FOwnsValues, FOwnsKeys); + AssignPropertiesTo(Result); +end; + +function TJclSortedMapF.CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; +begin + Result := TArraySet.Create(FKeyCompare, FCapacity, AOwnsObjects); +end; + +function TJclSortedMapF.KeysCompare(const A, B: TKey): Integer; +begin + if not Assigned(KeyCompare) then + raise EJclNoComparerError.Create; + Result := KeyCompare(A, B); +end; + +function TJclSortedMapF.ValuesCompare(const A, B: TValue): Integer; +begin + if not Assigned(ValueCompare) then + raise EJclNoComparerError.Create; + Result := ValueCompare(A, B); +end; + +//=== { TJclSortedMapI } ======================================= + +function TJclSortedMapI.CreateEmptyArrayList(ACapacity: Integer; + AOwnsObjects: Boolean): IJclCollection; +begin + Result := TArrayList.Create(ACapacity, AOwnsObjects); +end; + +function TJclSortedMapI.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclSortedMapI.Create(FCapacity, FOwnsValues, FOwnsKeys); + AssignPropertiesTo(Result); +end; + +function TJclSortedMapI.CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; +begin + Result := TArraySet.Create(FCapacity, AOwnsObjects); +end; + +function TJclSortedMapI.KeysCompare(const A, B: TKey): Integer; +begin + Result := A.CompareTo(B); +end; + +function TJclSortedMapI.ValuesCompare(const A, B: TValue): Integer; +begin + Result := A.CompareTo(B); +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclStacks.pas b/3rdParty/JCL/source/common/JclStacks.pas new file mode 100644 index 00000000..2b9c8185 --- /dev/null +++ b/3rdParty/JCL/source/common/JclStacks.pas @@ -0,0 +1,3017 @@ +{**************************************************************************************************} +{ WARNING: JEDI preprocessor generated unit. Do not edit. } +{**************************************************************************************************} + +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is Stack.pas. } +{ } +{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } +{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } +{ All rights reserved. } +{ } +{ Contributors: } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclStacks; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + {$IFDEF SUPPORTS_GENERICS} + System.Generics.Collections, + JclAlgorithms, + {$ENDIF SUPPORTS_GENERICS} + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF SUPPORTS_GENERICS} + Generics.Collections, + JclAlgorithms, + {$ENDIF SUPPORTS_GENERICS} + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclAbstractContainers, JclContainerIntf, JclSynch; + +type + TJclIntfStack = class(TJclIntfAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclIntfContainer, IJclIntfEqualityComparer, + IJclIntfStack) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElements: TDynIInterfaceArray; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclIntfStack } + procedure Clear; + function Contains(const AInterface: IInterface): Boolean; + function Empty: Boolean; + function Peek: IInterface; + function Pop: IInterface; + function Push(const AInterface: IInterface): Boolean; + function Size: Integer; + end; + + TJclAnsiStrStack = class(TJclAnsiStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclAnsiStrContainer, IJclAnsiStrEqualityComparer, IJclStrBaseContainer, + IJclAnsiStrStack) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElements: TDynAnsiStringArray; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclAnsiStrStack } + procedure Clear; + function Contains(const AString: AnsiString): Boolean; + function Empty: Boolean; + function Peek: AnsiString; + function Pop: AnsiString; + function Push(const AString: AnsiString): Boolean; + function Size: Integer; + end; + + TJclWideStrStack = class(TJclWideStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclWideStrContainer, IJclWideStrEqualityComparer, IJclStrBaseContainer, + IJclWideStrStack) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElements: TDynWideStringArray; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclWideStrStack } + procedure Clear; + function Contains(const AString: WideString): Boolean; + function Empty: Boolean; + function Peek: WideString; + function Pop: WideString; + function Push(const AString: WideString): Boolean; + function Size: Integer; + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclUnicodeStrStack = class(TJclUnicodeStrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclUnicodeStrContainer, IJclUnicodeStrEqualityComparer, IJclStrBaseContainer, + IJclUnicodeStrStack) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElements: TDynUnicodeStringArray; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclUnicodeStrStack } + procedure Clear; + function Contains(const AString: UnicodeString): Boolean; + function Empty: Boolean; + function Peek: UnicodeString; + function Pop: UnicodeString; + function Push(const AString: UnicodeString): Boolean; + function Size: Integer; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + TJclStrStack = TJclAnsiStrStack; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TJclStrStack = TJclWideStrStack; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TJclStrStack = TJclUnicodeStrStack; + {$ENDIF CONTAINER_UNICODESTR} + + TJclSingleStack = class(TJclSingleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclSingleContainer, IJclSingleEqualityComparer, + IJclSingleStack) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElements: TDynSingleArray; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclSingleStack } + procedure Clear; + function Contains(const AValue: Single): Boolean; + function Empty: Boolean; + function Peek: Single; + function Pop: Single; + function Push(const AValue: Single): Boolean; + function Size: Integer; + end; + + TJclDoubleStack = class(TJclDoubleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclDoubleContainer, IJclDoubleEqualityComparer, + IJclDoubleStack) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElements: TDynDoubleArray; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclDoubleStack } + procedure Clear; + function Contains(const AValue: Double): Boolean; + function Empty: Boolean; + function Peek: Double; + function Pop: Double; + function Push(const AValue: Double): Boolean; + function Size: Integer; + end; + + TJclExtendedStack = class(TJclExtendedAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclExtendedContainer, IJclExtendedEqualityComparer, + IJclExtendedStack) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElements: TDynExtendedArray; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclExtendedStack } + procedure Clear; + function Contains(const AValue: Extended): Boolean; + function Empty: Boolean; + function Peek: Extended; + function Pop: Extended; + function Push(const AValue: Extended): Boolean; + function Size: Integer; + end; + + {$IFDEF MATH_SINGLE_PRECISION} + TJclFloatStack = TJclSingleStack; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TJclFloatStack = TJclDoubleStack; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TJclFloatStack = TJclExtendedStack; + {$ENDIF MATH_EXTENDED_PRECISION} + + TJclIntegerStack = class(TJclIntegerAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclIntegerContainer, IJclIntegerEqualityComparer, + IJclIntegerStack) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElements: TDynIntegerArray; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclIntegerStack } + procedure Clear; + function Contains(AValue: Integer): Boolean; + function Empty: Boolean; + function Peek: Integer; + function Pop: Integer; + function Push(AValue: Integer): Boolean; + function Size: Integer; + end; + + TJclCardinalStack = class(TJclCardinalAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclCardinalContainer, IJclCardinalEqualityComparer, + IJclCardinalStack) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElements: TDynCardinalArray; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclCardinalStack } + procedure Clear; + function Contains(AValue: Cardinal): Boolean; + function Empty: Boolean; + function Peek: Cardinal; + function Pop: Cardinal; + function Push(AValue: Cardinal): Boolean; + function Size: Integer; + end; + + TJclInt64Stack = class(TJclInt64AbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclInt64Container, IJclInt64EqualityComparer, + IJclInt64Stack) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElements: TDynInt64Array; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclInt64Stack } + procedure Clear; + function Contains(const AValue: Int64): Boolean; + function Empty: Boolean; + function Peek: Int64; + function Pop: Int64; + function Push(const AValue: Int64): Boolean; + function Size: Integer; + end; + + TJclPtrStack = class(TJclPtrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclPtrContainer, IJclPtrEqualityComparer, + IJclPtrStack) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElements: TDynPointerArray; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer); + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclPtrStack } + procedure Clear; + function Contains(APtr: Pointer): Boolean; + function Empty: Boolean; + function Peek: Pointer; + function Pop: Pointer; + function Push(APtr: Pointer): Boolean; + function Size: Integer; + end; + + TJclStack = class(TJclAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclContainer, IJclEqualityComparer, IJclObjectOwner, + IJclStack) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FElements: TDynObjectArray; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer; AOwnsObjects: Boolean); + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclStack } + procedure Clear; + function Contains(AObject: TObject): Boolean; + function Empty: Boolean; + function Peek: TObject; + function Pop: TObject; + function Push(AObject: TObject): Boolean; + function Size: Integer; + end; + + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + + TJclStack = class(TJclAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclContainer, IJclEqualityComparer, IJclItemOwner, + IJclStack) + protected + type + TDynArray = array of T; + private + FElements: TDynArray; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(ACapacity: Integer; AOwnsItems: Boolean); + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclStack } + procedure Clear; + function Contains(const AItem: T): Boolean; + function Empty: Boolean; + function Peek: T; + function Pop: T; + function Push(const AItem: T): Boolean; + function Size: Integer; + end; + + // E = external helper to compare items for equality + TJclStackE = class(TJclStack, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, + IJclStack, IJclItemOwner) + private + FEqualityComparer: IEqualityComparer; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AEqualityComparer: IEqualityComparer; ACapacity: Integer; AOwnsItems: Boolean); + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + property EqualityComparer: IEqualityComparer read FEqualityComparer write FEqualityComparer; + end; + + // F = Function to compare items for equality + TJclStackF = class(TJclStack, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, + IJclStack, IJclItemOwner) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(AEqualityCompare: TEqualityCompare; ACapacity: Integer; AOwnsItems: Boolean); + end; + + // I = items can compare themselves to an other for equality + TJclStackI> = class(TJclStack, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, + IJclStack, IJclItemOwner) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +{$IFDEF BCB} +{$IFDEF WIN64} + {$HPPEMIT '#ifdef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #undef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #define JclStacks_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT '#endif'} + + {$HPPEMIT END '#ifdef JclStacks_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #define MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #undef JclStacks_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END '#endif'} +{$ENDIF WIN64} +{$ENDIF BCB} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + SysUtils; + +//=== { TJclIntfStack } ======================================================= + +constructor TJclIntfStack.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclIntfStack.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntfStack.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclIntfStack; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntfStack then + begin + ADest := TJclIntfStack(Dest); + ADest.Clear; + ADest.SetCapacity(FSize + 1); + for I := 0 to FSize - 1 do + ADest.FElements[I] := FElements[I]; + ADest.FSize := FSize; + end; +end; + +procedure TJclIntfStack.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeObject(FElements[I]); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfStack.Contains(const AInterface: IInterface): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElements[I], AInterface) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfStack.Empty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntfStack.Peek: IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FElements[FSize - 1] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfStack.Pop: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + begin + Dec(FSize); + Result := FElements[FSize]; + FElements[FSize] := nil; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfStack.Push(const AInterface: IInterface): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElements[FSize] := AInterface; + Inc(FSize); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfStack.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < FSize then + raise EJclOutOfBoundsError.Create; + SetLength(FElements, Value); + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfStack.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfStack.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfStack.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclAnsiStrStack } ======================================================= + +constructor TJclAnsiStrStack.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclAnsiStrStack.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclAnsiStrStack.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclAnsiStrStack; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclAnsiStrStack then + begin + ADest := TJclAnsiStrStack(Dest); + ADest.Clear; + ADest.SetCapacity(FSize + 1); + for I := 0 to FSize - 1 do + ADest.FElements[I] := FElements[I]; + ADest.FSize := FSize; + end; +end; + +procedure TJclAnsiStrStack.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeString(FElements[I]); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrStack.Contains(const AString: AnsiString): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElements[I], AString) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrStack.Empty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclAnsiStrStack.Peek: AnsiString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if FSize > 0 then + Result := FElements[FSize - 1] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrStack.Pop: AnsiString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := ''; + if FSize > 0 then + begin + Dec(FSize); + Result := FElements[FSize]; + FElements[FSize] := ''; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrStack.Push(const AString: AnsiString): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElements[FSize] := AString; + Inc(FSize); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrStack.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < FSize then + raise EJclOutOfBoundsError.Create; + SetLength(FElements, Value); + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrStack.Size: Integer; +begin + Result := FSize; +end; + +function TJclAnsiStrStack.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclAnsiStrStack.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclWideStrStack } ======================================================= + +constructor TJclWideStrStack.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclWideStrStack.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclWideStrStack.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclWideStrStack; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclWideStrStack then + begin + ADest := TJclWideStrStack(Dest); + ADest.Clear; + ADest.SetCapacity(FSize + 1); + for I := 0 to FSize - 1 do + ADest.FElements[I] := FElements[I]; + ADest.FSize := FSize; + end; +end; + +procedure TJclWideStrStack.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeString(FElements[I]); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrStack.Contains(const AString: WideString): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElements[I], AString) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrStack.Empty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclWideStrStack.Peek: WideString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if FSize > 0 then + Result := FElements[FSize - 1] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrStack.Pop: WideString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := ''; + if FSize > 0 then + begin + Dec(FSize); + Result := FElements[FSize]; + FElements[FSize] := ''; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrStack.Push(const AString: WideString): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElements[FSize] := AString; + Inc(FSize); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrStack.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < FSize then + raise EJclOutOfBoundsError.Create; + SetLength(FElements, Value); + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrStack.Size: Integer; +begin + Result := FSize; +end; + +function TJclWideStrStack.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclWideStrStack.Create(FSize); + AssignPropertiesTo(Result); +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrStack } ======================================================= + +constructor TJclUnicodeStrStack.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclUnicodeStrStack.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclUnicodeStrStack.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclUnicodeStrStack; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclUnicodeStrStack then + begin + ADest := TJclUnicodeStrStack(Dest); + ADest.Clear; + ADest.SetCapacity(FSize + 1); + for I := 0 to FSize - 1 do + ADest.FElements[I] := FElements[I]; + ADest.FSize := FSize; + end; +end; + +procedure TJclUnicodeStrStack.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeString(FElements[I]); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrStack.Contains(const AString: UnicodeString): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElements[I], AString) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrStack.Empty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclUnicodeStrStack.Peek: UnicodeString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if FSize > 0 then + Result := FElements[FSize - 1] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrStack.Pop: UnicodeString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := ''; + if FSize > 0 then + begin + Dec(FSize); + Result := FElements[FSize]; + FElements[FSize] := ''; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrStack.Push(const AString: UnicodeString): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElements[FSize] := AString; + Inc(FSize); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrStack.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < FSize then + raise EJclOutOfBoundsError.Create; + SetLength(FElements, Value); + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrStack.Size: Integer; +begin + Result := FSize; +end; + +function TJclUnicodeStrStack.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclUnicodeStrStack.Create(FSize); + AssignPropertiesTo(Result); +end; + +{$ENDIF SUPPORTS_UNICODE_STRING} + +//=== { TJclSingleStack } ======================================================= + +constructor TJclSingleStack.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclSingleStack.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclSingleStack.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclSingleStack; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclSingleStack then + begin + ADest := TJclSingleStack(Dest); + ADest.Clear; + ADest.SetCapacity(FSize + 1); + for I := 0 to FSize - 1 do + ADest.FElements[I] := FElements[I]; + ADest.FSize := FSize; + end; +end; + +procedure TJclSingleStack.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeSingle(FElements[I]); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleStack.Contains(const AValue: Single): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElements[I], AValue) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleStack.Empty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclSingleStack.Peek: Single; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FSize > 0 then + Result := FElements[FSize - 1] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleStack.Pop: Single; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FSize > 0 then + begin + Dec(FSize); + Result := FElements[FSize]; + FElements[FSize] := 0.0; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleStack.Push(const AValue: Single): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElements[FSize] := AValue; + Inc(FSize); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleStack.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < FSize then + raise EJclOutOfBoundsError.Create; + SetLength(FElements, Value); + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleStack.Size: Integer; +begin + Result := FSize; +end; + +function TJclSingleStack.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclSingleStack.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclDoubleStack } ======================================================= + +constructor TJclDoubleStack.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclDoubleStack.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclDoubleStack.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclDoubleStack; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclDoubleStack then + begin + ADest := TJclDoubleStack(Dest); + ADest.Clear; + ADest.SetCapacity(FSize + 1); + for I := 0 to FSize - 1 do + ADest.FElements[I] := FElements[I]; + ADest.FSize := FSize; + end; +end; + +procedure TJclDoubleStack.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeDouble(FElements[I]); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleStack.Contains(const AValue: Double): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElements[I], AValue) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleStack.Empty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclDoubleStack.Peek: Double; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FSize > 0 then + Result := FElements[FSize - 1] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleStack.Pop: Double; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FSize > 0 then + begin + Dec(FSize); + Result := FElements[FSize]; + FElements[FSize] := 0.0; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleStack.Push(const AValue: Double): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElements[FSize] := AValue; + Inc(FSize); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleStack.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < FSize then + raise EJclOutOfBoundsError.Create; + SetLength(FElements, Value); + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleStack.Size: Integer; +begin + Result := FSize; +end; + +function TJclDoubleStack.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclDoubleStack.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclExtendedStack } ======================================================= + +constructor TJclExtendedStack.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclExtendedStack.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclExtendedStack.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclExtendedStack; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclExtendedStack then + begin + ADest := TJclExtendedStack(Dest); + ADest.Clear; + ADest.SetCapacity(FSize + 1); + for I := 0 to FSize - 1 do + ADest.FElements[I] := FElements[I]; + ADest.FSize := FSize; + end; +end; + +procedure TJclExtendedStack.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeExtended(FElements[I]); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedStack.Contains(const AValue: Extended): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElements[I], AValue) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedStack.Empty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclExtendedStack.Peek: Extended; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FSize > 0 then + Result := FElements[FSize - 1] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedStack.Pop: Extended; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FSize > 0 then + begin + Dec(FSize); + Result := FElements[FSize]; + FElements[FSize] := 0.0; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedStack.Push(const AValue: Extended): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElements[FSize] := AValue; + Inc(FSize); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedStack.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < FSize then + raise EJclOutOfBoundsError.Create; + SetLength(FElements, Value); + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedStack.Size: Integer; +begin + Result := FSize; +end; + +function TJclExtendedStack.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclExtendedStack.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclIntegerStack } ======================================================= + +constructor TJclIntegerStack.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclIntegerStack.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclIntegerStack.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclIntegerStack; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntegerStack then + begin + ADest := TJclIntegerStack(Dest); + ADest.Clear; + ADest.SetCapacity(FSize + 1); + for I := 0 to FSize - 1 do + ADest.FElements[I] := FElements[I]; + ADest.FSize := FSize; + end; +end; + +procedure TJclIntegerStack.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeInteger(FElements[I]); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerStack.Contains(AValue: Integer): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElements[I], AValue) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerStack.Empty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntegerStack.Peek: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if FSize > 0 then + Result := FElements[FSize - 1] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerStack.Pop: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0; + if FSize > 0 then + begin + Dec(FSize); + Result := FElements[FSize]; + FElements[FSize] := 0; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerStack.Push(AValue: Integer): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElements[FSize] := AValue; + Inc(FSize); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerStack.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < FSize then + raise EJclOutOfBoundsError.Create; + SetLength(FElements, Value); + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerStack.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntegerStack.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntegerStack.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclCardinalStack } ======================================================= + +constructor TJclCardinalStack.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclCardinalStack.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclCardinalStack.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclCardinalStack; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclCardinalStack then + begin + ADest := TJclCardinalStack(Dest); + ADest.Clear; + ADest.SetCapacity(FSize + 1); + for I := 0 to FSize - 1 do + ADest.FElements[I] := FElements[I]; + ADest.FSize := FSize; + end; +end; + +procedure TJclCardinalStack.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeCardinal(FElements[I]); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalStack.Contains(AValue: Cardinal): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElements[I], AValue) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalStack.Empty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclCardinalStack.Peek: Cardinal; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if FSize > 0 then + Result := FElements[FSize - 1] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalStack.Pop: Cardinal; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0; + if FSize > 0 then + begin + Dec(FSize); + Result := FElements[FSize]; + FElements[FSize] := 0; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalStack.Push(AValue: Cardinal): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElements[FSize] := AValue; + Inc(FSize); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalStack.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < FSize then + raise EJclOutOfBoundsError.Create; + SetLength(FElements, Value); + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalStack.Size: Integer; +begin + Result := FSize; +end; + +function TJclCardinalStack.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclCardinalStack.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclInt64Stack } ======================================================= + +constructor TJclInt64Stack.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclInt64Stack.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclInt64Stack.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclInt64Stack; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclInt64Stack then + begin + ADest := TJclInt64Stack(Dest); + ADest.Clear; + ADest.SetCapacity(FSize + 1); + for I := 0 to FSize - 1 do + ADest.FElements[I] := FElements[I]; + ADest.FSize := FSize; + end; +end; + +procedure TJclInt64Stack.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeInt64(FElements[I]); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Stack.Contains(const AValue: Int64): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElements[I], AValue) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Stack.Empty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclInt64Stack.Peek: Int64; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if FSize > 0 then + Result := FElements[FSize - 1] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Stack.Pop: Int64; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := 0; + if FSize > 0 then + begin + Dec(FSize); + Result := FElements[FSize]; + FElements[FSize] := 0; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Stack.Push(const AValue: Int64): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElements[FSize] := AValue; + Inc(FSize); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64Stack.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < FSize then + raise EJclOutOfBoundsError.Create; + SetLength(FElements, Value); + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Stack.Size: Integer; +begin + Result := FSize; +end; + +function TJclInt64Stack.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclInt64Stack.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclPtrStack } ======================================================= + +constructor TJclPtrStack.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +destructor TJclPtrStack.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclPtrStack.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclPtrStack; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclPtrStack then + begin + ADest := TJclPtrStack(Dest); + ADest.Clear; + ADest.SetCapacity(FSize + 1); + for I := 0 to FSize - 1 do + ADest.FElements[I] := FElements[I]; + ADest.FSize := FSize; + end; +end; + +procedure TJclPtrStack.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreePointer(FElements[I]); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrStack.Contains(APtr: Pointer): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElements[I], APtr) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrStack.Empty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclPtrStack.Peek: Pointer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FElements[FSize - 1] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrStack.Pop: Pointer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + begin + Dec(FSize); + Result := FElements[FSize]; + FElements[FSize] := nil; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrStack.Push(APtr: Pointer): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElements[FSize] := APtr; + Inc(FSize); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrStack.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < FSize then + raise EJclOutOfBoundsError.Create; + SetLength(FElements, Value); + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrStack.Size: Integer; +begin + Result := FSize; +end; + +function TJclPtrStack.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclPtrStack.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclStack } ======================================================= + +constructor TJclStack.Create(ACapacity: Integer; AOwnsObjects: Boolean); +begin + inherited Create(AOwnsObjects); + SetCapacity(ACapacity); +end; + +destructor TJclStack.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclStack.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclStack; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclStack then + begin + ADest := TJclStack(Dest); + ADest.Clear; + ADest.SetCapacity(FSize + 1); + for I := 0 to FSize - 1 do + ADest.FElements[I] := FElements[I]; + ADest.FSize := FSize; + end; +end; + +procedure TJclStack.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeObject(FElements[I]); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclStack.Contains(AObject: TObject): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElements[I], AObject) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclStack.Empty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclStack.Peek: TObject; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + Result := FElements[FSize - 1] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclStack.Pop: TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := nil; + if FSize > 0 then + begin + Dec(FSize); + Result := FElements[FSize]; + FElements[FSize] := nil; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclStack.Push(AObject: TObject): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElements[FSize] := AObject; + Inc(FSize); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclStack.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < FSize then + raise EJclOutOfBoundsError.Create; + SetLength(FElements, Value); + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclStack.Size: Integer; +begin + Result := FSize; +end; + +function TJclStack.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclStack.Create(FSize, False); + AssignPropertiesTo(Result); +end; + + +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +//=== { TJclStack } ======================================================= + +constructor TJclStack.Create(ACapacity: Integer; AOwnsItems: Boolean); +begin + inherited Create(AOwnsItems); + SetCapacity(ACapacity); +end; + +destructor TJclStack.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure TJclStack.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclStack; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is TJclStack then + begin + ADest := TJclStack(Dest); + ADest.Clear; + ADest.SetCapacity(FSize + 1); + for I := 0 to FSize - 1 do + ADest.FElements[I] := FElements[I]; + ADest.FSize := FSize; + end; +end; + +procedure TJclStack.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeItem(FElements[I]); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclStack.Contains(const AItem: T): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElements[I], AItem) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclStack.Empty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclStack.Peek: T; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := Default(T); + if FSize > 0 then + Result := FElements[FSize - 1] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclStack.Pop: T; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Default(T); + if FSize > 0 then + begin + Dec(FSize); + Result := FElements[FSize]; + FElements[FSize] := Default(T); + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclStack.Push(const AItem: T): Boolean; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElements[FSize] := AItem; + Inc(FSize); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclStack.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value < FSize then + raise EJclOutOfBoundsError.Create; + SetLength(FElements, Value); + inherited SetCapacity(Value); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclStack.Size: Integer; +begin + Result := FSize; +end; + +//=== { TJclStackE } ====================================================== + +constructor TJclStackE.Create(const AEqualityComparer: IEqualityComparer; ACapacity: Integer; + AOwnsItems: Boolean); +begin + inherited Create(ACapacity, AOwnsItems); + FEqualityComparer := AEqualityComparer; +end; + +procedure TJclStackE.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclStackE then + TJclStackE(Dest).FEqualityComparer := FEqualityComparer; +end; + +function TJclStackE.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclStackE.Create(FEqualityComparer, FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclStackE.ItemsEqual(const A, B: T): Boolean; +begin + if EqualityComparer <> nil then + Result := EqualityComparer.Equals(A, B) + else + Result := inherited ItemsEqual(A, B); +end; + +//=== { TJclStackF } ====================================================== + +constructor TJclStackF.Create(AEqualityCompare: TEqualityCompare; ACapacity: Integer; AOwnsItems: Boolean); +begin + inherited Create(ACapacity, AOwnsItems); + SetEqualityCompare(AEqualityCompare); +end; + +function TJclStackF.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclStackF.Create(FEqualityCompare, FSize + 1, False); + AssignPropertiesTo(Result); +end; + +//=== { TJclStackI } ====================================================== + +function TJclStackI.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclStackI.Create(FSize + 1, False); + AssignPropertiesTo(Result); +end; + +function TJclStackI.ItemsEqual(const A, B: T): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + Result := A.Equals(B); +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclStatistics.pas b/3rdParty/JCL/source/common/JclStatistics.pas new file mode 100644 index 00000000..066d4327 --- /dev/null +++ b/3rdParty/JCL/source/common/JclStatistics.pas @@ -0,0 +1,507 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclStatistics.pas. } +{ } +{ The Initial Developer of the Original Code is ESB Consultancy. } +{ Portions created by ESB Consultancy are Copyright ESB Consultancy. All rights reserved. } +{ } +{ Contributors (in alphabetical order): } +{ ESB Consultancy } +{ Fred Hovey } +{ Marcel van Brakel } +{ Matthias Thoma } +{ Robert Marquardt } +{ Robert Rossmair } +{ Petr Vones } +{ } +{**************************************************************************************************} +{ } +{ Various common statistics routines to calculate, for example, the arithmetic mean, geometric } +{ meanor median of a set of numbers. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +{ TODO : Test cases! } + +unit JclStatistics; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclBase, JclMath; + +type + EJclStatisticsError = class(EJclMathError); + +{ Mean functions } + +function ArithmeticMean(const X: TDynFloatArray): Float; +function GeometricMean(const X: TDynFloatArray): Float; +function HarmonicMean(const X: TDynFloatArray): Float; +function HeronianMean(const A, B: Float): Float; + +{ Miscellanous } + +function BinomialCoeff(N, R: Cardinal): Float; +function IsPositiveFloatArray(const X: TDynFloatArray): Boolean; +function MaxFloatArray(const B: TDynFloatArray): Float; +function MaxFloatArrayIndex(const B: TDynFloatArray): Integer; +function Median(const X: TDynFloatArray): Float; +function MedianUnsorted(const X: TDynFloatArray): Float; +function MinFloatArray(const B: TDynFloatArray): Float; +function MinFloatArrayIndex(const B: TDynFloatArray): Integer; +function Permutation(N, R: Cardinal): Float; +function Combinations(N, R: Cardinal): Float; +function SumOfSquares(const X: TDynFloatArray): Float; +function PopulationVariance(const X: TDynFloatArray): Float; +procedure PopulationVarianceAndMean(const X: TDynFloatArray; var Variance, Mean: Float); +function SampleVariance(const X: TDynFloatArray): Float; +procedure SampleVarianceAndMean(const X: TDynFloatArray; var Variance, Mean: Float); +function StdError(const X: TDynFloatArray): Float; overload; +function StdError(const Variance: Float; const SampleSize: Integer): Float; overload; +function SumFloatArray(const B: TDynFloatArray): Float; +function SumSquareDiffFloatArray(const B: TDynFloatArray; Diff: Float): Float; +function SumSquareFloatArray(const B: TDynFloatArray): Float; +function SumPairProductFloatArray(const X, Y: TDynFloatArray): Float; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + JclLogic, + JclSysUtils, + JclResources; + +//=== Local helpers ========================================================== + +function GetDynLength(const X: TDynFloatArray): Integer; +begin + Result := Length(X); +end; + +function GetDynLengthNotNull(const X: TDynFloatArray): Integer; +begin + Result := Length(X); + if Result = 0 then + raise EJclMathError.CreateRes(@RsEmptyArray); +end; + +procedure InvalidSampleSize(SampleSize: Integer); +begin + raise EJclStatisticsError.CreateResFmt(@RsInvalidSampleSize, [SampleSize]); +end; + +function GetSampleSize(const Sample: TDynFloatArray; MinValidSize: Integer = 1): Integer; +begin + Result := Length(Sample); + if Result < MinValidSize then + InvalidSampleSize(Result); +end; + +//=== Mean Functions ========================================================= + +function ArithmeticMean(const X: TDynFloatArray): Float; +begin + Result := SumFloatArray(X) / Length(X); +end; + +function GeometricMean(const X: TDynFloatArray): Float; +var + I, N: Integer; +begin + N := GetSampleSize(X); + Result := 1.0; + for I := 0 to N - 1 do + begin + if X[I] <= PrecisionTolerance then + raise EJclMathError.CreateRes(@RsNonPositiveArray); + Result := Result * X[I]; + end; + Result := Power(Result, 1 / N); +end; + +function HarmonicMean(const X: TDynFloatArray): Float; +var + I, N: Integer; +begin + Result := 0.0; + N := GetSampleSize(X); + for I := 0 to N - 1 do + begin + if X[I] <= PrecisionTolerance then + raise EJclMathError.CreateRes(@RsNonPositiveArray); + Result := Result + 1 / X[I]; + end; + Result := N / Result; +end; + +function HeronianMean(const A, B: Float): Float; +begin + Assert(A >= 0); + Assert(B >= 0); + Result := (A + Sqrt(A * B) + B) / 3; +end; + +//=== Miscellanous =========================================================== + +function BinomialCoeff(N, R: Cardinal): Float; +var + I: Integer; + K: LongWord; +begin + if (N = 0) or (R > N) or (N > MaxFactorial) then + begin + Result := 0.0; + Exit; + end; + Result := 1.0; + if not ((R = 0) or (R = N)) then + begin + if R > N div 2 then + R := N - R; + K := 2; + try + for I := N - R + 1 to N do + begin + Result := Result * I; + if K <= R then + begin + Result := Result / K; + Inc(K); + end; + end; + Result := Int(Result + 0.5); + except + Result := -1.0; + end; + end; +end; + + +function IsPositiveFloatArray(const X: TDynFloatArray): Boolean; +var + I, N: Integer; +begin + Result := False; + N := GetDynLengthNotNull(X); + for I := 0 to N - 1 do + if X[I] <= PrecisionTolerance then + Exit; + Result := True; +end; + +function MaxFloatArray(const B: TDynFloatArray): Float; +var + I, N: Integer; +begin + N := GetDynLengthNotNull(B); + Result := B[0]; + for I := 1 to N - 1 do + if B[I] > Result then + Result := B[I]; +end; + +function MaxFloatArrayIndex(const B: TDynFloatArray): Integer; +var + I, N: Integer; + Max: Float; +begin + Result := 0; + N := GetDynLengthNotNull(B); + Max := B[0]; + for I := 1 to N - 1 do + if B[I] > Max then + begin + Max := B[I]; + Result := I; + end; +end; + +// The FloatArray X must be presorted so Median can calculate the correct value. +// Y_{(n+1)/2} if N is odd +// Median = { 1/2 * (Y_{n/2} + Y_{1+(n/2) } if N is even + +function Median(const X: TDynFloatArray): Float; +var + N: Integer; +begin + N := GetSampleSize(X); + if N = 1 then + Result := X[0] + else + if Odd(N) then + Result := X[N div 2] + else + Result := (X[N div 2 - 1] + X[N div 2]) / 2; +end; + +function MedianUnsorted(const X: TDynFloatArray): Float; +var + SortedList: TDynFloatArray; + +begin + // We need to sort the values first + SortedList := Copy(X); + // type cast to Pointer for the sake of FPC + SortDynArray(Pointer(SortedList), SizeOf(Float), DynArrayCompareFloat); + + // and call the median function afterwards + Result := Median(SortedList); +end; + +function MinFloatArray(const B: TDynFloatArray): Float; +var + I, N: Integer; +begin + N := GetDynLengthNotNull(B); + Result := B[0]; + for I := 1 to N - 1 do + if B[I] < Result then + Result := B[I]; +end; + +function MinFloatArrayIndex(const B: TDynFloatArray): Integer; +var + I, N: Integer; + Min: Float; +begin + Result := 0; + N := GetDynLengthNotNull(B); + Min := B[0]; + for I := 1 to N - 1 do + if B[I] < Min then + begin + Min := B[I]; + Result := I; + end; +end; + +function Permutation(N, R: Cardinal): Float; +var + I : Integer; +begin + if (N = 0) or (R > N) or (N > MaxFactorial) then + begin + Result := 0.0; + Exit; + end; + Result := 1.0; + if R <> 0 then + try + for I := N downto N - R + 1 do + Result := Result * I; + Result := Int(Result + 0.5); + except + Result := -1.0; + end; +end; + +{ TODO -cDoc : Donator: Fred Hovey } +function Combinations(N, R: Cardinal): Float; +begin + Result := Factorial(R); + if IsFloatZero(Result) then + Result := -1.0 + else + Result := Permutation(N, R) / Result; +end; + +{ TODO -cDoc : donator: Fred Hovey, contributor: Robert Rossmair } +function SumOfSquares(const X: TDynFloatArray): Float; +var + I, N: Integer; + Sum: Float; +begin + N := GetSampleSize(X); + Result := Sqr(X[0]); + Sum := X[0]; + for I := 1 to N - 1 do + begin + Result := Result + Sqr(X[I]); + Sum := Sum + X[I]; + end; + Result := Result - Sum * Sum / N; +end; + +{ TODO -cDoc : Contributors: Fred Hovey, Robert Rossmair } +function PopulationVariance(const X: TDynFloatArray): Float; +begin + // Length(X) = 0 would cause SumOfSquares() to raise an exception before the division is executed. + Result := SumOfSquares(X) / Length(X); +end; + +procedure PopulationVarianceAndMean(const X: TDynFloatArray; var Variance, Mean: Float); +var + I, N: Integer; + Sum, SumSq: Float; +begin + N := GetSampleSize(X); + SumSq := Sqr(X[0]); + Sum := X[0]; + for I := 1 to N - 1 do + begin + SumSq := SumSq + Sqr(X[I]); + Sum := Sum + X[I]; + end; + Mean := Sum / N; + Variance := (SumSq / N) - Sqr(Mean); +end; + +{ TODO -cDoc : Contributors: Fred Hovey, Robert Rossmair } +function SampleVariance(const X: TDynFloatArray): Float; +var + N: Integer; +begin + N := GetSampleSize(X, 2); + Result := SumOfSquares(X) / (N - 1) +end; + +{ TODO -cDoc : Contributors: Fred Hovey, Robert Rossmair } +procedure SampleVarianceAndMean(const X: TDynFloatArray; var Variance, Mean: Float); +var + I, N: Integer; + Sum, SumSq: Float; +begin + N := GetSampleSize(X); + SumSq := Sqr(X[0]); + Sum := X[0]; + for I := 1 to N - 1 do + begin + SumSq := SumSq + Sqr(X[I]); + Sum := Sum + X[I]; + end; + Mean := Sum / N; + if N < 2 then + InvalidSampleSize(N); + //Variance := (SumSq / (N - 1)) - Sqr(Sum / (N - 1)) => WRONG!!!! + Variance := (SumSq - Sum * Sum / N) / (N - 1) +end; + +{ TODO -cDoc : Donator: Fred Hovey, contributor: Robert Rossmair } +function StdError(const X: TDynFloatArray): Float; +begin + // Length(X) = 0 would cause SampleVariance() to raise an exception before the division is + // executed. + Result := Sqrt(SampleVariance(X) / Length(X)); +end; + +{ TODO -cDoc : Donator: Fred Hovey, contributor: Robert Rossmair } +function StdError(const Variance: Float; const SampleSize: Integer): Float; +begin + if SampleSize = 0 then + InvalidSampleSize(SampleSize); + Result := Sqrt(Variance / SampleSize); +end; + +function SumFloatArray(const B: TDynFloatArray): Float; +var + I, N: Integer; +begin + Result := 0.0; + N := GetDynLength(B); + if N <> 0 then + begin + Result := B[0]; + for I := 1 to N - 1 do + Result := Result + B[I]; + end; +end; + +function SumSquareDiffFloatArray(const B: TDynFloatArray; Diff: Float): Float; +var + I, N: Integer; +begin + Result := 0.0; + N := GetDynLength(B); + if N <> 0 then + begin + Result := Sqr(B[0] - Diff); + for I := 1 to N - 1 do + Result := Result + Sqr(B[I] - Diff); + end; +end; + +function SumSquareFloatArray(const B: TDynFloatArray): Float; +var + I, N: Integer; +begin + Result := 0.0; + N := GetDynLength(B); + if N <> 0 then + begin + Result := Sqr(B[0]); + for I := 1 to N - 1 do + Result := Result + Sqr(B[I]); + end; +end; + +function SumPairProductFloatArray(const X, Y: TDynFloatArray): Float; +var + I, N: Integer; +begin + Result := 0.0; + N := Min(Length(X), Length(Y)); + if N <> 0 then + begin + Result := X[0] * Y[0]; + for I := 1 to N - 1 do + Result := Result + X[I] * Y[I]; + end; +end; + +function ChiSquare(const X: TDynFloatArray): Float; { TODO -cDoc : ChiSquare } +var + I, N: Integer; + Sum: Float; +begin + N := GetDynLengthNotNull(X); + Result := Sqr(X[0]); + Sum := X[0]; + for I := 1 to N - 1 do + begin + Result := Result + Sqr(X[I]); + Sum := Sum + X[I]; + end; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclStrHashMap.pas b/3rdParty/JCL/source/common/JclStrHashMap.pas new file mode 100644 index 00000000..627e11ec --- /dev/null +++ b/3rdParty/JCL/source/common/JclStrHashMap.pas @@ -0,0 +1,735 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclStrHashMap.pas. } +{ } +{ The Initial Developer of the Original Code is Barry Kelly. } +{ Portions created by Barry Kelly are Copyright (C) Barry Kelly. All rights reserved. } +{ } +{ Contributors: } +{ Barry Kelly, Robert Rossmair, Matthias Thoma, Petr Vones } +{ } +{**************************************************************************************************} +{ } +{ This unit contains a string-pointer associative map. It works by hashing the added strings using } +{ a passed-in traits object. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclStrHashMap; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclResources; + +type + EJclStringHashMapError = class(EJclError); + THashValue = Cardinal; + +type + TStringHashMapTraits = class(TObject) + public + function Hash(const S: string): Cardinal; virtual; abstract; + function Compare(const L, R: string): Integer; virtual; abstract; + end; + +function CaseSensitiveTraits: TStringHashMapTraits; +function CaseInsensitiveTraits: TStringHashMapTraits; + +type + PUserData = Pointer; + PData = Pointer; + + TIterateFunc = function(AUserData: PUserData; const AStr: string; var APtr: PData): Boolean; + TIterateMethod = function(AUserData: PUserData; const AStr: string; var APtr: PData): Boolean of object; + + PPHashNode = ^PHashNode; + PHashNode = ^THashNode; + THashNode = record + Str: string; + Ptr: Pointer; + Left: PHashNode; + Right: PHashNode; + end; + + { Internal iterate function pointer type used by the protected + TStringHashMap.NodeIterate method. } + TNodeIterateFunc = procedure(AUserData: Pointer; ANode: PPHashNode); + + PHashArray = ^THashArray; + THashArray = array [0..MaxInt div SizeOf(PHashNode) - 1] of PHashNode; + + TStringHashMap = class(TObject) + private + FHashSize: Cardinal; + FCount: Cardinal; + FList: PHashArray; + FLeftDelete: Boolean; + FTraits: TStringHashMapTraits; + function IterateNode(ANode: PHashNode; AUserData: PUserData; AIterateFunc: TIterateFunc): Boolean; + function IterateMethodNode(ANode: PHashNode; AUserData: PUserData; AIterateMethod: TIterateMethod): Boolean; + procedure NodeIterate(ANode: PPHashNode; AUserData: PUserData; AIterateFunc: TNodeIterateFunc); + procedure SetHashSize(AHashSize: Cardinal); + procedure DeleteNodes(var Q: PHashNode); + procedure DeleteNode(var Q: PHashNode); + protected + function FindNode(const S: string): PPHashNode; + function AllocNode: PHashNode; virtual; + procedure FreeNode(ANode: PHashNode); virtual; + function GetData(const S: string): PData; + procedure SetData(const S: string; P: PData); + public + constructor Create(ATraits: TStringHashMapTraits; AHashSize: Cardinal); + destructor Destroy; override; + procedure Add(const S: string; const P); + function Remove(const S: string): PData; + procedure RemoveData(const P); + procedure Iterate(AUserData: PUserData; AIterateFunc: TIterateFunc); + procedure IterateMethod(AUserData: PUserData; AIterateMethod: TIterateMethod); + function Has(const S: string): Boolean; + function Find(const S: string; var P): Boolean; + function FindData(const P; var S: string): Boolean; + procedure Clear; + property Count: Cardinal read FCount; + property Data[const S: string]: PData read GetData write SetData; default; + property Traits: TStringHashMapTraits read FTraits; + property HashSize: Cardinal read FHashSize write SetHashSize; + end; + +{ Str=case sensitive, text=case insensitive } + +function Iterate_FreeObjects(AUserData: PUserData; const AStr: string; var AData: PData): Boolean; +function Iterate_Dispose(AUserData: PUserData; const AStr: string; var AData: PData): Boolean; +function Iterate_FreeMem(AUserData: PUserData; const AStr: string; var AData: PData): Boolean; + +type + TCaseSensitiveTraits = class(TStringHashMapTraits) + public + function Hash(const S: string): Cardinal; override; + function Compare(const L, R: string): Integer; override; + end; + + TCaseInsensitiveTraits = class(TStringHashMapTraits) + public + function Hash(const S: string): Cardinal; override; + function Compare(const L, R: string): Integer; override; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + JclAlgorithms; + +// Case Sensitive & Insensitive Traits +function TCaseSensitiveTraits.Compare(const L, R: string): Integer; +begin + Result := CompareStr(L, R); +end; + +function TCaseSensitiveTraits.Hash(const S: string): Cardinal; +begin + Result := StrSimpleHashConvert(S); +end; + +function TCaseInsensitiveTraits.Compare(const L, R: string): Integer; +begin + Result := CompareText(L, R); +end; + +function TCaseInsensitiveTraits.Hash(const S: string): Cardinal; +begin + Result := StrSimpleHashConvertI(S); +end; + +var + GlobalCaseSensitiveTraits: TCaseSensitiveTraits; + +function CaseSensitiveTraits: TStringHashMapTraits; +begin + if GlobalCaseSensitiveTraits = nil then + GlobalCaseSensitiveTraits := TCaseSensitiveTraits.Create; + Result := GlobalCaseSensitiveTraits; +end; + +var + GlobalCaseInsensitiveTraits: TCaseInsensitiveTraits; + +function CaseInsensitiveTraits: TStringHashMapTraits; +begin + if GlobalCaseInsensitiveTraits = nil then + GlobalCaseInsensitiveTraits := TCaseInsensitiveTraits.Create; + Result := GlobalCaseInsensitiveTraits; +end; + +function Iterate_FreeObjects(AUserData: PUserData; const AStr: string; var AData: PData): Boolean; +begin + TObject(AData).Free; + AData := nil; + Result := True; +end; + +function Iterate_Dispose(AUserData: PUserData; const AStr: string; var AData: PData): Boolean; +begin + Dispose(AData); + AData := nil; + Result := True; +end; + +function Iterate_FreeMem(AUserData: PUserData; const AStr: string; var AData: PData): Boolean; +begin + FreeMem(AData); + AData := nil; + Result := True; +end; + +//=== { TStringHashMap } ===================================================== + +constructor TStringHashMap.Create(ATraits: TStringHashMapTraits; AHashSize: Cardinal); +begin + inherited Create; + Assert(ATraits <> nil, LoadResString(@RsStringHashMapNoTraits)); + SetHashSize(AHashSize); + FTraits := ATraits; +end; + +destructor TStringHashMap.Destroy; +begin + Clear; + SetHashSize(0); + inherited Destroy; +end; + +type + PPCollectNodeNode = ^PCollectNodeNode; + PCollectNodeNode = ^TCollectNodeNode; + TCollectNodeNode = record + Next: PCollectNodeNode; + Str: string; + Ptr: Pointer; + end; + + +procedure NodeIterate_CollectNodes(AUserData: PUserData; ANode: PPHashNode); +var + PPCnn: PPCollectNodeNode; + PCnn: PCollectNodeNode; +begin + PPCnn := PPCollectNodeNode(AUserData); + New(PCnn); + PCnn^.Next := PPCnn^; + PPCnn^ := PCnn; + + PCnn^.Str := ANode^^.Str; + PCnn^.Ptr := ANode^^.Ptr; +end; + +procedure TStringHashMap.SetHashSize(AHashSize: Cardinal); +var + CollectList: PCollectNodeNode; + + procedure CollectNodes; + var + I: Integer; + begin + CollectList := nil; + for I := 0 to FHashSize - 1 do + NodeIterate(@FList^[I], @CollectList, NodeIterate_CollectNodes); + end; + + procedure InsertNodes; + var + PCnn, Tmp: PCollectNodeNode; + begin + PCnn := CollectList; + while PCnn <> nil do + begin + Tmp := PCnn^.Next; + Add(PCnn^.Str, PCnn^.Ptr); + Dispose(PCnn); + PCnn := Tmp; + end; + end; + +begin + { 4 cases: + we are empty, and AHashSize = 0 --> nothing to do + we are full, and AHashSize = 0 --> straight empty + we are empty, and AHashSize > 0 --> straight allocation + we are full, and AHashSize > 0 --> rehash } + + if FHashSize = 0 then + begin + if AHashSize > 0 then + begin + GetMem(FList, AHashSize * SizeOf(FList^[0])); + FillChar(FList^, AHashSize * SizeOf(FList^[0]), 0); + FHashSize := AHashSize; + end; + end + else + begin + if AHashSize > 0 then + begin + { must rehash table } + CollectNodes; + Clear; + ReallocMem(FList, AHashSize * SizeOf(FList^[0])); + FillChar(FList^, AHashSize * SizeOf(FList^[0]), 0); + FHashSize := AHashSize; + InsertNodes; + end + else + begin + { we are clearing the table - need hash to be empty } + if FCount > 0 then + raise EJclStringHashMapError.CreateRes(@RsStringHashMapMustBeEmpty); + FreeMem(FList); + FList := nil; + FHashSize := 0; + end; + end; +end; + +function TStringHashMap.FindNode(const S: string): PPHashNode; +var + I: Cardinal; + R: Integer; + PPN: PPHashNode; +begin + { we start at the node offset by S in the hash list } + I := FTraits.Hash(S) mod FHashSize; + + PPN := @FList^[I]; + + if PPN^ <> nil then + while True do + begin + R := FTraits.Compare(S, PPN^^.Str); + + { left, then right, then match } + if R < 0 then + PPN := @PPN^^.Left + else + if R > 0 then + PPN := @PPN^^.Right + else + Break; + + { check for empty position after drilling left or right } + if PPN^ = nil then + Break; + end; + + Result := PPN; +end; + +function TStringHashMap.IterateNode(ANode: PHashNode; AUserData: Pointer; + AIterateFunc: TIterateFunc): Boolean; +begin + if ANode <> nil then + begin + Result := AIterateFunc(AUserData, ANode^.Str, ANode^.Ptr); + if not Result then + Exit; + + Result := IterateNode(ANode^.Left, AUserData, AIterateFunc); + if not Result then + Exit; + + Result := IterateNode(ANode^.Right, AUserData, AIterateFunc); + if not Result then + Exit; + end + else + Result := True; +end; + +function TStringHashMap.IterateMethodNode(ANode: PHashNode; AUserData: Pointer; + AIterateMethod: TIterateMethod): Boolean; +begin + if ANode <> nil then + begin + Result := AIterateMethod(AUserData, ANode^.Str, ANode^.Ptr); + if not Result then + Exit; + + Result := IterateMethodNode(ANode^.Left, AUserData, AIterateMethod); + if not Result then + Exit; + + Result := IterateMethodNode(ANode^.Right, AUserData, AIterateMethod); + if not Result then + Exit; + end + else + Result := True; +end; + +procedure TStringHashMap.NodeIterate(ANode: PPHashNode; AUserData: Pointer; + AIterateFunc: TNodeIterateFunc); +begin + if ANode^ <> nil then + begin + AIterateFunc(AUserData, ANode); + NodeIterate(@ANode^.Left, AUserData, AIterateFunc); + NodeIterate(@ANode^.Right, AUserData, AIterateFunc); + end; +end; + +procedure TStringHashMap.DeleteNode(var Q: PHashNode); +var + T, R, S: PHashNode; +begin + { we must delete node Q without destroying binary tree } + { Knuth 6.2.2 D (pg 432 Vol 3 2nd ed) } + + { alternating between left / right delete to preserve decent + performance over multiple insertion / deletion } + FLeftDelete := not FLeftDelete; + + { T will be the node we delete } + T := Q; + + if FLeftDelete then + begin + if T^.Right = nil then + Q := T^.Left + else + begin + R := T^.Right; + if R^.Left = nil then + begin + R^.Left := T^.Left; + Q := R; + end + else + begin + S := R^.Left; + if S^.Left <> nil then + repeat + R := S; + S := R^.Left; + until S^.Left = nil; + { now, S = symmetric successor of Q } + S^.Left := T^.Left; + R^.Left := S^.Right; + S^.Right := T^.Right; + Q := S; + end; + end; + end + else + begin + if T^.Left = nil then + Q := T^.Right + else + begin + R := T^.Left; + if R^.Right = nil then + begin + R^.Right := T^.Right; + Q := R; + end + else + begin + S := R^.Right; + if S^.Right <> nil then + repeat + R := S; + S := R^.Right; + until S^.Right = nil; + { now, S = symmetric predecessor of Q } + S^.Right := T^.Right; + R^.Right := S^.Left; + S^.Left := T^.Left; + Q := S; + end; + end; + end; + + { we decrement before because the tree is already adjusted + => any exception in FreeNode MUST be ignored. + + It's unlikely that FreeNode would raise an exception anyway. } + Dec(FCount); + FreeNode(T); +end; + +procedure TStringHashMap.DeleteNodes(var Q: PHashNode); +begin + if Q^.Left <> nil then + DeleteNodes(Q^.Left); + if Q^.Right <> nil then + DeleteNodes(Q^.Right); + FreeNode(Q); + Q := nil; +end; + +function TStringHashMap.AllocNode: PHashNode; +begin + New(Result); + Result^.Left := nil; + Result^.Right := nil; +end; + +procedure TStringHashMap.FreeNode(ANode: PHashNode); +begin + Dispose(ANode); +end; + +function TStringHashMap.GetData(const S: string): Pointer; +var + PPN: PPHashNode; +begin + PPN := FindNode(S); + + if PPN^ <> nil then + Result := PPN^^.Ptr + else + Result := nil; +end; + +procedure TStringHashMap.SetData(const S: string; P: Pointer); +var + PPN: PPHashNode; +begin + PPN := FindNode(S); + + if PPN^ <> nil then + PPN^^.Ptr := P + else + begin + { add } + PPN^ := AllocNode; + { we increment after in case of exception } + Inc(FCount); + PPN^^.Str := S; + PPN^^.Ptr := P; + end; +end; + +procedure TStringHashMap.Add(const S: string; const P{: Pointer}); +var + PPN: PPHashNode; +begin + PPN := FindNode(S); + + { if reordered from SetData because PPN^ = nil is more common for Add } + if PPN^ = nil then + begin + { add } + PPN^ := AllocNode; + { we increment after in case of exception } + Inc(FCount); + PPN^^.Str := S; + PPN^^.Ptr := Pointer(P); + end + else + raise EJclStringHashMapError.CreateResFmt(@RsStringHashMapDuplicate, [S]); +end; + +type + PListNode = ^TListNode; + TListNode = record + Next: PListNode; + NodeLoc: PPHashNode; + end; + + PDataParam = ^TDataParam; + TDataParam = record + Head: PListNode; + Data: Pointer; + end; + +procedure NodeIterate_BuildDataList(AUserData: Pointer; ANode: PPHashNode); +var + DP: PDataParam; + T: PListNode; +begin + DP := PDataParam(AUserData); + if DP.Data = ANode^^.Ptr then + begin + New(T); + T^.Next := DP.Head; + T^.NodeLoc := ANode; + DP.Head := T; + end; +end; + +procedure TStringHashMap.RemoveData(const P{: Pointer}); +var + DP: TDataParam; + I: Integer; + N, T: PListNode; +begin + DP.Data := Pointer(P); + DP.Head := nil; + + for I := 0 to FHashSize - 1 do + NodeIterate(@FList^[I], @DP, NodeIterate_BuildDataList); + + N := DP.Head; + while N <> nil do + begin + DeleteNode(N^.NodeLoc^); + T := N; + N := N^.Next; + Dispose(T); + end; +end; + +function TStringHashMap.Remove(const S: string): Pointer; +var + PPN: PPHashNode; +begin + PPN := FindNode(S); + + if PPN^ <> nil then + begin + Result := PPN^^.Ptr; + DeleteNode(PPN^); + end + else + raise EJclStringHashMapError.CreateResFmt(@RsStringHashMapInvalidNode, [S]); +end; + +procedure TStringHashMap.IterateMethod(AUserData: Pointer; + AIterateMethod: TIterateMethod); +var + I: Integer; +begin + for I := 0 to FHashSize - 1 do + if not IterateMethodNode(FList^[I], AUserData, AIterateMethod) then + Break; +end; + +procedure TStringHashMap.Iterate(AUserData: Pointer; AIterateFunc: TIterateFunc); +var + I: Integer; +begin + for I := 0 to FHashSize - 1 do + if not IterateNode(FList^[I], AUserData, AIterateFunc) then + Break; +end; + +function TStringHashMap.Has(const S: string): Boolean; +var + PPN: PPHashNode; +begin + PPN := FindNode(S); + Result := PPN^ <> nil; +end; + +function TStringHashMap.Find(const S: string; var P{: Pointer}): Boolean; +var + PPN: PPHashNode; +begin + PPN := FindNode(S); + Result := PPN^ <> nil; + if Result then + Pointer(P) := PPN^^.Ptr; +end; + +type + PFindDataResult = ^TFindDataResult; + TFindDataResult = record + Found: Boolean; + ValueToFind: Pointer; + Key: string; + end; + +function Iterate_FindData(AUserData: Pointer; const AStr: string; + var APtr: Pointer): Boolean; +var + PFdr: PFindDataResult; +begin + PFdr := PFindDataResult(AUserData); + PFdr^.Found := (APtr = PFdr^.ValueToFind); + Result := not PFdr^.Found; + if PFdr^.Found then + PFdr^.Key := AStr; +end; + +function TStringHashMap.FindData(const P{: Pointer}; var S: string): Boolean; +var + PFdr: PFindDataResult; +begin + New(PFdr); + try + PFdr^.Found := False; + PFdr^.ValueToFind := Pointer(P); + Iterate(PFdr, Iterate_FindData); + Result := PFdr^.Found; + if Result then + S := PFdr^.Key; + finally + Dispose(PFdr); + end; +end; + +procedure TStringHashMap.Clear; +var + I: Integer; + PPN: PPHashNode; +begin + for I := 0 to FHashSize - 1 do + begin + PPN := @FList^[I]; + if PPN^ <> nil then + DeleteNodes(PPN^); + end; + FCount := 0; +end; + +initialization + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + FreeAndNil(GlobalCaseInsensitiveTraits); + FreeAndNil(GlobalCaseSensitiveTraits); + +end. + diff --git a/3rdParty/JCL/source/common/JclStreams.pas b/3rdParty/JCL/source/common/JclStreams.pas index 01277379..268f9f4e 100644 --- a/3rdParty/JCL/source/common/JclStreams.pas +++ b/3rdParty/JCL/source/common/JclStreams.pas @@ -1,3129 +1,3129 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is JclStreams.pas. } -{ } -{ The Initial Developer of the Original Code is Robert Marquardt. Portions created by } -{ Robert Marquardt are Copyright (C) Robert Marquardt (robert_marquardt att gmx dott de) } -{ All rights reserved. } -{ } -{ Contributors: } -{ Florent Ouchet (outchy) } -{ Heinz Zastrau } -{ Andreas Schmidt } -{ } -{**************************************************************************************************} -{ } -{ Stream-related functions and classes } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -unit JclStreams; - -{$I jcl.inc} - -interface - -uses - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - {$IFDEF HAS_UNITSCOPE} - {$IFDEF MSWINDOWS} - Winapi.Windows, - {$ENDIF MSWINDOWS} - System.SysUtils, System.Classes, - System.Contnrs, - {$ELSE ~HAS_UNITSCOPE} - {$IFDEF MSWINDOWS} - Windows, - {$ENDIF MSWINDOWS} - SysUtils, Classes, - Contnrs, - {$ENDIF ~HAS_UNITSCOPE} - {$IFDEF HAS_UNIT_LIBC} - Libc, - {$ENDIF HAS_UNIT_LIBC} - JclBase, JclStringConversions; - -const - StreamDefaultBufferSize = 4096; - -type - EJclStreamError = class(EJclError); - - // abstraction layer to support Delphi 5 and C++Builder 5 streams - // 64 bit version of overloaded functions are introduced - TJclStream = class(TStream) - protected - procedure SetSize(NewSize: Longint); overload; override; - procedure SetSize(const NewSize: Int64); overload; override; - public - function Seek(Offset: Longint; Origin: Word): Longint; overload; override; - function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override; - procedure LoadFromStream(Source: TStream; BufferSize: Longint = StreamDefaultBufferSize); virtual; - procedure LoadFromFile(const FileName: TFileName; BufferSize: Longint = StreamDefaultBufferSize); virtual; - procedure SaveToStream(Dest: TStream; BufferSize: Longint = StreamDefaultBufferSize); virtual; - procedure SaveToFile(const FileName: TFileName; BufferSize: Longint = StreamDefaultBufferSize); virtual; - end; - - //=== VCL stream replacements === - - TJclHandleStream = class(TJclStream) - private - FHandle: THandle; - protected - procedure SetSize(const NewSize: Int64); override; - public - constructor Create(AHandle: THandle); - function Read(var Buffer; Count: Longint): Longint; override; - function Write(const Buffer; Count: Longint): Longint; override; - function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; - property Handle: THandle read FHandle; - end; - - TJclFileStream = class(TJclHandleStream) - public - constructor Create(const FileName: TFileName; Mode: Word; Rights: Cardinal = $666); - destructor Destroy; override; - end; - - { - TJclCustomMemoryStream = class(TJclStream) - end; - - TJclMemoryStream = class(TJclCustomMemoryStream) - end; - - TJclStringStream = class(TJclStream) - end; - - TJclResourceStream = class(TJclCustomMemoryStream) - end; - } - - //=== new stream ideas === - - TJclEmptyStream = class(TJclStream) - protected - procedure SetSize(const NewSize: Int64); override; - public - function Read(var Buffer; Count: Longint): Longint; override; - function Write(const Buffer; Count: Longint): Longint; override; - function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; - end; - - TJclNullStream = class(TJclStream) - private - FPosition: Int64; - FSize: Int64; - protected - procedure SetSize(const NewSize: Int64); override; - public - function Read(var Buffer; Count: Longint): Longint; override; - function Write(const Buffer; Count: Longint): Longint; override; - function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; - end; - - TJclRandomStream = class(TJclNullStream) - protected - function GetRandSeed: Longint; virtual; - procedure SetRandSeed(Seed: Longint); virtual; - public - function RandomData: Byte; virtual; - procedure Randomize; dynamic; - function Read(var Buffer; Count: Longint): Longint; override; - property RandSeed: Longint read GetRandSeed write SetRandSeed; - end; - - TJclMultiplexStream = class(TJclStream) - private - FStreams: TList; - FReadStreamIndex: Integer; - function GetStream(Index: Integer): TStream; - function GetCount: Integer; - procedure SetStream(Index: Integer; const Value: TStream); - function GetReadStream: TStream; - procedure SetReadStream(const Value: TStream); - procedure SetReadStreamIndex(const Value: Integer); - protected - procedure SetSize(const NewSize: Int64); override; - public - constructor Create; - destructor Destroy; override; - function Read(var Buffer; Count: Longint): Longint; override; - function Write(const Buffer; Count: Longint): Longint; override; - function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; - - function Add(NewStream: TStream): Integer; - procedure Clear; - function Remove(AStream: TStream): Integer; - procedure Delete(const Index: Integer); - - property Streams[Index: Integer]: TStream read GetStream write SetStream; - property ReadStreamIndex: Integer read FReadStreamIndex write SetReadStreamIndex; - property ReadStream: TStream read GetReadStream write SetReadStream; - property Count: Integer read GetCount; - end; - - TJclStreamDecorator = class(TJclStream) - private - FAfterStreamChange: TNotifyEvent; - FBeforeStreamChange: TNotifyEvent; - FOwnsStream: Boolean; - FStream: TStream; - procedure SetStream(Value: TStream); - protected - procedure DoAfterStreamChange; virtual; - procedure DoBeforeStreamChange; virtual; - procedure SetSize(const NewSize: Int64); override; - public - constructor Create(AStream: TStream; AOwnsStream: Boolean = False); - destructor Destroy; override; - function Read(var Buffer; Count: Longint): Longint; override; - function Write(const Buffer; Count: Longint): Longint; override; - function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; - property AfterStreamChange: TNotifyEvent read FAfterStreamChange write FAfterStreamChange; - property BeforeStreamChange: TNotifyEvent read FBeforeStreamChange write FBeforeStreamChange; - property OwnsStream: Boolean read FOwnsStream write FOwnsStream; - property Stream: TStream read FStream write SetStream; - end; - - TJclBufferedStream = class(TJclStreamDecorator) - protected - FBuffer: array of Byte; - FBufferCurrentSize: Longint; - FBufferMaxModifiedPos: Longint; - FBufferSize: Longint; - FBufferStart: Int64; // position of the first byte of the buffer in stream - FPosition: Int64; // current position in stream - function BufferHit: Boolean; - function GetCalcedSize: Int64; virtual; - function LoadBuffer: Boolean; virtual; - function ReadFromBuffer(var Buffer; Count, Start: Longint): Longint; - function WriteToBuffer(const Buffer; Count, Start: Longint): Longint; - protected - procedure DoAfterStreamChange; override; - procedure DoBeforeStreamChange; override; - procedure SetSize(const NewSize: Int64); override; - public - constructor Create(AStream: TStream; AOwnsStream: Boolean = False); - destructor Destroy; override; - procedure Flush; virtual; - function Read(var Buffer; Count: Longint): Longint; override; - function Write(const Buffer; Count: Longint): Longint; override; - function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; - property BufferSize: Longint read FBufferSize write FBufferSize; - end; - - TStreamNotifyEvent = procedure(Sender: TObject; Position: Int64; Size: Int64) of object; - - TJclEventStream = class(TJclStreamDecorator) - private - FNotification: TStreamNotifyEvent; - procedure DoNotification; - protected - procedure DoBeforeStreamChange; override; - procedure DoAfterStreamChange; override; - procedure SetSize(const NewSize: Int64); override; - public - constructor Create(AStream: TStream; ANotification: TStreamNotifyEvent = nil; - AOwnsStream: Boolean = False); - function Read(var Buffer; Count: Longint): Longint; override; - function Write(const Buffer; Count: Longint): Longint; override; - function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; - property OnNotification: TStreamNotifyEvent read FNotification write FNotification; - end; - - TJclEasyStream = class(TJclStreamDecorator) - public - function IsEqual(Stream: TStream): Boolean; - function ReadBoolean: Boolean; - function ReadChar: Char; - function ReadAnsiChar: AnsiChar; - function ReadWideChar: WideChar; - function ReadByte: Byte; - function ReadCurrency: Currency; - function ReadDateTime: TDateTime; - function ReadExtended: Extended; - function ReadDouble: Double; - function ReadInt64: Int64; - function ReadInteger: Integer; - function ReadCString: string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} - function ReadCAnsiString: AnsiString; - function ReadCWideString: WideString; - function ReadShortString: string; - function ReadSingle: Single; - function ReadSizedString: string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} - function ReadSizedAnsiString: AnsiString; - function ReadSizedWideString: WideString; - procedure WriteBoolean(Value: Boolean); - procedure WriteChar(Value: Char); - procedure WriteAnsiChar(Value: AnsiChar); - procedure WriteWideChar(Value: WideChar); - procedure WriteByte(Value: Byte); - procedure WriteCurrency(const Value: Currency); - procedure WriteDateTime(const Value: TDateTime); - procedure WriteExtended(const Value: Extended); - procedure WriteDouble(const Value: Double); - procedure WriteInt64(Value: Int64); overload; - procedure WriteInteger(Value: Integer); overload; - procedure WriteCString(const Value: string); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} - procedure WriteCAnsiString(const Value: AnsiString); - procedure WriteCWideString(const Value: WideString); - // use WriteCString - procedure WriteShortString(const Value: ShortString); - procedure WriteSingle(const Value: Single); - procedure WriteSizedString(const Value: string); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} - procedure WriteSizedAnsiString(const Value: AnsiString); - procedure WriteSizedWideString(const Value: WideString); - end; - - TJclScopedStream = class(TJclStream) - private - FParentStream: TStream; - FStartPos: Int64; - FCurrentPos: Int64; - FMaxSize: Int64; - protected - procedure SetSize(const NewSize: Int64); override; - public - // scopedstream starting at the current position of the ParentStream - // if MaxSize is positive or null, read and write operations cannot overrun this size or the ParentStream limitation - // if MaxSize is negative, read and write operations are unlimited (up to the ParentStream limitation) - constructor Create(AParentStream: TStream; const AMaxSize: Int64 = -1); overload; - constructor Create(AParentStream: TStream; const AStartPos, AMaxSize: Int64); overload; - function Read(var Buffer; Count: Longint): Longint; override; - function Write(const Buffer; Count: Longint): Longint; override; - function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; - - property ParentStream: TStream read FParentStream; - property StartPos: Int64 read FStartPos; - property MaxSize: Int64 read FMaxSize write FMaxSize; - end; - - TJclStreamSeekEvent = function(Sender: TObject; const Offset: Int64; - Origin: TSeekOrigin): Int64 of object; - TJclStreamReadEvent = function(Sender: TObject; var Buffer; Count: Longint): Longint of object; - TJclStreamWriteEvent = function(Sender: TObject; const Buffer;Count: Longint): Longint of object; - TJclStreamSizeEvent = procedure(Sender: TObject; const NewSize: Int64) of object; - - TJclDelegatedStream = class(TJclStream) - private - FOnSeek: TJclStreamSeekEvent; - FOnRead: TJclStreamReadEvent; - FOnWrite: TJclStreamWriteEvent; - FOnSize: TJclStreamSizeEvent; - protected - procedure SetSize(const NewSize: Int64); override; - public - function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; - function Read(var Buffer; Count: Longint): Longint; override; - function Write(const Buffer; Count: Longint): Longint; override; - property OnSeek: TJclStreamSeekEvent read FOnSeek write FOnSeek; - property OnRead: TJclStreamReadEvent read FOnRead write FOnRead; - property OnWrite: TJclStreamWriteEvent read FOnWrite write FOnWrite; - property OnSize: TJclStreamSizeEvent read FOnSize write FOnSize; - end; - - // ancestor classes for streams with checksums and encrypted streams - // data are stored in sectors: each BufferSize-d buffer is followed by FSectorOverHead bytes - // containing the checksum. In case of an encrypted stream, there is no byte - // but sector is encrypted - - // reusing some code from TJclBufferedStream - TJclSectoredStream = class(TJclBufferedStream) - protected - FSectorOverHead: Longint; - function FlatToSectored(const Position: Int64): Int64; - function SectoredToFlat(const Position: Int64): Int64; - function GetCalcedSize: Int64; override; - function LoadBuffer: Boolean; override; - procedure DoAfterStreamChange; override; - procedure AfterBlockRead; virtual; // override to check protection - procedure BeforeBlockWrite; virtual; // override to compute protection - procedure SetSize(const NewSize: Int64); override; - public - constructor Create(AStorageStream: TStream; AOwnsStream: Boolean = False; - ASectorOverHead: Longint = 0); - - procedure Flush; override; - end; - - TJclCRC16Stream = class(TJclSectoredStream) - protected - procedure AfterBlockRead; override; - procedure BeforeBlockWrite; override; - public - constructor Create(AStorageStream: TStream; AOwnsStream: Boolean = False); - end; - - TJclCRC32Stream = class(TJclSectoredStream) - protected - procedure AfterBlockRead; override; - procedure BeforeBlockWrite; override; - public - constructor Create(AStorageStream: TStream; AOwnsStream: Boolean = False); - end; - - {$IFDEF COMPILER7_UP} - {$DEFINE SIZE64} - {$ENDIF ~COMPILER7_UP} - {$IFDEF FPC} - {$DEFINE SIZE64} - {$ENDIF FPC} - TJclSplitStream = class(TJclStream) - private - FVolume: TStream; - FVolumeIndex: Integer; - FVolumeMaxSize: Int64; - FPosition: Int64; - FVolumePosition: Int64; - FForcePosition: Boolean; - protected - function GetVolume(Index: Integer): TStream; virtual; abstract; - function GetVolumeMaxSize(Index: Integer): Int64; virtual; abstract; - function GetSize: Int64; {$IFDEF SIZE64}override;{$ENDIF SIZE64} - procedure SetSize(const NewSize: Int64); override; - function InternalLoadVolume(Index: Integer): Boolean; - public - constructor Create(AForcePosition: Boolean = False); - - function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; - function Read(var Buffer; Count: Longint): Longint; override; - function Write(const Buffer; Count: Longint): Longint; override; - - property ForcePosition: Boolean read FForcePosition write FForcePosition; - end; - - TJclVolumeEvent = function(Index: Integer): TStream of object; - TJclVolumeMaxSizeEvent = function(Index: Integer): Int64 of object; - - TJclDynamicSplitStream = class(TJclSplitStream) - private - FOnVolume: TJclVolumeEvent; - FOnVolumeMaxSize: TJclVolumeMaxSizeEvent; - protected - function GetVolume(Index: Integer): TStream; override; - function GetVolumeMaxSize(Index: Integer): Int64; override; - public - property OnVolume: TJclVolumeEvent read FOnVolume write FOnVolume; - property OnVolumeMaxSize: TJclVolumeMaxSizeEvent read FOnVolumeMaxSize - write FOnVolumeMaxSize; - end; - - TJclSplitVolume = class - public - MaxSize: Int64; - Stream: TStream; - OwnStream: Boolean; - end; - - TJclStaticSplitStream = class(TJclSplitStream) - private - FVolumes: TObjectList; - function GetVolumeCount: Integer; - protected - function GetVolume(Index: Integer): TStream; override; - function GetVolumeMaxSize(Index: Integer): Int64; override; - public - constructor Create(AForcePosition: Boolean = False); - destructor Destroy; override; - - function AddVolume(AStream: TStream; AMaxSize: Int64 = 0; - AOwnStream: Boolean = False): Integer; - - property VolumeCount: Integer read GetVolumeCount; - property Volumes[Index: Integer]: TStream read GetVolume; - property VolumeMaxSizes[Index: Integer]: Int64 read GetVolumeMaxSize; - end; - - TJclStringStream = class - protected - FStream: TStream; - FOwnStream: Boolean; - FBOM: array of Byte; - FBufferSize: SizeInt; - FStrPosition: Int64; // current position in characters - FStrBuffer: TUCS4Array; // buffer for read/write operations - FStrBufferPosition: Int64; // position of the first character of the read/write buffer - FStrBufferCurrentSize: Int64; // numbers of characters available in str buffer - FStrBufferModifiedSize: Int64; // numbers of characters modified in str buffer - FStrBufferStart: Int64; // position of the first byte of the read/write buffer in stream - FStrBufferNext: Int64; // position of the next character following the read/write buffer in stream - FStrPeekPosition: Int64; // current peek position in characters - FStrPeekBuffer: TUCS4Array; // buffer for peek operations - FStrPeekBufferPosition: Int64; // index of the first character of the peek buffer - FStrPeekBufferCurrentSize: SizeInt; // numbers of characters available in peek buffer - FStrPeekBufferStart: Int64; // position of the first byte of the peek buffer in stream - FStrPeekBufferNext: Int64; // position of the next character following the peek buffer in stream - function LoadBuffer: Boolean; - function LoadPeekBuffer: Boolean; - function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; virtual; abstract; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; virtual; - function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; virtual; abstract; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; virtual; - procedure InvalidateBuffers; - public - constructor Create(AStream: TStream; AOwnsStream: Boolean = False); virtual; - destructor Destroy; override; - procedure Flush; virtual; - function ReadString(var Buffer: string; Start, Count: Longint): Longint; overload; - function ReadString(BufferSize: Longint = StreamDefaultBufferSize): string; overload; - function ReadAnsiString(var Buffer: AnsiString; Start, Count: Longint): Longint; overload; - function ReadAnsiString(BufferSize: Longint = StreamDefaultBufferSize): AnsiString; overload; - function ReadWideString(var Buffer: WideString; Start, Count: Longint): Longint; overload; - function ReadWideString(BufferSize: Longint = StreamDefaultBufferSize): WideString; overload; - function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; virtual; - function WriteString(const Buffer: string; Start, Count: Longint): Longint; - function WriteAnsiString(const Buffer: AnsiString; Start, Count: Longint): Longint; - function WriteWideString(const Buffer: WideString; Start, Count: Longint): Longint; - function PeekChar(out Buffer: Char): Boolean; - function PeekAnsiChar(out Buffer: AnsiChar): Boolean; - function PeekUCS4(out Buffer: UCS4): Boolean; - function PeekWideChar(out Buffer: WideChar): Boolean; - function ReadChar(out Buffer: Char): Boolean; - function ReadAnsiChar(out Buffer: AnsiChar): Boolean; - function ReadUCS4(out Buffer: UCS4): Boolean; - function ReadWideChar(out Buffer: WideChar): Boolean; - function WriteChar(Value: Char): Boolean; - function WriteAnsiChar(Value: AnsiChar): Boolean; - function WriteUCS4(Value: UCS4): Boolean; - function WriteWideChar(Value: WideChar): Boolean; - function SkipBOM: LongInt; virtual; - function WriteBOM: Longint; virtual; - property BufferSize: SizeInt read FBufferSize write FBufferSize; - property PeekPosition: Int64 read FStrPeekPosition; - property Position: Int64 read FStrPosition; - property Stream: TStream read FStream; - property OwnStream: Boolean read FOwnStream; - end; - - TJclStringStreamClass = class of TJclStringStream; - - TJclAnsiStream = class(TJclStringStream) - private - FCodePage: Word; - protected - function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; - function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; - public - constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; - property CodePage: Word read FCodePage write FCodePage; - end; - - TJclUTF8Stream = class(TJclStringStream) - protected - function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; - function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; - public - constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; - end; - - TJclUTF16Stream = class(TJclStringStream) - protected - function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; - function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; - public - constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; - end; - - TJclStringEncoding = (seAnsi, seUTF8, seUTF16, seAuto); - - TJclAutoStream = class(TJclStringStream) - private - FCodePage: Word; - FEncoding: TJclStringEncoding; - procedure SetCodePage(Value: Word); - protected - function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override; - function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; - function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override; - function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; - public - constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; - function SkipBOM: LongInt; override; - property CodePage: Word read FCodePage write SetCodePage; - property Encoding: TJclStringEncoding read FEncoding; - end; - -// buffered copy of all available bytes from Source to Dest -// returns the number of bytes that were copied -function StreamCopy(Source: TStream; Dest: TStream; BufferSize: Longint = StreamDefaultBufferSize): Int64; - -// buffered copy of all available characters from Source to Dest -// retuns the number of characters (in specified encoding) that were copied -function StringStreamCopy(Source, Dest: TJclStringStream; BufferLength: Longint = StreamDefaultBufferSize): Int64; -function AnsiStringStreamCopy(Source, Dest: TJclStringStream; BufferLength: Longint = StreamDefaultBufferSize): Int64; -function WideStringStreamCopy(Source, Dest: TJclStringStream; BufferLength: Longint = StreamDefaultBufferSize): Int64; - -// compares 2 streams for differencies -function CompareStreams(A, B : TStream; BufferSize: Longint = StreamDefaultBufferSize): Boolean; -// compares 2 files for differencies (calling CompareStreams) -function CompareFiles(const FileA, FileB: TFileName; BufferSize: Longint = StreamDefaultBufferSize): Boolean; - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\common'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -uses - {$IFDEF HAS_UNITSCOPE} - System.Types, - {$ENDIF HAS_UNITSCOPE} - JclResources, - JclCharsets, - JclMath, - JclSysUtils; - -function StreamCopy(Source: TStream; Dest: TStream; BufferSize: Longint): Int64; -var - Buffer: array of Byte; - ByteCount: Longint; -begin - Result := 0; - SetLength(Buffer, BufferSize); - repeat - ByteCount := Source.Read(Buffer[0], BufferSize); - Result := Result + ByteCount; - Dest.WriteBuffer(Buffer[0], ByteCount); - until ByteCount < BufferSize; -end; - -function StringStreamCopy(Source, Dest: TJclStringStream; BufferLength: Longint): Int64; -var - Buffer: string; - CharCount: Longint; -begin - Result := 0; - SetLength(Buffer, BufferLength); - repeat - CharCount := Source.ReadString(Buffer, 1, BufferLength); - Result := Result + CharCount; - CharCount := Dest.WriteString(Buffer, 1, CharCount); - until CharCount = 0; -end; - -function AnsiStringStreamCopy(Source, Dest: TJclStringStream; BufferLength: Longint): Int64; -var - Buffer: AnsiString; - CharCount: Longint; -begin - Result := 0; - SetLength(Buffer, BufferLength); - repeat - CharCount := Source.ReadAnsiString(Buffer, 1, BufferLength); - Result := Result + CharCount; - CharCount := Dest.WriteAnsiString(Buffer, 1, CharCount); - until CharCount = 0; -end; - -function WideStringStreamCopy(Source, Dest: TJclStringStream; BufferLength: Longint): Int64; -var - Buffer: WideString; - CharCount: Longint; -begin - Result := 0; - SetLength(Buffer, BufferLength); - repeat - CharCount := Source.ReadWideString(Buffer, 1, BufferLength); - Result := Result + CharCount; - CharCount := Dest.WriteWideString(Buffer, 1, CharCount); - until CharCount = 0; -end; - -function CompareStreams(A, B : TStream; BufferSize: Longint): Boolean; -var - BufferA, BufferB: array of Byte; - ByteCountA, ByteCountB: Longint; -begin - SetLength(BufferA, BufferSize); - try - SetLength(BufferB, BufferSize); - try - repeat - ByteCountA := A.Read(BufferA[0], BufferSize); - ByteCountB := B.Read(BufferB[0], BufferSize); - - Result := (ByteCountA = ByteCountB); - Result := Result and CompareMem(BufferA, BufferB, ByteCountA); - until (ByteCountA <> BufferSize) or (ByteCountB <> BufferSize) or not Result; - finally - SetLength(BufferB, 0); - end; - finally - SetLength(BufferA, 0); - end; -end; - -function CompareFiles(const FileA, FileB: TFileName; BufferSize: Longint): Boolean; -var - A, B: TStream; -begin - A := TFileStream.Create(FileA, fmOpenRead or fmShareDenyWrite); - try - B := TFileStream.Create(FileB, fmOpenRead or fmShareDenyWrite); - try - Result := CompareStreams(A, B, BufferSize); - finally - B.Free; - end; - finally - A.Free; - end; -end; - -//=== { TJclStream } ========================================================= - -function TJclStream.Seek(Offset: Longint; Origin: Word): Longint; -var - Result64: Int64; -begin - case Origin of - soFromBeginning: - Result64 := Seek(Int64(Offset), soBeginning); - soFromCurrent: - Result64 := Seek(Int64(Offset), soCurrent); - soFromEnd: - Result64 := Seek(Int64(Offset), soEnd); - else - Result64 := -1; - end; - if (Result64 < 0) or (Result64 > High(Longint)) then - Result64 := -1; - Result := Result64; -end; - -procedure TJclStream.LoadFromFile(const FileName: TFileName; - BufferSize: Integer); -var - FS: TStream; -begin - FS := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); - try - LoadFromStream(FS, BufferSize); - finally - FS.Free; - end; -end; - -procedure TJclStream.LoadFromStream(Source: TStream; BufferSize: Integer); -begin - StreamCopy(Source, Self, BufferSize); -end; - -procedure TJclStream.SaveToFile(const FileName: TFileName; BufferSize: Integer); -var - FS: TStream; -begin - FS := TFileStream.Create(FileName, fmCreate); - try - SaveToStream(FS, BufferSize); - finally - FS.Free; - end; -end; - -procedure TJclStream.SaveToStream(Dest: TStream; BufferSize: Integer); -begin - StreamCopy(Self, Dest, BufferSize); -end; - -function TJclStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; -begin - // override to customize - Result := -1; -end; - -procedure TJclStream.SetSize(NewSize: Longint); -begin - SetSize(Int64(NewSize)); -end; - -procedure TJclStream.SetSize(const NewSize: Int64); -begin - // override to customize -end; - -//=== { TJclHandleStream } =================================================== - -constructor TJclHandleStream.Create(AHandle: THandle); -begin - inherited Create; - FHandle := AHandle; -end; - -function TJclHandleStream.Read(var Buffer; Count: Longint): Longint; -begin - Result := 0; - {$IFDEF MSWINDOWS} - if (Count <= 0) or not ReadFile(Handle, Buffer, DWORD(Count), DWORD(Result), nil) then - Result := 0; - {$ENDIF MSWINDOWS} - {$IFDEF LINUX} - Result := __read(Handle, Buffer, Count); - {$ENDIF LINUX} -end; - -function TJclHandleStream.Write(const Buffer; Count: Longint): Longint; -begin - Result := 0; - {$IFDEF MSWINDOWS} - if (Count <= 0) or not WriteFile(Handle, Buffer, DWORD(Count), DWORD(Result), nil) then - Result := 0; - {$ENDIF MSWINDOWS} - {$IFDEF LINUX} - Result := __write(Handle, Buffer, Count); - {$ENDIF LINUX} -end; - -{$IFDEF MSWINDOWS} -function TJclHandleStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; -const - INVALID_SET_FILE_POINTER = -1; -type - TLarge = record - case Boolean of - False: - (OffsetLo: Longint; - OffsetHi: Longint); - True: - (Offset64: Int64); - end; -var - Offs: TLarge; -begin - Offs.Offset64 := Offset; - Offs.OffsetLo := SetFilePointer(Handle, Offs.OffsetLo, @Offs.OffsetHi, Ord(Origin)); - if (Offs.OffsetLo = INVALID_SET_FILE_POINTER) and (GetLastError <> NO_ERROR) then - Result := -1 - else - Result := Offs.Offset64; -end; -{$ENDIF MSWINDOWS} -{$IFDEF LINUX} -function TJclHandleStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; -const - SeekOrigins: array [TSeekOrigin] of Cardinal = ( SEEK_SET {soBeginning}, SEEK_CUR {soCurrent}, SEEK_END {soEnd} ); -begin - Result := lseek(Handle, Offset, SeekOrigins[Origin]); -end; -{$ENDIF LINUX} - -procedure TJclHandleStream.SetSize(const NewSize: Int64); -begin - Seek(NewSize, soBeginning); - {$IFDEF MSWINDOWS} - if not SetEndOfFile(Handle) then - RaiseLastOSError; - {$ENDIF MSWINDOWS} - {$IFDEF LINUX} - if ftruncate(Handle, Position) = -1 then - raise EJclStreamError.CreateRes(@RsStreamsSetSizeError); - {$ENDIF LINUX} -end; - -//=== { TJclFileStream } ===================================================== - -constructor TJclFileStream.Create(const FileName: TFileName; Mode: Word; Rights: Cardinal); -var - H: THandle; -{$IFDEF LINUX} -const - INVALID_HANDLE_VALUE = -1; -{$ENDIF LINUX} -begin - if Mode = fmCreate then - begin - {$IFDEF LINUX} - H := open(PChar(FileName), O_CREAT or O_RDWR, Rights); - {$ENDIF LINUX} - {$IFDEF MSWINDOWS} - H := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE, - 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); - {$ENDIF MSWINDOWS} - inherited Create(H); - if Handle = INVALID_HANDLE_VALUE then - raise EJclStreamError.CreateResFmt(@RsStreamsCreateError, [FileName]); - end - else - begin - H := THandle(FileOpen(FileName, Mode)); - inherited Create(H); - if Handle = INVALID_HANDLE_VALUE then - raise EJclStreamError.CreateResFmt(@RsStreamsOpenError, [FileName]); - end; -end; - -destructor TJclFileStream.Destroy; -begin - {$IFDEF MSWINDOWS} - if Handle <> INVALID_HANDLE_VALUE then - CloseHandle(Handle); - {$ENDIF MSWINDOWS} - {$IFDEF LINUX} - __close(Handle); - {$ENDIF LINUX} - inherited Destroy; -end; - -//=== { TJclEmptyStream } ==================================================== - -// a stream which stays empty no matter what you do -// so it is a Unix /dev/null equivalent - -procedure TJclEmptyStream.SetSize(const NewSize: Int64); -begin - // nothing -end; - -function TJclEmptyStream.Read(var Buffer; Count: Longint): Longint; -begin - // you cannot read anything - Result := 0; -end; - -function TJclEmptyStream.Write(const Buffer; Count: Longint): Longint; -begin - // you cannot write anything - Result := 0; -end; - -function TJclEmptyStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; -begin - if Offset <> 0 then - // seeking to anywhere except the position 0 is an error - Result := -1 - else - Result := 0; -end; - -//=== { TJclNullStream } ===================================================== - -// a stream which only keeps position and size, but no data -// so it is a Unix /dev/zero equivalent (?) - -procedure TJclNullStream.SetSize(const NewSize: Int64); -begin - if NewSize > 0 then - FSize := NewSize - else - FSize := 0; - if FPosition > FSize then - FPosition := FSize; -end; - -function TJclNullStream.Read(var Buffer; Count: Longint): Longint; -begin - if Count < 0 then - Count := 0; - // FPosition > FSize is possible! - if FSize - FPosition < Count then - Count := FSize - FPosition; - // does not read if beyond EOF - if Count > 0 then - begin - ResetMemory(Buffer, Count); - FPosition := FPosition + Count; - end; - Result := Count; -end; - -function TJclNullStream.Write(const Buffer; Count: Longint): Longint; -begin - if Count < 0 then - Count := 0; - FPosition := FPosition + Count; - // writing when FPosition > FSize is possible! - if FPosition > FSize then - FSize := FPosition; - Result := Count; -end; - -function TJclNullStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; -var - Rel: Int64; -begin - case Origin of - soBeginning: - Rel := 0; - soCurrent: - Rel := FPosition; - soEnd: - Rel := FSize; - else - // force Rel + Offset = -1 (code is never reached) - Rel := Offset - 1; - end; - if Rel + Offset >= 0 then - begin - // all non-negative destination positions including beyond EOF are valid - FPosition := Rel + Offset; - Result := FPosition; - end - else - Result := -1; -end; - -//=== { TJclRandomStream } =================================================== - -// A TJclNullStream decendant which returns random data when read -// so it is a Unix /dev/random equivalent - -function TJclRandomStream.GetRandSeed: Longint; -begin - Result := System.RandSeed; -end; - -procedure TJclRandomStream.SetRandSeed(Seed: Longint); -begin - System.RandSeed := Seed; -end; - -function TJclRandomStream.RandomData: Byte; -begin - Result := System.Random(256); -end; - -procedure TJclRandomStream.Randomize; -begin - System.Randomize; -end; - -function TJclRandomStream.Read(var Buffer; Count: Longint): Longint; -var - I: Longint; - BufferPtr: PByte; -begin - // this handles all necessary checks - Count := inherited Read(Buffer, Count); - BufferPtr := @Buffer; - for I := 0 to Count - 1 do - begin - BufferPtr^ := RandomData; - Inc(BufferPtr); - end; - Result := Count; -end; - -//=== { TJclMultiplexStream } ================================================ - -constructor TJclMultiplexStream.Create; -begin - inherited Create; - FStreams := TList.Create; - FReadStreamIndex := -1; -end; - -destructor TJclMultiplexStream.Destroy; -begin - FStreams.Free; - inherited Destroy; -end; - -function TJclMultiplexStream.Add(NewStream: TStream): Integer; -begin - Result := FStreams.Add(Pointer(NewStream)); -end; - -procedure TJclMultiplexStream.Clear; -begin - FStreams.Clear; - FReadStreamIndex := -1; -end; - -procedure TJclMultiplexStream.Delete(const Index: Integer); -begin - FStreams.Delete(Index); - if ReadStreamIndex = Index then - FReadStreamIndex := -1 - else - if ReadStreamIndex > Index then - Dec(FReadStreamIndex); -end; - -function TJclMultiplexStream.GetReadStream: TStream; -begin - if FReadStreamIndex >= 0 then - Result := TStream(FStreams.Items[FReadStreamIndex]) - else - Result := nil; -end; - -function TJclMultiplexStream.GetStream(Index: Integer): TStream; -begin - Result := TStream(FStreams.Items[Index]); -end; - -function TJclMultiplexStream.GetCount: Integer; -begin - Result := FStreams.Count; -end; - -function TJclMultiplexStream.Read(var Buffer; Count: Longint): Longint; -var - Stream: TStream; -begin - Stream := ReadStream; - if Assigned(Stream) then - Result := Stream.Read(Buffer, Count) - else - Result := 0; -end; - -function TJclMultiplexStream.Remove(AStream: TStream): Integer; -begin - Result := FStreams.Remove(Pointer(AStream)); - if FReadStreamIndex = Result then - FReadStreamIndex := -1 - else - if FReadStreamIndex > Result then - Dec(FReadStreamIndex); -end; - -function TJclMultiplexStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; -begin - // what should this function do? - Result := -1; -end; - -procedure TJclMultiplexStream.SetReadStream(const Value: TStream); -begin - FReadStreamIndex := FStreams.IndexOf(Pointer(Value)); -end; - -procedure TJclMultiplexStream.SetReadStreamIndex(const Value: Integer); -begin - FReadStreamIndex := Value; -end; - -procedure TJclMultiplexStream.SetSize(const NewSize: Int64); -begin - // what should this function do? -end; - -procedure TJclMultiplexStream.SetStream(Index: Integer; const Value: TStream); -begin - FStreams.Items[Index] := Pointer(Value); -end; - -function TJclMultiplexStream.Write(const Buffer; Count: Longint): Longint; -var - Index: Integer; - ByteWritten, MinByteWritten: Longint; -begin - MinByteWritten := Count; - for Index := 0 to Self.Count - 1 do - begin - ByteWritten := TStream(FStreams.Items[Index]).Write(Buffer, Count); - if ByteWritten < MinByteWritten then - MinByteWritten := ByteWritten; - end; - Result := MinByteWritten; -end; - -//=== { TJclStreamDecorator } ================================================ - -constructor TJclStreamDecorator.Create(AStream: TStream; AOwnsStream: Boolean = False); -begin - inherited Create; - FStream := AStream; - FOwnsStream := AOwnsStream; -end; - -destructor TJclStreamDecorator.Destroy; -begin - if OwnsStream then - FStream.Free; - inherited Destroy; -end; - -procedure TJclStreamDecorator.DoAfterStreamChange; -begin - if Assigned(FAfterStreamChange) then - FAfterStreamChange(Self); -end; - -procedure TJclStreamDecorator.DoBeforeStreamChange; -begin - if Assigned(FBeforeStreamChange) then - FBeforeStreamChange(Self); -end; - -function TJclStreamDecorator.Read(var Buffer; Count: Longint): Longint; -begin - if Assigned(FStream) then - Result := Stream.Read(Buffer, Count) - else - Result := 0; -end; - -function TJclStreamDecorator.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; -begin - Result := Stream.Seek(Offset, Origin); -end; - -procedure TJclStreamDecorator.SetSize(const NewSize: Int64); -begin - if Assigned(FStream) then - Stream.Size := NewSize; -end; - -procedure TJclStreamDecorator.SetStream(Value: TStream); -begin - if Value <> FStream then - try - DoBeforeStreamChange; - finally - if OwnsStream then - FStream.Free; - FStream := Value; - DoAfterStreamChange; - end; -end; - -function TJclStreamDecorator.Write(const Buffer; Count: Longint): Longint; -begin - if Assigned(FStream) then - Result := Stream.Write(Buffer, Count) - else - Result := 0; -end; - -//=== { TJclBufferedStream } ================================================= - -constructor TJclBufferedStream.Create(AStream: TStream; AOwnsStream: Boolean = False); -begin - inherited Create(AStream, AOwnsStream); - if Stream <> nil then - FPosition := Stream.Position; - BufferSize := StreamDefaultBufferSize; - LoadBuffer; -end; - -destructor TJclBufferedStream.Destroy; -begin - Flush; - inherited Destroy; -end; - -function TJclBufferedStream.BufferHit: Boolean; -begin - Result := (FBufferStart <= FPosition) and (FPosition < (FBufferStart + FBufferCurrentSize)); -end; - -procedure TJclBufferedStream.DoAfterStreamChange; -begin - inherited DoAfterStreamChange; - FBufferCurrentSize := 0; // invalidate buffer after stream is changed - FBufferStart := 0; - if Stream <> nil then - FPosition := Stream.Position; -end; - -procedure TJclBufferedStream.DoBeforeStreamChange; -begin - inherited DoBeforeStreamChange; - Flush; -end; - -procedure TJclBufferedStream.Flush; -begin - if (Stream <> nil) and (FBufferMaxModifiedPos > 0) then - begin - Stream.Position := FBufferStart; - Stream.WriteBuffer(FBuffer[0], FBufferMaxModifiedPos); - FBufferMaxModifiedPos := 0; - end; -end; - -function TJclBufferedStream.GetCalcedSize: Int64; -begin - if Assigned(Stream) then - Result := Stream.Size - else - Result := 0; - if Result < FBufferMaxModifiedPos + FBufferStart then - Result := FBufferMaxModifiedPos + FBufferStart; -end; - -function TJclBufferedStream.LoadBuffer: Boolean; -begin - Flush; - if Length(FBuffer) <> FBufferSize then - SetLength(FBuffer, FBufferSize); - if Stream <> nil then - begin - Stream.Position := FPosition; - FBufferCurrentSize := Stream.Read(FBuffer[0], FBufferSize); - end - else - FBufferCurrentSize := 0; - FBufferStart := FPosition; - Result := (FBufferCurrentSize > 0); -end; - -function TJclBufferedStream.Read(var Buffer; Count: Longint): Longint; -const - Offset = 0; -begin - Result := Count + Offset; - while Count > 0 do - begin - if not BufferHit then - if not LoadBuffer then - Break; - Dec(Count, ReadFromBuffer(Buffer, Count, Result - Count)); - end; - Result := Result - Count - Offset; -end; - -function TJclBufferedStream.ReadFromBuffer(var Buffer; Count, Start: Longint): Longint; -var - BufPos: Longint; - P: PAnsiChar; -begin - Result := Count; - BufPos := FPosition - FBufferStart; - if Result > FBufferCurrentSize - BufPos then - Result := FBufferCurrentSize - BufPos; - P := @Buffer; - Move(FBuffer[BufPos], P[Start], Result); - Inc(FPosition, Result); -end; - -function TJclBufferedStream.Seek(const Offset: Int64; - Origin: TSeekOrigin): Int64; -var - NewPos: Int64; -begin - NewPos := FPosition; - case Origin of - soBeginning: - NewPos := Offset; - soCurrent: - Inc(NewPos, Offset); - soEnd: - NewPos := GetCalcedSize + Offset; - else - NewPos := -1; - end; - if NewPos < 0 then - NewPos := -1 - else - FPosition := NewPos; - Result := NewPos; -end; - -procedure TJclBufferedStream.SetSize(const NewSize: Int64); -begin - inherited SetSize(NewSize); - if NewSize < (FBufferStart + FBufferMaxModifiedPos) then - begin - FBufferMaxModifiedPos := NewSize - FBufferStart; - if FBufferMaxModifiedPos < 0 then - FBufferMaxModifiedPos := 0; - end; - if NewSize < (FBufferStart + FBufferCurrentSize) then - begin - FBufferCurrentSize := NewSize - FBufferStart; - if FBufferCurrentSize < 0 then - FBufferCurrentSize := 0; - end; - // fix from Marcelo Rocha - if Stream <> nil then - FPosition := Stream.Position; -end; - -function TJclBufferedStream.Write(const Buffer; Count: Longint): Longint; -const - Offset = 0; -begin - Result := Count + Offset; - while Count > 0 do - begin - if (FBufferStart > FPosition) or (FPosition >= (FBufferStart + FBufferSize)) then - LoadBuffer; - Dec(Count, WriteToBuffer(Buffer, Count, Result - Count)); - end; - Result := Result - Count - Offset; -end; - -function TJclBufferedStream.WriteToBuffer(const Buffer; Count, Start: Longint): Longint; -var - BufPos: Longint; - P: PAnsiChar; -begin - Result := Count; - BufPos := FPosition - FBufferStart; - if Result > Length(FBuffer) - BufPos then - Result := Length(FBuffer) - BufPos; - if FBufferCurrentSize < BufPos + Result then - FBufferCurrentSize := BufPos + Result; - P := @Buffer; - Move(P[Start], FBuffer[BufPos], Result); - if FBufferMaxModifiedPos < BufPos + Result then - FBufferMaxModifiedPos := BufPos + Result; - Inc(FPosition, Result); -end; - -//=== { TJclEventStream } ==================================================== - -constructor TJclEventStream.Create(AStream: TStream; ANotification: - TStreamNotifyEvent = nil; AOwnsStream: Boolean = False); -begin - inherited Create(AStream, AOwnsStream); - FNotification := ANotification; -end; - -procedure TJclEventStream.DoAfterStreamChange; -begin - inherited DoAfterStreamChange; - if Stream <> nil then - DoNotification; -end; - -procedure TJclEventStream.DoBeforeStreamChange; -begin - inherited DoBeforeStreamChange; - if Stream <> nil then - DoNotification; -end; - -procedure TJclEventStream.DoNotification; -begin - if Assigned(FNotification) then - FNotification(Self, Stream.Position, Stream.Size); -end; - -function TJclEventStream.Read(var Buffer; Count: Longint): Longint; -begin - Result := inherited Read(Buffer, Count); - DoNotification; -end; - -function TJclEventStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; -begin - Result := inherited Seek(Offset, Origin); - DoNotification; -end; - -procedure TJclEventStream.SetSize(const NewSize: Int64); -begin - inherited SetSize(NewSize); - DoNotification; -end; - -function TJclEventStream.Write(const Buffer; Count: Longint): Longint; -begin - Result := inherited Write(Buffer, Count); - DoNotification; -end; - -//=== { TJclEasyStream } ===================================================== - -function TJclEasyStream.IsEqual(Stream: TStream): Boolean; -var - SavePos, StreamSavePos: Int64; -begin - SavePos := Position; - StreamSavePos := Stream.Position; - try - Position := 0; - Stream.Position := 0; - Result := CompareStreams(Self, Stream); - finally - Position := SavePos; - Stream.Position := StreamSavePos; - end; -end; - -function TJclEasyStream.ReadBoolean: Boolean; -begin - Result := False; - ReadBuffer(Result, SizeOf(Result)); -end; - -function TJclEasyStream.ReadChar: Char; -begin - Result := #0; - ReadBuffer(Result, SizeOf(Result)); -end; - -function TJclEasyStream.ReadAnsiChar: AnsiChar; -begin - Result := #0; - ReadBuffer(Result, SizeOf(Result)); -end; - -function TJclEasyStream.ReadWideChar: WideChar; -begin - Result := #0; - ReadBuffer(Result, SizeOf(Result)); -end; - -function TJclEasyStream.ReadByte: Byte; -begin - Result := 0; - ReadBuffer(Result, SizeOf(Result)); -end; - -function TJclEasyStream.ReadCurrency: Currency; -begin - Result := 0; - ReadBuffer(Result, SizeOf(Result)); -end; - -function TJclEasyStream.ReadDateTime: TDateTime; -begin - Result := 0; - ReadBuffer(Result, SizeOf(Result)); -end; - -function TJclEasyStream.ReadDouble: Double; -begin - Result := 0; - ReadBuffer(Result, SizeOf(Result)); -end; - -function TJclEasyStream.ReadExtended: Extended; -begin - Result := 0; - ReadBuffer(Result, SizeOf(Result)); -end; - -function TJclEasyStream.ReadInt64: Int64; -begin - Result := 0; - ReadBuffer(Result, SizeOf(Result)); -end; - -function TJclEasyStream.ReadInteger: Integer; -begin - Result := 0; - ReadBuffer(Result, SizeOf(Result)); -end; - -function TJclEasyStream.ReadCString: string; -begin - {$IFDEF SUPPORTS_UNICODE} - Result := ReadCWideString; - {$ELSE ~SUPPORTS_UNICODE} - Result := ReadCAnsiString; - {$ENDIF ~SUPPORTS_UNICODE} -end; - -function TJclEasyStream.ReadCAnsiString: AnsiString; -var - CurrPos: Longint; - StrSize: Integer; -begin - CurrPos := Position; - repeat - until ReadAnsiChar = #0; - StrSize := Position - CurrPos; // Get number of bytes - SetLength(Result, StrSize div SizeOf(AnsiChar) - 1); // Set number of chars without #0 - Position := CurrPos; // Seek to start read - ReadBuffer(Result[1], StrSize); // Read ansi data and #0 -end; - -function TJclEasyStream.ReadCWideString: WideString; -var - CurrPos: Integer; - StrSize: Integer; -begin - CurrPos := Position; - repeat - until ReadWideChar = #0; - StrSize := Position - CurrPos; // Get number of bytes - SetLength(Result, StrSize div SizeOf(WideChar) - 1); // Set number of chars without #0 - Position := CurrPos; // Seek to start read - ReadBuffer(Result[1], StrSize); // Read wide data and #0 -end; - -function TJclEasyStream.ReadShortString: string; -var - StrSize: Integer; -begin - StrSize := Ord(ReadChar); - SetString(Result, PChar(nil), StrSize); - ReadBuffer(Pointer(Result)^, StrSize); -end; - -function TJclEasyStream.ReadSingle: Single; -begin - Result := 0; - ReadBuffer(Result, SizeOf(Result)); -end; - -function TJclEasyStream.ReadSizedString: string; -begin - {$IFDEF SUPPORTS_UNICODE} - Result := ReadSizedWideString; - {$ELSE ~SUPPORTS_UNICODE} - Result := ReadSizedAnsiString; - {$ENDIF ~SUPPORTS_UNICODE} -end; - -function TJclEasyStream.ReadSizedAnsiString: AnsiString; -var - StrSize: Integer; -begin - StrSize := ReadInteger; - SetLength(Result, StrSize); - ReadBuffer(Result[1], StrSize * SizeOf(Result[1])); -end; - -function TJclEasyStream.ReadSizedWideString: WideString; -var - StrSize: Integer; -begin - StrSize := ReadInteger; - SetLength(Result, StrSize); - ReadBuffer(Result[1], StrSize * SizeOf(Result[1])); -end; - -procedure TJclEasyStream.WriteBoolean(Value: Boolean); -begin - WriteBuffer(Value, SizeOf(Value)); -end; - -procedure TJclEasyStream.WriteChar(Value: Char); -begin - WriteBuffer(Value, SizeOf(Value)); -end; - -procedure TJclEasyStream.WriteAnsiChar(Value: AnsiChar); -begin - WriteBuffer(Value, SizeOf(Value)); -end; - -procedure TJclEasyStream.WriteWideChar(Value: WideChar); -begin - WriteBuffer(Value, SizeOf(Value)); -end; - -procedure TJclEasyStream.WriteByte(Value: Byte); -begin - WriteBuffer(Value, SizeOf(Value)); -end; - -procedure TJclEasyStream.WriteCurrency(const Value: Currency); -begin - WriteBuffer(Value, SizeOf(Value)); -end; - -procedure TJclEasyStream.WriteDateTime(const Value: TDateTime); -begin - WriteBuffer(Value, SizeOf(Value)); -end; - -procedure TJclEasyStream.WriteDouble(const Value: Double); -begin - WriteBuffer(Value, SizeOf(Value)); -end; - -procedure TJclEasyStream.WriteExtended(const Value: Extended); -begin - WriteBuffer(Value, SizeOf(Value)); -end; - -procedure TJclEasyStream.WriteInt64(Value: Int64); -begin - WriteBuffer(Value, SizeOf(Value)); -end; - -procedure TJclEasyStream.WriteInteger(Value: Integer); -begin - WriteBuffer(Value, SizeOf(Value)); -end; - -procedure TJclEasyStream.WriteCString(const Value: string); -begin - {$IFDEF SUPPORTS_UNICODE} - WriteCWideString(Value); - {$ELSE ~SUPPORTS_UNICODE} - WriteCAnsiString(Value); - {$ENDIF ~SUPPORTS_UNICODE} -end; - -procedure TJclEasyStream.WriteCAnsiString(const Value: AnsiString); -var - StrSize: Integer; -begin - StrSize := Length(Value); - WriteBuffer(Value[1], (StrSize + 1) * SizeOf(Value[1])); -end; - -procedure TJclEasyStream.WriteCWideString(const Value: WideString); -var - StrSize: Integer; -begin - StrSize := Length(Value); - WriteBuffer(Value[1], (StrSize + 1) * SizeOf(Value[1])); -end; - -procedure TJclEasyStream.WriteShortString(const Value: ShortString); -begin - WriteBuffer(Value[0], Length(Value) + 1); -end; - -procedure TJclEasyStream.WriteSingle(const Value: Single); -begin - WriteBuffer(Value, SizeOf(Value)); -end; - -procedure TJclEasyStream.WriteSizedString(const Value: string); -begin - {$IFDEF SUPPORTS_UNICODE} - WriteSizedWideString(Value); - {$ELSE ~SUPPORTS_UNICODE} - WriteSizedAnsiString(Value); - {$ENDIF ~SUPPORTS_UNICODE} -end; - -procedure TJclEasyStream.WriteSizedAnsiString(const Value: AnsiString); -var - StrSize: Integer; -begin - StrSize := Length(Value); - WriteInteger(StrSize); - WriteBuffer(Value[1], StrSize * SizeOf(Value[1])); -end; - -procedure TJclEasyStream.WriteSizedWideString(const Value: WideString); -var - StrSize: Integer; -begin - StrSize := Length(Value); - WriteInteger(StrSize); - WriteBuffer(Value[1], StrSize * SizeOf(Value[1])); -end; - -//=== { TJclScopedStream } =================================================== - -constructor TJclScopedStream.Create(AParentStream: TStream; const AMaxSize: Int64); -begin - inherited Create; - - FParentStream := AParentStream; - FStartPos := ParentStream.Position; - FCurrentPos := 0; - FMaxSize := AMaxSize; -end; - -constructor TJclScopedStream.Create(AParentStream: TStream; const AStartPos, AMaxSize: Int64); -begin - inherited Create; - - FParentStream := AParentStream; - FStartPos := AStartPos; - FCurrentPos := 0; - FMaxSize := AMaxSize; -end; - -function TJclScopedStream.Read(var Buffer; Count: Longint): Longint; -begin - if (MaxSize >= 0) and ((FCurrentPos + Count) > MaxSize) then - Count := MaxSize - FCurrentPos; - - if (Count > 0) and Assigned(ParentStream) then - begin - Result := ParentStream.Read(Buffer, Count); - Inc(FCurrentPos, Result); - end - else - Result := 0; -end; - -function TJclScopedStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; -begin - case Origin of - soBeginning: - begin - if (Offset < 0) or ((MaxSize >= 0) and (Offset > MaxSize)) then - Result := -1 // low and high bound check - else - Result := ParentStream.Seek(StartPos + Offset, soBeginning) - StartPos; - end; - soCurrent: - begin - if Offset = 0 then - Result := FCurrentPos // speeding the Position property up - else if ((FCurrentPos + Offset) < 0) or ((MaxSize >= 0) - and ((FCurrentPos + Offset) > MaxSize)) then - Result := -1 // low and high bound check - else - Result := ParentStream.Seek(Offset, soCurrent) - StartPos; - end; - soEnd: - begin - if (MaxSize >= 0) then - begin - if (Offset > 0) or (MaxSize < -Offset) then // low and high bound check - Result := -1 - else - Result := ParentStream.Seek(StartPos + MaxSize + Offset, soBeginning) - StartPos; - end - else - begin - Result := ParentStream.Seek(Offset, soEnd); - if (Result <> -1) and (Result < StartPos) then // low bound check - begin - Result := -1; - ParentStream.Seek(StartPos + FCurrentPos, soBeginning); - end; - end; - end; - else - Result := -1; - end; - if Result <> -1 then - FCurrentPos := Result; -end; - -procedure TJclScopedStream.SetSize(const NewSize: Int64); -var - ScopedNewSize: Int64; -begin - if (FMaxSize >= 0) and (NewSize >= (FStartPos + FMaxSize)) then - ScopedNewSize := FMaxSize + FStartPos - else - ScopedNewSize := NewSize; - inherited SetSize(ScopedNewSize); -end; - -function TJclScopedStream.Write(const Buffer; Count: Longint): Longint; -begin - if (MaxSize >= 0) and ((FCurrentPos + Count) > MaxSize) then - Count := MaxSize - FCurrentPos; - - if (Count > 0) and Assigned(ParentStream) then - begin - Result := ParentStream.Write(Buffer, Count); - Inc(FCurrentPos, Result); - end - else - Result := 0; -end; - -//=== { TJclDelegateStream } ================================================= - -procedure TJclDelegatedStream.SetSize(const NewSize: Int64); -begin - if Assigned(FOnSize) then - FOnSize(Self, NewSize); -end; - -function TJclDelegatedStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; -begin - if Assigned(FOnSeek) then - Result := FOnSeek(Self, Offset, Origin) - else - Result := -1; -end; - -function TJclDelegatedStream.Read(var Buffer; Count: Longint): Longint; -begin - if Assigned(FOnRead) then - Result := FOnRead(Self, Buffer, Count) - else - Result := -1; -end; - -function TJclDelegatedStream.Write(const Buffer; Count: Longint): Longint; -begin - if Assigned(FOnWrite) then - Result := FOnWrite(Self, Buffer, Count) - else - Result := -1; -end; - -//=== { TJclSectoredStream } ================================================= - -procedure TJclSectoredStream.AfterBlockRead; -begin - // override to customize (checks of protection) -end; - -procedure TJclSectoredStream.BeforeBlockWrite; -begin - // override to customize (computation of protection) -end; - -constructor TJclSectoredStream.Create(AStorageStream: TStream; - AOwnsStream: Boolean; ASectorOverHead: Integer); -begin - inherited Create(AStorageStream, AOwnsStream); - FSectorOverHead := ASectorOverHead; - if Stream <> nil then - FPosition := SectoredToFlat(Stream.Position); -end; - -procedure TJclSectoredStream.DoAfterStreamChange; -begin - inherited DoAfterStreamChange; - if Stream <> nil then - FPosition := SectoredToFlat(Stream.Position); -end; - -function TJclSectoredStream.FlatToSectored(const Position: Int64): Int64; -begin - Result := (Position div BufferSize) * (Int64(BufferSize) + FSectorOverHead) // add overheads of previous buffers - + (Position mod BufferSize); // offset in sector -end; - -procedure TJclSectoredStream.Flush; -begin - if (Stream <> nil) and (FBufferMaxModifiedPos > 0) then - begin - BeforeBlockWrite; - - Stream.Position := FlatToSectored(FBufferStart); - Stream.WriteBuffer(FBuffer[0], FBufferCurrentSize + FSectorOverHead); - FBufferMaxModifiedPos := 0; - end; -end; - -function TJclSectoredStream.GetCalcedSize: Int64; -var - VirtualSize: Int64; -begin - if Assigned(Stream) then - Result := SectoredToFlat(Stream.Size) - else - Result := 0; - VirtualSize := FBufferMaxModifiedPos + FBufferStart; - if Result < VirtualSize then - Result := VirtualSize; -end; - -function TJclSectoredStream.LoadBuffer: Boolean; -var - TotalSectorSize: Longint; -begin - Flush; - TotalSectorSize := FBufferSize + FSectorOverHead; - if Length(FBuffer) <> TotalSectorSize then - SetLength(FBuffer, TotalSectorSize); - FBufferStart := (FPosition div BufferSize) * BufferSize; - if Stream <> nil then - begin - Stream.Position := FlatToSectored(FBufferStart); - FBufferCurrentSize := Stream.Read(FBuffer[0], TotalSectorSize); - if FBufferCurrentSize > 0 then - begin - Dec(FBufferCurrentSize, FSectorOverHead); - AfterBlockRead; - end; - end - else - FBufferCurrentSize := 0; - Result := (FBufferCurrentSize > 0); -end; - -function TJclSectoredStream.SectoredToFlat(const Position: Int64): Int64; -var - TotalSectorSize: Int64; -begin - TotalSectorSize := Int64(BufferSize) + FSectorOverHead; - Result := (Position div TotalSectorSize) * BufferSize // remove previous overheads - + Position mod TotalSectorSize; // offset in sector -end; - -procedure TJclSectoredStream.SetSize(const NewSize: Int64); -begin - inherited SetSize(FlatToSectored(NewSize)); -end; - -//=== { TJclCRC16Stream } ==================================================== - -procedure TJclCRC16Stream.AfterBlockRead; -var - CRC: Word; -begin - CRC := Word(FBuffer[FBufferCurrentSize]) or (Word(FBuffer[FBufferCurrentSize + 1]) shl 8); - if CheckCrc16(FBuffer, FBufferCurrentSize, CRC) < 0 then - raise EJclStreamError.CreateRes(@RsStreamsCRCError); -end; - -procedure TJclCRC16Stream.BeforeBlockWrite; -var - CRC: Word; -begin - CRC := Crc16(FBuffer, FBufferCurrentSize); - FBuffer[FBufferCurrentSize] := CRC and $FF; - FBuffer[FBufferCurrentSize + 1] := CRC shr 8; -end; - -constructor TJclCRC16Stream.Create(AStorageStream: TStream; AOwnsStream: Boolean); -begin - inherited Create(AStorageStream, AOwnsStream, 2); -end; - -//=== { TJclCRC32Stream } ==================================================== - -procedure TJclCRC32Stream.AfterBlockRead; -var - CRC: Cardinal; -begin - CRC := Cardinal(FBuffer[FBufferCurrentSize]) or (Cardinal(FBuffer[FBufferCurrentSize + 1]) shl 8) - or (Cardinal(FBuffer[FBufferCurrentSize + 2]) shl 16) or (Cardinal(FBuffer[FBufferCurrentSize + 3]) shl 24); - if CheckCrc32(FBuffer, FBufferCurrentSize, CRC) < 0 then - raise EJclStreamError.CreateRes(@RsStreamsCRCError); -end; - -procedure TJclCRC32Stream.BeforeBlockWrite; -var - CRC: Cardinal; -begin - CRC := Crc32(FBuffer, FBufferCurrentSize); - FBuffer[FBufferCurrentSize] := CRC and $FF; - FBuffer[FBufferCurrentSize + 1] := (CRC shr 8) and $FF; - FBuffer[FBufferCurrentSize + 2] := (CRC shr 16) and $FF; - FBuffer[FBufferCurrentSize + 3] := (CRC shr 24) and $FF; -end; - -constructor TJclCRC32Stream.Create(AStorageStream: TStream; - AOwnsStream: Boolean); -begin - inherited Create(AStorageStream, AOwnsStream, 4); -end; - -//=== { TJclSplitStream } ==================================================== - -constructor TJclSplitStream.Create(AForcePosition: Boolean); -begin - inherited Create; - FVolume := nil; - FVolumeIndex := -1; - FVolumeMaxSize := 0; - FPosition := 0; - FVolumePosition := 0; - FForcePosition := AForcePosition; -end; - -function TJclSplitStream.GetSize: Int64; -var - OldVolumeIndex: Integer; - OldVolumePosition, OldPosition: Int64; -begin - OldVolumeIndex := FVolumeIndex; - OldVolumePosition := FVolumePosition; - OldPosition := FPosition; - - Result := 0; - try - FVolumeIndex := -1; - repeat - if not InternalLoadVolume(FVolumeIndex + 1) then - Break; - Result := Result + FVolume.Size; - until FVolume.Size = 0; - finally - InternalLoadVolume(OldVolumeIndex); - FPosition := OldPosition; - if Assigned(FVolume) then - FVolumePosition := FVolume.Seek(OldVolumePosition, soBeginning); - end; -end; - -function TJclSplitStream.InternalLoadVolume(Index: Integer): Boolean; -var - OldVolumeIndex: Integer; - OldVolumePosition: Int64; - OldVolume: TStream; -begin - if Index = -1 then - Index := 0; - if Index <> FVolumeIndex then - begin - // save current pointers - OldVolumeIndex := FVolumeIndex; - OldVolumePosition := FVolumePosition; - OldVolume := FVolume; - - FVolumeIndex := Index; - FVolumePosition := 0; - FVolume := GetVolume(Index); - Result := Assigned(FVolume); - if Result then begin - FVolumeMaxSize := GetVolumeMaxSize(Index); - FVolume.Seek(0, soBeginning) - end - else - begin - // restore old pointers if volume load failed - FVolumeIndex := OldVolumeIndex; - FVolumePosition := OldVolumePosition; - FVolume := OldVolume; - end; - end - else - Result := Assigned(FVolume); -end; - -function TJclSplitStream.Read(var Buffer; Count: Longint): Longint; -var - Data: PByte; - Total, LoopRead: Longint; -begin - Result := 0; - - if not InternalLoadVolume(FVolumeIndex) then - Exit; - - Data := PByte(@Buffer); - Total := Count; - - repeat - // force position - if ForcePosition then - FVolume.Seek(FVolumePosition, soBeginning); - - // try to read (Count) bytes from current stream - LoopRead := FVolume.Read(Data^, Count); - FVolumePosition := FVolumePosition + LoopRead; - FPosition := FPosition + LoopRead; - Inc(Result, LoopRead); - if Result = Total then - Break; - - // with next volume - Dec(Count, LoopRead); - Inc(Data, LoopRead); - if not InternalLoadVolume(FVolumeIndex + 1) then - Break; - until False; -end; - -function TJclSplitStream.Seek(const Offset: Int64; - Origin: TSeekOrigin): Int64; -var - ExpectedPosition, RemainingOffset: Int64; -begin - case TSeekOrigin(Origin) of - soBeginning: - ExpectedPosition := Offset; - soCurrent: - ExpectedPosition := FPosition + Offset; - soEnd: - ExpectedPosition := Size + Offset; - else - raise EJclStreamError.CreateRes(@RsStreamsSeekError); - end; - RemainingOffset := ExpectedPosition - FPosition; - Result := FPosition; - repeat - if not InternalLoadVolume(FVolumeIndex) then - Break; - - if RemainingOffset < 0 then - begin - // FPosition > ExpectedPosition, seek backward - if FVolumePosition >= -RemainingOffset then - begin - // seek in current volume - FVolumePosition := FVolume.Seek(FVolumePosition + RemainingOffset, soBeginning); - Result := Result + RemainingOffset; - FPosition := Result; - RemainingOffset := 0; - end - else - begin - // seek to previous volume - if FVolumeIndex = 0 then - Exit; - // seek to the beginning of current volume - RemainingOffset := RemainingOffset + FVolumePosition; - Result := Result - FVolumePosition; - FPosition := Result; - FVolumePosition := FVolume.Seek(0, soBeginning); - // load previous volume - if not InternalLoadVolume(FVolumeIndex - 1) then - Break; - Result := Result - FVolume.Size; - FPosition := Result; - RemainingOffset := RemainingOffset + FVolume.Size; - end; - end - else if RemainingOffset > 0 then - begin - // FPosition < ExpectedPosition, seek forward - if (FVolumeMaxSize = 0) or ((FVolumePosition + RemainingOffset) < FVolumeMaxSize) then - begin - // can seek in current volume - FVolumePosition := FVolume.Seek(FVolumePosition + RemainingOffset, soBeginning); - Result := Result + RemainingOffset; - FPosition := Result; - RemainingOffset := 0; - end - else - begin - // seek to next volume - RemainingOffset := RemainingOffset - FVolumeMaxSize + FVolumePosition; - Result := Result + FVolumeMaxSize - FVolumePosition; - FPosition := Result; - if not InternalLoadVolume(FVolumeIndex + 1) then begin - FVolumePosition := FVolumeMaxSize; - Break; - end; - end; - end; - until RemainingOffset = 0; -end; - -procedure TJclSplitStream.SetSize(const NewSize: Int64); -var - OldVolumeIndex: Integer; - OldVolumePosition, OldPosition, RemainingSize, VolumeSize: Int64; -begin - OldVolumeIndex := FVolumeIndex; - OldVolumePosition := FVolumePosition; - OldPosition := FPosition; - - RemainingSize := NewSize; - try - FVolumeIndex := 0; - repeat - if not InternalLoadVolume(FVolumeIndex) then - Break; - if (FVolumeMaxSize > 0) and (RemainingSize > FVolumeMaxSize) then - VolumeSize := FVolumeMaxSize - else - VolumeSize := RemainingSize; - FVolume.Size := VolumeSize; - RemainingSize := RemainingSize - VolumeSize; - - Inc(FVolumeIndex); - until RemainingSize = 0; - finally - InternalLoadVolume(OldVolumeIndex); - FPosition := OldPosition; - if Assigned(FVolume) then - FVolumePosition := FVolume.Seek(OldVolumePosition, soBeginning); - end; -end; - -function TJclSplitStream.Write(const Buffer; Count: Longint): Longint; -var - Data: PByte; - Total, LoopWritten: Longint; -begin - Result := 0; - - if not InternalLoadVolume(FVolumeIndex) then - Exit; - - Data := PByte(@Buffer); - Total := Count; - - repeat - // force position - if ForcePosition then - FVolume.Seek(FVolumePosition, soBeginning); - - // do not write more than (VolumeMaxSize) bytes in current stream - if (FVolumeMaxSize > 0) and ((Count + FVolumePosition) > FVolumeMaxSize) then - LoopWritten := FVolumeMaxSize - FVolumePosition - else - LoopWritten := Count; - // try to write (Count) bytes from current stream - LoopWritten := FVolume.Write(Data^, LoopWritten); - FVolumePosition := FVolumePosition + LoopWritten; - FPosition := FPosition + LoopWritten; - Inc(Result, LoopWritten); - if Result = Total then - Break; - - // with next volume - Dec(Count, LoopWritten); - Inc(Data, LoopWritten); - if not InternalLoadVolume(FVolumeIndex + 1) then - Break; - until False; -end; - -//=== { TJclDynamicSplitStream } ============================================= - -function TJclDynamicSplitStream.GetVolume(Index: Integer): TStream; -begin - if Assigned(FOnVolume) then - Result := FOnVolume(Index) - else - Result := nil; -end; - -function TJclDynamicSplitStream.GetVolumeMaxSize(Index: Integer): Int64; -begin - if Assigned(FOnVolumeMaxSize) then - Result := FOnVolumeMaxSize(Index) - else - Result := 0; -end; - -//=== { TJclStaticSplitStream } =========================================== - -constructor TJclStaticSplitStream.Create(AForcePosition: Boolean); -begin - inherited Create(AForcePosition); - FVolumes := TObjectList.Create(True); -end; - -destructor TJclStaticSplitStream.Destroy; -var - Index: Integer; - AVolumeRec: TJclSplitVolume; -begin - if Assigned(FVolumes) then - begin - for Index := 0 to FVolumes.Count - 1 do - begin - AVolumeRec := TJclSplitVolume(FVolumes.Items[Index]); - if AVolumeRec.OwnStream then - AVolumeRec.Stream.Free; - end; - FVolumes.Free; - end; - inherited Destroy; -end; - -function TJclStaticSplitStream.AddVolume(AStream: TStream; AMaxSize: Int64; - AOwnStream: Boolean): Integer; -var - AVolumeRec: TJclSplitVolume; -begin - AVolumeRec := TJclSplitVolume.Create; - AVolumeRec.MaxSize := AMaxSize; - AVolumeRec.Stream := AStream; - AVolumeRec.OwnStream := AOwnStream; - Result := FVolumes.Add(AVolumeRec); -end; - -function TJclStaticSplitStream.GetVolume(Index: Integer): TStream; -begin - Result := TJclSplitVolume(FVolumes.Items[Index]).Stream; -end; - -function TJclStaticSplitStream.GetVolumeCount: Integer; -begin - Result := FVolumes.Count; -end; - -function TJclStaticSplitStream.GetVolumeMaxSize(Index: Integer): Int64; -begin - Result := TJclSplitVolume(FVolumes.Items[Index]).MaxSize; -end; - -//=== { TJclStringStream } ==================================================== - -constructor TJclStringStream.Create(AStream: TStream; AOwnsStream: Boolean); -begin - inherited Create; - FStream := AStream; - FOwnStream := AOwnsStream; - FBufferSize := StreamDefaultBufferSize; - - // Must call this method so that buffer initial values are properly set. - // This is most useful when AStream is not located at position zero - // before being used by us. - InvalidateBuffers; -end; - -destructor TJclStringStream.Destroy; -begin - Flush; - if FOwnStream then - FStream.Free; - inherited; -end; - -procedure TJclStringStream.Flush; -begin - if FStrBufferModifiedSize > 0 then - begin - FStream.Position := FStrBufferStart; - InternalSetNextBuffer(FStream, FStrBuffer, 0, FStrBufferModifiedSize); - FStrBufferNext := FStream.Seek(0, soCurrent); - FStrBufferModifiedSize := 0; - end; -end; - -function TJclStringStream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; -var - Ch: UCS4; -begin - // override to optimize - Result := 0; - while Count > 0 do - begin - if InternalGetNextChar(S, Ch) then - begin - Buffer[Start] := Ch; - Inc(Start); - Inc(Result); - end - else - Break; - Dec(Count); - end; -end; - -function TJclStringStream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; -begin - // override to optimize - Result := 0; - while Count > 0 do - begin - if InternalSetNextChar(S, Buffer[Start]) then - begin - Inc(Start); - Inc(Result); - end - else - Break; - Dec(Count); - end; -end; - -procedure TJclStringStream.InvalidateBuffers; -begin - FStrBufferStart := FStream.Seek(0, soCurrent); - FStrBufferNext := FStrBufferStart; - FStrBufferPosition := 0; - FStrBufferCurrentSize := 0; - FStrBufferModifiedSize := 0; - FStrPeekBufferStart := FStrBufferStart; - FStrPeekBufferNext := FStrBufferNext; - FStrPeekPosition := 0; - FStrPeekBufferCurrentSize := 0; -end; - -function TJclStringStream.LoadBuffer: Boolean; -begin - Flush; - // first test if the peek buffer contains the value - if (FStrBufferNext >= FStrPeekBufferStart) and (FStrBufferNext < FStrPeekBufferNext) then - begin - // the requested buffer is already loaded in the peek buffer - FStrBufferStart := FStrPeekBufferStart; - FStrBufferNext := FStrPeekBufferNext; - if Length(FStrBuffer) <> Length(FStrPeekBuffer) then - SetLength(FStrBuffer, Length(FStrPeekBuffer)); - FStrBufferPosition := FStrPeekBufferPosition; - FStrBufferCurrentSize := FStrPeekBufferCurrentSize; - Move(FStrPeekBuffer[0], FStrBuffer[0], FStrBufferCurrentSize * SizeOf(FStrBuffer[0])); - end - else - begin - // load a new buffer - if Length(FStrBuffer) <> FBufferSize then - SetLength(FStrBuffer, FBufferSize); - Inc(FStrBufferPosition, FStrBufferCurrentSize); - FStrBufferStart := FStrBufferNext; - FStream.Seek(FStrBufferStart, soBeginning); - FStrBufferCurrentSize := InternalGetNextBuffer(FStream, FStrBuffer, 0, FBufferSize); - FStrBufferNext := FStream.Seek(0, soCurrent); - // reset the peek buffer - FStrPeekBufferPosition := FStrBufferPosition + FStrBufferCurrentSize; - FStrPeekBufferCurrentSize := 0; - FStrPeekBufferNext := FStrBufferNext; - FStrPeekBufferStart := FStrBufferNext; - end; - Result := (FStrPosition >= FStrBufferPosition) and (FStrPosition < (FStrBufferPosition + FStrBufferCurrentSize)); -end; - -function TJclStringStream.LoadPeekBuffer: Boolean; -begin - if Length(FStrPeekBuffer) <> FBufferSize then - SetLength(FStrPeekBuffer, FBufferSize); - if FStrPeekBufferPosition > FStrPeekPosition then - begin - // the peek position is rolling back, load the buffer after the read buffer - FStrPeekBufferPosition := FStrBufferPosition; - FStrPeekBufferCurrentSize := FStrBufferCurrentSize; - FStrPeekBufferStart := FStrBufferStart; - FStrPeekBufferNext := FStrBufferNext; - end; - FStrPeekBufferStart := FStrPeekBufferNext; - Inc(FStrPeekBufferPosition, FStrPeekBufferCurrentSize); - FStream.Seek(FStrPeekBufferStart, soBeginning); - FStrPeekBufferCurrentSize := InternalGetNextBuffer(FStream, FStrPeekBuffer, 0, FBufferSize); - FStrPeekBufferNext := FStream.Seek(0, soCurrent); - Result := (FStrPeekPosition >= FStrPeekBufferPosition) and (FStrPeekPosition < (FStrPeekBufferPosition + FStrPeekBufferCurrentSize)); -end; - -function TJclStringStream.PeekAnsiChar(out Buffer: AnsiChar): Boolean; -var - Ch: UCS4; -begin - Result := PeekUCS4(Ch); - if Result then - Buffer := UCS4ToAnsiChar(Ch); -end; - -function TJclStringStream.PeekChar(out Buffer: Char): Boolean; -var - Ch: UCS4; -begin - Result := PeekUCS4(Ch); - if Result then - Buffer := UCS4ToChar(Ch); -end; - -function TJclStringStream.PeekUCS4(out Buffer: UCS4): Boolean; -begin - if (FStrPeekPosition >= FStrPeekBufferPosition) and (FStrPeekPosition < (FStrPeekBufferPosition + FStrPeekBufferCurrentSize)) then - begin - // read from the peek buffer - Result := True; - Buffer := FStrPeekBuffer[FStrPeekPosition - FStrPeekBufferPosition]; - Inc(FStrPeekPosition); - end - else - if (FStrPeekPosition >= FStrBufferPosition) and (FStrPeekPosition < (FStrBufferPosition + FStrBufferCurrentSize)) then - begin - // read from the read/write buffer - Result := True; - Buffer := FStrBuffer[FStrPeekPosition - FStrBufferPosition]; - Inc(FStrPeekPosition); - end - else - begin - // load a new peek buffer - Result := LoadPeekBuffer; - if Result then - begin - Buffer := FStrPeekBuffer[FStrPeekPosition - FStrPeekBufferPosition]; - Inc(FStrPeekPosition); - end; - end; -end; - -function TJclStringStream.PeekWideChar(out Buffer: WideChar): Boolean; -var - Ch: UCS4; -begin - Result := PeekUCS4(Ch); - if Result then - Buffer := UCS4ToWideChar(Ch); -end; - -function TJclStringStream.ReadString(var Buffer: string; Start, Count: Longint): Longint; -var - Index: Integer; - StrPos: SizeInt; - Ch: UCS4; -begin - Index := Start; - while Index < Start + Count - 1 do // avoid overflow on surrogate pairs for WideString - begin - if ReadUCS4(Ch) then - begin - StrPos := Index; - if StringSetNextChar(Buffer, StrPos, Ch) and (StrPos > 0) then - Index := StrPos - else - Break; // end of string (write) - end - else - Break; // end of stream (read) - end; - Result := Index - Start; -end; - -function TJclStringStream.ReadString(BufferSize: Longint): string; -var - Buffer: string; - ProcessedLength: Longint; -begin - Result := ''; - SetLength(Buffer, BufferSize); - repeat - ProcessedLength := ReadString(Buffer, 1, BufferSize); - if ProcessedLength > 0 then - Result := Result + Copy(Buffer, 1, ProcessedLength); - until ProcessedLength = 0; -end; - -function TJclStringStream.ReadAnsiChar(out Buffer: AnsiChar): Boolean; -var - Ch: UCS4; -begin - Result := ReadUCS4(Ch); - if Result then - Buffer := UCS4ToAnsiChar(Ch); -end; - -function TJclStringStream.ReadAnsiString(var Buffer: AnsiString; Start, Count: Longint): Longint; -var - Index: Integer; - StrPos: SizeInt; - Ch: UCS4; -begin - Index := Start; - while Index < Start + Count do - begin - if ReadUCS4(Ch) then - begin - StrPos := Index; - if AnsiSetNextChar(Buffer, StrPos, Ch) and (StrPos > 0) then - Index := StrPos - else - Break; // end of string (write) - end - else - Break; // end of stream (read) - end; - Result := Index - Start; -end; - -function TJclStringStream.ReadAnsiString(BufferSize: Longint): AnsiString; -var - Buffer: AnsiString; - ProcessedLength: Longint; -begin - Result := ''; - SetLength(Buffer, BufferSize); - repeat - ProcessedLength := ReadAnsiString(Buffer, 1, BufferSize); - if ProcessedLength > 0 then - Result := Result + Copy(Buffer, 1, ProcessedLength); - until ProcessedLength = 0; -end; - -function TJclStringStream.ReadChar(out Buffer: Char): Boolean; -var - Ch: UCS4; -begin - Result := ReadUCS4(Ch); - if Result then - Buffer := UCS4ToChar(Ch); -end; - -function TJclStringStream.ReadUCS4(out Buffer: UCS4): Boolean; -begin - if (FStrPosition >= FStrBufferPosition) and (FStrPosition < (FStrBufferPosition + FStrBufferCurrentSize)) then - begin - // load from buffer - Result := True; - Buffer := FStrBuffer[FStrPosition - FStrBufferPosition]; - Inc(FStrPosition); - end - else - begin - // load a new buffer - Result := LoadBuffer; - if Result then - begin - Buffer := FStrBuffer[FStrPosition - FStrBufferPosition]; - Inc(FStrPosition); - end; - end; - FStrPeekPosition := FStrPosition; -end; - -function TJclStringStream.ReadWideChar(out Buffer: WideChar): Boolean; -var - Ch: UCS4; -begin - Result := ReadUCS4(Ch); - if Result then - Buffer := UCS4ToWideChar(Ch); -end; - -function TJclStringStream.ReadWideString(var Buffer: WideString; Start, Count: Longint): Longint; -var - Index: Integer; - StrPos: SizeInt; - Ch: UCS4; -begin - Index := Start; - while Index < Start + Count - 1 do // avoid overflow on surrogate pairs - begin - if ReadUCS4(Ch) then - begin - StrPos := Index; - if UTF16SetNextChar(Buffer, StrPos, Ch) and (StrPos > 0) then - Index := StrPos - else - Break; // end of string (write) - end - else - Break; // end of stream (read) - end; - Result := Index - Start; -end; - -function TJclStringStream.ReadWideString(BufferSize: Longint): WideString; -var - Buffer: WideString; - ProcessedLength: Longint; -begin - Result := ''; - SetLength(Buffer, BufferSize); - repeat - ProcessedLength := ReadWideString(Buffer, 1, BufferSize); - if ProcessedLength > 0 then - Result := Result + Copy(Buffer, 1, ProcessedLength); - until ProcessedLength = 0; -end; - -function TJclStringStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; -begin - case Origin of - soBeginning: - if Offset = 0 then - begin - Flush; - FStrPosition := 0; - FStrBufferPosition := 0; - FStrBufferCurrentSize := 0; - FStrBufferStart := 0; - FStrBufferNext := 0; - FStrPeekBufferPosition := 0; - FStrPeekBufferCurrentSize := 0; - FStrPeekBufferStart := 0; - FStrPeekBufferNext := 0; - end - else - raise EJclStreamError.CreateRes(@RsStreamsSeekError); - soCurrent: - if Offset <> 0 then - raise EJclStreamError.CreateRes(@RsStreamsSeekError); - soEnd: - raise EJclStreamError.CreateRes(@RsStreamsSeekError); - end; - Result := FStrPosition; - FStrPeekPosition := FStrPosition; -end; - -function TJclStringStream.SkipBOM: Longint; -var - Pos: Int64; - I: Integer; - BOM: array of Byte; -begin - if Length(FBOM) > 0 then - begin - Pos := FStream.Seek(0, soCurrent); - SetLength(BOM, Length(FBOM)); - Result := FStream.Read(BOM[0], Length(BOM) * SizeOf(BOM[0])); - if Result = Length(FBOM) * SizeOf(FBOM[0]) then - for I := Low(FBOM) to High(FBOM) do - if BOM[I - Low(FBOM)] <> FBOM[I] then - Result := 0; - if Result <> Length(FBOM) * SizeOf(FBOM[0]) then - FStream.Seek(Pos, soBeginning); - end - else - Result := 0; - InvalidateBuffers; -end; - -function TJclStringStream.WriteBOM: Longint; -begin - if Length(FBOM) > 0 then - Result := FStream.Write(FBOM[0], Length(FBOM) * SizeOf(FBOM[0])) - else - Result := 0; - InvalidateBuffers; -end; - -function TJclStringStream.WriteChar(Value: Char): Boolean; -begin - Result := WriteUCS4(CharToUCS4(Value)); -end; - -function TJclStringStream.WriteString(const Buffer: string; Start, Count: Longint): Longint; -var - Index: Integer; - StrPos: SizeInt; - Ch: UCS4; -begin - Index := Start; - while Index < Start + Count do - begin - StrPos := Index; - Ch := StringGetNextChar(Buffer, StrPos); - if (StrPos > 0) and WriteUCS4(Ch) then - Index := StrPos - else - Break; // end of string (read) or end of stream (write) - end; - Result := Index - Start; -end; - -function TJclStringStream.WriteAnsiChar(Value: AnsiChar): Boolean; -begin - Result := WriteUCS4(AnsiCharToUCS4(Value)); -end; - -function TJclStringStream.WriteAnsiString(const Buffer: AnsiString; Start, Count: Longint): Longint; -var - Index: Integer; - StrPos: SizeInt; - Ch: UCS4; -begin - Index := Start; - while Index < Start + Count do - begin - StrPos := Index; - Ch := AnsiGetNextChar(Buffer, StrPos); - if (StrPos > 0) and WriteUCS4(Ch) then - Index := StrPos - else - Break; // end of string (read) or end of stream (write) - end; - Result := Index - Start; -end; - -function TJclStringStream.WriteUCS4(Value: UCS4): Boolean; -var - BufferPos: Int64; -begin - if FStrPosition >= (FStrBufferPosition + FBufferSize) then - // load the next buffer first - LoadBuffer; - // write to current buffer - BufferPos := FStrPosition - FStrBufferPosition; - Result := True; - if Length(FStrBuffer) <> FBufferSize then - SetLength(FStrBuffer, FBufferSize); - FStrBuffer[BufferPos] := Value; - Inc(FStrPosition); - Inc(BufferPos); - if FStrBufferModifiedSize < BufferPos then - FStrBufferModifiedSize := BufferPos; - if FStrBufferCurrentSize < BufferPos then - FStrBufferCurrentSize := BufferPos; - FStrPeekPosition := FStrPosition; -end; - -function TJclStringStream.WriteWideChar(Value: WideChar): Boolean; -begin - Result := WriteUCS4(WideCharToUCS4(Value)); -end; - -function TJclStringStream.WriteWideString(const Buffer: WideString; Start, Count: Longint): Longint; -var - Index: Integer; - StrPos: SizeInt; - Ch: UCS4; -begin - Index := Start; - while Index < Start + Count do - begin - StrPos := Index; - Ch := UTF16GetNextChar(Buffer, StrPos); - if (StrPos > 0) and WriteUCS4(Ch) then - Index := StrPos - else - Break; // end of string (read) or end of stream (write) - end; - Result := Index - Start; -end; - -//=== { TJclAnsiStream } ====================================================== - -constructor TJclAnsiStream.Create(AStream: TStream; AOwnsStream: Boolean); -begin - inherited Create(AStream, AOwnsStream); - SetLength(FBOM, 0); - FCodePage := CP_ACP; -end; - -function TJclAnsiStream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; -begin - if FCodePage = CP_ACP then - Result := AnsiGetNextBufferFromStream(S, Buffer, Start, Count) - else - Result := AnsiGetNextBufferFromStream(S, FCodePage, Buffer, Start, Count); -end; - -function TJclAnsiStream.InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; -begin - if FCodePage = CP_ACP then - Result := AnsiGetNextCharFromStream(S, Ch) - else - Result := AnsiGetNextCharFromStream(S, FCodePage, Ch); -end; - -function TJclAnsiStream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; -begin - if FCodePage = CP_ACP then - Result := AnsiSetNextBufferToStream(S, Buffer, Start, Count) - else - Result := AnsiSetNextBufferToStream(S, FCodePage, Buffer, Start, Count); -end; - -function TJclAnsiStream.InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; -begin - if FCodePage = CP_ACP then - Result := AnsiSetNextCharToStream(S, Ch) - else - Result := AnsiSetNextCharToStream(S, FCodePage, Ch); -end; - -//=== { TJclUTF8Stream } ====================================================== - -constructor TJclUTF8Stream.Create(AStream: TStream; AOwnsStream: Boolean); -var - I: Integer; -begin - inherited Create(AStream, AOwnsStream); - SetLength(FBOM, Length(BOM_UTF8)); - for I := Low(BOM_UTF8) to High(BOM_UTF8) do - FBOM[I - Low(BOM_UTF8)] := BOM_UTF8[I]; -end; - -function TJclUTF8Stream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; -begin - Result := UTF8GetNextBufferFromStream(S, Buffer, Start, Count); -end; - -function TJclUTF8Stream.InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; -begin - Result := UTF8GetNextCharFromStream(S, Ch); -end; - -function TJclUTF8Stream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; -begin - Result := UTF8SetNextBufferToStream(S, Buffer, Start, Count); -end; - -function TJclUTF8Stream.InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; -begin - Result := UTF8SetNextCharToStream(S, Ch); -end; - -//=== { TJclUTF16Stream } ===================================================== - -constructor TJclUTF16Stream.Create(AStream: TStream; AOwnsStream: Boolean); -var - I: Integer; -begin - inherited Create(AStream, AOwnsStream); - SetLength(FBOM, Length(BOM_UTF16_LSB)); - for I := Low(BOM_UTF16_LSB) to High(BOM_UTF16_LSB) do - FBOM[I - Low(BOM_UTF16_LSB)] := BOM_UTF16_LSB[I]; -end; - -function TJclUTF16Stream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; -begin - Result := UTF16GetNextBufferFromStream(S, Buffer, Start, Count); -end; - -function TJclUTF16Stream.InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; -begin - Result := UTF16GetNextCharFromStream(S, Ch); -end; - -function TJclUTF16Stream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; -begin - Result := UTF16SetNextBufferToStream(S, Buffer, Start, Count); -end; - -function TJclUTF16Stream.InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; -begin - Result := UTF16SetNextCharToStream(S, Ch); -end; - -//=== { TJclAutoStream } ====================================================== - -constructor TJclAutoStream.Create(AStream: TStream; AOwnsStream: Boolean); -var - I, MaxLength, ReadLength: Integer; - BOM: array of Byte; -begin - inherited Create(AStream, AOwnsStream); - MaxLength := Length(BOM_UTF8); - if MaxLength < Length(BOM_UTF16_LSB) then - MaxLength := Length(BOM_UTF16_LSB); - - SetLength(BOM, MaxLength); - ReadLength := FStream.Read(BOM[0], Length(BOM) * SizeOf(BOM[0])) div SizeOf(BOM[0]); - - FEncoding := seAuto; - - // try UTF8 BOM - if (FEncoding = seAuto) and (ReadLength >= Length(BOM_UTF8) * SizeOf(BOM_UTF8[0])) then - begin - FCodePage := CP_UTF8; - FEncoding := seUTF8; - for I := Low(BOM_UTF8) to High(BOM_UTF8) do - if BOM[I - Low(BOM_UTF8)] <> BOM_UTF8[I] then - begin - FEncoding := seAuto; - Break; - end; - end; - - // try UTF16 BOM - if (FEncoding = seAuto) and (ReadLength >= Length(BOM_UTF16_LSB) * SizeOf(BOM_UTF16_LSB[0])) then - begin - FCodePage := CP_UTF16LE; - FEncoding := seUTF16; - for I := Low(BOM_UTF16_LSB) to High(BOM_UTF16_LSB) do - if BOM[I - Low(BOM_UTF8)] <> BOM_UTF16_LSB[I] then - begin - FEncoding := seAuto; - Break; - end; - end; - - case FEncoding of - seUTF8: - begin - FCodePage := CP_UTF8; - SetLength(FBOM, Length(BOM_UTF8)); - for I := Low(BOM_UTF8) to High(BOM_UTF8) do - FBOM[I - Low(BOM_UTF8)] := BOM_UTF8[I]; - end; - seUTF16: - begin - FCodePage := CP_UTF16LE; - SetLength(FBOM, Length(BOM_UTF16_LSB)); - for I := Low(BOM_UTF16_LSB) to High(BOM_UTF16_LSB) do - FBOM[I - Low(BOM_UTF16_LSB)] := BOM_UTF16_LSB[I]; - end; - seAuto, - seAnsi: - begin - // defaults to Ansi - FCodePage := CP_ACP; - FEncoding := seAnsi; - SetLength(FBOM, 0); - end; - end; - FStream.Seek(Length(FBOM) - ReadLength, soCurrent); - InvalidateBuffers; -end; - -function TJclAutoStream.InternalGetNextBuffer(S: TStream; - var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; -begin - case FCodePage of - CP_UTF8: - Result := UTF8GetNextBufferFromStream(S, Buffer, Start, Count); - CP_UTF16LE: - Result := UTF16GetNextBufferFromStream(S, Buffer, Start, Count); - CP_ACP: - Result := AnsiGetNextBufferFromStream(S, Buffer, Start, Count); - else - Result := AnsiGetNextBufferFromStream(S, CodePage, Buffer, Start, Count); - end; -end; - -function TJclAutoStream.InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; -begin - case FCodePage of - CP_UTF8: - Result := UTF8GetNextCharFromStream(S, Ch); - CP_UTF16LE: - Result := UTF16GetNextCharFromStream(S, Ch); - CP_ACP: - Result := AnsiGetNextCharFromStream(S, Ch); - else - Result := AnsiGetNextCharFromStream(S, CodePage, Ch); - end; -end; - -function TJclAutoStream.InternalSetNextBuffer(S: TStream; - const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; -begin - case FCodePage of - CP_UTF8: - Result := UTF8SetNextBufferToStream(S, Buffer, Start, Count); - CP_UTF16LE: - Result := UTF16SetNextBufferToStream(S, Buffer, Start, Count); - CP_ACP: - Result := AnsiSetNextBufferToStream(S, Buffer, Start, Count); - else - Result := AnsiSetNextBufferToStream(S, CodePage, Buffer, Start, Count); - end; -end; - -function TJclAutoStream.InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; -begin - case FCodePage of - CP_UTF8: - Result := UTF8SetNextCharToStream(S, Ch); - CP_UTF16LE: - Result := UTF16SetNextCharToStream(S, Ch); - CP_ACP: - Result := AnsiSetNextCharToStream(S, Ch); - else - Result := AnsiSetNextCharToStream(S, CodePage, Ch); - end; -end; - -procedure TJclAutoStream.SetCodePage(Value: Word); -begin - if Value = CP_UTF8 then - FEncoding := seUTF8 - else - if Value = CP_UTF16LE then - FEncoding := seUTF16 - else - if Value = CP_ACP then - FEncoding := seAnsi - else - FEncoding := seAuto; - FCodePage := Value; -end; - -function TJclAutoStream.SkipBOM: LongInt; -begin - // already skipped to determine encoding - Result := 0; - InvalidateBuffers; -end; - -{$IFDEF UNITVERSIONING} -initialization - RegisterUnitVersion(HInstance, UnitVersioning); - -finalization - UnregisterUnitVersion(HInstance); -{$ENDIF UNITVERSIONING} - -end. +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclStreams.pas. } +{ } +{ The Initial Developer of the Original Code is Robert Marquardt. Portions created by } +{ Robert Marquardt are Copyright (C) Robert Marquardt (robert_marquardt att gmx dott de) } +{ All rights reserved. } +{ } +{ Contributors: } +{ Florent Ouchet (outchy) } +{ Heinz Zastrau } +{ Andreas Schmidt } +{ } +{**************************************************************************************************} +{ } +{ Stream-related functions and classes } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclStreams; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Winapi.Windows, + {$ENDIF MSWINDOWS} + System.SysUtils, System.Classes, + System.Contnrs, + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + SysUtils, Classes, + Contnrs, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + JclBase, JclStringConversions; + +const + StreamDefaultBufferSize = 4096; + +type + EJclStreamError = class(EJclError); + + // abstraction layer to support Delphi 5 and C++Builder 5 streams + // 64 bit version of overloaded functions are introduced + TJclStream = class(TStream) + protected + procedure SetSize(NewSize: Longint); overload; override; + procedure SetSize(const NewSize: Int64); overload; override; + public + function Seek(Offset: Longint; Origin: Word): Longint; overload; override; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override; + procedure LoadFromStream(Source: TStream; BufferSize: Longint = StreamDefaultBufferSize); virtual; + procedure LoadFromFile(const FileName: TFileName; BufferSize: Longint = StreamDefaultBufferSize); virtual; + procedure SaveToStream(Dest: TStream; BufferSize: Longint = StreamDefaultBufferSize); virtual; + procedure SaveToFile(const FileName: TFileName; BufferSize: Longint = StreamDefaultBufferSize); virtual; + end; + + //=== VCL stream replacements === + + TJclHandleStream = class(TJclStream) + private + FHandle: THandle; + protected + procedure SetSize(const NewSize: Int64); override; + public + constructor Create(AHandle: THandle); + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; + property Handle: THandle read FHandle; + end; + + TJclFileStream = class(TJclHandleStream) + public + constructor Create(const FileName: TFileName; Mode: Word; Rights: Cardinal = $666); + destructor Destroy; override; + end; + + { + TJclCustomMemoryStream = class(TJclStream) + end; + + TJclMemoryStream = class(TJclCustomMemoryStream) + end; + + TJclStringStream = class(TJclStream) + end; + + TJclResourceStream = class(TJclCustomMemoryStream) + end; + } + + //=== new stream ideas === + + TJclEmptyStream = class(TJclStream) + protected + procedure SetSize(const NewSize: Int64); override; + public + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; + end; + + TJclNullStream = class(TJclStream) + private + FPosition: Int64; + FSize: Int64; + protected + procedure SetSize(const NewSize: Int64); override; + public + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; + end; + + TJclRandomStream = class(TJclNullStream) + protected + function GetRandSeed: Longint; virtual; + procedure SetRandSeed(Seed: Longint); virtual; + public + function RandomData: Byte; virtual; + procedure Randomize; dynamic; + function Read(var Buffer; Count: Longint): Longint; override; + property RandSeed: Longint read GetRandSeed write SetRandSeed; + end; + + TJclMultiplexStream = class(TJclStream) + private + FStreams: TList; + FReadStreamIndex: Integer; + function GetStream(Index: Integer): TStream; + function GetCount: Integer; + procedure SetStream(Index: Integer; const Value: TStream); + function GetReadStream: TStream; + procedure SetReadStream(const Value: TStream); + procedure SetReadStreamIndex(const Value: Integer); + protected + procedure SetSize(const NewSize: Int64); override; + public + constructor Create; + destructor Destroy; override; + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; + + function Add(NewStream: TStream): Integer; + procedure Clear; + function Remove(AStream: TStream): Integer; + procedure Delete(const Index: Integer); + + property Streams[Index: Integer]: TStream read GetStream write SetStream; + property ReadStreamIndex: Integer read FReadStreamIndex write SetReadStreamIndex; + property ReadStream: TStream read GetReadStream write SetReadStream; + property Count: Integer read GetCount; + end; + + TJclStreamDecorator = class(TJclStream) + private + FAfterStreamChange: TNotifyEvent; + FBeforeStreamChange: TNotifyEvent; + FOwnsStream: Boolean; + FStream: TStream; + procedure SetStream(Value: TStream); + protected + procedure DoAfterStreamChange; virtual; + procedure DoBeforeStreamChange; virtual; + procedure SetSize(const NewSize: Int64); override; + public + constructor Create(AStream: TStream; AOwnsStream: Boolean = False); + destructor Destroy; override; + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; + property AfterStreamChange: TNotifyEvent read FAfterStreamChange write FAfterStreamChange; + property BeforeStreamChange: TNotifyEvent read FBeforeStreamChange write FBeforeStreamChange; + property OwnsStream: Boolean read FOwnsStream write FOwnsStream; + property Stream: TStream read FStream write SetStream; + end; + + TJclBufferedStream = class(TJclStreamDecorator) + protected + FBuffer: array of Byte; + FBufferCurrentSize: Longint; + FBufferMaxModifiedPos: Longint; + FBufferSize: Longint; + FBufferStart: Int64; // position of the first byte of the buffer in stream + FPosition: Int64; // current position in stream + function BufferHit: Boolean; + function GetCalcedSize: Int64; virtual; + function LoadBuffer: Boolean; virtual; + function ReadFromBuffer(var Buffer; Count, Start: Longint): Longint; + function WriteToBuffer(const Buffer; Count, Start: Longint): Longint; + protected + procedure DoAfterStreamChange; override; + procedure DoBeforeStreamChange; override; + procedure SetSize(const NewSize: Int64); override; + public + constructor Create(AStream: TStream; AOwnsStream: Boolean = False); + destructor Destroy; override; + procedure Flush; virtual; + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; + property BufferSize: Longint read FBufferSize write FBufferSize; + end; + + TStreamNotifyEvent = procedure(Sender: TObject; Position: Int64; Size: Int64) of object; + + TJclEventStream = class(TJclStreamDecorator) + private + FNotification: TStreamNotifyEvent; + procedure DoNotification; + protected + procedure DoBeforeStreamChange; override; + procedure DoAfterStreamChange; override; + procedure SetSize(const NewSize: Int64); override; + public + constructor Create(AStream: TStream; ANotification: TStreamNotifyEvent = nil; + AOwnsStream: Boolean = False); + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; + property OnNotification: TStreamNotifyEvent read FNotification write FNotification; + end; + + TJclEasyStream = class(TJclStreamDecorator) + public + function IsEqual(Stream: TStream): Boolean; + function ReadBoolean: Boolean; + function ReadChar: Char; + function ReadAnsiChar: AnsiChar; + function ReadWideChar: WideChar; + function ReadByte: Byte; + function ReadCurrency: Currency; + function ReadDateTime: TDateTime; + function ReadExtended: Extended; + function ReadDouble: Double; + function ReadInt64: Int64; + function ReadInteger: Integer; + function ReadCString: string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + function ReadCAnsiString: AnsiString; + function ReadCWideString: WideString; + function ReadShortString: string; + function ReadSingle: Single; + function ReadSizedString: string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + function ReadSizedAnsiString: AnsiString; + function ReadSizedWideString: WideString; + procedure WriteBoolean(Value: Boolean); + procedure WriteChar(Value: Char); + procedure WriteAnsiChar(Value: AnsiChar); + procedure WriteWideChar(Value: WideChar); + procedure WriteByte(Value: Byte); + procedure WriteCurrency(const Value: Currency); + procedure WriteDateTime(const Value: TDateTime); + procedure WriteExtended(const Value: Extended); + procedure WriteDouble(const Value: Double); + procedure WriteInt64(Value: Int64); overload; + procedure WriteInteger(Value: Integer); overload; + procedure WriteCString(const Value: string); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure WriteCAnsiString(const Value: AnsiString); + procedure WriteCWideString(const Value: WideString); + // use WriteCString + procedure WriteShortString(const Value: ShortString); + procedure WriteSingle(const Value: Single); + procedure WriteSizedString(const Value: string); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + procedure WriteSizedAnsiString(const Value: AnsiString); + procedure WriteSizedWideString(const Value: WideString); + end; + + TJclScopedStream = class(TJclStream) + private + FParentStream: TStream; + FStartPos: Int64; + FCurrentPos: Int64; + FMaxSize: Int64; + protected + procedure SetSize(const NewSize: Int64); override; + public + // scopedstream starting at the current position of the ParentStream + // if MaxSize is positive or null, read and write operations cannot overrun this size or the ParentStream limitation + // if MaxSize is negative, read and write operations are unlimited (up to the ParentStream limitation) + constructor Create(AParentStream: TStream; const AMaxSize: Int64 = -1); overload; + constructor Create(AParentStream: TStream; const AStartPos, AMaxSize: Int64); overload; + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; + + property ParentStream: TStream read FParentStream; + property StartPos: Int64 read FStartPos; + property MaxSize: Int64 read FMaxSize write FMaxSize; + end; + + TJclStreamSeekEvent = function(Sender: TObject; const Offset: Int64; + Origin: TSeekOrigin): Int64 of object; + TJclStreamReadEvent = function(Sender: TObject; var Buffer; Count: Longint): Longint of object; + TJclStreamWriteEvent = function(Sender: TObject; const Buffer;Count: Longint): Longint of object; + TJclStreamSizeEvent = procedure(Sender: TObject; const NewSize: Int64) of object; + + TJclDelegatedStream = class(TJclStream) + private + FOnSeek: TJclStreamSeekEvent; + FOnRead: TJclStreamReadEvent; + FOnWrite: TJclStreamWriteEvent; + FOnSize: TJclStreamSizeEvent; + protected + procedure SetSize(const NewSize: Int64); override; + public + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + property OnSeek: TJclStreamSeekEvent read FOnSeek write FOnSeek; + property OnRead: TJclStreamReadEvent read FOnRead write FOnRead; + property OnWrite: TJclStreamWriteEvent read FOnWrite write FOnWrite; + property OnSize: TJclStreamSizeEvent read FOnSize write FOnSize; + end; + + // ancestor classes for streams with checksums and encrypted streams + // data are stored in sectors: each BufferSize-d buffer is followed by FSectorOverHead bytes + // containing the checksum. In case of an encrypted stream, there is no byte + // but sector is encrypted + + // reusing some code from TJclBufferedStream + TJclSectoredStream = class(TJclBufferedStream) + protected + FSectorOverHead: Longint; + function FlatToSectored(const Position: Int64): Int64; + function SectoredToFlat(const Position: Int64): Int64; + function GetCalcedSize: Int64; override; + function LoadBuffer: Boolean; override; + procedure DoAfterStreamChange; override; + procedure AfterBlockRead; virtual; // override to check protection + procedure BeforeBlockWrite; virtual; // override to compute protection + procedure SetSize(const NewSize: Int64); override; + public + constructor Create(AStorageStream: TStream; AOwnsStream: Boolean = False; + ASectorOverHead: Longint = 0); + + procedure Flush; override; + end; + + TJclCRC16Stream = class(TJclSectoredStream) + protected + procedure AfterBlockRead; override; + procedure BeforeBlockWrite; override; + public + constructor Create(AStorageStream: TStream; AOwnsStream: Boolean = False); + end; + + TJclCRC32Stream = class(TJclSectoredStream) + protected + procedure AfterBlockRead; override; + procedure BeforeBlockWrite; override; + public + constructor Create(AStorageStream: TStream; AOwnsStream: Boolean = False); + end; + + {$IFDEF COMPILER7_UP} + {$DEFINE SIZE64} + {$ENDIF ~COMPILER7_UP} + {$IFDEF FPC} + {$DEFINE SIZE64} + {$ENDIF FPC} + TJclSplitStream = class(TJclStream) + private + FVolume: TStream; + FVolumeIndex: Integer; + FVolumeMaxSize: Int64; + FPosition: Int64; + FVolumePosition: Int64; + FForcePosition: Boolean; + protected + function GetVolume(Index: Integer): TStream; virtual; abstract; + function GetVolumeMaxSize(Index: Integer): Int64; virtual; abstract; + function GetSize: Int64; {$IFDEF SIZE64}override;{$ENDIF SIZE64} + procedure SetSize(const NewSize: Int64); override; + function InternalLoadVolume(Index: Integer): Boolean; + public + constructor Create(AForcePosition: Boolean = False); + + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + + property ForcePosition: Boolean read FForcePosition write FForcePosition; + end; + + TJclVolumeEvent = function(Index: Integer): TStream of object; + TJclVolumeMaxSizeEvent = function(Index: Integer): Int64 of object; + + TJclDynamicSplitStream = class(TJclSplitStream) + private + FOnVolume: TJclVolumeEvent; + FOnVolumeMaxSize: TJclVolumeMaxSizeEvent; + protected + function GetVolume(Index: Integer): TStream; override; + function GetVolumeMaxSize(Index: Integer): Int64; override; + public + property OnVolume: TJclVolumeEvent read FOnVolume write FOnVolume; + property OnVolumeMaxSize: TJclVolumeMaxSizeEvent read FOnVolumeMaxSize + write FOnVolumeMaxSize; + end; + + TJclSplitVolume = class + public + MaxSize: Int64; + Stream: TStream; + OwnStream: Boolean; + end; + + TJclStaticSplitStream = class(TJclSplitStream) + private + FVolumes: TObjectList; + function GetVolumeCount: Integer; + protected + function GetVolume(Index: Integer): TStream; override; + function GetVolumeMaxSize(Index: Integer): Int64; override; + public + constructor Create(AForcePosition: Boolean = False); + destructor Destroy; override; + + function AddVolume(AStream: TStream; AMaxSize: Int64 = 0; + AOwnStream: Boolean = False): Integer; + + property VolumeCount: Integer read GetVolumeCount; + property Volumes[Index: Integer]: TStream read GetVolume; + property VolumeMaxSizes[Index: Integer]: Int64 read GetVolumeMaxSize; + end; + + TJclStringStream = class + protected + FStream: TStream; + FOwnStream: Boolean; + FBOM: array of Byte; + FBufferSize: SizeInt; + FStrPosition: Int64; // current position in characters + FStrBuffer: TUCS4Array; // buffer for read/write operations + FStrBufferPosition: Int64; // position of the first character of the read/write buffer + FStrBufferCurrentSize: Int64; // numbers of characters available in str buffer + FStrBufferModifiedSize: Int64; // numbers of characters modified in str buffer + FStrBufferStart: Int64; // position of the first byte of the read/write buffer in stream + FStrBufferNext: Int64; // position of the next character following the read/write buffer in stream + FStrPeekPosition: Int64; // current peek position in characters + FStrPeekBuffer: TUCS4Array; // buffer for peek operations + FStrPeekBufferPosition: Int64; // index of the first character of the peek buffer + FStrPeekBufferCurrentSize: SizeInt; // numbers of characters available in peek buffer + FStrPeekBufferStart: Int64; // position of the first byte of the peek buffer in stream + FStrPeekBufferNext: Int64; // position of the next character following the peek buffer in stream + function LoadBuffer: Boolean; + function LoadPeekBuffer: Boolean; + function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; virtual; abstract; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; virtual; + function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; virtual; abstract; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; virtual; + procedure InvalidateBuffers; + public + constructor Create(AStream: TStream; AOwnsStream: Boolean = False); virtual; + destructor Destroy; override; + procedure Flush; virtual; + function ReadString(var Buffer: string; Start, Count: Longint): Longint; overload; + function ReadString(BufferSize: Longint = StreamDefaultBufferSize): string; overload; + function ReadAnsiString(var Buffer: AnsiString; Start, Count: Longint): Longint; overload; + function ReadAnsiString(BufferSize: Longint = StreamDefaultBufferSize): AnsiString; overload; + function ReadWideString(var Buffer: WideString; Start, Count: Longint): Longint; overload; + function ReadWideString(BufferSize: Longint = StreamDefaultBufferSize): WideString; overload; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; virtual; + function WriteString(const Buffer: string; Start, Count: Longint): Longint; + function WriteAnsiString(const Buffer: AnsiString; Start, Count: Longint): Longint; + function WriteWideString(const Buffer: WideString; Start, Count: Longint): Longint; + function PeekChar(out Buffer: Char): Boolean; + function PeekAnsiChar(out Buffer: AnsiChar): Boolean; + function PeekUCS4(out Buffer: UCS4): Boolean; + function PeekWideChar(out Buffer: WideChar): Boolean; + function ReadChar(out Buffer: Char): Boolean; + function ReadAnsiChar(out Buffer: AnsiChar): Boolean; + function ReadUCS4(out Buffer: UCS4): Boolean; + function ReadWideChar(out Buffer: WideChar): Boolean; + function WriteChar(Value: Char): Boolean; + function WriteAnsiChar(Value: AnsiChar): Boolean; + function WriteUCS4(Value: UCS4): Boolean; + function WriteWideChar(Value: WideChar): Boolean; + function SkipBOM: LongInt; virtual; + function WriteBOM: Longint; virtual; + property BufferSize: SizeInt read FBufferSize write FBufferSize; + property PeekPosition: Int64 read FStrPeekPosition; + property Position: Int64 read FStrPosition; + property Stream: TStream read FStream; + property OwnStream: Boolean read FOwnStream; + end; + + TJclStringStreamClass = class of TJclStringStream; + + TJclAnsiStream = class(TJclStringStream) + private + FCodePage: Word; + protected + function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; + function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; + public + constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; + property CodePage: Word read FCodePage write FCodePage; + end; + + TJclUTF8Stream = class(TJclStringStream) + protected + function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; + function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; + public + constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; + end; + + TJclUTF16Stream = class(TJclStringStream) + protected + function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; + function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; + public + constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; + end; + + TJclStringEncoding = (seAnsi, seUTF8, seUTF16, seAuto); + + TJclAutoStream = class(TJclStringStream) + private + FCodePage: Word; + FEncoding: TJclStringEncoding; + procedure SetCodePage(Value: Word); + protected + function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override; + function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; + function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override; + function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override; + public + constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override; + function SkipBOM: LongInt; override; + property CodePage: Word read FCodePage write SetCodePage; + property Encoding: TJclStringEncoding read FEncoding; + end; + +// buffered copy of all available bytes from Source to Dest +// returns the number of bytes that were copied +function StreamCopy(Source: TStream; Dest: TStream; BufferSize: Longint = StreamDefaultBufferSize): Int64; + +// buffered copy of all available characters from Source to Dest +// retuns the number of characters (in specified encoding) that were copied +function StringStreamCopy(Source, Dest: TJclStringStream; BufferLength: Longint = StreamDefaultBufferSize): Int64; +function AnsiStringStreamCopy(Source, Dest: TJclStringStream; BufferLength: Longint = StreamDefaultBufferSize): Int64; +function WideStringStreamCopy(Source, Dest: TJclStringStream; BufferLength: Longint = StreamDefaultBufferSize): Int64; + +// compares 2 streams for differencies +function CompareStreams(A, B : TStream; BufferSize: Longint = StreamDefaultBufferSize): Boolean; +// compares 2 files for differencies (calling CompareStreams) +function CompareFiles(const FileA, FileB: TFileName; BufferSize: Longint = StreamDefaultBufferSize): Boolean; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.Types, + {$ENDIF HAS_UNITSCOPE} + JclResources, + JclCharsets, + JclMath, + JclSysUtils; + +function StreamCopy(Source: TStream; Dest: TStream; BufferSize: Longint): Int64; +var + Buffer: array of Byte; + ByteCount: Longint; +begin + Result := 0; + SetLength(Buffer, BufferSize); + repeat + ByteCount := Source.Read(Buffer[0], BufferSize); + Result := Result + ByteCount; + Dest.WriteBuffer(Buffer[0], ByteCount); + until ByteCount < BufferSize; +end; + +function StringStreamCopy(Source, Dest: TJclStringStream; BufferLength: Longint): Int64; +var + Buffer: string; + CharCount: Longint; +begin + Result := 0; + SetLength(Buffer, BufferLength); + repeat + CharCount := Source.ReadString(Buffer, 1, BufferLength); + Result := Result + CharCount; + CharCount := Dest.WriteString(Buffer, 1, CharCount); + until CharCount = 0; +end; + +function AnsiStringStreamCopy(Source, Dest: TJclStringStream; BufferLength: Longint): Int64; +var + Buffer: AnsiString; + CharCount: Longint; +begin + Result := 0; + SetLength(Buffer, BufferLength); + repeat + CharCount := Source.ReadAnsiString(Buffer, 1, BufferLength); + Result := Result + CharCount; + CharCount := Dest.WriteAnsiString(Buffer, 1, CharCount); + until CharCount = 0; +end; + +function WideStringStreamCopy(Source, Dest: TJclStringStream; BufferLength: Longint): Int64; +var + Buffer: WideString; + CharCount: Longint; +begin + Result := 0; + SetLength(Buffer, BufferLength); + repeat + CharCount := Source.ReadWideString(Buffer, 1, BufferLength); + Result := Result + CharCount; + CharCount := Dest.WriteWideString(Buffer, 1, CharCount); + until CharCount = 0; +end; + +function CompareStreams(A, B : TStream; BufferSize: Longint): Boolean; +var + BufferA, BufferB: array of Byte; + ByteCountA, ByteCountB: Longint; +begin + SetLength(BufferA, BufferSize); + try + SetLength(BufferB, BufferSize); + try + repeat + ByteCountA := A.Read(BufferA[0], BufferSize); + ByteCountB := B.Read(BufferB[0], BufferSize); + + Result := (ByteCountA = ByteCountB); + Result := Result and CompareMem(BufferA, BufferB, ByteCountA); + until (ByteCountA <> BufferSize) or (ByteCountB <> BufferSize) or not Result; + finally + SetLength(BufferB, 0); + end; + finally + SetLength(BufferA, 0); + end; +end; + +function CompareFiles(const FileA, FileB: TFileName; BufferSize: Longint): Boolean; +var + A, B: TStream; +begin + A := TFileStream.Create(FileA, fmOpenRead or fmShareDenyWrite); + try + B := TFileStream.Create(FileB, fmOpenRead or fmShareDenyWrite); + try + Result := CompareStreams(A, B, BufferSize); + finally + B.Free; + end; + finally + A.Free; + end; +end; + +//=== { TJclStream } ========================================================= + +function TJclStream.Seek(Offset: Longint; Origin: Word): Longint; +var + Result64: Int64; +begin + case Origin of + soFromBeginning: + Result64 := Seek(Int64(Offset), soBeginning); + soFromCurrent: + Result64 := Seek(Int64(Offset), soCurrent); + soFromEnd: + Result64 := Seek(Int64(Offset), soEnd); + else + Result64 := -1; + end; + if (Result64 < 0) or (Result64 > High(Longint)) then + Result64 := -1; + Result := Result64; +end; + +procedure TJclStream.LoadFromFile(const FileName: TFileName; + BufferSize: Integer); +var + FS: TStream; +begin + FS := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); + try + LoadFromStream(FS, BufferSize); + finally + FS.Free; + end; +end; + +procedure TJclStream.LoadFromStream(Source: TStream; BufferSize: Integer); +begin + StreamCopy(Source, Self, BufferSize); +end; + +procedure TJclStream.SaveToFile(const FileName: TFileName; BufferSize: Integer); +var + FS: TStream; +begin + FS := TFileStream.Create(FileName, fmCreate); + try + SaveToStream(FS, BufferSize); + finally + FS.Free; + end; +end; + +procedure TJclStream.SaveToStream(Dest: TStream; BufferSize: Integer); +begin + StreamCopy(Self, Dest, BufferSize); +end; + +function TJclStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; +begin + // override to customize + Result := -1; +end; + +procedure TJclStream.SetSize(NewSize: Longint); +begin + SetSize(Int64(NewSize)); +end; + +procedure TJclStream.SetSize(const NewSize: Int64); +begin + // override to customize +end; + +//=== { TJclHandleStream } =================================================== + +constructor TJclHandleStream.Create(AHandle: THandle); +begin + inherited Create; + FHandle := AHandle; +end; + +function TJclHandleStream.Read(var Buffer; Count: Longint): Longint; +begin + Result := 0; + {$IFDEF MSWINDOWS} + if (Count <= 0) or not ReadFile(Handle, Buffer, DWORD(Count), DWORD(Result), nil) then + Result := 0; + {$ENDIF MSWINDOWS} + {$IFDEF LINUX} + Result := __read(Handle, Buffer, Count); + {$ENDIF LINUX} +end; + +function TJclHandleStream.Write(const Buffer; Count: Longint): Longint; +begin + Result := 0; + {$IFDEF MSWINDOWS} + if (Count <= 0) or not WriteFile(Handle, Buffer, DWORD(Count), DWORD(Result), nil) then + Result := 0; + {$ENDIF MSWINDOWS} + {$IFDEF LINUX} + Result := __write(Handle, Buffer, Count); + {$ENDIF LINUX} +end; + +{$IFDEF MSWINDOWS} +function TJclHandleStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; +const + INVALID_SET_FILE_POINTER = -1; +type + TLarge = record + case Boolean of + False: + (OffsetLo: Longint; + OffsetHi: Longint); + True: + (Offset64: Int64); + end; +var + Offs: TLarge; +begin + Offs.Offset64 := Offset; + Offs.OffsetLo := SetFilePointer(Handle, Offs.OffsetLo, @Offs.OffsetHi, Ord(Origin)); + if (Offs.OffsetLo = INVALID_SET_FILE_POINTER) and (GetLastError <> NO_ERROR) then + Result := -1 + else + Result := Offs.Offset64; +end; +{$ENDIF MSWINDOWS} +{$IFDEF LINUX} +function TJclHandleStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; +const + SeekOrigins: array [TSeekOrigin] of Cardinal = ( SEEK_SET {soBeginning}, SEEK_CUR {soCurrent}, SEEK_END {soEnd} ); +begin + Result := lseek(Handle, Offset, SeekOrigins[Origin]); +end; +{$ENDIF LINUX} + +procedure TJclHandleStream.SetSize(const NewSize: Int64); +begin + Seek(NewSize, soBeginning); + {$IFDEF MSWINDOWS} + if not SetEndOfFile(Handle) then + RaiseLastOSError; + {$ENDIF MSWINDOWS} + {$IFDEF LINUX} + if ftruncate(Handle, Position) = -1 then + raise EJclStreamError.CreateRes(@RsStreamsSetSizeError); + {$ENDIF LINUX} +end; + +//=== { TJclFileStream } ===================================================== + +constructor TJclFileStream.Create(const FileName: TFileName; Mode: Word; Rights: Cardinal); +var + H: THandle; +{$IFDEF LINUX} +const + INVALID_HANDLE_VALUE = -1; +{$ENDIF LINUX} +begin + if Mode = fmCreate then + begin + {$IFDEF LINUX} + H := open(PChar(FileName), O_CREAT or O_RDWR, Rights); + {$ENDIF LINUX} + {$IFDEF MSWINDOWS} + H := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE, + 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); + {$ENDIF MSWINDOWS} + inherited Create(H); + if Handle = INVALID_HANDLE_VALUE then + raise EJclStreamError.CreateResFmt(@RsStreamsCreateError, [FileName]); + end + else + begin + H := THandle(FileOpen(FileName, Mode)); + inherited Create(H); + if Handle = INVALID_HANDLE_VALUE then + raise EJclStreamError.CreateResFmt(@RsStreamsOpenError, [FileName]); + end; +end; + +destructor TJclFileStream.Destroy; +begin + {$IFDEF MSWINDOWS} + if Handle <> INVALID_HANDLE_VALUE then + CloseHandle(Handle); + {$ENDIF MSWINDOWS} + {$IFDEF LINUX} + __close(Handle); + {$ENDIF LINUX} + inherited Destroy; +end; + +//=== { TJclEmptyStream } ==================================================== + +// a stream which stays empty no matter what you do +// so it is a Unix /dev/null equivalent + +procedure TJclEmptyStream.SetSize(const NewSize: Int64); +begin + // nothing +end; + +function TJclEmptyStream.Read(var Buffer; Count: Longint): Longint; +begin + // you cannot read anything + Result := 0; +end; + +function TJclEmptyStream.Write(const Buffer; Count: Longint): Longint; +begin + // you cannot write anything + Result := 0; +end; + +function TJclEmptyStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; +begin + if Offset <> 0 then + // seeking to anywhere except the position 0 is an error + Result := -1 + else + Result := 0; +end; + +//=== { TJclNullStream } ===================================================== + +// a stream which only keeps position and size, but no data +// so it is a Unix /dev/zero equivalent (?) + +procedure TJclNullStream.SetSize(const NewSize: Int64); +begin + if NewSize > 0 then + FSize := NewSize + else + FSize := 0; + if FPosition > FSize then + FPosition := FSize; +end; + +function TJclNullStream.Read(var Buffer; Count: Longint): Longint; +begin + if Count < 0 then + Count := 0; + // FPosition > FSize is possible! + if FSize - FPosition < Count then + Count := FSize - FPosition; + // does not read if beyond EOF + if Count > 0 then + begin + ResetMemory(Buffer, Count); + FPosition := FPosition + Count; + end; + Result := Count; +end; + +function TJclNullStream.Write(const Buffer; Count: Longint): Longint; +begin + if Count < 0 then + Count := 0; + FPosition := FPosition + Count; + // writing when FPosition > FSize is possible! + if FPosition > FSize then + FSize := FPosition; + Result := Count; +end; + +function TJclNullStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; +var + Rel: Int64; +begin + case Origin of + soBeginning: + Rel := 0; + soCurrent: + Rel := FPosition; + soEnd: + Rel := FSize; + else + // force Rel + Offset = -1 (code is never reached) + Rel := Offset - 1; + end; + if Rel + Offset >= 0 then + begin + // all non-negative destination positions including beyond EOF are valid + FPosition := Rel + Offset; + Result := FPosition; + end + else + Result := -1; +end; + +//=== { TJclRandomStream } =================================================== + +// A TJclNullStream decendant which returns random data when read +// so it is a Unix /dev/random equivalent + +function TJclRandomStream.GetRandSeed: Longint; +begin + Result := System.RandSeed; +end; + +procedure TJclRandomStream.SetRandSeed(Seed: Longint); +begin + System.RandSeed := Seed; +end; + +function TJclRandomStream.RandomData: Byte; +begin + Result := System.Random(256); +end; + +procedure TJclRandomStream.Randomize; +begin + System.Randomize; +end; + +function TJclRandomStream.Read(var Buffer; Count: Longint): Longint; +var + I: Longint; + BufferPtr: PByte; +begin + // this handles all necessary checks + Count := inherited Read(Buffer, Count); + BufferPtr := @Buffer; + for I := 0 to Count - 1 do + begin + BufferPtr^ := RandomData; + Inc(BufferPtr); + end; + Result := Count; +end; + +//=== { TJclMultiplexStream } ================================================ + +constructor TJclMultiplexStream.Create; +begin + inherited Create; + FStreams := TList.Create; + FReadStreamIndex := -1; +end; + +destructor TJclMultiplexStream.Destroy; +begin + FStreams.Free; + inherited Destroy; +end; + +function TJclMultiplexStream.Add(NewStream: TStream): Integer; +begin + Result := FStreams.Add(Pointer(NewStream)); +end; + +procedure TJclMultiplexStream.Clear; +begin + FStreams.Clear; + FReadStreamIndex := -1; +end; + +procedure TJclMultiplexStream.Delete(const Index: Integer); +begin + FStreams.Delete(Index); + if ReadStreamIndex = Index then + FReadStreamIndex := -1 + else + if ReadStreamIndex > Index then + Dec(FReadStreamIndex); +end; + +function TJclMultiplexStream.GetReadStream: TStream; +begin + if FReadStreamIndex >= 0 then + Result := TStream(FStreams.Items[FReadStreamIndex]) + else + Result := nil; +end; + +function TJclMultiplexStream.GetStream(Index: Integer): TStream; +begin + Result := TStream(FStreams.Items[Index]); +end; + +function TJclMultiplexStream.GetCount: Integer; +begin + Result := FStreams.Count; +end; + +function TJclMultiplexStream.Read(var Buffer; Count: Longint): Longint; +var + Stream: TStream; +begin + Stream := ReadStream; + if Assigned(Stream) then + Result := Stream.Read(Buffer, Count) + else + Result := 0; +end; + +function TJclMultiplexStream.Remove(AStream: TStream): Integer; +begin + Result := FStreams.Remove(Pointer(AStream)); + if FReadStreamIndex = Result then + FReadStreamIndex := -1 + else + if FReadStreamIndex > Result then + Dec(FReadStreamIndex); +end; + +function TJclMultiplexStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; +begin + // what should this function do? + Result := -1; +end; + +procedure TJclMultiplexStream.SetReadStream(const Value: TStream); +begin + FReadStreamIndex := FStreams.IndexOf(Pointer(Value)); +end; + +procedure TJclMultiplexStream.SetReadStreamIndex(const Value: Integer); +begin + FReadStreamIndex := Value; +end; + +procedure TJclMultiplexStream.SetSize(const NewSize: Int64); +begin + // what should this function do? +end; + +procedure TJclMultiplexStream.SetStream(Index: Integer; const Value: TStream); +begin + FStreams.Items[Index] := Pointer(Value); +end; + +function TJclMultiplexStream.Write(const Buffer; Count: Longint): Longint; +var + Index: Integer; + ByteWritten, MinByteWritten: Longint; +begin + MinByteWritten := Count; + for Index := 0 to Self.Count - 1 do + begin + ByteWritten := TStream(FStreams.Items[Index]).Write(Buffer, Count); + if ByteWritten < MinByteWritten then + MinByteWritten := ByteWritten; + end; + Result := MinByteWritten; +end; + +//=== { TJclStreamDecorator } ================================================ + +constructor TJclStreamDecorator.Create(AStream: TStream; AOwnsStream: Boolean = False); +begin + inherited Create; + FStream := AStream; + FOwnsStream := AOwnsStream; +end; + +destructor TJclStreamDecorator.Destroy; +begin + if OwnsStream then + FStream.Free; + inherited Destroy; +end; + +procedure TJclStreamDecorator.DoAfterStreamChange; +begin + if Assigned(FAfterStreamChange) then + FAfterStreamChange(Self); +end; + +procedure TJclStreamDecorator.DoBeforeStreamChange; +begin + if Assigned(FBeforeStreamChange) then + FBeforeStreamChange(Self); +end; + +function TJclStreamDecorator.Read(var Buffer; Count: Longint): Longint; +begin + if Assigned(FStream) then + Result := Stream.Read(Buffer, Count) + else + Result := 0; +end; + +function TJclStreamDecorator.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; +begin + Result := Stream.Seek(Offset, Origin); +end; + +procedure TJclStreamDecorator.SetSize(const NewSize: Int64); +begin + if Assigned(FStream) then + Stream.Size := NewSize; +end; + +procedure TJclStreamDecorator.SetStream(Value: TStream); +begin + if Value <> FStream then + try + DoBeforeStreamChange; + finally + if OwnsStream then + FStream.Free; + FStream := Value; + DoAfterStreamChange; + end; +end; + +function TJclStreamDecorator.Write(const Buffer; Count: Longint): Longint; +begin + if Assigned(FStream) then + Result := Stream.Write(Buffer, Count) + else + Result := 0; +end; + +//=== { TJclBufferedStream } ================================================= + +constructor TJclBufferedStream.Create(AStream: TStream; AOwnsStream: Boolean = False); +begin + inherited Create(AStream, AOwnsStream); + if Stream <> nil then + FPosition := Stream.Position; + BufferSize := StreamDefaultBufferSize; + LoadBuffer; +end; + +destructor TJclBufferedStream.Destroy; +begin + Flush; + inherited Destroy; +end; + +function TJclBufferedStream.BufferHit: Boolean; +begin + Result := (FBufferStart <= FPosition) and (FPosition < (FBufferStart + FBufferCurrentSize)); +end; + +procedure TJclBufferedStream.DoAfterStreamChange; +begin + inherited DoAfterStreamChange; + FBufferCurrentSize := 0; // invalidate buffer after stream is changed + FBufferStart := 0; + if Stream <> nil then + FPosition := Stream.Position; +end; + +procedure TJclBufferedStream.DoBeforeStreamChange; +begin + inherited DoBeforeStreamChange; + Flush; +end; + +procedure TJclBufferedStream.Flush; +begin + if (Stream <> nil) and (FBufferMaxModifiedPos > 0) then + begin + Stream.Position := FBufferStart; + Stream.WriteBuffer(FBuffer[0], FBufferMaxModifiedPos); + FBufferMaxModifiedPos := 0; + end; +end; + +function TJclBufferedStream.GetCalcedSize: Int64; +begin + if Assigned(Stream) then + Result := Stream.Size + else + Result := 0; + if Result < FBufferMaxModifiedPos + FBufferStart then + Result := FBufferMaxModifiedPos + FBufferStart; +end; + +function TJclBufferedStream.LoadBuffer: Boolean; +begin + Flush; + if Length(FBuffer) <> FBufferSize then + SetLength(FBuffer, FBufferSize); + if Stream <> nil then + begin + Stream.Position := FPosition; + FBufferCurrentSize := Stream.Read(FBuffer[0], FBufferSize); + end + else + FBufferCurrentSize := 0; + FBufferStart := FPosition; + Result := (FBufferCurrentSize > 0); +end; + +function TJclBufferedStream.Read(var Buffer; Count: Longint): Longint; +const + Offset = 0; +begin + Result := Count + Offset; + while Count > 0 do + begin + if not BufferHit then + if not LoadBuffer then + Break; + Dec(Count, ReadFromBuffer(Buffer, Count, Result - Count)); + end; + Result := Result - Count - Offset; +end; + +function TJclBufferedStream.ReadFromBuffer(var Buffer; Count, Start: Longint): Longint; +var + BufPos: Longint; + P: PAnsiChar; +begin + Result := Count; + BufPos := FPosition - FBufferStart; + if Result > FBufferCurrentSize - BufPos then + Result := FBufferCurrentSize - BufPos; + P := @Buffer; + Move(FBuffer[BufPos], P[Start], Result); + Inc(FPosition, Result); +end; + +function TJclBufferedStream.Seek(const Offset: Int64; + Origin: TSeekOrigin): Int64; +var + NewPos: Int64; +begin + NewPos := FPosition; + case Origin of + soBeginning: + NewPos := Offset; + soCurrent: + Inc(NewPos, Offset); + soEnd: + NewPos := GetCalcedSize + Offset; + else + NewPos := -1; + end; + if NewPos < 0 then + NewPos := -1 + else + FPosition := NewPos; + Result := NewPos; +end; + +procedure TJclBufferedStream.SetSize(const NewSize: Int64); +begin + inherited SetSize(NewSize); + if NewSize < (FBufferStart + FBufferMaxModifiedPos) then + begin + FBufferMaxModifiedPos := NewSize - FBufferStart; + if FBufferMaxModifiedPos < 0 then + FBufferMaxModifiedPos := 0; + end; + if NewSize < (FBufferStart + FBufferCurrentSize) then + begin + FBufferCurrentSize := NewSize - FBufferStart; + if FBufferCurrentSize < 0 then + FBufferCurrentSize := 0; + end; + // fix from Marcelo Rocha + if Stream <> nil then + FPosition := Stream.Position; +end; + +function TJclBufferedStream.Write(const Buffer; Count: Longint): Longint; +const + Offset = 0; +begin + Result := Count + Offset; + while Count > 0 do + begin + if (FBufferStart > FPosition) or (FPosition >= (FBufferStart + FBufferSize)) then + LoadBuffer; + Dec(Count, WriteToBuffer(Buffer, Count, Result - Count)); + end; + Result := Result - Count - Offset; +end; + +function TJclBufferedStream.WriteToBuffer(const Buffer; Count, Start: Longint): Longint; +var + BufPos: Longint; + P: PAnsiChar; +begin + Result := Count; + BufPos := FPosition - FBufferStart; + if Result > Length(FBuffer) - BufPos then + Result := Length(FBuffer) - BufPos; + if FBufferCurrentSize < BufPos + Result then + FBufferCurrentSize := BufPos + Result; + P := @Buffer; + Move(P[Start], FBuffer[BufPos], Result); + if FBufferMaxModifiedPos < BufPos + Result then + FBufferMaxModifiedPos := BufPos + Result; + Inc(FPosition, Result); +end; + +//=== { TJclEventStream } ==================================================== + +constructor TJclEventStream.Create(AStream: TStream; ANotification: + TStreamNotifyEvent = nil; AOwnsStream: Boolean = False); +begin + inherited Create(AStream, AOwnsStream); + FNotification := ANotification; +end; + +procedure TJclEventStream.DoAfterStreamChange; +begin + inherited DoAfterStreamChange; + if Stream <> nil then + DoNotification; +end; + +procedure TJclEventStream.DoBeforeStreamChange; +begin + inherited DoBeforeStreamChange; + if Stream <> nil then + DoNotification; +end; + +procedure TJclEventStream.DoNotification; +begin + if Assigned(FNotification) then + FNotification(Self, Stream.Position, Stream.Size); +end; + +function TJclEventStream.Read(var Buffer; Count: Longint): Longint; +begin + Result := inherited Read(Buffer, Count); + DoNotification; +end; + +function TJclEventStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; +begin + Result := inherited Seek(Offset, Origin); + DoNotification; +end; + +procedure TJclEventStream.SetSize(const NewSize: Int64); +begin + inherited SetSize(NewSize); + DoNotification; +end; + +function TJclEventStream.Write(const Buffer; Count: Longint): Longint; +begin + Result := inherited Write(Buffer, Count); + DoNotification; +end; + +//=== { TJclEasyStream } ===================================================== + +function TJclEasyStream.IsEqual(Stream: TStream): Boolean; +var + SavePos, StreamSavePos: Int64; +begin + SavePos := Position; + StreamSavePos := Stream.Position; + try + Position := 0; + Stream.Position := 0; + Result := CompareStreams(Self, Stream); + finally + Position := SavePos; + Stream.Position := StreamSavePos; + end; +end; + +function TJclEasyStream.ReadBoolean: Boolean; +begin + Result := False; + ReadBuffer(Result, SizeOf(Result)); +end; + +function TJclEasyStream.ReadChar: Char; +begin + Result := #0; + ReadBuffer(Result, SizeOf(Result)); +end; + +function TJclEasyStream.ReadAnsiChar: AnsiChar; +begin + Result := #0; + ReadBuffer(Result, SizeOf(Result)); +end; + +function TJclEasyStream.ReadWideChar: WideChar; +begin + Result := #0; + ReadBuffer(Result, SizeOf(Result)); +end; + +function TJclEasyStream.ReadByte: Byte; +begin + Result := 0; + ReadBuffer(Result, SizeOf(Result)); +end; + +function TJclEasyStream.ReadCurrency: Currency; +begin + Result := 0; + ReadBuffer(Result, SizeOf(Result)); +end; + +function TJclEasyStream.ReadDateTime: TDateTime; +begin + Result := 0; + ReadBuffer(Result, SizeOf(Result)); +end; + +function TJclEasyStream.ReadDouble: Double; +begin + Result := 0; + ReadBuffer(Result, SizeOf(Result)); +end; + +function TJclEasyStream.ReadExtended: Extended; +begin + Result := 0; + ReadBuffer(Result, SizeOf(Result)); +end; + +function TJclEasyStream.ReadInt64: Int64; +begin + Result := 0; + ReadBuffer(Result, SizeOf(Result)); +end; + +function TJclEasyStream.ReadInteger: Integer; +begin + Result := 0; + ReadBuffer(Result, SizeOf(Result)); +end; + +function TJclEasyStream.ReadCString: string; +begin + {$IFDEF SUPPORTS_UNICODE} + Result := ReadCWideString; + {$ELSE ~SUPPORTS_UNICODE} + Result := ReadCAnsiString; + {$ENDIF ~SUPPORTS_UNICODE} +end; + +function TJclEasyStream.ReadCAnsiString: AnsiString; +var + CurrPos: Longint; + StrSize: Integer; +begin + CurrPos := Position; + repeat + until ReadAnsiChar = #0; + StrSize := Position - CurrPos; // Get number of bytes + SetLength(Result, StrSize div SizeOf(AnsiChar) - 1); // Set number of chars without #0 + Position := CurrPos; // Seek to start read + ReadBuffer(Result[1], StrSize); // Read ansi data and #0 +end; + +function TJclEasyStream.ReadCWideString: WideString; +var + CurrPos: Integer; + StrSize: Integer; +begin + CurrPos := Position; + repeat + until ReadWideChar = #0; + StrSize := Position - CurrPos; // Get number of bytes + SetLength(Result, StrSize div SizeOf(WideChar) - 1); // Set number of chars without #0 + Position := CurrPos; // Seek to start read + ReadBuffer(Result[1], StrSize); // Read wide data and #0 +end; + +function TJclEasyStream.ReadShortString: string; +var + StrSize: Integer; +begin + StrSize := Ord(ReadChar); + SetString(Result, PChar(nil), StrSize); + ReadBuffer(Pointer(Result)^, StrSize); +end; + +function TJclEasyStream.ReadSingle: Single; +begin + Result := 0; + ReadBuffer(Result, SizeOf(Result)); +end; + +function TJclEasyStream.ReadSizedString: string; +begin + {$IFDEF SUPPORTS_UNICODE} + Result := ReadSizedWideString; + {$ELSE ~SUPPORTS_UNICODE} + Result := ReadSizedAnsiString; + {$ENDIF ~SUPPORTS_UNICODE} +end; + +function TJclEasyStream.ReadSizedAnsiString: AnsiString; +var + StrSize: Integer; +begin + StrSize := ReadInteger; + SetLength(Result, StrSize); + ReadBuffer(Result[1], StrSize * SizeOf(Result[1])); +end; + +function TJclEasyStream.ReadSizedWideString: WideString; +var + StrSize: Integer; +begin + StrSize := ReadInteger; + SetLength(Result, StrSize); + ReadBuffer(Result[1], StrSize * SizeOf(Result[1])); +end; + +procedure TJclEasyStream.WriteBoolean(Value: Boolean); +begin + WriteBuffer(Value, SizeOf(Value)); +end; + +procedure TJclEasyStream.WriteChar(Value: Char); +begin + WriteBuffer(Value, SizeOf(Value)); +end; + +procedure TJclEasyStream.WriteAnsiChar(Value: AnsiChar); +begin + WriteBuffer(Value, SizeOf(Value)); +end; + +procedure TJclEasyStream.WriteWideChar(Value: WideChar); +begin + WriteBuffer(Value, SizeOf(Value)); +end; + +procedure TJclEasyStream.WriteByte(Value: Byte); +begin + WriteBuffer(Value, SizeOf(Value)); +end; + +procedure TJclEasyStream.WriteCurrency(const Value: Currency); +begin + WriteBuffer(Value, SizeOf(Value)); +end; + +procedure TJclEasyStream.WriteDateTime(const Value: TDateTime); +begin + WriteBuffer(Value, SizeOf(Value)); +end; + +procedure TJclEasyStream.WriteDouble(const Value: Double); +begin + WriteBuffer(Value, SizeOf(Value)); +end; + +procedure TJclEasyStream.WriteExtended(const Value: Extended); +begin + WriteBuffer(Value, SizeOf(Value)); +end; + +procedure TJclEasyStream.WriteInt64(Value: Int64); +begin + WriteBuffer(Value, SizeOf(Value)); +end; + +procedure TJclEasyStream.WriteInteger(Value: Integer); +begin + WriteBuffer(Value, SizeOf(Value)); +end; + +procedure TJclEasyStream.WriteCString(const Value: string); +begin + {$IFDEF SUPPORTS_UNICODE} + WriteCWideString(Value); + {$ELSE ~SUPPORTS_UNICODE} + WriteCAnsiString(Value); + {$ENDIF ~SUPPORTS_UNICODE} +end; + +procedure TJclEasyStream.WriteCAnsiString(const Value: AnsiString); +var + StrSize: Integer; +begin + StrSize := Length(Value); + WriteBuffer(Value[1], (StrSize + 1) * SizeOf(Value[1])); +end; + +procedure TJclEasyStream.WriteCWideString(const Value: WideString); +var + StrSize: Integer; +begin + StrSize := Length(Value); + WriteBuffer(Value[1], (StrSize + 1) * SizeOf(Value[1])); +end; + +procedure TJclEasyStream.WriteShortString(const Value: ShortString); +begin + WriteBuffer(Value[0], Length(Value) + 1); +end; + +procedure TJclEasyStream.WriteSingle(const Value: Single); +begin + WriteBuffer(Value, SizeOf(Value)); +end; + +procedure TJclEasyStream.WriteSizedString(const Value: string); +begin + {$IFDEF SUPPORTS_UNICODE} + WriteSizedWideString(Value); + {$ELSE ~SUPPORTS_UNICODE} + WriteSizedAnsiString(Value); + {$ENDIF ~SUPPORTS_UNICODE} +end; + +procedure TJclEasyStream.WriteSizedAnsiString(const Value: AnsiString); +var + StrSize: Integer; +begin + StrSize := Length(Value); + WriteInteger(StrSize); + WriteBuffer(Value[1], StrSize * SizeOf(Value[1])); +end; + +procedure TJclEasyStream.WriteSizedWideString(const Value: WideString); +var + StrSize: Integer; +begin + StrSize := Length(Value); + WriteInteger(StrSize); + WriteBuffer(Value[1], StrSize * SizeOf(Value[1])); +end; + +//=== { TJclScopedStream } =================================================== + +constructor TJclScopedStream.Create(AParentStream: TStream; const AMaxSize: Int64); +begin + inherited Create; + + FParentStream := AParentStream; + FStartPos := ParentStream.Position; + FCurrentPos := 0; + FMaxSize := AMaxSize; +end; + +constructor TJclScopedStream.Create(AParentStream: TStream; const AStartPos, AMaxSize: Int64); +begin + inherited Create; + + FParentStream := AParentStream; + FStartPos := AStartPos; + FCurrentPos := 0; + FMaxSize := AMaxSize; +end; + +function TJclScopedStream.Read(var Buffer; Count: Longint): Longint; +begin + if (MaxSize >= 0) and ((FCurrentPos + Count) > MaxSize) then + Count := MaxSize - FCurrentPos; + + if (Count > 0) and Assigned(ParentStream) then + begin + Result := ParentStream.Read(Buffer, Count); + Inc(FCurrentPos, Result); + end + else + Result := 0; +end; + +function TJclScopedStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; +begin + case Origin of + soBeginning: + begin + if (Offset < 0) or ((MaxSize >= 0) and (Offset > MaxSize)) then + Result := -1 // low and high bound check + else + Result := ParentStream.Seek(StartPos + Offset, soBeginning) - StartPos; + end; + soCurrent: + begin + if Offset = 0 then + Result := FCurrentPos // speeding the Position property up + else if ((FCurrentPos + Offset) < 0) or ((MaxSize >= 0) + and ((FCurrentPos + Offset) > MaxSize)) then + Result := -1 // low and high bound check + else + Result := ParentStream.Seek(Offset, soCurrent) - StartPos; + end; + soEnd: + begin + if (MaxSize >= 0) then + begin + if (Offset > 0) or (MaxSize < -Offset) then // low and high bound check + Result := -1 + else + Result := ParentStream.Seek(StartPos + MaxSize + Offset, soBeginning) - StartPos; + end + else + begin + Result := ParentStream.Seek(Offset, soEnd); + if (Result <> -1) and (Result < StartPos) then // low bound check + begin + Result := -1; + ParentStream.Seek(StartPos + FCurrentPos, soBeginning); + end; + end; + end; + else + Result := -1; + end; + if Result <> -1 then + FCurrentPos := Result; +end; + +procedure TJclScopedStream.SetSize(const NewSize: Int64); +var + ScopedNewSize: Int64; +begin + if (FMaxSize >= 0) and (NewSize >= (FStartPos + FMaxSize)) then + ScopedNewSize := FMaxSize + FStartPos + else + ScopedNewSize := NewSize; + inherited SetSize(ScopedNewSize); +end; + +function TJclScopedStream.Write(const Buffer; Count: Longint): Longint; +begin + if (MaxSize >= 0) and ((FCurrentPos + Count) > MaxSize) then + Count := MaxSize - FCurrentPos; + + if (Count > 0) and Assigned(ParentStream) then + begin + Result := ParentStream.Write(Buffer, Count); + Inc(FCurrentPos, Result); + end + else + Result := 0; +end; + +//=== { TJclDelegateStream } ================================================= + +procedure TJclDelegatedStream.SetSize(const NewSize: Int64); +begin + if Assigned(FOnSize) then + FOnSize(Self, NewSize); +end; + +function TJclDelegatedStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; +begin + if Assigned(FOnSeek) then + Result := FOnSeek(Self, Offset, Origin) + else + Result := -1; +end; + +function TJclDelegatedStream.Read(var Buffer; Count: Longint): Longint; +begin + if Assigned(FOnRead) then + Result := FOnRead(Self, Buffer, Count) + else + Result := -1; +end; + +function TJclDelegatedStream.Write(const Buffer; Count: Longint): Longint; +begin + if Assigned(FOnWrite) then + Result := FOnWrite(Self, Buffer, Count) + else + Result := -1; +end; + +//=== { TJclSectoredStream } ================================================= + +procedure TJclSectoredStream.AfterBlockRead; +begin + // override to customize (checks of protection) +end; + +procedure TJclSectoredStream.BeforeBlockWrite; +begin + // override to customize (computation of protection) +end; + +constructor TJclSectoredStream.Create(AStorageStream: TStream; + AOwnsStream: Boolean; ASectorOverHead: Integer); +begin + inherited Create(AStorageStream, AOwnsStream); + FSectorOverHead := ASectorOverHead; + if Stream <> nil then + FPosition := SectoredToFlat(Stream.Position); +end; + +procedure TJclSectoredStream.DoAfterStreamChange; +begin + inherited DoAfterStreamChange; + if Stream <> nil then + FPosition := SectoredToFlat(Stream.Position); +end; + +function TJclSectoredStream.FlatToSectored(const Position: Int64): Int64; +begin + Result := (Position div BufferSize) * (Int64(BufferSize) + FSectorOverHead) // add overheads of previous buffers + + (Position mod BufferSize); // offset in sector +end; + +procedure TJclSectoredStream.Flush; +begin + if (Stream <> nil) and (FBufferMaxModifiedPos > 0) then + begin + BeforeBlockWrite; + + Stream.Position := FlatToSectored(FBufferStart); + Stream.WriteBuffer(FBuffer[0], FBufferCurrentSize + FSectorOverHead); + FBufferMaxModifiedPos := 0; + end; +end; + +function TJclSectoredStream.GetCalcedSize: Int64; +var + VirtualSize: Int64; +begin + if Assigned(Stream) then + Result := SectoredToFlat(Stream.Size) + else + Result := 0; + VirtualSize := FBufferMaxModifiedPos + FBufferStart; + if Result < VirtualSize then + Result := VirtualSize; +end; + +function TJclSectoredStream.LoadBuffer: Boolean; +var + TotalSectorSize: Longint; +begin + Flush; + TotalSectorSize := FBufferSize + FSectorOverHead; + if Length(FBuffer) <> TotalSectorSize then + SetLength(FBuffer, TotalSectorSize); + FBufferStart := (FPosition div BufferSize) * BufferSize; + if Stream <> nil then + begin + Stream.Position := FlatToSectored(FBufferStart); + FBufferCurrentSize := Stream.Read(FBuffer[0], TotalSectorSize); + if FBufferCurrentSize > 0 then + begin + Dec(FBufferCurrentSize, FSectorOverHead); + AfterBlockRead; + end; + end + else + FBufferCurrentSize := 0; + Result := (FBufferCurrentSize > 0); +end; + +function TJclSectoredStream.SectoredToFlat(const Position: Int64): Int64; +var + TotalSectorSize: Int64; +begin + TotalSectorSize := Int64(BufferSize) + FSectorOverHead; + Result := (Position div TotalSectorSize) * BufferSize // remove previous overheads + + Position mod TotalSectorSize; // offset in sector +end; + +procedure TJclSectoredStream.SetSize(const NewSize: Int64); +begin + inherited SetSize(FlatToSectored(NewSize)); +end; + +//=== { TJclCRC16Stream } ==================================================== + +procedure TJclCRC16Stream.AfterBlockRead; +var + CRC: Word; +begin + CRC := Word(FBuffer[FBufferCurrentSize]) or (Word(FBuffer[FBufferCurrentSize + 1]) shl 8); + if CheckCrc16(FBuffer, FBufferCurrentSize, CRC) < 0 then + raise EJclStreamError.CreateRes(@RsStreamsCRCError); +end; + +procedure TJclCRC16Stream.BeforeBlockWrite; +var + CRC: Word; +begin + CRC := Crc16(FBuffer, FBufferCurrentSize); + FBuffer[FBufferCurrentSize] := CRC and $FF; + FBuffer[FBufferCurrentSize + 1] := CRC shr 8; +end; + +constructor TJclCRC16Stream.Create(AStorageStream: TStream; AOwnsStream: Boolean); +begin + inherited Create(AStorageStream, AOwnsStream, 2); +end; + +//=== { TJclCRC32Stream } ==================================================== + +procedure TJclCRC32Stream.AfterBlockRead; +var + CRC: Cardinal; +begin + CRC := Cardinal(FBuffer[FBufferCurrentSize]) or (Cardinal(FBuffer[FBufferCurrentSize + 1]) shl 8) + or (Cardinal(FBuffer[FBufferCurrentSize + 2]) shl 16) or (Cardinal(FBuffer[FBufferCurrentSize + 3]) shl 24); + if CheckCrc32(FBuffer, FBufferCurrentSize, CRC) < 0 then + raise EJclStreamError.CreateRes(@RsStreamsCRCError); +end; + +procedure TJclCRC32Stream.BeforeBlockWrite; +var + CRC: Cardinal; +begin + CRC := Crc32(FBuffer, FBufferCurrentSize); + FBuffer[FBufferCurrentSize] := CRC and $FF; + FBuffer[FBufferCurrentSize + 1] := (CRC shr 8) and $FF; + FBuffer[FBufferCurrentSize + 2] := (CRC shr 16) and $FF; + FBuffer[FBufferCurrentSize + 3] := (CRC shr 24) and $FF; +end; + +constructor TJclCRC32Stream.Create(AStorageStream: TStream; + AOwnsStream: Boolean); +begin + inherited Create(AStorageStream, AOwnsStream, 4); +end; + +//=== { TJclSplitStream } ==================================================== + +constructor TJclSplitStream.Create(AForcePosition: Boolean); +begin + inherited Create; + FVolume := nil; + FVolumeIndex := -1; + FVolumeMaxSize := 0; + FPosition := 0; + FVolumePosition := 0; + FForcePosition := AForcePosition; +end; + +function TJclSplitStream.GetSize: Int64; +var + OldVolumeIndex: Integer; + OldVolumePosition, OldPosition: Int64; +begin + OldVolumeIndex := FVolumeIndex; + OldVolumePosition := FVolumePosition; + OldPosition := FPosition; + + Result := 0; + try + FVolumeIndex := -1; + repeat + if not InternalLoadVolume(FVolumeIndex + 1) then + Break; + Result := Result + FVolume.Size; + until FVolume.Size = 0; + finally + InternalLoadVolume(OldVolumeIndex); + FPosition := OldPosition; + if Assigned(FVolume) then + FVolumePosition := FVolume.Seek(OldVolumePosition, soBeginning); + end; +end; + +function TJclSplitStream.InternalLoadVolume(Index: Integer): Boolean; +var + OldVolumeIndex: Integer; + OldVolumePosition: Int64; + OldVolume: TStream; +begin + if Index = -1 then + Index := 0; + if Index <> FVolumeIndex then + begin + // save current pointers + OldVolumeIndex := FVolumeIndex; + OldVolumePosition := FVolumePosition; + OldVolume := FVolume; + + FVolumeIndex := Index; + FVolumePosition := 0; + FVolume := GetVolume(Index); + Result := Assigned(FVolume); + if Result then begin + FVolumeMaxSize := GetVolumeMaxSize(Index); + FVolume.Seek(0, soBeginning) + end + else + begin + // restore old pointers if volume load failed + FVolumeIndex := OldVolumeIndex; + FVolumePosition := OldVolumePosition; + FVolume := OldVolume; + end; + end + else + Result := Assigned(FVolume); +end; + +function TJclSplitStream.Read(var Buffer; Count: Longint): Longint; +var + Data: PByte; + Total, LoopRead: Longint; +begin + Result := 0; + + if not InternalLoadVolume(FVolumeIndex) then + Exit; + + Data := PByte(@Buffer); + Total := Count; + + repeat + // force position + if ForcePosition then + FVolume.Seek(FVolumePosition, soBeginning); + + // try to read (Count) bytes from current stream + LoopRead := FVolume.Read(Data^, Count); + FVolumePosition := FVolumePosition + LoopRead; + FPosition := FPosition + LoopRead; + Inc(Result, LoopRead); + if Result = Total then + Break; + + // with next volume + Dec(Count, LoopRead); + Inc(Data, LoopRead); + if not InternalLoadVolume(FVolumeIndex + 1) then + Break; + until False; +end; + +function TJclSplitStream.Seek(const Offset: Int64; + Origin: TSeekOrigin): Int64; +var + ExpectedPosition, RemainingOffset: Int64; +begin + case TSeekOrigin(Origin) of + soBeginning: + ExpectedPosition := Offset; + soCurrent: + ExpectedPosition := FPosition + Offset; + soEnd: + ExpectedPosition := Size + Offset; + else + raise EJclStreamError.CreateRes(@RsStreamsSeekError); + end; + RemainingOffset := ExpectedPosition - FPosition; + Result := FPosition; + repeat + if not InternalLoadVolume(FVolumeIndex) then + Break; + + if RemainingOffset < 0 then + begin + // FPosition > ExpectedPosition, seek backward + if FVolumePosition >= -RemainingOffset then + begin + // seek in current volume + FVolumePosition := FVolume.Seek(FVolumePosition + RemainingOffset, soBeginning); + Result := Result + RemainingOffset; + FPosition := Result; + RemainingOffset := 0; + end + else + begin + // seek to previous volume + if FVolumeIndex = 0 then + Exit; + // seek to the beginning of current volume + RemainingOffset := RemainingOffset + FVolumePosition; + Result := Result - FVolumePosition; + FPosition := Result; + FVolumePosition := FVolume.Seek(0, soBeginning); + // load previous volume + if not InternalLoadVolume(FVolumeIndex - 1) then + Break; + Result := Result - FVolume.Size; + FPosition := Result; + RemainingOffset := RemainingOffset + FVolume.Size; + end; + end + else if RemainingOffset > 0 then + begin + // FPosition < ExpectedPosition, seek forward + if (FVolumeMaxSize = 0) or ((FVolumePosition + RemainingOffset) < FVolumeMaxSize) then + begin + // can seek in current volume + FVolumePosition := FVolume.Seek(FVolumePosition + RemainingOffset, soBeginning); + Result := Result + RemainingOffset; + FPosition := Result; + RemainingOffset := 0; + end + else + begin + // seek to next volume + RemainingOffset := RemainingOffset - FVolumeMaxSize + FVolumePosition; + Result := Result + FVolumeMaxSize - FVolumePosition; + FPosition := Result; + if not InternalLoadVolume(FVolumeIndex + 1) then begin + FVolumePosition := FVolumeMaxSize; + Break; + end; + end; + end; + until RemainingOffset = 0; +end; + +procedure TJclSplitStream.SetSize(const NewSize: Int64); +var + OldVolumeIndex: Integer; + OldVolumePosition, OldPosition, RemainingSize, VolumeSize: Int64; +begin + OldVolumeIndex := FVolumeIndex; + OldVolumePosition := FVolumePosition; + OldPosition := FPosition; + + RemainingSize := NewSize; + try + FVolumeIndex := 0; + repeat + if not InternalLoadVolume(FVolumeIndex) then + Break; + if (FVolumeMaxSize > 0) and (RemainingSize > FVolumeMaxSize) then + VolumeSize := FVolumeMaxSize + else + VolumeSize := RemainingSize; + FVolume.Size := VolumeSize; + RemainingSize := RemainingSize - VolumeSize; + + Inc(FVolumeIndex); + until RemainingSize = 0; + finally + InternalLoadVolume(OldVolumeIndex); + FPosition := OldPosition; + if Assigned(FVolume) then + FVolumePosition := FVolume.Seek(OldVolumePosition, soBeginning); + end; +end; + +function TJclSplitStream.Write(const Buffer; Count: Longint): Longint; +var + Data: PByte; + Total, LoopWritten: Longint; +begin + Result := 0; + + if not InternalLoadVolume(FVolumeIndex) then + Exit; + + Data := PByte(@Buffer); + Total := Count; + + repeat + // force position + if ForcePosition then + FVolume.Seek(FVolumePosition, soBeginning); + + // do not write more than (VolumeMaxSize) bytes in current stream + if (FVolumeMaxSize > 0) and ((Count + FVolumePosition) > FVolumeMaxSize) then + LoopWritten := FVolumeMaxSize - FVolumePosition + else + LoopWritten := Count; + // try to write (Count) bytes from current stream + LoopWritten := FVolume.Write(Data^, LoopWritten); + FVolumePosition := FVolumePosition + LoopWritten; + FPosition := FPosition + LoopWritten; + Inc(Result, LoopWritten); + if Result = Total then + Break; + + // with next volume + Dec(Count, LoopWritten); + Inc(Data, LoopWritten); + if not InternalLoadVolume(FVolumeIndex + 1) then + Break; + until False; +end; + +//=== { TJclDynamicSplitStream } ============================================= + +function TJclDynamicSplitStream.GetVolume(Index: Integer): TStream; +begin + if Assigned(FOnVolume) then + Result := FOnVolume(Index) + else + Result := nil; +end; + +function TJclDynamicSplitStream.GetVolumeMaxSize(Index: Integer): Int64; +begin + if Assigned(FOnVolumeMaxSize) then + Result := FOnVolumeMaxSize(Index) + else + Result := 0; +end; + +//=== { TJclStaticSplitStream } =========================================== + +constructor TJclStaticSplitStream.Create(AForcePosition: Boolean); +begin + inherited Create(AForcePosition); + FVolumes := TObjectList.Create(True); +end; + +destructor TJclStaticSplitStream.Destroy; +var + Index: Integer; + AVolumeRec: TJclSplitVolume; +begin + if Assigned(FVolumes) then + begin + for Index := 0 to FVolumes.Count - 1 do + begin + AVolumeRec := TJclSplitVolume(FVolumes.Items[Index]); + if AVolumeRec.OwnStream then + AVolumeRec.Stream.Free; + end; + FVolumes.Free; + end; + inherited Destroy; +end; + +function TJclStaticSplitStream.AddVolume(AStream: TStream; AMaxSize: Int64; + AOwnStream: Boolean): Integer; +var + AVolumeRec: TJclSplitVolume; +begin + AVolumeRec := TJclSplitVolume.Create; + AVolumeRec.MaxSize := AMaxSize; + AVolumeRec.Stream := AStream; + AVolumeRec.OwnStream := AOwnStream; + Result := FVolumes.Add(AVolumeRec); +end; + +function TJclStaticSplitStream.GetVolume(Index: Integer): TStream; +begin + Result := TJclSplitVolume(FVolumes.Items[Index]).Stream; +end; + +function TJclStaticSplitStream.GetVolumeCount: Integer; +begin + Result := FVolumes.Count; +end; + +function TJclStaticSplitStream.GetVolumeMaxSize(Index: Integer): Int64; +begin + Result := TJclSplitVolume(FVolumes.Items[Index]).MaxSize; +end; + +//=== { TJclStringStream } ==================================================== + +constructor TJclStringStream.Create(AStream: TStream; AOwnsStream: Boolean); +begin + inherited Create; + FStream := AStream; + FOwnStream := AOwnsStream; + FBufferSize := StreamDefaultBufferSize; + + // Must call this method so that buffer initial values are properly set. + // This is most useful when AStream is not located at position zero + // before being used by us. + InvalidateBuffers; +end; + +destructor TJclStringStream.Destroy; +begin + Flush; + if FOwnStream then + FStream.Free; + inherited; +end; + +procedure TJclStringStream.Flush; +begin + if FStrBufferModifiedSize > 0 then + begin + FStream.Position := FStrBufferStart; + InternalSetNextBuffer(FStream, FStrBuffer, 0, FStrBufferModifiedSize); + FStrBufferNext := FStream.Seek(0, soCurrent); + FStrBufferModifiedSize := 0; + end; +end; + +function TJclStringStream.InternalGetNextBuffer(S: TStream; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; +var + Ch: UCS4; +begin + // override to optimize + Result := 0; + while Count > 0 do + begin + if InternalGetNextChar(S, Ch) then + begin + Buffer[Start] := Ch; + Inc(Start); + Inc(Result); + end + else + Break; + Dec(Count); + end; +end; + +function TJclStringStream.InternalSetNextBuffer(S: TStream; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; +begin + // override to optimize + Result := 0; + while Count > 0 do + begin + if InternalSetNextChar(S, Buffer[Start]) then + begin + Inc(Start); + Inc(Result); + end + else + Break; + Dec(Count); + end; +end; + +procedure TJclStringStream.InvalidateBuffers; +begin + FStrBufferStart := FStream.Seek(0, soCurrent); + FStrBufferNext := FStrBufferStart; + FStrBufferPosition := 0; + FStrBufferCurrentSize := 0; + FStrBufferModifiedSize := 0; + FStrPeekBufferStart := FStrBufferStart; + FStrPeekBufferNext := FStrBufferNext; + FStrPeekPosition := 0; + FStrPeekBufferCurrentSize := 0; +end; + +function TJclStringStream.LoadBuffer: Boolean; +begin + Flush; + // first test if the peek buffer contains the value + if (FStrBufferNext >= FStrPeekBufferStart) and (FStrBufferNext < FStrPeekBufferNext) then + begin + // the requested buffer is already loaded in the peek buffer + FStrBufferStart := FStrPeekBufferStart; + FStrBufferNext := FStrPeekBufferNext; + if Length(FStrBuffer) <> Length(FStrPeekBuffer) then + SetLength(FStrBuffer, Length(FStrPeekBuffer)); + FStrBufferPosition := FStrPeekBufferPosition; + FStrBufferCurrentSize := FStrPeekBufferCurrentSize; + Move(FStrPeekBuffer[0], FStrBuffer[0], FStrBufferCurrentSize * SizeOf(FStrBuffer[0])); + end + else + begin + // load a new buffer + if Length(FStrBuffer) <> FBufferSize then + SetLength(FStrBuffer, FBufferSize); + Inc(FStrBufferPosition, FStrBufferCurrentSize); + FStrBufferStart := FStrBufferNext; + FStream.Seek(FStrBufferStart, soBeginning); + FStrBufferCurrentSize := InternalGetNextBuffer(FStream, FStrBuffer, 0, FBufferSize); + FStrBufferNext := FStream.Seek(0, soCurrent); + // reset the peek buffer + FStrPeekBufferPosition := FStrBufferPosition + FStrBufferCurrentSize; + FStrPeekBufferCurrentSize := 0; + FStrPeekBufferNext := FStrBufferNext; + FStrPeekBufferStart := FStrBufferNext; + end; + Result := (FStrPosition >= FStrBufferPosition) and (FStrPosition < (FStrBufferPosition + FStrBufferCurrentSize)); +end; + +function TJclStringStream.LoadPeekBuffer: Boolean; +begin + if Length(FStrPeekBuffer) <> FBufferSize then + SetLength(FStrPeekBuffer, FBufferSize); + if FStrPeekBufferPosition > FStrPeekPosition then + begin + // the peek position is rolling back, load the buffer after the read buffer + FStrPeekBufferPosition := FStrBufferPosition; + FStrPeekBufferCurrentSize := FStrBufferCurrentSize; + FStrPeekBufferStart := FStrBufferStart; + FStrPeekBufferNext := FStrBufferNext; + end; + FStrPeekBufferStart := FStrPeekBufferNext; + Inc(FStrPeekBufferPosition, FStrPeekBufferCurrentSize); + FStream.Seek(FStrPeekBufferStart, soBeginning); + FStrPeekBufferCurrentSize := InternalGetNextBuffer(FStream, FStrPeekBuffer, 0, FBufferSize); + FStrPeekBufferNext := FStream.Seek(0, soCurrent); + Result := (FStrPeekPosition >= FStrPeekBufferPosition) and (FStrPeekPosition < (FStrPeekBufferPosition + FStrPeekBufferCurrentSize)); +end; + +function TJclStringStream.PeekAnsiChar(out Buffer: AnsiChar): Boolean; +var + Ch: UCS4; +begin + Result := PeekUCS4(Ch); + if Result then + Buffer := UCS4ToAnsiChar(Ch); +end; + +function TJclStringStream.PeekChar(out Buffer: Char): Boolean; +var + Ch: UCS4; +begin + Result := PeekUCS4(Ch); + if Result then + Buffer := UCS4ToChar(Ch); +end; + +function TJclStringStream.PeekUCS4(out Buffer: UCS4): Boolean; +begin + if (FStrPeekPosition >= FStrPeekBufferPosition) and (FStrPeekPosition < (FStrPeekBufferPosition + FStrPeekBufferCurrentSize)) then + begin + // read from the peek buffer + Result := True; + Buffer := FStrPeekBuffer[FStrPeekPosition - FStrPeekBufferPosition]; + Inc(FStrPeekPosition); + end + else + if (FStrPeekPosition >= FStrBufferPosition) and (FStrPeekPosition < (FStrBufferPosition + FStrBufferCurrentSize)) then + begin + // read from the read/write buffer + Result := True; + Buffer := FStrBuffer[FStrPeekPosition - FStrBufferPosition]; + Inc(FStrPeekPosition); + end + else + begin + // load a new peek buffer + Result := LoadPeekBuffer; + if Result then + begin + Buffer := FStrPeekBuffer[FStrPeekPosition - FStrPeekBufferPosition]; + Inc(FStrPeekPosition); + end; + end; +end; + +function TJclStringStream.PeekWideChar(out Buffer: WideChar): Boolean; +var + Ch: UCS4; +begin + Result := PeekUCS4(Ch); + if Result then + Buffer := UCS4ToWideChar(Ch); +end; + +function TJclStringStream.ReadString(var Buffer: string; Start, Count: Longint): Longint; +var + Index: Integer; + StrPos: SizeInt; + Ch: UCS4; +begin + Index := Start; + while Index < Start + Count - 1 do // avoid overflow on surrogate pairs for WideString + begin + if ReadUCS4(Ch) then + begin + StrPos := Index; + if StringSetNextChar(Buffer, StrPos, Ch) and (StrPos > 0) then + Index := StrPos + else + Break; // end of string (write) + end + else + Break; // end of stream (read) + end; + Result := Index - Start; +end; + +function TJclStringStream.ReadString(BufferSize: Longint): string; +var + Buffer: string; + ProcessedLength: Longint; +begin + Result := ''; + SetLength(Buffer, BufferSize); + repeat + ProcessedLength := ReadString(Buffer, 1, BufferSize); + if ProcessedLength > 0 then + Result := Result + Copy(Buffer, 1, ProcessedLength); + until ProcessedLength = 0; +end; + +function TJclStringStream.ReadAnsiChar(out Buffer: AnsiChar): Boolean; +var + Ch: UCS4; +begin + Result := ReadUCS4(Ch); + if Result then + Buffer := UCS4ToAnsiChar(Ch); +end; + +function TJclStringStream.ReadAnsiString(var Buffer: AnsiString; Start, Count: Longint): Longint; +var + Index: Integer; + StrPos: SizeInt; + Ch: UCS4; +begin + Index := Start; + while Index < Start + Count do + begin + if ReadUCS4(Ch) then + begin + StrPos := Index; + if AnsiSetNextChar(Buffer, StrPos, Ch) and (StrPos > 0) then + Index := StrPos + else + Break; // end of string (write) + end + else + Break; // end of stream (read) + end; + Result := Index - Start; +end; + +function TJclStringStream.ReadAnsiString(BufferSize: Longint): AnsiString; +var + Buffer: AnsiString; + ProcessedLength: Longint; +begin + Result := ''; + SetLength(Buffer, BufferSize); + repeat + ProcessedLength := ReadAnsiString(Buffer, 1, BufferSize); + if ProcessedLength > 0 then + Result := Result + Copy(Buffer, 1, ProcessedLength); + until ProcessedLength = 0; +end; + +function TJclStringStream.ReadChar(out Buffer: Char): Boolean; +var + Ch: UCS4; +begin + Result := ReadUCS4(Ch); + if Result then + Buffer := UCS4ToChar(Ch); +end; + +function TJclStringStream.ReadUCS4(out Buffer: UCS4): Boolean; +begin + if (FStrPosition >= FStrBufferPosition) and (FStrPosition < (FStrBufferPosition + FStrBufferCurrentSize)) then + begin + // load from buffer + Result := True; + Buffer := FStrBuffer[FStrPosition - FStrBufferPosition]; + Inc(FStrPosition); + end + else + begin + // load a new buffer + Result := LoadBuffer; + if Result then + begin + Buffer := FStrBuffer[FStrPosition - FStrBufferPosition]; + Inc(FStrPosition); + end; + end; + FStrPeekPosition := FStrPosition; +end; + +function TJclStringStream.ReadWideChar(out Buffer: WideChar): Boolean; +var + Ch: UCS4; +begin + Result := ReadUCS4(Ch); + if Result then + Buffer := UCS4ToWideChar(Ch); +end; + +function TJclStringStream.ReadWideString(var Buffer: WideString; Start, Count: Longint): Longint; +var + Index: Integer; + StrPos: SizeInt; + Ch: UCS4; +begin + Index := Start; + while Index < Start + Count - 1 do // avoid overflow on surrogate pairs + begin + if ReadUCS4(Ch) then + begin + StrPos := Index; + if UTF16SetNextChar(Buffer, StrPos, Ch) and (StrPos > 0) then + Index := StrPos + else + Break; // end of string (write) + end + else + Break; // end of stream (read) + end; + Result := Index - Start; +end; + +function TJclStringStream.ReadWideString(BufferSize: Longint): WideString; +var + Buffer: WideString; + ProcessedLength: Longint; +begin + Result := ''; + SetLength(Buffer, BufferSize); + repeat + ProcessedLength := ReadWideString(Buffer, 1, BufferSize); + if ProcessedLength > 0 then + Result := Result + Copy(Buffer, 1, ProcessedLength); + until ProcessedLength = 0; +end; + +function TJclStringStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; +begin + case Origin of + soBeginning: + if Offset = 0 then + begin + Flush; + FStrPosition := 0; + FStrBufferPosition := 0; + FStrBufferCurrentSize := 0; + FStrBufferStart := 0; + FStrBufferNext := 0; + FStrPeekBufferPosition := 0; + FStrPeekBufferCurrentSize := 0; + FStrPeekBufferStart := 0; + FStrPeekBufferNext := 0; + end + else + raise EJclStreamError.CreateRes(@RsStreamsSeekError); + soCurrent: + if Offset <> 0 then + raise EJclStreamError.CreateRes(@RsStreamsSeekError); + soEnd: + raise EJclStreamError.CreateRes(@RsStreamsSeekError); + end; + Result := FStrPosition; + FStrPeekPosition := FStrPosition; +end; + +function TJclStringStream.SkipBOM: Longint; +var + Pos: Int64; + I: Integer; + BOM: array of Byte; +begin + if Length(FBOM) > 0 then + begin + Pos := FStream.Seek(0, soCurrent); + SetLength(BOM, Length(FBOM)); + Result := FStream.Read(BOM[0], Length(BOM) * SizeOf(BOM[0])); + if Result = Length(FBOM) * SizeOf(FBOM[0]) then + for I := Low(FBOM) to High(FBOM) do + if BOM[I - Low(FBOM)] <> FBOM[I] then + Result := 0; + if Result <> Length(FBOM) * SizeOf(FBOM[0]) then + FStream.Seek(Pos, soBeginning); + end + else + Result := 0; + InvalidateBuffers; +end; + +function TJclStringStream.WriteBOM: Longint; +begin + if Length(FBOM) > 0 then + Result := FStream.Write(FBOM[0], Length(FBOM) * SizeOf(FBOM[0])) + else + Result := 0; + InvalidateBuffers; +end; + +function TJclStringStream.WriteChar(Value: Char): Boolean; +begin + Result := WriteUCS4(CharToUCS4(Value)); +end; + +function TJclStringStream.WriteString(const Buffer: string; Start, Count: Longint): Longint; +var + Index: Integer; + StrPos: SizeInt; + Ch: UCS4; +begin + Index := Start; + while Index < Start + Count do + begin + StrPos := Index; + Ch := StringGetNextChar(Buffer, StrPos); + if (StrPos > 0) and WriteUCS4(Ch) then + Index := StrPos + else + Break; // end of string (read) or end of stream (write) + end; + Result := Index - Start; +end; + +function TJclStringStream.WriteAnsiChar(Value: AnsiChar): Boolean; +begin + Result := WriteUCS4(AnsiCharToUCS4(Value)); +end; + +function TJclStringStream.WriteAnsiString(const Buffer: AnsiString; Start, Count: Longint): Longint; +var + Index: Integer; + StrPos: SizeInt; + Ch: UCS4; +begin + Index := Start; + while Index < Start + Count do + begin + StrPos := Index; + Ch := AnsiGetNextChar(Buffer, StrPos); + if (StrPos > 0) and WriteUCS4(Ch) then + Index := StrPos + else + Break; // end of string (read) or end of stream (write) + end; + Result := Index - Start; +end; + +function TJclStringStream.WriteUCS4(Value: UCS4): Boolean; +var + BufferPos: Int64; +begin + if FStrPosition >= (FStrBufferPosition + FBufferSize) then + // load the next buffer first + LoadBuffer; + // write to current buffer + BufferPos := FStrPosition - FStrBufferPosition; + Result := True; + if Length(FStrBuffer) <> FBufferSize then + SetLength(FStrBuffer, FBufferSize); + FStrBuffer[BufferPos] := Value; + Inc(FStrPosition); + Inc(BufferPos); + if FStrBufferModifiedSize < BufferPos then + FStrBufferModifiedSize := BufferPos; + if FStrBufferCurrentSize < BufferPos then + FStrBufferCurrentSize := BufferPos; + FStrPeekPosition := FStrPosition; +end; + +function TJclStringStream.WriteWideChar(Value: WideChar): Boolean; +begin + Result := WriteUCS4(WideCharToUCS4(Value)); +end; + +function TJclStringStream.WriteWideString(const Buffer: WideString; Start, Count: Longint): Longint; +var + Index: Integer; + StrPos: SizeInt; + Ch: UCS4; +begin + Index := Start; + while Index < Start + Count do + begin + StrPos := Index; + Ch := UTF16GetNextChar(Buffer, StrPos); + if (StrPos > 0) and WriteUCS4(Ch) then + Index := StrPos + else + Break; // end of string (read) or end of stream (write) + end; + Result := Index - Start; +end; + +//=== { TJclAnsiStream } ====================================================== + +constructor TJclAnsiStream.Create(AStream: TStream; AOwnsStream: Boolean); +begin + inherited Create(AStream, AOwnsStream); + SetLength(FBOM, 0); + FCodePage := CP_ACP; +end; + +function TJclAnsiStream.InternalGetNextBuffer(S: TStream; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; +begin + if FCodePage = CP_ACP then + Result := AnsiGetNextBufferFromStream(S, Buffer, Start, Count) + else + Result := AnsiGetNextBufferFromStream(S, FCodePage, Buffer, Start, Count); +end; + +function TJclAnsiStream.InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; +begin + if FCodePage = CP_ACP then + Result := AnsiGetNextCharFromStream(S, Ch) + else + Result := AnsiGetNextCharFromStream(S, FCodePage, Ch); +end; + +function TJclAnsiStream.InternalSetNextBuffer(S: TStream; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; +begin + if FCodePage = CP_ACP then + Result := AnsiSetNextBufferToStream(S, Buffer, Start, Count) + else + Result := AnsiSetNextBufferToStream(S, FCodePage, Buffer, Start, Count); +end; + +function TJclAnsiStream.InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; +begin + if FCodePage = CP_ACP then + Result := AnsiSetNextCharToStream(S, Ch) + else + Result := AnsiSetNextCharToStream(S, FCodePage, Ch); +end; + +//=== { TJclUTF8Stream } ====================================================== + +constructor TJclUTF8Stream.Create(AStream: TStream; AOwnsStream: Boolean); +var + I: Integer; +begin + inherited Create(AStream, AOwnsStream); + SetLength(FBOM, Length(BOM_UTF8)); + for I := Low(BOM_UTF8) to High(BOM_UTF8) do + FBOM[I - Low(BOM_UTF8)] := BOM_UTF8[I]; +end; + +function TJclUTF8Stream.InternalGetNextBuffer(S: TStream; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; +begin + Result := UTF8GetNextBufferFromStream(S, Buffer, Start, Count); +end; + +function TJclUTF8Stream.InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; +begin + Result := UTF8GetNextCharFromStream(S, Ch); +end; + +function TJclUTF8Stream.InternalSetNextBuffer(S: TStream; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; +begin + Result := UTF8SetNextBufferToStream(S, Buffer, Start, Count); +end; + +function TJclUTF8Stream.InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; +begin + Result := UTF8SetNextCharToStream(S, Ch); +end; + +//=== { TJclUTF16Stream } ===================================================== + +constructor TJclUTF16Stream.Create(AStream: TStream; AOwnsStream: Boolean); +var + I: Integer; +begin + inherited Create(AStream, AOwnsStream); + SetLength(FBOM, Length(BOM_UTF16_LSB)); + for I := Low(BOM_UTF16_LSB) to High(BOM_UTF16_LSB) do + FBOM[I - Low(BOM_UTF16_LSB)] := BOM_UTF16_LSB[I]; +end; + +function TJclUTF16Stream.InternalGetNextBuffer(S: TStream; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; +begin + Result := UTF16GetNextBufferFromStream(S, Buffer, Start, Count); +end; + +function TJclUTF16Stream.InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; +begin + Result := UTF16GetNextCharFromStream(S, Ch); +end; + +function TJclUTF16Stream.InternalSetNextBuffer(S: TStream; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; +begin + Result := UTF16SetNextBufferToStream(S, Buffer, Start, Count); +end; + +function TJclUTF16Stream.InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; +begin + Result := UTF16SetNextCharToStream(S, Ch); +end; + +//=== { TJclAutoStream } ====================================================== + +constructor TJclAutoStream.Create(AStream: TStream; AOwnsStream: Boolean); +var + I, MaxLength, ReadLength: Integer; + BOM: array of Byte; +begin + inherited Create(AStream, AOwnsStream); + MaxLength := Length(BOM_UTF8); + if MaxLength < Length(BOM_UTF16_LSB) then + MaxLength := Length(BOM_UTF16_LSB); + + SetLength(BOM, MaxLength); + ReadLength := FStream.Read(BOM[0], Length(BOM) * SizeOf(BOM[0])) div SizeOf(BOM[0]); + + FEncoding := seAuto; + + // try UTF8 BOM + if (FEncoding = seAuto) and (ReadLength >= Length(BOM_UTF8) * SizeOf(BOM_UTF8[0])) then + begin + FCodePage := CP_UTF8; + FEncoding := seUTF8; + for I := Low(BOM_UTF8) to High(BOM_UTF8) do + if BOM[I - Low(BOM_UTF8)] <> BOM_UTF8[I] then + begin + FEncoding := seAuto; + Break; + end; + end; + + // try UTF16 BOM + if (FEncoding = seAuto) and (ReadLength >= Length(BOM_UTF16_LSB) * SizeOf(BOM_UTF16_LSB[0])) then + begin + FCodePage := CP_UTF16LE; + FEncoding := seUTF16; + for I := Low(BOM_UTF16_LSB) to High(BOM_UTF16_LSB) do + if BOM[I - Low(BOM_UTF8)] <> BOM_UTF16_LSB[I] then + begin + FEncoding := seAuto; + Break; + end; + end; + + case FEncoding of + seUTF8: + begin + FCodePage := CP_UTF8; + SetLength(FBOM, Length(BOM_UTF8)); + for I := Low(BOM_UTF8) to High(BOM_UTF8) do + FBOM[I - Low(BOM_UTF8)] := BOM_UTF8[I]; + end; + seUTF16: + begin + FCodePage := CP_UTF16LE; + SetLength(FBOM, Length(BOM_UTF16_LSB)); + for I := Low(BOM_UTF16_LSB) to High(BOM_UTF16_LSB) do + FBOM[I - Low(BOM_UTF16_LSB)] := BOM_UTF16_LSB[I]; + end; + seAuto, + seAnsi: + begin + // defaults to Ansi + FCodePage := CP_ACP; + FEncoding := seAnsi; + SetLength(FBOM, 0); + end; + end; + FStream.Seek(Length(FBOM) - ReadLength, soCurrent); + InvalidateBuffers; +end; + +function TJclAutoStream.InternalGetNextBuffer(S: TStream; + var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; +begin + case FCodePage of + CP_UTF8: + Result := UTF8GetNextBufferFromStream(S, Buffer, Start, Count); + CP_UTF16LE: + Result := UTF16GetNextBufferFromStream(S, Buffer, Start, Count); + CP_ACP: + Result := AnsiGetNextBufferFromStream(S, Buffer, Start, Count); + else + Result := AnsiGetNextBufferFromStream(S, CodePage, Buffer, Start, Count); + end; +end; + +function TJclAutoStream.InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; +begin + case FCodePage of + CP_UTF8: + Result := UTF8GetNextCharFromStream(S, Ch); + CP_UTF16LE: + Result := UTF16GetNextCharFromStream(S, Ch); + CP_ACP: + Result := AnsiGetNextCharFromStream(S, Ch); + else + Result := AnsiGetNextCharFromStream(S, CodePage, Ch); + end; +end; + +function TJclAutoStream.InternalSetNextBuffer(S: TStream; + const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; +begin + case FCodePage of + CP_UTF8: + Result := UTF8SetNextBufferToStream(S, Buffer, Start, Count); + CP_UTF16LE: + Result := UTF16SetNextBufferToStream(S, Buffer, Start, Count); + CP_ACP: + Result := AnsiSetNextBufferToStream(S, Buffer, Start, Count); + else + Result := AnsiSetNextBufferToStream(S, CodePage, Buffer, Start, Count); + end; +end; + +function TJclAutoStream.InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; +begin + case FCodePage of + CP_UTF8: + Result := UTF8SetNextCharToStream(S, Ch); + CP_UTF16LE: + Result := UTF16SetNextCharToStream(S, Ch); + CP_ACP: + Result := AnsiSetNextCharToStream(S, Ch); + else + Result := AnsiSetNextCharToStream(S, CodePage, Ch); + end; +end; + +procedure TJclAutoStream.SetCodePage(Value: Word); +begin + if Value = CP_UTF8 then + FEncoding := seUTF8 + else + if Value = CP_UTF16LE then + FEncoding := seUTF16 + else + if Value = CP_ACP then + FEncoding := seAnsi + else + FEncoding := seAuto; + FCodePage := Value; +end; + +function TJclAutoStream.SkipBOM: LongInt; +begin + // already skipped to determine encoding + Result := 0; + InvalidateBuffers; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclStringConversions.pas b/3rdParty/JCL/source/common/JclStringConversions.pas index 1ee596f5..8efe8775 100644 --- a/3rdParty/JCL/source/common/JclStringConversions.pas +++ b/3rdParty/JCL/source/common/JclStringConversions.pas @@ -1,3885 +1,3885 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is JclUnicode.pas. } -{ } -{ The Initial Developer of the Original Code is Mike Lischke (public att lischke-online dott de). } -{ Portions created by Mike Lischke are Copyright (C) 1999-2000 Mike Lischke. All Rights Reserved. } -{ } -{ Contributor(s): } -{ Marcel van Brakel } -{ Andreas Hausladen (ahuser) } -{ Mike Lischke } -{ Flier Lu (flier) } -{ Robert Marquardt (marquardt) } -{ Robert Rossmair (rrossmair) } -{ Olivier Sannier (obones) } -{ Matthias Thoma (mthoma) } -{ Petr Vones (pvones) } -{ Peter Schraut (http://www.console-dev.de) } -{ Florent Ouchet (outchy) } -{ } -{**************************************************************************************************} -{ } -{ String conversion routines } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -unit JclStringConversions; - -{$I jcl.inc} - -interface - -uses - {$IFDEF HAS_UNITSCOPE} - System.Classes, - {$ELSE ~HAS_UNITSCOPE} - Classes, - {$ENDIF ~HAS_UNITSCOPE} - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - JclBase; - -type - EJclStringConversionError = class(EJclError); - EJclUnexpectedEOSequenceError = class (EJclStringConversionError) - public - constructor Create; - end; - -// conversion routines between Ansi, UTF-16, UCS-4 and UTF8 strings - -// one shot conversion between PAnsiChar and PWideChar -procedure ExpandASCIIString(const Source: PAnsiChar; Target: PWideChar; Count: SizeInt); - -// tpye of stream related functions -type - TJclStreamGetNextCharFunc = function(S: TStream; out Ch: UCS4): Boolean; - TJclStreamSkipCharsFunc = function(S: TStream; var NbSeq: SizeInt): Boolean; - TJclStreamSetNextCharFunc = function(S: TStream; Ch: UCS4): Boolean; - -// iterative conversions - -// UTF8GetNextChar = read next UTF8 sequence at StrPos -// if UNICODE_SILENT_FAILURE is defined, invalid sequences will be replaced by ReplacementCharacter -// otherwise StrPos is set to -1 on return to flag an error (invalid UTF8 sequence) -// StrPos will be incremented by the number of chars that were read -function UTF8GetNextChar(const S: TUTF8String; var StrPos: SizeInt): UCS4; -function UTF8GetNextBuffer(const S: TUTF8String; var StrPos: SizeInt; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; -function UTF8GetNextCharFromStream(S: TStream; out Ch: UCS4): Boolean; -function UTF8GetNextBufferFromStream(S: TStream; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; - -// UTF8SkipChars = skip NbSeq UTF8 sequences starting from StrPos -// returns False if String is too small -// if UNICODE_SILENT_FAILURE is not defined StrPos is set to -1 on error (invalid UTF8 sequence) -// StrPos will be incremented by the number of chars that were skipped -// On return, NbSeq contains the number of UTF8 sequences that were skipped -function UTF8SkipChars(const S: TUTF8String; var StrPos: SizeInt; var NbSeq: SizeInt): Boolean; -function UTF8SkipCharsFromStream(S: TStream; var NbSeq: SizeInt): Boolean; - -// UTF8SetNextChar = append an UTF8 sequence at StrPos -// returns False on error: -// - if an UCS4 character cannot be stored to an UTF-8 string: -// - if UNICODE_SILENT_FAILURE is defined, ReplacementCharacter is added -// - if UNICODE_SILENT_FAILURE is not defined, StrPos is set to -1 -// - StrPos > -1 flags string being too small, callee did nothing, caller is responsible for allocating space -// StrPos will be incremented by the number of chars that were written -function UTF8SetNextChar(var S: TUTF8String; var StrPos: SizeInt; Ch: UCS4): Boolean; -function UTF8SetNextBuffer(var S: TUTF8String; var StrPos: SizeInt; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; -function UTF8SetNextCharToStream(S: TStream; Ch: UCS4): Boolean; -function UTF8SetNextBufferToStream(S: TStream; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; - -// UTF16GetNextChar = read next UTF16 sequence at StrPos -// if UNICODE_SILENT_FAILURE is defined, invalid sequences will be replaced by ReplacementCharacter -// otherwise StrPos is set to -1 on return to flag an error (invalid UTF16 sequence) -// StrPos will be incremented by the number of chars that were read -function UTF16GetNextChar(const S: TUTF16String; var StrPos: SizeInt): UCS4; overload; -function UTF16GetNextBuffer(const S: TUTF16String; var StrPos: SizeInt; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; -{$IFDEF SUPPORTS_UNICODE_STRING} -function UTF16GetNextChar(const S: WideString; var StrPos: SizeInt): UCS4; overload; -function UTF16GetNextBuffer(const S: WideString; var StrPos: SizeInt; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; -{$ENDIF SUPPORTS_UNICODE_STRING} -function UTF16GetNextCharFromStream(S: TStream; out Ch: UCS4): Boolean; -function UTF16GetNextBufferFromStream(S: TStream; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; - -// UTF16GetPreviousChar = read previous UTF16 sequence starting at StrPos-1 -// if UNICODE_SILENT_FAILURE is defined, invalid sequences will be replaced by ReplacementCharacter -// otherwise StrPos is set to -1 on return to flag an error (invalid UTF16 sequence) -// StrPos will be decremented by the number of chars that were read -function UTF16GetPreviousChar(const S: TUTF16String; var StrPos: SizeInt): UCS4; overload; -{$IFDEF SUPPORTS_UNICODE_STRING} -function UTF16GetPreviousChar(const S: WideString; var StrPos: SizeInt): UCS4; overload; -{$ENDIF SUPPORTS_UNICODE_STRING} - -// UTF16SkipChars = skip NbSeq UTF16 sequences starting from StrPos -// returns False if String is too small -// if UNICODE_SILENT_FAILURE is not defined StrPos is set to -1 on error (invalid UTF16 sequence) -// StrPos will be incremented by the number of chars that were skipped -// On return, NbChar contains the number of UTF16 sequences that were skipped -function UTF16SkipChars(const S: TUTF16String; var StrPos: SizeInt; var NbSeq: SizeInt): Boolean; overload; -{$IFDEF SUPPORTS_UNICODE_STRING} -function UTF16SkipChars(const S: WideString; var StrPos: SizeInt; var NbSeq: SizeInt): Boolean; overload; -{$ENDIF SUPPORTS_UNICODE_STRING} -function UTF16SkipCharsFromStream(S: TStream; var NbSeq: SizeInt): Boolean; - -// UTF16SetNextChar = append an UTF16 sequence at StrPos -// returns False on error: -// - if an UCS4 character cannot be stored to an UTF-16 string: -// - if UNICODE_SILENT_FAILURE is defined, ReplacementCharacter is added -// - if UNICODE_SILENT_FAILURE is not defined, StrPos is set to -1 -// - StrPos > -1 flags string being too small, callee did nothing and caller is responsible for allocating space -// StrPos will be incremented by the number of chars that were written -function UTF16SetNextChar(var S: TUTF16String; var StrPos: SizeInt; Ch: UCS4): Boolean; overload; -function UTF16SetNextBuffer(var S: TUTF16String; var StrPos: SizeInt; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; -{$IFDEF SUPPORTS_UNICODE_STRING} -function UTF16SetNextChar(var S: WideString; var StrPos: SizeInt; Ch: UCS4): Boolean; overload; -function UTF16SetNextBuffer(var S: WideString; var StrPos: SizeInt; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; -{$ENDIF SUPPORTS_UNICODE_STRING} -function UTF16SetNextCharToStream(S: TStream; Ch: UCS4): Boolean; -function UTF16SetNextBufferToStream(S: TStream; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; - -// AnsiGetNextChar = read next character at StrPos -// StrPos will be incremented by the number of chars that were read (1) -function AnsiGetNextChar(const S: AnsiString; var StrPos: SizeInt): UCS4; overload; -function AnsiGetNextBuffer(const S: AnsiString; var StrPos: SizeInt; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; -function AnsiGetNextCharFromStream(S: TStream; out Ch: UCS4): Boolean; overload; -function AnsiGetNextBufferFromStream(S: TStream; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; - -// same as AnsiGetNextChar* with custom codepage -function AnsiGetNextChar(const S: AnsiString; CodePage: Word; var StrPos: SizeInt): UCS4; overload; -function AnsiGetNextBuffer(const S: AnsiString; CodePage: Word; var StrPos: SizeInt; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; -function AnsiGetNextCharFromStream(S: TStream; CodePage: Word; out Ch: UCS4): Boolean; overload; -function AnsiGetNextBufferFromStream(S: TStream; CodePage: Word; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; - -// AnsiSkipChars = skip NbSeq characters starting from StrPos -// returns False if String is too small -// StrPos will be incremented by the number of chars that were skipped -// On return, NbChar contains the number of UTF16 sequences that were skipped -function AnsiSkipChars(const S: AnsiString; var StrPos: SizeInt; var NbSeq: SizeInt): Boolean; -function AnsiSkipCharsFromStream(S: TStream; var NbSeq: SizeInt): Boolean; - -// AnsiSetNextChar = append a character at StrPos -// returns False on error: -// - if an UCS4 character cannot be stored to an ansi string: -// - if UNICODE_SILENT_FAILURE is defined, ReplacementCharacter is added -// - if UNICODE_SILENT_FAILURE is not defined, StrPos is set to -1 -// - StrPos > -1 flags string being too small, callee did nothing and caller is responsible for allocating space -// StrPos will be incremented by the number of chars that were written (1) -function AnsiSetNextChar(var S: AnsiString; var StrPos: SizeInt; Ch: UCS4): Boolean; overload; -function AnsiSetNextBuffer(var S: AnsiString; var StrPos: SizeInt; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; -function AnsiSetNextCharToStream(S: TStream; Ch: UCS4): Boolean; overload; -function AnsiSetNextBufferToStream(S: TStream; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; - -// same as AnsiSetNextChar* with custom codepage -function AnsiSetNextChar(var S: AnsiString; CodePage: Word; var StrPos: SizeInt; Ch: UCS4): Boolean; overload; -function AnsiSetNextBuffer(var S: AnsiString; CodePage: Word; var StrPos: SizeInt; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; -function AnsiSetNextCharToStream(S: TStream; CodePage: Word; Ch: UCS4): Boolean; overload; -function AnsiSetNextBufferToStream(S: TStream; CodePage: Word; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; - -// StringGetNextChar = read next character/sequence at StrPos -// if UNICODE_SILENT_FAILURE is defined, invalid sequences will be replaced by ReplacementCharacter -// otherwise StrPos is set to -1 on return to flag an error (invalid UTF16 sequence for WideString) -// StrPos will be incremented by the number of chars that were read -function StringGetNextChar(const S: string; var StrPos: SizeInt): UCS4; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function StringGetNextBuffer(const S: string; var StrPos: SizeInt; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} - -// StringSkipChars = skip NbSeq characters/sequences starting from StrPos -// returns False if String is too small -// if UNICODE_SILENT_FAILURE is not defined StrPos is set to -1 on error (invalid UTF16 sequence for WideString) -// StrPos will be incremented by the number of chars that were skipped -// On return, NbChar contains the number of UTF16 sequences that were skipped -function StringSkipChars(const S: string; var StrPos: SizeInt; var NbSeq: SizeInt): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} - -// StringSetNextChar = append a character/sequence at StrPos -// returns False on error: -// - if an UCS4 character cannot be stored to a string: -// - if UNICODE_SILENT_FAILURE is defined, ReplacementCharacter is added -// - if UNICODE_SILENT_FAILURE is not defined, StrPos is set to -1 -// - StrPos > -1 flags string being too small, callee did nothing and caller is responsible for allocating space -// StrPos will be incremented by the number of chars that were written -function StringSetNextChar(var S: string; var StrPos: SizeInt; Ch: UCS4): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function StringSetNextBuffer(var S: string; var StrPos: SizeInt; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} - -// one shot conversions between WideString and others -function WideStringToUTF8(const S: WideString): TUTF8String; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -function UTF8ToWideString(const S: TUTF8String): WideString; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -function WideStringToUCS4(const S: WideString): TUCS4Array; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -function UCS4ToWideString(const S: TUCS4Array): WideString; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} - -// one shot conversions between AnsiString and others -function AnsiStringToUTF8(const S: AnsiString): TUTF8String; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -function UTF8ToAnsiString(const S: TUTF8String): AnsiString; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -function AnsiStringToUTF16(const S: AnsiString): TUTF16String; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -function UTF16ToAnsiString(const S: TUTF16String): AnsiString; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -function AnsiStringToUCS4(const S: AnsiString): TUCS4Array; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -function UCS4ToAnsiString(const S: TUCS4Array): AnsiString; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} - -// one shot conversions between string and others -function StringToUTF8(const S: string): TUTF8String; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -function UTF8ToString(const S: TUTF8String): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -function StringToUTF16(const S: string): TUTF16String; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -function UTF16ToString(const S: TUTF16String): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -function StringToUCS4(const S: string): TUCS4Array; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -function UCS4ToString(const S: TUCS4Array): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} - -function TryStringToUTF8(const S: string; out D: TUTF8String): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -function TryUTF8ToString(const S: TUTF8String; out D: string): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -function TryStringToUTF16(const S: string; out D: TUTF16String): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -function TryUTF16ToString(const S: TUTF16String; out D: string): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -function TryStringToUCS4(const S: string; out D: TUCS4Array): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -function TryUCS4ToString(const S: TUCS4Array; out D: string): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} - -function UTF8ToUTF16(const S: TUTF8String): TUTF16String; -function UTF16ToUTF8(const S: TUTF16String): TUTF8String; -function UTF8ToUCS4(const S: TUTF8String): TUCS4Array; -function UCS4ToUTF8(const S: TUCS4Array): TUTF8String; -function UTF16ToUCS4(const S: TUTF16String): TUCS4Array; -function UCS4ToUTF16(const S: TUCS4Array): TUTF16String; - -function TryUTF8ToUTF16(const S: TUTF8String; out D: TUTF16String): Boolean; -function TryUTF16ToUTF8(const S: TUTF16String; out D: TUTF8String): Boolean; -function TryUTF8ToUCS4(const S: TUTF8String; out D: TUCS4Array): Boolean; -function TryUCS4ToUTF8(const S: TUCS4Array; out D: TUTF8String): Boolean; -function TryUTF16ToUCS4(const S: TUTF16String; out D: TUCS4Array): Boolean; -function TryUCS4ToUTF16(const S: TUCS4Array; out D: TUTF16String): Boolean; - -// indexed conversions -function UTF8CharCount(const S: TUTF8String): SizeInt; -function UTF16CharCount(const S: TUTF16String): SizeInt; -function UCS2CharCount(const S: TUCS2String): SizeInt; -function UCS4CharCount(const S: TUCS4Array): SizeInt; -// returns False if string is too small -// if UNICODE_SILENT_FAILURE is not defined and an invalid UTFX sequence is detected, an exception is raised -// returns True on success and Value contains UCS4 character that was read -function GetUCS4CharAt(const UTF8Str: TUTF8String; Index: SizeInt; out Value: UCS4): Boolean; overload; -function GetUCS4CharAt(const WideStr: TUTF16String; Index: SizeInt; out Value: UCS4; IsUTF16: Boolean = True): Boolean; overload; -function GetUCS4CharAt(const UCS4Str: TUCS4Array; Index: SizeInt; out Value: UCS4): Boolean; overload; - -function UCS4ToAnsiChar(Value: UCS4): AnsiChar; -function UCS4ToWideChar(Value: UCS4): WideChar; -function UCS4ToChar(Value: UCS4): Char; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} - -function AnsiCharToUCS4(Value: AnsiChar): UCS4; -function WideCharToUCS4(Value: WideChar): UCS4; -function CharToUCS4(Value: Char): UCS4; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\common'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -uses - {$IFDEF HAS_UNITSCOPE} - {$IFDEF MSWINDOWS} - Winapi.Windows, - {$ENDIF MSWINDOWS} - {$ELSE ~HAS_UNITSCOPE} - {$IFDEF MSWINDOWS} - Windows, - {$ENDIF MSWINDOWS} - {$ENDIF ~HAS_UNITSCOPE} - JclResources; - -const MB_ERR_INVALID_CHARS = 8; - -constructor EJclUnexpectedEOSequenceError.Create; -begin - inherited CreateRes(@RsEUnexpectedEOSeq); -end; - -function StreamReadByte(S: TStream; out B: Byte): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -begin - B := 0; - Result := S.Read(B, SizeOf(B)) = SizeOf(B); -end; - -function StreamWriteByte(S: TStream; B: Byte): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -begin - Result := S.Write(B, SizeOf(B)) = SizeOf(B); -end; - -function StreamReadWord(S: TStream; out W: Word): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -begin - W := 0; - Result := S.Read(W, SizeOf(W)) = SizeOf(W); -end; - -function StreamWriteWord(S: TStream; W: Word): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -begin - Result := S.Write(W, SizeOf(W)) = SizeOf(W); -end; - -//----------------- conversion routines ------------------------------------------------------------ - -// Converts the given source ANSI string into a Unicode string by expanding each character -// from one byte to two bytes. -// EAX contains Source, EDX contains Target, ECX contains Count - -procedure ExpandASCIIString(const Source: PAnsiChar; Target: PWideChar; Count: SizeInt); -asm - {$IFDEF CPU32} - // --> EAX Source - // EDX Target - // ECX Count - JECXZ @@Finish // go out if there is nothing to do (ECX = 0) - PUSH ESI - MOV ESI, EAX - XOR EAX, EAX -@@1: - MOV AL, [ESI] - INC ESI - MOV [EDX], AX - ADD EDX, 2 - DEC ECX - JNZ @@1 - POP ESI - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> RCX Source - // RDX Target - // R8 Count - - DEC R8 // go out if there is nothing to do (R8 = 0) - JS @@Finish -@@1: - MOVZX AX, BYTE PTR [RCX] - INC RCX - MOV WORD PTR [RDX], AX - ADD RDX, 2 -@@2: - DEC R8 - JNS @@1 - {$ENDIF CPU64} -@@Finish: -end; - -const - HalfShift: Integer = 10; - - HalfBase: UCS4 = $0010000; - HalfMask: UCS4 = $3FF; - -procedure FlagInvalidSequence(var StrPos: SizeInt; Increment: SizeInt; out Ch: UCS4); overload; -begin - {$IFDEF UNICODE_SILENT_FAILURE} - Ch := UCS4ReplacementCharacter; - Inc(StrPos, Increment); - {$ELSE ~UNICODE_SILENT_FAILURE} - StrPos := -1; - {$ENDIF ~UNICODE_SILENT_FAILURE} -end; - -procedure FlagInvalidSequence(var StrPos: SizeInt; Increment: SizeInt); overload; -begin - {$IFDEF UNICODE_SILENT_FAILURE} - Inc(StrPos, Increment); - {$ELSE ~UNICODE_SILENT_FAILURE} - StrPos := -1; - {$ENDIF ~UNICODE_SILENT_FAILURE} -end; - -procedure FlagInvalidSequence(out Ch: UCS4); overload; -begin - {$IFDEF UNICODE_SILENT_FAILURE} - Ch := UCS4ReplacementCharacter; - {$ELSE ~UNICODE_SILENT_FAILURE} - raise EJclUnexpectedEOSequenceError.Create; - {$ENDIF ~UNICODE_SILENT_FAILURE} -end; - -procedure FlagInvalidSequence; overload; -begin - {$IFNDEF UNICODE_SILENT_FAILURE} - raise EJclUnexpectedEOSequenceError.Create; - {$ENDIF ~UNICODE_SILENT_FAILURE} -end; - -// if UNICODE_SILENT_FAILURE is defined, invalid sequences will be replaced by ReplacementCharacter -// otherwise StrPos is set to -1 on return to flag an error (invalid UTF8 sequence) -// StrPos will be incremented by the number of chars that were read -function UTF8GetNextChar(const S: TUTF8String; var StrPos: SizeInt): UCS4; -var - StrLength: SizeInt; - Ch: UCS4; - ReadSuccess: Boolean; -begin - StrLength := Length(S); - ReadSuccess := True; - - if (StrPos <= StrLength) and (StrPos > 0) then - begin - Result := UCS4(S[StrPos]); - - case Result of - $00..$7F: - // 1 byte to read - Inc(StrPos); - $C0..$DF: - begin - // 2 bytes to read - if StrPos < StrLength then - begin - Ch := UCS4(S[StrPos + 1]); - if (Ch and $C0) = $80 then - begin - Result := ((Result and $1F) shl 6) or (Ch and $3F); - Inc(StrPos, 2); - end - else - FlagInvalidSequence(StrPos, 1, Result); - end - else - ReadSuccess := False; - end; - $E0..$EF: - begin - // 3 bytes to read - if (StrPos + 1) < StrLength then - begin - Ch := UCS4(S[StrPos + 1]); - if (Ch and $C0) = $80 then - begin - Result := ((Result and $0F) shl 12) or ((Ch and $3F) shl 6); - Ch := UCS4(S[StrPos + 2]); - if (Ch and $C0) = $80 then - begin - Result := Result or (Ch and $3F); - Inc(StrPos, 3); - end - else - FlagInvalidSequence(StrPos, 2, Result); - end - else - FlagInvalidSequence(StrPos, 1, Result); - end - else - ReadSuccess := False; - end; - $F0..$F7: - begin - // 4 bytes to read - if (StrPos + 2) < StrLength then - begin - Ch := UCS4(S[StrPos + 1]); - if (Ch and $C0) = $80 then - begin - Result := ((Result and $07) shl 18) or ((Ch and $3F) shl 12); - Ch := UCS4(S[StrPos + 2]); - if (Ch and $C0) = $80 then - begin - Result := Result or ((Ch and $3F) shl 6); - Ch := UCS4(S[StrPos + 3]); - if (Ch and $C0) = $80 then - begin - Result := Result or (Ch and $3F); - Inc(StrPos, 4); - end - else - FlagInvalidSequence(StrPos, 3, Result); - end - else - FlagInvalidSequence(StrPos, 2, Result); - end - else - FlagInvalidSequence(StrPos, 1, Result); - end - else - ReadSuccess := False; - end; - $F8..$FB: - begin - // 5 bytes to read - if (StrPos + 3) < StrLength then - begin - Ch := UCS4(S[StrPos + 1]); - if (Ch and $C0) = $80 then - begin - Result := ((Result and $03) shl 24) or ((Ch and $3F) shl 18); - Ch := UCS4(S[StrPos + 2]); - if (Ch and $C0) = $80 then - begin - Result := Result or ((Ch and $3F) shl 12); - Ch := UCS4(S[StrPos + 3]); - if (Ch and $C0) = $80 then - begin - Result := Result or ((Ch and $3F) shl 6); - Ch := UCS4(S[StrPos + 4]); - if (Ch and $C0) = $80 then - begin - Result := Result or (Ch and $3F); - Inc(StrPos, 5); - end - else - FlagInvalidSequence(StrPos, 4, Result); - end - else - FlagInvalidSequence(StrPos, 3, Result); - end - else - FlagInvalidSequence(StrPos, 2, Result); - end - else - FlagInvalidSequence(StrPos, 1, Result); - end - else - ReadSuccess := False; - end; - $FC..$FD: - begin - // 6 bytes to read - if (StrPos + 4) < StrLength then - begin - Ch := UCS4(S[StrPos + 1]); - if (Ch and $C0) = $80 then - begin - Result := ((Result and $01) shl 30) or ((Ch and $3F) shl 24); - Ch := UCS4(S[StrPos + 2]); - if (Ch and $C0) = $80 then - begin - Result := Result or ((Ch and $3F) shl 18); - Ch := UCS4(S[StrPos + 3]); - if (Ch and $C0) = $80 then - begin - Result := Result or ((Ch and $3F) shl 12); - Ch := UCS4(S[StrPos + 4]); - if (Ch and $C0) = $80 then - begin - Result := Result or ((Ch and $3F) shl 6); - Ch := UCS4(S[StrPos + 5]); - if (Ch and $C0) = $80 then - begin - Result := Result or (Ch and $3F); - Inc(StrPos, 6); - end - else - FlagInvalidSequence(StrPos, 5, Result); - end - else - FlagInvalidSequence(StrPos, 4, Result); - end - else - FlagInvalidSequence(StrPos, 3, Result); - end - else - FlagInvalidSequence(StrPos, 2, Result); - end - else - FlagInvalidSequence(StrPos, 1, Result); - end - else - ReadSuccess := False; - end; - else - FlagInvalidSequence(StrPos, 1, Result); - end; - if not ReadSuccess then - FlagInvalidSequence(StrPos, 1, Result); - end - else - begin - // StrPos > StrLength - Result := 0; - FlagInvalidSequence(StrPos, 0, Result); - end; -end; - -function UTF8GetNextBuffer(const S: TUTF8String; var StrPos: SizeInt; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; -var - B: Byte; - Ch: UCS4; - ReadSuccess: Boolean; - StrLength: SizeInt; -begin - StrLength := Length(S); - Result := 0; - ReadSuccess := True; - while (StrPos <= StrLength) and (StrPos > 0) and (Count > 0) do - begin - Ch := UCS4(S[StrPos]); - - case Ch of - $00..$7F: - // 1 byte to read - Inc(StrPos); - $C0..$DF: - begin - // 2 bytes to read - if StrPos < StrLength then - begin - B := Ord(S[StrPos + 1]); - if (B and $C0) = $80 then - Ch := ((Ch and $1F) shl 6) or (B and $3F) - else - FlagInvalidSequence(StrPos, 1, Ch); - end - else - ReadSuccess := False; - end; - $E0..$EF: - begin - // 3 bytes to read - if (StrPos + 1) < StrLength then - begin - B := Ord(S[StrPos + 1]); - if (B and $C0) = $80 then - begin - Ch := ((Ch and $0F) shl 12) or ((B and $3F) shl 6); - B := Ord(S[StrPos + 2]); - if (B and $C0) = $80 then - Ch := Ch or (B and $3F) - else - FlagInvalidSequence(StrPos, 2, Ch); - end - else - FlagInvalidSequence(StrPos, 1, Ch); - end - else - ReadSuccess := False; - end; - $F0..$F7: - begin - // 4 bytes to read - if (StrPos + 2) < StrLength then - begin - B := Ord(S[StrPos + 1]); - if (B and $C0) = $80 then - begin - Ch := ((Ch and $07) shl 18) or ((B and $3F) shl 12); - B := Ord(S[StrPos + 2]); - if (B and $C0) = $80 then - begin - Ch := Ch or ((B and $3F) shl 6); - B := Ord(S[StrPos + 3]); - if (B and $C0) = $80 then - Ch := Ch or (B and $3F) - else - FlagInvalidSequence(StrPos, 3, Ch); - end - else - FlagInvalidSequence(StrPos, 2, Ch); - end - else - FlagInvalidSequence(StrPos, 1, Ch); - end - else - ReadSuccess := False; - end; - $F8..$FB: - begin - // 5 bytes to read - if (StrPos + 3) < StrLength then - begin - B := Ord(S[StrPos + 1]); - if (B and $C0) = $80 then - begin - Ch := ((Ch and $03) shl 24) or ((B and $3F) shl 18); - B := Ord(S[StrPos + 2]); - if (B and $C0) = $80 then - begin - Ch := Ch or ((B and $3F) shl 12); - B := Ord(S[StrPos + 3]); - if (B and $C0) = $80 then - begin - Ch := Ch or ((B and $3F) shl 6); - B := Ord(S[StrPos + 4]); - if (B and $C0) = $80 then - Ch := Ch or (B and $3F) - else - FlagInvalidSequence(StrPos, 4, Ch); - end - else - FlagInvalidSequence(StrPos, 3, Ch); - end - else - FlagInvalidSequence(StrPos, 2, Ch); - end - else - FlagInvalidSequence(StrPos, 1, Ch); - end - else - ReadSuccess := False; - end; - $FC..$FD: - begin - // 6 bytes to read - if (StrPos + 4) < StrLength then - begin - B := Ord(S[StrPos + 1]); - if (B and $C0) = $80 then - begin - Ch := ((Ch and $01) shl 30) or ((B and $3F) shl 24); - B := Ord(S[StrPos + 2]); - if (B and $C0) = $80 then - begin - Ch := Ch or ((B and $3F) shl 18); - B := Ord(S[StrPos + 3]); - if (B and $C0) = $80 then - begin - Ch := Ch or ((B and $3F) shl 12); - B := Ord(S[StrPos + 4]); - if (B and $C0) = $80 then - begin - Ch := Ch or ((B and $3F) shl 6); - B := Ord(S[StrPos + 5]); - if (B and $C0) = $80 then - Ch := Ch or (B and $3F) - else - FlagInvalidSequence(StrPos, 5, Ch); - end - else - FlagInvalidSequence(StrPos, 4, Ch); - end - else - FlagInvalidSequence(StrPos, 3, Ch); - end - else - FlagInvalidSequence(StrPos, 2, Ch); - end - else - FlagInvalidSequence(StrPos, 1, Ch); - end - else - ReadSuccess := False; - end - else - FlagInvalidSequence(StrPos, 1, Ch); - end; - if not ReadSuccess then - FlagInvalidSequence(StrPos, 1, Ch); - - Buffer[Start] := Ch; - Inc(Start); - Inc(Result); - Dec(Count); - end; -end; - -function UTF8GetNextCharFromStream(S: TStream; out Ch: UCS4): Boolean; -var - B: Byte; -begin - Result := StreamReadByte(S,B); - if Result then - begin - Ch := UCS4(B); - - case Ch of - $00..$7F: ; - // 1 byte to read - // nothing to do - $C0..$DF: - begin - // 2 bytes to read - Result := StreamReadByte(S,B); - if Result then - begin - if (B and $C0) = $80 then - Ch := ((Ch and $1F) shl 6) or (B and $3F) - else - FlagInvalidSequence(Ch); - end; - end; - $E0..$EF: - begin - // 3 bytes to read - Result := StreamReadByte(S,B); - if Result then - begin - if (B and $C0) = $80 then - begin - Ch := ((Ch and $0F) shl 12) or ((B and $3F) shl 6); - Result := StreamReadByte(S,B); - if Result then - begin - if (B and $C0) = $80 then - Ch := Ch or (B and $3F) - else - FlagInvalidSequence(Ch); - end; - end - else - FlagInvalidSequence(Ch); - end; - end; - $F0..$F7: - begin - // 4 bytes to read - Result := StreamReadByte(S,B); - if Result then - begin - if (B and $C0) = $80 then - begin - Ch := ((Ch and $07) shl 18) or ((B and $3F) shl 12); - Result := StreamReadByte(S,B); - if Result then - begin - if (B and $C0) = $80 then - begin - Ch := Ch or ((B and $3F) shl 6); - Result := StreamReadByte(S,B); - if Result then - begin - if (B and $C0) = $80 then - Ch := Ch or (B and $3F) - else - FlagInvalidSequence(Ch); - end; - end - else - FlagInvalidSequence(Ch); - end; - end - else - FlagInvalidSequence(Ch); - end; - end; - $F8..$FB: - begin - // 5 bytes to read - Result := StreamReadByte(S,B); - if Result then - begin - if (B and $C0) = $80 then - begin - Ch := ((Ch and $03) shl 24) or ((B and $3F) shl 18); - Result := StreamReadByte(S,B); - if Result then - begin - if (B and $C0) = $80 then - begin - Ch := Ch or ((B and $3F) shl 12); - Result := StreamReadByte(S,B); - if Result then - begin - if (B and $C0) = $80 then - begin - Ch := Ch or ((B and $3F) shl 6); - Result := StreamReadByte(S,B); - if Result then - begin - if (B and $C0) = $80 then - Ch := Ch or (B and $3F) - else - FlagInvalidSequence(Ch); - end; - end - else - FlagInvalidSequence(Ch); - end; - end - else - FlagInvalidSequence(Ch); - end; - end - else - FlagInvalidSequence(Ch); - end; - end; - $FC..$FD: - begin - // 6 bytes to read - Result := StreamReadByte(S,B); - if Result then - begin - if (B and $C0) = $80 then - begin - Ch := ((Ch and $01) shl 30) or ((B and $3F) shl 24); - Result := StreamReadByte(S,B); - if Result then - begin - if (B and $C0) = $80 then - begin - Ch := Ch or ((B and $3F) shl 18); - Result := StreamReadByte(S,B); - if Result then - begin - if (B and $C0) = $80 then - begin - Ch := Ch or ((B and $3F) shl 12); - Result := StreamReadByte(S,B); - if Result then - begin - if (B and $C0) = $80 then - begin - Ch := Ch or ((B and $3F) shl 6); - Result := StreamReadByte(S,B); - if Result then - begin - if (B and $C0) = $80 then - Ch := Ch or (B and $3F) - else - FlagInvalidSequence(Ch); - end; - end - else - FlagInvalidSequence(Ch); - end; - end - else - FlagInvalidSequence(Ch); - end; - end - else - FlagInvalidSequence(Ch); - end; - end - else - FlagInvalidSequence(Ch); - end; - end; - else - FlagInvalidSequence(Ch); - end; - end; -end; - -function UTF8GetNextBufferFromStream(S: TStream; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; -var - B: Byte; - Ch: UCS4; - ReadSuccess: Boolean; -begin - Result := 0; - ReadSuccess := True; - while ReadSuccess and (Count > 0) do - begin - if StreamReadByte(S,B) then - begin - Ch := UCS4(B); - - case Ch of - $00..$7F: ; - // 1 byte to read - // nothing to do - $C0..$DF: - begin - // 2 bytes to read - if StreamReadByte(S,B) then - begin - if (B and $C0) = $80 then - Ch := ((Ch and $1F) shl 6) or (B and $3F) - else - FlagInvalidSequence(Ch); - end - else - ReadSuccess := False; - end; - $E0..$EF: - begin - // 3 bytes to read - if StreamReadByte(S,B) then - begin - if (B and $C0) = $80 then - begin - Ch := ((Ch and $0F) shl 12) or ((B and $3F) shl 6); - if StreamReadByte(S,B) then - begin - if (B and $C0) = $80 then - Ch := Ch or (B and $3F) - else - FlagInvalidSequence(Ch); - end - else - ReadSuccess := False; - end - else - FlagInvalidSequence(Ch); - end - else - ReadSuccess := False; - end; - $F0..$F7: - begin - // 4 bytes to read - if StreamReadByte(S,B) then - begin - if (B and $C0) = $80 then - begin - Ch := ((Ch and $07) shl 18) or ((B and $3F) shl 12); - if StreamReadByte(S,B) then - begin - if (B and $C0) = $80 then - begin - Ch := Ch or ((B and $3F) shl 6); - if StreamReadByte(S,B) then - begin - if (B and $C0) = $80 then - Ch := Ch or (B and $3F) - else - FlagInvalidSequence(Ch); - end - else - ReadSuccess := False; - end - else - FlagInvalidSequence(Ch); - end - else - ReadSuccess := False; - end - else - FlagInvalidSequence(Ch); - end - else - ReadSuccess := False; - end; - $F8..$FB: - begin - // 5 bytes to read - if StreamReadByte(S,B) then - begin - if (B and $C0) = $80 then - begin - Ch := ((Ch and $03) shl 24) or ((B and $3F) shl 18); - if StreamReadByte(S,B) then - begin - if (B and $C0) = $80 then - begin - Ch := Ch or ((B and $3F) shl 12); - if StreamReadByte(S,B) then - begin - if (B and $C0) = $80 then - begin - Ch := Ch or ((B and $3F) shl 6); - if StreamReadByte(S,B) then - begin - if (B and $C0) = $80 then - Ch := Ch or (B and $3F) - else - FlagInvalidSequence(Ch); - end - else - ReadSuccess := False; - end - else - FlagInvalidSequence(Ch); - end - else - ReadSuccess := False; - end - else - FlagInvalidSequence(Ch); - end - else - ReadSuccess := False; - end - else - FlagInvalidSequence(Ch); - end - else - ReadSuccess := False; - end; - $FC..$FD: - begin - // 6 bytes to read - if StreamReadByte(S,B) then - begin - if (B and $C0) = $80 then - begin - Ch := ((Ch and $01) shl 30) or ((B and $3F) shl 24); - if StreamReadByte(S,B) then - begin - if (B and $C0) = $80 then - begin - Ch := Ch or ((B and $3F) shl 18); - if StreamReadByte(S,B) then - begin - if (B and $C0) = $80 then - begin - Ch := Ch or ((B and $3F) shl 12); - if StreamReadByte(S,B) then - begin - if (B and $C0) = $80 then - begin - Ch := Ch or ((B and $3F) shl 6); - if StreamReadByte(S,B) then - begin - if (B and $C0) = $80 then - Ch := Ch or (B and $3F) - else - FlagInvalidSequence(Ch); - end - else - ReadSuccess := False; - end - else - FlagInvalidSequence(Ch); - end - else - ReadSuccess := False; - end - else - FlagInvalidSequence(Ch); - end - else - ReadSuccess := False; - end - else - FlagInvalidSequence(Ch); - end - else - ReadSuccess := False; - end - else - FlagInvalidSequence(Ch); - end - else - ReadSuccess := False; - end - else - FlagInvalidSequence(Ch); - end; - if ReadSuccess then - begin - Buffer[Start] := Ch; - Inc(Start); - Inc(Result); - end; - end - else - ReadSuccess := False; - Dec(Count); - end; -end; - -// returns False if String is too small -// if UNICODE_SILENT_FAILURE is not defined StrPos is set to -1 on error (invalid UTF8 sequence) -// StrPos will be incremented by the number of ansi chars that were skipped -// On return, NbSeq contains the number of UTF8 sequences that were skipped -function UTF8SkipChars(const S: TUTF8String; var StrPos: SizeInt; var NbSeq: SizeInt): Boolean; -var - StrLength: SizeInt; - Ch: UCS4; - Index: SizeInt; -begin - Result := True; - StrLength := Length(S); - - Index := 0; - while (Index < NbSeq) and (StrPos > 0) do - begin - Ch := UCS4(S[StrPos]); - - case Ch of - $00..$7F: - // 1 byte to skip - Inc(StrPos); - $C0..$DF: - // 2 bytes to skip - if (StrPos >= StrLength) or ((UCS4(S[StrPos + 1]) and $C0) <> $80) then - FlagInvalidSequence(StrPos, 1) - else - Inc(StrPos, 2); - $E0..$EF: - // 3 bytes to skip - if ((StrPos + 1) >= StrLength) or ((UCS4(S[StrPos + 1]) and $C0) <> $80) then - FlagInvalidSequence(StrPos, 1) - else - if (UCS4(S[StrPos + 2]) and $C0) <> $80 then - FlagInvalidSequence(StrPos, 2) - else - Inc(StrPos, 3); - $F0..$F7: - // 4 bytes to skip - if ((StrPos + 2) >= StrLength) or ((UCS4(S[StrPos + 1]) and $C0) <> $80) then - FlagInvalidSequence(StrPos, 1) - else - if (UCS4(S[StrPos + 2]) and $C0) <> $80 then - FlagInvalidSequence(StrPos, 2) - else - if (UCS4(S[StrPos + 3]) and $C0) <> $80 then - FlagInvalidSequence(StrPos, 3) - else - Inc(StrPos, 4); - $F8..$FB: - // 5 bytes to skip - if ((StrPos + 3) >= StrLength) or ((UCS4(S[StrPos + 1]) and $C0) <> $80) then - FlagInvalidSequence(StrPos, 1) - else - if (UCS4(S[StrPos + 2]) and $C0) <> $80 then - FlagInvalidSequence(StrPos, 2) - else - if (UCS4(S[StrPos + 3]) and $C0) <> $80 then - FlagInvalidSequence(StrPos, 3) - else - if (UCS4(S[StrPos + 4]) and $C0) <> $80 then - FlagInvalidSequence(StrPos, 4) - else - Inc(StrPos, 5); - $FC..$FD: - // 6 bytes to skip - if ((StrPos + 4) >= StrLength) or ((UCS4(S[StrPos + 1]) and $C0) <> $80) then - FlagInvalidSequence(StrPos, 1) - else - if (UCS4(S[StrPos + 2]) and $C0) <> $80 then - FlagInvalidSequence(StrPos, 2) - else - if (UCS4(S[StrPos + 3]) and $C0) <> $80 then - FlagInvalidSequence(StrPos, 3) - else - if (UCS4(S[StrPos + 4]) and $C0) <> $80 then - FlagInvalidSequence(StrPos, 4) - else - if (UCS4(S[StrPos + 5]) and $C0) <> $80 then - FlagInvalidSequence(StrPos, 5) - else - Inc(StrPos, 6); - else - FlagInvalidSequence(StrPos, 1); - end; - - if StrPos <> -1 then - Inc(Index); - if (StrPos > StrLength) and (Index < NbSeq) then - begin - Result := False; - Break; - end; - end; - NbSeq := Index; -end; - -function UTF8SkipCharsFromStream(S: TStream; var NbSeq: SizeInt): Boolean; -var - B: Byte; - Index: SizeInt; -begin - Index := 0; - while (Index < NbSeq) do - begin - Result := StreamReadByte(S, B); - if not Result then - Break; - case B of - $00..$7F: ; - // 1 byte to skip - // nothing to do - $C0..$DF: - // 2 bytes to skip - begin - Result := StreamReadByte(S, B); - if not Result then - Break; - if (B and $C0) <> $80 then - FlagInvalidSequence; - end; - $E0..$EF: - // 3 bytes to skip - begin - Result := StreamReadByte(S, B); - if not Result then - Break; - if (B and $C0) <> $80 then - FlagInvalidSequence; - Result := StreamReadByte(S, B); - if not Result then - Break; - if (B and $C0) <> $80 then - FlagInvalidSequence; - end; - $F0..$F7: - // 4 bytes to skip - begin - Result := StreamReadByte(S, B); - if not Result then - Break; - if (B and $C0) <> $80 then - FlagInvalidSequence; - Result := StreamReadByte(S, B); - if not Result then - Break; - if (B and $C0) <> $80 then - FlagInvalidSequence; - Result := StreamReadByte(S, B); - if not Result then - Break; - if (B and $C0) <> $80 then - FlagInvalidSequence; - end; - $F8..$FB: - // 5 bytes to skip - begin - Result := StreamReadByte(S, B); - if not Result then - Break; - if (B and $C0) <> $80 then - FlagInvalidSequence; - Result := StreamReadByte(S, B); - if not Result then - Break; - if (B and $C0) <> $80 then - FlagInvalidSequence; - Result := StreamReadByte(S, B); - if not Result then - Break; - if (B and $C0) <> $80 then - FlagInvalidSequence; - Result := StreamReadByte(S, B); - if not Result then - Break; - if (B and $C0) <> $80 then - FlagInvalidSequence; - end; - $FC..$FD: - // 6 bytes to skip - begin - Result := StreamReadByte(S, B); - if not Result then - Break; - if (B and $C0) <> $80 then - FlagInvalidSequence; - Result := StreamReadByte(S, B); - if not Result then - Break; - if (B and $C0) <> $80 then - FlagInvalidSequence; - Result := StreamReadByte(S, B); - if not Result then - Break; - if (B and $C0) <> $80 then - FlagInvalidSequence; - Result := StreamReadByte(S, B); - if not Result then - Break; - if (B and $C0) <> $80 then - FlagInvalidSequence; - Result := StreamReadByte(S, B); - if not Result then - Break; - if (B and $C0) <> $80 then - FlagInvalidSequence; - end; - else - FlagInvalidSequence; - end; - Inc(Index); - end; - Result := Index = NbSeq; - NbSeq := Index; -end; - -// returns False on error: -// - if an UCS4 character cannot be stored to an UTF-8 string: -// - if UNICODE_SILENT_FAILURE is defined, ReplacementCharacter is added -// - if UNICODE_SILENT_FAILURE is not defined, StrPos is set to -1 -// - StrPos > -1 flags string being too small, caller is responsible for allocating space -// StrPos will be incremented by the number of chars that were written -function UTF8SetNextChar(var S: TUTF8String; var StrPos: SizeInt; Ch: UCS4): Boolean; -var - StrLength: SizeInt; -begin - StrLength := Length(S); - - if Ch <= $7F then - begin - // 7 bits to store - Result := (StrPos > 0) and (StrPos <= StrLength); - if Result then - begin - S[StrPos] := AnsiChar(Ch); - Inc(StrPos); - end; - end - else - if Ch <= $7FF then - begin - // 11 bits to store - Result := (StrPos > 0) and (StrPos < StrLength); - if Result then - begin - S[StrPos] := AnsiChar($C0 or (Ch shr 6)); // 5 bits - S[StrPos + 1] := AnsiChar((Ch and $3F) or $80); // 6 bits - Inc(StrPos, 2); - end; - end - else - if Ch <= $FFFF then - begin - // 16 bits to store - Result := (StrPos > 0) and (StrPos < (StrLength - 1)); - if Result then - begin - S[StrPos] := AnsiChar($E0 or (Ch shr 12)); // 4 bits - S[StrPos + 1] := AnsiChar(((Ch shr 6) and $3F) or $80); // 6 bits - S[StrPos + 2] := AnsiChar((Ch and $3F) or $80); // 6 bits - Inc(StrPos, 3); - end; - end - else - if Ch <= $1FFFFF then - begin - // 21 bits to store - Result := (StrPos > 0) and (StrPos < (StrLength - 2)); - if Result then - begin - S[StrPos] := AnsiChar($F0 or (Ch shr 18)); // 3 bits - S[StrPos + 1] := AnsiChar(((Ch shr 12) and $3F) or $80); // 6 bits - S[StrPos + 2] := AnsiChar(((Ch shr 6) and $3F) or $80); // 6 bits - S[StrPos + 3] := AnsiChar((Ch and $3F) or $80); // 6 bits - Inc(StrPos, 4); - end; - end - else - if Ch <= $3FFFFFF then - begin - // 26 bits to store - Result := (StrPos > 0) and (StrPos < (StrLength - 2)); - if Result then - begin - S[StrPos] := AnsiChar($F8 or (Ch shr 24)); // 2 bits - S[StrPos + 1] := AnsiChar(((Ch shr 18) and $3F) or $80); // 6 bits - S[StrPos + 2] := AnsiChar(((Ch shr 12) and $3F) or $80); // 6 bits - S[StrPos + 3] := AnsiChar(((Ch shr 6) and $3F) or $80); // 6 bits - S[StrPos + 4] := AnsiChar((Ch and $3F) or $80); // 6 bits - Inc(StrPos, 5); - end; - end - else - if Ch <= MaximumUCS4 then - begin - // 31 bits to store - Result := (StrPos > 0) and (StrPos < (StrLength - 3)); - if Result then - begin - S[StrPos] := AnsiChar($FC or (Ch shr 30)); // 1 bits - S[StrPos + 1] := AnsiChar(((Ch shr 24) and $3F) or $80); // 6 bits - S[StrPos + 2] := AnsiChar(((Ch shr 18) and $3F) or $80); // 6 bits - S[StrPos + 3] := AnsiChar(((Ch shr 12) and $3F) or $80); // 6 bits - S[StrPos + 4] := AnsiChar(((Ch shr 6) and $3F) or $80); // 6 bits - S[StrPos + 5] := AnsiChar((Ch and $3F) or $80); // 6 bits - Inc(StrPos, 6); - end; - end - else - begin - {$IFDEF UNICODE_SILENT_FAILURE} - // add ReplacementCharacter - Result := (StrPos > 0) and (StrPos < (StrLength - 1)); - if Result then - begin - S[StrPos] := AnsiChar($E0 or (UCS4ReplacementCharacter shr 12)); // 4 bits - S[StrPos + 1] := AnsiChar(((UCS4ReplacementCharacter shr 6) and $3F) or $80); // 6 bits - S[StrPos + 2] := AnsiChar((UCS4ReplacementCharacter and $3F) or $80); // 6 bits - Inc(StrPos, 3); - end; - {$ELSE ~UNICODE_SILENT_FAILURE} - StrPos := -1; - Result := False; - {$ENDIF ~UNICODE_SILENT_FAILURE} - end; -end; - -function UTF8SetNextBuffer(var S: TUTF8String; var StrPos: SizeInt; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; -var - StrLength: SizeInt; - Ch: UCS4; - Success: Boolean; -begin - StrLength := Length(S); - Success := True; - Result := 0; - while Success and (Count > 0) do - begin - Ch := Buffer[Start]; - if Ch <= $7F then - begin - // 7 bits to store - if (StrPos > 0) and (StrPos <= StrLength) then - begin - S[StrPos] := AnsiChar(Ch); - Inc(StrPos); - end - else - Success := False; - end - else - if Ch <= $7FF then - begin - // 11 bits to store - if (StrPos > 0) and (StrPos < StrLength) then - begin - S[StrPos] := AnsiChar($C0 or (Ch shr 6)); // 5 bits - S[StrPos + 1] := AnsiChar((Ch and $3F) or $80); // 6 bits - Inc(StrPos, 2); - end - else - Success := False; - end - else - if Ch <= $FFFF then - begin - // 16 bits to store - if (StrPos > 0) and (StrPos < (StrLength - 1)) then - begin - S[StrPos] := AnsiChar($E0 or (Ch shr 12)); // 4 bits - S[StrPos + 1] := AnsiChar(((Ch shr 6) and $3F) or $80); // 6 bits - S[StrPos + 2] := AnsiChar((Ch and $3F) or $80); // 6 bits - Inc(StrPos, 3); - end - else - Success := False; - end - else - if Ch <= $1FFFFF then - begin - // 21 bits to store - if (StrPos > 0) and (StrPos < (StrLength - 2)) then - begin - S[StrPos] := AnsiChar($F0 or (Ch shr 18)); // 3 bits - S[StrPos + 1] := AnsiChar(((Ch shr 12) and $3F) or $80); // 6 bits - S[StrPos + 2] := AnsiChar(((Ch shr 6) and $3F) or $80); // 6 bits - S[StrPos + 3] := AnsiChar((Ch and $3F) or $80); // 6 bits - Inc(StrPos, 4); - end - else - Success := False; - end - else - if Ch <= $3FFFFFF then - begin - // 26 bits to store - if (StrPos > 0) and (StrPos < (StrLength - 2)) then - begin - S[StrPos] := AnsiChar($F8 or (Ch shr 24)); // 2 bits - S[StrPos + 1] := AnsiChar(((Ch shr 18) and $3F) or $80); // 6 bits - S[StrPos + 2] := AnsiChar(((Ch shr 12) and $3F) or $80); // 6 bits - S[StrPos + 3] := AnsiChar(((Ch shr 6) and $3F) or $80); // 6 bits - S[StrPos + 4] := AnsiChar((Ch and $3F) or $80); // 6 bits - Inc(StrPos, 5); - end - else - Success := False; - end - else - if Ch <= MaximumUCS4 then - begin - // 31 bits to store - if (StrPos > 0) and (StrPos < (StrLength - 3)) then - begin - S[StrPos] := AnsiChar($FC or (Ch shr 30)); // 1 bits - S[StrPos + 1] := AnsiChar(((Ch shr 24) and $3F) or $80); // 6 bits - S[StrPos + 2] := AnsiChar(((Ch shr 18) and $3F) or $80); // 6 bits - S[StrPos + 3] := AnsiChar(((Ch shr 12) and $3F) or $80); // 6 bits - S[StrPos + 4] := AnsiChar(((Ch shr 6) and $3F) or $80); // 6 bits - S[StrPos + 5] := AnsiChar((Ch and $3F) or $80); // 6 bits - Inc(StrPos, 6); - end - else - Success := False; - end - else - begin - {$IFDEF UNICODE_SILENT_FAILURE} - // add ReplacementCharacter - if (StrPos > 0) and (StrPos < (StrLength - 1)) then - begin - S[StrPos] := AnsiChar($E0 or (UCS4ReplacementCharacter shr 12)); // 4 bits - S[StrPos + 1] := AnsiChar(((UCS4ReplacementCharacter shr 6) and $3F) or $80); // 6 bits - S[StrPos + 2] := AnsiChar((UCS4ReplacementCharacter and $3F) or $80); // 6 bits - Inc(StrPos, 3); - end - else - Success := False; - {$ELSE ~UNICODE_SILENT_FAILURE} - StrPos := -1; - Success := False; - {$ENDIF ~UNICODE_SILENT_FAILURE} - end; - if Success then - begin - Inc(Start); - Inc(Result); - end; - Dec(Count); - end; -end; - -function UTF8SetNextCharToStream(S: TStream; Ch: UCS4): Boolean; -begin - if Ch <= $7F then - // 7 bits to store - Result := StreamWriteByte(S,Ch) - else - if Ch <= $7FF then - // 11 bits to store - Result := StreamWriteByte(S, $C0 or (Ch shr 6)) and // 5 bits - StreamWriteByte(S, (Ch and $3F) or $80) // 6 bits - else - if Ch <= $FFFF then - // 16 bits to store - Result := StreamWriteByte(S, $E0 or (Ch shr 12)) and // 4 bits - StreamWriteByte(S, ((Ch shr 6) and $3F) or $80) and // 6 bits - StreamWriteByte(S, (Ch and $3F) or $80) // 6 bits - else - if Ch <= $1FFFFF then - // 21 bits to store - Result := StreamWriteByte(S, $F0 or (Ch shr 18)) and // 3 bits - StreamWriteByte(S, ((Ch shr 12) and $3F) or $80) and // 6 bits - StreamWriteByte(S, ((Ch shr 6) and $3F) or $80) and // 6 bits - StreamWriteByte(S, (Ch and $3F) or $80) // 6 bits - else - if Ch <= $3FFFFFF then - // 26 bits to store - Result := StreamWriteByte(S, $F8 or (Ch shr 24)) and // 2 bits - StreamWriteByte(S, ((Ch shr 18) and $3F) or $80) and // 6 bits - StreamWriteByte(S, ((Ch shr 12) and $3F) or $80) and // 6 bits - StreamWriteByte(S, ((Ch shr 6) and $3F) or $80) and // 6 bits - StreamWriteByte(S, (Ch and $3F) or $80) // 6 bits - else - if Ch <= MaximumUCS4 then - // 31 bits to store - Result := StreamWriteByte(S, $FC or (Ch shr 30)) and // 1 bits - StreamWriteByte(S, ((Ch shr 24) and $3F) or $80) and // 6 bits - StreamWriteByte(S, ((Ch shr 18) and $3F) or $80) and // 6 bits - StreamWriteByte(S, ((Ch shr 12) and $3F) or $80) and // 6 bits - StreamWriteByte(S, ((Ch shr 6) and $3F) or $80) and // 6 bits - StreamWriteByte(S, (Ch and $3F) or $80) // 6 bits - else - {$IFDEF UNICODE_SILENT_FAILURE} - // add ReplacementCharacter - Result := StreamWriteByte(S, $E0 or (UCS4ReplacementCharacter shr 12)) and // 4 bits - StreamWriteByte(S, ((UCS4ReplacementCharacter shr 6) and $3F) or $80) and // 6 bits - StreamWriteByte(S, (UCS4ReplacementCharacter and $3F) or $80); // 6 bits - {$ELSE ~UNICODE_SILENT_FAILURE} - Result := False; - {$ENDIF ~UNICODE_SILENT_FAILURE} -end; - -function UTF8SetNextBufferToStream(S: TStream; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; -var - Ch: UCS4; - Success: Boolean; -begin - Result := 0; - Success := True; - while Success and (Count > 0) do - begin - Ch := Buffer[Start]; - if Ch <= $7F then - // 7 bits to store - Success := StreamWriteByte(S,Ch) - else - if Ch <= $7FF then - // 11 bits to store - Success := StreamWriteByte(S, $C0 or (Ch shr 6)) and // 5 bits - StreamWriteByte(S, (Ch and $3F) or $80) // 6 bits - else - if Ch <= $FFFF then - // 16 bits to store - Success := StreamWriteByte(S, $E0 or (Ch shr 12)) and // 4 bits - StreamWriteByte(S, ((Ch shr 6) and $3F) or $80) and // 6 bits - StreamWriteByte(S, (Ch and $3F) or $80) // 6 bits - else - if Ch <= $1FFFFF then - // 21 bits to store - Success := StreamWriteByte(S, $F0 or (Ch shr 18)) and // 3 bits - StreamWriteByte(S, ((Ch shr 12) and $3F) or $80) and // 6 bits - StreamWriteByte(S, ((Ch shr 6) and $3F) or $80) and // 6 bits - StreamWriteByte(S, (Ch and $3F) or $80) // 6 bits - else - if Ch <= $3FFFFFF then - // 26 bits to store - Success := StreamWriteByte(S, $F8 or (Ch shr 24)) and // 2 bits - StreamWriteByte(S, ((Ch shr 18) and $3F) or $80) and // 6 bits - StreamWriteByte(S, ((Ch shr 12) and $3F) or $80) and // 6 bits - StreamWriteByte(S, ((Ch shr 6) and $3F) or $80) and // 6 bits - StreamWriteByte(S, (Ch and $3F) or $80) // 6 bits - else - if Ch <= MaximumUCS4 then - // 31 bits to store - Success := StreamWriteByte(S, $FC or (Ch shr 30)) and // 1 bits - StreamWriteByte(S, ((Ch shr 24) and $3F) or $80) and // 6 bits - StreamWriteByte(S, ((Ch shr 18) and $3F) or $80) and // 6 bits - StreamWriteByte(S, ((Ch shr 12) and $3F) or $80) and // 6 bits - StreamWriteByte(S, ((Ch shr 6) and $3F) or $80) and // 6 bits - StreamWriteByte(S, (Ch and $3F) or $80) // 6 bits - else - {$IFDEF UNICODE_SILENT_FAILURE} - // add ReplacementCharacter - Success := StreamWriteByte(S, $E0 or (UCS4ReplacementCharacter shr 12)) and // 4 bits - StreamWriteByte(S, ((UCS4ReplacementCharacter shr 6) and $3F) or $80) and // 6 bits - StreamWriteByte(S, (UCS4ReplacementCharacter and $3F) or $80); // 6 bits - {$ELSE ~UNICODE_SILENT_FAILURE} - Success := False; - {$ENDIF ~UNICODE_SILENT_FAILURE} - if Success then - begin - Inc(Start); - Inc(Result); - end; - Dec(Count); - end; -end; - -// if UNICODE_SILENT_FAILURE is defined, invalid sequences will be replaced by ReplacementCharacter -// otherwise StrPos is set to -1 on return to flag an error (invalid UTF16 sequence) -// StrPos will be incremented by the number of chars that were read -function UTF16GetNextChar(const S: TUTF16String; var StrPos: SizeInt): UCS4; -var - StrLength: SizeInt; - Ch: UCS4; -begin - StrLength := Length(S); - - if (StrPos <= StrLength) and (StrPos > 0) then - begin - Result := UCS4(S[StrPos]); - - case Result of - SurrogateHighStart..SurrogateHighEnd: - begin - // 2 bytes to read - if StrPos < StrLength then - begin - Ch := UCS4(S[StrPos + 1]); - if (Ch >= SurrogateLowStart) and (Ch <= SurrogateLowEnd) then - begin - Result := ((Result - SurrogateHighStart) shl HalfShift) + (Ch - SurrogateLowStart) + HalfBase; - Inc(StrPos, 2); - end - else - FlagInvalidSequence(StrPos, 1, Result); - end - else - FlagInvalidSequence(StrPos, 1, Result); - end; - SurrogateLowStart..SurrogateLowEnd: - FlagInvalidSequence(StrPos, 1, Result); - else - // 1 byte to read - Inc(StrPos); - end; - end - else - begin - // StrPos > StrLength - Result := 0; - FlagInvalidSequence(StrPos, 0, Result); - end; -end; - -function UTF16GetNextBuffer(const S: TUTF16String; var StrPos: SizeInt; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; -var - StrLength: SizeInt; - Ch, ChNext: UCS4; - ReadSuccess: Boolean; -begin - StrLength := Length(S); - Result := 0; - ReadSuccess := True; - while (StrPos <= StrLength) and (StrPos > 0) and (Count > 0) do - begin - Ch := UCS4(S[StrPos]); - - case Ch of - SurrogateHighStart..SurrogateHighEnd: - begin - // 2 bytes to read - if StrPos < StrLength then - begin - ChNext := UCS4(S[StrPos + 1]); - if (ChNext >= SurrogateLowStart) and (ChNext <= SurrogateLowEnd) then - begin - Ch := ((Ch - SurrogateHighStart) shl HalfShift) + (ChNext - SurrogateLowStart) + HalfBase; - Inc(StrPos, 2); - end - else - FlagInvalidSequence(StrPos, 1, Ch); - end - else - ReadSuccess := False; - end; - SurrogateLowStart..SurrogateLowEnd: - FlagInvalidSequence(StrPos, 1, Ch); - else - // 1 byte to read - Inc(StrPos); - end; - if not ReadSuccess then - FlagInvalidSequence(StrPos, 1, Ch); - - Buffer[Start] := Ch; - Inc(Start); - Inc(Result); - Dec(Count); - end; -end; - -// if UNICODE_SILENT_FAILURE is defined, invalid sequences will be replaced by ReplacementCharacter -// otherwise StrPos is set to -1 on return to flag an error (invalid UTF16 sequence) -// StrPos will be incremented by the number of chars that were read -{$IFDEF SUPPORTS_UNICODE_STRING} -function UTF16GetNextChar(const S: WideString; var StrPos: SizeInt): UCS4; -var - StrLength: SizeInt; - Ch: UCS4; -begin - StrLength := Length(S); - - if (StrPos <= StrLength) and (StrPos > 0) then - begin - Result := UCS4(S[StrPos]); - - case Result of - SurrogateHighStart..SurrogateHighEnd: - begin - // 2 bytes to read - if StrPos < StrLength then - begin - Ch := UCS4(S[StrPos + 1]); - if (Ch >= SurrogateLowStart) and (Ch <= SurrogateLowEnd) then - begin - Result := ((Result - SurrogateHighStart) shl HalfShift) + (Ch - SurrogateLowStart) + HalfBase; - Inc(StrPos, 2); - end - else - FlagInvalidSequence(StrPos, 1, Result); - end - else - FlagInvalidSequence(StrPos, 1, Result); - end; - SurrogateLowStart..SurrogateLowEnd: - FlagInvalidSequence(StrPos, 1, Result); - else - // 1 byte to read - Inc(StrPos); - end; - end - else - begin - // StrPos > StrLength - Result := 0; - FlagInvalidSequence(StrPos, 0, Result); - end; -end; - -function UTF16GetNextBuffer(const S: WideString; var StrPos: SizeInt; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; -var - StrLength: SizeInt; - Ch, ChNext: UCS4; - ReadSuccess: Boolean; -begin - StrLength := Length(S); - Result := 0; - ReadSuccess := True; - while (StrPos <= StrLength) and (StrPos > 0) and (Count > 0) do - begin - Ch := UCS4(S[StrPos]); - - case Ch of - SurrogateHighStart..SurrogateHighEnd: - begin - // 2 bytes to read - if StrPos < StrLength then - begin - ChNext := UCS4(S[StrPos + 1]); - if (ChNext >= SurrogateLowStart) and (ChNext <= SurrogateLowEnd) then - begin - Ch := ((Ch - SurrogateHighStart) shl HalfShift) + (ChNext - SurrogateLowStart) + HalfBase; - Inc(StrPos, 2); - end - else - FlagInvalidSequence(StrPos, 1, Ch); - end - else - ReadSuccess := False; - end; - SurrogateLowStart..SurrogateLowEnd: - FlagInvalidSequence(StrPos, 1, Ch); - else - // 1 byte to read - Inc(StrPos); - end; - if not ReadSuccess then - FlagInvalidSequence(StrPos, 1, Ch); - - Buffer[Start] := Ch; - Inc(Start); - Inc(Result); - Dec(Count); - end; -end; -{$ENDIF SUPPORTS_UNICODE_STRING} - -function UTF16GetNextCharFromStream(S: TStream; out Ch: UCS4): Boolean; -var - W: Word; -begin - Result := StreamReadWord(S, W); - if Result then - begin - Ch := UCS4(W); - - case W of - SurrogateHighStart..SurrogateHighEnd: - begin - // 2 bytes to read - Result := StreamReadWord(S, W); - if Result then - begin - if (W >= SurrogateLowStart) and (W <= SurrogateLowEnd) then - Ch := ((Ch - SurrogateHighStart) shl HalfShift) + (W - SurrogateLowStart) + HalfBase - else - FlagInvalidSequence(Ch); - end; - end; - SurrogateLowStart..SurrogateLowEnd: - FlagInvalidSequence(Ch); - else - // 1 byte to read - // nothing to do - end; - end; -end; - -function UTF16GetNextBufferFromStream(S: TStream; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; -var - W: Word; - Ch: UCS4; - ReadSuccess: Boolean; -begin - Result := 0; - ReadSuccess := True; - while ReadSuccess and (Count > 0) do - begin - if StreamReadWord(S, W) then - begin - Ch := UCS4(W); - - case W of - SurrogateHighStart..SurrogateHighEnd: - begin - // 2 bytes to read - if StreamReadWord(S, W) then - begin - if (W >= SurrogateLowStart) and (W <= SurrogateLowEnd) then - Ch := ((Ch - SurrogateHighStart) shl HalfShift) + (W - SurrogateLowStart) + HalfBase - else - FlagInvalidSequence(Ch); - end - else - ReadSuccess := False; - end; - SurrogateLowStart..SurrogateLowEnd: - FlagInvalidSequence(Ch); - else - // 1 byte to read - // nothing to do - end; - if ReadSuccess then - begin - Buffer[Start] := Ch; - Inc(Result); - Inc(Start); - end; - end; - Dec(Count); - end; -end; - -// if UNICODE_SILENT_FAILURE is defined, invalid sequences will be replaced by ReplacementCharacter -// otherwise StrPos is set to -1 on return to flag an error (invalid UTF16 sequence) -// StrPos will be decremented by the number of chars that were read -function UTF16GetPreviousChar(const S: TUTF16String; var StrPos: SizeInt): UCS4; -var - StrLength: SizeInt; - ChPrev: UCS4; -begin - StrLength := Length(S); - - if (StrPos <= (StrLength + 1)) and (StrPos > 1) then - begin - Result := UCS4(S[StrPos - 1]); - - case Result of - SurrogateHighStart..SurrogateHighEnd: - FlagInvalidSequence(StrPos, -1, Result); - SurrogateLowStart..SurrogateLowEnd: - begin - // 2 bytes to read - if StrPos > 2 then - begin - ChPrev := UCS4(S[StrPos - 2]); - if (ChPrev >= SurrogateHighStart) and (ChPrev <= SurrogateHighEnd) then - begin - Result := ((ChPrev - SurrogateHighStart) shl HalfShift) + (Result - SurrogateLowStart) + HalfBase; - Dec(StrPos, 2); - end - else - FlagInvalidSequence(StrPos, -1, Result); - end - else - FlagInvalidSequence(StrPos, -1, Result); - end; - else - // 1 byte to read - Dec(StrPos); - end; - end - else - begin - // StrPos > StrLength - Result := 0; - FlagInvalidSequence(StrPos, 0, Result); - end; -end; - -// if UNICODE_SILENT_FAILURE is defined, invalid sequences will be replaced by ReplacementCharacter -// otherwise StrPos is set to -1 on return to flag an error (invalid UTF16 sequence) -// StrPos will be decremented by the number of chars that were read -{$IFDEF SUPPORTS_UNICODE_STRING} -function UTF16GetPreviousChar(const S: WideString; var StrPos: SizeInt): UCS4; -var - StrLength: SizeInt; - ChPrev: UCS4; -begin - StrLength := Length(S); - - if (StrPos <= (StrLength + 1)) and (StrPos > 1) then - begin - Result := UCS4(S[StrPos - 1]); - - case Result of - SurrogateHighStart..SurrogateHighEnd: - FlagInvalidSequence(StrPos, -1, Result); - SurrogateLowStart..SurrogateLowEnd: - begin - // 2 bytes to read - if StrPos > 2 then - begin - ChPrev := UCS4(S[StrPos - 2]); - if (ChPrev >= SurrogateHighStart) and (ChPrev <= SurrogateHighEnd) then - begin - Result := ((ChPrev - SurrogateHighStart) shl HalfShift) + (Result - SurrogateLowStart) + HalfBase; - Dec(StrPos, 2); - end - else - FlagInvalidSequence(StrPos, -1, Result); - end - else - FlagInvalidSequence(StrPos, -1, Result); - end; - else - // 1 byte to read - Dec(StrPos); - end; - end - else - begin - // StrPos > StrLength - Result := 0; - FlagInvalidSequence(StrPos, 0, Result); - end; -end; -{$ENDIF SUPPORTS_UNICODE_STRING} - -// returns False if String is too small -// if UNICODE_SILENT_FAILURE is not defined StrPos is set to -1 on error (invalid UTF16 sequence) -// StrPos will be incremented by the number of chars that were skipped -// On return, NbSeq contains the number of UTF16 sequences that were skipped -function UTF16SkipChars(const S: TUTF16String; var StrPos: SizeInt; var NbSeq: SizeInt): Boolean; -var - StrLength, Index: SizeInt; - Ch: UCS4; -begin - Result := True; - StrLength := Length(S); - - Index := 0; - if NbSeq >= 0 then - while (Index < NbSeq) and (StrPos > 0) do - begin - Ch := UCS4(S[StrPos]); - - case Ch of - SurrogateHighStart..SurrogateHighEnd: - // 2 bytes to skip - if StrPos >= StrLength then - FlagInvalidSequence(StrPos, 1) - else - begin - Ch := UCS4(S[StrPos + 1]); - if (Ch < SurrogateLowStart) or (Ch > SurrogateLowEnd) then - FlagInvalidSequence(StrPos, 1) - else - Inc(StrPos, 2); - end; - SurrogateLowStart..SurrogateLowEnd: - // error - FlagInvalidSequence(StrPos, 1); - else - // 1 byte to skip - Inc(StrPos); - end; - - if StrPos <> -1 then - Inc(Index); - - if (StrPos > StrLength) and (Index < NbSeq) then - begin - Result := False; - Break; - end; - end - else - while (Index > NbSeq) and (StrPos > 1) do - begin - Ch := UCS4(S[StrPos - 1]); - - case Ch of - SurrogateHighStart..SurrogateHighEnd: - // error - FlagInvalidSequence(StrPos, -1); - SurrogateLowStart..SurrogateLowEnd: - // 2 bytes to skip - if StrPos <= 2 then - FlagInvalidSequence(StrPos, -1) - else - begin - Ch := UCS4(S[StrPos - 2]); - if (Ch < SurrogateHighStart) or (Ch > SurrogateHighEnd) then - FlagInvalidSequence(StrPos, -1) - else - Dec(StrPos, 2); - end; - else - // 1 byte to skip - Dec(StrPos); - end; - - if StrPos <> -1 then - Dec(Index); - - if (StrPos = 1) and (Index > NbSeq) then - begin - Result := False; - Break; - end; - end; - NbSeq := Index; -end; - -// returns False if String is too small -// if UNICODE_SILENT_FAILURE is not defined StrPos is set to -1 on error (invalid UTF16 sequence) -// StrPos will be incremented by the number of chars that were skipped -// On return, NbSeq contains the number of UTF16 sequences that were skipped -{$IFDEF SUPPORTS_UNICODE_STRING} -function UTF16SkipChars(const S: WideString; var StrPos: SizeInt; var NbSeq: SizeInt): Boolean; -var - StrLength, Index: SizeInt; - Ch: UCS4; -begin - Result := True; - StrLength := Length(S); - - Index := 0; - if NbSeq >= 0 then - while (Index < NbSeq) and (StrPos > 0) do - begin - Ch := UCS4(S[StrPos]); - - case Ch of - SurrogateHighStart..SurrogateHighEnd: - // 2 bytes to skip - if StrPos >= StrLength then - FlagInvalidSequence(StrPos, 1) - else - begin - Ch := UCS4(S[StrPos + 1]); - if (Ch < SurrogateLowStart) or (Ch > SurrogateLowEnd) then - FlagInvalidSequence(StrPos, 1) - else - Inc(StrPos, 2); - end; - SurrogateLowStart..SurrogateLowEnd: - // error - FlagInvalidSequence(StrPos, 1); - else - // 1 byte to skip - Inc(StrPos); - end; - - if StrPos <> -1 then - Inc(Index); - - if (StrPos > StrLength) and (Index < NbSeq) then - begin - Result := False; - Break; - end; - end - else - while (Index > NbSeq) and (StrPos > 1) do - begin - Ch := UCS4(S[StrPos - 1]); - - case Ch of - SurrogateHighStart..SurrogateHighEnd: - // error - FlagInvalidSequence(StrPos, -1); - SurrogateLowStart..SurrogateLowEnd: - // 2 bytes to skip - if StrPos <= 2 then - FlagInvalidSequence(StrPos, -1) - else - begin - Ch := UCS4(S[StrPos - 2]); - if (Ch < SurrogateHighStart) or (Ch > SurrogateHighEnd) then - FlagInvalidSequence(StrPos, -1) - else - Dec(StrPos, 2); - end; - else - // 1 byte to skip - Dec(StrPos); - end; - - if StrPos <> -1 then - Dec(Index); - - if (StrPos = 1) and (Index > NbSeq) then - begin - Result := False; - Break; - end; - end; - NbSeq := Index; -end; -{$ENDIF SUPPORTS_UNICODE_STRING} - -function UTF16SkipCharsFromStream(S: TStream; var NbSeq: SizeInt): Boolean; -var - Index: SizeInt; - W: Word; -begin - Index := 0; - while Index < NbSeq do - begin - Result := StreamReadWord(S, W); - if not Result then - Break; - case W of - SurrogateHighStart..SurrogateHighEnd: - // 2 bytes to skip - begin - Result := StreamReadWord(S, W); - if not Result then - Break; - if (W < SurrogateLowStart) or (W > SurrogateLowEnd) then - FlagInvalidSequence; - end; - SurrogateLowStart..SurrogateLowEnd: - // error - FlagInvalidSequence; - else - // 1 byte to skip - // nothing to do - end; - Inc(Index); - end; - Result := Index = NbSeq; - NbSeq := Index; -end; - -// returns False on error: -// - if an UCS4 character cannot be stored to an UTF-8 string: -// - if UNICODE_SILENT_FAILURE is defined, ReplacementCharacter is added -// - if UNICODE_SILENT_FAILURE is not defined, StrPos is set to -1 -// - StrPos > -1 flags string being too small, caller is responsible for allocating space -// StrPos will be incremented by the number of chars that were written -function UTF16SetNextChar(var S: TUTF16String; var StrPos: SizeInt; Ch: UCS4): Boolean; -var - StrLength: SizeInt; -begin - StrLength := Length(S); - - if Ch <= MaximumUCS2 then - begin - // 16 bits to store in place - Result := (StrPos > 0) and (StrPos <= StrLength); - if Result then - begin - S[StrPos] := WideChar(Ch); - Inc(StrPos); - end; - end - else - if Ch <= MaximumUTF16 then - begin - // stores a surrogate pair - Result := (StrPos > 0) and (StrPos < StrLength); - if Result then - begin - Ch := Ch - HalfBase; - S[StrPos] := WideChar((Ch shr HalfShift) or SurrogateHighStart); - S[StrPos + 1] := WideChar((Ch and HalfMask) or SurrogateLowStart); - Inc(StrPos, 2); - end; - end - else - begin - {$IFDEF UNICODE_SILENT_FAILURE} - // add ReplacementCharacter - Result := (StrPos > 0) and (StrPos <= StrLength); - if Result then - begin - S[StrPos] := WideChar(UCS4ReplacementCharacter); - Inc(StrPos, 1); - end; - {$ELSE ~UNICODE_SILENT_FAILURE} - StrPos := -1; - Result := False; - {$ENDIF ~UNICODE_SILENT_FAILURE} - end; -end; - -function UTF16SetNextBuffer(var S: TUTF16String; var StrPos: SizeInt; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; -var - StrLength: SizeInt; - Ch: UCS4; - Success: Boolean; -begin - StrLength := Length(S); - Result := 0; - Success := True; - while Success and (Count > 0) do - begin - Ch := Buffer[Start]; - - if Ch <= MaximumUCS2 then - begin - // 16 bits to store in place - if (StrPos > 0) and (StrPos <= StrLength) then - begin - S[StrPos] := WideChar(Ch); - Inc(StrPos); - end - else - Success := False; - end - else - if Ch <= MaximumUTF16 then - begin - // stores a surrogate pair - if (StrPos > 0) and (StrPos < StrLength) then - begin - Ch := Ch - HalfBase; - S[StrPos] := WideChar((Ch shr HalfShift) or SurrogateHighStart); - S[StrPos + 1] := WideChar((Ch and HalfMask) or SurrogateLowStart); - Inc(StrPos, 2); - end - else - Success := False; - end - else - begin - {$IFDEF UNICODE_SILENT_FAILURE} - // add ReplacementCharacter - if (StrPos > 0) and (StrPos <= StrLength) then - begin - S[StrPos] := WideChar(UCS4ReplacementCharacter); - Inc(StrPos, 1); - end - else - Success := False; - {$ELSE ~UNICODE_SILENT_FAILURE} - StrPos := -1; - Success := False; - {$ENDIF ~UNICODE_SILENT_FAILURE} - end; - if Success then - begin - Inc(Start); - Inc(Result); - end; - Dec(Count); - end; -end; - -{$IFDEF SUPPORTS_UNICODE_STRING} -function UTF16SetNextChar(var S: WideString; var StrPos: SizeInt; Ch: UCS4): Boolean; -var - StrLength: SizeInt; -begin - StrLength := Length(S); - - if Ch <= MaximumUCS2 then - begin - // 16 bits to store in place - Result := (StrPos > 0) and (StrPos <= StrLength); - if Result then - begin - S[StrPos] := WideChar(Ch); - Inc(StrPos); - end; - end - else - if Ch <= MaximumUTF16 then - begin - // stores a surrogate pair - Result := (StrPos > 0) and (StrPos < StrLength); - if Result then - begin - Ch := Ch - HalfBase; - S[StrPos] := WideChar((Ch shr HalfShift) + SurrogateHighStart); - S[StrPos + 1] := WideChar((Ch and HalfMask) + SurrogateLowStart); - Inc(StrPos, 2); - end; - end - else - begin - {$IFDEF UNICODE_SILENT_FAILURE} - // add ReplacementCharacter - Result := (StrPos > 0) and (StrPos <= StrLength); - if Result then - begin - S[StrPos] := WideChar(UCS4ReplacementCharacter); - Inc(StrPos, 1); - end; - {$ELSE ~UNICODE_SILENT_FAILURE} - StrPos := -1; - Result := False; - {$ENDIF ~UNICODE_SILENT_FAILURE} - end; -end; - -function UTF16SetNextBuffer(var S: WideString; var StrPos: SizeInt; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; -var - StrLength: SizeInt; - Ch: UCS4; - Success: Boolean; -begin - StrLength := Length(S); - Result := 0; - Success := True; - while Success and (Count > 0) do - begin - Ch := Buffer[Start]; - - if Ch <= MaximumUCS2 then - begin - // 16 bits to store in place - if (StrPos > 0) and (StrPos <= StrLength) then - begin - S[StrPos] := WideChar(Ch); - Inc(StrPos); - end - else - Success := False; - end - else - if Ch <= MaximumUTF16 then - begin - // stores a surrogate pair - if (StrPos > 0) and (StrPos < StrLength) then - begin - Ch := Ch - HalfBase; - S[StrPos] := WideChar((Ch shr HalfShift) or SurrogateHighStart); - S[StrPos + 1] := WideChar((Ch and HalfMask) or SurrogateLowStart); - Inc(StrPos, 2); - end - else - Success := False; - end - else - begin - {$IFDEF UNICODE_SILENT_FAILURE} - // add ReplacementCharacter - if (StrPos > 0) and (StrPos <= StrLength) then - begin - S[StrPos] := WideChar(UCS4ReplacementCharacter); - Inc(StrPos, 1); - end - else - Success := False; - {$ELSE ~UNICODE_SILENT_FAILURE} - StrPos := -1; - Success := False; - {$ENDIF ~UNICODE_SILENT_FAILURE} - end; - if Success then - begin - Inc(Start); - Inc(Result); - end; - Dec(Count); - end; -end; -{$ENDIF SUPPORTS_UNICODE_STRING} - -function UTF16SetNextCharToStream(S: TStream; Ch: UCS4): Boolean; -begin - if Ch <= MaximumUCS2 then - // 16 bits to store in place - Result := StreamWriteWord(S, Ch) - else - if Ch <= MaximumUTF16 then - // stores a surrogate pair - Result := StreamWriteWord(S, (Ch shr HalfShift) or SurrogateHighStart) and - StreamWriteWord(S, (Ch and HalfMask) or SurrogateLowStart) - else - begin - {$IFDEF UNICODE_SILENT_FAILURE} - // add ReplacementCharacter - Result := StreamWriteWord(S, UCS4ReplacementCharacter); - {$ELSE ~UNICODE_SILENT_FAILURE} - Result := False; - {$ENDIF ~UNICODE_SILENT_FAILURE} - end; -end; - -function UTF16SetNextBufferToStream(S: TStream; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; -var - Ch: UCS4; - Success: Boolean; -begin - Result := 0; - Success := True; - while Success and (Count > 0) do - begin - Ch := Buffer[Start]; - if Ch <= MaximumUCS2 then - // 16 bits to store in place - Success := StreamWriteWord(S, Ch) - else - if Ch <= MaximumUTF16 then - // stores a surrogate pair - Success := StreamWriteWord(S, (Ch shr HalfShift) or SurrogateHighStart) and - StreamWriteWord(S, (Ch and HalfMask) or SurrogateLowStart) - else - begin - {$IFDEF UNICODE_SILENT_FAILURE} - // add ReplacementCharacter - Success := StreamWriteWord(S, UCS4ReplacementCharacter); - {$ELSE ~UNICODE_SILENT_FAILURE} - Success := False; - {$ENDIF ~UNICODE_SILENT_FAILURE} - end; - if Success then - begin - Inc(Start); - Inc(Result); - end; - Dec(Count); - end; -end; - -// AnsiGetNextChar = read next character at StrPos -// StrPos will be incremented by the number of chars that were read (1) -function AnsiGetNextChar(const S: AnsiString; var StrPos: SizeInt): UCS4; -var - StrLen, TmpPos: SizeInt; - UTF16Buffer: TUTF16String; -begin - StrLen := Length(S); - - if (StrPos <= StrLen) and (StrPos > 0) then - begin - UTF16Buffer := WideString(S[StrPos]); - TmpPos := 1; - Result := UTF16GetNextChar(UTF16Buffer, TmpPos); - if TmpPos = -1 then - StrPos := -1 - else - Inc(StrPos); - end - else - begin - // StrPos > StrLength - Result := 0; - FlagInvalidSequence(StrPos, 0, Result); - end; -end; - -function AnsiGetNextBuffer(const S: AnsiString; var StrPos: SizeInt; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; -var - StrLength, TmpPos: SizeInt; - UTF16Buffer: TUTF16String; -begin - StrLength := Length(S); - if (StrPos > 0) and (StrPos <= StrLength) then - begin - UTF16Buffer := WideString(Copy(S, StrPos, Count)); - TmpPos := 1; - Result := UTF16GetNextBuffer(UTF16Buffer, TmpPos, Buffer, Start, Count); - if TmpPos > 0 then - Inc(StrPos, Result) - else - StrPos := -1; - end - else - Result := 0; -end; - -function AnsiGetNextCharFromStream(S: TStream; out Ch: UCS4): Boolean; -var - B: Byte; - TmpPos: SizeInt; - UTF16Buffer: TUTF16String; -begin - Result := StreamReadByte(S, B); - if Result then - begin - UTF16Buffer := WideString(AnsiString(AnsiChar(B))); - TmpPos := 1; - Ch := UTF16GetNextChar(UTF16Buffer, TmpPos); - Result := TmpPos <> -1; - end; -end; - -function AnsiGetNextBufferFromStream(S: TStream; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; -var - B: TDynByteArray; - ReadSuccess: Boolean; - ReadCount, TmpPos: SizeInt; - UTF16Buffer: TUTF16String; -begin - Result := 0; - ReadSuccess := True; - SetLength(B, Count); - SetLength(UTF16Buffer, 2 * Count); - while ReadSuccess and (Count > 0) do - begin - ReadCount := S.Read(B[0], Count); - if ReadCount > 0 then - begin - ReadCount := MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED or MB_ERR_INVALID_CHARS, @B[0], ReadCount, PWideChar(UTF16Buffer), 2 * Count); - if ReadCount > 0 then - begin - TmpPos := 1; - ReadCount := UTF16GetNextBuffer(UTF16Buffer, TmpPos, Buffer, Start, ReadCount); - if TmpPos <> -1 then - Inc(Result, ReadCount) - else - ReadSuccess := False; - end - else - begin - Result := 0; - FlagInvalidSequence; - end; - end - else - ReadSuccess := False; - Dec(Count, ReadCount); - end; -end; - -// AnsiGetNextChar = read next character at StrPos -// StrPos will be incremented by the number of chars that were read (1) -function AnsiGetNextChar(const S: AnsiString; CodePage: Word; var StrPos: SizeInt): UCS4; -var - StrLen, TmpPos: SizeInt; - UTF16Buffer: TUTF16String; -begin - StrLen := Length(S); - - if (StrPos <= StrLen) and (StrPos > 0) then - begin - SetLength(UTF16Buffer, 2); - if MultiByteToWideChar(CodePage, MB_PRECOMPOSED or MB_ERR_INVALID_CHARS, @S[StrPos], 1, PWideChar(UTF16Buffer), 2) > 0 then - begin - TmpPos := 1; - Result := UTF16GetNextChar(UTF16Buffer, TmpPos); - if TmpPos > 0 then - Inc(StrPos) - else - StrPos := -1; - end - else - begin - Result := UCS4ReplacementCharacter; - FlagInvalidSequence(StrPos, 1, Result); - end; - end - else - begin - // StrPos > StrLength - Result := 0; - FlagInvalidSequence(StrPos, 0, Result); - end; -end; - -function AnsiGetNextBuffer(const S: AnsiString; CodePage: Word; var StrPos: SizeInt; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; -var - ReadCount, StrLength, TmpPos: SizeInt; - UTF16Buffer: TUTF16String; -begin - StrLength := Length(S); - if (StrPos > 0) and (StrPos <= StrLength) then - begin - SetLength(Buffer, 2 * Count); - ReadCount :=MultiByteToWideChar(CodePage, MB_PRECOMPOSED or MB_ERR_INVALID_CHARS, @S[StrPos], Count, PWideChar(UTF16Buffer), 2 * Count); - if ReadCount > 0 then - begin - TmpPos := 1; - Result := UTF16GetNextBuffer(UTF16Buffer, TmpPos, Buffer, Start, ReadCount); - if TmpPos > 0 then - Inc(StrPos, Result) - else - StrPos := -1; - end - else - begin - Result := 0; - FlagInvalidSequence(StrPos, 1); - end; - end - else - Result := 0; -end; - -function AnsiGetNextCharFromStream(S: TStream; CodePage: Word; out Ch: UCS4): Boolean; -var - B: Byte; - TmpPos: SizeInt; - UTF16Buffer: TUTF16String; -begin - Result := StreamReadByte(S, B); - if Result then - begin - SetLength(UTF16Buffer, 2); - if MultiByteToWideChar(CodePage, MB_PRECOMPOSED or MB_ERR_INVALID_CHARS, @B, 1, PWideChar(UTF16Buffer), 2) <> 0 then - begin - TmpPos := 1; - Ch := UTF16GetNextChar(UTF16Buffer, TmpPos); - Result := TmpPos <> -1; - end - else - begin - Result := False; - Ch := UCS4ReplacementCharacter; - end; - end; -end; - -function AnsiGetNextBufferFromStream(S: TStream; CodePage: Word; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; -var - B: TDynByteArray; - ReadSuccess: Boolean; - ReadCount, TmpPos: SizeInt; - UTF16Buffer: TUTF16String; -begin - Result := 0; - ReadSuccess := True; - SetLength(B, Count); - SetLength(UTF16Buffer, 2 * Count); - while ReadSuccess and (Count > 0) do - begin - ReadCount := S.Read(B[0], Count); - if ReadCount > 0 then - begin - ReadCount := MultiByteToWideChar(CodePage, MB_PRECOMPOSED or MB_ERR_INVALID_CHARS, @B[0], ReadCount, PWideChar(UTF16Buffer), 2 * Count); - if ReadCount > 0 then - begin - TmpPos := 1; - ReadCount := UTF16GetNextBuffer(UTF16Buffer, TmpPos, Buffer, Start, ReadCount); - if TmpPos <> -1 then - Inc(Result, ReadCount) - else - ReadSuccess := False; - end - else - begin - Result := 0; - FlagInvalidSequence; - end; - end - else - ReadSuccess := False; - Dec(Count, ReadCount); - end; -end; - -// AnsiSkipChars = skip NbSeq characters starting from StrPos -// returns False if String is too small -// StrPos will be incremented by the number of chars that were skipped -// On return, NbChar contains the number of chars that were skipped -function AnsiSkipChars(const S: AnsiString; var StrPos: SizeInt; var NbSeq: SizeInt): Boolean; -var - StrLen: SizeInt; -begin - StrLen := Length(S); - - if StrPos > 0 then - begin - if StrPos + NbSeq > StrLen then - begin - NbSeq := StrLen + 1 - StrPos; - StrPos := StrLen + 1; - Result := False; - end - else - begin - // NbSeq := NbSeq; - StrPos := StrLen + NbSeq; - Result := True; - end; - end - else - begin - // previous error - NbSeq := 0; - // StrPos := -1; - Result := False; - end; -end; - -function AnsiSkipCharsFromStream(S: TStream; var NbSeq: SizeInt): Boolean; -var - Index: SizeInt; - B: Byte; -begin - Index := 0; - while Index < NbSeq do - begin - Result := StreamReadByte(S, B); - if not Result then - Break; - Inc(Index); - end; - Result := Index = NbSeq; - NbSeq := Index; -end; - -// AnsiSetNextChar = append a character at StrPos -// returns False on error: -// - if an UCS4 character cannot be stored to an ansi string: -// - if UNICODE_SILENT_FAILURE is defined, ReplacementCharacter is added -// - if UNICODE_SILENT_FAILURE is not defined, StrPos is set to -1 -// - StrPos > -1 flags string being too small, callee did nothing and caller is responsible for allocating space -// StrPos will be incremented by the number of chars that were written (1) -function AnsiSetNextChar(var S: AnsiString; var StrPos: SizeInt; Ch: UCS4): Boolean; -var - StrLen, TmpPos, AnsiStrLen: SizeInt; - UTF16Buffer: TUTF16String; - AnsiBuffer: AnsiString; -begin - StrLen := Length(S); - Result := (StrPos > 0) and (StrPos <= StrLen); - if Result then - begin - SetLength(UTF16Buffer, 2); - TmpPos := 1; - Result := UTF16SetNextChar(UTF16Buffer, TmpPos, Ch); - if Result and (TmpPos = 2) then - // one wide character - AnsiBuffer := AnsiString(WideString(UTF16Buffer[1])) - else - if Result and (TmpPos = 3) then - // one surrogate pair - AnsiBuffer := AnsiString(UTF16Buffer) - else - begin - // add ReplacementCharacter - AnsiBuffer := AnsiReplacementCharacter; - {$IFDEF UNICODE_SILENT_FAILURE} - Result := True; - {$ELSE} - StrPos := -1; - {$ENDIF UNICODE_SILENT_FAILURE} - end; - AnsiStrLen := Length(AnsiBuffer); - Result := Result and ((StrPos + AnsiStrLen) <= (StrLen + 1)); - if Result then - begin - for TmpPos := 1 to AnsiStrLen do - begin - S[StrPos] := AnsiBuffer[TmpPos]; - Inc(StrPos); - end; - end; - end; -end; - -function AnsiSetNextBuffer(var S: AnsiString; var StrPos: SizeInt; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; -var - AnsiBuffer: AnsiString; - UTF16Buffer: WideString; - StrLen, TmpPos, AnsiStrLen: SizeInt; - Ch: UCS4; - Success: Boolean; -begin - StrLen:= Length(S); - SetLength(UTF16Buffer, 2); - Result := 0; - Success := True; - while Success and (Count > 0) do - begin - Ch := Buffer[Start]; - - TmpPos := 1; - Success := UTF16SetNextChar(UTF16Buffer, TmpPos, Ch); - if Success and (TmpPos = 2) then - // one wide character - AnsiBuffer := AnsiString(WideString(UTF16Buffer[1])) - else - if Success and (TmpPos = 3) then - // one surrogate pair - AnsiBuffer := AnsiString(UTF16Buffer) - else - begin - // add ReplacementCharacter - AnsiBuffer := AnsiReplacementCharacter; - {$IFDEF UNICODE_SILENT_FAILURE} - Success := True; - {$ELSE} - StrPos := -1; - {$ENDIF ~UNICODE_SILENT_FAILURE} - end; - AnsiStrLen := Length(AnsiBuffer); - Success := Success and ((StrPos + AnsiStrLen) <= (StrLen + 1)); - if Success then - begin - for TmpPos := 1 to AnsiStrLen do - begin - S[StrPos] := AnsiBuffer[TmpPos]; - Inc(StrPos); - end; - end; - if Success then - begin - Inc(Start); - Inc(Result); - end; - Dec(Count); - end; -end; - -function AnsiSetNextCharToStream(S: TStream; Ch: UCS4): Boolean; -var - TmpPos, I: SizeInt; - UTF16Buffer: TUTF16String; - AnsiBuffer: AnsiString; -begin - SetLength(UTF16Buffer, 2); - TmpPos := 1; - Result := UTF16SetNextChar(UTF16Buffer, TmpPos, Ch); - - if Result and (TmpPos = 2) then - // one wide character - AnsiBuffer := AnsiString(WideString(UTF16Buffer[1])) - else - if Result and (TmpPos = 3) then - // one surrogate pair - AnsiBuffer := AnsiString(UTF16Buffer) - else - begin - // add ReplacementCharacter - AnsiBuffer := AnsiReplacementCharacter; - {$IFDEF UNICODE_SILENT_FAILURE} - Result := True; - {$ENDIF UNICODE_SILENT_FAILURE} - end; - if Result then - for I := 1 to Length(AnsiBuffer) do - Result := Result and StreamWriteByte(S, Ord(AnsiBuffer[I])); -end; - -function AnsiSetNextBufferToStream(S: TStream; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; -var - TmpPos, I: SizeInt; - UTF16Buffer: TUTF16String; - AnsiBuffer: AnsiString; - Success: Boolean; - Ch: UCS4; -begin - SetLength(UTF16Buffer, 2); - Result := 0; - Success := True; - while Success and (Count > 0) do - begin - Ch := Buffer[Start]; - TmpPos := 1; - Success := UTF16SetNextChar(UTF16Buffer, TmpPos, Ch); - - if Success and (TmpPos = 2) then - // one wide character - AnsiBuffer := AnsiString(WideString(UTF16Buffer[1])) - else - if Success and (TmpPos = 3) then - // one surrogate pair - AnsiBuffer := AnsiString(UTF16Buffer) - else - begin - // add ReplacementCharacter - AnsiBuffer := AnsiReplacementCharacter; - {$IFDEF UNICODE_SILENT_FAILURE} - Success := True; - {$ENDIF UNICODE_SILENT_FAILURE} - end; - if Success then - for I := 1 to Length(AnsiBuffer) do - Success := Success and StreamWriteByte(S, Ord(AnsiBuffer[I])); - if Success then - begin - Inc(Start); - Inc(Result); - end; - Dec(Count); - end; -end; - -function AnsiSetNextChar(var S: AnsiString; CodePage: Word; var StrPos: SizeInt; Ch: UCS4): Boolean; -var - StrLen, TmpPos, AnsiStrLen: SizeInt; - UTF16Buffer: TUTF16String; - AnsiBuffer: AnsiString; -begin - StrLen := Length(S); - Result := (StrPos > 0) and (StrPos <= StrLen); - if Result then - begin - SetLength(UTF16Buffer, 2); - TmpPos := 1; - Result := UTF16SetNextChar(UTF16Buffer, TmpPos, Ch); - AnsiStrLen := WideCharToMultiByte(CodePage, 0, PWideChar(UTF16Buffer), TmpPos-1, nil, 0, nil, nil); - SetLength(AnsiBuffer, AnsiStrLen); - Result := Result and (WideCharToMultiByte(CodePage, 0, PWideChar(UTF16Buffer), TmpPos-1, @AnsiBuffer[1], AnsiStrLen, nil, nil) > 0); - if not Result then - begin - // add ReplacementCharacter - AnsiBuffer := AnsiReplacementCharacter; - AnsiStrLen := 1; - {$IFDEF UNICODE_SILENT_FAILURE} - Result := True; - {$ELSE} - StrPos := -1; - {$ENDIF ~UNICODE_SILENT_FAILURE} - end; - Result := Result and ((StrPos + AnsiStrLen) <= (StrLen + 1)); - if Result then - for TmpPos := 1 to AnsiStrLen do - begin - S[StrPos] := AnsiBuffer[TmpPos]; - Inc(StrPos); - end; - end; -end; - -function AnsiSetNextBuffer(var S: AnsiString; CodePage: Word; var StrPos: SizeInt; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; -var - StrLen, TmpPos, AnsiStrLen: SizeInt; - UTF16Buffer: TUTF16String; - AnsiBuffer: AnsiString; - Ch: UCS4; - Success: Boolean; -begin - StrLen:= Length(S); - SetLength(UTF16Buffer, 2); - Result := 0; - Success := True; - while Success and (Count > 0) do - begin - Ch := Buffer[Start]; - - TmpPos := 1; - Success := UTF16SetNextChar(UTF16Buffer, TmpPos, Ch); - AnsiStrLen := WideCharToMultiByte(CodePage, 0, PWideChar(UTF16Buffer), TmpPos-1, nil, 0, nil, nil); - SetLength(AnsiBuffer, AnsiStrLen); - Success := Success and (WideCharToMultiByte(CodePage, 0, PWideChar(UTF16Buffer), TmpPos-1, @AnsiBuffer[1], AnsiStrLen, nil, nil) > 0); - if not Success then - begin - // add ReplacementCharacter - AnsiBuffer := AnsiReplacementCharacter; - AnsiStrLen := 1; - {$IFDEF UNICODE_SILENT_FAILURE} - Success := True; - {$ELSE} - StrPos := -1; - {$ENDIF UNICODE_SILENT_FAILURE} - end; - Success := Success and ((StrPos + AnsiStrLen) <= (StrLen + 1)); - if Success then - for TmpPos := 1 to AnsiStrLen do - begin - S[StrPos] := AnsiBuffer[TmpPos]; - Inc(StrPos); - end; - if Success then - begin - Inc(Start); - Inc(Result); - end; - Dec(Count); - end; -end; - -function AnsiSetNextCharToStream(S: TStream; CodePage: Word; Ch: UCS4): Boolean; -var - TmpPos, AnsiStrLen: SizeInt; - UTF16Buffer: TUTF16String; - AnsiBuffer: AnsiString; -begin - SetLength(UTF16Buffer, 2); - TmpPos := 1; - Result := UTF16SetNextChar(UTF16Buffer, TmpPos, Ch); - AnsiStrLen := WideCharToMultiByte(CodePage, 0, PWideChar(UTF16Buffer), TmpPos-1, nil, 0, nil, nil); - SetLength(AnsiBuffer, AnsiStrLen); - Result := Result and (WideCharToMultiByte(CodePage, 0, PWideChar(UTF16Buffer), TmpPos-1, @AnsiBuffer[1], AnsiStrLen, nil, nil) > 0); - if not Result then - begin - // add ReplacementCharacter - AnsiBuffer := AnsiReplacementCharacter; - AnsiStrLen := 1; - {$IFDEF UNICODE_SILENT_FAILURE} - Result := True; - {$ENDIF UNICODE_SILENT_FAILURE} - end; - if Result then - for TmpPos := 1 to AnsiStrLen do - Result := Result and StreamWriteByte(S, Ord(AnsiBuffer[TmpPos])); -end; - -function AnsiSetNextBufferToStream(S: TStream; CodePage: Word; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; -var - TmpPos, AnsiStrLen: SizeInt; - UTF16Buffer: TUTF16String; - AnsiBuffer: AnsiString; - Success: Boolean; - Ch: UCS4; -begin - SetLength(UTF16Buffer, 2); - Result := 0; - Success := True; - while Success and (Count > 0) do - begin - Ch := Buffer[Start]; - TmpPos := 1; - Success := UTF16SetNextChar(UTF16Buffer, TmpPos, Ch); - AnsiStrLen := WideCharToMultiByte(CodePage, 0, PWideChar(UTF16Buffer), TmpPos-1, nil, 0, nil, nil); - SetLength(AnsiBuffer, AnsiStrLen); - Success := Success and (WideCharToMultiByte(CodePage, 0, PWideChar(UTF16Buffer), TmpPos-1, @AnsiBuffer[1], AnsiStrLen, nil, nil) > 0); - if not Success then - begin - // add ReplacementCharacter - AnsiBuffer := AnsiReplacementCharacter; - AnsiStrLen := 1; - {$IFDEF UNICODE_SILENT_FAILURE} - Success := True; - {$ENDIF UNICODE_SILENT_FAILURE} - end; - if Success then - for TmpPos := 1 to AnsiStrLen do - Success := Success and StreamWriteByte(S, Ord(AnsiBuffer[TmpPos])); - if Success then - begin - Inc(Start); - Inc(Result); - end; - Dec(Count); - end; -end; - -// StringGetNextChar = read next character/sequence at StrPos -// if UNICODE_SILENT_FAILURE is defined, invalid sequences will be replaced by ReplacementCharacter -// otherwise StrPos is set to -1 on return to flag an error (invalid UTF16 sequence for WideString) -// StrPos will be incremented by the number of chars that were read -function StringGetNextChar(const S: string; var StrPos: SizeInt): UCS4; -begin - {$IFDEF SUPPORTS_UNICODE} - Result := UTF16GetNextChar(S, StrPos); - {$ELSE ~SUPPORTS_UNICODE} - Result := AnsiGetNextChar(S, StrPos); - {$ENDIF ~SUPPORTS_UNICODE} -end; - -function StringGetNextBuffer(const S: string; var StrPos: SizeInt; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; -begin - {$IFDEF SUPPORTS_UNICODE} - Result := UTF16GetNextBuffer(S, StrPos, Buffer, Start, Count); - {$ELSE ~SUPPORTS_UNICODE} - Result := AnsiGetNextBuffer(S, StrPos, Buffer, Start, Count); - {$ENDIF ~SUPPORTS_UNICODE} -end; - -// StringSkipChars = skip NbSeq characters/sequences starting from StrPos -// returns False if String is too small -// if UNICODE_SILENT_FAILURE is not defined StrPos is set to -1 on error (invalid UTF16 sequence for WideString) -// StrPos will be incremented by the number of chars that were skipped -// On return, NbChar contains the number of UTF16 sequences that were skipped -function StringSkipChars(const S: string; var StrPos: SizeInt; var NbSeq: SizeInt): Boolean; -begin - {$IFDEF SUPPORTS_UNICODE} - Result := UTF16SkipChars(S, StrPos, NbSeq); - {$ELSE ~SUPPORTS_UNICODE} - Result := AnsiSkipChars(S, StrPos, NbSeq); - {$ENDIF ~SUPPORTS_UNICODE} -end; - -// StringSetNextChar = append a character/sequence at StrPos -// returns False on error: -// - if an UCS4 character cannot be stored to a string: -// - if UNICODE_SILENT_FAILURE is defined, ReplacementCharacter is added -// - if UNICODE_SILENT_FAILURE is not defined, StrPos is set to -1 -// - StrPos > -1 flags string being too small, callee did nothing and caller is responsible for allocating space -// StrPos will be incremented by the number of chars that were written -function StringSetNextChar(var S: string; var StrPos: SizeInt; Ch: UCS4): Boolean; -begin - {$IFDEF SUPPORTS_UNICODE} - Result := UTF16SetNextChar(S, StrPos, Ch); - {$ELSE ~SUPPORTS_UNICODE} - Result := AnsiSetNextChar(S, StrPos, Ch); - {$ENDIF ~SUPPORTS_UNICODE} -end; - -function StringSetNextBuffer(var S: string; var StrPos: SizeInt; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; -begin - {$IFDEF SUPPORTS_UNICODE} - Result := UTF16SetNextBuffer(S, StrPos, Buffer, Start, Count); - {$ELSE ~SUPPORTS_UNICODE} - Result := AnsiSetNextBuffer(S, StrPos, Buffer, Start, Count); - {$ENDIF ~SUPPORTS_UNICODE} -end; - -function WideStringToUTF8(const S: WideString): TUTF8String; -begin - Result := UTF16ToUTF8(S); -end; - -function UTF8ToWideString(const S: TUTF8String): WideString; -begin - Result := UTF8ToUTF16(S); -end; - -function WideStringToUCS4(const S: WideString): TUCS4Array; -begin - Result := UTF16ToUCS4(S); -end; - -function UCS4ToWideString(const S: TUCS4Array): WideString; -begin - Result := UCS4ToUTF16(S); -end; - -function AnsiStringToUTF8(const S: AnsiString): TUTF8String; -var - WS: TUTF16String; -begin - WS := TUTF16String(S); - Result := UTF16ToUTF8(WS); -end; - -function UTF8ToAnsiString(const S: TUTF8String): AnsiString; -var - WS: TUTF16String; -begin - WS := UTF8ToUTF16(S); - Result := AnsiString(WS); -end; - -function AnsiStringToUTF16(const S: AnsiString): TUTF16String; -begin - Result := TUTF16String(S); -end; - -function UTF16ToAnsiString(const S: TUTF16String): AnsiString; -begin - Result := AnsiString(S); -end; - -function AnsiStringToUCS4(const S: AnsiString): TUCS4Array; -var - WS: TUTF16String; -begin - WS := TUTF16String(S); - Result := UTF16ToUCS4(WS); -end; - -function UCS4ToAnsiString(const S: TUCS4Array): AnsiString; -var - WS: TUTF16String; -begin - WS := UCS4ToUTF16(S); - Result := AnsiString(WS); -end; - -function StringToUTF8(const S: string): TUTF8String; -var - WS: TUTF16String; -begin - WS := TUTF16String(S); - Result := UTF16ToUTF8(WS); -end; - -function TryStringToUTF8(const S: string; out D: TUTF8String): Boolean; -var - WS: TUTF16String; -begin - WS := TUTF16String(S); - Result := TryUTF16ToUTF8(WS, D); -end; - -function UTF8ToString(const S: TUTF8String): string; -var - WS: TUTF16String; -begin - WS := UTF8ToUTF16(S); - Result := string(WS); -end; - -function TryUTF8ToString(const S: TUTF8String; out D: string): Boolean; -var - WS: TUTF16String; -begin - Result := TryUTF8ToUTF16(S, WS); - D := string(WS); -end; - -function StringToUTF16(const S: string): TUTF16String; -begin - Result := TUTF16String(S); -end; - -function TryStringToUTF16(const S: string; out D: TUTF16String): Boolean; -begin - D := TUTF16String(S); - Result := True; -end; - -function UTF16ToString(const S: TUTF16String): string; -begin - Result := string(S); -end; - -function TryUTF16ToString(const S: TUTF16String; out D: string): Boolean; -begin - D := string(S); - Result := True; -end; - -function StringToUCS4(const S: string): TUCS4Array; -var - WS: TUTF16String; -begin - WS := TUTF16String(S); - Result := UTF16ToUCS4(WS); -end; - -function TryStringToUCS4(const S: string; out D: TUCS4Array): Boolean; -var - WS: TUTF16String; -begin - WS := TUTF16String(S); - Result := TryUTF16ToUCS4(WS, D); -end; - -function UCS4ToString(const S: TUCS4Array): string; -var - WS: WideString; -begin - WS := UCS4ToUTF16(S); - Result := string(WS); -end; - -function TryUCS4ToString(const S: TUCS4Array; out D: string): Boolean; -var - WS: TUTF16String; -begin - Result := TryUCS4ToUTF16(S, WS); - D := string(WS); -end; - -function UTF8ToUTF16(const S: TUTF8String): TUTF16String; -var - SrcIndex, SrcLength, DestIndex: SizeInt; - Ch: UCS4; -begin - if S = '' then - Result := '' - else - begin - SrcLength := Length(S); - SetLength(Result, SrcLength); // create enough room - - SrcIndex := 1; - DestIndex := 1; - while SrcIndex <= SrcLength do - begin - Ch := UTF8GetNextChar(S, SrcIndex); - if SrcIndex = -1 then - raise EJclUnexpectedEOSequenceError.Create; - - UTF16SetNextChar(Result, DestIndex, Ch); - end; - SetLength(Result, DestIndex - 1); // now fix up length - end; -end; - -function TryUTF8ToUTF16(const S: TUTF8String; out D: TUTF16String): Boolean; -var - SrcIndex, SrcLength, DestIndex: SizeInt; - Ch: UCS4; -begin - Result := True; - if S = '' then - D := '' - else - begin - SrcLength := Length(S); - SetLength(D, SrcLength); // create enough room - - SrcIndex := 1; - DestIndex := 1; - while (SrcIndex > 0) and (SrcIndex <= SrcLength) do - begin - Ch := UTF8GetNextChar(S, SrcIndex); - if SrcIndex > 0 then - UTF16SetNextChar(D, DestIndex, Ch) - else - Result := False; - end; - if Result then - SetLength(D, DestIndex - 1) // now fix up length - else - D := ''; - end; -end; - -function UTF16ToUTF8(const S: TUTF16String): TUTF8String; -var - SrcIndex, SrcLength, DestIndex: SizeInt; - Ch: UCS4; -begin - if S = '' then - Result := '' - else - begin - SrcLength := Length(S); - SetLength(Result, SrcLength * 3); // worste case - - SrcIndex := 1; - DestIndex := 1; - while SrcIndex <= SrcLength do - begin - Ch := UTF16GetNextChar(S, SrcIndex); - if SrcIndex = -1 then - raise EJclUnexpectedEOSequenceError.Create; - - UTF8SetNextChar(Result, DestIndex, Ch); - end; - SetLength(Result, DestIndex - 1); // now fix up length - end; -end; - -function TryUTF16ToUTF8(const S: TUTF16String; out D: TUTF8String): Boolean; -var - SrcIndex, SrcLength, DestIndex: SizeInt; - Ch: UCS4; -begin - Result := True; - if S = '' then - D := '' - else - begin - SrcLength := Length(S); - SetLength(D, SrcLength * 3); // worste case - - SrcIndex := 1; - DestIndex := 1; - while (SrcIndex > 0) and (SrcIndex <= SrcLength) do - begin - Ch := UTF16GetNextChar(S, SrcIndex); - if SrcIndex > 0 then - UTF8SetNextChar(D, DestIndex, Ch) - else - Result := False; - end; - if Result then - SetLength(D, DestIndex - 1) // now fix up length - else - D := ''; - end; -end; - -function UTF8ToUCS4(const S: TUTF8String): TUCS4Array; -var - SrcIndex, SrcLength, DestIndex: SizeInt; - Ch: UCS4; -begin - if S <> '' then - begin - SrcLength := Length(S); - SetLength(Result, SrcLength); // create enough room - - SrcIndex := 1; - DestIndex := 0; - while SrcIndex <= SrcLength do - begin - Ch := UTF8GetNextChar(S, SrcIndex); - if SrcIndex = -1 then - raise EJclUnexpectedEOSequenceError.Create; - - Result[DestIndex] := Ch; - Inc(DestIndex); - end; - SetLength(Result, DestIndex); // now fix up length - end; -end; - -function TryUTF8ToUCS4(const S: TUTF8String; out D: TUCS4Array): Boolean; -var - SrcIndex, SrcLength, DestIndex: SizeInt; - Ch: UCS4; -begin - Result := True; - if S <> '' then - begin - SrcLength := Length(S); - SetLength(D, SrcLength); // create enough room - - SrcIndex := 1; - DestIndex := 0; - while (SrcIndex > 0) and (SrcIndex <= SrcLength) do - begin - Ch := UTF8GetNextChar(S, SrcIndex); - if SrcIndex > 0 then - begin - D[DestIndex] := Ch; - Inc(DestIndex); - end - else - Result := False; - end; - if Result then - SetLength(D, DestIndex) // now fix up length - else - SetLength(D, 0); - end; -end; - -function UCS4ToUTF8(const S: TUCS4Array): TUTF8String; -var - SrcIndex, SrcLength, DestIndex: SizeInt; -begin - SrcLength := Length(S); - if Length(S) = 0 then - Result := '' - else - begin - SetLength(Result, SrcLength * 3); // assume worst case - DestIndex := 1; - - for SrcIndex := 0 to SrcLength - 1 do - begin - UTF8SetNextChar(Result, DestIndex, S[SrcIndex]); - if DestIndex = -1 then - raise EJclUnexpectedEOSequenceError.Create; - end; - - SetLength(Result, DestIndex - 1); // set to actual length - end; -end; - -function TryUCS4ToUTF8(const S: TUCS4Array; out D: TUTF8String): Boolean; -var - SrcIndex, SrcLength, DestIndex: SizeInt; -begin - SrcLength := Length(S); - Result := True; - if Length(S) = 0 then - D := '' - else - begin - SetLength(D, SrcLength * 3); // assume worst case - DestIndex := 1; - - for SrcIndex := 0 to SrcLength - 1 do - begin - UTF8SetNextChar(D, DestIndex, S[SrcIndex]); - if DestIndex = -1 then - begin - Result := False; - Break; - end; - end; - if Result then - SetLength(D, DestIndex - 1) // set to actual length - else - D := ''; - end; -end; - -function UTF16ToUCS4(const S: TUTF16String): TUCS4Array; -var - SrcIndex, SrcLength, DestIndex: SizeInt; - Ch: UCS4; -begin - if S <> '' then - begin - SrcLength := Length(S); - SetLength(Result, SrcLength); // create enough room - - SrcIndex := 1; - DestIndex := 0; - while SrcIndex <= SrcLength do - begin - Ch := UTF16GetNextChar(S, SrcIndex); - if SrcIndex = -1 then - raise EJclUnexpectedEOSequenceError.Create; - - Result[DestIndex] := Ch; - Inc(DestIndex); - end; - SetLength(Result, DestIndex); // now fix up length - end; -end; - -function TryUTF16ToUCS4(const S: TUTF16String; out D: TUCS4Array): Boolean; -var - SrcIndex, SrcLength, DestIndex: SizeInt; - Ch: UCS4; -begin - Result := True; - if S <> '' then - begin - SrcLength := Length(S); - SetLength(D, SrcLength); // create enough room - - SrcIndex := 1; - DestIndex := 0; - while (SrcIndex > 0) and (SrcIndex <= SrcLength) do - begin - Ch := UTF16GetNextChar(S, SrcIndex); - if SrcIndex > 0 then - begin - D[DestIndex] := Ch; - Inc(DestIndex); - end - else - Result := False; - end; - if Result then - SetLength(D, DestIndex) // now fix up length - else - SetLength(D, 0); - end; -end; - -function UCS4ToUTF16(const S: TUCS4Array): TUTF16String; -var - SrcIndex, SrcLength, DestIndex: SizeInt; -begin - SrcLength := Length(S); - if SrcLength = 0 then - Result := '' - else - begin - SetLength(Result, SrcLength * 3); // assume worst case - DestIndex := 1; - - for SrcIndex := 0 to SrcLength - 1 do - begin - UTF16SetNextChar(Result, DestIndex, S[SrcIndex]); - if DestIndex = -1 then - raise EJclUnexpectedEOSequenceError.Create; - end; - - SetLength(Result, DestIndex - 1); // set to actual length - end; -end; - -function TryUCS4ToUTF16(const S: TUCS4Array; out D:TUTF16String): Boolean; -var - SrcIndex, SrcLength, DestIndex: SizeInt; -begin - SrcLength := Length(S); - Result := True; - if SrcLength = 0 then - D := '' - else - begin - SetLength(D, SrcLength * 3); // assume worst case - DestIndex := 1; - - for SrcIndex := 0 to SrcLength - 1 do - begin - UTF16SetNextChar(D, DestIndex, S[SrcIndex]); - if DestIndex = -1 then - begin - Result := False; - Break; - end; - end; - - if Result then - SetLength(D, DestIndex - 1) // set to actual length - else - D := ''; - end; -end; - -function UTF8CharCount(const S: TUTF8String): SizeInt; -var - StrPos: SizeInt; -begin - StrPos := 1; - Result := Length(S); - UTF8SkipChars(S, StrPos, Result); - if StrPos = -1 then - raise EJclUnexpectedEOSequenceError.Create; -end; - -function UTF16CharCount(const S: TUTF16String): SizeInt; -var - StrPos: SizeInt; -begin - StrPos := 1; - Result := Length(S); - UTF16SkipChars(S, StrPos, Result); - if StrPos = -1 then - raise EJclUnexpectedEOSequenceError.Create; -end; - -function UCS2CharCount(const S: TUCS2String): SizeInt; -begin - Result := Length(S); -end; - -function UCS4CharCount(const S: TUCS4Array): SizeInt; -begin - Result := Length(S); -end; - -function GetUCS4CharAt(const UTF8Str: TUTF8String; Index: SizeInt; out Value: UCS4): Boolean; overload; -var - StrPos: SizeInt; -begin - StrPos := 1; - Result := Index >= 0; - if Result then - Result := UTF8SkipChars(UTF8Str, StrPos, Index); - if StrPos = -1 then - raise EJclUnexpectedEOSequenceError.Create; - Result := Result and (StrPos <= Length(UTF8Str)); - if Result then - begin - Value := UTF8GetNextChar(UTF8Str, StrPos); - if StrPos = -1 then - raise EJclUnexpectedEOSequenceError.Create; - end; -end; - -function GetUCS4CharAt(const WideStr: TUTF16String; Index: SizeInt; out Value: UCS4; IsUTF16: Boolean): Boolean; overload; -var - StrPos: SizeInt; -begin - if IsUTF16 then - begin - StrPos := 1; - Result := Index >= 0; - if Result then - Result := UTF16SkipChars(WideStr, StrPos, Index); - if StrPos = -1 then - raise EJclUnexpectedEOSequenceError.Create; - Result := Result and (StrPos <= Length(WideStr)); - if Result then - begin - Value := UTF16GetNextChar(WideStr, StrPos); - if StrPos = -1 then - raise EJclUnexpectedEOSequenceError.Create; - end; - end - else - begin - Result := (Index >= 1) and (Index <= Length(WideStr)); - Value := UCS4(WideStr[Index]); - end; -end; - -function GetUCS4CharAt(const UCS4Str: TUCS4Array; Index: SizeInt; out Value: UCS4): Boolean; overload; -begin - Result := (Index >= 0) and (Index < Length(UCS4Str)); - if Result then - Value := UCS4Str[Index]; -end; - -function UCS4ToAnsiChar(Value: UCS4): AnsiChar; -var - Buf: WideString; - StrPos: SizeInt; -begin - StrPos := 1; - Buf := #0#0; - if UTF16SetNextChar(Buf, StrPos, Value) then - Result := AnsiString(Buf)[1] - else - Result := AnsiReplacementCharacter; -end; - -function UCS4ToWideChar(Value: UCS4): WideChar; -begin - if Value <= MaximumUCS2 then - Result := WideChar(Value) - else - Result := WideChar(UCS4ReplacementCharacter); -end; - -function UCS4ToChar(Value: UCS4): Char; -begin - {$IFDEF SUPPORTS_UNICODE} - Result := UCS4ToWideChar(Value); - {$ELSE ~SUPPORTS_UNICODE} - Result := UCS4ToAnsiChar(Value); - {$ENDIF ~SUPPORTS_UNICODE} -end; - -function AnsiCharToUCS4(Value: AnsiChar): UCS4; -var - Buf: WideString; - StrPos: SizeInt; -begin - StrPos := 1; - Buf := WideString(AnsiString(Value)); - Result := UTF16GetNextChar(Buf, StrPos); -end; - -function WideCharToUCS4(Value: WideChar): UCS4; -begin - Result := UCS4(Value); -end; - -function CharToUCS4(Value: Char): UCS4; -begin - {$IFDEF SUPPORTS_UNICODE} - Result := WideCharToUCS4(Value); - {$ELSE ~SUPPORTS_UNICODE} - Result := AnsiCharToUCS4(Value); - {$ENDIF ~SUPPORTS_UNICODE} -end; - -{$IFDEF UNITVERSIONING} -initialization - RegisterUnitVersion(HInstance, UnitVersioning); - -finalization - UnregisterUnitVersion(HInstance); -{$ENDIF UNITVERSIONING} - -end. +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclUnicode.pas. } +{ } +{ The Initial Developer of the Original Code is Mike Lischke (public att lischke-online dott de). } +{ Portions created by Mike Lischke are Copyright (C) 1999-2000 Mike Lischke. All Rights Reserved. } +{ } +{ Contributor(s): } +{ Marcel van Brakel } +{ Andreas Hausladen (ahuser) } +{ Mike Lischke } +{ Flier Lu (flier) } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Olivier Sannier (obones) } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ Peter Schraut (http://www.console-dev.de) } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ String conversion routines } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclStringConversions; + +{$I jcl.inc} + +interface + +uses + {$IFDEF HAS_UNITSCOPE} + System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Classes, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclBase; + +type + EJclStringConversionError = class(EJclError); + EJclUnexpectedEOSequenceError = class (EJclStringConversionError) + public + constructor Create; + end; + +// conversion routines between Ansi, UTF-16, UCS-4 and UTF8 strings + +// one shot conversion between PAnsiChar and PWideChar +procedure ExpandASCIIString(const Source: PAnsiChar; Target: PWideChar; Count: SizeInt); + +// tpye of stream related functions +type + TJclStreamGetNextCharFunc = function(S: TStream; out Ch: UCS4): Boolean; + TJclStreamSkipCharsFunc = function(S: TStream; var NbSeq: SizeInt): Boolean; + TJclStreamSetNextCharFunc = function(S: TStream; Ch: UCS4): Boolean; + +// iterative conversions + +// UTF8GetNextChar = read next UTF8 sequence at StrPos +// if UNICODE_SILENT_FAILURE is defined, invalid sequences will be replaced by ReplacementCharacter +// otherwise StrPos is set to -1 on return to flag an error (invalid UTF8 sequence) +// StrPos will be incremented by the number of chars that were read +function UTF8GetNextChar(const S: TUTF8String; var StrPos: SizeInt): UCS4; +function UTF8GetNextBuffer(const S: TUTF8String; var StrPos: SizeInt; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; +function UTF8GetNextCharFromStream(S: TStream; out Ch: UCS4): Boolean; +function UTF8GetNextBufferFromStream(S: TStream; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; + +// UTF8SkipChars = skip NbSeq UTF8 sequences starting from StrPos +// returns False if String is too small +// if UNICODE_SILENT_FAILURE is not defined StrPos is set to -1 on error (invalid UTF8 sequence) +// StrPos will be incremented by the number of chars that were skipped +// On return, NbSeq contains the number of UTF8 sequences that were skipped +function UTF8SkipChars(const S: TUTF8String; var StrPos: SizeInt; var NbSeq: SizeInt): Boolean; +function UTF8SkipCharsFromStream(S: TStream; var NbSeq: SizeInt): Boolean; + +// UTF8SetNextChar = append an UTF8 sequence at StrPos +// returns False on error: +// - if an UCS4 character cannot be stored to an UTF-8 string: +// - if UNICODE_SILENT_FAILURE is defined, ReplacementCharacter is added +// - if UNICODE_SILENT_FAILURE is not defined, StrPos is set to -1 +// - StrPos > -1 flags string being too small, callee did nothing, caller is responsible for allocating space +// StrPos will be incremented by the number of chars that were written +function UTF8SetNextChar(var S: TUTF8String; var StrPos: SizeInt; Ch: UCS4): Boolean; +function UTF8SetNextBuffer(var S: TUTF8String; var StrPos: SizeInt; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; +function UTF8SetNextCharToStream(S: TStream; Ch: UCS4): Boolean; +function UTF8SetNextBufferToStream(S: TStream; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; + +// UTF16GetNextChar = read next UTF16 sequence at StrPos +// if UNICODE_SILENT_FAILURE is defined, invalid sequences will be replaced by ReplacementCharacter +// otherwise StrPos is set to -1 on return to flag an error (invalid UTF16 sequence) +// StrPos will be incremented by the number of chars that were read +function UTF16GetNextChar(const S: TUTF16String; var StrPos: SizeInt): UCS4; overload; +function UTF16GetNextBuffer(const S: TUTF16String; var StrPos: SizeInt; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; +{$IFDEF SUPPORTS_UNICODE_STRING} +function UTF16GetNextChar(const S: WideString; var StrPos: SizeInt): UCS4; overload; +function UTF16GetNextBuffer(const S: WideString; var StrPos: SizeInt; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; +{$ENDIF SUPPORTS_UNICODE_STRING} +function UTF16GetNextCharFromStream(S: TStream; out Ch: UCS4): Boolean; +function UTF16GetNextBufferFromStream(S: TStream; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; + +// UTF16GetPreviousChar = read previous UTF16 sequence starting at StrPos-1 +// if UNICODE_SILENT_FAILURE is defined, invalid sequences will be replaced by ReplacementCharacter +// otherwise StrPos is set to -1 on return to flag an error (invalid UTF16 sequence) +// StrPos will be decremented by the number of chars that were read +function UTF16GetPreviousChar(const S: TUTF16String; var StrPos: SizeInt): UCS4; overload; +{$IFDEF SUPPORTS_UNICODE_STRING} +function UTF16GetPreviousChar(const S: WideString; var StrPos: SizeInt): UCS4; overload; +{$ENDIF SUPPORTS_UNICODE_STRING} + +// UTF16SkipChars = skip NbSeq UTF16 sequences starting from StrPos +// returns False if String is too small +// if UNICODE_SILENT_FAILURE is not defined StrPos is set to -1 on error (invalid UTF16 sequence) +// StrPos will be incremented by the number of chars that were skipped +// On return, NbChar contains the number of UTF16 sequences that were skipped +function UTF16SkipChars(const S: TUTF16String; var StrPos: SizeInt; var NbSeq: SizeInt): Boolean; overload; +{$IFDEF SUPPORTS_UNICODE_STRING} +function UTF16SkipChars(const S: WideString; var StrPos: SizeInt; var NbSeq: SizeInt): Boolean; overload; +{$ENDIF SUPPORTS_UNICODE_STRING} +function UTF16SkipCharsFromStream(S: TStream; var NbSeq: SizeInt): Boolean; + +// UTF16SetNextChar = append an UTF16 sequence at StrPos +// returns False on error: +// - if an UCS4 character cannot be stored to an UTF-16 string: +// - if UNICODE_SILENT_FAILURE is defined, ReplacementCharacter is added +// - if UNICODE_SILENT_FAILURE is not defined, StrPos is set to -1 +// - StrPos > -1 flags string being too small, callee did nothing and caller is responsible for allocating space +// StrPos will be incremented by the number of chars that were written +function UTF16SetNextChar(var S: TUTF16String; var StrPos: SizeInt; Ch: UCS4): Boolean; overload; +function UTF16SetNextBuffer(var S: TUTF16String; var StrPos: SizeInt; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; +{$IFDEF SUPPORTS_UNICODE_STRING} +function UTF16SetNextChar(var S: WideString; var StrPos: SizeInt; Ch: UCS4): Boolean; overload; +function UTF16SetNextBuffer(var S: WideString; var StrPos: SizeInt; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; +{$ENDIF SUPPORTS_UNICODE_STRING} +function UTF16SetNextCharToStream(S: TStream; Ch: UCS4): Boolean; +function UTF16SetNextBufferToStream(S: TStream; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; + +// AnsiGetNextChar = read next character at StrPos +// StrPos will be incremented by the number of chars that were read (1) +function AnsiGetNextChar(const S: AnsiString; var StrPos: SizeInt): UCS4; overload; +function AnsiGetNextBuffer(const S: AnsiString; var StrPos: SizeInt; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; +function AnsiGetNextCharFromStream(S: TStream; out Ch: UCS4): Boolean; overload; +function AnsiGetNextBufferFromStream(S: TStream; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; + +// same as AnsiGetNextChar* with custom codepage +function AnsiGetNextChar(const S: AnsiString; CodePage: Word; var StrPos: SizeInt): UCS4; overload; +function AnsiGetNextBuffer(const S: AnsiString; CodePage: Word; var StrPos: SizeInt; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; +function AnsiGetNextCharFromStream(S: TStream; CodePage: Word; out Ch: UCS4): Boolean; overload; +function AnsiGetNextBufferFromStream(S: TStream; CodePage: Word; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; + +// AnsiSkipChars = skip NbSeq characters starting from StrPos +// returns False if String is too small +// StrPos will be incremented by the number of chars that were skipped +// On return, NbChar contains the number of UTF16 sequences that were skipped +function AnsiSkipChars(const S: AnsiString; var StrPos: SizeInt; var NbSeq: SizeInt): Boolean; +function AnsiSkipCharsFromStream(S: TStream; var NbSeq: SizeInt): Boolean; + +// AnsiSetNextChar = append a character at StrPos +// returns False on error: +// - if an UCS4 character cannot be stored to an ansi string: +// - if UNICODE_SILENT_FAILURE is defined, ReplacementCharacter is added +// - if UNICODE_SILENT_FAILURE is not defined, StrPos is set to -1 +// - StrPos > -1 flags string being too small, callee did nothing and caller is responsible for allocating space +// StrPos will be incremented by the number of chars that were written (1) +function AnsiSetNextChar(var S: AnsiString; var StrPos: SizeInt; Ch: UCS4): Boolean; overload; +function AnsiSetNextBuffer(var S: AnsiString; var StrPos: SizeInt; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; +function AnsiSetNextCharToStream(S: TStream; Ch: UCS4): Boolean; overload; +function AnsiSetNextBufferToStream(S: TStream; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; + +// same as AnsiSetNextChar* with custom codepage +function AnsiSetNextChar(var S: AnsiString; CodePage: Word; var StrPos: SizeInt; Ch: UCS4): Boolean; overload; +function AnsiSetNextBuffer(var S: AnsiString; CodePage: Word; var StrPos: SizeInt; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; +function AnsiSetNextCharToStream(S: TStream; CodePage: Word; Ch: UCS4): Boolean; overload; +function AnsiSetNextBufferToStream(S: TStream; CodePage: Word; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; + +// StringGetNextChar = read next character/sequence at StrPos +// if UNICODE_SILENT_FAILURE is defined, invalid sequences will be replaced by ReplacementCharacter +// otherwise StrPos is set to -1 on return to flag an error (invalid UTF16 sequence for WideString) +// StrPos will be incremented by the number of chars that were read +function StringGetNextChar(const S: string; var StrPos: SizeInt): UCS4; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function StringGetNextBuffer(const S: string; var StrPos: SizeInt; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + +// StringSkipChars = skip NbSeq characters/sequences starting from StrPos +// returns False if String is too small +// if UNICODE_SILENT_FAILURE is not defined StrPos is set to -1 on error (invalid UTF16 sequence for WideString) +// StrPos will be incremented by the number of chars that were skipped +// On return, NbChar contains the number of UTF16 sequences that were skipped +function StringSkipChars(const S: string; var StrPos: SizeInt; var NbSeq: SizeInt): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + +// StringSetNextChar = append a character/sequence at StrPos +// returns False on error: +// - if an UCS4 character cannot be stored to a string: +// - if UNICODE_SILENT_FAILURE is defined, ReplacementCharacter is added +// - if UNICODE_SILENT_FAILURE is not defined, StrPos is set to -1 +// - StrPos > -1 flags string being too small, callee did nothing and caller is responsible for allocating space +// StrPos will be incremented by the number of chars that were written +function StringSetNextChar(var S: string; var StrPos: SizeInt; Ch: UCS4): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function StringSetNextBuffer(var S: string; var StrPos: SizeInt; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + +// one shot conversions between WideString and others +function WideStringToUTF8(const S: WideString): TUTF8String; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +function UTF8ToWideString(const S: TUTF8String): WideString; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +function WideStringToUCS4(const S: WideString): TUCS4Array; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +function UCS4ToWideString(const S: TUCS4Array): WideString; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} + +// one shot conversions between AnsiString and others +function AnsiStringToUTF8(const S: AnsiString): TUTF8String; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +function UTF8ToAnsiString(const S: TUTF8String): AnsiString; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +function AnsiStringToUTF16(const S: AnsiString): TUTF16String; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +function UTF16ToAnsiString(const S: TUTF16String): AnsiString; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +function AnsiStringToUCS4(const S: AnsiString): TUCS4Array; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +function UCS4ToAnsiString(const S: TUCS4Array): AnsiString; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} + +// one shot conversions between string and others +function StringToUTF8(const S: string): TUTF8String; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +function UTF8ToString(const S: TUTF8String): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +function StringToUTF16(const S: string): TUTF16String; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +function UTF16ToString(const S: TUTF16String): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +function StringToUCS4(const S: string): TUCS4Array; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +function UCS4ToString(const S: TUCS4Array): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} + +function TryStringToUTF8(const S: string; out D: TUTF8String): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +function TryUTF8ToString(const S: TUTF8String; out D: string): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +function TryStringToUTF16(const S: string; out D: TUTF16String): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +function TryUTF16ToString(const S: TUTF16String; out D: string): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +function TryStringToUCS4(const S: string; out D: TUCS4Array): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +function TryUCS4ToString(const S: TUCS4Array; out D: string): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} + +function UTF8ToUTF16(const S: TUTF8String): TUTF16String; +function UTF16ToUTF8(const S: TUTF16String): TUTF8String; +function UTF8ToUCS4(const S: TUTF8String): TUCS4Array; +function UCS4ToUTF8(const S: TUCS4Array): TUTF8String; +function UTF16ToUCS4(const S: TUTF16String): TUCS4Array; +function UCS4ToUTF16(const S: TUCS4Array): TUTF16String; + +function TryUTF8ToUTF16(const S: TUTF8String; out D: TUTF16String): Boolean; +function TryUTF16ToUTF8(const S: TUTF16String; out D: TUTF8String): Boolean; +function TryUTF8ToUCS4(const S: TUTF8String; out D: TUCS4Array): Boolean; +function TryUCS4ToUTF8(const S: TUCS4Array; out D: TUTF8String): Boolean; +function TryUTF16ToUCS4(const S: TUTF16String; out D: TUCS4Array): Boolean; +function TryUCS4ToUTF16(const S: TUCS4Array; out D: TUTF16String): Boolean; + +// indexed conversions +function UTF8CharCount(const S: TUTF8String): SizeInt; +function UTF16CharCount(const S: TUTF16String): SizeInt; +function UCS2CharCount(const S: TUCS2String): SizeInt; +function UCS4CharCount(const S: TUCS4Array): SizeInt; +// returns False if string is too small +// if UNICODE_SILENT_FAILURE is not defined and an invalid UTFX sequence is detected, an exception is raised +// returns True on success and Value contains UCS4 character that was read +function GetUCS4CharAt(const UTF8Str: TUTF8String; Index: SizeInt; out Value: UCS4): Boolean; overload; +function GetUCS4CharAt(const WideStr: TUTF16String; Index: SizeInt; out Value: UCS4; IsUTF16: Boolean = True): Boolean; overload; +function GetUCS4CharAt(const UCS4Str: TUCS4Array; Index: SizeInt; out Value: UCS4): Boolean; overload; + +function UCS4ToAnsiChar(Value: UCS4): AnsiChar; +function UCS4ToWideChar(Value: UCS4): WideChar; +function UCS4ToChar(Value: UCS4): Char; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} + +function AnsiCharToUCS4(Value: AnsiChar): UCS4; +function WideCharToUCS4(Value: WideChar): UCS4; +function CharToUCS4(Value: Char): UCS4; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Winapi.Windows, + {$ENDIF MSWINDOWS} + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + {$ENDIF ~HAS_UNITSCOPE} + JclResources; + +const MB_ERR_INVALID_CHARS = 8; + +constructor EJclUnexpectedEOSequenceError.Create; +begin + inherited CreateRes(@RsEUnexpectedEOSeq); +end; + +function StreamReadByte(S: TStream; out B: Byte): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +begin + B := 0; + Result := S.Read(B, SizeOf(B)) = SizeOf(B); +end; + +function StreamWriteByte(S: TStream; B: Byte): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +begin + Result := S.Write(B, SizeOf(B)) = SizeOf(B); +end; + +function StreamReadWord(S: TStream; out W: Word): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +begin + W := 0; + Result := S.Read(W, SizeOf(W)) = SizeOf(W); +end; + +function StreamWriteWord(S: TStream; W: Word): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +begin + Result := S.Write(W, SizeOf(W)) = SizeOf(W); +end; + +//----------------- conversion routines ------------------------------------------------------------ + +// Converts the given source ANSI string into a Unicode string by expanding each character +// from one byte to two bytes. +// EAX contains Source, EDX contains Target, ECX contains Count + +procedure ExpandASCIIString(const Source: PAnsiChar; Target: PWideChar; Count: SizeInt); +asm + {$IFDEF CPU32} + // --> EAX Source + // EDX Target + // ECX Count + JECXZ @@Finish // go out if there is nothing to do (ECX = 0) + PUSH ESI + MOV ESI, EAX + XOR EAX, EAX +@@1: + MOV AL, [ESI] + INC ESI + MOV [EDX], AX + ADD EDX, 2 + DEC ECX + JNZ @@1 + POP ESI + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> RCX Source + // RDX Target + // R8 Count + + DEC R8 // go out if there is nothing to do (R8 = 0) + JS @@Finish +@@1: + MOVZX AX, BYTE PTR [RCX] + INC RCX + MOV WORD PTR [RDX], AX + ADD RDX, 2 +@@2: + DEC R8 + JNS @@1 + {$ENDIF CPU64} +@@Finish: +end; + +const + HalfShift: Integer = 10; + + HalfBase: UCS4 = $0010000; + HalfMask: UCS4 = $3FF; + +procedure FlagInvalidSequence(var StrPos: SizeInt; Increment: SizeInt; out Ch: UCS4); overload; +begin + {$IFDEF UNICODE_SILENT_FAILURE} + Ch := UCS4ReplacementCharacter; + Inc(StrPos, Increment); + {$ELSE ~UNICODE_SILENT_FAILURE} + StrPos := -1; + {$ENDIF ~UNICODE_SILENT_FAILURE} +end; + +procedure FlagInvalidSequence(var StrPos: SizeInt; Increment: SizeInt); overload; +begin + {$IFDEF UNICODE_SILENT_FAILURE} + Inc(StrPos, Increment); + {$ELSE ~UNICODE_SILENT_FAILURE} + StrPos := -1; + {$ENDIF ~UNICODE_SILENT_FAILURE} +end; + +procedure FlagInvalidSequence(out Ch: UCS4); overload; +begin + {$IFDEF UNICODE_SILENT_FAILURE} + Ch := UCS4ReplacementCharacter; + {$ELSE ~UNICODE_SILENT_FAILURE} + raise EJclUnexpectedEOSequenceError.Create; + {$ENDIF ~UNICODE_SILENT_FAILURE} +end; + +procedure FlagInvalidSequence; overload; +begin + {$IFNDEF UNICODE_SILENT_FAILURE} + raise EJclUnexpectedEOSequenceError.Create; + {$ENDIF ~UNICODE_SILENT_FAILURE} +end; + +// if UNICODE_SILENT_FAILURE is defined, invalid sequences will be replaced by ReplacementCharacter +// otherwise StrPos is set to -1 on return to flag an error (invalid UTF8 sequence) +// StrPos will be incremented by the number of chars that were read +function UTF8GetNextChar(const S: TUTF8String; var StrPos: SizeInt): UCS4; +var + StrLength: SizeInt; + Ch: UCS4; + ReadSuccess: Boolean; +begin + StrLength := Length(S); + ReadSuccess := True; + + if (StrPos <= StrLength) and (StrPos > 0) then + begin + Result := UCS4(S[StrPos]); + + case Result of + $00..$7F: + // 1 byte to read + Inc(StrPos); + $C0..$DF: + begin + // 2 bytes to read + if StrPos < StrLength then + begin + Ch := UCS4(S[StrPos + 1]); + if (Ch and $C0) = $80 then + begin + Result := ((Result and $1F) shl 6) or (Ch and $3F); + Inc(StrPos, 2); + end + else + FlagInvalidSequence(StrPos, 1, Result); + end + else + ReadSuccess := False; + end; + $E0..$EF: + begin + // 3 bytes to read + if (StrPos + 1) < StrLength then + begin + Ch := UCS4(S[StrPos + 1]); + if (Ch and $C0) = $80 then + begin + Result := ((Result and $0F) shl 12) or ((Ch and $3F) shl 6); + Ch := UCS4(S[StrPos + 2]); + if (Ch and $C0) = $80 then + begin + Result := Result or (Ch and $3F); + Inc(StrPos, 3); + end + else + FlagInvalidSequence(StrPos, 2, Result); + end + else + FlagInvalidSequence(StrPos, 1, Result); + end + else + ReadSuccess := False; + end; + $F0..$F7: + begin + // 4 bytes to read + if (StrPos + 2) < StrLength then + begin + Ch := UCS4(S[StrPos + 1]); + if (Ch and $C0) = $80 then + begin + Result := ((Result and $07) shl 18) or ((Ch and $3F) shl 12); + Ch := UCS4(S[StrPos + 2]); + if (Ch and $C0) = $80 then + begin + Result := Result or ((Ch and $3F) shl 6); + Ch := UCS4(S[StrPos + 3]); + if (Ch and $C0) = $80 then + begin + Result := Result or (Ch and $3F); + Inc(StrPos, 4); + end + else + FlagInvalidSequence(StrPos, 3, Result); + end + else + FlagInvalidSequence(StrPos, 2, Result); + end + else + FlagInvalidSequence(StrPos, 1, Result); + end + else + ReadSuccess := False; + end; + $F8..$FB: + begin + // 5 bytes to read + if (StrPos + 3) < StrLength then + begin + Ch := UCS4(S[StrPos + 1]); + if (Ch and $C0) = $80 then + begin + Result := ((Result and $03) shl 24) or ((Ch and $3F) shl 18); + Ch := UCS4(S[StrPos + 2]); + if (Ch and $C0) = $80 then + begin + Result := Result or ((Ch and $3F) shl 12); + Ch := UCS4(S[StrPos + 3]); + if (Ch and $C0) = $80 then + begin + Result := Result or ((Ch and $3F) shl 6); + Ch := UCS4(S[StrPos + 4]); + if (Ch and $C0) = $80 then + begin + Result := Result or (Ch and $3F); + Inc(StrPos, 5); + end + else + FlagInvalidSequence(StrPos, 4, Result); + end + else + FlagInvalidSequence(StrPos, 3, Result); + end + else + FlagInvalidSequence(StrPos, 2, Result); + end + else + FlagInvalidSequence(StrPos, 1, Result); + end + else + ReadSuccess := False; + end; + $FC..$FD: + begin + // 6 bytes to read + if (StrPos + 4) < StrLength then + begin + Ch := UCS4(S[StrPos + 1]); + if (Ch and $C0) = $80 then + begin + Result := ((Result and $01) shl 30) or ((Ch and $3F) shl 24); + Ch := UCS4(S[StrPos + 2]); + if (Ch and $C0) = $80 then + begin + Result := Result or ((Ch and $3F) shl 18); + Ch := UCS4(S[StrPos + 3]); + if (Ch and $C0) = $80 then + begin + Result := Result or ((Ch and $3F) shl 12); + Ch := UCS4(S[StrPos + 4]); + if (Ch and $C0) = $80 then + begin + Result := Result or ((Ch and $3F) shl 6); + Ch := UCS4(S[StrPos + 5]); + if (Ch and $C0) = $80 then + begin + Result := Result or (Ch and $3F); + Inc(StrPos, 6); + end + else + FlagInvalidSequence(StrPos, 5, Result); + end + else + FlagInvalidSequence(StrPos, 4, Result); + end + else + FlagInvalidSequence(StrPos, 3, Result); + end + else + FlagInvalidSequence(StrPos, 2, Result); + end + else + FlagInvalidSequence(StrPos, 1, Result); + end + else + ReadSuccess := False; + end; + else + FlagInvalidSequence(StrPos, 1, Result); + end; + if not ReadSuccess then + FlagInvalidSequence(StrPos, 1, Result); + end + else + begin + // StrPos > StrLength + Result := 0; + FlagInvalidSequence(StrPos, 0, Result); + end; +end; + +function UTF8GetNextBuffer(const S: TUTF8String; var StrPos: SizeInt; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; +var + B: Byte; + Ch: UCS4; + ReadSuccess: Boolean; + StrLength: SizeInt; +begin + StrLength := Length(S); + Result := 0; + ReadSuccess := True; + while (StrPos <= StrLength) and (StrPos > 0) and (Count > 0) do + begin + Ch := UCS4(S[StrPos]); + + case Ch of + $00..$7F: + // 1 byte to read + Inc(StrPos); + $C0..$DF: + begin + // 2 bytes to read + if StrPos < StrLength then + begin + B := Ord(S[StrPos + 1]); + if (B and $C0) = $80 then + Ch := ((Ch and $1F) shl 6) or (B and $3F) + else + FlagInvalidSequence(StrPos, 1, Ch); + end + else + ReadSuccess := False; + end; + $E0..$EF: + begin + // 3 bytes to read + if (StrPos + 1) < StrLength then + begin + B := Ord(S[StrPos + 1]); + if (B and $C0) = $80 then + begin + Ch := ((Ch and $0F) shl 12) or ((B and $3F) shl 6); + B := Ord(S[StrPos + 2]); + if (B and $C0) = $80 then + Ch := Ch or (B and $3F) + else + FlagInvalidSequence(StrPos, 2, Ch); + end + else + FlagInvalidSequence(StrPos, 1, Ch); + end + else + ReadSuccess := False; + end; + $F0..$F7: + begin + // 4 bytes to read + if (StrPos + 2) < StrLength then + begin + B := Ord(S[StrPos + 1]); + if (B and $C0) = $80 then + begin + Ch := ((Ch and $07) shl 18) or ((B and $3F) shl 12); + B := Ord(S[StrPos + 2]); + if (B and $C0) = $80 then + begin + Ch := Ch or ((B and $3F) shl 6); + B := Ord(S[StrPos + 3]); + if (B and $C0) = $80 then + Ch := Ch or (B and $3F) + else + FlagInvalidSequence(StrPos, 3, Ch); + end + else + FlagInvalidSequence(StrPos, 2, Ch); + end + else + FlagInvalidSequence(StrPos, 1, Ch); + end + else + ReadSuccess := False; + end; + $F8..$FB: + begin + // 5 bytes to read + if (StrPos + 3) < StrLength then + begin + B := Ord(S[StrPos + 1]); + if (B and $C0) = $80 then + begin + Ch := ((Ch and $03) shl 24) or ((B and $3F) shl 18); + B := Ord(S[StrPos + 2]); + if (B and $C0) = $80 then + begin + Ch := Ch or ((B and $3F) shl 12); + B := Ord(S[StrPos + 3]); + if (B and $C0) = $80 then + begin + Ch := Ch or ((B and $3F) shl 6); + B := Ord(S[StrPos + 4]); + if (B and $C0) = $80 then + Ch := Ch or (B and $3F) + else + FlagInvalidSequence(StrPos, 4, Ch); + end + else + FlagInvalidSequence(StrPos, 3, Ch); + end + else + FlagInvalidSequence(StrPos, 2, Ch); + end + else + FlagInvalidSequence(StrPos, 1, Ch); + end + else + ReadSuccess := False; + end; + $FC..$FD: + begin + // 6 bytes to read + if (StrPos + 4) < StrLength then + begin + B := Ord(S[StrPos + 1]); + if (B and $C0) = $80 then + begin + Ch := ((Ch and $01) shl 30) or ((B and $3F) shl 24); + B := Ord(S[StrPos + 2]); + if (B and $C0) = $80 then + begin + Ch := Ch or ((B and $3F) shl 18); + B := Ord(S[StrPos + 3]); + if (B and $C0) = $80 then + begin + Ch := Ch or ((B and $3F) shl 12); + B := Ord(S[StrPos + 4]); + if (B and $C0) = $80 then + begin + Ch := Ch or ((B and $3F) shl 6); + B := Ord(S[StrPos + 5]); + if (B and $C0) = $80 then + Ch := Ch or (B and $3F) + else + FlagInvalidSequence(StrPos, 5, Ch); + end + else + FlagInvalidSequence(StrPos, 4, Ch); + end + else + FlagInvalidSequence(StrPos, 3, Ch); + end + else + FlagInvalidSequence(StrPos, 2, Ch); + end + else + FlagInvalidSequence(StrPos, 1, Ch); + end + else + ReadSuccess := False; + end + else + FlagInvalidSequence(StrPos, 1, Ch); + end; + if not ReadSuccess then + FlagInvalidSequence(StrPos, 1, Ch); + + Buffer[Start] := Ch; + Inc(Start); + Inc(Result); + Dec(Count); + end; +end; + +function UTF8GetNextCharFromStream(S: TStream; out Ch: UCS4): Boolean; +var + B: Byte; +begin + Result := StreamReadByte(S,B); + if Result then + begin + Ch := UCS4(B); + + case Ch of + $00..$7F: ; + // 1 byte to read + // nothing to do + $C0..$DF: + begin + // 2 bytes to read + Result := StreamReadByte(S,B); + if Result then + begin + if (B and $C0) = $80 then + Ch := ((Ch and $1F) shl 6) or (B and $3F) + else + FlagInvalidSequence(Ch); + end; + end; + $E0..$EF: + begin + // 3 bytes to read + Result := StreamReadByte(S,B); + if Result then + begin + if (B and $C0) = $80 then + begin + Ch := ((Ch and $0F) shl 12) or ((B and $3F) shl 6); + Result := StreamReadByte(S,B); + if Result then + begin + if (B and $C0) = $80 then + Ch := Ch or (B and $3F) + else + FlagInvalidSequence(Ch); + end; + end + else + FlagInvalidSequence(Ch); + end; + end; + $F0..$F7: + begin + // 4 bytes to read + Result := StreamReadByte(S,B); + if Result then + begin + if (B and $C0) = $80 then + begin + Ch := ((Ch and $07) shl 18) or ((B and $3F) shl 12); + Result := StreamReadByte(S,B); + if Result then + begin + if (B and $C0) = $80 then + begin + Ch := Ch or ((B and $3F) shl 6); + Result := StreamReadByte(S,B); + if Result then + begin + if (B and $C0) = $80 then + Ch := Ch or (B and $3F) + else + FlagInvalidSequence(Ch); + end; + end + else + FlagInvalidSequence(Ch); + end; + end + else + FlagInvalidSequence(Ch); + end; + end; + $F8..$FB: + begin + // 5 bytes to read + Result := StreamReadByte(S,B); + if Result then + begin + if (B and $C0) = $80 then + begin + Ch := ((Ch and $03) shl 24) or ((B and $3F) shl 18); + Result := StreamReadByte(S,B); + if Result then + begin + if (B and $C0) = $80 then + begin + Ch := Ch or ((B and $3F) shl 12); + Result := StreamReadByte(S,B); + if Result then + begin + if (B and $C0) = $80 then + begin + Ch := Ch or ((B and $3F) shl 6); + Result := StreamReadByte(S,B); + if Result then + begin + if (B and $C0) = $80 then + Ch := Ch or (B and $3F) + else + FlagInvalidSequence(Ch); + end; + end + else + FlagInvalidSequence(Ch); + end; + end + else + FlagInvalidSequence(Ch); + end; + end + else + FlagInvalidSequence(Ch); + end; + end; + $FC..$FD: + begin + // 6 bytes to read + Result := StreamReadByte(S,B); + if Result then + begin + if (B and $C0) = $80 then + begin + Ch := ((Ch and $01) shl 30) or ((B and $3F) shl 24); + Result := StreamReadByte(S,B); + if Result then + begin + if (B and $C0) = $80 then + begin + Ch := Ch or ((B and $3F) shl 18); + Result := StreamReadByte(S,B); + if Result then + begin + if (B and $C0) = $80 then + begin + Ch := Ch or ((B and $3F) shl 12); + Result := StreamReadByte(S,B); + if Result then + begin + if (B and $C0) = $80 then + begin + Ch := Ch or ((B and $3F) shl 6); + Result := StreamReadByte(S,B); + if Result then + begin + if (B and $C0) = $80 then + Ch := Ch or (B and $3F) + else + FlagInvalidSequence(Ch); + end; + end + else + FlagInvalidSequence(Ch); + end; + end + else + FlagInvalidSequence(Ch); + end; + end + else + FlagInvalidSequence(Ch); + end; + end + else + FlagInvalidSequence(Ch); + end; + end; + else + FlagInvalidSequence(Ch); + end; + end; +end; + +function UTF8GetNextBufferFromStream(S: TStream; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; +var + B: Byte; + Ch: UCS4; + ReadSuccess: Boolean; +begin + Result := 0; + ReadSuccess := True; + while ReadSuccess and (Count > 0) do + begin + if StreamReadByte(S,B) then + begin + Ch := UCS4(B); + + case Ch of + $00..$7F: ; + // 1 byte to read + // nothing to do + $C0..$DF: + begin + // 2 bytes to read + if StreamReadByte(S,B) then + begin + if (B and $C0) = $80 then + Ch := ((Ch and $1F) shl 6) or (B and $3F) + else + FlagInvalidSequence(Ch); + end + else + ReadSuccess := False; + end; + $E0..$EF: + begin + // 3 bytes to read + if StreamReadByte(S,B) then + begin + if (B and $C0) = $80 then + begin + Ch := ((Ch and $0F) shl 12) or ((B and $3F) shl 6); + if StreamReadByte(S,B) then + begin + if (B and $C0) = $80 then + Ch := Ch or (B and $3F) + else + FlagInvalidSequence(Ch); + end + else + ReadSuccess := False; + end + else + FlagInvalidSequence(Ch); + end + else + ReadSuccess := False; + end; + $F0..$F7: + begin + // 4 bytes to read + if StreamReadByte(S,B) then + begin + if (B and $C0) = $80 then + begin + Ch := ((Ch and $07) shl 18) or ((B and $3F) shl 12); + if StreamReadByte(S,B) then + begin + if (B and $C0) = $80 then + begin + Ch := Ch or ((B and $3F) shl 6); + if StreamReadByte(S,B) then + begin + if (B and $C0) = $80 then + Ch := Ch or (B and $3F) + else + FlagInvalidSequence(Ch); + end + else + ReadSuccess := False; + end + else + FlagInvalidSequence(Ch); + end + else + ReadSuccess := False; + end + else + FlagInvalidSequence(Ch); + end + else + ReadSuccess := False; + end; + $F8..$FB: + begin + // 5 bytes to read + if StreamReadByte(S,B) then + begin + if (B and $C0) = $80 then + begin + Ch := ((Ch and $03) shl 24) or ((B and $3F) shl 18); + if StreamReadByte(S,B) then + begin + if (B and $C0) = $80 then + begin + Ch := Ch or ((B and $3F) shl 12); + if StreamReadByte(S,B) then + begin + if (B and $C0) = $80 then + begin + Ch := Ch or ((B and $3F) shl 6); + if StreamReadByte(S,B) then + begin + if (B and $C0) = $80 then + Ch := Ch or (B and $3F) + else + FlagInvalidSequence(Ch); + end + else + ReadSuccess := False; + end + else + FlagInvalidSequence(Ch); + end + else + ReadSuccess := False; + end + else + FlagInvalidSequence(Ch); + end + else + ReadSuccess := False; + end + else + FlagInvalidSequence(Ch); + end + else + ReadSuccess := False; + end; + $FC..$FD: + begin + // 6 bytes to read + if StreamReadByte(S,B) then + begin + if (B and $C0) = $80 then + begin + Ch := ((Ch and $01) shl 30) or ((B and $3F) shl 24); + if StreamReadByte(S,B) then + begin + if (B and $C0) = $80 then + begin + Ch := Ch or ((B and $3F) shl 18); + if StreamReadByte(S,B) then + begin + if (B and $C0) = $80 then + begin + Ch := Ch or ((B and $3F) shl 12); + if StreamReadByte(S,B) then + begin + if (B and $C0) = $80 then + begin + Ch := Ch or ((B and $3F) shl 6); + if StreamReadByte(S,B) then + begin + if (B and $C0) = $80 then + Ch := Ch or (B and $3F) + else + FlagInvalidSequence(Ch); + end + else + ReadSuccess := False; + end + else + FlagInvalidSequence(Ch); + end + else + ReadSuccess := False; + end + else + FlagInvalidSequence(Ch); + end + else + ReadSuccess := False; + end + else + FlagInvalidSequence(Ch); + end + else + ReadSuccess := False; + end + else + FlagInvalidSequence(Ch); + end + else + ReadSuccess := False; + end + else + FlagInvalidSequence(Ch); + end; + if ReadSuccess then + begin + Buffer[Start] := Ch; + Inc(Start); + Inc(Result); + end; + end + else + ReadSuccess := False; + Dec(Count); + end; +end; + +// returns False if String is too small +// if UNICODE_SILENT_FAILURE is not defined StrPos is set to -1 on error (invalid UTF8 sequence) +// StrPos will be incremented by the number of ansi chars that were skipped +// On return, NbSeq contains the number of UTF8 sequences that were skipped +function UTF8SkipChars(const S: TUTF8String; var StrPos: SizeInt; var NbSeq: SizeInt): Boolean; +var + StrLength: SizeInt; + Ch: UCS4; + Index: SizeInt; +begin + Result := True; + StrLength := Length(S); + + Index := 0; + while (Index < NbSeq) and (StrPos > 0) do + begin + Ch := UCS4(S[StrPos]); + + case Ch of + $00..$7F: + // 1 byte to skip + Inc(StrPos); + $C0..$DF: + // 2 bytes to skip + if (StrPos >= StrLength) or ((UCS4(S[StrPos + 1]) and $C0) <> $80) then + FlagInvalidSequence(StrPos, 1) + else + Inc(StrPos, 2); + $E0..$EF: + // 3 bytes to skip + if ((StrPos + 1) >= StrLength) or ((UCS4(S[StrPos + 1]) and $C0) <> $80) then + FlagInvalidSequence(StrPos, 1) + else + if (UCS4(S[StrPos + 2]) and $C0) <> $80 then + FlagInvalidSequence(StrPos, 2) + else + Inc(StrPos, 3); + $F0..$F7: + // 4 bytes to skip + if ((StrPos + 2) >= StrLength) or ((UCS4(S[StrPos + 1]) and $C0) <> $80) then + FlagInvalidSequence(StrPos, 1) + else + if (UCS4(S[StrPos + 2]) and $C0) <> $80 then + FlagInvalidSequence(StrPos, 2) + else + if (UCS4(S[StrPos + 3]) and $C0) <> $80 then + FlagInvalidSequence(StrPos, 3) + else + Inc(StrPos, 4); + $F8..$FB: + // 5 bytes to skip + if ((StrPos + 3) >= StrLength) or ((UCS4(S[StrPos + 1]) and $C0) <> $80) then + FlagInvalidSequence(StrPos, 1) + else + if (UCS4(S[StrPos + 2]) and $C0) <> $80 then + FlagInvalidSequence(StrPos, 2) + else + if (UCS4(S[StrPos + 3]) and $C0) <> $80 then + FlagInvalidSequence(StrPos, 3) + else + if (UCS4(S[StrPos + 4]) and $C0) <> $80 then + FlagInvalidSequence(StrPos, 4) + else + Inc(StrPos, 5); + $FC..$FD: + // 6 bytes to skip + if ((StrPos + 4) >= StrLength) or ((UCS4(S[StrPos + 1]) and $C0) <> $80) then + FlagInvalidSequence(StrPos, 1) + else + if (UCS4(S[StrPos + 2]) and $C0) <> $80 then + FlagInvalidSequence(StrPos, 2) + else + if (UCS4(S[StrPos + 3]) and $C0) <> $80 then + FlagInvalidSequence(StrPos, 3) + else + if (UCS4(S[StrPos + 4]) and $C0) <> $80 then + FlagInvalidSequence(StrPos, 4) + else + if (UCS4(S[StrPos + 5]) and $C0) <> $80 then + FlagInvalidSequence(StrPos, 5) + else + Inc(StrPos, 6); + else + FlagInvalidSequence(StrPos, 1); + end; + + if StrPos <> -1 then + Inc(Index); + if (StrPos > StrLength) and (Index < NbSeq) then + begin + Result := False; + Break; + end; + end; + NbSeq := Index; +end; + +function UTF8SkipCharsFromStream(S: TStream; var NbSeq: SizeInt): Boolean; +var + B: Byte; + Index: SizeInt; +begin + Index := 0; + while (Index < NbSeq) do + begin + Result := StreamReadByte(S, B); + if not Result then + Break; + case B of + $00..$7F: ; + // 1 byte to skip + // nothing to do + $C0..$DF: + // 2 bytes to skip + begin + Result := StreamReadByte(S, B); + if not Result then + Break; + if (B and $C0) <> $80 then + FlagInvalidSequence; + end; + $E0..$EF: + // 3 bytes to skip + begin + Result := StreamReadByte(S, B); + if not Result then + Break; + if (B and $C0) <> $80 then + FlagInvalidSequence; + Result := StreamReadByte(S, B); + if not Result then + Break; + if (B and $C0) <> $80 then + FlagInvalidSequence; + end; + $F0..$F7: + // 4 bytes to skip + begin + Result := StreamReadByte(S, B); + if not Result then + Break; + if (B and $C0) <> $80 then + FlagInvalidSequence; + Result := StreamReadByte(S, B); + if not Result then + Break; + if (B and $C0) <> $80 then + FlagInvalidSequence; + Result := StreamReadByte(S, B); + if not Result then + Break; + if (B and $C0) <> $80 then + FlagInvalidSequence; + end; + $F8..$FB: + // 5 bytes to skip + begin + Result := StreamReadByte(S, B); + if not Result then + Break; + if (B and $C0) <> $80 then + FlagInvalidSequence; + Result := StreamReadByte(S, B); + if not Result then + Break; + if (B and $C0) <> $80 then + FlagInvalidSequence; + Result := StreamReadByte(S, B); + if not Result then + Break; + if (B and $C0) <> $80 then + FlagInvalidSequence; + Result := StreamReadByte(S, B); + if not Result then + Break; + if (B and $C0) <> $80 then + FlagInvalidSequence; + end; + $FC..$FD: + // 6 bytes to skip + begin + Result := StreamReadByte(S, B); + if not Result then + Break; + if (B and $C0) <> $80 then + FlagInvalidSequence; + Result := StreamReadByte(S, B); + if not Result then + Break; + if (B and $C0) <> $80 then + FlagInvalidSequence; + Result := StreamReadByte(S, B); + if not Result then + Break; + if (B and $C0) <> $80 then + FlagInvalidSequence; + Result := StreamReadByte(S, B); + if not Result then + Break; + if (B and $C0) <> $80 then + FlagInvalidSequence; + Result := StreamReadByte(S, B); + if not Result then + Break; + if (B and $C0) <> $80 then + FlagInvalidSequence; + end; + else + FlagInvalidSequence; + end; + Inc(Index); + end; + Result := Index = NbSeq; + NbSeq := Index; +end; + +// returns False on error: +// - if an UCS4 character cannot be stored to an UTF-8 string: +// - if UNICODE_SILENT_FAILURE is defined, ReplacementCharacter is added +// - if UNICODE_SILENT_FAILURE is not defined, StrPos is set to -1 +// - StrPos > -1 flags string being too small, caller is responsible for allocating space +// StrPos will be incremented by the number of chars that were written +function UTF8SetNextChar(var S: TUTF8String; var StrPos: SizeInt; Ch: UCS4): Boolean; +var + StrLength: SizeInt; +begin + StrLength := Length(S); + + if Ch <= $7F then + begin + // 7 bits to store + Result := (StrPos > 0) and (StrPos <= StrLength); + if Result then + begin + S[StrPos] := AnsiChar(Ch); + Inc(StrPos); + end; + end + else + if Ch <= $7FF then + begin + // 11 bits to store + Result := (StrPos > 0) and (StrPos < StrLength); + if Result then + begin + S[StrPos] := AnsiChar($C0 or (Ch shr 6)); // 5 bits + S[StrPos + 1] := AnsiChar((Ch and $3F) or $80); // 6 bits + Inc(StrPos, 2); + end; + end + else + if Ch <= $FFFF then + begin + // 16 bits to store + Result := (StrPos > 0) and (StrPos < (StrLength - 1)); + if Result then + begin + S[StrPos] := AnsiChar($E0 or (Ch shr 12)); // 4 bits + S[StrPos + 1] := AnsiChar(((Ch shr 6) and $3F) or $80); // 6 bits + S[StrPos + 2] := AnsiChar((Ch and $3F) or $80); // 6 bits + Inc(StrPos, 3); + end; + end + else + if Ch <= $1FFFFF then + begin + // 21 bits to store + Result := (StrPos > 0) and (StrPos < (StrLength - 2)); + if Result then + begin + S[StrPos] := AnsiChar($F0 or (Ch shr 18)); // 3 bits + S[StrPos + 1] := AnsiChar(((Ch shr 12) and $3F) or $80); // 6 bits + S[StrPos + 2] := AnsiChar(((Ch shr 6) and $3F) or $80); // 6 bits + S[StrPos + 3] := AnsiChar((Ch and $3F) or $80); // 6 bits + Inc(StrPos, 4); + end; + end + else + if Ch <= $3FFFFFF then + begin + // 26 bits to store + Result := (StrPos > 0) and (StrPos < (StrLength - 2)); + if Result then + begin + S[StrPos] := AnsiChar($F8 or (Ch shr 24)); // 2 bits + S[StrPos + 1] := AnsiChar(((Ch shr 18) and $3F) or $80); // 6 bits + S[StrPos + 2] := AnsiChar(((Ch shr 12) and $3F) or $80); // 6 bits + S[StrPos + 3] := AnsiChar(((Ch shr 6) and $3F) or $80); // 6 bits + S[StrPos + 4] := AnsiChar((Ch and $3F) or $80); // 6 bits + Inc(StrPos, 5); + end; + end + else + if Ch <= MaximumUCS4 then + begin + // 31 bits to store + Result := (StrPos > 0) and (StrPos < (StrLength - 3)); + if Result then + begin + S[StrPos] := AnsiChar($FC or (Ch shr 30)); // 1 bits + S[StrPos + 1] := AnsiChar(((Ch shr 24) and $3F) or $80); // 6 bits + S[StrPos + 2] := AnsiChar(((Ch shr 18) and $3F) or $80); // 6 bits + S[StrPos + 3] := AnsiChar(((Ch shr 12) and $3F) or $80); // 6 bits + S[StrPos + 4] := AnsiChar(((Ch shr 6) and $3F) or $80); // 6 bits + S[StrPos + 5] := AnsiChar((Ch and $3F) or $80); // 6 bits + Inc(StrPos, 6); + end; + end + else + begin + {$IFDEF UNICODE_SILENT_FAILURE} + // add ReplacementCharacter + Result := (StrPos > 0) and (StrPos < (StrLength - 1)); + if Result then + begin + S[StrPos] := AnsiChar($E0 or (UCS4ReplacementCharacter shr 12)); // 4 bits + S[StrPos + 1] := AnsiChar(((UCS4ReplacementCharacter shr 6) and $3F) or $80); // 6 bits + S[StrPos + 2] := AnsiChar((UCS4ReplacementCharacter and $3F) or $80); // 6 bits + Inc(StrPos, 3); + end; + {$ELSE ~UNICODE_SILENT_FAILURE} + StrPos := -1; + Result := False; + {$ENDIF ~UNICODE_SILENT_FAILURE} + end; +end; + +function UTF8SetNextBuffer(var S: TUTF8String; var StrPos: SizeInt; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; +var + StrLength: SizeInt; + Ch: UCS4; + Success: Boolean; +begin + StrLength := Length(S); + Success := True; + Result := 0; + while Success and (Count > 0) do + begin + Ch := Buffer[Start]; + if Ch <= $7F then + begin + // 7 bits to store + if (StrPos > 0) and (StrPos <= StrLength) then + begin + S[StrPos] := AnsiChar(Ch); + Inc(StrPos); + end + else + Success := False; + end + else + if Ch <= $7FF then + begin + // 11 bits to store + if (StrPos > 0) and (StrPos < StrLength) then + begin + S[StrPos] := AnsiChar($C0 or (Ch shr 6)); // 5 bits + S[StrPos + 1] := AnsiChar((Ch and $3F) or $80); // 6 bits + Inc(StrPos, 2); + end + else + Success := False; + end + else + if Ch <= $FFFF then + begin + // 16 bits to store + if (StrPos > 0) and (StrPos < (StrLength - 1)) then + begin + S[StrPos] := AnsiChar($E0 or (Ch shr 12)); // 4 bits + S[StrPos + 1] := AnsiChar(((Ch shr 6) and $3F) or $80); // 6 bits + S[StrPos + 2] := AnsiChar((Ch and $3F) or $80); // 6 bits + Inc(StrPos, 3); + end + else + Success := False; + end + else + if Ch <= $1FFFFF then + begin + // 21 bits to store + if (StrPos > 0) and (StrPos < (StrLength - 2)) then + begin + S[StrPos] := AnsiChar($F0 or (Ch shr 18)); // 3 bits + S[StrPos + 1] := AnsiChar(((Ch shr 12) and $3F) or $80); // 6 bits + S[StrPos + 2] := AnsiChar(((Ch shr 6) and $3F) or $80); // 6 bits + S[StrPos + 3] := AnsiChar((Ch and $3F) or $80); // 6 bits + Inc(StrPos, 4); + end + else + Success := False; + end + else + if Ch <= $3FFFFFF then + begin + // 26 bits to store + if (StrPos > 0) and (StrPos < (StrLength - 2)) then + begin + S[StrPos] := AnsiChar($F8 or (Ch shr 24)); // 2 bits + S[StrPos + 1] := AnsiChar(((Ch shr 18) and $3F) or $80); // 6 bits + S[StrPos + 2] := AnsiChar(((Ch shr 12) and $3F) or $80); // 6 bits + S[StrPos + 3] := AnsiChar(((Ch shr 6) and $3F) or $80); // 6 bits + S[StrPos + 4] := AnsiChar((Ch and $3F) or $80); // 6 bits + Inc(StrPos, 5); + end + else + Success := False; + end + else + if Ch <= MaximumUCS4 then + begin + // 31 bits to store + if (StrPos > 0) and (StrPos < (StrLength - 3)) then + begin + S[StrPos] := AnsiChar($FC or (Ch shr 30)); // 1 bits + S[StrPos + 1] := AnsiChar(((Ch shr 24) and $3F) or $80); // 6 bits + S[StrPos + 2] := AnsiChar(((Ch shr 18) and $3F) or $80); // 6 bits + S[StrPos + 3] := AnsiChar(((Ch shr 12) and $3F) or $80); // 6 bits + S[StrPos + 4] := AnsiChar(((Ch shr 6) and $3F) or $80); // 6 bits + S[StrPos + 5] := AnsiChar((Ch and $3F) or $80); // 6 bits + Inc(StrPos, 6); + end + else + Success := False; + end + else + begin + {$IFDEF UNICODE_SILENT_FAILURE} + // add ReplacementCharacter + if (StrPos > 0) and (StrPos < (StrLength - 1)) then + begin + S[StrPos] := AnsiChar($E0 or (UCS4ReplacementCharacter shr 12)); // 4 bits + S[StrPos + 1] := AnsiChar(((UCS4ReplacementCharacter shr 6) and $3F) or $80); // 6 bits + S[StrPos + 2] := AnsiChar((UCS4ReplacementCharacter and $3F) or $80); // 6 bits + Inc(StrPos, 3); + end + else + Success := False; + {$ELSE ~UNICODE_SILENT_FAILURE} + StrPos := -1; + Success := False; + {$ENDIF ~UNICODE_SILENT_FAILURE} + end; + if Success then + begin + Inc(Start); + Inc(Result); + end; + Dec(Count); + end; +end; + +function UTF8SetNextCharToStream(S: TStream; Ch: UCS4): Boolean; +begin + if Ch <= $7F then + // 7 bits to store + Result := StreamWriteByte(S,Ch) + else + if Ch <= $7FF then + // 11 bits to store + Result := StreamWriteByte(S, $C0 or (Ch shr 6)) and // 5 bits + StreamWriteByte(S, (Ch and $3F) or $80) // 6 bits + else + if Ch <= $FFFF then + // 16 bits to store + Result := StreamWriteByte(S, $E0 or (Ch shr 12)) and // 4 bits + StreamWriteByte(S, ((Ch shr 6) and $3F) or $80) and // 6 bits + StreamWriteByte(S, (Ch and $3F) or $80) // 6 bits + else + if Ch <= $1FFFFF then + // 21 bits to store + Result := StreamWriteByte(S, $F0 or (Ch shr 18)) and // 3 bits + StreamWriteByte(S, ((Ch shr 12) and $3F) or $80) and // 6 bits + StreamWriteByte(S, ((Ch shr 6) and $3F) or $80) and // 6 bits + StreamWriteByte(S, (Ch and $3F) or $80) // 6 bits + else + if Ch <= $3FFFFFF then + // 26 bits to store + Result := StreamWriteByte(S, $F8 or (Ch shr 24)) and // 2 bits + StreamWriteByte(S, ((Ch shr 18) and $3F) or $80) and // 6 bits + StreamWriteByte(S, ((Ch shr 12) and $3F) or $80) and // 6 bits + StreamWriteByte(S, ((Ch shr 6) and $3F) or $80) and // 6 bits + StreamWriteByte(S, (Ch and $3F) or $80) // 6 bits + else + if Ch <= MaximumUCS4 then + // 31 bits to store + Result := StreamWriteByte(S, $FC or (Ch shr 30)) and // 1 bits + StreamWriteByte(S, ((Ch shr 24) and $3F) or $80) and // 6 bits + StreamWriteByte(S, ((Ch shr 18) and $3F) or $80) and // 6 bits + StreamWriteByte(S, ((Ch shr 12) and $3F) or $80) and // 6 bits + StreamWriteByte(S, ((Ch shr 6) and $3F) or $80) and // 6 bits + StreamWriteByte(S, (Ch and $3F) or $80) // 6 bits + else + {$IFDEF UNICODE_SILENT_FAILURE} + // add ReplacementCharacter + Result := StreamWriteByte(S, $E0 or (UCS4ReplacementCharacter shr 12)) and // 4 bits + StreamWriteByte(S, ((UCS4ReplacementCharacter shr 6) and $3F) or $80) and // 6 bits + StreamWriteByte(S, (UCS4ReplacementCharacter and $3F) or $80); // 6 bits + {$ELSE ~UNICODE_SILENT_FAILURE} + Result := False; + {$ENDIF ~UNICODE_SILENT_FAILURE} +end; + +function UTF8SetNextBufferToStream(S: TStream; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; +var + Ch: UCS4; + Success: Boolean; +begin + Result := 0; + Success := True; + while Success and (Count > 0) do + begin + Ch := Buffer[Start]; + if Ch <= $7F then + // 7 bits to store + Success := StreamWriteByte(S,Ch) + else + if Ch <= $7FF then + // 11 bits to store + Success := StreamWriteByte(S, $C0 or (Ch shr 6)) and // 5 bits + StreamWriteByte(S, (Ch and $3F) or $80) // 6 bits + else + if Ch <= $FFFF then + // 16 bits to store + Success := StreamWriteByte(S, $E0 or (Ch shr 12)) and // 4 bits + StreamWriteByte(S, ((Ch shr 6) and $3F) or $80) and // 6 bits + StreamWriteByte(S, (Ch and $3F) or $80) // 6 bits + else + if Ch <= $1FFFFF then + // 21 bits to store + Success := StreamWriteByte(S, $F0 or (Ch shr 18)) and // 3 bits + StreamWriteByte(S, ((Ch shr 12) and $3F) or $80) and // 6 bits + StreamWriteByte(S, ((Ch shr 6) and $3F) or $80) and // 6 bits + StreamWriteByte(S, (Ch and $3F) or $80) // 6 bits + else + if Ch <= $3FFFFFF then + // 26 bits to store + Success := StreamWriteByte(S, $F8 or (Ch shr 24)) and // 2 bits + StreamWriteByte(S, ((Ch shr 18) and $3F) or $80) and // 6 bits + StreamWriteByte(S, ((Ch shr 12) and $3F) or $80) and // 6 bits + StreamWriteByte(S, ((Ch shr 6) and $3F) or $80) and // 6 bits + StreamWriteByte(S, (Ch and $3F) or $80) // 6 bits + else + if Ch <= MaximumUCS4 then + // 31 bits to store + Success := StreamWriteByte(S, $FC or (Ch shr 30)) and // 1 bits + StreamWriteByte(S, ((Ch shr 24) and $3F) or $80) and // 6 bits + StreamWriteByte(S, ((Ch shr 18) and $3F) or $80) and // 6 bits + StreamWriteByte(S, ((Ch shr 12) and $3F) or $80) and // 6 bits + StreamWriteByte(S, ((Ch shr 6) and $3F) or $80) and // 6 bits + StreamWriteByte(S, (Ch and $3F) or $80) // 6 bits + else + {$IFDEF UNICODE_SILENT_FAILURE} + // add ReplacementCharacter + Success := StreamWriteByte(S, $E0 or (UCS4ReplacementCharacter shr 12)) and // 4 bits + StreamWriteByte(S, ((UCS4ReplacementCharacter shr 6) and $3F) or $80) and // 6 bits + StreamWriteByte(S, (UCS4ReplacementCharacter and $3F) or $80); // 6 bits + {$ELSE ~UNICODE_SILENT_FAILURE} + Success := False; + {$ENDIF ~UNICODE_SILENT_FAILURE} + if Success then + begin + Inc(Start); + Inc(Result); + end; + Dec(Count); + end; +end; + +// if UNICODE_SILENT_FAILURE is defined, invalid sequences will be replaced by ReplacementCharacter +// otherwise StrPos is set to -1 on return to flag an error (invalid UTF16 sequence) +// StrPos will be incremented by the number of chars that were read +function UTF16GetNextChar(const S: TUTF16String; var StrPos: SizeInt): UCS4; +var + StrLength: SizeInt; + Ch: UCS4; +begin + StrLength := Length(S); + + if (StrPos <= StrLength) and (StrPos > 0) then + begin + Result := UCS4(S[StrPos]); + + case Result of + SurrogateHighStart..SurrogateHighEnd: + begin + // 2 bytes to read + if StrPos < StrLength then + begin + Ch := UCS4(S[StrPos + 1]); + if (Ch >= SurrogateLowStart) and (Ch <= SurrogateLowEnd) then + begin + Result := ((Result - SurrogateHighStart) shl HalfShift) + (Ch - SurrogateLowStart) + HalfBase; + Inc(StrPos, 2); + end + else + FlagInvalidSequence(StrPos, 1, Result); + end + else + FlagInvalidSequence(StrPos, 1, Result); + end; + SurrogateLowStart..SurrogateLowEnd: + FlagInvalidSequence(StrPos, 1, Result); + else + // 1 byte to read + Inc(StrPos); + end; + end + else + begin + // StrPos > StrLength + Result := 0; + FlagInvalidSequence(StrPos, 0, Result); + end; +end; + +function UTF16GetNextBuffer(const S: TUTF16String; var StrPos: SizeInt; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; +var + StrLength: SizeInt; + Ch, ChNext: UCS4; + ReadSuccess: Boolean; +begin + StrLength := Length(S); + Result := 0; + ReadSuccess := True; + while (StrPos <= StrLength) and (StrPos > 0) and (Count > 0) do + begin + Ch := UCS4(S[StrPos]); + + case Ch of + SurrogateHighStart..SurrogateHighEnd: + begin + // 2 bytes to read + if StrPos < StrLength then + begin + ChNext := UCS4(S[StrPos + 1]); + if (ChNext >= SurrogateLowStart) and (ChNext <= SurrogateLowEnd) then + begin + Ch := ((Ch - SurrogateHighStart) shl HalfShift) + (ChNext - SurrogateLowStart) + HalfBase; + Inc(StrPos, 2); + end + else + FlagInvalidSequence(StrPos, 1, Ch); + end + else + ReadSuccess := False; + end; + SurrogateLowStart..SurrogateLowEnd: + FlagInvalidSequence(StrPos, 1, Ch); + else + // 1 byte to read + Inc(StrPos); + end; + if not ReadSuccess then + FlagInvalidSequence(StrPos, 1, Ch); + + Buffer[Start] := Ch; + Inc(Start); + Inc(Result); + Dec(Count); + end; +end; + +// if UNICODE_SILENT_FAILURE is defined, invalid sequences will be replaced by ReplacementCharacter +// otherwise StrPos is set to -1 on return to flag an error (invalid UTF16 sequence) +// StrPos will be incremented by the number of chars that were read +{$IFDEF SUPPORTS_UNICODE_STRING} +function UTF16GetNextChar(const S: WideString; var StrPos: SizeInt): UCS4; +var + StrLength: SizeInt; + Ch: UCS4; +begin + StrLength := Length(S); + + if (StrPos <= StrLength) and (StrPos > 0) then + begin + Result := UCS4(S[StrPos]); + + case Result of + SurrogateHighStart..SurrogateHighEnd: + begin + // 2 bytes to read + if StrPos < StrLength then + begin + Ch := UCS4(S[StrPos + 1]); + if (Ch >= SurrogateLowStart) and (Ch <= SurrogateLowEnd) then + begin + Result := ((Result - SurrogateHighStart) shl HalfShift) + (Ch - SurrogateLowStart) + HalfBase; + Inc(StrPos, 2); + end + else + FlagInvalidSequence(StrPos, 1, Result); + end + else + FlagInvalidSequence(StrPos, 1, Result); + end; + SurrogateLowStart..SurrogateLowEnd: + FlagInvalidSequence(StrPos, 1, Result); + else + // 1 byte to read + Inc(StrPos); + end; + end + else + begin + // StrPos > StrLength + Result := 0; + FlagInvalidSequence(StrPos, 0, Result); + end; +end; + +function UTF16GetNextBuffer(const S: WideString; var StrPos: SizeInt; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; +var + StrLength: SizeInt; + Ch, ChNext: UCS4; + ReadSuccess: Boolean; +begin + StrLength := Length(S); + Result := 0; + ReadSuccess := True; + while (StrPos <= StrLength) and (StrPos > 0) and (Count > 0) do + begin + Ch := UCS4(S[StrPos]); + + case Ch of + SurrogateHighStart..SurrogateHighEnd: + begin + // 2 bytes to read + if StrPos < StrLength then + begin + ChNext := UCS4(S[StrPos + 1]); + if (ChNext >= SurrogateLowStart) and (ChNext <= SurrogateLowEnd) then + begin + Ch := ((Ch - SurrogateHighStart) shl HalfShift) + (ChNext - SurrogateLowStart) + HalfBase; + Inc(StrPos, 2); + end + else + FlagInvalidSequence(StrPos, 1, Ch); + end + else + ReadSuccess := False; + end; + SurrogateLowStart..SurrogateLowEnd: + FlagInvalidSequence(StrPos, 1, Ch); + else + // 1 byte to read + Inc(StrPos); + end; + if not ReadSuccess then + FlagInvalidSequence(StrPos, 1, Ch); + + Buffer[Start] := Ch; + Inc(Start); + Inc(Result); + Dec(Count); + end; +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +function UTF16GetNextCharFromStream(S: TStream; out Ch: UCS4): Boolean; +var + W: Word; +begin + Result := StreamReadWord(S, W); + if Result then + begin + Ch := UCS4(W); + + case W of + SurrogateHighStart..SurrogateHighEnd: + begin + // 2 bytes to read + Result := StreamReadWord(S, W); + if Result then + begin + if (W >= SurrogateLowStart) and (W <= SurrogateLowEnd) then + Ch := ((Ch - SurrogateHighStart) shl HalfShift) + (W - SurrogateLowStart) + HalfBase + else + FlagInvalidSequence(Ch); + end; + end; + SurrogateLowStart..SurrogateLowEnd: + FlagInvalidSequence(Ch); + else + // 1 byte to read + // nothing to do + end; + end; +end; + +function UTF16GetNextBufferFromStream(S: TStream; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; +var + W: Word; + Ch: UCS4; + ReadSuccess: Boolean; +begin + Result := 0; + ReadSuccess := True; + while ReadSuccess and (Count > 0) do + begin + if StreamReadWord(S, W) then + begin + Ch := UCS4(W); + + case W of + SurrogateHighStart..SurrogateHighEnd: + begin + // 2 bytes to read + if StreamReadWord(S, W) then + begin + if (W >= SurrogateLowStart) and (W <= SurrogateLowEnd) then + Ch := ((Ch - SurrogateHighStart) shl HalfShift) + (W - SurrogateLowStart) + HalfBase + else + FlagInvalidSequence(Ch); + end + else + ReadSuccess := False; + end; + SurrogateLowStart..SurrogateLowEnd: + FlagInvalidSequence(Ch); + else + // 1 byte to read + // nothing to do + end; + if ReadSuccess then + begin + Buffer[Start] := Ch; + Inc(Result); + Inc(Start); + end; + end; + Dec(Count); + end; +end; + +// if UNICODE_SILENT_FAILURE is defined, invalid sequences will be replaced by ReplacementCharacter +// otherwise StrPos is set to -1 on return to flag an error (invalid UTF16 sequence) +// StrPos will be decremented by the number of chars that were read +function UTF16GetPreviousChar(const S: TUTF16String; var StrPos: SizeInt): UCS4; +var + StrLength: SizeInt; + ChPrev: UCS4; +begin + StrLength := Length(S); + + if (StrPos <= (StrLength + 1)) and (StrPos > 1) then + begin + Result := UCS4(S[StrPos - 1]); + + case Result of + SurrogateHighStart..SurrogateHighEnd: + FlagInvalidSequence(StrPos, -1, Result); + SurrogateLowStart..SurrogateLowEnd: + begin + // 2 bytes to read + if StrPos > 2 then + begin + ChPrev := UCS4(S[StrPos - 2]); + if (ChPrev >= SurrogateHighStart) and (ChPrev <= SurrogateHighEnd) then + begin + Result := ((ChPrev - SurrogateHighStart) shl HalfShift) + (Result - SurrogateLowStart) + HalfBase; + Dec(StrPos, 2); + end + else + FlagInvalidSequence(StrPos, -1, Result); + end + else + FlagInvalidSequence(StrPos, -1, Result); + end; + else + // 1 byte to read + Dec(StrPos); + end; + end + else + begin + // StrPos > StrLength + Result := 0; + FlagInvalidSequence(StrPos, 0, Result); + end; +end; + +// if UNICODE_SILENT_FAILURE is defined, invalid sequences will be replaced by ReplacementCharacter +// otherwise StrPos is set to -1 on return to flag an error (invalid UTF16 sequence) +// StrPos will be decremented by the number of chars that were read +{$IFDEF SUPPORTS_UNICODE_STRING} +function UTF16GetPreviousChar(const S: WideString; var StrPos: SizeInt): UCS4; +var + StrLength: SizeInt; + ChPrev: UCS4; +begin + StrLength := Length(S); + + if (StrPos <= (StrLength + 1)) and (StrPos > 1) then + begin + Result := UCS4(S[StrPos - 1]); + + case Result of + SurrogateHighStart..SurrogateHighEnd: + FlagInvalidSequence(StrPos, -1, Result); + SurrogateLowStart..SurrogateLowEnd: + begin + // 2 bytes to read + if StrPos > 2 then + begin + ChPrev := UCS4(S[StrPos - 2]); + if (ChPrev >= SurrogateHighStart) and (ChPrev <= SurrogateHighEnd) then + begin + Result := ((ChPrev - SurrogateHighStart) shl HalfShift) + (Result - SurrogateLowStart) + HalfBase; + Dec(StrPos, 2); + end + else + FlagInvalidSequence(StrPos, -1, Result); + end + else + FlagInvalidSequence(StrPos, -1, Result); + end; + else + // 1 byte to read + Dec(StrPos); + end; + end + else + begin + // StrPos > StrLength + Result := 0; + FlagInvalidSequence(StrPos, 0, Result); + end; +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +// returns False if String is too small +// if UNICODE_SILENT_FAILURE is not defined StrPos is set to -1 on error (invalid UTF16 sequence) +// StrPos will be incremented by the number of chars that were skipped +// On return, NbSeq contains the number of UTF16 sequences that were skipped +function UTF16SkipChars(const S: TUTF16String; var StrPos: SizeInt; var NbSeq: SizeInt): Boolean; +var + StrLength, Index: SizeInt; + Ch: UCS4; +begin + Result := True; + StrLength := Length(S); + + Index := 0; + if NbSeq >= 0 then + while (Index < NbSeq) and (StrPos > 0) do + begin + Ch := UCS4(S[StrPos]); + + case Ch of + SurrogateHighStart..SurrogateHighEnd: + // 2 bytes to skip + if StrPos >= StrLength then + FlagInvalidSequence(StrPos, 1) + else + begin + Ch := UCS4(S[StrPos + 1]); + if (Ch < SurrogateLowStart) or (Ch > SurrogateLowEnd) then + FlagInvalidSequence(StrPos, 1) + else + Inc(StrPos, 2); + end; + SurrogateLowStart..SurrogateLowEnd: + // error + FlagInvalidSequence(StrPos, 1); + else + // 1 byte to skip + Inc(StrPos); + end; + + if StrPos <> -1 then + Inc(Index); + + if (StrPos > StrLength) and (Index < NbSeq) then + begin + Result := False; + Break; + end; + end + else + while (Index > NbSeq) and (StrPos > 1) do + begin + Ch := UCS4(S[StrPos - 1]); + + case Ch of + SurrogateHighStart..SurrogateHighEnd: + // error + FlagInvalidSequence(StrPos, -1); + SurrogateLowStart..SurrogateLowEnd: + // 2 bytes to skip + if StrPos <= 2 then + FlagInvalidSequence(StrPos, -1) + else + begin + Ch := UCS4(S[StrPos - 2]); + if (Ch < SurrogateHighStart) or (Ch > SurrogateHighEnd) then + FlagInvalidSequence(StrPos, -1) + else + Dec(StrPos, 2); + end; + else + // 1 byte to skip + Dec(StrPos); + end; + + if StrPos <> -1 then + Dec(Index); + + if (StrPos = 1) and (Index > NbSeq) then + begin + Result := False; + Break; + end; + end; + NbSeq := Index; +end; + +// returns False if String is too small +// if UNICODE_SILENT_FAILURE is not defined StrPos is set to -1 on error (invalid UTF16 sequence) +// StrPos will be incremented by the number of chars that were skipped +// On return, NbSeq contains the number of UTF16 sequences that were skipped +{$IFDEF SUPPORTS_UNICODE_STRING} +function UTF16SkipChars(const S: WideString; var StrPos: SizeInt; var NbSeq: SizeInt): Boolean; +var + StrLength, Index: SizeInt; + Ch: UCS4; +begin + Result := True; + StrLength := Length(S); + + Index := 0; + if NbSeq >= 0 then + while (Index < NbSeq) and (StrPos > 0) do + begin + Ch := UCS4(S[StrPos]); + + case Ch of + SurrogateHighStart..SurrogateHighEnd: + // 2 bytes to skip + if StrPos >= StrLength then + FlagInvalidSequence(StrPos, 1) + else + begin + Ch := UCS4(S[StrPos + 1]); + if (Ch < SurrogateLowStart) or (Ch > SurrogateLowEnd) then + FlagInvalidSequence(StrPos, 1) + else + Inc(StrPos, 2); + end; + SurrogateLowStart..SurrogateLowEnd: + // error + FlagInvalidSequence(StrPos, 1); + else + // 1 byte to skip + Inc(StrPos); + end; + + if StrPos <> -1 then + Inc(Index); + + if (StrPos > StrLength) and (Index < NbSeq) then + begin + Result := False; + Break; + end; + end + else + while (Index > NbSeq) and (StrPos > 1) do + begin + Ch := UCS4(S[StrPos - 1]); + + case Ch of + SurrogateHighStart..SurrogateHighEnd: + // error + FlagInvalidSequence(StrPos, -1); + SurrogateLowStart..SurrogateLowEnd: + // 2 bytes to skip + if StrPos <= 2 then + FlagInvalidSequence(StrPos, -1) + else + begin + Ch := UCS4(S[StrPos - 2]); + if (Ch < SurrogateHighStart) or (Ch > SurrogateHighEnd) then + FlagInvalidSequence(StrPos, -1) + else + Dec(StrPos, 2); + end; + else + // 1 byte to skip + Dec(StrPos); + end; + + if StrPos <> -1 then + Dec(Index); + + if (StrPos = 1) and (Index > NbSeq) then + begin + Result := False; + Break; + end; + end; + NbSeq := Index; +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +function UTF16SkipCharsFromStream(S: TStream; var NbSeq: SizeInt): Boolean; +var + Index: SizeInt; + W: Word; +begin + Index := 0; + while Index < NbSeq do + begin + Result := StreamReadWord(S, W); + if not Result then + Break; + case W of + SurrogateHighStart..SurrogateHighEnd: + // 2 bytes to skip + begin + Result := StreamReadWord(S, W); + if not Result then + Break; + if (W < SurrogateLowStart) or (W > SurrogateLowEnd) then + FlagInvalidSequence; + end; + SurrogateLowStart..SurrogateLowEnd: + // error + FlagInvalidSequence; + else + // 1 byte to skip + // nothing to do + end; + Inc(Index); + end; + Result := Index = NbSeq; + NbSeq := Index; +end; + +// returns False on error: +// - if an UCS4 character cannot be stored to an UTF-8 string: +// - if UNICODE_SILENT_FAILURE is defined, ReplacementCharacter is added +// - if UNICODE_SILENT_FAILURE is not defined, StrPos is set to -1 +// - StrPos > -1 flags string being too small, caller is responsible for allocating space +// StrPos will be incremented by the number of chars that were written +function UTF16SetNextChar(var S: TUTF16String; var StrPos: SizeInt; Ch: UCS4): Boolean; +var + StrLength: SizeInt; +begin + StrLength := Length(S); + + if Ch <= MaximumUCS2 then + begin + // 16 bits to store in place + Result := (StrPos > 0) and (StrPos <= StrLength); + if Result then + begin + S[StrPos] := WideChar(Ch); + Inc(StrPos); + end; + end + else + if Ch <= MaximumUTF16 then + begin + // stores a surrogate pair + Result := (StrPos > 0) and (StrPos < StrLength); + if Result then + begin + Ch := Ch - HalfBase; + S[StrPos] := WideChar((Ch shr HalfShift) or SurrogateHighStart); + S[StrPos + 1] := WideChar((Ch and HalfMask) or SurrogateLowStart); + Inc(StrPos, 2); + end; + end + else + begin + {$IFDEF UNICODE_SILENT_FAILURE} + // add ReplacementCharacter + Result := (StrPos > 0) and (StrPos <= StrLength); + if Result then + begin + S[StrPos] := WideChar(UCS4ReplacementCharacter); + Inc(StrPos, 1); + end; + {$ELSE ~UNICODE_SILENT_FAILURE} + StrPos := -1; + Result := False; + {$ENDIF ~UNICODE_SILENT_FAILURE} + end; +end; + +function UTF16SetNextBuffer(var S: TUTF16String; var StrPos: SizeInt; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; +var + StrLength: SizeInt; + Ch: UCS4; + Success: Boolean; +begin + StrLength := Length(S); + Result := 0; + Success := True; + while Success and (Count > 0) do + begin + Ch := Buffer[Start]; + + if Ch <= MaximumUCS2 then + begin + // 16 bits to store in place + if (StrPos > 0) and (StrPos <= StrLength) then + begin + S[StrPos] := WideChar(Ch); + Inc(StrPos); + end + else + Success := False; + end + else + if Ch <= MaximumUTF16 then + begin + // stores a surrogate pair + if (StrPos > 0) and (StrPos < StrLength) then + begin + Ch := Ch - HalfBase; + S[StrPos] := WideChar((Ch shr HalfShift) or SurrogateHighStart); + S[StrPos + 1] := WideChar((Ch and HalfMask) or SurrogateLowStart); + Inc(StrPos, 2); + end + else + Success := False; + end + else + begin + {$IFDEF UNICODE_SILENT_FAILURE} + // add ReplacementCharacter + if (StrPos > 0) and (StrPos <= StrLength) then + begin + S[StrPos] := WideChar(UCS4ReplacementCharacter); + Inc(StrPos, 1); + end + else + Success := False; + {$ELSE ~UNICODE_SILENT_FAILURE} + StrPos := -1; + Success := False; + {$ENDIF ~UNICODE_SILENT_FAILURE} + end; + if Success then + begin + Inc(Start); + Inc(Result); + end; + Dec(Count); + end; +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +function UTF16SetNextChar(var S: WideString; var StrPos: SizeInt; Ch: UCS4): Boolean; +var + StrLength: SizeInt; +begin + StrLength := Length(S); + + if Ch <= MaximumUCS2 then + begin + // 16 bits to store in place + Result := (StrPos > 0) and (StrPos <= StrLength); + if Result then + begin + S[StrPos] := WideChar(Ch); + Inc(StrPos); + end; + end + else + if Ch <= MaximumUTF16 then + begin + // stores a surrogate pair + Result := (StrPos > 0) and (StrPos < StrLength); + if Result then + begin + Ch := Ch - HalfBase; + S[StrPos] := WideChar((Ch shr HalfShift) + SurrogateHighStart); + S[StrPos + 1] := WideChar((Ch and HalfMask) + SurrogateLowStart); + Inc(StrPos, 2); + end; + end + else + begin + {$IFDEF UNICODE_SILENT_FAILURE} + // add ReplacementCharacter + Result := (StrPos > 0) and (StrPos <= StrLength); + if Result then + begin + S[StrPos] := WideChar(UCS4ReplacementCharacter); + Inc(StrPos, 1); + end; + {$ELSE ~UNICODE_SILENT_FAILURE} + StrPos := -1; + Result := False; + {$ENDIF ~UNICODE_SILENT_FAILURE} + end; +end; + +function UTF16SetNextBuffer(var S: WideString; var StrPos: SizeInt; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; +var + StrLength: SizeInt; + Ch: UCS4; + Success: Boolean; +begin + StrLength := Length(S); + Result := 0; + Success := True; + while Success and (Count > 0) do + begin + Ch := Buffer[Start]; + + if Ch <= MaximumUCS2 then + begin + // 16 bits to store in place + if (StrPos > 0) and (StrPos <= StrLength) then + begin + S[StrPos] := WideChar(Ch); + Inc(StrPos); + end + else + Success := False; + end + else + if Ch <= MaximumUTF16 then + begin + // stores a surrogate pair + if (StrPos > 0) and (StrPos < StrLength) then + begin + Ch := Ch - HalfBase; + S[StrPos] := WideChar((Ch shr HalfShift) or SurrogateHighStart); + S[StrPos + 1] := WideChar((Ch and HalfMask) or SurrogateLowStart); + Inc(StrPos, 2); + end + else + Success := False; + end + else + begin + {$IFDEF UNICODE_SILENT_FAILURE} + // add ReplacementCharacter + if (StrPos > 0) and (StrPos <= StrLength) then + begin + S[StrPos] := WideChar(UCS4ReplacementCharacter); + Inc(StrPos, 1); + end + else + Success := False; + {$ELSE ~UNICODE_SILENT_FAILURE} + StrPos := -1; + Success := False; + {$ENDIF ~UNICODE_SILENT_FAILURE} + end; + if Success then + begin + Inc(Start); + Inc(Result); + end; + Dec(Count); + end; +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +function UTF16SetNextCharToStream(S: TStream; Ch: UCS4): Boolean; +begin + if Ch <= MaximumUCS2 then + // 16 bits to store in place + Result := StreamWriteWord(S, Ch) + else + if Ch <= MaximumUTF16 then + // stores a surrogate pair + Result := StreamWriteWord(S, (Ch shr HalfShift) or SurrogateHighStart) and + StreamWriteWord(S, (Ch and HalfMask) or SurrogateLowStart) + else + begin + {$IFDEF UNICODE_SILENT_FAILURE} + // add ReplacementCharacter + Result := StreamWriteWord(S, UCS4ReplacementCharacter); + {$ELSE ~UNICODE_SILENT_FAILURE} + Result := False; + {$ENDIF ~UNICODE_SILENT_FAILURE} + end; +end; + +function UTF16SetNextBufferToStream(S: TStream; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; +var + Ch: UCS4; + Success: Boolean; +begin + Result := 0; + Success := True; + while Success and (Count > 0) do + begin + Ch := Buffer[Start]; + if Ch <= MaximumUCS2 then + // 16 bits to store in place + Success := StreamWriteWord(S, Ch) + else + if Ch <= MaximumUTF16 then + // stores a surrogate pair + Success := StreamWriteWord(S, (Ch shr HalfShift) or SurrogateHighStart) and + StreamWriteWord(S, (Ch and HalfMask) or SurrogateLowStart) + else + begin + {$IFDEF UNICODE_SILENT_FAILURE} + // add ReplacementCharacter + Success := StreamWriteWord(S, UCS4ReplacementCharacter); + {$ELSE ~UNICODE_SILENT_FAILURE} + Success := False; + {$ENDIF ~UNICODE_SILENT_FAILURE} + end; + if Success then + begin + Inc(Start); + Inc(Result); + end; + Dec(Count); + end; +end; + +// AnsiGetNextChar = read next character at StrPos +// StrPos will be incremented by the number of chars that were read (1) +function AnsiGetNextChar(const S: AnsiString; var StrPos: SizeInt): UCS4; +var + StrLen, TmpPos: SizeInt; + UTF16Buffer: TUTF16String; +begin + StrLen := Length(S); + + if (StrPos <= StrLen) and (StrPos > 0) then + begin + UTF16Buffer := WideString(S[StrPos]); + TmpPos := 1; + Result := UTF16GetNextChar(UTF16Buffer, TmpPos); + if TmpPos = -1 then + StrPos := -1 + else + Inc(StrPos); + end + else + begin + // StrPos > StrLength + Result := 0; + FlagInvalidSequence(StrPos, 0, Result); + end; +end; + +function AnsiGetNextBuffer(const S: AnsiString; var StrPos: SizeInt; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; +var + StrLength, TmpPos: SizeInt; + UTF16Buffer: TUTF16String; +begin + StrLength := Length(S); + if (StrPos > 0) and (StrPos <= StrLength) then + begin + UTF16Buffer := WideString(Copy(S, StrPos, Count)); + TmpPos := 1; + Result := UTF16GetNextBuffer(UTF16Buffer, TmpPos, Buffer, Start, Count); + if TmpPos > 0 then + Inc(StrPos, Result) + else + StrPos := -1; + end + else + Result := 0; +end; + +function AnsiGetNextCharFromStream(S: TStream; out Ch: UCS4): Boolean; +var + B: Byte; + TmpPos: SizeInt; + UTF16Buffer: TUTF16String; +begin + Result := StreamReadByte(S, B); + if Result then + begin + UTF16Buffer := WideString(AnsiString(AnsiChar(B))); + TmpPos := 1; + Ch := UTF16GetNextChar(UTF16Buffer, TmpPos); + Result := TmpPos <> -1; + end; +end; + +function AnsiGetNextBufferFromStream(S: TStream; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; +var + B: TDynByteArray; + ReadSuccess: Boolean; + ReadCount, TmpPos: SizeInt; + UTF16Buffer: TUTF16String; +begin + Result := 0; + ReadSuccess := True; + SetLength(B, Count); + SetLength(UTF16Buffer, 2 * Count); + while ReadSuccess and (Count > 0) do + begin + ReadCount := S.Read(B[0], Count); + if ReadCount > 0 then + begin + ReadCount := MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED or MB_ERR_INVALID_CHARS, @B[0], ReadCount, PWideChar(UTF16Buffer), 2 * Count); + if ReadCount > 0 then + begin + TmpPos := 1; + ReadCount := UTF16GetNextBuffer(UTF16Buffer, TmpPos, Buffer, Start, ReadCount); + if TmpPos <> -1 then + Inc(Result, ReadCount) + else + ReadSuccess := False; + end + else + begin + Result := 0; + FlagInvalidSequence; + end; + end + else + ReadSuccess := False; + Dec(Count, ReadCount); + end; +end; + +// AnsiGetNextChar = read next character at StrPos +// StrPos will be incremented by the number of chars that were read (1) +function AnsiGetNextChar(const S: AnsiString; CodePage: Word; var StrPos: SizeInt): UCS4; +var + StrLen, TmpPos: SizeInt; + UTF16Buffer: TUTF16String; +begin + StrLen := Length(S); + + if (StrPos <= StrLen) and (StrPos > 0) then + begin + SetLength(UTF16Buffer, 2); + if MultiByteToWideChar(CodePage, MB_PRECOMPOSED or MB_ERR_INVALID_CHARS, @S[StrPos], 1, PWideChar(UTF16Buffer), 2) > 0 then + begin + TmpPos := 1; + Result := UTF16GetNextChar(UTF16Buffer, TmpPos); + if TmpPos > 0 then + Inc(StrPos) + else + StrPos := -1; + end + else + begin + Result := UCS4ReplacementCharacter; + FlagInvalidSequence(StrPos, 1, Result); + end; + end + else + begin + // StrPos > StrLength + Result := 0; + FlagInvalidSequence(StrPos, 0, Result); + end; +end; + +function AnsiGetNextBuffer(const S: AnsiString; CodePage: Word; var StrPos: SizeInt; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; +var + ReadCount, StrLength, TmpPos: SizeInt; + UTF16Buffer: TUTF16String; +begin + StrLength := Length(S); + if (StrPos > 0) and (StrPos <= StrLength) then + begin + SetLength(Buffer, 2 * Count); + ReadCount :=MultiByteToWideChar(CodePage, MB_PRECOMPOSED or MB_ERR_INVALID_CHARS, @S[StrPos], Count, PWideChar(UTF16Buffer), 2 * Count); + if ReadCount > 0 then + begin + TmpPos := 1; + Result := UTF16GetNextBuffer(UTF16Buffer, TmpPos, Buffer, Start, ReadCount); + if TmpPos > 0 then + Inc(StrPos, Result) + else + StrPos := -1; + end + else + begin + Result := 0; + FlagInvalidSequence(StrPos, 1); + end; + end + else + Result := 0; +end; + +function AnsiGetNextCharFromStream(S: TStream; CodePage: Word; out Ch: UCS4): Boolean; +var + B: Byte; + TmpPos: SizeInt; + UTF16Buffer: TUTF16String; +begin + Result := StreamReadByte(S, B); + if Result then + begin + SetLength(UTF16Buffer, 2); + if MultiByteToWideChar(CodePage, MB_PRECOMPOSED or MB_ERR_INVALID_CHARS, @B, 1, PWideChar(UTF16Buffer), 2) <> 0 then + begin + TmpPos := 1; + Ch := UTF16GetNextChar(UTF16Buffer, TmpPos); + Result := TmpPos <> -1; + end + else + begin + Result := False; + Ch := UCS4ReplacementCharacter; + end; + end; +end; + +function AnsiGetNextBufferFromStream(S: TStream; CodePage: Word; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; +var + B: TDynByteArray; + ReadSuccess: Boolean; + ReadCount, TmpPos: SizeInt; + UTF16Buffer: TUTF16String; +begin + Result := 0; + ReadSuccess := True; + SetLength(B, Count); + SetLength(UTF16Buffer, 2 * Count); + while ReadSuccess and (Count > 0) do + begin + ReadCount := S.Read(B[0], Count); + if ReadCount > 0 then + begin + ReadCount := MultiByteToWideChar(CodePage, MB_PRECOMPOSED or MB_ERR_INVALID_CHARS, @B[0], ReadCount, PWideChar(UTF16Buffer), 2 * Count); + if ReadCount > 0 then + begin + TmpPos := 1; + ReadCount := UTF16GetNextBuffer(UTF16Buffer, TmpPos, Buffer, Start, ReadCount); + if TmpPos <> -1 then + Inc(Result, ReadCount) + else + ReadSuccess := False; + end + else + begin + Result := 0; + FlagInvalidSequence; + end; + end + else + ReadSuccess := False; + Dec(Count, ReadCount); + end; +end; + +// AnsiSkipChars = skip NbSeq characters starting from StrPos +// returns False if String is too small +// StrPos will be incremented by the number of chars that were skipped +// On return, NbChar contains the number of chars that were skipped +function AnsiSkipChars(const S: AnsiString; var StrPos: SizeInt; var NbSeq: SizeInt): Boolean; +var + StrLen: SizeInt; +begin + StrLen := Length(S); + + if StrPos > 0 then + begin + if StrPos + NbSeq > StrLen then + begin + NbSeq := StrLen + 1 - StrPos; + StrPos := StrLen + 1; + Result := False; + end + else + begin + // NbSeq := NbSeq; + StrPos := StrLen + NbSeq; + Result := True; + end; + end + else + begin + // previous error + NbSeq := 0; + // StrPos := -1; + Result := False; + end; +end; + +function AnsiSkipCharsFromStream(S: TStream; var NbSeq: SizeInt): Boolean; +var + Index: SizeInt; + B: Byte; +begin + Index := 0; + while Index < NbSeq do + begin + Result := StreamReadByte(S, B); + if not Result then + Break; + Inc(Index); + end; + Result := Index = NbSeq; + NbSeq := Index; +end; + +// AnsiSetNextChar = append a character at StrPos +// returns False on error: +// - if an UCS4 character cannot be stored to an ansi string: +// - if UNICODE_SILENT_FAILURE is defined, ReplacementCharacter is added +// - if UNICODE_SILENT_FAILURE is not defined, StrPos is set to -1 +// - StrPos > -1 flags string being too small, callee did nothing and caller is responsible for allocating space +// StrPos will be incremented by the number of chars that were written (1) +function AnsiSetNextChar(var S: AnsiString; var StrPos: SizeInt; Ch: UCS4): Boolean; +var + StrLen, TmpPos, AnsiStrLen: SizeInt; + UTF16Buffer: TUTF16String; + AnsiBuffer: AnsiString; +begin + StrLen := Length(S); + Result := (StrPos > 0) and (StrPos <= StrLen); + if Result then + begin + SetLength(UTF16Buffer, 2); + TmpPos := 1; + Result := UTF16SetNextChar(UTF16Buffer, TmpPos, Ch); + if Result and (TmpPos = 2) then + // one wide character + AnsiBuffer := AnsiString(WideString(UTF16Buffer[1])) + else + if Result and (TmpPos = 3) then + // one surrogate pair + AnsiBuffer := AnsiString(UTF16Buffer) + else + begin + // add ReplacementCharacter + AnsiBuffer := AnsiReplacementCharacter; + {$IFDEF UNICODE_SILENT_FAILURE} + Result := True; + {$ELSE} + StrPos := -1; + {$ENDIF UNICODE_SILENT_FAILURE} + end; + AnsiStrLen := Length(AnsiBuffer); + Result := Result and ((StrPos + AnsiStrLen) <= (StrLen + 1)); + if Result then + begin + for TmpPos := 1 to AnsiStrLen do + begin + S[StrPos] := AnsiBuffer[TmpPos]; + Inc(StrPos); + end; + end; + end; +end; + +function AnsiSetNextBuffer(var S: AnsiString; var StrPos: SizeInt; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; +var + AnsiBuffer: AnsiString; + UTF16Buffer: WideString; + StrLen, TmpPos, AnsiStrLen: SizeInt; + Ch: UCS4; + Success: Boolean; +begin + StrLen:= Length(S); + SetLength(UTF16Buffer, 2); + Result := 0; + Success := True; + while Success and (Count > 0) do + begin + Ch := Buffer[Start]; + + TmpPos := 1; + Success := UTF16SetNextChar(UTF16Buffer, TmpPos, Ch); + if Success and (TmpPos = 2) then + // one wide character + AnsiBuffer := AnsiString(WideString(UTF16Buffer[1])) + else + if Success and (TmpPos = 3) then + // one surrogate pair + AnsiBuffer := AnsiString(UTF16Buffer) + else + begin + // add ReplacementCharacter + AnsiBuffer := AnsiReplacementCharacter; + {$IFDEF UNICODE_SILENT_FAILURE} + Success := True; + {$ELSE} + StrPos := -1; + {$ENDIF ~UNICODE_SILENT_FAILURE} + end; + AnsiStrLen := Length(AnsiBuffer); + Success := Success and ((StrPos + AnsiStrLen) <= (StrLen + 1)); + if Success then + begin + for TmpPos := 1 to AnsiStrLen do + begin + S[StrPos] := AnsiBuffer[TmpPos]; + Inc(StrPos); + end; + end; + if Success then + begin + Inc(Start); + Inc(Result); + end; + Dec(Count); + end; +end; + +function AnsiSetNextCharToStream(S: TStream; Ch: UCS4): Boolean; +var + TmpPos, I: SizeInt; + UTF16Buffer: TUTF16String; + AnsiBuffer: AnsiString; +begin + SetLength(UTF16Buffer, 2); + TmpPos := 1; + Result := UTF16SetNextChar(UTF16Buffer, TmpPos, Ch); + + if Result and (TmpPos = 2) then + // one wide character + AnsiBuffer := AnsiString(WideString(UTF16Buffer[1])) + else + if Result and (TmpPos = 3) then + // one surrogate pair + AnsiBuffer := AnsiString(UTF16Buffer) + else + begin + // add ReplacementCharacter + AnsiBuffer := AnsiReplacementCharacter; + {$IFDEF UNICODE_SILENT_FAILURE} + Result := True; + {$ENDIF UNICODE_SILENT_FAILURE} + end; + if Result then + for I := 1 to Length(AnsiBuffer) do + Result := Result and StreamWriteByte(S, Ord(AnsiBuffer[I])); +end; + +function AnsiSetNextBufferToStream(S: TStream; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; +var + TmpPos, I: SizeInt; + UTF16Buffer: TUTF16String; + AnsiBuffer: AnsiString; + Success: Boolean; + Ch: UCS4; +begin + SetLength(UTF16Buffer, 2); + Result := 0; + Success := True; + while Success and (Count > 0) do + begin + Ch := Buffer[Start]; + TmpPos := 1; + Success := UTF16SetNextChar(UTF16Buffer, TmpPos, Ch); + + if Success and (TmpPos = 2) then + // one wide character + AnsiBuffer := AnsiString(WideString(UTF16Buffer[1])) + else + if Success and (TmpPos = 3) then + // one surrogate pair + AnsiBuffer := AnsiString(UTF16Buffer) + else + begin + // add ReplacementCharacter + AnsiBuffer := AnsiReplacementCharacter; + {$IFDEF UNICODE_SILENT_FAILURE} + Success := True; + {$ENDIF UNICODE_SILENT_FAILURE} + end; + if Success then + for I := 1 to Length(AnsiBuffer) do + Success := Success and StreamWriteByte(S, Ord(AnsiBuffer[I])); + if Success then + begin + Inc(Start); + Inc(Result); + end; + Dec(Count); + end; +end; + +function AnsiSetNextChar(var S: AnsiString; CodePage: Word; var StrPos: SizeInt; Ch: UCS4): Boolean; +var + StrLen, TmpPos, AnsiStrLen: SizeInt; + UTF16Buffer: TUTF16String; + AnsiBuffer: AnsiString; +begin + StrLen := Length(S); + Result := (StrPos > 0) and (StrPos <= StrLen); + if Result then + begin + SetLength(UTF16Buffer, 2); + TmpPos := 1; + Result := UTF16SetNextChar(UTF16Buffer, TmpPos, Ch); + AnsiStrLen := WideCharToMultiByte(CodePage, 0, PWideChar(UTF16Buffer), TmpPos-1, nil, 0, nil, nil); + SetLength(AnsiBuffer, AnsiStrLen); + Result := Result and (WideCharToMultiByte(CodePage, 0, PWideChar(UTF16Buffer), TmpPos-1, @AnsiBuffer[1], AnsiStrLen, nil, nil) > 0); + if not Result then + begin + // add ReplacementCharacter + AnsiBuffer := AnsiReplacementCharacter; + AnsiStrLen := 1; + {$IFDEF UNICODE_SILENT_FAILURE} + Result := True; + {$ELSE} + StrPos := -1; + {$ENDIF ~UNICODE_SILENT_FAILURE} + end; + Result := Result and ((StrPos + AnsiStrLen) <= (StrLen + 1)); + if Result then + for TmpPos := 1 to AnsiStrLen do + begin + S[StrPos] := AnsiBuffer[TmpPos]; + Inc(StrPos); + end; + end; +end; + +function AnsiSetNextBuffer(var S: AnsiString; CodePage: Word; var StrPos: SizeInt; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; +var + StrLen, TmpPos, AnsiStrLen: SizeInt; + UTF16Buffer: TUTF16String; + AnsiBuffer: AnsiString; + Ch: UCS4; + Success: Boolean; +begin + StrLen:= Length(S); + SetLength(UTF16Buffer, 2); + Result := 0; + Success := True; + while Success and (Count > 0) do + begin + Ch := Buffer[Start]; + + TmpPos := 1; + Success := UTF16SetNextChar(UTF16Buffer, TmpPos, Ch); + AnsiStrLen := WideCharToMultiByte(CodePage, 0, PWideChar(UTF16Buffer), TmpPos-1, nil, 0, nil, nil); + SetLength(AnsiBuffer, AnsiStrLen); + Success := Success and (WideCharToMultiByte(CodePage, 0, PWideChar(UTF16Buffer), TmpPos-1, @AnsiBuffer[1], AnsiStrLen, nil, nil) > 0); + if not Success then + begin + // add ReplacementCharacter + AnsiBuffer := AnsiReplacementCharacter; + AnsiStrLen := 1; + {$IFDEF UNICODE_SILENT_FAILURE} + Success := True; + {$ELSE} + StrPos := -1; + {$ENDIF UNICODE_SILENT_FAILURE} + end; + Success := Success and ((StrPos + AnsiStrLen) <= (StrLen + 1)); + if Success then + for TmpPos := 1 to AnsiStrLen do + begin + S[StrPos] := AnsiBuffer[TmpPos]; + Inc(StrPos); + end; + if Success then + begin + Inc(Start); + Inc(Result); + end; + Dec(Count); + end; +end; + +function AnsiSetNextCharToStream(S: TStream; CodePage: Word; Ch: UCS4): Boolean; +var + TmpPos, AnsiStrLen: SizeInt; + UTF16Buffer: TUTF16String; + AnsiBuffer: AnsiString; +begin + SetLength(UTF16Buffer, 2); + TmpPos := 1; + Result := UTF16SetNextChar(UTF16Buffer, TmpPos, Ch); + AnsiStrLen := WideCharToMultiByte(CodePage, 0, PWideChar(UTF16Buffer), TmpPos-1, nil, 0, nil, nil); + SetLength(AnsiBuffer, AnsiStrLen); + Result := Result and (WideCharToMultiByte(CodePage, 0, PWideChar(UTF16Buffer), TmpPos-1, @AnsiBuffer[1], AnsiStrLen, nil, nil) > 0); + if not Result then + begin + // add ReplacementCharacter + AnsiBuffer := AnsiReplacementCharacter; + AnsiStrLen := 1; + {$IFDEF UNICODE_SILENT_FAILURE} + Result := True; + {$ENDIF UNICODE_SILENT_FAILURE} + end; + if Result then + for TmpPos := 1 to AnsiStrLen do + Result := Result and StreamWriteByte(S, Ord(AnsiBuffer[TmpPos])); +end; + +function AnsiSetNextBufferToStream(S: TStream; CodePage: Word; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; overload; +var + TmpPos, AnsiStrLen: SizeInt; + UTF16Buffer: TUTF16String; + AnsiBuffer: AnsiString; + Success: Boolean; + Ch: UCS4; +begin + SetLength(UTF16Buffer, 2); + Result := 0; + Success := True; + while Success and (Count > 0) do + begin + Ch := Buffer[Start]; + TmpPos := 1; + Success := UTF16SetNextChar(UTF16Buffer, TmpPos, Ch); + AnsiStrLen := WideCharToMultiByte(CodePage, 0, PWideChar(UTF16Buffer), TmpPos-1, nil, 0, nil, nil); + SetLength(AnsiBuffer, AnsiStrLen); + Success := Success and (WideCharToMultiByte(CodePage, 0, PWideChar(UTF16Buffer), TmpPos-1, @AnsiBuffer[1], AnsiStrLen, nil, nil) > 0); + if not Success then + begin + // add ReplacementCharacter + AnsiBuffer := AnsiReplacementCharacter; + AnsiStrLen := 1; + {$IFDEF UNICODE_SILENT_FAILURE} + Success := True; + {$ENDIF UNICODE_SILENT_FAILURE} + end; + if Success then + for TmpPos := 1 to AnsiStrLen do + Success := Success and StreamWriteByte(S, Ord(AnsiBuffer[TmpPos])); + if Success then + begin + Inc(Start); + Inc(Result); + end; + Dec(Count); + end; +end; + +// StringGetNextChar = read next character/sequence at StrPos +// if UNICODE_SILENT_FAILURE is defined, invalid sequences will be replaced by ReplacementCharacter +// otherwise StrPos is set to -1 on return to flag an error (invalid UTF16 sequence for WideString) +// StrPos will be incremented by the number of chars that were read +function StringGetNextChar(const S: string; var StrPos: SizeInt): UCS4; +begin + {$IFDEF SUPPORTS_UNICODE} + Result := UTF16GetNextChar(S, StrPos); + {$ELSE ~SUPPORTS_UNICODE} + Result := AnsiGetNextChar(S, StrPos); + {$ENDIF ~SUPPORTS_UNICODE} +end; + +function StringGetNextBuffer(const S: string; var StrPos: SizeInt; var Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; +begin + {$IFDEF SUPPORTS_UNICODE} + Result := UTF16GetNextBuffer(S, StrPos, Buffer, Start, Count); + {$ELSE ~SUPPORTS_UNICODE} + Result := AnsiGetNextBuffer(S, StrPos, Buffer, Start, Count); + {$ENDIF ~SUPPORTS_UNICODE} +end; + +// StringSkipChars = skip NbSeq characters/sequences starting from StrPos +// returns False if String is too small +// if UNICODE_SILENT_FAILURE is not defined StrPos is set to -1 on error (invalid UTF16 sequence for WideString) +// StrPos will be incremented by the number of chars that were skipped +// On return, NbChar contains the number of UTF16 sequences that were skipped +function StringSkipChars(const S: string; var StrPos: SizeInt; var NbSeq: SizeInt): Boolean; +begin + {$IFDEF SUPPORTS_UNICODE} + Result := UTF16SkipChars(S, StrPos, NbSeq); + {$ELSE ~SUPPORTS_UNICODE} + Result := AnsiSkipChars(S, StrPos, NbSeq); + {$ENDIF ~SUPPORTS_UNICODE} +end; + +// StringSetNextChar = append a character/sequence at StrPos +// returns False on error: +// - if an UCS4 character cannot be stored to a string: +// - if UNICODE_SILENT_FAILURE is defined, ReplacementCharacter is added +// - if UNICODE_SILENT_FAILURE is not defined, StrPos is set to -1 +// - StrPos > -1 flags string being too small, callee did nothing and caller is responsible for allocating space +// StrPos will be incremented by the number of chars that were written +function StringSetNextChar(var S: string; var StrPos: SizeInt; Ch: UCS4): Boolean; +begin + {$IFDEF SUPPORTS_UNICODE} + Result := UTF16SetNextChar(S, StrPos, Ch); + {$ELSE ~SUPPORTS_UNICODE} + Result := AnsiSetNextChar(S, StrPos, Ch); + {$ENDIF ~SUPPORTS_UNICODE} +end; + +function StringSetNextBuffer(var S: string; var StrPos: SizeInt; const Buffer: TUCS4Array; var Start: SizeInt; Count: SizeInt): SizeInt; +begin + {$IFDEF SUPPORTS_UNICODE} + Result := UTF16SetNextBuffer(S, StrPos, Buffer, Start, Count); + {$ELSE ~SUPPORTS_UNICODE} + Result := AnsiSetNextBuffer(S, StrPos, Buffer, Start, Count); + {$ENDIF ~SUPPORTS_UNICODE} +end; + +function WideStringToUTF8(const S: WideString): TUTF8String; +begin + Result := UTF16ToUTF8(S); +end; + +function UTF8ToWideString(const S: TUTF8String): WideString; +begin + Result := UTF8ToUTF16(S); +end; + +function WideStringToUCS4(const S: WideString): TUCS4Array; +begin + Result := UTF16ToUCS4(S); +end; + +function UCS4ToWideString(const S: TUCS4Array): WideString; +begin + Result := UCS4ToUTF16(S); +end; + +function AnsiStringToUTF8(const S: AnsiString): TUTF8String; +var + WS: TUTF16String; +begin + WS := TUTF16String(S); + Result := UTF16ToUTF8(WS); +end; + +function UTF8ToAnsiString(const S: TUTF8String): AnsiString; +var + WS: TUTF16String; +begin + WS := UTF8ToUTF16(S); + Result := AnsiString(WS); +end; + +function AnsiStringToUTF16(const S: AnsiString): TUTF16String; +begin + Result := TUTF16String(S); +end; + +function UTF16ToAnsiString(const S: TUTF16String): AnsiString; +begin + Result := AnsiString(S); +end; + +function AnsiStringToUCS4(const S: AnsiString): TUCS4Array; +var + WS: TUTF16String; +begin + WS := TUTF16String(S); + Result := UTF16ToUCS4(WS); +end; + +function UCS4ToAnsiString(const S: TUCS4Array): AnsiString; +var + WS: TUTF16String; +begin + WS := UCS4ToUTF16(S); + Result := AnsiString(WS); +end; + +function StringToUTF8(const S: string): TUTF8String; +var + WS: TUTF16String; +begin + WS := TUTF16String(S); + Result := UTF16ToUTF8(WS); +end; + +function TryStringToUTF8(const S: string; out D: TUTF8String): Boolean; +var + WS: TUTF16String; +begin + WS := TUTF16String(S); + Result := TryUTF16ToUTF8(WS, D); +end; + +function UTF8ToString(const S: TUTF8String): string; +var + WS: TUTF16String; +begin + WS := UTF8ToUTF16(S); + Result := string(WS); +end; + +function TryUTF8ToString(const S: TUTF8String; out D: string): Boolean; +var + WS: TUTF16String; +begin + Result := TryUTF8ToUTF16(S, WS); + D := string(WS); +end; + +function StringToUTF16(const S: string): TUTF16String; +begin + Result := TUTF16String(S); +end; + +function TryStringToUTF16(const S: string; out D: TUTF16String): Boolean; +begin + D := TUTF16String(S); + Result := True; +end; + +function UTF16ToString(const S: TUTF16String): string; +begin + Result := string(S); +end; + +function TryUTF16ToString(const S: TUTF16String; out D: string): Boolean; +begin + D := string(S); + Result := True; +end; + +function StringToUCS4(const S: string): TUCS4Array; +var + WS: TUTF16String; +begin + WS := TUTF16String(S); + Result := UTF16ToUCS4(WS); +end; + +function TryStringToUCS4(const S: string; out D: TUCS4Array): Boolean; +var + WS: TUTF16String; +begin + WS := TUTF16String(S); + Result := TryUTF16ToUCS4(WS, D); +end; + +function UCS4ToString(const S: TUCS4Array): string; +var + WS: WideString; +begin + WS := UCS4ToUTF16(S); + Result := string(WS); +end; + +function TryUCS4ToString(const S: TUCS4Array; out D: string): Boolean; +var + WS: TUTF16String; +begin + Result := TryUCS4ToUTF16(S, WS); + D := string(WS); +end; + +function UTF8ToUTF16(const S: TUTF8String): TUTF16String; +var + SrcIndex, SrcLength, DestIndex: SizeInt; + Ch: UCS4; +begin + if S = '' then + Result := '' + else + begin + SrcLength := Length(S); + SetLength(Result, SrcLength); // create enough room + + SrcIndex := 1; + DestIndex := 1; + while SrcIndex <= SrcLength do + begin + Ch := UTF8GetNextChar(S, SrcIndex); + if SrcIndex = -1 then + raise EJclUnexpectedEOSequenceError.Create; + + UTF16SetNextChar(Result, DestIndex, Ch); + end; + SetLength(Result, DestIndex - 1); // now fix up length + end; +end; + +function TryUTF8ToUTF16(const S: TUTF8String; out D: TUTF16String): Boolean; +var + SrcIndex, SrcLength, DestIndex: SizeInt; + Ch: UCS4; +begin + Result := True; + if S = '' then + D := '' + else + begin + SrcLength := Length(S); + SetLength(D, SrcLength); // create enough room + + SrcIndex := 1; + DestIndex := 1; + while (SrcIndex > 0) and (SrcIndex <= SrcLength) do + begin + Ch := UTF8GetNextChar(S, SrcIndex); + if SrcIndex > 0 then + UTF16SetNextChar(D, DestIndex, Ch) + else + Result := False; + end; + if Result then + SetLength(D, DestIndex - 1) // now fix up length + else + D := ''; + end; +end; + +function UTF16ToUTF8(const S: TUTF16String): TUTF8String; +var + SrcIndex, SrcLength, DestIndex: SizeInt; + Ch: UCS4; +begin + if S = '' then + Result := '' + else + begin + SrcLength := Length(S); + SetLength(Result, SrcLength * 3); // worste case + + SrcIndex := 1; + DestIndex := 1; + while SrcIndex <= SrcLength do + begin + Ch := UTF16GetNextChar(S, SrcIndex); + if SrcIndex = -1 then + raise EJclUnexpectedEOSequenceError.Create; + + UTF8SetNextChar(Result, DestIndex, Ch); + end; + SetLength(Result, DestIndex - 1); // now fix up length + end; +end; + +function TryUTF16ToUTF8(const S: TUTF16String; out D: TUTF8String): Boolean; +var + SrcIndex, SrcLength, DestIndex: SizeInt; + Ch: UCS4; +begin + Result := True; + if S = '' then + D := '' + else + begin + SrcLength := Length(S); + SetLength(D, SrcLength * 3); // worste case + + SrcIndex := 1; + DestIndex := 1; + while (SrcIndex > 0) and (SrcIndex <= SrcLength) do + begin + Ch := UTF16GetNextChar(S, SrcIndex); + if SrcIndex > 0 then + UTF8SetNextChar(D, DestIndex, Ch) + else + Result := False; + end; + if Result then + SetLength(D, DestIndex - 1) // now fix up length + else + D := ''; + end; +end; + +function UTF8ToUCS4(const S: TUTF8String): TUCS4Array; +var + SrcIndex, SrcLength, DestIndex: SizeInt; + Ch: UCS4; +begin + if S <> '' then + begin + SrcLength := Length(S); + SetLength(Result, SrcLength); // create enough room + + SrcIndex := 1; + DestIndex := 0; + while SrcIndex <= SrcLength do + begin + Ch := UTF8GetNextChar(S, SrcIndex); + if SrcIndex = -1 then + raise EJclUnexpectedEOSequenceError.Create; + + Result[DestIndex] := Ch; + Inc(DestIndex); + end; + SetLength(Result, DestIndex); // now fix up length + end; +end; + +function TryUTF8ToUCS4(const S: TUTF8String; out D: TUCS4Array): Boolean; +var + SrcIndex, SrcLength, DestIndex: SizeInt; + Ch: UCS4; +begin + Result := True; + if S <> '' then + begin + SrcLength := Length(S); + SetLength(D, SrcLength); // create enough room + + SrcIndex := 1; + DestIndex := 0; + while (SrcIndex > 0) and (SrcIndex <= SrcLength) do + begin + Ch := UTF8GetNextChar(S, SrcIndex); + if SrcIndex > 0 then + begin + D[DestIndex] := Ch; + Inc(DestIndex); + end + else + Result := False; + end; + if Result then + SetLength(D, DestIndex) // now fix up length + else + SetLength(D, 0); + end; +end; + +function UCS4ToUTF8(const S: TUCS4Array): TUTF8String; +var + SrcIndex, SrcLength, DestIndex: SizeInt; +begin + SrcLength := Length(S); + if Length(S) = 0 then + Result := '' + else + begin + SetLength(Result, SrcLength * 3); // assume worst case + DestIndex := 1; + + for SrcIndex := 0 to SrcLength - 1 do + begin + UTF8SetNextChar(Result, DestIndex, S[SrcIndex]); + if DestIndex = -1 then + raise EJclUnexpectedEOSequenceError.Create; + end; + + SetLength(Result, DestIndex - 1); // set to actual length + end; +end; + +function TryUCS4ToUTF8(const S: TUCS4Array; out D: TUTF8String): Boolean; +var + SrcIndex, SrcLength, DestIndex: SizeInt; +begin + SrcLength := Length(S); + Result := True; + if Length(S) = 0 then + D := '' + else + begin + SetLength(D, SrcLength * 3); // assume worst case + DestIndex := 1; + + for SrcIndex := 0 to SrcLength - 1 do + begin + UTF8SetNextChar(D, DestIndex, S[SrcIndex]); + if DestIndex = -1 then + begin + Result := False; + Break; + end; + end; + if Result then + SetLength(D, DestIndex - 1) // set to actual length + else + D := ''; + end; +end; + +function UTF16ToUCS4(const S: TUTF16String): TUCS4Array; +var + SrcIndex, SrcLength, DestIndex: SizeInt; + Ch: UCS4; +begin + if S <> '' then + begin + SrcLength := Length(S); + SetLength(Result, SrcLength); // create enough room + + SrcIndex := 1; + DestIndex := 0; + while SrcIndex <= SrcLength do + begin + Ch := UTF16GetNextChar(S, SrcIndex); + if SrcIndex = -1 then + raise EJclUnexpectedEOSequenceError.Create; + + Result[DestIndex] := Ch; + Inc(DestIndex); + end; + SetLength(Result, DestIndex); // now fix up length + end; +end; + +function TryUTF16ToUCS4(const S: TUTF16String; out D: TUCS4Array): Boolean; +var + SrcIndex, SrcLength, DestIndex: SizeInt; + Ch: UCS4; +begin + Result := True; + if S <> '' then + begin + SrcLength := Length(S); + SetLength(D, SrcLength); // create enough room + + SrcIndex := 1; + DestIndex := 0; + while (SrcIndex > 0) and (SrcIndex <= SrcLength) do + begin + Ch := UTF16GetNextChar(S, SrcIndex); + if SrcIndex > 0 then + begin + D[DestIndex] := Ch; + Inc(DestIndex); + end + else + Result := False; + end; + if Result then + SetLength(D, DestIndex) // now fix up length + else + SetLength(D, 0); + end; +end; + +function UCS4ToUTF16(const S: TUCS4Array): TUTF16String; +var + SrcIndex, SrcLength, DestIndex: SizeInt; +begin + SrcLength := Length(S); + if SrcLength = 0 then + Result := '' + else + begin + SetLength(Result, SrcLength * 3); // assume worst case + DestIndex := 1; + + for SrcIndex := 0 to SrcLength - 1 do + begin + UTF16SetNextChar(Result, DestIndex, S[SrcIndex]); + if DestIndex = -1 then + raise EJclUnexpectedEOSequenceError.Create; + end; + + SetLength(Result, DestIndex - 1); // set to actual length + end; +end; + +function TryUCS4ToUTF16(const S: TUCS4Array; out D:TUTF16String): Boolean; +var + SrcIndex, SrcLength, DestIndex: SizeInt; +begin + SrcLength := Length(S); + Result := True; + if SrcLength = 0 then + D := '' + else + begin + SetLength(D, SrcLength * 3); // assume worst case + DestIndex := 1; + + for SrcIndex := 0 to SrcLength - 1 do + begin + UTF16SetNextChar(D, DestIndex, S[SrcIndex]); + if DestIndex = -1 then + begin + Result := False; + Break; + end; + end; + + if Result then + SetLength(D, DestIndex - 1) // set to actual length + else + D := ''; + end; +end; + +function UTF8CharCount(const S: TUTF8String): SizeInt; +var + StrPos: SizeInt; +begin + StrPos := 1; + Result := Length(S); + UTF8SkipChars(S, StrPos, Result); + if StrPos = -1 then + raise EJclUnexpectedEOSequenceError.Create; +end; + +function UTF16CharCount(const S: TUTF16String): SizeInt; +var + StrPos: SizeInt; +begin + StrPos := 1; + Result := Length(S); + UTF16SkipChars(S, StrPos, Result); + if StrPos = -1 then + raise EJclUnexpectedEOSequenceError.Create; +end; + +function UCS2CharCount(const S: TUCS2String): SizeInt; +begin + Result := Length(S); +end; + +function UCS4CharCount(const S: TUCS4Array): SizeInt; +begin + Result := Length(S); +end; + +function GetUCS4CharAt(const UTF8Str: TUTF8String; Index: SizeInt; out Value: UCS4): Boolean; overload; +var + StrPos: SizeInt; +begin + StrPos := 1; + Result := Index >= 0; + if Result then + Result := UTF8SkipChars(UTF8Str, StrPos, Index); + if StrPos = -1 then + raise EJclUnexpectedEOSequenceError.Create; + Result := Result and (StrPos <= Length(UTF8Str)); + if Result then + begin + Value := UTF8GetNextChar(UTF8Str, StrPos); + if StrPos = -1 then + raise EJclUnexpectedEOSequenceError.Create; + end; +end; + +function GetUCS4CharAt(const WideStr: TUTF16String; Index: SizeInt; out Value: UCS4; IsUTF16: Boolean): Boolean; overload; +var + StrPos: SizeInt; +begin + if IsUTF16 then + begin + StrPos := 1; + Result := Index >= 0; + if Result then + Result := UTF16SkipChars(WideStr, StrPos, Index); + if StrPos = -1 then + raise EJclUnexpectedEOSequenceError.Create; + Result := Result and (StrPos <= Length(WideStr)); + if Result then + begin + Value := UTF16GetNextChar(WideStr, StrPos); + if StrPos = -1 then + raise EJclUnexpectedEOSequenceError.Create; + end; + end + else + begin + Result := (Index >= 1) and (Index <= Length(WideStr)); + Value := UCS4(WideStr[Index]); + end; +end; + +function GetUCS4CharAt(const UCS4Str: TUCS4Array; Index: SizeInt; out Value: UCS4): Boolean; overload; +begin + Result := (Index >= 0) and (Index < Length(UCS4Str)); + if Result then + Value := UCS4Str[Index]; +end; + +function UCS4ToAnsiChar(Value: UCS4): AnsiChar; +var + Buf: WideString; + StrPos: SizeInt; +begin + StrPos := 1; + Buf := #0#0; + if UTF16SetNextChar(Buf, StrPos, Value) then + Result := AnsiString(Buf)[1] + else + Result := AnsiReplacementCharacter; +end; + +function UCS4ToWideChar(Value: UCS4): WideChar; +begin + if Value <= MaximumUCS2 then + Result := WideChar(Value) + else + Result := WideChar(UCS4ReplacementCharacter); +end; + +function UCS4ToChar(Value: UCS4): Char; +begin + {$IFDEF SUPPORTS_UNICODE} + Result := UCS4ToWideChar(Value); + {$ELSE ~SUPPORTS_UNICODE} + Result := UCS4ToAnsiChar(Value); + {$ENDIF ~SUPPORTS_UNICODE} +end; + +function AnsiCharToUCS4(Value: AnsiChar): UCS4; +var + Buf: WideString; + StrPos: SizeInt; +begin + StrPos := 1; + Buf := WideString(AnsiString(Value)); + Result := UTF16GetNextChar(Buf, StrPos); +end; + +function WideCharToUCS4(Value: WideChar): UCS4; +begin + Result := UCS4(Value); +end; + +function CharToUCS4(Value: Char): UCS4; +begin + {$IFDEF SUPPORTS_UNICODE} + Result := WideCharToUCS4(Value); + {$ELSE ~SUPPORTS_UNICODE} + Result := AnsiCharToUCS4(Value); + {$ENDIF ~SUPPORTS_UNICODE} +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclStringLists.pas b/3rdParty/JCL/source/common/JclStringLists.pas index c3c5a5fc..4e7a66db 100644 --- a/3rdParty/JCL/source/common/JclStringLists.pas +++ b/3rdParty/JCL/source/common/JclStringLists.pas @@ -1,1445 +1,1445 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is NewStringListUnit.pas. } -{ } -{ The Initial Developer of the Original Code is Romullo Sousa. } -{ Portions created by Romullo Sousa are Copyright (C) Romullo Sousa. All rights reserved. } -{ } -{ Contributor(s): } -{ Romullo Sousa (romullobr) } -{ Leo Simas (Leh_U) } -{ } -{**************************************************************************************************} -{ } -{ This unit contains several improvements of the standard TStringList. } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -unit JclStringLists; - -{$I jcl.inc} - -interface - -uses - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - {$IFDEF HAS_UNITSCOPE} - {$IFDEF MSWINDOWS} - Winapi.Windows, - {$ENDIF MSWINDOWS} - System.Variants, - System.Classes, System.SysUtils, - {$ELSE ~HAS_UNITSCOPE} - {$IFDEF MSWINDOWS} - Windows, - {$ENDIF MSWINDOWS} - Variants, - Classes, SysUtils, - {$ENDIF ~HAS_UNITSCOPE} - JclBase, - JclPCRE; - -{$DEFINE HAS_TSTRINGS_COMPARESTRINGS} -{$IFDEF FPC} - {$UNDEF HAS_TSTRINGS_COMPARESTRINGS} -{$ENDIF FPC} - -type - EJclStringListError = class(EJclError); - - IJclStringList = interface; - - TJclStringListObjectsMode = (omNone, omObjects, omVariants, omInterfaces); - - TJclStringListSortCompare = function(List: IJclStringList; Index1, Index2: Integer): Integer; - - IJclStringList = interface(IInterface) - ['{8DC5B71C-4756-404D-8636-7872CD299796}'] - { From TStrings/TStringList } - function Add(const S: string): Integer; overload; - function AddObject(const S: string; AObject: TObject): Integer; - function Get(Index: Integer): string; - function GetCapacity: Integer; - function GetCount: Integer; - function GetObjects(Index: Integer): TObject; - function GetTextStr: string; - function GetValue(const Name: string): string; - {$IFDEF FPC} - function Find(const S: string; out Index: Integer): Boolean; - {$ELSE ~FPC} - function Find(const S: string; var Index: Integer): Boolean; - {$ENDIF ~FPC} - function IndexOf(const S: string): Integer; - function GetCaseSensitive: Boolean; - function GetDuplicates: TDuplicates; - function GetOnChange: TNotifyEvent; - function GetOnChanging: TNotifyEvent; - function GetSorted: Boolean; - function Equals(Strings: TStrings): Boolean; - function IndexOfName(const Name: string): Integer; - function IndexOfObject(AObject: TObject): Integer; - function LoadFromFile(const FileName: string): IJclStringList; - function LoadFromStream(Stream: TStream): IJclStringList; - function SaveToFile(const FileName: string): IJclStringList; - function SaveToStream(Stream: TStream): IJclStringList; - function GetCommaText: string; - function GetDelimitedText: string; - function GetDelimiter: Char; - function GetName(Index: Integer): string; - {$IFDEF COMPILER7_UP} - function GetNameValueSeparator: Char; - function GetValueFromIndex(Index: Integer): string; - {$ENDIF COMPILER7_UP} - function GetQuoteChar: Char; - procedure SetCommaText(const Value: string); - procedure SetDelimitedText(const Value: string); - procedure SetDelimiter(const Value: Char); - {$IFDEF COMPILER7_UP} - procedure SetNameValueSeparator(const Value: Char); - procedure SetValueFromIndex(Index: Integer; const Value: string); - {$ENDIF COMPILER7_UP} - procedure SetQuoteChar(const Value: Char); - procedure AddStrings(Strings: TStrings); overload; - procedure SetObjects(Index: Integer; const Value: TObject); - procedure Put(Index: Integer; const S: string); - procedure SetCapacity(NewCapacity: Integer); - procedure SetTextStr(const Value: string); - procedure SetValue(const Name, Value: string); - procedure SetCaseSensitive(const Value: Boolean); - procedure SetDuplicates(const Value: TDuplicates); - procedure SetOnChange(const Value: TNotifyEvent); - procedure SetOnChanging(const Value: TNotifyEvent); - procedure SetSorted(const Value: Boolean); - property Count: Integer read GetCount; - property Strings[Index: Integer]: string read Get write Put; default; - property Text: string read GetTextStr write SetTextStr; - property Objects[Index: Integer]: TObject read GetObjects write SetObjects; - property Capacity: Integer read GetCapacity write SetCapacity; - property Values[const Name: string]: string read GetValue write SetValue; - property Duplicates: TDuplicates read GetDuplicates write SetDuplicates; - property Sorted: Boolean read GetSorted write SetSorted; - property CaseSensitive: Boolean read GetCaseSensitive write SetCaseSensitive; - property OnChange: TNotifyEvent read GetOnChange write SetOnChange; - property OnChanging: TNotifyEvent read GetOnChanging write SetOnChanging; - property DelimitedText: string read GetDelimitedText write SetDelimitedText; - property Delimiter: Char read GetDelimiter write SetDelimiter; - property Names[Index: Integer]: string read GetName; - property QuoteChar: Char read GetQuoteChar write SetQuoteChar; - property CommaText: string read GetCommaText write SetCommaText; - {$IFDEF COMPILER7_UP} - property ValueFromIndex[Index: Integer]: string read GetValueFromIndex write SetValueFromIndex; - property NameValueSeparator: Char read GetNameValueSeparator write SetNameValueSeparator; - {$ENDIF COMPILER7_UP} - { New } - function Assign(Source: TPersistent): IJclStringList; - function LoadExeParams: IJclStringList; - function Exists(const S: string): Boolean; - function ExistsName(const S: string): Boolean; - function DeleteBlanks: IJclStringList; - function KeepIntegers: IJclStringList; - function DeleteIntegers: IJclStringList; - function ReleaseInterfaces: IJclStringList; - function FreeObjects(AFreeAndNil: Boolean = False): IJclStringList; - function Clone: IJclStringList; - function Insert(Index: Integer; const S: string): IJclStringList; - function InsertObject(Index: Integer; const S: string; AObject: TObject): IJclStringList; - function Sort(ACompareFunction: TJclStringListSortCompare = nil): IJclStringList; - function SortAsInteger: IJclStringList; - function SortByName: IJclStringList; - function Delete(AIndex: Integer): IJclStringList; overload; - function Delete(const AString: string): IJclStringList; overload; - function Exchange(Index1, Index2: Integer): IJclStringList; - function Add(const A: array of const): IJclStringList; overload; - function AddStrings(const A: array of string): IJclStringList; overload; - function BeginUpdate: IJclStringList; - function EndUpdate: IJclStringList; - function Trim: IJclStringList; - function Join(const ASeparator: string = ''): string; - function Split(const AText, ASeparator: string; AClearBeforeAdd: Boolean = True): IJclStringList; - function ExtractWords(const AText: string; const ADelims: TSetOfAnsiChar = [#0..' ']; AClearBeforeAdd: Boolean = True): IJclStringList; - function Last: string; - function First: string; - function LastIndex: Integer; - function Clear: IJclStringList; - {$IFDEF JCL_PCRE} - function DeleteRegEx(const APattern: string): IJclStringList; - function KeepRegEx(const APattern: string): IJclStringList; - function Files(const APattern: string = '*'; ARecursive: Boolean = False; const ARegExPattern: string = ''): IJclStringList; - function Directories(const APattern: string = '*'; ARecursive: Boolean = False; const ARegExPattern: string = ''): IJclStringList; - {$ENDIF JCL_PCRE} - function GetStringsRef: TStrings; - function ConfigAsSet: IJclStringList; - function Delimit(const ADelimiter: string): IJclStringList; - function GetInterfaceByIndex(Index: Integer): IInterface; - function GetLists(Index: Integer): IJclStringList; - function GetVariants(AIndex: Integer): Variant; - function GetKeyInterface(const AKey: string): IInterface; - function GetKeyObject(const AKey: string): TObject; - function GetKeyVariant(const AKey: string): Variant; - function GetKeyList(const AKey: string): IJclStringList; - function GetObjectsMode: TJclStringListObjectsMode; - procedure SetInterfaceByIndex(Index: Integer; const Value: IInterface); - procedure SetLists(Index: Integer; const Value: IJclStringList); - procedure SetVariants(Index: Integer; const Value: Variant); - procedure SetKeyInterface(const AKey: string; const Value: IInterface); - procedure SetKeyObject(const AKey: string; const Value: TObject); - procedure SetKeyVariant(const AKey: string; const Value: Variant); - procedure SetKeyList(const AKey: string; const Value: IJclStringList); - property Interfaces[Index: Integer]: IInterface read GetInterfaceByIndex write SetInterfaceByIndex; - property Lists[Index: Integer]: IJclStringList read GetLists write SetLists; - property Variants[Index: Integer]: Variant read GetVariants write SetVariants; - property KeyList[const AKey: string]: IJclStringList read GetKeyList write SetKeyList; - property KeyObject[const AKey: string]: TObject read GetKeyObject write SetKeyObject; - property KeyInterface[const AKey: string]: IInterface read GetKeyInterface write SetKeyInterface; - property KeyVariant[const AKey: string]: Variant read GetKeyVariant write SetKeyVariant; - property ObjectsMode: TJclStringListObjectsMode read GetObjectsMode; - {$IFDEF SUPPORTS_FOR_IN} - function GetEnumerator: TStringsEnumerator; - {$ENDIF SUPPORTS_FOR_IN} - end; - -type - TJclInterfacedStringList = class(TStringList, IInterface) - private - FOwnerInterface: IInterface; - public - { IInterface } - function _AddRef: Integer; stdcall; - function _Release: Integer; stdcall; - function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; stdcall; - procedure AfterConstruction; override; - end; - - - TJclStringList = class(TJclInterfacedStringList, IInterface, IJclStringList) - private - FObjectsMode: TJclStringListObjectsMode; - FSelfAsInterface: IJclStringList; - {$IFDEF JCL_PCRE} - FLastRegExPattern: string; - FRegEx: TJclRegEx; - {$ENDIF JCL_PCRE} - FCompareFunction: TJclStringListSortCompare; - function CanFreeObjects: Boolean; - {$IFDEF JCL_PCRE} - function MatchRegEx(const S, APattern: string): Boolean; - {$ENDIF JCL_PCRE} - procedure EnsureObjectsMode(AMode: TJclStringListObjectsMode); - protected - FRefCount: Integer; - {$IFNDEF HAS_TSTRINGS_COMPARESTRINGS} - function CompareStrings(const S1, S2: string): Integer; virtual; - {$ENDIF ~HAS_TSTRINGS_COMPARESTRINGS} - public - constructor Create; - destructor Destroy; override; - { IInterface } - // function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall; - function _AddRef: Integer; stdcall; - function _Release: Integer; stdcall; - { IJclStringList } - // function Add(const S: string): Integer; overload; - // function AddObject(const S: string; AObject: TObject): Integer; - // function Get(Index: Integer): string; - // function GetCapacity: Integer; - // function GetCount: Integer; - function GetObjects(Index: Integer): TObject; - // function GetTextStr: string; - function GetValue(const Name: string): string; - // function Find(const S: string; var Index: Integer): Boolean; - // function IndexOf(const S: string): Integer; - function GetCaseSensitive: Boolean; - function GetDuplicates: TDuplicates; - function GetOnChange: TNotifyEvent; - function GetOnChanging: TNotifyEvent; - function GetSorted: Boolean; - // function Equals(Strings: TStrings): Boolean; - // function IndexOfName(const Name: string): Integer; - // function IndexOfObject(AObject: TObject): Integer; - function LoadFromFile(const FileName: string): IJclStringList; reintroduce; - function LoadFromStream(Stream: TStream): IJclStringList; reintroduce; - function SaveToFile(const FileName: string): IJclStringList; reintroduce; - function SaveToStream(Stream: TStream): IJclStringList; reintroduce; - function GetCommaText: string; - function GetDelimitedText: string; - function GetDelimiter: Char; - function GetName(Index: Integer): string; - {$IFDEF COMPILER7_UP} - function GetNameValueSeparator: Char; - function GetValueFromIndex(Index: Integer): string; - {$ENDIF COMPILER7_UP} - function GetQuoteChar: Char; - procedure SetCommaText(const Value: string); - procedure SetDelimitedText(const Value: string); - procedure SetDelimiter(const Value: Char); - {$IFDEF COMPILER7_UP} - procedure SetNameValueSeparator(const Value: Char); - procedure SetValueFromIndex(Index: Integer; const Value: string); - {$ENDIF COMPILER7_UP} - procedure SetQuoteChar(const Value: Char); - // procedure AddStrings(Strings: TStrings); overload; - procedure SetObjects(Index: Integer; const Value: TObject); - // procedure Put(Index: Integer; const S: string); - // procedure SetCapacity(NewCapacity: Integer); - // procedure SetTextStr(const Value: string); - procedure SetValue(const Name, Value: string); - procedure SetCaseSensitive(const Value: Boolean); - procedure SetDuplicates(const Value: TDuplicates); - procedure SetOnChange(const Value: TNotifyEvent); - procedure SetOnChanging(const Value: TNotifyEvent); - procedure SetSorted(const Value: Boolean); - property Count: Integer read GetCount; - property Strings[Index: Integer]: string read Get write Put; default; - property Text: string read GetTextStr write SetTextStr; - property Objects[Index: Integer]: TObject read GetObjects write SetObjects; - property Capacity: Integer read GetCapacity write SetCapacity; - property Values[const Name: string]: string read GetValue write SetValue; - property Duplicates: TDuplicates read GetDuplicates write SetDuplicates; - property Sorted: Boolean read GetSorted write SetSorted; - property CaseSensitive: Boolean read GetCaseSensitive write SetCaseSensitive; - property OnChange: TNotifyEvent read GetOnChange write SetOnChange; - property OnChanging: TNotifyEvent read GetOnChanging write SetOnChanging; - property DelimitedText: string read GetDelimitedText write SetDelimitedText; - property Delimiter: Char read GetDelimiter write SetDelimiter; - property Names[Index: Integer]: string read GetName; - property QuoteChar: Char read GetQuoteChar write SetQuoteChar; - property CommaText: string read GetCommaText write SetCommaText; - {$IFDEF COMPILER7_UP} - property ValueFromIndex[Index: Integer]: string read GetValueFromIndex write SetValueFromIndex; - property NameValueSeparator: Char read GetNameValueSeparator write SetNameValueSeparator; - {$ENDIF COMPILER7_UP} - { New } - function Assign(Source: TPersistent): IJclStringList; reintroduce; - function LoadExeParams: IJclStringList; - function Exists(const S: string): Boolean; - function ExistsName(const S: string): Boolean; - function DeleteBlanks: IJclStringList; - function KeepIntegers: IJclStringList; - function DeleteIntegers: IJclStringList; - function ReleaseInterfaces: IJclStringList; - function FreeObjects(AFreeAndNil: Boolean = False): IJclStringList; - function Clone: IJclStringList; - function Insert(Index: Integer; const S: string): IJclStringList; reintroduce; - function InsertObject(Index: Integer; const S: string; AObject: TObject): IJclStringList; reintroduce; - function Sort(ACompareFunction: TJclStringListSortCompare = nil): IJclStringList; reintroduce; - function SortAsInteger: IJclStringList; - function SortByName: IJclStringList; - function Delete(AIndex: Integer): IJclStringList; reintroduce; overload; - function Delete(const AString: string): IJclStringList; reintroduce; overload; - function Exchange(Index1, Index2: Integer): IJclStringList; reintroduce; - function Add(const A: array of const): IJclStringList; reintroduce; overload; - function AddStrings(const A: array of string): IJclStringList; reintroduce; overload; - function BeginUpdate: IJclStringList; - function EndUpdate: IJclStringList; - function Trim: IJclStringList; - function Join(const ASeparator: string = ''): string; - function Split(const AText, ASeparator: string; AClearBeforeAdd: Boolean = True): IJclStringList; - function ExtractWords(const AText: string; const ADelims: TSetOfAnsiChar = [#0..' ']; AClearBeforeAdd: Boolean = True): IJclStringList; - function Last: string; - function First: string; - function LastIndex: Integer; - function Clear: IJclStringList; reintroduce; - {$IFDEF JCL_PCRE} - function DeleteRegEx(const APattern: string): IJclStringList; - function KeepRegEx(const APattern: string): IJclStringList; - function Files(const APattern: string = '*'; ARecursive: Boolean = False; const ARegExPattern: string = ''): IJclStringList; - function Directories(const APattern: string = '*'; ARecursive: Boolean = False; const ARegExPattern: string = ''): IJclStringList; - {$ENDIF JCL_PCRE} - function GetStringsRef: TStrings; - function ConfigAsSet: IJclStringList; - function Delimit(const ADelimiter: string): IJclStringList; - function GetInterfaceByIndex(Index: Integer): IInterface; - function GetLists(Index: Integer): IJclStringList; - function GetVariants(AIndex: Integer): Variant; - function GetKeyInterface(const AKey: string): IInterface; - function GetKeyObject(const AKey: string): TObject; - function GetKeyVariant(const AKey: string): Variant; - function GetKeyList(const AKey: string): IJclStringList; - function GetObjectsMode: TJclStringListObjectsMode; - procedure SetInterfaceByIndex(Index: Integer; const Value: IInterface); - procedure SetLists(Index: Integer; const Value: IJclStringList); - procedure SetVariants(Index: Integer; const Value: Variant); - procedure SetKeyInterface(const AKey: string; const Value: IInterface); - procedure SetKeyObject(const AKey: string; const Value: TObject); - procedure SetKeyVariant(const AKey: string; const Value: Variant); - procedure SetKeyList(const AKey: string; const Value: IJclStringList); - property Interfaces[Index: Integer]: IInterface read GetInterfaceByIndex write SetInterfaceByIndex; - property Lists[Index: Integer]: IJclStringList read GetLists write SetLists; - property Variants[Index: Integer]: Variant read GetVariants write SetVariants; - property KeyList[const AKey: string]: IJclStringList read GetKeyList write SetKeyList; - property KeyObject[const AKey: string]: TObject read GetKeyObject write SetKeyObject; - property KeyInterface[const AKey: string]: IInterface read GetKeyInterface write SetKeyInterface; - property KeyVariant[const AKey: string]: Variant read GetKeyVariant write SetKeyVariant; - property ObjectsMode: TJclStringListObjectsMode read GetObjectsMode; - end; - -function JclStringList: IJclStringList; overload; -function JclStringListStrings(AStrings: TStrings): IJclStringList; overload; -function JclStringListStrings(const A: array of string): IJclStringList; overload; -function JclStringList(const A: array of const): IJclStringList; overload; -function JclStringList(const AText: string): IJclStringList; overload; - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\common'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -uses - {$IFDEF HAS_UNITSCOPE} - System.TypInfo, - {$ELSE ~HAS_UNITSCOPE} - TypInfo, - {$ENDIF ~HAS_UNITSCOPE} - JclFileUtils, - JclStrings; - -type - TVariantWrapper = class(TObject) - private - FValue: Variant; - end; - - TInterfaceWrapper = class(TObject) - private - FValue: IInterface; - end; - -function JclStringList: IJclStringList; -begin - Result := TJclStringList.Create; -end; - -function JclStringList(const AText: string): IJclStringList; overload; -begin - Result := JclStringList; - Result.Text := AText; -end; - -function JclStringListStrings(AStrings: TStrings): IJclStringList; overload; -begin - Result := JclStringList; - Result.AddStrings(AStrings); -end; - -function JclStringListStrings(const A: array of string): IJclStringList; -begin - Result := JclStringList.AddStrings(A); -end; - -function JclStringList(const A: array of const): IJclStringList; -begin - Result := JclStringList.Add(A); -end; - -//=== { TJclInterfacedStringList } ============================================== - -procedure TJclInterfacedStringList.AfterConstruction; -Var - MyOwner : TPersistent; -begin - inherited; - MyOwner := GetOwner; - if Assigned(MyOwner) then - MyOwner.GetInterface(IUnknown,FOwnerInterface); -end; - - -function TJclInterfacedStringList._AddRef: Integer;stdcall; -begin - if assigned(FOwnerInterface) then - Result := FOwnerInterface._AddRef - else - Result := -1; -end; - - -function TJclInterfacedStringList._Release: Integer;stdcall; -begin - if assigned(FOwnerInterface) then - Result := FOwnerInterface._Release - else - Result := -1; -end; - - -function TJclInterfacedStringList.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult;stdcall; -begin - if GetInterface(IID, Obj) then - Result := 0 - else - Result := E_NOINTERFACE; -end; - -//=== { TJclStringList } ===================================================== - -function TJclStringList.Add(const A: array of const): IJclStringList; -const - BoolToStr: array [Boolean] of string[5] = ('false', 'true'); -var - I: Integer; -begin - Result := BeginUpdate; - try - for I := Low(A) to High(A) do - case A[I].VType of - vtInteger: - Add(IntToStr(A[I].VInteger)); - vtBoolean: - Add(string(BoolToStr[A[I].VBoolean])); - vtChar: - Add(string(AnsiString(A[I].VChar))); - vtExtended: - Add(FloatToStr(A[I].VExtended^)); - vtString: - Add(string(A[I].VString^)); - vtPChar: - Add(string(AnsiString(A[I].VPChar))); - vtPWideChar: - Add(string(WideString(A[I].VPWideChar))); - vtObject: - Add(A[I].VObject.ClassName); - vtClass: - Add(A[I].VClass.ClassName); - vtAnsiString: - Add(string(A[I].VAnsiString)); - vtWideString: - Add(string(A[I].VWideString)); - vtCurrency: - Add(CurrToStr(A[I].VCurrency^)); - vtVariant: - Add(string(A[I].VVariant^)); - vtInt64: - Add(IntToStr(A[I].VInt64^)); - {$IFDEF SUPPORTS_UNICODE_STRING} - vtUnicodeString: - Add(string(A[I].VUnicodeString)); - {$ENDIF SUPPORTS_UNICODE_STRING} - end; - finally - Result := EndUpdate; - end; -end; - -function TJclStringList.AddStrings(const A: array of string): IJclStringList; -var - I: Integer; -begin - Result := BeginUpdate; - try - for I := Low(A) to High(A) do - Add(A[I]); - finally - Result := EndUpdate; - end; -end; - -function TJclStringList.BeginUpdate: IJclStringList; -begin - inherited BeginUpdate; - Result := FSelfAsInterface; -end; - -function TJclStringList.Clear: IJclStringList; -begin - if CanFreeObjects then - FreeObjects(False); - inherited Clear; - Result := FSelfAsInterface; -end; - -function TJclStringList.EndUpdate: IJclStringList; -begin - inherited EndUpdate; - Result := FSelfAsInterface; -end; - -function TJclStringList.ExtractWords(const AText: string; const ADelims: TSetOfAnsiChar; - AClearBeforeAdd: Boolean): IJclStringList; -var - L, I, X: Integer; -begin - Result := BeginUpdate; - try - if AClearBeforeAdd then - Clear; - I := 1; - L := Length(AText); - while I <= L do - begin - while (I <= L) and (AnsiChar(AText[I]) in ADelims) do - Inc(I); - X := I; - while (I <= L) and not (AnsiChar(AText[I]) in ADelims) do - Inc(I); - if X <> I then - Add(Copy(AText, X, I - X)); - end; - finally - Result := EndUpdate; - end; -end; - -function TJclStringList.First: string; -begin - Result := Strings[0]; -end; - -function TJclStringList.Join(const ASeparator: string): string; -var - I: Integer; -begin - Result := ''; - for I := 0 to LastIndex - 1 do - Result := Result + Strings[I] + ASeparator; - if Count > 0 then - Result := Result + Last; -end; - -function TJclStringList.Last: string; -begin - Result := Strings[LastIndex]; -end; - -function TJclStringList.Split(const AText, ASeparator: string; - AClearBeforeAdd: Boolean = True): IJclStringList; -var - LStartIndex, LEndIndex: Integer; - LLengthSeparator: Integer; -begin - Result := FSelfAsInterface; - if AText <> '' then - begin - Result := BeginUpdate; - try - if AClearBeforeAdd then - Clear; - LLengthSeparator := Length(ASeparator); - LStartIndex := 1; - LEndIndex := StrSearch(ASeparator, AText, LStartIndex); - while LEndIndex > 0 do - begin - Add(Copy(AText, LStartIndex, LEndIndex - LStartIndex)); - LStartIndex := LEndIndex + LLengthSeparator; - LEndIndex := StrSearch(ASeparator, AText, LStartIndex); - end; - Add(Copy(AText, LStartIndex, MaxInt)); - finally - Result := EndUpdate; - end; - end; -end; - -function TJclStringList.Trim: IJclStringList; -var - I: Integer; -begin - Result := BeginUpdate; - try - for I := 0 to LastIndex do - Strings[I] := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.Trim(Strings[I]); - finally - Result := EndUpdate; - end; -end; - -function TJclStringList._AddRef: Integer; -begin - Result := InterlockedIncrement(FRefCount); -end; - -function TJclStringList._Release: Integer; -begin - Result := InterlockedDecrement(FRefCount); - if Result = 1 then - begin - // When there is only one reference, it is the internal reference, - // so we release it. The compiler will call _Release again and - // the object will be destroyed. - FSelfAsInterface := nil; - end - else - if Result = 0 then - Destroy; -end; - -{$IFDEF JCL_PCRE} -function TJclStringList.DeleteRegEx(const APattern: string): IJclStringList; -var - I: Integer; -begin - Result := BeginUpdate; - try - for I := LastIndex downto 0 do - if MatchRegEx(Strings[I], APattern) then - Delete(I); - finally - Result := EndUpdate; - end; -end; - -function TJclStringList.KeepRegEx(const APattern: string): IJclStringList; -var - I: Integer; -begin - Result := BeginUpdate; - try - for I := LastIndex downto 0 do - if not MatchRegEx(Strings[I], APattern) then - Delete(I); - finally - Result := EndUpdate; - end; -end; - -function TJclStringList.MatchRegEx(const S, APattern: string): Boolean; -begin - if FRegEx = nil then - FRegEx := TJclRegEx.Create; - if FLastRegExPattern <> APattern then - begin - if CaseSensitive then - FRegEx.Options := FRegEx.Options - [roIgnoreCase] - else - FRegEx.Options := FRegEx.Options + [roIgnoreCase]; - FRegEx.Compile(APattern, False, True); - FLastRegExPattern := APattern; - end; - Result := FRegEx.Match(S); -end; -{$ENDIF JCL_PCRE} - -destructor TJclStringList.Destroy; -begin - if CanFreeObjects then - FreeObjects(False); - {$IFDEF JCL_PCRE} - FreeAndNil(FRegEx); - {$ENDIF JCL_PCRE} - inherited Destroy; -end; - -{$IFDEF JCL_PCRE} -function TJclStringList.Directories(const APattern: string = '*'; - ARecursive: Boolean = False; const ARegExPattern: string = ''): IJclStringList; - - procedure DoDirectories(const APattern: string); - var - LSearchRec: TSearchRec; - LFullName: string; - LPath: string; - begin - LPath := ExtractFilePath(APattern); - if FindFirst(APattern, faAnyFile, LSearchRec) = 0 then - try - repeat - if (LSearchRec.Attr and faDirectory = 0) or - (LSearchRec.Name = '.') or (LSearchRec.Name = '..') then - Continue; - LFullName := LPath + LSearchRec.Name; - if (ARegExPattern = '') or MatchRegEx(LFullName, ARegExPattern) then - Add(LFullName); - if ARecursive then - DoDirectories(PathAddSeparator(LFullName) + ExtractFileName(APattern)); - until FindNext(LSearchRec) <> 0; - finally - FindClose(LSearchRec); - end; - end; - -begin - Result := BeginUpdate; - try - if DirectoryExists(APattern) then - DoDirectories(PathAddSeparator(APattern) + '*') - else - DoDirectories(APattern); - finally - Result := EndUpdate; - end; -end; - -function TJclStringList.Files(const APattern: string = '*'; - ARecursive: Boolean = False; const ARegExPattern: string = ''): IJclStringList; - - procedure DoFiles(const APattern: string); - var - LSearchRec: TSearchRec; - LFullName: string; - LDirectories: IJclStringList; - LPath: string; - I: Integer; - begin - LPath := ExtractFilePath(APattern); - if FindFirst(APattern, faAnyFile and not faDirectory, LSearchRec) = 0 then - begin - try - repeat - if (LSearchRec.Attr and faDirectory <> 0) or - (LSearchRec.Name = '.') or (LSearchRec.Name = '..') then - Continue; - LFullName := LPath + LSearchRec.Name; - if (ARegExPattern = '') or MatchRegEx(LFullName, ARegExPattern) then - Add(LFullName); - until FindNext(LSearchRec) <> 0; - finally - FindClose(LSearchRec); - end; - end; - if ARecursive then - begin - LDirectories := JclStringList.Directories(LPath + '*', False); - for I := 0 to LDirectories.LastIndex do - DoFiles(PathAddSeparator(LDirectories[I]) + ExtractFileName(APattern)); - end; - end; - -begin - Result := BeginUpdate; - try - if DirectoryExists(APattern) then - DoFiles(PathAddSeparator(APattern) + '*') - else - DoFiles(APattern); - finally - Result := EndUpdate; - end; -end; -{$ENDIF JCL_PCRE} - -function TJclStringList.LastIndex: Integer; -begin - { The code bellow is more optimized than "Result := Count - 1". } - Result := Count; - Dec(Result); -end; - -constructor TJclStringList.Create; -begin - inherited Create; - if QueryInterface(IJclStringList, FSelfAsInterface) <> 0 then - System.Error(reIntfCastError); -end; - -function TJclStringList.GetLists(Index: Integer): IJclStringList; -begin - Result := Interfaces[Index] as IJclStringList; - if Result = nil then - begin - Result := JclStringList; - Interfaces[Index] := Result; - end; -end; - -procedure TJclStringList.SetLists(Index: Integer; const Value: IJclStringList); -begin - Interfaces[Index] := Value; -end; - -function TJclStringList.GetStringsRef: TStrings; -begin - Result := Self; -end; - -function TJclStringList.GetKeyInterface(const AKey: string): IInterface; -var - I: Integer; -begin - I := IndexOf(AKey); - if I >= 0 then - Result := Interfaces[I] - else - Result := nil; -end; - -function TJclStringList.GetKeyObject(const AKey: string): TObject; -var - I: Integer; -begin - I := IndexOf(AKey); - if I >= 0 then - Result := Objects[I] - else - Result := nil; -end; - -procedure TJclStringList.SetKeyInterface(const AKey: string; const Value: IInterface); -var - I: Integer; -begin - I := IndexOf(AKey); - if I < 0 then - I := Add(AKey); - Interfaces[I] := Value -end; - -procedure TJclStringList.SetKeyObject(const AKey: string; const Value: TObject); -var - I: Integer; -begin - I := IndexOf(AKey); - if I < 0 then - AddObject(AKey, Value) - else - Objects[I] := Value; -end; - -function TJclStringList.ConfigAsSet: IJclStringList; -begin - Sorted := True; - Duplicates := dupIgnore; - Result := FSelfAsInterface; -end; - -function TJclStringList.GetKeyVariant(const AKey: string): Variant; -var - I: Integer; -begin - I := IndexOf(AKey); - if I >= 0 then - Result := Variants[I] - else - Result := Unassigned; -end; - -procedure TJclStringList.SetKeyVariant(const AKey: string; const Value: Variant); -var - I: Integer; -begin - I := IndexOf(AKey); - if I < 0 then - I := Add(AKey); - Variants[I] := Value -end; - -function TJclStringList.GetValue(const Name: string): string; -begin - Result := inherited Values[Name]; -end; - -procedure TJclStringList.SetValue(const Name, Value: string); -begin - inherited Values[Name] := Value; -end; - -function TJclStringList.GetInterfaceByIndex(Index: Integer): IInterface; -var - V: TInterfaceWrapper; -begin - if FObjectsMode <> omInterfaces then - EnsureObjectsMode(omInterfaces); - V := TInterfaceWrapper(inherited Objects[Index]); - if V = nil then - Result := nil - else - Result := V.FValue; -end; - -procedure TJclStringList.SetInterfaceByIndex(Index: Integer; const Value: IInterface); -var - V: TInterfaceWrapper; -begin - if FObjectsMode <> omInterfaces then - EnsureObjectsMode(omInterfaces); - V := TInterfaceWrapper(inherited Objects[Index]); - if V = nil then - begin - V := TInterfaceWrapper.Create; - inherited Objects[Index] := V; - end; - V.FValue := Value; -end; - -function TJclStringList.GetObjects(Index: Integer): TObject; -begin - if FObjectsMode <> omObjects then - EnsureObjectsMode(omObjects); - Result := inherited Objects[Index]; -end; - -procedure TJclStringList.SetObjects(Index: Integer; const Value: TObject); -begin - if FObjectsMode <> omObjects then - EnsureObjectsMode(omObjects); - inherited Objects[Index] := Value; -end; - -function TJclStringList.GetVariants(AIndex: Integer): Variant; -var - V: TVariantWrapper; -begin - if FObjectsMode <> omVariants then - EnsureObjectsMode(omVariants); - V := TVariantWrapper(inherited Objects[AIndex]); - if V = nil then - Result := Unassigned - else - Result := V.FValue; -end; - -procedure TJclStringList.SetVariants(Index: Integer; const Value: Variant); -var - V: TVariantWrapper; -begin - if FObjectsMode <> omVariants then - EnsureObjectsMode(omVariants); - V := TVariantWrapper(inherited Objects[Index]); - if V = nil then - begin - V := TVariantWrapper.Create; - inherited Objects[Index] := V; - end; - V.FValue := Value; -end; - -procedure TJclStringList.EnsureObjectsMode(AMode: TJclStringListObjectsMode); -begin - if FObjectsMode <> AMode then - begin - if FObjectsMode <> omNone then - begin - raise EJclStringListError.CreateFmt('Objects cannot be used as "%s" because it has been used as "%s".', - [GetEnumName(TypeInfo(TJclStringListObjectsMode), Ord(AMode)), - GetEnumName(TypeInfo(TJclStringListObjectsMode), Ord(FObjectsMode))]); - end; - FObjectsMode := AMode; - end; -end; - -function TJclStringList.GetKeyList(const AKey: string): IJclStringList; -begin - Result := KeyInterface[AKey] as IJclStringList; - if Result = nil then - begin - Result := JclStringList; - KeyInterface[AKey] := Result; - end; -end; - -procedure TJclStringList.SetKeyList(const AKey: string; const Value: IJclStringList); -begin - KeyInterface[AKey] := Value; -end; - -function TJclStringList.Delete(AIndex: Integer): IJclStringList; -begin - if CanFreeObjects then - inherited Objects[AIndex].Free; - inherited Delete(AIndex); - Result := FSelfAsInterface; -end; - -function TJclStringList.Delete(const AString: string): IJclStringList; -begin - Result := Delete(IndexOf(AString)); -end; - -function TJclStringList.Exchange(Index1, Index2: Integer): IJclStringList; -begin - inherited Exchange(Index1, Index2); - Result := FSelfAsInterface; -end; - -function LocalSort(List: TStringList; Index1, Index2: Integer): Integer; -begin - Result := TJclStringList(List).FCompareFunction(TJclStringList(List).FSelfAsInterface, Index1, Index2); -end; - -function TJclStringList.Sort(ACompareFunction: TJclStringListSortCompare = nil): IJclStringList; -begin - FCompareFunction := ACompareFunction; - if not Assigned(ACompareFunction) then - inherited Sort - else - inherited CustomSort(@LocalSort); - Result := FSelfAsInterface; -end; - -function LocalSortAsInteger(List: TStringList; Index1, Index2: Integer): Integer; -begin - Result := StrToInt(List[Index1]) - StrToInt(List[Index2]); -end; - -function TJclStringList.SortAsInteger: IJclStringList; -begin - inherited CustomSort(@LocalSortAsInteger); - Result := FSelfAsInterface; -end; - -{$IFNDEF HAS_TSTRINGS_COMPARESTRINGS} -function TJclStringList.CompareStrings(const S1, S2: string): Integer; -begin - Result := AnsiCompareText(S1, S2); -end; -{$ENDIF ~HAS_TSTRINGS_COMPARESTRINGS} - -function LocalSortByName(List: TStringList; Index1, Index2: Integer): Integer; -begin - Result := TJclStringList(List).CompareStrings(List.Names[Index1], List.Names[Index2]); -end; - -function TJclStringList.SortByName: IJclStringList; -begin - inherited CustomSort(@LocalSortByName); - Result := FSelfAsInterface; -end; - -function TJclStringList.Insert(Index: Integer; const S: string): IJclStringList; -begin - inherited Insert(Index, S); - Result := FSelfAsInterface; -end; - -function TJclStringList.InsertObject(Index: Integer; const S: string; AObject: TObject): IJclStringList; -begin - inherited InsertObject(Index, S, AObject); - Result := FSelfAsInterface; -end; - -function TJclStringList.GetCaseSensitive: Boolean; -begin - Result := inherited CaseSensitive; -end; - -function TJclStringList.GetDuplicates: TDuplicates; -begin - Result := inherited Duplicates; -end; - -function TJclStringList.GetOnChange: TNotifyEvent; -begin - Result := inherited OnChange; -end; - -function TJclStringList.GetOnChanging: TNotifyEvent; -begin - Result := inherited OnChanging; -end; - -function TJclStringList.GetSorted: Boolean; -begin - Result := inherited Sorted; -end; - -procedure TJclStringList.SetCaseSensitive(const Value: Boolean); -begin - inherited CaseSensitive := Value; -end; - -procedure TJclStringList.SetDuplicates(const Value: TDuplicates); -begin - inherited Duplicates := Value; -end; - -procedure TJclStringList.SetOnChange(const Value: TNotifyEvent); -begin - inherited OnChange := Value; -end; - -procedure TJclStringList.SetOnChanging(const Value: TNotifyEvent); -begin - inherited OnChanging := Value; -end; - -procedure TJclStringList.SetSorted(const Value: Boolean); -begin - inherited Sorted := Value; -end; - -function TJclStringList.LoadFromFile(const FileName: string): IJclStringList; -begin - inherited LoadFromFile(FileName); - Result := FSelfAsInterface; -end; - -function TJclStringList.LoadFromStream(Stream: TStream): IJclStringList; -begin - inherited LoadFromStream(Stream); - Result := FSelfAsInterface; -end; - -function TJclStringList.SaveToFile(const FileName: string): IJclStringList; -begin - inherited SaveToFile(FileName); - Result := FSelfAsInterface; -end; - -function TJclStringList.SaveToStream(Stream: TStream): IJclStringList; -begin - inherited SaveToStream(Stream); - Result := FSelfAsInterface; -end; - -function TJclStringList.GetCommaText: string; -begin - Result := inherited CommaText; -end; - -function TJclStringList.GetDelimitedText: string; -begin - Result := inherited DelimitedText; -end; - -function TJclStringList.GetDelimiter: Char; -begin - Result := inherited Delimiter; -end; - -function TJclStringList.GetName(Index: Integer): string; -begin - Result := inherited Names[Index]; -end; - -{$IFDEF COMPILER7_UP} - -function TJclStringList.GetNameValueSeparator: Char; -begin - Result := inherited NameValueSeparator; -end; - -function TJclStringList.GetValueFromIndex(Index: Integer): string; -begin - Result := inherited ValueFromIndex[Index]; -end; - -{$ENDIF COMPILER7_UP} - -function TJclStringList.GetQuoteChar: Char; -begin - Result := inherited QuoteChar; -end; - -procedure TJclStringList.SetCommaText(const Value: string); -begin - inherited CommaText := Value; -end; - -procedure TJclStringList.SetDelimitedText(const Value: string); -begin - inherited DelimitedText := Value; -end; - -procedure TJclStringList.SetDelimiter(const Value: Char); -begin - inherited Delimiter := Value; -end; - -{$IFDEF COMPILER7_UP} - -procedure TJclStringList.SetNameValueSeparator(const Value: Char); -begin - inherited NameValueSeparator := Value; -end; - -procedure TJclStringList.SetValueFromIndex(Index: Integer; const Value: string); -begin - inherited ValueFromIndex[Index] := Value; -end; - -{$ENDIF COMPILER7_UP} - -procedure TJclStringList.SetQuoteChar(const Value: Char); -begin - inherited QuoteChar := Value; -end; - -function TJclStringList.Delimit(const ADelimiter: string): IJclStringList; -var - I: Integer; -begin - Result := BeginUpdate; - try - for I := 0 to LastIndex do - Strings[I] := ADelimiter + Strings[I] + ADelimiter; - finally - Result := EndUpdate; - end; -end; - -function TJclStringList.LoadExeParams: IJclStringList; -var - I: Integer; - S: string; -begin - Result := BeginUpdate; - try - Clear; - for I := 1 to ParamCount do - begin - S := ParamStr(I); - if (S[1] = '-') or (S[1] = '/') then - System.Delete(S, 1, 1); - Add(S); - end; - finally - Result := EndUpdate; - end; -end; - -function TJclStringList.Exists(const S: string): Boolean; -begin - Result := IndexOf(S) >= 0; -end; - -function TJclStringList.ExistsName(const S: string): Boolean; -begin - Result := IndexOfName(S) >= 0; -end; - -function TJclStringList.DeleteBlanks: IJclStringList; -var - I: Integer; -begin - Result := BeginUpdate; - try - for I := LastIndex downto 0 do - if {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.Trim(Strings[I]) = '' then - Delete(I); - finally - Result := EndUpdate; - end; -end; - -function TJclStringList.KeepIntegers: IJclStringList; -var - I, X: Integer; -begin - Result := BeginUpdate; - try - X := 0; - for I := LastIndex downto 0 do - if not TryStrToInt(Strings[I], X) then - Delete(I); - finally - Result := EndUpdate; - end; -end; - -function TJclStringList.DeleteIntegers: IJclStringList; -var - I, X: Integer; -begin - Result := BeginUpdate; - try - X := 0; - for I := LastIndex downto 0 do - if TryStrToInt(Strings[I], X) then - Delete(I); - finally - Result := EndUpdate; - end; -end; - -function TJclStringList.FreeObjects(AFreeAndNil: Boolean = False): IJclStringList; -var - I: Integer; -begin - if AFreeAndNil then - Result := BeginUpdate; - for I := 0 to LastIndex do - begin - inherited Objects[I].Free; - if AFreeAndNil then - inherited Objects[I] := nil; - end; - if AFreeAndNil then - Result := EndUpdate - else - Result := FSelfAsInterface; -end; - -function TJclStringList.ReleaseInterfaces: IJclStringList; -var - I: Integer; -begin - Result := BeginUpdate; - try - for I := 0 to LastIndex do - Interfaces[I] := nil; - finally - Result := EndUpdate; - end; -end; - -function TJclStringList.Clone: IJclStringList; -begin - Result := JclStringList.Assign(Self); -end; - -function TJclStringList.Assign(Source: TPersistent): IJclStringList; -var - L: TJclStringList; - I: Integer; -begin - inherited Assign(Source); - Result := FSelfAsInterface; - if Source is TJclStringList then - begin - L := TJclStringList(Source); - FObjectsMode := L.FObjectsMode; - if not (FObjectsMode in [omNone, omObjects]) then - begin - Result := BeginUpdate; - try - for I := 0 to LastIndex do - begin - inherited Objects[I] := nil; - case FObjectsMode of - omVariants: - Variants[I] := L.Variants[I]; - omInterfaces: - Interfaces[I] := L.Interfaces[I]; - end; - end; - finally - Result := EndUpdate; - end; - end; - end; -end; - -function TJclStringList.CanFreeObjects: Boolean; -begin - Result := not (FObjectsMode in [omNone, omObjects]); -end; - -function TJclStringList.GetObjectsMode: TJclStringListObjectsMode; -begin - Result := FObjectsMode; -end; - -{$IFDEF UNITVERSIONING} -initialization - RegisterUnitVersion(HInstance, UnitVersioning); - -finalization - UnregisterUnitVersion(HInstance); -{$ENDIF UNITVERSIONING} - -end. +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is NewStringListUnit.pas. } +{ } +{ The Initial Developer of the Original Code is Romullo Sousa. } +{ Portions created by Romullo Sousa are Copyright (C) Romullo Sousa. All rights reserved. } +{ } +{ Contributor(s): } +{ Romullo Sousa (romullobr) } +{ Leo Simas (Leh_U) } +{ } +{**************************************************************************************************} +{ } +{ This unit contains several improvements of the standard TStringList. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclStringLists; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Winapi.Windows, + {$ENDIF MSWINDOWS} + System.Variants, + System.Classes, System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + Variants, + Classes, SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, + JclPCRE; + +{$DEFINE HAS_TSTRINGS_COMPARESTRINGS} +{$IFDEF FPC} + {$UNDEF HAS_TSTRINGS_COMPARESTRINGS} +{$ENDIF FPC} + +type + EJclStringListError = class(EJclError); + + IJclStringList = interface; + + TJclStringListObjectsMode = (omNone, omObjects, omVariants, omInterfaces); + + TJclStringListSortCompare = function(List: IJclStringList; Index1, Index2: Integer): Integer; + + IJclStringList = interface(IInterface) + ['{8DC5B71C-4756-404D-8636-7872CD299796}'] + { From TStrings/TStringList } + function Add(const S: string): Integer; overload; + function AddObject(const S: string; AObject: TObject): Integer; + function Get(Index: Integer): string; + function GetCapacity: Integer; + function GetCount: Integer; + function GetObjects(Index: Integer): TObject; + function GetTextStr: string; + function GetValue(const Name: string): string; + {$IFDEF FPC} + function Find(const S: string; out Index: Integer): Boolean; + {$ELSE ~FPC} + function Find(const S: string; var Index: Integer): Boolean; + {$ENDIF ~FPC} + function IndexOf(const S: string): Integer; + function GetCaseSensitive: Boolean; + function GetDuplicates: TDuplicates; + function GetOnChange: TNotifyEvent; + function GetOnChanging: TNotifyEvent; + function GetSorted: Boolean; + function Equals(Strings: TStrings): Boolean; + function IndexOfName(const Name: string): Integer; + function IndexOfObject(AObject: TObject): Integer; + function LoadFromFile(const FileName: string): IJclStringList; + function LoadFromStream(Stream: TStream): IJclStringList; + function SaveToFile(const FileName: string): IJclStringList; + function SaveToStream(Stream: TStream): IJclStringList; + function GetCommaText: string; + function GetDelimitedText: string; + function GetDelimiter: Char; + function GetName(Index: Integer): string; + {$IFDEF COMPILER7_UP} + function GetNameValueSeparator: Char; + function GetValueFromIndex(Index: Integer): string; + {$ENDIF COMPILER7_UP} + function GetQuoteChar: Char; + procedure SetCommaText(const Value: string); + procedure SetDelimitedText(const Value: string); + procedure SetDelimiter(const Value: Char); + {$IFDEF COMPILER7_UP} + procedure SetNameValueSeparator(const Value: Char); + procedure SetValueFromIndex(Index: Integer; const Value: string); + {$ENDIF COMPILER7_UP} + procedure SetQuoteChar(const Value: Char); + procedure AddStrings(Strings: TStrings); overload; + procedure SetObjects(Index: Integer; const Value: TObject); + procedure Put(Index: Integer; const S: string); + procedure SetCapacity(NewCapacity: Integer); + procedure SetTextStr(const Value: string); + procedure SetValue(const Name, Value: string); + procedure SetCaseSensitive(const Value: Boolean); + procedure SetDuplicates(const Value: TDuplicates); + procedure SetOnChange(const Value: TNotifyEvent); + procedure SetOnChanging(const Value: TNotifyEvent); + procedure SetSorted(const Value: Boolean); + property Count: Integer read GetCount; + property Strings[Index: Integer]: string read Get write Put; default; + property Text: string read GetTextStr write SetTextStr; + property Objects[Index: Integer]: TObject read GetObjects write SetObjects; + property Capacity: Integer read GetCapacity write SetCapacity; + property Values[const Name: string]: string read GetValue write SetValue; + property Duplicates: TDuplicates read GetDuplicates write SetDuplicates; + property Sorted: Boolean read GetSorted write SetSorted; + property CaseSensitive: Boolean read GetCaseSensitive write SetCaseSensitive; + property OnChange: TNotifyEvent read GetOnChange write SetOnChange; + property OnChanging: TNotifyEvent read GetOnChanging write SetOnChanging; + property DelimitedText: string read GetDelimitedText write SetDelimitedText; + property Delimiter: Char read GetDelimiter write SetDelimiter; + property Names[Index: Integer]: string read GetName; + property QuoteChar: Char read GetQuoteChar write SetQuoteChar; + property CommaText: string read GetCommaText write SetCommaText; + {$IFDEF COMPILER7_UP} + property ValueFromIndex[Index: Integer]: string read GetValueFromIndex write SetValueFromIndex; + property NameValueSeparator: Char read GetNameValueSeparator write SetNameValueSeparator; + {$ENDIF COMPILER7_UP} + { New } + function Assign(Source: TPersistent): IJclStringList; + function LoadExeParams: IJclStringList; + function Exists(const S: string): Boolean; + function ExistsName(const S: string): Boolean; + function DeleteBlanks: IJclStringList; + function KeepIntegers: IJclStringList; + function DeleteIntegers: IJclStringList; + function ReleaseInterfaces: IJclStringList; + function FreeObjects(AFreeAndNil: Boolean = False): IJclStringList; + function Clone: IJclStringList; + function Insert(Index: Integer; const S: string): IJclStringList; + function InsertObject(Index: Integer; const S: string; AObject: TObject): IJclStringList; + function Sort(ACompareFunction: TJclStringListSortCompare = nil): IJclStringList; + function SortAsInteger: IJclStringList; + function SortByName: IJclStringList; + function Delete(AIndex: Integer): IJclStringList; overload; + function Delete(const AString: string): IJclStringList; overload; + function Exchange(Index1, Index2: Integer): IJclStringList; + function Add(const A: array of const): IJclStringList; overload; + function AddStrings(const A: array of string): IJclStringList; overload; + function BeginUpdate: IJclStringList; + function EndUpdate: IJclStringList; + function Trim: IJclStringList; + function Join(const ASeparator: string = ''): string; + function Split(const AText, ASeparator: string; AClearBeforeAdd: Boolean = True): IJclStringList; + function ExtractWords(const AText: string; const ADelims: TSetOfAnsiChar = [#0..' ']; AClearBeforeAdd: Boolean = True): IJclStringList; + function Last: string; + function First: string; + function LastIndex: Integer; + function Clear: IJclStringList; + {$IFDEF JCL_PCRE} + function DeleteRegEx(const APattern: string): IJclStringList; + function KeepRegEx(const APattern: string): IJclStringList; + function Files(const APattern: string = '*'; ARecursive: Boolean = False; const ARegExPattern: string = ''): IJclStringList; + function Directories(const APattern: string = '*'; ARecursive: Boolean = False; const ARegExPattern: string = ''): IJclStringList; + {$ENDIF JCL_PCRE} + function GetStringsRef: TStrings; + function ConfigAsSet: IJclStringList; + function Delimit(const ADelimiter: string): IJclStringList; + function GetInterfaceByIndex(Index: Integer): IInterface; + function GetLists(Index: Integer): IJclStringList; + function GetVariants(AIndex: Integer): Variant; + function GetKeyInterface(const AKey: string): IInterface; + function GetKeyObject(const AKey: string): TObject; + function GetKeyVariant(const AKey: string): Variant; + function GetKeyList(const AKey: string): IJclStringList; + function GetObjectsMode: TJclStringListObjectsMode; + procedure SetInterfaceByIndex(Index: Integer; const Value: IInterface); + procedure SetLists(Index: Integer; const Value: IJclStringList); + procedure SetVariants(Index: Integer; const Value: Variant); + procedure SetKeyInterface(const AKey: string; const Value: IInterface); + procedure SetKeyObject(const AKey: string; const Value: TObject); + procedure SetKeyVariant(const AKey: string; const Value: Variant); + procedure SetKeyList(const AKey: string; const Value: IJclStringList); + property Interfaces[Index: Integer]: IInterface read GetInterfaceByIndex write SetInterfaceByIndex; + property Lists[Index: Integer]: IJclStringList read GetLists write SetLists; + property Variants[Index: Integer]: Variant read GetVariants write SetVariants; + property KeyList[const AKey: string]: IJclStringList read GetKeyList write SetKeyList; + property KeyObject[const AKey: string]: TObject read GetKeyObject write SetKeyObject; + property KeyInterface[const AKey: string]: IInterface read GetKeyInterface write SetKeyInterface; + property KeyVariant[const AKey: string]: Variant read GetKeyVariant write SetKeyVariant; + property ObjectsMode: TJclStringListObjectsMode read GetObjectsMode; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: TStringsEnumerator; + {$ENDIF SUPPORTS_FOR_IN} + end; + +type + TJclInterfacedStringList = class(TStringList, IInterface) + private + FOwnerInterface: IInterface; + public + { IInterface } + function _AddRef: Integer; stdcall; + function _Release: Integer; stdcall; + function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; stdcall; + procedure AfterConstruction; override; + end; + + + TJclStringList = class(TJclInterfacedStringList, IInterface, IJclStringList) + private + FObjectsMode: TJclStringListObjectsMode; + FSelfAsInterface: IJclStringList; + {$IFDEF JCL_PCRE} + FLastRegExPattern: string; + FRegEx: TJclRegEx; + {$ENDIF JCL_PCRE} + FCompareFunction: TJclStringListSortCompare; + function CanFreeObjects: Boolean; + {$IFDEF JCL_PCRE} + function MatchRegEx(const S, APattern: string): Boolean; + {$ENDIF JCL_PCRE} + procedure EnsureObjectsMode(AMode: TJclStringListObjectsMode); + protected + FRefCount: Integer; + {$IFNDEF HAS_TSTRINGS_COMPARESTRINGS} + function CompareStrings(const S1, S2: string): Integer; virtual; + {$ENDIF ~HAS_TSTRINGS_COMPARESTRINGS} + public + constructor Create; + destructor Destroy; override; + { IInterface } + // function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall; + function _AddRef: Integer; stdcall; + function _Release: Integer; stdcall; + { IJclStringList } + // function Add(const S: string): Integer; overload; + // function AddObject(const S: string; AObject: TObject): Integer; + // function Get(Index: Integer): string; + // function GetCapacity: Integer; + // function GetCount: Integer; + function GetObjects(Index: Integer): TObject; + // function GetTextStr: string; + function GetValue(const Name: string): string; + // function Find(const S: string; var Index: Integer): Boolean; + // function IndexOf(const S: string): Integer; + function GetCaseSensitive: Boolean; + function GetDuplicates: TDuplicates; + function GetOnChange: TNotifyEvent; + function GetOnChanging: TNotifyEvent; + function GetSorted: Boolean; + // function Equals(Strings: TStrings): Boolean; + // function IndexOfName(const Name: string): Integer; + // function IndexOfObject(AObject: TObject): Integer; + function LoadFromFile(const FileName: string): IJclStringList; reintroduce; + function LoadFromStream(Stream: TStream): IJclStringList; reintroduce; + function SaveToFile(const FileName: string): IJclStringList; reintroduce; + function SaveToStream(Stream: TStream): IJclStringList; reintroduce; + function GetCommaText: string; + function GetDelimitedText: string; + function GetDelimiter: Char; + function GetName(Index: Integer): string; + {$IFDEF COMPILER7_UP} + function GetNameValueSeparator: Char; + function GetValueFromIndex(Index: Integer): string; + {$ENDIF COMPILER7_UP} + function GetQuoteChar: Char; + procedure SetCommaText(const Value: string); + procedure SetDelimitedText(const Value: string); + procedure SetDelimiter(const Value: Char); + {$IFDEF COMPILER7_UP} + procedure SetNameValueSeparator(const Value: Char); + procedure SetValueFromIndex(Index: Integer; const Value: string); + {$ENDIF COMPILER7_UP} + procedure SetQuoteChar(const Value: Char); + // procedure AddStrings(Strings: TStrings); overload; + procedure SetObjects(Index: Integer; const Value: TObject); + // procedure Put(Index: Integer; const S: string); + // procedure SetCapacity(NewCapacity: Integer); + // procedure SetTextStr(const Value: string); + procedure SetValue(const Name, Value: string); + procedure SetCaseSensitive(const Value: Boolean); + procedure SetDuplicates(const Value: TDuplicates); + procedure SetOnChange(const Value: TNotifyEvent); + procedure SetOnChanging(const Value: TNotifyEvent); + procedure SetSorted(const Value: Boolean); + property Count: Integer read GetCount; + property Strings[Index: Integer]: string read Get write Put; default; + property Text: string read GetTextStr write SetTextStr; + property Objects[Index: Integer]: TObject read GetObjects write SetObjects; + property Capacity: Integer read GetCapacity write SetCapacity; + property Values[const Name: string]: string read GetValue write SetValue; + property Duplicates: TDuplicates read GetDuplicates write SetDuplicates; + property Sorted: Boolean read GetSorted write SetSorted; + property CaseSensitive: Boolean read GetCaseSensitive write SetCaseSensitive; + property OnChange: TNotifyEvent read GetOnChange write SetOnChange; + property OnChanging: TNotifyEvent read GetOnChanging write SetOnChanging; + property DelimitedText: string read GetDelimitedText write SetDelimitedText; + property Delimiter: Char read GetDelimiter write SetDelimiter; + property Names[Index: Integer]: string read GetName; + property QuoteChar: Char read GetQuoteChar write SetQuoteChar; + property CommaText: string read GetCommaText write SetCommaText; + {$IFDEF COMPILER7_UP} + property ValueFromIndex[Index: Integer]: string read GetValueFromIndex write SetValueFromIndex; + property NameValueSeparator: Char read GetNameValueSeparator write SetNameValueSeparator; + {$ENDIF COMPILER7_UP} + { New } + function Assign(Source: TPersistent): IJclStringList; reintroduce; + function LoadExeParams: IJclStringList; + function Exists(const S: string): Boolean; + function ExistsName(const S: string): Boolean; + function DeleteBlanks: IJclStringList; + function KeepIntegers: IJclStringList; + function DeleteIntegers: IJclStringList; + function ReleaseInterfaces: IJclStringList; + function FreeObjects(AFreeAndNil: Boolean = False): IJclStringList; + function Clone: IJclStringList; + function Insert(Index: Integer; const S: string): IJclStringList; reintroduce; + function InsertObject(Index: Integer; const S: string; AObject: TObject): IJclStringList; reintroduce; + function Sort(ACompareFunction: TJclStringListSortCompare = nil): IJclStringList; reintroduce; + function SortAsInteger: IJclStringList; + function SortByName: IJclStringList; + function Delete(AIndex: Integer): IJclStringList; reintroduce; overload; + function Delete(const AString: string): IJclStringList; reintroduce; overload; + function Exchange(Index1, Index2: Integer): IJclStringList; reintroduce; + function Add(const A: array of const): IJclStringList; reintroduce; overload; + function AddStrings(const A: array of string): IJclStringList; reintroduce; overload; + function BeginUpdate: IJclStringList; + function EndUpdate: IJclStringList; + function Trim: IJclStringList; + function Join(const ASeparator: string = ''): string; + function Split(const AText, ASeparator: string; AClearBeforeAdd: Boolean = True): IJclStringList; + function ExtractWords(const AText: string; const ADelims: TSetOfAnsiChar = [#0..' ']; AClearBeforeAdd: Boolean = True): IJclStringList; + function Last: string; + function First: string; + function LastIndex: Integer; + function Clear: IJclStringList; reintroduce; + {$IFDEF JCL_PCRE} + function DeleteRegEx(const APattern: string): IJclStringList; + function KeepRegEx(const APattern: string): IJclStringList; + function Files(const APattern: string = '*'; ARecursive: Boolean = False; const ARegExPattern: string = ''): IJclStringList; + function Directories(const APattern: string = '*'; ARecursive: Boolean = False; const ARegExPattern: string = ''): IJclStringList; + {$ENDIF JCL_PCRE} + function GetStringsRef: TStrings; + function ConfigAsSet: IJclStringList; + function Delimit(const ADelimiter: string): IJclStringList; + function GetInterfaceByIndex(Index: Integer): IInterface; + function GetLists(Index: Integer): IJclStringList; + function GetVariants(AIndex: Integer): Variant; + function GetKeyInterface(const AKey: string): IInterface; + function GetKeyObject(const AKey: string): TObject; + function GetKeyVariant(const AKey: string): Variant; + function GetKeyList(const AKey: string): IJclStringList; + function GetObjectsMode: TJclStringListObjectsMode; + procedure SetInterfaceByIndex(Index: Integer; const Value: IInterface); + procedure SetLists(Index: Integer; const Value: IJclStringList); + procedure SetVariants(Index: Integer; const Value: Variant); + procedure SetKeyInterface(const AKey: string; const Value: IInterface); + procedure SetKeyObject(const AKey: string; const Value: TObject); + procedure SetKeyVariant(const AKey: string; const Value: Variant); + procedure SetKeyList(const AKey: string; const Value: IJclStringList); + property Interfaces[Index: Integer]: IInterface read GetInterfaceByIndex write SetInterfaceByIndex; + property Lists[Index: Integer]: IJclStringList read GetLists write SetLists; + property Variants[Index: Integer]: Variant read GetVariants write SetVariants; + property KeyList[const AKey: string]: IJclStringList read GetKeyList write SetKeyList; + property KeyObject[const AKey: string]: TObject read GetKeyObject write SetKeyObject; + property KeyInterface[const AKey: string]: IInterface read GetKeyInterface write SetKeyInterface; + property KeyVariant[const AKey: string]: Variant read GetKeyVariant write SetKeyVariant; + property ObjectsMode: TJclStringListObjectsMode read GetObjectsMode; + end; + +function JclStringList: IJclStringList; overload; +function JclStringListStrings(AStrings: TStrings): IJclStringList; overload; +function JclStringListStrings(const A: array of string): IJclStringList; overload; +function JclStringList(const A: array of const): IJclStringList; overload; +function JclStringList(const AText: string): IJclStringList; overload; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.TypInfo, + {$ELSE ~HAS_UNITSCOPE} + TypInfo, + {$ENDIF ~HAS_UNITSCOPE} + JclFileUtils, + JclStrings; + +type + TVariantWrapper = class(TObject) + private + FValue: Variant; + end; + + TInterfaceWrapper = class(TObject) + private + FValue: IInterface; + end; + +function JclStringList: IJclStringList; +begin + Result := TJclStringList.Create; +end; + +function JclStringList(const AText: string): IJclStringList; overload; +begin + Result := JclStringList; + Result.Text := AText; +end; + +function JclStringListStrings(AStrings: TStrings): IJclStringList; overload; +begin + Result := JclStringList; + Result.AddStrings(AStrings); +end; + +function JclStringListStrings(const A: array of string): IJclStringList; +begin + Result := JclStringList.AddStrings(A); +end; + +function JclStringList(const A: array of const): IJclStringList; +begin + Result := JclStringList.Add(A); +end; + +//=== { TJclInterfacedStringList } ============================================== + +procedure TJclInterfacedStringList.AfterConstruction; +Var + MyOwner : TPersistent; +begin + inherited; + MyOwner := GetOwner; + if Assigned(MyOwner) then + MyOwner.GetInterface(IUnknown,FOwnerInterface); +end; + + +function TJclInterfacedStringList._AddRef: Integer;stdcall; +begin + if assigned(FOwnerInterface) then + Result := FOwnerInterface._AddRef + else + Result := -1; +end; + + +function TJclInterfacedStringList._Release: Integer;stdcall; +begin + if assigned(FOwnerInterface) then + Result := FOwnerInterface._Release + else + Result := -1; +end; + + +function TJclInterfacedStringList.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult;stdcall; +begin + if GetInterface(IID, Obj) then + Result := 0 + else + Result := E_NOINTERFACE; +end; + +//=== { TJclStringList } ===================================================== + +function TJclStringList.Add(const A: array of const): IJclStringList; +const + BoolToStr: array [Boolean] of string[5] = ('false', 'true'); +var + I: Integer; +begin + Result := BeginUpdate; + try + for I := Low(A) to High(A) do + case A[I].VType of + vtInteger: + Add(IntToStr(A[I].VInteger)); + vtBoolean: + Add(string(BoolToStr[A[I].VBoolean])); + vtChar: + Add(string(AnsiString(A[I].VChar))); + vtExtended: + Add(FloatToStr(A[I].VExtended^)); + vtString: + Add(string(A[I].VString^)); + vtPChar: + Add(string(AnsiString(A[I].VPChar))); + vtPWideChar: + Add(string(WideString(A[I].VPWideChar))); + vtObject: + Add(A[I].VObject.ClassName); + vtClass: + Add(A[I].VClass.ClassName); + vtAnsiString: + Add(string(A[I].VAnsiString)); + vtWideString: + Add(string(A[I].VWideString)); + vtCurrency: + Add(CurrToStr(A[I].VCurrency^)); + vtVariant: + Add(string(A[I].VVariant^)); + vtInt64: + Add(IntToStr(A[I].VInt64^)); + {$IFDEF SUPPORTS_UNICODE_STRING} + vtUnicodeString: + Add(string(A[I].VUnicodeString)); + {$ENDIF SUPPORTS_UNICODE_STRING} + end; + finally + Result := EndUpdate; + end; +end; + +function TJclStringList.AddStrings(const A: array of string): IJclStringList; +var + I: Integer; +begin + Result := BeginUpdate; + try + for I := Low(A) to High(A) do + Add(A[I]); + finally + Result := EndUpdate; + end; +end; + +function TJclStringList.BeginUpdate: IJclStringList; +begin + inherited BeginUpdate; + Result := FSelfAsInterface; +end; + +function TJclStringList.Clear: IJclStringList; +begin + if CanFreeObjects then + FreeObjects(False); + inherited Clear; + Result := FSelfAsInterface; +end; + +function TJclStringList.EndUpdate: IJclStringList; +begin + inherited EndUpdate; + Result := FSelfAsInterface; +end; + +function TJclStringList.ExtractWords(const AText: string; const ADelims: TSetOfAnsiChar; + AClearBeforeAdd: Boolean): IJclStringList; +var + L, I, X: Integer; +begin + Result := BeginUpdate; + try + if AClearBeforeAdd then + Clear; + I := 1; + L := Length(AText); + while I <= L do + begin + while (I <= L) and (AnsiChar(AText[I]) in ADelims) do + Inc(I); + X := I; + while (I <= L) and not (AnsiChar(AText[I]) in ADelims) do + Inc(I); + if X <> I then + Add(Copy(AText, X, I - X)); + end; + finally + Result := EndUpdate; + end; +end; + +function TJclStringList.First: string; +begin + Result := Strings[0]; +end; + +function TJclStringList.Join(const ASeparator: string): string; +var + I: Integer; +begin + Result := ''; + for I := 0 to LastIndex - 1 do + Result := Result + Strings[I] + ASeparator; + if Count > 0 then + Result := Result + Last; +end; + +function TJclStringList.Last: string; +begin + Result := Strings[LastIndex]; +end; + +function TJclStringList.Split(const AText, ASeparator: string; + AClearBeforeAdd: Boolean = True): IJclStringList; +var + LStartIndex, LEndIndex: Integer; + LLengthSeparator: Integer; +begin + Result := FSelfAsInterface; + if AText <> '' then + begin + Result := BeginUpdate; + try + if AClearBeforeAdd then + Clear; + LLengthSeparator := Length(ASeparator); + LStartIndex := 1; + LEndIndex := StrSearch(ASeparator, AText, LStartIndex); + while LEndIndex > 0 do + begin + Add(Copy(AText, LStartIndex, LEndIndex - LStartIndex)); + LStartIndex := LEndIndex + LLengthSeparator; + LEndIndex := StrSearch(ASeparator, AText, LStartIndex); + end; + Add(Copy(AText, LStartIndex, MaxInt)); + finally + Result := EndUpdate; + end; + end; +end; + +function TJclStringList.Trim: IJclStringList; +var + I: Integer; +begin + Result := BeginUpdate; + try + for I := 0 to LastIndex do + Strings[I] := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.Trim(Strings[I]); + finally + Result := EndUpdate; + end; +end; + +function TJclStringList._AddRef: Integer; +begin + Result := InterlockedIncrement(FRefCount); +end; + +function TJclStringList._Release: Integer; +begin + Result := InterlockedDecrement(FRefCount); + if Result = 1 then + begin + // When there is only one reference, it is the internal reference, + // so we release it. The compiler will call _Release again and + // the object will be destroyed. + FSelfAsInterface := nil; + end + else + if Result = 0 then + Destroy; +end; + +{$IFDEF JCL_PCRE} +function TJclStringList.DeleteRegEx(const APattern: string): IJclStringList; +var + I: Integer; +begin + Result := BeginUpdate; + try + for I := LastIndex downto 0 do + if MatchRegEx(Strings[I], APattern) then + Delete(I); + finally + Result := EndUpdate; + end; +end; + +function TJclStringList.KeepRegEx(const APattern: string): IJclStringList; +var + I: Integer; +begin + Result := BeginUpdate; + try + for I := LastIndex downto 0 do + if not MatchRegEx(Strings[I], APattern) then + Delete(I); + finally + Result := EndUpdate; + end; +end; + +function TJclStringList.MatchRegEx(const S, APattern: string): Boolean; +begin + if FRegEx = nil then + FRegEx := TJclRegEx.Create; + if FLastRegExPattern <> APattern then + begin + if CaseSensitive then + FRegEx.Options := FRegEx.Options - [roIgnoreCase] + else + FRegEx.Options := FRegEx.Options + [roIgnoreCase]; + FRegEx.Compile(APattern, False, True); + FLastRegExPattern := APattern; + end; + Result := FRegEx.Match(S); +end; +{$ENDIF JCL_PCRE} + +destructor TJclStringList.Destroy; +begin + if CanFreeObjects then + FreeObjects(False); + {$IFDEF JCL_PCRE} + FreeAndNil(FRegEx); + {$ENDIF JCL_PCRE} + inherited Destroy; +end; + +{$IFDEF JCL_PCRE} +function TJclStringList.Directories(const APattern: string = '*'; + ARecursive: Boolean = False; const ARegExPattern: string = ''): IJclStringList; + + procedure DoDirectories(const APattern: string); + var + LSearchRec: TSearchRec; + LFullName: string; + LPath: string; + begin + LPath := ExtractFilePath(APattern); + if FindFirst(APattern, faAnyFile, LSearchRec) = 0 then + try + repeat + if (LSearchRec.Attr and faDirectory = 0) or + (LSearchRec.Name = '.') or (LSearchRec.Name = '..') then + Continue; + LFullName := LPath + LSearchRec.Name; + if (ARegExPattern = '') or MatchRegEx(LFullName, ARegExPattern) then + Add(LFullName); + if ARecursive then + DoDirectories(PathAddSeparator(LFullName) + ExtractFileName(APattern)); + until FindNext(LSearchRec) <> 0; + finally + FindClose(LSearchRec); + end; + end; + +begin + Result := BeginUpdate; + try + if DirectoryExists(APattern) then + DoDirectories(PathAddSeparator(APattern) + '*') + else + DoDirectories(APattern); + finally + Result := EndUpdate; + end; +end; + +function TJclStringList.Files(const APattern: string = '*'; + ARecursive: Boolean = False; const ARegExPattern: string = ''): IJclStringList; + + procedure DoFiles(const APattern: string); + var + LSearchRec: TSearchRec; + LFullName: string; + LDirectories: IJclStringList; + LPath: string; + I: Integer; + begin + LPath := ExtractFilePath(APattern); + if FindFirst(APattern, faAnyFile and not faDirectory, LSearchRec) = 0 then + begin + try + repeat + if (LSearchRec.Attr and faDirectory <> 0) or + (LSearchRec.Name = '.') or (LSearchRec.Name = '..') then + Continue; + LFullName := LPath + LSearchRec.Name; + if (ARegExPattern = '') or MatchRegEx(LFullName, ARegExPattern) then + Add(LFullName); + until FindNext(LSearchRec) <> 0; + finally + FindClose(LSearchRec); + end; + end; + if ARecursive then + begin + LDirectories := JclStringList.Directories(LPath + '*', False); + for I := 0 to LDirectories.LastIndex do + DoFiles(PathAddSeparator(LDirectories[I]) + ExtractFileName(APattern)); + end; + end; + +begin + Result := BeginUpdate; + try + if DirectoryExists(APattern) then + DoFiles(PathAddSeparator(APattern) + '*') + else + DoFiles(APattern); + finally + Result := EndUpdate; + end; +end; +{$ENDIF JCL_PCRE} + +function TJclStringList.LastIndex: Integer; +begin + { The code bellow is more optimized than "Result := Count - 1". } + Result := Count; + Dec(Result); +end; + +constructor TJclStringList.Create; +begin + inherited Create; + if QueryInterface(IJclStringList, FSelfAsInterface) <> 0 then + System.Error(reIntfCastError); +end; + +function TJclStringList.GetLists(Index: Integer): IJclStringList; +begin + Result := Interfaces[Index] as IJclStringList; + if Result = nil then + begin + Result := JclStringList; + Interfaces[Index] := Result; + end; +end; + +procedure TJclStringList.SetLists(Index: Integer; const Value: IJclStringList); +begin + Interfaces[Index] := Value; +end; + +function TJclStringList.GetStringsRef: TStrings; +begin + Result := Self; +end; + +function TJclStringList.GetKeyInterface(const AKey: string): IInterface; +var + I: Integer; +begin + I := IndexOf(AKey); + if I >= 0 then + Result := Interfaces[I] + else + Result := nil; +end; + +function TJclStringList.GetKeyObject(const AKey: string): TObject; +var + I: Integer; +begin + I := IndexOf(AKey); + if I >= 0 then + Result := Objects[I] + else + Result := nil; +end; + +procedure TJclStringList.SetKeyInterface(const AKey: string; const Value: IInterface); +var + I: Integer; +begin + I := IndexOf(AKey); + if I < 0 then + I := Add(AKey); + Interfaces[I] := Value +end; + +procedure TJclStringList.SetKeyObject(const AKey: string; const Value: TObject); +var + I: Integer; +begin + I := IndexOf(AKey); + if I < 0 then + AddObject(AKey, Value) + else + Objects[I] := Value; +end; + +function TJclStringList.ConfigAsSet: IJclStringList; +begin + Sorted := True; + Duplicates := dupIgnore; + Result := FSelfAsInterface; +end; + +function TJclStringList.GetKeyVariant(const AKey: string): Variant; +var + I: Integer; +begin + I := IndexOf(AKey); + if I >= 0 then + Result := Variants[I] + else + Result := Unassigned; +end; + +procedure TJclStringList.SetKeyVariant(const AKey: string; const Value: Variant); +var + I: Integer; +begin + I := IndexOf(AKey); + if I < 0 then + I := Add(AKey); + Variants[I] := Value +end; + +function TJclStringList.GetValue(const Name: string): string; +begin + Result := inherited Values[Name]; +end; + +procedure TJclStringList.SetValue(const Name, Value: string); +begin + inherited Values[Name] := Value; +end; + +function TJclStringList.GetInterfaceByIndex(Index: Integer): IInterface; +var + V: TInterfaceWrapper; +begin + if FObjectsMode <> omInterfaces then + EnsureObjectsMode(omInterfaces); + V := TInterfaceWrapper(inherited Objects[Index]); + if V = nil then + Result := nil + else + Result := V.FValue; +end; + +procedure TJclStringList.SetInterfaceByIndex(Index: Integer; const Value: IInterface); +var + V: TInterfaceWrapper; +begin + if FObjectsMode <> omInterfaces then + EnsureObjectsMode(omInterfaces); + V := TInterfaceWrapper(inherited Objects[Index]); + if V = nil then + begin + V := TInterfaceWrapper.Create; + inherited Objects[Index] := V; + end; + V.FValue := Value; +end; + +function TJclStringList.GetObjects(Index: Integer): TObject; +begin + if FObjectsMode <> omObjects then + EnsureObjectsMode(omObjects); + Result := inherited Objects[Index]; +end; + +procedure TJclStringList.SetObjects(Index: Integer; const Value: TObject); +begin + if FObjectsMode <> omObjects then + EnsureObjectsMode(omObjects); + inherited Objects[Index] := Value; +end; + +function TJclStringList.GetVariants(AIndex: Integer): Variant; +var + V: TVariantWrapper; +begin + if FObjectsMode <> omVariants then + EnsureObjectsMode(omVariants); + V := TVariantWrapper(inherited Objects[AIndex]); + if V = nil then + Result := Unassigned + else + Result := V.FValue; +end; + +procedure TJclStringList.SetVariants(Index: Integer; const Value: Variant); +var + V: TVariantWrapper; +begin + if FObjectsMode <> omVariants then + EnsureObjectsMode(omVariants); + V := TVariantWrapper(inherited Objects[Index]); + if V = nil then + begin + V := TVariantWrapper.Create; + inherited Objects[Index] := V; + end; + V.FValue := Value; +end; + +procedure TJclStringList.EnsureObjectsMode(AMode: TJclStringListObjectsMode); +begin + if FObjectsMode <> AMode then + begin + if FObjectsMode <> omNone then + begin + raise EJclStringListError.CreateFmt('Objects cannot be used as "%s" because it has been used as "%s".', + [GetEnumName(TypeInfo(TJclStringListObjectsMode), Ord(AMode)), + GetEnumName(TypeInfo(TJclStringListObjectsMode), Ord(FObjectsMode))]); + end; + FObjectsMode := AMode; + end; +end; + +function TJclStringList.GetKeyList(const AKey: string): IJclStringList; +begin + Result := KeyInterface[AKey] as IJclStringList; + if Result = nil then + begin + Result := JclStringList; + KeyInterface[AKey] := Result; + end; +end; + +procedure TJclStringList.SetKeyList(const AKey: string; const Value: IJclStringList); +begin + KeyInterface[AKey] := Value; +end; + +function TJclStringList.Delete(AIndex: Integer): IJclStringList; +begin + if CanFreeObjects then + inherited Objects[AIndex].Free; + inherited Delete(AIndex); + Result := FSelfAsInterface; +end; + +function TJclStringList.Delete(const AString: string): IJclStringList; +begin + Result := Delete(IndexOf(AString)); +end; + +function TJclStringList.Exchange(Index1, Index2: Integer): IJclStringList; +begin + inherited Exchange(Index1, Index2); + Result := FSelfAsInterface; +end; + +function LocalSort(List: TStringList; Index1, Index2: Integer): Integer; +begin + Result := TJclStringList(List).FCompareFunction(TJclStringList(List).FSelfAsInterface, Index1, Index2); +end; + +function TJclStringList.Sort(ACompareFunction: TJclStringListSortCompare = nil): IJclStringList; +begin + FCompareFunction := ACompareFunction; + if not Assigned(ACompareFunction) then + inherited Sort + else + inherited CustomSort(@LocalSort); + Result := FSelfAsInterface; +end; + +function LocalSortAsInteger(List: TStringList; Index1, Index2: Integer): Integer; +begin + Result := StrToInt(List[Index1]) - StrToInt(List[Index2]); +end; + +function TJclStringList.SortAsInteger: IJclStringList; +begin + inherited CustomSort(@LocalSortAsInteger); + Result := FSelfAsInterface; +end; + +{$IFNDEF HAS_TSTRINGS_COMPARESTRINGS} +function TJclStringList.CompareStrings(const S1, S2: string): Integer; +begin + Result := AnsiCompareText(S1, S2); +end; +{$ENDIF ~HAS_TSTRINGS_COMPARESTRINGS} + +function LocalSortByName(List: TStringList; Index1, Index2: Integer): Integer; +begin + Result := TJclStringList(List).CompareStrings(List.Names[Index1], List.Names[Index2]); +end; + +function TJclStringList.SortByName: IJclStringList; +begin + inherited CustomSort(@LocalSortByName); + Result := FSelfAsInterface; +end; + +function TJclStringList.Insert(Index: Integer; const S: string): IJclStringList; +begin + inherited Insert(Index, S); + Result := FSelfAsInterface; +end; + +function TJclStringList.InsertObject(Index: Integer; const S: string; AObject: TObject): IJclStringList; +begin + inherited InsertObject(Index, S, AObject); + Result := FSelfAsInterface; +end; + +function TJclStringList.GetCaseSensitive: Boolean; +begin + Result := inherited CaseSensitive; +end; + +function TJclStringList.GetDuplicates: TDuplicates; +begin + Result := inherited Duplicates; +end; + +function TJclStringList.GetOnChange: TNotifyEvent; +begin + Result := inherited OnChange; +end; + +function TJclStringList.GetOnChanging: TNotifyEvent; +begin + Result := inherited OnChanging; +end; + +function TJclStringList.GetSorted: Boolean; +begin + Result := inherited Sorted; +end; + +procedure TJclStringList.SetCaseSensitive(const Value: Boolean); +begin + inherited CaseSensitive := Value; +end; + +procedure TJclStringList.SetDuplicates(const Value: TDuplicates); +begin + inherited Duplicates := Value; +end; + +procedure TJclStringList.SetOnChange(const Value: TNotifyEvent); +begin + inherited OnChange := Value; +end; + +procedure TJclStringList.SetOnChanging(const Value: TNotifyEvent); +begin + inherited OnChanging := Value; +end; + +procedure TJclStringList.SetSorted(const Value: Boolean); +begin + inherited Sorted := Value; +end; + +function TJclStringList.LoadFromFile(const FileName: string): IJclStringList; +begin + inherited LoadFromFile(FileName); + Result := FSelfAsInterface; +end; + +function TJclStringList.LoadFromStream(Stream: TStream): IJclStringList; +begin + inherited LoadFromStream(Stream); + Result := FSelfAsInterface; +end; + +function TJclStringList.SaveToFile(const FileName: string): IJclStringList; +begin + inherited SaveToFile(FileName); + Result := FSelfAsInterface; +end; + +function TJclStringList.SaveToStream(Stream: TStream): IJclStringList; +begin + inherited SaveToStream(Stream); + Result := FSelfAsInterface; +end; + +function TJclStringList.GetCommaText: string; +begin + Result := inherited CommaText; +end; + +function TJclStringList.GetDelimitedText: string; +begin + Result := inherited DelimitedText; +end; + +function TJclStringList.GetDelimiter: Char; +begin + Result := inherited Delimiter; +end; + +function TJclStringList.GetName(Index: Integer): string; +begin + Result := inherited Names[Index]; +end; + +{$IFDEF COMPILER7_UP} + +function TJclStringList.GetNameValueSeparator: Char; +begin + Result := inherited NameValueSeparator; +end; + +function TJclStringList.GetValueFromIndex(Index: Integer): string; +begin + Result := inherited ValueFromIndex[Index]; +end; + +{$ENDIF COMPILER7_UP} + +function TJclStringList.GetQuoteChar: Char; +begin + Result := inherited QuoteChar; +end; + +procedure TJclStringList.SetCommaText(const Value: string); +begin + inherited CommaText := Value; +end; + +procedure TJclStringList.SetDelimitedText(const Value: string); +begin + inherited DelimitedText := Value; +end; + +procedure TJclStringList.SetDelimiter(const Value: Char); +begin + inherited Delimiter := Value; +end; + +{$IFDEF COMPILER7_UP} + +procedure TJclStringList.SetNameValueSeparator(const Value: Char); +begin + inherited NameValueSeparator := Value; +end; + +procedure TJclStringList.SetValueFromIndex(Index: Integer; const Value: string); +begin + inherited ValueFromIndex[Index] := Value; +end; + +{$ENDIF COMPILER7_UP} + +procedure TJclStringList.SetQuoteChar(const Value: Char); +begin + inherited QuoteChar := Value; +end; + +function TJclStringList.Delimit(const ADelimiter: string): IJclStringList; +var + I: Integer; +begin + Result := BeginUpdate; + try + for I := 0 to LastIndex do + Strings[I] := ADelimiter + Strings[I] + ADelimiter; + finally + Result := EndUpdate; + end; +end; + +function TJclStringList.LoadExeParams: IJclStringList; +var + I: Integer; + S: string; +begin + Result := BeginUpdate; + try + Clear; + for I := 1 to ParamCount do + begin + S := ParamStr(I); + if (S[1] = '-') or (S[1] = '/') then + System.Delete(S, 1, 1); + Add(S); + end; + finally + Result := EndUpdate; + end; +end; + +function TJclStringList.Exists(const S: string): Boolean; +begin + Result := IndexOf(S) >= 0; +end; + +function TJclStringList.ExistsName(const S: string): Boolean; +begin + Result := IndexOfName(S) >= 0; +end; + +function TJclStringList.DeleteBlanks: IJclStringList; +var + I: Integer; +begin + Result := BeginUpdate; + try + for I := LastIndex downto 0 do + if {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.Trim(Strings[I]) = '' then + Delete(I); + finally + Result := EndUpdate; + end; +end; + +function TJclStringList.KeepIntegers: IJclStringList; +var + I, X: Integer; +begin + Result := BeginUpdate; + try + X := 0; + for I := LastIndex downto 0 do + if not TryStrToInt(Strings[I], X) then + Delete(I); + finally + Result := EndUpdate; + end; +end; + +function TJclStringList.DeleteIntegers: IJclStringList; +var + I, X: Integer; +begin + Result := BeginUpdate; + try + X := 0; + for I := LastIndex downto 0 do + if TryStrToInt(Strings[I], X) then + Delete(I); + finally + Result := EndUpdate; + end; +end; + +function TJclStringList.FreeObjects(AFreeAndNil: Boolean = False): IJclStringList; +var + I: Integer; +begin + if AFreeAndNil then + Result := BeginUpdate; + for I := 0 to LastIndex do + begin + inherited Objects[I].Free; + if AFreeAndNil then + inherited Objects[I] := nil; + end; + if AFreeAndNil then + Result := EndUpdate + else + Result := FSelfAsInterface; +end; + +function TJclStringList.ReleaseInterfaces: IJclStringList; +var + I: Integer; +begin + Result := BeginUpdate; + try + for I := 0 to LastIndex do + Interfaces[I] := nil; + finally + Result := EndUpdate; + end; +end; + +function TJclStringList.Clone: IJclStringList; +begin + Result := JclStringList.Assign(Self); +end; + +function TJclStringList.Assign(Source: TPersistent): IJclStringList; +var + L: TJclStringList; + I: Integer; +begin + inherited Assign(Source); + Result := FSelfAsInterface; + if Source is TJclStringList then + begin + L := TJclStringList(Source); + FObjectsMode := L.FObjectsMode; + if not (FObjectsMode in [omNone, omObjects]) then + begin + Result := BeginUpdate; + try + for I := 0 to LastIndex do + begin + inherited Objects[I] := nil; + case FObjectsMode of + omVariants: + Variants[I] := L.Variants[I]; + omInterfaces: + Interfaces[I] := L.Interfaces[I]; + end; + end; + finally + Result := EndUpdate; + end; + end; + end; +end; + +function TJclStringList.CanFreeObjects: Boolean; +begin + Result := not (FObjectsMode in [omNone, omObjects]); +end; + +function TJclStringList.GetObjectsMode: TJclStringListObjectsMode; +begin + Result := FObjectsMode; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclStrings.pas b/3rdParty/JCL/source/common/JclStrings.pas index 4fbf9e5e..44fcb254 100644 --- a/3rdParty/JCL/source/common/JclStrings.pas +++ b/3rdParty/JCL/source/common/JclStrings.pas @@ -1,5418 +1,5418 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is JclStrings.pas. } -{ } -{ The Initial Developer of the Original Code is Marcel van Brakel. } -{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. All rights reserved. } -{ } -{ Contributor(s): } -{ Alexander Radchenko } -{ Andreas Hausladen (ahuser) } -{ Anthony Steele } -{ Azret Botash } -{ Barry Kelly } -{ Huanlin Tsai } -{ Jack N.A. Bakker } -{ Jean-Fabien Connault (cycocrew) } -{ John C Molyneux } -{ Kiriakos Vlahos } -{ Leonard Wennekers } -{ Marcel Bestebroer } -{ Martin Kimmings } -{ Martin Kubecka } -{ Massimo Maria Ghisalberti } -{ Matthias Thoma (mthoma) } -{ Michael Winter } -{ Nick Hodges } -{ Olivier Sannier (obones) } -{ Pelle F. S. Liljendal } -{ Petr Vones (pvones) } -{ Rik Barker (rikbarker) } -{ Robert Lee } -{ Robert Marquardt (marquardt) } -{ Robert Rossmair (rrossmair) } -{ Andreas Schmidt } -{ Sean Farrow (sfarrow) } -{ } -{**************************************************************************************************} -{ } -{ Various character and string routines (searching, testing and transforming) } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -unit JclStrings; - -{$I jcl.inc} - -interface - -uses - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - {$IFDEF HAS_UNITSCOPE} - {$IFDEF MSWINDOWS} - Winapi.Windows, - {$ENDIF MSWINDOWS} - {$IFDEF UNICODE_RTL_DATABASE} - System.Character, - {$ENDIF UNICODE_RTL_DATABASE} - System.Classes, System.SysUtils, - {$ELSE ~HAS_UNITSCOPE} - {$IFDEF MSWINDOWS} - Windows, - {$ENDIF MSWINDOWS} - {$IFDEF UNICODE_RTL_DATABASE} - Character, - {$ENDIF UNICODE_RTL_DATABASE} - Classes, SysUtils, - {$ENDIF ~HAS_UNITSCOPE} - JclAnsiStrings, - JclWideStrings, - JclBase; - -// Exceptions -type - EJclStringError = class(EJclError); - -// Character constants and sets - -const - // Misc. often used character definitions - NativeNull = Char(#0); - NativeSoh = Char(#1); - NativeStx = Char(#2); - NativeEtx = Char(#3); - NativeEot = Char(#4); - NativeEnq = Char(#5); - NativeAck = Char(#6); - NativeBell = Char(#7); - NativeBackspace = Char(#8); - NativeTab = Char(#9); - NativeLineFeed = JclBase.NativeLineFeed; - NativeVerticalTab = Char(#11); - NativeFormFeed = Char(#12); - NativeCarriageReturn = JclBase.NativeCarriageReturn; - NativeCrLf = JclBase.NativeCrLf; - NativeSo = Char(#14); - NativeSi = Char(#15); - NativeDle = Char(#16); - NativeDc1 = Char(#17); - NativeDc2 = Char(#18); - NativeDc3 = Char(#19); - NativeDc4 = Char(#20); - NativeNak = Char(#21); - NativeSyn = Char(#22); - NativeEtb = Char(#23); - NativeCan = Char(#24); - NativeEm = Char(#25); - NativeEndOfFile = Char(#26); - NativeEscape = Char(#27); - NativeFs = Char(#28); - NativeGs = Char(#29); - NativeRs = Char(#30); - NativeUs = Char(#31); - NativeSpace = Char(' '); - NativeComma = Char(','); - NativeBackslash = Char('\'); - NativeForwardSlash = Char('/'); - - NativeDoubleQuote = Char('"'); - NativeSingleQuote = Char(''''); - - NativeLineBreak = JclBase.NativeLineBreak; - -const - // CharType return values - C1_UPPER = $0001; // Uppercase - C1_LOWER = $0002; // Lowercase - C1_DIGIT = $0004; // Decimal digits - C1_SPACE = $0008; // Space characters - C1_PUNCT = $0010; // Punctuation - C1_CNTRL = $0020; // Control characters - C1_BLANK = $0040; // Blank characters - C1_XDIGIT = $0080; // Hexadecimal digits - C1_ALPHA = $0100; // Any linguistic character: alphabetic, syllabary, or ideographic - - {$IFDEF MSWINDOWS} - {$IFDEF SUPPORTS_EXTSYM} - {$EXTERNALSYM C1_UPPER} - {$EXTERNALSYM C1_LOWER} - {$EXTERNALSYM C1_DIGIT} - {$EXTERNALSYM C1_SPACE} - {$EXTERNALSYM C1_PUNCT} - {$EXTERNALSYM C1_CNTRL} - {$EXTERNALSYM C1_BLANK} - {$EXTERNALSYM C1_XDIGIT} - {$EXTERNALSYM C1_ALPHA} - {$ENDIF SUPPORTS_EXTSYM} - {$ENDIF MSWINDOWS} - -type - TCharValidator = function(const C: Char): Boolean; - -function ArrayContainsChar(const Chars: array of Char; const C: Char): Boolean; overload; -function ArrayContainsChar(const Chars: array of Char; const C: Char; out Index: SizeInt): Boolean; overload; - -// String Test Routines -function StrIsAlpha(const S: string): Boolean; -function StrIsAlphaNum(const S: string): Boolean; -function StrIsAlphaNumUnderscore(const S: string): Boolean; -function StrContainsChars(const S: string; const Chars: TCharValidator; CheckAll: Boolean): Boolean; overload; -function StrContainsChars(const S: string; const Chars: array of Char; CheckAll: Boolean): Boolean; overload; -function StrConsistsOfNumberChars(const S: string): Boolean; -function StrIsDigit(const S: string): Boolean; -function StrIsSubset(const S: string; const ValidChars: TCharValidator): Boolean; overload; -function StrIsSubset(const S: string; const ValidChars: array of Char): Boolean; overload; -function StrSame(const S1, S2: string; CaseSensitive: Boolean = False): Boolean; - -// String Transformation Routines -function StrCenter(const S: string; L: SizeInt; C: Char = ' '): string; -function StrCharPosLower(const S: string; CharPos: SizeInt): string; -function StrCharPosUpper(const S: string; CharPos: SizeInt): string; -function StrDoubleQuote(const S: string): string; -function StrEnsureNoPrefix(const Prefix, Text: string): string; -function StrEnsureNoSuffix(const Suffix, Text: string): string; -function StrEnsurePrefix(const Prefix, Text: string): string; -function StrEnsureSuffix(const Suffix, Text: string): string; -function StrEscapedToString(const S: string): string; -function StrLower(const S: string): string; -procedure StrLowerInPlace(var S: string); -procedure StrLowerBuff(S: PChar); -procedure StrMove(var Dest: string; const Source: string; const ToIndex, - FromIndex, Count: SizeInt); -function StrPadLeft(const S: string; Len: SizeInt; C: Char = NativeSpace): string; -function StrPadRight(const S: string; Len: SizeInt; C: Char = NativeSpace): string; -function StrProper(const S: string): string; -procedure StrProperBuff(S: PChar); -function StrQuote(const S: string; C: Char): string; -function StrRemoveChars(const S: string; const Chars: TCharValidator): string; overload; -function StrRemoveChars(const S: string; const Chars: array of Char): string; overload; -function StrRemoveLeadingChars(const S: string; const Chars: TCharValidator): string; overload; -function StrRemoveLeadingChars(const S: string; const Chars: array of Char): string; overload; -function StrRemoveEndChars(const S: string; const Chars: TCharValidator): string; overload; -function StrRemoveEndChars(const S: string; const Chars: array of Char): string; overload; -function StrKeepChars(const S: string; const Chars: TCharValidator): string; overload; -function StrKeepChars(const S: string; const Chars: array of Char): string; overload; -procedure StrReplace(var S: string; const Search, Replace: string; Flags: TReplaceFlags = []); -function StrReplaceChar(const S: string; const Source, Replace: Char): string; -function StrReplaceChars(const S: string; const Chars: TCharValidator; Replace: Char): string; overload; -function StrReplaceChars(const S: string; const Chars: array of Char; Replace: Char): string; overload; -function StrReplaceButChars(const S: string; const Chars: TCharValidator; Replace: Char): string; overload; -function StrReplaceButChars(const S: string; const Chars: array of Char; Replace: Char): string; overload; -function StrRepeat(const S: string; Count: SizeInt): string; -function StrRepeatLength(const S: string; L: SizeInt): string; -function StrReverse(const S: string): string; -procedure StrReverseInPlace(var S: string); -function StrSingleQuote(const S: string): string; -procedure StrSkipChars(var S: PChar; const Chars: TCharValidator); overload; -procedure StrSkipChars(var S: PChar; const Chars: array of Char); overload; -procedure StrSkipChars(const S: string; var Index: SizeInt; const Chars: TCharValidator); overload; -procedure StrSkipChars(const S: string; var Index: SizeInt; const Chars: array of Char); overload; -function StrSmartCase(const S: string; const Delimiters: TCharValidator): string; overload; -function StrSmartCase(const S: string; const Delimiters: array of Char): string; overload; -function StrStringToEscaped(const S: string): string; -function StrStripNonNumberChars(const S: string): string; -function StrToHex(const Source: string): string; -function StrTrimCharLeft(const S: string; C: Char): string; -function StrTrimCharsLeft(const S: string; const Chars: TCharValidator): string; overload; -function StrTrimCharsLeft(const S: string; const Chars: array of Char): string; overload; -function StrTrimCharRight(const S: string; C: Char): string; -function StrTrimCharsRight(const S: string; const Chars: TCharValidator): string; overload; -function StrTrimCharsRight(const S: string; const Chars: array of Char): string; overload; -function StrTrimQuotes(const S: string): string; -function StrUpper(const S: string): string; -procedure StrUpperInPlace(var S: string); -procedure StrUpperBuff(S: PChar); - -// String Management -procedure StrAddRef(var S: string); -procedure StrDecRef(var S: string); -function StrLength(const S: string): SizeInt; -function StrRefCount(const S: string): SizeInt; - -// String Search and Replace Routines -function StrCharCount(const S: string; C: Char): SizeInt; overload; -function StrCharsCount(const S: string; const Chars: TCharValidator): SizeInt; overload; -function StrCharsCount(const S: string; const Chars: array of Char): SizeInt; overload; -function StrStrCount(const S, SubS: string): SizeInt; -function StrCompare(const S1, S2: string; CaseSensitive: Boolean = False): SizeInt; -function StrCompareRange(const S1, S2: string; Index, Count: SizeInt; CaseSensitive: Boolean = True): SizeInt; -function StrCompareRangeEx(const S1, S2: string; Index, Count: SizeInt; CaseSensitive: Boolean): SizeInt; -procedure StrFillChar(var S; Count: SizeInt; C: Char); -function StrRepeatChar(C: Char; Count: SizeInt): string; -function StrFind(const Substr, S: string; const Index: SizeInt = 1): SizeInt; -function StrHasPrefix(const S: string; const Prefixes: array of string): Boolean; -function StrHasSuffix(const S: string; const Suffixes: array of string): Boolean; -function StrIndex(const S: string; const List: array of string; CaseSensitive: Boolean = False): SizeInt; -function StrIHasPrefix(const S: string; const Prefixes: array of string): Boolean; -function StrIHasSuffix(const S: string; const Suffixes: array of string): Boolean; -function StrILastPos(const SubStr, S: string): SizeInt; -function StrIPos(const SubStr, S: string): SizeInt; -function StrIPrefixIndex(const S: string; const Prefixes: array of string): SizeInt; -function StrIsOneOf(const S: string; const List: array of string): Boolean; -function StrISuffixIndex(const S: string; const Suffixes: array of string): SizeInt; -function StrLastPos(const SubStr, S: string): SizeInt; -function StrMatch(const Substr, S: string; Index: SizeInt = 1): SizeInt; -function StrMatches(const Substr, S: string; const Index: SizeInt = 1): Boolean; -function StrNIPos(const S, SubStr: string; N: SizeInt): SizeInt; -function StrNPos(const S, SubStr: string; N: SizeInt): SizeInt; -function StrPrefixIndex(const S: string; const Prefixes: array of string): SizeInt; -function StrSearch(const Substr, S: string; const Index: SizeInt = 1): SizeInt; -function StrSuffixIndex(const S: string; const Suffixes: array of string): SizeInt; - -// String Extraction -/// Returns the string after SubStr -function StrAfter(const SubStr, S: string): string; -/// Returns the String before SubStr -function StrBefore(const SubStr, S: string): string; -/// Splits a string at SubStr, returns true when SubStr is found, Left contains the -/// string before the SubStr and Right the string behind SubStr -function StrSplit(const SubStr, S: string;var Left, Right : string): boolean; -/// Returns the string between Start and Stop -function StrBetween(const S: string; const Start, Stop: Char): string; -/// Returns all but rightmost N characters of the string -function StrChopRight(const S: string; N: SizeInt): string;{$IFDEF SUPPORTS_INLINE} {$IFDEF COMPILER16_UP} inline; {$ENDIF} {$ENDIF} -/// Returns the left Count characters of the string -function StrLeft(const S: string; Count: SizeInt): string; {$IFDEF SUPPORTS_INLINE} {$IFDEF COMPILER16_UP} inline; {$ENDIF} {$ENDIF} -/// Returns the string starting from position Start for the Count Characters -function StrMid(const S: string; Start, Count: SizeInt): string; {$IFDEF SUPPORTS_INLINE} {$IFDEF COMPILER16_UP} inline; {$ENDIF} {$ENDIF} -/// Returns the string starting from position N to the end -function StrRestOf(const S: string; N: SizeInt): string;{$IFDEF SUPPORTS_INLINE} {$IFDEF COMPILER16_UP} inline; {$ENDIF} {$ENDIF} -/// Returns the right Count characters of the string -function StrRight(const S: string; Count: SizeInt): string;{$IFDEF SUPPORTS_INLINE} {$IFDEF COMPILER16_UP} inline; {$ENDIF} {$ENDIF} - -// Character Test Routines -function CharEqualNoCase(const C1, C2: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsAlpha(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsAlphaNum(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsBlank(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsControl(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsDelete(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsDigit(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsFracDigit(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsHexDigit(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsLower(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsNumberChar(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} {$IFDEF COMPILER16_UP} inline; {$ENDIF} {$ENDIF} -function CharIsNumber(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} {$IFDEF COMPILER16_UP} inline; {$ENDIF} {$ENDIF} -function CharIsPrintable(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsPunctuation(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsReturn(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsSpace(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsUpper(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsValidIdentifierLetter(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsWhiteSpace(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharIsWildcard(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharType(const C: Char): Word; - -// Character Transformation Routines -function CharHex(const C: Char): Byte; -function CharLower(const C: Char): Char; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharUpper(const C: Char): Char; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function CharToggleCase(const C: Char): Char; - -// Character Search and Replace -function CharPos(const S: string; const C: Char; const Index: SizeInt = 1): SizeInt; -function CharLastPos(const S: string; const C: Char; const Index: SizeInt = 1): SizeInt; -function CharIPos(const S: string; C: Char; const Index: SizeInt = 1): SizeInt; -function CharReplace(var S: string; const Search, Replace: Char): SizeInt; - -// PCharVector -type - PCharVector = ^PChar; - -function StringsToPCharVector(var Dest: PCharVector; const Source: TStrings): PCharVector; -function PCharVectorCount(Source: PCharVector): SizeInt; -procedure PCharVectorToStrings(const Dest: TStrings; Source: PCharVector); -procedure FreePCharVector(var Dest: PCharVector); - -// MultiSz Routines -type - PMultiSz = PChar; - PAnsiMultiSz = JclAnsiStrings.PAnsiMultiSz; - PWideMultiSz = JclWideStrings.PWideMultiSz; - - TAnsiStrings = JclAnsiStrings.TJclAnsiStrings; - TWideStrings = JclWideStrings.TJclWideStrings; - TAnsiStringList = JclAnsiStrings.TJclAnsiStringList; - TWideStringList = JclWideStrings.TJclWideStringList; - -function StringsToMultiSz(var Dest: PMultiSz; const Source: TStrings): PMultiSz; -procedure MultiSzToStrings(const Dest: TStrings; const Source: PMultiSz); -function MultiSzLength(const Source: PMultiSz): SizeInt; -procedure AllocateMultiSz(var Dest: PMultiSz; Len: SizeInt); -procedure FreeMultiSz(var Dest: PMultiSz); -function MultiSzDup(const Source: PMultiSz): PMultiSz; - -function AnsiStringsToAnsiMultiSz(var Dest: PAnsiMultiSz; const Source: TAnsiStrings): PAnsiMultiSz; - {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -procedure AnsiMultiSzToAnsiStrings(const Dest: TAnsiStrings; const Source: PAnsiMultiSz); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function AnsiMultiSzLength(const Source: PAnsiMultiSz): SizeInt; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -procedure AllocateAnsiMultiSz(var Dest: PAnsiMultiSz; Len: SizeInt); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -procedure FreeAnsiMultiSz(var Dest: PAnsiMultiSz); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function AnsiMultiSzDup(const Source: PAnsiMultiSz): PAnsiMultiSz; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} - -function WideStringsToWideMultiSz(var Dest: PWideMultiSz; const Source: TWideStrings): PWideMultiSz; - {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -procedure WideMultiSzToWideStrings(const Dest: TWideStrings; const Source: PWideMultiSz); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function WideMultiSzLength(const Source: PWideMultiSz): SizeInt; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -procedure AllocateWideMultiSz(var Dest: PWideMultiSz; Len: SizeInt); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -procedure FreeWideMultiSz(var Dest: PWideMultiSz); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} -function WideMultiSzDup(const Source: PWideMultiSz): PWideMultiSz; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} - -// TStrings Manipulation -procedure StrIToStrings(S, Sep: string; const List: TStrings; const AllowEmptyString: Boolean = True); -procedure StrToStrings(S, Sep: string; const List: TStrings; const AllowEmptyString: Boolean = True); -function StringsToStr(const List: TStrings; const Sep: string; const AllowEmptyString: Boolean = True): string; overload; -function StringsToStr(const List: TStrings; const Sep: string; const NumberOfItems: SizeInt; const AllowEmptyString: - Boolean = True): string; overload; -procedure TrimStrings(const List: TStrings; DeleteIfEmpty: Boolean = True); -procedure TrimStringsRight(const List: TStrings; DeleteIfEmpty: Boolean = True); -procedure TrimStringsLeft(const List: TStrings; DeleteIfEmpty: Boolean = True); -function AddStringToStrings(const S: string; Strings: TStrings; const Unique: Boolean): Boolean; - -// Miscellaneous -// (OF) moved to JclSysUtils -// function BooleanToStr(B: Boolean): string; - // AnsiString here because it is binary data -function FileToString(const FileName: string): {$IFDEF COMPILER12_UP}RawByteString{$ELSE}AnsiString{$ENDIF}; -procedure StringToFile(const FileName: string; const Contents: {$IFDEF COMPILER12_UP}RawByteString{$ELSE}AnsiString{$ENDIF}; - Append: Boolean = False); - -function StrToken(var S: string; Separator: Char): string; -procedure StrTokens(const S: string; const List: TStrings); -procedure StrTokenToStrings(S: string; Separator: Char; const List: TStrings); -function StrWord(const S: string; var Index: SizeInt; out Word: string): Boolean; overload; -function StrWord(var S: PChar; out Word: string): Boolean; overload; -function StrIdent(const S: string; var Index: SizeInt; out Ident: string): Boolean; overload; -function StrIdent(var S: PChar; out Ident: string): Boolean; overload; -function StrToFloatSafe(const S: string): Float; -function StrToIntSafe(const S: string): Integer; -procedure StrNormIndex(const StrLen: SizeInt; var Index: SizeInt; var Count: SizeInt); overload; - -function ArrayOf(List: TStrings): TDynStringArray; overload; - -type - FormatException = class(EJclError); - ArgumentException = class(EJclError); - ArgumentNullException = class(EJclError); - ArgumentOutOfRangeException = class(EJclError); - - IToString = interface - ['{C4ABABB4-1029-46E7-B5FA-99800F130C05}'] - function ToString: string; - end; - - TCharDynArray = array of Char; - - // The TStringBuilder class is a Delphi implementation of the .NET - // System.Text.StringBuilder. - // It is zero based and the methods that have a TObject argument (Append, Insert, - // AppendFormat) are limited to IToString implementors or Delphi 2009+ RTL. - // This class is not threadsafe. Any instance of TStringBuilder should not - // be used in different threads at the same time. - TJclStringBuilder = class(TInterfacedObject, IToString) - private - FChars: TCharDynArray; - FLength: SizeInt; - FMaxCapacity: SizeInt; - - function GetCapacity: SizeInt; - procedure SetCapacity(const Value: SizeInt); - function GetChars(Index: SizeInt): Char; - procedure SetChars(Index: SizeInt; const Value: Char); - procedure Set_Length(const Value: SizeInt); - protected - function AppendPChar(Value: PChar; Count: SizeInt; RepeatCount: SizeInt = 1): TJclStringBuilder; - function InsertPChar(Index: SizeInt; Value: PChar; Count: SizeInt; RepeatCount: SizeInt = 1): TJclStringBuilder; - public - constructor Create(const Value: string; Capacity: SizeInt = 16); overload; - constructor Create(Capacity: SizeInt = 16; MaxCapacity: SizeInt = MaxInt); overload; - constructor Create(const Value: string; StartIndex, Length, Capacity: SizeInt); overload; - - function Append(const Value: string): TJclStringBuilder; overload; - function Append(const Value: string; StartIndex, Length: SizeInt): TJclStringBuilder; overload; - function Append(Value: Boolean): TJclStringBuilder; overload; - function Append(Value: Char; RepeatCount: SizeInt = 1): TJclStringBuilder; overload; - function Append(const Value: array of Char): TJclStringBuilder; overload; - function Append(const Value: array of Char; StartIndex, Length: SizeInt): TJclStringBuilder; overload; - function Append(Value: Cardinal): TJclStringBuilder; overload; - function Append(Value: Integer): TJclStringBuilder; overload; - function Append(Value: Double): TJclStringBuilder; overload; - function Append(Value: Int64): TJclStringBuilder; overload; - function Append(Obj: TObject): TJclStringBuilder; overload; - function AppendFormat(const Fmt: string; const Args: array of const): TJclStringBuilder; overload; - function AppendFormat(const Fmt: string; Arg0: Variant): TJclStringBuilder; overload; - function AppendFormat(const Fmt: string; Arg0, Arg1: Variant): TJclStringBuilder; overload; - function AppendFormat(const Fmt: string; Arg0, Arg1, Arg2: Variant): TJclStringBuilder; overload; - - function Insert(Index: SizeInt; const Value: string; Count: SizeInt = 1): TJclStringBuilder; overload; - function Insert(Index: SizeInt; Value: Boolean): TJclStringBuilder; overload; - function Insert(Index: SizeInt; const Value: array of Char): TJclStringBuilder; overload; - function Insert(Index: SizeInt; const Value: array of Char; StartIndex, Length: SizeInt): TJclStringBuilder; - overload; - function Insert(Index: SizeInt; Value: Cardinal): TJclStringBuilder; overload; - function Insert(Index: SizeInt; Value: Integer): TJclStringBuilder; overload; - function Insert(Index: SizeInt; Value: Double): TJclStringBuilder; overload; - function Insert(Index: SizeInt; Value: Int64): TJclStringBuilder; overload; - function Insert(Index: SizeInt; Obj: TObject): TJclStringBuilder; overload; - - function Replace(OldChar, NewChar: Char; StartIndex: SizeInt = 0; Count: SizeInt = -1): TJclStringBuilder; - overload; - function Replace(OldValue, NewValue: string; StartIndex: SizeInt = 0; Count: SizeInt = -1): TJclStringBuilder; - overload; - - function Remove(StartIndex, Length: SizeInt): TJclStringBuilder; - function EnsureCapacity(Capacity: SizeInt): SizeInt; - procedure Clear; - - { IToString } - function ToString: string; {$IFDEF RTL200_UP} override; {$ENDIF RTL200_UP} - - property __Chars__[Index: SizeInt]: Char read GetChars write SetChars; default; - property Chars: TCharDynArray read FChars; - property Length: SizeInt read FLength write Set_Length; - property Capacity: SizeInt read GetCapacity write SetCapacity; - property MaxCapacity: SizeInt read FMaxCapacity; - end; - - {$IFDEF RTL200_UP} - TStringBuilder = {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.TStringBuilder; - {$ELSE ~RTL200_UP} - TStringBuilder = TJclStringBuilder; - {$ENDIF ~RTL200_UP} - -// DotNetFormat() uses the .NET format style: "{argX}" -function DotNetFormat(const Fmt: string; const Args: array of const): string; overload; -function DotNetFormat(const Fmt: string; const Arg0: Variant): string; overload; -function DotNetFormat(const Fmt: string; const Arg0, Arg1: Variant): string; overload; -function DotNetFormat(const Fmt: string; const Arg0, Arg1, Arg2: Variant): string; overload; - -// TJclTabSet -type - TJclTabSet = class (TInterfacedObject, IToString) - private - FData: TObject; - function GetCount: SizeInt; - function GetStops(Index: SizeInt): SizeInt; - function GetTabWidth: SizeInt; - function GetZeroBased: Boolean; - procedure SetStops(Index, Value: SizeInt); - procedure SetTabWidth(Value: SizeInt); - procedure SetZeroBased(Value: Boolean); - protected - function FindStop(Column: SizeInt): SizeInt; - function InternalTabStops: TDynSizeIntArray; - function InternalTabWidth: SizeInt; - procedure RemoveAt(Index: SizeInt); - public - constructor Create; overload; - constructor Create(Data: TObject); overload; - constructor Create(TabWidth: SizeInt); overload; - constructor Create(const Tabstops: array of SizeInt; ZeroBased: Boolean); overload; - constructor Create(const Tabstops: array of SizeInt; ZeroBased: Boolean; TabWidth: SizeInt); overload; - destructor Destroy; override; - - // cloning and referencing - function Clone: TJclTabSet; - function NewReference: TJclTabSet; - - // Tab stops manipulation - function Add(Column: SizeInt): SizeInt; - function Delete(Column: SizeInt): SizeInt; - - // Usage - function Expand(const S: string): string; overload; - function Expand(const S: string; Column: SizeInt): string; overload; - procedure OptimalFillInfo(StartColumn, TargetColumn: SizeInt; out TabsNeeded, SpacesNeeded: SizeInt); - function Optimize(const S: string): string; overload; - function Optimize(const S: string; Column: SizeInt): string; overload; - function StartColumn: SizeInt; - function TabFrom(Column: SizeInt): SizeInt; - function UpdatePosition(const S: string): SizeInt; overload; - function UpdatePosition(const S: string; Column: SizeInt): SizeInt; overload; - function UpdatePosition(const S: string; var Column, Line: SizeInt): SizeInt; overload; - - { IToString } - function ToString: string; overload; {$IFDEF RTL200_UP} override; {$ENDIF RTL200_UP} - // Conversions - function ToString(FormattingOptions: SizeInt): string; {$IFDEF RTL200_UP} reintroduce; {$ENDIF RTL200_UP} overload; - class function FromString(const S: string): TJclTabSet; {$IFDEF SUPPORTS_STATIC} static; {$ENDIF SUPPORTS_STATIC} - - // Properties - property ActualTabWidth: SizeInt read InternalTabWidth; - property Count: SizeInt read GetCount; - property TabStops[Index: SizeInt]: SizeInt read GetStops write SetStops; default; - property TabWidth: SizeInt read GetTabWidth write SetTabWidth; - property ZeroBased: Boolean read GetZeroBased write SetZeroBased; - end; - -// Formatting constants -const - TabSetFormatting_SurroundStopsWithBrackets = 1; - TabSetFormatting_EmptyBracketsIfNoStops = 2; - TabSetFormatting_NoTabStops = 4; - TabSetFormatting_NoTabWidth = 8; - TabSetFormatting_AutoTabWidth = 16; - // common combinations - TabSetFormatting_Default = 0; - TabSetFormatting_AlwaysUseBrackets = TabSetFormatting_SurroundStopsWithBrackets or - TabSetFormatting_EmptyBracketsIfNoStops; - TabSetFormatting_Full = TabSetFormatting_AlwaysUseBrackets or TabSetFormatting_AutoTabWidth; - // aliases - TabSetFormatting_StopsOnly = TabSetFormatting_NoTabWidth; - TabSetFormatting_TabWidthOnly = TabSetFormatting_NoTabStops; - TabSetFormatting_StopsWithoutBracketsAndTabWidth = TabSetFormatting_Default; - -// Tab expansion routines -function StrExpandTabs(S: string): string; {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF} overload; -function StrExpandTabs(S: string; TabWidth: SizeInt): string; {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF} overload; -function StrExpandTabs(S: string; TabSet: TJclTabSet): string; {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF} overload; -// Tab optimization routines -function StrOptimizeTabs(S: string): string; {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF} overload; -function StrOptimizeTabs(S: string; TabWidth: SizeInt): string; {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF} overload; -function StrOptimizeTabs(S: string; TabSet: TJclTabSet): string; {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF} overload; - -// move to JclBase? -type - NullReferenceException = class(EJclError) - public - constructor Create; overload; - end; - -procedure StrResetLength(var S: WideString); overload; -procedure StrResetLength(var S: AnsiString); overload; -procedure StrResetLength(S: TJclStringBuilder); overload; -{$IFDEF SUPPORTS_UNICODE_STRING} -procedure StrResetLength(var S: UnicodeString); overload; -{$ENDIF SUPPORTS_UNICODE_STRING} - -// natural comparison functions -function CompareNaturalStr(const S1, S2: string): SizeInt; -function CompareNaturalText(const S1, S2: string): SizeInt; - -{$IFNDEF UNICODE_RTL_DATABASE} -// internal structures published to make function inlining working -const - MaxStrCharCount = Ord(High(Char)) + 1; // # of chars in one set - StrLoOffset = MaxStrCharCount * 0; // offset to lower case chars - StrUpOffset = MaxStrCharCount * 1; // offset to upper case chars - StrReOffset = MaxStrCharCount * 2; // offset to reverse case chars - StrCaseMapSize = MaxStrCharCount * 3; // # of chars is a table - -var - StrCaseMap: array [0..StrCaseMapSize - 1] of Char; // case mappings - StrCaseMapReady: Boolean = False; // true if case map exists - StrCharTypes: array [Char] of Word; -{$ENDIF ~UNICODE_RTL_DATABASE} - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\common'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -uses - {$IFDEF HAS_UNIT_LIBC} - Libc, - {$ENDIF HAS_UNIT_LIBC} - {$IFDEF SUPPORTS_UNICODE} - {$IFDEF HAS_UNITSCOPE} - System.StrUtils, - {$ELSE ~HAS_UNITSCOPE} - StrUtils, - {$ENDIF ~HAS_UNITSCOPE} - {$ENDIF SUPPORTS_UNICODE} - JclLogic, JclResources, JclStreams, JclSynch, JclSysUtils; - -//=== Internal =============================================================== - -type - TStrRec = packed record - RefCount: Integer; - Length: Integer; - end; - PStrRec = ^TStrRec; - -{$IFNDEF UNICODE_RTL_DATABASE} -procedure LoadCharTypes; -var - CurrChar: Char; - CurrType: Word; -begin - for CurrChar := Low(CurrChar) to High(CurrChar) do - begin - {$IFDEF MSWINDOWS} - CurrType := 0; - GetStringTypeEx(LOCALE_USER_DEFAULT, CT_CTYPE1, @CurrChar, 1, CurrType); - {$DEFINE CHAR_TYPES_INITIALIZED} - {$ENDIF MSWINDOWS} - {$IFDEF LINUX} - CurrType := 0; - if isupper(Byte(CurrChar)) <> 0 then - CurrType := CurrType or C1_UPPER; - if islower(Byte(CurrChar)) <> 0 then - CurrType := CurrType or C1_LOWER; - if isdigit(Byte(CurrChar)) <> 0 then - CurrType := CurrType or C1_DIGIT; - if isspace(Byte(CurrChar)) <> 0 then - CurrType := CurrType or C1_SPACE; - if ispunct(Byte(CurrChar)) <> 0 then - CurrType := CurrType or C1_PUNCT; - if iscntrl(Byte(CurrChar)) <> 0 then - CurrType := CurrType or C1_CNTRL; - if isblank(Byte(CurrChar)) <> 0 then - CurrType := CurrType or C1_BLANK; - if isxdigit(Byte(CurrChar)) <> 0 then - CurrType := CurrType or C1_XDIGIT; - if isalpha(Byte(CurrChar)) <> 0 then - CurrType := CurrType or C1_ALPHA; - {$DEFINE CHAR_TYPES_INITIALIZED} - {$ENDIF LINUX} - StrCharTypes[CurrChar] := CurrType; - {$IFNDEF CHAR_TYPES_INITIALIZED} - Implement case map initialization here - {$ENDIF ~CHAR_TYPES_INITIALIZED} - end; -end; - -procedure LoadCaseMap; -var - CurrChar, UpCaseChar, LoCaseChar, ReCaseChar: Char; -begin - if not StrCaseMapReady then - begin - for CurrChar := Low(Char) to High(Char) do - begin - {$IFDEF MSWINDOWS} - LoCaseChar := CurrChar; - UpCaseChar := CurrChar; - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CharLowerBuff(@LoCaseChar, 1); - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CharUpperBuff(@UpCaseChar, 1); - {$DEFINE CASE_MAP_INITIALIZED} - {$ENDIF MSWINDOWS} - {$IFDEF LINUX} - LoCaseChar := Char(tolower(Byte(CurrChar))); - UpCaseChar := Char(toupper(Byte(CurrChar))); - {$DEFINE CASE_MAP_INITIALIZED} - {$ENDIF LINUX} - {$IFNDEF CASE_MAP_INITIALIZED} - Implement case map initialization here - {$ENDIF ~CASE_MAP_INITIALIZED} - if CharIsUpper(CurrChar) then - ReCaseChar := LoCaseChar - else - if CharIsLower(CurrChar) then - ReCaseChar := UpCaseChar - else - ReCaseChar := CurrChar; - StrCaseMap[Ord(CurrChar) + StrLoOffset] := LoCaseChar; - StrCaseMap[Ord(CurrChar) + StrUpOffset] := UpCaseChar; - StrCaseMap[Ord(CurrChar) + StrReOffset] := ReCaseChar; - end; - StrCaseMapReady := True; - end; -end; - -// Uppercases or Lowercases a give string depending on the -// passed offset. (UpOffset or LoOffset) - -procedure StrCase(var Str: string; const Offset: SizeInt); -var - P: PChar; - I, L: SizeInt; -begin - L := Length(Str); - if L > 0 then - begin - UniqueString(Str); - P := PChar(Str); - for I := 1 to L do - begin - P^ := StrCaseMap[Offset + Ord(P^)]; - Inc(P); - end; - end; -end; - -// Internal utility function -// Uppercases or Lowercases a give null terminated string depending on the -// passed offset. (UpOffset or LoOffset) - -procedure StrCaseBuff(S: PChar; const Offset: SizeInt); -var - C: Char; -begin - if S <> nil then - begin - repeat - C := S^; - S^ := StrCaseMap[Offset + Ord(C)]; - Inc(S); - until C = #0; - end; -end; -{$ENDIF ~UNICODE_RTL_DATABASE} - -function StrEndW(Str: PWideChar): PWideChar; -begin - Result := Str; - while Result^ <> #0 do - Inc(Result); -end; - -function ArrayContainsChar(const Chars: array of Char; const C: Char): Boolean; -var - idx: SizeInt; -begin - Result := ArrayContainsChar(Chars, C, idx); -end; - -function ArrayContainsChar(const Chars: array of Char; const C: Char; out Index: SizeInt): Boolean; -{ optimized version for sorted arrays -var - I, L, H: SizeInt; -begin - L := Low(Chars); - H := High(Chars); - while L <= H do - begin - I := (L + H) div 2; - if C = Chars[I] then - begin - Result := True; - Exit; - end - else - if C < Chars[I] then - H := I - 1 - else - // C > Chars[I] - L := I + 1; - end; - Result := False; -end;} -begin - Index := High(Chars); - while (Index >= Low(Chars)) and (Chars[Index] <> C) do - Dec(Index); - Result := Index >= Low(Chars); -end; - -// String Test Routines -function StrIsAlpha(const S: string): Boolean; -var - I: SizeInt; -begin - Result := S <> ''; - for I := 1 to Length(S) do - begin - if not CharIsAlpha(S[I]) then - begin - Result := False; - Exit; - end; - end; -end; - -function StrIsAlphaNum(const S: string): Boolean; -var - I: SizeInt; -begin - Result := S <> ''; - for I := 1 to Length(S) do - begin - if not CharIsAlphaNum(S[I]) then - begin - Result := False; - Exit; - end; - end; -end; - -function StrConsistsofNumberChars(const S: string): Boolean; -var - I: SizeInt; -begin - Result := S <> ''; - for I := 1 to Length(S) do - begin - if not CharIsNumberChar(S[I]) then - begin - Result := False; - Exit; - end; - end; -end; - -function StrContainsChars(const S: string; const Chars: TCharValidator; CheckAll: Boolean): Boolean; -var - I: SizeInt; -begin - Result := False; - if CheckAll then - begin - // this will not work with the current definition of the validator. The validator would need to check each character - // it requires against the string (which is currently not provided to the Validator). The current implementation of - // CheckAll will check if all characters in S will be accepted by the provided Validator, which is wrong and incon- - // sistent with the documentation and the array-based overload. - for I := 1 to Length(S) do - begin - Result := Chars(S[I]); - if not Result then - Break; - end; - end - else - begin - for I := 1 to Length(S) do - begin - Result := Chars(S[I]); - if Result then - Break; - end; - end; -end; - -function StrContainsChars(const S: string; const Chars: array of Char; CheckAll: Boolean): Boolean; -var - I: SizeInt; -begin - if CheckAll then - begin - Result := True; - I := High(Chars); - while (I >= 0) and Result do - begin - Result := CharPos(S, Chars[I]) > 0; - Dec(I); - end; - end - else - begin - Result := False; - for I := 1 to Length(S) do - begin - Result := ArrayContainsChar(Chars, S[I]); - if Result then - Break; - end; - end; -end; - -function StrIsAlphaNumUnderscore(const S: string): Boolean; -var - I: SizeInt; - C: Char; -begin - for I := 1 to Length(S) do - begin - C := S[I]; - - if not (CharIsAlphaNum(C) or (C = '_')) then - begin - Result := False; - Exit; - end; - end; - - Result := Length(S) > 0; -end; - -function StrIsDigit(const S: string): Boolean; -var - I: SizeInt; -begin - Result := S <> ''; - for I := 1 to Length(S) do - begin - if not CharIsDigit(S[I]) then - begin - Result := False; - Exit; - end; - end; -end; - -function StrIsSubset(const S: string; const ValidChars: TCharValidator): Boolean; -var - I: SizeInt; -begin - for I := 1 to Length(S) do - begin - Result := ValidChars(S[I]); - if not Result then - Exit; - end; - - Result := Length(S) > 0; -end; - -function StrIsSubset(const S: string; const ValidChars: array of Char): Boolean; -var - I: SizeInt; -begin - for I := 1 to Length(S) do - begin - Result := ArrayContainsChar(ValidChars, S[I]); - if not Result then - Exit; - end; - - Result := Length(S) > 0; -end; - -function StrSame(const S1, S2: string; CaseSensitive: Boolean): Boolean; -begin - Result := StrCompare(S1, S2, CaseSensitive) = 0; -end; - -//=== String Transformation Routines ========================================= - -function StrCenter(const S: string; L: SizeInt; C: Char = ' '): string; -begin - if Length(S) < L then - begin - Result := StringOfChar(C, (L - Length(S)) div 2) + S; - Result := Result + StringOfChar(C, L - Length(Result)); - end - else - Result := S; -end; - -function StrCharPosLower(const S: string; CharPos: SizeInt): string; -begin - Result := S; - if (CharPos > 0) and (CharPos <= Length(S)) then - Result[CharPos] := CharLower(Result[CharPos]); -end; - -function StrCharPosUpper(const S: string; CharPos: SizeInt): string; -begin - Result := S; - if (CharPos > 0) and (CharPos <= Length(S)) then - Result[CharPos] := CharUpper(Result[CharPos]); -end; - -function StrDoubleQuote(const S: string): string; -begin - Result := NativeDoubleQuote + S + NativeDoubleQuote; -end; - -function StrEnsureNoPrefix(const Prefix, Text: string): string; -var - PrefixLen: SizeInt; -begin - PrefixLen := Length(Prefix); - if Copy(Text, 1, PrefixLen) = Prefix then - Result := Copy(Text, PrefixLen + 1, Length(Text)) - else - Result := Text; -end; - -function StrEnsureNoSuffix(const Suffix, Text: string): string; -var - SuffixLen: SizeInt; - StrLength: SizeInt; -begin - SuffixLen := Length(Suffix); - StrLength := Length(Text); - if Copy(Text, StrLength - SuffixLen + 1, SuffixLen) = Suffix then - Result := Copy(Text, 1, StrLength - SuffixLen) - else - Result := Text; -end; - -function StrEnsurePrefix(const Prefix, Text: string): string; -var - PrefixLen: SizeInt; -begin - PrefixLen := Length(Prefix); - if Copy(Text, 1, PrefixLen) = Prefix then - Result := Text - else - Result := Prefix + Text; -end; - -function StrEnsureSuffix(const Suffix, Text: string): string; -var - SuffixLen: SizeInt; -begin - SuffixLen := Length(Suffix); - if Copy(Text, Length(Text) - SuffixLen + 1, SuffixLen) = Suffix then - Result := Text - else - Result := Text + Suffix; -end; - -function StrEscapedToString(const S: string): string; - procedure HandleHexEscapeSeq(const S: string; var I: SizeInt; Len: SizeInt; var Dest: string); - const - HexDigits = string('0123456789abcdefABCDEF'); - var - StartI, Val, N: SizeInt; - begin - StartI := I; - N := Pos(S[I + 1], HexDigits) - 1; - if N < 0 then - // '\x' without hex digit following is not escape sequence - Dest := Dest + '\x' - else - begin - Inc(I); // Jump over x - if N >= 16 then - N := N - 6; - Val := N; - // Same for second digit - if I < Len then - begin - N := Pos(S[I + 1], HexDigits) - 1; - if N >= 0 then - begin - Inc(I); // Jump over first digit - if N >= 16 then - N := N - 6; - Val := Val * 16 + N; - end; - end; - - if Val > Ord(High(Char)) then - raise EJclStringError.CreateResFmt(@RsNumericConstantTooLarge, [Val, StartI]); - - Dest := Dest + Char(Val); - end; - end; - - procedure HandleOctEscapeSeq(const S: string; var I: SizeInt; Len: SizeInt; var Dest: string); - const - OctDigits = string('01234567'); - var - StartI, Val, N: SizeInt; - begin - StartI := I; - // first digit - Val := Pos(S[I], OctDigits) - 1; - if I < Len then - begin - N := Pos(S[I + 1], OctDigits) - 1; - if N >= 0 then - begin - Inc(I); - Val := Val * 8 + N; - end; - if I < Len then - begin - N := Pos(S[I + 1], OctDigits) - 1; - if N >= 0 then - begin - Inc(I); - Val := Val * 8 + N; - end; - end; - end; - - if Val > Ord(High(Char)) then - raise EJclStringError.CreateResFmt(@RsNumericConstantTooLarge, [Val, StartI]); - - Dest := Dest + Char(Val); - end; - -var - I, Len: SizeInt; -begin - Result := ''; - I := 1; - Len := Length(S); - while I <= Len do - begin - if not ((S[I] = '\') and (I < Len)) then - Result := Result + S[I] - else - begin - Inc(I); // Jump over escape character - case S[I] of - 'a': - Result := Result + NativeBell; - 'b': - Result := Result + NativeBackspace; - 'f': - Result := Result + NativeFormFeed; - 'n': - Result := Result + NativeLineFeed; - 'r': - Result := Result + NativeCarriageReturn; - 't': - Result := Result + NativeTab; - 'v': - Result := Result + NativeVerticalTab; - '\': - Result := Result + '\'; - '"': - Result := Result + '"'; - '''': - Result := Result + ''''; // Optionally escaped - '?': - Result := Result + '?'; // Optionally escaped - 'x': - if I < Len then - // Start of hex escape sequence - HandleHexEscapeSeq(S, I, Len, Result) - else - // '\x' at end of string is not escape sequence - Result := Result + '\x'; - '0'..'7': - // start of octal escape sequence - HandleOctEscapeSeq(S, I, Len, Result); - else - // no escape sequence - Result := Result + '\' + S[I]; - end; - end; - Inc(I); - end; -end; - -function StrLower(const S: string): string; -begin - Result := S; - StrLowerInPlace(Result); -end; - -procedure StrLowerInPlace(var S: string); -{$IFDEF UNICODE_RTL_DATABASE} -var - P: PChar; - I, L: SizeInt; -begin - L := Length(S); - if L > 0 then - begin - UniqueString(S); - P := PChar(S); - for I := 1 to L do - begin - P^ := TCharacter.ToLower(P^); - Inc(P); - end; - end; -end; -{$ELSE ~UNICODE_RTL_DATABASE} -begin - StrCase(S, StrLoOffset); -end; -{$ENDIF ~UNICODE_RTL_DATABASE} - -procedure StrLowerBuff(S: PChar); -begin - {$IFDEF UNICODE_RTL_DATABASE} - if S <> nil then - begin - repeat - S^ := TCharacter.ToLower(S^); - Inc(S); - until S^ = #0; - end; - {$ELSE ~UNICODE_RTL_DATABASE} - StrCaseBuff(S, StrLoOffset); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -procedure StrMove(var Dest: string; const Source: string; - const ToIndex, FromIndex, Count: SizeInt); -begin - // Check strings - if (Source = '') or (Length(Dest) = 0) then - Exit; - - // Check FromIndex - if (FromIndex <= 0) or (FromIndex > Length(Source)) or - (ToIndex <= 0) or (ToIndex > Length(Dest)) or - ((FromIndex + Count - 1) > Length(Source)) or ((ToIndex + Count - 1) > Length(Dest)) then - { TODO : Is failure without notice the proper thing to do here? } - Exit; - - // Move - Move(Source[FromIndex], Dest[ToIndex], Count * SizeOf(Char)); -end; - -function StrPadLeft(const S: string; Len: SizeInt; C: Char): string; -var - L: SizeInt; -begin - L := Length(S); - if L < Len then - Result := StringOfChar(C, Len - L) + S - else - Result := S; -end; - -function StrPadRight(const S: string; Len: SizeInt; C: Char): string; -var - L: SizeInt; -begin - L := Length(S); - if L < Len then - Result := S + StringOfChar(C, Len - L) - else - Result := S; -end; - -function StrProper(const S: string): string; -begin - Result := StrLower(S); - if Result <> '' then - Result[1] := UpCase(Result[1]); -end; - -procedure StrProperBuff(S: PChar); -begin - if (S <> nil) and (S^ <> #0) then - begin - StrLowerBuff(S); - S^ := CharUpper(S^); - end; -end; - -function StrQuote(const S: string; C: Char): string; -var - L: SizeInt; -begin - L := Length(S); - Result := S; - if L > 0 then - begin - if Result[1] <> C then - begin - Result := C + Result; - Inc(L); - end; - if Result[L] <> C then - Result := Result + C; - end; -end; - -function StrRemoveChars(const S: string; const Chars: TCharValidator): string; -var - Source, Dest: PChar; - Len, Index: SizeInt; -begin - Len := Length(S); - SetLength(Result, Len); - UniqueString(Result); - Source := PChar(S); - Dest := PChar(Result); - for Index := 0 to Len - 1 do - begin - if not Chars(Source^) then - begin - Dest^ := Source^; - Inc(Dest); - end; - Inc(Source); - end; - SetLength(Result, Dest - PChar(Result)); -end; - -function StrRemoveChars(const S: string; const Chars: array of Char): string; -var - Source, Dest: PChar; - Len, Index: SizeInt; -begin - Len := Length(S); - SetLength(Result, Len); - UniqueString(Result); - Source := PChar(S); - Dest := PChar(Result); - for Index := 0 to Len - 1 do - begin - if not ArrayContainsChar(Chars, Source^) then - begin - Dest^ := Source^; - Inc(Dest); - end; - Inc(Source); - end; - SetLength(Result, Dest - PChar(Result)); -end; - -function StrRemoveLeadingChars(const S: string; const Chars: TCharValidator): string; -var - Len : SizeInt; - I: SizeInt; -begin - Len := Length(S); - I := 1; - while (I <= Len) and Chars(s[I]) do - Inc(I); - Result := Copy (s, I, Len-I+1); -end; - -function StrRemoveLeadingChars(const S: string; const Chars: array of Char): string; -var - Len : SizeInt; - I: SizeInt; -begin - Len := Length(S); - I := 1; - while (I <= Len) and ArrayContainsChar(Chars, s[I]) do - Inc(I); - Result := Copy (s, I, Len-I+1); -end; - -function StrRemoveEndChars(const S: string; const Chars: TCharValidator): string; -var - Len : SizeInt; -begin - Len := Length(S); - while (Len > 0) and Chars(s[Len]) do - Dec(Len); - Result := Copy (s, 1, Len); -end; - -function StrRemoveEndChars(const S: string; const Chars: array of Char): string; -var - Len : SizeInt; -begin - Len := Length(S); - while (Len > 0) and ArrayContainsChar(Chars, s[Len]) do - Dec(Len); - Result := Copy (s, 1, Len); -end; - -function StrKeepChars(const S: string; const Chars: TCharValidator): string; -var - Source, Dest: PChar; - Len, Index: SizeInt; -begin - Len := Length(S); - SetLength(Result, Len); - UniqueString(Result); - Source := PChar(S); - Dest := PChar(Result); - for Index := 0 to Len - 1 do - begin - if Chars(Source^) then - begin - Dest^ := Source^; - Inc(Dest); - end; - Inc(Source); - end; - SetLength(Result, Dest - PChar(Result)); -end; - -function StrKeepChars(const S: string; const Chars: array of Char): string; -var - Source, Dest: PChar; - Len, Index: SizeInt; -begin - Len := Length(S); - SetLength(Result, Len); - UniqueString(Result); - Source := PChar(S); - Dest := PChar(Result); - for Index := 0 to Len - 1 do - begin - if ArrayContainsChar(Chars, Source^) then - begin - Dest^ := Source^; - Inc(Dest); - end; - Inc(Source); - end; - SetLength(Result, Dest - PChar(Result)); -end; - -function StrRepeat(const S: string; Count: SizeInt): string; -var - Len, Index: SizeInt; - Dest, Source: PChar; -begin - Len := Length(S); - SetLength(Result, Count * Len); - Dest := PChar(Result); - Source := PChar(S); - if Dest <> nil then - for Index := 0 to Count - 1 do - begin - Move(Source^, Dest^, Len * SizeOf(Char)); - Inc(Dest, Len); - end; -end; - -function StrRepeatLength(const S: string; L: SizeInt): string; -var - Len: SizeInt; - Dest: PChar; -begin - Result := ''; - Len := Length(S); - - if (Len > 0) and (S <> '') then - begin - SetLength(Result, L); - Dest := PChar(Result); - while (L > 0) do - begin - Move(S[1], Dest^, Min(L, Len) * SizeOf(Char)); - Inc(Dest, Len); - Dec(L, Len); - end; - end; -end; - -procedure StrReplace(var S: string; const Search, Replace: string; Flags: TReplaceFlags); -var - SearchStr: string; - ResultStr: string; { result string } - SourcePtr: PChar; { pointer into S of character under examination } - SourceMatchPtr: PChar; { pointers into S and Search when first character has } - SearchMatchPtr: PChar; { been matched and we're probing for a complete match } - ResultPtr: PChar; { pointer into Result of character being written } - ResultIndex, - SearchLength, { length of search string } - ReplaceLength, { length of replace string } - BufferLength, { length of temporary result buffer } - ResultLength: SizeInt; { length of result string } - C: Char; { first character of search string } - IgnoreCase: Boolean; -begin - if Search = '' then - begin - if S = '' then - begin - S := Replace; - Exit; - end - else - raise EJclStringError.CreateRes(@RsBlankSearchString); - end; - - if S <> '' then - begin - IgnoreCase := rfIgnoreCase in Flags; - if IgnoreCase then - SearchStr := StrUpper(Search) - else - SearchStr := Search; - { avoid having to call Length() within the loop } - SearchLength := Length(Search); - ReplaceLength := Length(Replace); - ResultLength := Length(S); - BufferLength := ResultLength; - SetLength(ResultStr, BufferLength); - { get pointers to begin of source and result } - ResultPtr := PChar(ResultStr); - SourcePtr := PChar(S); - C := SearchStr[1]; - { while we haven't reached the end of the string } - while True do - begin - { copy characters until we find the first character of the search string } - if IgnoreCase then - while (CharUpper(SourcePtr^) <> C) and (SourcePtr^ <> #0) do - begin - ResultPtr^ := SourcePtr^; - Inc(ResultPtr); - Inc(SourcePtr); - end - else - while (SourcePtr^ <> C) and (SourcePtr^ <> #0) do - begin - ResultPtr^ := SourcePtr^; - Inc(ResultPtr); - Inc(SourcePtr); - end; - { did we find that first character or did we hit the end of the string? } - if SourcePtr^ = #0 then - Break - else - begin - { continue comparing, +1 because first character was matched already } - SourceMatchPtr := SourcePtr + 1; - SearchMatchPtr := PChar(SearchStr) + 1; - if IgnoreCase then - while (CharUpper(SourceMatchPtr^) = SearchMatchPtr^) and (SearchMatchPtr^ <> #0) do - begin - Inc(SourceMatchPtr); - Inc(SearchMatchPtr); - end - else - while (SourceMatchPtr^ = SearchMatchPtr^) and (SearchMatchPtr^ <> #0) do - begin - Inc(SourceMatchPtr); - Inc(SearchMatchPtr); - end; - { did we find a complete match? } - if SearchMatchPtr^ = #0 then - begin - // keep track of result length - Inc(ResultLength, ReplaceLength - SearchLength); - if ReplaceLength > 0 then - begin - // increase buffer size if required - if ResultLength > BufferLength then - begin - BufferLength := ResultLength * 2; - ResultIndex := ResultPtr - PChar(ResultStr) + 1; - SetLength(ResultStr, BufferLength); - ResultPtr := @ResultStr[ResultIndex]; - end; - { append replace to result and move past the search string in source } - Move((@Replace[1])^, ResultPtr^, ReplaceLength * SizeOf(Char)); - end; - Inc(SourcePtr, SearchLength); - Inc(ResultPtr, ReplaceLength); - { replace all instances or just one? } - if not (rfReplaceAll in Flags) then - begin - { just one, copy until end of source and break out of loop } - while SourcePtr^ <> #0 do - begin - ResultPtr^ := SourcePtr^; - Inc(ResultPtr); - Inc(SourcePtr); - end; - Break; - end; - end - else - begin - { copy current character and start over with the next } - ResultPtr^ := SourcePtr^; - Inc(ResultPtr); - Inc(SourcePtr); - end; - end; - end; - { set result length and copy result into S } - SetLength(ResultStr, ResultLength); - S := ResultStr; - end; -end; - -function StrReplaceChar(const S: string; const Source, Replace: Char): string; -var - I: SizeInt; -begin - Result := S; - for I := 1 to Length(S) do - if Result[I] = Source then - Result[I] := Replace; -end; - -function StrReplaceChars(const S: string; const Chars: TCharValidator; Replace: Char): string; -var - I: SizeInt; -begin - Result := S; - for I := 1 to Length(S) do - if Chars(Result[I]) then - Result[I] := Replace; -end; - -function StrReplaceChars(const S: string; const Chars: array of Char; Replace: Char): string; -var - I: SizeInt; -begin - Result := S; - for I := 1 to Length(S) do - if ArrayContainsChar(Chars, Result[I]) then - Result[I] := Replace; -end; - -function StrReplaceButChars(const S: string; const Chars: TCharValidator; - Replace: Char): string; -var - I: SizeInt; -begin - Result := S; - for I := 1 to Length(S) do - if not Chars(Result[I]) then - Result[I] := Replace; -end; - -function StrReplaceButChars(const S: string; const Chars: array of Char; Replace: Char): string; -var - I: SizeInt; -begin - Result := S; - for I := 1 to Length(S) do - if not ArrayContainsChar(Chars, Result[I]) then - Result[I] := Replace; -end; - -function StrReverse(const S: string): string; -begin - Result := S; - StrReverseInplace(Result); -end; - -procedure StrReverseInPlace(var S: string); -{ TODO -oahuser : Warning: This is dangerous for unicode surrogates } -var - P1, P2: PChar; - C: Char; -begin - UniqueString(S); - P1 := PChar(S); - P2 := P1 + (Length(S) - 1); - while P1 < P2 do - begin - C := P1^; - P1^ := P2^; - P2^ := C; - Inc(P1); - Dec(P2); - end; -end; - -function StrSingleQuote(const S: string): string; -begin - Result := NativeSingleQuote + S + NativeSingleQuote; -end; - -procedure StrSkipChars(var S: PChar; const Chars: TCharValidator); -begin - while Chars(S^) do - Inc(S); -end; - -procedure StrSkipChars(var S: PChar; const Chars: array of Char); -begin - while ArrayContainsChar(Chars, S^) do - Inc(S); -end; - -procedure StrSkipChars(const S: string; var Index: SizeInt; const Chars: TCharValidator); -begin - while Chars(S[Index]) do - Inc(Index); -end; - -procedure StrSkipChars(const S: string; var Index: SizeInt; const Chars: array of Char); -begin - while ArrayContainsChar(Chars, S[Index]) do - Inc(Index); -end; - -function StrSmartCase(const S: string; const Delimiters: TCharValidator): string; -var - Source, Dest: PChar; - Index, Len: SizeInt; - InternalDelimiters: TCharValidator; -begin - Result := ''; - if Assigned(Delimiters) then - InternalDelimiters := Delimiters - else - InternalDelimiters := CharIsSpace; - - if S <> '' then - begin - Result := S; - UniqueString(Result); - - Len := Length(S); - Source := PChar(S); - Dest := PChar(Result); - Inc(Dest); - - for Index := 2 to Len do - begin - if InternalDelimiters(Source^) and not InternalDelimiters(Dest^) then - Dest^ := CharUpper(Dest^); - Inc(Dest); - Inc(Source); - end; - Result[1] := CharUpper(Result[1]); - end; -end; - -function StrSmartCase(const S: string; const Delimiters: array of Char): string; -var - Source, Dest: PChar; - Index, Len: SizeInt; -begin - Result := ''; - - if S <> '' then - begin - Result := S; - UniqueString(Result); - - Len := Length(S); - Source := PChar(S); - Dest := PChar(Result); - Inc(Dest); - - for Index := 2 to Len do - begin - if ArrayContainsChar(Delimiters, Source^) and not ArrayContainsChar(Delimiters, Dest^) then - Dest^ := CharUpper(Dest^); - Inc(Dest); - Inc(Source); - end; - Result[1] := CharUpper(Result[1]); - end; -end; - -function StrStringToEscaped(const S: string): string; -var - I: SizeInt; -begin - Result := ''; - for I := 1 to Length(S) do - begin - case S[I] of - NativeBackspace: - Result := Result + '\b'; - NativeBell: - Result := Result + '\a'; - NativeCarriageReturn: - Result := Result + '\r'; - NAtiveFormFeed: - Result := Result + '\f'; - NativeLineFeed: - Result := Result + '\n'; - NativeTab: - Result := Result + '\t'; - NativeVerticalTab: - Result := Result + '\v'; - NativeBackSlash: - Result := Result + '\\'; - NativeDoubleQuote: - Result := Result + '\"'; - else - // Characters < ' ' are escaped with hex sequence - if S[I] < #32 then - Result := Result + Format('\x%.2x', [SizeInt(S[I])]) - else - Result := Result + S[I]; - end; - end; -end; - -function StrStripNonNumberChars(const S: string): string; -var - I: SizeInt; - C: Char; -begin - Result := ''; - for I := 1 to Length(S) do - begin - C := S[I]; - if CharIsNumberChar(C) then - Result := Result + C; - end; -end; - -function StrToHex(const Source: string): string; -var - Index: SizeInt; - C, L, N: SizeInt; - BL, BH: Byte; - S: string; -begin - Result := ''; - if Source <> '' then - begin - S := Source; - L := Length(S); - if Odd(L) then - begin - S := '0' + S; - Inc(L); - end; - Index := 1; - SetLength(Result, L div 2); - C := 1; - N := 1; - while C <= L do - begin - BH := CharHex(S[Index]); - Inc(Index); - BL := CharHex(S[Index]); - Inc(Index); - Inc(C, 2); - if (BH = $FF) or (BL = $FF) then - begin - Result := ''; - Exit; - end; - Result[N] := Char((BH shl 4) or BL); - Inc(N); - end; - end; -end; - -function StrTrimCharLeft(const S: string; C: Char): string; -var - I, L: SizeInt; -begin - I := 1; - L := Length(S); - while (I <= L) and (S[I] = C) do - Inc(I); - Result := Copy(S, I, L - I + 1); -end; - -function StrTrimCharsLeft(const S: string; const Chars: TCharValidator): string; -var - I, L: SizeInt; -begin - I := 1; - L := Length(S); - while (I <= L) and Chars(S[I]) do - Inc(I); - Result := Copy(S, I, L - I + 1); -end; - -function StrTrimCharsLeft(const S: string; const Chars: array of Char): string; -var - I, L: SizeInt; -begin - I := 1; - L := Length(S); - while (I <= L) and ArrayContainsChar(Chars, S[I]) do - Inc(I); - Result := Copy(S, I, L - I + 1); -end; - -function StrTrimCharRight(const S: string; C: Char): string; -var - I: SizeInt; -begin - I := Length(S); - while (I >= 1) and (S[I] = C) do - Dec(I); - Result := Copy(S, 1, I); -end; - -function StrTrimCharsRight(const S: string; const Chars: TCharValidator): string; -var - I: SizeInt; -begin - I := Length(S); - while (I >= 1) and Chars(S[I]) do - Dec(I); - Result := Copy(S, 1, I); -end; - -function StrTrimCharsRight(const S: string; const Chars: array of Char): string; -var - I: SizeInt; -begin - I := Length(S); - while (I >= 1) and ArrayContainsChar(Chars, S[I]) do - Dec(I); - Result := Copy(S, 1, I); -end; - -function StrTrimQuotes(const S: string): string; -var - First, Last: Char; - L: SizeInt; -begin - L := Length(S); - if L > 1 then - begin - First := S[1]; - Last := S[L]; - if (First = Last) and ((First = NativeSingleQuote) or (First = NativeDoubleQuote)) then - Result := Copy(S, 2, L - 2) - else - Result := S; - end - else - Result := S; -end; - -function StrUpper(const S: string): string; -begin - Result := S; - StrUpperInPlace(Result); -end; - -procedure StrUpperInPlace(var S: string); -{$IFDEF UNICODE_RTL_DATABASE} -var - P: PChar; - I, L: SizeInt; -begin - L := Length(S); - if L > 0 then - begin - UniqueString(S); - P := PChar(S); - for I := 1 to L do - begin - P^ := TCharacter.ToUpper(P^); - Inc(P); - end; - end; -end; -{$ELSE ~UNICODE_RTL_DATABASE} -begin - StrCase(S, StrUpOffset); -end; -{$ENDIF ~UNICODE_RTL_DATABASE} - -procedure StrUpperBuff(S: PChar); -begin - {$IFDEF UNICODE_RTL_DATABASE} - if S <> nil then - begin - repeat - S^ := TCharacter.ToUpper(S^); - Inc(S); - until S^ = #0; - end; - {$ELSE ~UNICODE_RTL_DATABASE} - StrCaseBuff(S, StrUpOffset); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -//=== String Management ====================================================== - -procedure StrAddRef(var S: string); -var - P: PStrRec; -begin - P := Pointer(S); - if P <> nil then - begin - Dec(P); - if P^.RefCount = -1 then - UniqueString(S) - else - LockedInc(P^.RefCount); - end; -end; - -procedure StrDecRef(var S: string); -var - P: PStrRec; -begin - P := Pointer(S); - if P <> nil then - begin - Dec(P); - case P^.RefCount of - -1, 0: { nothing } ; - 1: - begin - Finalize(S); - Pointer(S) := nil; - end; - else - LockedDec(P^.RefCount); - end; - end; -end; - -function StrLength(const S: string): SizeInt; -var - P: PStrRec; -begin - Result := 0; - P := Pointer(S); - if P <> nil then - begin - Dec(P); - Result := P^.Length and (not $80000000 shr 1); - end; -end; - -function StrRefCount(const S: string): SizeInt; -var - P: PStrRec; -begin - Result := 0; - P := Pointer(S); - if P <> nil then - begin - Dec(P); - Result := P^.RefCount; - end; -end; - -procedure StrResetLength(var S: WideString); -var - I: SizeInt; -begin - for I := 0 to Length(S) - 1 do - if S[I + 1] = #0 then - begin - SetLength(S, I); - Exit; - end; -end; - -procedure StrResetLength(var S: AnsiString); -var - I: SizeInt; -begin - for I := 0 to Length(S) - 1 do - if S[I + 1] = #0 then - begin - SetLength(S, I); - Exit; - end; -end; - -procedure StrResetLength(S: TJclStringBuilder); -var - I: SizeInt; -begin - if S <> nil then - for I := 0 to S.Length - 1 do - if S[I] = #0 then - begin - S.Length := I; - Exit; - end; -end; - -{$IFDEF SUPPORTS_UNICODE_STRING} -procedure StrResetLength(var S: UnicodeString); -var - I: SizeInt; -begin - for I := 0 to Length(S) - 1 do - if S[I + 1] = #0 then - begin - SetLength(S, I); - Exit; - end; -end; -{$ENDIF SUPPORTS_UNICODE_STRING} - -//=== String Search and Replace Routines ===================================== - -function StrCharCount(const S: string; C: Char): SizeInt; -var - I: SizeInt; -begin - Result := 0; - for I := 1 to Length(S) do - if S[I] = C then - Inc(Result); -end; - -function StrCharsCount(const S: string; const Chars: TCharValidator): SizeInt; -var - I: SizeInt; -begin - Result := 0; - for I := 1 to Length(S) do - if Chars(S[I]) then - Inc(Result); -end; - -function StrCharsCount(const S: string; const Chars: array of Char): SizeInt; -var - I: SizeInt; -begin - Result := 0; - for I := 1 to Length(S) do - if ArrayContainsChar(Chars, S[I]) then - Inc(Result); -end; - -function StrStrCount(const S, SubS: string): SizeInt; -var - I: SizeInt; -begin - Result := 0; - if (Length(SubS) > Length(S)) or (Length(SubS) = 0) or (Length(S) = 0) then - Exit; - if Length(SubS) = 1 then - begin - Result := StrCharCount(S, SubS[1]); - Exit; - end; - I := StrSearch(SubS, S, 1); - - if I > 0 then - Inc(Result); - - while (I > 0) and (Length(S) > I + Length(SubS)) do - begin - I := StrSearch(SubS, S, I + 1); - - if I > 0 then - Inc(Result); - end; -end; - -(* -{ 1} Test(StrCompareRange('', '', 1, 5), 0); -{ 2} Test(StrCompareRange('A', '', 1, 5), -1); -{ 3} Test(StrCompareRange('AB', '', 1, 5), -1); -{ 4} Test(StrCompareRange('ABC', '', 1, 5), -1); -{ 5} Test(StrCompareRange('', 'A', 1, 5), -1); -{ 6} Test(StrCompareRange('', 'AB', 1, 5), -1); -{ 7} Test(StrCompareRange('', 'ABC', 1, 5), -1); -{ 8} Test(StrCompareRange('A', 'a', 1, 5), -2); -{ 9} Test(StrCompareRange('A', 'a', 1, 1), -32); -{10} Test(StrCompareRange('aA', 'aB', 1, 1), 0); -{11} Test(StrCompareRange('aA', 'aB', 1, 2), -1); -{12} Test(StrCompareRange('aB', 'aA', 1, 2), 1); -{13} Test(StrCompareRange('aA', 'aa', 1, 2), -32); -{14} Test(StrCompareRange('aa', 'aA', 1, 2), 32); -{15} Test(StrCompareRange('', '', 1, 0), 0); -{16} Test(StrCompareRange('A', 'A', 1, 0), -2); -{17} Test(StrCompareRange('Aa', 'A', 1, 0), -2); -{18} Test(StrCompareRange('Aa', 'Aa', 1, 2), 0); -{19} Test(StrCompareRange('Aa', 'A', 1, 2), 0); -{20} Test(StrCompareRange('Ba', 'A', 1, 2), 1); -*) -function StrCompareRangeEx(const S1, S2: string; Index, Count: SizeInt; CaseSensitive: Boolean): SizeInt; -var - Len1, Len2: SizeInt; - I: SizeInt; - C1, C2: Char; -begin - if Pointer(S1) = Pointer(S2) then - begin - if (Count <= 0) and (S1 <> '') then - Result := -2 // no work - else - Result := 0; - end - else - if (S1 = '') or (S2 = '') then - Result := -1 // null string - else - if Count <= 0 then - Result := -2 // no work - else - begin - Len1 := Length(S1); - Len2 := Length(S2); - - if (Index - 1) + Count > Len1 then - Result := -2 - else - begin - if (Index - 1) + Count > Len2 then // strange behaviour, but the assembler code does it - Count := Len2 - (Index - 1); - - if CaseSensitive then - begin - for I := 0 to Count - 1 do - begin - C1 := S1[Index + I]; - C2 := S2[Index + I]; - if C1 <> C2 then - begin - Result := Ord(C1) - Ord(C2); - Exit; - end; - end; - end - else - begin - for I := 0 to Count - 1 do - begin - C1 := S1[Index + I]; - C2 := S2[Index + I]; - if C1 <> C2 then - begin - C1 := CharLower(C1); - C2 := CharLower(C2); - if C1 <> C2 then - begin - Result := Ord(C1) - Ord(C2); - Exit; - end; - end; - end; - end; - Result := 0; - end; - end; -end; - -function StrCompare(const S1, S2: string; CaseSensitive: Boolean): SizeInt; -var - Len1, Len2: SizeInt; -begin - if Pointer(S1) = Pointer(S2) then - Result := 0 - else - begin - Len1 := Length(S1); - Len2 := Length(S2); - Result := Len1 - Len2; - if Result = 0 then - Result := StrCompareRangeEx(S1, S2, 1, Len1, CaseSensitive); - end; -end; - -function StrCompareRange(const S1, S2: string; Index, Count: SizeInt; CaseSensitive: Boolean): SizeInt; -begin - Result := StrCompareRangeEx(S1, S2, Index, Count, CaseSensitive); -end; - -procedure StrFillChar(var S; Count: SizeInt; C: Char); -{$IFDEF SUPPORTS_UNICODE} -asm - // 32 --> EAX S - // EDX Count - // ECX C - // 64 --> RCX S - // RDX Count - // R8W C - {$IFDEF CPU32} - DEC EDX - JS @@Leave -@@Loop: - MOV [EAX], CX - ADD EAX, 2 - DEC EDX - JNS @@Loop - {$ENDIF CPU32} - {$IFDEF CPU64} - DEC RDX - JS @@Leave -@@Loop: - MOV WORD PTR [RCX], R8W - ADD RCX, 2 - DEC RDX - JNS @@Loop - {$ENDIF CPU64} -@@Leave: -end; -{$ELSE ~SUPPORTS_UNICODE} -begin - if Count > 0 then - FillChar(S, Count, C); -end; -{$ENDIF ~SUPPORTS_UNICODE} - -function StrRepeatChar(C: Char; Count: SizeInt): string; -begin - SetLength(Result, Count); - if Count > 0 then - StrFillChar(Result[1], Count, C); -end; - -function StrFind(const Substr, S: string; const Index: SizeInt): SizeInt; -var - pos: SizeInt; -begin - if (SubStr <> '') and (S <> '') then - begin - pos := StrIPos(Substr, Copy(S, Index, Length(S) - Index + 1)); - if pos = 0 then - Result := 0 - else - Result := Index + Pos - 1; - end - else - Result := 0; -end; - -function StrHasPrefix(const S: string; const Prefixes: array of string): Boolean; -begin - Result := StrPrefixIndex(S, Prefixes) > -1; -end; - -function StrHasSuffix(const S: string; const Suffixes: array of string): Boolean; -begin - Result := StrSuffixIndex(S, Suffixes) > -1; -end; - -function StrIndex(const S: string; const List: array of string; CaseSensitive: Boolean): SizeInt; -var - I: SizeInt; -begin - Result := -1; - for I := Low(List) to High(List) do - begin - if StrCompare(S, List[I], CaseSensitive) = 0 then - begin - Result := I; - Break; - end; - end; -end; - -function StrIHasPrefix(const S: string; const Prefixes: array of string): Boolean; -begin - Result := StrIPrefixIndex(S, Prefixes) > -1; -end; - -function StrIHasSuffix(const S: string; const Suffixes: array of string): Boolean; -begin - Result := StrISuffixIndex(S, Suffixes) > -1; -end; - -function StrILastPos(const SubStr, S: string): SizeInt; -begin - Result := StrLastPos(StrUpper(SubStr), StrUpper(S)); -end; - -function StrIPos(const SubStr, S: string): SizeInt; -begin - Result := Pos(StrUpper(SubStr), StrUpper(S)); -end; - -function StrIPrefixIndex(const S: string; const Prefixes: array of string): SizeInt; -var - I: SizeInt; - Test: string; -begin - Result := -1; - for I := Low(Prefixes) to High(Prefixes) do - begin - Test := StrLeft(S, Length(Prefixes[I])); - if CompareText(Test, Prefixes[I]) = 0 then - begin - Result := I; - Break; - end; - end; -end; - -function StrIsOneOf(const S: string; const List: array of string): Boolean; -begin - Result := StrIndex(S, List) > -1; -end; - -function StrISuffixIndex(const S: string; const Suffixes: array of string): SizeInt; -var - I: SizeInt; - Test: string; -begin - Result := -1; - for I := Low(Suffixes) to High(Suffixes) do - begin - Test := StrRight(S, Length(Suffixes[I])); - if CompareText(Test, Suffixes[I]) = 0 then - begin - Result := I; - Break; - end; - end; -end; - -function StrLastPos(const SubStr, S: string): SizeInt; -var - Last, Current: PChar; -begin - Result := 0; - Last := nil; - Current := PChar(S); - - while (Current <> nil) and (Current^ <> #0) do - begin - Current := StrPos(PChar(Current), PChar(SubStr)); - if Current <> nil then - begin - Last := Current; - Inc(Current); - end; - end; - if Last <> nil then - Result := Abs(PChar(S) - Last) + 1; -end; - -// IMPORTANT NOTE: The StrMatch function does currently not work with the Asterix (*) -// (*) acts like (?) - -function StrMatch(const Substr, S: string; Index: SizeInt): SizeInt; -var - SI, SubI, SLen, SubLen: SizeInt; - SubC: Char; -begin - SLen := Length(S); - SubLen := Length(Substr); - Result := 0; - if (Index > SLen) or (SubLen = 0) then - Exit; - while Index <= SLen do - begin - SubI := 1; - SI := Index; - while (SI <= SLen) and (SubI <= SubLen) do - begin - SubC := Substr[SubI]; - if (SubC = '*') or (SubC = '?') or (SubC = S[SI]) then - begin - Inc(SI); - Inc(SubI); - end - else - Break; - end; - if SubI > SubLen then - begin - Result := Index; - Break; - end; - Inc(Index); - end; -end; - -// Derived from "Like" by Michael Winter -function StrMatches(const Substr, S: string; const Index: SizeInt): Boolean; -var - StringPtr: PChar; - PatternPtr: PChar; - StringRes: PChar; - PatternRes: PChar; -begin - if SubStr = '' then - raise EJclStringError.CreateRes(@RsBlankSearchString); - - Result := SubStr = '*'; - - if Result or (S = '') then - Exit; - - if (Index <= 0) or (Index > Length(S)) then - raise EJclStringError.CreateRes(@RsArgumentOutOfRange); - - StringPtr := PChar(@S[Index]); - PatternPtr := PChar(SubStr); - StringRes := nil; - PatternRes := nil; - - repeat - repeat - case PatternPtr^ of - #0: - begin - Result := StringPtr^ = #0; - if Result or (StringRes = nil) or (PatternRes = nil) then - Exit; - - StringPtr := StringRes; - PatternPtr := PatternRes; - Break; - end; - '*': - begin - Inc(PatternPtr); - PatternRes := PatternPtr; - Break; - end; - '?': - begin - if StringPtr^ = #0 then - Exit; - Inc(StringPtr); - Inc(PatternPtr); - end; - else - begin - if StringPtr^ = #0 then - Exit; - if StringPtr^ <> PatternPtr^ then - begin - if (StringRes = nil) or (PatternRes = nil) then - Exit; - StringPtr := StringRes; - PatternPtr := PatternRes; - Break; - end - else - begin - Inc(StringPtr); - Inc(PatternPtr); - end; - end; - end; - until False; - - repeat - case PatternPtr^ of - #0: - begin - Result := True; - Exit; - end; - '*': - begin - Inc(PatternPtr); - PatternRes := PatternPtr; - end; - '?': - begin - if StringPtr^ = #0 then - Exit; - Inc(StringPtr); - Inc(PatternPtr); - end; - else - begin - repeat - if StringPtr^ = #0 then - Exit; - if StringPtr^ = PatternPtr^ then - Break; - Inc(StringPtr); - until False; - Inc(StringPtr); - StringRes := StringPtr; - Inc(PatternPtr); - Break; - end; - end; - until False; - until False; -end; - -function StrNPos(const S, SubStr: string; N: SizeInt): SizeInt; -var - I, P: SizeInt; -begin - if N < 1 then - begin - Result := 0; - Exit; - end; - - Result := StrSearch(SubStr, S, 1); - I := 1; - while I < N do - begin - P := StrSearch(SubStr, S, Result + 1); - if P = 0 then - begin - Result := 0; - Break; - end - else - begin - Result := P; - Inc(I); - end; - end; -end; - -function StrNIPos(const S, SubStr: string; N: SizeInt): SizeInt; -var - I, P: SizeInt; -begin - if N < 1 then - begin - Result := 0; - Exit; - end; - - Result := StrFind(SubStr, S, 1); - I := 1; - while I < N do - begin - P := StrFind(SubStr, S, Result + 1); - if P = 0 then - begin - Result := 0; - Break; - end - else - begin - Result := P; - Inc(I); - end; - end; -end; - -function StrPrefixIndex(const S: string; const Prefixes: array of string): SizeInt; -var - I: SizeInt; - Test: string; -begin - Result := -1; - for I := Low(Prefixes) to High(Prefixes) do - begin - Test := StrLeft(S, Length(Prefixes[I])); - if CompareStr(Test, Prefixes[I]) = 0 then - begin - Result := I; - Break; - end; - end; -end; - -function StrSearch(const Substr, S: string; const Index: SizeInt): SizeInt; -var - SP, SPI, SubP: PChar; - SLen: SizeInt; -begin - SLen := Length(S); - if Index <= SLen then - begin - SP := PChar(S); - SubP := PChar(Substr); - SPI := SP; - Inc(SPI, Index); - Dec(SPI); - SPI := StrPos(SPI, SubP); - if SPI <> nil then - Result := SPI - SP + 1 - else - Result := 0; - end - else - Result := 0; -end; - -function StrSuffixIndex(const S: string; const Suffixes: array of string): SizeInt; -var - I: SizeInt; - Test: string; -begin - Result := -1; - for I := Low(Suffixes) to High(Suffixes) do - begin - Test := StrRight(S, Length(Suffixes[I])); - if CompareStr(Test, Suffixes[I]) = 0 then - begin - Result := I; - Break; - end; - end; -end; - -//=== String Extraction ====================================================== - -function StrAfter(const SubStr, S: string): string; -var - P: SizeInt; -begin - P := StrFind(SubStr, S, 1); // StrFind is case-insensitive pos - if P <= 0 then - Result := '' // substr not found -> nothing after it - else - Result := StrRestOf(S, P + Length(SubStr)); -end; - -function StrBefore(const SubStr, S: string): string; -var - P: SizeInt; -begin - P := StrFind(SubStr, S, 1); - if P <= 0 then - Result := S - else - Result := StrLeft(S, P - 1); -end; - -function StrSplit(const SubStr, S: string;var Left, Right : string): boolean; -var - P: SizeInt; -begin - P := StrFind(SubStr, S, 1); - Result:= p > 0; - if Result then - begin - Left := StrLeft(S, P - 1); - Right := StrRestOf(S, P + Length(SubStr)); - end - else - begin - Left := ''; - Right := ''; - end; -end; - -function StrBetween(const S: string; const Start, Stop: Char): string; -var - PosStart, PosEnd: SizeInt; - L: SizeInt; -begin - PosStart := Pos(Start, S); - PosEnd := StrSearch(Stop, S, PosStart + 1); // PosEnd has to be after PosStart. - - if (PosStart > 0) and (PosEnd > PosStart) then - begin - L := PosEnd - PosStart; - Result := Copy(S, PosStart + 1, L - 1); - end - else - Result := ''; -end; - -function StrChopRight(const S: string; N: SizeInt): string; -begin - Result := Copy(S, 1, Length(S) - N); -end; - -function StrLeft(const S: string; Count: SizeInt): string; -begin - Result := Copy(S, 1, Count); -end; - -function StrMid(const S: string; Start, Count: SizeInt): string; -begin - Result := Copy(S, Start, Count); -end; - -function StrRestOf(const S: string; N: SizeInt): string; -begin - Result := Copy(S, N, (Length(S) - N + 1)); -end; - -function StrRight(const S: string; Count: SizeInt): string; -begin - Result := Copy(S, Length(S) - Count + 1, Count); -end; - -//=== Character (do we have it ;) ============================================ - -function CharEqualNoCase(const C1, C2: Char): Boolean; -begin - //if they are not equal chars, may be same letter different case - Result := (C1 = C2) or - (CharIsAlpha(C1) and CharIsAlpha(C2) and (CharLower(C1) = CharLower(C2))); -end; - - -function CharIsAlpha(const C: Char): Boolean; -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.IsLetter(C); - {$ELSE ~UNICODE_RTL_DATABASE} - Result := (StrCharTypes[C] and C1_ALPHA) <> 0; - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function CharIsAlphaNum(const C: Char): Boolean; -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.IsLetterOrDigit(C); - {$ELSE ~UNICODE_RTL_DATABASE} - Result := ((StrCharTypes[C] and C1_ALPHA) <> 0) or ((StrCharTypes[C] and C1_DIGIT) <> 0); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function CharIsBlank(const C: Char): Boolean; -begin - {$IFDEF UNICODE_RTL_DATABASE} - //http://blogs.msdn.com/b/michkap/archive/2007/06/11/3230072.aspx - Result := (C = ' ') or (C = #$0009) or (C = #$00A0) or (C = #$3000); - {$ELSE ~UNICODE_RTL_DATABASE} - Result := ((StrCharTypes[C] and C1_BLANK) <> 0); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function CharIsControl(const C: Char): Boolean; -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.IsControl(C); - {$ELSE ~UNICODE_RTL_DATABASE} - Result := (StrCharTypes[C] and C1_CNTRL) <> 0; - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function CharIsDelete(const C: Char): Boolean; -begin - Result := (C = #8); -end; - -function CharIsDigit(const C: Char): Boolean; -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.IsDigit(C); - {$ELSE ~UNICODE_RTL_DATABASE} - Result := (StrCharTypes[C] and C1_DIGIT) <> 0; - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function CharIsFracDigit(const C: Char): Boolean; -begin - Result := (C = '.') or CharIsDigit(C); -end; - -function CharIsHexDigit(const C: Char): Boolean; -begin - case C of - 'A'..'F', - 'a'..'f': - Result := True; - else - Result := CharIsDigit(C); - end; -end; - -function CharIsLower(const C: Char): Boolean; -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.IsLower(C); - {$ELSE ~UNICODE_RTL_DATABASE} - Result := (StrCharTypes[C] and C1_LOWER) <> 0; - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function CharIsNumberChar(const C: Char): Boolean; -begin - Result := CharIsDigit(C) or (C = '+') or (C = '-') or (C = JclFormatSettings.DecimalSeparator); -end; - -function CharIsNumber(const C: Char): Boolean; -begin - Result := CharIsDigit(C) or (C = JclFormatSettings.DecimalSeparator); -end; - -function CharIsPrintable(const C: Char): Boolean; -begin - Result := not CharIsControl(C); -end; - -function CharIsPunctuation(const C: Char): Boolean; -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.IsPunctuation(C); - {$ELSE ~UNICODE_RTL_DATABASE} - Result := ((StrCharTypes[C] and C1_PUNCT) <> 0); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function CharIsReturn(const C: Char): Boolean; -begin - Result := (C = NativeLineFeed) or (C = NativeCarriageReturn); -end; - -function CharIsSpace(const C: Char): Boolean; -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.IsWhiteSpace(C); - {$ELSE ~UNICODE_RTL_DATABASE} - Result := (StrCharTypes[C] and C1_SPACE) <> 0; - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function CharIsUpper(const C: Char): Boolean; -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.IsUpper(C); - {$ELSE ~UNICODE_RTL_DATABASE} - Result := (StrCharTypes[C] and C1_UPPER) <> 0; - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function CharIsValidIdentifierLetter(const C: Char): Boolean; -begin - case C of - {$IFDEF SUPPORTS_UNICODE} - // from XML specifications - #$00C0..#$00D6, #$00D8..#$00F6, #$00F8..#$02FF, #$0370..#$037D, - #$037F..#$1FFF, #$200C..#$200D, #$2070..#$218F, #$2C00..#$2FEF, - #$3001..#$D7FF, #$F900..#$FDCF, #$FDF0..#$FFFD, // #$10000..#$EFFFF, howto match surrogate pairs? - #$00B7, #$0300..#$036F, #$203F..#$2040, - {$ENDIF SUPPORTS_UNICODE} - '0'..'9', 'A'..'Z', 'a'..'z', '_': - Result := True; - else - Result := False; - end; -end; - -function CharIsWhiteSpace(const C: Char): Boolean; -begin - case C of - NativeTab, - NativeLineFeed, - NativeVerticalTab, - NativeFormFeed, - NativeCarriageReturn, - NativeSpace: - Result := True; - else - Result := False; - end; -end; - -function CharIsWildcard(const C: Char): Boolean; -begin - case C of - '*', '?': - Result := True; - else - Result := False; - end; -end; - -function CharType(const C: Char): Word; -begin - {$IFDEF UNICODE_RTL_DATABASE} - GetStringTypeEx(LOCALE_USER_DEFAULT, CT_CTYPE1, @C, 1, Result); - {$ELSE ~UNICODE_RTL_DATABASE} - Result := StrCharTypes[C]; - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -//=== PCharVector ============================================================ - -function StringsToPCharVector(var Dest: PCharVector; const Source: TStrings): PCharVector; -var - I: SizeInt; - S: string; - List: array of PChar; -begin - Assert(Source <> nil); - Dest := AllocMem((Source.Count + SizeOf(Char)) * SizeOf(PChar)); - SetLength(List, Source.Count + SizeOf(Char)); - for I := 0 to Source.Count - 1 do - begin - S := Source[I]; - List[I] := StrAlloc(Length(S) + SizeOf(Char)); - StrPCopy(List[I], S); - end; - List[Source.Count] := nil; - Move(List[0], Dest^, (Source.Count + 1) * SizeOf(PChar)); - Result := Dest; -end; - -function PCharVectorCount(Source: PCharVector): SizeInt; -begin - Result := 0; - if Source <> nil then - begin - while Source^ <> nil do - begin - Inc(Source); - Inc(Result); - end; - end; -end; - -procedure PCharVectorToStrings(const Dest: TStrings; Source: PCharVector); -var - I, Count: SizeInt; - List: array of PChar; -begin - Assert(Dest <> nil); - if Source <> nil then - begin - Count := PCharVectorCount(Source); - SetLength(List, Count); - Move(Source^, List[0], Count * SizeOf(PChar)); - Dest.BeginUpdate; - try - Dest.Clear; - for I := 0 to Count - 1 do - Dest.Add(List[I]); - finally - Dest.EndUpdate; - end; - end; -end; - -procedure FreePCharVector(var Dest: PCharVector); -var - I, Count: SizeInt; - List: array of PChar; -begin - if Dest <> nil then - begin - Count := PCharVectorCount(Dest); - SetLength(List, Count); - Move(Dest^, List[0], Count * SizeOf(PChar)); - for I := 0 to Count - 1 do - StrDispose(List[I]); - FreeMem(Dest, (Count + 1) * SizeOf(PChar)); - Dest := nil; - end; -end; - -//=== Character Transformation Routines ====================================== - -function CharHex(const C: Char): Byte; -begin - case C of - '0'..'9': - Result := Ord(C) - Ord('0'); - 'a'..'f': - Result := Ord(C) - Ord('a') + 10; - 'A'..'F': - Result := Ord(C) - Ord('A') + 10; - else - Result := $FF; - end; -end; - -function CharLower(const C: Char): Char; -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.ToLower(C); - {$ELSE ~UNICODE_RTL_DATABASE} - Result := StrCaseMap[Ord(C) + StrLoOffset]; - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function CharToggleCase(const C: Char): Char; -begin - {$IFDEF UNICODE_RTL_DATABASE} - if CharIsLower(C) then - Result := CharUpper(C) - else if CharIsUpper(C) then - Result := CharLower(C) - else - Result := C; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := StrCaseMap[Ord(C) + StrReOffset]; - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function CharUpper(const C: Char): Char; -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.ToUpper(C); - {$ELSE ~UNICODE_RTL_DATABASE} - Result := StrCaseMap[Ord(C) + StrUpOffset]; - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -//=== Character Search and Replace =========================================== - -function CharLastPos(const S: string; const C: Char; const Index: SizeInt): SizeInt; -begin - if (Index > 0) and (Index <= Length(S)) then - begin - for Result := Length(S) downto Index do - if S[Result] = C then - Exit; - end; - Result := 0; -end; - -function CharPos(const S: string; const C: Char; const Index: SizeInt): SizeInt; -begin - if (Index > 0) and (Index <= Length(S)) then - begin - for Result := Index to Length(S) do - if S[Result] = C then - Exit; - end; - Result := 0; -end; - -function CharIPos(const S: string; C: Char; const Index: SizeInt): SizeInt; -begin - if (Index > 0) and (Index <= Length(S)) then - begin - C := CharUpper(C); - for Result := Index to Length(S) do - if CharUpper(S[Result]) = C then - Exit; - end; - Result := 0; -end; - -function CharReplace(var S: string; const Search, Replace: Char): SizeInt; -var - P: PChar; - Index, Len: SizeInt; -begin - Result := 0; - if Search <> Replace then - begin - UniqueString(S); - P := PChar(S); - Len := Length(S); - for Index := 0 to Len - 1 do - begin - if P^ = Search then - begin - P^ := Replace; - Inc(Result); - end; - Inc(P); - end; - end; -end; - -//=== MultiSz ================================================================ - -function StringsToMultiSz(var Dest: PMultiSz; const Source: TStrings): PMultiSz; -var - I, TotalLength: SizeInt; - P: PMultiSz; -begin - Assert(Source <> nil); - TotalLength := 1; - for I := 0 to Source.Count - 1 do - if Source[I] = '' then - raise EJclStringError.CreateRes(@RsInvalidEmptyStringItem) - else - Inc(TotalLength, StrLen(PChar(Source[I])) + 1); - AllocateMultiSz(Dest, TotalLength); - P := Dest; - for I := 0 to Source.Count - 1 do - begin - P := StrECopy(P, PChar(Source[I])); - Inc(P); - end; - P^ := #0; - Result := Dest; -end; - -procedure MultiSzToStrings(const Dest: TStrings; const Source: PMultiSz); -var - P: PMultiSz; -begin - Assert(Dest <> nil); - Dest.BeginUpdate; - try - Dest.Clear; - if Source <> nil then - begin - P := Source; - while P^ <> #0 do - begin - Dest.Add(P); - P := StrEnd(P); - Inc(P); - end; - end; - finally - Dest.EndUpdate; - end; -end; - -function MultiSzLength(const Source: PMultiSz): SizeInt; -var - P: PMultiSz; -begin - Result := 0; - if Source <> nil then - begin - P := Source; - repeat - Inc(Result, StrLen(P) + 1); - P := StrEnd(P); - Inc(P); - until P^ = #0; - Inc(Result); - end; -end; - -procedure AllocateMultiSz(var Dest: PMultiSz; Len: SizeInt); -begin - if Len > 0 then - GetMem(Dest, Len * SizeOf(Char)) - else - Dest := nil; -end; - -procedure FreeMultiSz(var Dest: PMultiSz); -begin - if Dest <> nil then - FreeMem(Dest); - Dest := nil; -end; - -function MultiSzDup(const Source: PMultiSz): PMultiSz; -var - Len: SizeInt; -begin - if Source <> nil then - begin - Len := MultiSzLength(Source); - Result := nil; - AllocateMultiSz(Result, Len); - Move(Source^, Result^, Len * SizeOf(Char)); - end - else - Result := nil; -end; - -function AnsiStringsToAnsiMultiSz(var Dest: PAnsiMultiSz; const Source: TAnsiStrings): PAnsiMultiSz; -begin - Result := JclAnsiStrings.StringsToMultiSz(Dest, Source); -end; - -procedure AnsiMultiSzToAnsiStrings(const Dest: TAnsiStrings; const Source: PAnsiMultiSz); -begin - JclAnsiStrings.MultiSzToStrings(Dest, Source); -end; - -function AnsiMultiSzLength(const Source: PAnsiMultiSz): SizeInt; -begin - Result := JclAnsiStrings.MultiSzLength(Source); -end; - -procedure AllocateAnsiMultiSz(var Dest: PAnsiMultiSz; Len: SizeInt); -begin - JclAnsiStrings.AllocateMultiSz(Dest, Len); -end; - -procedure FreeAnsiMultiSz(var Dest: PAnsiMultiSz); -begin - JclAnsiStrings.FreeMultiSz(Dest); -end; - -function AnsiMultiSzDup(const Source: PAnsiMultiSz): PAnsiMultiSz; -begin - Result := JclAnsiStrings.MultiSzDup(Source); -end; - -function WideStringsToWideMultiSz(var Dest: PWideMultiSz; const Source: TWideStrings): PWideMultiSz; -begin - Result := JclWideStrings.StringsToMultiSz(Dest, Source); -end; - -procedure WideMultiSzToWideStrings(const Dest: TWideStrings; const Source: PWideMultiSz); -begin - JclWideStrings.MultiSzToStrings(Dest, Source); -end; - -function WideMultiSzLength(const Source: PWideMultiSz): SizeInt; -begin - Result := JclWideStrings.MultiSzLength(Source); -end; - -procedure AllocateWideMultiSz(var Dest: PWideMultiSz; Len: SizeInt); -begin - JclWideStrings.AllocateMultiSz(Dest, Len); -end; - -procedure FreeWideMultiSz(var Dest: PWideMultiSz); -begin - JclWideStrings.FreeMultiSz(Dest); -end; - -function WideMultiSzDup(const Source: PWideMultiSz): PWideMultiSz; -begin - Result := JclWideStrings.MultiSzDup(Source); -end; - -//=== TStrings Manipulation ================================================== - -procedure StrToStrings(S, Sep: string; const List: TStrings; const AllowEmptyString: Boolean = True); -var - I, L: SizeInt; - Left: string; -begin - Assert(List <> nil); - List.BeginUpdate; - try - List.Clear; - L := Length(Sep); - I := Pos(Sep, S); - while I > 0 do - begin - Left := StrLeft(S, I - 1); - if (Left <> '') or AllowEmptyString then - List.Add(Left); - Delete(S, 1, I + L - 1); - I := Pos(Sep, S); - end; - if (S <> '') or AllowEmptyString then - List.Add(S); // Ignore empty strings at the end (only if AllowEmptyString = False). - finally - List.EndUpdate; - end; -end; - -procedure StrIToStrings(S, Sep: string; const List: TStrings; const AllowEmptyString: Boolean = True); -var - I, L: SizeInt; - LowerCaseStr: string; - Left: string; -begin - Assert(List <> nil); - LowerCaseStr := StrLower(S); - Sep := StrLower(Sep); - L := Length(Sep); - I := Pos(Sep, LowerCaseStr); - List.BeginUpdate; - try - List.Clear; - while I > 0 do - begin - Left := StrLeft(S, I - 1); - if (Left <> '') or AllowEmptyString then - List.Add(Left); - Delete(S, 1, I + L - 1); - Delete(LowerCaseStr, 1, I + L - 1); - I := Pos(Sep, LowerCaseStr); - end; - if (S <> '') or AllowEmptyString then - List.Add(S); // Ignore empty strings at the end (only if AllowEmptyString = False). - finally - List.EndUpdate; - end; -end; - -function StringsToStr(const List: TStrings; const Sep: string; const AllowEmptyString: Boolean = True): string; -var - I, L: SizeInt; -begin - Result := ''; - for I := 0 to List.Count - 1 do - begin - if (List[I] <> '') or AllowEmptyString then - begin - // don't combine these into one addition, somehow it hurts performance - Result := Result + List[I]; - Result := Result + Sep; - end; - end; - // remove terminating separator - if List.Count > 0 then - begin - L := Length(Sep); - Delete(Result, Length(Result) - L + 1, L); - end; -end; - -function StringsToStr(const List: TStrings; const Sep: string; const NumberOfItems: SizeInt; const AllowEmptyString: - Boolean = True): string; -var - I, L, N: SizeInt; -begin - Result := ''; - if List.Count > NumberOfItems then - N := NumberOfItems - else - N := List.Count; - for I := 0 to N - 1 do - begin - if (List[I] <> '') or AllowEmptyString then - begin - // don't combine these into one addition, somehow it hurts performance - Result := Result + List[I]; - Result := Result + Sep; - end; - end; - // remove terminating separator - if N > 0 then - begin - L := Length(Sep); - Delete(Result, Length(Result) - L + 1, L); - end; -end; - -procedure TrimStrings(const List: TStrings; DeleteIfEmpty: Boolean); -var - I: SizeInt; -begin - Assert(List <> nil); - List.BeginUpdate; - try - for I := List.Count - 1 downto 0 do - begin - List[I] := Trim(List[I]); - if (List[I] = '') and DeleteIfEmpty then - List.Delete(I); - end; - finally - List.EndUpdate; - end; -end; - -procedure TrimStringsRight(const List: TStrings; DeleteIfEmpty: Boolean); -var - I: SizeInt; -begin - Assert(List <> nil); - List.BeginUpdate; - try - for I := List.Count - 1 downto 0 do - begin - List[I] := TrimRight(List[I]); - if (List[I] = '') and DeleteIfEmpty then - List.Delete(I); - end; - finally - List.EndUpdate; - end; -end; - -procedure TrimStringsLeft(const List: TStrings; DeleteIfEmpty: Boolean); -var - I: SizeInt; -begin - Assert(List <> nil); - List.BeginUpdate; - try - for I := List.Count - 1 downto 0 do - begin - List[I] := TrimLeft(List[I]); - if (List[I] = '') and DeleteIfEmpty then - List.Delete(I); - end; - finally - List.EndUpdate; - end; -end; - -function AddStringToStrings(const S: string; Strings: TStrings; const Unique: Boolean): Boolean; -begin - Assert(Strings <> nil); - Result := Unique and (Strings.IndexOf(S) <> -1); - if not Result then - Result := Strings.Add(S) > -1; -end; - -//=== Miscellaneous ========================================================== - -function FileToString(const FileName: string): {$IFDEF COMPILER12_UP}RawByteString{$ELSE}AnsiString{$ENDIF}; -var - fs: TFileStream; - Len: SizeInt; -begin - fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); - try - Len := fs.Size; - SetLength(Result, Len); - if Len > 0 then - fs.ReadBuffer(Result[1], Len); - finally - fs.Free; - end; -end; - -procedure StringToFile(const FileName: string; const Contents: {$IFDEF COMPILER12_UP}RawByteString{$ELSE}AnsiString{$ENDIF}; - Append: Boolean); -var - FS: TFileStream; - Len: SizeInt; -begin - if Append and FileExists(filename) then - FS := TFileStream.Create(FileName, fmOpenReadWrite or fmShareDenyWrite) - else - FS := TFileStream.Create(FileName, fmCreate); - try - if Append then - FS.Seek(0, soEnd); // faster than .Position := .Size - Len := Length(Contents); - if Len > 0 then - FS.WriteBuffer(Contents[1], Len); - finally - FS.Free; - end; -end; - -function StrToken(var S: string; Separator: Char): string; -var - I: SizeInt; -begin - I := Pos(Separator, S); - if I <> 0 then - begin - Result := Copy(S, 1, I - 1); - Delete(S, 1, I); - end - else - begin - Result := S; - S := ''; - end; -end; - -procedure StrTokens(const S: string; const List: TStrings); -var - Start: PChar; - Token: string; - Done: Boolean; -begin - Assert(List <> nil); - if List = nil then - Exit; - - List.BeginUpdate; - try - List.Clear; - Start := Pointer(S); - repeat - Done := JclStrings.StrWord(Start, Token); - if Token <> '' then - List.Add(Token); - until Done; - finally - List.EndUpdate; - end; -end; - -function StrWord(const S: string; var Index: SizeInt; out Word: string): Boolean; -var - Start: SizeInt; - C: Char; -begin - Word := ''; - if (S = '') then - begin - Result := True; - Exit; - end; - Start := Index; - Result := False; - while True do - begin - C := S[Index]; - case C of - #0: - begin - if Start <> 0 then - Word := Copy(S, Start, Index - Start); - Result := True; - Exit; - end; - NativeSpace, NativeLineFeed, NativeCarriageReturn: - begin - if Start <> 0 then - begin - Word := Copy(S, Start, Index - Start); - Exit; - end - else - begin - while CharIsWhiteSpace(C) do - begin - Inc(Index); - C := S[Index]; - end; - end; - end; - else - if Start = 0 then - Start := Index; - Inc(Index); - end; - end; -end; - -function StrWord(var S: PChar; out Word: string): Boolean; -var - Start: PChar; -begin - Word := ''; - if S = nil then - begin - Result := True; - Exit; - end; - Start := nil; - Result := False; - while True do - begin - case S^ of - #0: - begin - if Start <> nil then - SetString(Word, Start, S - Start); - Result := True; - Exit; - end; - NativeSpace, NativeLineFeed, NativeCarriageReturn: - begin - if Start <> nil then - begin - SetString(Word, Start, S - Start); - Exit; - end - else - while CharIsWhiteSpace(S^) do - Inc(S); - end; - else - if Start = nil then - Start := S; - Inc(S); - end; - end; -end; - -function StrIdent(const S: string; var Index: SizeInt; out Ident: string): Boolean; -var - Start: SizeInt; - C: Char; -begin - Ident := ''; - if (S = '') then - begin - Result := True; - Exit; - end; - Start := Index; - Result := False; - while True do - begin - C := S[Index]; - if CharIsValidIdentifierLetter(C) then - begin - if Start = 0 then - Start := Index; - end - else - if C = #0 then - begin - if Start <> 0 then - Ident := Copy(S, Start, Index - Start); - Result := True; - Exit; - end - else - begin - if Start <> 0 then - begin - Ident := Copy(S, Start, Index - Start); - Exit; - end; - end; - Inc(Index); - end; -end; - -function StrIdent(var S: PChar; out Ident: string): Boolean; -var - Start: PChar; - C: Char; -begin - Ident := ''; - if S = nil then - begin - Result := True; - Exit; - end; - Start := nil; - Result := False; - while True do - begin - C := S^; - if CharIsValidIdentifierLetter(C) then - begin - if Start = nil then - Start := S; - end - else - if C = #0 then - begin - if Start <> nil then - SetString(Ident, Start, S - Start); - Result := True; - Exit; - end - else - begin - if Start <> nil then - begin - SetString(Ident, Start, S - Start); - Exit; - end - end; - Inc(S); - end; -end; - -procedure StrTokenToStrings(S: string; Separator: Char; const List: TStrings); -var - Token: string; -begin - Assert(List <> nil); - - if List = nil then - Exit; - - List.BeginUpdate; - try - List.Clear; - while S <> '' do - begin - Token := StrToken(S, Separator); - List.Add(Token); - end; - finally - List.EndUpdate; - end; -end; - -function StrToFloatSafe(const S: string): Float; -var - Temp: string; - I, J, K: SizeInt; - SwapSeparators, IsNegative: Boolean; - DecSep, ThouSep, C: Char; -begin - DecSep := {$IFDEF RTL220_UP}FormatSettings.{$ENDIF}DecimalSeparator; - ThouSep := {$IFDEF RTL220_UP}FormatSettings.{$ENDIF}ThousandSeparator; - Temp := S; - SwapSeparators := False; - - IsNegative := False; - J := 0; - for I := 1 to Length(Temp) do - begin - C := Temp[I]; - if C = '-' then - IsNegative := not IsNegative - else - if (C <> ' ') and (C <> '(') and (C <> '+') then - begin - // if it appears prior to any digit, it has to be a decimal separator - SwapSeparators := Temp[I] = ThouSep; - J := I; - Break; - end; - end; - - if not SwapSeparators then - begin - K := CharPos(Temp, DecSep); - SwapSeparators := - // if it appears prior to any digit, it has to be a decimal separator - (K > J) and - // if it appears multiple times, it has to be a thousand separator - ((StrCharCount(Temp, DecSep) > 1) or - // we assume (consistent with Windows Platform SDK documentation), - // that thousand separators appear only to the left of the decimal - (K < CharPos(Temp, ThouSep))); - end; - - if SwapSeparators then - begin - // assume a numerical string from a different locale, - // where DecimalSeparator and ThousandSeparator are exchanged - for I := 1 to Length(Temp) do - if Temp[I] = DecSep then - Temp[I] := ThouSep - else - if Temp[I] = ThouSep then - Temp[I] := DecSep; - end; - - Temp := StrKeepChars(Temp, CharIsNumber); - - if Length(Temp) > 0 then - begin - if Temp[1] = DecSep then - Temp := '0' + Temp; - if Temp[Length(Temp)] = DecSep then - Temp := Temp + '0'; - Result := StrToFloat(Temp); - if IsNegative then - Result := -Result; - end - else - Result := 0.0; -end; - -function StrToIntSafe(const S: string): Integer; -begin - Result := Trunc(StrToFloatSafe(S)); -end; - -procedure StrNormIndex(const StrLen: SizeInt; var Index: SizeInt; var Count: SizeInt); overload; -begin - Index := Max(1, Min(Index, StrLen + 1)); - Count := Max(0, Min(Count, StrLen + 1 - Index)); -end; - -function ArrayOf(List: TStrings): TDynStringArray; -var - I: SizeInt; -begin - if List <> nil then - begin - SetLength(Result, List.Count); - for I := 0 to List.Count - 1 do - Result[I] := List[I]; - end - else - Result := nil; -end; - -const - BoolToStr: array [Boolean] of string = ('false', 'true'); - -type - TInterfacedObjectAccess = class(TInterfacedObject); - -procedure MoveChar(const Source; var Dest; Count: SizeInt); -begin - if Count > 0 then - Move(Source, Dest, Count * SizeOf(Char)); -end; - -function DotNetFormat(const Fmt: string; const Arg0: Variant): string; -begin - Result := DotNetFormat(Fmt, [Arg0]); -end; - -function DotNetFormat(const Fmt: string; const Arg0, Arg1: Variant): string; -begin - Result := DotNetFormat(Fmt, [Arg0, Arg1]); -end; - -function DotNetFormat(const Fmt: string; const Arg0, Arg1, Arg2: Variant): string; -begin - Result := DotNetFormat(Fmt, [Arg0, Arg1, Arg2]); -end; - -function DotNetFormat(const Fmt: string; const Args: array of const): string; -var - F, P: PChar; - Len, Capacity, Count: SizeInt; - Index: SizeInt; - ErrorCode: Integer; - S: string; - - procedure Grow(Count: SizeInt); - begin - if Len + Count > Capacity then - begin - Capacity := Capacity * 5 div 3 + Count; - SetLength(Result, Capacity); - end; - end; - - function InheritsFrom(AClass: TClass; const ClassName: string): Boolean; - begin - Result := True; - while AClass <> nil do - begin - if CompareText(AClass.ClassName, ClassName) = 0 then - Exit; - AClass := AClass.ClassParent; - end; - Result := False; - end; - - function GetStringOf(const V: TVarData; Index: SizeInt): string; overload; - begin - case V.VType of - varEmpty, varNull: - raise ArgumentNullException.CreateRes(@RsArgumentIsNull); - varSmallInt: - Result := IntToStr(V.VSmallInt); - varInteger: - Result := IntToStr(V.VInteger); - varSingle: - Result := FloatToStr(V.VSingle); - varDouble: - Result := FloatToStr(V.VDouble); - varCurrency: - Result := CurrToStr(V.VCurrency); - varDate: - Result := DateTimeToStr(V.VDate); - varOleStr: - Result := V.VOleStr; - varBoolean: - Result := BoolToStr[V.VBoolean <> False]; - varByte: - Result := IntToStr(V.VByte); - varWord: - Result := IntToStr(V.VWord); - varShortInt: - Result := IntToStr(V.VShortInt); - varLongWord: - Result := IntToStr(V.VLongWord); - varInt64: - Result := IntToStr(V.VInt64); - varString: - Result := string(V.VString); - {$IFDEF SUPPORTS_UNICODE_STRING} - varUString: - Result := string(V.VUString); - {$ENDIF SUPPORTS_UNICODE_STRING} - {varArray, - varDispatch, - varError, - varUnknown, - varAny, - varByRef:} - else - raise ArgumentNullException.CreateResFmt(@RsDotNetFormatArgumentNotSupported, [Index]); - end; - end; - - function GetStringOf(Index: SizeInt): string; overload; - var - V: TVarRec; - Intf: IToString; - begin - V := Args[Index]; - if (V.VInteger = 0) and - (V.VType in [vtExtended, vtString, vtObject, vtClass, vtCurrency, - vtInterface, vtInt64]) then - raise ArgumentNullException.CreateResFmt(@RsArgumentIsNull, [Index]); - - case V.VType of - vtInteger: - Result := IntToStr(V.VInteger); - vtBoolean: - Result := BoolToStr[V.VBoolean]; - vtChar: - Result := string(AnsiString(V.VChar)); - vtExtended: - Result := FloatToStr(V.VExtended^); - vtString: - Result := string(V.VString^); - vtPointer: - Result := IntToHex(TJclAddr(V.VPointer), 8); - vtPChar: - Result := string(AnsiString(V.VPChar)); - vtObject: - if (V.VObject is TInterfacedObject) and V.VObject.GetInterface(IToString, Intf) then - begin - Result := Intf.ToString; - Pointer(Intf) := nil; // do not release the object - // undo the RefCount change - Dec(TInterfacedObjectAccess(V.VObject).FRefCount); - end - else - if ((V.VObject is TComponent) or (V.VObject is TInterfacedPersistent)) and V.VObject.GetInterface(IToString, Intf) then - Result := Intf.ToString - {$IFDEF RTL200_UP} - else - Result := V.VObject.ToString; - {$ELSE} - else - raise ArgumentNullException.CreateResFmt(@RsDotNetFormatObjectArgumentNotSupported, [V.VObject.ClassName, Index]); - {$ENDIF RTL200_UP} - vtClass: - Result := V.VClass.ClassName; - vtWideChar: - Result := V.VWideChar; - vtPWideChar: - Result := V.VPWideChar; - vtAnsiString: - Result := string(V.VAnsiString); - vtCurrency: - Result := CurrToStr(V.VCurrency^); - vtVariant: - Result := GetStringOf(TVarData(V.VVariant^), Index); - vtInterface: - if IInterface(V.VInterface).QueryInterface(IToString, Intf) = 0 then - Result := IToString(Intf).ToString - else - raise ArgumentNullException.CreateResFmt(@RsDotNetFormatArgumentNotSupported, [Index]); - vtWideString: - Result := WideString(V.VWideString); - vtInt64: - Result := IntToStr(V.VInt64^); - {$IFDEF SUPPORTS_UNICODE_STRING} - vtUnicodeString: - Result := UnicodeString(V.VUnicodeString); - {$ENDIF SUPPORTS_UNICODE_STRING} - else - raise ArgumentNullException.CreateResFmt(@RsDotNetFormatArgumentNotSupported, [Index]); - end; - end; - -begin - if Length(Args) = 0 then - begin - Result := Fmt; - Exit; - end; - Len := 0; - Capacity := Length(Fmt); - SetLength(Result, Capacity); - if Capacity = 0 then - raise ArgumentNullException.CreateRes(@RsDotNetFormatNullFormat); - - P := Pointer(Fmt); - F := P; - while True do - begin - if (P[0] = #0) or (P[0] = '{') then - begin - Count := P - F; - Inc(P); - if (P[-1] <> #0) and (P[0] = '{') then - Inc(Count); // include '{' - - if Count > 0 then - begin - Grow(Count); - MoveChar(F[0], Result[Len + 1], Count); - Inc(Len, Count); - end; - - if P[-1] = #0 then - Break; - - if P[0] <> '{' then - begin - F := P; - Inc(P); - while (P[0] <> #0) and (P[0] <> '}') do - Inc(P); - SetString(S, F, P - F); - Val(S, Index, ErrorCode); - if ErrorCode <> 0 then - raise FormatException.CreateRes(@RsFormatException); - if (Index < 0) or (Index > High(Args)) then - raise FormatException.CreateRes(@RsFormatException); - S := GetStringOf(Index); - if S <> '' then - begin - Grow(Length(S)); - MoveChar(S[1], Result[Len + 1], Length(S)); - Inc(Len, Length(S)); - end; - - if P[0] = #0 then - Break; - end; - F := P + 1; - end - else - if (P[0] = '}') and (P[1] = '}') then - begin - Count := P - F + 1; - Inc(P); // skip next '}' - - Grow(Count); - MoveChar(F[0], Result[Len + 1], Count); - Inc(Len, Count); - F := P + 1; - end; - - Inc(P); - end; - - SetLength(Result, Len); -end; - -//=== { TJclStringBuilder } ===================================================== - -constructor TJclStringBuilder.Create(Capacity: SizeInt; MaxCapacity: SizeInt); -begin - inherited Create; - SetLength(FChars, Capacity); - FMaxCapacity := MaxCapacity; -end; - -constructor TJclStringBuilder.Create(const Value: string; Capacity: SizeInt); -begin - Create(Capacity); - Append(Value); -end; - -constructor TJclStringBuilder.Create(const Value: string; StartIndex, Length, Capacity: SizeInt); -begin - Create(Capacity); - Append(Value, StartIndex + 1, Length); -end; - -function TJclStringBuilder.ToString: string; -begin - if FLength > 0 then - SetString(Result, PChar(@FChars[0]), FLength) - else - Result := ''; -end; - -function TJclStringBuilder.EnsureCapacity(Capacity: SizeInt): SizeInt; -begin - if System.Length(FChars) < Capacity then - SetCapacity(Capacity); - Result := System.Length(FChars); -end; - -procedure TJclStringBuilder.Clear; -begin - Length := 0; -end; - -procedure TJclStringBuilder.SetCapacity(const Value: SizeInt); -begin - if Value <> System.Length(FChars) then - begin - SetLength(FChars, Value); - if Value < FLength then - FLength := Value; - end; -end; - -function TJclStringBuilder.GetChars(Index: SizeInt): Char; -begin - Result := FChars[Index]; -end; - -procedure TJclStringBuilder.SetChars(Index: SizeInt; const Value: Char); -begin - FChars[Index] := Value; -end; - -procedure TJclStringBuilder.Set_Length(const Value: SizeInt); -begin - FLength := Value; -end; - -function TJclStringBuilder.GetCapacity: SizeInt; -begin - Result := System.Length(FChars); -end; - -function TJclStringBuilder.AppendPChar(Value: PChar; Count: SizeInt; RepeatCount: SizeInt): TJclStringBuilder; -var - Capacity: SizeInt; -begin - if (Count > 0) and (RepeatCount > 0) then - begin - repeat - Capacity := System.Length(FChars); - if Capacity + Count > MaxCapacity then - raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange); - if Capacity < FLength + Count then - SetLength(FChars, Capacity * 5 div 3 + Count); - if Count = 1 then - FChars[FLength] := Value[0] - else - MoveChar(Value[0], FChars[FLength], Count); - Inc(FLength, Count); - Dec(RepeatCount); - until RepeatCount <= 0; - end; - Result := Self; -end; - -function TJclStringBuilder.InsertPChar(Index: SizeInt; Value: PChar; Count, - RepeatCount: SizeInt): TJclStringBuilder; -var - Capacity: SizeInt; -begin - if (Index < 0) or (Index > FLength) then - raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange); - - if Index = FLength then - AppendPChar(Value, Count, RepeatCount) - else - if (Count > 0) and (RepeatCount > 0) then - begin - repeat - Capacity := System.Length(FChars); - if Capacity + Count > MaxCapacity then - raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange); - if Capacity < FLength + Count then - SetLength(FChars, Capacity * 5 div 3 + Count); - MoveChar(FChars[Index], FChars[Index + Count], FLength - Index); - if Count = 1 then - FChars[Index] := Value[0] - else - MoveChar(Value[0], FChars[Index], Count); - Inc(FLength, Count); - - Dec(RepeatCount); - - Inc(Index, Count); // little optimization - until RepeatCount <= 0; - end; - Result := Self; -end; - -function TJclStringBuilder.Append(const Value: array of Char): TJclStringBuilder; -var - Len: SizeInt; -begin - Len := System.Length(Value); - if Len > 0 then - AppendPChar(@Value[0], Len); - Result := Self; -end; - -function TJclStringBuilder.Append(const Value: array of Char; StartIndex, Length: SizeInt): TJclStringBuilder; -var - Len: SizeInt; -begin - Len := System.Length(Value); - if (Length > 0) and (StartIndex < Len) then - begin - if StartIndex + Length > Len then - Length := Len - StartIndex; - AppendPChar(PChar(@Value[0]) + StartIndex, Length); - end; - Result := Self; -end; - -function TJclStringBuilder.Append(Value: Char; RepeatCount: SizeInt = 1): TJclStringBuilder; -begin - Result := AppendPChar(@Value, 1, RepeatCount); -end; - -function TJclStringBuilder.Append(const Value: string): TJclStringBuilder; -var - Len: SizeInt; -begin - Len := System.Length(Value); - if Len > 0 then - AppendPChar(Pointer(Value), Len); - Result := Self; -end; - -function TJclStringBuilder.Append(const Value: string; StartIndex, Length: SizeInt): TJclStringBuilder; -var - Len: SizeInt; -begin - Len := System.Length(Value); - if (Length > 0) and (StartIndex < Len) then - begin - if StartIndex + Length > Len then - Length := Len - StartIndex; - AppendPChar(PChar(Pointer(Value)) + StartIndex, Length); - end; - Result := Self; -end; - -function TJclStringBuilder.Append(Value: Boolean): TJclStringBuilder; -begin - Result := Append(BoolToStr[Value]); -end; - -function TJclStringBuilder.Append(Value: Cardinal): TJclStringBuilder; -begin - Result := Append(IntToStr(Value)); -end; - -function TJclStringBuilder.Append(Value: Integer): TJclStringBuilder; -begin - Result := Append(IntToStr(Value)); -end; - -function TJclStringBuilder.Append(Value: Double): TJclStringBuilder; -begin - Result := Append(FloatToStr(Value)); -end; - -function TJclStringBuilder.Append(Value: Int64): TJclStringBuilder; -begin - Result := Append(IntToStr(Value)); -end; - -function TJclStringBuilder.Append(Obj: TObject): TJclStringBuilder; -begin - Result := Append(DotNetFormat('{0}', [Obj])); -end; - -function TJclStringBuilder.AppendFormat(const Fmt: string; Arg0: Variant): TJclStringBuilder; -begin - Result := Append(DotNetFormat(Fmt, [Arg0])); -end; - -function TJclStringBuilder.AppendFormat(const Fmt: string; Arg0, Arg1: Variant): TJclStringBuilder; -begin - Result := Append(DotNetFormat(Fmt, [Arg0, Arg1])); -end; - -function TJclStringBuilder.AppendFormat(const Fmt: string; Arg0, Arg1, Arg2: Variant): TJclStringBuilder; -begin - Result := Append(DotNetFormat(Fmt, [Arg0, Arg1, Arg2])); -end; - -function TJclStringBuilder.AppendFormat(const Fmt: string; const Args: array of const): TJclStringBuilder; -begin - Result := Append(DotNetFormat(Fmt, Args)); -end; - -function TJclStringBuilder.Insert(Index: SizeInt; const Value: array of Char): TJclStringBuilder; -var - Len: SizeInt; -begin - Len := System.Length(Value); - if Len > 0 then - InsertPChar(Index, @Value[0], Len); - Result := Self; -end; - -function TJclStringBuilder.Insert(Index: SizeInt; const Value: string; Count: SizeInt): TJclStringBuilder; -var - Len: SizeInt; -begin - Len := System.Length(Value); - if Len > 0 then - InsertPChar(Index, Pointer(Value), Len, Count); - Result := Self; -end; - -function TJclStringBuilder.Insert(Index: SizeInt; Value: Boolean): TJclStringBuilder; -begin - Result := Insert(Index, BoolToStr[Value]); -end; - -function TJclStringBuilder.Insert(Index: SizeInt; const Value: array of Char; - StartIndex, Length: SizeInt): TJclStringBuilder; -var - Len: SizeInt; -begin - Len := System.Length(Value); - if (Length > 0) and (StartIndex < Len) then - begin - if StartIndex + Length > Len then - Length := Len - StartIndex; - InsertPChar(Index, PChar(@Value[0]) + StartIndex, Length); - end; - Result := Self; -end; - -function TJclStringBuilder.Insert(Index: SizeInt; Value: Double): TJclStringBuilder; -begin - Result := Insert(Index, FloatToStr(Value)); -end; - -function TJclStringBuilder.Insert(Index: SizeInt; Value: Int64): TJclStringBuilder; -begin - Result := Insert(Index, IntToStr(Value)); -end; - -function TJclStringBuilder.Insert(Index: SizeInt; Value: Cardinal): TJclStringBuilder; -begin - Result := Insert(Index, IntToStr(Value)); -end; - -function TJclStringBuilder.Insert(Index: SizeInt; Value: Integer): TJclStringBuilder; -begin - Result := Insert(Index, IntToStr(Value)); -end; - -function TJclStringBuilder.Insert(Index: SizeInt; Obj: TObject): TJclStringBuilder; -begin - Result := Insert(Index, DotNetFormat('{0}', [Obj])); -end; - -function TJclStringBuilder.Remove(StartIndex, Length: SizeInt): TJclStringBuilder; -begin - if (StartIndex < 0) or (Length < 0) or (StartIndex + Length >= FLength) then - raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange); - if Length > 0 then - begin - MoveChar(FChars[StartIndex + Length], FChars[StartIndex], FLength - (StartIndex + Length)); - Dec(FLength, Length); - end; - Result := Self; -end; - -function TJclStringBuilder.Replace(OldChar, NewChar: Char; StartIndex, - Count: SizeInt): TJclStringBuilder; -var - I: SizeInt; -begin - if Count = -1 then - Count := FLength; - if (StartIndex < 0) or (Count < 0) or (StartIndex + Count > FLength) then - raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange); - if (Count > 0) and (OldChar <> NewChar) then - begin - for I := StartIndex to StartIndex + Length - 1 do - if FChars[I] = OldChar then - FChars[I] := NewChar; - end; - Result := Self; -end; - -function TJclStringBuilder.Replace(OldValue, NewValue: string; StartIndex, Count: SizeInt): TJclStringBuilder; -var - I: SizeInt; - Offset: SizeInt; - NewLen, OldLen, Capacity: SizeInt; -begin - if Count = -1 then - Count := FLength; - if (StartIndex < 0) or (Count < 0) or (StartIndex + Count > FLength) then - raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange); - if OldValue = '' then - raise ArgumentException.CreateResFmt(@RsArgumentIsNull, [0]); - - if (Count > 0) and (OldValue <> NewValue) then - begin - OldLen := System.Length(OldValue); - NewLen := System.Length(NewValue); - Offset := NewLen - OldLen; - Capacity := System.Length(FChars); - for I := StartIndex to StartIndex + Length - 1 do - if FChars[I] = OldValue[1] then - begin - if OldLen > 1 then - if StrLComp(@FChars[I + 1], PChar(OldValue) + 1, OldLen - 1) <> 0 then - Continue; - if Offset <> 0 then - begin - if FLength - OldLen + NewLen > MaxCurrency then - raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange); - if Capacity < FLength + Offset then - begin - Capacity := Capacity * 5 div 3 + Offset; - SetLength(FChars, Capacity); - end; - if Offset < 0 then - MoveChar(FChars[I - Offset], FChars[I], FLength - I) - else - MoveChar(FChars[I + OldLen], FChars[I + OldLen + Offset], FLength - OldLen - I); - Inc(FLength, Offset); - end; - if NewLen > 0 then - begin - if (OldLen = 1) and (NewLen = 1) then - FChars[I] := NewValue[1] - else - MoveChar(NewValue[1], FChars[I], NewLen); - end; - end; - end; - Result := Self; -end; - -function StrExpandTabs(S: string): string; -begin - // use an empty tab set, which will default to a tab width of 2 - Result := TJclTabSet(nil).Expand(s); -end; - -function StrExpandTabs(S: string; TabWidth: SizeInt): string; -var - TabSet: TJclTabSet; -begin - // create a tab set with no tab stops and the given tab width - TabSet := TJclTabSet.Create(TabWidth); - try - Result := TabSet.Expand(S); - finally - TabSet.Free; - end; -end; - -function StrExpandTabs(S: string; TabSet: TJclTabSet): string; -begin - // use the provided tab set to perform the expansion - Result := TabSet.Expand(S); -end; - -function StrOptimizeTabs(S: string): string; -begin - // use an empty tab set, which will default to a tab width of 2 - Result := TJclTabSet(nil).Optimize(s); -end; - -function StrOptimizeTabs(S: string; TabWidth: SizeInt): string; -var - TabSet: TJclTabSet; -begin - // create a tab set with no tab stops and the given tab width - TabSet := TJclTabSet.Create(TabWidth); - try - Result := TabSet.Optimize(S); - finally - TabSet.Free; - end; -end; - -function StrOptimizeTabs(S: string; TabSet: TJclTabSet): string; -begin - // use the provided tab set to perform the optimization - Result := TabSet.Optimize(S); -end; - -// === { TTabSetData } =================================================== - -type - TTabSetData = class - public - FStops: TDynSizeIntArray; - FRealWidth: SizeInt; - FRefCount: SizeInt; - FWidth: SizeInt; - FZeroBased: Boolean; - constructor Create(TabStops: array of SizeInt; ZeroBased: Boolean; TabWidth: SizeInt); - - function Add(Column: SizeInt): SizeInt; - function AddRef: SizeInt; - procedure CalcRealWidth; - function FindStop(Column: SizeInt): SizeInt; - function ReleaseRef: SizeInt; - procedure RemoveAt(Index: SizeInt); - procedure SetStops(Index, Value: SizeInt); - end; - -constructor TTabSetData.Create(TabStops: array of SizeInt; ZeroBased: Boolean; TabWidth: SizeInt); -var - idx: SizeInt; -begin - inherited Create; - FRefCount := 1; - for idx := 0 to High(Tabstops) do - Add(Tabstops[idx]); - FWidth := TabWidth; - FZeroBased := ZeroBased; - CalcRealWidth; -end; - -function TTabSetData.Add(Column: SizeInt): SizeInt; -var - I: SizeInt; -begin - if Column < Ord(FZeroBased) then - raise ArgumentOutOfRangeException.Create('Column'); - Result := FindStop(Column); - if Result < 0 then - begin - // the column doesn't exist; invert the result of FindStop to get the correct index position - Result := not Result; - // increase the tab stop array - SetLength(FStops, Length(FStops) + 1); - // shift rooms after the insert position - for I := High(FStops) - 1 downto Result do - FStops[I + 1] := FStops[I]; - // add the tab stop at the correct location - FStops[Result] := Column; - CalcRealWidth; - end - else - begin - raise EJclStringError.CreateRes(@RsTabs_DuplicatesNotAllowed); - end; -end; - -function TTabSetData.AddRef: SizeInt; -begin - Result := LockedInc(FRefCount); -end; - -procedure TTabSetData.CalcRealWidth; -begin - if FWidth < 1 then - begin - if Length(FStops) > 1 then - FRealWidth := FStops[High(FStops)] - FStops[Pred(High(FStops))] - else - if Length(FStops) = 1 then - FRealWidth := FStops[0] - else - FRealWidth := 2; - end - else - FRealWidth := FWidth; -end; - -function TTabSetData.FindStop(Column: SizeInt): SizeInt; -begin - Result := High(FStops); - while (Result >= 0) and (FStops[Result] > Column) do - Dec(Result); - if (Result >= 0) and (FStops[Result] <> Column) then - Result := not Succ(Result); -end; - -function TTabSetData.ReleaseRef: SizeInt; -begin - Result := LockedDec(FRefCount); - if Result <= 0 then - Destroy; -end; - -procedure TTabSetData.RemoveAt(Index: SizeInt); -var - I: SizeInt; -begin - for I := Index to High(FStops) - 1 do - FStops[I] := FStops[I + 1]; - SetLength(FStops, High(FStops)); - CalcRealWidth; -end; - -procedure TTabSetData.SetStops(Index, Value: SizeInt); -var - temp: SizeInt; -begin - if (Index < 0) or (Index >= Length(FStops)) then - begin - raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange); - end - else - begin - temp := FindStop(Value); - if temp < 0 then - begin - // remove existing tab stop... - RemoveAt(Index); - // now add the new tab stop - Add(Value); - end - else - if temp <> Index then - begin - // new tab stop already present at another index - raise EJclStringError.CreateRes(@RsTabs_DuplicatesNotAllowed); - end; - end; -end; - -//=== { TJclTabSet } ===================================================== - -constructor TJclTabSet.Create; -begin - // no tab stops, tab width set to auto - Create([], True, 0); -end; - -constructor TJclTabSet.Create(TabWidth: SizeInt); -begin - // no tab stops, specified tab width - Create([], True, TabWidth); -end; - -constructor TJclTabSet.Create(const Tabstops: array of SizeInt; ZeroBased: Boolean); -begin - // specified tab stops, tab width equal to distance between last two tab stops - Create(Tabstops, ZeroBased, 0); -end; - -constructor TJclTabSet.Create(const Tabstops: array of SizeInt; ZeroBased: Boolean; TabWidth: SizeInt); -begin - inherited Create; - FData := TTabSetData.Create(Tabstops, ZeroBased, TabWidth); -end; - -constructor TJclTabSet.Create(Data: TObject); -begin - inherited Create; - // add a reference to the data - TTabSetData(Data).AddRef; - // assign the data to this instance - FData := TTabSetData(Data); -end; - -destructor TJclTabSet.Destroy; -begin - // release the reference to the tab set data - TTabSetData(FData).ReleaseRef; - // make sure we won't accidentally refer to it later, just in case something goes wrong during destruction - FData := nil; - // really destroy the instance - inherited Destroy; -end; - -function TJclTabSet.Add(Column: SizeInt): SizeInt; -begin - if Self = nil then - raise NullReferenceException.Create; - Result := TTabSetData(FData).Add(Column); -end; - -function TJclTabSet.Clone: TJclTabSet; -begin - if Self <> nil then - Result := TJclTabSet.Create(TTabSetData(FData).FStops, TTabSetData(FData).FZeroBased, TTabSetData(FData).FWidth) - else - Result := nil; -end; - -function TJclTabSet.Delete(Column: SizeInt): SizeInt; -begin - Result := TTabSetData(FData).FindStop(Column); - if Result >= 0 then - TTabSetData(FData).RemoveAt(Result); -end; - -function TJclTabSet.Expand(const S: string): string; -begin - Result := Expand(s, StartColumn); -end; - -function TJclTabSet.Expand(const S: string; Column: SizeInt): string; -var - sb: TJclStringBuilder; - head: PChar; - cur: PChar; -begin - if Column < StartColumn then - raise ArgumentOutOfRangeException.Create('Column'); - sb := TJclStringBuilder.Create(Length(S)); - try - cur := PChar(S); - while cur^ <> #0 do - begin - head := cur; - while (cur^ <> #0) and (cur^ <> #9) do - begin - if CharIsReturn(cur^) then - Column := StartColumn - else - Inc(Column); - Inc(cur); - end; - if cur > head then - sb.Append(head, 0, cur - head); - if cur^ = #9 then - begin - sb.Append(' ', TabFrom(Column) - Column); - Column := TabFrom(Column); - Inc(cur); - end; - end; - Result := sb.ToString; - finally - sb.Free; - end; -end; - -function TJclTabSet.FindStop(Column: SizeInt): SizeInt; -begin - if Self <> nil then - Result := TTabSetData(FData).FindStop(Column) - else - Result := -1; -end; - -class function TJclTabSet.FromString(const S: string): TJclTabSet; -var - cur: PChar; - - function ParseNumber: Integer; - var - head: PChar; - begin - StrSkipChars(cur, CharIsWhiteSpace); - head := cur; - while CharIsDigit(cur^) do - Inc(cur); - Result := -1; - if (cur <= head) or not TryStrToInt(Copy(head, 1, cur - head), Result) then - Result := -1; - end; - - procedure ParseStops; - var - openBracket, hadComma: Boolean; - num: SizeInt; - begin - StrSkipChars(cur, CharIsWhiteSpace); - openBracket := cur^ = '['; - hadComma := False; - if openBracket then - Inc(cur); - repeat - num := ParseNumber; - if (num < 0) and hadComma then - raise EJclStringError.CreateRes(@RsTabs_StopExpected) - else - if num >= 0 then - Result.Add(num); - StrSkipChars(cur, CharIsWhiteSpace); - hadComma := cur^ = ','; - if hadComma then - Inc(cur); - until (cur^ = #0) or (cur^ = '+') or (cur^ = ']'); - if hadComma then - raise EJclStringError.CreateRes(@RsTabs_StopExpected) - else - if openBracket and (cur^ <> ']') then - raise EJclStringError.CreateRes(@RsTabs_CloseBracketExpected); - end; - - procedure ParseTabWidth; - var - num: SizeInt; - begin - StrSkipChars(cur, CharIsWhiteSpace); - if cur^ = '+' then - begin - Inc(cur); - StrSkipChars(cur, CharIsWhiteSpace); - num := ParseNumber; - if (num < 0) then - raise EJclStringError.CreateRes(@RsTabs_TabWidthExpected) - else - Result.TabWidth := num; - end; - end; - - procedure ParseZeroBasedFlag; - begin - StrSkipChars(cur, CharIsWhiteSpace); - if cur^ = '0' then - begin - Inc(cur); - if CharIsWhiteSpace(cur^) or (cur^ = #0) or (cur^ = '[') then - begin - Result.ZeroBased := True; - StrSkipChars(cur, CharIsWhiteSpace); - end - else - Dec(cur); - end; - end; - -begin - Result := TJclTabSet.Create; - try - Result.ZeroBased := False; - cur := PChar(S); - ParseZeroBasedFlag; - ParseStops; - ParseTabWidth; - except - // clean up the partially complete instance (to avoid memory leaks)... - Result.Free; - // ... and re-raise the exception - raise; - end; -end; - -function TJclTabSet.GetCount: SizeInt; -begin - if Self <> nil then - Result := Length(TTabSetData(FData).FStops) - else - Result := 0; -end; - -function TJclTabSet.GetStops(Index: SizeInt): SizeInt; -begin - if Self <> nil then - begin - if (Index < 0) or (Index >= Length(TTabSetData(FData).FStops)) then - begin - raise EJclStringError.CreateRes(@RsArgumentOutOfRange); - end - else - Result := TTabSetData(FData).FStops[Index]; - end - else - begin - raise EJclStringError.CreateRes(@RsArgumentOutOfRange); - end; -end; - -function TJclTabSet.GetTabWidth: SizeInt; -begin - if Self <> nil then - Result := TTabSetData(FData).FWidth - else - Result := 0; -end; - -function TJclTabSet.GetZeroBased: Boolean; -begin - Result := (Self = nil) or TTabSetData(FData).FZeroBased; -end; - -procedure TJclTabSet.OptimalFillInfo(StartColumn, TargetColumn: SizeInt; out TabsNeeded, SpacesNeeded: SizeInt); -var - nextTab: SizeInt; -begin - if StartColumn < Self.StartColumn then // starting column less than 1 or 0 (depending on ZeroBased state) - raise ArgumentOutOfRangeException.Create('StartColumn'); - if (TargetColumn < StartColumn) then // target lies before the starting column - raise ArgumentOutOfRangeException.Create('TargetColumn'); - TabsNeeded := 0; - repeat - nextTab := TabFrom(StartColumn); - if nextTab <= TargetColumn then - begin - Inc(TabsNeeded); - StartColumn := nextTab; - end; - until nextTab > TargetColumn; - SpacesNeeded := TargetColumn - StartColumn; -end; - -function TJclTabSet.Optimize(const S: string): string; -begin - Result := Optimize(S, StartColumn); -end; - -function TJclTabSet.Optimize(const S: string; Column: SizeInt): string; -var - sb: TJclStringBuilder; - head: PChar; - cur: PChar; - tgt: SizeInt; - - procedure AppendOptimalWhiteSpace(Target: SizeInt); - var - tabCount: SizeInt; - spaceCount: SizeInt; - begin - if cur > head then - begin - OptimalFillInfo(Column, Target, tabCount, spaceCount); - if tabCount > 0 then - sb.Append(#9, tabCount); - if spaceCount > 0 then - sb.Append(' ', spaceCount); - end; - end; - -begin - if Column < StartColumn then - raise ArgumentOutOfRangeException.Create('Column'); - sb := TJclStringBuilder.Create(Length(S)); - try - cur := PChar(s); - while cur^ <> #0 do - begin - // locate first whitespace character - head := cur; - while (cur^ <> #0) and not CharIsWhiteSpace(cur^) do - Inc(cur); - // output non whitespace characters - if cur > head then - sb.Append(head, 0, cur - head); - // advance column - Inc(Column, cur - head); - // initialize target column indexer - tgt := Column; - // locate end of whitespace sequence - while CharIsWhiteSpace(cur^) do - begin - if CharIsReturn(cur^) then - begin - // append optimized whitespace sequence... - AppendOptimalWhiteSpace(tgt); - // ...set the column back to the start of the line... - Column := StartColumn; - // ...reset target column indexer... - tgt := Column; - // ...add the line break character... - sb.Append(cur^); - end - else - if cur^ = #9 then - tgt := TabFrom(tgt) // expand the tab - else - Inc(tgt); // a normal whitespace; taking up 1 column - Inc(cur); - end; - AppendOptimalWhiteSpace(tgt); // append optimized whitespace sequence... - Column := tgt; // ...and memorize the column for the next iteration - end; - Result := sb.ToString; // convert result to a string - finally - sb.Free; - end; -end; - -procedure TJclTabSet.RemoveAt(Index: SizeInt); -begin - if Self <> nil then - TTabSetData(FData).RemoveAt(Index) - else - raise NullReferenceException.Create; -end; - -procedure TJclTabSet.SetStops(Index, Value: SizeInt); -begin - if Self <> nil then - TTabSetData(FData).SetStops(Index, Value) - else - raise NullReferenceException.Create; -end; - -procedure TJclTabSet.SetTabWidth(Value: SizeInt); -begin - if Self <> nil then - begin - TTabSetData(FData).FWidth := Value; - TTabSetData(FData).CalcRealWidth; - end - else - raise NullReferenceException.Create; -end; - -procedure TJclTabSet.SetZeroBased(Value: Boolean); -var - shift: SizeInt; - idx: SizeInt; -begin - if Self <> nil then - begin - if Value <> TTabSetData(FData).FZeroBased then - begin - TTabSetData(FData).FZeroBased := Value; - if Value then - shift := -1 - else - shift := 1; - for idx := 0 to High(TTabSetData(FData).FStops) do - TTabSetData(FData).FStops[idx] := TTabSetData(FData).FStops[idx] + shift; - end; - end - else - raise NullReferenceException.Create; -end; - -function TJclTabSet.InternalTabStops: TDynSizeIntArray; -begin - if Self <> nil then - Result := TTabSetData(FData).FStops - else - Result := nil; -end; - -function TJclTabSet.InternalTabWidth: SizeInt; -begin - if Self <> nil then - Result := TTabSetData(FData).FRealWidth - else - Result := 2; -end; - -function TJclTabSet.NewReference: TJclTabSet; -begin - if Self <> nil then - Result := TJclTabSet.Create(FData) - else - Result := nil; -end; - -function TJclTabSet.StartColumn: SizeInt; -begin - if GetZeroBased then - Result := 0 - else - Result := 1; -end; - -function TJclTabSet.TabFrom(Column: SizeInt): SizeInt; -begin - if Column < StartColumn then - raise ArgumentOutOfRangeException.Create('Column'); - Result := FindStop(Column); - if Result < 0 then - Result := not Result - else - Inc(Result); - if Result >= GetCount then - begin - if GetCount > 0 then - Result := TTabSetData(FData).FStops[High(TTabSetData(FData).FStops)] - else - Result := StartColumn; - while Result <= Column do - Inc(Result, ActualTabWidth); - end - else - Result := TTabSetData(FData).FStops[Result]; -end; - -function TJclTabSet.ToString: string; -begin - Result := ToString(TabSetFormatting_Full); -end; - -function TJclTabSet.ToString(FormattingOptions: SizeInt): string; -var - sb: TJclStringBuilder; - idx: SizeInt; - - function WantBrackets: Boolean; - begin - Result := (TabSetFormatting_SurroundStopsWithBrackets and FormattingOptions) <> 0; - end; - - function EmptyBrackets: Boolean; - begin - Result := (TabSetFormatting_EmptyBracketsIfNoStops and FormattingOptions) <> 0; - end; - - function IncludeAutoWidth: Boolean; - begin - Result := (TabSetFormatting_AutoTabWidth and FormattingOptions) <> 0; - end; - - function IncludeTabWidth: Boolean; - begin - Result := (TabSetFormatting_NoTabWidth and FormattingOptions) = 0; - end; - - function IncludeStops: Boolean; - begin - Result := (TabSetFormatting_NoTabStops and FormattingOptions) = 0; - end; - -begin - sb := TJclStringBuilder.Create; - try - // output the fixed tabulation positions if requested... - if IncludeStops then - begin - // output each individual tabulation position - for idx := 0 to GetCount - 1 do - begin - sb.Append(TabStops[idx]); - sb.Append(','); - end; - // remove the final comma if any tabulation positions where outputted - if sb.Length <> 0 then - sb.Remove(sb.Length - 1, 1); - // bracket the tabulation positions if requested - if WantBrackets and (EmptyBrackets or (sb.Length > 0)) then - begin - sb.Insert(0, '['); - sb.Append(']'); - end; - end; - // output the tab width if requested.... - if IncludeTabWidth and (IncludeAutoWidth or (TabWidth > 0)) then - begin - // separate the tab width from any outputted tabulation positions with a whitespace - if sb.Length > 0 then - sb.Append(' '); - // flag tab width - sb.Append('+'); - // finally, output the tab width - sb.Append(ActualTabWidth); - end; - // flag zero-based tabset by outputting a 0 (zero) as the first character. - if ZeroBased then - sb.Insert(0, string('0 ')); - Result := StrTrimCharRight(sb.ToString, ' '); - finally - sb.Free; - end; -end; - -function TJclTabSet.UpdatePosition(const S: string): SizeInt; -var - Line: SizeInt; -begin - Result := StartColumn; - Line := -1; - UpdatePosition(S, Result, Line); -end; - -function TJclTabSet.UpdatePosition(const S: string; Column: SizeInt): SizeInt; -var - Line: SizeInt; -begin - if Column < StartColumn then - raise ArgumentOutOfRangeException.Create('Column'); - Result := Column; - Line := -1; - UpdatePosition(S, Result, Line); -end; - -function TJclTabSet.UpdatePosition(const S: string; var Column, Line: SizeInt): SizeInt; -var - prevChar: Char; - cur: PChar; -begin - if Column < StartColumn then - raise ArgumentOutOfRangeException.Create('Column'); - // initialize loop - cur := PChar(S); - // iterate until end of string (the Null-character) - while cur^ <> #0 do - begin - // check for line-breaking characters - if CharIsReturn(cur^) then - begin - // Column moves back all the way to the left - Column := StartColumn; - // If this is the first line-break character or the same line-break character, increment the Line parameter - Inc(Line); - // check if it's the first of a two-character line-break - prevChar := cur^; - Inc(cur); - // if it isn't a two-character line-break, undo the previous advancement - if (cur^ = prevChar) or not CharIsReturn(cur^) then - Dec(cur); - end - else // check for tab character and expand it - if cur^ = #9 then - Column := TabFrom(Column) - else // a normal character; increment column - Inc(Column); - // advance pointer - Inc(cur); - end; - // set the result to the newly calculated column - Result := Column; -end; - -//=== { NullReferenceException } ============================================= - -constructor NullReferenceException.Create; -begin - CreateRes(@RsArg_NullReferenceException); -end; - -function CompareNatural(const S1, S2: string; CaseInsensitive: Boolean): SizeInt; -var - Cur1, Len1, - Cur2, Len2: SizeInt; - - function IsRealNumberChar(ch: Char): Boolean; - begin - Result := ((ch >= '0') and (ch <= '9')) or (ch = '-') or (ch = '+'); - end; - - procedure NumberCompare; - var - IsReallyNumber: Boolean; - FirstDiffBreaks: Boolean; - Val1, Val2: SizeInt; - begin - Result := 0; - IsReallyNumber := False; - // count leading spaces in S1 - while (Cur1 <= Len1) and CharIsWhiteSpace(S1[Cur1]) do - begin - Dec(Result); - Inc(Cur1); - end; - // count leading spaces in S2 (canceling them out against the ones in S1) - while (Cur2 <= Len2) and CharIsWhiteSpace(S2[Cur2]) do - begin - Inc(Result); - Inc(Cur2); - end; - - // if spaces match, or both strings are actually followed by a numeric character, continue the checks - if (Result = 0) or ((Cur1 <= Len1) and CharIsNumberChar(S1[Cur1]) and (Cur2 <= Len2) and CharIsNumberChar(S2[Cur2])) then - begin - // Check signed number - if (Cur1 <= Len1) and (S1[Cur1] = '-') and ((Cur2 > Len2) or (S2[Cur2] <> '-')) then - Result := 1 - else - if (Cur2 <= Len2) and (S2[Cur2] = '-') and ((Cur1 > Len1) or (S1[Cur1] <> '-')) then - Result := -1 - else - Result := 0; - - if (Cur1 <= Len1) and ((S1[Cur1] = '-') or (S1[Cur1] = '+')) then - Inc(Cur1); - if (Cur2 <= Len2) and ((S2[Cur2] = '-') or (S2[Cur2] = '+')) then - Inc(Cur2); - - FirstDiffBreaks := (Cur1 <= Len1) and (S1[Cur1] = '0') or (Cur2 <= Len2) and (S2[Cur2] = '0'); - while (Cur1 <= Len1) and CharIsDigit(S1[Cur1]) and (Cur2 <= Len2) and CharIsDigit(S2[Cur2]) do - begin - IsReallyNumber := True; - Val1 := StrToInt(S1[Cur1]); - Val2 := StrToInt(S2[Cur2]); - - if (Result = 0) and (Val1 < Val2) then - Result := -1 - else - if (Result = 0) and (Val1 > Val2) then - Result := 1; - if FirstDiffBreaks and (Result <> 0) then - Break; - Inc(Cur1); - Inc(Cur2); - end; - - if IsReallyNumber then - begin - if not FirstDiffBreaks then - begin - if (Cur1 <= Len1) and CharIsDigit(S1[Cur1]) then - Result := 1 - else - if (Cur2 <= Len2) and CharIsDigit(S2[Cur2]) then - Result := -1; - end; - end; - end; - end; - - procedure SetByCompareLength; - var - Remain1: SizeInt; - Remain2: SizeInt; - begin - // base result on relative compare length (spaces could be ignored, so even if S1 is longer than S2, they could be - // completely equal, or S2 could be longer) - Remain1 := Len1 - Cur1 + 1; - Remain2 := Len2 - Cur2 + 1; - if Remain1 < 0 then - Remain1 := 0; - if Remain2 < 0 then - Remain2 := 0; - - if Remain1 < Remain2 then - Result := -1 - else - if Remain1 > Remain2 then - Result := 1; - end; - -begin - Cur1 := 1; - Len1 := Length(S1); - Cur2 := 1; - Len2 := Length(S2); - Result := 0; - - while (Result = 0) do - begin - if (Cur1 > Len1) or (Cur2 > Len2) then - begin - SetByCompareLength; - Break; - end - else - if (Cur1 <= Len1) and (Cur2 > Len2) then - Result := 1 - else - if (S1[Cur1] = '-') and IsRealNumberChar(S2[Cur2]) and (S2[Cur2] <> '-') then - Result := -1 - else - if (S2[Cur2] = '-') and IsRealNumberChar(S1[Cur1]) and (S1[Cur1] <> '-') then - Result := 1 - else - if (IsRealNumberChar(S1[Cur1]) or CharIsWhiteSpace(S1[Cur1])) and (IsRealNumberChar(S2[Cur2]) or CharIsWhiteSpace(S2[Cur2])) then - NumberCompare - else - begin - if CaseInsensitive then - Result := StrLIComp(PChar(@S1[Cur1]), PChar(@S2[Cur2]), 1) - else - Result := StrLComp(PChar(@S1[Cur1]), PChar(@S2[Cur2]), 1); - Inc(Cur1); - Inc(Cur2); - end; - end; -end; - -function CompareNaturalStr(const S1, S2: string): SizeInt; overload; -begin - Result := CompareNatural(S1, S2, False); -end; - -function CompareNaturalText(const S1, S2: string): SizeInt; overload; -begin - Result := CompareNatural(S1, S2, True); -end; - -initialization - {$IFNDEF UNICODE_RTL_DATABASE} - LoadCharTypes; // this table first - LoadCaseMap; // or this function does not work - {$ENDIF ~UNICODE_RTL_DATABASE} - {$IFDEF UNITVERSIONING} - RegisterUnitVersion(HInstance, UnitVersioning); - {$ENDIF UNITVERSIONING} - -{$IFDEF UNITVERSIONING} -finalization - UnregisterUnitVersion(HInstance); -{$ENDIF UNITVERSIONING} - -end. - +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclStrings.pas. } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. } +{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. All rights reserved. } +{ } +{ Contributor(s): } +{ Alexander Radchenko } +{ Andreas Hausladen (ahuser) } +{ Anthony Steele } +{ Azret Botash } +{ Barry Kelly } +{ Huanlin Tsai } +{ Jack N.A. Bakker } +{ Jean-Fabien Connault (cycocrew) } +{ John C Molyneux } +{ Kiriakos Vlahos } +{ Leonard Wennekers } +{ Marcel Bestebroer } +{ Martin Kimmings } +{ Martin Kubecka } +{ Massimo Maria Ghisalberti } +{ Matthias Thoma (mthoma) } +{ Michael Winter } +{ Nick Hodges } +{ Olivier Sannier (obones) } +{ Pelle F. S. Liljendal } +{ Petr Vones (pvones) } +{ Rik Barker (rikbarker) } +{ Robert Lee } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Andreas Schmidt } +{ Sean Farrow (sfarrow) } +{ } +{**************************************************************************************************} +{ } +{ Various character and string routines (searching, testing and transforming) } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclStrings; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Winapi.Windows, + {$ENDIF MSWINDOWS} + {$IFDEF UNICODE_RTL_DATABASE} + System.Character, + {$ENDIF UNICODE_RTL_DATABASE} + System.Classes, System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + {$IFDEF UNICODE_RTL_DATABASE} + Character, + {$ENDIF UNICODE_RTL_DATABASE} + Classes, SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclAnsiStrings, + JclWideStrings, + JclBase; + +// Exceptions +type + EJclStringError = class(EJclError); + +// Character constants and sets + +const + // Misc. often used character definitions + NativeNull = Char(#0); + NativeSoh = Char(#1); + NativeStx = Char(#2); + NativeEtx = Char(#3); + NativeEot = Char(#4); + NativeEnq = Char(#5); + NativeAck = Char(#6); + NativeBell = Char(#7); + NativeBackspace = Char(#8); + NativeTab = Char(#9); + NativeLineFeed = JclBase.NativeLineFeed; + NativeVerticalTab = Char(#11); + NativeFormFeed = Char(#12); + NativeCarriageReturn = JclBase.NativeCarriageReturn; + NativeCrLf = JclBase.NativeCrLf; + NativeSo = Char(#14); + NativeSi = Char(#15); + NativeDle = Char(#16); + NativeDc1 = Char(#17); + NativeDc2 = Char(#18); + NativeDc3 = Char(#19); + NativeDc4 = Char(#20); + NativeNak = Char(#21); + NativeSyn = Char(#22); + NativeEtb = Char(#23); + NativeCan = Char(#24); + NativeEm = Char(#25); + NativeEndOfFile = Char(#26); + NativeEscape = Char(#27); + NativeFs = Char(#28); + NativeGs = Char(#29); + NativeRs = Char(#30); + NativeUs = Char(#31); + NativeSpace = Char(' '); + NativeComma = Char(','); + NativeBackslash = Char('\'); + NativeForwardSlash = Char('/'); + + NativeDoubleQuote = Char('"'); + NativeSingleQuote = Char(''''); + + NativeLineBreak = JclBase.NativeLineBreak; + +const + // CharType return values + C1_UPPER = $0001; // Uppercase + C1_LOWER = $0002; // Lowercase + C1_DIGIT = $0004; // Decimal digits + C1_SPACE = $0008; // Space characters + C1_PUNCT = $0010; // Punctuation + C1_CNTRL = $0020; // Control characters + C1_BLANK = $0040; // Blank characters + C1_XDIGIT = $0080; // Hexadecimal digits + C1_ALPHA = $0100; // Any linguistic character: alphabetic, syllabary, or ideographic + + {$IFDEF MSWINDOWS} + {$IFDEF SUPPORTS_EXTSYM} + {$EXTERNALSYM C1_UPPER} + {$EXTERNALSYM C1_LOWER} + {$EXTERNALSYM C1_DIGIT} + {$EXTERNALSYM C1_SPACE} + {$EXTERNALSYM C1_PUNCT} + {$EXTERNALSYM C1_CNTRL} + {$EXTERNALSYM C1_BLANK} + {$EXTERNALSYM C1_XDIGIT} + {$EXTERNALSYM C1_ALPHA} + {$ENDIF SUPPORTS_EXTSYM} + {$ENDIF MSWINDOWS} + +type + TCharValidator = function(const C: Char): Boolean; + +function ArrayContainsChar(const Chars: array of Char; const C: Char): Boolean; overload; +function ArrayContainsChar(const Chars: array of Char; const C: Char; out Index: SizeInt): Boolean; overload; + +// String Test Routines +function StrIsAlpha(const S: string): Boolean; +function StrIsAlphaNum(const S: string): Boolean; +function StrIsAlphaNumUnderscore(const S: string): Boolean; +function StrContainsChars(const S: string; const Chars: TCharValidator; CheckAll: Boolean): Boolean; overload; +function StrContainsChars(const S: string; const Chars: array of Char; CheckAll: Boolean): Boolean; overload; +function StrConsistsOfNumberChars(const S: string): Boolean; +function StrIsDigit(const S: string): Boolean; +function StrIsSubset(const S: string; const ValidChars: TCharValidator): Boolean; overload; +function StrIsSubset(const S: string; const ValidChars: array of Char): Boolean; overload; +function StrSame(const S1, S2: string; CaseSensitive: Boolean = False): Boolean; + +// String Transformation Routines +function StrCenter(const S: string; L: SizeInt; C: Char = ' '): string; +function StrCharPosLower(const S: string; CharPos: SizeInt): string; +function StrCharPosUpper(const S: string; CharPos: SizeInt): string; +function StrDoubleQuote(const S: string): string; +function StrEnsureNoPrefix(const Prefix, Text: string): string; +function StrEnsureNoSuffix(const Suffix, Text: string): string; +function StrEnsurePrefix(const Prefix, Text: string): string; +function StrEnsureSuffix(const Suffix, Text: string): string; +function StrEscapedToString(const S: string): string; +function StrLower(const S: string): string; +procedure StrLowerInPlace(var S: string); +procedure StrLowerBuff(S: PChar); +procedure StrMove(var Dest: string; const Source: string; const ToIndex, + FromIndex, Count: SizeInt); +function StrPadLeft(const S: string; Len: SizeInt; C: Char = NativeSpace): string; +function StrPadRight(const S: string; Len: SizeInt; C: Char = NativeSpace): string; +function StrProper(const S: string): string; +procedure StrProperBuff(S: PChar); +function StrQuote(const S: string; C: Char): string; +function StrRemoveChars(const S: string; const Chars: TCharValidator): string; overload; +function StrRemoveChars(const S: string; const Chars: array of Char): string; overload; +function StrRemoveLeadingChars(const S: string; const Chars: TCharValidator): string; overload; +function StrRemoveLeadingChars(const S: string; const Chars: array of Char): string; overload; +function StrRemoveEndChars(const S: string; const Chars: TCharValidator): string; overload; +function StrRemoveEndChars(const S: string; const Chars: array of Char): string; overload; +function StrKeepChars(const S: string; const Chars: TCharValidator): string; overload; +function StrKeepChars(const S: string; const Chars: array of Char): string; overload; +procedure StrReplace(var S: string; const Search, Replace: string; Flags: TReplaceFlags = []); +function StrReplaceChar(const S: string; const Source, Replace: Char): string; +function StrReplaceChars(const S: string; const Chars: TCharValidator; Replace: Char): string; overload; +function StrReplaceChars(const S: string; const Chars: array of Char; Replace: Char): string; overload; +function StrReplaceButChars(const S: string; const Chars: TCharValidator; Replace: Char): string; overload; +function StrReplaceButChars(const S: string; const Chars: array of Char; Replace: Char): string; overload; +function StrRepeat(const S: string; Count: SizeInt): string; +function StrRepeatLength(const S: string; L: SizeInt): string; +function StrReverse(const S: string): string; +procedure StrReverseInPlace(var S: string); +function StrSingleQuote(const S: string): string; +procedure StrSkipChars(var S: PChar; const Chars: TCharValidator); overload; +procedure StrSkipChars(var S: PChar; const Chars: array of Char); overload; +procedure StrSkipChars(const S: string; var Index: SizeInt; const Chars: TCharValidator); overload; +procedure StrSkipChars(const S: string; var Index: SizeInt; const Chars: array of Char); overload; +function StrSmartCase(const S: string; const Delimiters: TCharValidator): string; overload; +function StrSmartCase(const S: string; const Delimiters: array of Char): string; overload; +function StrStringToEscaped(const S: string): string; +function StrStripNonNumberChars(const S: string): string; +function StrToHex(const Source: string): string; +function StrTrimCharLeft(const S: string; C: Char): string; +function StrTrimCharsLeft(const S: string; const Chars: TCharValidator): string; overload; +function StrTrimCharsLeft(const S: string; const Chars: array of Char): string; overload; +function StrTrimCharRight(const S: string; C: Char): string; +function StrTrimCharsRight(const S: string; const Chars: TCharValidator): string; overload; +function StrTrimCharsRight(const S: string; const Chars: array of Char): string; overload; +function StrTrimQuotes(const S: string): string; +function StrUpper(const S: string): string; +procedure StrUpperInPlace(var S: string); +procedure StrUpperBuff(S: PChar); + +// String Management +procedure StrAddRef(var S: string); +procedure StrDecRef(var S: string); +function StrLength(const S: string): SizeInt; +function StrRefCount(const S: string): SizeInt; + +// String Search and Replace Routines +function StrCharCount(const S: string; C: Char): SizeInt; overload; +function StrCharsCount(const S: string; const Chars: TCharValidator): SizeInt; overload; +function StrCharsCount(const S: string; const Chars: array of Char): SizeInt; overload; +function StrStrCount(const S, SubS: string): SizeInt; +function StrCompare(const S1, S2: string; CaseSensitive: Boolean = False): SizeInt; +function StrCompareRange(const S1, S2: string; Index, Count: SizeInt; CaseSensitive: Boolean = True): SizeInt; +function StrCompareRangeEx(const S1, S2: string; Index, Count: SizeInt; CaseSensitive: Boolean): SizeInt; +procedure StrFillChar(var S; Count: SizeInt; C: Char); +function StrRepeatChar(C: Char; Count: SizeInt): string; +function StrFind(const Substr, S: string; const Index: SizeInt = 1): SizeInt; +function StrHasPrefix(const S: string; const Prefixes: array of string): Boolean; +function StrHasSuffix(const S: string; const Suffixes: array of string): Boolean; +function StrIndex(const S: string; const List: array of string; CaseSensitive: Boolean = False): SizeInt; +function StrIHasPrefix(const S: string; const Prefixes: array of string): Boolean; +function StrIHasSuffix(const S: string; const Suffixes: array of string): Boolean; +function StrILastPos(const SubStr, S: string): SizeInt; +function StrIPos(const SubStr, S: string): SizeInt; +function StrIPrefixIndex(const S: string; const Prefixes: array of string): SizeInt; +function StrIsOneOf(const S: string; const List: array of string): Boolean; +function StrISuffixIndex(const S: string; const Suffixes: array of string): SizeInt; +function StrLastPos(const SubStr, S: string): SizeInt; +function StrMatch(const Substr, S: string; Index: SizeInt = 1): SizeInt; +function StrMatches(const Substr, S: string; const Index: SizeInt = 1): Boolean; +function StrNIPos(const S, SubStr: string; N: SizeInt): SizeInt; +function StrNPos(const S, SubStr: string; N: SizeInt): SizeInt; +function StrPrefixIndex(const S: string; const Prefixes: array of string): SizeInt; +function StrSearch(const Substr, S: string; const Index: SizeInt = 1): SizeInt; +function StrSuffixIndex(const S: string; const Suffixes: array of string): SizeInt; + +// String Extraction +/// Returns the string after SubStr +function StrAfter(const SubStr, S: string): string; +/// Returns the String before SubStr +function StrBefore(const SubStr, S: string): string; +/// Splits a string at SubStr, returns true when SubStr is found, Left contains the +/// string before the SubStr and Right the string behind SubStr +function StrSplit(const SubStr, S: string;var Left, Right : string): boolean; +/// Returns the string between Start and Stop +function StrBetween(const S: string; const Start, Stop: Char): string; +/// Returns all but rightmost N characters of the string +function StrChopRight(const S: string; N: SizeInt): string;{$IFDEF SUPPORTS_INLINE} {$IFDEF COMPILER16_UP} inline; {$ENDIF} {$ENDIF} +/// Returns the left Count characters of the string +function StrLeft(const S: string; Count: SizeInt): string; {$IFDEF SUPPORTS_INLINE} {$IFDEF COMPILER16_UP} inline; {$ENDIF} {$ENDIF} +/// Returns the string starting from position Start for the Count Characters +function StrMid(const S: string; Start, Count: SizeInt): string; {$IFDEF SUPPORTS_INLINE} {$IFDEF COMPILER16_UP} inline; {$ENDIF} {$ENDIF} +/// Returns the string starting from position N to the end +function StrRestOf(const S: string; N: SizeInt): string;{$IFDEF SUPPORTS_INLINE} {$IFDEF COMPILER16_UP} inline; {$ENDIF} {$ENDIF} +/// Returns the right Count characters of the string +function StrRight(const S: string; Count: SizeInt): string;{$IFDEF SUPPORTS_INLINE} {$IFDEF COMPILER16_UP} inline; {$ENDIF} {$ENDIF} + +// Character Test Routines +function CharEqualNoCase(const C1, C2: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsAlpha(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsAlphaNum(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsBlank(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsControl(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsDelete(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsDigit(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsFracDigit(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsHexDigit(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsLower(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsNumberChar(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} {$IFDEF COMPILER16_UP} inline; {$ENDIF} {$ENDIF} +function CharIsNumber(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} {$IFDEF COMPILER16_UP} inline; {$ENDIF} {$ENDIF} +function CharIsPrintable(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsPunctuation(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsReturn(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsSpace(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsUpper(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsValidIdentifierLetter(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsWhiteSpace(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharIsWildcard(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharType(const C: Char): Word; + +// Character Transformation Routines +function CharHex(const C: Char): Byte; +function CharLower(const C: Char): Char; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharUpper(const C: Char): Char; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function CharToggleCase(const C: Char): Char; + +// Character Search and Replace +function CharPos(const S: string; const C: Char; const Index: SizeInt = 1): SizeInt; +function CharLastPos(const S: string; const C: Char; const Index: SizeInt = 1): SizeInt; +function CharIPos(const S: string; C: Char; const Index: SizeInt = 1): SizeInt; +function CharReplace(var S: string; const Search, Replace: Char): SizeInt; + +// PCharVector +type + PCharVector = ^PChar; + +function StringsToPCharVector(var Dest: PCharVector; const Source: TStrings): PCharVector; +function PCharVectorCount(Source: PCharVector): SizeInt; +procedure PCharVectorToStrings(const Dest: TStrings; Source: PCharVector); +procedure FreePCharVector(var Dest: PCharVector); + +// MultiSz Routines +type + PMultiSz = PChar; + PAnsiMultiSz = JclAnsiStrings.PAnsiMultiSz; + PWideMultiSz = JclWideStrings.PWideMultiSz; + + TAnsiStrings = JclAnsiStrings.TJclAnsiStrings; + TWideStrings = JclWideStrings.TJclWideStrings; + TAnsiStringList = JclAnsiStrings.TJclAnsiStringList; + TWideStringList = JclWideStrings.TJclWideStringList; + +function StringsToMultiSz(var Dest: PMultiSz; const Source: TStrings): PMultiSz; +procedure MultiSzToStrings(const Dest: TStrings; const Source: PMultiSz); +function MultiSzLength(const Source: PMultiSz): SizeInt; +procedure AllocateMultiSz(var Dest: PMultiSz; Len: SizeInt); +procedure FreeMultiSz(var Dest: PMultiSz); +function MultiSzDup(const Source: PMultiSz): PMultiSz; + +function AnsiStringsToAnsiMultiSz(var Dest: PAnsiMultiSz; const Source: TAnsiStrings): PAnsiMultiSz; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure AnsiMultiSzToAnsiStrings(const Dest: TAnsiStrings; const Source: PAnsiMultiSz); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function AnsiMultiSzLength(const Source: PAnsiMultiSz): SizeInt; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure AllocateAnsiMultiSz(var Dest: PAnsiMultiSz; Len: SizeInt); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure FreeAnsiMultiSz(var Dest: PAnsiMultiSz); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function AnsiMultiSzDup(const Source: PAnsiMultiSz): PAnsiMultiSz; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + +function WideStringsToWideMultiSz(var Dest: PWideMultiSz; const Source: TWideStrings): PWideMultiSz; + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure WideMultiSzToWideStrings(const Dest: TWideStrings; const Source: PWideMultiSz); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function WideMultiSzLength(const Source: PWideMultiSz): SizeInt; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure AllocateWideMultiSz(var Dest: PWideMultiSz; Len: SizeInt); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure FreeWideMultiSz(var Dest: PWideMultiSz); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +function WideMultiSzDup(const Source: PWideMultiSz): PWideMultiSz; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} + +// TStrings Manipulation +procedure StrIToStrings(S, Sep: string; const List: TStrings; const AllowEmptyString: Boolean = True); +procedure StrToStrings(S, Sep: string; const List: TStrings; const AllowEmptyString: Boolean = True); +function StringsToStr(const List: TStrings; const Sep: string; const AllowEmptyString: Boolean = True): string; overload; +function StringsToStr(const List: TStrings; const Sep: string; const NumberOfItems: SizeInt; const AllowEmptyString: + Boolean = True): string; overload; +procedure TrimStrings(const List: TStrings; DeleteIfEmpty: Boolean = True); +procedure TrimStringsRight(const List: TStrings; DeleteIfEmpty: Boolean = True); +procedure TrimStringsLeft(const List: TStrings; DeleteIfEmpty: Boolean = True); +function AddStringToStrings(const S: string; Strings: TStrings; const Unique: Boolean): Boolean; + +// Miscellaneous +// (OF) moved to JclSysUtils +// function BooleanToStr(B: Boolean): string; + // AnsiString here because it is binary data +function FileToString(const FileName: string): {$IFDEF COMPILER12_UP}RawByteString{$ELSE}AnsiString{$ENDIF}; +procedure StringToFile(const FileName: string; const Contents: {$IFDEF COMPILER12_UP}RawByteString{$ELSE}AnsiString{$ENDIF}; + Append: Boolean = False); + +function StrToken(var S: string; Separator: Char): string; +procedure StrTokens(const S: string; const List: TStrings); +procedure StrTokenToStrings(S: string; Separator: Char; const List: TStrings); +function StrWord(const S: string; var Index: SizeInt; out Word: string): Boolean; overload; +function StrWord(var S: PChar; out Word: string): Boolean; overload; +function StrIdent(const S: string; var Index: SizeInt; out Ident: string): Boolean; overload; +function StrIdent(var S: PChar; out Ident: string): Boolean; overload; +function StrToFloatSafe(const S: string): Float; +function StrToIntSafe(const S: string): Integer; +procedure StrNormIndex(const StrLen: SizeInt; var Index: SizeInt; var Count: SizeInt); overload; + +function ArrayOf(List: TStrings): TDynStringArray; overload; + +type + FormatException = class(EJclError); + ArgumentException = class(EJclError); + ArgumentNullException = class(EJclError); + ArgumentOutOfRangeException = class(EJclError); + + IToString = interface + ['{C4ABABB4-1029-46E7-B5FA-99800F130C05}'] + function ToString: string; + end; + + TCharDynArray = array of Char; + + // The TStringBuilder class is a Delphi implementation of the .NET + // System.Text.StringBuilder. + // It is zero based and the methods that have a TObject argument (Append, Insert, + // AppendFormat) are limited to IToString implementors or Delphi 2009+ RTL. + // This class is not threadsafe. Any instance of TStringBuilder should not + // be used in different threads at the same time. + TJclStringBuilder = class(TInterfacedObject, IToString) + private + FChars: TCharDynArray; + FLength: SizeInt; + FMaxCapacity: SizeInt; + + function GetCapacity: SizeInt; + procedure SetCapacity(const Value: SizeInt); + function GetChars(Index: SizeInt): Char; + procedure SetChars(Index: SizeInt; const Value: Char); + procedure Set_Length(const Value: SizeInt); + protected + function AppendPChar(Value: PChar; Count: SizeInt; RepeatCount: SizeInt = 1): TJclStringBuilder; + function InsertPChar(Index: SizeInt; Value: PChar; Count: SizeInt; RepeatCount: SizeInt = 1): TJclStringBuilder; + public + constructor Create(const Value: string; Capacity: SizeInt = 16); overload; + constructor Create(Capacity: SizeInt = 16; MaxCapacity: SizeInt = MaxInt); overload; + constructor Create(const Value: string; StartIndex, Length, Capacity: SizeInt); overload; + + function Append(const Value: string): TJclStringBuilder; overload; + function Append(const Value: string; StartIndex, Length: SizeInt): TJclStringBuilder; overload; + function Append(Value: Boolean): TJclStringBuilder; overload; + function Append(Value: Char; RepeatCount: SizeInt = 1): TJclStringBuilder; overload; + function Append(const Value: array of Char): TJclStringBuilder; overload; + function Append(const Value: array of Char; StartIndex, Length: SizeInt): TJclStringBuilder; overload; + function Append(Value: Cardinal): TJclStringBuilder; overload; + function Append(Value: Integer): TJclStringBuilder; overload; + function Append(Value: Double): TJclStringBuilder; overload; + function Append(Value: Int64): TJclStringBuilder; overload; + function Append(Obj: TObject): TJclStringBuilder; overload; + function AppendFormat(const Fmt: string; const Args: array of const): TJclStringBuilder; overload; + function AppendFormat(const Fmt: string; Arg0: Variant): TJclStringBuilder; overload; + function AppendFormat(const Fmt: string; Arg0, Arg1: Variant): TJclStringBuilder; overload; + function AppendFormat(const Fmt: string; Arg0, Arg1, Arg2: Variant): TJclStringBuilder; overload; + + function Insert(Index: SizeInt; const Value: string; Count: SizeInt = 1): TJclStringBuilder; overload; + function Insert(Index: SizeInt; Value: Boolean): TJclStringBuilder; overload; + function Insert(Index: SizeInt; const Value: array of Char): TJclStringBuilder; overload; + function Insert(Index: SizeInt; const Value: array of Char; StartIndex, Length: SizeInt): TJclStringBuilder; + overload; + function Insert(Index: SizeInt; Value: Cardinal): TJclStringBuilder; overload; + function Insert(Index: SizeInt; Value: Integer): TJclStringBuilder; overload; + function Insert(Index: SizeInt; Value: Double): TJclStringBuilder; overload; + function Insert(Index: SizeInt; Value: Int64): TJclStringBuilder; overload; + function Insert(Index: SizeInt; Obj: TObject): TJclStringBuilder; overload; + + function Replace(OldChar, NewChar: Char; StartIndex: SizeInt = 0; Count: SizeInt = -1): TJclStringBuilder; + overload; + function Replace(OldValue, NewValue: string; StartIndex: SizeInt = 0; Count: SizeInt = -1): TJclStringBuilder; + overload; + + function Remove(StartIndex, Length: SizeInt): TJclStringBuilder; + function EnsureCapacity(Capacity: SizeInt): SizeInt; + procedure Clear; + + { IToString } + function ToString: string; {$IFDEF RTL200_UP} override; {$ENDIF RTL200_UP} + + property __Chars__[Index: SizeInt]: Char read GetChars write SetChars; default; + property Chars: TCharDynArray read FChars; + property Length: SizeInt read FLength write Set_Length; + property Capacity: SizeInt read GetCapacity write SetCapacity; + property MaxCapacity: SizeInt read FMaxCapacity; + end; + + {$IFDEF RTL200_UP} + TStringBuilder = {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.TStringBuilder; + {$ELSE ~RTL200_UP} + TStringBuilder = TJclStringBuilder; + {$ENDIF ~RTL200_UP} + +// DotNetFormat() uses the .NET format style: "{argX}" +function DotNetFormat(const Fmt: string; const Args: array of const): string; overload; +function DotNetFormat(const Fmt: string; const Arg0: Variant): string; overload; +function DotNetFormat(const Fmt: string; const Arg0, Arg1: Variant): string; overload; +function DotNetFormat(const Fmt: string; const Arg0, Arg1, Arg2: Variant): string; overload; + +// TJclTabSet +type + TJclTabSet = class (TInterfacedObject, IToString) + private + FData: TObject; + function GetCount: SizeInt; + function GetStops(Index: SizeInt): SizeInt; + function GetTabWidth: SizeInt; + function GetZeroBased: Boolean; + procedure SetStops(Index, Value: SizeInt); + procedure SetTabWidth(Value: SizeInt); + procedure SetZeroBased(Value: Boolean); + protected + function FindStop(Column: SizeInt): SizeInt; + function InternalTabStops: TDynSizeIntArray; + function InternalTabWidth: SizeInt; + procedure RemoveAt(Index: SizeInt); + public + constructor Create; overload; + constructor Create(Data: TObject); overload; + constructor Create(TabWidth: SizeInt); overload; + constructor Create(const Tabstops: array of SizeInt; ZeroBased: Boolean); overload; + constructor Create(const Tabstops: array of SizeInt; ZeroBased: Boolean; TabWidth: SizeInt); overload; + destructor Destroy; override; + + // cloning and referencing + function Clone: TJclTabSet; + function NewReference: TJclTabSet; + + // Tab stops manipulation + function Add(Column: SizeInt): SizeInt; + function Delete(Column: SizeInt): SizeInt; + + // Usage + function Expand(const S: string): string; overload; + function Expand(const S: string; Column: SizeInt): string; overload; + procedure OptimalFillInfo(StartColumn, TargetColumn: SizeInt; out TabsNeeded, SpacesNeeded: SizeInt); + function Optimize(const S: string): string; overload; + function Optimize(const S: string; Column: SizeInt): string; overload; + function StartColumn: SizeInt; + function TabFrom(Column: SizeInt): SizeInt; + function UpdatePosition(const S: string): SizeInt; overload; + function UpdatePosition(const S: string; Column: SizeInt): SizeInt; overload; + function UpdatePosition(const S: string; var Column, Line: SizeInt): SizeInt; overload; + + { IToString } + function ToString: string; overload; {$IFDEF RTL200_UP} override; {$ENDIF RTL200_UP} + // Conversions + function ToString(FormattingOptions: SizeInt): string; {$IFDEF RTL200_UP} reintroduce; {$ENDIF RTL200_UP} overload; + class function FromString(const S: string): TJclTabSet; {$IFDEF SUPPORTS_STATIC} static; {$ENDIF SUPPORTS_STATIC} + + // Properties + property ActualTabWidth: SizeInt read InternalTabWidth; + property Count: SizeInt read GetCount; + property TabStops[Index: SizeInt]: SizeInt read GetStops write SetStops; default; + property TabWidth: SizeInt read GetTabWidth write SetTabWidth; + property ZeroBased: Boolean read GetZeroBased write SetZeroBased; + end; + +// Formatting constants +const + TabSetFormatting_SurroundStopsWithBrackets = 1; + TabSetFormatting_EmptyBracketsIfNoStops = 2; + TabSetFormatting_NoTabStops = 4; + TabSetFormatting_NoTabWidth = 8; + TabSetFormatting_AutoTabWidth = 16; + // common combinations + TabSetFormatting_Default = 0; + TabSetFormatting_AlwaysUseBrackets = TabSetFormatting_SurroundStopsWithBrackets or + TabSetFormatting_EmptyBracketsIfNoStops; + TabSetFormatting_Full = TabSetFormatting_AlwaysUseBrackets or TabSetFormatting_AutoTabWidth; + // aliases + TabSetFormatting_StopsOnly = TabSetFormatting_NoTabWidth; + TabSetFormatting_TabWidthOnly = TabSetFormatting_NoTabStops; + TabSetFormatting_StopsWithoutBracketsAndTabWidth = TabSetFormatting_Default; + +// Tab expansion routines +function StrExpandTabs(S: string): string; {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF} overload; +function StrExpandTabs(S: string; TabWidth: SizeInt): string; {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF} overload; +function StrExpandTabs(S: string; TabSet: TJclTabSet): string; {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF} overload; +// Tab optimization routines +function StrOptimizeTabs(S: string): string; {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF} overload; +function StrOptimizeTabs(S: string; TabWidth: SizeInt): string; {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF} overload; +function StrOptimizeTabs(S: string; TabSet: TJclTabSet): string; {$IFDEF SUPPORTS_INLINE}inline; {$ENDIF} overload; + +// move to JclBase? +type + NullReferenceException = class(EJclError) + public + constructor Create; overload; + end; + +procedure StrResetLength(var S: WideString); overload; +procedure StrResetLength(var S: AnsiString); overload; +procedure StrResetLength(S: TJclStringBuilder); overload; +{$IFDEF SUPPORTS_UNICODE_STRING} +procedure StrResetLength(var S: UnicodeString); overload; +{$ENDIF SUPPORTS_UNICODE_STRING} + +// natural comparison functions +function CompareNaturalStr(const S1, S2: string): SizeInt; +function CompareNaturalText(const S1, S2: string): SizeInt; + +{$IFNDEF UNICODE_RTL_DATABASE} +// internal structures published to make function inlining working +const + MaxStrCharCount = Ord(High(Char)) + 1; // # of chars in one set + StrLoOffset = MaxStrCharCount * 0; // offset to lower case chars + StrUpOffset = MaxStrCharCount * 1; // offset to upper case chars + StrReOffset = MaxStrCharCount * 2; // offset to reverse case chars + StrCaseMapSize = MaxStrCharCount * 3; // # of chars is a table + +var + StrCaseMap: array [0..StrCaseMapSize - 1] of Char; // case mappings + StrCaseMapReady: Boolean = False; // true if case map exists + StrCharTypes: array [Char] of Word; +{$ENDIF ~UNICODE_RTL_DATABASE} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + {$IFDEF SUPPORTS_UNICODE} + {$IFDEF HAS_UNITSCOPE} + System.StrUtils, + {$ELSE ~HAS_UNITSCOPE} + StrUtils, + {$ENDIF ~HAS_UNITSCOPE} + {$ENDIF SUPPORTS_UNICODE} + JclLogic, JclResources, JclStreams, JclSynch, JclSysUtils; + +//=== Internal =============================================================== + +type + TStrRec = packed record + RefCount: Integer; + Length: Integer; + end; + PStrRec = ^TStrRec; + +{$IFNDEF UNICODE_RTL_DATABASE} +procedure LoadCharTypes; +var + CurrChar: Char; + CurrType: Word; +begin + for CurrChar := Low(CurrChar) to High(CurrChar) do + begin + {$IFDEF MSWINDOWS} + CurrType := 0; + GetStringTypeEx(LOCALE_USER_DEFAULT, CT_CTYPE1, @CurrChar, 1, CurrType); + {$DEFINE CHAR_TYPES_INITIALIZED} + {$ENDIF MSWINDOWS} + {$IFDEF LINUX} + CurrType := 0; + if isupper(Byte(CurrChar)) <> 0 then + CurrType := CurrType or C1_UPPER; + if islower(Byte(CurrChar)) <> 0 then + CurrType := CurrType or C1_LOWER; + if isdigit(Byte(CurrChar)) <> 0 then + CurrType := CurrType or C1_DIGIT; + if isspace(Byte(CurrChar)) <> 0 then + CurrType := CurrType or C1_SPACE; + if ispunct(Byte(CurrChar)) <> 0 then + CurrType := CurrType or C1_PUNCT; + if iscntrl(Byte(CurrChar)) <> 0 then + CurrType := CurrType or C1_CNTRL; + if isblank(Byte(CurrChar)) <> 0 then + CurrType := CurrType or C1_BLANK; + if isxdigit(Byte(CurrChar)) <> 0 then + CurrType := CurrType or C1_XDIGIT; + if isalpha(Byte(CurrChar)) <> 0 then + CurrType := CurrType or C1_ALPHA; + {$DEFINE CHAR_TYPES_INITIALIZED} + {$ENDIF LINUX} + StrCharTypes[CurrChar] := CurrType; + {$IFNDEF CHAR_TYPES_INITIALIZED} + Implement case map initialization here + {$ENDIF ~CHAR_TYPES_INITIALIZED} + end; +end; + +procedure LoadCaseMap; +var + CurrChar, UpCaseChar, LoCaseChar, ReCaseChar: Char; +begin + if not StrCaseMapReady then + begin + for CurrChar := Low(Char) to High(Char) do + begin + {$IFDEF MSWINDOWS} + LoCaseChar := CurrChar; + UpCaseChar := CurrChar; + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CharLowerBuff(@LoCaseChar, 1); + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CharUpperBuff(@UpCaseChar, 1); + {$DEFINE CASE_MAP_INITIALIZED} + {$ENDIF MSWINDOWS} + {$IFDEF LINUX} + LoCaseChar := Char(tolower(Byte(CurrChar))); + UpCaseChar := Char(toupper(Byte(CurrChar))); + {$DEFINE CASE_MAP_INITIALIZED} + {$ENDIF LINUX} + {$IFNDEF CASE_MAP_INITIALIZED} + Implement case map initialization here + {$ENDIF ~CASE_MAP_INITIALIZED} + if CharIsUpper(CurrChar) then + ReCaseChar := LoCaseChar + else + if CharIsLower(CurrChar) then + ReCaseChar := UpCaseChar + else + ReCaseChar := CurrChar; + StrCaseMap[Ord(CurrChar) + StrLoOffset] := LoCaseChar; + StrCaseMap[Ord(CurrChar) + StrUpOffset] := UpCaseChar; + StrCaseMap[Ord(CurrChar) + StrReOffset] := ReCaseChar; + end; + StrCaseMapReady := True; + end; +end; + +// Uppercases or Lowercases a give string depending on the +// passed offset. (UpOffset or LoOffset) + +procedure StrCase(var Str: string; const Offset: SizeInt); +var + P: PChar; + I, L: SizeInt; +begin + L := Length(Str); + if L > 0 then + begin + UniqueString(Str); + P := PChar(Str); + for I := 1 to L do + begin + P^ := StrCaseMap[Offset + Ord(P^)]; + Inc(P); + end; + end; +end; + +// Internal utility function +// Uppercases or Lowercases a give null terminated string depending on the +// passed offset. (UpOffset or LoOffset) + +procedure StrCaseBuff(S: PChar; const Offset: SizeInt); +var + C: Char; +begin + if S <> nil then + begin + repeat + C := S^; + S^ := StrCaseMap[Offset + Ord(C)]; + Inc(S); + until C = #0; + end; +end; +{$ENDIF ~UNICODE_RTL_DATABASE} + +function StrEndW(Str: PWideChar): PWideChar; +begin + Result := Str; + while Result^ <> #0 do + Inc(Result); +end; + +function ArrayContainsChar(const Chars: array of Char; const C: Char): Boolean; +var + idx: SizeInt; +begin + Result := ArrayContainsChar(Chars, C, idx); +end; + +function ArrayContainsChar(const Chars: array of Char; const C: Char; out Index: SizeInt): Boolean; +{ optimized version for sorted arrays +var + I, L, H: SizeInt; +begin + L := Low(Chars); + H := High(Chars); + while L <= H do + begin + I := (L + H) div 2; + if C = Chars[I] then + begin + Result := True; + Exit; + end + else + if C < Chars[I] then + H := I - 1 + else + // C > Chars[I] + L := I + 1; + end; + Result := False; +end;} +begin + Index := High(Chars); + while (Index >= Low(Chars)) and (Chars[Index] <> C) do + Dec(Index); + Result := Index >= Low(Chars); +end; + +// String Test Routines +function StrIsAlpha(const S: string): Boolean; +var + I: SizeInt; +begin + Result := S <> ''; + for I := 1 to Length(S) do + begin + if not CharIsAlpha(S[I]) then + begin + Result := False; + Exit; + end; + end; +end; + +function StrIsAlphaNum(const S: string): Boolean; +var + I: SizeInt; +begin + Result := S <> ''; + for I := 1 to Length(S) do + begin + if not CharIsAlphaNum(S[I]) then + begin + Result := False; + Exit; + end; + end; +end; + +function StrConsistsofNumberChars(const S: string): Boolean; +var + I: SizeInt; +begin + Result := S <> ''; + for I := 1 to Length(S) do + begin + if not CharIsNumberChar(S[I]) then + begin + Result := False; + Exit; + end; + end; +end; + +function StrContainsChars(const S: string; const Chars: TCharValidator; CheckAll: Boolean): Boolean; +var + I: SizeInt; +begin + Result := False; + if CheckAll then + begin + // this will not work with the current definition of the validator. The validator would need to check each character + // it requires against the string (which is currently not provided to the Validator). The current implementation of + // CheckAll will check if all characters in S will be accepted by the provided Validator, which is wrong and incon- + // sistent with the documentation and the array-based overload. + for I := 1 to Length(S) do + begin + Result := Chars(S[I]); + if not Result then + Break; + end; + end + else + begin + for I := 1 to Length(S) do + begin + Result := Chars(S[I]); + if Result then + Break; + end; + end; +end; + +function StrContainsChars(const S: string; const Chars: array of Char; CheckAll: Boolean): Boolean; +var + I: SizeInt; +begin + if CheckAll then + begin + Result := True; + I := High(Chars); + while (I >= 0) and Result do + begin + Result := CharPos(S, Chars[I]) > 0; + Dec(I); + end; + end + else + begin + Result := False; + for I := 1 to Length(S) do + begin + Result := ArrayContainsChar(Chars, S[I]); + if Result then + Break; + end; + end; +end; + +function StrIsAlphaNumUnderscore(const S: string): Boolean; +var + I: SizeInt; + C: Char; +begin + for I := 1 to Length(S) do + begin + C := S[I]; + + if not (CharIsAlphaNum(C) or (C = '_')) then + begin + Result := False; + Exit; + end; + end; + + Result := Length(S) > 0; +end; + +function StrIsDigit(const S: string): Boolean; +var + I: SizeInt; +begin + Result := S <> ''; + for I := 1 to Length(S) do + begin + if not CharIsDigit(S[I]) then + begin + Result := False; + Exit; + end; + end; +end; + +function StrIsSubset(const S: string; const ValidChars: TCharValidator): Boolean; +var + I: SizeInt; +begin + for I := 1 to Length(S) do + begin + Result := ValidChars(S[I]); + if not Result then + Exit; + end; + + Result := Length(S) > 0; +end; + +function StrIsSubset(const S: string; const ValidChars: array of Char): Boolean; +var + I: SizeInt; +begin + for I := 1 to Length(S) do + begin + Result := ArrayContainsChar(ValidChars, S[I]); + if not Result then + Exit; + end; + + Result := Length(S) > 0; +end; + +function StrSame(const S1, S2: string; CaseSensitive: Boolean): Boolean; +begin + Result := StrCompare(S1, S2, CaseSensitive) = 0; +end; + +//=== String Transformation Routines ========================================= + +function StrCenter(const S: string; L: SizeInt; C: Char = ' '): string; +begin + if Length(S) < L then + begin + Result := StringOfChar(C, (L - Length(S)) div 2) + S; + Result := Result + StringOfChar(C, L - Length(Result)); + end + else + Result := S; +end; + +function StrCharPosLower(const S: string; CharPos: SizeInt): string; +begin + Result := S; + if (CharPos > 0) and (CharPos <= Length(S)) then + Result[CharPos] := CharLower(Result[CharPos]); +end; + +function StrCharPosUpper(const S: string; CharPos: SizeInt): string; +begin + Result := S; + if (CharPos > 0) and (CharPos <= Length(S)) then + Result[CharPos] := CharUpper(Result[CharPos]); +end; + +function StrDoubleQuote(const S: string): string; +begin + Result := NativeDoubleQuote + S + NativeDoubleQuote; +end; + +function StrEnsureNoPrefix(const Prefix, Text: string): string; +var + PrefixLen: SizeInt; +begin + PrefixLen := Length(Prefix); + if Copy(Text, 1, PrefixLen) = Prefix then + Result := Copy(Text, PrefixLen + 1, Length(Text)) + else + Result := Text; +end; + +function StrEnsureNoSuffix(const Suffix, Text: string): string; +var + SuffixLen: SizeInt; + StrLength: SizeInt; +begin + SuffixLen := Length(Suffix); + StrLength := Length(Text); + if Copy(Text, StrLength - SuffixLen + 1, SuffixLen) = Suffix then + Result := Copy(Text, 1, StrLength - SuffixLen) + else + Result := Text; +end; + +function StrEnsurePrefix(const Prefix, Text: string): string; +var + PrefixLen: SizeInt; +begin + PrefixLen := Length(Prefix); + if Copy(Text, 1, PrefixLen) = Prefix then + Result := Text + else + Result := Prefix + Text; +end; + +function StrEnsureSuffix(const Suffix, Text: string): string; +var + SuffixLen: SizeInt; +begin + SuffixLen := Length(Suffix); + if Copy(Text, Length(Text) - SuffixLen + 1, SuffixLen) = Suffix then + Result := Text + else + Result := Text + Suffix; +end; + +function StrEscapedToString(const S: string): string; + procedure HandleHexEscapeSeq(const S: string; var I: SizeInt; Len: SizeInt; var Dest: string); + const + HexDigits = string('0123456789abcdefABCDEF'); + var + StartI, Val, N: SizeInt; + begin + StartI := I; + N := Pos(S[I + 1], HexDigits) - 1; + if N < 0 then + // '\x' without hex digit following is not escape sequence + Dest := Dest + '\x' + else + begin + Inc(I); // Jump over x + if N >= 16 then + N := N - 6; + Val := N; + // Same for second digit + if I < Len then + begin + N := Pos(S[I + 1], HexDigits) - 1; + if N >= 0 then + begin + Inc(I); // Jump over first digit + if N >= 16 then + N := N - 6; + Val := Val * 16 + N; + end; + end; + + if Val > Ord(High(Char)) then + raise EJclStringError.CreateResFmt(@RsNumericConstantTooLarge, [Val, StartI]); + + Dest := Dest + Char(Val); + end; + end; + + procedure HandleOctEscapeSeq(const S: string; var I: SizeInt; Len: SizeInt; var Dest: string); + const + OctDigits = string('01234567'); + var + StartI, Val, N: SizeInt; + begin + StartI := I; + // first digit + Val := Pos(S[I], OctDigits) - 1; + if I < Len then + begin + N := Pos(S[I + 1], OctDigits) - 1; + if N >= 0 then + begin + Inc(I); + Val := Val * 8 + N; + end; + if I < Len then + begin + N := Pos(S[I + 1], OctDigits) - 1; + if N >= 0 then + begin + Inc(I); + Val := Val * 8 + N; + end; + end; + end; + + if Val > Ord(High(Char)) then + raise EJclStringError.CreateResFmt(@RsNumericConstantTooLarge, [Val, StartI]); + + Dest := Dest + Char(Val); + end; + +var + I, Len: SizeInt; +begin + Result := ''; + I := 1; + Len := Length(S); + while I <= Len do + begin + if not ((S[I] = '\') and (I < Len)) then + Result := Result + S[I] + else + begin + Inc(I); // Jump over escape character + case S[I] of + 'a': + Result := Result + NativeBell; + 'b': + Result := Result + NativeBackspace; + 'f': + Result := Result + NativeFormFeed; + 'n': + Result := Result + NativeLineFeed; + 'r': + Result := Result + NativeCarriageReturn; + 't': + Result := Result + NativeTab; + 'v': + Result := Result + NativeVerticalTab; + '\': + Result := Result + '\'; + '"': + Result := Result + '"'; + '''': + Result := Result + ''''; // Optionally escaped + '?': + Result := Result + '?'; // Optionally escaped + 'x': + if I < Len then + // Start of hex escape sequence + HandleHexEscapeSeq(S, I, Len, Result) + else + // '\x' at end of string is not escape sequence + Result := Result + '\x'; + '0'..'7': + // start of octal escape sequence + HandleOctEscapeSeq(S, I, Len, Result); + else + // no escape sequence + Result := Result + '\' + S[I]; + end; + end; + Inc(I); + end; +end; + +function StrLower(const S: string): string; +begin + Result := S; + StrLowerInPlace(Result); +end; + +procedure StrLowerInPlace(var S: string); +{$IFDEF UNICODE_RTL_DATABASE} +var + P: PChar; + I, L: SizeInt; +begin + L := Length(S); + if L > 0 then + begin + UniqueString(S); + P := PChar(S); + for I := 1 to L do + begin + P^ := TCharacter.ToLower(P^); + Inc(P); + end; + end; +end; +{$ELSE ~UNICODE_RTL_DATABASE} +begin + StrCase(S, StrLoOffset); +end; +{$ENDIF ~UNICODE_RTL_DATABASE} + +procedure StrLowerBuff(S: PChar); +begin + {$IFDEF UNICODE_RTL_DATABASE} + if S <> nil then + begin + repeat + S^ := TCharacter.ToLower(S^); + Inc(S); + until S^ = #0; + end; + {$ELSE ~UNICODE_RTL_DATABASE} + StrCaseBuff(S, StrLoOffset); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +procedure StrMove(var Dest: string; const Source: string; + const ToIndex, FromIndex, Count: SizeInt); +begin + // Check strings + if (Source = '') or (Length(Dest) = 0) then + Exit; + + // Check FromIndex + if (FromIndex <= 0) or (FromIndex > Length(Source)) or + (ToIndex <= 0) or (ToIndex > Length(Dest)) or + ((FromIndex + Count - 1) > Length(Source)) or ((ToIndex + Count - 1) > Length(Dest)) then + { TODO : Is failure without notice the proper thing to do here? } + Exit; + + // Move + Move(Source[FromIndex], Dest[ToIndex], Count * SizeOf(Char)); +end; + +function StrPadLeft(const S: string; Len: SizeInt; C: Char): string; +var + L: SizeInt; +begin + L := Length(S); + if L < Len then + Result := StringOfChar(C, Len - L) + S + else + Result := S; +end; + +function StrPadRight(const S: string; Len: SizeInt; C: Char): string; +var + L: SizeInt; +begin + L := Length(S); + if L < Len then + Result := S + StringOfChar(C, Len - L) + else + Result := S; +end; + +function StrProper(const S: string): string; +begin + Result := StrLower(S); + if Result <> '' then + Result[1] := UpCase(Result[1]); +end; + +procedure StrProperBuff(S: PChar); +begin + if (S <> nil) and (S^ <> #0) then + begin + StrLowerBuff(S); + S^ := CharUpper(S^); + end; +end; + +function StrQuote(const S: string; C: Char): string; +var + L: SizeInt; +begin + L := Length(S); + Result := S; + if L > 0 then + begin + if Result[1] <> C then + begin + Result := C + Result; + Inc(L); + end; + if Result[L] <> C then + Result := Result + C; + end; +end; + +function StrRemoveChars(const S: string; const Chars: TCharValidator): string; +var + Source, Dest: PChar; + Len, Index: SizeInt; +begin + Len := Length(S); + SetLength(Result, Len); + UniqueString(Result); + Source := PChar(S); + Dest := PChar(Result); + for Index := 0 to Len - 1 do + begin + if not Chars(Source^) then + begin + Dest^ := Source^; + Inc(Dest); + end; + Inc(Source); + end; + SetLength(Result, Dest - PChar(Result)); +end; + +function StrRemoveChars(const S: string; const Chars: array of Char): string; +var + Source, Dest: PChar; + Len, Index: SizeInt; +begin + Len := Length(S); + SetLength(Result, Len); + UniqueString(Result); + Source := PChar(S); + Dest := PChar(Result); + for Index := 0 to Len - 1 do + begin + if not ArrayContainsChar(Chars, Source^) then + begin + Dest^ := Source^; + Inc(Dest); + end; + Inc(Source); + end; + SetLength(Result, Dest - PChar(Result)); +end; + +function StrRemoveLeadingChars(const S: string; const Chars: TCharValidator): string; +var + Len : SizeInt; + I: SizeInt; +begin + Len := Length(S); + I := 1; + while (I <= Len) and Chars(s[I]) do + Inc(I); + Result := Copy (s, I, Len-I+1); +end; + +function StrRemoveLeadingChars(const S: string; const Chars: array of Char): string; +var + Len : SizeInt; + I: SizeInt; +begin + Len := Length(S); + I := 1; + while (I <= Len) and ArrayContainsChar(Chars, s[I]) do + Inc(I); + Result := Copy (s, I, Len-I+1); +end; + +function StrRemoveEndChars(const S: string; const Chars: TCharValidator): string; +var + Len : SizeInt; +begin + Len := Length(S); + while (Len > 0) and Chars(s[Len]) do + Dec(Len); + Result := Copy (s, 1, Len); +end; + +function StrRemoveEndChars(const S: string; const Chars: array of Char): string; +var + Len : SizeInt; +begin + Len := Length(S); + while (Len > 0) and ArrayContainsChar(Chars, s[Len]) do + Dec(Len); + Result := Copy (s, 1, Len); +end; + +function StrKeepChars(const S: string; const Chars: TCharValidator): string; +var + Source, Dest: PChar; + Len, Index: SizeInt; +begin + Len := Length(S); + SetLength(Result, Len); + UniqueString(Result); + Source := PChar(S); + Dest := PChar(Result); + for Index := 0 to Len - 1 do + begin + if Chars(Source^) then + begin + Dest^ := Source^; + Inc(Dest); + end; + Inc(Source); + end; + SetLength(Result, Dest - PChar(Result)); +end; + +function StrKeepChars(const S: string; const Chars: array of Char): string; +var + Source, Dest: PChar; + Len, Index: SizeInt; +begin + Len := Length(S); + SetLength(Result, Len); + UniqueString(Result); + Source := PChar(S); + Dest := PChar(Result); + for Index := 0 to Len - 1 do + begin + if ArrayContainsChar(Chars, Source^) then + begin + Dest^ := Source^; + Inc(Dest); + end; + Inc(Source); + end; + SetLength(Result, Dest - PChar(Result)); +end; + +function StrRepeat(const S: string; Count: SizeInt): string; +var + Len, Index: SizeInt; + Dest, Source: PChar; +begin + Len := Length(S); + SetLength(Result, Count * Len); + Dest := PChar(Result); + Source := PChar(S); + if Dest <> nil then + for Index := 0 to Count - 1 do + begin + Move(Source^, Dest^, Len * SizeOf(Char)); + Inc(Dest, Len); + end; +end; + +function StrRepeatLength(const S: string; L: SizeInt): string; +var + Len: SizeInt; + Dest: PChar; +begin + Result := ''; + Len := Length(S); + + if (Len > 0) and (S <> '') then + begin + SetLength(Result, L); + Dest := PChar(Result); + while (L > 0) do + begin + Move(S[1], Dest^, Min(L, Len) * SizeOf(Char)); + Inc(Dest, Len); + Dec(L, Len); + end; + end; +end; + +procedure StrReplace(var S: string; const Search, Replace: string; Flags: TReplaceFlags); +var + SearchStr: string; + ResultStr: string; { result string } + SourcePtr: PChar; { pointer into S of character under examination } + SourceMatchPtr: PChar; { pointers into S and Search when first character has } + SearchMatchPtr: PChar; { been matched and we're probing for a complete match } + ResultPtr: PChar; { pointer into Result of character being written } + ResultIndex, + SearchLength, { length of search string } + ReplaceLength, { length of replace string } + BufferLength, { length of temporary result buffer } + ResultLength: SizeInt; { length of result string } + C: Char; { first character of search string } + IgnoreCase: Boolean; +begin + if Search = '' then + begin + if S = '' then + begin + S := Replace; + Exit; + end + else + raise EJclStringError.CreateRes(@RsBlankSearchString); + end; + + if S <> '' then + begin + IgnoreCase := rfIgnoreCase in Flags; + if IgnoreCase then + SearchStr := StrUpper(Search) + else + SearchStr := Search; + { avoid having to call Length() within the loop } + SearchLength := Length(Search); + ReplaceLength := Length(Replace); + ResultLength := Length(S); + BufferLength := ResultLength; + SetLength(ResultStr, BufferLength); + { get pointers to begin of source and result } + ResultPtr := PChar(ResultStr); + SourcePtr := PChar(S); + C := SearchStr[1]; + { while we haven't reached the end of the string } + while True do + begin + { copy characters until we find the first character of the search string } + if IgnoreCase then + while (CharUpper(SourcePtr^) <> C) and (SourcePtr^ <> #0) do + begin + ResultPtr^ := SourcePtr^; + Inc(ResultPtr); + Inc(SourcePtr); + end + else + while (SourcePtr^ <> C) and (SourcePtr^ <> #0) do + begin + ResultPtr^ := SourcePtr^; + Inc(ResultPtr); + Inc(SourcePtr); + end; + { did we find that first character or did we hit the end of the string? } + if SourcePtr^ = #0 then + Break + else + begin + { continue comparing, +1 because first character was matched already } + SourceMatchPtr := SourcePtr + 1; + SearchMatchPtr := PChar(SearchStr) + 1; + if IgnoreCase then + while (CharUpper(SourceMatchPtr^) = SearchMatchPtr^) and (SearchMatchPtr^ <> #0) do + begin + Inc(SourceMatchPtr); + Inc(SearchMatchPtr); + end + else + while (SourceMatchPtr^ = SearchMatchPtr^) and (SearchMatchPtr^ <> #0) do + begin + Inc(SourceMatchPtr); + Inc(SearchMatchPtr); + end; + { did we find a complete match? } + if SearchMatchPtr^ = #0 then + begin + // keep track of result length + Inc(ResultLength, ReplaceLength - SearchLength); + if ReplaceLength > 0 then + begin + // increase buffer size if required + if ResultLength > BufferLength then + begin + BufferLength := ResultLength * 2; + ResultIndex := ResultPtr - PChar(ResultStr) + 1; + SetLength(ResultStr, BufferLength); + ResultPtr := @ResultStr[ResultIndex]; + end; + { append replace to result and move past the search string in source } + Move((@Replace[1])^, ResultPtr^, ReplaceLength * SizeOf(Char)); + end; + Inc(SourcePtr, SearchLength); + Inc(ResultPtr, ReplaceLength); + { replace all instances or just one? } + if not (rfReplaceAll in Flags) then + begin + { just one, copy until end of source and break out of loop } + while SourcePtr^ <> #0 do + begin + ResultPtr^ := SourcePtr^; + Inc(ResultPtr); + Inc(SourcePtr); + end; + Break; + end; + end + else + begin + { copy current character and start over with the next } + ResultPtr^ := SourcePtr^; + Inc(ResultPtr); + Inc(SourcePtr); + end; + end; + end; + { set result length and copy result into S } + SetLength(ResultStr, ResultLength); + S := ResultStr; + end; +end; + +function StrReplaceChar(const S: string; const Source, Replace: Char): string; +var + I: SizeInt; +begin + Result := S; + for I := 1 to Length(S) do + if Result[I] = Source then + Result[I] := Replace; +end; + +function StrReplaceChars(const S: string; const Chars: TCharValidator; Replace: Char): string; +var + I: SizeInt; +begin + Result := S; + for I := 1 to Length(S) do + if Chars(Result[I]) then + Result[I] := Replace; +end; + +function StrReplaceChars(const S: string; const Chars: array of Char; Replace: Char): string; +var + I: SizeInt; +begin + Result := S; + for I := 1 to Length(S) do + if ArrayContainsChar(Chars, Result[I]) then + Result[I] := Replace; +end; + +function StrReplaceButChars(const S: string; const Chars: TCharValidator; + Replace: Char): string; +var + I: SizeInt; +begin + Result := S; + for I := 1 to Length(S) do + if not Chars(Result[I]) then + Result[I] := Replace; +end; + +function StrReplaceButChars(const S: string; const Chars: array of Char; Replace: Char): string; +var + I: SizeInt; +begin + Result := S; + for I := 1 to Length(S) do + if not ArrayContainsChar(Chars, Result[I]) then + Result[I] := Replace; +end; + +function StrReverse(const S: string): string; +begin + Result := S; + StrReverseInplace(Result); +end; + +procedure StrReverseInPlace(var S: string); +{ TODO -oahuser : Warning: This is dangerous for unicode surrogates } +var + P1, P2: PChar; + C: Char; +begin + UniqueString(S); + P1 := PChar(S); + P2 := P1 + (Length(S) - 1); + while P1 < P2 do + begin + C := P1^; + P1^ := P2^; + P2^ := C; + Inc(P1); + Dec(P2); + end; +end; + +function StrSingleQuote(const S: string): string; +begin + Result := NativeSingleQuote + S + NativeSingleQuote; +end; + +procedure StrSkipChars(var S: PChar; const Chars: TCharValidator); +begin + while Chars(S^) do + Inc(S); +end; + +procedure StrSkipChars(var S: PChar; const Chars: array of Char); +begin + while ArrayContainsChar(Chars, S^) do + Inc(S); +end; + +procedure StrSkipChars(const S: string; var Index: SizeInt; const Chars: TCharValidator); +begin + while Chars(S[Index]) do + Inc(Index); +end; + +procedure StrSkipChars(const S: string; var Index: SizeInt; const Chars: array of Char); +begin + while ArrayContainsChar(Chars, S[Index]) do + Inc(Index); +end; + +function StrSmartCase(const S: string; const Delimiters: TCharValidator): string; +var + Source, Dest: PChar; + Index, Len: SizeInt; + InternalDelimiters: TCharValidator; +begin + Result := ''; + if Assigned(Delimiters) then + InternalDelimiters := Delimiters + else + InternalDelimiters := CharIsSpace; + + if S <> '' then + begin + Result := S; + UniqueString(Result); + + Len := Length(S); + Source := PChar(S); + Dest := PChar(Result); + Inc(Dest); + + for Index := 2 to Len do + begin + if InternalDelimiters(Source^) and not InternalDelimiters(Dest^) then + Dest^ := CharUpper(Dest^); + Inc(Dest); + Inc(Source); + end; + Result[1] := CharUpper(Result[1]); + end; +end; + +function StrSmartCase(const S: string; const Delimiters: array of Char): string; +var + Source, Dest: PChar; + Index, Len: SizeInt; +begin + Result := ''; + + if S <> '' then + begin + Result := S; + UniqueString(Result); + + Len := Length(S); + Source := PChar(S); + Dest := PChar(Result); + Inc(Dest); + + for Index := 2 to Len do + begin + if ArrayContainsChar(Delimiters, Source^) and not ArrayContainsChar(Delimiters, Dest^) then + Dest^ := CharUpper(Dest^); + Inc(Dest); + Inc(Source); + end; + Result[1] := CharUpper(Result[1]); + end; +end; + +function StrStringToEscaped(const S: string): string; +var + I: SizeInt; +begin + Result := ''; + for I := 1 to Length(S) do + begin + case S[I] of + NativeBackspace: + Result := Result + '\b'; + NativeBell: + Result := Result + '\a'; + NativeCarriageReturn: + Result := Result + '\r'; + NAtiveFormFeed: + Result := Result + '\f'; + NativeLineFeed: + Result := Result + '\n'; + NativeTab: + Result := Result + '\t'; + NativeVerticalTab: + Result := Result + '\v'; + NativeBackSlash: + Result := Result + '\\'; + NativeDoubleQuote: + Result := Result + '\"'; + else + // Characters < ' ' are escaped with hex sequence + if S[I] < #32 then + Result := Result + Format('\x%.2x', [SizeInt(S[I])]) + else + Result := Result + S[I]; + end; + end; +end; + +function StrStripNonNumberChars(const S: string): string; +var + I: SizeInt; + C: Char; +begin + Result := ''; + for I := 1 to Length(S) do + begin + C := S[I]; + if CharIsNumberChar(C) then + Result := Result + C; + end; +end; + +function StrToHex(const Source: string): string; +var + Index: SizeInt; + C, L, N: SizeInt; + BL, BH: Byte; + S: string; +begin + Result := ''; + if Source <> '' then + begin + S := Source; + L := Length(S); + if Odd(L) then + begin + S := '0' + S; + Inc(L); + end; + Index := 1; + SetLength(Result, L div 2); + C := 1; + N := 1; + while C <= L do + begin + BH := CharHex(S[Index]); + Inc(Index); + BL := CharHex(S[Index]); + Inc(Index); + Inc(C, 2); + if (BH = $FF) or (BL = $FF) then + begin + Result := ''; + Exit; + end; + Result[N] := Char((BH shl 4) or BL); + Inc(N); + end; + end; +end; + +function StrTrimCharLeft(const S: string; C: Char): string; +var + I, L: SizeInt; +begin + I := 1; + L := Length(S); + while (I <= L) and (S[I] = C) do + Inc(I); + Result := Copy(S, I, L - I + 1); +end; + +function StrTrimCharsLeft(const S: string; const Chars: TCharValidator): string; +var + I, L: SizeInt; +begin + I := 1; + L := Length(S); + while (I <= L) and Chars(S[I]) do + Inc(I); + Result := Copy(S, I, L - I + 1); +end; + +function StrTrimCharsLeft(const S: string; const Chars: array of Char): string; +var + I, L: SizeInt; +begin + I := 1; + L := Length(S); + while (I <= L) and ArrayContainsChar(Chars, S[I]) do + Inc(I); + Result := Copy(S, I, L - I + 1); +end; + +function StrTrimCharRight(const S: string; C: Char): string; +var + I: SizeInt; +begin + I := Length(S); + while (I >= 1) and (S[I] = C) do + Dec(I); + Result := Copy(S, 1, I); +end; + +function StrTrimCharsRight(const S: string; const Chars: TCharValidator): string; +var + I: SizeInt; +begin + I := Length(S); + while (I >= 1) and Chars(S[I]) do + Dec(I); + Result := Copy(S, 1, I); +end; + +function StrTrimCharsRight(const S: string; const Chars: array of Char): string; +var + I: SizeInt; +begin + I := Length(S); + while (I >= 1) and ArrayContainsChar(Chars, S[I]) do + Dec(I); + Result := Copy(S, 1, I); +end; + +function StrTrimQuotes(const S: string): string; +var + First, Last: Char; + L: SizeInt; +begin + L := Length(S); + if L > 1 then + begin + First := S[1]; + Last := S[L]; + if (First = Last) and ((First = NativeSingleQuote) or (First = NativeDoubleQuote)) then + Result := Copy(S, 2, L - 2) + else + Result := S; + end + else + Result := S; +end; + +function StrUpper(const S: string): string; +begin + Result := S; + StrUpperInPlace(Result); +end; + +procedure StrUpperInPlace(var S: string); +{$IFDEF UNICODE_RTL_DATABASE} +var + P: PChar; + I, L: SizeInt; +begin + L := Length(S); + if L > 0 then + begin + UniqueString(S); + P := PChar(S); + for I := 1 to L do + begin + P^ := TCharacter.ToUpper(P^); + Inc(P); + end; + end; +end; +{$ELSE ~UNICODE_RTL_DATABASE} +begin + StrCase(S, StrUpOffset); +end; +{$ENDIF ~UNICODE_RTL_DATABASE} + +procedure StrUpperBuff(S: PChar); +begin + {$IFDEF UNICODE_RTL_DATABASE} + if S <> nil then + begin + repeat + S^ := TCharacter.ToUpper(S^); + Inc(S); + until S^ = #0; + end; + {$ELSE ~UNICODE_RTL_DATABASE} + StrCaseBuff(S, StrUpOffset); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +//=== String Management ====================================================== + +procedure StrAddRef(var S: string); +var + P: PStrRec; +begin + P := Pointer(S); + if P <> nil then + begin + Dec(P); + if P^.RefCount = -1 then + UniqueString(S) + else + LockedInc(P^.RefCount); + end; +end; + +procedure StrDecRef(var S: string); +var + P: PStrRec; +begin + P := Pointer(S); + if P <> nil then + begin + Dec(P); + case P^.RefCount of + -1, 0: { nothing } ; + 1: + begin + Finalize(S); + Pointer(S) := nil; + end; + else + LockedDec(P^.RefCount); + end; + end; +end; + +function StrLength(const S: string): SizeInt; +var + P: PStrRec; +begin + Result := 0; + P := Pointer(S); + if P <> nil then + begin + Dec(P); + Result := P^.Length and (not $80000000 shr 1); + end; +end; + +function StrRefCount(const S: string): SizeInt; +var + P: PStrRec; +begin + Result := 0; + P := Pointer(S); + if P <> nil then + begin + Dec(P); + Result := P^.RefCount; + end; +end; + +procedure StrResetLength(var S: WideString); +var + I: SizeInt; +begin + for I := 0 to Length(S) - 1 do + if S[I + 1] = #0 then + begin + SetLength(S, I); + Exit; + end; +end; + +procedure StrResetLength(var S: AnsiString); +var + I: SizeInt; +begin + for I := 0 to Length(S) - 1 do + if S[I + 1] = #0 then + begin + SetLength(S, I); + Exit; + end; +end; + +procedure StrResetLength(S: TJclStringBuilder); +var + I: SizeInt; +begin + if S <> nil then + for I := 0 to S.Length - 1 do + if S[I] = #0 then + begin + S.Length := I; + Exit; + end; +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +procedure StrResetLength(var S: UnicodeString); +var + I: SizeInt; +begin + for I := 0 to Length(S) - 1 do + if S[I + 1] = #0 then + begin + SetLength(S, I); + Exit; + end; +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +//=== String Search and Replace Routines ===================================== + +function StrCharCount(const S: string; C: Char): SizeInt; +var + I: SizeInt; +begin + Result := 0; + for I := 1 to Length(S) do + if S[I] = C then + Inc(Result); +end; + +function StrCharsCount(const S: string; const Chars: TCharValidator): SizeInt; +var + I: SizeInt; +begin + Result := 0; + for I := 1 to Length(S) do + if Chars(S[I]) then + Inc(Result); +end; + +function StrCharsCount(const S: string; const Chars: array of Char): SizeInt; +var + I: SizeInt; +begin + Result := 0; + for I := 1 to Length(S) do + if ArrayContainsChar(Chars, S[I]) then + Inc(Result); +end; + +function StrStrCount(const S, SubS: string): SizeInt; +var + I: SizeInt; +begin + Result := 0; + if (Length(SubS) > Length(S)) or (Length(SubS) = 0) or (Length(S) = 0) then + Exit; + if Length(SubS) = 1 then + begin + Result := StrCharCount(S, SubS[1]); + Exit; + end; + I := StrSearch(SubS, S, 1); + + if I > 0 then + Inc(Result); + + while (I > 0) and (Length(S) > I + Length(SubS)) do + begin + I := StrSearch(SubS, S, I + 1); + + if I > 0 then + Inc(Result); + end; +end; + +(* +{ 1} Test(StrCompareRange('', '', 1, 5), 0); +{ 2} Test(StrCompareRange('A', '', 1, 5), -1); +{ 3} Test(StrCompareRange('AB', '', 1, 5), -1); +{ 4} Test(StrCompareRange('ABC', '', 1, 5), -1); +{ 5} Test(StrCompareRange('', 'A', 1, 5), -1); +{ 6} Test(StrCompareRange('', 'AB', 1, 5), -1); +{ 7} Test(StrCompareRange('', 'ABC', 1, 5), -1); +{ 8} Test(StrCompareRange('A', 'a', 1, 5), -2); +{ 9} Test(StrCompareRange('A', 'a', 1, 1), -32); +{10} Test(StrCompareRange('aA', 'aB', 1, 1), 0); +{11} Test(StrCompareRange('aA', 'aB', 1, 2), -1); +{12} Test(StrCompareRange('aB', 'aA', 1, 2), 1); +{13} Test(StrCompareRange('aA', 'aa', 1, 2), -32); +{14} Test(StrCompareRange('aa', 'aA', 1, 2), 32); +{15} Test(StrCompareRange('', '', 1, 0), 0); +{16} Test(StrCompareRange('A', 'A', 1, 0), -2); +{17} Test(StrCompareRange('Aa', 'A', 1, 0), -2); +{18} Test(StrCompareRange('Aa', 'Aa', 1, 2), 0); +{19} Test(StrCompareRange('Aa', 'A', 1, 2), 0); +{20} Test(StrCompareRange('Ba', 'A', 1, 2), 1); +*) +function StrCompareRangeEx(const S1, S2: string; Index, Count: SizeInt; CaseSensitive: Boolean): SizeInt; +var + Len1, Len2: SizeInt; + I: SizeInt; + C1, C2: Char; +begin + if Pointer(S1) = Pointer(S2) then + begin + if (Count <= 0) and (S1 <> '') then + Result := -2 // no work + else + Result := 0; + end + else + if (S1 = '') or (S2 = '') then + Result := -1 // null string + else + if Count <= 0 then + Result := -2 // no work + else + begin + Len1 := Length(S1); + Len2 := Length(S2); + + if (Index - 1) + Count > Len1 then + Result := -2 + else + begin + if (Index - 1) + Count > Len2 then // strange behaviour, but the assembler code does it + Count := Len2 - (Index - 1); + + if CaseSensitive then + begin + for I := 0 to Count - 1 do + begin + C1 := S1[Index + I]; + C2 := S2[Index + I]; + if C1 <> C2 then + begin + Result := Ord(C1) - Ord(C2); + Exit; + end; + end; + end + else + begin + for I := 0 to Count - 1 do + begin + C1 := S1[Index + I]; + C2 := S2[Index + I]; + if C1 <> C2 then + begin + C1 := CharLower(C1); + C2 := CharLower(C2); + if C1 <> C2 then + begin + Result := Ord(C1) - Ord(C2); + Exit; + end; + end; + end; + end; + Result := 0; + end; + end; +end; + +function StrCompare(const S1, S2: string; CaseSensitive: Boolean): SizeInt; +var + Len1, Len2: SizeInt; +begin + if Pointer(S1) = Pointer(S2) then + Result := 0 + else + begin + Len1 := Length(S1); + Len2 := Length(S2); + Result := Len1 - Len2; + if Result = 0 then + Result := StrCompareRangeEx(S1, S2, 1, Len1, CaseSensitive); + end; +end; + +function StrCompareRange(const S1, S2: string; Index, Count: SizeInt; CaseSensitive: Boolean): SizeInt; +begin + Result := StrCompareRangeEx(S1, S2, Index, Count, CaseSensitive); +end; + +procedure StrFillChar(var S; Count: SizeInt; C: Char); +{$IFDEF SUPPORTS_UNICODE} +asm + // 32 --> EAX S + // EDX Count + // ECX C + // 64 --> RCX S + // RDX Count + // R8W C + {$IFDEF CPU32} + DEC EDX + JS @@Leave +@@Loop: + MOV [EAX], CX + ADD EAX, 2 + DEC EDX + JNS @@Loop + {$ENDIF CPU32} + {$IFDEF CPU64} + DEC RDX + JS @@Leave +@@Loop: + MOV WORD PTR [RCX], R8W + ADD RCX, 2 + DEC RDX + JNS @@Loop + {$ENDIF CPU64} +@@Leave: +end; +{$ELSE ~SUPPORTS_UNICODE} +begin + if Count > 0 then + FillChar(S, Count, C); +end; +{$ENDIF ~SUPPORTS_UNICODE} + +function StrRepeatChar(C: Char; Count: SizeInt): string; +begin + SetLength(Result, Count); + if Count > 0 then + StrFillChar(Result[1], Count, C); +end; + +function StrFind(const Substr, S: string; const Index: SizeInt): SizeInt; +var + pos: SizeInt; +begin + if (SubStr <> '') and (S <> '') then + begin + pos := StrIPos(Substr, Copy(S, Index, Length(S) - Index + 1)); + if pos = 0 then + Result := 0 + else + Result := Index + Pos - 1; + end + else + Result := 0; +end; + +function StrHasPrefix(const S: string; const Prefixes: array of string): Boolean; +begin + Result := StrPrefixIndex(S, Prefixes) > -1; +end; + +function StrHasSuffix(const S: string; const Suffixes: array of string): Boolean; +begin + Result := StrSuffixIndex(S, Suffixes) > -1; +end; + +function StrIndex(const S: string; const List: array of string; CaseSensitive: Boolean): SizeInt; +var + I: SizeInt; +begin + Result := -1; + for I := Low(List) to High(List) do + begin + if StrCompare(S, List[I], CaseSensitive) = 0 then + begin + Result := I; + Break; + end; + end; +end; + +function StrIHasPrefix(const S: string; const Prefixes: array of string): Boolean; +begin + Result := StrIPrefixIndex(S, Prefixes) > -1; +end; + +function StrIHasSuffix(const S: string; const Suffixes: array of string): Boolean; +begin + Result := StrISuffixIndex(S, Suffixes) > -1; +end; + +function StrILastPos(const SubStr, S: string): SizeInt; +begin + Result := StrLastPos(StrUpper(SubStr), StrUpper(S)); +end; + +function StrIPos(const SubStr, S: string): SizeInt; +begin + Result := Pos(StrUpper(SubStr), StrUpper(S)); +end; + +function StrIPrefixIndex(const S: string; const Prefixes: array of string): SizeInt; +var + I: SizeInt; + Test: string; +begin + Result := -1; + for I := Low(Prefixes) to High(Prefixes) do + begin + Test := StrLeft(S, Length(Prefixes[I])); + if CompareText(Test, Prefixes[I]) = 0 then + begin + Result := I; + Break; + end; + end; +end; + +function StrIsOneOf(const S: string; const List: array of string): Boolean; +begin + Result := StrIndex(S, List) > -1; +end; + +function StrISuffixIndex(const S: string; const Suffixes: array of string): SizeInt; +var + I: SizeInt; + Test: string; +begin + Result := -1; + for I := Low(Suffixes) to High(Suffixes) do + begin + Test := StrRight(S, Length(Suffixes[I])); + if CompareText(Test, Suffixes[I]) = 0 then + begin + Result := I; + Break; + end; + end; +end; + +function StrLastPos(const SubStr, S: string): SizeInt; +var + Last, Current: PChar; +begin + Result := 0; + Last := nil; + Current := PChar(S); + + while (Current <> nil) and (Current^ <> #0) do + begin + Current := StrPos(PChar(Current), PChar(SubStr)); + if Current <> nil then + begin + Last := Current; + Inc(Current); + end; + end; + if Last <> nil then + Result := Abs(PChar(S) - Last) + 1; +end; + +// IMPORTANT NOTE: The StrMatch function does currently not work with the Asterix (*) +// (*) acts like (?) + +function StrMatch(const Substr, S: string; Index: SizeInt): SizeInt; +var + SI, SubI, SLen, SubLen: SizeInt; + SubC: Char; +begin + SLen := Length(S); + SubLen := Length(Substr); + Result := 0; + if (Index > SLen) or (SubLen = 0) then + Exit; + while Index <= SLen do + begin + SubI := 1; + SI := Index; + while (SI <= SLen) and (SubI <= SubLen) do + begin + SubC := Substr[SubI]; + if (SubC = '*') or (SubC = '?') or (SubC = S[SI]) then + begin + Inc(SI); + Inc(SubI); + end + else + Break; + end; + if SubI > SubLen then + begin + Result := Index; + Break; + end; + Inc(Index); + end; +end; + +// Derived from "Like" by Michael Winter +function StrMatches(const Substr, S: string; const Index: SizeInt): Boolean; +var + StringPtr: PChar; + PatternPtr: PChar; + StringRes: PChar; + PatternRes: PChar; +begin + if SubStr = '' then + raise EJclStringError.CreateRes(@RsBlankSearchString); + + Result := SubStr = '*'; + + if Result or (S = '') then + Exit; + + if (Index <= 0) or (Index > Length(S)) then + raise EJclStringError.CreateRes(@RsArgumentOutOfRange); + + StringPtr := PChar(@S[Index]); + PatternPtr := PChar(SubStr); + StringRes := nil; + PatternRes := nil; + + repeat + repeat + case PatternPtr^ of + #0: + begin + Result := StringPtr^ = #0; + if Result or (StringRes = nil) or (PatternRes = nil) then + Exit; + + StringPtr := StringRes; + PatternPtr := PatternRes; + Break; + end; + '*': + begin + Inc(PatternPtr); + PatternRes := PatternPtr; + Break; + end; + '?': + begin + if StringPtr^ = #0 then + Exit; + Inc(StringPtr); + Inc(PatternPtr); + end; + else + begin + if StringPtr^ = #0 then + Exit; + if StringPtr^ <> PatternPtr^ then + begin + if (StringRes = nil) or (PatternRes = nil) then + Exit; + StringPtr := StringRes; + PatternPtr := PatternRes; + Break; + end + else + begin + Inc(StringPtr); + Inc(PatternPtr); + end; + end; + end; + until False; + + repeat + case PatternPtr^ of + #0: + begin + Result := True; + Exit; + end; + '*': + begin + Inc(PatternPtr); + PatternRes := PatternPtr; + end; + '?': + begin + if StringPtr^ = #0 then + Exit; + Inc(StringPtr); + Inc(PatternPtr); + end; + else + begin + repeat + if StringPtr^ = #0 then + Exit; + if StringPtr^ = PatternPtr^ then + Break; + Inc(StringPtr); + until False; + Inc(StringPtr); + StringRes := StringPtr; + Inc(PatternPtr); + Break; + end; + end; + until False; + until False; +end; + +function StrNPos(const S, SubStr: string; N: SizeInt): SizeInt; +var + I, P: SizeInt; +begin + if N < 1 then + begin + Result := 0; + Exit; + end; + + Result := StrSearch(SubStr, S, 1); + I := 1; + while I < N do + begin + P := StrSearch(SubStr, S, Result + 1); + if P = 0 then + begin + Result := 0; + Break; + end + else + begin + Result := P; + Inc(I); + end; + end; +end; + +function StrNIPos(const S, SubStr: string; N: SizeInt): SizeInt; +var + I, P: SizeInt; +begin + if N < 1 then + begin + Result := 0; + Exit; + end; + + Result := StrFind(SubStr, S, 1); + I := 1; + while I < N do + begin + P := StrFind(SubStr, S, Result + 1); + if P = 0 then + begin + Result := 0; + Break; + end + else + begin + Result := P; + Inc(I); + end; + end; +end; + +function StrPrefixIndex(const S: string; const Prefixes: array of string): SizeInt; +var + I: SizeInt; + Test: string; +begin + Result := -1; + for I := Low(Prefixes) to High(Prefixes) do + begin + Test := StrLeft(S, Length(Prefixes[I])); + if CompareStr(Test, Prefixes[I]) = 0 then + begin + Result := I; + Break; + end; + end; +end; + +function StrSearch(const Substr, S: string; const Index: SizeInt): SizeInt; +var + SP, SPI, SubP: PChar; + SLen: SizeInt; +begin + SLen := Length(S); + if Index <= SLen then + begin + SP := PChar(S); + SubP := PChar(Substr); + SPI := SP; + Inc(SPI, Index); + Dec(SPI); + SPI := StrPos(SPI, SubP); + if SPI <> nil then + Result := SPI - SP + 1 + else + Result := 0; + end + else + Result := 0; +end; + +function StrSuffixIndex(const S: string; const Suffixes: array of string): SizeInt; +var + I: SizeInt; + Test: string; +begin + Result := -1; + for I := Low(Suffixes) to High(Suffixes) do + begin + Test := StrRight(S, Length(Suffixes[I])); + if CompareStr(Test, Suffixes[I]) = 0 then + begin + Result := I; + Break; + end; + end; +end; + +//=== String Extraction ====================================================== + +function StrAfter(const SubStr, S: string): string; +var + P: SizeInt; +begin + P := StrFind(SubStr, S, 1); // StrFind is case-insensitive pos + if P <= 0 then + Result := '' // substr not found -> nothing after it + else + Result := StrRestOf(S, P + Length(SubStr)); +end; + +function StrBefore(const SubStr, S: string): string; +var + P: SizeInt; +begin + P := StrFind(SubStr, S, 1); + if P <= 0 then + Result := S + else + Result := StrLeft(S, P - 1); +end; + +function StrSplit(const SubStr, S: string;var Left, Right : string): boolean; +var + P: SizeInt; +begin + P := StrFind(SubStr, S, 1); + Result:= p > 0; + if Result then + begin + Left := StrLeft(S, P - 1); + Right := StrRestOf(S, P + Length(SubStr)); + end + else + begin + Left := ''; + Right := ''; + end; +end; + +function StrBetween(const S: string; const Start, Stop: Char): string; +var + PosStart, PosEnd: SizeInt; + L: SizeInt; +begin + PosStart := Pos(Start, S); + PosEnd := StrSearch(Stop, S, PosStart + 1); // PosEnd has to be after PosStart. + + if (PosStart > 0) and (PosEnd > PosStart) then + begin + L := PosEnd - PosStart; + Result := Copy(S, PosStart + 1, L - 1); + end + else + Result := ''; +end; + +function StrChopRight(const S: string; N: SizeInt): string; +begin + Result := Copy(S, 1, Length(S) - N); +end; + +function StrLeft(const S: string; Count: SizeInt): string; +begin + Result := Copy(S, 1, Count); +end; + +function StrMid(const S: string; Start, Count: SizeInt): string; +begin + Result := Copy(S, Start, Count); +end; + +function StrRestOf(const S: string; N: SizeInt): string; +begin + Result := Copy(S, N, (Length(S) - N + 1)); +end; + +function StrRight(const S: string; Count: SizeInt): string; +begin + Result := Copy(S, Length(S) - Count + 1, Count); +end; + +//=== Character (do we have it ;) ============================================ + +function CharEqualNoCase(const C1, C2: Char): Boolean; +begin + //if they are not equal chars, may be same letter different case + Result := (C1 = C2) or + (CharIsAlpha(C1) and CharIsAlpha(C2) and (CharLower(C1) = CharLower(C2))); +end; + + +function CharIsAlpha(const C: Char): Boolean; +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.IsLetter(C); + {$ELSE ~UNICODE_RTL_DATABASE} + Result := (StrCharTypes[C] and C1_ALPHA) <> 0; + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function CharIsAlphaNum(const C: Char): Boolean; +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.IsLetterOrDigit(C); + {$ELSE ~UNICODE_RTL_DATABASE} + Result := ((StrCharTypes[C] and C1_ALPHA) <> 0) or ((StrCharTypes[C] and C1_DIGIT) <> 0); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function CharIsBlank(const C: Char): Boolean; +begin + {$IFDEF UNICODE_RTL_DATABASE} + //http://blogs.msdn.com/b/michkap/archive/2007/06/11/3230072.aspx + Result := (C = ' ') or (C = #$0009) or (C = #$00A0) or (C = #$3000); + {$ELSE ~UNICODE_RTL_DATABASE} + Result := ((StrCharTypes[C] and C1_BLANK) <> 0); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function CharIsControl(const C: Char): Boolean; +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.IsControl(C); + {$ELSE ~UNICODE_RTL_DATABASE} + Result := (StrCharTypes[C] and C1_CNTRL) <> 0; + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function CharIsDelete(const C: Char): Boolean; +begin + Result := (C = #8); +end; + +function CharIsDigit(const C: Char): Boolean; +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.IsDigit(C); + {$ELSE ~UNICODE_RTL_DATABASE} + Result := (StrCharTypes[C] and C1_DIGIT) <> 0; + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function CharIsFracDigit(const C: Char): Boolean; +begin + Result := (C = '.') or CharIsDigit(C); +end; + +function CharIsHexDigit(const C: Char): Boolean; +begin + case C of + 'A'..'F', + 'a'..'f': + Result := True; + else + Result := CharIsDigit(C); + end; +end; + +function CharIsLower(const C: Char): Boolean; +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.IsLower(C); + {$ELSE ~UNICODE_RTL_DATABASE} + Result := (StrCharTypes[C] and C1_LOWER) <> 0; + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function CharIsNumberChar(const C: Char): Boolean; +begin + Result := CharIsDigit(C) or (C = '+') or (C = '-') or (C = JclFormatSettings.DecimalSeparator); +end; + +function CharIsNumber(const C: Char): Boolean; +begin + Result := CharIsDigit(C) or (C = JclFormatSettings.DecimalSeparator); +end; + +function CharIsPrintable(const C: Char): Boolean; +begin + Result := not CharIsControl(C); +end; + +function CharIsPunctuation(const C: Char): Boolean; +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.IsPunctuation(C); + {$ELSE ~UNICODE_RTL_DATABASE} + Result := ((StrCharTypes[C] and C1_PUNCT) <> 0); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function CharIsReturn(const C: Char): Boolean; +begin + Result := (C = NativeLineFeed) or (C = NativeCarriageReturn); +end; + +function CharIsSpace(const C: Char): Boolean; +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.IsWhiteSpace(C); + {$ELSE ~UNICODE_RTL_DATABASE} + Result := (StrCharTypes[C] and C1_SPACE) <> 0; + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function CharIsUpper(const C: Char): Boolean; +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.IsUpper(C); + {$ELSE ~UNICODE_RTL_DATABASE} + Result := (StrCharTypes[C] and C1_UPPER) <> 0; + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function CharIsValidIdentifierLetter(const C: Char): Boolean; +begin + case C of + {$IFDEF SUPPORTS_UNICODE} + // from XML specifications + #$00C0..#$00D6, #$00D8..#$00F6, #$00F8..#$02FF, #$0370..#$037D, + #$037F..#$1FFF, #$200C..#$200D, #$2070..#$218F, #$2C00..#$2FEF, + #$3001..#$D7FF, #$F900..#$FDCF, #$FDF0..#$FFFD, // #$10000..#$EFFFF, howto match surrogate pairs? + #$00B7, #$0300..#$036F, #$203F..#$2040, + {$ENDIF SUPPORTS_UNICODE} + '0'..'9', 'A'..'Z', 'a'..'z', '_': + Result := True; + else + Result := False; + end; +end; + +function CharIsWhiteSpace(const C: Char): Boolean; +begin + case C of + NativeTab, + NativeLineFeed, + NativeVerticalTab, + NativeFormFeed, + NativeCarriageReturn, + NativeSpace: + Result := True; + else + Result := False; + end; +end; + +function CharIsWildcard(const C: Char): Boolean; +begin + case C of + '*', '?': + Result := True; + else + Result := False; + end; +end; + +function CharType(const C: Char): Word; +begin + {$IFDEF UNICODE_RTL_DATABASE} + GetStringTypeEx(LOCALE_USER_DEFAULT, CT_CTYPE1, @C, 1, Result); + {$ELSE ~UNICODE_RTL_DATABASE} + Result := StrCharTypes[C]; + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +//=== PCharVector ============================================================ + +function StringsToPCharVector(var Dest: PCharVector; const Source: TStrings): PCharVector; +var + I: SizeInt; + S: string; + List: array of PChar; +begin + Assert(Source <> nil); + Dest := AllocMem((Source.Count + SizeOf(Char)) * SizeOf(PChar)); + SetLength(List, Source.Count + SizeOf(Char)); + for I := 0 to Source.Count - 1 do + begin + S := Source[I]; + List[I] := StrAlloc(Length(S) + SizeOf(Char)); + StrPCopy(List[I], S); + end; + List[Source.Count] := nil; + Move(List[0], Dest^, (Source.Count + 1) * SizeOf(PChar)); + Result := Dest; +end; + +function PCharVectorCount(Source: PCharVector): SizeInt; +begin + Result := 0; + if Source <> nil then + begin + while Source^ <> nil do + begin + Inc(Source); + Inc(Result); + end; + end; +end; + +procedure PCharVectorToStrings(const Dest: TStrings; Source: PCharVector); +var + I, Count: SizeInt; + List: array of PChar; +begin + Assert(Dest <> nil); + if Source <> nil then + begin + Count := PCharVectorCount(Source); + SetLength(List, Count); + Move(Source^, List[0], Count * SizeOf(PChar)); + Dest.BeginUpdate; + try + Dest.Clear; + for I := 0 to Count - 1 do + Dest.Add(List[I]); + finally + Dest.EndUpdate; + end; + end; +end; + +procedure FreePCharVector(var Dest: PCharVector); +var + I, Count: SizeInt; + List: array of PChar; +begin + if Dest <> nil then + begin + Count := PCharVectorCount(Dest); + SetLength(List, Count); + Move(Dest^, List[0], Count * SizeOf(PChar)); + for I := 0 to Count - 1 do + StrDispose(List[I]); + FreeMem(Dest, (Count + 1) * SizeOf(PChar)); + Dest := nil; + end; +end; + +//=== Character Transformation Routines ====================================== + +function CharHex(const C: Char): Byte; +begin + case C of + '0'..'9': + Result := Ord(C) - Ord('0'); + 'a'..'f': + Result := Ord(C) - Ord('a') + 10; + 'A'..'F': + Result := Ord(C) - Ord('A') + 10; + else + Result := $FF; + end; +end; + +function CharLower(const C: Char): Char; +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.ToLower(C); + {$ELSE ~UNICODE_RTL_DATABASE} + Result := StrCaseMap[Ord(C) + StrLoOffset]; + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function CharToggleCase(const C: Char): Char; +begin + {$IFDEF UNICODE_RTL_DATABASE} + if CharIsLower(C) then + Result := CharUpper(C) + else if CharIsUpper(C) then + Result := CharLower(C) + else + Result := C; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := StrCaseMap[Ord(C) + StrReOffset]; + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function CharUpper(const C: Char): Char; +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.ToUpper(C); + {$ELSE ~UNICODE_RTL_DATABASE} + Result := StrCaseMap[Ord(C) + StrUpOffset]; + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +//=== Character Search and Replace =========================================== + +function CharLastPos(const S: string; const C: Char; const Index: SizeInt): SizeInt; +begin + if (Index > 0) and (Index <= Length(S)) then + begin + for Result := Length(S) downto Index do + if S[Result] = C then + Exit; + end; + Result := 0; +end; + +function CharPos(const S: string; const C: Char; const Index: SizeInt): SizeInt; +begin + if (Index > 0) and (Index <= Length(S)) then + begin + for Result := Index to Length(S) do + if S[Result] = C then + Exit; + end; + Result := 0; +end; + +function CharIPos(const S: string; C: Char; const Index: SizeInt): SizeInt; +begin + if (Index > 0) and (Index <= Length(S)) then + begin + C := CharUpper(C); + for Result := Index to Length(S) do + if CharUpper(S[Result]) = C then + Exit; + end; + Result := 0; +end; + +function CharReplace(var S: string; const Search, Replace: Char): SizeInt; +var + P: PChar; + Index, Len: SizeInt; +begin + Result := 0; + if Search <> Replace then + begin + UniqueString(S); + P := PChar(S); + Len := Length(S); + for Index := 0 to Len - 1 do + begin + if P^ = Search then + begin + P^ := Replace; + Inc(Result); + end; + Inc(P); + end; + end; +end; + +//=== MultiSz ================================================================ + +function StringsToMultiSz(var Dest: PMultiSz; const Source: TStrings): PMultiSz; +var + I, TotalLength: SizeInt; + P: PMultiSz; +begin + Assert(Source <> nil); + TotalLength := 1; + for I := 0 to Source.Count - 1 do + if Source[I] = '' then + raise EJclStringError.CreateRes(@RsInvalidEmptyStringItem) + else + Inc(TotalLength, StrLen(PChar(Source[I])) + 1); + AllocateMultiSz(Dest, TotalLength); + P := Dest; + for I := 0 to Source.Count - 1 do + begin + P := StrECopy(P, PChar(Source[I])); + Inc(P); + end; + P^ := #0; + Result := Dest; +end; + +procedure MultiSzToStrings(const Dest: TStrings; const Source: PMultiSz); +var + P: PMultiSz; +begin + Assert(Dest <> nil); + Dest.BeginUpdate; + try + Dest.Clear; + if Source <> nil then + begin + P := Source; + while P^ <> #0 do + begin + Dest.Add(P); + P := StrEnd(P); + Inc(P); + end; + end; + finally + Dest.EndUpdate; + end; +end; + +function MultiSzLength(const Source: PMultiSz): SizeInt; +var + P: PMultiSz; +begin + Result := 0; + if Source <> nil then + begin + P := Source; + repeat + Inc(Result, StrLen(P) + 1); + P := StrEnd(P); + Inc(P); + until P^ = #0; + Inc(Result); + end; +end; + +procedure AllocateMultiSz(var Dest: PMultiSz; Len: SizeInt); +begin + if Len > 0 then + GetMem(Dest, Len * SizeOf(Char)) + else + Dest := nil; +end; + +procedure FreeMultiSz(var Dest: PMultiSz); +begin + if Dest <> nil then + FreeMem(Dest); + Dest := nil; +end; + +function MultiSzDup(const Source: PMultiSz): PMultiSz; +var + Len: SizeInt; +begin + if Source <> nil then + begin + Len := MultiSzLength(Source); + Result := nil; + AllocateMultiSz(Result, Len); + Move(Source^, Result^, Len * SizeOf(Char)); + end + else + Result := nil; +end; + +function AnsiStringsToAnsiMultiSz(var Dest: PAnsiMultiSz; const Source: TAnsiStrings): PAnsiMultiSz; +begin + Result := JclAnsiStrings.StringsToMultiSz(Dest, Source); +end; + +procedure AnsiMultiSzToAnsiStrings(const Dest: TAnsiStrings; const Source: PAnsiMultiSz); +begin + JclAnsiStrings.MultiSzToStrings(Dest, Source); +end; + +function AnsiMultiSzLength(const Source: PAnsiMultiSz): SizeInt; +begin + Result := JclAnsiStrings.MultiSzLength(Source); +end; + +procedure AllocateAnsiMultiSz(var Dest: PAnsiMultiSz; Len: SizeInt); +begin + JclAnsiStrings.AllocateMultiSz(Dest, Len); +end; + +procedure FreeAnsiMultiSz(var Dest: PAnsiMultiSz); +begin + JclAnsiStrings.FreeMultiSz(Dest); +end; + +function AnsiMultiSzDup(const Source: PAnsiMultiSz): PAnsiMultiSz; +begin + Result := JclAnsiStrings.MultiSzDup(Source); +end; + +function WideStringsToWideMultiSz(var Dest: PWideMultiSz; const Source: TWideStrings): PWideMultiSz; +begin + Result := JclWideStrings.StringsToMultiSz(Dest, Source); +end; + +procedure WideMultiSzToWideStrings(const Dest: TWideStrings; const Source: PWideMultiSz); +begin + JclWideStrings.MultiSzToStrings(Dest, Source); +end; + +function WideMultiSzLength(const Source: PWideMultiSz): SizeInt; +begin + Result := JclWideStrings.MultiSzLength(Source); +end; + +procedure AllocateWideMultiSz(var Dest: PWideMultiSz; Len: SizeInt); +begin + JclWideStrings.AllocateMultiSz(Dest, Len); +end; + +procedure FreeWideMultiSz(var Dest: PWideMultiSz); +begin + JclWideStrings.FreeMultiSz(Dest); +end; + +function WideMultiSzDup(const Source: PWideMultiSz): PWideMultiSz; +begin + Result := JclWideStrings.MultiSzDup(Source); +end; + +//=== TStrings Manipulation ================================================== + +procedure StrToStrings(S, Sep: string; const List: TStrings; const AllowEmptyString: Boolean = True); +var + I, L: SizeInt; + Left: string; +begin + Assert(List <> nil); + List.BeginUpdate; + try + List.Clear; + L := Length(Sep); + I := Pos(Sep, S); + while I > 0 do + begin + Left := StrLeft(S, I - 1); + if (Left <> '') or AllowEmptyString then + List.Add(Left); + Delete(S, 1, I + L - 1); + I := Pos(Sep, S); + end; + if (S <> '') or AllowEmptyString then + List.Add(S); // Ignore empty strings at the end (only if AllowEmptyString = False). + finally + List.EndUpdate; + end; +end; + +procedure StrIToStrings(S, Sep: string; const List: TStrings; const AllowEmptyString: Boolean = True); +var + I, L: SizeInt; + LowerCaseStr: string; + Left: string; +begin + Assert(List <> nil); + LowerCaseStr := StrLower(S); + Sep := StrLower(Sep); + L := Length(Sep); + I := Pos(Sep, LowerCaseStr); + List.BeginUpdate; + try + List.Clear; + while I > 0 do + begin + Left := StrLeft(S, I - 1); + if (Left <> '') or AllowEmptyString then + List.Add(Left); + Delete(S, 1, I + L - 1); + Delete(LowerCaseStr, 1, I + L - 1); + I := Pos(Sep, LowerCaseStr); + end; + if (S <> '') or AllowEmptyString then + List.Add(S); // Ignore empty strings at the end (only if AllowEmptyString = False). + finally + List.EndUpdate; + end; +end; + +function StringsToStr(const List: TStrings; const Sep: string; const AllowEmptyString: Boolean = True): string; +var + I, L: SizeInt; +begin + Result := ''; + for I := 0 to List.Count - 1 do + begin + if (List[I] <> '') or AllowEmptyString then + begin + // don't combine these into one addition, somehow it hurts performance + Result := Result + List[I]; + Result := Result + Sep; + end; + end; + // remove terminating separator + if List.Count > 0 then + begin + L := Length(Sep); + Delete(Result, Length(Result) - L + 1, L); + end; +end; + +function StringsToStr(const List: TStrings; const Sep: string; const NumberOfItems: SizeInt; const AllowEmptyString: + Boolean = True): string; +var + I, L, N: SizeInt; +begin + Result := ''; + if List.Count > NumberOfItems then + N := NumberOfItems + else + N := List.Count; + for I := 0 to N - 1 do + begin + if (List[I] <> '') or AllowEmptyString then + begin + // don't combine these into one addition, somehow it hurts performance + Result := Result + List[I]; + Result := Result + Sep; + end; + end; + // remove terminating separator + if N > 0 then + begin + L := Length(Sep); + Delete(Result, Length(Result) - L + 1, L); + end; +end; + +procedure TrimStrings(const List: TStrings; DeleteIfEmpty: Boolean); +var + I: SizeInt; +begin + Assert(List <> nil); + List.BeginUpdate; + try + for I := List.Count - 1 downto 0 do + begin + List[I] := Trim(List[I]); + if (List[I] = '') and DeleteIfEmpty then + List.Delete(I); + end; + finally + List.EndUpdate; + end; +end; + +procedure TrimStringsRight(const List: TStrings; DeleteIfEmpty: Boolean); +var + I: SizeInt; +begin + Assert(List <> nil); + List.BeginUpdate; + try + for I := List.Count - 1 downto 0 do + begin + List[I] := TrimRight(List[I]); + if (List[I] = '') and DeleteIfEmpty then + List.Delete(I); + end; + finally + List.EndUpdate; + end; +end; + +procedure TrimStringsLeft(const List: TStrings; DeleteIfEmpty: Boolean); +var + I: SizeInt; +begin + Assert(List <> nil); + List.BeginUpdate; + try + for I := List.Count - 1 downto 0 do + begin + List[I] := TrimLeft(List[I]); + if (List[I] = '') and DeleteIfEmpty then + List.Delete(I); + end; + finally + List.EndUpdate; + end; +end; + +function AddStringToStrings(const S: string; Strings: TStrings; const Unique: Boolean): Boolean; +begin + Assert(Strings <> nil); + Result := Unique and (Strings.IndexOf(S) <> -1); + if not Result then + Result := Strings.Add(S) > -1; +end; + +//=== Miscellaneous ========================================================== + +function FileToString(const FileName: string): {$IFDEF COMPILER12_UP}RawByteString{$ELSE}AnsiString{$ENDIF}; +var + fs: TFileStream; + Len: SizeInt; +begin + fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); + try + Len := fs.Size; + SetLength(Result, Len); + if Len > 0 then + fs.ReadBuffer(Result[1], Len); + finally + fs.Free; + end; +end; + +procedure StringToFile(const FileName: string; const Contents: {$IFDEF COMPILER12_UP}RawByteString{$ELSE}AnsiString{$ENDIF}; + Append: Boolean); +var + FS: TFileStream; + Len: SizeInt; +begin + if Append and FileExists(filename) then + FS := TFileStream.Create(FileName, fmOpenReadWrite or fmShareDenyWrite) + else + FS := TFileStream.Create(FileName, fmCreate); + try + if Append then + FS.Seek(0, soEnd); // faster than .Position := .Size + Len := Length(Contents); + if Len > 0 then + FS.WriteBuffer(Contents[1], Len); + finally + FS.Free; + end; +end; + +function StrToken(var S: string; Separator: Char): string; +var + I: SizeInt; +begin + I := Pos(Separator, S); + if I <> 0 then + begin + Result := Copy(S, 1, I - 1); + Delete(S, 1, I); + end + else + begin + Result := S; + S := ''; + end; +end; + +procedure StrTokens(const S: string; const List: TStrings); +var + Start: PChar; + Token: string; + Done: Boolean; +begin + Assert(List <> nil); + if List = nil then + Exit; + + List.BeginUpdate; + try + List.Clear; + Start := Pointer(S); + repeat + Done := JclStrings.StrWord(Start, Token); + if Token <> '' then + List.Add(Token); + until Done; + finally + List.EndUpdate; + end; +end; + +function StrWord(const S: string; var Index: SizeInt; out Word: string): Boolean; +var + Start: SizeInt; + C: Char; +begin + Word := ''; + if (S = '') then + begin + Result := True; + Exit; + end; + Start := Index; + Result := False; + while True do + begin + C := S[Index]; + case C of + #0: + begin + if Start <> 0 then + Word := Copy(S, Start, Index - Start); + Result := True; + Exit; + end; + NativeSpace, NativeLineFeed, NativeCarriageReturn: + begin + if Start <> 0 then + begin + Word := Copy(S, Start, Index - Start); + Exit; + end + else + begin + while CharIsWhiteSpace(C) do + begin + Inc(Index); + C := S[Index]; + end; + end; + end; + else + if Start = 0 then + Start := Index; + Inc(Index); + end; + end; +end; + +function StrWord(var S: PChar; out Word: string): Boolean; +var + Start: PChar; +begin + Word := ''; + if S = nil then + begin + Result := True; + Exit; + end; + Start := nil; + Result := False; + while True do + begin + case S^ of + #0: + begin + if Start <> nil then + SetString(Word, Start, S - Start); + Result := True; + Exit; + end; + NativeSpace, NativeLineFeed, NativeCarriageReturn: + begin + if Start <> nil then + begin + SetString(Word, Start, S - Start); + Exit; + end + else + while CharIsWhiteSpace(S^) do + Inc(S); + end; + else + if Start = nil then + Start := S; + Inc(S); + end; + end; +end; + +function StrIdent(const S: string; var Index: SizeInt; out Ident: string): Boolean; +var + Start: SizeInt; + C: Char; +begin + Ident := ''; + if (S = '') then + begin + Result := True; + Exit; + end; + Start := Index; + Result := False; + while True do + begin + C := S[Index]; + if CharIsValidIdentifierLetter(C) then + begin + if Start = 0 then + Start := Index; + end + else + if C = #0 then + begin + if Start <> 0 then + Ident := Copy(S, Start, Index - Start); + Result := True; + Exit; + end + else + begin + if Start <> 0 then + begin + Ident := Copy(S, Start, Index - Start); + Exit; + end; + end; + Inc(Index); + end; +end; + +function StrIdent(var S: PChar; out Ident: string): Boolean; +var + Start: PChar; + C: Char; +begin + Ident := ''; + if S = nil then + begin + Result := True; + Exit; + end; + Start := nil; + Result := False; + while True do + begin + C := S^; + if CharIsValidIdentifierLetter(C) then + begin + if Start = nil then + Start := S; + end + else + if C = #0 then + begin + if Start <> nil then + SetString(Ident, Start, S - Start); + Result := True; + Exit; + end + else + begin + if Start <> nil then + begin + SetString(Ident, Start, S - Start); + Exit; + end + end; + Inc(S); + end; +end; + +procedure StrTokenToStrings(S: string; Separator: Char; const List: TStrings); +var + Token: string; +begin + Assert(List <> nil); + + if List = nil then + Exit; + + List.BeginUpdate; + try + List.Clear; + while S <> '' do + begin + Token := StrToken(S, Separator); + List.Add(Token); + end; + finally + List.EndUpdate; + end; +end; + +function StrToFloatSafe(const S: string): Float; +var + Temp: string; + I, J, K: SizeInt; + SwapSeparators, IsNegative: Boolean; + DecSep, ThouSep, C: Char; +begin + DecSep := {$IFDEF RTL220_UP}FormatSettings.{$ENDIF}DecimalSeparator; + ThouSep := {$IFDEF RTL220_UP}FormatSettings.{$ENDIF}ThousandSeparator; + Temp := S; + SwapSeparators := False; + + IsNegative := False; + J := 0; + for I := 1 to Length(Temp) do + begin + C := Temp[I]; + if C = '-' then + IsNegative := not IsNegative + else + if (C <> ' ') and (C <> '(') and (C <> '+') then + begin + // if it appears prior to any digit, it has to be a decimal separator + SwapSeparators := Temp[I] = ThouSep; + J := I; + Break; + end; + end; + + if not SwapSeparators then + begin + K := CharPos(Temp, DecSep); + SwapSeparators := + // if it appears prior to any digit, it has to be a decimal separator + (K > J) and + // if it appears multiple times, it has to be a thousand separator + ((StrCharCount(Temp, DecSep) > 1) or + // we assume (consistent with Windows Platform SDK documentation), + // that thousand separators appear only to the left of the decimal + (K < CharPos(Temp, ThouSep))); + end; + + if SwapSeparators then + begin + // assume a numerical string from a different locale, + // where DecimalSeparator and ThousandSeparator are exchanged + for I := 1 to Length(Temp) do + if Temp[I] = DecSep then + Temp[I] := ThouSep + else + if Temp[I] = ThouSep then + Temp[I] := DecSep; + end; + + Temp := StrKeepChars(Temp, CharIsNumber); + + if Length(Temp) > 0 then + begin + if Temp[1] = DecSep then + Temp := '0' + Temp; + if Temp[Length(Temp)] = DecSep then + Temp := Temp + '0'; + Result := StrToFloat(Temp); + if IsNegative then + Result := -Result; + end + else + Result := 0.0; +end; + +function StrToIntSafe(const S: string): Integer; +begin + Result := Trunc(StrToFloatSafe(S)); +end; + +procedure StrNormIndex(const StrLen: SizeInt; var Index: SizeInt; var Count: SizeInt); overload; +begin + Index := Max(1, Min(Index, StrLen + 1)); + Count := Max(0, Min(Count, StrLen + 1 - Index)); +end; + +function ArrayOf(List: TStrings): TDynStringArray; +var + I: SizeInt; +begin + if List <> nil then + begin + SetLength(Result, List.Count); + for I := 0 to List.Count - 1 do + Result[I] := List[I]; + end + else + Result := nil; +end; + +const + BoolToStr: array [Boolean] of string = ('false', 'true'); + +type + TInterfacedObjectAccess = class(TInterfacedObject); + +procedure MoveChar(const Source; var Dest; Count: SizeInt); +begin + if Count > 0 then + Move(Source, Dest, Count * SizeOf(Char)); +end; + +function DotNetFormat(const Fmt: string; const Arg0: Variant): string; +begin + Result := DotNetFormat(Fmt, [Arg0]); +end; + +function DotNetFormat(const Fmt: string; const Arg0, Arg1: Variant): string; +begin + Result := DotNetFormat(Fmt, [Arg0, Arg1]); +end; + +function DotNetFormat(const Fmt: string; const Arg0, Arg1, Arg2: Variant): string; +begin + Result := DotNetFormat(Fmt, [Arg0, Arg1, Arg2]); +end; + +function DotNetFormat(const Fmt: string; const Args: array of const): string; +var + F, P: PChar; + Len, Capacity, Count: SizeInt; + Index: SizeInt; + ErrorCode: Integer; + S: string; + + procedure Grow(Count: SizeInt); + begin + if Len + Count > Capacity then + begin + Capacity := Capacity * 5 div 3 + Count; + SetLength(Result, Capacity); + end; + end; + + function InheritsFrom(AClass: TClass; const ClassName: string): Boolean; + begin + Result := True; + while AClass <> nil do + begin + if CompareText(AClass.ClassName, ClassName) = 0 then + Exit; + AClass := AClass.ClassParent; + end; + Result := False; + end; + + function GetStringOf(const V: TVarData; Index: SizeInt): string; overload; + begin + case V.VType of + varEmpty, varNull: + raise ArgumentNullException.CreateRes(@RsArgumentIsNull); + varSmallInt: + Result := IntToStr(V.VSmallInt); + varInteger: + Result := IntToStr(V.VInteger); + varSingle: + Result := FloatToStr(V.VSingle); + varDouble: + Result := FloatToStr(V.VDouble); + varCurrency: + Result := CurrToStr(V.VCurrency); + varDate: + Result := DateTimeToStr(V.VDate); + varOleStr: + Result := V.VOleStr; + varBoolean: + Result := BoolToStr[V.VBoolean <> False]; + varByte: + Result := IntToStr(V.VByte); + varWord: + Result := IntToStr(V.VWord); + varShortInt: + Result := IntToStr(V.VShortInt); + varLongWord: + Result := IntToStr(V.VLongWord); + varInt64: + Result := IntToStr(V.VInt64); + varString: + Result := string(V.VString); + {$IFDEF SUPPORTS_UNICODE_STRING} + varUString: + Result := string(V.VUString); + {$ENDIF SUPPORTS_UNICODE_STRING} + {varArray, + varDispatch, + varError, + varUnknown, + varAny, + varByRef:} + else + raise ArgumentNullException.CreateResFmt(@RsDotNetFormatArgumentNotSupported, [Index]); + end; + end; + + function GetStringOf(Index: SizeInt): string; overload; + var + V: TVarRec; + Intf: IToString; + begin + V := Args[Index]; + if (V.VInteger = 0) and + (V.VType in [vtExtended, vtString, vtObject, vtClass, vtCurrency, + vtInterface, vtInt64]) then + raise ArgumentNullException.CreateResFmt(@RsArgumentIsNull, [Index]); + + case V.VType of + vtInteger: + Result := IntToStr(V.VInteger); + vtBoolean: + Result := BoolToStr[V.VBoolean]; + vtChar: + Result := string(AnsiString(V.VChar)); + vtExtended: + Result := FloatToStr(V.VExtended^); + vtString: + Result := string(V.VString^); + vtPointer: + Result := IntToHex(TJclAddr(V.VPointer), 8); + vtPChar: + Result := string(AnsiString(V.VPChar)); + vtObject: + if (V.VObject is TInterfacedObject) and V.VObject.GetInterface(IToString, Intf) then + begin + Result := Intf.ToString; + Pointer(Intf) := nil; // do not release the object + // undo the RefCount change + Dec(TInterfacedObjectAccess(V.VObject).FRefCount); + end + else + if ((V.VObject is TComponent) or (V.VObject is TInterfacedPersistent)) and V.VObject.GetInterface(IToString, Intf) then + Result := Intf.ToString + {$IFDEF RTL200_UP} + else + Result := V.VObject.ToString; + {$ELSE} + else + raise ArgumentNullException.CreateResFmt(@RsDotNetFormatObjectArgumentNotSupported, [V.VObject.ClassName, Index]); + {$ENDIF RTL200_UP} + vtClass: + Result := V.VClass.ClassName; + vtWideChar: + Result := V.VWideChar; + vtPWideChar: + Result := V.VPWideChar; + vtAnsiString: + Result := string(V.VAnsiString); + vtCurrency: + Result := CurrToStr(V.VCurrency^); + vtVariant: + Result := GetStringOf(TVarData(V.VVariant^), Index); + vtInterface: + if IInterface(V.VInterface).QueryInterface(IToString, Intf) = 0 then + Result := IToString(Intf).ToString + else + raise ArgumentNullException.CreateResFmt(@RsDotNetFormatArgumentNotSupported, [Index]); + vtWideString: + Result := WideString(V.VWideString); + vtInt64: + Result := IntToStr(V.VInt64^); + {$IFDEF SUPPORTS_UNICODE_STRING} + vtUnicodeString: + Result := UnicodeString(V.VUnicodeString); + {$ENDIF SUPPORTS_UNICODE_STRING} + else + raise ArgumentNullException.CreateResFmt(@RsDotNetFormatArgumentNotSupported, [Index]); + end; + end; + +begin + if Length(Args) = 0 then + begin + Result := Fmt; + Exit; + end; + Len := 0; + Capacity := Length(Fmt); + SetLength(Result, Capacity); + if Capacity = 0 then + raise ArgumentNullException.CreateRes(@RsDotNetFormatNullFormat); + + P := Pointer(Fmt); + F := P; + while True do + begin + if (P[0] = #0) or (P[0] = '{') then + begin + Count := P - F; + Inc(P); + if (P[-1] <> #0) and (P[0] = '{') then + Inc(Count); // include '{' + + if Count > 0 then + begin + Grow(Count); + MoveChar(F[0], Result[Len + 1], Count); + Inc(Len, Count); + end; + + if P[-1] = #0 then + Break; + + if P[0] <> '{' then + begin + F := P; + Inc(P); + while (P[0] <> #0) and (P[0] <> '}') do + Inc(P); + SetString(S, F, P - F); + Val(S, Index, ErrorCode); + if ErrorCode <> 0 then + raise FormatException.CreateRes(@RsFormatException); + if (Index < 0) or (Index > High(Args)) then + raise FormatException.CreateRes(@RsFormatException); + S := GetStringOf(Index); + if S <> '' then + begin + Grow(Length(S)); + MoveChar(S[1], Result[Len + 1], Length(S)); + Inc(Len, Length(S)); + end; + + if P[0] = #0 then + Break; + end; + F := P + 1; + end + else + if (P[0] = '}') and (P[1] = '}') then + begin + Count := P - F + 1; + Inc(P); // skip next '}' + + Grow(Count); + MoveChar(F[0], Result[Len + 1], Count); + Inc(Len, Count); + F := P + 1; + end; + + Inc(P); + end; + + SetLength(Result, Len); +end; + +//=== { TJclStringBuilder } ===================================================== + +constructor TJclStringBuilder.Create(Capacity: SizeInt; MaxCapacity: SizeInt); +begin + inherited Create; + SetLength(FChars, Capacity); + FMaxCapacity := MaxCapacity; +end; + +constructor TJclStringBuilder.Create(const Value: string; Capacity: SizeInt); +begin + Create(Capacity); + Append(Value); +end; + +constructor TJclStringBuilder.Create(const Value: string; StartIndex, Length, Capacity: SizeInt); +begin + Create(Capacity); + Append(Value, StartIndex + 1, Length); +end; + +function TJclStringBuilder.ToString: string; +begin + if FLength > 0 then + SetString(Result, PChar(@FChars[0]), FLength) + else + Result := ''; +end; + +function TJclStringBuilder.EnsureCapacity(Capacity: SizeInt): SizeInt; +begin + if System.Length(FChars) < Capacity then + SetCapacity(Capacity); + Result := System.Length(FChars); +end; + +procedure TJclStringBuilder.Clear; +begin + Length := 0; +end; + +procedure TJclStringBuilder.SetCapacity(const Value: SizeInt); +begin + if Value <> System.Length(FChars) then + begin + SetLength(FChars, Value); + if Value < FLength then + FLength := Value; + end; +end; + +function TJclStringBuilder.GetChars(Index: SizeInt): Char; +begin + Result := FChars[Index]; +end; + +procedure TJclStringBuilder.SetChars(Index: SizeInt; const Value: Char); +begin + FChars[Index] := Value; +end; + +procedure TJclStringBuilder.Set_Length(const Value: SizeInt); +begin + FLength := Value; +end; + +function TJclStringBuilder.GetCapacity: SizeInt; +begin + Result := System.Length(FChars); +end; + +function TJclStringBuilder.AppendPChar(Value: PChar; Count: SizeInt; RepeatCount: SizeInt): TJclStringBuilder; +var + Capacity: SizeInt; +begin + if (Count > 0) and (RepeatCount > 0) then + begin + repeat + Capacity := System.Length(FChars); + if Capacity + Count > MaxCapacity then + raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange); + if Capacity < FLength + Count then + SetLength(FChars, Capacity * 5 div 3 + Count); + if Count = 1 then + FChars[FLength] := Value[0] + else + MoveChar(Value[0], FChars[FLength], Count); + Inc(FLength, Count); + Dec(RepeatCount); + until RepeatCount <= 0; + end; + Result := Self; +end; + +function TJclStringBuilder.InsertPChar(Index: SizeInt; Value: PChar; Count, + RepeatCount: SizeInt): TJclStringBuilder; +var + Capacity: SizeInt; +begin + if (Index < 0) or (Index > FLength) then + raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange); + + if Index = FLength then + AppendPChar(Value, Count, RepeatCount) + else + if (Count > 0) and (RepeatCount > 0) then + begin + repeat + Capacity := System.Length(FChars); + if Capacity + Count > MaxCapacity then + raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange); + if Capacity < FLength + Count then + SetLength(FChars, Capacity * 5 div 3 + Count); + MoveChar(FChars[Index], FChars[Index + Count], FLength - Index); + if Count = 1 then + FChars[Index] := Value[0] + else + MoveChar(Value[0], FChars[Index], Count); + Inc(FLength, Count); + + Dec(RepeatCount); + + Inc(Index, Count); // little optimization + until RepeatCount <= 0; + end; + Result := Self; +end; + +function TJclStringBuilder.Append(const Value: array of Char): TJclStringBuilder; +var + Len: SizeInt; +begin + Len := System.Length(Value); + if Len > 0 then + AppendPChar(@Value[0], Len); + Result := Self; +end; + +function TJclStringBuilder.Append(const Value: array of Char; StartIndex, Length: SizeInt): TJclStringBuilder; +var + Len: SizeInt; +begin + Len := System.Length(Value); + if (Length > 0) and (StartIndex < Len) then + begin + if StartIndex + Length > Len then + Length := Len - StartIndex; + AppendPChar(PChar(@Value[0]) + StartIndex, Length); + end; + Result := Self; +end; + +function TJclStringBuilder.Append(Value: Char; RepeatCount: SizeInt = 1): TJclStringBuilder; +begin + Result := AppendPChar(@Value, 1, RepeatCount); +end; + +function TJclStringBuilder.Append(const Value: string): TJclStringBuilder; +var + Len: SizeInt; +begin + Len := System.Length(Value); + if Len > 0 then + AppendPChar(Pointer(Value), Len); + Result := Self; +end; + +function TJclStringBuilder.Append(const Value: string; StartIndex, Length: SizeInt): TJclStringBuilder; +var + Len: SizeInt; +begin + Len := System.Length(Value); + if (Length > 0) and (StartIndex < Len) then + begin + if StartIndex + Length > Len then + Length := Len - StartIndex; + AppendPChar(PChar(Pointer(Value)) + StartIndex, Length); + end; + Result := Self; +end; + +function TJclStringBuilder.Append(Value: Boolean): TJclStringBuilder; +begin + Result := Append(BoolToStr[Value]); +end; + +function TJclStringBuilder.Append(Value: Cardinal): TJclStringBuilder; +begin + Result := Append(IntToStr(Value)); +end; + +function TJclStringBuilder.Append(Value: Integer): TJclStringBuilder; +begin + Result := Append(IntToStr(Value)); +end; + +function TJclStringBuilder.Append(Value: Double): TJclStringBuilder; +begin + Result := Append(FloatToStr(Value)); +end; + +function TJclStringBuilder.Append(Value: Int64): TJclStringBuilder; +begin + Result := Append(IntToStr(Value)); +end; + +function TJclStringBuilder.Append(Obj: TObject): TJclStringBuilder; +begin + Result := Append(DotNetFormat('{0}', [Obj])); +end; + +function TJclStringBuilder.AppendFormat(const Fmt: string; Arg0: Variant): TJclStringBuilder; +begin + Result := Append(DotNetFormat(Fmt, [Arg0])); +end; + +function TJclStringBuilder.AppendFormat(const Fmt: string; Arg0, Arg1: Variant): TJclStringBuilder; +begin + Result := Append(DotNetFormat(Fmt, [Arg0, Arg1])); +end; + +function TJclStringBuilder.AppendFormat(const Fmt: string; Arg0, Arg1, Arg2: Variant): TJclStringBuilder; +begin + Result := Append(DotNetFormat(Fmt, [Arg0, Arg1, Arg2])); +end; + +function TJclStringBuilder.AppendFormat(const Fmt: string; const Args: array of const): TJclStringBuilder; +begin + Result := Append(DotNetFormat(Fmt, Args)); +end; + +function TJclStringBuilder.Insert(Index: SizeInt; const Value: array of Char): TJclStringBuilder; +var + Len: SizeInt; +begin + Len := System.Length(Value); + if Len > 0 then + InsertPChar(Index, @Value[0], Len); + Result := Self; +end; + +function TJclStringBuilder.Insert(Index: SizeInt; const Value: string; Count: SizeInt): TJclStringBuilder; +var + Len: SizeInt; +begin + Len := System.Length(Value); + if Len > 0 then + InsertPChar(Index, Pointer(Value), Len, Count); + Result := Self; +end; + +function TJclStringBuilder.Insert(Index: SizeInt; Value: Boolean): TJclStringBuilder; +begin + Result := Insert(Index, BoolToStr[Value]); +end; + +function TJclStringBuilder.Insert(Index: SizeInt; const Value: array of Char; + StartIndex, Length: SizeInt): TJclStringBuilder; +var + Len: SizeInt; +begin + Len := System.Length(Value); + if (Length > 0) and (StartIndex < Len) then + begin + if StartIndex + Length > Len then + Length := Len - StartIndex; + InsertPChar(Index, PChar(@Value[0]) + StartIndex, Length); + end; + Result := Self; +end; + +function TJclStringBuilder.Insert(Index: SizeInt; Value: Double): TJclStringBuilder; +begin + Result := Insert(Index, FloatToStr(Value)); +end; + +function TJclStringBuilder.Insert(Index: SizeInt; Value: Int64): TJclStringBuilder; +begin + Result := Insert(Index, IntToStr(Value)); +end; + +function TJclStringBuilder.Insert(Index: SizeInt; Value: Cardinal): TJclStringBuilder; +begin + Result := Insert(Index, IntToStr(Value)); +end; + +function TJclStringBuilder.Insert(Index: SizeInt; Value: Integer): TJclStringBuilder; +begin + Result := Insert(Index, IntToStr(Value)); +end; + +function TJclStringBuilder.Insert(Index: SizeInt; Obj: TObject): TJclStringBuilder; +begin + Result := Insert(Index, DotNetFormat('{0}', [Obj])); +end; + +function TJclStringBuilder.Remove(StartIndex, Length: SizeInt): TJclStringBuilder; +begin + if (StartIndex < 0) or (Length < 0) or (StartIndex + Length >= FLength) then + raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange); + if Length > 0 then + begin + MoveChar(FChars[StartIndex + Length], FChars[StartIndex], FLength - (StartIndex + Length)); + Dec(FLength, Length); + end; + Result := Self; +end; + +function TJclStringBuilder.Replace(OldChar, NewChar: Char; StartIndex, + Count: SizeInt): TJclStringBuilder; +var + I: SizeInt; +begin + if Count = -1 then + Count := FLength; + if (StartIndex < 0) or (Count < 0) or (StartIndex + Count > FLength) then + raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange); + if (Count > 0) and (OldChar <> NewChar) then + begin + for I := StartIndex to StartIndex + Length - 1 do + if FChars[I] = OldChar then + FChars[I] := NewChar; + end; + Result := Self; +end; + +function TJclStringBuilder.Replace(OldValue, NewValue: string; StartIndex, Count: SizeInt): TJclStringBuilder; +var + I: SizeInt; + Offset: SizeInt; + NewLen, OldLen, Capacity: SizeInt; +begin + if Count = -1 then + Count := FLength; + if (StartIndex < 0) or (Count < 0) or (StartIndex + Count > FLength) then + raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange); + if OldValue = '' then + raise ArgumentException.CreateResFmt(@RsArgumentIsNull, [0]); + + if (Count > 0) and (OldValue <> NewValue) then + begin + OldLen := System.Length(OldValue); + NewLen := System.Length(NewValue); + Offset := NewLen - OldLen; + Capacity := System.Length(FChars); + for I := StartIndex to StartIndex + Length - 1 do + if FChars[I] = OldValue[1] then + begin + if OldLen > 1 then + if StrLComp(@FChars[I + 1], PChar(OldValue) + 1, OldLen - 1) <> 0 then + Continue; + if Offset <> 0 then + begin + if FLength - OldLen + NewLen > MaxCurrency then + raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange); + if Capacity < FLength + Offset then + begin + Capacity := Capacity * 5 div 3 + Offset; + SetLength(FChars, Capacity); + end; + if Offset < 0 then + MoveChar(FChars[I - Offset], FChars[I], FLength - I) + else + MoveChar(FChars[I + OldLen], FChars[I + OldLen + Offset], FLength - OldLen - I); + Inc(FLength, Offset); + end; + if NewLen > 0 then + begin + if (OldLen = 1) and (NewLen = 1) then + FChars[I] := NewValue[1] + else + MoveChar(NewValue[1], FChars[I], NewLen); + end; + end; + end; + Result := Self; +end; + +function StrExpandTabs(S: string): string; +begin + // use an empty tab set, which will default to a tab width of 2 + Result := TJclTabSet(nil).Expand(s); +end; + +function StrExpandTabs(S: string; TabWidth: SizeInt): string; +var + TabSet: TJclTabSet; +begin + // create a tab set with no tab stops and the given tab width + TabSet := TJclTabSet.Create(TabWidth); + try + Result := TabSet.Expand(S); + finally + TabSet.Free; + end; +end; + +function StrExpandTabs(S: string; TabSet: TJclTabSet): string; +begin + // use the provided tab set to perform the expansion + Result := TabSet.Expand(S); +end; + +function StrOptimizeTabs(S: string): string; +begin + // use an empty tab set, which will default to a tab width of 2 + Result := TJclTabSet(nil).Optimize(s); +end; + +function StrOptimizeTabs(S: string; TabWidth: SizeInt): string; +var + TabSet: TJclTabSet; +begin + // create a tab set with no tab stops and the given tab width + TabSet := TJclTabSet.Create(TabWidth); + try + Result := TabSet.Optimize(S); + finally + TabSet.Free; + end; +end; + +function StrOptimizeTabs(S: string; TabSet: TJclTabSet): string; +begin + // use the provided tab set to perform the optimization + Result := TabSet.Optimize(S); +end; + +// === { TTabSetData } =================================================== + +type + TTabSetData = class + public + FStops: TDynSizeIntArray; + FRealWidth: SizeInt; + FRefCount: SizeInt; + FWidth: SizeInt; + FZeroBased: Boolean; + constructor Create(TabStops: array of SizeInt; ZeroBased: Boolean; TabWidth: SizeInt); + + function Add(Column: SizeInt): SizeInt; + function AddRef: SizeInt; + procedure CalcRealWidth; + function FindStop(Column: SizeInt): SizeInt; + function ReleaseRef: SizeInt; + procedure RemoveAt(Index: SizeInt); + procedure SetStops(Index, Value: SizeInt); + end; + +constructor TTabSetData.Create(TabStops: array of SizeInt; ZeroBased: Boolean; TabWidth: SizeInt); +var + idx: SizeInt; +begin + inherited Create; + FRefCount := 1; + for idx := 0 to High(Tabstops) do + Add(Tabstops[idx]); + FWidth := TabWidth; + FZeroBased := ZeroBased; + CalcRealWidth; +end; + +function TTabSetData.Add(Column: SizeInt): SizeInt; +var + I: SizeInt; +begin + if Column < Ord(FZeroBased) then + raise ArgumentOutOfRangeException.Create('Column'); + Result := FindStop(Column); + if Result < 0 then + begin + // the column doesn't exist; invert the result of FindStop to get the correct index position + Result := not Result; + // increase the tab stop array + SetLength(FStops, Length(FStops) + 1); + // shift rooms after the insert position + for I := High(FStops) - 1 downto Result do + FStops[I + 1] := FStops[I]; + // add the tab stop at the correct location + FStops[Result] := Column; + CalcRealWidth; + end + else + begin + raise EJclStringError.CreateRes(@RsTabs_DuplicatesNotAllowed); + end; +end; + +function TTabSetData.AddRef: SizeInt; +begin + Result := LockedInc(FRefCount); +end; + +procedure TTabSetData.CalcRealWidth; +begin + if FWidth < 1 then + begin + if Length(FStops) > 1 then + FRealWidth := FStops[High(FStops)] - FStops[Pred(High(FStops))] + else + if Length(FStops) = 1 then + FRealWidth := FStops[0] + else + FRealWidth := 2; + end + else + FRealWidth := FWidth; +end; + +function TTabSetData.FindStop(Column: SizeInt): SizeInt; +begin + Result := High(FStops); + while (Result >= 0) and (FStops[Result] > Column) do + Dec(Result); + if (Result >= 0) and (FStops[Result] <> Column) then + Result := not Succ(Result); +end; + +function TTabSetData.ReleaseRef: SizeInt; +begin + Result := LockedDec(FRefCount); + if Result <= 0 then + Destroy; +end; + +procedure TTabSetData.RemoveAt(Index: SizeInt); +var + I: SizeInt; +begin + for I := Index to High(FStops) - 1 do + FStops[I] := FStops[I + 1]; + SetLength(FStops, High(FStops)); + CalcRealWidth; +end; + +procedure TTabSetData.SetStops(Index, Value: SizeInt); +var + temp: SizeInt; +begin + if (Index < 0) or (Index >= Length(FStops)) then + begin + raise ArgumentOutOfRangeException.CreateRes(@RsArgumentOutOfRange); + end + else + begin + temp := FindStop(Value); + if temp < 0 then + begin + // remove existing tab stop... + RemoveAt(Index); + // now add the new tab stop + Add(Value); + end + else + if temp <> Index then + begin + // new tab stop already present at another index + raise EJclStringError.CreateRes(@RsTabs_DuplicatesNotAllowed); + end; + end; +end; + +//=== { TJclTabSet } ===================================================== + +constructor TJclTabSet.Create; +begin + // no tab stops, tab width set to auto + Create([], True, 0); +end; + +constructor TJclTabSet.Create(TabWidth: SizeInt); +begin + // no tab stops, specified tab width + Create([], True, TabWidth); +end; + +constructor TJclTabSet.Create(const Tabstops: array of SizeInt; ZeroBased: Boolean); +begin + // specified tab stops, tab width equal to distance between last two tab stops + Create(Tabstops, ZeroBased, 0); +end; + +constructor TJclTabSet.Create(const Tabstops: array of SizeInt; ZeroBased: Boolean; TabWidth: SizeInt); +begin + inherited Create; + FData := TTabSetData.Create(Tabstops, ZeroBased, TabWidth); +end; + +constructor TJclTabSet.Create(Data: TObject); +begin + inherited Create; + // add a reference to the data + TTabSetData(Data).AddRef; + // assign the data to this instance + FData := TTabSetData(Data); +end; + +destructor TJclTabSet.Destroy; +begin + // release the reference to the tab set data + TTabSetData(FData).ReleaseRef; + // make sure we won't accidentally refer to it later, just in case something goes wrong during destruction + FData := nil; + // really destroy the instance + inherited Destroy; +end; + +function TJclTabSet.Add(Column: SizeInt): SizeInt; +begin + if Self = nil then + raise NullReferenceException.Create; + Result := TTabSetData(FData).Add(Column); +end; + +function TJclTabSet.Clone: TJclTabSet; +begin + if Self <> nil then + Result := TJclTabSet.Create(TTabSetData(FData).FStops, TTabSetData(FData).FZeroBased, TTabSetData(FData).FWidth) + else + Result := nil; +end; + +function TJclTabSet.Delete(Column: SizeInt): SizeInt; +begin + Result := TTabSetData(FData).FindStop(Column); + if Result >= 0 then + TTabSetData(FData).RemoveAt(Result); +end; + +function TJclTabSet.Expand(const S: string): string; +begin + Result := Expand(s, StartColumn); +end; + +function TJclTabSet.Expand(const S: string; Column: SizeInt): string; +var + sb: TJclStringBuilder; + head: PChar; + cur: PChar; +begin + if Column < StartColumn then + raise ArgumentOutOfRangeException.Create('Column'); + sb := TJclStringBuilder.Create(Length(S)); + try + cur := PChar(S); + while cur^ <> #0 do + begin + head := cur; + while (cur^ <> #0) and (cur^ <> #9) do + begin + if CharIsReturn(cur^) then + Column := StartColumn + else + Inc(Column); + Inc(cur); + end; + if cur > head then + sb.Append(head, 0, cur - head); + if cur^ = #9 then + begin + sb.Append(' ', TabFrom(Column) - Column); + Column := TabFrom(Column); + Inc(cur); + end; + end; + Result := sb.ToString; + finally + sb.Free; + end; +end; + +function TJclTabSet.FindStop(Column: SizeInt): SizeInt; +begin + if Self <> nil then + Result := TTabSetData(FData).FindStop(Column) + else + Result := -1; +end; + +class function TJclTabSet.FromString(const S: string): TJclTabSet; +var + cur: PChar; + + function ParseNumber: Integer; + var + head: PChar; + begin + StrSkipChars(cur, CharIsWhiteSpace); + head := cur; + while CharIsDigit(cur^) do + Inc(cur); + Result := -1; + if (cur <= head) or not TryStrToInt(Copy(head, 1, cur - head), Result) then + Result := -1; + end; + + procedure ParseStops; + var + openBracket, hadComma: Boolean; + num: SizeInt; + begin + StrSkipChars(cur, CharIsWhiteSpace); + openBracket := cur^ = '['; + hadComma := False; + if openBracket then + Inc(cur); + repeat + num := ParseNumber; + if (num < 0) and hadComma then + raise EJclStringError.CreateRes(@RsTabs_StopExpected) + else + if num >= 0 then + Result.Add(num); + StrSkipChars(cur, CharIsWhiteSpace); + hadComma := cur^ = ','; + if hadComma then + Inc(cur); + until (cur^ = #0) or (cur^ = '+') or (cur^ = ']'); + if hadComma then + raise EJclStringError.CreateRes(@RsTabs_StopExpected) + else + if openBracket and (cur^ <> ']') then + raise EJclStringError.CreateRes(@RsTabs_CloseBracketExpected); + end; + + procedure ParseTabWidth; + var + num: SizeInt; + begin + StrSkipChars(cur, CharIsWhiteSpace); + if cur^ = '+' then + begin + Inc(cur); + StrSkipChars(cur, CharIsWhiteSpace); + num := ParseNumber; + if (num < 0) then + raise EJclStringError.CreateRes(@RsTabs_TabWidthExpected) + else + Result.TabWidth := num; + end; + end; + + procedure ParseZeroBasedFlag; + begin + StrSkipChars(cur, CharIsWhiteSpace); + if cur^ = '0' then + begin + Inc(cur); + if CharIsWhiteSpace(cur^) or (cur^ = #0) or (cur^ = '[') then + begin + Result.ZeroBased := True; + StrSkipChars(cur, CharIsWhiteSpace); + end + else + Dec(cur); + end; + end; + +begin + Result := TJclTabSet.Create; + try + Result.ZeroBased := False; + cur := PChar(S); + ParseZeroBasedFlag; + ParseStops; + ParseTabWidth; + except + // clean up the partially complete instance (to avoid memory leaks)... + Result.Free; + // ... and re-raise the exception + raise; + end; +end; + +function TJclTabSet.GetCount: SizeInt; +begin + if Self <> nil then + Result := Length(TTabSetData(FData).FStops) + else + Result := 0; +end; + +function TJclTabSet.GetStops(Index: SizeInt): SizeInt; +begin + if Self <> nil then + begin + if (Index < 0) or (Index >= Length(TTabSetData(FData).FStops)) then + begin + raise EJclStringError.CreateRes(@RsArgumentOutOfRange); + end + else + Result := TTabSetData(FData).FStops[Index]; + end + else + begin + raise EJclStringError.CreateRes(@RsArgumentOutOfRange); + end; +end; + +function TJclTabSet.GetTabWidth: SizeInt; +begin + if Self <> nil then + Result := TTabSetData(FData).FWidth + else + Result := 0; +end; + +function TJclTabSet.GetZeroBased: Boolean; +begin + Result := (Self = nil) or TTabSetData(FData).FZeroBased; +end; + +procedure TJclTabSet.OptimalFillInfo(StartColumn, TargetColumn: SizeInt; out TabsNeeded, SpacesNeeded: SizeInt); +var + nextTab: SizeInt; +begin + if StartColumn < Self.StartColumn then // starting column less than 1 or 0 (depending on ZeroBased state) + raise ArgumentOutOfRangeException.Create('StartColumn'); + if (TargetColumn < StartColumn) then // target lies before the starting column + raise ArgumentOutOfRangeException.Create('TargetColumn'); + TabsNeeded := 0; + repeat + nextTab := TabFrom(StartColumn); + if nextTab <= TargetColumn then + begin + Inc(TabsNeeded); + StartColumn := nextTab; + end; + until nextTab > TargetColumn; + SpacesNeeded := TargetColumn - StartColumn; +end; + +function TJclTabSet.Optimize(const S: string): string; +begin + Result := Optimize(S, StartColumn); +end; + +function TJclTabSet.Optimize(const S: string; Column: SizeInt): string; +var + sb: TJclStringBuilder; + head: PChar; + cur: PChar; + tgt: SizeInt; + + procedure AppendOptimalWhiteSpace(Target: SizeInt); + var + tabCount: SizeInt; + spaceCount: SizeInt; + begin + if cur > head then + begin + OptimalFillInfo(Column, Target, tabCount, spaceCount); + if tabCount > 0 then + sb.Append(#9, tabCount); + if spaceCount > 0 then + sb.Append(' ', spaceCount); + end; + end; + +begin + if Column < StartColumn then + raise ArgumentOutOfRangeException.Create('Column'); + sb := TJclStringBuilder.Create(Length(S)); + try + cur := PChar(s); + while cur^ <> #0 do + begin + // locate first whitespace character + head := cur; + while (cur^ <> #0) and not CharIsWhiteSpace(cur^) do + Inc(cur); + // output non whitespace characters + if cur > head then + sb.Append(head, 0, cur - head); + // advance column + Inc(Column, cur - head); + // initialize target column indexer + tgt := Column; + // locate end of whitespace sequence + while CharIsWhiteSpace(cur^) do + begin + if CharIsReturn(cur^) then + begin + // append optimized whitespace sequence... + AppendOptimalWhiteSpace(tgt); + // ...set the column back to the start of the line... + Column := StartColumn; + // ...reset target column indexer... + tgt := Column; + // ...add the line break character... + sb.Append(cur^); + end + else + if cur^ = #9 then + tgt := TabFrom(tgt) // expand the tab + else + Inc(tgt); // a normal whitespace; taking up 1 column + Inc(cur); + end; + AppendOptimalWhiteSpace(tgt); // append optimized whitespace sequence... + Column := tgt; // ...and memorize the column for the next iteration + end; + Result := sb.ToString; // convert result to a string + finally + sb.Free; + end; +end; + +procedure TJclTabSet.RemoveAt(Index: SizeInt); +begin + if Self <> nil then + TTabSetData(FData).RemoveAt(Index) + else + raise NullReferenceException.Create; +end; + +procedure TJclTabSet.SetStops(Index, Value: SizeInt); +begin + if Self <> nil then + TTabSetData(FData).SetStops(Index, Value) + else + raise NullReferenceException.Create; +end; + +procedure TJclTabSet.SetTabWidth(Value: SizeInt); +begin + if Self <> nil then + begin + TTabSetData(FData).FWidth := Value; + TTabSetData(FData).CalcRealWidth; + end + else + raise NullReferenceException.Create; +end; + +procedure TJclTabSet.SetZeroBased(Value: Boolean); +var + shift: SizeInt; + idx: SizeInt; +begin + if Self <> nil then + begin + if Value <> TTabSetData(FData).FZeroBased then + begin + TTabSetData(FData).FZeroBased := Value; + if Value then + shift := -1 + else + shift := 1; + for idx := 0 to High(TTabSetData(FData).FStops) do + TTabSetData(FData).FStops[idx] := TTabSetData(FData).FStops[idx] + shift; + end; + end + else + raise NullReferenceException.Create; +end; + +function TJclTabSet.InternalTabStops: TDynSizeIntArray; +begin + if Self <> nil then + Result := TTabSetData(FData).FStops + else + Result := nil; +end; + +function TJclTabSet.InternalTabWidth: SizeInt; +begin + if Self <> nil then + Result := TTabSetData(FData).FRealWidth + else + Result := 2; +end; + +function TJclTabSet.NewReference: TJclTabSet; +begin + if Self <> nil then + Result := TJclTabSet.Create(FData) + else + Result := nil; +end; + +function TJclTabSet.StartColumn: SizeInt; +begin + if GetZeroBased then + Result := 0 + else + Result := 1; +end; + +function TJclTabSet.TabFrom(Column: SizeInt): SizeInt; +begin + if Column < StartColumn then + raise ArgumentOutOfRangeException.Create('Column'); + Result := FindStop(Column); + if Result < 0 then + Result := not Result + else + Inc(Result); + if Result >= GetCount then + begin + if GetCount > 0 then + Result := TTabSetData(FData).FStops[High(TTabSetData(FData).FStops)] + else + Result := StartColumn; + while Result <= Column do + Inc(Result, ActualTabWidth); + end + else + Result := TTabSetData(FData).FStops[Result]; +end; + +function TJclTabSet.ToString: string; +begin + Result := ToString(TabSetFormatting_Full); +end; + +function TJclTabSet.ToString(FormattingOptions: SizeInt): string; +var + sb: TJclStringBuilder; + idx: SizeInt; + + function WantBrackets: Boolean; + begin + Result := (TabSetFormatting_SurroundStopsWithBrackets and FormattingOptions) <> 0; + end; + + function EmptyBrackets: Boolean; + begin + Result := (TabSetFormatting_EmptyBracketsIfNoStops and FormattingOptions) <> 0; + end; + + function IncludeAutoWidth: Boolean; + begin + Result := (TabSetFormatting_AutoTabWidth and FormattingOptions) <> 0; + end; + + function IncludeTabWidth: Boolean; + begin + Result := (TabSetFormatting_NoTabWidth and FormattingOptions) = 0; + end; + + function IncludeStops: Boolean; + begin + Result := (TabSetFormatting_NoTabStops and FormattingOptions) = 0; + end; + +begin + sb := TJclStringBuilder.Create; + try + // output the fixed tabulation positions if requested... + if IncludeStops then + begin + // output each individual tabulation position + for idx := 0 to GetCount - 1 do + begin + sb.Append(TabStops[idx]); + sb.Append(','); + end; + // remove the final comma if any tabulation positions where outputted + if sb.Length <> 0 then + sb.Remove(sb.Length - 1, 1); + // bracket the tabulation positions if requested + if WantBrackets and (EmptyBrackets or (sb.Length > 0)) then + begin + sb.Insert(0, '['); + sb.Append(']'); + end; + end; + // output the tab width if requested.... + if IncludeTabWidth and (IncludeAutoWidth or (TabWidth > 0)) then + begin + // separate the tab width from any outputted tabulation positions with a whitespace + if sb.Length > 0 then + sb.Append(' '); + // flag tab width + sb.Append('+'); + // finally, output the tab width + sb.Append(ActualTabWidth); + end; + // flag zero-based tabset by outputting a 0 (zero) as the first character. + if ZeroBased then + sb.Insert(0, string('0 ')); + Result := StrTrimCharRight(sb.ToString, ' '); + finally + sb.Free; + end; +end; + +function TJclTabSet.UpdatePosition(const S: string): SizeInt; +var + Line: SizeInt; +begin + Result := StartColumn; + Line := -1; + UpdatePosition(S, Result, Line); +end; + +function TJclTabSet.UpdatePosition(const S: string; Column: SizeInt): SizeInt; +var + Line: SizeInt; +begin + if Column < StartColumn then + raise ArgumentOutOfRangeException.Create('Column'); + Result := Column; + Line := -1; + UpdatePosition(S, Result, Line); +end; + +function TJclTabSet.UpdatePosition(const S: string; var Column, Line: SizeInt): SizeInt; +var + prevChar: Char; + cur: PChar; +begin + if Column < StartColumn then + raise ArgumentOutOfRangeException.Create('Column'); + // initialize loop + cur := PChar(S); + // iterate until end of string (the Null-character) + while cur^ <> #0 do + begin + // check for line-breaking characters + if CharIsReturn(cur^) then + begin + // Column moves back all the way to the left + Column := StartColumn; + // If this is the first line-break character or the same line-break character, increment the Line parameter + Inc(Line); + // check if it's the first of a two-character line-break + prevChar := cur^; + Inc(cur); + // if it isn't a two-character line-break, undo the previous advancement + if (cur^ = prevChar) or not CharIsReturn(cur^) then + Dec(cur); + end + else // check for tab character and expand it + if cur^ = #9 then + Column := TabFrom(Column) + else // a normal character; increment column + Inc(Column); + // advance pointer + Inc(cur); + end; + // set the result to the newly calculated column + Result := Column; +end; + +//=== { NullReferenceException } ============================================= + +constructor NullReferenceException.Create; +begin + CreateRes(@RsArg_NullReferenceException); +end; + +function CompareNatural(const S1, S2: string; CaseInsensitive: Boolean): SizeInt; +var + Cur1, Len1, + Cur2, Len2: SizeInt; + + function IsRealNumberChar(ch: Char): Boolean; + begin + Result := ((ch >= '0') and (ch <= '9')) or (ch = '-') or (ch = '+'); + end; + + procedure NumberCompare; + var + IsReallyNumber: Boolean; + FirstDiffBreaks: Boolean; + Val1, Val2: SizeInt; + begin + Result := 0; + IsReallyNumber := False; + // count leading spaces in S1 + while (Cur1 <= Len1) and CharIsWhiteSpace(S1[Cur1]) do + begin + Dec(Result); + Inc(Cur1); + end; + // count leading spaces in S2 (canceling them out against the ones in S1) + while (Cur2 <= Len2) and CharIsWhiteSpace(S2[Cur2]) do + begin + Inc(Result); + Inc(Cur2); + end; + + // if spaces match, or both strings are actually followed by a numeric character, continue the checks + if (Result = 0) or ((Cur1 <= Len1) and CharIsNumberChar(S1[Cur1]) and (Cur2 <= Len2) and CharIsNumberChar(S2[Cur2])) then + begin + // Check signed number + if (Cur1 <= Len1) and (S1[Cur1] = '-') and ((Cur2 > Len2) or (S2[Cur2] <> '-')) then + Result := 1 + else + if (Cur2 <= Len2) and (S2[Cur2] = '-') and ((Cur1 > Len1) or (S1[Cur1] <> '-')) then + Result := -1 + else + Result := 0; + + if (Cur1 <= Len1) and ((S1[Cur1] = '-') or (S1[Cur1] = '+')) then + Inc(Cur1); + if (Cur2 <= Len2) and ((S2[Cur2] = '-') or (S2[Cur2] = '+')) then + Inc(Cur2); + + FirstDiffBreaks := (Cur1 <= Len1) and (S1[Cur1] = '0') or (Cur2 <= Len2) and (S2[Cur2] = '0'); + while (Cur1 <= Len1) and CharIsDigit(S1[Cur1]) and (Cur2 <= Len2) and CharIsDigit(S2[Cur2]) do + begin + IsReallyNumber := True; + Val1 := StrToInt(S1[Cur1]); + Val2 := StrToInt(S2[Cur2]); + + if (Result = 0) and (Val1 < Val2) then + Result := -1 + else + if (Result = 0) and (Val1 > Val2) then + Result := 1; + if FirstDiffBreaks and (Result <> 0) then + Break; + Inc(Cur1); + Inc(Cur2); + end; + + if IsReallyNumber then + begin + if not FirstDiffBreaks then + begin + if (Cur1 <= Len1) and CharIsDigit(S1[Cur1]) then + Result := 1 + else + if (Cur2 <= Len2) and CharIsDigit(S2[Cur2]) then + Result := -1; + end; + end; + end; + end; + + procedure SetByCompareLength; + var + Remain1: SizeInt; + Remain2: SizeInt; + begin + // base result on relative compare length (spaces could be ignored, so even if S1 is longer than S2, they could be + // completely equal, or S2 could be longer) + Remain1 := Len1 - Cur1 + 1; + Remain2 := Len2 - Cur2 + 1; + if Remain1 < 0 then + Remain1 := 0; + if Remain2 < 0 then + Remain2 := 0; + + if Remain1 < Remain2 then + Result := -1 + else + if Remain1 > Remain2 then + Result := 1; + end; + +begin + Cur1 := 1; + Len1 := Length(S1); + Cur2 := 1; + Len2 := Length(S2); + Result := 0; + + while (Result = 0) do + begin + if (Cur1 > Len1) or (Cur2 > Len2) then + begin + SetByCompareLength; + Break; + end + else + if (Cur1 <= Len1) and (Cur2 > Len2) then + Result := 1 + else + if (S1[Cur1] = '-') and IsRealNumberChar(S2[Cur2]) and (S2[Cur2] <> '-') then + Result := -1 + else + if (S2[Cur2] = '-') and IsRealNumberChar(S1[Cur1]) and (S1[Cur1] <> '-') then + Result := 1 + else + if (IsRealNumberChar(S1[Cur1]) or CharIsWhiteSpace(S1[Cur1])) and (IsRealNumberChar(S2[Cur2]) or CharIsWhiteSpace(S2[Cur2])) then + NumberCompare + else + begin + if CaseInsensitive then + Result := StrLIComp(PChar(@S1[Cur1]), PChar(@S2[Cur2]), 1) + else + Result := StrLComp(PChar(@S1[Cur1]), PChar(@S2[Cur2]), 1); + Inc(Cur1); + Inc(Cur2); + end; + end; +end; + +function CompareNaturalStr(const S1, S2: string): SizeInt; overload; +begin + Result := CompareNatural(S1, S2, False); +end; + +function CompareNaturalText(const S1, S2: string): SizeInt; overload; +begin + Result := CompareNatural(S1, S2, True); +end; + +initialization + {$IFNDEF UNICODE_RTL_DATABASE} + LoadCharTypes; // this table first + LoadCaseMap; // or this function does not work + {$ENDIF ~UNICODE_RTL_DATABASE} + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +{$IFDEF UNITVERSIONING} +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclSynch.pas b/3rdParty/JCL/source/common/JclSynch.pas index 02699c2b..4d1768b0 100644 --- a/3rdParty/JCL/source/common/JclSynch.pas +++ b/3rdParty/JCL/source/common/JclSynch.pas @@ -1,1778 +1,1778 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is JclSynch.pas. } -{ } -{ The Initial Developers of the Original Code are Marcel van Brakel and Azret Botash. } -{ Portions created by these individuals are Copyright (C) of these individuals. } -{ All Rights Reserved. } -{ } -{ Contributor(s): } -{ Marcel van Brakel } -{ Olivier Sannier (obones) } -{ Matthias Thoma (mthoma) } -{ } -{**************************************************************************************************} -{ } -{ This unit contains various classes and support routines for implementing synchronisation in } -{ multithreaded applications. This ranges from interlocked access to simple typed variables to } -{ wrapper classes for synchronisation primitives provided by the operating system } -{ (critical section, semaphore, mutex etc). It also includes three user defined classes to } -{ complement these. } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -unit JclSynch; - -{$I jcl.inc} - -interface - -uses - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - {$IFDEF HAS_UNITSCOPE} - {$IFDEF MSWINDOWS} - Winapi.Windows, JclWin32, - {$ENDIF MSWINDOWS} - {$ELSE ~HAS_UNITSCOPE} - {$IFDEF MSWINDOWS} - Windows, JclWin32, - {$ENDIF MSWINDOWS} - {$ENDIF ~HAS_UNITSCOPE} - JclBase; - -// Locked Integer manipulation -// -// Routines to manipulate simple typed variables in a thread safe manner -function LockedAdd(var Target: Integer; Value: Integer): Integer; overload; -function LockedCompareExchange(var Target: Integer; Exch, Comp: Integer): Integer; overload; -function LockedCompareExchange(var Target: TObject; Exch, Comp: TObject): TObject; overload; -function LockedCompareExchange(var Target: Pointer; Exch, Comp: Pointer): Pointer; overload; -function LockedDec(var Target: Integer): Integer; overload; -function LockedExchange(var Target: Integer; Value: Integer): Integer; overload; -function LockedExchangeAdd(var Target: Integer; Value: Integer): Integer; overload; -function LockedExchangeDec(var Target: Integer): Integer; overload; -function LockedExchangeInc(var Target: Integer): Integer; overload; -function LockedExchangeSub(var Target: Integer; Value: Integer): Integer; overload; -function LockedInc(var Target: Integer): Integer; overload; -function LockedSub(var Target: Integer; Value: Integer): Integer; overload; - -{$IFDEF CPU64} -function LockedAdd(var Target: Int64; Value: Int64): Int64; overload; -function LockedCompareExchange(var Target: Int64; Exch, Comp: Int64): Int64; overload; -function LockedDec(var Target: Int64): Int64; overload; -function LockedExchange(var Target: Int64; Value: Int64): Int64; overload; -function LockedExchangeAdd(var Target: Int64; Value: Int64): Int64; overload; -function LockedExchangeDec(var Target: Int64): Int64; overload; -function LockedExchangeInc(var Target: Int64): Int64; overload; -function LockedExchangeSub(var Target: Int64; Value: Int64): Int64; overload; -function LockedInc(var Target: Int64): Int64; overload; -function LockedSub(var Target: Int64; Value: Int64): Int64; overload; - -{$IFDEF BORLAND} -{$IFNDEF COMPILER29_UP} -function LockedDec(var Target: NativeInt): NativeInt; overload; -function LockedInc(var Target: NativeInt): NativeInt; overload; -{$ENDIF ~COMPILER29_UP} -{$ENDIF BORLAND} -{$ENDIF CPU64} - -// TJclDispatcherObject -// -// Base class for operating system provided synchronisation primitives -type - TJclWaitResult = (wrAbandoned, wrError, wrIoCompletion, wrSignaled, wrTimeout); - - TJclWaitHandle = THandle; - - TJclDispatcherObject = class(TObject) - private - FExisted: Boolean; - FHandle: TJclWaitHandle; - FName: string; - public - constructor Attach(AHandle: TJclWaitHandle); - destructor Destroy; override; - //function MsgWaitFor(const TimeOut: Cardinal): TJclWaitResult; Mask: DWORD): TJclWaitResult; - //function MsgWaitForEx(const TimeOut: Cardinal): TJclWaitResult; Mask: DWORD): TJclWaitResult; - function SignalAndWait(const Obj: TJclDispatcherObject; TimeOut: Cardinal; - Alertable: Boolean): TJclWaitResult; - function WaitAlertable(const TimeOut: Cardinal): TJclWaitResult; - function WaitFor(const TimeOut: Cardinal): TJclWaitResult; - function WaitForever: TJclWaitResult; - property Existed: Boolean read FExisted; - property Handle: TJclWaitHandle read FHandle; - property Name: string read FName; - end; - -// Wait functions -// -// Object enabled Wait functions (takes TJclDispatcher objects as parameter as -// opposed to handles) mostly for convenience -function WaitForMultipleObjects(const Objects: array of TJclDispatcherObject; - WaitAll: Boolean; TimeOut: Cardinal): Cardinal; -function WaitAlertableForMultipleObjects(const Objects: array of TJclDispatcherObject; - WaitAll: Boolean; TimeOut: Cardinal): Cardinal; - -type - TJclCriticalSection = class(TObject) - private - FCriticalSection: TRTLCriticalSection; - public - constructor Create; virtual; - destructor Destroy; override; - class procedure CreateAndEnter(var CS: TJclCriticalSection); - procedure Enter; - procedure Leave; - end; - - TJclCriticalSectionEx = class(TJclCriticalSection) - private - FSpinCount: Cardinal; - function GetSpinCount: Cardinal; - procedure SetSpinCount(const Value: Cardinal); - public - constructor Create; override; - constructor CreateEx(SpinCount: Cardinal; NoFailEnter: Boolean); virtual; - class function GetSpinTimeOut: Cardinal; - class procedure SetSpinTimeOut(const Value: Cardinal); - function TryEnter: Boolean; - property SpinCount: Cardinal read GetSpinCount write SetSpinCount; - end; - - TJclEvent = class(TJclDispatcherObject) - public - constructor Create(SecAttr: PSecurityAttributes; Manual, Signaled: Boolean; const Name: string); - constructor Open(Access: Cardinal; Inheritable: Boolean; const Name: string); - function Pulse: Boolean; - function ResetEvent: Boolean; - function SetEvent: Boolean; - end; - - TJclWaitableTimer = class(TJclDispatcherObject) - private - FResume: Boolean; - public - constructor Create(SecAttr: PSecurityAttributes; Manual: Boolean; const Name: string); - constructor Open(Access: Cardinal; Inheritable: Boolean; const Name: string); - function Cancel: Boolean; - function SetTimer(const DueTime: Int64; Period: Longint; Resume: Boolean): Boolean; - function SetTimerApc(const DueTime: Int64; Period: Longint; Resume: Boolean; Apc: TFNTimerAPCRoutine; Arg: Pointer): Boolean; - end; - - TJclSemaphore = class(TJclDispatcherObject) - public - constructor Create(SecAttr: PSecurityAttributes; Initial, Maximum: Longint; const Name: string); - constructor Open(Access: Cardinal; Inheritable: Boolean; const Name: string); - function Release(ReleaseCount: Longint): Boolean; - function ReleasePrev(ReleaseCount: Longint; var PrevCount: Longint): Boolean; - end; - - TJclMutex = class(TJclDispatcherObject) - public - constructor Create(SecAttr: PSecurityAttributes; InitialOwner: Boolean; - const Name: string); - constructor Open(Access: Cardinal; Inheritable: Boolean; const Name: string); - function Acquire(const TimeOut: Cardinal = INFINITE): Boolean; - function Release: Boolean; - end; - - POptexSharedInfo = ^TOptexSharedInfo; - TOptexSharedInfo = record - SpinCount: Integer; // number of times to try and enter the optex before - // waiting on kernel event, 0 on single processor - LockCount: Integer; // count of enter attempts - ThreadId: Longword; // id of thread that owns the optex, 0 if free - RecursionCount: Integer; // number of times the optex is owned, 0 if free - end; - - TJclOptex = class(TObject) - private - FEvent: TJclEvent; - FExisted: Boolean; - FFileMapping: THandle; - FName: string; - FSharedInfo: POptexSharedInfo; - function GetUniProcess: Boolean; - function GetSpinCount: Integer; - procedure SetSpinCount(Value: Integer); - public - constructor Create(const Name: string = ''; SpinCount: Integer = 4000); - destructor Destroy; override; - procedure Enter; - procedure Leave; - function TryEnter: Boolean; - property Existed: Boolean read FExisted; - property Name: string read FName; - property SpinCount: Integer read GetSpinCount write SetSpinCount; - property UniProcess: Boolean read GetUniProcess; - end; - - TMrewPreferred = (mpReaders, mpWriters, mpEqual); - - TMrewThreadInfo = record - ThreadId: Longword; // client-id of thread - RecursionCount: Integer; // number of times a thread accessed the mrew - Reader: Boolean; // true if reader, false if writer - end; - TMrewThreadInfoArray = array of TMrewThreadInfo; - - TJclMultiReadExclusiveWrite = class(TObject) - private - FLock: TJclCriticalSection; - FPreferred: TMrewPreferred; - FSemReaders: TJclSemaphore; - FSemWriters: TJclSemaphore; - FState: Integer; - FThreads: TMrewThreadInfoArray; - FWaitingReaders: Integer; - FWaitingWriters: Integer; - procedure AddToThreadList(ThreadId: Longword; Reader: Boolean); - procedure RemoveFromThreadList(Index: Integer); - function FindThread(ThreadId: Longword): Integer; - procedure ReleaseWaiters(WasReading: Boolean); - protected - procedure Release; - public - constructor Create(Preferred: TMrewPreferred); - - destructor Destroy; override; - procedure BeginRead; - procedure BeginWrite; - procedure EndRead; - procedure EndWrite; - end; - - PMetSectSharedInfo = ^TMetSectSharedInfo; - TMetSectSharedInfo = record - Initialized: LongBool; // Is the metered section initialized? - SpinLock: Longint; // Used to gain access to this structure - ThreadsWaiting: Longint; // Count of threads waiting - AvailableCount: Longint; // Available resource count - MaximumCount: Longint; // Maximum resource count - end; - - PMeteredSection = ^TMeteredSection; - TMeteredSection = record - Event: THandle; // Handle to a kernel event object - FileMap: THandle; // Handle to memory mapped file - SharedInfo: PMetSectSharedInfo; - end; - - TJclMeteredSection = class(TObject) - private - FMetSect: PMeteredSection; - procedure CloseMeteredSection; - function InitMeteredSection(InitialCount, MaxCount: Longint; const Name: string; OpenOnly: Boolean): Boolean; - function CreateMetSectEvent(const Name: string; OpenOnly: Boolean): Boolean; - function CreateMetSectFileView(InitialCount, MaxCount: Longint; const Name: string; OpenOnly: Boolean): Boolean; - protected - procedure AcquireLock; - procedure ReleaseLock; - public - constructor Create(InitialCount, MaxCount: Longint; const Name: string); - constructor Open(const Name: string); - destructor Destroy; override; - function Enter(TimeOut: Longword): TJclWaitResult; - function Leave(ReleaseCount: Longint): Boolean; overload; - function Leave(ReleaseCount: Longint; out PrevCount: Longint): Boolean; overload; - end; - -// Debugging -// -// Note that the following function and structure declarations are all offically -// undocumented and, except for QueryCriticalSection, require Windows NT since -// it is all part of the Windows NT Native API. -{ TODO -cTest : Test this structures } -type - TEventInfo = record - EventType: Longint; // 0 = manual, otherwise auto - Signaled: LongBool; // true is signaled - end; - - TMutexInfo = record - SignalState: Longint; // >0 = signaled, <0 = |SignalState| recurs. acquired - Owned: ByteBool; // owned by thread - Abandoned: ByteBool; // is abandoned? - end; - - TSemaphoreCounts = record - CurrentCount: Longint; // current semaphore count - MaximumCount: Longint; // maximum semaphore count - end; - - TTimerInfo = record - Remaining: TLargeInteger; // 100ns intervals until signaled - Signaled: ByteBool; // is signaled? - end; - -function QueryCriticalSection(CS: TJclCriticalSection; var Info: TRTLCriticalSection): Boolean; -{ TODO -cTest : Test these 4 functions } -function QueryEvent(Handle: THandle; var Info: TEventInfo): Boolean; -function QueryMutex(Handle: THandle; var Info: TMutexInfo): Boolean; -function QuerySemaphore(Handle: THandle; var Info: TSemaphoreCounts): Boolean; -function QueryTimer(Handle: THandle; var Info: TTimerInfo): Boolean; - -type - // Exceptions - EJclWin32HandleObjectError = class(EJclWin32Error); - EJclDispatcherObjectError = class(EJclWin32Error); - EJclCriticalSectionError = class(EJclWin32Error); - EJclEventError = class(EJclWin32Error); - EJclWaitableTimerError = class(EJclWin32Error); - EJclSemaphoreError = class(EJclWin32Error); - EJclMutexError = class(EJclWin32Error); - EJclMeteredSectionError = class(EJclError); - -function ValidateMutexName(const aName: string): string; - - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\common'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -uses - {$IFDEF HAS_UNITSCOPE} - System.SysUtils, - {$ELSE ~HAS_UNITSCOPE} - SysUtils, - {$ENDIF ~HAS_UNITSCOPE} - JclLogic, JclRegistry, JclResources, - JclSysInfo, JclStrings; - -const - RegSessionManager = {HKLM\} 'SYSTEM\CurrentControlSet\Control\Session Manager'; - RegCritSecTimeout = {RegSessionManager\} 'CriticalSectionTimeout'; - -// Locked Integer manipulation -function LockedAdd(var Target: Integer; Value: Integer): Integer; -asm - {$IFDEF CPU32} - // --> EAX Target - // EDX Value - // <-- EAX Result - MOV ECX, EAX - MOV EAX, EDX - LOCK XADD [ECX], EAX - ADD EAX, EDX - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> RCX Target - // EDX Value - // <-- EAX Result - MOV EAX, EDX - LOCK XADD [RCX], EAX - ADD EAX, EDX - {$ENDIF CPU64} -end; - -function LockedCompareExchange(var Target: Integer; Exch, Comp: Integer): Integer; -asm - {$IFDEF CPU32} - // --> EAX Target - // EDX Exch - // ECX Comp - // <-- EAX Result - XCHG EAX, ECX - // EAX Comp - // EDX Exch - // ECX Target - LOCK CMPXCHG [ECX], EDX - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> RCX Target - // EDX Exch - // R8 Comp - // <-- EAX Result - MOV RAX, R8 - // RCX Target - // EDX Exch - // RAX Comp - LOCK CMPXCHG [RCX], EDX - {$ENDIF CPU64} -end; - -function LockedCompareExchange(var Target: Pointer; Exch, Comp: Pointer): Pointer; -asm - {$IFDEF CPU32} - // --> EAX Target - // EDX Exch - // ECX Comp - // <-- EAX Result - XCHG EAX, ECX - // EAX Comp - // EDX Exch - // ECX Target - LOCK CMPXCHG [ECX], EDX - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> RCX Target - // RDX Exch - // R8 Comp - // <-- RAX Result - MOV RAX, R8 - // RCX Target - // RDX Exch - // RAX Comp - LOCK CMPXCHG [RCX], RDX - {$ENDIF CPU64} -end; - -function LockedCompareExchange(var Target: TObject; Exch, Comp: TObject): TObject; -asm - {$IFDEF CPU32} - // --> EAX Target - // EDX Exch - // ECX Comp - // <-- EAX Result - XCHG EAX, ECX - // EAX Comp - // EDX Exch - // ECX Target - LOCK CMPXCHG [ECX], EDX - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> RCX Target - // RDX Exch - // R8 Comp - // <-- RAX Result - MOV RAX, R8 - // --> RCX Target - // RDX Exch - // RAX Comp - LOCK CMPXCHG [RCX], RDX - {$ENDIF CPU64} -end; - -function LockedDec(var Target: Integer): Integer; -asm - {$IFDEF CPU32} - // --> EAX Target - // <-- EAX Result - MOV ECX, EAX - MOV EAX, -1 - LOCK XADD [ECX], EAX - DEC EAX - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> RCX Target - // <-- EAX Result - MOV EAX, -1 - LOCK XADD [RCX], EAX - DEC EAX - {$ENDIF CPU64} -end; - -function LockedExchange(var Target: Integer; Value: Integer): Integer; -asm - {$IFDEF CPU32} - // --> EAX Target - // EDX Value - // <-- EAX Result - MOV ECX, EAX - MOV EAX, EDX - // ECX Target - // EAX Value - LOCK XCHG [ECX], EAX - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> RCX Target - // EDX Value - // <-- EAX Result - MOV EAX, EDX - // RCX Target - // EAX Value - LOCK XCHG [RCX], EAX - {$ENDIF CPU64} -end; - -function LockedExchangeAdd(var Target: Integer; Value: Integer): Integer; -asm - {$IFDEF CPU32} - // --> EAX Target - // EDX Value - // <-- EAX Result - MOV ECX, EAX - MOV EAX, EDX - // ECX Target - // EAX Value - LOCK XADD [ECX], EAX - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> RCX Target - // EDX Value - // <-- EAX Result - MOV EAX, EDX - // RCX Target - // EAX Value - LOCK XADD [RCX], EAX - {$ENDIF CPU64} -end; - -function LockedExchangeDec(var Target: Integer): Integer; -asm - {$IFDEF CPU32} - // --> EAX Target - // <-- EAX Result - MOV ECX, EAX - MOV EAX, -1 - LOCK XADD [ECX], EAX - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> RCX Target - // <-- EAX Result - MOV EAX, -1 - LOCK XADD [RCX], EAX - {$ENDIF CPU64} -end; - -function LockedExchangeInc(var Target: Integer): Integer; -asm - {$IFDEF CPU32} - // --> EAX Target - // <-- EAX Result - MOV ECX, EAX - MOV EAX, 1 - LOCK XADD [ECX], EAX - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> RCX Target - // <-- EAX Result - MOV EAX, 1 - LOCK XADD [RCX], EAX - {$ENDIF CPU64} -end; - -function LockedExchangeSub(var Target: Integer; Value: Integer): Integer; -asm - {$IFDEF CPU32} - // --> EAX Target - // EDX Value - // <-- EAX Result - MOV ECX, EAX - NEG EDX - MOV EAX, EDX - // ECX Target - // EAX -Value - LOCK XADD [ECX], EAX - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> RCX Target - // EDX Value - // <-- EAX Result - NEG EDX - MOV EAX, EDX - // RCX Target - // EAX -Value - LOCK XADD [RCX], EAX - {$ENDIF CPU64} -end; - -function LockedInc(var Target: Integer): Integer; -asm - {$IFDEF CPU32} - // --> EAX Target - // <-- EAX Result - MOV ECX, EAX - MOV EAX, 1 - LOCK XADD [ECX], EAX - INC EAX - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> RCX Target - // <-- EAX Result - MOV EAX, 1 - LOCK XADD [RCX], EAX - INC EAX - {$ENDIF CPU64} -end; - -function LockedSub(var Target: Integer; Value: Integer): Integer; -asm - {$IFDEF CPU32} - // --> EAX Target - // EDX Value - // <-- EAX Result - MOV ECX, EAX - NEG EDX - MOV EAX, EDX - LOCK XADD [ECX], EAX - ADD EAX, EDX - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> RCX Target - // EDX Value - // <-- EAX Result - NEG EDX - MOV EAX, EDX - LOCK XADD [RCX], EAX - ADD EAX, EDX - {$ENDIF CPU64} -end; - -{$IFDEF CPU64} - -// Locked Int64 manipulation -function LockedAdd(var Target: Int64; Value: Int64): Int64; -asm - // --> RCX Target - // RDX Value - // <-- RAX Result - MOV RAX, RDX - LOCK XADD [RCX], RAX - ADD RAX, RDX -end; - -function LockedCompareExchange(var Target: Int64; Exch, Comp: Int64): Int64; -asm - // --> RCX Target - // RDX Exch - // R8 Comp - // <-- RAX Result - MOV RAX, R8 - LOCK CMPXCHG [RCX], RDX -end; - -function LockedDec(var Target: Int64): Int64; -asm - // --> RCX Target - // <-- RAX Result - MOV RAX, -1 - LOCK XADD [RCX], RAX - DEC RAX -end; - -function LockedExchange(var Target: Int64; Value: Int64): Int64; -asm - // --> RCX Target - // RDX Value - // <-- RAX Result - MOV RAX, RDX - LOCK XCHG [RCX], RAX -end; - -function LockedExchangeAdd(var Target: Int64; Value: Int64): Int64; -asm - // --> RCX Target - // RDX Value - // <-- RAX Result - MOV RAX, RDX - LOCK XADD [RCX], RAX -end; - -function LockedExchangeDec(var Target: Int64): Int64; -asm - // --> RCX Target - // <-- RAX Result - MOV RAX, -1 - LOCK XADD [RCX], RAX -end; - -function LockedExchangeInc(var Target: Int64): Int64; -asm - // --> RCX Target - // <-- RAX Result - MOV RAX, 1 - LOCK XADD [RCX], RAX -end; - -function LockedExchangeSub(var Target: Int64; Value: Int64): Int64; -asm - // --> RCX Target - // RDX Value - // <-- RAX Result - NEG RDX - MOV RAX, RDX - LOCK XADD [RCX], RAX -end; - -function LockedInc(var Target: Int64): Int64; -asm - // --> RCX Target - // <-- RAX Result - MOV RAX, 1 - LOCK XADD [RCX], RAX - INC RAX -end; - -function LockedSub(var Target: Int64; Value: Int64): Int64; -asm - // --> RCX Target - // RDX Value - // <-- RAX Result - NEG RDX - MOV RAX, RDX - LOCK XADD [RCX], RAX - ADD RAX, RDX -end; - -{$IFDEF BORLAND} - -{$IFNDEF COMPILER29_UP} - -function LockedDec(var Target: NativeInt): NativeInt; -asm - // --> RCX Target - // <-- RAX Result - MOV RAX, -1 - LOCK XADD [RCX], RAX - DEC RAX -end; - -function LockedInc(var Target: NativeInt): NativeInt; -asm - // --> RCX Target - // <-- RAX Result - MOV RAX, 1 - LOCK XADD [RCX], RAX - INC RAX -end; - -{$ENDIF ~COMPILER29_UP} - -{$ENDIF BORLAND} - -{$ENDIF CPU64} - -//=== { TJclDispatcherObject } =============================================== - -function MapSignalResult(const Ret: DWORD): TJclWaitResult; -begin - case Ret of - WAIT_ABANDONED: - Result := wrAbandoned; - WAIT_OBJECT_0: - Result := wrSignaled; - WAIT_TIMEOUT: - Result := wrTimeout; - WAIT_IO_COMPLETION: - Result := wrIoCompletion; - WAIT_FAILED: - Result := wrError; - else - Result := wrError; - end; -end; - -constructor TJclDispatcherObject.Attach(AHandle: TJclWaitHandle); -begin - inherited Create; - FExisted := True; - FHandle := AHandle; - FName := ''; -end; - -destructor TJclDispatcherObject.Destroy; -begin - CloseHandle(FHandle); - inherited Destroy; -end; - -{ TODO: Use RTDL Version of SignalObjectAndWait } - -function TJclDispatcherObject.SignalAndWait(const Obj: TJclDispatcherObject; - TimeOut: Cardinal; Alertable: Boolean): TJclWaitResult; -begin - // Note: Do not make this method virtual! It's only available on NT 4 up... - Result := MapSignalResult(Cardinal({$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.SignalObjectAndWait(Obj.Handle, Handle, TimeOut, Alertable))); -end; - -function TJclDispatcherObject.WaitAlertable(const TimeOut: Cardinal): TJclWaitResult; -begin - Result := MapSignalResult({$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.WaitForSingleObjectEx(FHandle, TimeOut, True)); -end; - -function TJclDispatcherObject.WaitFor(const TimeOut: Cardinal): TJclWaitResult; -begin - Result := MapSignalResult({$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.WaitForSingleObject(FHandle, TimeOut)); -end; - -function TJclDispatcherObject.WaitForever: TJclWaitResult; -begin - Result := WaitFor(INFINITE); -end; - -// Wait functions -function WaitForMultipleObjects(const Objects: array of TJclDispatcherObject; - WaitAll: Boolean; TimeOut: Cardinal): Cardinal; -var - Handles: array of TJclWaitHandle; - I, Count: Integer; -begin - Count := High(Objects) + 1; - SetLength(Handles, Count); - for I := 0 to Count - 1 do - Handles[I] := Objects[I].Handle; - Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.WaitForMultipleObjects(Count, @Handles[0], WaitAll, TimeOut); -end; - -function WaitAlertableForMultipleObjects(const Objects: array of TJclDispatcherObject; - WaitAll: Boolean; TimeOut: Cardinal): Cardinal; -var - Handles: array of TJclWaitHandle; - I, Count: Integer; -begin - Count := High(Objects) + 1; - SetLength(Handles, Count); - for I := 0 to Count - 1 do - Handles[I] := Objects[I].Handle; - Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.WaitForMultipleObjectsEx(Count, @Handles[0], WaitAll, TimeOut, True); -end; - -//=== { TJclCriticalSection } ================================================ - -constructor TJclCriticalSection.Create; -begin - inherited Create; - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.InitializeCriticalSection(FCriticalSection); -end; - -destructor TJclCriticalSection.Destroy; -begin - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.DeleteCriticalSection(FCriticalSection); - inherited Destroy; -end; - -class procedure TJclCriticalSection.CreateAndEnter(var CS: TJclCriticalSection); -var - NewCritSect: TJclCriticalSection; -begin - NewCritSect := TJclCriticalSection.Create; - if LockedCompareExchange(Pointer(CS), Pointer(NewCritSect), nil) <> nil then - begin - // LoadInProgress was <> nil -> no exchange took place, free the CS - NewCritSect.Free; - end; - CS.Enter; -end; - -procedure TJclCriticalSection.Enter; -begin - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.EnterCriticalSection(FCriticalSection); -end; - -procedure TJclCriticalSection.Leave; -begin - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.LeaveCriticalSection(FCriticalSection); -end; - -//== { TJclCriticalSectionEx } =============================================== - -const - DefaultCritSectSpinCount = 4000; - -constructor TJclCriticalSectionEx.Create; -begin - CreateEx(DefaultCritSectSpinCount, False); -end; - -{ TODO: Use RTDL Version of InitializeCriticalSectionAndSpinCount } - -constructor TJclCriticalSectionEx.CreateEx(SpinCount: Cardinal; - NoFailEnter: Boolean); -begin - FSpinCount := SpinCount; - if NoFailEnter then - SpinCount := SpinCount or Cardinal($80000000); - - if not InitializeCriticalSectionAndSpinCount(FCriticalSection, SpinCount) then - raise EJclCriticalSectionError.CreateRes(@RsSynchInitCriticalSection); -end; - -function TJclCriticalSectionEx.GetSpinCount: Cardinal; -begin - // Spinning only makes sense on multiprocessor systems. On a single processor - // system the thread would simply waste cycles while the owning thread is - // suspended and thus cannot release the critical section. - if ProcessorCount = 1 then - Result := 0 - else - Result := FSpinCount; -end; - -class function TJclCriticalSectionEx.GetSpinTimeOut: Cardinal; -begin - Result := Cardinal(RegReadInteger(HKEY_LOCAL_MACHINE, RegSessionManager, - RegCritSecTimeout)); -end; - -{ TODO: Use RTLD version of SetCriticalSectionSpinCount } -procedure TJclCriticalSectionEx.SetSpinCount(const Value: Cardinal); -begin - FSpinCount := SetCriticalSectionSpinCount(FCriticalSection, Value); -end; - -class procedure TJclCriticalSectionEx.SetSpinTimeOut(const Value: Cardinal); -begin - RegWriteInteger(HKEY_LOCAL_MACHINE, RegSessionManager, RegCritSecTimeout, - Integer(Value)); -end; - -{ TODO: Use RTLD version of TryEnterCriticalSection } -function TJclCriticalSectionEx.TryEnter: Boolean; -begin - Result := TryEnterCriticalSection(FCriticalSection); -end; - -//== { TJclEvent } =========================================================== - -constructor TJclEvent.Create(SecAttr: PSecurityAttributes; Manual, Signaled: Boolean; const Name: string); -begin - inherited Create; - FName := Name; - FHandle := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CreateEvent(SecAttr, Manual, Signaled, PChar(FName)); - if FHandle = 0 then - raise EJclEventError.CreateRes(@RsSynchCreateEvent); - FExisted := GetLastError = ERROR_ALREADY_EXISTS; -end; - -constructor TJclEvent.Open(Access: Cardinal; Inheritable: Boolean; - const Name: string); -begin - FName := Name; - FExisted := True; - FHandle := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.OpenEvent(Access, Inheritable, PChar(Name)); - if FHandle = 0 then - raise EJclEventError.CreateRes(@RsSynchOpenEvent); -end; - -function TJclEvent.Pulse: Boolean; -begin - Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.PulseEvent(FHandle); -end; - -function TJclEvent.ResetEvent: Boolean; -begin - Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.ResetEvent(FHandle); -end; - -function TJclEvent.SetEvent: Boolean; -begin - Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.SetEvent(FHandle); -end; - -//=== { TJclWaitableTimer } ================================================== - -{ TODO: Use RTLD version of CreateWaitableTimer } -constructor TJclWaitableTimer.Create(SecAttr: PSecurityAttributes; - Manual: Boolean; const Name: string); -begin - FName := Name; - FResume := False; - FHandle := CreateWaitableTimer(SecAttr, Manual, PChar(Name)); - if FHandle = 0 then - raise EJclWaitableTimerError.CreateRes(@RsSynchCreateWaitableTimer); - FExisted := GetLastError = ERROR_ALREADY_EXISTS; -end; - -{ TODO: Use RTLD version of CancelWaitableTimer } -function TJclWaitableTimer.Cancel: Boolean; -begin - Result := CancelWaitableTimer(FHandle); -end; - -{ TODO: Use RTLD version of OpenWaitableTimer } - -constructor TJclWaitableTimer.Open(Access: Cardinal; Inheritable: Boolean; - const Name: string); -begin - FExisted := True; - FName := Name; - FResume := False; - FHandle := OpenWaitableTimer(Access, Inheritable, PChar(Name)); - if FHandle = 0 then - raise EJclWaitableTimerError.CreateRes(@RsSynchOpenWaitableTimer); -end; - -{ TODO: Use RTLD version of SetWaitableTimer } -function TJclWaitableTimer.SetTimer(const DueTime: Int64; Period: Longint; - Resume: Boolean): Boolean; -var - DT: Int64; -begin - DT := DueTime; - FResume := Resume; - Result := SetWaitableTimer(FHandle, DT, Period, nil, nil, FResume); -end; - -{ TODO -cHelp : OS restrictions } -function TJclWaitableTimer.SetTimerApc(const DueTime: Int64; Period: Longint; - Resume: Boolean; Apc: TFNTimerAPCRoutine; Arg: Pointer): Boolean; -var - DT: Int64; -begin - DT := DueTime; - FResume := Resume; - Result := RtdlSetWaitableTimer(FHandle, DT, Period, Apc, Arg, FResume); - { TODO : Exception for Win9x, older WinNT? } - // if not Result and (GetLastError = ERROR_CALL_NOT_IMPLEMENTED) then - // RaiseLastOSError; -end; - -//== { TJclSemaphore } ======================================================= - -constructor TJclSemaphore.Create(SecAttr: PSecurityAttributes; - Initial, Maximum: Integer; const Name: string); -begin - Assert((Initial >= 0) and (Maximum > 0)); - FName := Name; - FHandle := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CreateSemaphore(SecAttr, Initial, Maximum, PChar(Name)); - if FHandle = 0 then - raise EJclSemaphoreError.CreateRes(@RsSynchCreateSemaphore); - FExisted := GetLastError = ERROR_ALREADY_EXISTS; -end; - -constructor TJclSemaphore.Open(Access: Cardinal; Inheritable: Boolean; - const Name: string); -begin - FName := Name; - FExisted := True; - FHandle := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.OpenSemaphore(Access, Inheritable, PChar(Name)); - if FHandle = 0 then - raise EJclSemaphoreError.CreateRes(@RsSynchOpenSemaphore); -end; - -function TJclSemaphore.ReleasePrev(ReleaseCount: Longint; - var PrevCount: Longint): Boolean; -begin - Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.ReleaseSemaphore(FHandle, ReleaseCount, @PrevCount); -end; - -function TJclSemaphore.Release(ReleaseCount: Integer): Boolean; -begin - Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.ReleaseSemaphore(FHandle, ReleaseCount, nil); -end; - -//=== { TJclMutex } ========================================================== - -function TJclMutex.Acquire(const TimeOut: Cardinal): Boolean; -begin - Result := WaitFor(TimeOut) = wrSignaled; -end; - -constructor TJclMutex.Create(SecAttr: PSecurityAttributes; InitialOwner: Boolean; const Name: string); -begin - inherited Create; - FName := Name; - FHandle := JclWin32.CreateMutex(SecAttr, InitialOwner, PChar(Name)); - if FHandle = 0 then - raise EJclMutexError.CreateRes(@RsSynchCreateMutex); - FExisted := GetLastError = ERROR_ALREADY_EXISTS; -end; - -constructor TJclMutex.Open(Access: Cardinal; Inheritable: Boolean; const Name: string); -begin - inherited Create; - FName := Name; - FExisted := True; - FHandle := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.OpenMutex(Access, Inheritable, PChar(Name)); - if FHandle = 0 then - raise EJclMutexError.CreateRes(@RsSynchOpenMutex); -end; - -function TJclMutex.Release: Boolean; -begin - Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.ReleaseMutex(FHandle); -end; - -//=== { TJclOptex } ========================================================== - -constructor TJclOptex.Create(const Name: string; SpinCount: Integer); -begin - FExisted := False; - FName := Name; - if Name = '' then - begin - // None shared optex, don't need filemapping, sharedinfo is local - FFileMapping := 0; - FEvent := TJclEvent.Create(nil, False, False, ''); - FSharedInfo := AllocMem(SizeOf(TOptexSharedInfo)); - end - else - begin - // Shared optex, event protects access to sharedinfo. Creation of filemapping - // doesn't need protection as it will automatically "open" instead of "create" - // if another process already created it. - FEvent := TJclEvent.Create(nil, False, False, 'Optex_Event_' + Name); - FExisted := FEvent.Existed; - FFileMapping := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, - 0, SizeOf(TOptexSharedInfo), PChar('Optex_MMF_' + Name)); - Assert(FFileMapping <> 0); - FSharedInfo := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.MapViewOfFile(FFileMapping, FILE_MAP_WRITE, 0, 0, 0); - Assert(FSharedInfo <> nil); - end; - SetSpinCount(SpinCount); -end; - -destructor TJclOptex.Destroy; -begin - FreeAndNil(FEvent); - if UniProcess then - FreeMem(FSharedInfo) - else - begin - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.UnmapViewOfFile(FSharedInfo); - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CloseHandle(FFileMapping); - end; - inherited Destroy; -end; - -procedure TJclOptex.Enter; -var - ThreadId: Longword; -begin - if TryEnter then - Exit; - ThreadId := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetCurrentThreadId; - if {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.InterlockedIncrement(FSharedInfo^.LockCount) = 1 then - begin - // Optex was unowned - FSharedInfo^.ThreadId := ThreadId; - FSharedInfo^.RecursionCount := 1; - end - else - begin - if FSharedInfo^.ThreadId = ThreadId then - begin - // We already owned it, increase ownership count - Inc(FSharedInfo^.RecursionCount) - end - else - begin - // Optex is owner by someone else, wait for it to be released and then - // immediately take ownership - FEvent.WaitForever; - FSharedInfo^.ThreadId := ThreadId; - FSharedInfo^.RecursionCount := 1; - end; - end; -end; - -function TJclOptex.GetSpinCount: Integer; -begin - Result := FSharedInfo^.SpinCount; -end; - -function TJclOptex.GetUniProcess: Boolean; -begin - Result := FFileMapping = 0; -end; - -procedure TJclOptex.Leave; -begin - Dec(FSharedInfo^.RecursionCount); - if FSharedInfo^.RecursionCount > 0 then - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.InterlockedDecrement(FSharedInfo^.LockCount) - else - begin - FSharedInfo^.ThreadId := 0; - if {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.InterlockedDecrement(FSharedInfo^.LockCount) > 0 then - FEvent.SetEvent; - end; -end; - -procedure TJclOptex.SetSpinCount(Value: Integer); -begin - if Value < 0 then - Value := DefaultCritSectSpinCount; - // Spinning only makes sense on multiprocessor systems - if ProcessorCount > 1 then - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.InterlockedExchange(Integer(FSharedInfo^.SpinCount), Value); -end; - -function TJclOptex.TryEnter: Boolean; -var - ThreadId: Longword; - ThreadOwnsOptex: Boolean; - SpinCount: Integer; -begin - ThreadId := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetCurrentThreadId; - SpinCount := FSharedInfo^.SpinCount; - repeat - //ThreadOwnsOptex := InterlockedCompareExchange(Pointer(FSharedInfo^.LockCount), - // Pointer(1), Pointer(0)) = Pointer(0); // not available on win95 - ThreadOwnsOptex := LockedCompareExchange(FSharedInfo^.LockCount, 1, 0) = 0; - if ThreadOwnsOptex then - begin - // Optex was unowned - FSharedInfo^.ThreadId := ThreadId; - FSharedInfo^.RecursionCount := 1; - end - else - begin - if FSharedInfo^.ThreadId = ThreadId then - begin - // We already owned the Optex - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.InterlockedIncrement(FSharedInfo^.LockCount); - Inc(FSharedInfo^.RecursionCount); - ThreadOwnsOptex := True; - end; - end; - Dec(SpinCount); - until ThreadOwnsOptex or (SpinCount <= 0); - Result := ThreadOwnsOptex; -end; - -//=== { TJclMultiReadExclusiveWrite } ======================================== - -constructor TJclMultiReadExclusiveWrite.Create(Preferred: TMrewPreferred); -begin - inherited Create; - FLock := TJclCriticalSection.Create; - FPreferred := Preferred; - FSemReaders := TJclSemaphore.Create(nil, 0, MaxInt, ''); - FSemWriters := TJclSemaphore.Create(nil, 0, MaxInt, ''); - SetLength(FThreads, 0); - FState := 0; - FWaitingReaders := 0; - FWaitingWriters := 0; -end; - -destructor TJclMultiReadExclusiveWrite.Destroy; -begin - FreeAndNil(FSemReaders); - FreeAndNil(FSemWriters); - FreeAndNil(FLock); - inherited Destroy; -end; - -procedure TJclMultiReadExclusiveWrite.AddToThreadList(ThreadId: Longword; - Reader: Boolean); -var - L: Integer; -begin - // Caller must own lock - L := Length(FThreads); - SetLength(FThreads, L + 1); - FThreads[L].ThreadId := ThreadId; - FThreads[L].RecursionCount := 1; - FThreads[L].Reader := Reader; -end; - -procedure TJclMultiReadExclusiveWrite.BeginRead; -var - ThreadId: Longword; - Index: Integer; - MustWait: Boolean; -begin - MustWait := False; - ThreadId := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetCurrentThreadId; - FLock.Enter; - try - Index := FindThread(ThreadId); - if Index >= 0 then - begin - // Thread is on threadslist so it is already reading - Inc(FThreads[Index].RecursionCount); - end - else - begin - // Request to read (first time) - AddToThreadList(ThreadId, True); - if FState >= 0 then - begin - // MREW is unowned or only readers. If there are no waiting writers or - // readers are preferred then allow thread to continue, otherwise it must - // wait it's turn - if (FPreferred = mpReaders) or (FWaitingWriters = 0) then - Inc(FState) - else - begin - Inc(FWaitingReaders); - MustWait := True; - end; - end - else - begin - // MREW is owner by a writer, must wait - Inc(FWaitingReaders); - MustWait := True; - end; - end; - finally - FLock.Leave; - end; - if MustWait then - FSemReaders.WaitForever; -end; - -procedure TJclMultiReadExclusiveWrite.BeginWrite; -var - ThreadId: Longword; - Index: Integer; - MustWait: Boolean; -begin - MustWait := False; - FLock.Enter; - try - ThreadId := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetCurrentThreadId; - Index := FindThread(ThreadId); - if Index < 0 then - begin - // Request to write (first time) - AddToThreadList(ThreadId, False); - if FState = 0 then - begin - // MREW is unowned so start writing - FState := -1; - end - else - begin - // MREW is owner, must wait - Inc(FWaitingWriters); - MustWait := True; - end; - end - else - begin - if FThreads[Index].Reader then - begin - // Request to write while reading - Inc(FThreads[Index].RecursionCount); - FThreads[Index].Reader := False; - Dec(FState); - if FState = 0 then - begin - // MREW is unowned so start writing - FState := -1; - end - else - begin - // MREW is owned, must wait - MustWait := True; - Inc(FWaitingWriters); - end; - end - else - // Requesting to write while already writing - Inc(FThreads[Index].RecursionCount); - end; - finally - FLock.Leave; - end; - if MustWait then - FSemWriters.WaitFor(INFINITE); -end; - -procedure TJclMultiReadExclusiveWrite.EndRead; -begin - Release; -end; - -procedure TJclMultiReadExclusiveWrite.EndWrite; -begin - Release; -end; - -function TJclMultiReadExclusiveWrite.FindThread(ThreadId: Longword): Integer; -var - I: Integer; -begin - // Caller must lock - Result := -1; - for I := 0 to Length(FThreads) - 1 do - if FThreads[I].ThreadId = ThreadId then - begin - Result := I; - Exit; - end; -end; - -procedure TJclMultiReadExclusiveWrite.Release; -var - ThreadId: Longword; - Index: Integer; - WasReading: Boolean; -begin - ThreadId := GetCurrentThreadId; - FLock.Enter; - try - Index := FindThread(ThreadId); - if Index >= 0 then - begin - Dec(FThreads[Index].RecursionCount); - if FThreads[Index].RecursionCount = 0 then - begin - WasReading := FThreads[Index].Reader; - if WasReading then - Dec(FState) - else - FState := 0; - RemoveFromThreadList(Index); - if FState = 0 then - ReleaseWaiters(WasReading); - end; - end; - finally - FLock.Leave; - end; -end; - -procedure TJclMultiReadExclusiveWrite.ReleaseWaiters(WasReading: Boolean); -var - ToRelease: TMrewPreferred; -begin - // Caller must Lock - ToRelease := mpEqual; - case FPreferred of - mpReaders: - if FWaitingReaders > 0 then - ToRelease := mpReaders - else - if FWaitingWriters > 0 then - ToRelease := mpWriters; - mpWriters: - if FWaitingWriters > 0 then - ToRelease := mpWriters - else - if FWaitingReaders > 0 then - ToRelease := mpReaders; - mpEqual: - if WasReading then - begin - if FWaitingWriters > 0 then - ToRelease := mpWriters - else - if FWaitingReaders > 0 then - ToRelease := mpReaders; - end - else - begin - if FWaitingReaders > 0 then - ToRelease := mpReaders - else - if FWaitingWriters > 0 then - ToRelease := mpWriters; - end; - end; - case ToRelease of - mpReaders: - begin - FState := FWaitingReaders; - FWaitingReaders := 0; - FSemReaders.Release(FState); - end; - mpWriters: - begin - FState := -1; - Dec(FWaitingWriters); - FSemWriters.Release(1); - end; - mpEqual: - // no waiters - end; -end; - -procedure TJclMultiReadExclusiveWrite.RemoveFromThreadList(Index: Integer); -var - L: Integer; -begin - // Caller must Lock - L := Length(FThreads); - if Index < (L - 1) then - Move(FThreads[Index + 1], FThreads[Index], SizeOf(TMrewThreadInfo) * (L - Index - 1)); - SetLength(FThreads, L - 1); -end; - -//=== { TJclMeteredSection } ================================================= - -const - MAX_METSECT_NAMELEN = 128; - -constructor TJclMeteredSection.Create(InitialCount, MaxCount: Integer; const Name: string); -begin - if (MaxCount < 1) or (InitialCount > MaxCount) or (InitialCount < 0) or - (Length(Name) > MAX_METSECT_NAMELEN) then - raise EJclMeteredSectionError.CreateRes(@RsMetSectInvalidParameter); - FMetSect := PMeteredSection(AllocMem(SizeOf(TMeteredSection))); - if FMetSect <> nil then - begin - if not InitMeteredSection(InitialCount, MaxCount, Name, False) then - begin - CloseMeteredSection; - FMetSect := nil; - raise EJclMeteredSectionError.CreateRes(@RsMetSectInitialize); - end; - end; -end; - -constructor TJclMeteredSection.Open(const Name: string); -begin - FMetSect := nil; - if Name = '' then - raise EJclMeteredSectionError.CreateRes(@RsMetSectNameEmpty); - FMetSect := PMeteredSection(AllocMem(SizeOf(TMeteredSection))); - Assert(FMetSect <> nil); - if not InitMeteredSection(0, 0, Name, True) then - begin - CloseMeteredSection; - FMetSect := nil; - raise EJclMeteredSectionError.CreateRes(@RsMetSectInitialize); - end; -end; - -destructor TJclMeteredSection.Destroy; -begin - CloseMeteredSection; - inherited Destroy; -end; - -procedure TJclMeteredSection.AcquireLock; -begin - while {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.InterlockedExchange(FMetSect^.SharedInfo^.SpinLock, 1) <> 0 do - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.Sleep(0); -end; - -procedure TJclMeteredSection.CloseMeteredSection; -begin - if FMetSect <> nil then - begin - if FMetSect^.SharedInfo <> nil then - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.UnmapViewOfFile(FMetSect^.SharedInfo); - if FMetSect^.FileMap <> 0 then - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CloseHandle(FMetSect^.FileMap); - if FMetSect^.Event <> 0 then - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CloseHandle(FMetSect^.Event); - FreeMem(FMetSect); - end; -end; - -function TJclMeteredSection.CreateMetSectEvent(const Name: string; OpenOnly: Boolean): Boolean; -var - FullName: string; -begin - if Name = '' then - FMetSect^.Event := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CreateEvent(nil, False, False, nil) - else - begin - FullName := 'JCL_MSECT_EVT_' + Name; - if OpenOnly then - FMetSect^.Event := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.OpenEvent(0, False, PChar(FullName)) - else - FMetSect^.Event := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CreateEvent(nil, False, False, PChar(FullName)); - end; - Result := FMetSect^.Event <> 0; -end; - -function TJclMeteredSection.CreateMetSectFileView(InitialCount, MaxCount: Longint; - const Name: string; OpenOnly: Boolean): Boolean; -var - FullName: string; - LastError: DWORD; -begin - Result := False; - if Name = '' then - FMetSect^.FileMap := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(TMetSectSharedInfo), nil) - else - begin - FullName := 'JCL_MSECT_MMF_' + Name; - if OpenOnly then - FMetSect^.FileMap := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.OpenFileMapping(0, False, PChar(FullName)) - else - FMetSect^.FileMap := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(TMetSectSharedInfo), PChar(FullName)); - end; - if FMetSect^.FileMap <> 0 then - begin - LastError := GetLastError; - FMetSect^.SharedInfo := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.MapViewOfFile(FMetSect^.FileMap, FILE_MAP_WRITE, 0, 0, 0); - if FMetSect^.SharedInfo <> nil then - begin - if LastError = ERROR_ALREADY_EXISTS then - while not FMetSect^.SharedInfo^.Initialized do Sleep(0) - else - begin - FMetSect^.SharedInfo^.SpinLock := 0; - FMetSect^.SharedInfo^.ThreadsWaiting := 0; - FMetSect^.SharedInfo^.AvailableCount := InitialCount; - FMetSect^.SharedInfo^.MaximumCount := MaxCount; - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.InterlockedExchange(Integer(FMetSect^.SharedInfo^.Initialized), 1); - end; - Result := True; - end; - end; -end; - -function TJclMeteredSection.Enter(TimeOut: Longword): TJclWaitResult; -begin - Result := wrSignaled; - while Result = wrSignaled do - begin - AcquireLock; - try - if FMetSect^.SharedInfo^.AvailableCount >= 1 then - begin - Dec(FMetSect^.SharedInfo^.AvailableCount); - Result := MapSignalResult(WAIT_OBJECT_0); - Exit; - end; - Inc(FMetSect^.SharedInfo^.ThreadsWaiting); - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.ResetEvent(FMetSect^.Event); - finally - ReleaseLock; - end; - Result := MapSignalResult({$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.WaitForSingleObject(FMetSect^.Event, TimeOut)); - end; -end; - -function TJclMeteredSection.InitMeteredSection(InitialCount, MaxCount: Longint; - const Name: string; OpenOnly: Boolean): Boolean; -begin - Result := False; - if CreateMetSectEvent(Name, OpenOnly) then - Result := CreateMetSectFileView(InitialCount, MaxCount, Name, OpenOnly); -end; - -function TJclMeteredSection.Leave(ReleaseCount: Integer; out PrevCount: Integer): Boolean; -var - Count: Integer; -begin - Result := False; - AcquireLock; - try - PrevCount := FMetSect^.SharedInfo^.AvailableCount; - if (ReleaseCount < 0) or - (FMetSect^.SharedInfo^.AvailableCount + ReleaseCount > FMetSect^.SharedInfo^.MaximumCount) then - begin - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.SetLastError(ERROR_INVALID_PARAMETER); - Exit; - end; - Inc(FMetSect^.SharedInfo^.AvailableCount, ReleaseCount); - ReleaseCount := Min(ReleaseCount, FMetSect^.SharedInfo^.ThreadsWaiting); - if FMetSect^.SharedInfo^.ThreadsWaiting > 0 then - begin - for Count := 0 to ReleaseCount - 1 do - begin - Dec(FMetSect^.SharedInfo^.ThreadsWaiting); - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.SetEvent(FMetSect^.Event); - end; - end; - finally - ReleaseLock; - end; - Result := True; -end; - -function TJclMeteredSection.Leave(ReleaseCount: Integer): Boolean; -var - Previous: Longint; -begin - Result := Leave(ReleaseCount, Previous); -end; - -procedure TJclMeteredSection.ReleaseLock; -begin - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.InterlockedExchange(FMetSect^.SharedInfo^.SpinLock, 0); -end; - -//=== Debugging ============================================================== - -function QueryCriticalSection(CS: TJclCriticalSection; var Info: TRTLCriticalSection): Boolean; -begin - Result := CS <> nil; - if Result then - Info := CS.FCriticalSection; -end; - -// Native API functions -// http://undocumented.ntinternals.net/ - -{ TODO: RTLD version } - -type - TNtQueryProc = function (Handle: THandle; InfoClass: Byte; Info: Pointer; - Len: Longint; ResLen: PLongint): Longint; stdcall; - -var - _QueryEvent: TNtQueryProc = nil; - _QueryMutex: TNtQueryProc = nil; - _QuerySemaphore: TNtQueryProc = nil; - _QueryTimer: TNtQueryProc = nil; - -function CallQueryProc(var P: TNtQueryProc; const Name: string; Handle: THandle; - Info: Pointer; InfoSize: Longint): Boolean; -var - NtDll: THandle; - Status: Longint; -begin - Result := False; - if @P = nil then - begin - NtDll := GetModuleHandle(PChar('ntdll.dll')); - if NtDll <> 0 then - @P := GetProcAddress(NtDll, PChar(Name)); - end; - if @P <> nil then - begin - Status := P(Handle, 0, Info, InfoSize, nil); - Result := (Status and $80000000) = 0; - end; -end; - -function QueryEvent(Handle: THandle; var Info: TEventInfo): Boolean; -begin - Result := CallQueryProc(_QueryEvent, 'NtQueryEvent', Handle, @Info, SizeOf(Info)); -end; - -function QueryMutex(Handle: THandle; var Info: TMutexInfo): Boolean; -begin - Result := CallQueryProc(_QueryMutex, 'NtQueryMutex', Handle, @Info, SizeOf(Info)); -end; - -function QuerySemaphore(Handle: THandle; var Info: TSemaphoreCounts): Boolean; -begin - Result := CallQueryProc(_QuerySemaphore, 'NtQuerySemaphore', Handle, @Info, SizeOf(Info)); -end; - -function QueryTimer(Handle: THandle; var Info: TTimerInfo): Boolean; -begin - Result := CallQueryProc(_QueryTimer, 'NtQueryTimer', Handle, @Info, SizeOf(Info)); -end; - -function ValidateMutexName(const aName: string): string; -const cMutexMaxName = 200; -begin - if Length(aName) > cMutexMaxName then - Result := Copy (aName, Length(aName)-cMutexMaxName, cMutexMaxName) - else - Result := aName; - Result := StrReplaceChar(Result, '\', '_'); -end; - - - -{$IFDEF UNITVERSIONING} -initialization - RegisterUnitVersion(HInstance, UnitVersioning); - -finalization - UnregisterUnitVersion(HInstance); -{$ENDIF UNITVERSIONING} - -end. +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclSynch.pas. } +{ } +{ The Initial Developers of the Original Code are Marcel van Brakel and Azret Botash. } +{ Portions created by these individuals are Copyright (C) of these individuals. } +{ All Rights Reserved. } +{ } +{ Contributor(s): } +{ Marcel van Brakel } +{ Olivier Sannier (obones) } +{ Matthias Thoma (mthoma) } +{ } +{**************************************************************************************************} +{ } +{ This unit contains various classes and support routines for implementing synchronisation in } +{ multithreaded applications. This ranges from interlocked access to simple typed variables to } +{ wrapper classes for synchronisation primitives provided by the operating system } +{ (critical section, semaphore, mutex etc). It also includes three user defined classes to } +{ complement these. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclSynch; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Winapi.Windows, JclWin32, + {$ENDIF MSWINDOWS} + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Windows, JclWin32, + {$ENDIF MSWINDOWS} + {$ENDIF ~HAS_UNITSCOPE} + JclBase; + +// Locked Integer manipulation +// +// Routines to manipulate simple typed variables in a thread safe manner +function LockedAdd(var Target: Integer; Value: Integer): Integer; overload; +function LockedCompareExchange(var Target: Integer; Exch, Comp: Integer): Integer; overload; +function LockedCompareExchange(var Target: TObject; Exch, Comp: TObject): TObject; overload; +function LockedCompareExchange(var Target: Pointer; Exch, Comp: Pointer): Pointer; overload; +function LockedDec(var Target: Integer): Integer; overload; +function LockedExchange(var Target: Integer; Value: Integer): Integer; overload; +function LockedExchangeAdd(var Target: Integer; Value: Integer): Integer; overload; +function LockedExchangeDec(var Target: Integer): Integer; overload; +function LockedExchangeInc(var Target: Integer): Integer; overload; +function LockedExchangeSub(var Target: Integer; Value: Integer): Integer; overload; +function LockedInc(var Target: Integer): Integer; overload; +function LockedSub(var Target: Integer; Value: Integer): Integer; overload; + +{$IFDEF CPU64} +function LockedAdd(var Target: Int64; Value: Int64): Int64; overload; +function LockedCompareExchange(var Target: Int64; Exch, Comp: Int64): Int64; overload; +function LockedDec(var Target: Int64): Int64; overload; +function LockedExchange(var Target: Int64; Value: Int64): Int64; overload; +function LockedExchangeAdd(var Target: Int64; Value: Int64): Int64; overload; +function LockedExchangeDec(var Target: Int64): Int64; overload; +function LockedExchangeInc(var Target: Int64): Int64; overload; +function LockedExchangeSub(var Target: Int64; Value: Int64): Int64; overload; +function LockedInc(var Target: Int64): Int64; overload; +function LockedSub(var Target: Int64; Value: Int64): Int64; overload; + +{$IFDEF BORLAND} +{$IFNDEF COMPILER29_UP} +function LockedDec(var Target: NativeInt): NativeInt; overload; +function LockedInc(var Target: NativeInt): NativeInt; overload; +{$ENDIF ~COMPILER29_UP} +{$ENDIF BORLAND} +{$ENDIF CPU64} + +// TJclDispatcherObject +// +// Base class for operating system provided synchronisation primitives +type + TJclWaitResult = (wrAbandoned, wrError, wrIoCompletion, wrSignaled, wrTimeout); + + TJclWaitHandle = THandle; + + TJclDispatcherObject = class(TObject) + private + FExisted: Boolean; + FHandle: TJclWaitHandle; + FName: string; + public + constructor Attach(AHandle: TJclWaitHandle); + destructor Destroy; override; + //function MsgWaitFor(const TimeOut: Cardinal): TJclWaitResult; Mask: DWORD): TJclWaitResult; + //function MsgWaitForEx(const TimeOut: Cardinal): TJclWaitResult; Mask: DWORD): TJclWaitResult; + function SignalAndWait(const Obj: TJclDispatcherObject; TimeOut: Cardinal; + Alertable: Boolean): TJclWaitResult; + function WaitAlertable(const TimeOut: Cardinal): TJclWaitResult; + function WaitFor(const TimeOut: Cardinal): TJclWaitResult; + function WaitForever: TJclWaitResult; + property Existed: Boolean read FExisted; + property Handle: TJclWaitHandle read FHandle; + property Name: string read FName; + end; + +// Wait functions +// +// Object enabled Wait functions (takes TJclDispatcher objects as parameter as +// opposed to handles) mostly for convenience +function WaitForMultipleObjects(const Objects: array of TJclDispatcherObject; + WaitAll: Boolean; TimeOut: Cardinal): Cardinal; +function WaitAlertableForMultipleObjects(const Objects: array of TJclDispatcherObject; + WaitAll: Boolean; TimeOut: Cardinal): Cardinal; + +type + TJclCriticalSection = class(TObject) + private + FCriticalSection: TRTLCriticalSection; + public + constructor Create; virtual; + destructor Destroy; override; + class procedure CreateAndEnter(var CS: TJclCriticalSection); + procedure Enter; + procedure Leave; + end; + + TJclCriticalSectionEx = class(TJclCriticalSection) + private + FSpinCount: Cardinal; + function GetSpinCount: Cardinal; + procedure SetSpinCount(const Value: Cardinal); + public + constructor Create; override; + constructor CreateEx(SpinCount: Cardinal; NoFailEnter: Boolean); virtual; + class function GetSpinTimeOut: Cardinal; + class procedure SetSpinTimeOut(const Value: Cardinal); + function TryEnter: Boolean; + property SpinCount: Cardinal read GetSpinCount write SetSpinCount; + end; + + TJclEvent = class(TJclDispatcherObject) + public + constructor Create(SecAttr: PSecurityAttributes; Manual, Signaled: Boolean; const Name: string); + constructor Open(Access: Cardinal; Inheritable: Boolean; const Name: string); + function Pulse: Boolean; + function ResetEvent: Boolean; + function SetEvent: Boolean; + end; + + TJclWaitableTimer = class(TJclDispatcherObject) + private + FResume: Boolean; + public + constructor Create(SecAttr: PSecurityAttributes; Manual: Boolean; const Name: string); + constructor Open(Access: Cardinal; Inheritable: Boolean; const Name: string); + function Cancel: Boolean; + function SetTimer(const DueTime: Int64; Period: Longint; Resume: Boolean): Boolean; + function SetTimerApc(const DueTime: Int64; Period: Longint; Resume: Boolean; Apc: TFNTimerAPCRoutine; Arg: Pointer): Boolean; + end; + + TJclSemaphore = class(TJclDispatcherObject) + public + constructor Create(SecAttr: PSecurityAttributes; Initial, Maximum: Longint; const Name: string); + constructor Open(Access: Cardinal; Inheritable: Boolean; const Name: string); + function Release(ReleaseCount: Longint): Boolean; + function ReleasePrev(ReleaseCount: Longint; var PrevCount: Longint): Boolean; + end; + + TJclMutex = class(TJclDispatcherObject) + public + constructor Create(SecAttr: PSecurityAttributes; InitialOwner: Boolean; + const Name: string); + constructor Open(Access: Cardinal; Inheritable: Boolean; const Name: string); + function Acquire(const TimeOut: Cardinal = INFINITE): Boolean; + function Release: Boolean; + end; + + POptexSharedInfo = ^TOptexSharedInfo; + TOptexSharedInfo = record + SpinCount: Integer; // number of times to try and enter the optex before + // waiting on kernel event, 0 on single processor + LockCount: Integer; // count of enter attempts + ThreadId: Longword; // id of thread that owns the optex, 0 if free + RecursionCount: Integer; // number of times the optex is owned, 0 if free + end; + + TJclOptex = class(TObject) + private + FEvent: TJclEvent; + FExisted: Boolean; + FFileMapping: THandle; + FName: string; + FSharedInfo: POptexSharedInfo; + function GetUniProcess: Boolean; + function GetSpinCount: Integer; + procedure SetSpinCount(Value: Integer); + public + constructor Create(const Name: string = ''; SpinCount: Integer = 4000); + destructor Destroy; override; + procedure Enter; + procedure Leave; + function TryEnter: Boolean; + property Existed: Boolean read FExisted; + property Name: string read FName; + property SpinCount: Integer read GetSpinCount write SetSpinCount; + property UniProcess: Boolean read GetUniProcess; + end; + + TMrewPreferred = (mpReaders, mpWriters, mpEqual); + + TMrewThreadInfo = record + ThreadId: Longword; // client-id of thread + RecursionCount: Integer; // number of times a thread accessed the mrew + Reader: Boolean; // true if reader, false if writer + end; + TMrewThreadInfoArray = array of TMrewThreadInfo; + + TJclMultiReadExclusiveWrite = class(TObject) + private + FLock: TJclCriticalSection; + FPreferred: TMrewPreferred; + FSemReaders: TJclSemaphore; + FSemWriters: TJclSemaphore; + FState: Integer; + FThreads: TMrewThreadInfoArray; + FWaitingReaders: Integer; + FWaitingWriters: Integer; + procedure AddToThreadList(ThreadId: Longword; Reader: Boolean); + procedure RemoveFromThreadList(Index: Integer); + function FindThread(ThreadId: Longword): Integer; + procedure ReleaseWaiters(WasReading: Boolean); + protected + procedure Release; + public + constructor Create(Preferred: TMrewPreferred); + + destructor Destroy; override; + procedure BeginRead; + procedure BeginWrite; + procedure EndRead; + procedure EndWrite; + end; + + PMetSectSharedInfo = ^TMetSectSharedInfo; + TMetSectSharedInfo = record + Initialized: LongBool; // Is the metered section initialized? + SpinLock: Longint; // Used to gain access to this structure + ThreadsWaiting: Longint; // Count of threads waiting + AvailableCount: Longint; // Available resource count + MaximumCount: Longint; // Maximum resource count + end; + + PMeteredSection = ^TMeteredSection; + TMeteredSection = record + Event: THandle; // Handle to a kernel event object + FileMap: THandle; // Handle to memory mapped file + SharedInfo: PMetSectSharedInfo; + end; + + TJclMeteredSection = class(TObject) + private + FMetSect: PMeteredSection; + procedure CloseMeteredSection; + function InitMeteredSection(InitialCount, MaxCount: Longint; const Name: string; OpenOnly: Boolean): Boolean; + function CreateMetSectEvent(const Name: string; OpenOnly: Boolean): Boolean; + function CreateMetSectFileView(InitialCount, MaxCount: Longint; const Name: string; OpenOnly: Boolean): Boolean; + protected + procedure AcquireLock; + procedure ReleaseLock; + public + constructor Create(InitialCount, MaxCount: Longint; const Name: string); + constructor Open(const Name: string); + destructor Destroy; override; + function Enter(TimeOut: Longword): TJclWaitResult; + function Leave(ReleaseCount: Longint): Boolean; overload; + function Leave(ReleaseCount: Longint; out PrevCount: Longint): Boolean; overload; + end; + +// Debugging +// +// Note that the following function and structure declarations are all offically +// undocumented and, except for QueryCriticalSection, require Windows NT since +// it is all part of the Windows NT Native API. +{ TODO -cTest : Test this structures } +type + TEventInfo = record + EventType: Longint; // 0 = manual, otherwise auto + Signaled: LongBool; // true is signaled + end; + + TMutexInfo = record + SignalState: Longint; // >0 = signaled, <0 = |SignalState| recurs. acquired + Owned: ByteBool; // owned by thread + Abandoned: ByteBool; // is abandoned? + end; + + TSemaphoreCounts = record + CurrentCount: Longint; // current semaphore count + MaximumCount: Longint; // maximum semaphore count + end; + + TTimerInfo = record + Remaining: TLargeInteger; // 100ns intervals until signaled + Signaled: ByteBool; // is signaled? + end; + +function QueryCriticalSection(CS: TJclCriticalSection; var Info: TRTLCriticalSection): Boolean; +{ TODO -cTest : Test these 4 functions } +function QueryEvent(Handle: THandle; var Info: TEventInfo): Boolean; +function QueryMutex(Handle: THandle; var Info: TMutexInfo): Boolean; +function QuerySemaphore(Handle: THandle; var Info: TSemaphoreCounts): Boolean; +function QueryTimer(Handle: THandle; var Info: TTimerInfo): Boolean; + +type + // Exceptions + EJclWin32HandleObjectError = class(EJclWin32Error); + EJclDispatcherObjectError = class(EJclWin32Error); + EJclCriticalSectionError = class(EJclWin32Error); + EJclEventError = class(EJclWin32Error); + EJclWaitableTimerError = class(EJclWin32Error); + EJclSemaphoreError = class(EJclWin32Error); + EJclMutexError = class(EJclWin32Error); + EJclMeteredSectionError = class(EJclError); + +function ValidateMutexName(const aName: string): string; + + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclLogic, JclRegistry, JclResources, + JclSysInfo, JclStrings; + +const + RegSessionManager = {HKLM\} 'SYSTEM\CurrentControlSet\Control\Session Manager'; + RegCritSecTimeout = {RegSessionManager\} 'CriticalSectionTimeout'; + +// Locked Integer manipulation +function LockedAdd(var Target: Integer; Value: Integer): Integer; +asm + {$IFDEF CPU32} + // --> EAX Target + // EDX Value + // <-- EAX Result + MOV ECX, EAX + MOV EAX, EDX + LOCK XADD [ECX], EAX + ADD EAX, EDX + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> RCX Target + // EDX Value + // <-- EAX Result + MOV EAX, EDX + LOCK XADD [RCX], EAX + ADD EAX, EDX + {$ENDIF CPU64} +end; + +function LockedCompareExchange(var Target: Integer; Exch, Comp: Integer): Integer; +asm + {$IFDEF CPU32} + // --> EAX Target + // EDX Exch + // ECX Comp + // <-- EAX Result + XCHG EAX, ECX + // EAX Comp + // EDX Exch + // ECX Target + LOCK CMPXCHG [ECX], EDX + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> RCX Target + // EDX Exch + // R8 Comp + // <-- EAX Result + MOV RAX, R8 + // RCX Target + // EDX Exch + // RAX Comp + LOCK CMPXCHG [RCX], EDX + {$ENDIF CPU64} +end; + +function LockedCompareExchange(var Target: Pointer; Exch, Comp: Pointer): Pointer; +asm + {$IFDEF CPU32} + // --> EAX Target + // EDX Exch + // ECX Comp + // <-- EAX Result + XCHG EAX, ECX + // EAX Comp + // EDX Exch + // ECX Target + LOCK CMPXCHG [ECX], EDX + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> RCX Target + // RDX Exch + // R8 Comp + // <-- RAX Result + MOV RAX, R8 + // RCX Target + // RDX Exch + // RAX Comp + LOCK CMPXCHG [RCX], RDX + {$ENDIF CPU64} +end; + +function LockedCompareExchange(var Target: TObject; Exch, Comp: TObject): TObject; +asm + {$IFDEF CPU32} + // --> EAX Target + // EDX Exch + // ECX Comp + // <-- EAX Result + XCHG EAX, ECX + // EAX Comp + // EDX Exch + // ECX Target + LOCK CMPXCHG [ECX], EDX + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> RCX Target + // RDX Exch + // R8 Comp + // <-- RAX Result + MOV RAX, R8 + // --> RCX Target + // RDX Exch + // RAX Comp + LOCK CMPXCHG [RCX], RDX + {$ENDIF CPU64} +end; + +function LockedDec(var Target: Integer): Integer; +asm + {$IFDEF CPU32} + // --> EAX Target + // <-- EAX Result + MOV ECX, EAX + MOV EAX, -1 + LOCK XADD [ECX], EAX + DEC EAX + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> RCX Target + // <-- EAX Result + MOV EAX, -1 + LOCK XADD [RCX], EAX + DEC EAX + {$ENDIF CPU64} +end; + +function LockedExchange(var Target: Integer; Value: Integer): Integer; +asm + {$IFDEF CPU32} + // --> EAX Target + // EDX Value + // <-- EAX Result + MOV ECX, EAX + MOV EAX, EDX + // ECX Target + // EAX Value + LOCK XCHG [ECX], EAX + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> RCX Target + // EDX Value + // <-- EAX Result + MOV EAX, EDX + // RCX Target + // EAX Value + LOCK XCHG [RCX], EAX + {$ENDIF CPU64} +end; + +function LockedExchangeAdd(var Target: Integer; Value: Integer): Integer; +asm + {$IFDEF CPU32} + // --> EAX Target + // EDX Value + // <-- EAX Result + MOV ECX, EAX + MOV EAX, EDX + // ECX Target + // EAX Value + LOCK XADD [ECX], EAX + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> RCX Target + // EDX Value + // <-- EAX Result + MOV EAX, EDX + // RCX Target + // EAX Value + LOCK XADD [RCX], EAX + {$ENDIF CPU64} +end; + +function LockedExchangeDec(var Target: Integer): Integer; +asm + {$IFDEF CPU32} + // --> EAX Target + // <-- EAX Result + MOV ECX, EAX + MOV EAX, -1 + LOCK XADD [ECX], EAX + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> RCX Target + // <-- EAX Result + MOV EAX, -1 + LOCK XADD [RCX], EAX + {$ENDIF CPU64} +end; + +function LockedExchangeInc(var Target: Integer): Integer; +asm + {$IFDEF CPU32} + // --> EAX Target + // <-- EAX Result + MOV ECX, EAX + MOV EAX, 1 + LOCK XADD [ECX], EAX + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> RCX Target + // <-- EAX Result + MOV EAX, 1 + LOCK XADD [RCX], EAX + {$ENDIF CPU64} +end; + +function LockedExchangeSub(var Target: Integer; Value: Integer): Integer; +asm + {$IFDEF CPU32} + // --> EAX Target + // EDX Value + // <-- EAX Result + MOV ECX, EAX + NEG EDX + MOV EAX, EDX + // ECX Target + // EAX -Value + LOCK XADD [ECX], EAX + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> RCX Target + // EDX Value + // <-- EAX Result + NEG EDX + MOV EAX, EDX + // RCX Target + // EAX -Value + LOCK XADD [RCX], EAX + {$ENDIF CPU64} +end; + +function LockedInc(var Target: Integer): Integer; +asm + {$IFDEF CPU32} + // --> EAX Target + // <-- EAX Result + MOV ECX, EAX + MOV EAX, 1 + LOCK XADD [ECX], EAX + INC EAX + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> RCX Target + // <-- EAX Result + MOV EAX, 1 + LOCK XADD [RCX], EAX + INC EAX + {$ENDIF CPU64} +end; + +function LockedSub(var Target: Integer; Value: Integer): Integer; +asm + {$IFDEF CPU32} + // --> EAX Target + // EDX Value + // <-- EAX Result + MOV ECX, EAX + NEG EDX + MOV EAX, EDX + LOCK XADD [ECX], EAX + ADD EAX, EDX + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> RCX Target + // EDX Value + // <-- EAX Result + NEG EDX + MOV EAX, EDX + LOCK XADD [RCX], EAX + ADD EAX, EDX + {$ENDIF CPU64} +end; + +{$IFDEF CPU64} + +// Locked Int64 manipulation +function LockedAdd(var Target: Int64; Value: Int64): Int64; +asm + // --> RCX Target + // RDX Value + // <-- RAX Result + MOV RAX, RDX + LOCK XADD [RCX], RAX + ADD RAX, RDX +end; + +function LockedCompareExchange(var Target: Int64; Exch, Comp: Int64): Int64; +asm + // --> RCX Target + // RDX Exch + // R8 Comp + // <-- RAX Result + MOV RAX, R8 + LOCK CMPXCHG [RCX], RDX +end; + +function LockedDec(var Target: Int64): Int64; +asm + // --> RCX Target + // <-- RAX Result + MOV RAX, -1 + LOCK XADD [RCX], RAX + DEC RAX +end; + +function LockedExchange(var Target: Int64; Value: Int64): Int64; +asm + // --> RCX Target + // RDX Value + // <-- RAX Result + MOV RAX, RDX + LOCK XCHG [RCX], RAX +end; + +function LockedExchangeAdd(var Target: Int64; Value: Int64): Int64; +asm + // --> RCX Target + // RDX Value + // <-- RAX Result + MOV RAX, RDX + LOCK XADD [RCX], RAX +end; + +function LockedExchangeDec(var Target: Int64): Int64; +asm + // --> RCX Target + // <-- RAX Result + MOV RAX, -1 + LOCK XADD [RCX], RAX +end; + +function LockedExchangeInc(var Target: Int64): Int64; +asm + // --> RCX Target + // <-- RAX Result + MOV RAX, 1 + LOCK XADD [RCX], RAX +end; + +function LockedExchangeSub(var Target: Int64; Value: Int64): Int64; +asm + // --> RCX Target + // RDX Value + // <-- RAX Result + NEG RDX + MOV RAX, RDX + LOCK XADD [RCX], RAX +end; + +function LockedInc(var Target: Int64): Int64; +asm + // --> RCX Target + // <-- RAX Result + MOV RAX, 1 + LOCK XADD [RCX], RAX + INC RAX +end; + +function LockedSub(var Target: Int64; Value: Int64): Int64; +asm + // --> RCX Target + // RDX Value + // <-- RAX Result + NEG RDX + MOV RAX, RDX + LOCK XADD [RCX], RAX + ADD RAX, RDX +end; + +{$IFDEF BORLAND} + +{$IFNDEF COMPILER29_UP} + +function LockedDec(var Target: NativeInt): NativeInt; +asm + // --> RCX Target + // <-- RAX Result + MOV RAX, -1 + LOCK XADD [RCX], RAX + DEC RAX +end; + +function LockedInc(var Target: NativeInt): NativeInt; +asm + // --> RCX Target + // <-- RAX Result + MOV RAX, 1 + LOCK XADD [RCX], RAX + INC RAX +end; + +{$ENDIF ~COMPILER29_UP} + +{$ENDIF BORLAND} + +{$ENDIF CPU64} + +//=== { TJclDispatcherObject } =============================================== + +function MapSignalResult(const Ret: DWORD): TJclWaitResult; +begin + case Ret of + WAIT_ABANDONED: + Result := wrAbandoned; + WAIT_OBJECT_0: + Result := wrSignaled; + WAIT_TIMEOUT: + Result := wrTimeout; + WAIT_IO_COMPLETION: + Result := wrIoCompletion; + WAIT_FAILED: + Result := wrError; + else + Result := wrError; + end; +end; + +constructor TJclDispatcherObject.Attach(AHandle: TJclWaitHandle); +begin + inherited Create; + FExisted := True; + FHandle := AHandle; + FName := ''; +end; + +destructor TJclDispatcherObject.Destroy; +begin + CloseHandle(FHandle); + inherited Destroy; +end; + +{ TODO: Use RTDL Version of SignalObjectAndWait } + +function TJclDispatcherObject.SignalAndWait(const Obj: TJclDispatcherObject; + TimeOut: Cardinal; Alertable: Boolean): TJclWaitResult; +begin + // Note: Do not make this method virtual! It's only available on NT 4 up... + Result := MapSignalResult(Cardinal({$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.SignalObjectAndWait(Obj.Handle, Handle, TimeOut, Alertable))); +end; + +function TJclDispatcherObject.WaitAlertable(const TimeOut: Cardinal): TJclWaitResult; +begin + Result := MapSignalResult({$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.WaitForSingleObjectEx(FHandle, TimeOut, True)); +end; + +function TJclDispatcherObject.WaitFor(const TimeOut: Cardinal): TJclWaitResult; +begin + Result := MapSignalResult({$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.WaitForSingleObject(FHandle, TimeOut)); +end; + +function TJclDispatcherObject.WaitForever: TJclWaitResult; +begin + Result := WaitFor(INFINITE); +end; + +// Wait functions +function WaitForMultipleObjects(const Objects: array of TJclDispatcherObject; + WaitAll: Boolean; TimeOut: Cardinal): Cardinal; +var + Handles: array of TJclWaitHandle; + I, Count: Integer; +begin + Count := High(Objects) + 1; + SetLength(Handles, Count); + for I := 0 to Count - 1 do + Handles[I] := Objects[I].Handle; + Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.WaitForMultipleObjects(Count, @Handles[0], WaitAll, TimeOut); +end; + +function WaitAlertableForMultipleObjects(const Objects: array of TJclDispatcherObject; + WaitAll: Boolean; TimeOut: Cardinal): Cardinal; +var + Handles: array of TJclWaitHandle; + I, Count: Integer; +begin + Count := High(Objects) + 1; + SetLength(Handles, Count); + for I := 0 to Count - 1 do + Handles[I] := Objects[I].Handle; + Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.WaitForMultipleObjectsEx(Count, @Handles[0], WaitAll, TimeOut, True); +end; + +//=== { TJclCriticalSection } ================================================ + +constructor TJclCriticalSection.Create; +begin + inherited Create; + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.InitializeCriticalSection(FCriticalSection); +end; + +destructor TJclCriticalSection.Destroy; +begin + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.DeleteCriticalSection(FCriticalSection); + inherited Destroy; +end; + +class procedure TJclCriticalSection.CreateAndEnter(var CS: TJclCriticalSection); +var + NewCritSect: TJclCriticalSection; +begin + NewCritSect := TJclCriticalSection.Create; + if LockedCompareExchange(Pointer(CS), Pointer(NewCritSect), nil) <> nil then + begin + // LoadInProgress was <> nil -> no exchange took place, free the CS + NewCritSect.Free; + end; + CS.Enter; +end; + +procedure TJclCriticalSection.Enter; +begin + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.EnterCriticalSection(FCriticalSection); +end; + +procedure TJclCriticalSection.Leave; +begin + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.LeaveCriticalSection(FCriticalSection); +end; + +//== { TJclCriticalSectionEx } =============================================== + +const + DefaultCritSectSpinCount = 4000; + +constructor TJclCriticalSectionEx.Create; +begin + CreateEx(DefaultCritSectSpinCount, False); +end; + +{ TODO: Use RTDL Version of InitializeCriticalSectionAndSpinCount } + +constructor TJclCriticalSectionEx.CreateEx(SpinCount: Cardinal; + NoFailEnter: Boolean); +begin + FSpinCount := SpinCount; + if NoFailEnter then + SpinCount := SpinCount or Cardinal($80000000); + + if not InitializeCriticalSectionAndSpinCount(FCriticalSection, SpinCount) then + raise EJclCriticalSectionError.CreateRes(@RsSynchInitCriticalSection); +end; + +function TJclCriticalSectionEx.GetSpinCount: Cardinal; +begin + // Spinning only makes sense on multiprocessor systems. On a single processor + // system the thread would simply waste cycles while the owning thread is + // suspended and thus cannot release the critical section. + if ProcessorCount = 1 then + Result := 0 + else + Result := FSpinCount; +end; + +class function TJclCriticalSectionEx.GetSpinTimeOut: Cardinal; +begin + Result := Cardinal(RegReadInteger(HKEY_LOCAL_MACHINE, RegSessionManager, + RegCritSecTimeout)); +end; + +{ TODO: Use RTLD version of SetCriticalSectionSpinCount } +procedure TJclCriticalSectionEx.SetSpinCount(const Value: Cardinal); +begin + FSpinCount := SetCriticalSectionSpinCount(FCriticalSection, Value); +end; + +class procedure TJclCriticalSectionEx.SetSpinTimeOut(const Value: Cardinal); +begin + RegWriteInteger(HKEY_LOCAL_MACHINE, RegSessionManager, RegCritSecTimeout, + Integer(Value)); +end; + +{ TODO: Use RTLD version of TryEnterCriticalSection } +function TJclCriticalSectionEx.TryEnter: Boolean; +begin + Result := TryEnterCriticalSection(FCriticalSection); +end; + +//== { TJclEvent } =========================================================== + +constructor TJclEvent.Create(SecAttr: PSecurityAttributes; Manual, Signaled: Boolean; const Name: string); +begin + inherited Create; + FName := Name; + FHandle := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CreateEvent(SecAttr, Manual, Signaled, PChar(FName)); + if FHandle = 0 then + raise EJclEventError.CreateRes(@RsSynchCreateEvent); + FExisted := GetLastError = ERROR_ALREADY_EXISTS; +end; + +constructor TJclEvent.Open(Access: Cardinal; Inheritable: Boolean; + const Name: string); +begin + FName := Name; + FExisted := True; + FHandle := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.OpenEvent(Access, Inheritable, PChar(Name)); + if FHandle = 0 then + raise EJclEventError.CreateRes(@RsSynchOpenEvent); +end; + +function TJclEvent.Pulse: Boolean; +begin + Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.PulseEvent(FHandle); +end; + +function TJclEvent.ResetEvent: Boolean; +begin + Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.ResetEvent(FHandle); +end; + +function TJclEvent.SetEvent: Boolean; +begin + Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.SetEvent(FHandle); +end; + +//=== { TJclWaitableTimer } ================================================== + +{ TODO: Use RTLD version of CreateWaitableTimer } +constructor TJclWaitableTimer.Create(SecAttr: PSecurityAttributes; + Manual: Boolean; const Name: string); +begin + FName := Name; + FResume := False; + FHandle := CreateWaitableTimer(SecAttr, Manual, PChar(Name)); + if FHandle = 0 then + raise EJclWaitableTimerError.CreateRes(@RsSynchCreateWaitableTimer); + FExisted := GetLastError = ERROR_ALREADY_EXISTS; +end; + +{ TODO: Use RTLD version of CancelWaitableTimer } +function TJclWaitableTimer.Cancel: Boolean; +begin + Result := CancelWaitableTimer(FHandle); +end; + +{ TODO: Use RTLD version of OpenWaitableTimer } + +constructor TJclWaitableTimer.Open(Access: Cardinal; Inheritable: Boolean; + const Name: string); +begin + FExisted := True; + FName := Name; + FResume := False; + FHandle := OpenWaitableTimer(Access, Inheritable, PChar(Name)); + if FHandle = 0 then + raise EJclWaitableTimerError.CreateRes(@RsSynchOpenWaitableTimer); +end; + +{ TODO: Use RTLD version of SetWaitableTimer } +function TJclWaitableTimer.SetTimer(const DueTime: Int64; Period: Longint; + Resume: Boolean): Boolean; +var + DT: Int64; +begin + DT := DueTime; + FResume := Resume; + Result := SetWaitableTimer(FHandle, DT, Period, nil, nil, FResume); +end; + +{ TODO -cHelp : OS restrictions } +function TJclWaitableTimer.SetTimerApc(const DueTime: Int64; Period: Longint; + Resume: Boolean; Apc: TFNTimerAPCRoutine; Arg: Pointer): Boolean; +var + DT: Int64; +begin + DT := DueTime; + FResume := Resume; + Result := RtdlSetWaitableTimer(FHandle, DT, Period, Apc, Arg, FResume); + { TODO : Exception for Win9x, older WinNT? } + // if not Result and (GetLastError = ERROR_CALL_NOT_IMPLEMENTED) then + // RaiseLastOSError; +end; + +//== { TJclSemaphore } ======================================================= + +constructor TJclSemaphore.Create(SecAttr: PSecurityAttributes; + Initial, Maximum: Integer; const Name: string); +begin + Assert((Initial >= 0) and (Maximum > 0)); + FName := Name; + FHandle := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CreateSemaphore(SecAttr, Initial, Maximum, PChar(Name)); + if FHandle = 0 then + raise EJclSemaphoreError.CreateRes(@RsSynchCreateSemaphore); + FExisted := GetLastError = ERROR_ALREADY_EXISTS; +end; + +constructor TJclSemaphore.Open(Access: Cardinal; Inheritable: Boolean; + const Name: string); +begin + FName := Name; + FExisted := True; + FHandle := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.OpenSemaphore(Access, Inheritable, PChar(Name)); + if FHandle = 0 then + raise EJclSemaphoreError.CreateRes(@RsSynchOpenSemaphore); +end; + +function TJclSemaphore.ReleasePrev(ReleaseCount: Longint; + var PrevCount: Longint): Boolean; +begin + Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.ReleaseSemaphore(FHandle, ReleaseCount, @PrevCount); +end; + +function TJclSemaphore.Release(ReleaseCount: Integer): Boolean; +begin + Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.ReleaseSemaphore(FHandle, ReleaseCount, nil); +end; + +//=== { TJclMutex } ========================================================== + +function TJclMutex.Acquire(const TimeOut: Cardinal): Boolean; +begin + Result := WaitFor(TimeOut) = wrSignaled; +end; + +constructor TJclMutex.Create(SecAttr: PSecurityAttributes; InitialOwner: Boolean; const Name: string); +begin + inherited Create; + FName := Name; + FHandle := JclWin32.CreateMutex(SecAttr, InitialOwner, PChar(Name)); + if FHandle = 0 then + raise EJclMutexError.CreateRes(@RsSynchCreateMutex); + FExisted := GetLastError = ERROR_ALREADY_EXISTS; +end; + +constructor TJclMutex.Open(Access: Cardinal; Inheritable: Boolean; const Name: string); +begin + inherited Create; + FName := Name; + FExisted := True; + FHandle := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.OpenMutex(Access, Inheritable, PChar(Name)); + if FHandle = 0 then + raise EJclMutexError.CreateRes(@RsSynchOpenMutex); +end; + +function TJclMutex.Release: Boolean; +begin + Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.ReleaseMutex(FHandle); +end; + +//=== { TJclOptex } ========================================================== + +constructor TJclOptex.Create(const Name: string; SpinCount: Integer); +begin + FExisted := False; + FName := Name; + if Name = '' then + begin + // None shared optex, don't need filemapping, sharedinfo is local + FFileMapping := 0; + FEvent := TJclEvent.Create(nil, False, False, ''); + FSharedInfo := AllocMem(SizeOf(TOptexSharedInfo)); + end + else + begin + // Shared optex, event protects access to sharedinfo. Creation of filemapping + // doesn't need protection as it will automatically "open" instead of "create" + // if another process already created it. + FEvent := TJclEvent.Create(nil, False, False, 'Optex_Event_' + Name); + FExisted := FEvent.Existed; + FFileMapping := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, + 0, SizeOf(TOptexSharedInfo), PChar('Optex_MMF_' + Name)); + Assert(FFileMapping <> 0); + FSharedInfo := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.MapViewOfFile(FFileMapping, FILE_MAP_WRITE, 0, 0, 0); + Assert(FSharedInfo <> nil); + end; + SetSpinCount(SpinCount); +end; + +destructor TJclOptex.Destroy; +begin + FreeAndNil(FEvent); + if UniProcess then + FreeMem(FSharedInfo) + else + begin + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.UnmapViewOfFile(FSharedInfo); + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CloseHandle(FFileMapping); + end; + inherited Destroy; +end; + +procedure TJclOptex.Enter; +var + ThreadId: Longword; +begin + if TryEnter then + Exit; + ThreadId := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetCurrentThreadId; + if {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.InterlockedIncrement(FSharedInfo^.LockCount) = 1 then + begin + // Optex was unowned + FSharedInfo^.ThreadId := ThreadId; + FSharedInfo^.RecursionCount := 1; + end + else + begin + if FSharedInfo^.ThreadId = ThreadId then + begin + // We already owned it, increase ownership count + Inc(FSharedInfo^.RecursionCount) + end + else + begin + // Optex is owner by someone else, wait for it to be released and then + // immediately take ownership + FEvent.WaitForever; + FSharedInfo^.ThreadId := ThreadId; + FSharedInfo^.RecursionCount := 1; + end; + end; +end; + +function TJclOptex.GetSpinCount: Integer; +begin + Result := FSharedInfo^.SpinCount; +end; + +function TJclOptex.GetUniProcess: Boolean; +begin + Result := FFileMapping = 0; +end; + +procedure TJclOptex.Leave; +begin + Dec(FSharedInfo^.RecursionCount); + if FSharedInfo^.RecursionCount > 0 then + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.InterlockedDecrement(FSharedInfo^.LockCount) + else + begin + FSharedInfo^.ThreadId := 0; + if {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.InterlockedDecrement(FSharedInfo^.LockCount) > 0 then + FEvent.SetEvent; + end; +end; + +procedure TJclOptex.SetSpinCount(Value: Integer); +begin + if Value < 0 then + Value := DefaultCritSectSpinCount; + // Spinning only makes sense on multiprocessor systems + if ProcessorCount > 1 then + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.InterlockedExchange(Integer(FSharedInfo^.SpinCount), Value); +end; + +function TJclOptex.TryEnter: Boolean; +var + ThreadId: Longword; + ThreadOwnsOptex: Boolean; + SpinCount: Integer; +begin + ThreadId := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetCurrentThreadId; + SpinCount := FSharedInfo^.SpinCount; + repeat + //ThreadOwnsOptex := InterlockedCompareExchange(Pointer(FSharedInfo^.LockCount), + // Pointer(1), Pointer(0)) = Pointer(0); // not available on win95 + ThreadOwnsOptex := LockedCompareExchange(FSharedInfo^.LockCount, 1, 0) = 0; + if ThreadOwnsOptex then + begin + // Optex was unowned + FSharedInfo^.ThreadId := ThreadId; + FSharedInfo^.RecursionCount := 1; + end + else + begin + if FSharedInfo^.ThreadId = ThreadId then + begin + // We already owned the Optex + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.InterlockedIncrement(FSharedInfo^.LockCount); + Inc(FSharedInfo^.RecursionCount); + ThreadOwnsOptex := True; + end; + end; + Dec(SpinCount); + until ThreadOwnsOptex or (SpinCount <= 0); + Result := ThreadOwnsOptex; +end; + +//=== { TJclMultiReadExclusiveWrite } ======================================== + +constructor TJclMultiReadExclusiveWrite.Create(Preferred: TMrewPreferred); +begin + inherited Create; + FLock := TJclCriticalSection.Create; + FPreferred := Preferred; + FSemReaders := TJclSemaphore.Create(nil, 0, MaxInt, ''); + FSemWriters := TJclSemaphore.Create(nil, 0, MaxInt, ''); + SetLength(FThreads, 0); + FState := 0; + FWaitingReaders := 0; + FWaitingWriters := 0; +end; + +destructor TJclMultiReadExclusiveWrite.Destroy; +begin + FreeAndNil(FSemReaders); + FreeAndNil(FSemWriters); + FreeAndNil(FLock); + inherited Destroy; +end; + +procedure TJclMultiReadExclusiveWrite.AddToThreadList(ThreadId: Longword; + Reader: Boolean); +var + L: Integer; +begin + // Caller must own lock + L := Length(FThreads); + SetLength(FThreads, L + 1); + FThreads[L].ThreadId := ThreadId; + FThreads[L].RecursionCount := 1; + FThreads[L].Reader := Reader; +end; + +procedure TJclMultiReadExclusiveWrite.BeginRead; +var + ThreadId: Longword; + Index: Integer; + MustWait: Boolean; +begin + MustWait := False; + ThreadId := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetCurrentThreadId; + FLock.Enter; + try + Index := FindThread(ThreadId); + if Index >= 0 then + begin + // Thread is on threadslist so it is already reading + Inc(FThreads[Index].RecursionCount); + end + else + begin + // Request to read (first time) + AddToThreadList(ThreadId, True); + if FState >= 0 then + begin + // MREW is unowned or only readers. If there are no waiting writers or + // readers are preferred then allow thread to continue, otherwise it must + // wait it's turn + if (FPreferred = mpReaders) or (FWaitingWriters = 0) then + Inc(FState) + else + begin + Inc(FWaitingReaders); + MustWait := True; + end; + end + else + begin + // MREW is owner by a writer, must wait + Inc(FWaitingReaders); + MustWait := True; + end; + end; + finally + FLock.Leave; + end; + if MustWait then + FSemReaders.WaitForever; +end; + +procedure TJclMultiReadExclusiveWrite.BeginWrite; +var + ThreadId: Longword; + Index: Integer; + MustWait: Boolean; +begin + MustWait := False; + FLock.Enter; + try + ThreadId := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetCurrentThreadId; + Index := FindThread(ThreadId); + if Index < 0 then + begin + // Request to write (first time) + AddToThreadList(ThreadId, False); + if FState = 0 then + begin + // MREW is unowned so start writing + FState := -1; + end + else + begin + // MREW is owner, must wait + Inc(FWaitingWriters); + MustWait := True; + end; + end + else + begin + if FThreads[Index].Reader then + begin + // Request to write while reading + Inc(FThreads[Index].RecursionCount); + FThreads[Index].Reader := False; + Dec(FState); + if FState = 0 then + begin + // MREW is unowned so start writing + FState := -1; + end + else + begin + // MREW is owned, must wait + MustWait := True; + Inc(FWaitingWriters); + end; + end + else + // Requesting to write while already writing + Inc(FThreads[Index].RecursionCount); + end; + finally + FLock.Leave; + end; + if MustWait then + FSemWriters.WaitFor(INFINITE); +end; + +procedure TJclMultiReadExclusiveWrite.EndRead; +begin + Release; +end; + +procedure TJclMultiReadExclusiveWrite.EndWrite; +begin + Release; +end; + +function TJclMultiReadExclusiveWrite.FindThread(ThreadId: Longword): Integer; +var + I: Integer; +begin + // Caller must lock + Result := -1; + for I := 0 to Length(FThreads) - 1 do + if FThreads[I].ThreadId = ThreadId then + begin + Result := I; + Exit; + end; +end; + +procedure TJclMultiReadExclusiveWrite.Release; +var + ThreadId: Longword; + Index: Integer; + WasReading: Boolean; +begin + ThreadId := GetCurrentThreadId; + FLock.Enter; + try + Index := FindThread(ThreadId); + if Index >= 0 then + begin + Dec(FThreads[Index].RecursionCount); + if FThreads[Index].RecursionCount = 0 then + begin + WasReading := FThreads[Index].Reader; + if WasReading then + Dec(FState) + else + FState := 0; + RemoveFromThreadList(Index); + if FState = 0 then + ReleaseWaiters(WasReading); + end; + end; + finally + FLock.Leave; + end; +end; + +procedure TJclMultiReadExclusiveWrite.ReleaseWaiters(WasReading: Boolean); +var + ToRelease: TMrewPreferred; +begin + // Caller must Lock + ToRelease := mpEqual; + case FPreferred of + mpReaders: + if FWaitingReaders > 0 then + ToRelease := mpReaders + else + if FWaitingWriters > 0 then + ToRelease := mpWriters; + mpWriters: + if FWaitingWriters > 0 then + ToRelease := mpWriters + else + if FWaitingReaders > 0 then + ToRelease := mpReaders; + mpEqual: + if WasReading then + begin + if FWaitingWriters > 0 then + ToRelease := mpWriters + else + if FWaitingReaders > 0 then + ToRelease := mpReaders; + end + else + begin + if FWaitingReaders > 0 then + ToRelease := mpReaders + else + if FWaitingWriters > 0 then + ToRelease := mpWriters; + end; + end; + case ToRelease of + mpReaders: + begin + FState := FWaitingReaders; + FWaitingReaders := 0; + FSemReaders.Release(FState); + end; + mpWriters: + begin + FState := -1; + Dec(FWaitingWriters); + FSemWriters.Release(1); + end; + mpEqual: + // no waiters + end; +end; + +procedure TJclMultiReadExclusiveWrite.RemoveFromThreadList(Index: Integer); +var + L: Integer; +begin + // Caller must Lock + L := Length(FThreads); + if Index < (L - 1) then + Move(FThreads[Index + 1], FThreads[Index], SizeOf(TMrewThreadInfo) * (L - Index - 1)); + SetLength(FThreads, L - 1); +end; + +//=== { TJclMeteredSection } ================================================= + +const + MAX_METSECT_NAMELEN = 128; + +constructor TJclMeteredSection.Create(InitialCount, MaxCount: Integer; const Name: string); +begin + if (MaxCount < 1) or (InitialCount > MaxCount) or (InitialCount < 0) or + (Length(Name) > MAX_METSECT_NAMELEN) then + raise EJclMeteredSectionError.CreateRes(@RsMetSectInvalidParameter); + FMetSect := PMeteredSection(AllocMem(SizeOf(TMeteredSection))); + if FMetSect <> nil then + begin + if not InitMeteredSection(InitialCount, MaxCount, Name, False) then + begin + CloseMeteredSection; + FMetSect := nil; + raise EJclMeteredSectionError.CreateRes(@RsMetSectInitialize); + end; + end; +end; + +constructor TJclMeteredSection.Open(const Name: string); +begin + FMetSect := nil; + if Name = '' then + raise EJclMeteredSectionError.CreateRes(@RsMetSectNameEmpty); + FMetSect := PMeteredSection(AllocMem(SizeOf(TMeteredSection))); + Assert(FMetSect <> nil); + if not InitMeteredSection(0, 0, Name, True) then + begin + CloseMeteredSection; + FMetSect := nil; + raise EJclMeteredSectionError.CreateRes(@RsMetSectInitialize); + end; +end; + +destructor TJclMeteredSection.Destroy; +begin + CloseMeteredSection; + inherited Destroy; +end; + +procedure TJclMeteredSection.AcquireLock; +begin + while {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.InterlockedExchange(FMetSect^.SharedInfo^.SpinLock, 1) <> 0 do + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.Sleep(0); +end; + +procedure TJclMeteredSection.CloseMeteredSection; +begin + if FMetSect <> nil then + begin + if FMetSect^.SharedInfo <> nil then + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.UnmapViewOfFile(FMetSect^.SharedInfo); + if FMetSect^.FileMap <> 0 then + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CloseHandle(FMetSect^.FileMap); + if FMetSect^.Event <> 0 then + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CloseHandle(FMetSect^.Event); + FreeMem(FMetSect); + end; +end; + +function TJclMeteredSection.CreateMetSectEvent(const Name: string; OpenOnly: Boolean): Boolean; +var + FullName: string; +begin + if Name = '' then + FMetSect^.Event := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CreateEvent(nil, False, False, nil) + else + begin + FullName := 'JCL_MSECT_EVT_' + Name; + if OpenOnly then + FMetSect^.Event := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.OpenEvent(0, False, PChar(FullName)) + else + FMetSect^.Event := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CreateEvent(nil, False, False, PChar(FullName)); + end; + Result := FMetSect^.Event <> 0; +end; + +function TJclMeteredSection.CreateMetSectFileView(InitialCount, MaxCount: Longint; + const Name: string; OpenOnly: Boolean): Boolean; +var + FullName: string; + LastError: DWORD; +begin + Result := False; + if Name = '' then + FMetSect^.FileMap := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(TMetSectSharedInfo), nil) + else + begin + FullName := 'JCL_MSECT_MMF_' + Name; + if OpenOnly then + FMetSect^.FileMap := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.OpenFileMapping(0, False, PChar(FullName)) + else + FMetSect^.FileMap := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(TMetSectSharedInfo), PChar(FullName)); + end; + if FMetSect^.FileMap <> 0 then + begin + LastError := GetLastError; + FMetSect^.SharedInfo := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.MapViewOfFile(FMetSect^.FileMap, FILE_MAP_WRITE, 0, 0, 0); + if FMetSect^.SharedInfo <> nil then + begin + if LastError = ERROR_ALREADY_EXISTS then + while not FMetSect^.SharedInfo^.Initialized do Sleep(0) + else + begin + FMetSect^.SharedInfo^.SpinLock := 0; + FMetSect^.SharedInfo^.ThreadsWaiting := 0; + FMetSect^.SharedInfo^.AvailableCount := InitialCount; + FMetSect^.SharedInfo^.MaximumCount := MaxCount; + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.InterlockedExchange(Integer(FMetSect^.SharedInfo^.Initialized), 1); + end; + Result := True; + end; + end; +end; + +function TJclMeteredSection.Enter(TimeOut: Longword): TJclWaitResult; +begin + Result := wrSignaled; + while Result = wrSignaled do + begin + AcquireLock; + try + if FMetSect^.SharedInfo^.AvailableCount >= 1 then + begin + Dec(FMetSect^.SharedInfo^.AvailableCount); + Result := MapSignalResult(WAIT_OBJECT_0); + Exit; + end; + Inc(FMetSect^.SharedInfo^.ThreadsWaiting); + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.ResetEvent(FMetSect^.Event); + finally + ReleaseLock; + end; + Result := MapSignalResult({$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.WaitForSingleObject(FMetSect^.Event, TimeOut)); + end; +end; + +function TJclMeteredSection.InitMeteredSection(InitialCount, MaxCount: Longint; + const Name: string; OpenOnly: Boolean): Boolean; +begin + Result := False; + if CreateMetSectEvent(Name, OpenOnly) then + Result := CreateMetSectFileView(InitialCount, MaxCount, Name, OpenOnly); +end; + +function TJclMeteredSection.Leave(ReleaseCount: Integer; out PrevCount: Integer): Boolean; +var + Count: Integer; +begin + Result := False; + AcquireLock; + try + PrevCount := FMetSect^.SharedInfo^.AvailableCount; + if (ReleaseCount < 0) or + (FMetSect^.SharedInfo^.AvailableCount + ReleaseCount > FMetSect^.SharedInfo^.MaximumCount) then + begin + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.SetLastError(ERROR_INVALID_PARAMETER); + Exit; + end; + Inc(FMetSect^.SharedInfo^.AvailableCount, ReleaseCount); + ReleaseCount := Min(ReleaseCount, FMetSect^.SharedInfo^.ThreadsWaiting); + if FMetSect^.SharedInfo^.ThreadsWaiting > 0 then + begin + for Count := 0 to ReleaseCount - 1 do + begin + Dec(FMetSect^.SharedInfo^.ThreadsWaiting); + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.SetEvent(FMetSect^.Event); + end; + end; + finally + ReleaseLock; + end; + Result := True; +end; + +function TJclMeteredSection.Leave(ReleaseCount: Integer): Boolean; +var + Previous: Longint; +begin + Result := Leave(ReleaseCount, Previous); +end; + +procedure TJclMeteredSection.ReleaseLock; +begin + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.InterlockedExchange(FMetSect^.SharedInfo^.SpinLock, 0); +end; + +//=== Debugging ============================================================== + +function QueryCriticalSection(CS: TJclCriticalSection; var Info: TRTLCriticalSection): Boolean; +begin + Result := CS <> nil; + if Result then + Info := CS.FCriticalSection; +end; + +// Native API functions +// http://undocumented.ntinternals.net/ + +{ TODO: RTLD version } + +type + TNtQueryProc = function (Handle: THandle; InfoClass: Byte; Info: Pointer; + Len: Longint; ResLen: PLongint): Longint; stdcall; + +var + _QueryEvent: TNtQueryProc = nil; + _QueryMutex: TNtQueryProc = nil; + _QuerySemaphore: TNtQueryProc = nil; + _QueryTimer: TNtQueryProc = nil; + +function CallQueryProc(var P: TNtQueryProc; const Name: string; Handle: THandle; + Info: Pointer; InfoSize: Longint): Boolean; +var + NtDll: THandle; + Status: Longint; +begin + Result := False; + if @P = nil then + begin + NtDll := GetModuleHandle(PChar('ntdll.dll')); + if NtDll <> 0 then + @P := GetProcAddress(NtDll, PChar(Name)); + end; + if @P <> nil then + begin + Status := P(Handle, 0, Info, InfoSize, nil); + Result := (Status and $80000000) = 0; + end; +end; + +function QueryEvent(Handle: THandle; var Info: TEventInfo): Boolean; +begin + Result := CallQueryProc(_QueryEvent, 'NtQueryEvent', Handle, @Info, SizeOf(Info)); +end; + +function QueryMutex(Handle: THandle; var Info: TMutexInfo): Boolean; +begin + Result := CallQueryProc(_QueryMutex, 'NtQueryMutex', Handle, @Info, SizeOf(Info)); +end; + +function QuerySemaphore(Handle: THandle; var Info: TSemaphoreCounts): Boolean; +begin + Result := CallQueryProc(_QuerySemaphore, 'NtQuerySemaphore', Handle, @Info, SizeOf(Info)); +end; + +function QueryTimer(Handle: THandle; var Info: TTimerInfo): Boolean; +begin + Result := CallQueryProc(_QueryTimer, 'NtQueryTimer', Handle, @Info, SizeOf(Info)); +end; + +function ValidateMutexName(const aName: string): string; +const cMutexMaxName = 200; +begin + if Length(aName) > cMutexMaxName then + Result := Copy (aName, Length(aName)-cMutexMaxName, cMutexMaxName) + else + Result := aName; + Result := StrReplaceChar(Result, '\', '_'); +end; + + + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclSysInfo.pas b/3rdParty/JCL/source/common/JclSysInfo.pas index e06093e6..b86c6de2 100644 --- a/3rdParty/JCL/source/common/JclSysInfo.pas +++ b/3rdParty/JCL/source/common/JclSysInfo.pas @@ -258,7 +258,7 @@ function GetShellProcessHandle: THandle; wvWin2003, wvWinXP64, wvWin2003R2, wvWinVista, wvWinServer2008, wvWin7, wvWinServer2008R2, wvWin8, wvWin8RT, wvWinServer2012, wvWin81, wvWin81RT, wvWinServer2012R2, wvWin10, wvWinServer2016, - wvWinServer2019, wvWinServer, wvWin11, wvWinServer2022); + wvWinServer2019, wvWinServer, wvWin11, wvWinServer2022, wvWinServer2025); TWindowsEdition = (weUnknown, weWinXPHome, weWinXPPro, weWinXPHomeN, weWinXPProN, weWinXPHomeK, weWinXPProK, weWinXPHomeKN, weWinXPProKN, weWinXPStarter, weWinXPMediaCenter, @@ -312,6 +312,7 @@ function GetShellProcessHandle: THandle; IsWinServer2016: Boolean = False; IsWinServer2019: Boolean = False; IsWinServer2022: Boolean = False; + IsWinServer2025: Boolean = False; IsWinServer: Boolean = False; IsWin11: Boolean = False; @@ -333,6 +334,7 @@ function GetShellProcessHandle: THandle; const Windows11InitialBuildNumber = 22000; + Windows2025ServerInitialBuildNumber = 26100; function GetWindowsVersion: TWindowsVersion; function GetWindowsEdition: TWindowsEdition; @@ -3617,7 +3619,7 @@ function GetWindowsVersion: TWindowsVersion; Win32MinorVersionEx := 4 // Windows 10 (builds < 9926) and Windows Server 2016 (builds < 10074) else if Win32MajorVersionEx = 10 then - Win32MinorVersionEx := -1 // Windows 10 (builds >= 9926) and Windows Server 2016/2019/2022 (builds >= 10074), set to -1 to escape case block + Win32MinorVersionEx := -1 // Windows 10 (builds >= 9926) and Windows Server 2016/2019/2022/2025 (builds >= 10074), set to -1 to escape case block else Win32MinorVersionEx := Win32MinorVersion; end; @@ -3710,7 +3712,12 @@ function GetWindowsVersion: TWindowsVersion; 1809: Result := wvWinServer2019; 2009: - Result := wvWinServer2022; + begin + if GetWindowsBuildNumber >= Windows2025ServerInitialBuildNumber then + Result := wvWinServer2025 + else + Result := wvWinServer2022; + end else Result := wvWinServer; end; @@ -4038,6 +4045,8 @@ function GetWindowsVersionString: string; Result := LoadResString(@RsOSVersionWinServer2019); wvWinServer2022: Result := LoadResString(@RsOSVersionWinServer2022); + wvWinServer2025: + Result := LoadResString(@RsOSVersionWinServer2025); wvWinServer: Result := LoadResString(@RsOSVersionWinServer); wvWin11: @@ -4358,6 +4367,9 @@ function GetWindowsReleaseName: String; else if WindowsDisplayVersion = '24H2' then Result := '2024 Update' + else + if WindowsDisplayVersion = '25H2' then + Result := '2025 Update' else Result := WindowsDisplayVersion + ' Update'; Result := Trim(GetWindowsVersionString + ' ' + Result); @@ -6667,6 +6679,8 @@ procedure InitSysInfo; IsWinServer2019 := True; wvWinServer2022: IsWinServer2022 := True; + wvWinServer2025: + IsWinServer2025 := True; wvWinServer: IsWinServer := True; wvWin11: diff --git a/3rdParty/JCL/source/common/JclTrees.pas b/3rdParty/JCL/source/common/JclTrees.pas new file mode 100644 index 00000000..a2a92a6c --- /dev/null +++ b/3rdParty/JCL/source/common/JclTrees.pas @@ -0,0 +1,20332 @@ +{**************************************************************************************************} +{ WARNING: JEDI preprocessor generated unit. Do not edit. } +{**************************************************************************************************} + +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclTrees.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet. Portions created by } +{ Florent Ouchet are Copyright (C) Florent Ouchet = class + public + Value: T; + {$IFDEF BCB} + Children: TDynObjectArray; + {$ELSE ~BCB} + Children: array of TJclTreeNode; + {$ENDIF ~BCB} + ChildrenCount: Integer; + Parent: TJclTreeNode; + function IndexOfChild(AChild: TJclTreeNode): Integer; + function IndexOfValue(const AItem: T; const AEqualityComparer: IJclEqualityComparer): Integer; + end; + + TJclPreOrderTreeIterator = class; + TJclPostOrderTreeIterator = class; + + TJclTree = class(TJclAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclContainer, IJclFlatContainer, IJclEqualityComparer, IJclItemOwner, + IJclCollection, IJclTree) + protected + type + TTreeNode = TJclTreeNode; + TPreOrderTreeIterator = TJclPreOrderTreeIterator; + TPostOrderTreeIterator = TJclPostOrderTreeIterator; + private + FRoot: TTreeNode; + FTraverseOrder: TJclTraverseOrder; + protected + procedure ExtractNode(var ANode: TTreeNode); + procedure RemoveNode(var ANode: TTreeNode); + function CloneNode(Node, Parent: TTreeNode): TTreeNode; + function NodeContains(ANode: TTreeNode; const AItem: T): Boolean; + procedure PackNode(ANode: TTreeNode); + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + public + constructor Create(AOwnsItems: Boolean); + destructor Destroy; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { IJclCollection } + function Add(const AItem: T): Boolean; + function AddAll(const ACollection: IJclCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclCollection): Boolean; + function Contains(const AItem: T): Boolean; + function ContainsAll(const ACollection: IJclCollection): Boolean; + function Extract(const AItem: T): Boolean; + function ExtractAll(const ACollection: IJclCollection): Boolean; + function First: IJclIterator; + function IsEmpty: Boolean; + function Last: IJclIterator; + function Remove(const AItem: T): Boolean; + function RemoveAll(const ACollection: IJclCollection): Boolean; + function RetainAll(const ACollection: IJclCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclTree } + function GetRoot: IJclTreeIterator; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: IJclTreeIterator read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + TJclTreeIterator = class(TJclAbstractIterator, IJclIterator, IJclTreeIterator) + protected + FCursor: TJclTree.TTreeNode; + FStart: TItrStart; + FOwnTree: TJclTree; + FEqualityComparer: IJclEqualityComparer; // keep a reference of tree interface + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function GetNextCursor: TJclTree.TTreeNode; virtual; abstract; + // return next node on the same level + function GetNextSibling: TJclTree.TTreeNode; virtual; abstract; + function GetPreviousCursor: TJclTree.TTreeNode; virtual; abstract; + public + constructor Create(OwnTree: TJclTree; ACursor: TJclTree.TTreeNode; AValid: Boolean; AStart: TItrStart); + { IJclIterator } + function Add(const AItem: T): Boolean; + procedure Extract; + function GetItem: T; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AItem: T): Boolean; + function IteratorEquals(const AIterator: IJclIterator): Boolean; + function Next: T; + function NextIndex: Integer; + function Previous: T; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetItem(const AItem: T); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: T read GetItem; + {$ENDIF SUPPORTS_FOR_IN} + { IJclTreeIterator } + function AddChild(const AItem: T): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): T; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(const AItem: T): Integer; + function InsertChild(Index: Integer; const AItem: T): Boolean; + function Parent: T; + procedure SetChild(Index: Integer; const AItem: T); + end; + + TJclPreOrderTreeIterator = class(TJclTreeIterator, IJclIterator, IJclTreeIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclTree.TTreeNode; override; + function GetNextSibling: TJclTree.TTreeNode; override; + function GetPreviousCursor: TJclTree.TTreeNode; override; + end; + + TJclPostOrderTreeIterator = class(TJclTreeIterator, IJclIterator, IJclTreeIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: TJclTree.TTreeNode; override; + function GetNextSibling: TJclTree.TTreeNode; override; + function GetPreviousCursor: TJclTree.TTreeNode; override; + end; + + // E = External helper to compare items for equality + TJclTreeE = class(TJclTree, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclContainer, IJclItemOwner, IJclEqualityComparer, + IJclCollection, IJclTree) + private + FEqualityComparer: IJclEqualityComparer; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AEqualityComparer: IJclEqualityComparer; AOwnsItems: Boolean); + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + property EqualityComparer: IJclEqualityComparer read FEqualityComparer write FEqualityComparer; + end; + + // F = Function to compare items for equality + TJclTreeF = class(TJclTree, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclContainer, IJclItemOwner, IJclEqualityComparer, + IJclCollection, IJclTree) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(ACompare: TCompare; AOwnsItems: Boolean); + end; + + // I = Items can compare themselves to an other for equality + TJclTreeI> = class(TJclTree, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclContainer, IJclItemOwner, IJclEqualityComparer, + IJclCollection, IJclTree) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +{$IFDEF BCB} +{$IFDEF WIN64} + {$HPPEMIT '#ifdef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #undef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #define JclTrees_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT '#endif'} + + {$HPPEMIT END '#ifdef JclTrees_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #define MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #undef JclTrees_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END '#endif'} +{$ENDIF WIN64} +{$ENDIF BCB} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +//=== { TJclIntfTreeNode } ======================================================= + +function TJclIntfTreeNode.IndexOfChild(AChild: TJclIntfTreeNode): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if Children[Result] = AChild then + Exit; + Result := -1; +end; + +function TJclIntfTreeNode.IndexOfValue(const AInterface: IInterface; + const AEqualityComparer: IJclIntfEqualityComparer): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if AEqualityComparer.ItemsEqual(TJclIntfTreeNode(Children[Result]).Value, AInterface) then + Exit; + Result := -1; +end; + +//=== { TJclIntfTree } ======================================================= + +constructor TJclIntfTree.Create(); +begin + inherited Create(); + FTraverseOrder := toPreOrder; +end; + +destructor TJclIntfTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclIntfTree.Add(const AInterface: IInterface): Boolean; +var + NewNode: TJclIntfTreeNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := AllowDefaultElements or not ItemsEqual(AInterface, nil); + + if Result then + begin + if FRoot <> nil then + begin + Result := (not Contains(AInterface)) or CheckDuplicate; + if Result then + begin + if FRoot.ChildrenCount = Length(FRoot.Children) then + SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); + if FRoot.ChildrenCount < Length(FRoot.Children) then + begin + NewNode := TJclIntfTreeNode.Create; + NewNode.Value := AInterface; + NewNode.Parent := FRoot; + FRoot.Children[FRoot.ChildrenCount] := NewNode; + Inc(FRoot.ChildrenCount); + Inc(FSize); + end + else + Result := False; + end; + end + else + begin + FRoot := TJclIntfTreeNode.Create; + FRoot.Value := AInterface; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfTree.AddAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclIntfTree; + ACollection: IJclIntfCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntfTree then + begin + ADest := TJclIntfTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclIntfCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclIntfTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclIntfTree then + TJclIntfTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclIntfTree.Clear; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + RemoveNode(FRoot); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfTree.CloneNode(Node, Parent: TJclIntfTreeNode): TJclIntfTreeNode; +var + Index: Integer; +begin + Result := TJclIntfTreeNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + SetLength(Result.Children, Node.ChildrenCount); + Result.ChildrenCount := Node.ChildrenCount; + for Index := 0 to Node.ChildrenCount - 1 do + Result.Children[Index] := CloneNode(TJclIntfTreeNode(Node.Children[Index]), Result); // recursive call +end; + +function TJclIntfTree.CollectionEquals(const ACollection: IJclIntfCollection): Boolean; +var + It, ItSelf: IJclIntfIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfTree.Contains(const AInterface: IInterface): Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + Result := NodeContains(FRoot, AInterface) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfTree.ContainsAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfTree.Extract(const AInterface: IInterface): Boolean; +var + It: IJclIntfIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FRoot <> nil; + if Result then + begin + It := First; + while It.HasNext do + if ItemsEqual(It.Next, AInterface) then + begin + It.Extract; + if RemoveSingleElement then + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfTree.ExtractAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfTree.ExtractNode(var ANode: TJclIntfTreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TJclIntfTreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + ExtractNode(TJclIntfTreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + ExtractNode(ANode.Children[Index]); + {$ENDIF ~BCB} + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclIntfTree.First: IJclIntfIterator; +var + Start: TJclIntfTreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderIntfTreeIterator.Create(Self, Start, False, isFirst); + toPostOrder: + begin + if Start <> nil then + while (Start.ChildrenCount > 0) do + Start := TJclIntfTreeNode(Start.Children[0]); + Result := TJclPostOrderIntfTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclIntfTree.GetEnumerator: IJclIntfIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclIntfTree.GetRoot: IJclIntfTreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderIntfTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TJclPostOrderIntfTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclIntfTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntfTree.Last: IJclIntfIterator; +var + Start: TJclIntfTreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while Start.ChildrenCount > 0 do + Start := TJclIntfTreeNode(Start.Children[Start.ChildrenCount - 1]); + Result := TJclPreOrderIntfTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TJclPostOrderIntfTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfTree.NodeContains(ANode: TJclIntfTreeNode; const AInterface: IInterface): Boolean; +var + Index: Integer; +begin + Result := ItemsEqual(ANode.Value, AInterface); + if not Result then + for Index := 0 to ANode.ChildrenCount - 1 do + begin + Result := NodeContains(TJclIntfTreeNode(ANode.Children[Index]), AInterface); + if Result then + Break; + end; +end; + +procedure TJclIntfTree.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + PackNode(FRoot); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfTree.PackNode(ANode: TJclIntfTreeNode); +var + Index: Integer; +begin + SetLength(ANode.Children, ANode.ChildrenCount); + for Index := 0 to ANode.ChildrenCount - 1 do + PackNode(TJclIntfTreeNode(ANode.Children[Index])); +end; + +function TJclIntfTree.Remove(const AInterface: IInterface): Boolean; +var + Extracted: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AInterface); + if Result then + begin + Extracted := AInterface; + FreeObject(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfTree.RemoveAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfTree.RemoveNode(var ANode: TJclIntfTreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TJclIntfTreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + RemoveNode(TJclIntfTreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + RemoveNode(ANode.Children[Index]); + {$ENDIF ~BCB} + FreeObject(ANode.Value); + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclIntfTree.RetainAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclIntfTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclIntfTree.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfTree.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfTree.Create; + AssignPropertiesTo(Result); +end; + +//=== { TJclIntfTreeIterator } =========================================================== + +constructor TJclIntfTreeIterator.Create(OwnTree: TJclIntfTree; ACursor: TJclIntfTreeNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnTree := OwnTree; + FStart := AStart; + FEqualityComparer := OwnTree as IJclIntfEqualityComparer; +end; + +function TJclIntfTreeIterator.Add(const AInterface: IInterface): Boolean; +var + ParentNode, NewNode: TJclIntfTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // add sibling or, if FCursor is root node, behave like TJclIntfTree.Add + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AInterface, nil)) + and ((not FOwnTree.Contains(AInterface)) or FOwnTree.CheckDuplicate); + + if Result then + begin + ParentNode := FCursor.Parent; + if ParentNode = nil then + ParentNode := FCursor; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclIntfTreeNode.Create; + NewNode.Value := AInterface; + NewNode.Parent := ParentNode; + ParentNode.Children[ParentNode.ChildrenCount] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfTreeIterator.AddChild(const AInterface: IInterface): Boolean; +var + NewNode: TJclIntfTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AInterface, nil)) + and ((not FOwnTree.Contains(AInterface)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclIntfTreeNode.Create; + NewNode.Value := AInterface; + NewNode.Parent := FCursor; + FCursor.Children[FCursor.ChildrenCount] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclIntfTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclIntfTreeIterator then + begin + ADest := TJclIntfTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclIntfTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.ChildrenCount + else + Result := 0; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfTreeIterator.DeleteChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclIntfTreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfTreeIterator.DeleteChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclIntfTreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfTreeIterator.Extract; +var + OldCursor: TJclIntfTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.ExtractNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfTreeIterator.ExtractChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclIntfTreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfTreeIterator.ExtractChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclIntfTreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfTreeIterator.GetChild(Index: Integer): IInterface; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := nil; + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + FCursor := TJclIntfTreeNode(FCursor.Children[Index]); + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfTreeIterator.GetObject: IInterface; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfTreeIterator.IndexOfChild(const AInterface: IInterface): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.IndexOfValue(AInterface, FEqualityComparer) + else + Result := -1; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfTreeIterator.Insert(const AInterface: IInterface): Boolean; +var + ParentNode, NewNode: TJclIntfTreeNode; + Index, I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclIntfTree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AInterface, nil)) + and ((not FOwnTree.Contains(AInterface)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.Parent <> nil then + begin + ParentNode := FCursor.Parent; + Index := 0; + while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do + Inc(Index); + end + else + begin + ParentNode := FCursor; + Index := 0; + end; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclIntfTreeNode.Create; + NewNode.Value := AInterface; + NewNode.Parent := ParentNode; + for I := ParentNode.ChildrenCount - 1 downto Index do + ParentNode.Children[I + 1] := ParentNode.Children[I]; + ParentNode.Children[Index] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfTreeIterator.InsertChild(Index: Integer; const AInterface: IInterface): Boolean; +var + NewNode: TJclIntfTreeNode; + I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclIntfTree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AInterface, nil)) + and ((not FOwnTree.Contains(AInterface)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclIntfTreeNode.Create; + NewNode.Value := AInterface; + NewNode.Parent := FCursor; + for I := FCursor.ChildrenCount - 1 downto Index do + FCursor.Children[I + 1] := FCursor.Children[I]; + FCursor.Children[Index] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfTreeIterator.IteratorEquals(const AIterator: IJclIntfIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclIntfTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclIntfTreeIterator then + begin + ItrObj := TJclIntfTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclIntfTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclIntfTreeIterator.Next: IInterface; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclIntfTreeIterator.Parent: IInterface; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := nil; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfTreeIterator.Previous: IInterface; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclIntfTreeIterator.Remove; +var + OldCursor: TJclIntfTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.RemoveNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfTreeIterator.Reset; +var + NewCursor: TJclIntfTreeNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfTreeIterator.SetChild(Index: Integer; const AInterface: IInterface); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + TJclIntfTreeNode(FCursor.Children[Index]).Value := AInterface + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfTreeIterator.SetObject(const AInterface: IInterface); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + if FCursor <> nil then + begin + FOwnTree.FreeObject(FCursor.Value); + FCursor.Value := AInterface; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclPreOrderIntfTreeIterator } =================================================== + +function TJclPreOrderIntfTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderIntfTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderIntfTreeIterator.GetNextCursor: TJclIntfTreeNode; +var + LastRet: TJclIntfTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.ChildrenCount > 0 then + Result := TJclIntfTreeNode(Result.Children[0]) + else + begin + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclIntfTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + end; +end; + +function TJclPreOrderIntfTreeIterator.GetNextSibling: TJclIntfTreeNode; +var + LastRet: TJclIntfTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclIntfTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); +end; + +function TJclPreOrderIntfTreeIterator.GetPreviousCursor: TJclIntfTreeNode; +var + LastRet: TJclIntfTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then + // come from Right + begin + Result := TJclIntfTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + while (Result.ChildrenCount > 0) do // descend down the tree + Result := TJclIntfTreeNode(Result.Children[Result.ChildrenCount - 1]); + end; +end; + +//=== { TJclPostOrderIntfTreeIterator } ================================================== + +function TJclPostOrderIntfTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderIntfTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderIntfTreeIterator.GetNextCursor: TJclIntfTreeNode; +var + LastRet: TJclIntfTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclIntfTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclIntfTreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderIntfTreeIterator.GetNextSibling: TJclIntfTreeNode; +var + LastRet: TJclIntfTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclIntfTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclIntfTreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderIntfTreeIterator.GetPreviousCursor: TJclIntfTreeNode; +var + LastRet: TJclIntfTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.ChildrenCount > 0 then + Result := TJclIntfTreeNode(Result.Children[Result.ChildrenCount - 1]) + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := TJclIntfTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + end; +end; + +//=== { TJclAnsiStrTreeNode } ======================================================= + +function TJclAnsiStrTreeNode.IndexOfChild(AChild: TJclAnsiStrTreeNode): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if Children[Result] = AChild then + Exit; + Result := -1; +end; + +function TJclAnsiStrTreeNode.IndexOfValue(const AString: AnsiString; + const AEqualityComparer: IJclAnsiStrEqualityComparer): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if AEqualityComparer.ItemsEqual(TJclAnsiStrTreeNode(Children[Result]).Value, AString) then + Exit; + Result := -1; +end; + +//=== { TJclAnsiStrTree } ======================================================= + +constructor TJclAnsiStrTree.Create(); +begin + inherited Create(); + FTraverseOrder := toPreOrder; +end; + +destructor TJclAnsiStrTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclAnsiStrTree.Add(const AString: AnsiString): Boolean; +var + NewNode: TJclAnsiStrTreeNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := AllowDefaultElements or not ItemsEqual(AString, ''); + + if Result then + begin + if FRoot <> nil then + begin + Result := (not Contains(AString)) or CheckDuplicate; + if Result then + begin + if FRoot.ChildrenCount = Length(FRoot.Children) then + SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); + if FRoot.ChildrenCount < Length(FRoot.Children) then + begin + NewNode := TJclAnsiStrTreeNode.Create; + NewNode.Value := AString; + NewNode.Parent := FRoot; + FRoot.Children[FRoot.ChildrenCount] := NewNode; + Inc(FRoot.ChildrenCount); + Inc(FSize); + end + else + Result := False; + end; + end + else + begin + FRoot := TJclAnsiStrTreeNode.Create; + FRoot.Value := AString; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrTree.AddAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclAnsiStrTree; + ACollection: IJclAnsiStrCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclAnsiStrTree then + begin + ADest := TJclAnsiStrTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclAnsiStrCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclAnsiStrTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclAnsiStrTree then + TJclAnsiStrTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclAnsiStrTree.Clear; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + RemoveNode(FRoot); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrTree.CloneNode(Node, Parent: TJclAnsiStrTreeNode): TJclAnsiStrTreeNode; +var + Index: Integer; +begin + Result := TJclAnsiStrTreeNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + SetLength(Result.Children, Node.ChildrenCount); + Result.ChildrenCount := Node.ChildrenCount; + for Index := 0 to Node.ChildrenCount - 1 do + Result.Children[Index] := CloneNode(TJclAnsiStrTreeNode(Node.Children[Index]), Result); // recursive call +end; + +function TJclAnsiStrTree.CollectionEquals(const ACollection: IJclAnsiStrCollection): Boolean; +var + It, ItSelf: IJclAnsiStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrTree.Contains(const AString: AnsiString): Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + Result := NodeContains(FRoot, AString) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrTree.ContainsAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrTree.Extract(const AString: AnsiString): Boolean; +var + It: IJclAnsiStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FRoot <> nil; + if Result then + begin + It := First; + while It.HasNext do + if ItemsEqual(It.Next, AString) then + begin + It.Extract; + if RemoveSingleElement then + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrTree.ExtractAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrTree.ExtractNode(var ANode: TJclAnsiStrTreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TJclAnsiStrTreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + ExtractNode(TJclAnsiStrTreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + ExtractNode(ANode.Children[Index]); + {$ENDIF ~BCB} + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclAnsiStrTree.First: IJclAnsiStrIterator; +var + Start: TJclAnsiStrTreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderAnsiStrTreeIterator.Create(Self, Start, False, isFirst); + toPostOrder: + begin + if Start <> nil then + while (Start.ChildrenCount > 0) do + Start := TJclAnsiStrTreeNode(Start.Children[0]); + Result := TJclPostOrderAnsiStrTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclAnsiStrTree.GetEnumerator: IJclAnsiStrIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclAnsiStrTree.GetRoot: IJclAnsiStrTreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderAnsiStrTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TJclPostOrderAnsiStrTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclAnsiStrTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclAnsiStrTree.Last: IJclAnsiStrIterator; +var + Start: TJclAnsiStrTreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while Start.ChildrenCount > 0 do + Start := TJclAnsiStrTreeNode(Start.Children[Start.ChildrenCount - 1]); + Result := TJclPreOrderAnsiStrTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TJclPostOrderAnsiStrTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrTree.NodeContains(ANode: TJclAnsiStrTreeNode; const AString: AnsiString): Boolean; +var + Index: Integer; +begin + Result := ItemsEqual(ANode.Value, AString); + if not Result then + for Index := 0 to ANode.ChildrenCount - 1 do + begin + Result := NodeContains(TJclAnsiStrTreeNode(ANode.Children[Index]), AString); + if Result then + Break; + end; +end; + +procedure TJclAnsiStrTree.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + PackNode(FRoot); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrTree.PackNode(ANode: TJclAnsiStrTreeNode); +var + Index: Integer; +begin + SetLength(ANode.Children, ANode.ChildrenCount); + for Index := 0 to ANode.ChildrenCount - 1 do + PackNode(TJclAnsiStrTreeNode(ANode.Children[Index])); +end; + +function TJclAnsiStrTree.Remove(const AString: AnsiString): Boolean; +var + Extracted: AnsiString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AString); + if Result then + begin + Extracted := AString; + FreeString(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrTree.RemoveAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrTree.RemoveNode(var ANode: TJclAnsiStrTreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TJclAnsiStrTreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + RemoveNode(TJclAnsiStrTreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + RemoveNode(ANode.Children[Index]); + {$ENDIF ~BCB} + FreeString(ANode.Value); + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclAnsiStrTree.RetainAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclAnsiStrTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclAnsiStrTree.Size: Integer; +begin + Result := FSize; +end; + +function TJclAnsiStrTree.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclAnsiStrTree.Create; + AssignPropertiesTo(Result); +end; + +//=== { TJclAnsiStrTreeIterator } =========================================================== + +constructor TJclAnsiStrTreeIterator.Create(OwnTree: TJclAnsiStrTree; ACursor: TJclAnsiStrTreeNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnTree := OwnTree; + FStart := AStart; + FEqualityComparer := OwnTree as IJclAnsiStrEqualityComparer; +end; + +function TJclAnsiStrTreeIterator.Add(const AString: AnsiString): Boolean; +var + ParentNode, NewNode: TJclAnsiStrTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // add sibling or, if FCursor is root node, behave like TJclAnsiStrTree.Add + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, '')) + and ((not FOwnTree.Contains(AString)) or FOwnTree.CheckDuplicate); + + if Result then + begin + ParentNode := FCursor.Parent; + if ParentNode = nil then + ParentNode := FCursor; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclAnsiStrTreeNode.Create; + NewNode.Value := AString; + NewNode.Parent := ParentNode; + ParentNode.Children[ParentNode.ChildrenCount] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrTreeIterator.AddChild(const AString: AnsiString): Boolean; +var + NewNode: TJclAnsiStrTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, '')) + and ((not FOwnTree.Contains(AString)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclAnsiStrTreeNode.Create; + NewNode.Value := AString; + NewNode.Parent := FCursor; + FCursor.Children[FCursor.ChildrenCount] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclAnsiStrTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclAnsiStrTreeIterator then + begin + ADest := TJclAnsiStrTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclAnsiStrTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.ChildrenCount + else + Result := 0; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrTreeIterator.DeleteChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclAnsiStrTreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrTreeIterator.DeleteChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclAnsiStrTreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrTreeIterator.Extract; +var + OldCursor: TJclAnsiStrTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.ExtractNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrTreeIterator.ExtractChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclAnsiStrTreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrTreeIterator.ExtractChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclAnsiStrTreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrTreeIterator.GetChild(Index: Integer): AnsiString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := ''; + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + FCursor := TJclAnsiStrTreeNode(FCursor.Children[Index]); + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrTreeIterator.GetString: AnsiString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := ''; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrTreeIterator.IndexOfChild(const AString: AnsiString): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.IndexOfValue(AString, FEqualityComparer) + else + Result := -1; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrTreeIterator.Insert(const AString: AnsiString): Boolean; +var + ParentNode, NewNode: TJclAnsiStrTreeNode; + Index, I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclAnsiStrTree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, '')) + and ((not FOwnTree.Contains(AString)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.Parent <> nil then + begin + ParentNode := FCursor.Parent; + Index := 0; + while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do + Inc(Index); + end + else + begin + ParentNode := FCursor; + Index := 0; + end; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclAnsiStrTreeNode.Create; + NewNode.Value := AString; + NewNode.Parent := ParentNode; + for I := ParentNode.ChildrenCount - 1 downto Index do + ParentNode.Children[I + 1] := ParentNode.Children[I]; + ParentNode.Children[Index] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrTreeIterator.InsertChild(Index: Integer; const AString: AnsiString): Boolean; +var + NewNode: TJclAnsiStrTreeNode; + I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclAnsiStrTree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, '')) + and ((not FOwnTree.Contains(AString)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclAnsiStrTreeNode.Create; + NewNode.Value := AString; + NewNode.Parent := FCursor; + for I := FCursor.ChildrenCount - 1 downto Index do + FCursor.Children[I + 1] := FCursor.Children[I]; + FCursor.Children[Index] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrTreeIterator.IteratorEquals(const AIterator: IJclAnsiStrIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclAnsiStrTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclAnsiStrTreeIterator then + begin + ItrObj := TJclAnsiStrTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclAnsiStrTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclAnsiStrTreeIterator.Next: AnsiString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := ''; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclAnsiStrTreeIterator.Parent: AnsiString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := ''; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrTreeIterator.Previous: AnsiString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := ''; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclAnsiStrTreeIterator.Remove; +var + OldCursor: TJclAnsiStrTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.RemoveNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrTreeIterator.Reset; +var + NewCursor: TJclAnsiStrTreeNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrTreeIterator.SetChild(Index: Integer; const AString: AnsiString); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + TJclAnsiStrTreeNode(FCursor.Children[Index]).Value := AString + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrTreeIterator.SetString(const AString: AnsiString); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + if FCursor <> nil then + begin + FOwnTree.FreeString(FCursor.Value); + FCursor.Value := AString; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclPreOrderAnsiStrTreeIterator } =================================================== + +function TJclPreOrderAnsiStrTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderAnsiStrTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderAnsiStrTreeIterator.GetNextCursor: TJclAnsiStrTreeNode; +var + LastRet: TJclAnsiStrTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.ChildrenCount > 0 then + Result := TJclAnsiStrTreeNode(Result.Children[0]) + else + begin + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclAnsiStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + end; +end; + +function TJclPreOrderAnsiStrTreeIterator.GetNextSibling: TJclAnsiStrTreeNode; +var + LastRet: TJclAnsiStrTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclAnsiStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); +end; + +function TJclPreOrderAnsiStrTreeIterator.GetPreviousCursor: TJclAnsiStrTreeNode; +var + LastRet: TJclAnsiStrTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then + // come from Right + begin + Result := TJclAnsiStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + while (Result.ChildrenCount > 0) do // descend down the tree + Result := TJclAnsiStrTreeNode(Result.Children[Result.ChildrenCount - 1]); + end; +end; + +//=== { TJclPostOrderAnsiStrTreeIterator } ================================================== + +function TJclPostOrderAnsiStrTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderAnsiStrTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderAnsiStrTreeIterator.GetNextCursor: TJclAnsiStrTreeNode; +var + LastRet: TJclAnsiStrTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclAnsiStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclAnsiStrTreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderAnsiStrTreeIterator.GetNextSibling: TJclAnsiStrTreeNode; +var + LastRet: TJclAnsiStrTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclAnsiStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclAnsiStrTreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderAnsiStrTreeIterator.GetPreviousCursor: TJclAnsiStrTreeNode; +var + LastRet: TJclAnsiStrTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.ChildrenCount > 0 then + Result := TJclAnsiStrTreeNode(Result.Children[Result.ChildrenCount - 1]) + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := TJclAnsiStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + end; +end; + +//=== { TJclWideStrTreeNode } ======================================================= + +function TJclWideStrTreeNode.IndexOfChild(AChild: TJclWideStrTreeNode): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if Children[Result] = AChild then + Exit; + Result := -1; +end; + +function TJclWideStrTreeNode.IndexOfValue(const AString: WideString; + const AEqualityComparer: IJclWideStrEqualityComparer): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if AEqualityComparer.ItemsEqual(TJclWideStrTreeNode(Children[Result]).Value, AString) then + Exit; + Result := -1; +end; + +//=== { TJclWideStrTree } ======================================================= + +constructor TJclWideStrTree.Create(); +begin + inherited Create(); + FTraverseOrder := toPreOrder; +end; + +destructor TJclWideStrTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclWideStrTree.Add(const AString: WideString): Boolean; +var + NewNode: TJclWideStrTreeNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := AllowDefaultElements or not ItemsEqual(AString, ''); + + if Result then + begin + if FRoot <> nil then + begin + Result := (not Contains(AString)) or CheckDuplicate; + if Result then + begin + if FRoot.ChildrenCount = Length(FRoot.Children) then + SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); + if FRoot.ChildrenCount < Length(FRoot.Children) then + begin + NewNode := TJclWideStrTreeNode.Create; + NewNode.Value := AString; + NewNode.Parent := FRoot; + FRoot.Children[FRoot.ChildrenCount] := NewNode; + Inc(FRoot.ChildrenCount); + Inc(FSize); + end + else + Result := False; + end; + end + else + begin + FRoot := TJclWideStrTreeNode.Create; + FRoot.Value := AString; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrTree.AddAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclWideStrTree; + ACollection: IJclWideStrCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclWideStrTree then + begin + ADest := TJclWideStrTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclWideStrCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclWideStrTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclWideStrTree then + TJclWideStrTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclWideStrTree.Clear; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + RemoveNode(FRoot); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrTree.CloneNode(Node, Parent: TJclWideStrTreeNode): TJclWideStrTreeNode; +var + Index: Integer; +begin + Result := TJclWideStrTreeNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + SetLength(Result.Children, Node.ChildrenCount); + Result.ChildrenCount := Node.ChildrenCount; + for Index := 0 to Node.ChildrenCount - 1 do + Result.Children[Index] := CloneNode(TJclWideStrTreeNode(Node.Children[Index]), Result); // recursive call +end; + +function TJclWideStrTree.CollectionEquals(const ACollection: IJclWideStrCollection): Boolean; +var + It, ItSelf: IJclWideStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrTree.Contains(const AString: WideString): Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + Result := NodeContains(FRoot, AString) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrTree.ContainsAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrTree.Extract(const AString: WideString): Boolean; +var + It: IJclWideStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FRoot <> nil; + if Result then + begin + It := First; + while It.HasNext do + if ItemsEqual(It.Next, AString) then + begin + It.Extract; + if RemoveSingleElement then + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrTree.ExtractAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrTree.ExtractNode(var ANode: TJclWideStrTreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TJclWideStrTreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + ExtractNode(TJclWideStrTreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + ExtractNode(ANode.Children[Index]); + {$ENDIF ~BCB} + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclWideStrTree.First: IJclWideStrIterator; +var + Start: TJclWideStrTreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderWideStrTreeIterator.Create(Self, Start, False, isFirst); + toPostOrder: + begin + if Start <> nil then + while (Start.ChildrenCount > 0) do + Start := TJclWideStrTreeNode(Start.Children[0]); + Result := TJclPostOrderWideStrTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclWideStrTree.GetEnumerator: IJclWideStrIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclWideStrTree.GetRoot: IJclWideStrTreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderWideStrTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TJclPostOrderWideStrTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclWideStrTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclWideStrTree.Last: IJclWideStrIterator; +var + Start: TJclWideStrTreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while Start.ChildrenCount > 0 do + Start := TJclWideStrTreeNode(Start.Children[Start.ChildrenCount - 1]); + Result := TJclPreOrderWideStrTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TJclPostOrderWideStrTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrTree.NodeContains(ANode: TJclWideStrTreeNode; const AString: WideString): Boolean; +var + Index: Integer; +begin + Result := ItemsEqual(ANode.Value, AString); + if not Result then + for Index := 0 to ANode.ChildrenCount - 1 do + begin + Result := NodeContains(TJclWideStrTreeNode(ANode.Children[Index]), AString); + if Result then + Break; + end; +end; + +procedure TJclWideStrTree.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + PackNode(FRoot); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrTree.PackNode(ANode: TJclWideStrTreeNode); +var + Index: Integer; +begin + SetLength(ANode.Children, ANode.ChildrenCount); + for Index := 0 to ANode.ChildrenCount - 1 do + PackNode(TJclWideStrTreeNode(ANode.Children[Index])); +end; + +function TJclWideStrTree.Remove(const AString: WideString): Boolean; +var + Extracted: WideString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AString); + if Result then + begin + Extracted := AString; + FreeString(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrTree.RemoveAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrTree.RemoveNode(var ANode: TJclWideStrTreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TJclWideStrTreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + RemoveNode(TJclWideStrTreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + RemoveNode(ANode.Children[Index]); + {$ENDIF ~BCB} + FreeString(ANode.Value); + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclWideStrTree.RetainAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclWideStrTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclWideStrTree.Size: Integer; +begin + Result := FSize; +end; + +function TJclWideStrTree.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclWideStrTree.Create; + AssignPropertiesTo(Result); +end; + +//=== { TJclWideStrTreeIterator } =========================================================== + +constructor TJclWideStrTreeIterator.Create(OwnTree: TJclWideStrTree; ACursor: TJclWideStrTreeNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnTree := OwnTree; + FStart := AStart; + FEqualityComparer := OwnTree as IJclWideStrEqualityComparer; +end; + +function TJclWideStrTreeIterator.Add(const AString: WideString): Boolean; +var + ParentNode, NewNode: TJclWideStrTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // add sibling or, if FCursor is root node, behave like TJclWideStrTree.Add + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, '')) + and ((not FOwnTree.Contains(AString)) or FOwnTree.CheckDuplicate); + + if Result then + begin + ParentNode := FCursor.Parent; + if ParentNode = nil then + ParentNode := FCursor; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclWideStrTreeNode.Create; + NewNode.Value := AString; + NewNode.Parent := ParentNode; + ParentNode.Children[ParentNode.ChildrenCount] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrTreeIterator.AddChild(const AString: WideString): Boolean; +var + NewNode: TJclWideStrTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, '')) + and ((not FOwnTree.Contains(AString)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclWideStrTreeNode.Create; + NewNode.Value := AString; + NewNode.Parent := FCursor; + FCursor.Children[FCursor.ChildrenCount] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclWideStrTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclWideStrTreeIterator then + begin + ADest := TJclWideStrTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclWideStrTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.ChildrenCount + else + Result := 0; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrTreeIterator.DeleteChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclWideStrTreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrTreeIterator.DeleteChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclWideStrTreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrTreeIterator.Extract; +var + OldCursor: TJclWideStrTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.ExtractNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrTreeIterator.ExtractChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclWideStrTreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrTreeIterator.ExtractChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclWideStrTreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrTreeIterator.GetChild(Index: Integer): WideString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := ''; + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + FCursor := TJclWideStrTreeNode(FCursor.Children[Index]); + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrTreeIterator.GetString: WideString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := ''; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrTreeIterator.IndexOfChild(const AString: WideString): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.IndexOfValue(AString, FEqualityComparer) + else + Result := -1; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrTreeIterator.Insert(const AString: WideString): Boolean; +var + ParentNode, NewNode: TJclWideStrTreeNode; + Index, I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclWideStrTree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, '')) + and ((not FOwnTree.Contains(AString)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.Parent <> nil then + begin + ParentNode := FCursor.Parent; + Index := 0; + while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do + Inc(Index); + end + else + begin + ParentNode := FCursor; + Index := 0; + end; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclWideStrTreeNode.Create; + NewNode.Value := AString; + NewNode.Parent := ParentNode; + for I := ParentNode.ChildrenCount - 1 downto Index do + ParentNode.Children[I + 1] := ParentNode.Children[I]; + ParentNode.Children[Index] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrTreeIterator.InsertChild(Index: Integer; const AString: WideString): Boolean; +var + NewNode: TJclWideStrTreeNode; + I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclWideStrTree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, '')) + and ((not FOwnTree.Contains(AString)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclWideStrTreeNode.Create; + NewNode.Value := AString; + NewNode.Parent := FCursor; + for I := FCursor.ChildrenCount - 1 downto Index do + FCursor.Children[I + 1] := FCursor.Children[I]; + FCursor.Children[Index] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrTreeIterator.IteratorEquals(const AIterator: IJclWideStrIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclWideStrTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclWideStrTreeIterator then + begin + ItrObj := TJclWideStrTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclWideStrTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclWideStrTreeIterator.Next: WideString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := ''; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclWideStrTreeIterator.Parent: WideString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := ''; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrTreeIterator.Previous: WideString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := ''; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclWideStrTreeIterator.Remove; +var + OldCursor: TJclWideStrTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.RemoveNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrTreeIterator.Reset; +var + NewCursor: TJclWideStrTreeNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrTreeIterator.SetChild(Index: Integer; const AString: WideString); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + TJclWideStrTreeNode(FCursor.Children[Index]).Value := AString + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrTreeIterator.SetString(const AString: WideString); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + if FCursor <> nil then + begin + FOwnTree.FreeString(FCursor.Value); + FCursor.Value := AString; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclPreOrderWideStrTreeIterator } =================================================== + +function TJclPreOrderWideStrTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderWideStrTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderWideStrTreeIterator.GetNextCursor: TJclWideStrTreeNode; +var + LastRet: TJclWideStrTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.ChildrenCount > 0 then + Result := TJclWideStrTreeNode(Result.Children[0]) + else + begin + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclWideStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + end; +end; + +function TJclPreOrderWideStrTreeIterator.GetNextSibling: TJclWideStrTreeNode; +var + LastRet: TJclWideStrTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclWideStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); +end; + +function TJclPreOrderWideStrTreeIterator.GetPreviousCursor: TJclWideStrTreeNode; +var + LastRet: TJclWideStrTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then + // come from Right + begin + Result := TJclWideStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + while (Result.ChildrenCount > 0) do // descend down the tree + Result := TJclWideStrTreeNode(Result.Children[Result.ChildrenCount - 1]); + end; +end; + +//=== { TJclPostOrderWideStrTreeIterator } ================================================== + +function TJclPostOrderWideStrTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderWideStrTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderWideStrTreeIterator.GetNextCursor: TJclWideStrTreeNode; +var + LastRet: TJclWideStrTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclWideStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclWideStrTreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderWideStrTreeIterator.GetNextSibling: TJclWideStrTreeNode; +var + LastRet: TJclWideStrTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclWideStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclWideStrTreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderWideStrTreeIterator.GetPreviousCursor: TJclWideStrTreeNode; +var + LastRet: TJclWideStrTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.ChildrenCount > 0 then + Result := TJclWideStrTreeNode(Result.Children[Result.ChildrenCount - 1]) + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := TJclWideStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + end; +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrTreeNode } ======================================================= + +function TJclUnicodeStrTreeNode.IndexOfChild(AChild: TJclUnicodeStrTreeNode): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if Children[Result] = AChild then + Exit; + Result := -1; +end; + +function TJclUnicodeStrTreeNode.IndexOfValue(const AString: UnicodeString; + const AEqualityComparer: IJclUnicodeStrEqualityComparer): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if AEqualityComparer.ItemsEqual(TJclUnicodeStrTreeNode(Children[Result]).Value, AString) then + Exit; + Result := -1; +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrTree } ======================================================= + +constructor TJclUnicodeStrTree.Create(); +begin + inherited Create(); + FTraverseOrder := toPreOrder; +end; + +destructor TJclUnicodeStrTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclUnicodeStrTree.Add(const AString: UnicodeString): Boolean; +var + NewNode: TJclUnicodeStrTreeNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := AllowDefaultElements or not ItemsEqual(AString, ''); + + if Result then + begin + if FRoot <> nil then + begin + Result := (not Contains(AString)) or CheckDuplicate; + if Result then + begin + if FRoot.ChildrenCount = Length(FRoot.Children) then + SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); + if FRoot.ChildrenCount < Length(FRoot.Children) then + begin + NewNode := TJclUnicodeStrTreeNode.Create; + NewNode.Value := AString; + NewNode.Parent := FRoot; + FRoot.Children[FRoot.ChildrenCount] := NewNode; + Inc(FRoot.ChildrenCount); + Inc(FSize); + end + else + Result := False; + end; + end + else + begin + FRoot := TJclUnicodeStrTreeNode.Create; + FRoot.Value := AString; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrTree.AddAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclUnicodeStrTree; + ACollection: IJclUnicodeStrCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclUnicodeStrTree then + begin + ADest := TJclUnicodeStrTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclUnicodeStrCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclUnicodeStrTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclUnicodeStrTree then + TJclUnicodeStrTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclUnicodeStrTree.Clear; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + RemoveNode(FRoot); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrTree.CloneNode(Node, Parent: TJclUnicodeStrTreeNode): TJclUnicodeStrTreeNode; +var + Index: Integer; +begin + Result := TJclUnicodeStrTreeNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + SetLength(Result.Children, Node.ChildrenCount); + Result.ChildrenCount := Node.ChildrenCount; + for Index := 0 to Node.ChildrenCount - 1 do + Result.Children[Index] := CloneNode(TJclUnicodeStrTreeNode(Node.Children[Index]), Result); // recursive call +end; + +function TJclUnicodeStrTree.CollectionEquals(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It, ItSelf: IJclUnicodeStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrTree.Contains(const AString: UnicodeString): Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + Result := NodeContains(FRoot, AString) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrTree.ContainsAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrTree.Extract(const AString: UnicodeString): Boolean; +var + It: IJclUnicodeStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FRoot <> nil; + if Result then + begin + It := First; + while It.HasNext do + if ItemsEqual(It.Next, AString) then + begin + It.Extract; + if RemoveSingleElement then + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrTree.ExtractAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrTree.ExtractNode(var ANode: TJclUnicodeStrTreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TJclUnicodeStrTreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + ExtractNode(TJclUnicodeStrTreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + ExtractNode(ANode.Children[Index]); + {$ENDIF ~BCB} + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclUnicodeStrTree.First: IJclUnicodeStrIterator; +var + Start: TJclUnicodeStrTreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderUnicodeStrTreeIterator.Create(Self, Start, False, isFirst); + toPostOrder: + begin + if Start <> nil then + while (Start.ChildrenCount > 0) do + Start := TJclUnicodeStrTreeNode(Start.Children[0]); + Result := TJclPostOrderUnicodeStrTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclUnicodeStrTree.GetEnumerator: IJclUnicodeStrIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclUnicodeStrTree.GetRoot: IJclUnicodeStrTreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderUnicodeStrTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TJclPostOrderUnicodeStrTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclUnicodeStrTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclUnicodeStrTree.Last: IJclUnicodeStrIterator; +var + Start: TJclUnicodeStrTreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while Start.ChildrenCount > 0 do + Start := TJclUnicodeStrTreeNode(Start.Children[Start.ChildrenCount - 1]); + Result := TJclPreOrderUnicodeStrTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TJclPostOrderUnicodeStrTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrTree.NodeContains(ANode: TJclUnicodeStrTreeNode; const AString: UnicodeString): Boolean; +var + Index: Integer; +begin + Result := ItemsEqual(ANode.Value, AString); + if not Result then + for Index := 0 to ANode.ChildrenCount - 1 do + begin + Result := NodeContains(TJclUnicodeStrTreeNode(ANode.Children[Index]), AString); + if Result then + Break; + end; +end; + +procedure TJclUnicodeStrTree.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + PackNode(FRoot); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrTree.PackNode(ANode: TJclUnicodeStrTreeNode); +var + Index: Integer; +begin + SetLength(ANode.Children, ANode.ChildrenCount); + for Index := 0 to ANode.ChildrenCount - 1 do + PackNode(TJclUnicodeStrTreeNode(ANode.Children[Index])); +end; + +function TJclUnicodeStrTree.Remove(const AString: UnicodeString): Boolean; +var + Extracted: UnicodeString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AString); + if Result then + begin + Extracted := AString; + FreeString(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrTree.RemoveAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrTree.RemoveNode(var ANode: TJclUnicodeStrTreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TJclUnicodeStrTreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + RemoveNode(TJclUnicodeStrTreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + RemoveNode(ANode.Children[Index]); + {$ENDIF ~BCB} + FreeString(ANode.Value); + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclUnicodeStrTree.RetainAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclUnicodeStrTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclUnicodeStrTree.Size: Integer; +begin + Result := FSize; +end; + +function TJclUnicodeStrTree.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclUnicodeStrTree.Create; + AssignPropertiesTo(Result); +end; + +{$ENDIF SUPPORTS_UNICODE_STRING} + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrTreeIterator } =========================================================== + +constructor TJclUnicodeStrTreeIterator.Create(OwnTree: TJclUnicodeStrTree; ACursor: TJclUnicodeStrTreeNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnTree := OwnTree; + FStart := AStart; + FEqualityComparer := OwnTree as IJclUnicodeStrEqualityComparer; +end; + +function TJclUnicodeStrTreeIterator.Add(const AString: UnicodeString): Boolean; +var + ParentNode, NewNode: TJclUnicodeStrTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // add sibling or, if FCursor is root node, behave like TJclUnicodeStrTree.Add + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, '')) + and ((not FOwnTree.Contains(AString)) or FOwnTree.CheckDuplicate); + + if Result then + begin + ParentNode := FCursor.Parent; + if ParentNode = nil then + ParentNode := FCursor; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclUnicodeStrTreeNode.Create; + NewNode.Value := AString; + NewNode.Parent := ParentNode; + ParentNode.Children[ParentNode.ChildrenCount] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrTreeIterator.AddChild(const AString: UnicodeString): Boolean; +var + NewNode: TJclUnicodeStrTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, '')) + and ((not FOwnTree.Contains(AString)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclUnicodeStrTreeNode.Create; + NewNode.Value := AString; + NewNode.Parent := FCursor; + FCursor.Children[FCursor.ChildrenCount] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclUnicodeStrTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclUnicodeStrTreeIterator then + begin + ADest := TJclUnicodeStrTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclUnicodeStrTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.ChildrenCount + else + Result := 0; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrTreeIterator.DeleteChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclUnicodeStrTreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrTreeIterator.DeleteChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclUnicodeStrTreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrTreeIterator.Extract; +var + OldCursor: TJclUnicodeStrTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.ExtractNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrTreeIterator.ExtractChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclUnicodeStrTreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrTreeIterator.ExtractChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclUnicodeStrTreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrTreeIterator.GetChild(Index: Integer): UnicodeString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := ''; + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + FCursor := TJclUnicodeStrTreeNode(FCursor.Children[Index]); + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrTreeIterator.GetString: UnicodeString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := ''; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrTreeIterator.IndexOfChild(const AString: UnicodeString): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.IndexOfValue(AString, FEqualityComparer) + else + Result := -1; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrTreeIterator.Insert(const AString: UnicodeString): Boolean; +var + ParentNode, NewNode: TJclUnicodeStrTreeNode; + Index, I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclUnicodeStrTree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, '')) + and ((not FOwnTree.Contains(AString)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.Parent <> nil then + begin + ParentNode := FCursor.Parent; + Index := 0; + while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do + Inc(Index); + end + else + begin + ParentNode := FCursor; + Index := 0; + end; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclUnicodeStrTreeNode.Create; + NewNode.Value := AString; + NewNode.Parent := ParentNode; + for I := ParentNode.ChildrenCount - 1 downto Index do + ParentNode.Children[I + 1] := ParentNode.Children[I]; + ParentNode.Children[Index] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrTreeIterator.InsertChild(Index: Integer; const AString: UnicodeString): Boolean; +var + NewNode: TJclUnicodeStrTreeNode; + I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclUnicodeStrTree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AString, '')) + and ((not FOwnTree.Contains(AString)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclUnicodeStrTreeNode.Create; + NewNode.Value := AString; + NewNode.Parent := FCursor; + for I := FCursor.ChildrenCount - 1 downto Index do + FCursor.Children[I + 1] := FCursor.Children[I]; + FCursor.Children[Index] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrTreeIterator.IteratorEquals(const AIterator: IJclUnicodeStrIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclUnicodeStrTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclUnicodeStrTreeIterator then + begin + ItrObj := TJclUnicodeStrTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclUnicodeStrTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclUnicodeStrTreeIterator.Next: UnicodeString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := ''; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclUnicodeStrTreeIterator.Parent: UnicodeString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := ''; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrTreeIterator.Previous: UnicodeString; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := ''; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclUnicodeStrTreeIterator.Remove; +var + OldCursor: TJclUnicodeStrTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.RemoveNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrTreeIterator.Reset; +var + NewCursor: TJclUnicodeStrTreeNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrTreeIterator.SetChild(Index: Integer; const AString: UnicodeString); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + TJclUnicodeStrTreeNode(FCursor.Children[Index]).Value := AString + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrTreeIterator.SetString(const AString: UnicodeString); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + if FCursor <> nil then + begin + FOwnTree.FreeString(FCursor.Value); + FCursor.Value := AString; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclPreOrderUnicodeStrTreeIterator } =================================================== + +function TJclPreOrderUnicodeStrTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderUnicodeStrTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderUnicodeStrTreeIterator.GetNextCursor: TJclUnicodeStrTreeNode; +var + LastRet: TJclUnicodeStrTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.ChildrenCount > 0 then + Result := TJclUnicodeStrTreeNode(Result.Children[0]) + else + begin + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclUnicodeStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + end; +end; + +function TJclPreOrderUnicodeStrTreeIterator.GetNextSibling: TJclUnicodeStrTreeNode; +var + LastRet: TJclUnicodeStrTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclUnicodeStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); +end; + +function TJclPreOrderUnicodeStrTreeIterator.GetPreviousCursor: TJclUnicodeStrTreeNode; +var + LastRet: TJclUnicodeStrTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then + // come from Right + begin + Result := TJclUnicodeStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + while (Result.ChildrenCount > 0) do // descend down the tree + Result := TJclUnicodeStrTreeNode(Result.Children[Result.ChildrenCount - 1]); + end; +end; + +//=== { TJclPostOrderUnicodeStrTreeIterator } ================================================== + +function TJclPostOrderUnicodeStrTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderUnicodeStrTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderUnicodeStrTreeIterator.GetNextCursor: TJclUnicodeStrTreeNode; +var + LastRet: TJclUnicodeStrTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclUnicodeStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclUnicodeStrTreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderUnicodeStrTreeIterator.GetNextSibling: TJclUnicodeStrTreeNode; +var + LastRet: TJclUnicodeStrTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclUnicodeStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclUnicodeStrTreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderUnicodeStrTreeIterator.GetPreviousCursor: TJclUnicodeStrTreeNode; +var + LastRet: TJclUnicodeStrTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.ChildrenCount > 0 then + Result := TJclUnicodeStrTreeNode(Result.Children[Result.ChildrenCount - 1]) + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := TJclUnicodeStrTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + end; +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +//=== { TJclSingleTreeNode } ======================================================= + +function TJclSingleTreeNode.IndexOfChild(AChild: TJclSingleTreeNode): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if Children[Result] = AChild then + Exit; + Result := -1; +end; + +function TJclSingleTreeNode.IndexOfValue(const AValue: Single; + const AEqualityComparer: IJclSingleEqualityComparer): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if AEqualityComparer.ItemsEqual(TJclSingleTreeNode(Children[Result]).Value, AValue) then + Exit; + Result := -1; +end; + +//=== { TJclSingleTree } ======================================================= + +constructor TJclSingleTree.Create(); +begin + inherited Create(); + FTraverseOrder := toPreOrder; +end; + +destructor TJclSingleTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclSingleTree.Add(const AValue: Single): Boolean; +var + NewNode: TJclSingleTreeNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := AllowDefaultElements or not ItemsEqual(AValue, 0.0); + + if Result then + begin + if FRoot <> nil then + begin + Result := (not Contains(AValue)) or CheckDuplicate; + if Result then + begin + if FRoot.ChildrenCount = Length(FRoot.Children) then + SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); + if FRoot.ChildrenCount < Length(FRoot.Children) then + begin + NewNode := TJclSingleTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := FRoot; + FRoot.Children[FRoot.ChildrenCount] := NewNode; + Inc(FRoot.ChildrenCount); + Inc(FSize); + end + else + Result := False; + end; + end + else + begin + FRoot := TJclSingleTreeNode.Create; + FRoot.Value := AValue; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleTree.AddAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclSingleTree; + ACollection: IJclSingleCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclSingleTree then + begin + ADest := TJclSingleTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclSingleCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclSingleTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclSingleTree then + TJclSingleTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclSingleTree.Clear; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + RemoveNode(FRoot); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleTree.CloneNode(Node, Parent: TJclSingleTreeNode): TJclSingleTreeNode; +var + Index: Integer; +begin + Result := TJclSingleTreeNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + SetLength(Result.Children, Node.ChildrenCount); + Result.ChildrenCount := Node.ChildrenCount; + for Index := 0 to Node.ChildrenCount - 1 do + Result.Children[Index] := CloneNode(TJclSingleTreeNode(Node.Children[Index]), Result); // recursive call +end; + +function TJclSingleTree.CollectionEquals(const ACollection: IJclSingleCollection): Boolean; +var + It, ItSelf: IJclSingleIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleTree.Contains(const AValue: Single): Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + Result := NodeContains(FRoot, AValue) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleTree.ContainsAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleTree.Extract(const AValue: Single): Boolean; +var + It: IJclSingleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FRoot <> nil; + if Result then + begin + It := First; + while It.HasNext do + if ItemsEqual(It.Next, AValue) then + begin + It.Extract; + if RemoveSingleElement then + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleTree.ExtractAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleTree.ExtractNode(var ANode: TJclSingleTreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TJclSingleTreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + ExtractNode(TJclSingleTreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + ExtractNode(ANode.Children[Index]); + {$ENDIF ~BCB} + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclSingleTree.First: IJclSingleIterator; +var + Start: TJclSingleTreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderSingleTreeIterator.Create(Self, Start, False, isFirst); + toPostOrder: + begin + if Start <> nil then + while (Start.ChildrenCount > 0) do + Start := TJclSingleTreeNode(Start.Children[0]); + Result := TJclPostOrderSingleTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclSingleTree.GetEnumerator: IJclSingleIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclSingleTree.GetRoot: IJclSingleTreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderSingleTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TJclPostOrderSingleTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclSingleTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclSingleTree.Last: IJclSingleIterator; +var + Start: TJclSingleTreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while Start.ChildrenCount > 0 do + Start := TJclSingleTreeNode(Start.Children[Start.ChildrenCount - 1]); + Result := TJclPreOrderSingleTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TJclPostOrderSingleTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleTree.NodeContains(ANode: TJclSingleTreeNode; const AValue: Single): Boolean; +var + Index: Integer; +begin + Result := ItemsEqual(ANode.Value, AValue); + if not Result then + for Index := 0 to ANode.ChildrenCount - 1 do + begin + Result := NodeContains(TJclSingleTreeNode(ANode.Children[Index]), AValue); + if Result then + Break; + end; +end; + +procedure TJclSingleTree.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + PackNode(FRoot); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleTree.PackNode(ANode: TJclSingleTreeNode); +var + Index: Integer; +begin + SetLength(ANode.Children, ANode.ChildrenCount); + for Index := 0 to ANode.ChildrenCount - 1 do + PackNode(TJclSingleTreeNode(ANode.Children[Index])); +end; + +function TJclSingleTree.Remove(const AValue: Single): Boolean; +var + Extracted: Single; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeSingle(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleTree.RemoveAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleTree.RemoveNode(var ANode: TJclSingleTreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TJclSingleTreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + RemoveNode(TJclSingleTreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + RemoveNode(ANode.Children[Index]); + {$ENDIF ~BCB} + FreeSingle(ANode.Value); + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclSingleTree.RetainAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclSingleTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclSingleTree.Size: Integer; +begin + Result := FSize; +end; + +function TJclSingleTree.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclSingleTree.Create; + AssignPropertiesTo(Result); +end; + +//=== { TJclSingleTreeIterator } =========================================================== + +constructor TJclSingleTreeIterator.Create(OwnTree: TJclSingleTree; ACursor: TJclSingleTreeNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnTree := OwnTree; + FStart := AStart; + FEqualityComparer := OwnTree as IJclSingleEqualityComparer; +end; + +function TJclSingleTreeIterator.Add(const AValue: Single): Boolean; +var + ParentNode, NewNode: TJclSingleTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // add sibling or, if FCursor is root node, behave like TJclSingleTree.Add + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0)) + and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); + + if Result then + begin + ParentNode := FCursor.Parent; + if ParentNode = nil then + ParentNode := FCursor; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclSingleTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := ParentNode; + ParentNode.Children[ParentNode.ChildrenCount] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleTreeIterator.AddChild(const AValue: Single): Boolean; +var + NewNode: TJclSingleTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0)) + and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclSingleTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := FCursor; + FCursor.Children[FCursor.ChildrenCount] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclSingleTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclSingleTreeIterator then + begin + ADest := TJclSingleTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclSingleTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.ChildrenCount + else + Result := 0; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleTreeIterator.DeleteChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclSingleTreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleTreeIterator.DeleteChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclSingleTreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleTreeIterator.Extract; +var + OldCursor: TJclSingleTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.ExtractNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleTreeIterator.ExtractChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclSingleTreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleTreeIterator.ExtractChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclSingleTreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleTreeIterator.GetChild(Index: Integer): Single; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + FCursor := TJclSingleTreeNode(FCursor.Children[Index]); + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleTreeIterator.GetValue: Single; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := 0.0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleTreeIterator.IndexOfChild(const AValue: Single): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.IndexOfValue(AValue, FEqualityComparer) + else + Result := -1; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleTreeIterator.Insert(const AValue: Single): Boolean; +var + ParentNode, NewNode: TJclSingleTreeNode; + Index, I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclSingleTree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0)) + and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.Parent <> nil then + begin + ParentNode := FCursor.Parent; + Index := 0; + while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do + Inc(Index); + end + else + begin + ParentNode := FCursor; + Index := 0; + end; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclSingleTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := ParentNode; + for I := ParentNode.ChildrenCount - 1 downto Index do + ParentNode.Children[I + 1] := ParentNode.Children[I]; + ParentNode.Children[Index] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleTreeIterator.InsertChild(Index: Integer; const AValue: Single): Boolean; +var + NewNode: TJclSingleTreeNode; + I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclSingleTree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0)) + and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclSingleTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := FCursor; + for I := FCursor.ChildrenCount - 1 downto Index do + FCursor.Children[I + 1] := FCursor.Children[I]; + FCursor.Children[Index] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleTreeIterator.IteratorEquals(const AIterator: IJclSingleIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclSingleTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclSingleTreeIterator then + begin + ItrObj := TJclSingleTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclSingleTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclSingleTreeIterator.Next: Single; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := 0.0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclSingleTreeIterator.Parent: Single; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleTreeIterator.Previous: Single; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := 0.0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclSingleTreeIterator.Remove; +var + OldCursor: TJclSingleTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.RemoveNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleTreeIterator.Reset; +var + NewCursor: TJclSingleTreeNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleTreeIterator.SetChild(Index: Integer; const AValue: Single); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + TJclSingleTreeNode(FCursor.Children[Index]).Value := AValue + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleTreeIterator.SetValue(const AValue: Single); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + if FCursor <> nil then + begin + FOwnTree.FreeSingle(FCursor.Value); + FCursor.Value := AValue; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclPreOrderSingleTreeIterator } =================================================== + +function TJclPreOrderSingleTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderSingleTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderSingleTreeIterator.GetNextCursor: TJclSingleTreeNode; +var + LastRet: TJclSingleTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.ChildrenCount > 0 then + Result := TJclSingleTreeNode(Result.Children[0]) + else + begin + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclSingleTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + end; +end; + +function TJclPreOrderSingleTreeIterator.GetNextSibling: TJclSingleTreeNode; +var + LastRet: TJclSingleTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclSingleTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); +end; + +function TJclPreOrderSingleTreeIterator.GetPreviousCursor: TJclSingleTreeNode; +var + LastRet: TJclSingleTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then + // come from Right + begin + Result := TJclSingleTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + while (Result.ChildrenCount > 0) do // descend down the tree + Result := TJclSingleTreeNode(Result.Children[Result.ChildrenCount - 1]); + end; +end; + +//=== { TJclPostOrderSingleTreeIterator } ================================================== + +function TJclPostOrderSingleTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderSingleTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderSingleTreeIterator.GetNextCursor: TJclSingleTreeNode; +var + LastRet: TJclSingleTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclSingleTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclSingleTreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderSingleTreeIterator.GetNextSibling: TJclSingleTreeNode; +var + LastRet: TJclSingleTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclSingleTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclSingleTreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderSingleTreeIterator.GetPreviousCursor: TJclSingleTreeNode; +var + LastRet: TJclSingleTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.ChildrenCount > 0 then + Result := TJclSingleTreeNode(Result.Children[Result.ChildrenCount - 1]) + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := TJclSingleTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + end; +end; + +//=== { TJclDoubleTreeNode } ======================================================= + +function TJclDoubleTreeNode.IndexOfChild(AChild: TJclDoubleTreeNode): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if Children[Result] = AChild then + Exit; + Result := -1; +end; + +function TJclDoubleTreeNode.IndexOfValue(const AValue: Double; + const AEqualityComparer: IJclDoubleEqualityComparer): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if AEqualityComparer.ItemsEqual(TJclDoubleTreeNode(Children[Result]).Value, AValue) then + Exit; + Result := -1; +end; + +//=== { TJclDoubleTree } ======================================================= + +constructor TJclDoubleTree.Create(); +begin + inherited Create(); + FTraverseOrder := toPreOrder; +end; + +destructor TJclDoubleTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclDoubleTree.Add(const AValue: Double): Boolean; +var + NewNode: TJclDoubleTreeNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := AllowDefaultElements or not ItemsEqual(AValue, 0.0); + + if Result then + begin + if FRoot <> nil then + begin + Result := (not Contains(AValue)) or CheckDuplicate; + if Result then + begin + if FRoot.ChildrenCount = Length(FRoot.Children) then + SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); + if FRoot.ChildrenCount < Length(FRoot.Children) then + begin + NewNode := TJclDoubleTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := FRoot; + FRoot.Children[FRoot.ChildrenCount] := NewNode; + Inc(FRoot.ChildrenCount); + Inc(FSize); + end + else + Result := False; + end; + end + else + begin + FRoot := TJclDoubleTreeNode.Create; + FRoot.Value := AValue; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleTree.AddAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclDoubleTree; + ACollection: IJclDoubleCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclDoubleTree then + begin + ADest := TJclDoubleTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclDoubleCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclDoubleTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclDoubleTree then + TJclDoubleTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclDoubleTree.Clear; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + RemoveNode(FRoot); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleTree.CloneNode(Node, Parent: TJclDoubleTreeNode): TJclDoubleTreeNode; +var + Index: Integer; +begin + Result := TJclDoubleTreeNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + SetLength(Result.Children, Node.ChildrenCount); + Result.ChildrenCount := Node.ChildrenCount; + for Index := 0 to Node.ChildrenCount - 1 do + Result.Children[Index] := CloneNode(TJclDoubleTreeNode(Node.Children[Index]), Result); // recursive call +end; + +function TJclDoubleTree.CollectionEquals(const ACollection: IJclDoubleCollection): Boolean; +var + It, ItSelf: IJclDoubleIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleTree.Contains(const AValue: Double): Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + Result := NodeContains(FRoot, AValue) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleTree.ContainsAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleTree.Extract(const AValue: Double): Boolean; +var + It: IJclDoubleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FRoot <> nil; + if Result then + begin + It := First; + while It.HasNext do + if ItemsEqual(It.Next, AValue) then + begin + It.Extract; + if RemoveSingleElement then + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleTree.ExtractAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleTree.ExtractNode(var ANode: TJclDoubleTreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TJclDoubleTreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + ExtractNode(TJclDoubleTreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + ExtractNode(ANode.Children[Index]); + {$ENDIF ~BCB} + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclDoubleTree.First: IJclDoubleIterator; +var + Start: TJclDoubleTreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderDoubleTreeIterator.Create(Self, Start, False, isFirst); + toPostOrder: + begin + if Start <> nil then + while (Start.ChildrenCount > 0) do + Start := TJclDoubleTreeNode(Start.Children[0]); + Result := TJclPostOrderDoubleTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclDoubleTree.GetEnumerator: IJclDoubleIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclDoubleTree.GetRoot: IJclDoubleTreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderDoubleTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TJclPostOrderDoubleTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclDoubleTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclDoubleTree.Last: IJclDoubleIterator; +var + Start: TJclDoubleTreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while Start.ChildrenCount > 0 do + Start := TJclDoubleTreeNode(Start.Children[Start.ChildrenCount - 1]); + Result := TJclPreOrderDoubleTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TJclPostOrderDoubleTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleTree.NodeContains(ANode: TJclDoubleTreeNode; const AValue: Double): Boolean; +var + Index: Integer; +begin + Result := ItemsEqual(ANode.Value, AValue); + if not Result then + for Index := 0 to ANode.ChildrenCount - 1 do + begin + Result := NodeContains(TJclDoubleTreeNode(ANode.Children[Index]), AValue); + if Result then + Break; + end; +end; + +procedure TJclDoubleTree.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + PackNode(FRoot); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleTree.PackNode(ANode: TJclDoubleTreeNode); +var + Index: Integer; +begin + SetLength(ANode.Children, ANode.ChildrenCount); + for Index := 0 to ANode.ChildrenCount - 1 do + PackNode(TJclDoubleTreeNode(ANode.Children[Index])); +end; + +function TJclDoubleTree.Remove(const AValue: Double): Boolean; +var + Extracted: Double; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeDouble(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleTree.RemoveAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleTree.RemoveNode(var ANode: TJclDoubleTreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TJclDoubleTreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + RemoveNode(TJclDoubleTreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + RemoveNode(ANode.Children[Index]); + {$ENDIF ~BCB} + FreeDouble(ANode.Value); + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclDoubleTree.RetainAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclDoubleTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclDoubleTree.Size: Integer; +begin + Result := FSize; +end; + +function TJclDoubleTree.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclDoubleTree.Create; + AssignPropertiesTo(Result); +end; + +//=== { TJclDoubleTreeIterator } =========================================================== + +constructor TJclDoubleTreeIterator.Create(OwnTree: TJclDoubleTree; ACursor: TJclDoubleTreeNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnTree := OwnTree; + FStart := AStart; + FEqualityComparer := OwnTree as IJclDoubleEqualityComparer; +end; + +function TJclDoubleTreeIterator.Add(const AValue: Double): Boolean; +var + ParentNode, NewNode: TJclDoubleTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // add sibling or, if FCursor is root node, behave like TJclDoubleTree.Add + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0)) + and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); + + if Result then + begin + ParentNode := FCursor.Parent; + if ParentNode = nil then + ParentNode := FCursor; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclDoubleTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := ParentNode; + ParentNode.Children[ParentNode.ChildrenCount] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleTreeIterator.AddChild(const AValue: Double): Boolean; +var + NewNode: TJclDoubleTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0)) + and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclDoubleTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := FCursor; + FCursor.Children[FCursor.ChildrenCount] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclDoubleTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclDoubleTreeIterator then + begin + ADest := TJclDoubleTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclDoubleTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.ChildrenCount + else + Result := 0; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleTreeIterator.DeleteChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclDoubleTreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleTreeIterator.DeleteChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclDoubleTreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleTreeIterator.Extract; +var + OldCursor: TJclDoubleTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.ExtractNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleTreeIterator.ExtractChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclDoubleTreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleTreeIterator.ExtractChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclDoubleTreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleTreeIterator.GetChild(Index: Integer): Double; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + FCursor := TJclDoubleTreeNode(FCursor.Children[Index]); + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleTreeIterator.GetValue: Double; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := 0.0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleTreeIterator.IndexOfChild(const AValue: Double): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.IndexOfValue(AValue, FEqualityComparer) + else + Result := -1; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleTreeIterator.Insert(const AValue: Double): Boolean; +var + ParentNode, NewNode: TJclDoubleTreeNode; + Index, I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclDoubleTree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0)) + and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.Parent <> nil then + begin + ParentNode := FCursor.Parent; + Index := 0; + while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do + Inc(Index); + end + else + begin + ParentNode := FCursor; + Index := 0; + end; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclDoubleTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := ParentNode; + for I := ParentNode.ChildrenCount - 1 downto Index do + ParentNode.Children[I + 1] := ParentNode.Children[I]; + ParentNode.Children[Index] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleTreeIterator.InsertChild(Index: Integer; const AValue: Double): Boolean; +var + NewNode: TJclDoubleTreeNode; + I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclDoubleTree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0)) + and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclDoubleTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := FCursor; + for I := FCursor.ChildrenCount - 1 downto Index do + FCursor.Children[I + 1] := FCursor.Children[I]; + FCursor.Children[Index] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleTreeIterator.IteratorEquals(const AIterator: IJclDoubleIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclDoubleTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclDoubleTreeIterator then + begin + ItrObj := TJclDoubleTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclDoubleTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclDoubleTreeIterator.Next: Double; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := 0.0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclDoubleTreeIterator.Parent: Double; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleTreeIterator.Previous: Double; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := 0.0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclDoubleTreeIterator.Remove; +var + OldCursor: TJclDoubleTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.RemoveNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleTreeIterator.Reset; +var + NewCursor: TJclDoubleTreeNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleTreeIterator.SetChild(Index: Integer; const AValue: Double); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + TJclDoubleTreeNode(FCursor.Children[Index]).Value := AValue + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleTreeIterator.SetValue(const AValue: Double); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + if FCursor <> nil then + begin + FOwnTree.FreeDouble(FCursor.Value); + FCursor.Value := AValue; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclPreOrderDoubleTreeIterator } =================================================== + +function TJclPreOrderDoubleTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderDoubleTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderDoubleTreeIterator.GetNextCursor: TJclDoubleTreeNode; +var + LastRet: TJclDoubleTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.ChildrenCount > 0 then + Result := TJclDoubleTreeNode(Result.Children[0]) + else + begin + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclDoubleTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + end; +end; + +function TJclPreOrderDoubleTreeIterator.GetNextSibling: TJclDoubleTreeNode; +var + LastRet: TJclDoubleTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclDoubleTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); +end; + +function TJclPreOrderDoubleTreeIterator.GetPreviousCursor: TJclDoubleTreeNode; +var + LastRet: TJclDoubleTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then + // come from Right + begin + Result := TJclDoubleTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + while (Result.ChildrenCount > 0) do // descend down the tree + Result := TJclDoubleTreeNode(Result.Children[Result.ChildrenCount - 1]); + end; +end; + +//=== { TJclPostOrderDoubleTreeIterator } ================================================== + +function TJclPostOrderDoubleTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderDoubleTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderDoubleTreeIterator.GetNextCursor: TJclDoubleTreeNode; +var + LastRet: TJclDoubleTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclDoubleTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclDoubleTreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderDoubleTreeIterator.GetNextSibling: TJclDoubleTreeNode; +var + LastRet: TJclDoubleTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclDoubleTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclDoubleTreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderDoubleTreeIterator.GetPreviousCursor: TJclDoubleTreeNode; +var + LastRet: TJclDoubleTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.ChildrenCount > 0 then + Result := TJclDoubleTreeNode(Result.Children[Result.ChildrenCount - 1]) + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := TJclDoubleTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + end; +end; + +//=== { TJclExtendedTreeNode } ======================================================= + +function TJclExtendedTreeNode.IndexOfChild(AChild: TJclExtendedTreeNode): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if Children[Result] = AChild then + Exit; + Result := -1; +end; + +function TJclExtendedTreeNode.IndexOfValue(const AValue: Extended; + const AEqualityComparer: IJclExtendedEqualityComparer): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if AEqualityComparer.ItemsEqual(TJclExtendedTreeNode(Children[Result]).Value, AValue) then + Exit; + Result := -1; +end; + +//=== { TJclExtendedTree } ======================================================= + +constructor TJclExtendedTree.Create(); +begin + inherited Create(); + FTraverseOrder := toPreOrder; +end; + +destructor TJclExtendedTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclExtendedTree.Add(const AValue: Extended): Boolean; +var + NewNode: TJclExtendedTreeNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := AllowDefaultElements or not ItemsEqual(AValue, 0.0); + + if Result then + begin + if FRoot <> nil then + begin + Result := (not Contains(AValue)) or CheckDuplicate; + if Result then + begin + if FRoot.ChildrenCount = Length(FRoot.Children) then + SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); + if FRoot.ChildrenCount < Length(FRoot.Children) then + begin + NewNode := TJclExtendedTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := FRoot; + FRoot.Children[FRoot.ChildrenCount] := NewNode; + Inc(FRoot.ChildrenCount); + Inc(FSize); + end + else + Result := False; + end; + end + else + begin + FRoot := TJclExtendedTreeNode.Create; + FRoot.Value := AValue; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedTree.AddAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclExtendedTree; + ACollection: IJclExtendedCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclExtendedTree then + begin + ADest := TJclExtendedTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclExtendedCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclExtendedTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclExtendedTree then + TJclExtendedTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclExtendedTree.Clear; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + RemoveNode(FRoot); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedTree.CloneNode(Node, Parent: TJclExtendedTreeNode): TJclExtendedTreeNode; +var + Index: Integer; +begin + Result := TJclExtendedTreeNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + SetLength(Result.Children, Node.ChildrenCount); + Result.ChildrenCount := Node.ChildrenCount; + for Index := 0 to Node.ChildrenCount - 1 do + Result.Children[Index] := CloneNode(TJclExtendedTreeNode(Node.Children[Index]), Result); // recursive call +end; + +function TJclExtendedTree.CollectionEquals(const ACollection: IJclExtendedCollection): Boolean; +var + It, ItSelf: IJclExtendedIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedTree.Contains(const AValue: Extended): Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + Result := NodeContains(FRoot, AValue) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedTree.ContainsAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedTree.Extract(const AValue: Extended): Boolean; +var + It: IJclExtendedIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FRoot <> nil; + if Result then + begin + It := First; + while It.HasNext do + if ItemsEqual(It.Next, AValue) then + begin + It.Extract; + if RemoveSingleElement then + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedTree.ExtractAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedTree.ExtractNode(var ANode: TJclExtendedTreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TJclExtendedTreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + ExtractNode(TJclExtendedTreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + ExtractNode(ANode.Children[Index]); + {$ENDIF ~BCB} + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclExtendedTree.First: IJclExtendedIterator; +var + Start: TJclExtendedTreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderExtendedTreeIterator.Create(Self, Start, False, isFirst); + toPostOrder: + begin + if Start <> nil then + while (Start.ChildrenCount > 0) do + Start := TJclExtendedTreeNode(Start.Children[0]); + Result := TJclPostOrderExtendedTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclExtendedTree.GetEnumerator: IJclExtendedIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclExtendedTree.GetRoot: IJclExtendedTreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderExtendedTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TJclPostOrderExtendedTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclExtendedTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclExtendedTree.Last: IJclExtendedIterator; +var + Start: TJclExtendedTreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while Start.ChildrenCount > 0 do + Start := TJclExtendedTreeNode(Start.Children[Start.ChildrenCount - 1]); + Result := TJclPreOrderExtendedTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TJclPostOrderExtendedTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedTree.NodeContains(ANode: TJclExtendedTreeNode; const AValue: Extended): Boolean; +var + Index: Integer; +begin + Result := ItemsEqual(ANode.Value, AValue); + if not Result then + for Index := 0 to ANode.ChildrenCount - 1 do + begin + Result := NodeContains(TJclExtendedTreeNode(ANode.Children[Index]), AValue); + if Result then + Break; + end; +end; + +procedure TJclExtendedTree.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + PackNode(FRoot); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedTree.PackNode(ANode: TJclExtendedTreeNode); +var + Index: Integer; +begin + SetLength(ANode.Children, ANode.ChildrenCount); + for Index := 0 to ANode.ChildrenCount - 1 do + PackNode(TJclExtendedTreeNode(ANode.Children[Index])); +end; + +function TJclExtendedTree.Remove(const AValue: Extended): Boolean; +var + Extracted: Extended; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeExtended(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedTree.RemoveAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedTree.RemoveNode(var ANode: TJclExtendedTreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TJclExtendedTreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + RemoveNode(TJclExtendedTreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + RemoveNode(ANode.Children[Index]); + {$ENDIF ~BCB} + FreeExtended(ANode.Value); + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclExtendedTree.RetainAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclExtendedTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclExtendedTree.Size: Integer; +begin + Result := FSize; +end; + +function TJclExtendedTree.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclExtendedTree.Create; + AssignPropertiesTo(Result); +end; + +//=== { TJclExtendedTreeIterator } =========================================================== + +constructor TJclExtendedTreeIterator.Create(OwnTree: TJclExtendedTree; ACursor: TJclExtendedTreeNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnTree := OwnTree; + FStart := AStart; + FEqualityComparer := OwnTree as IJclExtendedEqualityComparer; +end; + +function TJclExtendedTreeIterator.Add(const AValue: Extended): Boolean; +var + ParentNode, NewNode: TJclExtendedTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // add sibling or, if FCursor is root node, behave like TJclExtendedTree.Add + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0)) + and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); + + if Result then + begin + ParentNode := FCursor.Parent; + if ParentNode = nil then + ParentNode := FCursor; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclExtendedTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := ParentNode; + ParentNode.Children[ParentNode.ChildrenCount] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedTreeIterator.AddChild(const AValue: Extended): Boolean; +var + NewNode: TJclExtendedTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0)) + and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclExtendedTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := FCursor; + FCursor.Children[FCursor.ChildrenCount] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclExtendedTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclExtendedTreeIterator then + begin + ADest := TJclExtendedTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclExtendedTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.ChildrenCount + else + Result := 0; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedTreeIterator.DeleteChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclExtendedTreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedTreeIterator.DeleteChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclExtendedTreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedTreeIterator.Extract; +var + OldCursor: TJclExtendedTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.ExtractNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedTreeIterator.ExtractChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclExtendedTreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedTreeIterator.ExtractChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclExtendedTreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedTreeIterator.GetChild(Index: Integer): Extended; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + FCursor := TJclExtendedTreeNode(FCursor.Children[Index]); + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedTreeIterator.GetValue: Extended; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := 0.0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedTreeIterator.IndexOfChild(const AValue: Extended): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.IndexOfValue(AValue, FEqualityComparer) + else + Result := -1; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedTreeIterator.Insert(const AValue: Extended): Boolean; +var + ParentNode, NewNode: TJclExtendedTreeNode; + Index, I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclExtendedTree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0)) + and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.Parent <> nil then + begin + ParentNode := FCursor.Parent; + Index := 0; + while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do + Inc(Index); + end + else + begin + ParentNode := FCursor; + Index := 0; + end; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclExtendedTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := ParentNode; + for I := ParentNode.ChildrenCount - 1 downto Index do + ParentNode.Children[I + 1] := ParentNode.Children[I]; + ParentNode.Children[Index] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedTreeIterator.InsertChild(Index: Integer; const AValue: Extended): Boolean; +var + NewNode: TJclExtendedTreeNode; + I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclExtendedTree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0.0)) + and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclExtendedTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := FCursor; + for I := FCursor.ChildrenCount - 1 downto Index do + FCursor.Children[I + 1] := FCursor.Children[I]; + FCursor.Children[Index] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedTreeIterator.IteratorEquals(const AIterator: IJclExtendedIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclExtendedTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclExtendedTreeIterator then + begin + ItrObj := TJclExtendedTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclExtendedTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclExtendedTreeIterator.Next: Extended; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := 0.0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclExtendedTreeIterator.Parent: Extended; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedTreeIterator.Previous: Extended; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := 0.0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclExtendedTreeIterator.Remove; +var + OldCursor: TJclExtendedTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.RemoveNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedTreeIterator.Reset; +var + NewCursor: TJclExtendedTreeNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedTreeIterator.SetChild(Index: Integer; const AValue: Extended); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + TJclExtendedTreeNode(FCursor.Children[Index]).Value := AValue + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedTreeIterator.SetValue(const AValue: Extended); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + if FCursor <> nil then + begin + FOwnTree.FreeExtended(FCursor.Value); + FCursor.Value := AValue; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclPreOrderExtendedTreeIterator } =================================================== + +function TJclPreOrderExtendedTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderExtendedTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderExtendedTreeIterator.GetNextCursor: TJclExtendedTreeNode; +var + LastRet: TJclExtendedTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.ChildrenCount > 0 then + Result := TJclExtendedTreeNode(Result.Children[0]) + else + begin + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclExtendedTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + end; +end; + +function TJclPreOrderExtendedTreeIterator.GetNextSibling: TJclExtendedTreeNode; +var + LastRet: TJclExtendedTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclExtendedTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); +end; + +function TJclPreOrderExtendedTreeIterator.GetPreviousCursor: TJclExtendedTreeNode; +var + LastRet: TJclExtendedTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then + // come from Right + begin + Result := TJclExtendedTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + while (Result.ChildrenCount > 0) do // descend down the tree + Result := TJclExtendedTreeNode(Result.Children[Result.ChildrenCount - 1]); + end; +end; + +//=== { TJclPostOrderExtendedTreeIterator } ================================================== + +function TJclPostOrderExtendedTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderExtendedTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderExtendedTreeIterator.GetNextCursor: TJclExtendedTreeNode; +var + LastRet: TJclExtendedTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclExtendedTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclExtendedTreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderExtendedTreeIterator.GetNextSibling: TJclExtendedTreeNode; +var + LastRet: TJclExtendedTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclExtendedTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclExtendedTreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderExtendedTreeIterator.GetPreviousCursor: TJclExtendedTreeNode; +var + LastRet: TJclExtendedTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.ChildrenCount > 0 then + Result := TJclExtendedTreeNode(Result.Children[Result.ChildrenCount - 1]) + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := TJclExtendedTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + end; +end; + +//=== { TJclIntegerTreeNode } ======================================================= + +function TJclIntegerTreeNode.IndexOfChild(AChild: TJclIntegerTreeNode): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if Children[Result] = AChild then + Exit; + Result := -1; +end; + +function TJclIntegerTreeNode.IndexOfValue(AValue: Integer; + const AEqualityComparer: IJclIntegerEqualityComparer): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if AEqualityComparer.ItemsEqual(TJclIntegerTreeNode(Children[Result]).Value, AValue) then + Exit; + Result := -1; +end; + +//=== { TJclIntegerTree } ======================================================= + +constructor TJclIntegerTree.Create(); +begin + inherited Create(); + FTraverseOrder := toPreOrder; +end; + +destructor TJclIntegerTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclIntegerTree.Add(AValue: Integer): Boolean; +var + NewNode: TJclIntegerTreeNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := AllowDefaultElements or not ItemsEqual(AValue, 0); + + if Result then + begin + if FRoot <> nil then + begin + Result := (not Contains(AValue)) or CheckDuplicate; + if Result then + begin + if FRoot.ChildrenCount = Length(FRoot.Children) then + SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); + if FRoot.ChildrenCount < Length(FRoot.Children) then + begin + NewNode := TJclIntegerTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := FRoot; + FRoot.Children[FRoot.ChildrenCount] := NewNode; + Inc(FRoot.ChildrenCount); + Inc(FSize); + end + else + Result := False; + end; + end + else + begin + FRoot := TJclIntegerTreeNode.Create; + FRoot.Value := AValue; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerTree.AddAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclIntegerTree; + ACollection: IJclIntegerCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntegerTree then + begin + ADest := TJclIntegerTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclIntegerCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclIntegerTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclIntegerTree then + TJclIntegerTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclIntegerTree.Clear; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + RemoveNode(FRoot); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerTree.CloneNode(Node, Parent: TJclIntegerTreeNode): TJclIntegerTreeNode; +var + Index: Integer; +begin + Result := TJclIntegerTreeNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + SetLength(Result.Children, Node.ChildrenCount); + Result.ChildrenCount := Node.ChildrenCount; + for Index := 0 to Node.ChildrenCount - 1 do + Result.Children[Index] := CloneNode(TJclIntegerTreeNode(Node.Children[Index]), Result); // recursive call +end; + +function TJclIntegerTree.CollectionEquals(const ACollection: IJclIntegerCollection): Boolean; +var + It, ItSelf: IJclIntegerIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerTree.Contains(AValue: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + Result := NodeContains(FRoot, AValue) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerTree.ContainsAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerTree.Extract(AValue: Integer): Boolean; +var + It: IJclIntegerIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FRoot <> nil; + if Result then + begin + It := First; + while It.HasNext do + if ItemsEqual(It.Next, AValue) then + begin + It.Extract; + if RemoveSingleElement then + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerTree.ExtractAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerTree.ExtractNode(var ANode: TJclIntegerTreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TJclIntegerTreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + ExtractNode(TJclIntegerTreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + ExtractNode(ANode.Children[Index]); + {$ENDIF ~BCB} + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclIntegerTree.First: IJclIntegerIterator; +var + Start: TJclIntegerTreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderIntegerTreeIterator.Create(Self, Start, False, isFirst); + toPostOrder: + begin + if Start <> nil then + while (Start.ChildrenCount > 0) do + Start := TJclIntegerTreeNode(Start.Children[0]); + Result := TJclPostOrderIntegerTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclIntegerTree.GetEnumerator: IJclIntegerIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclIntegerTree.GetRoot: IJclIntegerTreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderIntegerTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TJclPostOrderIntegerTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclIntegerTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntegerTree.Last: IJclIntegerIterator; +var + Start: TJclIntegerTreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while Start.ChildrenCount > 0 do + Start := TJclIntegerTreeNode(Start.Children[Start.ChildrenCount - 1]); + Result := TJclPreOrderIntegerTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TJclPostOrderIntegerTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerTree.NodeContains(ANode: TJclIntegerTreeNode; AValue: Integer): Boolean; +var + Index: Integer; +begin + Result := ItemsEqual(ANode.Value, AValue); + if not Result then + for Index := 0 to ANode.ChildrenCount - 1 do + begin + Result := NodeContains(TJclIntegerTreeNode(ANode.Children[Index]), AValue); + if Result then + Break; + end; +end; + +procedure TJclIntegerTree.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + PackNode(FRoot); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerTree.PackNode(ANode: TJclIntegerTreeNode); +var + Index: Integer; +begin + SetLength(ANode.Children, ANode.ChildrenCount); + for Index := 0 to ANode.ChildrenCount - 1 do + PackNode(TJclIntegerTreeNode(ANode.Children[Index])); +end; + +function TJclIntegerTree.Remove(AValue: Integer): Boolean; +var + Extracted: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeInteger(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerTree.RemoveAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerTree.RemoveNode(var ANode: TJclIntegerTreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TJclIntegerTreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + RemoveNode(TJclIntegerTreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + RemoveNode(ANode.Children[Index]); + {$ENDIF ~BCB} + FreeInteger(ANode.Value); + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclIntegerTree.RetainAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclIntegerTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclIntegerTree.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntegerTree.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntegerTree.Create; + AssignPropertiesTo(Result); +end; + +//=== { TJclIntegerTreeIterator } =========================================================== + +constructor TJclIntegerTreeIterator.Create(OwnTree: TJclIntegerTree; ACursor: TJclIntegerTreeNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnTree := OwnTree; + FStart := AStart; + FEqualityComparer := OwnTree as IJclIntegerEqualityComparer; +end; + +function TJclIntegerTreeIterator.Add(AValue: Integer): Boolean; +var + ParentNode, NewNode: TJclIntegerTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // add sibling or, if FCursor is root node, behave like TJclIntegerTree.Add + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0)) + and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); + + if Result then + begin + ParentNode := FCursor.Parent; + if ParentNode = nil then + ParentNode := FCursor; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclIntegerTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := ParentNode; + ParentNode.Children[ParentNode.ChildrenCount] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerTreeIterator.AddChild(AValue: Integer): Boolean; +var + NewNode: TJclIntegerTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0)) + and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclIntegerTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := FCursor; + FCursor.Children[FCursor.ChildrenCount] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclIntegerTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclIntegerTreeIterator then + begin + ADest := TJclIntegerTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclIntegerTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.ChildrenCount + else + Result := 0; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerTreeIterator.DeleteChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclIntegerTreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerTreeIterator.DeleteChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclIntegerTreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerTreeIterator.Extract; +var + OldCursor: TJclIntegerTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.ExtractNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerTreeIterator.ExtractChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclIntegerTreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerTreeIterator.ExtractChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclIntegerTreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerTreeIterator.GetChild(Index: Integer): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + FCursor := TJclIntegerTreeNode(FCursor.Children[Index]); + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerTreeIterator.GetValue: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := 0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerTreeIterator.IndexOfChild(AValue: Integer): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.IndexOfValue(AValue, FEqualityComparer) + else + Result := -1; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerTreeIterator.Insert(AValue: Integer): Boolean; +var + ParentNode, NewNode: TJclIntegerTreeNode; + Index, I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclIntegerTree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0)) + and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.Parent <> nil then + begin + ParentNode := FCursor.Parent; + Index := 0; + while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do + Inc(Index); + end + else + begin + ParentNode := FCursor; + Index := 0; + end; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclIntegerTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := ParentNode; + for I := ParentNode.ChildrenCount - 1 downto Index do + ParentNode.Children[I + 1] := ParentNode.Children[I]; + ParentNode.Children[Index] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerTreeIterator.InsertChild(Index: Integer; AValue: Integer): Boolean; +var + NewNode: TJclIntegerTreeNode; + I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclIntegerTree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0)) + and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclIntegerTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := FCursor; + for I := FCursor.ChildrenCount - 1 downto Index do + FCursor.Children[I + 1] := FCursor.Children[I]; + FCursor.Children[Index] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerTreeIterator.IteratorEquals(const AIterator: IJclIntegerIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclIntegerTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclIntegerTreeIterator then + begin + ItrObj := TJclIntegerTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclIntegerTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclIntegerTreeIterator.Next: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := 0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclIntegerTreeIterator.Parent: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerTreeIterator.Previous: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := 0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclIntegerTreeIterator.Remove; +var + OldCursor: TJclIntegerTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.RemoveNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerTreeIterator.Reset; +var + NewCursor: TJclIntegerTreeNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerTreeIterator.SetChild(Index: Integer; AValue: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + TJclIntegerTreeNode(FCursor.Children[Index]).Value := AValue + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerTreeIterator.SetValue(AValue: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + if FCursor <> nil then + begin + FOwnTree.FreeInteger(FCursor.Value); + FCursor.Value := AValue; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclPreOrderIntegerTreeIterator } =================================================== + +function TJclPreOrderIntegerTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderIntegerTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderIntegerTreeIterator.GetNextCursor: TJclIntegerTreeNode; +var + LastRet: TJclIntegerTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.ChildrenCount > 0 then + Result := TJclIntegerTreeNode(Result.Children[0]) + else + begin + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclIntegerTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + end; +end; + +function TJclPreOrderIntegerTreeIterator.GetNextSibling: TJclIntegerTreeNode; +var + LastRet: TJclIntegerTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclIntegerTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); +end; + +function TJclPreOrderIntegerTreeIterator.GetPreviousCursor: TJclIntegerTreeNode; +var + LastRet: TJclIntegerTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then + // come from Right + begin + Result := TJclIntegerTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + while (Result.ChildrenCount > 0) do // descend down the tree + Result := TJclIntegerTreeNode(Result.Children[Result.ChildrenCount - 1]); + end; +end; + +//=== { TJclPostOrderIntegerTreeIterator } ================================================== + +function TJclPostOrderIntegerTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderIntegerTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderIntegerTreeIterator.GetNextCursor: TJclIntegerTreeNode; +var + LastRet: TJclIntegerTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclIntegerTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclIntegerTreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderIntegerTreeIterator.GetNextSibling: TJclIntegerTreeNode; +var + LastRet: TJclIntegerTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclIntegerTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclIntegerTreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderIntegerTreeIterator.GetPreviousCursor: TJclIntegerTreeNode; +var + LastRet: TJclIntegerTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.ChildrenCount > 0 then + Result := TJclIntegerTreeNode(Result.Children[Result.ChildrenCount - 1]) + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := TJclIntegerTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + end; +end; + +//=== { TJclCardinalTreeNode } ======================================================= + +function TJclCardinalTreeNode.IndexOfChild(AChild: TJclCardinalTreeNode): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if Children[Result] = AChild then + Exit; + Result := -1; +end; + +function TJclCardinalTreeNode.IndexOfValue(AValue: Cardinal; + const AEqualityComparer: IJclCardinalEqualityComparer): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if AEqualityComparer.ItemsEqual(TJclCardinalTreeNode(Children[Result]).Value, AValue) then + Exit; + Result := -1; +end; + +//=== { TJclCardinalTree } ======================================================= + +constructor TJclCardinalTree.Create(); +begin + inherited Create(); + FTraverseOrder := toPreOrder; +end; + +destructor TJclCardinalTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclCardinalTree.Add(AValue: Cardinal): Boolean; +var + NewNode: TJclCardinalTreeNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := AllowDefaultElements or not ItemsEqual(AValue, 0); + + if Result then + begin + if FRoot <> nil then + begin + Result := (not Contains(AValue)) or CheckDuplicate; + if Result then + begin + if FRoot.ChildrenCount = Length(FRoot.Children) then + SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); + if FRoot.ChildrenCount < Length(FRoot.Children) then + begin + NewNode := TJclCardinalTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := FRoot; + FRoot.Children[FRoot.ChildrenCount] := NewNode; + Inc(FRoot.ChildrenCount); + Inc(FSize); + end + else + Result := False; + end; + end + else + begin + FRoot := TJclCardinalTreeNode.Create; + FRoot.Value := AValue; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalTree.AddAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclCardinalTree; + ACollection: IJclCardinalCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclCardinalTree then + begin + ADest := TJclCardinalTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclCardinalCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclCardinalTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclCardinalTree then + TJclCardinalTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclCardinalTree.Clear; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + RemoveNode(FRoot); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalTree.CloneNode(Node, Parent: TJclCardinalTreeNode): TJclCardinalTreeNode; +var + Index: Integer; +begin + Result := TJclCardinalTreeNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + SetLength(Result.Children, Node.ChildrenCount); + Result.ChildrenCount := Node.ChildrenCount; + for Index := 0 to Node.ChildrenCount - 1 do + Result.Children[Index] := CloneNode(TJclCardinalTreeNode(Node.Children[Index]), Result); // recursive call +end; + +function TJclCardinalTree.CollectionEquals(const ACollection: IJclCardinalCollection): Boolean; +var + It, ItSelf: IJclCardinalIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalTree.Contains(AValue: Cardinal): Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + Result := NodeContains(FRoot, AValue) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalTree.ContainsAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalTree.Extract(AValue: Cardinal): Boolean; +var + It: IJclCardinalIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FRoot <> nil; + if Result then + begin + It := First; + while It.HasNext do + if ItemsEqual(It.Next, AValue) then + begin + It.Extract; + if RemoveSingleElement then + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalTree.ExtractAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalTree.ExtractNode(var ANode: TJclCardinalTreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TJclCardinalTreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + ExtractNode(TJclCardinalTreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + ExtractNode(ANode.Children[Index]); + {$ENDIF ~BCB} + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclCardinalTree.First: IJclCardinalIterator; +var + Start: TJclCardinalTreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderCardinalTreeIterator.Create(Self, Start, False, isFirst); + toPostOrder: + begin + if Start <> nil then + while (Start.ChildrenCount > 0) do + Start := TJclCardinalTreeNode(Start.Children[0]); + Result := TJclPostOrderCardinalTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclCardinalTree.GetEnumerator: IJclCardinalIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclCardinalTree.GetRoot: IJclCardinalTreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderCardinalTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TJclPostOrderCardinalTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclCardinalTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclCardinalTree.Last: IJclCardinalIterator; +var + Start: TJclCardinalTreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while Start.ChildrenCount > 0 do + Start := TJclCardinalTreeNode(Start.Children[Start.ChildrenCount - 1]); + Result := TJclPreOrderCardinalTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TJclPostOrderCardinalTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalTree.NodeContains(ANode: TJclCardinalTreeNode; AValue: Cardinal): Boolean; +var + Index: Integer; +begin + Result := ItemsEqual(ANode.Value, AValue); + if not Result then + for Index := 0 to ANode.ChildrenCount - 1 do + begin + Result := NodeContains(TJclCardinalTreeNode(ANode.Children[Index]), AValue); + if Result then + Break; + end; +end; + +procedure TJclCardinalTree.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + PackNode(FRoot); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalTree.PackNode(ANode: TJclCardinalTreeNode); +var + Index: Integer; +begin + SetLength(ANode.Children, ANode.ChildrenCount); + for Index := 0 to ANode.ChildrenCount - 1 do + PackNode(TJclCardinalTreeNode(ANode.Children[Index])); +end; + +function TJclCardinalTree.Remove(AValue: Cardinal): Boolean; +var + Extracted: Cardinal; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeCardinal(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalTree.RemoveAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalTree.RemoveNode(var ANode: TJclCardinalTreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TJclCardinalTreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + RemoveNode(TJclCardinalTreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + RemoveNode(ANode.Children[Index]); + {$ENDIF ~BCB} + FreeCardinal(ANode.Value); + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclCardinalTree.RetainAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclCardinalTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclCardinalTree.Size: Integer; +begin + Result := FSize; +end; + +function TJclCardinalTree.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclCardinalTree.Create; + AssignPropertiesTo(Result); +end; + +//=== { TJclCardinalTreeIterator } =========================================================== + +constructor TJclCardinalTreeIterator.Create(OwnTree: TJclCardinalTree; ACursor: TJclCardinalTreeNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnTree := OwnTree; + FStart := AStart; + FEqualityComparer := OwnTree as IJclCardinalEqualityComparer; +end; + +function TJclCardinalTreeIterator.Add(AValue: Cardinal): Boolean; +var + ParentNode, NewNode: TJclCardinalTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // add sibling or, if FCursor is root node, behave like TJclCardinalTree.Add + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0)) + and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); + + if Result then + begin + ParentNode := FCursor.Parent; + if ParentNode = nil then + ParentNode := FCursor; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclCardinalTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := ParentNode; + ParentNode.Children[ParentNode.ChildrenCount] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalTreeIterator.AddChild(AValue: Cardinal): Boolean; +var + NewNode: TJclCardinalTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0)) + and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclCardinalTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := FCursor; + FCursor.Children[FCursor.ChildrenCount] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclCardinalTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclCardinalTreeIterator then + begin + ADest := TJclCardinalTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclCardinalTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.ChildrenCount + else + Result := 0; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalTreeIterator.DeleteChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclCardinalTreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalTreeIterator.DeleteChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclCardinalTreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalTreeIterator.Extract; +var + OldCursor: TJclCardinalTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.ExtractNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalTreeIterator.ExtractChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclCardinalTreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalTreeIterator.ExtractChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclCardinalTreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalTreeIterator.GetChild(Index: Integer): Cardinal; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + FCursor := TJclCardinalTreeNode(FCursor.Children[Index]); + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalTreeIterator.GetValue: Cardinal; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := 0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalTreeIterator.IndexOfChild(AValue: Cardinal): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.IndexOfValue(AValue, FEqualityComparer) + else + Result := -1; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalTreeIterator.Insert(AValue: Cardinal): Boolean; +var + ParentNode, NewNode: TJclCardinalTreeNode; + Index, I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclCardinalTree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0)) + and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.Parent <> nil then + begin + ParentNode := FCursor.Parent; + Index := 0; + while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do + Inc(Index); + end + else + begin + ParentNode := FCursor; + Index := 0; + end; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclCardinalTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := ParentNode; + for I := ParentNode.ChildrenCount - 1 downto Index do + ParentNode.Children[I + 1] := ParentNode.Children[I]; + ParentNode.Children[Index] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalTreeIterator.InsertChild(Index: Integer; AValue: Cardinal): Boolean; +var + NewNode: TJclCardinalTreeNode; + I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclCardinalTree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0)) + and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclCardinalTreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := FCursor; + for I := FCursor.ChildrenCount - 1 downto Index do + FCursor.Children[I + 1] := FCursor.Children[I]; + FCursor.Children[Index] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalTreeIterator.IteratorEquals(const AIterator: IJclCardinalIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclCardinalTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclCardinalTreeIterator then + begin + ItrObj := TJclCardinalTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclCardinalTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclCardinalTreeIterator.Next: Cardinal; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := 0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclCardinalTreeIterator.Parent: Cardinal; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalTreeIterator.Previous: Cardinal; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := 0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclCardinalTreeIterator.Remove; +var + OldCursor: TJclCardinalTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.RemoveNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalTreeIterator.Reset; +var + NewCursor: TJclCardinalTreeNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalTreeIterator.SetChild(Index: Integer; AValue: Cardinal); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + TJclCardinalTreeNode(FCursor.Children[Index]).Value := AValue + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalTreeIterator.SetValue(AValue: Cardinal); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + if FCursor <> nil then + begin + FOwnTree.FreeCardinal(FCursor.Value); + FCursor.Value := AValue; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclPreOrderCardinalTreeIterator } =================================================== + +function TJclPreOrderCardinalTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderCardinalTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderCardinalTreeIterator.GetNextCursor: TJclCardinalTreeNode; +var + LastRet: TJclCardinalTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.ChildrenCount > 0 then + Result := TJclCardinalTreeNode(Result.Children[0]) + else + begin + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclCardinalTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + end; +end; + +function TJclPreOrderCardinalTreeIterator.GetNextSibling: TJclCardinalTreeNode; +var + LastRet: TJclCardinalTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclCardinalTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); +end; + +function TJclPreOrderCardinalTreeIterator.GetPreviousCursor: TJclCardinalTreeNode; +var + LastRet: TJclCardinalTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then + // come from Right + begin + Result := TJclCardinalTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + while (Result.ChildrenCount > 0) do // descend down the tree + Result := TJclCardinalTreeNode(Result.Children[Result.ChildrenCount - 1]); + end; +end; + +//=== { TJclPostOrderCardinalTreeIterator } ================================================== + +function TJclPostOrderCardinalTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderCardinalTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderCardinalTreeIterator.GetNextCursor: TJclCardinalTreeNode; +var + LastRet: TJclCardinalTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclCardinalTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclCardinalTreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderCardinalTreeIterator.GetNextSibling: TJclCardinalTreeNode; +var + LastRet: TJclCardinalTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclCardinalTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclCardinalTreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderCardinalTreeIterator.GetPreviousCursor: TJclCardinalTreeNode; +var + LastRet: TJclCardinalTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.ChildrenCount > 0 then + Result := TJclCardinalTreeNode(Result.Children[Result.ChildrenCount - 1]) + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := TJclCardinalTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + end; +end; + +//=== { TJclInt64TreeNode } ======================================================= + +function TJclInt64TreeNode.IndexOfChild(AChild: TJclInt64TreeNode): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if Children[Result] = AChild then + Exit; + Result := -1; +end; + +function TJclInt64TreeNode.IndexOfValue(const AValue: Int64; + const AEqualityComparer: IJclInt64EqualityComparer): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if AEqualityComparer.ItemsEqual(TJclInt64TreeNode(Children[Result]).Value, AValue) then + Exit; + Result := -1; +end; + +//=== { TJclInt64Tree } ======================================================= + +constructor TJclInt64Tree.Create(); +begin + inherited Create(); + FTraverseOrder := toPreOrder; +end; + +destructor TJclInt64Tree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclInt64Tree.Add(const AValue: Int64): Boolean; +var + NewNode: TJclInt64TreeNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := AllowDefaultElements or not ItemsEqual(AValue, 0); + + if Result then + begin + if FRoot <> nil then + begin + Result := (not Contains(AValue)) or CheckDuplicate; + if Result then + begin + if FRoot.ChildrenCount = Length(FRoot.Children) then + SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); + if FRoot.ChildrenCount < Length(FRoot.Children) then + begin + NewNode := TJclInt64TreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := FRoot; + FRoot.Children[FRoot.ChildrenCount] := NewNode; + Inc(FRoot.ChildrenCount); + Inc(FSize); + end + else + Result := False; + end; + end + else + begin + FRoot := TJclInt64TreeNode.Create; + FRoot.Value := AValue; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Tree.AddAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64Tree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclInt64Tree; + ACollection: IJclInt64Collection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclInt64Tree then + begin + ADest := TJclInt64Tree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclInt64Collection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclInt64Tree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclInt64Tree then + TJclInt64Tree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclInt64Tree.Clear; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + RemoveNode(FRoot); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Tree.CloneNode(Node, Parent: TJclInt64TreeNode): TJclInt64TreeNode; +var + Index: Integer; +begin + Result := TJclInt64TreeNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + SetLength(Result.Children, Node.ChildrenCount); + Result.ChildrenCount := Node.ChildrenCount; + for Index := 0 to Node.ChildrenCount - 1 do + Result.Children[Index] := CloneNode(TJclInt64TreeNode(Node.Children[Index]), Result); // recursive call +end; + +function TJclInt64Tree.CollectionEquals(const ACollection: IJclInt64Collection): Boolean; +var + It, ItSelf: IJclInt64Iterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Tree.Contains(const AValue: Int64): Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + Result := NodeContains(FRoot, AValue) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Tree.ContainsAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Tree.Extract(const AValue: Int64): Boolean; +var + It: IJclInt64Iterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FRoot <> nil; + if Result then + begin + It := First; + while It.HasNext do + if ItemsEqual(It.Next, AValue) then + begin + It.Extract; + if RemoveSingleElement then + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Tree.ExtractAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64Tree.ExtractNode(var ANode: TJclInt64TreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TJclInt64TreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + ExtractNode(TJclInt64TreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + ExtractNode(ANode.Children[Index]); + {$ENDIF ~BCB} + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclInt64Tree.First: IJclInt64Iterator; +var + Start: TJclInt64TreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderInt64TreeIterator.Create(Self, Start, False, isFirst); + toPostOrder: + begin + if Start <> nil then + while (Start.ChildrenCount > 0) do + Start := TJclInt64TreeNode(Start.Children[0]); + Result := TJclPostOrderInt64TreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclInt64Tree.GetEnumerator: IJclInt64Iterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclInt64Tree.GetRoot: IJclInt64TreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderInt64TreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TJclPostOrderInt64TreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Tree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclInt64Tree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclInt64Tree.Last: IJclInt64Iterator; +var + Start: TJclInt64TreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while Start.ChildrenCount > 0 do + Start := TJclInt64TreeNode(Start.Children[Start.ChildrenCount - 1]); + Result := TJclPreOrderInt64TreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TJclPostOrderInt64TreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Tree.NodeContains(ANode: TJclInt64TreeNode; const AValue: Int64): Boolean; +var + Index: Integer; +begin + Result := ItemsEqual(ANode.Value, AValue); + if not Result then + for Index := 0 to ANode.ChildrenCount - 1 do + begin + Result := NodeContains(TJclInt64TreeNode(ANode.Children[Index]), AValue); + if Result then + Break; + end; +end; + +procedure TJclInt64Tree.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + PackNode(FRoot); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64Tree.PackNode(ANode: TJclInt64TreeNode); +var + Index: Integer; +begin + SetLength(ANode.Children, ANode.ChildrenCount); + for Index := 0 to ANode.ChildrenCount - 1 do + PackNode(TJclInt64TreeNode(ANode.Children[Index])); +end; + +function TJclInt64Tree.Remove(const AValue: Int64): Boolean; +var + Extracted: Int64; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeInt64(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Tree.RemoveAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64Tree.RemoveNode(var ANode: TJclInt64TreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TJclInt64TreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + RemoveNode(TJclInt64TreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + RemoveNode(ANode.Children[Index]); + {$ENDIF ~BCB} + FreeInt64(ANode.Value); + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclInt64Tree.RetainAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64Tree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclInt64Tree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclInt64Tree.Size: Integer; +begin + Result := FSize; +end; + +function TJclInt64Tree.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclInt64Tree.Create; + AssignPropertiesTo(Result); +end; + +//=== { TJclInt64TreeIterator } =========================================================== + +constructor TJclInt64TreeIterator.Create(OwnTree: TJclInt64Tree; ACursor: TJclInt64TreeNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnTree := OwnTree; + FStart := AStart; + FEqualityComparer := OwnTree as IJclInt64EqualityComparer; +end; + +function TJclInt64TreeIterator.Add(const AValue: Int64): Boolean; +var + ParentNode, NewNode: TJclInt64TreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // add sibling or, if FCursor is root node, behave like TJclInt64Tree.Add + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0)) + and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); + + if Result then + begin + ParentNode := FCursor.Parent; + if ParentNode = nil then + ParentNode := FCursor; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclInt64TreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := ParentNode; + ParentNode.Children[ParentNode.ChildrenCount] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64TreeIterator.AddChild(const AValue: Int64): Boolean; +var + NewNode: TJclInt64TreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0)) + and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclInt64TreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := FCursor; + FCursor.Children[FCursor.ChildrenCount] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64TreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclInt64TreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclInt64TreeIterator then + begin + ADest := TJclInt64TreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclInt64TreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.ChildrenCount + else + Result := 0; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64TreeIterator.DeleteChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclInt64TreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64TreeIterator.DeleteChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclInt64TreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64TreeIterator.Extract; +var + OldCursor: TJclInt64TreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.ExtractNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64TreeIterator.ExtractChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclInt64TreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64TreeIterator.ExtractChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclInt64TreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64TreeIterator.GetChild(Index: Integer): Int64; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + FCursor := TJclInt64TreeNode(FCursor.Children[Index]); + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64TreeIterator.GetValue: Int64; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := 0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64TreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64TreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64TreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64TreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64TreeIterator.IndexOfChild(const AValue: Int64): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.IndexOfValue(AValue, FEqualityComparer) + else + Result := -1; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64TreeIterator.Insert(const AValue: Int64): Boolean; +var + ParentNode, NewNode: TJclInt64TreeNode; + Index, I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclInt64Tree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0)) + and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.Parent <> nil then + begin + ParentNode := FCursor.Parent; + Index := 0; + while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do + Inc(Index); + end + else + begin + ParentNode := FCursor; + Index := 0; + end; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclInt64TreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := ParentNode; + for I := ParentNode.ChildrenCount - 1 downto Index do + ParentNode.Children[I + 1] := ParentNode.Children[I]; + ParentNode.Children[Index] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64TreeIterator.InsertChild(Index: Integer; const AValue: Int64): Boolean; +var + NewNode: TJclInt64TreeNode; + I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclInt64Tree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AValue, 0)) + and ((not FOwnTree.Contains(AValue)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclInt64TreeNode.Create; + NewNode.Value := AValue; + NewNode.Parent := FCursor; + for I := FCursor.ChildrenCount - 1 downto Index do + FCursor.Children[I + 1] := FCursor.Children[I]; + FCursor.Children[Index] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64TreeIterator.IteratorEquals(const AIterator: IJclInt64Iterator): Boolean; +var + Obj: TObject; + ItrObj: TJclInt64TreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclInt64TreeIterator then + begin + ItrObj := TJclInt64TreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclInt64TreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclInt64TreeIterator.Next: Int64; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := 0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64TreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclInt64TreeIterator.Parent: Int64; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := 0; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64TreeIterator.Previous: Int64; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := 0; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64TreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclInt64TreeIterator.Remove; +var + OldCursor: TJclInt64TreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.RemoveNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64TreeIterator.Reset; +var + NewCursor: TJclInt64TreeNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64TreeIterator.SetChild(Index: Integer; const AValue: Int64); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + TJclInt64TreeNode(FCursor.Children[Index]).Value := AValue + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64TreeIterator.SetValue(const AValue: Int64); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + if FCursor <> nil then + begin + FOwnTree.FreeInt64(FCursor.Value); + FCursor.Value := AValue; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclPreOrderInt64TreeIterator } =================================================== + +function TJclPreOrderInt64TreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderInt64TreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderInt64TreeIterator.GetNextCursor: TJclInt64TreeNode; +var + LastRet: TJclInt64TreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.ChildrenCount > 0 then + Result := TJclInt64TreeNode(Result.Children[0]) + else + begin + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclInt64TreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + end; +end; + +function TJclPreOrderInt64TreeIterator.GetNextSibling: TJclInt64TreeNode; +var + LastRet: TJclInt64TreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclInt64TreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); +end; + +function TJclPreOrderInt64TreeIterator.GetPreviousCursor: TJclInt64TreeNode; +var + LastRet: TJclInt64TreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then + // come from Right + begin + Result := TJclInt64TreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + while (Result.ChildrenCount > 0) do // descend down the tree + Result := TJclInt64TreeNode(Result.Children[Result.ChildrenCount - 1]); + end; +end; + +//=== { TJclPostOrderInt64TreeIterator } ================================================== + +function TJclPostOrderInt64TreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderInt64TreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderInt64TreeIterator.GetNextCursor: TJclInt64TreeNode; +var + LastRet: TJclInt64TreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclInt64TreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclInt64TreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderInt64TreeIterator.GetNextSibling: TJclInt64TreeNode; +var + LastRet: TJclInt64TreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclInt64TreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclInt64TreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderInt64TreeIterator.GetPreviousCursor: TJclInt64TreeNode; +var + LastRet: TJclInt64TreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.ChildrenCount > 0 then + Result := TJclInt64TreeNode(Result.Children[Result.ChildrenCount - 1]) + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := TJclInt64TreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + end; +end; + +//=== { TJclPtrTreeNode } ======================================================= + +function TJclPtrTreeNode.IndexOfChild(AChild: TJclPtrTreeNode): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if Children[Result] = AChild then + Exit; + Result := -1; +end; + +function TJclPtrTreeNode.IndexOfValue(APtr: Pointer; + const AEqualityComparer: IJclPtrEqualityComparer): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if AEqualityComparer.ItemsEqual(TJclPtrTreeNode(Children[Result]).Value, APtr) then + Exit; + Result := -1; +end; + +//=== { TJclPtrTree } ======================================================= + +constructor TJclPtrTree.Create(); +begin + inherited Create(); + FTraverseOrder := toPreOrder; +end; + +destructor TJclPtrTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclPtrTree.Add(APtr: Pointer): Boolean; +var + NewNode: TJclPtrTreeNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := AllowDefaultElements or not ItemsEqual(APtr, nil); + + if Result then + begin + if FRoot <> nil then + begin + Result := (not Contains(APtr)) or CheckDuplicate; + if Result then + begin + if FRoot.ChildrenCount = Length(FRoot.Children) then + SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); + if FRoot.ChildrenCount < Length(FRoot.Children) then + begin + NewNode := TJclPtrTreeNode.Create; + NewNode.Value := APtr; + NewNode.Parent := FRoot; + FRoot.Children[FRoot.ChildrenCount] := NewNode; + Inc(FRoot.ChildrenCount); + Inc(FSize); + end + else + Result := False; + end; + end + else + begin + FRoot := TJclPtrTreeNode.Create; + FRoot.Value := APtr; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrTree.AddAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclPtrTree; + ACollection: IJclPtrCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclPtrTree then + begin + ADest := TJclPtrTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclPtrCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclPtrTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclPtrTree then + TJclPtrTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclPtrTree.Clear; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + RemoveNode(FRoot); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrTree.CloneNode(Node, Parent: TJclPtrTreeNode): TJclPtrTreeNode; +var + Index: Integer; +begin + Result := TJclPtrTreeNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + SetLength(Result.Children, Node.ChildrenCount); + Result.ChildrenCount := Node.ChildrenCount; + for Index := 0 to Node.ChildrenCount - 1 do + Result.Children[Index] := CloneNode(TJclPtrTreeNode(Node.Children[Index]), Result); // recursive call +end; + +function TJclPtrTree.CollectionEquals(const ACollection: IJclPtrCollection): Boolean; +var + It, ItSelf: IJclPtrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrTree.Contains(APtr: Pointer): Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + Result := NodeContains(FRoot, APtr) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrTree.ContainsAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrTree.Extract(APtr: Pointer): Boolean; +var + It: IJclPtrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FRoot <> nil; + if Result then + begin + It := First; + while It.HasNext do + if ItemsEqual(It.Next, APtr) then + begin + It.Extract; + if RemoveSingleElement then + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrTree.ExtractAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrTree.ExtractNode(var ANode: TJclPtrTreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TJclPtrTreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + ExtractNode(TJclPtrTreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + ExtractNode(ANode.Children[Index]); + {$ENDIF ~BCB} + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclPtrTree.First: IJclPtrIterator; +var + Start: TJclPtrTreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderPtrTreeIterator.Create(Self, Start, False, isFirst); + toPostOrder: + begin + if Start <> nil then + while (Start.ChildrenCount > 0) do + Start := TJclPtrTreeNode(Start.Children[0]); + Result := TJclPostOrderPtrTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclPtrTree.GetEnumerator: IJclPtrIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclPtrTree.GetRoot: IJclPtrTreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderPtrTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TJclPostOrderPtrTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclPtrTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclPtrTree.Last: IJclPtrIterator; +var + Start: TJclPtrTreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while Start.ChildrenCount > 0 do + Start := TJclPtrTreeNode(Start.Children[Start.ChildrenCount - 1]); + Result := TJclPreOrderPtrTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TJclPostOrderPtrTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrTree.NodeContains(ANode: TJclPtrTreeNode; APtr: Pointer): Boolean; +var + Index: Integer; +begin + Result := ItemsEqual(ANode.Value, APtr); + if not Result then + for Index := 0 to ANode.ChildrenCount - 1 do + begin + Result := NodeContains(TJclPtrTreeNode(ANode.Children[Index]), APtr); + if Result then + Break; + end; +end; + +procedure TJclPtrTree.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + PackNode(FRoot); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrTree.PackNode(ANode: TJclPtrTreeNode); +var + Index: Integer; +begin + SetLength(ANode.Children, ANode.ChildrenCount); + for Index := 0 to ANode.ChildrenCount - 1 do + PackNode(TJclPtrTreeNode(ANode.Children[Index])); +end; + +function TJclPtrTree.Remove(APtr: Pointer): Boolean; +var + Extracted: Pointer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(APtr); + if Result then + begin + Extracted := APtr; + FreePointer(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrTree.RemoveAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrTree.RemoveNode(var ANode: TJclPtrTreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TJclPtrTreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + RemoveNode(TJclPtrTreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + RemoveNode(ANode.Children[Index]); + {$ENDIF ~BCB} + FreePointer(ANode.Value); + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclPtrTree.RetainAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclPtrTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclPtrTree.Size: Integer; +begin + Result := FSize; +end; + +function TJclPtrTree.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclPtrTree.Create; + AssignPropertiesTo(Result); +end; + +//=== { TJclPtrTreeIterator } =========================================================== + +constructor TJclPtrTreeIterator.Create(OwnTree: TJclPtrTree; ACursor: TJclPtrTreeNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnTree := OwnTree; + FStart := AStart; + FEqualityComparer := OwnTree as IJclPtrEqualityComparer; +end; + +function TJclPtrTreeIterator.Add(APtr: Pointer): Boolean; +var + ParentNode, NewNode: TJclPtrTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // add sibling or, if FCursor is root node, behave like TJclPtrTree.Add + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(APtr, nil)) + and ((not FOwnTree.Contains(APtr)) or FOwnTree.CheckDuplicate); + + if Result then + begin + ParentNode := FCursor.Parent; + if ParentNode = nil then + ParentNode := FCursor; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclPtrTreeNode.Create; + NewNode.Value := APtr; + NewNode.Parent := ParentNode; + ParentNode.Children[ParentNode.ChildrenCount] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrTreeIterator.AddChild(APtr: Pointer): Boolean; +var + NewNode: TJclPtrTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(APtr, nil)) + and ((not FOwnTree.Contains(APtr)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclPtrTreeNode.Create; + NewNode.Value := APtr; + NewNode.Parent := FCursor; + FCursor.Children[FCursor.ChildrenCount] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclPtrTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclPtrTreeIterator then + begin + ADest := TJclPtrTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclPtrTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.ChildrenCount + else + Result := 0; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrTreeIterator.DeleteChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclPtrTreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrTreeIterator.DeleteChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclPtrTreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrTreeIterator.Extract; +var + OldCursor: TJclPtrTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.ExtractNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrTreeIterator.ExtractChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclPtrTreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrTreeIterator.ExtractChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclPtrTreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrTreeIterator.GetChild(Index: Integer): Pointer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := nil; + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + FCursor := TJclPtrTreeNode(FCursor.Children[Index]); + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrTreeIterator.GetPointer: Pointer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrTreeIterator.IndexOfChild(APtr: Pointer): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.IndexOfValue(APtr, FEqualityComparer) + else + Result := -1; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrTreeIterator.Insert(APtr: Pointer): Boolean; +var + ParentNode, NewNode: TJclPtrTreeNode; + Index, I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclPtrTree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(APtr, nil)) + and ((not FOwnTree.Contains(APtr)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.Parent <> nil then + begin + ParentNode := FCursor.Parent; + Index := 0; + while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do + Inc(Index); + end + else + begin + ParentNode := FCursor; + Index := 0; + end; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclPtrTreeNode.Create; + NewNode.Value := APtr; + NewNode.Parent := ParentNode; + for I := ParentNode.ChildrenCount - 1 downto Index do + ParentNode.Children[I + 1] := ParentNode.Children[I]; + ParentNode.Children[Index] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrTreeIterator.InsertChild(Index: Integer; APtr: Pointer): Boolean; +var + NewNode: TJclPtrTreeNode; + I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclPtrTree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(APtr, nil)) + and ((not FOwnTree.Contains(APtr)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclPtrTreeNode.Create; + NewNode.Value := APtr; + NewNode.Parent := FCursor; + for I := FCursor.ChildrenCount - 1 downto Index do + FCursor.Children[I + 1] := FCursor.Children[I]; + FCursor.Children[Index] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrTreeIterator.IteratorEquals(const AIterator: IJclPtrIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclPtrTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclPtrTreeIterator then + begin + ItrObj := TJclPtrTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclPtrTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclPtrTreeIterator.Next: Pointer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclPtrTreeIterator.Parent: Pointer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := nil; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrTreeIterator.Previous: Pointer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclPtrTreeIterator.Remove; +var + OldCursor: TJclPtrTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.RemoveNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrTreeIterator.Reset; +var + NewCursor: TJclPtrTreeNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrTreeIterator.SetChild(Index: Integer; APtr: Pointer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + TJclPtrTreeNode(FCursor.Children[Index]).Value := APtr + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrTreeIterator.SetPointer(APtr: Pointer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + if FCursor <> nil then + begin + FOwnTree.FreePointer(FCursor.Value); + FCursor.Value := APtr; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclPreOrderPtrTreeIterator } =================================================== + +function TJclPreOrderPtrTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderPtrTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderPtrTreeIterator.GetNextCursor: TJclPtrTreeNode; +var + LastRet: TJclPtrTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.ChildrenCount > 0 then + Result := TJclPtrTreeNode(Result.Children[0]) + else + begin + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclPtrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + end; +end; + +function TJclPreOrderPtrTreeIterator.GetNextSibling: TJclPtrTreeNode; +var + LastRet: TJclPtrTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclPtrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); +end; + +function TJclPreOrderPtrTreeIterator.GetPreviousCursor: TJclPtrTreeNode; +var + LastRet: TJclPtrTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then + // come from Right + begin + Result := TJclPtrTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + while (Result.ChildrenCount > 0) do // descend down the tree + Result := TJclPtrTreeNode(Result.Children[Result.ChildrenCount - 1]); + end; +end; + +//=== { TJclPostOrderPtrTreeIterator } ================================================== + +function TJclPostOrderPtrTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderPtrTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderPtrTreeIterator.GetNextCursor: TJclPtrTreeNode; +var + LastRet: TJclPtrTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclPtrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclPtrTreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderPtrTreeIterator.GetNextSibling: TJclPtrTreeNode; +var + LastRet: TJclPtrTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclPtrTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclPtrTreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderPtrTreeIterator.GetPreviousCursor: TJclPtrTreeNode; +var + LastRet: TJclPtrTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.ChildrenCount > 0 then + Result := TJclPtrTreeNode(Result.Children[Result.ChildrenCount - 1]) + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := TJclPtrTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + end; +end; + +//=== { TJclTreeNode } ======================================================= + +function TJclTreeNode.IndexOfChild(AChild: TJclTreeNode): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if Children[Result] = AChild then + Exit; + Result := -1; +end; + +function TJclTreeNode.IndexOfValue(AObject: TObject; + const AEqualityComparer: IJclEqualityComparer): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if AEqualityComparer.ItemsEqual(TJclTreeNode(Children[Result]).Value, AObject) then + Exit; + Result := -1; +end; + +//=== { TJclTree } ======================================================= + +constructor TJclTree.Create(AOwnsObjects: Boolean); +begin + inherited Create(AOwnsObjects); + FTraverseOrder := toPreOrder; +end; + +destructor TJclTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclTree.Add(AObject: TObject): Boolean; +var + NewNode: TJclTreeNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := AllowDefaultElements or not ItemsEqual(AObject, nil); + + if Result then + begin + if FRoot <> nil then + begin + Result := (not Contains(AObject)) or CheckDuplicate; + if Result then + begin + if FRoot.ChildrenCount = Length(FRoot.Children) then + SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); + if FRoot.ChildrenCount < Length(FRoot.Children) then + begin + NewNode := TJclTreeNode.Create; + NewNode.Value := AObject; + NewNode.Parent := FRoot; + FRoot.Children[FRoot.ChildrenCount] := NewNode; + Inc(FRoot.ChildrenCount); + Inc(FSize); + end + else + Result := False; + end; + end + else + begin + FRoot := TJclTreeNode.Create; + FRoot.Value := AObject; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTree.AddAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclTree; + ACollection: IJclCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclTree then + begin + ADest := TJclTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclTree then + TJclTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclTree.Clear; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + RemoveNode(FRoot); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTree.CloneNode(Node, Parent: TJclTreeNode): TJclTreeNode; +var + Index: Integer; +begin + Result := TJclTreeNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + SetLength(Result.Children, Node.ChildrenCount); + Result.ChildrenCount := Node.ChildrenCount; + for Index := 0 to Node.ChildrenCount - 1 do + Result.Children[Index] := CloneNode(TJclTreeNode(Node.Children[Index]), Result); // recursive call +end; + +function TJclTree.CollectionEquals(const ACollection: IJclCollection): Boolean; +var + It, ItSelf: IJclIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTree.Contains(AObject: TObject): Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + Result := NodeContains(FRoot, AObject) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTree.ContainsAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTree.Extract(AObject: TObject): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FRoot <> nil; + if Result then + begin + It := First; + while It.HasNext do + if ItemsEqual(It.Next, AObject) then + begin + It.Extract; + if RemoveSingleElement then + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTree.ExtractAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTree.ExtractNode(var ANode: TJclTreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TJclTreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + ExtractNode(TJclTreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + ExtractNode(ANode.Children[Index]); + {$ENDIF ~BCB} + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclTree.First: IJclIterator; +var + Start: TJclTreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderTreeIterator.Create(Self, Start, False, isFirst); + toPostOrder: + begin + if Start <> nil then + while (Start.ChildrenCount > 0) do + Start := TJclTreeNode(Start.Children[0]); + Result := TJclPostOrderTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclTree.GetEnumerator: IJclIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclTree.GetRoot: IJclTreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TJclPreOrderTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TJclPostOrderTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclTree.Last: IJclIterator; +var + Start: TJclTreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while Start.ChildrenCount > 0 do + Start := TJclTreeNode(Start.Children[Start.ChildrenCount - 1]); + Result := TJclPreOrderTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TJclPostOrderTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTree.NodeContains(ANode: TJclTreeNode; AObject: TObject): Boolean; +var + Index: Integer; +begin + Result := ItemsEqual(ANode.Value, AObject); + if not Result then + for Index := 0 to ANode.ChildrenCount - 1 do + begin + Result := NodeContains(TJclTreeNode(ANode.Children[Index]), AObject); + if Result then + Break; + end; +end; + +procedure TJclTree.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + PackNode(FRoot); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTree.PackNode(ANode: TJclTreeNode); +var + Index: Integer; +begin + SetLength(ANode.Children, ANode.ChildrenCount); + for Index := 0 to ANode.ChildrenCount - 1 do + PackNode(TJclTreeNode(ANode.Children[Index])); +end; + +function TJclTree.Remove(AObject: TObject): Boolean; +var + Extracted: TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AObject); + if Result then + begin + Extracted := AObject; + FreeObject(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTree.RemoveAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTree.RemoveNode(var ANode: TJclTreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TJclTreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + RemoveNode(TJclTreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + RemoveNode(ANode.Children[Index]); + {$ENDIF ~BCB} + FreeObject(ANode.Value); + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclTree.RetainAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclTree.Size: Integer; +begin + Result := FSize; +end; + +function TJclTree.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclTree.Create(False); + AssignPropertiesTo(Result); +end; + +//=== { TJclTreeIterator } =========================================================== + +constructor TJclTreeIterator.Create(OwnTree: TJclTree; ACursor: TJclTreeNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnTree := OwnTree; + FStart := AStart; + FEqualityComparer := OwnTree as IJclEqualityComparer; +end; + +function TJclTreeIterator.Add(AObject: TObject): Boolean; +var + ParentNode, NewNode: TJclTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // add sibling or, if FCursor is root node, behave like TJclTree.Add + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AObject, nil)) + and ((not FOwnTree.Contains(AObject)) or FOwnTree.CheckDuplicate); + + if Result then + begin + ParentNode := FCursor.Parent; + if ParentNode = nil then + ParentNode := FCursor; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclTreeNode.Create; + NewNode.Value := AObject; + NewNode.Parent := ParentNode; + ParentNode.Children[ParentNode.ChildrenCount] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.AddChild(AObject: TObject): Boolean; +var + NewNode: TJclTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AObject, nil)) + and ((not FOwnTree.Contains(AObject)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclTreeNode.Create; + NewNode.Value := AObject; + NewNode.Parent := FCursor; + FCursor.Children[FCursor.ChildrenCount] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclTreeIterator then + begin + ADest := TJclTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.ChildrenCount + else + Result := 0; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTreeIterator.DeleteChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclTreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTreeIterator.DeleteChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclTreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTreeIterator.Extract; +var + OldCursor: TJclTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.ExtractNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTreeIterator.ExtractChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclTreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTreeIterator.ExtractChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclTreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.GetChild(Index: Integer): TObject; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := nil; + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + FCursor := TJclTreeNode(FCursor.Children[Index]); + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.GetObject: TObject; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.IndexOfChild(AObject: TObject): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.IndexOfValue(AObject, FEqualityComparer) + else + Result := -1; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.Insert(AObject: TObject): Boolean; +var + ParentNode, NewNode: TJclTreeNode; + Index, I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclTree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AObject, nil)) + and ((not FOwnTree.Contains(AObject)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.Parent <> nil then + begin + ParentNode := FCursor.Parent; + Index := 0; + while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do + Inc(Index); + end + else + begin + ParentNode := FCursor; + Index := 0; + end; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclTreeNode.Create; + NewNode.Value := AObject; + NewNode.Parent := ParentNode; + for I := ParentNode.ChildrenCount - 1 downto Index do + ParentNode.Children[I + 1] := ParentNode.Children[I]; + ParentNode.Children[Index] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.InsertChild(Index: Integer; AObject: TObject): Boolean; +var + NewNode: TJclTreeNode; + I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclTree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AObject, nil)) + and ((not FOwnTree.Contains(AObject)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclTreeNode.Create; + NewNode.Value := AObject; + NewNode.Parent := FCursor; + for I := FCursor.ChildrenCount - 1 downto Index do + FCursor.Children[I + 1] := FCursor.Children[I]; + FCursor.Children[Index] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.IteratorEquals(const AIterator: IJclIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclTreeIterator then + begin + ItrObj := TJclTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclTreeIterator.Next: TObject; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclTreeIterator.Parent: TObject; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := nil; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.Previous: TObject; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclTreeIterator.Remove; +var + OldCursor: TJclTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.RemoveNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTreeIterator.Reset; +var + NewCursor: TJclTreeNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTreeIterator.SetChild(Index: Integer; AObject: TObject); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + TJclTreeNode(FCursor.Children[Index]).Value := AObject + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTreeIterator.SetObject(AObject: TObject); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + if FCursor <> nil then + begin + FOwnTree.FreeObject(FCursor.Value); + FCursor.Value := AObject; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclPreOrderTreeIterator } =================================================== + +function TJclPreOrderTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderTreeIterator.GetNextCursor: TJclTreeNode; +var + LastRet: TJclTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.ChildrenCount > 0 then + Result := TJclTreeNode(Result.Children[0]) + else + begin + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + end; +end; + +function TJclPreOrderTreeIterator.GetNextSibling: TJclTreeNode; +var + LastRet: TJclTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); +end; + +function TJclPreOrderTreeIterator.GetPreviousCursor: TJclTreeNode; +var + LastRet: TJclTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then + // come from Right + begin + Result := TJclTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + while (Result.ChildrenCount > 0) do // descend down the tree + Result := TJclTreeNode(Result.Children[Result.ChildrenCount - 1]); + end; +end; + +//=== { TJclPostOrderTreeIterator } ================================================== + +function TJclPostOrderTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderTreeIterator.GetNextCursor: TJclTreeNode; +var + LastRet: TJclTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclTreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderTreeIterator.GetNextSibling: TJclTreeNode; +var + LastRet: TJclTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclTreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderTreeIterator.GetPreviousCursor: TJclTreeNode; +var + LastRet: TJclTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.ChildrenCount > 0 then + Result := TJclTreeNode(Result.Children[Result.ChildrenCount - 1]) + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := TJclTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + end; +end; + + +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +//=== { TJclTreeNode } ======================================================= + +function TJclTreeNode.IndexOfChild(AChild: TJclTreeNode): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if Children[Result] = AChild then + Exit; + Result := -1; +end; + +function TJclTreeNode.IndexOfValue(const AItem: T; + const AEqualityComparer: IJclEqualityComparer): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if AEqualityComparer.ItemsEqual(TJclTreeNode(Children[Result]).Value, AItem) then + Exit; + Result := -1; +end; + +//=== { TJclTree } ======================================================= + +constructor TJclTree.Create(AOwnsItems: Boolean); +begin + inherited Create(AOwnsItems); + FTraverseOrder := toPreOrder; +end; + +destructor TJclTree.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclTree.Add(const AItem: T): Boolean; +var + NewNode: TTreeNode; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := AllowDefaultElements or not ItemsEqual(AItem, Default(T)); + + if Result then + begin + if FRoot <> nil then + begin + Result := (not Contains(AItem)) or CheckDuplicate; + if Result then + begin + if FRoot.ChildrenCount = Length(FRoot.Children) then + SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); + if FRoot.ChildrenCount < Length(FRoot.Children) then + begin + NewNode := TTreeNode.Create; + NewNode.Value := AItem; + NewNode.Parent := FRoot; + FRoot.Children[FRoot.ChildrenCount] := NewNode; + Inc(FRoot.ChildrenCount); + Inc(FSize); + end + else + Result := False; + end; + end + else + begin + FRoot := TTreeNode.Create; + FRoot.Value := AItem; + Inc(FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTree.AddAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTree.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclTree; + ACollection: IJclCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclTree then + begin + ADest := TJclTree(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), IJclCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclTree.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is TJclTree then + TJclTree(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure TJclTree.Clear; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + RemoveNode(FRoot); + FSize := 0; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTree.CloneNode(Node, Parent: TTreeNode): TTreeNode; +var + Index: Integer; +begin + Result := TTreeNode.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + SetLength(Result.Children, Node.ChildrenCount); + Result.ChildrenCount := Node.ChildrenCount; + for Index := 0 to Node.ChildrenCount - 1 do + Result.Children[Index] := CloneNode(TTreeNode(Node.Children[Index]), Result); // recursive call +end; + +function TJclTree.CollectionEquals(const ACollection: IJclCollection): Boolean; +var + It, ItSelf: IJclIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTree.Contains(const AItem: T): Boolean; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + Result := NodeContains(FRoot, AItem) + else + Result := False; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTree.ContainsAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTree.Extract(const AItem: T): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FRoot <> nil; + if Result then + begin + It := First; + while It.HasNext do + if ItemsEqual(It.Next, AItem) then + begin + It.Extract; + if RemoveSingleElement then + Break; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTree.ExtractAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTree.ExtractNode(var ANode: TTreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TTreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + ExtractNode(TTreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + ExtractNode(ANode.Children[Index]); + {$ENDIF ~BCB} + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclTree.First: IJclIterator; +var + Start: TTreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := TPreOrderTreeIterator.Create(Self, Start, False, isFirst); + toPostOrder: + begin + if Start <> nil then + while (Start.ChildrenCount > 0) do + Start := TTreeNode(Start.Children[0]); + Result := TPostOrderTreeIterator.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclTree.GetEnumerator: IJclIterator; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclTree.GetRoot: IJclTreeIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + case GetTraverseOrder of + toPreOrder: + Result := TPreOrderTreeIterator.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := TPostOrderTreeIterator.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclTree.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclTree.Last: IJclIterator; +var + Start: TTreeNode; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while Start.ChildrenCount > 0 do + Start := TTreeNode(Start.Children[Start.ChildrenCount - 1]); + Result := TPreOrderTreeIterator.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := TPostOrderTreeIterator.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTree.NodeContains(ANode: TTreeNode; const AItem: T): Boolean; +var + Index: Integer; +begin + Result := ItemsEqual(ANode.Value, AItem); + if not Result then + for Index := 0 to ANode.ChildrenCount - 1 do + begin + Result := NodeContains(TTreeNode(ANode.Children[Index]), AItem); + if Result then + Break; + end; +end; + +procedure TJclTree.Pack; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if FRoot <> nil then + PackNode(FRoot); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTree.PackNode(ANode: TTreeNode); +var + Index: Integer; +begin + SetLength(ANode.Children, ANode.ChildrenCount); + for Index := 0 to ANode.ChildrenCount - 1 do + PackNode(TTreeNode(ANode.Children[Index])); +end; + +function TJclTree.Remove(const AItem: T): Boolean; +var + Extracted: T; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AItem); + if Result then + begin + Extracted := AItem; + FreeItem(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTree.RemoveAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTree.RemoveNode(var ANode: TTreeNode); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: TTreeNode; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + RemoveNode(TTreeNode(ANode.Children[Index])); + {$ELSE ~BCB} + RemoveNode(ANode.Children[Index]); + {$ENDIF ~BCB} + FreeItem(ANode.Value); + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function TJclTree.RetainAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTree.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclTree.Size: Integer; +begin + Result := FSize; +end; + +//=== { TJclTreeIterator } =========================================================== + +constructor TJclTreeIterator.Create(OwnTree: TJclTree; ACursor: TJclTreeNode; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnTree := OwnTree; + FStart := AStart; + FEqualityComparer := OwnTree as IJclEqualityComparer; +end; + +function TJclTreeIterator.Add(const AItem: T): Boolean; +var + ParentNode, NewNode: TJclTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // add sibling or, if FCursor is root node, behave like TJclTree.Add + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AItem, Default(T))) + and ((not FOwnTree.Contains(AItem)) or FOwnTree.CheckDuplicate); + + if Result then + begin + ParentNode := FCursor.Parent; + if ParentNode = nil then + ParentNode := FCursor; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclTreeNode.Create; + NewNode.Value := AItem; + NewNode.Parent := ParentNode; + ParentNode.Children[ParentNode.ChildrenCount] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.AddChild(const AItem: T): Boolean; +var + NewNode: TJclTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AItem, Default(T))) + and ((not FOwnTree.Contains(AItem)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclTreeNode.Create; + NewNode.Value := AItem; + NewNode.Parent := FCursor; + FCursor.Children[FCursor.ChildrenCount] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTreeIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclTreeIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclTreeIterator then + begin + ADest := TJclTreeIterator(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function TJclTreeIterator.ChildrenCount: Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.ChildrenCount + else + Result := 0; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTreeIterator.DeleteChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclTreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTreeIterator.DeleteChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.RemoveNode(TJclTreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTreeIterator.Extract; +var + OldCursor: TJclTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.ExtractNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTreeIterator.ExtractChild(Index: Integer); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclTreeNode(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTreeIterator.ExtractChildren; +var + Index: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.ExtractNode(TJclTreeNode(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.GetChild(Index: Integer): T; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := Default(T); + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + FCursor := TJclTreeNode(FCursor.Children[Index]); + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.GetItem: T; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := Default(T); + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.HasChild(Index: Integer): Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.HasNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.HasParent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.HasPrevious: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.IndexOfChild(const AItem: T): Integer; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if FCursor <> nil then + Result := FCursor.IndexOfValue(AItem, FEqualityComparer) + else + Result := -1; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.Insert(const AItem: T): Boolean; +var + ParentNode, NewNode: TJclTreeNode; + Index, I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclTree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AItem, Default(T))) + and ((not FOwnTree.Contains(AItem)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.Parent <> nil then + begin + ParentNode := FCursor.Parent; + Index := 0; + while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do + Inc(Index); + end + else + begin + ParentNode := FCursor; + Index := 0; + end; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := TJclTreeNode.Create; + NewNode.Value := AItem; + NewNode.Parent := ParentNode; + for I := ParentNode.ChildrenCount - 1 downto Index do + ParentNode.Children[I + 1] := ParentNode.Children[I]; + ParentNode.Children[Index] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.InsertChild(Index: Integer; const AItem: T): Boolean; +var + NewNode: TJclTreeNode; + I: Integer; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + // insert sibling or, if FCursor is root node, behave like TJclTree.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(AItem, Default(T))) + and ((not FOwnTree.Contains(AItem)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := TJclTreeNode.Create; + NewNode.Value := AItem; + NewNode.Parent := FCursor; + for I := FCursor.ChildrenCount - 1 downto Index do + FCursor.Children[I + 1] := FCursor.Children[I]; + FCursor.Children[Index] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.IteratorEquals(const AIterator: IJclIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclTreeIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclTreeIterator then + begin + ItrObj := TJclTreeIterator(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclTreeIterator.MoveNext: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclTreeIterator.Next: T; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := Default(T); + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function TJclTreeIterator.Parent: T; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Result := Default(T); + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.Previous: T; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := Default(T); + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function TJclTreeIterator.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure TJclTreeIterator.Remove; +var + OldCursor: TJclTreeNode; +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.RemoveNode(OldCursor); + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTreeIterator.Reset; +var + NewCursor: TJclTreeNode; +begin + {$IFDEF THREADSAFE} + FOwnTree.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTreeIterator.SetChild(Index: Integer; const AItem: T); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + TJclTreeNode(FCursor.Children[Index]).Value := AItem + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclTreeIterator.SetItem(const AItem: T); +begin + if FOwnTree.ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + FOwnTree.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + if FCursor <> nil then + begin + FOwnTree.FreeItem(FCursor.Value); + FCursor.Value := AItem; + end; + {$IFDEF THREADSAFE} + finally + FOwnTree.WriteUnlock; + end; + {$ENDIF THREADSAFE} +end; + +//=== { TJclPreOrderTreeIterator } =================================================== + +function TJclPreOrderTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPreOrderTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPreOrderTreeIterator.GetNextCursor: TJclTreeNode; +var + LastRet: TJclTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.ChildrenCount > 0 then + Result := TJclTreeNode(Result.Children[0]) + else + begin + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + end; +end; + +function TJclPreOrderTreeIterator.GetNextSibling: TJclTreeNode; +var + LastRet: TJclTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := TJclTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); +end; + +function TJclPreOrderTreeIterator.GetPreviousCursor: TJclTreeNode; +var + LastRet: TJclTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then + // come from Right + begin + Result := TJclTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + while (Result.ChildrenCount > 0) do // descend down the tree + Result := TJclTreeNode(Result.Children[Result.ChildrenCount - 1]); + end; +end; + +//=== { TJclPostOrderTreeIterator } ================================================== + +function TJclPostOrderTreeIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPostOrderTreeIterator.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function TJclPostOrderTreeIterator.GetNextCursor: TJclTreeNode; +var + LastRet: TJclTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclTreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderTreeIterator.GetNextSibling: TJclTreeNode; +var + LastRet: TJclTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := TJclTreeNode(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := TJclTreeNode(Result.Children[0]); + end; +end; + +function TJclPostOrderTreeIterator.GetPreviousCursor: TJclTreeNode; +var + LastRet: TJclTreeNode; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.ChildrenCount > 0 then + Result := TJclTreeNode(Result.Children[Result.ChildrenCount - 1]) + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := TJclTreeNode(Result.Children[Result.IndexOfChild(LastRet) - 1]); + end; +end; + +//=== { TJclTreeE } ======================================================= + +constructor TJclTreeE.Create(const AEqualityComparer: IJclEqualityComparer; AOwnsItems: Boolean); +begin + inherited Create(AOwnsItems); + FEqualityComparer := AEqualityComparer; +end; + +procedure TJclTreeE.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclTreeE then + TJclTreeE(Dest).FEqualityComparer := FEqualityComparer; +end; + +function TJclTreeE.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclTreeE.Create(EqualityComparer, False); + AssignPropertiesTo(Result); +end; + +function TJclTreeE.ItemsEqual(const A, B: T): Boolean; +begin + if EqualityComparer <> nil then + Result := EqualityComparer.ItemsEqual(A, B) + else + Result := inherited ItemsEqual(A, B); +end; + +//=== { TJclTreeF } ======================================================= + +constructor TJclTreeF.Create(ACompare: TCompare; AOwnsItems: Boolean); +begin + inherited Create(AOwnsItems); + SetCompare(ACompare); +end; + +function TJclTreeF.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclTreeF.Create(Compare, False); + AssignPropertiesTo(Result); +end; + +//=== { TJclTreeI } ======================================================= + +function TJclTreeI.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclTreeI.Create(False); + AssignPropertiesTo(Result); +end; + +function TJclTreeI.ItemsEqual(const A, B: T): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + Result := A.Equals(B); +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclUnicode.pas b/3rdParty/JCL/source/common/JclUnicode.pas index eadb5da4..c6e07a94 100644 --- a/3rdParty/JCL/source/common/JclUnicode.pas +++ b/3rdParty/JCL/source/common/JclUnicode.pas @@ -1,8195 +1,8195 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is JclUnicode.pas. } -{ } -{ The Initial Developer of the Original Code is Mike Lischke (public att lischke-online dott de). } -{ Portions created by Mike Lischke are Copyright (C) 1999-2000 Mike Lischke. All Rights Reserved. } -{ } -{ Contributor(s): } -{ Marcel van Brakel } -{ Andreas Hausladen (ahuser) } -{ Mike Lischke } -{ Flier Lu (flier) } -{ Robert Marquardt (marquardt) } -{ Robert Rossmair (rrossmair) } -{ Olivier Sannier (obones) } -{ Matthias Thoma (mthoma) } -{ Petr Vones (pvones) } -{ Peter Schraut (http://www.console-dev.de) } -{ Florent Ouchet (outchy) } -{ glchapman } -{ Markus Humm (mhumm) } -{ } -{**************************************************************************************************} -{ } -{ Various Unicode related routines } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -unit JclUnicode; - -{$I jcl.inc} - -// Copyright (c) 1999-2000 Mike Lischke (public att lischke-online dott de) -// - -// 10-JUL-2005: (changes by Peter Schraut) -// - added CodeBlockName, returns the blockname as string -// - added CodeBlockRange, returns the range of the specified codeblock -// - updated TUnicodeBlock to reflect changes in unicode 4.1 -// - updated CodeBlockFromChar to reflect changes in unicode 4.1 -// - Notes: -// Here are a few suggestions to reflect latest namechanges in unicode 4.1, -// but they were not done due to compatibility with old code: -// ubGreek should be renamed to ubGreekandCoptic -// ubCombiningMarksforSymbols should be renamed to ubCombiningDiacriticalMarksforSymbols -// ubPrivateUse should be renamed to ubPrivateUseArea -// -// -// 19-SEP-2003: (changes by Andreas Hausladen) -// - added OWN_WIDESTRING_MEMMGR for faster memory managment in TWideStringList -// under Windows -// - fixed: TWideStringList.Destroy does not set OnChange and OnChanging to nil before calling Clear -// -// -// 29-MAR-2002: MT -// - WideNormalize now returns strings with normalization mode nfNone unchanged. -// - Bug fix in WideCompose: Raised exception when Result of WideComposeHangul was an -// empty string. (#0000044) -// - Bug fix in WideAdjustLineBreaks -// - Added Asserts were needed. -// - TWideStrings.IndexOfName now takes care of NormalizeForm as well. -// - TWideStrings.IndexOf now takes care of NormalizeForm as well. -// - TWideString.List Find now uses the same NormalizationForm for the search string as it uses -// within the list itself. -// -// 29-NOV-2001: -// - bug fix -// 06-JUN-2001: -// - small changes -// 28-APR-2001: -// - bug fixes -// 05-APR-2001: -// - bug fixes -// 23-MAR-2001: -// - WideSameText -// - small changes -// 10-FEB-2001: -// - bug fix in StringToWideStringEx and WideStringToStringEx -// 05-FEB-2001: -// - TWideStrings.GetSeparatedText changed (no separator anymore after the last line) -// 29-JAN-2001: -// - PrepareUnicodeData -// - LoadInProgress critical section is now created at init time to avoid critical thread races -// - bug fixes -// 26-JAN-2001: -// - ExpandANSIString -// - TWideStrings.SaveUnicode is by default True now -// 20..21-JAN-2001: -// - StrUpperW, StrLowerW and StrTitleW removed because they potentially would need -// a reallocation to work correctly (use the WideString versions instead) -// - further improvements related to internal data -// - introduced TUnicodeBlock -// - CodeBlockFromChar improved -// 07-JAN-2001: -// optimized access to character properties, combining class etc. -// 06-JAN-2001: -// TWideStrings and TWideStringList improved -// APR-DEC 2000: versions 2.1 - 2.6 -// - preparation for public rlease -// - additional conversion routines -// - JCL compliance -// - character properties unified -// - character properties data and lookup improvements -// - reworked Unicode data resource file -// - improved simple string comparation routines (StrCompW, StrLCompW etc., include surrogate fix) -// - special case folding data for language neutral case insensitive comparations included -// - optimized decomposition -// - composition and normalization support -// - normalization conformance tests applied -// - bug fixes -// FEB-MAR 2000: version 2.0 -// - Unicode regular expressions (URE) search class (TURESearch) -// - generic search engine base class for both the Boyer-Moore and the RE search class -// - whole word only search in UTBM, bug fixes in UTBM -// - string decomposition (including hangul) -// OCT/99 - JAN/2000: version 1.0 -// - basic Unicode implementation, more than 100 WideString/UCS2 and UCS4 core functions -// - TWideStrings and TWideStringList classes -// - Unicode Tuned Boyer-Moore search class (TUTBMSearch) -// - low and high level Unicode/Wide* functions -// - low level Unicode UCS4 data import and functions -// - helper functions -// -// Version 2.9 -// This unit contains routines and classes to manage and work with Unicode/WideString strings. -// You need Delphi 4 or higher to compile this code. -// -// Publicly available low level functions are all preceded by "Unicode..." (e.g. -// in UnicodeToUpper) while the high level functions use the Str... or Wide... -// naming scheme (e.g. StrLICompW and WideUpperCase). -// -// The normalization implementation in this unit has successfully and completely passed the -// official normative conformance testing as of Annex 9 in Technical Report #15 -// (Unicode Standard Annex #15, http://www.unicode.org/unicode/reports/tr15, from 2000-08-31). -// -// Open issues: -// - Yet to do things in the URE class are: -// - check all character classes if they match correctly -// - optimize rebuild of DFA (build only when pattern changes) -// - set flag parameter of ExecuteURE -// - add \d any decimal digit -// \D any character that is not a decimal digit -// \s any whitespace character -// \S any character that is not a whitespace character -// \w any "word" character -// \W any "non-word" character -// - The wide string classes still compare text with functions provided by the -// particular system. This works usually fine under WinNT/W2K (although also -// there are limitations like maximum text lengths). Under Win9x conversions -// from and to MBCS are necessary which are bound to a particular locale and -// so very limited in general use. These comparisons should be changed so that -// the code in this unit is used. - -interface - -uses - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - {$IFDEF HAS_UNITSCOPE} - {$IFDEF MSWINDOWS} - Winapi.Windows, - {$ENDIF MSWINDOWS} - System.SysUtils, System.Classes, - {$IFDEF HAS_UNIT_CHARACTER} - System.Character, - {$ENDIF HAS_UNIT_CHARACTER} - {$ELSE ~HAS_UNITSCOPE} - {$IFDEF MSWINDOWS} - Windows, - {$ENDIF MSWINDOWS} - SysUtils, Classes, - {$IFDEF HAS_UNIT_CHARACTER} - Character, - {$ENDIF HAS_UNIT_CHARACTER} - {$ENDIF ~HAS_UNITSCOPE} - JclBase; - -{$IFNDEF FPC} - {$IFDEF MSWINDOWS} - {$DEFINE OWN_WIDESTRING_MEMMGR} - {$ENDIF MSWINDOWS} -{$ENDIF ~FPC} - -const - // definitions of often used characters: - // Note: Use them only for tests of a certain character not to determine character - // classes (like white spaces) as in Unicode are often many code points defined - // being in a certain class. Hence your best option is to use the various - // UnicodeIs* functions. - WideNull = WideChar(#0); - WideTabulator = WideChar(#9); - WideSpace = WideChar(#32); - - // logical line breaks - WideLF = WideChar(#10); - WideLineFeed = WideChar(#10); - WideVerticalTab = WideChar(#11); - WideFormFeed = WideChar(#12); - WideCR = WideChar(#13); - WideCarriageReturn = WideChar(#13); - WideCRLF = WideString(#13#10); - WideLineSeparator = WideChar($2028); - WideParagraphSeparator = WideChar($2029); - - // byte order marks for Unicode files - // Unicode text files (in UTF-16 format) should contain $FFFE as first character to - // identify such a file clearly. Depending on the system where the file was created - // on this appears either in big endian or little endian style. - BOM_LSB_FIRST = WideChar($FEFF); - BOM_MSB_FIRST = WideChar($FFFE); - -type - TSaveFormat = ( sfUTF16LSB, sfUTF16MSB, sfUTF8, sfAnsi ); - -const - sfUnicodeLSB = sfUTF16LSB; - sfUnicodeMSB = sfUTF16MSB; - -type - // various predefined or otherwise useful character property categories - TCharacterCategory = ( - // normative categories - ccLetterUppercase, - ccLetterLowercase, - ccLetterTitlecase, - ccMarkNonSpacing, - ccMarkSpacingCombining, - ccMarkEnclosing, - ccNumberDecimalDigit, - ccNumberLetter, - ccNumberOther, - ccSeparatorSpace, - ccSeparatorLine, - ccSeparatorParagraph, - ccOtherControl, - ccOtherFormat, - ccOtherSurrogate, - ccOtherPrivate, - ccOtherUnassigned, - // informative categories - ccLetterModifier, - ccLetterOther, - ccPunctuationConnector, - ccPunctuationDash, - ccPunctuationOpen, - ccPunctuationClose, - ccPunctuationInitialQuote, - ccPunctuationFinalQuote, - ccPunctuationOther, - ccSymbolMath, - ccSymbolCurrency, - ccSymbolModifier, - ccSymbolOther, - // bidirectional categories - ccLeftToRight, - ccLeftToRightEmbedding, - ccLeftToRightOverride, - ccRightToLeft, - ccRightToLeftArabic, - ccRightToLeftEmbedding, - ccRightToLeftOverride, - ccPopDirectionalFormat, - ccEuropeanNumber, - ccEuropeanNumberSeparator, - ccEuropeanNumberTerminator, - ccArabicNumber, - ccCommonNumberSeparator, - ccBoundaryNeutral, - ccSegmentSeparator, // this includes tab and vertical tab - ccWhiteSpace, // Separator characters and control characters which should be treated by programming languages as "white space" for the purpose of parsing elements. - ccOtherNeutrals, - ccLeftToRightIsolate, - ccRightToLeftIsolate, - ccFirstStrongIsolate, - ccPopDirectionalIsolate, - // self defined categories, they do not appear in the Unicode data file - ccComposed, // can be decomposed - ccNonBreaking, - ccSymmetric, // has left and right forms - ccHexDigit, // Characters commonly used for the representation of hexadecimal numbers, plus their compatibility equivalents. - ccQuotationMark, // Punctuation characters that function as quotation marks. - ccMirroring, - ccAssigned, // means there is a definition in the Unicode standard - ccASCIIHexDigit, // ASCII characters commonly used for the representation of hexadecimal numbers - ccBidiControl, // Format control characters which have specific functions in the Unicode Bidirectional Algorithm [UAX9]. - ccDash, // Punctuation characters explicitly called out as dashes in the Unicode Standard, plus their compatibility equivalents. Most of these have the General_Category value Pd, but some have the General_Category value Sm because of their use in mathematics. - ccDeprecated, // For a machine-readable list of deprecated characters. No characters will ever be removed from the standard, but the usage of deprecated characters is strongly discouraged. - ccDiacritic, // Characters that linguistically modify the meaning of another character to which they apply. Some diacritics are not combining characters, and some combining characters are not diacritics. - ccExtender, // Characters whose principal function is to extend the value or shape of a preceding alphabetic character. Typical of these are length and iteration marks. - ccHyphen, // Dashes which are used to mark connections between pieces of words, plus the Katakana middle dot. The Katakana middle dot functions like a hyphen, but is shaped like a dot rather than a dash. - ccIdeographic, // Characters considered to be CJKV (Chinese, Japanese, Korean, and Vietnamese) ideographs. - ccIDSBinaryOperator, // Used in Ideographic Description Sequences. - ccIDSTrinaryOperator, // Used in Ideographic Description Sequences. - ccJoinControl, // Format control characters which have specific functions for control of cursive joining and ligation. - ccLogicalOrderException, // There are a small number of characters that do not use logical order. These characters require special handling in most processing. - ccNonCharacterCodePoint, // Code points permanently reserved for internal use. - ccOtherAlphabetic, // Used in deriving the Alphabetic property. - ccOtherDefaultIgnorableCodePoint, // Used in deriving the Default_Ignorable_Code_Point property. - ccOtherGraphemeExtend, // Used in deriving the Grapheme_Extend property. - ccOtherIDContinue, // Used for backward compatibility of ID_Continue. - ccOtherIDStart, // Used for backward compatibility of ID_Start. - ccOtherLowercase, // Used in deriving the Lowercase property. - ccOtherMath, // Used in deriving the Math property. - ccOtherUppercase, // Used in deriving the Uppercase property. - ccPatternSyntax, // Used for pattern syntax as described in UAX #31: Unicode Identifier and Pattern Syntax [UAX31]. - ccPatternWhiteSpace, - ccRadical, // Used in Ideographic Description Sequences. - ccSoftDotted, // Characters with a "soft dot", like i or j. An accent placed on these characters causes the dot to disappear. An explicit dot above can be added where required, such as in Lithuanian. - ccSTerm, // Sentence Terminal. Used in UAX #29: Unicode Text Segmentation [UAX29]. - ccTerminalPunctuation, // Punctuation characters that generally mark the end of textual units. - ccUnifiedIdeograph, // Used in Ideographic Description Sequences. - ccVariationSelector, // Indicates characters that are Variation Selectors. For details on the behavior of these characters, see StandardizedVariants.html, Section 16.4, "Variation Selectors" in [Unicode], and the Unicode Ideographic Variation Database [UTS37]. - ccSentenceTerminal, // Characters used at the end of a sentence - ccPrependedQuotationMark, - ccRegionalIndicator - ); - TCharacterCategories = set of TCharacterCategory; - -{$IFDEF HAS_UNIT_CHARACTER} -type - TCharacterUnicodeCategory = ccLetterUppercase..ccSymbolOther; - -const - CharacterCategoryToUnicodeCategory: array [TCharacterUnicodeCategory] of TUnicodeCategory = - ( TUnicodeCategory.ucUppercaseLetter, // ccLetterUppercase - TUnicodeCategory.ucLowercaseLetter, // ccLetterLowercase - TUnicodeCategory.ucTitlecaseLetter, // ccLetterTitlecase - TUnicodeCategory.ucNonSpacingMark, // ccMarkNonSpacing - TUnicodeCategory.ucCombiningMark, // ccMarkSpacingCombining - TUnicodeCategory.ucEnclosingMark, // ccMarkEnclosing - TUnicodeCategory.ucDecimalNumber, // ccNumberDecimalDigit - TUnicodeCategory.ucLetterNumber, // ccNumberLetter - TUnicodeCategory.ucOtherNumber, // ccNumberOther - TUnicodeCategory.ucSpaceSeparator, // ccSeparatorSpace - TUnicodeCategory.ucLineSeparator, // ccSeparatorLine - TUnicodeCategory.ucParagraphSeparator, // ccSeparatorParagraph - TUnicodeCategory.ucControl, // ccOtherControl - TUnicodeCategory.ucFormat, // ccOtherFormat - TUnicodeCategory.ucSurrogate, // ccOtherSurrogate - TUnicodeCategory.ucPrivateUse, // ccOtherPrivate - TUnicodeCategory.ucUnassigned, // ccOtherUnassigned - TUnicodeCategory.ucModifierLetter, // ccLetterModifier - TUnicodeCategory.ucOtherLetter, // ccLetterOther - TUnicodeCategory.ucConnectPunctuation, // ccPunctuationConnector - TUnicodeCategory.ucDashPunctuation, // ccPunctuationDash - TUnicodeCategory.ucOpenPunctuation, // ccPunctuationOpen - TUnicodeCategory.ucClosePunctuation, // ccPunctuationClose - TUnicodeCategory.ucInitialPunctuation, // ccPunctuationInitialQuote - TUnicodeCategory.ucFinalPunctuation, // ccPunctuationFinalQuote - TUnicodeCategory.ucOtherPunctuation, // ccPunctuationOther - TUnicodeCategory.ucMathSymbol, // ccSymbolMath - TUnicodeCategory.ucCurrencySymbol, // ccSymbolCurrency - TUnicodeCategory.ucModifierSymbol, // ccSymbolModifier - TUnicodeCategory.ucOtherSymbol ); // ccSymbolOther - - UnicodeCategoryToCharacterCategory: array [TUnicodeCategory] of TCharacterCategory = - ( ccOtherControl, // ucControl - ccOtherFormat, // ucFormat - ccOtherUnassigned, // ucUnassigned - ccOtherPrivate, // ucPrivateUse - ccOtherSurrogate, // ucSurrogate - ccLetterLowercase, // ucLowercaseLetter - ccLetterModifier, // ucModifierLetter - ccLetterOther, // ucOtherLetter - ccLetterTitlecase, // ucTitlecaseLetter - ccLetterUppercase, // ucUppercaseLetter - ccMarkSpacingCombining, // ucCombiningMark - ccMarkEnclosing, // ucEnclosingMark - ccMarkNonSpacing, // ucNonSpacingMark - ccNumberDecimalDigit, // ucDecimalNumber - ccNumberLetter, // ucLetterNumber - ccNumberOther, // ucOtherNumber - ccPunctuationConnector, // ucConnectPunctuation - ccPunctuationDash, // ucDashPunctuation - ccPunctuationClose, // ucClosePunctuation - ccPunctuationFinalQuote, // ucFinalPunctuation - ccPunctuationInitialQuote, // ucInitialPunctuation - ccPunctuationOther, // ucOtherPunctuation - ccPunctuationOpen, // ucOpenPunctuation - ccSymbolCurrency, // ucCurrencySymbol - ccSymbolModifier, // ucModifierSymbol - ccSymbolMath, // ucMathSymbol - ccSymbolOther, // ucOtherSymbol - ccSeparatorLine, // ucLineSeparator - ccSeparatorParagraph, // ucParagraphSeparator - ccSeparatorSpace ); // ucSpaceSeparator - -function CharacterCategoriesToUnicodeCategory(const Categories: TCharacterCategories): TUnicodeCategory; -function UnicodeCategoryToCharacterCategories(Category: TUnicodeCategory): TCharacterCategories; -{$ENDIF HAS_UNIT_CHARACTER} - -type - // four forms of normalization are defined: - TNormalizationForm = ( - nfNone, // do not normalize - nfC, // canonical decomposition followed by canonical composition (this is most often used) - nfD, // canonical decomposition - nfKC, // compatibility decomposition followed by a canonical composition - nfKD // compatibility decomposition - ); - - // 16 compatibility formatting tags are defined: - TCompatibilityFormattingTag = ( - cftCanonical, // default when no CFT is explicited - cftFont, // Font variant (for example, a blackletter form) - cftNoBreak, // No-break version of a space or hyphen - cftInitial, // Initial presentation form (Arabic) - cftMedial, // Medial presentation form (Arabic) - cftFinal, // Final presentation form (Arabic) - cftIsolated, // Isolated presentation form (Arabic) - cftCircle, // Encircled form - cftSuper, // Superscript form - cftSub, // Subscript form - cftVertical, // Vertical layout presentation form - cftWide, // Wide (or zenkaku) compatibility character - cftNarrow, // Narrow (or hankaku) compatibility character - cftSmall, // Small variant form (CNS compatibility) - cftSquare, // CJK squared font variant - cftFraction, // Vulgar fraction form - cftCompat // Otherwise unspecified compatibility character - ); - TCompatibilityFormattingTags = set of TCompatibilityFormattingTag; - - // used to hold information about the start and end - // position of a unicodeblock. - TUnicodeBlockRange = record - RangeStart, - RangeEnd: Cardinal; - end; - - // An Unicode block usually corresponds to a particular language script but - // can also represent special characters, musical symbols and the like. - // https://www.unicode.org/charts/ - TUnicodeBlock = ( - ubUndefined, - ubBasicLatin, - ubLatin1Supplement, - ubLatinExtendedA, - ubLatinExtendedB, - ubIPAExtensions, - ubSpacingModifierLetters, - ubCombiningDiacriticalMarks, - ubGreekandCoptic, - ubCyrillic, - ubCyrillicSupplement, - ubArmenian, - ubHebrew, - ubArabic, - ubSyriac, - ubArabicSupplement, - ubThaana, - ubNKo, - ubSamaritan, - ubMandaic, - ubSyriacSupplement, - ubArabicExtendedA, - ubDevanagari, - ubBengali, - ubGurmukhi, - ubGujarati, - ubOriya, - ubTamil, - ubTelugu, - ubKannada, - ubMalayalam, - ubSinhala, - ubThai, - ubLao, - ubTibetan, - ubMyanmar, - ubGeorgian, - ubHangulJamo, - ubEthiopic, - ubEthiopicSupplement, - ubCherokee, - ubUnifiedCanadianAboriginalSyllabics, - ubOgham, - ubRunic, - ubTagalog, - ubHanunoo, - ubBuhid, - ubTagbanwa, - ubKhmer, - ubMongolian, - ubUnifiedCanadianAboriginalSyllabicsExtended, - ubLimbu, - ubTaiLe, - ubNewTaiLue, - ubKhmerSymbols, - ubBuginese, - ubTaiTham, - ubCombiningDiactiticalMarksExtended, - ubBalinese, - ubSundanese, - ubBatak, - ubLepcha, - ubOlChiki, - ubCyrillicExtendedC, - ubGeorgianExtended, - ubSundaneseSupplement, - ubVedicExtensions, - ubPhoneticExtensions, - ubPhoneticExtensionsSupplement, - ubCombiningDiacriticalMarksSupplement, - ubLatinExtendedAdditional, - ubGreekExtended, - ubGeneralPunctuation, - ubSuperscriptsandSubscripts, - ubCurrencySymbols, - ubCombiningDiacriticalMarksforSymbols, - ubLetterlikeSymbols, - ubNumberForms, - ubArrows, - ubMathematicalOperators, - ubMiscellaneousTechnical, - ubControlPictures, - ubOpticalCharacterRecognition, - ubEnclosedAlphanumerics, - ubBoxDrawing, - ubBlockElements, - ubGeometricShapes, - ubMiscellaneousSymbols, - ubDingbats, - ubMiscellaneousMathematicalSymbolsA, - ubSupplementalArrowsA, - ubBraillePatterns, - ubSupplementalArrowsB, - ubMiscellaneousMathematicalSymbolsB, - ubSupplementalMathematicalOperators, - ubMiscellaneousSymbolsandArrows, - ubGlagolitic, - ubLatinExtendedC, - ubCoptic, - ubGeorgianSupplement, - ubTifinagh, - ubEthiopicExtended, - ubCyrillicExtendedA, - ubSupplementalPunctuation, - ubCJKRadicalsSupplement, - ubKangxiRadicals, - ubIdeographicDescriptionCharacters, - ubCJKSymbolsandPunctuation, - ubHiragana, - ubKatakana, - ubBopomofo, - ubHangulCompatibilityJamo, - ubKanbun, - ubBopomofoExtended, - ubCJKStrokes, - ubKatakanaPhoneticExtensions, - ubEnclosedCJKLettersandMonths, - ubCJKCompatibility, - ubCJKUnifiedIdeographsExtensionA, - ubYijingHexagramSymbols, - ubCJKUnifiedIdeographs, - ubYiSyllables, - ubYiRadicals, - ubLisu, - ubVai, - ubCyrillicExtendedB, - ubBamum, - ubModifierToneLetters, - ubLatinExtendedD, - ubSylotiNagri, - ubCommonIndicNumberForms, - ubPhagsPa, - ubSaurashtra, - ubDevanagariExtended, - ubKayahLi, - ubRejang, - ubHangulJamoExtendedA, - ubJavanese, - ubMyanmarExtendedB, - ubCham, - ubMyanmarExtendedA, - ubTaiViet, - ubMeeteiMayekExtensions, - ubEthiopicExtendedA, - ubLatinExtendedE, - ubCherokeeSupplement, - ubMeeteiMayek, - ubHangulSyllables, - ubHangulJamoExtendedB, - ubHighSurrogates, - ubHighPrivateUseSurrogates, - ubLowSurrogates, - ubPrivateUseArea, - ubCJKCompatibilityIdeographs, - ubAlphabeticPresentationForms, - ubArabicPresentationFormsA, - ubVariationSelectors, - ubVerticalForms, - ubCombiningHalfMarks, - ubCJKCompatibilityForms, - ubSmallFormVariants, - ubArabicPresentationFormsB, - ubHalfwidthandFullwidthForms, - ubSpecials, - ubLinearBSyllabary, - ubLinearBIdeograms, - ubAegeanNumbers, - ubAncientGreekNumbers, - ubAncientSymbols, - ubPhaistosDisc, - ubLycian, - ubCarian, - ubCopticEpactNumbers, - ubOldItalic, - ubGothic, - ubOldPermic, - ubUgaritic, - ubOldPersian, - ubDeseret, - ubShavian, - ubOsmanya, - ubOsage, - ubElbasan, - ubCaucasianAlbanian, - ubLinearA, - ubCypriotSyllabary, - ubImperialAramaic, - ubPalmyrene, - ubNabataean, - ubHatran, - ubPhoenician, - ubLydian, - ubMeroiticHieroglyphs, - ubMeroiticCursive, - ubKharoshthi, - ubOldSouthArabian, - ubOldNorthArabian, - ubManichaean, - ubAvestan, - ubInscriptionalParthian, - ubInscriptionalPahlavi, - ubPsalterPahlavi, - ubOldTurkic, - ubOldHungarian, - ubHanifiRohingya, - ubRumiNumeralSymbols, - ubYezidi, - ubOldSogdian, - ubSogdian, - ubChorasmian, - ubElymaic, - ubBrahmi, - ubKaithi, - ubSoraSompeng, - ubChakma, - ubMahajani, - ubSharada, - ubSinhalaArchaicNumbers, - ubKhojki, - ubMultani, - ubKhudawadi, - ubGrantha, - ubNewa, - ubTirhuta, - ubSiddam, - ubModi, - ubMongolianSupplement, - ubTakri, - ubAhom, - ubDogra, - ubWarangCiti, - ubDivesAkuru, - ubNandinagari, - ubZanabazarSquare, - ubSoyombo, - ubPauCinHau, - ubBhaiksuki, - ubMarchen, - ubMasaramGondi, - ubGunjalaGondi, - ubTamilSupplement, - ubMakasar, - ubLisuSupplement, - ubCuneiform, - ubCuneiformNumbersAndPunctuation, - ubEarlyDynasticCuneiform, - ubEgyptianHieroglyphs, - ubEgyptianHieroglyphFormatControls, - ubAnatolianHieroglyphs, - ubBamumSupplement, - ubMro, - ubBassaVah, - ubPahawhHmong, - ubMedefaidrin, - ubMiao, - upIdeographicSymbolsAndPunctuation, - ubTangut, - ubTangutComponents, - ubKhitanSmallScript, - ubTangutSupplement, - ubKanaSupplement, - ubKanaExtendedA, - ubSmallKanaExtension, - ubNushu, - ubDuployan, - ubShorthandFormatControls, - ubByzantineMusicalSymbols, - ubMusicalSymbols, - ubAncientGreekMusicalNotation, - ubMayanNumerals, - ubTaiXuanJingSymbols, - ubCountingRodNumerals, - ubSuttonSignWriting, - ubMathematicalAlphanumericSymbols, - ubGlagolithicSupplement, - ubWancho, - ubNyiakengPuachueHmong, - ubMendeKikakui, - ubIndicSiyaqNumbers, - ubOttomanSiyaqNumbers, - ubAdlam, - ubArabicMathematicalAlphabeticSymbols, - ubMahjongTiles, - ubDominoTiles, - ubPlayingCards, - ubEnclosedAlphanumericSupplement, - ubEnclosedIdeographicSupplement, - ubMiscellaneousSymbolsAndPictographs, - ubEmoticons, - ubOrnamentalDingbats, - ubTransportAndMapSymbols, - ubAlchemicalSymbols, - ubGeometricShapesExtended, - ubSupplementalArrowsC, - ubSupplementalSymbolsAndPictographs, - ubChessSymbols, - ubSymbolsAndPictographsExtendedA, - ubSymbolsForLegacyComputing, - ubCJKUnifiedIdeographsExtensionB, - ubCJKUnifiedIdeographsExtensionC, - ubCJKUnifiedIdeographsExtensionD, - ubCJKUnifiedIdeographsExtensionE, - ubCJKUnifiedIdeographsExtensionF, - ubCJKCompatibilityIdeographsSupplement, - ubCJKUnifiedIdeographsExtensionG, - ubTags, - ubVariationSelectorsSupplement, - ubSupplementaryPrivateUseAreaA, - ubSupplementaryPrivateUseAreaB - ); - - TUnicodeBlockData = record - Range: TUnicodeBlockRange; - Name: string; - end; - PUnicodeBlockData = ^TUnicodeBlockData; - -const - UnicodeBlockData: array [TUnicodeBlock] of TUnicodeBlockData = - ((Range:(RangeStart: $FFFFFFFF; RangeEnd: $0000); Name: 'No-block'), - (Range:(RangeStart: $0000; RangeEnd: $007F); Name: 'Basic Latin'), - (Range:(RangeStart: $0080; RangeEnd: $00FF); Name: 'Latin-1 Supplement'), - (Range:(RangeStart: $0100; RangeEnd: $017F); Name: 'Latin Extended-A'), - (Range:(RangeStart: $0180; RangeEnd: $024F); Name: 'Latin Extended-B'), - (Range:(RangeStart: $0250; RangeEnd: $02AF); Name: 'IPA Extensions'), - (Range:(RangeStart: $02B0; RangeEnd: $02FF); Name: 'Spacing Modifier Letters'), - (Range:(RangeStart: $0300; RangeEnd: $036F); Name: 'Combining Diacritical Marks'), - (Range:(RangeStart: $0370; RangeEnd: $03FF); Name: 'Greek and Coptic'), - (Range:(RangeStart: $0400; RangeEnd: $04FF); Name: 'Cyrillic'), - (Range:(RangeStart: $0500; RangeEnd: $052F); Name: 'Cyrillic Supplement'), - (Range:(RangeStart: $0530; RangeEnd: $058F); Name: 'Armenian'), - (Range:(RangeStart: $0590; RangeEnd: $05FF); Name: 'Hebrew'), - (Range:(RangeStart: $0600; RangeEnd: $06FF); Name: 'Arabic'), - (Range:(RangeStart: $0700; RangeEnd: $074F); Name: 'Syriac'), - (Range:(RangeStart: $0750; RangeEnd: $077F); Name: 'Arabic Supplement'), - (Range:(RangeStart: $0780; RangeEnd: $07BF); Name: 'Thaana'), - (Range:(RangeStart: $07C0; RangeEnd: $07FF); Name: 'NKo'), - (Range:(RangeStart: $0800; RangeEnd: $083F); Name: 'Samaritan'), - (Range:(RangeStart: $0840; RangeEnd: $085F); Name: 'Mandaic'), - (Range:(RangeStart: $0860; RangeEnd: $086F); Name: 'Syriac Supplement'), - (Range:(RangeStart: $08A0; RangeEnd: $08FF); Name: 'Arabic Extended-A'), - (Range:(RangeStart: $0900; RangeEnd: $097F); Name: 'Devanagari'), - (Range:(RangeStart: $0980; RangeEnd: $09FF); Name: 'Bengali'), - (Range:(RangeStart: $0A00; RangeEnd: $0A7F); Name: 'Gurmukhi'), - (Range:(RangeStart: $0A80; RangeEnd: $0AFF); Name: 'Gujarati'), - (Range:(RangeStart: $0B00; RangeEnd: $0B7F); Name: 'Oriya'), - (Range:(RangeStart: $0B80; RangeEnd: $0BFF); Name: 'Tamil'), - (Range:(RangeStart: $0C00; RangeEnd: $0C7F); Name: 'Telugu'), - (Range:(RangeStart: $0C80; RangeEnd: $0CFF); Name: 'Kannada'), - (Range:(RangeStart: $0D00; RangeEnd: $0D7F); Name: 'Malayalam'), - (Range:(RangeStart: $0D80; RangeEnd: $0DFF); Name: 'Sinhala'), - (Range:(RangeStart: $0E00; RangeEnd: $0E7F); Name: 'Thai'), - (Range:(RangeStart: $0E80; RangeEnd: $0EFF); Name: 'Lao'), - (Range:(RangeStart: $0F00; RangeEnd: $0FFF); Name: 'Tibetan'), - (Range:(RangeStart: $1000; RangeEnd: $109F); Name: 'Myanmar'), - (Range:(RangeStart: $10A0; RangeEnd: $10FF); Name: 'Georgian'), - (Range:(RangeStart: $1100; RangeEnd: $11FF); Name: 'Hangul Jamo'), - (Range:(RangeStart: $1200; RangeEnd: $137F); Name: 'Ethiopic'), - (Range:(RangeStart: $1380; RangeEnd: $139F); Name: 'Ethiopic Supplement'), - (Range:(RangeStart: $13A0; RangeEnd: $13FF); Name: 'Cherokee'), - (Range:(RangeStart: $1400; RangeEnd: $167F); Name: 'Unified Canadian Aboriginal Syllabics'), - (Range:(RangeStart: $1680; RangeEnd: $169F); Name: 'Ogham'), - (Range:(RangeStart: $16A0; RangeEnd: $16FF); Name: 'Runic'), - (Range:(RangeStart: $1700; RangeEnd: $171F); Name: 'Tagalog'), - (Range:(RangeStart: $1720; RangeEnd: $173F); Name: 'Hanunoo'), - (Range:(RangeStart: $1740; RangeEnd: $175F); Name: 'Buhid'), - (Range:(RangeStart: $1760; RangeEnd: $177F); Name: 'Tagbanwa'), - (Range:(RangeStart: $1780; RangeEnd: $17FF); Name: 'Khmer'), - (Range:(RangeStart: $1800; RangeEnd: $18AF); Name: 'Mongolian'), - (Range:(RangeStart: $18B0; RangeEnd: $18FF); Name: 'Unified Canadian Aboriginal Syllabics Extended'), - (Range:(RangeStart: $1900; RangeEnd: $194F); Name: 'Limbu'), - (Range:(RangeStart: $1950; RangeEnd: $197F); Name: 'Tai Le'), - (Range:(RangeStart: $1980; RangeEnd: $19DF); Name: 'New Tai Lue'), - (Range:(RangeStart: $19E0; RangeEnd: $19FF); Name: 'Khmer Symbols'), - (Range:(RangeStart: $1A00; RangeEnd: $1A1F); Name: 'Buginese'), - (Range:(RangeStart: $1A20; RangeEnd: $1AAF); Name: 'Tai Tham'), - (Range:(RangeStart: $1AB0; RangeEnd: $1AFF); Name: 'Combining Diacritical Marks Extended'), - (Range:(RangeStart: $1B00; RangeEnd: $1B7F); Name: 'Balinese'), - (Range:(RangeStart: $1B80; RangeEnd: $1BBF); Name: 'Sundanese'), - (Range:(RangeStart: $1BC0; RangeEnd: $1BFF); Name: 'Batak'), - (Range:(RangeStart: $1C00; RangeEnd: $1C4F); Name: 'Lepcha'), - (Range:(RangeStart: $1C50; RangeEnd: $1C7F); Name: 'Ol Chiki'), - (Range:(RangeStart: $1C80; RangeEnd: $1C8F); Name: 'Cyrillic Extended-C'), - (Range:(RangeStart: $1C90; RangeEnd: $1CBF); Name: 'Georgian Extended'), - (Range:(RangeStart: $1CC0; RangeEnd: $1CCF); Name: 'Sundanese Supplement'), - (Range:(RangeStart: $1CD0; RangeEnd: $1CFF); Name: 'Vedic Extensions'), - (Range:(RangeStart: $1D00; RangeEnd: $1D7F); Name: 'Phonetic Extensions'), - (Range:(RangeStart: $1D80; RangeEnd: $1DBF); Name: 'Phonetic Extensions Supplement'), - (Range:(RangeStart: $1DC0; RangeEnd: $1DFF); Name: 'Combining Diacritical Marks Supplement'), - (Range:(RangeStart: $1E00; RangeEnd: $1EFF); Name: 'Latin Extended Additional'), - (Range:(RangeStart: $1F00; RangeEnd: $1FFF); Name: 'Greek Extended'), - (Range:(RangeStart: $2000; RangeEnd: $206F); Name: 'General Punctuation'), - (Range:(RangeStart: $2070; RangeEnd: $209F); Name: 'Superscripts and Subscripts'), - (Range:(RangeStart: $20A0; RangeEnd: $20CF); Name: 'Currency Symbols'), - (Range:(RangeStart: $20D0; RangeEnd: $20FF); Name: 'Combining Diacritical Marks for Symbols'), - (Range:(RangeStart: $2100; RangeEnd: $214F); Name: 'Letterlike Symbols'), - (Range:(RangeStart: $2150; RangeEnd: $218F); Name: 'Number Forms'), - (Range:(RangeStart: $2190; RangeEnd: $21FF); Name: 'Arrows'), - (Range:(RangeStart: $2200; RangeEnd: $22FF); Name: 'Mathematical Operators'), - (Range:(RangeStart: $2300; RangeEnd: $23FF); Name: 'Miscellaneous Technical'), - (Range:(RangeStart: $2400; RangeEnd: $243F); Name: 'Control Pictures'), - (Range:(RangeStart: $2440; RangeEnd: $245F); Name: 'Optical Character Recognition'), - (Range:(RangeStart: $2460; RangeEnd: $24FF); Name: 'Enclosed Alphanumerics'), - (Range:(RangeStart: $2500; RangeEnd: $257F); Name: 'Box Drawing'), - (Range:(RangeStart: $2580; RangeEnd: $259F); Name: 'Block Elements'), - (Range:(RangeStart: $25A0; RangeEnd: $25FF); Name: 'Geometric Shapes'), - (Range:(RangeStart: $2600; RangeEnd: $26FF); Name: 'Miscellaneous Symbols'), - (Range:(RangeStart: $2700; RangeEnd: $27BF); Name: 'Dingbats'), - (Range:(RangeStart: $27C0; RangeEnd: $27EF); Name: 'Miscellaneous Mathematical Symbols-A'), - (Range:(RangeStart: $27F0; RangeEnd: $27FF); Name: 'Supplemental Arrows-A'), - (Range:(RangeStart: $2800; RangeEnd: $28FF); Name: 'Braille Patterns'), - (Range:(RangeStart: $2900; RangeEnd: $297F); Name: 'Supplemental Arrows-B'), - (Range:(RangeStart: $2980; RangeEnd: $29FF); Name: 'Miscellaneous Mathematical Symbols-B'), - (Range:(RangeStart: $2A00; RangeEnd: $2AFF); Name: 'Supplemental Mathematical Operators'), - (Range:(RangeStart: $2B00; RangeEnd: $2BFF); Name: 'Miscellaneous Symbols and Arrows'), - (Range:(RangeStart: $2C00; RangeEnd: $2C5F); Name: 'Glagolitic'), - (Range:(RangeStart: $2C60; RangeEnd: $2C7F); Name: 'Latin Extended-C'), - (Range:(RangeStart: $2C80; RangeEnd: $2CFF); Name: 'Coptic'), - (Range:(RangeStart: $2D00; RangeEnd: $2D2F); Name: 'Georgian Supplement'), - (Range:(RangeStart: $2D30; RangeEnd: $2D7F); Name: 'Tifinagh'), - (Range:(RangeStart: $2D80; RangeEnd: $2DDF); Name: 'Ethiopic Extended'), - (Range:(RangeStart: $2DE0; RangeEnd: $2DFF); Name: 'Cyrillic Extended-A'), - (Range:(RangeStart: $2E00; RangeEnd: $2E7F); Name: 'Supplemental Punctuation'), - (Range:(RangeStart: $2E80; RangeEnd: $2EFF); Name: 'CJK Radicals Supplement'), - (Range:(RangeStart: $2F00; RangeEnd: $2FDF); Name: 'Kangxi Radicals'), - (Range:(RangeStart: $2FF0; RangeEnd: $2FFF); Name: 'Ideographic Description Characters'), - (Range:(RangeStart: $3000; RangeEnd: $303F); Name: 'CJK Symbols and Punctuation'), - (Range:(RangeStart: $3040; RangeEnd: $309F); Name: 'Hiragana'), - (Range:(RangeStart: $30A0; RangeEnd: $30FF); Name: 'Katakana'), - (Range:(RangeStart: $3100; RangeEnd: $312F); Name: 'Bopomofo'), - (Range:(RangeStart: $3130; RangeEnd: $318F); Name: 'Hangul Compatibility Jamo'), - (Range:(RangeStart: $3190; RangeEnd: $319F); Name: 'Kanbun'), - (Range:(RangeStart: $31A0; RangeEnd: $31BF); Name: 'Bopomofo Extended'), - (Range:(RangeStart: $31C0; RangeEnd: $31EF); Name: 'CJK Strokes'), - (Range:(RangeStart: $31F0; RangeEnd: $31FF); Name: 'Katakana Phonetic Extensions'), - (Range:(RangeStart: $3200; RangeEnd: $32FF); Name: 'Enclosed CJK Letters and Months'), - (Range:(RangeStart: $3300; RangeEnd: $33FF); Name: 'CJK Compatibility'), - (Range:(RangeStart: $3400; RangeEnd: $4DBF); Name: 'CJK Unified Ideographs Extension A'), - (Range:(RangeStart: $4DC0; RangeEnd: $4DFF); Name: 'Yijing Hexagram Symbols'), - (Range:(RangeStart: $4E00; RangeEnd: $9FFC); Name: 'CJK Unified Ideographs'), - (Range:(RangeStart: $A000; RangeEnd: $A48F); Name: 'Yi Syllables'), - (Range:(RangeStart: $A490; RangeEnd: $A4CF); Name: 'Yi Radicals'), - (Range:(RangeStart: $A4D0; RangeEnd: $A4FF); Name: 'Lisu'), - (Range:(RangeStart: $A500; RangeEnd: $A63F); Name: 'Vai'), - (Range:(RangeStart: $A640; RangeEnd: $A69F); Name: 'Cyrillic Extended-B'), - (Range:(RangeStart: $A6A0; RangeEnd: $A6FF); Name: 'Bamum'), - (Range:(RangeStart: $A700; RangeEnd: $A71F); Name: 'Modifier Tone Letters'), - (Range:(RangeStart: $A720; RangeEnd: $A7FF); Name: 'Latin Extended-D'), - (Range:(RangeStart: $A800; RangeEnd: $A82F); Name: 'Syloti Nagri'), - (Range:(RangeStart: $A830; RangeEnd: $A83F); Name: 'Common Indic Number Forms'), - (Range:(RangeStart: $A840; RangeEnd: $A87F); Name: 'Phags-pa'), - (Range:(RangeStart: $A880; RangeEnd: $A8DF); Name: 'Saurashtra'), - (Range:(RangeStart: $A8E0; RangeEnd: $A8FF); Name: 'Devanagari Extended'), - (Range:(RangeStart: $A900; RangeEnd: $A92F); Name: 'Kayah Li'), - (Range:(RangeStart: $A930; RangeEnd: $A95F); Name: 'Rejang'), - (Range:(RangeStart: $A960; RangeEnd: $A97F); Name: 'Hangul Jamo Extended-A'), - (Range:(RangeStart: $A980; RangeEnd: $A9DF); Name: 'Javanese'), - (Range:(RangeStart: $A9E0; RangeEnd: $A9FF); Name: 'Myanmar Extended-B'), - (Range:(RangeStart: $AA00; RangeEnd: $AA5F); Name: 'Cham'), - (Range:(RangeStart: $AA60; RangeEnd: $AA7F); Name: 'Myanmar Extended-A'), - (Range:(RangeStart: $AA80; RangeEnd: $AADF); Name: 'Tai Viet'), - (Range:(RangeStart: $AAE0; RangeEnd: $AAFF); Name: 'Meetei Mayek Extensions'), - (Range:(RangeStart: $AB00; RangeEnd: $AB2F); Name: 'Ethiopic Extended-A'), - (Range:(RangeStart: $AB30; RangeEnd: $AB6F); Name: 'Latin Extended-E'), - (Range:(RangeStart: $AB70; RangeEnd: $ABBF); Name: 'Cherokee Supplement'), - (Range:(RangeStart: $ABC0; RangeEnd: $ABFF); Name: 'Meetei Mayek'), - (Range:(RangeStart: $AC00; RangeEnd: $D7AF); Name: 'Hangul Syllables'), - (Range:(RangeStart: $D7B0; RangeEnd: $D7FF); Name: 'Hangul Jamo Extended-B'), - (Range:(RangeStart: $D800; RangeEnd: $DB7F); Name: 'High Surrogates'), - (Range:(RangeStart: $DB80; RangeEnd: $DBFF); Name: 'High Private Use Surrogates'), - (Range:(RangeStart: $DC00; RangeEnd: $DFFF); Name: 'Low Surrogates'), - (Range:(RangeStart: $E000; RangeEnd: $F8FF); Name: 'Private Use Area'), - (Range:(RangeStart: $F900; RangeEnd: $FAFF); Name: 'CJK Compatibility Ideographs'), - (Range:(RangeStart: $FB00; RangeEnd: $FB4F); Name: 'Alphabetic Presentation Forms'), - (Range:(RangeStart: $FB50; RangeEnd: $FDFF); Name: 'Arabic Presentation Forms-A'), - (Range:(RangeStart: $FE00; RangeEnd: $FE0F); Name: 'Variation Selectors'), - (Range:(RangeStart: $FE10; RangeEnd: $FE1F); Name: 'Vertical Forms'), - (Range:(RangeStart: $FE20; RangeEnd: $FE2F); Name: 'Combining Half Marks'), - (Range:(RangeStart: $FE30; RangeEnd: $FE4F); Name: 'CJK Compatibility Forms'), - (Range:(RangeStart: $FE50; RangeEnd: $FE6F); Name: 'Small Form Variants'), - (Range:(RangeStart: $FE70; RangeEnd: $FEFF); Name: 'Arabic Presentation Forms-B'), - (Range:(RangeStart: $FF00; RangeEnd: $FFEF); Name: 'Halfwidth and Fullwidth Forms'), - (Range:(RangeStart: $FFF0; RangeEnd: $FFFF); Name: 'Specials'), - (Range:(RangeStart: $10000; RangeEnd: $1007F); Name: 'Linear B Syllabary'), - (Range:(RangeStart: $10080; RangeEnd: $100FF); Name: 'Linear B Ideograms'), - (Range:(RangeStart: $10100; RangeEnd: $1013F); Name: 'Aegean Numbers'), - (Range:(RangeStart: $10140; RangeEnd: $1018F); Name: 'Ancient Greek Numbers'), - (Range:(RangeStart: $10190; RangeEnd: $101CF); Name: 'Ancient Symbols'), - (Range:(RangeStart: $101D0; RangeEnd: $101FF); Name: 'Phaistos Disc'), - (Range:(RangeStart: $10280; RangeEnd: $1029F); Name: 'Lycian'), - (Range:(RangeStart: $102A0; RangeEnd: $102DF); Name: 'Carian'), - (Range:(RangeStart: $102E0; RangeEnd: $102FF); Name: 'Coptic Epact Numbers'), - (Range:(RangeStart: $10300; RangeEnd: $1032F); Name: 'Old Italic'), - (Range:(RangeStart: $10330; RangeEnd: $1034F); Name: 'Gothic'), - (Range:(RangeStart: $10350; RangeEnd: $1037F); Name: 'Old Permic'), - (Range:(RangeStart: $10380; RangeEnd: $1039F); Name: 'Ugaritic'), - (Range:(RangeStart: $103A0; RangeEnd: $103DF); Name: 'Old Persian'), - (Range:(RangeStart: $10400; RangeEnd: $1044F); Name: 'Deseret'), - (Range:(RangeStart: $10450; RangeEnd: $1047F); Name: 'Shavian'), - (Range:(RangeStart: $10480; RangeEnd: $104AF); Name: 'Osmanya'), - (Range:(RangeStart: $104B0; RangeEnd: $104FF); Name: 'Osage'), - (Range:(RangeStart: $10500; RangeEnd: $1052F); Name: 'Elbasan'), - (Range:(RangeStart: $10530; RangeEnd: $1056F); Name: 'Caucasian Albanian'), - (Range:(RangeStart: $10600; RangeEnd: $1077F); Name: 'Linear A'), - (Range:(RangeStart: $10800; RangeEnd: $1083F); Name: 'Cypriot Syllabary'), - (Range:(RangeStart: $10840; RangeEnd: $1085F); Name: 'Imperial Aramaic'), - (Range:(RangeStart: $10860; RangeEnd: $1087F); Name: 'Palmyrene'), - (Range:(RangeStart: $10880; RangeEnd: $108AF); Name: 'Nabataean'), - (Range:(RangeStart: $108E0; RangeEnd: $108FF); Name: 'Hatran'), - (Range:(RangeStart: $10900; RangeEnd: $1091F); Name: 'Phoenician'), - (Range:(RangeStart: $10920; RangeEnd: $1093F); Name: 'Lydian'), - (Range:(RangeStart: $10980; RangeEnd: $1099F); Name: 'Meroitic Hieroglyphs'), - (Range:(RangeStart: $109A0; RangeEnd: $109FF); Name: 'Meroitic Cursive'), - (Range:(RangeStart: $10A00; RangeEnd: $10A5F); Name: 'Kharoshthi'), - (Range:(RangeStart: $10A60; RangeEnd: $10A7F); Name: 'Old South Arabian'), - (Range:(RangeStart: $10A80; RangeEnd: $10A9F); Name: 'Old North Arabian'), - (Range:(RangeStart: $10AC0; RangeEnd: $10AFF); Name: 'Manichaean'), - (Range:(RangeStart: $10B00; RangeEnd: $10B3F); Name: 'Avestan'), - (Range:(RangeStart: $10B40; RangeEnd: $10B5F); Name: 'Inscriptional Parthian'), - (Range:(RangeStart: $10B60; RangeEnd: $10B7F); Name: 'Inscriptional Pahlavi'), - (Range:(RangeStart: $10B80; RangeEnd: $10BAF); Name: 'Psalter Pahlavi'), - (Range:(RangeStart: $10C00; RangeEnd: $10C4F); Name: 'Old Turkic'), - (Range:(RangeStart: $10C80; RangeEnd: $10CFF); Name: 'Old Hungarian'), - (Range:(RangeStart: $10D00; RangeEnd: $10D3F); Name: 'Hanifi Rohingya'), - (Range:(RangeStart: $10E60; RangeEnd: $10E7F); Name: 'Rumi Numeral Symbols'), - (Range:(RangeStart: $10E80; RangeEnd: $10EBF); Name: 'Yezidi'), - (Range:(RangeStart: $10F00; RangeEnd: $10F2F); Name: 'Old Sogdian'), - (Range:(RangeStart: $10F30; RangeEnd: $10FAF); Name: 'Sogdian'), - (Range:(RangeStart: $10FB0; RangeEnd: $10FDF); Name: 'Chorasmian'), - (Range:(RangeStart: $10FE0; RangeEnd: $10FFF); Name: 'Elymaic'), - (Range:(RangeStart: $11000; RangeEnd: $1107F); Name: 'Brahmi'), - (Range:(RangeStart: $11080; RangeEnd: $110CF); Name: 'Kaithi'), - (Range:(RangeStart: $110D0; RangeEnd: $110FF); Name: 'Sora Sompeng'), - (Range:(RangeStart: $11100; RangeEnd: $1114F); Name: 'Chakma'), - (Range:(RangeStart: $11150; RangeEnd: $1117F); Name: 'Mahajani'), - (Range:(RangeStart: $11180; RangeEnd: $111DF); Name: 'Sharada'), - (Range:(RangeStart: $111E0; RangeEnd: $111FF); Name: 'Sinhala Archaic Numbers'), - (Range:(RangeStart: $11200; RangeEnd: $1124F); Name: 'Khojki'), - (Range:(RangeStart: $11280; RangeEnd: $112AF); Name: 'Multani'), - (Range:(RangeStart: $112B0; RangeEnd: $112FF); Name: 'Khudawadi'), - (Range:(RangeStart: $11300; RangeEnd: $1137F); Name: 'Grantha'), - (Range:(RangeStart: $11400; RangeEnd: $1147F); Name: 'Newa'), - (Range:(RangeStart: $11480; RangeEnd: $114DF); Name: 'Tirhuta'), - (Range:(RangeStart: $11580; RangeEnd: $115FF); Name: 'Siddam'), - (Range:(RangeStart: $11600; RangeEnd: $1165F); Name: 'Modi'), - (Range:(RangeStart: $11660; RangeEnd: $1167F); Name: 'Mongolian Supplement'), - (Range:(RangeStart: $11680; RangeEnd: $116CF); Name: 'Takri'), - (Range:(RangeStart: $11700; RangeEnd: $1173F); Name: 'Ahom'), - (Range:(RangeStart: $11800; RangeEnd: $1184F); Name: 'Dogra'), - (Range:(RangeStart: $118A0; RangeEnd: $118FF); Name: 'Warang Citi'), - (Range:(RangeStart: $11900; RangeEnd: $1195F); Name: 'Dives Akuru'), - (Range:(RangeStart: $119A0; RangeEnd: $119FF); Name: 'Nandinagari'), - (Range:(RangeStart: $11A00; RangeEnd: $11A4F); Name: 'Zanabazar Square'), - (Range:(RangeStart: $11A50; RangeEnd: $11AAF); Name: 'Soyombo'), - (Range:(RangeStart: $11AC0; RangeEnd: $11AFF); Name: 'Pau Cin Hau'), - (Range:(RangeStart: $11C00; RangeEnd: $11C6F); Name: 'Bhaiksuki'), - (Range:(RangeStart: $11C70; RangeEnd: $11CBF); Name: 'Marchen'), - (Range:(RangeStart: $11D00; RangeEnd: $11D5F); Name: 'Masaram Gondi'), - (Range:(RangeStart: $11D60; RangeEnd: $11DAF); Name: 'Gunjala Gondi'), - (Range:(RangeStart: $11EE0; RangeEnd: $11EFF); Name: 'Makasar'), - (Range:(RangeStart: $11FB0; RangeEnd: $11FBF); Name: 'Lisu Supplement'), - (Range:(RangeStart: $11FC0; RangeEnd: $11FFF); Name: 'Tamil Supplement'), - (Range:(RangeStart: $12000; RangeEnd: $123FF); Name: 'Cuneiform'), - (Range:(RangeStart: $12400; RangeEnd: $1247F); Name: 'Cuneiform Numbers and Punctuation'), - (Range:(RangeStart: $12480; RangeEnd: $1254F); Name: 'Early Dynastic Cuneiform'), - (Range:(RangeStart: $13000; RangeEnd: $1342F); Name: 'Egyptian Hieroglyphs'), - (Range:(RangeStart: $13430; RangeEnd: $1343F); Name: 'Egyptian Hieroglyph Format Controls'), - (Range:(RangeStart: $14400; RangeEnd: $1467F); Name: 'Anatolian Hieroglyphs'), - (Range:(RangeStart: $16800; RangeEnd: $16A3F); Name: 'Bamum Supplement'), - (Range:(RangeStart: $16A40; RangeEnd: $16A6F); Name: 'Mro'), - (Range:(RangeStart: $16AD0; RangeEnd: $16AFF); Name: 'Bassa Vah'), - (Range:(RangeStart: $16B00; RangeEnd: $16B8F); Name: 'Pahawh Hmong'), - (Range:(RangeStart: $16E40; RangeEnd: $16E9F); Name: 'Medefaidrin'), - (Range:(RangeStart: $16F00; RangeEnd: $16F9F); Name: 'Miao'), - (Range:(RangeStart: $16FE0; RangeEnd: $16FFF); Name: 'Ideographic Symbols and Punctuation'), - (Range:(RangeStart: $17000; RangeEnd: $187F7); Name: 'Tangut'), - (Range:(RangeStart: $18800; RangeEnd: $18AFF); Name: 'Tangut Components'), - (Range:(RangeStart: $18B00; RangeEnd: $18CFF); Name: 'Khitan Small Script'), - (Range:(RangeStart: $18D00; RangeEnd: $18D08); Name: 'Tangut Supplement'), - (Range:(RangeStart: $1B000; RangeEnd: $1B0FF); Name: 'Kana Supplement'), - (Range:(RangeStart: $1B100; RangeEnd: $1B12F); Name: 'Kana Extended-A'), - (Range:(RangeStart: $1B130; RangeEnd: $1B16F); Name: 'Small Kana Extension'), - (Range:(RangeStart: $1B170; RangeEnd: $1B2FF); Name: 'Nushu'), - (Range:(RangeStart: $1BC00; RangeEnd: $1BC9F); Name: 'Duployan'), - (Range:(RangeStart: $1BCA0; RangeEnd: $1BCAF); Name: 'Shorthand Format Controls'), - (Range:(RangeStart: $1D000; RangeEnd: $1D0FF); Name: 'Byzantine Musical Symbols'), - (Range:(RangeStart: $1D100; RangeEnd: $1D1FF); Name: 'Musical Symbols'), - (Range:(RangeStart: $1D200; RangeEnd: $1D24F); Name: 'Ancient Greek Musical Notation'), - (Range:(RangeStart: $1D2E0; RangeEnd: $1D2FF); Name: 'Mayan Numerals'), - (Range:(RangeStart: $1D300; RangeEnd: $1D35F); Name: 'Tai Xuan Jing Symbols'), - (Range:(RangeStart: $1D360; RangeEnd: $1D37F); Name: 'Counting Rod Numerals'), - (Range:(RangeStart: $1D400; RangeEnd: $1D7FF); Name: 'Mathematical Alphanumeric Symbols'), - (Range:(RangeStart: $1D800; RangeEnd: $1DAAF); Name: 'Sutton SignWriting'), - (Range:(RangeStart: $1E000; RangeEnd: $1E02F); Name: 'Glagolitic Supplement'), - (Range:(RangeStart: $1E100; RangeEnd: $1E14F); Name: 'Nyiakeng Puachue Hmong'), - (Range:(RangeStart: $1E2C0; RangeEnd: $1E2FF); Name: 'Wancho'), - (Range:(RangeStart: $1E800; RangeEnd: $1E8DF); Name: 'Mende Kikakui'), - (Range:(RangeStart: $1EC70; RangeEnd: $1ECBF); Name: 'Indic Siyaq Numbers'), - (Range:(RangeStart: $1ED00; RangeEnd: $1ED4F); Name: 'Ottoman Siyaq Numbers'), - (Range:(RangeStart: $1E900; RangeEnd: $1E95F); Name: 'Adlam'), - (Range:(RangeStart: $1EE00; RangeEnd: $1EEFF); Name: 'Arabic Mathematical Alphabetic Symbols'), - (Range:(RangeStart: $1F000; RangeEnd: $1F02F); Name: 'Mahjong Tiles'), - (Range:(RangeStart: $1F030; RangeEnd: $1F09F); Name: 'Domino Tiles'), - (Range:(RangeStart: $1F0A0; RangeEnd: $1F0FF); Name: 'Playing Cards'), - (Range:(RangeStart: $1F100; RangeEnd: $1F1FF); Name: 'Enclosed Alphanumeric Supplement'), - (Range:(RangeStart: $1F200; RangeEnd: $1F2FF); Name: 'Enclosed Ideographic Supplement'), - (Range:(RangeStart: $1F300; RangeEnd: $1F5FF); Name: 'Miscellaneous Symbols And Pictographs'), - (Range:(RangeStart: $1F600; RangeEnd: $1F64F); Name: 'Emoticons'), - (Range:(RangeStart: $1F650; RangeEnd: $1F67F); Name: 'Ornamental Dingbats'), - (Range:(RangeStart: $1F680; RangeEnd: $1F6FF); Name: 'Transport And Map Symbols'), - (Range:(RangeStart: $1F700; RangeEnd: $1F77F); Name: 'Alchemical Symbols'), - (Range:(RangeStart: $1F780; RangeEnd: $1F7FF); Name: 'Geometric Shapes Extended'), - (Range:(RangeStart: $1F800; RangeEnd: $1F8FF); Name: 'Supplemental Arrows-C'), - (Range:(RangeStart: $1F900; RangeEnd: $1F9FF); Name: 'Supplemental Symbols And Pictographs'), - (Range:(RangeStart: $1FA00; RangeEnd: $1FA6F); Name: 'Chess Symbols'), - (Range:(RangeStart: $1FA70; RangeEnd: $1FAFF); Name: 'Symbols and Pictographs Extended-A'), - (Range:(RangeStart: $1FB00; RangeEnd: $1FBFF); Name: 'Symbols for Legacy Computing'), - (Range:(RangeStart: $20000; RangeEnd: $2A6DD); Name: 'CJK Unified Ideographs Extension B'), - (Range:(RangeStart: $2A700; RangeEnd: $2B734); Name: 'CJK Unified Ideographs Extension C'), - (Range:(RangeStart: $2B740; RangeEnd: $2B81D); Name: 'CJK Unified Ideographs Extension D'), - (Range:(RangeStart: $2B820; RangeEnd: $2CEA1); Name: 'CJK Unified Ideographs Extension E'), - (Range:(RangeStart: $2CEB0; RangeEnd: $2EBE0); Name: 'CJK Unified Ideographs Extension F'), - (Range:(RangeStart: $2F800; RangeEnd: $2FA1F); Name: 'CJK Compatibility Ideographs Supplement'), - (Range:(RangeStart: $30000; RangeEnd: $3134A); Name: 'CJK Unified Ideographs Extension G'), - (Range:(RangeStart: $E0000; RangeEnd: $E007F); Name: 'Tags'), - (Range:(RangeStart: $E0100; RangeEnd: $E01EF); Name: 'Variation Selectors Supplement'), - (Range:(RangeStart: $F0000; RangeEnd: $FFFFF); Name: 'Supplementary Private Use Area-A'), - (Range:(RangeStart: $100000; RangeEnd: $10FFFF); Name: 'Supplementary Private Use Area-B')); - -{$IFNDEF UNICODE_RTL_DATABASE} - -type - TWideStrings = class; - - TSearchFlag = ( - sfCaseSensitive, // match letter case - sfIgnoreNonSpacing, // ignore non-spacing characters in search - sfSpaceCompress, // handle several consecutive white spaces as one white space - // (this applies to the pattern as well as the search text) - sfWholeWordOnly // match only text at end/start and/or surrounded by white spaces - ); - - TSearchFlags = set of TSearchFlag; - - // a generic search class defininition used for tuned Boyer-Moore and Unicode - // regular expression searches - TSearchEngine = class(TObject) - private - FResults: TList; // 2 entries for each result (start and stop position) - FOwner: TWideStrings; // at the moment unused, perhaps later to access strings faster - protected - function GetCount: SizeInt; virtual; - public - constructor Create(AOwner: TWideStrings); virtual; - destructor Destroy; override; - - procedure AddResult(Start, Stop: SizeInt); virtual; - procedure Clear; virtual; - procedure ClearResults; virtual; - procedure DeleteResult(Index: SizeInt); virtual; - procedure FindPrepare(const Pattern: WideString; Options: TSearchFlags); overload; virtual; abstract; - procedure FindPrepare(Pattern: PWideChar; PatternLength: SizeInt; Options: TSearchFlags); overload; virtual; abstract; - function FindFirst(const Text: WideString; var Start, Stop: SizeInt): Boolean; overload; virtual; abstract; - function FindFirst(Text: PWideChar; TextLen: SizeInt; var Start, Stop: SizeInt): Boolean; overload; virtual; abstract; - function FindAll(const Text: WideString): Boolean; overload; virtual; abstract; - function FindAll(Text: PWideChar; TextLen: SizeInt): Boolean; overload; virtual; abstract; - procedure GetResult(Index: SizeInt; var Start, Stop: SizeInt); virtual; - - property Count: SizeInt read GetCount; - end; - - // The Unicode Tuned Boyer-Moore (UTBM) search implementation is an extended - // translation created from a free package written by Mark Leisher (mleisher att crl dott nmsu dott edu). - // - // The code handles high and low surrogates as well as case (in)dependency, - // can ignore non-spacing characters and allows optionally to return whole - // words only. - - // single pattern character - PUTBMChar = ^TUTBMChar; - TUTBMChar = record - LoCase, - UpCase, - TitleCase: UCS4; - end; - - PUTBMSkip = ^TUTBMSkip; - TUTBMSkip = record - BMChar: PUTBMChar; - SkipValues: Integer; - end; - - TUTBMSearch = class(TSearchEngine) - private - FFlags: TSearchFlags; - FPattern: PUTBMChar; - FPatternUsed: SizeInt; - FPatternSize: SizeInt; - FPatternLength: SizeInt; - FSkipValues: PUTBMSkip; - FSkipsUsed: SizeInt; - FMD4: SizeInt; - protected - procedure ClearPattern; - procedure Compile(Pattern: PUCS2; PatternLength: SizeInt; Flags: TSearchFlags); - function Find(Text: PUCS2; TextLen: SizeInt; var MatchStart, MatchEnd: SizeInt): Boolean; - function GetSkipValue(TextStart, TextEnd: PUCS2): SizeInt; - function Match(Text, Start, Stop: PUCS2; var MatchStart, MatchEnd: SizeInt): Boolean; - public - procedure Clear; override; - procedure FindPrepare(const Pattern: WideString; Options: TSearchFlags); overload; override; - procedure FindPrepare(Pattern: PWideChar; PatternLength: SizeInt; Options: TSearchFlags); overload; override; - function FindFirst(const Text: WideString; var Start, Stop: SizeInt): Boolean; overload; override; - function FindFirst(Text: PWideChar; TextLen: SizeInt; var Start, Stop: SizeInt): Boolean; overload; override; - function FindAll(const Text: WideString): Boolean; overload; override; - function FindAll(Text: PWideChar; TextLen: SizeInt): Boolean; overload; override; - end; - - // Regular expression search engine for text in UCS2 form taking surrogates - // into account. This implementation is an improved translation from the URE - // package written by Mark Leisher (mleisher att crl dott nmsu dott edu) who used a variation - // of the RE->DFA algorithm done by Mark Hopkins (markh att csd4 dott csd dott uwm dott edu). - // Assumptions: - // o Regular expression and text already normalized. - // o Conversion to lower case assumes a 1-1 mapping. - // - // Definitions: - // Separator - any one of U+2028, U+2029, NL, CR. - // - // Operators: - // . - match any character - // * - match zero or more of the last subexpression - // + - match one or more of the last subexpression - // ? - match zero or one of the last subexpression - // () - subexpression grouping - // {m, n} - match at least m occurrences and up to n occurrences - // Note: both values can be 0 or ommitted which denotes then a unlimiting bound - // {,} and {0,} and {0, 0} correspond to * - // {, 1} and {0, 1} correspond to ? - // {1,} and {1, 0} correspond to + - // {m} - match exactly m occurrences - // - // Notes: - // o The "." operator normally does not match separators, but a flag is - // available that will allow this operator to match a separator. - // - // Literals and Constants: - // c - literal UCS2 character - // \x.... - hexadecimal number of up to 4 digits - // \X.... - hexadecimal number of up to 4 digits - // \u.... - hexadecimal number of up to 4 digits - // \U.... - hexadecimal number of up to 4 digits - // - // Character classes: - // [...] - Character class - // [^...] - Negated character class - // \pN1,N2,...,Nn - Character properties class - // \PN1,N2,...,Nn - Negated character properties class - // - // POSIX character classes recognized: - // :alnum: - // :alpha: - // :cntrl: - // :digit: - // :graph: - // :lower: - // :print: - // :punct: - // :space: - // :upper: - // :xdigit: - // - // Notes: - // o Character property classes are \p or \P followed by a comma separated - // list of integers between 0 and the maximum entry index in TCharacterCategory. - // These integers directly correspond to the TCharacterCategory enumeration entries. - // Note: upper, lower and title case classes need to have case sensitive search - // be enabled to match correctly! - // - // o Character classes can contain literals, constants and character - // property classes. Example: - // - // [abc\U10A\p0,13,4] - - // structure used to handle a compacted range of characters - PUcRange = ^TUcRange; - TUcRange = record - MinCode, - MaxCode: UCS4; - end; - - TUcCClass = record - Ranges: array of TUcRange; - RangesUsed: SizeInt; - end; - - // either a single character or a list of character classes - TUcSymbol = record - Chr: UCS4; - CCL: TUcCClass; - end; - - // this is a general element structure used for expressions and stack elements - TUcElement = record - OnStack: Boolean; - AType, - LHS, - RHS: SizeInt; - end; - - // this is a structure used to track a list or a stack of states - PUcStateList = ^TUcStateList; - TUcStateList = record - List: array of SizeInt; - ListUsed: SizeInt; - end; - - // structure to track the list of unique states for a symbol during reduction - PUcSymbolTableEntry = ^TUcSymbolTableEntry; - TUcSymbolTableEntry = record - ID, - AType: SizeInt; - Mods, - Categories: TCharacterCategories; - Symbol: TUcSymbol; - States: TUcStateList; - end; - - // structure to hold a single State - PUcState = ^TUcState; - TUcState = record - ID: SizeInt; - Accepting: Boolean; - StateList: TUcStateList; - Transitions: array of TUcElement; - TransitionsUsed: SizeInt; - end; - - // structure used for keeping lists of states - TUcStateTable = record - States: array of TUcState; - StatesUsed: SizeInt; - end; - - // structure to track pairs of DFA states when equivalent states are merged - TUcEquivalent = record - Left, - Right: SizeInt; - end; - - TUcExpressionList = record - Expressions: array of TUcElement; - ExpressionsUsed: SizeInt; - end; - - TUcSymbolTable = record - Symbols: array of TUcSymbolTableEntry; - SymbolsUsed: SizeInt; - end; - - TUcEquivalentList = record - Equivalents: array of TUcEquivalent; - EquivalentsUsed: SizeInt; - end; - - // structure used for constructing the NFA and reducing to a minimal DFA - PUREBuffer = ^TUREBuffer; - TUREBuffer = record - Reducing: Boolean; - Error: Integer; - Flags: Cardinal; - Stack: TUcStateList; - SymbolTable: TUcSymbolTable; // table of unique symbols encountered - ExpressionList: TUcExpressionList; // tracks the unique expressions generated - // for the NFA and when the NFA is reduced - States: TUcStateTable; // the reduced table of unique groups of NFA states - EquivalentList: TUcEquivalentList; // tracks states when equivalent states are merged - end; - - TUcTransition = record - Symbol, - NextState: SizeInt; - end; - - PDFAState = ^TDFAState; - TDFAState = record - Accepting: Boolean; - NumberTransitions: SizeInt; - StartTransition: SizeInt; - end; - - TDFAStates = record - States: array of TDFAState; - StatesUsed: SizeInt; - end; - - TUcTransitions = record - Transitions: array of TUcTransition; - TransitionsUsed: SizeInt; - end; - - TDFA = record - Flags: Cardinal; - SymbolTable: TUcSymbolTable; - StateList: TDFAStates; - TransitionList: TUcTransitions; - end; - - TURESearch = class(TSearchEngine) - private - FUREBuffer: TUREBuffer; - FDFA: TDFA; - protected - procedure AddEquivalentPair(L, R: SizeInt); - procedure AddRange(var CCL: TUcCClass; Range: TUcRange); - function AddState(NewStates: array of SizeInt): SizeInt; - procedure AddSymbolState(Symbol, State: SizeInt); - function BuildCharacterClass(CP: PUCS2; Limit: SizeInt; Symbol: PUcSymbolTableEntry): SizeInt; - procedure ClearUREBuffer; - function CompileSymbol(S: PUCS2; Limit: SizeInt; Symbol: PUcSymbolTableEntry): SizeInt; - procedure CompileURE(RE: PWideChar; RELength: SizeInt; Casefold: Boolean); - procedure CollectPendingOperations(var State: SizeInt); - function ConvertRegExpToNFA(RE: PWideChar; RELength: SizeInt): SizeInt; - function ExecuteURE(Flags: Cardinal; Text: PUCS2; TextLen: SizeInt; var MatchStart, MatchEnd: SizeInt): Boolean; - procedure ClearDFA; - procedure HexDigitSetup(Symbol: PUcSymbolTableEntry); - function MakeExpression(AType, LHS, RHS: SizeInt): SizeInt; - function MakeHexNumber(NP: PUCS2; Limit: SizeInt; var Number: UCS4): SizeInt; - function MakeSymbol(S: PUCS2; Limit: SizeInt; out Consumed: SizeInt): SizeInt; - procedure MergeEquivalents; - function ParsePropertyList(Properties: PUCS2; Limit: SizeInt; var Categories: TCharacterCategories): SizeInt; - function Peek: SizeInt; - function Pop: SizeInt; - function PosixCCL(CP: PUCS2; Limit: SizeInt; Symbol: PUcSymbolTableEntry): SizeInt; - function ProbeLowSurrogate(LeftState: PUCS2; Limit: SizeInt; var Code: UCS4): SizeInt; - procedure Push(V: SizeInt); - procedure Reduce(Start: SizeInt); - procedure SpaceSetup(Symbol: PUcSymbolTableEntry; Categories: TCharacterCategories); - function SymbolsAreDifferent(A, B: PUcSymbolTableEntry): Boolean; - public - procedure Clear; override; - procedure FindPrepare(const Pattern: WideString; Options: TSearchFlags); overload; override; - procedure FindPrepare(Pattern: PWideChar; PatternLength: SizeInt; Options: TSearchFlags); overload; override; - function FindFirst(const Text: WideString; var Start, Stop: SizeInt): Boolean; overload; override; - function FindFirst(Text: PWideChar; TextLen: SizeInt; var Start, Stop: SizeInt): Boolean; overload; override; - function FindAll(const Text: WideString): Boolean; overload; override; - function FindAll(Text: PWideChar; TextLen: SizeInt): Boolean; overload; override; - end; - - // Event used to give the application a chance to switch the way of how to save - // the text in TWideStrings if the text contains characters not only from the - // ANSI block but the save type is ANSI. On triggering the event the application - // can change the property SaveUnicode as needed. This property is again checked - // after the callback returns. - TConfirmConversionEvent = procedure (Sender: TWideStrings; var Allowed: Boolean) of object; - - TWideStrings = class(TPersistent) - private - FUpdateCount: Integer; - FLanguage: LCID; // language can usually left alone, the system's default is used - FSaved: Boolean; // set in SaveToStream, True in case saving was successful otherwise False - FNormalizationForm: TNormalizationForm; // determines in which form Unicode strings should be stored - FOnConfirmConversion: TConfirmConversionEvent; - FSaveFormat: TSaveFormat; // overrides the FSaveUnicode flag, initialized when a file is loaded, - // expect losses if it is set to sfAnsi before saving - function GetCommaText: WideString; - function GetName(Index: Integer): WideString; - function GetValue(const Name: WideString): WideString; - procedure ReadData(Reader: TReader); - procedure SetCommaText(const Value: WideString); - procedure SetNormalizationForm(const Value: TNormalizationForm); - procedure SetValue(const Name, Value: WideString); - procedure WriteData(Writer: TWriter); - function GetSaveUnicode: Boolean; - procedure SetSaveUnicode(const Value: Boolean); - protected - procedure DefineProperties(Filer: TFiler); override; - procedure DoConfirmConversion(var Allowed: Boolean); virtual; - procedure Error(const Msg: string; Data: Integer); - function Get(Index: Integer): WideString; virtual; abstract; - function GetCapacity: Integer; virtual; - function GetCount: Integer; virtual; abstract; - function GetObject(Index: Integer): TObject; virtual; - function GetTextStr: WideString; virtual; - procedure Put(Index: Integer; const S: WideString); virtual; abstract; - procedure PutObject(Index: Integer; AObject: TObject); virtual; abstract; - procedure SetCapacity(NewCapacity: Integer); virtual; - procedure SetUpdateState(Updating: Boolean); virtual; - procedure SetLanguage(Value: LCID); virtual; - public - constructor Create; - - function Add(const S: WideString): Integer; virtual; - function AddObject(const S: WideString; AObject: TObject): Integer; virtual; - procedure Append(const S: WideString); - procedure AddStrings(Strings: TStrings); overload; virtual; - procedure AddStrings(Strings: TWideStrings); overload; virtual; - procedure Assign(Source: TPersistent); override; - procedure AssignTo(Dest: TPersistent); override; - procedure BeginUpdate; - procedure Clear; virtual; abstract; - procedure Delete(Index: Integer); virtual; abstract; - procedure EndUpdate; - function Equals(Strings: TWideStrings): Boolean; {$IFDEF RTL200_UP} reintroduce; {$ENDIF RTL200_UP} - procedure Exchange(Index1, Index2: Integer); virtual; - function GetSeparatedText(Separators: WideString): WideString; virtual; - function GetText: PWideChar; virtual; - function IndexOf(const S: WideString): Integer; virtual; - function IndexOfName(const Name: WideString): Integer; - function IndexOfObject(AObject: TObject): Integer; - procedure Insert(Index: Integer; const S: WideString); virtual; abstract; - procedure InsertObject(Index: Integer; const S: WideString; AObject: TObject); - procedure LoadFromFile(const FileName: TFileName); virtual; - procedure LoadFromStream(Stream: TStream); virtual; - procedure Move(CurIndex, NewIndex: Integer); virtual; - procedure SaveToFile(const FileName: TFileName); virtual; - procedure SaveToStream(Stream: TStream; WithBOM: Boolean = True); virtual; - procedure SetText(const Value: WideString); virtual; - - property Capacity: Integer read GetCapacity write SetCapacity; - property CommaText: WideString read GetCommaText write SetCommaText; - property Count: Integer read GetCount; - property Language: LCID read FLanguage write SetLanguage; - property Names[Index: Integer]: WideString read GetName; - property NormalizationForm: TNormalizationForm read FNormalizationForm write SetNormalizationForm default nfC; - property Objects[Index: Integer]: TObject read GetObject write PutObject; - property Values[const Name: WideString]: WideString read GetValue write SetValue; - property Saved: Boolean read FSaved; - property SaveUnicode: Boolean read GetSaveUnicode write SetSaveUnicode default True; - property SaveFormat: TSaveFormat read FSaveFormat write FSaveFormat default sfUnicodeLSB; - property Strings[Index: Integer]: WideString read Get write Put; default; - property Text: WideString read GetTextStr write SetText; - - property OnConfirmConversion: TConfirmConversionEvent read FOnConfirmConversion write FOnConfirmConversion; - end; - - //----- TWideStringList class - TWideStringItem = record - {$IFDEF OWN_WIDESTRING_MEMMGR} - FString: PWideChar; // "array of WideChar"; - {$ELSE ~OWN_WIDESTRING_MEMMGR} - FString: WideString; - {$ENDIF ~OWN_WIDESTRING_MEMMGR} - FObject: TObject; - end; - - TWideStringItemList = array of TWideStringItem; - - TWideStringList = class(TWideStrings) - private - FList: TWideStringItemList; - FCount: Integer; - FSorted: Boolean; - FDuplicates: TDuplicates; - FOnChange: TNotifyEvent; - FOnChanging: TNotifyEvent; - procedure ExchangeItems(Index1, Index2: Integer); - procedure Grow; - procedure QuickSort(L, R: Integer); - procedure InsertItem(Index: Integer; const S: WideString); - procedure SetSorted(Value: Boolean); - {$IFDEF OWN_WIDESTRING_MEMMGR} - procedure SetListString(Index: Integer; const S: WideString); - {$ENDIF OWN_WIDESTRING_MEMMGR} - protected - procedure Changed; virtual; - procedure Changing; virtual; - function Get(Index: Integer): WideString; override; - function GetCapacity: Integer; override; - function GetCount: Integer; override; - function GetObject(Index: Integer): TObject; override; - procedure Put(Index: Integer; const S: WideString); override; - procedure PutObject(Index: Integer; AObject: TObject); override; - procedure SetCapacity(NewCapacity: Integer); override; - procedure SetUpdateState(Updating: Boolean); override; - procedure SetLanguage(Value: LCID); override; - public - destructor Destroy; override; - - function Add(const S: WideString): Integer; override; - procedure Clear; override; - procedure Delete(Index: Integer); override; - procedure Exchange(Index1, Index2: Integer); override; - function Find(const S: WideString; var Index: Integer): Boolean; virtual; - function IndexOf(const S: WideString): Integer; override; - procedure Insert(Index: Integer; const S: WideString); override; - procedure Sort; virtual; - - property Duplicates: TDuplicates read FDuplicates write FDuplicates; - property Sorted: Boolean read FSorted write SetSorted; - property OnChange: TNotifyEvent read FOnChange write FOnChange; - property OnChanging: TNotifyEvent read FOnChanging write FOnChanging; - end; - -{$ENDIF ~UNICODE_RTL_DATABASE} - -{ -// all these functions are now in JclWideStrings.pas -function StrLenW(Str: PWideChar): SizeInt; -function StrEndW(Str: PWideChar): PWideChar; -function StrMoveW(Dest, Source: PWideChar; Count: SizeInt): PWideChar; -function StrCopyW(Dest, Source: PWideChar): PWideChar; -function StrECopyW(Dest, Source: PWideChar): PWideChar; -function StrLCopyW(Dest, Source: PWideChar; MaxLen: SizeInt): PWideChar; -function StrPCopyWW(Dest: PWideChar; const Source: WideString): PWideChar; overload; -function StrPCopyW(Dest: PWideChar; const Source: AnsiString): PWideChar; -function StrPLCopyWW(Dest: PWideChar; const Source: WideString; MaxLen: SizeInt): PWideChar; -function StrPLCopyW(Dest: PWideChar; const Source: AnsiString; MaxLen: SizeInt): PWideChar; -function StrCatW(Dest: PWideChar; const Source: PWideChar): PWideChar; -function StrLCatW(Dest, Source: PWideChar; MaxLen: SizeInt): PWideChar; -function StrCompW(const Str1, Str2: PWideChar): Integer; -function StrICompW(const Str1, Str2: PWideChar): Integer; -function StrLCompW(const Str1, Str2: PWideChar; MaxLen: SizeInt): Integer; -function StrLICompW(const Str1, Str2: PWideChar; MaxLen: SizeInt): Integer; -function StrNScanW(const Str1, Str2: PWideChar): SizeInt; -function StrRNScanW(const Str1, Str2: PWideChar): SizeInt; -function StrScanW(Str: PWideChar; Chr: WideChar): PWideChar; overload; -function StrScanW(Str: PWideChar; Chr: WideChar; StrLen: SizeInt): PWideChar; overload; -function StrRScanW(Str: PWideChar; Chr: WideChar): PWideChar; -function StrPosW(Str, SubStr: PWideChar): PWideChar; -function StrAllocW(WideSize: SizeInt): PWideChar; -function StrBufSizeW(const Str: PWideChar): SizeInt; -function StrNewW(const Str: PWideChar): PWideChar; overload; -function StrNewW(const Str: WideString): PWideChar; overload; -procedure StrDisposeW(Str: PWideChar); -procedure StrDisposeAndNilW(var Str: PWideChar); -procedure StrSwapByteOrder(Str: PWideChar); -} - -// functions involving Delphi wide strings -function WideAdjustLineBreaks(const S: WideString): WideString; -function WideCharPos(const S: WideString; const Ch: WideChar; const Index: SizeInt): SizeInt; //az -{$IFNDEF UNICODE_RTL_DATABASE} -function WideCompose(const S: WideString; Compatible: Boolean = True): WideString; overload; -function WideCompose(const S: WideString; Tags: TCompatibilityFormattingTags): WideString; overload; -function WideDecompose(const S: WideString; Compatible: Boolean = True): WideString; overload; -function WideDecompose(const S: WideString; Tags: TCompatibilityFormattingTags): WideString; overload; -{$ENDIF ~UNICODE_RTL_DATABASE} -function WideExtractQuotedStr(var Src: PWideChar; Quote: WideChar): WideString; -function WideQuotedStr(const S: WideString; Quote: WideChar): WideString; -function WideStringOfChar(C: WideChar; Count: SizeInt): WideString; - -// case conversion function -type - TCaseType = (ctFold, ctLower, ctTitle, ctUpper); - -{$IFNDEF UNICODE_RTL_DATABASE} -function WideNormalize(const S: WideString; Form: TNormalizationForm): WideString; - -function WideCaseConvert(C: WideChar; CaseType: TCaseType): WideString; overload; -function WideCaseConvert(const S: WideString; CaseType: TCaseType): WideString; overload; -function WideCaseFolding(C: WideChar): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -function WideCaseFolding(const S: WideString): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -function WideTitleCase(C: WideChar): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -function WideTitleCase(const S: WideString): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -{$ENDIF ~UNICODE_RTL_DATABASE} -function WideLowerCase(C: WideChar): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -function WideLowerCase(const S: WideString): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -function WideUpperCase(C: WideChar): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} -function WideUpperCase(const S: WideString): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} - -function WideSameText(const Str1, Str2: WideString): Boolean; -function WideTrim(const S: WideString): WideString; -function WideTrimLeft(const S: WideString): WideString; -function WideTrimRight(const S: WideString): WideString; - -type - // result type for number retrieval functions - TUcNumber = record - Numerator, - Denominator: Integer; - end; - -// Low level character routines -{$IFNDEF UNICODE_RTL_DATABASE} -function UnicodeNumberLookup(Code: UCS4; var Number: TUcNumber): Boolean; -function UnicodeCompose(const Codes: array of UCS4; out Composite: UCS4; Compatible: Boolean = True): Integer; overload; -function UnicodeCompose(const Codes: array of UCS4; out Composite: UCS4; Tags: TCompatibilityFormattingTags): Integer; overload; -function UnicodeCaseFold(Code: UCS4): TUCS4Array; -function UnicodeDecompose(Code: UCS4; Compatible: Boolean = True): TUCS4Array; overload; -function UnicodeDecompose(Code: UCS4; Tags: TCompatibilityFormattingTags): TUCS4Array; overload; -function UnicodeToTitle(Code: UCS4): TUCS4Array; -{$ENDIF ~UNICODE_RTL_DATABASE} -function UnicodeToUpper(Code: UCS4): TUCS4Array; -function UnicodeToLower(Code: UCS4): TUCS4Array; - -// Character test routines -function UnicodeIsAlpha(C: UCS4): Boolean; -function UnicodeIsDigit(C: UCS4): Boolean; -function UnicodeIsAlphaNum(C: UCS4): Boolean; -function UnicodeIsNumberOther(C: UCS4): Boolean; -function UnicodeIsCased(C: UCS4): Boolean; -function UnicodeIsControl(C: UCS4): Boolean; -function UnicodeIsSpace(C: UCS4): Boolean; -function UnicodeIsWhiteSpace(C: UCS4): Boolean; -function UnicodeIsBlank(C: UCS4): Boolean; -function UnicodeIsPunctuation(C: UCS4): Boolean; -function UnicodeIsGraph(C: UCS4): Boolean; -function UnicodeIsPrintable(C: UCS4): Boolean; -function UnicodeIsUpper(C: UCS4): Boolean; -function UnicodeIsLower(C: UCS4): Boolean; -function UnicodeIsTitle(C: UCS4): Boolean; -{$IFNDEF UNICODE_RTL_DATABASE} -function UnicodeIsHexDigit(C: UCS4): Boolean; -{$ENDIF ~UNICODE_RTL_DATABASE} -function UnicodeIsIsoControl(C: UCS4): Boolean; -function UnicodeIsFormatControl(C: UCS4): Boolean; -function UnicodeIsSymbol(C: UCS4): Boolean; -function UnicodeIsNumber(C: UCS4): Boolean; -function UnicodeIsNonSpacing(C: UCS4): Boolean; -function UnicodeIsOpenPunctuation(C: UCS4): Boolean; -function UnicodeIsClosePunctuation(C: UCS4): Boolean; -function UnicodeIsInitialPunctuation(C: UCS4): Boolean; -function UnicodeIsFinalPunctuation(C: UCS4): Boolean; -{$IFNDEF UNICODE_RTL_DATABASE} -function UnicodeIsComposed(C: UCS4): Boolean; -function UnicodeIsQuotationMark(C: UCS4): Boolean; -function UnicodeIsSymmetric(C: UCS4): Boolean; -function UnicodeIsMirroring(C: UCS4): Boolean; -function UnicodeIsNonBreaking(C: UCS4): Boolean; - -// Directionality functions -function UnicodeIsRightToLeft(C: UCS4): Boolean; -function UnicodeIsLeftToRight(C: UCS4): Boolean; -function UnicodeIsStrong(C: UCS4): Boolean; -function UnicodeIsWeak(C: UCS4): Boolean; -function UnicodeIsNeutral(C: UCS4): Boolean; -function UnicodeIsSeparator(C: UCS4): Boolean; - -// Other character test functions -function UnicodeIsMark(C: UCS4): Boolean; -function UnicodeIsModifier(C: UCS4): Boolean; -{$ENDIF ~UNICODE_RTL_DATABASE} -function UnicodeIsLetterNumber(C: UCS4): Boolean; -function UnicodeIsConnectionPunctuation(C: UCS4): Boolean; -function UnicodeIsDash(C: UCS4): Boolean; -function UnicodeIsMath(C: UCS4): Boolean; -function UnicodeIsCurrency(C: UCS4): Boolean; -function UnicodeIsModifierSymbol(C: UCS4): Boolean; -function UnicodeIsSpacingMark(C: UCS4): Boolean; -function UnicodeIsEnclosing(C: UCS4): Boolean; -function UnicodeIsPrivate(C: UCS4): Boolean; -function UnicodeIsSurrogate(C: UCS4): Boolean; -function UnicodeIsLineSeparator(C: UCS4): Boolean; -function UnicodeIsParagraphSeparator(C: UCS4): Boolean; -function UnicodeIsIdentifierStart(C: UCS4): Boolean; -function UnicodeIsIdentifierPart(C: UCS4): Boolean; -function UnicodeIsDefined(C: UCS4): Boolean; -function UnicodeIsUndefined(C: UCS4): Boolean; -function UnicodeIsHan(C: UCS4): Boolean; -function UnicodeIsHangul(C: UCS4): Boolean; - -function UnicodeIsUnassigned(C: UCS4): Boolean; -function UnicodeIsLetterOther(C: UCS4): Boolean; -function UnicodeIsConnector(C: UCS4): Boolean; -function UnicodeIsPunctuationOther(C: UCS4): Boolean; -function UnicodeIsSymbolOther(C: UCS4): Boolean; -{$IFNDEF UNICODE_RTL_DATABASE} -function UnicodeIsLeftToRightEmbedding(C: UCS4): Boolean; -function UnicodeIsLeftToRightOverride(C: UCS4): Boolean; -function UnicodeIsRightToLeftArabic(C: UCS4): Boolean; -function UnicodeIsRightToLeftEmbedding(C: UCS4): Boolean; -function UnicodeIsRightToLeftOverride(C: UCS4): Boolean; -function UnicodeIsPopDirectionalFormat(C: UCS4): Boolean; -function UnicodeIsEuropeanNumber(C: UCS4): Boolean; -function UnicodeIsEuropeanNumberSeparator(C: UCS4): Boolean; -function UnicodeIsEuropeanNumberTerminator(C: UCS4): Boolean; -function UnicodeIsArabicNumber(C: UCS4): Boolean; -function UnicodeIsCommonNumberSeparator(C: UCS4): Boolean; -function UnicodeIsBoundaryNeutral(C: UCS4): Boolean; -function UnicodeIsSegmentSeparator(C: UCS4): Boolean; -function UnicodeIsOtherNeutrals(C: UCS4): Boolean; -function UnicodeIsASCIIHexDigit(C: UCS4): Boolean; -function UnicodeIsBidiControl(C: UCS4): Boolean; -function UnicodeIsDeprecated(C: UCS4): Boolean; -function UnicodeIsDiacritic(C: UCS4): Boolean; -function UnicodeIsExtender(C: UCS4): Boolean; -function UnicodeIsHyphen(C: UCS4): Boolean; -function UnicodeIsIdeographic(C: UCS4): Boolean; -function UnicodeIsIDSBinaryOperator(C: UCS4): Boolean; -function UnicodeIsIDSTrinaryOperator(C: UCS4): Boolean; -function UnicodeIsJoinControl(C: UCS4): Boolean; -function UnicodeIsLogicalOrderException(C: UCS4): Boolean; -function UnicodeIsNonCharacterCodePoint(C: UCS4): Boolean; -function UnicodeIsOtherAlphabetic(C: UCS4): Boolean; -function UnicodeIsOtherDefaultIgnorableCodePoint(C: UCS4): Boolean; -function UnicodeIsOtherGraphemeExtend(C: UCS4): Boolean; -function UnicodeIsOtherIDContinue(C: UCS4): Boolean; -function UnicodeIsOtherIDStart(C: UCS4): Boolean; -function UnicodeIsOtherLowercase(C: UCS4): Boolean; -function UnicodeIsOtherMath(C: UCS4): Boolean; -function UnicodeIsOtherUppercase(C: UCS4): Boolean; -function UnicodeIsPatternSyntax(C: UCS4): Boolean; -function UnicodeIsPatternWhiteSpace(C: UCS4): Boolean; -function UnicodeIsRadical(C: UCS4): Boolean; -function UnicodeIsSoftDotted(C: UCS4): Boolean; -function UnicodeIsSTerm(C: UCS4): Boolean; -function UnicodeIsTerminalPunctuation(C: UCS4): Boolean; -function UnicodeIsUnifiedIdeograph(C: UCS4): Boolean; -function UnicodeIsVariationSelector(C: UCS4): Boolean; -{$ENDIF ~UNICODE_RTL_DATABASE} - -// Utility functions -function CharSetFromLocale(Language: LCID): Byte; -function GetCharSetFromLocale(Language: LCID; out FontCharSet: Byte): Boolean; -function CodePageFromLocale(Language: LCID): Word; -function CodeBlockName(const CB: TUnicodeBlock): string; -function CodeBlockRange(const CB: TUnicodeBlock): TUnicodeBlockRange; -function CodeBlockFromChar(const C: UCS4): TUnicodeBlock; -function KeyboardCodePage: Word; -function KeyUnicode(C: Char): WideChar; -function StringToWideStringEx(const S: AnsiString; CodePage: Word): WideString; -function TranslateString(const S: AnsiString; CP1, CP2: Word): AnsiString; -function WideStringToStringEx(const WS: WideString; CodePage: Word): AnsiString; - -type - TCompareFunc = function (const W1, W2: WideString; Locale: LCID): Integer; - -var - WideCompareText: TCompareFunc; - -type - EJclUnicodeError = class(EJclError); - -// functions to load Unicode data from resource -procedure LoadCharacterCategories; -procedure LoadCaseMappingData; -procedure LoadDecompositionData; -procedure LoadCombiningClassData; -procedure LoadNumberData; -procedure LoadCompositionData; - -// functions around TUCS4Array -function UCS4Array(Ch: UCS4): TUCS4Array; -function UCS4ArrayConcat(Left, Right: UCS4): TUCS4Array; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -procedure UCS4ArrayConcat(var Left: TUCS4Array; Right: UCS4); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -procedure UCS4ArrayConcat(var Left: TUCS4Array; const Right: TUCS4Array); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function UCS4ArrayEquals(const Left: TUCS4Array; const Right: TUCS4Array): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function UCS4ArrayEquals(const Left: TUCS4Array; Right: UCS4): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function UCS4ArrayEquals(const Left: TUCS4Array; const Right: AnsiString): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} -function UCS4ArrayEquals(const Left: TUCS4Array; Right: AnsiChar): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\common'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -// Unicode data for case mapping, decomposition, numbers etc. This data is -// loaded on demand which means only those parts will be put in memory which are -// needed by one of the lookup functions. -// Note: There is a little tool called UDExtract which creates a resouce script from -// the Unicode database file which can be compiled to the needed res file. -// This tool, including its source code, can be downloaded from www.lischke-online.de/Unicode.html. - -{$IFNDEF UNICODE_RTL_DATABASE} -{$IFDEF UNICODE_RAW_DATA} -{$R JclUnicode.res} -{$ENDIF UNICODE_RAW_DATA} -{$IFDEF UNICODE_BZIP2_DATA} -{$R JclUnicodeBZip2.res} -{$ENDIF UNICODE_BZIP2_DATA} -{$IFDEF UNICODE_ZLIB_DATA} -{$R JclUnicodeZLib.res} -{$ENDIF UNICODE_ZLIB_DATA} -{$ENDIF ~UNICODE_RTL_DATABASE} - -uses - {$IFDEF HAS_UNIT_RTLCONSTS} - {$IFDEF HAS_UNITSCOPE} - System.RtlConsts, - {$ELSE ~HAS_UNITSCOPE} - RtlConsts, - {$ENDIF ~HAS_UNITSCOPE} - {$ENDIF HAS_UNIT_RTLCONSTS} - {$IFNDEF UNICODE_RTL_DATABASE} - {$IFDEF UNICODE_BZIP2_DATA} - BZip2, - {$ENDIF UNICODE_BZIP2_DATA} - {$IFDEF UNICODE_ZLIB_DATA} - ZLibh, - {$ENDIF UNICODE_ZLIB_DATA} - JclStreams, - {$IFNDEF UNICODE_RAW_DATA} - JclCompression, - {$ENDIF ~UNICODE_RAW_DATA} - {$ENDIF ~UNICODE_RTL_DATABASE} - JclResources, JclSynch, JclSysUtils, JclSysInfo, JclStringConversions, JclWideStrings; - -const - {$IFDEF FPC} // declarations from unit [Rtl]Consts - SDuplicateString = 'String list does not allow duplicates'; - SListIndexError = 'List index out of bounds (%d)'; - SSortedListError = 'Operation not allowed on sorted string list'; - {$ENDIF FPC} - // some predefined sets to shorten parameter lists below and ease repeative usage - ClassLetter = [ccLetterUppercase, ccLetterLowercase, ccLetterTitlecase, ccLetterModifier, ccLetterOther]; - ClassSpace = [ccSeparatorSpace]; - ClassPunctuation = [ccPunctuationConnector, ccPunctuationDash, ccPunctuationOpen, ccPunctuationClose, - ccPunctuationOther, ccPunctuationInitialQuote, ccPunctuationFinalQuote]; - ClassMark = [ccMarkNonSpacing, ccMarkSpacingCombining, ccMarkEnclosing]; - ClassNumber = [ccNumberDecimalDigit, ccNumberLetter, ccNumberOther]; - ClassSymbol = [ccSymbolMath, ccSymbolCurrency, ccSymbolModifier, ccSymbolOther]; - ClassEuropeanNumber = [ccEuropeanNumber, ccEuropeanNumberSeparator, ccEuropeanNumberTerminator]; - - // used to negate a set of categories - ClassAll = [Low(TCharacterCategory)..High(TCharacterCategory)]; - -{$IFDEF HAS_UNIT_CHARACTER} -function CharacterCategoriesToUnicodeCategory(const Categories: TCharacterCategories): TUnicodeCategory; -var - Category: TCharacterUnicodeCategory; -begin - for Category := Low(TCharacterUnicodeCategory) to High(TCharacterUnicodeCategory) do - if Category in Categories then - begin - Result := CharacterCategoryToUnicodeCategory[Category]; - Exit; - end; - Result := TUnicodeCategory.ucUnassigned; -end; - -function UnicodeCategoryToCharacterCategories(Category: TUnicodeCategory): TCharacterCategories; -begin - Result := []; - Include(Result, UnicodeCategoryToCharacterCategory[Category]); -end; -{$ENDIF HAS_UNIT_CHARACTER} - -{$IFDEF UNICODE_RTL_DATABASE} -procedure LoadCharacterCategories; -begin - // do nothing, the RTL database is already loaded -end; - -procedure LoadCaseMappingData; -begin - // do nothing, the RTL database is already loaded -end; - -procedure LoadDecompositionData; -begin - // do nothing, the RTL database is already loaded -end; - -procedure LoadCombiningClassData; -begin - // do nothing, the RTL database is already loaded -end; - -procedure LoadNumberData; -begin - // do nothing, the RTL database is already loaded -end; - -procedure LoadCompositionData; -begin - // do nothing, the RTL database is already loaded -end; -{$ELSE ~UNICODE_RTL_DATABASE} -var - // As the global data can be accessed by several threads it should be guarded - // while the data is loaded. - LoadInProgress: TJclCriticalSection; - -function OpenResourceStream(const ResName: string): TJclEasyStream; -var - ResourceStream: TStream; - {$IFNDEF UNICODE_RAW_DATA} - DecompressionStream: TStream; - RawStream: TMemoryStream; - {$ENDIF ~UNICODE_RAW_DATA} -begin - ResourceStream := TResourceStream.Create(HInstance, ResName, 'UNICODEDATA'); - {$IFDEF UNICODE_RAW_DATA} - Result := TJclEasyStream.Create(ResourceStream, True); - {$ENDIF UNICODE_RAW_DATA} - {$IFDEF UNICODE_BZIP2_DATA} - try - LoadBZip2; - DecompressionStream := TJclBZIP2DecompressionStream.Create(ResourceStream); - try - RawStream := TMemoryStream.Create; - StreamCopy(DecompressionStream, RawStream); - RawStream.Seek(0, soBeginning); - Result := TJclEasyStream.Create(RawStream, True); - finally - DecompressionStream.Free; - end; - finally - ResourceStream.Free; - end; - {$ENDIF UNICODE_BZIP2_DATA} - {$IFDEF UNICODE_ZLIB_DATA} - try - LoadZLib; - DecompressionStream := TJclZLibDecompressStream.Create(ResourceStream); - try - RawStream := TMemoryStream.Create; - StreamCopy(DecompressionStream, RawStream); - RawStream.Seek(0, soBeginning); - Result := TJclEasyStream.Create(RawStream, True); - finally - DecompressionStream.Free; - end; - finally - ResourceStream.Free; - end; - {$ENDIF UNICODE_ZLIB_DATA} -end; - -function StreamReadChar(Stream: TStream): Cardinal; -begin - Result := 0; - Stream.ReadBuffer(Result, 3); -end; - -//----------------- support for character categories ----------------------------------------------- - -// Character category data is quite a large block since every defined character in Unicode is assigned at least -// one category. Because of this we cannot use a sparse matrix to provide quick access as implemented for -// e.g. composition data. -// The approach used here is based on the fact that an application seldomly uses all characters defined in Unicode -// simultanously. In fact the opposite is true. Most application will use either Western Europe or Arabic or -// Far East character data, but very rarely all together. Based on this fact is the implementation of virtual -// memory using the systems paging file (aka file mapping) to load only into virtual memory what is used currently. -// The implementation is not yet finished and needs a lot of improvements yet. - -type - // start and stop of a range of code points - TRange = record - Start, - Stop: Cardinal; - end; - - TRangeArray = array of TRange; - TCategoriesArray = array of array of TCharacterCategories; - -var - // character categories, stored in the system's swap file and mapped on demand - CategoriesLoaded: Boolean; - Categories: array [Byte] of TCategoriesArray; - -procedure LoadCharacterCategories; -// Loads the character categories data (as saved by the Unicode database extractor, see also -// the comments about JclUnicode.res above). -var - Size: Integer; - Stream: TJclEasyStream; - Category: TCharacterCategory; - Buffer: TRangeArray; - First, Second, Third: Byte; - J, K: Integer; -begin - // make sure no other code is currently modifying the global data area - LoadInProgress.Enter; - try - // Data already loaded? - if not CategoriesLoaded then - begin - Stream := OpenResourceStream('CATEGORIES'); - try - while Stream.Position < Stream.Size do - begin - // a) read which category is current in the stream - Category := TCharacterCategory(Stream.ReadByte); - // b) read the size of the ranges and the ranges themself - Size := Stream.ReadInteger; - if Size > 0 then - begin - SetLength(Buffer, Size); - for J := 0 to Size - 1 do - begin - Buffer[J].Start := StreamReadChar(Stream); - Buffer[J].Stop := StreamReadChar(Stream); - end; - - // c) go through every range and add the current category to each code point - for J := 0 to Size - 1 do - for K := Buffer[J].Start to Buffer[J].Stop do - begin - Assert(K < $1000000, LoadResString(@RsCategoryUnicodeChar)); - - First := (K shr 16) and $FF; - Second := (K shr 8) and $FF; - Third := K and $FF; - // add second step array if not yet done - if Categories[First] = nil then - SetLength(Categories[First], 256); - if Categories[First, Second] = nil then - SetLength(Categories[First, Second], 256); - // The array is allocated on the exact size, but the compiler generates - // a 32 bit "BTS" instruction that accesses memory beyond the allocated block. - if Third < 255 then - Include(Categories[First, Second, Third], Category) - else - Categories[First, Second, Third] := Categories[First, Second, Third] + [Category]; - end; - end; - end; - // Assert(Stream.Position = Stream.Size); - finally - Stream.Free; - CategoriesLoaded := True; - end; - end; - finally - LoadInProgress.Leave; - end; -end; - -function CategoryLookup(Code: Cardinal; Cats: TCharacterCategories): Boolean; overload; -// determines whether the Code is in the given category -var - First, Second, Third: Byte; -begin - Assert(Code < $1000000, LoadResString(@RsCategoryUnicodeChar)); - - // load property data if not already done - if not CategoriesLoaded then - LoadCharacterCategories; - - First := (Code shr 16) and $FF; - Second := (Code shr 8) and $FF; - Third := Code and $FF; - if (Categories[First] <> nil) and (Categories[First, Second] <> nil) then - Result := Categories[First, Second, Third] * Cats <> [] - else - Result := False; -end; - -//----------------- support for case mapping ------------------------------------------------------- - -type - TCase = array [TCaseType] of TUCS4Array; // mapping for case fold, lower, title and upper in this order - TCaseArray = array of array of TCase; - -var - // An array for all case mappings (including 1 to many casing if saved by the extraction program). - // The organization is a sparse, two stage matrix. - // SingletonMapping is to quickly return a single default mapping. - CaseDataLoaded: Boolean; - CaseMapping: array [Byte] of TCaseArray; - -procedure LoadCaseMappingData; -var - Stream: TJclEasyStream; - I, J, Code, Size: Integer; - First, Second, Third: Byte; -begin - // make sure no other code is currently modifying the global data area - LoadInProgress.Enter; - try - if not CaseDataLoaded then - begin - Stream := OpenResourceStream('CASE'); - try - // the first entry in the stream is the number of entries in the case mapping table - Size := Stream.ReadInteger; - for I := 0 to Size - 1 do - begin - // a) read actual code point - Code := StreamReadChar(Stream); - Assert(Code < $1000000, LoadResString(@RsCasedUnicodeChar)); - - // if there is no high byte entry in the first stage table then create one - First := (Code shr 16) and $FF; - Second := (Code shr 8) and $FF; - Third := Code and $FF; - if CaseMapping[First] = nil then - SetLength(CaseMapping[First], 256); - if CaseMapping[First, Second] = nil then - SetLength(CaseMapping[First, Second], 256); - - // b) read fold case array - Size := Stream.ReadByte; - if Size > 0 then - begin - SetLength(CaseMapping[First, Second, Third, ctFold], Size); - for J := 0 to Size - 1 do - CaseMapping[First, Second, Third, ctFold, J] := StreamReadChar(Stream); - end; - // c) read lower case array - Size := Stream.ReadByte; - if Size > 0 then - begin - SetLength(CaseMapping[First, Second, Third, ctLower], Size); - for J := 0 to Size - 1 do - CaseMapping[First, Second, Third, ctLower, J] := StreamReadChar(Stream); - end; - // d) read title case array - Size := Stream.ReadByte; - if Size > 0 then - begin - SetLength(CaseMapping[First, Second, Third, ctTitle], Size); - for J := 0 to Size - 1 do - CaseMapping[First, Second, Third, ctTitle, J] := StreamReadChar(Stream); - end; - // e) read upper case array - Size := Stream.ReadByte; - if Size > 0 then - begin - SetLength(CaseMapping[First, Second, Third, ctUpper], Size); - for J := 0 to Size - 1 do - CaseMapping[First, Second, Third, ctUpper, J] := StreamReadChar(Stream); - end; - end; - Assert(Stream.Position = Stream.Size); - finally - Stream.Free; - CaseDataLoaded := True; - end; - end; - finally - LoadInProgress.Leave; - end; -end; - -function CaseLookup(Code: Cardinal; CaseType: TCaseType; var Mapping: TUCS4Array): Boolean; -// Performs a lookup of the given code; returns True if Found, with Mapping referring to the mapping. -// ctFold is handled specially: if no mapping is found then result of looking up ctLower -// is returned -var - First, Second, Third: Byte; -begin - Assert(Code < $1000000, LoadResString(@RsCasedUnicodeChar)); - - // load case mapping data if not already done - if not CaseDataLoaded then - LoadCaseMappingData; - - First := (Code shr 16) and $FF; - Second := (Code shr 8) and $FF; - Third := Code and $FF; - // Check first stage table whether there is a mapping for a particular block and - // (if so) then whether there is a mapping or not. - if (CaseMapping[First] <> nil) and (CaseMapping[First, Second] <> nil) and - (CaseMapping[First, Second, Third, CaseType] <> nil) then - Mapping := CaseMapping[First, Second, Third, CaseType] - else - Mapping := nil; - Result := Assigned(Mapping); - // defer to lower case if no fold case exists - if not Result and (CaseType = ctFold) and (CaseMapping[First] <> nil) and - (CaseMapping[First, Second] <> nil) and (CaseMapping[First, Second, Third, ctLower] <> nil) then - begin - Mapping := CaseMapping[First, Second, Third, ctLower]; - Result := Assigned(Mapping); - end; -end; - -function UnicodeCaseFold(Code: UCS4): TUCS4Array; -// This function returnes an array of special case fold mappings if there is one defined for the given -// code, otherwise the lower case will be returned. This all applies only to cased code points. -// Uncased code points are returned unchanged. -begin - SetLength(Result, 0); - if not CaseLookup(Code, ctFold, Result) then - begin - SetLength(Result, 1); - Result[0] := Code; - end; -end; - -{$ENDIF ~UNICODE_RTL_DATABASE} - -function UnicodeToUpper(Code: UCS4): TUCS4Array; -begin - {$IFDEF UNICODE_RTL_DATABASE} - SetLength(Result, 1); - Result[0] := Ord(TCharacter.ToUpper(Chr(Code))); - {$ELSE ~UNICODE_RTL_DATABASE} - SetLength(Result, 0); - if not CaseLookup(Code, ctUpper, Result) then - begin - SetLength(Result, 1); - Result[0] := Code; - end; - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeToLower(Code: UCS4): TUCS4Array; -begin - {$IFDEF UNICODE_RTL_DATABASE} - SetLength(Result, 1); - Result[0] := Ord(TCharacter.ToLower(Chr(Code))); - {$ELSE ~UNICODE_RTL_DATABASE} - SetLength(Result, 0); - if not CaseLookup(Code, ctLower, Result) then - begin - SetLength(Result, 1); - Result[0] := Code; - end; - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -{$IFNDEF UNICODE_RTL_DATABASE} - -function UnicodeToTitle(Code: UCS4): TUCS4Array; -begin - SetLength(Result, 0); - if not CaseLookup(Code, ctTitle, Result) then - begin - SetLength(Result, 1); - Result[0] := Code; - end; -end; - -//----------------- support for decomposition ------------------------------------------------------ - -const - // constants for hangul composition and hangul-to-jamo decomposition - SBase = $AC00; // hangul syllables start code point - LBase = $1100; // leading syllable - VBase = $1161; - TBase = $11A7; // trailing syllable - LCount = 19; - VCount = 21; - TCount = 28; - NCount = VCount * TCount; // 588 - SCount = LCount * NCount; // 11172 - -type - TDecomposition = record - Tag: TCompatibilityFormattingTag; - Leaves: TUCS4Array; - end; - TDecompositions = array of array of TDecomposition; - TDecompositionsArray = array [Byte] of TDecompositions; - -var - // list of decompositions, organized (again) as three stage matrix - // Note: there are two tables, one for canonical decompositions and the other one - // for compatibility decompositions. - DecompositionsLoaded: Boolean; - Decompositions: TDecompositionsArray; - -procedure LoadDecompositionData; -var - Stream: TJclEasyStream; - I, J, Code, Size: Integer; - First, Second, Third: Byte; -begin - // make sure no other code is currently modifying the global data area - LoadInProgress.Enter; - try - if not DecompositionsLoaded then - begin - Stream := OpenResourceStream('DECOMPOSITION'); - try - // determine how many decomposition entries we have - Size := Stream.ReadInteger; - for I := 0 to Size - 1 do - begin - Code := StreamReadChar(Stream); - - Assert(Code < $1000000, LoadResString(@RsDecomposedUnicodeChar)); - - First := (Code shr 16) and $FF; - Second := (Code shr 8) and $FF; - Third := Code and $FF; - - // if there is no high byte entry in the first stage table then create one - if Decompositions[First] = nil then - SetLength(Decompositions[First], 256); - if Decompositions[First, Second] = nil then - SetLength(Decompositions[First, Second], 256); - - Size := Stream.ReadByte; - if Size > 0 then - begin - Decompositions[First, Second, Third].Tag := TCompatibilityFormattingTag(Stream.ReadByte); - SetLength(Decompositions[First, Second, Third].Leaves, Size); - for J := 0 to Size - 1 do - Decompositions[First, Second, Third].Leaves[J] := StreamReadChar(Stream); - end; - end; - Assert(Stream.Position = Stream.Size); - finally - Stream.Free; - DecompositionsLoaded := True; - end; - end; - finally - LoadInProgress.Leave; - end; -end; - -function UnicodeDecomposeHangul(Code: UCS4): TUCS4Array; -// algorithmically decomposes hangul character -var - Rest: Integer; -begin - Dec(Code, SBase); - Rest := Code mod TCount; - if Rest = 0 then - SetLength(Result, 2) - else - SetLength(Result, 3); - Result[0] := LBase + (Code div NCount); - Result[1] := VBase + ((Code mod NCount) div TCount); - if Rest <> 0 then - Result[2] := TBase + Rest; -end; - -function UnicodeDecompose(Code: UCS4; Compatible: Boolean): TUCS4Array; -var - First, Second, Third: Byte; -begin - Assert(Code < $1000000, LoadResString(@RsDecomposedUnicodeChar)); - - // load decomposition data if not already done - if not DecompositionsLoaded then - LoadDecompositionData; - - Result := nil; - - // if the code is hangul then decomposition is algorithmically - if UnicodeIsHangul(Code) then - Result := UnicodeDecomposeHangul(Code) - else - begin - First := (Code shr 16) and $FF; - Second := (Code shr 8) and $FF; - Third := Code and $FF; - - if (Decompositions[First] <> nil) and (Decompositions[First, Second] <> nil) - and (Decompositions[First, Second, Third].Leaves <> nil) - and (Compatible or (Decompositions[First, Second, Third].Tag = cftCanonical)) then - Result := Decompositions[First, Second, Third].Leaves - else - Result := nil; - end; -end; - -function UnicodeDecompose(Code: UCS4; Tags: TCompatibilityFormattingTags): TUCS4Array; -var - First, Second, Third: Byte; -begin - Assert(Code < $1000000, LoadResString(@RsDecomposedUnicodeChar)); - - // load decomposition data if not already done - if not DecompositionsLoaded then - LoadDecompositionData; - - Result := nil; - - // if the code is hangul then decomposition is algorithmically - if UnicodeIsHangul(Code) then - Result := UnicodeDecomposeHangul(Code) - else - begin - First := (Code shr 16) and $FF; - Second := (Code shr 8) and $FF; - Third := Code and $FF; - - if (Decompositions[First] <> nil) and (Decompositions[First, Second] <> nil) - and (Decompositions[First, Second, Third].Leaves <> nil) - and (Decompositions[First, Second, Third].Tag in Tags) then - Result := Decompositions[First, Second, Third].Leaves - else - Result := nil; - end; -end; - -//----------------- support for combining classes -------------------------------------------------- - -type - TClassArray = array of array of Byte; - -var - // canonical combining classes, again as two stage matrix - CCCsLoaded: Boolean; - CCCs: array [Byte] of TClassArray; - -procedure LoadCombiningClassData; -var - Stream: TJclEasyStream; - I, J, K, Size: Integer; - Buffer: TRangeArray; - First, Second, Third: Byte; -begin - // make sure no other code is currently modifying the global data area - LoadInProgress.Enter; - try - if not CCCsLoaded then - begin - Stream := OpenResourceStream('COMBINING'); - try - while Stream.Position < Stream.Size do - begin - // a) determine which class is stored here - I := Stream.ReadByte; - // b) determine how many ranges are assigned to this class - Size := Stream.ReadByte; - // c) read start and stop code of each range - if Size > 0 then - begin - SetLength(Buffer, Size); - for J := 0 to Size - 1 do - begin - Buffer[J].Start := StreamReadChar(Stream); - Buffer[J].Stop := StreamReadChar(Stream); - end; - - // d) put this class in every of the code points just loaded - for J := 0 to Size - 1 do - for K := Buffer[J].Start to Buffer[J].Stop do - begin - // (outchy) TODO: handle in a cleaner way - Assert(K < $1000000, LoadResString(@RsCombiningClassUnicodeChar)); - First := (K shr 16) and $FF; - Second := (K shr 8) and $FF; - Third := K and $FF; - // add second step array if not yet done - if CCCs[First] = nil then - SetLength(CCCs[First], 256); - if CCCs[First, Second] = nil then - SetLength(CCCs[First, Second], 256); - CCCs[First, Second, Third] := I; - end; - end; - end; - // Assert(Stream.Position = Stream.Size); - finally - Stream.Free; - CCCsLoaded := True; - end; - end; - finally - LoadInProgress.Leave; - end; -end; - -function CanonicalCombiningClass(Code: Cardinal): Cardinal; -var - First, Second, Third: Byte; -begin - Assert(Code < $1000000, LoadResString(@RsCombiningClassUnicodeChar)); - - // load combining class data if not already done - if not CCCsLoaded then - LoadCombiningClassData; - - First := (Code shr 16) and $FF; - Second := (Code shr 8) and $FF; - Third := Code and $FF; - if (CCCs[First] <> nil) and (CCCs[First, Second] <> nil) then - Result := CCCs[First, Second, Third] - else - Result := 0; -end; - -//----------------- support for numeric values ----------------------------------------------------- - -type - // structures for handling numbers - TCodeIndex = record - Code, - Index: Cardinal; - end; - -var - // array to hold the number equivalents for specific codes - NumberCodesLoaded: Boolean; - NumberCodes: array of TCodeIndex; - // array of numbers used in NumberCodes - Numbers: array of TUcNumber; - -procedure LoadNumberData; -var - Stream: TJclEasyStream; - Size, I: Integer; -begin - // make sure no other code is currently modifying the global data area - LoadInProgress.Enter; - try - if not NumberCodesLoaded then - begin - Stream := OpenResourceStream('NUMBERS'); - try - // Numbers are special (compared to other Unicode data) as they utilize two - // arrays, one containing all used numbers (in nominator-denominator format) and - // another one which maps a code point to one of the numbers in the first array. - - // a) determine size of numbers array - Size := Stream.ReadByte; - SetLength(Numbers, Size); - // b) read numbers data - for I := 0 to Size - 1 do - begin - Numbers[I].Numerator := Stream.ReadInteger; - Numbers[I].Denominator := Stream.ReadInteger; - end; - // c) determine size of index array - Size := Stream.ReadInteger; - SetLength(NumberCodes, Size); - // d) read index data - for I := 0 to Size - 1 do - begin - NumberCodes[I].Code := StreamReadChar(Stream); - NumberCodes[I].Index := Stream.ReadByte; - end; - Assert(Stream.Position = Stream.Size); - finally - Stream.Free; - NumberCodesLoaded := True; - end; - end; - finally - LoadInProgress.Leave; - end; -end; - -function UnicodeNumberLookup(Code: UCS4; var Number: TUcNumber): Boolean; -// Searches for the given code and returns its number equivalent (if there is one). -// Typical cases are: '1/6' (U+2159), '3/8' (U+215C), 'XII' (U+216B) etc. -// Result is set to True if the code could be found. -var - L, R, M: Integer; -begin - // load number data if not already done - if not NumberCodesLoaded then - LoadNumberData; - - Result := False; - L := 0; - R := High(NumberCodes); - while L <= R do - begin - M := (L + R) shr 1; - if Code > NumberCodes[M].Code then - L := M + 1 - else - begin - if Code < NumberCodes[M].Code then - R := M - 1 - else - begin - Number := Numbers[NumberCodes[M].Index]; - Result := True; - Break; - end; - end; - end; -end; - -//----------------- support for composition -------------------------------------------------------- - -type - // maps between a pair of code points to a composite code point - // Note: the source pair is packed into one 4 byte value to speed up search. - TComposition = record - Code: Cardinal; - Tag: TCompatibilityFormattingTag; - First: Cardinal; - Next: array of Cardinal; - end; - -var - // list of composition mappings - CompositionsLoaded: Boolean; - Compositions: array of TComposition; - MaxCompositionSize: Integer; - -procedure LoadCompositionData; -var - Stream: TJclEasyStream; - I, J, Size: Integer; -begin - // make sure no other code is currently modifying the global data area - LoadInProgress.Enter; - try - if not CompositionsLoaded then - begin - Stream := OpenResourceStream('COMPOSITION'); - try - // a) determine size of compositions array - Size := Stream.ReadInteger; - SetLength(Compositions, Size); - // b) read data - for I := 0 to Size - 1 do - begin - Compositions[I].Code := StreamReadChar(Stream); - Size := Stream.ReadByte; - if Size > MaxCompositionSize then - MaxCompositionSize := Size; - SetLength(Compositions[I].Next, Size - 1); - Compositions[I].Tag := TCompatibilityFormattingTag(Stream.ReadByte); - Compositions[I].First := StreamReadChar(Stream); - for J := 0 to Size - 2 do - Compositions[I].Next[J] := StreamReadChar(Stream); - end; - Assert(Stream.Position = Stream.Size); - finally - Stream.Free; - CompositionsLoaded := True; - end; - end; - finally - LoadInProgress.Leave; - end; -end; - -function UnicodeCompose(const Codes: array of UCS4; out Composite: UCS4; Compatible: Boolean): Integer; -// Maps the sequence of Codes (up to MaxCompositionSize codes) to a composite -// Result is the number of Codes that were composed (at least 1 if Codes is not empty) -var - L, R, M, I, HighCodes, HighNext: Integer; -begin - if not CompositionsLoaded then - LoadCompositionData; - - Result := 0; - HighCodes := High(Codes); - - if HighCodes = -1 then - Exit; - - if HighCodes = 0 then - begin - Result := 1; - Composite := Codes[0]; - Exit; - end; - - L := 0; - R := High(Compositions); - - while L <= R do - begin - M := (L + R) shr 1; - if Compositions[M].First > Codes[0] then - R := M - 1 - else - if Compositions[M].First < Codes[0] then - L := M + 1 - else - begin - // back to the first element where Codes[0] = First - while (M > 0) and (Compositions[M-1].First = Codes[0]) do - Dec(M); - - while (M <= High(Compositions)) and (Compositions[M].First = Codes[0]) do - begin - HighNext := High(Compositions[M].Next); - Result := 0; - - if (HighNext < HighCodes) // enough characters in buffer to be tested - and (Compatible or (Compositions[M].Tag = cftCanonical)) then - begin - for I := 0 to HighNext do - if Compositions[M].Next[I] = Codes[I + 1] then - Result := I + 2 { +1 for first, +1 because of 0-based array } - else - Break; - - if Result = HighNext + 2 then // all codes matched - begin - Composite := Compositions[M].Code; - Exit; - end; - end; - - Inc(M); - end; - Break; - end; - end; - Result := 1; - Composite := Codes[0]; -end; - -function UnicodeCompose(const Codes: array of UCS4; out Composite: UCS4; Tags: TCompatibilityFormattingTags): Integer; -// Maps the sequence of Codes (up to MaxCompositionSize codes) to a composite -// Result is the number of Codes that were composed (at least 1 if Codes is not empty) -var - L, R, M, I, HighCodes, HighNext: Integer; -begin - if not CompositionsLoaded then - LoadCompositionData; - - Result := 0; - HighCodes := High(Codes); - - if HighCodes = -1 then - Exit; - - if HighCodes = 0 then - begin - Result := 1; - Composite := Codes[0]; - Exit; - end; - - L := 0; - R := High(Compositions); - - while L <= R do - begin - M := (L + R) shr 1; - if Compositions[M].First > Codes[0] then - R := M - 1 - else - if Compositions[M].First < Codes[0] then - L := M + 1 - else - begin - // back to the first element where Codes[0] = First - while (M > 0) and (Compositions[M-1].First = Codes[0]) do - Dec(M); - - while (M <= High(Compositions)) and (Compositions[M].First = Codes[0]) do - begin - HighNext := High(Compositions[M].Next); - Result := 0; - - if (HighNext < HighCodes) // enough characters in buffer to be tested - and (Compositions[M].Tag in Tags) then - begin - for I := 0 to HighNext do - if Compositions[M].Next[I] = Codes[I + 1] then - Result := I + 2 { +1 for first, +1 because of 0-based array } - else - Break; - - if Result = HighNext + 2 then // all codes matched - begin - Composite := Compositions[M].Code; - Exit; - end; - end; - - Inc(M); - end; - Break; - end; - end; - Result := 1; - Composite := Codes[0]; -end; - -//=== { TSearchEngine } ====================================================== - -constructor TSearchEngine.Create(AOwner: TWideStrings); -begin - inherited Create; - FOwner := AOwner; - FResults := TList.Create; -end; - -destructor TSearchEngine.Destroy; -begin - Clear; - FResults.Free; - inherited Destroy; -end; - -procedure TSearchEngine.AddResult(Start, Stop: SizeInt); -begin - FResults.Add(Pointer(Start)); - FResults.Add(Pointer(Stop)); -end; - -procedure TSearchEngine.Clear; -begin - ClearResults; -end; - -procedure TSearchEngine.ClearResults; -begin - FResults.Clear; -end; - -procedure TSearchEngine.DeleteResult(Index: SizeInt); -// explicitly deletes a search result -begin - with FResults do - begin - // start index - Delete(2 * Index); - // stop index - Delete(2 * Index); - end; -end; - -function TSearchEngine.GetCount: SizeInt; -// returns the number of matches found -begin - Result := FResults.Count div 2; -end; - -procedure TSearchEngine.GetResult(Index: SizeInt; var Start, Stop: SizeInt); -// returns the start position of a match (end position can be determined by -// adding the length of the pattern to the start position) -begin - Start := SizeInt(FResults[2 * Index]); - Stop := SizeInt(FResults[2 * Index + 1]); -end; - -//----------------- TUTBSearch --------------------------------------------------------------------- - -procedure TUTBMSearch.ClearPattern; -begin - FreeMem(FPattern); - FPattern := nil; - FFlags := []; - FPatternUsed := 0; - FPatternSize := 0; - FPatternLength := 0; - FreeMem(FSkipValues); - FSkipValues := nil; - FSkipsUsed := 0; - FMD4 := 0; -end; - -function TUTBMSearch.GetSkipValue(TextStart, TextEnd: PUCS2): SizeInt; -// looks up the SkipValues value for a character -var - I: SizeInt; - C1, - C2: UCS4; - Sp: PUTBMSkip; -begin - Result := 0; - if TJclAddr(TextStart) < TJclAddr(TextEnd) then - begin - C1 := UCS4(TextStart^); - if (TextStart + 1) < TextEnd then - C2 := UCS4((TextStart + 1)^) - else - C2 := $FFFFFFFF; - if (SurrogateHighStart <= C1) and (C1 <= SurrogateHighEnd) and - (SurrogateLowStart <= C2) and (C2 <= $DDDD) then - C1 := $10000 + (((C1 and $03FF) shl 10) or (C2 and $03FF)); - - Sp := FSkipValues; - for I := 0 to FSkipsUsed - 1 do - begin - if not (Boolean(C1 xor Sp.BMChar.UpCase) and - Boolean(C1 xor Sp.BMChar.LoCase) and - Boolean(C1 xor Sp.BMChar.TitleCase)) then - begin - if (TextEnd - TextStart) < Sp.SkipValues then - Result := TextEnd - TextStart - else - Result := Sp.SkipValues; - Exit; - end; - Inc(Sp); - end; - Result := FPatternLength; - end; -end; - -function TUTBMSearch.Match(Text, Start, Stop: PUCS2; var MatchStart, MatchEnd: SizeInt): Boolean; -// Checks once whether the text at position Start (which points to the end of the -// current text part to be matched) matches. -// Note: If whole words only are allowed then the left and right border tests are -// done here too. The keypoint for the right border is that the next character -// after the search string is either the text end or a space character. -// For the left side this is similar, but there is nothing like a string -// start marker (like the string end marker #0). -// -// It seems not obvious, but we still can use the passed Text pointer to do -// the left check. Although this pointer might not point to the real string -// start (e.g. in TUTBMSearch.FindAll Text is incremented as needed) it is -// still a valid check mark. The reason is that Text either points to the -// real string start or a previous match (happened already, keep in mind the -// search options do not change in the FindAll loop) and the character just -// before Text is a space character. -// This fact implies, though, that strings passed to Find (or FindFirst, -// FindAll in TUTBMSearch) always really start at the given address. Although -// this might not be the case in some circumstances (e.g. if you pass only -// the selection from an editor) it is still assumed that a pattern matching -// from the first position on (from the search string start) also matches -// when whole words only are allowed. -var - CheckSpace: Boolean; - C1, C2: UCS4; - Count: SizeInt; - Cp: PUTBMChar; -begin - // be pessimistic - Result := False; - - // set the potential match endpoint first - MatchEnd := (Start - Text) + 1; - - C1 := UCS4(Start^); - if (Start + 1) < Stop then - C2 := UCS4((Start + 1)^) - else - C2 := $FFFFFFFF; - if (SurrogateHighStart <= C1) and (C1 <= SurrogateHighEnd) and - (SurrogateLowStart <= C2) and (C2 <= SurrogateLowEnd) then - begin - C1 := $10000 + (((C1 and $03FF) shl 10) or (C2 and $03FF)); - // Adjust the match end point to occur after the UTF-16 character. - Inc(MatchEnd); - end; - - // check special cases - if FPatternUsed = 1 then - begin - MatchStart := Start - Text; - Result := True; - Exit; - end; - - // Early out if entire words need to be matched and the next character - // in the search string is neither the string end nor a space character. - if (sfWholeWordOnly in FFlags) and - not ((Start + 1)^ = WideNull) and - not UnicodeIsWhiteSpace(UCS4((Start + 1)^)) then - Exit; - - // compare backward - Cp := FPattern; - Inc(Cp, FPatternUsed - 1); - - Count := FPatternLength; - while (Start >= Text) and (Count > 0) do - begin - // ignore non-spacing characters if indicated - if sfIgnoreNonSpacing in FFlags then - begin - while (Start > Text) and UnicodeIsNonSpacing(C1) do - begin - Dec(Start); - C2 := UCS4(Start^); - if (Start - 1) > Text then - C1 := UCS4((Start - 1)^) - else - C1 := $FFFFFFFF; - if (SurrogateLowStart <= C2) and (C2 <= SurrogateLowEnd) and - (SurrogateHighStart <= C1) and (C1 <= SurrogateHighEnd) then - begin - C1 := $10000 + (((C1 and $03FF) shl 10) or (C2 and $03FF)); - Dec(Start); - end - else - C1 := C2; - end; - end; - - // handle space compression if indicated - if sfSpaceCompress in FFlags then - begin - CheckSpace := False; - while (Start > Text) and (UnicodeIsWhiteSpace(C1) or UnicodeIsControl(C1)) do - begin - CheckSpace := UnicodeIsWhiteSpace(C1); - Dec(Start); - C2 := UCS4(Start^); - if (Start - 1) > Text then - C1 := UCS4((Start - 1)^) - else - C1 := $FFFFFFFF; - if (SurrogateLowStart <= C2) and (C2 <= SurrogateLowEnd) and - (SurrogateHighStart <= C1) and (C1 <= SurrogateHighEnd) then - begin - C1 := $10000 + (((C1 and $03FF) shl 10) or (C2 and $03FF)); - Dec(Start); - end - else - C1 := C2; - end; - // Handle things if space compression was indicated and one or - // more member characters were found. - if CheckSpace then - begin - if Cp.UpCase <> $20 then - Exit; - Dec(Cp); - Dec(Count); - // If Count is 0 at this place then the space character(s) was the first - // in the pattern and we need to correct the start position. - if Count = 0 then - Inc(Start); - end; - end; - - // handle the normal comparison cases - if (Count > 0) and - (Boolean(C1 xor Cp.UpCase) and - Boolean(C1 xor Cp.LoCase) and - Boolean(C1 xor Cp.TitleCase)) then - Exit; - - if C1 >= $10000 then - Dec(Count, 2) - else - Dec(Count, 1); - if Count > 0 then - begin - Dec(Cp); - // get the next preceding character - if Start > Text then - begin - Dec(Start); - C2 := UCS4(Start^); - if (Start - 1) > Text then - C1 := UCS4((Start - 1)^) - else - C1 := $FFFFFFFF; - if (SurrogateLowStart <= C2) and (C2 <= SurrogateLowEnd) and - (SurrogateHighStart <= C1) and (C1 <= SurrogateHighEnd) then - begin - C1 := $10000 + (((C1 and $03FF) shl 10) or (C2 and $03FF)); - Dec(Start); - end - else - C1 := C2; - end; - end; - end; - - // So far the string matched. Now check its left border for a space character - // if whole word only are allowed. - if not (sfWholeWordOnly in FFlags) or - (Start <= Text) or - UnicodeIsWhiteSpace(UCS4((Start - 1)^)) then - begin - // set the match start position - MatchStart := Start - Text; - Result := True; - end; -end; - -procedure TUTBMSearch.Compile(Pattern: PUCS2; PatternLength: SizeInt; Flags: TSearchFlags); -var - HaveSpace: Boolean; - I, J, K, - SLen: SizeInt; - Cp: PUTBMChar; - Sp: PUTBMSkip; - C1, C2, - Sentinel: UCS4; -begin - if (Pattern <> nil) and (Pattern^ <> #0) and (PatternLength > 0) then - begin - // do some initialization - FFlags := Flags; - // extra skip flag - FMD4 := 1; - - Sentinel := 0; - - // allocate more storage if necessary - FPattern := AllocMem(SizeOf(TUTBMChar) * PatternLength); - FSkipValues := AllocMem(SizeOf(TUTBMSkip) * PatternLength); - FPatternSize := PatternLength; - - // Preprocess the pattern to remove controls (if specified) and determine case. - Cp := FPattern; - I := 0; - HaveSpace := False; - while I < PatternLength do - begin - C1 := UCS4(Pattern[I]); - if (I + 1) < PatternLength then - C2 := UCS4(Pattern[I + 1]) - else - C2 := $FFFFFFFF; - if (SurrogateHighStart <= C1) and (C1 <= SurrogateHighEnd) and - (SurrogateLowStart <= C2) and (C2 <= SurrogateLowEnd) then - C1 := $10000 + (((C1 and $03FF) shl 10) or (C2 and $03FF)); - - // Make sure the HaveSpace flag is turned off if the character is not an - // appropriate one. - if not UnicodeIsWhiteSpace(C1) then - HaveSpace := False; - - // If non-spacing characters should be ignored, do it here. - if (sfIgnoreNonSpacing in Flags) and UnicodeIsNonSpacing(C1) then - begin - Inc(I); - Continue; - end; - - // check if spaces and controls need to be compressed - if sfSpaceCompress in Flags then - begin - if UnicodeIsWhiteSpace(C1) then - begin - if not HaveSpace then - begin - // Add a space and set the flag. - Cp.UpCase := $20; - Cp.LoCase := $20; - Cp.TitleCase := $20; - Inc(Cp); - - // increase the real pattern length - Inc(FPatternLength); - Sentinel := $20; - HaveSpace := True; - end; - Inc(I); - Continue; - end; - - // ignore all control characters - if UnicodeIsControl(C1) then - begin - Inc(I); - Continue; - end; - end; - - // add the character - if not (sfCaseSensitive in Flags) then - begin - { TODO : use the entire mapping, not only the first character } - Cp.UpCase := UnicodeToUpper(C1)[0]; - Cp.LoCase := UnicodeToLower(C1)[0]; - Cp.TitleCase := UnicodeToTitle(C1)[0]; - end - else - begin - Cp.UpCase := C1; - Cp.LoCase := C1; - Cp.TitleCase := C1; - end; - - Sentinel := Cp.UpCase; - - // move to the next character - Inc(Cp); - - // increase the real pattern length appropriately - if C1 >= $10000 then - Inc(FPatternLength, 2) - else - Inc(FPatternLength); - - // increment the loop index for UTF-16 characters - if C1 > $10000 then - Inc(I, 2) - else - Inc(I); - end; - - // set the number of characters actually used - FPatternUsed := (TJclAddr(Cp) - TJclAddr(FPattern)) div SizeOf(TUTBMChar); - - // Go through and construct the skip array and determine the actual length - // of the pattern in UCS2 terms. - SLen := FPatternLength - 1; - Cp := FPattern; - K := 0; - for I := 0 to FPatternUsed - 1 do - begin - // locate the character in the FSkipValues array - Sp := FSkipValues; - J := 0; - while (J < FSkipsUsed) and (Sp.BMChar.UpCase <> Cp.UpCase) do - begin - Inc(J); - Inc(Sp); - end; - - // If the character is not found, set the new FSkipValues element and - // increase the number of FSkipValues elements. - if J = FSkipsUsed then - begin - Sp.BMChar := Cp; - Inc(FSkipsUsed); - end; - - // Set the updated FSkipValues value. If the character is UTF-16 and is - // not the last one in the pattern, add one to its FSkipValues value. - Sp.SkipValues := SLen - K; - if (Cp.UpCase >= $10000) and ((K + 2) < SLen) then - Inc(Sp.SkipValues); - - // set the new extra FSkipValues for the sentinel character - if ((Cp.UpCase >= $10000) and - ((K + 2) <= SLen) or ((K + 1) <= SLen) and - (Cp.UpCase = Sentinel)) then - FMD4 := SLen - K; - - // increase the actual index - if Cp.UpCase >= $10000 then - Inc(K, 2) - else - Inc(K); - Inc(Cp); - end; - end; -end; - -function TUTBMSearch.Find(Text: PUCS2; TextLen: SizeInt; var MatchStart, MatchEnd: SizeInt): Boolean; -// this is the main matching routine using a tuned Boyer-Moore algorithm -var - K: SizeInt; - Start, - Stop: PUCS2; -begin - Result := False; - if (FPattern <> nil) and (FPatternUsed > 0) and (Text <> nil) and - (TextLen > 0) and (TextLen >= FPatternLength) then - begin - Start := Text + FPatternLength - 1; - Stop := Text + TextLen; - - // adjust the start point if it points to a low surrogate - if (SurrogateLowStart <= UCS4(Start^)) and - (UCS4(Start^) <= SurrogateLowEnd) and - (SurrogateHighStart <= UCS4((Start - 1)^)) and - (UCS4((Start - 1)^) <= SurrogateHighEnd) then - Dec(Start); - - while Start < Stop do - begin - repeat - K := GetSkipValue(Start, Stop); - if K = 0 then - Break; - Inc(Start, K); - if (Start < Stop) and - (SurrogateLowStart <= UCS4(Start^)) and - (UCS4(Start^) <= SurrogateLowEnd) and - (SurrogateHighStart <= UCS4((Start - 1)^)) and - (UCS4((Start - 1)^) <= SurrogateHighEnd) then - Dec(Start); - until False; - - if (Start < Stop) and Match(Text, Start, Stop, MatchStart, MatchEnd) then - begin - Result := True; - Break; - end; - Inc(Start, FMD4); - if (Start < Stop) and - (SurrogateLowStart <= UCS4(Start^)) and - (UCS4(Start^) <= SurrogateLowEnd) and - (SurrogateHighStart <= UCS4((Start - 1)^)) and - (UCS4((Start - 1)^) <= SurrogateHighEnd) then - Dec(Start); - end; - end; -end; - -procedure TUTBMSearch.Clear; -begin - ClearPattern; - inherited Clear; -end; - -function TUTBMSearch.FindAll(const Text: WideString): Boolean; -begin - Result := FindAll(PWideChar(Text), Length(Text)); -end; - -function TUTBMSearch.FindAll(Text: PWideChar; TextLen: SizeInt): Boolean; -// Looks for all occurrences of the pattern passed to FindPrepare and creates an -// internal list of their positions. -var - Start, Stop: SizeInt; - Run: PWideChar; - RunLen: SizeInt; -begin - ClearResults; - Run := Text; - RunLen := TextLen; - Start := 0; - Stop := 0; - // repeat to find all occurrences of the pattern - while Find(Run, RunLen, Start, Stop) do - begin - // store this result (consider text pointer movement)... - AddResult(Start + (Run - Text), Stop + (Run - Text)); - // ... and advance text position and length - Inc(Run, Stop); - Dec(RunLen, Stop); - end; - Result := Count > 0; -end; - -function TUTBMSearch.FindFirst(const Text: WideString; var Start, Stop: SizeInt): Boolean; -// Looks for the first occurrence of the pattern passed to FindPrepare in Text and -// returns True if one could be found (in which case Start and Stop are set to -// the according indices) otherwise False. This function is in particular of -// interest if only one occurrence needs to be found. -begin - ClearResults; - Result := Find(PWideChar(Text), Length(Text), Start, Stop); - if Result then - AddResult(Start, Stop); -end; - -function TUTBMSearch.FindFirst(Text: PWideChar; TextLen: SizeInt; var Start, Stop: SizeInt): Boolean; -// Same as the WideString version of this method. -begin - ClearResults; - Result := Find(Text, TextLen, Start, Stop); - if Result then - AddResult(Start, Stop); -end; - -procedure TUTBMSearch.FindPrepare(const Pattern: WideString; Options: TSearchFlags); -begin - FindPrepare(PWideChar(Pattern), Length(Pattern), Options); -end; - -procedure TUTBMSearch.FindPrepare(Pattern: PWideChar; PatternLength: SizeInt; Options: TSearchFlags); -// prepares following search by compiling the given pattern into an internal structure -begin - Compile(Pattern, PatternLength, Options); -end; - -//----------------- Unicode RE search core --------------------------------------------------------- - -const - // error codes - _URE_OK = 0; - _URE_UNEXPECTED_EOS = -1; - _URE_CCLASS_OPEN = -2; - _URE_UNBALANCED_GROUP = -3; - _URE_INVALID_PROPERTY = -4; - _URE_INVALID_RANGE = -5; - _URE_RANGE_OPEN = -6; - - // options that can be combined for searching - URE_IGNORE_NONSPACING = $01; - URE_DONT_MATCHES_SEPARATORS = $02; - -const - // Flags used internally in the DFA - _URE_DFA_CASEFOLD = $01; - _URE_DFA_BLANKLINE = $02; - - // symbol types for the DFA - _URE_ANY_CHAR = 1; - _URE_CHAR = 2; - _URE_CCLASS = 3; - _URE_NCCLASS = 4; - _URE_BOL_ANCHOR = 5; - _URE_EOL_ANCHOR = 6; - - // op codes for converting the NFA to a DFA - _URE_SYMBOL = 10; - _URE_PAREN = 11; - _URE_QUEST = 12; - _URE_STAR = 13; - _URE_PLUS = 14; - _URE_ONE = 15; - _URE_AND = 16; - _URE_OR = 17; - - _URE_NOOP = $FFFF; - -//----------------- TURESearch --------------------------------------------------------------------- - -procedure TURESearch.Clear; -begin - inherited Clear; - ClearUREBuffer; - ClearDFA; -end; - -procedure TURESearch.Push(V: SizeInt); -begin - with FUREBuffer do - begin - // If the 'Reducing' parameter is True, check to see if the value passed is - // already on the stack. - if Reducing and ExpressionList.Expressions[Word(V)].OnStack then - Exit; - - if Stack.ListUsed = Length(Stack.List) then - SetLength(Stack.List, Length(Stack.List) + 8); - Stack.List[Stack.ListUsed] := V; - Inc(Stack.ListUsed); - - // If the 'reducing' parameter is True, flag the element as being on the Stack. - if Reducing then - ExpressionList.Expressions[Word(V)].OnStack := True; - end; -end; - -function TURESearch.Peek: SizeInt; -begin - if FUREBuffer.Stack.ListUsed = 0 then - Result := _URE_NOOP - else - Result := FUREBuffer.Stack.List[FUREBuffer.Stack.ListUsed - 1]; -end; - -function TURESearch.Pop: SizeInt; -begin - if FUREBuffer.Stack.ListUsed = 0 then - Result := _URE_NOOP - else - begin - Dec(FUREBuffer.Stack.ListUsed); - Result := FUREBuffer.Stack.List[FUREBuffer.Stack.ListUsed]; - if FUREBuffer.Reducing then - FUREBuffer.ExpressionList.Expressions[Word(Result)].OnStack := False; - end; -end; - -function TURESearch.ParsePropertyList(Properties: PUCS2; Limit: SizeInt; - var Categories: TCharacterCategories): SizeInt; -// Parse a comma-separated list of integers that represent character properties. -// Combine them into a set of categories and return the number of characters consumed. -var - N: SizeInt; - Run, - ListEnd: PUCS2; -begin - Run := Properties; - ListEnd := Run + Limit; - - N := 0; - Categories := []; - while (FUREBuffer.Error = _URE_OK) and (Run < ListEnd) do - begin - if Run^ = ',' then - begin - // Encountered a comma, so take the number parsed so far as category and - // reset the number. - Include(Categories, TCharacterCategory(N)); - N := 0; - end - else - begin - if (Run^ >= '0') and (Run^ <= '9') then - begin - // Encountered a digit, so start or continue building the SizeInt that - // represents the character category. - N := (N * 10) + SizeInt(Word(Run^) - Ord('0')); - end - else - begin - // Encountered something that is not part of the property list. - // Indicate that we are done. - Break; - end; - end; - - // If the number is to large then there is a problem. - // Most likely a missing comma separator. - if SizeInt(N) > Ord(High(TCharacterCategory)) then - FUREBuffer.Error := _URE_INVALID_PROPERTY; - Inc(Run); - end; - - // Return the number of characters consumed. - Result := Run - Properties; -end; - -function TURESearch.MakeHexNumber(NP: PUCS2; Limit: SizeInt; var Number: UCS4): SizeInt; -// Collect a hex number with 1 to 4 digits and return the number of characters used. -var - I: SizeInt; - Run, - ListEnd: PUCS2; -begin - Run := np; - ListEnd := Run + Limit; - - Number := 0; - I := 0; - while (I < 4) and (Run < ListEnd) do - begin - if (Run^ >= '0') and (Run^ <= '9') then - Number := (Number shl 4) or (Cardinal(Word(Run^) - Ord('0'))) - else - begin - if (Run^ >= 'A') and (Run^ <= 'F') then - Number := (Number shl 4) or (Cardinal(Word(Run^) - Ord('A')) + 10) - else - begin - if (Run^ >= 'a') and (Run^ <= 'f') then - Number := (Number shl 4) or (Cardinal(Word(Run^) - Ord('a')) + 10) - else - Break; - end; - end; - Inc(I); - Inc(Run); - end; - - Result := Run - NP; -end; - -procedure TURESearch.AddRange(var CCL: TUcCClass; Range: TUcRange); -// Insert a Range into a character class, removing duplicates and ordering them -// in increasing Range-start order. -var - I: SizeInt; - Temp: UCS4; -begin - // If the `Casefold' flag is set, then make sure both endpoints of the Range - // are converted to lower. - if (FUREBuffer.Flags and _URE_DFA_CASEFOLD) <> 0 then - begin - { TODO : use the entire mapping, not only the first character } - Range.MinCode := UnicodeToLower(Range.MinCode)[0]; - Range.MaxCode := UnicodeToLower(Range.MaxCode)[0]; - end; - - // Swap the Range endpoints if they are not in increasing order. - if Range.MinCode > Range.MaxCode then - begin - Temp := Range.MinCode; - Range.MinCode := Range.MaxCode; - Range.MaxCode := Temp; - end; - - I := 0; - while (I < CCL.RangesUsed) and (Range.MinCode < CCL.Ranges[I].MinCode) do - Inc(I); - - // check for a duplicate - if (I < CCL.RangesUsed) and (Range.MinCode = CCL.Ranges[I].MinCode) and - (Range.MaxCode = CCL.Ranges[I].MaxCode) then - Exit; - - if CCL.RangesUsed = Length(CCL.Ranges) then - SetLength(CCL.Ranges, Length(CCL.Ranges) + 8); - - if I < CCL.RangesUsed then - Move(CCL.Ranges[I], CCL.Ranges[I + 1], SizeOf(TUcRange) * (CCL.RangesUsed - I)); - - CCL.Ranges[I].MinCode := Range.MinCode; - CCL.Ranges[I].MaxCode := Range.MaxCode; - Inc(CCL.RangesUsed); -end; - -type - PTrie = ^TTrie; - TTrie = record - Key: UCS2; - Len, - Next: SizeInt; - Setup: SizeInt; - Categories: TCharacterCategories; - end; - -procedure TURESearch.SpaceSetup(Symbol: PUcSymbolTableEntry; Categories: TCharacterCategories); -var - Range: TUcRange; -begin - Symbol.Categories := Symbol.Categories + Categories; - - Range.MinCode := UCS4(WideTabulator); - Range.MaxCode := UCS4(WideTabulator); - AddRange(Symbol.Symbol.CCL, Range); - Range.MinCode := UCS4(WideCarriageReturn); - Range.MaxCode := UCS4(WideCarriageReturn); - AddRange(Symbol.Symbol.CCL, Range); - Range.MinCode := UCS4(WideLineFeed); - Range.MaxCode := UCS4(WideLineFeed); - AddRange(Symbol.Symbol.CCL, Range); - Range.MinCode := UCS4(WideFormFeed); - Range.MaxCode := UCS4(WideFormFeed); - AddRange(Symbol.Symbol.CCL, Range); - Range.MinCode := $FEFF; - Range.MaxCode := $FEFF; - AddRange(Symbol.Symbol.CCL, Range); -end; - -procedure TURESearch.HexDigitSetup(Symbol: PUcSymbolTableEntry); -var - Range: TUcRange; -begin - Range.MinCode := UCS4('0'); - Range.MaxCode := UCS4('9'); - AddRange(Symbol.Symbol.CCL, Range); - Range.MinCode := UCS4('A'); - Range.MaxCode := UCS4('F'); - AddRange(Symbol.Symbol.CCL, Range); - Range.MinCode := UCS4('a'); - Range.MaxCode := UCS4('f'); - AddRange(Symbol.Symbol.CCL, Range); -end; - -const - CClassTrie: array [0..64] of TTrie = ( - (Key: #$003A; Len: 1; Next: 1; Setup: 0; Categories: []), - (Key: #$0061; Len: 9; Next: 10; Setup: 0; Categories: []), - (Key: #$0063; Len: 8; Next: 19; Setup: 0; Categories: []), - (Key: #$0064; Len: 7; Next: 24; Setup: 0; Categories: []), - (Key: #$0067; Len: 6; Next: 29; Setup: 0; Categories: []), - (Key: #$006C; Len: 5; Next: 34; Setup: 0; Categories: []), - (Key: #$0070; Len: 4; Next: 39; Setup: 0; Categories: []), - (Key: #$0073; Len: 3; Next: 49; Setup: 0; Categories: []), - (Key: #$0075; Len: 2; Next: 54; Setup: 0; Categories: []), - (Key: #$0078; Len: 1; Next: 59; Setup: 0; Categories: []), - (Key: #$006C; Len: 1; Next: 11; Setup: 0; Categories: []), - (Key: #$006E; Len: 2; Next: 13; Setup: 0; Categories: []), - (Key: #$0070; Len: 1; Next: 16; Setup: 0; Categories: []), - (Key: #$0075; Len: 1; Next: 14; Setup: 0; Categories: []), - (Key: #$006D; Len: 1; Next: 15; Setup: 0; Categories: []), - (Key: #$003A; Len: 1; Next: 16; Setup: 1; Categories: ClassLetter + ClassNumber), - (Key: #$0068; Len: 1; Next: 17; Setup: 0; Categories: []), - (Key: #$0061; Len: 1; Next: 18; Setup: 0; Categories: []), - (Key: #$003A; Len: 1; Next: 19; Setup: 1; Categories: ClassLetter), - (Key: #$006E; Len: 1; Next: 20; Setup: 0; Categories: []), - (Key: #$0074; Len: 1; Next: 21; Setup: 0; Categories: []), - (Key: #$0072; Len: 1; Next: 22; Setup: 0; Categories: []), - (Key: #$006C; Len: 1; Next: 23; Setup: 0; Categories: []), - (Key: #$003A; Len: 1; Next: 24; Setup: 1; Categories: [ccOtherControl, ccOtherFormat]), - (Key: #$0069; Len: 1; Next: 25; Setup: 0; Categories: []), - (Key: #$0067; Len: 1; Next: 26; Setup: 0; Categories: []), - (Key: #$0069; Len: 1; Next: 27; Setup: 0; Categories: []), - (Key: #$0074; Len: 1; Next: 28; Setup: 0; Categories: []), - (Key: #$003A; Len: 1; Next: 29; Setup: 1; Categories: ClassNumber), - (Key: #$0072; Len: 1; Next: 30; Setup: 0; Categories: []), - (Key: #$0061; Len: 1; Next: 31; Setup: 0; Categories: []), - (Key: #$0070; Len: 1; Next: 32; Setup: 0; Categories: []), - (Key: #$0068; Len: 1; Next: 33; Setup: 0; Categories: []), - (Key: #$003A; Len: 1; Next: 34; Setup: 1; Categories: ClassMark + ClassNumber + ClassLetter + ClassPunctuation + - ClassSymbol), - (Key: #$006F; Len: 1; Next: 35; Setup: 0; Categories: []), - (Key: #$0077; Len: 1; Next: 36; Setup: 0; Categories: []), - (Key: #$0065; Len: 1; Next: 37; Setup: 0; Categories: []), - (Key: #$0072; Len: 1; Next: 38; Setup: 0; Categories: []), - (Key: #$003A; Len: 1; Next: 39; Setup: 1; Categories: [ccLetterLowercase]), - (Key: #$0072; Len: 2; Next: 41; Setup: 0; Categories: []), - (Key: #$0075; Len: 1; Next: 45; Setup: 0; Categories: []), - (Key: #$0069; Len: 1; Next: 42; Setup: 0; Categories: []), - (Key: #$006E; Len: 1; Next: 43; Setup: 0; Categories: []), - (Key: #$0074; Len: 1; Next: 44; Setup: 0; Categories: []), - (Key: #$003A; Len: 1; Next: 45; Setup: 1; Categories: ClassMark + ClassNumber + ClassLetter + ClassPunctuation + - ClassSymbol + [ccSeparatorSpace]), - (Key: #$006E; Len: 1; Next: 46; Setup: 0; Categories: []), - (Key: #$0063; Len: 1; Next: 47; Setup: 0; Categories: []), - (Key: #$0074; Len: 1; Next: 48; Setup: 0; Categories: []), - (Key: #$003A; Len: 1; Next: 49; Setup: 1; Categories: ClassPunctuation), - (Key: #$0070; Len: 1; Next: 50; Setup: 0; Categories: []), - (Key: #$0061; Len: 1; Next: 51; Setup: 0; Categories: []), - (Key: #$0063; Len: 1; Next: 52; Setup: 0; Categories: []), - (Key: #$0065; Len: 1; Next: 53; Setup: 0; Categories: []), - (Key: #$003A; Len: 1; Next: 54; Setup: 2; Categories: ClassSpace), - (Key: #$0070; Len: 1; Next: 55; Setup: 0; Categories: []), - (Key: #$0070; Len: 1; Next: 56; Setup: 0; Categories: []), - (Key: #$0065; Len: 1; Next: 57; Setup: 0; Categories: []), - (Key: #$0072; Len: 1; Next: 58; Setup: 0; Categories: []), - (Key: #$003A; Len: 1; Next: 59; Setup: 1; Categories: [ccLetterUppercase]), - (Key: #$0064; Len: 1; Next: 60; Setup: 0; Categories: []), - (Key: #$0069; Len: 1; Next: 61; Setup: 0; Categories: []), - (Key: #$0067; Len: 1; Next: 62; Setup: 0; Categories: []), - (Key: #$0069; Len: 1; Next: 63; Setup: 0; Categories: []), - (Key: #$0074; Len: 1; Next: 64; Setup: 0; Categories: []), - (Key: #$003A; Len: 1; Next: 65; Setup: 3; Categories: []) - ); - -function TURESearch.PosixCCL(CP: PUCS2; Limit: SizeInt; Symbol: PUcSymbolTableEntry): SizeInt; -// Probe for one of the POSIX colon delimited character classes in the static trie. -var - I: SizeInt; - N: SizeInt; - TP: PTrie; - Run, - ListEnd: PUCS2; -begin - Result := 0; - // If the number of characters left is less than 7, - // then this cannot be interpreted as one of the colon delimited classes. - if Limit >= 7 then - begin - Run := cp; - ListEnd := Run + Limit; - TP := @CClassTrie[0]; - I := 0; - while (Run < ListEnd) and (I < 8) do - begin - N := TP.Len; - while (N > 0) and (TP.Key <> Run^) do - begin - Inc(TP); - Dec(N); - end; - - if N = 0 then - begin - Result := 0; - Exit; - end; - - if (Run^ = ':') and ((I = 6) or (I = 7)) then - begin - Inc(Run); - Break; - end; - if (Run + 1) < ListEnd then - TP := @CClassTrie[TP.Next]; - Inc(I); - Inc(Run); - end; - - Result := Run - CP; - case TP.Setup of - 1: - Symbol.Categories := Symbol.Categories + TP.Categories; - 2: - SpaceSetup(Symbol, TP.Categories); - 3: - HexDigitSetup(Symbol); - else - Result := 0; - end; - end; -end; - -function TURESearch.BuildCharacterClass(CP: PUCS2; Limit: SizeInt; Symbol: PUcSymbolTableEntry): SizeInt; -// Construct a list of ranges and return the number of characters consumed. -var - RangeEnd: SizeInt; - N: SizeInt; - Run, - ListEnd: PUCS2; - C, Last: UCS4; - Range: TUcRange; -begin - Run := cp; - ListEnd := Run + Limit; - - if Run^ = '^' then - begin - Symbol.AType := _URE_NCCLASS; - Inc(Run); - end - else - Symbol.AType := _URE_CCLASS; - - Last := 0; - RangeEnd := 0; - while (FUREBuffer.Error = _URE_OK) and (Run < ListEnd) do - begin - // Allow for the special case []abc], where the first closing bracket would end an empty - // character class, which makes no sense. Hence this bracket is treaded literally. - if (Run^ = ']') and (Symbol.Symbol.CCL.RangesUsed > 0) then - Break; - - C := UCS4(Run^); - Inc(Run); - - // escape character - if C = Ord('\') then - begin - if Run = ListEnd then - begin - // The EOS was encountered when expecting the reverse solidus to be followed by the character it is escaping. - // Set an Error code and return the number of characters consumed up to this point. - FUREBuffer.Error := _URE_UNEXPECTED_EOS; - Result := Run - CP; - Exit; - end; - - C := UCS4(Run^); - Inc(Run); - case UCS2(C) of - 'a': - C := $07; - 'b': - C := $08; - 'f': - C := $0C; - 'n': - C := $0A; - 'R': - C := $0D; - 't': - C := $09; - 'v': - C := $0B; - 'p', 'P': - begin - Inc(Run, ParsePropertyList(Run, ListEnd - Run, Symbol.Categories)); - // Invert the bit mask of the properties if this is a negated character class or if 'P' is used to specify - // a list of character properties that should *not* match in a character class. - if C = Ord('P') then - Symbol.Categories := ClassAll - Symbol.Categories; - Continue; - end; - 'x', 'X', 'u', 'U': - begin - if (Run < ListEnd) and - ((Run^ >= '0') and (Run^ <= '9') or - (Run^ >= 'A') and (Run^ <= 'F') or - (Run^ >= 'a') and (Run^ <= 'f')) then - Inc(Run, MakeHexNumber(Run, ListEnd - Run, C)); - end; - end; - end - else - begin - if C = Ord(':') then - begin - // Probe for a POSIX colon delimited character class. - Dec(Run); - N := PosixCCL(Run, ListEnd - Run, Symbol); - if N = 0 then - Inc(Run) - else - begin - Inc(Run, N); - Continue; - end; - end; - end; - - // Check to see if the current character is a low surrogate that needs - // to be combined with a preceding high surrogate. - if Last <> 0 then - begin - if (C >= SurrogateLowStart) and (C <= SurrogateLowEnd) then - begin - // Construct the UTF16 character code. - C := $10000 + (((Last and $03FF) shl 10) or (C and $03FF)) - end - else - begin - // Add the isolated high surrogate to the range. - if RangeEnd = 1 then - Range.MaxCode := Last and $FFFF - else - begin - Range.MinCode := Last and $FFFF; - Range.MaxCode := Last and $FFFF; - end; - - AddRange(Symbol.Symbol.CCL, Range); - RangeEnd := 0; - end; - end; - - // Clear the Last character code. - Last := 0; - - // This slightly awkward code handles the different cases needed to construct a range. - if (C >= SurrogateHighStart) and (C <= SurrogateHighEnd) then - begin - // If the high surrogate is followed by a Range indicator, simply add it as the Range start. Otherwise, - // save it in the next character is a low surrogate. - if Run^ = '-' then - begin - Inc(Run); - Range.MinCode := C; - RangeEnd := 1; - end - else - Last := C; - end - else - begin - if RangeEnd = 1 then - begin - Range.MaxCode := C; - AddRange(Symbol.Symbol.CCL, Range); - RangeEnd := 0; - end - else - begin - Range.MinCode := C; - Range.MaxCode := C; - if Run^ = '-' then - begin - Inc(Run); - RangeEnd := 1; - end - else - AddRange(Symbol.Symbol.CCL, Range); - end; - end; - end; - - if (Run < ListEnd) and (Run^ = ']') then - Inc(Run) - else - begin - // The parse was not terminated by the character class close symbol (']'), so set an error code. - FUREBuffer.Error := _URE_CCLASS_OPEN; - end; - Result := Run - CP; -end; - -function TURESearch.ProbeLowSurrogate(LeftState: PUCS2; Limit: SizeInt; var Code: UCS4): SizeInt; -// probes for a low surrogate hex code -var - I: SizeInt; - Run, - ListEnd: PUCS2; -begin - I := 0; - Code := 0; - Run := LeftState; - ListEnd := Run + Limit; - - while (I < 4) and (Run < ListEnd) do - begin - if (Run^ >= '0') and (Run^ <= '9') then - Code := (Code shl 4) or (Cardinal(Word(Run^) - Ord('0'))) - else - begin - if (Run^ >= 'A') and (Run^ <= 'F') then - Code := (Code shl 4) or (Cardinal(Word(Run^) - Ord('A')) + 10) - else - begin - if (Run^ >= 'a') and (Run^ <= 'f') then - Code := (Code shl 4) or (Cardinal(Word(Run^) - Ord('a')) + 10) - else - Break; - end; - end; - Inc(Run); - end; - - if (SurrogateLowStart <= Code) and (Code <= SurrogateLowEnd) then - Result := Run - LeftState - else - Result := 0; -end; - -function TURESearch.CompileSymbol(S: PUCS2; Limit: SizeInt; Symbol: PUcSymbolTableEntry): SizeInt; -var - C: UCS4; - Run, - ListEnd: PUCS2; -begin - Run := S; - ListEnd := S + Limit; - - C := UCS4(Run^); - Inc(Run); - if C = Ord('\') then - begin - if Run = ListEnd then - begin - // The EOS was encountered when expecting the reverse solidus to be followed - // by the character it is escaping. Set an Error code and return the number - // of characters consumed up to this point. - FUREBuffer.Error := _URE_UNEXPECTED_EOS; - Result := Run - S; - Exit; - end; - - C := UCS4(Run^); - Inc(Run); - case UCS2(C) of - 'p', 'P': - begin - if UCS2(C) = 'p' then - Symbol.AType :=_URE_CCLASS - else - Symbol.AType :=_URE_NCCLASS; - Inc(Run, ParsePropertyList(Run, ListEnd - Run, Symbol.Categories)); - end; - 'a': - begin - Symbol.AType := _URE_CHAR; - Symbol.Symbol.Chr := $07; - end; - 'b': - begin - Symbol.AType := _URE_CHAR; - Symbol.Symbol.Chr := $08; - end; - 'f': - begin - Symbol.AType := _URE_CHAR; - Symbol.Symbol.Chr := $0C; - end; - 'n': - begin - Symbol.AType := _URE_CHAR; - Symbol.Symbol.Chr := $0A; - end; - 'r': - begin - Symbol.AType := _URE_CHAR; - Symbol.Symbol.Chr := $0D; - end; - 't': - begin - Symbol.AType := _URE_CHAR; - Symbol.Symbol.Chr := $09; - end; - 'v': - begin - Symbol.AType := _URE_CHAR; - Symbol.Symbol.Chr := $0B; - end; - else - case UCS2(C) of - 'x', 'X', 'u', 'U': - begin - // Collect between 1 and 4 digits representing an UCS2 code. - if (Run < ListEnd) and - ((Run^ >= '0') and (Run^ <= '9') or - (Run^ >= 'A') and (Run^ <= 'F') or - (Run^ >= 'a') and (Run^ <= 'f')) then - Inc(Run, MakeHexNumber(Run, ListEnd - Run, C)); - end; - end; - - // Simply add an escaped character here. - Symbol.AType := _URE_CHAR; - Symbol.Symbol.Chr := C; - end; - end - else - begin - if (UCS2(C) = '^') or (UCS2(C) = '$') then - begin - // Handle the BOL and EOL anchors. This actually consists simply of setting - // a flag that indicates that the user supplied anchor match function should - // be called. This needs to be done instead of simply matching line/paragraph - // separators because beginning-of-text and end-of-text tests are needed as well. - if UCS2(C) = '^' then - Symbol.AType := _URE_BOL_ANCHOR - else - Symbol.AType := _URE_EOL_ANCHOR; - end - else - begin - if UCS2(C) = '[' then - begin - // construct a character class - Inc(Run, BuildCharacterClass(Run, ListEnd - Run, Symbol)); - end - else - begin - if UCS2(C) = '.' then - Symbol.AType := _URE_ANY_CHAR - else - begin - Symbol.AType := _URE_CHAR; - Symbol.Symbol.Chr := C; - end; - end; - end; - end; - - // If the symbol type happens to be a character and is a high surrogate, then - // probe forward to see if it is followed by a low surrogate that needs to be added. - if (Run < ListEnd) and - (Symbol.AType = _URE_CHAR) and - (SurrogateHighStart <= Symbol.Symbol.Chr) and - (Symbol.Symbol.Chr <= SurrogateHighEnd) then - begin - if (SurrogateLowStart <= UCS4(Run^)) and - (UCS4(Run^) <= SurrogateLowEnd) then - begin - Symbol.Symbol.Chr := $10000 + (((Symbol.Symbol.Chr and $03FF) shl 10) or (UCS4(Run^) and $03FF)); - Inc(Run); - end - else - begin - if (Run^ = '\') and (((Run + 1)^ = 'x') or ((Run + 1)^ = 'X') or - ((Run + 1)^ = 'u') or ((Run + 1)^ = 'U')) then - begin - Inc(Run, ProbeLowSurrogate(Run + 2, ListEnd - (Run + 2), C)); - if (SurrogateLowStart <= C) and (C <= SurrogateLowEnd) then - begin - // Take into account the \[xu] in front of the hex code. - Inc(Run, 2); - Symbol.Symbol.Chr := $10000 + (((Symbol.Symbol.Chr and $03FF) shl 10) or (C and $03FF)); - end; - end; - end; - end; - - // Last, make sure any _URE_CHAR type symbols are changed to lower if the - // 'Casefold' flag is set. - { TODO : use the entire mapping, not only the first character and use the - case fold abilities of the unit. } - if ((FUREBuffer.Flags and _URE_DFA_CASEFOLD) <> 0) and (Symbol.AType = _URE_CHAR) then - Symbol.Symbol.Chr := UnicodeToLower(Symbol.Symbol.Chr)[0]; - - // If the symbol constructed is anything other than one of the anchors, - // make sure the _URE_DFA_BLANKLINE flag is removed. - if (Symbol.AType <> _URE_BOL_ANCHOR) and (Symbol.AType <> _URE_EOL_ANCHOR) then - FUREBuffer.Flags := FUREBuffer.Flags and not _URE_DFA_BLANKLINE; - - // Return the number of characters consumed. - Result := Run - S; -end; - -function TURESearch.SymbolsAreDifferent(A, B: PUcSymbolTableEntry): Boolean; -begin - Result := False; - if (A.AType <> B.AType) or (A.Mods <> B.Mods) or (A.Categories <> B.Categories) then - Result := True - else - begin - if (A.AType = _URE_CCLASS) or (A.AType = _URE_NCCLASS) then - begin - if A.Symbol.CCL.RangesUsed <> B.Symbol.CCL.RangesUsed then - Result := True - else - begin - if (A.Symbol.CCL.RangesUsed > 0) and - not CompareMem(@A.Symbol.CCL.Ranges[0], @B.Symbol.CCL.Ranges[0], - SizeOf(TUcRange) * A.Symbol.CCL.RangesUsed) then - Result := True;; - end; - end - else - begin - if (A.AType = _URE_CHAR) and (A.Symbol.Chr <> B.Symbol.Chr) then - Result := True; - end; - end; -end; - -function TURESearch.MakeSymbol(S: PUCS2; Limit: SizeInt; out Consumed: SizeInt): SizeInt; -// constructs a symbol, but only keep unique symbols -var - I: SizeInt; - Start: PUcSymbolTableEntry; - Symbol: TUcSymbolTableEntry; -begin - // Build the next symbol so we can test to see if it is already in the symbol table. - ResetMemory(Symbol, SizeOf(TUcSymbolTableEntry)); - Consumed := CompileSymbol(S, Limit, @Symbol); - - // Check to see if the symbol exists. - I := 0; - Start := @FUREBuffer.SymbolTable.Symbols[0]; - while (I < FUREBuffer.SymbolTable.SymbolsUsed) and SymbolsAreDifferent(@Symbol, Start) do - begin - Inc(I); - Inc(Start); - end; - - if I < FUREBuffer.SymbolTable.SymbolsUsed then - begin - // Free up any ranges used for the symbol. - if (Symbol.AType = _URE_CCLASS) or (Symbol.AType = _URE_NCCLASS) then - Symbol.Symbol.CCL.Ranges := nil; - Result := FUREBuffer.SymbolTable.Symbols[I].ID; - Exit; - end; - - // Need to add the new symbol. - if FUREBuffer.SymbolTable.SymbolsUsed = Length(FUREBuffer.SymbolTable.Symbols) then - begin - SetLength(FUREBuffer.SymbolTable.Symbols, Length(FUREBuffer.SymbolTable.Symbols) + 8); - end; - - Symbol.ID := FUREBuffer.SymbolTable.SymbolsUsed; - Inc(FUREBuffer.SymbolTable.SymbolsUsed); - FUREBuffer.SymbolTable.Symbols[Symbol.ID] := Symbol; - Result := Symbol.ID; -end; - -function TURESearch.MakeExpression(AType, LHS, RHS: SizeInt): SizeInt; -var - I: SizeInt; -begin - // Determine if the expression already exists or not. - with FUREBuffer.ExpressionList do - begin - for I := 0 to ExpressionsUsed - 1 do - begin - if (Expressions[I].AType = AType) and - (Expressions[I].LHS = LHS) and - (Expressions[I].RHS = RHS) then - begin - Result := I; - Exit; - end; - end; - - // Need to add a new expression. - if ExpressionsUsed = Length(Expressions) then - SetLength(Expressions, Length(Expressions) + 8); - - Expressions[ExpressionsUsed].OnStack := False; - Expressions[ExpressionsUsed].AType := AType; - Expressions[ExpressionsUsed].LHS := LHS; - Expressions[ExpressionsUsed].RHS := RHS; - - Result := ExpressionsUsed; - Inc(ExpressionsUsed); - end; -end; - -function IsSpecial(C: Word): Boolean; -begin - case C of - Word('+'), - Word('*'), - Word('?'), - Word('{'), - Word('|'), - Word(')'): - Result := True; - else - Result := False; - end; -end; - -procedure TURESearch.CollectPendingOperations(var State: SizeInt); -// collects all pending AND and OR operations and make corresponding expressions -var - Operation: SizeInt; -begin - repeat - Operation := Peek; - if (Operation <> _URE_AND) and (Operation <> _URE_OR) then - Break; - // make an expression with the AND or OR operator and its right hand side - Operation := Pop; - State := MakeExpression(Operation, Pop, State); - until False; -end; - -function TURESearch.ConvertRegExpToNFA(RE: PWideChar; RELength: SizeInt): SizeInt; -// Converts the regular expression into an NFA in a form that will be easy to -// reduce to a DFA. The starting state for the reduction will be returned. -var - C: UCS2; - Head, Tail: PUCS2; - S: WideString; - Symbol, - State, - LastState, - Used, - M, N: SizeInt; - I: SizeInt; -begin - State := _URE_NOOP; - - Head := RE; - Tail := Head + RELength; - while (FUREBuffer.Error = _URE_OK) and (Head < Tail) do - begin - C := Head^; - Inc(Head); - case C of - '(': - Push(_URE_PAREN); - ')': // check for the case of too many close parentheses - begin - if Peek = _URE_NOOP then - begin - FUREBuffer.Error := _URE_UNBALANCED_GROUP; - Break; - end; - CollectPendingOperations(State); - // remove the _URE_PAREN off the stack - Pop; - end; - '*': - State := MakeExpression(_URE_STAR, State, _URE_NOOP); - '+': - State := MakeExpression(_URE_PLUS, State, _URE_NOOP); - '?': - State := MakeExpression(_URE_QUEST, State, _URE_NOOP); - '|': - begin - CollectPendingOperations(State); - Push(State); - Push(_URE_OR); - end; - '{': // expressions of the form {m, n} - begin - C := #0; - M := 0; - N := 0; - // get first number - while UnicodeIsWhiteSpace(UCS4(Head^)) do - Inc(Head); - // very slow implementation - S := ''; - while (Head^ >= WideChar('0')) and (Head^ <= WideChar('9')) do - begin - S := S + Head^; - Inc(Head); - end; - if S <> '' then - M := StrToInt(S); - - while UnicodeIsWhiteSpace(UCS4(Head^)) do - Inc(Head); - if (Head^ <> ',') and (Head^ <> '}') then - begin - FUREBuffer.Error := _URE_INVALID_RANGE; - Break; - end; - - // check for an upper limit - if Head^ <> '}' then - begin - Inc(Head); - // get second number - while UnicodeIsWhiteSpace(UCS4(Head^)) do - Inc(Head); - // very slow implementation - S := ''; - while (Head^ >= WideChar('0')) and (Head^ <= WideChar('9')) do - begin - S := S + Head^; - Inc(Head); - end; - if S <> '' then - N := StrToInt(S); - end - else - N := M; - - if Head^ <> '}' then - begin - FUREBuffer.Error := _URE_RANGE_OPEN; - Break; - end - else - Inc(Head); - - // N = 0 means unlimited number of occurrences - if N = 0 then - begin - case M of - 0: // {,} {0,} {0, 0} mean the same as the star operator - State := MakeExpression(_URE_STAR, State, _URE_NOOP); - 1: // {1,} {1, 0} mean the same as the plus operator - State := MakeExpression(_URE_PLUS, State, _URE_NOOP); - else - begin - // encapsulate the expanded branches as would they be in parenthesis - // in order to avoid unwanted concatenation with pending operations/symbols - Push(_URE_PAREN); - // {m,} {m, 0} mean M fixed occurrences plus star operator - // make E^m... - for I := 1 to M - 1 do - begin - Push(State); - Push(_URE_AND); - end; - // ...and repeat the last symbol one or more times - State := MakeExpression(_URE_PLUS, State, _URE_NOOP); - CollectPendingOperations(State); - Pop; - end; - end; - end - else - begin - // check proper range limits - if M > N then - begin - FUREBuffer.Error := _URE_INVALID_RANGE; - Break; - end; - - // check special case {0, 1} (which corresponds to the ? operator) - if (M = 0) and (N = 1) then - State := MakeExpression(_URE_QUEST, State, _URE_NOOP) - else - begin - // handle the general case by expanding {m, n} into the equivalent - // expression E^m | E^(m + 1) | ... | E^n - - // encapsulate the expanded branches as would they be in parenthesis - // in order to avoid unwanted concatenation with pending operations/symbols - Push(_URE_PAREN); - // keep initial state as this is the one all alternatives start from - LastState := State; - - // Consider the special case M = 0 first. Because there's no construct - // to enter a pure epsilon-transition into the expression array I - // work around with the question mark operator to describe the first - // and second branch alternative. - if M = 0 then - begin - State := MakeExpression(_URE_QUEST, State, _URE_NOOP); - Inc(M, 2); - // Mark the pending OR operation (there must always follow at - // least on more alternative because the special case {0, 1} has - // already been handled). - Push(State); - Push(_URE_OR); - end; - - while M <= N do - begin - State := LastState; - // create E^M - for I := 1 to SizeInt(M) - 1 do - begin - Push(State); - Push(_URE_AND); - end; - // finish the branch and mark it as pending OR operation if it - // isn't the last one - CollectPendingOperations(State); - if M < N then - begin - Push(State); - Push(_URE_OR); - end; - Inc(M); - end; - // remove the _URE_PAREN off the stack - Pop; - end; - end; - end; - else - Dec(Head); - Symbol := MakeSymbol(Head, Tail - Head, Used); - Inc(Head, Used); - State := MakeExpression(_URE_SYMBOL, Symbol, _URE_NOOP); - end; - - if (C <> '(') and (C <> '|') and (C <> '{') and (Head < Tail) and - (not IsSpecial(Word(Head^)) or (Head^ = '(')) then - begin - Push(State); - Push(_URE_AND); - end; - end; - - CollectPendingOperations(State); - if FUREBuffer.Stack.ListUsed > 0 then - FUREBuffer.Error := _URE_UNBALANCED_GROUP; - - if FUREBuffer.Error = _URE_OK then - Result := State - else - Result := _URE_NOOP; -end; - -procedure TURESearch.AddSymbolState(Symbol, State: SizeInt); -var - I, J: SizeInt; - Found: Boolean; -begin - // Locate the symbol in the symbol table so the state can be added. - // If the symbol doesn't exist, then we are in serious trouble. - with FUREBuffer.SymbolTable do - begin - I := 0; - while (I < SymbolsUsed) and (Symbol <> Symbols[I].ID) do - Inc(I); - - Assert(I < SymbolsUsed); - end; - - // Now find out if the state exists in the symbol's state list. - with FUREBuffer.SymbolTable.Symbols[I].States do - begin - Found := False; - for J := 0 to ListUsed - 1 do - begin - if State <= List[J] then - begin - Found := True; - Break; - end; - end; - - if not Found then - J := ListUsed; - if not Found or (State < List[J]) then - begin - // Need to add the state in order. - if ListUsed = Length(List) then - SetLength(List, Length(List) + 8); - if J < ListUsed then - Move(List[J], List[J + 1], SizeOf(SizeInt) * (ListUsed - J)); - List[J] := State; - Inc(ListUsed); - end; - end; -end; - -function TURESearch.AddState(NewStates: array of SizeInt): SizeInt; -var - I: SizeInt; - Found: Boolean; -begin - Found := False; - for I := 0 to FUREBuffer.States.StatesUsed - 1 do - begin - if (FUREBuffer.States.States[I].StateList.ListUsed = Length(NewStates)) and - CompareMem(@NewStates[0], @FUREBuffer.States.States[I].StateList.List[0], - SizeOf(SizeInt) * Length(NewStates)) then - begin - Found := True; - Break; - end; - end; - - if not Found then - begin - // Need to add a new DFA State (set of NFA states). - if FUREBuffer.States.StatesUsed = Length(FUREBuffer.States.States) then - SetLength(FUREBuffer.States.States, Length(FUREBuffer.States.States) + 8); - - with FUREBuffer.States.States[FUREBuffer.States.StatesUsed] do - begin - ID := FUREBuffer.States.StatesUsed; - if (StateList.ListUsed + Length(NewStates)) >= Length(StateList.List) then - SetLength(StateList.List, Length(StateList.List) + Length(NewStates) + 8); - Move(NewStates[0], StateList.List[StateList.ListUsed], SizeOf(SizeInt) * Length(NewStates)); - Inc(StateList.ListUsed, Length(NewStates)); - end; - Inc(FUREBuffer.States.StatesUsed); - end; - - // Return the ID of the DFA state representing a group of NFA States. - if Found then - Result := I - else - Result := FUREBuffer.States.StatesUsed - 1; -end; - -procedure TURESearch.Reduce(Start: SizeInt); -var - I, J, - Symbols: SizeInt; - State, - RHS, - s1, s2, - ns1, ns2: SizeInt; - Evaluating: Boolean; -begin - FUREBuffer.Reducing := True; - - // Add the starting state for the reduction. - AddState([Start]); - - // Process each set of NFA states that get created. - I := 0; - // further states are added in the loop - while I < FUREBuffer.States.StatesUsed do - begin - with FUREBuffer, States.States[I], ExpressionList do - begin - // Push the current states on the stack. - for J := 0 to StateList.ListUsed - 1 do - Push(StateList.List[J]); - - // Reduce the NFA states. - Accepting := False; - Symbols := 0; - J := 0; - // need a while loop here as the stack will be modified within the loop and - // so also its usage count used to terminate the loop - while J < FUREBuffer.Stack.ListUsed do - begin - State := FUREBuffer.Stack.List[J]; - Evaluating := True; - - // This inner loop is the iterative equivalent of recursively - // reducing subexpressions generated as a result of a reduction. - while Evaluating do - begin - case Expressions[State].AType of - _URE_SYMBOL: - begin - ns1 := MakeExpression(_URE_ONE, _URE_NOOP, _URE_NOOP); - AddSymbolState(Expressions[State].LHS, ns1); - Inc(Symbols); - Evaluating := False; - end; - _URE_ONE: - begin - Accepting := True; - Evaluating := False; - end; - _URE_QUEST: - begin - s1 := Expressions[State].LHS; - ns1 := MakeExpression(_URE_ONE, _URE_NOOP, _URE_NOOP); - State := MakeExpression(_URE_OR, ns1, s1); - end; - _URE_PLUS: - begin - s1 := Expressions[State].LHS; - ns1 := MakeExpression(_URE_STAR, s1, _URE_NOOP); - State := MakeExpression(_URE_AND, s1, ns1); - end; - _URE_STAR: - begin - s1 := Expressions[State].LHS; - ns1 := MakeExpression(_URE_ONE, _URE_NOOP, _URE_NOOP); - ns2 := MakeExpression(_URE_PLUS, s1, _URE_NOOP); - State := MakeExpression(_URE_OR, ns1, ns2); - end; - _URE_OR: - begin - s1 := Expressions[State].LHS; - s2 := Expressions[State].RHS; - Push(s1); - Push(s2); - Evaluating := False; - end; - _URE_AND: - begin - s1 := Expressions[State].LHS; - s2 := Expressions[State].RHS; - case Expressions[s1].AType of - _URE_SYMBOL: - begin - AddSymbolState(Expressions[s1].LHS, s2); - Inc(Symbols); - Evaluating := False; - end; - _URE_ONE: - State := s2; - _URE_QUEST: - begin - ns1 := Expressions[s1].LHS; - ns2 := MakeExpression(_URE_AND, ns1, s2); - State := MakeExpression(_URE_OR, s2, ns2); - end; - _URE_PLUS: - begin - ns1 := Expressions[s1].LHS; - ns2 := MakeExpression(_URE_OR, s2, State); - State := MakeExpression(_URE_AND, ns1, ns2); - end; - _URE_STAR: - begin - ns1 := Expressions[s1].LHS; - ns2 := MakeExpression(_URE_AND, ns1, State); - State := MakeExpression(_URE_OR, s2, ns2); - end; - _URE_OR: - begin - ns1 := Expressions[s1].LHS; - ns2 := Expressions[s1].RHS; - ns1 := MakeExpression(_URE_AND, ns1, s2); - ns2 := MakeExpression(_URE_AND, ns2, s2); - State := MakeExpression(_URE_OR, ns1, ns2); - end; - _URE_AND: - begin - ns1 := Expressions[s1].LHS; - ns2 := Expressions[s1].RHS; - ns2 := MakeExpression(_URE_AND, ns2, s2); - State := MakeExpression(_URE_AND, ns1, ns2); - end; - end; - end; - end; - end; - Inc(J); - end; - - // clear the state stack - while Pop <> _URE_NOOP do - { nothing }; - - // generate the DFA states for the symbols collected during the current reduction - if (TransitionsUsed + Symbols) > Length(Transitions) then - SetLength(Transitions, Length(Transitions) + Symbols); - - // go through the symbol table and generate the DFA state transitions for - // each symbol that has collected NFA states - Symbols := 0; - J := 0; - while J < FUREBuffer.SymbolTable.SymbolsUsed do - begin - begin - if FUREBuffer.SymbolTable.Symbols[J].States.ListUsed > 0 then - begin - Transitions[Symbols].LHS := FUREBuffer.SymbolTable.Symbols[J].ID; - with FUREBuffer.SymbolTable.Symbols[J] do - begin - RHS := AddState(Copy(States.List, 0, States.ListUsed)); - States.ListUsed := 0; - end; - Transitions[Symbols].RHS := RHS; - Inc(Symbols); - end; - end; - Inc(J); - end; - - // set the number of transitions actually used - // Note: we need again to qualify a part of the TransistionsUsed path since the - // state array could be reallocated in the AddState call above and the - // with ... do will then be invalid. - States.States[I].TransitionsUsed := Symbols; - end; - Inc(I); - end; - FUREBuffer.Reducing := False; -end; - -procedure TURESearch.AddEquivalentPair(L, R: SizeInt); -var - I: SizeInt; -begin - L := FUREBuffer.States.States[L].ID; - R := FUREBuffer.States.States[R].ID; - - if L <> R then - begin - if L > R then - begin - I := L; - L := R; - R := I; - end; - - // Check to see if the equivalence pair already exists. - I := 0; - with FUREBuffer.EquivalentList do - begin - while (I < EquivalentsUsed) and - ((Equivalents[I].Left <> L) or (Equivalents[I].Right <> R)) do - Inc(I); - - if I >= EquivalentsUsed then - begin - if EquivalentsUsed = Length(Equivalents) then - SetLength(Equivalents, Length(Equivalents) + 8); - - Equivalents[EquivalentsUsed].Left := L; - Equivalents[EquivalentsUsed].Right := R; - Inc(EquivalentsUsed); - end; - end; - end; -end; - -procedure TURESearch.MergeEquivalents; -// merges the DFA states that are equivalent -var - I, J, K, - Equal: SizeInt; - Done: Boolean; - State1, State2, - LeftState, - RightState: PUcState; -begin - for I := 0 to FUREBuffer.States.StatesUsed - 1 do - begin - State1 := @FUREBuffer.States.States[I]; - if State1.ID = SizeInt(I) then - begin - J := 0; - while J < I do - begin - State2 := @FUREBuffer.States.States[J]; - if State2.ID = SizeInt(J) then - begin - FUREBuffer.EquivalentList.EquivalentsUsed := 0; - AddEquivalentPair(I, J); - - Done := False; - Equal := 0; - while Equal < FUREBuffer.EquivalentList.EquivalentsUsed do - begin - LeftState := @FUREBuffer.States.States[FUREBuffer.EquivalentList.Equivalents[Equal].Left]; - RightState := @FUREBuffer.States.States[FUREBuffer.EquivalentList.Equivalents[Equal].Right]; - - if (LeftState.Accepting <> RightState.Accepting) or - (LeftState.TransitionsUsed <> RightState.TransitionsUsed) then - begin - Done := True; - Break; - end; - - K := 0; - while (K < LeftState.TransitionsUsed) and - (LeftState.Transitions[K].LHS = RightState.Transitions[K].LHS) do - Inc(K); - - if K < LeftState.TransitionsUsed then - begin - Done := True; - Break; - end; - - for K := 0 to LeftState.TransitionsUsed - 1 do - AddEquivalentPair(LeftState.Transitions[K].RHS, RightState.Transitions[K].RHS); - - Inc(Equal); - end; - - if not Done then - Break; - end; - Inc(J); - end; - - if J < I then - begin - with FUREBuffer do - begin - for Equal := 0 to EquivalentList.EquivalentsUsed - 1 do - begin - States.States[EquivalentList.Equivalents[Equal].Right].ID := - States.States[EquivalentList.Equivalents[Equal].Left].ID; - end; - end; - end; - - end; - end; - - // Renumber the states appropriately - State1 := @FUREBuffer.States.States[0]; - Equal := 0; - for I := 0 to FUREBuffer.States.StatesUsed - 1 do - begin - if State1.ID = SizeInt(I) then - begin - State1.ID := Equal; - Inc(Equal); - end - else - State1.ID := FUREBuffer.States.States[State1.ID].ID; - Inc(State1); - end; -end; - -procedure TURESearch.ClearUREBuffer; -var - I: SizeInt; -begin - with FUREBuffer do - begin - // quite a few dynamic arrays to free - Stack.List := nil; - ExpressionList.Expressions := nil; - - // the symbol table has been handed over to the DFA and will be freed on - // release of the DFA - SymbolTable.SymbolsUsed := 0; - - for I := 0 to States.StatesUsed - 1 do - begin - States.States[I].Transitions := nil; - States.States[I].StateList.List := nil; - States.States[I].StateList.ListUsed := 0; - States.States[I].TransitionsUsed := 0; - end; - - States.StatesUsed := 0; - States.States := nil; - EquivalentList.Equivalents := nil; - end; - ResetMemory(FUREBuffer, SizeOf(FUREBuffer)); -end; - -procedure TURESearch.CompileURE(RE: PWideChar; RELength: SizeInt; Casefold: Boolean); -var - I, J: SizeInt; - State: SizeInt; - Run: PUcState; - TP: SizeInt; - - procedure UREError(Text: string; RE: PWideChar); - var - S: string; - begin - S := RE; - raise EJclUnicodeError.CreateResFmt(@RsUREErrorFmt, [LoadResString(@RsUREBaseString), Text, S]); - end; - -begin - // be paranoid - if (RE <> nil) and (RE^ <> WideNull) and (RELength > 0) then - begin - // Reset the various fields of the compilation buffer. Default the Flags - // to indicate the presense of the "^$" pattern. If any other pattern - // occurs, then this flag will be removed. This is done to catch this - // special pattern and handle it specially when matching. - ClearUREBuffer; - ClearDFA; - FUREBuffer.Flags := _URE_DFA_BLANKLINE; - if Casefold then - FUREBuffer.Flags := FUREBuffer.Flags or _URE_DFA_CASEFOLD; - - // Construct the NFA. If this stage returns a 0, then an error occurred or an - // empty expression was passed. - State := ConvertRegExpToNFA(RE, RELength); - if State <> _URE_NOOP then - begin - // Do the expression reduction to get the initial DFA. - Reduce(State); - - // Merge all the equivalent DFA States. - MergeEquivalents; - - // Construct the minimal DFA. - FDFA.Flags := FUREBuffer.Flags and (_URE_DFA_CASEFOLD or _URE_DFA_BLANKLINE); - - // Free up the NFA state groups and transfer the symbols from the buffer - // to the DFA. - FDFA.SymbolTable := FUREBuffer.SymbolTable; - FUREBuffer.SymbolTable.Symbols := nil; - - // Collect the total number of states and transitions needed for the DFA. - State := 0; - for I := 0 to FUREBuffer.States.StatesUsed - 1 do - begin - if FUREBuffer.States.States[I].ID = State then - begin - Inc(FDFA.StateList.StatesUsed); - Inc(FDFA.TransitionList.TransitionsUsed, FUREBuffer.States.States[I].TransitionsUsed); - Inc(State); - end; - end; - - // Allocate enough space for the states and transitions. - SetLength(FDFA.StateList.States, FDFA.StateList.StatesUsed); - SetLength(FDFA.TransitionList.Transitions, FDFA.TransitionList.TransitionsUsed); - - // Actually transfer the DFA States from the buffer. - State := 0; - TP := 0; - Run := @FUREBuffer.States.States[0]; - for I := 0 to FUREBuffer.States.StatesUsed - 1 do - begin - if Run.ID = State then - begin - FDFA.StateList.States[I].StartTransition := TP; - FDFA.StateList.States[I].NumberTransitions := Run.TransitionsUsed; - FDFA.StateList.States[I].Accepting := Run.Accepting; - - // Add the transitions for the state - for J := 0 to FDFA.StateList.States[I].NumberTransitions - 1 do - begin - FDFA.TransitionList.Transitions[TP].Symbol := Run.Transitions[J].LHS; - FDFA.TransitionList.Transitions[TP].NextState := - FUREBuffer.States.States[Run.Transitions[J].RHS].ID; - Inc(TP); - end; - - Inc(State); - end; - Inc(Run); - end; - end - else - begin - // there might be an error while parsing the pattern, show it if so - case FUREBuffer.Error of - _URE_UNEXPECTED_EOS: - UREError(LoadResString(@RsUREUnexpectedEOS), RE); - _URE_CCLASS_OPEN: - UREError(LoadResString(@RsURECharacterClassOpen), RE); - _URE_UNBALANCED_GROUP: - UREError(LoadResString(@RsUREUnbalancedGroup), RE); - _URE_INVALID_PROPERTY: - UREError(LoadResString(@RsUREInvalidCharProperty), RE); - _URE_INVALID_RANGE: - UREError(LoadResString(@RsUREInvalidRepeatRange), RE); - _URE_RANGE_OPEN: - UREError(LoadResString(@RsURERepeatRangeOpen), RE); - else - // expression was empty - raise EJclUnicodeError.CreateRes(@RsUREExpressionEmpty); - end; - end; - end; -end; - -procedure TURESearch.ClearDFA; -var - I: SizeInt; -begin - with FDFA do - begin - for I := 0 to SymbolTable.SymbolsUsed - 1 do - begin - if (SymbolTable.Symbols[I].AType = _URE_CCLASS) or - (SymbolTable.Symbols[I].AType = _URE_NCCLASS) then - SymbolTable.Symbols[I].Symbol.CCL.Ranges := nil; - end; - - for I := 0 to SymbolTable.SymbolsUsed - 1 do - begin - FDFA.SymbolTable.Symbols[I].States.List := nil; - FDFA.SymbolTable.Symbols[I].States.ListUsed := 0; - end; - SymbolTable.SymbolsUsed := 0; - - SymbolTable.Symbols := nil; - StateList.States := nil; - TransitionList.Transitions := nil; - end; - ResetMemory(FDFA, SizeOf(FDFA)); -end; - -function IsSeparator(C: UCS4): Boolean; -begin - Result := (C = $D) or (C = $A) or (C = $2028) or (C = $2029); -end; - -function TURESearch.ExecuteURE(Flags: Cardinal; Text: PUCS2; TextLen: SizeInt; var MatchStart, - MatchEnd: SizeInt): Boolean; -var - I, J: SizeInt; - Matched, - Found: Boolean; - Start, Stop: SizeInt; - C: UCS4; - Run, Tail, lp: PUCS2; - LastState: PDFAState; - Symbol: PUcSymbolTableEntry; - Rp: PUcRange; - LCMapping: TUCS4Array; -begin - Result := False; - if Text <> nil then - begin - // Handle the special case of an empty string matching the "^$" pattern. - if (Textlen = 0) and ((FDFA.Flags and _URE_DFA_BLANKLINE) <> 0) then - begin - MatchStart := 0; - MatchEnd := 0; - Result := True; - Exit; - end; - - Run := Text; - Tail := Run + TextLen; - Start := -1; - Stop := -1; - LastState := @FDFA.StateList.States[0]; - - Found := False; - while not Found and (Run < Tail) do - begin - lp := Run; - C := UCS4(Run^); - Inc(Run); - - // Check to see if this is a high surrogate that should be combined with a - // following low surrogate. - if (Run < Tail) and - (SurrogateHighStart <= C) and (C <= SurrogateHighEnd) and - (SurrogateLowStart <= UCS4(Run^)) and (UCS4(Run^) <= SurrogateLowEnd) then - begin - C := $10000 + (((C and $03FF) shl 10) or (UCS4(Run^) and $03FF)); - Inc(Run); - end; - - // Determine if the character is non-spacing and should be skipped. - if ((Flags and URE_IGNORE_NONSPACING) <> 0) and UnicodeIsNonSpacing(C) then - begin - Inc(Run); - Continue; - end; - - if (FDFA.Flags and _URE_DFA_CASEFOLD) <> 0 then - begin - SetLength(LCMapping, 0); - { TODO : use the entire mapping, not only the first character } - // (CaseLookup used for a little extra speed: avoids dynamic array allocation) - if CaseLookup(C, ctLower, LCMapping) then - C := LCMapping[0]; - end; - - // See if one of the transitions matches. - I := LastState.NumberTransitions - 1; - Matched := False; - - while not Matched and (I >= 0) do - begin - Symbol := @FDFA.SymbolTable.Symbols[FDFA.TransitionList.Transitions[LastState.StartTransition + I].Symbol]; - case Symbol.AType of - _URE_ANY_CHAR: - if ((Flags and URE_DONT_MATCHES_SEPARATORS) <> 0) or - not IsSeparator(C) then - Matched := True; - _URE_CHAR: - if C = Symbol.Symbol.Chr then - Matched := True; - _URE_BOL_ANCHOR: - if Lp = Text then - begin - Run := lp; - Matched := True; - end - else - begin - if IsSeparator(C) then - begin - if (C = $D) and (Run < Tail) and (Run^ = #$A) then - Inc(Run); - Lp := Run; - Matched := True; - end; - end; - _URE_EOL_ANCHOR: - if IsSeparator(C) then - begin - // Put the pointer back before the separator so the match end - // position will be correct. This will also cause the `Run' - // pointer to be advanced over the current separator once the - // match end point has been recorded. - Run := Lp; - Matched := True; - end; - _URE_CCLASS, - _URE_NCCLASS: - with Symbol^ do - begin - if Categories <> [] then - Matched := CategoryLookup(C, Categories); - if Symbol.CCL.RangesUsed > 0 then - begin - Rp := @Symbol.CCL.Ranges[0]; - for J := 0 to Symbol.CCL.RangesUsed - 1 do - begin - if (Rp.MinCode <= C) and (C <= Rp.MaxCode) then - begin - Matched := True; - Break; - end; - Inc(Rp); - end; - end; - - if AType = _URE_NCCLASS then - Matched := not Matched; - end; - end; - - if Matched then - begin - if Start = -1 then - Start := Lp - Text - else - Stop := Run - Text; - - LastState := @FDFA.StateList.States[FDFA.TransitionList.Transitions[LastState.StartTransition + I].NextState]; - - // If the match was an EOL anchor, adjust the pointer past the separator - // that caused the match. The correct match position has been recorded - // already. - if Symbol.AType = _URE_EOL_ANCHOR then - begin - // skip the character that caused the match - Inc(Run); - // handle the infamous CRLF situation - if (Run < Tail) and (C = $D) and (Run^ = #$A) then - Inc(Run); - end; - end; - Dec(I); - end; - - if not Matched then - begin - Found := LastState.Accepting; - if not Found then - begin - // If the last state was not accepting, then reset and start over. - LastState := @FDFA.StateList.States[0]; - Start := -1; - Stop := -1; - end - else - begin - // set start and stop pointer if not yet done - if Start = -1 then - begin - Start := Lp - Text; - Stop := Run - Text; - end - else - begin - if Stop = -1 then - Stop := Lp - Text; - end; - end; - end - else - begin - if Run = Tail then - begin - if not LastState.Accepting then - begin - // This ugly hack is to make sure the end-of-line anchors match - // when the source text hits the end. This is only done if the last - // subexpression matches. - for I := 0 to LastState.NumberTransitions - 1 do - begin - if Found then - Break; - Symbol := @FDFA.SymbolTable.Symbols[FDFA.TransitionList.Transitions[LastState.StartTransition + I].Symbol]; - if Symbol.AType =_URE_EOL_ANCHOR then - begin - LastState := @FDFA.StateList.States[FDFA.TransitionList.Transitions[LastState.StartTransition + I].NextState]; - if LastState.Accepting then - begin - Stop := Run - Text; - Found := True; - end - else - Break; - end; - end; - end - else - begin - // Make sure any conditions that match all the way to the end of - // the string match. - Found := True; - Stop := Run - Text; - end; - end; - end; - end; - - if Found then - begin - MatchStart := Start; - MatchEnd := Stop; - end; - Result := Found; - end; -end; - -function TURESearch.FindAll(const Text: WideString): Boolean; -begin - Result := FindAll(PWideChar(Text), Length(Text)); -end; - -function TURESearch.FindAll(Text: PWideChar; TextLen: SizeInt): Boolean; -// Looks for all occurrences of the pattern passed to FindPrepare and creates an -// internal list of their positions. -var - Start, Stop: SizeInt; - Run: PWideChar; - RunLen: SizeInt; -begin - ClearResults; - Run := Text; - RunLen := TextLen; - // repeat to find all occurrences of the pattern - Start := 0; - Stop := 0; - while ExecuteURE(0, Run, RunLen, Start, Stop) do - begin - // store this result (consider text pointer movement)... - AddResult(Start + (Run - Text), Stop + (Run - Text)); - // ... and advance text position and length - Inc(Run, Stop); - Dec(RunLen, Stop); - end; - Result := FResults.Count > 0; -end; - -function TURESearch.FindFirst(const Text: WideString; var Start, Stop: SizeInt): Boolean; -begin - Result := FindFirst(PWideChar(Text), Length(Text), Start, Stop); -end; - -function TURESearch.FindFirst(Text: PWideChar; TextLen: SizeInt; var Start, Stop: SizeInt): Boolean; -// Looks for the first occurrence of the pattern passed to FindPrepare in Text and -// returns True if one could be found (in which case Start and Stop are set to -// the according indices) otherwise False. This function is in particular of -// interest if only one occurrence needs to be found. -begin - ClearResults; - Result := ExecuteURE(0, Text, TextLen, Start, Stop); - if Result then - AddResult(Start, Stop); -end; - -procedure TURESearch.FindPrepare(Pattern: PWideChar; PatternLength: SizeInt; Options: TSearchFlags); -begin - CompileURE(Pattern, PatternLength, not (sfCaseSensitive in Options)); -end; - -procedure TURESearch.FindPrepare(const Pattern: WideString; Options: TSearchFlags); -begin - CompileURE(PWideChar(Pattern), Length(Pattern), not (sfCaseSensitive in Options)); -end; - -//=== { TWideStrings } ======================================================= - -constructor TWideStrings.Create; -begin - inherited Create; - FLanguage := GetUserDefaultLCID; - FNormalizationForm := nfC; - FSaveFormat := sfUnicodeLSB; -end; - -procedure TWideStrings.SetLanguage(Value: LCID); -begin - FLanguage := Value; -end; - -function TWideStrings.GetSaveUnicode: Boolean; -begin - Result := SaveFormat = sfUnicodeLSB; -end; - -procedure TWideStrings.SetSaveUnicode(const Value: Boolean); -begin - if Value then - SaveFormat := sfUnicodeLSB - else - SaveFormat := sfAnsi; -end; - -function TWideStrings.Add(const S: WideString): Integer; -begin - Result := GetCount; - Insert(Result, S); -end; - -function TWideStrings.AddObject(const S: WideString; AObject: TObject): Integer; -begin - Result := Add(S); - PutObject(Result, AObject); -end; - -procedure TWideStrings.Append(const S: WideString); -begin - Add(S); -end; - -procedure TWideStrings.AddStrings(Strings: TStrings); -var - I: Integer; - {$IFNDEF SUPPORTS_UNICODE} - CP: Word; - {$ENDIF ~SUPPORTS_UNICODE} -begin - BeginUpdate; - try - {$IFNDEF SUPPORTS_UNICODE} - CP := CodePageFromLocale(FLanguage); - {$ENDIF ~SUPPORTS_UNICODE} - for I := 0 to Strings.Count - 1 do - begin - {$IFDEF SUPPORTS_UNICODE} - AddObject(Strings[I], Strings.Objects[I]) - {$ELSE ~SUPPORTS_UNICODE} - AddObject(StringToWideStringEx(Strings[I], CP), Strings.Objects[I]) - {$ENDIF ~SUPPORTS_UNICODE} - end; - finally - EndUpdate; - end; -end; - -procedure TWideStrings.AddStrings(Strings: TWideStrings); -var - I: Integer; -begin - Assert(Strings <> nil); - - BeginUpdate; - try - for I := 0 to Strings.Count - 1 do - AddObject(Strings[I], Strings.Objects[I]); - finally - EndUpdate; - end; -end; - -procedure TWideStrings.Assign(Source: TPersistent); -// usual assignment routine, but able to assign wide and small strings -begin - if Source is TWideStrings then - begin - BeginUpdate; - try - Clear; - AddStrings(TWideStrings(Source)); - finally - EndUpdate; - end; - end - else - begin - if Source is TStrings then - begin - BeginUpdate; - try - Clear; - AddStrings(TStrings(Source)); - finally - EndUpdate; - end; - end - else - inherited Assign(Source); - end; -end; - -procedure TWideStrings.AssignTo(Dest: TPersistent); -// need to do also assignment to old style TStrings, but this class doesn't know -// TWideStrings, so we need to do it from here -var - I: Integer; - {$IFNDEF SUPPORTS_UNICODE} - CP: Word; - {$ENDIF ~SUPPORTS_UNICODE} -begin - if Dest is TStrings then - begin - with Dest as TStrings do - begin - BeginUpdate; - try - {$IFNDEF SUPPORTS_UNICODE} - CP := CodePageFromLocale(FLanguage); - {$ENDIF SUPPORTS_UNICODE} - Clear; - for I := 0 to Self.Count - 1 do - begin - {$IFDEF SUPPORTS_UNICODE} - AddObject(Self[I], Self.Objects[I]); - {$ELSE ~SUPPORTS_UNICODE} - AddObject(WideStringToStringEx(Self[I], CP), Self.Objects[I]); - {$ENDIF ~SUPPORTS_UNICODE} - end; - finally - EndUpdate; - end; - end; - end - else - begin - if Dest is TWideStrings then - begin - with Dest as TWideStrings do - begin - BeginUpdate; - try - Clear; - AddStrings(Self); - finally - EndUpdate; - end; - end; - end - else - inherited AssignTo(Dest); - end; -end; - -procedure TWideStrings.BeginUpdate; -begin - if FUpdateCount = 0 then - SetUpdateState(True); - Inc(FUpdateCount); -end; - -procedure TWideStrings.DefineProperties(Filer: TFiler); - -// Defines a private property for the content of the list. -// There's a bug in the handling of text DFMs in Classes.pas which prevents -// WideStrings from loading under some circumstances. Zbysek Hlinka -// (zhlinka att login dott cz) brought this to my attention and supplied also a solution. -// See ReadData and WriteData methods for implementation details. - - //--------------- local function -------------------------------------------- - - function DoWrite: Boolean; - begin - if Filer.Ancestor <> nil then - begin - Result := True; - if Filer.Ancestor is TWideStrings then - Result := not Equals(TWideStrings(Filer.Ancestor)) - end - else - Result := Count > 0; - end; - - //--------------- end local function ---------------------------------------- - -begin - Filer.DefineProperty('WideStrings', ReadData, WriteData, DoWrite); -end; - -procedure TWideStrings.DoConfirmConversion(var Allowed: Boolean); -begin - if Assigned(FOnConfirmConversion) then - FOnConfirmConversion(Self, Allowed); -end; - -procedure TWideStrings.EndUpdate; -begin - Dec(FUpdateCount); - if FUpdateCount = 0 then - SetUpdateState(False); -end; - -function TWideStrings.Equals(Strings: TWideStrings): Boolean; -var - I, Count: Integer; -begin - Assert(Strings <> nil); - - Result := False; - Count := GetCount; - if Count <> Strings.GetCount then - Exit; - { TODO : use internal comparation routine as soon as composition is implemented } - for I := 0 to Count - 1 do - if Get(I) <> Strings.Get(I) then - Exit; - Result := True; -end; - -procedure TWideStrings.Error(const Msg: string; Data: Integer); - - function ReturnAddr: Pointer; - asm - {$IFDEF CPU32} - MOV EAX, EBP - MOV EAX, [EAX + 4] - {$ENDIF CPU32} - {$IFDEF CPU64} - MOV RAX, RBP - MOV RAX, [RAX + 8] - {$ENDIF CPU64} - end; - -begin - raise EStringListError.CreateFmt(Msg, [Data]) at ReturnAddr; -end; - -procedure TWideStrings.Exchange(Index1, Index2: Integer); -var - TempObject: TObject; - TempString: WideString; -begin - BeginUpdate; - try - TempString := Strings[Index1]; - TempObject := Objects[Index1]; - Strings[Index1] := Strings[Index2]; - Objects[Index1] := Objects[Index2]; - Strings[Index2] := TempString; - Objects[Index2] := TempObject; - finally - EndUpdate; - end; -end; - -function TWideStrings.GetCapacity: Integer; -// Descendants may optionally override/replace this default implementation. -begin - Result := Count; -end; - -function TWideStrings.GetCommaText: WideString; -var - S: WideString; - P: PWideChar; - I, Count: Integer; -begin - Count := GetCount; - if (Count = 1) and (Get(0) = '') then - Result := '""' - else - begin - Result := ''; - for I := 0 to Count - 1 do - begin - S := Get(I); - P := PWideChar(S); - while (P^ > WideSpace) and (P^ <> '"') and (P^ <> ',') do - Inc(P); - if P^ <> WideNull then - S := WideQuotedStr(S, '"'); - Result := Result + S + ','; - end; - System.Delete(Result, Length(Result), 1); - end; -end; - -function TWideStrings.GetName(Index: Integer): WideString; -var - P: Integer; -begin - Result := Get(Index); - P := Pos('=', Result); - if P > 0 then - SetLength(Result, P - 1) - else - Result := ''; -end; - -function TWideStrings.GetObject(Index: Integer): TObject; -begin - Result := nil; -end; - -function TWideStrings.GetSeparatedText(Separators: WideString): WideString; -// Same as GetText but with customizable separator characters. -var - I, L, - Size, - Count, - SepSize: Integer; - P: PWideChar; - S: WideString; -begin - Count := GetCount; - SepSize := Length(Separators); - Size := 0; - for I := 0 to Count - 1 do - Inc(Size, Length(Get(I)) + SepSize); - - // set one separator less, the last line does not need a trailing separator - SetLength(Result, Size - SepSize); - if Size > 0 then - begin - P := Pointer(Result); - I := 0; - while True do - begin - S := Get(I); - L := Length(S); - if L <> 0 then - begin - // add current string - System.Move(Pointer(S)^, P^, 2 * L); - Inc(P, L); - end; - Inc(I); - if I = Count then - Break; - - // add separators - System.Move(Pointer(Separators)^, P^, SizeOf(WideChar) * SepSize); - Inc(P, SepSize); - end; - end; -end; - -function TWideStrings.GetTextStr: WideString; -begin - Result := GetSeparatedText(WideCRLF); -end; - -function TWideStrings.GetText: PWideChar; -begin - Result := StrNewW(GetTextStr); -end; - -function TWideStrings.GetValue(const Name: WideString): WideString; -var - I: Integer; -begin - I := IndexOfName(Name); - if I >= 0 then - Result := Copy(Get(I), Length(Name) + 2, MaxInt) - else - Result := ''; -end; - -function TWideStrings.IndexOf(const S: WideString): Integer; -var - NormString: WideString; -begin - NormString := WideNormalize(S, FNormalizationForm); - - for Result := 0 to GetCount - 1 do - if WideCompareText(Get(Result), NormString, FLanguage) = 0 then - Exit; - Result := -1; -end; - -function TWideStrings.IndexOfName(const Name: WideString): Integer; -var - P: Integer; - S: WideString; - NormName: WideString; -begin - NormName := WideNormalize(Name, FNormalizationForm); - - for Result := 0 to GetCount - 1 do - begin - S := Get(Result); - P := Pos('=', S); - if (P > 0) and (WideCompareText(Copy(S, 1, P - 1), NormName, FLanguage) = 0) then - Exit; - end; - Result := -1; -end; - -function TWideStrings.IndexOfObject(AObject: TObject): Integer; -begin - for Result := 0 to GetCount - 1 do - if GetObject(Result) = AObject then - Exit; - Result := -1; -end; - -procedure TWideStrings.InsertObject(Index: Integer; const S: WideString; AObject: TObject); -begin - Insert(Index, S); - PutObject(Index, AObject); -end; - -procedure TWideStrings.LoadFromFile(const FileName: TFileName); -var - Stream: TStream; -begin - try - Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); - try - LoadFromStream(Stream); - finally - Stream.Free; - end; - except - RaiseLastOSError; - end; -end; - -procedure TWideStrings.LoadFromStream(Stream: TStream); -// usual loader routine, but enhanced to handle byte order marks in stream -var - Size, - BytesRead: Integer; - ByteOrderMask: array [0..5] of Byte; // BOM size is max 5 bytes (cf: wikipedia) - // but it is easier to implement with a multiple of 2 - Loaded: Boolean; - SW: WideString; - SA: AnsiString; -begin - BeginUpdate; - try - Loaded := False; - - Size := Stream.Size - Stream.Position; - ByteOrderMask[0] := 0; - BytesRead := Stream.Read(ByteOrderMask[0],SizeOf(ByteOrderMask)); - - // UTF16 LSB = Unicode LSB - if (BytesRead >= 2) and (ByteOrderMask[0] = BOM_UTF16_LSB[0]) - and (ByteOrderMask[1] = BOM_UTF16_LSB[1]) then - begin - FSaveFormat := sfUTF16LSB; - SetLength(SW, (Size - 2) div SizeOf(WideChar)); - Assert((Size and 1) <> 1,'Number of chars must be a multiple of 2'); - if BytesRead > 2 then - begin - System.Move(ByteOrderMask[2], SW[1], BytesRead-2); // max 4 bytes = 2 widechars - if Size > BytesRead then - // first 2 chars (maximum) were copied by System.Move - Stream.Read(SW[3], Size-BytesRead); - end; - SetText(SW); - Loaded := True; - end; - - // UTF16 MSB = Unicode MSB - if (BytesRead >= 2) and (ByteOrderMask[0] = BOM_UTF16_MSB[0]) - and (ByteOrderMask[1] = BOM_UTF16_MSB[1]) then - begin - FSaveFormat := sfUTF16MSB; - SetLength(SW, (Size - 2) div SizeOf(WideChar)); - Assert((Size and 1) <> 1,'Number of chars must be a multiple of 2'); - if BytesRead > 2 then - begin - System.Move(ByteOrderMask[2],SW[1],BytesRead-2); // max 4 bytes = 2 widechars - if Size > BytesRead then - // first 2 chars (maximum) were copied by System.Move - Stream.Read(SW[3], Size-BytesRead); - StrSwapByteOrder(PWideChar(SW)); - end; - SetText(SW); - Loaded := True; - end; - - // UTF8 - if (BytesRead >= 3) and (ByteOrderMask[0] = BOM_UTF8[0]) - and (ByteOrderMask[1] = BOM_UTF8[1]) and (ByteOrderMask[2] = BOM_UTF8[2]) then - begin - FSaveFormat := sfUTF8; - SetLength(SA, (Size-3) div SizeOf(AnsiChar)); - if BytesRead > 3 then - begin - System.Move(ByteOrderMask[3],SA[1],BytesRead-3); // max 3 bytes = 3 chars - if Size > BytesRead then - // first 3 chars were copied by System.Move - Stream.Read(SA[4], Size-BytesRead); - SW := UTF8ToWideString(SA); - end; - SetText(SW); - Loaded := True; - end; - - // default case (Ansi) - if not Loaded then - begin - FSaveFormat := sfAnsi; - SetLength(SA, Size div SizeOf(AnsiChar)); - if BytesRead > 0 then - begin - System.Move(ByteOrderMask[0], SA[1], BytesRead); // max 6 bytes = 6 chars - if Size > BytesRead then - Stream.Read(SA[7], Size-BytesRead); // first 6 chars were copied by System.Move - end; - SetText(StringToWideStringEx(SA, CodePageFromLocale(FLanguage))); - end; - finally - EndUpdate; - end; -end; - -procedure TWideStrings.Move(CurIndex, NewIndex: Integer); -var - TempObject: TObject; - TempString: WideString; -begin - if CurIndex <> NewIndex then - begin - BeginUpdate; - try - TempString := Get(CurIndex); - TempObject := GetObject(CurIndex); - Delete(CurIndex); - InsertObject(NewIndex, TempString, TempObject); - finally - EndUpdate; - end; - end; -end; - -procedure TWideStrings.ReadData(Reader: TReader); -begin - case Reader.NextValue of - vaLString, vaString: - SetText(Reader.ReadString); - else - SetText(Reader.{$IFDEF RTL240_UP}ReadString{$ELSE}ReadWideString{$ENDIF}); - end; -end; - -procedure TWideStrings.SaveToFile(const FileName: TFileName); -var - Stream: TStream; -begin - Stream := TFileStream.Create(FileName, fmCreate); - try - SaveToStream(Stream); - finally - Stream.Free; - end; -end; - -procedure TWideStrings.SaveToStream(Stream: TStream; WithBOM: Boolean = True); -// Saves the currently loaded text into the given stream. WithBOM determines whether to write a -// byte order mark or not. Note: when saved as ANSI text there will never be a BOM. -var - SW: WideString; - SA: AnsiString; - Allowed: Boolean; - Run: PWideChar; -begin - // The application can decide in which format to save the content. - // If FSaveUnicode is False then all strings are saved in standard ANSI format - // which is also loadable by TStrings but you should be aware that all Unicode - // strings are then converted to ANSI based on the current system locale. - // An extra event is supplied to ask the user about the potential loss of - // information when converting Unicode to ANSI strings. - SW := GetTextStr; - Allowed := True; - FSaved := False; // be pessimistic - // A check for potential information loss makes only sense if the application has - // set an event to be used as call back to ask about the conversion. - if (FSaveFormat = sfAnsi) and Assigned(FOnConfirmConversion) then - begin - // application requests to save only ANSI characters, so check the text and - // call back in case information could be lost - Run := PWideChar(SW); - // only ask if there's at least one Unicode character in the text - while (Run^>#0) and (run^<=#255) do - Inc(Run); - // Note: The application can still set FSaveUnicode to True in the callback. - if Run^ <> WideNull then - DoConfirmConversion(Allowed); - end; - - if Allowed then - begin - // only save if allowed - case SaveFormat of - sfUTF16LSB : - begin - if WithBOM then - Stream.WriteBuffer(BOM_UTF16_LSB[0],SizeOf(BOM_UTF16_LSB)); - if Length(SW) > 0 then - Stream.WriteBuffer(SW[1],Length(SW)*SizeOf(UTF16)); - FSaved := True; - end; - sfUTF16MSB : - begin - if WithBOM then - Stream.WriteBuffer(BOM_UTF16_MSB[0],SizeOf(BOM_UTF16_MSB)); - if Length(SW) > 0 then - begin - StrSwapByteOrder(PWideChar(SW)); - Stream.WriteBuffer(SW[1],Length(SW)*SizeOf(UTF16)); - end; - FSaved := True; - end; - sfUTF8 : - begin - if WithBOM then - Stream.WriteBuffer(BOM_UTF8[0],SizeOf(BOM_UTF8)); - if Length(SW) > 0 then - begin - SA := WideStringToUTF8(SW); - Stream.WriteBuffer(SA[1],Length(SA)*SizeOf(UTF8)); - end; - FSaved := True; - end; - sfAnsi : - begin - if Length(SW) > 0 then - begin - SA := WideStringToStringEx(SW,CodePageFromLocale(FLanguage)); - Stream.WriteBuffer(SA[1],Length(SA)*SizeOf(AnsiChar)); - end; - FSaved := True; - end; - end; - end; -end; - -procedure TWideStrings.SetCapacity(NewCapacity: Integer); -begin - // do nothing - descendants may optionally implement this method -end; - -procedure TWideStrings.SetCommaText(const Value: WideString); -var - P, P1: PWideChar; - S: WideString; -begin - BeginUpdate; - try - Clear; - P := PWideChar(Value); - while (P^ >= #1) and (P^ <= WideSpace) do - Inc(P); - while P^ <> WideNull do - begin - if P^ = '"' then - S := WideExtractQuotedStr(P, '"') - else - begin - P1 := P; - while (P^ > WideSpace) and (P^ <> ',') do - Inc(P); - SetString(S, P1, P - P1); - end; - Add(S); - - while (P^ >= #1) and (P^ <= WideSpace) do - Inc(P); - if P^ = ',' then - begin - repeat - Inc(P); - until not ((P^ >= #1) and (P^ <= WideSpace)); - end; - end; - finally - EndUpdate; - end; -end; - -procedure TWideStrings.SetText(const Value: WideString); -var - Head, - Tail: PWideChar; - S: WideString; -begin - BeginUpdate; - try - Clear; - Head := PWideChar(Value); - while Head^ <> WideNull do - begin - Tail := Head; - while (Tail^ <> WideNull) and (Tail^ <> WideLineFeed) and (Tail^ <> WideCarriageReturn) and - (Tail^ <> WideVerticalTab) and (Tail^ <> WideFormFeed) and (Tail^ <> WideLineSeparator) and - (Tail^ <> WideParagraphSeparator) do - Inc(Tail); - SetString(S, Head, Tail - Head); - Add(S); - Head := Tail; - if Head^ <> WideNull then - begin - Inc(Head); - if (Tail^ = WideCarriageReturn) and (Head^ = WideLineFeed) then - Inc(Head); - end; - end; - finally - EndUpdate; - end; -end; - -procedure TWideStrings.SetUpdateState(Updating: Boolean); -begin -end; - -procedure TWideStrings.SetNormalizationForm(const Value: TNormalizationForm); -var - I: Integer; -begin - if FNormalizationForm <> Value then - begin - FNormalizationForm := Value; - if FNormalizationForm <> nfNone then - begin - // renormalize all strings according to the new form - for I := 0 to GetCount - 1 do - Put(I, WideNormalize(Get(I), FNormalizationForm)); - end; - end; -end; - -procedure TWideStrings.SetValue(const Name, Value: WideString); -var - I : Integer; -begin - I := IndexOfName(Name); - if Value <> '' then - begin - if I < 0 then - I := Add(''); - Put(I, Name + '=' + Value); - end - else - begin - if I >= 0 then - Delete(I); - end; -end; - -procedure TWideStrings.WriteData(Writer: TWriter); -begin - Writer.{$IFDEF RTL240_UP}WriteString{$ELSE}WriteWideString{$ENDIF}(GetTextStr); -end; - -//=== { TWideStringList } ==================================================== - -destructor TWideStringList.Destroy; -begin - FOnChange := nil; - FOnChanging := nil; - Clear; - inherited Destroy; -end; - -function TWideStringList.Add(const S: WideString): Integer; -begin - if not Sorted then - Result := FCount - else - begin - if Find(S, Result) then - begin - case Duplicates of - dupIgnore: - Exit; - dupError: - Error(SDuplicateString, 0); - end; - end; - end; - InsertItem(Result, S); -end; - -procedure TWideStringList.Changed; -begin - if (FUpdateCount = 0) and Assigned(FOnChange) then - FOnChange(Self); -end; - -procedure TWideStringList.Changing; -begin - if (FUpdateCount = 0) and Assigned(FOnChanging) then - FOnChanging(Self); -end; - -procedure TWideStringList.Clear; -{$IFDEF OWN_WIDESTRING_MEMMGR} -var - I: Integer; -{$ENDIF OWN_WIDESTRING_MEMMGR} -begin - if FCount <> 0 then - begin - Changing; - {$IFDEF OWN_WIDESTRING_MEMMGR} - for I := 0 to FCount - 1 do - with FList[I] do - if TDynWideCharArray(FString) <> nil then - TDynWideCharArray(FString) := nil; - {$ENDIF OWN_WIDESTRING_MEMMGR} - // this will automatically finalize the array - FList := nil; - FCount := 0; - SetCapacity(0); - Changed; - end; -end; - -procedure TWideStringList.Delete(Index: Integer); -begin - if Cardinal(Index) >= Cardinal(FCount) then - Error(SListIndexError, Index); - Changing; - - {$IFDEF OWN_WIDESTRING_MEMMGR} - SetListString(Index, ''); - {$ELSE ~OWN_WIDESTRING_MEMMGR} - FList[Index].FString := ''; - {$ENDIF ~OWN_WIDESTRING_MEMMGR} - Dec(FCount); - if Index < FCount then - begin - System.Move(FList[Index + 1], FList[Index], (FCount - Index) * SizeOf(TWideStringItem)); - Pointer(FList[FCount].FString) := nil; // avoid freeing the string, the address is now used in another element - end; - Changed; -end; - -procedure TWideStringList.Exchange(Index1, Index2: Integer); -begin - if Cardinal(Index1) >= Cardinal(FCount) then - Error(SListIndexError, Index1); - if Cardinal(Index2) >= Cardinal(FCount) then - Error(SListIndexError, Index2); - Changing; - ExchangeItems(Index1, Index2); - Changed; -end; - -procedure TWideStringList.ExchangeItems(Index1, Index2: Integer); -var - Temp: TWideStringItem; -begin - Temp := FList[Index1]; - FList[Index1] := FList[Index2]; - FList[Index2] := Temp; -end; - -function TWideStringList.Find(const S: WideString; var Index: Integer): Boolean; -var - L, H, I, C: Integer; - NormString: WideString; -begin - Result := False; - NormString := WideNormalize(S, FNormalizationForm); - L := 0; - H := FCount - 1; - while L <= H do - begin - I := (L + H) shr 1; - C := WideCompareText(FList[I].FString, NormString, FLanguage); - if C < 0 then - L := I+1 - else - begin - H := I - 1; - if C = 0 then - begin - Result := True; - if Duplicates <> dupAccept then - L := I; - end; - end; - end; - Index := L; -end; - -function TWideStringList.Get(Index: Integer): WideString; -{$IFDEF OWN_WIDESTRING_MEMMGR} -var - Len: Integer; -{$ENDIF OWN_WIDESTRING_MEMMGR} -begin - if Cardinal(Index) >= Cardinal(FCount) then - Error(SListIndexError, Index); - {$IFDEF OWN_WIDESTRING_MEMMGR} - with FList[Index] do - begin - Len := Length(TDynWideCharArray(FString)); - if Len > 0 then - begin - SetLength(Result, Len - 1); // exclude #0 - if Result <> '' then - System.Move(FString^, Result[1], Len * SizeOf(WideChar)); - end - else - Result := ''; - end; - {$ELSE ~OWN_WIDESTRING_MEMMGR} - Result := FList[Index].FString; - {$ENDIF ~OWN_WIDESTRING_MEMMGR} -end; - -function TWideStringList.GetCapacity: Integer; -begin - Result := Length(FList); -end; - -function TWideStringList.GetCount: Integer; -begin - Result := FCount; -end; - -function TWideStringList.GetObject(Index: Integer): TObject; -begin - if Cardinal(Index) >= Cardinal(FCount) then - Error(SListIndexError, Index); - Result := FList[Index].FObject; -end; - -procedure TWideStringList.Grow; -var - Delta, - Len: Integer; -begin - Len := Length(FList); - if Len > 64 then - Delta := Len div 4 - else - begin - if Len > 8 then - Delta := 16 - else - Delta := 4; - end; - SetCapacity(Len + Delta); -end; - -function TWideStringList.IndexOf(const S: WideString): Integer; -begin - if not Sorted then - Result := inherited IndexOf(S) - else - if not Find(S, Result) then - Result := -1; -end; - -procedure TWideStringList.Insert(Index: Integer; const S: WideString); -begin - if Sorted then - Error(SSortedListError, 0); - if Cardinal(Index) > Cardinal(FCount) then - Error(SListIndexError, Index); - InsertItem(Index, S); -end; - -{$IFDEF OWN_WIDESTRING_MEMMGR} -procedure TWideStringList.SetListString(Index: Integer; const S: WideString); -var - Len: Integer; - A: TDynWideCharArray; -begin - with FList[Index] do - begin - Pointer(A) := TDynWideCharArray(FString); - if A <> nil then - A := nil; // free memory - - Len := Length(S); - if Len > 0 then - begin - SetLength(A, Len + 1); // include #0 - System.Move(S[1], A[0], Len * SizeOf(WideChar)); - A[Len] := #0; - end; - - FString := PWideChar(A); - Pointer(A) := nil; // do not release the array on procedure exit - end; -end; -{$ENDIF OWN_WIDESTRING_MEMMGR} - -procedure TWideStringList.InsertItem(Index: Integer; const S: WideString); -begin - Changing; - if FCount = Length(FList) then - Grow; - if Index < FCount then - System.Move(FList[Index], FList[Index + 1], (FCount - Index) * SizeOf(TWideStringItem)); - with FList[Index] do - begin - Pointer(FString) := nil; // avoid freeing the string, the address is now used in another element - FObject := nil; - if (FNormalizationForm <> nfNone) and (Length(S) > 0) then - {$IFDEF OWN_WIDESTRING_MEMMGR} - SetListString(Index, WideNormalize(S, FNormalizationForm)) - else - SetListString(Index, S); - {$ELSE ~OWN_WIDESTRING_MEMMGR} - FString := WideNormalize(S, FNormalizationForm) - else - FString := S; - {$ENDIF ~OWN_WIDESTRING_MEMMGR} - end; - Inc(FCount); - Changed; -end; - -procedure TWideStringList.Put(Index: Integer; const S: WideString); -begin - if Sorted then - Error(SSortedListError, 0); - if Cardinal(Index) >= Cardinal(FCount) then - Error(SListIndexError, Index); - Changing; - - if (FNormalizationForm <> nfNone) and (Length(S) > 0) then - {$IFDEF OWN_WIDESTRING_MEMMGR} - SetListString(Index, WideNormalize(S, FNormalizationForm)) - else - SetListString(Index, S); - {$ELSE ~OWN_WIDESTRING_MEMMGR} - FList[Index].FString := WideNormalize(S, FNormalizationForm) - else - FList[Index].FString := S; - {$ENDIF ~OWN_WIDESTRING_MEMMGR} - Changed; -end; - -procedure TWideStringList.PutObject(Index: Integer; AObject: TObject); -begin - if Cardinal(Index) >= Cardinal(FCount) then - Error(SListIndexError, Index); - Changing; - FList[Index].FObject := AObject; - Changed; -end; - -procedure TWideStringList.QuickSort(L, R: Integer); -var - I, J: Integer; - P: WideString; -begin - repeat - I := L; - J := R; - P := FList[(L + R) shr 1].FString; - repeat - while WideCompareText(FList[I].FString, P, FLanguage) < 0 do - Inc(I); - while WideCompareText(FList[J].FString, P, FLanguage) > 0 do - Dec(J); - if I <= J then - begin - ExchangeItems(I, J); - Inc(I); - Dec(J); - end; - until I > J; - if L < J then - QuickSort(L, J); - L := I; - until I >= R; -end; - -procedure TWideStringList.SetCapacity(NewCapacity: Integer); -begin - SetLength(FList, NewCapacity); - if NewCapacity < FCount then - FCount := NewCapacity; -end; - -procedure TWideStringList.SetSorted(Value: Boolean); -begin - if FSorted <> Value then - begin - if Value then - Sort; - FSorted := Value; - end; -end; - -procedure TWideStringList.SetUpdateState(Updating: Boolean); -begin - if Updating then - Changing - else - Changed; -end; - -procedure TWideStringList.Sort; -begin - if not Sorted and (FCount > 1) then - begin - Changing; - QuickSort(0, FCount - 1); - Changed; - end; -end; - -procedure TWideStringList.SetLanguage(Value: LCID); -begin - inherited SetLanguage(Value); - if Sorted then - Sort; -end; - -{$ENDIF ~UNICODE_RTL_DATABASE} - -// exchanges in each character of the given string the low order and high order -// byte to go from LSB to MSB and vice versa. -// EAX contains address of string - -function WideAdjustLineBreaks(const S: WideString): WideString; -var - Source, - SourceEnd, - Dest: PWideChar; -begin - Source := Pointer(S); - SourceEnd := Source + Length(S); - - Source := Pointer(S); - SetString(Result, nil, SourceEnd - Source); - Dest := Pointer(Result); - - while Source < SourceEnd do - begin - case Source^ of - WideLineFeed: - begin - Dest^ := WideLineSeparator; - Inc(Dest); - Inc(Source); - end; - WideCarriageReturn: - begin - Dest^ := WideLineSeparator; - Inc(Dest); - Inc(Source); - if Source^ = WideLineFeed then - Inc(Source); - end; - else - Dest^ := Source^; - Inc(Dest); - Inc(Source); - end; - end; - - SetLength(Result, (TJclAddr(Dest) - TJclAddr(Result)) div 2); -end; - -function WideQuotedStr(const S: WideString; Quote: WideChar): WideString; -// works like QuotedStr from SysUtils.pas but can insert any quotation character -var - P, Src, - Dest: PWideChar; - AddCount: SizeInt; -begin - AddCount := 0; - P := StrScanW(PWideChar(S), Quote); - while (P <> nil) do - begin - Inc(P); - Inc(AddCount); - P := StrScanW(P, Quote); - end; - - if AddCount = 0 then - Result := Quote + S + Quote - else - begin - SetLength(Result, Length(S) + AddCount + 2); - Dest := PWideChar(Result); - Dest^ := Quote; - Inc(Dest); - Src := PWideChar(S); - P := StrScanW(Src, Quote); - repeat - Inc(P); - Move(Src^, Dest^, 2 * (P - Src)); - Inc(Dest, P - Src); - Dest^ := Quote; - Inc(Dest); - Src := P; - P := StrScanW(Src, Quote); - until P = nil; - P := StrEndW(Src); - Move(Src^, Dest^, 2 * (P - Src)); - Inc(Dest, P - Src); - Dest^ := Quote; - end; -end; - -function WideExtractQuotedStr(var Src: PWideChar; Quote: WideChar): WideString; -// extracts a string enclosed in quote characters given by Quote -var - P, Dest: PWideChar; - DropCount: SizeInt; -begin - Result := ''; - if (Src = nil) or (Src^ <> Quote) then - Exit; - - Inc(Src); - DropCount := 1; - P := Src; - Src := StrScanW(Src, Quote); - - while Src <> nil do // count adjacent pairs of quote chars - begin - Inc(Src); - if Src^ <> Quote then - Break; - Inc(Src); - Inc(DropCount); - Src := StrScanW(Src, Quote); - end; - - if Src = nil then - Src := StrEndW(P); - if (Src - P) <= 1 then - Exit; - - if DropCount = 1 then - SetString(Result, P, Src - P - 1) - else - begin - SetLength(Result, Src - P - DropCount); - Dest := PWideChar(Result); - Src := StrScanW(P, Quote); - while Src <> nil do - begin - Inc(Src); - if Src^ <> Quote then - Break; - Move(P^, Dest^, 2 * (Src - P)); - Inc(Dest, Src - P); - Inc(Src); - P := Src; - Src := StrScanW(Src, Quote); - end; - if Src = nil then - Src := StrEndW(P); - Move(P^, Dest^, 2 * (Src - P - 1)); - end; -end; - -function WideStringOfChar(C: WideChar; Count: SizeInt): WideString; -// returns a string of Count characters filled with C -var - I: SizeInt; -begin - SetLength(Result, Count); - for I := 1 to Count do - Result[I] := C; -end; - -function WideTrim(const S: WideString): WideString; -var - I, L: SizeInt; -begin - L := Length(S); - I := 1; - while (I <= L) and (UnicodeIsWhiteSpace(UCS4(S[I])) or UnicodeIsControl(UCS4(S[I]))) do - Inc(I); - if I > L then - Result := '' - else - begin - while UnicodeIsWhiteSpace(UCS4(S[L])) or UnicodeIsControl(UCS4(S[L])) do - Dec(L); - Result := Copy(S, I, L - I + 1); - end; -end; - -function WideTrimLeft(const S: WideString): WideString; -var - I, L: SizeInt; -begin - L := Length(S); - I := 1; - while (I <= L) and (UnicodeIsWhiteSpace(UCS4(S[I])) or UnicodeIsControl(UCS4(S[I]))) do - Inc(I); - Result := Copy(S, I, Maxint); -end; - -function WideTrimRight(const S: WideString): WideString; -var - I: SizeInt; -begin - I := Length(S); - while (I > 0) and (UnicodeIsWhiteSpace(UCS4(S[I])) or UnicodeIsControl(UCS4(S[I]))) do - Dec(I); - Result := Copy(S, 1, I); -end; - -// returns the index of character Ch in S, starts searching at index Index -// Note: This is a quick memory search. No attempt is made to interpret either -// the given charcter nor the string (ligatures, modifiers, surrogates etc.) -// Code from Azret Botash. - -function WideCharPos(const S: WideString; const Ch: WideChar; const Index: SizeInt): SizeInt; -var - P, R: PWideChar; -begin - if (Index > 0) and (Index <= Length(S)) then - begin - P := PWideChar(@S[Index]); - R := StrScanW(P, Ch); - if R <> nil then - Result := R - P + Index - else - Result := 0; - end - else - Result := 0; -end; - -{$IFNDEF UNICODE_RTL_DATABASE} - -function WideComposeHangul(const Source: WideString): WideString; -var - Len: SizeInt; - Ch, Last: WideChar; - I: SizeInt; - LIndex, VIndex, - SIndex, TIndex: SizeInt; -begin - Result := ''; - Len := Length(Source); - if Len > 0 then - begin - Last := Source[1]; - Result := Last; - - for I := 2 to Len do - begin - Ch := Source[I]; - - // 1. check to see if two current characters are L and V - LIndex := Word(Last) - LBase; - if (0 <= LIndex) and (LIndex < LCount) then - begin - VIndex := Word(Ch) - VBase; - if (0 <= VIndex) and (VIndex < VCount) then - begin - // make syllable of form LV - Last := WideChar((SBase + (LIndex * VCount + VIndex) * TCount)); - Result[Length(Result)] := Last; // reset last - Continue; // discard Ch - end; - end; - - // 2. check to see if two current characters are LV and T - SIndex := Word(Last) - SBase; - if (0 <= SIndex) and (SIndex < SCount) and ((SIndex mod TCount) = 0) then - begin - TIndex := Word(Ch) - TBase; - if (0 <= TIndex) and (TIndex <= TCount) then - begin - // make syllable of form LVT - Inc(Word(Last), TIndex); - Result[Length(Result)] := Last; // reset last - Continue; // discard Ch - end; - end; - - // if neither case was true, just add the character - Last := Ch; - Result := Result + Ch; - end; - end; -end; - -// Returns canonical composition of characters in S. - -function WideCompose(const S: WideString; Compatible: Boolean): WideString; -var - Buffer: array of UCS4; - LastInPos, InPos, OutPos, BufferSize, NbProcessed: SizeInt; - Composite: UCS4; -begin - // Set an arbitrary length for the result. This is automatically done when checking - // for hangul composition. - Result := WideComposeHangul(S); - - if Result = '' then - Exit; - - if not CompositionsLoaded then - LoadCompositionData; - - LastInPos := Length(Result); - if LastInPos > MaxCompositionSize then - SetLength(Buffer, MaxCompositionSize) - else - SetLength(Buffer, LastInPos); - - BufferSize := 0; - InPos := 0; - OutPos := 0; - - while (InPos < LastInPos) or (BufferSize > 0) do - begin - // fill buffer from input - - while BufferSize < Length(Buffer) do - begin - if InPos < LastInPos then - begin - Inc(InPos); - Buffer[BufferSize] := UCS4(Result[InPos]); - Inc(BufferSize); - end - else - SetLength(Buffer, BufferSize); - end; - - if Length(Buffer) = 0 then - Break; - - NbProcessed := UnicodeCompose(Buffer, Composite, Compatible); - if NbProcessed = 0 then - Break; - - if BufferSize > NbProcessed then - Move(Buffer[NbProcessed], Buffer[0], (BufferSize - NbProcessed) * SizeOf(UCS4)); - Dec(BufferSize, NbProcessed); - - Inc(OutPos); - Result[OutPos] := UCS2(Composite); - end; - // since we have likely shortened the source string we have to set the correct length on exit - SetLength(Result, OutPos); -end; - -function WideCompose(const S: WideString; Tags: TCompatibilityFormattingTags): WideString; -var - Buffer: array of UCS4; - LastInPos, InPos, OutPos, BufferSize, NbProcessed: SizeInt; - Composite: UCS4; -begin - // Set an arbitrary length for the result. This is automatically done when checking - // for hangul composition. - Result := WideComposeHangul(S); - - if Result = '' then - Exit; - - if not CompositionsLoaded then - LoadCompositionData; - - LastInPos := Length(Result); - if LastInPos > MaxCompositionSize then - SetLength(Buffer, MaxCompositionSize) - else - SetLength(Buffer, LastInPos); - - BufferSize := 0; - InPos := 0; - OutPos := 0; - - while (InPos < LastInPos) or (BufferSize > 0) do - begin - // fill buffer from input - - while BufferSize < Length(Buffer) do - begin - if InPos < LastInPos then - begin - Inc(InPos); - Buffer[BufferSize] := UCS4(Result[InPos]); - Inc(BufferSize); - end - else - SetLength(Buffer, BufferSize); - end; - - if Length(Buffer) = 0 then - Break; - - NbProcessed := UnicodeCompose(Buffer, Composite, Tags); - if NbProcessed = 0 then - Break; - - if BufferSize > NbProcessed then - Move(Buffer[NbProcessed], Buffer[0], (BufferSize - NbProcessed) * SizeOf(UCS4)); - Dec(BufferSize, NbProcessed); - - Inc(OutPos); - Result[OutPos] := UCS2(Composite); - end; - // since we have likely shortened the source string we have to set the correct length on exit - SetLength(Result, OutPos); -end; - -procedure FixCanonical(var S: WideString); -// Examines S and reorders all combining marks in the string so that they are in canonical order. -var - I: SizeInt; - Temp: WideChar; - CurrentClass, - LastClass: Cardinal; -begin - I := Length(S); - if I > 1 then - begin - CurrentClass := CanonicalCombiningClass(UCS4(S[I])); - repeat - Dec(I); - LastClass := CurrentClass; - CurrentClass := CanonicalCombiningClass(UCS4(S[I])); - - // A swap is presumed to be rare (and a double-swap very rare), - // so don't worry about efficiency here. - if (CurrentClass > LastClass) and (LastClass > 0) then - begin - // swap characters - Temp := S[I]; - S[I] := S[I + 1]; - S[I + 1] := Temp; - - // if not at end, backup (one further, to compensate for loop) - if I < Length(S) - 1 then - Inc(I, 2); - // reset type, since we swapped. - CurrentClass := CanonicalCombiningClass(UCS4(S[I])); - end; - until I = 1; - end; -end; - -function WideDecompose(const S: WideString; Compatible: Boolean): WideString; -// returns a string with all characters of S but decomposed, e.g. is returned as E^ etc. -var - I, J: SizeInt; - Decomp: TUCS4Array; -begin - Result := ''; - Decomp := nil; - - // iterate through each source code point - for I := 1 to Length(S) do - begin - Decomp := UnicodeDecompose(UCS4(S[I]), Compatible); - if Decomp = nil then - Result := Result + S[I] - else - for J := 0 to High(Decomp) do - Result := Result + WideChar(Decomp[J]); - end; - - // combining marks must be sorted according to their canonical combining class - FixCanonical(Result); -end; - -function WideDecompose(const S: WideString; Tags: TCompatibilityFormattingTags): WideString; -// returns a string with all characters of S but decomposed, e.g. is returned as E^ etc. -var - I, J: SizeInt; - Decomp: TUCS4Array; -begin - Result := ''; - Decomp := nil; - - // iterate through each source code point - for I := 1 to Length(S) do - begin - Decomp := UnicodeDecompose(UCS4(S[I]), Tags); - if Decomp = nil then - Result := Result + S[I] - else - for J := 0 to High(Decomp) do - Result := Result + WideChar(Decomp[J]); - end; - - // combining marks must be sorted according to their canonical combining class - FixCanonical(Result); -end; - -function WideNormalize(const S: WideString; Form: TNormalizationForm): WideString; -var - Temp: WideString; - Compatible: Boolean; -begin - Result := S; - - if Form = nfNone then - Exit; // No normalization needed. - - Compatible := Form in [nfKC, nfKD]; - if Form in [nfD, nfKD] then - Result := WideDecompose(S, Compatible) - else - begin - Temp := WideDecompose(S, Compatible); - Result := WideCompose(Temp, Compatible); - end; -end; - -{$ENDIF ~UNICODE_RTL_DATABASE} - -function WideSameText(const Str1, Str2: WideString): Boolean; -// Compares both strings case-insensitively and returns True if both are equal, otherwise False is returned. -begin - Result := Length(Str1) = Length(Str2); - if Result then - Result := StrICompW(PWideChar(Str1), PWideChar(Str2)) = 0; -end; - -//----------------- general purpose case mapping --------------------------------------------------- - -{$IFNDEF UNICODE_RTL_DATABASE} - -function WideCaseConvert(C: WideChar; CaseType: TCaseType): WideString; -var - I, RPos: SizeInt; - Mapping: TUCS4Array; -begin - SetLength(Mapping, 0); - if not CaseLookup(UCS4(C), CaseType, Mapping) then - Result := C - else - begin - SetLength(Result, 2 * Length(Mapping)); - RPos := 1; - for I := Low(Mapping) to High(Mapping) do - UTF16SetNextChar(Result, RPos, Mapping[I]); - if RPos > 0 then - SetLength(Result, RPos - 1) - else - raise EJclUnexpectedEOSequenceError.Create; - end; -end; - -function WideCaseConvert(const S: WideString; CaseType: TCaseType): WideString; -var - SLen, RLen, SPos, RPos, K, MapLen: SizeInt; - Code: UCS4; - Mapping: TUCS4Array; -begin - SetLength(Mapping, 0); - SLen := Length(S); - RLen := SLen; - SetLength(Result, RLen); - SPos := 1; - RPos := 1; - while (SPos > 0) and (SPos <= SLen) do - begin - Code := UTF16GetNextChar(S, SPos); - if SPos = -1 then - raise EJclUnexpectedEOSequenceError.Create; - - if CaseLookup(Code, CaseType, Mapping) then - begin - MapLen:= Length(Mapping); - if MapLen = 1 then - Code := Mapping[0]; - end - else - MapLen := 1; - - if MapLen = 1 then - begin - if not UTF16SetNextChar(Result, RPos, Code) then - begin - Inc(RLen, SLen); - SetLength(Result, RLen); - UTF16SetNextChar(Result, RPos, Code); - end; - end - else - begin - for K := Low(Mapping) to High(Mapping) do - if not UTF16SetNextChar(Result, RPos, Code) then - begin - Inc(RLen, SLen); - SetLength(Result, RLen); - UTF16SetNextChar(Result, RPos, Code); - end; - end; - end; - if RPos > 0 then - SetLength(Result, RPos - 1) - else - raise EJclUnexpectedEOSequenceError.Create; -end; - -// Note that most of the assigned code points don't have a case mapping and are therefore -// returned as they are. Other code points, however, might be converted into several characters -// like the german (eszett) whose upper case mapping is SS. - -function WideCaseFolding(C: WideChar): WideString; -// Special case folding function to map a string to either its lower case or -// to special cases. This can be used for case-insensitive comparation. -begin - Result:= WideCaseConvert(C, ctFold); -end; - -function WideCaseFolding(const S: WideString): WideString; -begin - Result:= WideCaseConvert(S, ctFold); -end; - -{$ENDIF ~UNICODE_RTL_DATABASE} - -function WideLowerCase(C: WideChar): WideString; -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.ToLower(C); - {$ELSE ~UNICODE_RTL_DATABASE} - Result:= WideCaseConvert(C, ctLower); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function WideLowerCase(const S: WideString): WideString; -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.ToLower(S); - {$ELSE ~UNICODE_RTL_DATABASE} - Result:= WideCaseConvert(S, ctLower); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -{$IFNDEF UNICODE_RTL_DATABASE} - -function WideTitleCase(C: WideChar): WideString; -begin - Result:= WideCaseConvert(C, ctTitle); -end; - -function WideTitleCase(const S: WideString): WideString; -begin - Result:= WideCaseConvert(S, ctTitle); -end; - -{$ENDIF ~UNICODE_RTL_DATABASE} - -function WideUpperCase(C: WideChar): WideString; -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.ToUpper(C); - {$ELSE ~UNICODE_RTL_DATABASE} - Result:= WideCaseConvert(C, ctUpper); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function WideUpperCase(const S: WideString): WideString; -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.ToUpper(S); - {$ELSE ~UNICODE_RTL_DATABASE} - Result:= WideCaseConvert(S, ctUpper); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -//----------------- character test routines -------------------------------------------------------- - -function UnicodeIsAlpha(C: UCS4): Boolean; // Is the character alphabetic? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.IsLetter(Chr(C)); - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, ClassLetter); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsDigit(C: UCS4): Boolean; // Is the character a digit? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.IsDigit(Chr(C)); - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccNumberDecimalDigit]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsAlphaNum(C: UCS4): Boolean; // Is the character alphabetic or a number? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.IsLetterOrDigit(Chr(C)); - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, ClassLetter + [ccNumberDecimalDigit]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsNumberOther(C: UCS4): Boolean; -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucOtherNumber; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccNumberOther]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsCased(C: UCS4): Boolean; -// Is the character a "cased" character, i.e. either lower case, title case or upper case -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) in - [TUnicodeCategory.ucLowercaseLetter, TUnicodeCategory.ucTitlecaseLetter, TUnicodeCategory.ucUppercaseLetter]; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccLetterLowercase, ccLetterTitleCase, ccLetterUppercase]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsControl(C: UCS4): Boolean; -// Is the character a control character? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) in - [TUnicodeCategory.ucControl, TUnicodeCategory.ucFormat]; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccOtherControl, ccOtherFormat]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsSpace(C: UCS4): Boolean; -// Is the character a spacing character? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucSpaceSeparator; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, ClassSpace); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsWhiteSpace(C: UCS4): Boolean; -// Is the character a white space character (same as UnicodeIsSpace plus -// tabulator, new line etc.)? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.IsWhiteSpace(Chr(C)); - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, ClassSpace + [ccWhiteSpace, ccSegmentSeparator]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsBlank(C: UCS4): Boolean; -// Is the character a space separator? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucSpaceSeparator; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccSeparatorSpace]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsPunctuation(C: UCS4): Boolean; -// Is the character a punctuation mark? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) in - [TUnicodeCategory.ucConnectPunctuation, TUnicodeCategory.ucDashPunctuation, - TUnicodeCategory.ucClosePunctuation, TUnicodeCategory.ucFinalPunctuation, - TUnicodeCategory.ucInitialPunctuation, TUnicodeCategory.ucOtherPunctuation, - TUnicodeCategory.ucOpenPunctuation]; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, ClassPunctuation); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsGraph(C: UCS4): Boolean; -// Is the character graphical? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) in - [TUnicodeCategory.ucCombiningMark, TUnicodeCategory.ucEnclosingMark, - TUnicodeCategory.ucNonSpacingMark, - TUnicodeCategory.ucDecimalNumber, TUnicodeCategory.ucLetterNumber, - TUnicodeCategory.ucOtherNumber, - TUnicodeCategory.ucLowercaseLetter, TUnicodeCategory.ucModifierLetter, - TUnicodeCategory.ucOtherLetter, TUnicodeCategory.ucTitlecaseLetter, - TUnicodeCategory.ucUppercaseLetter, - TUnicodeCategory.ucConnectPunctuation, TUnicodeCategory.ucDashPunctuation, - TUnicodeCategory.ucClosePunctuation, TUnicodeCategory.ucFinalPunctuation, - TUnicodeCategory.ucInitialPunctuation, TUnicodeCategory.ucOtherPunctuation, - TUnicodeCategory.ucOpenPunctuation, - TUnicodeCategory.ucCurrencySymbol, TUnicodeCategory.ucModifierSymbol, - TUnicodeCategory.ucMathSymbol, TUnicodeCategory.ucOtherSymbol]; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, ClassMark + ClassNumber + ClassLetter + ClassPunctuation + ClassSymbol); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsPrintable(C: UCS4): Boolean; -// Is the character printable? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) in - [TUnicodeCategory.ucCombiningMark, TUnicodeCategory.ucEnclosingMark, - TUnicodeCategory.ucNonSpacingMark, - TUnicodeCategory.ucDecimalNumber, TUnicodeCategory.ucLetterNumber, - TUnicodeCategory.ucOtherNumber, - TUnicodeCategory.ucLowercaseLetter, TUnicodeCategory.ucModifierLetter, - TUnicodeCategory.ucOtherLetter, TUnicodeCategory.ucTitlecaseLetter, - TUnicodeCategory.ucUppercaseLetter, - TUnicodeCategory.ucConnectPunctuation, TUnicodeCategory.ucDashPunctuation, - TUnicodeCategory.ucClosePunctuation, TUnicodeCategory.ucFinalPunctuation, - TUnicodeCategory.ucInitialPunctuation, TUnicodeCategory.ucOtherPunctuation, - TUnicodeCategory.ucOpenPunctuation, - TUnicodeCategory.ucCurrencySymbol, TUnicodeCategory.ucModifierSymbol, - TUnicodeCategory.ucMathSymbol, TUnicodeCategory.ucOtherSymbol, - TUnicodeCategory.ucSpaceSeparator]; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, ClassMark + ClassNumber + ClassLetter + ClassPunctuation + ClassSymbol + - [ccSeparatorSpace]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsUpper(C: UCS4): Boolean; -// Is the character already upper case? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucUppercaseLetter; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccLetterUppercase]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsLower(C: UCS4): Boolean; -// Is the character already lower case? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucLowercaseLetter; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccLetterLowercase]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsTitle(C: UCS4): Boolean; -// Is the character already title case? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucTitlecaseLetter; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccLetterTitlecase]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -{$IFNDEF UNICODE_RTL_DATABASE} -function UnicodeIsHexDigit(C: UCS4): Boolean; -// Is the character a hex digit? -begin - Result := CategoryLookup(C, [ccHexDigit]); -end; -{$ENDIF ~UNICODE_RTL_DATABASE} - -function UnicodeIsIsoControl(C: UCS4): Boolean; -// Is the character a C0 control character (< 32)? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucControl; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccOtherControl]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsFormatControl(C: UCS4): Boolean; -// Is the character a format control character? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucFormat; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccOtherFormat]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsSymbol(C: UCS4): Boolean; -// Is the character a symbol? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) in - [TUnicodeCategory.ucCurrencySymbol, TUnicodeCategory.ucModifierSymbol, - TUnicodeCategory.ucMathSymbol, TUnicodeCategory.ucOtherSymbol]; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, ClassSymbol); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsNumber(C: UCS4): Boolean; -// Is the character a number or digit? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) in - [TUnicodeCategory.ucDecimalNumber, TUnicodeCategory.ucLetterNumber, - TUnicodeCategory.ucOtherNumber]; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, ClassNumber); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsNonSpacing(C: UCS4): Boolean; -// Is the character non-spacing? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucNonSpacingMark; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccMarkNonSpacing]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsOpenPunctuation(C: UCS4): Boolean; -// Is the character an open/left punctuation (e.g. '[')? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucOpenPunctuation; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccPunctuationOpen]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsClosePunctuation(C: UCS4): Boolean; -// Is the character an close/right punctuation (e.g. ']')? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucClosePunctuation; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccPunctuationClose]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsInitialPunctuation(C: UCS4): Boolean; -// Is the character an initial punctuation (e.g. U+2018 LEFT SINGLE QUOTATION MARK)? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucInitialPunctuation; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccPunctuationInitialQuote]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsFinalPunctuation(C: UCS4): Boolean; -// Is the character a final punctuation (e.g. U+2019 RIGHT SINGLE QUOTATION MARK)? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucFinalPunctuation; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccPunctuationFinalQuote]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -{$IFNDEF UNICODE_RTL_DATABASE} -function UnicodeIsComposed(C: UCS4): Boolean; -// Can the character be decomposed into a set of other characters? -begin - Result := CategoryLookup(C, [ccComposed]); -end; - -function UnicodeIsQuotationMark(C: UCS4): Boolean; -// Is the character one of the many quotation marks? -begin - Result := CategoryLookup(C, [ccQuotationMark]); -end; - -function UnicodeIsSymmetric(C: UCS4): Boolean; -// Is the character one that has an opposite form (i.e. <>)? -begin - Result := CategoryLookup(C, [ccSymmetric]); -end; - -function UnicodeIsMirroring(C: UCS4): Boolean; -// Is the character mirroring (superset of symmetric)? -begin - Result := CategoryLookup(C, [ccMirroring]); -end; - -function UnicodeIsNonBreaking(C: UCS4): Boolean; -// Is the character non-breaking (i.e. non-breaking space)? -begin - Result := CategoryLookup(C, [ccNonBreaking]); -end; - -function UnicodeIsRightToLeft(C: UCS4): Boolean; -// Does the character have strong right-to-left directionality (i.e. Arabic letters)? -begin - Result := CategoryLookup(C, [ccRightToLeft]); -end; - -function UnicodeIsLeftToRight(C: UCS4): Boolean; -// Does the character have strong left-to-right directionality (i.e. Latin letters)? -begin - Result := CategoryLookup(C, [ccLeftToRight]); -end; - -function UnicodeIsStrong(C: UCS4): Boolean; -// Does the character have strong directionality? -begin - Result := CategoryLookup(C, [ccLeftToRight, ccRightToLeft]); -end; - -function UnicodeIsWeak(C: UCS4): Boolean; -// Does the character have weak directionality (i.e. numbers)? -begin - Result := CategoryLookup(C, ClassEuropeanNumber + [ccArabicNumber, ccCommonNumberSeparator]); -end; - -function UnicodeIsNeutral(C: UCS4): Boolean; -// Does the character have neutral directionality (i.e. whitespace)? -begin - Result := CategoryLookup(C, [ccSeparatorParagraph, ccSegmentSeparator, ccWhiteSpace, ccOtherNeutrals]); -end; - -function UnicodeIsSeparator(C: UCS4): Boolean; -// Is the character a block or segment separator? -begin - Result := CategoryLookup(C, [ccSeparatorParagraph, ccSegmentSeparator]); -end; - -function UnicodeIsMark(C: UCS4): Boolean; -// Is the character a mark of some kind? -begin - Result := CategoryLookup(C, ClassMark); -end; - -function UnicodeIsModifier(C: UCS4): Boolean; -// Is the character a letter modifier? -begin - Result := CategoryLookup(C, [ccLetterModifier]); -end; -{$ENDIF ~UNICODE_RTL_DATABASE} - -function UnicodeIsLetterNumber(C: UCS4): Boolean; -// Is the character a number represented by a letter? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucLetterNumber; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccNumberLetter]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsConnectionPunctuation(C: UCS4): Boolean; -// Is the character connecting punctuation? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucConnectPunctuation; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccPunctuationConnector]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsDash(C: UCS4): Boolean; -// Is the character a dash punctuation? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucDashPunctuation; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccPunctuationDash]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsMath(C: UCS4): Boolean; -// Is the character a math character? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucMathSymbol; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccSymbolMath]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsCurrency(C: UCS4): Boolean; -// Is the character a currency character? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucCurrencySymbol; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccSymbolCurrency]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsModifierSymbol(C: UCS4): Boolean; -// Is the character a modifier symbol? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucModifierSymbol; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccSymbolModifier]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsSpacingMark(C: UCS4): Boolean; -// Is the character a spacing mark? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) in - [TUnicodeCategory.ucLineSeparator, TUnicodeCategory.ucParagraphSeparator, - TUnicodeCategory.ucSpaceSeparator]; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccMarkSpacingCombining]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsEnclosing(C: UCS4): Boolean; -// Is the character enclosing (i.e. enclosing box)? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucEnclosingMark; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccMarkEnclosing]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsPrivate(C: UCS4): Boolean; -// Is the character from the Private Use Area? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucPrivateUse; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccOtherPrivate]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsSurrogate(C: UCS4): Boolean; -// Is the character one of the surrogate codes? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucSurrogate; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccOtherSurrogate]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsLineSeparator(C: UCS4): Boolean; -// Is the character a line separator? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucLineSeparator; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccSeparatorLine]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsParagraphSeparator(C: UCS4): Boolean; -// Is th character a paragraph separator; -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucParagraphSeparator; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccSeparatorParagraph]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsIdentifierStart(C: UCS4): Boolean; -// Can the character begin an identifier? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) in - [TUnicodeCategory.ucLowercaseLetter, TUnicodeCategory.ucModifierLetter, - TUnicodeCategory.ucOtherLetter, TUnicodeCategory.ucTitlecaseLetter, - TUnicodeCategory.ucUppercaseLetter, - TUnicodeCategory.ucLetterNumber]; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, ClassLetter + [ccNumberLetter]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsIdentifierPart(C: UCS4): Boolean; -// Can the character appear in an identifier? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) in - [TUnicodeCategory.ucLowercaseLetter, TUnicodeCategory.ucModifierLetter, - TUnicodeCategory.ucOtherLetter, TUnicodeCategory.ucTitlecaseLetter, - TUnicodeCategory.ucUppercaseLetter, - TUnicodeCategory.ucLetterNumber, TUnicodeCategory.ucDecimalNumber, - TUnicodeCategory.ucNonSpacingMark, TUnicodeCategory.ucCombiningMark, - TUnicodeCategory.ucConnectPunctuation, - TUnicodeCategory.ucFormat]; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, ClassLetter + [ccNumberLetter, ccMarkNonSpacing, ccMarkSpacingCombining, - ccNumberDecimalDigit, ccPunctuationConnector, ccOtherFormat]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsDefined(C: UCS4): Boolean; -// Is the character defined (appears in one of the data files)? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) <> TUnicodeCategory.ucUnassigned; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccAssigned]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsUndefined(C: UCS4): Boolean; -// Is the character undefined (not assigned in the Unicode database)? -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucUnassigned; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := not CategoryLookup(C, [ccAssigned]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsHan(C: UCS4): Boolean; -// Is the character a Han ideograph? -begin - Result := ((C >= $4E00) and (C <= $9FFF)) or ((C >= $F900) and (C <= $FAFF)); -end; - -function UnicodeIsHangul(C: UCS4): Boolean; -// Is the character a pre-composed Hangul syllable? -begin - Result := (C >= $AC00) and (C <= $D7FF); -end; - -function UnicodeIsUnassigned(C: UCS4): Boolean; -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucUnassigned; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccOtherUnassigned]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsLetterOther(C: UCS4): Boolean; -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucOtherLetter; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccLetterOther]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsConnector(C: UCS4): Boolean; -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucConnectPunctuation; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccPunctuationConnector]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsPunctuationOther(C: UCS4): Boolean; -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucOtherPunctuation; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccPunctuationOther]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -function UnicodeIsSymbolOther(C: UCS4): Boolean; -begin - {$IFDEF UNICODE_RTL_DATABASE} - Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucOtherSymbol; - {$ELSE ~UNICODE_RTL_DATABASE} - Result := CategoryLookup(C, [ccSymbolOther]); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -{$IFNDEF UNICODE_RTL_DATABASE} -function UnicodeIsLeftToRightEmbedding(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccLeftToRightEmbedding]); -end; - -function UnicodeIsLeftToRightOverride(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccLeftToRightOverride]); -end; - -function UnicodeIsRightToLeftArabic(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccRightToLeftArabic]); -end; - -function UnicodeIsRightToLeftEmbedding(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccRightToLeftEmbedding]); -end; - -function UnicodeIsRightToLeftOverride(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccRightToLeftOverride]); -end; - -function UnicodeIsPopDirectionalFormat(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccPopDirectionalFormat]); -end; - -function UnicodeIsEuropeanNumber(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccEuropeanNumber]); -end; - -function UnicodeIsEuropeanNumberSeparator(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccEuropeanNumberSeparator]); -end; - -function UnicodeIsEuropeanNumberTerminator(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccEuropeanNumberTerminator]); -end; - -function UnicodeIsArabicNumber(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccArabicNumber]); -end; - -function UnicodeIsCommonNumberSeparator(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccCommonNumberSeparator]); -end; - -function UnicodeIsBoundaryNeutral(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccBoundaryNeutral]); -end; - -function UnicodeIsSegmentSeparator(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccSegmentSeparator]); -end; - -function UnicodeIsOtherNeutrals(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccOtherNeutrals]); -end; - -function UnicodeIsASCIIHexDigit(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccASCIIHexDigit]); -end; - -function UnicodeIsBidiControl(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccBidiControl]); -end; - -function UnicodeIsDeprecated(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccDeprecated]); -end; - -function UnicodeIsDiacritic(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccDiacritic]); -end; - -function UnicodeIsExtender(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccExtender]); -end; - -function UnicodeIsHyphen(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccHyphen]); -end; - -function UnicodeIsIdeographic(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccIdeographic]); -end; - -function UnicodeIsIDSBinaryOperator(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccIDSBinaryOperator]); -end; - -function UnicodeIsIDSTrinaryOperator(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccIDSTrinaryOperator]); -end; - -function UnicodeIsJoinControl(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccJoinControl]); -end; - -function UnicodeIsLogicalOrderException(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccLogicalOrderException]); -end; - -function UnicodeIsNonCharacterCodePoint(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccNonCharacterCodePoint]); -end; - -function UnicodeIsOtherAlphabetic(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccOtherAlphabetic]); -end; - -function UnicodeIsOtherDefaultIgnorableCodePoint(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccOtherDefaultIgnorableCodePoint]); -end; - -function UnicodeIsOtherGraphemeExtend(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccOtherGraphemeExtend]); -end; - -function UnicodeIsOtherIDContinue(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccOtherIDContinue]); -end; - -function UnicodeIsOtherIDStart(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccOtherIDStart]); -end; - -function UnicodeIsOtherLowercase(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccOtherLowercase]); -end; - -function UnicodeIsOtherMath(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccOtherMath]); -end; - -function UnicodeIsOtherUppercase(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccOtherUppercase]); -end; - -function UnicodeIsPatternSyntax(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccPatternSyntax]); -end; - -function UnicodeIsPatternWhiteSpace(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccPatternWhiteSpace]); -end; - -function UnicodeIsRadical(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccRadical]); -end; - -function UnicodeIsSoftDotted(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccSoftDotted]); -end; - -function UnicodeIsSTerm(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccSTerm]); -end; - -function UnicodeIsTerminalPunctuation(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccTerminalPunctuation]); -end; - -function UnicodeIsUnifiedIdeograph(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccUnifiedIdeograph]); -end; - -function UnicodeIsVariationSelector(C: UCS4): Boolean; -begin - Result := CategoryLookup(C, [ccVariationSelector]); -end; -{$ENDIF ~UNICODE_RTL_DATABASE} - -// I need to fix a problem (introduced by MS) here. The first parameter can be a pointer -// (and is so defined) or can be a normal DWORD, depending on the dwFlags parameter. -// As usual, lpSrc has been translated to a var parameter. But this does not work in -// our case, hence the redeclaration of the function with a pointer as first parameter. - -function TranslateCharsetInfoEx(lpSrc: SizeInt; out lpCs: TCharsetInfo; dwFlags: DWORD): BOOL; stdcall; - external 'gdi32.dll' name 'TranslateCharsetInfo'; - -function GetCharSetFromLocale(Language: LCID; out FontCharSet: Byte): Boolean; -const - TCI_SRCLOCALE = $1000; -var - CP: Word; - CSI: TCharsetInfo; -begin - if not JclCheckWinVersion(5, 0) then // Win2k required - begin - // these versions of Windows don't support TCI_SRCLOCALE - CP := CodePageFromLocale(Language); - if CP = 0 then - RaiseLastOSError; - Result := TranslateCharsetInfoEx(CP, CSI, TCI_SRCCODEPAGE); - end - else - Result := TranslateCharsetInfoEx(Language, CSI, TCI_SRCLOCALE); - - if Result then - FontCharset := CSI.ciCharset; -end; - -function CharSetFromLocale(Language: LCID): Byte; -begin - if not GetCharSetFromLocale(Language, Result) then - RaiseLastOSError; -end; - -function CodePageFromLocale(Language: LCID): Word; -// determines the code page for a given locale -var - Buf: array [0..6] of Char; -begin - GetLocaleInfo(Language, LOCALE_IDefaultAnsiCodePage, Buf, 6); - Result := StrToIntDef(Buf, GetACP); -end; - -function KeyboardCodePage: Word; -begin - Result := CodePageFromLocale(GetKeyboardLayout(0) and $FFFF); -end; - -function KeyUnicode(C: Char): WideChar; -// converts the given character (as it comes with a WM_CHAR message) into its -// corresponding Unicode character depending on the active keyboard layout -begin - MultiByteToWideChar(KeyboardCodePage, MB_USEGLYPHCHARS, @C, 1, @Result, 1); -end; - -function CodeBlockRange(const CB: TUnicodeBlock): TUnicodeBlockRange; -// http://www.unicode.org/Public/5.0.0/ucd/Blocks.txt -begin - Result := UnicodeBlockData[CB].Range; -end; - - -// Names taken from http://www.unicode.org/Public/5.0.0/ucd/Blocks.txt -function CodeBlockName(const CB: TUnicodeBlock): string; -begin - Result := UnicodeBlockData[CB].Name; -end; - -// Returns an ID for the Unicode code block to which C belongs. -// If C does not belong to any of the defined blocks then ubUndefined is returned. -// Note: the code blocks listed here are based on Unicode Version 5.0.0 -function CodeBlockFromChar(const C: UCS4): TUnicodeBlock; -// http://www.unicode.org/Public/5.0.0/ucd/Blocks.txt -var - L, H, I: TUnicodeBlock; -begin - Result := ubUndefined; - L := ubBasicLatin; - H := High(TUnicodeBlock); - while L <= H do - begin - I := TUnicodeBlock((Cardinal(L) + Cardinal(H)) shr 1); - if (C >= UnicodeBlockData[I].Range.RangeStart) and (C <= UnicodeBlockData[I].Range.RangeEnd) then - begin - Result := I; - Break; - end - else - if C < UnicodeBlockData[I].Range.RangeStart then - begin - Dec(I); - H := I; - end - else - begin - Inc(I); - L := I; - end; - end; -end; - - -function CompareTextWin95(const W1, W2: WideString; Locale: LCID): SizeInt; -// special comparation function for Win9x since there's no system defined -// comparation function, returns -1 if W1 < W2, 0 if W1 = W2 or 1 if W1 > W2 -var - S1, S2: AnsiString; - CP: Word; - L1, L2: SizeInt; -begin - L1 := Length(W1); - L2 := Length(W2); - SetLength(S1, L1); - SetLength(S2, L2); - CP := CodePageFromLocale(Locale); - WideCharToMultiByte(CP, 0, PWideChar(W1), L1, PAnsiChar(S1), L1, nil, nil); - WideCharToMultiByte(CP, 0, PWideChar(W2), L2, PAnsiChar(S2), L2, nil, nil); - Result := CompareStringA(Locale, NORM_IGNORECASE, PAnsiChar(S1), Length(S1), - PAnsiChar(S2), Length(S2)) - 2; -end; - -function CompareTextWinNT(const W1, W2: WideString; Locale: LCID): SizeInt; -// Wrapper function for WinNT since there's no system defined comparation function -// in Win9x and we need a central comparation function for TWideStringList. -// Returns -1 if W1 < W2, 0 if W1 = W2 or 1 if W1 > W2 -begin - Result := CompareStringW(Locale, NORM_IGNORECASE, PWideChar(W1), Length(W1), - PWideChar(W2), Length(W2)) - 2; -end; - -function StringToWideStringEx(const S: AnsiString; CodePage: Word): WideString; -var - InputLength, - OutputLength: SizeInt; -begin - InputLength := Length(S); - OutputLength := MultiByteToWideChar(CodePage, 0, PAnsiChar(S), InputLength, nil, 0); - SetLength(Result, OutputLength); - MultiByteToWideChar(CodePage, 0, PAnsiChar(S), InputLength, PWideChar(Result), OutputLength); -end; - -function WideStringToStringEx(const WS: WideString; CodePage: Word): AnsiString; -var - InputLength, - OutputLength: SizeInt; -begin - InputLength := Length(WS); - OutputLength := WideCharToMultiByte(CodePage, 0, PWideChar(WS), InputLength, nil, 0, nil, nil); - SetLength(Result, OutputLength); - WideCharToMultiByte(CodePage, 0, PWideChar(WS), InputLength, PAnsiChar(Result), OutputLength, nil, nil); -end; - -function TranslateString(const S: AnsiString; CP1, CP2: Word): AnsiString; -begin - Result:= WideStringToStringEx(StringToWideStringEx(S, CP1), CP2); -end; - -function UCS4Array(Ch: UCS4): TUCS4Array; -begin - SetLength(Result, 1); - Result[0] := Ch; -end; - -function UCS4ArrayConcat(Left, Right: UCS4): TUCS4Array; -begin - SetLength(Result, 2); - Result[0] := Left; - Result[1] := Right; -end; - -procedure UCS4ArrayConcat(var Left: TUCS4Array; Right: UCS4); -var - I: SizeInt; -begin - I := Length(Left); - SetLength(Left, I + 1); - Left[I] := Right; -end; - -procedure UCS4ArrayConcat(var Left: TUCS4Array; const Right: TUCS4Array); -var - I, J: SizeInt; -begin - I := Length(Left); - J := Length(Right); - SetLength(Left, I + J); - Move(Right[0], Left[I], J * SizeOf(Right[0])); -end; - -function UCS4ArrayEquals(const Left: TUCS4Array; const Right: TUCS4Array): Boolean; -var - I: SizeInt; -begin - I := Length(Left); - Result := I = Length(Right); - while Result do - begin - Dec(I); - Result := (I >= 0) and (Left[I] = Right[I]); - end; - Result := I < 0; -end; - -function UCS4ArrayEquals(const Left: TUCS4Array; Right: UCS4): Boolean; -begin - Result := (Length(Left) = 1) and (Left[0] = Right); -end; - -function UCS4ArrayEquals(const Left: TUCS4Array; const Right: AnsiString): Boolean; -var - I: SizeInt; -begin - I := Length(Left); - Result := I = Length(Right); - while Result do - begin - Dec(I); - Result := (I >= 0) and (Left[I] = Ord(Right[I + 1])); - end; - Result := I < 0; -end; - -function UCS4ArrayEquals(const Left: TUCS4Array; Right: AnsiChar): Boolean; -begin - Result := (Length(Left) = 1) and (Left[0] = Ord(Right)); -end; - -procedure PrepareUnicodeData; -// Prepares structures which are globally needed. -begin - {$IFNDEF UNICODE_RTL_DATABASE} - LoadInProgress := TJclCriticalSection.Create; - {$ENDIF ~UNICODE_RTL_DATABASE} - - if (Win32Platform and VER_PLATFORM_WIN32_NT) <> 0 then - @WideCompareText := @CompareTextWinNT - else - @WideCompareText := @CompareTextWin95; -end; - -procedure FreeUnicodeData; -// Frees all data which has been allocated and which is not automatically freed by Delphi. -begin - {$IFNDEF UNICODE_RTL_DATABASE} - FreeAndNil(LoadInProgress); - {$ENDIF ~UNICODE_RTL_DATABASE} -end; - -initialization - PrepareUnicodeData; - {$IFDEF UNITVERSIONING} - RegisterUnitVersion(HInstance, UnitVersioning); - {$ENDIF UNITVERSIONING} - -finalization - {$IFDEF UNITVERSIONING} - UnregisterUnitVersion(HInstance); - {$ENDIF UNITVERSIONING} - FreeUnicodeData; - -end. +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclUnicode.pas. } +{ } +{ The Initial Developer of the Original Code is Mike Lischke (public att lischke-online dott de). } +{ Portions created by Mike Lischke are Copyright (C) 1999-2000 Mike Lischke. All Rights Reserved. } +{ } +{ Contributor(s): } +{ Marcel van Brakel } +{ Andreas Hausladen (ahuser) } +{ Mike Lischke } +{ Flier Lu (flier) } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Olivier Sannier (obones) } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ Peter Schraut (http://www.console-dev.de) } +{ Florent Ouchet (outchy) } +{ glchapman } +{ Markus Humm (mhumm) } +{ } +{**************************************************************************************************} +{ } +{ Various Unicode related routines } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclUnicode; + +{$I jcl.inc} + +// Copyright (c) 1999-2000 Mike Lischke (public att lischke-online dott de) +// + +// 10-JUL-2005: (changes by Peter Schraut) +// - added CodeBlockName, returns the blockname as string +// - added CodeBlockRange, returns the range of the specified codeblock +// - updated TUnicodeBlock to reflect changes in unicode 4.1 +// - updated CodeBlockFromChar to reflect changes in unicode 4.1 +// - Notes: +// Here are a few suggestions to reflect latest namechanges in unicode 4.1, +// but they were not done due to compatibility with old code: +// ubGreek should be renamed to ubGreekandCoptic +// ubCombiningMarksforSymbols should be renamed to ubCombiningDiacriticalMarksforSymbols +// ubPrivateUse should be renamed to ubPrivateUseArea +// +// +// 19-SEP-2003: (changes by Andreas Hausladen) +// - added OWN_WIDESTRING_MEMMGR for faster memory managment in TWideStringList +// under Windows +// - fixed: TWideStringList.Destroy does not set OnChange and OnChanging to nil before calling Clear +// +// +// 29-MAR-2002: MT +// - WideNormalize now returns strings with normalization mode nfNone unchanged. +// - Bug fix in WideCompose: Raised exception when Result of WideComposeHangul was an +// empty string. (#0000044) +// - Bug fix in WideAdjustLineBreaks +// - Added Asserts were needed. +// - TWideStrings.IndexOfName now takes care of NormalizeForm as well. +// - TWideStrings.IndexOf now takes care of NormalizeForm as well. +// - TWideString.List Find now uses the same NormalizationForm for the search string as it uses +// within the list itself. +// +// 29-NOV-2001: +// - bug fix +// 06-JUN-2001: +// - small changes +// 28-APR-2001: +// - bug fixes +// 05-APR-2001: +// - bug fixes +// 23-MAR-2001: +// - WideSameText +// - small changes +// 10-FEB-2001: +// - bug fix in StringToWideStringEx and WideStringToStringEx +// 05-FEB-2001: +// - TWideStrings.GetSeparatedText changed (no separator anymore after the last line) +// 29-JAN-2001: +// - PrepareUnicodeData +// - LoadInProgress critical section is now created at init time to avoid critical thread races +// - bug fixes +// 26-JAN-2001: +// - ExpandANSIString +// - TWideStrings.SaveUnicode is by default True now +// 20..21-JAN-2001: +// - StrUpperW, StrLowerW and StrTitleW removed because they potentially would need +// a reallocation to work correctly (use the WideString versions instead) +// - further improvements related to internal data +// - introduced TUnicodeBlock +// - CodeBlockFromChar improved +// 07-JAN-2001: +// optimized access to character properties, combining class etc. +// 06-JAN-2001: +// TWideStrings and TWideStringList improved +// APR-DEC 2000: versions 2.1 - 2.6 +// - preparation for public rlease +// - additional conversion routines +// - JCL compliance +// - character properties unified +// - character properties data and lookup improvements +// - reworked Unicode data resource file +// - improved simple string comparation routines (StrCompW, StrLCompW etc., include surrogate fix) +// - special case folding data for language neutral case insensitive comparations included +// - optimized decomposition +// - composition and normalization support +// - normalization conformance tests applied +// - bug fixes +// FEB-MAR 2000: version 2.0 +// - Unicode regular expressions (URE) search class (TURESearch) +// - generic search engine base class for both the Boyer-Moore and the RE search class +// - whole word only search in UTBM, bug fixes in UTBM +// - string decomposition (including hangul) +// OCT/99 - JAN/2000: version 1.0 +// - basic Unicode implementation, more than 100 WideString/UCS2 and UCS4 core functions +// - TWideStrings and TWideStringList classes +// - Unicode Tuned Boyer-Moore search class (TUTBMSearch) +// - low and high level Unicode/Wide* functions +// - low level Unicode UCS4 data import and functions +// - helper functions +// +// Version 2.9 +// This unit contains routines and classes to manage and work with Unicode/WideString strings. +// You need Delphi 4 or higher to compile this code. +// +// Publicly available low level functions are all preceded by "Unicode..." (e.g. +// in UnicodeToUpper) while the high level functions use the Str... or Wide... +// naming scheme (e.g. StrLICompW and WideUpperCase). +// +// The normalization implementation in this unit has successfully and completely passed the +// official normative conformance testing as of Annex 9 in Technical Report #15 +// (Unicode Standard Annex #15, http://www.unicode.org/unicode/reports/tr15, from 2000-08-31). +// +// Open issues: +// - Yet to do things in the URE class are: +// - check all character classes if they match correctly +// - optimize rebuild of DFA (build only when pattern changes) +// - set flag parameter of ExecuteURE +// - add \d any decimal digit +// \D any character that is not a decimal digit +// \s any whitespace character +// \S any character that is not a whitespace character +// \w any "word" character +// \W any "non-word" character +// - The wide string classes still compare text with functions provided by the +// particular system. This works usually fine under WinNT/W2K (although also +// there are limitations like maximum text lengths). Under Win9x conversions +// from and to MBCS are necessary which are bound to a particular locale and +// so very limited in general use. These comparisons should be changed so that +// the code in this unit is used. + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Winapi.Windows, + {$ENDIF MSWINDOWS} + System.SysUtils, System.Classes, + {$IFDEF HAS_UNIT_CHARACTER} + System.Character, + {$ENDIF HAS_UNIT_CHARACTER} + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + SysUtils, Classes, + {$IFDEF HAS_UNIT_CHARACTER} + Character, + {$ENDIF HAS_UNIT_CHARACTER} + {$ENDIF ~HAS_UNITSCOPE} + JclBase; + +{$IFNDEF FPC} + {$IFDEF MSWINDOWS} + {$DEFINE OWN_WIDESTRING_MEMMGR} + {$ENDIF MSWINDOWS} +{$ENDIF ~FPC} + +const + // definitions of often used characters: + // Note: Use them only for tests of a certain character not to determine character + // classes (like white spaces) as in Unicode are often many code points defined + // being in a certain class. Hence your best option is to use the various + // UnicodeIs* functions. + WideNull = WideChar(#0); + WideTabulator = WideChar(#9); + WideSpace = WideChar(#32); + + // logical line breaks + WideLF = WideChar(#10); + WideLineFeed = WideChar(#10); + WideVerticalTab = WideChar(#11); + WideFormFeed = WideChar(#12); + WideCR = WideChar(#13); + WideCarriageReturn = WideChar(#13); + WideCRLF = WideString(#13#10); + WideLineSeparator = WideChar($2028); + WideParagraphSeparator = WideChar($2029); + + // byte order marks for Unicode files + // Unicode text files (in UTF-16 format) should contain $FFFE as first character to + // identify such a file clearly. Depending on the system where the file was created + // on this appears either in big endian or little endian style. + BOM_LSB_FIRST = WideChar($FEFF); + BOM_MSB_FIRST = WideChar($FFFE); + +type + TSaveFormat = ( sfUTF16LSB, sfUTF16MSB, sfUTF8, sfAnsi ); + +const + sfUnicodeLSB = sfUTF16LSB; + sfUnicodeMSB = sfUTF16MSB; + +type + // various predefined or otherwise useful character property categories + TCharacterCategory = ( + // normative categories + ccLetterUppercase, + ccLetterLowercase, + ccLetterTitlecase, + ccMarkNonSpacing, + ccMarkSpacingCombining, + ccMarkEnclosing, + ccNumberDecimalDigit, + ccNumberLetter, + ccNumberOther, + ccSeparatorSpace, + ccSeparatorLine, + ccSeparatorParagraph, + ccOtherControl, + ccOtherFormat, + ccOtherSurrogate, + ccOtherPrivate, + ccOtherUnassigned, + // informative categories + ccLetterModifier, + ccLetterOther, + ccPunctuationConnector, + ccPunctuationDash, + ccPunctuationOpen, + ccPunctuationClose, + ccPunctuationInitialQuote, + ccPunctuationFinalQuote, + ccPunctuationOther, + ccSymbolMath, + ccSymbolCurrency, + ccSymbolModifier, + ccSymbolOther, + // bidirectional categories + ccLeftToRight, + ccLeftToRightEmbedding, + ccLeftToRightOverride, + ccRightToLeft, + ccRightToLeftArabic, + ccRightToLeftEmbedding, + ccRightToLeftOverride, + ccPopDirectionalFormat, + ccEuropeanNumber, + ccEuropeanNumberSeparator, + ccEuropeanNumberTerminator, + ccArabicNumber, + ccCommonNumberSeparator, + ccBoundaryNeutral, + ccSegmentSeparator, // this includes tab and vertical tab + ccWhiteSpace, // Separator characters and control characters which should be treated by programming languages as "white space" for the purpose of parsing elements. + ccOtherNeutrals, + ccLeftToRightIsolate, + ccRightToLeftIsolate, + ccFirstStrongIsolate, + ccPopDirectionalIsolate, + // self defined categories, they do not appear in the Unicode data file + ccComposed, // can be decomposed + ccNonBreaking, + ccSymmetric, // has left and right forms + ccHexDigit, // Characters commonly used for the representation of hexadecimal numbers, plus their compatibility equivalents. + ccQuotationMark, // Punctuation characters that function as quotation marks. + ccMirroring, + ccAssigned, // means there is a definition in the Unicode standard + ccASCIIHexDigit, // ASCII characters commonly used for the representation of hexadecimal numbers + ccBidiControl, // Format control characters which have specific functions in the Unicode Bidirectional Algorithm [UAX9]. + ccDash, // Punctuation characters explicitly called out as dashes in the Unicode Standard, plus their compatibility equivalents. Most of these have the General_Category value Pd, but some have the General_Category value Sm because of their use in mathematics. + ccDeprecated, // For a machine-readable list of deprecated characters. No characters will ever be removed from the standard, but the usage of deprecated characters is strongly discouraged. + ccDiacritic, // Characters that linguistically modify the meaning of another character to which they apply. Some diacritics are not combining characters, and some combining characters are not diacritics. + ccExtender, // Characters whose principal function is to extend the value or shape of a preceding alphabetic character. Typical of these are length and iteration marks. + ccHyphen, // Dashes which are used to mark connections between pieces of words, plus the Katakana middle dot. The Katakana middle dot functions like a hyphen, but is shaped like a dot rather than a dash. + ccIdeographic, // Characters considered to be CJKV (Chinese, Japanese, Korean, and Vietnamese) ideographs. + ccIDSBinaryOperator, // Used in Ideographic Description Sequences. + ccIDSTrinaryOperator, // Used in Ideographic Description Sequences. + ccJoinControl, // Format control characters which have specific functions for control of cursive joining and ligation. + ccLogicalOrderException, // There are a small number of characters that do not use logical order. These characters require special handling in most processing. + ccNonCharacterCodePoint, // Code points permanently reserved for internal use. + ccOtherAlphabetic, // Used in deriving the Alphabetic property. + ccOtherDefaultIgnorableCodePoint, // Used in deriving the Default_Ignorable_Code_Point property. + ccOtherGraphemeExtend, // Used in deriving the Grapheme_Extend property. + ccOtherIDContinue, // Used for backward compatibility of ID_Continue. + ccOtherIDStart, // Used for backward compatibility of ID_Start. + ccOtherLowercase, // Used in deriving the Lowercase property. + ccOtherMath, // Used in deriving the Math property. + ccOtherUppercase, // Used in deriving the Uppercase property. + ccPatternSyntax, // Used for pattern syntax as described in UAX #31: Unicode Identifier and Pattern Syntax [UAX31]. + ccPatternWhiteSpace, + ccRadical, // Used in Ideographic Description Sequences. + ccSoftDotted, // Characters with a "soft dot", like i or j. An accent placed on these characters causes the dot to disappear. An explicit dot above can be added where required, such as in Lithuanian. + ccSTerm, // Sentence Terminal. Used in UAX #29: Unicode Text Segmentation [UAX29]. + ccTerminalPunctuation, // Punctuation characters that generally mark the end of textual units. + ccUnifiedIdeograph, // Used in Ideographic Description Sequences. + ccVariationSelector, // Indicates characters that are Variation Selectors. For details on the behavior of these characters, see StandardizedVariants.html, Section 16.4, "Variation Selectors" in [Unicode], and the Unicode Ideographic Variation Database [UTS37]. + ccSentenceTerminal, // Characters used at the end of a sentence + ccPrependedQuotationMark, + ccRegionalIndicator + ); + TCharacterCategories = set of TCharacterCategory; + +{$IFDEF HAS_UNIT_CHARACTER} +type + TCharacterUnicodeCategory = ccLetterUppercase..ccSymbolOther; + +const + CharacterCategoryToUnicodeCategory: array [TCharacterUnicodeCategory] of TUnicodeCategory = + ( TUnicodeCategory.ucUppercaseLetter, // ccLetterUppercase + TUnicodeCategory.ucLowercaseLetter, // ccLetterLowercase + TUnicodeCategory.ucTitlecaseLetter, // ccLetterTitlecase + TUnicodeCategory.ucNonSpacingMark, // ccMarkNonSpacing + TUnicodeCategory.ucCombiningMark, // ccMarkSpacingCombining + TUnicodeCategory.ucEnclosingMark, // ccMarkEnclosing + TUnicodeCategory.ucDecimalNumber, // ccNumberDecimalDigit + TUnicodeCategory.ucLetterNumber, // ccNumberLetter + TUnicodeCategory.ucOtherNumber, // ccNumberOther + TUnicodeCategory.ucSpaceSeparator, // ccSeparatorSpace + TUnicodeCategory.ucLineSeparator, // ccSeparatorLine + TUnicodeCategory.ucParagraphSeparator, // ccSeparatorParagraph + TUnicodeCategory.ucControl, // ccOtherControl + TUnicodeCategory.ucFormat, // ccOtherFormat + TUnicodeCategory.ucSurrogate, // ccOtherSurrogate + TUnicodeCategory.ucPrivateUse, // ccOtherPrivate + TUnicodeCategory.ucUnassigned, // ccOtherUnassigned + TUnicodeCategory.ucModifierLetter, // ccLetterModifier + TUnicodeCategory.ucOtherLetter, // ccLetterOther + TUnicodeCategory.ucConnectPunctuation, // ccPunctuationConnector + TUnicodeCategory.ucDashPunctuation, // ccPunctuationDash + TUnicodeCategory.ucOpenPunctuation, // ccPunctuationOpen + TUnicodeCategory.ucClosePunctuation, // ccPunctuationClose + TUnicodeCategory.ucInitialPunctuation, // ccPunctuationInitialQuote + TUnicodeCategory.ucFinalPunctuation, // ccPunctuationFinalQuote + TUnicodeCategory.ucOtherPunctuation, // ccPunctuationOther + TUnicodeCategory.ucMathSymbol, // ccSymbolMath + TUnicodeCategory.ucCurrencySymbol, // ccSymbolCurrency + TUnicodeCategory.ucModifierSymbol, // ccSymbolModifier + TUnicodeCategory.ucOtherSymbol ); // ccSymbolOther + + UnicodeCategoryToCharacterCategory: array [TUnicodeCategory] of TCharacterCategory = + ( ccOtherControl, // ucControl + ccOtherFormat, // ucFormat + ccOtherUnassigned, // ucUnassigned + ccOtherPrivate, // ucPrivateUse + ccOtherSurrogate, // ucSurrogate + ccLetterLowercase, // ucLowercaseLetter + ccLetterModifier, // ucModifierLetter + ccLetterOther, // ucOtherLetter + ccLetterTitlecase, // ucTitlecaseLetter + ccLetterUppercase, // ucUppercaseLetter + ccMarkSpacingCombining, // ucCombiningMark + ccMarkEnclosing, // ucEnclosingMark + ccMarkNonSpacing, // ucNonSpacingMark + ccNumberDecimalDigit, // ucDecimalNumber + ccNumberLetter, // ucLetterNumber + ccNumberOther, // ucOtherNumber + ccPunctuationConnector, // ucConnectPunctuation + ccPunctuationDash, // ucDashPunctuation + ccPunctuationClose, // ucClosePunctuation + ccPunctuationFinalQuote, // ucFinalPunctuation + ccPunctuationInitialQuote, // ucInitialPunctuation + ccPunctuationOther, // ucOtherPunctuation + ccPunctuationOpen, // ucOpenPunctuation + ccSymbolCurrency, // ucCurrencySymbol + ccSymbolModifier, // ucModifierSymbol + ccSymbolMath, // ucMathSymbol + ccSymbolOther, // ucOtherSymbol + ccSeparatorLine, // ucLineSeparator + ccSeparatorParagraph, // ucParagraphSeparator + ccSeparatorSpace ); // ucSpaceSeparator + +function CharacterCategoriesToUnicodeCategory(const Categories: TCharacterCategories): TUnicodeCategory; +function UnicodeCategoryToCharacterCategories(Category: TUnicodeCategory): TCharacterCategories; +{$ENDIF HAS_UNIT_CHARACTER} + +type + // four forms of normalization are defined: + TNormalizationForm = ( + nfNone, // do not normalize + nfC, // canonical decomposition followed by canonical composition (this is most often used) + nfD, // canonical decomposition + nfKC, // compatibility decomposition followed by a canonical composition + nfKD // compatibility decomposition + ); + + // 16 compatibility formatting tags are defined: + TCompatibilityFormattingTag = ( + cftCanonical, // default when no CFT is explicited + cftFont, // Font variant (for example, a blackletter form) + cftNoBreak, // No-break version of a space or hyphen + cftInitial, // Initial presentation form (Arabic) + cftMedial, // Medial presentation form (Arabic) + cftFinal, // Final presentation form (Arabic) + cftIsolated, // Isolated presentation form (Arabic) + cftCircle, // Encircled form + cftSuper, // Superscript form + cftSub, // Subscript form + cftVertical, // Vertical layout presentation form + cftWide, // Wide (or zenkaku) compatibility character + cftNarrow, // Narrow (or hankaku) compatibility character + cftSmall, // Small variant form (CNS compatibility) + cftSquare, // CJK squared font variant + cftFraction, // Vulgar fraction form + cftCompat // Otherwise unspecified compatibility character + ); + TCompatibilityFormattingTags = set of TCompatibilityFormattingTag; + + // used to hold information about the start and end + // position of a unicodeblock. + TUnicodeBlockRange = record + RangeStart, + RangeEnd: Cardinal; + end; + + // An Unicode block usually corresponds to a particular language script but + // can also represent special characters, musical symbols and the like. + // https://www.unicode.org/charts/ + TUnicodeBlock = ( + ubUndefined, + ubBasicLatin, + ubLatin1Supplement, + ubLatinExtendedA, + ubLatinExtendedB, + ubIPAExtensions, + ubSpacingModifierLetters, + ubCombiningDiacriticalMarks, + ubGreekandCoptic, + ubCyrillic, + ubCyrillicSupplement, + ubArmenian, + ubHebrew, + ubArabic, + ubSyriac, + ubArabicSupplement, + ubThaana, + ubNKo, + ubSamaritan, + ubMandaic, + ubSyriacSupplement, + ubArabicExtendedA, + ubDevanagari, + ubBengali, + ubGurmukhi, + ubGujarati, + ubOriya, + ubTamil, + ubTelugu, + ubKannada, + ubMalayalam, + ubSinhala, + ubThai, + ubLao, + ubTibetan, + ubMyanmar, + ubGeorgian, + ubHangulJamo, + ubEthiopic, + ubEthiopicSupplement, + ubCherokee, + ubUnifiedCanadianAboriginalSyllabics, + ubOgham, + ubRunic, + ubTagalog, + ubHanunoo, + ubBuhid, + ubTagbanwa, + ubKhmer, + ubMongolian, + ubUnifiedCanadianAboriginalSyllabicsExtended, + ubLimbu, + ubTaiLe, + ubNewTaiLue, + ubKhmerSymbols, + ubBuginese, + ubTaiTham, + ubCombiningDiactiticalMarksExtended, + ubBalinese, + ubSundanese, + ubBatak, + ubLepcha, + ubOlChiki, + ubCyrillicExtendedC, + ubGeorgianExtended, + ubSundaneseSupplement, + ubVedicExtensions, + ubPhoneticExtensions, + ubPhoneticExtensionsSupplement, + ubCombiningDiacriticalMarksSupplement, + ubLatinExtendedAdditional, + ubGreekExtended, + ubGeneralPunctuation, + ubSuperscriptsandSubscripts, + ubCurrencySymbols, + ubCombiningDiacriticalMarksforSymbols, + ubLetterlikeSymbols, + ubNumberForms, + ubArrows, + ubMathematicalOperators, + ubMiscellaneousTechnical, + ubControlPictures, + ubOpticalCharacterRecognition, + ubEnclosedAlphanumerics, + ubBoxDrawing, + ubBlockElements, + ubGeometricShapes, + ubMiscellaneousSymbols, + ubDingbats, + ubMiscellaneousMathematicalSymbolsA, + ubSupplementalArrowsA, + ubBraillePatterns, + ubSupplementalArrowsB, + ubMiscellaneousMathematicalSymbolsB, + ubSupplementalMathematicalOperators, + ubMiscellaneousSymbolsandArrows, + ubGlagolitic, + ubLatinExtendedC, + ubCoptic, + ubGeorgianSupplement, + ubTifinagh, + ubEthiopicExtended, + ubCyrillicExtendedA, + ubSupplementalPunctuation, + ubCJKRadicalsSupplement, + ubKangxiRadicals, + ubIdeographicDescriptionCharacters, + ubCJKSymbolsandPunctuation, + ubHiragana, + ubKatakana, + ubBopomofo, + ubHangulCompatibilityJamo, + ubKanbun, + ubBopomofoExtended, + ubCJKStrokes, + ubKatakanaPhoneticExtensions, + ubEnclosedCJKLettersandMonths, + ubCJKCompatibility, + ubCJKUnifiedIdeographsExtensionA, + ubYijingHexagramSymbols, + ubCJKUnifiedIdeographs, + ubYiSyllables, + ubYiRadicals, + ubLisu, + ubVai, + ubCyrillicExtendedB, + ubBamum, + ubModifierToneLetters, + ubLatinExtendedD, + ubSylotiNagri, + ubCommonIndicNumberForms, + ubPhagsPa, + ubSaurashtra, + ubDevanagariExtended, + ubKayahLi, + ubRejang, + ubHangulJamoExtendedA, + ubJavanese, + ubMyanmarExtendedB, + ubCham, + ubMyanmarExtendedA, + ubTaiViet, + ubMeeteiMayekExtensions, + ubEthiopicExtendedA, + ubLatinExtendedE, + ubCherokeeSupplement, + ubMeeteiMayek, + ubHangulSyllables, + ubHangulJamoExtendedB, + ubHighSurrogates, + ubHighPrivateUseSurrogates, + ubLowSurrogates, + ubPrivateUseArea, + ubCJKCompatibilityIdeographs, + ubAlphabeticPresentationForms, + ubArabicPresentationFormsA, + ubVariationSelectors, + ubVerticalForms, + ubCombiningHalfMarks, + ubCJKCompatibilityForms, + ubSmallFormVariants, + ubArabicPresentationFormsB, + ubHalfwidthandFullwidthForms, + ubSpecials, + ubLinearBSyllabary, + ubLinearBIdeograms, + ubAegeanNumbers, + ubAncientGreekNumbers, + ubAncientSymbols, + ubPhaistosDisc, + ubLycian, + ubCarian, + ubCopticEpactNumbers, + ubOldItalic, + ubGothic, + ubOldPermic, + ubUgaritic, + ubOldPersian, + ubDeseret, + ubShavian, + ubOsmanya, + ubOsage, + ubElbasan, + ubCaucasianAlbanian, + ubLinearA, + ubCypriotSyllabary, + ubImperialAramaic, + ubPalmyrene, + ubNabataean, + ubHatran, + ubPhoenician, + ubLydian, + ubMeroiticHieroglyphs, + ubMeroiticCursive, + ubKharoshthi, + ubOldSouthArabian, + ubOldNorthArabian, + ubManichaean, + ubAvestan, + ubInscriptionalParthian, + ubInscriptionalPahlavi, + ubPsalterPahlavi, + ubOldTurkic, + ubOldHungarian, + ubHanifiRohingya, + ubRumiNumeralSymbols, + ubYezidi, + ubOldSogdian, + ubSogdian, + ubChorasmian, + ubElymaic, + ubBrahmi, + ubKaithi, + ubSoraSompeng, + ubChakma, + ubMahajani, + ubSharada, + ubSinhalaArchaicNumbers, + ubKhojki, + ubMultani, + ubKhudawadi, + ubGrantha, + ubNewa, + ubTirhuta, + ubSiddam, + ubModi, + ubMongolianSupplement, + ubTakri, + ubAhom, + ubDogra, + ubWarangCiti, + ubDivesAkuru, + ubNandinagari, + ubZanabazarSquare, + ubSoyombo, + ubPauCinHau, + ubBhaiksuki, + ubMarchen, + ubMasaramGondi, + ubGunjalaGondi, + ubTamilSupplement, + ubMakasar, + ubLisuSupplement, + ubCuneiform, + ubCuneiformNumbersAndPunctuation, + ubEarlyDynasticCuneiform, + ubEgyptianHieroglyphs, + ubEgyptianHieroglyphFormatControls, + ubAnatolianHieroglyphs, + ubBamumSupplement, + ubMro, + ubBassaVah, + ubPahawhHmong, + ubMedefaidrin, + ubMiao, + upIdeographicSymbolsAndPunctuation, + ubTangut, + ubTangutComponents, + ubKhitanSmallScript, + ubTangutSupplement, + ubKanaSupplement, + ubKanaExtendedA, + ubSmallKanaExtension, + ubNushu, + ubDuployan, + ubShorthandFormatControls, + ubByzantineMusicalSymbols, + ubMusicalSymbols, + ubAncientGreekMusicalNotation, + ubMayanNumerals, + ubTaiXuanJingSymbols, + ubCountingRodNumerals, + ubSuttonSignWriting, + ubMathematicalAlphanumericSymbols, + ubGlagolithicSupplement, + ubWancho, + ubNyiakengPuachueHmong, + ubMendeKikakui, + ubIndicSiyaqNumbers, + ubOttomanSiyaqNumbers, + ubAdlam, + ubArabicMathematicalAlphabeticSymbols, + ubMahjongTiles, + ubDominoTiles, + ubPlayingCards, + ubEnclosedAlphanumericSupplement, + ubEnclosedIdeographicSupplement, + ubMiscellaneousSymbolsAndPictographs, + ubEmoticons, + ubOrnamentalDingbats, + ubTransportAndMapSymbols, + ubAlchemicalSymbols, + ubGeometricShapesExtended, + ubSupplementalArrowsC, + ubSupplementalSymbolsAndPictographs, + ubChessSymbols, + ubSymbolsAndPictographsExtendedA, + ubSymbolsForLegacyComputing, + ubCJKUnifiedIdeographsExtensionB, + ubCJKUnifiedIdeographsExtensionC, + ubCJKUnifiedIdeographsExtensionD, + ubCJKUnifiedIdeographsExtensionE, + ubCJKUnifiedIdeographsExtensionF, + ubCJKCompatibilityIdeographsSupplement, + ubCJKUnifiedIdeographsExtensionG, + ubTags, + ubVariationSelectorsSupplement, + ubSupplementaryPrivateUseAreaA, + ubSupplementaryPrivateUseAreaB + ); + + TUnicodeBlockData = record + Range: TUnicodeBlockRange; + Name: string; + end; + PUnicodeBlockData = ^TUnicodeBlockData; + +const + UnicodeBlockData: array [TUnicodeBlock] of TUnicodeBlockData = + ((Range:(RangeStart: $FFFFFFFF; RangeEnd: $0000); Name: 'No-block'), + (Range:(RangeStart: $0000; RangeEnd: $007F); Name: 'Basic Latin'), + (Range:(RangeStart: $0080; RangeEnd: $00FF); Name: 'Latin-1 Supplement'), + (Range:(RangeStart: $0100; RangeEnd: $017F); Name: 'Latin Extended-A'), + (Range:(RangeStart: $0180; RangeEnd: $024F); Name: 'Latin Extended-B'), + (Range:(RangeStart: $0250; RangeEnd: $02AF); Name: 'IPA Extensions'), + (Range:(RangeStart: $02B0; RangeEnd: $02FF); Name: 'Spacing Modifier Letters'), + (Range:(RangeStart: $0300; RangeEnd: $036F); Name: 'Combining Diacritical Marks'), + (Range:(RangeStart: $0370; RangeEnd: $03FF); Name: 'Greek and Coptic'), + (Range:(RangeStart: $0400; RangeEnd: $04FF); Name: 'Cyrillic'), + (Range:(RangeStart: $0500; RangeEnd: $052F); Name: 'Cyrillic Supplement'), + (Range:(RangeStart: $0530; RangeEnd: $058F); Name: 'Armenian'), + (Range:(RangeStart: $0590; RangeEnd: $05FF); Name: 'Hebrew'), + (Range:(RangeStart: $0600; RangeEnd: $06FF); Name: 'Arabic'), + (Range:(RangeStart: $0700; RangeEnd: $074F); Name: 'Syriac'), + (Range:(RangeStart: $0750; RangeEnd: $077F); Name: 'Arabic Supplement'), + (Range:(RangeStart: $0780; RangeEnd: $07BF); Name: 'Thaana'), + (Range:(RangeStart: $07C0; RangeEnd: $07FF); Name: 'NKo'), + (Range:(RangeStart: $0800; RangeEnd: $083F); Name: 'Samaritan'), + (Range:(RangeStart: $0840; RangeEnd: $085F); Name: 'Mandaic'), + (Range:(RangeStart: $0860; RangeEnd: $086F); Name: 'Syriac Supplement'), + (Range:(RangeStart: $08A0; RangeEnd: $08FF); Name: 'Arabic Extended-A'), + (Range:(RangeStart: $0900; RangeEnd: $097F); Name: 'Devanagari'), + (Range:(RangeStart: $0980; RangeEnd: $09FF); Name: 'Bengali'), + (Range:(RangeStart: $0A00; RangeEnd: $0A7F); Name: 'Gurmukhi'), + (Range:(RangeStart: $0A80; RangeEnd: $0AFF); Name: 'Gujarati'), + (Range:(RangeStart: $0B00; RangeEnd: $0B7F); Name: 'Oriya'), + (Range:(RangeStart: $0B80; RangeEnd: $0BFF); Name: 'Tamil'), + (Range:(RangeStart: $0C00; RangeEnd: $0C7F); Name: 'Telugu'), + (Range:(RangeStart: $0C80; RangeEnd: $0CFF); Name: 'Kannada'), + (Range:(RangeStart: $0D00; RangeEnd: $0D7F); Name: 'Malayalam'), + (Range:(RangeStart: $0D80; RangeEnd: $0DFF); Name: 'Sinhala'), + (Range:(RangeStart: $0E00; RangeEnd: $0E7F); Name: 'Thai'), + (Range:(RangeStart: $0E80; RangeEnd: $0EFF); Name: 'Lao'), + (Range:(RangeStart: $0F00; RangeEnd: $0FFF); Name: 'Tibetan'), + (Range:(RangeStart: $1000; RangeEnd: $109F); Name: 'Myanmar'), + (Range:(RangeStart: $10A0; RangeEnd: $10FF); Name: 'Georgian'), + (Range:(RangeStart: $1100; RangeEnd: $11FF); Name: 'Hangul Jamo'), + (Range:(RangeStart: $1200; RangeEnd: $137F); Name: 'Ethiopic'), + (Range:(RangeStart: $1380; RangeEnd: $139F); Name: 'Ethiopic Supplement'), + (Range:(RangeStart: $13A0; RangeEnd: $13FF); Name: 'Cherokee'), + (Range:(RangeStart: $1400; RangeEnd: $167F); Name: 'Unified Canadian Aboriginal Syllabics'), + (Range:(RangeStart: $1680; RangeEnd: $169F); Name: 'Ogham'), + (Range:(RangeStart: $16A0; RangeEnd: $16FF); Name: 'Runic'), + (Range:(RangeStart: $1700; RangeEnd: $171F); Name: 'Tagalog'), + (Range:(RangeStart: $1720; RangeEnd: $173F); Name: 'Hanunoo'), + (Range:(RangeStart: $1740; RangeEnd: $175F); Name: 'Buhid'), + (Range:(RangeStart: $1760; RangeEnd: $177F); Name: 'Tagbanwa'), + (Range:(RangeStart: $1780; RangeEnd: $17FF); Name: 'Khmer'), + (Range:(RangeStart: $1800; RangeEnd: $18AF); Name: 'Mongolian'), + (Range:(RangeStart: $18B0; RangeEnd: $18FF); Name: 'Unified Canadian Aboriginal Syllabics Extended'), + (Range:(RangeStart: $1900; RangeEnd: $194F); Name: 'Limbu'), + (Range:(RangeStart: $1950; RangeEnd: $197F); Name: 'Tai Le'), + (Range:(RangeStart: $1980; RangeEnd: $19DF); Name: 'New Tai Lue'), + (Range:(RangeStart: $19E0; RangeEnd: $19FF); Name: 'Khmer Symbols'), + (Range:(RangeStart: $1A00; RangeEnd: $1A1F); Name: 'Buginese'), + (Range:(RangeStart: $1A20; RangeEnd: $1AAF); Name: 'Tai Tham'), + (Range:(RangeStart: $1AB0; RangeEnd: $1AFF); Name: 'Combining Diacritical Marks Extended'), + (Range:(RangeStart: $1B00; RangeEnd: $1B7F); Name: 'Balinese'), + (Range:(RangeStart: $1B80; RangeEnd: $1BBF); Name: 'Sundanese'), + (Range:(RangeStart: $1BC0; RangeEnd: $1BFF); Name: 'Batak'), + (Range:(RangeStart: $1C00; RangeEnd: $1C4F); Name: 'Lepcha'), + (Range:(RangeStart: $1C50; RangeEnd: $1C7F); Name: 'Ol Chiki'), + (Range:(RangeStart: $1C80; RangeEnd: $1C8F); Name: 'Cyrillic Extended-C'), + (Range:(RangeStart: $1C90; RangeEnd: $1CBF); Name: 'Georgian Extended'), + (Range:(RangeStart: $1CC0; RangeEnd: $1CCF); Name: 'Sundanese Supplement'), + (Range:(RangeStart: $1CD0; RangeEnd: $1CFF); Name: 'Vedic Extensions'), + (Range:(RangeStart: $1D00; RangeEnd: $1D7F); Name: 'Phonetic Extensions'), + (Range:(RangeStart: $1D80; RangeEnd: $1DBF); Name: 'Phonetic Extensions Supplement'), + (Range:(RangeStart: $1DC0; RangeEnd: $1DFF); Name: 'Combining Diacritical Marks Supplement'), + (Range:(RangeStart: $1E00; RangeEnd: $1EFF); Name: 'Latin Extended Additional'), + (Range:(RangeStart: $1F00; RangeEnd: $1FFF); Name: 'Greek Extended'), + (Range:(RangeStart: $2000; RangeEnd: $206F); Name: 'General Punctuation'), + (Range:(RangeStart: $2070; RangeEnd: $209F); Name: 'Superscripts and Subscripts'), + (Range:(RangeStart: $20A0; RangeEnd: $20CF); Name: 'Currency Symbols'), + (Range:(RangeStart: $20D0; RangeEnd: $20FF); Name: 'Combining Diacritical Marks for Symbols'), + (Range:(RangeStart: $2100; RangeEnd: $214F); Name: 'Letterlike Symbols'), + (Range:(RangeStart: $2150; RangeEnd: $218F); Name: 'Number Forms'), + (Range:(RangeStart: $2190; RangeEnd: $21FF); Name: 'Arrows'), + (Range:(RangeStart: $2200; RangeEnd: $22FF); Name: 'Mathematical Operators'), + (Range:(RangeStart: $2300; RangeEnd: $23FF); Name: 'Miscellaneous Technical'), + (Range:(RangeStart: $2400; RangeEnd: $243F); Name: 'Control Pictures'), + (Range:(RangeStart: $2440; RangeEnd: $245F); Name: 'Optical Character Recognition'), + (Range:(RangeStart: $2460; RangeEnd: $24FF); Name: 'Enclosed Alphanumerics'), + (Range:(RangeStart: $2500; RangeEnd: $257F); Name: 'Box Drawing'), + (Range:(RangeStart: $2580; RangeEnd: $259F); Name: 'Block Elements'), + (Range:(RangeStart: $25A0; RangeEnd: $25FF); Name: 'Geometric Shapes'), + (Range:(RangeStart: $2600; RangeEnd: $26FF); Name: 'Miscellaneous Symbols'), + (Range:(RangeStart: $2700; RangeEnd: $27BF); Name: 'Dingbats'), + (Range:(RangeStart: $27C0; RangeEnd: $27EF); Name: 'Miscellaneous Mathematical Symbols-A'), + (Range:(RangeStart: $27F0; RangeEnd: $27FF); Name: 'Supplemental Arrows-A'), + (Range:(RangeStart: $2800; RangeEnd: $28FF); Name: 'Braille Patterns'), + (Range:(RangeStart: $2900; RangeEnd: $297F); Name: 'Supplemental Arrows-B'), + (Range:(RangeStart: $2980; RangeEnd: $29FF); Name: 'Miscellaneous Mathematical Symbols-B'), + (Range:(RangeStart: $2A00; RangeEnd: $2AFF); Name: 'Supplemental Mathematical Operators'), + (Range:(RangeStart: $2B00; RangeEnd: $2BFF); Name: 'Miscellaneous Symbols and Arrows'), + (Range:(RangeStart: $2C00; RangeEnd: $2C5F); Name: 'Glagolitic'), + (Range:(RangeStart: $2C60; RangeEnd: $2C7F); Name: 'Latin Extended-C'), + (Range:(RangeStart: $2C80; RangeEnd: $2CFF); Name: 'Coptic'), + (Range:(RangeStart: $2D00; RangeEnd: $2D2F); Name: 'Georgian Supplement'), + (Range:(RangeStart: $2D30; RangeEnd: $2D7F); Name: 'Tifinagh'), + (Range:(RangeStart: $2D80; RangeEnd: $2DDF); Name: 'Ethiopic Extended'), + (Range:(RangeStart: $2DE0; RangeEnd: $2DFF); Name: 'Cyrillic Extended-A'), + (Range:(RangeStart: $2E00; RangeEnd: $2E7F); Name: 'Supplemental Punctuation'), + (Range:(RangeStart: $2E80; RangeEnd: $2EFF); Name: 'CJK Radicals Supplement'), + (Range:(RangeStart: $2F00; RangeEnd: $2FDF); Name: 'Kangxi Radicals'), + (Range:(RangeStart: $2FF0; RangeEnd: $2FFF); Name: 'Ideographic Description Characters'), + (Range:(RangeStart: $3000; RangeEnd: $303F); Name: 'CJK Symbols and Punctuation'), + (Range:(RangeStart: $3040; RangeEnd: $309F); Name: 'Hiragana'), + (Range:(RangeStart: $30A0; RangeEnd: $30FF); Name: 'Katakana'), + (Range:(RangeStart: $3100; RangeEnd: $312F); Name: 'Bopomofo'), + (Range:(RangeStart: $3130; RangeEnd: $318F); Name: 'Hangul Compatibility Jamo'), + (Range:(RangeStart: $3190; RangeEnd: $319F); Name: 'Kanbun'), + (Range:(RangeStart: $31A0; RangeEnd: $31BF); Name: 'Bopomofo Extended'), + (Range:(RangeStart: $31C0; RangeEnd: $31EF); Name: 'CJK Strokes'), + (Range:(RangeStart: $31F0; RangeEnd: $31FF); Name: 'Katakana Phonetic Extensions'), + (Range:(RangeStart: $3200; RangeEnd: $32FF); Name: 'Enclosed CJK Letters and Months'), + (Range:(RangeStart: $3300; RangeEnd: $33FF); Name: 'CJK Compatibility'), + (Range:(RangeStart: $3400; RangeEnd: $4DBF); Name: 'CJK Unified Ideographs Extension A'), + (Range:(RangeStart: $4DC0; RangeEnd: $4DFF); Name: 'Yijing Hexagram Symbols'), + (Range:(RangeStart: $4E00; RangeEnd: $9FFC); Name: 'CJK Unified Ideographs'), + (Range:(RangeStart: $A000; RangeEnd: $A48F); Name: 'Yi Syllables'), + (Range:(RangeStart: $A490; RangeEnd: $A4CF); Name: 'Yi Radicals'), + (Range:(RangeStart: $A4D0; RangeEnd: $A4FF); Name: 'Lisu'), + (Range:(RangeStart: $A500; RangeEnd: $A63F); Name: 'Vai'), + (Range:(RangeStart: $A640; RangeEnd: $A69F); Name: 'Cyrillic Extended-B'), + (Range:(RangeStart: $A6A0; RangeEnd: $A6FF); Name: 'Bamum'), + (Range:(RangeStart: $A700; RangeEnd: $A71F); Name: 'Modifier Tone Letters'), + (Range:(RangeStart: $A720; RangeEnd: $A7FF); Name: 'Latin Extended-D'), + (Range:(RangeStart: $A800; RangeEnd: $A82F); Name: 'Syloti Nagri'), + (Range:(RangeStart: $A830; RangeEnd: $A83F); Name: 'Common Indic Number Forms'), + (Range:(RangeStart: $A840; RangeEnd: $A87F); Name: 'Phags-pa'), + (Range:(RangeStart: $A880; RangeEnd: $A8DF); Name: 'Saurashtra'), + (Range:(RangeStart: $A8E0; RangeEnd: $A8FF); Name: 'Devanagari Extended'), + (Range:(RangeStart: $A900; RangeEnd: $A92F); Name: 'Kayah Li'), + (Range:(RangeStart: $A930; RangeEnd: $A95F); Name: 'Rejang'), + (Range:(RangeStart: $A960; RangeEnd: $A97F); Name: 'Hangul Jamo Extended-A'), + (Range:(RangeStart: $A980; RangeEnd: $A9DF); Name: 'Javanese'), + (Range:(RangeStart: $A9E0; RangeEnd: $A9FF); Name: 'Myanmar Extended-B'), + (Range:(RangeStart: $AA00; RangeEnd: $AA5F); Name: 'Cham'), + (Range:(RangeStart: $AA60; RangeEnd: $AA7F); Name: 'Myanmar Extended-A'), + (Range:(RangeStart: $AA80; RangeEnd: $AADF); Name: 'Tai Viet'), + (Range:(RangeStart: $AAE0; RangeEnd: $AAFF); Name: 'Meetei Mayek Extensions'), + (Range:(RangeStart: $AB00; RangeEnd: $AB2F); Name: 'Ethiopic Extended-A'), + (Range:(RangeStart: $AB30; RangeEnd: $AB6F); Name: 'Latin Extended-E'), + (Range:(RangeStart: $AB70; RangeEnd: $ABBF); Name: 'Cherokee Supplement'), + (Range:(RangeStart: $ABC0; RangeEnd: $ABFF); Name: 'Meetei Mayek'), + (Range:(RangeStart: $AC00; RangeEnd: $D7AF); Name: 'Hangul Syllables'), + (Range:(RangeStart: $D7B0; RangeEnd: $D7FF); Name: 'Hangul Jamo Extended-B'), + (Range:(RangeStart: $D800; RangeEnd: $DB7F); Name: 'High Surrogates'), + (Range:(RangeStart: $DB80; RangeEnd: $DBFF); Name: 'High Private Use Surrogates'), + (Range:(RangeStart: $DC00; RangeEnd: $DFFF); Name: 'Low Surrogates'), + (Range:(RangeStart: $E000; RangeEnd: $F8FF); Name: 'Private Use Area'), + (Range:(RangeStart: $F900; RangeEnd: $FAFF); Name: 'CJK Compatibility Ideographs'), + (Range:(RangeStart: $FB00; RangeEnd: $FB4F); Name: 'Alphabetic Presentation Forms'), + (Range:(RangeStart: $FB50; RangeEnd: $FDFF); Name: 'Arabic Presentation Forms-A'), + (Range:(RangeStart: $FE00; RangeEnd: $FE0F); Name: 'Variation Selectors'), + (Range:(RangeStart: $FE10; RangeEnd: $FE1F); Name: 'Vertical Forms'), + (Range:(RangeStart: $FE20; RangeEnd: $FE2F); Name: 'Combining Half Marks'), + (Range:(RangeStart: $FE30; RangeEnd: $FE4F); Name: 'CJK Compatibility Forms'), + (Range:(RangeStart: $FE50; RangeEnd: $FE6F); Name: 'Small Form Variants'), + (Range:(RangeStart: $FE70; RangeEnd: $FEFF); Name: 'Arabic Presentation Forms-B'), + (Range:(RangeStart: $FF00; RangeEnd: $FFEF); Name: 'Halfwidth and Fullwidth Forms'), + (Range:(RangeStart: $FFF0; RangeEnd: $FFFF); Name: 'Specials'), + (Range:(RangeStart: $10000; RangeEnd: $1007F); Name: 'Linear B Syllabary'), + (Range:(RangeStart: $10080; RangeEnd: $100FF); Name: 'Linear B Ideograms'), + (Range:(RangeStart: $10100; RangeEnd: $1013F); Name: 'Aegean Numbers'), + (Range:(RangeStart: $10140; RangeEnd: $1018F); Name: 'Ancient Greek Numbers'), + (Range:(RangeStart: $10190; RangeEnd: $101CF); Name: 'Ancient Symbols'), + (Range:(RangeStart: $101D0; RangeEnd: $101FF); Name: 'Phaistos Disc'), + (Range:(RangeStart: $10280; RangeEnd: $1029F); Name: 'Lycian'), + (Range:(RangeStart: $102A0; RangeEnd: $102DF); Name: 'Carian'), + (Range:(RangeStart: $102E0; RangeEnd: $102FF); Name: 'Coptic Epact Numbers'), + (Range:(RangeStart: $10300; RangeEnd: $1032F); Name: 'Old Italic'), + (Range:(RangeStart: $10330; RangeEnd: $1034F); Name: 'Gothic'), + (Range:(RangeStart: $10350; RangeEnd: $1037F); Name: 'Old Permic'), + (Range:(RangeStart: $10380; RangeEnd: $1039F); Name: 'Ugaritic'), + (Range:(RangeStart: $103A0; RangeEnd: $103DF); Name: 'Old Persian'), + (Range:(RangeStart: $10400; RangeEnd: $1044F); Name: 'Deseret'), + (Range:(RangeStart: $10450; RangeEnd: $1047F); Name: 'Shavian'), + (Range:(RangeStart: $10480; RangeEnd: $104AF); Name: 'Osmanya'), + (Range:(RangeStart: $104B0; RangeEnd: $104FF); Name: 'Osage'), + (Range:(RangeStart: $10500; RangeEnd: $1052F); Name: 'Elbasan'), + (Range:(RangeStart: $10530; RangeEnd: $1056F); Name: 'Caucasian Albanian'), + (Range:(RangeStart: $10600; RangeEnd: $1077F); Name: 'Linear A'), + (Range:(RangeStart: $10800; RangeEnd: $1083F); Name: 'Cypriot Syllabary'), + (Range:(RangeStart: $10840; RangeEnd: $1085F); Name: 'Imperial Aramaic'), + (Range:(RangeStart: $10860; RangeEnd: $1087F); Name: 'Palmyrene'), + (Range:(RangeStart: $10880; RangeEnd: $108AF); Name: 'Nabataean'), + (Range:(RangeStart: $108E0; RangeEnd: $108FF); Name: 'Hatran'), + (Range:(RangeStart: $10900; RangeEnd: $1091F); Name: 'Phoenician'), + (Range:(RangeStart: $10920; RangeEnd: $1093F); Name: 'Lydian'), + (Range:(RangeStart: $10980; RangeEnd: $1099F); Name: 'Meroitic Hieroglyphs'), + (Range:(RangeStart: $109A0; RangeEnd: $109FF); Name: 'Meroitic Cursive'), + (Range:(RangeStart: $10A00; RangeEnd: $10A5F); Name: 'Kharoshthi'), + (Range:(RangeStart: $10A60; RangeEnd: $10A7F); Name: 'Old South Arabian'), + (Range:(RangeStart: $10A80; RangeEnd: $10A9F); Name: 'Old North Arabian'), + (Range:(RangeStart: $10AC0; RangeEnd: $10AFF); Name: 'Manichaean'), + (Range:(RangeStart: $10B00; RangeEnd: $10B3F); Name: 'Avestan'), + (Range:(RangeStart: $10B40; RangeEnd: $10B5F); Name: 'Inscriptional Parthian'), + (Range:(RangeStart: $10B60; RangeEnd: $10B7F); Name: 'Inscriptional Pahlavi'), + (Range:(RangeStart: $10B80; RangeEnd: $10BAF); Name: 'Psalter Pahlavi'), + (Range:(RangeStart: $10C00; RangeEnd: $10C4F); Name: 'Old Turkic'), + (Range:(RangeStart: $10C80; RangeEnd: $10CFF); Name: 'Old Hungarian'), + (Range:(RangeStart: $10D00; RangeEnd: $10D3F); Name: 'Hanifi Rohingya'), + (Range:(RangeStart: $10E60; RangeEnd: $10E7F); Name: 'Rumi Numeral Symbols'), + (Range:(RangeStart: $10E80; RangeEnd: $10EBF); Name: 'Yezidi'), + (Range:(RangeStart: $10F00; RangeEnd: $10F2F); Name: 'Old Sogdian'), + (Range:(RangeStart: $10F30; RangeEnd: $10FAF); Name: 'Sogdian'), + (Range:(RangeStart: $10FB0; RangeEnd: $10FDF); Name: 'Chorasmian'), + (Range:(RangeStart: $10FE0; RangeEnd: $10FFF); Name: 'Elymaic'), + (Range:(RangeStart: $11000; RangeEnd: $1107F); Name: 'Brahmi'), + (Range:(RangeStart: $11080; RangeEnd: $110CF); Name: 'Kaithi'), + (Range:(RangeStart: $110D0; RangeEnd: $110FF); Name: 'Sora Sompeng'), + (Range:(RangeStart: $11100; RangeEnd: $1114F); Name: 'Chakma'), + (Range:(RangeStart: $11150; RangeEnd: $1117F); Name: 'Mahajani'), + (Range:(RangeStart: $11180; RangeEnd: $111DF); Name: 'Sharada'), + (Range:(RangeStart: $111E0; RangeEnd: $111FF); Name: 'Sinhala Archaic Numbers'), + (Range:(RangeStart: $11200; RangeEnd: $1124F); Name: 'Khojki'), + (Range:(RangeStart: $11280; RangeEnd: $112AF); Name: 'Multani'), + (Range:(RangeStart: $112B0; RangeEnd: $112FF); Name: 'Khudawadi'), + (Range:(RangeStart: $11300; RangeEnd: $1137F); Name: 'Grantha'), + (Range:(RangeStart: $11400; RangeEnd: $1147F); Name: 'Newa'), + (Range:(RangeStart: $11480; RangeEnd: $114DF); Name: 'Tirhuta'), + (Range:(RangeStart: $11580; RangeEnd: $115FF); Name: 'Siddam'), + (Range:(RangeStart: $11600; RangeEnd: $1165F); Name: 'Modi'), + (Range:(RangeStart: $11660; RangeEnd: $1167F); Name: 'Mongolian Supplement'), + (Range:(RangeStart: $11680; RangeEnd: $116CF); Name: 'Takri'), + (Range:(RangeStart: $11700; RangeEnd: $1173F); Name: 'Ahom'), + (Range:(RangeStart: $11800; RangeEnd: $1184F); Name: 'Dogra'), + (Range:(RangeStart: $118A0; RangeEnd: $118FF); Name: 'Warang Citi'), + (Range:(RangeStart: $11900; RangeEnd: $1195F); Name: 'Dives Akuru'), + (Range:(RangeStart: $119A0; RangeEnd: $119FF); Name: 'Nandinagari'), + (Range:(RangeStart: $11A00; RangeEnd: $11A4F); Name: 'Zanabazar Square'), + (Range:(RangeStart: $11A50; RangeEnd: $11AAF); Name: 'Soyombo'), + (Range:(RangeStart: $11AC0; RangeEnd: $11AFF); Name: 'Pau Cin Hau'), + (Range:(RangeStart: $11C00; RangeEnd: $11C6F); Name: 'Bhaiksuki'), + (Range:(RangeStart: $11C70; RangeEnd: $11CBF); Name: 'Marchen'), + (Range:(RangeStart: $11D00; RangeEnd: $11D5F); Name: 'Masaram Gondi'), + (Range:(RangeStart: $11D60; RangeEnd: $11DAF); Name: 'Gunjala Gondi'), + (Range:(RangeStart: $11EE0; RangeEnd: $11EFF); Name: 'Makasar'), + (Range:(RangeStart: $11FB0; RangeEnd: $11FBF); Name: 'Lisu Supplement'), + (Range:(RangeStart: $11FC0; RangeEnd: $11FFF); Name: 'Tamil Supplement'), + (Range:(RangeStart: $12000; RangeEnd: $123FF); Name: 'Cuneiform'), + (Range:(RangeStart: $12400; RangeEnd: $1247F); Name: 'Cuneiform Numbers and Punctuation'), + (Range:(RangeStart: $12480; RangeEnd: $1254F); Name: 'Early Dynastic Cuneiform'), + (Range:(RangeStart: $13000; RangeEnd: $1342F); Name: 'Egyptian Hieroglyphs'), + (Range:(RangeStart: $13430; RangeEnd: $1343F); Name: 'Egyptian Hieroglyph Format Controls'), + (Range:(RangeStart: $14400; RangeEnd: $1467F); Name: 'Anatolian Hieroglyphs'), + (Range:(RangeStart: $16800; RangeEnd: $16A3F); Name: 'Bamum Supplement'), + (Range:(RangeStart: $16A40; RangeEnd: $16A6F); Name: 'Mro'), + (Range:(RangeStart: $16AD0; RangeEnd: $16AFF); Name: 'Bassa Vah'), + (Range:(RangeStart: $16B00; RangeEnd: $16B8F); Name: 'Pahawh Hmong'), + (Range:(RangeStart: $16E40; RangeEnd: $16E9F); Name: 'Medefaidrin'), + (Range:(RangeStart: $16F00; RangeEnd: $16F9F); Name: 'Miao'), + (Range:(RangeStart: $16FE0; RangeEnd: $16FFF); Name: 'Ideographic Symbols and Punctuation'), + (Range:(RangeStart: $17000; RangeEnd: $187F7); Name: 'Tangut'), + (Range:(RangeStart: $18800; RangeEnd: $18AFF); Name: 'Tangut Components'), + (Range:(RangeStart: $18B00; RangeEnd: $18CFF); Name: 'Khitan Small Script'), + (Range:(RangeStart: $18D00; RangeEnd: $18D08); Name: 'Tangut Supplement'), + (Range:(RangeStart: $1B000; RangeEnd: $1B0FF); Name: 'Kana Supplement'), + (Range:(RangeStart: $1B100; RangeEnd: $1B12F); Name: 'Kana Extended-A'), + (Range:(RangeStart: $1B130; RangeEnd: $1B16F); Name: 'Small Kana Extension'), + (Range:(RangeStart: $1B170; RangeEnd: $1B2FF); Name: 'Nushu'), + (Range:(RangeStart: $1BC00; RangeEnd: $1BC9F); Name: 'Duployan'), + (Range:(RangeStart: $1BCA0; RangeEnd: $1BCAF); Name: 'Shorthand Format Controls'), + (Range:(RangeStart: $1D000; RangeEnd: $1D0FF); Name: 'Byzantine Musical Symbols'), + (Range:(RangeStart: $1D100; RangeEnd: $1D1FF); Name: 'Musical Symbols'), + (Range:(RangeStart: $1D200; RangeEnd: $1D24F); Name: 'Ancient Greek Musical Notation'), + (Range:(RangeStart: $1D2E0; RangeEnd: $1D2FF); Name: 'Mayan Numerals'), + (Range:(RangeStart: $1D300; RangeEnd: $1D35F); Name: 'Tai Xuan Jing Symbols'), + (Range:(RangeStart: $1D360; RangeEnd: $1D37F); Name: 'Counting Rod Numerals'), + (Range:(RangeStart: $1D400; RangeEnd: $1D7FF); Name: 'Mathematical Alphanumeric Symbols'), + (Range:(RangeStart: $1D800; RangeEnd: $1DAAF); Name: 'Sutton SignWriting'), + (Range:(RangeStart: $1E000; RangeEnd: $1E02F); Name: 'Glagolitic Supplement'), + (Range:(RangeStart: $1E100; RangeEnd: $1E14F); Name: 'Nyiakeng Puachue Hmong'), + (Range:(RangeStart: $1E2C0; RangeEnd: $1E2FF); Name: 'Wancho'), + (Range:(RangeStart: $1E800; RangeEnd: $1E8DF); Name: 'Mende Kikakui'), + (Range:(RangeStart: $1EC70; RangeEnd: $1ECBF); Name: 'Indic Siyaq Numbers'), + (Range:(RangeStart: $1ED00; RangeEnd: $1ED4F); Name: 'Ottoman Siyaq Numbers'), + (Range:(RangeStart: $1E900; RangeEnd: $1E95F); Name: 'Adlam'), + (Range:(RangeStart: $1EE00; RangeEnd: $1EEFF); Name: 'Arabic Mathematical Alphabetic Symbols'), + (Range:(RangeStart: $1F000; RangeEnd: $1F02F); Name: 'Mahjong Tiles'), + (Range:(RangeStart: $1F030; RangeEnd: $1F09F); Name: 'Domino Tiles'), + (Range:(RangeStart: $1F0A0; RangeEnd: $1F0FF); Name: 'Playing Cards'), + (Range:(RangeStart: $1F100; RangeEnd: $1F1FF); Name: 'Enclosed Alphanumeric Supplement'), + (Range:(RangeStart: $1F200; RangeEnd: $1F2FF); Name: 'Enclosed Ideographic Supplement'), + (Range:(RangeStart: $1F300; RangeEnd: $1F5FF); Name: 'Miscellaneous Symbols And Pictographs'), + (Range:(RangeStart: $1F600; RangeEnd: $1F64F); Name: 'Emoticons'), + (Range:(RangeStart: $1F650; RangeEnd: $1F67F); Name: 'Ornamental Dingbats'), + (Range:(RangeStart: $1F680; RangeEnd: $1F6FF); Name: 'Transport And Map Symbols'), + (Range:(RangeStart: $1F700; RangeEnd: $1F77F); Name: 'Alchemical Symbols'), + (Range:(RangeStart: $1F780; RangeEnd: $1F7FF); Name: 'Geometric Shapes Extended'), + (Range:(RangeStart: $1F800; RangeEnd: $1F8FF); Name: 'Supplemental Arrows-C'), + (Range:(RangeStart: $1F900; RangeEnd: $1F9FF); Name: 'Supplemental Symbols And Pictographs'), + (Range:(RangeStart: $1FA00; RangeEnd: $1FA6F); Name: 'Chess Symbols'), + (Range:(RangeStart: $1FA70; RangeEnd: $1FAFF); Name: 'Symbols and Pictographs Extended-A'), + (Range:(RangeStart: $1FB00; RangeEnd: $1FBFF); Name: 'Symbols for Legacy Computing'), + (Range:(RangeStart: $20000; RangeEnd: $2A6DD); Name: 'CJK Unified Ideographs Extension B'), + (Range:(RangeStart: $2A700; RangeEnd: $2B734); Name: 'CJK Unified Ideographs Extension C'), + (Range:(RangeStart: $2B740; RangeEnd: $2B81D); Name: 'CJK Unified Ideographs Extension D'), + (Range:(RangeStart: $2B820; RangeEnd: $2CEA1); Name: 'CJK Unified Ideographs Extension E'), + (Range:(RangeStart: $2CEB0; RangeEnd: $2EBE0); Name: 'CJK Unified Ideographs Extension F'), + (Range:(RangeStart: $2F800; RangeEnd: $2FA1F); Name: 'CJK Compatibility Ideographs Supplement'), + (Range:(RangeStart: $30000; RangeEnd: $3134A); Name: 'CJK Unified Ideographs Extension G'), + (Range:(RangeStart: $E0000; RangeEnd: $E007F); Name: 'Tags'), + (Range:(RangeStart: $E0100; RangeEnd: $E01EF); Name: 'Variation Selectors Supplement'), + (Range:(RangeStart: $F0000; RangeEnd: $FFFFF); Name: 'Supplementary Private Use Area-A'), + (Range:(RangeStart: $100000; RangeEnd: $10FFFF); Name: 'Supplementary Private Use Area-B')); + +{$IFNDEF UNICODE_RTL_DATABASE} + +type + TWideStrings = class; + + TSearchFlag = ( + sfCaseSensitive, // match letter case + sfIgnoreNonSpacing, // ignore non-spacing characters in search + sfSpaceCompress, // handle several consecutive white spaces as one white space + // (this applies to the pattern as well as the search text) + sfWholeWordOnly // match only text at end/start and/or surrounded by white spaces + ); + + TSearchFlags = set of TSearchFlag; + + // a generic search class defininition used for tuned Boyer-Moore and Unicode + // regular expression searches + TSearchEngine = class(TObject) + private + FResults: TList; // 2 entries for each result (start and stop position) + FOwner: TWideStrings; // at the moment unused, perhaps later to access strings faster + protected + function GetCount: SizeInt; virtual; + public + constructor Create(AOwner: TWideStrings); virtual; + destructor Destroy; override; + + procedure AddResult(Start, Stop: SizeInt); virtual; + procedure Clear; virtual; + procedure ClearResults; virtual; + procedure DeleteResult(Index: SizeInt); virtual; + procedure FindPrepare(const Pattern: WideString; Options: TSearchFlags); overload; virtual; abstract; + procedure FindPrepare(Pattern: PWideChar; PatternLength: SizeInt; Options: TSearchFlags); overload; virtual; abstract; + function FindFirst(const Text: WideString; var Start, Stop: SizeInt): Boolean; overload; virtual; abstract; + function FindFirst(Text: PWideChar; TextLen: SizeInt; var Start, Stop: SizeInt): Boolean; overload; virtual; abstract; + function FindAll(const Text: WideString): Boolean; overload; virtual; abstract; + function FindAll(Text: PWideChar; TextLen: SizeInt): Boolean; overload; virtual; abstract; + procedure GetResult(Index: SizeInt; var Start, Stop: SizeInt); virtual; + + property Count: SizeInt read GetCount; + end; + + // The Unicode Tuned Boyer-Moore (UTBM) search implementation is an extended + // translation created from a free package written by Mark Leisher (mleisher att crl dott nmsu dott edu). + // + // The code handles high and low surrogates as well as case (in)dependency, + // can ignore non-spacing characters and allows optionally to return whole + // words only. + + // single pattern character + PUTBMChar = ^TUTBMChar; + TUTBMChar = record + LoCase, + UpCase, + TitleCase: UCS4; + end; + + PUTBMSkip = ^TUTBMSkip; + TUTBMSkip = record + BMChar: PUTBMChar; + SkipValues: Integer; + end; + + TUTBMSearch = class(TSearchEngine) + private + FFlags: TSearchFlags; + FPattern: PUTBMChar; + FPatternUsed: SizeInt; + FPatternSize: SizeInt; + FPatternLength: SizeInt; + FSkipValues: PUTBMSkip; + FSkipsUsed: SizeInt; + FMD4: SizeInt; + protected + procedure ClearPattern; + procedure Compile(Pattern: PUCS2; PatternLength: SizeInt; Flags: TSearchFlags); + function Find(Text: PUCS2; TextLen: SizeInt; var MatchStart, MatchEnd: SizeInt): Boolean; + function GetSkipValue(TextStart, TextEnd: PUCS2): SizeInt; + function Match(Text, Start, Stop: PUCS2; var MatchStart, MatchEnd: SizeInt): Boolean; + public + procedure Clear; override; + procedure FindPrepare(const Pattern: WideString; Options: TSearchFlags); overload; override; + procedure FindPrepare(Pattern: PWideChar; PatternLength: SizeInt; Options: TSearchFlags); overload; override; + function FindFirst(const Text: WideString; var Start, Stop: SizeInt): Boolean; overload; override; + function FindFirst(Text: PWideChar; TextLen: SizeInt; var Start, Stop: SizeInt): Boolean; overload; override; + function FindAll(const Text: WideString): Boolean; overload; override; + function FindAll(Text: PWideChar; TextLen: SizeInt): Boolean; overload; override; + end; + + // Regular expression search engine for text in UCS2 form taking surrogates + // into account. This implementation is an improved translation from the URE + // package written by Mark Leisher (mleisher att crl dott nmsu dott edu) who used a variation + // of the RE->DFA algorithm done by Mark Hopkins (markh att csd4 dott csd dott uwm dott edu). + // Assumptions: + // o Regular expression and text already normalized. + // o Conversion to lower case assumes a 1-1 mapping. + // + // Definitions: + // Separator - any one of U+2028, U+2029, NL, CR. + // + // Operators: + // . - match any character + // * - match zero or more of the last subexpression + // + - match one or more of the last subexpression + // ? - match zero or one of the last subexpression + // () - subexpression grouping + // {m, n} - match at least m occurrences and up to n occurrences + // Note: both values can be 0 or ommitted which denotes then a unlimiting bound + // {,} and {0,} and {0, 0} correspond to * + // {, 1} and {0, 1} correspond to ? + // {1,} and {1, 0} correspond to + + // {m} - match exactly m occurrences + // + // Notes: + // o The "." operator normally does not match separators, but a flag is + // available that will allow this operator to match a separator. + // + // Literals and Constants: + // c - literal UCS2 character + // \x.... - hexadecimal number of up to 4 digits + // \X.... - hexadecimal number of up to 4 digits + // \u.... - hexadecimal number of up to 4 digits + // \U.... - hexadecimal number of up to 4 digits + // + // Character classes: + // [...] - Character class + // [^...] - Negated character class + // \pN1,N2,...,Nn - Character properties class + // \PN1,N2,...,Nn - Negated character properties class + // + // POSIX character classes recognized: + // :alnum: + // :alpha: + // :cntrl: + // :digit: + // :graph: + // :lower: + // :print: + // :punct: + // :space: + // :upper: + // :xdigit: + // + // Notes: + // o Character property classes are \p or \P followed by a comma separated + // list of integers between 0 and the maximum entry index in TCharacterCategory. + // These integers directly correspond to the TCharacterCategory enumeration entries. + // Note: upper, lower and title case classes need to have case sensitive search + // be enabled to match correctly! + // + // o Character classes can contain literals, constants and character + // property classes. Example: + // + // [abc\U10A\p0,13,4] + + // structure used to handle a compacted range of characters + PUcRange = ^TUcRange; + TUcRange = record + MinCode, + MaxCode: UCS4; + end; + + TUcCClass = record + Ranges: array of TUcRange; + RangesUsed: SizeInt; + end; + + // either a single character or a list of character classes + TUcSymbol = record + Chr: UCS4; + CCL: TUcCClass; + end; + + // this is a general element structure used for expressions and stack elements + TUcElement = record + OnStack: Boolean; + AType, + LHS, + RHS: SizeInt; + end; + + // this is a structure used to track a list or a stack of states + PUcStateList = ^TUcStateList; + TUcStateList = record + List: array of SizeInt; + ListUsed: SizeInt; + end; + + // structure to track the list of unique states for a symbol during reduction + PUcSymbolTableEntry = ^TUcSymbolTableEntry; + TUcSymbolTableEntry = record + ID, + AType: SizeInt; + Mods, + Categories: TCharacterCategories; + Symbol: TUcSymbol; + States: TUcStateList; + end; + + // structure to hold a single State + PUcState = ^TUcState; + TUcState = record + ID: SizeInt; + Accepting: Boolean; + StateList: TUcStateList; + Transitions: array of TUcElement; + TransitionsUsed: SizeInt; + end; + + // structure used for keeping lists of states + TUcStateTable = record + States: array of TUcState; + StatesUsed: SizeInt; + end; + + // structure to track pairs of DFA states when equivalent states are merged + TUcEquivalent = record + Left, + Right: SizeInt; + end; + + TUcExpressionList = record + Expressions: array of TUcElement; + ExpressionsUsed: SizeInt; + end; + + TUcSymbolTable = record + Symbols: array of TUcSymbolTableEntry; + SymbolsUsed: SizeInt; + end; + + TUcEquivalentList = record + Equivalents: array of TUcEquivalent; + EquivalentsUsed: SizeInt; + end; + + // structure used for constructing the NFA and reducing to a minimal DFA + PUREBuffer = ^TUREBuffer; + TUREBuffer = record + Reducing: Boolean; + Error: Integer; + Flags: Cardinal; + Stack: TUcStateList; + SymbolTable: TUcSymbolTable; // table of unique symbols encountered + ExpressionList: TUcExpressionList; // tracks the unique expressions generated + // for the NFA and when the NFA is reduced + States: TUcStateTable; // the reduced table of unique groups of NFA states + EquivalentList: TUcEquivalentList; // tracks states when equivalent states are merged + end; + + TUcTransition = record + Symbol, + NextState: SizeInt; + end; + + PDFAState = ^TDFAState; + TDFAState = record + Accepting: Boolean; + NumberTransitions: SizeInt; + StartTransition: SizeInt; + end; + + TDFAStates = record + States: array of TDFAState; + StatesUsed: SizeInt; + end; + + TUcTransitions = record + Transitions: array of TUcTransition; + TransitionsUsed: SizeInt; + end; + + TDFA = record + Flags: Cardinal; + SymbolTable: TUcSymbolTable; + StateList: TDFAStates; + TransitionList: TUcTransitions; + end; + + TURESearch = class(TSearchEngine) + private + FUREBuffer: TUREBuffer; + FDFA: TDFA; + protected + procedure AddEquivalentPair(L, R: SizeInt); + procedure AddRange(var CCL: TUcCClass; Range: TUcRange); + function AddState(NewStates: array of SizeInt): SizeInt; + procedure AddSymbolState(Symbol, State: SizeInt); + function BuildCharacterClass(CP: PUCS2; Limit: SizeInt; Symbol: PUcSymbolTableEntry): SizeInt; + procedure ClearUREBuffer; + function CompileSymbol(S: PUCS2; Limit: SizeInt; Symbol: PUcSymbolTableEntry): SizeInt; + procedure CompileURE(RE: PWideChar; RELength: SizeInt; Casefold: Boolean); + procedure CollectPendingOperations(var State: SizeInt); + function ConvertRegExpToNFA(RE: PWideChar; RELength: SizeInt): SizeInt; + function ExecuteURE(Flags: Cardinal; Text: PUCS2; TextLen: SizeInt; var MatchStart, MatchEnd: SizeInt): Boolean; + procedure ClearDFA; + procedure HexDigitSetup(Symbol: PUcSymbolTableEntry); + function MakeExpression(AType, LHS, RHS: SizeInt): SizeInt; + function MakeHexNumber(NP: PUCS2; Limit: SizeInt; var Number: UCS4): SizeInt; + function MakeSymbol(S: PUCS2; Limit: SizeInt; out Consumed: SizeInt): SizeInt; + procedure MergeEquivalents; + function ParsePropertyList(Properties: PUCS2; Limit: SizeInt; var Categories: TCharacterCategories): SizeInt; + function Peek: SizeInt; + function Pop: SizeInt; + function PosixCCL(CP: PUCS2; Limit: SizeInt; Symbol: PUcSymbolTableEntry): SizeInt; + function ProbeLowSurrogate(LeftState: PUCS2; Limit: SizeInt; var Code: UCS4): SizeInt; + procedure Push(V: SizeInt); + procedure Reduce(Start: SizeInt); + procedure SpaceSetup(Symbol: PUcSymbolTableEntry; Categories: TCharacterCategories); + function SymbolsAreDifferent(A, B: PUcSymbolTableEntry): Boolean; + public + procedure Clear; override; + procedure FindPrepare(const Pattern: WideString; Options: TSearchFlags); overload; override; + procedure FindPrepare(Pattern: PWideChar; PatternLength: SizeInt; Options: TSearchFlags); overload; override; + function FindFirst(const Text: WideString; var Start, Stop: SizeInt): Boolean; overload; override; + function FindFirst(Text: PWideChar; TextLen: SizeInt; var Start, Stop: SizeInt): Boolean; overload; override; + function FindAll(const Text: WideString): Boolean; overload; override; + function FindAll(Text: PWideChar; TextLen: SizeInt): Boolean; overload; override; + end; + + // Event used to give the application a chance to switch the way of how to save + // the text in TWideStrings if the text contains characters not only from the + // ANSI block but the save type is ANSI. On triggering the event the application + // can change the property SaveUnicode as needed. This property is again checked + // after the callback returns. + TConfirmConversionEvent = procedure (Sender: TWideStrings; var Allowed: Boolean) of object; + + TWideStrings = class(TPersistent) + private + FUpdateCount: Integer; + FLanguage: LCID; // language can usually left alone, the system's default is used + FSaved: Boolean; // set in SaveToStream, True in case saving was successful otherwise False + FNormalizationForm: TNormalizationForm; // determines in which form Unicode strings should be stored + FOnConfirmConversion: TConfirmConversionEvent; + FSaveFormat: TSaveFormat; // overrides the FSaveUnicode flag, initialized when a file is loaded, + // expect losses if it is set to sfAnsi before saving + function GetCommaText: WideString; + function GetName(Index: Integer): WideString; + function GetValue(const Name: WideString): WideString; + procedure ReadData(Reader: TReader); + procedure SetCommaText(const Value: WideString); + procedure SetNormalizationForm(const Value: TNormalizationForm); + procedure SetValue(const Name, Value: WideString); + procedure WriteData(Writer: TWriter); + function GetSaveUnicode: Boolean; + procedure SetSaveUnicode(const Value: Boolean); + protected + procedure DefineProperties(Filer: TFiler); override; + procedure DoConfirmConversion(var Allowed: Boolean); virtual; + procedure Error(const Msg: string; Data: Integer); + function Get(Index: Integer): WideString; virtual; abstract; + function GetCapacity: Integer; virtual; + function GetCount: Integer; virtual; abstract; + function GetObject(Index: Integer): TObject; virtual; + function GetTextStr: WideString; virtual; + procedure Put(Index: Integer; const S: WideString); virtual; abstract; + procedure PutObject(Index: Integer; AObject: TObject); virtual; abstract; + procedure SetCapacity(NewCapacity: Integer); virtual; + procedure SetUpdateState(Updating: Boolean); virtual; + procedure SetLanguage(Value: LCID); virtual; + public + constructor Create; + + function Add(const S: WideString): Integer; virtual; + function AddObject(const S: WideString; AObject: TObject): Integer; virtual; + procedure Append(const S: WideString); + procedure AddStrings(Strings: TStrings); overload; virtual; + procedure AddStrings(Strings: TWideStrings); overload; virtual; + procedure Assign(Source: TPersistent); override; + procedure AssignTo(Dest: TPersistent); override; + procedure BeginUpdate; + procedure Clear; virtual; abstract; + procedure Delete(Index: Integer); virtual; abstract; + procedure EndUpdate; + function Equals(Strings: TWideStrings): Boolean; {$IFDEF RTL200_UP} reintroduce; {$ENDIF RTL200_UP} + procedure Exchange(Index1, Index2: Integer); virtual; + function GetSeparatedText(Separators: WideString): WideString; virtual; + function GetText: PWideChar; virtual; + function IndexOf(const S: WideString): Integer; virtual; + function IndexOfName(const Name: WideString): Integer; + function IndexOfObject(AObject: TObject): Integer; + procedure Insert(Index: Integer; const S: WideString); virtual; abstract; + procedure InsertObject(Index: Integer; const S: WideString; AObject: TObject); + procedure LoadFromFile(const FileName: TFileName); virtual; + procedure LoadFromStream(Stream: TStream); virtual; + procedure Move(CurIndex, NewIndex: Integer); virtual; + procedure SaveToFile(const FileName: TFileName); virtual; + procedure SaveToStream(Stream: TStream; WithBOM: Boolean = True); virtual; + procedure SetText(const Value: WideString); virtual; + + property Capacity: Integer read GetCapacity write SetCapacity; + property CommaText: WideString read GetCommaText write SetCommaText; + property Count: Integer read GetCount; + property Language: LCID read FLanguage write SetLanguage; + property Names[Index: Integer]: WideString read GetName; + property NormalizationForm: TNormalizationForm read FNormalizationForm write SetNormalizationForm default nfC; + property Objects[Index: Integer]: TObject read GetObject write PutObject; + property Values[const Name: WideString]: WideString read GetValue write SetValue; + property Saved: Boolean read FSaved; + property SaveUnicode: Boolean read GetSaveUnicode write SetSaveUnicode default True; + property SaveFormat: TSaveFormat read FSaveFormat write FSaveFormat default sfUnicodeLSB; + property Strings[Index: Integer]: WideString read Get write Put; default; + property Text: WideString read GetTextStr write SetText; + + property OnConfirmConversion: TConfirmConversionEvent read FOnConfirmConversion write FOnConfirmConversion; + end; + + //----- TWideStringList class + TWideStringItem = record + {$IFDEF OWN_WIDESTRING_MEMMGR} + FString: PWideChar; // "array of WideChar"; + {$ELSE ~OWN_WIDESTRING_MEMMGR} + FString: WideString; + {$ENDIF ~OWN_WIDESTRING_MEMMGR} + FObject: TObject; + end; + + TWideStringItemList = array of TWideStringItem; + + TWideStringList = class(TWideStrings) + private + FList: TWideStringItemList; + FCount: Integer; + FSorted: Boolean; + FDuplicates: TDuplicates; + FOnChange: TNotifyEvent; + FOnChanging: TNotifyEvent; + procedure ExchangeItems(Index1, Index2: Integer); + procedure Grow; + procedure QuickSort(L, R: Integer); + procedure InsertItem(Index: Integer; const S: WideString); + procedure SetSorted(Value: Boolean); + {$IFDEF OWN_WIDESTRING_MEMMGR} + procedure SetListString(Index: Integer; const S: WideString); + {$ENDIF OWN_WIDESTRING_MEMMGR} + protected + procedure Changed; virtual; + procedure Changing; virtual; + function Get(Index: Integer): WideString; override; + function GetCapacity: Integer; override; + function GetCount: Integer; override; + function GetObject(Index: Integer): TObject; override; + procedure Put(Index: Integer; const S: WideString); override; + procedure PutObject(Index: Integer; AObject: TObject); override; + procedure SetCapacity(NewCapacity: Integer); override; + procedure SetUpdateState(Updating: Boolean); override; + procedure SetLanguage(Value: LCID); override; + public + destructor Destroy; override; + + function Add(const S: WideString): Integer; override; + procedure Clear; override; + procedure Delete(Index: Integer); override; + procedure Exchange(Index1, Index2: Integer); override; + function Find(const S: WideString; var Index: Integer): Boolean; virtual; + function IndexOf(const S: WideString): Integer; override; + procedure Insert(Index: Integer; const S: WideString); override; + procedure Sort; virtual; + + property Duplicates: TDuplicates read FDuplicates write FDuplicates; + property Sorted: Boolean read FSorted write SetSorted; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property OnChanging: TNotifyEvent read FOnChanging write FOnChanging; + end; + +{$ENDIF ~UNICODE_RTL_DATABASE} + +{ +// all these functions are now in JclWideStrings.pas +function StrLenW(Str: PWideChar): SizeInt; +function StrEndW(Str: PWideChar): PWideChar; +function StrMoveW(Dest, Source: PWideChar; Count: SizeInt): PWideChar; +function StrCopyW(Dest, Source: PWideChar): PWideChar; +function StrECopyW(Dest, Source: PWideChar): PWideChar; +function StrLCopyW(Dest, Source: PWideChar; MaxLen: SizeInt): PWideChar; +function StrPCopyWW(Dest: PWideChar; const Source: WideString): PWideChar; overload; +function StrPCopyW(Dest: PWideChar; const Source: AnsiString): PWideChar; +function StrPLCopyWW(Dest: PWideChar; const Source: WideString; MaxLen: SizeInt): PWideChar; +function StrPLCopyW(Dest: PWideChar; const Source: AnsiString; MaxLen: SizeInt): PWideChar; +function StrCatW(Dest: PWideChar; const Source: PWideChar): PWideChar; +function StrLCatW(Dest, Source: PWideChar; MaxLen: SizeInt): PWideChar; +function StrCompW(const Str1, Str2: PWideChar): Integer; +function StrICompW(const Str1, Str2: PWideChar): Integer; +function StrLCompW(const Str1, Str2: PWideChar; MaxLen: SizeInt): Integer; +function StrLICompW(const Str1, Str2: PWideChar; MaxLen: SizeInt): Integer; +function StrNScanW(const Str1, Str2: PWideChar): SizeInt; +function StrRNScanW(const Str1, Str2: PWideChar): SizeInt; +function StrScanW(Str: PWideChar; Chr: WideChar): PWideChar; overload; +function StrScanW(Str: PWideChar; Chr: WideChar; StrLen: SizeInt): PWideChar; overload; +function StrRScanW(Str: PWideChar; Chr: WideChar): PWideChar; +function StrPosW(Str, SubStr: PWideChar): PWideChar; +function StrAllocW(WideSize: SizeInt): PWideChar; +function StrBufSizeW(const Str: PWideChar): SizeInt; +function StrNewW(const Str: PWideChar): PWideChar; overload; +function StrNewW(const Str: WideString): PWideChar; overload; +procedure StrDisposeW(Str: PWideChar); +procedure StrDisposeAndNilW(var Str: PWideChar); +procedure StrSwapByteOrder(Str: PWideChar); +} + +// functions involving Delphi wide strings +function WideAdjustLineBreaks(const S: WideString): WideString; +function WideCharPos(const S: WideString; const Ch: WideChar; const Index: SizeInt): SizeInt; //az +{$IFNDEF UNICODE_RTL_DATABASE} +function WideCompose(const S: WideString; Compatible: Boolean = True): WideString; overload; +function WideCompose(const S: WideString; Tags: TCompatibilityFormattingTags): WideString; overload; +function WideDecompose(const S: WideString; Compatible: Boolean = True): WideString; overload; +function WideDecompose(const S: WideString; Tags: TCompatibilityFormattingTags): WideString; overload; +{$ENDIF ~UNICODE_RTL_DATABASE} +function WideExtractQuotedStr(var Src: PWideChar; Quote: WideChar): WideString; +function WideQuotedStr(const S: WideString; Quote: WideChar): WideString; +function WideStringOfChar(C: WideChar; Count: SizeInt): WideString; + +// case conversion function +type + TCaseType = (ctFold, ctLower, ctTitle, ctUpper); + +{$IFNDEF UNICODE_RTL_DATABASE} +function WideNormalize(const S: WideString; Form: TNormalizationForm): WideString; + +function WideCaseConvert(C: WideChar; CaseType: TCaseType): WideString; overload; +function WideCaseConvert(const S: WideString; CaseType: TCaseType): WideString; overload; +function WideCaseFolding(C: WideChar): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +function WideCaseFolding(const S: WideString): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +function WideTitleCase(C: WideChar): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +function WideTitleCase(const S: WideString): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +{$ENDIF ~UNICODE_RTL_DATABASE} +function WideLowerCase(C: WideChar): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +function WideLowerCase(const S: WideString): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +function WideUpperCase(C: WideChar): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} +function WideUpperCase(const S: WideString): WideString; overload; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} + +function WideSameText(const Str1, Str2: WideString): Boolean; +function WideTrim(const S: WideString): WideString; +function WideTrimLeft(const S: WideString): WideString; +function WideTrimRight(const S: WideString): WideString; + +type + // result type for number retrieval functions + TUcNumber = record + Numerator, + Denominator: Integer; + end; + +// Low level character routines +{$IFNDEF UNICODE_RTL_DATABASE} +function UnicodeNumberLookup(Code: UCS4; var Number: TUcNumber): Boolean; +function UnicodeCompose(const Codes: array of UCS4; out Composite: UCS4; Compatible: Boolean = True): Integer; overload; +function UnicodeCompose(const Codes: array of UCS4; out Composite: UCS4; Tags: TCompatibilityFormattingTags): Integer; overload; +function UnicodeCaseFold(Code: UCS4): TUCS4Array; +function UnicodeDecompose(Code: UCS4; Compatible: Boolean = True): TUCS4Array; overload; +function UnicodeDecompose(Code: UCS4; Tags: TCompatibilityFormattingTags): TUCS4Array; overload; +function UnicodeToTitle(Code: UCS4): TUCS4Array; +{$ENDIF ~UNICODE_RTL_DATABASE} +function UnicodeToUpper(Code: UCS4): TUCS4Array; +function UnicodeToLower(Code: UCS4): TUCS4Array; + +// Character test routines +function UnicodeIsAlpha(C: UCS4): Boolean; +function UnicodeIsDigit(C: UCS4): Boolean; +function UnicodeIsAlphaNum(C: UCS4): Boolean; +function UnicodeIsNumberOther(C: UCS4): Boolean; +function UnicodeIsCased(C: UCS4): Boolean; +function UnicodeIsControl(C: UCS4): Boolean; +function UnicodeIsSpace(C: UCS4): Boolean; +function UnicodeIsWhiteSpace(C: UCS4): Boolean; +function UnicodeIsBlank(C: UCS4): Boolean; +function UnicodeIsPunctuation(C: UCS4): Boolean; +function UnicodeIsGraph(C: UCS4): Boolean; +function UnicodeIsPrintable(C: UCS4): Boolean; +function UnicodeIsUpper(C: UCS4): Boolean; +function UnicodeIsLower(C: UCS4): Boolean; +function UnicodeIsTitle(C: UCS4): Boolean; +{$IFNDEF UNICODE_RTL_DATABASE} +function UnicodeIsHexDigit(C: UCS4): Boolean; +{$ENDIF ~UNICODE_RTL_DATABASE} +function UnicodeIsIsoControl(C: UCS4): Boolean; +function UnicodeIsFormatControl(C: UCS4): Boolean; +function UnicodeIsSymbol(C: UCS4): Boolean; +function UnicodeIsNumber(C: UCS4): Boolean; +function UnicodeIsNonSpacing(C: UCS4): Boolean; +function UnicodeIsOpenPunctuation(C: UCS4): Boolean; +function UnicodeIsClosePunctuation(C: UCS4): Boolean; +function UnicodeIsInitialPunctuation(C: UCS4): Boolean; +function UnicodeIsFinalPunctuation(C: UCS4): Boolean; +{$IFNDEF UNICODE_RTL_DATABASE} +function UnicodeIsComposed(C: UCS4): Boolean; +function UnicodeIsQuotationMark(C: UCS4): Boolean; +function UnicodeIsSymmetric(C: UCS4): Boolean; +function UnicodeIsMirroring(C: UCS4): Boolean; +function UnicodeIsNonBreaking(C: UCS4): Boolean; + +// Directionality functions +function UnicodeIsRightToLeft(C: UCS4): Boolean; +function UnicodeIsLeftToRight(C: UCS4): Boolean; +function UnicodeIsStrong(C: UCS4): Boolean; +function UnicodeIsWeak(C: UCS4): Boolean; +function UnicodeIsNeutral(C: UCS4): Boolean; +function UnicodeIsSeparator(C: UCS4): Boolean; + +// Other character test functions +function UnicodeIsMark(C: UCS4): Boolean; +function UnicodeIsModifier(C: UCS4): Boolean; +{$ENDIF ~UNICODE_RTL_DATABASE} +function UnicodeIsLetterNumber(C: UCS4): Boolean; +function UnicodeIsConnectionPunctuation(C: UCS4): Boolean; +function UnicodeIsDash(C: UCS4): Boolean; +function UnicodeIsMath(C: UCS4): Boolean; +function UnicodeIsCurrency(C: UCS4): Boolean; +function UnicodeIsModifierSymbol(C: UCS4): Boolean; +function UnicodeIsSpacingMark(C: UCS4): Boolean; +function UnicodeIsEnclosing(C: UCS4): Boolean; +function UnicodeIsPrivate(C: UCS4): Boolean; +function UnicodeIsSurrogate(C: UCS4): Boolean; +function UnicodeIsLineSeparator(C: UCS4): Boolean; +function UnicodeIsParagraphSeparator(C: UCS4): Boolean; +function UnicodeIsIdentifierStart(C: UCS4): Boolean; +function UnicodeIsIdentifierPart(C: UCS4): Boolean; +function UnicodeIsDefined(C: UCS4): Boolean; +function UnicodeIsUndefined(C: UCS4): Boolean; +function UnicodeIsHan(C: UCS4): Boolean; +function UnicodeIsHangul(C: UCS4): Boolean; + +function UnicodeIsUnassigned(C: UCS4): Boolean; +function UnicodeIsLetterOther(C: UCS4): Boolean; +function UnicodeIsConnector(C: UCS4): Boolean; +function UnicodeIsPunctuationOther(C: UCS4): Boolean; +function UnicodeIsSymbolOther(C: UCS4): Boolean; +{$IFNDEF UNICODE_RTL_DATABASE} +function UnicodeIsLeftToRightEmbedding(C: UCS4): Boolean; +function UnicodeIsLeftToRightOverride(C: UCS4): Boolean; +function UnicodeIsRightToLeftArabic(C: UCS4): Boolean; +function UnicodeIsRightToLeftEmbedding(C: UCS4): Boolean; +function UnicodeIsRightToLeftOverride(C: UCS4): Boolean; +function UnicodeIsPopDirectionalFormat(C: UCS4): Boolean; +function UnicodeIsEuropeanNumber(C: UCS4): Boolean; +function UnicodeIsEuropeanNumberSeparator(C: UCS4): Boolean; +function UnicodeIsEuropeanNumberTerminator(C: UCS4): Boolean; +function UnicodeIsArabicNumber(C: UCS4): Boolean; +function UnicodeIsCommonNumberSeparator(C: UCS4): Boolean; +function UnicodeIsBoundaryNeutral(C: UCS4): Boolean; +function UnicodeIsSegmentSeparator(C: UCS4): Boolean; +function UnicodeIsOtherNeutrals(C: UCS4): Boolean; +function UnicodeIsASCIIHexDigit(C: UCS4): Boolean; +function UnicodeIsBidiControl(C: UCS4): Boolean; +function UnicodeIsDeprecated(C: UCS4): Boolean; +function UnicodeIsDiacritic(C: UCS4): Boolean; +function UnicodeIsExtender(C: UCS4): Boolean; +function UnicodeIsHyphen(C: UCS4): Boolean; +function UnicodeIsIdeographic(C: UCS4): Boolean; +function UnicodeIsIDSBinaryOperator(C: UCS4): Boolean; +function UnicodeIsIDSTrinaryOperator(C: UCS4): Boolean; +function UnicodeIsJoinControl(C: UCS4): Boolean; +function UnicodeIsLogicalOrderException(C: UCS4): Boolean; +function UnicodeIsNonCharacterCodePoint(C: UCS4): Boolean; +function UnicodeIsOtherAlphabetic(C: UCS4): Boolean; +function UnicodeIsOtherDefaultIgnorableCodePoint(C: UCS4): Boolean; +function UnicodeIsOtherGraphemeExtend(C: UCS4): Boolean; +function UnicodeIsOtherIDContinue(C: UCS4): Boolean; +function UnicodeIsOtherIDStart(C: UCS4): Boolean; +function UnicodeIsOtherLowercase(C: UCS4): Boolean; +function UnicodeIsOtherMath(C: UCS4): Boolean; +function UnicodeIsOtherUppercase(C: UCS4): Boolean; +function UnicodeIsPatternSyntax(C: UCS4): Boolean; +function UnicodeIsPatternWhiteSpace(C: UCS4): Boolean; +function UnicodeIsRadical(C: UCS4): Boolean; +function UnicodeIsSoftDotted(C: UCS4): Boolean; +function UnicodeIsSTerm(C: UCS4): Boolean; +function UnicodeIsTerminalPunctuation(C: UCS4): Boolean; +function UnicodeIsUnifiedIdeograph(C: UCS4): Boolean; +function UnicodeIsVariationSelector(C: UCS4): Boolean; +{$ENDIF ~UNICODE_RTL_DATABASE} + +// Utility functions +function CharSetFromLocale(Language: LCID): Byte; +function GetCharSetFromLocale(Language: LCID; out FontCharSet: Byte): Boolean; +function CodePageFromLocale(Language: LCID): Word; +function CodeBlockName(const CB: TUnicodeBlock): string; +function CodeBlockRange(const CB: TUnicodeBlock): TUnicodeBlockRange; +function CodeBlockFromChar(const C: UCS4): TUnicodeBlock; +function KeyboardCodePage: Word; +function KeyUnicode(C: Char): WideChar; +function StringToWideStringEx(const S: AnsiString; CodePage: Word): WideString; +function TranslateString(const S: AnsiString; CP1, CP2: Word): AnsiString; +function WideStringToStringEx(const WS: WideString; CodePage: Word): AnsiString; + +type + TCompareFunc = function (const W1, W2: WideString; Locale: LCID): Integer; + +var + WideCompareText: TCompareFunc; + +type + EJclUnicodeError = class(EJclError); + +// functions to load Unicode data from resource +procedure LoadCharacterCategories; +procedure LoadCaseMappingData; +procedure LoadDecompositionData; +procedure LoadCombiningClassData; +procedure LoadNumberData; +procedure LoadCompositionData; + +// functions around TUCS4Array +function UCS4Array(Ch: UCS4): TUCS4Array; +function UCS4ArrayConcat(Left, Right: UCS4): TUCS4Array; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +procedure UCS4ArrayConcat(var Left: TUCS4Array; Right: UCS4); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +procedure UCS4ArrayConcat(var Left: TUCS4Array; const Right: TUCS4Array); overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function UCS4ArrayEquals(const Left: TUCS4Array; const Right: TUCS4Array): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function UCS4ArrayEquals(const Left: TUCS4Array; Right: UCS4): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function UCS4ArrayEquals(const Left: TUCS4Array; const Right: AnsiString): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function UCS4ArrayEquals(const Left: TUCS4Array; Right: AnsiChar): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +// Unicode data for case mapping, decomposition, numbers etc. This data is +// loaded on demand which means only those parts will be put in memory which are +// needed by one of the lookup functions. +// Note: There is a little tool called UDExtract which creates a resouce script from +// the Unicode database file which can be compiled to the needed res file. +// This tool, including its source code, can be downloaded from www.lischke-online.de/Unicode.html. + +{$IFNDEF UNICODE_RTL_DATABASE} +{$IFDEF UNICODE_RAW_DATA} +{$R JclUnicode.res} +{$ENDIF UNICODE_RAW_DATA} +{$IFDEF UNICODE_BZIP2_DATA} +{$R JclUnicodeBZip2.res} +{$ENDIF UNICODE_BZIP2_DATA} +{$IFDEF UNICODE_ZLIB_DATA} +{$R JclUnicodeZLib.res} +{$ENDIF UNICODE_ZLIB_DATA} +{$ENDIF ~UNICODE_RTL_DATABASE} + +uses + {$IFDEF HAS_UNIT_RTLCONSTS} + {$IFDEF HAS_UNITSCOPE} + System.RtlConsts, + {$ELSE ~HAS_UNITSCOPE} + RtlConsts, + {$ENDIF ~HAS_UNITSCOPE} + {$ENDIF HAS_UNIT_RTLCONSTS} + {$IFNDEF UNICODE_RTL_DATABASE} + {$IFDEF UNICODE_BZIP2_DATA} + BZip2, + {$ENDIF UNICODE_BZIP2_DATA} + {$IFDEF UNICODE_ZLIB_DATA} + ZLibh, + {$ENDIF UNICODE_ZLIB_DATA} + JclStreams, + {$IFNDEF UNICODE_RAW_DATA} + JclCompression, + {$ENDIF ~UNICODE_RAW_DATA} + {$ENDIF ~UNICODE_RTL_DATABASE} + JclResources, JclSynch, JclSysUtils, JclSysInfo, JclStringConversions, JclWideStrings; + +const + {$IFDEF FPC} // declarations from unit [Rtl]Consts + SDuplicateString = 'String list does not allow duplicates'; + SListIndexError = 'List index out of bounds (%d)'; + SSortedListError = 'Operation not allowed on sorted string list'; + {$ENDIF FPC} + // some predefined sets to shorten parameter lists below and ease repeative usage + ClassLetter = [ccLetterUppercase, ccLetterLowercase, ccLetterTitlecase, ccLetterModifier, ccLetterOther]; + ClassSpace = [ccSeparatorSpace]; + ClassPunctuation = [ccPunctuationConnector, ccPunctuationDash, ccPunctuationOpen, ccPunctuationClose, + ccPunctuationOther, ccPunctuationInitialQuote, ccPunctuationFinalQuote]; + ClassMark = [ccMarkNonSpacing, ccMarkSpacingCombining, ccMarkEnclosing]; + ClassNumber = [ccNumberDecimalDigit, ccNumberLetter, ccNumberOther]; + ClassSymbol = [ccSymbolMath, ccSymbolCurrency, ccSymbolModifier, ccSymbolOther]; + ClassEuropeanNumber = [ccEuropeanNumber, ccEuropeanNumberSeparator, ccEuropeanNumberTerminator]; + + // used to negate a set of categories + ClassAll = [Low(TCharacterCategory)..High(TCharacterCategory)]; + +{$IFDEF HAS_UNIT_CHARACTER} +function CharacterCategoriesToUnicodeCategory(const Categories: TCharacterCategories): TUnicodeCategory; +var + Category: TCharacterUnicodeCategory; +begin + for Category := Low(TCharacterUnicodeCategory) to High(TCharacterUnicodeCategory) do + if Category in Categories then + begin + Result := CharacterCategoryToUnicodeCategory[Category]; + Exit; + end; + Result := TUnicodeCategory.ucUnassigned; +end; + +function UnicodeCategoryToCharacterCategories(Category: TUnicodeCategory): TCharacterCategories; +begin + Result := []; + Include(Result, UnicodeCategoryToCharacterCategory[Category]); +end; +{$ENDIF HAS_UNIT_CHARACTER} + +{$IFDEF UNICODE_RTL_DATABASE} +procedure LoadCharacterCategories; +begin + // do nothing, the RTL database is already loaded +end; + +procedure LoadCaseMappingData; +begin + // do nothing, the RTL database is already loaded +end; + +procedure LoadDecompositionData; +begin + // do nothing, the RTL database is already loaded +end; + +procedure LoadCombiningClassData; +begin + // do nothing, the RTL database is already loaded +end; + +procedure LoadNumberData; +begin + // do nothing, the RTL database is already loaded +end; + +procedure LoadCompositionData; +begin + // do nothing, the RTL database is already loaded +end; +{$ELSE ~UNICODE_RTL_DATABASE} +var + // As the global data can be accessed by several threads it should be guarded + // while the data is loaded. + LoadInProgress: TJclCriticalSection; + +function OpenResourceStream(const ResName: string): TJclEasyStream; +var + ResourceStream: TStream; + {$IFNDEF UNICODE_RAW_DATA} + DecompressionStream: TStream; + RawStream: TMemoryStream; + {$ENDIF ~UNICODE_RAW_DATA} +begin + ResourceStream := TResourceStream.Create(HInstance, ResName, 'UNICODEDATA'); + {$IFDEF UNICODE_RAW_DATA} + Result := TJclEasyStream.Create(ResourceStream, True); + {$ENDIF UNICODE_RAW_DATA} + {$IFDEF UNICODE_BZIP2_DATA} + try + LoadBZip2; + DecompressionStream := TJclBZIP2DecompressionStream.Create(ResourceStream); + try + RawStream := TMemoryStream.Create; + StreamCopy(DecompressionStream, RawStream); + RawStream.Seek(0, soBeginning); + Result := TJclEasyStream.Create(RawStream, True); + finally + DecompressionStream.Free; + end; + finally + ResourceStream.Free; + end; + {$ENDIF UNICODE_BZIP2_DATA} + {$IFDEF UNICODE_ZLIB_DATA} + try + LoadZLib; + DecompressionStream := TJclZLibDecompressStream.Create(ResourceStream); + try + RawStream := TMemoryStream.Create; + StreamCopy(DecompressionStream, RawStream); + RawStream.Seek(0, soBeginning); + Result := TJclEasyStream.Create(RawStream, True); + finally + DecompressionStream.Free; + end; + finally + ResourceStream.Free; + end; + {$ENDIF UNICODE_ZLIB_DATA} +end; + +function StreamReadChar(Stream: TStream): Cardinal; +begin + Result := 0; + Stream.ReadBuffer(Result, 3); +end; + +//----------------- support for character categories ----------------------------------------------- + +// Character category data is quite a large block since every defined character in Unicode is assigned at least +// one category. Because of this we cannot use a sparse matrix to provide quick access as implemented for +// e.g. composition data. +// The approach used here is based on the fact that an application seldomly uses all characters defined in Unicode +// simultanously. In fact the opposite is true. Most application will use either Western Europe or Arabic or +// Far East character data, but very rarely all together. Based on this fact is the implementation of virtual +// memory using the systems paging file (aka file mapping) to load only into virtual memory what is used currently. +// The implementation is not yet finished and needs a lot of improvements yet. + +type + // start and stop of a range of code points + TRange = record + Start, + Stop: Cardinal; + end; + + TRangeArray = array of TRange; + TCategoriesArray = array of array of TCharacterCategories; + +var + // character categories, stored in the system's swap file and mapped on demand + CategoriesLoaded: Boolean; + Categories: array [Byte] of TCategoriesArray; + +procedure LoadCharacterCategories; +// Loads the character categories data (as saved by the Unicode database extractor, see also +// the comments about JclUnicode.res above). +var + Size: Integer; + Stream: TJclEasyStream; + Category: TCharacterCategory; + Buffer: TRangeArray; + First, Second, Third: Byte; + J, K: Integer; +begin + // make sure no other code is currently modifying the global data area + LoadInProgress.Enter; + try + // Data already loaded? + if not CategoriesLoaded then + begin + Stream := OpenResourceStream('CATEGORIES'); + try + while Stream.Position < Stream.Size do + begin + // a) read which category is current in the stream + Category := TCharacterCategory(Stream.ReadByte); + // b) read the size of the ranges and the ranges themself + Size := Stream.ReadInteger; + if Size > 0 then + begin + SetLength(Buffer, Size); + for J := 0 to Size - 1 do + begin + Buffer[J].Start := StreamReadChar(Stream); + Buffer[J].Stop := StreamReadChar(Stream); + end; + + // c) go through every range and add the current category to each code point + for J := 0 to Size - 1 do + for K := Buffer[J].Start to Buffer[J].Stop do + begin + Assert(K < $1000000, LoadResString(@RsCategoryUnicodeChar)); + + First := (K shr 16) and $FF; + Second := (K shr 8) and $FF; + Third := K and $FF; + // add second step array if not yet done + if Categories[First] = nil then + SetLength(Categories[First], 256); + if Categories[First, Second] = nil then + SetLength(Categories[First, Second], 256); + // The array is allocated on the exact size, but the compiler generates + // a 32 bit "BTS" instruction that accesses memory beyond the allocated block. + if Third < 255 then + Include(Categories[First, Second, Third], Category) + else + Categories[First, Second, Third] := Categories[First, Second, Third] + [Category]; + end; + end; + end; + // Assert(Stream.Position = Stream.Size); + finally + Stream.Free; + CategoriesLoaded := True; + end; + end; + finally + LoadInProgress.Leave; + end; +end; + +function CategoryLookup(Code: Cardinal; Cats: TCharacterCategories): Boolean; overload; +// determines whether the Code is in the given category +var + First, Second, Third: Byte; +begin + Assert(Code < $1000000, LoadResString(@RsCategoryUnicodeChar)); + + // load property data if not already done + if not CategoriesLoaded then + LoadCharacterCategories; + + First := (Code shr 16) and $FF; + Second := (Code shr 8) and $FF; + Third := Code and $FF; + if (Categories[First] <> nil) and (Categories[First, Second] <> nil) then + Result := Categories[First, Second, Third] * Cats <> [] + else + Result := False; +end; + +//----------------- support for case mapping ------------------------------------------------------- + +type + TCase = array [TCaseType] of TUCS4Array; // mapping for case fold, lower, title and upper in this order + TCaseArray = array of array of TCase; + +var + // An array for all case mappings (including 1 to many casing if saved by the extraction program). + // The organization is a sparse, two stage matrix. + // SingletonMapping is to quickly return a single default mapping. + CaseDataLoaded: Boolean; + CaseMapping: array [Byte] of TCaseArray; + +procedure LoadCaseMappingData; +var + Stream: TJclEasyStream; + I, J, Code, Size: Integer; + First, Second, Third: Byte; +begin + // make sure no other code is currently modifying the global data area + LoadInProgress.Enter; + try + if not CaseDataLoaded then + begin + Stream := OpenResourceStream('CASE'); + try + // the first entry in the stream is the number of entries in the case mapping table + Size := Stream.ReadInteger; + for I := 0 to Size - 1 do + begin + // a) read actual code point + Code := StreamReadChar(Stream); + Assert(Code < $1000000, LoadResString(@RsCasedUnicodeChar)); + + // if there is no high byte entry in the first stage table then create one + First := (Code shr 16) and $FF; + Second := (Code shr 8) and $FF; + Third := Code and $FF; + if CaseMapping[First] = nil then + SetLength(CaseMapping[First], 256); + if CaseMapping[First, Second] = nil then + SetLength(CaseMapping[First, Second], 256); + + // b) read fold case array + Size := Stream.ReadByte; + if Size > 0 then + begin + SetLength(CaseMapping[First, Second, Third, ctFold], Size); + for J := 0 to Size - 1 do + CaseMapping[First, Second, Third, ctFold, J] := StreamReadChar(Stream); + end; + // c) read lower case array + Size := Stream.ReadByte; + if Size > 0 then + begin + SetLength(CaseMapping[First, Second, Third, ctLower], Size); + for J := 0 to Size - 1 do + CaseMapping[First, Second, Third, ctLower, J] := StreamReadChar(Stream); + end; + // d) read title case array + Size := Stream.ReadByte; + if Size > 0 then + begin + SetLength(CaseMapping[First, Second, Third, ctTitle], Size); + for J := 0 to Size - 1 do + CaseMapping[First, Second, Third, ctTitle, J] := StreamReadChar(Stream); + end; + // e) read upper case array + Size := Stream.ReadByte; + if Size > 0 then + begin + SetLength(CaseMapping[First, Second, Third, ctUpper], Size); + for J := 0 to Size - 1 do + CaseMapping[First, Second, Third, ctUpper, J] := StreamReadChar(Stream); + end; + end; + Assert(Stream.Position = Stream.Size); + finally + Stream.Free; + CaseDataLoaded := True; + end; + end; + finally + LoadInProgress.Leave; + end; +end; + +function CaseLookup(Code: Cardinal; CaseType: TCaseType; var Mapping: TUCS4Array): Boolean; +// Performs a lookup of the given code; returns True if Found, with Mapping referring to the mapping. +// ctFold is handled specially: if no mapping is found then result of looking up ctLower +// is returned +var + First, Second, Third: Byte; +begin + Assert(Code < $1000000, LoadResString(@RsCasedUnicodeChar)); + + // load case mapping data if not already done + if not CaseDataLoaded then + LoadCaseMappingData; + + First := (Code shr 16) and $FF; + Second := (Code shr 8) and $FF; + Third := Code and $FF; + // Check first stage table whether there is a mapping for a particular block and + // (if so) then whether there is a mapping or not. + if (CaseMapping[First] <> nil) and (CaseMapping[First, Second] <> nil) and + (CaseMapping[First, Second, Third, CaseType] <> nil) then + Mapping := CaseMapping[First, Second, Third, CaseType] + else + Mapping := nil; + Result := Assigned(Mapping); + // defer to lower case if no fold case exists + if not Result and (CaseType = ctFold) and (CaseMapping[First] <> nil) and + (CaseMapping[First, Second] <> nil) and (CaseMapping[First, Second, Third, ctLower] <> nil) then + begin + Mapping := CaseMapping[First, Second, Third, ctLower]; + Result := Assigned(Mapping); + end; +end; + +function UnicodeCaseFold(Code: UCS4): TUCS4Array; +// This function returnes an array of special case fold mappings if there is one defined for the given +// code, otherwise the lower case will be returned. This all applies only to cased code points. +// Uncased code points are returned unchanged. +begin + SetLength(Result, 0); + if not CaseLookup(Code, ctFold, Result) then + begin + SetLength(Result, 1); + Result[0] := Code; + end; +end; + +{$ENDIF ~UNICODE_RTL_DATABASE} + +function UnicodeToUpper(Code: UCS4): TUCS4Array; +begin + {$IFDEF UNICODE_RTL_DATABASE} + SetLength(Result, 1); + Result[0] := Ord(TCharacter.ToUpper(Chr(Code))); + {$ELSE ~UNICODE_RTL_DATABASE} + SetLength(Result, 0); + if not CaseLookup(Code, ctUpper, Result) then + begin + SetLength(Result, 1); + Result[0] := Code; + end; + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeToLower(Code: UCS4): TUCS4Array; +begin + {$IFDEF UNICODE_RTL_DATABASE} + SetLength(Result, 1); + Result[0] := Ord(TCharacter.ToLower(Chr(Code))); + {$ELSE ~UNICODE_RTL_DATABASE} + SetLength(Result, 0); + if not CaseLookup(Code, ctLower, Result) then + begin + SetLength(Result, 1); + Result[0] := Code; + end; + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +{$IFNDEF UNICODE_RTL_DATABASE} + +function UnicodeToTitle(Code: UCS4): TUCS4Array; +begin + SetLength(Result, 0); + if not CaseLookup(Code, ctTitle, Result) then + begin + SetLength(Result, 1); + Result[0] := Code; + end; +end; + +//----------------- support for decomposition ------------------------------------------------------ + +const + // constants for hangul composition and hangul-to-jamo decomposition + SBase = $AC00; // hangul syllables start code point + LBase = $1100; // leading syllable + VBase = $1161; + TBase = $11A7; // trailing syllable + LCount = 19; + VCount = 21; + TCount = 28; + NCount = VCount * TCount; // 588 + SCount = LCount * NCount; // 11172 + +type + TDecomposition = record + Tag: TCompatibilityFormattingTag; + Leaves: TUCS4Array; + end; + TDecompositions = array of array of TDecomposition; + TDecompositionsArray = array [Byte] of TDecompositions; + +var + // list of decompositions, organized (again) as three stage matrix + // Note: there are two tables, one for canonical decompositions and the other one + // for compatibility decompositions. + DecompositionsLoaded: Boolean; + Decompositions: TDecompositionsArray; + +procedure LoadDecompositionData; +var + Stream: TJclEasyStream; + I, J, Code, Size: Integer; + First, Second, Third: Byte; +begin + // make sure no other code is currently modifying the global data area + LoadInProgress.Enter; + try + if not DecompositionsLoaded then + begin + Stream := OpenResourceStream('DECOMPOSITION'); + try + // determine how many decomposition entries we have + Size := Stream.ReadInteger; + for I := 0 to Size - 1 do + begin + Code := StreamReadChar(Stream); + + Assert(Code < $1000000, LoadResString(@RsDecomposedUnicodeChar)); + + First := (Code shr 16) and $FF; + Second := (Code shr 8) and $FF; + Third := Code and $FF; + + // if there is no high byte entry in the first stage table then create one + if Decompositions[First] = nil then + SetLength(Decompositions[First], 256); + if Decompositions[First, Second] = nil then + SetLength(Decompositions[First, Second], 256); + + Size := Stream.ReadByte; + if Size > 0 then + begin + Decompositions[First, Second, Third].Tag := TCompatibilityFormattingTag(Stream.ReadByte); + SetLength(Decompositions[First, Second, Third].Leaves, Size); + for J := 0 to Size - 1 do + Decompositions[First, Second, Third].Leaves[J] := StreamReadChar(Stream); + end; + end; + Assert(Stream.Position = Stream.Size); + finally + Stream.Free; + DecompositionsLoaded := True; + end; + end; + finally + LoadInProgress.Leave; + end; +end; + +function UnicodeDecomposeHangul(Code: UCS4): TUCS4Array; +// algorithmically decomposes hangul character +var + Rest: Integer; +begin + Dec(Code, SBase); + Rest := Code mod TCount; + if Rest = 0 then + SetLength(Result, 2) + else + SetLength(Result, 3); + Result[0] := LBase + (Code div NCount); + Result[1] := VBase + ((Code mod NCount) div TCount); + if Rest <> 0 then + Result[2] := TBase + Rest; +end; + +function UnicodeDecompose(Code: UCS4; Compatible: Boolean): TUCS4Array; +var + First, Second, Third: Byte; +begin + Assert(Code < $1000000, LoadResString(@RsDecomposedUnicodeChar)); + + // load decomposition data if not already done + if not DecompositionsLoaded then + LoadDecompositionData; + + Result := nil; + + // if the code is hangul then decomposition is algorithmically + if UnicodeIsHangul(Code) then + Result := UnicodeDecomposeHangul(Code) + else + begin + First := (Code shr 16) and $FF; + Second := (Code shr 8) and $FF; + Third := Code and $FF; + + if (Decompositions[First] <> nil) and (Decompositions[First, Second] <> nil) + and (Decompositions[First, Second, Third].Leaves <> nil) + and (Compatible or (Decompositions[First, Second, Third].Tag = cftCanonical)) then + Result := Decompositions[First, Second, Third].Leaves + else + Result := nil; + end; +end; + +function UnicodeDecompose(Code: UCS4; Tags: TCompatibilityFormattingTags): TUCS4Array; +var + First, Second, Third: Byte; +begin + Assert(Code < $1000000, LoadResString(@RsDecomposedUnicodeChar)); + + // load decomposition data if not already done + if not DecompositionsLoaded then + LoadDecompositionData; + + Result := nil; + + // if the code is hangul then decomposition is algorithmically + if UnicodeIsHangul(Code) then + Result := UnicodeDecomposeHangul(Code) + else + begin + First := (Code shr 16) and $FF; + Second := (Code shr 8) and $FF; + Third := Code and $FF; + + if (Decompositions[First] <> nil) and (Decompositions[First, Second] <> nil) + and (Decompositions[First, Second, Third].Leaves <> nil) + and (Decompositions[First, Second, Third].Tag in Tags) then + Result := Decompositions[First, Second, Third].Leaves + else + Result := nil; + end; +end; + +//----------------- support for combining classes -------------------------------------------------- + +type + TClassArray = array of array of Byte; + +var + // canonical combining classes, again as two stage matrix + CCCsLoaded: Boolean; + CCCs: array [Byte] of TClassArray; + +procedure LoadCombiningClassData; +var + Stream: TJclEasyStream; + I, J, K, Size: Integer; + Buffer: TRangeArray; + First, Second, Third: Byte; +begin + // make sure no other code is currently modifying the global data area + LoadInProgress.Enter; + try + if not CCCsLoaded then + begin + Stream := OpenResourceStream('COMBINING'); + try + while Stream.Position < Stream.Size do + begin + // a) determine which class is stored here + I := Stream.ReadByte; + // b) determine how many ranges are assigned to this class + Size := Stream.ReadByte; + // c) read start and stop code of each range + if Size > 0 then + begin + SetLength(Buffer, Size); + for J := 0 to Size - 1 do + begin + Buffer[J].Start := StreamReadChar(Stream); + Buffer[J].Stop := StreamReadChar(Stream); + end; + + // d) put this class in every of the code points just loaded + for J := 0 to Size - 1 do + for K := Buffer[J].Start to Buffer[J].Stop do + begin + // (outchy) TODO: handle in a cleaner way + Assert(K < $1000000, LoadResString(@RsCombiningClassUnicodeChar)); + First := (K shr 16) and $FF; + Second := (K shr 8) and $FF; + Third := K and $FF; + // add second step array if not yet done + if CCCs[First] = nil then + SetLength(CCCs[First], 256); + if CCCs[First, Second] = nil then + SetLength(CCCs[First, Second], 256); + CCCs[First, Second, Third] := I; + end; + end; + end; + // Assert(Stream.Position = Stream.Size); + finally + Stream.Free; + CCCsLoaded := True; + end; + end; + finally + LoadInProgress.Leave; + end; +end; + +function CanonicalCombiningClass(Code: Cardinal): Cardinal; +var + First, Second, Third: Byte; +begin + Assert(Code < $1000000, LoadResString(@RsCombiningClassUnicodeChar)); + + // load combining class data if not already done + if not CCCsLoaded then + LoadCombiningClassData; + + First := (Code shr 16) and $FF; + Second := (Code shr 8) and $FF; + Third := Code and $FF; + if (CCCs[First] <> nil) and (CCCs[First, Second] <> nil) then + Result := CCCs[First, Second, Third] + else + Result := 0; +end; + +//----------------- support for numeric values ----------------------------------------------------- + +type + // structures for handling numbers + TCodeIndex = record + Code, + Index: Cardinal; + end; + +var + // array to hold the number equivalents for specific codes + NumberCodesLoaded: Boolean; + NumberCodes: array of TCodeIndex; + // array of numbers used in NumberCodes + Numbers: array of TUcNumber; + +procedure LoadNumberData; +var + Stream: TJclEasyStream; + Size, I: Integer; +begin + // make sure no other code is currently modifying the global data area + LoadInProgress.Enter; + try + if not NumberCodesLoaded then + begin + Stream := OpenResourceStream('NUMBERS'); + try + // Numbers are special (compared to other Unicode data) as they utilize two + // arrays, one containing all used numbers (in nominator-denominator format) and + // another one which maps a code point to one of the numbers in the first array. + + // a) determine size of numbers array + Size := Stream.ReadByte; + SetLength(Numbers, Size); + // b) read numbers data + for I := 0 to Size - 1 do + begin + Numbers[I].Numerator := Stream.ReadInteger; + Numbers[I].Denominator := Stream.ReadInteger; + end; + // c) determine size of index array + Size := Stream.ReadInteger; + SetLength(NumberCodes, Size); + // d) read index data + for I := 0 to Size - 1 do + begin + NumberCodes[I].Code := StreamReadChar(Stream); + NumberCodes[I].Index := Stream.ReadByte; + end; + Assert(Stream.Position = Stream.Size); + finally + Stream.Free; + NumberCodesLoaded := True; + end; + end; + finally + LoadInProgress.Leave; + end; +end; + +function UnicodeNumberLookup(Code: UCS4; var Number: TUcNumber): Boolean; +// Searches for the given code and returns its number equivalent (if there is one). +// Typical cases are: '1/6' (U+2159), '3/8' (U+215C), 'XII' (U+216B) etc. +// Result is set to True if the code could be found. +var + L, R, M: Integer; +begin + // load number data if not already done + if not NumberCodesLoaded then + LoadNumberData; + + Result := False; + L := 0; + R := High(NumberCodes); + while L <= R do + begin + M := (L + R) shr 1; + if Code > NumberCodes[M].Code then + L := M + 1 + else + begin + if Code < NumberCodes[M].Code then + R := M - 1 + else + begin + Number := Numbers[NumberCodes[M].Index]; + Result := True; + Break; + end; + end; + end; +end; + +//----------------- support for composition -------------------------------------------------------- + +type + // maps between a pair of code points to a composite code point + // Note: the source pair is packed into one 4 byte value to speed up search. + TComposition = record + Code: Cardinal; + Tag: TCompatibilityFormattingTag; + First: Cardinal; + Next: array of Cardinal; + end; + +var + // list of composition mappings + CompositionsLoaded: Boolean; + Compositions: array of TComposition; + MaxCompositionSize: Integer; + +procedure LoadCompositionData; +var + Stream: TJclEasyStream; + I, J, Size: Integer; +begin + // make sure no other code is currently modifying the global data area + LoadInProgress.Enter; + try + if not CompositionsLoaded then + begin + Stream := OpenResourceStream('COMPOSITION'); + try + // a) determine size of compositions array + Size := Stream.ReadInteger; + SetLength(Compositions, Size); + // b) read data + for I := 0 to Size - 1 do + begin + Compositions[I].Code := StreamReadChar(Stream); + Size := Stream.ReadByte; + if Size > MaxCompositionSize then + MaxCompositionSize := Size; + SetLength(Compositions[I].Next, Size - 1); + Compositions[I].Tag := TCompatibilityFormattingTag(Stream.ReadByte); + Compositions[I].First := StreamReadChar(Stream); + for J := 0 to Size - 2 do + Compositions[I].Next[J] := StreamReadChar(Stream); + end; + Assert(Stream.Position = Stream.Size); + finally + Stream.Free; + CompositionsLoaded := True; + end; + end; + finally + LoadInProgress.Leave; + end; +end; + +function UnicodeCompose(const Codes: array of UCS4; out Composite: UCS4; Compatible: Boolean): Integer; +// Maps the sequence of Codes (up to MaxCompositionSize codes) to a composite +// Result is the number of Codes that were composed (at least 1 if Codes is not empty) +var + L, R, M, I, HighCodes, HighNext: Integer; +begin + if not CompositionsLoaded then + LoadCompositionData; + + Result := 0; + HighCodes := High(Codes); + + if HighCodes = -1 then + Exit; + + if HighCodes = 0 then + begin + Result := 1; + Composite := Codes[0]; + Exit; + end; + + L := 0; + R := High(Compositions); + + while L <= R do + begin + M := (L + R) shr 1; + if Compositions[M].First > Codes[0] then + R := M - 1 + else + if Compositions[M].First < Codes[0] then + L := M + 1 + else + begin + // back to the first element where Codes[0] = First + while (M > 0) and (Compositions[M-1].First = Codes[0]) do + Dec(M); + + while (M <= High(Compositions)) and (Compositions[M].First = Codes[0]) do + begin + HighNext := High(Compositions[M].Next); + Result := 0; + + if (HighNext < HighCodes) // enough characters in buffer to be tested + and (Compatible or (Compositions[M].Tag = cftCanonical)) then + begin + for I := 0 to HighNext do + if Compositions[M].Next[I] = Codes[I + 1] then + Result := I + 2 { +1 for first, +1 because of 0-based array } + else + Break; + + if Result = HighNext + 2 then // all codes matched + begin + Composite := Compositions[M].Code; + Exit; + end; + end; + + Inc(M); + end; + Break; + end; + end; + Result := 1; + Composite := Codes[0]; +end; + +function UnicodeCompose(const Codes: array of UCS4; out Composite: UCS4; Tags: TCompatibilityFormattingTags): Integer; +// Maps the sequence of Codes (up to MaxCompositionSize codes) to a composite +// Result is the number of Codes that were composed (at least 1 if Codes is not empty) +var + L, R, M, I, HighCodes, HighNext: Integer; +begin + if not CompositionsLoaded then + LoadCompositionData; + + Result := 0; + HighCodes := High(Codes); + + if HighCodes = -1 then + Exit; + + if HighCodes = 0 then + begin + Result := 1; + Composite := Codes[0]; + Exit; + end; + + L := 0; + R := High(Compositions); + + while L <= R do + begin + M := (L + R) shr 1; + if Compositions[M].First > Codes[0] then + R := M - 1 + else + if Compositions[M].First < Codes[0] then + L := M + 1 + else + begin + // back to the first element where Codes[0] = First + while (M > 0) and (Compositions[M-1].First = Codes[0]) do + Dec(M); + + while (M <= High(Compositions)) and (Compositions[M].First = Codes[0]) do + begin + HighNext := High(Compositions[M].Next); + Result := 0; + + if (HighNext < HighCodes) // enough characters in buffer to be tested + and (Compositions[M].Tag in Tags) then + begin + for I := 0 to HighNext do + if Compositions[M].Next[I] = Codes[I + 1] then + Result := I + 2 { +1 for first, +1 because of 0-based array } + else + Break; + + if Result = HighNext + 2 then // all codes matched + begin + Composite := Compositions[M].Code; + Exit; + end; + end; + + Inc(M); + end; + Break; + end; + end; + Result := 1; + Composite := Codes[0]; +end; + +//=== { TSearchEngine } ====================================================== + +constructor TSearchEngine.Create(AOwner: TWideStrings); +begin + inherited Create; + FOwner := AOwner; + FResults := TList.Create; +end; + +destructor TSearchEngine.Destroy; +begin + Clear; + FResults.Free; + inherited Destroy; +end; + +procedure TSearchEngine.AddResult(Start, Stop: SizeInt); +begin + FResults.Add(Pointer(Start)); + FResults.Add(Pointer(Stop)); +end; + +procedure TSearchEngine.Clear; +begin + ClearResults; +end; + +procedure TSearchEngine.ClearResults; +begin + FResults.Clear; +end; + +procedure TSearchEngine.DeleteResult(Index: SizeInt); +// explicitly deletes a search result +begin + with FResults do + begin + // start index + Delete(2 * Index); + // stop index + Delete(2 * Index); + end; +end; + +function TSearchEngine.GetCount: SizeInt; +// returns the number of matches found +begin + Result := FResults.Count div 2; +end; + +procedure TSearchEngine.GetResult(Index: SizeInt; var Start, Stop: SizeInt); +// returns the start position of a match (end position can be determined by +// adding the length of the pattern to the start position) +begin + Start := SizeInt(FResults[2 * Index]); + Stop := SizeInt(FResults[2 * Index + 1]); +end; + +//----------------- TUTBSearch --------------------------------------------------------------------- + +procedure TUTBMSearch.ClearPattern; +begin + FreeMem(FPattern); + FPattern := nil; + FFlags := []; + FPatternUsed := 0; + FPatternSize := 0; + FPatternLength := 0; + FreeMem(FSkipValues); + FSkipValues := nil; + FSkipsUsed := 0; + FMD4 := 0; +end; + +function TUTBMSearch.GetSkipValue(TextStart, TextEnd: PUCS2): SizeInt; +// looks up the SkipValues value for a character +var + I: SizeInt; + C1, + C2: UCS4; + Sp: PUTBMSkip; +begin + Result := 0; + if TJclAddr(TextStart) < TJclAddr(TextEnd) then + begin + C1 := UCS4(TextStart^); + if (TextStart + 1) < TextEnd then + C2 := UCS4((TextStart + 1)^) + else + C2 := $FFFFFFFF; + if (SurrogateHighStart <= C1) and (C1 <= SurrogateHighEnd) and + (SurrogateLowStart <= C2) and (C2 <= $DDDD) then + C1 := $10000 + (((C1 and $03FF) shl 10) or (C2 and $03FF)); + + Sp := FSkipValues; + for I := 0 to FSkipsUsed - 1 do + begin + if not (Boolean(C1 xor Sp.BMChar.UpCase) and + Boolean(C1 xor Sp.BMChar.LoCase) and + Boolean(C1 xor Sp.BMChar.TitleCase)) then + begin + if (TextEnd - TextStart) < Sp.SkipValues then + Result := TextEnd - TextStart + else + Result := Sp.SkipValues; + Exit; + end; + Inc(Sp); + end; + Result := FPatternLength; + end; +end; + +function TUTBMSearch.Match(Text, Start, Stop: PUCS2; var MatchStart, MatchEnd: SizeInt): Boolean; +// Checks once whether the text at position Start (which points to the end of the +// current text part to be matched) matches. +// Note: If whole words only are allowed then the left and right border tests are +// done here too. The keypoint for the right border is that the next character +// after the search string is either the text end or a space character. +// For the left side this is similar, but there is nothing like a string +// start marker (like the string end marker #0). +// +// It seems not obvious, but we still can use the passed Text pointer to do +// the left check. Although this pointer might not point to the real string +// start (e.g. in TUTBMSearch.FindAll Text is incremented as needed) it is +// still a valid check mark. The reason is that Text either points to the +// real string start or a previous match (happened already, keep in mind the +// search options do not change in the FindAll loop) and the character just +// before Text is a space character. +// This fact implies, though, that strings passed to Find (or FindFirst, +// FindAll in TUTBMSearch) always really start at the given address. Although +// this might not be the case in some circumstances (e.g. if you pass only +// the selection from an editor) it is still assumed that a pattern matching +// from the first position on (from the search string start) also matches +// when whole words only are allowed. +var + CheckSpace: Boolean; + C1, C2: UCS4; + Count: SizeInt; + Cp: PUTBMChar; +begin + // be pessimistic + Result := False; + + // set the potential match endpoint first + MatchEnd := (Start - Text) + 1; + + C1 := UCS4(Start^); + if (Start + 1) < Stop then + C2 := UCS4((Start + 1)^) + else + C2 := $FFFFFFFF; + if (SurrogateHighStart <= C1) and (C1 <= SurrogateHighEnd) and + (SurrogateLowStart <= C2) and (C2 <= SurrogateLowEnd) then + begin + C1 := $10000 + (((C1 and $03FF) shl 10) or (C2 and $03FF)); + // Adjust the match end point to occur after the UTF-16 character. + Inc(MatchEnd); + end; + + // check special cases + if FPatternUsed = 1 then + begin + MatchStart := Start - Text; + Result := True; + Exit; + end; + + // Early out if entire words need to be matched and the next character + // in the search string is neither the string end nor a space character. + if (sfWholeWordOnly in FFlags) and + not ((Start + 1)^ = WideNull) and + not UnicodeIsWhiteSpace(UCS4((Start + 1)^)) then + Exit; + + // compare backward + Cp := FPattern; + Inc(Cp, FPatternUsed - 1); + + Count := FPatternLength; + while (Start >= Text) and (Count > 0) do + begin + // ignore non-spacing characters if indicated + if sfIgnoreNonSpacing in FFlags then + begin + while (Start > Text) and UnicodeIsNonSpacing(C1) do + begin + Dec(Start); + C2 := UCS4(Start^); + if (Start - 1) > Text then + C1 := UCS4((Start - 1)^) + else + C1 := $FFFFFFFF; + if (SurrogateLowStart <= C2) and (C2 <= SurrogateLowEnd) and + (SurrogateHighStart <= C1) and (C1 <= SurrogateHighEnd) then + begin + C1 := $10000 + (((C1 and $03FF) shl 10) or (C2 and $03FF)); + Dec(Start); + end + else + C1 := C2; + end; + end; + + // handle space compression if indicated + if sfSpaceCompress in FFlags then + begin + CheckSpace := False; + while (Start > Text) and (UnicodeIsWhiteSpace(C1) or UnicodeIsControl(C1)) do + begin + CheckSpace := UnicodeIsWhiteSpace(C1); + Dec(Start); + C2 := UCS4(Start^); + if (Start - 1) > Text then + C1 := UCS4((Start - 1)^) + else + C1 := $FFFFFFFF; + if (SurrogateLowStart <= C2) and (C2 <= SurrogateLowEnd) and + (SurrogateHighStart <= C1) and (C1 <= SurrogateHighEnd) then + begin + C1 := $10000 + (((C1 and $03FF) shl 10) or (C2 and $03FF)); + Dec(Start); + end + else + C1 := C2; + end; + // Handle things if space compression was indicated and one or + // more member characters were found. + if CheckSpace then + begin + if Cp.UpCase <> $20 then + Exit; + Dec(Cp); + Dec(Count); + // If Count is 0 at this place then the space character(s) was the first + // in the pattern and we need to correct the start position. + if Count = 0 then + Inc(Start); + end; + end; + + // handle the normal comparison cases + if (Count > 0) and + (Boolean(C1 xor Cp.UpCase) and + Boolean(C1 xor Cp.LoCase) and + Boolean(C1 xor Cp.TitleCase)) then + Exit; + + if C1 >= $10000 then + Dec(Count, 2) + else + Dec(Count, 1); + if Count > 0 then + begin + Dec(Cp); + // get the next preceding character + if Start > Text then + begin + Dec(Start); + C2 := UCS4(Start^); + if (Start - 1) > Text then + C1 := UCS4((Start - 1)^) + else + C1 := $FFFFFFFF; + if (SurrogateLowStart <= C2) and (C2 <= SurrogateLowEnd) and + (SurrogateHighStart <= C1) and (C1 <= SurrogateHighEnd) then + begin + C1 := $10000 + (((C1 and $03FF) shl 10) or (C2 and $03FF)); + Dec(Start); + end + else + C1 := C2; + end; + end; + end; + + // So far the string matched. Now check its left border for a space character + // if whole word only are allowed. + if not (sfWholeWordOnly in FFlags) or + (Start <= Text) or + UnicodeIsWhiteSpace(UCS4((Start - 1)^)) then + begin + // set the match start position + MatchStart := Start - Text; + Result := True; + end; +end; + +procedure TUTBMSearch.Compile(Pattern: PUCS2; PatternLength: SizeInt; Flags: TSearchFlags); +var + HaveSpace: Boolean; + I, J, K, + SLen: SizeInt; + Cp: PUTBMChar; + Sp: PUTBMSkip; + C1, C2, + Sentinel: UCS4; +begin + if (Pattern <> nil) and (Pattern^ <> #0) and (PatternLength > 0) then + begin + // do some initialization + FFlags := Flags; + // extra skip flag + FMD4 := 1; + + Sentinel := 0; + + // allocate more storage if necessary + FPattern := AllocMem(SizeOf(TUTBMChar) * PatternLength); + FSkipValues := AllocMem(SizeOf(TUTBMSkip) * PatternLength); + FPatternSize := PatternLength; + + // Preprocess the pattern to remove controls (if specified) and determine case. + Cp := FPattern; + I := 0; + HaveSpace := False; + while I < PatternLength do + begin + C1 := UCS4(Pattern[I]); + if (I + 1) < PatternLength then + C2 := UCS4(Pattern[I + 1]) + else + C2 := $FFFFFFFF; + if (SurrogateHighStart <= C1) and (C1 <= SurrogateHighEnd) and + (SurrogateLowStart <= C2) and (C2 <= SurrogateLowEnd) then + C1 := $10000 + (((C1 and $03FF) shl 10) or (C2 and $03FF)); + + // Make sure the HaveSpace flag is turned off if the character is not an + // appropriate one. + if not UnicodeIsWhiteSpace(C1) then + HaveSpace := False; + + // If non-spacing characters should be ignored, do it here. + if (sfIgnoreNonSpacing in Flags) and UnicodeIsNonSpacing(C1) then + begin + Inc(I); + Continue; + end; + + // check if spaces and controls need to be compressed + if sfSpaceCompress in Flags then + begin + if UnicodeIsWhiteSpace(C1) then + begin + if not HaveSpace then + begin + // Add a space and set the flag. + Cp.UpCase := $20; + Cp.LoCase := $20; + Cp.TitleCase := $20; + Inc(Cp); + + // increase the real pattern length + Inc(FPatternLength); + Sentinel := $20; + HaveSpace := True; + end; + Inc(I); + Continue; + end; + + // ignore all control characters + if UnicodeIsControl(C1) then + begin + Inc(I); + Continue; + end; + end; + + // add the character + if not (sfCaseSensitive in Flags) then + begin + { TODO : use the entire mapping, not only the first character } + Cp.UpCase := UnicodeToUpper(C1)[0]; + Cp.LoCase := UnicodeToLower(C1)[0]; + Cp.TitleCase := UnicodeToTitle(C1)[0]; + end + else + begin + Cp.UpCase := C1; + Cp.LoCase := C1; + Cp.TitleCase := C1; + end; + + Sentinel := Cp.UpCase; + + // move to the next character + Inc(Cp); + + // increase the real pattern length appropriately + if C1 >= $10000 then + Inc(FPatternLength, 2) + else + Inc(FPatternLength); + + // increment the loop index for UTF-16 characters + if C1 > $10000 then + Inc(I, 2) + else + Inc(I); + end; + + // set the number of characters actually used + FPatternUsed := (TJclAddr(Cp) - TJclAddr(FPattern)) div SizeOf(TUTBMChar); + + // Go through and construct the skip array and determine the actual length + // of the pattern in UCS2 terms. + SLen := FPatternLength - 1; + Cp := FPattern; + K := 0; + for I := 0 to FPatternUsed - 1 do + begin + // locate the character in the FSkipValues array + Sp := FSkipValues; + J := 0; + while (J < FSkipsUsed) and (Sp.BMChar.UpCase <> Cp.UpCase) do + begin + Inc(J); + Inc(Sp); + end; + + // If the character is not found, set the new FSkipValues element and + // increase the number of FSkipValues elements. + if J = FSkipsUsed then + begin + Sp.BMChar := Cp; + Inc(FSkipsUsed); + end; + + // Set the updated FSkipValues value. If the character is UTF-16 and is + // not the last one in the pattern, add one to its FSkipValues value. + Sp.SkipValues := SLen - K; + if (Cp.UpCase >= $10000) and ((K + 2) < SLen) then + Inc(Sp.SkipValues); + + // set the new extra FSkipValues for the sentinel character + if ((Cp.UpCase >= $10000) and + ((K + 2) <= SLen) or ((K + 1) <= SLen) and + (Cp.UpCase = Sentinel)) then + FMD4 := SLen - K; + + // increase the actual index + if Cp.UpCase >= $10000 then + Inc(K, 2) + else + Inc(K); + Inc(Cp); + end; + end; +end; + +function TUTBMSearch.Find(Text: PUCS2; TextLen: SizeInt; var MatchStart, MatchEnd: SizeInt): Boolean; +// this is the main matching routine using a tuned Boyer-Moore algorithm +var + K: SizeInt; + Start, + Stop: PUCS2; +begin + Result := False; + if (FPattern <> nil) and (FPatternUsed > 0) and (Text <> nil) and + (TextLen > 0) and (TextLen >= FPatternLength) then + begin + Start := Text + FPatternLength - 1; + Stop := Text + TextLen; + + // adjust the start point if it points to a low surrogate + if (SurrogateLowStart <= UCS4(Start^)) and + (UCS4(Start^) <= SurrogateLowEnd) and + (SurrogateHighStart <= UCS4((Start - 1)^)) and + (UCS4((Start - 1)^) <= SurrogateHighEnd) then + Dec(Start); + + while Start < Stop do + begin + repeat + K := GetSkipValue(Start, Stop); + if K = 0 then + Break; + Inc(Start, K); + if (Start < Stop) and + (SurrogateLowStart <= UCS4(Start^)) and + (UCS4(Start^) <= SurrogateLowEnd) and + (SurrogateHighStart <= UCS4((Start - 1)^)) and + (UCS4((Start - 1)^) <= SurrogateHighEnd) then + Dec(Start); + until False; + + if (Start < Stop) and Match(Text, Start, Stop, MatchStart, MatchEnd) then + begin + Result := True; + Break; + end; + Inc(Start, FMD4); + if (Start < Stop) and + (SurrogateLowStart <= UCS4(Start^)) and + (UCS4(Start^) <= SurrogateLowEnd) and + (SurrogateHighStart <= UCS4((Start - 1)^)) and + (UCS4((Start - 1)^) <= SurrogateHighEnd) then + Dec(Start); + end; + end; +end; + +procedure TUTBMSearch.Clear; +begin + ClearPattern; + inherited Clear; +end; + +function TUTBMSearch.FindAll(const Text: WideString): Boolean; +begin + Result := FindAll(PWideChar(Text), Length(Text)); +end; + +function TUTBMSearch.FindAll(Text: PWideChar; TextLen: SizeInt): Boolean; +// Looks for all occurrences of the pattern passed to FindPrepare and creates an +// internal list of their positions. +var + Start, Stop: SizeInt; + Run: PWideChar; + RunLen: SizeInt; +begin + ClearResults; + Run := Text; + RunLen := TextLen; + Start := 0; + Stop := 0; + // repeat to find all occurrences of the pattern + while Find(Run, RunLen, Start, Stop) do + begin + // store this result (consider text pointer movement)... + AddResult(Start + (Run - Text), Stop + (Run - Text)); + // ... and advance text position and length + Inc(Run, Stop); + Dec(RunLen, Stop); + end; + Result := Count > 0; +end; + +function TUTBMSearch.FindFirst(const Text: WideString; var Start, Stop: SizeInt): Boolean; +// Looks for the first occurrence of the pattern passed to FindPrepare in Text and +// returns True if one could be found (in which case Start and Stop are set to +// the according indices) otherwise False. This function is in particular of +// interest if only one occurrence needs to be found. +begin + ClearResults; + Result := Find(PWideChar(Text), Length(Text), Start, Stop); + if Result then + AddResult(Start, Stop); +end; + +function TUTBMSearch.FindFirst(Text: PWideChar; TextLen: SizeInt; var Start, Stop: SizeInt): Boolean; +// Same as the WideString version of this method. +begin + ClearResults; + Result := Find(Text, TextLen, Start, Stop); + if Result then + AddResult(Start, Stop); +end; + +procedure TUTBMSearch.FindPrepare(const Pattern: WideString; Options: TSearchFlags); +begin + FindPrepare(PWideChar(Pattern), Length(Pattern), Options); +end; + +procedure TUTBMSearch.FindPrepare(Pattern: PWideChar; PatternLength: SizeInt; Options: TSearchFlags); +// prepares following search by compiling the given pattern into an internal structure +begin + Compile(Pattern, PatternLength, Options); +end; + +//----------------- Unicode RE search core --------------------------------------------------------- + +const + // error codes + _URE_OK = 0; + _URE_UNEXPECTED_EOS = -1; + _URE_CCLASS_OPEN = -2; + _URE_UNBALANCED_GROUP = -3; + _URE_INVALID_PROPERTY = -4; + _URE_INVALID_RANGE = -5; + _URE_RANGE_OPEN = -6; + + // options that can be combined for searching + URE_IGNORE_NONSPACING = $01; + URE_DONT_MATCHES_SEPARATORS = $02; + +const + // Flags used internally in the DFA + _URE_DFA_CASEFOLD = $01; + _URE_DFA_BLANKLINE = $02; + + // symbol types for the DFA + _URE_ANY_CHAR = 1; + _URE_CHAR = 2; + _URE_CCLASS = 3; + _URE_NCCLASS = 4; + _URE_BOL_ANCHOR = 5; + _URE_EOL_ANCHOR = 6; + + // op codes for converting the NFA to a DFA + _URE_SYMBOL = 10; + _URE_PAREN = 11; + _URE_QUEST = 12; + _URE_STAR = 13; + _URE_PLUS = 14; + _URE_ONE = 15; + _URE_AND = 16; + _URE_OR = 17; + + _URE_NOOP = $FFFF; + +//----------------- TURESearch --------------------------------------------------------------------- + +procedure TURESearch.Clear; +begin + inherited Clear; + ClearUREBuffer; + ClearDFA; +end; + +procedure TURESearch.Push(V: SizeInt); +begin + with FUREBuffer do + begin + // If the 'Reducing' parameter is True, check to see if the value passed is + // already on the stack. + if Reducing and ExpressionList.Expressions[Word(V)].OnStack then + Exit; + + if Stack.ListUsed = Length(Stack.List) then + SetLength(Stack.List, Length(Stack.List) + 8); + Stack.List[Stack.ListUsed] := V; + Inc(Stack.ListUsed); + + // If the 'reducing' parameter is True, flag the element as being on the Stack. + if Reducing then + ExpressionList.Expressions[Word(V)].OnStack := True; + end; +end; + +function TURESearch.Peek: SizeInt; +begin + if FUREBuffer.Stack.ListUsed = 0 then + Result := _URE_NOOP + else + Result := FUREBuffer.Stack.List[FUREBuffer.Stack.ListUsed - 1]; +end; + +function TURESearch.Pop: SizeInt; +begin + if FUREBuffer.Stack.ListUsed = 0 then + Result := _URE_NOOP + else + begin + Dec(FUREBuffer.Stack.ListUsed); + Result := FUREBuffer.Stack.List[FUREBuffer.Stack.ListUsed]; + if FUREBuffer.Reducing then + FUREBuffer.ExpressionList.Expressions[Word(Result)].OnStack := False; + end; +end; + +function TURESearch.ParsePropertyList(Properties: PUCS2; Limit: SizeInt; + var Categories: TCharacterCategories): SizeInt; +// Parse a comma-separated list of integers that represent character properties. +// Combine them into a set of categories and return the number of characters consumed. +var + N: SizeInt; + Run, + ListEnd: PUCS2; +begin + Run := Properties; + ListEnd := Run + Limit; + + N := 0; + Categories := []; + while (FUREBuffer.Error = _URE_OK) and (Run < ListEnd) do + begin + if Run^ = ',' then + begin + // Encountered a comma, so take the number parsed so far as category and + // reset the number. + Include(Categories, TCharacterCategory(N)); + N := 0; + end + else + begin + if (Run^ >= '0') and (Run^ <= '9') then + begin + // Encountered a digit, so start or continue building the SizeInt that + // represents the character category. + N := (N * 10) + SizeInt(Word(Run^) - Ord('0')); + end + else + begin + // Encountered something that is not part of the property list. + // Indicate that we are done. + Break; + end; + end; + + // If the number is to large then there is a problem. + // Most likely a missing comma separator. + if SizeInt(N) > Ord(High(TCharacterCategory)) then + FUREBuffer.Error := _URE_INVALID_PROPERTY; + Inc(Run); + end; + + // Return the number of characters consumed. + Result := Run - Properties; +end; + +function TURESearch.MakeHexNumber(NP: PUCS2; Limit: SizeInt; var Number: UCS4): SizeInt; +// Collect a hex number with 1 to 4 digits and return the number of characters used. +var + I: SizeInt; + Run, + ListEnd: PUCS2; +begin + Run := np; + ListEnd := Run + Limit; + + Number := 0; + I := 0; + while (I < 4) and (Run < ListEnd) do + begin + if (Run^ >= '0') and (Run^ <= '9') then + Number := (Number shl 4) or (Cardinal(Word(Run^) - Ord('0'))) + else + begin + if (Run^ >= 'A') and (Run^ <= 'F') then + Number := (Number shl 4) or (Cardinal(Word(Run^) - Ord('A')) + 10) + else + begin + if (Run^ >= 'a') and (Run^ <= 'f') then + Number := (Number shl 4) or (Cardinal(Word(Run^) - Ord('a')) + 10) + else + Break; + end; + end; + Inc(I); + Inc(Run); + end; + + Result := Run - NP; +end; + +procedure TURESearch.AddRange(var CCL: TUcCClass; Range: TUcRange); +// Insert a Range into a character class, removing duplicates and ordering them +// in increasing Range-start order. +var + I: SizeInt; + Temp: UCS4; +begin + // If the `Casefold' flag is set, then make sure both endpoints of the Range + // are converted to lower. + if (FUREBuffer.Flags and _URE_DFA_CASEFOLD) <> 0 then + begin + { TODO : use the entire mapping, not only the first character } + Range.MinCode := UnicodeToLower(Range.MinCode)[0]; + Range.MaxCode := UnicodeToLower(Range.MaxCode)[0]; + end; + + // Swap the Range endpoints if they are not in increasing order. + if Range.MinCode > Range.MaxCode then + begin + Temp := Range.MinCode; + Range.MinCode := Range.MaxCode; + Range.MaxCode := Temp; + end; + + I := 0; + while (I < CCL.RangesUsed) and (Range.MinCode < CCL.Ranges[I].MinCode) do + Inc(I); + + // check for a duplicate + if (I < CCL.RangesUsed) and (Range.MinCode = CCL.Ranges[I].MinCode) and + (Range.MaxCode = CCL.Ranges[I].MaxCode) then + Exit; + + if CCL.RangesUsed = Length(CCL.Ranges) then + SetLength(CCL.Ranges, Length(CCL.Ranges) + 8); + + if I < CCL.RangesUsed then + Move(CCL.Ranges[I], CCL.Ranges[I + 1], SizeOf(TUcRange) * (CCL.RangesUsed - I)); + + CCL.Ranges[I].MinCode := Range.MinCode; + CCL.Ranges[I].MaxCode := Range.MaxCode; + Inc(CCL.RangesUsed); +end; + +type + PTrie = ^TTrie; + TTrie = record + Key: UCS2; + Len, + Next: SizeInt; + Setup: SizeInt; + Categories: TCharacterCategories; + end; + +procedure TURESearch.SpaceSetup(Symbol: PUcSymbolTableEntry; Categories: TCharacterCategories); +var + Range: TUcRange; +begin + Symbol.Categories := Symbol.Categories + Categories; + + Range.MinCode := UCS4(WideTabulator); + Range.MaxCode := UCS4(WideTabulator); + AddRange(Symbol.Symbol.CCL, Range); + Range.MinCode := UCS4(WideCarriageReturn); + Range.MaxCode := UCS4(WideCarriageReturn); + AddRange(Symbol.Symbol.CCL, Range); + Range.MinCode := UCS4(WideLineFeed); + Range.MaxCode := UCS4(WideLineFeed); + AddRange(Symbol.Symbol.CCL, Range); + Range.MinCode := UCS4(WideFormFeed); + Range.MaxCode := UCS4(WideFormFeed); + AddRange(Symbol.Symbol.CCL, Range); + Range.MinCode := $FEFF; + Range.MaxCode := $FEFF; + AddRange(Symbol.Symbol.CCL, Range); +end; + +procedure TURESearch.HexDigitSetup(Symbol: PUcSymbolTableEntry); +var + Range: TUcRange; +begin + Range.MinCode := UCS4('0'); + Range.MaxCode := UCS4('9'); + AddRange(Symbol.Symbol.CCL, Range); + Range.MinCode := UCS4('A'); + Range.MaxCode := UCS4('F'); + AddRange(Symbol.Symbol.CCL, Range); + Range.MinCode := UCS4('a'); + Range.MaxCode := UCS4('f'); + AddRange(Symbol.Symbol.CCL, Range); +end; + +const + CClassTrie: array [0..64] of TTrie = ( + (Key: #$003A; Len: 1; Next: 1; Setup: 0; Categories: []), + (Key: #$0061; Len: 9; Next: 10; Setup: 0; Categories: []), + (Key: #$0063; Len: 8; Next: 19; Setup: 0; Categories: []), + (Key: #$0064; Len: 7; Next: 24; Setup: 0; Categories: []), + (Key: #$0067; Len: 6; Next: 29; Setup: 0; Categories: []), + (Key: #$006C; Len: 5; Next: 34; Setup: 0; Categories: []), + (Key: #$0070; Len: 4; Next: 39; Setup: 0; Categories: []), + (Key: #$0073; Len: 3; Next: 49; Setup: 0; Categories: []), + (Key: #$0075; Len: 2; Next: 54; Setup: 0; Categories: []), + (Key: #$0078; Len: 1; Next: 59; Setup: 0; Categories: []), + (Key: #$006C; Len: 1; Next: 11; Setup: 0; Categories: []), + (Key: #$006E; Len: 2; Next: 13; Setup: 0; Categories: []), + (Key: #$0070; Len: 1; Next: 16; Setup: 0; Categories: []), + (Key: #$0075; Len: 1; Next: 14; Setup: 0; Categories: []), + (Key: #$006D; Len: 1; Next: 15; Setup: 0; Categories: []), + (Key: #$003A; Len: 1; Next: 16; Setup: 1; Categories: ClassLetter + ClassNumber), + (Key: #$0068; Len: 1; Next: 17; Setup: 0; Categories: []), + (Key: #$0061; Len: 1; Next: 18; Setup: 0; Categories: []), + (Key: #$003A; Len: 1; Next: 19; Setup: 1; Categories: ClassLetter), + (Key: #$006E; Len: 1; Next: 20; Setup: 0; Categories: []), + (Key: #$0074; Len: 1; Next: 21; Setup: 0; Categories: []), + (Key: #$0072; Len: 1; Next: 22; Setup: 0; Categories: []), + (Key: #$006C; Len: 1; Next: 23; Setup: 0; Categories: []), + (Key: #$003A; Len: 1; Next: 24; Setup: 1; Categories: [ccOtherControl, ccOtherFormat]), + (Key: #$0069; Len: 1; Next: 25; Setup: 0; Categories: []), + (Key: #$0067; Len: 1; Next: 26; Setup: 0; Categories: []), + (Key: #$0069; Len: 1; Next: 27; Setup: 0; Categories: []), + (Key: #$0074; Len: 1; Next: 28; Setup: 0; Categories: []), + (Key: #$003A; Len: 1; Next: 29; Setup: 1; Categories: ClassNumber), + (Key: #$0072; Len: 1; Next: 30; Setup: 0; Categories: []), + (Key: #$0061; Len: 1; Next: 31; Setup: 0; Categories: []), + (Key: #$0070; Len: 1; Next: 32; Setup: 0; Categories: []), + (Key: #$0068; Len: 1; Next: 33; Setup: 0; Categories: []), + (Key: #$003A; Len: 1; Next: 34; Setup: 1; Categories: ClassMark + ClassNumber + ClassLetter + ClassPunctuation + + ClassSymbol), + (Key: #$006F; Len: 1; Next: 35; Setup: 0; Categories: []), + (Key: #$0077; Len: 1; Next: 36; Setup: 0; Categories: []), + (Key: #$0065; Len: 1; Next: 37; Setup: 0; Categories: []), + (Key: #$0072; Len: 1; Next: 38; Setup: 0; Categories: []), + (Key: #$003A; Len: 1; Next: 39; Setup: 1; Categories: [ccLetterLowercase]), + (Key: #$0072; Len: 2; Next: 41; Setup: 0; Categories: []), + (Key: #$0075; Len: 1; Next: 45; Setup: 0; Categories: []), + (Key: #$0069; Len: 1; Next: 42; Setup: 0; Categories: []), + (Key: #$006E; Len: 1; Next: 43; Setup: 0; Categories: []), + (Key: #$0074; Len: 1; Next: 44; Setup: 0; Categories: []), + (Key: #$003A; Len: 1; Next: 45; Setup: 1; Categories: ClassMark + ClassNumber + ClassLetter + ClassPunctuation + + ClassSymbol + [ccSeparatorSpace]), + (Key: #$006E; Len: 1; Next: 46; Setup: 0; Categories: []), + (Key: #$0063; Len: 1; Next: 47; Setup: 0; Categories: []), + (Key: #$0074; Len: 1; Next: 48; Setup: 0; Categories: []), + (Key: #$003A; Len: 1; Next: 49; Setup: 1; Categories: ClassPunctuation), + (Key: #$0070; Len: 1; Next: 50; Setup: 0; Categories: []), + (Key: #$0061; Len: 1; Next: 51; Setup: 0; Categories: []), + (Key: #$0063; Len: 1; Next: 52; Setup: 0; Categories: []), + (Key: #$0065; Len: 1; Next: 53; Setup: 0; Categories: []), + (Key: #$003A; Len: 1; Next: 54; Setup: 2; Categories: ClassSpace), + (Key: #$0070; Len: 1; Next: 55; Setup: 0; Categories: []), + (Key: #$0070; Len: 1; Next: 56; Setup: 0; Categories: []), + (Key: #$0065; Len: 1; Next: 57; Setup: 0; Categories: []), + (Key: #$0072; Len: 1; Next: 58; Setup: 0; Categories: []), + (Key: #$003A; Len: 1; Next: 59; Setup: 1; Categories: [ccLetterUppercase]), + (Key: #$0064; Len: 1; Next: 60; Setup: 0; Categories: []), + (Key: #$0069; Len: 1; Next: 61; Setup: 0; Categories: []), + (Key: #$0067; Len: 1; Next: 62; Setup: 0; Categories: []), + (Key: #$0069; Len: 1; Next: 63; Setup: 0; Categories: []), + (Key: #$0074; Len: 1; Next: 64; Setup: 0; Categories: []), + (Key: #$003A; Len: 1; Next: 65; Setup: 3; Categories: []) + ); + +function TURESearch.PosixCCL(CP: PUCS2; Limit: SizeInt; Symbol: PUcSymbolTableEntry): SizeInt; +// Probe for one of the POSIX colon delimited character classes in the static trie. +var + I: SizeInt; + N: SizeInt; + TP: PTrie; + Run, + ListEnd: PUCS2; +begin + Result := 0; + // If the number of characters left is less than 7, + // then this cannot be interpreted as one of the colon delimited classes. + if Limit >= 7 then + begin + Run := cp; + ListEnd := Run + Limit; + TP := @CClassTrie[0]; + I := 0; + while (Run < ListEnd) and (I < 8) do + begin + N := TP.Len; + while (N > 0) and (TP.Key <> Run^) do + begin + Inc(TP); + Dec(N); + end; + + if N = 0 then + begin + Result := 0; + Exit; + end; + + if (Run^ = ':') and ((I = 6) or (I = 7)) then + begin + Inc(Run); + Break; + end; + if (Run + 1) < ListEnd then + TP := @CClassTrie[TP.Next]; + Inc(I); + Inc(Run); + end; + + Result := Run - CP; + case TP.Setup of + 1: + Symbol.Categories := Symbol.Categories + TP.Categories; + 2: + SpaceSetup(Symbol, TP.Categories); + 3: + HexDigitSetup(Symbol); + else + Result := 0; + end; + end; +end; + +function TURESearch.BuildCharacterClass(CP: PUCS2; Limit: SizeInt; Symbol: PUcSymbolTableEntry): SizeInt; +// Construct a list of ranges and return the number of characters consumed. +var + RangeEnd: SizeInt; + N: SizeInt; + Run, + ListEnd: PUCS2; + C, Last: UCS4; + Range: TUcRange; +begin + Run := cp; + ListEnd := Run + Limit; + + if Run^ = '^' then + begin + Symbol.AType := _URE_NCCLASS; + Inc(Run); + end + else + Symbol.AType := _URE_CCLASS; + + Last := 0; + RangeEnd := 0; + while (FUREBuffer.Error = _URE_OK) and (Run < ListEnd) do + begin + // Allow for the special case []abc], where the first closing bracket would end an empty + // character class, which makes no sense. Hence this bracket is treaded literally. + if (Run^ = ']') and (Symbol.Symbol.CCL.RangesUsed > 0) then + Break; + + C := UCS4(Run^); + Inc(Run); + + // escape character + if C = Ord('\') then + begin + if Run = ListEnd then + begin + // The EOS was encountered when expecting the reverse solidus to be followed by the character it is escaping. + // Set an Error code and return the number of characters consumed up to this point. + FUREBuffer.Error := _URE_UNEXPECTED_EOS; + Result := Run - CP; + Exit; + end; + + C := UCS4(Run^); + Inc(Run); + case UCS2(C) of + 'a': + C := $07; + 'b': + C := $08; + 'f': + C := $0C; + 'n': + C := $0A; + 'R': + C := $0D; + 't': + C := $09; + 'v': + C := $0B; + 'p', 'P': + begin + Inc(Run, ParsePropertyList(Run, ListEnd - Run, Symbol.Categories)); + // Invert the bit mask of the properties if this is a negated character class or if 'P' is used to specify + // a list of character properties that should *not* match in a character class. + if C = Ord('P') then + Symbol.Categories := ClassAll - Symbol.Categories; + Continue; + end; + 'x', 'X', 'u', 'U': + begin + if (Run < ListEnd) and + ((Run^ >= '0') and (Run^ <= '9') or + (Run^ >= 'A') and (Run^ <= 'F') or + (Run^ >= 'a') and (Run^ <= 'f')) then + Inc(Run, MakeHexNumber(Run, ListEnd - Run, C)); + end; + end; + end + else + begin + if C = Ord(':') then + begin + // Probe for a POSIX colon delimited character class. + Dec(Run); + N := PosixCCL(Run, ListEnd - Run, Symbol); + if N = 0 then + Inc(Run) + else + begin + Inc(Run, N); + Continue; + end; + end; + end; + + // Check to see if the current character is a low surrogate that needs + // to be combined with a preceding high surrogate. + if Last <> 0 then + begin + if (C >= SurrogateLowStart) and (C <= SurrogateLowEnd) then + begin + // Construct the UTF16 character code. + C := $10000 + (((Last and $03FF) shl 10) or (C and $03FF)) + end + else + begin + // Add the isolated high surrogate to the range. + if RangeEnd = 1 then + Range.MaxCode := Last and $FFFF + else + begin + Range.MinCode := Last and $FFFF; + Range.MaxCode := Last and $FFFF; + end; + + AddRange(Symbol.Symbol.CCL, Range); + RangeEnd := 0; + end; + end; + + // Clear the Last character code. + Last := 0; + + // This slightly awkward code handles the different cases needed to construct a range. + if (C >= SurrogateHighStart) and (C <= SurrogateHighEnd) then + begin + // If the high surrogate is followed by a Range indicator, simply add it as the Range start. Otherwise, + // save it in the next character is a low surrogate. + if Run^ = '-' then + begin + Inc(Run); + Range.MinCode := C; + RangeEnd := 1; + end + else + Last := C; + end + else + begin + if RangeEnd = 1 then + begin + Range.MaxCode := C; + AddRange(Symbol.Symbol.CCL, Range); + RangeEnd := 0; + end + else + begin + Range.MinCode := C; + Range.MaxCode := C; + if Run^ = '-' then + begin + Inc(Run); + RangeEnd := 1; + end + else + AddRange(Symbol.Symbol.CCL, Range); + end; + end; + end; + + if (Run < ListEnd) and (Run^ = ']') then + Inc(Run) + else + begin + // The parse was not terminated by the character class close symbol (']'), so set an error code. + FUREBuffer.Error := _URE_CCLASS_OPEN; + end; + Result := Run - CP; +end; + +function TURESearch.ProbeLowSurrogate(LeftState: PUCS2; Limit: SizeInt; var Code: UCS4): SizeInt; +// probes for a low surrogate hex code +var + I: SizeInt; + Run, + ListEnd: PUCS2; +begin + I := 0; + Code := 0; + Run := LeftState; + ListEnd := Run + Limit; + + while (I < 4) and (Run < ListEnd) do + begin + if (Run^ >= '0') and (Run^ <= '9') then + Code := (Code shl 4) or (Cardinal(Word(Run^) - Ord('0'))) + else + begin + if (Run^ >= 'A') and (Run^ <= 'F') then + Code := (Code shl 4) or (Cardinal(Word(Run^) - Ord('A')) + 10) + else + begin + if (Run^ >= 'a') and (Run^ <= 'f') then + Code := (Code shl 4) or (Cardinal(Word(Run^) - Ord('a')) + 10) + else + Break; + end; + end; + Inc(Run); + end; + + if (SurrogateLowStart <= Code) and (Code <= SurrogateLowEnd) then + Result := Run - LeftState + else + Result := 0; +end; + +function TURESearch.CompileSymbol(S: PUCS2; Limit: SizeInt; Symbol: PUcSymbolTableEntry): SizeInt; +var + C: UCS4; + Run, + ListEnd: PUCS2; +begin + Run := S; + ListEnd := S + Limit; + + C := UCS4(Run^); + Inc(Run); + if C = Ord('\') then + begin + if Run = ListEnd then + begin + // The EOS was encountered when expecting the reverse solidus to be followed + // by the character it is escaping. Set an Error code and return the number + // of characters consumed up to this point. + FUREBuffer.Error := _URE_UNEXPECTED_EOS; + Result := Run - S; + Exit; + end; + + C := UCS4(Run^); + Inc(Run); + case UCS2(C) of + 'p', 'P': + begin + if UCS2(C) = 'p' then + Symbol.AType :=_URE_CCLASS + else + Symbol.AType :=_URE_NCCLASS; + Inc(Run, ParsePropertyList(Run, ListEnd - Run, Symbol.Categories)); + end; + 'a': + begin + Symbol.AType := _URE_CHAR; + Symbol.Symbol.Chr := $07; + end; + 'b': + begin + Symbol.AType := _URE_CHAR; + Symbol.Symbol.Chr := $08; + end; + 'f': + begin + Symbol.AType := _URE_CHAR; + Symbol.Symbol.Chr := $0C; + end; + 'n': + begin + Symbol.AType := _URE_CHAR; + Symbol.Symbol.Chr := $0A; + end; + 'r': + begin + Symbol.AType := _URE_CHAR; + Symbol.Symbol.Chr := $0D; + end; + 't': + begin + Symbol.AType := _URE_CHAR; + Symbol.Symbol.Chr := $09; + end; + 'v': + begin + Symbol.AType := _URE_CHAR; + Symbol.Symbol.Chr := $0B; + end; + else + case UCS2(C) of + 'x', 'X', 'u', 'U': + begin + // Collect between 1 and 4 digits representing an UCS2 code. + if (Run < ListEnd) and + ((Run^ >= '0') and (Run^ <= '9') or + (Run^ >= 'A') and (Run^ <= 'F') or + (Run^ >= 'a') and (Run^ <= 'f')) then + Inc(Run, MakeHexNumber(Run, ListEnd - Run, C)); + end; + end; + + // Simply add an escaped character here. + Symbol.AType := _URE_CHAR; + Symbol.Symbol.Chr := C; + end; + end + else + begin + if (UCS2(C) = '^') or (UCS2(C) = '$') then + begin + // Handle the BOL and EOL anchors. This actually consists simply of setting + // a flag that indicates that the user supplied anchor match function should + // be called. This needs to be done instead of simply matching line/paragraph + // separators because beginning-of-text and end-of-text tests are needed as well. + if UCS2(C) = '^' then + Symbol.AType := _URE_BOL_ANCHOR + else + Symbol.AType := _URE_EOL_ANCHOR; + end + else + begin + if UCS2(C) = '[' then + begin + // construct a character class + Inc(Run, BuildCharacterClass(Run, ListEnd - Run, Symbol)); + end + else + begin + if UCS2(C) = '.' then + Symbol.AType := _URE_ANY_CHAR + else + begin + Symbol.AType := _URE_CHAR; + Symbol.Symbol.Chr := C; + end; + end; + end; + end; + + // If the symbol type happens to be a character and is a high surrogate, then + // probe forward to see if it is followed by a low surrogate that needs to be added. + if (Run < ListEnd) and + (Symbol.AType = _URE_CHAR) and + (SurrogateHighStart <= Symbol.Symbol.Chr) and + (Symbol.Symbol.Chr <= SurrogateHighEnd) then + begin + if (SurrogateLowStart <= UCS4(Run^)) and + (UCS4(Run^) <= SurrogateLowEnd) then + begin + Symbol.Symbol.Chr := $10000 + (((Symbol.Symbol.Chr and $03FF) shl 10) or (UCS4(Run^) and $03FF)); + Inc(Run); + end + else + begin + if (Run^ = '\') and (((Run + 1)^ = 'x') or ((Run + 1)^ = 'X') or + ((Run + 1)^ = 'u') or ((Run + 1)^ = 'U')) then + begin + Inc(Run, ProbeLowSurrogate(Run + 2, ListEnd - (Run + 2), C)); + if (SurrogateLowStart <= C) and (C <= SurrogateLowEnd) then + begin + // Take into account the \[xu] in front of the hex code. + Inc(Run, 2); + Symbol.Symbol.Chr := $10000 + (((Symbol.Symbol.Chr and $03FF) shl 10) or (C and $03FF)); + end; + end; + end; + end; + + // Last, make sure any _URE_CHAR type symbols are changed to lower if the + // 'Casefold' flag is set. + { TODO : use the entire mapping, not only the first character and use the + case fold abilities of the unit. } + if ((FUREBuffer.Flags and _URE_DFA_CASEFOLD) <> 0) and (Symbol.AType = _URE_CHAR) then + Symbol.Symbol.Chr := UnicodeToLower(Symbol.Symbol.Chr)[0]; + + // If the symbol constructed is anything other than one of the anchors, + // make sure the _URE_DFA_BLANKLINE flag is removed. + if (Symbol.AType <> _URE_BOL_ANCHOR) and (Symbol.AType <> _URE_EOL_ANCHOR) then + FUREBuffer.Flags := FUREBuffer.Flags and not _URE_DFA_BLANKLINE; + + // Return the number of characters consumed. + Result := Run - S; +end; + +function TURESearch.SymbolsAreDifferent(A, B: PUcSymbolTableEntry): Boolean; +begin + Result := False; + if (A.AType <> B.AType) or (A.Mods <> B.Mods) or (A.Categories <> B.Categories) then + Result := True + else + begin + if (A.AType = _URE_CCLASS) or (A.AType = _URE_NCCLASS) then + begin + if A.Symbol.CCL.RangesUsed <> B.Symbol.CCL.RangesUsed then + Result := True + else + begin + if (A.Symbol.CCL.RangesUsed > 0) and + not CompareMem(@A.Symbol.CCL.Ranges[0], @B.Symbol.CCL.Ranges[0], + SizeOf(TUcRange) * A.Symbol.CCL.RangesUsed) then + Result := True;; + end; + end + else + begin + if (A.AType = _URE_CHAR) and (A.Symbol.Chr <> B.Symbol.Chr) then + Result := True; + end; + end; +end; + +function TURESearch.MakeSymbol(S: PUCS2; Limit: SizeInt; out Consumed: SizeInt): SizeInt; +// constructs a symbol, but only keep unique symbols +var + I: SizeInt; + Start: PUcSymbolTableEntry; + Symbol: TUcSymbolTableEntry; +begin + // Build the next symbol so we can test to see if it is already in the symbol table. + ResetMemory(Symbol, SizeOf(TUcSymbolTableEntry)); + Consumed := CompileSymbol(S, Limit, @Symbol); + + // Check to see if the symbol exists. + I := 0; + Start := @FUREBuffer.SymbolTable.Symbols[0]; + while (I < FUREBuffer.SymbolTable.SymbolsUsed) and SymbolsAreDifferent(@Symbol, Start) do + begin + Inc(I); + Inc(Start); + end; + + if I < FUREBuffer.SymbolTable.SymbolsUsed then + begin + // Free up any ranges used for the symbol. + if (Symbol.AType = _URE_CCLASS) or (Symbol.AType = _URE_NCCLASS) then + Symbol.Symbol.CCL.Ranges := nil; + Result := FUREBuffer.SymbolTable.Symbols[I].ID; + Exit; + end; + + // Need to add the new symbol. + if FUREBuffer.SymbolTable.SymbolsUsed = Length(FUREBuffer.SymbolTable.Symbols) then + begin + SetLength(FUREBuffer.SymbolTable.Symbols, Length(FUREBuffer.SymbolTable.Symbols) + 8); + end; + + Symbol.ID := FUREBuffer.SymbolTable.SymbolsUsed; + Inc(FUREBuffer.SymbolTable.SymbolsUsed); + FUREBuffer.SymbolTable.Symbols[Symbol.ID] := Symbol; + Result := Symbol.ID; +end; + +function TURESearch.MakeExpression(AType, LHS, RHS: SizeInt): SizeInt; +var + I: SizeInt; +begin + // Determine if the expression already exists or not. + with FUREBuffer.ExpressionList do + begin + for I := 0 to ExpressionsUsed - 1 do + begin + if (Expressions[I].AType = AType) and + (Expressions[I].LHS = LHS) and + (Expressions[I].RHS = RHS) then + begin + Result := I; + Exit; + end; + end; + + // Need to add a new expression. + if ExpressionsUsed = Length(Expressions) then + SetLength(Expressions, Length(Expressions) + 8); + + Expressions[ExpressionsUsed].OnStack := False; + Expressions[ExpressionsUsed].AType := AType; + Expressions[ExpressionsUsed].LHS := LHS; + Expressions[ExpressionsUsed].RHS := RHS; + + Result := ExpressionsUsed; + Inc(ExpressionsUsed); + end; +end; + +function IsSpecial(C: Word): Boolean; +begin + case C of + Word('+'), + Word('*'), + Word('?'), + Word('{'), + Word('|'), + Word(')'): + Result := True; + else + Result := False; + end; +end; + +procedure TURESearch.CollectPendingOperations(var State: SizeInt); +// collects all pending AND and OR operations and make corresponding expressions +var + Operation: SizeInt; +begin + repeat + Operation := Peek; + if (Operation <> _URE_AND) and (Operation <> _URE_OR) then + Break; + // make an expression with the AND or OR operator and its right hand side + Operation := Pop; + State := MakeExpression(Operation, Pop, State); + until False; +end; + +function TURESearch.ConvertRegExpToNFA(RE: PWideChar; RELength: SizeInt): SizeInt; +// Converts the regular expression into an NFA in a form that will be easy to +// reduce to a DFA. The starting state for the reduction will be returned. +var + C: UCS2; + Head, Tail: PUCS2; + S: WideString; + Symbol, + State, + LastState, + Used, + M, N: SizeInt; + I: SizeInt; +begin + State := _URE_NOOP; + + Head := RE; + Tail := Head + RELength; + while (FUREBuffer.Error = _URE_OK) and (Head < Tail) do + begin + C := Head^; + Inc(Head); + case C of + '(': + Push(_URE_PAREN); + ')': // check for the case of too many close parentheses + begin + if Peek = _URE_NOOP then + begin + FUREBuffer.Error := _URE_UNBALANCED_GROUP; + Break; + end; + CollectPendingOperations(State); + // remove the _URE_PAREN off the stack + Pop; + end; + '*': + State := MakeExpression(_URE_STAR, State, _URE_NOOP); + '+': + State := MakeExpression(_URE_PLUS, State, _URE_NOOP); + '?': + State := MakeExpression(_URE_QUEST, State, _URE_NOOP); + '|': + begin + CollectPendingOperations(State); + Push(State); + Push(_URE_OR); + end; + '{': // expressions of the form {m, n} + begin + C := #0; + M := 0; + N := 0; + // get first number + while UnicodeIsWhiteSpace(UCS4(Head^)) do + Inc(Head); + // very slow implementation + S := ''; + while (Head^ >= WideChar('0')) and (Head^ <= WideChar('9')) do + begin + S := S + Head^; + Inc(Head); + end; + if S <> '' then + M := StrToInt(S); + + while UnicodeIsWhiteSpace(UCS4(Head^)) do + Inc(Head); + if (Head^ <> ',') and (Head^ <> '}') then + begin + FUREBuffer.Error := _URE_INVALID_RANGE; + Break; + end; + + // check for an upper limit + if Head^ <> '}' then + begin + Inc(Head); + // get second number + while UnicodeIsWhiteSpace(UCS4(Head^)) do + Inc(Head); + // very slow implementation + S := ''; + while (Head^ >= WideChar('0')) and (Head^ <= WideChar('9')) do + begin + S := S + Head^; + Inc(Head); + end; + if S <> '' then + N := StrToInt(S); + end + else + N := M; + + if Head^ <> '}' then + begin + FUREBuffer.Error := _URE_RANGE_OPEN; + Break; + end + else + Inc(Head); + + // N = 0 means unlimited number of occurrences + if N = 0 then + begin + case M of + 0: // {,} {0,} {0, 0} mean the same as the star operator + State := MakeExpression(_URE_STAR, State, _URE_NOOP); + 1: // {1,} {1, 0} mean the same as the plus operator + State := MakeExpression(_URE_PLUS, State, _URE_NOOP); + else + begin + // encapsulate the expanded branches as would they be in parenthesis + // in order to avoid unwanted concatenation with pending operations/symbols + Push(_URE_PAREN); + // {m,} {m, 0} mean M fixed occurrences plus star operator + // make E^m... + for I := 1 to M - 1 do + begin + Push(State); + Push(_URE_AND); + end; + // ...and repeat the last symbol one or more times + State := MakeExpression(_URE_PLUS, State, _URE_NOOP); + CollectPendingOperations(State); + Pop; + end; + end; + end + else + begin + // check proper range limits + if M > N then + begin + FUREBuffer.Error := _URE_INVALID_RANGE; + Break; + end; + + // check special case {0, 1} (which corresponds to the ? operator) + if (M = 0) and (N = 1) then + State := MakeExpression(_URE_QUEST, State, _URE_NOOP) + else + begin + // handle the general case by expanding {m, n} into the equivalent + // expression E^m | E^(m + 1) | ... | E^n + + // encapsulate the expanded branches as would they be in parenthesis + // in order to avoid unwanted concatenation with pending operations/symbols + Push(_URE_PAREN); + // keep initial state as this is the one all alternatives start from + LastState := State; + + // Consider the special case M = 0 first. Because there's no construct + // to enter a pure epsilon-transition into the expression array I + // work around with the question mark operator to describe the first + // and second branch alternative. + if M = 0 then + begin + State := MakeExpression(_URE_QUEST, State, _URE_NOOP); + Inc(M, 2); + // Mark the pending OR operation (there must always follow at + // least on more alternative because the special case {0, 1} has + // already been handled). + Push(State); + Push(_URE_OR); + end; + + while M <= N do + begin + State := LastState; + // create E^M + for I := 1 to SizeInt(M) - 1 do + begin + Push(State); + Push(_URE_AND); + end; + // finish the branch and mark it as pending OR operation if it + // isn't the last one + CollectPendingOperations(State); + if M < N then + begin + Push(State); + Push(_URE_OR); + end; + Inc(M); + end; + // remove the _URE_PAREN off the stack + Pop; + end; + end; + end; + else + Dec(Head); + Symbol := MakeSymbol(Head, Tail - Head, Used); + Inc(Head, Used); + State := MakeExpression(_URE_SYMBOL, Symbol, _URE_NOOP); + end; + + if (C <> '(') and (C <> '|') and (C <> '{') and (Head < Tail) and + (not IsSpecial(Word(Head^)) or (Head^ = '(')) then + begin + Push(State); + Push(_URE_AND); + end; + end; + + CollectPendingOperations(State); + if FUREBuffer.Stack.ListUsed > 0 then + FUREBuffer.Error := _URE_UNBALANCED_GROUP; + + if FUREBuffer.Error = _URE_OK then + Result := State + else + Result := _URE_NOOP; +end; + +procedure TURESearch.AddSymbolState(Symbol, State: SizeInt); +var + I, J: SizeInt; + Found: Boolean; +begin + // Locate the symbol in the symbol table so the state can be added. + // If the symbol doesn't exist, then we are in serious trouble. + with FUREBuffer.SymbolTable do + begin + I := 0; + while (I < SymbolsUsed) and (Symbol <> Symbols[I].ID) do + Inc(I); + + Assert(I < SymbolsUsed); + end; + + // Now find out if the state exists in the symbol's state list. + with FUREBuffer.SymbolTable.Symbols[I].States do + begin + Found := False; + for J := 0 to ListUsed - 1 do + begin + if State <= List[J] then + begin + Found := True; + Break; + end; + end; + + if not Found then + J := ListUsed; + if not Found or (State < List[J]) then + begin + // Need to add the state in order. + if ListUsed = Length(List) then + SetLength(List, Length(List) + 8); + if J < ListUsed then + Move(List[J], List[J + 1], SizeOf(SizeInt) * (ListUsed - J)); + List[J] := State; + Inc(ListUsed); + end; + end; +end; + +function TURESearch.AddState(NewStates: array of SizeInt): SizeInt; +var + I: SizeInt; + Found: Boolean; +begin + Found := False; + for I := 0 to FUREBuffer.States.StatesUsed - 1 do + begin + if (FUREBuffer.States.States[I].StateList.ListUsed = Length(NewStates)) and + CompareMem(@NewStates[0], @FUREBuffer.States.States[I].StateList.List[0], + SizeOf(SizeInt) * Length(NewStates)) then + begin + Found := True; + Break; + end; + end; + + if not Found then + begin + // Need to add a new DFA State (set of NFA states). + if FUREBuffer.States.StatesUsed = Length(FUREBuffer.States.States) then + SetLength(FUREBuffer.States.States, Length(FUREBuffer.States.States) + 8); + + with FUREBuffer.States.States[FUREBuffer.States.StatesUsed] do + begin + ID := FUREBuffer.States.StatesUsed; + if (StateList.ListUsed + Length(NewStates)) >= Length(StateList.List) then + SetLength(StateList.List, Length(StateList.List) + Length(NewStates) + 8); + Move(NewStates[0], StateList.List[StateList.ListUsed], SizeOf(SizeInt) * Length(NewStates)); + Inc(StateList.ListUsed, Length(NewStates)); + end; + Inc(FUREBuffer.States.StatesUsed); + end; + + // Return the ID of the DFA state representing a group of NFA States. + if Found then + Result := I + else + Result := FUREBuffer.States.StatesUsed - 1; +end; + +procedure TURESearch.Reduce(Start: SizeInt); +var + I, J, + Symbols: SizeInt; + State, + RHS, + s1, s2, + ns1, ns2: SizeInt; + Evaluating: Boolean; +begin + FUREBuffer.Reducing := True; + + // Add the starting state for the reduction. + AddState([Start]); + + // Process each set of NFA states that get created. + I := 0; + // further states are added in the loop + while I < FUREBuffer.States.StatesUsed do + begin + with FUREBuffer, States.States[I], ExpressionList do + begin + // Push the current states on the stack. + for J := 0 to StateList.ListUsed - 1 do + Push(StateList.List[J]); + + // Reduce the NFA states. + Accepting := False; + Symbols := 0; + J := 0; + // need a while loop here as the stack will be modified within the loop and + // so also its usage count used to terminate the loop + while J < FUREBuffer.Stack.ListUsed do + begin + State := FUREBuffer.Stack.List[J]; + Evaluating := True; + + // This inner loop is the iterative equivalent of recursively + // reducing subexpressions generated as a result of a reduction. + while Evaluating do + begin + case Expressions[State].AType of + _URE_SYMBOL: + begin + ns1 := MakeExpression(_URE_ONE, _URE_NOOP, _URE_NOOP); + AddSymbolState(Expressions[State].LHS, ns1); + Inc(Symbols); + Evaluating := False; + end; + _URE_ONE: + begin + Accepting := True; + Evaluating := False; + end; + _URE_QUEST: + begin + s1 := Expressions[State].LHS; + ns1 := MakeExpression(_URE_ONE, _URE_NOOP, _URE_NOOP); + State := MakeExpression(_URE_OR, ns1, s1); + end; + _URE_PLUS: + begin + s1 := Expressions[State].LHS; + ns1 := MakeExpression(_URE_STAR, s1, _URE_NOOP); + State := MakeExpression(_URE_AND, s1, ns1); + end; + _URE_STAR: + begin + s1 := Expressions[State].LHS; + ns1 := MakeExpression(_URE_ONE, _URE_NOOP, _URE_NOOP); + ns2 := MakeExpression(_URE_PLUS, s1, _URE_NOOP); + State := MakeExpression(_URE_OR, ns1, ns2); + end; + _URE_OR: + begin + s1 := Expressions[State].LHS; + s2 := Expressions[State].RHS; + Push(s1); + Push(s2); + Evaluating := False; + end; + _URE_AND: + begin + s1 := Expressions[State].LHS; + s2 := Expressions[State].RHS; + case Expressions[s1].AType of + _URE_SYMBOL: + begin + AddSymbolState(Expressions[s1].LHS, s2); + Inc(Symbols); + Evaluating := False; + end; + _URE_ONE: + State := s2; + _URE_QUEST: + begin + ns1 := Expressions[s1].LHS; + ns2 := MakeExpression(_URE_AND, ns1, s2); + State := MakeExpression(_URE_OR, s2, ns2); + end; + _URE_PLUS: + begin + ns1 := Expressions[s1].LHS; + ns2 := MakeExpression(_URE_OR, s2, State); + State := MakeExpression(_URE_AND, ns1, ns2); + end; + _URE_STAR: + begin + ns1 := Expressions[s1].LHS; + ns2 := MakeExpression(_URE_AND, ns1, State); + State := MakeExpression(_URE_OR, s2, ns2); + end; + _URE_OR: + begin + ns1 := Expressions[s1].LHS; + ns2 := Expressions[s1].RHS; + ns1 := MakeExpression(_URE_AND, ns1, s2); + ns2 := MakeExpression(_URE_AND, ns2, s2); + State := MakeExpression(_URE_OR, ns1, ns2); + end; + _URE_AND: + begin + ns1 := Expressions[s1].LHS; + ns2 := Expressions[s1].RHS; + ns2 := MakeExpression(_URE_AND, ns2, s2); + State := MakeExpression(_URE_AND, ns1, ns2); + end; + end; + end; + end; + end; + Inc(J); + end; + + // clear the state stack + while Pop <> _URE_NOOP do + { nothing }; + + // generate the DFA states for the symbols collected during the current reduction + if (TransitionsUsed + Symbols) > Length(Transitions) then + SetLength(Transitions, Length(Transitions) + Symbols); + + // go through the symbol table and generate the DFA state transitions for + // each symbol that has collected NFA states + Symbols := 0; + J := 0; + while J < FUREBuffer.SymbolTable.SymbolsUsed do + begin + begin + if FUREBuffer.SymbolTable.Symbols[J].States.ListUsed > 0 then + begin + Transitions[Symbols].LHS := FUREBuffer.SymbolTable.Symbols[J].ID; + with FUREBuffer.SymbolTable.Symbols[J] do + begin + RHS := AddState(Copy(States.List, 0, States.ListUsed)); + States.ListUsed := 0; + end; + Transitions[Symbols].RHS := RHS; + Inc(Symbols); + end; + end; + Inc(J); + end; + + // set the number of transitions actually used + // Note: we need again to qualify a part of the TransistionsUsed path since the + // state array could be reallocated in the AddState call above and the + // with ... do will then be invalid. + States.States[I].TransitionsUsed := Symbols; + end; + Inc(I); + end; + FUREBuffer.Reducing := False; +end; + +procedure TURESearch.AddEquivalentPair(L, R: SizeInt); +var + I: SizeInt; +begin + L := FUREBuffer.States.States[L].ID; + R := FUREBuffer.States.States[R].ID; + + if L <> R then + begin + if L > R then + begin + I := L; + L := R; + R := I; + end; + + // Check to see if the equivalence pair already exists. + I := 0; + with FUREBuffer.EquivalentList do + begin + while (I < EquivalentsUsed) and + ((Equivalents[I].Left <> L) or (Equivalents[I].Right <> R)) do + Inc(I); + + if I >= EquivalentsUsed then + begin + if EquivalentsUsed = Length(Equivalents) then + SetLength(Equivalents, Length(Equivalents) + 8); + + Equivalents[EquivalentsUsed].Left := L; + Equivalents[EquivalentsUsed].Right := R; + Inc(EquivalentsUsed); + end; + end; + end; +end; + +procedure TURESearch.MergeEquivalents; +// merges the DFA states that are equivalent +var + I, J, K, + Equal: SizeInt; + Done: Boolean; + State1, State2, + LeftState, + RightState: PUcState; +begin + for I := 0 to FUREBuffer.States.StatesUsed - 1 do + begin + State1 := @FUREBuffer.States.States[I]; + if State1.ID = SizeInt(I) then + begin + J := 0; + while J < I do + begin + State2 := @FUREBuffer.States.States[J]; + if State2.ID = SizeInt(J) then + begin + FUREBuffer.EquivalentList.EquivalentsUsed := 0; + AddEquivalentPair(I, J); + + Done := False; + Equal := 0; + while Equal < FUREBuffer.EquivalentList.EquivalentsUsed do + begin + LeftState := @FUREBuffer.States.States[FUREBuffer.EquivalentList.Equivalents[Equal].Left]; + RightState := @FUREBuffer.States.States[FUREBuffer.EquivalentList.Equivalents[Equal].Right]; + + if (LeftState.Accepting <> RightState.Accepting) or + (LeftState.TransitionsUsed <> RightState.TransitionsUsed) then + begin + Done := True; + Break; + end; + + K := 0; + while (K < LeftState.TransitionsUsed) and + (LeftState.Transitions[K].LHS = RightState.Transitions[K].LHS) do + Inc(K); + + if K < LeftState.TransitionsUsed then + begin + Done := True; + Break; + end; + + for K := 0 to LeftState.TransitionsUsed - 1 do + AddEquivalentPair(LeftState.Transitions[K].RHS, RightState.Transitions[K].RHS); + + Inc(Equal); + end; + + if not Done then + Break; + end; + Inc(J); + end; + + if J < I then + begin + with FUREBuffer do + begin + for Equal := 0 to EquivalentList.EquivalentsUsed - 1 do + begin + States.States[EquivalentList.Equivalents[Equal].Right].ID := + States.States[EquivalentList.Equivalents[Equal].Left].ID; + end; + end; + end; + + end; + end; + + // Renumber the states appropriately + State1 := @FUREBuffer.States.States[0]; + Equal := 0; + for I := 0 to FUREBuffer.States.StatesUsed - 1 do + begin + if State1.ID = SizeInt(I) then + begin + State1.ID := Equal; + Inc(Equal); + end + else + State1.ID := FUREBuffer.States.States[State1.ID].ID; + Inc(State1); + end; +end; + +procedure TURESearch.ClearUREBuffer; +var + I: SizeInt; +begin + with FUREBuffer do + begin + // quite a few dynamic arrays to free + Stack.List := nil; + ExpressionList.Expressions := nil; + + // the symbol table has been handed over to the DFA and will be freed on + // release of the DFA + SymbolTable.SymbolsUsed := 0; + + for I := 0 to States.StatesUsed - 1 do + begin + States.States[I].Transitions := nil; + States.States[I].StateList.List := nil; + States.States[I].StateList.ListUsed := 0; + States.States[I].TransitionsUsed := 0; + end; + + States.StatesUsed := 0; + States.States := nil; + EquivalentList.Equivalents := nil; + end; + ResetMemory(FUREBuffer, SizeOf(FUREBuffer)); +end; + +procedure TURESearch.CompileURE(RE: PWideChar; RELength: SizeInt; Casefold: Boolean); +var + I, J: SizeInt; + State: SizeInt; + Run: PUcState; + TP: SizeInt; + + procedure UREError(Text: string; RE: PWideChar); + var + S: string; + begin + S := RE; + raise EJclUnicodeError.CreateResFmt(@RsUREErrorFmt, [LoadResString(@RsUREBaseString), Text, S]); + end; + +begin + // be paranoid + if (RE <> nil) and (RE^ <> WideNull) and (RELength > 0) then + begin + // Reset the various fields of the compilation buffer. Default the Flags + // to indicate the presense of the "^$" pattern. If any other pattern + // occurs, then this flag will be removed. This is done to catch this + // special pattern and handle it specially when matching. + ClearUREBuffer; + ClearDFA; + FUREBuffer.Flags := _URE_DFA_BLANKLINE; + if Casefold then + FUREBuffer.Flags := FUREBuffer.Flags or _URE_DFA_CASEFOLD; + + // Construct the NFA. If this stage returns a 0, then an error occurred or an + // empty expression was passed. + State := ConvertRegExpToNFA(RE, RELength); + if State <> _URE_NOOP then + begin + // Do the expression reduction to get the initial DFA. + Reduce(State); + + // Merge all the equivalent DFA States. + MergeEquivalents; + + // Construct the minimal DFA. + FDFA.Flags := FUREBuffer.Flags and (_URE_DFA_CASEFOLD or _URE_DFA_BLANKLINE); + + // Free up the NFA state groups and transfer the symbols from the buffer + // to the DFA. + FDFA.SymbolTable := FUREBuffer.SymbolTable; + FUREBuffer.SymbolTable.Symbols := nil; + + // Collect the total number of states and transitions needed for the DFA. + State := 0; + for I := 0 to FUREBuffer.States.StatesUsed - 1 do + begin + if FUREBuffer.States.States[I].ID = State then + begin + Inc(FDFA.StateList.StatesUsed); + Inc(FDFA.TransitionList.TransitionsUsed, FUREBuffer.States.States[I].TransitionsUsed); + Inc(State); + end; + end; + + // Allocate enough space for the states and transitions. + SetLength(FDFA.StateList.States, FDFA.StateList.StatesUsed); + SetLength(FDFA.TransitionList.Transitions, FDFA.TransitionList.TransitionsUsed); + + // Actually transfer the DFA States from the buffer. + State := 0; + TP := 0; + Run := @FUREBuffer.States.States[0]; + for I := 0 to FUREBuffer.States.StatesUsed - 1 do + begin + if Run.ID = State then + begin + FDFA.StateList.States[I].StartTransition := TP; + FDFA.StateList.States[I].NumberTransitions := Run.TransitionsUsed; + FDFA.StateList.States[I].Accepting := Run.Accepting; + + // Add the transitions for the state + for J := 0 to FDFA.StateList.States[I].NumberTransitions - 1 do + begin + FDFA.TransitionList.Transitions[TP].Symbol := Run.Transitions[J].LHS; + FDFA.TransitionList.Transitions[TP].NextState := + FUREBuffer.States.States[Run.Transitions[J].RHS].ID; + Inc(TP); + end; + + Inc(State); + end; + Inc(Run); + end; + end + else + begin + // there might be an error while parsing the pattern, show it if so + case FUREBuffer.Error of + _URE_UNEXPECTED_EOS: + UREError(LoadResString(@RsUREUnexpectedEOS), RE); + _URE_CCLASS_OPEN: + UREError(LoadResString(@RsURECharacterClassOpen), RE); + _URE_UNBALANCED_GROUP: + UREError(LoadResString(@RsUREUnbalancedGroup), RE); + _URE_INVALID_PROPERTY: + UREError(LoadResString(@RsUREInvalidCharProperty), RE); + _URE_INVALID_RANGE: + UREError(LoadResString(@RsUREInvalidRepeatRange), RE); + _URE_RANGE_OPEN: + UREError(LoadResString(@RsURERepeatRangeOpen), RE); + else + // expression was empty + raise EJclUnicodeError.CreateRes(@RsUREExpressionEmpty); + end; + end; + end; +end; + +procedure TURESearch.ClearDFA; +var + I: SizeInt; +begin + with FDFA do + begin + for I := 0 to SymbolTable.SymbolsUsed - 1 do + begin + if (SymbolTable.Symbols[I].AType = _URE_CCLASS) or + (SymbolTable.Symbols[I].AType = _URE_NCCLASS) then + SymbolTable.Symbols[I].Symbol.CCL.Ranges := nil; + end; + + for I := 0 to SymbolTable.SymbolsUsed - 1 do + begin + FDFA.SymbolTable.Symbols[I].States.List := nil; + FDFA.SymbolTable.Symbols[I].States.ListUsed := 0; + end; + SymbolTable.SymbolsUsed := 0; + + SymbolTable.Symbols := nil; + StateList.States := nil; + TransitionList.Transitions := nil; + end; + ResetMemory(FDFA, SizeOf(FDFA)); +end; + +function IsSeparator(C: UCS4): Boolean; +begin + Result := (C = $D) or (C = $A) or (C = $2028) or (C = $2029); +end; + +function TURESearch.ExecuteURE(Flags: Cardinal; Text: PUCS2; TextLen: SizeInt; var MatchStart, + MatchEnd: SizeInt): Boolean; +var + I, J: SizeInt; + Matched, + Found: Boolean; + Start, Stop: SizeInt; + C: UCS4; + Run, Tail, lp: PUCS2; + LastState: PDFAState; + Symbol: PUcSymbolTableEntry; + Rp: PUcRange; + LCMapping: TUCS4Array; +begin + Result := False; + if Text <> nil then + begin + // Handle the special case of an empty string matching the "^$" pattern. + if (Textlen = 0) and ((FDFA.Flags and _URE_DFA_BLANKLINE) <> 0) then + begin + MatchStart := 0; + MatchEnd := 0; + Result := True; + Exit; + end; + + Run := Text; + Tail := Run + TextLen; + Start := -1; + Stop := -1; + LastState := @FDFA.StateList.States[0]; + + Found := False; + while not Found and (Run < Tail) do + begin + lp := Run; + C := UCS4(Run^); + Inc(Run); + + // Check to see if this is a high surrogate that should be combined with a + // following low surrogate. + if (Run < Tail) and + (SurrogateHighStart <= C) and (C <= SurrogateHighEnd) and + (SurrogateLowStart <= UCS4(Run^)) and (UCS4(Run^) <= SurrogateLowEnd) then + begin + C := $10000 + (((C and $03FF) shl 10) or (UCS4(Run^) and $03FF)); + Inc(Run); + end; + + // Determine if the character is non-spacing and should be skipped. + if ((Flags and URE_IGNORE_NONSPACING) <> 0) and UnicodeIsNonSpacing(C) then + begin + Inc(Run); + Continue; + end; + + if (FDFA.Flags and _URE_DFA_CASEFOLD) <> 0 then + begin + SetLength(LCMapping, 0); + { TODO : use the entire mapping, not only the first character } + // (CaseLookup used for a little extra speed: avoids dynamic array allocation) + if CaseLookup(C, ctLower, LCMapping) then + C := LCMapping[0]; + end; + + // See if one of the transitions matches. + I := LastState.NumberTransitions - 1; + Matched := False; + + while not Matched and (I >= 0) do + begin + Symbol := @FDFA.SymbolTable.Symbols[FDFA.TransitionList.Transitions[LastState.StartTransition + I].Symbol]; + case Symbol.AType of + _URE_ANY_CHAR: + if ((Flags and URE_DONT_MATCHES_SEPARATORS) <> 0) or + not IsSeparator(C) then + Matched := True; + _URE_CHAR: + if C = Symbol.Symbol.Chr then + Matched := True; + _URE_BOL_ANCHOR: + if Lp = Text then + begin + Run := lp; + Matched := True; + end + else + begin + if IsSeparator(C) then + begin + if (C = $D) and (Run < Tail) and (Run^ = #$A) then + Inc(Run); + Lp := Run; + Matched := True; + end; + end; + _URE_EOL_ANCHOR: + if IsSeparator(C) then + begin + // Put the pointer back before the separator so the match end + // position will be correct. This will also cause the `Run' + // pointer to be advanced over the current separator once the + // match end point has been recorded. + Run := Lp; + Matched := True; + end; + _URE_CCLASS, + _URE_NCCLASS: + with Symbol^ do + begin + if Categories <> [] then + Matched := CategoryLookup(C, Categories); + if Symbol.CCL.RangesUsed > 0 then + begin + Rp := @Symbol.CCL.Ranges[0]; + for J := 0 to Symbol.CCL.RangesUsed - 1 do + begin + if (Rp.MinCode <= C) and (C <= Rp.MaxCode) then + begin + Matched := True; + Break; + end; + Inc(Rp); + end; + end; + + if AType = _URE_NCCLASS then + Matched := not Matched; + end; + end; + + if Matched then + begin + if Start = -1 then + Start := Lp - Text + else + Stop := Run - Text; + + LastState := @FDFA.StateList.States[FDFA.TransitionList.Transitions[LastState.StartTransition + I].NextState]; + + // If the match was an EOL anchor, adjust the pointer past the separator + // that caused the match. The correct match position has been recorded + // already. + if Symbol.AType = _URE_EOL_ANCHOR then + begin + // skip the character that caused the match + Inc(Run); + // handle the infamous CRLF situation + if (Run < Tail) and (C = $D) and (Run^ = #$A) then + Inc(Run); + end; + end; + Dec(I); + end; + + if not Matched then + begin + Found := LastState.Accepting; + if not Found then + begin + // If the last state was not accepting, then reset and start over. + LastState := @FDFA.StateList.States[0]; + Start := -1; + Stop := -1; + end + else + begin + // set start and stop pointer if not yet done + if Start = -1 then + begin + Start := Lp - Text; + Stop := Run - Text; + end + else + begin + if Stop = -1 then + Stop := Lp - Text; + end; + end; + end + else + begin + if Run = Tail then + begin + if not LastState.Accepting then + begin + // This ugly hack is to make sure the end-of-line anchors match + // when the source text hits the end. This is only done if the last + // subexpression matches. + for I := 0 to LastState.NumberTransitions - 1 do + begin + if Found then + Break; + Symbol := @FDFA.SymbolTable.Symbols[FDFA.TransitionList.Transitions[LastState.StartTransition + I].Symbol]; + if Symbol.AType =_URE_EOL_ANCHOR then + begin + LastState := @FDFA.StateList.States[FDFA.TransitionList.Transitions[LastState.StartTransition + I].NextState]; + if LastState.Accepting then + begin + Stop := Run - Text; + Found := True; + end + else + Break; + end; + end; + end + else + begin + // Make sure any conditions that match all the way to the end of + // the string match. + Found := True; + Stop := Run - Text; + end; + end; + end; + end; + + if Found then + begin + MatchStart := Start; + MatchEnd := Stop; + end; + Result := Found; + end; +end; + +function TURESearch.FindAll(const Text: WideString): Boolean; +begin + Result := FindAll(PWideChar(Text), Length(Text)); +end; + +function TURESearch.FindAll(Text: PWideChar; TextLen: SizeInt): Boolean; +// Looks for all occurrences of the pattern passed to FindPrepare and creates an +// internal list of their positions. +var + Start, Stop: SizeInt; + Run: PWideChar; + RunLen: SizeInt; +begin + ClearResults; + Run := Text; + RunLen := TextLen; + // repeat to find all occurrences of the pattern + Start := 0; + Stop := 0; + while ExecuteURE(0, Run, RunLen, Start, Stop) do + begin + // store this result (consider text pointer movement)... + AddResult(Start + (Run - Text), Stop + (Run - Text)); + // ... and advance text position and length + Inc(Run, Stop); + Dec(RunLen, Stop); + end; + Result := FResults.Count > 0; +end; + +function TURESearch.FindFirst(const Text: WideString; var Start, Stop: SizeInt): Boolean; +begin + Result := FindFirst(PWideChar(Text), Length(Text), Start, Stop); +end; + +function TURESearch.FindFirst(Text: PWideChar; TextLen: SizeInt; var Start, Stop: SizeInt): Boolean; +// Looks for the first occurrence of the pattern passed to FindPrepare in Text and +// returns True if one could be found (in which case Start and Stop are set to +// the according indices) otherwise False. This function is in particular of +// interest if only one occurrence needs to be found. +begin + ClearResults; + Result := ExecuteURE(0, Text, TextLen, Start, Stop); + if Result then + AddResult(Start, Stop); +end; + +procedure TURESearch.FindPrepare(Pattern: PWideChar; PatternLength: SizeInt; Options: TSearchFlags); +begin + CompileURE(Pattern, PatternLength, not (sfCaseSensitive in Options)); +end; + +procedure TURESearch.FindPrepare(const Pattern: WideString; Options: TSearchFlags); +begin + CompileURE(PWideChar(Pattern), Length(Pattern), not (sfCaseSensitive in Options)); +end; + +//=== { TWideStrings } ======================================================= + +constructor TWideStrings.Create; +begin + inherited Create; + FLanguage := GetUserDefaultLCID; + FNormalizationForm := nfC; + FSaveFormat := sfUnicodeLSB; +end; + +procedure TWideStrings.SetLanguage(Value: LCID); +begin + FLanguage := Value; +end; + +function TWideStrings.GetSaveUnicode: Boolean; +begin + Result := SaveFormat = sfUnicodeLSB; +end; + +procedure TWideStrings.SetSaveUnicode(const Value: Boolean); +begin + if Value then + SaveFormat := sfUnicodeLSB + else + SaveFormat := sfAnsi; +end; + +function TWideStrings.Add(const S: WideString): Integer; +begin + Result := GetCount; + Insert(Result, S); +end; + +function TWideStrings.AddObject(const S: WideString; AObject: TObject): Integer; +begin + Result := Add(S); + PutObject(Result, AObject); +end; + +procedure TWideStrings.Append(const S: WideString); +begin + Add(S); +end; + +procedure TWideStrings.AddStrings(Strings: TStrings); +var + I: Integer; + {$IFNDEF SUPPORTS_UNICODE} + CP: Word; + {$ENDIF ~SUPPORTS_UNICODE} +begin + BeginUpdate; + try + {$IFNDEF SUPPORTS_UNICODE} + CP := CodePageFromLocale(FLanguage); + {$ENDIF ~SUPPORTS_UNICODE} + for I := 0 to Strings.Count - 1 do + begin + {$IFDEF SUPPORTS_UNICODE} + AddObject(Strings[I], Strings.Objects[I]) + {$ELSE ~SUPPORTS_UNICODE} + AddObject(StringToWideStringEx(Strings[I], CP), Strings.Objects[I]) + {$ENDIF ~SUPPORTS_UNICODE} + end; + finally + EndUpdate; + end; +end; + +procedure TWideStrings.AddStrings(Strings: TWideStrings); +var + I: Integer; +begin + Assert(Strings <> nil); + + BeginUpdate; + try + for I := 0 to Strings.Count - 1 do + AddObject(Strings[I], Strings.Objects[I]); + finally + EndUpdate; + end; +end; + +procedure TWideStrings.Assign(Source: TPersistent); +// usual assignment routine, but able to assign wide and small strings +begin + if Source is TWideStrings then + begin + BeginUpdate; + try + Clear; + AddStrings(TWideStrings(Source)); + finally + EndUpdate; + end; + end + else + begin + if Source is TStrings then + begin + BeginUpdate; + try + Clear; + AddStrings(TStrings(Source)); + finally + EndUpdate; + end; + end + else + inherited Assign(Source); + end; +end; + +procedure TWideStrings.AssignTo(Dest: TPersistent); +// need to do also assignment to old style TStrings, but this class doesn't know +// TWideStrings, so we need to do it from here +var + I: Integer; + {$IFNDEF SUPPORTS_UNICODE} + CP: Word; + {$ENDIF ~SUPPORTS_UNICODE} +begin + if Dest is TStrings then + begin + with Dest as TStrings do + begin + BeginUpdate; + try + {$IFNDEF SUPPORTS_UNICODE} + CP := CodePageFromLocale(FLanguage); + {$ENDIF SUPPORTS_UNICODE} + Clear; + for I := 0 to Self.Count - 1 do + begin + {$IFDEF SUPPORTS_UNICODE} + AddObject(Self[I], Self.Objects[I]); + {$ELSE ~SUPPORTS_UNICODE} + AddObject(WideStringToStringEx(Self[I], CP), Self.Objects[I]); + {$ENDIF ~SUPPORTS_UNICODE} + end; + finally + EndUpdate; + end; + end; + end + else + begin + if Dest is TWideStrings then + begin + with Dest as TWideStrings do + begin + BeginUpdate; + try + Clear; + AddStrings(Self); + finally + EndUpdate; + end; + end; + end + else + inherited AssignTo(Dest); + end; +end; + +procedure TWideStrings.BeginUpdate; +begin + if FUpdateCount = 0 then + SetUpdateState(True); + Inc(FUpdateCount); +end; + +procedure TWideStrings.DefineProperties(Filer: TFiler); + +// Defines a private property for the content of the list. +// There's a bug in the handling of text DFMs in Classes.pas which prevents +// WideStrings from loading under some circumstances. Zbysek Hlinka +// (zhlinka att login dott cz) brought this to my attention and supplied also a solution. +// See ReadData and WriteData methods for implementation details. + + //--------------- local function -------------------------------------------- + + function DoWrite: Boolean; + begin + if Filer.Ancestor <> nil then + begin + Result := True; + if Filer.Ancestor is TWideStrings then + Result := not Equals(TWideStrings(Filer.Ancestor)) + end + else + Result := Count > 0; + end; + + //--------------- end local function ---------------------------------------- + +begin + Filer.DefineProperty('WideStrings', ReadData, WriteData, DoWrite); +end; + +procedure TWideStrings.DoConfirmConversion(var Allowed: Boolean); +begin + if Assigned(FOnConfirmConversion) then + FOnConfirmConversion(Self, Allowed); +end; + +procedure TWideStrings.EndUpdate; +begin + Dec(FUpdateCount); + if FUpdateCount = 0 then + SetUpdateState(False); +end; + +function TWideStrings.Equals(Strings: TWideStrings): Boolean; +var + I, Count: Integer; +begin + Assert(Strings <> nil); + + Result := False; + Count := GetCount; + if Count <> Strings.GetCount then + Exit; + { TODO : use internal comparation routine as soon as composition is implemented } + for I := 0 to Count - 1 do + if Get(I) <> Strings.Get(I) then + Exit; + Result := True; +end; + +procedure TWideStrings.Error(const Msg: string; Data: Integer); + + function ReturnAddr: Pointer; + asm + {$IFDEF CPU32} + MOV EAX, EBP + MOV EAX, [EAX + 4] + {$ENDIF CPU32} + {$IFDEF CPU64} + MOV RAX, RBP + MOV RAX, [RAX + 8] + {$ENDIF CPU64} + end; + +begin + raise EStringListError.CreateFmt(Msg, [Data]) at ReturnAddr; +end; + +procedure TWideStrings.Exchange(Index1, Index2: Integer); +var + TempObject: TObject; + TempString: WideString; +begin + BeginUpdate; + try + TempString := Strings[Index1]; + TempObject := Objects[Index1]; + Strings[Index1] := Strings[Index2]; + Objects[Index1] := Objects[Index2]; + Strings[Index2] := TempString; + Objects[Index2] := TempObject; + finally + EndUpdate; + end; +end; + +function TWideStrings.GetCapacity: Integer; +// Descendants may optionally override/replace this default implementation. +begin + Result := Count; +end; + +function TWideStrings.GetCommaText: WideString; +var + S: WideString; + P: PWideChar; + I, Count: Integer; +begin + Count := GetCount; + if (Count = 1) and (Get(0) = '') then + Result := '""' + else + begin + Result := ''; + for I := 0 to Count - 1 do + begin + S := Get(I); + P := PWideChar(S); + while (P^ > WideSpace) and (P^ <> '"') and (P^ <> ',') do + Inc(P); + if P^ <> WideNull then + S := WideQuotedStr(S, '"'); + Result := Result + S + ','; + end; + System.Delete(Result, Length(Result), 1); + end; +end; + +function TWideStrings.GetName(Index: Integer): WideString; +var + P: Integer; +begin + Result := Get(Index); + P := Pos('=', Result); + if P > 0 then + SetLength(Result, P - 1) + else + Result := ''; +end; + +function TWideStrings.GetObject(Index: Integer): TObject; +begin + Result := nil; +end; + +function TWideStrings.GetSeparatedText(Separators: WideString): WideString; +// Same as GetText but with customizable separator characters. +var + I, L, + Size, + Count, + SepSize: Integer; + P: PWideChar; + S: WideString; +begin + Count := GetCount; + SepSize := Length(Separators); + Size := 0; + for I := 0 to Count - 1 do + Inc(Size, Length(Get(I)) + SepSize); + + // set one separator less, the last line does not need a trailing separator + SetLength(Result, Size - SepSize); + if Size > 0 then + begin + P := Pointer(Result); + I := 0; + while True do + begin + S := Get(I); + L := Length(S); + if L <> 0 then + begin + // add current string + System.Move(Pointer(S)^, P^, 2 * L); + Inc(P, L); + end; + Inc(I); + if I = Count then + Break; + + // add separators + System.Move(Pointer(Separators)^, P^, SizeOf(WideChar) * SepSize); + Inc(P, SepSize); + end; + end; +end; + +function TWideStrings.GetTextStr: WideString; +begin + Result := GetSeparatedText(WideCRLF); +end; + +function TWideStrings.GetText: PWideChar; +begin + Result := StrNewW(GetTextStr); +end; + +function TWideStrings.GetValue(const Name: WideString): WideString; +var + I: Integer; +begin + I := IndexOfName(Name); + if I >= 0 then + Result := Copy(Get(I), Length(Name) + 2, MaxInt) + else + Result := ''; +end; + +function TWideStrings.IndexOf(const S: WideString): Integer; +var + NormString: WideString; +begin + NormString := WideNormalize(S, FNormalizationForm); + + for Result := 0 to GetCount - 1 do + if WideCompareText(Get(Result), NormString, FLanguage) = 0 then + Exit; + Result := -1; +end; + +function TWideStrings.IndexOfName(const Name: WideString): Integer; +var + P: Integer; + S: WideString; + NormName: WideString; +begin + NormName := WideNormalize(Name, FNormalizationForm); + + for Result := 0 to GetCount - 1 do + begin + S := Get(Result); + P := Pos('=', S); + if (P > 0) and (WideCompareText(Copy(S, 1, P - 1), NormName, FLanguage) = 0) then + Exit; + end; + Result := -1; +end; + +function TWideStrings.IndexOfObject(AObject: TObject): Integer; +begin + for Result := 0 to GetCount - 1 do + if GetObject(Result) = AObject then + Exit; + Result := -1; +end; + +procedure TWideStrings.InsertObject(Index: Integer; const S: WideString; AObject: TObject); +begin + Insert(Index, S); + PutObject(Index, AObject); +end; + +procedure TWideStrings.LoadFromFile(const FileName: TFileName); +var + Stream: TStream; +begin + try + Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); + try + LoadFromStream(Stream); + finally + Stream.Free; + end; + except + RaiseLastOSError; + end; +end; + +procedure TWideStrings.LoadFromStream(Stream: TStream); +// usual loader routine, but enhanced to handle byte order marks in stream +var + Size, + BytesRead: Integer; + ByteOrderMask: array [0..5] of Byte; // BOM size is max 5 bytes (cf: wikipedia) + // but it is easier to implement with a multiple of 2 + Loaded: Boolean; + SW: WideString; + SA: AnsiString; +begin + BeginUpdate; + try + Loaded := False; + + Size := Stream.Size - Stream.Position; + ByteOrderMask[0] := 0; + BytesRead := Stream.Read(ByteOrderMask[0],SizeOf(ByteOrderMask)); + + // UTF16 LSB = Unicode LSB + if (BytesRead >= 2) and (ByteOrderMask[0] = BOM_UTF16_LSB[0]) + and (ByteOrderMask[1] = BOM_UTF16_LSB[1]) then + begin + FSaveFormat := sfUTF16LSB; + SetLength(SW, (Size - 2) div SizeOf(WideChar)); + Assert((Size and 1) <> 1,'Number of chars must be a multiple of 2'); + if BytesRead > 2 then + begin + System.Move(ByteOrderMask[2], SW[1], BytesRead-2); // max 4 bytes = 2 widechars + if Size > BytesRead then + // first 2 chars (maximum) were copied by System.Move + Stream.Read(SW[3], Size-BytesRead); + end; + SetText(SW); + Loaded := True; + end; + + // UTF16 MSB = Unicode MSB + if (BytesRead >= 2) and (ByteOrderMask[0] = BOM_UTF16_MSB[0]) + and (ByteOrderMask[1] = BOM_UTF16_MSB[1]) then + begin + FSaveFormat := sfUTF16MSB; + SetLength(SW, (Size - 2) div SizeOf(WideChar)); + Assert((Size and 1) <> 1,'Number of chars must be a multiple of 2'); + if BytesRead > 2 then + begin + System.Move(ByteOrderMask[2],SW[1],BytesRead-2); // max 4 bytes = 2 widechars + if Size > BytesRead then + // first 2 chars (maximum) were copied by System.Move + Stream.Read(SW[3], Size-BytesRead); + StrSwapByteOrder(PWideChar(SW)); + end; + SetText(SW); + Loaded := True; + end; + + // UTF8 + if (BytesRead >= 3) and (ByteOrderMask[0] = BOM_UTF8[0]) + and (ByteOrderMask[1] = BOM_UTF8[1]) and (ByteOrderMask[2] = BOM_UTF8[2]) then + begin + FSaveFormat := sfUTF8; + SetLength(SA, (Size-3) div SizeOf(AnsiChar)); + if BytesRead > 3 then + begin + System.Move(ByteOrderMask[3],SA[1],BytesRead-3); // max 3 bytes = 3 chars + if Size > BytesRead then + // first 3 chars were copied by System.Move + Stream.Read(SA[4], Size-BytesRead); + SW := UTF8ToWideString(SA); + end; + SetText(SW); + Loaded := True; + end; + + // default case (Ansi) + if not Loaded then + begin + FSaveFormat := sfAnsi; + SetLength(SA, Size div SizeOf(AnsiChar)); + if BytesRead > 0 then + begin + System.Move(ByteOrderMask[0], SA[1], BytesRead); // max 6 bytes = 6 chars + if Size > BytesRead then + Stream.Read(SA[7], Size-BytesRead); // first 6 chars were copied by System.Move + end; + SetText(StringToWideStringEx(SA, CodePageFromLocale(FLanguage))); + end; + finally + EndUpdate; + end; +end; + +procedure TWideStrings.Move(CurIndex, NewIndex: Integer); +var + TempObject: TObject; + TempString: WideString; +begin + if CurIndex <> NewIndex then + begin + BeginUpdate; + try + TempString := Get(CurIndex); + TempObject := GetObject(CurIndex); + Delete(CurIndex); + InsertObject(NewIndex, TempString, TempObject); + finally + EndUpdate; + end; + end; +end; + +procedure TWideStrings.ReadData(Reader: TReader); +begin + case Reader.NextValue of + vaLString, vaString: + SetText(Reader.ReadString); + else + SetText(Reader.{$IFDEF RTL240_UP}ReadString{$ELSE}ReadWideString{$ENDIF}); + end; +end; + +procedure TWideStrings.SaveToFile(const FileName: TFileName); +var + Stream: TStream; +begin + Stream := TFileStream.Create(FileName, fmCreate); + try + SaveToStream(Stream); + finally + Stream.Free; + end; +end; + +procedure TWideStrings.SaveToStream(Stream: TStream; WithBOM: Boolean = True); +// Saves the currently loaded text into the given stream. WithBOM determines whether to write a +// byte order mark or not. Note: when saved as ANSI text there will never be a BOM. +var + SW: WideString; + SA: AnsiString; + Allowed: Boolean; + Run: PWideChar; +begin + // The application can decide in which format to save the content. + // If FSaveUnicode is False then all strings are saved in standard ANSI format + // which is also loadable by TStrings but you should be aware that all Unicode + // strings are then converted to ANSI based on the current system locale. + // An extra event is supplied to ask the user about the potential loss of + // information when converting Unicode to ANSI strings. + SW := GetTextStr; + Allowed := True; + FSaved := False; // be pessimistic + // A check for potential information loss makes only sense if the application has + // set an event to be used as call back to ask about the conversion. + if (FSaveFormat = sfAnsi) and Assigned(FOnConfirmConversion) then + begin + // application requests to save only ANSI characters, so check the text and + // call back in case information could be lost + Run := PWideChar(SW); + // only ask if there's at least one Unicode character in the text + while (Run^>#0) and (run^<=#255) do + Inc(Run); + // Note: The application can still set FSaveUnicode to True in the callback. + if Run^ <> WideNull then + DoConfirmConversion(Allowed); + end; + + if Allowed then + begin + // only save if allowed + case SaveFormat of + sfUTF16LSB : + begin + if WithBOM then + Stream.WriteBuffer(BOM_UTF16_LSB[0],SizeOf(BOM_UTF16_LSB)); + if Length(SW) > 0 then + Stream.WriteBuffer(SW[1],Length(SW)*SizeOf(UTF16)); + FSaved := True; + end; + sfUTF16MSB : + begin + if WithBOM then + Stream.WriteBuffer(BOM_UTF16_MSB[0],SizeOf(BOM_UTF16_MSB)); + if Length(SW) > 0 then + begin + StrSwapByteOrder(PWideChar(SW)); + Stream.WriteBuffer(SW[1],Length(SW)*SizeOf(UTF16)); + end; + FSaved := True; + end; + sfUTF8 : + begin + if WithBOM then + Stream.WriteBuffer(BOM_UTF8[0],SizeOf(BOM_UTF8)); + if Length(SW) > 0 then + begin + SA := WideStringToUTF8(SW); + Stream.WriteBuffer(SA[1],Length(SA)*SizeOf(UTF8)); + end; + FSaved := True; + end; + sfAnsi : + begin + if Length(SW) > 0 then + begin + SA := WideStringToStringEx(SW,CodePageFromLocale(FLanguage)); + Stream.WriteBuffer(SA[1],Length(SA)*SizeOf(AnsiChar)); + end; + FSaved := True; + end; + end; + end; +end; + +procedure TWideStrings.SetCapacity(NewCapacity: Integer); +begin + // do nothing - descendants may optionally implement this method +end; + +procedure TWideStrings.SetCommaText(const Value: WideString); +var + P, P1: PWideChar; + S: WideString; +begin + BeginUpdate; + try + Clear; + P := PWideChar(Value); + while (P^ >= #1) and (P^ <= WideSpace) do + Inc(P); + while P^ <> WideNull do + begin + if P^ = '"' then + S := WideExtractQuotedStr(P, '"') + else + begin + P1 := P; + while (P^ > WideSpace) and (P^ <> ',') do + Inc(P); + SetString(S, P1, P - P1); + end; + Add(S); + + while (P^ >= #1) and (P^ <= WideSpace) do + Inc(P); + if P^ = ',' then + begin + repeat + Inc(P); + until not ((P^ >= #1) and (P^ <= WideSpace)); + end; + end; + finally + EndUpdate; + end; +end; + +procedure TWideStrings.SetText(const Value: WideString); +var + Head, + Tail: PWideChar; + S: WideString; +begin + BeginUpdate; + try + Clear; + Head := PWideChar(Value); + while Head^ <> WideNull do + begin + Tail := Head; + while (Tail^ <> WideNull) and (Tail^ <> WideLineFeed) and (Tail^ <> WideCarriageReturn) and + (Tail^ <> WideVerticalTab) and (Tail^ <> WideFormFeed) and (Tail^ <> WideLineSeparator) and + (Tail^ <> WideParagraphSeparator) do + Inc(Tail); + SetString(S, Head, Tail - Head); + Add(S); + Head := Tail; + if Head^ <> WideNull then + begin + Inc(Head); + if (Tail^ = WideCarriageReturn) and (Head^ = WideLineFeed) then + Inc(Head); + end; + end; + finally + EndUpdate; + end; +end; + +procedure TWideStrings.SetUpdateState(Updating: Boolean); +begin +end; + +procedure TWideStrings.SetNormalizationForm(const Value: TNormalizationForm); +var + I: Integer; +begin + if FNormalizationForm <> Value then + begin + FNormalizationForm := Value; + if FNormalizationForm <> nfNone then + begin + // renormalize all strings according to the new form + for I := 0 to GetCount - 1 do + Put(I, WideNormalize(Get(I), FNormalizationForm)); + end; + end; +end; + +procedure TWideStrings.SetValue(const Name, Value: WideString); +var + I : Integer; +begin + I := IndexOfName(Name); + if Value <> '' then + begin + if I < 0 then + I := Add(''); + Put(I, Name + '=' + Value); + end + else + begin + if I >= 0 then + Delete(I); + end; +end; + +procedure TWideStrings.WriteData(Writer: TWriter); +begin + Writer.{$IFDEF RTL240_UP}WriteString{$ELSE}WriteWideString{$ENDIF}(GetTextStr); +end; + +//=== { TWideStringList } ==================================================== + +destructor TWideStringList.Destroy; +begin + FOnChange := nil; + FOnChanging := nil; + Clear; + inherited Destroy; +end; + +function TWideStringList.Add(const S: WideString): Integer; +begin + if not Sorted then + Result := FCount + else + begin + if Find(S, Result) then + begin + case Duplicates of + dupIgnore: + Exit; + dupError: + Error(SDuplicateString, 0); + end; + end; + end; + InsertItem(Result, S); +end; + +procedure TWideStringList.Changed; +begin + if (FUpdateCount = 0) and Assigned(FOnChange) then + FOnChange(Self); +end; + +procedure TWideStringList.Changing; +begin + if (FUpdateCount = 0) and Assigned(FOnChanging) then + FOnChanging(Self); +end; + +procedure TWideStringList.Clear; +{$IFDEF OWN_WIDESTRING_MEMMGR} +var + I: Integer; +{$ENDIF OWN_WIDESTRING_MEMMGR} +begin + if FCount <> 0 then + begin + Changing; + {$IFDEF OWN_WIDESTRING_MEMMGR} + for I := 0 to FCount - 1 do + with FList[I] do + if TDynWideCharArray(FString) <> nil then + TDynWideCharArray(FString) := nil; + {$ENDIF OWN_WIDESTRING_MEMMGR} + // this will automatically finalize the array + FList := nil; + FCount := 0; + SetCapacity(0); + Changed; + end; +end; + +procedure TWideStringList.Delete(Index: Integer); +begin + if Cardinal(Index) >= Cardinal(FCount) then + Error(SListIndexError, Index); + Changing; + + {$IFDEF OWN_WIDESTRING_MEMMGR} + SetListString(Index, ''); + {$ELSE ~OWN_WIDESTRING_MEMMGR} + FList[Index].FString := ''; + {$ENDIF ~OWN_WIDESTRING_MEMMGR} + Dec(FCount); + if Index < FCount then + begin + System.Move(FList[Index + 1], FList[Index], (FCount - Index) * SizeOf(TWideStringItem)); + Pointer(FList[FCount].FString) := nil; // avoid freeing the string, the address is now used in another element + end; + Changed; +end; + +procedure TWideStringList.Exchange(Index1, Index2: Integer); +begin + if Cardinal(Index1) >= Cardinal(FCount) then + Error(SListIndexError, Index1); + if Cardinal(Index2) >= Cardinal(FCount) then + Error(SListIndexError, Index2); + Changing; + ExchangeItems(Index1, Index2); + Changed; +end; + +procedure TWideStringList.ExchangeItems(Index1, Index2: Integer); +var + Temp: TWideStringItem; +begin + Temp := FList[Index1]; + FList[Index1] := FList[Index2]; + FList[Index2] := Temp; +end; + +function TWideStringList.Find(const S: WideString; var Index: Integer): Boolean; +var + L, H, I, C: Integer; + NormString: WideString; +begin + Result := False; + NormString := WideNormalize(S, FNormalizationForm); + L := 0; + H := FCount - 1; + while L <= H do + begin + I := (L + H) shr 1; + C := WideCompareText(FList[I].FString, NormString, FLanguage); + if C < 0 then + L := I+1 + else + begin + H := I - 1; + if C = 0 then + begin + Result := True; + if Duplicates <> dupAccept then + L := I; + end; + end; + end; + Index := L; +end; + +function TWideStringList.Get(Index: Integer): WideString; +{$IFDEF OWN_WIDESTRING_MEMMGR} +var + Len: Integer; +{$ENDIF OWN_WIDESTRING_MEMMGR} +begin + if Cardinal(Index) >= Cardinal(FCount) then + Error(SListIndexError, Index); + {$IFDEF OWN_WIDESTRING_MEMMGR} + with FList[Index] do + begin + Len := Length(TDynWideCharArray(FString)); + if Len > 0 then + begin + SetLength(Result, Len - 1); // exclude #0 + if Result <> '' then + System.Move(FString^, Result[1], Len * SizeOf(WideChar)); + end + else + Result := ''; + end; + {$ELSE ~OWN_WIDESTRING_MEMMGR} + Result := FList[Index].FString; + {$ENDIF ~OWN_WIDESTRING_MEMMGR} +end; + +function TWideStringList.GetCapacity: Integer; +begin + Result := Length(FList); +end; + +function TWideStringList.GetCount: Integer; +begin + Result := FCount; +end; + +function TWideStringList.GetObject(Index: Integer): TObject; +begin + if Cardinal(Index) >= Cardinal(FCount) then + Error(SListIndexError, Index); + Result := FList[Index].FObject; +end; + +procedure TWideStringList.Grow; +var + Delta, + Len: Integer; +begin + Len := Length(FList); + if Len > 64 then + Delta := Len div 4 + else + begin + if Len > 8 then + Delta := 16 + else + Delta := 4; + end; + SetCapacity(Len + Delta); +end; + +function TWideStringList.IndexOf(const S: WideString): Integer; +begin + if not Sorted then + Result := inherited IndexOf(S) + else + if not Find(S, Result) then + Result := -1; +end; + +procedure TWideStringList.Insert(Index: Integer; const S: WideString); +begin + if Sorted then + Error(SSortedListError, 0); + if Cardinal(Index) > Cardinal(FCount) then + Error(SListIndexError, Index); + InsertItem(Index, S); +end; + +{$IFDEF OWN_WIDESTRING_MEMMGR} +procedure TWideStringList.SetListString(Index: Integer; const S: WideString); +var + Len: Integer; + A: TDynWideCharArray; +begin + with FList[Index] do + begin + Pointer(A) := TDynWideCharArray(FString); + if A <> nil then + A := nil; // free memory + + Len := Length(S); + if Len > 0 then + begin + SetLength(A, Len + 1); // include #0 + System.Move(S[1], A[0], Len * SizeOf(WideChar)); + A[Len] := #0; + end; + + FString := PWideChar(A); + Pointer(A) := nil; // do not release the array on procedure exit + end; +end; +{$ENDIF OWN_WIDESTRING_MEMMGR} + +procedure TWideStringList.InsertItem(Index: Integer; const S: WideString); +begin + Changing; + if FCount = Length(FList) then + Grow; + if Index < FCount then + System.Move(FList[Index], FList[Index + 1], (FCount - Index) * SizeOf(TWideStringItem)); + with FList[Index] do + begin + Pointer(FString) := nil; // avoid freeing the string, the address is now used in another element + FObject := nil; + if (FNormalizationForm <> nfNone) and (Length(S) > 0) then + {$IFDEF OWN_WIDESTRING_MEMMGR} + SetListString(Index, WideNormalize(S, FNormalizationForm)) + else + SetListString(Index, S); + {$ELSE ~OWN_WIDESTRING_MEMMGR} + FString := WideNormalize(S, FNormalizationForm) + else + FString := S; + {$ENDIF ~OWN_WIDESTRING_MEMMGR} + end; + Inc(FCount); + Changed; +end; + +procedure TWideStringList.Put(Index: Integer; const S: WideString); +begin + if Sorted then + Error(SSortedListError, 0); + if Cardinal(Index) >= Cardinal(FCount) then + Error(SListIndexError, Index); + Changing; + + if (FNormalizationForm <> nfNone) and (Length(S) > 0) then + {$IFDEF OWN_WIDESTRING_MEMMGR} + SetListString(Index, WideNormalize(S, FNormalizationForm)) + else + SetListString(Index, S); + {$ELSE ~OWN_WIDESTRING_MEMMGR} + FList[Index].FString := WideNormalize(S, FNormalizationForm) + else + FList[Index].FString := S; + {$ENDIF ~OWN_WIDESTRING_MEMMGR} + Changed; +end; + +procedure TWideStringList.PutObject(Index: Integer; AObject: TObject); +begin + if Cardinal(Index) >= Cardinal(FCount) then + Error(SListIndexError, Index); + Changing; + FList[Index].FObject := AObject; + Changed; +end; + +procedure TWideStringList.QuickSort(L, R: Integer); +var + I, J: Integer; + P: WideString; +begin + repeat + I := L; + J := R; + P := FList[(L + R) shr 1].FString; + repeat + while WideCompareText(FList[I].FString, P, FLanguage) < 0 do + Inc(I); + while WideCompareText(FList[J].FString, P, FLanguage) > 0 do + Dec(J); + if I <= J then + begin + ExchangeItems(I, J); + Inc(I); + Dec(J); + end; + until I > J; + if L < J then + QuickSort(L, J); + L := I; + until I >= R; +end; + +procedure TWideStringList.SetCapacity(NewCapacity: Integer); +begin + SetLength(FList, NewCapacity); + if NewCapacity < FCount then + FCount := NewCapacity; +end; + +procedure TWideStringList.SetSorted(Value: Boolean); +begin + if FSorted <> Value then + begin + if Value then + Sort; + FSorted := Value; + end; +end; + +procedure TWideStringList.SetUpdateState(Updating: Boolean); +begin + if Updating then + Changing + else + Changed; +end; + +procedure TWideStringList.Sort; +begin + if not Sorted and (FCount > 1) then + begin + Changing; + QuickSort(0, FCount - 1); + Changed; + end; +end; + +procedure TWideStringList.SetLanguage(Value: LCID); +begin + inherited SetLanguage(Value); + if Sorted then + Sort; +end; + +{$ENDIF ~UNICODE_RTL_DATABASE} + +// exchanges in each character of the given string the low order and high order +// byte to go from LSB to MSB and vice versa. +// EAX contains address of string + +function WideAdjustLineBreaks(const S: WideString): WideString; +var + Source, + SourceEnd, + Dest: PWideChar; +begin + Source := Pointer(S); + SourceEnd := Source + Length(S); + + Source := Pointer(S); + SetString(Result, nil, SourceEnd - Source); + Dest := Pointer(Result); + + while Source < SourceEnd do + begin + case Source^ of + WideLineFeed: + begin + Dest^ := WideLineSeparator; + Inc(Dest); + Inc(Source); + end; + WideCarriageReturn: + begin + Dest^ := WideLineSeparator; + Inc(Dest); + Inc(Source); + if Source^ = WideLineFeed then + Inc(Source); + end; + else + Dest^ := Source^; + Inc(Dest); + Inc(Source); + end; + end; + + SetLength(Result, (TJclAddr(Dest) - TJclAddr(Result)) div 2); +end; + +function WideQuotedStr(const S: WideString; Quote: WideChar): WideString; +// works like QuotedStr from SysUtils.pas but can insert any quotation character +var + P, Src, + Dest: PWideChar; + AddCount: SizeInt; +begin + AddCount := 0; + P := StrScanW(PWideChar(S), Quote); + while (P <> nil) do + begin + Inc(P); + Inc(AddCount); + P := StrScanW(P, Quote); + end; + + if AddCount = 0 then + Result := Quote + S + Quote + else + begin + SetLength(Result, Length(S) + AddCount + 2); + Dest := PWideChar(Result); + Dest^ := Quote; + Inc(Dest); + Src := PWideChar(S); + P := StrScanW(Src, Quote); + repeat + Inc(P); + Move(Src^, Dest^, 2 * (P - Src)); + Inc(Dest, P - Src); + Dest^ := Quote; + Inc(Dest); + Src := P; + P := StrScanW(Src, Quote); + until P = nil; + P := StrEndW(Src); + Move(Src^, Dest^, 2 * (P - Src)); + Inc(Dest, P - Src); + Dest^ := Quote; + end; +end; + +function WideExtractQuotedStr(var Src: PWideChar; Quote: WideChar): WideString; +// extracts a string enclosed in quote characters given by Quote +var + P, Dest: PWideChar; + DropCount: SizeInt; +begin + Result := ''; + if (Src = nil) or (Src^ <> Quote) then + Exit; + + Inc(Src); + DropCount := 1; + P := Src; + Src := StrScanW(Src, Quote); + + while Src <> nil do // count adjacent pairs of quote chars + begin + Inc(Src); + if Src^ <> Quote then + Break; + Inc(Src); + Inc(DropCount); + Src := StrScanW(Src, Quote); + end; + + if Src = nil then + Src := StrEndW(P); + if (Src - P) <= 1 then + Exit; + + if DropCount = 1 then + SetString(Result, P, Src - P - 1) + else + begin + SetLength(Result, Src - P - DropCount); + Dest := PWideChar(Result); + Src := StrScanW(P, Quote); + while Src <> nil do + begin + Inc(Src); + if Src^ <> Quote then + Break; + Move(P^, Dest^, 2 * (Src - P)); + Inc(Dest, Src - P); + Inc(Src); + P := Src; + Src := StrScanW(Src, Quote); + end; + if Src = nil then + Src := StrEndW(P); + Move(P^, Dest^, 2 * (Src - P - 1)); + end; +end; + +function WideStringOfChar(C: WideChar; Count: SizeInt): WideString; +// returns a string of Count characters filled with C +var + I: SizeInt; +begin + SetLength(Result, Count); + for I := 1 to Count do + Result[I] := C; +end; + +function WideTrim(const S: WideString): WideString; +var + I, L: SizeInt; +begin + L := Length(S); + I := 1; + while (I <= L) and (UnicodeIsWhiteSpace(UCS4(S[I])) or UnicodeIsControl(UCS4(S[I]))) do + Inc(I); + if I > L then + Result := '' + else + begin + while UnicodeIsWhiteSpace(UCS4(S[L])) or UnicodeIsControl(UCS4(S[L])) do + Dec(L); + Result := Copy(S, I, L - I + 1); + end; +end; + +function WideTrimLeft(const S: WideString): WideString; +var + I, L: SizeInt; +begin + L := Length(S); + I := 1; + while (I <= L) and (UnicodeIsWhiteSpace(UCS4(S[I])) or UnicodeIsControl(UCS4(S[I]))) do + Inc(I); + Result := Copy(S, I, Maxint); +end; + +function WideTrimRight(const S: WideString): WideString; +var + I: SizeInt; +begin + I := Length(S); + while (I > 0) and (UnicodeIsWhiteSpace(UCS4(S[I])) or UnicodeIsControl(UCS4(S[I]))) do + Dec(I); + Result := Copy(S, 1, I); +end; + +// returns the index of character Ch in S, starts searching at index Index +// Note: This is a quick memory search. No attempt is made to interpret either +// the given charcter nor the string (ligatures, modifiers, surrogates etc.) +// Code from Azret Botash. + +function WideCharPos(const S: WideString; const Ch: WideChar; const Index: SizeInt): SizeInt; +var + P, R: PWideChar; +begin + if (Index > 0) and (Index <= Length(S)) then + begin + P := PWideChar(@S[Index]); + R := StrScanW(P, Ch); + if R <> nil then + Result := R - P + Index + else + Result := 0; + end + else + Result := 0; +end; + +{$IFNDEF UNICODE_RTL_DATABASE} + +function WideComposeHangul(const Source: WideString): WideString; +var + Len: SizeInt; + Ch, Last: WideChar; + I: SizeInt; + LIndex, VIndex, + SIndex, TIndex: SizeInt; +begin + Result := ''; + Len := Length(Source); + if Len > 0 then + begin + Last := Source[1]; + Result := Last; + + for I := 2 to Len do + begin + Ch := Source[I]; + + // 1. check to see if two current characters are L and V + LIndex := Word(Last) - LBase; + if (0 <= LIndex) and (LIndex < LCount) then + begin + VIndex := Word(Ch) - VBase; + if (0 <= VIndex) and (VIndex < VCount) then + begin + // make syllable of form LV + Last := WideChar((SBase + (LIndex * VCount + VIndex) * TCount)); + Result[Length(Result)] := Last; // reset last + Continue; // discard Ch + end; + end; + + // 2. check to see if two current characters are LV and T + SIndex := Word(Last) - SBase; + if (0 <= SIndex) and (SIndex < SCount) and ((SIndex mod TCount) = 0) then + begin + TIndex := Word(Ch) - TBase; + if (0 <= TIndex) and (TIndex <= TCount) then + begin + // make syllable of form LVT + Inc(Word(Last), TIndex); + Result[Length(Result)] := Last; // reset last + Continue; // discard Ch + end; + end; + + // if neither case was true, just add the character + Last := Ch; + Result := Result + Ch; + end; + end; +end; + +// Returns canonical composition of characters in S. + +function WideCompose(const S: WideString; Compatible: Boolean): WideString; +var + Buffer: array of UCS4; + LastInPos, InPos, OutPos, BufferSize, NbProcessed: SizeInt; + Composite: UCS4; +begin + // Set an arbitrary length for the result. This is automatically done when checking + // for hangul composition. + Result := WideComposeHangul(S); + + if Result = '' then + Exit; + + if not CompositionsLoaded then + LoadCompositionData; + + LastInPos := Length(Result); + if LastInPos > MaxCompositionSize then + SetLength(Buffer, MaxCompositionSize) + else + SetLength(Buffer, LastInPos); + + BufferSize := 0; + InPos := 0; + OutPos := 0; + + while (InPos < LastInPos) or (BufferSize > 0) do + begin + // fill buffer from input + + while BufferSize < Length(Buffer) do + begin + if InPos < LastInPos then + begin + Inc(InPos); + Buffer[BufferSize] := UCS4(Result[InPos]); + Inc(BufferSize); + end + else + SetLength(Buffer, BufferSize); + end; + + if Length(Buffer) = 0 then + Break; + + NbProcessed := UnicodeCompose(Buffer, Composite, Compatible); + if NbProcessed = 0 then + Break; + + if BufferSize > NbProcessed then + Move(Buffer[NbProcessed], Buffer[0], (BufferSize - NbProcessed) * SizeOf(UCS4)); + Dec(BufferSize, NbProcessed); + + Inc(OutPos); + Result[OutPos] := UCS2(Composite); + end; + // since we have likely shortened the source string we have to set the correct length on exit + SetLength(Result, OutPos); +end; + +function WideCompose(const S: WideString; Tags: TCompatibilityFormattingTags): WideString; +var + Buffer: array of UCS4; + LastInPos, InPos, OutPos, BufferSize, NbProcessed: SizeInt; + Composite: UCS4; +begin + // Set an arbitrary length for the result. This is automatically done when checking + // for hangul composition. + Result := WideComposeHangul(S); + + if Result = '' then + Exit; + + if not CompositionsLoaded then + LoadCompositionData; + + LastInPos := Length(Result); + if LastInPos > MaxCompositionSize then + SetLength(Buffer, MaxCompositionSize) + else + SetLength(Buffer, LastInPos); + + BufferSize := 0; + InPos := 0; + OutPos := 0; + + while (InPos < LastInPos) or (BufferSize > 0) do + begin + // fill buffer from input + + while BufferSize < Length(Buffer) do + begin + if InPos < LastInPos then + begin + Inc(InPos); + Buffer[BufferSize] := UCS4(Result[InPos]); + Inc(BufferSize); + end + else + SetLength(Buffer, BufferSize); + end; + + if Length(Buffer) = 0 then + Break; + + NbProcessed := UnicodeCompose(Buffer, Composite, Tags); + if NbProcessed = 0 then + Break; + + if BufferSize > NbProcessed then + Move(Buffer[NbProcessed], Buffer[0], (BufferSize - NbProcessed) * SizeOf(UCS4)); + Dec(BufferSize, NbProcessed); + + Inc(OutPos); + Result[OutPos] := UCS2(Composite); + end; + // since we have likely shortened the source string we have to set the correct length on exit + SetLength(Result, OutPos); +end; + +procedure FixCanonical(var S: WideString); +// Examines S and reorders all combining marks in the string so that they are in canonical order. +var + I: SizeInt; + Temp: WideChar; + CurrentClass, + LastClass: Cardinal; +begin + I := Length(S); + if I > 1 then + begin + CurrentClass := CanonicalCombiningClass(UCS4(S[I])); + repeat + Dec(I); + LastClass := CurrentClass; + CurrentClass := CanonicalCombiningClass(UCS4(S[I])); + + // A swap is presumed to be rare (and a double-swap very rare), + // so don't worry about efficiency here. + if (CurrentClass > LastClass) and (LastClass > 0) then + begin + // swap characters + Temp := S[I]; + S[I] := S[I + 1]; + S[I + 1] := Temp; + + // if not at end, backup (one further, to compensate for loop) + if I < Length(S) - 1 then + Inc(I, 2); + // reset type, since we swapped. + CurrentClass := CanonicalCombiningClass(UCS4(S[I])); + end; + until I = 1; + end; +end; + +function WideDecompose(const S: WideString; Compatible: Boolean): WideString; +// returns a string with all characters of S but decomposed, e.g. is returned as E^ etc. +var + I, J: SizeInt; + Decomp: TUCS4Array; +begin + Result := ''; + Decomp := nil; + + // iterate through each source code point + for I := 1 to Length(S) do + begin + Decomp := UnicodeDecompose(UCS4(S[I]), Compatible); + if Decomp = nil then + Result := Result + S[I] + else + for J := 0 to High(Decomp) do + Result := Result + WideChar(Decomp[J]); + end; + + // combining marks must be sorted according to their canonical combining class + FixCanonical(Result); +end; + +function WideDecompose(const S: WideString; Tags: TCompatibilityFormattingTags): WideString; +// returns a string with all characters of S but decomposed, e.g. is returned as E^ etc. +var + I, J: SizeInt; + Decomp: TUCS4Array; +begin + Result := ''; + Decomp := nil; + + // iterate through each source code point + for I := 1 to Length(S) do + begin + Decomp := UnicodeDecompose(UCS4(S[I]), Tags); + if Decomp = nil then + Result := Result + S[I] + else + for J := 0 to High(Decomp) do + Result := Result + WideChar(Decomp[J]); + end; + + // combining marks must be sorted according to their canonical combining class + FixCanonical(Result); +end; + +function WideNormalize(const S: WideString; Form: TNormalizationForm): WideString; +var + Temp: WideString; + Compatible: Boolean; +begin + Result := S; + + if Form = nfNone then + Exit; // No normalization needed. + + Compatible := Form in [nfKC, nfKD]; + if Form in [nfD, nfKD] then + Result := WideDecompose(S, Compatible) + else + begin + Temp := WideDecompose(S, Compatible); + Result := WideCompose(Temp, Compatible); + end; +end; + +{$ENDIF ~UNICODE_RTL_DATABASE} + +function WideSameText(const Str1, Str2: WideString): Boolean; +// Compares both strings case-insensitively and returns True if both are equal, otherwise False is returned. +begin + Result := Length(Str1) = Length(Str2); + if Result then + Result := StrICompW(PWideChar(Str1), PWideChar(Str2)) = 0; +end; + +//----------------- general purpose case mapping --------------------------------------------------- + +{$IFNDEF UNICODE_RTL_DATABASE} + +function WideCaseConvert(C: WideChar; CaseType: TCaseType): WideString; +var + I, RPos: SizeInt; + Mapping: TUCS4Array; +begin + SetLength(Mapping, 0); + if not CaseLookup(UCS4(C), CaseType, Mapping) then + Result := C + else + begin + SetLength(Result, 2 * Length(Mapping)); + RPos := 1; + for I := Low(Mapping) to High(Mapping) do + UTF16SetNextChar(Result, RPos, Mapping[I]); + if RPos > 0 then + SetLength(Result, RPos - 1) + else + raise EJclUnexpectedEOSequenceError.Create; + end; +end; + +function WideCaseConvert(const S: WideString; CaseType: TCaseType): WideString; +var + SLen, RLen, SPos, RPos, K, MapLen: SizeInt; + Code: UCS4; + Mapping: TUCS4Array; +begin + SetLength(Mapping, 0); + SLen := Length(S); + RLen := SLen; + SetLength(Result, RLen); + SPos := 1; + RPos := 1; + while (SPos > 0) and (SPos <= SLen) do + begin + Code := UTF16GetNextChar(S, SPos); + if SPos = -1 then + raise EJclUnexpectedEOSequenceError.Create; + + if CaseLookup(Code, CaseType, Mapping) then + begin + MapLen:= Length(Mapping); + if MapLen = 1 then + Code := Mapping[0]; + end + else + MapLen := 1; + + if MapLen = 1 then + begin + if not UTF16SetNextChar(Result, RPos, Code) then + begin + Inc(RLen, SLen); + SetLength(Result, RLen); + UTF16SetNextChar(Result, RPos, Code); + end; + end + else + begin + for K := Low(Mapping) to High(Mapping) do + if not UTF16SetNextChar(Result, RPos, Code) then + begin + Inc(RLen, SLen); + SetLength(Result, RLen); + UTF16SetNextChar(Result, RPos, Code); + end; + end; + end; + if RPos > 0 then + SetLength(Result, RPos - 1) + else + raise EJclUnexpectedEOSequenceError.Create; +end; + +// Note that most of the assigned code points don't have a case mapping and are therefore +// returned as they are. Other code points, however, might be converted into several characters +// like the german (eszett) whose upper case mapping is SS. + +function WideCaseFolding(C: WideChar): WideString; +// Special case folding function to map a string to either its lower case or +// to special cases. This can be used for case-insensitive comparation. +begin + Result:= WideCaseConvert(C, ctFold); +end; + +function WideCaseFolding(const S: WideString): WideString; +begin + Result:= WideCaseConvert(S, ctFold); +end; + +{$ENDIF ~UNICODE_RTL_DATABASE} + +function WideLowerCase(C: WideChar): WideString; +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.ToLower(C); + {$ELSE ~UNICODE_RTL_DATABASE} + Result:= WideCaseConvert(C, ctLower); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function WideLowerCase(const S: WideString): WideString; +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.ToLower(S); + {$ELSE ~UNICODE_RTL_DATABASE} + Result:= WideCaseConvert(S, ctLower); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +{$IFNDEF UNICODE_RTL_DATABASE} + +function WideTitleCase(C: WideChar): WideString; +begin + Result:= WideCaseConvert(C, ctTitle); +end; + +function WideTitleCase(const S: WideString): WideString; +begin + Result:= WideCaseConvert(S, ctTitle); +end; + +{$ENDIF ~UNICODE_RTL_DATABASE} + +function WideUpperCase(C: WideChar): WideString; +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.ToUpper(C); + {$ELSE ~UNICODE_RTL_DATABASE} + Result:= WideCaseConvert(C, ctUpper); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function WideUpperCase(const S: WideString): WideString; +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.ToUpper(S); + {$ELSE ~UNICODE_RTL_DATABASE} + Result:= WideCaseConvert(S, ctUpper); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +//----------------- character test routines -------------------------------------------------------- + +function UnicodeIsAlpha(C: UCS4): Boolean; // Is the character alphabetic? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.IsLetter(Chr(C)); + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, ClassLetter); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsDigit(C: UCS4): Boolean; // Is the character a digit? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.IsDigit(Chr(C)); + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccNumberDecimalDigit]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsAlphaNum(C: UCS4): Boolean; // Is the character alphabetic or a number? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.IsLetterOrDigit(Chr(C)); + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, ClassLetter + [ccNumberDecimalDigit]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsNumberOther(C: UCS4): Boolean; +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucOtherNumber; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccNumberOther]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsCased(C: UCS4): Boolean; +// Is the character a "cased" character, i.e. either lower case, title case or upper case +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) in + [TUnicodeCategory.ucLowercaseLetter, TUnicodeCategory.ucTitlecaseLetter, TUnicodeCategory.ucUppercaseLetter]; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccLetterLowercase, ccLetterTitleCase, ccLetterUppercase]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsControl(C: UCS4): Boolean; +// Is the character a control character? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) in + [TUnicodeCategory.ucControl, TUnicodeCategory.ucFormat]; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccOtherControl, ccOtherFormat]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsSpace(C: UCS4): Boolean; +// Is the character a spacing character? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucSpaceSeparator; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, ClassSpace); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsWhiteSpace(C: UCS4): Boolean; +// Is the character a white space character (same as UnicodeIsSpace plus +// tabulator, new line etc.)? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.IsWhiteSpace(Chr(C)); + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, ClassSpace + [ccWhiteSpace, ccSegmentSeparator]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsBlank(C: UCS4): Boolean; +// Is the character a space separator? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucSpaceSeparator; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccSeparatorSpace]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsPunctuation(C: UCS4): Boolean; +// Is the character a punctuation mark? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) in + [TUnicodeCategory.ucConnectPunctuation, TUnicodeCategory.ucDashPunctuation, + TUnicodeCategory.ucClosePunctuation, TUnicodeCategory.ucFinalPunctuation, + TUnicodeCategory.ucInitialPunctuation, TUnicodeCategory.ucOtherPunctuation, + TUnicodeCategory.ucOpenPunctuation]; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, ClassPunctuation); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsGraph(C: UCS4): Boolean; +// Is the character graphical? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) in + [TUnicodeCategory.ucCombiningMark, TUnicodeCategory.ucEnclosingMark, + TUnicodeCategory.ucNonSpacingMark, + TUnicodeCategory.ucDecimalNumber, TUnicodeCategory.ucLetterNumber, + TUnicodeCategory.ucOtherNumber, + TUnicodeCategory.ucLowercaseLetter, TUnicodeCategory.ucModifierLetter, + TUnicodeCategory.ucOtherLetter, TUnicodeCategory.ucTitlecaseLetter, + TUnicodeCategory.ucUppercaseLetter, + TUnicodeCategory.ucConnectPunctuation, TUnicodeCategory.ucDashPunctuation, + TUnicodeCategory.ucClosePunctuation, TUnicodeCategory.ucFinalPunctuation, + TUnicodeCategory.ucInitialPunctuation, TUnicodeCategory.ucOtherPunctuation, + TUnicodeCategory.ucOpenPunctuation, + TUnicodeCategory.ucCurrencySymbol, TUnicodeCategory.ucModifierSymbol, + TUnicodeCategory.ucMathSymbol, TUnicodeCategory.ucOtherSymbol]; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, ClassMark + ClassNumber + ClassLetter + ClassPunctuation + ClassSymbol); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsPrintable(C: UCS4): Boolean; +// Is the character printable? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) in + [TUnicodeCategory.ucCombiningMark, TUnicodeCategory.ucEnclosingMark, + TUnicodeCategory.ucNonSpacingMark, + TUnicodeCategory.ucDecimalNumber, TUnicodeCategory.ucLetterNumber, + TUnicodeCategory.ucOtherNumber, + TUnicodeCategory.ucLowercaseLetter, TUnicodeCategory.ucModifierLetter, + TUnicodeCategory.ucOtherLetter, TUnicodeCategory.ucTitlecaseLetter, + TUnicodeCategory.ucUppercaseLetter, + TUnicodeCategory.ucConnectPunctuation, TUnicodeCategory.ucDashPunctuation, + TUnicodeCategory.ucClosePunctuation, TUnicodeCategory.ucFinalPunctuation, + TUnicodeCategory.ucInitialPunctuation, TUnicodeCategory.ucOtherPunctuation, + TUnicodeCategory.ucOpenPunctuation, + TUnicodeCategory.ucCurrencySymbol, TUnicodeCategory.ucModifierSymbol, + TUnicodeCategory.ucMathSymbol, TUnicodeCategory.ucOtherSymbol, + TUnicodeCategory.ucSpaceSeparator]; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, ClassMark + ClassNumber + ClassLetter + ClassPunctuation + ClassSymbol + + [ccSeparatorSpace]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsUpper(C: UCS4): Boolean; +// Is the character already upper case? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucUppercaseLetter; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccLetterUppercase]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsLower(C: UCS4): Boolean; +// Is the character already lower case? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucLowercaseLetter; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccLetterLowercase]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsTitle(C: UCS4): Boolean; +// Is the character already title case? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucTitlecaseLetter; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccLetterTitlecase]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +{$IFNDEF UNICODE_RTL_DATABASE} +function UnicodeIsHexDigit(C: UCS4): Boolean; +// Is the character a hex digit? +begin + Result := CategoryLookup(C, [ccHexDigit]); +end; +{$ENDIF ~UNICODE_RTL_DATABASE} + +function UnicodeIsIsoControl(C: UCS4): Boolean; +// Is the character a C0 control character (< 32)? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucControl; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccOtherControl]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsFormatControl(C: UCS4): Boolean; +// Is the character a format control character? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucFormat; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccOtherFormat]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsSymbol(C: UCS4): Boolean; +// Is the character a symbol? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) in + [TUnicodeCategory.ucCurrencySymbol, TUnicodeCategory.ucModifierSymbol, + TUnicodeCategory.ucMathSymbol, TUnicodeCategory.ucOtherSymbol]; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, ClassSymbol); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsNumber(C: UCS4): Boolean; +// Is the character a number or digit? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) in + [TUnicodeCategory.ucDecimalNumber, TUnicodeCategory.ucLetterNumber, + TUnicodeCategory.ucOtherNumber]; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, ClassNumber); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsNonSpacing(C: UCS4): Boolean; +// Is the character non-spacing? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucNonSpacingMark; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccMarkNonSpacing]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsOpenPunctuation(C: UCS4): Boolean; +// Is the character an open/left punctuation (e.g. '[')? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucOpenPunctuation; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccPunctuationOpen]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsClosePunctuation(C: UCS4): Boolean; +// Is the character an close/right punctuation (e.g. ']')? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucClosePunctuation; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccPunctuationClose]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsInitialPunctuation(C: UCS4): Boolean; +// Is the character an initial punctuation (e.g. U+2018 LEFT SINGLE QUOTATION MARK)? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucInitialPunctuation; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccPunctuationInitialQuote]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsFinalPunctuation(C: UCS4): Boolean; +// Is the character a final punctuation (e.g. U+2019 RIGHT SINGLE QUOTATION MARK)? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucFinalPunctuation; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccPunctuationFinalQuote]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +{$IFNDEF UNICODE_RTL_DATABASE} +function UnicodeIsComposed(C: UCS4): Boolean; +// Can the character be decomposed into a set of other characters? +begin + Result := CategoryLookup(C, [ccComposed]); +end; + +function UnicodeIsQuotationMark(C: UCS4): Boolean; +// Is the character one of the many quotation marks? +begin + Result := CategoryLookup(C, [ccQuotationMark]); +end; + +function UnicodeIsSymmetric(C: UCS4): Boolean; +// Is the character one that has an opposite form (i.e. <>)? +begin + Result := CategoryLookup(C, [ccSymmetric]); +end; + +function UnicodeIsMirroring(C: UCS4): Boolean; +// Is the character mirroring (superset of symmetric)? +begin + Result := CategoryLookup(C, [ccMirroring]); +end; + +function UnicodeIsNonBreaking(C: UCS4): Boolean; +// Is the character non-breaking (i.e. non-breaking space)? +begin + Result := CategoryLookup(C, [ccNonBreaking]); +end; + +function UnicodeIsRightToLeft(C: UCS4): Boolean; +// Does the character have strong right-to-left directionality (i.e. Arabic letters)? +begin + Result := CategoryLookup(C, [ccRightToLeft]); +end; + +function UnicodeIsLeftToRight(C: UCS4): Boolean; +// Does the character have strong left-to-right directionality (i.e. Latin letters)? +begin + Result := CategoryLookup(C, [ccLeftToRight]); +end; + +function UnicodeIsStrong(C: UCS4): Boolean; +// Does the character have strong directionality? +begin + Result := CategoryLookup(C, [ccLeftToRight, ccRightToLeft]); +end; + +function UnicodeIsWeak(C: UCS4): Boolean; +// Does the character have weak directionality (i.e. numbers)? +begin + Result := CategoryLookup(C, ClassEuropeanNumber + [ccArabicNumber, ccCommonNumberSeparator]); +end; + +function UnicodeIsNeutral(C: UCS4): Boolean; +// Does the character have neutral directionality (i.e. whitespace)? +begin + Result := CategoryLookup(C, [ccSeparatorParagraph, ccSegmentSeparator, ccWhiteSpace, ccOtherNeutrals]); +end; + +function UnicodeIsSeparator(C: UCS4): Boolean; +// Is the character a block or segment separator? +begin + Result := CategoryLookup(C, [ccSeparatorParagraph, ccSegmentSeparator]); +end; + +function UnicodeIsMark(C: UCS4): Boolean; +// Is the character a mark of some kind? +begin + Result := CategoryLookup(C, ClassMark); +end; + +function UnicodeIsModifier(C: UCS4): Boolean; +// Is the character a letter modifier? +begin + Result := CategoryLookup(C, [ccLetterModifier]); +end; +{$ENDIF ~UNICODE_RTL_DATABASE} + +function UnicodeIsLetterNumber(C: UCS4): Boolean; +// Is the character a number represented by a letter? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucLetterNumber; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccNumberLetter]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsConnectionPunctuation(C: UCS4): Boolean; +// Is the character connecting punctuation? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucConnectPunctuation; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccPunctuationConnector]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsDash(C: UCS4): Boolean; +// Is the character a dash punctuation? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucDashPunctuation; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccPunctuationDash]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsMath(C: UCS4): Boolean; +// Is the character a math character? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucMathSymbol; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccSymbolMath]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsCurrency(C: UCS4): Boolean; +// Is the character a currency character? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucCurrencySymbol; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccSymbolCurrency]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsModifierSymbol(C: UCS4): Boolean; +// Is the character a modifier symbol? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucModifierSymbol; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccSymbolModifier]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsSpacingMark(C: UCS4): Boolean; +// Is the character a spacing mark? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) in + [TUnicodeCategory.ucLineSeparator, TUnicodeCategory.ucParagraphSeparator, + TUnicodeCategory.ucSpaceSeparator]; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccMarkSpacingCombining]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsEnclosing(C: UCS4): Boolean; +// Is the character enclosing (i.e. enclosing box)? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucEnclosingMark; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccMarkEnclosing]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsPrivate(C: UCS4): Boolean; +// Is the character from the Private Use Area? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucPrivateUse; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccOtherPrivate]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsSurrogate(C: UCS4): Boolean; +// Is the character one of the surrogate codes? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucSurrogate; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccOtherSurrogate]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsLineSeparator(C: UCS4): Boolean; +// Is the character a line separator? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucLineSeparator; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccSeparatorLine]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsParagraphSeparator(C: UCS4): Boolean; +// Is th character a paragraph separator; +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucParagraphSeparator; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccSeparatorParagraph]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsIdentifierStart(C: UCS4): Boolean; +// Can the character begin an identifier? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) in + [TUnicodeCategory.ucLowercaseLetter, TUnicodeCategory.ucModifierLetter, + TUnicodeCategory.ucOtherLetter, TUnicodeCategory.ucTitlecaseLetter, + TUnicodeCategory.ucUppercaseLetter, + TUnicodeCategory.ucLetterNumber]; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, ClassLetter + [ccNumberLetter]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsIdentifierPart(C: UCS4): Boolean; +// Can the character appear in an identifier? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) in + [TUnicodeCategory.ucLowercaseLetter, TUnicodeCategory.ucModifierLetter, + TUnicodeCategory.ucOtherLetter, TUnicodeCategory.ucTitlecaseLetter, + TUnicodeCategory.ucUppercaseLetter, + TUnicodeCategory.ucLetterNumber, TUnicodeCategory.ucDecimalNumber, + TUnicodeCategory.ucNonSpacingMark, TUnicodeCategory.ucCombiningMark, + TUnicodeCategory.ucConnectPunctuation, + TUnicodeCategory.ucFormat]; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, ClassLetter + [ccNumberLetter, ccMarkNonSpacing, ccMarkSpacingCombining, + ccNumberDecimalDigit, ccPunctuationConnector, ccOtherFormat]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsDefined(C: UCS4): Boolean; +// Is the character defined (appears in one of the data files)? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) <> TUnicodeCategory.ucUnassigned; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccAssigned]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsUndefined(C: UCS4): Boolean; +// Is the character undefined (not assigned in the Unicode database)? +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucUnassigned; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := not CategoryLookup(C, [ccAssigned]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsHan(C: UCS4): Boolean; +// Is the character a Han ideograph? +begin + Result := ((C >= $4E00) and (C <= $9FFF)) or ((C >= $F900) and (C <= $FAFF)); +end; + +function UnicodeIsHangul(C: UCS4): Boolean; +// Is the character a pre-composed Hangul syllable? +begin + Result := (C >= $AC00) and (C <= $D7FF); +end; + +function UnicodeIsUnassigned(C: UCS4): Boolean; +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucUnassigned; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccOtherUnassigned]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsLetterOther(C: UCS4): Boolean; +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucOtherLetter; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccLetterOther]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsConnector(C: UCS4): Boolean; +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucConnectPunctuation; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccPunctuationConnector]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsPunctuationOther(C: UCS4): Boolean; +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucOtherPunctuation; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccPunctuationOther]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +function UnicodeIsSymbolOther(C: UCS4): Boolean; +begin + {$IFDEF UNICODE_RTL_DATABASE} + Result := TCharacter.GetUnicodeCategory(Chr(C)) = TUnicodeCategory.ucOtherSymbol; + {$ELSE ~UNICODE_RTL_DATABASE} + Result := CategoryLookup(C, [ccSymbolOther]); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +{$IFNDEF UNICODE_RTL_DATABASE} +function UnicodeIsLeftToRightEmbedding(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccLeftToRightEmbedding]); +end; + +function UnicodeIsLeftToRightOverride(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccLeftToRightOverride]); +end; + +function UnicodeIsRightToLeftArabic(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccRightToLeftArabic]); +end; + +function UnicodeIsRightToLeftEmbedding(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccRightToLeftEmbedding]); +end; + +function UnicodeIsRightToLeftOverride(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccRightToLeftOverride]); +end; + +function UnicodeIsPopDirectionalFormat(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccPopDirectionalFormat]); +end; + +function UnicodeIsEuropeanNumber(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccEuropeanNumber]); +end; + +function UnicodeIsEuropeanNumberSeparator(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccEuropeanNumberSeparator]); +end; + +function UnicodeIsEuropeanNumberTerminator(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccEuropeanNumberTerminator]); +end; + +function UnicodeIsArabicNumber(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccArabicNumber]); +end; + +function UnicodeIsCommonNumberSeparator(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccCommonNumberSeparator]); +end; + +function UnicodeIsBoundaryNeutral(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccBoundaryNeutral]); +end; + +function UnicodeIsSegmentSeparator(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccSegmentSeparator]); +end; + +function UnicodeIsOtherNeutrals(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccOtherNeutrals]); +end; + +function UnicodeIsASCIIHexDigit(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccASCIIHexDigit]); +end; + +function UnicodeIsBidiControl(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccBidiControl]); +end; + +function UnicodeIsDeprecated(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccDeprecated]); +end; + +function UnicodeIsDiacritic(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccDiacritic]); +end; + +function UnicodeIsExtender(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccExtender]); +end; + +function UnicodeIsHyphen(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccHyphen]); +end; + +function UnicodeIsIdeographic(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccIdeographic]); +end; + +function UnicodeIsIDSBinaryOperator(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccIDSBinaryOperator]); +end; + +function UnicodeIsIDSTrinaryOperator(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccIDSTrinaryOperator]); +end; + +function UnicodeIsJoinControl(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccJoinControl]); +end; + +function UnicodeIsLogicalOrderException(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccLogicalOrderException]); +end; + +function UnicodeIsNonCharacterCodePoint(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccNonCharacterCodePoint]); +end; + +function UnicodeIsOtherAlphabetic(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccOtherAlphabetic]); +end; + +function UnicodeIsOtherDefaultIgnorableCodePoint(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccOtherDefaultIgnorableCodePoint]); +end; + +function UnicodeIsOtherGraphemeExtend(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccOtherGraphemeExtend]); +end; + +function UnicodeIsOtherIDContinue(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccOtherIDContinue]); +end; + +function UnicodeIsOtherIDStart(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccOtherIDStart]); +end; + +function UnicodeIsOtherLowercase(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccOtherLowercase]); +end; + +function UnicodeIsOtherMath(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccOtherMath]); +end; + +function UnicodeIsOtherUppercase(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccOtherUppercase]); +end; + +function UnicodeIsPatternSyntax(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccPatternSyntax]); +end; + +function UnicodeIsPatternWhiteSpace(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccPatternWhiteSpace]); +end; + +function UnicodeIsRadical(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccRadical]); +end; + +function UnicodeIsSoftDotted(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccSoftDotted]); +end; + +function UnicodeIsSTerm(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccSTerm]); +end; + +function UnicodeIsTerminalPunctuation(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccTerminalPunctuation]); +end; + +function UnicodeIsUnifiedIdeograph(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccUnifiedIdeograph]); +end; + +function UnicodeIsVariationSelector(C: UCS4): Boolean; +begin + Result := CategoryLookup(C, [ccVariationSelector]); +end; +{$ENDIF ~UNICODE_RTL_DATABASE} + +// I need to fix a problem (introduced by MS) here. The first parameter can be a pointer +// (and is so defined) or can be a normal DWORD, depending on the dwFlags parameter. +// As usual, lpSrc has been translated to a var parameter. But this does not work in +// our case, hence the redeclaration of the function with a pointer as first parameter. + +function TranslateCharsetInfoEx(lpSrc: SizeInt; out lpCs: TCharsetInfo; dwFlags: DWORD): BOOL; stdcall; + external 'gdi32.dll' name 'TranslateCharsetInfo'; + +function GetCharSetFromLocale(Language: LCID; out FontCharSet: Byte): Boolean; +const + TCI_SRCLOCALE = $1000; +var + CP: Word; + CSI: TCharsetInfo; +begin + if not JclCheckWinVersion(5, 0) then // Win2k required + begin + // these versions of Windows don't support TCI_SRCLOCALE + CP := CodePageFromLocale(Language); + if CP = 0 then + RaiseLastOSError; + Result := TranslateCharsetInfoEx(CP, CSI, TCI_SRCCODEPAGE); + end + else + Result := TranslateCharsetInfoEx(Language, CSI, TCI_SRCLOCALE); + + if Result then + FontCharset := CSI.ciCharset; +end; + +function CharSetFromLocale(Language: LCID): Byte; +begin + if not GetCharSetFromLocale(Language, Result) then + RaiseLastOSError; +end; + +function CodePageFromLocale(Language: LCID): Word; +// determines the code page for a given locale +var + Buf: array [0..6] of Char; +begin + GetLocaleInfo(Language, LOCALE_IDefaultAnsiCodePage, Buf, 6); + Result := StrToIntDef(Buf, GetACP); +end; + +function KeyboardCodePage: Word; +begin + Result := CodePageFromLocale(GetKeyboardLayout(0) and $FFFF); +end; + +function KeyUnicode(C: Char): WideChar; +// converts the given character (as it comes with a WM_CHAR message) into its +// corresponding Unicode character depending on the active keyboard layout +begin + MultiByteToWideChar(KeyboardCodePage, MB_USEGLYPHCHARS, @C, 1, @Result, 1); +end; + +function CodeBlockRange(const CB: TUnicodeBlock): TUnicodeBlockRange; +// http://www.unicode.org/Public/5.0.0/ucd/Blocks.txt +begin + Result := UnicodeBlockData[CB].Range; +end; + + +// Names taken from http://www.unicode.org/Public/5.0.0/ucd/Blocks.txt +function CodeBlockName(const CB: TUnicodeBlock): string; +begin + Result := UnicodeBlockData[CB].Name; +end; + +// Returns an ID for the Unicode code block to which C belongs. +// If C does not belong to any of the defined blocks then ubUndefined is returned. +// Note: the code blocks listed here are based on Unicode Version 5.0.0 +function CodeBlockFromChar(const C: UCS4): TUnicodeBlock; +// http://www.unicode.org/Public/5.0.0/ucd/Blocks.txt +var + L, H, I: TUnicodeBlock; +begin + Result := ubUndefined; + L := ubBasicLatin; + H := High(TUnicodeBlock); + while L <= H do + begin + I := TUnicodeBlock((Cardinal(L) + Cardinal(H)) shr 1); + if (C >= UnicodeBlockData[I].Range.RangeStart) and (C <= UnicodeBlockData[I].Range.RangeEnd) then + begin + Result := I; + Break; + end + else + if C < UnicodeBlockData[I].Range.RangeStart then + begin + Dec(I); + H := I; + end + else + begin + Inc(I); + L := I; + end; + end; +end; + + +function CompareTextWin95(const W1, W2: WideString; Locale: LCID): SizeInt; +// special comparation function for Win9x since there's no system defined +// comparation function, returns -1 if W1 < W2, 0 if W1 = W2 or 1 if W1 > W2 +var + S1, S2: AnsiString; + CP: Word; + L1, L2: SizeInt; +begin + L1 := Length(W1); + L2 := Length(W2); + SetLength(S1, L1); + SetLength(S2, L2); + CP := CodePageFromLocale(Locale); + WideCharToMultiByte(CP, 0, PWideChar(W1), L1, PAnsiChar(S1), L1, nil, nil); + WideCharToMultiByte(CP, 0, PWideChar(W2), L2, PAnsiChar(S2), L2, nil, nil); + Result := CompareStringA(Locale, NORM_IGNORECASE, PAnsiChar(S1), Length(S1), + PAnsiChar(S2), Length(S2)) - 2; +end; + +function CompareTextWinNT(const W1, W2: WideString; Locale: LCID): SizeInt; +// Wrapper function for WinNT since there's no system defined comparation function +// in Win9x and we need a central comparation function for TWideStringList. +// Returns -1 if W1 < W2, 0 if W1 = W2 or 1 if W1 > W2 +begin + Result := CompareStringW(Locale, NORM_IGNORECASE, PWideChar(W1), Length(W1), + PWideChar(W2), Length(W2)) - 2; +end; + +function StringToWideStringEx(const S: AnsiString; CodePage: Word): WideString; +var + InputLength, + OutputLength: SizeInt; +begin + InputLength := Length(S); + OutputLength := MultiByteToWideChar(CodePage, 0, PAnsiChar(S), InputLength, nil, 0); + SetLength(Result, OutputLength); + MultiByteToWideChar(CodePage, 0, PAnsiChar(S), InputLength, PWideChar(Result), OutputLength); +end; + +function WideStringToStringEx(const WS: WideString; CodePage: Word): AnsiString; +var + InputLength, + OutputLength: SizeInt; +begin + InputLength := Length(WS); + OutputLength := WideCharToMultiByte(CodePage, 0, PWideChar(WS), InputLength, nil, 0, nil, nil); + SetLength(Result, OutputLength); + WideCharToMultiByte(CodePage, 0, PWideChar(WS), InputLength, PAnsiChar(Result), OutputLength, nil, nil); +end; + +function TranslateString(const S: AnsiString; CP1, CP2: Word): AnsiString; +begin + Result:= WideStringToStringEx(StringToWideStringEx(S, CP1), CP2); +end; + +function UCS4Array(Ch: UCS4): TUCS4Array; +begin + SetLength(Result, 1); + Result[0] := Ch; +end; + +function UCS4ArrayConcat(Left, Right: UCS4): TUCS4Array; +begin + SetLength(Result, 2); + Result[0] := Left; + Result[1] := Right; +end; + +procedure UCS4ArrayConcat(var Left: TUCS4Array; Right: UCS4); +var + I: SizeInt; +begin + I := Length(Left); + SetLength(Left, I + 1); + Left[I] := Right; +end; + +procedure UCS4ArrayConcat(var Left: TUCS4Array; const Right: TUCS4Array); +var + I, J: SizeInt; +begin + I := Length(Left); + J := Length(Right); + SetLength(Left, I + J); + Move(Right[0], Left[I], J * SizeOf(Right[0])); +end; + +function UCS4ArrayEquals(const Left: TUCS4Array; const Right: TUCS4Array): Boolean; +var + I: SizeInt; +begin + I := Length(Left); + Result := I = Length(Right); + while Result do + begin + Dec(I); + Result := (I >= 0) and (Left[I] = Right[I]); + end; + Result := I < 0; +end; + +function UCS4ArrayEquals(const Left: TUCS4Array; Right: UCS4): Boolean; +begin + Result := (Length(Left) = 1) and (Left[0] = Right); +end; + +function UCS4ArrayEquals(const Left: TUCS4Array; const Right: AnsiString): Boolean; +var + I: SizeInt; +begin + I := Length(Left); + Result := I = Length(Right); + while Result do + begin + Dec(I); + Result := (I >= 0) and (Left[I] = Ord(Right[I + 1])); + end; + Result := I < 0; +end; + +function UCS4ArrayEquals(const Left: TUCS4Array; Right: AnsiChar): Boolean; +begin + Result := (Length(Left) = 1) and (Left[0] = Ord(Right)); +end; + +procedure PrepareUnicodeData; +// Prepares structures which are globally needed. +begin + {$IFNDEF UNICODE_RTL_DATABASE} + LoadInProgress := TJclCriticalSection.Create; + {$ENDIF ~UNICODE_RTL_DATABASE} + + if (Win32Platform and VER_PLATFORM_WIN32_NT) <> 0 then + @WideCompareText := @CompareTextWinNT + else + @WideCompareText := @CompareTextWin95; +end; + +procedure FreeUnicodeData; +// Frees all data which has been allocated and which is not automatically freed by Delphi. +begin + {$IFNDEF UNICODE_RTL_DATABASE} + FreeAndNil(LoadInProgress); + {$ENDIF ~UNICODE_RTL_DATABASE} +end; + +initialization + PrepareUnicodeData; + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + FreeUnicodeData; + +end. diff --git a/3rdParty/JCL/source/common/JclUnicode.rc b/3rdParty/JCL/source/common/JclUnicode.rc index d086f6d7..4e28b328 100644 --- a/3rdParty/JCL/source/common/JclUnicode.rc +++ b/3rdParty/JCL/source/common/JclUnicode.rc @@ -1,6063 +1,6063 @@ -/**************************************************************************************************** - - - ..\..\jcl\source\common\JclUnicode.rc - - - Produced by UDExtract written by Dipl. Ing. Mike Lischke, public@lischke-online.de - - -****************************************************************************************************/ - - -LANGUAGE 0,0 CATEGORIES UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE -{ - '00 7E 02 00 00 41 00 00 5A 00 00 C0 00 00 D6 00 00 D8 00 00 DE 00 00 00 01 00 00 01 00 02 01 00' - '02 01 00 04 01 00 04 01 00 06 01 00 06 01 00 08 01 00 08 01 00 0A 01 00 0A 01 00 0C 01 00 0C 01' - '00 0E 01 00 0E 01 00 10 01 00 10 01 00 12 01 00 12 01 00 14 01 00 14 01 00 16 01 00 16 01 00 18' - '01 00 18 01 00 1A 01 00 1A 01 00 1C 01 00 1C 01 00 1E 01 00 1E 01 00 20 01 00 20 01 00 22 01 00' - '22 01 00 24 01 00 24 01 00 26 01 00 26 01 00 28 01 00 28 01 00 2A 01 00 2A 01 00 2C 01 00 2C 01' - '00 2E 01 00 2E 01 00 30 01 00 30 01 00 32 01 00 32 01 00 34 01 00 34 01 00 36 01 00 36 01 00 39' - '01 00 39 01 00 3B 01 00 3B 01 00 3D 01 00 3D 01 00 3F 01 00 3F 01 00 41 01 00 41 01 00 43 01 00' - '43 01 00 45 01 00 45 01 00 47 01 00 47 01 00 4A 01 00 4A 01 00 4C 01 00 4C 01 00 4E 01 00 4E 01' - '00 50 01 00 50 01 00 52 01 00 52 01 00 54 01 00 54 01 00 56 01 00 56 01 00 58 01 00 58 01 00 5A' - '01 00 5A 01 00 5C 01 00 5C 01 00 5E 01 00 5E 01 00 60 01 00 60 01 00 62 01 00 62 01 00 64 01 00' - '64 01 00 66 01 00 66 01 00 68 01 00 68 01 00 6A 01 00 6A 01 00 6C 01 00 6C 01 00 6E 01 00 6E 01' - '00 70 01 00 70 01 00 72 01 00 72 01 00 74 01 00 74 01 00 76 01 00 76 01 00 78 01 00 79 01 00 7B' - '01 00 7B 01 00 7D 01 00 7D 01 00 81 01 00 82 01 00 84 01 00 84 01 00 86 01 00 87 01 00 89 01 00' - '8B 01 00 8E 01 00 91 01 00 93 01 00 94 01 00 96 01 00 98 01 00 9C 01 00 9D 01 00 9F 01 00 A0 01' - '00 A2 01 00 A2 01 00 A4 01 00 A4 01 00 A6 01 00 A7 01 00 A9 01 00 A9 01 00 AC 01 00 AC 01 00 AE' - '01 00 AF 01 00 B1 01 00 B3 01 00 B5 01 00 B5 01 00 B7 01 00 B8 01 00 BC 01 00 BC 01 00 C4 01 00' - 'C4 01 00 C7 01 00 C7 01 00 CA 01 00 CA 01 00 CD 01 00 CD 01 00 CF 01 00 CF 01 00 D1 01 00 D1 01' - '00 D3 01 00 D3 01 00 D5 01 00 D5 01 00 D7 01 00 D7 01 00 D9 01 00 D9 01 00 DB 01 00 DB 01 00 DE' - '01 00 DE 01 00 E0 01 00 E0 01 00 E2 01 00 E2 01 00 E4 01 00 E4 01 00 E6 01 00 E6 01 00 E8 01 00' - 'E8 01 00 EA 01 00 EA 01 00 EC 01 00 EC 01 00 EE 01 00 EE 01 00 F1 01 00 F1 01 00 F4 01 00 F4 01' - '00 F6 01 00 F8 01 00 FA 01 00 FA 01 00 FC 01 00 FC 01 00 FE 01 00 FE 01 00 00 02 00 00 02 00 02' - '02 00 02 02 00 04 02 00 04 02 00 06 02 00 06 02 00 08 02 00 08 02 00 0A 02 00 0A 02 00 0C 02 00' - '0C 02 00 0E 02 00 0E 02 00 10 02 00 10 02 00 12 02 00 12 02 00 14 02 00 14 02 00 16 02 00 16 02' - '00 18 02 00 18 02 00 1A 02 00 1A 02 00 1C 02 00 1C 02 00 1E 02 00 1E 02 00 20 02 00 20 02 00 22' - '02 00 22 02 00 24 02 00 24 02 00 26 02 00 26 02 00 28 02 00 28 02 00 2A 02 00 2A 02 00 2C 02 00' - '2C 02 00 2E 02 00 2E 02 00 30 02 00 30 02 00 32 02 00 32 02 00 3A 02 00 3B 02 00 3D 02 00 3E 02' - '00 41 02 00 41 02 00 43 02 00 46 02 00 48 02 00 48 02 00 4A 02 00 4A 02 00 4C 02 00 4C 02 00 4E' - '02 00 4E 02 00 70 03 00 70 03 00 72 03 00 72 03 00 76 03 00 76 03 00 7F 03 00 7F 03 00 86 03 00' - '86 03 00 88 03 00 8A 03 00 8C 03 00 8C 03 00 8E 03 00 8F 03 00 91 03 00 A1 03 00 A3 03 00 AB 03' - '00 CF 03 00 CF 03 00 D2 03 00 D4 03 00 D8 03 00 D8 03 00 DA 03 00 DA 03 00 DC 03 00 DC 03 00 DE' - '03 00 DE 03 00 E0 03 00 E0 03 00 E2 03 00 E2 03 00 E4 03 00 E4 03 00 E6 03 00 E6 03 00 E8 03 00' - 'E8 03 00 EA 03 00 EA 03 00 EC 03 00 EC 03 00 EE 03 00 EE 03 00 F4 03 00 F4 03 00 F7 03 00 F7 03' - '00 F9 03 00 FA 03 00 FD 03 00 2F 04 00 60 04 00 60 04 00 62 04 00 62 04 00 64 04 00 64 04 00 66' - '04 00 66 04 00 68 04 00 68 04 00 6A 04 00 6A 04 00 6C 04 00 6C 04 00 6E 04 00 6E 04 00 70 04 00' - '70 04 00 72 04 00 72 04 00 74 04 00 74 04 00 76 04 00 76 04 00 78 04 00 78 04 00 7A 04 00 7A 04' - '00 7C 04 00 7C 04 00 7E 04 00 7E 04 00 80 04 00 80 04 00 8A 04 00 8A 04 00 8C 04 00 8C 04 00 8E' - '04 00 8E 04 00 90 04 00 90 04 00 92 04 00 92 04 00 94 04 00 94 04 00 96 04 00 96 04 00 98 04 00' - '98 04 00 9A 04 00 9A 04 00 9C 04 00 9C 04 00 9E 04 00 9E 04 00 A0 04 00 A0 04 00 A2 04 00 A2 04' - '00 A4 04 00 A4 04 00 A6 04 00 A6 04 00 A8 04 00 A8 04 00 AA 04 00 AA 04 00 AC 04 00 AC 04 00 AE' - '04 00 AE 04 00 B0 04 00 B0 04 00 B2 04 00 B2 04 00 B4 04 00 B4 04 00 B6 04 00 B6 04 00 B8 04 00' - 'B8 04 00 BA 04 00 BA 04 00 BC 04 00 BC 04 00 BE 04 00 BE 04 00 C0 04 00 C1 04 00 C3 04 00 C3 04' - '00 C5 04 00 C5 04 00 C7 04 00 C7 04 00 C9 04 00 C9 04 00 CB 04 00 CB 04 00 CD 04 00 CD 04 00 D0' - '04 00 D0 04 00 D2 04 00 D2 04 00 D4 04 00 D4 04 00 D6 04 00 D6 04 00 D8 04 00 D8 04 00 DA 04 00' - 'DA 04 00 DC 04 00 DC 04 00 DE 04 00 DE 04 00 E0 04 00 E0 04 00 E2 04 00 E2 04 00 E4 04 00 E4 04' - '00 E6 04 00 E6 04 00 E8 04 00 E8 04 00 EA 04 00 EA 04 00 EC 04 00 EC 04 00 EE 04 00 EE 04 00 F0' - '04 00 F0 04 00 F2 04 00 F2 04 00 F4 04 00 F4 04 00 F6 04 00 F6 04 00 F8 04 00 F8 04 00 FA 04 00' - 'FA 04 00 FC 04 00 FC 04 00 FE 04 00 FE 04 00 00 05 00 00 05 00 02 05 00 02 05 00 04 05 00 04 05' - '00 06 05 00 06 05 00 08 05 00 08 05 00 0A 05 00 0A 05 00 0C 05 00 0C 05 00 0E 05 00 0E 05 00 10' - '05 00 10 05 00 12 05 00 12 05 00 14 05 00 14 05 00 16 05 00 16 05 00 18 05 00 18 05 00 1A 05 00' - '1A 05 00 1C 05 00 1C 05 00 1E 05 00 1E 05 00 20 05 00 20 05 00 22 05 00 22 05 00 24 05 00 24 05' - '00 26 05 00 26 05 00 28 05 00 28 05 00 2A 05 00 2A 05 00 2C 05 00 2C 05 00 2E 05 00 2E 05 00 31' - '05 00 56 05 00 A0 10 00 C5 10 00 C7 10 00 C7 10 00 CD 10 00 CD 10 00 A0 13 00 F5 13 00 90 1C 00' - 'BA 1C 00 BD 1C 00 BF 1C 00 00 1E 00 00 1E 00 02 1E 00 02 1E 00 04 1E 00 04 1E 00 06 1E 00 06 1E' - '00 08 1E 00 08 1E 00 0A 1E 00 0A 1E 00 0C 1E 00 0C 1E 00 0E 1E 00 0E 1E 00 10 1E 00 10 1E 00 12' - '1E 00 12 1E 00 14 1E 00 14 1E 00 16 1E 00 16 1E 00 18 1E 00 18 1E 00 1A 1E 00 1A 1E 00 1C 1E 00' - '1C 1E 00 1E 1E 00 1E 1E 00 20 1E 00 20 1E 00 22 1E 00 22 1E 00 24 1E 00 24 1E 00 26 1E 00 26 1E' - '00 28 1E 00 28 1E 00 2A 1E 00 2A 1E 00 2C 1E 00 2C 1E 00 2E 1E 00 2E 1E 00 30 1E 00 30 1E 00 32' - '1E 00 32 1E 00 34 1E 00 34 1E 00 36 1E 00 36 1E 00 38 1E 00 38 1E 00 3A 1E 00 3A 1E 00 3C 1E 00' - '3C 1E 00 3E 1E 00 3E 1E 00 40 1E 00 40 1E 00 42 1E 00 42 1E 00 44 1E 00 44 1E 00 46 1E 00 46 1E' - '00 48 1E 00 48 1E 00 4A 1E 00 4A 1E 00 4C 1E 00 4C 1E 00 4E 1E 00 4E 1E 00 50 1E 00 50 1E 00 52' - '1E 00 52 1E 00 54 1E 00 54 1E 00 56 1E 00 56 1E 00 58 1E 00 58 1E 00 5A 1E 00 5A 1E 00 5C 1E 00' - '5C 1E 00 5E 1E 00 5E 1E 00 60 1E 00 60 1E 00 62 1E 00 62 1E 00 64 1E 00 64 1E 00 66 1E 00 66 1E' - '00 68 1E 00 68 1E 00 6A 1E 00 6A 1E 00 6C 1E 00 6C 1E 00 6E 1E 00 6E 1E 00 70 1E 00 70 1E 00 72' - '1E 00 72 1E 00 74 1E 00 74 1E 00 76 1E 00 76 1E 00 78 1E 00 78 1E 00 7A 1E 00 7A 1E 00 7C 1E 00' - '7C 1E 00 7E 1E 00 7E 1E 00 80 1E 00 80 1E 00 82 1E 00 82 1E 00 84 1E 00 84 1E 00 86 1E 00 86 1E' - '00 88 1E 00 88 1E 00 8A 1E 00 8A 1E 00 8C 1E 00 8C 1E 00 8E 1E 00 8E 1E 00 90 1E 00 90 1E 00 92' - '1E 00 92 1E 00 94 1E 00 94 1E 00 9E 1E 00 9E 1E 00 A0 1E 00 A0 1E 00 A2 1E 00 A2 1E 00 A4 1E 00' - 'A4 1E 00 A6 1E 00 A6 1E 00 A8 1E 00 A8 1E 00 AA 1E 00 AA 1E 00 AC 1E 00 AC 1E 00 AE 1E 00 AE 1E' - '00 B0 1E 00 B0 1E 00 B2 1E 00 B2 1E 00 B4 1E 00 B4 1E 00 B6 1E 00 B6 1E 00 B8 1E 00 B8 1E 00 BA' - '1E 00 BA 1E 00 BC 1E 00 BC 1E 00 BE 1E 00 BE 1E 00 C0 1E 00 C0 1E 00 C2 1E 00 C2 1E 00 C4 1E 00' - 'C4 1E 00 C6 1E 00 C6 1E 00 C8 1E 00 C8 1E 00 CA 1E 00 CA 1E 00 CC 1E 00 CC 1E 00 CE 1E 00 CE 1E' - '00 D0 1E 00 D0 1E 00 D2 1E 00 D2 1E 00 D4 1E 00 D4 1E 00 D6 1E 00 D6 1E 00 D8 1E 00 D8 1E 00 DA' - '1E 00 DA 1E 00 DC 1E 00 DC 1E 00 DE 1E 00 DE 1E 00 E0 1E 00 E0 1E 00 E2 1E 00 E2 1E 00 E4 1E 00' - 'E4 1E 00 E6 1E 00 E6 1E 00 E8 1E 00 E8 1E 00 EA 1E 00 EA 1E 00 EC 1E 00 EC 1E 00 EE 1E 00 EE 1E' - '00 F0 1E 00 F0 1E 00 F2 1E 00 F2 1E 00 F4 1E 00 F4 1E 00 F6 1E 00 F6 1E 00 F8 1E 00 F8 1E 00 FA' - '1E 00 FA 1E 00 FC 1E 00 FC 1E 00 FE 1E 00 FE 1E 00 08 1F 00 0F 1F 00 18 1F 00 1D 1F 00 28 1F 00' - '2F 1F 00 38 1F 00 3F 1F 00 48 1F 00 4D 1F 00 59 1F 00 59 1F 00 5B 1F 00 5B 1F 00 5D 1F 00 5D 1F' - '00 5F 1F 00 5F 1F 00 68 1F 00 6F 1F 00 B8 1F 00 BB 1F 00 C8 1F 00 CB 1F 00 D8 1F 00 DB 1F 00 E8' - '1F 00 EC 1F 00 F8 1F 00 FB 1F 00 02 21 00 02 21 00 07 21 00 07 21 00 0B 21 00 0D 21 00 10 21 00' - '12 21 00 15 21 00 15 21 00 19 21 00 1D 21 00 24 21 00 24 21 00 26 21 00 26 21 00 28 21 00 28 21' - '00 2A 21 00 2D 21 00 30 21 00 33 21 00 3E 21 00 3F 21 00 45 21 00 45 21 00 83 21 00 83 21 00 00' - '2C 00 2E 2C 00 60 2C 00 60 2C 00 62 2C 00 64 2C 00 67 2C 00 67 2C 00 69 2C 00 69 2C 00 6B 2C 00' - '6B 2C 00 6D 2C 00 70 2C 00 72 2C 00 72 2C 00 75 2C 00 75 2C 00 7E 2C 00 80 2C 00 82 2C 00 82 2C' - '00 84 2C 00 84 2C 00 86 2C 00 86 2C 00 88 2C 00 88 2C 00 8A 2C 00 8A 2C 00 8C 2C 00 8C 2C 00 8E' - '2C 00 8E 2C 00 90 2C 00 90 2C 00 92 2C 00 92 2C 00 94 2C 00 94 2C 00 96 2C 00 96 2C 00 98 2C 00' - '98 2C 00 9A 2C 00 9A 2C 00 9C 2C 00 9C 2C 00 9E 2C 00 9E 2C 00 A0 2C 00 A0 2C 00 A2 2C 00 A2 2C' - '00 A4 2C 00 A4 2C 00 A6 2C 00 A6 2C 00 A8 2C 00 A8 2C 00 AA 2C 00 AA 2C 00 AC 2C 00 AC 2C 00 AE' - '2C 00 AE 2C 00 B0 2C 00 B0 2C 00 B2 2C 00 B2 2C 00 B4 2C 00 B4 2C 00 B6 2C 00 B6 2C 00 B8 2C 00' - 'B8 2C 00 BA 2C 00 BA 2C 00 BC 2C 00 BC 2C 00 BE 2C 00 BE 2C 00 C0 2C 00 C0 2C 00 C2 2C 00 C2 2C' - '00 C4 2C 00 C4 2C 00 C6 2C 00 C6 2C 00 C8 2C 00 C8 2C 00 CA 2C 00 CA 2C 00 CC 2C 00 CC 2C 00 CE' - '2C 00 CE 2C 00 D0 2C 00 D0 2C 00 D2 2C 00 D2 2C 00 D4 2C 00 D4 2C 00 D6 2C 00 D6 2C 00 D8 2C 00' - 'D8 2C 00 DA 2C 00 DA 2C 00 DC 2C 00 DC 2C 00 DE 2C 00 DE 2C 00 E0 2C 00 E0 2C 00 E2 2C 00 E2 2C' - '00 EB 2C 00 EB 2C 00 ED 2C 00 ED 2C 00 F2 2C 00 F2 2C 00 40 A6 00 40 A6 00 42 A6 00 42 A6 00 44' - 'A6 00 44 A6 00 46 A6 00 46 A6 00 48 A6 00 48 A6 00 4A A6 00 4A A6 00 4C A6 00 4C A6 00 4E A6 00' - '4E A6 00 50 A6 00 50 A6 00 52 A6 00 52 A6 00 54 A6 00 54 A6 00 56 A6 00 56 A6 00 58 A6 00 58 A6' - '00 5A A6 00 5A A6 00 5C A6 00 5C A6 00 5E A6 00 5E A6 00 60 A6 00 60 A6 00 62 A6 00 62 A6 00 64' - 'A6 00 64 A6 00 66 A6 00 66 A6 00 68 A6 00 68 A6 00 6A A6 00 6A A6 00 6C A6 00 6C A6 00 80 A6 00' - '80 A6 00 82 A6 00 82 A6 00 84 A6 00 84 A6 00 86 A6 00 86 A6 00 88 A6 00 88 A6 00 8A A6 00 8A A6' - '00 8C A6 00 8C A6 00 8E A6 00 8E A6 00 90 A6 00 90 A6 00 92 A6 00 92 A6 00 94 A6 00 94 A6 00 96' - 'A6 00 96 A6 00 98 A6 00 98 A6 00 9A A6 00 9A A6 00 22 A7 00 22 A7 00 24 A7 00 24 A7 00 26 A7 00' - '26 A7 00 28 A7 00 28 A7 00 2A A7 00 2A A7 00 2C A7 00 2C A7 00 2E A7 00 2E A7 00 32 A7 00 32 A7' - '00 34 A7 00 34 A7 00 36 A7 00 36 A7 00 38 A7 00 38 A7 00 3A A7 00 3A A7 00 3C A7 00 3C A7 00 3E' - 'A7 00 3E A7 00 40 A7 00 40 A7 00 42 A7 00 42 A7 00 44 A7 00 44 A7 00 46 A7 00 46 A7 00 48 A7 00' - '48 A7 00 4A A7 00 4A A7 00 4C A7 00 4C A7 00 4E A7 00 4E A7 00 50 A7 00 50 A7 00 52 A7 00 52 A7' - '00 54 A7 00 54 A7 00 56 A7 00 56 A7 00 58 A7 00 58 A7 00 5A A7 00 5A A7 00 5C A7 00 5C A7 00 5E' - 'A7 00 5E A7 00 60 A7 00 60 A7 00 62 A7 00 62 A7 00 64 A7 00 64 A7 00 66 A7 00 66 A7 00 68 A7 00' - '68 A7 00 6A A7 00 6A A7 00 6C A7 00 6C A7 00 6E A7 00 6E A7 00 79 A7 00 79 A7 00 7B A7 00 7B A7' - '00 7D A7 00 7E A7 00 80 A7 00 80 A7 00 82 A7 00 82 A7 00 84 A7 00 84 A7 00 86 A7 00 86 A7 00 8B' - 'A7 00 8B A7 00 8D A7 00 8D A7 00 90 A7 00 90 A7 00 92 A7 00 92 A7 00 96 A7 00 96 A7 00 98 A7 00' - '98 A7 00 9A A7 00 9A A7 00 9C A7 00 9C A7 00 9E A7 00 9E A7 00 A0 A7 00 A0 A7 00 A2 A7 00 A2 A7' - '00 A4 A7 00 A4 A7 00 A6 A7 00 A6 A7 00 A8 A7 00 A8 A7 00 AA A7 00 AE A7 00 B0 A7 00 B4 A7 00 B6' - 'A7 00 B6 A7 00 B8 A7 00 B8 A7 00 BA A7 00 BA A7 00 BC A7 00 BC A7 00 BE A7 00 BE A7 00 C2 A7 00' - 'C2 A7 00 C4 A7 00 C7 A7 00 C9 A7 00 C9 A7 00 F5 A7 00 F5 A7 00 21 FF 00 3A FF 00 00 04 01 27 04' - '01 B0 04 01 D3 04 01 80 0C 01 B2 0C 01 A0 18 01 BF 18 01 40 6E 01 5F 6E 01 00 D4 01 19 D4 01 34' - 'D4 01 4D D4 01 68 D4 01 81 D4 01 9C D4 01 9C D4 01 9E D4 01 9F D4 01 A2 D4 01 A2 D4 01 A5 D4 01' - 'A6 D4 01 A9 D4 01 AC D4 01 AE D4 01 B5 D4 01 D0 D4 01 E9 D4 01 04 D5 01 05 D5 01 07 D5 01 0A D5' - '01 0D D5 01 14 D5 01 16 D5 01 1C D5 01 38 D5 01 39 D5 01 3B D5 01 3E D5 01 40 D5 01 44 D5 01 46' - 'D5 01 46 D5 01 4A D5 01 50 D5 01 6C D5 01 85 D5 01 A0 D5 01 B9 D5 01 D4 D5 01 ED D5 01 08 D6 01' - '21 D6 01 3C D6 01 55 D6 01 70 D6 01 89 D6 01 A8 D6 01 C0 D6 01 E2 D6 01 FA D6 01 1C D7 01 34 D7' - '01 56 D7 01 6E D7 01 90 D7 01 A8 D7 01 CA D7 01 CA D7 01 00 E9 01 21 E9 01 01 85 02 00 00 61 00' - '00 7A 00 00 B5 00 00 B5 00 00 DF 00 00 F6 00 00 F8 00 00 FF 00 00 01 01 00 01 01 00 03 01 00 03' - '01 00 05 01 00 05 01 00 07 01 00 07 01 00 09 01 00 09 01 00 0B 01 00 0B 01 00 0D 01 00 0D 01 00' - '0F 01 00 0F 01 00 11 01 00 11 01 00 13 01 00 13 01 00 15 01 00 15 01 00 17 01 00 17 01 00 19 01' - '00 19 01 00 1B 01 00 1B 01 00 1D 01 00 1D 01 00 1F 01 00 1F 01 00 21 01 00 21 01 00 23 01 00 23' - '01 00 25 01 00 25 01 00 27 01 00 27 01 00 29 01 00 29 01 00 2B 01 00 2B 01 00 2D 01 00 2D 01 00' - '2F 01 00 2F 01 00 31 01 00 31 01 00 33 01 00 33 01 00 35 01 00 35 01 00 37 01 00 38 01 00 3A 01' - '00 3A 01 00 3C 01 00 3C 01 00 3E 01 00 3E 01 00 40 01 00 40 01 00 42 01 00 42 01 00 44 01 00 44' - '01 00 46 01 00 46 01 00 48 01 00 49 01 00 4B 01 00 4B 01 00 4D 01 00 4D 01 00 4F 01 00 4F 01 00' - '51 01 00 51 01 00 53 01 00 53 01 00 55 01 00 55 01 00 57 01 00 57 01 00 59 01 00 59 01 00 5B 01' - '00 5B 01 00 5D 01 00 5D 01 00 5F 01 00 5F 01 00 61 01 00 61 01 00 63 01 00 63 01 00 65 01 00 65' - '01 00 67 01 00 67 01 00 69 01 00 69 01 00 6B 01 00 6B 01 00 6D 01 00 6D 01 00 6F 01 00 6F 01 00' - '71 01 00 71 01 00 73 01 00 73 01 00 75 01 00 75 01 00 77 01 00 77 01 00 7A 01 00 7A 01 00 7C 01' - '00 7C 01 00 7E 01 00 80 01 00 83 01 00 83 01 00 85 01 00 85 01 00 88 01 00 88 01 00 8C 01 00 8D' - '01 00 92 01 00 92 01 00 95 01 00 95 01 00 99 01 00 9B 01 00 9E 01 00 9E 01 00 A1 01 00 A1 01 00' - 'A3 01 00 A3 01 00 A5 01 00 A5 01 00 A8 01 00 A8 01 00 AA 01 00 AB 01 00 AD 01 00 AD 01 00 B0 01' - '00 B0 01 00 B4 01 00 B4 01 00 B6 01 00 B6 01 00 B9 01 00 BA 01 00 BD 01 00 BF 01 00 C6 01 00 C6' - '01 00 C9 01 00 C9 01 00 CC 01 00 CC 01 00 CE 01 00 CE 01 00 D0 01 00 D0 01 00 D2 01 00 D2 01 00' - 'D4 01 00 D4 01 00 D6 01 00 D6 01 00 D8 01 00 D8 01 00 DA 01 00 DA 01 00 DC 01 00 DD 01 00 DF 01' - '00 DF 01 00 E1 01 00 E1 01 00 E3 01 00 E3 01 00 E5 01 00 E5 01 00 E7 01 00 E7 01 00 E9 01 00 E9' - '01 00 EB 01 00 EB 01 00 ED 01 00 ED 01 00 EF 01 00 F0 01 00 F3 01 00 F3 01 00 F5 01 00 F5 01 00' - 'F9 01 00 F9 01 00 FB 01 00 FB 01 00 FD 01 00 FD 01 00 FF 01 00 FF 01 00 01 02 00 01 02 00 03 02' - '00 03 02 00 05 02 00 05 02 00 07 02 00 07 02 00 09 02 00 09 02 00 0B 02 00 0B 02 00 0D 02 00 0D' - '02 00 0F 02 00 0F 02 00 11 02 00 11 02 00 13 02 00 13 02 00 15 02 00 15 02 00 17 02 00 17 02 00' - '19 02 00 19 02 00 1B 02 00 1B 02 00 1D 02 00 1D 02 00 1F 02 00 1F 02 00 21 02 00 21 02 00 23 02' - '00 23 02 00 25 02 00 25 02 00 27 02 00 27 02 00 29 02 00 29 02 00 2B 02 00 2B 02 00 2D 02 00 2D' - '02 00 2F 02 00 2F 02 00 31 02 00 31 02 00 33 02 00 39 02 00 3C 02 00 3C 02 00 3F 02 00 40 02 00' - '42 02 00 42 02 00 47 02 00 47 02 00 49 02 00 49 02 00 4B 02 00 4B 02 00 4D 02 00 4D 02 00 4F 02' - '00 93 02 00 95 02 00 AF 02 00 71 03 00 71 03 00 73 03 00 73 03 00 77 03 00 77 03 00 7B 03 00 7D' - '03 00 90 03 00 90 03 00 AC 03 00 CE 03 00 D0 03 00 D1 03 00 D5 03 00 D7 03 00 D9 03 00 D9 03 00' - 'DB 03 00 DB 03 00 DD 03 00 DD 03 00 DF 03 00 DF 03 00 E1 03 00 E1 03 00 E3 03 00 E3 03 00 E5 03' - '00 E5 03 00 E7 03 00 E7 03 00 E9 03 00 E9 03 00 EB 03 00 EB 03 00 ED 03 00 ED 03 00 EF 03 00 F3' - '03 00 F5 03 00 F5 03 00 F8 03 00 F8 03 00 FB 03 00 FC 03 00 30 04 00 5F 04 00 61 04 00 61 04 00' - '63 04 00 63 04 00 65 04 00 65 04 00 67 04 00 67 04 00 69 04 00 69 04 00 6B 04 00 6B 04 00 6D 04' - '00 6D 04 00 6F 04 00 6F 04 00 71 04 00 71 04 00 73 04 00 73 04 00 75 04 00 75 04 00 77 04 00 77' - '04 00 79 04 00 79 04 00 7B 04 00 7B 04 00 7D 04 00 7D 04 00 7F 04 00 7F 04 00 81 04 00 81 04 00' - '8B 04 00 8B 04 00 8D 04 00 8D 04 00 8F 04 00 8F 04 00 91 04 00 91 04 00 93 04 00 93 04 00 95 04' - '00 95 04 00 97 04 00 97 04 00 99 04 00 99 04 00 9B 04 00 9B 04 00 9D 04 00 9D 04 00 9F 04 00 9F' - '04 00 A1 04 00 A1 04 00 A3 04 00 A3 04 00 A5 04 00 A5 04 00 A7 04 00 A7 04 00 A9 04 00 A9 04 00' - 'AB 04 00 AB 04 00 AD 04 00 AD 04 00 AF 04 00 AF 04 00 B1 04 00 B1 04 00 B3 04 00 B3 04 00 B5 04' - '00 B5 04 00 B7 04 00 B7 04 00 B9 04 00 B9 04 00 BB 04 00 BB 04 00 BD 04 00 BD 04 00 BF 04 00 BF' - '04 00 C2 04 00 C2 04 00 C4 04 00 C4 04 00 C6 04 00 C6 04 00 C8 04 00 C8 04 00 CA 04 00 CA 04 00' - 'CC 04 00 CC 04 00 CE 04 00 CF 04 00 D1 04 00 D1 04 00 D3 04 00 D3 04 00 D5 04 00 D5 04 00 D7 04' - '00 D7 04 00 D9 04 00 D9 04 00 DB 04 00 DB 04 00 DD 04 00 DD 04 00 DF 04 00 DF 04 00 E1 04 00 E1' - '04 00 E3 04 00 E3 04 00 E5 04 00 E5 04 00 E7 04 00 E7 04 00 E9 04 00 E9 04 00 EB 04 00 EB 04 00' - 'ED 04 00 ED 04 00 EF 04 00 EF 04 00 F1 04 00 F1 04 00 F3 04 00 F3 04 00 F5 04 00 F5 04 00 F7 04' - '00 F7 04 00 F9 04 00 F9 04 00 FB 04 00 FB 04 00 FD 04 00 FD 04 00 FF 04 00 FF 04 00 01 05 00 01' - '05 00 03 05 00 03 05 00 05 05 00 05 05 00 07 05 00 07 05 00 09 05 00 09 05 00 0B 05 00 0B 05 00' - '0D 05 00 0D 05 00 0F 05 00 0F 05 00 11 05 00 11 05 00 13 05 00 13 05 00 15 05 00 15 05 00 17 05' - '00 17 05 00 19 05 00 19 05 00 1B 05 00 1B 05 00 1D 05 00 1D 05 00 1F 05 00 1F 05 00 21 05 00 21' - '05 00 23 05 00 23 05 00 25 05 00 25 05 00 27 05 00 27 05 00 29 05 00 29 05 00 2B 05 00 2B 05 00' - '2D 05 00 2D 05 00 2F 05 00 2F 05 00 60 05 00 88 05 00 D0 10 00 FA 10 00 FD 10 00 FF 10 00 F8 13' - '00 FD 13 00 80 1C 00 88 1C 00 00 1D 00 2B 1D 00 6B 1D 00 77 1D 00 79 1D 00 9A 1D 00 01 1E 00 01' - '1E 00 03 1E 00 03 1E 00 05 1E 00 05 1E 00 07 1E 00 07 1E 00 09 1E 00 09 1E 00 0B 1E 00 0B 1E 00' - '0D 1E 00 0D 1E 00 0F 1E 00 0F 1E 00 11 1E 00 11 1E 00 13 1E 00 13 1E 00 15 1E 00 15 1E 00 17 1E' - '00 17 1E 00 19 1E 00 19 1E 00 1B 1E 00 1B 1E 00 1D 1E 00 1D 1E 00 1F 1E 00 1F 1E 00 21 1E 00 21' - '1E 00 23 1E 00 23 1E 00 25 1E 00 25 1E 00 27 1E 00 27 1E 00 29 1E 00 29 1E 00 2B 1E 00 2B 1E 00' - '2D 1E 00 2D 1E 00 2F 1E 00 2F 1E 00 31 1E 00 31 1E 00 33 1E 00 33 1E 00 35 1E 00 35 1E 00 37 1E' - '00 37 1E 00 39 1E 00 39 1E 00 3B 1E 00 3B 1E 00 3D 1E 00 3D 1E 00 3F 1E 00 3F 1E 00 41 1E 00 41' - '1E 00 43 1E 00 43 1E 00 45 1E 00 45 1E 00 47 1E 00 47 1E 00 49 1E 00 49 1E 00 4B 1E 00 4B 1E 00' - '4D 1E 00 4D 1E 00 4F 1E 00 4F 1E 00 51 1E 00 51 1E 00 53 1E 00 53 1E 00 55 1E 00 55 1E 00 57 1E' - '00 57 1E 00 59 1E 00 59 1E 00 5B 1E 00 5B 1E 00 5D 1E 00 5D 1E 00 5F 1E 00 5F 1E 00 61 1E 00 61' - '1E 00 63 1E 00 63 1E 00 65 1E 00 65 1E 00 67 1E 00 67 1E 00 69 1E 00 69 1E 00 6B 1E 00 6B 1E 00' - '6D 1E 00 6D 1E 00 6F 1E 00 6F 1E 00 71 1E 00 71 1E 00 73 1E 00 73 1E 00 75 1E 00 75 1E 00 77 1E' - '00 77 1E 00 79 1E 00 79 1E 00 7B 1E 00 7B 1E 00 7D 1E 00 7D 1E 00 7F 1E 00 7F 1E 00 81 1E 00 81' - '1E 00 83 1E 00 83 1E 00 85 1E 00 85 1E 00 87 1E 00 87 1E 00 89 1E 00 89 1E 00 8B 1E 00 8B 1E 00' - '8D 1E 00 8D 1E 00 8F 1E 00 8F 1E 00 91 1E 00 91 1E 00 93 1E 00 93 1E 00 95 1E 00 9D 1E 00 9F 1E' - '00 9F 1E 00 A1 1E 00 A1 1E 00 A3 1E 00 A3 1E 00 A5 1E 00 A5 1E 00 A7 1E 00 A7 1E 00 A9 1E 00 A9' - '1E 00 AB 1E 00 AB 1E 00 AD 1E 00 AD 1E 00 AF 1E 00 AF 1E 00 B1 1E 00 B1 1E 00 B3 1E 00 B3 1E 00' - 'B5 1E 00 B5 1E 00 B7 1E 00 B7 1E 00 B9 1E 00 B9 1E 00 BB 1E 00 BB 1E 00 BD 1E 00 BD 1E 00 BF 1E' - '00 BF 1E 00 C1 1E 00 C1 1E 00 C3 1E 00 C3 1E 00 C5 1E 00 C5 1E 00 C7 1E 00 C7 1E 00 C9 1E 00 C9' - '1E 00 CB 1E 00 CB 1E 00 CD 1E 00 CD 1E 00 CF 1E 00 CF 1E 00 D1 1E 00 D1 1E 00 D3 1E 00 D3 1E 00' - 'D5 1E 00 D5 1E 00 D7 1E 00 D7 1E 00 D9 1E 00 D9 1E 00 DB 1E 00 DB 1E 00 DD 1E 00 DD 1E 00 DF 1E' - '00 DF 1E 00 E1 1E 00 E1 1E 00 E3 1E 00 E3 1E 00 E5 1E 00 E5 1E 00 E7 1E 00 E7 1E 00 E9 1E 00 E9' - '1E 00 EB 1E 00 EB 1E 00 ED 1E 00 ED 1E 00 EF 1E 00 EF 1E 00 F1 1E 00 F1 1E 00 F3 1E 00 F3 1E 00' - 'F5 1E 00 F5 1E 00 F7 1E 00 F7 1E 00 F9 1E 00 F9 1E 00 FB 1E 00 FB 1E 00 FD 1E 00 FD 1E 00 FF 1E' - '00 07 1F 00 10 1F 00 15 1F 00 20 1F 00 27 1F 00 30 1F 00 37 1F 00 40 1F 00 45 1F 00 50 1F 00 57' - '1F 00 60 1F 00 67 1F 00 70 1F 00 7D 1F 00 80 1F 00 87 1F 00 90 1F 00 97 1F 00 A0 1F 00 A7 1F 00' - 'B0 1F 00 B4 1F 00 B6 1F 00 B7 1F 00 BE 1F 00 BE 1F 00 C2 1F 00 C4 1F 00 C6 1F 00 C7 1F 00 D0 1F' - '00 D3 1F 00 D6 1F 00 D7 1F 00 E0 1F 00 E7 1F 00 F2 1F 00 F4 1F 00 F6 1F 00 F7 1F 00 0A 21 00 0A' - '21 00 0E 21 00 0F 21 00 13 21 00 13 21 00 2F 21 00 2F 21 00 34 21 00 34 21 00 39 21 00 39 21 00' - '3C 21 00 3D 21 00 46 21 00 49 21 00 4E 21 00 4E 21 00 84 21 00 84 21 00 30 2C 00 5E 2C 00 61 2C' - '00 61 2C 00 65 2C 00 66 2C 00 68 2C 00 68 2C 00 6A 2C 00 6A 2C 00 6C 2C 00 6C 2C 00 71 2C 00 71' - '2C 00 73 2C 00 74 2C 00 76 2C 00 7B 2C 00 81 2C 00 81 2C 00 83 2C 00 83 2C 00 85 2C 00 85 2C 00' - '87 2C 00 87 2C 00 89 2C 00 89 2C 00 8B 2C 00 8B 2C 00 8D 2C 00 8D 2C 00 8F 2C 00 8F 2C 00 91 2C' - '00 91 2C 00 93 2C 00 93 2C 00 95 2C 00 95 2C 00 97 2C 00 97 2C 00 99 2C 00 99 2C 00 9B 2C 00 9B' - '2C 00 9D 2C 00 9D 2C 00 9F 2C 00 9F 2C 00 A1 2C 00 A1 2C 00 A3 2C 00 A3 2C 00 A5 2C 00 A5 2C 00' - 'A7 2C 00 A7 2C 00 A9 2C 00 A9 2C 00 AB 2C 00 AB 2C 00 AD 2C 00 AD 2C 00 AF 2C 00 AF 2C 00 B1 2C' - '00 B1 2C 00 B3 2C 00 B3 2C 00 B5 2C 00 B5 2C 00 B7 2C 00 B7 2C 00 B9 2C 00 B9 2C 00 BB 2C 00 BB' - '2C 00 BD 2C 00 BD 2C 00 BF 2C 00 BF 2C 00 C1 2C 00 C1 2C 00 C3 2C 00 C3 2C 00 C5 2C 00 C5 2C 00' - 'C7 2C 00 C7 2C 00 C9 2C 00 C9 2C 00 CB 2C 00 CB 2C 00 CD 2C 00 CD 2C 00 CF 2C 00 CF 2C 00 D1 2C' - '00 D1 2C 00 D3 2C 00 D3 2C 00 D5 2C 00 D5 2C 00 D7 2C 00 D7 2C 00 D9 2C 00 D9 2C 00 DB 2C 00 DB' - '2C 00 DD 2C 00 DD 2C 00 DF 2C 00 DF 2C 00 E1 2C 00 E1 2C 00 E3 2C 00 E4 2C 00 EC 2C 00 EC 2C 00' - 'EE 2C 00 EE 2C 00 F3 2C 00 F3 2C 00 00 2D 00 25 2D 00 27 2D 00 27 2D 00 2D 2D 00 2D 2D 00 41 A6' - '00 41 A6 00 43 A6 00 43 A6 00 45 A6 00 45 A6 00 47 A6 00 47 A6 00 49 A6 00 49 A6 00 4B A6 00 4B' - 'A6 00 4D A6 00 4D A6 00 4F A6 00 4F A6 00 51 A6 00 51 A6 00 53 A6 00 53 A6 00 55 A6 00 55 A6 00' - '57 A6 00 57 A6 00 59 A6 00 59 A6 00 5B A6 00 5B A6 00 5D A6 00 5D A6 00 5F A6 00 5F A6 00 61 A6' - '00 61 A6 00 63 A6 00 63 A6 00 65 A6 00 65 A6 00 67 A6 00 67 A6 00 69 A6 00 69 A6 00 6B A6 00 6B' - 'A6 00 6D A6 00 6D A6 00 81 A6 00 81 A6 00 83 A6 00 83 A6 00 85 A6 00 85 A6 00 87 A6 00 87 A6 00' - '89 A6 00 89 A6 00 8B A6 00 8B A6 00 8D A6 00 8D A6 00 8F A6 00 8F A6 00 91 A6 00 91 A6 00 93 A6' - '00 93 A6 00 95 A6 00 95 A6 00 97 A6 00 97 A6 00 99 A6 00 99 A6 00 9B A6 00 9B A6 00 23 A7 00 23' - 'A7 00 25 A7 00 25 A7 00 27 A7 00 27 A7 00 29 A7 00 29 A7 00 2B A7 00 2B A7 00 2D A7 00 2D A7 00' - '2F A7 00 31 A7 00 33 A7 00 33 A7 00 35 A7 00 35 A7 00 37 A7 00 37 A7 00 39 A7 00 39 A7 00 3B A7' - '00 3B A7 00 3D A7 00 3D A7 00 3F A7 00 3F A7 00 41 A7 00 41 A7 00 43 A7 00 43 A7 00 45 A7 00 45' - 'A7 00 47 A7 00 47 A7 00 49 A7 00 49 A7 00 4B A7 00 4B A7 00 4D A7 00 4D A7 00 4F A7 00 4F A7 00' - '51 A7 00 51 A7 00 53 A7 00 53 A7 00 55 A7 00 55 A7 00 57 A7 00 57 A7 00 59 A7 00 59 A7 00 5B A7' - '00 5B A7 00 5D A7 00 5D A7 00 5F A7 00 5F A7 00 61 A7 00 61 A7 00 63 A7 00 63 A7 00 65 A7 00 65' - 'A7 00 67 A7 00 67 A7 00 69 A7 00 69 A7 00 6B A7 00 6B A7 00 6D A7 00 6D A7 00 6F A7 00 6F A7 00' - '71 A7 00 78 A7 00 7A A7 00 7A A7 00 7C A7 00 7C A7 00 7F A7 00 7F A7 00 81 A7 00 81 A7 00 83 A7' - '00 83 A7 00 85 A7 00 85 A7 00 87 A7 00 87 A7 00 8C A7 00 8C A7 00 8E A7 00 8E A7 00 91 A7 00 91' - 'A7 00 93 A7 00 95 A7 00 97 A7 00 97 A7 00 99 A7 00 99 A7 00 9B A7 00 9B A7 00 9D A7 00 9D A7 00' - '9F A7 00 9F A7 00 A1 A7 00 A1 A7 00 A3 A7 00 A3 A7 00 A5 A7 00 A5 A7 00 A7 A7 00 A7 A7 00 A9 A7' - '00 A9 A7 00 AF A7 00 AF A7 00 B5 A7 00 B5 A7 00 B7 A7 00 B7 A7 00 B9 A7 00 B9 A7 00 BB A7 00 BB' - 'A7 00 BD A7 00 BD A7 00 BF A7 00 BF A7 00 C3 A7 00 C3 A7 00 C8 A7 00 C8 A7 00 CA A7 00 CA A7 00' - 'F6 A7 00 F6 A7 00 FA A7 00 FA A7 00 30 AB 00 5A AB 00 60 AB 00 68 AB 00 70 AB 00 BF AB 00 00 FB' - '00 06 FB 00 13 FB 00 17 FB 00 41 FF 00 5A FF 00 28 04 01 4F 04 01 D8 04 01 FB 04 01 C0 0C 01 F2' - '0C 01 C0 18 01 DF 18 01 60 6E 01 7F 6E 01 1A D4 01 33 D4 01 4E D4 01 54 D4 01 56 D4 01 67 D4 01' - '82 D4 01 9B D4 01 B6 D4 01 B9 D4 01 BB D4 01 BB D4 01 BD D4 01 C3 D4 01 C5 D4 01 CF D4 01 EA D4' - '01 03 D5 01 1E D5 01 37 D5 01 52 D5 01 6B D5 01 86 D5 01 9F D5 01 BA D5 01 D3 D5 01 EE D5 01 07' - 'D6 01 22 D6 01 3B D6 01 56 D6 01 6F D6 01 8A D6 01 A5 D6 01 C2 D6 01 DA D6 01 DC D6 01 E1 D6 01' - 'FC D6 01 14 D7 01 16 D7 01 1B D7 01 36 D7 01 4E D7 01 50 D7 01 55 D7 01 70 D7 01 88 D7 01 8A D7' - '01 8F D7 01 AA D7 01 C2 D7 01 C4 D7 01 C9 D7 01 CB D7 01 CB D7 01 22 E9 01 43 E9 01 02 0A 00 00' - '00 C5 01 00 C5 01 00 C8 01 00 C8 01 00 CB 01 00 CB 01 00 F2 01 00 F2 01 00 88 1F 00 8F 1F 00 98' - '1F 00 9F 1F 00 A8 1F 00 AF 1F 00 BC 1F 00 BC 1F 00 CC 1F 00 CC 1F 00 FC 1F 00 FC 1F 00 03 44 01' - '00 00 00 03 00 6F 03 00 83 04 00 89 04 00 91 05 00 BD 05 00 BF 05 00 BF 05 00 C1 05 00 C2 05 00' - 'C4 05 00 C5 05 00 C7 05 00 C7 05 00 10 06 00 1A 06 00 4B 06 00 5F 06 00 70 06 00 70 06 00 D6 06' - '00 DC 06 00 DF 06 00 E4 06 00 E7 06 00 E8 06 00 EA 06 00 ED 06 00 11 07 00 11 07 00 30 07 00 4A' - '07 00 A6 07 00 B0 07 00 EB 07 00 F3 07 00 FD 07 00 FD 07 00 16 08 00 19 08 00 1B 08 00 23 08 00' - '25 08 00 27 08 00 29 08 00 2D 08 00 59 08 00 5B 08 00 D3 08 00 E1 08 00 E3 08 00 02 09 00 3A 09' - '00 3A 09 00 3C 09 00 3C 09 00 41 09 00 48 09 00 4D 09 00 4D 09 00 51 09 00 57 09 00 62 09 00 63' - '09 00 81 09 00 81 09 00 BC 09 00 BC 09 00 C1 09 00 C4 09 00 CD 09 00 CD 09 00 E2 09 00 E3 09 00' - 'FE 09 00 FE 09 00 01 0A 00 02 0A 00 3C 0A 00 3C 0A 00 41 0A 00 42 0A 00 47 0A 00 48 0A 00 4B 0A' - '00 4D 0A 00 51 0A 00 51 0A 00 70 0A 00 71 0A 00 75 0A 00 75 0A 00 81 0A 00 82 0A 00 BC 0A 00 BC' - '0A 00 C1 0A 00 C5 0A 00 C7 0A 00 C8 0A 00 CD 0A 00 CD 0A 00 E2 0A 00 E3 0A 00 FA 0A 00 FF 0A 00' - '01 0B 00 01 0B 00 3C 0B 00 3C 0B 00 3F 0B 00 3F 0B 00 41 0B 00 44 0B 00 4D 0B 00 4D 0B 00 55 0B' - '00 56 0B 00 62 0B 00 63 0B 00 82 0B 00 82 0B 00 C0 0B 00 C0 0B 00 CD 0B 00 CD 0B 00 00 0C 00 00' - '0C 00 04 0C 00 04 0C 00 3E 0C 00 40 0C 00 46 0C 00 48 0C 00 4A 0C 00 4D 0C 00 55 0C 00 56 0C 00' - '62 0C 00 63 0C 00 81 0C 00 81 0C 00 BC 0C 00 BC 0C 00 BF 0C 00 BF 0C 00 C6 0C 00 C6 0C 00 CC 0C' - '00 CD 0C 00 E2 0C 00 E3 0C 00 00 0D 00 01 0D 00 3B 0D 00 3C 0D 00 41 0D 00 44 0D 00 4D 0D 00 4D' - '0D 00 62 0D 00 63 0D 00 81 0D 00 81 0D 00 CA 0D 00 CA 0D 00 D2 0D 00 D4 0D 00 D6 0D 00 D6 0D 00' - '31 0E 00 31 0E 00 34 0E 00 3A 0E 00 47 0E 00 4E 0E 00 B1 0E 00 B1 0E 00 B4 0E 00 BC 0E 00 C8 0E' - '00 CD 0E 00 18 0F 00 19 0F 00 35 0F 00 35 0F 00 37 0F 00 37 0F 00 39 0F 00 39 0F 00 71 0F 00 7E' - '0F 00 80 0F 00 84 0F 00 86 0F 00 87 0F 00 8D 0F 00 97 0F 00 99 0F 00 BC 0F 00 C6 0F 00 C6 0F 00' - '2D 10 00 30 10 00 32 10 00 37 10 00 39 10 00 3A 10 00 3D 10 00 3E 10 00 58 10 00 59 10 00 5E 10' - '00 60 10 00 71 10 00 74 10 00 82 10 00 82 10 00 85 10 00 86 10 00 8D 10 00 8D 10 00 9D 10 00 9D' - '10 00 5D 13 00 5F 13 00 12 17 00 14 17 00 32 17 00 34 17 00 52 17 00 53 17 00 72 17 00 73 17 00' - 'B4 17 00 B5 17 00 B7 17 00 BD 17 00 C6 17 00 C6 17 00 C9 17 00 D3 17 00 DD 17 00 DD 17 00 0B 18' - '00 0D 18 00 85 18 00 86 18 00 A9 18 00 A9 18 00 20 19 00 22 19 00 27 19 00 28 19 00 32 19 00 32' - '19 00 39 19 00 3B 19 00 17 1A 00 18 1A 00 1B 1A 00 1B 1A 00 56 1A 00 56 1A 00 58 1A 00 5E 1A 00' - '60 1A 00 60 1A 00 62 1A 00 62 1A 00 65 1A 00 6C 1A 00 73 1A 00 7C 1A 00 7F 1A 00 7F 1A 00 B0 1A' - '00 C0 1A 00 00 1B 00 03 1B 00 34 1B 00 34 1B 00 36 1B 00 3A 1B 00 3C 1B 00 3C 1B 00 42 1B 00 42' - '1B 00 6B 1B 00 73 1B 00 80 1B 00 81 1B 00 A2 1B 00 A5 1B 00 A8 1B 00 A9 1B 00 AB 1B 00 AD 1B 00' - 'E6 1B 00 E6 1B 00 E8 1B 00 E9 1B 00 ED 1B 00 ED 1B 00 EF 1B 00 F1 1B 00 2C 1C 00 33 1C 00 36 1C' - '00 37 1C 00 D0 1C 00 D2 1C 00 D4 1C 00 E0 1C 00 E2 1C 00 E8 1C 00 ED 1C 00 ED 1C 00 F4 1C 00 F4' - '1C 00 F8 1C 00 F9 1C 00 C0 1D 00 F9 1D 00 FB 1D 00 FF 1D 00 D0 20 00 F0 20 00 EF 2C 00 F1 2C 00' - '7F 2D 00 7F 2D 00 E0 2D 00 FF 2D 00 2A 30 00 2D 30 00 99 30 00 9A 30 00 6F A6 00 72 A6 00 74 A6' - '00 7D A6 00 9E A6 00 9F A6 00 F0 A6 00 F1 A6 00 02 A8 00 02 A8 00 06 A8 00 06 A8 00 0B A8 00 0B' - 'A8 00 25 A8 00 26 A8 00 2C A8 00 2C A8 00 C4 A8 00 C5 A8 00 E0 A8 00 F1 A8 00 FF A8 00 FF A8 00' - '26 A9 00 2D A9 00 47 A9 00 51 A9 00 80 A9 00 82 A9 00 B3 A9 00 B3 A9 00 B6 A9 00 B9 A9 00 BC A9' - '00 BD A9 00 E5 A9 00 E5 A9 00 29 AA 00 2E AA 00 31 AA 00 32 AA 00 35 AA 00 36 AA 00 43 AA 00 43' - 'AA 00 4C AA 00 4C AA 00 7C AA 00 7C AA 00 B0 AA 00 B0 AA 00 B2 AA 00 B4 AA 00 B7 AA 00 B8 AA 00' - 'BE AA 00 BF AA 00 C1 AA 00 C1 AA 00 EC AA 00 ED AA 00 F6 AA 00 F6 AA 00 E5 AB 00 E5 AB 00 E8 AB' - '00 E8 AB 00 ED AB 00 ED AB 00 1E FB 00 1E FB 00 00 FE 00 0F FE 00 20 FE 00 2F FE 00 FD 01 01 FD' - '01 01 E0 02 01 E0 02 01 76 03 01 7A 03 01 01 0A 01 03 0A 01 05 0A 01 06 0A 01 0C 0A 01 0F 0A 01' - '38 0A 01 3A 0A 01 3F 0A 01 3F 0A 01 E5 0A 01 E6 0A 01 24 0D 01 27 0D 01 AB 0E 01 AC 0E 01 46 0F' - '01 50 0F 01 01 10 01 01 10 01 38 10 01 46 10 01 7F 10 01 81 10 01 B3 10 01 B6 10 01 B9 10 01 BA' - '10 01 00 11 01 02 11 01 27 11 01 2B 11 01 2D 11 01 34 11 01 73 11 01 73 11 01 80 11 01 81 11 01' - 'B6 11 01 BE 11 01 C9 11 01 CC 11 01 CF 11 01 CF 11 01 2F 12 01 31 12 01 34 12 01 34 12 01 36 12' - '01 37 12 01 3E 12 01 3E 12 01 DF 12 01 DF 12 01 E3 12 01 EA 12 01 00 13 01 01 13 01 3B 13 01 3C' - '13 01 40 13 01 40 13 01 66 13 01 6C 13 01 70 13 01 74 13 01 38 14 01 3F 14 01 42 14 01 44 14 01' - '46 14 01 46 14 01 5E 14 01 5E 14 01 B3 14 01 B8 14 01 BA 14 01 BA 14 01 BF 14 01 C0 14 01 C2 14' - '01 C3 14 01 B2 15 01 B5 15 01 BC 15 01 BD 15 01 BF 15 01 C0 15 01 DC 15 01 DD 15 01 33 16 01 3A' - '16 01 3D 16 01 3D 16 01 3F 16 01 40 16 01 AB 16 01 AB 16 01 AD 16 01 AD 16 01 B0 16 01 B5 16 01' - 'B7 16 01 B7 16 01 1D 17 01 1F 17 01 22 17 01 25 17 01 27 17 01 2B 17 01 2F 18 01 37 18 01 39 18' - '01 3A 18 01 3B 19 01 3C 19 01 3E 19 01 3E 19 01 43 19 01 43 19 01 D4 19 01 D7 19 01 DA 19 01 DB' - '19 01 E0 19 01 E0 19 01 01 1A 01 0A 1A 01 33 1A 01 38 1A 01 3B 1A 01 3E 1A 01 47 1A 01 47 1A 01' - '51 1A 01 56 1A 01 59 1A 01 5B 1A 01 8A 1A 01 96 1A 01 98 1A 01 99 1A 01 30 1C 01 36 1C 01 38 1C' - '01 3D 1C 01 3F 1C 01 3F 1C 01 92 1C 01 A7 1C 01 AA 1C 01 B0 1C 01 B2 1C 01 B3 1C 01 B5 1C 01 B6' - '1C 01 31 1D 01 36 1D 01 3A 1D 01 3A 1D 01 3C 1D 01 3D 1D 01 3F 1D 01 45 1D 01 47 1D 01 47 1D 01' - '90 1D 01 91 1D 01 95 1D 01 95 1D 01 97 1D 01 97 1D 01 F3 1E 01 F4 1E 01 F0 6A 01 F4 6A 01 30 6B' - '01 36 6B 01 4F 6F 01 4F 6F 01 8F 6F 01 92 6F 01 E4 6F 01 E4 6F 01 9D BC 01 9E BC 01 67 D1 01 69' - 'D1 01 7B D1 01 82 D1 01 85 D1 01 8B D1 01 AA D1 01 AD D1 01 42 D2 01 44 D2 01 00 DA 01 36 DA 01' - '3B DA 01 6C DA 01 75 DA 01 75 DA 01 84 DA 01 84 DA 01 9B DA 01 9F DA 01 A1 DA 01 AF DA 01 00 E0' - '01 06 E0 01 08 E0 01 18 E0 01 1B E0 01 21 E0 01 23 E0 01 24 E0 01 26 E0 01 2A E0 01 30 E1 01 36' - 'E1 01 EC E2 01 EF E2 01 D0 E8 01 D6 E8 01 44 E9 01 4A E9 01 00 01 0E EF 01 0E 04 AF 00 00 00 03' - '09 00 03 09 00 3B 09 00 3B 09 00 3E 09 00 40 09 00 49 09 00 4C 09 00 4E 09 00 4F 09 00 82 09 00' - '83 09 00 BE 09 00 C0 09 00 C7 09 00 C8 09 00 CB 09 00 CC 09 00 D7 09 00 D7 09 00 03 0A 00 03 0A' - '00 3E 0A 00 40 0A 00 83 0A 00 83 0A 00 BE 0A 00 C0 0A 00 C9 0A 00 C9 0A 00 CB 0A 00 CC 0A 00 02' - '0B 00 03 0B 00 3E 0B 00 3E 0B 00 40 0B 00 40 0B 00 47 0B 00 48 0B 00 4B 0B 00 4C 0B 00 57 0B 00' - '57 0B 00 BE 0B 00 BF 0B 00 C1 0B 00 C2 0B 00 C6 0B 00 C8 0B 00 CA 0B 00 CC 0B 00 D7 0B 00 D7 0B' - '00 01 0C 00 03 0C 00 41 0C 00 44 0C 00 82 0C 00 83 0C 00 BE 0C 00 BE 0C 00 C0 0C 00 C4 0C 00 C7' - '0C 00 C8 0C 00 CA 0C 00 CB 0C 00 D5 0C 00 D6 0C 00 02 0D 00 03 0D 00 3E 0D 00 40 0D 00 46 0D 00' - '48 0D 00 4A 0D 00 4C 0D 00 57 0D 00 57 0D 00 82 0D 00 83 0D 00 CF 0D 00 D1 0D 00 D8 0D 00 DF 0D' - '00 F2 0D 00 F3 0D 00 3E 0F 00 3F 0F 00 7F 0F 00 7F 0F 00 2B 10 00 2C 10 00 31 10 00 31 10 00 38' - '10 00 38 10 00 3B 10 00 3C 10 00 56 10 00 57 10 00 62 10 00 64 10 00 67 10 00 6D 10 00 83 10 00' - '84 10 00 87 10 00 8C 10 00 8F 10 00 8F 10 00 9A 10 00 9C 10 00 B6 17 00 B6 17 00 BE 17 00 C5 17' - '00 C7 17 00 C8 17 00 23 19 00 26 19 00 29 19 00 2B 19 00 30 19 00 31 19 00 33 19 00 38 19 00 19' - '1A 00 1A 1A 00 55 1A 00 55 1A 00 57 1A 00 57 1A 00 61 1A 00 61 1A 00 63 1A 00 64 1A 00 6D 1A 00' - '72 1A 00 04 1B 00 04 1B 00 35 1B 00 35 1B 00 3B 1B 00 3B 1B 00 3D 1B 00 41 1B 00 43 1B 00 44 1B' - '00 82 1B 00 82 1B 00 A1 1B 00 A1 1B 00 A6 1B 00 A7 1B 00 AA 1B 00 AA 1B 00 E7 1B 00 E7 1B 00 EA' - '1B 00 EC 1B 00 EE 1B 00 EE 1B 00 F2 1B 00 F3 1B 00 24 1C 00 2B 1C 00 34 1C 00 35 1C 00 E1 1C 00' - 'E1 1C 00 F7 1C 00 F7 1C 00 2E 30 00 2F 30 00 23 A8 00 24 A8 00 27 A8 00 27 A8 00 80 A8 00 81 A8' - '00 B4 A8 00 C3 A8 00 52 A9 00 53 A9 00 83 A9 00 83 A9 00 B4 A9 00 B5 A9 00 BA A9 00 BB A9 00 BE' - 'A9 00 C0 A9 00 2F AA 00 30 AA 00 33 AA 00 34 AA 00 4D AA 00 4D AA 00 7B AA 00 7B AA 00 7D AA 00' - '7D AA 00 EB AA 00 EB AA 00 EE AA 00 EF AA 00 F5 AA 00 F5 AA 00 E3 AB 00 E4 AB 00 E6 AB 00 E7 AB' - '00 E9 AB 00 EA AB 00 EC AB 00 EC AB 00 00 10 01 00 10 01 02 10 01 02 10 01 82 10 01 82 10 01 B0' - '10 01 B2 10 01 B7 10 01 B8 10 01 2C 11 01 2C 11 01 45 11 01 46 11 01 82 11 01 82 11 01 B3 11 01' - 'B5 11 01 BF 11 01 C0 11 01 CE 11 01 CE 11 01 2C 12 01 2E 12 01 32 12 01 33 12 01 35 12 01 35 12' - '01 E0 12 01 E2 12 01 02 13 01 03 13 01 3E 13 01 3F 13 01 41 13 01 44 13 01 47 13 01 48 13 01 4B' - '13 01 4D 13 01 57 13 01 57 13 01 62 13 01 63 13 01 35 14 01 37 14 01 40 14 01 41 14 01 45 14 01' - '45 14 01 B0 14 01 B2 14 01 B9 14 01 B9 14 01 BB 14 01 BE 14 01 C1 14 01 C1 14 01 AF 15 01 B1 15' - '01 B8 15 01 BB 15 01 BE 15 01 BE 15 01 30 16 01 32 16 01 3B 16 01 3C 16 01 3E 16 01 3E 16 01 AC' - '16 01 AC 16 01 AE 16 01 AF 16 01 B6 16 01 B6 16 01 20 17 01 21 17 01 26 17 01 26 17 01 2C 18 01' - '2E 18 01 38 18 01 38 18 01 30 19 01 35 19 01 37 19 01 38 19 01 3D 19 01 3D 19 01 40 19 01 40 19' - '01 42 19 01 42 19 01 D1 19 01 D3 19 01 DC 19 01 DF 19 01 E4 19 01 E4 19 01 39 1A 01 39 1A 01 57' - '1A 01 58 1A 01 97 1A 01 97 1A 01 2F 1C 01 2F 1C 01 3E 1C 01 3E 1C 01 A9 1C 01 A9 1C 01 B1 1C 01' - 'B1 1C 01 B4 1C 01 B4 1C 01 8A 1D 01 8E 1D 01 93 1D 01 94 1D 01 96 1D 01 96 1D 01 F5 1E 01 F6 1E' - '01 51 6F 01 87 6F 01 F0 6F 01 F1 6F 01 65 D1 01 66 D1 01 6D D1 01 72 D1 01 05 05 00 00 00 88 04' - '00 89 04 00 BE 1A 00 BE 1A 00 DD 20 00 E0 20 00 E2 20 00 E4 20 00 70 A6 00 72 A6 00 06 3D 00 00' - '00 30 00 00 39 00 00 60 06 00 69 06 00 F0 06 00 F9 06 00 C0 07 00 C9 07 00 66 09 00 6F 09 00 E6' - '09 00 EF 09 00 66 0A 00 6F 0A 00 E6 0A 00 EF 0A 00 66 0B 00 6F 0B 00 E6 0B 00 EF 0B 00 66 0C 00' - '6F 0C 00 E6 0C 00 EF 0C 00 66 0D 00 6F 0D 00 E6 0D 00 EF 0D 00 50 0E 00 59 0E 00 D0 0E 00 D9 0E' - '00 20 0F 00 29 0F 00 40 10 00 49 10 00 90 10 00 99 10 00 E0 17 00 E9 17 00 10 18 00 19 18 00 46' - '19 00 4F 19 00 D0 19 00 D9 19 00 80 1A 00 89 1A 00 90 1A 00 99 1A 00 50 1B 00 59 1B 00 B0 1B 00' - 'B9 1B 00 40 1C 00 49 1C 00 50 1C 00 59 1C 00 20 A6 00 29 A6 00 D0 A8 00 D9 A8 00 00 A9 00 09 A9' - '00 D0 A9 00 D9 A9 00 F0 A9 00 F9 A9 00 50 AA 00 59 AA 00 F0 AB 00 F9 AB 00 10 FF 00 19 FF 00 A0' - '04 01 A9 04 01 30 0D 01 39 0D 01 66 10 01 6F 10 01 F0 10 01 F9 10 01 36 11 01 3F 11 01 D0 11 01' - 'D9 11 01 F0 12 01 F9 12 01 50 14 01 59 14 01 D0 14 01 D9 14 01 50 16 01 59 16 01 C0 16 01 C9 16' - '01 30 17 01 39 17 01 E0 18 01 E9 18 01 50 19 01 59 19 01 50 1C 01 59 1C 01 50 1D 01 59 1D 01 A0' - '1D 01 A9 1D 01 60 6A 01 69 6A 01 50 6B 01 59 6B 01 CE D7 01 FF D7 01 40 E1 01 49 E1 01 F0 E2 01' - 'F9 E2 01 50 E9 01 59 E9 01 F0 FB 01 F9 FB 01 07 0C 00 00 00 EE 16 00 F0 16 00 60 21 00 82 21 00' - '85 21 00 88 21 00 07 30 00 07 30 00 21 30 00 29 30 00 38 30 00 3A 30 00 E6 A6 00 EF A6 00 40 01' - '01 74 01 01 41 03 01 41 03 01 4A 03 01 4A 03 01 D1 03 01 D5 03 01 00 24 01 6E 24 01 08 47 00 00' - '00 B2 00 00 B3 00 00 B9 00 00 B9 00 00 BC 00 00 BE 00 00 F4 09 00 F9 09 00 72 0B 00 77 0B 00 F0' - '0B 00 F2 0B 00 78 0C 00 7E 0C 00 58 0D 00 5E 0D 00 70 0D 00 78 0D 00 2A 0F 00 33 0F 00 69 13 00' - '7C 13 00 F0 17 00 F9 17 00 DA 19 00 DA 19 00 70 20 00 70 20 00 74 20 00 79 20 00 80 20 00 89 20' - '00 50 21 00 5F 21 00 89 21 00 89 21 00 60 24 00 9B 24 00 EA 24 00 FF 24 00 76 27 00 93 27 00 FD' - '2C 00 FD 2C 00 92 31 00 95 31 00 20 32 00 29 32 00 48 32 00 4F 32 00 51 32 00 5F 32 00 80 32 00' - '89 32 00 B1 32 00 BF 32 00 30 A8 00 35 A8 00 07 01 01 33 01 01 75 01 01 78 01 01 8A 01 01 8B 01' - '01 E1 02 01 FB 02 01 20 03 01 23 03 01 58 08 01 5F 08 01 79 08 01 7F 08 01 A7 08 01 AF 08 01 FB' - '08 01 FF 08 01 16 09 01 1B 09 01 BC 09 01 BD 09 01 C0 09 01 CF 09 01 D2 09 01 FF 09 01 40 0A 01' - '48 0A 01 7D 0A 01 7E 0A 01 9D 0A 01 9F 0A 01 EB 0A 01 EF 0A 01 58 0B 01 5F 0B 01 78 0B 01 7F 0B' - '01 A9 0B 01 AF 0B 01 FA 0C 01 FF 0C 01 60 0E 01 7E 0E 01 1D 0F 01 26 0F 01 51 0F 01 54 0F 01 C5' - '0F 01 CB 0F 01 52 10 01 65 10 01 E1 11 01 F4 11 01 3A 17 01 3B 17 01 EA 18 01 F2 18 01 5A 1C 01' - '6C 1C 01 C0 1F 01 D4 1F 01 5B 6B 01 61 6B 01 80 6E 01 96 6E 01 E0 D2 01 F3 D2 01 60 D3 01 78 D3' - '01 C7 E8 01 CF E8 01 71 EC 01 AB EC 01 AD EC 01 AF EC 01 B1 EC 01 B4 EC 01 01 ED 01 2D ED 01 2F' - 'ED 01 3D ED 01 00 F1 01 0C F1 01 09 07 00 00 00 20 00 00 20 00 00 A0 00 00 A0 00 00 80 16 00 80' - '16 00 00 20 00 0A 20 00 2F 20 00 2F 20 00 5F 20 00 5F 20 00 00 30 00 00 30 00 0A 01 00 00 00 28' - '20 00 28 20 00 0B 05 00 00 00 0A 00 00 0A 00 00 0D 00 00 0D 00 00 1C 00 00 1E 00 00 85 00 00 85' - '00 00 29 20 00 29 20 00 0C 02 00 00 00 00 00 00 1F 00 00 7F 00 00 9F 00 00 0D 14 00 00 00 AD 00' - '00 AD 00 00 00 06 00 05 06 00 1C 06 00 1C 06 00 DD 06 00 DD 06 00 0F 07 00 0F 07 00 E2 08 00 E2' - '08 00 0E 18 00 0E 18 00 0B 20 00 0F 20 00 2A 20 00 2E 20 00 60 20 00 64 20 00 66 20 00 6F 20 00' - 'FF FE 00 FF FE 00 F9 FF 00 FB FF 00 BD 10 01 BD 10 01 CD 10 01 CD 10 01 30 34 01 38 34 01 A0 BC' - '01 A3 BC 01 73 D1 01 7A D1 01 01 00 0E 01 00 0E 20 00 0E 7F 00 0E 0E 01 00 00 00 00 D8 00 FF DF' - '00 0F 03 00 00 00 00 E0 00 FF F8 00 00 00 0F FD FF 0F 00 00 10 FD FF 10 11 3D 00 00 00 B0 02 00' - 'C1 02 00 C6 02 00 D1 02 00 E0 02 00 E4 02 00 EC 02 00 EC 02 00 EE 02 00 EE 02 00 74 03 00 74 03' - '00 7A 03 00 7A 03 00 59 05 00 59 05 00 40 06 00 40 06 00 E5 06 00 E6 06 00 F4 07 00 F5 07 00 FA' - '07 00 FA 07 00 1A 08 00 1A 08 00 24 08 00 24 08 00 28 08 00 28 08 00 71 09 00 71 09 00 46 0E 00' - '46 0E 00 C6 0E 00 C6 0E 00 FC 10 00 FC 10 00 D7 17 00 D7 17 00 43 18 00 43 18 00 A7 1A 00 A7 1A' - '00 78 1C 00 7D 1C 00 2C 1D 00 6A 1D 00 78 1D 00 78 1D 00 9B 1D 00 BF 1D 00 71 20 00 71 20 00 7F' - '20 00 7F 20 00 90 20 00 9C 20 00 7C 2C 00 7D 2C 00 6F 2D 00 6F 2D 00 2F 2E 00 2F 2E 00 05 30 00' - '05 30 00 31 30 00 35 30 00 3B 30 00 3B 30 00 9D 30 00 9E 30 00 FC 30 00 FE 30 00 15 A0 00 15 A0' - '00 F8 A4 00 FD A4 00 0C A6 00 0C A6 00 7F A6 00 7F A6 00 9C A6 00 9D A6 00 17 A7 00 1F A7 00 70' - 'A7 00 70 A7 00 88 A7 00 88 A7 00 F8 A7 00 F9 A7 00 CF A9 00 CF A9 00 E6 A9 00 E6 A9 00 70 AA 00' - '70 AA 00 DD AA 00 DD AA 00 F3 AA 00 F4 AA 00 5C AB 00 5F AB 00 69 AB 00 69 AB 00 70 FF 00 70 FF' - '00 9E FF 00 9F FF 00 40 6B 01 43 6B 01 93 6F 01 9F 6F 01 E0 6F 01 E1 6F 01 E3 6F 01 E3 6F 01 37' - 'E1 01 3D E1 01 4B E9 01 4B E9 01 12 E9 01 00 00 AA 00 00 AA 00 00 BA 00 00 BA 00 00 BB 01 00 BB' - '01 00 C0 01 00 C3 01 00 94 02 00 94 02 00 D0 05 00 EA 05 00 EF 05 00 F2 05 00 20 06 00 3F 06 00' - '41 06 00 4A 06 00 6E 06 00 6F 06 00 71 06 00 D3 06 00 D5 06 00 D5 06 00 EE 06 00 EF 06 00 FA 06' - '00 FC 06 00 FF 06 00 FF 06 00 10 07 00 10 07 00 12 07 00 2F 07 00 4D 07 00 A5 07 00 B1 07 00 B1' - '07 00 CA 07 00 EA 07 00 00 08 00 15 08 00 40 08 00 58 08 00 60 08 00 6A 08 00 A0 08 00 B4 08 00' - 'B6 08 00 C7 08 00 04 09 00 39 09 00 3D 09 00 3D 09 00 50 09 00 50 09 00 58 09 00 61 09 00 72 09' - '00 80 09 00 85 09 00 8C 09 00 8F 09 00 90 09 00 93 09 00 A8 09 00 AA 09 00 B0 09 00 B2 09 00 B2' - '09 00 B6 09 00 B9 09 00 BD 09 00 BD 09 00 CE 09 00 CE 09 00 DC 09 00 DD 09 00 DF 09 00 E1 09 00' - 'F0 09 00 F1 09 00 FC 09 00 FC 09 00 05 0A 00 0A 0A 00 0F 0A 00 10 0A 00 13 0A 00 28 0A 00 2A 0A' - '00 30 0A 00 32 0A 00 33 0A 00 35 0A 00 36 0A 00 38 0A 00 39 0A 00 59 0A 00 5C 0A 00 5E 0A 00 5E' - '0A 00 72 0A 00 74 0A 00 85 0A 00 8D 0A 00 8F 0A 00 91 0A 00 93 0A 00 A8 0A 00 AA 0A 00 B0 0A 00' - 'B2 0A 00 B3 0A 00 B5 0A 00 B9 0A 00 BD 0A 00 BD 0A 00 D0 0A 00 D0 0A 00 E0 0A 00 E1 0A 00 F9 0A' - '00 F9 0A 00 05 0B 00 0C 0B 00 0F 0B 00 10 0B 00 13 0B 00 28 0B 00 2A 0B 00 30 0B 00 32 0B 00 33' - '0B 00 35 0B 00 39 0B 00 3D 0B 00 3D 0B 00 5C 0B 00 5D 0B 00 5F 0B 00 61 0B 00 71 0B 00 71 0B 00' - '83 0B 00 83 0B 00 85 0B 00 8A 0B 00 8E 0B 00 90 0B 00 92 0B 00 95 0B 00 99 0B 00 9A 0B 00 9C 0B' - '00 9C 0B 00 9E 0B 00 9F 0B 00 A3 0B 00 A4 0B 00 A8 0B 00 AA 0B 00 AE 0B 00 B9 0B 00 D0 0B 00 D0' - '0B 00 05 0C 00 0C 0C 00 0E 0C 00 10 0C 00 12 0C 00 28 0C 00 2A 0C 00 39 0C 00 3D 0C 00 3D 0C 00' - '58 0C 00 5A 0C 00 60 0C 00 61 0C 00 80 0C 00 80 0C 00 85 0C 00 8C 0C 00 8E 0C 00 90 0C 00 92 0C' - '00 A8 0C 00 AA 0C 00 B3 0C 00 B5 0C 00 B9 0C 00 BD 0C 00 BD 0C 00 DE 0C 00 DE 0C 00 E0 0C 00 E1' - '0C 00 F1 0C 00 F2 0C 00 04 0D 00 0C 0D 00 0E 0D 00 10 0D 00 12 0D 00 3A 0D 00 3D 0D 00 3D 0D 00' - '4E 0D 00 4E 0D 00 54 0D 00 56 0D 00 5F 0D 00 61 0D 00 7A 0D 00 7F 0D 00 85 0D 00 96 0D 00 9A 0D' - '00 B1 0D 00 B3 0D 00 BB 0D 00 BD 0D 00 BD 0D 00 C0 0D 00 C6 0D 00 01 0E 00 30 0E 00 32 0E 00 33' - '0E 00 40 0E 00 45 0E 00 81 0E 00 82 0E 00 84 0E 00 84 0E 00 86 0E 00 8A 0E 00 8C 0E 00 A3 0E 00' - 'A5 0E 00 A5 0E 00 A7 0E 00 B0 0E 00 B2 0E 00 B3 0E 00 BD 0E 00 BD 0E 00 C0 0E 00 C4 0E 00 DC 0E' - '00 DF 0E 00 00 0F 00 00 0F 00 40 0F 00 47 0F 00 49 0F 00 6C 0F 00 88 0F 00 8C 0F 00 00 10 00 2A' - '10 00 3F 10 00 3F 10 00 50 10 00 55 10 00 5A 10 00 5D 10 00 61 10 00 61 10 00 65 10 00 66 10 00' - '6E 10 00 70 10 00 75 10 00 81 10 00 8E 10 00 8E 10 00 00 11 00 48 12 00 4A 12 00 4D 12 00 50 12' - '00 56 12 00 58 12 00 58 12 00 5A 12 00 5D 12 00 60 12 00 88 12 00 8A 12 00 8D 12 00 90 12 00 B0' - '12 00 B2 12 00 B5 12 00 B8 12 00 BE 12 00 C0 12 00 C0 12 00 C2 12 00 C5 12 00 C8 12 00 D6 12 00' - 'D8 12 00 10 13 00 12 13 00 15 13 00 18 13 00 5A 13 00 80 13 00 8F 13 00 01 14 00 6C 16 00 6F 16' - '00 7F 16 00 81 16 00 9A 16 00 A0 16 00 EA 16 00 F1 16 00 F8 16 00 00 17 00 0C 17 00 0E 17 00 11' - '17 00 20 17 00 31 17 00 40 17 00 51 17 00 60 17 00 6C 17 00 6E 17 00 70 17 00 80 17 00 B3 17 00' - 'DC 17 00 DC 17 00 20 18 00 42 18 00 44 18 00 78 18 00 80 18 00 84 18 00 87 18 00 A8 18 00 AA 18' - '00 AA 18 00 B0 18 00 F5 18 00 00 19 00 1E 19 00 50 19 00 6D 19 00 70 19 00 74 19 00 80 19 00 AB' - '19 00 B0 19 00 C9 19 00 00 1A 00 16 1A 00 20 1A 00 54 1A 00 05 1B 00 33 1B 00 45 1B 00 4B 1B 00' - '83 1B 00 A0 1B 00 AE 1B 00 AF 1B 00 BA 1B 00 E5 1B 00 00 1C 00 23 1C 00 4D 1C 00 4F 1C 00 5A 1C' - '00 77 1C 00 E9 1C 00 EC 1C 00 EE 1C 00 F3 1C 00 F5 1C 00 F6 1C 00 FA 1C 00 FA 1C 00 35 21 00 38' - '21 00 30 2D 00 67 2D 00 80 2D 00 96 2D 00 A0 2D 00 A6 2D 00 A8 2D 00 AE 2D 00 B0 2D 00 B6 2D 00' - 'B8 2D 00 BE 2D 00 C0 2D 00 C6 2D 00 C8 2D 00 CE 2D 00 D0 2D 00 D6 2D 00 D8 2D 00 DE 2D 00 06 30' - '00 06 30 00 3C 30 00 3C 30 00 41 30 00 96 30 00 9F 30 00 9F 30 00 A1 30 00 FA 30 00 FF 30 00 FF' - '30 00 05 31 00 2F 31 00 31 31 00 8E 31 00 A0 31 00 BF 31 00 F0 31 00 FF 31 00 00 34 00 BF 4D 00' - '00 4E 00 FC 9F 00 00 A0 00 14 A0 00 16 A0 00 8C A4 00 D0 A4 00 F7 A4 00 00 A5 00 0B A6 00 10 A6' - '00 1F A6 00 2A A6 00 2B A6 00 6E A6 00 6E A6 00 A0 A6 00 E5 A6 00 8F A7 00 8F A7 00 F7 A7 00 F7' - 'A7 00 FB A7 00 01 A8 00 03 A8 00 05 A8 00 07 A8 00 0A A8 00 0C A8 00 22 A8 00 40 A8 00 73 A8 00' - '82 A8 00 B3 A8 00 F2 A8 00 F7 A8 00 FB A8 00 FB A8 00 FD A8 00 FE A8 00 0A A9 00 25 A9 00 30 A9' - '00 46 A9 00 60 A9 00 7C A9 00 84 A9 00 B2 A9 00 E0 A9 00 E4 A9 00 E7 A9 00 EF A9 00 FA A9 00 FE' - 'A9 00 00 AA 00 28 AA 00 40 AA 00 42 AA 00 44 AA 00 4B AA 00 60 AA 00 6F AA 00 71 AA 00 76 AA 00' - '7A AA 00 7A AA 00 7E AA 00 AF AA 00 B1 AA 00 B1 AA 00 B5 AA 00 B6 AA 00 B9 AA 00 BD AA 00 C0 AA' - '00 C0 AA 00 C2 AA 00 C2 AA 00 DB AA 00 DC AA 00 E0 AA 00 EA AA 00 F2 AA 00 F2 AA 00 01 AB 00 06' - 'AB 00 09 AB 00 0E AB 00 11 AB 00 16 AB 00 20 AB 00 26 AB 00 28 AB 00 2E AB 00 C0 AB 00 E2 AB 00' - '00 AC 00 A3 D7 00 B0 D7 00 C6 D7 00 CB D7 00 FB D7 00 00 F9 00 6D FA 00 70 FA 00 D9 FA 00 1D FB' - '00 1D FB 00 1F FB 00 28 FB 00 2A FB 00 36 FB 00 38 FB 00 3C FB 00 3E FB 00 3E FB 00 40 FB 00 41' - 'FB 00 43 FB 00 44 FB 00 46 FB 00 B1 FB 00 D3 FB 00 3D FD 00 50 FD 00 8F FD 00 92 FD 00 C7 FD 00' - 'F0 FD 00 FB FD 00 70 FE 00 74 FE 00 76 FE 00 FC FE 00 66 FF 00 6F FF 00 71 FF 00 9D FF 00 A0 FF' - '00 BE FF 00 C2 FF 00 C7 FF 00 CA FF 00 CF FF 00 D2 FF 00 D7 FF 00 DA FF 00 DC FF 00 00 00 01 0B' - '00 01 0D 00 01 26 00 01 28 00 01 3A 00 01 3C 00 01 3D 00 01 3F 00 01 4D 00 01 50 00 01 5D 00 01' - '80 00 01 FA 00 01 80 02 01 9C 02 01 A0 02 01 D0 02 01 00 03 01 1F 03 01 2D 03 01 40 03 01 42 03' - '01 49 03 01 50 03 01 75 03 01 80 03 01 9D 03 01 A0 03 01 C3 03 01 C8 03 01 CF 03 01 50 04 01 9D' - '04 01 00 05 01 27 05 01 30 05 01 63 05 01 00 06 01 36 07 01 40 07 01 55 07 01 60 07 01 67 07 01' - '00 08 01 05 08 01 08 08 01 08 08 01 0A 08 01 35 08 01 37 08 01 38 08 01 3C 08 01 3C 08 01 3F 08' - '01 55 08 01 60 08 01 76 08 01 80 08 01 9E 08 01 E0 08 01 F2 08 01 F4 08 01 F5 08 01 00 09 01 15' - '09 01 20 09 01 39 09 01 80 09 01 B7 09 01 BE 09 01 BF 09 01 00 0A 01 00 0A 01 10 0A 01 13 0A 01' - '15 0A 01 17 0A 01 19 0A 01 35 0A 01 60 0A 01 7C 0A 01 80 0A 01 9C 0A 01 C0 0A 01 C7 0A 01 C9 0A' - '01 E4 0A 01 00 0B 01 35 0B 01 40 0B 01 55 0B 01 60 0B 01 72 0B 01 80 0B 01 91 0B 01 00 0C 01 48' - '0C 01 00 0D 01 23 0D 01 80 0E 01 A9 0E 01 B0 0E 01 B1 0E 01 00 0F 01 1C 0F 01 27 0F 01 27 0F 01' - '30 0F 01 45 0F 01 B0 0F 01 C4 0F 01 E0 0F 01 F6 0F 01 03 10 01 37 10 01 83 10 01 AF 10 01 D0 10' - '01 E8 10 01 03 11 01 26 11 01 44 11 01 44 11 01 47 11 01 47 11 01 50 11 01 72 11 01 76 11 01 76' - '11 01 83 11 01 B2 11 01 C1 11 01 C4 11 01 DA 11 01 DA 11 01 DC 11 01 DC 11 01 00 12 01 11 12 01' - '13 12 01 2B 12 01 80 12 01 86 12 01 88 12 01 88 12 01 8A 12 01 8D 12 01 8F 12 01 9D 12 01 9F 12' - '01 A8 12 01 B0 12 01 DE 12 01 05 13 01 0C 13 01 0F 13 01 10 13 01 13 13 01 28 13 01 2A 13 01 30' - '13 01 32 13 01 33 13 01 35 13 01 39 13 01 3D 13 01 3D 13 01 50 13 01 50 13 01 5D 13 01 61 13 01' - '00 14 01 34 14 01 47 14 01 4A 14 01 5F 14 01 61 14 01 80 14 01 AF 14 01 C4 14 01 C5 14 01 C7 14' - '01 C7 14 01 80 15 01 AE 15 01 D8 15 01 DB 15 01 00 16 01 2F 16 01 44 16 01 44 16 01 80 16 01 AA' - '16 01 B8 16 01 B8 16 01 00 17 01 1A 17 01 00 18 01 2B 18 01 FF 18 01 06 19 01 09 19 01 09 19 01' - '0C 19 01 13 19 01 15 19 01 16 19 01 18 19 01 2F 19 01 3F 19 01 3F 19 01 41 19 01 41 19 01 A0 19' - '01 A7 19 01 AA 19 01 D0 19 01 E1 19 01 E1 19 01 E3 19 01 E3 19 01 00 1A 01 00 1A 01 0B 1A 01 32' - '1A 01 3A 1A 01 3A 1A 01 50 1A 01 50 1A 01 5C 1A 01 89 1A 01 9D 1A 01 9D 1A 01 C0 1A 01 F8 1A 01' - '00 1C 01 08 1C 01 0A 1C 01 2E 1C 01 40 1C 01 40 1C 01 72 1C 01 8F 1C 01 00 1D 01 06 1D 01 08 1D' - '01 09 1D 01 0B 1D 01 30 1D 01 46 1D 01 46 1D 01 60 1D 01 65 1D 01 67 1D 01 68 1D 01 6A 1D 01 89' - '1D 01 98 1D 01 98 1D 01 E0 1E 01 F2 1E 01 B0 1F 01 B0 1F 01 00 20 01 99 23 01 80 24 01 43 25 01' - '00 30 01 2E 34 01 00 44 01 46 46 01 00 68 01 38 6A 01 40 6A 01 5E 6A 01 D0 6A 01 ED 6A 01 00 6B' - '01 2F 6B 01 63 6B 01 77 6B 01 7D 6B 01 8F 6B 01 00 6F 01 4A 6F 01 50 6F 01 50 6F 01 00 70 01 F7' - '87 01 00 88 01 D5 8C 01 00 8D 01 08 8D 01 00 B0 01 1E B1 01 50 B1 01 52 B1 01 64 B1 01 67 B1 01' - '70 B1 01 FB B2 01 00 BC 01 6A BC 01 70 BC 01 7C BC 01 80 BC 01 88 BC 01 90 BC 01 99 BC 01 00 E1' - '01 2C E1 01 4E E1 01 4E E1 01 C0 E2 01 EB E2 01 00 E8 01 C4 E8 01 00 EE 01 03 EE 01 05 EE 01 1F' - 'EE 01 21 EE 01 22 EE 01 24 EE 01 24 EE 01 27 EE 01 27 EE 01 29 EE 01 32 EE 01 34 EE 01 37 EE 01' - '39 EE 01 39 EE 01 3B EE 01 3B EE 01 42 EE 01 42 EE 01 47 EE 01 47 EE 01 49 EE 01 49 EE 01 4B EE' - '01 4B EE 01 4D EE 01 4F EE 01 51 EE 01 52 EE 01 54 EE 01 54 EE 01 57 EE 01 57 EE 01 59 EE 01 59' - 'EE 01 5B EE 01 5B EE 01 5D EE 01 5D EE 01 5F EE 01 5F EE 01 61 EE 01 62 EE 01 64 EE 01 64 EE 01' - '67 EE 01 6A EE 01 6C EE 01 72 EE 01 74 EE 01 77 EE 01 79 EE 01 7C EE 01 7E EE 01 7E EE 01 80 EE' - '01 89 EE 01 8B EE 01 9B EE 01 A1 EE 01 A3 EE 01 A5 EE 01 A9 EE 01 AB EE 01 BB EE 01 00 00 02 DD' - 'A6 02 00 A7 02 34 B7 02 40 B7 02 1D B8 02 20 B8 02 A1 CE 02 B0 CE 02 E0 EB 02 00 F8 02 1D FA 02' - '00 00 03 4A 13 03 13 06 00 00 00 5F 00 00 5F 00 00 3F 20 00 40 20 00 54 20 00 54 20 00 33 FE 00' - '34 FE 00 4D FE 00 4F FE 00 3F FF 00 3F FF 00 14 16 00 00 00 2D 00 00 2D 00 00 8A 05 00 8A 05 00' - 'BE 05 00 BE 05 00 00 14 00 00 14 00 06 18 00 06 18 00 10 20 00 15 20 00 53 20 00 53 20 00 7B 20' - '00 7B 20 00 8B 20 00 8B 20 00 12 22 00 12 22 00 17 2E 00 17 2E 00 1A 2E 00 1A 2E 00 3A 2E 00 3B' - '2E 00 40 2E 00 40 2E 00 1C 30 00 1C 30 00 30 30 00 30 30 00 A0 30 00 A0 30 00 31 FE 00 32 FE 00' - '58 FE 00 58 FE 00 63 FE 00 63 FE 00 0D FF 00 0D FF 00 AD 0E 01 AD 0E 01 15 4B 00 00 00 28 00 00' - '28 00 00 5B 00 00 5B 00 00 7B 00 00 7B 00 00 3A 0F 00 3A 0F 00 3C 0F 00 3C 0F 00 9B 16 00 9B 16' - '00 1A 20 00 1A 20 00 1E 20 00 1E 20 00 45 20 00 45 20 00 7D 20 00 7D 20 00 8D 20 00 8D 20 00 08' - '23 00 08 23 00 0A 23 00 0A 23 00 29 23 00 29 23 00 68 27 00 68 27 00 6A 27 00 6A 27 00 6C 27 00' - '6C 27 00 6E 27 00 6E 27 00 70 27 00 70 27 00 72 27 00 72 27 00 74 27 00 74 27 00 C5 27 00 C5 27' - '00 E6 27 00 E6 27 00 E8 27 00 E8 27 00 EA 27 00 EA 27 00 EC 27 00 EC 27 00 EE 27 00 EE 27 00 83' - '29 00 83 29 00 85 29 00 85 29 00 87 29 00 87 29 00 89 29 00 89 29 00 8B 29 00 8B 29 00 8D 29 00' - '8D 29 00 8F 29 00 8F 29 00 91 29 00 91 29 00 93 29 00 93 29 00 95 29 00 95 29 00 97 29 00 97 29' - '00 D8 29 00 D8 29 00 DA 29 00 DA 29 00 FC 29 00 FC 29 00 22 2E 00 22 2E 00 24 2E 00 24 2E 00 26' - '2E 00 26 2E 00 28 2E 00 28 2E 00 42 2E 00 42 2E 00 08 30 00 08 30 00 0A 30 00 0A 30 00 0C 30 00' - '0C 30 00 0E 30 00 0E 30 00 10 30 00 10 30 00 14 30 00 14 30 00 16 30 00 16 30 00 18 30 00 18 30' - '00 1A 30 00 1A 30 00 1D 30 00 1D 30 00 3F FD 00 3F FD 00 17 FE 00 17 FE 00 35 FE 00 35 FE 00 37' - 'FE 00 37 FE 00 39 FE 00 39 FE 00 3B FE 00 3B FE 00 3D FE 00 3D FE 00 3F FE 00 3F FE 00 41 FE 00' - '41 FE 00 43 FE 00 43 FE 00 47 FE 00 47 FE 00 59 FE 00 59 FE 00 5B FE 00 5B FE 00 5D FE 00 5D FE' - '00 08 FF 00 08 FF 00 3B FF 00 3B FF 00 5B FF 00 5B FF 00 5F FF 00 5F FF 00 62 FF 00 62 FF 00 16' - '48 00 00 00 29 00 00 29 00 00 5D 00 00 5D 00 00 7D 00 00 7D 00 00 3B 0F 00 3B 0F 00 3D 0F 00 3D' - '0F 00 9C 16 00 9C 16 00 46 20 00 46 20 00 7E 20 00 7E 20 00 8E 20 00 8E 20 00 09 23 00 09 23 00' - '0B 23 00 0B 23 00 2A 23 00 2A 23 00 69 27 00 69 27 00 6B 27 00 6B 27 00 6D 27 00 6D 27 00 6F 27' - '00 6F 27 00 71 27 00 71 27 00 73 27 00 73 27 00 75 27 00 75 27 00 C6 27 00 C6 27 00 E7 27 00 E7' - '27 00 E9 27 00 E9 27 00 EB 27 00 EB 27 00 ED 27 00 ED 27 00 EF 27 00 EF 27 00 84 29 00 84 29 00' - '86 29 00 86 29 00 88 29 00 88 29 00 8A 29 00 8A 29 00 8C 29 00 8C 29 00 8E 29 00 8E 29 00 90 29' - '00 90 29 00 92 29 00 92 29 00 94 29 00 94 29 00 96 29 00 96 29 00 98 29 00 98 29 00 D9 29 00 D9' - '29 00 DB 29 00 DB 29 00 FD 29 00 FD 29 00 23 2E 00 23 2E 00 25 2E 00 25 2E 00 27 2E 00 27 2E 00' - '29 2E 00 29 2E 00 09 30 00 09 30 00 0B 30 00 0B 30 00 0D 30 00 0D 30 00 0F 30 00 0F 30 00 11 30' - '00 11 30 00 15 30 00 15 30 00 17 30 00 17 30 00 19 30 00 19 30 00 1B 30 00 1B 30 00 1E 30 00 1F' - '30 00 3E FD 00 3E FD 00 18 FE 00 18 FE 00 36 FE 00 36 FE 00 38 FE 00 38 FE 00 3A FE 00 3A FE 00' - '3C FE 00 3C FE 00 3E FE 00 3E FE 00 40 FE 00 40 FE 00 42 FE 00 42 FE 00 44 FE 00 44 FE 00 48 FE' - '00 48 FE 00 5A FE 00 5A FE 00 5C FE 00 5C FE 00 5E FE 00 5E FE 00 09 FF 00 09 FF 00 3D FF 00 3D' - 'FF 00 5D FF 00 5D FF 00 60 FF 00 60 FF 00 63 FF 00 63 FF 00 17 0B 00 00 00 AB 00 00 AB 00 00 18' - '20 00 18 20 00 1B 20 00 1C 20 00 1F 20 00 1F 20 00 39 20 00 39 20 00 02 2E 00 02 2E 00 04 2E 00' - '04 2E 00 09 2E 00 09 2E 00 0C 2E 00 0C 2E 00 1C 2E 00 1C 2E 00 20 2E 00 20 2E 00 18 0A 00 00 00' - 'BB 00 00 BB 00 00 19 20 00 19 20 00 1D 20 00 1D 20 00 3A 20 00 3A 20 00 03 2E 00 03 2E 00 05 2E' - '00 05 2E 00 0A 2E 00 0A 2E 00 0D 2E 00 0D 2E 00 1D 2E 00 1D 2E 00 21 2E 00 21 2E 00 19 B5 00 00' - '00 21 00 00 23 00 00 25 00 00 27 00 00 2A 00 00 2A 00 00 2C 00 00 2C 00 00 2E 00 00 2F 00 00 3A' - '00 00 3B 00 00 3F 00 00 40 00 00 5C 00 00 5C 00 00 A1 00 00 A1 00 00 A7 00 00 A7 00 00 B6 00 00' - 'B7 00 00 BF 00 00 BF 00 00 7E 03 00 7E 03 00 87 03 00 87 03 00 5A 05 00 5F 05 00 89 05 00 89 05' - '00 C0 05 00 C0 05 00 C3 05 00 C3 05 00 C6 05 00 C6 05 00 F3 05 00 F4 05 00 09 06 00 0A 06 00 0C' - '06 00 0D 06 00 1B 06 00 1B 06 00 1E 06 00 1F 06 00 6A 06 00 6D 06 00 D4 06 00 D4 06 00 00 07 00' - '0D 07 00 F7 07 00 F9 07 00 30 08 00 3E 08 00 5E 08 00 5E 08 00 64 09 00 65 09 00 70 09 00 70 09' - '00 FD 09 00 FD 09 00 76 0A 00 76 0A 00 F0 0A 00 F0 0A 00 77 0C 00 77 0C 00 84 0C 00 84 0C 00 F4' - '0D 00 F4 0D 00 4F 0E 00 4F 0E 00 5A 0E 00 5B 0E 00 04 0F 00 12 0F 00 14 0F 00 14 0F 00 85 0F 00' - '85 0F 00 D0 0F 00 D4 0F 00 D9 0F 00 DA 0F 00 4A 10 00 4F 10 00 FB 10 00 FB 10 00 60 13 00 68 13' - '00 6E 16 00 6E 16 00 EB 16 00 ED 16 00 35 17 00 36 17 00 D4 17 00 D6 17 00 D8 17 00 DA 17 00 00' - '18 00 05 18 00 07 18 00 0A 18 00 44 19 00 45 19 00 1E 1A 00 1F 1A 00 A0 1A 00 A6 1A 00 A8 1A 00' - 'AD 1A 00 5A 1B 00 60 1B 00 FC 1B 00 FF 1B 00 3B 1C 00 3F 1C 00 7E 1C 00 7F 1C 00 C0 1C 00 C7 1C' - '00 D3 1C 00 D3 1C 00 16 20 00 17 20 00 20 20 00 27 20 00 30 20 00 38 20 00 3B 20 00 3E 20 00 41' - '20 00 43 20 00 47 20 00 51 20 00 53 20 00 53 20 00 55 20 00 5E 20 00 F9 2C 00 FC 2C 00 FE 2C 00' - 'FF 2C 00 70 2D 00 70 2D 00 00 2E 00 01 2E 00 06 2E 00 08 2E 00 0B 2E 00 0B 2E 00 0E 2E 00 16 2E' - '00 18 2E 00 19 2E 00 1B 2E 00 1B 2E 00 1E 2E 00 1F 2E 00 2A 2E 00 2E 2E 00 30 2E 00 39 2E 00 3C' - '2E 00 3F 2E 00 41 2E 00 41 2E 00 43 2E 00 4F 2E 00 52 2E 00 52 2E 00 01 30 00 03 30 00 3D 30 00' - '3D 30 00 FB 30 00 FB 30 00 FE A4 00 FF A4 00 0D A6 00 0F A6 00 73 A6 00 73 A6 00 7E A6 00 7E A6' - '00 F2 A6 00 F7 A6 00 74 A8 00 77 A8 00 CE A8 00 CF A8 00 F8 A8 00 FA A8 00 FC A8 00 FC A8 00 2E' - 'A9 00 2F A9 00 5F A9 00 5F A9 00 C1 A9 00 CD A9 00 DE A9 00 DF A9 00 5C AA 00 5F AA 00 DE AA 00' - 'DF AA 00 F0 AA 00 F1 AA 00 EB AB 00 EB AB 00 10 FE 00 16 FE 00 19 FE 00 19 FE 00 30 FE 00 30 FE' - '00 45 FE 00 46 FE 00 49 FE 00 4C FE 00 50 FE 00 52 FE 00 54 FE 00 57 FE 00 5F FE 00 61 FE 00 68' - 'FE 00 68 FE 00 6A FE 00 6B FE 00 01 FF 00 03 FF 00 05 FF 00 07 FF 00 0A FF 00 0A FF 00 0C FF 00' - '0C FF 00 0E FF 00 0F FF 00 1A FF 00 1B FF 00 1F FF 00 20 FF 00 3C FF 00 3C FF 00 61 FF 00 61 FF' - '00 64 FF 00 65 FF 00 00 01 01 02 01 01 9F 03 01 9F 03 01 D0 03 01 D0 03 01 6F 05 01 6F 05 01 57' - '08 01 57 08 01 1F 09 01 1F 09 01 3F 09 01 3F 09 01 50 0A 01 58 0A 01 7F 0A 01 7F 0A 01 F0 0A 01' - 'F6 0A 01 39 0B 01 3F 0B 01 99 0B 01 9C 0B 01 55 0F 01 59 0F 01 47 10 01 4D 10 01 BB 10 01 BC 10' - '01 BE 10 01 C1 10 01 40 11 01 43 11 01 74 11 01 75 11 01 C5 11 01 C8 11 01 CD 11 01 CD 11 01 DB' - '11 01 DB 11 01 DD 11 01 DF 11 01 38 12 01 3D 12 01 A9 12 01 A9 12 01 4B 14 01 4F 14 01 5A 14 01' - '5B 14 01 5D 14 01 5D 14 01 C6 14 01 C6 14 01 C1 15 01 D7 15 01 41 16 01 43 16 01 60 16 01 6C 16' - '01 3C 17 01 3E 17 01 3B 18 01 3B 18 01 44 19 01 46 19 01 E2 19 01 E2 19 01 3F 1A 01 46 1A 01 9A' - '1A 01 9C 1A 01 9E 1A 01 A2 1A 01 41 1C 01 45 1C 01 70 1C 01 71 1C 01 F7 1E 01 F8 1E 01 FF 1F 01' - 'FF 1F 01 70 24 01 74 24 01 6E 6A 01 6F 6A 01 F5 6A 01 F5 6A 01 37 6B 01 3B 6B 01 44 6B 01 44 6B' - '01 97 6E 01 9A 6E 01 E2 6F 01 E2 6F 01 9F BC 01 9F BC 01 87 DA 01 8B DA 01 5E E9 01 5F E9 01 1A' - '40 00 00 00 2B 00 00 2B 00 00 3C 00 00 3E 00 00 7C 00 00 7C 00 00 7E 00 00 7E 00 00 AC 00 00 AC' - '00 00 B1 00 00 B1 00 00 D7 00 00 D7 00 00 F7 00 00 F7 00 00 F6 03 00 F6 03 00 06 06 00 08 06 00' - '44 20 00 44 20 00 52 20 00 52 20 00 7A 20 00 7C 20 00 8A 20 00 8C 20 00 18 21 00 18 21 00 40 21' - '00 44 21 00 4B 21 00 4B 21 00 90 21 00 94 21 00 9A 21 00 9B 21 00 A0 21 00 A0 21 00 A3 21 00 A3' - '21 00 A6 21 00 A6 21 00 AE 21 00 AE 21 00 CE 21 00 CF 21 00 D2 21 00 D2 21 00 D4 21 00 D4 21 00' - 'F4 21 00 FF 22 00 20 23 00 21 23 00 7C 23 00 7C 23 00 9B 23 00 B3 23 00 DC 23 00 E1 23 00 B7 25' - '00 B7 25 00 C1 25 00 C1 25 00 F8 25 00 FF 25 00 6F 26 00 6F 26 00 C0 27 00 C4 27 00 C7 27 00 E5' - '27 00 F0 27 00 FF 27 00 00 29 00 82 29 00 99 29 00 D7 29 00 DC 29 00 FB 29 00 FE 29 00 FF 2A 00' - '30 2B 00 44 2B 00 47 2B 00 4C 2B 00 29 FB 00 29 FB 00 62 FE 00 62 FE 00 64 FE 00 66 FE 00 0B FF' - '00 0B FF 00 1C FF 00 1E FF 00 5C FF 00 5C FF 00 5E FF 00 5E FF 00 E2 FF 00 E2 FF 00 E9 FF 00 EC' - 'FF 00 C1 D6 01 C1 D6 01 DB D6 01 DB D6 01 FB D6 01 FB D6 01 15 D7 01 15 D7 01 35 D7 01 35 D7 01' - '4F D7 01 4F D7 01 6F D7 01 6F D7 01 89 D7 01 89 D7 01 A9 D7 01 A9 D7 01 C3 D7 01 C3 D7 01 F0 EE' - '01 F1 EE 01 1B 15 00 00 00 24 00 00 24 00 00 A2 00 00 A5 00 00 8F 05 00 8F 05 00 0B 06 00 0B 06' - '00 FE 07 00 FF 07 00 F2 09 00 F3 09 00 FB 09 00 FB 09 00 F1 0A 00 F1 0A 00 F9 0B 00 F9 0B 00 3F' - '0E 00 3F 0E 00 DB 17 00 DB 17 00 A0 20 00 BF 20 00 38 A8 00 38 A8 00 FC FD 00 FC FD 00 69 FE 00' - '69 FE 00 04 FF 00 04 FF 00 E0 FF 00 E1 FF 00 E5 FF 00 E6 FF 00 DD 1F 01 E0 1F 01 FF E2 01 FF E2' - '01 B0 EC 01 B0 EC 01 1C 1E 00 00 00 5E 00 00 5E 00 00 60 00 00 60 00 00 A8 00 00 A8 00 00 AF 00' - '00 AF 00 00 B4 00 00 B4 00 00 B8 00 00 B8 00 00 C2 02 00 C5 02 00 D2 02 00 DF 02 00 E5 02 00 EB' - '02 00 ED 02 00 ED 02 00 EF 02 00 FF 02 00 75 03 00 75 03 00 84 03 00 85 03 00 BD 1F 00 BD 1F 00' - 'BF 1F 00 C1 1F 00 CD 1F 00 CF 1F 00 DD 1F 00 DF 1F 00 ED 1F 00 EF 1F 00 FD 1F 00 FE 1F 00 9B 30' - '00 9C 30 00 00 A7 00 16 A7 00 20 A7 00 21 A7 00 89 A7 00 8A A7 00 5B AB 00 5B AB 00 6A AB 00 6B' - 'AB 00 B2 FB 00 C1 FB 00 3E FF 00 3E FF 00 40 FF 00 40 FF 00 E3 FF 00 E3 FF 00 FB F3 01 FF F3 01' - '1D B6 00 00 00 A6 00 00 A6 00 00 A9 00 00 A9 00 00 AE 00 00 AE 00 00 B0 00 00 B0 00 00 82 04 00' - '82 04 00 8D 05 00 8E 05 00 0E 06 00 0F 06 00 DE 06 00 DE 06 00 E9 06 00 E9 06 00 FD 06 00 FE 06' - '00 F6 07 00 F6 07 00 FA 09 00 FA 09 00 70 0B 00 70 0B 00 F3 0B 00 F8 0B 00 FA 0B 00 FA 0B 00 7F' - '0C 00 7F 0C 00 4F 0D 00 4F 0D 00 79 0D 00 79 0D 00 01 0F 00 03 0F 00 13 0F 00 13 0F 00 15 0F 00' - '17 0F 00 1A 0F 00 1F 0F 00 34 0F 00 34 0F 00 36 0F 00 36 0F 00 38 0F 00 38 0F 00 BE 0F 00 C5 0F' - '00 C7 0F 00 CC 0F 00 CE 0F 00 CF 0F 00 D5 0F 00 D8 0F 00 9E 10 00 9F 10 00 90 13 00 99 13 00 6D' - '16 00 6D 16 00 40 19 00 40 19 00 DE 19 00 FF 19 00 61 1B 00 6A 1B 00 74 1B 00 7C 1B 00 00 21 00' - '01 21 00 03 21 00 06 21 00 08 21 00 09 21 00 14 21 00 14 21 00 16 21 00 17 21 00 1E 21 00 23 21' - '00 25 21 00 25 21 00 27 21 00 27 21 00 29 21 00 29 21 00 2E 21 00 2E 21 00 3A 21 00 3B 21 00 4A' - '21 00 4A 21 00 4C 21 00 4D 21 00 4F 21 00 4F 21 00 8A 21 00 8B 21 00 95 21 00 99 21 00 9C 21 00' - '9F 21 00 A1 21 00 A2 21 00 A4 21 00 A5 21 00 A7 21 00 AD 21 00 AF 21 00 CD 21 00 D0 21 00 D1 21' - '00 D3 21 00 D3 21 00 D5 21 00 F3 21 00 00 23 00 07 23 00 0C 23 00 1F 23 00 22 23 00 28 23 00 2B' - '23 00 7B 23 00 7D 23 00 9A 23 00 B4 23 00 DB 23 00 E2 23 00 26 24 00 40 24 00 4A 24 00 9C 24 00' - 'E9 24 00 00 25 00 B6 25 00 B8 25 00 C0 25 00 C2 25 00 F7 25 00 00 26 00 6E 26 00 70 26 00 67 27' - '00 94 27 00 BF 27 00 00 28 00 FF 28 00 00 2B 00 2F 2B 00 45 2B 00 46 2B 00 4D 2B 00 73 2B 00 76' - '2B 00 95 2B 00 97 2B 00 FF 2B 00 E5 2C 00 EA 2C 00 50 2E 00 51 2E 00 80 2E 00 99 2E 00 9B 2E 00' - 'F3 2E 00 00 2F 00 D5 2F 00 F0 2F 00 FB 2F 00 04 30 00 04 30 00 12 30 00 13 30 00 20 30 00 20 30' - '00 36 30 00 37 30 00 3E 30 00 3F 30 00 90 31 00 91 31 00 96 31 00 9F 31 00 C0 31 00 E3 31 00 00' - '32 00 1E 32 00 2A 32 00 47 32 00 50 32 00 50 32 00 60 32 00 7F 32 00 8A 32 00 B0 32 00 C0 32 00' - 'FF 33 00 C0 4D 00 FF 4D 00 90 A4 00 C6 A4 00 28 A8 00 2B A8 00 36 A8 00 37 A8 00 39 A8 00 39 A8' - '00 77 AA 00 79 AA 00 FD FD 00 FD FD 00 E4 FF 00 E4 FF 00 E8 FF 00 E8 FF 00 ED FF 00 EE FF 00 FC' - 'FF 00 FD FF 00 37 01 01 3F 01 01 79 01 01 89 01 01 8C 01 01 8E 01 01 90 01 01 9C 01 01 A0 01 01' - 'A0 01 01 D0 01 01 FC 01 01 77 08 01 78 08 01 C8 0A 01 C8 0A 01 3F 17 01 3F 17 01 D5 1F 01 DC 1F' - '01 E1 1F 01 F1 1F 01 3C 6B 01 3F 6B 01 45 6B 01 45 6B 01 9C BC 01 9C BC 01 00 D0 01 F5 D0 01 00' - 'D1 01 26 D1 01 29 D1 01 64 D1 01 6A D1 01 6C D1 01 83 D1 01 84 D1 01 8C D1 01 A9 D1 01 AE D1 01' - 'E8 D1 01 00 D2 01 41 D2 01 45 D2 01 45 D2 01 00 D3 01 56 D3 01 00 D8 01 FF D9 01 37 DA 01 3A DA' - '01 6D DA 01 74 DA 01 76 DA 01 83 DA 01 85 DA 01 86 DA 01 4F E1 01 4F E1 01 AC EC 01 AC EC 01 2E' - 'ED 01 2E ED 01 00 F0 01 2B F0 01 30 F0 01 93 F0 01 A0 F0 01 AE F0 01 B1 F0 01 BF F0 01 C1 F0 01' - 'CF F0 01 D1 F0 01 F5 F0 01 0D F1 01 AD F1 01 E6 F1 01 02 F2 01 10 F2 01 3B F2 01 40 F2 01 48 F2' - '01 50 F2 01 51 F2 01 60 F2 01 65 F2 01 00 F3 01 FA F3 01 00 F4 01 D7 F6 01 E0 F6 01 EC F6 01 F0' - 'F6 01 FC F6 01 00 F7 01 73 F7 01 80 F7 01 D8 F7 01 E0 F7 01 EB F7 01 00 F8 01 0B F8 01 10 F8 01' - '47 F8 01 50 F8 01 59 F8 01 60 F8 01 87 F8 01 90 F8 01 AD F8 01 B0 F8 01 B1 F8 01 00 F9 01 78 F9' - '01 7A F9 01 CB F9 01 CD F9 01 53 FA 01 60 FA 01 6D FA 01 70 FA 01 74 FA 01 78 FA 01 7A FA 01 80' - 'FA 01 86 FA 01 90 FA 01 A8 FA 01 B0 FA 01 B6 FA 01 C0 FA 01 C2 FA 01 D0 FA 01 D6 FA 01 00 FB 01' - '92 FB 01 94 FB 01 CA FB 01 1E BE 02 00 00 41 00 00 5A 00 00 61 00 00 7A 00 00 AA 00 00 AA 00 00' - 'B5 00 00 B5 00 00 BA 00 00 BA 00 00 C0 00 00 D6 00 00 D8 00 00 F6 00 00 F8 00 00 B8 02 00 BB 02' - '00 C1 02 00 D0 02 00 D1 02 00 E0 02 00 E4 02 00 EE 02 00 EE 02 00 70 03 00 73 03 00 76 03 00 77' - '03 00 7A 03 00 7D 03 00 7F 03 00 7F 03 00 86 03 00 86 03 00 88 03 00 8A 03 00 8C 03 00 8C 03 00' - '8E 03 00 A1 03 00 A3 03 00 F5 03 00 F7 03 00 82 04 00 8A 04 00 2F 05 00 31 05 00 56 05 00 59 05' - '00 89 05 00 03 09 00 39 09 00 3B 09 00 3B 09 00 3D 09 00 40 09 00 49 09 00 4C 09 00 4E 09 00 50' - '09 00 58 09 00 61 09 00 64 09 00 80 09 00 82 09 00 83 09 00 85 09 00 8C 09 00 8F 09 00 90 09 00' - '93 09 00 A8 09 00 AA 09 00 B0 09 00 B2 09 00 B2 09 00 B6 09 00 B9 09 00 BD 09 00 C0 09 00 C7 09' - '00 C8 09 00 CB 09 00 CC 09 00 CE 09 00 CE 09 00 D7 09 00 D7 09 00 DC 09 00 DD 09 00 DF 09 00 E1' - '09 00 E6 09 00 F1 09 00 F4 09 00 FA 09 00 FC 09 00 FD 09 00 03 0A 00 03 0A 00 05 0A 00 0A 0A 00' - '0F 0A 00 10 0A 00 13 0A 00 28 0A 00 2A 0A 00 30 0A 00 32 0A 00 33 0A 00 35 0A 00 36 0A 00 38 0A' - '00 39 0A 00 3E 0A 00 40 0A 00 59 0A 00 5C 0A 00 5E 0A 00 5E 0A 00 66 0A 00 6F 0A 00 72 0A 00 74' - '0A 00 76 0A 00 76 0A 00 83 0A 00 83 0A 00 85 0A 00 8D 0A 00 8F 0A 00 91 0A 00 93 0A 00 A8 0A 00' - 'AA 0A 00 B0 0A 00 B2 0A 00 B3 0A 00 B5 0A 00 B9 0A 00 BD 0A 00 C0 0A 00 C9 0A 00 C9 0A 00 CB 0A' - '00 CC 0A 00 D0 0A 00 D0 0A 00 E0 0A 00 E1 0A 00 E6 0A 00 F0 0A 00 F9 0A 00 F9 0A 00 02 0B 00 03' - '0B 00 05 0B 00 0C 0B 00 0F 0B 00 10 0B 00 13 0B 00 28 0B 00 2A 0B 00 30 0B 00 32 0B 00 33 0B 00' - '35 0B 00 39 0B 00 3D 0B 00 3E 0B 00 40 0B 00 40 0B 00 47 0B 00 48 0B 00 4B 0B 00 4C 0B 00 57 0B' - '00 57 0B 00 5C 0B 00 5D 0B 00 5F 0B 00 61 0B 00 66 0B 00 77 0B 00 83 0B 00 83 0B 00 85 0B 00 8A' - '0B 00 8E 0B 00 90 0B 00 92 0B 00 95 0B 00 99 0B 00 9A 0B 00 9C 0B 00 9C 0B 00 9E 0B 00 9F 0B 00' - 'A3 0B 00 A4 0B 00 A8 0B 00 AA 0B 00 AE 0B 00 B9 0B 00 BE 0B 00 BF 0B 00 C1 0B 00 C2 0B 00 C6 0B' - '00 C8 0B 00 CA 0B 00 CC 0B 00 D0 0B 00 D0 0B 00 D7 0B 00 D7 0B 00 E6 0B 00 F2 0B 00 01 0C 00 03' - '0C 00 05 0C 00 0C 0C 00 0E 0C 00 10 0C 00 12 0C 00 28 0C 00 2A 0C 00 39 0C 00 3D 0C 00 3D 0C 00' - '41 0C 00 44 0C 00 58 0C 00 5A 0C 00 60 0C 00 61 0C 00 66 0C 00 6F 0C 00 77 0C 00 77 0C 00 7F 0C' - '00 80 0C 00 82 0C 00 8C 0C 00 8E 0C 00 90 0C 00 92 0C 00 A8 0C 00 AA 0C 00 B3 0C 00 B5 0C 00 B9' - '0C 00 BD 0C 00 C4 0C 00 C6 0C 00 C8 0C 00 CA 0C 00 CB 0C 00 D5 0C 00 D6 0C 00 DE 0C 00 DE 0C 00' - 'E0 0C 00 E1 0C 00 E6 0C 00 EF 0C 00 F1 0C 00 F2 0C 00 02 0D 00 0C 0D 00 0E 0D 00 10 0D 00 12 0D' - '00 3A 0D 00 3D 0D 00 40 0D 00 46 0D 00 48 0D 00 4A 0D 00 4C 0D 00 4E 0D 00 4F 0D 00 54 0D 00 61' - '0D 00 66 0D 00 7F 0D 00 82 0D 00 83 0D 00 85 0D 00 96 0D 00 9A 0D 00 B1 0D 00 B3 0D 00 BB 0D 00' - 'BD 0D 00 BD 0D 00 C0 0D 00 C6 0D 00 CF 0D 00 D1 0D 00 D8 0D 00 DF 0D 00 E6 0D 00 EF 0D 00 F2 0D' - '00 F4 0D 00 01 0E 00 30 0E 00 32 0E 00 33 0E 00 40 0E 00 46 0E 00 4F 0E 00 5B 0E 00 81 0E 00 82' - '0E 00 84 0E 00 84 0E 00 86 0E 00 8A 0E 00 8C 0E 00 A3 0E 00 A5 0E 00 A5 0E 00 A7 0E 00 B0 0E 00' - 'B2 0E 00 B3 0E 00 BD 0E 00 BD 0E 00 C0 0E 00 C4 0E 00 C6 0E 00 C6 0E 00 D0 0E 00 D9 0E 00 DC 0E' - '00 DF 0E 00 00 0F 00 17 0F 00 1A 0F 00 34 0F 00 36 0F 00 36 0F 00 38 0F 00 38 0F 00 3E 0F 00 47' - '0F 00 49 0F 00 6C 0F 00 7F 0F 00 7F 0F 00 85 0F 00 85 0F 00 88 0F 00 8C 0F 00 BE 0F 00 C5 0F 00' - 'C7 0F 00 CC 0F 00 CE 0F 00 DA 0F 00 00 10 00 2C 10 00 31 10 00 31 10 00 38 10 00 38 10 00 3B 10' - '00 3C 10 00 3F 10 00 57 10 00 5A 10 00 5D 10 00 61 10 00 70 10 00 75 10 00 81 10 00 83 10 00 84' - '10 00 87 10 00 8C 10 00 8E 10 00 9C 10 00 9E 10 00 C5 10 00 C7 10 00 C7 10 00 CD 10 00 CD 10 00' - 'D0 10 00 48 12 00 4A 12 00 4D 12 00 50 12 00 56 12 00 58 12 00 58 12 00 5A 12 00 5D 12 00 60 12' - '00 88 12 00 8A 12 00 8D 12 00 90 12 00 B0 12 00 B2 12 00 B5 12 00 B8 12 00 BE 12 00 C0 12 00 C0' - '12 00 C2 12 00 C5 12 00 C8 12 00 D6 12 00 D8 12 00 10 13 00 12 13 00 15 13 00 18 13 00 5A 13 00' - '60 13 00 7C 13 00 80 13 00 8F 13 00 A0 13 00 F5 13 00 F8 13 00 FD 13 00 01 14 00 7F 16 00 81 16' - '00 9A 16 00 A0 16 00 F8 16 00 00 17 00 0C 17 00 0E 17 00 11 17 00 20 17 00 31 17 00 35 17 00 36' - '17 00 40 17 00 51 17 00 60 17 00 6C 17 00 6E 17 00 70 17 00 80 17 00 B3 17 00 B6 17 00 B6 17 00' - 'BE 17 00 C5 17 00 C7 17 00 C8 17 00 D4 17 00 DA 17 00 DC 17 00 DC 17 00 E0 17 00 E9 17 00 10 18' - '00 19 18 00 20 18 00 78 18 00 80 18 00 84 18 00 87 18 00 A8 18 00 AA 18 00 AA 18 00 B0 18 00 F5' - '18 00 00 19 00 1E 19 00 23 19 00 26 19 00 29 19 00 2B 19 00 30 19 00 31 19 00 33 19 00 38 19 00' - '46 19 00 6D 19 00 70 19 00 74 19 00 80 19 00 AB 19 00 B0 19 00 C9 19 00 D0 19 00 DA 19 00 00 1A' - '00 16 1A 00 19 1A 00 1A 1A 00 1E 1A 00 55 1A 00 57 1A 00 57 1A 00 61 1A 00 61 1A 00 63 1A 00 64' - '1A 00 6D 1A 00 72 1A 00 80 1A 00 89 1A 00 90 1A 00 99 1A 00 A0 1A 00 AD 1A 00 04 1B 00 33 1B 00' - '35 1B 00 35 1B 00 3B 1B 00 3B 1B 00 3D 1B 00 41 1B 00 43 1B 00 4B 1B 00 50 1B 00 6A 1B 00 74 1B' - '00 7C 1B 00 82 1B 00 A1 1B 00 A6 1B 00 A7 1B 00 AA 1B 00 AA 1B 00 AE 1B 00 E5 1B 00 E7 1B 00 E7' - '1B 00 EA 1B 00 EC 1B 00 EE 1B 00 EE 1B 00 F2 1B 00 F3 1B 00 FC 1B 00 2B 1C 00 34 1C 00 35 1C 00' - '3B 1C 00 49 1C 00 4D 1C 00 88 1C 00 90 1C 00 BA 1C 00 BD 1C 00 C7 1C 00 D3 1C 00 D3 1C 00 E1 1C' - '00 E1 1C 00 E9 1C 00 EC 1C 00 EE 1C 00 F3 1C 00 F5 1C 00 F7 1C 00 FA 1C 00 FA 1C 00 00 1D 00 BF' - '1D 00 00 1E 00 15 1F 00 18 1F 00 1D 1F 00 20 1F 00 45 1F 00 48 1F 00 4D 1F 00 50 1F 00 57 1F 00' - '59 1F 00 59 1F 00 5B 1F 00 5B 1F 00 5D 1F 00 5D 1F 00 5F 1F 00 7D 1F 00 80 1F 00 B4 1F 00 B6 1F' - '00 BC 1F 00 BE 1F 00 BE 1F 00 C2 1F 00 C4 1F 00 C6 1F 00 CC 1F 00 D0 1F 00 D3 1F 00 D6 1F 00 DB' - '1F 00 E0 1F 00 EC 1F 00 F2 1F 00 F4 1F 00 F6 1F 00 FC 1F 00 0E 20 00 0E 20 00 71 20 00 71 20 00' - '7F 20 00 7F 20 00 90 20 00 9C 20 00 02 21 00 02 21 00 07 21 00 07 21 00 0A 21 00 13 21 00 15 21' - '00 15 21 00 19 21 00 1D 21 00 24 21 00 24 21 00 26 21 00 26 21 00 28 21 00 28 21 00 2A 21 00 2D' - '21 00 2F 21 00 39 21 00 3C 21 00 3F 21 00 45 21 00 49 21 00 4E 21 00 4F 21 00 60 21 00 88 21 00' - '36 23 00 7A 23 00 95 23 00 95 23 00 9C 24 00 E9 24 00 AC 26 00 AC 26 00 00 28 00 FF 28 00 00 2C' - '00 2E 2C 00 30 2C 00 5E 2C 00 60 2C 00 E4 2C 00 EB 2C 00 EE 2C 00 F2 2C 00 F3 2C 00 00 2D 00 25' - '2D 00 27 2D 00 27 2D 00 2D 2D 00 2D 2D 00 30 2D 00 67 2D 00 6F 2D 00 70 2D 00 80 2D 00 96 2D 00' - 'A0 2D 00 A6 2D 00 A8 2D 00 AE 2D 00 B0 2D 00 B6 2D 00 B8 2D 00 BE 2D 00 C0 2D 00 C6 2D 00 C8 2D' - '00 CE 2D 00 D0 2D 00 D6 2D 00 D8 2D 00 DE 2D 00 05 30 00 07 30 00 21 30 00 29 30 00 2E 30 00 2F' - '30 00 31 30 00 35 30 00 38 30 00 3C 30 00 41 30 00 96 30 00 9D 30 00 9F 30 00 A1 30 00 FA 30 00' - 'FC 30 00 FF 30 00 05 31 00 2F 31 00 31 31 00 8E 31 00 90 31 00 BF 31 00 F0 31 00 1C 32 00 20 32' - '00 4F 32 00 60 32 00 7B 32 00 7F 32 00 B0 32 00 C0 32 00 CB 32 00 D0 32 00 76 33 00 7B 33 00 DD' - '33 00 E0 33 00 FE 33 00 00 34 00 BF 4D 00 00 4E 00 FC 9F 00 00 A0 00 8C A4 00 D0 A4 00 0C A6 00' - '10 A6 00 2B A6 00 40 A6 00 6E A6 00 80 A6 00 9D A6 00 A0 A6 00 EF A6 00 F2 A6 00 F7 A6 00 22 A7' - '00 87 A7 00 89 A7 00 BF A7 00 C2 A7 00 CA A7 00 F5 A7 00 01 A8 00 03 A8 00 05 A8 00 07 A8 00 0A' - 'A8 00 0C A8 00 24 A8 00 27 A8 00 27 A8 00 30 A8 00 37 A8 00 40 A8 00 73 A8 00 80 A8 00 C3 A8 00' - 'CE A8 00 D9 A8 00 F2 A8 00 FE A8 00 00 A9 00 25 A9 00 2E A9 00 46 A9 00 52 A9 00 53 A9 00 5F A9' - '00 7C A9 00 83 A9 00 B2 A9 00 B4 A9 00 B5 A9 00 BA A9 00 BB A9 00 BE A9 00 CD A9 00 CF A9 00 D9' - 'A9 00 DE A9 00 E4 A9 00 E6 A9 00 FE A9 00 00 AA 00 28 AA 00 2F AA 00 30 AA 00 33 AA 00 34 AA 00' - '40 AA 00 42 AA 00 44 AA 00 4B AA 00 4D AA 00 4D AA 00 50 AA 00 59 AA 00 5C AA 00 7B AA 00 7D AA' - '00 AF AA 00 B1 AA 00 B1 AA 00 B5 AA 00 B6 AA 00 B9 AA 00 BD AA 00 C0 AA 00 C0 AA 00 C2 AA 00 C2' - 'AA 00 DB AA 00 EB AA 00 EE AA 00 F5 AA 00 01 AB 00 06 AB 00 09 AB 00 0E AB 00 11 AB 00 16 AB 00' - '20 AB 00 26 AB 00 28 AB 00 2E AB 00 30 AB 00 69 AB 00 70 AB 00 E4 AB 00 E6 AB 00 E7 AB 00 E9 AB' - '00 EC AB 00 F0 AB 00 F9 AB 00 00 AC 00 A3 D7 00 B0 D7 00 C6 D7 00 CB D7 00 FB D7 00 00 D8 00 6D' - 'FA 00 70 FA 00 D9 FA 00 00 FB 00 06 FB 00 13 FB 00 17 FB 00 21 FF 00 3A FF 00 41 FF 00 5A FF 00' - '66 FF 00 BE FF 00 C2 FF 00 C7 FF 00 CA FF 00 CF FF 00 D2 FF 00 D7 FF 00 DA FF 00 DC FF 00 00 00' - '01 0B 00 01 0D 00 01 26 00 01 28 00 01 3A 00 01 3C 00 01 3D 00 01 3F 00 01 4D 00 01 50 00 01 5D' - '00 01 80 00 01 FA 00 01 00 01 01 00 01 01 02 01 01 02 01 01 07 01 01 33 01 01 37 01 01 3F 01 01' - '8D 01 01 8E 01 01 D0 01 01 FC 01 01 80 02 01 9C 02 01 A0 02 01 D0 02 01 00 03 01 23 03 01 2D 03' - '01 4A 03 01 50 03 01 75 03 01 80 03 01 9D 03 01 9F 03 01 C3 03 01 C8 03 01 D5 03 01 00 04 01 9D' - '04 01 A0 04 01 A9 04 01 B0 04 01 D3 04 01 D8 04 01 FB 04 01 00 05 01 27 05 01 30 05 01 63 05 01' - '6F 05 01 6F 05 01 00 06 01 36 07 01 40 07 01 55 07 01 60 07 01 67 07 01 00 10 01 00 10 01 02 10' - '01 37 10 01 47 10 01 4D 10 01 66 10 01 6F 10 01 82 10 01 B2 10 01 B7 10 01 B8 10 01 BB 10 01 C1' - '10 01 CD 10 01 CD 10 01 D0 10 01 E8 10 01 F0 10 01 F9 10 01 03 11 01 26 11 01 2C 11 01 2C 11 01' - '36 11 01 47 11 01 50 11 01 72 11 01 74 11 01 76 11 01 82 11 01 B5 11 01 BF 11 01 C8 11 01 CD 11' - '01 CE 11 01 D0 11 01 DF 11 01 E1 11 01 F4 11 01 00 12 01 11 12 01 13 12 01 2E 12 01 32 12 01 33' - '12 01 35 12 01 35 12 01 38 12 01 3D 12 01 80 12 01 86 12 01 88 12 01 88 12 01 8A 12 01 8D 12 01' - '8F 12 01 9D 12 01 9F 12 01 A9 12 01 B0 12 01 DE 12 01 E0 12 01 E2 12 01 F0 12 01 F9 12 01 02 13' - '01 03 13 01 05 13 01 0C 13 01 0F 13 01 10 13 01 13 13 01 28 13 01 2A 13 01 30 13 01 32 13 01 33' - '13 01 35 13 01 39 13 01 3D 13 01 3F 13 01 41 13 01 44 13 01 47 13 01 48 13 01 4B 13 01 4D 13 01' - '50 13 01 50 13 01 57 13 01 57 13 01 5D 13 01 63 13 01 00 14 01 37 14 01 40 14 01 41 14 01 45 14' - '01 45 14 01 47 14 01 5B 14 01 5D 14 01 5D 14 01 5F 14 01 61 14 01 80 14 01 B2 14 01 B9 14 01 B9' - '14 01 BB 14 01 BE 14 01 C1 14 01 C1 14 01 C4 14 01 C7 14 01 D0 14 01 D9 14 01 80 15 01 B1 15 01' - 'B8 15 01 BB 15 01 BE 15 01 BE 15 01 C1 15 01 DB 15 01 00 16 01 32 16 01 3B 16 01 3C 16 01 3E 16' - '01 3E 16 01 41 16 01 44 16 01 50 16 01 59 16 01 80 16 01 AA 16 01 AC 16 01 AC 16 01 AE 16 01 AF' - '16 01 B6 16 01 B6 16 01 B8 16 01 B8 16 01 C0 16 01 C9 16 01 00 17 01 1A 17 01 20 17 01 21 17 01' - '26 17 01 26 17 01 30 17 01 3F 17 01 00 18 01 2E 18 01 38 18 01 38 18 01 3B 18 01 3B 18 01 A0 18' - '01 F2 18 01 FF 18 01 06 19 01 09 19 01 09 19 01 0C 19 01 13 19 01 15 19 01 16 19 01 18 19 01 35' - '19 01 37 19 01 38 19 01 3D 19 01 3D 19 01 3F 19 01 42 19 01 44 19 01 46 19 01 50 19 01 59 19 01' - 'A0 19 01 A7 19 01 AA 19 01 D3 19 01 DC 19 01 DF 19 01 E1 19 01 E4 19 01 00 1A 01 00 1A 01 07 1A' - '01 08 1A 01 0B 1A 01 32 1A 01 39 1A 01 3A 1A 01 3F 1A 01 46 1A 01 50 1A 01 50 1A 01 57 1A 01 58' - '1A 01 5C 1A 01 89 1A 01 97 1A 01 97 1A 01 9A 1A 01 A2 1A 01 C0 1A 01 F8 1A 01 00 1C 01 08 1C 01' - '0A 1C 01 2F 1C 01 3E 1C 01 45 1C 01 50 1C 01 6C 1C 01 70 1C 01 8F 1C 01 A9 1C 01 A9 1C 01 B1 1C' - '01 B1 1C 01 B4 1C 01 B4 1C 01 00 1D 01 06 1D 01 08 1D 01 09 1D 01 0B 1D 01 30 1D 01 46 1D 01 46' - '1D 01 50 1D 01 59 1D 01 60 1D 01 65 1D 01 67 1D 01 68 1D 01 6A 1D 01 8E 1D 01 93 1D 01 94 1D 01' - '96 1D 01 96 1D 01 98 1D 01 98 1D 01 A0 1D 01 A9 1D 01 E0 1E 01 F2 1E 01 F5 1E 01 F8 1E 01 B0 1F' - '01 B0 1F 01 C0 1F 01 D4 1F 01 FF 1F 01 99 23 01 00 24 01 6E 24 01 70 24 01 74 24 01 80 24 01 43' - '25 01 00 30 01 2E 34 01 30 34 01 38 34 01 00 44 01 46 46 01 00 68 01 38 6A 01 40 6A 01 5E 6A 01' - '60 6A 01 69 6A 01 6E 6A 01 6F 6A 01 D0 6A 01 ED 6A 01 F5 6A 01 F5 6A 01 00 6B 01 2F 6B 01 37 6B' - '01 45 6B 01 50 6B 01 59 6B 01 5B 6B 01 61 6B 01 63 6B 01 77 6B 01 7D 6B 01 8F 6B 01 40 6E 01 9A' - '6E 01 00 6F 01 4A 6F 01 50 6F 01 87 6F 01 93 6F 01 9F 6F 01 E0 6F 01 E1 6F 01 E3 6F 01 E3 6F 01' - 'F0 6F 01 F1 6F 01 00 70 01 F7 87 01 00 88 01 D5 8C 01 00 8D 01 08 8D 01 00 B0 01 1E B1 01 50 B1' - '01 52 B1 01 64 B1 01 67 B1 01 70 B1 01 FB B2 01 00 BC 01 6A BC 01 70 BC 01 7C BC 01 80 BC 01 88' - 'BC 01 90 BC 01 99 BC 01 9C BC 01 9C BC 01 9F BC 01 9F BC 01 00 D0 01 F5 D0 01 00 D1 01 26 D1 01' - '29 D1 01 66 D1 01 6A D1 01 72 D1 01 83 D1 01 84 D1 01 8C D1 01 A9 D1 01 AE D1 01 E8 D1 01 E0 D2' - '01 F3 D2 01 60 D3 01 78 D3 01 00 D4 01 54 D4 01 56 D4 01 9C D4 01 9E D4 01 9F D4 01 A2 D4 01 A2' - 'D4 01 A5 D4 01 A6 D4 01 A9 D4 01 AC D4 01 AE D4 01 B9 D4 01 BB D4 01 BB D4 01 BD D4 01 C3 D4 01' - 'C5 D4 01 05 D5 01 07 D5 01 0A D5 01 0D D5 01 14 D5 01 16 D5 01 1C D5 01 1E D5 01 39 D5 01 3B D5' - '01 3E D5 01 40 D5 01 44 D5 01 46 D5 01 46 D5 01 4A D5 01 50 D5 01 52 D5 01 A5 D6 01 A8 D6 01 DA' - 'D6 01 DC D6 01 14 D7 01 16 D7 01 4E D7 01 50 D7 01 88 D7 01 8A D7 01 C2 D7 01 C4 D7 01 CB D7 01' - '00 D8 01 FF D9 01 37 DA 01 3A DA 01 6D DA 01 74 DA 01 76 DA 01 83 DA 01 85 DA 01 8B DA 01 00 E1' - '01 2C E1 01 37 E1 01 3D E1 01 40 E1 01 49 E1 01 4E E1 01 4F E1 01 C0 E2 01 EB E2 01 F0 E2 01 F9' - 'E2 01 10 F1 01 2E F1 01 30 F1 01 69 F1 01 70 F1 01 AC F1 01 E6 F1 01 02 F2 01 10 F2 01 3B F2 01' - '40 F2 01 48 F2 01 50 F2 01 51 F2 01 00 00 02 DD A6 02 00 A7 02 34 B7 02 40 B7 02 1D B8 02 20 B8' - '02 A1 CE 02 B0 CE 02 E0 EB 02 00 F8 02 1D FA 02 00 00 03 4A 13 03 00 00 0F FD FF 0F 00 00 10 FD' - 'FF 10 1F 01 00 00 00 2A 20 00 2A 20 00 20 01 00 00 00 2D 20 00 2D 20 00 21 47 00 00 00 BE 05 00' - 'BE 05 00 C0 05 00 C0 05 00 C3 05 00 C3 05 00 C6 05 00 C6 05 00 D0 05 00 EA 05 00 EF 05 00 F4 05' - '00 C0 07 00 EA 07 00 F4 07 00 F5 07 00 FA 07 00 FA 07 00 FE 07 00 15 08 00 1A 08 00 1A 08 00 24' - '08 00 24 08 00 28 08 00 28 08 00 30 08 00 3E 08 00 40 08 00 58 08 00 5E 08 00 5E 08 00 0F 20 00' - '0F 20 00 1D FB 00 1D FB 00 1F FB 00 28 FB 00 2A FB 00 36 FB 00 38 FB 00 3C FB 00 3E FB 00 3E FB' - '00 40 FB 00 41 FB 00 43 FB 00 44 FB 00 46 FB 00 4F FB 00 00 08 01 05 08 01 08 08 01 08 08 01 0A' - '08 01 35 08 01 37 08 01 38 08 01 3C 08 01 3C 08 01 3F 08 01 55 08 01 57 08 01 9E 08 01 A7 08 01' - 'AF 08 01 E0 08 01 F2 08 01 F4 08 01 F5 08 01 FB 08 01 1B 09 01 20 09 01 39 09 01 3F 09 01 3F 09' - '01 80 09 01 B7 09 01 BC 09 01 CF 09 01 D2 09 01 00 0A 01 10 0A 01 13 0A 01 15 0A 01 17 0A 01 19' - '0A 01 35 0A 01 40 0A 01 48 0A 01 50 0A 01 58 0A 01 60 0A 01 9F 0A 01 C0 0A 01 E4 0A 01 EB 0A 01' - 'F6 0A 01 00 0B 01 35 0B 01 40 0B 01 55 0B 01 58 0B 01 72 0B 01 78 0B 01 91 0B 01 99 0B 01 9C 0B' - '01 A9 0B 01 AF 0B 01 00 0C 01 48 0C 01 80 0C 01 B2 0C 01 C0 0C 01 F2 0C 01 FA 0C 01 FF 0C 01 80' - '0E 01 A9 0E 01 AD 0E 01 AD 0E 01 B0 0E 01 B1 0E 01 00 0F 01 27 0F 01 B0 0F 01 CB 0F 01 E0 0F 01' - 'F6 0F 01 00 E8 01 C4 E8 01 C7 E8 01 CF E8 01 00 E9 01 43 E9 01 4B E9 01 4B E9 01 50 E9 01 59 E9' - '01 5E E9 01 5F E9 01 22 3E 00 00 00 08 06 00 08 06 00 0B 06 00 0B 06 00 0D 06 00 0D 06 00 1B 06' - '00 1C 06 00 1E 06 00 4A 06 00 6D 06 00 6F 06 00 71 06 00 D5 06 00 E5 06 00 E6 06 00 EE 06 00 EF' - '06 00 FA 06 00 0D 07 00 0F 07 00 10 07 00 12 07 00 2F 07 00 4D 07 00 A5 07 00 B1 07 00 B1 07 00' - '60 08 00 6A 08 00 A0 08 00 B4 08 00 B6 08 00 C7 08 00 50 FB 00 C1 FB 00 D3 FB 00 3D FD 00 50 FD' - '00 8F FD 00 92 FD 00 C7 FD 00 F0 FD 00 FC FD 00 70 FE 00 74 FE 00 76 FE 00 FC FE 00 00 0D 01 23' - '0D 01 30 0F 01 45 0F 01 51 0F 01 59 0F 01 71 EC 01 B4 EC 01 01 ED 01 3D ED 01 00 EE 01 03 EE 01' - '05 EE 01 1F EE 01 21 EE 01 22 EE 01 24 EE 01 24 EE 01 27 EE 01 27 EE 01 29 EE 01 32 EE 01 34 EE' - '01 37 EE 01 39 EE 01 39 EE 01 3B EE 01 3B EE 01 42 EE 01 42 EE 01 47 EE 01 47 EE 01 49 EE 01 49' - 'EE 01 4B EE 01 4B EE 01 4D EE 01 4F EE 01 51 EE 01 52 EE 01 54 EE 01 54 EE 01 57 EE 01 57 EE 01' - '59 EE 01 59 EE 01 5B EE 01 5B EE 01 5D EE 01 5D EE 01 5F EE 01 5F EE 01 61 EE 01 62 EE 01 64 EE' - '01 64 EE 01 67 EE 01 6A EE 01 6C EE 01 72 EE 01 74 EE 01 77 EE 01 79 EE 01 7C EE 01 7E EE 01 7E' - 'EE 01 80 EE 01 89 EE 01 8B EE 01 9B EE 01 A1 EE 01 A3 EE 01 A5 EE 01 A9 EE 01 AB EE 01 BB EE 01' - '23 01 00 00 00 2B 20 00 2B 20 00 24 01 00 00 00 2E 20 00 2E 20 00 25 01 00 00 00 2C 20 00 2C 20' - '00 26 0D 00 00 00 30 00 00 39 00 00 B2 00 00 B3 00 00 B9 00 00 B9 00 00 F0 06 00 F9 06 00 70 20' - '00 70 20 00 74 20 00 79 20 00 80 20 00 89 20 00 88 24 00 9B 24 00 10 FF 00 19 FF 00 E1 02 01 FB' - '02 01 CE D7 01 FF D7 01 00 F1 01 0A F1 01 F0 FB 01 F9 FB 01 27 09 00 00 00 2B 00 00 2B 00 00 2D' - '00 00 2D 00 00 7A 20 00 7B 20 00 8A 20 00 8B 20 00 12 22 00 12 22 00 29 FB 00 29 FB 00 62 FE 00' - '63 FE 00 0B FF 00 0B FF 00 0D FF 00 0D FF 00 28 18 00 00 00 23 00 00 25 00 00 A2 00 00 A5 00 00' - 'B0 00 00 B1 00 00 8F 05 00 8F 05 00 09 06 00 0A 06 00 6A 06 00 6A 06 00 F2 09 00 F3 09 00 FB 09' - '00 FB 09 00 F1 0A 00 F1 0A 00 F9 0B 00 F9 0B 00 3F 0E 00 3F 0E 00 DB 17 00 DB 17 00 30 20 00 34' - '20 00 A0 20 00 BF 20 00 2E 21 00 2E 21 00 13 22 00 13 22 00 38 A8 00 39 A8 00 5F FE 00 5F FE 00' - '69 FE 00 6A FE 00 03 FF 00 05 FF 00 E0 FF 00 E1 FF 00 E5 FF 00 E6 FF 00 DD 1F 01 E0 1F 01 FF E2' - '01 FF E2 01 29 07 00 00 00 00 06 00 05 06 00 60 06 00 69 06 00 6B 06 00 6C 06 00 DD 06 00 DD 06' - '00 E2 08 00 E2 08 00 30 0D 01 39 0D 01 60 0E 01 7E 0E 01 2A 0D 00 00 00 2C 00 00 2C 00 00 2E 00' - '00 2F 00 00 3A 00 00 3A 00 00 A0 00 00 A0 00 00 0C 06 00 0C 06 00 2F 20 00 2F 20 00 44 20 00 44' - '20 00 50 FE 00 50 FE 00 52 FE 00 52 FE 00 55 FE 00 55 FE 00 0C FF 00 0C FF 00 0E FF 00 0F FF 00' - '1A FF 00 1A FF 00 2B 0E 00 00 00 00 00 00 08 00 00 0E 00 00 1B 00 00 7F 00 00 84 00 00 86 00 00' - '9F 00 00 AD 00 00 AD 00 00 0E 18 00 0E 18 00 0B 20 00 0D 20 00 60 20 00 64 20 00 6A 20 00 6F 20' - '00 FF FE 00 FF FE 00 A0 BC 01 A3 BC 01 73 D1 01 7A D1 01 01 00 0E 01 00 0E 20 00 0E 7F 00 0E 2C' - '03 00 00 00 09 00 00 09 00 00 0B 00 00 0B 00 00 1F 00 00 1F 00 00 2D 0A 00 00 00 09 00 00 0D 00' - '00 20 00 00 20 00 00 85 00 00 85 00 00 A0 00 00 A0 00 00 80 16 00 80 16 00 00 20 00 0A 20 00 28' - '20 00 29 20 00 2F 20 00 2F 20 00 5F 20 00 5F 20 00 00 30 00 00 30 00 2E BC 00 00 00 21 00 00 22' - '00 00 26 00 00 2A 00 00 3B 00 00 40 00 00 5B 00 00 60 00 00 7B 00 00 7E 00 00 A1 00 00 A1 00 00' - 'A6 00 00 A9 00 00 AB 00 00 AC 00 00 AE 00 00 AF 00 00 B4 00 00 B4 00 00 B6 00 00 B8 00 00 BB 00' - '00 BF 00 00 D7 00 00 D7 00 00 F7 00 00 F7 00 00 B9 02 00 BA 02 00 C2 02 00 CF 02 00 D2 02 00 DF' - '02 00 E5 02 00 ED 02 00 EF 02 00 FF 02 00 74 03 00 75 03 00 7E 03 00 7E 03 00 84 03 00 85 03 00' - '87 03 00 87 03 00 F6 03 00 F6 03 00 8A 05 00 8A 05 00 8D 05 00 8E 05 00 06 06 00 07 06 00 0E 06' - '00 0F 06 00 DE 06 00 DE 06 00 E9 06 00 E9 06 00 F6 07 00 F9 07 00 F3 0B 00 F8 0B 00 FA 0B 00 FA' - '0B 00 78 0C 00 7E 0C 00 3A 0F 00 3D 0F 00 90 13 00 99 13 00 00 14 00 00 14 00 9B 16 00 9C 16 00' - 'F0 17 00 F9 17 00 00 18 00 0A 18 00 40 19 00 40 19 00 44 19 00 45 19 00 DE 19 00 FF 19 00 BD 1F' - '00 BD 1F 00 BF 1F 00 C1 1F 00 CD 1F 00 CF 1F 00 DD 1F 00 DF 1F 00 ED 1F 00 EF 1F 00 FD 1F 00 FE' - '1F 00 10 20 00 27 20 00 35 20 00 43 20 00 45 20 00 5E 20 00 7C 20 00 7E 20 00 8C 20 00 8E 20 00' - '00 21 00 01 21 00 03 21 00 06 21 00 08 21 00 09 21 00 14 21 00 14 21 00 16 21 00 18 21 00 1E 21' - '00 23 21 00 25 21 00 25 21 00 27 21 00 27 21 00 29 21 00 29 21 00 3A 21 00 3B 21 00 40 21 00 44' - '21 00 4A 21 00 4D 21 00 50 21 00 5F 21 00 89 21 00 8B 21 00 90 21 00 11 22 00 14 22 00 35 23 00' - '7B 23 00 94 23 00 96 23 00 26 24 00 40 24 00 4A 24 00 60 24 00 87 24 00 EA 24 00 AB 26 00 AD 26' - '00 FF 27 00 00 29 00 73 2B 00 76 2B 00 95 2B 00 97 2B 00 FF 2B 00 E5 2C 00 EA 2C 00 F9 2C 00 FF' - '2C 00 00 2E 00 52 2E 00 80 2E 00 99 2E 00 9B 2E 00 F3 2E 00 00 2F 00 D5 2F 00 F0 2F 00 FB 2F 00' - '01 30 00 04 30 00 08 30 00 20 30 00 30 30 00 30 30 00 36 30 00 37 30 00 3D 30 00 3F 30 00 9B 30' - '00 9C 30 00 A0 30 00 A0 30 00 FB 30 00 FB 30 00 C0 31 00 E3 31 00 1D 32 00 1E 32 00 50 32 00 5F' - '32 00 7C 32 00 7E 32 00 B1 32 00 BF 32 00 CC 32 00 CF 32 00 77 33 00 7A 33 00 DE 33 00 DF 33 00' - 'FF 33 00 FF 33 00 C0 4D 00 FF 4D 00 90 A4 00 C6 A4 00 0D A6 00 0F A6 00 73 A6 00 73 A6 00 7E A6' - '00 7F A6 00 00 A7 00 21 A7 00 88 A7 00 88 A7 00 28 A8 00 2B A8 00 74 A8 00 77 A8 00 6A AB 00 6B' - 'AB 00 3E FD 00 3F FD 00 FD FD 00 FD FD 00 10 FE 00 19 FE 00 30 FE 00 4F FE 00 51 FE 00 51 FE 00' - '54 FE 00 54 FE 00 56 FE 00 5E FE 00 60 FE 00 61 FE 00 64 FE 00 66 FE 00 68 FE 00 68 FE 00 6B FE' - '00 6B FE 00 01 FF 00 02 FF 00 06 FF 00 0A FF 00 1B FF 00 20 FF 00 3B FF 00 40 FF 00 5B FF 00 65' - 'FF 00 E2 FF 00 E4 FF 00 E8 FF 00 EE FF 00 F9 FF 00 FD FF 00 01 01 01 01 01 01 40 01 01 8C 01 01' - '90 01 01 9C 01 01 A0 01 01 A0 01 01 1F 09 01 1F 09 01 39 0B 01 3F 0B 01 52 10 01 65 10 01 60 16' - '01 6C 16 01 D5 1F 01 DC 1F 01 E1 1F 01 F1 1F 01 E2 6F 01 E2 6F 01 00 D2 01 41 D2 01 45 D2 01 45' - 'D2 01 00 D3 01 56 D3 01 DB D6 01 DB D6 01 15 D7 01 15 D7 01 4F D7 01 4F D7 01 89 D7 01 89 D7 01' - 'C3 D7 01 C3 D7 01 F0 EE 01 F1 EE 01 00 F0 01 2B F0 01 30 F0 01 93 F0 01 A0 F0 01 AE F0 01 B1 F0' - '01 BF F0 01 C1 F0 01 CF F0 01 D1 F0 01 F5 F0 01 0B F1 01 0F F1 01 2F F1 01 2F F1 01 6A F1 01 6F' - 'F1 01 AD F1 01 AD F1 01 60 F2 01 65 F2 01 00 F3 01 D7 F6 01 E0 F6 01 EC F6 01 F0 F6 01 FC F6 01' - '00 F7 01 73 F7 01 80 F7 01 D8 F7 01 E0 F7 01 EB F7 01 00 F8 01 0B F8 01 10 F8 01 47 F8 01 50 F8' - '01 59 F8 01 60 F8 01 87 F8 01 90 F8 01 AD F8 01 B0 F8 01 B1 F8 01 00 F9 01 78 F9 01 7A F9 01 CB' - 'F9 01 CD F9 01 53 FA 01 60 FA 01 6D FA 01 70 FA 01 74 FA 01 78 FA 01 7A FA 01 80 FA 01 86 FA 01' - '90 FA 01 A8 FA 01 B0 FA 01 B6 FA 01 C0 FA 01 C2 FA 01 D0 FA 01 D6 FA 01 00 FB 01 92 FB 01 94 FB' - '01 CA FB 01 2F 01 00 00 00 66 20 00 66 20 00 30 01 00 00 00 67 20 00 67 20 00 31 01 00 00 00 68' - '20 00 68 20 00 32 01 00 00 00 69 20 00 69 20 00 33 87 01 00 00 A0 00 00 A0 00 00 A8 00 00 A8 00' - '00 AA 00 00 AA 00 00 AF 00 00 AF 00 00 B2 00 00 B5 00 00 B8 00 00 BA 00 00 BC 00 00 BE 00 00 C0' - '00 00 C5 00 00 C7 00 00 CF 00 00 D1 00 00 D6 00 00 D9 00 00 DD 00 00 E0 00 00 E5 00 00 E7 00 00' - 'EF 00 00 F1 00 00 F6 00 00 F9 00 00 FD 00 00 FF 00 00 0F 01 00 12 01 00 25 01 00 28 01 00 30 01' - '00 32 01 00 37 01 00 39 01 00 40 01 00 43 01 00 49 01 00 4C 01 00 51 01 00 54 01 00 65 01 00 68' - '01 00 7F 01 00 A0 01 00 A1 01 00 AF 01 00 B0 01 00 C4 01 00 DC 01 00 DE 01 00 E3 01 00 E6 01 00' - 'F5 01 00 F8 01 00 1B 02 00 1E 02 00 1F 02 00 26 02 00 33 02 00 B0 02 00 B8 02 00 D8 02 00 DD 02' - '00 E0 02 00 E4 02 00 40 03 00 41 03 00 43 03 00 44 03 00 74 03 00 74 03 00 7A 03 00 7A 03 00 7E' - '03 00 7E 03 00 84 03 00 8A 03 00 8C 03 00 8C 03 00 8E 03 00 90 03 00 AA 03 00 B0 03 00 CA 03 00' - 'CE 03 00 D0 03 00 D6 03 00 F0 03 00 F2 03 00 F4 03 00 F5 03 00 F9 03 00 F9 03 00 00 04 00 01 04' - '00 03 04 00 03 04 00 07 04 00 07 04 00 0C 04 00 0E 04 00 19 04 00 19 04 00 39 04 00 39 04 00 50' - '04 00 51 04 00 53 04 00 53 04 00 57 04 00 57 04 00 5C 04 00 5E 04 00 76 04 00 77 04 00 C1 04 00' - 'C2 04 00 D0 04 00 D3 04 00 D6 04 00 D7 04 00 DA 04 00 DF 04 00 E2 04 00 E7 04 00 EA 04 00 F5 04' - '00 F8 04 00 F9 04 00 87 05 00 87 05 00 22 06 00 26 06 00 75 06 00 78 06 00 C0 06 00 C0 06 00 C2' - '06 00 C2 06 00 D3 06 00 D3 06 00 29 09 00 29 09 00 31 09 00 31 09 00 34 09 00 34 09 00 58 09 00' - '5F 09 00 CB 09 00 CC 09 00 DC 09 00 DD 09 00 DF 09 00 DF 09 00 33 0A 00 33 0A 00 36 0A 00 36 0A' - '00 59 0A 00 5B 0A 00 5E 0A 00 5E 0A 00 48 0B 00 48 0B 00 4B 0B 00 4C 0B 00 5C 0B 00 5D 0B 00 94' - '0B 00 94 0B 00 CA 0B 00 CC 0B 00 48 0C 00 48 0C 00 C0 0C 00 C0 0C 00 C7 0C 00 C8 0C 00 CA 0C 00' - 'CB 0C 00 4A 0D 00 4C 0D 00 DA 0D 00 DA 0D 00 DC 0D 00 DE 0D 00 33 0E 00 33 0E 00 B3 0E 00 B3 0E' - '00 DC 0E 00 DD 0E 00 0C 0F 00 0C 0F 00 43 0F 00 43 0F 00 4D 0F 00 4D 0F 00 52 0F 00 52 0F 00 57' - '0F 00 57 0F 00 5C 0F 00 5C 0F 00 69 0F 00 69 0F 00 73 0F 00 73 0F 00 75 0F 00 79 0F 00 81 0F 00' - '81 0F 00 93 0F 00 93 0F 00 9D 0F 00 9D 0F 00 A2 0F 00 A2 0F 00 A7 0F 00 A7 0F 00 AC 0F 00 AC 0F' - '00 B9 0F 00 B9 0F 00 26 10 00 26 10 00 FC 10 00 FC 10 00 06 1B 00 06 1B 00 08 1B 00 08 1B 00 0A' - '1B 00 0A 1B 00 0C 1B 00 0C 1B 00 0E 1B 00 0E 1B 00 12 1B 00 12 1B 00 3B 1B 00 3B 1B 00 3D 1B 00' - '3D 1B 00 40 1B 00 41 1B 00 43 1B 00 43 1B 00 2C 1D 00 2E 1D 00 30 1D 00 3A 1D 00 3C 1D 00 4D 1D' - '00 4F 1D 00 6A 1D 00 78 1D 00 78 1D 00 9B 1D 00 BF 1D 00 00 1E 00 9B 1E 00 A0 1E 00 F9 1E 00 00' - '1F 00 15 1F 00 18 1F 00 1D 1F 00 20 1F 00 45 1F 00 48 1F 00 4D 1F 00 50 1F 00 57 1F 00 59 1F 00' - '59 1F 00 5B 1F 00 5B 1F 00 5D 1F 00 5D 1F 00 5F 1F 00 7D 1F 00 80 1F 00 B4 1F 00 B6 1F 00 C4 1F' - '00 C6 1F 00 D3 1F 00 D6 1F 00 DB 1F 00 DD 1F 00 EF 1F 00 F2 1F 00 F4 1F 00 F6 1F 00 FE 1F 00 00' - '20 00 0A 20 00 11 20 00 11 20 00 17 20 00 17 20 00 24 20 00 26 20 00 2F 20 00 2F 20 00 33 20 00' - '34 20 00 36 20 00 37 20 00 3C 20 00 3C 20 00 3E 20 00 3E 20 00 47 20 00 49 20 00 57 20 00 57 20' - '00 5F 20 00 5F 20 00 70 20 00 71 20 00 74 20 00 8E 20 00 90 20 00 9C 20 00 A8 20 00 A8 20 00 00' - '21 00 03 21 00 05 21 00 07 21 00 09 21 00 13 21 00 15 21 00 16 21 00 19 21 00 1D 21 00 20 21 00' - '22 21 00 24 21 00 24 21 00 26 21 00 26 21 00 28 21 00 28 21 00 2A 21 00 2D 21 00 2F 21 00 31 21' - '00 33 21 00 39 21 00 3B 21 00 40 21 00 45 21 00 49 21 00 50 21 00 7F 21 00 89 21 00 89 21 00 9A' - '21 00 9B 21 00 AE 21 00 AE 21 00 CD 21 00 CF 21 00 04 22 00 04 22 00 09 22 00 09 22 00 0C 22 00' - '0C 22 00 24 22 00 24 22 00 26 22 00 26 22 00 2C 22 00 2D 22 00 2F 22 00 30 22 00 41 22 00 41 22' - '00 44 22 00 44 22 00 47 22 00 47 22 00 49 22 00 49 22 00 60 22 00 60 22 00 62 22 00 62 22 00 6D' - '22 00 71 22 00 74 22 00 75 22 00 78 22 00 79 22 00 80 22 00 81 22 00 84 22 00 85 22 00 88 22 00' - '89 22 00 AC 22 00 AF 22 00 E0 22 00 E3 22 00 EA 22 00 ED 22 00 29 23 00 2A 23 00 60 24 00 EA 24' - '00 0C 2A 00 0C 2A 00 74 2A 00 76 2A 00 DC 2A 00 DC 2A 00 7C 2C 00 7D 2C 00 6F 2D 00 6F 2D 00 9F' - '2E 00 9F 2E 00 F3 2E 00 F3 2E 00 00 2F 00 D5 2F 00 00 30 00 00 30 00 36 30 00 36 30 00 38 30 00' - '3A 30 00 4C 30 00 4C 30 00 4E 30 00 4E 30 00 50 30 00 50 30 00 52 30 00 52 30 00 54 30 00 54 30' - '00 56 30 00 56 30 00 58 30 00 58 30 00 5A 30 00 5A 30 00 5C 30 00 5C 30 00 5E 30 00 5E 30 00 60' - '30 00 60 30 00 62 30 00 62 30 00 65 30 00 65 30 00 67 30 00 67 30 00 69 30 00 69 30 00 70 30 00' - '71 30 00 73 30 00 74 30 00 76 30 00 77 30 00 79 30 00 7A 30 00 7C 30 00 7D 30 00 94 30 00 94 30' - '00 9B 30 00 9C 30 00 9E 30 00 9F 30 00 AC 30 00 AC 30 00 AE 30 00 AE 30 00 B0 30 00 B0 30 00 B2' - '30 00 B2 30 00 B4 30 00 B4 30 00 B6 30 00 B6 30 00 B8 30 00 B8 30 00 BA 30 00 BA 30 00 BC 30 00' - 'BC 30 00 BE 30 00 BE 30 00 C0 30 00 C0 30 00 C2 30 00 C2 30 00 C5 30 00 C5 30 00 C7 30 00 C7 30' - '00 C9 30 00 C9 30 00 D0 30 00 D1 30 00 D3 30 00 D4 30 00 D6 30 00 D7 30 00 D9 30 00 DA 30 00 DC' - '30 00 DD 30 00 F4 30 00 F4 30 00 F7 30 00 FA 30 00 FE 30 00 FF 30 00 31 31 00 8E 31 00 92 31 00' - '9F 31 00 00 32 00 1E 32 00 20 32 00 47 32 00 50 32 00 7E 32 00 80 32 00 FF 33 00 9C A6 00 9D A6' - '00 70 A7 00 70 A7 00 F8 A7 00 F9 A7 00 5C AB 00 5F AB 00 69 AB 00 69 AB 00 00 F9 00 0D FA 00 10' - 'FA 00 10 FA 00 12 FA 00 12 FA 00 15 FA 00 1E FA 00 20 FA 00 20 FA 00 22 FA 00 22 FA 00 25 FA 00' - '26 FA 00 2A FA 00 6D FA 00 70 FA 00 D9 FA 00 00 FB 00 06 FB 00 13 FB 00 17 FB 00 1D FB 00 1D FB' - '00 1F FB 00 36 FB 00 38 FB 00 3C FB 00 3E FB 00 3E FB 00 40 FB 00 41 FB 00 43 FB 00 44 FB 00 46' - 'FB 00 B1 FB 00 D3 FB 00 3D FD 00 50 FD 00 8F FD 00 92 FD 00 C7 FD 00 F0 FD 00 FC FD 00 10 FE 00' - '19 FE 00 30 FE 00 44 FE 00 47 FE 00 52 FE 00 54 FE 00 66 FE 00 68 FE 00 6B FE 00 70 FE 00 72 FE' - '00 74 FE 00 74 FE 00 76 FE 00 FC FE 00 01 FF 00 BE FF 00 C2 FF 00 C7 FF 00 CA FF 00 CF FF 00 D2' - 'FF 00 D7 FF 00 DA FF 00 DC FF 00 E0 FF 00 E6 FF 00 E8 FF 00 EE FF 00 9A 10 01 9A 10 01 9C 10 01' - '9C 10 01 AB 10 01 AB 10 01 2E 11 01 2F 11 01 4B 13 01 4C 13 01 BB 14 01 BC 14 01 BE 14 01 BE 14' - '01 BA 15 01 BB 15 01 38 19 01 38 19 01 5E D1 01 64 D1 01 BB D1 01 C0 D1 01 00 D4 01 54 D4 01 56' - 'D4 01 9C D4 01 9E D4 01 9F D4 01 A2 D4 01 A2 D4 01 A5 D4 01 A6 D4 01 A9 D4 01 AC D4 01 AE D4 01' - 'B9 D4 01 BB D4 01 BB D4 01 BD D4 01 C3 D4 01 C5 D4 01 05 D5 01 07 D5 01 0A D5 01 0D D5 01 14 D5' - '01 16 D5 01 1C D5 01 1E D5 01 39 D5 01 3B D5 01 3E D5 01 40 D5 01 44 D5 01 46 D5 01 46 D5 01 4A' - 'D5 01 50 D5 01 52 D5 01 A5 D6 01 A8 D6 01 CB D7 01 CE D7 01 FF D7 01 00 EE 01 03 EE 01 05 EE 01' - '1F EE 01 21 EE 01 22 EE 01 24 EE 01 24 EE 01 27 EE 01 27 EE 01 29 EE 01 32 EE 01 34 EE 01 37 EE' - '01 39 EE 01 39 EE 01 3B EE 01 3B EE 01 42 EE 01 42 EE 01 47 EE 01 47 EE 01 49 EE 01 49 EE 01 4B' - 'EE 01 4B EE 01 4D EE 01 4F EE 01 51 EE 01 52 EE 01 54 EE 01 54 EE 01 57 EE 01 57 EE 01 59 EE 01' - '59 EE 01 5B EE 01 5B EE 01 5D EE 01 5D EE 01 5F EE 01 5F EE 01 61 EE 01 62 EE 01 64 EE 01 64 EE' - '01 67 EE 01 6A EE 01 6C EE 01 72 EE 01 74 EE 01 77 EE 01 79 EE 01 7C EE 01 7E EE 01 7E EE 01 80' - 'EE 01 89 EE 01 8B EE 01 9B EE 01 A1 EE 01 A3 EE 01 A5 EE 01 A9 EE 01 AB EE 01 BB EE 01 00 F1 01' - '0A F1 01 10 F1 01 2E F1 01 30 F1 01 4F F1 01 6A F1 01 6C F1 01 90 F1 01 90 F1 01 00 F2 01 02 F2' - '01 10 F2 01 3B F2 01 40 F2 01 48 F2 01 50 F2 01 51 F2 01 F0 FB 01 F9 FB 01 00 F8 02 1D FA 02 34' - '05 00 00 00 A0 00 00 A0 00 00 0C 0F 00 0C 0F 00 07 20 00 07 20 00 11 20 00 11 20 00 2F 20 00 2F' - '20 00 35 27 01 00 00 28 00 00 29 00 00 5B 00 00 5B 00 00 5D 00 00 5D 00 00 7B 00 00 7B 00 00 7D' - '00 00 7D 00 00 AB 00 00 AB 00 00 BB 00 00 BB 00 00 BE 02 00 BF 02 00 C2 02 00 C3 02 00 D2 02 00' - 'D3 02 00 F1 02 00 F2 02 00 18 03 00 19 03 00 1C 03 00 1C 03 00 39 03 00 39 03 00 50 03 00 51 03' - '00 54 03 00 55 03 00 57 03 00 58 03 00 8D 05 00 8E 05 00 06 07 00 07 07 00 F7 08 00 FA 08 00 D5' - '0F 00 D8 0F 00 F6 1D 00 F8 1D 00 FE 1D 00 FE 1D 00 0E 20 00 0F 20 00 18 20 00 19 20 00 1C 20 00' - '1D 20 00 2A 20 00 2B 20 00 2D 20 00 2E 20 00 39 20 00 3A 20 00 45 20 00 46 20 00 4C 20 00 4D 20' - '00 66 20 00 67 20 00 7D 20 00 7E 20 00 8D 20 00 8E 20 00 D0 20 00 D1 20 00 D6 20 00 D7 20 00 EC' - '20 00 EF 20 00 90 21 00 90 21 00 92 21 00 92 21 00 9A 21 00 9E 21 00 A0 21 00 A0 21 00 A2 21 00' - 'A4 21 00 A6 21 00 A6 21 00 A9 21 00 AC 21 00 B0 21 00 B3 21 00 BC 21 00 C4 21 00 C6 21 00 C7 21' - '00 C9 21 00 C9 21 00 CB 21 00 CD 21 00 CF 21 00 D0 21 00 D2 21 00 D2 21 00 DA 21 00 DD 21 00 E0' - '21 00 E0 21 00 E2 21 00 E2 21 00 E4 21 00 E6 21 00 E8 21 00 E8 21 00 F4 21 00 F4 21 00 F6 21 00' - 'F8 21 00 FA 21 00 FB 21 00 FD 21 00 FE 21 00 A2 22 00 A3 22 00 AB 22 00 AB 22 00 C9 22 00 CC 22' - '00 08 23 00 0F 23 00 1C 23 00 1F 23 00 26 23 00 26 23 00 29 23 00 2B 23 00 45 23 00 48 23 00 9B' - '23 00 A9 23 00 AB 23 00 AD 23 00 B0 23 00 B1 23 00 B8 23 00 B9 23 00 BE 23 00 BF 23 00 CB 23 00' - 'CC 23 00 E9 23 00 EA 23 00 ED 23 00 EE 23 00 F4 23 00 F5 23 00 0C 25 00 2B 25 00 2D 25 00 2E 25' - '00 31 25 00 32 25 00 35 25 00 36 25 00 39 25 00 3A 25 00 3D 25 00 3E 25 00 43 25 00 46 25 00 49' - '25 00 4A 25 00 52 25 00 63 25 00 6D 25 00 72 25 00 74 25 00 74 25 00 76 25 00 76 25 00 78 25 00' - '78 25 00 7A 25 00 7A 25 00 89 25 00 90 25 00 95 25 00 98 25 00 9A 25 00 9A 25 00 9D 25 00 9E 25' - '00 A7 25 00 A8 25 00 B6 25 00 BB 25 00 C0 25 00 C5 25 00 D0 25 00 D1 25 00 D6 25 00 D7 25 00 DC' - '25 00 DF 25 00 E2 25 00 E5 25 00 E7 25 00 EA 25 00 ED 25 00 EE 25 00 F0 25 00 FA 25 00 FF 25 00' - 'FF 25 00 1A 26 00 1C 26 00 1E 26 00 1E 26 00 9E 26 00 9F 26 00 E5 26 00 E6 26 00 0E 27 00 0E 27' - '00 68 27 00 75 27 00 C5 27 00 C6 27 00 D5 27 00 D6 27 00 DD 27 00 DE 27 00 E2 27 00 EF 27 00 F4' - '27 00 F6 27 00 F8 27 00 F9 27 00 FB 27 00 FF 27 00 00 29 00 03 29 00 05 29 00 07 29 00 0C 29 00' - '11 29 00 14 29 00 20 29 00 33 29 00 33 29 00 36 29 00 37 29 00 42 29 00 43 29 00 45 29 00 47 29' - '00 4C 29 00 4D 29 00 4F 29 00 4F 29 00 51 29 00 62 29 00 64 29 00 64 29 00 66 29 00 6D 29 00 71' - '29 00 75 29 00 7C 29 00 7D 29 00 83 29 00 92 29 00 97 29 00 98 29 00 A8 29 00 AF 29 00 B3 29 00' - 'B4 29 00 D1 29 00 D2 29 00 D4 29 00 D5 29 00 D8 29 00 DB 29 00 E8 29 00 E9 29 00 FC 29 00 FD 29' - '00 2D 2A 00 2E 2A 00 34 2A 00 35 2A 00 CD 2A 00 CE 2A 00 E5 2A 00 E5 2A 00 05 2B 00 05 2B 00 0E' - '2B 00 11 2B 00 14 2B 00 17 2B 00 30 2B 00 42 2B 00 45 2B 00 4C 2B 00 60 2B 00 60 2B 00 62 2B 00' - '62 2B 00 6A 2B 00 6A 2B 00 6C 2B 00 6C 2B 00 70 2B 00 70 2B 00 72 2B 00 72 2B 00 7A 2B 00 7A 2B' - '00 7C 2B 00 7C 2B 00 80 2B 00 80 2B 00 82 2B 00 82 2B 00 84 2B 00 84 2B 00 86 2B 00 86 2B 00 88' - '2B 00 88 2B 00 8A 2B 00 8A 2B 00 8C 2B 00 8C 2B 00 8E 2B 00 8E 2B 00 90 2B 00 93 2B 00 95 2B 00' - '95 2B 00 98 2B 00 98 2B 00 9A 2B 00 9A 2B 00 9C 2B 00 9C 2B 00 9E 2B 00 9E 2B 00 A0 2B 00 B7 2B' - '00 C7 2B 00 C8 2B 00 E8 2B 00 EC 2B 00 EE 2B 00 EE 2B 00 02 2E 00 05 2E 00 09 2E 00 0A 2E 00 0C' - '2E 00 0D 2E 00 1C 2E 00 1D 2E 00 20 2E 00 29 2E 00 36 2E 00 37 2E 00 50 2E 00 51 2E 00 F8 2F 00' - 'F9 2F 00 08 30 00 11 30 00 14 30 00 1B 30 00 A7 32 00 A8 32 00 C1 A9 00 C2 A9 00 6A AB 00 6B AB' - '00 3E FD 00 3F FD 00 20 FE 00 25 FE 00 27 FE 00 2C FE 00 2E FE 00 2F FE 00 35 FE 00 44 FE 00 47' - 'FE 00 48 FE 00 59 FE 00 5E FE 00 08 FF 00 09 FF 00 3B FF 00 3B FF 00 3D FF 00 3D FF 00 5B FF 00' - '5B FF 00 5D FF 00 5D FF 00 5F FF 00 60 FF 00 62 FF 00 63 FF 00 E9 FF 00 E9 FF 00 EB FF 00 EB FF' - '00 77 08 01 78 08 01 70 BC 01 70 BC 01 72 BC 01 72 BC 01 06 D1 01 07 D1 01 4A D1 01 4D D1 01 48' - 'F4 01 49 F4 01 0D F5 01 0E F5 01 43 F5 01 44 F5 01 7B F5 01 7B F5 01 7D F5 01 7D F5 01 89 F5 01' - '89 F5 01 98 F5 01 9D F5 01 E6 F5 01 E9 F5 01 EC F5 01 EF F5 01 6C F6 01 6C F6 01 6E F6 01 6E F6' - '01 00 F8 01 00 F8 01 02 F8 01 02 F8 01 04 F8 01 04 F8 01 06 F8 01 06 F8 01 08 F8 01 08 F8 01 0A' - 'F8 01 0A F8 01 10 F8 01 10 F8 01 12 F8 01 12 F8 01 14 F8 01 14 F8 01 16 F8 01 16 F8 01 18 F8 01' - '18 F8 01 1A F8 01 1A F8 01 1C F8 01 1C F8 01 1E F8 01 1E F8 01 20 F8 01 20 F8 01 22 F8 01 22 F8' - '01 24 F8 01 24 F8 01 26 F8 01 26 F8 01 28 F8 01 28 F8 01 2A F8 01 2A F8 01 2C F8 01 2C F8 01 2E' - 'F8 01 2E F8 01 30 F8 01 30 F8 01 32 F8 01 32 F8 01 34 F8 01 34 F8 01 36 F8 01 36 F8 01 38 F8 01' - '38 F8 01 3A F8 01 3A F8 01 3C F8 01 3C F8 01 3E F8 01 3E F8 01 40 F8 01 40 F8 01 42 F8 01 42 F8' - '01 44 F8 01 44 F8 01 46 F8 01 46 F8 01 50 F8 01 50 F8 01 52 F8 01 52 F8 01 60 F8 01 60 F8 01 62' - 'F8 01 62 F8 01 68 F8 01 68 F8 01 6A F8 01 6A F8 01 70 F8 01 70 F8 01 72 F8 01 72 F8 01 78 F8 01' - '78 F8 01 7A F8 01 7A F8 01 80 F8 01 80 F8 01 82 F8 01 82 F8 01 90 F8 01 90 F8 01 92 F8 01 92 F8' - '01 94 F8 01 94 F8 01 96 F8 01 96 F8 01 98 F8 01 98 F8 01 9A F8 01 9A F8 01 A2 F8 01 AB F8 01 1B' - 'F9 01 1C F9 01 68 FB 01 68 FB 01 6A FB 01 6A FB 01 6C FB 01 6C FB 01 6E FB 01 6E FB 01 7C FB 01' - '7F FB 01 87 FB 01 8D FB 01 98 FB 01 99 FB 01 9C FB 01 A5 FB 01 A8 FB 01 AD FB 01 B2 FB 01 B3 FB' - '01 B5 FB 01 B6 FB 01 B9 FB 01 BA FB 01 C7 FB 01 C8 FB 01 28 00 0E 29 00 0E 5B 00 0E 5B 00 0E 5D' - '00 0E 5D 00 0E 7B 00 0E 7B 00 0E 7D 00 0E 7D 00 0E 36 06 00 00 00 30 00 00 39 00 00 41 00 00 46' - '00 00 61 00 00 66 00 00 10 FF 00 19 FF 00 21 FF 00 26 FF 00 41 FF 00 46 FF 00 37 0D 00 00 00 22' - '00 00 22 00 00 27 00 00 27 00 00 AB 00 00 AB 00 00 BB 00 00 BB 00 00 18 20 00 1F 20 00 39 20 00' - '3A 20 00 42 2E 00 42 2E 00 0C 30 00 0F 30 00 1D 30 00 1F 30 00 41 FE 00 44 FE 00 02 FF 00 02 FF' - '00 07 FF 00 07 FF 00 62 FF 00 63 FF 00 38 71 00 00 00 28 00 00 29 00 00 3C 00 00 3C 00 00 3E 00' - '00 3E 00 00 5B 00 00 5B 00 00 5D 00 00 5D 00 00 7B 00 00 7B 00 00 7D 00 00 7D 00 00 AB 00 00 AB' - '00 00 BB 00 00 BB 00 00 3A 0F 00 3D 0F 00 9B 16 00 9C 16 00 39 20 00 3A 20 00 45 20 00 46 20 00' - '7D 20 00 7E 20 00 8D 20 00 8E 20 00 40 21 00 40 21 00 01 22 00 04 22 00 08 22 00 0D 22 00 11 22' - '00 11 22 00 15 22 00 16 22 00 1A 22 00 1D 22 00 1F 22 00 22 22 00 24 22 00 24 22 00 26 22 00 26' - '22 00 2B 22 00 33 22 00 39 22 00 39 22 00 3B 22 00 4C 22 00 52 22 00 55 22 00 5F 22 00 60 22 00' - '62 22 00 62 22 00 64 22 00 6B 22 00 6E 22 00 8C 22 00 8F 22 00 92 22 00 98 22 00 98 22 00 A2 22' - '00 A3 22 00 A6 22 00 B8 22 00 BE 22 00 BF 22 00 C9 22 00 CD 22 00 D0 22 00 D1 22 00 D6 22 00 ED' - '22 00 F0 22 00 FF 22 00 08 23 00 0B 23 00 20 23 00 21 23 00 29 23 00 2A 23 00 68 27 00 75 27 00' - 'C0 27 00 C0 27 00 C3 27 00 C6 27 00 C8 27 00 C9 27 00 CB 27 00 CD 27 00 D3 27 00 D6 27 00 DC 27' - '00 DE 27 00 E2 27 00 EF 27 00 83 29 00 98 29 00 9B 29 00 A0 29 00 A2 29 00 AF 29 00 B8 29 00 B8' - '29 00 C0 29 00 C5 29 00 C9 29 00 C9 29 00 CE 29 00 D2 29 00 D4 29 00 D5 29 00 D8 29 00 DC 29 00' - 'E1 29 00 E1 29 00 E3 29 00 E5 29 00 E8 29 00 E9 29 00 F4 29 00 F9 29 00 FC 29 00 FD 29 00 0A 2A' - '00 1C 2A 00 1E 2A 00 21 2A 00 24 2A 00 24 2A 00 26 2A 00 26 2A 00 29 2A 00 29 2A 00 2B 2A 00 2E' - '2A 00 34 2A 00 35 2A 00 3C 2A 00 3E 2A 00 57 2A 00 58 2A 00 64 2A 00 65 2A 00 6A 2A 00 6D 2A 00' - '6F 2A 00 70 2A 00 73 2A 00 74 2A 00 79 2A 00 A3 2A 00 A6 2A 00 AD 2A 00 AF 2A 00 D6 2A 00 DC 2A' - '00 DC 2A 00 DE 2A 00 DE 2A 00 E2 2A 00 E6 2A 00 EC 2A 00 EE 2A 00 F3 2A 00 F3 2A 00 F7 2A 00 FB' - '2A 00 FD 2A 00 FD 2A 00 FE 2B 00 FE 2B 00 02 2E 00 05 2E 00 09 2E 00 0A 2E 00 0C 2E 00 0D 2E 00' - '1C 2E 00 1D 2E 00 20 2E 00 29 2E 00 08 30 00 11 30 00 14 30 00 1B 30 00 59 FE 00 5E FE 00 64 FE' - '00 65 FE 00 08 FF 00 09 FF 00 1C FF 00 1C FF 00 1E FF 00 1E FF 00 3B FF 00 3B FF 00 3D FF 00 3D' - 'FF 00 5B FF 00 5B FF 00 5D FF 00 5D FF 00 5F FF 00 60 FF 00 62 FF 00 63 FF 00 DB D6 01 DB D6 01' - '15 D7 01 15 D7 01 4F D7 01 4F D7 01 89 D7 01 89 D7 01 C3 D7 01 C3 D7 01 39 A5 02 00 00 00 00 00' - '77 03 00 7A 03 00 7F 03 00 84 03 00 8A 03 00 8C 03 00 8C 03 00 8E 03 00 A1 03 00 A3 03 00 2F 05' - '00 31 05 00 56 05 00 59 05 00 8A 05 00 8D 05 00 8F 05 00 91 05 00 C7 05 00 D0 05 00 EA 05 00 EF' - '05 00 F4 05 00 00 06 00 1C 06 00 1E 06 00 0D 07 00 0F 07 00 4A 07 00 4D 07 00 B1 07 00 C0 07 00' - 'FA 07 00 FD 07 00 2D 08 00 30 08 00 3E 08 00 40 08 00 5B 08 00 5E 08 00 5E 08 00 60 08 00 6A 08' - '00 A0 08 00 B4 08 00 B6 08 00 C7 08 00 D3 08 00 83 09 00 85 09 00 8C 09 00 8F 09 00 90 09 00 93' - '09 00 A8 09 00 AA 09 00 B0 09 00 B2 09 00 B2 09 00 B6 09 00 B9 09 00 BC 09 00 C4 09 00 C7 09 00' - 'C8 09 00 CB 09 00 CE 09 00 D7 09 00 D7 09 00 DC 09 00 DD 09 00 DF 09 00 E3 09 00 E6 09 00 FE 09' - '00 01 0A 00 03 0A 00 05 0A 00 0A 0A 00 0F 0A 00 10 0A 00 13 0A 00 28 0A 00 2A 0A 00 30 0A 00 32' - '0A 00 33 0A 00 35 0A 00 36 0A 00 38 0A 00 39 0A 00 3C 0A 00 3C 0A 00 3E 0A 00 42 0A 00 47 0A 00' - '48 0A 00 4B 0A 00 4D 0A 00 51 0A 00 51 0A 00 59 0A 00 5C 0A 00 5E 0A 00 5E 0A 00 66 0A 00 76 0A' - '00 81 0A 00 83 0A 00 85 0A 00 8D 0A 00 8F 0A 00 91 0A 00 93 0A 00 A8 0A 00 AA 0A 00 B0 0A 00 B2' - '0A 00 B3 0A 00 B5 0A 00 B9 0A 00 BC 0A 00 C5 0A 00 C7 0A 00 C9 0A 00 CB 0A 00 CD 0A 00 D0 0A 00' - 'D0 0A 00 E0 0A 00 E3 0A 00 E6 0A 00 F1 0A 00 F9 0A 00 FF 0A 00 01 0B 00 03 0B 00 05 0B 00 0C 0B' - '00 0F 0B 00 10 0B 00 13 0B 00 28 0B 00 2A 0B 00 30 0B 00 32 0B 00 33 0B 00 35 0B 00 39 0B 00 3C' - '0B 00 44 0B 00 47 0B 00 48 0B 00 4B 0B 00 4D 0B 00 55 0B 00 57 0B 00 5C 0B 00 5D 0B 00 5F 0B 00' - '63 0B 00 66 0B 00 77 0B 00 82 0B 00 83 0B 00 85 0B 00 8A 0B 00 8E 0B 00 90 0B 00 92 0B 00 95 0B' - '00 99 0B 00 9A 0B 00 9C 0B 00 9C 0B 00 9E 0B 00 9F 0B 00 A3 0B 00 A4 0B 00 A8 0B 00 AA 0B 00 AE' - '0B 00 B9 0B 00 BE 0B 00 C2 0B 00 C6 0B 00 C8 0B 00 CA 0B 00 CD 0B 00 D0 0B 00 D0 0B 00 D7 0B 00' - 'D7 0B 00 E6 0B 00 FA 0B 00 00 0C 00 0C 0C 00 0E 0C 00 10 0C 00 12 0C 00 28 0C 00 2A 0C 00 39 0C' - '00 3D 0C 00 44 0C 00 46 0C 00 48 0C 00 4A 0C 00 4D 0C 00 55 0C 00 56 0C 00 58 0C 00 5A 0C 00 60' - '0C 00 63 0C 00 66 0C 00 6F 0C 00 77 0C 00 8C 0C 00 8E 0C 00 90 0C 00 92 0C 00 A8 0C 00 AA 0C 00' - 'B3 0C 00 B5 0C 00 B9 0C 00 BC 0C 00 C4 0C 00 C6 0C 00 C8 0C 00 CA 0C 00 CD 0C 00 D5 0C 00 D6 0C' - '00 DE 0C 00 DE 0C 00 E0 0C 00 E3 0C 00 E6 0C 00 EF 0C 00 F1 0C 00 F2 0C 00 00 0D 00 0C 0D 00 0E' - '0D 00 10 0D 00 12 0D 00 44 0D 00 46 0D 00 48 0D 00 4A 0D 00 4F 0D 00 54 0D 00 63 0D 00 66 0D 00' - '7F 0D 00 81 0D 00 83 0D 00 85 0D 00 96 0D 00 9A 0D 00 B1 0D 00 B3 0D 00 BB 0D 00 BD 0D 00 BD 0D' - '00 C0 0D 00 C6 0D 00 CA 0D 00 CA 0D 00 CF 0D 00 D4 0D 00 D6 0D 00 D6 0D 00 D8 0D 00 DF 0D 00 E6' - '0D 00 EF 0D 00 F2 0D 00 F4 0D 00 01 0E 00 3A 0E 00 3F 0E 00 5B 0E 00 81 0E 00 82 0E 00 84 0E 00' - '84 0E 00 86 0E 00 8A 0E 00 8C 0E 00 A3 0E 00 A5 0E 00 A5 0E 00 A7 0E 00 BD 0E 00 C0 0E 00 C4 0E' - '00 C6 0E 00 C6 0E 00 C8 0E 00 CD 0E 00 D0 0E 00 D9 0E 00 DC 0E 00 DF 0E 00 00 0F 00 47 0F 00 49' - '0F 00 6C 0F 00 71 0F 00 97 0F 00 99 0F 00 BC 0F 00 BE 0F 00 CC 0F 00 CE 0F 00 DA 0F 00 00 10 00' - 'C5 10 00 C7 10 00 C7 10 00 CD 10 00 CD 10 00 D0 10 00 48 12 00 4A 12 00 4D 12 00 50 12 00 56 12' - '00 58 12 00 58 12 00 5A 12 00 5D 12 00 60 12 00 88 12 00 8A 12 00 8D 12 00 90 12 00 B0 12 00 B2' - '12 00 B5 12 00 B8 12 00 BE 12 00 C0 12 00 C0 12 00 C2 12 00 C5 12 00 C8 12 00 D6 12 00 D8 12 00' - '10 13 00 12 13 00 15 13 00 18 13 00 5A 13 00 5D 13 00 7C 13 00 80 13 00 99 13 00 A0 13 00 F5 13' - '00 F8 13 00 FD 13 00 00 14 00 9C 16 00 A0 16 00 F8 16 00 00 17 00 0C 17 00 0E 17 00 14 17 00 20' - '17 00 36 17 00 40 17 00 53 17 00 60 17 00 6C 17 00 6E 17 00 70 17 00 72 17 00 73 17 00 80 17 00' - 'DD 17 00 E0 17 00 E9 17 00 F0 17 00 F9 17 00 00 18 00 0E 18 00 10 18 00 19 18 00 20 18 00 78 18' - '00 80 18 00 AA 18 00 B0 18 00 F5 18 00 00 19 00 1E 19 00 20 19 00 2B 19 00 30 19 00 3B 19 00 40' - '19 00 40 19 00 44 19 00 6D 19 00 70 19 00 74 19 00 80 19 00 AB 19 00 B0 19 00 C9 19 00 D0 19 00' - 'DA 19 00 DE 19 00 1B 1A 00 1E 1A 00 5E 1A 00 60 1A 00 7C 1A 00 7F 1A 00 89 1A 00 90 1A 00 99 1A' - '00 A0 1A 00 AD 1A 00 B0 1A 00 C0 1A 00 00 1B 00 4B 1B 00 50 1B 00 7C 1B 00 80 1B 00 F3 1B 00 FC' - '1B 00 37 1C 00 3B 1C 00 49 1C 00 4D 1C 00 88 1C 00 90 1C 00 BA 1C 00 BD 1C 00 C7 1C 00 D0 1C 00' - 'FA 1C 00 00 1D 00 F9 1D 00 FB 1D 00 15 1F 00 18 1F 00 1D 1F 00 20 1F 00 45 1F 00 48 1F 00 4D 1F' - '00 50 1F 00 57 1F 00 59 1F 00 59 1F 00 5B 1F 00 5B 1F 00 5D 1F 00 5D 1F 00 5F 1F 00 7D 1F 00 80' - '1F 00 B4 1F 00 B6 1F 00 C4 1F 00 C6 1F 00 D3 1F 00 D6 1F 00 DB 1F 00 DD 1F 00 EF 1F 00 F2 1F 00' - 'F4 1F 00 F6 1F 00 FE 1F 00 00 20 00 64 20 00 66 20 00 71 20 00 74 20 00 8E 20 00 90 20 00 9C 20' - '00 A0 20 00 BF 20 00 D0 20 00 F0 20 00 00 21 00 8B 21 00 90 21 00 26 24 00 40 24 00 4A 24 00 60' - '24 00 73 2B 00 76 2B 00 95 2B 00 97 2B 00 2E 2C 00 30 2C 00 5E 2C 00 60 2C 00 F3 2C 00 F9 2C 00' - '25 2D 00 27 2D 00 27 2D 00 2D 2D 00 2D 2D 00 30 2D 00 67 2D 00 6F 2D 00 70 2D 00 7F 2D 00 96 2D' - '00 A0 2D 00 A6 2D 00 A8 2D 00 AE 2D 00 B0 2D 00 B6 2D 00 B8 2D 00 BE 2D 00 C0 2D 00 C6 2D 00 C8' - '2D 00 CE 2D 00 D0 2D 00 D6 2D 00 D8 2D 00 DE 2D 00 E0 2D 00 52 2E 00 80 2E 00 99 2E 00 9B 2E 00' - 'F3 2E 00 00 2F 00 D5 2F 00 F0 2F 00 FB 2F 00 00 30 00 3F 30 00 41 30 00 96 30 00 99 30 00 FF 30' - '00 05 31 00 2F 31 00 31 31 00 8E 31 00 90 31 00 E3 31 00 F0 31 00 1E 32 00 20 32 00 FC 9F 00 00' - 'A0 00 8C A4 00 90 A4 00 C6 A4 00 D0 A4 00 2B A6 00 40 A6 00 F7 A6 00 00 A7 00 BF A7 00 C2 A7 00' - 'CA A7 00 F5 A7 00 2C A8 00 30 A8 00 39 A8 00 40 A8 00 77 A8 00 80 A8 00 C5 A8 00 CE A8 00 D9 A8' - '00 E0 A8 00 53 A9 00 5F A9 00 7C A9 00 80 A9 00 CD A9 00 CF A9 00 D9 A9 00 DE A9 00 FE A9 00 00' - 'AA 00 36 AA 00 40 AA 00 4D AA 00 50 AA 00 59 AA 00 5C AA 00 C2 AA 00 DB AA 00 F6 AA 00 01 AB 00' - '06 AB 00 09 AB 00 0E AB 00 11 AB 00 16 AB 00 20 AB 00 26 AB 00 28 AB 00 2E AB 00 30 AB 00 6B AB' - '00 70 AB 00 ED AB 00 F0 AB 00 F9 AB 00 00 AC 00 A3 D7 00 B0 D7 00 C6 D7 00 CB D7 00 FB D7 00 00' - 'D8 00 6D FA 00 70 FA 00 D9 FA 00 00 FB 00 06 FB 00 13 FB 00 17 FB 00 1D FB 00 36 FB 00 38 FB 00' - '3C FB 00 3E FB 00 3E FB 00 40 FB 00 41 FB 00 43 FB 00 44 FB 00 46 FB 00 C1 FB 00 D3 FB 00 3F FD' - '00 50 FD 00 8F FD 00 92 FD 00 C7 FD 00 F0 FD 00 FD FD 00 00 FE 00 19 FE 00 20 FE 00 52 FE 00 54' - 'FE 00 66 FE 00 68 FE 00 6B FE 00 70 FE 00 74 FE 00 76 FE 00 FC FE 00 FF FE 00 FF FE 00 01 FF 00' - 'BE FF 00 C2 FF 00 C7 FF 00 CA FF 00 CF FF 00 D2 FF 00 D7 FF 00 DA FF 00 DC FF 00 E0 FF 00 E6 FF' - '00 E8 FF 00 EE FF 00 F9 FF 00 FD FF 00 00 00 01 0B 00 01 0D 00 01 26 00 01 28 00 01 3A 00 01 3C' - '00 01 3D 00 01 3F 00 01 4D 00 01 50 00 01 5D 00 01 80 00 01 FA 00 01 00 01 01 02 01 01 07 01 01' - '33 01 01 37 01 01 8E 01 01 90 01 01 9C 01 01 A0 01 01 A0 01 01 D0 01 01 FD 01 01 80 02 01 9C 02' - '01 A0 02 01 D0 02 01 E0 02 01 FB 02 01 00 03 01 23 03 01 2D 03 01 4A 03 01 50 03 01 7A 03 01 80' - '03 01 9D 03 01 9F 03 01 C3 03 01 C8 03 01 D5 03 01 00 04 01 9D 04 01 A0 04 01 A9 04 01 B0 04 01' - 'D3 04 01 D8 04 01 FB 04 01 00 05 01 27 05 01 30 05 01 63 05 01 6F 05 01 6F 05 01 00 06 01 36 07' - '01 40 07 01 55 07 01 60 07 01 67 07 01 00 08 01 05 08 01 08 08 01 08 08 01 0A 08 01 35 08 01 37' - '08 01 38 08 01 3C 08 01 3C 08 01 3F 08 01 55 08 01 57 08 01 9E 08 01 A7 08 01 AF 08 01 E0 08 01' - 'F2 08 01 F4 08 01 F5 08 01 FB 08 01 1B 09 01 1F 09 01 39 09 01 3F 09 01 3F 09 01 80 09 01 B7 09' - '01 BC 09 01 CF 09 01 D2 09 01 03 0A 01 05 0A 01 06 0A 01 0C 0A 01 13 0A 01 15 0A 01 17 0A 01 19' - '0A 01 35 0A 01 38 0A 01 3A 0A 01 3F 0A 01 48 0A 01 50 0A 01 58 0A 01 60 0A 01 9F 0A 01 C0 0A 01' - 'E6 0A 01 EB 0A 01 F6 0A 01 00 0B 01 35 0B 01 39 0B 01 55 0B 01 58 0B 01 72 0B 01 78 0B 01 91 0B' - '01 99 0B 01 9C 0B 01 A9 0B 01 AF 0B 01 00 0C 01 48 0C 01 80 0C 01 B2 0C 01 C0 0C 01 F2 0C 01 FA' - '0C 01 27 0D 01 30 0D 01 39 0D 01 60 0E 01 7E 0E 01 80 0E 01 A9 0E 01 AB 0E 01 AD 0E 01 B0 0E 01' - 'B1 0E 01 00 0F 01 27 0F 01 30 0F 01 59 0F 01 B0 0F 01 CB 0F 01 E0 0F 01 F6 0F 01 00 10 01 4D 10' - '01 52 10 01 6F 10 01 7F 10 01 C1 10 01 CD 10 01 CD 10 01 D0 10 01 E8 10 01 F0 10 01 F9 10 01 00' - '11 01 34 11 01 36 11 01 47 11 01 50 11 01 76 11 01 80 11 01 DF 11 01 E1 11 01 F4 11 01 00 12 01' - '11 12 01 13 12 01 3E 12 01 80 12 01 86 12 01 88 12 01 88 12 01 8A 12 01 8D 12 01 8F 12 01 9D 12' - '01 9F 12 01 A9 12 01 B0 12 01 EA 12 01 F0 12 01 F9 12 01 00 13 01 03 13 01 05 13 01 0C 13 01 0F' - '13 01 10 13 01 13 13 01 28 13 01 2A 13 01 30 13 01 32 13 01 33 13 01 35 13 01 39 13 01 3B 13 01' - '44 13 01 47 13 01 48 13 01 4B 13 01 4D 13 01 50 13 01 50 13 01 57 13 01 57 13 01 5D 13 01 63 13' - '01 66 13 01 6C 13 01 70 13 01 74 13 01 00 14 01 5B 14 01 5D 14 01 61 14 01 80 14 01 C7 14 01 D0' - '14 01 D9 14 01 80 15 01 B5 15 01 B8 15 01 DD 15 01 00 16 01 44 16 01 50 16 01 59 16 01 60 16 01' - '6C 16 01 80 16 01 B8 16 01 C0 16 01 C9 16 01 00 17 01 1A 17 01 1D 17 01 2B 17 01 30 17 01 3F 17' - '01 00 18 01 3B 18 01 A0 18 01 F2 18 01 FF 18 01 06 19 01 09 19 01 09 19 01 0C 19 01 13 19 01 15' - '19 01 16 19 01 18 19 01 35 19 01 37 19 01 38 19 01 3B 19 01 46 19 01 50 19 01 59 19 01 A0 19 01' - 'A7 19 01 AA 19 01 D7 19 01 DA 19 01 E4 19 01 00 1A 01 47 1A 01 50 1A 01 A2 1A 01 C0 1A 01 F8 1A' - '01 00 1C 01 08 1C 01 0A 1C 01 36 1C 01 38 1C 01 45 1C 01 50 1C 01 6C 1C 01 70 1C 01 8F 1C 01 92' - '1C 01 A7 1C 01 A9 1C 01 B6 1C 01 00 1D 01 06 1D 01 08 1D 01 09 1D 01 0B 1D 01 36 1D 01 3A 1D 01' - '3A 1D 01 3C 1D 01 3D 1D 01 3F 1D 01 47 1D 01 50 1D 01 59 1D 01 60 1D 01 65 1D 01 67 1D 01 68 1D' - '01 6A 1D 01 8E 1D 01 90 1D 01 91 1D 01 93 1D 01 98 1D 01 A0 1D 01 A9 1D 01 E0 1E 01 F8 1E 01 B0' - '1F 01 B0 1F 01 C0 1F 01 F1 1F 01 FF 1F 01 99 23 01 00 24 01 6E 24 01 70 24 01 74 24 01 80 24 01' - '43 25 01 00 30 01 2E 34 01 30 34 01 38 34 01 00 44 01 46 46 01 00 68 01 38 6A 01 40 6A 01 5E 6A' - '01 60 6A 01 69 6A 01 6E 6A 01 6F 6A 01 D0 6A 01 ED 6A 01 F0 6A 01 F5 6A 01 00 6B 01 45 6B 01 50' - '6B 01 59 6B 01 5B 6B 01 61 6B 01 63 6B 01 77 6B 01 7D 6B 01 8F 6B 01 40 6E 01 9A 6E 01 00 6F 01' - '4A 6F 01 4F 6F 01 87 6F 01 8F 6F 01 9F 6F 01 E0 6F 01 E4 6F 01 F0 6F 01 F1 6F 01 00 70 01 F7 87' - '01 00 88 01 D5 8C 01 00 8D 01 08 8D 01 00 B0 01 1E B1 01 50 B1 01 52 B1 01 64 B1 01 67 B1 01 70' - 'B1 01 FB B2 01 00 BC 01 6A BC 01 70 BC 01 7C BC 01 80 BC 01 88 BC 01 90 BC 01 99 BC 01 9C BC 01' - 'A3 BC 01 00 D0 01 F5 D0 01 00 D1 01 26 D1 01 29 D1 01 E8 D1 01 00 D2 01 45 D2 01 E0 D2 01 F3 D2' - '01 00 D3 01 56 D3 01 60 D3 01 78 D3 01 00 D4 01 54 D4 01 56 D4 01 9C D4 01 9E D4 01 9F D4 01 A2' - 'D4 01 A2 D4 01 A5 D4 01 A6 D4 01 A9 D4 01 AC D4 01 AE D4 01 B9 D4 01 BB D4 01 BB D4 01 BD D4 01' - 'C3 D4 01 C5 D4 01 05 D5 01 07 D5 01 0A D5 01 0D D5 01 14 D5 01 16 D5 01 1C D5 01 1E D5 01 39 D5' - '01 3B D5 01 3E D5 01 40 D5 01 44 D5 01 46 D5 01 46 D5 01 4A D5 01 50 D5 01 52 D5 01 A5 D6 01 A8' - 'D6 01 CB D7 01 CE D7 01 8B DA 01 9B DA 01 9F DA 01 A1 DA 01 AF DA 01 00 E0 01 06 E0 01 08 E0 01' - '18 E0 01 1B E0 01 21 E0 01 23 E0 01 24 E0 01 26 E0 01 2A E0 01 00 E1 01 2C E1 01 30 E1 01 3D E1' - '01 40 E1 01 49 E1 01 4E E1 01 4F E1 01 C0 E2 01 F9 E2 01 FF E2 01 FF E2 01 00 E8 01 C4 E8 01 C7' - 'E8 01 D6 E8 01 00 E9 01 4B E9 01 50 E9 01 59 E9 01 5E E9 01 5F E9 01 71 EC 01 B4 EC 01 01 ED 01' - '3D ED 01 00 EE 01 03 EE 01 05 EE 01 1F EE 01 21 EE 01 22 EE 01 24 EE 01 24 EE 01 27 EE 01 27 EE' - '01 29 EE 01 32 EE 01 34 EE 01 37 EE 01 39 EE 01 39 EE 01 3B EE 01 3B EE 01 42 EE 01 42 EE 01 47' - 'EE 01 47 EE 01 49 EE 01 49 EE 01 4B EE 01 4B EE 01 4D EE 01 4F EE 01 51 EE 01 52 EE 01 54 EE 01' - '54 EE 01 57 EE 01 57 EE 01 59 EE 01 59 EE 01 5B EE 01 5B EE 01 5D EE 01 5D EE 01 5F EE 01 5F EE' - '01 61 EE 01 62 EE 01 64 EE 01 64 EE 01 67 EE 01 6A EE 01 6C EE 01 72 EE 01 74 EE 01 77 EE 01 79' - 'EE 01 7C EE 01 7E EE 01 7E EE 01 80 EE 01 89 EE 01 8B EE 01 9B EE 01 A1 EE 01 A3 EE 01 A5 EE 01' - 'A9 EE 01 AB EE 01 BB EE 01 F0 EE 01 F1 EE 01 00 F0 01 2B F0 01 30 F0 01 93 F0 01 A0 F0 01 AE F0' - '01 B1 F0 01 BF F0 01 C1 F0 01 CF F0 01 D1 F0 01 F5 F0 01 00 F1 01 AD F1 01 E6 F1 01 02 F2 01 10' - 'F2 01 3B F2 01 40 F2 01 48 F2 01 50 F2 01 51 F2 01 60 F2 01 65 F2 01 00 F3 01 D7 F6 01 E0 F6 01' - 'EC F6 01 F0 F6 01 FC F6 01 00 F7 01 73 F7 01 80 F7 01 D8 F7 01 E0 F7 01 EB F7 01 00 F8 01 0B F8' - '01 10 F8 01 47 F8 01 50 F8 01 59 F8 01 60 F8 01 87 F8 01 90 F8 01 AD F8 01 B0 F8 01 B1 F8 01 00' - 'F9 01 78 F9 01 7A F9 01 CB F9 01 CD F9 01 53 FA 01 60 FA 01 6D FA 01 70 FA 01 74 FA 01 78 FA 01' - '7A FA 01 80 FA 01 86 FA 01 90 FA 01 A8 FA 01 B0 FA 01 B6 FA 01 C0 FA 01 C2 FA 01 D0 FA 01 D6 FA' - '01 00 FB 01 92 FB 01 94 FB 01 CA FB 01 F0 FB 01 F9 FB 01 00 00 02 DD A6 02 00 A7 02 34 B7 02 40' - 'B7 02 1D B8 02 20 B8 02 A1 CE 02 B0 CE 02 E0 EB 02 00 F8 02 1D FA 02 00 00 03 4A 13 03 01 00 0E' - '01 00 0E 20 00 0E 7F 00 0E 00 01 0E EF 01 0E 00 00 0F FD FF 0F 00 00 10 FD FF 10 3A 03 00 00 00' - '30 00 00 39 00 00 41 00 00 46 00 00 61 00 00 66 00 00 3B 04 00 00 00 1C 06 00 1C 06 00 0E 20 00' - '0F 20 00 2A 20 00 2E 20 00 66 20 00 69 20 00 3D 08 00 00 00 49 01 00 49 01 00 73 06 00 73 06 00' - '77 0F 00 77 0F 00 79 0F 00 79 0F 00 A3 17 00 A4 17 00 6A 20 00 6F 20 00 29 23 00 2A 23 00 01 00' - '0E 01 00 0E 3E B0 00 00 00 5E 00 00 5E 00 00 60 00 00 60 00 00 A8 00 00 A8 00 00 AF 00 00 AF 00' - '00 B4 00 00 B4 00 00 B7 00 00 B8 00 00 B0 02 00 4E 03 00 50 03 00 57 03 00 5D 03 00 62 03 00 74' - '03 00 75 03 00 7A 03 00 7A 03 00 84 03 00 85 03 00 83 04 00 87 04 00 59 05 00 59 05 00 91 05 00' - 'A1 05 00 A3 05 00 BD 05 00 BF 05 00 BF 05 00 C1 05 00 C2 05 00 C4 05 00 C4 05 00 4B 06 00 52 06' - '00 57 06 00 58 06 00 DF 06 00 E0 06 00 E5 06 00 E6 06 00 EA 06 00 EC 06 00 30 07 00 4A 07 00 A6' - '07 00 B0 07 00 EB 07 00 F5 07 00 18 08 00 19 08 00 E3 08 00 FE 08 00 3C 09 00 3C 09 00 4D 09 00' - '4D 09 00 51 09 00 54 09 00 71 09 00 71 09 00 BC 09 00 BC 09 00 CD 09 00 CD 09 00 3C 0A 00 3C 0A' - '00 4D 0A 00 4D 0A 00 BC 0A 00 BC 0A 00 CD 0A 00 CD 0A 00 FD 0A 00 FF 0A 00 3C 0B 00 3C 0B 00 4D' - '0B 00 4D 0B 00 55 0B 00 55 0B 00 CD 0B 00 CD 0B 00 4D 0C 00 4D 0C 00 BC 0C 00 BC 0C 00 CD 0C 00' - 'CD 0C 00 3B 0D 00 3C 0D 00 4D 0D 00 4D 0D 00 CA 0D 00 CA 0D 00 47 0E 00 4C 0E 00 4E 0E 00 4E 0E' - '00 BA 0E 00 BA 0E 00 C8 0E 00 CC 0E 00 18 0F 00 19 0F 00 35 0F 00 35 0F 00 37 0F 00 37 0F 00 39' - '0F 00 39 0F 00 3E 0F 00 3F 0F 00 82 0F 00 84 0F 00 86 0F 00 87 0F 00 C6 0F 00 C6 0F 00 37 10 00' - '37 10 00 39 10 00 3A 10 00 63 10 00 64 10 00 69 10 00 6D 10 00 87 10 00 8D 10 00 8F 10 00 8F 10' - '00 9A 10 00 9B 10 00 5D 13 00 5F 13 00 C9 17 00 D3 17 00 DD 17 00 DD 17 00 39 19 00 3B 19 00 75' - '1A 00 7C 1A 00 7F 1A 00 7F 1A 00 B0 1A 00 BD 1A 00 34 1B 00 34 1B 00 44 1B 00 44 1B 00 6B 1B 00' - '73 1B 00 AA 1B 00 AB 1B 00 36 1C 00 37 1C 00 78 1C 00 7D 1C 00 D0 1C 00 E8 1C 00 ED 1C 00 ED 1C' - '00 F4 1C 00 F4 1C 00 F7 1C 00 F9 1C 00 2C 1D 00 6A 1D 00 C4 1D 00 CF 1D 00 F5 1D 00 F9 1D 00 FD' - '1D 00 FF 1D 00 BD 1F 00 BD 1F 00 BF 1F 00 C1 1F 00 CD 1F 00 CF 1F 00 DD 1F 00 DF 1F 00 ED 1F 00' - 'EF 1F 00 FD 1F 00 FE 1F 00 EF 2C 00 F1 2C 00 2F 2E 00 2F 2E 00 2A 30 00 2F 30 00 99 30 00 9C 30' - '00 FC 30 00 FC 30 00 6F A6 00 6F A6 00 7C A6 00 7D A6 00 7F A6 00 7F A6 00 9C A6 00 9D A6 00 F0' - 'A6 00 F1 A6 00 00 A7 00 21 A7 00 88 A7 00 8A A7 00 F8 A7 00 F9 A7 00 C4 A8 00 C4 A8 00 E0 A8 00' - 'F1 A8 00 2B A9 00 2E A9 00 53 A9 00 53 A9 00 B3 A9 00 B3 A9 00 C0 A9 00 C0 A9 00 E5 A9 00 E5 A9' - '00 7B AA 00 7D AA 00 BF AA 00 C2 AA 00 F6 AA 00 F6 AA 00 5B AB 00 5F AB 00 69 AB 00 6B AB 00 EC' - 'AB 00 ED AB 00 1E FB 00 1E FB 00 20 FE 00 2F FE 00 3E FF 00 3E FF 00 40 FF 00 40 FF 00 70 FF 00' - '70 FF 00 9E FF 00 9F FF 00 E3 FF 00 E3 FF 00 E0 02 01 E0 02 01 E5 0A 01 E6 0A 01 22 0D 01 27 0D' - '01 46 0F 01 50 0F 01 B9 10 01 BA 10 01 33 11 01 34 11 01 73 11 01 73 11 01 C0 11 01 C0 11 01 CA' - '11 01 CC 11 01 35 12 01 36 12 01 E9 12 01 EA 12 01 3C 13 01 3C 13 01 4D 13 01 4D 13 01 66 13 01' - '6C 13 01 70 13 01 74 13 01 42 14 01 42 14 01 46 14 01 46 14 01 C2 14 01 C3 14 01 BF 15 01 C0 15' - '01 3F 16 01 3F 16 01 B6 16 01 B7 16 01 2B 17 01 2B 17 01 39 18 01 3A 18 01 3D 19 01 3E 19 01 43' - '19 01 43 19 01 E0 19 01 E0 19 01 34 1A 01 34 1A 01 47 1A 01 47 1A 01 99 1A 01 99 1A 01 3F 1C 01' - '3F 1C 01 42 1D 01 42 1D 01 44 1D 01 45 1D 01 97 1D 01 97 1D 01 F0 6A 01 F4 6A 01 30 6B 01 36 6B' - '01 8F 6F 01 9F 6F 01 F0 6F 01 F1 6F 01 67 D1 01 69 D1 01 6D D1 01 72 D1 01 7B D1 01 82 D1 01 85' - 'D1 01 8B D1 01 AA D1 01 AD D1 01 30 E1 01 36 E1 01 EC E2 01 EF E2 01 D0 E8 01 D6 E8 01 44 E9 01' - '46 E9 01 48 E9 01 4A E9 01 3F 20 00 00 00 B7 00 00 B7 00 00 D0 02 00 D1 02 00 40 06 00 40 06 00' - 'FA 07 00 FA 07 00 55 0B 00 55 0B 00 46 0E 00 46 0E 00 C6 0E 00 C6 0E 00 0A 18 00 0A 18 00 43 18' - '00 43 18 00 A7 1A 00 A7 1A 00 36 1C 00 36 1C 00 7B 1C 00 7B 1C 00 05 30 00 05 30 00 31 30 00 35' - '30 00 9D 30 00 9E 30 00 FC 30 00 FE 30 00 15 A0 00 15 A0 00 0C A6 00 0C A6 00 CF A9 00 CF A9 00' - 'E6 A9 00 E6 A9 00 70 AA 00 70 AA 00 DD AA 00 DD AA 00 F3 AA 00 F4 AA 00 70 FF 00 70 FF 00 5D 13' - '01 5D 13 01 C6 15 01 C8 15 01 98 1A 01 98 1A 01 42 6B 01 43 6B 01 E0 6F 01 E1 6F 01 E3 6F 01 E3' - '6F 01 3C E1 01 3D E1 01 44 E9 01 46 E9 01 40 0A 00 00 00 2D 00 00 2D 00 00 AD 00 00 AD 00 00 8A' - '05 00 8A 05 00 06 18 00 06 18 00 10 20 00 11 20 00 17 2E 00 17 2E 00 FB 30 00 FB 30 00 63 FE 00' - '63 FE 00 0D FF 00 0D FF 00 65 FF 00 65 FF 00 41 13 00 00 00 06 30 00 07 30 00 21 30 00 29 30 00' - '38 30 00 3A 30 00 00 34 00 BF 4D 00 00 4E 00 FC 9F 00 00 F9 00 6D FA 00 70 FA 00 D9 FA 00 E4 6F' - '01 E4 6F 01 00 70 01 F7 87 01 00 88 01 D5 8C 01 00 8D 01 08 8D 01 70 B1 01 FB B2 01 00 00 02 DD' - 'A6 02 00 A7 02 34 B7 02 40 B7 02 1D B8 02 20 B8 02 A1 CE 02 B0 CE 02 E0 EB 02 00 F8 02 1D FA 02' - '00 00 03 4A 13 03 42 02 00 00 00 F0 2F 00 F1 2F 00 F4 2F 00 FB 2F 00 43 01 00 00 00 F2 2F 00 F3' - '2F 00 44 01 00 00 00 0C 20 00 0D 20 00 45 07 00 00 00 40 0E 00 44 0E 00 C0 0E 00 C4 0E 00 B5 19' - '00 B7 19 00 BA 19 00 BA 19 00 B5 AA 00 B6 AA 00 B9 AA 00 B9 AA 00 BB AA 00 BC AA 00 46 12 00 00' - '00 D0 FD 00 EF FD 00 FE FF 00 FF FF 00 FE FF 01 FF FF 01 FE FF 02 FF FF 02 FE FF 03 FF FF 03 FE' - 'FF 04 FF FF 04 FE FF 05 FF FF 05 FE FF 06 FF FF 06 FE FF 07 FF FF 07 FE FF 08 FF FF 08 FE FF 09' - 'FF FF 09 FE FF 0A FF FF 0A FE FF 0B FF FF 0B FE FF 0C FF FF 0C FE FF 0D FF FF 0D FE FF 0E FF FF' - '0E FE FF 0F FF FF 0F FE FF 10 FF FF 10 47 E6 00 00 00 45 03 00 45 03 00 B0 05 00 BD 05 00 BF 05' - '00 BF 05 00 C1 05 00 C2 05 00 C4 05 00 C5 05 00 C7 05 00 C7 05 00 10 06 00 1A 06 00 4B 06 00 57' - '06 00 59 06 00 5F 06 00 70 06 00 70 06 00 D6 06 00 DC 06 00 E1 06 00 E4 06 00 E7 06 00 E8 06 00' - 'ED 06 00 ED 06 00 11 07 00 11 07 00 30 07 00 3F 07 00 A6 07 00 B0 07 00 16 08 00 17 08 00 1B 08' - '00 23 08 00 25 08 00 27 08 00 29 08 00 2C 08 00 D4 08 00 DF 08 00 E3 08 00 E9 08 00 F0 08 00 03' - '09 00 3A 09 00 3B 09 00 3E 09 00 4C 09 00 4E 09 00 4F 09 00 55 09 00 57 09 00 62 09 00 63 09 00' - '81 09 00 83 09 00 BE 09 00 C4 09 00 C7 09 00 C8 09 00 CB 09 00 CC 09 00 D7 09 00 D7 09 00 E2 09' - '00 E3 09 00 01 0A 00 03 0A 00 3E 0A 00 42 0A 00 47 0A 00 48 0A 00 4B 0A 00 4C 0A 00 51 0A 00 51' - '0A 00 70 0A 00 71 0A 00 75 0A 00 75 0A 00 81 0A 00 83 0A 00 BE 0A 00 C5 0A 00 C7 0A 00 C9 0A 00' - 'CB 0A 00 CC 0A 00 E2 0A 00 E3 0A 00 FA 0A 00 FC 0A 00 01 0B 00 03 0B 00 3E 0B 00 44 0B 00 47 0B' - '00 48 0B 00 4B 0B 00 4C 0B 00 56 0B 00 57 0B 00 62 0B 00 63 0B 00 82 0B 00 82 0B 00 BE 0B 00 C2' - '0B 00 C6 0B 00 C8 0B 00 CA 0B 00 CC 0B 00 D7 0B 00 D7 0B 00 00 0C 00 03 0C 00 3E 0C 00 44 0C 00' - '46 0C 00 48 0C 00 4A 0C 00 4C 0C 00 55 0C 00 56 0C 00 62 0C 00 63 0C 00 81 0C 00 83 0C 00 BE 0C' - '00 C4 0C 00 C6 0C 00 C8 0C 00 CA 0C 00 CC 0C 00 D5 0C 00 D6 0C 00 E2 0C 00 E3 0C 00 00 0D 00 03' - '0D 00 3E 0D 00 44 0D 00 46 0D 00 48 0D 00 4A 0D 00 4C 0D 00 57 0D 00 57 0D 00 62 0D 00 63 0D 00' - '81 0D 00 83 0D 00 CF 0D 00 D4 0D 00 D6 0D 00 D6 0D 00 D8 0D 00 DF 0D 00 F2 0D 00 F3 0D 00 31 0E' - '00 31 0E 00 34 0E 00 3A 0E 00 4D 0E 00 4D 0E 00 B1 0E 00 B1 0E 00 B4 0E 00 B9 0E 00 BB 0E 00 BC' - '0E 00 CD 0E 00 CD 0E 00 71 0F 00 81 0F 00 8D 0F 00 97 0F 00 99 0F 00 BC 0F 00 2B 10 00 36 10 00' - '38 10 00 38 10 00 3B 10 00 3E 10 00 56 10 00 59 10 00 5E 10 00 60 10 00 62 10 00 64 10 00 67 10' - '00 6D 10 00 71 10 00 74 10 00 82 10 00 8D 10 00 8F 10 00 8F 10 00 9A 10 00 9D 10 00 12 17 00 13' - '17 00 32 17 00 33 17 00 52 17 00 53 17 00 72 17 00 73 17 00 B6 17 00 C8 17 00 85 18 00 86 18 00' - 'A9 18 00 A9 18 00 20 19 00 2B 19 00 30 19 00 38 19 00 17 1A 00 1B 1A 00 55 1A 00 5E 1A 00 61 1A' - '00 74 1A 00 BF 1A 00 C0 1A 00 00 1B 00 04 1B 00 35 1B 00 43 1B 00 80 1B 00 82 1B 00 A1 1B 00 A9' - '1B 00 AC 1B 00 AD 1B 00 E7 1B 00 F1 1B 00 24 1C 00 36 1C 00 E7 1D 00 F4 1D 00 B6 24 00 E9 24 00' - 'E0 2D 00 FF 2D 00 74 A6 00 7B A6 00 9E A6 00 9F A6 00 02 A8 00 02 A8 00 0B A8 00 0B A8 00 23 A8' - '00 27 A8 00 80 A8 00 81 A8 00 B4 A8 00 C3 A8 00 C5 A8 00 C5 A8 00 FF A8 00 FF A8 00 26 A9 00 2A' - 'A9 00 47 A9 00 52 A9 00 80 A9 00 83 A9 00 B4 A9 00 BF A9 00 E5 A9 00 E5 A9 00 29 AA 00 36 AA 00' - '43 AA 00 43 AA 00 4C AA 00 4D AA 00 7B AA 00 7D AA 00 B0 AA 00 B0 AA 00 B2 AA 00 B4 AA 00 B7 AA' - '00 B8 AA 00 BE AA 00 BE AA 00 EB AA 00 EF AA 00 F5 AA 00 F5 AA 00 E3 AB 00 EA AB 00 1E FB 00 1E' - 'FB 00 76 03 01 7A 03 01 01 0A 01 03 0A 01 05 0A 01 06 0A 01 0C 0A 01 0F 0A 01 24 0D 01 27 0D 01' - 'AB 0E 01 AC 0E 01 00 10 01 02 10 01 38 10 01 45 10 01 82 10 01 82 10 01 B0 10 01 B8 10 01 00 11' - '01 02 11 01 27 11 01 32 11 01 45 11 01 46 11 01 80 11 01 82 11 01 B3 11 01 BF 11 01 CE 11 01 CF' - '11 01 2C 12 01 34 12 01 37 12 01 37 12 01 3E 12 01 3E 12 01 DF 12 01 E8 12 01 00 13 01 03 13 01' - '3E 13 01 44 13 01 47 13 01 48 13 01 4B 13 01 4C 13 01 57 13 01 57 13 01 62 13 01 63 13 01 35 14' - '01 41 14 01 43 14 01 45 14 01 B0 14 01 C1 14 01 AF 15 01 B5 15 01 B8 15 01 BE 15 01 DC 15 01 DD' - '15 01 30 16 01 3E 16 01 40 16 01 40 16 01 AB 16 01 B5 16 01 1D 17 01 2A 17 01 2C 18 01 38 18 01' - '30 19 01 35 19 01 37 19 01 38 19 01 3B 19 01 3C 19 01 40 19 01 40 19 01 42 19 01 42 19 01 D1 19' - '01 D7 19 01 DA 19 01 DF 19 01 E4 19 01 E4 19 01 01 1A 01 0A 1A 01 35 1A 01 39 1A 01 3B 1A 01 3E' - '1A 01 51 1A 01 5B 1A 01 8A 1A 01 97 1A 01 2F 1C 01 36 1C 01 38 1C 01 3E 1C 01 92 1C 01 A7 1C 01' - 'A9 1C 01 B6 1C 01 31 1D 01 36 1D 01 3A 1D 01 3A 1D 01 3C 1D 01 3D 1D 01 3F 1D 01 41 1D 01 43 1D' - '01 43 1D 01 47 1D 01 47 1D 01 8A 1D 01 8E 1D 01 90 1D 01 91 1D 01 93 1D 01 96 1D 01 F3 1E 01 F6' - '1E 01 4F 6F 01 4F 6F 01 51 6F 01 87 6F 01 8F 6F 01 92 6F 01 F0 6F 01 F1 6F 01 9E BC 01 9E BC 01' - '00 E0 01 06 E0 01 08 E0 01 18 E0 01 1B E0 01 21 E0 01 23 E0 01 24 E0 01 26 E0 01 2A E0 01 47 E9' - '01 47 E9 01 30 F1 01 49 F1 01 50 F1 01 69 F1 01 70 F1 01 89 F1 01 48 0B 00 00 00 4F 03 00 4F 03' - '00 5F 11 00 60 11 00 B4 17 00 B5 17 00 65 20 00 65 20 00 64 31 00 64 31 00 A0 FF 00 A0 FF 00 F0' - 'FF 00 F8 FF 00 00 00 0E 00 00 0E 02 00 0E 1F 00 0E 80 00 0E FF 00 0E F0 01 0E FF 0F 0E 49 19 00' - '00 00 BE 09 00 BE 09 00 D7 09 00 D7 09 00 3E 0B 00 3E 0B 00 57 0B 00 57 0B 00 BE 0B 00 BE 0B 00' - 'D7 0B 00 D7 0B 00 C2 0C 00 C2 0C 00 D5 0C 00 D6 0C 00 3E 0D 00 3E 0D 00 57 0D 00 57 0D 00 CF 0D' - '00 CF 0D 00 DF 0D 00 DF 0D 00 35 1B 00 35 1B 00 0C 20 00 0C 20 00 2E 30 00 2F 30 00 9E FF 00 9F' - 'FF 00 3E 13 01 3E 13 01 57 13 01 57 13 01 B0 14 01 B0 14 01 BD 14 01 BD 14 01 AF 15 01 AF 15 01' - '30 19 01 30 19 01 65 D1 01 65 D1 01 6E D1 01 72 D1 01 20 00 0E 7F 00 0E 4A 04 00 00 00 B7 00 00' - 'B7 00 00 87 03 00 87 03 00 69 13 00 71 13 00 DA 19 00 DA 19 00 4B 04 00 00 00 85 18 00 86 18 00' - '18 21 00 18 21 00 2E 21 00 2E 21 00 9B 30 00 9C 30 00 4C 14 00 00 00 AA 00 00 AA 00 00 BA 00 00' - 'BA 00 00 B0 02 00 B8 02 00 C0 02 00 C1 02 00 E0 02 00 E4 02 00 45 03 00 45 03 00 7A 03 00 7A 03' - '00 2C 1D 00 6A 1D 00 78 1D 00 78 1D 00 9B 1D 00 BF 1D 00 71 20 00 71 20 00 7F 20 00 7F 20 00 90' - '20 00 9C 20 00 70 21 00 7F 21 00 D0 24 00 E9 24 00 7C 2C 00 7D 2C 00 9C A6 00 9D A6 00 70 A7 00' - '70 A7 00 F8 A7 00 F9 A7 00 5C AB 00 5F AB 00 4D 86 00 00 00 5E 00 00 5E 00 00 D0 03 00 D2 03 00' - 'D5 03 00 D5 03 00 F0 03 00 F1 03 00 F4 03 00 F5 03 00 16 20 00 16 20 00 32 20 00 34 20 00 40 20' - '00 40 20 00 61 20 00 64 20 00 7D 20 00 7E 20 00 8D 20 00 8E 20 00 D0 20 00 DC 20 00 E1 20 00 E1' - '20 00 E5 20 00 E6 20 00 EB 20 00 EF 20 00 02 21 00 02 21 00 07 21 00 07 21 00 0A 21 00 13 21 00' - '15 21 00 15 21 00 19 21 00 1D 21 00 24 21 00 24 21 00 28 21 00 29 21 00 2C 21 00 2D 21 00 2F 21' - '00 31 21 00 33 21 00 38 21 00 3C 21 00 3F 21 00 45 21 00 49 21 00 95 21 00 99 21 00 9C 21 00 9F' - '21 00 A1 21 00 A2 21 00 A4 21 00 A5 21 00 A7 21 00 A7 21 00 A9 21 00 AD 21 00 B0 21 00 B1 21 00' - 'B6 21 00 B7 21 00 BC 21 00 CD 21 00 D0 21 00 D1 21 00 D3 21 00 D3 21 00 D5 21 00 DB 21 00 DD 21' - '00 DD 21 00 E4 21 00 E5 21 00 08 23 00 0B 23 00 B4 23 00 B5 23 00 B7 23 00 B7 23 00 D0 23 00 D0' - '23 00 E2 23 00 E2 23 00 A0 25 00 A1 25 00 AE 25 00 B6 25 00 BC 25 00 C0 25 00 C6 25 00 C7 25 00' - 'CA 25 00 CB 25 00 CF 25 00 D3 25 00 E2 25 00 E2 25 00 E4 25 00 E4 25 00 E7 25 00 EC 25 00 05 26' - '00 06 26 00 40 26 00 40 26 00 42 26 00 42 26 00 60 26 00 63 26 00 6D 26 00 6E 26 00 C5 27 00 C6' - '27 00 E6 27 00 EF 27 00 83 29 00 98 29 00 D8 29 00 DB 29 00 FC 29 00 FD 29 00 61 FE 00 61 FE 00' - '63 FE 00 63 FE 00 68 FE 00 68 FE 00 3C FF 00 3C FF 00 3E FF 00 3E FF 00 00 D4 01 54 D4 01 56 D4' - '01 9C D4 01 9E D4 01 9F D4 01 A2 D4 01 A2 D4 01 A5 D4 01 A6 D4 01 A9 D4 01 AC D4 01 AE D4 01 B9' - 'D4 01 BB D4 01 BB D4 01 BD D4 01 C3 D4 01 C5 D4 01 05 D5 01 07 D5 01 0A D5 01 0D D5 01 14 D5 01' - '16 D5 01 1C D5 01 1E D5 01 39 D5 01 3B D5 01 3E D5 01 40 D5 01 44 D5 01 46 D5 01 46 D5 01 4A D5' - '01 50 D5 01 52 D5 01 A5 D6 01 A8 D6 01 C0 D6 01 C2 D6 01 DA D6 01 DC D6 01 FA D6 01 FC D6 01 14' - 'D7 01 16 D7 01 34 D7 01 36 D7 01 4E D7 01 50 D7 01 6E D7 01 70 D7 01 88 D7 01 8A D7 01 A8 D7 01' - 'AA D7 01 C2 D7 01 C4 D7 01 CB D7 01 CE D7 01 FF D7 01 00 EE 01 03 EE 01 05 EE 01 1F EE 01 21 EE' - '01 22 EE 01 24 EE 01 24 EE 01 27 EE 01 27 EE 01 29 EE 01 32 EE 01 34 EE 01 37 EE 01 39 EE 01 39' - 'EE 01 3B EE 01 3B EE 01 42 EE 01 42 EE 01 47 EE 01 47 EE 01 49 EE 01 49 EE 01 4B EE 01 4B EE 01' - '4D EE 01 4F EE 01 51 EE 01 52 EE 01 54 EE 01 54 EE 01 57 EE 01 57 EE 01 59 EE 01 59 EE 01 5B EE' - '01 5B EE 01 5D EE 01 5D EE 01 5F EE 01 5F EE 01 61 EE 01 62 EE 01 64 EE 01 64 EE 01 67 EE 01 6A' - 'EE 01 6C EE 01 72 EE 01 74 EE 01 77 EE 01 79 EE 01 7C EE 01 7E EE 01 7E EE 01 80 EE 01 89 EE 01' - '8B EE 01 9B EE 01 A1 EE 01 A3 EE 01 A5 EE 01 A9 EE 01 AB EE 01 BB EE 01 4E 05 00 00 00 60 21 00' - '6F 21 00 B6 24 00 CF 24 00 30 F1 01 49 F1 01 50 F1 01 69 F1 01 70 F1 01 89 F1 01 4F 1C 00 00 00' - '21 00 00 2F 00 00 3A 00 00 40 00 00 5B 00 00 5E 00 00 60 00 00 60 00 00 7B 00 00 7E 00 00 A1 00' - '00 A7 00 00 A9 00 00 A9 00 00 AB 00 00 AC 00 00 AE 00 00 AE 00 00 B0 00 00 B1 00 00 B6 00 00 B6' - '00 00 BB 00 00 BB 00 00 BF 00 00 BF 00 00 D7 00 00 D7 00 00 F7 00 00 F7 00 00 10 20 00 27 20 00' - '30 20 00 3E 20 00 41 20 00 53 20 00 55 20 00 5E 20 00 90 21 00 5F 24 00 00 25 00 75 27 00 94 27' - '00 FF 2B 00 00 2E 00 7F 2E 00 01 30 00 03 30 00 08 30 00 20 30 00 30 30 00 30 30 00 3E FD 00 3F' - 'FD 00 45 FE 00 46 FE 00 50 05 00 00 00 09 00 00 0D 00 00 20 00 00 20 00 00 85 00 00 85 00 00 0E' - '20 00 0F 20 00 28 20 00 29 20 00 51 03 00 00 00 80 2E 00 99 2E 00 9B 2E 00 F3 2E 00 00 2F 00 D5' - '2F 00 52 1F 00 00 00 69 00 00 6A 00 00 2F 01 00 2F 01 00 49 02 00 49 02 00 68 02 00 68 02 00 9D' - '02 00 9D 02 00 B2 02 00 B2 02 00 F3 03 00 F3 03 00 56 04 00 56 04 00 58 04 00 58 04 00 62 1D 00' - '62 1D 00 96 1D 00 96 1D 00 A4 1D 00 A4 1D 00 A8 1D 00 A8 1D 00 2D 1E 00 2D 1E 00 CB 1E 00 CB 1E' - '00 71 20 00 71 20 00 48 21 00 49 21 00 7C 2C 00 7C 2C 00 22 D4 01 23 D4 01 56 D4 01 57 D4 01 8A' - 'D4 01 8B D4 01 BE D4 01 BF D4 01 F2 D4 01 F3 D4 01 26 D5 01 27 D5 01 5A D5 01 5B D5 01 8E D5 01' - '8F D5 01 C2 D5 01 C3 D5 01 F6 D5 01 F7 D5 01 2A D6 01 2B D6 01 5E D6 01 5F D6 01 92 D6 01 93 D6' - '01 54 68 00 00 00 21 00 00 21 00 00 2C 00 00 2C 00 00 2E 00 00 2E 00 00 3A 00 00 3B 00 00 3F 00' - '00 3F 00 00 7E 03 00 7E 03 00 87 03 00 87 03 00 89 05 00 89 05 00 C3 05 00 C3 05 00 0C 06 00 0C' - '06 00 1B 06 00 1B 06 00 1E 06 00 1F 06 00 D4 06 00 D4 06 00 00 07 00 0A 07 00 0C 07 00 0C 07 00' - 'F8 07 00 F9 07 00 30 08 00 3E 08 00 5E 08 00 5E 08 00 64 09 00 65 09 00 5A 0E 00 5B 0E 00 08 0F' - '00 08 0F 00 0D 0F 00 12 0F 00 4A 10 00 4B 10 00 61 13 00 68 13 00 6E 16 00 6E 16 00 EB 16 00 ED' - '16 00 35 17 00 36 17 00 D4 17 00 D6 17 00 DA 17 00 DA 17 00 02 18 00 05 18 00 08 18 00 09 18 00' - '44 19 00 45 19 00 A8 1A 00 AB 1A 00 5A 1B 00 5B 1B 00 5D 1B 00 5F 1B 00 3B 1C 00 3F 1C 00 7E 1C' - '00 7F 1C 00 3C 20 00 3D 20 00 47 20 00 49 20 00 2E 2E 00 2E 2E 00 3C 2E 00 3C 2E 00 41 2E 00 41' - '2E 00 4C 2E 00 4C 2E 00 4E 2E 00 4F 2E 00 01 30 00 02 30 00 FE A4 00 FF A4 00 0D A6 00 0F A6 00' - 'F3 A6 00 F7 A6 00 76 A8 00 77 A8 00 CE A8 00 CF A8 00 2F A9 00 2F A9 00 C7 A9 00 C9 A9 00 5D AA' - '00 5F AA 00 DF AA 00 DF AA 00 F0 AA 00 F1 AA 00 EB AB 00 EB AB 00 50 FE 00 52 FE 00 54 FE 00 57' - 'FE 00 01 FF 00 01 FF 00 0C FF 00 0C FF 00 0E FF 00 0E FF 00 1A FF 00 1B FF 00 1F FF 00 1F FF 00' - '61 FF 00 61 FF 00 64 FF 00 64 FF 00 9F 03 01 9F 03 01 D0 03 01 D0 03 01 57 08 01 57 08 01 1F 09' - '01 1F 09 01 56 0A 01 57 0A 01 F0 0A 01 F5 0A 01 3A 0B 01 3F 0B 01 99 0B 01 9C 0B 01 55 0F 01 59' - '0F 01 47 10 01 4D 10 01 BE 10 01 C1 10 01 41 11 01 43 11 01 C5 11 01 C6 11 01 CD 11 01 CD 11 01' - 'DE 11 01 DF 11 01 38 12 01 3C 12 01 A9 12 01 A9 12 01 4B 14 01 4D 14 01 5A 14 01 5B 14 01 C2 15' - '01 C5 15 01 C9 15 01 D7 15 01 41 16 01 42 16 01 3C 17 01 3E 17 01 44 19 01 44 19 01 46 19 01 46' - '19 01 42 1A 01 43 1A 01 9B 1A 01 9C 1A 01 A1 1A 01 A2 1A 01 41 1C 01 43 1C 01 71 1C 01 71 1C 01' - 'F7 1E 01 F8 1E 01 70 24 01 74 24 01 6E 6A 01 6F 6A 01 F5 6A 01 F5 6A 01 37 6B 01 39 6B 01 44 6B' - '01 44 6B 01 97 6E 01 98 6E 01 9F BC 01 9F BC 01 87 DA 01 8A DA 01 55 0F 00 00 00 00 34 00 BF 4D' - '00 00 4E 00 FC 9F 00 0E FA 00 0F FA 00 11 FA 00 11 FA 00 13 FA 00 14 FA 00 1F FA 00 1F FA 00 21' - 'FA 00 21 FA 00 23 FA 00 24 FA 00 27 FA 00 29 FA 00 00 00 02 DD A6 02 00 A7 02 34 B7 02 40 B7 02' - '1D B8 02 20 B8 02 A1 CE 02 B0 CE 02 E0 EB 02 00 00 03 4A 13 03 56 03 00 00 00 0B 18 00 0D 18 00' - '00 FE 00 0F FE 00 00 01 0E EF 01 0E 57 4C 00 00 00 21 00 00 21 00 00 2E 00 00 2E 00 00 3F 00 00' - '3F 00 00 89 05 00 89 05 00 1E 06 00 1F 06 00 D4 06 00 D4 06 00 00 07 00 02 07 00 F9 07 00 F9 07' - '00 37 08 00 37 08 00 39 08 00 39 08 00 3D 08 00 3E 08 00 64 09 00 65 09 00 4A 10 00 4B 10 00 62' - '13 00 62 13 00 67 13 00 68 13 00 6E 16 00 6E 16 00 35 17 00 36 17 00 03 18 00 03 18 00 09 18 00' - '09 18 00 44 19 00 45 19 00 A8 1A 00 AB 1A 00 5A 1B 00 5B 1B 00 5E 1B 00 5F 1B 00 3B 1C 00 3C 1C' - '00 7E 1C 00 7F 1C 00 3C 20 00 3D 20 00 47 20 00 49 20 00 2E 2E 00 2E 2E 00 3C 2E 00 3C 2E 00 02' - '30 00 02 30 00 FF A4 00 FF A4 00 0E A6 00 0F A6 00 F3 A6 00 F3 A6 00 F7 A6 00 F7 A6 00 76 A8 00' - '77 A8 00 CE A8 00 CF A8 00 2F A9 00 2F A9 00 C8 A9 00 C9 A9 00 5D AA 00 5F AA 00 F0 AA 00 F1 AA' - '00 EB AB 00 EB AB 00 52 FE 00 52 FE 00 56 FE 00 57 FE 00 01 FF 00 01 FF 00 0E FF 00 0E FF 00 1F' - 'FF 00 1F FF 00 61 FF 00 61 FF 00 56 0A 01 57 0A 01 55 0F 01 59 0F 01 47 10 01 48 10 01 BE 10 01' - 'C1 10 01 41 11 01 43 11 01 C5 11 01 C6 11 01 CD 11 01 CD 11 01 DE 11 01 DF 11 01 38 12 01 39 12' - '01 3B 12 01 3C 12 01 A9 12 01 A9 12 01 4B 14 01 4C 14 01 C2 15 01 C3 15 01 C9 15 01 D7 15 01 41' - '16 01 42 16 01 3C 17 01 3E 17 01 44 19 01 44 19 01 46 19 01 46 19 01 42 1A 01 43 1A 01 9B 1A 01' - '9C 1A 01 41 1C 01 42 1C 01 F7 1E 01 F8 1E 01 6E 6A 01 6F 6A 01 F5 6A 01 F5 6A 01 37 6B 01 38 6B' - '01 44 6B 01 44 6B 01 98 6E 01 98 6E 01 9F BC 01 9F BC 01 88 DA 01 88 DA 01 58 06 00 00 00 00 06' - '00 05 06 00 DD 06 00 DD 06 00 0F 07 00 0F 07 00 E2 08 00 E2 08 00 BD 10 01 BD 10 01 CD 10 01 CD' - '10 01 59 01 00 00 00 E6 F1 01 FF F1 01' -} - - -LANGUAGE 0,0 CASE UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE -{ - '20 0B 00 00 41 00 00 01 61 00 00 01 61 00 00 00 00 42 00 00 01 62 00 00 01 62 00 00 00 00 43 00' - '00 01 63 00 00 01 63 00 00 00 00 44 00 00 01 64 00 00 01 64 00 00 00 00 45 00 00 01 65 00 00 01' - '65 00 00 00 00 46 00 00 01 66 00 00 01 66 00 00 00 00 47 00 00 01 67 00 00 01 67 00 00 00 00 48' - '00 00 01 68 00 00 01 68 00 00 00 00 49 00 00 01 69 00 00 01 69 00 00 01 49 00 00 01 49 00 00 4A' - '00 00 01 6A 00 00 01 6A 00 00 01 4A 00 00 01 4A 00 00 4B 00 00 01 6B 00 00 01 6B 00 00 00 00 4C' - '00 00 01 6C 00 00 01 6C 00 00 00 00 4D 00 00 01 6D 00 00 01 6D 00 00 00 00 4E 00 00 01 6E 00 00' - '01 6E 00 00 00 00 4F 00 00 01 6F 00 00 01 6F 00 00 00 00 50 00 00 01 70 00 00 01 70 00 00 00 00' - '51 00 00 01 71 00 00 01 71 00 00 00 00 52 00 00 01 72 00 00 01 72 00 00 00 00 53 00 00 01 73 00' - '00 01 73 00 00 00 00 54 00 00 01 74 00 00 01 74 00 00 00 00 55 00 00 01 75 00 00 01 75 00 00 00' - '00 56 00 00 01 76 00 00 01 76 00 00 00 00 57 00 00 01 77 00 00 01 77 00 00 00 00 58 00 00 01 78' - '00 00 01 78 00 00 00 00 59 00 00 01 79 00 00 01 79 00 00 00 00 5A 00 00 01 7A 00 00 01 7A 00 00' - '00 00 61 00 00 00 00 01 41 00 00 01 41 00 00 62 00 00 00 00 01 42 00 00 01 42 00 00 63 00 00 00' - '00 01 43 00 00 01 43 00 00 64 00 00 00 00 01 44 00 00 01 44 00 00 65 00 00 00 00 01 45 00 00 01' - '45 00 00 66 00 00 00 00 01 46 00 00 01 46 00 00 67 00 00 00 00 01 47 00 00 01 47 00 00 68 00 00' - '00 00 01 48 00 00 01 48 00 00 69 00 00 00 01 69 00 00 01 49 00 00 01 49 00 00 6A 00 00 00 00 01' - '4A 00 00 01 4A 00 00 6B 00 00 00 00 01 4B 00 00 01 4B 00 00 6C 00 00 00 00 01 4C 00 00 01 4C 00' - '00 6D 00 00 00 00 01 4D 00 00 01 4D 00 00 6E 00 00 00 00 01 4E 00 00 01 4E 00 00 6F 00 00 00 00' - '01 4F 00 00 01 4F 00 00 70 00 00 00 00 01 50 00 00 01 50 00 00 71 00 00 00 00 01 51 00 00 01 51' - '00 00 72 00 00 00 00 01 52 00 00 01 52 00 00 73 00 00 00 00 01 53 00 00 01 53 00 00 74 00 00 00' - '00 01 54 00 00 01 54 00 00 75 00 00 00 00 01 55 00 00 01 55 00 00 76 00 00 00 00 01 56 00 00 01' - '56 00 00 77 00 00 00 00 01 57 00 00 01 57 00 00 78 00 00 00 00 01 58 00 00 01 58 00 00 79 00 00' - '00 00 01 59 00 00 01 59 00 00 7A 00 00 00 00 01 5A 00 00 01 5A 00 00 B5 00 00 01 BC 03 00 00 01' - '9C 03 00 01 9C 03 00 C0 00 00 01 E0 00 00 01 E0 00 00 00 00 C1 00 00 01 E1 00 00 01 E1 00 00 00' - '00 C2 00 00 01 E2 00 00 01 E2 00 00 00 00 C3 00 00 01 E3 00 00 01 E3 00 00 00 00 C4 00 00 01 E4' - '00 00 01 E4 00 00 00 00 C5 00 00 01 E5 00 00 01 E5 00 00 00 00 C6 00 00 01 E6 00 00 01 E6 00 00' - '00 00 C7 00 00 01 E7 00 00 01 E7 00 00 00 00 C8 00 00 01 E8 00 00 01 E8 00 00 00 00 C9 00 00 01' - 'E9 00 00 01 E9 00 00 00 00 CA 00 00 01 EA 00 00 01 EA 00 00 00 00 CB 00 00 01 EB 00 00 01 EB 00' - '00 00 00 CC 00 00 01 EC 00 00 01 EC 00 00 01 CC 00 00 01 CC 00 00 CD 00 00 01 ED 00 00 01 ED 00' - '00 01 CD 00 00 01 CD 00 00 CE 00 00 01 EE 00 00 01 EE 00 00 00 00 CF 00 00 01 EF 00 00 01 EF 00' - '00 00 00 D0 00 00 01 F0 00 00 01 F0 00 00 00 00 D1 00 00 01 F1 00 00 01 F1 00 00 00 00 D2 00 00' - '01 F2 00 00 01 F2 00 00 00 00 D3 00 00 01 F3 00 00 01 F3 00 00 00 00 D4 00 00 01 F4 00 00 01 F4' - '00 00 00 00 D5 00 00 01 F5 00 00 01 F5 00 00 00 00 D6 00 00 01 F6 00 00 01 F6 00 00 00 00 D8 00' - '00 01 F8 00 00 01 F8 00 00 00 00 D9 00 00 01 F9 00 00 01 F9 00 00 00 00 DA 00 00 01 FA 00 00 01' - 'FA 00 00 00 00 DB 00 00 01 FB 00 00 01 FB 00 00 00 00 DC 00 00 01 FC 00 00 01 FC 00 00 00 00 DD' - '00 00 01 FD 00 00 01 FD 00 00 00 00 DE 00 00 01 FE 00 00 01 FE 00 00 00 00 DF 00 00 02 73 00 00' - '73 00 00 01 DF 00 00 02 53 00 00 73 00 00 02 53 00 00 53 00 00 E0 00 00 00 00 01 C0 00 00 01 C0' - '00 00 E1 00 00 00 00 01 C1 00 00 01 C1 00 00 E2 00 00 00 00 01 C2 00 00 01 C2 00 00 E3 00 00 00' - '00 01 C3 00 00 01 C3 00 00 E4 00 00 00 00 01 C4 00 00 01 C4 00 00 E5 00 00 00 00 01 C5 00 00 01' - 'C5 00 00 E6 00 00 00 00 01 C6 00 00 01 C6 00 00 E7 00 00 00 00 01 C7 00 00 01 C7 00 00 E8 00 00' - '00 00 01 C8 00 00 01 C8 00 00 E9 00 00 00 00 01 C9 00 00 01 C9 00 00 EA 00 00 00 00 01 CA 00 00' - '01 CA 00 00 EB 00 00 00 00 01 CB 00 00 01 CB 00 00 EC 00 00 00 00 01 CC 00 00 01 CC 00 00 ED 00' - '00 00 00 01 CD 00 00 01 CD 00 00 EE 00 00 00 00 01 CE 00 00 01 CE 00 00 EF 00 00 00 00 01 CF 00' - '00 01 CF 00 00 F0 00 00 00 00 01 D0 00 00 01 D0 00 00 F1 00 00 00 00 01 D1 00 00 01 D1 00 00 F2' - '00 00 00 00 01 D2 00 00 01 D2 00 00 F3 00 00 00 00 01 D3 00 00 01 D3 00 00 F4 00 00 00 00 01 D4' - '00 00 01 D4 00 00 F5 00 00 00 00 01 D5 00 00 01 D5 00 00 F6 00 00 00 00 01 D6 00 00 01 D6 00 00' - 'F8 00 00 00 00 01 D8 00 00 01 D8 00 00 F9 00 00 00 00 01 D9 00 00 01 D9 00 00 FA 00 00 00 00 01' - 'DA 00 00 01 DA 00 00 FB 00 00 00 00 01 DB 00 00 01 DB 00 00 FC 00 00 00 00 01 DC 00 00 01 DC 00' - '00 FD 00 00 00 00 01 DD 00 00 01 DD 00 00 FE 00 00 00 00 01 DE 00 00 01 DE 00 00 FF 00 00 00 00' - '01 78 01 00 01 78 01 00 00 01 00 01 01 01 00 01 01 01 00 00 00 01 01 00 00 00 01 00 01 00 01 00' - '01 00 02 01 00 01 03 01 00 01 03 01 00 00 00 03 01 00 00 00 01 02 01 00 01 02 01 00 04 01 00 01' - '05 01 00 01 05 01 00 00 00 05 01 00 00 00 01 04 01 00 01 04 01 00 06 01 00 01 07 01 00 01 07 01' - '00 00 00 07 01 00 00 00 01 06 01 00 01 06 01 00 08 01 00 01 09 01 00 01 09 01 00 00 00 09 01 00' - '00 00 01 08 01 00 01 08 01 00 0A 01 00 01 0B 01 00 01 0B 01 00 00 00 0B 01 00 00 00 01 0A 01 00' - '01 0A 01 00 0C 01 00 01 0D 01 00 01 0D 01 00 00 00 0D 01 00 00 00 01 0C 01 00 01 0C 01 00 0E 01' - '00 01 0F 01 00 01 0F 01 00 00 00 0F 01 00 00 00 01 0E 01 00 01 0E 01 00 10 01 00 01 11 01 00 01' - '11 01 00 00 00 11 01 00 00 00 01 10 01 00 01 10 01 00 12 01 00 01 13 01 00 01 13 01 00 00 00 13' - '01 00 00 00 01 12 01 00 01 12 01 00 14 01 00 01 15 01 00 01 15 01 00 00 00 15 01 00 00 00 01 14' - '01 00 01 14 01 00 16 01 00 01 17 01 00 01 17 01 00 00 00 17 01 00 00 00 01 16 01 00 01 16 01 00' - '18 01 00 01 19 01 00 01 19 01 00 00 00 19 01 00 00 00 01 18 01 00 01 18 01 00 1A 01 00 01 1B 01' - '00 01 1B 01 00 00 00 1B 01 00 00 00 01 1A 01 00 01 1A 01 00 1C 01 00 01 1D 01 00 01 1D 01 00 00' - '00 1D 01 00 00 00 01 1C 01 00 01 1C 01 00 1E 01 00 01 1F 01 00 01 1F 01 00 00 00 1F 01 00 00 00' - '01 1E 01 00 01 1E 01 00 20 01 00 01 21 01 00 01 21 01 00 00 00 21 01 00 00 00 01 20 01 00 01 20' - '01 00 22 01 00 01 23 01 00 01 23 01 00 00 00 23 01 00 00 00 01 22 01 00 01 22 01 00 24 01 00 01' - '25 01 00 01 25 01 00 00 00 25 01 00 00 00 01 24 01 00 01 24 01 00 26 01 00 01 27 01 00 01 27 01' - '00 00 00 27 01 00 00 00 01 26 01 00 01 26 01 00 28 01 00 01 29 01 00 01 29 01 00 01 28 01 00 01' - '28 01 00 29 01 00 00 00 01 28 01 00 01 28 01 00 2A 01 00 01 2B 01 00 01 2B 01 00 00 00 2B 01 00' - '00 00 01 2A 01 00 01 2A 01 00 2C 01 00 01 2D 01 00 01 2D 01 00 00 00 2D 01 00 00 00 01 2C 01 00' - '01 2C 01 00 2E 01 00 01 2F 01 00 01 2F 01 00 01 2E 01 00 01 2E 01 00 2F 01 00 00 00 01 2E 01 00' - '01 2E 01 00 30 01 00 02 69 00 00 07 03 00 01 69 00 00 01 30 01 00 01 30 01 00 31 01 00 00 00 01' - '49 00 00 01 49 00 00 32 01 00 01 33 01 00 01 33 01 00 00 00 33 01 00 00 00 01 32 01 00 01 32 01' - '00 34 01 00 01 35 01 00 01 35 01 00 00 00 35 01 00 00 00 01 34 01 00 01 34 01 00 36 01 00 01 37' - '01 00 01 37 01 00 00 00 37 01 00 00 00 01 36 01 00 01 36 01 00 39 01 00 01 3A 01 00 01 3A 01 00' - '00 00 3A 01 00 00 00 01 39 01 00 01 39 01 00 3B 01 00 01 3C 01 00 01 3C 01 00 00 00 3C 01 00 00' - '00 01 3B 01 00 01 3B 01 00 3D 01 00 01 3E 01 00 01 3E 01 00 00 00 3E 01 00 00 00 01 3D 01 00 01' - '3D 01 00 3F 01 00 01 40 01 00 01 40 01 00 00 00 40 01 00 00 00 01 3F 01 00 01 3F 01 00 41 01 00' - '01 42 01 00 01 42 01 00 00 00 42 01 00 00 00 01 41 01 00 01 41 01 00 43 01 00 01 44 01 00 01 44' - '01 00 00 00 44 01 00 00 00 01 43 01 00 01 43 01 00 45 01 00 01 46 01 00 01 46 01 00 00 00 46 01' - '00 00 00 01 45 01 00 01 45 01 00 47 01 00 01 48 01 00 01 48 01 00 00 00 48 01 00 00 00 01 47 01' - '00 01 47 01 00 49 01 00 02 BC 02 00 6E 00 00 01 49 01 00 02 BC 02 00 4E 00 00 02 BC 02 00 4E 00' - '00 4A 01 00 01 4B 01 00 01 4B 01 00 00 00 4B 01 00 00 00 01 4A 01 00 01 4A 01 00 4C 01 00 01 4D' - '01 00 01 4D 01 00 00 00 4D 01 00 00 00 01 4C 01 00 01 4C 01 00 4E 01 00 01 4F 01 00 01 4F 01 00' - '00 00 4F 01 00 00 00 01 4E 01 00 01 4E 01 00 50 01 00 01 51 01 00 01 51 01 00 00 00 51 01 00 00' - '00 01 50 01 00 01 50 01 00 52 01 00 01 53 01 00 01 53 01 00 00 00 53 01 00 00 00 01 52 01 00 01' - '52 01 00 54 01 00 01 55 01 00 01 55 01 00 00 00 55 01 00 00 00 01 54 01 00 01 54 01 00 56 01 00' - '01 57 01 00 01 57 01 00 00 00 57 01 00 00 00 01 56 01 00 01 56 01 00 58 01 00 01 59 01 00 01 59' - '01 00 00 00 59 01 00 00 00 01 58 01 00 01 58 01 00 5A 01 00 01 5B 01 00 01 5B 01 00 00 00 5B 01' - '00 00 00 01 5A 01 00 01 5A 01 00 5C 01 00 01 5D 01 00 01 5D 01 00 00 00 5D 01 00 00 00 01 5C 01' - '00 01 5C 01 00 5E 01 00 01 5F 01 00 01 5F 01 00 00 00 5F 01 00 00 00 01 5E 01 00 01 5E 01 00 60' - '01 00 01 61 01 00 01 61 01 00 00 00 61 01 00 00 00 01 60 01 00 01 60 01 00 62 01 00 01 63 01 00' - '01 63 01 00 00 00 63 01 00 00 00 01 62 01 00 01 62 01 00 64 01 00 01 65 01 00 01 65 01 00 00 00' - '65 01 00 00 00 01 64 01 00 01 64 01 00 66 01 00 01 67 01 00 01 67 01 00 00 00 67 01 00 00 00 01' - '66 01 00 01 66 01 00 68 01 00 01 69 01 00 01 69 01 00 00 00 69 01 00 00 00 01 68 01 00 01 68 01' - '00 6A 01 00 01 6B 01 00 01 6B 01 00 00 00 6B 01 00 00 00 01 6A 01 00 01 6A 01 00 6C 01 00 01 6D' - '01 00 01 6D 01 00 00 00 6D 01 00 00 00 01 6C 01 00 01 6C 01 00 6E 01 00 01 6F 01 00 01 6F 01 00' - '00 00 6F 01 00 00 00 01 6E 01 00 01 6E 01 00 70 01 00 01 71 01 00 01 71 01 00 00 00 71 01 00 00' - '00 01 70 01 00 01 70 01 00 72 01 00 01 73 01 00 01 73 01 00 00 00 73 01 00 00 00 01 72 01 00 01' - '72 01 00 74 01 00 01 75 01 00 01 75 01 00 00 00 75 01 00 00 00 01 74 01 00 01 74 01 00 76 01 00' - '01 77 01 00 01 77 01 00 00 00 77 01 00 00 00 01 76 01 00 01 76 01 00 78 01 00 01 FF 00 00 01 FF' - '00 00 00 00 79 01 00 01 7A 01 00 01 7A 01 00 00 00 7A 01 00 00 00 01 79 01 00 01 79 01 00 7B 01' - '00 01 7C 01 00 01 7C 01 00 00 00 7C 01 00 00 00 01 7B 01 00 01 7B 01 00 7D 01 00 01 7E 01 00 01' - '7E 01 00 00 00 7E 01 00 00 00 01 7D 01 00 01 7D 01 00 7F 01 00 01 73 00 00 00 01 53 00 00 01 53' - '00 00 80 01 00 00 00 01 43 02 00 01 43 02 00 81 01 00 01 53 02 00 01 53 02 00 00 00 82 01 00 01' - '83 01 00 01 83 01 00 00 00 83 01 00 00 00 01 82 01 00 01 82 01 00 84 01 00 01 85 01 00 01 85 01' - '00 00 00 85 01 00 00 00 01 84 01 00 01 84 01 00 86 01 00 01 54 02 00 01 54 02 00 00 00 87 01 00' - '01 88 01 00 01 88 01 00 00 00 88 01 00 00 00 01 87 01 00 01 87 01 00 89 01 00 01 56 02 00 01 56' - '02 00 00 00 8A 01 00 01 57 02 00 01 57 02 00 00 00 8B 01 00 01 8C 01 00 01 8C 01 00 00 00 8C 01' - '00 00 00 01 8B 01 00 01 8B 01 00 8E 01 00 01 DD 01 00 01 DD 01 00 00 00 8F 01 00 01 59 02 00 01' - '59 02 00 00 00 90 01 00 01 5B 02 00 01 5B 02 00 00 00 91 01 00 01 92 01 00 01 92 01 00 00 00 92' - '01 00 00 00 01 91 01 00 01 91 01 00 93 01 00 01 60 02 00 01 60 02 00 00 00 94 01 00 01 63 02 00' - '01 63 02 00 00 00 95 01 00 00 00 01 F6 01 00 01 F6 01 00 96 01 00 01 69 02 00 01 69 02 00 00 00' - '97 01 00 01 68 02 00 01 68 02 00 00 00 98 01 00 01 99 01 00 01 99 01 00 00 00 99 01 00 00 00 01' - '98 01 00 01 98 01 00 9A 01 00 00 00 01 3D 02 00 01 3D 02 00 9C 01 00 01 6F 02 00 01 6F 02 00 00' - '00 9D 01 00 01 72 02 00 01 72 02 00 00 00 9E 01 00 00 00 01 20 02 00 01 20 02 00 9F 01 00 01 75' - '02 00 01 75 02 00 00 00 A0 01 00 01 A1 01 00 01 A1 01 00 00 00 A1 01 00 00 00 01 A0 01 00 01 A0' - '01 00 A2 01 00 01 A3 01 00 01 A3 01 00 00 00 A3 01 00 00 00 01 A2 01 00 01 A2 01 00 A4 01 00 01' - 'A5 01 00 01 A5 01 00 00 00 A5 01 00 00 00 01 A4 01 00 01 A4 01 00 A6 01 00 01 80 02 00 01 80 02' - '00 00 00 A7 01 00 01 A8 01 00 01 A8 01 00 00 00 A8 01 00 00 00 01 A7 01 00 01 A7 01 00 A9 01 00' - '01 83 02 00 01 83 02 00 00 00 AC 01 00 01 AD 01 00 01 AD 01 00 00 00 AD 01 00 00 00 01 AC 01 00' - '01 AC 01 00 AE 01 00 01 88 02 00 01 88 02 00 00 00 AF 01 00 01 B0 01 00 01 B0 01 00 00 00 B0 01' - '00 00 00 01 AF 01 00 01 AF 01 00 B1 01 00 01 8A 02 00 01 8A 02 00 00 00 B2 01 00 01 8B 02 00 01' - '8B 02 00 00 00 B3 01 00 01 B4 01 00 01 B4 01 00 00 00 B4 01 00 00 00 01 B3 01 00 01 B3 01 00 B5' - '01 00 01 B6 01 00 01 B6 01 00 00 00 B6 01 00 00 00 01 B5 01 00 01 B5 01 00 B7 01 00 01 92 02 00' - '01 92 02 00 00 00 B8 01 00 01 B9 01 00 01 B9 01 00 00 00 B9 01 00 00 00 01 B8 01 00 01 B8 01 00' - 'BC 01 00 01 BD 01 00 01 BD 01 00 00 00 BD 01 00 00 00 01 BC 01 00 01 BC 01 00 BF 01 00 00 00 01' - 'F7 01 00 01 F7 01 00 C4 01 00 01 C6 01 00 01 C6 01 00 01 C5 01 00 00 C5 01 00 01 C6 01 00 01 C6' - '01 00 01 C5 01 00 01 C4 01 00 C6 01 00 00 00 01 C5 01 00 01 C4 01 00 C7 01 00 01 C9 01 00 01 C9' - '01 00 01 C8 01 00 00 C8 01 00 01 C9 01 00 01 C9 01 00 01 C8 01 00 01 C7 01 00 C9 01 00 00 00 01' - 'C8 01 00 01 C7 01 00 CA 01 00 01 CC 01 00 01 CC 01 00 01 CB 01 00 00 CB 01 00 01 CC 01 00 01 CC' - '01 00 01 CB 01 00 01 CA 01 00 CC 01 00 00 00 01 CB 01 00 01 CA 01 00 CD 01 00 01 CE 01 00 01 CE' - '01 00 00 00 CE 01 00 00 00 01 CD 01 00 01 CD 01 00 CF 01 00 01 D0 01 00 01 D0 01 00 00 00 D0 01' - '00 00 00 01 CF 01 00 01 CF 01 00 D1 01 00 01 D2 01 00 01 D2 01 00 00 00 D2 01 00 00 00 01 D1 01' - '00 01 D1 01 00 D3 01 00 01 D4 01 00 01 D4 01 00 00 00 D4 01 00 00 00 01 D3 01 00 01 D3 01 00 D5' - '01 00 01 D6 01 00 01 D6 01 00 00 00 D6 01 00 00 00 01 D5 01 00 01 D5 01 00 D7 01 00 01 D8 01 00' - '01 D8 01 00 00 00 D8 01 00 00 00 01 D7 01 00 01 D7 01 00 D9 01 00 01 DA 01 00 01 DA 01 00 00 00' - 'DA 01 00 00 00 01 D9 01 00 01 D9 01 00 DB 01 00 01 DC 01 00 01 DC 01 00 00 00 DC 01 00 00 00 01' - 'DB 01 00 01 DB 01 00 DD 01 00 00 00 01 8E 01 00 01 8E 01 00 DE 01 00 01 DF 01 00 01 DF 01 00 00' - '00 DF 01 00 00 00 01 DE 01 00 01 DE 01 00 E0 01 00 01 E1 01 00 01 E1 01 00 00 00 E1 01 00 00 00' - '01 E0 01 00 01 E0 01 00 E2 01 00 01 E3 01 00 01 E3 01 00 00 00 E3 01 00 00 00 01 E2 01 00 01 E2' - '01 00 E4 01 00 01 E5 01 00 01 E5 01 00 00 00 E5 01 00 00 00 01 E4 01 00 01 E4 01 00 E6 01 00 01' - 'E7 01 00 01 E7 01 00 00 00 E7 01 00 00 00 01 E6 01 00 01 E6 01 00 E8 01 00 01 E9 01 00 01 E9 01' - '00 00 00 E9 01 00 00 00 01 E8 01 00 01 E8 01 00 EA 01 00 01 EB 01 00 01 EB 01 00 00 00 EB 01 00' - '00 00 01 EA 01 00 01 EA 01 00 EC 01 00 01 ED 01 00 01 ED 01 00 00 00 ED 01 00 00 00 01 EC 01 00' - '01 EC 01 00 EE 01 00 01 EF 01 00 01 EF 01 00 00 00 EF 01 00 00 00 01 EE 01 00 01 EE 01 00 F0 01' - '00 02 6A 00 00 0C 03 00 01 F0 01 00 02 4A 00 00 0C 03 00 02 4A 00 00 0C 03 00 F1 01 00 01 F3 01' - '00 01 F3 01 00 01 F2 01 00 00 F2 01 00 01 F3 01 00 01 F3 01 00 01 F2 01 00 01 F1 01 00 F3 01 00' - '00 00 01 F2 01 00 01 F1 01 00 F4 01 00 01 F5 01 00 01 F5 01 00 00 00 F5 01 00 00 00 01 F4 01 00' - '01 F4 01 00 F6 01 00 01 95 01 00 01 95 01 00 00 00 F7 01 00 01 BF 01 00 01 BF 01 00 00 00 F8 01' - '00 01 F9 01 00 01 F9 01 00 00 00 F9 01 00 00 00 01 F8 01 00 01 F8 01 00 FA 01 00 01 FB 01 00 01' - 'FB 01 00 00 00 FB 01 00 00 00 01 FA 01 00 01 FA 01 00 FC 01 00 01 FD 01 00 01 FD 01 00 00 00 FD' - '01 00 00 00 01 FC 01 00 01 FC 01 00 FE 01 00 01 FF 01 00 01 FF 01 00 00 00 FF 01 00 00 00 01 FE' - '01 00 01 FE 01 00 00 02 00 01 01 02 00 01 01 02 00 00 00 01 02 00 00 00 01 00 02 00 01 00 02 00' - '02 02 00 01 03 02 00 01 03 02 00 00 00 03 02 00 00 00 01 02 02 00 01 02 02 00 04 02 00 01 05 02' - '00 01 05 02 00 00 00 05 02 00 00 00 01 04 02 00 01 04 02 00 06 02 00 01 07 02 00 01 07 02 00 00' - '00 07 02 00 00 00 01 06 02 00 01 06 02 00 08 02 00 01 09 02 00 01 09 02 00 00 00 09 02 00 00 00' - '01 08 02 00 01 08 02 00 0A 02 00 01 0B 02 00 01 0B 02 00 00 00 0B 02 00 00 00 01 0A 02 00 01 0A' - '02 00 0C 02 00 01 0D 02 00 01 0D 02 00 00 00 0D 02 00 00 00 01 0C 02 00 01 0C 02 00 0E 02 00 01' - '0F 02 00 01 0F 02 00 00 00 0F 02 00 00 00 01 0E 02 00 01 0E 02 00 10 02 00 01 11 02 00 01 11 02' - '00 00 00 11 02 00 00 00 01 10 02 00 01 10 02 00 12 02 00 01 13 02 00 01 13 02 00 00 00 13 02 00' - '00 00 01 12 02 00 01 12 02 00 14 02 00 01 15 02 00 01 15 02 00 00 00 15 02 00 00 00 01 14 02 00' - '01 14 02 00 16 02 00 01 17 02 00 01 17 02 00 00 00 17 02 00 00 00 01 16 02 00 01 16 02 00 18 02' - '00 01 19 02 00 01 19 02 00 00 00 19 02 00 00 00 01 18 02 00 01 18 02 00 1A 02 00 01 1B 02 00 01' - '1B 02 00 00 00 1B 02 00 00 00 01 1A 02 00 01 1A 02 00 1C 02 00 01 1D 02 00 01 1D 02 00 00 00 1D' - '02 00 00 00 01 1C 02 00 01 1C 02 00 1E 02 00 01 1F 02 00 01 1F 02 00 00 00 1F 02 00 00 00 01 1E' - '02 00 01 1E 02 00 20 02 00 01 9E 01 00 01 9E 01 00 00 00 22 02 00 01 23 02 00 01 23 02 00 00 00' - '23 02 00 00 00 01 22 02 00 01 22 02 00 24 02 00 01 25 02 00 01 25 02 00 00 00 25 02 00 00 00 01' - '24 02 00 01 24 02 00 26 02 00 01 27 02 00 01 27 02 00 00 00 27 02 00 00 00 01 26 02 00 01 26 02' - '00 28 02 00 01 29 02 00 01 29 02 00 00 00 29 02 00 00 00 01 28 02 00 01 28 02 00 2A 02 00 01 2B' - '02 00 01 2B 02 00 00 00 2B 02 00 00 00 01 2A 02 00 01 2A 02 00 2C 02 00 01 2D 02 00 01 2D 02 00' - '00 00 2D 02 00 00 00 01 2C 02 00 01 2C 02 00 2E 02 00 01 2F 02 00 01 2F 02 00 00 00 2F 02 00 00' - '00 01 2E 02 00 01 2E 02 00 30 02 00 01 31 02 00 01 31 02 00 00 00 31 02 00 00 00 01 30 02 00 01' - '30 02 00 32 02 00 01 33 02 00 01 33 02 00 00 00 33 02 00 00 00 01 32 02 00 01 32 02 00 3A 02 00' - '01 65 2C 00 01 65 2C 00 00 00 3B 02 00 01 3C 02 00 01 3C 02 00 00 00 3C 02 00 00 00 01 3B 02 00' - '01 3B 02 00 3D 02 00 01 9A 01 00 01 9A 01 00 00 00 3E 02 00 01 66 2C 00 01 66 2C 00 00 00 3F 02' - '00 00 00 01 7E 2C 00 01 7E 2C 00 40 02 00 00 00 01 7F 2C 00 01 7F 2C 00 41 02 00 01 42 02 00 01' - '42 02 00 00 00 42 02 00 00 00 01 41 02 00 01 41 02 00 43 02 00 01 80 01 00 01 80 01 00 00 00 44' - '02 00 01 89 02 00 01 89 02 00 00 00 45 02 00 01 8C 02 00 01 8C 02 00 00 00 46 02 00 01 47 02 00' - '01 47 02 00 00 00 47 02 00 00 00 01 46 02 00 01 46 02 00 48 02 00 01 49 02 00 01 49 02 00 00 00' - '49 02 00 00 00 01 48 02 00 01 48 02 00 4A 02 00 01 4B 02 00 01 4B 02 00 00 00 4B 02 00 00 00 01' - '4A 02 00 01 4A 02 00 4C 02 00 01 4D 02 00 01 4D 02 00 00 00 4D 02 00 00 00 01 4C 02 00 01 4C 02' - '00 4E 02 00 01 4F 02 00 01 4F 02 00 00 00 4F 02 00 00 00 01 4E 02 00 01 4E 02 00 50 02 00 00 00' - '01 6F 2C 00 01 6F 2C 00 51 02 00 00 00 01 6D 2C 00 01 6D 2C 00 52 02 00 00 00 01 70 2C 00 01 70' - '2C 00 53 02 00 00 00 01 81 01 00 01 81 01 00 54 02 00 00 00 01 86 01 00 01 86 01 00 56 02 00 00' - '00 01 89 01 00 01 89 01 00 57 02 00 00 00 01 8A 01 00 01 8A 01 00 59 02 00 00 00 01 8F 01 00 01' - '8F 01 00 5B 02 00 00 00 01 90 01 00 01 90 01 00 5C 02 00 00 00 01 AB A7 00 01 AB A7 00 60 02 00' - '00 00 01 93 01 00 01 93 01 00 61 02 00 00 00 01 AC A7 00 01 AC A7 00 63 02 00 00 00 01 94 01 00' - '01 94 01 00 65 02 00 00 00 01 8D A7 00 01 8D A7 00 66 02 00 00 00 01 AA A7 00 01 AA A7 00 68 02' - '00 00 00 01 97 01 00 01 97 01 00 69 02 00 00 00 01 96 01 00 01 96 01 00 6A 02 00 00 00 01 AE A7' - '00 01 AE A7 00 6B 02 00 00 00 01 62 2C 00 01 62 2C 00 6C 02 00 00 00 01 AD A7 00 01 AD A7 00 6F' - '02 00 00 00 01 9C 01 00 01 9C 01 00 71 02 00 00 00 01 6E 2C 00 01 6E 2C 00 72 02 00 00 00 01 9D' - '01 00 01 9D 01 00 75 02 00 00 00 01 9F 01 00 01 9F 01 00 7D 02 00 00 00 01 64 2C 00 01 64 2C 00' - '80 02 00 00 00 01 A6 01 00 01 A6 01 00 82 02 00 00 00 01 C5 A7 00 01 C5 A7 00 83 02 00 00 00 01' - 'A9 01 00 01 A9 01 00 87 02 00 00 00 01 B1 A7 00 01 B1 A7 00 88 02 00 00 00 01 AE 01 00 01 AE 01' - '00 89 02 00 00 00 01 44 02 00 01 44 02 00 8A 02 00 00 00 01 B1 01 00 01 B1 01 00 8B 02 00 00 00' - '01 B2 01 00 01 B2 01 00 8C 02 00 00 00 01 45 02 00 01 45 02 00 92 02 00 00 00 01 B7 01 00 01 B7' - '01 00 9D 02 00 00 00 01 B2 A7 00 01 B2 A7 00 9E 02 00 00 00 01 B0 A7 00 01 B0 A7 00 07 03 00 00' - '01 07 03 00 01 07 03 00 01 07 03 00 45 03 00 01 B9 03 00 00 01 99 03 00 01 99 03 00 70 03 00 01' - '71 03 00 01 71 03 00 00 00 71 03 00 00 00 01 70 03 00 01 70 03 00 72 03 00 01 73 03 00 01 73 03' - '00 00 00 73 03 00 00 00 01 72 03 00 01 72 03 00 76 03 00 01 77 03 00 01 77 03 00 00 00 77 03 00' - '00 00 01 76 03 00 01 76 03 00 7B 03 00 00 00 01 FD 03 00 01 FD 03 00 7C 03 00 00 00 01 FE 03 00' - '01 FE 03 00 7D 03 00 00 00 01 FF 03 00 01 FF 03 00 7F 03 00 01 F3 03 00 01 F3 03 00 00 00 86 03' - '00 01 AC 03 00 01 AC 03 00 00 00 88 03 00 01 AD 03 00 01 AD 03 00 00 00 89 03 00 01 AE 03 00 01' - 'AE 03 00 00 00 8A 03 00 01 AF 03 00 01 AF 03 00 00 00 8C 03 00 01 CC 03 00 01 CC 03 00 00 00 8E' - '03 00 01 CD 03 00 01 CD 03 00 00 00 8F 03 00 01 CE 03 00 01 CE 03 00 00 00 90 03 00 03 B9 03 00' - '08 03 00 01 03 00 01 90 03 00 03 99 03 00 08 03 00 01 03 00 03 99 03 00 08 03 00 01 03 00 91 03' - '00 01 B1 03 00 01 B1 03 00 00 00 92 03 00 01 B2 03 00 01 B2 03 00 00 00 93 03 00 01 B3 03 00 01' - 'B3 03 00 00 00 94 03 00 01 B4 03 00 01 B4 03 00 00 00 95 03 00 01 B5 03 00 01 B5 03 00 00 00 96' - '03 00 01 B6 03 00 01 B6 03 00 00 00 97 03 00 01 B7 03 00 01 B7 03 00 00 00 98 03 00 01 B8 03 00' - '01 B8 03 00 00 00 99 03 00 01 B9 03 00 01 B9 03 00 00 00 9A 03 00 01 BA 03 00 01 BA 03 00 00 00' - '9B 03 00 01 BB 03 00 01 BB 03 00 00 00 9C 03 00 01 BC 03 00 01 BC 03 00 00 00 9D 03 00 01 BD 03' - '00 01 BD 03 00 00 00 9E 03 00 01 BE 03 00 01 BE 03 00 00 00 9F 03 00 01 BF 03 00 01 BF 03 00 00' - '00 A0 03 00 01 C0 03 00 01 C0 03 00 00 00 A1 03 00 01 C1 03 00 01 C1 03 00 00 00 A3 03 00 01 C3' - '03 00 01 C3 03 00 01 A3 03 00 01 A3 03 00 A4 03 00 01 C4 03 00 01 C4 03 00 00 00 A5 03 00 01 C5' - '03 00 01 C5 03 00 00 00 A6 03 00 01 C6 03 00 01 C6 03 00 00 00 A7 03 00 01 C7 03 00 01 C7 03 00' - '00 00 A8 03 00 01 C8 03 00 01 C8 03 00 00 00 A9 03 00 01 C9 03 00 01 C9 03 00 00 00 AA 03 00 01' - 'CA 03 00 01 CA 03 00 00 00 AB 03 00 01 CB 03 00 01 CB 03 00 00 00 AC 03 00 00 00 01 86 03 00 01' - '86 03 00 AD 03 00 00 00 01 88 03 00 01 88 03 00 AE 03 00 00 00 01 89 03 00 01 89 03 00 AF 03 00' - '00 00 01 8A 03 00 01 8A 03 00 B0 03 00 03 C5 03 00 08 03 00 01 03 00 01 B0 03 00 03 A5 03 00 08' - '03 00 01 03 00 03 A5 03 00 08 03 00 01 03 00 B1 03 00 00 00 01 91 03 00 01 91 03 00 B2 03 00 00' - '00 01 92 03 00 01 92 03 00 B3 03 00 00 00 01 93 03 00 01 93 03 00 B4 03 00 00 00 01 94 03 00 01' - '94 03 00 B5 03 00 00 00 01 95 03 00 01 95 03 00 B6 03 00 00 00 01 96 03 00 01 96 03 00 B7 03 00' - '00 00 01 97 03 00 01 97 03 00 B8 03 00 00 00 01 98 03 00 01 98 03 00 B9 03 00 00 00 01 99 03 00' - '01 99 03 00 BA 03 00 00 00 01 9A 03 00 01 9A 03 00 BB 03 00 00 00 01 9B 03 00 01 9B 03 00 BC 03' - '00 00 00 01 9C 03 00 01 9C 03 00 BD 03 00 00 00 01 9D 03 00 01 9D 03 00 BE 03 00 00 00 01 9E 03' - '00 01 9E 03 00 BF 03 00 00 00 01 9F 03 00 01 9F 03 00 C0 03 00 00 00 01 A0 03 00 01 A0 03 00 C1' - '03 00 00 00 01 A1 03 00 01 A1 03 00 C2 03 00 01 C3 03 00 00 01 A3 03 00 01 A3 03 00 C3 03 00 00' - '00 01 A3 03 00 01 A3 03 00 C4 03 00 00 00 01 A4 03 00 01 A4 03 00 C5 03 00 00 00 01 A5 03 00 01' - 'A5 03 00 C6 03 00 00 00 01 A6 03 00 01 A6 03 00 C7 03 00 00 00 01 A7 03 00 01 A7 03 00 C8 03 00' - '00 00 01 A8 03 00 01 A8 03 00 C9 03 00 00 00 01 A9 03 00 01 A9 03 00 CA 03 00 00 00 01 AA 03 00' - '01 AA 03 00 CB 03 00 00 00 01 AB 03 00 01 AB 03 00 CC 03 00 00 00 01 8C 03 00 01 8C 03 00 CD 03' - '00 00 00 01 8E 03 00 01 8E 03 00 CE 03 00 00 00 01 8F 03 00 01 8F 03 00 CF 03 00 01 D7 03 00 01' - 'D7 03 00 00 00 D0 03 00 01 B2 03 00 00 01 92 03 00 01 92 03 00 D1 03 00 01 B8 03 00 00 01 98 03' - '00 01 98 03 00 D5 03 00 01 C6 03 00 00 01 A6 03 00 01 A6 03 00 D6 03 00 01 C0 03 00 00 01 A0 03' - '00 01 A0 03 00 D7 03 00 00 00 01 CF 03 00 01 CF 03 00 D8 03 00 01 D9 03 00 01 D9 03 00 00 00 D9' - '03 00 00 00 01 D8 03 00 01 D8 03 00 DA 03 00 01 DB 03 00 01 DB 03 00 00 00 DB 03 00 00 00 01 DA' - '03 00 01 DA 03 00 DC 03 00 01 DD 03 00 01 DD 03 00 00 00 DD 03 00 00 00 01 DC 03 00 01 DC 03 00' - 'DE 03 00 01 DF 03 00 01 DF 03 00 00 00 DF 03 00 00 00 01 DE 03 00 01 DE 03 00 E0 03 00 01 E1 03' - '00 01 E1 03 00 00 00 E1 03 00 00 00 01 E0 03 00 01 E0 03 00 E2 03 00 01 E3 03 00 01 E3 03 00 00' - '00 E3 03 00 00 00 01 E2 03 00 01 E2 03 00 E4 03 00 01 E5 03 00 01 E5 03 00 00 00 E5 03 00 00 00' - '01 E4 03 00 01 E4 03 00 E6 03 00 01 E7 03 00 01 E7 03 00 00 00 E7 03 00 00 00 01 E6 03 00 01 E6' - '03 00 E8 03 00 01 E9 03 00 01 E9 03 00 00 00 E9 03 00 00 00 01 E8 03 00 01 E8 03 00 EA 03 00 01' - 'EB 03 00 01 EB 03 00 00 00 EB 03 00 00 00 01 EA 03 00 01 EA 03 00 EC 03 00 01 ED 03 00 01 ED 03' - '00 00 00 ED 03 00 00 00 01 EC 03 00 01 EC 03 00 EE 03 00 01 EF 03 00 01 EF 03 00 00 00 EF 03 00' - '00 00 01 EE 03 00 01 EE 03 00 F0 03 00 01 BA 03 00 00 01 9A 03 00 01 9A 03 00 F1 03 00 01 C1 03' - '00 00 01 A1 03 00 01 A1 03 00 F2 03 00 00 00 01 F9 03 00 01 F9 03 00 F3 03 00 00 00 01 7F 03 00' - '01 7F 03 00 F4 03 00 01 B8 03 00 01 B8 03 00 00 00 F5 03 00 01 B5 03 00 00 01 95 03 00 01 95 03' - '00 F7 03 00 01 F8 03 00 01 F8 03 00 00 00 F8 03 00 00 00 01 F7 03 00 01 F7 03 00 F9 03 00 01 F2' - '03 00 01 F2 03 00 00 00 FA 03 00 01 FB 03 00 01 FB 03 00 00 00 FB 03 00 00 00 01 FA 03 00 01 FA' - '03 00 FD 03 00 01 7B 03 00 01 7B 03 00 00 00 FE 03 00 01 7C 03 00 01 7C 03 00 00 00 FF 03 00 01' - '7D 03 00 01 7D 03 00 00 00 00 04 00 01 50 04 00 01 50 04 00 00 00 01 04 00 01 51 04 00 01 51 04' - '00 00 00 02 04 00 01 52 04 00 01 52 04 00 00 00 03 04 00 01 53 04 00 01 53 04 00 00 00 04 04 00' - '01 54 04 00 01 54 04 00 00 00 05 04 00 01 55 04 00 01 55 04 00 00 00 06 04 00 01 56 04 00 01 56' - '04 00 00 00 07 04 00 01 57 04 00 01 57 04 00 00 00 08 04 00 01 58 04 00 01 58 04 00 00 00 09 04' - '00 01 59 04 00 01 59 04 00 00 00 0A 04 00 01 5A 04 00 01 5A 04 00 00 00 0B 04 00 01 5B 04 00 01' - '5B 04 00 00 00 0C 04 00 01 5C 04 00 01 5C 04 00 00 00 0D 04 00 01 5D 04 00 01 5D 04 00 00 00 0E' - '04 00 01 5E 04 00 01 5E 04 00 00 00 0F 04 00 01 5F 04 00 01 5F 04 00 00 00 10 04 00 01 30 04 00' - '01 30 04 00 00 00 11 04 00 01 31 04 00 01 31 04 00 00 00 12 04 00 01 32 04 00 01 32 04 00 00 00' - '13 04 00 01 33 04 00 01 33 04 00 00 00 14 04 00 01 34 04 00 01 34 04 00 00 00 15 04 00 01 35 04' - '00 01 35 04 00 00 00 16 04 00 01 36 04 00 01 36 04 00 00 00 17 04 00 01 37 04 00 01 37 04 00 00' - '00 18 04 00 01 38 04 00 01 38 04 00 00 00 19 04 00 01 39 04 00 01 39 04 00 00 00 1A 04 00 01 3A' - '04 00 01 3A 04 00 00 00 1B 04 00 01 3B 04 00 01 3B 04 00 00 00 1C 04 00 01 3C 04 00 01 3C 04 00' - '00 00 1D 04 00 01 3D 04 00 01 3D 04 00 00 00 1E 04 00 01 3E 04 00 01 3E 04 00 00 00 1F 04 00 01' - '3F 04 00 01 3F 04 00 00 00 20 04 00 01 40 04 00 01 40 04 00 00 00 21 04 00 01 41 04 00 01 41 04' - '00 00 00 22 04 00 01 42 04 00 01 42 04 00 00 00 23 04 00 01 43 04 00 01 43 04 00 00 00 24 04 00' - '01 44 04 00 01 44 04 00 00 00 25 04 00 01 45 04 00 01 45 04 00 00 00 26 04 00 01 46 04 00 01 46' - '04 00 00 00 27 04 00 01 47 04 00 01 47 04 00 00 00 28 04 00 01 48 04 00 01 48 04 00 00 00 29 04' - '00 01 49 04 00 01 49 04 00 00 00 2A 04 00 01 4A 04 00 01 4A 04 00 00 00 2B 04 00 01 4B 04 00 01' - '4B 04 00 00 00 2C 04 00 01 4C 04 00 01 4C 04 00 00 00 2D 04 00 01 4D 04 00 01 4D 04 00 00 00 2E' - '04 00 01 4E 04 00 01 4E 04 00 00 00 2F 04 00 01 4F 04 00 01 4F 04 00 00 00 30 04 00 00 00 01 10' - '04 00 01 10 04 00 31 04 00 00 00 01 11 04 00 01 11 04 00 32 04 00 00 00 01 12 04 00 01 12 04 00' - '33 04 00 00 00 01 13 04 00 01 13 04 00 34 04 00 00 00 01 14 04 00 01 14 04 00 35 04 00 00 00 01' - '15 04 00 01 15 04 00 36 04 00 00 00 01 16 04 00 01 16 04 00 37 04 00 00 00 01 17 04 00 01 17 04' - '00 38 04 00 00 00 01 18 04 00 01 18 04 00 39 04 00 00 00 01 19 04 00 01 19 04 00 3A 04 00 00 00' - '01 1A 04 00 01 1A 04 00 3B 04 00 00 00 01 1B 04 00 01 1B 04 00 3C 04 00 00 00 01 1C 04 00 01 1C' - '04 00 3D 04 00 00 00 01 1D 04 00 01 1D 04 00 3E 04 00 00 00 01 1E 04 00 01 1E 04 00 3F 04 00 00' - '00 01 1F 04 00 01 1F 04 00 40 04 00 00 00 01 20 04 00 01 20 04 00 41 04 00 00 00 01 21 04 00 01' - '21 04 00 42 04 00 00 00 01 22 04 00 01 22 04 00 43 04 00 00 00 01 23 04 00 01 23 04 00 44 04 00' - '00 00 01 24 04 00 01 24 04 00 45 04 00 00 00 01 25 04 00 01 25 04 00 46 04 00 00 00 01 26 04 00' - '01 26 04 00 47 04 00 00 00 01 27 04 00 01 27 04 00 48 04 00 00 00 01 28 04 00 01 28 04 00 49 04' - '00 00 00 01 29 04 00 01 29 04 00 4A 04 00 00 00 01 2A 04 00 01 2A 04 00 4B 04 00 00 00 01 2B 04' - '00 01 2B 04 00 4C 04 00 00 00 01 2C 04 00 01 2C 04 00 4D 04 00 00 00 01 2D 04 00 01 2D 04 00 4E' - '04 00 00 00 01 2E 04 00 01 2E 04 00 4F 04 00 00 00 01 2F 04 00 01 2F 04 00 50 04 00 00 00 01 00' - '04 00 01 00 04 00 51 04 00 00 00 01 01 04 00 01 01 04 00 52 04 00 00 00 01 02 04 00 01 02 04 00' - '53 04 00 00 00 01 03 04 00 01 03 04 00 54 04 00 00 00 01 04 04 00 01 04 04 00 55 04 00 00 00 01' - '05 04 00 01 05 04 00 56 04 00 00 00 01 06 04 00 01 06 04 00 57 04 00 00 00 01 07 04 00 01 07 04' - '00 58 04 00 00 00 01 08 04 00 01 08 04 00 59 04 00 00 00 01 09 04 00 01 09 04 00 5A 04 00 00 00' - '01 0A 04 00 01 0A 04 00 5B 04 00 00 00 01 0B 04 00 01 0B 04 00 5C 04 00 00 00 01 0C 04 00 01 0C' - '04 00 5D 04 00 00 00 01 0D 04 00 01 0D 04 00 5E 04 00 00 00 01 0E 04 00 01 0E 04 00 5F 04 00 00' - '00 01 0F 04 00 01 0F 04 00 60 04 00 01 61 04 00 01 61 04 00 00 00 61 04 00 00 00 01 60 04 00 01' - '60 04 00 62 04 00 01 63 04 00 01 63 04 00 00 00 63 04 00 00 00 01 62 04 00 01 62 04 00 64 04 00' - '01 65 04 00 01 65 04 00 00 00 65 04 00 00 00 01 64 04 00 01 64 04 00 66 04 00 01 67 04 00 01 67' - '04 00 00 00 67 04 00 00 00 01 66 04 00 01 66 04 00 68 04 00 01 69 04 00 01 69 04 00 00 00 69 04' - '00 00 00 01 68 04 00 01 68 04 00 6A 04 00 01 6B 04 00 01 6B 04 00 00 00 6B 04 00 00 00 01 6A 04' - '00 01 6A 04 00 6C 04 00 01 6D 04 00 01 6D 04 00 00 00 6D 04 00 00 00 01 6C 04 00 01 6C 04 00 6E' - '04 00 01 6F 04 00 01 6F 04 00 00 00 6F 04 00 00 00 01 6E 04 00 01 6E 04 00 70 04 00 01 71 04 00' - '01 71 04 00 00 00 71 04 00 00 00 01 70 04 00 01 70 04 00 72 04 00 01 73 04 00 01 73 04 00 00 00' - '73 04 00 00 00 01 72 04 00 01 72 04 00 74 04 00 01 75 04 00 01 75 04 00 00 00 75 04 00 00 00 01' - '74 04 00 01 74 04 00 76 04 00 01 77 04 00 01 77 04 00 00 00 77 04 00 00 00 01 76 04 00 01 76 04' - '00 78 04 00 01 79 04 00 01 79 04 00 00 00 79 04 00 00 00 01 78 04 00 01 78 04 00 7A 04 00 01 7B' - '04 00 01 7B 04 00 00 00 7B 04 00 00 00 01 7A 04 00 01 7A 04 00 7C 04 00 01 7D 04 00 01 7D 04 00' - '00 00 7D 04 00 00 00 01 7C 04 00 01 7C 04 00 7E 04 00 01 7F 04 00 01 7F 04 00 00 00 7F 04 00 00' - '00 01 7E 04 00 01 7E 04 00 80 04 00 01 81 04 00 01 81 04 00 00 00 81 04 00 00 00 01 80 04 00 01' - '80 04 00 8A 04 00 01 8B 04 00 01 8B 04 00 00 00 8B 04 00 00 00 01 8A 04 00 01 8A 04 00 8C 04 00' - '01 8D 04 00 01 8D 04 00 00 00 8D 04 00 00 00 01 8C 04 00 01 8C 04 00 8E 04 00 01 8F 04 00 01 8F' - '04 00 00 00 8F 04 00 00 00 01 8E 04 00 01 8E 04 00 90 04 00 01 91 04 00 01 91 04 00 00 00 91 04' - '00 00 00 01 90 04 00 01 90 04 00 92 04 00 01 93 04 00 01 93 04 00 00 00 93 04 00 00 00 01 92 04' - '00 01 92 04 00 94 04 00 01 95 04 00 01 95 04 00 00 00 95 04 00 00 00 01 94 04 00 01 94 04 00 96' - '04 00 01 97 04 00 01 97 04 00 00 00 97 04 00 00 00 01 96 04 00 01 96 04 00 98 04 00 01 99 04 00' - '01 99 04 00 00 00 99 04 00 00 00 01 98 04 00 01 98 04 00 9A 04 00 01 9B 04 00 01 9B 04 00 00 00' - '9B 04 00 00 00 01 9A 04 00 01 9A 04 00 9C 04 00 01 9D 04 00 01 9D 04 00 00 00 9D 04 00 00 00 01' - '9C 04 00 01 9C 04 00 9E 04 00 01 9F 04 00 01 9F 04 00 00 00 9F 04 00 00 00 01 9E 04 00 01 9E 04' - '00 A0 04 00 01 A1 04 00 01 A1 04 00 00 00 A1 04 00 00 00 01 A0 04 00 01 A0 04 00 A2 04 00 01 A3' - '04 00 01 A3 04 00 00 00 A3 04 00 00 00 01 A2 04 00 01 A2 04 00 A4 04 00 01 A5 04 00 01 A5 04 00' - '00 00 A5 04 00 00 00 01 A4 04 00 01 A4 04 00 A6 04 00 01 A7 04 00 01 A7 04 00 00 00 A7 04 00 00' - '00 01 A6 04 00 01 A6 04 00 A8 04 00 01 A9 04 00 01 A9 04 00 00 00 A9 04 00 00 00 01 A8 04 00 01' - 'A8 04 00 AA 04 00 01 AB 04 00 01 AB 04 00 00 00 AB 04 00 00 00 01 AA 04 00 01 AA 04 00 AC 04 00' - '01 AD 04 00 01 AD 04 00 00 00 AD 04 00 00 00 01 AC 04 00 01 AC 04 00 AE 04 00 01 AF 04 00 01 AF' - '04 00 00 00 AF 04 00 00 00 01 AE 04 00 01 AE 04 00 B0 04 00 01 B1 04 00 01 B1 04 00 00 00 B1 04' - '00 00 00 01 B0 04 00 01 B0 04 00 B2 04 00 01 B3 04 00 01 B3 04 00 00 00 B3 04 00 00 00 01 B2 04' - '00 01 B2 04 00 B4 04 00 01 B5 04 00 01 B5 04 00 00 00 B5 04 00 00 00 01 B4 04 00 01 B4 04 00 B6' - '04 00 01 B7 04 00 01 B7 04 00 00 00 B7 04 00 00 00 01 B6 04 00 01 B6 04 00 B8 04 00 01 B9 04 00' - '01 B9 04 00 00 00 B9 04 00 00 00 01 B8 04 00 01 B8 04 00 BA 04 00 01 BB 04 00 01 BB 04 00 00 00' - 'BB 04 00 00 00 01 BA 04 00 01 BA 04 00 BC 04 00 01 BD 04 00 01 BD 04 00 00 00 BD 04 00 00 00 01' - 'BC 04 00 01 BC 04 00 BE 04 00 01 BF 04 00 01 BF 04 00 00 00 BF 04 00 00 00 01 BE 04 00 01 BE 04' - '00 C0 04 00 01 CF 04 00 01 CF 04 00 00 00 C1 04 00 01 C2 04 00 01 C2 04 00 00 00 C2 04 00 00 00' - '01 C1 04 00 01 C1 04 00 C3 04 00 01 C4 04 00 01 C4 04 00 00 00 C4 04 00 00 00 01 C3 04 00 01 C3' - '04 00 C5 04 00 01 C6 04 00 01 C6 04 00 00 00 C6 04 00 00 00 01 C5 04 00 01 C5 04 00 C7 04 00 01' - 'C8 04 00 01 C8 04 00 00 00 C8 04 00 00 00 01 C7 04 00 01 C7 04 00 C9 04 00 01 CA 04 00 01 CA 04' - '00 00 00 CA 04 00 00 00 01 C9 04 00 01 C9 04 00 CB 04 00 01 CC 04 00 01 CC 04 00 00 00 CC 04 00' - '00 00 01 CB 04 00 01 CB 04 00 CD 04 00 01 CE 04 00 01 CE 04 00 00 00 CE 04 00 00 00 01 CD 04 00' - '01 CD 04 00 CF 04 00 00 00 01 C0 04 00 01 C0 04 00 D0 04 00 01 D1 04 00 01 D1 04 00 00 00 D1 04' - '00 00 00 01 D0 04 00 01 D0 04 00 D2 04 00 01 D3 04 00 01 D3 04 00 00 00 D3 04 00 00 00 01 D2 04' - '00 01 D2 04 00 D4 04 00 01 D5 04 00 01 D5 04 00 00 00 D5 04 00 00 00 01 D4 04 00 01 D4 04 00 D6' - '04 00 01 D7 04 00 01 D7 04 00 00 00 D7 04 00 00 00 01 D6 04 00 01 D6 04 00 D8 04 00 01 D9 04 00' - '01 D9 04 00 00 00 D9 04 00 00 00 01 D8 04 00 01 D8 04 00 DA 04 00 01 DB 04 00 01 DB 04 00 00 00' - 'DB 04 00 00 00 01 DA 04 00 01 DA 04 00 DC 04 00 01 DD 04 00 01 DD 04 00 00 00 DD 04 00 00 00 01' - 'DC 04 00 01 DC 04 00 DE 04 00 01 DF 04 00 01 DF 04 00 00 00 DF 04 00 00 00 01 DE 04 00 01 DE 04' - '00 E0 04 00 01 E1 04 00 01 E1 04 00 00 00 E1 04 00 00 00 01 E0 04 00 01 E0 04 00 E2 04 00 01 E3' - '04 00 01 E3 04 00 00 00 E3 04 00 00 00 01 E2 04 00 01 E2 04 00 E4 04 00 01 E5 04 00 01 E5 04 00' - '00 00 E5 04 00 00 00 01 E4 04 00 01 E4 04 00 E6 04 00 01 E7 04 00 01 E7 04 00 00 00 E7 04 00 00' - '00 01 E6 04 00 01 E6 04 00 E8 04 00 01 E9 04 00 01 E9 04 00 00 00 E9 04 00 00 00 01 E8 04 00 01' - 'E8 04 00 EA 04 00 01 EB 04 00 01 EB 04 00 00 00 EB 04 00 00 00 01 EA 04 00 01 EA 04 00 EC 04 00' - '01 ED 04 00 01 ED 04 00 00 00 ED 04 00 00 00 01 EC 04 00 01 EC 04 00 EE 04 00 01 EF 04 00 01 EF' - '04 00 00 00 EF 04 00 00 00 01 EE 04 00 01 EE 04 00 F0 04 00 01 F1 04 00 01 F1 04 00 00 00 F1 04' - '00 00 00 01 F0 04 00 01 F0 04 00 F2 04 00 01 F3 04 00 01 F3 04 00 00 00 F3 04 00 00 00 01 F2 04' - '00 01 F2 04 00 F4 04 00 01 F5 04 00 01 F5 04 00 00 00 F5 04 00 00 00 01 F4 04 00 01 F4 04 00 F6' - '04 00 01 F7 04 00 01 F7 04 00 00 00 F7 04 00 00 00 01 F6 04 00 01 F6 04 00 F8 04 00 01 F9 04 00' - '01 F9 04 00 00 00 F9 04 00 00 00 01 F8 04 00 01 F8 04 00 FA 04 00 01 FB 04 00 01 FB 04 00 00 00' - 'FB 04 00 00 00 01 FA 04 00 01 FA 04 00 FC 04 00 01 FD 04 00 01 FD 04 00 00 00 FD 04 00 00 00 01' - 'FC 04 00 01 FC 04 00 FE 04 00 01 FF 04 00 01 FF 04 00 00 00 FF 04 00 00 00 01 FE 04 00 01 FE 04' - '00 00 05 00 01 01 05 00 01 01 05 00 00 00 01 05 00 00 00 01 00 05 00 01 00 05 00 02 05 00 01 03' - '05 00 01 03 05 00 00 00 03 05 00 00 00 01 02 05 00 01 02 05 00 04 05 00 01 05 05 00 01 05 05 00' - '00 00 05 05 00 00 00 01 04 05 00 01 04 05 00 06 05 00 01 07 05 00 01 07 05 00 00 00 07 05 00 00' - '00 01 06 05 00 01 06 05 00 08 05 00 01 09 05 00 01 09 05 00 00 00 09 05 00 00 00 01 08 05 00 01' - '08 05 00 0A 05 00 01 0B 05 00 01 0B 05 00 00 00 0B 05 00 00 00 01 0A 05 00 01 0A 05 00 0C 05 00' - '01 0D 05 00 01 0D 05 00 00 00 0D 05 00 00 00 01 0C 05 00 01 0C 05 00 0E 05 00 01 0F 05 00 01 0F' - '05 00 00 00 0F 05 00 00 00 01 0E 05 00 01 0E 05 00 10 05 00 01 11 05 00 01 11 05 00 00 00 11 05' - '00 00 00 01 10 05 00 01 10 05 00 12 05 00 01 13 05 00 01 13 05 00 00 00 13 05 00 00 00 01 12 05' - '00 01 12 05 00 14 05 00 01 15 05 00 01 15 05 00 00 00 15 05 00 00 00 01 14 05 00 01 14 05 00 16' - '05 00 01 17 05 00 01 17 05 00 00 00 17 05 00 00 00 01 16 05 00 01 16 05 00 18 05 00 01 19 05 00' - '01 19 05 00 00 00 19 05 00 00 00 01 18 05 00 01 18 05 00 1A 05 00 01 1B 05 00 01 1B 05 00 00 00' - '1B 05 00 00 00 01 1A 05 00 01 1A 05 00 1C 05 00 01 1D 05 00 01 1D 05 00 00 00 1D 05 00 00 00 01' - '1C 05 00 01 1C 05 00 1E 05 00 01 1F 05 00 01 1F 05 00 00 00 1F 05 00 00 00 01 1E 05 00 01 1E 05' - '00 20 05 00 01 21 05 00 01 21 05 00 00 00 21 05 00 00 00 01 20 05 00 01 20 05 00 22 05 00 01 23' - '05 00 01 23 05 00 00 00 23 05 00 00 00 01 22 05 00 01 22 05 00 24 05 00 01 25 05 00 01 25 05 00' - '00 00 25 05 00 00 00 01 24 05 00 01 24 05 00 26 05 00 01 27 05 00 01 27 05 00 00 00 27 05 00 00' - '00 01 26 05 00 01 26 05 00 28 05 00 01 29 05 00 01 29 05 00 00 00 29 05 00 00 00 01 28 05 00 01' - '28 05 00 2A 05 00 01 2B 05 00 01 2B 05 00 00 00 2B 05 00 00 00 01 2A 05 00 01 2A 05 00 2C 05 00' - '01 2D 05 00 01 2D 05 00 00 00 2D 05 00 00 00 01 2C 05 00 01 2C 05 00 2E 05 00 01 2F 05 00 01 2F' - '05 00 00 00 2F 05 00 00 00 01 2E 05 00 01 2E 05 00 31 05 00 01 61 05 00 01 61 05 00 00 00 32 05' - '00 01 62 05 00 01 62 05 00 00 00 33 05 00 01 63 05 00 01 63 05 00 00 00 34 05 00 01 64 05 00 01' - '64 05 00 00 00 35 05 00 01 65 05 00 01 65 05 00 00 00 36 05 00 01 66 05 00 01 66 05 00 00 00 37' - '05 00 01 67 05 00 01 67 05 00 00 00 38 05 00 01 68 05 00 01 68 05 00 00 00 39 05 00 01 69 05 00' - '01 69 05 00 00 00 3A 05 00 01 6A 05 00 01 6A 05 00 00 00 3B 05 00 01 6B 05 00 01 6B 05 00 00 00' - '3C 05 00 01 6C 05 00 01 6C 05 00 00 00 3D 05 00 01 6D 05 00 01 6D 05 00 00 00 3E 05 00 01 6E 05' - '00 01 6E 05 00 00 00 3F 05 00 01 6F 05 00 01 6F 05 00 00 00 40 05 00 01 70 05 00 01 70 05 00 00' - '00 41 05 00 01 71 05 00 01 71 05 00 00 00 42 05 00 01 72 05 00 01 72 05 00 00 00 43 05 00 01 73' - '05 00 01 73 05 00 00 00 44 05 00 01 74 05 00 01 74 05 00 00 00 45 05 00 01 75 05 00 01 75 05 00' - '00 00 46 05 00 01 76 05 00 01 76 05 00 00 00 47 05 00 01 77 05 00 01 77 05 00 00 00 48 05 00 01' - '78 05 00 01 78 05 00 00 00 49 05 00 01 79 05 00 01 79 05 00 00 00 4A 05 00 01 7A 05 00 01 7A 05' - '00 00 00 4B 05 00 01 7B 05 00 01 7B 05 00 00 00 4C 05 00 01 7C 05 00 01 7C 05 00 00 00 4D 05 00' - '01 7D 05 00 01 7D 05 00 00 00 4E 05 00 01 7E 05 00 01 7E 05 00 00 00 4F 05 00 01 7F 05 00 01 7F' - '05 00 00 00 50 05 00 01 80 05 00 01 80 05 00 00 00 51 05 00 01 81 05 00 01 81 05 00 00 00 52 05' - '00 01 82 05 00 01 82 05 00 00 00 53 05 00 01 83 05 00 01 83 05 00 00 00 54 05 00 01 84 05 00 01' - '84 05 00 00 00 55 05 00 01 85 05 00 01 85 05 00 00 00 56 05 00 01 86 05 00 01 86 05 00 00 00 61' - '05 00 00 00 01 31 05 00 01 31 05 00 62 05 00 00 00 01 32 05 00 01 32 05 00 63 05 00 00 00 01 33' - '05 00 01 33 05 00 64 05 00 00 00 01 34 05 00 01 34 05 00 65 05 00 00 00 01 35 05 00 01 35 05 00' - '66 05 00 00 00 01 36 05 00 01 36 05 00 67 05 00 00 00 01 37 05 00 01 37 05 00 68 05 00 00 00 01' - '38 05 00 01 38 05 00 69 05 00 00 00 01 39 05 00 01 39 05 00 6A 05 00 00 00 01 3A 05 00 01 3A 05' - '00 6B 05 00 00 00 01 3B 05 00 01 3B 05 00 6C 05 00 00 00 01 3C 05 00 01 3C 05 00 6D 05 00 00 00' - '01 3D 05 00 01 3D 05 00 6E 05 00 00 00 01 3E 05 00 01 3E 05 00 6F 05 00 00 00 01 3F 05 00 01 3F' - '05 00 70 05 00 00 00 01 40 05 00 01 40 05 00 71 05 00 00 00 01 41 05 00 01 41 05 00 72 05 00 00' - '00 01 42 05 00 01 42 05 00 73 05 00 00 00 01 43 05 00 01 43 05 00 74 05 00 00 00 01 44 05 00 01' - '44 05 00 75 05 00 00 00 01 45 05 00 01 45 05 00 76 05 00 00 00 01 46 05 00 01 46 05 00 77 05 00' - '00 00 01 47 05 00 01 47 05 00 78 05 00 00 00 01 48 05 00 01 48 05 00 79 05 00 00 00 01 49 05 00' - '01 49 05 00 7A 05 00 00 00 01 4A 05 00 01 4A 05 00 7B 05 00 00 00 01 4B 05 00 01 4B 05 00 7C 05' - '00 00 00 01 4C 05 00 01 4C 05 00 7D 05 00 00 00 01 4D 05 00 01 4D 05 00 7E 05 00 00 00 01 4E 05' - '00 01 4E 05 00 7F 05 00 00 00 01 4F 05 00 01 4F 05 00 80 05 00 00 00 01 50 05 00 01 50 05 00 81' - '05 00 00 00 01 51 05 00 01 51 05 00 82 05 00 00 00 01 52 05 00 01 52 05 00 83 05 00 00 00 01 53' - '05 00 01 53 05 00 84 05 00 00 00 01 54 05 00 01 54 05 00 85 05 00 00 00 01 55 05 00 01 55 05 00' - '86 05 00 00 00 01 56 05 00 01 56 05 00 87 05 00 02 65 05 00 82 05 00 01 87 05 00 02 35 05 00 82' - '05 00 02 35 05 00 52 05 00 A0 10 00 01 00 2D 00 01 00 2D 00 00 00 A1 10 00 01 01 2D 00 01 01 2D' - '00 00 00 A2 10 00 01 02 2D 00 01 02 2D 00 00 00 A3 10 00 01 03 2D 00 01 03 2D 00 00 00 A4 10 00' - '01 04 2D 00 01 04 2D 00 00 00 A5 10 00 01 05 2D 00 01 05 2D 00 00 00 A6 10 00 01 06 2D 00 01 06' - '2D 00 00 00 A7 10 00 01 07 2D 00 01 07 2D 00 00 00 A8 10 00 01 08 2D 00 01 08 2D 00 00 00 A9 10' - '00 01 09 2D 00 01 09 2D 00 00 00 AA 10 00 01 0A 2D 00 01 0A 2D 00 00 00 AB 10 00 01 0B 2D 00 01' - '0B 2D 00 00 00 AC 10 00 01 0C 2D 00 01 0C 2D 00 00 00 AD 10 00 01 0D 2D 00 01 0D 2D 00 00 00 AE' - '10 00 01 0E 2D 00 01 0E 2D 00 00 00 AF 10 00 01 0F 2D 00 01 0F 2D 00 00 00 B0 10 00 01 10 2D 00' - '01 10 2D 00 00 00 B1 10 00 01 11 2D 00 01 11 2D 00 00 00 B2 10 00 01 12 2D 00 01 12 2D 00 00 00' - 'B3 10 00 01 13 2D 00 01 13 2D 00 00 00 B4 10 00 01 14 2D 00 01 14 2D 00 00 00 B5 10 00 01 15 2D' - '00 01 15 2D 00 00 00 B6 10 00 01 16 2D 00 01 16 2D 00 00 00 B7 10 00 01 17 2D 00 01 17 2D 00 00' - '00 B8 10 00 01 18 2D 00 01 18 2D 00 00 00 B9 10 00 01 19 2D 00 01 19 2D 00 00 00 BA 10 00 01 1A' - '2D 00 01 1A 2D 00 00 00 BB 10 00 01 1B 2D 00 01 1B 2D 00 00 00 BC 10 00 01 1C 2D 00 01 1C 2D 00' - '00 00 BD 10 00 01 1D 2D 00 01 1D 2D 00 00 00 BE 10 00 01 1E 2D 00 01 1E 2D 00 00 00 BF 10 00 01' - '1F 2D 00 01 1F 2D 00 00 00 C0 10 00 01 20 2D 00 01 20 2D 00 00 00 C1 10 00 01 21 2D 00 01 21 2D' - '00 00 00 C2 10 00 01 22 2D 00 01 22 2D 00 00 00 C3 10 00 01 23 2D 00 01 23 2D 00 00 00 C4 10 00' - '01 24 2D 00 01 24 2D 00 00 00 C5 10 00 01 25 2D 00 01 25 2D 00 00 00 C7 10 00 01 27 2D 00 01 27' - '2D 00 00 00 CD 10 00 01 2D 2D 00 01 2D 2D 00 00 00 D0 10 00 00 00 01 D0 10 00 01 90 1C 00 D1 10' - '00 00 00 01 D1 10 00 01 91 1C 00 D2 10 00 00 00 01 D2 10 00 01 92 1C 00 D3 10 00 00 00 01 D3 10' - '00 01 93 1C 00 D4 10 00 00 00 01 D4 10 00 01 94 1C 00 D5 10 00 00 00 01 D5 10 00 01 95 1C 00 D6' - '10 00 00 00 01 D6 10 00 01 96 1C 00 D7 10 00 00 00 01 D7 10 00 01 97 1C 00 D8 10 00 00 00 01 D8' - '10 00 01 98 1C 00 D9 10 00 00 00 01 D9 10 00 01 99 1C 00 DA 10 00 00 00 01 DA 10 00 01 9A 1C 00' - 'DB 10 00 00 00 01 DB 10 00 01 9B 1C 00 DC 10 00 00 00 01 DC 10 00 01 9C 1C 00 DD 10 00 00 00 01' - 'DD 10 00 01 9D 1C 00 DE 10 00 00 00 01 DE 10 00 01 9E 1C 00 DF 10 00 00 00 01 DF 10 00 01 9F 1C' - '00 E0 10 00 00 00 01 E0 10 00 01 A0 1C 00 E1 10 00 00 00 01 E1 10 00 01 A1 1C 00 E2 10 00 00 00' - '01 E2 10 00 01 A2 1C 00 E3 10 00 00 00 01 E3 10 00 01 A3 1C 00 E4 10 00 00 00 01 E4 10 00 01 A4' - '1C 00 E5 10 00 00 00 01 E5 10 00 01 A5 1C 00 E6 10 00 00 00 01 E6 10 00 01 A6 1C 00 E7 10 00 00' - '00 01 E7 10 00 01 A7 1C 00 E8 10 00 00 00 01 E8 10 00 01 A8 1C 00 E9 10 00 00 00 01 E9 10 00 01' - 'A9 1C 00 EA 10 00 00 00 01 EA 10 00 01 AA 1C 00 EB 10 00 00 00 01 EB 10 00 01 AB 1C 00 EC 10 00' - '00 00 01 EC 10 00 01 AC 1C 00 ED 10 00 00 00 01 ED 10 00 01 AD 1C 00 EE 10 00 00 00 01 EE 10 00' - '01 AE 1C 00 EF 10 00 00 00 01 EF 10 00 01 AF 1C 00 F0 10 00 00 00 01 F0 10 00 01 B0 1C 00 F1 10' - '00 00 00 01 F1 10 00 01 B1 1C 00 F2 10 00 00 00 01 F2 10 00 01 B2 1C 00 F3 10 00 00 00 01 F3 10' - '00 01 B3 1C 00 F4 10 00 00 00 01 F4 10 00 01 B4 1C 00 F5 10 00 00 00 01 F5 10 00 01 B5 1C 00 F6' - '10 00 00 00 01 F6 10 00 01 B6 1C 00 F7 10 00 00 00 01 F7 10 00 01 B7 1C 00 F8 10 00 00 00 01 F8' - '10 00 01 B8 1C 00 F9 10 00 00 00 01 F9 10 00 01 B9 1C 00 FA 10 00 00 00 01 FA 10 00 01 BA 1C 00' - 'FD 10 00 00 00 01 FD 10 00 01 BD 1C 00 FE 10 00 00 00 01 FE 10 00 01 BE 1C 00 FF 10 00 00 00 01' - 'FF 10 00 01 BF 1C 00 A0 13 00 00 01 70 AB 00 00 00 A1 13 00 00 01 71 AB 00 00 00 A2 13 00 00 01' - '72 AB 00 00 00 A3 13 00 00 01 73 AB 00 00 00 A4 13 00 00 01 74 AB 00 00 00 A5 13 00 00 01 75 AB' - '00 00 00 A6 13 00 00 01 76 AB 00 00 00 A7 13 00 00 01 77 AB 00 00 00 A8 13 00 00 01 78 AB 00 00' - '00 A9 13 00 00 01 79 AB 00 00 00 AA 13 00 00 01 7A AB 00 00 00 AB 13 00 00 01 7B AB 00 00 00 AC' - '13 00 00 01 7C AB 00 00 00 AD 13 00 00 01 7D AB 00 00 00 AE 13 00 00 01 7E AB 00 00 00 AF 13 00' - '00 01 7F AB 00 00 00 B0 13 00 00 01 80 AB 00 00 00 B1 13 00 00 01 81 AB 00 00 00 B2 13 00 00 01' - '82 AB 00 00 00 B3 13 00 00 01 83 AB 00 00 00 B4 13 00 00 01 84 AB 00 00 00 B5 13 00 00 01 85 AB' - '00 00 00 B6 13 00 00 01 86 AB 00 00 00 B7 13 00 00 01 87 AB 00 00 00 B8 13 00 00 01 88 AB 00 00' - '00 B9 13 00 00 01 89 AB 00 00 00 BA 13 00 00 01 8A AB 00 00 00 BB 13 00 00 01 8B AB 00 00 00 BC' - '13 00 00 01 8C AB 00 00 00 BD 13 00 00 01 8D AB 00 00 00 BE 13 00 00 01 8E AB 00 00 00 BF 13 00' - '00 01 8F AB 00 00 00 C0 13 00 00 01 90 AB 00 00 00 C1 13 00 00 01 91 AB 00 00 00 C2 13 00 00 01' - '92 AB 00 00 00 C3 13 00 00 01 93 AB 00 00 00 C4 13 00 00 01 94 AB 00 00 00 C5 13 00 00 01 95 AB' - '00 00 00 C6 13 00 00 01 96 AB 00 00 00 C7 13 00 00 01 97 AB 00 00 00 C8 13 00 00 01 98 AB 00 00' - '00 C9 13 00 00 01 99 AB 00 00 00 CA 13 00 00 01 9A AB 00 00 00 CB 13 00 00 01 9B AB 00 00 00 CC' - '13 00 00 01 9C AB 00 00 00 CD 13 00 00 01 9D AB 00 00 00 CE 13 00 00 01 9E AB 00 00 00 CF 13 00' - '00 01 9F AB 00 00 00 D0 13 00 00 01 A0 AB 00 00 00 D1 13 00 00 01 A1 AB 00 00 00 D2 13 00 00 01' - 'A2 AB 00 00 00 D3 13 00 00 01 A3 AB 00 00 00 D4 13 00 00 01 A4 AB 00 00 00 D5 13 00 00 01 A5 AB' - '00 00 00 D6 13 00 00 01 A6 AB 00 00 00 D7 13 00 00 01 A7 AB 00 00 00 D8 13 00 00 01 A8 AB 00 00' - '00 D9 13 00 00 01 A9 AB 00 00 00 DA 13 00 00 01 AA AB 00 00 00 DB 13 00 00 01 AB AB 00 00 00 DC' - '13 00 00 01 AC AB 00 00 00 DD 13 00 00 01 AD AB 00 00 00 DE 13 00 00 01 AE AB 00 00 00 DF 13 00' - '00 01 AF AB 00 00 00 E0 13 00 00 01 B0 AB 00 00 00 E1 13 00 00 01 B1 AB 00 00 00 E2 13 00 00 01' - 'B2 AB 00 00 00 E3 13 00 00 01 B3 AB 00 00 00 E4 13 00 00 01 B4 AB 00 00 00 E5 13 00 00 01 B5 AB' - '00 00 00 E6 13 00 00 01 B6 AB 00 00 00 E7 13 00 00 01 B7 AB 00 00 00 E8 13 00 00 01 B8 AB 00 00' - '00 E9 13 00 00 01 B9 AB 00 00 00 EA 13 00 00 01 BA AB 00 00 00 EB 13 00 00 01 BB AB 00 00 00 EC' - '13 00 00 01 BC AB 00 00 00 ED 13 00 00 01 BD AB 00 00 00 EE 13 00 00 01 BE AB 00 00 00 EF 13 00' - '00 01 BF AB 00 00 00 F0 13 00 00 01 F8 13 00 00 00 F1 13 00 00 01 F9 13 00 00 00 F2 13 00 00 01' - 'FA 13 00 00 00 F3 13 00 00 01 FB 13 00 00 00 F4 13 00 00 01 FC 13 00 00 00 F5 13 00 00 01 FD 13' - '00 00 00 F8 13 00 01 F0 13 00 00 01 F0 13 00 01 F0 13 00 F9 13 00 01 F1 13 00 00 01 F1 13 00 01' - 'F1 13 00 FA 13 00 01 F2 13 00 00 01 F2 13 00 01 F2 13 00 FB 13 00 01 F3 13 00 00 01 F3 13 00 01' - 'F3 13 00 FC 13 00 01 F4 13 00 00 01 F4 13 00 01 F4 13 00 FD 13 00 01 F5 13 00 00 01 F5 13 00 01' - 'F5 13 00 80 1C 00 01 32 04 00 00 01 12 04 00 01 12 04 00 81 1C 00 01 34 04 00 00 01 14 04 00 01' - '14 04 00 82 1C 00 01 3E 04 00 00 01 1E 04 00 01 1E 04 00 83 1C 00 01 41 04 00 00 01 21 04 00 01' - '21 04 00 84 1C 00 01 42 04 00 00 01 22 04 00 01 22 04 00 85 1C 00 01 42 04 00 00 01 22 04 00 01' - '22 04 00 86 1C 00 01 4A 04 00 00 01 2A 04 00 01 2A 04 00 87 1C 00 01 63 04 00 00 01 62 04 00 01' - '62 04 00 88 1C 00 01 4B A6 00 00 01 4A A6 00 01 4A A6 00 90 1C 00 01 D0 10 00 01 D0 10 00 00 00' - '91 1C 00 01 D1 10 00 01 D1 10 00 00 00 92 1C 00 01 D2 10 00 01 D2 10 00 00 00 93 1C 00 01 D3 10' - '00 01 D3 10 00 00 00 94 1C 00 01 D4 10 00 01 D4 10 00 00 00 95 1C 00 01 D5 10 00 01 D5 10 00 00' - '00 96 1C 00 01 D6 10 00 01 D6 10 00 00 00 97 1C 00 01 D7 10 00 01 D7 10 00 00 00 98 1C 00 01 D8' - '10 00 01 D8 10 00 00 00 99 1C 00 01 D9 10 00 01 D9 10 00 00 00 9A 1C 00 01 DA 10 00 01 DA 10 00' - '00 00 9B 1C 00 01 DB 10 00 01 DB 10 00 00 00 9C 1C 00 01 DC 10 00 01 DC 10 00 00 00 9D 1C 00 01' - 'DD 10 00 01 DD 10 00 00 00 9E 1C 00 01 DE 10 00 01 DE 10 00 00 00 9F 1C 00 01 DF 10 00 01 DF 10' - '00 00 00 A0 1C 00 01 E0 10 00 01 E0 10 00 00 00 A1 1C 00 01 E1 10 00 01 E1 10 00 00 00 A2 1C 00' - '01 E2 10 00 01 E2 10 00 00 00 A3 1C 00 01 E3 10 00 01 E3 10 00 00 00 A4 1C 00 01 E4 10 00 01 E4' - '10 00 00 00 A5 1C 00 01 E5 10 00 01 E5 10 00 00 00 A6 1C 00 01 E6 10 00 01 E6 10 00 00 00 A7 1C' - '00 01 E7 10 00 01 E7 10 00 00 00 A8 1C 00 01 E8 10 00 01 E8 10 00 00 00 A9 1C 00 01 E9 10 00 01' - 'E9 10 00 00 00 AA 1C 00 01 EA 10 00 01 EA 10 00 00 00 AB 1C 00 01 EB 10 00 01 EB 10 00 00 00 AC' - '1C 00 01 EC 10 00 01 EC 10 00 00 00 AD 1C 00 01 ED 10 00 01 ED 10 00 00 00 AE 1C 00 01 EE 10 00' - '01 EE 10 00 00 00 AF 1C 00 01 EF 10 00 01 EF 10 00 00 00 B0 1C 00 01 F0 10 00 01 F0 10 00 00 00' - 'B1 1C 00 01 F1 10 00 01 F1 10 00 00 00 B2 1C 00 01 F2 10 00 01 F2 10 00 00 00 B3 1C 00 01 F3 10' - '00 01 F3 10 00 00 00 B4 1C 00 01 F4 10 00 01 F4 10 00 00 00 B5 1C 00 01 F5 10 00 01 F5 10 00 00' - '00 B6 1C 00 01 F6 10 00 01 F6 10 00 00 00 B7 1C 00 01 F7 10 00 01 F7 10 00 00 00 B8 1C 00 01 F8' - '10 00 01 F8 10 00 00 00 B9 1C 00 01 F9 10 00 01 F9 10 00 00 00 BA 1C 00 01 FA 10 00 01 FA 10 00' - '00 00 BD 1C 00 01 FD 10 00 01 FD 10 00 00 00 BE 1C 00 01 FE 10 00 01 FE 10 00 00 00 BF 1C 00 01' - 'FF 10 00 01 FF 10 00 00 00 79 1D 00 00 00 01 7D A7 00 01 7D A7 00 7D 1D 00 00 00 01 63 2C 00 01' - '63 2C 00 8E 1D 00 00 00 01 C6 A7 00 01 C6 A7 00 00 1E 00 01 01 1E 00 01 01 1E 00 00 00 01 1E 00' - '00 00 01 00 1E 00 01 00 1E 00 02 1E 00 01 03 1E 00 01 03 1E 00 00 00 03 1E 00 00 00 01 02 1E 00' - '01 02 1E 00 04 1E 00 01 05 1E 00 01 05 1E 00 00 00 05 1E 00 00 00 01 04 1E 00 01 04 1E 00 06 1E' - '00 01 07 1E 00 01 07 1E 00 00 00 07 1E 00 00 00 01 06 1E 00 01 06 1E 00 08 1E 00 01 09 1E 00 01' - '09 1E 00 00 00 09 1E 00 00 00 01 08 1E 00 01 08 1E 00 0A 1E 00 01 0B 1E 00 01 0B 1E 00 00 00 0B' - '1E 00 00 00 01 0A 1E 00 01 0A 1E 00 0C 1E 00 01 0D 1E 00 01 0D 1E 00 00 00 0D 1E 00 00 00 01 0C' - '1E 00 01 0C 1E 00 0E 1E 00 01 0F 1E 00 01 0F 1E 00 00 00 0F 1E 00 00 00 01 0E 1E 00 01 0E 1E 00' - '10 1E 00 01 11 1E 00 01 11 1E 00 00 00 11 1E 00 00 00 01 10 1E 00 01 10 1E 00 12 1E 00 01 13 1E' - '00 01 13 1E 00 00 00 13 1E 00 00 00 01 12 1E 00 01 12 1E 00 14 1E 00 01 15 1E 00 01 15 1E 00 00' - '00 15 1E 00 00 00 01 14 1E 00 01 14 1E 00 16 1E 00 01 17 1E 00 01 17 1E 00 00 00 17 1E 00 00 00' - '01 16 1E 00 01 16 1E 00 18 1E 00 01 19 1E 00 01 19 1E 00 00 00 19 1E 00 00 00 01 18 1E 00 01 18' - '1E 00 1A 1E 00 01 1B 1E 00 01 1B 1E 00 00 00 1B 1E 00 00 00 01 1A 1E 00 01 1A 1E 00 1C 1E 00 01' - '1D 1E 00 01 1D 1E 00 00 00 1D 1E 00 00 00 01 1C 1E 00 01 1C 1E 00 1E 1E 00 01 1F 1E 00 01 1F 1E' - '00 00 00 1F 1E 00 00 00 01 1E 1E 00 01 1E 1E 00 20 1E 00 01 21 1E 00 01 21 1E 00 00 00 21 1E 00' - '00 00 01 20 1E 00 01 20 1E 00 22 1E 00 01 23 1E 00 01 23 1E 00 00 00 23 1E 00 00 00 01 22 1E 00' - '01 22 1E 00 24 1E 00 01 25 1E 00 01 25 1E 00 00 00 25 1E 00 00 00 01 24 1E 00 01 24 1E 00 26 1E' - '00 01 27 1E 00 01 27 1E 00 00 00 27 1E 00 00 00 01 26 1E 00 01 26 1E 00 28 1E 00 01 29 1E 00 01' - '29 1E 00 00 00 29 1E 00 00 00 01 28 1E 00 01 28 1E 00 2A 1E 00 01 2B 1E 00 01 2B 1E 00 00 00 2B' - '1E 00 00 00 01 2A 1E 00 01 2A 1E 00 2C 1E 00 01 2D 1E 00 01 2D 1E 00 00 00 2D 1E 00 00 00 01 2C' - '1E 00 01 2C 1E 00 2E 1E 00 01 2F 1E 00 01 2F 1E 00 00 00 2F 1E 00 00 00 01 2E 1E 00 01 2E 1E 00' - '30 1E 00 01 31 1E 00 01 31 1E 00 00 00 31 1E 00 00 00 01 30 1E 00 01 30 1E 00 32 1E 00 01 33 1E' - '00 01 33 1E 00 00 00 33 1E 00 00 00 01 32 1E 00 01 32 1E 00 34 1E 00 01 35 1E 00 01 35 1E 00 00' - '00 35 1E 00 00 00 01 34 1E 00 01 34 1E 00 36 1E 00 01 37 1E 00 01 37 1E 00 00 00 37 1E 00 00 00' - '01 36 1E 00 01 36 1E 00 38 1E 00 01 39 1E 00 01 39 1E 00 00 00 39 1E 00 00 00 01 38 1E 00 01 38' - '1E 00 3A 1E 00 01 3B 1E 00 01 3B 1E 00 00 00 3B 1E 00 00 00 01 3A 1E 00 01 3A 1E 00 3C 1E 00 01' - '3D 1E 00 01 3D 1E 00 00 00 3D 1E 00 00 00 01 3C 1E 00 01 3C 1E 00 3E 1E 00 01 3F 1E 00 01 3F 1E' - '00 00 00 3F 1E 00 00 00 01 3E 1E 00 01 3E 1E 00 40 1E 00 01 41 1E 00 01 41 1E 00 00 00 41 1E 00' - '00 00 01 40 1E 00 01 40 1E 00 42 1E 00 01 43 1E 00 01 43 1E 00 00 00 43 1E 00 00 00 01 42 1E 00' - '01 42 1E 00 44 1E 00 01 45 1E 00 01 45 1E 00 00 00 45 1E 00 00 00 01 44 1E 00 01 44 1E 00 46 1E' - '00 01 47 1E 00 01 47 1E 00 00 00 47 1E 00 00 00 01 46 1E 00 01 46 1E 00 48 1E 00 01 49 1E 00 01' - '49 1E 00 00 00 49 1E 00 00 00 01 48 1E 00 01 48 1E 00 4A 1E 00 01 4B 1E 00 01 4B 1E 00 00 00 4B' - '1E 00 00 00 01 4A 1E 00 01 4A 1E 00 4C 1E 00 01 4D 1E 00 01 4D 1E 00 00 00 4D 1E 00 00 00 01 4C' - '1E 00 01 4C 1E 00 4E 1E 00 01 4F 1E 00 01 4F 1E 00 00 00 4F 1E 00 00 00 01 4E 1E 00 01 4E 1E 00' - '50 1E 00 01 51 1E 00 01 51 1E 00 00 00 51 1E 00 00 00 01 50 1E 00 01 50 1E 00 52 1E 00 01 53 1E' - '00 01 53 1E 00 00 00 53 1E 00 00 00 01 52 1E 00 01 52 1E 00 54 1E 00 01 55 1E 00 01 55 1E 00 00' - '00 55 1E 00 00 00 01 54 1E 00 01 54 1E 00 56 1E 00 01 57 1E 00 01 57 1E 00 00 00 57 1E 00 00 00' - '01 56 1E 00 01 56 1E 00 58 1E 00 01 59 1E 00 01 59 1E 00 00 00 59 1E 00 00 00 01 58 1E 00 01 58' - '1E 00 5A 1E 00 01 5B 1E 00 01 5B 1E 00 00 00 5B 1E 00 00 00 01 5A 1E 00 01 5A 1E 00 5C 1E 00 01' - '5D 1E 00 01 5D 1E 00 00 00 5D 1E 00 00 00 01 5C 1E 00 01 5C 1E 00 5E 1E 00 01 5F 1E 00 01 5F 1E' - '00 00 00 5F 1E 00 00 00 01 5E 1E 00 01 5E 1E 00 60 1E 00 01 61 1E 00 01 61 1E 00 00 00 61 1E 00' - '00 00 01 60 1E 00 01 60 1E 00 62 1E 00 01 63 1E 00 01 63 1E 00 00 00 63 1E 00 00 00 01 62 1E 00' - '01 62 1E 00 64 1E 00 01 65 1E 00 01 65 1E 00 00 00 65 1E 00 00 00 01 64 1E 00 01 64 1E 00 66 1E' - '00 01 67 1E 00 01 67 1E 00 00 00 67 1E 00 00 00 01 66 1E 00 01 66 1E 00 68 1E 00 01 69 1E 00 01' - '69 1E 00 00 00 69 1E 00 00 00 01 68 1E 00 01 68 1E 00 6A 1E 00 01 6B 1E 00 01 6B 1E 00 00 00 6B' - '1E 00 00 00 01 6A 1E 00 01 6A 1E 00 6C 1E 00 01 6D 1E 00 01 6D 1E 00 00 00 6D 1E 00 00 00 01 6C' - '1E 00 01 6C 1E 00 6E 1E 00 01 6F 1E 00 01 6F 1E 00 00 00 6F 1E 00 00 00 01 6E 1E 00 01 6E 1E 00' - '70 1E 00 01 71 1E 00 01 71 1E 00 00 00 71 1E 00 00 00 01 70 1E 00 01 70 1E 00 72 1E 00 01 73 1E' - '00 01 73 1E 00 00 00 73 1E 00 00 00 01 72 1E 00 01 72 1E 00 74 1E 00 01 75 1E 00 01 75 1E 00 00' - '00 75 1E 00 00 00 01 74 1E 00 01 74 1E 00 76 1E 00 01 77 1E 00 01 77 1E 00 00 00 77 1E 00 00 00' - '01 76 1E 00 01 76 1E 00 78 1E 00 01 79 1E 00 01 79 1E 00 00 00 79 1E 00 00 00 01 78 1E 00 01 78' - '1E 00 7A 1E 00 01 7B 1E 00 01 7B 1E 00 00 00 7B 1E 00 00 00 01 7A 1E 00 01 7A 1E 00 7C 1E 00 01' - '7D 1E 00 01 7D 1E 00 00 00 7D 1E 00 00 00 01 7C 1E 00 01 7C 1E 00 7E 1E 00 01 7F 1E 00 01 7F 1E' - '00 00 00 7F 1E 00 00 00 01 7E 1E 00 01 7E 1E 00 80 1E 00 01 81 1E 00 01 81 1E 00 00 00 81 1E 00' - '00 00 01 80 1E 00 01 80 1E 00 82 1E 00 01 83 1E 00 01 83 1E 00 00 00 83 1E 00 00 00 01 82 1E 00' - '01 82 1E 00 84 1E 00 01 85 1E 00 01 85 1E 00 00 00 85 1E 00 00 00 01 84 1E 00 01 84 1E 00 86 1E' - '00 01 87 1E 00 01 87 1E 00 00 00 87 1E 00 00 00 01 86 1E 00 01 86 1E 00 88 1E 00 01 89 1E 00 01' - '89 1E 00 00 00 89 1E 00 00 00 01 88 1E 00 01 88 1E 00 8A 1E 00 01 8B 1E 00 01 8B 1E 00 00 00 8B' - '1E 00 00 00 01 8A 1E 00 01 8A 1E 00 8C 1E 00 01 8D 1E 00 01 8D 1E 00 00 00 8D 1E 00 00 00 01 8C' - '1E 00 01 8C 1E 00 8E 1E 00 01 8F 1E 00 01 8F 1E 00 00 00 8F 1E 00 00 00 01 8E 1E 00 01 8E 1E 00' - '90 1E 00 01 91 1E 00 01 91 1E 00 00 00 91 1E 00 00 00 01 90 1E 00 01 90 1E 00 92 1E 00 01 93 1E' - '00 01 93 1E 00 00 00 93 1E 00 00 00 01 92 1E 00 01 92 1E 00 94 1E 00 01 95 1E 00 01 95 1E 00 00' - '00 95 1E 00 00 00 01 94 1E 00 01 94 1E 00 96 1E 00 02 68 00 00 31 03 00 01 96 1E 00 02 48 00 00' - '31 03 00 02 48 00 00 31 03 00 97 1E 00 02 74 00 00 08 03 00 01 97 1E 00 02 54 00 00 08 03 00 02' - '54 00 00 08 03 00 98 1E 00 02 77 00 00 0A 03 00 01 98 1E 00 02 57 00 00 0A 03 00 02 57 00 00 0A' - '03 00 99 1E 00 02 79 00 00 0A 03 00 01 99 1E 00 02 59 00 00 0A 03 00 02 59 00 00 0A 03 00 9A 1E' - '00 02 61 00 00 BE 02 00 01 9A 1E 00 02 41 00 00 BE 02 00 02 41 00 00 BE 02 00 9B 1E 00 01 61 1E' - '00 00 01 60 1E 00 01 60 1E 00 9E 1E 00 02 73 00 00 73 00 00 01 DF 00 00 00 00 A0 1E 00 01 A1 1E' - '00 01 A1 1E 00 00 00 A1 1E 00 00 00 01 A0 1E 00 01 A0 1E 00 A2 1E 00 01 A3 1E 00 01 A3 1E 00 00' - '00 A3 1E 00 00 00 01 A2 1E 00 01 A2 1E 00 A4 1E 00 01 A5 1E 00 01 A5 1E 00 00 00 A5 1E 00 00 00' - '01 A4 1E 00 01 A4 1E 00 A6 1E 00 01 A7 1E 00 01 A7 1E 00 00 00 A7 1E 00 00 00 01 A6 1E 00 01 A6' - '1E 00 A8 1E 00 01 A9 1E 00 01 A9 1E 00 00 00 A9 1E 00 00 00 01 A8 1E 00 01 A8 1E 00 AA 1E 00 01' - 'AB 1E 00 01 AB 1E 00 00 00 AB 1E 00 00 00 01 AA 1E 00 01 AA 1E 00 AC 1E 00 01 AD 1E 00 01 AD 1E' - '00 00 00 AD 1E 00 00 00 01 AC 1E 00 01 AC 1E 00 AE 1E 00 01 AF 1E 00 01 AF 1E 00 00 00 AF 1E 00' - '00 00 01 AE 1E 00 01 AE 1E 00 B0 1E 00 01 B1 1E 00 01 B1 1E 00 00 00 B1 1E 00 00 00 01 B0 1E 00' - '01 B0 1E 00 B2 1E 00 01 B3 1E 00 01 B3 1E 00 00 00 B3 1E 00 00 00 01 B2 1E 00 01 B2 1E 00 B4 1E' - '00 01 B5 1E 00 01 B5 1E 00 00 00 B5 1E 00 00 00 01 B4 1E 00 01 B4 1E 00 B6 1E 00 01 B7 1E 00 01' - 'B7 1E 00 00 00 B7 1E 00 00 00 01 B6 1E 00 01 B6 1E 00 B8 1E 00 01 B9 1E 00 01 B9 1E 00 00 00 B9' - '1E 00 00 00 01 B8 1E 00 01 B8 1E 00 BA 1E 00 01 BB 1E 00 01 BB 1E 00 00 00 BB 1E 00 00 00 01 BA' - '1E 00 01 BA 1E 00 BC 1E 00 01 BD 1E 00 01 BD 1E 00 00 00 BD 1E 00 00 00 01 BC 1E 00 01 BC 1E 00' - 'BE 1E 00 01 BF 1E 00 01 BF 1E 00 00 00 BF 1E 00 00 00 01 BE 1E 00 01 BE 1E 00 C0 1E 00 01 C1 1E' - '00 01 C1 1E 00 00 00 C1 1E 00 00 00 01 C0 1E 00 01 C0 1E 00 C2 1E 00 01 C3 1E 00 01 C3 1E 00 00' - '00 C3 1E 00 00 00 01 C2 1E 00 01 C2 1E 00 C4 1E 00 01 C5 1E 00 01 C5 1E 00 00 00 C5 1E 00 00 00' - '01 C4 1E 00 01 C4 1E 00 C6 1E 00 01 C7 1E 00 01 C7 1E 00 00 00 C7 1E 00 00 00 01 C6 1E 00 01 C6' - '1E 00 C8 1E 00 01 C9 1E 00 01 C9 1E 00 00 00 C9 1E 00 00 00 01 C8 1E 00 01 C8 1E 00 CA 1E 00 01' - 'CB 1E 00 01 CB 1E 00 00 00 CB 1E 00 00 00 01 CA 1E 00 01 CA 1E 00 CC 1E 00 01 CD 1E 00 01 CD 1E' - '00 00 00 CD 1E 00 00 00 01 CC 1E 00 01 CC 1E 00 CE 1E 00 01 CF 1E 00 01 CF 1E 00 00 00 CF 1E 00' - '00 00 01 CE 1E 00 01 CE 1E 00 D0 1E 00 01 D1 1E 00 01 D1 1E 00 00 00 D1 1E 00 00 00 01 D0 1E 00' - '01 D0 1E 00 D2 1E 00 01 D3 1E 00 01 D3 1E 00 00 00 D3 1E 00 00 00 01 D2 1E 00 01 D2 1E 00 D4 1E' - '00 01 D5 1E 00 01 D5 1E 00 00 00 D5 1E 00 00 00 01 D4 1E 00 01 D4 1E 00 D6 1E 00 01 D7 1E 00 01' - 'D7 1E 00 00 00 D7 1E 00 00 00 01 D6 1E 00 01 D6 1E 00 D8 1E 00 01 D9 1E 00 01 D9 1E 00 00 00 D9' - '1E 00 00 00 01 D8 1E 00 01 D8 1E 00 DA 1E 00 01 DB 1E 00 01 DB 1E 00 00 00 DB 1E 00 00 00 01 DA' - '1E 00 01 DA 1E 00 DC 1E 00 01 DD 1E 00 01 DD 1E 00 00 00 DD 1E 00 00 00 01 DC 1E 00 01 DC 1E 00' - 'DE 1E 00 01 DF 1E 00 01 DF 1E 00 00 00 DF 1E 00 00 00 01 DE 1E 00 01 DE 1E 00 E0 1E 00 01 E1 1E' - '00 01 E1 1E 00 00 00 E1 1E 00 00 00 01 E0 1E 00 01 E0 1E 00 E2 1E 00 01 E3 1E 00 01 E3 1E 00 00' - '00 E3 1E 00 00 00 01 E2 1E 00 01 E2 1E 00 E4 1E 00 01 E5 1E 00 01 E5 1E 00 00 00 E5 1E 00 00 00' - '01 E4 1E 00 01 E4 1E 00 E6 1E 00 01 E7 1E 00 01 E7 1E 00 00 00 E7 1E 00 00 00 01 E6 1E 00 01 E6' - '1E 00 E8 1E 00 01 E9 1E 00 01 E9 1E 00 00 00 E9 1E 00 00 00 01 E8 1E 00 01 E8 1E 00 EA 1E 00 01' - 'EB 1E 00 01 EB 1E 00 00 00 EB 1E 00 00 00 01 EA 1E 00 01 EA 1E 00 EC 1E 00 01 ED 1E 00 01 ED 1E' - '00 00 00 ED 1E 00 00 00 01 EC 1E 00 01 EC 1E 00 EE 1E 00 01 EF 1E 00 01 EF 1E 00 00 00 EF 1E 00' - '00 00 01 EE 1E 00 01 EE 1E 00 F0 1E 00 01 F1 1E 00 01 F1 1E 00 00 00 F1 1E 00 00 00 01 F0 1E 00' - '01 F0 1E 00 F2 1E 00 01 F3 1E 00 01 F3 1E 00 00 00 F3 1E 00 00 00 01 F2 1E 00 01 F2 1E 00 F4 1E' - '00 01 F5 1E 00 01 F5 1E 00 00 00 F5 1E 00 00 00 01 F4 1E 00 01 F4 1E 00 F6 1E 00 01 F7 1E 00 01' - 'F7 1E 00 00 00 F7 1E 00 00 00 01 F6 1E 00 01 F6 1E 00 F8 1E 00 01 F9 1E 00 01 F9 1E 00 00 00 F9' - '1E 00 00 00 01 F8 1E 00 01 F8 1E 00 FA 1E 00 01 FB 1E 00 01 FB 1E 00 00 00 FB 1E 00 00 00 01 FA' - '1E 00 01 FA 1E 00 FC 1E 00 01 FD 1E 00 01 FD 1E 00 00 00 FD 1E 00 00 00 01 FC 1E 00 01 FC 1E 00' - 'FE 1E 00 01 FF 1E 00 01 FF 1E 00 00 00 FF 1E 00 00 00 01 FE 1E 00 01 FE 1E 00 00 1F 00 00 00 01' - '08 1F 00 01 08 1F 00 01 1F 00 00 00 01 09 1F 00 01 09 1F 00 02 1F 00 00 00 01 0A 1F 00 01 0A 1F' - '00 03 1F 00 00 00 01 0B 1F 00 01 0B 1F 00 04 1F 00 00 00 01 0C 1F 00 01 0C 1F 00 05 1F 00 00 00' - '01 0D 1F 00 01 0D 1F 00 06 1F 00 00 00 01 0E 1F 00 01 0E 1F 00 07 1F 00 00 00 01 0F 1F 00 01 0F' - '1F 00 08 1F 00 01 00 1F 00 01 00 1F 00 00 00 09 1F 00 01 01 1F 00 01 01 1F 00 00 00 0A 1F 00 01' - '02 1F 00 01 02 1F 00 00 00 0B 1F 00 01 03 1F 00 01 03 1F 00 00 00 0C 1F 00 01 04 1F 00 01 04 1F' - '00 00 00 0D 1F 00 01 05 1F 00 01 05 1F 00 00 00 0E 1F 00 01 06 1F 00 01 06 1F 00 00 00 0F 1F 00' - '01 07 1F 00 01 07 1F 00 00 00 10 1F 00 00 00 01 18 1F 00 01 18 1F 00 11 1F 00 00 00 01 19 1F 00' - '01 19 1F 00 12 1F 00 00 00 01 1A 1F 00 01 1A 1F 00 13 1F 00 00 00 01 1B 1F 00 01 1B 1F 00 14 1F' - '00 00 00 01 1C 1F 00 01 1C 1F 00 15 1F 00 00 00 01 1D 1F 00 01 1D 1F 00 18 1F 00 01 10 1F 00 01' - '10 1F 00 00 00 19 1F 00 01 11 1F 00 01 11 1F 00 00 00 1A 1F 00 01 12 1F 00 01 12 1F 00 00 00 1B' - '1F 00 01 13 1F 00 01 13 1F 00 00 00 1C 1F 00 01 14 1F 00 01 14 1F 00 00 00 1D 1F 00 01 15 1F 00' - '01 15 1F 00 00 00 20 1F 00 00 00 01 28 1F 00 01 28 1F 00 21 1F 00 00 00 01 29 1F 00 01 29 1F 00' - '22 1F 00 00 00 01 2A 1F 00 01 2A 1F 00 23 1F 00 00 00 01 2B 1F 00 01 2B 1F 00 24 1F 00 00 00 01' - '2C 1F 00 01 2C 1F 00 25 1F 00 00 00 01 2D 1F 00 01 2D 1F 00 26 1F 00 00 00 01 2E 1F 00 01 2E 1F' - '00 27 1F 00 00 00 01 2F 1F 00 01 2F 1F 00 28 1F 00 01 20 1F 00 01 20 1F 00 00 00 29 1F 00 01 21' - '1F 00 01 21 1F 00 00 00 2A 1F 00 01 22 1F 00 01 22 1F 00 00 00 2B 1F 00 01 23 1F 00 01 23 1F 00' - '00 00 2C 1F 00 01 24 1F 00 01 24 1F 00 00 00 2D 1F 00 01 25 1F 00 01 25 1F 00 00 00 2E 1F 00 01' - '26 1F 00 01 26 1F 00 00 00 2F 1F 00 01 27 1F 00 01 27 1F 00 00 00 30 1F 00 00 00 01 38 1F 00 01' - '38 1F 00 31 1F 00 00 00 01 39 1F 00 01 39 1F 00 32 1F 00 00 00 01 3A 1F 00 01 3A 1F 00 33 1F 00' - '00 00 01 3B 1F 00 01 3B 1F 00 34 1F 00 00 00 01 3C 1F 00 01 3C 1F 00 35 1F 00 00 00 01 3D 1F 00' - '01 3D 1F 00 36 1F 00 00 00 01 3E 1F 00 01 3E 1F 00 37 1F 00 00 00 01 3F 1F 00 01 3F 1F 00 38 1F' - '00 01 30 1F 00 01 30 1F 00 00 00 39 1F 00 01 31 1F 00 01 31 1F 00 00 00 3A 1F 00 01 32 1F 00 01' - '32 1F 00 00 00 3B 1F 00 01 33 1F 00 01 33 1F 00 00 00 3C 1F 00 01 34 1F 00 01 34 1F 00 00 00 3D' - '1F 00 01 35 1F 00 01 35 1F 00 00 00 3E 1F 00 01 36 1F 00 01 36 1F 00 00 00 3F 1F 00 01 37 1F 00' - '01 37 1F 00 00 00 40 1F 00 00 00 01 48 1F 00 01 48 1F 00 41 1F 00 00 00 01 49 1F 00 01 49 1F 00' - '42 1F 00 00 00 01 4A 1F 00 01 4A 1F 00 43 1F 00 00 00 01 4B 1F 00 01 4B 1F 00 44 1F 00 00 00 01' - '4C 1F 00 01 4C 1F 00 45 1F 00 00 00 01 4D 1F 00 01 4D 1F 00 48 1F 00 01 40 1F 00 01 40 1F 00 00' - '00 49 1F 00 01 41 1F 00 01 41 1F 00 00 00 4A 1F 00 01 42 1F 00 01 42 1F 00 00 00 4B 1F 00 01 43' - '1F 00 01 43 1F 00 00 00 4C 1F 00 01 44 1F 00 01 44 1F 00 00 00 4D 1F 00 01 45 1F 00 01 45 1F 00' - '00 00 50 1F 00 02 C5 03 00 13 03 00 01 50 1F 00 02 A5 03 00 13 03 00 02 A5 03 00 13 03 00 51 1F' - '00 00 00 01 59 1F 00 01 59 1F 00 52 1F 00 03 C5 03 00 13 03 00 00 03 00 01 52 1F 00 03 A5 03 00' - '13 03 00 00 03 00 03 A5 03 00 13 03 00 00 03 00 53 1F 00 00 00 01 5B 1F 00 01 5B 1F 00 54 1F 00' - '03 C5 03 00 13 03 00 01 03 00 01 54 1F 00 03 A5 03 00 13 03 00 01 03 00 03 A5 03 00 13 03 00 01' - '03 00 55 1F 00 00 00 01 5D 1F 00 01 5D 1F 00 56 1F 00 03 C5 03 00 13 03 00 42 03 00 01 56 1F 00' - '03 A5 03 00 13 03 00 42 03 00 03 A5 03 00 13 03 00 42 03 00 57 1F 00 00 00 01 5F 1F 00 01 5F 1F' - '00 59 1F 00 01 51 1F 00 01 51 1F 00 00 00 5B 1F 00 01 53 1F 00 01 53 1F 00 00 00 5D 1F 00 01 55' - '1F 00 01 55 1F 00 00 00 5F 1F 00 01 57 1F 00 01 57 1F 00 00 00 60 1F 00 00 00 01 68 1F 00 01 68' - '1F 00 61 1F 00 00 00 01 69 1F 00 01 69 1F 00 62 1F 00 00 00 01 6A 1F 00 01 6A 1F 00 63 1F 00 00' - '00 01 6B 1F 00 01 6B 1F 00 64 1F 00 00 00 01 6C 1F 00 01 6C 1F 00 65 1F 00 00 00 01 6D 1F 00 01' - '6D 1F 00 66 1F 00 00 00 01 6E 1F 00 01 6E 1F 00 67 1F 00 00 00 01 6F 1F 00 01 6F 1F 00 68 1F 00' - '01 60 1F 00 01 60 1F 00 00 00 69 1F 00 01 61 1F 00 01 61 1F 00 00 00 6A 1F 00 01 62 1F 00 01 62' - '1F 00 00 00 6B 1F 00 01 63 1F 00 01 63 1F 00 00 00 6C 1F 00 01 64 1F 00 01 64 1F 00 00 00 6D 1F' - '00 01 65 1F 00 01 65 1F 00 00 00 6E 1F 00 01 66 1F 00 01 66 1F 00 00 00 6F 1F 00 01 67 1F 00 01' - '67 1F 00 00 00 70 1F 00 00 00 01 BA 1F 00 01 BA 1F 00 71 1F 00 00 00 01 BB 1F 00 01 BB 1F 00 72' - '1F 00 00 00 01 C8 1F 00 01 C8 1F 00 73 1F 00 00 00 01 C9 1F 00 01 C9 1F 00 74 1F 00 00 00 01 CA' - '1F 00 01 CA 1F 00 75 1F 00 00 00 01 CB 1F 00 01 CB 1F 00 76 1F 00 00 00 01 DA 1F 00 01 DA 1F 00' - '77 1F 00 00 00 01 DB 1F 00 01 DB 1F 00 78 1F 00 00 00 01 F8 1F 00 01 F8 1F 00 79 1F 00 00 00 01' - 'F9 1F 00 01 F9 1F 00 7A 1F 00 00 00 01 EA 1F 00 01 EA 1F 00 7B 1F 00 00 00 01 EB 1F 00 01 EB 1F' - '00 7C 1F 00 00 00 01 FA 1F 00 01 FA 1F 00 7D 1F 00 00 00 01 FB 1F 00 01 FB 1F 00 80 1F 00 02 00' - '1F 00 B9 03 00 01 80 1F 00 01 88 1F 00 01 88 1F 00 81 1F 00 02 01 1F 00 B9 03 00 01 81 1F 00 01' - '89 1F 00 01 89 1F 00 82 1F 00 02 02 1F 00 B9 03 00 01 82 1F 00 01 8A 1F 00 01 8A 1F 00 83 1F 00' - '02 03 1F 00 B9 03 00 01 83 1F 00 01 8B 1F 00 01 8B 1F 00 84 1F 00 02 04 1F 00 B9 03 00 01 84 1F' - '00 01 8C 1F 00 01 8C 1F 00 85 1F 00 02 05 1F 00 B9 03 00 01 85 1F 00 01 8D 1F 00 01 8D 1F 00 86' - '1F 00 02 06 1F 00 B9 03 00 01 86 1F 00 01 8E 1F 00 01 8E 1F 00 87 1F 00 02 07 1F 00 B9 03 00 01' - '87 1F 00 01 8F 1F 00 01 8F 1F 00 88 1F 00 02 00 1F 00 B9 03 00 01 80 1F 00 01 88 1F 00 02 08 1F' - '00 99 03 00 89 1F 00 02 01 1F 00 B9 03 00 01 81 1F 00 01 89 1F 00 02 09 1F 00 99 03 00 8A 1F 00' - '02 02 1F 00 B9 03 00 01 82 1F 00 01 8A 1F 00 02 0A 1F 00 99 03 00 8B 1F 00 02 03 1F 00 B9 03 00' - '01 83 1F 00 01 8B 1F 00 02 0B 1F 00 99 03 00 8C 1F 00 02 04 1F 00 B9 03 00 01 84 1F 00 01 8C 1F' - '00 02 0C 1F 00 99 03 00 8D 1F 00 02 05 1F 00 B9 03 00 01 85 1F 00 01 8D 1F 00 02 0D 1F 00 99 03' - '00 8E 1F 00 02 06 1F 00 B9 03 00 01 86 1F 00 01 8E 1F 00 02 0E 1F 00 99 03 00 8F 1F 00 02 07 1F' - '00 B9 03 00 01 87 1F 00 01 8F 1F 00 02 0F 1F 00 99 03 00 90 1F 00 02 20 1F 00 B9 03 00 01 90 1F' - '00 01 98 1F 00 01 98 1F 00 91 1F 00 02 21 1F 00 B9 03 00 01 91 1F 00 01 99 1F 00 01 99 1F 00 92' - '1F 00 02 22 1F 00 B9 03 00 01 92 1F 00 01 9A 1F 00 01 9A 1F 00 93 1F 00 02 23 1F 00 B9 03 00 01' - '93 1F 00 01 9B 1F 00 01 9B 1F 00 94 1F 00 02 24 1F 00 B9 03 00 01 94 1F 00 01 9C 1F 00 01 9C 1F' - '00 95 1F 00 02 25 1F 00 B9 03 00 01 95 1F 00 01 9D 1F 00 01 9D 1F 00 96 1F 00 02 26 1F 00 B9 03' - '00 01 96 1F 00 01 9E 1F 00 01 9E 1F 00 97 1F 00 02 27 1F 00 B9 03 00 01 97 1F 00 01 9F 1F 00 01' - '9F 1F 00 98 1F 00 02 20 1F 00 B9 03 00 01 90 1F 00 01 98 1F 00 02 28 1F 00 99 03 00 99 1F 00 02' - '21 1F 00 B9 03 00 01 91 1F 00 01 99 1F 00 02 29 1F 00 99 03 00 9A 1F 00 02 22 1F 00 B9 03 00 01' - '92 1F 00 01 9A 1F 00 02 2A 1F 00 99 03 00 9B 1F 00 02 23 1F 00 B9 03 00 01 93 1F 00 01 9B 1F 00' - '02 2B 1F 00 99 03 00 9C 1F 00 02 24 1F 00 B9 03 00 01 94 1F 00 01 9C 1F 00 02 2C 1F 00 99 03 00' - '9D 1F 00 02 25 1F 00 B9 03 00 01 95 1F 00 01 9D 1F 00 02 2D 1F 00 99 03 00 9E 1F 00 02 26 1F 00' - 'B9 03 00 01 96 1F 00 01 9E 1F 00 02 2E 1F 00 99 03 00 9F 1F 00 02 27 1F 00 B9 03 00 01 97 1F 00' - '01 9F 1F 00 02 2F 1F 00 99 03 00 A0 1F 00 02 60 1F 00 B9 03 00 01 A0 1F 00 01 A8 1F 00 01 A8 1F' - '00 A1 1F 00 02 61 1F 00 B9 03 00 01 A1 1F 00 01 A9 1F 00 01 A9 1F 00 A2 1F 00 02 62 1F 00 B9 03' - '00 01 A2 1F 00 01 AA 1F 00 01 AA 1F 00 A3 1F 00 02 63 1F 00 B9 03 00 01 A3 1F 00 01 AB 1F 00 01' - 'AB 1F 00 A4 1F 00 02 64 1F 00 B9 03 00 01 A4 1F 00 01 AC 1F 00 01 AC 1F 00 A5 1F 00 02 65 1F 00' - 'B9 03 00 01 A5 1F 00 01 AD 1F 00 01 AD 1F 00 A6 1F 00 02 66 1F 00 B9 03 00 01 A6 1F 00 01 AE 1F' - '00 01 AE 1F 00 A7 1F 00 02 67 1F 00 B9 03 00 01 A7 1F 00 01 AF 1F 00 01 AF 1F 00 A8 1F 00 02 60' - '1F 00 B9 03 00 01 A0 1F 00 01 A8 1F 00 02 68 1F 00 99 03 00 A9 1F 00 02 61 1F 00 B9 03 00 01 A1' - '1F 00 01 A9 1F 00 02 69 1F 00 99 03 00 AA 1F 00 02 62 1F 00 B9 03 00 01 A2 1F 00 01 AA 1F 00 02' - '6A 1F 00 99 03 00 AB 1F 00 02 63 1F 00 B9 03 00 01 A3 1F 00 01 AB 1F 00 02 6B 1F 00 99 03 00 AC' - '1F 00 02 64 1F 00 B9 03 00 01 A4 1F 00 01 AC 1F 00 02 6C 1F 00 99 03 00 AD 1F 00 02 65 1F 00 B9' - '03 00 01 A5 1F 00 01 AD 1F 00 02 6D 1F 00 99 03 00 AE 1F 00 02 66 1F 00 B9 03 00 01 A6 1F 00 01' - 'AE 1F 00 02 6E 1F 00 99 03 00 AF 1F 00 02 67 1F 00 B9 03 00 01 A7 1F 00 01 AF 1F 00 02 6F 1F 00' - '99 03 00 B0 1F 00 00 00 01 B8 1F 00 01 B8 1F 00 B1 1F 00 00 00 01 B9 1F 00 01 B9 1F 00 B2 1F 00' - '02 70 1F 00 B9 03 00 01 B2 1F 00 02 BA 1F 00 45 03 00 02 BA 1F 00 99 03 00 B3 1F 00 02 B1 03 00' - 'B9 03 00 01 B3 1F 00 01 BC 1F 00 01 BC 1F 00 B4 1F 00 02 AC 03 00 B9 03 00 01 B4 1F 00 02 86 03' - '00 45 03 00 02 86 03 00 99 03 00 B6 1F 00 02 B1 03 00 42 03 00 01 B6 1F 00 02 91 03 00 42 03 00' - '02 91 03 00 42 03 00 B7 1F 00 03 B1 03 00 42 03 00 B9 03 00 01 B7 1F 00 03 91 03 00 42 03 00 45' - '03 00 03 91 03 00 42 03 00 99 03 00 B8 1F 00 01 B0 1F 00 01 B0 1F 00 00 00 B9 1F 00 01 B1 1F 00' - '01 B1 1F 00 00 00 BA 1F 00 01 70 1F 00 01 70 1F 00 00 00 BB 1F 00 01 71 1F 00 01 71 1F 00 00 00' - 'BC 1F 00 02 B1 03 00 B9 03 00 01 B3 1F 00 01 BC 1F 00 02 91 03 00 99 03 00 BE 1F 00 01 B9 03 00' - '00 01 99 03 00 01 99 03 00 C2 1F 00 02 74 1F 00 B9 03 00 01 C2 1F 00 02 CA 1F 00 45 03 00 02 CA' - '1F 00 99 03 00 C3 1F 00 02 B7 03 00 B9 03 00 01 C3 1F 00 01 CC 1F 00 01 CC 1F 00 C4 1F 00 02 AE' - '03 00 B9 03 00 01 C4 1F 00 02 89 03 00 45 03 00 02 89 03 00 99 03 00 C6 1F 00 02 B7 03 00 42 03' - '00 01 C6 1F 00 02 97 03 00 42 03 00 02 97 03 00 42 03 00 C7 1F 00 03 B7 03 00 42 03 00 B9 03 00' - '01 C7 1F 00 03 97 03 00 42 03 00 45 03 00 03 97 03 00 42 03 00 99 03 00 C8 1F 00 01 72 1F 00 01' - '72 1F 00 00 00 C9 1F 00 01 73 1F 00 01 73 1F 00 00 00 CA 1F 00 01 74 1F 00 01 74 1F 00 00 00 CB' - '1F 00 01 75 1F 00 01 75 1F 00 00 00 CC 1F 00 02 B7 03 00 B9 03 00 01 C3 1F 00 01 CC 1F 00 02 97' - '03 00 99 03 00 D0 1F 00 00 00 01 D8 1F 00 01 D8 1F 00 D1 1F 00 00 00 01 D9 1F 00 01 D9 1F 00 D2' - '1F 00 03 B9 03 00 08 03 00 00 03 00 01 D2 1F 00 03 99 03 00 08 03 00 00 03 00 03 99 03 00 08 03' - '00 00 03 00 D3 1F 00 03 B9 03 00 08 03 00 01 03 00 01 D3 1F 00 03 99 03 00 08 03 00 01 03 00 03' - '99 03 00 08 03 00 01 03 00 D6 1F 00 02 B9 03 00 42 03 00 01 D6 1F 00 02 99 03 00 42 03 00 02 99' - '03 00 42 03 00 D7 1F 00 03 B9 03 00 08 03 00 42 03 00 01 D7 1F 00 03 99 03 00 08 03 00 42 03 00' - '03 99 03 00 08 03 00 42 03 00 D8 1F 00 01 D0 1F 00 01 D0 1F 00 00 00 D9 1F 00 01 D1 1F 00 01 D1' - '1F 00 00 00 DA 1F 00 01 76 1F 00 01 76 1F 00 00 00 DB 1F 00 01 77 1F 00 01 77 1F 00 00 00 E0 1F' - '00 00 00 01 E8 1F 00 01 E8 1F 00 E1 1F 00 00 00 01 E9 1F 00 01 E9 1F 00 E2 1F 00 03 C5 03 00 08' - '03 00 00 03 00 01 E2 1F 00 03 A5 03 00 08 03 00 00 03 00 03 A5 03 00 08 03 00 00 03 00 E3 1F 00' - '03 C5 03 00 08 03 00 01 03 00 01 E3 1F 00 03 A5 03 00 08 03 00 01 03 00 03 A5 03 00 08 03 00 01' - '03 00 E4 1F 00 02 C1 03 00 13 03 00 01 E4 1F 00 02 A1 03 00 13 03 00 02 A1 03 00 13 03 00 E5 1F' - '00 00 00 01 EC 1F 00 01 EC 1F 00 E6 1F 00 02 C5 03 00 42 03 00 01 E6 1F 00 02 A5 03 00 42 03 00' - '02 A5 03 00 42 03 00 E7 1F 00 03 C5 03 00 08 03 00 42 03 00 01 E7 1F 00 03 A5 03 00 08 03 00 42' - '03 00 03 A5 03 00 08 03 00 42 03 00 E8 1F 00 01 E0 1F 00 01 E0 1F 00 00 00 E9 1F 00 01 E1 1F 00' - '01 E1 1F 00 00 00 EA 1F 00 01 7A 1F 00 01 7A 1F 00 00 00 EB 1F 00 01 7B 1F 00 01 7B 1F 00 00 00' - 'EC 1F 00 01 E5 1F 00 01 E5 1F 00 00 00 F2 1F 00 02 7C 1F 00 B9 03 00 01 F2 1F 00 02 FA 1F 00 45' - '03 00 02 FA 1F 00 99 03 00 F3 1F 00 02 C9 03 00 B9 03 00 01 F3 1F 00 01 FC 1F 00 01 FC 1F 00 F4' - '1F 00 02 CE 03 00 B9 03 00 01 F4 1F 00 02 8F 03 00 45 03 00 02 8F 03 00 99 03 00 F6 1F 00 02 C9' - '03 00 42 03 00 01 F6 1F 00 02 A9 03 00 42 03 00 02 A9 03 00 42 03 00 F7 1F 00 03 C9 03 00 42 03' - '00 B9 03 00 01 F7 1F 00 03 A9 03 00 42 03 00 45 03 00 03 A9 03 00 42 03 00 99 03 00 F8 1F 00 01' - '78 1F 00 01 78 1F 00 00 00 F9 1F 00 01 79 1F 00 01 79 1F 00 00 00 FA 1F 00 01 7C 1F 00 01 7C 1F' - '00 00 00 FB 1F 00 01 7D 1F 00 01 7D 1F 00 00 00 FC 1F 00 02 C9 03 00 B9 03 00 01 F3 1F 00 01 FC' - '1F 00 02 A9 03 00 99 03 00 26 21 00 01 C9 03 00 01 C9 03 00 00 00 2A 21 00 01 6B 00 00 01 6B 00' - '00 00 00 2B 21 00 01 E5 00 00 01 E5 00 00 00 00 32 21 00 01 4E 21 00 01 4E 21 00 00 00 4E 21 00' - '00 00 01 32 21 00 01 32 21 00 60 21 00 01 70 21 00 01 70 21 00 00 00 61 21 00 01 71 21 00 01 71' - '21 00 00 00 62 21 00 01 72 21 00 01 72 21 00 00 00 63 21 00 01 73 21 00 01 73 21 00 00 00 64 21' - '00 01 74 21 00 01 74 21 00 00 00 65 21 00 01 75 21 00 01 75 21 00 00 00 66 21 00 01 76 21 00 01' - '76 21 00 00 00 67 21 00 01 77 21 00 01 77 21 00 00 00 68 21 00 01 78 21 00 01 78 21 00 00 00 69' - '21 00 01 79 21 00 01 79 21 00 00 00 6A 21 00 01 7A 21 00 01 7A 21 00 00 00 6B 21 00 01 7B 21 00' - '01 7B 21 00 00 00 6C 21 00 01 7C 21 00 01 7C 21 00 00 00 6D 21 00 01 7D 21 00 01 7D 21 00 00 00' - '6E 21 00 01 7E 21 00 01 7E 21 00 00 00 6F 21 00 01 7F 21 00 01 7F 21 00 00 00 70 21 00 00 00 01' - '60 21 00 01 60 21 00 71 21 00 00 00 01 61 21 00 01 61 21 00 72 21 00 00 00 01 62 21 00 01 62 21' - '00 73 21 00 00 00 01 63 21 00 01 63 21 00 74 21 00 00 00 01 64 21 00 01 64 21 00 75 21 00 00 00' - '01 65 21 00 01 65 21 00 76 21 00 00 00 01 66 21 00 01 66 21 00 77 21 00 00 00 01 67 21 00 01 67' - '21 00 78 21 00 00 00 01 68 21 00 01 68 21 00 79 21 00 00 00 01 69 21 00 01 69 21 00 7A 21 00 00' - '00 01 6A 21 00 01 6A 21 00 7B 21 00 00 00 01 6B 21 00 01 6B 21 00 7C 21 00 00 00 01 6C 21 00 01' - '6C 21 00 7D 21 00 00 00 01 6D 21 00 01 6D 21 00 7E 21 00 00 00 01 6E 21 00 01 6E 21 00 7F 21 00' - '00 00 01 6F 21 00 01 6F 21 00 83 21 00 01 84 21 00 01 84 21 00 00 00 84 21 00 00 00 01 83 21 00' - '01 83 21 00 B6 24 00 01 D0 24 00 01 D0 24 00 00 00 B7 24 00 01 D1 24 00 01 D1 24 00 00 00 B8 24' - '00 01 D2 24 00 01 D2 24 00 00 00 B9 24 00 01 D3 24 00 01 D3 24 00 00 00 BA 24 00 01 D4 24 00 01' - 'D4 24 00 00 00 BB 24 00 01 D5 24 00 01 D5 24 00 00 00 BC 24 00 01 D6 24 00 01 D6 24 00 00 00 BD' - '24 00 01 D7 24 00 01 D7 24 00 00 00 BE 24 00 01 D8 24 00 01 D8 24 00 00 00 BF 24 00 01 D9 24 00' - '01 D9 24 00 00 00 C0 24 00 01 DA 24 00 01 DA 24 00 00 00 C1 24 00 01 DB 24 00 01 DB 24 00 00 00' - 'C2 24 00 01 DC 24 00 01 DC 24 00 00 00 C3 24 00 01 DD 24 00 01 DD 24 00 00 00 C4 24 00 01 DE 24' - '00 01 DE 24 00 00 00 C5 24 00 01 DF 24 00 01 DF 24 00 00 00 C6 24 00 01 E0 24 00 01 E0 24 00 00' - '00 C7 24 00 01 E1 24 00 01 E1 24 00 00 00 C8 24 00 01 E2 24 00 01 E2 24 00 00 00 C9 24 00 01 E3' - '24 00 01 E3 24 00 00 00 CA 24 00 01 E4 24 00 01 E4 24 00 00 00 CB 24 00 01 E5 24 00 01 E5 24 00' - '00 00 CC 24 00 01 E6 24 00 01 E6 24 00 00 00 CD 24 00 01 E7 24 00 01 E7 24 00 00 00 CE 24 00 01' - 'E8 24 00 01 E8 24 00 00 00 CF 24 00 01 E9 24 00 01 E9 24 00 00 00 D0 24 00 00 00 01 B6 24 00 01' - 'B6 24 00 D1 24 00 00 00 01 B7 24 00 01 B7 24 00 D2 24 00 00 00 01 B8 24 00 01 B8 24 00 D3 24 00' - '00 00 01 B9 24 00 01 B9 24 00 D4 24 00 00 00 01 BA 24 00 01 BA 24 00 D5 24 00 00 00 01 BB 24 00' - '01 BB 24 00 D6 24 00 00 00 01 BC 24 00 01 BC 24 00 D7 24 00 00 00 01 BD 24 00 01 BD 24 00 D8 24' - '00 00 00 01 BE 24 00 01 BE 24 00 D9 24 00 00 00 01 BF 24 00 01 BF 24 00 DA 24 00 00 00 01 C0 24' - '00 01 C0 24 00 DB 24 00 00 00 01 C1 24 00 01 C1 24 00 DC 24 00 00 00 01 C2 24 00 01 C2 24 00 DD' - '24 00 00 00 01 C3 24 00 01 C3 24 00 DE 24 00 00 00 01 C4 24 00 01 C4 24 00 DF 24 00 00 00 01 C5' - '24 00 01 C5 24 00 E0 24 00 00 00 01 C6 24 00 01 C6 24 00 E1 24 00 00 00 01 C7 24 00 01 C7 24 00' - 'E2 24 00 00 00 01 C8 24 00 01 C8 24 00 E3 24 00 00 00 01 C9 24 00 01 C9 24 00 E4 24 00 00 00 01' - 'CA 24 00 01 CA 24 00 E5 24 00 00 00 01 CB 24 00 01 CB 24 00 E6 24 00 00 00 01 CC 24 00 01 CC 24' - '00 E7 24 00 00 00 01 CD 24 00 01 CD 24 00 E8 24 00 00 00 01 CE 24 00 01 CE 24 00 E9 24 00 00 00' - '01 CF 24 00 01 CF 24 00 00 2C 00 01 30 2C 00 01 30 2C 00 00 00 01 2C 00 01 31 2C 00 01 31 2C 00' - '00 00 02 2C 00 01 32 2C 00 01 32 2C 00 00 00 03 2C 00 01 33 2C 00 01 33 2C 00 00 00 04 2C 00 01' - '34 2C 00 01 34 2C 00 00 00 05 2C 00 01 35 2C 00 01 35 2C 00 00 00 06 2C 00 01 36 2C 00 01 36 2C' - '00 00 00 07 2C 00 01 37 2C 00 01 37 2C 00 00 00 08 2C 00 01 38 2C 00 01 38 2C 00 00 00 09 2C 00' - '01 39 2C 00 01 39 2C 00 00 00 0A 2C 00 01 3A 2C 00 01 3A 2C 00 00 00 0B 2C 00 01 3B 2C 00 01 3B' - '2C 00 00 00 0C 2C 00 01 3C 2C 00 01 3C 2C 00 00 00 0D 2C 00 01 3D 2C 00 01 3D 2C 00 00 00 0E 2C' - '00 01 3E 2C 00 01 3E 2C 00 00 00 0F 2C 00 01 3F 2C 00 01 3F 2C 00 00 00 10 2C 00 01 40 2C 00 01' - '40 2C 00 00 00 11 2C 00 01 41 2C 00 01 41 2C 00 00 00 12 2C 00 01 42 2C 00 01 42 2C 00 00 00 13' - '2C 00 01 43 2C 00 01 43 2C 00 00 00 14 2C 00 01 44 2C 00 01 44 2C 00 00 00 15 2C 00 01 45 2C 00' - '01 45 2C 00 00 00 16 2C 00 01 46 2C 00 01 46 2C 00 00 00 17 2C 00 01 47 2C 00 01 47 2C 00 00 00' - '18 2C 00 01 48 2C 00 01 48 2C 00 00 00 19 2C 00 01 49 2C 00 01 49 2C 00 00 00 1A 2C 00 01 4A 2C' - '00 01 4A 2C 00 00 00 1B 2C 00 01 4B 2C 00 01 4B 2C 00 00 00 1C 2C 00 01 4C 2C 00 01 4C 2C 00 00' - '00 1D 2C 00 01 4D 2C 00 01 4D 2C 00 00 00 1E 2C 00 01 4E 2C 00 01 4E 2C 00 00 00 1F 2C 00 01 4F' - '2C 00 01 4F 2C 00 00 00 20 2C 00 01 50 2C 00 01 50 2C 00 00 00 21 2C 00 01 51 2C 00 01 51 2C 00' - '00 00 22 2C 00 01 52 2C 00 01 52 2C 00 00 00 23 2C 00 01 53 2C 00 01 53 2C 00 00 00 24 2C 00 01' - '54 2C 00 01 54 2C 00 00 00 25 2C 00 01 55 2C 00 01 55 2C 00 00 00 26 2C 00 01 56 2C 00 01 56 2C' - '00 00 00 27 2C 00 01 57 2C 00 01 57 2C 00 00 00 28 2C 00 01 58 2C 00 01 58 2C 00 00 00 29 2C 00' - '01 59 2C 00 01 59 2C 00 00 00 2A 2C 00 01 5A 2C 00 01 5A 2C 00 00 00 2B 2C 00 01 5B 2C 00 01 5B' - '2C 00 00 00 2C 2C 00 01 5C 2C 00 01 5C 2C 00 00 00 2D 2C 00 01 5D 2C 00 01 5D 2C 00 00 00 2E 2C' - '00 01 5E 2C 00 01 5E 2C 00 00 00 30 2C 00 00 00 01 00 2C 00 01 00 2C 00 31 2C 00 00 00 01 01 2C' - '00 01 01 2C 00 32 2C 00 00 00 01 02 2C 00 01 02 2C 00 33 2C 00 00 00 01 03 2C 00 01 03 2C 00 34' - '2C 00 00 00 01 04 2C 00 01 04 2C 00 35 2C 00 00 00 01 05 2C 00 01 05 2C 00 36 2C 00 00 00 01 06' - '2C 00 01 06 2C 00 37 2C 00 00 00 01 07 2C 00 01 07 2C 00 38 2C 00 00 00 01 08 2C 00 01 08 2C 00' - '39 2C 00 00 00 01 09 2C 00 01 09 2C 00 3A 2C 00 00 00 01 0A 2C 00 01 0A 2C 00 3B 2C 00 00 00 01' - '0B 2C 00 01 0B 2C 00 3C 2C 00 00 00 01 0C 2C 00 01 0C 2C 00 3D 2C 00 00 00 01 0D 2C 00 01 0D 2C' - '00 3E 2C 00 00 00 01 0E 2C 00 01 0E 2C 00 3F 2C 00 00 00 01 0F 2C 00 01 0F 2C 00 40 2C 00 00 00' - '01 10 2C 00 01 10 2C 00 41 2C 00 00 00 01 11 2C 00 01 11 2C 00 42 2C 00 00 00 01 12 2C 00 01 12' - '2C 00 43 2C 00 00 00 01 13 2C 00 01 13 2C 00 44 2C 00 00 00 01 14 2C 00 01 14 2C 00 45 2C 00 00' - '00 01 15 2C 00 01 15 2C 00 46 2C 00 00 00 01 16 2C 00 01 16 2C 00 47 2C 00 00 00 01 17 2C 00 01' - '17 2C 00 48 2C 00 00 00 01 18 2C 00 01 18 2C 00 49 2C 00 00 00 01 19 2C 00 01 19 2C 00 4A 2C 00' - '00 00 01 1A 2C 00 01 1A 2C 00 4B 2C 00 00 00 01 1B 2C 00 01 1B 2C 00 4C 2C 00 00 00 01 1C 2C 00' - '01 1C 2C 00 4D 2C 00 00 00 01 1D 2C 00 01 1D 2C 00 4E 2C 00 00 00 01 1E 2C 00 01 1E 2C 00 4F 2C' - '00 00 00 01 1F 2C 00 01 1F 2C 00 50 2C 00 00 00 01 20 2C 00 01 20 2C 00 51 2C 00 00 00 01 21 2C' - '00 01 21 2C 00 52 2C 00 00 00 01 22 2C 00 01 22 2C 00 53 2C 00 00 00 01 23 2C 00 01 23 2C 00 54' - '2C 00 00 00 01 24 2C 00 01 24 2C 00 55 2C 00 00 00 01 25 2C 00 01 25 2C 00 56 2C 00 00 00 01 26' - '2C 00 01 26 2C 00 57 2C 00 00 00 01 27 2C 00 01 27 2C 00 58 2C 00 00 00 01 28 2C 00 01 28 2C 00' - '59 2C 00 00 00 01 29 2C 00 01 29 2C 00 5A 2C 00 00 00 01 2A 2C 00 01 2A 2C 00 5B 2C 00 00 00 01' - '2B 2C 00 01 2B 2C 00 5C 2C 00 00 00 01 2C 2C 00 01 2C 2C 00 5D 2C 00 00 00 01 2D 2C 00 01 2D 2C' - '00 5E 2C 00 00 00 01 2E 2C 00 01 2E 2C 00 60 2C 00 01 61 2C 00 01 61 2C 00 00 00 61 2C 00 00 00' - '01 60 2C 00 01 60 2C 00 62 2C 00 01 6B 02 00 01 6B 02 00 00 00 63 2C 00 01 7D 1D 00 01 7D 1D 00' - '00 00 64 2C 00 01 7D 02 00 01 7D 02 00 00 00 65 2C 00 00 00 01 3A 02 00 01 3A 02 00 66 2C 00 00' - '00 01 3E 02 00 01 3E 02 00 67 2C 00 01 68 2C 00 01 68 2C 00 00 00 68 2C 00 00 00 01 67 2C 00 01' - '67 2C 00 69 2C 00 01 6A 2C 00 01 6A 2C 00 00 00 6A 2C 00 00 00 01 69 2C 00 01 69 2C 00 6B 2C 00' - '01 6C 2C 00 01 6C 2C 00 00 00 6C 2C 00 00 00 01 6B 2C 00 01 6B 2C 00 6D 2C 00 01 51 02 00 01 51' - '02 00 00 00 6E 2C 00 01 71 02 00 01 71 02 00 00 00 6F 2C 00 01 50 02 00 01 50 02 00 00 00 70 2C' - '00 01 52 02 00 01 52 02 00 00 00 72 2C 00 01 73 2C 00 01 73 2C 00 00 00 73 2C 00 00 00 01 72 2C' - '00 01 72 2C 00 75 2C 00 01 76 2C 00 01 76 2C 00 00 00 76 2C 00 00 00 01 75 2C 00 01 75 2C 00 7E' - '2C 00 01 3F 02 00 01 3F 02 00 00 00 7F 2C 00 01 40 02 00 01 40 02 00 00 00 80 2C 00 01 81 2C 00' - '01 81 2C 00 00 00 81 2C 00 00 00 01 80 2C 00 01 80 2C 00 82 2C 00 01 83 2C 00 01 83 2C 00 00 00' - '83 2C 00 00 00 01 82 2C 00 01 82 2C 00 84 2C 00 01 85 2C 00 01 85 2C 00 00 00 85 2C 00 00 00 01' - '84 2C 00 01 84 2C 00 86 2C 00 01 87 2C 00 01 87 2C 00 00 00 87 2C 00 00 00 01 86 2C 00 01 86 2C' - '00 88 2C 00 01 89 2C 00 01 89 2C 00 00 00 89 2C 00 00 00 01 88 2C 00 01 88 2C 00 8A 2C 00 01 8B' - '2C 00 01 8B 2C 00 00 00 8B 2C 00 00 00 01 8A 2C 00 01 8A 2C 00 8C 2C 00 01 8D 2C 00 01 8D 2C 00' - '00 00 8D 2C 00 00 00 01 8C 2C 00 01 8C 2C 00 8E 2C 00 01 8F 2C 00 01 8F 2C 00 00 00 8F 2C 00 00' - '00 01 8E 2C 00 01 8E 2C 00 90 2C 00 01 91 2C 00 01 91 2C 00 00 00 91 2C 00 00 00 01 90 2C 00 01' - '90 2C 00 92 2C 00 01 93 2C 00 01 93 2C 00 00 00 93 2C 00 00 00 01 92 2C 00 01 92 2C 00 94 2C 00' - '01 95 2C 00 01 95 2C 00 00 00 95 2C 00 00 00 01 94 2C 00 01 94 2C 00 96 2C 00 01 97 2C 00 01 97' - '2C 00 00 00 97 2C 00 00 00 01 96 2C 00 01 96 2C 00 98 2C 00 01 99 2C 00 01 99 2C 00 00 00 99 2C' - '00 00 00 01 98 2C 00 01 98 2C 00 9A 2C 00 01 9B 2C 00 01 9B 2C 00 00 00 9B 2C 00 00 00 01 9A 2C' - '00 01 9A 2C 00 9C 2C 00 01 9D 2C 00 01 9D 2C 00 00 00 9D 2C 00 00 00 01 9C 2C 00 01 9C 2C 00 9E' - '2C 00 01 9F 2C 00 01 9F 2C 00 00 00 9F 2C 00 00 00 01 9E 2C 00 01 9E 2C 00 A0 2C 00 01 A1 2C 00' - '01 A1 2C 00 00 00 A1 2C 00 00 00 01 A0 2C 00 01 A0 2C 00 A2 2C 00 01 A3 2C 00 01 A3 2C 00 00 00' - 'A3 2C 00 00 00 01 A2 2C 00 01 A2 2C 00 A4 2C 00 01 A5 2C 00 01 A5 2C 00 00 00 A5 2C 00 00 00 01' - 'A4 2C 00 01 A4 2C 00 A6 2C 00 01 A7 2C 00 01 A7 2C 00 00 00 A7 2C 00 00 00 01 A6 2C 00 01 A6 2C' - '00 A8 2C 00 01 A9 2C 00 01 A9 2C 00 00 00 A9 2C 00 00 00 01 A8 2C 00 01 A8 2C 00 AA 2C 00 01 AB' - '2C 00 01 AB 2C 00 00 00 AB 2C 00 00 00 01 AA 2C 00 01 AA 2C 00 AC 2C 00 01 AD 2C 00 01 AD 2C 00' - '00 00 AD 2C 00 00 00 01 AC 2C 00 01 AC 2C 00 AE 2C 00 01 AF 2C 00 01 AF 2C 00 00 00 AF 2C 00 00' - '00 01 AE 2C 00 01 AE 2C 00 B0 2C 00 01 B1 2C 00 01 B1 2C 00 00 00 B1 2C 00 00 00 01 B0 2C 00 01' - 'B0 2C 00 B2 2C 00 01 B3 2C 00 01 B3 2C 00 00 00 B3 2C 00 00 00 01 B2 2C 00 01 B2 2C 00 B4 2C 00' - '01 B5 2C 00 01 B5 2C 00 00 00 B5 2C 00 00 00 01 B4 2C 00 01 B4 2C 00 B6 2C 00 01 B7 2C 00 01 B7' - '2C 00 00 00 B7 2C 00 00 00 01 B6 2C 00 01 B6 2C 00 B8 2C 00 01 B9 2C 00 01 B9 2C 00 00 00 B9 2C' - '00 00 00 01 B8 2C 00 01 B8 2C 00 BA 2C 00 01 BB 2C 00 01 BB 2C 00 00 00 BB 2C 00 00 00 01 BA 2C' - '00 01 BA 2C 00 BC 2C 00 01 BD 2C 00 01 BD 2C 00 00 00 BD 2C 00 00 00 01 BC 2C 00 01 BC 2C 00 BE' - '2C 00 01 BF 2C 00 01 BF 2C 00 00 00 BF 2C 00 00 00 01 BE 2C 00 01 BE 2C 00 C0 2C 00 01 C1 2C 00' - '01 C1 2C 00 00 00 C1 2C 00 00 00 01 C0 2C 00 01 C0 2C 00 C2 2C 00 01 C3 2C 00 01 C3 2C 00 00 00' - 'C3 2C 00 00 00 01 C2 2C 00 01 C2 2C 00 C4 2C 00 01 C5 2C 00 01 C5 2C 00 00 00 C5 2C 00 00 00 01' - 'C4 2C 00 01 C4 2C 00 C6 2C 00 01 C7 2C 00 01 C7 2C 00 00 00 C7 2C 00 00 00 01 C6 2C 00 01 C6 2C' - '00 C8 2C 00 01 C9 2C 00 01 C9 2C 00 00 00 C9 2C 00 00 00 01 C8 2C 00 01 C8 2C 00 CA 2C 00 01 CB' - '2C 00 01 CB 2C 00 00 00 CB 2C 00 00 00 01 CA 2C 00 01 CA 2C 00 CC 2C 00 01 CD 2C 00 01 CD 2C 00' - '00 00 CD 2C 00 00 00 01 CC 2C 00 01 CC 2C 00 CE 2C 00 01 CF 2C 00 01 CF 2C 00 00 00 CF 2C 00 00' - '00 01 CE 2C 00 01 CE 2C 00 D0 2C 00 01 D1 2C 00 01 D1 2C 00 00 00 D1 2C 00 00 00 01 D0 2C 00 01' - 'D0 2C 00 D2 2C 00 01 D3 2C 00 01 D3 2C 00 00 00 D3 2C 00 00 00 01 D2 2C 00 01 D2 2C 00 D4 2C 00' - '01 D5 2C 00 01 D5 2C 00 00 00 D5 2C 00 00 00 01 D4 2C 00 01 D4 2C 00 D6 2C 00 01 D7 2C 00 01 D7' - '2C 00 00 00 D7 2C 00 00 00 01 D6 2C 00 01 D6 2C 00 D8 2C 00 01 D9 2C 00 01 D9 2C 00 00 00 D9 2C' - '00 00 00 01 D8 2C 00 01 D8 2C 00 DA 2C 00 01 DB 2C 00 01 DB 2C 00 00 00 DB 2C 00 00 00 01 DA 2C' - '00 01 DA 2C 00 DC 2C 00 01 DD 2C 00 01 DD 2C 00 00 00 DD 2C 00 00 00 01 DC 2C 00 01 DC 2C 00 DE' - '2C 00 01 DF 2C 00 01 DF 2C 00 00 00 DF 2C 00 00 00 01 DE 2C 00 01 DE 2C 00 E0 2C 00 01 E1 2C 00' - '01 E1 2C 00 00 00 E1 2C 00 00 00 01 E0 2C 00 01 E0 2C 00 E2 2C 00 01 E3 2C 00 01 E3 2C 00 00 00' - 'E3 2C 00 00 00 01 E2 2C 00 01 E2 2C 00 EB 2C 00 01 EC 2C 00 01 EC 2C 00 00 00 EC 2C 00 00 00 01' - 'EB 2C 00 01 EB 2C 00 ED 2C 00 01 EE 2C 00 01 EE 2C 00 00 00 EE 2C 00 00 00 01 ED 2C 00 01 ED 2C' - '00 F2 2C 00 01 F3 2C 00 01 F3 2C 00 00 00 F3 2C 00 00 00 01 F2 2C 00 01 F2 2C 00 00 2D 00 00 00' - '01 A0 10 00 01 A0 10 00 01 2D 00 00 00 01 A1 10 00 01 A1 10 00 02 2D 00 00 00 01 A2 10 00 01 A2' - '10 00 03 2D 00 00 00 01 A3 10 00 01 A3 10 00 04 2D 00 00 00 01 A4 10 00 01 A4 10 00 05 2D 00 00' - '00 01 A5 10 00 01 A5 10 00 06 2D 00 00 00 01 A6 10 00 01 A6 10 00 07 2D 00 00 00 01 A7 10 00 01' - 'A7 10 00 08 2D 00 00 00 01 A8 10 00 01 A8 10 00 09 2D 00 00 00 01 A9 10 00 01 A9 10 00 0A 2D 00' - '00 00 01 AA 10 00 01 AA 10 00 0B 2D 00 00 00 01 AB 10 00 01 AB 10 00 0C 2D 00 00 00 01 AC 10 00' - '01 AC 10 00 0D 2D 00 00 00 01 AD 10 00 01 AD 10 00 0E 2D 00 00 00 01 AE 10 00 01 AE 10 00 0F 2D' - '00 00 00 01 AF 10 00 01 AF 10 00 10 2D 00 00 00 01 B0 10 00 01 B0 10 00 11 2D 00 00 00 01 B1 10' - '00 01 B1 10 00 12 2D 00 00 00 01 B2 10 00 01 B2 10 00 13 2D 00 00 00 01 B3 10 00 01 B3 10 00 14' - '2D 00 00 00 01 B4 10 00 01 B4 10 00 15 2D 00 00 00 01 B5 10 00 01 B5 10 00 16 2D 00 00 00 01 B6' - '10 00 01 B6 10 00 17 2D 00 00 00 01 B7 10 00 01 B7 10 00 18 2D 00 00 00 01 B8 10 00 01 B8 10 00' - '19 2D 00 00 00 01 B9 10 00 01 B9 10 00 1A 2D 00 00 00 01 BA 10 00 01 BA 10 00 1B 2D 00 00 00 01' - 'BB 10 00 01 BB 10 00 1C 2D 00 00 00 01 BC 10 00 01 BC 10 00 1D 2D 00 00 00 01 BD 10 00 01 BD 10' - '00 1E 2D 00 00 00 01 BE 10 00 01 BE 10 00 1F 2D 00 00 00 01 BF 10 00 01 BF 10 00 20 2D 00 00 00' - '01 C0 10 00 01 C0 10 00 21 2D 00 00 00 01 C1 10 00 01 C1 10 00 22 2D 00 00 00 01 C2 10 00 01 C2' - '10 00 23 2D 00 00 00 01 C3 10 00 01 C3 10 00 24 2D 00 00 00 01 C4 10 00 01 C4 10 00 25 2D 00 00' - '00 01 C5 10 00 01 C5 10 00 27 2D 00 00 00 01 C7 10 00 01 C7 10 00 2D 2D 00 00 00 01 CD 10 00 01' - 'CD 10 00 40 A6 00 01 41 A6 00 01 41 A6 00 00 00 41 A6 00 00 00 01 40 A6 00 01 40 A6 00 42 A6 00' - '01 43 A6 00 01 43 A6 00 00 00 43 A6 00 00 00 01 42 A6 00 01 42 A6 00 44 A6 00 01 45 A6 00 01 45' - 'A6 00 00 00 45 A6 00 00 00 01 44 A6 00 01 44 A6 00 46 A6 00 01 47 A6 00 01 47 A6 00 00 00 47 A6' - '00 00 00 01 46 A6 00 01 46 A6 00 48 A6 00 01 49 A6 00 01 49 A6 00 00 00 49 A6 00 00 00 01 48 A6' - '00 01 48 A6 00 4A A6 00 01 4B A6 00 01 4B A6 00 00 00 4B A6 00 00 00 01 4A A6 00 01 4A A6 00 4C' - 'A6 00 01 4D A6 00 01 4D A6 00 00 00 4D A6 00 00 00 01 4C A6 00 01 4C A6 00 4E A6 00 01 4F A6 00' - '01 4F A6 00 00 00 4F A6 00 00 00 01 4E A6 00 01 4E A6 00 50 A6 00 01 51 A6 00 01 51 A6 00 00 00' - '51 A6 00 00 00 01 50 A6 00 01 50 A6 00 52 A6 00 01 53 A6 00 01 53 A6 00 00 00 53 A6 00 00 00 01' - '52 A6 00 01 52 A6 00 54 A6 00 01 55 A6 00 01 55 A6 00 00 00 55 A6 00 00 00 01 54 A6 00 01 54 A6' - '00 56 A6 00 01 57 A6 00 01 57 A6 00 00 00 57 A6 00 00 00 01 56 A6 00 01 56 A6 00 58 A6 00 01 59' - 'A6 00 01 59 A6 00 00 00 59 A6 00 00 00 01 58 A6 00 01 58 A6 00 5A A6 00 01 5B A6 00 01 5B A6 00' - '00 00 5B A6 00 00 00 01 5A A6 00 01 5A A6 00 5C A6 00 01 5D A6 00 01 5D A6 00 00 00 5D A6 00 00' - '00 01 5C A6 00 01 5C A6 00 5E A6 00 01 5F A6 00 01 5F A6 00 00 00 5F A6 00 00 00 01 5E A6 00 01' - '5E A6 00 60 A6 00 01 61 A6 00 01 61 A6 00 00 00 61 A6 00 00 00 01 60 A6 00 01 60 A6 00 62 A6 00' - '01 63 A6 00 01 63 A6 00 00 00 63 A6 00 00 00 01 62 A6 00 01 62 A6 00 64 A6 00 01 65 A6 00 01 65' - 'A6 00 00 00 65 A6 00 00 00 01 64 A6 00 01 64 A6 00 66 A6 00 01 67 A6 00 01 67 A6 00 00 00 67 A6' - '00 00 00 01 66 A6 00 01 66 A6 00 68 A6 00 01 69 A6 00 01 69 A6 00 00 00 69 A6 00 00 00 01 68 A6' - '00 01 68 A6 00 6A A6 00 01 6B A6 00 01 6B A6 00 00 00 6B A6 00 00 00 01 6A A6 00 01 6A A6 00 6C' - 'A6 00 01 6D A6 00 01 6D A6 00 00 00 6D A6 00 00 00 01 6C A6 00 01 6C A6 00 80 A6 00 01 81 A6 00' - '01 81 A6 00 00 00 81 A6 00 00 00 01 80 A6 00 01 80 A6 00 82 A6 00 01 83 A6 00 01 83 A6 00 00 00' - '83 A6 00 00 00 01 82 A6 00 01 82 A6 00 84 A6 00 01 85 A6 00 01 85 A6 00 00 00 85 A6 00 00 00 01' - '84 A6 00 01 84 A6 00 86 A6 00 01 87 A6 00 01 87 A6 00 00 00 87 A6 00 00 00 01 86 A6 00 01 86 A6' - '00 88 A6 00 01 89 A6 00 01 89 A6 00 00 00 89 A6 00 00 00 01 88 A6 00 01 88 A6 00 8A A6 00 01 8B' - 'A6 00 01 8B A6 00 00 00 8B A6 00 00 00 01 8A A6 00 01 8A A6 00 8C A6 00 01 8D A6 00 01 8D A6 00' - '00 00 8D A6 00 00 00 01 8C A6 00 01 8C A6 00 8E A6 00 01 8F A6 00 01 8F A6 00 00 00 8F A6 00 00' - '00 01 8E A6 00 01 8E A6 00 90 A6 00 01 91 A6 00 01 91 A6 00 00 00 91 A6 00 00 00 01 90 A6 00 01' - '90 A6 00 92 A6 00 01 93 A6 00 01 93 A6 00 00 00 93 A6 00 00 00 01 92 A6 00 01 92 A6 00 94 A6 00' - '01 95 A6 00 01 95 A6 00 00 00 95 A6 00 00 00 01 94 A6 00 01 94 A6 00 96 A6 00 01 97 A6 00 01 97' - 'A6 00 00 00 97 A6 00 00 00 01 96 A6 00 01 96 A6 00 98 A6 00 01 99 A6 00 01 99 A6 00 00 00 99 A6' - '00 00 00 01 98 A6 00 01 98 A6 00 9A A6 00 01 9B A6 00 01 9B A6 00 00 00 9B A6 00 00 00 01 9A A6' - '00 01 9A A6 00 22 A7 00 01 23 A7 00 01 23 A7 00 00 00 23 A7 00 00 00 01 22 A7 00 01 22 A7 00 24' - 'A7 00 01 25 A7 00 01 25 A7 00 00 00 25 A7 00 00 00 01 24 A7 00 01 24 A7 00 26 A7 00 01 27 A7 00' - '01 27 A7 00 00 00 27 A7 00 00 00 01 26 A7 00 01 26 A7 00 28 A7 00 01 29 A7 00 01 29 A7 00 00 00' - '29 A7 00 00 00 01 28 A7 00 01 28 A7 00 2A A7 00 01 2B A7 00 01 2B A7 00 00 00 2B A7 00 00 00 01' - '2A A7 00 01 2A A7 00 2C A7 00 01 2D A7 00 01 2D A7 00 00 00 2D A7 00 00 00 01 2C A7 00 01 2C A7' - '00 2E A7 00 01 2F A7 00 01 2F A7 00 00 00 2F A7 00 00 00 01 2E A7 00 01 2E A7 00 32 A7 00 01 33' - 'A7 00 01 33 A7 00 00 00 33 A7 00 00 00 01 32 A7 00 01 32 A7 00 34 A7 00 01 35 A7 00 01 35 A7 00' - '00 00 35 A7 00 00 00 01 34 A7 00 01 34 A7 00 36 A7 00 01 37 A7 00 01 37 A7 00 00 00 37 A7 00 00' - '00 01 36 A7 00 01 36 A7 00 38 A7 00 01 39 A7 00 01 39 A7 00 00 00 39 A7 00 00 00 01 38 A7 00 01' - '38 A7 00 3A A7 00 01 3B A7 00 01 3B A7 00 00 00 3B A7 00 00 00 01 3A A7 00 01 3A A7 00 3C A7 00' - '01 3D A7 00 01 3D A7 00 00 00 3D A7 00 00 00 01 3C A7 00 01 3C A7 00 3E A7 00 01 3F A7 00 01 3F' - 'A7 00 00 00 3F A7 00 00 00 01 3E A7 00 01 3E A7 00 40 A7 00 01 41 A7 00 01 41 A7 00 00 00 41 A7' - '00 00 00 01 40 A7 00 01 40 A7 00 42 A7 00 01 43 A7 00 01 43 A7 00 00 00 43 A7 00 00 00 01 42 A7' - '00 01 42 A7 00 44 A7 00 01 45 A7 00 01 45 A7 00 00 00 45 A7 00 00 00 01 44 A7 00 01 44 A7 00 46' - 'A7 00 01 47 A7 00 01 47 A7 00 00 00 47 A7 00 00 00 01 46 A7 00 01 46 A7 00 48 A7 00 01 49 A7 00' - '01 49 A7 00 00 00 49 A7 00 00 00 01 48 A7 00 01 48 A7 00 4A A7 00 01 4B A7 00 01 4B A7 00 00 00' - '4B A7 00 00 00 01 4A A7 00 01 4A A7 00 4C A7 00 01 4D A7 00 01 4D A7 00 00 00 4D A7 00 00 00 01' - '4C A7 00 01 4C A7 00 4E A7 00 01 4F A7 00 01 4F A7 00 00 00 4F A7 00 00 00 01 4E A7 00 01 4E A7' - '00 50 A7 00 01 51 A7 00 01 51 A7 00 00 00 51 A7 00 00 00 01 50 A7 00 01 50 A7 00 52 A7 00 01 53' - 'A7 00 01 53 A7 00 00 00 53 A7 00 00 00 01 52 A7 00 01 52 A7 00 54 A7 00 01 55 A7 00 01 55 A7 00' - '00 00 55 A7 00 00 00 01 54 A7 00 01 54 A7 00 56 A7 00 01 57 A7 00 01 57 A7 00 00 00 57 A7 00 00' - '00 01 56 A7 00 01 56 A7 00 58 A7 00 01 59 A7 00 01 59 A7 00 00 00 59 A7 00 00 00 01 58 A7 00 01' - '58 A7 00 5A A7 00 01 5B A7 00 01 5B A7 00 00 00 5B A7 00 00 00 01 5A A7 00 01 5A A7 00 5C A7 00' - '01 5D A7 00 01 5D A7 00 00 00 5D A7 00 00 00 01 5C A7 00 01 5C A7 00 5E A7 00 01 5F A7 00 01 5F' - 'A7 00 00 00 5F A7 00 00 00 01 5E A7 00 01 5E A7 00 60 A7 00 01 61 A7 00 01 61 A7 00 00 00 61 A7' - '00 00 00 01 60 A7 00 01 60 A7 00 62 A7 00 01 63 A7 00 01 63 A7 00 00 00 63 A7 00 00 00 01 62 A7' - '00 01 62 A7 00 64 A7 00 01 65 A7 00 01 65 A7 00 00 00 65 A7 00 00 00 01 64 A7 00 01 64 A7 00 66' - 'A7 00 01 67 A7 00 01 67 A7 00 00 00 67 A7 00 00 00 01 66 A7 00 01 66 A7 00 68 A7 00 01 69 A7 00' - '01 69 A7 00 00 00 69 A7 00 00 00 01 68 A7 00 01 68 A7 00 6A A7 00 01 6B A7 00 01 6B A7 00 00 00' - '6B A7 00 00 00 01 6A A7 00 01 6A A7 00 6C A7 00 01 6D A7 00 01 6D A7 00 00 00 6D A7 00 00 00 01' - '6C A7 00 01 6C A7 00 6E A7 00 01 6F A7 00 01 6F A7 00 00 00 6F A7 00 00 00 01 6E A7 00 01 6E A7' - '00 79 A7 00 01 7A A7 00 01 7A A7 00 00 00 7A A7 00 00 00 01 79 A7 00 01 79 A7 00 7B A7 00 01 7C' - 'A7 00 01 7C A7 00 00 00 7C A7 00 00 00 01 7B A7 00 01 7B A7 00 7D A7 00 01 79 1D 00 01 79 1D 00' - '00 00 7E A7 00 01 7F A7 00 01 7F A7 00 00 00 7F A7 00 00 00 01 7E A7 00 01 7E A7 00 80 A7 00 01' - '81 A7 00 01 81 A7 00 00 00 81 A7 00 00 00 01 80 A7 00 01 80 A7 00 82 A7 00 01 83 A7 00 01 83 A7' - '00 00 00 83 A7 00 00 00 01 82 A7 00 01 82 A7 00 84 A7 00 01 85 A7 00 01 85 A7 00 00 00 85 A7 00' - '00 00 01 84 A7 00 01 84 A7 00 86 A7 00 01 87 A7 00 01 87 A7 00 00 00 87 A7 00 00 00 01 86 A7 00' - '01 86 A7 00 8B A7 00 01 8C A7 00 01 8C A7 00 00 00 8C A7 00 00 00 01 8B A7 00 01 8B A7 00 8D A7' - '00 01 65 02 00 01 65 02 00 00 00 90 A7 00 01 91 A7 00 01 91 A7 00 00 00 91 A7 00 00 00 01 90 A7' - '00 01 90 A7 00 92 A7 00 01 93 A7 00 01 93 A7 00 00 00 93 A7 00 00 00 01 92 A7 00 01 92 A7 00 94' - 'A7 00 00 00 01 C4 A7 00 01 C4 A7 00 96 A7 00 01 97 A7 00 01 97 A7 00 00 00 97 A7 00 00 00 01 96' - 'A7 00 01 96 A7 00 98 A7 00 01 99 A7 00 01 99 A7 00 00 00 99 A7 00 00 00 01 98 A7 00 01 98 A7 00' - '9A A7 00 01 9B A7 00 01 9B A7 00 00 00 9B A7 00 00 00 01 9A A7 00 01 9A A7 00 9C A7 00 01 9D A7' - '00 01 9D A7 00 00 00 9D A7 00 00 00 01 9C A7 00 01 9C A7 00 9E A7 00 01 9F A7 00 01 9F A7 00 00' - '00 9F A7 00 00 00 01 9E A7 00 01 9E A7 00 A0 A7 00 01 A1 A7 00 01 A1 A7 00 00 00 A1 A7 00 00 00' - '01 A0 A7 00 01 A0 A7 00 A2 A7 00 01 A3 A7 00 01 A3 A7 00 00 00 A3 A7 00 00 00 01 A2 A7 00 01 A2' - 'A7 00 A4 A7 00 01 A5 A7 00 01 A5 A7 00 00 00 A5 A7 00 00 00 01 A4 A7 00 01 A4 A7 00 A6 A7 00 01' - 'A7 A7 00 01 A7 A7 00 00 00 A7 A7 00 00 00 01 A6 A7 00 01 A6 A7 00 A8 A7 00 01 A9 A7 00 01 A9 A7' - '00 00 00 A9 A7 00 00 00 01 A8 A7 00 01 A8 A7 00 AA A7 00 01 66 02 00 01 66 02 00 00 00 AB A7 00' - '01 5C 02 00 01 5C 02 00 00 00 AC A7 00 01 61 02 00 01 61 02 00 00 00 AD A7 00 01 6C 02 00 01 6C' - '02 00 00 00 AE A7 00 01 6A 02 00 01 6A 02 00 00 00 B0 A7 00 01 9E 02 00 01 9E 02 00 00 00 B1 A7' - '00 01 87 02 00 01 87 02 00 00 00 B2 A7 00 01 9D 02 00 01 9D 02 00 00 00 B3 A7 00 01 53 AB 00 01' - '53 AB 00 00 00 B4 A7 00 01 B5 A7 00 01 B5 A7 00 00 00 B5 A7 00 00 00 01 B4 A7 00 01 B4 A7 00 B6' - 'A7 00 01 B7 A7 00 01 B7 A7 00 00 00 B7 A7 00 00 00 01 B6 A7 00 01 B6 A7 00 B8 A7 00 01 B9 A7 00' - '01 B9 A7 00 00 00 B9 A7 00 00 00 01 B8 A7 00 01 B8 A7 00 BA A7 00 01 BB A7 00 01 BB A7 00 00 00' - 'BB A7 00 00 00 01 BA A7 00 01 BA A7 00 BC A7 00 01 BD A7 00 01 BD A7 00 00 00 BD A7 00 00 00 01' - 'BC A7 00 01 BC A7 00 BE A7 00 01 BF A7 00 01 BF A7 00 00 00 BF A7 00 00 00 01 BE A7 00 01 BE A7' - '00 C2 A7 00 01 C3 A7 00 01 C3 A7 00 00 00 C3 A7 00 00 00 01 C2 A7 00 01 C2 A7 00 C4 A7 00 01 94' - 'A7 00 01 94 A7 00 00 00 C5 A7 00 01 82 02 00 01 82 02 00 00 00 C6 A7 00 01 8E 1D 00 01 8E 1D 00' - '00 00 C7 A7 00 01 C8 A7 00 01 C8 A7 00 00 00 C8 A7 00 00 00 01 C7 A7 00 01 C7 A7 00 C9 A7 00 01' - 'CA A7 00 01 CA A7 00 00 00 CA A7 00 00 00 01 C9 A7 00 01 C9 A7 00 F5 A7 00 01 F6 A7 00 01 F6 A7' - '00 00 00 F6 A7 00 00 00 01 F5 A7 00 01 F5 A7 00 53 AB 00 00 00 01 B3 A7 00 01 B3 A7 00 70 AB 00' - '01 A0 13 00 00 01 A0 13 00 01 A0 13 00 71 AB 00 01 A1 13 00 00 01 A1 13 00 01 A1 13 00 72 AB 00' - '01 A2 13 00 00 01 A2 13 00 01 A2 13 00 73 AB 00 01 A3 13 00 00 01 A3 13 00 01 A3 13 00 74 AB 00' - '01 A4 13 00 00 01 A4 13 00 01 A4 13 00 75 AB 00 01 A5 13 00 00 01 A5 13 00 01 A5 13 00 76 AB 00' - '01 A6 13 00 00 01 A6 13 00 01 A6 13 00 77 AB 00 01 A7 13 00 00 01 A7 13 00 01 A7 13 00 78 AB 00' - '01 A8 13 00 00 01 A8 13 00 01 A8 13 00 79 AB 00 01 A9 13 00 00 01 A9 13 00 01 A9 13 00 7A AB 00' - '01 AA 13 00 00 01 AA 13 00 01 AA 13 00 7B AB 00 01 AB 13 00 00 01 AB 13 00 01 AB 13 00 7C AB 00' - '01 AC 13 00 00 01 AC 13 00 01 AC 13 00 7D AB 00 01 AD 13 00 00 01 AD 13 00 01 AD 13 00 7E AB 00' - '01 AE 13 00 00 01 AE 13 00 01 AE 13 00 7F AB 00 01 AF 13 00 00 01 AF 13 00 01 AF 13 00 80 AB 00' - '01 B0 13 00 00 01 B0 13 00 01 B0 13 00 81 AB 00 01 B1 13 00 00 01 B1 13 00 01 B1 13 00 82 AB 00' - '01 B2 13 00 00 01 B2 13 00 01 B2 13 00 83 AB 00 01 B3 13 00 00 01 B3 13 00 01 B3 13 00 84 AB 00' - '01 B4 13 00 00 01 B4 13 00 01 B4 13 00 85 AB 00 01 B5 13 00 00 01 B5 13 00 01 B5 13 00 86 AB 00' - '01 B6 13 00 00 01 B6 13 00 01 B6 13 00 87 AB 00 01 B7 13 00 00 01 B7 13 00 01 B7 13 00 88 AB 00' - '01 B8 13 00 00 01 B8 13 00 01 B8 13 00 89 AB 00 01 B9 13 00 00 01 B9 13 00 01 B9 13 00 8A AB 00' - '01 BA 13 00 00 01 BA 13 00 01 BA 13 00 8B AB 00 01 BB 13 00 00 01 BB 13 00 01 BB 13 00 8C AB 00' - '01 BC 13 00 00 01 BC 13 00 01 BC 13 00 8D AB 00 01 BD 13 00 00 01 BD 13 00 01 BD 13 00 8E AB 00' - '01 BE 13 00 00 01 BE 13 00 01 BE 13 00 8F AB 00 01 BF 13 00 00 01 BF 13 00 01 BF 13 00 90 AB 00' - '01 C0 13 00 00 01 C0 13 00 01 C0 13 00 91 AB 00 01 C1 13 00 00 01 C1 13 00 01 C1 13 00 92 AB 00' - '01 C2 13 00 00 01 C2 13 00 01 C2 13 00 93 AB 00 01 C3 13 00 00 01 C3 13 00 01 C3 13 00 94 AB 00' - '01 C4 13 00 00 01 C4 13 00 01 C4 13 00 95 AB 00 01 C5 13 00 00 01 C5 13 00 01 C5 13 00 96 AB 00' - '01 C6 13 00 00 01 C6 13 00 01 C6 13 00 97 AB 00 01 C7 13 00 00 01 C7 13 00 01 C7 13 00 98 AB 00' - '01 C8 13 00 00 01 C8 13 00 01 C8 13 00 99 AB 00 01 C9 13 00 00 01 C9 13 00 01 C9 13 00 9A AB 00' - '01 CA 13 00 00 01 CA 13 00 01 CA 13 00 9B AB 00 01 CB 13 00 00 01 CB 13 00 01 CB 13 00 9C AB 00' - '01 CC 13 00 00 01 CC 13 00 01 CC 13 00 9D AB 00 01 CD 13 00 00 01 CD 13 00 01 CD 13 00 9E AB 00' - '01 CE 13 00 00 01 CE 13 00 01 CE 13 00 9F AB 00 01 CF 13 00 00 01 CF 13 00 01 CF 13 00 A0 AB 00' - '01 D0 13 00 00 01 D0 13 00 01 D0 13 00 A1 AB 00 01 D1 13 00 00 01 D1 13 00 01 D1 13 00 A2 AB 00' - '01 D2 13 00 00 01 D2 13 00 01 D2 13 00 A3 AB 00 01 D3 13 00 00 01 D3 13 00 01 D3 13 00 A4 AB 00' - '01 D4 13 00 00 01 D4 13 00 01 D4 13 00 A5 AB 00 01 D5 13 00 00 01 D5 13 00 01 D5 13 00 A6 AB 00' - '01 D6 13 00 00 01 D6 13 00 01 D6 13 00 A7 AB 00 01 D7 13 00 00 01 D7 13 00 01 D7 13 00 A8 AB 00' - '01 D8 13 00 00 01 D8 13 00 01 D8 13 00 A9 AB 00 01 D9 13 00 00 01 D9 13 00 01 D9 13 00 AA AB 00' - '01 DA 13 00 00 01 DA 13 00 01 DA 13 00 AB AB 00 01 DB 13 00 00 01 DB 13 00 01 DB 13 00 AC AB 00' - '01 DC 13 00 00 01 DC 13 00 01 DC 13 00 AD AB 00 01 DD 13 00 00 01 DD 13 00 01 DD 13 00 AE AB 00' - '01 DE 13 00 00 01 DE 13 00 01 DE 13 00 AF AB 00 01 DF 13 00 00 01 DF 13 00 01 DF 13 00 B0 AB 00' - '01 E0 13 00 00 01 E0 13 00 01 E0 13 00 B1 AB 00 01 E1 13 00 00 01 E1 13 00 01 E1 13 00 B2 AB 00' - '01 E2 13 00 00 01 E2 13 00 01 E2 13 00 B3 AB 00 01 E3 13 00 00 01 E3 13 00 01 E3 13 00 B4 AB 00' - '01 E4 13 00 00 01 E4 13 00 01 E4 13 00 B5 AB 00 01 E5 13 00 00 01 E5 13 00 01 E5 13 00 B6 AB 00' - '01 E6 13 00 00 01 E6 13 00 01 E6 13 00 B7 AB 00 01 E7 13 00 00 01 E7 13 00 01 E7 13 00 B8 AB 00' - '01 E8 13 00 00 01 E8 13 00 01 E8 13 00 B9 AB 00 01 E9 13 00 00 01 E9 13 00 01 E9 13 00 BA AB 00' - '01 EA 13 00 00 01 EA 13 00 01 EA 13 00 BB AB 00 01 EB 13 00 00 01 EB 13 00 01 EB 13 00 BC AB 00' - '01 EC 13 00 00 01 EC 13 00 01 EC 13 00 BD AB 00 01 ED 13 00 00 01 ED 13 00 01 ED 13 00 BE AB 00' - '01 EE 13 00 00 01 EE 13 00 01 EE 13 00 BF AB 00 01 EF 13 00 00 01 EF 13 00 01 EF 13 00 00 FB 00' - '02 66 00 00 66 00 00 01 00 FB 00 02 46 00 00 66 00 00 02 46 00 00 46 00 00 01 FB 00 02 66 00 00' - '69 00 00 01 01 FB 00 02 46 00 00 69 00 00 02 46 00 00 49 00 00 02 FB 00 02 66 00 00 6C 00 00 01' - '02 FB 00 02 46 00 00 6C 00 00 02 46 00 00 4C 00 00 03 FB 00 03 66 00 00 66 00 00 69 00 00 01 03' - 'FB 00 03 46 00 00 66 00 00 69 00 00 03 46 00 00 46 00 00 49 00 00 04 FB 00 03 66 00 00 66 00 00' - '6C 00 00 01 04 FB 00 03 46 00 00 66 00 00 6C 00 00 03 46 00 00 46 00 00 4C 00 00 05 FB 00 02 73' - '00 00 74 00 00 01 05 FB 00 02 53 00 00 74 00 00 02 53 00 00 54 00 00 06 FB 00 02 73 00 00 74 00' - '00 01 06 FB 00 02 53 00 00 74 00 00 02 53 00 00 54 00 00 13 FB 00 02 74 05 00 76 05 00 01 13 FB' - '00 02 44 05 00 76 05 00 02 44 05 00 46 05 00 14 FB 00 02 74 05 00 65 05 00 01 14 FB 00 02 44 05' - '00 65 05 00 02 44 05 00 35 05 00 15 FB 00 02 74 05 00 6B 05 00 01 15 FB 00 02 44 05 00 6B 05 00' - '02 44 05 00 3B 05 00 16 FB 00 02 7E 05 00 76 05 00 01 16 FB 00 02 4E 05 00 76 05 00 02 4E 05 00' - '46 05 00 17 FB 00 02 74 05 00 6D 05 00 01 17 FB 00 02 44 05 00 6D 05 00 02 44 05 00 3D 05 00 21' - 'FF 00 01 41 FF 00 01 41 FF 00 00 00 22 FF 00 01 42 FF 00 01 42 FF 00 00 00 23 FF 00 01 43 FF 00' - '01 43 FF 00 00 00 24 FF 00 01 44 FF 00 01 44 FF 00 00 00 25 FF 00 01 45 FF 00 01 45 FF 00 00 00' - '26 FF 00 01 46 FF 00 01 46 FF 00 00 00 27 FF 00 01 47 FF 00 01 47 FF 00 00 00 28 FF 00 01 48 FF' - '00 01 48 FF 00 00 00 29 FF 00 01 49 FF 00 01 49 FF 00 00 00 2A FF 00 01 4A FF 00 01 4A FF 00 00' - '00 2B FF 00 01 4B FF 00 01 4B FF 00 00 00 2C FF 00 01 4C FF 00 01 4C FF 00 00 00 2D FF 00 01 4D' - 'FF 00 01 4D FF 00 00 00 2E FF 00 01 4E FF 00 01 4E FF 00 00 00 2F FF 00 01 4F FF 00 01 4F FF 00' - '00 00 30 FF 00 01 50 FF 00 01 50 FF 00 00 00 31 FF 00 01 51 FF 00 01 51 FF 00 00 00 32 FF 00 01' - '52 FF 00 01 52 FF 00 00 00 33 FF 00 01 53 FF 00 01 53 FF 00 00 00 34 FF 00 01 54 FF 00 01 54 FF' - '00 00 00 35 FF 00 01 55 FF 00 01 55 FF 00 00 00 36 FF 00 01 56 FF 00 01 56 FF 00 00 00 37 FF 00' - '01 57 FF 00 01 57 FF 00 00 00 38 FF 00 01 58 FF 00 01 58 FF 00 00 00 39 FF 00 01 59 FF 00 01 59' - 'FF 00 00 00 3A FF 00 01 5A FF 00 01 5A FF 00 00 00 41 FF 00 00 00 01 21 FF 00 01 21 FF 00 42 FF' - '00 00 00 01 22 FF 00 01 22 FF 00 43 FF 00 00 00 01 23 FF 00 01 23 FF 00 44 FF 00 00 00 01 24 FF' - '00 01 24 FF 00 45 FF 00 00 00 01 25 FF 00 01 25 FF 00 46 FF 00 00 00 01 26 FF 00 01 26 FF 00 47' - 'FF 00 00 00 01 27 FF 00 01 27 FF 00 48 FF 00 00 00 01 28 FF 00 01 28 FF 00 49 FF 00 00 00 01 29' - 'FF 00 01 29 FF 00 4A FF 00 00 00 01 2A FF 00 01 2A FF 00 4B FF 00 00 00 01 2B FF 00 01 2B FF 00' - '4C FF 00 00 00 01 2C FF 00 01 2C FF 00 4D FF 00 00 00 01 2D FF 00 01 2D FF 00 4E FF 00 00 00 01' - '2E FF 00 01 2E FF 00 4F FF 00 00 00 01 2F FF 00 01 2F FF 00 50 FF 00 00 00 01 30 FF 00 01 30 FF' - '00 51 FF 00 00 00 01 31 FF 00 01 31 FF 00 52 FF 00 00 00 01 32 FF 00 01 32 FF 00 53 FF 00 00 00' - '01 33 FF 00 01 33 FF 00 54 FF 00 00 00 01 34 FF 00 01 34 FF 00 55 FF 00 00 00 01 35 FF 00 01 35' - 'FF 00 56 FF 00 00 00 01 36 FF 00 01 36 FF 00 57 FF 00 00 00 01 37 FF 00 01 37 FF 00 58 FF 00 00' - '00 01 38 FF 00 01 38 FF 00 59 FF 00 00 00 01 39 FF 00 01 39 FF 00 5A FF 00 00 00 01 3A FF 00 01' - '3A FF 00 00 04 01 01 28 04 01 01 28 04 01 00 00 01 04 01 01 29 04 01 01 29 04 01 00 00 02 04 01' - '01 2A 04 01 01 2A 04 01 00 00 03 04 01 01 2B 04 01 01 2B 04 01 00 00 04 04 01 01 2C 04 01 01 2C' - '04 01 00 00 05 04 01 01 2D 04 01 01 2D 04 01 00 00 06 04 01 01 2E 04 01 01 2E 04 01 00 00 07 04' - '01 01 2F 04 01 01 2F 04 01 00 00 08 04 01 01 30 04 01 01 30 04 01 00 00 09 04 01 01 31 04 01 01' - '31 04 01 00 00 0A 04 01 01 32 04 01 01 32 04 01 00 00 0B 04 01 01 33 04 01 01 33 04 01 00 00 0C' - '04 01 01 34 04 01 01 34 04 01 00 00 0D 04 01 01 35 04 01 01 35 04 01 00 00 0E 04 01 01 36 04 01' - '01 36 04 01 00 00 0F 04 01 01 37 04 01 01 37 04 01 00 00 10 04 01 01 38 04 01 01 38 04 01 00 00' - '11 04 01 01 39 04 01 01 39 04 01 00 00 12 04 01 01 3A 04 01 01 3A 04 01 00 00 13 04 01 01 3B 04' - '01 01 3B 04 01 00 00 14 04 01 01 3C 04 01 01 3C 04 01 00 00 15 04 01 01 3D 04 01 01 3D 04 01 00' - '00 16 04 01 01 3E 04 01 01 3E 04 01 00 00 17 04 01 01 3F 04 01 01 3F 04 01 00 00 18 04 01 01 40' - '04 01 01 40 04 01 00 00 19 04 01 01 41 04 01 01 41 04 01 00 00 1A 04 01 01 42 04 01 01 42 04 01' - '00 00 1B 04 01 01 43 04 01 01 43 04 01 00 00 1C 04 01 01 44 04 01 01 44 04 01 00 00 1D 04 01 01' - '45 04 01 01 45 04 01 00 00 1E 04 01 01 46 04 01 01 46 04 01 00 00 1F 04 01 01 47 04 01 01 47 04' - '01 00 00 20 04 01 01 48 04 01 01 48 04 01 00 00 21 04 01 01 49 04 01 01 49 04 01 00 00 22 04 01' - '01 4A 04 01 01 4A 04 01 00 00 23 04 01 01 4B 04 01 01 4B 04 01 00 00 24 04 01 01 4C 04 01 01 4C' - '04 01 00 00 25 04 01 01 4D 04 01 01 4D 04 01 00 00 26 04 01 01 4E 04 01 01 4E 04 01 00 00 27 04' - '01 01 4F 04 01 01 4F 04 01 00 00 28 04 01 00 00 01 00 04 01 01 00 04 01 29 04 01 00 00 01 01 04' - '01 01 01 04 01 2A 04 01 00 00 01 02 04 01 01 02 04 01 2B 04 01 00 00 01 03 04 01 01 03 04 01 2C' - '04 01 00 00 01 04 04 01 01 04 04 01 2D 04 01 00 00 01 05 04 01 01 05 04 01 2E 04 01 00 00 01 06' - '04 01 01 06 04 01 2F 04 01 00 00 01 07 04 01 01 07 04 01 30 04 01 00 00 01 08 04 01 01 08 04 01' - '31 04 01 00 00 01 09 04 01 01 09 04 01 32 04 01 00 00 01 0A 04 01 01 0A 04 01 33 04 01 00 00 01' - '0B 04 01 01 0B 04 01 34 04 01 00 00 01 0C 04 01 01 0C 04 01 35 04 01 00 00 01 0D 04 01 01 0D 04' - '01 36 04 01 00 00 01 0E 04 01 01 0E 04 01 37 04 01 00 00 01 0F 04 01 01 0F 04 01 38 04 01 00 00' - '01 10 04 01 01 10 04 01 39 04 01 00 00 01 11 04 01 01 11 04 01 3A 04 01 00 00 01 12 04 01 01 12' - '04 01 3B 04 01 00 00 01 13 04 01 01 13 04 01 3C 04 01 00 00 01 14 04 01 01 14 04 01 3D 04 01 00' - '00 01 15 04 01 01 15 04 01 3E 04 01 00 00 01 16 04 01 01 16 04 01 3F 04 01 00 00 01 17 04 01 01' - '17 04 01 40 04 01 00 00 01 18 04 01 01 18 04 01 41 04 01 00 00 01 19 04 01 01 19 04 01 42 04 01' - '00 00 01 1A 04 01 01 1A 04 01 43 04 01 00 00 01 1B 04 01 01 1B 04 01 44 04 01 00 00 01 1C 04 01' - '01 1C 04 01 45 04 01 00 00 01 1D 04 01 01 1D 04 01 46 04 01 00 00 01 1E 04 01 01 1E 04 01 47 04' - '01 00 00 01 1F 04 01 01 1F 04 01 48 04 01 00 00 01 20 04 01 01 20 04 01 49 04 01 00 00 01 21 04' - '01 01 21 04 01 4A 04 01 00 00 01 22 04 01 01 22 04 01 4B 04 01 00 00 01 23 04 01 01 23 04 01 4C' - '04 01 00 00 01 24 04 01 01 24 04 01 4D 04 01 00 00 01 25 04 01 01 25 04 01 4E 04 01 00 00 01 26' - '04 01 01 26 04 01 4F 04 01 00 00 01 27 04 01 01 27 04 01 B0 04 01 01 D8 04 01 01 D8 04 01 00 00' - 'B1 04 01 01 D9 04 01 01 D9 04 01 00 00 B2 04 01 01 DA 04 01 01 DA 04 01 00 00 B3 04 01 01 DB 04' - '01 01 DB 04 01 00 00 B4 04 01 01 DC 04 01 01 DC 04 01 00 00 B5 04 01 01 DD 04 01 01 DD 04 01 00' - '00 B6 04 01 01 DE 04 01 01 DE 04 01 00 00 B7 04 01 01 DF 04 01 01 DF 04 01 00 00 B8 04 01 01 E0' - '04 01 01 E0 04 01 00 00 B9 04 01 01 E1 04 01 01 E1 04 01 00 00 BA 04 01 01 E2 04 01 01 E2 04 01' - '00 00 BB 04 01 01 E3 04 01 01 E3 04 01 00 00 BC 04 01 01 E4 04 01 01 E4 04 01 00 00 BD 04 01 01' - 'E5 04 01 01 E5 04 01 00 00 BE 04 01 01 E6 04 01 01 E6 04 01 00 00 BF 04 01 01 E7 04 01 01 E7 04' - '01 00 00 C0 04 01 01 E8 04 01 01 E8 04 01 00 00 C1 04 01 01 E9 04 01 01 E9 04 01 00 00 C2 04 01' - '01 EA 04 01 01 EA 04 01 00 00 C3 04 01 01 EB 04 01 01 EB 04 01 00 00 C4 04 01 01 EC 04 01 01 EC' - '04 01 00 00 C5 04 01 01 ED 04 01 01 ED 04 01 00 00 C6 04 01 01 EE 04 01 01 EE 04 01 00 00 C7 04' - '01 01 EF 04 01 01 EF 04 01 00 00 C8 04 01 01 F0 04 01 01 F0 04 01 00 00 C9 04 01 01 F1 04 01 01' - 'F1 04 01 00 00 CA 04 01 01 F2 04 01 01 F2 04 01 00 00 CB 04 01 01 F3 04 01 01 F3 04 01 00 00 CC' - '04 01 01 F4 04 01 01 F4 04 01 00 00 CD 04 01 01 F5 04 01 01 F5 04 01 00 00 CE 04 01 01 F6 04 01' - '01 F6 04 01 00 00 CF 04 01 01 F7 04 01 01 F7 04 01 00 00 D0 04 01 01 F8 04 01 01 F8 04 01 00 00' - 'D1 04 01 01 F9 04 01 01 F9 04 01 00 00 D2 04 01 01 FA 04 01 01 FA 04 01 00 00 D3 04 01 01 FB 04' - '01 01 FB 04 01 00 00 D8 04 01 00 00 01 B0 04 01 01 B0 04 01 D9 04 01 00 00 01 B1 04 01 01 B1 04' - '01 DA 04 01 00 00 01 B2 04 01 01 B2 04 01 DB 04 01 00 00 01 B3 04 01 01 B3 04 01 DC 04 01 00 00' - '01 B4 04 01 01 B4 04 01 DD 04 01 00 00 01 B5 04 01 01 B5 04 01 DE 04 01 00 00 01 B6 04 01 01 B6' - '04 01 DF 04 01 00 00 01 B7 04 01 01 B7 04 01 E0 04 01 00 00 01 B8 04 01 01 B8 04 01 E1 04 01 00' - '00 01 B9 04 01 01 B9 04 01 E2 04 01 00 00 01 BA 04 01 01 BA 04 01 E3 04 01 00 00 01 BB 04 01 01' - 'BB 04 01 E4 04 01 00 00 01 BC 04 01 01 BC 04 01 E5 04 01 00 00 01 BD 04 01 01 BD 04 01 E6 04 01' - '00 00 01 BE 04 01 01 BE 04 01 E7 04 01 00 00 01 BF 04 01 01 BF 04 01 E8 04 01 00 00 01 C0 04 01' - '01 C0 04 01 E9 04 01 00 00 01 C1 04 01 01 C1 04 01 EA 04 01 00 00 01 C2 04 01 01 C2 04 01 EB 04' - '01 00 00 01 C3 04 01 01 C3 04 01 EC 04 01 00 00 01 C4 04 01 01 C4 04 01 ED 04 01 00 00 01 C5 04' - '01 01 C5 04 01 EE 04 01 00 00 01 C6 04 01 01 C6 04 01 EF 04 01 00 00 01 C7 04 01 01 C7 04 01 F0' - '04 01 00 00 01 C8 04 01 01 C8 04 01 F1 04 01 00 00 01 C9 04 01 01 C9 04 01 F2 04 01 00 00 01 CA' - '04 01 01 CA 04 01 F3 04 01 00 00 01 CB 04 01 01 CB 04 01 F4 04 01 00 00 01 CC 04 01 01 CC 04 01' - 'F5 04 01 00 00 01 CD 04 01 01 CD 04 01 F6 04 01 00 00 01 CE 04 01 01 CE 04 01 F7 04 01 00 00 01' - 'CF 04 01 01 CF 04 01 F8 04 01 00 00 01 D0 04 01 01 D0 04 01 F9 04 01 00 00 01 D1 04 01 01 D1 04' - '01 FA 04 01 00 00 01 D2 04 01 01 D2 04 01 FB 04 01 00 00 01 D3 04 01 01 D3 04 01 80 0C 01 01 C0' - '0C 01 01 C0 0C 01 00 00 81 0C 01 01 C1 0C 01 01 C1 0C 01 00 00 82 0C 01 01 C2 0C 01 01 C2 0C 01' - '00 00 83 0C 01 01 C3 0C 01 01 C3 0C 01 00 00 84 0C 01 01 C4 0C 01 01 C4 0C 01 00 00 85 0C 01 01' - 'C5 0C 01 01 C5 0C 01 00 00 86 0C 01 01 C6 0C 01 01 C6 0C 01 00 00 87 0C 01 01 C7 0C 01 01 C7 0C' - '01 00 00 88 0C 01 01 C8 0C 01 01 C8 0C 01 00 00 89 0C 01 01 C9 0C 01 01 C9 0C 01 00 00 8A 0C 01' - '01 CA 0C 01 01 CA 0C 01 00 00 8B 0C 01 01 CB 0C 01 01 CB 0C 01 00 00 8C 0C 01 01 CC 0C 01 01 CC' - '0C 01 00 00 8D 0C 01 01 CD 0C 01 01 CD 0C 01 00 00 8E 0C 01 01 CE 0C 01 01 CE 0C 01 00 00 8F 0C' - '01 01 CF 0C 01 01 CF 0C 01 00 00 90 0C 01 01 D0 0C 01 01 D0 0C 01 00 00 91 0C 01 01 D1 0C 01 01' - 'D1 0C 01 00 00 92 0C 01 01 D2 0C 01 01 D2 0C 01 00 00 93 0C 01 01 D3 0C 01 01 D3 0C 01 00 00 94' - '0C 01 01 D4 0C 01 01 D4 0C 01 00 00 95 0C 01 01 D5 0C 01 01 D5 0C 01 00 00 96 0C 01 01 D6 0C 01' - '01 D6 0C 01 00 00 97 0C 01 01 D7 0C 01 01 D7 0C 01 00 00 98 0C 01 01 D8 0C 01 01 D8 0C 01 00 00' - '99 0C 01 01 D9 0C 01 01 D9 0C 01 00 00 9A 0C 01 01 DA 0C 01 01 DA 0C 01 00 00 9B 0C 01 01 DB 0C' - '01 01 DB 0C 01 00 00 9C 0C 01 01 DC 0C 01 01 DC 0C 01 00 00 9D 0C 01 01 DD 0C 01 01 DD 0C 01 00' - '00 9E 0C 01 01 DE 0C 01 01 DE 0C 01 00 00 9F 0C 01 01 DF 0C 01 01 DF 0C 01 00 00 A0 0C 01 01 E0' - '0C 01 01 E0 0C 01 00 00 A1 0C 01 01 E1 0C 01 01 E1 0C 01 00 00 A2 0C 01 01 E2 0C 01 01 E2 0C 01' - '00 00 A3 0C 01 01 E3 0C 01 01 E3 0C 01 00 00 A4 0C 01 01 E4 0C 01 01 E4 0C 01 00 00 A5 0C 01 01' - 'E5 0C 01 01 E5 0C 01 00 00 A6 0C 01 01 E6 0C 01 01 E6 0C 01 00 00 A7 0C 01 01 E7 0C 01 01 E7 0C' - '01 00 00 A8 0C 01 01 E8 0C 01 01 E8 0C 01 00 00 A9 0C 01 01 E9 0C 01 01 E9 0C 01 00 00 AA 0C 01' - '01 EA 0C 01 01 EA 0C 01 00 00 AB 0C 01 01 EB 0C 01 01 EB 0C 01 00 00 AC 0C 01 01 EC 0C 01 01 EC' - '0C 01 00 00 AD 0C 01 01 ED 0C 01 01 ED 0C 01 00 00 AE 0C 01 01 EE 0C 01 01 EE 0C 01 00 00 AF 0C' - '01 01 EF 0C 01 01 EF 0C 01 00 00 B0 0C 01 01 F0 0C 01 01 F0 0C 01 00 00 B1 0C 01 01 F1 0C 01 01' - 'F1 0C 01 00 00 B2 0C 01 01 F2 0C 01 01 F2 0C 01 00 00 C0 0C 01 00 00 01 80 0C 01 01 80 0C 01 C1' - '0C 01 00 00 01 81 0C 01 01 81 0C 01 C2 0C 01 00 00 01 82 0C 01 01 82 0C 01 C3 0C 01 00 00 01 83' - '0C 01 01 83 0C 01 C4 0C 01 00 00 01 84 0C 01 01 84 0C 01 C5 0C 01 00 00 01 85 0C 01 01 85 0C 01' - 'C6 0C 01 00 00 01 86 0C 01 01 86 0C 01 C7 0C 01 00 00 01 87 0C 01 01 87 0C 01 C8 0C 01 00 00 01' - '88 0C 01 01 88 0C 01 C9 0C 01 00 00 01 89 0C 01 01 89 0C 01 CA 0C 01 00 00 01 8A 0C 01 01 8A 0C' - '01 CB 0C 01 00 00 01 8B 0C 01 01 8B 0C 01 CC 0C 01 00 00 01 8C 0C 01 01 8C 0C 01 CD 0C 01 00 00' - '01 8D 0C 01 01 8D 0C 01 CE 0C 01 00 00 01 8E 0C 01 01 8E 0C 01 CF 0C 01 00 00 01 8F 0C 01 01 8F' - '0C 01 D0 0C 01 00 00 01 90 0C 01 01 90 0C 01 D1 0C 01 00 00 01 91 0C 01 01 91 0C 01 D2 0C 01 00' - '00 01 92 0C 01 01 92 0C 01 D3 0C 01 00 00 01 93 0C 01 01 93 0C 01 D4 0C 01 00 00 01 94 0C 01 01' - '94 0C 01 D5 0C 01 00 00 01 95 0C 01 01 95 0C 01 D6 0C 01 00 00 01 96 0C 01 01 96 0C 01 D7 0C 01' - '00 00 01 97 0C 01 01 97 0C 01 D8 0C 01 00 00 01 98 0C 01 01 98 0C 01 D9 0C 01 00 00 01 99 0C 01' - '01 99 0C 01 DA 0C 01 00 00 01 9A 0C 01 01 9A 0C 01 DB 0C 01 00 00 01 9B 0C 01 01 9B 0C 01 DC 0C' - '01 00 00 01 9C 0C 01 01 9C 0C 01 DD 0C 01 00 00 01 9D 0C 01 01 9D 0C 01 DE 0C 01 00 00 01 9E 0C' - '01 01 9E 0C 01 DF 0C 01 00 00 01 9F 0C 01 01 9F 0C 01 E0 0C 01 00 00 01 A0 0C 01 01 A0 0C 01 E1' - '0C 01 00 00 01 A1 0C 01 01 A1 0C 01 E2 0C 01 00 00 01 A2 0C 01 01 A2 0C 01 E3 0C 01 00 00 01 A3' - '0C 01 01 A3 0C 01 E4 0C 01 00 00 01 A4 0C 01 01 A4 0C 01 E5 0C 01 00 00 01 A5 0C 01 01 A5 0C 01' - 'E6 0C 01 00 00 01 A6 0C 01 01 A6 0C 01 E7 0C 01 00 00 01 A7 0C 01 01 A7 0C 01 E8 0C 01 00 00 01' - 'A8 0C 01 01 A8 0C 01 E9 0C 01 00 00 01 A9 0C 01 01 A9 0C 01 EA 0C 01 00 00 01 AA 0C 01 01 AA 0C' - '01 EB 0C 01 00 00 01 AB 0C 01 01 AB 0C 01 EC 0C 01 00 00 01 AC 0C 01 01 AC 0C 01 ED 0C 01 00 00' - '01 AD 0C 01 01 AD 0C 01 EE 0C 01 00 00 01 AE 0C 01 01 AE 0C 01 EF 0C 01 00 00 01 AF 0C 01 01 AF' - '0C 01 F0 0C 01 00 00 01 B0 0C 01 01 B0 0C 01 F1 0C 01 00 00 01 B1 0C 01 01 B1 0C 01 F2 0C 01 00' - '00 01 B2 0C 01 01 B2 0C 01 A0 18 01 01 C0 18 01 01 C0 18 01 00 00 A1 18 01 01 C1 18 01 01 C1 18' - '01 00 00 A2 18 01 01 C2 18 01 01 C2 18 01 00 00 A3 18 01 01 C3 18 01 01 C3 18 01 00 00 A4 18 01' - '01 C4 18 01 01 C4 18 01 00 00 A5 18 01 01 C5 18 01 01 C5 18 01 00 00 A6 18 01 01 C6 18 01 01 C6' - '18 01 00 00 A7 18 01 01 C7 18 01 01 C7 18 01 00 00 A8 18 01 01 C8 18 01 01 C8 18 01 00 00 A9 18' - '01 01 C9 18 01 01 C9 18 01 00 00 AA 18 01 01 CA 18 01 01 CA 18 01 00 00 AB 18 01 01 CB 18 01 01' - 'CB 18 01 00 00 AC 18 01 01 CC 18 01 01 CC 18 01 00 00 AD 18 01 01 CD 18 01 01 CD 18 01 00 00 AE' - '18 01 01 CE 18 01 01 CE 18 01 00 00 AF 18 01 01 CF 18 01 01 CF 18 01 00 00 B0 18 01 01 D0 18 01' - '01 D0 18 01 00 00 B1 18 01 01 D1 18 01 01 D1 18 01 00 00 B2 18 01 01 D2 18 01 01 D2 18 01 00 00' - 'B3 18 01 01 D3 18 01 01 D3 18 01 00 00 B4 18 01 01 D4 18 01 01 D4 18 01 00 00 B5 18 01 01 D5 18' - '01 01 D5 18 01 00 00 B6 18 01 01 D6 18 01 01 D6 18 01 00 00 B7 18 01 01 D7 18 01 01 D7 18 01 00' - '00 B8 18 01 01 D8 18 01 01 D8 18 01 00 00 B9 18 01 01 D9 18 01 01 D9 18 01 00 00 BA 18 01 01 DA' - '18 01 01 DA 18 01 00 00 BB 18 01 01 DB 18 01 01 DB 18 01 00 00 BC 18 01 01 DC 18 01 01 DC 18 01' - '00 00 BD 18 01 01 DD 18 01 01 DD 18 01 00 00 BE 18 01 01 DE 18 01 01 DE 18 01 00 00 BF 18 01 01' - 'DF 18 01 01 DF 18 01 00 00 C0 18 01 00 00 01 A0 18 01 01 A0 18 01 C1 18 01 00 00 01 A1 18 01 01' - 'A1 18 01 C2 18 01 00 00 01 A2 18 01 01 A2 18 01 C3 18 01 00 00 01 A3 18 01 01 A3 18 01 C4 18 01' - '00 00 01 A4 18 01 01 A4 18 01 C5 18 01 00 00 01 A5 18 01 01 A5 18 01 C6 18 01 00 00 01 A6 18 01' - '01 A6 18 01 C7 18 01 00 00 01 A7 18 01 01 A7 18 01 C8 18 01 00 00 01 A8 18 01 01 A8 18 01 C9 18' - '01 00 00 01 A9 18 01 01 A9 18 01 CA 18 01 00 00 01 AA 18 01 01 AA 18 01 CB 18 01 00 00 01 AB 18' - '01 01 AB 18 01 CC 18 01 00 00 01 AC 18 01 01 AC 18 01 CD 18 01 00 00 01 AD 18 01 01 AD 18 01 CE' - '18 01 00 00 01 AE 18 01 01 AE 18 01 CF 18 01 00 00 01 AF 18 01 01 AF 18 01 D0 18 01 00 00 01 B0' - '18 01 01 B0 18 01 D1 18 01 00 00 01 B1 18 01 01 B1 18 01 D2 18 01 00 00 01 B2 18 01 01 B2 18 01' - 'D3 18 01 00 00 01 B3 18 01 01 B3 18 01 D4 18 01 00 00 01 B4 18 01 01 B4 18 01 D5 18 01 00 00 01' - 'B5 18 01 01 B5 18 01 D6 18 01 00 00 01 B6 18 01 01 B6 18 01 D7 18 01 00 00 01 B7 18 01 01 B7 18' - '01 D8 18 01 00 00 01 B8 18 01 01 B8 18 01 D9 18 01 00 00 01 B9 18 01 01 B9 18 01 DA 18 01 00 00' - '01 BA 18 01 01 BA 18 01 DB 18 01 00 00 01 BB 18 01 01 BB 18 01 DC 18 01 00 00 01 BC 18 01 01 BC' - '18 01 DD 18 01 00 00 01 BD 18 01 01 BD 18 01 DE 18 01 00 00 01 BE 18 01 01 BE 18 01 DF 18 01 00' - '00 01 BF 18 01 01 BF 18 01 40 6E 01 01 60 6E 01 01 60 6E 01 00 00 41 6E 01 01 61 6E 01 01 61 6E' - '01 00 00 42 6E 01 01 62 6E 01 01 62 6E 01 00 00 43 6E 01 01 63 6E 01 01 63 6E 01 00 00 44 6E 01' - '01 64 6E 01 01 64 6E 01 00 00 45 6E 01 01 65 6E 01 01 65 6E 01 00 00 46 6E 01 01 66 6E 01 01 66' - '6E 01 00 00 47 6E 01 01 67 6E 01 01 67 6E 01 00 00 48 6E 01 01 68 6E 01 01 68 6E 01 00 00 49 6E' - '01 01 69 6E 01 01 69 6E 01 00 00 4A 6E 01 01 6A 6E 01 01 6A 6E 01 00 00 4B 6E 01 01 6B 6E 01 01' - '6B 6E 01 00 00 4C 6E 01 01 6C 6E 01 01 6C 6E 01 00 00 4D 6E 01 01 6D 6E 01 01 6D 6E 01 00 00 4E' - '6E 01 01 6E 6E 01 01 6E 6E 01 00 00 4F 6E 01 01 6F 6E 01 01 6F 6E 01 00 00 50 6E 01 01 70 6E 01' - '01 70 6E 01 00 00 51 6E 01 01 71 6E 01 01 71 6E 01 00 00 52 6E 01 01 72 6E 01 01 72 6E 01 00 00' - '53 6E 01 01 73 6E 01 01 73 6E 01 00 00 54 6E 01 01 74 6E 01 01 74 6E 01 00 00 55 6E 01 01 75 6E' - '01 01 75 6E 01 00 00 56 6E 01 01 76 6E 01 01 76 6E 01 00 00 57 6E 01 01 77 6E 01 01 77 6E 01 00' - '00 58 6E 01 01 78 6E 01 01 78 6E 01 00 00 59 6E 01 01 79 6E 01 01 79 6E 01 00 00 5A 6E 01 01 7A' - '6E 01 01 7A 6E 01 00 00 5B 6E 01 01 7B 6E 01 01 7B 6E 01 00 00 5C 6E 01 01 7C 6E 01 01 7C 6E 01' - '00 00 5D 6E 01 01 7D 6E 01 01 7D 6E 01 00 00 5E 6E 01 01 7E 6E 01 01 7E 6E 01 00 00 5F 6E 01 01' - '7F 6E 01 01 7F 6E 01 00 00 60 6E 01 00 00 01 40 6E 01 01 40 6E 01 61 6E 01 00 00 01 41 6E 01 01' - '41 6E 01 62 6E 01 00 00 01 42 6E 01 01 42 6E 01 63 6E 01 00 00 01 43 6E 01 01 43 6E 01 64 6E 01' - '00 00 01 44 6E 01 01 44 6E 01 65 6E 01 00 00 01 45 6E 01 01 45 6E 01 66 6E 01 00 00 01 46 6E 01' - '01 46 6E 01 67 6E 01 00 00 01 47 6E 01 01 47 6E 01 68 6E 01 00 00 01 48 6E 01 01 48 6E 01 69 6E' - '01 00 00 01 49 6E 01 01 49 6E 01 6A 6E 01 00 00 01 4A 6E 01 01 4A 6E 01 6B 6E 01 00 00 01 4B 6E' - '01 01 4B 6E 01 6C 6E 01 00 00 01 4C 6E 01 01 4C 6E 01 6D 6E 01 00 00 01 4D 6E 01 01 4D 6E 01 6E' - '6E 01 00 00 01 4E 6E 01 01 4E 6E 01 6F 6E 01 00 00 01 4F 6E 01 01 4F 6E 01 70 6E 01 00 00 01 50' - '6E 01 01 50 6E 01 71 6E 01 00 00 01 51 6E 01 01 51 6E 01 72 6E 01 00 00 01 52 6E 01 01 52 6E 01' - '73 6E 01 00 00 01 53 6E 01 01 53 6E 01 74 6E 01 00 00 01 54 6E 01 01 54 6E 01 75 6E 01 00 00 01' - '55 6E 01 01 55 6E 01 76 6E 01 00 00 01 56 6E 01 01 56 6E 01 77 6E 01 00 00 01 57 6E 01 01 57 6E' - '01 78 6E 01 00 00 01 58 6E 01 01 58 6E 01 79 6E 01 00 00 01 59 6E 01 01 59 6E 01 7A 6E 01 00 00' - '01 5A 6E 01 01 5A 6E 01 7B 6E 01 00 00 01 5B 6E 01 01 5B 6E 01 7C 6E 01 00 00 01 5C 6E 01 01 5C' - '6E 01 7D 6E 01 00 00 01 5D 6E 01 01 5D 6E 01 7E 6E 01 00 00 01 5E 6E 01 01 5E 6E 01 7F 6E 01 00' - '00 01 5F 6E 01 01 5F 6E 01 00 E9 01 01 22 E9 01 01 22 E9 01 00 00 01 E9 01 01 23 E9 01 01 23 E9' - '01 00 00 02 E9 01 01 24 E9 01 01 24 E9 01 00 00 03 E9 01 01 25 E9 01 01 25 E9 01 00 00 04 E9 01' - '01 26 E9 01 01 26 E9 01 00 00 05 E9 01 01 27 E9 01 01 27 E9 01 00 00 06 E9 01 01 28 E9 01 01 28' - 'E9 01 00 00 07 E9 01 01 29 E9 01 01 29 E9 01 00 00 08 E9 01 01 2A E9 01 01 2A E9 01 00 00 09 E9' - '01 01 2B E9 01 01 2B E9 01 00 00 0A E9 01 01 2C E9 01 01 2C E9 01 00 00 0B E9 01 01 2D E9 01 01' - '2D E9 01 00 00 0C E9 01 01 2E E9 01 01 2E E9 01 00 00 0D E9 01 01 2F E9 01 01 2F E9 01 00 00 0E' - 'E9 01 01 30 E9 01 01 30 E9 01 00 00 0F E9 01 01 31 E9 01 01 31 E9 01 00 00 10 E9 01 01 32 E9 01' - '01 32 E9 01 00 00 11 E9 01 01 33 E9 01 01 33 E9 01 00 00 12 E9 01 01 34 E9 01 01 34 E9 01 00 00' - '13 E9 01 01 35 E9 01 01 35 E9 01 00 00 14 E9 01 01 36 E9 01 01 36 E9 01 00 00 15 E9 01 01 37 E9' - '01 01 37 E9 01 00 00 16 E9 01 01 38 E9 01 01 38 E9 01 00 00 17 E9 01 01 39 E9 01 01 39 E9 01 00' - '00 18 E9 01 01 3A E9 01 01 3A E9 01 00 00 19 E9 01 01 3B E9 01 01 3B E9 01 00 00 1A E9 01 01 3C' - 'E9 01 01 3C E9 01 00 00 1B E9 01 01 3D E9 01 01 3D E9 01 00 00 1C E9 01 01 3E E9 01 01 3E E9 01' - '00 00 1D E9 01 01 3F E9 01 01 3F E9 01 00 00 1E E9 01 01 40 E9 01 01 40 E9 01 00 00 1F E9 01 01' - '41 E9 01 01 41 E9 01 00 00 20 E9 01 01 42 E9 01 01 42 E9 01 00 00 21 E9 01 01 43 E9 01 01 43 E9' - '01 00 00 22 E9 01 00 00 01 00 E9 01 01 00 E9 01 23 E9 01 00 00 01 01 E9 01 01 01 E9 01 24 E9 01' - '00 00 01 02 E9 01 01 02 E9 01 25 E9 01 00 00 01 03 E9 01 01 03 E9 01 26 E9 01 00 00 01 04 E9 01' - '01 04 E9 01 27 E9 01 00 00 01 05 E9 01 01 05 E9 01 28 E9 01 00 00 01 06 E9 01 01 06 E9 01 29 E9' - '01 00 00 01 07 E9 01 01 07 E9 01 2A E9 01 00 00 01 08 E9 01 01 08 E9 01 2B E9 01 00 00 01 09 E9' - '01 01 09 E9 01 2C E9 01 00 00 01 0A E9 01 01 0A E9 01 2D E9 01 00 00 01 0B E9 01 01 0B E9 01 2E' - 'E9 01 00 00 01 0C E9 01 01 0C E9 01 2F E9 01 00 00 01 0D E9 01 01 0D E9 01 30 E9 01 00 00 01 0E' - 'E9 01 01 0E E9 01 31 E9 01 00 00 01 0F E9 01 01 0F E9 01 32 E9 01 00 00 01 10 E9 01 01 10 E9 01' - '33 E9 01 00 00 01 11 E9 01 01 11 E9 01 34 E9 01 00 00 01 12 E9 01 01 12 E9 01 35 E9 01 00 00 01' - '13 E9 01 01 13 E9 01 36 E9 01 00 00 01 14 E9 01 01 14 E9 01 37 E9 01 00 00 01 15 E9 01 01 15 E9' - '01 38 E9 01 00 00 01 16 E9 01 01 16 E9 01 39 E9 01 00 00 01 17 E9 01 01 17 E9 01 3A E9 01 00 00' - '01 18 E9 01 01 18 E9 01 3B E9 01 00 00 01 19 E9 01 01 19 E9 01 3C E9 01 00 00 01 1A E9 01 01 1A' - 'E9 01 3D E9 01 00 00 01 1B E9 01 01 1B E9 01 3E E9 01 00 00 01 1C E9 01 01 1C E9 01 3F E9 01 00' - '00 01 1D E9 01 01 1D E9 01 40 E9 01 00 00 01 1E E9 01 01 1E E9 01 41 E9 01 00 00 01 1F E9 01 01' - '1F E9 01 42 E9 01 00 00 01 20 E9 01 01 20 E9 01 43 E9 01 00 00 01 21 E9 01 01 21 E9 01' -} - - -LANGUAGE 0,0 DECOMPOSITION UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE -{ - '68 16 00 00 A0 00 00 01 02 20 00 00 A8 00 00 02 10 20 00 00 08 03 00 AA 00 00 01 08 61 00 00 AF' - '00 00 02 10 20 00 00 04 03 00 B2 00 00 01 08 32 00 00 B3 00 00 01 08 33 00 00 B4 00 00 02 10 20' - '00 00 01 03 00 B5 00 00 01 10 BC 03 00 B8 00 00 02 10 20 00 00 27 03 00 B9 00 00 01 08 31 00 00' - 'BA 00 00 01 08 6F 00 00 BC 00 00 03 0F 31 00 00 44 20 00 34 00 00 BD 00 00 03 0F 31 00 00 44 20' - '00 32 00 00 BE 00 00 03 0F 33 00 00 44 20 00 34 00 00 C0 00 00 02 00 41 00 00 00 03 00 C1 00 00' - '02 00 41 00 00 01 03 00 C2 00 00 02 00 41 00 00 02 03 00 C3 00 00 02 00 41 00 00 03 03 00 C4 00' - '00 02 00 41 00 00 08 03 00 C5 00 00 02 00 41 00 00 0A 03 00 C7 00 00 02 00 43 00 00 27 03 00 C8' - '00 00 02 00 45 00 00 00 03 00 C9 00 00 02 00 45 00 00 01 03 00 CA 00 00 02 00 45 00 00 02 03 00' - 'CB 00 00 02 00 45 00 00 08 03 00 CC 00 00 02 00 49 00 00 00 03 00 CD 00 00 02 00 49 00 00 01 03' - '00 CE 00 00 02 00 49 00 00 02 03 00 CF 00 00 02 00 49 00 00 08 03 00 D1 00 00 02 00 4E 00 00 03' - '03 00 D2 00 00 02 00 4F 00 00 00 03 00 D3 00 00 02 00 4F 00 00 01 03 00 D4 00 00 02 00 4F 00 00' - '02 03 00 D5 00 00 02 00 4F 00 00 03 03 00 D6 00 00 02 00 4F 00 00 08 03 00 D9 00 00 02 00 55 00' - '00 00 03 00 DA 00 00 02 00 55 00 00 01 03 00 DB 00 00 02 00 55 00 00 02 03 00 DC 00 00 02 00 55' - '00 00 08 03 00 DD 00 00 02 00 59 00 00 01 03 00 E0 00 00 02 00 61 00 00 00 03 00 E1 00 00 02 00' - '61 00 00 01 03 00 E2 00 00 02 00 61 00 00 02 03 00 E3 00 00 02 00 61 00 00 03 03 00 E4 00 00 02' - '00 61 00 00 08 03 00 E5 00 00 02 00 61 00 00 0A 03 00 E7 00 00 02 00 63 00 00 27 03 00 E8 00 00' - '02 00 65 00 00 00 03 00 E9 00 00 02 00 65 00 00 01 03 00 EA 00 00 02 00 65 00 00 02 03 00 EB 00' - '00 02 00 65 00 00 08 03 00 EC 00 00 02 00 69 00 00 00 03 00 ED 00 00 02 00 69 00 00 01 03 00 EE' - '00 00 02 00 69 00 00 02 03 00 EF 00 00 02 00 69 00 00 08 03 00 F1 00 00 02 00 6E 00 00 03 03 00' - 'F2 00 00 02 00 6F 00 00 00 03 00 F3 00 00 02 00 6F 00 00 01 03 00 F4 00 00 02 00 6F 00 00 02 03' - '00 F5 00 00 02 00 6F 00 00 03 03 00 F6 00 00 02 00 6F 00 00 08 03 00 F9 00 00 02 00 75 00 00 00' - '03 00 FA 00 00 02 00 75 00 00 01 03 00 FB 00 00 02 00 75 00 00 02 03 00 FC 00 00 02 00 75 00 00' - '08 03 00 FD 00 00 02 00 79 00 00 01 03 00 FF 00 00 02 00 79 00 00 08 03 00 00 01 00 02 00 41 00' - '00 04 03 00 01 01 00 02 00 61 00 00 04 03 00 02 01 00 02 00 41 00 00 06 03 00 03 01 00 02 00 61' - '00 00 06 03 00 04 01 00 02 00 41 00 00 28 03 00 05 01 00 02 00 61 00 00 28 03 00 06 01 00 02 00' - '43 00 00 01 03 00 07 01 00 02 00 63 00 00 01 03 00 08 01 00 02 00 43 00 00 02 03 00 09 01 00 02' - '00 63 00 00 02 03 00 0A 01 00 02 00 43 00 00 07 03 00 0B 01 00 02 00 63 00 00 07 03 00 0C 01 00' - '02 00 43 00 00 0C 03 00 0D 01 00 02 00 63 00 00 0C 03 00 0E 01 00 02 00 44 00 00 0C 03 00 0F 01' - '00 02 00 64 00 00 0C 03 00 12 01 00 02 00 45 00 00 04 03 00 13 01 00 02 00 65 00 00 04 03 00 14' - '01 00 02 00 45 00 00 06 03 00 15 01 00 02 00 65 00 00 06 03 00 16 01 00 02 00 45 00 00 07 03 00' - '17 01 00 02 00 65 00 00 07 03 00 18 01 00 02 00 45 00 00 28 03 00 19 01 00 02 00 65 00 00 28 03' - '00 1A 01 00 02 00 45 00 00 0C 03 00 1B 01 00 02 00 65 00 00 0C 03 00 1C 01 00 02 00 47 00 00 02' - '03 00 1D 01 00 02 00 67 00 00 02 03 00 1E 01 00 02 00 47 00 00 06 03 00 1F 01 00 02 00 67 00 00' - '06 03 00 20 01 00 02 00 47 00 00 07 03 00 21 01 00 02 00 67 00 00 07 03 00 22 01 00 02 00 47 00' - '00 27 03 00 23 01 00 02 00 67 00 00 27 03 00 24 01 00 02 00 48 00 00 02 03 00 25 01 00 02 00 68' - '00 00 02 03 00 28 01 00 02 00 49 00 00 03 03 00 29 01 00 02 00 69 00 00 03 03 00 2A 01 00 02 00' - '49 00 00 04 03 00 2B 01 00 02 00 69 00 00 04 03 00 2C 01 00 02 00 49 00 00 06 03 00 2D 01 00 02' - '00 69 00 00 06 03 00 2E 01 00 02 00 49 00 00 28 03 00 2F 01 00 02 00 69 00 00 28 03 00 30 01 00' - '02 00 49 00 00 07 03 00 32 01 00 02 10 49 00 00 4A 00 00 33 01 00 02 10 69 00 00 6A 00 00 34 01' - '00 02 00 4A 00 00 02 03 00 35 01 00 02 00 6A 00 00 02 03 00 36 01 00 02 00 4B 00 00 27 03 00 37' - '01 00 02 00 6B 00 00 27 03 00 39 01 00 02 00 4C 00 00 01 03 00 3A 01 00 02 00 6C 00 00 01 03 00' - '3B 01 00 02 00 4C 00 00 27 03 00 3C 01 00 02 00 6C 00 00 27 03 00 3D 01 00 02 00 4C 00 00 0C 03' - '00 3E 01 00 02 00 6C 00 00 0C 03 00 3F 01 00 02 10 4C 00 00 B7 00 00 40 01 00 02 10 6C 00 00 B7' - '00 00 43 01 00 02 00 4E 00 00 01 03 00 44 01 00 02 00 6E 00 00 01 03 00 45 01 00 02 00 4E 00 00' - '27 03 00 46 01 00 02 00 6E 00 00 27 03 00 47 01 00 02 00 4E 00 00 0C 03 00 48 01 00 02 00 6E 00' - '00 0C 03 00 49 01 00 02 10 BC 02 00 6E 00 00 4C 01 00 02 00 4F 00 00 04 03 00 4D 01 00 02 00 6F' - '00 00 04 03 00 4E 01 00 02 00 4F 00 00 06 03 00 4F 01 00 02 00 6F 00 00 06 03 00 50 01 00 02 00' - '4F 00 00 0B 03 00 51 01 00 02 00 6F 00 00 0B 03 00 54 01 00 02 00 52 00 00 01 03 00 55 01 00 02' - '00 72 00 00 01 03 00 56 01 00 02 00 52 00 00 27 03 00 57 01 00 02 00 72 00 00 27 03 00 58 01 00' - '02 00 52 00 00 0C 03 00 59 01 00 02 00 72 00 00 0C 03 00 5A 01 00 02 00 53 00 00 01 03 00 5B 01' - '00 02 00 73 00 00 01 03 00 5C 01 00 02 00 53 00 00 02 03 00 5D 01 00 02 00 73 00 00 02 03 00 5E' - '01 00 02 00 53 00 00 27 03 00 5F 01 00 02 00 73 00 00 27 03 00 60 01 00 02 00 53 00 00 0C 03 00' - '61 01 00 02 00 73 00 00 0C 03 00 62 01 00 02 00 54 00 00 27 03 00 63 01 00 02 00 74 00 00 27 03' - '00 64 01 00 02 00 54 00 00 0C 03 00 65 01 00 02 00 74 00 00 0C 03 00 68 01 00 02 00 55 00 00 03' - '03 00 69 01 00 02 00 75 00 00 03 03 00 6A 01 00 02 00 55 00 00 04 03 00 6B 01 00 02 00 75 00 00' - '04 03 00 6C 01 00 02 00 55 00 00 06 03 00 6D 01 00 02 00 75 00 00 06 03 00 6E 01 00 02 00 55 00' - '00 0A 03 00 6F 01 00 02 00 75 00 00 0A 03 00 70 01 00 02 00 55 00 00 0B 03 00 71 01 00 02 00 75' - '00 00 0B 03 00 72 01 00 02 00 55 00 00 28 03 00 73 01 00 02 00 75 00 00 28 03 00 74 01 00 02 00' - '57 00 00 02 03 00 75 01 00 02 00 77 00 00 02 03 00 76 01 00 02 00 59 00 00 02 03 00 77 01 00 02' - '00 79 00 00 02 03 00 78 01 00 02 00 59 00 00 08 03 00 79 01 00 02 00 5A 00 00 01 03 00 7A 01 00' - '02 00 7A 00 00 01 03 00 7B 01 00 02 00 5A 00 00 07 03 00 7C 01 00 02 00 7A 00 00 07 03 00 7D 01' - '00 02 00 5A 00 00 0C 03 00 7E 01 00 02 00 7A 00 00 0C 03 00 7F 01 00 01 10 73 00 00 A0 01 00 02' - '00 4F 00 00 1B 03 00 A1 01 00 02 00 6F 00 00 1B 03 00 AF 01 00 02 00 55 00 00 1B 03 00 B0 01 00' - '02 00 75 00 00 1B 03 00 C4 01 00 03 10 44 00 00 5A 00 00 0C 03 00 C5 01 00 03 10 44 00 00 7A 00' - '00 0C 03 00 C6 01 00 03 10 64 00 00 7A 00 00 0C 03 00 C7 01 00 02 10 4C 00 00 4A 00 00 C8 01 00' - '02 10 4C 00 00 6A 00 00 C9 01 00 02 10 6C 00 00 6A 00 00 CA 01 00 02 10 4E 00 00 4A 00 00 CB 01' - '00 02 10 4E 00 00 6A 00 00 CC 01 00 02 10 6E 00 00 6A 00 00 CD 01 00 02 00 41 00 00 0C 03 00 CE' - '01 00 02 00 61 00 00 0C 03 00 CF 01 00 02 00 49 00 00 0C 03 00 D0 01 00 02 00 69 00 00 0C 03 00' - 'D1 01 00 02 00 4F 00 00 0C 03 00 D2 01 00 02 00 6F 00 00 0C 03 00 D3 01 00 02 00 55 00 00 0C 03' - '00 D4 01 00 02 00 75 00 00 0C 03 00 D5 01 00 03 00 55 00 00 08 03 00 04 03 00 D6 01 00 03 00 75' - '00 00 08 03 00 04 03 00 D7 01 00 03 00 55 00 00 08 03 00 01 03 00 D8 01 00 03 00 75 00 00 08 03' - '00 01 03 00 D9 01 00 03 00 55 00 00 08 03 00 0C 03 00 DA 01 00 03 00 75 00 00 08 03 00 0C 03 00' - 'DB 01 00 03 00 55 00 00 08 03 00 00 03 00 DC 01 00 03 00 75 00 00 08 03 00 00 03 00 DE 01 00 03' - '00 41 00 00 08 03 00 04 03 00 DF 01 00 03 00 61 00 00 08 03 00 04 03 00 E0 01 00 03 00 41 00 00' - '07 03 00 04 03 00 E1 01 00 03 00 61 00 00 07 03 00 04 03 00 E2 01 00 02 00 C6 00 00 04 03 00 E3' - '01 00 02 00 E6 00 00 04 03 00 E6 01 00 02 00 47 00 00 0C 03 00 E7 01 00 02 00 67 00 00 0C 03 00' - 'E8 01 00 02 00 4B 00 00 0C 03 00 E9 01 00 02 00 6B 00 00 0C 03 00 EA 01 00 02 00 4F 00 00 28 03' - '00 EB 01 00 02 00 6F 00 00 28 03 00 EC 01 00 03 00 4F 00 00 28 03 00 04 03 00 ED 01 00 03 00 6F' - '00 00 28 03 00 04 03 00 EE 01 00 02 00 B7 01 00 0C 03 00 EF 01 00 02 00 92 02 00 0C 03 00 F0 01' - '00 02 00 6A 00 00 0C 03 00 F1 01 00 02 10 44 00 00 5A 00 00 F2 01 00 02 10 44 00 00 7A 00 00 F3' - '01 00 02 10 64 00 00 7A 00 00 F4 01 00 02 00 47 00 00 01 03 00 F5 01 00 02 00 67 00 00 01 03 00' - 'F8 01 00 02 00 4E 00 00 00 03 00 F9 01 00 02 00 6E 00 00 00 03 00 FA 01 00 03 00 41 00 00 0A 03' - '00 01 03 00 FB 01 00 03 00 61 00 00 0A 03 00 01 03 00 FC 01 00 02 00 C6 00 00 01 03 00 FD 01 00' - '02 00 E6 00 00 01 03 00 FE 01 00 02 00 D8 00 00 01 03 00 FF 01 00 02 00 F8 00 00 01 03 00 00 02' - '00 02 00 41 00 00 0F 03 00 01 02 00 02 00 61 00 00 0F 03 00 02 02 00 02 00 41 00 00 11 03 00 03' - '02 00 02 00 61 00 00 11 03 00 04 02 00 02 00 45 00 00 0F 03 00 05 02 00 02 00 65 00 00 0F 03 00' - '06 02 00 02 00 45 00 00 11 03 00 07 02 00 02 00 65 00 00 11 03 00 08 02 00 02 00 49 00 00 0F 03' - '00 09 02 00 02 00 69 00 00 0F 03 00 0A 02 00 02 00 49 00 00 11 03 00 0B 02 00 02 00 69 00 00 11' - '03 00 0C 02 00 02 00 4F 00 00 0F 03 00 0D 02 00 02 00 6F 00 00 0F 03 00 0E 02 00 02 00 4F 00 00' - '11 03 00 0F 02 00 02 00 6F 00 00 11 03 00 10 02 00 02 00 52 00 00 0F 03 00 11 02 00 02 00 72 00' - '00 0F 03 00 12 02 00 02 00 52 00 00 11 03 00 13 02 00 02 00 72 00 00 11 03 00 14 02 00 02 00 55' - '00 00 0F 03 00 15 02 00 02 00 75 00 00 0F 03 00 16 02 00 02 00 55 00 00 11 03 00 17 02 00 02 00' - '75 00 00 11 03 00 18 02 00 02 00 53 00 00 26 03 00 19 02 00 02 00 73 00 00 26 03 00 1A 02 00 02' - '00 54 00 00 26 03 00 1B 02 00 02 00 74 00 00 26 03 00 1E 02 00 02 00 48 00 00 0C 03 00 1F 02 00' - '02 00 68 00 00 0C 03 00 26 02 00 02 00 41 00 00 07 03 00 27 02 00 02 00 61 00 00 07 03 00 28 02' - '00 02 00 45 00 00 27 03 00 29 02 00 02 00 65 00 00 27 03 00 2A 02 00 03 00 4F 00 00 08 03 00 04' - '03 00 2B 02 00 03 00 6F 00 00 08 03 00 04 03 00 2C 02 00 03 00 4F 00 00 03 03 00 04 03 00 2D 02' - '00 03 00 6F 00 00 03 03 00 04 03 00 2E 02 00 02 00 4F 00 00 07 03 00 2F 02 00 02 00 6F 00 00 07' - '03 00 30 02 00 03 00 4F 00 00 07 03 00 04 03 00 31 02 00 03 00 6F 00 00 07 03 00 04 03 00 32 02' - '00 02 00 59 00 00 04 03 00 33 02 00 02 00 79 00 00 04 03 00 B0 02 00 01 08 68 00 00 B1 02 00 01' - '08 66 02 00 B2 02 00 01 08 6A 00 00 B3 02 00 01 08 72 00 00 B4 02 00 01 08 79 02 00 B5 02 00 01' - '08 7B 02 00 B6 02 00 01 08 81 02 00 B7 02 00 01 08 77 00 00 B8 02 00 01 08 79 00 00 D8 02 00 02' - '10 20 00 00 06 03 00 D9 02 00 02 10 20 00 00 07 03 00 DA 02 00 02 10 20 00 00 0A 03 00 DB 02 00' - '02 10 20 00 00 28 03 00 DC 02 00 02 10 20 00 00 03 03 00 DD 02 00 02 10 20 00 00 0B 03 00 E0 02' - '00 01 08 63 02 00 E1 02 00 01 08 6C 00 00 E2 02 00 01 08 73 00 00 E3 02 00 01 08 78 00 00 E4 02' - '00 01 08 95 02 00 40 03 00 01 00 00 03 00 41 03 00 01 00 01 03 00 43 03 00 01 00 13 03 00 44 03' - '00 02 00 08 03 00 01 03 00 74 03 00 01 00 B9 02 00 7A 03 00 02 10 20 00 00 45 03 00 7E 03 00 01' - '00 3B 00 00 84 03 00 02 10 20 00 00 01 03 00 85 03 00 03 00 20 00 00 08 03 00 01 03 00 86 03 00' - '02 00 91 03 00 01 03 00 87 03 00 01 00 B7 00 00 88 03 00 02 00 95 03 00 01 03 00 89 03 00 02 00' - '97 03 00 01 03 00 8A 03 00 02 00 99 03 00 01 03 00 8C 03 00 02 00 9F 03 00 01 03 00 8E 03 00 02' - '00 A5 03 00 01 03 00 8F 03 00 02 00 A9 03 00 01 03 00 90 03 00 03 00 B9 03 00 08 03 00 01 03 00' - 'AA 03 00 02 00 99 03 00 08 03 00 AB 03 00 02 00 A5 03 00 08 03 00 AC 03 00 02 00 B1 03 00 01 03' - '00 AD 03 00 02 00 B5 03 00 01 03 00 AE 03 00 02 00 B7 03 00 01 03 00 AF 03 00 02 00 B9 03 00 01' - '03 00 B0 03 00 03 00 C5 03 00 08 03 00 01 03 00 CA 03 00 02 00 B9 03 00 08 03 00 CB 03 00 02 00' - 'C5 03 00 08 03 00 CC 03 00 02 00 BF 03 00 01 03 00 CD 03 00 02 00 C5 03 00 01 03 00 CE 03 00 02' - '00 C9 03 00 01 03 00 D0 03 00 01 10 B2 03 00 D1 03 00 01 10 B8 03 00 D2 03 00 01 10 A5 03 00 D3' - '03 00 02 00 A5 03 00 01 03 00 D4 03 00 02 00 A5 03 00 08 03 00 D5 03 00 01 10 C6 03 00 D6 03 00' - '01 10 C0 03 00 F0 03 00 01 10 BA 03 00 F1 03 00 01 10 C1 03 00 F2 03 00 01 10 C2 03 00 F4 03 00' - '01 10 98 03 00 F5 03 00 01 10 B5 03 00 F9 03 00 01 10 A3 03 00 00 04 00 02 00 15 04 00 00 03 00' - '01 04 00 02 00 15 04 00 08 03 00 03 04 00 02 00 13 04 00 01 03 00 07 04 00 02 00 06 04 00 08 03' - '00 0C 04 00 02 00 1A 04 00 01 03 00 0D 04 00 02 00 18 04 00 00 03 00 0E 04 00 02 00 23 04 00 06' - '03 00 19 04 00 02 00 18 04 00 06 03 00 39 04 00 02 00 38 04 00 06 03 00 50 04 00 02 00 35 04 00' - '00 03 00 51 04 00 02 00 35 04 00 08 03 00 53 04 00 02 00 33 04 00 01 03 00 57 04 00 02 00 56 04' - '00 08 03 00 5C 04 00 02 00 3A 04 00 01 03 00 5D 04 00 02 00 38 04 00 00 03 00 5E 04 00 02 00 43' - '04 00 06 03 00 76 04 00 02 00 74 04 00 0F 03 00 77 04 00 02 00 75 04 00 0F 03 00 C1 04 00 02 00' - '16 04 00 06 03 00 C2 04 00 02 00 36 04 00 06 03 00 D0 04 00 02 00 10 04 00 06 03 00 D1 04 00 02' - '00 30 04 00 06 03 00 D2 04 00 02 00 10 04 00 08 03 00 D3 04 00 02 00 30 04 00 08 03 00 D6 04 00' - '02 00 15 04 00 06 03 00 D7 04 00 02 00 35 04 00 06 03 00 DA 04 00 02 00 D8 04 00 08 03 00 DB 04' - '00 02 00 D9 04 00 08 03 00 DC 04 00 02 00 16 04 00 08 03 00 DD 04 00 02 00 36 04 00 08 03 00 DE' - '04 00 02 00 17 04 00 08 03 00 DF 04 00 02 00 37 04 00 08 03 00 E2 04 00 02 00 18 04 00 04 03 00' - 'E3 04 00 02 00 38 04 00 04 03 00 E4 04 00 02 00 18 04 00 08 03 00 E5 04 00 02 00 38 04 00 08 03' - '00 E6 04 00 02 00 1E 04 00 08 03 00 E7 04 00 02 00 3E 04 00 08 03 00 EA 04 00 02 00 E8 04 00 08' - '03 00 EB 04 00 02 00 E9 04 00 08 03 00 EC 04 00 02 00 2D 04 00 08 03 00 ED 04 00 02 00 4D 04 00' - '08 03 00 EE 04 00 02 00 23 04 00 04 03 00 EF 04 00 02 00 43 04 00 04 03 00 F0 04 00 02 00 23 04' - '00 08 03 00 F1 04 00 02 00 43 04 00 08 03 00 F2 04 00 02 00 23 04 00 0B 03 00 F3 04 00 02 00 43' - '04 00 0B 03 00 F4 04 00 02 00 27 04 00 08 03 00 F5 04 00 02 00 47 04 00 08 03 00 F8 04 00 02 00' - '2B 04 00 08 03 00 F9 04 00 02 00 4B 04 00 08 03 00 87 05 00 02 10 65 05 00 82 05 00 22 06 00 02' - '00 27 06 00 53 06 00 23 06 00 02 00 27 06 00 54 06 00 24 06 00 02 00 48 06 00 54 06 00 25 06 00' - '02 00 27 06 00 55 06 00 26 06 00 02 00 4A 06 00 54 06 00 75 06 00 02 10 27 06 00 74 06 00 76 06' - '00 02 10 48 06 00 74 06 00 77 06 00 02 10 C7 06 00 74 06 00 78 06 00 02 10 4A 06 00 74 06 00 C0' - '06 00 02 00 D5 06 00 54 06 00 C2 06 00 02 00 C1 06 00 54 06 00 D3 06 00 02 00 D2 06 00 54 06 00' - '29 09 00 02 00 28 09 00 3C 09 00 31 09 00 02 00 30 09 00 3C 09 00 34 09 00 02 00 33 09 00 3C 09' - '00 58 09 00 02 00 15 09 00 3C 09 00 59 09 00 02 00 16 09 00 3C 09 00 5A 09 00 02 00 17 09 00 3C' - '09 00 5B 09 00 02 00 1C 09 00 3C 09 00 5C 09 00 02 00 21 09 00 3C 09 00 5D 09 00 02 00 22 09 00' - '3C 09 00 5E 09 00 02 00 2B 09 00 3C 09 00 5F 09 00 02 00 2F 09 00 3C 09 00 CB 09 00 02 00 C7 09' - '00 BE 09 00 CC 09 00 02 00 C7 09 00 D7 09 00 DC 09 00 02 00 A1 09 00 BC 09 00 DD 09 00 02 00 A2' - '09 00 BC 09 00 DF 09 00 02 00 AF 09 00 BC 09 00 33 0A 00 02 00 32 0A 00 3C 0A 00 36 0A 00 02 00' - '38 0A 00 3C 0A 00 59 0A 00 02 00 16 0A 00 3C 0A 00 5A 0A 00 02 00 17 0A 00 3C 0A 00 5B 0A 00 02' - '00 1C 0A 00 3C 0A 00 5E 0A 00 02 00 2B 0A 00 3C 0A 00 48 0B 00 02 00 47 0B 00 56 0B 00 4B 0B 00' - '02 00 47 0B 00 3E 0B 00 4C 0B 00 02 00 47 0B 00 57 0B 00 5C 0B 00 02 00 21 0B 00 3C 0B 00 5D 0B' - '00 02 00 22 0B 00 3C 0B 00 94 0B 00 02 00 92 0B 00 D7 0B 00 CA 0B 00 02 00 C6 0B 00 BE 0B 00 CB' - '0B 00 02 00 C7 0B 00 BE 0B 00 CC 0B 00 02 00 C6 0B 00 D7 0B 00 48 0C 00 02 00 46 0C 00 56 0C 00' - 'C0 0C 00 02 00 BF 0C 00 D5 0C 00 C7 0C 00 02 00 C6 0C 00 D5 0C 00 C8 0C 00 02 00 C6 0C 00 D6 0C' - '00 CA 0C 00 02 00 C6 0C 00 C2 0C 00 CB 0C 00 03 00 C6 0C 00 C2 0C 00 D5 0C 00 4A 0D 00 02 00 46' - '0D 00 3E 0D 00 4B 0D 00 02 00 47 0D 00 3E 0D 00 4C 0D 00 02 00 46 0D 00 57 0D 00 DA 0D 00 02 00' - 'D9 0D 00 CA 0D 00 DC 0D 00 02 00 D9 0D 00 CF 0D 00 DD 0D 00 03 00 D9 0D 00 CF 0D 00 CA 0D 00 DE' - '0D 00 02 00 D9 0D 00 DF 0D 00 33 0E 00 02 10 4D 0E 00 32 0E 00 B3 0E 00 02 10 CD 0E 00 B2 0E 00' - 'DC 0E 00 02 10 AB 0E 00 99 0E 00 DD 0E 00 02 10 AB 0E 00 A1 0E 00 0C 0F 00 01 02 0B 0F 00 43 0F' - '00 02 00 42 0F 00 B7 0F 00 4D 0F 00 02 00 4C 0F 00 B7 0F 00 52 0F 00 02 00 51 0F 00 B7 0F 00 57' - '0F 00 02 00 56 0F 00 B7 0F 00 5C 0F 00 02 00 5B 0F 00 B7 0F 00 69 0F 00 02 00 40 0F 00 B5 0F 00' - '73 0F 00 02 00 71 0F 00 72 0F 00 75 0F 00 02 00 71 0F 00 74 0F 00 76 0F 00 02 00 B2 0F 00 80 0F' - '00 77 0F 00 03 10 B2 0F 00 71 0F 00 80 0F 00 78 0F 00 02 00 B3 0F 00 80 0F 00 79 0F 00 03 10 B3' - '0F 00 71 0F 00 80 0F 00 81 0F 00 02 00 71 0F 00 80 0F 00 93 0F 00 02 00 92 0F 00 B7 0F 00 9D 0F' - '00 02 00 9C 0F 00 B7 0F 00 A2 0F 00 02 00 A1 0F 00 B7 0F 00 A7 0F 00 02 00 A6 0F 00 B7 0F 00 AC' - '0F 00 02 00 AB 0F 00 B7 0F 00 B9 0F 00 02 00 90 0F 00 B5 0F 00 26 10 00 02 00 25 10 00 2E 10 00' - 'FC 10 00 01 08 DC 10 00 06 1B 00 02 00 05 1B 00 35 1B 00 08 1B 00 02 00 07 1B 00 35 1B 00 0A 1B' - '00 02 00 09 1B 00 35 1B 00 0C 1B 00 02 00 0B 1B 00 35 1B 00 0E 1B 00 02 00 0D 1B 00 35 1B 00 12' - '1B 00 02 00 11 1B 00 35 1B 00 3B 1B 00 02 00 3A 1B 00 35 1B 00 3D 1B 00 02 00 3C 1B 00 35 1B 00' - '40 1B 00 02 00 3E 1B 00 35 1B 00 41 1B 00 02 00 3F 1B 00 35 1B 00 43 1B 00 02 00 42 1B 00 35 1B' - '00 2C 1D 00 01 08 41 00 00 2D 1D 00 01 08 C6 00 00 2E 1D 00 01 08 42 00 00 30 1D 00 01 08 44 00' - '00 31 1D 00 01 08 45 00 00 32 1D 00 01 08 8E 01 00 33 1D 00 01 08 47 00 00 34 1D 00 01 08 48 00' - '00 35 1D 00 01 08 49 00 00 36 1D 00 01 08 4A 00 00 37 1D 00 01 08 4B 00 00 38 1D 00 01 08 4C 00' - '00 39 1D 00 01 08 4D 00 00 3A 1D 00 01 08 4E 00 00 3C 1D 00 01 08 4F 00 00 3D 1D 00 01 08 22 02' - '00 3E 1D 00 01 08 50 00 00 3F 1D 00 01 08 52 00 00 40 1D 00 01 08 54 00 00 41 1D 00 01 08 55 00' - '00 42 1D 00 01 08 57 00 00 43 1D 00 01 08 61 00 00 44 1D 00 01 08 50 02 00 45 1D 00 01 08 51 02' - '00 46 1D 00 01 08 02 1D 00 47 1D 00 01 08 62 00 00 48 1D 00 01 08 64 00 00 49 1D 00 01 08 65 00' - '00 4A 1D 00 01 08 59 02 00 4B 1D 00 01 08 5B 02 00 4C 1D 00 01 08 5C 02 00 4D 1D 00 01 08 67 00' - '00 4F 1D 00 01 08 6B 00 00 50 1D 00 01 08 6D 00 00 51 1D 00 01 08 4B 01 00 52 1D 00 01 08 6F 00' - '00 53 1D 00 01 08 54 02 00 54 1D 00 01 08 16 1D 00 55 1D 00 01 08 17 1D 00 56 1D 00 01 08 70 00' - '00 57 1D 00 01 08 74 00 00 58 1D 00 01 08 75 00 00 59 1D 00 01 08 1D 1D 00 5A 1D 00 01 08 6F 02' - '00 5B 1D 00 01 08 76 00 00 5C 1D 00 01 08 25 1D 00 5D 1D 00 01 08 B2 03 00 5E 1D 00 01 08 B3 03' - '00 5F 1D 00 01 08 B4 03 00 60 1D 00 01 08 C6 03 00 61 1D 00 01 08 C7 03 00 62 1D 00 01 09 69 00' - '00 63 1D 00 01 09 72 00 00 64 1D 00 01 09 75 00 00 65 1D 00 01 09 76 00 00 66 1D 00 01 09 B2 03' - '00 67 1D 00 01 09 B3 03 00 68 1D 00 01 09 C1 03 00 69 1D 00 01 09 C6 03 00 6A 1D 00 01 09 C7 03' - '00 78 1D 00 01 08 3D 04 00 9B 1D 00 01 08 52 02 00 9C 1D 00 01 08 63 00 00 9D 1D 00 01 08 55 02' - '00 9E 1D 00 01 08 F0 00 00 9F 1D 00 01 08 5C 02 00 A0 1D 00 01 08 66 00 00 A1 1D 00 01 08 5F 02' - '00 A2 1D 00 01 08 61 02 00 A3 1D 00 01 08 65 02 00 A4 1D 00 01 08 68 02 00 A5 1D 00 01 08 69 02' - '00 A6 1D 00 01 08 6A 02 00 A7 1D 00 01 08 7B 1D 00 A8 1D 00 01 08 9D 02 00 A9 1D 00 01 08 6D 02' - '00 AA 1D 00 01 08 85 1D 00 AB 1D 00 01 08 9F 02 00 AC 1D 00 01 08 71 02 00 AD 1D 00 01 08 70 02' - '00 AE 1D 00 01 08 72 02 00 AF 1D 00 01 08 73 02 00 B0 1D 00 01 08 74 02 00 B1 1D 00 01 08 75 02' - '00 B2 1D 00 01 08 78 02 00 B3 1D 00 01 08 82 02 00 B4 1D 00 01 08 83 02 00 B5 1D 00 01 08 AB 01' - '00 B6 1D 00 01 08 89 02 00 B7 1D 00 01 08 8A 02 00 B8 1D 00 01 08 1C 1D 00 B9 1D 00 01 08 8B 02' - '00 BA 1D 00 01 08 8C 02 00 BB 1D 00 01 08 7A 00 00 BC 1D 00 01 08 90 02 00 BD 1D 00 01 08 91 02' - '00 BE 1D 00 01 08 92 02 00 BF 1D 00 01 08 B8 03 00 00 1E 00 02 00 41 00 00 25 03 00 01 1E 00 02' - '00 61 00 00 25 03 00 02 1E 00 02 00 42 00 00 07 03 00 03 1E 00 02 00 62 00 00 07 03 00 04 1E 00' - '02 00 42 00 00 23 03 00 05 1E 00 02 00 62 00 00 23 03 00 06 1E 00 02 00 42 00 00 31 03 00 07 1E' - '00 02 00 62 00 00 31 03 00 08 1E 00 03 00 43 00 00 27 03 00 01 03 00 09 1E 00 03 00 63 00 00 27' - '03 00 01 03 00 0A 1E 00 02 00 44 00 00 07 03 00 0B 1E 00 02 00 64 00 00 07 03 00 0C 1E 00 02 00' - '44 00 00 23 03 00 0D 1E 00 02 00 64 00 00 23 03 00 0E 1E 00 02 00 44 00 00 31 03 00 0F 1E 00 02' - '00 64 00 00 31 03 00 10 1E 00 02 00 44 00 00 27 03 00 11 1E 00 02 00 64 00 00 27 03 00 12 1E 00' - '02 00 44 00 00 2D 03 00 13 1E 00 02 00 64 00 00 2D 03 00 14 1E 00 03 00 45 00 00 04 03 00 00 03' - '00 15 1E 00 03 00 65 00 00 04 03 00 00 03 00 16 1E 00 03 00 45 00 00 04 03 00 01 03 00 17 1E 00' - '03 00 65 00 00 04 03 00 01 03 00 18 1E 00 02 00 45 00 00 2D 03 00 19 1E 00 02 00 65 00 00 2D 03' - '00 1A 1E 00 02 00 45 00 00 30 03 00 1B 1E 00 02 00 65 00 00 30 03 00 1C 1E 00 03 00 45 00 00 27' - '03 00 06 03 00 1D 1E 00 03 00 65 00 00 27 03 00 06 03 00 1E 1E 00 02 00 46 00 00 07 03 00 1F 1E' - '00 02 00 66 00 00 07 03 00 20 1E 00 02 00 47 00 00 04 03 00 21 1E 00 02 00 67 00 00 04 03 00 22' - '1E 00 02 00 48 00 00 07 03 00 23 1E 00 02 00 68 00 00 07 03 00 24 1E 00 02 00 48 00 00 23 03 00' - '25 1E 00 02 00 68 00 00 23 03 00 26 1E 00 02 00 48 00 00 08 03 00 27 1E 00 02 00 68 00 00 08 03' - '00 28 1E 00 02 00 48 00 00 27 03 00 29 1E 00 02 00 68 00 00 27 03 00 2A 1E 00 02 00 48 00 00 2E' - '03 00 2B 1E 00 02 00 68 00 00 2E 03 00 2C 1E 00 02 00 49 00 00 30 03 00 2D 1E 00 02 00 69 00 00' - '30 03 00 2E 1E 00 03 00 49 00 00 08 03 00 01 03 00 2F 1E 00 03 00 69 00 00 08 03 00 01 03 00 30' - '1E 00 02 00 4B 00 00 01 03 00 31 1E 00 02 00 6B 00 00 01 03 00 32 1E 00 02 00 4B 00 00 23 03 00' - '33 1E 00 02 00 6B 00 00 23 03 00 34 1E 00 02 00 4B 00 00 31 03 00 35 1E 00 02 00 6B 00 00 31 03' - '00 36 1E 00 02 00 4C 00 00 23 03 00 37 1E 00 02 00 6C 00 00 23 03 00 38 1E 00 03 00 4C 00 00 23' - '03 00 04 03 00 39 1E 00 03 00 6C 00 00 23 03 00 04 03 00 3A 1E 00 02 00 4C 00 00 31 03 00 3B 1E' - '00 02 00 6C 00 00 31 03 00 3C 1E 00 02 00 4C 00 00 2D 03 00 3D 1E 00 02 00 6C 00 00 2D 03 00 3E' - '1E 00 02 00 4D 00 00 01 03 00 3F 1E 00 02 00 6D 00 00 01 03 00 40 1E 00 02 00 4D 00 00 07 03 00' - '41 1E 00 02 00 6D 00 00 07 03 00 42 1E 00 02 00 4D 00 00 23 03 00 43 1E 00 02 00 6D 00 00 23 03' - '00 44 1E 00 02 00 4E 00 00 07 03 00 45 1E 00 02 00 6E 00 00 07 03 00 46 1E 00 02 00 4E 00 00 23' - '03 00 47 1E 00 02 00 6E 00 00 23 03 00 48 1E 00 02 00 4E 00 00 31 03 00 49 1E 00 02 00 6E 00 00' - '31 03 00 4A 1E 00 02 00 4E 00 00 2D 03 00 4B 1E 00 02 00 6E 00 00 2D 03 00 4C 1E 00 03 00 4F 00' - '00 03 03 00 01 03 00 4D 1E 00 03 00 6F 00 00 03 03 00 01 03 00 4E 1E 00 03 00 4F 00 00 03 03 00' - '08 03 00 4F 1E 00 03 00 6F 00 00 03 03 00 08 03 00 50 1E 00 03 00 4F 00 00 04 03 00 00 03 00 51' - '1E 00 03 00 6F 00 00 04 03 00 00 03 00 52 1E 00 03 00 4F 00 00 04 03 00 01 03 00 53 1E 00 03 00' - '6F 00 00 04 03 00 01 03 00 54 1E 00 02 00 50 00 00 01 03 00 55 1E 00 02 00 70 00 00 01 03 00 56' - '1E 00 02 00 50 00 00 07 03 00 57 1E 00 02 00 70 00 00 07 03 00 58 1E 00 02 00 52 00 00 07 03 00' - '59 1E 00 02 00 72 00 00 07 03 00 5A 1E 00 02 00 52 00 00 23 03 00 5B 1E 00 02 00 72 00 00 23 03' - '00 5C 1E 00 03 00 52 00 00 23 03 00 04 03 00 5D 1E 00 03 00 72 00 00 23 03 00 04 03 00 5E 1E 00' - '02 00 52 00 00 31 03 00 5F 1E 00 02 00 72 00 00 31 03 00 60 1E 00 02 00 53 00 00 07 03 00 61 1E' - '00 02 00 73 00 00 07 03 00 62 1E 00 02 00 53 00 00 23 03 00 63 1E 00 02 00 73 00 00 23 03 00 64' - '1E 00 03 00 53 00 00 01 03 00 07 03 00 65 1E 00 03 00 73 00 00 01 03 00 07 03 00 66 1E 00 03 00' - '53 00 00 0C 03 00 07 03 00 67 1E 00 03 00 73 00 00 0C 03 00 07 03 00 68 1E 00 03 00 53 00 00 23' - '03 00 07 03 00 69 1E 00 03 00 73 00 00 23 03 00 07 03 00 6A 1E 00 02 00 54 00 00 07 03 00 6B 1E' - '00 02 00 74 00 00 07 03 00 6C 1E 00 02 00 54 00 00 23 03 00 6D 1E 00 02 00 74 00 00 23 03 00 6E' - '1E 00 02 00 54 00 00 31 03 00 6F 1E 00 02 00 74 00 00 31 03 00 70 1E 00 02 00 54 00 00 2D 03 00' - '71 1E 00 02 00 74 00 00 2D 03 00 72 1E 00 02 00 55 00 00 24 03 00 73 1E 00 02 00 75 00 00 24 03' - '00 74 1E 00 02 00 55 00 00 30 03 00 75 1E 00 02 00 75 00 00 30 03 00 76 1E 00 02 00 55 00 00 2D' - '03 00 77 1E 00 02 00 75 00 00 2D 03 00 78 1E 00 03 00 55 00 00 03 03 00 01 03 00 79 1E 00 03 00' - '75 00 00 03 03 00 01 03 00 7A 1E 00 03 00 55 00 00 04 03 00 08 03 00 7B 1E 00 03 00 75 00 00 04' - '03 00 08 03 00 7C 1E 00 02 00 56 00 00 03 03 00 7D 1E 00 02 00 76 00 00 03 03 00 7E 1E 00 02 00' - '56 00 00 23 03 00 7F 1E 00 02 00 76 00 00 23 03 00 80 1E 00 02 00 57 00 00 00 03 00 81 1E 00 02' - '00 77 00 00 00 03 00 82 1E 00 02 00 57 00 00 01 03 00 83 1E 00 02 00 77 00 00 01 03 00 84 1E 00' - '02 00 57 00 00 08 03 00 85 1E 00 02 00 77 00 00 08 03 00 86 1E 00 02 00 57 00 00 07 03 00 87 1E' - '00 02 00 77 00 00 07 03 00 88 1E 00 02 00 57 00 00 23 03 00 89 1E 00 02 00 77 00 00 23 03 00 8A' - '1E 00 02 00 58 00 00 07 03 00 8B 1E 00 02 00 78 00 00 07 03 00 8C 1E 00 02 00 58 00 00 08 03 00' - '8D 1E 00 02 00 78 00 00 08 03 00 8E 1E 00 02 00 59 00 00 07 03 00 8F 1E 00 02 00 79 00 00 07 03' - '00 90 1E 00 02 00 5A 00 00 02 03 00 91 1E 00 02 00 7A 00 00 02 03 00 92 1E 00 02 00 5A 00 00 23' - '03 00 93 1E 00 02 00 7A 00 00 23 03 00 94 1E 00 02 00 5A 00 00 31 03 00 95 1E 00 02 00 7A 00 00' - '31 03 00 96 1E 00 02 00 68 00 00 31 03 00 97 1E 00 02 00 74 00 00 08 03 00 98 1E 00 02 00 77 00' - '00 0A 03 00 99 1E 00 02 00 79 00 00 0A 03 00 9A 1E 00 02 10 61 00 00 BE 02 00 9B 1E 00 02 00 73' - '00 00 07 03 00 A0 1E 00 02 00 41 00 00 23 03 00 A1 1E 00 02 00 61 00 00 23 03 00 A2 1E 00 02 00' - '41 00 00 09 03 00 A3 1E 00 02 00 61 00 00 09 03 00 A4 1E 00 03 00 41 00 00 02 03 00 01 03 00 A5' - '1E 00 03 00 61 00 00 02 03 00 01 03 00 A6 1E 00 03 00 41 00 00 02 03 00 00 03 00 A7 1E 00 03 00' - '61 00 00 02 03 00 00 03 00 A8 1E 00 03 00 41 00 00 02 03 00 09 03 00 A9 1E 00 03 00 61 00 00 02' - '03 00 09 03 00 AA 1E 00 03 00 41 00 00 02 03 00 03 03 00 AB 1E 00 03 00 61 00 00 02 03 00 03 03' - '00 AC 1E 00 03 00 41 00 00 23 03 00 02 03 00 AD 1E 00 03 00 61 00 00 23 03 00 02 03 00 AE 1E 00' - '03 00 41 00 00 06 03 00 01 03 00 AF 1E 00 03 00 61 00 00 06 03 00 01 03 00 B0 1E 00 03 00 41 00' - '00 06 03 00 00 03 00 B1 1E 00 03 00 61 00 00 06 03 00 00 03 00 B2 1E 00 03 00 41 00 00 06 03 00' - '09 03 00 B3 1E 00 03 00 61 00 00 06 03 00 09 03 00 B4 1E 00 03 00 41 00 00 06 03 00 03 03 00 B5' - '1E 00 03 00 61 00 00 06 03 00 03 03 00 B6 1E 00 03 00 41 00 00 23 03 00 06 03 00 B7 1E 00 03 00' - '61 00 00 23 03 00 06 03 00 B8 1E 00 02 00 45 00 00 23 03 00 B9 1E 00 02 00 65 00 00 23 03 00 BA' - '1E 00 02 00 45 00 00 09 03 00 BB 1E 00 02 00 65 00 00 09 03 00 BC 1E 00 02 00 45 00 00 03 03 00' - 'BD 1E 00 02 00 65 00 00 03 03 00 BE 1E 00 03 00 45 00 00 02 03 00 01 03 00 BF 1E 00 03 00 65 00' - '00 02 03 00 01 03 00 C0 1E 00 03 00 45 00 00 02 03 00 00 03 00 C1 1E 00 03 00 65 00 00 02 03 00' - '00 03 00 C2 1E 00 03 00 45 00 00 02 03 00 09 03 00 C3 1E 00 03 00 65 00 00 02 03 00 09 03 00 C4' - '1E 00 03 00 45 00 00 02 03 00 03 03 00 C5 1E 00 03 00 65 00 00 02 03 00 03 03 00 C6 1E 00 03 00' - '45 00 00 23 03 00 02 03 00 C7 1E 00 03 00 65 00 00 23 03 00 02 03 00 C8 1E 00 02 00 49 00 00 09' - '03 00 C9 1E 00 02 00 69 00 00 09 03 00 CA 1E 00 02 00 49 00 00 23 03 00 CB 1E 00 02 00 69 00 00' - '23 03 00 CC 1E 00 02 00 4F 00 00 23 03 00 CD 1E 00 02 00 6F 00 00 23 03 00 CE 1E 00 02 00 4F 00' - '00 09 03 00 CF 1E 00 02 00 6F 00 00 09 03 00 D0 1E 00 03 00 4F 00 00 02 03 00 01 03 00 D1 1E 00' - '03 00 6F 00 00 02 03 00 01 03 00 D2 1E 00 03 00 4F 00 00 02 03 00 00 03 00 D3 1E 00 03 00 6F 00' - '00 02 03 00 00 03 00 D4 1E 00 03 00 4F 00 00 02 03 00 09 03 00 D5 1E 00 03 00 6F 00 00 02 03 00' - '09 03 00 D6 1E 00 03 00 4F 00 00 02 03 00 03 03 00 D7 1E 00 03 00 6F 00 00 02 03 00 03 03 00 D8' - '1E 00 03 00 4F 00 00 23 03 00 02 03 00 D9 1E 00 03 00 6F 00 00 23 03 00 02 03 00 DA 1E 00 03 00' - '4F 00 00 1B 03 00 01 03 00 DB 1E 00 03 00 6F 00 00 1B 03 00 01 03 00 DC 1E 00 03 00 4F 00 00 1B' - '03 00 00 03 00 DD 1E 00 03 00 6F 00 00 1B 03 00 00 03 00 DE 1E 00 03 00 4F 00 00 1B 03 00 09 03' - '00 DF 1E 00 03 00 6F 00 00 1B 03 00 09 03 00 E0 1E 00 03 00 4F 00 00 1B 03 00 03 03 00 E1 1E 00' - '03 00 6F 00 00 1B 03 00 03 03 00 E2 1E 00 03 00 4F 00 00 1B 03 00 23 03 00 E3 1E 00 03 00 6F 00' - '00 1B 03 00 23 03 00 E4 1E 00 02 00 55 00 00 23 03 00 E5 1E 00 02 00 75 00 00 23 03 00 E6 1E 00' - '02 00 55 00 00 09 03 00 E7 1E 00 02 00 75 00 00 09 03 00 E8 1E 00 03 00 55 00 00 1B 03 00 01 03' - '00 E9 1E 00 03 00 75 00 00 1B 03 00 01 03 00 EA 1E 00 03 00 55 00 00 1B 03 00 00 03 00 EB 1E 00' - '03 00 75 00 00 1B 03 00 00 03 00 EC 1E 00 03 00 55 00 00 1B 03 00 09 03 00 ED 1E 00 03 00 75 00' - '00 1B 03 00 09 03 00 EE 1E 00 03 00 55 00 00 1B 03 00 03 03 00 EF 1E 00 03 00 75 00 00 1B 03 00' - '03 03 00 F0 1E 00 03 00 55 00 00 1B 03 00 23 03 00 F1 1E 00 03 00 75 00 00 1B 03 00 23 03 00 F2' - '1E 00 02 00 59 00 00 00 03 00 F3 1E 00 02 00 79 00 00 00 03 00 F4 1E 00 02 00 59 00 00 23 03 00' - 'F5 1E 00 02 00 79 00 00 23 03 00 F6 1E 00 02 00 59 00 00 09 03 00 F7 1E 00 02 00 79 00 00 09 03' - '00 F8 1E 00 02 00 59 00 00 03 03 00 F9 1E 00 02 00 79 00 00 03 03 00 00 1F 00 02 00 B1 03 00 13' - '03 00 01 1F 00 02 00 B1 03 00 14 03 00 02 1F 00 03 00 B1 03 00 13 03 00 00 03 00 03 1F 00 03 00' - 'B1 03 00 14 03 00 00 03 00 04 1F 00 03 00 B1 03 00 13 03 00 01 03 00 05 1F 00 03 00 B1 03 00 14' - '03 00 01 03 00 06 1F 00 03 00 B1 03 00 13 03 00 42 03 00 07 1F 00 03 00 B1 03 00 14 03 00 42 03' - '00 08 1F 00 02 00 91 03 00 13 03 00 09 1F 00 02 00 91 03 00 14 03 00 0A 1F 00 03 00 91 03 00 13' - '03 00 00 03 00 0B 1F 00 03 00 91 03 00 14 03 00 00 03 00 0C 1F 00 03 00 91 03 00 13 03 00 01 03' - '00 0D 1F 00 03 00 91 03 00 14 03 00 01 03 00 0E 1F 00 03 00 91 03 00 13 03 00 42 03 00 0F 1F 00' - '03 00 91 03 00 14 03 00 42 03 00 10 1F 00 02 00 B5 03 00 13 03 00 11 1F 00 02 00 B5 03 00 14 03' - '00 12 1F 00 03 00 B5 03 00 13 03 00 00 03 00 13 1F 00 03 00 B5 03 00 14 03 00 00 03 00 14 1F 00' - '03 00 B5 03 00 13 03 00 01 03 00 15 1F 00 03 00 B5 03 00 14 03 00 01 03 00 18 1F 00 02 00 95 03' - '00 13 03 00 19 1F 00 02 00 95 03 00 14 03 00 1A 1F 00 03 00 95 03 00 13 03 00 00 03 00 1B 1F 00' - '03 00 95 03 00 14 03 00 00 03 00 1C 1F 00 03 00 95 03 00 13 03 00 01 03 00 1D 1F 00 03 00 95 03' - '00 14 03 00 01 03 00 20 1F 00 02 00 B7 03 00 13 03 00 21 1F 00 02 00 B7 03 00 14 03 00 22 1F 00' - '03 00 B7 03 00 13 03 00 00 03 00 23 1F 00 03 00 B7 03 00 14 03 00 00 03 00 24 1F 00 03 00 B7 03' - '00 13 03 00 01 03 00 25 1F 00 03 00 B7 03 00 14 03 00 01 03 00 26 1F 00 03 00 B7 03 00 13 03 00' - '42 03 00 27 1F 00 03 00 B7 03 00 14 03 00 42 03 00 28 1F 00 02 00 97 03 00 13 03 00 29 1F 00 02' - '00 97 03 00 14 03 00 2A 1F 00 03 00 97 03 00 13 03 00 00 03 00 2B 1F 00 03 00 97 03 00 14 03 00' - '00 03 00 2C 1F 00 03 00 97 03 00 13 03 00 01 03 00 2D 1F 00 03 00 97 03 00 14 03 00 01 03 00 2E' - '1F 00 03 00 97 03 00 13 03 00 42 03 00 2F 1F 00 03 00 97 03 00 14 03 00 42 03 00 30 1F 00 02 00' - 'B9 03 00 13 03 00 31 1F 00 02 00 B9 03 00 14 03 00 32 1F 00 03 00 B9 03 00 13 03 00 00 03 00 33' - '1F 00 03 00 B9 03 00 14 03 00 00 03 00 34 1F 00 03 00 B9 03 00 13 03 00 01 03 00 35 1F 00 03 00' - 'B9 03 00 14 03 00 01 03 00 36 1F 00 03 00 B9 03 00 13 03 00 42 03 00 37 1F 00 03 00 B9 03 00 14' - '03 00 42 03 00 38 1F 00 02 00 99 03 00 13 03 00 39 1F 00 02 00 99 03 00 14 03 00 3A 1F 00 03 00' - '99 03 00 13 03 00 00 03 00 3B 1F 00 03 00 99 03 00 14 03 00 00 03 00 3C 1F 00 03 00 99 03 00 13' - '03 00 01 03 00 3D 1F 00 03 00 99 03 00 14 03 00 01 03 00 3E 1F 00 03 00 99 03 00 13 03 00 42 03' - '00 3F 1F 00 03 00 99 03 00 14 03 00 42 03 00 40 1F 00 02 00 BF 03 00 13 03 00 41 1F 00 02 00 BF' - '03 00 14 03 00 42 1F 00 03 00 BF 03 00 13 03 00 00 03 00 43 1F 00 03 00 BF 03 00 14 03 00 00 03' - '00 44 1F 00 03 00 BF 03 00 13 03 00 01 03 00 45 1F 00 03 00 BF 03 00 14 03 00 01 03 00 48 1F 00' - '02 00 9F 03 00 13 03 00 49 1F 00 02 00 9F 03 00 14 03 00 4A 1F 00 03 00 9F 03 00 13 03 00 00 03' - '00 4B 1F 00 03 00 9F 03 00 14 03 00 00 03 00 4C 1F 00 03 00 9F 03 00 13 03 00 01 03 00 4D 1F 00' - '03 00 9F 03 00 14 03 00 01 03 00 50 1F 00 02 00 C5 03 00 13 03 00 51 1F 00 02 00 C5 03 00 14 03' - '00 52 1F 00 03 00 C5 03 00 13 03 00 00 03 00 53 1F 00 03 00 C5 03 00 14 03 00 00 03 00 54 1F 00' - '03 00 C5 03 00 13 03 00 01 03 00 55 1F 00 03 00 C5 03 00 14 03 00 01 03 00 56 1F 00 03 00 C5 03' - '00 13 03 00 42 03 00 57 1F 00 03 00 C5 03 00 14 03 00 42 03 00 59 1F 00 02 00 A5 03 00 14 03 00' - '5B 1F 00 03 00 A5 03 00 14 03 00 00 03 00 5D 1F 00 03 00 A5 03 00 14 03 00 01 03 00 5F 1F 00 03' - '00 A5 03 00 14 03 00 42 03 00 60 1F 00 02 00 C9 03 00 13 03 00 61 1F 00 02 00 C9 03 00 14 03 00' - '62 1F 00 03 00 C9 03 00 13 03 00 00 03 00 63 1F 00 03 00 C9 03 00 14 03 00 00 03 00 64 1F 00 03' - '00 C9 03 00 13 03 00 01 03 00 65 1F 00 03 00 C9 03 00 14 03 00 01 03 00 66 1F 00 03 00 C9 03 00' - '13 03 00 42 03 00 67 1F 00 03 00 C9 03 00 14 03 00 42 03 00 68 1F 00 02 00 A9 03 00 13 03 00 69' - '1F 00 02 00 A9 03 00 14 03 00 6A 1F 00 03 00 A9 03 00 13 03 00 00 03 00 6B 1F 00 03 00 A9 03 00' - '14 03 00 00 03 00 6C 1F 00 03 00 A9 03 00 13 03 00 01 03 00 6D 1F 00 03 00 A9 03 00 14 03 00 01' - '03 00 6E 1F 00 03 00 A9 03 00 13 03 00 42 03 00 6F 1F 00 03 00 A9 03 00 14 03 00 42 03 00 70 1F' - '00 02 00 B1 03 00 00 03 00 71 1F 00 02 00 B1 03 00 01 03 00 72 1F 00 02 00 B5 03 00 00 03 00 73' - '1F 00 02 00 B5 03 00 01 03 00 74 1F 00 02 00 B7 03 00 00 03 00 75 1F 00 02 00 B7 03 00 01 03 00' - '76 1F 00 02 00 B9 03 00 00 03 00 77 1F 00 02 00 B9 03 00 01 03 00 78 1F 00 02 00 BF 03 00 00 03' - '00 79 1F 00 02 00 BF 03 00 01 03 00 7A 1F 00 02 00 C5 03 00 00 03 00 7B 1F 00 02 00 C5 03 00 01' - '03 00 7C 1F 00 02 00 C9 03 00 00 03 00 7D 1F 00 02 00 C9 03 00 01 03 00 80 1F 00 03 00 B1 03 00' - '13 03 00 45 03 00 81 1F 00 03 00 B1 03 00 14 03 00 45 03 00 82 1F 00 04 00 B1 03 00 13 03 00 00' - '03 00 45 03 00 83 1F 00 04 00 B1 03 00 14 03 00 00 03 00 45 03 00 84 1F 00 04 00 B1 03 00 13 03' - '00 01 03 00 45 03 00 85 1F 00 04 00 B1 03 00 14 03 00 01 03 00 45 03 00 86 1F 00 04 00 B1 03 00' - '13 03 00 42 03 00 45 03 00 87 1F 00 04 00 B1 03 00 14 03 00 42 03 00 45 03 00 88 1F 00 03 00 91' - '03 00 13 03 00 45 03 00 89 1F 00 03 00 91 03 00 14 03 00 45 03 00 8A 1F 00 04 00 91 03 00 13 03' - '00 00 03 00 45 03 00 8B 1F 00 04 00 91 03 00 14 03 00 00 03 00 45 03 00 8C 1F 00 04 00 91 03 00' - '13 03 00 01 03 00 45 03 00 8D 1F 00 04 00 91 03 00 14 03 00 01 03 00 45 03 00 8E 1F 00 04 00 91' - '03 00 13 03 00 42 03 00 45 03 00 8F 1F 00 04 00 91 03 00 14 03 00 42 03 00 45 03 00 90 1F 00 03' - '00 B7 03 00 13 03 00 45 03 00 91 1F 00 03 00 B7 03 00 14 03 00 45 03 00 92 1F 00 04 00 B7 03 00' - '13 03 00 00 03 00 45 03 00 93 1F 00 04 00 B7 03 00 14 03 00 00 03 00 45 03 00 94 1F 00 04 00 B7' - '03 00 13 03 00 01 03 00 45 03 00 95 1F 00 04 00 B7 03 00 14 03 00 01 03 00 45 03 00 96 1F 00 04' - '00 B7 03 00 13 03 00 42 03 00 45 03 00 97 1F 00 04 00 B7 03 00 14 03 00 42 03 00 45 03 00 98 1F' - '00 03 00 97 03 00 13 03 00 45 03 00 99 1F 00 03 00 97 03 00 14 03 00 45 03 00 9A 1F 00 04 00 97' - '03 00 13 03 00 00 03 00 45 03 00 9B 1F 00 04 00 97 03 00 14 03 00 00 03 00 45 03 00 9C 1F 00 04' - '00 97 03 00 13 03 00 01 03 00 45 03 00 9D 1F 00 04 00 97 03 00 14 03 00 01 03 00 45 03 00 9E 1F' - '00 04 00 97 03 00 13 03 00 42 03 00 45 03 00 9F 1F 00 04 00 97 03 00 14 03 00 42 03 00 45 03 00' - 'A0 1F 00 03 00 C9 03 00 13 03 00 45 03 00 A1 1F 00 03 00 C9 03 00 14 03 00 45 03 00 A2 1F 00 04' - '00 C9 03 00 13 03 00 00 03 00 45 03 00 A3 1F 00 04 00 C9 03 00 14 03 00 00 03 00 45 03 00 A4 1F' - '00 04 00 C9 03 00 13 03 00 01 03 00 45 03 00 A5 1F 00 04 00 C9 03 00 14 03 00 01 03 00 45 03 00' - 'A6 1F 00 04 00 C9 03 00 13 03 00 42 03 00 45 03 00 A7 1F 00 04 00 C9 03 00 14 03 00 42 03 00 45' - '03 00 A8 1F 00 03 00 A9 03 00 13 03 00 45 03 00 A9 1F 00 03 00 A9 03 00 14 03 00 45 03 00 AA 1F' - '00 04 00 A9 03 00 13 03 00 00 03 00 45 03 00 AB 1F 00 04 00 A9 03 00 14 03 00 00 03 00 45 03 00' - 'AC 1F 00 04 00 A9 03 00 13 03 00 01 03 00 45 03 00 AD 1F 00 04 00 A9 03 00 14 03 00 01 03 00 45' - '03 00 AE 1F 00 04 00 A9 03 00 13 03 00 42 03 00 45 03 00 AF 1F 00 04 00 A9 03 00 14 03 00 42 03' - '00 45 03 00 B0 1F 00 02 00 B1 03 00 06 03 00 B1 1F 00 02 00 B1 03 00 04 03 00 B2 1F 00 03 00 B1' - '03 00 00 03 00 45 03 00 B3 1F 00 02 00 B1 03 00 45 03 00 B4 1F 00 03 00 B1 03 00 01 03 00 45 03' - '00 B6 1F 00 02 00 B1 03 00 42 03 00 B7 1F 00 03 00 B1 03 00 42 03 00 45 03 00 B8 1F 00 02 00 91' - '03 00 06 03 00 B9 1F 00 02 00 91 03 00 04 03 00 BA 1F 00 02 00 91 03 00 00 03 00 BB 1F 00 02 00' - '91 03 00 01 03 00 BC 1F 00 02 00 91 03 00 45 03 00 BD 1F 00 02 10 20 00 00 13 03 00 BE 1F 00 01' - '00 B9 03 00 BF 1F 00 02 10 20 00 00 13 03 00 C0 1F 00 02 10 20 00 00 42 03 00 C1 1F 00 03 00 20' - '00 00 08 03 00 42 03 00 C2 1F 00 03 00 B7 03 00 00 03 00 45 03 00 C3 1F 00 02 00 B7 03 00 45 03' - '00 C4 1F 00 03 00 B7 03 00 01 03 00 45 03 00 C6 1F 00 02 00 B7 03 00 42 03 00 C7 1F 00 03 00 B7' - '03 00 42 03 00 45 03 00 C8 1F 00 02 00 95 03 00 00 03 00 C9 1F 00 02 00 95 03 00 01 03 00 CA 1F' - '00 02 00 97 03 00 00 03 00 CB 1F 00 02 00 97 03 00 01 03 00 CC 1F 00 02 00 97 03 00 45 03 00 CD' - '1F 00 03 00 20 00 00 13 03 00 00 03 00 CE 1F 00 03 00 20 00 00 13 03 00 01 03 00 CF 1F 00 03 00' - '20 00 00 13 03 00 42 03 00 D0 1F 00 02 00 B9 03 00 06 03 00 D1 1F 00 02 00 B9 03 00 04 03 00 D2' - '1F 00 03 00 B9 03 00 08 03 00 00 03 00 D3 1F 00 03 00 B9 03 00 08 03 00 01 03 00 D6 1F 00 02 00' - 'B9 03 00 42 03 00 D7 1F 00 03 00 B9 03 00 08 03 00 42 03 00 D8 1F 00 02 00 99 03 00 06 03 00 D9' - '1F 00 02 00 99 03 00 04 03 00 DA 1F 00 02 00 99 03 00 00 03 00 DB 1F 00 02 00 99 03 00 01 03 00' - 'DD 1F 00 03 00 20 00 00 14 03 00 00 03 00 DE 1F 00 03 00 20 00 00 14 03 00 01 03 00 DF 1F 00 03' - '00 20 00 00 14 03 00 42 03 00 E0 1F 00 02 00 C5 03 00 06 03 00 E1 1F 00 02 00 C5 03 00 04 03 00' - 'E2 1F 00 03 00 C5 03 00 08 03 00 00 03 00 E3 1F 00 03 00 C5 03 00 08 03 00 01 03 00 E4 1F 00 02' - '00 C1 03 00 13 03 00 E5 1F 00 02 00 C1 03 00 14 03 00 E6 1F 00 02 00 C5 03 00 42 03 00 E7 1F 00' - '03 00 C5 03 00 08 03 00 42 03 00 E8 1F 00 02 00 A5 03 00 06 03 00 E9 1F 00 02 00 A5 03 00 04 03' - '00 EA 1F 00 02 00 A5 03 00 00 03 00 EB 1F 00 02 00 A5 03 00 01 03 00 EC 1F 00 02 00 A1 03 00 14' - '03 00 ED 1F 00 03 00 20 00 00 08 03 00 00 03 00 EE 1F 00 03 00 20 00 00 08 03 00 01 03 00 EF 1F' - '00 01 00 60 00 00 F2 1F 00 03 00 C9 03 00 00 03 00 45 03 00 F3 1F 00 02 00 C9 03 00 45 03 00 F4' - '1F 00 03 00 C9 03 00 01 03 00 45 03 00 F6 1F 00 02 00 C9 03 00 42 03 00 F7 1F 00 03 00 C9 03 00' - '42 03 00 45 03 00 F8 1F 00 02 00 9F 03 00 00 03 00 F9 1F 00 02 00 9F 03 00 01 03 00 FA 1F 00 02' - '00 A9 03 00 00 03 00 FB 1F 00 02 00 A9 03 00 01 03 00 FC 1F 00 02 00 A9 03 00 45 03 00 FD 1F 00' - '02 00 20 00 00 01 03 00 FE 1F 00 02 10 20 00 00 14 03 00 00 20 00 01 00 20 00 00 01 20 00 01 00' - '20 00 00 02 20 00 01 10 20 00 00 03 20 00 01 10 20 00 00 04 20 00 01 10 20 00 00 05 20 00 01 10' - '20 00 00 06 20 00 01 10 20 00 00 07 20 00 01 02 20 00 00 08 20 00 01 10 20 00 00 09 20 00 01 10' - '20 00 00 0A 20 00 01 10 20 00 00 11 20 00 01 02 10 20 00 17 20 00 02 10 20 00 00 33 03 00 24 20' - '00 01 10 2E 00 00 25 20 00 02 10 2E 00 00 2E 00 00 26 20 00 03 10 2E 00 00 2E 00 00 2E 00 00 2F' - '20 00 01 02 20 00 00 33 20 00 02 10 32 20 00 32 20 00 34 20 00 03 10 32 20 00 32 20 00 32 20 00' - '36 20 00 02 10 35 20 00 35 20 00 37 20 00 03 10 35 20 00 35 20 00 35 20 00 3C 20 00 02 10 21 00' - '00 21 00 00 3E 20 00 02 10 20 00 00 05 03 00 47 20 00 02 10 3F 00 00 3F 00 00 48 20 00 02 10 3F' - '00 00 21 00 00 49 20 00 02 10 21 00 00 3F 00 00 57 20 00 04 10 32 20 00 32 20 00 32 20 00 32 20' - '00 5F 20 00 01 10 20 00 00 70 20 00 01 08 30 00 00 71 20 00 01 08 69 00 00 74 20 00 01 08 34 00' - '00 75 20 00 01 08 35 00 00 76 20 00 01 08 36 00 00 77 20 00 01 08 37 00 00 78 20 00 01 08 38 00' - '00 79 20 00 01 08 39 00 00 7A 20 00 01 08 2B 00 00 7B 20 00 01 08 12 22 00 7C 20 00 01 08 3D 00' - '00 7D 20 00 01 08 28 00 00 7E 20 00 01 08 29 00 00 7F 20 00 01 08 6E 00 00 80 20 00 01 09 30 00' - '00 81 20 00 01 09 31 00 00 82 20 00 01 09 32 00 00 83 20 00 01 09 33 00 00 84 20 00 01 09 34 00' - '00 85 20 00 01 09 35 00 00 86 20 00 01 09 36 00 00 87 20 00 01 09 37 00 00 88 20 00 01 09 38 00' - '00 89 20 00 01 09 39 00 00 8A 20 00 01 09 2B 00 00 8B 20 00 01 09 12 22 00 8C 20 00 01 09 3D 00' - '00 8D 20 00 01 09 28 00 00 8E 20 00 01 09 29 00 00 90 20 00 01 09 61 00 00 91 20 00 01 09 65 00' - '00 92 20 00 01 09 6F 00 00 93 20 00 01 09 78 00 00 94 20 00 01 09 59 02 00 95 20 00 01 09 68 00' - '00 96 20 00 01 09 6B 00 00 97 20 00 01 09 6C 00 00 98 20 00 01 09 6D 00 00 99 20 00 01 09 6E 00' - '00 9A 20 00 01 09 70 00 00 9B 20 00 01 09 73 00 00 9C 20 00 01 09 74 00 00 A8 20 00 02 10 52 00' - '00 73 00 00 00 21 00 03 10 61 00 00 2F 00 00 63 00 00 01 21 00 03 10 61 00 00 2F 00 00 73 00 00' - '02 21 00 01 01 43 00 00 03 21 00 02 10 B0 00 00 43 00 00 05 21 00 03 10 63 00 00 2F 00 00 6F 00' - '00 06 21 00 03 10 63 00 00 2F 00 00 75 00 00 07 21 00 01 10 90 01 00 09 21 00 02 10 B0 00 00 46' - '00 00 0A 21 00 01 01 67 00 00 0B 21 00 01 01 48 00 00 0C 21 00 01 01 48 00 00 0D 21 00 01 01 48' - '00 00 0E 21 00 01 01 68 00 00 0F 21 00 01 01 27 01 00 10 21 00 01 01 49 00 00 11 21 00 01 01 49' - '00 00 12 21 00 01 01 4C 00 00 13 21 00 01 01 6C 00 00 15 21 00 01 01 4E 00 00 16 21 00 02 10 4E' - '00 00 6F 00 00 19 21 00 01 01 50 00 00 1A 21 00 01 01 51 00 00 1B 21 00 01 01 52 00 00 1C 21 00' - '01 01 52 00 00 1D 21 00 01 01 52 00 00 20 21 00 02 08 53 00 00 4D 00 00 21 21 00 03 10 54 00 00' - '45 00 00 4C 00 00 22 21 00 02 08 54 00 00 4D 00 00 24 21 00 01 01 5A 00 00 26 21 00 01 00 A9 03' - '00 28 21 00 01 01 5A 00 00 2A 21 00 01 00 4B 00 00 2B 21 00 02 00 41 00 00 0A 03 00 2C 21 00 01' - '01 42 00 00 2D 21 00 01 01 43 00 00 2F 21 00 01 01 65 00 00 30 21 00 01 01 45 00 00 31 21 00 01' - '01 46 00 00 33 21 00 01 01 4D 00 00 34 21 00 01 01 6F 00 00 35 21 00 01 10 D0 05 00 36 21 00 01' - '10 D1 05 00 37 21 00 01 10 D2 05 00 38 21 00 01 10 D3 05 00 39 21 00 01 01 69 00 00 3B 21 00 03' - '10 46 00 00 41 00 00 58 00 00 3C 21 00 01 01 C0 03 00 3D 21 00 01 01 B3 03 00 3E 21 00 01 01 93' - '03 00 3F 21 00 01 01 A0 03 00 40 21 00 01 01 11 22 00 45 21 00 01 01 44 00 00 46 21 00 01 01 64' - '00 00 47 21 00 01 01 65 00 00 48 21 00 01 01 69 00 00 49 21 00 01 01 6A 00 00 50 21 00 03 0F 31' - '00 00 44 20 00 37 00 00 51 21 00 03 0F 31 00 00 44 20 00 39 00 00 52 21 00 04 0F 31 00 00 44 20' - '00 31 00 00 30 00 00 53 21 00 03 0F 31 00 00 44 20 00 33 00 00 54 21 00 03 0F 32 00 00 44 20 00' - '33 00 00 55 21 00 03 0F 31 00 00 44 20 00 35 00 00 56 21 00 03 0F 32 00 00 44 20 00 35 00 00 57' - '21 00 03 0F 33 00 00 44 20 00 35 00 00 58 21 00 03 0F 34 00 00 44 20 00 35 00 00 59 21 00 03 0F' - '31 00 00 44 20 00 36 00 00 5A 21 00 03 0F 35 00 00 44 20 00 36 00 00 5B 21 00 03 0F 31 00 00 44' - '20 00 38 00 00 5C 21 00 03 0F 33 00 00 44 20 00 38 00 00 5D 21 00 03 0F 35 00 00 44 20 00 38 00' - '00 5E 21 00 03 0F 37 00 00 44 20 00 38 00 00 5F 21 00 02 0F 31 00 00 44 20 00 60 21 00 01 10 49' - '00 00 61 21 00 02 10 49 00 00 49 00 00 62 21 00 03 10 49 00 00 49 00 00 49 00 00 63 21 00 02 10' - '49 00 00 56 00 00 64 21 00 01 10 56 00 00 65 21 00 02 10 56 00 00 49 00 00 66 21 00 03 10 56 00' - '00 49 00 00 49 00 00 67 21 00 04 10 56 00 00 49 00 00 49 00 00 49 00 00 68 21 00 02 10 49 00 00' - '58 00 00 69 21 00 01 10 58 00 00 6A 21 00 02 10 58 00 00 49 00 00 6B 21 00 03 10 58 00 00 49 00' - '00 49 00 00 6C 21 00 01 10 4C 00 00 6D 21 00 01 10 43 00 00 6E 21 00 01 10 44 00 00 6F 21 00 01' - '10 4D 00 00 70 21 00 01 10 69 00 00 71 21 00 02 10 69 00 00 69 00 00 72 21 00 03 10 69 00 00 69' - '00 00 69 00 00 73 21 00 02 10 69 00 00 76 00 00 74 21 00 01 10 76 00 00 75 21 00 02 10 76 00 00' - '69 00 00 76 21 00 03 10 76 00 00 69 00 00 69 00 00 77 21 00 04 10 76 00 00 69 00 00 69 00 00 69' - '00 00 78 21 00 02 10 69 00 00 78 00 00 79 21 00 01 10 78 00 00 7A 21 00 02 10 78 00 00 69 00 00' - '7B 21 00 03 10 78 00 00 69 00 00 69 00 00 7C 21 00 01 10 6C 00 00 7D 21 00 01 10 63 00 00 7E 21' - '00 01 10 64 00 00 7F 21 00 01 10 6D 00 00 89 21 00 03 0F 30 00 00 44 20 00 33 00 00 9A 21 00 02' - '00 90 21 00 38 03 00 9B 21 00 02 00 92 21 00 38 03 00 AE 21 00 02 00 94 21 00 38 03 00 CD 21 00' - '02 00 D0 21 00 38 03 00 CE 21 00 02 00 D4 21 00 38 03 00 CF 21 00 02 00 D2 21 00 38 03 00 04 22' - '00 02 00 03 22 00 38 03 00 09 22 00 02 00 08 22 00 38 03 00 0C 22 00 02 00 0B 22 00 38 03 00 24' - '22 00 02 00 23 22 00 38 03 00 26 22 00 02 00 25 22 00 38 03 00 2C 22 00 02 10 2B 22 00 2B 22 00' - '2D 22 00 03 10 2B 22 00 2B 22 00 2B 22 00 2F 22 00 02 10 2E 22 00 2E 22 00 30 22 00 03 10 2E 22' - '00 2E 22 00 2E 22 00 41 22 00 02 00 3C 22 00 38 03 00 44 22 00 02 00 43 22 00 38 03 00 47 22 00' - '02 00 45 22 00 38 03 00 49 22 00 02 00 48 22 00 38 03 00 60 22 00 02 00 3D 00 00 38 03 00 62 22' - '00 02 00 61 22 00 38 03 00 6D 22 00 02 00 4D 22 00 38 03 00 6E 22 00 02 00 3C 00 00 38 03 00 6F' - '22 00 02 00 3E 00 00 38 03 00 70 22 00 02 00 64 22 00 38 03 00 71 22 00 02 00 65 22 00 38 03 00' - '74 22 00 02 00 72 22 00 38 03 00 75 22 00 02 00 73 22 00 38 03 00 78 22 00 02 00 76 22 00 38 03' - '00 79 22 00 02 00 77 22 00 38 03 00 80 22 00 02 00 7A 22 00 38 03 00 81 22 00 02 00 7B 22 00 38' - '03 00 84 22 00 02 00 82 22 00 38 03 00 85 22 00 02 00 83 22 00 38 03 00 88 22 00 02 00 86 22 00' - '38 03 00 89 22 00 02 00 87 22 00 38 03 00 AC 22 00 02 00 A2 22 00 38 03 00 AD 22 00 02 00 A8 22' - '00 38 03 00 AE 22 00 02 00 A9 22 00 38 03 00 AF 22 00 02 00 AB 22 00 38 03 00 E0 22 00 02 00 7C' - '22 00 38 03 00 E1 22 00 02 00 7D 22 00 38 03 00 E2 22 00 02 00 91 22 00 38 03 00 E3 22 00 02 00' - '92 22 00 38 03 00 EA 22 00 02 00 B2 22 00 38 03 00 EB 22 00 02 00 B3 22 00 38 03 00 EC 22 00 02' - '00 B4 22 00 38 03 00 ED 22 00 02 00 B5 22 00 38 03 00 29 23 00 01 00 08 30 00 2A 23 00 01 00 09' - '30 00 60 24 00 01 07 31 00 00 61 24 00 01 07 32 00 00 62 24 00 01 07 33 00 00 63 24 00 01 07 34' - '00 00 64 24 00 01 07 35 00 00 65 24 00 01 07 36 00 00 66 24 00 01 07 37 00 00 67 24 00 01 07 38' - '00 00 68 24 00 01 07 39 00 00 69 24 00 02 07 31 00 00 30 00 00 6A 24 00 02 07 31 00 00 31 00 00' - '6B 24 00 02 07 31 00 00 32 00 00 6C 24 00 02 07 31 00 00 33 00 00 6D 24 00 02 07 31 00 00 34 00' - '00 6E 24 00 02 07 31 00 00 35 00 00 6F 24 00 02 07 31 00 00 36 00 00 70 24 00 02 07 31 00 00 37' - '00 00 71 24 00 02 07 31 00 00 38 00 00 72 24 00 02 07 31 00 00 39 00 00 73 24 00 02 07 32 00 00' - '30 00 00 74 24 00 03 10 28 00 00 31 00 00 29 00 00 75 24 00 03 10 28 00 00 32 00 00 29 00 00 76' - '24 00 03 10 28 00 00 33 00 00 29 00 00 77 24 00 03 10 28 00 00 34 00 00 29 00 00 78 24 00 03 10' - '28 00 00 35 00 00 29 00 00 79 24 00 03 10 28 00 00 36 00 00 29 00 00 7A 24 00 03 10 28 00 00 37' - '00 00 29 00 00 7B 24 00 03 10 28 00 00 38 00 00 29 00 00 7C 24 00 03 10 28 00 00 39 00 00 29 00' - '00 7D 24 00 04 10 28 00 00 31 00 00 30 00 00 29 00 00 7E 24 00 04 10 28 00 00 31 00 00 31 00 00' - '29 00 00 7F 24 00 04 10 28 00 00 31 00 00 32 00 00 29 00 00 80 24 00 04 10 28 00 00 31 00 00 33' - '00 00 29 00 00 81 24 00 04 10 28 00 00 31 00 00 34 00 00 29 00 00 82 24 00 04 10 28 00 00 31 00' - '00 35 00 00 29 00 00 83 24 00 04 10 28 00 00 31 00 00 36 00 00 29 00 00 84 24 00 04 10 28 00 00' - '31 00 00 37 00 00 29 00 00 85 24 00 04 10 28 00 00 31 00 00 38 00 00 29 00 00 86 24 00 04 10 28' - '00 00 31 00 00 39 00 00 29 00 00 87 24 00 04 10 28 00 00 32 00 00 30 00 00 29 00 00 88 24 00 02' - '10 31 00 00 2E 00 00 89 24 00 02 10 32 00 00 2E 00 00 8A 24 00 02 10 33 00 00 2E 00 00 8B 24 00' - '02 10 34 00 00 2E 00 00 8C 24 00 02 10 35 00 00 2E 00 00 8D 24 00 02 10 36 00 00 2E 00 00 8E 24' - '00 02 10 37 00 00 2E 00 00 8F 24 00 02 10 38 00 00 2E 00 00 90 24 00 02 10 39 00 00 2E 00 00 91' - '24 00 03 10 31 00 00 30 00 00 2E 00 00 92 24 00 03 10 31 00 00 31 00 00 2E 00 00 93 24 00 03 10' - '31 00 00 32 00 00 2E 00 00 94 24 00 03 10 31 00 00 33 00 00 2E 00 00 95 24 00 03 10 31 00 00 34' - '00 00 2E 00 00 96 24 00 03 10 31 00 00 35 00 00 2E 00 00 97 24 00 03 10 31 00 00 36 00 00 2E 00' - '00 98 24 00 03 10 31 00 00 37 00 00 2E 00 00 99 24 00 03 10 31 00 00 38 00 00 2E 00 00 9A 24 00' - '03 10 31 00 00 39 00 00 2E 00 00 9B 24 00 03 10 32 00 00 30 00 00 2E 00 00 9C 24 00 03 10 28 00' - '00 61 00 00 29 00 00 9D 24 00 03 10 28 00 00 62 00 00 29 00 00 9E 24 00 03 10 28 00 00 63 00 00' - '29 00 00 9F 24 00 03 10 28 00 00 64 00 00 29 00 00 A0 24 00 03 10 28 00 00 65 00 00 29 00 00 A1' - '24 00 03 10 28 00 00 66 00 00 29 00 00 A2 24 00 03 10 28 00 00 67 00 00 29 00 00 A3 24 00 03 10' - '28 00 00 68 00 00 29 00 00 A4 24 00 03 10 28 00 00 69 00 00 29 00 00 A5 24 00 03 10 28 00 00 6A' - '00 00 29 00 00 A6 24 00 03 10 28 00 00 6B 00 00 29 00 00 A7 24 00 03 10 28 00 00 6C 00 00 29 00' - '00 A8 24 00 03 10 28 00 00 6D 00 00 29 00 00 A9 24 00 03 10 28 00 00 6E 00 00 29 00 00 AA 24 00' - '03 10 28 00 00 6F 00 00 29 00 00 AB 24 00 03 10 28 00 00 70 00 00 29 00 00 AC 24 00 03 10 28 00' - '00 71 00 00 29 00 00 AD 24 00 03 10 28 00 00 72 00 00 29 00 00 AE 24 00 03 10 28 00 00 73 00 00' - '29 00 00 AF 24 00 03 10 28 00 00 74 00 00 29 00 00 B0 24 00 03 10 28 00 00 75 00 00 29 00 00 B1' - '24 00 03 10 28 00 00 76 00 00 29 00 00 B2 24 00 03 10 28 00 00 77 00 00 29 00 00 B3 24 00 03 10' - '28 00 00 78 00 00 29 00 00 B4 24 00 03 10 28 00 00 79 00 00 29 00 00 B5 24 00 03 10 28 00 00 7A' - '00 00 29 00 00 B6 24 00 01 07 41 00 00 B7 24 00 01 07 42 00 00 B8 24 00 01 07 43 00 00 B9 24 00' - '01 07 44 00 00 BA 24 00 01 07 45 00 00 BB 24 00 01 07 46 00 00 BC 24 00 01 07 47 00 00 BD 24 00' - '01 07 48 00 00 BE 24 00 01 07 49 00 00 BF 24 00 01 07 4A 00 00 C0 24 00 01 07 4B 00 00 C1 24 00' - '01 07 4C 00 00 C2 24 00 01 07 4D 00 00 C3 24 00 01 07 4E 00 00 C4 24 00 01 07 4F 00 00 C5 24 00' - '01 07 50 00 00 C6 24 00 01 07 51 00 00 C7 24 00 01 07 52 00 00 C8 24 00 01 07 53 00 00 C9 24 00' - '01 07 54 00 00 CA 24 00 01 07 55 00 00 CB 24 00 01 07 56 00 00 CC 24 00 01 07 57 00 00 CD 24 00' - '01 07 58 00 00 CE 24 00 01 07 59 00 00 CF 24 00 01 07 5A 00 00 D0 24 00 01 07 61 00 00 D1 24 00' - '01 07 62 00 00 D2 24 00 01 07 63 00 00 D3 24 00 01 07 64 00 00 D4 24 00 01 07 65 00 00 D5 24 00' - '01 07 66 00 00 D6 24 00 01 07 67 00 00 D7 24 00 01 07 68 00 00 D8 24 00 01 07 69 00 00 D9 24 00' - '01 07 6A 00 00 DA 24 00 01 07 6B 00 00 DB 24 00 01 07 6C 00 00 DC 24 00 01 07 6D 00 00 DD 24 00' - '01 07 6E 00 00 DE 24 00 01 07 6F 00 00 DF 24 00 01 07 70 00 00 E0 24 00 01 07 71 00 00 E1 24 00' - '01 07 72 00 00 E2 24 00 01 07 73 00 00 E3 24 00 01 07 74 00 00 E4 24 00 01 07 75 00 00 E5 24 00' - '01 07 76 00 00 E6 24 00 01 07 77 00 00 E7 24 00 01 07 78 00 00 E8 24 00 01 07 79 00 00 E9 24 00' - '01 07 7A 00 00 EA 24 00 01 07 30 00 00 0C 2A 00 04 10 2B 22 00 2B 22 00 2B 22 00 2B 22 00 74 2A' - '00 03 10 3A 00 00 3A 00 00 3D 00 00 75 2A 00 02 10 3D 00 00 3D 00 00 76 2A 00 03 10 3D 00 00 3D' - '00 00 3D 00 00 DC 2A 00 02 00 DD 2A 00 38 03 00 7C 2C 00 01 09 6A 00 00 7D 2C 00 01 08 56 00 00' - '6F 2D 00 01 08 61 2D 00 9F 2E 00 01 10 CD 6B 00 F3 2E 00 01 10 9F 9F 00 00 2F 00 01 10 00 4E 00' - '01 2F 00 01 10 28 4E 00 02 2F 00 01 10 36 4E 00 03 2F 00 01 10 3F 4E 00 04 2F 00 01 10 59 4E 00' - '05 2F 00 01 10 85 4E 00 06 2F 00 01 10 8C 4E 00 07 2F 00 01 10 A0 4E 00 08 2F 00 01 10 BA 4E 00' - '09 2F 00 01 10 3F 51 00 0A 2F 00 01 10 65 51 00 0B 2F 00 01 10 6B 51 00 0C 2F 00 01 10 82 51 00' - '0D 2F 00 01 10 96 51 00 0E 2F 00 01 10 AB 51 00 0F 2F 00 01 10 E0 51 00 10 2F 00 01 10 F5 51 00' - '11 2F 00 01 10 00 52 00 12 2F 00 01 10 9B 52 00 13 2F 00 01 10 F9 52 00 14 2F 00 01 10 15 53 00' - '15 2F 00 01 10 1A 53 00 16 2F 00 01 10 38 53 00 17 2F 00 01 10 41 53 00 18 2F 00 01 10 5C 53 00' - '19 2F 00 01 10 69 53 00 1A 2F 00 01 10 82 53 00 1B 2F 00 01 10 B6 53 00 1C 2F 00 01 10 C8 53 00' - '1D 2F 00 01 10 E3 53 00 1E 2F 00 01 10 D7 56 00 1F 2F 00 01 10 1F 57 00 20 2F 00 01 10 EB 58 00' - '21 2F 00 01 10 02 59 00 22 2F 00 01 10 0A 59 00 23 2F 00 01 10 15 59 00 24 2F 00 01 10 27 59 00' - '25 2F 00 01 10 73 59 00 26 2F 00 01 10 50 5B 00 27 2F 00 01 10 80 5B 00 28 2F 00 01 10 F8 5B 00' - '29 2F 00 01 10 0F 5C 00 2A 2F 00 01 10 22 5C 00 2B 2F 00 01 10 38 5C 00 2C 2F 00 01 10 6E 5C 00' - '2D 2F 00 01 10 71 5C 00 2E 2F 00 01 10 DB 5D 00 2F 2F 00 01 10 E5 5D 00 30 2F 00 01 10 F1 5D 00' - '31 2F 00 01 10 FE 5D 00 32 2F 00 01 10 72 5E 00 33 2F 00 01 10 7A 5E 00 34 2F 00 01 10 7F 5E 00' - '35 2F 00 01 10 F4 5E 00 36 2F 00 01 10 FE 5E 00 37 2F 00 01 10 0B 5F 00 38 2F 00 01 10 13 5F 00' - '39 2F 00 01 10 50 5F 00 3A 2F 00 01 10 61 5F 00 3B 2F 00 01 10 73 5F 00 3C 2F 00 01 10 C3 5F 00' - '3D 2F 00 01 10 08 62 00 3E 2F 00 01 10 36 62 00 3F 2F 00 01 10 4B 62 00 40 2F 00 01 10 2F 65 00' - '41 2F 00 01 10 34 65 00 42 2F 00 01 10 87 65 00 43 2F 00 01 10 97 65 00 44 2F 00 01 10 A4 65 00' - '45 2F 00 01 10 B9 65 00 46 2F 00 01 10 E0 65 00 47 2F 00 01 10 E5 65 00 48 2F 00 01 10 F0 66 00' - '49 2F 00 01 10 08 67 00 4A 2F 00 01 10 28 67 00 4B 2F 00 01 10 20 6B 00 4C 2F 00 01 10 62 6B 00' - '4D 2F 00 01 10 79 6B 00 4E 2F 00 01 10 B3 6B 00 4F 2F 00 01 10 CB 6B 00 50 2F 00 01 10 D4 6B 00' - '51 2F 00 01 10 DB 6B 00 52 2F 00 01 10 0F 6C 00 53 2F 00 01 10 14 6C 00 54 2F 00 01 10 34 6C 00' - '55 2F 00 01 10 6B 70 00 56 2F 00 01 10 2A 72 00 57 2F 00 01 10 36 72 00 58 2F 00 01 10 3B 72 00' - '59 2F 00 01 10 3F 72 00 5A 2F 00 01 10 47 72 00 5B 2F 00 01 10 59 72 00 5C 2F 00 01 10 5B 72 00' - '5D 2F 00 01 10 AC 72 00 5E 2F 00 01 10 84 73 00 5F 2F 00 01 10 89 73 00 60 2F 00 01 10 DC 74 00' - '61 2F 00 01 10 E6 74 00 62 2F 00 01 10 18 75 00 63 2F 00 01 10 1F 75 00 64 2F 00 01 10 28 75 00' - '65 2F 00 01 10 30 75 00 66 2F 00 01 10 8B 75 00 67 2F 00 01 10 92 75 00 68 2F 00 01 10 76 76 00' - '69 2F 00 01 10 7D 76 00 6A 2F 00 01 10 AE 76 00 6B 2F 00 01 10 BF 76 00 6C 2F 00 01 10 EE 76 00' - '6D 2F 00 01 10 DB 77 00 6E 2F 00 01 10 E2 77 00 6F 2F 00 01 10 F3 77 00 70 2F 00 01 10 3A 79 00' - '71 2F 00 01 10 B8 79 00 72 2F 00 01 10 BE 79 00 73 2F 00 01 10 74 7A 00 74 2F 00 01 10 CB 7A 00' - '75 2F 00 01 10 F9 7A 00 76 2F 00 01 10 73 7C 00 77 2F 00 01 10 F8 7C 00 78 2F 00 01 10 36 7F 00' - '79 2F 00 01 10 51 7F 00 7A 2F 00 01 10 8A 7F 00 7B 2F 00 01 10 BD 7F 00 7C 2F 00 01 10 01 80 00' - '7D 2F 00 01 10 0C 80 00 7E 2F 00 01 10 12 80 00 7F 2F 00 01 10 33 80 00 80 2F 00 01 10 7F 80 00' - '81 2F 00 01 10 89 80 00 82 2F 00 01 10 E3 81 00 83 2F 00 01 10 EA 81 00 84 2F 00 01 10 F3 81 00' - '85 2F 00 01 10 FC 81 00 86 2F 00 01 10 0C 82 00 87 2F 00 01 10 1B 82 00 88 2F 00 01 10 1F 82 00' - '89 2F 00 01 10 6E 82 00 8A 2F 00 01 10 72 82 00 8B 2F 00 01 10 78 82 00 8C 2F 00 01 10 4D 86 00' - '8D 2F 00 01 10 6B 86 00 8E 2F 00 01 10 40 88 00 8F 2F 00 01 10 4C 88 00 90 2F 00 01 10 63 88 00' - '91 2F 00 01 10 7E 89 00 92 2F 00 01 10 8B 89 00 93 2F 00 01 10 D2 89 00 94 2F 00 01 10 00 8A 00' - '95 2F 00 01 10 37 8C 00 96 2F 00 01 10 46 8C 00 97 2F 00 01 10 55 8C 00 98 2F 00 01 10 78 8C 00' - '99 2F 00 01 10 9D 8C 00 9A 2F 00 01 10 64 8D 00 9B 2F 00 01 10 70 8D 00 9C 2F 00 01 10 B3 8D 00' - '9D 2F 00 01 10 AB 8E 00 9E 2F 00 01 10 CA 8E 00 9F 2F 00 01 10 9B 8F 00 A0 2F 00 01 10 B0 8F 00' - 'A1 2F 00 01 10 B5 8F 00 A2 2F 00 01 10 91 90 00 A3 2F 00 01 10 49 91 00 A4 2F 00 01 10 C6 91 00' - 'A5 2F 00 01 10 CC 91 00 A6 2F 00 01 10 D1 91 00 A7 2F 00 01 10 77 95 00 A8 2F 00 01 10 80 95 00' - 'A9 2F 00 01 10 1C 96 00 AA 2F 00 01 10 B6 96 00 AB 2F 00 01 10 B9 96 00 AC 2F 00 01 10 E8 96 00' - 'AD 2F 00 01 10 51 97 00 AE 2F 00 01 10 5E 97 00 AF 2F 00 01 10 62 97 00 B0 2F 00 01 10 69 97 00' - 'B1 2F 00 01 10 CB 97 00 B2 2F 00 01 10 ED 97 00 B3 2F 00 01 10 F3 97 00 B4 2F 00 01 10 01 98 00' - 'B5 2F 00 01 10 A8 98 00 B6 2F 00 01 10 DB 98 00 B7 2F 00 01 10 DF 98 00 B8 2F 00 01 10 96 99 00' - 'B9 2F 00 01 10 99 99 00 BA 2F 00 01 10 AC 99 00 BB 2F 00 01 10 A8 9A 00 BC 2F 00 01 10 D8 9A 00' - 'BD 2F 00 01 10 DF 9A 00 BE 2F 00 01 10 25 9B 00 BF 2F 00 01 10 2F 9B 00 C0 2F 00 01 10 32 9B 00' - 'C1 2F 00 01 10 3C 9B 00 C2 2F 00 01 10 5A 9B 00 C3 2F 00 01 10 E5 9C 00 C4 2F 00 01 10 75 9E 00' - 'C5 2F 00 01 10 7F 9E 00 C6 2F 00 01 10 A5 9E 00 C7 2F 00 01 10 BB 9E 00 C8 2F 00 01 10 C3 9E 00' - 'C9 2F 00 01 10 CD 9E 00 CA 2F 00 01 10 D1 9E 00 CB 2F 00 01 10 F9 9E 00 CC 2F 00 01 10 FD 9E 00' - 'CD 2F 00 01 10 0E 9F 00 CE 2F 00 01 10 13 9F 00 CF 2F 00 01 10 20 9F 00 D0 2F 00 01 10 3B 9F 00' - 'D1 2F 00 01 10 4A 9F 00 D2 2F 00 01 10 52 9F 00 D3 2F 00 01 10 8D 9F 00 D4 2F 00 01 10 9C 9F 00' - 'D5 2F 00 01 10 A0 9F 00 00 30 00 01 0B 20 00 00 36 30 00 01 10 12 30 00 38 30 00 01 10 41 53 00' - '39 30 00 01 10 44 53 00 3A 30 00 01 10 45 53 00 4C 30 00 02 00 4B 30 00 99 30 00 4E 30 00 02 00' - '4D 30 00 99 30 00 50 30 00 02 00 4F 30 00 99 30 00 52 30 00 02 00 51 30 00 99 30 00 54 30 00 02' - '00 53 30 00 99 30 00 56 30 00 02 00 55 30 00 99 30 00 58 30 00 02 00 57 30 00 99 30 00 5A 30 00' - '02 00 59 30 00 99 30 00 5C 30 00 02 00 5B 30 00 99 30 00 5E 30 00 02 00 5D 30 00 99 30 00 60 30' - '00 02 00 5F 30 00 99 30 00 62 30 00 02 00 61 30 00 99 30 00 65 30 00 02 00 64 30 00 99 30 00 67' - '30 00 02 00 66 30 00 99 30 00 69 30 00 02 00 68 30 00 99 30 00 70 30 00 02 00 6F 30 00 99 30 00' - '71 30 00 02 00 6F 30 00 9A 30 00 73 30 00 02 00 72 30 00 99 30 00 74 30 00 02 00 72 30 00 9A 30' - '00 76 30 00 02 00 75 30 00 99 30 00 77 30 00 02 00 75 30 00 9A 30 00 79 30 00 02 00 78 30 00 99' - '30 00 7A 30 00 02 00 78 30 00 9A 30 00 7C 30 00 02 00 7B 30 00 99 30 00 7D 30 00 02 00 7B 30 00' - '9A 30 00 94 30 00 02 00 46 30 00 99 30 00 9B 30 00 02 10 20 00 00 99 30 00 9C 30 00 02 10 20 00' - '00 9A 30 00 9E 30 00 02 00 9D 30 00 99 30 00 9F 30 00 02 0A 88 30 00 8A 30 00 AC 30 00 02 00 AB' - '30 00 99 30 00 AE 30 00 02 00 AD 30 00 99 30 00 B0 30 00 02 00 AF 30 00 99 30 00 B2 30 00 02 00' - 'B1 30 00 99 30 00 B4 30 00 02 00 B3 30 00 99 30 00 B6 30 00 02 00 B5 30 00 99 30 00 B8 30 00 02' - '00 B7 30 00 99 30 00 BA 30 00 02 00 B9 30 00 99 30 00 BC 30 00 02 00 BB 30 00 99 30 00 BE 30 00' - '02 00 BD 30 00 99 30 00 C0 30 00 02 00 BF 30 00 99 30 00 C2 30 00 02 00 C1 30 00 99 30 00 C5 30' - '00 02 00 C4 30 00 99 30 00 C7 30 00 02 00 C6 30 00 99 30 00 C9 30 00 02 00 C8 30 00 99 30 00 D0' - '30 00 02 00 CF 30 00 99 30 00 D1 30 00 02 00 CF 30 00 9A 30 00 D3 30 00 02 00 D2 30 00 99 30 00' - 'D4 30 00 02 00 D2 30 00 9A 30 00 D6 30 00 02 00 D5 30 00 99 30 00 D7 30 00 02 00 D5 30 00 9A 30' - '00 D9 30 00 02 00 D8 30 00 99 30 00 DA 30 00 02 00 D8 30 00 9A 30 00 DC 30 00 02 00 DB 30 00 99' - '30 00 DD 30 00 02 00 DB 30 00 9A 30 00 F4 30 00 02 00 A6 30 00 99 30 00 F7 30 00 02 00 EF 30 00' - '99 30 00 F8 30 00 02 00 F0 30 00 99 30 00 F9 30 00 02 00 F1 30 00 99 30 00 FA 30 00 02 00 F2 30' - '00 99 30 00 FE 30 00 02 00 FD 30 00 99 30 00 FF 30 00 02 0A B3 30 00 C8 30 00 31 31 00 01 10 00' - '11 00 32 31 00 01 10 01 11 00 33 31 00 01 10 AA 11 00 34 31 00 01 10 02 11 00 35 31 00 01 10 AC' - '11 00 36 31 00 01 10 AD 11 00 37 31 00 01 10 03 11 00 38 31 00 01 10 04 11 00 39 31 00 01 10 05' - '11 00 3A 31 00 01 10 B0 11 00 3B 31 00 01 10 B1 11 00 3C 31 00 01 10 B2 11 00 3D 31 00 01 10 B3' - '11 00 3E 31 00 01 10 B4 11 00 3F 31 00 01 10 B5 11 00 40 31 00 01 10 1A 11 00 41 31 00 01 10 06' - '11 00 42 31 00 01 10 07 11 00 43 31 00 01 10 08 11 00 44 31 00 01 10 21 11 00 45 31 00 01 10 09' - '11 00 46 31 00 01 10 0A 11 00 47 31 00 01 10 0B 11 00 48 31 00 01 10 0C 11 00 49 31 00 01 10 0D' - '11 00 4A 31 00 01 10 0E 11 00 4B 31 00 01 10 0F 11 00 4C 31 00 01 10 10 11 00 4D 31 00 01 10 11' - '11 00 4E 31 00 01 10 12 11 00 4F 31 00 01 10 61 11 00 50 31 00 01 10 62 11 00 51 31 00 01 10 63' - '11 00 52 31 00 01 10 64 11 00 53 31 00 01 10 65 11 00 54 31 00 01 10 66 11 00 55 31 00 01 10 67' - '11 00 56 31 00 01 10 68 11 00 57 31 00 01 10 69 11 00 58 31 00 01 10 6A 11 00 59 31 00 01 10 6B' - '11 00 5A 31 00 01 10 6C 11 00 5B 31 00 01 10 6D 11 00 5C 31 00 01 10 6E 11 00 5D 31 00 01 10 6F' - '11 00 5E 31 00 01 10 70 11 00 5F 31 00 01 10 71 11 00 60 31 00 01 10 72 11 00 61 31 00 01 10 73' - '11 00 62 31 00 01 10 74 11 00 63 31 00 01 10 75 11 00 64 31 00 01 10 60 11 00 65 31 00 01 10 14' - '11 00 66 31 00 01 10 15 11 00 67 31 00 01 10 C7 11 00 68 31 00 01 10 C8 11 00 69 31 00 01 10 CC' - '11 00 6A 31 00 01 10 CE 11 00 6B 31 00 01 10 D3 11 00 6C 31 00 01 10 D7 11 00 6D 31 00 01 10 D9' - '11 00 6E 31 00 01 10 1C 11 00 6F 31 00 01 10 DD 11 00 70 31 00 01 10 DF 11 00 71 31 00 01 10 1D' - '11 00 72 31 00 01 10 1E 11 00 73 31 00 01 10 20 11 00 74 31 00 01 10 22 11 00 75 31 00 01 10 23' - '11 00 76 31 00 01 10 27 11 00 77 31 00 01 10 29 11 00 78 31 00 01 10 2B 11 00 79 31 00 01 10 2C' - '11 00 7A 31 00 01 10 2D 11 00 7B 31 00 01 10 2E 11 00 7C 31 00 01 10 2F 11 00 7D 31 00 01 10 32' - '11 00 7E 31 00 01 10 36 11 00 7F 31 00 01 10 40 11 00 80 31 00 01 10 47 11 00 81 31 00 01 10 4C' - '11 00 82 31 00 01 10 F1 11 00 83 31 00 01 10 F2 11 00 84 31 00 01 10 57 11 00 85 31 00 01 10 58' - '11 00 86 31 00 01 10 59 11 00 87 31 00 01 10 84 11 00 88 31 00 01 10 85 11 00 89 31 00 01 10 88' - '11 00 8A 31 00 01 10 91 11 00 8B 31 00 01 10 92 11 00 8C 31 00 01 10 94 11 00 8D 31 00 01 10 9E' - '11 00 8E 31 00 01 10 A1 11 00 92 31 00 01 08 00 4E 00 93 31 00 01 08 8C 4E 00 94 31 00 01 08 09' - '4E 00 95 31 00 01 08 DB 56 00 96 31 00 01 08 0A 4E 00 97 31 00 01 08 2D 4E 00 98 31 00 01 08 0B' - '4E 00 99 31 00 01 08 32 75 00 9A 31 00 01 08 59 4E 00 9B 31 00 01 08 19 4E 00 9C 31 00 01 08 01' - '4E 00 9D 31 00 01 08 29 59 00 9E 31 00 01 08 30 57 00 9F 31 00 01 08 BA 4E 00 00 32 00 03 10 28' - '00 00 00 11 00 29 00 00 01 32 00 03 10 28 00 00 02 11 00 29 00 00 02 32 00 03 10 28 00 00 03 11' - '00 29 00 00 03 32 00 03 10 28 00 00 05 11 00 29 00 00 04 32 00 03 10 28 00 00 06 11 00 29 00 00' - '05 32 00 03 10 28 00 00 07 11 00 29 00 00 06 32 00 03 10 28 00 00 09 11 00 29 00 00 07 32 00 03' - '10 28 00 00 0B 11 00 29 00 00 08 32 00 03 10 28 00 00 0C 11 00 29 00 00 09 32 00 03 10 28 00 00' - '0E 11 00 29 00 00 0A 32 00 03 10 28 00 00 0F 11 00 29 00 00 0B 32 00 03 10 28 00 00 10 11 00 29' - '00 00 0C 32 00 03 10 28 00 00 11 11 00 29 00 00 0D 32 00 03 10 28 00 00 12 11 00 29 00 00 0E 32' - '00 04 10 28 00 00 00 11 00 61 11 00 29 00 00 0F 32 00 04 10 28 00 00 02 11 00 61 11 00 29 00 00' - '10 32 00 04 10 28 00 00 03 11 00 61 11 00 29 00 00 11 32 00 04 10 28 00 00 05 11 00 61 11 00 29' - '00 00 12 32 00 04 10 28 00 00 06 11 00 61 11 00 29 00 00 13 32 00 04 10 28 00 00 07 11 00 61 11' - '00 29 00 00 14 32 00 04 10 28 00 00 09 11 00 61 11 00 29 00 00 15 32 00 04 10 28 00 00 0B 11 00' - '61 11 00 29 00 00 16 32 00 04 10 28 00 00 0C 11 00 61 11 00 29 00 00 17 32 00 04 10 28 00 00 0E' - '11 00 61 11 00 29 00 00 18 32 00 04 10 28 00 00 0F 11 00 61 11 00 29 00 00 19 32 00 04 10 28 00' - '00 10 11 00 61 11 00 29 00 00 1A 32 00 04 10 28 00 00 11 11 00 61 11 00 29 00 00 1B 32 00 04 10' - '28 00 00 12 11 00 61 11 00 29 00 00 1C 32 00 04 10 28 00 00 0C 11 00 6E 11 00 29 00 00 1D 32 00' - '07 10 28 00 00 0B 11 00 69 11 00 0C 11 00 65 11 00 AB 11 00 29 00 00 1E 32 00 06 10 28 00 00 0B' - '11 00 69 11 00 12 11 00 6E 11 00 29 00 00 20 32 00 03 10 28 00 00 00 4E 00 29 00 00 21 32 00 03' - '10 28 00 00 8C 4E 00 29 00 00 22 32 00 03 10 28 00 00 09 4E 00 29 00 00 23 32 00 03 10 28 00 00' - 'DB 56 00 29 00 00 24 32 00 03 10 28 00 00 94 4E 00 29 00 00 25 32 00 03 10 28 00 00 6D 51 00 29' - '00 00 26 32 00 03 10 28 00 00 03 4E 00 29 00 00 27 32 00 03 10 28 00 00 6B 51 00 29 00 00 28 32' - '00 03 10 28 00 00 5D 4E 00 29 00 00 29 32 00 03 10 28 00 00 41 53 00 29 00 00 2A 32 00 03 10 28' - '00 00 08 67 00 29 00 00 2B 32 00 03 10 28 00 00 6B 70 00 29 00 00 2C 32 00 03 10 28 00 00 34 6C' - '00 29 00 00 2D 32 00 03 10 28 00 00 28 67 00 29 00 00 2E 32 00 03 10 28 00 00 D1 91 00 29 00 00' - '2F 32 00 03 10 28 00 00 1F 57 00 29 00 00 30 32 00 03 10 28 00 00 E5 65 00 29 00 00 31 32 00 03' - '10 28 00 00 2A 68 00 29 00 00 32 32 00 03 10 28 00 00 09 67 00 29 00 00 33 32 00 03 10 28 00 00' - '3E 79 00 29 00 00 34 32 00 03 10 28 00 00 0D 54 00 29 00 00 35 32 00 03 10 28 00 00 79 72 00 29' - '00 00 36 32 00 03 10 28 00 00 A1 8C 00 29 00 00 37 32 00 03 10 28 00 00 5D 79 00 29 00 00 38 32' - '00 03 10 28 00 00 B4 52 00 29 00 00 39 32 00 03 10 28 00 00 E3 4E 00 29 00 00 3A 32 00 03 10 28' - '00 00 7C 54 00 29 00 00 3B 32 00 03 10 28 00 00 66 5B 00 29 00 00 3C 32 00 03 10 28 00 00 E3 76' - '00 29 00 00 3D 32 00 03 10 28 00 00 01 4F 00 29 00 00 3E 32 00 03 10 28 00 00 C7 8C 00 29 00 00' - '3F 32 00 03 10 28 00 00 54 53 00 29 00 00 40 32 00 03 10 28 00 00 6D 79 00 29 00 00 41 32 00 03' - '10 28 00 00 11 4F 00 29 00 00 42 32 00 03 10 28 00 00 EA 81 00 29 00 00 43 32 00 03 10 28 00 00' - 'F3 81 00 29 00 00 44 32 00 01 07 4F 55 00 45 32 00 01 07 7C 5E 00 46 32 00 01 07 87 65 00 47 32' - '00 01 07 8F 7B 00 50 32 00 03 0E 50 00 00 54 00 00 45 00 00 51 32 00 02 07 32 00 00 31 00 00 52' - '32 00 02 07 32 00 00 32 00 00 53 32 00 02 07 32 00 00 33 00 00 54 32 00 02 07 32 00 00 34 00 00' - '55 32 00 02 07 32 00 00 35 00 00 56 32 00 02 07 32 00 00 36 00 00 57 32 00 02 07 32 00 00 37 00' - '00 58 32 00 02 07 32 00 00 38 00 00 59 32 00 02 07 32 00 00 39 00 00 5A 32 00 02 07 33 00 00 30' - '00 00 5B 32 00 02 07 33 00 00 31 00 00 5C 32 00 02 07 33 00 00 32 00 00 5D 32 00 02 07 33 00 00' - '33 00 00 5E 32 00 02 07 33 00 00 34 00 00 5F 32 00 02 07 33 00 00 35 00 00 60 32 00 01 07 00 11' - '00 61 32 00 01 07 02 11 00 62 32 00 01 07 03 11 00 63 32 00 01 07 05 11 00 64 32 00 01 07 06 11' - '00 65 32 00 01 07 07 11 00 66 32 00 01 07 09 11 00 67 32 00 01 07 0B 11 00 68 32 00 01 07 0C 11' - '00 69 32 00 01 07 0E 11 00 6A 32 00 01 07 0F 11 00 6B 32 00 01 07 10 11 00 6C 32 00 01 07 11 11' - '00 6D 32 00 01 07 12 11 00 6E 32 00 02 07 00 11 00 61 11 00 6F 32 00 02 07 02 11 00 61 11 00 70' - '32 00 02 07 03 11 00 61 11 00 71 32 00 02 07 05 11 00 61 11 00 72 32 00 02 07 06 11 00 61 11 00' - '73 32 00 02 07 07 11 00 61 11 00 74 32 00 02 07 09 11 00 61 11 00 75 32 00 02 07 0B 11 00 61 11' - '00 76 32 00 02 07 0C 11 00 61 11 00 77 32 00 02 07 0E 11 00 61 11 00 78 32 00 02 07 0F 11 00 61' - '11 00 79 32 00 02 07 10 11 00 61 11 00 7A 32 00 02 07 11 11 00 61 11 00 7B 32 00 02 07 12 11 00' - '61 11 00 7C 32 00 05 07 0E 11 00 61 11 00 B7 11 00 00 11 00 69 11 00 7D 32 00 04 07 0C 11 00 6E' - '11 00 0B 11 00 74 11 00 7E 32 00 02 07 0B 11 00 6E 11 00 80 32 00 01 07 00 4E 00 81 32 00 01 07' - '8C 4E 00 82 32 00 01 07 09 4E 00 83 32 00 01 07 DB 56 00 84 32 00 01 07 94 4E 00 85 32 00 01 07' - '6D 51 00 86 32 00 01 07 03 4E 00 87 32 00 01 07 6B 51 00 88 32 00 01 07 5D 4E 00 89 32 00 01 07' - '41 53 00 8A 32 00 01 07 08 67 00 8B 32 00 01 07 6B 70 00 8C 32 00 01 07 34 6C 00 8D 32 00 01 07' - '28 67 00 8E 32 00 01 07 D1 91 00 8F 32 00 01 07 1F 57 00 90 32 00 01 07 E5 65 00 91 32 00 01 07' - '2A 68 00 92 32 00 01 07 09 67 00 93 32 00 01 07 3E 79 00 94 32 00 01 07 0D 54 00 95 32 00 01 07' - '79 72 00 96 32 00 01 07 A1 8C 00 97 32 00 01 07 5D 79 00 98 32 00 01 07 B4 52 00 99 32 00 01 07' - 'D8 79 00 9A 32 00 01 07 37 75 00 9B 32 00 01 07 73 59 00 9C 32 00 01 07 69 90 00 9D 32 00 01 07' - '2A 51 00 9E 32 00 01 07 70 53 00 9F 32 00 01 07 E8 6C 00 A0 32 00 01 07 05 98 00 A1 32 00 01 07' - '11 4F 00 A2 32 00 01 07 99 51 00 A3 32 00 01 07 63 6B 00 A4 32 00 01 07 0A 4E 00 A5 32 00 01 07' - '2D 4E 00 A6 32 00 01 07 0B 4E 00 A7 32 00 01 07 E6 5D 00 A8 32 00 01 07 F3 53 00 A9 32 00 01 07' - '3B 53 00 AA 32 00 01 07 97 5B 00 AB 32 00 01 07 66 5B 00 AC 32 00 01 07 E3 76 00 AD 32 00 01 07' - '01 4F 00 AE 32 00 01 07 C7 8C 00 AF 32 00 01 07 54 53 00 B0 32 00 01 07 1C 59 00 B1 32 00 02 07' - '33 00 00 36 00 00 B2 32 00 02 07 33 00 00 37 00 00 B3 32 00 02 07 33 00 00 38 00 00 B4 32 00 02' - '07 33 00 00 39 00 00 B5 32 00 02 07 34 00 00 30 00 00 B6 32 00 02 07 34 00 00 31 00 00 B7 32 00' - '02 07 34 00 00 32 00 00 B8 32 00 02 07 34 00 00 33 00 00 B9 32 00 02 07 34 00 00 34 00 00 BA 32' - '00 02 07 34 00 00 35 00 00 BB 32 00 02 07 34 00 00 36 00 00 BC 32 00 02 07 34 00 00 37 00 00 BD' - '32 00 02 07 34 00 00 38 00 00 BE 32 00 02 07 34 00 00 39 00 00 BF 32 00 02 07 35 00 00 30 00 00' - 'C0 32 00 02 10 31 00 00 08 67 00 C1 32 00 02 10 32 00 00 08 67 00 C2 32 00 02 10 33 00 00 08 67' - '00 C3 32 00 02 10 34 00 00 08 67 00 C4 32 00 02 10 35 00 00 08 67 00 C5 32 00 02 10 36 00 00 08' - '67 00 C6 32 00 02 10 37 00 00 08 67 00 C7 32 00 02 10 38 00 00 08 67 00 C8 32 00 02 10 39 00 00' - '08 67 00 C9 32 00 03 10 31 00 00 30 00 00 08 67 00 CA 32 00 03 10 31 00 00 31 00 00 08 67 00 CB' - '32 00 03 10 31 00 00 32 00 00 08 67 00 CC 32 00 02 0E 48 00 00 67 00 00 CD 32 00 03 0E 65 00 00' - '72 00 00 67 00 00 CE 32 00 02 0E 65 00 00 56 00 00 CF 32 00 03 0E 4C 00 00 54 00 00 44 00 00 D0' - '32 00 01 07 A2 30 00 D1 32 00 01 07 A4 30 00 D2 32 00 01 07 A6 30 00 D3 32 00 01 07 A8 30 00 D4' - '32 00 01 07 AA 30 00 D5 32 00 01 07 AB 30 00 D6 32 00 01 07 AD 30 00 D7 32 00 01 07 AF 30 00 D8' - '32 00 01 07 B1 30 00 D9 32 00 01 07 B3 30 00 DA 32 00 01 07 B5 30 00 DB 32 00 01 07 B7 30 00 DC' - '32 00 01 07 B9 30 00 DD 32 00 01 07 BB 30 00 DE 32 00 01 07 BD 30 00 DF 32 00 01 07 BF 30 00 E0' - '32 00 01 07 C1 30 00 E1 32 00 01 07 C4 30 00 E2 32 00 01 07 C6 30 00 E3 32 00 01 07 C8 30 00 E4' - '32 00 01 07 CA 30 00 E5 32 00 01 07 CB 30 00 E6 32 00 01 07 CC 30 00 E7 32 00 01 07 CD 30 00 E8' - '32 00 01 07 CE 30 00 E9 32 00 01 07 CF 30 00 EA 32 00 01 07 D2 30 00 EB 32 00 01 07 D5 30 00 EC' - '32 00 01 07 D8 30 00 ED 32 00 01 07 DB 30 00 EE 32 00 01 07 DE 30 00 EF 32 00 01 07 DF 30 00 F0' - '32 00 01 07 E0 30 00 F1 32 00 01 07 E1 30 00 F2 32 00 01 07 E2 30 00 F3 32 00 01 07 E4 30 00 F4' - '32 00 01 07 E6 30 00 F5 32 00 01 07 E8 30 00 F6 32 00 01 07 E9 30 00 F7 32 00 01 07 EA 30 00 F8' - '32 00 01 07 EB 30 00 F9 32 00 01 07 EC 30 00 FA 32 00 01 07 ED 30 00 FB 32 00 01 07 EF 30 00 FC' - '32 00 01 07 F0 30 00 FD 32 00 01 07 F1 30 00 FE 32 00 01 07 F2 30 00 FF 32 00 02 0E E4 4E 00 8C' - '54 00 00 33 00 05 0E A2 30 00 CF 30 00 9A 30 00 FC 30 00 C8 30 00 01 33 00 04 0E A2 30 00 EB 30' - '00 D5 30 00 A1 30 00 02 33 00 05 0E A2 30 00 F3 30 00 D8 30 00 9A 30 00 A2 30 00 03 33 00 03 0E' - 'A2 30 00 FC 30 00 EB 30 00 04 33 00 05 0E A4 30 00 CB 30 00 F3 30 00 AF 30 00 99 30 00 05 33 00' - '03 0E A4 30 00 F3 30 00 C1 30 00 06 33 00 03 0E A6 30 00 A9 30 00 F3 30 00 07 33 00 06 0E A8 30' - '00 B9 30 00 AF 30 00 FC 30 00 C8 30 00 99 30 00 08 33 00 04 0E A8 30 00 FC 30 00 AB 30 00 FC 30' - '00 09 33 00 03 0E AA 30 00 F3 30 00 B9 30 00 0A 33 00 03 0E AA 30 00 FC 30 00 E0 30 00 0B 33 00' - '03 0E AB 30 00 A4 30 00 EA 30 00 0C 33 00 04 0E AB 30 00 E9 30 00 C3 30 00 C8 30 00 0D 33 00 04' - '0E AB 30 00 ED 30 00 EA 30 00 FC 30 00 0E 33 00 04 0E AB 30 00 99 30 00 ED 30 00 F3 30 00 0F 33' - '00 04 0E AB 30 00 99 30 00 F3 30 00 DE 30 00 10 33 00 06 0E AD 30 00 99 30 00 AD 30 00 99 30 00' - 'AB 30 00 99 30 00 11 33 00 04 0E AD 30 00 99 30 00 CB 30 00 FC 30 00 12 33 00 04 0E AD 30 00 E5' - '30 00 EA 30 00 FC 30 00 13 33 00 08 0E AD 30 00 99 30 00 EB 30 00 AD 30 00 99 30 00 BF 30 00 99' - '30 00 FC 30 00 14 33 00 02 0E AD 30 00 ED 30 00 15 33 00 06 0E AD 30 00 ED 30 00 AF 30 00 99 30' - '00 E9 30 00 E0 30 00 16 33 00 06 0E AD 30 00 ED 30 00 E1 30 00 FC 30 00 C8 30 00 EB 30 00 17 33' - '00 05 0E AD 30 00 ED 30 00 EF 30 00 C3 30 00 C8 30 00 18 33 00 04 0E AF 30 00 99 30 00 E9 30 00' - 'E0 30 00 19 33 00 06 0E AF 30 00 99 30 00 E9 30 00 E0 30 00 C8 30 00 F3 30 00 1A 33 00 06 0E AF' - '30 00 EB 30 00 BB 30 00 99 30 00 A4 30 00 ED 30 00 1B 33 00 04 0E AF 30 00 ED 30 00 FC 30 00 CD' - '30 00 1C 33 00 03 0E B1 30 00 FC 30 00 B9 30 00 1D 33 00 03 0E B3 30 00 EB 30 00 CA 30 00 1E 33' - '00 04 0E B3 30 00 FC 30 00 DB 30 00 9A 30 00 1F 33 00 04 0E B5 30 00 A4 30 00 AF 30 00 EB 30 00' - '20 33 00 05 0E B5 30 00 F3 30 00 C1 30 00 FC 30 00 E0 30 00 21 33 00 05 0E B7 30 00 EA 30 00 F3' - '30 00 AF 30 00 99 30 00 22 33 00 03 0E BB 30 00 F3 30 00 C1 30 00 23 33 00 03 0E BB 30 00 F3 30' - '00 C8 30 00 24 33 00 04 0E BF 30 00 99 30 00 FC 30 00 B9 30 00 25 33 00 03 0E C6 30 00 99 30 00' - 'B7 30 00 26 33 00 03 0E C8 30 00 99 30 00 EB 30 00 27 33 00 02 0E C8 30 00 F3 30 00 28 33 00 02' - '0E CA 30 00 CE 30 00 29 33 00 03 0E CE 30 00 C3 30 00 C8 30 00 2A 33 00 03 0E CF 30 00 A4 30 00' - 'C4 30 00 2B 33 00 06 0E CF 30 00 9A 30 00 FC 30 00 BB 30 00 F3 30 00 C8 30 00 2C 33 00 04 0E CF' - '30 00 9A 30 00 FC 30 00 C4 30 00 2D 33 00 05 0E CF 30 00 99 30 00 FC 30 00 EC 30 00 EB 30 00 2E' - '33 00 06 0E D2 30 00 9A 30 00 A2 30 00 B9 30 00 C8 30 00 EB 30 00 2F 33 00 04 0E D2 30 00 9A 30' - '00 AF 30 00 EB 30 00 30 33 00 03 0E D2 30 00 9A 30 00 B3 30 00 31 33 00 03 0E D2 30 00 99 30 00' - 'EB 30 00 32 33 00 06 0E D5 30 00 A1 30 00 E9 30 00 C3 30 00 C8 30 00 99 30 00 33 33 00 04 0E D5' - '30 00 A3 30 00 FC 30 00 C8 30 00 34 33 00 06 0E D5 30 00 99 30 00 C3 30 00 B7 30 00 A7 30 00 EB' - '30 00 35 33 00 03 0E D5 30 00 E9 30 00 F3 30 00 36 33 00 05 0E D8 30 00 AF 30 00 BF 30 00 FC 30' - '00 EB 30 00 37 33 00 03 0E D8 30 00 9A 30 00 BD 30 00 38 33 00 04 0E D8 30 00 9A 30 00 CB 30 00' - 'D2 30 00 39 33 00 03 0E D8 30 00 EB 30 00 C4 30 00 3A 33 00 04 0E D8 30 00 9A 30 00 F3 30 00 B9' - '30 00 3B 33 00 07 0E D8 30 00 9A 30 00 FC 30 00 D8 30 00 9A 30 00 B7 30 00 99 30 00 3C 33 00 04' - '0E D8 30 00 99 30 00 FC 30 00 BF 30 00 3D 33 00 05 0E DB 30 00 9A 30 00 A4 30 00 F3 30 00 C8 30' - '00 3E 33 00 04 0E DB 30 00 99 30 00 EB 30 00 C8 30 00 3F 33 00 02 0E DB 30 00 F3 30 00 40 33 00' - '07 0E DB 30 00 9A 30 00 F3 30 00 DB 30 00 9A 30 00 C8 30 00 99 30 00 41 33 00 03 0E DB 30 00 FC' - '30 00 EB 30 00 42 33 00 03 0E DB 30 00 FC 30 00 F3 30 00 43 33 00 04 0E DE 30 00 A4 30 00 AF 30' - '00 ED 30 00 44 33 00 03 0E DE 30 00 A4 30 00 EB 30 00 45 33 00 03 0E DE 30 00 C3 30 00 CF 30 00' - '46 33 00 03 0E DE 30 00 EB 30 00 AF 30 00 47 33 00 05 0E DE 30 00 F3 30 00 B7 30 00 E7 30 00 F3' - '30 00 48 33 00 04 0E DF 30 00 AF 30 00 ED 30 00 F3 30 00 49 33 00 02 0E DF 30 00 EA 30 00 4A 33' - '00 06 0E DF 30 00 EA 30 00 CF 30 00 99 30 00 FC 30 00 EB 30 00 4B 33 00 03 0E E1 30 00 AB 30 00' - '99 30 00 4C 33 00 05 0E E1 30 00 AB 30 00 99 30 00 C8 30 00 F3 30 00 4D 33 00 04 0E E1 30 00 FC' - '30 00 C8 30 00 EB 30 00 4E 33 00 04 0E E4 30 00 FC 30 00 C8 30 00 99 30 00 4F 33 00 03 0E E4 30' - '00 FC 30 00 EB 30 00 50 33 00 03 0E E6 30 00 A2 30 00 F3 30 00 51 33 00 04 0E EA 30 00 C3 30 00' - 'C8 30 00 EB 30 00 52 33 00 02 0E EA 30 00 E9 30 00 53 33 00 04 0E EB 30 00 D2 30 00 9A 30 00 FC' - '30 00 54 33 00 05 0E EB 30 00 FC 30 00 D5 30 00 99 30 00 EB 30 00 55 33 00 02 0E EC 30 00 E0 30' - '00 56 33 00 06 0E EC 30 00 F3 30 00 C8 30 00 B1 30 00 99 30 00 F3 30 00 57 33 00 03 0E EF 30 00' - 'C3 30 00 C8 30 00 58 33 00 02 10 30 00 00 B9 70 00 59 33 00 02 10 31 00 00 B9 70 00 5A 33 00 02' - '10 32 00 00 B9 70 00 5B 33 00 02 10 33 00 00 B9 70 00 5C 33 00 02 10 34 00 00 B9 70 00 5D 33 00' - '02 10 35 00 00 B9 70 00 5E 33 00 02 10 36 00 00 B9 70 00 5F 33 00 02 10 37 00 00 B9 70 00 60 33' - '00 02 10 38 00 00 B9 70 00 61 33 00 02 10 39 00 00 B9 70 00 62 33 00 03 10 31 00 00 30 00 00 B9' - '70 00 63 33 00 03 10 31 00 00 31 00 00 B9 70 00 64 33 00 03 10 31 00 00 32 00 00 B9 70 00 65 33' - '00 03 10 31 00 00 33 00 00 B9 70 00 66 33 00 03 10 31 00 00 34 00 00 B9 70 00 67 33 00 03 10 31' - '00 00 35 00 00 B9 70 00 68 33 00 03 10 31 00 00 36 00 00 B9 70 00 69 33 00 03 10 31 00 00 37 00' - '00 B9 70 00 6A 33 00 03 10 31 00 00 38 00 00 B9 70 00 6B 33 00 03 10 31 00 00 39 00 00 B9 70 00' - '6C 33 00 03 10 32 00 00 30 00 00 B9 70 00 6D 33 00 03 10 32 00 00 31 00 00 B9 70 00 6E 33 00 03' - '10 32 00 00 32 00 00 B9 70 00 6F 33 00 03 10 32 00 00 33 00 00 B9 70 00 70 33 00 03 10 32 00 00' - '34 00 00 B9 70 00 71 33 00 03 0E 68 00 00 50 00 00 61 00 00 72 33 00 02 0E 64 00 00 61 00 00 73' - '33 00 02 0E 41 00 00 55 00 00 74 33 00 03 0E 62 00 00 61 00 00 72 00 00 75 33 00 02 0E 6F 00 00' - '56 00 00 76 33 00 02 0E 70 00 00 63 00 00 77 33 00 02 0E 64 00 00 6D 00 00 78 33 00 03 0E 64 00' - '00 6D 00 00 32 00 00 79 33 00 03 0E 64 00 00 6D 00 00 33 00 00 7A 33 00 02 0E 49 00 00 55 00 00' - '7B 33 00 02 0E 73 5E 00 10 62 00 7C 33 00 02 0E 2D 66 00 8C 54 00 7D 33 00 02 0E 27 59 00 63 6B' - '00 7E 33 00 02 0E 0E 66 00 BB 6C 00 7F 33 00 04 0E 2A 68 00 0F 5F 00 1A 4F 00 3E 79 00 80 33 00' - '02 0E 70 00 00 41 00 00 81 33 00 02 0E 6E 00 00 41 00 00 82 33 00 02 0E BC 03 00 41 00 00 83 33' - '00 02 0E 6D 00 00 41 00 00 84 33 00 02 0E 6B 00 00 41 00 00 85 33 00 02 0E 4B 00 00 42 00 00 86' - '33 00 02 0E 4D 00 00 42 00 00 87 33 00 02 0E 47 00 00 42 00 00 88 33 00 03 0E 63 00 00 61 00 00' - '6C 00 00 89 33 00 04 0E 6B 00 00 63 00 00 61 00 00 6C 00 00 8A 33 00 02 0E 70 00 00 46 00 00 8B' - '33 00 02 0E 6E 00 00 46 00 00 8C 33 00 02 0E BC 03 00 46 00 00 8D 33 00 02 0E BC 03 00 67 00 00' - '8E 33 00 02 0E 6D 00 00 67 00 00 8F 33 00 02 0E 6B 00 00 67 00 00 90 33 00 02 0E 48 00 00 7A 00' - '00 91 33 00 03 0E 6B 00 00 48 00 00 7A 00 00 92 33 00 03 0E 4D 00 00 48 00 00 7A 00 00 93 33 00' - '03 0E 47 00 00 48 00 00 7A 00 00 94 33 00 03 0E 54 00 00 48 00 00 7A 00 00 95 33 00 02 0E BC 03' - '00 6C 00 00 96 33 00 02 0E 6D 00 00 6C 00 00 97 33 00 02 0E 64 00 00 6C 00 00 98 33 00 02 0E 6B' - '00 00 6C 00 00 99 33 00 02 0E 66 00 00 6D 00 00 9A 33 00 02 0E 6E 00 00 6D 00 00 9B 33 00 02 0E' - 'BC 03 00 6D 00 00 9C 33 00 02 0E 6D 00 00 6D 00 00 9D 33 00 02 0E 63 00 00 6D 00 00 9E 33 00 02' - '0E 6B 00 00 6D 00 00 9F 33 00 03 0E 6D 00 00 6D 00 00 32 00 00 A0 33 00 03 0E 63 00 00 6D 00 00' - '32 00 00 A1 33 00 02 0E 6D 00 00 32 00 00 A2 33 00 03 0E 6B 00 00 6D 00 00 32 00 00 A3 33 00 03' - '0E 6D 00 00 6D 00 00 33 00 00 A4 33 00 03 0E 63 00 00 6D 00 00 33 00 00 A5 33 00 02 0E 6D 00 00' - '33 00 00 A6 33 00 03 0E 6B 00 00 6D 00 00 33 00 00 A7 33 00 03 0E 6D 00 00 15 22 00 73 00 00 A8' - '33 00 04 0E 6D 00 00 15 22 00 73 00 00 32 00 00 A9 33 00 02 0E 50 00 00 61 00 00 AA 33 00 03 0E' - '6B 00 00 50 00 00 61 00 00 AB 33 00 03 0E 4D 00 00 50 00 00 61 00 00 AC 33 00 03 0E 47 00 00 50' - '00 00 61 00 00 AD 33 00 03 0E 72 00 00 61 00 00 64 00 00 AE 33 00 05 0E 72 00 00 61 00 00 64 00' - '00 15 22 00 73 00 00 AF 33 00 06 0E 72 00 00 61 00 00 64 00 00 15 22 00 73 00 00 32 00 00 B0 33' - '00 02 0E 70 00 00 73 00 00 B1 33 00 02 0E 6E 00 00 73 00 00 B2 33 00 02 0E BC 03 00 73 00 00 B3' - '33 00 02 0E 6D 00 00 73 00 00 B4 33 00 02 0E 70 00 00 56 00 00 B5 33 00 02 0E 6E 00 00 56 00 00' - 'B6 33 00 02 0E BC 03 00 56 00 00 B7 33 00 02 0E 6D 00 00 56 00 00 B8 33 00 02 0E 6B 00 00 56 00' - '00 B9 33 00 02 0E 4D 00 00 56 00 00 BA 33 00 02 0E 70 00 00 57 00 00 BB 33 00 02 0E 6E 00 00 57' - '00 00 BC 33 00 02 0E BC 03 00 57 00 00 BD 33 00 02 0E 6D 00 00 57 00 00 BE 33 00 02 0E 6B 00 00' - '57 00 00 BF 33 00 02 0E 4D 00 00 57 00 00 C0 33 00 02 0E 6B 00 00 A9 03 00 C1 33 00 02 0E 4D 00' - '00 A9 03 00 C2 33 00 04 0E 61 00 00 2E 00 00 6D 00 00 2E 00 00 C3 33 00 02 0E 42 00 00 71 00 00' - 'C4 33 00 02 0E 63 00 00 63 00 00 C5 33 00 02 0E 63 00 00 64 00 00 C6 33 00 04 0E 43 00 00 15 22' - '00 6B 00 00 67 00 00 C7 33 00 03 0E 43 00 00 6F 00 00 2E 00 00 C8 33 00 02 0E 64 00 00 42 00 00' - 'C9 33 00 02 0E 47 00 00 79 00 00 CA 33 00 02 0E 68 00 00 61 00 00 CB 33 00 02 0E 48 00 00 50 00' - '00 CC 33 00 02 0E 69 00 00 6E 00 00 CD 33 00 02 0E 4B 00 00 4B 00 00 CE 33 00 02 0E 4B 00 00 4D' - '00 00 CF 33 00 02 0E 6B 00 00 74 00 00 D0 33 00 02 0E 6C 00 00 6D 00 00 D1 33 00 02 0E 6C 00 00' - '6E 00 00 D2 33 00 03 0E 6C 00 00 6F 00 00 67 00 00 D3 33 00 02 0E 6C 00 00 78 00 00 D4 33 00 02' - '0E 6D 00 00 62 00 00 D5 33 00 03 0E 6D 00 00 69 00 00 6C 00 00 D6 33 00 03 0E 6D 00 00 6F 00 00' - '6C 00 00 D7 33 00 02 0E 50 00 00 48 00 00 D8 33 00 04 0E 70 00 00 2E 00 00 6D 00 00 2E 00 00 D9' - '33 00 03 0E 50 00 00 50 00 00 4D 00 00 DA 33 00 02 0E 50 00 00 52 00 00 DB 33 00 02 0E 73 00 00' - '72 00 00 DC 33 00 02 0E 53 00 00 76 00 00 DD 33 00 02 0E 57 00 00 62 00 00 DE 33 00 03 0E 56 00' - '00 15 22 00 6D 00 00 DF 33 00 03 0E 41 00 00 15 22 00 6D 00 00 E0 33 00 02 10 31 00 00 E5 65 00' - 'E1 33 00 02 10 32 00 00 E5 65 00 E2 33 00 02 10 33 00 00 E5 65 00 E3 33 00 02 10 34 00 00 E5 65' - '00 E4 33 00 02 10 35 00 00 E5 65 00 E5 33 00 02 10 36 00 00 E5 65 00 E6 33 00 02 10 37 00 00 E5' - '65 00 E7 33 00 02 10 38 00 00 E5 65 00 E8 33 00 02 10 39 00 00 E5 65 00 E9 33 00 03 10 31 00 00' - '30 00 00 E5 65 00 EA 33 00 03 10 31 00 00 31 00 00 E5 65 00 EB 33 00 03 10 31 00 00 32 00 00 E5' - '65 00 EC 33 00 03 10 31 00 00 33 00 00 E5 65 00 ED 33 00 03 10 31 00 00 34 00 00 E5 65 00 EE 33' - '00 03 10 31 00 00 35 00 00 E5 65 00 EF 33 00 03 10 31 00 00 36 00 00 E5 65 00 F0 33 00 03 10 31' - '00 00 37 00 00 E5 65 00 F1 33 00 03 10 31 00 00 38 00 00 E5 65 00 F2 33 00 03 10 31 00 00 39 00' - '00 E5 65 00 F3 33 00 03 10 32 00 00 30 00 00 E5 65 00 F4 33 00 03 10 32 00 00 31 00 00 E5 65 00' - 'F5 33 00 03 10 32 00 00 32 00 00 E5 65 00 F6 33 00 03 10 32 00 00 33 00 00 E5 65 00 F7 33 00 03' - '10 32 00 00 34 00 00 E5 65 00 F8 33 00 03 10 32 00 00 35 00 00 E5 65 00 F9 33 00 03 10 32 00 00' - '36 00 00 E5 65 00 FA 33 00 03 10 32 00 00 37 00 00 E5 65 00 FB 33 00 03 10 32 00 00 38 00 00 E5' - '65 00 FC 33 00 03 10 32 00 00 39 00 00 E5 65 00 FD 33 00 03 10 33 00 00 30 00 00 E5 65 00 FE 33' - '00 03 10 33 00 00 31 00 00 E5 65 00 FF 33 00 03 0E 67 00 00 61 00 00 6C 00 00 9C A6 00 01 08 4A' - '04 00 9D A6 00 01 08 4C 04 00 70 A7 00 01 08 6F A7 00 F8 A7 00 01 08 26 01 00 F9 A7 00 01 08 53' - '01 00 5C AB 00 01 08 27 A7 00 5D AB 00 01 08 37 AB 00 5E AB 00 01 08 6B 02 00 5F AB 00 01 08 52' - 'AB 00 69 AB 00 01 08 8D 02 00 00 F9 00 01 00 48 8C 00 01 F9 00 01 00 F4 66 00 02 F9 00 01 00 CA' - '8E 00 03 F9 00 01 00 C8 8C 00 04 F9 00 01 00 D1 6E 00 05 F9 00 01 00 32 4E 00 06 F9 00 01 00 E5' - '53 00 07 F9 00 01 00 9C 9F 00 08 F9 00 01 00 9C 9F 00 09 F9 00 01 00 51 59 00 0A F9 00 01 00 D1' - '91 00 0B F9 00 01 00 87 55 00 0C F9 00 01 00 48 59 00 0D F9 00 01 00 F6 61 00 0E F9 00 01 00 69' - '76 00 0F F9 00 01 00 85 7F 00 10 F9 00 01 00 3F 86 00 11 F9 00 01 00 BA 87 00 12 F9 00 01 00 F8' - '88 00 13 F9 00 01 00 8F 90 00 14 F9 00 01 00 02 6A 00 15 F9 00 01 00 1B 6D 00 16 F9 00 01 00 D9' - '70 00 17 F9 00 01 00 DE 73 00 18 F9 00 01 00 3D 84 00 19 F9 00 01 00 6A 91 00 1A F9 00 01 00 F1' - '99 00 1B F9 00 01 00 82 4E 00 1C F9 00 01 00 75 53 00 1D F9 00 01 00 04 6B 00 1E F9 00 01 00 1B' - '72 00 1F F9 00 01 00 2D 86 00 20 F9 00 01 00 1E 9E 00 21 F9 00 01 00 50 5D 00 22 F9 00 01 00 EB' - '6F 00 23 F9 00 01 00 CD 85 00 24 F9 00 01 00 64 89 00 25 F9 00 01 00 C9 62 00 26 F9 00 01 00 D8' - '81 00 27 F9 00 01 00 1F 88 00 28 F9 00 01 00 CA 5E 00 29 F9 00 01 00 17 67 00 2A F9 00 01 00 6A' - '6D 00 2B F9 00 01 00 FC 72 00 2C F9 00 01 00 CE 90 00 2D F9 00 01 00 86 4F 00 2E F9 00 01 00 B7' - '51 00 2F F9 00 01 00 DE 52 00 30 F9 00 01 00 C4 64 00 31 F9 00 01 00 D3 6A 00 32 F9 00 01 00 10' - '72 00 33 F9 00 01 00 E7 76 00 34 F9 00 01 00 01 80 00 35 F9 00 01 00 06 86 00 36 F9 00 01 00 5C' - '86 00 37 F9 00 01 00 EF 8D 00 38 F9 00 01 00 32 97 00 39 F9 00 01 00 6F 9B 00 3A F9 00 01 00 FA' - '9D 00 3B F9 00 01 00 8C 78 00 3C F9 00 01 00 7F 79 00 3D F9 00 01 00 A0 7D 00 3E F9 00 01 00 C9' - '83 00 3F F9 00 01 00 04 93 00 40 F9 00 01 00 7F 9E 00 41 F9 00 01 00 D6 8A 00 42 F9 00 01 00 DF' - '58 00 43 F9 00 01 00 04 5F 00 44 F9 00 01 00 60 7C 00 45 F9 00 01 00 7E 80 00 46 F9 00 01 00 62' - '72 00 47 F9 00 01 00 CA 78 00 48 F9 00 01 00 C2 8C 00 49 F9 00 01 00 F7 96 00 4A F9 00 01 00 D8' - '58 00 4B F9 00 01 00 62 5C 00 4C F9 00 01 00 13 6A 00 4D F9 00 01 00 DA 6D 00 4E F9 00 01 00 0F' - '6F 00 4F F9 00 01 00 2F 7D 00 50 F9 00 01 00 37 7E 00 51 F9 00 01 00 4B 96 00 52 F9 00 01 00 D2' - '52 00 53 F9 00 01 00 8B 80 00 54 F9 00 01 00 DC 51 00 55 F9 00 01 00 CC 51 00 56 F9 00 01 00 1C' - '7A 00 57 F9 00 01 00 BE 7D 00 58 F9 00 01 00 F1 83 00 59 F9 00 01 00 75 96 00 5A F9 00 01 00 80' - '8B 00 5B F9 00 01 00 CF 62 00 5C F9 00 01 00 02 6A 00 5D F9 00 01 00 FE 8A 00 5E F9 00 01 00 39' - '4E 00 5F F9 00 01 00 E7 5B 00 60 F9 00 01 00 12 60 00 61 F9 00 01 00 87 73 00 62 F9 00 01 00 70' - '75 00 63 F9 00 01 00 17 53 00 64 F9 00 01 00 FB 78 00 65 F9 00 01 00 BF 4F 00 66 F9 00 01 00 A9' - '5F 00 67 F9 00 01 00 0D 4E 00 68 F9 00 01 00 CC 6C 00 69 F9 00 01 00 78 65 00 6A F9 00 01 00 22' - '7D 00 6B F9 00 01 00 C3 53 00 6C F9 00 01 00 5E 58 00 6D F9 00 01 00 01 77 00 6E F9 00 01 00 49' - '84 00 6F F9 00 01 00 AA 8A 00 70 F9 00 01 00 BA 6B 00 71 F9 00 01 00 B0 8F 00 72 F9 00 01 00 88' - '6C 00 73 F9 00 01 00 FE 62 00 74 F9 00 01 00 E5 82 00 75 F9 00 01 00 A0 63 00 76 F9 00 01 00 65' - '75 00 77 F9 00 01 00 AE 4E 00 78 F9 00 01 00 69 51 00 79 F9 00 01 00 C9 51 00 7A F9 00 01 00 81' - '68 00 7B F9 00 01 00 E7 7C 00 7C F9 00 01 00 6F 82 00 7D F9 00 01 00 D2 8A 00 7E F9 00 01 00 CF' - '91 00 7F F9 00 01 00 F5 52 00 80 F9 00 01 00 42 54 00 81 F9 00 01 00 73 59 00 82 F9 00 01 00 EC' - '5E 00 83 F9 00 01 00 C5 65 00 84 F9 00 01 00 FE 6F 00 85 F9 00 01 00 2A 79 00 86 F9 00 01 00 AD' - '95 00 87 F9 00 01 00 6A 9A 00 88 F9 00 01 00 97 9E 00 89 F9 00 01 00 CE 9E 00 8A F9 00 01 00 9B' - '52 00 8B F9 00 01 00 C6 66 00 8C F9 00 01 00 77 6B 00 8D F9 00 01 00 62 8F 00 8E F9 00 01 00 74' - '5E 00 8F F9 00 01 00 90 61 00 90 F9 00 01 00 00 62 00 91 F9 00 01 00 9A 64 00 92 F9 00 01 00 23' - '6F 00 93 F9 00 01 00 49 71 00 94 F9 00 01 00 89 74 00 95 F9 00 01 00 CA 79 00 96 F9 00 01 00 F4' - '7D 00 97 F9 00 01 00 6F 80 00 98 F9 00 01 00 26 8F 00 99 F9 00 01 00 EE 84 00 9A F9 00 01 00 23' - '90 00 9B F9 00 01 00 4A 93 00 9C F9 00 01 00 17 52 00 9D F9 00 01 00 A3 52 00 9E F9 00 01 00 BD' - '54 00 9F F9 00 01 00 C8 70 00 A0 F9 00 01 00 C2 88 00 A1 F9 00 01 00 AA 8A 00 A2 F9 00 01 00 C9' - '5E 00 A3 F9 00 01 00 F5 5F 00 A4 F9 00 01 00 7B 63 00 A5 F9 00 01 00 AE 6B 00 A6 F9 00 01 00 3E' - '7C 00 A7 F9 00 01 00 75 73 00 A8 F9 00 01 00 E4 4E 00 A9 F9 00 01 00 F9 56 00 AA F9 00 01 00 E7' - '5B 00 AB F9 00 01 00 BA 5D 00 AC F9 00 01 00 1C 60 00 AD F9 00 01 00 B2 73 00 AE F9 00 01 00 69' - '74 00 AF F9 00 01 00 9A 7F 00 B0 F9 00 01 00 46 80 00 B1 F9 00 01 00 34 92 00 B2 F9 00 01 00 F6' - '96 00 B3 F9 00 01 00 48 97 00 B4 F9 00 01 00 18 98 00 B5 F9 00 01 00 8B 4F 00 B6 F9 00 01 00 AE' - '79 00 B7 F9 00 01 00 B4 91 00 B8 F9 00 01 00 B8 96 00 B9 F9 00 01 00 E1 60 00 BA F9 00 01 00 86' - '4E 00 BB F9 00 01 00 DA 50 00 BC F9 00 01 00 EE 5B 00 BD F9 00 01 00 3F 5C 00 BE F9 00 01 00 99' - '65 00 BF F9 00 01 00 02 6A 00 C0 F9 00 01 00 CE 71 00 C1 F9 00 01 00 42 76 00 C2 F9 00 01 00 FC' - '84 00 C3 F9 00 01 00 7C 90 00 C4 F9 00 01 00 8D 9F 00 C5 F9 00 01 00 88 66 00 C6 F9 00 01 00 2E' - '96 00 C7 F9 00 01 00 89 52 00 C8 F9 00 01 00 7B 67 00 C9 F9 00 01 00 F3 67 00 CA F9 00 01 00 41' - '6D 00 CB F9 00 01 00 9C 6E 00 CC F9 00 01 00 09 74 00 CD F9 00 01 00 59 75 00 CE F9 00 01 00 6B' - '78 00 CF F9 00 01 00 10 7D 00 D0 F9 00 01 00 5E 98 00 D1 F9 00 01 00 6D 51 00 D2 F9 00 01 00 2E' - '62 00 D3 F9 00 01 00 78 96 00 D4 F9 00 01 00 2B 50 00 D5 F9 00 01 00 19 5D 00 D6 F9 00 01 00 EA' - '6D 00 D7 F9 00 01 00 2A 8F 00 D8 F9 00 01 00 8B 5F 00 D9 F9 00 01 00 44 61 00 DA F9 00 01 00 17' - '68 00 DB F9 00 01 00 87 73 00 DC F9 00 01 00 86 96 00 DD F9 00 01 00 29 52 00 DE F9 00 01 00 0F' - '54 00 DF F9 00 01 00 65 5C 00 E0 F9 00 01 00 13 66 00 E1 F9 00 01 00 4E 67 00 E2 F9 00 01 00 A8' - '68 00 E3 F9 00 01 00 E5 6C 00 E4 F9 00 01 00 06 74 00 E5 F9 00 01 00 E2 75 00 E6 F9 00 01 00 79' - '7F 00 E7 F9 00 01 00 CF 88 00 E8 F9 00 01 00 E1 88 00 E9 F9 00 01 00 CC 91 00 EA F9 00 01 00 E2' - '96 00 EB F9 00 01 00 3F 53 00 EC F9 00 01 00 BA 6E 00 ED F9 00 01 00 1D 54 00 EE F9 00 01 00 D0' - '71 00 EF F9 00 01 00 98 74 00 F0 F9 00 01 00 FA 85 00 F1 F9 00 01 00 A3 96 00 F2 F9 00 01 00 57' - '9C 00 F3 F9 00 01 00 9F 9E 00 F4 F9 00 01 00 97 67 00 F5 F9 00 01 00 CB 6D 00 F6 F9 00 01 00 E8' - '81 00 F7 F9 00 01 00 CB 7A 00 F8 F9 00 01 00 20 7B 00 F9 F9 00 01 00 92 7C 00 FA F9 00 01 00 C0' - '72 00 FB F9 00 01 00 99 70 00 FC F9 00 01 00 58 8B 00 FD F9 00 01 00 C0 4E 00 FE F9 00 01 00 36' - '83 00 FF F9 00 01 00 3A 52 00 00 FA 00 01 00 07 52 00 01 FA 00 01 00 A6 5E 00 02 FA 00 01 00 D3' - '62 00 03 FA 00 01 00 D6 7C 00 04 FA 00 01 00 85 5B 00 05 FA 00 01 00 1E 6D 00 06 FA 00 01 00 B4' - '66 00 07 FA 00 01 00 3B 8F 00 08 FA 00 01 00 4C 88 00 09 FA 00 01 00 4D 96 00 0A FA 00 01 00 8B' - '89 00 0B FA 00 01 00 D3 5E 00 0C FA 00 01 00 40 51 00 0D FA 00 01 00 C0 55 00 10 FA 00 01 00 5A' - '58 00 12 FA 00 01 00 74 66 00 15 FA 00 01 00 DE 51 00 16 FA 00 01 00 2A 73 00 17 FA 00 01 00 CA' - '76 00 18 FA 00 01 00 3C 79 00 19 FA 00 01 00 5E 79 00 1A FA 00 01 00 65 79 00 1B FA 00 01 00 8F' - '79 00 1C FA 00 01 00 56 97 00 1D FA 00 01 00 BE 7C 00 1E FA 00 01 00 BD 7F 00 20 FA 00 01 00 12' - '86 00 22 FA 00 01 00 F8 8A 00 25 FA 00 01 00 38 90 00 26 FA 00 01 00 FD 90 00 2A FA 00 01 00 EF' - '98 00 2B FA 00 01 00 FC 98 00 2C FA 00 01 00 28 99 00 2D FA 00 01 00 B4 9D 00 2E FA 00 01 00 DE' - '90 00 2F FA 00 01 00 B7 96 00 30 FA 00 01 00 AE 4F 00 31 FA 00 01 00 E7 50 00 32 FA 00 01 00 4D' - '51 00 33 FA 00 01 00 C9 52 00 34 FA 00 01 00 E4 52 00 35 FA 00 01 00 51 53 00 36 FA 00 01 00 9D' - '55 00 37 FA 00 01 00 06 56 00 38 FA 00 01 00 68 56 00 39 FA 00 01 00 40 58 00 3A FA 00 01 00 A8' - '58 00 3B FA 00 01 00 64 5C 00 3C FA 00 01 00 6E 5C 00 3D FA 00 01 00 94 60 00 3E FA 00 01 00 68' - '61 00 3F FA 00 01 00 8E 61 00 40 FA 00 01 00 F2 61 00 41 FA 00 01 00 4F 65 00 42 FA 00 01 00 E2' - '65 00 43 FA 00 01 00 91 66 00 44 FA 00 01 00 85 68 00 45 FA 00 01 00 77 6D 00 46 FA 00 01 00 1A' - '6E 00 47 FA 00 01 00 22 6F 00 48 FA 00 01 00 6E 71 00 49 FA 00 01 00 2B 72 00 4A FA 00 01 00 22' - '74 00 4B FA 00 01 00 91 78 00 4C FA 00 01 00 3E 79 00 4D FA 00 01 00 49 79 00 4E FA 00 01 00 48' - '79 00 4F FA 00 01 00 50 79 00 50 FA 00 01 00 56 79 00 51 FA 00 01 00 5D 79 00 52 FA 00 01 00 8D' - '79 00 53 FA 00 01 00 8E 79 00 54 FA 00 01 00 40 7A 00 55 FA 00 01 00 81 7A 00 56 FA 00 01 00 C0' - '7B 00 57 FA 00 01 00 F4 7D 00 58 FA 00 01 00 09 7E 00 59 FA 00 01 00 41 7E 00 5A FA 00 01 00 72' - '7F 00 5B FA 00 01 00 05 80 00 5C FA 00 01 00 ED 81 00 5D FA 00 01 00 79 82 00 5E FA 00 01 00 79' - '82 00 5F FA 00 01 00 57 84 00 60 FA 00 01 00 10 89 00 61 FA 00 01 00 96 89 00 62 FA 00 01 00 01' - '8B 00 63 FA 00 01 00 39 8B 00 64 FA 00 01 00 D3 8C 00 65 FA 00 01 00 08 8D 00 66 FA 00 01 00 B6' - '8F 00 67 FA 00 01 00 38 90 00 68 FA 00 01 00 E3 96 00 69 FA 00 01 00 FF 97 00 6A FA 00 01 00 3B' - '98 00 6B FA 00 01 00 75 60 00 6C FA 00 01 00 EE 42 02 6D FA 00 01 00 18 82 00 70 FA 00 01 00 26' - '4E 00 71 FA 00 01 00 B5 51 00 72 FA 00 01 00 68 51 00 73 FA 00 01 00 80 4F 00 74 FA 00 01 00 45' - '51 00 75 FA 00 01 00 80 51 00 76 FA 00 01 00 C7 52 00 77 FA 00 01 00 FA 52 00 78 FA 00 01 00 9D' - '55 00 79 FA 00 01 00 55 55 00 7A FA 00 01 00 99 55 00 7B FA 00 01 00 E2 55 00 7C FA 00 01 00 5A' - '58 00 7D FA 00 01 00 B3 58 00 7E FA 00 01 00 44 59 00 7F FA 00 01 00 54 59 00 80 FA 00 01 00 62' - '5A 00 81 FA 00 01 00 28 5B 00 82 FA 00 01 00 D2 5E 00 83 FA 00 01 00 D9 5E 00 84 FA 00 01 00 69' - '5F 00 85 FA 00 01 00 AD 5F 00 86 FA 00 01 00 D8 60 00 87 FA 00 01 00 4E 61 00 88 FA 00 01 00 08' - '61 00 89 FA 00 01 00 8E 61 00 8A FA 00 01 00 60 61 00 8B FA 00 01 00 F2 61 00 8C FA 00 01 00 34' - '62 00 8D FA 00 01 00 C4 63 00 8E FA 00 01 00 1C 64 00 8F FA 00 01 00 52 64 00 90 FA 00 01 00 56' - '65 00 91 FA 00 01 00 74 66 00 92 FA 00 01 00 17 67 00 93 FA 00 01 00 1B 67 00 94 FA 00 01 00 56' - '67 00 95 FA 00 01 00 79 6B 00 96 FA 00 01 00 BA 6B 00 97 FA 00 01 00 41 6D 00 98 FA 00 01 00 DB' - '6E 00 99 FA 00 01 00 CB 6E 00 9A FA 00 01 00 22 6F 00 9B FA 00 01 00 1E 70 00 9C FA 00 01 00 6E' - '71 00 9D FA 00 01 00 A7 77 00 9E FA 00 01 00 35 72 00 9F FA 00 01 00 AF 72 00 A0 FA 00 01 00 2A' - '73 00 A1 FA 00 01 00 71 74 00 A2 FA 00 01 00 06 75 00 A3 FA 00 01 00 3B 75 00 A4 FA 00 01 00 1D' - '76 00 A5 FA 00 01 00 1F 76 00 A6 FA 00 01 00 CA 76 00 A7 FA 00 01 00 DB 76 00 A8 FA 00 01 00 F4' - '76 00 A9 FA 00 01 00 4A 77 00 AA FA 00 01 00 40 77 00 AB FA 00 01 00 CC 78 00 AC FA 00 01 00 B1' - '7A 00 AD FA 00 01 00 C0 7B 00 AE FA 00 01 00 7B 7C 00 AF FA 00 01 00 5B 7D 00 B0 FA 00 01 00 F4' - '7D 00 B1 FA 00 01 00 3E 7F 00 B2 FA 00 01 00 05 80 00 B3 FA 00 01 00 52 83 00 B4 FA 00 01 00 EF' - '83 00 B5 FA 00 01 00 79 87 00 B6 FA 00 01 00 41 89 00 B7 FA 00 01 00 86 89 00 B8 FA 00 01 00 96' - '89 00 B9 FA 00 01 00 BF 8A 00 BA FA 00 01 00 F8 8A 00 BB FA 00 01 00 CB 8A 00 BC FA 00 01 00 01' - '8B 00 BD FA 00 01 00 FE 8A 00 BE FA 00 01 00 ED 8A 00 BF FA 00 01 00 39 8B 00 C0 FA 00 01 00 8A' - '8B 00 C1 FA 00 01 00 08 8D 00 C2 FA 00 01 00 38 8F 00 C3 FA 00 01 00 72 90 00 C4 FA 00 01 00 99' - '91 00 C5 FA 00 01 00 76 92 00 C6 FA 00 01 00 7C 96 00 C7 FA 00 01 00 E3 96 00 C8 FA 00 01 00 56' - '97 00 C9 FA 00 01 00 DB 97 00 CA FA 00 01 00 FF 97 00 CB FA 00 01 00 0B 98 00 CC FA 00 01 00 3B' - '98 00 CD FA 00 01 00 12 9B 00 CE FA 00 01 00 9C 9F 00 CF FA 00 01 00 4A 28 02 D0 FA 00 01 00 44' - '28 02 D1 FA 00 01 00 D5 33 02 D2 FA 00 01 00 9D 3B 00 D3 FA 00 01 00 18 40 00 D4 FA 00 01 00 39' - '40 00 D5 FA 00 01 00 49 52 02 D6 FA 00 01 00 D0 5C 02 D7 FA 00 01 00 D3 7E 02 D8 FA 00 01 00 43' - '9F 00 D9 FA 00 01 00 8E 9F 00 00 FB 00 02 10 66 00 00 66 00 00 01 FB 00 02 10 66 00 00 69 00 00' - '02 FB 00 02 10 66 00 00 6C 00 00 03 FB 00 03 10 66 00 00 66 00 00 69 00 00 04 FB 00 03 10 66 00' - '00 66 00 00 6C 00 00 05 FB 00 02 10 73 00 00 74 00 00 06 FB 00 02 10 73 00 00 74 00 00 13 FB 00' - '02 10 74 05 00 76 05 00 14 FB 00 02 10 74 05 00 65 05 00 15 FB 00 02 10 74 05 00 6B 05 00 16 FB' - '00 02 10 7E 05 00 76 05 00 17 FB 00 02 10 74 05 00 6D 05 00 1D FB 00 02 00 D9 05 00 B4 05 00 1F' - 'FB 00 02 00 F2 05 00 B7 05 00 20 FB 00 01 01 E2 05 00 21 FB 00 01 01 D0 05 00 22 FB 00 01 01 D3' - '05 00 23 FB 00 01 01 D4 05 00 24 FB 00 01 01 DB 05 00 25 FB 00 01 01 DC 05 00 26 FB 00 01 01 DD' - '05 00 27 FB 00 01 01 E8 05 00 28 FB 00 01 01 EA 05 00 29 FB 00 01 01 2B 00 00 2A FB 00 02 00 E9' - '05 00 C1 05 00 2B FB 00 02 00 E9 05 00 C2 05 00 2C FB 00 03 00 E9 05 00 BC 05 00 C1 05 00 2D FB' - '00 03 00 E9 05 00 BC 05 00 C2 05 00 2E FB 00 02 00 D0 05 00 B7 05 00 2F FB 00 02 00 D0 05 00 B8' - '05 00 30 FB 00 02 00 D0 05 00 BC 05 00 31 FB 00 02 00 D1 05 00 BC 05 00 32 FB 00 02 00 D2 05 00' - 'BC 05 00 33 FB 00 02 00 D3 05 00 BC 05 00 34 FB 00 02 00 D4 05 00 BC 05 00 35 FB 00 02 00 D5 05' - '00 BC 05 00 36 FB 00 02 00 D6 05 00 BC 05 00 38 FB 00 02 00 D8 05 00 BC 05 00 39 FB 00 02 00 D9' - '05 00 BC 05 00 3A FB 00 02 00 DA 05 00 BC 05 00 3B FB 00 02 00 DB 05 00 BC 05 00 3C FB 00 02 00' - 'DC 05 00 BC 05 00 3E FB 00 02 00 DE 05 00 BC 05 00 40 FB 00 02 00 E0 05 00 BC 05 00 41 FB 00 02' - '00 E1 05 00 BC 05 00 43 FB 00 02 00 E3 05 00 BC 05 00 44 FB 00 02 00 E4 05 00 BC 05 00 46 FB 00' - '02 00 E6 05 00 BC 05 00 47 FB 00 02 00 E7 05 00 BC 05 00 48 FB 00 02 00 E8 05 00 BC 05 00 49 FB' - '00 02 00 E9 05 00 BC 05 00 4A FB 00 02 00 EA 05 00 BC 05 00 4B FB 00 02 00 D5 05 00 B9 05 00 4C' - 'FB 00 02 00 D1 05 00 BF 05 00 4D FB 00 02 00 DB 05 00 BF 05 00 4E FB 00 02 00 E4 05 00 BF 05 00' - '4F FB 00 02 10 D0 05 00 DC 05 00 50 FB 00 01 06 71 06 00 51 FB 00 01 05 71 06 00 52 FB 00 01 06' - '7B 06 00 53 FB 00 01 05 7B 06 00 54 FB 00 01 03 7B 06 00 55 FB 00 01 04 7B 06 00 56 FB 00 01 06' - '7E 06 00 57 FB 00 01 05 7E 06 00 58 FB 00 01 03 7E 06 00 59 FB 00 01 04 7E 06 00 5A FB 00 01 06' - '80 06 00 5B FB 00 01 05 80 06 00 5C FB 00 01 03 80 06 00 5D FB 00 01 04 80 06 00 5E FB 00 01 06' - '7A 06 00 5F FB 00 01 05 7A 06 00 60 FB 00 01 03 7A 06 00 61 FB 00 01 04 7A 06 00 62 FB 00 01 06' - '7F 06 00 63 FB 00 01 05 7F 06 00 64 FB 00 01 03 7F 06 00 65 FB 00 01 04 7F 06 00 66 FB 00 01 06' - '79 06 00 67 FB 00 01 05 79 06 00 68 FB 00 01 03 79 06 00 69 FB 00 01 04 79 06 00 6A FB 00 01 06' - 'A4 06 00 6B FB 00 01 05 A4 06 00 6C FB 00 01 03 A4 06 00 6D FB 00 01 04 A4 06 00 6E FB 00 01 06' - 'A6 06 00 6F FB 00 01 05 A6 06 00 70 FB 00 01 03 A6 06 00 71 FB 00 01 04 A6 06 00 72 FB 00 01 06' - '84 06 00 73 FB 00 01 05 84 06 00 74 FB 00 01 03 84 06 00 75 FB 00 01 04 84 06 00 76 FB 00 01 06' - '83 06 00 77 FB 00 01 05 83 06 00 78 FB 00 01 03 83 06 00 79 FB 00 01 04 83 06 00 7A FB 00 01 06' - '86 06 00 7B FB 00 01 05 86 06 00 7C FB 00 01 03 86 06 00 7D FB 00 01 04 86 06 00 7E FB 00 01 06' - '87 06 00 7F FB 00 01 05 87 06 00 80 FB 00 01 03 87 06 00 81 FB 00 01 04 87 06 00 82 FB 00 01 06' - '8D 06 00 83 FB 00 01 05 8D 06 00 84 FB 00 01 06 8C 06 00 85 FB 00 01 05 8C 06 00 86 FB 00 01 06' - '8E 06 00 87 FB 00 01 05 8E 06 00 88 FB 00 01 06 88 06 00 89 FB 00 01 05 88 06 00 8A FB 00 01 06' - '98 06 00 8B FB 00 01 05 98 06 00 8C FB 00 01 06 91 06 00 8D FB 00 01 05 91 06 00 8E FB 00 01 06' - 'A9 06 00 8F FB 00 01 05 A9 06 00 90 FB 00 01 03 A9 06 00 91 FB 00 01 04 A9 06 00 92 FB 00 01 06' - 'AF 06 00 93 FB 00 01 05 AF 06 00 94 FB 00 01 03 AF 06 00 95 FB 00 01 04 AF 06 00 96 FB 00 01 06' - 'B3 06 00 97 FB 00 01 05 B3 06 00 98 FB 00 01 03 B3 06 00 99 FB 00 01 04 B3 06 00 9A FB 00 01 06' - 'B1 06 00 9B FB 00 01 05 B1 06 00 9C FB 00 01 03 B1 06 00 9D FB 00 01 04 B1 06 00 9E FB 00 01 06' - 'BA 06 00 9F FB 00 01 05 BA 06 00 A0 FB 00 01 06 BB 06 00 A1 FB 00 01 05 BB 06 00 A2 FB 00 01 03' - 'BB 06 00 A3 FB 00 01 04 BB 06 00 A4 FB 00 02 06 D5 06 00 54 06 00 A5 FB 00 02 05 D5 06 00 54 06' - '00 A6 FB 00 01 06 C1 06 00 A7 FB 00 01 05 C1 06 00 A8 FB 00 01 03 C1 06 00 A9 FB 00 01 04 C1 06' - '00 AA FB 00 01 06 BE 06 00 AB FB 00 01 05 BE 06 00 AC FB 00 01 03 BE 06 00 AD FB 00 01 04 BE 06' - '00 AE FB 00 01 06 D2 06 00 AF FB 00 01 05 D2 06 00 B0 FB 00 02 06 D2 06 00 54 06 00 B1 FB 00 02' - '05 D2 06 00 54 06 00 D3 FB 00 01 06 AD 06 00 D4 FB 00 01 05 AD 06 00 D5 FB 00 01 03 AD 06 00 D6' - 'FB 00 01 04 AD 06 00 D7 FB 00 01 06 C7 06 00 D8 FB 00 01 05 C7 06 00 D9 FB 00 01 06 C6 06 00 DA' - 'FB 00 01 05 C6 06 00 DB FB 00 01 06 C8 06 00 DC FB 00 01 05 C8 06 00 DD FB 00 02 06 C7 06 00 74' - '06 00 DE FB 00 01 06 CB 06 00 DF FB 00 01 05 CB 06 00 E0 FB 00 01 06 C5 06 00 E1 FB 00 01 05 C5' - '06 00 E2 FB 00 01 06 C9 06 00 E3 FB 00 01 05 C9 06 00 E4 FB 00 01 06 D0 06 00 E5 FB 00 01 05 D0' - '06 00 E6 FB 00 01 03 D0 06 00 E7 FB 00 01 04 D0 06 00 E8 FB 00 01 03 49 06 00 E9 FB 00 01 04 49' - '06 00 EA FB 00 03 06 4A 06 00 54 06 00 27 06 00 EB FB 00 03 05 4A 06 00 54 06 00 27 06 00 EC FB' - '00 03 06 4A 06 00 54 06 00 D5 06 00 ED FB 00 03 05 4A 06 00 54 06 00 D5 06 00 EE FB 00 03 06 4A' - '06 00 54 06 00 48 06 00 EF FB 00 03 05 4A 06 00 54 06 00 48 06 00 F0 FB 00 03 06 4A 06 00 54 06' - '00 C7 06 00 F1 FB 00 03 05 4A 06 00 54 06 00 C7 06 00 F2 FB 00 03 06 4A 06 00 54 06 00 C6 06 00' - 'F3 FB 00 03 05 4A 06 00 54 06 00 C6 06 00 F4 FB 00 03 06 4A 06 00 54 06 00 C8 06 00 F5 FB 00 03' - '05 4A 06 00 54 06 00 C8 06 00 F6 FB 00 03 06 4A 06 00 54 06 00 D0 06 00 F7 FB 00 03 05 4A 06 00' - '54 06 00 D0 06 00 F8 FB 00 03 03 4A 06 00 54 06 00 D0 06 00 F9 FB 00 03 06 4A 06 00 54 06 00 49' - '06 00 FA FB 00 03 05 4A 06 00 54 06 00 49 06 00 FB FB 00 03 03 4A 06 00 54 06 00 49 06 00 FC FB' - '00 01 06 CC 06 00 FD FB 00 01 05 CC 06 00 FE FB 00 01 03 CC 06 00 FF FB 00 01 04 CC 06 00 00 FC' - '00 03 06 4A 06 00 54 06 00 2C 06 00 01 FC 00 03 06 4A 06 00 54 06 00 2D 06 00 02 FC 00 03 06 4A' - '06 00 54 06 00 45 06 00 03 FC 00 03 06 4A 06 00 54 06 00 49 06 00 04 FC 00 03 06 4A 06 00 54 06' - '00 4A 06 00 05 FC 00 02 06 28 06 00 2C 06 00 06 FC 00 02 06 28 06 00 2D 06 00 07 FC 00 02 06 28' - '06 00 2E 06 00 08 FC 00 02 06 28 06 00 45 06 00 09 FC 00 02 06 28 06 00 49 06 00 0A FC 00 02 06' - '28 06 00 4A 06 00 0B FC 00 02 06 2A 06 00 2C 06 00 0C FC 00 02 06 2A 06 00 2D 06 00 0D FC 00 02' - '06 2A 06 00 2E 06 00 0E FC 00 02 06 2A 06 00 45 06 00 0F FC 00 02 06 2A 06 00 49 06 00 10 FC 00' - '02 06 2A 06 00 4A 06 00 11 FC 00 02 06 2B 06 00 2C 06 00 12 FC 00 02 06 2B 06 00 45 06 00 13 FC' - '00 02 06 2B 06 00 49 06 00 14 FC 00 02 06 2B 06 00 4A 06 00 15 FC 00 02 06 2C 06 00 2D 06 00 16' - 'FC 00 02 06 2C 06 00 45 06 00 17 FC 00 02 06 2D 06 00 2C 06 00 18 FC 00 02 06 2D 06 00 45 06 00' - '19 FC 00 02 06 2E 06 00 2C 06 00 1A FC 00 02 06 2E 06 00 2D 06 00 1B FC 00 02 06 2E 06 00 45 06' - '00 1C FC 00 02 06 33 06 00 2C 06 00 1D FC 00 02 06 33 06 00 2D 06 00 1E FC 00 02 06 33 06 00 2E' - '06 00 1F FC 00 02 06 33 06 00 45 06 00 20 FC 00 02 06 35 06 00 2D 06 00 21 FC 00 02 06 35 06 00' - '45 06 00 22 FC 00 02 06 36 06 00 2C 06 00 23 FC 00 02 06 36 06 00 2D 06 00 24 FC 00 02 06 36 06' - '00 2E 06 00 25 FC 00 02 06 36 06 00 45 06 00 26 FC 00 02 06 37 06 00 2D 06 00 27 FC 00 02 06 37' - '06 00 45 06 00 28 FC 00 02 06 38 06 00 45 06 00 29 FC 00 02 06 39 06 00 2C 06 00 2A FC 00 02 06' - '39 06 00 45 06 00 2B FC 00 02 06 3A 06 00 2C 06 00 2C FC 00 02 06 3A 06 00 45 06 00 2D FC 00 02' - '06 41 06 00 2C 06 00 2E FC 00 02 06 41 06 00 2D 06 00 2F FC 00 02 06 41 06 00 2E 06 00 30 FC 00' - '02 06 41 06 00 45 06 00 31 FC 00 02 06 41 06 00 49 06 00 32 FC 00 02 06 41 06 00 4A 06 00 33 FC' - '00 02 06 42 06 00 2D 06 00 34 FC 00 02 06 42 06 00 45 06 00 35 FC 00 02 06 42 06 00 49 06 00 36' - 'FC 00 02 06 42 06 00 4A 06 00 37 FC 00 02 06 43 06 00 27 06 00 38 FC 00 02 06 43 06 00 2C 06 00' - '39 FC 00 02 06 43 06 00 2D 06 00 3A FC 00 02 06 43 06 00 2E 06 00 3B FC 00 02 06 43 06 00 44 06' - '00 3C FC 00 02 06 43 06 00 45 06 00 3D FC 00 02 06 43 06 00 49 06 00 3E FC 00 02 06 43 06 00 4A' - '06 00 3F FC 00 02 06 44 06 00 2C 06 00 40 FC 00 02 06 44 06 00 2D 06 00 41 FC 00 02 06 44 06 00' - '2E 06 00 42 FC 00 02 06 44 06 00 45 06 00 43 FC 00 02 06 44 06 00 49 06 00 44 FC 00 02 06 44 06' - '00 4A 06 00 45 FC 00 02 06 45 06 00 2C 06 00 46 FC 00 02 06 45 06 00 2D 06 00 47 FC 00 02 06 45' - '06 00 2E 06 00 48 FC 00 02 06 45 06 00 45 06 00 49 FC 00 02 06 45 06 00 49 06 00 4A FC 00 02 06' - '45 06 00 4A 06 00 4B FC 00 02 06 46 06 00 2C 06 00 4C FC 00 02 06 46 06 00 2D 06 00 4D FC 00 02' - '06 46 06 00 2E 06 00 4E FC 00 02 06 46 06 00 45 06 00 4F FC 00 02 06 46 06 00 49 06 00 50 FC 00' - '02 06 46 06 00 4A 06 00 51 FC 00 02 06 47 06 00 2C 06 00 52 FC 00 02 06 47 06 00 45 06 00 53 FC' - '00 02 06 47 06 00 49 06 00 54 FC 00 02 06 47 06 00 4A 06 00 55 FC 00 02 06 4A 06 00 2C 06 00 56' - 'FC 00 02 06 4A 06 00 2D 06 00 57 FC 00 02 06 4A 06 00 2E 06 00 58 FC 00 02 06 4A 06 00 45 06 00' - '59 FC 00 02 06 4A 06 00 49 06 00 5A FC 00 02 06 4A 06 00 4A 06 00 5B FC 00 02 06 30 06 00 70 06' - '00 5C FC 00 02 06 31 06 00 70 06 00 5D FC 00 02 06 49 06 00 70 06 00 5E FC 00 03 06 20 00 00 4C' - '06 00 51 06 00 5F FC 00 03 06 20 00 00 4D 06 00 51 06 00 60 FC 00 03 06 20 00 00 4E 06 00 51 06' - '00 61 FC 00 03 06 20 00 00 4F 06 00 51 06 00 62 FC 00 03 06 20 00 00 50 06 00 51 06 00 63 FC 00' - '03 06 20 00 00 51 06 00 70 06 00 64 FC 00 03 05 4A 06 00 54 06 00 31 06 00 65 FC 00 03 05 4A 06' - '00 54 06 00 32 06 00 66 FC 00 03 05 4A 06 00 54 06 00 45 06 00 67 FC 00 03 05 4A 06 00 54 06 00' - '46 06 00 68 FC 00 03 05 4A 06 00 54 06 00 49 06 00 69 FC 00 03 05 4A 06 00 54 06 00 4A 06 00 6A' - 'FC 00 02 05 28 06 00 31 06 00 6B FC 00 02 05 28 06 00 32 06 00 6C FC 00 02 05 28 06 00 45 06 00' - '6D FC 00 02 05 28 06 00 46 06 00 6E FC 00 02 05 28 06 00 49 06 00 6F FC 00 02 05 28 06 00 4A 06' - '00 70 FC 00 02 05 2A 06 00 31 06 00 71 FC 00 02 05 2A 06 00 32 06 00 72 FC 00 02 05 2A 06 00 45' - '06 00 73 FC 00 02 05 2A 06 00 46 06 00 74 FC 00 02 05 2A 06 00 49 06 00 75 FC 00 02 05 2A 06 00' - '4A 06 00 76 FC 00 02 05 2B 06 00 31 06 00 77 FC 00 02 05 2B 06 00 32 06 00 78 FC 00 02 05 2B 06' - '00 45 06 00 79 FC 00 02 05 2B 06 00 46 06 00 7A FC 00 02 05 2B 06 00 49 06 00 7B FC 00 02 05 2B' - '06 00 4A 06 00 7C FC 00 02 05 41 06 00 49 06 00 7D FC 00 02 05 41 06 00 4A 06 00 7E FC 00 02 05' - '42 06 00 49 06 00 7F FC 00 02 05 42 06 00 4A 06 00 80 FC 00 02 05 43 06 00 27 06 00 81 FC 00 02' - '05 43 06 00 44 06 00 82 FC 00 02 05 43 06 00 45 06 00 83 FC 00 02 05 43 06 00 49 06 00 84 FC 00' - '02 05 43 06 00 4A 06 00 85 FC 00 02 05 44 06 00 45 06 00 86 FC 00 02 05 44 06 00 49 06 00 87 FC' - '00 02 05 44 06 00 4A 06 00 88 FC 00 02 05 45 06 00 27 06 00 89 FC 00 02 05 45 06 00 45 06 00 8A' - 'FC 00 02 05 46 06 00 31 06 00 8B FC 00 02 05 46 06 00 32 06 00 8C FC 00 02 05 46 06 00 45 06 00' - '8D FC 00 02 05 46 06 00 46 06 00 8E FC 00 02 05 46 06 00 49 06 00 8F FC 00 02 05 46 06 00 4A 06' - '00 90 FC 00 02 05 49 06 00 70 06 00 91 FC 00 02 05 4A 06 00 31 06 00 92 FC 00 02 05 4A 06 00 32' - '06 00 93 FC 00 02 05 4A 06 00 45 06 00 94 FC 00 02 05 4A 06 00 46 06 00 95 FC 00 02 05 4A 06 00' - '49 06 00 96 FC 00 02 05 4A 06 00 4A 06 00 97 FC 00 03 03 4A 06 00 54 06 00 2C 06 00 98 FC 00 03' - '03 4A 06 00 54 06 00 2D 06 00 99 FC 00 03 03 4A 06 00 54 06 00 2E 06 00 9A FC 00 03 03 4A 06 00' - '54 06 00 45 06 00 9B FC 00 03 03 4A 06 00 54 06 00 47 06 00 9C FC 00 02 03 28 06 00 2C 06 00 9D' - 'FC 00 02 03 28 06 00 2D 06 00 9E FC 00 02 03 28 06 00 2E 06 00 9F FC 00 02 03 28 06 00 45 06 00' - 'A0 FC 00 02 03 28 06 00 47 06 00 A1 FC 00 02 03 2A 06 00 2C 06 00 A2 FC 00 02 03 2A 06 00 2D 06' - '00 A3 FC 00 02 03 2A 06 00 2E 06 00 A4 FC 00 02 03 2A 06 00 45 06 00 A5 FC 00 02 03 2A 06 00 47' - '06 00 A6 FC 00 02 03 2B 06 00 45 06 00 A7 FC 00 02 03 2C 06 00 2D 06 00 A8 FC 00 02 03 2C 06 00' - '45 06 00 A9 FC 00 02 03 2D 06 00 2C 06 00 AA FC 00 02 03 2D 06 00 45 06 00 AB FC 00 02 03 2E 06' - '00 2C 06 00 AC FC 00 02 03 2E 06 00 45 06 00 AD FC 00 02 03 33 06 00 2C 06 00 AE FC 00 02 03 33' - '06 00 2D 06 00 AF FC 00 02 03 33 06 00 2E 06 00 B0 FC 00 02 03 33 06 00 45 06 00 B1 FC 00 02 03' - '35 06 00 2D 06 00 B2 FC 00 02 03 35 06 00 2E 06 00 B3 FC 00 02 03 35 06 00 45 06 00 B4 FC 00 02' - '03 36 06 00 2C 06 00 B5 FC 00 02 03 36 06 00 2D 06 00 B6 FC 00 02 03 36 06 00 2E 06 00 B7 FC 00' - '02 03 36 06 00 45 06 00 B8 FC 00 02 03 37 06 00 2D 06 00 B9 FC 00 02 03 38 06 00 45 06 00 BA FC' - '00 02 03 39 06 00 2C 06 00 BB FC 00 02 03 39 06 00 45 06 00 BC FC 00 02 03 3A 06 00 2C 06 00 BD' - 'FC 00 02 03 3A 06 00 45 06 00 BE FC 00 02 03 41 06 00 2C 06 00 BF FC 00 02 03 41 06 00 2D 06 00' - 'C0 FC 00 02 03 41 06 00 2E 06 00 C1 FC 00 02 03 41 06 00 45 06 00 C2 FC 00 02 03 42 06 00 2D 06' - '00 C3 FC 00 02 03 42 06 00 45 06 00 C4 FC 00 02 03 43 06 00 2C 06 00 C5 FC 00 02 03 43 06 00 2D' - '06 00 C6 FC 00 02 03 43 06 00 2E 06 00 C7 FC 00 02 03 43 06 00 44 06 00 C8 FC 00 02 03 43 06 00' - '45 06 00 C9 FC 00 02 03 44 06 00 2C 06 00 CA FC 00 02 03 44 06 00 2D 06 00 CB FC 00 02 03 44 06' - '00 2E 06 00 CC FC 00 02 03 44 06 00 45 06 00 CD FC 00 02 03 44 06 00 47 06 00 CE FC 00 02 03 45' - '06 00 2C 06 00 CF FC 00 02 03 45 06 00 2D 06 00 D0 FC 00 02 03 45 06 00 2E 06 00 D1 FC 00 02 03' - '45 06 00 45 06 00 D2 FC 00 02 03 46 06 00 2C 06 00 D3 FC 00 02 03 46 06 00 2D 06 00 D4 FC 00 02' - '03 46 06 00 2E 06 00 D5 FC 00 02 03 46 06 00 45 06 00 D6 FC 00 02 03 46 06 00 47 06 00 D7 FC 00' - '02 03 47 06 00 2C 06 00 D8 FC 00 02 03 47 06 00 45 06 00 D9 FC 00 02 03 47 06 00 70 06 00 DA FC' - '00 02 03 4A 06 00 2C 06 00 DB FC 00 02 03 4A 06 00 2D 06 00 DC FC 00 02 03 4A 06 00 2E 06 00 DD' - 'FC 00 02 03 4A 06 00 45 06 00 DE FC 00 02 03 4A 06 00 47 06 00 DF FC 00 03 04 4A 06 00 54 06 00' - '45 06 00 E0 FC 00 03 04 4A 06 00 54 06 00 47 06 00 E1 FC 00 02 04 28 06 00 45 06 00 E2 FC 00 02' - '04 28 06 00 47 06 00 E3 FC 00 02 04 2A 06 00 45 06 00 E4 FC 00 02 04 2A 06 00 47 06 00 E5 FC 00' - '02 04 2B 06 00 45 06 00 E6 FC 00 02 04 2B 06 00 47 06 00 E7 FC 00 02 04 33 06 00 45 06 00 E8 FC' - '00 02 04 33 06 00 47 06 00 E9 FC 00 02 04 34 06 00 45 06 00 EA FC 00 02 04 34 06 00 47 06 00 EB' - 'FC 00 02 04 43 06 00 44 06 00 EC FC 00 02 04 43 06 00 45 06 00 ED FC 00 02 04 44 06 00 45 06 00' - 'EE FC 00 02 04 46 06 00 45 06 00 EF FC 00 02 04 46 06 00 47 06 00 F0 FC 00 02 04 4A 06 00 45 06' - '00 F1 FC 00 02 04 4A 06 00 47 06 00 F2 FC 00 03 04 40 06 00 4E 06 00 51 06 00 F3 FC 00 03 04 40' - '06 00 4F 06 00 51 06 00 F4 FC 00 03 04 40 06 00 50 06 00 51 06 00 F5 FC 00 02 06 37 06 00 49 06' - '00 F6 FC 00 02 06 37 06 00 4A 06 00 F7 FC 00 02 06 39 06 00 49 06 00 F8 FC 00 02 06 39 06 00 4A' - '06 00 F9 FC 00 02 06 3A 06 00 49 06 00 FA FC 00 02 06 3A 06 00 4A 06 00 FB FC 00 02 06 33 06 00' - '49 06 00 FC FC 00 02 06 33 06 00 4A 06 00 FD FC 00 02 06 34 06 00 49 06 00 FE FC 00 02 06 34 06' - '00 4A 06 00 FF FC 00 02 06 2D 06 00 49 06 00 00 FD 00 02 06 2D 06 00 4A 06 00 01 FD 00 02 06 2C' - '06 00 49 06 00 02 FD 00 02 06 2C 06 00 4A 06 00 03 FD 00 02 06 2E 06 00 49 06 00 04 FD 00 02 06' - '2E 06 00 4A 06 00 05 FD 00 02 06 35 06 00 49 06 00 06 FD 00 02 06 35 06 00 4A 06 00 07 FD 00 02' - '06 36 06 00 49 06 00 08 FD 00 02 06 36 06 00 4A 06 00 09 FD 00 02 06 34 06 00 2C 06 00 0A FD 00' - '02 06 34 06 00 2D 06 00 0B FD 00 02 06 34 06 00 2E 06 00 0C FD 00 02 06 34 06 00 45 06 00 0D FD' - '00 02 06 34 06 00 31 06 00 0E FD 00 02 06 33 06 00 31 06 00 0F FD 00 02 06 35 06 00 31 06 00 10' - 'FD 00 02 06 36 06 00 31 06 00 11 FD 00 02 05 37 06 00 49 06 00 12 FD 00 02 05 37 06 00 4A 06 00' - '13 FD 00 02 05 39 06 00 49 06 00 14 FD 00 02 05 39 06 00 4A 06 00 15 FD 00 02 05 3A 06 00 49 06' - '00 16 FD 00 02 05 3A 06 00 4A 06 00 17 FD 00 02 05 33 06 00 49 06 00 18 FD 00 02 05 33 06 00 4A' - '06 00 19 FD 00 02 05 34 06 00 49 06 00 1A FD 00 02 05 34 06 00 4A 06 00 1B FD 00 02 05 2D 06 00' - '49 06 00 1C FD 00 02 05 2D 06 00 4A 06 00 1D FD 00 02 05 2C 06 00 49 06 00 1E FD 00 02 05 2C 06' - '00 4A 06 00 1F FD 00 02 05 2E 06 00 49 06 00 20 FD 00 02 05 2E 06 00 4A 06 00 21 FD 00 02 05 35' - '06 00 49 06 00 22 FD 00 02 05 35 06 00 4A 06 00 23 FD 00 02 05 36 06 00 49 06 00 24 FD 00 02 05' - '36 06 00 4A 06 00 25 FD 00 02 05 34 06 00 2C 06 00 26 FD 00 02 05 34 06 00 2D 06 00 27 FD 00 02' - '05 34 06 00 2E 06 00 28 FD 00 02 05 34 06 00 45 06 00 29 FD 00 02 05 34 06 00 31 06 00 2A FD 00' - '02 05 33 06 00 31 06 00 2B FD 00 02 05 35 06 00 31 06 00 2C FD 00 02 05 36 06 00 31 06 00 2D FD' - '00 02 03 34 06 00 2C 06 00 2E FD 00 02 03 34 06 00 2D 06 00 2F FD 00 02 03 34 06 00 2E 06 00 30' - 'FD 00 02 03 34 06 00 45 06 00 31 FD 00 02 03 33 06 00 47 06 00 32 FD 00 02 03 34 06 00 47 06 00' - '33 FD 00 02 03 37 06 00 45 06 00 34 FD 00 02 04 33 06 00 2C 06 00 35 FD 00 02 04 33 06 00 2D 06' - '00 36 FD 00 02 04 33 06 00 2E 06 00 37 FD 00 02 04 34 06 00 2C 06 00 38 FD 00 02 04 34 06 00 2D' - '06 00 39 FD 00 02 04 34 06 00 2E 06 00 3A FD 00 02 04 37 06 00 45 06 00 3B FD 00 02 04 38 06 00' - '45 06 00 3C FD 00 02 05 27 06 00 4B 06 00 3D FD 00 02 06 27 06 00 4B 06 00 50 FD 00 03 03 2A 06' - '00 2C 06 00 45 06 00 51 FD 00 03 05 2A 06 00 2D 06 00 2C 06 00 52 FD 00 03 03 2A 06 00 2D 06 00' - '2C 06 00 53 FD 00 03 03 2A 06 00 2D 06 00 45 06 00 54 FD 00 03 03 2A 06 00 2E 06 00 45 06 00 55' - 'FD 00 03 03 2A 06 00 45 06 00 2C 06 00 56 FD 00 03 03 2A 06 00 45 06 00 2D 06 00 57 FD 00 03 03' - '2A 06 00 45 06 00 2E 06 00 58 FD 00 03 05 2C 06 00 45 06 00 2D 06 00 59 FD 00 03 03 2C 06 00 45' - '06 00 2D 06 00 5A FD 00 03 05 2D 06 00 45 06 00 4A 06 00 5B FD 00 03 05 2D 06 00 45 06 00 49 06' - '00 5C FD 00 03 03 33 06 00 2D 06 00 2C 06 00 5D FD 00 03 03 33 06 00 2C 06 00 2D 06 00 5E FD 00' - '03 05 33 06 00 2C 06 00 49 06 00 5F FD 00 03 05 33 06 00 45 06 00 2D 06 00 60 FD 00 03 03 33 06' - '00 45 06 00 2D 06 00 61 FD 00 03 03 33 06 00 45 06 00 2C 06 00 62 FD 00 03 05 33 06 00 45 06 00' - '45 06 00 63 FD 00 03 03 33 06 00 45 06 00 45 06 00 64 FD 00 03 05 35 06 00 2D 06 00 2D 06 00 65' - 'FD 00 03 03 35 06 00 2D 06 00 2D 06 00 66 FD 00 03 05 35 06 00 45 06 00 45 06 00 67 FD 00 03 05' - '34 06 00 2D 06 00 45 06 00 68 FD 00 03 03 34 06 00 2D 06 00 45 06 00 69 FD 00 03 05 34 06 00 2C' - '06 00 4A 06 00 6A FD 00 03 05 34 06 00 45 06 00 2E 06 00 6B FD 00 03 03 34 06 00 45 06 00 2E 06' - '00 6C FD 00 03 05 34 06 00 45 06 00 45 06 00 6D FD 00 03 03 34 06 00 45 06 00 45 06 00 6E FD 00' - '03 05 36 06 00 2D 06 00 49 06 00 6F FD 00 03 05 36 06 00 2E 06 00 45 06 00 70 FD 00 03 03 36 06' - '00 2E 06 00 45 06 00 71 FD 00 03 05 37 06 00 45 06 00 2D 06 00 72 FD 00 03 03 37 06 00 45 06 00' - '2D 06 00 73 FD 00 03 03 37 06 00 45 06 00 45 06 00 74 FD 00 03 05 37 06 00 45 06 00 4A 06 00 75' - 'FD 00 03 05 39 06 00 2C 06 00 45 06 00 76 FD 00 03 05 39 06 00 45 06 00 45 06 00 77 FD 00 03 03' - '39 06 00 45 06 00 45 06 00 78 FD 00 03 05 39 06 00 45 06 00 49 06 00 79 FD 00 03 05 3A 06 00 45' - '06 00 45 06 00 7A FD 00 03 05 3A 06 00 45 06 00 4A 06 00 7B FD 00 03 05 3A 06 00 45 06 00 49 06' - '00 7C FD 00 03 05 41 06 00 2E 06 00 45 06 00 7D FD 00 03 03 41 06 00 2E 06 00 45 06 00 7E FD 00' - '03 05 42 06 00 45 06 00 2D 06 00 7F FD 00 03 05 42 06 00 45 06 00 45 06 00 80 FD 00 03 05 44 06' - '00 2D 06 00 45 06 00 81 FD 00 03 05 44 06 00 2D 06 00 4A 06 00 82 FD 00 03 05 44 06 00 2D 06 00' - '49 06 00 83 FD 00 03 03 44 06 00 2C 06 00 2C 06 00 84 FD 00 03 05 44 06 00 2C 06 00 2C 06 00 85' - 'FD 00 03 05 44 06 00 2E 06 00 45 06 00 86 FD 00 03 03 44 06 00 2E 06 00 45 06 00 87 FD 00 03 05' - '44 06 00 45 06 00 2D 06 00 88 FD 00 03 03 44 06 00 45 06 00 2D 06 00 89 FD 00 03 03 45 06 00 2D' - '06 00 2C 06 00 8A FD 00 03 03 45 06 00 2D 06 00 45 06 00 8B FD 00 03 05 45 06 00 2D 06 00 4A 06' - '00 8C FD 00 03 03 45 06 00 2C 06 00 2D 06 00 8D FD 00 03 03 45 06 00 2C 06 00 45 06 00 8E FD 00' - '03 03 45 06 00 2E 06 00 2C 06 00 8F FD 00 03 03 45 06 00 2E 06 00 45 06 00 92 FD 00 03 03 45 06' - '00 2C 06 00 2E 06 00 93 FD 00 03 03 47 06 00 45 06 00 2C 06 00 94 FD 00 03 03 47 06 00 45 06 00' - '45 06 00 95 FD 00 03 03 46 06 00 2D 06 00 45 06 00 96 FD 00 03 05 46 06 00 2D 06 00 49 06 00 97' - 'FD 00 03 05 46 06 00 2C 06 00 45 06 00 98 FD 00 03 03 46 06 00 2C 06 00 45 06 00 99 FD 00 03 05' - '46 06 00 2C 06 00 49 06 00 9A FD 00 03 05 46 06 00 45 06 00 4A 06 00 9B FD 00 03 05 46 06 00 45' - '06 00 49 06 00 9C FD 00 03 05 4A 06 00 45 06 00 45 06 00 9D FD 00 03 03 4A 06 00 45 06 00 45 06' - '00 9E FD 00 03 05 28 06 00 2E 06 00 4A 06 00 9F FD 00 03 05 2A 06 00 2C 06 00 4A 06 00 A0 FD 00' - '03 05 2A 06 00 2C 06 00 49 06 00 A1 FD 00 03 05 2A 06 00 2E 06 00 4A 06 00 A2 FD 00 03 05 2A 06' - '00 2E 06 00 49 06 00 A3 FD 00 03 05 2A 06 00 45 06 00 4A 06 00 A4 FD 00 03 05 2A 06 00 45 06 00' - '49 06 00 A5 FD 00 03 05 2C 06 00 45 06 00 4A 06 00 A6 FD 00 03 05 2C 06 00 2D 06 00 49 06 00 A7' - 'FD 00 03 05 2C 06 00 45 06 00 49 06 00 A8 FD 00 03 05 33 06 00 2E 06 00 49 06 00 A9 FD 00 03 05' - '35 06 00 2D 06 00 4A 06 00 AA FD 00 03 05 34 06 00 2D 06 00 4A 06 00 AB FD 00 03 05 36 06 00 2D' - '06 00 4A 06 00 AC FD 00 03 05 44 06 00 2C 06 00 4A 06 00 AD FD 00 03 05 44 06 00 45 06 00 4A 06' - '00 AE FD 00 03 05 4A 06 00 2D 06 00 4A 06 00 AF FD 00 03 05 4A 06 00 2C 06 00 4A 06 00 B0 FD 00' - '03 05 4A 06 00 45 06 00 4A 06 00 B1 FD 00 03 05 45 06 00 45 06 00 4A 06 00 B2 FD 00 03 05 42 06' - '00 45 06 00 4A 06 00 B3 FD 00 03 05 46 06 00 2D 06 00 4A 06 00 B4 FD 00 03 03 42 06 00 45 06 00' - '2D 06 00 B5 FD 00 03 03 44 06 00 2D 06 00 45 06 00 B6 FD 00 03 05 39 06 00 45 06 00 4A 06 00 B7' - 'FD 00 03 05 43 06 00 45 06 00 4A 06 00 B8 FD 00 03 03 46 06 00 2C 06 00 2D 06 00 B9 FD 00 03 05' - '45 06 00 2E 06 00 4A 06 00 BA FD 00 03 03 44 06 00 2C 06 00 45 06 00 BB FD 00 03 05 43 06 00 45' - '06 00 45 06 00 BC FD 00 03 05 44 06 00 2C 06 00 45 06 00 BD FD 00 03 05 46 06 00 2C 06 00 2D 06' - '00 BE FD 00 03 05 2C 06 00 2D 06 00 4A 06 00 BF FD 00 03 05 2D 06 00 2C 06 00 4A 06 00 C0 FD 00' - '03 05 45 06 00 2C 06 00 4A 06 00 C1 FD 00 03 05 41 06 00 45 06 00 4A 06 00 C2 FD 00 03 05 28 06' - '00 2D 06 00 4A 06 00 C3 FD 00 03 03 43 06 00 45 06 00 45 06 00 C4 FD 00 03 03 39 06 00 2C 06 00' - '45 06 00 C5 FD 00 03 03 35 06 00 45 06 00 45 06 00 C6 FD 00 03 05 33 06 00 2E 06 00 4A 06 00 C7' - 'FD 00 03 05 46 06 00 2C 06 00 4A 06 00 F0 FD 00 03 06 35 06 00 44 06 00 D2 06 00 F1 FD 00 03 06' - '42 06 00 44 06 00 D2 06 00 F2 FD 00 04 06 27 06 00 44 06 00 44 06 00 47 06 00 F3 FD 00 04 06 27' - '06 00 43 06 00 28 06 00 31 06 00 F4 FD 00 04 06 45 06 00 2D 06 00 45 06 00 2F 06 00 F5 FD 00 04' - '06 35 06 00 44 06 00 39 06 00 45 06 00 F6 FD 00 04 06 31 06 00 33 06 00 48 06 00 44 06 00 F7 FD' - '00 04 06 39 06 00 44 06 00 4A 06 00 47 06 00 F8 FD 00 04 06 48 06 00 33 06 00 44 06 00 45 06 00' - 'F9 FD 00 03 06 35 06 00 44 06 00 49 06 00 FA FD 00 12 06 35 06 00 44 06 00 49 06 00 20 00 00 27' - '06 00 44 06 00 44 06 00 47 06 00 20 00 00 39 06 00 44 06 00 4A 06 00 47 06 00 20 00 00 48 06 00' - '33 06 00 44 06 00 45 06 00 FB FD 00 08 06 2C 06 00 44 06 00 20 00 00 2C 06 00 44 06 00 27 06 00' - '44 06 00 47 06 00 FC FD 00 04 06 31 06 00 CC 06 00 27 06 00 44 06 00 10 FE 00 01 0A 2C 00 00 11' - 'FE 00 01 0A 01 30 00 12 FE 00 01 0A 02 30 00 13 FE 00 01 0A 3A 00 00 14 FE 00 01 0A 3B 00 00 15' - 'FE 00 01 0A 21 00 00 16 FE 00 01 0A 3F 00 00 17 FE 00 01 0A 16 30 00 18 FE 00 01 0A 17 30 00 19' - 'FE 00 03 0A 2E 00 00 2E 00 00 2E 00 00 30 FE 00 02 0A 2E 00 00 2E 00 00 31 FE 00 01 0A 14 20 00' - '32 FE 00 01 0A 13 20 00 33 FE 00 01 0A 5F 00 00 34 FE 00 01 0A 5F 00 00 35 FE 00 01 0A 28 00 00' - '36 FE 00 01 0A 29 00 00 37 FE 00 01 0A 7B 00 00 38 FE 00 01 0A 7D 00 00 39 FE 00 01 0A 14 30 00' - '3A FE 00 01 0A 15 30 00 3B FE 00 01 0A 10 30 00 3C FE 00 01 0A 11 30 00 3D FE 00 01 0A 0A 30 00' - '3E FE 00 01 0A 0B 30 00 3F FE 00 01 0A 08 30 00 40 FE 00 01 0A 09 30 00 41 FE 00 01 0A 0C 30 00' - '42 FE 00 01 0A 0D 30 00 43 FE 00 01 0A 0E 30 00 44 FE 00 01 0A 0F 30 00 47 FE 00 01 0A 5B 00 00' - '48 FE 00 01 0A 5D 00 00 49 FE 00 02 10 20 00 00 05 03 00 4A FE 00 02 10 20 00 00 05 03 00 4B FE' - '00 02 10 20 00 00 05 03 00 4C FE 00 02 10 20 00 00 05 03 00 4D FE 00 01 10 5F 00 00 4E FE 00 01' - '10 5F 00 00 4F FE 00 01 10 5F 00 00 50 FE 00 01 0D 2C 00 00 51 FE 00 01 0D 01 30 00 52 FE 00 01' - '0D 2E 00 00 54 FE 00 01 0D 3B 00 00 55 FE 00 01 0D 3A 00 00 56 FE 00 01 0D 3F 00 00 57 FE 00 01' - '0D 21 00 00 58 FE 00 01 0D 14 20 00 59 FE 00 01 0D 28 00 00 5A FE 00 01 0D 29 00 00 5B FE 00 01' - '0D 7B 00 00 5C FE 00 01 0D 7D 00 00 5D FE 00 01 0D 14 30 00 5E FE 00 01 0D 15 30 00 5F FE 00 01' - '0D 23 00 00 60 FE 00 01 0D 26 00 00 61 FE 00 01 0D 2A 00 00 62 FE 00 01 0D 2B 00 00 63 FE 00 01' - '0D 2D 00 00 64 FE 00 01 0D 3C 00 00 65 FE 00 01 0D 3E 00 00 66 FE 00 01 0D 3D 00 00 68 FE 00 01' - '0D 5C 00 00 69 FE 00 01 0D 24 00 00 6A FE 00 01 0D 25 00 00 6B FE 00 01 0D 40 00 00 70 FE 00 02' - '06 20 00 00 4B 06 00 71 FE 00 02 04 40 06 00 4B 06 00 72 FE 00 02 06 20 00 00 4C 06 00 74 FE 00' - '02 06 20 00 00 4D 06 00 76 FE 00 02 06 20 00 00 4E 06 00 77 FE 00 02 04 40 06 00 4E 06 00 78 FE' - '00 02 06 20 00 00 4F 06 00 79 FE 00 02 04 40 06 00 4F 06 00 7A FE 00 02 06 20 00 00 50 06 00 7B' - 'FE 00 02 04 40 06 00 50 06 00 7C FE 00 02 06 20 00 00 51 06 00 7D FE 00 02 04 40 06 00 51 06 00' - '7E FE 00 02 06 20 00 00 52 06 00 7F FE 00 02 04 40 06 00 52 06 00 80 FE 00 01 06 21 06 00 81 FE' - '00 02 06 27 06 00 53 06 00 82 FE 00 02 05 27 06 00 53 06 00 83 FE 00 02 06 27 06 00 54 06 00 84' - 'FE 00 02 05 27 06 00 54 06 00 85 FE 00 02 06 48 06 00 54 06 00 86 FE 00 02 05 48 06 00 54 06 00' - '87 FE 00 02 06 27 06 00 55 06 00 88 FE 00 02 05 27 06 00 55 06 00 89 FE 00 02 06 4A 06 00 54 06' - '00 8A FE 00 02 05 4A 06 00 54 06 00 8B FE 00 02 03 4A 06 00 54 06 00 8C FE 00 02 04 4A 06 00 54' - '06 00 8D FE 00 01 06 27 06 00 8E FE 00 01 05 27 06 00 8F FE 00 01 06 28 06 00 90 FE 00 01 05 28' - '06 00 91 FE 00 01 03 28 06 00 92 FE 00 01 04 28 06 00 93 FE 00 01 06 29 06 00 94 FE 00 01 05 29' - '06 00 95 FE 00 01 06 2A 06 00 96 FE 00 01 05 2A 06 00 97 FE 00 01 03 2A 06 00 98 FE 00 01 04 2A' - '06 00 99 FE 00 01 06 2B 06 00 9A FE 00 01 05 2B 06 00 9B FE 00 01 03 2B 06 00 9C FE 00 01 04 2B' - '06 00 9D FE 00 01 06 2C 06 00 9E FE 00 01 05 2C 06 00 9F FE 00 01 03 2C 06 00 A0 FE 00 01 04 2C' - '06 00 A1 FE 00 01 06 2D 06 00 A2 FE 00 01 05 2D 06 00 A3 FE 00 01 03 2D 06 00 A4 FE 00 01 04 2D' - '06 00 A5 FE 00 01 06 2E 06 00 A6 FE 00 01 05 2E 06 00 A7 FE 00 01 03 2E 06 00 A8 FE 00 01 04 2E' - '06 00 A9 FE 00 01 06 2F 06 00 AA FE 00 01 05 2F 06 00 AB FE 00 01 06 30 06 00 AC FE 00 01 05 30' - '06 00 AD FE 00 01 06 31 06 00 AE FE 00 01 05 31 06 00 AF FE 00 01 06 32 06 00 B0 FE 00 01 05 32' - '06 00 B1 FE 00 01 06 33 06 00 B2 FE 00 01 05 33 06 00 B3 FE 00 01 03 33 06 00 B4 FE 00 01 04 33' - '06 00 B5 FE 00 01 06 34 06 00 B6 FE 00 01 05 34 06 00 B7 FE 00 01 03 34 06 00 B8 FE 00 01 04 34' - '06 00 B9 FE 00 01 06 35 06 00 BA FE 00 01 05 35 06 00 BB FE 00 01 03 35 06 00 BC FE 00 01 04 35' - '06 00 BD FE 00 01 06 36 06 00 BE FE 00 01 05 36 06 00 BF FE 00 01 03 36 06 00 C0 FE 00 01 04 36' - '06 00 C1 FE 00 01 06 37 06 00 C2 FE 00 01 05 37 06 00 C3 FE 00 01 03 37 06 00 C4 FE 00 01 04 37' - '06 00 C5 FE 00 01 06 38 06 00 C6 FE 00 01 05 38 06 00 C7 FE 00 01 03 38 06 00 C8 FE 00 01 04 38' - '06 00 C9 FE 00 01 06 39 06 00 CA FE 00 01 05 39 06 00 CB FE 00 01 03 39 06 00 CC FE 00 01 04 39' - '06 00 CD FE 00 01 06 3A 06 00 CE FE 00 01 05 3A 06 00 CF FE 00 01 03 3A 06 00 D0 FE 00 01 04 3A' - '06 00 D1 FE 00 01 06 41 06 00 D2 FE 00 01 05 41 06 00 D3 FE 00 01 03 41 06 00 D4 FE 00 01 04 41' - '06 00 D5 FE 00 01 06 42 06 00 D6 FE 00 01 05 42 06 00 D7 FE 00 01 03 42 06 00 D8 FE 00 01 04 42' - '06 00 D9 FE 00 01 06 43 06 00 DA FE 00 01 05 43 06 00 DB FE 00 01 03 43 06 00 DC FE 00 01 04 43' - '06 00 DD FE 00 01 06 44 06 00 DE FE 00 01 05 44 06 00 DF FE 00 01 03 44 06 00 E0 FE 00 01 04 44' - '06 00 E1 FE 00 01 06 45 06 00 E2 FE 00 01 05 45 06 00 E3 FE 00 01 03 45 06 00 E4 FE 00 01 04 45' - '06 00 E5 FE 00 01 06 46 06 00 E6 FE 00 01 05 46 06 00 E7 FE 00 01 03 46 06 00 E8 FE 00 01 04 46' - '06 00 E9 FE 00 01 06 47 06 00 EA FE 00 01 05 47 06 00 EB FE 00 01 03 47 06 00 EC FE 00 01 04 47' - '06 00 ED FE 00 01 06 48 06 00 EE FE 00 01 05 48 06 00 EF FE 00 01 06 49 06 00 F0 FE 00 01 05 49' - '06 00 F1 FE 00 01 06 4A 06 00 F2 FE 00 01 05 4A 06 00 F3 FE 00 01 03 4A 06 00 F4 FE 00 01 04 4A' - '06 00 F5 FE 00 03 06 44 06 00 27 06 00 53 06 00 F6 FE 00 03 05 44 06 00 27 06 00 53 06 00 F7 FE' - '00 03 06 44 06 00 27 06 00 54 06 00 F8 FE 00 03 05 44 06 00 27 06 00 54 06 00 F9 FE 00 03 06 44' - '06 00 27 06 00 55 06 00 FA FE 00 03 05 44 06 00 27 06 00 55 06 00 FB FE 00 02 06 44 06 00 27 06' - '00 FC FE 00 02 05 44 06 00 27 06 00 01 FF 00 01 0B 21 00 00 02 FF 00 01 0B 22 00 00 03 FF 00 01' - '0B 23 00 00 04 FF 00 01 0B 24 00 00 05 FF 00 01 0B 25 00 00 06 FF 00 01 0B 26 00 00 07 FF 00 01' - '0B 27 00 00 08 FF 00 01 0B 28 00 00 09 FF 00 01 0B 29 00 00 0A FF 00 01 0B 2A 00 00 0B FF 00 01' - '0B 2B 00 00 0C FF 00 01 0B 2C 00 00 0D FF 00 01 0B 2D 00 00 0E FF 00 01 0B 2E 00 00 0F FF 00 01' - '0B 2F 00 00 10 FF 00 01 0B 30 00 00 11 FF 00 01 0B 31 00 00 12 FF 00 01 0B 32 00 00 13 FF 00 01' - '0B 33 00 00 14 FF 00 01 0B 34 00 00 15 FF 00 01 0B 35 00 00 16 FF 00 01 0B 36 00 00 17 FF 00 01' - '0B 37 00 00 18 FF 00 01 0B 38 00 00 19 FF 00 01 0B 39 00 00 1A FF 00 01 0B 3A 00 00 1B FF 00 01' - '0B 3B 00 00 1C FF 00 01 0B 3C 00 00 1D FF 00 01 0B 3D 00 00 1E FF 00 01 0B 3E 00 00 1F FF 00 01' - '0B 3F 00 00 20 FF 00 01 0B 40 00 00 21 FF 00 01 0B 41 00 00 22 FF 00 01 0B 42 00 00 23 FF 00 01' - '0B 43 00 00 24 FF 00 01 0B 44 00 00 25 FF 00 01 0B 45 00 00 26 FF 00 01 0B 46 00 00 27 FF 00 01' - '0B 47 00 00 28 FF 00 01 0B 48 00 00 29 FF 00 01 0B 49 00 00 2A FF 00 01 0B 4A 00 00 2B FF 00 01' - '0B 4B 00 00 2C FF 00 01 0B 4C 00 00 2D FF 00 01 0B 4D 00 00 2E FF 00 01 0B 4E 00 00 2F FF 00 01' - '0B 4F 00 00 30 FF 00 01 0B 50 00 00 31 FF 00 01 0B 51 00 00 32 FF 00 01 0B 52 00 00 33 FF 00 01' - '0B 53 00 00 34 FF 00 01 0B 54 00 00 35 FF 00 01 0B 55 00 00 36 FF 00 01 0B 56 00 00 37 FF 00 01' - '0B 57 00 00 38 FF 00 01 0B 58 00 00 39 FF 00 01 0B 59 00 00 3A FF 00 01 0B 5A 00 00 3B FF 00 01' - '0B 5B 00 00 3C FF 00 01 0B 5C 00 00 3D FF 00 01 0B 5D 00 00 3E FF 00 01 0B 5E 00 00 3F FF 00 01' - '0B 5F 00 00 40 FF 00 01 0B 60 00 00 41 FF 00 01 0B 61 00 00 42 FF 00 01 0B 62 00 00 43 FF 00 01' - '0B 63 00 00 44 FF 00 01 0B 64 00 00 45 FF 00 01 0B 65 00 00 46 FF 00 01 0B 66 00 00 47 FF 00 01' - '0B 67 00 00 48 FF 00 01 0B 68 00 00 49 FF 00 01 0B 69 00 00 4A FF 00 01 0B 6A 00 00 4B FF 00 01' - '0B 6B 00 00 4C FF 00 01 0B 6C 00 00 4D FF 00 01 0B 6D 00 00 4E FF 00 01 0B 6E 00 00 4F FF 00 01' - '0B 6F 00 00 50 FF 00 01 0B 70 00 00 51 FF 00 01 0B 71 00 00 52 FF 00 01 0B 72 00 00 53 FF 00 01' - '0B 73 00 00 54 FF 00 01 0B 74 00 00 55 FF 00 01 0B 75 00 00 56 FF 00 01 0B 76 00 00 57 FF 00 01' - '0B 77 00 00 58 FF 00 01 0B 78 00 00 59 FF 00 01 0B 79 00 00 5A FF 00 01 0B 7A 00 00 5B FF 00 01' - '0B 7B 00 00 5C FF 00 01 0B 7C 00 00 5D FF 00 01 0B 7D 00 00 5E FF 00 01 0B 7E 00 00 5F FF 00 01' - '0B 85 29 00 60 FF 00 01 0B 86 29 00 61 FF 00 01 0C 02 30 00 62 FF 00 01 0C 0C 30 00 63 FF 00 01' - '0C 0D 30 00 64 FF 00 01 0C 01 30 00 65 FF 00 01 0C FB 30 00 66 FF 00 01 0C F2 30 00 67 FF 00 01' - '0C A1 30 00 68 FF 00 01 0C A3 30 00 69 FF 00 01 0C A5 30 00 6A FF 00 01 0C A7 30 00 6B FF 00 01' - '0C A9 30 00 6C FF 00 01 0C E3 30 00 6D FF 00 01 0C E5 30 00 6E FF 00 01 0C E7 30 00 6F FF 00 01' - '0C C3 30 00 70 FF 00 01 0C FC 30 00 71 FF 00 01 0C A2 30 00 72 FF 00 01 0C A4 30 00 73 FF 00 01' - '0C A6 30 00 74 FF 00 01 0C A8 30 00 75 FF 00 01 0C AA 30 00 76 FF 00 01 0C AB 30 00 77 FF 00 01' - '0C AD 30 00 78 FF 00 01 0C AF 30 00 79 FF 00 01 0C B1 30 00 7A FF 00 01 0C B3 30 00 7B FF 00 01' - '0C B5 30 00 7C FF 00 01 0C B7 30 00 7D FF 00 01 0C B9 30 00 7E FF 00 01 0C BB 30 00 7F FF 00 01' - '0C BD 30 00 80 FF 00 01 0C BF 30 00 81 FF 00 01 0C C1 30 00 82 FF 00 01 0C C4 30 00 83 FF 00 01' - '0C C6 30 00 84 FF 00 01 0C C8 30 00 85 FF 00 01 0C CA 30 00 86 FF 00 01 0C CB 30 00 87 FF 00 01' - '0C CC 30 00 88 FF 00 01 0C CD 30 00 89 FF 00 01 0C CE 30 00 8A FF 00 01 0C CF 30 00 8B FF 00 01' - '0C D2 30 00 8C FF 00 01 0C D5 30 00 8D FF 00 01 0C D8 30 00 8E FF 00 01 0C DB 30 00 8F FF 00 01' - '0C DE 30 00 90 FF 00 01 0C DF 30 00 91 FF 00 01 0C E0 30 00 92 FF 00 01 0C E1 30 00 93 FF 00 01' - '0C E2 30 00 94 FF 00 01 0C E4 30 00 95 FF 00 01 0C E6 30 00 96 FF 00 01 0C E8 30 00 97 FF 00 01' - '0C E9 30 00 98 FF 00 01 0C EA 30 00 99 FF 00 01 0C EB 30 00 9A FF 00 01 0C EC 30 00 9B FF 00 01' - '0C ED 30 00 9C FF 00 01 0C EF 30 00 9D FF 00 01 0C F3 30 00 9E FF 00 01 0C 99 30 00 9F FF 00 01' - '0C 9A 30 00 A0 FF 00 01 0C 60 11 00 A1 FF 00 01 0C 00 11 00 A2 FF 00 01 0C 01 11 00 A3 FF 00 01' - '0C AA 11 00 A4 FF 00 01 0C 02 11 00 A5 FF 00 01 0C AC 11 00 A6 FF 00 01 0C AD 11 00 A7 FF 00 01' - '0C 03 11 00 A8 FF 00 01 0C 04 11 00 A9 FF 00 01 0C 05 11 00 AA FF 00 01 0C B0 11 00 AB FF 00 01' - '0C B1 11 00 AC FF 00 01 0C B2 11 00 AD FF 00 01 0C B3 11 00 AE FF 00 01 0C B4 11 00 AF FF 00 01' - '0C B5 11 00 B0 FF 00 01 0C 1A 11 00 B1 FF 00 01 0C 06 11 00 B2 FF 00 01 0C 07 11 00 B3 FF 00 01' - '0C 08 11 00 B4 FF 00 01 0C 21 11 00 B5 FF 00 01 0C 09 11 00 B6 FF 00 01 0C 0A 11 00 B7 FF 00 01' - '0C 0B 11 00 B8 FF 00 01 0C 0C 11 00 B9 FF 00 01 0C 0D 11 00 BA FF 00 01 0C 0E 11 00 BB FF 00 01' - '0C 0F 11 00 BC FF 00 01 0C 10 11 00 BD FF 00 01 0C 11 11 00 BE FF 00 01 0C 12 11 00 C2 FF 00 01' - '0C 61 11 00 C3 FF 00 01 0C 62 11 00 C4 FF 00 01 0C 63 11 00 C5 FF 00 01 0C 64 11 00 C6 FF 00 01' - '0C 65 11 00 C7 FF 00 01 0C 66 11 00 CA FF 00 01 0C 67 11 00 CB FF 00 01 0C 68 11 00 CC FF 00 01' - '0C 69 11 00 CD FF 00 01 0C 6A 11 00 CE FF 00 01 0C 6B 11 00 CF FF 00 01 0C 6C 11 00 D2 FF 00 01' - '0C 6D 11 00 D3 FF 00 01 0C 6E 11 00 D4 FF 00 01 0C 6F 11 00 D5 FF 00 01 0C 70 11 00 D6 FF 00 01' - '0C 71 11 00 D7 FF 00 01 0C 72 11 00 DA FF 00 01 0C 73 11 00 DB FF 00 01 0C 74 11 00 DC FF 00 01' - '0C 75 11 00 E0 FF 00 01 0B A2 00 00 E1 FF 00 01 0B A3 00 00 E2 FF 00 01 0B AC 00 00 E3 FF 00 02' - '0B 20 00 00 04 03 00 E4 FF 00 01 0B A6 00 00 E5 FF 00 01 0B A5 00 00 E6 FF 00 01 0B A9 20 00 E8' - 'FF 00 01 0C 02 25 00 E9 FF 00 01 0C 90 21 00 EA FF 00 01 0C 91 21 00 EB FF 00 01 0C 92 21 00 EC' - 'FF 00 01 0C 93 21 00 ED FF 00 01 0C A0 25 00 EE FF 00 01 0C CB 25 00 9A 10 01 02 00 99 10 01 BA' - '10 01 9C 10 01 02 00 9B 10 01 BA 10 01 AB 10 01 02 00 A5 10 01 BA 10 01 2E 11 01 02 00 31 11 01' - '27 11 01 2F 11 01 02 00 32 11 01 27 11 01 4B 13 01 02 00 47 13 01 3E 13 01 4C 13 01 02 00 47 13' - '01 57 13 01 BB 14 01 02 00 B9 14 01 BA 14 01 BC 14 01 02 00 B9 14 01 B0 14 01 BE 14 01 02 00 B9' - '14 01 BD 14 01 BA 15 01 02 00 B8 15 01 AF 15 01 BB 15 01 02 00 B9 15 01 AF 15 01 38 19 01 02 00' - '35 19 01 30 19 01 5E D1 01 02 00 57 D1 01 65 D1 01 5F D1 01 02 00 58 D1 01 65 D1 01 60 D1 01 03' - '00 58 D1 01 65 D1 01 6E D1 01 61 D1 01 03 00 58 D1 01 65 D1 01 6F D1 01 62 D1 01 03 00 58 D1 01' - '65 D1 01 70 D1 01 63 D1 01 03 00 58 D1 01 65 D1 01 71 D1 01 64 D1 01 03 00 58 D1 01 65 D1 01 72' - 'D1 01 BB D1 01 02 00 B9 D1 01 65 D1 01 BC D1 01 02 00 BA D1 01 65 D1 01 BD D1 01 03 00 B9 D1 01' - '65 D1 01 6E D1 01 BE D1 01 03 00 BA D1 01 65 D1 01 6E D1 01 BF D1 01 03 00 B9 D1 01 65 D1 01 6F' - 'D1 01 C0 D1 01 03 00 BA D1 01 65 D1 01 6F D1 01 00 D4 01 01 01 41 00 00 01 D4 01 01 01 42 00 00' - '02 D4 01 01 01 43 00 00 03 D4 01 01 01 44 00 00 04 D4 01 01 01 45 00 00 05 D4 01 01 01 46 00 00' - '06 D4 01 01 01 47 00 00 07 D4 01 01 01 48 00 00 08 D4 01 01 01 49 00 00 09 D4 01 01 01 4A 00 00' - '0A D4 01 01 01 4B 00 00 0B D4 01 01 01 4C 00 00 0C D4 01 01 01 4D 00 00 0D D4 01 01 01 4E 00 00' - '0E D4 01 01 01 4F 00 00 0F D4 01 01 01 50 00 00 10 D4 01 01 01 51 00 00 11 D4 01 01 01 52 00 00' - '12 D4 01 01 01 53 00 00 13 D4 01 01 01 54 00 00 14 D4 01 01 01 55 00 00 15 D4 01 01 01 56 00 00' - '16 D4 01 01 01 57 00 00 17 D4 01 01 01 58 00 00 18 D4 01 01 01 59 00 00 19 D4 01 01 01 5A 00 00' - '1A D4 01 01 01 61 00 00 1B D4 01 01 01 62 00 00 1C D4 01 01 01 63 00 00 1D D4 01 01 01 64 00 00' - '1E D4 01 01 01 65 00 00 1F D4 01 01 01 66 00 00 20 D4 01 01 01 67 00 00 21 D4 01 01 01 68 00 00' - '22 D4 01 01 01 69 00 00 23 D4 01 01 01 6A 00 00 24 D4 01 01 01 6B 00 00 25 D4 01 01 01 6C 00 00' - '26 D4 01 01 01 6D 00 00 27 D4 01 01 01 6E 00 00 28 D4 01 01 01 6F 00 00 29 D4 01 01 01 70 00 00' - '2A D4 01 01 01 71 00 00 2B D4 01 01 01 72 00 00 2C D4 01 01 01 73 00 00 2D D4 01 01 01 74 00 00' - '2E D4 01 01 01 75 00 00 2F D4 01 01 01 76 00 00 30 D4 01 01 01 77 00 00 31 D4 01 01 01 78 00 00' - '32 D4 01 01 01 79 00 00 33 D4 01 01 01 7A 00 00 34 D4 01 01 01 41 00 00 35 D4 01 01 01 42 00 00' - '36 D4 01 01 01 43 00 00 37 D4 01 01 01 44 00 00 38 D4 01 01 01 45 00 00 39 D4 01 01 01 46 00 00' - '3A D4 01 01 01 47 00 00 3B D4 01 01 01 48 00 00 3C D4 01 01 01 49 00 00 3D D4 01 01 01 4A 00 00' - '3E D4 01 01 01 4B 00 00 3F D4 01 01 01 4C 00 00 40 D4 01 01 01 4D 00 00 41 D4 01 01 01 4E 00 00' - '42 D4 01 01 01 4F 00 00 43 D4 01 01 01 50 00 00 44 D4 01 01 01 51 00 00 45 D4 01 01 01 52 00 00' - '46 D4 01 01 01 53 00 00 47 D4 01 01 01 54 00 00 48 D4 01 01 01 55 00 00 49 D4 01 01 01 56 00 00' - '4A D4 01 01 01 57 00 00 4B D4 01 01 01 58 00 00 4C D4 01 01 01 59 00 00 4D D4 01 01 01 5A 00 00' - '4E D4 01 01 01 61 00 00 4F D4 01 01 01 62 00 00 50 D4 01 01 01 63 00 00 51 D4 01 01 01 64 00 00' - '52 D4 01 01 01 65 00 00 53 D4 01 01 01 66 00 00 54 D4 01 01 01 67 00 00 56 D4 01 01 01 69 00 00' - '57 D4 01 01 01 6A 00 00 58 D4 01 01 01 6B 00 00 59 D4 01 01 01 6C 00 00 5A D4 01 01 01 6D 00 00' - '5B D4 01 01 01 6E 00 00 5C D4 01 01 01 6F 00 00 5D D4 01 01 01 70 00 00 5E D4 01 01 01 71 00 00' - '5F D4 01 01 01 72 00 00 60 D4 01 01 01 73 00 00 61 D4 01 01 01 74 00 00 62 D4 01 01 01 75 00 00' - '63 D4 01 01 01 76 00 00 64 D4 01 01 01 77 00 00 65 D4 01 01 01 78 00 00 66 D4 01 01 01 79 00 00' - '67 D4 01 01 01 7A 00 00 68 D4 01 01 01 41 00 00 69 D4 01 01 01 42 00 00 6A D4 01 01 01 43 00 00' - '6B D4 01 01 01 44 00 00 6C D4 01 01 01 45 00 00 6D D4 01 01 01 46 00 00 6E D4 01 01 01 47 00 00' - '6F D4 01 01 01 48 00 00 70 D4 01 01 01 49 00 00 71 D4 01 01 01 4A 00 00 72 D4 01 01 01 4B 00 00' - '73 D4 01 01 01 4C 00 00 74 D4 01 01 01 4D 00 00 75 D4 01 01 01 4E 00 00 76 D4 01 01 01 4F 00 00' - '77 D4 01 01 01 50 00 00 78 D4 01 01 01 51 00 00 79 D4 01 01 01 52 00 00 7A D4 01 01 01 53 00 00' - '7B D4 01 01 01 54 00 00 7C D4 01 01 01 55 00 00 7D D4 01 01 01 56 00 00 7E D4 01 01 01 57 00 00' - '7F D4 01 01 01 58 00 00 80 D4 01 01 01 59 00 00 81 D4 01 01 01 5A 00 00 82 D4 01 01 01 61 00 00' - '83 D4 01 01 01 62 00 00 84 D4 01 01 01 63 00 00 85 D4 01 01 01 64 00 00 86 D4 01 01 01 65 00 00' - '87 D4 01 01 01 66 00 00 88 D4 01 01 01 67 00 00 89 D4 01 01 01 68 00 00 8A D4 01 01 01 69 00 00' - '8B D4 01 01 01 6A 00 00 8C D4 01 01 01 6B 00 00 8D D4 01 01 01 6C 00 00 8E D4 01 01 01 6D 00 00' - '8F D4 01 01 01 6E 00 00 90 D4 01 01 01 6F 00 00 91 D4 01 01 01 70 00 00 92 D4 01 01 01 71 00 00' - '93 D4 01 01 01 72 00 00 94 D4 01 01 01 73 00 00 95 D4 01 01 01 74 00 00 96 D4 01 01 01 75 00 00' - '97 D4 01 01 01 76 00 00 98 D4 01 01 01 77 00 00 99 D4 01 01 01 78 00 00 9A D4 01 01 01 79 00 00' - '9B D4 01 01 01 7A 00 00 9C D4 01 01 01 41 00 00 9E D4 01 01 01 43 00 00 9F D4 01 01 01 44 00 00' - 'A2 D4 01 01 01 47 00 00 A5 D4 01 01 01 4A 00 00 A6 D4 01 01 01 4B 00 00 A9 D4 01 01 01 4E 00 00' - 'AA D4 01 01 01 4F 00 00 AB D4 01 01 01 50 00 00 AC D4 01 01 01 51 00 00 AE D4 01 01 01 53 00 00' - 'AF D4 01 01 01 54 00 00 B0 D4 01 01 01 55 00 00 B1 D4 01 01 01 56 00 00 B2 D4 01 01 01 57 00 00' - 'B3 D4 01 01 01 58 00 00 B4 D4 01 01 01 59 00 00 B5 D4 01 01 01 5A 00 00 B6 D4 01 01 01 61 00 00' - 'B7 D4 01 01 01 62 00 00 B8 D4 01 01 01 63 00 00 B9 D4 01 01 01 64 00 00 BB D4 01 01 01 66 00 00' - 'BD D4 01 01 01 68 00 00 BE D4 01 01 01 69 00 00 BF D4 01 01 01 6A 00 00 C0 D4 01 01 01 6B 00 00' - 'C1 D4 01 01 01 6C 00 00 C2 D4 01 01 01 6D 00 00 C3 D4 01 01 01 6E 00 00 C5 D4 01 01 01 70 00 00' - 'C6 D4 01 01 01 71 00 00 C7 D4 01 01 01 72 00 00 C8 D4 01 01 01 73 00 00 C9 D4 01 01 01 74 00 00' - 'CA D4 01 01 01 75 00 00 CB D4 01 01 01 76 00 00 CC D4 01 01 01 77 00 00 CD D4 01 01 01 78 00 00' - 'CE D4 01 01 01 79 00 00 CF D4 01 01 01 7A 00 00 D0 D4 01 01 01 41 00 00 D1 D4 01 01 01 42 00 00' - 'D2 D4 01 01 01 43 00 00 D3 D4 01 01 01 44 00 00 D4 D4 01 01 01 45 00 00 D5 D4 01 01 01 46 00 00' - 'D6 D4 01 01 01 47 00 00 D7 D4 01 01 01 48 00 00 D8 D4 01 01 01 49 00 00 D9 D4 01 01 01 4A 00 00' - 'DA D4 01 01 01 4B 00 00 DB D4 01 01 01 4C 00 00 DC D4 01 01 01 4D 00 00 DD D4 01 01 01 4E 00 00' - 'DE D4 01 01 01 4F 00 00 DF D4 01 01 01 50 00 00 E0 D4 01 01 01 51 00 00 E1 D4 01 01 01 52 00 00' - 'E2 D4 01 01 01 53 00 00 E3 D4 01 01 01 54 00 00 E4 D4 01 01 01 55 00 00 E5 D4 01 01 01 56 00 00' - 'E6 D4 01 01 01 57 00 00 E7 D4 01 01 01 58 00 00 E8 D4 01 01 01 59 00 00 E9 D4 01 01 01 5A 00 00' - 'EA D4 01 01 01 61 00 00 EB D4 01 01 01 62 00 00 EC D4 01 01 01 63 00 00 ED D4 01 01 01 64 00 00' - 'EE D4 01 01 01 65 00 00 EF D4 01 01 01 66 00 00 F0 D4 01 01 01 67 00 00 F1 D4 01 01 01 68 00 00' - 'F2 D4 01 01 01 69 00 00 F3 D4 01 01 01 6A 00 00 F4 D4 01 01 01 6B 00 00 F5 D4 01 01 01 6C 00 00' - 'F6 D4 01 01 01 6D 00 00 F7 D4 01 01 01 6E 00 00 F8 D4 01 01 01 6F 00 00 F9 D4 01 01 01 70 00 00' - 'FA D4 01 01 01 71 00 00 FB D4 01 01 01 72 00 00 FC D4 01 01 01 73 00 00 FD D4 01 01 01 74 00 00' - 'FE D4 01 01 01 75 00 00 FF D4 01 01 01 76 00 00 00 D5 01 01 01 77 00 00 01 D5 01 01 01 78 00 00' - '02 D5 01 01 01 79 00 00 03 D5 01 01 01 7A 00 00 04 D5 01 01 01 41 00 00 05 D5 01 01 01 42 00 00' - '07 D5 01 01 01 44 00 00 08 D5 01 01 01 45 00 00 09 D5 01 01 01 46 00 00 0A D5 01 01 01 47 00 00' - '0D D5 01 01 01 4A 00 00 0E D5 01 01 01 4B 00 00 0F D5 01 01 01 4C 00 00 10 D5 01 01 01 4D 00 00' - '11 D5 01 01 01 4E 00 00 12 D5 01 01 01 4F 00 00 13 D5 01 01 01 50 00 00 14 D5 01 01 01 51 00 00' - '16 D5 01 01 01 53 00 00 17 D5 01 01 01 54 00 00 18 D5 01 01 01 55 00 00 19 D5 01 01 01 56 00 00' - '1A D5 01 01 01 57 00 00 1B D5 01 01 01 58 00 00 1C D5 01 01 01 59 00 00 1E D5 01 01 01 61 00 00' - '1F D5 01 01 01 62 00 00 20 D5 01 01 01 63 00 00 21 D5 01 01 01 64 00 00 22 D5 01 01 01 65 00 00' - '23 D5 01 01 01 66 00 00 24 D5 01 01 01 67 00 00 25 D5 01 01 01 68 00 00 26 D5 01 01 01 69 00 00' - '27 D5 01 01 01 6A 00 00 28 D5 01 01 01 6B 00 00 29 D5 01 01 01 6C 00 00 2A D5 01 01 01 6D 00 00' - '2B D5 01 01 01 6E 00 00 2C D5 01 01 01 6F 00 00 2D D5 01 01 01 70 00 00 2E D5 01 01 01 71 00 00' - '2F D5 01 01 01 72 00 00 30 D5 01 01 01 73 00 00 31 D5 01 01 01 74 00 00 32 D5 01 01 01 75 00 00' - '33 D5 01 01 01 76 00 00 34 D5 01 01 01 77 00 00 35 D5 01 01 01 78 00 00 36 D5 01 01 01 79 00 00' - '37 D5 01 01 01 7A 00 00 38 D5 01 01 01 41 00 00 39 D5 01 01 01 42 00 00 3B D5 01 01 01 44 00 00' - '3C D5 01 01 01 45 00 00 3D D5 01 01 01 46 00 00 3E D5 01 01 01 47 00 00 40 D5 01 01 01 49 00 00' - '41 D5 01 01 01 4A 00 00 42 D5 01 01 01 4B 00 00 43 D5 01 01 01 4C 00 00 44 D5 01 01 01 4D 00 00' - '46 D5 01 01 01 4F 00 00 4A D5 01 01 01 53 00 00 4B D5 01 01 01 54 00 00 4C D5 01 01 01 55 00 00' - '4D D5 01 01 01 56 00 00 4E D5 01 01 01 57 00 00 4F D5 01 01 01 58 00 00 50 D5 01 01 01 59 00 00' - '52 D5 01 01 01 61 00 00 53 D5 01 01 01 62 00 00 54 D5 01 01 01 63 00 00 55 D5 01 01 01 64 00 00' - '56 D5 01 01 01 65 00 00 57 D5 01 01 01 66 00 00 58 D5 01 01 01 67 00 00 59 D5 01 01 01 68 00 00' - '5A D5 01 01 01 69 00 00 5B D5 01 01 01 6A 00 00 5C D5 01 01 01 6B 00 00 5D D5 01 01 01 6C 00 00' - '5E D5 01 01 01 6D 00 00 5F D5 01 01 01 6E 00 00 60 D5 01 01 01 6F 00 00 61 D5 01 01 01 70 00 00' - '62 D5 01 01 01 71 00 00 63 D5 01 01 01 72 00 00 64 D5 01 01 01 73 00 00 65 D5 01 01 01 74 00 00' - '66 D5 01 01 01 75 00 00 67 D5 01 01 01 76 00 00 68 D5 01 01 01 77 00 00 69 D5 01 01 01 78 00 00' - '6A D5 01 01 01 79 00 00 6B D5 01 01 01 7A 00 00 6C D5 01 01 01 41 00 00 6D D5 01 01 01 42 00 00' - '6E D5 01 01 01 43 00 00 6F D5 01 01 01 44 00 00 70 D5 01 01 01 45 00 00 71 D5 01 01 01 46 00 00' - '72 D5 01 01 01 47 00 00 73 D5 01 01 01 48 00 00 74 D5 01 01 01 49 00 00 75 D5 01 01 01 4A 00 00' - '76 D5 01 01 01 4B 00 00 77 D5 01 01 01 4C 00 00 78 D5 01 01 01 4D 00 00 79 D5 01 01 01 4E 00 00' - '7A D5 01 01 01 4F 00 00 7B D5 01 01 01 50 00 00 7C D5 01 01 01 51 00 00 7D D5 01 01 01 52 00 00' - '7E D5 01 01 01 53 00 00 7F D5 01 01 01 54 00 00 80 D5 01 01 01 55 00 00 81 D5 01 01 01 56 00 00' - '82 D5 01 01 01 57 00 00 83 D5 01 01 01 58 00 00 84 D5 01 01 01 59 00 00 85 D5 01 01 01 5A 00 00' - '86 D5 01 01 01 61 00 00 87 D5 01 01 01 62 00 00 88 D5 01 01 01 63 00 00 89 D5 01 01 01 64 00 00' - '8A D5 01 01 01 65 00 00 8B D5 01 01 01 66 00 00 8C D5 01 01 01 67 00 00 8D D5 01 01 01 68 00 00' - '8E D5 01 01 01 69 00 00 8F D5 01 01 01 6A 00 00 90 D5 01 01 01 6B 00 00 91 D5 01 01 01 6C 00 00' - '92 D5 01 01 01 6D 00 00 93 D5 01 01 01 6E 00 00 94 D5 01 01 01 6F 00 00 95 D5 01 01 01 70 00 00' - '96 D5 01 01 01 71 00 00 97 D5 01 01 01 72 00 00 98 D5 01 01 01 73 00 00 99 D5 01 01 01 74 00 00' - '9A D5 01 01 01 75 00 00 9B D5 01 01 01 76 00 00 9C D5 01 01 01 77 00 00 9D D5 01 01 01 78 00 00' - '9E D5 01 01 01 79 00 00 9F D5 01 01 01 7A 00 00 A0 D5 01 01 01 41 00 00 A1 D5 01 01 01 42 00 00' - 'A2 D5 01 01 01 43 00 00 A3 D5 01 01 01 44 00 00 A4 D5 01 01 01 45 00 00 A5 D5 01 01 01 46 00 00' - 'A6 D5 01 01 01 47 00 00 A7 D5 01 01 01 48 00 00 A8 D5 01 01 01 49 00 00 A9 D5 01 01 01 4A 00 00' - 'AA D5 01 01 01 4B 00 00 AB D5 01 01 01 4C 00 00 AC D5 01 01 01 4D 00 00 AD D5 01 01 01 4E 00 00' - 'AE D5 01 01 01 4F 00 00 AF D5 01 01 01 50 00 00 B0 D5 01 01 01 51 00 00 B1 D5 01 01 01 52 00 00' - 'B2 D5 01 01 01 53 00 00 B3 D5 01 01 01 54 00 00 B4 D5 01 01 01 55 00 00 B5 D5 01 01 01 56 00 00' - 'B6 D5 01 01 01 57 00 00 B7 D5 01 01 01 58 00 00 B8 D5 01 01 01 59 00 00 B9 D5 01 01 01 5A 00 00' - 'BA D5 01 01 01 61 00 00 BB D5 01 01 01 62 00 00 BC D5 01 01 01 63 00 00 BD D5 01 01 01 64 00 00' - 'BE D5 01 01 01 65 00 00 BF D5 01 01 01 66 00 00 C0 D5 01 01 01 67 00 00 C1 D5 01 01 01 68 00 00' - 'C2 D5 01 01 01 69 00 00 C3 D5 01 01 01 6A 00 00 C4 D5 01 01 01 6B 00 00 C5 D5 01 01 01 6C 00 00' - 'C6 D5 01 01 01 6D 00 00 C7 D5 01 01 01 6E 00 00 C8 D5 01 01 01 6F 00 00 C9 D5 01 01 01 70 00 00' - 'CA D5 01 01 01 71 00 00 CB D5 01 01 01 72 00 00 CC D5 01 01 01 73 00 00 CD D5 01 01 01 74 00 00' - 'CE D5 01 01 01 75 00 00 CF D5 01 01 01 76 00 00 D0 D5 01 01 01 77 00 00 D1 D5 01 01 01 78 00 00' - 'D2 D5 01 01 01 79 00 00 D3 D5 01 01 01 7A 00 00 D4 D5 01 01 01 41 00 00 D5 D5 01 01 01 42 00 00' - 'D6 D5 01 01 01 43 00 00 D7 D5 01 01 01 44 00 00 D8 D5 01 01 01 45 00 00 D9 D5 01 01 01 46 00 00' - 'DA D5 01 01 01 47 00 00 DB D5 01 01 01 48 00 00 DC D5 01 01 01 49 00 00 DD D5 01 01 01 4A 00 00' - 'DE D5 01 01 01 4B 00 00 DF D5 01 01 01 4C 00 00 E0 D5 01 01 01 4D 00 00 E1 D5 01 01 01 4E 00 00' - 'E2 D5 01 01 01 4F 00 00 E3 D5 01 01 01 50 00 00 E4 D5 01 01 01 51 00 00 E5 D5 01 01 01 52 00 00' - 'E6 D5 01 01 01 53 00 00 E7 D5 01 01 01 54 00 00 E8 D5 01 01 01 55 00 00 E9 D5 01 01 01 56 00 00' - 'EA D5 01 01 01 57 00 00 EB D5 01 01 01 58 00 00 EC D5 01 01 01 59 00 00 ED D5 01 01 01 5A 00 00' - 'EE D5 01 01 01 61 00 00 EF D5 01 01 01 62 00 00 F0 D5 01 01 01 63 00 00 F1 D5 01 01 01 64 00 00' - 'F2 D5 01 01 01 65 00 00 F3 D5 01 01 01 66 00 00 F4 D5 01 01 01 67 00 00 F5 D5 01 01 01 68 00 00' - 'F6 D5 01 01 01 69 00 00 F7 D5 01 01 01 6A 00 00 F8 D5 01 01 01 6B 00 00 F9 D5 01 01 01 6C 00 00' - 'FA D5 01 01 01 6D 00 00 FB D5 01 01 01 6E 00 00 FC D5 01 01 01 6F 00 00 FD D5 01 01 01 70 00 00' - 'FE D5 01 01 01 71 00 00 FF D5 01 01 01 72 00 00 00 D6 01 01 01 73 00 00 01 D6 01 01 01 74 00 00' - '02 D6 01 01 01 75 00 00 03 D6 01 01 01 76 00 00 04 D6 01 01 01 77 00 00 05 D6 01 01 01 78 00 00' - '06 D6 01 01 01 79 00 00 07 D6 01 01 01 7A 00 00 08 D6 01 01 01 41 00 00 09 D6 01 01 01 42 00 00' - '0A D6 01 01 01 43 00 00 0B D6 01 01 01 44 00 00 0C D6 01 01 01 45 00 00 0D D6 01 01 01 46 00 00' - '0E D6 01 01 01 47 00 00 0F D6 01 01 01 48 00 00 10 D6 01 01 01 49 00 00 11 D6 01 01 01 4A 00 00' - '12 D6 01 01 01 4B 00 00 13 D6 01 01 01 4C 00 00 14 D6 01 01 01 4D 00 00 15 D6 01 01 01 4E 00 00' - '16 D6 01 01 01 4F 00 00 17 D6 01 01 01 50 00 00 18 D6 01 01 01 51 00 00 19 D6 01 01 01 52 00 00' - '1A D6 01 01 01 53 00 00 1B D6 01 01 01 54 00 00 1C D6 01 01 01 55 00 00 1D D6 01 01 01 56 00 00' - '1E D6 01 01 01 57 00 00 1F D6 01 01 01 58 00 00 20 D6 01 01 01 59 00 00 21 D6 01 01 01 5A 00 00' - '22 D6 01 01 01 61 00 00 23 D6 01 01 01 62 00 00 24 D6 01 01 01 63 00 00 25 D6 01 01 01 64 00 00' - '26 D6 01 01 01 65 00 00 27 D6 01 01 01 66 00 00 28 D6 01 01 01 67 00 00 29 D6 01 01 01 68 00 00' - '2A D6 01 01 01 69 00 00 2B D6 01 01 01 6A 00 00 2C D6 01 01 01 6B 00 00 2D D6 01 01 01 6C 00 00' - '2E D6 01 01 01 6D 00 00 2F D6 01 01 01 6E 00 00 30 D6 01 01 01 6F 00 00 31 D6 01 01 01 70 00 00' - '32 D6 01 01 01 71 00 00 33 D6 01 01 01 72 00 00 34 D6 01 01 01 73 00 00 35 D6 01 01 01 74 00 00' - '36 D6 01 01 01 75 00 00 37 D6 01 01 01 76 00 00 38 D6 01 01 01 77 00 00 39 D6 01 01 01 78 00 00' - '3A D6 01 01 01 79 00 00 3B D6 01 01 01 7A 00 00 3C D6 01 01 01 41 00 00 3D D6 01 01 01 42 00 00' - '3E D6 01 01 01 43 00 00 3F D6 01 01 01 44 00 00 40 D6 01 01 01 45 00 00 41 D6 01 01 01 46 00 00' - '42 D6 01 01 01 47 00 00 43 D6 01 01 01 48 00 00 44 D6 01 01 01 49 00 00 45 D6 01 01 01 4A 00 00' - '46 D6 01 01 01 4B 00 00 47 D6 01 01 01 4C 00 00 48 D6 01 01 01 4D 00 00 49 D6 01 01 01 4E 00 00' - '4A D6 01 01 01 4F 00 00 4B D6 01 01 01 50 00 00 4C D6 01 01 01 51 00 00 4D D6 01 01 01 52 00 00' - '4E D6 01 01 01 53 00 00 4F D6 01 01 01 54 00 00 50 D6 01 01 01 55 00 00 51 D6 01 01 01 56 00 00' - '52 D6 01 01 01 57 00 00 53 D6 01 01 01 58 00 00 54 D6 01 01 01 59 00 00 55 D6 01 01 01 5A 00 00' - '56 D6 01 01 01 61 00 00 57 D6 01 01 01 62 00 00 58 D6 01 01 01 63 00 00 59 D6 01 01 01 64 00 00' - '5A D6 01 01 01 65 00 00 5B D6 01 01 01 66 00 00 5C D6 01 01 01 67 00 00 5D D6 01 01 01 68 00 00' - '5E D6 01 01 01 69 00 00 5F D6 01 01 01 6A 00 00 60 D6 01 01 01 6B 00 00 61 D6 01 01 01 6C 00 00' - '62 D6 01 01 01 6D 00 00 63 D6 01 01 01 6E 00 00 64 D6 01 01 01 6F 00 00 65 D6 01 01 01 70 00 00' - '66 D6 01 01 01 71 00 00 67 D6 01 01 01 72 00 00 68 D6 01 01 01 73 00 00 69 D6 01 01 01 74 00 00' - '6A D6 01 01 01 75 00 00 6B D6 01 01 01 76 00 00 6C D6 01 01 01 77 00 00 6D D6 01 01 01 78 00 00' - '6E D6 01 01 01 79 00 00 6F D6 01 01 01 7A 00 00 70 D6 01 01 01 41 00 00 71 D6 01 01 01 42 00 00' - '72 D6 01 01 01 43 00 00 73 D6 01 01 01 44 00 00 74 D6 01 01 01 45 00 00 75 D6 01 01 01 46 00 00' - '76 D6 01 01 01 47 00 00 77 D6 01 01 01 48 00 00 78 D6 01 01 01 49 00 00 79 D6 01 01 01 4A 00 00' - '7A D6 01 01 01 4B 00 00 7B D6 01 01 01 4C 00 00 7C D6 01 01 01 4D 00 00 7D D6 01 01 01 4E 00 00' - '7E D6 01 01 01 4F 00 00 7F D6 01 01 01 50 00 00 80 D6 01 01 01 51 00 00 81 D6 01 01 01 52 00 00' - '82 D6 01 01 01 53 00 00 83 D6 01 01 01 54 00 00 84 D6 01 01 01 55 00 00 85 D6 01 01 01 56 00 00' - '86 D6 01 01 01 57 00 00 87 D6 01 01 01 58 00 00 88 D6 01 01 01 59 00 00 89 D6 01 01 01 5A 00 00' - '8A D6 01 01 01 61 00 00 8B D6 01 01 01 62 00 00 8C D6 01 01 01 63 00 00 8D D6 01 01 01 64 00 00' - '8E D6 01 01 01 65 00 00 8F D6 01 01 01 66 00 00 90 D6 01 01 01 67 00 00 91 D6 01 01 01 68 00 00' - '92 D6 01 01 01 69 00 00 93 D6 01 01 01 6A 00 00 94 D6 01 01 01 6B 00 00 95 D6 01 01 01 6C 00 00' - '96 D6 01 01 01 6D 00 00 97 D6 01 01 01 6E 00 00 98 D6 01 01 01 6F 00 00 99 D6 01 01 01 70 00 00' - '9A D6 01 01 01 71 00 00 9B D6 01 01 01 72 00 00 9C D6 01 01 01 73 00 00 9D D6 01 01 01 74 00 00' - '9E D6 01 01 01 75 00 00 9F D6 01 01 01 76 00 00 A0 D6 01 01 01 77 00 00 A1 D6 01 01 01 78 00 00' - 'A2 D6 01 01 01 79 00 00 A3 D6 01 01 01 7A 00 00 A4 D6 01 01 01 31 01 00 A5 D6 01 01 01 37 02 00' - 'A8 D6 01 01 01 91 03 00 A9 D6 01 01 01 92 03 00 AA D6 01 01 01 93 03 00 AB D6 01 01 01 94 03 00' - 'AC D6 01 01 01 95 03 00 AD D6 01 01 01 96 03 00 AE D6 01 01 01 97 03 00 AF D6 01 01 01 98 03 00' - 'B0 D6 01 01 01 99 03 00 B1 D6 01 01 01 9A 03 00 B2 D6 01 01 01 9B 03 00 B3 D6 01 01 01 9C 03 00' - 'B4 D6 01 01 01 9D 03 00 B5 D6 01 01 01 9E 03 00 B6 D6 01 01 01 9F 03 00 B7 D6 01 01 01 A0 03 00' - 'B8 D6 01 01 01 A1 03 00 B9 D6 01 01 01 98 03 00 BA D6 01 01 01 A3 03 00 BB D6 01 01 01 A4 03 00' - 'BC D6 01 01 01 A5 03 00 BD D6 01 01 01 A6 03 00 BE D6 01 01 01 A7 03 00 BF D6 01 01 01 A8 03 00' - 'C0 D6 01 01 01 A9 03 00 C1 D6 01 01 01 07 22 00 C2 D6 01 01 01 B1 03 00 C3 D6 01 01 01 B2 03 00' - 'C4 D6 01 01 01 B3 03 00 C5 D6 01 01 01 B4 03 00 C6 D6 01 01 01 B5 03 00 C7 D6 01 01 01 B6 03 00' - 'C8 D6 01 01 01 B7 03 00 C9 D6 01 01 01 B8 03 00 CA D6 01 01 01 B9 03 00 CB D6 01 01 01 BA 03 00' - 'CC D6 01 01 01 BB 03 00 CD D6 01 01 01 BC 03 00 CE D6 01 01 01 BD 03 00 CF D6 01 01 01 BE 03 00' - 'D0 D6 01 01 01 BF 03 00 D1 D6 01 01 01 C0 03 00 D2 D6 01 01 01 C1 03 00 D3 D6 01 01 01 C2 03 00' - 'D4 D6 01 01 01 C3 03 00 D5 D6 01 01 01 C4 03 00 D6 D6 01 01 01 C5 03 00 D7 D6 01 01 01 C6 03 00' - 'D8 D6 01 01 01 C7 03 00 D9 D6 01 01 01 C8 03 00 DA D6 01 01 01 C9 03 00 DB D6 01 01 01 02 22 00' - 'DC D6 01 01 01 B5 03 00 DD D6 01 01 01 B8 03 00 DE D6 01 01 01 BA 03 00 DF D6 01 01 01 C6 03 00' - 'E0 D6 01 01 01 C1 03 00 E1 D6 01 01 01 C0 03 00 E2 D6 01 01 01 91 03 00 E3 D6 01 01 01 92 03 00' - 'E4 D6 01 01 01 93 03 00 E5 D6 01 01 01 94 03 00 E6 D6 01 01 01 95 03 00 E7 D6 01 01 01 96 03 00' - 'E8 D6 01 01 01 97 03 00 E9 D6 01 01 01 98 03 00 EA D6 01 01 01 99 03 00 EB D6 01 01 01 9A 03 00' - 'EC D6 01 01 01 9B 03 00 ED D6 01 01 01 9C 03 00 EE D6 01 01 01 9D 03 00 EF D6 01 01 01 9E 03 00' - 'F0 D6 01 01 01 9F 03 00 F1 D6 01 01 01 A0 03 00 F2 D6 01 01 01 A1 03 00 F3 D6 01 01 01 98 03 00' - 'F4 D6 01 01 01 A3 03 00 F5 D6 01 01 01 A4 03 00 F6 D6 01 01 01 A5 03 00 F7 D6 01 01 01 A6 03 00' - 'F8 D6 01 01 01 A7 03 00 F9 D6 01 01 01 A8 03 00 FA D6 01 01 01 A9 03 00 FB D6 01 01 01 07 22 00' - 'FC D6 01 01 01 B1 03 00 FD D6 01 01 01 B2 03 00 FE D6 01 01 01 B3 03 00 FF D6 01 01 01 B4 03 00' - '00 D7 01 01 01 B5 03 00 01 D7 01 01 01 B6 03 00 02 D7 01 01 01 B7 03 00 03 D7 01 01 01 B8 03 00' - '04 D7 01 01 01 B9 03 00 05 D7 01 01 01 BA 03 00 06 D7 01 01 01 BB 03 00 07 D7 01 01 01 BC 03 00' - '08 D7 01 01 01 BD 03 00 09 D7 01 01 01 BE 03 00 0A D7 01 01 01 BF 03 00 0B D7 01 01 01 C0 03 00' - '0C D7 01 01 01 C1 03 00 0D D7 01 01 01 C2 03 00 0E D7 01 01 01 C3 03 00 0F D7 01 01 01 C4 03 00' - '10 D7 01 01 01 C5 03 00 11 D7 01 01 01 C6 03 00 12 D7 01 01 01 C7 03 00 13 D7 01 01 01 C8 03 00' - '14 D7 01 01 01 C9 03 00 15 D7 01 01 01 02 22 00 16 D7 01 01 01 B5 03 00 17 D7 01 01 01 B8 03 00' - '18 D7 01 01 01 BA 03 00 19 D7 01 01 01 C6 03 00 1A D7 01 01 01 C1 03 00 1B D7 01 01 01 C0 03 00' - '1C D7 01 01 01 91 03 00 1D D7 01 01 01 92 03 00 1E D7 01 01 01 93 03 00 1F D7 01 01 01 94 03 00' - '20 D7 01 01 01 95 03 00 21 D7 01 01 01 96 03 00 22 D7 01 01 01 97 03 00 23 D7 01 01 01 98 03 00' - '24 D7 01 01 01 99 03 00 25 D7 01 01 01 9A 03 00 26 D7 01 01 01 9B 03 00 27 D7 01 01 01 9C 03 00' - '28 D7 01 01 01 9D 03 00 29 D7 01 01 01 9E 03 00 2A D7 01 01 01 9F 03 00 2B D7 01 01 01 A0 03 00' - '2C D7 01 01 01 A1 03 00 2D D7 01 01 01 98 03 00 2E D7 01 01 01 A3 03 00 2F D7 01 01 01 A4 03 00' - '30 D7 01 01 01 A5 03 00 31 D7 01 01 01 A6 03 00 32 D7 01 01 01 A7 03 00 33 D7 01 01 01 A8 03 00' - '34 D7 01 01 01 A9 03 00 35 D7 01 01 01 07 22 00 36 D7 01 01 01 B1 03 00 37 D7 01 01 01 B2 03 00' - '38 D7 01 01 01 B3 03 00 39 D7 01 01 01 B4 03 00 3A D7 01 01 01 B5 03 00 3B D7 01 01 01 B6 03 00' - '3C D7 01 01 01 B7 03 00 3D D7 01 01 01 B8 03 00 3E D7 01 01 01 B9 03 00 3F D7 01 01 01 BA 03 00' - '40 D7 01 01 01 BB 03 00 41 D7 01 01 01 BC 03 00 42 D7 01 01 01 BD 03 00 43 D7 01 01 01 BE 03 00' - '44 D7 01 01 01 BF 03 00 45 D7 01 01 01 C0 03 00 46 D7 01 01 01 C1 03 00 47 D7 01 01 01 C2 03 00' - '48 D7 01 01 01 C3 03 00 49 D7 01 01 01 C4 03 00 4A D7 01 01 01 C5 03 00 4B D7 01 01 01 C6 03 00' - '4C D7 01 01 01 C7 03 00 4D D7 01 01 01 C8 03 00 4E D7 01 01 01 C9 03 00 4F D7 01 01 01 02 22 00' - '50 D7 01 01 01 B5 03 00 51 D7 01 01 01 B8 03 00 52 D7 01 01 01 BA 03 00 53 D7 01 01 01 C6 03 00' - '54 D7 01 01 01 C1 03 00 55 D7 01 01 01 C0 03 00 56 D7 01 01 01 91 03 00 57 D7 01 01 01 92 03 00' - '58 D7 01 01 01 93 03 00 59 D7 01 01 01 94 03 00 5A D7 01 01 01 95 03 00 5B D7 01 01 01 96 03 00' - '5C D7 01 01 01 97 03 00 5D D7 01 01 01 98 03 00 5E D7 01 01 01 99 03 00 5F D7 01 01 01 9A 03 00' - '60 D7 01 01 01 9B 03 00 61 D7 01 01 01 9C 03 00 62 D7 01 01 01 9D 03 00 63 D7 01 01 01 9E 03 00' - '64 D7 01 01 01 9F 03 00 65 D7 01 01 01 A0 03 00 66 D7 01 01 01 A1 03 00 67 D7 01 01 01 98 03 00' - '68 D7 01 01 01 A3 03 00 69 D7 01 01 01 A4 03 00 6A D7 01 01 01 A5 03 00 6B D7 01 01 01 A6 03 00' - '6C D7 01 01 01 A7 03 00 6D D7 01 01 01 A8 03 00 6E D7 01 01 01 A9 03 00 6F D7 01 01 01 07 22 00' - '70 D7 01 01 01 B1 03 00 71 D7 01 01 01 B2 03 00 72 D7 01 01 01 B3 03 00 73 D7 01 01 01 B4 03 00' - '74 D7 01 01 01 B5 03 00 75 D7 01 01 01 B6 03 00 76 D7 01 01 01 B7 03 00 77 D7 01 01 01 B8 03 00' - '78 D7 01 01 01 B9 03 00 79 D7 01 01 01 BA 03 00 7A D7 01 01 01 BB 03 00 7B D7 01 01 01 BC 03 00' - '7C D7 01 01 01 BD 03 00 7D D7 01 01 01 BE 03 00 7E D7 01 01 01 BF 03 00 7F D7 01 01 01 C0 03 00' - '80 D7 01 01 01 C1 03 00 81 D7 01 01 01 C2 03 00 82 D7 01 01 01 C3 03 00 83 D7 01 01 01 C4 03 00' - '84 D7 01 01 01 C5 03 00 85 D7 01 01 01 C6 03 00 86 D7 01 01 01 C7 03 00 87 D7 01 01 01 C8 03 00' - '88 D7 01 01 01 C9 03 00 89 D7 01 01 01 02 22 00 8A D7 01 01 01 B5 03 00 8B D7 01 01 01 B8 03 00' - '8C D7 01 01 01 BA 03 00 8D D7 01 01 01 C6 03 00 8E D7 01 01 01 C1 03 00 8F D7 01 01 01 C0 03 00' - '90 D7 01 01 01 91 03 00 91 D7 01 01 01 92 03 00 92 D7 01 01 01 93 03 00 93 D7 01 01 01 94 03 00' - '94 D7 01 01 01 95 03 00 95 D7 01 01 01 96 03 00 96 D7 01 01 01 97 03 00 97 D7 01 01 01 98 03 00' - '98 D7 01 01 01 99 03 00 99 D7 01 01 01 9A 03 00 9A D7 01 01 01 9B 03 00 9B D7 01 01 01 9C 03 00' - '9C D7 01 01 01 9D 03 00 9D D7 01 01 01 9E 03 00 9E D7 01 01 01 9F 03 00 9F D7 01 01 01 A0 03 00' - 'A0 D7 01 01 01 A1 03 00 A1 D7 01 01 01 98 03 00 A2 D7 01 01 01 A3 03 00 A3 D7 01 01 01 A4 03 00' - 'A4 D7 01 01 01 A5 03 00 A5 D7 01 01 01 A6 03 00 A6 D7 01 01 01 A7 03 00 A7 D7 01 01 01 A8 03 00' - 'A8 D7 01 01 01 A9 03 00 A9 D7 01 01 01 07 22 00 AA D7 01 01 01 B1 03 00 AB D7 01 01 01 B2 03 00' - 'AC D7 01 01 01 B3 03 00 AD D7 01 01 01 B4 03 00 AE D7 01 01 01 B5 03 00 AF D7 01 01 01 B6 03 00' - 'B0 D7 01 01 01 B7 03 00 B1 D7 01 01 01 B8 03 00 B2 D7 01 01 01 B9 03 00 B3 D7 01 01 01 BA 03 00' - 'B4 D7 01 01 01 BB 03 00 B5 D7 01 01 01 BC 03 00 B6 D7 01 01 01 BD 03 00 B7 D7 01 01 01 BE 03 00' - 'B8 D7 01 01 01 BF 03 00 B9 D7 01 01 01 C0 03 00 BA D7 01 01 01 C1 03 00 BB D7 01 01 01 C2 03 00' - 'BC D7 01 01 01 C3 03 00 BD D7 01 01 01 C4 03 00 BE D7 01 01 01 C5 03 00 BF D7 01 01 01 C6 03 00' - 'C0 D7 01 01 01 C7 03 00 C1 D7 01 01 01 C8 03 00 C2 D7 01 01 01 C9 03 00 C3 D7 01 01 01 02 22 00' - 'C4 D7 01 01 01 B5 03 00 C5 D7 01 01 01 B8 03 00 C6 D7 01 01 01 BA 03 00 C7 D7 01 01 01 C6 03 00' - 'C8 D7 01 01 01 C1 03 00 C9 D7 01 01 01 C0 03 00 CA D7 01 01 01 DC 03 00 CB D7 01 01 01 DD 03 00' - 'CE D7 01 01 01 30 00 00 CF D7 01 01 01 31 00 00 D0 D7 01 01 01 32 00 00 D1 D7 01 01 01 33 00 00' - 'D2 D7 01 01 01 34 00 00 D3 D7 01 01 01 35 00 00 D4 D7 01 01 01 36 00 00 D5 D7 01 01 01 37 00 00' - 'D6 D7 01 01 01 38 00 00 D7 D7 01 01 01 39 00 00 D8 D7 01 01 01 30 00 00 D9 D7 01 01 01 31 00 00' - 'DA D7 01 01 01 32 00 00 DB D7 01 01 01 33 00 00 DC D7 01 01 01 34 00 00 DD D7 01 01 01 35 00 00' - 'DE D7 01 01 01 36 00 00 DF D7 01 01 01 37 00 00 E0 D7 01 01 01 38 00 00 E1 D7 01 01 01 39 00 00' - 'E2 D7 01 01 01 30 00 00 E3 D7 01 01 01 31 00 00 E4 D7 01 01 01 32 00 00 E5 D7 01 01 01 33 00 00' - 'E6 D7 01 01 01 34 00 00 E7 D7 01 01 01 35 00 00 E8 D7 01 01 01 36 00 00 E9 D7 01 01 01 37 00 00' - 'EA D7 01 01 01 38 00 00 EB D7 01 01 01 39 00 00 EC D7 01 01 01 30 00 00 ED D7 01 01 01 31 00 00' - 'EE D7 01 01 01 32 00 00 EF D7 01 01 01 33 00 00 F0 D7 01 01 01 34 00 00 F1 D7 01 01 01 35 00 00' - 'F2 D7 01 01 01 36 00 00 F3 D7 01 01 01 37 00 00 F4 D7 01 01 01 38 00 00 F5 D7 01 01 01 39 00 00' - 'F6 D7 01 01 01 30 00 00 F7 D7 01 01 01 31 00 00 F8 D7 01 01 01 32 00 00 F9 D7 01 01 01 33 00 00' - 'FA D7 01 01 01 34 00 00 FB D7 01 01 01 35 00 00 FC D7 01 01 01 36 00 00 FD D7 01 01 01 37 00 00' - 'FE D7 01 01 01 38 00 00 FF D7 01 01 01 39 00 00 00 EE 01 01 01 27 06 00 01 EE 01 01 01 28 06 00' - '02 EE 01 01 01 2C 06 00 03 EE 01 01 01 2F 06 00 05 EE 01 01 01 48 06 00 06 EE 01 01 01 32 06 00' - '07 EE 01 01 01 2D 06 00 08 EE 01 01 01 37 06 00 09 EE 01 01 01 4A 06 00 0A EE 01 01 01 43 06 00' - '0B EE 01 01 01 44 06 00 0C EE 01 01 01 45 06 00 0D EE 01 01 01 46 06 00 0E EE 01 01 01 33 06 00' - '0F EE 01 01 01 39 06 00 10 EE 01 01 01 41 06 00 11 EE 01 01 01 35 06 00 12 EE 01 01 01 42 06 00' - '13 EE 01 01 01 31 06 00 14 EE 01 01 01 34 06 00 15 EE 01 01 01 2A 06 00 16 EE 01 01 01 2B 06 00' - '17 EE 01 01 01 2E 06 00 18 EE 01 01 01 30 06 00 19 EE 01 01 01 36 06 00 1A EE 01 01 01 38 06 00' - '1B EE 01 01 01 3A 06 00 1C EE 01 01 01 6E 06 00 1D EE 01 01 01 BA 06 00 1E EE 01 01 01 A1 06 00' - '1F EE 01 01 01 6F 06 00 21 EE 01 01 01 28 06 00 22 EE 01 01 01 2C 06 00 24 EE 01 01 01 47 06 00' - '27 EE 01 01 01 2D 06 00 29 EE 01 01 01 4A 06 00 2A EE 01 01 01 43 06 00 2B EE 01 01 01 44 06 00' - '2C EE 01 01 01 45 06 00 2D EE 01 01 01 46 06 00 2E EE 01 01 01 33 06 00 2F EE 01 01 01 39 06 00' - '30 EE 01 01 01 41 06 00 31 EE 01 01 01 35 06 00 32 EE 01 01 01 42 06 00 34 EE 01 01 01 34 06 00' - '35 EE 01 01 01 2A 06 00 36 EE 01 01 01 2B 06 00 37 EE 01 01 01 2E 06 00 39 EE 01 01 01 36 06 00' - '3B EE 01 01 01 3A 06 00 42 EE 01 01 01 2C 06 00 47 EE 01 01 01 2D 06 00 49 EE 01 01 01 4A 06 00' - '4B EE 01 01 01 44 06 00 4D EE 01 01 01 46 06 00 4E EE 01 01 01 33 06 00 4F EE 01 01 01 39 06 00' - '51 EE 01 01 01 35 06 00 52 EE 01 01 01 42 06 00 54 EE 01 01 01 34 06 00 57 EE 01 01 01 2E 06 00' - '59 EE 01 01 01 36 06 00 5B EE 01 01 01 3A 06 00 5D EE 01 01 01 BA 06 00 5F EE 01 01 01 6F 06 00' - '61 EE 01 01 01 28 06 00 62 EE 01 01 01 2C 06 00 64 EE 01 01 01 47 06 00 67 EE 01 01 01 2D 06 00' - '68 EE 01 01 01 37 06 00 69 EE 01 01 01 4A 06 00 6A EE 01 01 01 43 06 00 6C EE 01 01 01 45 06 00' - '6D EE 01 01 01 46 06 00 6E EE 01 01 01 33 06 00 6F EE 01 01 01 39 06 00 70 EE 01 01 01 41 06 00' - '71 EE 01 01 01 35 06 00 72 EE 01 01 01 42 06 00 74 EE 01 01 01 34 06 00 75 EE 01 01 01 2A 06 00' - '76 EE 01 01 01 2B 06 00 77 EE 01 01 01 2E 06 00 79 EE 01 01 01 36 06 00 7A EE 01 01 01 38 06 00' - '7B EE 01 01 01 3A 06 00 7C EE 01 01 01 6E 06 00 7E EE 01 01 01 A1 06 00 80 EE 01 01 01 27 06 00' - '81 EE 01 01 01 28 06 00 82 EE 01 01 01 2C 06 00 83 EE 01 01 01 2F 06 00 84 EE 01 01 01 47 06 00' - '85 EE 01 01 01 48 06 00 86 EE 01 01 01 32 06 00 87 EE 01 01 01 2D 06 00 88 EE 01 01 01 37 06 00' - '89 EE 01 01 01 4A 06 00 8B EE 01 01 01 44 06 00 8C EE 01 01 01 45 06 00 8D EE 01 01 01 46 06 00' - '8E EE 01 01 01 33 06 00 8F EE 01 01 01 39 06 00 90 EE 01 01 01 41 06 00 91 EE 01 01 01 35 06 00' - '92 EE 01 01 01 42 06 00 93 EE 01 01 01 31 06 00 94 EE 01 01 01 34 06 00 95 EE 01 01 01 2A 06 00' - '96 EE 01 01 01 2B 06 00 97 EE 01 01 01 2E 06 00 98 EE 01 01 01 30 06 00 99 EE 01 01 01 36 06 00' - '9A EE 01 01 01 38 06 00 9B EE 01 01 01 3A 06 00 A1 EE 01 01 01 28 06 00 A2 EE 01 01 01 2C 06 00' - 'A3 EE 01 01 01 2F 06 00 A5 EE 01 01 01 48 06 00 A6 EE 01 01 01 32 06 00 A7 EE 01 01 01 2D 06 00' - 'A8 EE 01 01 01 37 06 00 A9 EE 01 01 01 4A 06 00 AB EE 01 01 01 44 06 00 AC EE 01 01 01 45 06 00' - 'AD EE 01 01 01 46 06 00 AE EE 01 01 01 33 06 00 AF EE 01 01 01 39 06 00 B0 EE 01 01 01 41 06 00' - 'B1 EE 01 01 01 35 06 00 B2 EE 01 01 01 42 06 00 B3 EE 01 01 01 31 06 00 B4 EE 01 01 01 34 06 00' - 'B5 EE 01 01 01 2A 06 00 B6 EE 01 01 01 2B 06 00 B7 EE 01 01 01 2E 06 00 B8 EE 01 01 01 30 06 00' - 'B9 EE 01 01 01 36 06 00 BA EE 01 01 01 38 06 00 BB EE 01 01 01 3A 06 00 00 F1 01 02 10 30 00 00' - '2E 00 00 01 F1 01 02 10 30 00 00 2C 00 00 02 F1 01 02 10 31 00 00 2C 00 00 03 F1 01 02 10 32 00' - '00 2C 00 00 04 F1 01 02 10 33 00 00 2C 00 00 05 F1 01 02 10 34 00 00 2C 00 00 06 F1 01 02 10 35' - '00 00 2C 00 00 07 F1 01 02 10 36 00 00 2C 00 00 08 F1 01 02 10 37 00 00 2C 00 00 09 F1 01 02 10' - '38 00 00 2C 00 00 0A F1 01 02 10 39 00 00 2C 00 00 10 F1 01 03 10 28 00 00 41 00 00 29 00 00 11' - 'F1 01 03 10 28 00 00 42 00 00 29 00 00 12 F1 01 03 10 28 00 00 43 00 00 29 00 00 13 F1 01 03 10' - '28 00 00 44 00 00 29 00 00 14 F1 01 03 10 28 00 00 45 00 00 29 00 00 15 F1 01 03 10 28 00 00 46' - '00 00 29 00 00 16 F1 01 03 10 28 00 00 47 00 00 29 00 00 17 F1 01 03 10 28 00 00 48 00 00 29 00' - '00 18 F1 01 03 10 28 00 00 49 00 00 29 00 00 19 F1 01 03 10 28 00 00 4A 00 00 29 00 00 1A F1 01' - '03 10 28 00 00 4B 00 00 29 00 00 1B F1 01 03 10 28 00 00 4C 00 00 29 00 00 1C F1 01 03 10 28 00' - '00 4D 00 00 29 00 00 1D F1 01 03 10 28 00 00 4E 00 00 29 00 00 1E F1 01 03 10 28 00 00 4F 00 00' - '29 00 00 1F F1 01 03 10 28 00 00 50 00 00 29 00 00 20 F1 01 03 10 28 00 00 51 00 00 29 00 00 21' - 'F1 01 03 10 28 00 00 52 00 00 29 00 00 22 F1 01 03 10 28 00 00 53 00 00 29 00 00 23 F1 01 03 10' - '28 00 00 54 00 00 29 00 00 24 F1 01 03 10 28 00 00 55 00 00 29 00 00 25 F1 01 03 10 28 00 00 56' - '00 00 29 00 00 26 F1 01 03 10 28 00 00 57 00 00 29 00 00 27 F1 01 03 10 28 00 00 58 00 00 29 00' - '00 28 F1 01 03 10 28 00 00 59 00 00 29 00 00 29 F1 01 03 10 28 00 00 5A 00 00 29 00 00 2A F1 01' - '03 10 14 30 00 53 00 00 15 30 00 2B F1 01 01 07 43 00 00 2C F1 01 01 07 52 00 00 2D F1 01 02 07' - '43 00 00 44 00 00 2E F1 01 02 07 57 00 00 5A 00 00 30 F1 01 01 0E 41 00 00 31 F1 01 01 0E 42 00' - '00 32 F1 01 01 0E 43 00 00 33 F1 01 01 0E 44 00 00 34 F1 01 01 0E 45 00 00 35 F1 01 01 0E 46 00' - '00 36 F1 01 01 0E 47 00 00 37 F1 01 01 0E 48 00 00 38 F1 01 01 0E 49 00 00 39 F1 01 01 0E 4A 00' - '00 3A F1 01 01 0E 4B 00 00 3B F1 01 01 0E 4C 00 00 3C F1 01 01 0E 4D 00 00 3D F1 01 01 0E 4E 00' - '00 3E F1 01 01 0E 4F 00 00 3F F1 01 01 0E 50 00 00 40 F1 01 01 0E 51 00 00 41 F1 01 01 0E 52 00' - '00 42 F1 01 01 0E 53 00 00 43 F1 01 01 0E 54 00 00 44 F1 01 01 0E 55 00 00 45 F1 01 01 0E 56 00' - '00 46 F1 01 01 0E 57 00 00 47 F1 01 01 0E 58 00 00 48 F1 01 01 0E 59 00 00 49 F1 01 01 0E 5A 00' - '00 4A F1 01 02 0E 48 00 00 56 00 00 4B F1 01 02 0E 4D 00 00 56 00 00 4C F1 01 02 0E 53 00 00 44' - '00 00 4D F1 01 02 0E 53 00 00 53 00 00 4E F1 01 03 0E 50 00 00 50 00 00 56 00 00 4F F1 01 02 0E' - '57 00 00 43 00 00 6A F1 01 02 08 4D 00 00 43 00 00 6B F1 01 02 08 4D 00 00 44 00 00 6C F1 01 02' - '08 4D 00 00 52 00 00 90 F1 01 02 0E 44 00 00 4A 00 00 00 F2 01 02 0E 7B 30 00 4B 30 00 01 F2 01' - '02 0E B3 30 00 B3 30 00 02 F2 01 01 0E B5 30 00 10 F2 01 01 0E 4B 62 00 11 F2 01 01 0E 57 5B 00' - '12 F2 01 01 0E CC 53 00 13 F2 01 02 0E C6 30 00 99 30 00 14 F2 01 01 0E 8C 4E 00 15 F2 01 01 0E' - '1A 59 00 16 F2 01 01 0E E3 89 00 17 F2 01 01 0E 29 59 00 18 F2 01 01 0E A4 4E 00 19 F2 01 01 0E' - '20 66 00 1A F2 01 01 0E 21 71 00 1B F2 01 01 0E 99 65 00 1C F2 01 01 0E 4D 52 00 1D F2 01 01 0E' - '8C 5F 00 1E F2 01 01 0E 8D 51 00 1F F2 01 01 0E B0 65 00 20 F2 01 01 0E 1D 52 00 21 F2 01 01 0E' - '42 7D 00 22 F2 01 01 0E 1F 75 00 23 F2 01 01 0E A9 8C 00 24 F2 01 01 0E F0 58 00 25 F2 01 01 0E' - '39 54 00 26 F2 01 01 0E 14 6F 00 27 F2 01 01 0E 95 62 00 28 F2 01 01 0E 55 63 00 29 F2 01 01 0E' - '00 4E 00 2A F2 01 01 0E 09 4E 00 2B F2 01 01 0E 4A 90 00 2C F2 01 01 0E E6 5D 00 2D F2 01 01 0E' - '2D 4E 00 2E F2 01 01 0E F3 53 00 2F F2 01 01 0E 07 63 00 30 F2 01 01 0E 70 8D 00 31 F2 01 01 0E' - '53 62 00 32 F2 01 01 0E 81 79 00 33 F2 01 01 0E 7A 7A 00 34 F2 01 01 0E 08 54 00 35 F2 01 01 0E' - '80 6E 00 36 F2 01 01 0E 09 67 00 37 F2 01 01 0E 08 67 00 38 F2 01 01 0E 33 75 00 39 F2 01 01 0E' - '72 52 00 3A F2 01 01 0E B6 55 00 3B F2 01 01 0E 4D 91 00 40 F2 01 03 10 14 30 00 2C 67 00 15 30' - '00 41 F2 01 03 10 14 30 00 09 4E 00 15 30 00 42 F2 01 03 10 14 30 00 8C 4E 00 15 30 00 43 F2 01' - '03 10 14 30 00 89 5B 00 15 30 00 44 F2 01 03 10 14 30 00 B9 70 00 15 30 00 45 F2 01 03 10 14 30' - '00 53 62 00 15 30 00 46 F2 01 03 10 14 30 00 D7 76 00 15 30 00 47 F2 01 03 10 14 30 00 DD 52 00' - '15 30 00 48 F2 01 03 10 14 30 00 57 65 00 15 30 00 50 F2 01 01 07 97 5F 00 51 F2 01 01 07 EF 53' - '00 F0 FB 01 01 01 30 00 00 F1 FB 01 01 01 31 00 00 F2 FB 01 01 01 32 00 00 F3 FB 01 01 01 33 00' - '00 F4 FB 01 01 01 34 00 00 F5 FB 01 01 01 35 00 00 F6 FB 01 01 01 36 00 00 F7 FB 01 01 01 37 00' - '00 F8 FB 01 01 01 38 00 00 F9 FB 01 01 01 39 00 00 00 F8 02 01 00 3D 4E 00 01 F8 02 01 00 38 4E' - '00 02 F8 02 01 00 41 4E 00 03 F8 02 01 00 22 01 02 04 F8 02 01 00 60 4F 00 05 F8 02 01 00 AE 4F' - '00 06 F8 02 01 00 BB 4F 00 07 F8 02 01 00 02 50 00 08 F8 02 01 00 7A 50 00 09 F8 02 01 00 99 50' - '00 0A F8 02 01 00 E7 50 00 0B F8 02 01 00 CF 50 00 0C F8 02 01 00 9E 34 00 0D F8 02 01 00 3A 06' - '02 0E F8 02 01 00 4D 51 00 0F F8 02 01 00 54 51 00 10 F8 02 01 00 64 51 00 11 F8 02 01 00 77 51' - '00 12 F8 02 01 00 1C 05 02 13 F8 02 01 00 B9 34 00 14 F8 02 01 00 67 51 00 15 F8 02 01 00 8D 51' - '00 16 F8 02 01 00 4B 05 02 17 F8 02 01 00 97 51 00 18 F8 02 01 00 A4 51 00 19 F8 02 01 00 CC 4E' - '00 1A F8 02 01 00 AC 51 00 1B F8 02 01 00 B5 51 00 1C F8 02 01 00 DF 91 02 1D F8 02 01 00 F5 51' - '00 1E F8 02 01 00 03 52 00 1F F8 02 01 00 DF 34 00 20 F8 02 01 00 3B 52 00 21 F8 02 01 00 46 52' - '00 22 F8 02 01 00 72 52 00 23 F8 02 01 00 77 52 00 24 F8 02 01 00 15 35 00 25 F8 02 01 00 C7 52' - '00 26 F8 02 01 00 C9 52 00 27 F8 02 01 00 E4 52 00 28 F8 02 01 00 FA 52 00 29 F8 02 01 00 05 53' - '00 2A F8 02 01 00 06 53 00 2B F8 02 01 00 17 53 00 2C F8 02 01 00 49 53 00 2D F8 02 01 00 51 53' - '00 2E F8 02 01 00 5A 53 00 2F F8 02 01 00 73 53 00 30 F8 02 01 00 7D 53 00 31 F8 02 01 00 7F 53' - '00 32 F8 02 01 00 7F 53 00 33 F8 02 01 00 7F 53 00 34 F8 02 01 00 2C 0A 02 35 F8 02 01 00 70 70' - '00 36 F8 02 01 00 CA 53 00 37 F8 02 01 00 DF 53 00 38 F8 02 01 00 63 0B 02 39 F8 02 01 00 EB 53' - '00 3A F8 02 01 00 F1 53 00 3B F8 02 01 00 06 54 00 3C F8 02 01 00 9E 54 00 3D F8 02 01 00 38 54' - '00 3E F8 02 01 00 48 54 00 3F F8 02 01 00 68 54 00 40 F8 02 01 00 A2 54 00 41 F8 02 01 00 F6 54' - '00 42 F8 02 01 00 10 55 00 43 F8 02 01 00 53 55 00 44 F8 02 01 00 63 55 00 45 F8 02 01 00 84 55' - '00 46 F8 02 01 00 84 55 00 47 F8 02 01 00 99 55 00 48 F8 02 01 00 AB 55 00 49 F8 02 01 00 B3 55' - '00 4A F8 02 01 00 C2 55 00 4B F8 02 01 00 16 57 00 4C F8 02 01 00 06 56 00 4D F8 02 01 00 17 57' - '00 4E F8 02 01 00 51 56 00 4F F8 02 01 00 74 56 00 50 F8 02 01 00 07 52 00 51 F8 02 01 00 EE 58' - '00 52 F8 02 01 00 CE 57 00 53 F8 02 01 00 F4 57 00 54 F8 02 01 00 0D 58 00 55 F8 02 01 00 8B 57' - '00 56 F8 02 01 00 32 58 00 57 F8 02 01 00 31 58 00 58 F8 02 01 00 AC 58 00 59 F8 02 01 00 E4 14' - '02 5A F8 02 01 00 F2 58 00 5B F8 02 01 00 F7 58 00 5C F8 02 01 00 06 59 00 5D F8 02 01 00 1A 59' - '00 5E F8 02 01 00 22 59 00 5F F8 02 01 00 62 59 00 60 F8 02 01 00 A8 16 02 61 F8 02 01 00 EA 16' - '02 62 F8 02 01 00 EC 59 00 63 F8 02 01 00 1B 5A 00 64 F8 02 01 00 27 5A 00 65 F8 02 01 00 D8 59' - '00 66 F8 02 01 00 66 5A 00 67 F8 02 01 00 EE 36 00 68 F8 02 01 00 FC 36 00 69 F8 02 01 00 08 5B' - '00 6A F8 02 01 00 3E 5B 00 6B F8 02 01 00 3E 5B 00 6C F8 02 01 00 C8 19 02 6D F8 02 01 00 C3 5B' - '00 6E F8 02 01 00 D8 5B 00 6F F8 02 01 00 E7 5B 00 70 F8 02 01 00 F3 5B 00 71 F8 02 01 00 18 1B' - '02 72 F8 02 01 00 FF 5B 00 73 F8 02 01 00 06 5C 00 74 F8 02 01 00 53 5F 00 75 F8 02 01 00 22 5C' - '00 76 F8 02 01 00 81 37 00 77 F8 02 01 00 60 5C 00 78 F8 02 01 00 6E 5C 00 79 F8 02 01 00 C0 5C' - '00 7A F8 02 01 00 8D 5C 00 7B F8 02 01 00 E4 1D 02 7C F8 02 01 00 43 5D 00 7D F8 02 01 00 E6 1D' - '02 7E F8 02 01 00 6E 5D 00 7F F8 02 01 00 6B 5D 00 80 F8 02 01 00 7C 5D 00 81 F8 02 01 00 E1 5D' - '00 82 F8 02 01 00 E2 5D 00 83 F8 02 01 00 2F 38 00 84 F8 02 01 00 FD 5D 00 85 F8 02 01 00 28 5E' - '00 86 F8 02 01 00 3D 5E 00 87 F8 02 01 00 69 5E 00 88 F8 02 01 00 62 38 00 89 F8 02 01 00 83 21' - '02 8A F8 02 01 00 7C 38 00 8B F8 02 01 00 B0 5E 00 8C F8 02 01 00 B3 5E 00 8D F8 02 01 00 B6 5E' - '00 8E F8 02 01 00 CA 5E 00 8F F8 02 01 00 92 A3 02 90 F8 02 01 00 FE 5E 00 91 F8 02 01 00 31 23' - '02 92 F8 02 01 00 31 23 02 93 F8 02 01 00 01 82 00 94 F8 02 01 00 22 5F 00 95 F8 02 01 00 22 5F' - '00 96 F8 02 01 00 C7 38 00 97 F8 02 01 00 B8 32 02 98 F8 02 01 00 DA 61 02 99 F8 02 01 00 62 5F' - '00 9A F8 02 01 00 6B 5F 00 9B F8 02 01 00 E3 38 00 9C F8 02 01 00 9A 5F 00 9D F8 02 01 00 CD 5F' - '00 9E F8 02 01 00 D7 5F 00 9F F8 02 01 00 F9 5F 00 A0 F8 02 01 00 81 60 00 A1 F8 02 01 00 3A 39' - '00 A2 F8 02 01 00 1C 39 00 A3 F8 02 01 00 94 60 00 A4 F8 02 01 00 D4 26 02 A5 F8 02 01 00 C7 60' - '00 A6 F8 02 01 00 48 61 00 A7 F8 02 01 00 4C 61 00 A8 F8 02 01 00 4E 61 00 A9 F8 02 01 00 4C 61' - '00 AA F8 02 01 00 7A 61 00 AB F8 02 01 00 8E 61 00 AC F8 02 01 00 B2 61 00 AD F8 02 01 00 A4 61' - '00 AE F8 02 01 00 AF 61 00 AF F8 02 01 00 DE 61 00 B0 F8 02 01 00 F2 61 00 B1 F8 02 01 00 F6 61' - '00 B2 F8 02 01 00 10 62 00 B3 F8 02 01 00 1B 62 00 B4 F8 02 01 00 5D 62 00 B5 F8 02 01 00 B1 62' - '00 B6 F8 02 01 00 D4 62 00 B7 F8 02 01 00 50 63 00 B8 F8 02 01 00 0C 2B 02 B9 F8 02 01 00 3D 63' - '00 BA F8 02 01 00 FC 62 00 BB F8 02 01 00 68 63 00 BC F8 02 01 00 83 63 00 BD F8 02 01 00 E4 63' - '00 BE F8 02 01 00 F1 2B 02 BF F8 02 01 00 22 64 00 C0 F8 02 01 00 C5 63 00 C1 F8 02 01 00 A9 63' - '00 C2 F8 02 01 00 2E 3A 00 C3 F8 02 01 00 69 64 00 C4 F8 02 01 00 7E 64 00 C5 F8 02 01 00 9D 64' - '00 C6 F8 02 01 00 77 64 00 C7 F8 02 01 00 6C 3A 00 C8 F8 02 01 00 4F 65 00 C9 F8 02 01 00 6C 65' - '00 CA F8 02 01 00 0A 30 02 CB F8 02 01 00 E3 65 00 CC F8 02 01 00 F8 66 00 CD F8 02 01 00 49 66' - '00 CE F8 02 01 00 19 3B 00 CF F8 02 01 00 91 66 00 D0 F8 02 01 00 08 3B 00 D1 F8 02 01 00 E4 3A' - '00 D2 F8 02 01 00 92 51 00 D3 F8 02 01 00 95 51 00 D4 F8 02 01 00 00 67 00 D5 F8 02 01 00 9C 66' - '00 D6 F8 02 01 00 AD 80 00 D7 F8 02 01 00 D9 43 00 D8 F8 02 01 00 17 67 00 D9 F8 02 01 00 1B 67' - '00 DA F8 02 01 00 21 67 00 DB F8 02 01 00 5E 67 00 DC F8 02 01 00 53 67 00 DD F8 02 01 00 C3 33' - '02 DE F8 02 01 00 49 3B 00 DF F8 02 01 00 FA 67 00 E0 F8 02 01 00 85 67 00 E1 F8 02 01 00 52 68' - '00 E2 F8 02 01 00 85 68 00 E3 F8 02 01 00 6D 34 02 E4 F8 02 01 00 8E 68 00 E5 F8 02 01 00 1F 68' - '00 E6 F8 02 01 00 14 69 00 E7 F8 02 01 00 9D 3B 00 E8 F8 02 01 00 42 69 00 E9 F8 02 01 00 A3 69' - '00 EA F8 02 01 00 EA 69 00 EB F8 02 01 00 A8 6A 00 EC F8 02 01 00 A3 36 02 ED F8 02 01 00 DB 6A' - '00 EE F8 02 01 00 18 3C 00 EF F8 02 01 00 21 6B 00 F0 F8 02 01 00 A7 38 02 F1 F8 02 01 00 54 6B' - '00 F2 F8 02 01 00 4E 3C 00 F3 F8 02 01 00 72 6B 00 F4 F8 02 01 00 9F 6B 00 F5 F8 02 01 00 BA 6B' - '00 F6 F8 02 01 00 BB 6B 00 F7 F8 02 01 00 8D 3A 02 F8 F8 02 01 00 0B 1D 02 F9 F8 02 01 00 FA 3A' - '02 FA F8 02 01 00 4E 6C 00 FB F8 02 01 00 BC 3C 02 FC F8 02 01 00 BF 6C 00 FD F8 02 01 00 CD 6C' - '00 FE F8 02 01 00 67 6C 00 FF F8 02 01 00 16 6D 00 00 F9 02 01 00 3E 6D 00 01 F9 02 01 00 77 6D' - '00 02 F9 02 01 00 41 6D 00 03 F9 02 01 00 69 6D 00 04 F9 02 01 00 78 6D 00 05 F9 02 01 00 85 6D' - '00 06 F9 02 01 00 1E 3D 02 07 F9 02 01 00 34 6D 00 08 F9 02 01 00 2F 6E 00 09 F9 02 01 00 6E 6E' - '00 0A F9 02 01 00 33 3D 00 0B F9 02 01 00 CB 6E 00 0C F9 02 01 00 C7 6E 00 0D F9 02 01 00 D1 3E' - '02 0E F9 02 01 00 F9 6D 00 0F F9 02 01 00 6E 6F 00 10 F9 02 01 00 5E 3F 02 11 F9 02 01 00 8E 3F' - '02 12 F9 02 01 00 C6 6F 00 13 F9 02 01 00 39 70 00 14 F9 02 01 00 1E 70 00 15 F9 02 01 00 1B 70' - '00 16 F9 02 01 00 96 3D 00 17 F9 02 01 00 4A 70 00 18 F9 02 01 00 7D 70 00 19 F9 02 01 00 77 70' - '00 1A F9 02 01 00 AD 70 00 1B F9 02 01 00 25 05 02 1C F9 02 01 00 45 71 00 1D F9 02 01 00 63 42' - '02 1E F9 02 01 00 9C 71 00 1F F9 02 01 00 AB 43 02 20 F9 02 01 00 28 72 00 21 F9 02 01 00 35 72' - '00 22 F9 02 01 00 50 72 00 23 F9 02 01 00 08 46 02 24 F9 02 01 00 80 72 00 25 F9 02 01 00 95 72' - '00 26 F9 02 01 00 35 47 02 27 F9 02 01 00 14 48 02 28 F9 02 01 00 7A 73 00 29 F9 02 01 00 8B 73' - '00 2A F9 02 01 00 AC 3E 00 2B F9 02 01 00 A5 73 00 2C F9 02 01 00 B8 3E 00 2D F9 02 01 00 B8 3E' - '00 2E F9 02 01 00 47 74 00 2F F9 02 01 00 5C 74 00 30 F9 02 01 00 71 74 00 31 F9 02 01 00 85 74' - '00 32 F9 02 01 00 CA 74 00 33 F9 02 01 00 1B 3F 00 34 F9 02 01 00 24 75 00 35 F9 02 01 00 36 4C' - '02 36 F9 02 01 00 3E 75 00 37 F9 02 01 00 92 4C 02 38 F9 02 01 00 70 75 00 39 F9 02 01 00 9F 21' - '02 3A F9 02 01 00 10 76 00 3B F9 02 01 00 A1 4F 02 3C F9 02 01 00 B8 4F 02 3D F9 02 01 00 44 50' - '02 3E F9 02 01 00 FC 3F 00 3F F9 02 01 00 08 40 00 40 F9 02 01 00 F4 76 00 41 F9 02 01 00 F3 50' - '02 42 F9 02 01 00 F2 50 02 43 F9 02 01 00 19 51 02 44 F9 02 01 00 33 51 02 45 F9 02 01 00 1E 77' - '00 46 F9 02 01 00 1F 77 00 47 F9 02 01 00 1F 77 00 48 F9 02 01 00 4A 77 00 49 F9 02 01 00 39 40' - '00 4A F9 02 01 00 8B 77 00 4B F9 02 01 00 46 40 00 4C F9 02 01 00 96 40 00 4D F9 02 01 00 1D 54' - '02 4E F9 02 01 00 4E 78 00 4F F9 02 01 00 8C 78 00 50 F9 02 01 00 CC 78 00 51 F9 02 01 00 E3 40' - '00 52 F9 02 01 00 26 56 02 53 F9 02 01 00 56 79 00 54 F9 02 01 00 9A 56 02 55 F9 02 01 00 C5 56' - '02 56 F9 02 01 00 8F 79 00 57 F9 02 01 00 EB 79 00 58 F9 02 01 00 2F 41 00 59 F9 02 01 00 40 7A' - '00 5A F9 02 01 00 4A 7A 00 5B F9 02 01 00 4F 7A 00 5C F9 02 01 00 7C 59 02 5D F9 02 01 00 A7 5A' - '02 5E F9 02 01 00 A7 5A 02 5F F9 02 01 00 EE 7A 00 60 F9 02 01 00 02 42 00 61 F9 02 01 00 AB 5B' - '02 62 F9 02 01 00 C6 7B 00 63 F9 02 01 00 C9 7B 00 64 F9 02 01 00 27 42 00 65 F9 02 01 00 80 5C' - '02 66 F9 02 01 00 D2 7C 00 67 F9 02 01 00 A0 42 00 68 F9 02 01 00 E8 7C 00 69 F9 02 01 00 E3 7C' - '00 6A F9 02 01 00 00 7D 00 6B F9 02 01 00 86 5F 02 6C F9 02 01 00 63 7D 00 6D F9 02 01 00 01 43' - '00 6E F9 02 01 00 C7 7D 00 6F F9 02 01 00 02 7E 00 70 F9 02 01 00 45 7E 00 71 F9 02 01 00 34 43' - '00 72 F9 02 01 00 28 62 02 73 F9 02 01 00 47 62 02 74 F9 02 01 00 59 43 00 75 F9 02 01 00 D9 62' - '02 76 F9 02 01 00 7A 7F 00 77 F9 02 01 00 3E 63 02 78 F9 02 01 00 95 7F 00 79 F9 02 01 00 FA 7F' - '00 7A F9 02 01 00 05 80 00 7B F9 02 01 00 DA 64 02 7C F9 02 01 00 23 65 02 7D F9 02 01 00 60 80' - '00 7E F9 02 01 00 A8 65 02 7F F9 02 01 00 70 80 00 80 F9 02 01 00 5F 33 02 81 F9 02 01 00 D5 43' - '00 82 F9 02 01 00 B2 80 00 83 F9 02 01 00 03 81 00 84 F9 02 01 00 0B 44 00 85 F9 02 01 00 3E 81' - '00 86 F9 02 01 00 B5 5A 00 87 F9 02 01 00 A7 67 02 88 F9 02 01 00 B5 67 02 89 F9 02 01 00 93 33' - '02 8A F9 02 01 00 9C 33 02 8B F9 02 01 00 01 82 00 8C F9 02 01 00 04 82 00 8D F9 02 01 00 9E 8F' - '00 8E F9 02 01 00 6B 44 00 8F F9 02 01 00 91 82 00 90 F9 02 01 00 8B 82 00 91 F9 02 01 00 9D 82' - '00 92 F9 02 01 00 B3 52 00 93 F9 02 01 00 B1 82 00 94 F9 02 01 00 B3 82 00 95 F9 02 01 00 BD 82' - '00 96 F9 02 01 00 E6 82 00 97 F9 02 01 00 3C 6B 02 98 F9 02 01 00 E5 82 00 99 F9 02 01 00 1D 83' - '00 9A F9 02 01 00 63 83 00 9B F9 02 01 00 AD 83 00 9C F9 02 01 00 23 83 00 9D F9 02 01 00 BD 83' - '00 9E F9 02 01 00 E7 83 00 9F F9 02 01 00 57 84 00 A0 F9 02 01 00 53 83 00 A1 F9 02 01 00 CA 83' - '00 A2 F9 02 01 00 CC 83 00 A3 F9 02 01 00 DC 83 00 A4 F9 02 01 00 36 6C 02 A5 F9 02 01 00 6B 6D' - '02 A6 F9 02 01 00 D5 6C 02 A7 F9 02 01 00 2B 45 00 A8 F9 02 01 00 F1 84 00 A9 F9 02 01 00 F3 84' - '00 AA F9 02 01 00 16 85 00 AB F9 02 01 00 CA 73 02 AC F9 02 01 00 64 85 00 AD F9 02 01 00 2C 6F' - '02 AE F9 02 01 00 5D 45 00 AF F9 02 01 00 61 45 00 B0 F9 02 01 00 B1 6F 02 B1 F9 02 01 00 D2 70' - '02 B2 F9 02 01 00 6B 45 00 B3 F9 02 01 00 50 86 00 B4 F9 02 01 00 5C 86 00 B5 F9 02 01 00 67 86' - '00 B6 F9 02 01 00 69 86 00 B7 F9 02 01 00 A9 86 00 B8 F9 02 01 00 88 86 00 B9 F9 02 01 00 0E 87' - '00 BA F9 02 01 00 E2 86 00 BB F9 02 01 00 79 87 00 BC F9 02 01 00 28 87 00 BD F9 02 01 00 6B 87' - '00 BE F9 02 01 00 86 87 00 BF F9 02 01 00 D7 45 00 C0 F9 02 01 00 E1 87 00 C1 F9 02 01 00 01 88' - '00 C2 F9 02 01 00 F9 45 00 C3 F9 02 01 00 60 88 00 C4 F9 02 01 00 63 88 00 C5 F9 02 01 00 67 76' - '02 C6 F9 02 01 00 D7 88 00 C7 F9 02 01 00 DE 88 00 C8 F9 02 01 00 35 46 00 C9 F9 02 01 00 FA 88' - '00 CA F9 02 01 00 BB 34 00 CB F9 02 01 00 AE 78 02 CC F9 02 01 00 66 79 02 CD F9 02 01 00 BE 46' - '00 CE F9 02 01 00 C7 46 00 CF F9 02 01 00 A0 8A 00 D0 F9 02 01 00 ED 8A 00 D1 F9 02 01 00 8A 8B' - '00 D2 F9 02 01 00 55 8C 00 D3 F9 02 01 00 A8 7C 02 D4 F9 02 01 00 AB 8C 00 D5 F9 02 01 00 C1 8C' - '00 D6 F9 02 01 00 1B 8D 00 D7 F9 02 01 00 77 8D 00 D8 F9 02 01 00 2F 7F 02 D9 F9 02 01 00 04 08' - '02 DA F9 02 01 00 CB 8D 00 DB F9 02 01 00 BC 8D 00 DC F9 02 01 00 F0 8D 00 DD F9 02 01 00 DE 08' - '02 DE F9 02 01 00 D4 8E 00 DF F9 02 01 00 38 8F 00 E0 F9 02 01 00 D2 85 02 E1 F9 02 01 00 ED 85' - '02 E2 F9 02 01 00 94 90 00 E3 F9 02 01 00 F1 90 00 E4 F9 02 01 00 11 91 00 E5 F9 02 01 00 2E 87' - '02 E6 F9 02 01 00 1B 91 00 E7 F9 02 01 00 38 92 00 E8 F9 02 01 00 D7 92 00 E9 F9 02 01 00 D8 92' - '00 EA F9 02 01 00 7C 92 00 EB F9 02 01 00 F9 93 00 EC F9 02 01 00 15 94 00 ED F9 02 01 00 FA 8B' - '02 EE F9 02 01 00 8B 95 00 EF F9 02 01 00 95 49 00 F0 F9 02 01 00 B7 95 00 F1 F9 02 01 00 77 8D' - '02 F2 F9 02 01 00 E6 49 00 F3 F9 02 01 00 C3 96 00 F4 F9 02 01 00 B2 5D 00 F5 F9 02 01 00 23 97' - '00 F6 F9 02 01 00 45 91 02 F7 F9 02 01 00 1A 92 02 F8 F9 02 01 00 6E 4A 00 F9 F9 02 01 00 76 4A' - '00 FA F9 02 01 00 E0 97 00 FB F9 02 01 00 0A 94 02 FC F9 02 01 00 B2 4A 00 FD F9 02 01 00 96 94' - '02 FE F9 02 01 00 0B 98 00 FF F9 02 01 00 0B 98 00 00 FA 02 01 00 29 98 00 01 FA 02 01 00 B6 95' - '02 02 FA 02 01 00 E2 98 00 03 FA 02 01 00 33 4B 00 04 FA 02 01 00 29 99 00 05 FA 02 01 00 A7 99' - '00 06 FA 02 01 00 C2 99 00 07 FA 02 01 00 FE 99 00 08 FA 02 01 00 CE 4B 00 09 FA 02 01 00 30 9B' - '02 0A FA 02 01 00 12 9B 00 0B FA 02 01 00 40 9C 00 0C FA 02 01 00 FD 9C 00 0D FA 02 01 00 CE 4C' - '00 0E FA 02 01 00 ED 4C 00 0F FA 02 01 00 67 9D 00 10 FA 02 01 00 CE A0 02 11 FA 02 01 00 F8 4C' - '00 12 FA 02 01 00 05 A1 02 13 FA 02 01 00 0E A2 02 14 FA 02 01 00 91 A2 02 15 FA 02 01 00 BB 9E' - '00 16 FA 02 01 00 56 4D 00 17 FA 02 01 00 F9 9E 00 18 FA 02 01 00 FE 9E 00 19 FA 02 01 00 05 9F' - '00 1A FA 02 01 00 0F 9F 00 1B FA 02 01 00 16 9F 00 1C FA 02 01 00 3B 9F 00 1D FA 02 01 00 00 A6' - '02' -} - - -LANGUAGE 0,0 COMBINING UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE -{ - '01 0B 34 03 00 38 03 00 D4 1C 00 D4 1C 00 E2 1C 00 E8 1C 00 D2 20 00 D3 20 00 D8 20 00 DA 20 00' - 'E5 20 00 E6 20 00 EA 20 00 EB 20 00 39 0A 01 39 0A 01 F0 6A 01 F4 6A 01 9E BC 01 9E BC 01 67 D1' - '01 69 D1 01 06 01 F0 6F 01 F1 6F 01 07 19 3C 09 00 3C 09 00 BC 09 00 BC 09 00 3C 0A 00 3C 0A 00' - 'BC 0A 00 BC 0A 00 3C 0B 00 3C 0B 00 BC 0C 00 BC 0C 00 37 10 00 37 10 00 34 1B 00 34 1B 00 E6 1B' - '00 E6 1B 00 37 1C 00 37 1C 00 B3 A9 00 B3 A9 00 BA 10 01 BA 10 01 73 11 01 73 11 01 CA 11 01 CA' - '11 01 36 12 01 36 12 01 E9 12 01 E9 12 01 3B 13 01 3C 13 01 46 14 01 46 14 01 C3 14 01 C3 14 01' - 'C0 15 01 C0 15 01 B7 16 01 B7 16 01 3A 18 01 3A 18 01 43 19 01 43 19 01 42 1D 01 42 1D 01 4A E9' - '01 4A E9 01 08 01 99 30 00 9A 30 00 09 36 4D 09 00 4D 09 00 CD 09 00 CD 09 00 4D 0A 00 4D 0A 00' - 'CD 0A 00 CD 0A 00 4D 0B 00 4D 0B 00 CD 0B 00 CD 0B 00 4D 0C 00 4D 0C 00 CD 0C 00 CD 0C 00 3B 0D' - '00 3C 0D 00 4D 0D 00 4D 0D 00 CA 0D 00 CA 0D 00 3A 0E 00 3A 0E 00 BA 0E 00 BA 0E 00 84 0F 00 84' - '0F 00 39 10 00 3A 10 00 14 17 00 14 17 00 34 17 00 34 17 00 D2 17 00 D2 17 00 60 1A 00 60 1A 00' - '44 1B 00 44 1B 00 AA 1B 00 AB 1B 00 F2 1B 00 F3 1B 00 7F 2D 00 7F 2D 00 06 A8 00 06 A8 00 2C A8' - '00 2C A8 00 C4 A8 00 C4 A8 00 53 A9 00 53 A9 00 C0 A9 00 C0 A9 00 F6 AA 00 F6 AA 00 ED AB 00 ED' - 'AB 00 3F 0A 01 3F 0A 01 46 10 01 46 10 01 7F 10 01 7F 10 01 B9 10 01 B9 10 01 33 11 01 34 11 01' - 'C0 11 01 C0 11 01 35 12 01 35 12 01 EA 12 01 EA 12 01 4D 13 01 4D 13 01 42 14 01 42 14 01 C2 14' - '01 C2 14 01 BF 15 01 BF 15 01 3F 16 01 3F 16 01 B6 16 01 B6 16 01 2B 17 01 2B 17 01 39 18 01 39' - '18 01 3D 19 01 3E 19 01 E0 19 01 E0 19 01 34 1A 01 34 1A 01 47 1A 01 47 1A 01 99 1A 01 99 1A 01' - '3F 1C 01 3F 1C 01 44 1D 01 45 1D 01 97 1D 01 97 1D 01 0A 01 B0 05 00 B0 05 00 0B 01 B1 05 00 B1' - '05 00 0C 01 B2 05 00 B2 05 00 0D 01 B3 05 00 B3 05 00 0E 01 B4 05 00 B4 05 00 0F 01 B5 05 00 B5' - '05 00 10 01 B6 05 00 B6 05 00 11 01 B7 05 00 B7 05 00 12 02 B8 05 00 B8 05 00 C7 05 00 C7 05 00' - '13 01 B9 05 00 BA 05 00 14 01 BB 05 00 BB 05 00 15 01 BC 05 00 BC 05 00 16 01 BD 05 00 BD 05 00' - '17 01 BF 05 00 BF 05 00 18 01 C1 05 00 C1 05 00 19 01 C2 05 00 C2 05 00 1A 01 1E FB 00 1E FB 00' - '1B 02 4B 06 00 4B 06 00 F0 08 00 F0 08 00 1C 02 4C 06 00 4C 06 00 F1 08 00 F1 08 00 1D 02 4D 06' - '00 4D 06 00 F2 08 00 F2 08 00 1E 02 18 06 00 18 06 00 4E 06 00 4E 06 00 1F 02 19 06 00 19 06 00' - '4F 06 00 4F 06 00 20 02 1A 06 00 1A 06 00 50 06 00 50 06 00 21 01 51 06 00 51 06 00 22 01 52 06' - '00 52 06 00 23 01 70 06 00 70 06 00 24 01 11 07 00 11 07 00 54 01 55 0C 00 55 0C 00 5B 01 56 0C' - '00 56 0C 00 67 01 38 0E 00 39 0E 00 6B 01 48 0E 00 4B 0E 00 76 01 B8 0E 00 B9 0E 00 7A 01 C8 0E' - '00 CB 0E 00 81 01 71 0F 00 71 0F 00 82 03 72 0F 00 72 0F 00 7A 0F 00 7D 0F 00 80 0F 00 80 0F 00' - '84 01 74 0F 00 74 0F 00 CA 03 21 03 00 22 03 00 27 03 00 28 03 00 D0 1D 00 D0 1D 00 D6 01 CE 1D' - '00 CE 1D 00 D8 04 1B 03 00 1B 03 00 39 0F 00 39 0F 00 65 D1 01 66 D1 01 6E D1 01 72 D1 01 DA 01' - '2A 30 00 2A 30 00 DC 4E 16 03 00 19 03 00 1C 03 00 20 03 00 23 03 00 26 03 00 29 03 00 33 03 00' - '39 03 00 3C 03 00 47 03 00 49 03 00 4D 03 00 4E 03 00 53 03 00 56 03 00 59 03 00 5A 03 00 91 05' - '00 91 05 00 96 05 00 96 05 00 9B 05 00 9B 05 00 A2 05 00 A7 05 00 AA 05 00 AA 05 00 C5 05 00 C5' - '05 00 55 06 00 56 06 00 5C 06 00 5C 06 00 5F 06 00 5F 06 00 E3 06 00 E3 06 00 EA 06 00 EA 06 00' - 'ED 06 00 ED 06 00 31 07 00 31 07 00 34 07 00 34 07 00 37 07 00 39 07 00 3B 07 00 3C 07 00 3E 07' - '00 3E 07 00 42 07 00 42 07 00 44 07 00 44 07 00 46 07 00 46 07 00 48 07 00 48 07 00 F2 07 00 F2' - '07 00 FD 07 00 FD 07 00 59 08 00 5B 08 00 D3 08 00 D3 08 00 E3 08 00 E3 08 00 E6 08 00 E6 08 00' - 'E9 08 00 E9 08 00 ED 08 00 EF 08 00 F6 08 00 F6 08 00 F9 08 00 FA 08 00 52 09 00 52 09 00 18 0F' - '00 19 0F 00 35 0F 00 35 0F 00 37 0F 00 37 0F 00 C6 0F 00 C6 0F 00 8D 10 00 8D 10 00 3B 19 00 3B' - '19 00 18 1A 00 18 1A 00 7F 1A 00 7F 1A 00 B5 1A 00 BA 1A 00 BD 1A 00 BD 1A 00 BF 1A 00 C0 1A 00' - '6C 1B 00 6C 1B 00 D5 1C 00 D9 1C 00 DC 1C 00 DF 1C 00 ED 1C 00 ED 1C 00 C2 1D 00 C2 1D 00 CA 1D' - '00 CA 1D 00 CF 1D 00 CF 1D 00 F9 1D 00 F9 1D 00 FD 1D 00 FD 1D 00 FF 1D 00 FF 1D 00 E8 20 00 E8' - '20 00 EC 20 00 EF 20 00 2B A9 00 2D A9 00 B4 AA 00 B4 AA 00 27 FE 00 2D FE 00 FD 01 01 FD 01 01' - 'E0 02 01 E0 02 01 0D 0A 01 0D 0A 01 3A 0A 01 3A 0A 01 E6 0A 01 E6 0A 01 46 0F 01 47 0F 01 4B 0F' - '01 4B 0F 01 4D 0F 01 50 0F 01 7B D1 01 82 D1 01 8A D1 01 8B D1 01 D0 E8 01 D6 E8 01 DE 04 9A 05' - '00 9A 05 00 AD 05 00 AD 05 00 39 19 00 39 19 00 2D 30 00 2D 30 00 E0 01 2E 30 00 2F 30 00 E2 01' - '6D D1 01 6D D1 01 E4 04 AE 05 00 AE 05 00 A9 18 00 A9 18 00 F7 1D 00 F8 1D 00 2B 30 00 2B 30 00' - 'E6 76 00 03 00 14 03 00 3D 03 00 44 03 00 46 03 00 46 03 00 4A 03 00 4C 03 00 50 03 00 52 03 00' - '57 03 00 57 03 00 5B 03 00 5B 03 00 63 03 00 6F 03 00 83 04 00 87 04 00 92 05 00 95 05 00 97 05' - '00 99 05 00 9C 05 00 A1 05 00 A8 05 00 A9 05 00 AB 05 00 AC 05 00 AF 05 00 AF 05 00 C4 05 00 C4' - '05 00 10 06 00 17 06 00 53 06 00 54 06 00 57 06 00 5B 06 00 5D 06 00 5E 06 00 D6 06 00 DC 06 00' - 'DF 06 00 E2 06 00 E4 06 00 E4 06 00 E7 06 00 E8 06 00 EB 06 00 EC 06 00 30 07 00 30 07 00 32 07' - '00 33 07 00 35 07 00 36 07 00 3A 07 00 3A 07 00 3D 07 00 3D 07 00 3F 07 00 41 07 00 43 07 00 43' - '07 00 45 07 00 45 07 00 47 07 00 47 07 00 49 07 00 4A 07 00 EB 07 00 F1 07 00 F3 07 00 F3 07 00' - '16 08 00 19 08 00 1B 08 00 23 08 00 25 08 00 27 08 00 29 08 00 2D 08 00 D4 08 00 E1 08 00 E4 08' - '00 E5 08 00 E7 08 00 E8 08 00 EA 08 00 EC 08 00 F3 08 00 F5 08 00 F7 08 00 F8 08 00 FB 08 00 FF' - '08 00 51 09 00 51 09 00 53 09 00 54 09 00 FE 09 00 FE 09 00 82 0F 00 83 0F 00 86 0F 00 87 0F 00' - '5D 13 00 5F 13 00 DD 17 00 DD 17 00 3A 19 00 3A 19 00 17 1A 00 17 1A 00 75 1A 00 7C 1A 00 B0 1A' - '00 B4 1A 00 BB 1A 00 BC 1A 00 6B 1B 00 6B 1B 00 6D 1B 00 73 1B 00 D0 1C 00 D2 1C 00 DA 1C 00 DB' - '1C 00 E0 1C 00 E0 1C 00 F4 1C 00 F4 1C 00 F8 1C 00 F9 1C 00 C0 1D 00 C1 1D 00 C3 1D 00 C9 1D 00' - 'CB 1D 00 CC 1D 00 D1 1D 00 F5 1D 00 FB 1D 00 FB 1D 00 FE 1D 00 FE 1D 00 D0 20 00 D1 20 00 D4 20' - '00 D7 20 00 DB 20 00 DC 20 00 E1 20 00 E1 20 00 E7 20 00 E7 20 00 E9 20 00 E9 20 00 F0 20 00 F0' - '20 00 EF 2C 00 F1 2C 00 E0 2D 00 FF 2D 00 6F A6 00 6F A6 00 74 A6 00 7D A6 00 9E A6 00 9F A6 00' - 'F0 A6 00 F1 A6 00 E0 A8 00 F1 A8 00 B0 AA 00 B0 AA 00 B2 AA 00 B3 AA 00 B7 AA 00 B8 AA 00 BE AA' - '00 BF AA 00 C1 AA 00 C1 AA 00 20 FE 00 26 FE 00 2E FE 00 2F FE 00 76 03 01 7A 03 01 0F 0A 01 0F' - '0A 01 38 0A 01 38 0A 01 E5 0A 01 E5 0A 01 24 0D 01 27 0D 01 AB 0E 01 AC 0E 01 48 0F 01 4A 0F 01' - '4C 0F 01 4C 0F 01 00 11 01 02 11 01 66 13 01 6C 13 01 70 13 01 74 13 01 5E 14 01 5E 14 01 30 6B' - '01 36 6B 01 85 D1 01 89 D1 01 AA D1 01 AD D1 01 42 D2 01 44 D2 01 00 E0 01 06 E0 01 08 E0 01 18' - 'E0 01 1B E0 01 21 E0 01 23 E0 01 24 E0 01 26 E0 01 2A E0 01 30 E1 01 36 E1 01 EC E2 01 EF E2 01' - '44 E9 01 49 E9 01 E8 05 15 03 00 15 03 00 1A 03 00 1A 03 00 58 03 00 58 03 00 F6 1D 00 F6 1D 00' - '2C 30 00 2C 30 00 E9 04 5C 03 00 5C 03 00 5F 03 00 5F 03 00 62 03 00 62 03 00 FC 1D 00 FC 1D 00' - 'EA 03 5D 03 00 5E 03 00 60 03 00 61 03 00 CD 1D 00 CD 1D 00 F0 01 45 03 00 45 03 00' -} - - -LANGUAGE 0,0 NUMBERS UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE -{ - '95 00 00 00 00 01 00 00 00 01 00 00 00 01 00 00 00 02 00 00 00 01 00 00 00 03 00 00 00 01 00 00' - '00 04 00 00 00 01 00 00 00 05 00 00 00 01 00 00 00 06 00 00 00 01 00 00 00 07 00 00 00 01 00 00' - '00 08 00 00 00 01 00 00 00 09 00 00 00 01 00 00 00 01 00 00 00 04 00 00 00 01 00 00 00 02 00 00' - '00 03 00 00 00 04 00 00 00 01 00 00 00 10 00 00 00 01 00 00 00 08 00 00 00 03 00 00 00 10 00 00' - '00 10 00 00 00 01 00 00 00 0A 00 00 00 01 00 00 00 64 00 00 00 01 00 00 00 E8 03 00 00 01 00 00' - '00 01 00 00 00 A0 00 00 00 01 00 00 00 28 00 00 00 03 00 00 00 50 00 00 00 01 00 00 00 14 00 00' - '00 01 00 00 00 0A 00 00 00 03 00 00 00 14 00 00 00 01 00 00 00 05 00 00 00 03 00 00 00 02 00 00' - '00 05 00 00 00 02 00 00 00 07 00 00 00 02 00 00 00 09 00 00 00 02 00 00 00 0B 00 00 00 02 00 00' - '00 0D 00 00 00 02 00 00 00 0F 00 00 00 02 00 00 00 11 00 00 00 02 00 00 00 FF FF FF FF 02 00 00' - '00 14 00 00 00 01 00 00 00 1E 00 00 00 01 00 00 00 28 00 00 00 01 00 00 00 32 00 00 00 01 00 00' - '00 3C 00 00 00 01 00 00 00 46 00 00 00 01 00 00 00 50 00 00 00 01 00 00 00 5A 00 00 00 01 00 00' - '00 10 27 00 00 01 00 00 00 11 00 00 00 01 00 00 00 12 00 00 00 01 00 00 00 13 00 00 00 01 00 00' - '00 01 00 00 00 07 00 00 00 01 00 00 00 09 00 00 00 01 00 00 00 03 00 00 00 02 00 00 00 03 00 00' - '00 02 00 00 00 05 00 00 00 03 00 00 00 05 00 00 00 04 00 00 00 05 00 00 00 01 00 00 00 06 00 00' - '00 05 00 00 00 06 00 00 00 03 00 00 00 08 00 00 00 05 00 00 00 08 00 00 00 07 00 00 00 08 00 00' - '00 0B 00 00 00 01 00 00 00 0C 00 00 00 01 00 00 00 F4 01 00 00 01 00 00 00 88 13 00 00 01 00 00' - '00 50 C3 00 00 01 00 00 00 A0 86 01 00 01 00 00 00 0D 00 00 00 01 00 00 00 0E 00 00 00 01 00 00' - '00 0F 00 00 00 01 00 00 00 15 00 00 00 01 00 00 00 16 00 00 00 01 00 00 00 17 00 00 00 01 00 00' - '00 18 00 00 00 01 00 00 00 19 00 00 00 01 00 00 00 1A 00 00 00 01 00 00 00 1B 00 00 00 01 00 00' - '00 1C 00 00 00 01 00 00 00 1D 00 00 00 01 00 00 00 1F 00 00 00 01 00 00 00 20 00 00 00 01 00 00' - '00 21 00 00 00 01 00 00 00 22 00 00 00 01 00 00 00 23 00 00 00 01 00 00 00 24 00 00 00 01 00 00' - '00 25 00 00 00 01 00 00 00 26 00 00 00 01 00 00 00 27 00 00 00 01 00 00 00 29 00 00 00 01 00 00' - '00 2A 00 00 00 01 00 00 00 2B 00 00 00 01 00 00 00 2C 00 00 00 01 00 00 00 2D 00 00 00 01 00 00' - '00 2E 00 00 00 01 00 00 00 2F 00 00 00 01 00 00 00 30 00 00 00 01 00 00 00 31 00 00 00 01 00 00' - '00 C8 00 00 00 01 00 00 00 2C 01 00 00 01 00 00 00 90 01 00 00 01 00 00 00 58 02 00 00 01 00 00' - '00 BC 02 00 00 01 00 00 00 20 03 00 00 01 00 00 00 84 03 00 00 01 00 00 00 D0 07 00 00 01 00 00' - '00 B8 0B 00 00 01 00 00 00 A0 0F 00 00 01 00 00 00 70 17 00 00 01 00 00 00 58 1B 00 00 01 00 00' - '00 40 1F 00 00 01 00 00 00 28 23 00 00 01 00 00 00 20 4E 00 00 01 00 00 00 30 75 00 00 01 00 00' - '00 40 9C 00 00 01 00 00 00 60 EA 00 00 01 00 00 00 70 11 01 00 01 00 00 00 80 38 01 00 01 00 00' - '00 90 5F 01 00 01 00 00 00 0B 00 00 00 0C 00 00 00 40 0D 03 00 01 00 00 00 E0 93 04 00 01 00 00' - '00 80 1A 06 00 01 00 00 00 20 A1 07 00 01 00 00 00 C0 27 09 00 01 00 00 00 60 AE 0A 00 01 00 00' - '00 00 35 0C 00 01 00 00 00 A0 BB 0D 00 01 00 00 00 01 00 00 00 0C 00 00 00 02 00 00 00 0C 00 00' - '00 03 00 00 00 0C 00 00 00 04 00 00 00 0C 00 00 00 05 00 00 00 0C 00 00 00 06 00 00 00 0C 00 00' - '00 07 00 00 00 0C 00 00 00 08 00 00 00 0C 00 00 00 09 00 00 00 0C 00 00 00 0A 00 00 00 0C 00 00' - '00 01 00 00 00 40 01 00 00 01 00 00 00 50 00 00 00 01 00 00 00 40 00 00 00 01 00 00 00 20 00 00' - '00 03 00 00 00 40 00 00 00 C0 4B 03 00 01 00 00 00 80 97 06 00 01 00 00 00 40 42 0F 00 01 00 00' - '00 00 E1 F5 05 01 00 00 00 00 E4 0B 54 01 00 00 00 00 10 A5 D4 01 00 00 00 80 96 98 00 01 00 00' - '00 00 2D 31 01 01 00 00 00 FD 06 00 00 30 00 00 00 31 00 00 01 32 00 00 02 33 00 00 03 34 00 00' - '04 35 00 00 05 36 00 00 06 37 00 00 07 38 00 00 08 39 00 00 09 B2 00 00 02 B3 00 00 03 B9 00 00' - '01 BC 00 00 0A BD 00 00 0B BE 00 00 0C 60 06 00 00 61 06 00 01 62 06 00 02 63 06 00 03 64 06 00' - '04 65 06 00 05 66 06 00 06 67 06 00 07 68 06 00 08 69 06 00 09 F0 06 00 00 F1 06 00 01 F2 06 00' - '02 F3 06 00 03 F4 06 00 04 F5 06 00 05 F6 06 00 06 F7 06 00 07 F8 06 00 08 F9 06 00 09 C0 07 00' - '00 C1 07 00 01 C2 07 00 02 C3 07 00 03 C4 07 00 04 C5 07 00 05 C6 07 00 06 C7 07 00 07 C8 07 00' - '08 C9 07 00 09 66 09 00 00 67 09 00 01 68 09 00 02 69 09 00 03 6A 09 00 04 6B 09 00 05 6C 09 00' - '06 6D 09 00 07 6E 09 00 08 6F 09 00 09 E6 09 00 00 E7 09 00 01 E8 09 00 02 E9 09 00 03 EA 09 00' - '04 EB 09 00 05 EC 09 00 06 ED 09 00 07 EE 09 00 08 EF 09 00 09 F4 09 00 0D F5 09 00 0E F6 09 00' - '0F F7 09 00 0A F8 09 00 0C F9 09 00 10 66 0A 00 00 67 0A 00 01 68 0A 00 02 69 0A 00 03 6A 0A 00' - '04 6B 0A 00 05 6C 0A 00 06 6D 0A 00 07 6E 0A 00 08 6F 0A 00 09 E6 0A 00 00 E7 0A 00 01 E8 0A 00' - '02 E9 0A 00 03 EA 0A 00 04 EB 0A 00 05 EC 0A 00 06 ED 0A 00 07 EE 0A 00 08 EF 0A 00 09 66 0B 00' - '00 67 0B 00 01 68 0B 00 02 69 0B 00 03 6A 0B 00 04 6B 0B 00 05 6C 0B 00 06 6D 0B 00 07 6E 0B 00' - '08 6F 0B 00 09 72 0B 00 0A 73 0B 00 0B 74 0B 00 0C 75 0B 00 0D 76 0B 00 0E 77 0B 00 0F E6 0B 00' - '00 E7 0B 00 01 E8 0B 00 02 E9 0B 00 03 EA 0B 00 04 EB 0B 00 05 EC 0B 00 06 ED 0B 00 07 EE 0B 00' - '08 EF 0B 00 09 F0 0B 00 11 F1 0B 00 12 F2 0B 00 13 66 0C 00 00 67 0C 00 01 68 0C 00 02 69 0C 00' - '03 6A 0C 00 04 6B 0C 00 05 6C 0C 00 06 6D 0C 00 07 6E 0C 00 08 6F 0C 00 09 78 0C 00 00 79 0C 00' - '01 7A 0C 00 02 7B 0C 00 03 7C 0C 00 01 7D 0C 00 02 7E 0C 00 03 E6 0C 00 00 E7 0C 00 01 E8 0C 00' - '02 E9 0C 00 03 EA 0C 00 04 EB 0C 00 05 EC 0C 00 06 ED 0C 00 07 EE 0C 00 08 EF 0C 00 09 58 0D 00' - '14 59 0D 00 15 5A 0D 00 16 5B 0D 00 17 5C 0D 00 18 5D 0D 00 19 5E 0D 00 1A 66 0D 00 00 67 0D 00' - '01 68 0D 00 02 69 0D 00 03 6A 0D 00 04 6B 0D 00 05 6C 0D 00 06 6D 0D 00 07 6E 0D 00 08 6F 0D 00' - '09 70 0D 00 11 71 0D 00 12 72 0D 00 13 73 0D 00 0A 74 0D 00 0B 75 0D 00 0C 76 0D 00 0D 77 0D 00' - '0E 78 0D 00 0F E6 0D 00 00 E7 0D 00 01 E8 0D 00 02 E9 0D 00 03 EA 0D 00 04 EB 0D 00 05 EC 0D 00' - '06 ED 0D 00 07 EE 0D 00 08 EF 0D 00 09 50 0E 00 00 51 0E 00 01 52 0E 00 02 53 0E 00 03 54 0E 00' - '04 55 0E 00 05 56 0E 00 06 57 0E 00 07 58 0E 00 08 59 0E 00 09 D0 0E 00 00 D1 0E 00 01 D2 0E 00' - '02 D3 0E 00 03 D4 0E 00 04 D5 0E 00 05 D6 0E 00 06 D7 0E 00 07 D8 0E 00 08 D9 0E 00 09 20 0F 00' - '00 21 0F 00 01 22 0F 00 02 23 0F 00 03 24 0F 00 04 25 0F 00 05 26 0F 00 06 27 0F 00 07 28 0F 00' - '08 29 0F 00 09 2A 0F 00 0B 2B 0F 00 1B 2C 0F 00 1C 2D 0F 00 1D 2E 0F 00 1E 2F 0F 00 1F 30 0F 00' - '20 31 0F 00 21 32 0F 00 22 33 0F 00 23 40 10 00 00 41 10 00 01 42 10 00 02 43 10 00 03 44 10 00' - '04 45 10 00 05 46 10 00 06 47 10 00 07 48 10 00 08 49 10 00 09 90 10 00 00 91 10 00 01 92 10 00' - '02 93 10 00 03 94 10 00 04 95 10 00 05 96 10 00 06 97 10 00 07 98 10 00 08 99 10 00 09 69 13 00' - '01 6A 13 00 02 6B 13 00 03 6C 13 00 04 6D 13 00 05 6E 13 00 06 6F 13 00 07 70 13 00 08 71 13 00' - '09 72 13 00 11 73 13 00 24 74 13 00 25 75 13 00 26 76 13 00 27 77 13 00 28 78 13 00 29 79 13 00' - '2A 7A 13 00 2B 7B 13 00 12 7C 13 00 2C EE 16 00 2D EF 16 00 2E F0 16 00 2F E0 17 00 00 E1 17 00' - '01 E2 17 00 02 E3 17 00 03 E4 17 00 04 E5 17 00 05 E6 17 00 06 E7 17 00 07 E8 17 00 08 E9 17 00' - '09 F0 17 00 00 F1 17 00 01 F2 17 00 02 F3 17 00 03 F4 17 00 04 F5 17 00 05 F6 17 00 06 F7 17 00' - '07 F8 17 00 08 F9 17 00 09 10 18 00 00 11 18 00 01 12 18 00 02 13 18 00 03 14 18 00 04 15 18 00' - '05 16 18 00 06 17 18 00 07 18 18 00 08 19 18 00 09 46 19 00 00 47 19 00 01 48 19 00 02 49 19 00' - '03 4A 19 00 04 4B 19 00 05 4C 19 00 06 4D 19 00 07 4E 19 00 08 4F 19 00 09 D0 19 00 00 D1 19 00' - '01 D2 19 00 02 D3 19 00 03 D4 19 00 04 D5 19 00 05 D6 19 00 06 D7 19 00 07 D8 19 00 08 D9 19 00' - '09 DA 19 00 01 80 1A 00 00 81 1A 00 01 82 1A 00 02 83 1A 00 03 84 1A 00 04 85 1A 00 05 86 1A 00' - '06 87 1A 00 07 88 1A 00 08 89 1A 00 09 90 1A 00 00 91 1A 00 01 92 1A 00 02 93 1A 00 03 94 1A 00' - '04 95 1A 00 05 96 1A 00 06 97 1A 00 07 98 1A 00 08 99 1A 00 09 50 1B 00 00 51 1B 00 01 52 1B 00' - '02 53 1B 00 03 54 1B 00 04 55 1B 00 05 56 1B 00 06 57 1B 00 07 58 1B 00 08 59 1B 00 09 B0 1B 00' - '00 B1 1B 00 01 B2 1B 00 02 B3 1B 00 03 B4 1B 00 04 B5 1B 00 05 B6 1B 00 06 B7 1B 00 07 B8 1B 00' - '08 B9 1B 00 09 40 1C 00 00 41 1C 00 01 42 1C 00 02 43 1C 00 03 44 1C 00 04 45 1C 00 05 46 1C 00' - '06 47 1C 00 07 48 1C 00 08 49 1C 00 09 50 1C 00 00 51 1C 00 01 52 1C 00 02 53 1C 00 03 54 1C 00' - '04 55 1C 00 05 56 1C 00 06 57 1C 00 07 58 1C 00 08 59 1C 00 09 70 20 00 00 74 20 00 04 75 20 00' - '05 76 20 00 06 77 20 00 07 78 20 00 08 79 20 00 09 80 20 00 00 81 20 00 01 82 20 00 02 83 20 00' - '03 84 20 00 04 85 20 00 05 86 20 00 06 87 20 00 07 88 20 00 08 89 20 00 09 50 21 00 30 51 21 00' - '31 52 21 00 18 53 21 00 32 54 21 00 33 55 21 00 1A 56 21 00 34 57 21 00 35 58 21 00 36 59 21 00' - '37 5A 21 00 38 5B 21 00 0E 5C 21 00 39 5D 21 00 3A 5E 21 00 3B 5F 21 00 01 60 21 00 01 61 21 00' - '02 62 21 00 03 63 21 00 04 64 21 00 05 65 21 00 06 66 21 00 07 67 21 00 08 68 21 00 09 69 21 00' - '11 6A 21 00 3C 6B 21 00 3D 6C 21 00 27 6D 21 00 12 6E 21 00 3E 6F 21 00 13 70 21 00 01 71 21 00' - '02 72 21 00 03 73 21 00 04 74 21 00 05 75 21 00 06 76 21 00 07 77 21 00 08 78 21 00 09 79 21 00' - '11 7A 21 00 3C 7B 21 00 3D 7C 21 00 27 7D 21 00 12 7E 21 00 3E 7F 21 00 13 80 21 00 13 81 21 00' - '3F 82 21 00 2C 85 21 00 06 86 21 00 27 87 21 00 40 88 21 00 41 89 21 00 00 60 24 00 01 61 24 00' - '02 62 24 00 03 63 24 00 04 64 24 00 05 65 24 00 06 66 24 00 07 67 24 00 08 68 24 00 09 69 24 00' - '11 6A 24 00 3C 6B 24 00 3D 6C 24 00 42 6D 24 00 43 6E 24 00 44 6F 24 00 10 70 24 00 2D 71 24 00' - '2E 72 24 00 2F 73 24 00 24 74 24 00 01 75 24 00 02 76 24 00 03 77 24 00 04 78 24 00 05 79 24 00' - '06 7A 24 00 07 7B 24 00 08 7C 24 00 09 7D 24 00 11 7E 24 00 3C 7F 24 00 3D 80 24 00 42 81 24 00' - '43 82 24 00 44 83 24 00 10 84 24 00 2D 85 24 00 2E 86 24 00 2F 87 24 00 24 88 24 00 01 89 24 00' - '02 8A 24 00 03 8B 24 00 04 8C 24 00 05 8D 24 00 06 8E 24 00 07 8F 24 00 08 90 24 00 09 91 24 00' - '11 92 24 00 3C 93 24 00 3D 94 24 00 42 95 24 00 43 96 24 00 44 97 24 00 10 98 24 00 2D 99 24 00' - '2E 9A 24 00 2F 9B 24 00 24 EA 24 00 00 EB 24 00 3C EC 24 00 3D ED 24 00 42 EE 24 00 43 EF 24 00' - '44 F0 24 00 10 F1 24 00 2D F2 24 00 2E F3 24 00 2F F4 24 00 24 F5 24 00 01 F6 24 00 02 F7 24 00' - '03 F8 24 00 04 F9 24 00 05 FA 24 00 06 FB 24 00 07 FC 24 00 08 FD 24 00 09 FE 24 00 11 FF 24 00' - '00 76 27 00 01 77 27 00 02 78 27 00 03 79 27 00 04 7A 27 00 05 7B 27 00 06 7C 27 00 07 7D 27 00' - '08 7E 27 00 09 7F 27 00 11 80 27 00 01 81 27 00 02 82 27 00 03 83 27 00 04 84 27 00 05 85 27 00' - '06 86 27 00 07 87 27 00 08 88 27 00 09 89 27 00 11 8A 27 00 01 8B 27 00 02 8C 27 00 03 8D 27 00' - '04 8E 27 00 05 8F 27 00 06 90 27 00 07 91 27 00 08 92 27 00 09 93 27 00 11 FD 2C 00 0B 07 30 00' - '00 21 30 00 01 22 30 00 02 23 30 00 03 24 30 00 04 25 30 00 05 26 30 00 06 27 30 00 07 28 30 00' - '08 29 30 00 09 38 30 00 11 39 30 00 24 3A 30 00 25 92 31 00 01 93 31 00 02 94 31 00 03 95 31 00' - '04 20 32 00 01 21 32 00 02 22 32 00 03 23 32 00 04 24 32 00 05 25 32 00 06 26 32 00 07 27 32 00' - '08 28 32 00 09 29 32 00 11 48 32 00 11 49 32 00 24 4A 32 00 25 4B 32 00 26 4C 32 00 27 4D 32 00' - '28 4E 32 00 29 4F 32 00 2A 51 32 00 45 52 32 00 46 53 32 00 47 54 32 00 48 55 32 00 49 56 32 00' - '4A 57 32 00 4B 58 32 00 4C 59 32 00 4D 5A 32 00 25 5B 32 00 4E 5C 32 00 4F 5D 32 00 50 5E 32 00' - '51 5F 32 00 52 80 32 00 01 81 32 00 02 82 32 00 03 83 32 00 04 84 32 00 05 85 32 00 06 86 32 00' - '07 87 32 00 08 88 32 00 09 89 32 00 11 B1 32 00 53 B2 32 00 54 B3 32 00 55 B4 32 00 56 B5 32 00' - '26 B6 32 00 57 B7 32 00 58 B8 32 00 59 B9 32 00 5A BA 32 00 5B BB 32 00 5C BC 32 00 5D BD 32 00' - '5E BE 32 00 5F BF 32 00 27 20 A6 00 00 21 A6 00 01 22 A6 00 02 23 A6 00 03 24 A6 00 04 25 A6 00' - '05 26 A6 00 06 27 A6 00 07 28 A6 00 08 29 A6 00 09 E6 A6 00 01 E7 A6 00 02 E8 A6 00 03 E9 A6 00' - '04 EA A6 00 05 EB A6 00 06 EC A6 00 07 ED A6 00 08 EE A6 00 09 EF A6 00 00 30 A8 00 0A 31 A8 00' - '0B 32 A8 00 0C 33 A8 00 0D 34 A8 00 0E 35 A8 00 0F D0 A8 00 00 D1 A8 00 01 D2 A8 00 02 D3 A8 00' - '03 D4 A8 00 04 D5 A8 00 05 D6 A8 00 06 D7 A8 00 07 D8 A8 00 08 D9 A8 00 09 00 A9 00 00 01 A9 00' - '01 02 A9 00 02 03 A9 00 03 04 A9 00 04 05 A9 00 05 06 A9 00 06 07 A9 00 07 08 A9 00 08 09 A9 00' - '09 D0 A9 00 00 D1 A9 00 01 D2 A9 00 02 D3 A9 00 03 D4 A9 00 04 D5 A9 00 05 D6 A9 00 06 D7 A9 00' - '07 D8 A9 00 08 D9 A9 00 09 F0 A9 00 00 F1 A9 00 01 F2 A9 00 02 F3 A9 00 03 F4 A9 00 04 F5 A9 00' - '05 F6 A9 00 06 F7 A9 00 07 F8 A9 00 08 F9 A9 00 09 50 AA 00 00 51 AA 00 01 52 AA 00 02 53 AA 00' - '03 54 AA 00 04 55 AA 00 05 56 AA 00 06 57 AA 00 07 58 AA 00 08 59 AA 00 09 F0 AB 00 00 F1 AB 00' - '01 F2 AB 00 02 F3 AB 00 03 F4 AB 00 04 F5 AB 00 05 F6 AB 00 06 F7 AB 00 07 F8 AB 00 08 F9 AB 00' - '09 6B F9 00 03 73 F9 00 11 78 F9 00 02 B2 F9 00 00 D1 F9 00 06 D3 F9 00 06 FD F9 00 11 10 FF 00' - '00 11 FF 00 01 12 FF 00 02 13 FF 00 03 14 FF 00 04 15 FF 00 05 16 FF 00 06 17 FF 00 07 18 FF 00' - '08 19 FF 00 09 07 01 01 01 08 01 01 02 09 01 01 03 0A 01 01 04 0B 01 01 05 0C 01 01 06 0D 01 01' - '07 0E 01 01 08 0F 01 01 09 10 01 01 11 11 01 01 24 12 01 01 25 13 01 01 26 14 01 01 27 15 01 01' - '28 16 01 01 29 17 01 01 2A 18 01 01 2B 19 01 01 12 1A 01 01 60 1B 01 01 61 1C 01 01 62 1D 01 01' - '3E 1E 01 01 63 1F 01 01 64 20 01 01 65 21 01 01 66 22 01 01 13 23 01 01 67 24 01 01 68 25 01 01' - '69 26 01 01 3F 27 01 01 6A 28 01 01 6B 29 01 01 6C 2A 01 01 6D 2B 01 01 2C 2C 01 01 6E 2D 01 01' - '6F 2E 01 01 70 2F 01 01 40 30 01 01 71 31 01 01 72 32 01 01 73 33 01 01 74 40 01 01 0A 41 01 01' - '0B 42 01 01 01 43 01 01 05 44 01 01 27 45 01 01 3E 46 01 01 3F 47 01 01 40 48 01 01 05 49 01 01' - '11 4A 01 01 27 4B 01 01 12 4C 01 01 3E 4D 01 01 13 4E 01 01 3F 4F 01 01 05 50 01 01 11 51 01 01' - '27 52 01 01 12 53 01 01 3E 54 01 01 13 55 01 01 2C 56 01 01 40 57 01 01 11 58 01 01 01 59 01 01' - '01 5A 01 01 01 5B 01 01 02 5C 01 01 02 5D 01 01 02 5E 01 01 02 5F 01 01 05 60 01 01 11 61 01 01' - '11 62 01 01 11 63 01 01 11 64 01 01 11 65 01 01 25 66 01 01 27 67 01 01 27 68 01 01 27 69 01 01' - '27 6A 01 01 12 6B 01 01 61 6C 01 01 3E 6D 01 01 3E 6E 01 01 3E 6F 01 01 3E 70 01 01 3E 71 01 01' - '13 72 01 01 3F 73 01 01 05 74 01 01 27 75 01 01 0B 76 01 01 0B 77 01 01 33 78 01 01 0C 8A 01 01' - '00 8B 01 01 0A E1 02 01 01 E2 02 01 02 E3 02 01 03 E4 02 01 04 E5 02 01 05 E6 02 01 06 E7 02 01' - '07 E8 02 01 08 E9 02 01 09 EA 02 01 11 EB 02 01 24 EC 02 01 25 ED 02 01 26 EE 02 01 27 EF 02 01' - '28 F0 02 01 29 F1 02 01 2A F2 02 01 2B F3 02 01 12 F4 02 01 60 F5 02 01 61 F6 02 01 62 F7 02 01' - '3E F8 02 01 63 F9 02 01 64 FA 02 01 65 FB 02 01 66 20 03 01 01 21 03 01 05 22 03 01 11 23 03 01' - '27 41 03 01 2B 4A 03 01 66 D1 03 01 01 D2 03 01 02 D3 03 01 11 D4 03 01 24 D5 03 01 12 A0 04 01' - '00 A1 04 01 01 A2 04 01 02 A3 04 01 03 A4 04 01 04 A5 04 01 05 A6 04 01 06 A7 04 01 07 A8 04 01' - '08 A9 04 01 09 58 08 01 01 59 08 01 02 5A 08 01 03 5B 08 01 11 5C 08 01 24 5D 08 01 12 5E 08 01' - '13 5F 08 01 2C 79 08 01 01 7A 08 01 02 7B 08 01 03 7C 08 01 04 7D 08 01 05 7E 08 01 11 7F 08 01' - '24 A7 08 01 01 A8 08 01 02 A9 08 01 03 AA 08 01 04 AB 08 01 04 AC 08 01 05 AD 08 01 11 AE 08 01' - '24 AF 08 01 12 FB 08 01 01 FC 08 01 05 FD 08 01 11 FE 08 01 24 FF 08 01 12 16 09 01 01 17 09 01' - '11 18 09 01 24 19 09 01 12 1A 09 01 02 1B 09 01 03 BC 09 01 75 BD 09 01 0B C0 09 01 01 C1 09 01' - '02 C2 09 01 03 C3 09 01 04 C4 09 01 05 C5 09 01 06 C6 09 01 07 C7 09 01 08 C8 09 01 09 C9 09 01' - '11 CA 09 01 24 CB 09 01 25 CC 09 01 26 CD 09 01 27 CE 09 01 28 CF 09 01 29 D2 09 01 12 D3 09 01' - '60 D4 09 01 61 D5 09 01 62 D6 09 01 3E D7 09 01 63 D8 09 01 64 D9 09 01 65 DA 09 01 66 DB 09 01' - '13 DC 09 01 67 DD 09 01 68 DE 09 01 69 DF 09 01 3F E0 09 01 6A E1 09 01 6B E2 09 01 6C E3 09 01' - '6D E4 09 01 2C E5 09 01 6E E6 09 01 6F E7 09 01 70 E8 09 01 40 E9 09 01 71 EA 09 01 72 EB 09 01' - '73 EC 09 01 74 ED 09 01 41 EE 09 01 76 EF 09 01 77 F0 09 01 78 F1 09 01 79 F2 09 01 7A F3 09 01' - '7B F4 09 01 7C F5 09 01 7D F6 09 01 7E F7 09 01 7F F8 09 01 80 F9 09 01 81 FA 09 01 82 FB 09 01' - '83 FC 09 01 84 FD 09 01 85 FE 09 01 86 FF 09 01 87 40 0A 01 01 41 0A 01 02 42 0A 01 03 43 0A 01' - '04 44 0A 01 11 45 0A 01 24 46 0A 01 12 47 0A 01 13 48 0A 01 0B 7D 0A 01 01 7E 0A 01 27 9D 0A 01' - '01 9E 0A 01 11 9F 0A 01 24 EB 0A 01 01 EC 0A 01 05 ED 0A 01 11 EE 0A 01 24 EF 0A 01 12 58 0B 01' - '01 59 0B 01 02 5A 0B 01 03 5B 0B 01 04 5C 0B 01 11 5D 0B 01 24 5E 0B 01 12 5F 0B 01 13 78 0B 01' - '01 79 0B 01 02 7A 0B 01 03 7B 0B 01 04 7C 0B 01 11 7D 0B 01 24 7E 0B 01 12 7F 0B 01 13 A9 0B 01' - '01 AA 0B 01 02 AB 0B 01 03 AC 0B 01 04 AD 0B 01 11 AE 0B 01 24 AF 0B 01 12 FA 0C 01 01 FB 0C 01' - '05 FC 0C 01 11 FD 0C 01 27 FE 0C 01 12 FF 0C 01 13 30 0D 01 00 31 0D 01 01 32 0D 01 02 33 0D 01' - '03 34 0D 01 04 35 0D 01 05 36 0D 01 06 37 0D 01 07 38 0D 01 08 39 0D 01 09 60 0E 01 01 61 0E 01' - '02 62 0E 01 03 63 0E 01 04 64 0E 01 05 65 0E 01 06 66 0E 01 07 67 0E 01 08 68 0E 01 09 69 0E 01' - '11 6A 0E 01 24 6B 0E 01 25 6C 0E 01 26 6D 0E 01 27 6E 0E 01 28 6F 0E 01 29 70 0E 01 2A 71 0E 01' - '2B 72 0E 01 12 73 0E 01 60 74 0E 01 61 75 0E 01 62 76 0E 01 3E 77 0E 01 63 78 0E 01 64 79 0E 01' - '65 7A 0E 01 66 7B 0E 01 0B 7C 0E 01 0A 7D 0E 01 32 7E 0E 01 33 1D 0F 01 01 1E 0F 01 02 1F 0F 01' - '03 20 0F 01 04 21 0F 01 05 22 0F 01 11 23 0F 01 24 24 0F 01 25 25 0F 01 12 26 0F 01 0B 51 0F 01' - '01 52 0F 01 11 53 0F 01 24 54 0F 01 12 C5 0F 01 01 C6 0F 01 02 C7 0F 01 03 C8 0F 01 04 C9 0F 01' - '11 CA 0F 01 24 CB 0F 01 12 52 10 01 01 53 10 01 02 54 10 01 03 55 10 01 04 56 10 01 05 57 10 01' - '06 58 10 01 07 59 10 01 08 5A 10 01 09 5B 10 01 11 5C 10 01 24 5D 10 01 25 5E 10 01 26 5F 10 01' - '27 60 10 01 28 61 10 01 29 62 10 01 2A 63 10 01 2B 64 10 01 12 65 10 01 13 66 10 01 00 67 10 01' - '01 68 10 01 02 69 10 01 03 6A 10 01 04 6B 10 01 05 6C 10 01 06 6D 10 01 07 6E 10 01 08 6F 10 01' - '09 F0 10 01 00 F1 10 01 01 F2 10 01 02 F3 10 01 03 F4 10 01 04 F5 10 01 05 F6 10 01 06 F7 10 01' - '07 F8 10 01 08 F9 10 01 09 36 11 01 00 37 11 01 01 38 11 01 02 39 11 01 03 3A 11 01 04 3B 11 01' - '05 3C 11 01 06 3D 11 01 07 3E 11 01 08 3F 11 01 09 D0 11 01 00 D1 11 01 01 D2 11 01 02 D3 11 01' - '03 D4 11 01 04 D5 11 01 05 D6 11 01 06 D7 11 01 07 D8 11 01 08 D9 11 01 09 E1 11 01 01 E2 11 01' - '02 E3 11 01 03 E4 11 01 04 E5 11 01 05 E6 11 01 06 E7 11 01 07 E8 11 01 08 E9 11 01 09 EA 11 01' - '11 EB 11 01 24 EC 11 01 25 ED 11 01 26 EE 11 01 27 EF 11 01 28 F0 11 01 29 F1 11 01 2A F2 11 01' - '2B F3 11 01 12 F4 11 01 13 F0 12 01 00 F1 12 01 01 F2 12 01 02 F3 12 01 03 F4 12 01 04 F5 12 01' - '05 F6 12 01 06 F7 12 01 07 F8 12 01 08 F9 12 01 09 50 14 01 00 51 14 01 01 52 14 01 02 53 14 01' - '03 54 14 01 04 55 14 01 05 56 14 01 06 57 14 01 07 58 14 01 08 59 14 01 09 D0 14 01 00 D1 14 01' - '01 D2 14 01 02 D3 14 01 03 D4 14 01 04 D5 14 01 05 D6 14 01 06 D7 14 01 07 D8 14 01 08 D9 14 01' - '09 50 16 01 00 51 16 01 01 52 16 01 02 53 16 01 03 54 16 01 04 55 16 01 05 56 16 01 06 57 16 01' - '07 58 16 01 08 59 16 01 09 C0 16 01 00 C1 16 01 01 C2 16 01 02 C3 16 01 03 C4 16 01 04 C5 16 01' - '05 C6 16 01 06 C7 16 01 07 C8 16 01 08 C9 16 01 09 30 17 01 00 31 17 01 01 32 17 01 02 33 17 01' - '03 34 17 01 04 35 17 01 05 36 17 01 06 37 17 01 07 38 17 01 08 39 17 01 09 3A 17 01 11 3B 17 01' - '24 E0 18 01 00 E1 18 01 01 E2 18 01 02 E3 18 01 03 E4 18 01 04 E5 18 01 05 E6 18 01 06 E7 18 01' - '07 E8 18 01 08 E9 18 01 09 EA 18 01 11 EB 18 01 24 EC 18 01 25 ED 18 01 26 EE 18 01 27 EF 18 01' - '28 F0 18 01 29 F1 18 01 2A F2 18 01 2B 50 19 01 00 51 19 01 01 52 19 01 02 53 19 01 03 54 19 01' - '04 55 19 01 05 56 19 01 06 57 19 01 07 58 19 01 08 59 19 01 09 50 1C 01 00 51 1C 01 01 52 1C 01' - '02 53 1C 01 03 54 1C 01 04 55 1C 01 05 56 1C 01 06 57 1C 01 07 58 1C 01 08 59 1C 01 09 5A 1C 01' - '01 5B 1C 01 02 5C 1C 01 03 5D 1C 01 04 5E 1C 01 05 5F 1C 01 06 60 1C 01 07 61 1C 01 08 62 1C 01' - '09 63 1C 01 11 64 1C 01 24 65 1C 01 25 66 1C 01 26 67 1C 01 27 68 1C 01 28 69 1C 01 29 6A 1C 01' - '2A 6B 1C 01 2B 6C 1C 01 12 50 1D 01 00 51 1D 01 01 52 1D 01 02 53 1D 01 03 54 1D 01 04 55 1D 01' - '05 56 1D 01 06 57 1D 01 07 58 1D 01 08 59 1D 01 09 A0 1D 01 00 A1 1D 01 01 A2 1D 01 02 A3 1D 01' - '03 A4 1D 01 04 A5 1D 01 05 A6 1D 01 06 A7 1D 01 07 A8 1D 01 08 A9 1D 01 09 C0 1F 01 88 C1 1F 01' - '14 C2 1F 01 89 C3 1F 01 8A C4 1F 01 15 C5 1F 01 8B C6 1F 01 16 C7 1F 01 8C C8 1F 01 17 C9 1F 01' - '0D CA 1F 01 0D CB 1F 01 18 CC 1F 01 0E CD 1F 01 19 CE 1F 01 0F CF 1F 01 1A D0 1F 01 0A D1 1F 01' - '0B D2 1F 01 0B D3 1F 01 0C D4 1F 01 88 00 24 01 02 01 24 01 03 02 24 01 04 03 24 01 05 04 24 01' - '06 05 24 01 07 06 24 01 08 07 24 01 09 08 24 01 03 09 24 01 04 0A 24 01 05 0B 24 01 06 0C 24 01' - '07 0D 24 01 08 0E 24 01 09 0F 24 01 04 10 24 01 05 11 24 01 06 12 24 01 07 13 24 01 08 14 24 01' - '09 15 24 01 01 16 24 01 02 17 24 01 03 18 24 01 04 19 24 01 05 1A 24 01 06 1B 24 01 07 1C 24 01' - '08 1D 24 01 09 1E 24 01 01 1F 24 01 02 20 24 01 03 21 24 01 04 22 24 01 05 23 24 01 02 24 24 01' - '03 25 24 01 03 26 24 01 04 27 24 01 05 28 24 01 06 29 24 01 07 2A 24 01 08 2B 24 01 09 2C 24 01' - '01 2D 24 01 02 2E 24 01 03 2F 24 01 03 30 24 01 04 31 24 01 05 32 24 01 8D 33 24 01 8E 34 24 01' - '01 35 24 01 02 36 24 01 03 37 24 01 03 38 24 01 04 39 24 01 05 3A 24 01 03 3B 24 01 03 3C 24 01' - '04 3D 24 01 04 3E 24 01 04 3F 24 01 04 40 24 01 06 41 24 01 07 42 24 01 07 43 24 01 07 44 24 01' - '08 45 24 01 08 46 24 01 09 47 24 01 09 48 24 01 09 49 24 01 09 4A 24 01 02 4B 24 01 03 4C 24 01' - '04 4D 24 01 05 4E 24 01 06 4F 24 01 01 50 24 01 02 51 24 01 03 52 24 01 04 53 24 01 04 54 24 01' - '05 55 24 01 05 56 24 01 02 57 24 01 03 58 24 01 01 59 24 01 02 5A 24 01 32 5B 24 01 33 5C 24 01' - '38 5D 24 01 32 5E 24 01 33 5F 24 01 0E 60 24 01 0A 61 24 01 37 62 24 01 0A 63 24 01 0A 64 24 01' - '0B 65 24 01 32 66 24 01 33 67 24 01 26 68 24 01 27 69 24 01 04 6A 24 01 05 6B 24 01 06 6C 24 01' - '07 6D 24 01 08 6E 24 01 09 60 6A 01 00 61 6A 01 01 62 6A 01 02 63 6A 01 03 64 6A 01 04 65 6A 01' - '05 66 6A 01 06 67 6A 01 07 68 6A 01 08 69 6A 01 09 50 6B 01 00 51 6B 01 01 52 6B 01 02 53 6B 01' - '03 54 6B 01 04 55 6B 01 05 56 6B 01 06 57 6B 01 07 58 6B 01 08 59 6B 01 09 5B 6B 01 11 5C 6B 01' - '12 5D 6B 01 2C 5E 6B 01 8F 5F 6B 01 90 60 6B 01 91 61 6B 01 92 80 6E 01 00 81 6E 01 01 82 6E 01' - '02 83 6E 01 03 84 6E 01 04 85 6E 01 05 86 6E 01 06 87 6E 01 07 88 6E 01 08 89 6E 01 09 8A 6E 01' - '11 8B 6E 01 3C 8C 6E 01 3D 8D 6E 01 42 8E 6E 01 43 8F 6E 01 44 90 6E 01 10 91 6E 01 2D 92 6E 01' - '2E 93 6E 01 2F 94 6E 01 01 95 6E 01 02 96 6E 01 03 E0 D2 01 00 E1 D2 01 01 E2 D2 01 02 E3 D2 01' - '03 E4 D2 01 04 E5 D2 01 05 E6 D2 01 06 E7 D2 01 07 E8 D2 01 08 E9 D2 01 09 EA D2 01 11 EB D2 01' - '3C EC D2 01 3D ED D2 01 42 EE D2 01 43 EF D2 01 44 F0 D2 01 10 F1 D2 01 2D F2 D2 01 2E F3 D2 01' - '2F 60 D3 01 01 61 D3 01 02 62 D3 01 03 63 D3 01 04 64 D3 01 05 65 D3 01 06 66 D3 01 07 67 D3 01' - '08 68 D3 01 09 69 D3 01 11 6A D3 01 24 6B D3 01 25 6C D3 01 26 6D D3 01 27 6E D3 01 28 6F D3 01' - '29 70 D3 01 2A 71 D3 01 2B 72 D3 01 01 73 D3 01 02 74 D3 01 03 75 D3 01 04 76 D3 01 05 77 D3 01' - '01 78 D3 01 05 CE D7 01 00 CF D7 01 01 D0 D7 01 02 D1 D7 01 03 D2 D7 01 04 D3 D7 01 05 D4 D7 01' - '06 D5 D7 01 07 D6 D7 01 08 D7 D7 01 09 D8 D7 01 00 D9 D7 01 01 DA D7 01 02 DB D7 01 03 DC D7 01' - '04 DD D7 01 05 DE D7 01 06 DF D7 01 07 E0 D7 01 08 E1 D7 01 09 E2 D7 01 00 E3 D7 01 01 E4 D7 01' - '02 E5 D7 01 03 E6 D7 01 04 E7 D7 01 05 E8 D7 01 06 E9 D7 01 07 EA D7 01 08 EB D7 01 09 EC D7 01' - '00 ED D7 01 01 EE D7 01 02 EF D7 01 03 F0 D7 01 04 F1 D7 01 05 F2 D7 01 06 F3 D7 01 07 F4 D7 01' - '08 F5 D7 01 09 F6 D7 01 00 F7 D7 01 01 F8 D7 01 02 F9 D7 01 03 FA D7 01 04 FB D7 01 05 FC D7 01' - '06 FD D7 01 07 FE D7 01 08 FF D7 01 09 40 E1 01 00 41 E1 01 01 42 E1 01 02 43 E1 01 03 44 E1 01' - '04 45 E1 01 05 46 E1 01 06 47 E1 01 07 48 E1 01 08 49 E1 01 09 F0 E2 01 00 F1 E2 01 01 F2 E2 01' - '02 F3 E2 01 03 F4 E2 01 04 F5 E2 01 05 F6 E2 01 06 F7 E2 01 07 F8 E2 01 08 F9 E2 01 09 C7 E8 01' - '01 C8 E8 01 02 C9 E8 01 03 CA E8 01 04 CB E8 01 05 CC E8 01 06 CD E8 01 07 CE E8 01 08 CF E8 01' - '09 50 E9 01 00 51 E9 01 01 52 E9 01 02 53 E9 01 03 54 E9 01 04 55 E9 01 05 56 E9 01 06 57 E9 01' - '07 58 E9 01 08 59 E9 01 09 71 EC 01 01 72 EC 01 02 73 EC 01 03 74 EC 01 04 75 EC 01 05 76 EC 01' - '06 77 EC 01 07 78 EC 01 08 79 EC 01 09 7A EC 01 11 7B EC 01 24 7C EC 01 25 7D EC 01 26 7E EC 01' - '27 7F EC 01 28 80 EC 01 29 81 EC 01 2A 82 EC 01 2B 83 EC 01 12 84 EC 01 60 85 EC 01 61 86 EC 01' - '62 87 EC 01 3E 88 EC 01 63 89 EC 01 64 8A EC 01 65 8B EC 01 66 8C EC 01 13 8D EC 01 67 8E EC 01' - '68 8F EC 01 69 90 EC 01 3F 91 EC 01 6A 92 EC 01 6B 93 EC 01 6C 94 EC 01 6D 95 EC 01 2C 96 EC 01' - '6E 97 EC 01 6F 98 EC 01 70 99 EC 01 40 9A EC 01 71 9B EC 01 72 9C EC 01 73 9D EC 01 74 9E EC 01' - '41 9F EC 01 76 A0 EC 01 41 A1 EC 01 93 A2 EC 01 94 A3 EC 01 01 A4 EC 01 02 A5 EC 01 03 A6 EC 01' - '04 A7 EC 01 05 A8 EC 01 06 A9 EC 01 07 AA EC 01 08 AB EC 01 09 AD EC 01 0A AE EC 01 0B AF EC 01' - '0C B1 EC 01 01 B2 EC 01 02 B3 EC 01 2C B4 EC 01 41 01 ED 01 01 02 ED 01 02 03 ED 01 03 04 ED 01' - '04 05 ED 01 05 06 ED 01 06 07 ED 01 07 08 ED 01 08 09 ED 01 09 0A ED 01 11 0B ED 01 24 0C ED 01' - '25 0D ED 01 26 0E ED 01 27 0F ED 01 28 10 ED 01 29 11 ED 01 2A 12 ED 01 2B 13 ED 01 12 14 ED 01' - '60 15 ED 01 61 16 ED 01 62 17 ED 01 3E 18 ED 01 63 19 ED 01 64 1A ED 01 65 1B ED 01 66 1C ED 01' - '13 1D ED 01 67 1E ED 01 68 1F ED 01 69 20 ED 01 3F 21 ED 01 6A 22 ED 01 6B 23 ED 01 6C 24 ED 01' - '6D 25 ED 01 2C 26 ED 01 6E 27 ED 01 6F 28 ED 01 70 29 ED 01 40 2A ED 01 71 2B ED 01 72 2C ED 01' - '73 2D ED 01 74 2F ED 01 02 30 ED 01 03 31 ED 01 04 32 ED 01 05 33 ED 01 06 34 ED 01 07 35 ED 01' - '08 36 ED 01 09 37 ED 01 11 38 ED 01 62 39 ED 01 63 3A ED 01 67 3B ED 01 2C 3C ED 01 0B 3D ED 01' - '37 00 F1 01 00 01 F1 01 00 02 F1 01 01 03 F1 01 02 04 F1 01 03 05 F1 01 04 06 F1 01 05 07 F1 01' - '06 08 F1 01 07 09 F1 01 08 0A F1 01 09 0B F1 01 00 0C F1 01 00 F0 FB 01 00 F1 FB 01 01 F2 FB 01' - '02 F3 FB 01 03 F4 FB 01 04 F5 FB 01 05 F6 FB 01 06 F7 FB 01 07 F8 FB 01 08 F9 FB 01 09 90 F8 02' - '09' -} - - -LANGUAGE 0,0 COMPOSITION UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE -{ - '08 12 00 00 B4 00 00 02 10 20 00 00 01 03 00 84 03 00 02 10 20 00 00 01 03 00 DC 02 00 02 10 20' - '00 00 03 03 00 E3 FF 00 02 0B 20 00 00 04 03 00 AF 00 00 02 10 20 00 00 04 03 00 49 FE 00 02 10' - '20 00 00 05 03 00 3E 20 00 02 10 20 00 00 05 03 00 4A FE 00 02 10 20 00 00 05 03 00 4B FE 00 02' - '10 20 00 00 05 03 00 4C FE 00 02 10 20 00 00 05 03 00 D8 02 00 02 10 20 00 00 06 03 00 D9 02 00' - '02 10 20 00 00 07 03 00 ED 1F 00 03 00 20 00 00 08 03 00 00 03 00 85 03 00 03 00 20 00 00 08 03' - '00 01 03 00 C1 1F 00 03 00 20 00 00 08 03 00 42 03 00 A8 00 00 02 10 20 00 00 08 03 00 DA 02 00' - '02 10 20 00 00 0A 03 00 DD 02 00 02 10 20 00 00 0B 03 00 CD 1F 00 03 00 20 00 00 13 03 00 00 03' - '00 CE 1F 00 03 00 20 00 00 13 03 00 01 03 00 CF 1F 00 03 00 20 00 00 13 03 00 42 03 00 BF 1F 00' - '02 10 20 00 00 13 03 00 BD 1F 00 02 10 20 00 00 13 03 00 DD 1F 00 03 00 20 00 00 14 03 00 00 03' - '00 DE 1F 00 03 00 20 00 00 14 03 00 01 03 00 DF 1F 00 03 00 20 00 00 14 03 00 42 03 00 FE 1F 00' - '02 10 20 00 00 14 03 00 B8 00 00 02 10 20 00 00 27 03 00 DB 02 00 02 10 20 00 00 28 03 00 17 20' - '00 02 10 20 00 00 33 03 00 C0 1F 00 02 10 20 00 00 42 03 00 7A 03 00 02 10 20 00 00 45 03 00 70' - 'FE 00 02 06 20 00 00 4B 06 00 5E FC 00 03 06 20 00 00 4C 06 00 51 06 00 72 FE 00 02 06 20 00 00' - '4C 06 00 5F FC 00 03 06 20 00 00 4D 06 00 51 06 00 74 FE 00 02 06 20 00 00 4D 06 00 60 FC 00 03' - '06 20 00 00 4E 06 00 51 06 00 76 FE 00 02 06 20 00 00 4E 06 00 61 FC 00 03 06 20 00 00 4F 06 00' - '51 06 00 78 FE 00 02 06 20 00 00 4F 06 00 62 FC 00 03 06 20 00 00 50 06 00 51 06 00 7A FE 00 02' - '06 20 00 00 50 06 00 63 FC 00 03 06 20 00 00 51 06 00 70 06 00 7C FE 00 02 06 20 00 00 51 06 00' - '7E FE 00 02 06 20 00 00 52 06 00 9B 30 00 02 10 20 00 00 99 30 00 9C 30 00 02 10 20 00 00 9A 30' - '00 0A 20 00 01 10 20 00 00 09 20 00 01 10 20 00 00 2F 20 00 01 02 20 00 00 5F 20 00 01 10 20 00' - '00 A0 00 00 01 02 20 00 00 02 20 00 01 10 20 00 00 03 20 00 01 10 20 00 00 04 20 00 01 10 20 00' - '00 06 20 00 01 10 20 00 00 05 20 00 01 10 20 00 00 08 20 00 01 10 20 00 00 07 20 00 01 02 20 00' - '00 00 30 00 01 0B 20 00 00 3C 20 00 02 10 21 00 00 21 00 00 49 20 00 02 10 21 00 00 3F 00 00 57' - 'FE 00 01 0D 21 00 00 15 FE 00 01 0A 21 00 00 01 FF 00 01 0B 21 00 00 02 FF 00 01 0B 22 00 00 5F' - 'FE 00 01 0D 23 00 00 03 FF 00 01 0B 23 00 00 04 FF 00 01 0B 24 00 00 69 FE 00 01 0D 24 00 00 6A' - 'FE 00 01 0D 25 00 00 05 FF 00 01 0B 25 00 00 06 FF 00 01 0B 26 00 00 60 FE 00 01 0D 26 00 00 07' - 'FF 00 01 0B 27 00 00 74 24 00 03 10 28 00 00 31 00 00 29 00 00 7D 24 00 04 10 28 00 00 31 00 00' - '30 00 00 29 00 00 7E 24 00 04 10 28 00 00 31 00 00 31 00 00 29 00 00 7F 24 00 04 10 28 00 00 31' - '00 00 32 00 00 29 00 00 80 24 00 04 10 28 00 00 31 00 00 33 00 00 29 00 00 81 24 00 04 10 28 00' - '00 31 00 00 34 00 00 29 00 00 82 24 00 04 10 28 00 00 31 00 00 35 00 00 29 00 00 83 24 00 04 10' - '28 00 00 31 00 00 36 00 00 29 00 00 84 24 00 04 10 28 00 00 31 00 00 37 00 00 29 00 00 85 24 00' - '04 10 28 00 00 31 00 00 38 00 00 29 00 00 86 24 00 04 10 28 00 00 31 00 00 39 00 00 29 00 00 75' - '24 00 03 10 28 00 00 32 00 00 29 00 00 87 24 00 04 10 28 00 00 32 00 00 30 00 00 29 00 00 76 24' - '00 03 10 28 00 00 33 00 00 29 00 00 77 24 00 03 10 28 00 00 34 00 00 29 00 00 78 24 00 03 10 28' - '00 00 35 00 00 29 00 00 79 24 00 03 10 28 00 00 36 00 00 29 00 00 7A 24 00 03 10 28 00 00 37 00' - '00 29 00 00 7B 24 00 03 10 28 00 00 38 00 00 29 00 00 7C 24 00 03 10 28 00 00 39 00 00 29 00 00' - '10 F1 01 03 10 28 00 00 41 00 00 29 00 00 11 F1 01 03 10 28 00 00 42 00 00 29 00 00 12 F1 01 03' - '10 28 00 00 43 00 00 29 00 00 13 F1 01 03 10 28 00 00 44 00 00 29 00 00 14 F1 01 03 10 28 00 00' - '45 00 00 29 00 00 15 F1 01 03 10 28 00 00 46 00 00 29 00 00 16 F1 01 03 10 28 00 00 47 00 00 29' - '00 00 17 F1 01 03 10 28 00 00 48 00 00 29 00 00 18 F1 01 03 10 28 00 00 49 00 00 29 00 00 19 F1' - '01 03 10 28 00 00 4A 00 00 29 00 00 1A F1 01 03 10 28 00 00 4B 00 00 29 00 00 1B F1 01 03 10 28' - '00 00 4C 00 00 29 00 00 1C F1 01 03 10 28 00 00 4D 00 00 29 00 00 1D F1 01 03 10 28 00 00 4E 00' - '00 29 00 00 1E F1 01 03 10 28 00 00 4F 00 00 29 00 00 1F F1 01 03 10 28 00 00 50 00 00 29 00 00' - '20 F1 01 03 10 28 00 00 51 00 00 29 00 00 21 F1 01 03 10 28 00 00 52 00 00 29 00 00 22 F1 01 03' - '10 28 00 00 53 00 00 29 00 00 23 F1 01 03 10 28 00 00 54 00 00 29 00 00 24 F1 01 03 10 28 00 00' - '55 00 00 29 00 00 25 F1 01 03 10 28 00 00 56 00 00 29 00 00 26 F1 01 03 10 28 00 00 57 00 00 29' - '00 00 27 F1 01 03 10 28 00 00 58 00 00 29 00 00 28 F1 01 03 10 28 00 00 59 00 00 29 00 00 29 F1' - '01 03 10 28 00 00 5A 00 00 29 00 00 9C 24 00 03 10 28 00 00 61 00 00 29 00 00 9D 24 00 03 10 28' - '00 00 62 00 00 29 00 00 9E 24 00 03 10 28 00 00 63 00 00 29 00 00 9F 24 00 03 10 28 00 00 64 00' - '00 29 00 00 A0 24 00 03 10 28 00 00 65 00 00 29 00 00 A1 24 00 03 10 28 00 00 66 00 00 29 00 00' - 'A2 24 00 03 10 28 00 00 67 00 00 29 00 00 A3 24 00 03 10 28 00 00 68 00 00 29 00 00 A4 24 00 03' - '10 28 00 00 69 00 00 29 00 00 A5 24 00 03 10 28 00 00 6A 00 00 29 00 00 A6 24 00 03 10 28 00 00' - '6B 00 00 29 00 00 A7 24 00 03 10 28 00 00 6C 00 00 29 00 00 A8 24 00 03 10 28 00 00 6D 00 00 29' - '00 00 A9 24 00 03 10 28 00 00 6E 00 00 29 00 00 AA 24 00 03 10 28 00 00 6F 00 00 29 00 00 AB 24' - '00 03 10 28 00 00 70 00 00 29 00 00 AC 24 00 03 10 28 00 00 71 00 00 29 00 00 AD 24 00 03 10 28' - '00 00 72 00 00 29 00 00 AE 24 00 03 10 28 00 00 73 00 00 29 00 00 AF 24 00 03 10 28 00 00 74 00' - '00 29 00 00 B0 24 00 03 10 28 00 00 75 00 00 29 00 00 B1 24 00 03 10 28 00 00 76 00 00 29 00 00' - 'B2 24 00 03 10 28 00 00 77 00 00 29 00 00 B3 24 00 03 10 28 00 00 78 00 00 29 00 00 B4 24 00 03' - '10 28 00 00 79 00 00 29 00 00 B5 24 00 03 10 28 00 00 7A 00 00 29 00 00 00 32 00 03 10 28 00 00' - '00 11 00 29 00 00 0E 32 00 04 10 28 00 00 00 11 00 61 11 00 29 00 00 01 32 00 03 10 28 00 00 02' - '11 00 29 00 00 0F 32 00 04 10 28 00 00 02 11 00 61 11 00 29 00 00 02 32 00 03 10 28 00 00 03 11' - '00 29 00 00 10 32 00 04 10 28 00 00 03 11 00 61 11 00 29 00 00 03 32 00 03 10 28 00 00 05 11 00' - '29 00 00 11 32 00 04 10 28 00 00 05 11 00 61 11 00 29 00 00 04 32 00 03 10 28 00 00 06 11 00 29' - '00 00 12 32 00 04 10 28 00 00 06 11 00 61 11 00 29 00 00 05 32 00 03 10 28 00 00 07 11 00 29 00' - '00 13 32 00 04 10 28 00 00 07 11 00 61 11 00 29 00 00 06 32 00 03 10 28 00 00 09 11 00 29 00 00' - '14 32 00 04 10 28 00 00 09 11 00 61 11 00 29 00 00 07 32 00 03 10 28 00 00 0B 11 00 29 00 00 15' - '32 00 04 10 28 00 00 0B 11 00 61 11 00 29 00 00 1D 32 00 07 10 28 00 00 0B 11 00 69 11 00 0C 11' - '00 65 11 00 AB 11 00 29 00 00 1E 32 00 06 10 28 00 00 0B 11 00 69 11 00 12 11 00 6E 11 00 29 00' - '00 08 32 00 03 10 28 00 00 0C 11 00 29 00 00 16 32 00 04 10 28 00 00 0C 11 00 61 11 00 29 00 00' - '1C 32 00 04 10 28 00 00 0C 11 00 6E 11 00 29 00 00 09 32 00 03 10 28 00 00 0E 11 00 29 00 00 17' - '32 00 04 10 28 00 00 0E 11 00 61 11 00 29 00 00 0A 32 00 03 10 28 00 00 0F 11 00 29 00 00 18 32' - '00 04 10 28 00 00 0F 11 00 61 11 00 29 00 00 0B 32 00 03 10 28 00 00 10 11 00 29 00 00 19 32 00' - '04 10 28 00 00 10 11 00 61 11 00 29 00 00 0C 32 00 03 10 28 00 00 11 11 00 29 00 00 1A 32 00 04' - '10 28 00 00 11 11 00 61 11 00 29 00 00 0D 32 00 03 10 28 00 00 12 11 00 29 00 00 1B 32 00 04 10' - '28 00 00 12 11 00 61 11 00 29 00 00 20 32 00 03 10 28 00 00 00 4E 00 29 00 00 26 32 00 03 10 28' - '00 00 03 4E 00 29 00 00 22 32 00 03 10 28 00 00 09 4E 00 29 00 00 28 32 00 03 10 28 00 00 5D 4E' - '00 29 00 00 21 32 00 03 10 28 00 00 8C 4E 00 29 00 00 24 32 00 03 10 28 00 00 94 4E 00 29 00 00' - '39 32 00 03 10 28 00 00 E3 4E 00 29 00 00 3D 32 00 03 10 28 00 00 01 4F 00 29 00 00 41 32 00 03' - '10 28 00 00 11 4F 00 29 00 00 27 32 00 03 10 28 00 00 6B 51 00 29 00 00 25 32 00 03 10 28 00 00' - '6D 51 00 29 00 00 38 32 00 03 10 28 00 00 B4 52 00 29 00 00 29 32 00 03 10 28 00 00 41 53 00 29' - '00 00 3F 32 00 03 10 28 00 00 54 53 00 29 00 00 34 32 00 03 10 28 00 00 0D 54 00 29 00 00 3A 32' - '00 03 10 28 00 00 7C 54 00 29 00 00 23 32 00 03 10 28 00 00 DB 56 00 29 00 00 2F 32 00 03 10 28' - '00 00 1F 57 00 29 00 00 3B 32 00 03 10 28 00 00 66 5B 00 29 00 00 30 32 00 03 10 28 00 00 E5 65' - '00 29 00 00 2A 32 00 03 10 28 00 00 08 67 00 29 00 00 32 32 00 03 10 28 00 00 09 67 00 29 00 00' - '2D 32 00 03 10 28 00 00 28 67 00 29 00 00 31 32 00 03 10 28 00 00 2A 68 00 29 00 00 2C 32 00 03' - '10 28 00 00 34 6C 00 29 00 00 2B 32 00 03 10 28 00 00 6B 70 00 29 00 00 35 32 00 03 10 28 00 00' - '79 72 00 29 00 00 3C 32 00 03 10 28 00 00 E3 76 00 29 00 00 33 32 00 03 10 28 00 00 3E 79 00 29' - '00 00 37 32 00 03 10 28 00 00 5D 79 00 29 00 00 40 32 00 03 10 28 00 00 6D 79 00 29 00 00 42 32' - '00 03 10 28 00 00 EA 81 00 29 00 00 43 32 00 03 10 28 00 00 F3 81 00 29 00 00 36 32 00 03 10 28' - '00 00 A1 8C 00 29 00 00 3E 32 00 03 10 28 00 00 C7 8C 00 29 00 00 2E 32 00 03 10 28 00 00 D1 91' - '00 29 00 00 7D 20 00 01 08 28 00 00 08 FF 00 01 0B 28 00 00 35 FE 00 01 0A 28 00 00 59 FE 00 01' - '0D 28 00 00 8D 20 00 01 09 28 00 00 5A FE 00 01 0D 29 00 00 09 FF 00 01 0B 29 00 00 8E 20 00 01' - '09 29 00 00 7E 20 00 01 08 29 00 00 36 FE 00 01 0A 29 00 00 0A FF 00 01 0B 2A 00 00 61 FE 00 01' - '0D 2A 00 00 7A 20 00 01 08 2B 00 00 8A 20 00 01 09 2B 00 00 29 FB 00 01 01 2B 00 00 62 FE 00 01' - '0D 2B 00 00 0B FF 00 01 0B 2B 00 00 50 FE 00 01 0D 2C 00 00 0C FF 00 01 0B 2C 00 00 10 FE 00 01' - '0A 2C 00 00 0D FF 00 01 0B 2D 00 00 63 FE 00 01 0D 2D 00 00 19 FE 00 03 0A 2E 00 00 2E 00 00 2E' - '00 00 26 20 00 03 10 2E 00 00 2E 00 00 2E 00 00 30 FE 00 02 0A 2E 00 00 2E 00 00 25 20 00 02 10' - '2E 00 00 2E 00 00 52 FE 00 01 0D 2E 00 00 24 20 00 01 10 2E 00 00 0E FF 00 01 0B 2E 00 00 0F FF' - '00 01 0B 2F 00 00 01 F1 01 02 10 30 00 00 2C 00 00 00 F1 01 02 10 30 00 00 2E 00 00 89 21 00 03' - '0F 30 00 00 44 20 00 33 00 00 58 33 00 02 10 30 00 00 B9 70 00 D8 D7 01 01 01 30 00 00 E2 D7 01' - '01 01 30 00 00 CE D7 01 01 01 30 00 00 10 FF 00 01 0B 30 00 00 F0 FB 01 01 01 30 00 00 EA 24 00' - '01 07 30 00 00 EC D7 01 01 01 30 00 00 80 20 00 01 09 30 00 00 70 20 00 01 08 30 00 00 F6 D7 01' - '01 01 30 00 00 02 F1 01 02 10 31 00 00 2C 00 00 88 24 00 02 10 31 00 00 2E 00 00 91 24 00 03 10' - '31 00 00 30 00 00 2E 00 00 E9 33 00 03 10 31 00 00 30 00 00 E5 65 00 C9 32 00 03 10 31 00 00 30' - '00 00 08 67 00 62 33 00 03 10 31 00 00 30 00 00 B9 70 00 69 24 00 02 07 31 00 00 30 00 00 92 24' - '00 03 10 31 00 00 31 00 00 2E 00 00 EA 33 00 03 10 31 00 00 31 00 00 E5 65 00 CA 32 00 03 10 31' - '00 00 31 00 00 08 67 00 63 33 00 03 10 31 00 00 31 00 00 B9 70 00 6A 24 00 02 07 31 00 00 31 00' - '00 93 24 00 03 10 31 00 00 32 00 00 2E 00 00 EB 33 00 03 10 31 00 00 32 00 00 E5 65 00 CB 32 00' - '03 10 31 00 00 32 00 00 08 67 00 64 33 00 03 10 31 00 00 32 00 00 B9 70 00 6B 24 00 02 07 31 00' - '00 32 00 00 94 24 00 03 10 31 00 00 33 00 00 2E 00 00 EC 33 00 03 10 31 00 00 33 00 00 E5 65 00' - '65 33 00 03 10 31 00 00 33 00 00 B9 70 00 6C 24 00 02 07 31 00 00 33 00 00 95 24 00 03 10 31 00' - '00 34 00 00 2E 00 00 ED 33 00 03 10 31 00 00 34 00 00 E5 65 00 66 33 00 03 10 31 00 00 34 00 00' - 'B9 70 00 6D 24 00 02 07 31 00 00 34 00 00 96 24 00 03 10 31 00 00 35 00 00 2E 00 00 EE 33 00 03' - '10 31 00 00 35 00 00 E5 65 00 67 33 00 03 10 31 00 00 35 00 00 B9 70 00 6E 24 00 02 07 31 00 00' - '35 00 00 97 24 00 03 10 31 00 00 36 00 00 2E 00 00 EF 33 00 03 10 31 00 00 36 00 00 E5 65 00 68' - '33 00 03 10 31 00 00 36 00 00 B9 70 00 6F 24 00 02 07 31 00 00 36 00 00 98 24 00 03 10 31 00 00' - '37 00 00 2E 00 00 F0 33 00 03 10 31 00 00 37 00 00 E5 65 00 69 33 00 03 10 31 00 00 37 00 00 B9' - '70 00 70 24 00 02 07 31 00 00 37 00 00 99 24 00 03 10 31 00 00 38 00 00 2E 00 00 F1 33 00 03 10' - '31 00 00 38 00 00 E5 65 00 6A 33 00 03 10 31 00 00 38 00 00 B9 70 00 71 24 00 02 07 31 00 00 38' - '00 00 9A 24 00 03 10 31 00 00 39 00 00 2E 00 00 F2 33 00 03 10 31 00 00 39 00 00 E5 65 00 6B 33' - '00 03 10 31 00 00 39 00 00 B9 70 00 72 24 00 02 07 31 00 00 39 00 00 52 21 00 04 0F 31 00 00 44' - '20 00 31 00 00 30 00 00 BD 00 00 03 0F 31 00 00 44 20 00 32 00 00 53 21 00 03 0F 31 00 00 44 20' - '00 33 00 00 BC 00 00 03 0F 31 00 00 44 20 00 34 00 00 55 21 00 03 0F 31 00 00 44 20 00 35 00 00' - '59 21 00 03 0F 31 00 00 44 20 00 36 00 00 50 21 00 03 0F 31 00 00 44 20 00 37 00 00 5B 21 00 03' - '0F 31 00 00 44 20 00 38 00 00 51 21 00 03 0F 31 00 00 44 20 00 39 00 00 5F 21 00 02 0F 31 00 00' - '44 20 00 E0 33 00 02 10 31 00 00 E5 65 00 C0 32 00 02 10 31 00 00 08 67 00 59 33 00 02 10 31 00' - '00 B9 70 00 81 20 00 01 09 31 00 00 D9 D7 01 01 01 31 00 00 E3 D7 01 01 01 31 00 00 F7 D7 01 01' - '01 31 00 00 60 24 00 01 07 31 00 00 F1 FB 01 01 01 31 00 00 11 FF 00 01 0B 31 00 00 ED D7 01 01' - '01 31 00 00 CF D7 01 01 01 31 00 00 B9 00 00 01 08 31 00 00 03 F1 01 02 10 32 00 00 2C 00 00 89' - '24 00 02 10 32 00 00 2E 00 00 9B 24 00 03 10 32 00 00 30 00 00 2E 00 00 F3 33 00 03 10 32 00 00' - '30 00 00 E5 65 00 6C 33 00 03 10 32 00 00 30 00 00 B9 70 00 73 24 00 02 07 32 00 00 30 00 00 F4' - '33 00 03 10 32 00 00 31 00 00 E5 65 00 6D 33 00 03 10 32 00 00 31 00 00 B9 70 00 51 32 00 02 07' - '32 00 00 31 00 00 F5 33 00 03 10 32 00 00 32 00 00 E5 65 00 6E 33 00 03 10 32 00 00 32 00 00 B9' - '70 00 52 32 00 02 07 32 00 00 32 00 00 F6 33 00 03 10 32 00 00 33 00 00 E5 65 00 6F 33 00 03 10' - '32 00 00 33 00 00 B9 70 00 53 32 00 02 07 32 00 00 33 00 00 F7 33 00 03 10 32 00 00 34 00 00 E5' - '65 00 70 33 00 03 10 32 00 00 34 00 00 B9 70 00 54 32 00 02 07 32 00 00 34 00 00 F8 33 00 03 10' - '32 00 00 35 00 00 E5 65 00 55 32 00 02 07 32 00 00 35 00 00 F9 33 00 03 10 32 00 00 36 00 00 E5' - '65 00 56 32 00 02 07 32 00 00 36 00 00 FA 33 00 03 10 32 00 00 37 00 00 E5 65 00 57 32 00 02 07' - '32 00 00 37 00 00 FB 33 00 03 10 32 00 00 38 00 00 E5 65 00 58 32 00 02 07 32 00 00 38 00 00 FC' - '33 00 03 10 32 00 00 39 00 00 E5 65 00 59 32 00 02 07 32 00 00 39 00 00 54 21 00 03 0F 32 00 00' - '44 20 00 33 00 00 56 21 00 03 0F 32 00 00 44 20 00 35 00 00 E1 33 00 02 10 32 00 00 E5 65 00 C1' - '32 00 02 10 32 00 00 08 67 00 5A 33 00 02 10 32 00 00 B9 70 00 82 20 00 01 09 32 00 00 61 24 00' - '01 07 32 00 00 B2 00 00 01 08 32 00 00 12 FF 00 01 0B 32 00 00 F2 FB 01 01 01 32 00 00 E4 D7 01' - '01 01 32 00 00 EE D7 01 01 01 32 00 00 D0 D7 01 01 01 32 00 00 DA D7 01 01 01 32 00 00 F8 D7 01' - '01 01 32 00 00 04 F1 01 02 10 33 00 00 2C 00 00 8A 24 00 02 10 33 00 00 2E 00 00 FD 33 00 03 10' - '33 00 00 30 00 00 E5 65 00 5A 32 00 02 07 33 00 00 30 00 00 FE 33 00 03 10 33 00 00 31 00 00 E5' - '65 00 5B 32 00 02 07 33 00 00 31 00 00 5C 32 00 02 07 33 00 00 32 00 00 5D 32 00 02 07 33 00 00' - '33 00 00 5E 32 00 02 07 33 00 00 34 00 00 5F 32 00 02 07 33 00 00 35 00 00 B1 32 00 02 07 33 00' - '00 36 00 00 B2 32 00 02 07 33 00 00 37 00 00 B3 32 00 02 07 33 00 00 38 00 00 B4 32 00 02 07 33' - '00 00 39 00 00 BE 00 00 03 0F 33 00 00 44 20 00 34 00 00 57 21 00 03 0F 33 00 00 44 20 00 35 00' - '00 5C 21 00 03 0F 33 00 00 44 20 00 38 00 00 E2 33 00 02 10 33 00 00 E5 65 00 C2 32 00 02 10 33' - '00 00 08 67 00 5B 33 00 02 10 33 00 00 B9 70 00 F3 FB 01 01 01 33 00 00 13 FF 00 01 0B 33 00 00' - 'D1 D7 01 01 01 33 00 00 B3 00 00 01 08 33 00 00 F9 D7 01 01 01 33 00 00 EF D7 01 01 01 33 00 00' - 'DB D7 01 01 01 33 00 00 E5 D7 01 01 01 33 00 00 83 20 00 01 09 33 00 00 62 24 00 01 07 33 00 00' - '05 F1 01 02 10 34 00 00 2C 00 00 8B 24 00 02 10 34 00 00 2E 00 00 B5 32 00 02 07 34 00 00 30 00' - '00 B6 32 00 02 07 34 00 00 31 00 00 B7 32 00 02 07 34 00 00 32 00 00 B8 32 00 02 07 34 00 00 33' - '00 00 B9 32 00 02 07 34 00 00 34 00 00 BA 32 00 02 07 34 00 00 35 00 00 BB 32 00 02 07 34 00 00' - '36 00 00 BC 32 00 02 07 34 00 00 37 00 00 BD 32 00 02 07 34 00 00 38 00 00 BE 32 00 02 07 34 00' - '00 39 00 00 58 21 00 03 0F 34 00 00 44 20 00 35 00 00 E3 33 00 02 10 34 00 00 E5 65 00 C3 32 00' - '02 10 34 00 00 08 67 00 5C 33 00 02 10 34 00 00 B9 70 00 FA D7 01 01 01 34 00 00 DC D7 01 01 01' - '34 00 00 63 24 00 01 07 34 00 00 E6 D7 01 01 01 34 00 00 F0 D7 01 01 01 34 00 00 F4 FB 01 01 01' - '34 00 00 84 20 00 01 09 34 00 00 D2 D7 01 01 01 34 00 00 14 FF 00 01 0B 34 00 00 74 20 00 01 08' - '34 00 00 06 F1 01 02 10 35 00 00 2C 00 00 8C 24 00 02 10 35 00 00 2E 00 00 BF 32 00 02 07 35 00' - '00 30 00 00 5A 21 00 03 0F 35 00 00 44 20 00 36 00 00 5D 21 00 03 0F 35 00 00 44 20 00 38 00 00' - 'E4 33 00 02 10 35 00 00 E5 65 00 C4 32 00 02 10 35 00 00 08 67 00 5D 33 00 02 10 35 00 00 B9 70' - '00 E7 D7 01 01 01 35 00 00 D3 D7 01 01 01 35 00 00 85 20 00 01 09 35 00 00 FB D7 01 01 01 35 00' - '00 DD D7 01 01 01 35 00 00 F1 D7 01 01 01 35 00 00 F5 FB 01 01 01 35 00 00 75 20 00 01 08 35 00' - '00 64 24 00 01 07 35 00 00 15 FF 00 01 0B 35 00 00 07 F1 01 02 10 36 00 00 2C 00 00 8D 24 00 02' - '10 36 00 00 2E 00 00 E5 33 00 02 10 36 00 00 E5 65 00 C5 32 00 02 10 36 00 00 08 67 00 5E 33 00' - '02 10 36 00 00 B9 70 00 F6 FB 01 01 01 36 00 00 16 FF 00 01 0B 36 00 00 65 24 00 01 07 36 00 00' - '86 20 00 01 09 36 00 00 D4 D7 01 01 01 36 00 00 DE D7 01 01 01 36 00 00 76 20 00 01 08 36 00 00' - 'E8 D7 01 01 01 36 00 00 F2 D7 01 01 01 36 00 00 FC D7 01 01 01 36 00 00 08 F1 01 02 10 37 00 00' - '2C 00 00 8E 24 00 02 10 37 00 00 2E 00 00 5E 21 00 03 0F 37 00 00 44 20 00 38 00 00 E6 33 00 02' - '10 37 00 00 E5 65 00 C6 32 00 02 10 37 00 00 08 67 00 5F 33 00 02 10 37 00 00 B9 70 00 17 FF 00' - '01 0B 37 00 00 F7 FB 01 01 01 37 00 00 D5 D7 01 01 01 37 00 00 F3 D7 01 01 01 37 00 00 E9 D7 01' - '01 01 37 00 00 77 20 00 01 08 37 00 00 DF D7 01 01 01 37 00 00 66 24 00 01 07 37 00 00 FD D7 01' - '01 01 37 00 00 87 20 00 01 09 37 00 00 09 F1 01 02 10 38 00 00 2C 00 00 8F 24 00 02 10 38 00 00' - '2E 00 00 E7 33 00 02 10 38 00 00 E5 65 00 C7 32 00 02 10 38 00 00 08 67 00 60 33 00 02 10 38 00' - '00 B9 70 00 F4 D7 01 01 01 38 00 00 88 20 00 01 09 38 00 00 18 FF 00 01 0B 38 00 00 F8 FB 01 01' - '01 38 00 00 EA D7 01 01 01 38 00 00 E0 D7 01 01 01 38 00 00 67 24 00 01 07 38 00 00 78 20 00 01' - '08 38 00 00 FE D7 01 01 01 38 00 00 D6 D7 01 01 01 38 00 00 0A F1 01 02 10 39 00 00 2C 00 00 90' - '24 00 02 10 39 00 00 2E 00 00 E8 33 00 02 10 39 00 00 E5 65 00 C8 32 00 02 10 39 00 00 08 67 00' - '61 33 00 02 10 39 00 00 B9 70 00 19 FF 00 01 0B 39 00 00 FF D7 01 01 01 39 00 00 79 20 00 01 08' - '39 00 00 EB D7 01 01 01 39 00 00 68 24 00 01 07 39 00 00 D7 D7 01 01 01 39 00 00 F9 FB 01 01 01' - '39 00 00 F5 D7 01 01 01 39 00 00 E1 D7 01 01 01 39 00 00 89 20 00 01 09 39 00 00 74 2A 00 03 10' - '3A 00 00 3A 00 00 3D 00 00 55 FE 00 01 0D 3A 00 00 13 FE 00 01 0A 3A 00 00 1A FF 00 01 0B 3A 00' - '00 14 FE 00 01 0A 3B 00 00 54 FE 00 01 0D 3B 00 00 1B FF 00 01 0B 3B 00 00 6E 22 00 02 00 3C 00' - '00 38 03 00 1C FF 00 01 0B 3C 00 00 64 FE 00 01 0D 3C 00 00 76 2A 00 03 10 3D 00 00 3D 00 00 3D' - '00 00 75 2A 00 02 10 3D 00 00 3D 00 00 60 22 00 02 00 3D 00 00 38 03 00 7C 20 00 01 08 3D 00 00' - '8C 20 00 01 09 3D 00 00 1D FF 00 01 0B 3D 00 00 66 FE 00 01 0D 3D 00 00 6F 22 00 02 00 3E 00 00' - '38 03 00 65 FE 00 01 0D 3E 00 00 1E FF 00 01 0B 3E 00 00 48 20 00 02 10 3F 00 00 21 00 00 47 20' - '00 02 10 3F 00 00 3F 00 00 1F FF 00 01 0B 3F 00 00 56 FE 00 01 0D 3F 00 00 16 FE 00 01 0A 3F 00' - '00 6B FE 00 01 0D 40 00 00 20 FF 00 01 0B 40 00 00 73 33 00 02 0E 41 00 00 55 00 00 C0 00 00 02' - '00 41 00 00 00 03 00 C1 00 00 02 00 41 00 00 01 03 00 A6 1E 00 03 00 41 00 00 02 03 00 00 03 00' - 'A4 1E 00 03 00 41 00 00 02 03 00 01 03 00 AA 1E 00 03 00 41 00 00 02 03 00 03 03 00 A8 1E 00 03' - '00 41 00 00 02 03 00 09 03 00 C2 00 00 02 00 41 00 00 02 03 00 C3 00 00 02 00 41 00 00 03 03 00' - '00 01 00 02 00 41 00 00 04 03 00 B0 1E 00 03 00 41 00 00 06 03 00 00 03 00 AE 1E 00 03 00 41 00' - '00 06 03 00 01 03 00 B4 1E 00 03 00 41 00 00 06 03 00 03 03 00 B2 1E 00 03 00 41 00 00 06 03 00' - '09 03 00 02 01 00 02 00 41 00 00 06 03 00 E0 01 00 03 00 41 00 00 07 03 00 04 03 00 26 02 00 02' - '00 41 00 00 07 03 00 DE 01 00 03 00 41 00 00 08 03 00 04 03 00 C4 00 00 02 00 41 00 00 08 03 00' - 'A2 1E 00 02 00 41 00 00 09 03 00 FA 01 00 03 00 41 00 00 0A 03 00 01 03 00 C5 00 00 02 00 41 00' - '00 0A 03 00 CD 01 00 02 00 41 00 00 0C 03 00 00 02 00 02 00 41 00 00 0F 03 00 02 02 00 02 00 41' - '00 00 11 03 00 AC 1E 00 03 00 41 00 00 23 03 00 02 03 00 B6 1E 00 03 00 41 00 00 23 03 00 06 03' - '00 A0 1E 00 02 00 41 00 00 23 03 00 00 1E 00 02 00 41 00 00 25 03 00 04 01 00 02 00 41 00 00 28' - '03 00 DF 33 00 03 0E 41 00 00 15 22 00 6D 00 00 21 FF 00 01 0B 41 00 00 38 D5 01 01 01 41 00 00' - '3C D6 01 01 01 41 00 00 A0 D5 01 01 01 41 00 00 2C 1D 00 01 08 41 00 00 04 D5 01 01 01 41 00 00' - '6C D5 01 01 01 41 00 00 30 F1 01 01 0E 41 00 00 68 D4 01 01 01 41 00 00 B6 24 00 01 07 41 00 00' - '9C D4 01 01 01 41 00 00 D4 D5 01 01 01 41 00 00 D0 D4 01 01 01 41 00 00 70 D6 01 01 01 41 00 00' - '08 D6 01 01 01 41 00 00 00 D4 01 01 01 41 00 00 34 D4 01 01 01 41 00 00 C3 33 00 02 0E 42 00 00' - '71 00 00 02 1E 00 02 00 42 00 00 07 03 00 04 1E 00 02 00 42 00 00 23 03 00 06 1E 00 02 00 42 00' - '00 31 03 00 3D D6 01 01 01 42 00 00 31 F1 01 01 0E 42 00 00 05 D5 01 01 01 42 00 00 39 D5 01 01' - '01 42 00 00 01 D4 01 01 01 42 00 00 D1 D4 01 01 01 42 00 00 35 D4 01 01 01 42 00 00 71 D6 01 01' - '01 42 00 00 09 D6 01 01 01 42 00 00 B7 24 00 01 07 42 00 00 D5 D5 01 01 01 42 00 00 2C 21 00 01' - '01 42 00 00 A1 D5 01 01 01 42 00 00 2E 1D 00 01 08 42 00 00 6D D5 01 01 01 42 00 00 69 D4 01 01' - '01 42 00 00 22 FF 00 01 0B 42 00 00 2D F1 01 02 07 43 00 00 44 00 00 C7 33 00 03 0E 43 00 00 6F' - '00 00 2E 00 00 06 01 00 02 00 43 00 00 01 03 00 08 01 00 02 00 43 00 00 02 03 00 0A 01 00 02 00' - '43 00 00 07 03 00 0C 01 00 02 00 43 00 00 0C 03 00 08 1E 00 03 00 43 00 00 27 03 00 01 03 00 C7' - '00 00 02 00 43 00 00 27 03 00 C6 33 00 04 0E 43 00 00 15 22 00 6B 00 00 67 00 00 6E D5 01 01 01' - '43 00 00 3E D6 01 01 01 43 00 00 9E D4 01 01 01 43 00 00 32 F1 01 01 0E 43 00 00 2B F1 01 01 07' - '43 00 00 02 21 00 01 01 43 00 00 A2 D5 01 01 01 43 00 00 6A D4 01 01 01 43 00 00 6D 21 00 01 10' - '43 00 00 02 D4 01 01 01 43 00 00 B8 24 00 01 07 43 00 00 0A D6 01 01 01 43 00 00 D2 D4 01 01 01' - '43 00 00 23 FF 00 01 0B 43 00 00 36 D4 01 01 01 43 00 00 2D 21 00 01 01 43 00 00 72 D6 01 01 01' - '43 00 00 D6 D5 01 01 01 43 00 00 90 F1 01 02 0E 44 00 00 4A 00 00 C4 01 00 03 10 44 00 00 5A 00' - '00 0C 03 00 F1 01 00 02 10 44 00 00 5A 00 00 C5 01 00 03 10 44 00 00 7A 00 00 0C 03 00 F2 01 00' - '02 10 44 00 00 7A 00 00 0A 1E 00 02 00 44 00 00 07 03 00 0E 01 00 02 00 44 00 00 0C 03 00 0C 1E' - '00 02 00 44 00 00 23 03 00 10 1E 00 02 00 44 00 00 27 03 00 12 1E 00 02 00 44 00 00 2D 03 00 0E' - '1E 00 02 00 44 00 00 31 03 00 A3 D5 01 01 01 44 00 00 6B D4 01 01 01 44 00 00 B9 24 00 01 07 44' - '00 00 24 FF 00 01 0B 44 00 00 45 21 00 01 01 44 00 00 D3 D4 01 01 01 44 00 00 07 D5 01 01 01 44' - '00 00 0B D6 01 01 01 44 00 00 3B D5 01 01 01 44 00 00 03 D4 01 01 01 44 00 00 6F D5 01 01 01 44' - '00 00 3F D6 01 01 01 44 00 00 33 F1 01 01 0E 44 00 00 30 1D 00 01 08 44 00 00 73 D6 01 01 01 44' - '00 00 6E 21 00 01 10 44 00 00 37 D4 01 01 01 44 00 00 9F D4 01 01 01 44 00 00 D7 D5 01 01 01 44' - '00 00 C8 00 00 02 00 45 00 00 00 03 00 C9 00 00 02 00 45 00 00 01 03 00 C0 1E 00 03 00 45 00 00' - '02 03 00 00 03 00 BE 1E 00 03 00 45 00 00 02 03 00 01 03 00 C4 1E 00 03 00 45 00 00 02 03 00 03' - '03 00 C2 1E 00 03 00 45 00 00 02 03 00 09 03 00 CA 00 00 02 00 45 00 00 02 03 00 BC 1E 00 02 00' - '45 00 00 03 03 00 14 1E 00 03 00 45 00 00 04 03 00 00 03 00 16 1E 00 03 00 45 00 00 04 03 00 01' - '03 00 12 01 00 02 00 45 00 00 04 03 00 14 01 00 02 00 45 00 00 06 03 00 16 01 00 02 00 45 00 00' - '07 03 00 CB 00 00 02 00 45 00 00 08 03 00 BA 1E 00 02 00 45 00 00 09 03 00 1A 01 00 02 00 45 00' - '00 0C 03 00 04 02 00 02 00 45 00 00 0F 03 00 06 02 00 02 00 45 00 00 11 03 00 C6 1E 00 03 00 45' - '00 00 23 03 00 02 03 00 B8 1E 00 02 00 45 00 00 23 03 00 1C 1E 00 03 00 45 00 00 27 03 00 06 03' - '00 28 02 00 02 00 45 00 00 27 03 00 18 01 00 02 00 45 00 00 28 03 00 18 1E 00 02 00 45 00 00 2D' - '03 00 1A 1E 00 02 00 45 00 00 30 03 00 31 1D 00 01 08 45 00 00 08 D5 01 01 01 45 00 00 D8 D5 01' - '01 01 45 00 00 0C D6 01 01 01 45 00 00 D4 D4 01 01 01 45 00 00 04 D4 01 01 01 45 00 00 3C D5 01' - '01 01 45 00 00 34 F1 01 01 0E 45 00 00 74 D6 01 01 01 45 00 00 38 D4 01 01 01 45 00 00 6C D4 01' - '01 01 45 00 00 A4 D5 01 01 01 45 00 00 BA 24 00 01 07 45 00 00 30 21 00 01 01 45 00 00 70 D5 01' - '01 01 45 00 00 40 D6 01 01 01 45 00 00 25 FF 00 01 0B 45 00 00 3B 21 00 03 10 46 00 00 41 00 00' - '58 00 00 1E 1E 00 02 00 46 00 00 07 03 00 3D D5 01 01 01 46 00 00 26 FF 00 01 0B 46 00 00 39 D4' - '01 01 01 46 00 00 71 D5 01 01 01 46 00 00 05 D4 01 01 01 46 00 00 0D D6 01 01 01 46 00 00 A5 D5' - '01 01 01 46 00 00 BB 24 00 01 07 46 00 00 D5 D4 01 01 01 46 00 00 41 D6 01 01 01 46 00 00 6D D4' - '01 01 01 46 00 00 31 21 00 01 01 46 00 00 35 F1 01 01 0E 46 00 00 D9 D5 01 01 01 46 00 00 75 D6' - '01 01 01 46 00 00 09 D5 01 01 01 46 00 00 87 33 00 02 0E 47 00 00 42 00 00 93 33 00 03 0E 47 00' - '00 48 00 00 7A 00 00 AC 33 00 03 0E 47 00 00 50 00 00 61 00 00 C9 33 00 02 0E 47 00 00 79 00 00' - 'F4 01 00 02 00 47 00 00 01 03 00 1C 01 00 02 00 47 00 00 02 03 00 20 1E 00 02 00 47 00 00 04 03' - '00 1E 01 00 02 00 47 00 00 06 03 00 20 01 00 02 00 47 00 00 07 03 00 E6 01 00 02 00 47 00 00 0C' - '03 00 22 01 00 02 00 47 00 00 27 03 00 72 D5 01 01 01 47 00 00 76 D6 01 01 01 47 00 00 BC 24 00' - '01 07 47 00 00 DA D5 01 01 01 47 00 00 3A D4 01 01 01 47 00 00 A2 D4 01 01 01 47 00 00 6E D4 01' - '01 01 47 00 00 A6 D5 01 01 01 47 00 00 27 FF 00 01 0B 47 00 00 42 D6 01 01 01 47 00 00 36 F1 01' - '01 0E 47 00 00 0E D6 01 01 01 47 00 00 D6 D4 01 01 01 47 00 00 3E D5 01 01 01 47 00 00 0A D5 01' - '01 01 47 00 00 06 D4 01 01 01 47 00 00 33 1D 00 01 08 47 00 00 CB 33 00 02 0E 48 00 00 50 00 00' - '4A F1 01 02 0E 48 00 00 56 00 00 CC 32 00 02 0E 48 00 00 67 00 00 90 33 00 02 0E 48 00 00 7A 00' - '00 24 01 00 02 00 48 00 00 02 03 00 22 1E 00 02 00 48 00 00 07 03 00 26 1E 00 02 00 48 00 00 08' - '03 00 1E 02 00 02 00 48 00 00 0C 03 00 24 1E 00 02 00 48 00 00 23 03 00 28 1E 00 02 00 48 00 00' - '27 03 00 2A 1E 00 02 00 48 00 00 2E 03 00 DB D5 01 01 01 48 00 00 3B D4 01 01 01 48 00 00 0C 21' - '00 01 01 48 00 00 0B 21 00 01 01 48 00 00 28 FF 00 01 0B 48 00 00 0D 21 00 01 01 48 00 00 BD 24' - '00 01 07 48 00 00 0F D6 01 01 01 48 00 00 6F D4 01 01 01 48 00 00 73 D5 01 01 01 48 00 00 07 D4' - '01 01 01 48 00 00 37 F1 01 01 0E 48 00 00 D7 D4 01 01 01 48 00 00 43 D6 01 01 01 48 00 00 A7 D5' - '01 01 01 48 00 00 34 1D 00 01 08 48 00 00 77 D6 01 01 01 48 00 00 62 21 00 03 10 49 00 00 49 00' - '00 49 00 00 61 21 00 02 10 49 00 00 49 00 00 32 01 00 02 10 49 00 00 4A 00 00 7A 33 00 02 0E 49' - '00 00 55 00 00 63 21 00 02 10 49 00 00 56 00 00 68 21 00 02 10 49 00 00 58 00 00 CC 00 00 02 00' - '49 00 00 00 03 00 CD 00 00 02 00 49 00 00 01 03 00 CE 00 00 02 00 49 00 00 02 03 00 28 01 00 02' - '00 49 00 00 03 03 00 2A 01 00 02 00 49 00 00 04 03 00 2C 01 00 02 00 49 00 00 06 03 00 30 01 00' - '02 00 49 00 00 07 03 00 2E 1E 00 03 00 49 00 00 08 03 00 01 03 00 CF 00 00 02 00 49 00 00 08 03' - '00 C8 1E 00 02 00 49 00 00 09 03 00 CF 01 00 02 00 49 00 00 0C 03 00 08 02 00 02 00 49 00 00 0F' - '03 00 0A 02 00 02 00 49 00 00 11 03 00 CA 1E 00 02 00 49 00 00 23 03 00 2E 01 00 02 00 49 00 00' - '28 03 00 2C 1E 00 02 00 49 00 00 30 03 00 60 21 00 01 10 49 00 00 D8 D4 01 01 01 49 00 00 29 FF' - '00 01 0B 49 00 00 35 1D 00 01 08 49 00 00 78 D6 01 01 01 49 00 00 08 D4 01 01 01 49 00 00 74 D5' - '01 01 01 49 00 00 BE 24 00 01 07 49 00 00 DC D5 01 01 01 49 00 00 10 21 00 01 01 49 00 00 11 21' - '00 01 01 49 00 00 40 D5 01 01 01 49 00 00 70 D4 01 01 01 49 00 00 3C D4 01 01 01 49 00 00 44 D6' - '01 01 01 49 00 00 10 D6 01 01 01 49 00 00 A8 D5 01 01 01 49 00 00 38 F1 01 01 0E 49 00 00 34 01' - '00 02 00 4A 00 00 02 03 00 71 D4 01 01 01 4A 00 00 79 D6 01 01 01 4A 00 00 BF 24 00 01 07 4A 00' - '00 75 D5 01 01 01 4A 00 00 39 F1 01 01 0E 4A 00 00 45 D6 01 01 01 4A 00 00 41 D5 01 01 01 4A 00' - '00 0D D5 01 01 01 4A 00 00 D9 D4 01 01 01 4A 00 00 36 1D 00 01 08 4A 00 00 DD D5 01 01 01 4A 00' - '00 11 D6 01 01 01 4A 00 00 09 D4 01 01 01 4A 00 00 2A FF 00 01 0B 4A 00 00 A9 D5 01 01 01 4A 00' - '00 A5 D4 01 01 01 4A 00 00 3D D4 01 01 01 4A 00 00 85 33 00 02 0E 4B 00 00 42 00 00 CD 33 00 02' - '0E 4B 00 00 4B 00 00 CE 33 00 02 0E 4B 00 00 4D 00 00 30 1E 00 02 00 4B 00 00 01 03 00 E8 01 00' - '02 00 4B 00 00 0C 03 00 32 1E 00 02 00 4B 00 00 23 03 00 36 01 00 02 00 4B 00 00 27 03 00 34 1E' - '00 02 00 4B 00 00 31 03 00 0A D4 01 01 01 4B 00 00 A6 D4 01 01 01 4B 00 00 C0 24 00 01 07 4B 00' - '00 12 D6 01 01 01 4B 00 00 76 D5 01 01 01 4B 00 00 0E D5 01 01 01 4B 00 00 42 D5 01 01 01 4B 00' - '00 3E D4 01 01 01 4B 00 00 46 D6 01 01 01 4B 00 00 3A F1 01 01 0E 4B 00 00 37 1D 00 01 08 4B 00' - '00 AA D5 01 01 01 4B 00 00 DA D4 01 01 01 4B 00 00 DE D5 01 01 01 4B 00 00 7A D6 01 01 01 4B 00' - '00 72 D4 01 01 01 4B 00 00 2B FF 00 01 0B 4B 00 00 C7 01 00 02 10 4C 00 00 4A 00 00 CF 32 00 03' - '0E 4C 00 00 54 00 00 44 00 00 C8 01 00 02 10 4C 00 00 6A 00 00 3F 01 00 02 10 4C 00 00 B7 00 00' - '39 01 00 02 00 4C 00 00 01 03 00 3D 01 00 02 00 4C 00 00 0C 03 00 38 1E 00 03 00 4C 00 00 23 03' - '00 04 03 00 36 1E 00 02 00 4C 00 00 23 03 00 3B 01 00 02 00 4C 00 00 27 03 00 3C 1E 00 02 00 4C' - '00 00 2D 03 00 3A 1E 00 02 00 4C 00 00 31 03 00 6C 21 00 01 10 4C 00 00 0F D5 01 01 01 4C 00 00' - 'DB D4 01 01 01 4C 00 00 77 D5 01 01 01 4C 00 00 3F D4 01 01 01 4C 00 00 AB D5 01 01 01 4C 00 00' - '3B F1 01 01 0E 4C 00 00 73 D4 01 01 01 4C 00 00 12 21 00 01 01 4C 00 00 C1 24 00 01 07 4C 00 00' - '47 D6 01 01 01 4C 00 00 43 D5 01 01 01 4C 00 00 2C FF 00 01 0B 4C 00 00 0B D4 01 01 01 4C 00 00' - '38 1D 00 01 08 4C 00 00 13 D6 01 01 01 4C 00 00 7B D6 01 01 01 4C 00 00 DF D5 01 01 01 4C 00 00' - '86 33 00 02 0E 4D 00 00 42 00 00 6A F1 01 02 08 4D 00 00 43 00 00 6B F1 01 02 08 4D 00 00 44 00' - '00 92 33 00 03 0E 4D 00 00 48 00 00 7A 00 00 AB 33 00 03 0E 4D 00 00 50 00 00 61 00 00 6C F1 01' - '02 08 4D 00 00 52 00 00 4B F1 01 02 0E 4D 00 00 56 00 00 B9 33 00 02 0E 4D 00 00 56 00 00 BF 33' - '00 02 0E 4D 00 00 57 00 00 3E 1E 00 02 00 4D 00 00 01 03 00 40 1E 00 02 00 4D 00 00 07 03 00 42' - '1E 00 02 00 4D 00 00 23 03 00 C1 33 00 02 0E 4D 00 00 A9 03 00 44 D5 01 01 01 4D 00 00 C2 24 00' - '01 07 4D 00 00 74 D4 01 01 01 4D 00 00 0C D4 01 01 01 4D 00 00 6F 21 00 01 10 4D 00 00 33 21 00' - '01 01 4D 00 00 40 D4 01 01 01 4D 00 00 AC D5 01 01 01 4D 00 00 E0 D5 01 01 01 4D 00 00 10 D5 01' - '01 01 4D 00 00 7C D6 01 01 01 4D 00 00 3C F1 01 01 0E 4D 00 00 2D FF 00 01 0B 4D 00 00 DC D4 01' - '01 01 4D 00 00 48 D6 01 01 01 4D 00 00 39 1D 00 01 08 4D 00 00 78 D5 01 01 01 4D 00 00 14 D6 01' - '01 01 4D 00 00 CA 01 00 02 10 4E 00 00 4A 00 00 CB 01 00 02 10 4E 00 00 6A 00 00 16 21 00 02 10' - '4E 00 00 6F 00 00 F8 01 00 02 00 4E 00 00 00 03 00 43 01 00 02 00 4E 00 00 01 03 00 D1 00 00 02' - '00 4E 00 00 03 03 00 44 1E 00 02 00 4E 00 00 07 03 00 47 01 00 02 00 4E 00 00 0C 03 00 46 1E 00' - '02 00 4E 00 00 23 03 00 45 01 00 02 00 4E 00 00 27 03 00 4A 1E 00 02 00 4E 00 00 2D 03 00 48 1E' - '00 02 00 4E 00 00 31 03 00 2E FF 00 01 0B 4E 00 00 C3 24 00 01 07 4E 00 00 41 D4 01 01 01 4E 00' - '00 79 D5 01 01 01 4E 00 00 A9 D4 01 01 01 4E 00 00 7D D6 01 01 01 4E 00 00 15 D6 01 01 01 4E 00' - '00 AD D5 01 01 01 4E 00 00 DD D4 01 01 01 4E 00 00 0D D4 01 01 01 4E 00 00 75 D4 01 01 01 4E 00' - '00 49 D6 01 01 01 4E 00 00 E1 D5 01 01 01 4E 00 00 3A 1D 00 01 08 4E 00 00 3D F1 01 01 0E 4E 00' - '00 11 D5 01 01 01 4E 00 00 15 21 00 01 01 4E 00 00 D2 00 00 02 00 4F 00 00 00 03 00 D3 00 00 02' - '00 4F 00 00 01 03 00 D2 1E 00 03 00 4F 00 00 02 03 00 00 03 00 D0 1E 00 03 00 4F 00 00 02 03 00' - '01 03 00 D6 1E 00 03 00 4F 00 00 02 03 00 03 03 00 D4 1E 00 03 00 4F 00 00 02 03 00 09 03 00 D4' - '00 00 02 00 4F 00 00 02 03 00 4C 1E 00 03 00 4F 00 00 03 03 00 01 03 00 2C 02 00 03 00 4F 00 00' - '03 03 00 04 03 00 4E 1E 00 03 00 4F 00 00 03 03 00 08 03 00 D5 00 00 02 00 4F 00 00 03 03 00 50' - '1E 00 03 00 4F 00 00 04 03 00 00 03 00 52 1E 00 03 00 4F 00 00 04 03 00 01 03 00 4C 01 00 02 00' - '4F 00 00 04 03 00 4E 01 00 02 00 4F 00 00 06 03 00 30 02 00 03 00 4F 00 00 07 03 00 04 03 00 2E' - '02 00 02 00 4F 00 00 07 03 00 2A 02 00 03 00 4F 00 00 08 03 00 04 03 00 D6 00 00 02 00 4F 00 00' - '08 03 00 CE 1E 00 02 00 4F 00 00 09 03 00 50 01 00 02 00 4F 00 00 0B 03 00 D1 01 00 02 00 4F 00' - '00 0C 03 00 0C 02 00 02 00 4F 00 00 0F 03 00 0E 02 00 02 00 4F 00 00 11 03 00 DC 1E 00 03 00 4F' - '00 00 1B 03 00 00 03 00 DA 1E 00 03 00 4F 00 00 1B 03 00 01 03 00 E0 1E 00 03 00 4F 00 00 1B 03' - '00 03 03 00 DE 1E 00 03 00 4F 00 00 1B 03 00 09 03 00 E2 1E 00 03 00 4F 00 00 1B 03 00 23 03 00' - 'A0 01 00 02 00 4F 00 00 1B 03 00 D8 1E 00 03 00 4F 00 00 23 03 00 02 03 00 CC 1E 00 02 00 4F 00' - '00 23 03 00 EC 01 00 03 00 4F 00 00 28 03 00 04 03 00 EA 01 00 02 00 4F 00 00 28 03 00 42 D4 01' - '01 01 4F 00 00 16 D6 01 01 01 4F 00 00 2F FF 00 01 0B 4F 00 00 4A D6 01 01 01 4F 00 00 46 D5 01' - '01 01 4F 00 00 7A D5 01 01 01 4F 00 00 12 D5 01 01 01 4F 00 00 3C 1D 00 01 08 4F 00 00 C4 24 00' - '01 07 4F 00 00 76 D4 01 01 01 4F 00 00 E2 D5 01 01 01 4F 00 00 0E D4 01 01 01 4F 00 00 AA D4 01' - '01 01 4F 00 00 3E F1 01 01 0E 4F 00 00 7E D6 01 01 01 4F 00 00 DE D4 01 01 01 4F 00 00 AE D5 01' - '01 01 4F 00 00 D7 33 00 02 0E 50 00 00 48 00 00 D9 33 00 03 0E 50 00 00 50 00 00 4D 00 00 4E F1' - '01 03 0E 50 00 00 50 00 00 56 00 00 DA 33 00 02 0E 50 00 00 52 00 00 50 32 00 03 0E 50 00 00 54' - '00 00 45 00 00 A9 33 00 02 0E 50 00 00 61 00 00 54 1E 00 02 00 50 00 00 01 03 00 56 1E 00 02 00' - '50 00 00 07 03 00 30 FF 00 01 0B 50 00 00 C5 24 00 01 07 50 00 00 7B D5 01 01 01 50 00 00 7F D6' - '01 01 01 50 00 00 3F F1 01 01 0E 50 00 00 DF D4 01 01 01 50 00 00 AF D5 01 01 01 50 00 00 AB D4' - '01 01 01 50 00 00 3E 1D 00 01 08 50 00 00 13 D5 01 01 01 50 00 00 4B D6 01 01 01 50 00 00 77 D4' - '01 01 01 50 00 00 43 D4 01 01 01 50 00 00 19 21 00 01 01 50 00 00 E3 D5 01 01 01 50 00 00 17 D6' - '01 01 01 50 00 00 0F D4 01 01 01 50 00 00 1A 21 00 01 01 51 00 00 78 D4 01 01 01 51 00 00 80 D6' - '01 01 01 51 00 00 18 D6 01 01 01 51 00 00 4C D6 01 01 01 51 00 00 E0 D4 01 01 01 51 00 00 7C D5' - '01 01 01 51 00 00 10 D4 01 01 01 51 00 00 C6 24 00 01 07 51 00 00 14 D5 01 01 01 51 00 00 E4 D5' - '01 01 01 51 00 00 44 D4 01 01 01 51 00 00 40 F1 01 01 0E 51 00 00 B0 D5 01 01 01 51 00 00 31 FF' - '00 01 0B 51 00 00 AC D4 01 01 01 51 00 00 A8 20 00 02 10 52 00 00 73 00 00 54 01 00 02 00 52 00' - '00 01 03 00 58 1E 00 02 00 52 00 00 07 03 00 58 01 00 02 00 52 00 00 0C 03 00 10 02 00 02 00 52' - '00 00 0F 03 00 12 02 00 02 00 52 00 00 11 03 00 5C 1E 00 03 00 52 00 00 23 03 00 04 03 00 5A 1E' - '00 02 00 52 00 00 23 03 00 56 01 00 02 00 52 00 00 27 03 00 5E 1E 00 02 00 52 00 00 31 03 00 4D' - 'D6 01 01 01 52 00 00 32 FF 00 01 0B 52 00 00 45 D4 01 01 01 52 00 00 2C F1 01 01 07 52 00 00 41' - 'F1 01 01 0E 52 00 00 B1 D5 01 01 01 52 00 00 7D D5 01 01 01 52 00 00 1B 21 00 01 01 52 00 00 19' - 'D6 01 01 01 52 00 00 1D 21 00 01 01 52 00 00 1C 21 00 01 01 52 00 00 C7 24 00 01 07 52 00 00 3F' - '1D 00 01 08 52 00 00 11 D4 01 01 01 52 00 00 E5 D5 01 01 01 52 00 00 81 D6 01 01 01 52 00 00 79' - 'D4 01 01 01 52 00 00 E1 D4 01 01 01 52 00 00 4C F1 01 02 0E 53 00 00 44 00 00 20 21 00 02 08 53' - '00 00 4D 00 00 4D F1 01 02 0E 53 00 00 53 00 00 DC 33 00 02 0E 53 00 00 76 00 00 64 1E 00 03 00' - '53 00 00 01 03 00 07 03 00 5A 01 00 02 00 53 00 00 01 03 00 5C 01 00 02 00 53 00 00 02 03 00 60' - '1E 00 02 00 53 00 00 07 03 00 66 1E 00 03 00 53 00 00 0C 03 00 07 03 00 60 01 00 02 00 53 00 00' - '0C 03 00 68 1E 00 03 00 53 00 00 23 03 00 07 03 00 62 1E 00 02 00 53 00 00 23 03 00 18 02 00 02' - '00 53 00 00 26 03 00 5E 01 00 02 00 53 00 00 27 03 00 1A D6 01 01 01 53 00 00 4A D5 01 01 01 53' - '00 00 7A D4 01 01 01 53 00 00 AE D4 01 01 01 53 00 00 E6 D5 01 01 01 53 00 00 C8 24 00 01 07 53' - '00 00 7E D5 01 01 01 53 00 00 82 D6 01 01 01 53 00 00 B2 D5 01 01 01 53 00 00 42 F1 01 01 0E 53' - '00 00 46 D4 01 01 01 53 00 00 E2 D4 01 01 01 53 00 00 16 D5 01 01 01 53 00 00 12 D4 01 01 01 53' - '00 00 4E D6 01 01 01 53 00 00 33 FF 00 01 0B 53 00 00 21 21 00 03 10 54 00 00 45 00 00 4C 00 00' - '94 33 00 03 0E 54 00 00 48 00 00 7A 00 00 22 21 00 02 08 54 00 00 4D 00 00 6A 1E 00 02 00 54 00' - '00 07 03 00 64 01 00 02 00 54 00 00 0C 03 00 6C 1E 00 02 00 54 00 00 23 03 00 1A 02 00 02 00 54' - '00 00 26 03 00 62 01 00 02 00 54 00 00 27 03 00 70 1E 00 02 00 54 00 00 2D 03 00 6E 1E 00 02 00' - '54 00 00 31 03 00 C9 24 00 01 07 54 00 00 E3 D4 01 01 01 54 00 00 1B D6 01 01 01 54 00 00 17 D5' - '01 01 01 54 00 00 4B D5 01 01 01 54 00 00 83 D6 01 01 01 54 00 00 13 D4 01 01 01 54 00 00 4F D6' - '01 01 01 54 00 00 43 F1 01 01 0E 54 00 00 7B D4 01 01 01 54 00 00 7F D5 01 01 01 54 00 00 E7 D5' - '01 01 01 54 00 00 AF D4 01 01 01 54 00 00 47 D4 01 01 01 54 00 00 40 1D 00 01 08 54 00 00 B3 D5' - '01 01 01 54 00 00 34 FF 00 01 0B 54 00 00 D9 00 00 02 00 55 00 00 00 03 00 DA 00 00 02 00 55 00' - '00 01 03 00 DB 00 00 02 00 55 00 00 02 03 00 78 1E 00 03 00 55 00 00 03 03 00 01 03 00 68 01 00' - '02 00 55 00 00 03 03 00 7A 1E 00 03 00 55 00 00 04 03 00 08 03 00 6A 01 00 02 00 55 00 00 04 03' - '00 6C 01 00 02 00 55 00 00 06 03 00 DB 01 00 03 00 55 00 00 08 03 00 00 03 00 D7 01 00 03 00 55' - '00 00 08 03 00 01 03 00 D5 01 00 03 00 55 00 00 08 03 00 04 03 00 D9 01 00 03 00 55 00 00 08 03' - '00 0C 03 00 DC 00 00 02 00 55 00 00 08 03 00 E6 1E 00 02 00 55 00 00 09 03 00 6E 01 00 02 00 55' - '00 00 0A 03 00 70 01 00 02 00 55 00 00 0B 03 00 D3 01 00 02 00 55 00 00 0C 03 00 14 02 00 02 00' - '55 00 00 0F 03 00 16 02 00 02 00 55 00 00 11 03 00 EA 1E 00 03 00 55 00 00 1B 03 00 00 03 00 E8' - '1E 00 03 00 55 00 00 1B 03 00 01 03 00 EE 1E 00 03 00 55 00 00 1B 03 00 03 03 00 EC 1E 00 03 00' - '55 00 00 1B 03 00 09 03 00 F0 1E 00 03 00 55 00 00 1B 03 00 23 03 00 AF 01 00 02 00 55 00 00 1B' - '03 00 E4 1E 00 02 00 55 00 00 23 03 00 72 1E 00 02 00 55 00 00 24 03 00 72 01 00 02 00 55 00 00' - '28 03 00 76 1E 00 02 00 55 00 00 2D 03 00 74 1E 00 02 00 55 00 00 30 03 00 E8 D5 01 01 01 55 00' - '00 CA 24 00 01 07 55 00 00 14 D4 01 01 01 55 00 00 4C D5 01 01 01 55 00 00 44 F1 01 01 0E 55 00' - '00 50 D6 01 01 01 55 00 00 41 1D 00 01 08 55 00 00 48 D4 01 01 01 55 00 00 80 D5 01 01 01 55 00' - '00 B4 D5 01 01 01 55 00 00 35 FF 00 01 0B 55 00 00 B0 D4 01 01 01 55 00 00 7C D4 01 01 01 55 00' - '00 1C D6 01 01 01 55 00 00 84 D6 01 01 01 55 00 00 18 D5 01 01 01 55 00 00 E4 D4 01 01 01 55 00' - '00 67 21 00 04 10 56 00 00 49 00 00 49 00 00 49 00 00 66 21 00 03 10 56 00 00 49 00 00 49 00 00' - '65 21 00 02 10 56 00 00 49 00 00 7C 1E 00 02 00 56 00 00 03 03 00 7E 1E 00 02 00 56 00 00 23 03' - '00 DE 33 00 03 0E 56 00 00 15 22 00 6D 00 00 CB 24 00 01 07 56 00 00 B1 D4 01 01 01 56 00 00 45' - 'F1 01 01 0E 56 00 00 E5 D4 01 01 01 56 00 00 85 D6 01 01 01 56 00 00 81 D5 01 01 01 56 00 00 51' - 'D6 01 01 01 56 00 00 64 21 00 01 10 56 00 00 36 FF 00 01 0B 56 00 00 1D D6 01 01 01 56 00 00 7D' - '2C 00 01 08 56 00 00 7D D4 01 01 01 56 00 00 49 D4 01 01 01 56 00 00 B5 D5 01 01 01 56 00 00 19' - 'D5 01 01 01 56 00 00 15 D4 01 01 01 56 00 00 4D D5 01 01 01 56 00 00 E9 D5 01 01 01 56 00 00 4F' - 'F1 01 02 0E 57 00 00 43 00 00 2E F1 01 02 07 57 00 00 5A 00 00 DD 33 00 02 0E 57 00 00 62 00 00' - '80 1E 00 02 00 57 00 00 00 03 00 82 1E 00 02 00 57 00 00 01 03 00 74 01 00 02 00 57 00 00 02 03' - '00 86 1E 00 02 00 57 00 00 07 03 00 84 1E 00 02 00 57 00 00 08 03 00 88 1E 00 02 00 57 00 00 23' - '03 00 42 1D 00 01 08 57 00 00 7E D4 01 01 01 57 00 00 CC 24 00 01 07 57 00 00 B6 D5 01 01 01 57' - '00 00 4A D4 01 01 01 57 00 00 B2 D4 01 01 01 57 00 00 46 F1 01 01 0E 57 00 00 E6 D4 01 01 01 57' - '00 00 1E D6 01 01 01 57 00 00 86 D6 01 01 01 57 00 00 82 D5 01 01 01 57 00 00 EA D5 01 01 01 57' - '00 00 52 D6 01 01 01 57 00 00 1A D5 01 01 01 57 00 00 4E D5 01 01 01 57 00 00 37 FF 00 01 0B 57' - '00 00 16 D4 01 01 01 57 00 00 6B 21 00 03 10 58 00 00 49 00 00 49 00 00 6A 21 00 02 10 58 00 00' - '49 00 00 8A 1E 00 02 00 58 00 00 07 03 00 8C 1E 00 02 00 58 00 00 08 03 00 47 F1 01 01 0E 58 00' - '00 4F D5 01 01 01 58 00 00 1F D6 01 01 01 58 00 00 7F D4 01 01 01 58 00 00 B3 D4 01 01 01 58 00' - '00 38 FF 00 01 0B 58 00 00 B7 D5 01 01 01 58 00 00 83 D5 01 01 01 58 00 00 E7 D4 01 01 01 58 00' - '00 CD 24 00 01 07 58 00 00 53 D6 01 01 01 58 00 00 87 D6 01 01 01 58 00 00 69 21 00 01 10 58 00' - '00 4B D4 01 01 01 58 00 00 1B D5 01 01 01 58 00 00 EB D5 01 01 01 58 00 00 17 D4 01 01 01 58 00' - '00 F2 1E 00 02 00 59 00 00 00 03 00 DD 00 00 02 00 59 00 00 01 03 00 76 01 00 02 00 59 00 00 02' - '03 00 F8 1E 00 02 00 59 00 00 03 03 00 32 02 00 02 00 59 00 00 04 03 00 8E 1E 00 02 00 59 00 00' - '07 03 00 78 01 00 02 00 59 00 00 08 03 00 F6 1E 00 02 00 59 00 00 09 03 00 F4 1E 00 02 00 59 00' - '00 23 03 00 80 D4 01 01 01 59 00 00 20 D6 01 01 01 59 00 00 CE 24 00 01 07 59 00 00 B4 D4 01 01' - '01 59 00 00 4C D4 01 01 01 59 00 00 88 D6 01 01 01 59 00 00 18 D4 01 01 01 59 00 00 50 D5 01 01' - '01 59 00 00 39 FF 00 01 0B 59 00 00 1C D5 01 01 01 59 00 00 B8 D5 01 01 01 59 00 00 54 D6 01 01' - '01 59 00 00 EC D5 01 01 01 59 00 00 84 D5 01 01 01 59 00 00 48 F1 01 01 0E 59 00 00 E8 D4 01 01' - '01 59 00 00 79 01 00 02 00 5A 00 00 01 03 00 90 1E 00 02 00 5A 00 00 02 03 00 7B 01 00 02 00 5A' - '00 00 07 03 00 7D 01 00 02 00 5A 00 00 0C 03 00 92 1E 00 02 00 5A 00 00 23 03 00 94 1E 00 02 00' - '5A 00 00 31 03 00 19 D4 01 01 01 5A 00 00 89 D6 01 01 01 5A 00 00 3A FF 00 01 0B 5A 00 00 ED D5' - '01 01 01 5A 00 00 21 D6 01 01 01 5A 00 00 81 D4 01 01 01 5A 00 00 B5 D4 01 01 01 5A 00 00 CF 24' - '00 01 07 5A 00 00 49 F1 01 01 0E 5A 00 00 E9 D4 01 01 01 5A 00 00 85 D5 01 01 01 5A 00 00 55 D6' - '01 01 01 5A 00 00 28 21 00 01 01 5A 00 00 24 21 00 01 01 5A 00 00 B9 D5 01 01 01 5A 00 00 4D D4' - '01 01 01 5A 00 00 3B FF 00 01 0B 5B 00 00 47 FE 00 01 0A 5B 00 00 3C FF 00 01 0B 5C 00 00 68 FE' - '00 01 0D 5C 00 00 3D FF 00 01 0B 5D 00 00 48 FE 00 01 0A 5D 00 00 3E FF 00 01 0B 5E 00 00 4D FE' - '00 01 10 5F 00 00 4E FE 00 01 10 5F 00 00 4F FE 00 01 10 5F 00 00 34 FE 00 01 0A 5F 00 00 33 FE' - '00 01 0A 5F 00 00 3F FF 00 01 0B 5F 00 00 40 FF 00 01 0B 60 00 00 C2 33 00 04 0E 61 00 00 2E 00' - '00 6D 00 00 2E 00 00 00 21 00 03 10 61 00 00 2F 00 00 63 00 00 01 21 00 03 10 61 00 00 2F 00 00' - '73 00 00 9A 1E 00 02 10 61 00 00 BE 02 00 E0 00 00 02 00 61 00 00 00 03 00 E1 00 00 02 00 61 00' - '00 01 03 00 A7 1E 00 03 00 61 00 00 02 03 00 00 03 00 A5 1E 00 03 00 61 00 00 02 03 00 01 03 00' - 'AB 1E 00 03 00 61 00 00 02 03 00 03 03 00 A9 1E 00 03 00 61 00 00 02 03 00 09 03 00 E2 00 00 02' - '00 61 00 00 02 03 00 E3 00 00 02 00 61 00 00 03 03 00 01 01 00 02 00 61 00 00 04 03 00 B1 1E 00' - '03 00 61 00 00 06 03 00 00 03 00 AF 1E 00 03 00 61 00 00 06 03 00 01 03 00 B5 1E 00 03 00 61 00' - '00 06 03 00 03 03 00 B3 1E 00 03 00 61 00 00 06 03 00 09 03 00 03 01 00 02 00 61 00 00 06 03 00' - 'E1 01 00 03 00 61 00 00 07 03 00 04 03 00 27 02 00 02 00 61 00 00 07 03 00 DF 01 00 03 00 61 00' - '00 08 03 00 04 03 00 E4 00 00 02 00 61 00 00 08 03 00 A3 1E 00 02 00 61 00 00 09 03 00 FB 01 00' - '03 00 61 00 00 0A 03 00 01 03 00 E5 00 00 02 00 61 00 00 0A 03 00 CE 01 00 02 00 61 00 00 0C 03' - '00 01 02 00 02 00 61 00 00 0F 03 00 03 02 00 02 00 61 00 00 11 03 00 AD 1E 00 03 00 61 00 00 23' - '03 00 02 03 00 B7 1E 00 03 00 61 00 00 23 03 00 06 03 00 A1 1E 00 02 00 61 00 00 23 03 00 01 1E' - '00 02 00 61 00 00 25 03 00 05 01 00 02 00 61 00 00 28 03 00 22 D6 01 01 01 61 00 00 4E D4 01 01' - '01 61 00 00 86 D5 01 01 01 61 00 00 D0 24 00 01 07 61 00 00 1A D4 01 01 01 61 00 00 EE D5 01 01' - '01 61 00 00 1E D5 01 01 01 61 00 00 EA D4 01 01 01 61 00 00 B6 D4 01 01 01 61 00 00 43 1D 00 01' - '08 61 00 00 41 FF 00 01 0B 61 00 00 82 D4 01 01 01 61 00 00 52 D5 01 01 01 61 00 00 8A D6 01 01' - '01 61 00 00 90 20 00 01 09 61 00 00 BA D5 01 01 01 61 00 00 56 D6 01 01 01 61 00 00 AA 00 00 01' - '08 61 00 00 74 33 00 03 0E 62 00 00 61 00 00 72 00 00 03 1E 00 02 00 62 00 00 07 03 00 05 1E 00' - '02 00 62 00 00 23 03 00 07 1E 00 02 00 62 00 00 31 03 00 87 D5 01 01 01 62 00 00 EF D5 01 01 01' - '62 00 00 8B D6 01 01 01 62 00 00 42 FF 00 01 0B 62 00 00 4F D4 01 01 01 62 00 00 83 D4 01 01 01' - '62 00 00 1F D5 01 01 01 62 00 00 23 D6 01 01 01 62 00 00 B7 D4 01 01 01 62 00 00 57 D6 01 01 01' - '62 00 00 53 D5 01 01 01 62 00 00 D1 24 00 01 07 62 00 00 EB D4 01 01 01 62 00 00 47 1D 00 01 08' - '62 00 00 BB D5 01 01 01 62 00 00 1B D4 01 01 01 62 00 00 05 21 00 03 10 63 00 00 2F 00 00 6F 00' - '00 06 21 00 03 10 63 00 00 2F 00 00 75 00 00 88 33 00 03 0E 63 00 00 61 00 00 6C 00 00 C4 33 00' - '02 0E 63 00 00 63 00 00 C5 33 00 02 0E 63 00 00 64 00 00 A0 33 00 03 0E 63 00 00 6D 00 00 32 00' - '00 A4 33 00 03 0E 63 00 00 6D 00 00 33 00 00 9D 33 00 02 0E 63 00 00 6D 00 00 07 01 00 02 00 63' - '00 00 01 03 00 09 01 00 02 00 63 00 00 02 03 00 0B 01 00 02 00 63 00 00 07 03 00 0D 01 00 02 00' - '63 00 00 0C 03 00 09 1E 00 03 00 63 00 00 27 03 00 01 03 00 E7 00 00 02 00 63 00 00 27 03 00 BC' - 'D5 01 01 01 63 00 00 84 D4 01 01 01 63 00 00 54 D5 01 01 01 63 00 00 43 FF 00 01 0B 63 00 00 D2' - '24 00 01 07 63 00 00 F0 D5 01 01 01 63 00 00 7D 21 00 01 10 63 00 00 20 D5 01 01 01 63 00 00 88' - 'D5 01 01 01 63 00 00 9C 1D 00 01 08 63 00 00 58 D6 01 01 01 63 00 00 EC D4 01 01 01 63 00 00 1C' - 'D4 01 01 01 63 00 00 B8 D4 01 01 01 63 00 00 24 D6 01 01 01 63 00 00 50 D4 01 01 01 63 00 00 8C' - 'D6 01 01 01 63 00 00 C8 33 00 02 0E 64 00 00 42 00 00 72 33 00 02 0E 64 00 00 61 00 00 97 33 00' - '02 0E 64 00 00 6C 00 00 78 33 00 03 0E 64 00 00 6D 00 00 32 00 00 79 33 00 03 0E 64 00 00 6D 00' - '00 33 00 00 77 33 00 02 0E 64 00 00 6D 00 00 C6 01 00 03 10 64 00 00 7A 00 00 0C 03 00 F3 01 00' - '02 10 64 00 00 7A 00 00 0B 1E 00 02 00 64 00 00 07 03 00 0F 01 00 02 00 64 00 00 0C 03 00 0D 1E' - '00 02 00 64 00 00 23 03 00 11 1E 00 02 00 64 00 00 27 03 00 13 1E 00 02 00 64 00 00 2D 03 00 0F' - '1E 00 02 00 64 00 00 31 03 00 7E 21 00 01 10 64 00 00 8D D6 01 01 01 64 00 00 F1 D5 01 01 01 64' - '00 00 B9 D4 01 01 01 64 00 00 1D D4 01 01 01 64 00 00 BD D5 01 01 01 64 00 00 46 21 00 01 01 64' - '00 00 48 1D 00 01 08 64 00 00 25 D6 01 01 01 64 00 00 D3 24 00 01 07 64 00 00 89 D5 01 01 01 64' - '00 00 55 D5 01 01 01 64 00 00 21 D5 01 01 01 64 00 00 59 D6 01 01 01 64 00 00 ED D4 01 01 01 64' - '00 00 44 FF 00 01 0B 64 00 00 85 D4 01 01 01 64 00 00 51 D4 01 01 01 64 00 00 CE 32 00 02 0E 65' - '00 00 56 00 00 CD 32 00 03 0E 65 00 00 72 00 00 67 00 00 E8 00 00 02 00 65 00 00 00 03 00 E9 00' - '00 02 00 65 00 00 01 03 00 C1 1E 00 03 00 65 00 00 02 03 00 00 03 00 BF 1E 00 03 00 65 00 00 02' - '03 00 01 03 00 C5 1E 00 03 00 65 00 00 02 03 00 03 03 00 C3 1E 00 03 00 65 00 00 02 03 00 09 03' - '00 EA 00 00 02 00 65 00 00 02 03 00 BD 1E 00 02 00 65 00 00 03 03 00 15 1E 00 03 00 65 00 00 04' - '03 00 00 03 00 17 1E 00 03 00 65 00 00 04 03 00 01 03 00 13 01 00 02 00 65 00 00 04 03 00 15 01' - '00 02 00 65 00 00 06 03 00 17 01 00 02 00 65 00 00 07 03 00 EB 00 00 02 00 65 00 00 08 03 00 BB' - '1E 00 02 00 65 00 00 09 03 00 1B 01 00 02 00 65 00 00 0C 03 00 05 02 00 02 00 65 00 00 0F 03 00' - '07 02 00 02 00 65 00 00 11 03 00 C7 1E 00 03 00 65 00 00 23 03 00 02 03 00 B9 1E 00 02 00 65 00' - '00 23 03 00 1D 1E 00 03 00 65 00 00 27 03 00 06 03 00 29 02 00 02 00 65 00 00 27 03 00 19 01 00' - '02 00 65 00 00 28 03 00 19 1E 00 02 00 65 00 00 2D 03 00 1B 1E 00 02 00 65 00 00 30 03 00 22 D5' - '01 01 01 65 00 00 F2 D5 01 01 01 65 00 00 26 D6 01 01 01 65 00 00 5A D6 01 01 01 65 00 00 EE D4' - '01 01 01 65 00 00 8E D6 01 01 01 65 00 00 49 1D 00 01 08 65 00 00 56 D5 01 01 01 65 00 00 47 21' - '00 01 01 65 00 00 8A D5 01 01 01 65 00 00 52 D4 01 01 01 65 00 00 BE D5 01 01 01 65 00 00 2F 21' - '00 01 01 65 00 00 91 20 00 01 09 65 00 00 45 FF 00 01 0B 65 00 00 D4 24 00 01 07 65 00 00 1E D4' - '01 01 01 65 00 00 86 D4 01 01 01 65 00 00 03 FB 00 03 10 66 00 00 66 00 00 69 00 00 04 FB 00 03' - '10 66 00 00 66 00 00 6C 00 00 00 FB 00 02 10 66 00 00 66 00 00 01 FB 00 02 10 66 00 00 69 00 00' - '02 FB 00 02 10 66 00 00 6C 00 00 99 33 00 02 0E 66 00 00 6D 00 00 1F 1E 00 02 00 66 00 00 07 03' - '00 BF D5 01 01 01 66 00 00 F3 D5 01 01 01 66 00 00 BB D4 01 01 01 66 00 00 1F D4 01 01 01 66 00' - '00 A0 1D 00 01 08 66 00 00 D5 24 00 01 07 66 00 00 8F D6 01 01 01 66 00 00 57 D5 01 01 01 66 00' - '00 46 FF 00 01 0B 66 00 00 5B D6 01 01 01 66 00 00 27 D6 01 01 01 66 00 00 87 D4 01 01 01 66 00' - '00 23 D5 01 01 01 66 00 00 53 D4 01 01 01 66 00 00 8B D5 01 01 01 66 00 00 EF D4 01 01 01 66 00' - '00 FF 33 00 03 0E 67 00 00 61 00 00 6C 00 00 F5 01 00 02 00 67 00 00 01 03 00 1D 01 00 02 00 67' - '00 00 02 03 00 21 1E 00 02 00 67 00 00 04 03 00 1F 01 00 02 00 67 00 00 06 03 00 21 01 00 02 00' - '67 00 00 07 03 00 E7 01 00 02 00 67 00 00 0C 03 00 23 01 00 02 00 67 00 00 27 03 00 5C D6 01 01' - '01 67 00 00 58 D5 01 01 01 67 00 00 88 D4 01 01 01 67 00 00 20 D4 01 01 01 67 00 00 C0 D5 01 01' - '01 67 00 00 D6 24 00 01 07 67 00 00 0A 21 00 01 01 67 00 00 47 FF 00 01 0B 67 00 00 F4 D5 01 01' - '01 67 00 00 F0 D4 01 01 01 67 00 00 54 D4 01 01 01 67 00 00 4D 1D 00 01 08 67 00 00 8C D5 01 01' - '01 67 00 00 28 D6 01 01 01 67 00 00 90 D6 01 01 01 67 00 00 24 D5 01 01 01 67 00 00 71 33 00 03' - '0E 68 00 00 50 00 00 61 00 00 CA 33 00 02 0E 68 00 00 61 00 00 25 01 00 02 00 68 00 00 02 03 00' - '23 1E 00 02 00 68 00 00 07 03 00 27 1E 00 02 00 68 00 00 08 03 00 1F 02 00 02 00 68 00 00 0C 03' - '00 25 1E 00 02 00 68 00 00 23 03 00 29 1E 00 02 00 68 00 00 27 03 00 2B 1E 00 02 00 68 00 00 2E' - '03 00 96 1E 00 02 00 68 00 00 31 03 00 F5 D5 01 01 01 68 00 00 25 D5 01 01 01 68 00 00 8D D5 01' - '01 01 68 00 00 0E 21 00 01 01 68 00 00 C1 D5 01 01 01 68 00 00 21 D4 01 01 01 68 00 00 48 FF 00' - '01 0B 68 00 00 29 D6 01 01 01 68 00 00 91 D6 01 01 01 68 00 00 89 D4 01 01 01 68 00 00 5D D6 01' - '01 01 68 00 00 D7 24 00 01 07 68 00 00 95 20 00 01 09 68 00 00 F1 D4 01 01 01 68 00 00 B0 02 00' - '01 08 68 00 00 BD D4 01 01 01 68 00 00 59 D5 01 01 01 68 00 00 72 21 00 03 10 69 00 00 69 00 00' - '69 00 00 71 21 00 02 10 69 00 00 69 00 00 33 01 00 02 10 69 00 00 6A 00 00 CC 33 00 02 0E 69 00' - '00 6E 00 00 73 21 00 02 10 69 00 00 76 00 00 78 21 00 02 10 69 00 00 78 00 00 EC 00 00 02 00 69' - '00 00 00 03 00 ED 00 00 02 00 69 00 00 01 03 00 EE 00 00 02 00 69 00 00 02 03 00 29 01 00 02 00' - '69 00 00 03 03 00 2B 01 00 02 00 69 00 00 04 03 00 2D 01 00 02 00 69 00 00 06 03 00 2F 1E 00 03' - '00 69 00 00 08 03 00 01 03 00 EF 00 00 02 00 69 00 00 08 03 00 C9 1E 00 02 00 69 00 00 09 03 00' - 'D0 01 00 02 00 69 00 00 0C 03 00 09 02 00 02 00 69 00 00 0F 03 00 0B 02 00 02 00 69 00 00 11 03' - '00 CB 1E 00 02 00 69 00 00 23 03 00 2F 01 00 02 00 69 00 00 28 03 00 2D 1E 00 02 00 69 00 00 30' - '03 00 8E D5 01 01 01 69 00 00 BE D4 01 01 01 69 00 00 56 D4 01 01 01 69 00 00 70 21 00 01 10 69' - '00 00 26 D5 01 01 01 69 00 00 62 1D 00 01 09 69 00 00 F6 D5 01 01 01 69 00 00 48 21 00 01 01 69' - '00 00 5E D6 01 01 01 69 00 00 2A D6 01 01 01 69 00 00 D8 24 00 01 07 69 00 00 49 FF 00 01 0B 69' - '00 00 22 D4 01 01 01 69 00 00 5A D5 01 01 01 69 00 00 71 20 00 01 08 69 00 00 F2 D4 01 01 01 69' - '00 00 92 D6 01 01 01 69 00 00 C2 D5 01 01 01 69 00 00 8A D4 01 01 01 69 00 00 39 21 00 01 01 69' - '00 00 35 01 00 02 00 6A 00 00 02 03 00 F0 01 00 02 00 6A 00 00 0C 03 00 C3 D5 01 01 01 6A 00 00' - '5B D5 01 01 01 6A 00 00 49 21 00 01 01 6A 00 00 BF D4 01 01 01 6A 00 00 8F D5 01 01 01 6A 00 00' - '57 D4 01 01 01 6A 00 00 7C 2C 00 01 09 6A 00 00 5F D6 01 01 01 6A 00 00 B2 02 00 01 08 6A 00 00' - '2B D6 01 01 01 6A 00 00 F3 D4 01 01 01 6A 00 00 D9 24 00 01 07 6A 00 00 4A FF 00 01 0B 6A 00 00' - '93 D6 01 01 01 6A 00 00 23 D4 01 01 01 6A 00 00 8B D4 01 01 01 6A 00 00 27 D5 01 01 01 6A 00 00' - 'F7 D5 01 01 01 6A 00 00 84 33 00 02 0E 6B 00 00 41 00 00 91 33 00 03 0E 6B 00 00 48 00 00 7A 00' - '00 AA 33 00 03 0E 6B 00 00 50 00 00 61 00 00 B8 33 00 02 0E 6B 00 00 56 00 00 BE 33 00 02 0E 6B' - '00 00 57 00 00 89 33 00 04 0E 6B 00 00 63 00 00 61 00 00 6C 00 00 8F 33 00 02 0E 6B 00 00 67 00' - '00 98 33 00 02 0E 6B 00 00 6C 00 00 A2 33 00 03 0E 6B 00 00 6D 00 00 32 00 00 A6 33 00 03 0E 6B' - '00 00 6D 00 00 33 00 00 9E 33 00 02 0E 6B 00 00 6D 00 00 CF 33 00 02 0E 6B 00 00 74 00 00 31 1E' - '00 02 00 6B 00 00 01 03 00 E9 01 00 02 00 6B 00 00 0C 03 00 33 1E 00 02 00 6B 00 00 23 03 00 37' - '01 00 02 00 6B 00 00 27 03 00 35 1E 00 02 00 6B 00 00 31 03 00 C0 33 00 02 0E 6B 00 00 A9 03 00' - 'C0 D4 01 01 01 6B 00 00 96 20 00 01 09 6B 00 00 5C D5 01 01 01 6B 00 00 DA 24 00 01 07 6B 00 00' - '4B FF 00 01 0B 6B 00 00 2C D6 01 01 01 6B 00 00 8C D4 01 01 01 6B 00 00 60 D6 01 01 01 6B 00 00' - '94 D6 01 01 01 6B 00 00 90 D5 01 01 01 6B 00 00 4F 1D 00 01 08 6B 00 00 C4 D5 01 01 01 6B 00 00' - 'F8 D5 01 01 01 6B 00 00 28 D5 01 01 01 6B 00 00 58 D4 01 01 01 6B 00 00 24 D4 01 01 01 6B 00 00' - 'F4 D4 01 01 01 6B 00 00 C9 01 00 02 10 6C 00 00 6A 00 00 D0 33 00 02 0E 6C 00 00 6D 00 00 D1 33' - '00 02 0E 6C 00 00 6E 00 00 D2 33 00 03 0E 6C 00 00 6F 00 00 67 00 00 D3 33 00 02 0E 6C 00 00 78' - '00 00 40 01 00 02 10 6C 00 00 B7 00 00 3A 01 00 02 00 6C 00 00 01 03 00 3E 01 00 02 00 6C 00 00' - '0C 03 00 39 1E 00 03 00 6C 00 00 23 03 00 04 03 00 37 1E 00 02 00 6C 00 00 23 03 00 3C 01 00 02' - '00 6C 00 00 27 03 00 3D 1E 00 02 00 6C 00 00 2D 03 00 3B 1E 00 02 00 6C 00 00 31 03 00 91 D5 01' - '01 01 6C 00 00 25 D4 01 01 01 6C 00 00 C1 D4 01 01 01 6C 00 00 59 D4 01 01 01 6C 00 00 95 D6 01' - '01 01 6C 00 00 8D D4 01 01 01 6C 00 00 13 21 00 01 01 6C 00 00 5D D5 01 01 01 6C 00 00 97 20 00' - '01 09 6C 00 00 4C FF 00 01 0B 6C 00 00 7C 21 00 01 10 6C 00 00 29 D5 01 01 01 6C 00 00 C5 D5 01' - '01 01 6C 00 00 F9 D5 01 01 01 6C 00 00 E1 02 00 01 08 6C 00 00 F5 D4 01 01 01 6C 00 00 DB 24 00' - '01 07 6C 00 00 61 D6 01 01 01 6C 00 00 2D D6 01 01 01 6C 00 00 A1 33 00 02 0E 6D 00 00 32 00 00' - 'A5 33 00 02 0E 6D 00 00 33 00 00 83 33 00 02 0E 6D 00 00 41 00 00 B7 33 00 02 0E 6D 00 00 56 00' - '00 BD 33 00 02 0E 6D 00 00 57 00 00 D4 33 00 02 0E 6D 00 00 62 00 00 8E 33 00 02 0E 6D 00 00 67' - '00 00 D5 33 00 03 0E 6D 00 00 69 00 00 6C 00 00 96 33 00 02 0E 6D 00 00 6C 00 00 9F 33 00 03 0E' - '6D 00 00 6D 00 00 32 00 00 A3 33 00 03 0E 6D 00 00 6D 00 00 33 00 00 9C 33 00 02 0E 6D 00 00 6D' - '00 00 D6 33 00 03 0E 6D 00 00 6F 00 00 6C 00 00 B3 33 00 02 0E 6D 00 00 73 00 00 3F 1E 00 02 00' - '6D 00 00 01 03 00 41 1E 00 02 00 6D 00 00 07 03 00 43 1E 00 02 00 6D 00 00 23 03 00 A8 33 00 04' - '0E 6D 00 00 15 22 00 73 00 00 32 00 00 A7 33 00 03 0E 6D 00 00 15 22 00 73 00 00 98 20 00 01 09' - '6D 00 00 8E D4 01 01 01 6D 00 00 2A D5 01 01 01 6D 00 00 2E D6 01 01 01 6D 00 00 DC 24 00 01 07' - '6D 00 00 26 D4 01 01 01 6D 00 00 4D FF 00 01 0B 6D 00 00 FA D5 01 01 01 6D 00 00 96 D6 01 01 01' - '6D 00 00 5A D4 01 01 01 6D 00 00 50 1D 00 01 08 6D 00 00 5E D5 01 01 01 6D 00 00 F6 D4 01 01 01' - '6D 00 00 7F 21 00 01 10 6D 00 00 C2 D4 01 01 01 6D 00 00 62 D6 01 01 01 6D 00 00 92 D5 01 01 01' - '6D 00 00 C6 D5 01 01 01 6D 00 00 81 33 00 02 0E 6E 00 00 41 00 00 8B 33 00 02 0E 6E 00 00 46 00' - '00 B5 33 00 02 0E 6E 00 00 56 00 00 BB 33 00 02 0E 6E 00 00 57 00 00 CC 01 00 02 10 6E 00 00 6A' - '00 00 9A 33 00 02 0E 6E 00 00 6D 00 00 B1 33 00 02 0E 6E 00 00 73 00 00 F9 01 00 02 00 6E 00 00' - '00 03 00 44 01 00 02 00 6E 00 00 01 03 00 F1 00 00 02 00 6E 00 00 03 03 00 45 1E 00 02 00 6E 00' - '00 07 03 00 48 01 00 02 00 6E 00 00 0C 03 00 47 1E 00 02 00 6E 00 00 23 03 00 46 01 00 02 00 6E' - '00 00 27 03 00 4B 1E 00 02 00 6E 00 00 2D 03 00 49 1E 00 02 00 6E 00 00 31 03 00 DD 24 00 01 07' - '6E 00 00 8F D4 01 01 01 6E 00 00 FB D5 01 01 01 6E 00 00 97 D6 01 01 01 6E 00 00 5B D4 01 01 01' - '6E 00 00 C7 D5 01 01 01 6E 00 00 4E FF 00 01 0B 6E 00 00 99 20 00 01 09 6E 00 00 C3 D4 01 01 01' - '6E 00 00 2F D6 01 01 01 6E 00 00 7F 20 00 01 08 6E 00 00 F7 D4 01 01 01 6E 00 00 93 D5 01 01 01' - '6E 00 00 2B D5 01 01 01 6E 00 00 5F D5 01 01 01 6E 00 00 63 D6 01 01 01 6E 00 00 27 D4 01 01 01' - '6E 00 00 75 33 00 02 0E 6F 00 00 56 00 00 F2 00 00 02 00 6F 00 00 00 03 00 F3 00 00 02 00 6F 00' - '00 01 03 00 D3 1E 00 03 00 6F 00 00 02 03 00 00 03 00 D1 1E 00 03 00 6F 00 00 02 03 00 01 03 00' - 'D7 1E 00 03 00 6F 00 00 02 03 00 03 03 00 D5 1E 00 03 00 6F 00 00 02 03 00 09 03 00 F4 00 00 02' - '00 6F 00 00 02 03 00 4D 1E 00 03 00 6F 00 00 03 03 00 01 03 00 2D 02 00 03 00 6F 00 00 03 03 00' - '04 03 00 4F 1E 00 03 00 6F 00 00 03 03 00 08 03 00 F5 00 00 02 00 6F 00 00 03 03 00 51 1E 00 03' - '00 6F 00 00 04 03 00 00 03 00 53 1E 00 03 00 6F 00 00 04 03 00 01 03 00 4D 01 00 02 00 6F 00 00' - '04 03 00 4F 01 00 02 00 6F 00 00 06 03 00 31 02 00 03 00 6F 00 00 07 03 00 04 03 00 2F 02 00 02' - '00 6F 00 00 07 03 00 2B 02 00 03 00 6F 00 00 08 03 00 04 03 00 F6 00 00 02 00 6F 00 00 08 03 00' - 'CF 1E 00 02 00 6F 00 00 09 03 00 51 01 00 02 00 6F 00 00 0B 03 00 D2 01 00 02 00 6F 00 00 0C 03' - '00 0D 02 00 02 00 6F 00 00 0F 03 00 0F 02 00 02 00 6F 00 00 11 03 00 DD 1E 00 03 00 6F 00 00 1B' - '03 00 00 03 00 DB 1E 00 03 00 6F 00 00 1B 03 00 01 03 00 E1 1E 00 03 00 6F 00 00 1B 03 00 03 03' - '00 DF 1E 00 03 00 6F 00 00 1B 03 00 09 03 00 E3 1E 00 03 00 6F 00 00 1B 03 00 23 03 00 A1 01 00' - '02 00 6F 00 00 1B 03 00 D9 1E 00 03 00 6F 00 00 23 03 00 02 03 00 CD 1E 00 02 00 6F 00 00 23 03' - '00 ED 01 00 03 00 6F 00 00 28 03 00 04 03 00 EB 01 00 02 00 6F 00 00 28 03 00 52 1D 00 01 08 6F' - '00 00 94 D5 01 01 01 6F 00 00 5C D4 01 01 01 6F 00 00 98 D6 01 01 01 6F 00 00 DE 24 00 01 07 6F' - '00 00 4F FF 00 01 0B 6F 00 00 C8 D5 01 01 01 6F 00 00 30 D6 01 01 01 6F 00 00 BA 00 00 01 08 6F' - '00 00 2C D5 01 01 01 6F 00 00 FC D5 01 01 01 6F 00 00 F8 D4 01 01 01 6F 00 00 60 D5 01 01 01 6F' - '00 00 64 D6 01 01 01 6F 00 00 34 21 00 01 01 6F 00 00 92 20 00 01 09 6F 00 00 90 D4 01 01 01 6F' - '00 00 28 D4 01 01 01 6F 00 00 D8 33 00 04 0E 70 00 00 2E 00 00 6D 00 00 2E 00 00 80 33 00 02 0E' - '70 00 00 41 00 00 8A 33 00 02 0E 70 00 00 46 00 00 B4 33 00 02 0E 70 00 00 56 00 00 BA 33 00 02' - '0E 70 00 00 57 00 00 76 33 00 02 0E 70 00 00 63 00 00 B0 33 00 02 0E 70 00 00 73 00 00 55 1E 00' - '02 00 70 00 00 01 03 00 57 1E 00 02 00 70 00 00 07 03 00 29 D4 01 01 01 70 00 00 95 D5 01 01 01' - '70 00 00 91 D4 01 01 01 70 00 00 99 D6 01 01 01 70 00 00 FD D5 01 01 01 70 00 00 56 1D 00 01 08' - '70 00 00 5D D4 01 01 01 70 00 00 50 FF 00 01 0B 70 00 00 31 D6 01 01 01 70 00 00 65 D6 01 01 01' - '70 00 00 C5 D4 01 01 01 70 00 00 2D D5 01 01 01 70 00 00 9A 20 00 01 09 70 00 00 61 D5 01 01 01' - '70 00 00 DF 24 00 01 07 70 00 00 F9 D4 01 01 01 70 00 00 C9 D5 01 01 01 70 00 00 9A D6 01 01 01' - '71 00 00 62 D5 01 01 01 71 00 00 5E D4 01 01 01 71 00 00 2A D4 01 01 01 71 00 00 FE D5 01 01 01' - '71 00 00 FA D4 01 01 01 71 00 00 66 D6 01 01 01 71 00 00 2E D5 01 01 01 71 00 00 92 D4 01 01 01' - '71 00 00 C6 D4 01 01 01 71 00 00 51 FF 00 01 0B 71 00 00 32 D6 01 01 01 71 00 00 CA D5 01 01 01' - '71 00 00 E0 24 00 01 07 71 00 00 96 D5 01 01 01 71 00 00 AF 33 00 06 0E 72 00 00 61 00 00 64 00' - '00 15 22 00 73 00 00 32 00 00 AE 33 00 05 0E 72 00 00 61 00 00 64 00 00 15 22 00 73 00 00 AD 33' - '00 03 0E 72 00 00 61 00 00 64 00 00 55 01 00 02 00 72 00 00 01 03 00 59 1E 00 02 00 72 00 00 07' - '03 00 59 01 00 02 00 72 00 00 0C 03 00 11 02 00 02 00 72 00 00 0F 03 00 13 02 00 02 00 72 00 00' - '11 03 00 5D 1E 00 03 00 72 00 00 23 03 00 04 03 00 5B 1E 00 02 00 72 00 00 23 03 00 57 01 00 02' - '00 72 00 00 27 03 00 5F 1E 00 02 00 72 00 00 31 03 00 B3 02 00 01 08 72 00 00 63 1D 00 01 09 72' - '00 00 93 D4 01 01 01 72 00 00 33 D6 01 01 01 72 00 00 67 D6 01 01 01 72 00 00 9B D6 01 01 01 72' - '00 00 C7 D4 01 01 01 72 00 00 2F D5 01 01 01 72 00 00 FB D4 01 01 01 72 00 00 5F D4 01 01 01 72' - '00 00 FF D5 01 01 01 72 00 00 63 D5 01 01 01 72 00 00 52 FF 00 01 0B 72 00 00 2B D4 01 01 01 72' - '00 00 97 D5 01 01 01 72 00 00 CB D5 01 01 01 72 00 00 E1 24 00 01 07 72 00 00 DB 33 00 02 0E 73' - '00 00 72 00 00 06 FB 00 02 10 73 00 00 74 00 00 05 FB 00 02 10 73 00 00 74 00 00 65 1E 00 03 00' - '73 00 00 01 03 00 07 03 00 5B 01 00 02 00 73 00 00 01 03 00 5D 01 00 02 00 73 00 00 02 03 00 9B' - '1E 00 02 00 73 00 00 07 03 00 61 1E 00 02 00 73 00 00 07 03 00 67 1E 00 03 00 73 00 00 0C 03 00' - '07 03 00 61 01 00 02 00 73 00 00 0C 03 00 69 1E 00 03 00 73 00 00 23 03 00 07 03 00 63 1E 00 02' - '00 73 00 00 23 03 00 19 02 00 02 00 73 00 00 26 03 00 5F 01 00 02 00 73 00 00 27 03 00 CC D5 01' - '01 01 73 00 00 68 D6 01 01 01 73 00 00 98 D5 01 01 01 73 00 00 C8 D4 01 01 01 73 00 00 FC D4 01' - '01 01 73 00 00 7F 01 00 01 10 73 00 00 9C D6 01 01 01 73 00 00 60 D4 01 01 01 73 00 00 00 D6 01' - '01 01 73 00 00 53 FF 00 01 0B 73 00 00 2C D4 01 01 01 73 00 00 64 D5 01 01 01 73 00 00 34 D6 01' - '01 01 73 00 00 94 D4 01 01 01 73 00 00 9B 20 00 01 09 73 00 00 E2 02 00 01 08 73 00 00 E2 24 00' - '01 07 73 00 00 30 D5 01 01 01 73 00 00 6B 1E 00 02 00 74 00 00 07 03 00 97 1E 00 02 00 74 00 00' - '08 03 00 65 01 00 02 00 74 00 00 0C 03 00 6D 1E 00 02 00 74 00 00 23 03 00 1B 02 00 02 00 74 00' - '00 26 03 00 63 01 00 02 00 74 00 00 27 03 00 71 1E 00 02 00 74 00 00 2D 03 00 6F 1E 00 02 00 74' - '00 00 31 03 00 61 D4 01 01 01 74 00 00 CD D5 01 01 01 74 00 00 65 D5 01 01 01 74 00 00 2D D4 01' - '01 01 74 00 00 E3 24 00 01 07 74 00 00 31 D5 01 01 01 74 00 00 95 D4 01 01 01 74 00 00 99 D5 01' - '01 01 74 00 00 FD D4 01 01 01 74 00 00 C9 D4 01 01 01 74 00 00 9C 20 00 01 09 74 00 00 35 D6 01' - '01 01 74 00 00 69 D6 01 01 01 74 00 00 57 1D 00 01 08 74 00 00 54 FF 00 01 0B 74 00 00 9D D6 01' - '01 01 74 00 00 01 D6 01 01 01 74 00 00 F9 00 00 02 00 75 00 00 00 03 00 FA 00 00 02 00 75 00 00' - '01 03 00 FB 00 00 02 00 75 00 00 02 03 00 79 1E 00 03 00 75 00 00 03 03 00 01 03 00 69 01 00 02' - '00 75 00 00 03 03 00 7B 1E 00 03 00 75 00 00 04 03 00 08 03 00 6B 01 00 02 00 75 00 00 04 03 00' - '6D 01 00 02 00 75 00 00 06 03 00 DC 01 00 03 00 75 00 00 08 03 00 00 03 00 D8 01 00 03 00 75 00' - '00 08 03 00 01 03 00 D6 01 00 03 00 75 00 00 08 03 00 04 03 00 DA 01 00 03 00 75 00 00 08 03 00' - '0C 03 00 FC 00 00 02 00 75 00 00 08 03 00 E7 1E 00 02 00 75 00 00 09 03 00 6F 01 00 02 00 75 00' - '00 0A 03 00 71 01 00 02 00 75 00 00 0B 03 00 D4 01 00 02 00 75 00 00 0C 03 00 15 02 00 02 00 75' - '00 00 0F 03 00 17 02 00 02 00 75 00 00 11 03 00 EB 1E 00 03 00 75 00 00 1B 03 00 00 03 00 E9 1E' - '00 03 00 75 00 00 1B 03 00 01 03 00 EF 1E 00 03 00 75 00 00 1B 03 00 03 03 00 ED 1E 00 03 00 75' - '00 00 1B 03 00 09 03 00 F1 1E 00 03 00 75 00 00 1B 03 00 23 03 00 B0 01 00 02 00 75 00 00 1B 03' - '00 E5 1E 00 02 00 75 00 00 23 03 00 73 1E 00 02 00 75 00 00 24 03 00 73 01 00 02 00 75 00 00 28' - '03 00 77 1E 00 02 00 75 00 00 2D 03 00 75 1E 00 02 00 75 00 00 30 03 00 55 FF 00 01 0B 75 00 00' - 'FE D4 01 01 01 75 00 00 CA D4 01 01 01 75 00 00 E4 24 00 01 07 75 00 00 CE D5 01 01 01 75 00 00' - '9E D6 01 01 01 75 00 00 66 D5 01 01 01 75 00 00 2E D4 01 01 01 75 00 00 36 D6 01 01 01 75 00 00' - '9A D5 01 01 01 75 00 00 6A D6 01 01 01 75 00 00 64 1D 00 01 09 75 00 00 58 1D 00 01 08 75 00 00' - '96 D4 01 01 01 75 00 00 02 D6 01 01 01 75 00 00 32 D5 01 01 01 75 00 00 62 D4 01 01 01 75 00 00' - '77 21 00 04 10 76 00 00 69 00 00 69 00 00 69 00 00 76 21 00 03 10 76 00 00 69 00 00 69 00 00 75' - '21 00 02 10 76 00 00 69 00 00 7D 1E 00 02 00 76 00 00 03 03 00 7F 1E 00 02 00 76 00 00 23 03 00' - '03 D6 01 01 01 76 00 00 74 21 00 01 10 76 00 00 37 D6 01 01 01 76 00 00 E5 24 00 01 07 76 00 00' - '63 D4 01 01 01 76 00 00 CB D4 01 01 01 76 00 00 CF D5 01 01 01 76 00 00 65 1D 00 01 09 76 00 00' - 'FF D4 01 01 01 76 00 00 67 D5 01 01 01 76 00 00 33 D5 01 01 01 76 00 00 9F D6 01 01 01 76 00 00' - '97 D4 01 01 01 76 00 00 5B 1D 00 01 08 76 00 00 9B D5 01 01 01 76 00 00 2F D4 01 01 01 76 00 00' - '56 FF 00 01 0B 76 00 00 6B D6 01 01 01 76 00 00 81 1E 00 02 00 77 00 00 00 03 00 83 1E 00 02 00' - '77 00 00 01 03 00 75 01 00 02 00 77 00 00 02 03 00 87 1E 00 02 00 77 00 00 07 03 00 85 1E 00 02' - '00 77 00 00 08 03 00 98 1E 00 02 00 77 00 00 0A 03 00 89 1E 00 02 00 77 00 00 23 03 00 B7 02 00' - '01 08 77 00 00 64 D4 01 01 01 77 00 00 34 D5 01 01 01 77 00 00 E6 24 00 01 07 77 00 00 D0 D5 01' - '01 01 77 00 00 38 D6 01 01 01 77 00 00 57 FF 00 01 0B 77 00 00 9C D5 01 01 01 77 00 00 68 D5 01' - '01 01 77 00 00 A0 D6 01 01 01 77 00 00 6C D6 01 01 01 77 00 00 00 D5 01 01 01 77 00 00 30 D4 01' - '01 01 77 00 00 04 D6 01 01 01 77 00 00 98 D4 01 01 01 77 00 00 CC D4 01 01 01 77 00 00 7B 21 00' - '03 10 78 00 00 69 00 00 69 00 00 7A 21 00 02 10 78 00 00 69 00 00 8B 1E 00 02 00 78 00 00 07 03' - '00 8D 1E 00 02 00 78 00 00 08 03 00 79 21 00 01 10 78 00 00 D1 D5 01 01 01 78 00 00 35 D5 01 01' - '01 78 00 00 93 20 00 01 09 78 00 00 58 FF 00 01 0B 78 00 00 05 D6 01 01 01 78 00 00 6D D6 01 01' - '01 78 00 00 A1 D6 01 01 01 78 00 00 31 D4 01 01 01 78 00 00 69 D5 01 01 01 78 00 00 39 D6 01 01' - '01 78 00 00 99 D4 01 01 01 78 00 00 CD D4 01 01 01 78 00 00 9D D5 01 01 01 78 00 00 E3 02 00 01' - '08 78 00 00 65 D4 01 01 01 78 00 00 E7 24 00 01 07 78 00 00 01 D5 01 01 01 78 00 00 F3 1E 00 02' - '00 79 00 00 00 03 00 FD 00 00 02 00 79 00 00 01 03 00 77 01 00 02 00 79 00 00 02 03 00 F9 1E 00' - '02 00 79 00 00 03 03 00 33 02 00 02 00 79 00 00 04 03 00 8F 1E 00 02 00 79 00 00 07 03 00 FF 00' - '00 02 00 79 00 00 08 03 00 F7 1E 00 02 00 79 00 00 09 03 00 99 1E 00 02 00 79 00 00 0A 03 00 F5' - '1E 00 02 00 79 00 00 23 03 00 E8 24 00 01 07 79 00 00 32 D4 01 01 01 79 00 00 02 D5 01 01 01 79' - '00 00 36 D5 01 01 01 79 00 00 9E D5 01 01 01 79 00 00 9A D4 01 01 01 79 00 00 A2 D6 01 01 01 79' - '00 00 06 D6 01 01 01 79 00 00 6A D5 01 01 01 79 00 00 59 FF 00 01 0B 79 00 00 66 D4 01 01 01 79' - '00 00 3A D6 01 01 01 79 00 00 D2 D5 01 01 01 79 00 00 B8 02 00 01 08 79 00 00 CE D4 01 01 01 79' - '00 00 6E D6 01 01 01 79 00 00 7A 01 00 02 00 7A 00 00 01 03 00 91 1E 00 02 00 7A 00 00 02 03 00' - '7C 01 00 02 00 7A 00 00 07 03 00 7E 01 00 02 00 7A 00 00 0C 03 00 93 1E 00 02 00 7A 00 00 23 03' - '00 95 1E 00 02 00 7A 00 00 31 03 00 37 D5 01 01 01 7A 00 00 9F D5 01 01 01 7A 00 00 D3 D5 01 01' - '01 7A 00 00 07 D6 01 01 01 7A 00 00 5A FF 00 01 0B 7A 00 00 6B D5 01 01 01 7A 00 00 03 D5 01 01' - '01 7A 00 00 9B D4 01 01 01 7A 00 00 CF D4 01 01 01 7A 00 00 BB 1D 00 01 08 7A 00 00 33 D4 01 01' - '01 7A 00 00 E9 24 00 01 07 7A 00 00 67 D4 01 01 01 7A 00 00 A3 D6 01 01 01 7A 00 00 6F D6 01 01' - '01 7A 00 00 3B D6 01 01 01 7A 00 00 37 FE 00 01 0A 7B 00 00 5B FE 00 01 0D 7B 00 00 5B FF 00 01' - '0B 7B 00 00 5C FF 00 01 0B 7C 00 00 5C FE 00 01 0D 7D 00 00 38 FE 00 01 0A 7D 00 00 5D FF 00 01' - '0B 7D 00 00 5E FF 00 01 0B 7E 00 00 E0 FF 00 01 0B A2 00 00 E1 FF 00 01 0B A3 00 00 E5 FF 00 01' - '0B A5 00 00 E4 FF 00 01 0B A6 00 00 E2 FF 00 01 0B AC 00 00 03 21 00 02 10 B0 00 00 43 00 00 09' - '21 00 02 10 B0 00 00 46 00 00 FC 01 00 02 00 C6 00 00 01 03 00 E2 01 00 02 00 C6 00 00 04 03 00' - '2D 1D 00 01 08 C6 00 00 FE 01 00 02 00 D8 00 00 01 03 00 FD 01 00 02 00 E6 00 00 01 03 00 E3 01' - '00 02 00 E6 00 00 04 03 00 9E 1D 00 01 08 F0 00 00 FF 01 00 02 00 F8 00 00 01 03 00 F8 A7 00 01' - '08 26 01 00 0F 21 00 01 01 27 01 00 A4 D6 01 01 01 31 01 00 51 1D 00 01 08 4B 01 00 F9 A7 00 01' - '08 53 01 00 32 1D 00 01 08 8E 01 00 07 21 00 01 10 90 01 00 B5 1D 00 01 08 AB 01 00 EE 01 00 02' - '00 B7 01 00 0C 03 00 3D 1D 00 01 08 22 02 00 A5 D6 01 01 01 37 02 00 44 1D 00 01 08 50 02 00 45' - '1D 00 01 08 51 02 00 9B 1D 00 01 08 52 02 00 53 1D 00 01 08 54 02 00 9D 1D 00 01 08 55 02 00 4A' - '1D 00 01 08 59 02 00 94 20 00 01 09 59 02 00 4B 1D 00 01 08 5B 02 00 9F 1D 00 01 08 5C 02 00 4C' - '1D 00 01 08 5C 02 00 A1 1D 00 01 08 5F 02 00 A2 1D 00 01 08 61 02 00 E0 02 00 01 08 63 02 00 A3' - '1D 00 01 08 65 02 00 B1 02 00 01 08 66 02 00 A4 1D 00 01 08 68 02 00 A5 1D 00 01 08 69 02 00 A6' - '1D 00 01 08 6A 02 00 5E AB 00 01 08 6B 02 00 A9 1D 00 01 08 6D 02 00 5A 1D 00 01 08 6F 02 00 AD' - '1D 00 01 08 70 02 00 AC 1D 00 01 08 71 02 00 AE 1D 00 01 08 72 02 00 AF 1D 00 01 08 73 02 00 B0' - '1D 00 01 08 74 02 00 B1 1D 00 01 08 75 02 00 B2 1D 00 01 08 78 02 00 B4 02 00 01 08 79 02 00 B5' - '02 00 01 08 7B 02 00 B6 02 00 01 08 81 02 00 B3 1D 00 01 08 82 02 00 B4 1D 00 01 08 83 02 00 B6' - '1D 00 01 08 89 02 00 B7 1D 00 01 08 8A 02 00 B9 1D 00 01 08 8B 02 00 BA 1D 00 01 08 8C 02 00 69' - 'AB 00 01 08 8D 02 00 BC 1D 00 01 08 90 02 00 BD 1D 00 01 08 91 02 00 EF 01 00 02 00 92 02 00 0C' - '03 00 BE 1D 00 01 08 92 02 00 E4 02 00 01 08 95 02 00 A8 1D 00 01 08 9D 02 00 AB 1D 00 01 08 9F' - '02 00 49 01 00 02 10 BC 02 00 6E 00 00 BA 1F 00 02 00 91 03 00 00 03 00 86 03 00 02 00 91 03 00' - '01 03 00 B9 1F 00 02 00 91 03 00 04 03 00 B8 1F 00 02 00 91 03 00 06 03 00 8A 1F 00 04 00 91 03' - '00 13 03 00 00 03 00 45 03 00 0A 1F 00 03 00 91 03 00 13 03 00 00 03 00 8C 1F 00 04 00 91 03 00' - '13 03 00 01 03 00 45 03 00 0C 1F 00 03 00 91 03 00 13 03 00 01 03 00 8E 1F 00 04 00 91 03 00 13' - '03 00 42 03 00 45 03 00 0E 1F 00 03 00 91 03 00 13 03 00 42 03 00 88 1F 00 03 00 91 03 00 13 03' - '00 45 03 00 08 1F 00 02 00 91 03 00 13 03 00 8B 1F 00 04 00 91 03 00 14 03 00 00 03 00 45 03 00' - '0B 1F 00 03 00 91 03 00 14 03 00 00 03 00 8D 1F 00 04 00 91 03 00 14 03 00 01 03 00 45 03 00 0D' - '1F 00 03 00 91 03 00 14 03 00 01 03 00 8F 1F 00 04 00 91 03 00 14 03 00 42 03 00 45 03 00 0F 1F' - '00 03 00 91 03 00 14 03 00 42 03 00 89 1F 00 03 00 91 03 00 14 03 00 45 03 00 09 1F 00 02 00 91' - '03 00 14 03 00 BC 1F 00 02 00 91 03 00 45 03 00 90 D7 01 01 01 91 03 00 56 D7 01 01 01 91 03 00' - 'A8 D6 01 01 01 91 03 00 1C D7 01 01 01 91 03 00 E2 D6 01 01 01 91 03 00 57 D7 01 01 01 92 03 00' - '91 D7 01 01 01 92 03 00 E3 D6 01 01 01 92 03 00 1D D7 01 01 01 92 03 00 A9 D6 01 01 01 92 03 00' - '92 D7 01 01 01 93 03 00 AA D6 01 01 01 93 03 00 58 D7 01 01 01 93 03 00 1E D7 01 01 01 93 03 00' - 'E4 D6 01 01 01 93 03 00 3E 21 00 01 01 93 03 00 59 D7 01 01 01 94 03 00 93 D7 01 01 01 94 03 00' - '1F D7 01 01 01 94 03 00 E5 D6 01 01 01 94 03 00 AB D6 01 01 01 94 03 00 C8 1F 00 02 00 95 03 00' - '00 03 00 88 03 00 02 00 95 03 00 01 03 00 1A 1F 00 03 00 95 03 00 13 03 00 00 03 00 1C 1F 00 03' - '00 95 03 00 13 03 00 01 03 00 18 1F 00 02 00 95 03 00 13 03 00 1B 1F 00 03 00 95 03 00 14 03 00' - '00 03 00 1D 1F 00 03 00 95 03 00 14 03 00 01 03 00 19 1F 00 02 00 95 03 00 14 03 00 AC D6 01 01' - '01 95 03 00 94 D7 01 01 01 95 03 00 E6 D6 01 01 01 95 03 00 5A D7 01 01 01 95 03 00 20 D7 01 01' - '01 95 03 00 21 D7 01 01 01 96 03 00 95 D7 01 01 01 96 03 00 AD D6 01 01 01 96 03 00 E7 D6 01 01' - '01 96 03 00 5B D7 01 01 01 96 03 00 CA 1F 00 02 00 97 03 00 00 03 00 89 03 00 02 00 97 03 00 01' - '03 00 9A 1F 00 04 00 97 03 00 13 03 00 00 03 00 45 03 00 2A 1F 00 03 00 97 03 00 13 03 00 00 03' - '00 9C 1F 00 04 00 97 03 00 13 03 00 01 03 00 45 03 00 2C 1F 00 03 00 97 03 00 13 03 00 01 03 00' - '9E 1F 00 04 00 97 03 00 13 03 00 42 03 00 45 03 00 2E 1F 00 03 00 97 03 00 13 03 00 42 03 00 98' - '1F 00 03 00 97 03 00 13 03 00 45 03 00 28 1F 00 02 00 97 03 00 13 03 00 9B 1F 00 04 00 97 03 00' - '14 03 00 00 03 00 45 03 00 2B 1F 00 03 00 97 03 00 14 03 00 00 03 00 9D 1F 00 04 00 97 03 00 14' - '03 00 01 03 00 45 03 00 2D 1F 00 03 00 97 03 00 14 03 00 01 03 00 9F 1F 00 04 00 97 03 00 14 03' - '00 42 03 00 45 03 00 2F 1F 00 03 00 97 03 00 14 03 00 42 03 00 99 1F 00 03 00 97 03 00 14 03 00' - '45 03 00 29 1F 00 02 00 97 03 00 14 03 00 CC 1F 00 02 00 97 03 00 45 03 00 5C D7 01 01 01 97 03' - '00 E8 D6 01 01 01 97 03 00 AE D6 01 01 01 97 03 00 96 D7 01 01 01 97 03 00 22 D7 01 01 01 97 03' - '00 67 D7 01 01 01 98 03 00 AF D6 01 01 01 98 03 00 97 D7 01 01 01 98 03 00 A1 D7 01 01 01 98 03' - '00 F3 D6 01 01 01 98 03 00 F4 03 00 01 10 98 03 00 5D D7 01 01 01 98 03 00 E9 D6 01 01 01 98 03' - '00 2D D7 01 01 01 98 03 00 23 D7 01 01 01 98 03 00 B9 D6 01 01 01 98 03 00 DA 1F 00 02 00 99 03' - '00 00 03 00 8A 03 00 02 00 99 03 00 01 03 00 D9 1F 00 02 00 99 03 00 04 03 00 D8 1F 00 02 00 99' - '03 00 06 03 00 AA 03 00 02 00 99 03 00 08 03 00 3A 1F 00 03 00 99 03 00 13 03 00 00 03 00 3C 1F' - '00 03 00 99 03 00 13 03 00 01 03 00 3E 1F 00 03 00 99 03 00 13 03 00 42 03 00 38 1F 00 02 00 99' - '03 00 13 03 00 3B 1F 00 03 00 99 03 00 14 03 00 00 03 00 3D 1F 00 03 00 99 03 00 14 03 00 01 03' - '00 3F 1F 00 03 00 99 03 00 14 03 00 42 03 00 39 1F 00 02 00 99 03 00 14 03 00 B0 D6 01 01 01 99' - '03 00 5E D7 01 01 01 99 03 00 EA D6 01 01 01 99 03 00 98 D7 01 01 01 99 03 00 24 D7 01 01 01 99' - '03 00 25 D7 01 01 01 9A 03 00 B1 D6 01 01 01 9A 03 00 5F D7 01 01 01 9A 03 00 EB D6 01 01 01 9A' - '03 00 99 D7 01 01 01 9A 03 00 9A D7 01 01 01 9B 03 00 26 D7 01 01 01 9B 03 00 B2 D6 01 01 01 9B' - '03 00 60 D7 01 01 01 9B 03 00 EC D6 01 01 01 9B 03 00 61 D7 01 01 01 9C 03 00 ED D6 01 01 01 9C' - '03 00 9B D7 01 01 01 9C 03 00 27 D7 01 01 01 9C 03 00 B3 D6 01 01 01 9C 03 00 9C D7 01 01 01 9D' - '03 00 B4 D6 01 01 01 9D 03 00 EE D6 01 01 01 9D 03 00 62 D7 01 01 01 9D 03 00 28 D7 01 01 01 9D' - '03 00 63 D7 01 01 01 9E 03 00 9D D7 01 01 01 9E 03 00 B5 D6 01 01 01 9E 03 00 29 D7 01 01 01 9E' - '03 00 EF D6 01 01 01 9E 03 00 F8 1F 00 02 00 9F 03 00 00 03 00 8C 03 00 02 00 9F 03 00 01 03 00' - '4A 1F 00 03 00 9F 03 00 13 03 00 00 03 00 4C 1F 00 03 00 9F 03 00 13 03 00 01 03 00 48 1F 00 02' - '00 9F 03 00 13 03 00 4B 1F 00 03 00 9F 03 00 14 03 00 00 03 00 4D 1F 00 03 00 9F 03 00 14 03 00' - '01 03 00 49 1F 00 02 00 9F 03 00 14 03 00 64 D7 01 01 01 9F 03 00 2A D7 01 01 01 9F 03 00 F0 D6' - '01 01 01 9F 03 00 9E D7 01 01 01 9F 03 00 B6 D6 01 01 01 9F 03 00 3F 21 00 01 01 A0 03 00 65 D7' - '01 01 01 A0 03 00 F1 D6 01 01 01 A0 03 00 2B D7 01 01 01 A0 03 00 B7 D6 01 01 01 A0 03 00 9F D7' - '01 01 01 A0 03 00 EC 1F 00 02 00 A1 03 00 14 03 00 B8 D6 01 01 01 A1 03 00 F2 D6 01 01 01 A1 03' - '00 A0 D7 01 01 01 A1 03 00 66 D7 01 01 01 A1 03 00 2C D7 01 01 01 A1 03 00 F9 03 00 01 10 A3 03' - '00 2E D7 01 01 01 A3 03 00 68 D7 01 01 01 A3 03 00 F4 D6 01 01 01 A3 03 00 A2 D7 01 01 01 A3 03' - '00 BA D6 01 01 01 A3 03 00 69 D7 01 01 01 A4 03 00 A3 D7 01 01 01 A4 03 00 F5 D6 01 01 01 A4 03' - '00 BB D6 01 01 01 A4 03 00 2F D7 01 01 01 A4 03 00 EA 1F 00 02 00 A5 03 00 00 03 00 8E 03 00 02' - '00 A5 03 00 01 03 00 D3 03 00 02 00 A5 03 00 01 03 00 E9 1F 00 02 00 A5 03 00 04 03 00 E8 1F 00' - '02 00 A5 03 00 06 03 00 D4 03 00 02 00 A5 03 00 08 03 00 AB 03 00 02 00 A5 03 00 08 03 00 5B 1F' - '00 03 00 A5 03 00 14 03 00 00 03 00 5D 1F 00 03 00 A5 03 00 14 03 00 01 03 00 5F 1F 00 03 00 A5' - '03 00 14 03 00 42 03 00 59 1F 00 02 00 A5 03 00 14 03 00 F6 D6 01 01 01 A5 03 00 6A D7 01 01 01' - 'A5 03 00 A4 D7 01 01 01 A5 03 00 30 D7 01 01 01 A5 03 00 D2 03 00 01 10 A5 03 00 BC D6 01 01 01' - 'A5 03 00 BD D6 01 01 01 A6 03 00 A5 D7 01 01 01 A6 03 00 31 D7 01 01 01 A6 03 00 6B D7 01 01 01' - 'A6 03 00 F7 D6 01 01 01 A6 03 00 BE D6 01 01 01 A7 03 00 A6 D7 01 01 01 A7 03 00 32 D7 01 01 01' - 'A7 03 00 6C D7 01 01 01 A7 03 00 F8 D6 01 01 01 A7 03 00 F9 D6 01 01 01 A8 03 00 33 D7 01 01 01' - 'A8 03 00 A7 D7 01 01 01 A8 03 00 BF D6 01 01 01 A8 03 00 6D D7 01 01 01 A8 03 00 FA 1F 00 02 00' - 'A9 03 00 00 03 00 8F 03 00 02 00 A9 03 00 01 03 00 AA 1F 00 04 00 A9 03 00 13 03 00 00 03 00 45' - '03 00 6A 1F 00 03 00 A9 03 00 13 03 00 00 03 00 AC 1F 00 04 00 A9 03 00 13 03 00 01 03 00 45 03' - '00 6C 1F 00 03 00 A9 03 00 13 03 00 01 03 00 AE 1F 00 04 00 A9 03 00 13 03 00 42 03 00 45 03 00' - '6E 1F 00 03 00 A9 03 00 13 03 00 42 03 00 A8 1F 00 03 00 A9 03 00 13 03 00 45 03 00 68 1F 00 02' - '00 A9 03 00 13 03 00 AB 1F 00 04 00 A9 03 00 14 03 00 00 03 00 45 03 00 6B 1F 00 03 00 A9 03 00' - '14 03 00 00 03 00 AD 1F 00 04 00 A9 03 00 14 03 00 01 03 00 45 03 00 6D 1F 00 03 00 A9 03 00 14' - '03 00 01 03 00 AF 1F 00 04 00 A9 03 00 14 03 00 42 03 00 45 03 00 6F 1F 00 03 00 A9 03 00 14 03' - '00 42 03 00 A9 1F 00 03 00 A9 03 00 14 03 00 45 03 00 69 1F 00 02 00 A9 03 00 14 03 00 FC 1F 00' - '02 00 A9 03 00 45 03 00 34 D7 01 01 01 A9 03 00 6E D7 01 01 01 A9 03 00 C0 D6 01 01 01 A9 03 00' - 'FA D6 01 01 01 A9 03 00 A8 D7 01 01 01 A9 03 00 B2 1F 00 03 00 B1 03 00 00 03 00 45 03 00 70 1F' - '00 02 00 B1 03 00 00 03 00 B4 1F 00 03 00 B1 03 00 01 03 00 45 03 00 AC 03 00 02 00 B1 03 00 01' - '03 00 B1 1F 00 02 00 B1 03 00 04 03 00 B0 1F 00 02 00 B1 03 00 06 03 00 82 1F 00 04 00 B1 03 00' - '13 03 00 00 03 00 45 03 00 02 1F 00 03 00 B1 03 00 13 03 00 00 03 00 84 1F 00 04 00 B1 03 00 13' - '03 00 01 03 00 45 03 00 04 1F 00 03 00 B1 03 00 13 03 00 01 03 00 86 1F 00 04 00 B1 03 00 13 03' - '00 42 03 00 45 03 00 06 1F 00 03 00 B1 03 00 13 03 00 42 03 00 80 1F 00 03 00 B1 03 00 13 03 00' - '45 03 00 00 1F 00 02 00 B1 03 00 13 03 00 83 1F 00 04 00 B1 03 00 14 03 00 00 03 00 45 03 00 03' - '1F 00 03 00 B1 03 00 14 03 00 00 03 00 85 1F 00 04 00 B1 03 00 14 03 00 01 03 00 45 03 00 05 1F' - '00 03 00 B1 03 00 14 03 00 01 03 00 87 1F 00 04 00 B1 03 00 14 03 00 42 03 00 45 03 00 07 1F 00' - '03 00 B1 03 00 14 03 00 42 03 00 81 1F 00 03 00 B1 03 00 14 03 00 45 03 00 01 1F 00 02 00 B1 03' - '00 14 03 00 B7 1F 00 03 00 B1 03 00 42 03 00 45 03 00 B6 1F 00 02 00 B1 03 00 42 03 00 B3 1F 00' - '02 00 B1 03 00 45 03 00 AA D7 01 01 01 B1 03 00 C2 D6 01 01 01 B1 03 00 FC D6 01 01 01 B1 03 00' - '70 D7 01 01 01 B1 03 00 36 D7 01 01 01 B1 03 00 C3 D6 01 01 01 B2 03 00 D0 03 00 01 10 B2 03 00' - '66 1D 00 01 09 B2 03 00 71 D7 01 01 01 B2 03 00 FD D6 01 01 01 B2 03 00 5D 1D 00 01 08 B2 03 00' - 'AB D7 01 01 01 B2 03 00 37 D7 01 01 01 B2 03 00 72 D7 01 01 01 B3 03 00 38 D7 01 01 01 B3 03 00' - 'AC D7 01 01 01 B3 03 00 5E 1D 00 01 08 B3 03 00 3D 21 00 01 01 B3 03 00 C4 D6 01 01 01 B3 03 00' - 'FE D6 01 01 01 B3 03 00 67 1D 00 01 09 B3 03 00 73 D7 01 01 01 B4 03 00 C5 D6 01 01 01 B4 03 00' - 'AD D7 01 01 01 B4 03 00 39 D7 01 01 01 B4 03 00 FF D6 01 01 01 B4 03 00 5F 1D 00 01 08 B4 03 00' - '72 1F 00 02 00 B5 03 00 00 03 00 AD 03 00 02 00 B5 03 00 01 03 00 12 1F 00 03 00 B5 03 00 13 03' - '00 00 03 00 14 1F 00 03 00 B5 03 00 13 03 00 01 03 00 10 1F 00 02 00 B5 03 00 13 03 00 13 1F 00' - '03 00 B5 03 00 14 03 00 00 03 00 15 1F 00 03 00 B5 03 00 14 03 00 01 03 00 11 1F 00 02 00 B5 03' - '00 14 03 00 74 D7 01 01 01 B5 03 00 3A D7 01 01 01 B5 03 00 50 D7 01 01 01 B5 03 00 F5 03 00 01' - '10 B5 03 00 C6 D6 01 01 01 B5 03 00 C4 D7 01 01 01 B5 03 00 DC D6 01 01 01 B5 03 00 00 D7 01 01' - '01 B5 03 00 16 D7 01 01 01 B5 03 00 AE D7 01 01 01 B5 03 00 8A D7 01 01 01 B5 03 00 AF D7 01 01' - '01 B6 03 00 01 D7 01 01 01 B6 03 00 C7 D6 01 01 01 B6 03 00 3B D7 01 01 01 B6 03 00 75 D7 01 01' - '01 B6 03 00 C2 1F 00 03 00 B7 03 00 00 03 00 45 03 00 74 1F 00 02 00 B7 03 00 00 03 00 C4 1F 00' - '03 00 B7 03 00 01 03 00 45 03 00 AE 03 00 02 00 B7 03 00 01 03 00 92 1F 00 04 00 B7 03 00 13 03' - '00 00 03 00 45 03 00 22 1F 00 03 00 B7 03 00 13 03 00 00 03 00 94 1F 00 04 00 B7 03 00 13 03 00' - '01 03 00 45 03 00 24 1F 00 03 00 B7 03 00 13 03 00 01 03 00 96 1F 00 04 00 B7 03 00 13 03 00 42' - '03 00 45 03 00 26 1F 00 03 00 B7 03 00 13 03 00 42 03 00 90 1F 00 03 00 B7 03 00 13 03 00 45 03' - '00 20 1F 00 02 00 B7 03 00 13 03 00 93 1F 00 04 00 B7 03 00 14 03 00 00 03 00 45 03 00 23 1F 00' - '03 00 B7 03 00 14 03 00 00 03 00 95 1F 00 04 00 B7 03 00 14 03 00 01 03 00 45 03 00 25 1F 00 03' - '00 B7 03 00 14 03 00 01 03 00 97 1F 00 04 00 B7 03 00 14 03 00 42 03 00 45 03 00 27 1F 00 03 00' - 'B7 03 00 14 03 00 42 03 00 91 1F 00 03 00 B7 03 00 14 03 00 45 03 00 21 1F 00 02 00 B7 03 00 14' - '03 00 C7 1F 00 03 00 B7 03 00 42 03 00 45 03 00 C6 1F 00 02 00 B7 03 00 42 03 00 C3 1F 00 02 00' - 'B7 03 00 45 03 00 3C D7 01 01 01 B7 03 00 B0 D7 01 01 01 B7 03 00 C8 D6 01 01 01 B7 03 00 02 D7' - '01 01 01 B7 03 00 76 D7 01 01 01 B7 03 00 C5 D7 01 01 01 B8 03 00 3D D7 01 01 01 B8 03 00 D1 03' - '00 01 10 B8 03 00 17 D7 01 01 01 B8 03 00 51 D7 01 01 01 B8 03 00 77 D7 01 01 01 B8 03 00 B1 D7' - '01 01 01 B8 03 00 C9 D6 01 01 01 B8 03 00 BF 1D 00 01 08 B8 03 00 8B D7 01 01 01 B8 03 00 03 D7' - '01 01 01 B8 03 00 DD D6 01 01 01 B8 03 00 76 1F 00 02 00 B9 03 00 00 03 00 AF 03 00 02 00 B9 03' - '00 01 03 00 D1 1F 00 02 00 B9 03 00 04 03 00 D0 1F 00 02 00 B9 03 00 06 03 00 D2 1F 00 03 00 B9' - '03 00 08 03 00 00 03 00 90 03 00 03 00 B9 03 00 08 03 00 01 03 00 D7 1F 00 03 00 B9 03 00 08 03' - '00 42 03 00 CA 03 00 02 00 B9 03 00 08 03 00 32 1F 00 03 00 B9 03 00 13 03 00 00 03 00 34 1F 00' - '03 00 B9 03 00 13 03 00 01 03 00 36 1F 00 03 00 B9 03 00 13 03 00 42 03 00 30 1F 00 02 00 B9 03' - '00 13 03 00 33 1F 00 03 00 B9 03 00 14 03 00 00 03 00 35 1F 00 03 00 B9 03 00 14 03 00 01 03 00' - '37 1F 00 03 00 B9 03 00 14 03 00 42 03 00 31 1F 00 02 00 B9 03 00 14 03 00 D6 1F 00 02 00 B9 03' - '00 42 03 00 04 D7 01 01 01 B9 03 00 B2 D7 01 01 01 B9 03 00 78 D7 01 01 01 B9 03 00 3E D7 01 01' - '01 B9 03 00 CA D6 01 01 01 B9 03 00 8C D7 01 01 01 BA 03 00 DE D6 01 01 01 BA 03 00 52 D7 01 01' - '01 BA 03 00 79 D7 01 01 01 BA 03 00 3F D7 01 01 01 BA 03 00 CB D6 01 01 01 BA 03 00 18 D7 01 01' - '01 BA 03 00 C6 D7 01 01 01 BA 03 00 B3 D7 01 01 01 BA 03 00 05 D7 01 01 01 BA 03 00 F0 03 00 01' - '10 BA 03 00 40 D7 01 01 01 BB 03 00 06 D7 01 01 01 BB 03 00 B4 D7 01 01 01 BB 03 00 CC D6 01 01' - '01 BB 03 00 7A D7 01 01 01 BB 03 00 82 33 00 02 0E BC 03 00 41 00 00 8C 33 00 02 0E BC 03 00 46' - '00 00 B6 33 00 02 0E BC 03 00 56 00 00 BC 33 00 02 0E BC 03 00 57 00 00 8D 33 00 02 0E BC 03 00' - '67 00 00 95 33 00 02 0E BC 03 00 6C 00 00 9B 33 00 02 0E BC 03 00 6D 00 00 B2 33 00 02 0E BC 03' - '00 73 00 00 B5 00 00 01 10 BC 03 00 CD D6 01 01 01 BC 03 00 7B D7 01 01 01 BC 03 00 B5 D7 01 01' - '01 BC 03 00 07 D7 01 01 01 BC 03 00 41 D7 01 01 01 BC 03 00 CE D6 01 01 01 BD 03 00 08 D7 01 01' - '01 BD 03 00 7C D7 01 01 01 BD 03 00 42 D7 01 01 01 BD 03 00 B6 D7 01 01 01 BD 03 00 CF D6 01 01' - '01 BE 03 00 7D D7 01 01 01 BE 03 00 B7 D7 01 01 01 BE 03 00 43 D7 01 01 01 BE 03 00 09 D7 01 01' - '01 BE 03 00 78 1F 00 02 00 BF 03 00 00 03 00 CC 03 00 02 00 BF 03 00 01 03 00 42 1F 00 03 00 BF' - '03 00 13 03 00 00 03 00 44 1F 00 03 00 BF 03 00 13 03 00 01 03 00 40 1F 00 02 00 BF 03 00 13 03' - '00 43 1F 00 03 00 BF 03 00 14 03 00 00 03 00 45 1F 00 03 00 BF 03 00 14 03 00 01 03 00 41 1F 00' - '02 00 BF 03 00 14 03 00 7E D7 01 01 01 BF 03 00 44 D7 01 01 01 BF 03 00 D0 D6 01 01 01 BF 03 00' - 'B8 D7 01 01 01 BF 03 00 0A D7 01 01 01 BF 03 00 8F D7 01 01 01 C0 03 00 7F D7 01 01 01 C0 03 00' - 'C9 D7 01 01 01 C0 03 00 D1 D6 01 01 01 C0 03 00 D6 03 00 01 10 C0 03 00 B9 D7 01 01 01 C0 03 00' - '45 D7 01 01 01 C0 03 00 E1 D6 01 01 01 C0 03 00 3C 21 00 01 01 C0 03 00 0B D7 01 01 01 C0 03 00' - '1B D7 01 01 01 C0 03 00 55 D7 01 01 01 C0 03 00 E4 1F 00 02 00 C1 03 00 13 03 00 E5 1F 00 02 00' - 'C1 03 00 14 03 00 0C D7 01 01 01 C1 03 00 80 D7 01 01 01 C1 03 00 BA D7 01 01 01 C1 03 00 54 D7' - '01 01 01 C1 03 00 46 D7 01 01 01 C1 03 00 8E D7 01 01 01 C1 03 00 68 1D 00 01 09 C1 03 00 E0 D6' - '01 01 01 C1 03 00 C8 D7 01 01 01 C1 03 00 D2 D6 01 01 01 C1 03 00 F1 03 00 01 10 C1 03 00 1A D7' - '01 01 01 C1 03 00 0D D7 01 01 01 C2 03 00 81 D7 01 01 01 C2 03 00 47 D7 01 01 01 C2 03 00 F2 03' - '00 01 10 C2 03 00 BB D7 01 01 01 C2 03 00 D3 D6 01 01 01 C2 03 00 82 D7 01 01 01 C3 03 00 BC D7' - '01 01 01 C3 03 00 48 D7 01 01 01 C3 03 00 0E D7 01 01 01 C3 03 00 D4 D6 01 01 01 C3 03 00 49 D7' - '01 01 01 C4 03 00 D5 D6 01 01 01 C4 03 00 83 D7 01 01 01 C4 03 00 BD D7 01 01 01 C4 03 00 0F D7' - '01 01 01 C4 03 00 7A 1F 00 02 00 C5 03 00 00 03 00 CD 03 00 02 00 C5 03 00 01 03 00 E1 1F 00 02' - '00 C5 03 00 04 03 00 E0 1F 00 02 00 C5 03 00 06 03 00 E2 1F 00 03 00 C5 03 00 08 03 00 00 03 00' - 'B0 03 00 03 00 C5 03 00 08 03 00 01 03 00 E7 1F 00 03 00 C5 03 00 08 03 00 42 03 00 CB 03 00 02' - '00 C5 03 00 08 03 00 52 1F 00 03 00 C5 03 00 13 03 00 00 03 00 54 1F 00 03 00 C5 03 00 13 03 00' - '01 03 00 56 1F 00 03 00 C5 03 00 13 03 00 42 03 00 50 1F 00 02 00 C5 03 00 13 03 00 53 1F 00 03' - '00 C5 03 00 14 03 00 00 03 00 55 1F 00 03 00 C5 03 00 14 03 00 01 03 00 57 1F 00 03 00 C5 03 00' - '14 03 00 42 03 00 51 1F 00 02 00 C5 03 00 14 03 00 E6 1F 00 02 00 C5 03 00 42 03 00 84 D7 01 01' - '01 C5 03 00 D6 D6 01 01 01 C5 03 00 4A D7 01 01 01 C5 03 00 10 D7 01 01 01 C5 03 00 BE D7 01 01' - '01 C5 03 00 BF D7 01 01 01 C6 03 00 19 D7 01 01 01 C6 03 00 C7 D7 01 01 01 C6 03 00 4B D7 01 01' - '01 C6 03 00 85 D7 01 01 01 C6 03 00 8D D7 01 01 01 C6 03 00 53 D7 01 01 01 C6 03 00 60 1D 00 01' - '08 C6 03 00 D5 03 00 01 10 C6 03 00 D7 D6 01 01 01 C6 03 00 69 1D 00 01 09 C6 03 00 11 D7 01 01' - '01 C6 03 00 DF D6 01 01 01 C6 03 00 61 1D 00 01 08 C7 03 00 C0 D7 01 01 01 C7 03 00 4C D7 01 01' - '01 C7 03 00 12 D7 01 01 01 C7 03 00 D8 D6 01 01 01 C7 03 00 86 D7 01 01 01 C7 03 00 6A 1D 00 01' - '09 C7 03 00 13 D7 01 01 01 C8 03 00 C1 D7 01 01 01 C8 03 00 87 D7 01 01 01 C8 03 00 D9 D6 01 01' - '01 C8 03 00 4D D7 01 01 01 C8 03 00 F2 1F 00 03 00 C9 03 00 00 03 00 45 03 00 7C 1F 00 02 00 C9' - '03 00 00 03 00 F4 1F 00 03 00 C9 03 00 01 03 00 45 03 00 CE 03 00 02 00 C9 03 00 01 03 00 A2 1F' - '00 04 00 C9 03 00 13 03 00 00 03 00 45 03 00 62 1F 00 03 00 C9 03 00 13 03 00 00 03 00 A4 1F 00' - '04 00 C9 03 00 13 03 00 01 03 00 45 03 00 64 1F 00 03 00 C9 03 00 13 03 00 01 03 00 A6 1F 00 04' - '00 C9 03 00 13 03 00 42 03 00 45 03 00 66 1F 00 03 00 C9 03 00 13 03 00 42 03 00 A0 1F 00 03 00' - 'C9 03 00 13 03 00 45 03 00 60 1F 00 02 00 C9 03 00 13 03 00 A3 1F 00 04 00 C9 03 00 14 03 00 00' - '03 00 45 03 00 63 1F 00 03 00 C9 03 00 14 03 00 00 03 00 A5 1F 00 04 00 C9 03 00 14 03 00 01 03' - '00 45 03 00 65 1F 00 03 00 C9 03 00 14 03 00 01 03 00 A7 1F 00 04 00 C9 03 00 14 03 00 42 03 00' - '45 03 00 67 1F 00 03 00 C9 03 00 14 03 00 42 03 00 A1 1F 00 03 00 C9 03 00 14 03 00 45 03 00 61' - '1F 00 02 00 C9 03 00 14 03 00 F7 1F 00 03 00 C9 03 00 42 03 00 45 03 00 F6 1F 00 02 00 C9 03 00' - '42 03 00 F3 1F 00 02 00 C9 03 00 45 03 00 88 D7 01 01 01 C9 03 00 DA D6 01 01 01 C9 03 00 C2 D7' - '01 01 01 C9 03 00 4E D7 01 01 01 C9 03 00 14 D7 01 01 01 C9 03 00 CA D7 01 01 01 DC 03 00 CB D7' - '01 01 01 DD 03 00 07 04 00 02 00 06 04 00 08 03 00 D0 04 00 02 00 10 04 00 06 03 00 D2 04 00 02' - '00 10 04 00 08 03 00 03 04 00 02 00 13 04 00 01 03 00 00 04 00 02 00 15 04 00 00 03 00 D6 04 00' - '02 00 15 04 00 06 03 00 01 04 00 02 00 15 04 00 08 03 00 C1 04 00 02 00 16 04 00 06 03 00 DC 04' - '00 02 00 16 04 00 08 03 00 DE 04 00 02 00 17 04 00 08 03 00 0D 04 00 02 00 18 04 00 00 03 00 E2' - '04 00 02 00 18 04 00 04 03 00 19 04 00 02 00 18 04 00 06 03 00 E4 04 00 02 00 18 04 00 08 03 00' - '0C 04 00 02 00 1A 04 00 01 03 00 E6 04 00 02 00 1E 04 00 08 03 00 EE 04 00 02 00 23 04 00 04 03' - '00 0E 04 00 02 00 23 04 00 06 03 00 F0 04 00 02 00 23 04 00 08 03 00 F2 04 00 02 00 23 04 00 0B' - '03 00 F4 04 00 02 00 27 04 00 08 03 00 F8 04 00 02 00 2B 04 00 08 03 00 EC 04 00 02 00 2D 04 00' - '08 03 00 D1 04 00 02 00 30 04 00 06 03 00 D3 04 00 02 00 30 04 00 08 03 00 53 04 00 02 00 33 04' - '00 01 03 00 50 04 00 02 00 35 04 00 00 03 00 D7 04 00 02 00 35 04 00 06 03 00 51 04 00 02 00 35' - '04 00 08 03 00 C2 04 00 02 00 36 04 00 06 03 00 DD 04 00 02 00 36 04 00 08 03 00 DF 04 00 02 00' - '37 04 00 08 03 00 5D 04 00 02 00 38 04 00 00 03 00 E3 04 00 02 00 38 04 00 04 03 00 39 04 00 02' - '00 38 04 00 06 03 00 E5 04 00 02 00 38 04 00 08 03 00 5C 04 00 02 00 3A 04 00 01 03 00 78 1D 00' - '01 08 3D 04 00 E7 04 00 02 00 3E 04 00 08 03 00 EF 04 00 02 00 43 04 00 04 03 00 5E 04 00 02 00' - '43 04 00 06 03 00 F1 04 00 02 00 43 04 00 08 03 00 F3 04 00 02 00 43 04 00 0B 03 00 F5 04 00 02' - '00 47 04 00 08 03 00 9C A6 00 01 08 4A 04 00 F9 04 00 02 00 4B 04 00 08 03 00 9D A6 00 01 08 4C' - '04 00 ED 04 00 02 00 4D 04 00 08 03 00 57 04 00 02 00 56 04 00 08 03 00 76 04 00 02 00 74 04 00' - '0F 03 00 77 04 00 02 00 75 04 00 0F 03 00 DA 04 00 02 00 D8 04 00 08 03 00 DB 04 00 02 00 D9 04' - '00 08 03 00 EA 04 00 02 00 E8 04 00 08 03 00 EB 04 00 02 00 E9 04 00 08 03 00 87 05 00 02 10 65' - '05 00 82 05 00 14 FB 00 02 10 74 05 00 65 05 00 15 FB 00 02 10 74 05 00 6B 05 00 17 FB 00 02 10' - '74 05 00 6D 05 00 13 FB 00 02 10 74 05 00 76 05 00 16 FB 00 02 10 7E 05 00 76 05 00 4F FB 00 02' - '10 D0 05 00 DC 05 00 21 FB 00 01 01 D0 05 00 35 21 00 01 10 D0 05 00 36 21 00 01 10 D1 05 00 37' - '21 00 01 10 D2 05 00 22 FB 00 01 01 D3 05 00 38 21 00 01 10 D3 05 00 23 FB 00 01 01 D4 05 00 24' - 'FB 00 01 01 DB 05 00 25 FB 00 01 01 DC 05 00 26 FB 00 01 01 DD 05 00 20 FB 00 01 01 E2 05 00 27' - 'FB 00 01 01 E8 05 00 28 FB 00 01 01 EA 05 00 80 FE 00 01 06 21 06 00 F3 FD 00 04 06 27 06 00 43' - '06 00 28 06 00 31 06 00 F2 FD 00 04 06 27 06 00 44 06 00 44 06 00 47 06 00 3D FD 00 02 06 27 06' - '00 4B 06 00 3C FD 00 02 05 27 06 00 4B 06 00 82 FE 00 02 05 27 06 00 53 06 00 22 06 00 02 00 27' - '06 00 53 06 00 81 FE 00 02 06 27 06 00 53 06 00 23 06 00 02 00 27 06 00 54 06 00 84 FE 00 02 05' - '27 06 00 54 06 00 83 FE 00 02 06 27 06 00 54 06 00 25 06 00 02 00 27 06 00 55 06 00 88 FE 00 02' - '05 27 06 00 55 06 00 87 FE 00 02 06 27 06 00 55 06 00 75 06 00 02 10 27 06 00 74 06 00 80 EE 01' - '01 01 27 06 00 8D FE 00 01 06 27 06 00 00 EE 01 01 01 27 06 00 8E FE 00 01 05 27 06 00 05 FC 00' - '02 06 28 06 00 2C 06 00 9C FC 00 02 03 28 06 00 2C 06 00 C2 FD 00 03 05 28 06 00 2D 06 00 4A 06' - '00 9D FC 00 02 03 28 06 00 2D 06 00 06 FC 00 02 06 28 06 00 2D 06 00 9E FD 00 03 05 28 06 00 2E' - '06 00 4A 06 00 07 FC 00 02 06 28 06 00 2E 06 00 9E FC 00 02 03 28 06 00 2E 06 00 6A FC 00 02 05' - '28 06 00 31 06 00 6B FC 00 02 05 28 06 00 32 06 00 08 FC 00 02 06 28 06 00 45 06 00 9F FC 00 02' - '03 28 06 00 45 06 00 E1 FC 00 02 04 28 06 00 45 06 00 6C FC 00 02 05 28 06 00 45 06 00 6D FC 00' - '02 05 28 06 00 46 06 00 A0 FC 00 02 03 28 06 00 47 06 00 E2 FC 00 02 04 28 06 00 47 06 00 09 FC' - '00 02 06 28 06 00 49 06 00 6E FC 00 02 05 28 06 00 49 06 00 0A FC 00 02 06 28 06 00 4A 06 00 6F' - 'FC 00 02 05 28 06 00 4A 06 00 61 EE 01 01 01 28 06 00 21 EE 01 01 01 28 06 00 91 FE 00 01 03 28' - '06 00 8F FE 00 01 06 28 06 00 90 FE 00 01 05 28 06 00 01 EE 01 01 01 28 06 00 A1 EE 01 01 01 28' - '06 00 81 EE 01 01 01 28 06 00 92 FE 00 01 04 28 06 00 94 FE 00 01 05 29 06 00 93 FE 00 01 06 29' - '06 00 50 FD 00 03 03 2A 06 00 2C 06 00 45 06 00 A0 FD 00 03 05 2A 06 00 2C 06 00 49 06 00 9F FD' - '00 03 05 2A 06 00 2C 06 00 4A 06 00 0B FC 00 02 06 2A 06 00 2C 06 00 A1 FC 00 02 03 2A 06 00 2C' - '06 00 52 FD 00 03 03 2A 06 00 2D 06 00 2C 06 00 51 FD 00 03 05 2A 06 00 2D 06 00 2C 06 00 53 FD' - '00 03 03 2A 06 00 2D 06 00 45 06 00 0C FC 00 02 06 2A 06 00 2D 06 00 A2 FC 00 02 03 2A 06 00 2D' - '06 00 54 FD 00 03 03 2A 06 00 2E 06 00 45 06 00 A2 FD 00 03 05 2A 06 00 2E 06 00 49 06 00 A1 FD' - '00 03 05 2A 06 00 2E 06 00 4A 06 00 0D FC 00 02 06 2A 06 00 2E 06 00 A3 FC 00 02 03 2A 06 00 2E' - '06 00 70 FC 00 02 05 2A 06 00 31 06 00 71 FC 00 02 05 2A 06 00 32 06 00 55 FD 00 03 03 2A 06 00' - '45 06 00 2C 06 00 56 FD 00 03 03 2A 06 00 45 06 00 2D 06 00 57 FD 00 03 03 2A 06 00 45 06 00 2E' - '06 00 A4 FD 00 03 05 2A 06 00 45 06 00 49 06 00 A3 FD 00 03 05 2A 06 00 45 06 00 4A 06 00 0E FC' - '00 02 06 2A 06 00 45 06 00 A4 FC 00 02 03 2A 06 00 45 06 00 E3 FC 00 02 04 2A 06 00 45 06 00 72' - 'FC 00 02 05 2A 06 00 45 06 00 73 FC 00 02 05 2A 06 00 46 06 00 A5 FC 00 02 03 2A 06 00 47 06 00' - 'E4 FC 00 02 04 2A 06 00 47 06 00 74 FC 00 02 05 2A 06 00 49 06 00 0F FC 00 02 06 2A 06 00 49 06' - '00 75 FC 00 02 05 2A 06 00 4A 06 00 10 FC 00 02 06 2A 06 00 4A 06 00 75 EE 01 01 01 2A 06 00 95' - 'FE 00 01 06 2A 06 00 15 EE 01 01 01 2A 06 00 35 EE 01 01 01 2A 06 00 95 EE 01 01 01 2A 06 00 98' - 'FE 00 01 04 2A 06 00 97 FE 00 01 03 2A 06 00 96 FE 00 01 05 2A 06 00 B5 EE 01 01 01 2A 06 00 11' - 'FC 00 02 06 2B 06 00 2C 06 00 76 FC 00 02 05 2B 06 00 31 06 00 77 FC 00 02 05 2B 06 00 32 06 00' - '78 FC 00 02 05 2B 06 00 45 06 00 E5 FC 00 02 04 2B 06 00 45 06 00 A6 FC 00 02 03 2B 06 00 45 06' - '00 12 FC 00 02 06 2B 06 00 45 06 00 79 FC 00 02 05 2B 06 00 46 06 00 E6 FC 00 02 04 2B 06 00 47' - '06 00 7A FC 00 02 05 2B 06 00 49 06 00 13 FC 00 02 06 2B 06 00 49 06 00 14 FC 00 02 06 2B 06 00' - '4A 06 00 7B FC 00 02 05 2B 06 00 4A 06 00 B6 EE 01 01 01 2B 06 00 96 EE 01 01 01 2B 06 00 9B FE' - '00 01 03 2B 06 00 9C FE 00 01 04 2B 06 00 99 FE 00 01 06 2B 06 00 9A FE 00 01 05 2B 06 00 36 EE' - '01 01 01 2B 06 00 76 EE 01 01 01 2B 06 00 16 EE 01 01 01 2B 06 00 A6 FD 00 03 05 2C 06 00 2D 06' - '00 49 06 00 BE FD 00 03 05 2C 06 00 2D 06 00 4A 06 00 A7 FC 00 02 03 2C 06 00 2D 06 00 15 FC 00' - '02 06 2C 06 00 2D 06 00 FB FD 00 08 06 2C 06 00 44 06 00 20 00 00 2C 06 00 44 06 00 27 06 00 44' - '06 00 47 06 00 58 FD 00 03 05 2C 06 00 45 06 00 2D 06 00 59 FD 00 03 03 2C 06 00 45 06 00 2D 06' - '00 A7 FD 00 03 05 2C 06 00 45 06 00 49 06 00 A5 FD 00 03 05 2C 06 00 45 06 00 4A 06 00 A8 FC 00' - '02 03 2C 06 00 45 06 00 16 FC 00 02 06 2C 06 00 45 06 00 1D FD 00 02 05 2C 06 00 49 06 00 01 FD' - '00 02 06 2C 06 00 49 06 00 02 FD 00 02 06 2C 06 00 4A 06 00 1E FD 00 02 05 2C 06 00 4A 06 00 9E' - 'FE 00 01 05 2C 06 00 9F FE 00 01 03 2C 06 00 9D FE 00 01 06 2C 06 00 A2 EE 01 01 01 2C 06 00 82' - 'EE 01 01 01 2C 06 00 62 EE 01 01 01 2C 06 00 42 EE 01 01 01 2C 06 00 02 EE 01 01 01 2C 06 00 22' - 'EE 01 01 01 2C 06 00 A0 FE 00 01 04 2C 06 00 BF FD 00 03 05 2D 06 00 2C 06 00 4A 06 00 A9 FC 00' - '02 03 2D 06 00 2C 06 00 17 FC 00 02 06 2D 06 00 2C 06 00 5B FD 00 03 05 2D 06 00 45 06 00 49 06' - '00 5A FD 00 03 05 2D 06 00 45 06 00 4A 06 00 18 FC 00 02 06 2D 06 00 45 06 00 AA FC 00 02 03 2D' - '06 00 45 06 00 1B FD 00 02 05 2D 06 00 49 06 00 FF FC 00 02 06 2D 06 00 49 06 00 1C FD 00 02 05' - '2D 06 00 4A 06 00 00 FD 00 02 06 2D 06 00 4A 06 00 47 EE 01 01 01 2D 06 00 67 EE 01 01 01 2D 06' - '00 87 EE 01 01 01 2D 06 00 A7 EE 01 01 01 2D 06 00 A4 FE 00 01 04 2D 06 00 07 EE 01 01 01 2D 06' - '00 27 EE 01 01 01 2D 06 00 A1 FE 00 01 06 2D 06 00 A3 FE 00 01 03 2D 06 00 A2 FE 00 01 05 2D 06' - '00 AB FC 00 02 03 2E 06 00 2C 06 00 19 FC 00 02 06 2E 06 00 2C 06 00 1A FC 00 02 06 2E 06 00 2D' - '06 00 1B FC 00 02 06 2E 06 00 45 06 00 AC FC 00 02 03 2E 06 00 45 06 00 03 FD 00 02 06 2E 06 00' - '49 06 00 1F FD 00 02 05 2E 06 00 49 06 00 20 FD 00 02 05 2E 06 00 4A 06 00 04 FD 00 02 06 2E 06' - '00 4A 06 00 17 EE 01 01 01 2E 06 00 77 EE 01 01 01 2E 06 00 B7 EE 01 01 01 2E 06 00 A5 FE 00 01' - '06 2E 06 00 A6 FE 00 01 05 2E 06 00 A7 FE 00 01 03 2E 06 00 A8 FE 00 01 04 2E 06 00 97 EE 01 01' - '01 2E 06 00 37 EE 01 01 01 2E 06 00 57 EE 01 01 01 2E 06 00 A9 FE 00 01 06 2F 06 00 03 EE 01 01' - '01 2F 06 00 83 EE 01 01 01 2F 06 00 A3 EE 01 01 01 2F 06 00 AA FE 00 01 05 2F 06 00 5B FC 00 02' - '06 30 06 00 70 06 00 B8 EE 01 01 01 30 06 00 98 EE 01 01 01 30 06 00 18 EE 01 01 01 30 06 00 AB' - 'FE 00 01 06 30 06 00 AC FE 00 01 05 30 06 00 F6 FD 00 04 06 31 06 00 33 06 00 48 06 00 44 06 00' - '5C FC 00 02 06 31 06 00 70 06 00 FC FD 00 04 06 31 06 00 CC 06 00 27 06 00 44 06 00 13 EE 01 01' - '01 31 06 00 B3 EE 01 01 01 31 06 00 AD FE 00 01 06 31 06 00 93 EE 01 01 01 31 06 00 AE FE 00 01' - '05 31 06 00 B0 FE 00 01 05 32 06 00 A6 EE 01 01 01 32 06 00 86 EE 01 01 01 32 06 00 06 EE 01 01' - '01 32 06 00 AF FE 00 01 06 32 06 00 5D FD 00 03 03 33 06 00 2C 06 00 2D 06 00 5E FD 00 03 05 33' - '06 00 2C 06 00 49 06 00 1C FC 00 02 06 33 06 00 2C 06 00 34 FD 00 02 04 33 06 00 2C 06 00 AD FC' - '00 02 03 33 06 00 2C 06 00 5C FD 00 03 03 33 06 00 2D 06 00 2C 06 00 35 FD 00 02 04 33 06 00 2D' - '06 00 1D FC 00 02 06 33 06 00 2D 06 00 AE FC 00 02 03 33 06 00 2D 06 00 A8 FD 00 03 05 33 06 00' - '2E 06 00 49 06 00 C6 FD 00 03 05 33 06 00 2E 06 00 4A 06 00 AF FC 00 02 03 33 06 00 2E 06 00 1E' - 'FC 00 02 06 33 06 00 2E 06 00 36 FD 00 02 04 33 06 00 2E 06 00 2A FD 00 02 05 33 06 00 31 06 00' - '0E FD 00 02 06 33 06 00 31 06 00 61 FD 00 03 03 33 06 00 45 06 00 2C 06 00 60 FD 00 03 03 33 06' - '00 45 06 00 2D 06 00 5F FD 00 03 05 33 06 00 45 06 00 2D 06 00 62 FD 00 03 05 33 06 00 45 06 00' - '45 06 00 63 FD 00 03 03 33 06 00 45 06 00 45 06 00 E7 FC 00 02 04 33 06 00 45 06 00 1F FC 00 02' - '06 33 06 00 45 06 00 B0 FC 00 02 03 33 06 00 45 06 00 31 FD 00 02 03 33 06 00 47 06 00 E8 FC 00' - '02 04 33 06 00 47 06 00 FB FC 00 02 06 33 06 00 49 06 00 17 FD 00 02 05 33 06 00 49 06 00 18 FD' - '00 02 05 33 06 00 4A 06 00 FC FC 00 02 06 33 06 00 4A 06 00 0E EE 01 01 01 33 06 00 8E EE 01 01' - '01 33 06 00 AE EE 01 01 01 33 06 00 B1 FE 00 01 06 33 06 00 B2 FE 00 01 05 33 06 00 4E EE 01 01' - '01 33 06 00 6E EE 01 01 01 33 06 00 2E EE 01 01 01 33 06 00 B4 FE 00 01 04 33 06 00 B3 FE 00 01' - '03 33 06 00 69 FD 00 03 05 34 06 00 2C 06 00 4A 06 00 37 FD 00 02 04 34 06 00 2C 06 00 09 FD 00' - '02 06 34 06 00 2C 06 00 2D FD 00 02 03 34 06 00 2C 06 00 25 FD 00 02 05 34 06 00 2C 06 00 68 FD' - '00 03 03 34 06 00 2D 06 00 45 06 00 67 FD 00 03 05 34 06 00 2D 06 00 45 06 00 AA FD 00 03 05 34' - '06 00 2D 06 00 4A 06 00 38 FD 00 02 04 34 06 00 2D 06 00 2E FD 00 02 03 34 06 00 2D 06 00 26 FD' - '00 02 05 34 06 00 2D 06 00 0A FD 00 02 06 34 06 00 2D 06 00 0B FD 00 02 06 34 06 00 2E 06 00 39' - 'FD 00 02 04 34 06 00 2E 06 00 27 FD 00 02 05 34 06 00 2E 06 00 2F FD 00 02 03 34 06 00 2E 06 00' - '29 FD 00 02 05 34 06 00 31 06 00 0D FD 00 02 06 34 06 00 31 06 00 6B FD 00 03 03 34 06 00 45 06' - '00 2E 06 00 6A FD 00 03 05 34 06 00 45 06 00 2E 06 00 6D FD 00 03 03 34 06 00 45 06 00 45 06 00' - '6C FD 00 03 05 34 06 00 45 06 00 45 06 00 28 FD 00 02 05 34 06 00 45 06 00 0C FD 00 02 06 34 06' - '00 45 06 00 E9 FC 00 02 04 34 06 00 45 06 00 30 FD 00 02 03 34 06 00 45 06 00 EA FC 00 02 04 34' - '06 00 47 06 00 32 FD 00 02 03 34 06 00 47 06 00 FD FC 00 02 06 34 06 00 49 06 00 19 FD 00 02 05' - '34 06 00 49 06 00 FE FC 00 02 06 34 06 00 4A 06 00 1A FD 00 02 05 34 06 00 4A 06 00 B8 FE 00 01' - '04 34 06 00 74 EE 01 01 01 34 06 00 14 EE 01 01 01 34 06 00 B4 EE 01 01 01 34 06 00 34 EE 01 01' - '01 34 06 00 B5 FE 00 01 06 34 06 00 94 EE 01 01 01 34 06 00 B6 FE 00 01 05 34 06 00 54 EE 01 01' - '01 34 06 00 B7 FE 00 01 03 34 06 00 64 FD 00 03 05 35 06 00 2D 06 00 2D 06 00 65 FD 00 03 03 35' - '06 00 2D 06 00 2D 06 00 A9 FD 00 03 05 35 06 00 2D 06 00 4A 06 00 20 FC 00 02 06 35 06 00 2D 06' - '00 B1 FC 00 02 03 35 06 00 2D 06 00 B2 FC 00 02 03 35 06 00 2E 06 00 2B FD 00 02 05 35 06 00 31' - '06 00 0F FD 00 02 06 35 06 00 31 06 00 F5 FD 00 04 06 35 06 00 44 06 00 39 06 00 45 06 00 FA FD' - '00 12 06 35 06 00 44 06 00 49 06 00 20 00 00 27 06 00 44 06 00 44 06 00 47 06 00 20 00 00 39 06' - '00 44 06 00 4A 06 00 47 06 00 20 00 00 48 06 00 33 06 00 44 06 00 45 06 00 F9 FD 00 03 06 35 06' - '00 44 06 00 49 06 00 F0 FD 00 03 06 35 06 00 44 06 00 D2 06 00 C5 FD 00 03 03 35 06 00 45 06 00' - '45 06 00 66 FD 00 03 05 35 06 00 45 06 00 45 06 00 B3 FC 00 02 03 35 06 00 45 06 00 21 FC 00 02' - '06 35 06 00 45 06 00 21 FD 00 02 05 35 06 00 49 06 00 05 FD 00 02 06 35 06 00 49 06 00 22 FD 00' - '02 05 35 06 00 4A 06 00 06 FD 00 02 06 35 06 00 4A 06 00 BB FE 00 01 03 35 06 00 71 EE 01 01 01' - '35 06 00 11 EE 01 01 01 35 06 00 BC FE 00 01 04 35 06 00 91 EE 01 01 01 35 06 00 BA FE 00 01 05' - '35 06 00 51 EE 01 01 01 35 06 00 B1 EE 01 01 01 35 06 00 31 EE 01 01 01 35 06 00 B9 FE 00 01 06' - '35 06 00 22 FC 00 02 06 36 06 00 2C 06 00 B4 FC 00 02 03 36 06 00 2C 06 00 6E FD 00 03 05 36 06' - '00 2D 06 00 49 06 00 AB FD 00 03 05 36 06 00 2D 06 00 4A 06 00 23 FC 00 02 06 36 06 00 2D 06 00' - 'B5 FC 00 02 03 36 06 00 2D 06 00 6F FD 00 03 05 36 06 00 2E 06 00 45 06 00 70 FD 00 03 03 36 06' - '00 2E 06 00 45 06 00 24 FC 00 02 06 36 06 00 2E 06 00 B6 FC 00 02 03 36 06 00 2E 06 00 10 FD 00' - '02 06 36 06 00 31 06 00 2C FD 00 02 05 36 06 00 31 06 00 25 FC 00 02 06 36 06 00 45 06 00 B7 FC' - '00 02 03 36 06 00 45 06 00 23 FD 00 02 05 36 06 00 49 06 00 07 FD 00 02 06 36 06 00 49 06 00 24' - 'FD 00 02 05 36 06 00 4A 06 00 08 FD 00 02 06 36 06 00 4A 06 00 19 EE 01 01 01 36 06 00 59 EE 01' - '01 01 36 06 00 79 EE 01 01 01 36 06 00 B9 EE 01 01 01 36 06 00 BF FE 00 01 03 36 06 00 BE FE 00' - '01 05 36 06 00 39 EE 01 01 01 36 06 00 99 EE 01 01 01 36 06 00 BD FE 00 01 06 36 06 00 C0 FE 00' - '01 04 36 06 00 B8 FC 00 02 03 37 06 00 2D 06 00 26 FC 00 02 06 37 06 00 2D 06 00 71 FD 00 03 05' - '37 06 00 45 06 00 2D 06 00 72 FD 00 03 03 37 06 00 45 06 00 2D 06 00 73 FD 00 03 03 37 06 00 45' - '06 00 45 06 00 74 FD 00 03 05 37 06 00 45 06 00 4A 06 00 27 FC 00 02 06 37 06 00 45 06 00 3A FD' - '00 02 04 37 06 00 45 06 00 33 FD 00 02 03 37 06 00 45 06 00 11 FD 00 02 05 37 06 00 49 06 00 F5' - 'FC 00 02 06 37 06 00 49 06 00 12 FD 00 02 05 37 06 00 4A 06 00 F6 FC 00 02 06 37 06 00 4A 06 00' - '08 EE 01 01 01 37 06 00 88 EE 01 01 01 37 06 00 68 EE 01 01 01 37 06 00 C2 FE 00 01 05 37 06 00' - 'C1 FE 00 01 06 37 06 00 C3 FE 00 01 03 37 06 00 A8 EE 01 01 01 37 06 00 C4 FE 00 01 04 37 06 00' - '3B FD 00 02 04 38 06 00 45 06 00 B9 FC 00 02 03 38 06 00 45 06 00 28 FC 00 02 06 38 06 00 45 06' - '00 C5 FE 00 01 06 38 06 00 7A EE 01 01 01 38 06 00 C6 FE 00 01 05 38 06 00 1A EE 01 01 01 38 06' - '00 BA EE 01 01 01 38 06 00 C7 FE 00 01 03 38 06 00 C8 FE 00 01 04 38 06 00 9A EE 01 01 01 38 06' - '00 75 FD 00 03 05 39 06 00 2C 06 00 45 06 00 C4 FD 00 03 03 39 06 00 2C 06 00 45 06 00 29 FC 00' - '02 06 39 06 00 2C 06 00 BA FC 00 02 03 39 06 00 2C 06 00 F7 FD 00 04 06 39 06 00 44 06 00 4A 06' - '00 47 06 00 77 FD 00 03 03 39 06 00 45 06 00 45 06 00 76 FD 00 03 05 39 06 00 45 06 00 45 06 00' - '78 FD 00 03 05 39 06 00 45 06 00 49 06 00 B6 FD 00 03 05 39 06 00 45 06 00 4A 06 00 BB FC 00 02' - '03 39 06 00 45 06 00 2A FC 00 02 06 39 06 00 45 06 00 13 FD 00 02 05 39 06 00 49 06 00 F7 FC 00' - '02 06 39 06 00 49 06 00 14 FD 00 02 05 39 06 00 4A 06 00 F8 FC 00 02 06 39 06 00 4A 06 00 4F EE' - '01 01 01 39 06 00 C9 FE 00 01 06 39 06 00 CA FE 00 01 05 39 06 00 2F EE 01 01 01 39 06 00 CC FE' - '00 01 04 39 06 00 CB FE 00 01 03 39 06 00 AF EE 01 01 01 39 06 00 6F EE 01 01 01 39 06 00 8F EE' - '01 01 01 39 06 00 0F EE 01 01 01 39 06 00 2B FC 00 02 06 3A 06 00 2C 06 00 BC FC 00 02 03 3A 06' - '00 2C 06 00 79 FD 00 03 05 3A 06 00 45 06 00 45 06 00 7B FD 00 03 05 3A 06 00 45 06 00 49 06 00' - '7A FD 00 03 05 3A 06 00 45 06 00 4A 06 00 2C FC 00 02 06 3A 06 00 45 06 00 BD FC 00 02 03 3A 06' - '00 45 06 00 F9 FC 00 02 06 3A 06 00 49 06 00 15 FD 00 02 05 3A 06 00 49 06 00 FA FC 00 02 06 3A' - '06 00 4A 06 00 16 FD 00 02 05 3A 06 00 4A 06 00 9B EE 01 01 01 3A 06 00 3B EE 01 01 01 3A 06 00' - 'CD FE 00 01 06 3A 06 00 CE FE 00 01 05 3A 06 00 5B EE 01 01 01 3A 06 00 7B EE 01 01 01 3A 06 00' - 'BB EE 01 01 01 3A 06 00 CF FE 00 01 03 3A 06 00 D0 FE 00 01 04 3A 06 00 1B EE 01 01 01 3A 06 00' - '71 FE 00 02 04 40 06 00 4B 06 00 F2 FC 00 03 04 40 06 00 4E 06 00 51 06 00 77 FE 00 02 04 40 06' - '00 4E 06 00 F3 FC 00 03 04 40 06 00 4F 06 00 51 06 00 79 FE 00 02 04 40 06 00 4F 06 00 F4 FC 00' - '03 04 40 06 00 50 06 00 51 06 00 7B FE 00 02 04 40 06 00 50 06 00 7D FE 00 02 04 40 06 00 51 06' - '00 7F FE 00 02 04 40 06 00 52 06 00 BE FC 00 02 03 41 06 00 2C 06 00 2D FC 00 02 06 41 06 00 2C' - '06 00 BF FC 00 02 03 41 06 00 2D 06 00 2E FC 00 02 06 41 06 00 2D 06 00 7D FD 00 03 03 41 06 00' - '2E 06 00 45 06 00 7C FD 00 03 05 41 06 00 2E 06 00 45 06 00 2F FC 00 02 06 41 06 00 2E 06 00 C0' - 'FC 00 02 03 41 06 00 2E 06 00 C1 FD 00 03 05 41 06 00 45 06 00 4A 06 00 C1 FC 00 02 03 41 06 00' - '45 06 00 30 FC 00 02 06 41 06 00 45 06 00 31 FC 00 02 06 41 06 00 49 06 00 7C FC 00 02 05 41 06' - '00 49 06 00 7D FC 00 02 05 41 06 00 4A 06 00 32 FC 00 02 06 41 06 00 4A 06 00 B0 EE 01 01 01 41' - '06 00 D3 FE 00 01 03 41 06 00 D4 FE 00 01 04 41 06 00 D1 FE 00 01 06 41 06 00 D2 FE 00 01 05 41' - '06 00 70 EE 01 01 01 41 06 00 90 EE 01 01 01 41 06 00 10 EE 01 01 01 41 06 00 30 EE 01 01 01 41' - '06 00 C2 FC 00 02 03 42 06 00 2D 06 00 33 FC 00 02 06 42 06 00 2D 06 00 F1 FD 00 03 06 42 06 00' - '44 06 00 D2 06 00 7E FD 00 03 05 42 06 00 45 06 00 2D 06 00 B4 FD 00 03 03 42 06 00 45 06 00 2D' - '06 00 7F FD 00 03 05 42 06 00 45 06 00 45 06 00 B2 FD 00 03 05 42 06 00 45 06 00 4A 06 00 34 FC' - '00 02 06 42 06 00 45 06 00 C3 FC 00 02 03 42 06 00 45 06 00 7E FC 00 02 05 42 06 00 49 06 00 35' - 'FC 00 02 06 42 06 00 49 06 00 36 FC 00 02 06 42 06 00 4A 06 00 7F FC 00 02 05 42 06 00 4A 06 00' - '32 EE 01 01 01 42 06 00 B2 EE 01 01 01 42 06 00 D5 FE 00 01 06 42 06 00 92 EE 01 01 01 42 06 00' - '12 EE 01 01 01 42 06 00 D6 FE 00 01 05 42 06 00 52 EE 01 01 01 42 06 00 D8 FE 00 01 04 42 06 00' - 'D7 FE 00 01 03 42 06 00 72 EE 01 01 01 42 06 00 80 FC 00 02 05 43 06 00 27 06 00 37 FC 00 02 06' - '43 06 00 27 06 00 38 FC 00 02 06 43 06 00 2C 06 00 C4 FC 00 02 03 43 06 00 2C 06 00 C5 FC 00 02' - '03 43 06 00 2D 06 00 39 FC 00 02 06 43 06 00 2D 06 00 3A FC 00 02 06 43 06 00 2E 06 00 C6 FC 00' - '02 03 43 06 00 2E 06 00 3B FC 00 02 06 43 06 00 44 06 00 81 FC 00 02 05 43 06 00 44 06 00 C7 FC' - '00 02 03 43 06 00 44 06 00 EB FC 00 02 04 43 06 00 44 06 00 BB FD 00 03 05 43 06 00 45 06 00 45' - '06 00 C3 FD 00 03 03 43 06 00 45 06 00 45 06 00 B7 FD 00 03 05 43 06 00 45 06 00 4A 06 00 EC FC' - '00 02 04 43 06 00 45 06 00 82 FC 00 02 05 43 06 00 45 06 00 3C FC 00 02 06 43 06 00 45 06 00 C8' - 'FC 00 02 03 43 06 00 45 06 00 3D FC 00 02 06 43 06 00 49 06 00 83 FC 00 02 05 43 06 00 49 06 00' - '84 FC 00 02 05 43 06 00 4A 06 00 3E FC 00 02 06 43 06 00 4A 06 00 6A EE 01 01 01 43 06 00 D9 FE' - '00 01 06 43 06 00 DA FE 00 01 05 43 06 00 2A EE 01 01 01 43 06 00 0A EE 01 01 01 43 06 00 DB FE' - '00 01 03 43 06 00 DC FE 00 01 04 43 06 00 F6 FE 00 03 05 44 06 00 27 06 00 53 06 00 F5 FE 00 03' - '06 44 06 00 27 06 00 53 06 00 F7 FE 00 03 06 44 06 00 27 06 00 54 06 00 F8 FE 00 03 05 44 06 00' - '27 06 00 54 06 00 FA FE 00 03 05 44 06 00 27 06 00 55 06 00 F9 FE 00 03 06 44 06 00 27 06 00 55' - '06 00 FC FE 00 02 05 44 06 00 27 06 00 FB FE 00 02 06 44 06 00 27 06 00 83 FD 00 03 03 44 06 00' - '2C 06 00 2C 06 00 84 FD 00 03 05 44 06 00 2C 06 00 2C 06 00 BA FD 00 03 03 44 06 00 2C 06 00 45' - '06 00 BC FD 00 03 05 44 06 00 2C 06 00 45 06 00 AC FD 00 03 05 44 06 00 2C 06 00 4A 06 00 C9 FC' - '00 02 03 44 06 00 2C 06 00 3F FC 00 02 06 44 06 00 2C 06 00 B5 FD 00 03 03 44 06 00 2D 06 00 45' - '06 00 80 FD 00 03 05 44 06 00 2D 06 00 45 06 00 82 FD 00 03 05 44 06 00 2D 06 00 49 06 00 81 FD' - '00 03 05 44 06 00 2D 06 00 4A 06 00 40 FC 00 02 06 44 06 00 2D 06 00 CA FC 00 02 03 44 06 00 2D' - '06 00 86 FD 00 03 03 44 06 00 2E 06 00 45 06 00 85 FD 00 03 05 44 06 00 2E 06 00 45 06 00 41 FC' - '00 02 06 44 06 00 2E 06 00 CB FC 00 02 03 44 06 00 2E 06 00 87 FD 00 03 05 44 06 00 45 06 00 2D' - '06 00 88 FD 00 03 03 44 06 00 45 06 00 2D 06 00 AD FD 00 03 05 44 06 00 45 06 00 4A 06 00 CC FC' - '00 02 03 44 06 00 45 06 00 85 FC 00 02 05 44 06 00 45 06 00 ED FC 00 02 04 44 06 00 45 06 00 42' - 'FC 00 02 06 44 06 00 45 06 00 CD FC 00 02 03 44 06 00 47 06 00 86 FC 00 02 05 44 06 00 49 06 00' - '43 FC 00 02 06 44 06 00 49 06 00 44 FC 00 02 06 44 06 00 4A 06 00 87 FC 00 02 05 44 06 00 4A 06' - '00 8B EE 01 01 01 44 06 00 2B EE 01 01 01 44 06 00 0B EE 01 01 01 44 06 00 4B EE 01 01 01 44 06' - '00 DF FE 00 01 03 44 06 00 E0 FE 00 01 04 44 06 00 DE FE 00 01 05 44 06 00 AB EE 01 01 01 44 06' - '00 DD FE 00 01 06 44 06 00 88 FC 00 02 05 45 06 00 27 06 00 8C FD 00 03 03 45 06 00 2C 06 00 2D' - '06 00 92 FD 00 03 03 45 06 00 2C 06 00 2E 06 00 8D FD 00 03 03 45 06 00 2C 06 00 45 06 00 C0 FD' - '00 03 05 45 06 00 2C 06 00 4A 06 00 CE FC 00 02 03 45 06 00 2C 06 00 45 FC 00 02 06 45 06 00 2C' - '06 00 89 FD 00 03 03 45 06 00 2D 06 00 2C 06 00 F4 FD 00 04 06 45 06 00 2D 06 00 45 06 00 2F 06' - '00 8A FD 00 03 03 45 06 00 2D 06 00 45 06 00 8B FD 00 03 05 45 06 00 2D 06 00 4A 06 00 CF FC 00' - '02 03 45 06 00 2D 06 00 46 FC 00 02 06 45 06 00 2D 06 00 8E FD 00 03 03 45 06 00 2E 06 00 2C 06' - '00 8F FD 00 03 03 45 06 00 2E 06 00 45 06 00 B9 FD 00 03 05 45 06 00 2E 06 00 4A 06 00 D0 FC 00' - '02 03 45 06 00 2E 06 00 47 FC 00 02 06 45 06 00 2E 06 00 B1 FD 00 03 05 45 06 00 45 06 00 4A 06' - '00 89 FC 00 02 05 45 06 00 45 06 00 D1 FC 00 02 03 45 06 00 45 06 00 48 FC 00 02 06 45 06 00 45' - '06 00 49 FC 00 02 06 45 06 00 49 06 00 4A FC 00 02 06 45 06 00 4A 06 00 E1 FE 00 01 06 45 06 00' - '2C EE 01 01 01 45 06 00 0C EE 01 01 01 45 06 00 8C EE 01 01 01 45 06 00 6C EE 01 01 01 45 06 00' - 'AC EE 01 01 01 45 06 00 E4 FE 00 01 04 45 06 00 E2 FE 00 01 05 45 06 00 E3 FE 00 01 03 45 06 00' - 'B8 FD 00 03 03 46 06 00 2C 06 00 2D 06 00 BD FD 00 03 05 46 06 00 2C 06 00 2D 06 00 97 FD 00 03' - '05 46 06 00 2C 06 00 45 06 00 98 FD 00 03 03 46 06 00 2C 06 00 45 06 00 99 FD 00 03 05 46 06 00' - '2C 06 00 49 06 00 C7 FD 00 03 05 46 06 00 2C 06 00 4A 06 00 4B FC 00 02 06 46 06 00 2C 06 00 D2' - 'FC 00 02 03 46 06 00 2C 06 00 95 FD 00 03 03 46 06 00 2D 06 00 45 06 00 96 FD 00 03 05 46 06 00' - '2D 06 00 49 06 00 B3 FD 00 03 05 46 06 00 2D 06 00 4A 06 00 4C FC 00 02 06 46 06 00 2D 06 00 D3' - 'FC 00 02 03 46 06 00 2D 06 00 4D FC 00 02 06 46 06 00 2E 06 00 D4 FC 00 02 03 46 06 00 2E 06 00' - '8A FC 00 02 05 46 06 00 31 06 00 8B FC 00 02 05 46 06 00 32 06 00 9B FD 00 03 05 46 06 00 45 06' - '00 49 06 00 9A FD 00 03 05 46 06 00 45 06 00 4A 06 00 EE FC 00 02 04 46 06 00 45 06 00 8C FC 00' - '02 05 46 06 00 45 06 00 4E FC 00 02 06 46 06 00 45 06 00 D5 FC 00 02 03 46 06 00 45 06 00 8D FC' - '00 02 05 46 06 00 46 06 00 D6 FC 00 02 03 46 06 00 47 06 00 EF FC 00 02 04 46 06 00 47 06 00 4F' - 'FC 00 02 06 46 06 00 49 06 00 8E FC 00 02 05 46 06 00 49 06 00 50 FC 00 02 06 46 06 00 4A 06 00' - '8F FC 00 02 05 46 06 00 4A 06 00 4D EE 01 01 01 46 06 00 6D EE 01 01 01 46 06 00 E8 FE 00 01 04' - '46 06 00 E7 FE 00 01 03 46 06 00 0D EE 01 01 01 46 06 00 AD EE 01 01 01 46 06 00 E5 FE 00 01 06' - '46 06 00 E6 FE 00 01 05 46 06 00 8D EE 01 01 01 46 06 00 2D EE 01 01 01 46 06 00 D7 FC 00 02 03' - '47 06 00 2C 06 00 51 FC 00 02 06 47 06 00 2C 06 00 93 FD 00 03 03 47 06 00 45 06 00 2C 06 00 94' - 'FD 00 03 03 47 06 00 45 06 00 45 06 00 52 FC 00 02 06 47 06 00 45 06 00 D8 FC 00 02 03 47 06 00' - '45 06 00 53 FC 00 02 06 47 06 00 49 06 00 54 FC 00 02 06 47 06 00 4A 06 00 D9 FC 00 02 03 47 06' - '00 70 06 00 24 EE 01 01 01 47 06 00 E9 FE 00 01 06 47 06 00 EC FE 00 01 04 47 06 00 64 EE 01 01' - '01 47 06 00 84 EE 01 01 01 47 06 00 EA FE 00 01 05 47 06 00 EB FE 00 01 03 47 06 00 F8 FD 00 04' - '06 48 06 00 33 06 00 44 06 00 45 06 00 24 06 00 02 00 48 06 00 54 06 00 85 FE 00 02 06 48 06 00' - '54 06 00 86 FE 00 02 05 48 06 00 54 06 00 76 06 00 02 10 48 06 00 74 06 00 EE FE 00 01 05 48 06' - '00 ED FE 00 01 06 48 06 00 85 EE 01 01 01 48 06 00 A5 EE 01 01 01 48 06 00 05 EE 01 01 01 48 06' - '00 90 FC 00 02 05 49 06 00 70 06 00 5D FC 00 02 06 49 06 00 70 06 00 EF FE 00 01 06 49 06 00 E8' - 'FB 00 01 03 49 06 00 E9 FB 00 01 04 49 06 00 F0 FE 00 01 05 49 06 00 AF FD 00 03 05 4A 06 00 2C' - '06 00 4A 06 00 55 FC 00 02 06 4A 06 00 2C 06 00 DA FC 00 02 03 4A 06 00 2C 06 00 AE FD 00 03 05' - '4A 06 00 2D 06 00 4A 06 00 56 FC 00 02 06 4A 06 00 2D 06 00 DB FC 00 02 03 4A 06 00 2D 06 00 DC' - 'FC 00 02 03 4A 06 00 2E 06 00 57 FC 00 02 06 4A 06 00 2E 06 00 91 FC 00 02 05 4A 06 00 31 06 00' - '92 FC 00 02 05 4A 06 00 32 06 00 9D FD 00 03 03 4A 06 00 45 06 00 45 06 00 9C FD 00 03 05 4A 06' - '00 45 06 00 45 06 00 B0 FD 00 03 05 4A 06 00 45 06 00 4A 06 00 58 FC 00 02 06 4A 06 00 45 06 00' - '93 FC 00 02 05 4A 06 00 45 06 00 DD FC 00 02 03 4A 06 00 45 06 00 F0 FC 00 02 04 4A 06 00 45 06' - '00 94 FC 00 02 05 4A 06 00 46 06 00 DE FC 00 02 03 4A 06 00 47 06 00 F1 FC 00 02 04 4A 06 00 47' - '06 00 95 FC 00 02 05 4A 06 00 49 06 00 59 FC 00 02 06 4A 06 00 49 06 00 5A FC 00 02 06 4A 06 00' - '4A 06 00 96 FC 00 02 05 4A 06 00 4A 06 00 EA FB 00 03 06 4A 06 00 54 06 00 27 06 00 EB FB 00 03' - '05 4A 06 00 54 06 00 27 06 00 00 FC 00 03 06 4A 06 00 54 06 00 2C 06 00 97 FC 00 03 03 4A 06 00' - '54 06 00 2C 06 00 01 FC 00 03 06 4A 06 00 54 06 00 2D 06 00 98 FC 00 03 03 4A 06 00 54 06 00 2D' - '06 00 99 FC 00 03 03 4A 06 00 54 06 00 2E 06 00 64 FC 00 03 05 4A 06 00 54 06 00 31 06 00 65 FC' - '00 03 05 4A 06 00 54 06 00 32 06 00 9A FC 00 03 03 4A 06 00 54 06 00 45 06 00 DF FC 00 03 04 4A' - '06 00 54 06 00 45 06 00 66 FC 00 03 05 4A 06 00 54 06 00 45 06 00 02 FC 00 03 06 4A 06 00 54 06' - '00 45 06 00 67 FC 00 03 05 4A 06 00 54 06 00 46 06 00 9B FC 00 03 03 4A 06 00 54 06 00 47 06 00' - 'E0 FC 00 03 04 4A 06 00 54 06 00 47 06 00 EF FB 00 03 05 4A 06 00 54 06 00 48 06 00 EE FB 00 03' - '06 4A 06 00 54 06 00 48 06 00 F9 FB 00 03 06 4A 06 00 54 06 00 49 06 00 68 FC 00 03 05 4A 06 00' - '54 06 00 49 06 00 03 FC 00 03 06 4A 06 00 54 06 00 49 06 00 FB FB 00 03 03 4A 06 00 54 06 00 49' - '06 00 FA FB 00 03 05 4A 06 00 54 06 00 49 06 00 04 FC 00 03 06 4A 06 00 54 06 00 4A 06 00 69 FC' - '00 03 05 4A 06 00 54 06 00 4A 06 00 F2 FB 00 03 06 4A 06 00 54 06 00 C6 06 00 F3 FB 00 03 05 4A' - '06 00 54 06 00 C6 06 00 F1 FB 00 03 05 4A 06 00 54 06 00 C7 06 00 F0 FB 00 03 06 4A 06 00 54 06' - '00 C7 06 00 F5 FB 00 03 05 4A 06 00 54 06 00 C8 06 00 F4 FB 00 03 06 4A 06 00 54 06 00 C8 06 00' - 'F7 FB 00 03 05 4A 06 00 54 06 00 D0 06 00 F6 FB 00 03 06 4A 06 00 54 06 00 D0 06 00 F8 FB 00 03' - '03 4A 06 00 54 06 00 D0 06 00 EC FB 00 03 06 4A 06 00 54 06 00 D5 06 00 ED FB 00 03 05 4A 06 00' - '54 06 00 D5 06 00 89 FE 00 02 06 4A 06 00 54 06 00 8B FE 00 02 03 4A 06 00 54 06 00 8C FE 00 02' - '04 4A 06 00 54 06 00 8A FE 00 02 05 4A 06 00 54 06 00 26 06 00 02 00 4A 06 00 54 06 00 78 06 00' - '02 10 4A 06 00 74 06 00 29 EE 01 01 01 4A 06 00 49 EE 01 01 01 4A 06 00 69 EE 01 01 01 4A 06 00' - 'F3 FE 00 01 03 4A 06 00 09 EE 01 01 01 4A 06 00 A9 EE 01 01 01 4A 06 00 89 EE 01 01 01 4A 06 00' - 'F4 FE 00 01 04 4A 06 00 F2 FE 00 01 05 4A 06 00 F1 FE 00 01 06 4A 06 00 1C EE 01 01 01 6E 06 00' - '7C EE 01 01 01 6E 06 00 5F EE 01 01 01 6F 06 00 1F EE 01 01 01 6F 06 00 50 FB 00 01 06 71 06 00' - '51 FB 00 01 05 71 06 00 68 FB 00 01 03 79 06 00 69 FB 00 01 04 79 06 00 66 FB 00 01 06 79 06 00' - '67 FB 00 01 05 79 06 00 60 FB 00 01 03 7A 06 00 61 FB 00 01 04 7A 06 00 5E FB 00 01 06 7A 06 00' - '5F FB 00 01 05 7A 06 00 54 FB 00 01 03 7B 06 00 55 FB 00 01 04 7B 06 00 52 FB 00 01 06 7B 06 00' - '53 FB 00 01 05 7B 06 00 58 FB 00 01 03 7E 06 00 59 FB 00 01 04 7E 06 00 56 FB 00 01 06 7E 06 00' - '57 FB 00 01 05 7E 06 00 63 FB 00 01 05 7F 06 00 62 FB 00 01 06 7F 06 00 65 FB 00 01 04 7F 06 00' - '64 FB 00 01 03 7F 06 00 5B FB 00 01 05 80 06 00 5A FB 00 01 06 80 06 00 5D FB 00 01 04 80 06 00' - '5C FB 00 01 03 80 06 00 78 FB 00 01 03 83 06 00 79 FB 00 01 04 83 06 00 76 FB 00 01 06 83 06 00' - '77 FB 00 01 05 83 06 00 74 FB 00 01 03 84 06 00 75 FB 00 01 04 84 06 00 72 FB 00 01 06 84 06 00' - '73 FB 00 01 05 84 06 00 7D FB 00 01 04 86 06 00 7C FB 00 01 03 86 06 00 7B FB 00 01 05 86 06 00' - '7A FB 00 01 06 86 06 00 80 FB 00 01 03 87 06 00 81 FB 00 01 04 87 06 00 7E FB 00 01 06 87 06 00' - '7F FB 00 01 05 87 06 00 89 FB 00 01 05 88 06 00 88 FB 00 01 06 88 06 00 84 FB 00 01 06 8C 06 00' - '85 FB 00 01 05 8C 06 00 82 FB 00 01 06 8D 06 00 83 FB 00 01 05 8D 06 00 87 FB 00 01 05 8E 06 00' - '86 FB 00 01 06 8E 06 00 8D FB 00 01 05 91 06 00 8C FB 00 01 06 91 06 00 8A FB 00 01 06 98 06 00' - '8B FB 00 01 05 98 06 00 1E EE 01 01 01 A1 06 00 7E EE 01 01 01 A1 06 00 6D FB 00 01 04 A4 06 00' - '6C FB 00 01 03 A4 06 00 6A FB 00 01 06 A4 06 00 6B FB 00 01 05 A4 06 00 6F FB 00 01 05 A6 06 00' - '6E FB 00 01 06 A6 06 00 71 FB 00 01 04 A6 06 00 70 FB 00 01 03 A6 06 00 91 FB 00 01 04 A9 06 00' - '8E FB 00 01 06 A9 06 00 8F FB 00 01 05 A9 06 00 90 FB 00 01 03 A9 06 00 D5 FB 00 01 03 AD 06 00' - 'D6 FB 00 01 04 AD 06 00 D3 FB 00 01 06 AD 06 00 D4 FB 00 01 05 AD 06 00 93 FB 00 01 05 AF 06 00' - '92 FB 00 01 06 AF 06 00 95 FB 00 01 04 AF 06 00 94 FB 00 01 03 AF 06 00 9B FB 00 01 05 B1 06 00' - '9A FB 00 01 06 B1 06 00 9D FB 00 01 04 B1 06 00 9C FB 00 01 03 B1 06 00 97 FB 00 01 05 B3 06 00' - '96 FB 00 01 06 B3 06 00 99 FB 00 01 04 B3 06 00 98 FB 00 01 03 B3 06 00 9E FB 00 01 06 BA 06 00' - '1D EE 01 01 01 BA 06 00 9F FB 00 01 05 BA 06 00 5D EE 01 01 01 BA 06 00 A0 FB 00 01 06 BB 06 00' - 'A1 FB 00 01 05 BB 06 00 A2 FB 00 01 03 BB 06 00 A3 FB 00 01 04 BB 06 00 AD FB 00 01 04 BE 06 00' - 'AA FB 00 01 06 BE 06 00 AB FB 00 01 05 BE 06 00 AC FB 00 01 03 BE 06 00 C2 06 00 02 00 C1 06 00' - '54 06 00 A7 FB 00 01 05 C1 06 00 A6 FB 00 01 06 C1 06 00 A8 FB 00 01 03 C1 06 00 A9 FB 00 01 04' - 'C1 06 00 E0 FB 00 01 06 C5 06 00 E1 FB 00 01 05 C5 06 00 D9 FB 00 01 06 C6 06 00 DA FB 00 01 05' - 'C6 06 00 DD FB 00 02 06 C7 06 00 74 06 00 77 06 00 02 10 C7 06 00 74 06 00 D7 FB 00 01 06 C7 06' - '00 D8 FB 00 01 05 C7 06 00 DB FB 00 01 06 C8 06 00 DC FB 00 01 05 C8 06 00 E2 FB 00 01 06 C9 06' - '00 E3 FB 00 01 05 C9 06 00 DE FB 00 01 06 CB 06 00 DF FB 00 01 05 CB 06 00 FD FB 00 01 05 CC 06' - '00 FC FB 00 01 06 CC 06 00 FF FB 00 01 04 CC 06 00 FE FB 00 01 03 CC 06 00 E6 FB 00 01 03 D0 06' - '00 E7 FB 00 01 04 D0 06 00 E4 FB 00 01 06 D0 06 00 E5 FB 00 01 05 D0 06 00 B1 FB 00 02 05 D2 06' - '00 54 06 00 D3 06 00 02 00 D2 06 00 54 06 00 B0 FB 00 02 06 D2 06 00 54 06 00 AE FB 00 01 06 D2' - '06 00 AF FB 00 01 05 D2 06 00 A5 FB 00 02 05 D5 06 00 54 06 00 A4 FB 00 02 06 D5 06 00 54 06 00' - 'C0 06 00 02 00 D5 06 00 54 06 00 29 09 00 02 00 28 09 00 3C 09 00 31 09 00 02 00 30 09 00 3C 09' - '00 34 09 00 02 00 33 09 00 3C 09 00 CB 09 00 02 00 C7 09 00 BE 09 00 CC 09 00 02 00 C7 09 00 D7' - '09 00 4B 0B 00 02 00 47 0B 00 3E 0B 00 48 0B 00 02 00 47 0B 00 56 0B 00 4C 0B 00 02 00 47 0B 00' - '57 0B 00 94 0B 00 02 00 92 0B 00 D7 0B 00 CA 0B 00 02 00 C6 0B 00 BE 0B 00 CC 0B 00 02 00 C6 0B' - '00 D7 0B 00 CB 0B 00 02 00 C7 0B 00 BE 0B 00 48 0C 00 02 00 46 0C 00 56 0C 00 C0 0C 00 02 00 BF' - '0C 00 D5 0C 00 CB 0C 00 03 00 C6 0C 00 C2 0C 00 D5 0C 00 CA 0C 00 02 00 C6 0C 00 C2 0C 00 C7 0C' - '00 02 00 C6 0C 00 D5 0C 00 C8 0C 00 02 00 C6 0C 00 D6 0C 00 4A 0D 00 02 00 46 0D 00 3E 0D 00 4C' - '0D 00 02 00 46 0D 00 57 0D 00 4B 0D 00 02 00 47 0D 00 3E 0D 00 DA 0D 00 02 00 D9 0D 00 CA 0D 00' - 'DD 0D 00 03 00 D9 0D 00 CF 0D 00 CA 0D 00 DC 0D 00 02 00 D9 0D 00 CF 0D 00 DE 0D 00 02 00 D9 0D' - '00 DF 0D 00 33 0E 00 02 10 4D 0E 00 32 0E 00 DC 0E 00 02 10 AB 0E 00 99 0E 00 DD 0E 00 02 10 AB' - '0E 00 A1 0E 00 B3 0E 00 02 10 CD 0E 00 B2 0E 00 0C 0F 00 01 02 0B 0F 00 77 0F 00 03 10 B2 0F 00' - '71 0F 00 80 0F 00 79 0F 00 03 10 B3 0F 00 71 0F 00 80 0F 00 26 10 00 02 00 25 10 00 2E 10 00 FC' - '10 00 01 08 DC 10 00 6E 32 00 02 07 00 11 00 61 11 00 31 31 00 01 10 00 11 00 A1 FF 00 01 0C 00' - '11 00 60 32 00 01 07 00 11 00 A2 FF 00 01 0C 01 11 00 32 31 00 01 10 01 11 00 6F 32 00 02 07 02' - '11 00 61 11 00 61 32 00 01 07 02 11 00 A4 FF 00 01 0C 02 11 00 34 31 00 01 10 02 11 00 70 32 00' - '02 07 03 11 00 61 11 00 37 31 00 01 10 03 11 00 A7 FF 00 01 0C 03 11 00 62 32 00 01 07 03 11 00' - 'A8 FF 00 01 0C 04 11 00 38 31 00 01 10 04 11 00 71 32 00 02 07 05 11 00 61 11 00 39 31 00 01 10' - '05 11 00 A9 FF 00 01 0C 05 11 00 63 32 00 01 07 05 11 00 72 32 00 02 07 06 11 00 61 11 00 41 31' - '00 01 10 06 11 00 B1 FF 00 01 0C 06 11 00 64 32 00 01 07 06 11 00 73 32 00 02 07 07 11 00 61 11' - '00 65 32 00 01 07 07 11 00 42 31 00 01 10 07 11 00 B2 FF 00 01 0C 07 11 00 B3 FF 00 01 0C 08 11' - '00 43 31 00 01 10 08 11 00 74 32 00 02 07 09 11 00 61 11 00 B5 FF 00 01 0C 09 11 00 66 32 00 01' - '07 09 11 00 45 31 00 01 10 09 11 00 B6 FF 00 01 0C 0A 11 00 46 31 00 01 10 0A 11 00 75 32 00 02' - '07 0B 11 00 61 11 00 7E 32 00 02 07 0B 11 00 6E 11 00 67 32 00 01 07 0B 11 00 47 31 00 01 10 0B' - '11 00 B7 FF 00 01 0C 0B 11 00 76 32 00 02 07 0C 11 00 61 11 00 7D 32 00 04 07 0C 11 00 6E 11 00' - '0B 11 00 74 11 00 B8 FF 00 01 0C 0C 11 00 48 31 00 01 10 0C 11 00 68 32 00 01 07 0C 11 00 49 31' - '00 01 10 0D 11 00 B9 FF 00 01 0C 0D 11 00 7C 32 00 05 07 0E 11 00 61 11 00 B7 11 00 00 11 00 69' - '11 00 77 32 00 02 07 0E 11 00 61 11 00 BA FF 00 01 0C 0E 11 00 4A 31 00 01 10 0E 11 00 69 32 00' - '01 07 0E 11 00 78 32 00 02 07 0F 11 00 61 11 00 BB FF 00 01 0C 0F 11 00 6A 32 00 01 07 0F 11 00' - '4B 31 00 01 10 0F 11 00 79 32 00 02 07 10 11 00 61 11 00 4C 31 00 01 10 10 11 00 6B 32 00 01 07' - '10 11 00 BC FF 00 01 0C 10 11 00 7A 32 00 02 07 11 11 00 61 11 00 4D 31 00 01 10 11 11 00 6C 32' - '00 01 07 11 11 00 BD FF 00 01 0C 11 11 00 7B 32 00 02 07 12 11 00 61 11 00 BE FF 00 01 0C 12 11' - '00 6D 32 00 01 07 12 11 00 4E 31 00 01 10 12 11 00 65 31 00 01 10 14 11 00 66 31 00 01 10 15 11' - '00 40 31 00 01 10 1A 11 00 B0 FF 00 01 0C 1A 11 00 6E 31 00 01 10 1C 11 00 71 31 00 01 10 1D 11' - '00 72 31 00 01 10 1E 11 00 73 31 00 01 10 20 11 00 B4 FF 00 01 0C 21 11 00 44 31 00 01 10 21 11' - '00 74 31 00 01 10 22 11 00 75 31 00 01 10 23 11 00 76 31 00 01 10 27 11 00 77 31 00 01 10 29 11' - '00 78 31 00 01 10 2B 11 00 79 31 00 01 10 2C 11 00 7A 31 00 01 10 2D 11 00 7B 31 00 01 10 2E 11' - '00 7C 31 00 01 10 2F 11 00 7D 31 00 01 10 32 11 00 7E 31 00 01 10 36 11 00 7F 31 00 01 10 40 11' - '00 80 31 00 01 10 47 11 00 81 31 00 01 10 4C 11 00 84 31 00 01 10 57 11 00 85 31 00 01 10 58 11' - '00 86 31 00 01 10 59 11 00 A0 FF 00 01 0C 60 11 00 64 31 00 01 10 60 11 00 4F 31 00 01 10 61 11' - '00 C2 FF 00 01 0C 61 11 00 50 31 00 01 10 62 11 00 C3 FF 00 01 0C 62 11 00 51 31 00 01 10 63 11' - '00 C4 FF 00 01 0C 63 11 00 52 31 00 01 10 64 11 00 C5 FF 00 01 0C 64 11 00 53 31 00 01 10 65 11' - '00 C6 FF 00 01 0C 65 11 00 54 31 00 01 10 66 11 00 C7 FF 00 01 0C 66 11 00 CA FF 00 01 0C 67 11' - '00 55 31 00 01 10 67 11 00 CB FF 00 01 0C 68 11 00 56 31 00 01 10 68 11 00 CC FF 00 01 0C 69 11' - '00 57 31 00 01 10 69 11 00 CD FF 00 01 0C 6A 11 00 58 31 00 01 10 6A 11 00 CE FF 00 01 0C 6B 11' - '00 59 31 00 01 10 6B 11 00 5A 31 00 01 10 6C 11 00 CF FF 00 01 0C 6C 11 00 5B 31 00 01 10 6D 11' - '00 D2 FF 00 01 0C 6D 11 00 D3 FF 00 01 0C 6E 11 00 5C 31 00 01 10 6E 11 00 D4 FF 00 01 0C 6F 11' - '00 5D 31 00 01 10 6F 11 00 D5 FF 00 01 0C 70 11 00 5E 31 00 01 10 70 11 00 D6 FF 00 01 0C 71 11' - '00 5F 31 00 01 10 71 11 00 D7 FF 00 01 0C 72 11 00 60 31 00 01 10 72 11 00 61 31 00 01 10 73 11' - '00 DA FF 00 01 0C 73 11 00 62 31 00 01 10 74 11 00 DB FF 00 01 0C 74 11 00 63 31 00 01 10 75 11' - '00 DC FF 00 01 0C 75 11 00 87 31 00 01 10 84 11 00 88 31 00 01 10 85 11 00 89 31 00 01 10 88 11' - '00 8A 31 00 01 10 91 11 00 8B 31 00 01 10 92 11 00 8C 31 00 01 10 94 11 00 8D 31 00 01 10 9E 11' - '00 8E 31 00 01 10 A1 11 00 A3 FF 00 01 0C AA 11 00 33 31 00 01 10 AA 11 00 35 31 00 01 10 AC 11' - '00 A5 FF 00 01 0C AC 11 00 36 31 00 01 10 AD 11 00 A6 FF 00 01 0C AD 11 00 AA FF 00 01 0C B0 11' - '00 3A 31 00 01 10 B0 11 00 3B 31 00 01 10 B1 11 00 AB FF 00 01 0C B1 11 00 3C 31 00 01 10 B2 11' - '00 AC FF 00 01 0C B2 11 00 AD FF 00 01 0C B3 11 00 3D 31 00 01 10 B3 11 00 AE FF 00 01 0C B4 11' - '00 3E 31 00 01 10 B4 11 00 AF FF 00 01 0C B5 11 00 3F 31 00 01 10 B5 11 00 67 31 00 01 10 C7 11' - '00 68 31 00 01 10 C8 11 00 69 31 00 01 10 CC 11 00 6A 31 00 01 10 CE 11 00 6B 31 00 01 10 D3 11' - '00 6C 31 00 01 10 D7 11 00 6D 31 00 01 10 D9 11 00 6F 31 00 01 10 DD 11 00 70 31 00 01 10 DF 11' - '00 82 31 00 01 10 F1 11 00 83 31 00 01 10 F2 11 00 06 1B 00 02 00 05 1B 00 35 1B 00 08 1B 00 02' - '00 07 1B 00 35 1B 00 0A 1B 00 02 00 09 1B 00 35 1B 00 0C 1B 00 02 00 0B 1B 00 35 1B 00 0E 1B 00' - '02 00 0D 1B 00 35 1B 00 12 1B 00 02 00 11 1B 00 35 1B 00 3B 1B 00 02 00 3A 1B 00 35 1B 00 3D 1B' - '00 02 00 3C 1B 00 35 1B 00 40 1B 00 02 00 3E 1B 00 35 1B 00 41 1B 00 02 00 3F 1B 00 35 1B 00 43' - '1B 00 02 00 42 1B 00 35 1B 00 46 1D 00 01 08 02 1D 00 54 1D 00 01 08 16 1D 00 55 1D 00 01 08 17' - '1D 00 B8 1D 00 01 08 1C 1D 00 59 1D 00 01 08 1D 1D 00 5C 1D 00 01 08 25 1D 00 A7 1D 00 01 08 7B' - '1D 00 AA 1D 00 01 08 85 1D 00 11 20 00 01 02 10 20 00 32 FE 00 01 0A 13 20 00 31 FE 00 01 0A 14' - '20 00 58 FE 00 01 0D 14 20 00 57 20 00 04 10 32 20 00 32 20 00 32 20 00 32 20 00 34 20 00 03 10' - '32 20 00 32 20 00 32 20 00 33 20 00 02 10 32 20 00 32 20 00 37 20 00 03 10 35 20 00 35 20 00 35' - '20 00 36 20 00 02 10 35 20 00 35 20 00 E6 FF 00 01 0B A9 20 00 9A 21 00 02 00 90 21 00 38 03 00' - 'E9 FF 00 01 0C 90 21 00 EA FF 00 01 0C 91 21 00 9B 21 00 02 00 92 21 00 38 03 00 EB FF 00 01 0C' - '92 21 00 EC FF 00 01 0C 93 21 00 AE 21 00 02 00 94 21 00 38 03 00 CD 21 00 02 00 D0 21 00 38 03' - '00 CF 21 00 02 00 D2 21 00 38 03 00 CE 21 00 02 00 D4 21 00 38 03 00 C3 D7 01 01 01 02 22 00 15' - 'D7 01 01 01 02 22 00 DB D6 01 01 01 02 22 00 89 D7 01 01 01 02 22 00 4F D7 01 01 01 02 22 00 04' - '22 00 02 00 03 22 00 38 03 00 A9 D7 01 01 01 07 22 00 35 D7 01 01 01 07 22 00 C1 D6 01 01 01 07' - '22 00 6F D7 01 01 01 07 22 00 FB D6 01 01 01 07 22 00 09 22 00 02 00 08 22 00 38 03 00 0C 22 00' - '02 00 0B 22 00 38 03 00 40 21 00 01 01 11 22 00 8B 20 00 01 09 12 22 00 7B 20 00 01 08 12 22 00' - '24 22 00 02 00 23 22 00 38 03 00 26 22 00 02 00 25 22 00 38 03 00 0C 2A 00 04 10 2B 22 00 2B 22' - '00 2B 22 00 2B 22 00 2D 22 00 03 10 2B 22 00 2B 22 00 2B 22 00 2C 22 00 02 10 2B 22 00 2B 22 00' - '30 22 00 03 10 2E 22 00 2E 22 00 2E 22 00 2F 22 00 02 10 2E 22 00 2E 22 00 41 22 00 02 00 3C 22' - '00 38 03 00 44 22 00 02 00 43 22 00 38 03 00 47 22 00 02 00 45 22 00 38 03 00 49 22 00 02 00 48' - '22 00 38 03 00 6D 22 00 02 00 4D 22 00 38 03 00 62 22 00 02 00 61 22 00 38 03 00 70 22 00 02 00' - '64 22 00 38 03 00 71 22 00 02 00 65 22 00 38 03 00 74 22 00 02 00 72 22 00 38 03 00 75 22 00 02' - '00 73 22 00 38 03 00 78 22 00 02 00 76 22 00 38 03 00 79 22 00 02 00 77 22 00 38 03 00 80 22 00' - '02 00 7A 22 00 38 03 00 81 22 00 02 00 7B 22 00 38 03 00 E0 22 00 02 00 7C 22 00 38 03 00 E1 22' - '00 02 00 7D 22 00 38 03 00 84 22 00 02 00 82 22 00 38 03 00 85 22 00 02 00 83 22 00 38 03 00 88' - '22 00 02 00 86 22 00 38 03 00 89 22 00 02 00 87 22 00 38 03 00 E2 22 00 02 00 91 22 00 38 03 00' - 'E3 22 00 02 00 92 22 00 38 03 00 AC 22 00 02 00 A2 22 00 38 03 00 AD 22 00 02 00 A8 22 00 38 03' - '00 AE 22 00 02 00 A9 22 00 38 03 00 AF 22 00 02 00 AB 22 00 38 03 00 EA 22 00 02 00 B2 22 00 38' - '03 00 EB 22 00 02 00 B3 22 00 38 03 00 EC 22 00 02 00 B4 22 00 38 03 00 ED 22 00 02 00 B5 22 00' - '38 03 00 E8 FF 00 01 0C 02 25 00 ED FF 00 01 0C A0 25 00 EE FF 00 01 0C CB 25 00 5F FF 00 01 0B' - '85 29 00 60 FF 00 01 0B 86 29 00 6F 2D 00 01 08 61 2D 00 51 FE 00 01 0D 01 30 00 64 FF 00 01 0C' - '01 30 00 11 FE 00 01 0A 01 30 00 61 FF 00 01 0C 02 30 00 12 FE 00 01 0A 02 30 00 3F FE 00 01 0A' - '08 30 00 40 FE 00 01 0A 09 30 00 3D FE 00 01 0A 0A 30 00 3E FE 00 01 0A 0B 30 00 62 FF 00 01 0C' - '0C 30 00 41 FE 00 01 0A 0C 30 00 42 FE 00 01 0A 0D 30 00 63 FF 00 01 0C 0D 30 00 43 FE 00 01 0A' - '0E 30 00 44 FE 00 01 0A 0F 30 00 3B FE 00 01 0A 10 30 00 3C FE 00 01 0A 11 30 00 36 30 00 01 10' - '12 30 00 2A F1 01 03 10 14 30 00 53 00 00 15 30 00 41 F2 01 03 10 14 30 00 09 4E 00 15 30 00 42' - 'F2 01 03 10 14 30 00 8C 4E 00 15 30 00 47 F2 01 03 10 14 30 00 DD 52 00 15 30 00 43 F2 01 03 10' - '14 30 00 89 5B 00 15 30 00 45 F2 01 03 10 14 30 00 53 62 00 15 30 00 48 F2 01 03 10 14 30 00 57' - '65 00 15 30 00 40 F2 01 03 10 14 30 00 2C 67 00 15 30 00 44 F2 01 03 10 14 30 00 B9 70 00 15 30' - '00 46 F2 01 03 10 14 30 00 D7 76 00 15 30 00 39 FE 00 01 0A 14 30 00 5D FE 00 01 0D 14 30 00 3A' - 'FE 00 01 0A 15 30 00 5E FE 00 01 0D 15 30 00 17 FE 00 01 0A 16 30 00 18 FE 00 01 0A 17 30 00 94' - '30 00 02 00 46 30 00 99 30 00 4C 30 00 02 00 4B 30 00 99 30 00 4E 30 00 02 00 4D 30 00 99 30 00' - '50 30 00 02 00 4F 30 00 99 30 00 52 30 00 02 00 51 30 00 99 30 00 54 30 00 02 00 53 30 00 99 30' - '00 56 30 00 02 00 55 30 00 99 30 00 58 30 00 02 00 57 30 00 99 30 00 5A 30 00 02 00 59 30 00 99' - '30 00 5C 30 00 02 00 5B 30 00 99 30 00 5E 30 00 02 00 5D 30 00 99 30 00 60 30 00 02 00 5F 30 00' - '99 30 00 62 30 00 02 00 61 30 00 99 30 00 65 30 00 02 00 64 30 00 99 30 00 67 30 00 02 00 66 30' - '00 99 30 00 69 30 00 02 00 68 30 00 99 30 00 70 30 00 02 00 6F 30 00 99 30 00 71 30 00 02 00 6F' - '30 00 9A 30 00 73 30 00 02 00 72 30 00 99 30 00 74 30 00 02 00 72 30 00 9A 30 00 76 30 00 02 00' - '75 30 00 99 30 00 77 30 00 02 00 75 30 00 9A 30 00 79 30 00 02 00 78 30 00 99 30 00 7A 30 00 02' - '00 78 30 00 9A 30 00 00 F2 01 02 0E 7B 30 00 4B 30 00 7C 30 00 02 00 7B 30 00 99 30 00 7D 30 00' - '02 00 7B 30 00 9A 30 00 9F 30 00 02 0A 88 30 00 8A 30 00 9E FF 00 01 0C 99 30 00 9F FF 00 01 0C' - '9A 30 00 9E 30 00 02 00 9D 30 00 99 30 00 67 FF 00 01 0C A1 30 00 00 33 00 05 0E A2 30 00 CF 30' - '00 9A 30 00 FC 30 00 C8 30 00 01 33 00 04 0E A2 30 00 EB 30 00 D5 30 00 A1 30 00 02 33 00 05 0E' - 'A2 30 00 F3 30 00 D8 30 00 9A 30 00 A2 30 00 03 33 00 03 0E A2 30 00 FC 30 00 EB 30 00 D0 32 00' - '01 07 A2 30 00 71 FF 00 01 0C A2 30 00 68 FF 00 01 0C A3 30 00 04 33 00 05 0E A4 30 00 CB 30 00' - 'F3 30 00 AF 30 00 99 30 00 05 33 00 03 0E A4 30 00 F3 30 00 C1 30 00 72 FF 00 01 0C A4 30 00 D1' - '32 00 01 07 A4 30 00 69 FF 00 01 0C A5 30 00 F4 30 00 02 00 A6 30 00 99 30 00 06 33 00 03 0E A6' - '30 00 A9 30 00 F3 30 00 73 FF 00 01 0C A6 30 00 D2 32 00 01 07 A6 30 00 6A FF 00 01 0C A7 30 00' - '07 33 00 06 0E A8 30 00 B9 30 00 AF 30 00 FC 30 00 C8 30 00 99 30 00 08 33 00 04 0E A8 30 00 FC' - '30 00 AB 30 00 FC 30 00 74 FF 00 01 0C A8 30 00 D3 32 00 01 07 A8 30 00 6B FF 00 01 0C A9 30 00' - '09 33 00 03 0E AA 30 00 F3 30 00 B9 30 00 0A 33 00 03 0E AA 30 00 FC 30 00 E0 30 00 D4 32 00 01' - '07 AA 30 00 75 FF 00 01 0C AA 30 00 0E 33 00 04 0E AB 30 00 99 30 00 ED 30 00 F3 30 00 0F 33 00' - '04 0E AB 30 00 99 30 00 F3 30 00 DE 30 00 AC 30 00 02 00 AB 30 00 99 30 00 0B 33 00 03 0E AB 30' - '00 A4 30 00 EA 30 00 0C 33 00 04 0E AB 30 00 E9 30 00 C3 30 00 C8 30 00 0D 33 00 04 0E AB 30 00' - 'ED 30 00 EA 30 00 FC 30 00 76 FF 00 01 0C AB 30 00 D5 32 00 01 07 AB 30 00 10 33 00 06 0E AD 30' - '00 99 30 00 AD 30 00 99 30 00 AB 30 00 99 30 00 11 33 00 04 0E AD 30 00 99 30 00 CB 30 00 FC 30' - '00 13 33 00 08 0E AD 30 00 99 30 00 EB 30 00 AD 30 00 99 30 00 BF 30 00 99 30 00 FC 30 00 AE 30' - '00 02 00 AD 30 00 99 30 00 12 33 00 04 0E AD 30 00 E5 30 00 EA 30 00 FC 30 00 15 33 00 06 0E AD' - '30 00 ED 30 00 AF 30 00 99 30 00 E9 30 00 E0 30 00 16 33 00 06 0E AD 30 00 ED 30 00 E1 30 00 FC' - '30 00 C8 30 00 EB 30 00 17 33 00 05 0E AD 30 00 ED 30 00 EF 30 00 C3 30 00 C8 30 00 14 33 00 02' - '0E AD 30 00 ED 30 00 77 FF 00 01 0C AD 30 00 D6 32 00 01 07 AD 30 00 19 33 00 06 0E AF 30 00 99' - '30 00 E9 30 00 E0 30 00 C8 30 00 F3 30 00 18 33 00 04 0E AF 30 00 99 30 00 E9 30 00 E0 30 00 B0' - '30 00 02 00 AF 30 00 99 30 00 1A 33 00 06 0E AF 30 00 EB 30 00 BB 30 00 99 30 00 A4 30 00 ED 30' - '00 1B 33 00 04 0E AF 30 00 ED 30 00 FC 30 00 CD 30 00 78 FF 00 01 0C AF 30 00 D7 32 00 01 07 AF' - '30 00 B2 30 00 02 00 B1 30 00 99 30 00 1C 33 00 03 0E B1 30 00 FC 30 00 B9 30 00 D8 32 00 01 07' - 'B1 30 00 79 FF 00 01 0C B1 30 00 B4 30 00 02 00 B3 30 00 99 30 00 01 F2 01 02 0E B3 30 00 B3 30' - '00 FF 30 00 02 0A B3 30 00 C8 30 00 1D 33 00 03 0E B3 30 00 EB 30 00 CA 30 00 1E 33 00 04 0E B3' - '30 00 FC 30 00 DB 30 00 9A 30 00 D9 32 00 01 07 B3 30 00 7A FF 00 01 0C B3 30 00 B6 30 00 02 00' - 'B5 30 00 99 30 00 1F 33 00 04 0E B5 30 00 A4 30 00 AF 30 00 EB 30 00 20 33 00 05 0E B5 30 00 F3' - '30 00 C1 30 00 FC 30 00 E0 30 00 7B FF 00 01 0C B5 30 00 DA 32 00 01 07 B5 30 00 02 F2 01 01 0E' - 'B5 30 00 B8 30 00 02 00 B7 30 00 99 30 00 21 33 00 05 0E B7 30 00 EA 30 00 F3 30 00 AF 30 00 99' - '30 00 DB 32 00 01 07 B7 30 00 7C FF 00 01 0C B7 30 00 BA 30 00 02 00 B9 30 00 99 30 00 7D FF 00' - '01 0C B9 30 00 DC 32 00 01 07 B9 30 00 BC 30 00 02 00 BB 30 00 99 30 00 22 33 00 03 0E BB 30 00' - 'F3 30 00 C1 30 00 23 33 00 03 0E BB 30 00 F3 30 00 C8 30 00 DD 32 00 01 07 BB 30 00 7E FF 00 01' - '0C BB 30 00 BE 30 00 02 00 BD 30 00 99 30 00 7F FF 00 01 0C BD 30 00 DE 32 00 01 07 BD 30 00 24' - '33 00 04 0E BF 30 00 99 30 00 FC 30 00 B9 30 00 C0 30 00 02 00 BF 30 00 99 30 00 DF 32 00 01 07' - 'BF 30 00 80 FF 00 01 0C BF 30 00 C2 30 00 02 00 C1 30 00 99 30 00 81 FF 00 01 0C C1 30 00 E0 32' - '00 01 07 C1 30 00 6F FF 00 01 0C C3 30 00 C5 30 00 02 00 C4 30 00 99 30 00 82 FF 00 01 0C C4 30' - '00 E1 32 00 01 07 C4 30 00 25 33 00 03 0E C6 30 00 99 30 00 B7 30 00 13 F2 01 02 0E C6 30 00 99' - '30 00 C7 30 00 02 00 C6 30 00 99 30 00 83 FF 00 01 0C C6 30 00 E2 32 00 01 07 C6 30 00 26 33 00' - '03 0E C8 30 00 99 30 00 EB 30 00 C9 30 00 02 00 C8 30 00 99 30 00 27 33 00 02 0E C8 30 00 F3 30' - '00 E3 32 00 01 07 C8 30 00 84 FF 00 01 0C C8 30 00 28 33 00 02 0E CA 30 00 CE 30 00 E4 32 00 01' - '07 CA 30 00 85 FF 00 01 0C CA 30 00 E5 32 00 01 07 CB 30 00 86 FF 00 01 0C CB 30 00 E6 32 00 01' - '07 CC 30 00 87 FF 00 01 0C CC 30 00 E7 32 00 01 07 CD 30 00 88 FF 00 01 0C CD 30 00 29 33 00 03' - '0E CE 30 00 C3 30 00 C8 30 00 E8 32 00 01 07 CE 30 00 89 FF 00 01 0C CE 30 00 2D 33 00 05 0E CF' - '30 00 99 30 00 FC 30 00 EC 30 00 EB 30 00 D0 30 00 02 00 CF 30 00 99 30 00 2B 33 00 06 0E CF 30' - '00 9A 30 00 FC 30 00 BB 30 00 F3 30 00 C8 30 00 2C 33 00 04 0E CF 30 00 9A 30 00 FC 30 00 C4 30' - '00 D1 30 00 02 00 CF 30 00 9A 30 00 2A 33 00 03 0E CF 30 00 A4 30 00 C4 30 00 8A FF 00 01 0C CF' - '30 00 E9 32 00 01 07 CF 30 00 31 33 00 03 0E D2 30 00 99 30 00 EB 30 00 D3 30 00 02 00 D2 30 00' - '99 30 00 2E 33 00 06 0E D2 30 00 9A 30 00 A2 30 00 B9 30 00 C8 30 00 EB 30 00 2F 33 00 04 0E D2' - '30 00 9A 30 00 AF 30 00 EB 30 00 30 33 00 03 0E D2 30 00 9A 30 00 B3 30 00 D4 30 00 02 00 D2 30' - '00 9A 30 00 EA 32 00 01 07 D2 30 00 8B FF 00 01 0C D2 30 00 34 33 00 06 0E D5 30 00 99 30 00 C3' - '30 00 B7 30 00 A7 30 00 EB 30 00 D6 30 00 02 00 D5 30 00 99 30 00 D7 30 00 02 00 D5 30 00 9A 30' - '00 32 33 00 06 0E D5 30 00 A1 30 00 E9 30 00 C3 30 00 C8 30 00 99 30 00 33 33 00 04 0E D5 30 00' - 'A3 30 00 FC 30 00 C8 30 00 35 33 00 03 0E D5 30 00 E9 30 00 F3 30 00 8C FF 00 01 0C D5 30 00 EB' - '32 00 01 07 D5 30 00 3C 33 00 04 0E D8 30 00 99 30 00 FC 30 00 BF 30 00 D9 30 00 02 00 D8 30 00' - '99 30 00 37 33 00 03 0E D8 30 00 9A 30 00 BD 30 00 38 33 00 04 0E D8 30 00 9A 30 00 CB 30 00 D2' - '30 00 3A 33 00 04 0E D8 30 00 9A 30 00 F3 30 00 B9 30 00 3B 33 00 07 0E D8 30 00 9A 30 00 FC 30' - '00 D8 30 00 9A 30 00 B7 30 00 99 30 00 DA 30 00 02 00 D8 30 00 9A 30 00 36 33 00 05 0E D8 30 00' - 'AF 30 00 BF 30 00 FC 30 00 EB 30 00 39 33 00 03 0E D8 30 00 EB 30 00 C4 30 00 8D FF 00 01 0C D8' - '30 00 EC 32 00 01 07 D8 30 00 3E 33 00 04 0E DB 30 00 99 30 00 EB 30 00 C8 30 00 DC 30 00 02 00' - 'DB 30 00 99 30 00 3D 33 00 05 0E DB 30 00 9A 30 00 A4 30 00 F3 30 00 C8 30 00 40 33 00 07 0E DB' - '30 00 9A 30 00 F3 30 00 DB 30 00 9A 30 00 C8 30 00 99 30 00 DD 30 00 02 00 DB 30 00 9A 30 00 3F' - '33 00 02 0E DB 30 00 F3 30 00 41 33 00 03 0E DB 30 00 FC 30 00 EB 30 00 42 33 00 03 0E DB 30 00' - 'FC 30 00 F3 30 00 8E FF 00 01 0C DB 30 00 ED 32 00 01 07 DB 30 00 43 33 00 04 0E DE 30 00 A4 30' - '00 AF 30 00 ED 30 00 44 33 00 03 0E DE 30 00 A4 30 00 EB 30 00 45 33 00 03 0E DE 30 00 C3 30 00' - 'CF 30 00 46 33 00 03 0E DE 30 00 EB 30 00 AF 30 00 47 33 00 05 0E DE 30 00 F3 30 00 B7 30 00 E7' - '30 00 F3 30 00 8F FF 00 01 0C DE 30 00 EE 32 00 01 07 DE 30 00 48 33 00 04 0E DF 30 00 AF 30 00' - 'ED 30 00 F3 30 00 4A 33 00 06 0E DF 30 00 EA 30 00 CF 30 00 99 30 00 FC 30 00 EB 30 00 49 33 00' - '02 0E DF 30 00 EA 30 00 EF 32 00 01 07 DF 30 00 90 FF 00 01 0C DF 30 00 F0 32 00 01 07 E0 30 00' - '91 FF 00 01 0C E0 30 00 4C 33 00 05 0E E1 30 00 AB 30 00 99 30 00 C8 30 00 F3 30 00 4B 33 00 03' - '0E E1 30 00 AB 30 00 99 30 00 4D 33 00 04 0E E1 30 00 FC 30 00 C8 30 00 EB 30 00 92 FF 00 01 0C' - 'E1 30 00 F1 32 00 01 07 E1 30 00 F2 32 00 01 07 E2 30 00 93 FF 00 01 0C E2 30 00 6C FF 00 01 0C' - 'E3 30 00 4E 33 00 04 0E E4 30 00 FC 30 00 C8 30 00 99 30 00 4F 33 00 03 0E E4 30 00 FC 30 00 EB' - '30 00 94 FF 00 01 0C E4 30 00 F3 32 00 01 07 E4 30 00 6D FF 00 01 0C E5 30 00 50 33 00 03 0E E6' - '30 00 A2 30 00 F3 30 00 95 FF 00 01 0C E6 30 00 F4 32 00 01 07 E6 30 00 6E FF 00 01 0C E7 30 00' - '96 FF 00 01 0C E8 30 00 F5 32 00 01 07 E8 30 00 F6 32 00 01 07 E9 30 00 97 FF 00 01 0C E9 30 00' - '51 33 00 04 0E EA 30 00 C3 30 00 C8 30 00 EB 30 00 52 33 00 02 0E EA 30 00 E9 30 00 F7 32 00 01' - '07 EA 30 00 98 FF 00 01 0C EA 30 00 53 33 00 04 0E EB 30 00 D2 30 00 9A 30 00 FC 30 00 54 33 00' - '05 0E EB 30 00 FC 30 00 D5 30 00 99 30 00 EB 30 00 F8 32 00 01 07 EB 30 00 99 FF 00 01 0C EB 30' - '00 55 33 00 02 0E EC 30 00 E0 30 00 56 33 00 06 0E EC 30 00 F3 30 00 C8 30 00 B1 30 00 99 30 00' - 'F3 30 00 F9 32 00 01 07 EC 30 00 9A FF 00 01 0C EC 30 00 9B FF 00 01 0C ED 30 00 FA 32 00 01 07' - 'ED 30 00 F7 30 00 02 00 EF 30 00 99 30 00 57 33 00 03 0E EF 30 00 C3 30 00 C8 30 00 FB 32 00 01' - '07 EF 30 00 9C FF 00 01 0C EF 30 00 F8 30 00 02 00 F0 30 00 99 30 00 FC 32 00 01 07 F0 30 00 F9' - '30 00 02 00 F1 30 00 99 30 00 FD 32 00 01 07 F1 30 00 FA 30 00 02 00 F2 30 00 99 30 00 66 FF 00' - '01 0C F2 30 00 FE 32 00 01 07 F2 30 00 9D FF 00 01 0C F3 30 00 65 FF 00 01 0C FB 30 00 70 FF 00' - '01 0C FC 30 00 FE 30 00 02 00 FD 30 00 99 30 00 80 32 00 01 07 00 4E 00 29 F2 01 01 0E 00 4E 00' - '00 2F 00 01 10 00 4E 00 92 31 00 01 08 00 4E 00 9C 31 00 01 08 01 4E 00 86 32 00 01 07 03 4E 00' - '94 31 00 01 08 09 4E 00 82 32 00 01 07 09 4E 00 2A F2 01 01 0E 09 4E 00 96 31 00 01 08 0A 4E 00' - 'A4 32 00 01 07 0A 4E 00 A6 32 00 01 07 0B 4E 00 98 31 00 01 08 0B 4E 00 9B 31 00 01 08 19 4E 00' - '01 2F 00 01 10 28 4E 00 A5 32 00 01 07 2D 4E 00 2D F2 01 01 0E 2D 4E 00 97 31 00 01 08 2D 4E 00' - '02 2F 00 01 10 36 4E 00 03 2F 00 01 10 3F 4E 00 9A 31 00 01 08 59 4E 00 04 2F 00 01 10 59 4E 00' - '88 32 00 01 07 5D 4E 00 05 2F 00 01 10 85 4E 00 93 31 00 01 08 8C 4E 00 06 2F 00 01 10 8C 4E 00' - '14 F2 01 01 0E 8C 4E 00 81 32 00 01 07 8C 4E 00 84 32 00 01 07 94 4E 00 07 2F 00 01 10 A0 4E 00' - '18 F2 01 01 0E A4 4E 00 08 2F 00 01 10 BA 4E 00 9F 31 00 01 08 BA 4E 00 FF 32 00 02 0E E4 4E 00' - '8C 54 00 AD 32 00 01 07 01 4F 00 A1 32 00 01 07 11 4F 00 9D 32 00 01 07 2A 51 00 09 2F 00 01 10' - '3F 51 00 0A 2F 00 01 10 65 51 00 87 32 00 01 07 6B 51 00 0B 2F 00 01 10 6B 51 00 85 32 00 01 07' - '6D 51 00 0C 2F 00 01 10 82 51 00 1E F2 01 01 0E 8D 51 00 0D 2F 00 01 10 96 51 00 A2 32 00 01 07' - '99 51 00 0E 2F 00 01 10 AB 51 00 0F 2F 00 01 10 E0 51 00 10 2F 00 01 10 F5 51 00 11 2F 00 01 10' - '00 52 00 20 F2 01 01 0E 1D 52 00 1C F2 01 01 0E 4D 52 00 39 F2 01 01 0E 72 52 00 12 2F 00 01 10' - '9B 52 00 98 32 00 01 07 B4 52 00 13 2F 00 01 10 F9 52 00 14 2F 00 01 10 15 53 00 15 2F 00 01 10' - '1A 53 00 16 2F 00 01 10 38 53 00 A9 32 00 01 07 3B 53 00 89 32 00 01 07 41 53 00 38 30 00 01 10' - '41 53 00 17 2F 00 01 10 41 53 00 39 30 00 01 10 44 53 00 3A 30 00 01 10 45 53 00 AF 32 00 01 07' - '54 53 00 18 2F 00 01 10 5C 53 00 19 2F 00 01 10 69 53 00 9E 32 00 01 07 70 53 00 1A 2F 00 01 10' - '82 53 00 1B 2F 00 01 10 B6 53 00 1C 2F 00 01 10 C8 53 00 12 F2 01 01 0E CC 53 00 1D 2F 00 01 10' - 'E3 53 00 51 F2 01 01 07 EF 53 00 2E F2 01 01 0E F3 53 00 A8 32 00 01 07 F3 53 00 34 F2 01 01 0E' - '08 54 00 94 32 00 01 07 0D 54 00 25 F2 01 01 0E 39 54 00 44 32 00 01 07 4F 55 00 3A F2 01 01 0E' - 'B6 55 00 1E 2F 00 01 10 D7 56 00 83 32 00 01 07 DB 56 00 95 31 00 01 08 DB 56 00 8F 32 00 01 07' - '1F 57 00 1F 2F 00 01 10 1F 57 00 9E 31 00 01 08 30 57 00 20 2F 00 01 10 EB 58 00 24 F2 01 01 0E' - 'F0 58 00 21 2F 00 01 10 02 59 00 22 2F 00 01 10 0A 59 00 23 2F 00 01 10 15 59 00 15 F2 01 01 0E' - '1A 59 00 B0 32 00 01 07 1C 59 00 7D 33 00 02 0E 27 59 00 63 6B 00 24 2F 00 01 10 27 59 00 17 F2' - '01 01 0E 29 59 00 9D 31 00 01 08 29 59 00 25 2F 00 01 10 73 59 00 9B 32 00 01 07 73 59 00 26 2F' - '00 01 10 50 5B 00 11 F2 01 01 0E 57 5B 00 AB 32 00 01 07 66 5B 00 27 2F 00 01 10 80 5B 00 AA 32' - '00 01 07 97 5B 00 28 2F 00 01 10 F8 5B 00 29 2F 00 01 10 0F 5C 00 2A 2F 00 01 10 22 5C 00 2B 2F' - '00 01 10 38 5C 00 2C 2F 00 01 10 6E 5C 00 2D 2F 00 01 10 71 5C 00 2E 2F 00 01 10 DB 5D 00 2F 2F' - '00 01 10 E5 5D 00 2C F2 01 01 0E E6 5D 00 A7 32 00 01 07 E6 5D 00 30 2F 00 01 10 F1 5D 00 31 2F' - '00 01 10 FE 5D 00 32 2F 00 01 10 72 5E 00 7B 33 00 02 0E 73 5E 00 10 62 00 33 2F 00 01 10 7A 5E' - '00 45 32 00 01 07 7C 5E 00 34 2F 00 01 10 7F 5E 00 35 2F 00 01 10 F4 5E 00 36 2F 00 01 10 FE 5E' - '00 37 2F 00 01 10 0B 5F 00 38 2F 00 01 10 13 5F 00 39 2F 00 01 10 50 5F 00 3A 2F 00 01 10 61 5F' - '00 3B 2F 00 01 10 73 5F 00 1D F2 01 01 0E 8C 5F 00 50 F2 01 01 07 97 5F 00 3C 2F 00 01 10 C3 5F' - '00 3D 2F 00 01 10 08 62 00 3E 2F 00 01 10 36 62 00 3F 2F 00 01 10 4B 62 00 10 F2 01 01 0E 4B 62' - '00 31 F2 01 01 0E 53 62 00 27 F2 01 01 0E 95 62 00 2F F2 01 01 0E 07 63 00 28 F2 01 01 0E 55 63' - '00 40 2F 00 01 10 2F 65 00 41 2F 00 01 10 34 65 00 42 2F 00 01 10 87 65 00 46 32 00 01 07 87 65' - '00 43 2F 00 01 10 97 65 00 1B F2 01 01 0E 99 65 00 44 2F 00 01 10 A4 65 00 1F F2 01 01 0E B0 65' - '00 45 2F 00 01 10 B9 65 00 46 2F 00 01 10 E0 65 00 90 32 00 01 07 E5 65 00 47 2F 00 01 10 E5 65' - '00 7E 33 00 02 0E 0E 66 00 BB 6C 00 19 F2 01 01 0E 20 66 00 7C 33 00 02 0E 2D 66 00 8C 54 00 48' - '2F 00 01 10 F0 66 00 8A 32 00 01 07 08 67 00 49 2F 00 01 10 08 67 00 37 F2 01 01 0E 08 67 00 36' - 'F2 01 01 0E 09 67 00 92 32 00 01 07 09 67 00 8D 32 00 01 07 28 67 00 4A 2F 00 01 10 28 67 00 7F' - '33 00 04 0E 2A 68 00 0F 5F 00 1A 4F 00 3E 79 00 91 32 00 01 07 2A 68 00 4B 2F 00 01 10 20 6B 00' - '4C 2F 00 01 10 62 6B 00 A3 32 00 01 07 63 6B 00 4D 2F 00 01 10 79 6B 00 4E 2F 00 01 10 B3 6B 00' - '4F 2F 00 01 10 CB 6B 00 9F 2E 00 01 10 CD 6B 00 50 2F 00 01 10 D4 6B 00 51 2F 00 01 10 DB 6B 00' - '52 2F 00 01 10 0F 6C 00 53 2F 00 01 10 14 6C 00 54 2F 00 01 10 34 6C 00 8C 32 00 01 07 34 6C 00' - '9F 32 00 01 07 E8 6C 00 35 F2 01 01 0E 80 6E 00 26 F2 01 01 0E 14 6F 00 55 2F 00 01 10 6B 70 00' - '8B 32 00 01 07 6B 70 00 1A F2 01 01 0E 21 71 00 56 2F 00 01 10 2A 72 00 57 2F 00 01 10 36 72 00' - '58 2F 00 01 10 3B 72 00 59 2F 00 01 10 3F 72 00 5A 2F 00 01 10 47 72 00 5B 2F 00 01 10 59 72 00' - '5C 2F 00 01 10 5B 72 00 95 32 00 01 07 79 72 00 5D 2F 00 01 10 AC 72 00 5E 2F 00 01 10 84 73 00' - '5F 2F 00 01 10 89 73 00 60 2F 00 01 10 DC 74 00 61 2F 00 01 10 E6 74 00 62 2F 00 01 10 18 75 00' - '22 F2 01 01 0E 1F 75 00 63 2F 00 01 10 1F 75 00 64 2F 00 01 10 28 75 00 65 2F 00 01 10 30 75 00' - '99 31 00 01 08 32 75 00 38 F2 01 01 0E 33 75 00 9A 32 00 01 07 37 75 00 66 2F 00 01 10 8B 75 00' - '67 2F 00 01 10 92 75 00 68 2F 00 01 10 76 76 00 69 2F 00 01 10 7D 76 00 6A 2F 00 01 10 AE 76 00' - '6B 2F 00 01 10 BF 76 00 AC 32 00 01 07 E3 76 00 6C 2F 00 01 10 EE 76 00 6D 2F 00 01 10 DB 77 00' - '6E 2F 00 01 10 E2 77 00 6F 2F 00 01 10 F3 77 00 70 2F 00 01 10 3A 79 00 93 32 00 01 07 3E 79 00' - '97 32 00 01 07 5D 79 00 32 F2 01 01 0E 81 79 00 71 2F 00 01 10 B8 79 00 72 2F 00 01 10 BE 79 00' - '99 32 00 01 07 D8 79 00 73 2F 00 01 10 74 7A 00 33 F2 01 01 0E 7A 7A 00 74 2F 00 01 10 CB 7A 00' - '75 2F 00 01 10 F9 7A 00 47 32 00 01 07 8F 7B 00 76 2F 00 01 10 73 7C 00 77 2F 00 01 10 F8 7C 00' - '21 F2 01 01 0E 42 7D 00 78 2F 00 01 10 36 7F 00 79 2F 00 01 10 51 7F 00 7A 2F 00 01 10 8A 7F 00' - '7B 2F 00 01 10 BD 7F 00 7C 2F 00 01 10 01 80 00 7D 2F 00 01 10 0C 80 00 7E 2F 00 01 10 12 80 00' - '7F 2F 00 01 10 33 80 00 80 2F 00 01 10 7F 80 00 81 2F 00 01 10 89 80 00 82 2F 00 01 10 E3 81 00' - '83 2F 00 01 10 EA 81 00 84 2F 00 01 10 F3 81 00 85 2F 00 01 10 FC 81 00 86 2F 00 01 10 0C 82 00' - '87 2F 00 01 10 1B 82 00 88 2F 00 01 10 1F 82 00 89 2F 00 01 10 6E 82 00 8A 2F 00 01 10 72 82 00' - '8B 2F 00 01 10 78 82 00 8C 2F 00 01 10 4D 86 00 8D 2F 00 01 10 6B 86 00 8E 2F 00 01 10 40 88 00' - '8F 2F 00 01 10 4C 88 00 90 2F 00 01 10 63 88 00 91 2F 00 01 10 7E 89 00 92 2F 00 01 10 8B 89 00' - '93 2F 00 01 10 D2 89 00 16 F2 01 01 0E E3 89 00 94 2F 00 01 10 00 8A 00 95 2F 00 01 10 37 8C 00' - '96 2F 00 01 10 46 8C 00 97 2F 00 01 10 55 8C 00 98 2F 00 01 10 78 8C 00 99 2F 00 01 10 9D 8C 00' - '96 32 00 01 07 A1 8C 00 23 F2 01 01 0E A9 8C 00 AE 32 00 01 07 C7 8C 00 9A 2F 00 01 10 64 8D 00' - '9B 2F 00 01 10 70 8D 00 30 F2 01 01 0E 70 8D 00 9C 2F 00 01 10 B3 8D 00 9D 2F 00 01 10 AB 8E 00' - '9E 2F 00 01 10 CA 8E 00 9F 2F 00 01 10 9B 8F 00 A0 2F 00 01 10 B0 8F 00 A1 2F 00 01 10 B5 8F 00' - '2B F2 01 01 0E 4A 90 00 9C 32 00 01 07 69 90 00 A2 2F 00 01 10 91 90 00 A3 2F 00 01 10 49 91 00' - '3B F2 01 01 0E 4D 91 00 A4 2F 00 01 10 C6 91 00 A5 2F 00 01 10 CC 91 00 8E 32 00 01 07 D1 91 00' - 'A6 2F 00 01 10 D1 91 00 A7 2F 00 01 10 77 95 00 A8 2F 00 01 10 80 95 00 A9 2F 00 01 10 1C 96 00' - 'AA 2F 00 01 10 B6 96 00 AB 2F 00 01 10 B9 96 00 AC 2F 00 01 10 E8 96 00 AD 2F 00 01 10 51 97 00' - 'AE 2F 00 01 10 5E 97 00 AF 2F 00 01 10 62 97 00 B0 2F 00 01 10 69 97 00 B1 2F 00 01 10 CB 97 00' - 'B2 2F 00 01 10 ED 97 00 B3 2F 00 01 10 F3 97 00 B4 2F 00 01 10 01 98 00 A0 32 00 01 07 05 98 00' - 'B5 2F 00 01 10 A8 98 00 B6 2F 00 01 10 DB 98 00 B7 2F 00 01 10 DF 98 00 B8 2F 00 01 10 96 99 00' - 'B9 2F 00 01 10 99 99 00 BA 2F 00 01 10 AC 99 00 BB 2F 00 01 10 A8 9A 00 BC 2F 00 01 10 D8 9A 00' - 'BD 2F 00 01 10 DF 9A 00 BE 2F 00 01 10 25 9B 00 BF 2F 00 01 10 2F 9B 00 C0 2F 00 01 10 32 9B 00' - 'C1 2F 00 01 10 3C 9B 00 C2 2F 00 01 10 5A 9B 00 C3 2F 00 01 10 E5 9C 00 C4 2F 00 01 10 75 9E 00' - 'C5 2F 00 01 10 7F 9E 00 C6 2F 00 01 10 A5 9E 00 C7 2F 00 01 10 BB 9E 00 C8 2F 00 01 10 C3 9E 00' - 'C9 2F 00 01 10 CD 9E 00 CA 2F 00 01 10 D1 9E 00 CB 2F 00 01 10 F9 9E 00 CC 2F 00 01 10 FD 9E 00' - 'CD 2F 00 01 10 0E 9F 00 CE 2F 00 01 10 13 9F 00 CF 2F 00 01 10 20 9F 00 D0 2F 00 01 10 3B 9F 00' - 'D1 2F 00 01 10 4A 9F 00 D2 2F 00 01 10 52 9F 00 D3 2F 00 01 10 8D 9F 00 D4 2F 00 01 10 9C 9F 00' - 'F3 2E 00 01 10 9F 9F 00 D5 2F 00 01 10 A0 9F 00 5C AB 00 01 08 27 A7 00 70 A7 00 01 08 6F A7 00' - '5D AB 00 01 08 37 AB 00 5F AB 00 01 08 52 AB 00 9A 10 01 02 00 99 10 01 BA 10 01 9C 10 01 02 00' - '9B 10 01 BA 10 01 AB 10 01 02 00 A5 10 01 BA 10 01 2E 11 01 02 00 31 11 01 27 11 01 2F 11 01 02' - '00 32 11 01 27 11 01 4B 13 01 02 00 47 13 01 3E 13 01 4C 13 01 02 00 47 13 01 57 13 01 BC 14 01' - '02 00 B9 14 01 B0 14 01 BB 14 01 02 00 B9 14 01 BA 14 01 BE 14 01 02 00 B9 14 01 BD 14 01 BA 15' - '01 02 00 B8 15 01 AF 15 01 BB 15 01 02 00 B9 15 01 AF 15 01 38 19 01 02 00 35 19 01 30 19 01' -} +/**************************************************************************************************** + + + ..\..\jcl\source\common\JclUnicode.rc + + + Produced by UDExtract written by Dipl. Ing. Mike Lischke, public@lischke-online.de + + +****************************************************************************************************/ + + +LANGUAGE 0,0 CATEGORIES UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE +{ + '00 7E 02 00 00 41 00 00 5A 00 00 C0 00 00 D6 00 00 D8 00 00 DE 00 00 00 01 00 00 01 00 02 01 00' + '02 01 00 04 01 00 04 01 00 06 01 00 06 01 00 08 01 00 08 01 00 0A 01 00 0A 01 00 0C 01 00 0C 01' + '00 0E 01 00 0E 01 00 10 01 00 10 01 00 12 01 00 12 01 00 14 01 00 14 01 00 16 01 00 16 01 00 18' + '01 00 18 01 00 1A 01 00 1A 01 00 1C 01 00 1C 01 00 1E 01 00 1E 01 00 20 01 00 20 01 00 22 01 00' + '22 01 00 24 01 00 24 01 00 26 01 00 26 01 00 28 01 00 28 01 00 2A 01 00 2A 01 00 2C 01 00 2C 01' + '00 2E 01 00 2E 01 00 30 01 00 30 01 00 32 01 00 32 01 00 34 01 00 34 01 00 36 01 00 36 01 00 39' + '01 00 39 01 00 3B 01 00 3B 01 00 3D 01 00 3D 01 00 3F 01 00 3F 01 00 41 01 00 41 01 00 43 01 00' + '43 01 00 45 01 00 45 01 00 47 01 00 47 01 00 4A 01 00 4A 01 00 4C 01 00 4C 01 00 4E 01 00 4E 01' + '00 50 01 00 50 01 00 52 01 00 52 01 00 54 01 00 54 01 00 56 01 00 56 01 00 58 01 00 58 01 00 5A' + '01 00 5A 01 00 5C 01 00 5C 01 00 5E 01 00 5E 01 00 60 01 00 60 01 00 62 01 00 62 01 00 64 01 00' + '64 01 00 66 01 00 66 01 00 68 01 00 68 01 00 6A 01 00 6A 01 00 6C 01 00 6C 01 00 6E 01 00 6E 01' + '00 70 01 00 70 01 00 72 01 00 72 01 00 74 01 00 74 01 00 76 01 00 76 01 00 78 01 00 79 01 00 7B' + '01 00 7B 01 00 7D 01 00 7D 01 00 81 01 00 82 01 00 84 01 00 84 01 00 86 01 00 87 01 00 89 01 00' + '8B 01 00 8E 01 00 91 01 00 93 01 00 94 01 00 96 01 00 98 01 00 9C 01 00 9D 01 00 9F 01 00 A0 01' + '00 A2 01 00 A2 01 00 A4 01 00 A4 01 00 A6 01 00 A7 01 00 A9 01 00 A9 01 00 AC 01 00 AC 01 00 AE' + '01 00 AF 01 00 B1 01 00 B3 01 00 B5 01 00 B5 01 00 B7 01 00 B8 01 00 BC 01 00 BC 01 00 C4 01 00' + 'C4 01 00 C7 01 00 C7 01 00 CA 01 00 CA 01 00 CD 01 00 CD 01 00 CF 01 00 CF 01 00 D1 01 00 D1 01' + '00 D3 01 00 D3 01 00 D5 01 00 D5 01 00 D7 01 00 D7 01 00 D9 01 00 D9 01 00 DB 01 00 DB 01 00 DE' + '01 00 DE 01 00 E0 01 00 E0 01 00 E2 01 00 E2 01 00 E4 01 00 E4 01 00 E6 01 00 E6 01 00 E8 01 00' + 'E8 01 00 EA 01 00 EA 01 00 EC 01 00 EC 01 00 EE 01 00 EE 01 00 F1 01 00 F1 01 00 F4 01 00 F4 01' + '00 F6 01 00 F8 01 00 FA 01 00 FA 01 00 FC 01 00 FC 01 00 FE 01 00 FE 01 00 00 02 00 00 02 00 02' + '02 00 02 02 00 04 02 00 04 02 00 06 02 00 06 02 00 08 02 00 08 02 00 0A 02 00 0A 02 00 0C 02 00' + '0C 02 00 0E 02 00 0E 02 00 10 02 00 10 02 00 12 02 00 12 02 00 14 02 00 14 02 00 16 02 00 16 02' + '00 18 02 00 18 02 00 1A 02 00 1A 02 00 1C 02 00 1C 02 00 1E 02 00 1E 02 00 20 02 00 20 02 00 22' + '02 00 22 02 00 24 02 00 24 02 00 26 02 00 26 02 00 28 02 00 28 02 00 2A 02 00 2A 02 00 2C 02 00' + '2C 02 00 2E 02 00 2E 02 00 30 02 00 30 02 00 32 02 00 32 02 00 3A 02 00 3B 02 00 3D 02 00 3E 02' + '00 41 02 00 41 02 00 43 02 00 46 02 00 48 02 00 48 02 00 4A 02 00 4A 02 00 4C 02 00 4C 02 00 4E' + '02 00 4E 02 00 70 03 00 70 03 00 72 03 00 72 03 00 76 03 00 76 03 00 7F 03 00 7F 03 00 86 03 00' + '86 03 00 88 03 00 8A 03 00 8C 03 00 8C 03 00 8E 03 00 8F 03 00 91 03 00 A1 03 00 A3 03 00 AB 03' + '00 CF 03 00 CF 03 00 D2 03 00 D4 03 00 D8 03 00 D8 03 00 DA 03 00 DA 03 00 DC 03 00 DC 03 00 DE' + '03 00 DE 03 00 E0 03 00 E0 03 00 E2 03 00 E2 03 00 E4 03 00 E4 03 00 E6 03 00 E6 03 00 E8 03 00' + 'E8 03 00 EA 03 00 EA 03 00 EC 03 00 EC 03 00 EE 03 00 EE 03 00 F4 03 00 F4 03 00 F7 03 00 F7 03' + '00 F9 03 00 FA 03 00 FD 03 00 2F 04 00 60 04 00 60 04 00 62 04 00 62 04 00 64 04 00 64 04 00 66' + '04 00 66 04 00 68 04 00 68 04 00 6A 04 00 6A 04 00 6C 04 00 6C 04 00 6E 04 00 6E 04 00 70 04 00' + '70 04 00 72 04 00 72 04 00 74 04 00 74 04 00 76 04 00 76 04 00 78 04 00 78 04 00 7A 04 00 7A 04' + '00 7C 04 00 7C 04 00 7E 04 00 7E 04 00 80 04 00 80 04 00 8A 04 00 8A 04 00 8C 04 00 8C 04 00 8E' + '04 00 8E 04 00 90 04 00 90 04 00 92 04 00 92 04 00 94 04 00 94 04 00 96 04 00 96 04 00 98 04 00' + '98 04 00 9A 04 00 9A 04 00 9C 04 00 9C 04 00 9E 04 00 9E 04 00 A0 04 00 A0 04 00 A2 04 00 A2 04' + '00 A4 04 00 A4 04 00 A6 04 00 A6 04 00 A8 04 00 A8 04 00 AA 04 00 AA 04 00 AC 04 00 AC 04 00 AE' + '04 00 AE 04 00 B0 04 00 B0 04 00 B2 04 00 B2 04 00 B4 04 00 B4 04 00 B6 04 00 B6 04 00 B8 04 00' + 'B8 04 00 BA 04 00 BA 04 00 BC 04 00 BC 04 00 BE 04 00 BE 04 00 C0 04 00 C1 04 00 C3 04 00 C3 04' + '00 C5 04 00 C5 04 00 C7 04 00 C7 04 00 C9 04 00 C9 04 00 CB 04 00 CB 04 00 CD 04 00 CD 04 00 D0' + '04 00 D0 04 00 D2 04 00 D2 04 00 D4 04 00 D4 04 00 D6 04 00 D6 04 00 D8 04 00 D8 04 00 DA 04 00' + 'DA 04 00 DC 04 00 DC 04 00 DE 04 00 DE 04 00 E0 04 00 E0 04 00 E2 04 00 E2 04 00 E4 04 00 E4 04' + '00 E6 04 00 E6 04 00 E8 04 00 E8 04 00 EA 04 00 EA 04 00 EC 04 00 EC 04 00 EE 04 00 EE 04 00 F0' + '04 00 F0 04 00 F2 04 00 F2 04 00 F4 04 00 F4 04 00 F6 04 00 F6 04 00 F8 04 00 F8 04 00 FA 04 00' + 'FA 04 00 FC 04 00 FC 04 00 FE 04 00 FE 04 00 00 05 00 00 05 00 02 05 00 02 05 00 04 05 00 04 05' + '00 06 05 00 06 05 00 08 05 00 08 05 00 0A 05 00 0A 05 00 0C 05 00 0C 05 00 0E 05 00 0E 05 00 10' + '05 00 10 05 00 12 05 00 12 05 00 14 05 00 14 05 00 16 05 00 16 05 00 18 05 00 18 05 00 1A 05 00' + '1A 05 00 1C 05 00 1C 05 00 1E 05 00 1E 05 00 20 05 00 20 05 00 22 05 00 22 05 00 24 05 00 24 05' + '00 26 05 00 26 05 00 28 05 00 28 05 00 2A 05 00 2A 05 00 2C 05 00 2C 05 00 2E 05 00 2E 05 00 31' + '05 00 56 05 00 A0 10 00 C5 10 00 C7 10 00 C7 10 00 CD 10 00 CD 10 00 A0 13 00 F5 13 00 90 1C 00' + 'BA 1C 00 BD 1C 00 BF 1C 00 00 1E 00 00 1E 00 02 1E 00 02 1E 00 04 1E 00 04 1E 00 06 1E 00 06 1E' + '00 08 1E 00 08 1E 00 0A 1E 00 0A 1E 00 0C 1E 00 0C 1E 00 0E 1E 00 0E 1E 00 10 1E 00 10 1E 00 12' + '1E 00 12 1E 00 14 1E 00 14 1E 00 16 1E 00 16 1E 00 18 1E 00 18 1E 00 1A 1E 00 1A 1E 00 1C 1E 00' + '1C 1E 00 1E 1E 00 1E 1E 00 20 1E 00 20 1E 00 22 1E 00 22 1E 00 24 1E 00 24 1E 00 26 1E 00 26 1E' + '00 28 1E 00 28 1E 00 2A 1E 00 2A 1E 00 2C 1E 00 2C 1E 00 2E 1E 00 2E 1E 00 30 1E 00 30 1E 00 32' + '1E 00 32 1E 00 34 1E 00 34 1E 00 36 1E 00 36 1E 00 38 1E 00 38 1E 00 3A 1E 00 3A 1E 00 3C 1E 00' + '3C 1E 00 3E 1E 00 3E 1E 00 40 1E 00 40 1E 00 42 1E 00 42 1E 00 44 1E 00 44 1E 00 46 1E 00 46 1E' + '00 48 1E 00 48 1E 00 4A 1E 00 4A 1E 00 4C 1E 00 4C 1E 00 4E 1E 00 4E 1E 00 50 1E 00 50 1E 00 52' + '1E 00 52 1E 00 54 1E 00 54 1E 00 56 1E 00 56 1E 00 58 1E 00 58 1E 00 5A 1E 00 5A 1E 00 5C 1E 00' + '5C 1E 00 5E 1E 00 5E 1E 00 60 1E 00 60 1E 00 62 1E 00 62 1E 00 64 1E 00 64 1E 00 66 1E 00 66 1E' + '00 68 1E 00 68 1E 00 6A 1E 00 6A 1E 00 6C 1E 00 6C 1E 00 6E 1E 00 6E 1E 00 70 1E 00 70 1E 00 72' + '1E 00 72 1E 00 74 1E 00 74 1E 00 76 1E 00 76 1E 00 78 1E 00 78 1E 00 7A 1E 00 7A 1E 00 7C 1E 00' + '7C 1E 00 7E 1E 00 7E 1E 00 80 1E 00 80 1E 00 82 1E 00 82 1E 00 84 1E 00 84 1E 00 86 1E 00 86 1E' + '00 88 1E 00 88 1E 00 8A 1E 00 8A 1E 00 8C 1E 00 8C 1E 00 8E 1E 00 8E 1E 00 90 1E 00 90 1E 00 92' + '1E 00 92 1E 00 94 1E 00 94 1E 00 9E 1E 00 9E 1E 00 A0 1E 00 A0 1E 00 A2 1E 00 A2 1E 00 A4 1E 00' + 'A4 1E 00 A6 1E 00 A6 1E 00 A8 1E 00 A8 1E 00 AA 1E 00 AA 1E 00 AC 1E 00 AC 1E 00 AE 1E 00 AE 1E' + '00 B0 1E 00 B0 1E 00 B2 1E 00 B2 1E 00 B4 1E 00 B4 1E 00 B6 1E 00 B6 1E 00 B8 1E 00 B8 1E 00 BA' + '1E 00 BA 1E 00 BC 1E 00 BC 1E 00 BE 1E 00 BE 1E 00 C0 1E 00 C0 1E 00 C2 1E 00 C2 1E 00 C4 1E 00' + 'C4 1E 00 C6 1E 00 C6 1E 00 C8 1E 00 C8 1E 00 CA 1E 00 CA 1E 00 CC 1E 00 CC 1E 00 CE 1E 00 CE 1E' + '00 D0 1E 00 D0 1E 00 D2 1E 00 D2 1E 00 D4 1E 00 D4 1E 00 D6 1E 00 D6 1E 00 D8 1E 00 D8 1E 00 DA' + '1E 00 DA 1E 00 DC 1E 00 DC 1E 00 DE 1E 00 DE 1E 00 E0 1E 00 E0 1E 00 E2 1E 00 E2 1E 00 E4 1E 00' + 'E4 1E 00 E6 1E 00 E6 1E 00 E8 1E 00 E8 1E 00 EA 1E 00 EA 1E 00 EC 1E 00 EC 1E 00 EE 1E 00 EE 1E' + '00 F0 1E 00 F0 1E 00 F2 1E 00 F2 1E 00 F4 1E 00 F4 1E 00 F6 1E 00 F6 1E 00 F8 1E 00 F8 1E 00 FA' + '1E 00 FA 1E 00 FC 1E 00 FC 1E 00 FE 1E 00 FE 1E 00 08 1F 00 0F 1F 00 18 1F 00 1D 1F 00 28 1F 00' + '2F 1F 00 38 1F 00 3F 1F 00 48 1F 00 4D 1F 00 59 1F 00 59 1F 00 5B 1F 00 5B 1F 00 5D 1F 00 5D 1F' + '00 5F 1F 00 5F 1F 00 68 1F 00 6F 1F 00 B8 1F 00 BB 1F 00 C8 1F 00 CB 1F 00 D8 1F 00 DB 1F 00 E8' + '1F 00 EC 1F 00 F8 1F 00 FB 1F 00 02 21 00 02 21 00 07 21 00 07 21 00 0B 21 00 0D 21 00 10 21 00' + '12 21 00 15 21 00 15 21 00 19 21 00 1D 21 00 24 21 00 24 21 00 26 21 00 26 21 00 28 21 00 28 21' + '00 2A 21 00 2D 21 00 30 21 00 33 21 00 3E 21 00 3F 21 00 45 21 00 45 21 00 83 21 00 83 21 00 00' + '2C 00 2E 2C 00 60 2C 00 60 2C 00 62 2C 00 64 2C 00 67 2C 00 67 2C 00 69 2C 00 69 2C 00 6B 2C 00' + '6B 2C 00 6D 2C 00 70 2C 00 72 2C 00 72 2C 00 75 2C 00 75 2C 00 7E 2C 00 80 2C 00 82 2C 00 82 2C' + '00 84 2C 00 84 2C 00 86 2C 00 86 2C 00 88 2C 00 88 2C 00 8A 2C 00 8A 2C 00 8C 2C 00 8C 2C 00 8E' + '2C 00 8E 2C 00 90 2C 00 90 2C 00 92 2C 00 92 2C 00 94 2C 00 94 2C 00 96 2C 00 96 2C 00 98 2C 00' + '98 2C 00 9A 2C 00 9A 2C 00 9C 2C 00 9C 2C 00 9E 2C 00 9E 2C 00 A0 2C 00 A0 2C 00 A2 2C 00 A2 2C' + '00 A4 2C 00 A4 2C 00 A6 2C 00 A6 2C 00 A8 2C 00 A8 2C 00 AA 2C 00 AA 2C 00 AC 2C 00 AC 2C 00 AE' + '2C 00 AE 2C 00 B0 2C 00 B0 2C 00 B2 2C 00 B2 2C 00 B4 2C 00 B4 2C 00 B6 2C 00 B6 2C 00 B8 2C 00' + 'B8 2C 00 BA 2C 00 BA 2C 00 BC 2C 00 BC 2C 00 BE 2C 00 BE 2C 00 C0 2C 00 C0 2C 00 C2 2C 00 C2 2C' + '00 C4 2C 00 C4 2C 00 C6 2C 00 C6 2C 00 C8 2C 00 C8 2C 00 CA 2C 00 CA 2C 00 CC 2C 00 CC 2C 00 CE' + '2C 00 CE 2C 00 D0 2C 00 D0 2C 00 D2 2C 00 D2 2C 00 D4 2C 00 D4 2C 00 D6 2C 00 D6 2C 00 D8 2C 00' + 'D8 2C 00 DA 2C 00 DA 2C 00 DC 2C 00 DC 2C 00 DE 2C 00 DE 2C 00 E0 2C 00 E0 2C 00 E2 2C 00 E2 2C' + '00 EB 2C 00 EB 2C 00 ED 2C 00 ED 2C 00 F2 2C 00 F2 2C 00 40 A6 00 40 A6 00 42 A6 00 42 A6 00 44' + 'A6 00 44 A6 00 46 A6 00 46 A6 00 48 A6 00 48 A6 00 4A A6 00 4A A6 00 4C A6 00 4C A6 00 4E A6 00' + '4E A6 00 50 A6 00 50 A6 00 52 A6 00 52 A6 00 54 A6 00 54 A6 00 56 A6 00 56 A6 00 58 A6 00 58 A6' + '00 5A A6 00 5A A6 00 5C A6 00 5C A6 00 5E A6 00 5E A6 00 60 A6 00 60 A6 00 62 A6 00 62 A6 00 64' + 'A6 00 64 A6 00 66 A6 00 66 A6 00 68 A6 00 68 A6 00 6A A6 00 6A A6 00 6C A6 00 6C A6 00 80 A6 00' + '80 A6 00 82 A6 00 82 A6 00 84 A6 00 84 A6 00 86 A6 00 86 A6 00 88 A6 00 88 A6 00 8A A6 00 8A A6' + '00 8C A6 00 8C A6 00 8E A6 00 8E A6 00 90 A6 00 90 A6 00 92 A6 00 92 A6 00 94 A6 00 94 A6 00 96' + 'A6 00 96 A6 00 98 A6 00 98 A6 00 9A A6 00 9A A6 00 22 A7 00 22 A7 00 24 A7 00 24 A7 00 26 A7 00' + '26 A7 00 28 A7 00 28 A7 00 2A A7 00 2A A7 00 2C A7 00 2C A7 00 2E A7 00 2E A7 00 32 A7 00 32 A7' + '00 34 A7 00 34 A7 00 36 A7 00 36 A7 00 38 A7 00 38 A7 00 3A A7 00 3A A7 00 3C A7 00 3C A7 00 3E' + 'A7 00 3E A7 00 40 A7 00 40 A7 00 42 A7 00 42 A7 00 44 A7 00 44 A7 00 46 A7 00 46 A7 00 48 A7 00' + '48 A7 00 4A A7 00 4A A7 00 4C A7 00 4C A7 00 4E A7 00 4E A7 00 50 A7 00 50 A7 00 52 A7 00 52 A7' + '00 54 A7 00 54 A7 00 56 A7 00 56 A7 00 58 A7 00 58 A7 00 5A A7 00 5A A7 00 5C A7 00 5C A7 00 5E' + 'A7 00 5E A7 00 60 A7 00 60 A7 00 62 A7 00 62 A7 00 64 A7 00 64 A7 00 66 A7 00 66 A7 00 68 A7 00' + '68 A7 00 6A A7 00 6A A7 00 6C A7 00 6C A7 00 6E A7 00 6E A7 00 79 A7 00 79 A7 00 7B A7 00 7B A7' + '00 7D A7 00 7E A7 00 80 A7 00 80 A7 00 82 A7 00 82 A7 00 84 A7 00 84 A7 00 86 A7 00 86 A7 00 8B' + 'A7 00 8B A7 00 8D A7 00 8D A7 00 90 A7 00 90 A7 00 92 A7 00 92 A7 00 96 A7 00 96 A7 00 98 A7 00' + '98 A7 00 9A A7 00 9A A7 00 9C A7 00 9C A7 00 9E A7 00 9E A7 00 A0 A7 00 A0 A7 00 A2 A7 00 A2 A7' + '00 A4 A7 00 A4 A7 00 A6 A7 00 A6 A7 00 A8 A7 00 A8 A7 00 AA A7 00 AE A7 00 B0 A7 00 B4 A7 00 B6' + 'A7 00 B6 A7 00 B8 A7 00 B8 A7 00 BA A7 00 BA A7 00 BC A7 00 BC A7 00 BE A7 00 BE A7 00 C2 A7 00' + 'C2 A7 00 C4 A7 00 C7 A7 00 C9 A7 00 C9 A7 00 F5 A7 00 F5 A7 00 21 FF 00 3A FF 00 00 04 01 27 04' + '01 B0 04 01 D3 04 01 80 0C 01 B2 0C 01 A0 18 01 BF 18 01 40 6E 01 5F 6E 01 00 D4 01 19 D4 01 34' + 'D4 01 4D D4 01 68 D4 01 81 D4 01 9C D4 01 9C D4 01 9E D4 01 9F D4 01 A2 D4 01 A2 D4 01 A5 D4 01' + 'A6 D4 01 A9 D4 01 AC D4 01 AE D4 01 B5 D4 01 D0 D4 01 E9 D4 01 04 D5 01 05 D5 01 07 D5 01 0A D5' + '01 0D D5 01 14 D5 01 16 D5 01 1C D5 01 38 D5 01 39 D5 01 3B D5 01 3E D5 01 40 D5 01 44 D5 01 46' + 'D5 01 46 D5 01 4A D5 01 50 D5 01 6C D5 01 85 D5 01 A0 D5 01 B9 D5 01 D4 D5 01 ED D5 01 08 D6 01' + '21 D6 01 3C D6 01 55 D6 01 70 D6 01 89 D6 01 A8 D6 01 C0 D6 01 E2 D6 01 FA D6 01 1C D7 01 34 D7' + '01 56 D7 01 6E D7 01 90 D7 01 A8 D7 01 CA D7 01 CA D7 01 00 E9 01 21 E9 01 01 85 02 00 00 61 00' + '00 7A 00 00 B5 00 00 B5 00 00 DF 00 00 F6 00 00 F8 00 00 FF 00 00 01 01 00 01 01 00 03 01 00 03' + '01 00 05 01 00 05 01 00 07 01 00 07 01 00 09 01 00 09 01 00 0B 01 00 0B 01 00 0D 01 00 0D 01 00' + '0F 01 00 0F 01 00 11 01 00 11 01 00 13 01 00 13 01 00 15 01 00 15 01 00 17 01 00 17 01 00 19 01' + '00 19 01 00 1B 01 00 1B 01 00 1D 01 00 1D 01 00 1F 01 00 1F 01 00 21 01 00 21 01 00 23 01 00 23' + '01 00 25 01 00 25 01 00 27 01 00 27 01 00 29 01 00 29 01 00 2B 01 00 2B 01 00 2D 01 00 2D 01 00' + '2F 01 00 2F 01 00 31 01 00 31 01 00 33 01 00 33 01 00 35 01 00 35 01 00 37 01 00 38 01 00 3A 01' + '00 3A 01 00 3C 01 00 3C 01 00 3E 01 00 3E 01 00 40 01 00 40 01 00 42 01 00 42 01 00 44 01 00 44' + '01 00 46 01 00 46 01 00 48 01 00 49 01 00 4B 01 00 4B 01 00 4D 01 00 4D 01 00 4F 01 00 4F 01 00' + '51 01 00 51 01 00 53 01 00 53 01 00 55 01 00 55 01 00 57 01 00 57 01 00 59 01 00 59 01 00 5B 01' + '00 5B 01 00 5D 01 00 5D 01 00 5F 01 00 5F 01 00 61 01 00 61 01 00 63 01 00 63 01 00 65 01 00 65' + '01 00 67 01 00 67 01 00 69 01 00 69 01 00 6B 01 00 6B 01 00 6D 01 00 6D 01 00 6F 01 00 6F 01 00' + '71 01 00 71 01 00 73 01 00 73 01 00 75 01 00 75 01 00 77 01 00 77 01 00 7A 01 00 7A 01 00 7C 01' + '00 7C 01 00 7E 01 00 80 01 00 83 01 00 83 01 00 85 01 00 85 01 00 88 01 00 88 01 00 8C 01 00 8D' + '01 00 92 01 00 92 01 00 95 01 00 95 01 00 99 01 00 9B 01 00 9E 01 00 9E 01 00 A1 01 00 A1 01 00' + 'A3 01 00 A3 01 00 A5 01 00 A5 01 00 A8 01 00 A8 01 00 AA 01 00 AB 01 00 AD 01 00 AD 01 00 B0 01' + '00 B0 01 00 B4 01 00 B4 01 00 B6 01 00 B6 01 00 B9 01 00 BA 01 00 BD 01 00 BF 01 00 C6 01 00 C6' + '01 00 C9 01 00 C9 01 00 CC 01 00 CC 01 00 CE 01 00 CE 01 00 D0 01 00 D0 01 00 D2 01 00 D2 01 00' + 'D4 01 00 D4 01 00 D6 01 00 D6 01 00 D8 01 00 D8 01 00 DA 01 00 DA 01 00 DC 01 00 DD 01 00 DF 01' + '00 DF 01 00 E1 01 00 E1 01 00 E3 01 00 E3 01 00 E5 01 00 E5 01 00 E7 01 00 E7 01 00 E9 01 00 E9' + '01 00 EB 01 00 EB 01 00 ED 01 00 ED 01 00 EF 01 00 F0 01 00 F3 01 00 F3 01 00 F5 01 00 F5 01 00' + 'F9 01 00 F9 01 00 FB 01 00 FB 01 00 FD 01 00 FD 01 00 FF 01 00 FF 01 00 01 02 00 01 02 00 03 02' + '00 03 02 00 05 02 00 05 02 00 07 02 00 07 02 00 09 02 00 09 02 00 0B 02 00 0B 02 00 0D 02 00 0D' + '02 00 0F 02 00 0F 02 00 11 02 00 11 02 00 13 02 00 13 02 00 15 02 00 15 02 00 17 02 00 17 02 00' + '19 02 00 19 02 00 1B 02 00 1B 02 00 1D 02 00 1D 02 00 1F 02 00 1F 02 00 21 02 00 21 02 00 23 02' + '00 23 02 00 25 02 00 25 02 00 27 02 00 27 02 00 29 02 00 29 02 00 2B 02 00 2B 02 00 2D 02 00 2D' + '02 00 2F 02 00 2F 02 00 31 02 00 31 02 00 33 02 00 39 02 00 3C 02 00 3C 02 00 3F 02 00 40 02 00' + '42 02 00 42 02 00 47 02 00 47 02 00 49 02 00 49 02 00 4B 02 00 4B 02 00 4D 02 00 4D 02 00 4F 02' + '00 93 02 00 95 02 00 AF 02 00 71 03 00 71 03 00 73 03 00 73 03 00 77 03 00 77 03 00 7B 03 00 7D' + '03 00 90 03 00 90 03 00 AC 03 00 CE 03 00 D0 03 00 D1 03 00 D5 03 00 D7 03 00 D9 03 00 D9 03 00' + 'DB 03 00 DB 03 00 DD 03 00 DD 03 00 DF 03 00 DF 03 00 E1 03 00 E1 03 00 E3 03 00 E3 03 00 E5 03' + '00 E5 03 00 E7 03 00 E7 03 00 E9 03 00 E9 03 00 EB 03 00 EB 03 00 ED 03 00 ED 03 00 EF 03 00 F3' + '03 00 F5 03 00 F5 03 00 F8 03 00 F8 03 00 FB 03 00 FC 03 00 30 04 00 5F 04 00 61 04 00 61 04 00' + '63 04 00 63 04 00 65 04 00 65 04 00 67 04 00 67 04 00 69 04 00 69 04 00 6B 04 00 6B 04 00 6D 04' + '00 6D 04 00 6F 04 00 6F 04 00 71 04 00 71 04 00 73 04 00 73 04 00 75 04 00 75 04 00 77 04 00 77' + '04 00 79 04 00 79 04 00 7B 04 00 7B 04 00 7D 04 00 7D 04 00 7F 04 00 7F 04 00 81 04 00 81 04 00' + '8B 04 00 8B 04 00 8D 04 00 8D 04 00 8F 04 00 8F 04 00 91 04 00 91 04 00 93 04 00 93 04 00 95 04' + '00 95 04 00 97 04 00 97 04 00 99 04 00 99 04 00 9B 04 00 9B 04 00 9D 04 00 9D 04 00 9F 04 00 9F' + '04 00 A1 04 00 A1 04 00 A3 04 00 A3 04 00 A5 04 00 A5 04 00 A7 04 00 A7 04 00 A9 04 00 A9 04 00' + 'AB 04 00 AB 04 00 AD 04 00 AD 04 00 AF 04 00 AF 04 00 B1 04 00 B1 04 00 B3 04 00 B3 04 00 B5 04' + '00 B5 04 00 B7 04 00 B7 04 00 B9 04 00 B9 04 00 BB 04 00 BB 04 00 BD 04 00 BD 04 00 BF 04 00 BF' + '04 00 C2 04 00 C2 04 00 C4 04 00 C4 04 00 C6 04 00 C6 04 00 C8 04 00 C8 04 00 CA 04 00 CA 04 00' + 'CC 04 00 CC 04 00 CE 04 00 CF 04 00 D1 04 00 D1 04 00 D3 04 00 D3 04 00 D5 04 00 D5 04 00 D7 04' + '00 D7 04 00 D9 04 00 D9 04 00 DB 04 00 DB 04 00 DD 04 00 DD 04 00 DF 04 00 DF 04 00 E1 04 00 E1' + '04 00 E3 04 00 E3 04 00 E5 04 00 E5 04 00 E7 04 00 E7 04 00 E9 04 00 E9 04 00 EB 04 00 EB 04 00' + 'ED 04 00 ED 04 00 EF 04 00 EF 04 00 F1 04 00 F1 04 00 F3 04 00 F3 04 00 F5 04 00 F5 04 00 F7 04' + '00 F7 04 00 F9 04 00 F9 04 00 FB 04 00 FB 04 00 FD 04 00 FD 04 00 FF 04 00 FF 04 00 01 05 00 01' + '05 00 03 05 00 03 05 00 05 05 00 05 05 00 07 05 00 07 05 00 09 05 00 09 05 00 0B 05 00 0B 05 00' + '0D 05 00 0D 05 00 0F 05 00 0F 05 00 11 05 00 11 05 00 13 05 00 13 05 00 15 05 00 15 05 00 17 05' + '00 17 05 00 19 05 00 19 05 00 1B 05 00 1B 05 00 1D 05 00 1D 05 00 1F 05 00 1F 05 00 21 05 00 21' + '05 00 23 05 00 23 05 00 25 05 00 25 05 00 27 05 00 27 05 00 29 05 00 29 05 00 2B 05 00 2B 05 00' + '2D 05 00 2D 05 00 2F 05 00 2F 05 00 60 05 00 88 05 00 D0 10 00 FA 10 00 FD 10 00 FF 10 00 F8 13' + '00 FD 13 00 80 1C 00 88 1C 00 00 1D 00 2B 1D 00 6B 1D 00 77 1D 00 79 1D 00 9A 1D 00 01 1E 00 01' + '1E 00 03 1E 00 03 1E 00 05 1E 00 05 1E 00 07 1E 00 07 1E 00 09 1E 00 09 1E 00 0B 1E 00 0B 1E 00' + '0D 1E 00 0D 1E 00 0F 1E 00 0F 1E 00 11 1E 00 11 1E 00 13 1E 00 13 1E 00 15 1E 00 15 1E 00 17 1E' + '00 17 1E 00 19 1E 00 19 1E 00 1B 1E 00 1B 1E 00 1D 1E 00 1D 1E 00 1F 1E 00 1F 1E 00 21 1E 00 21' + '1E 00 23 1E 00 23 1E 00 25 1E 00 25 1E 00 27 1E 00 27 1E 00 29 1E 00 29 1E 00 2B 1E 00 2B 1E 00' + '2D 1E 00 2D 1E 00 2F 1E 00 2F 1E 00 31 1E 00 31 1E 00 33 1E 00 33 1E 00 35 1E 00 35 1E 00 37 1E' + '00 37 1E 00 39 1E 00 39 1E 00 3B 1E 00 3B 1E 00 3D 1E 00 3D 1E 00 3F 1E 00 3F 1E 00 41 1E 00 41' + '1E 00 43 1E 00 43 1E 00 45 1E 00 45 1E 00 47 1E 00 47 1E 00 49 1E 00 49 1E 00 4B 1E 00 4B 1E 00' + '4D 1E 00 4D 1E 00 4F 1E 00 4F 1E 00 51 1E 00 51 1E 00 53 1E 00 53 1E 00 55 1E 00 55 1E 00 57 1E' + '00 57 1E 00 59 1E 00 59 1E 00 5B 1E 00 5B 1E 00 5D 1E 00 5D 1E 00 5F 1E 00 5F 1E 00 61 1E 00 61' + '1E 00 63 1E 00 63 1E 00 65 1E 00 65 1E 00 67 1E 00 67 1E 00 69 1E 00 69 1E 00 6B 1E 00 6B 1E 00' + '6D 1E 00 6D 1E 00 6F 1E 00 6F 1E 00 71 1E 00 71 1E 00 73 1E 00 73 1E 00 75 1E 00 75 1E 00 77 1E' + '00 77 1E 00 79 1E 00 79 1E 00 7B 1E 00 7B 1E 00 7D 1E 00 7D 1E 00 7F 1E 00 7F 1E 00 81 1E 00 81' + '1E 00 83 1E 00 83 1E 00 85 1E 00 85 1E 00 87 1E 00 87 1E 00 89 1E 00 89 1E 00 8B 1E 00 8B 1E 00' + '8D 1E 00 8D 1E 00 8F 1E 00 8F 1E 00 91 1E 00 91 1E 00 93 1E 00 93 1E 00 95 1E 00 9D 1E 00 9F 1E' + '00 9F 1E 00 A1 1E 00 A1 1E 00 A3 1E 00 A3 1E 00 A5 1E 00 A5 1E 00 A7 1E 00 A7 1E 00 A9 1E 00 A9' + '1E 00 AB 1E 00 AB 1E 00 AD 1E 00 AD 1E 00 AF 1E 00 AF 1E 00 B1 1E 00 B1 1E 00 B3 1E 00 B3 1E 00' + 'B5 1E 00 B5 1E 00 B7 1E 00 B7 1E 00 B9 1E 00 B9 1E 00 BB 1E 00 BB 1E 00 BD 1E 00 BD 1E 00 BF 1E' + '00 BF 1E 00 C1 1E 00 C1 1E 00 C3 1E 00 C3 1E 00 C5 1E 00 C5 1E 00 C7 1E 00 C7 1E 00 C9 1E 00 C9' + '1E 00 CB 1E 00 CB 1E 00 CD 1E 00 CD 1E 00 CF 1E 00 CF 1E 00 D1 1E 00 D1 1E 00 D3 1E 00 D3 1E 00' + 'D5 1E 00 D5 1E 00 D7 1E 00 D7 1E 00 D9 1E 00 D9 1E 00 DB 1E 00 DB 1E 00 DD 1E 00 DD 1E 00 DF 1E' + '00 DF 1E 00 E1 1E 00 E1 1E 00 E3 1E 00 E3 1E 00 E5 1E 00 E5 1E 00 E7 1E 00 E7 1E 00 E9 1E 00 E9' + '1E 00 EB 1E 00 EB 1E 00 ED 1E 00 ED 1E 00 EF 1E 00 EF 1E 00 F1 1E 00 F1 1E 00 F3 1E 00 F3 1E 00' + 'F5 1E 00 F5 1E 00 F7 1E 00 F7 1E 00 F9 1E 00 F9 1E 00 FB 1E 00 FB 1E 00 FD 1E 00 FD 1E 00 FF 1E' + '00 07 1F 00 10 1F 00 15 1F 00 20 1F 00 27 1F 00 30 1F 00 37 1F 00 40 1F 00 45 1F 00 50 1F 00 57' + '1F 00 60 1F 00 67 1F 00 70 1F 00 7D 1F 00 80 1F 00 87 1F 00 90 1F 00 97 1F 00 A0 1F 00 A7 1F 00' + 'B0 1F 00 B4 1F 00 B6 1F 00 B7 1F 00 BE 1F 00 BE 1F 00 C2 1F 00 C4 1F 00 C6 1F 00 C7 1F 00 D0 1F' + '00 D3 1F 00 D6 1F 00 D7 1F 00 E0 1F 00 E7 1F 00 F2 1F 00 F4 1F 00 F6 1F 00 F7 1F 00 0A 21 00 0A' + '21 00 0E 21 00 0F 21 00 13 21 00 13 21 00 2F 21 00 2F 21 00 34 21 00 34 21 00 39 21 00 39 21 00' + '3C 21 00 3D 21 00 46 21 00 49 21 00 4E 21 00 4E 21 00 84 21 00 84 21 00 30 2C 00 5E 2C 00 61 2C' + '00 61 2C 00 65 2C 00 66 2C 00 68 2C 00 68 2C 00 6A 2C 00 6A 2C 00 6C 2C 00 6C 2C 00 71 2C 00 71' + '2C 00 73 2C 00 74 2C 00 76 2C 00 7B 2C 00 81 2C 00 81 2C 00 83 2C 00 83 2C 00 85 2C 00 85 2C 00' + '87 2C 00 87 2C 00 89 2C 00 89 2C 00 8B 2C 00 8B 2C 00 8D 2C 00 8D 2C 00 8F 2C 00 8F 2C 00 91 2C' + '00 91 2C 00 93 2C 00 93 2C 00 95 2C 00 95 2C 00 97 2C 00 97 2C 00 99 2C 00 99 2C 00 9B 2C 00 9B' + '2C 00 9D 2C 00 9D 2C 00 9F 2C 00 9F 2C 00 A1 2C 00 A1 2C 00 A3 2C 00 A3 2C 00 A5 2C 00 A5 2C 00' + 'A7 2C 00 A7 2C 00 A9 2C 00 A9 2C 00 AB 2C 00 AB 2C 00 AD 2C 00 AD 2C 00 AF 2C 00 AF 2C 00 B1 2C' + '00 B1 2C 00 B3 2C 00 B3 2C 00 B5 2C 00 B5 2C 00 B7 2C 00 B7 2C 00 B9 2C 00 B9 2C 00 BB 2C 00 BB' + '2C 00 BD 2C 00 BD 2C 00 BF 2C 00 BF 2C 00 C1 2C 00 C1 2C 00 C3 2C 00 C3 2C 00 C5 2C 00 C5 2C 00' + 'C7 2C 00 C7 2C 00 C9 2C 00 C9 2C 00 CB 2C 00 CB 2C 00 CD 2C 00 CD 2C 00 CF 2C 00 CF 2C 00 D1 2C' + '00 D1 2C 00 D3 2C 00 D3 2C 00 D5 2C 00 D5 2C 00 D7 2C 00 D7 2C 00 D9 2C 00 D9 2C 00 DB 2C 00 DB' + '2C 00 DD 2C 00 DD 2C 00 DF 2C 00 DF 2C 00 E1 2C 00 E1 2C 00 E3 2C 00 E4 2C 00 EC 2C 00 EC 2C 00' + 'EE 2C 00 EE 2C 00 F3 2C 00 F3 2C 00 00 2D 00 25 2D 00 27 2D 00 27 2D 00 2D 2D 00 2D 2D 00 41 A6' + '00 41 A6 00 43 A6 00 43 A6 00 45 A6 00 45 A6 00 47 A6 00 47 A6 00 49 A6 00 49 A6 00 4B A6 00 4B' + 'A6 00 4D A6 00 4D A6 00 4F A6 00 4F A6 00 51 A6 00 51 A6 00 53 A6 00 53 A6 00 55 A6 00 55 A6 00' + '57 A6 00 57 A6 00 59 A6 00 59 A6 00 5B A6 00 5B A6 00 5D A6 00 5D A6 00 5F A6 00 5F A6 00 61 A6' + '00 61 A6 00 63 A6 00 63 A6 00 65 A6 00 65 A6 00 67 A6 00 67 A6 00 69 A6 00 69 A6 00 6B A6 00 6B' + 'A6 00 6D A6 00 6D A6 00 81 A6 00 81 A6 00 83 A6 00 83 A6 00 85 A6 00 85 A6 00 87 A6 00 87 A6 00' + '89 A6 00 89 A6 00 8B A6 00 8B A6 00 8D A6 00 8D A6 00 8F A6 00 8F A6 00 91 A6 00 91 A6 00 93 A6' + '00 93 A6 00 95 A6 00 95 A6 00 97 A6 00 97 A6 00 99 A6 00 99 A6 00 9B A6 00 9B A6 00 23 A7 00 23' + 'A7 00 25 A7 00 25 A7 00 27 A7 00 27 A7 00 29 A7 00 29 A7 00 2B A7 00 2B A7 00 2D A7 00 2D A7 00' + '2F A7 00 31 A7 00 33 A7 00 33 A7 00 35 A7 00 35 A7 00 37 A7 00 37 A7 00 39 A7 00 39 A7 00 3B A7' + '00 3B A7 00 3D A7 00 3D A7 00 3F A7 00 3F A7 00 41 A7 00 41 A7 00 43 A7 00 43 A7 00 45 A7 00 45' + 'A7 00 47 A7 00 47 A7 00 49 A7 00 49 A7 00 4B A7 00 4B A7 00 4D A7 00 4D A7 00 4F A7 00 4F A7 00' + '51 A7 00 51 A7 00 53 A7 00 53 A7 00 55 A7 00 55 A7 00 57 A7 00 57 A7 00 59 A7 00 59 A7 00 5B A7' + '00 5B A7 00 5D A7 00 5D A7 00 5F A7 00 5F A7 00 61 A7 00 61 A7 00 63 A7 00 63 A7 00 65 A7 00 65' + 'A7 00 67 A7 00 67 A7 00 69 A7 00 69 A7 00 6B A7 00 6B A7 00 6D A7 00 6D A7 00 6F A7 00 6F A7 00' + '71 A7 00 78 A7 00 7A A7 00 7A A7 00 7C A7 00 7C A7 00 7F A7 00 7F A7 00 81 A7 00 81 A7 00 83 A7' + '00 83 A7 00 85 A7 00 85 A7 00 87 A7 00 87 A7 00 8C A7 00 8C A7 00 8E A7 00 8E A7 00 91 A7 00 91' + 'A7 00 93 A7 00 95 A7 00 97 A7 00 97 A7 00 99 A7 00 99 A7 00 9B A7 00 9B A7 00 9D A7 00 9D A7 00' + '9F A7 00 9F A7 00 A1 A7 00 A1 A7 00 A3 A7 00 A3 A7 00 A5 A7 00 A5 A7 00 A7 A7 00 A7 A7 00 A9 A7' + '00 A9 A7 00 AF A7 00 AF A7 00 B5 A7 00 B5 A7 00 B7 A7 00 B7 A7 00 B9 A7 00 B9 A7 00 BB A7 00 BB' + 'A7 00 BD A7 00 BD A7 00 BF A7 00 BF A7 00 C3 A7 00 C3 A7 00 C8 A7 00 C8 A7 00 CA A7 00 CA A7 00' + 'F6 A7 00 F6 A7 00 FA A7 00 FA A7 00 30 AB 00 5A AB 00 60 AB 00 68 AB 00 70 AB 00 BF AB 00 00 FB' + '00 06 FB 00 13 FB 00 17 FB 00 41 FF 00 5A FF 00 28 04 01 4F 04 01 D8 04 01 FB 04 01 C0 0C 01 F2' + '0C 01 C0 18 01 DF 18 01 60 6E 01 7F 6E 01 1A D4 01 33 D4 01 4E D4 01 54 D4 01 56 D4 01 67 D4 01' + '82 D4 01 9B D4 01 B6 D4 01 B9 D4 01 BB D4 01 BB D4 01 BD D4 01 C3 D4 01 C5 D4 01 CF D4 01 EA D4' + '01 03 D5 01 1E D5 01 37 D5 01 52 D5 01 6B D5 01 86 D5 01 9F D5 01 BA D5 01 D3 D5 01 EE D5 01 07' + 'D6 01 22 D6 01 3B D6 01 56 D6 01 6F D6 01 8A D6 01 A5 D6 01 C2 D6 01 DA D6 01 DC D6 01 E1 D6 01' + 'FC D6 01 14 D7 01 16 D7 01 1B D7 01 36 D7 01 4E D7 01 50 D7 01 55 D7 01 70 D7 01 88 D7 01 8A D7' + '01 8F D7 01 AA D7 01 C2 D7 01 C4 D7 01 C9 D7 01 CB D7 01 CB D7 01 22 E9 01 43 E9 01 02 0A 00 00' + '00 C5 01 00 C5 01 00 C8 01 00 C8 01 00 CB 01 00 CB 01 00 F2 01 00 F2 01 00 88 1F 00 8F 1F 00 98' + '1F 00 9F 1F 00 A8 1F 00 AF 1F 00 BC 1F 00 BC 1F 00 CC 1F 00 CC 1F 00 FC 1F 00 FC 1F 00 03 44 01' + '00 00 00 03 00 6F 03 00 83 04 00 89 04 00 91 05 00 BD 05 00 BF 05 00 BF 05 00 C1 05 00 C2 05 00' + 'C4 05 00 C5 05 00 C7 05 00 C7 05 00 10 06 00 1A 06 00 4B 06 00 5F 06 00 70 06 00 70 06 00 D6 06' + '00 DC 06 00 DF 06 00 E4 06 00 E7 06 00 E8 06 00 EA 06 00 ED 06 00 11 07 00 11 07 00 30 07 00 4A' + '07 00 A6 07 00 B0 07 00 EB 07 00 F3 07 00 FD 07 00 FD 07 00 16 08 00 19 08 00 1B 08 00 23 08 00' + '25 08 00 27 08 00 29 08 00 2D 08 00 59 08 00 5B 08 00 D3 08 00 E1 08 00 E3 08 00 02 09 00 3A 09' + '00 3A 09 00 3C 09 00 3C 09 00 41 09 00 48 09 00 4D 09 00 4D 09 00 51 09 00 57 09 00 62 09 00 63' + '09 00 81 09 00 81 09 00 BC 09 00 BC 09 00 C1 09 00 C4 09 00 CD 09 00 CD 09 00 E2 09 00 E3 09 00' + 'FE 09 00 FE 09 00 01 0A 00 02 0A 00 3C 0A 00 3C 0A 00 41 0A 00 42 0A 00 47 0A 00 48 0A 00 4B 0A' + '00 4D 0A 00 51 0A 00 51 0A 00 70 0A 00 71 0A 00 75 0A 00 75 0A 00 81 0A 00 82 0A 00 BC 0A 00 BC' + '0A 00 C1 0A 00 C5 0A 00 C7 0A 00 C8 0A 00 CD 0A 00 CD 0A 00 E2 0A 00 E3 0A 00 FA 0A 00 FF 0A 00' + '01 0B 00 01 0B 00 3C 0B 00 3C 0B 00 3F 0B 00 3F 0B 00 41 0B 00 44 0B 00 4D 0B 00 4D 0B 00 55 0B' + '00 56 0B 00 62 0B 00 63 0B 00 82 0B 00 82 0B 00 C0 0B 00 C0 0B 00 CD 0B 00 CD 0B 00 00 0C 00 00' + '0C 00 04 0C 00 04 0C 00 3E 0C 00 40 0C 00 46 0C 00 48 0C 00 4A 0C 00 4D 0C 00 55 0C 00 56 0C 00' + '62 0C 00 63 0C 00 81 0C 00 81 0C 00 BC 0C 00 BC 0C 00 BF 0C 00 BF 0C 00 C6 0C 00 C6 0C 00 CC 0C' + '00 CD 0C 00 E2 0C 00 E3 0C 00 00 0D 00 01 0D 00 3B 0D 00 3C 0D 00 41 0D 00 44 0D 00 4D 0D 00 4D' + '0D 00 62 0D 00 63 0D 00 81 0D 00 81 0D 00 CA 0D 00 CA 0D 00 D2 0D 00 D4 0D 00 D6 0D 00 D6 0D 00' + '31 0E 00 31 0E 00 34 0E 00 3A 0E 00 47 0E 00 4E 0E 00 B1 0E 00 B1 0E 00 B4 0E 00 BC 0E 00 C8 0E' + '00 CD 0E 00 18 0F 00 19 0F 00 35 0F 00 35 0F 00 37 0F 00 37 0F 00 39 0F 00 39 0F 00 71 0F 00 7E' + '0F 00 80 0F 00 84 0F 00 86 0F 00 87 0F 00 8D 0F 00 97 0F 00 99 0F 00 BC 0F 00 C6 0F 00 C6 0F 00' + '2D 10 00 30 10 00 32 10 00 37 10 00 39 10 00 3A 10 00 3D 10 00 3E 10 00 58 10 00 59 10 00 5E 10' + '00 60 10 00 71 10 00 74 10 00 82 10 00 82 10 00 85 10 00 86 10 00 8D 10 00 8D 10 00 9D 10 00 9D' + '10 00 5D 13 00 5F 13 00 12 17 00 14 17 00 32 17 00 34 17 00 52 17 00 53 17 00 72 17 00 73 17 00' + 'B4 17 00 B5 17 00 B7 17 00 BD 17 00 C6 17 00 C6 17 00 C9 17 00 D3 17 00 DD 17 00 DD 17 00 0B 18' + '00 0D 18 00 85 18 00 86 18 00 A9 18 00 A9 18 00 20 19 00 22 19 00 27 19 00 28 19 00 32 19 00 32' + '19 00 39 19 00 3B 19 00 17 1A 00 18 1A 00 1B 1A 00 1B 1A 00 56 1A 00 56 1A 00 58 1A 00 5E 1A 00' + '60 1A 00 60 1A 00 62 1A 00 62 1A 00 65 1A 00 6C 1A 00 73 1A 00 7C 1A 00 7F 1A 00 7F 1A 00 B0 1A' + '00 C0 1A 00 00 1B 00 03 1B 00 34 1B 00 34 1B 00 36 1B 00 3A 1B 00 3C 1B 00 3C 1B 00 42 1B 00 42' + '1B 00 6B 1B 00 73 1B 00 80 1B 00 81 1B 00 A2 1B 00 A5 1B 00 A8 1B 00 A9 1B 00 AB 1B 00 AD 1B 00' + 'E6 1B 00 E6 1B 00 E8 1B 00 E9 1B 00 ED 1B 00 ED 1B 00 EF 1B 00 F1 1B 00 2C 1C 00 33 1C 00 36 1C' + '00 37 1C 00 D0 1C 00 D2 1C 00 D4 1C 00 E0 1C 00 E2 1C 00 E8 1C 00 ED 1C 00 ED 1C 00 F4 1C 00 F4' + '1C 00 F8 1C 00 F9 1C 00 C0 1D 00 F9 1D 00 FB 1D 00 FF 1D 00 D0 20 00 F0 20 00 EF 2C 00 F1 2C 00' + '7F 2D 00 7F 2D 00 E0 2D 00 FF 2D 00 2A 30 00 2D 30 00 99 30 00 9A 30 00 6F A6 00 72 A6 00 74 A6' + '00 7D A6 00 9E A6 00 9F A6 00 F0 A6 00 F1 A6 00 02 A8 00 02 A8 00 06 A8 00 06 A8 00 0B A8 00 0B' + 'A8 00 25 A8 00 26 A8 00 2C A8 00 2C A8 00 C4 A8 00 C5 A8 00 E0 A8 00 F1 A8 00 FF A8 00 FF A8 00' + '26 A9 00 2D A9 00 47 A9 00 51 A9 00 80 A9 00 82 A9 00 B3 A9 00 B3 A9 00 B6 A9 00 B9 A9 00 BC A9' + '00 BD A9 00 E5 A9 00 E5 A9 00 29 AA 00 2E AA 00 31 AA 00 32 AA 00 35 AA 00 36 AA 00 43 AA 00 43' + 'AA 00 4C AA 00 4C AA 00 7C AA 00 7C AA 00 B0 AA 00 B0 AA 00 B2 AA 00 B4 AA 00 B7 AA 00 B8 AA 00' + 'BE AA 00 BF AA 00 C1 AA 00 C1 AA 00 EC AA 00 ED AA 00 F6 AA 00 F6 AA 00 E5 AB 00 E5 AB 00 E8 AB' + '00 E8 AB 00 ED AB 00 ED AB 00 1E FB 00 1E FB 00 00 FE 00 0F FE 00 20 FE 00 2F FE 00 FD 01 01 FD' + '01 01 E0 02 01 E0 02 01 76 03 01 7A 03 01 01 0A 01 03 0A 01 05 0A 01 06 0A 01 0C 0A 01 0F 0A 01' + '38 0A 01 3A 0A 01 3F 0A 01 3F 0A 01 E5 0A 01 E6 0A 01 24 0D 01 27 0D 01 AB 0E 01 AC 0E 01 46 0F' + '01 50 0F 01 01 10 01 01 10 01 38 10 01 46 10 01 7F 10 01 81 10 01 B3 10 01 B6 10 01 B9 10 01 BA' + '10 01 00 11 01 02 11 01 27 11 01 2B 11 01 2D 11 01 34 11 01 73 11 01 73 11 01 80 11 01 81 11 01' + 'B6 11 01 BE 11 01 C9 11 01 CC 11 01 CF 11 01 CF 11 01 2F 12 01 31 12 01 34 12 01 34 12 01 36 12' + '01 37 12 01 3E 12 01 3E 12 01 DF 12 01 DF 12 01 E3 12 01 EA 12 01 00 13 01 01 13 01 3B 13 01 3C' + '13 01 40 13 01 40 13 01 66 13 01 6C 13 01 70 13 01 74 13 01 38 14 01 3F 14 01 42 14 01 44 14 01' + '46 14 01 46 14 01 5E 14 01 5E 14 01 B3 14 01 B8 14 01 BA 14 01 BA 14 01 BF 14 01 C0 14 01 C2 14' + '01 C3 14 01 B2 15 01 B5 15 01 BC 15 01 BD 15 01 BF 15 01 C0 15 01 DC 15 01 DD 15 01 33 16 01 3A' + '16 01 3D 16 01 3D 16 01 3F 16 01 40 16 01 AB 16 01 AB 16 01 AD 16 01 AD 16 01 B0 16 01 B5 16 01' + 'B7 16 01 B7 16 01 1D 17 01 1F 17 01 22 17 01 25 17 01 27 17 01 2B 17 01 2F 18 01 37 18 01 39 18' + '01 3A 18 01 3B 19 01 3C 19 01 3E 19 01 3E 19 01 43 19 01 43 19 01 D4 19 01 D7 19 01 DA 19 01 DB' + '19 01 E0 19 01 E0 19 01 01 1A 01 0A 1A 01 33 1A 01 38 1A 01 3B 1A 01 3E 1A 01 47 1A 01 47 1A 01' + '51 1A 01 56 1A 01 59 1A 01 5B 1A 01 8A 1A 01 96 1A 01 98 1A 01 99 1A 01 30 1C 01 36 1C 01 38 1C' + '01 3D 1C 01 3F 1C 01 3F 1C 01 92 1C 01 A7 1C 01 AA 1C 01 B0 1C 01 B2 1C 01 B3 1C 01 B5 1C 01 B6' + '1C 01 31 1D 01 36 1D 01 3A 1D 01 3A 1D 01 3C 1D 01 3D 1D 01 3F 1D 01 45 1D 01 47 1D 01 47 1D 01' + '90 1D 01 91 1D 01 95 1D 01 95 1D 01 97 1D 01 97 1D 01 F3 1E 01 F4 1E 01 F0 6A 01 F4 6A 01 30 6B' + '01 36 6B 01 4F 6F 01 4F 6F 01 8F 6F 01 92 6F 01 E4 6F 01 E4 6F 01 9D BC 01 9E BC 01 67 D1 01 69' + 'D1 01 7B D1 01 82 D1 01 85 D1 01 8B D1 01 AA D1 01 AD D1 01 42 D2 01 44 D2 01 00 DA 01 36 DA 01' + '3B DA 01 6C DA 01 75 DA 01 75 DA 01 84 DA 01 84 DA 01 9B DA 01 9F DA 01 A1 DA 01 AF DA 01 00 E0' + '01 06 E0 01 08 E0 01 18 E0 01 1B E0 01 21 E0 01 23 E0 01 24 E0 01 26 E0 01 2A E0 01 30 E1 01 36' + 'E1 01 EC E2 01 EF E2 01 D0 E8 01 D6 E8 01 44 E9 01 4A E9 01 00 01 0E EF 01 0E 04 AF 00 00 00 03' + '09 00 03 09 00 3B 09 00 3B 09 00 3E 09 00 40 09 00 49 09 00 4C 09 00 4E 09 00 4F 09 00 82 09 00' + '83 09 00 BE 09 00 C0 09 00 C7 09 00 C8 09 00 CB 09 00 CC 09 00 D7 09 00 D7 09 00 03 0A 00 03 0A' + '00 3E 0A 00 40 0A 00 83 0A 00 83 0A 00 BE 0A 00 C0 0A 00 C9 0A 00 C9 0A 00 CB 0A 00 CC 0A 00 02' + '0B 00 03 0B 00 3E 0B 00 3E 0B 00 40 0B 00 40 0B 00 47 0B 00 48 0B 00 4B 0B 00 4C 0B 00 57 0B 00' + '57 0B 00 BE 0B 00 BF 0B 00 C1 0B 00 C2 0B 00 C6 0B 00 C8 0B 00 CA 0B 00 CC 0B 00 D7 0B 00 D7 0B' + '00 01 0C 00 03 0C 00 41 0C 00 44 0C 00 82 0C 00 83 0C 00 BE 0C 00 BE 0C 00 C0 0C 00 C4 0C 00 C7' + '0C 00 C8 0C 00 CA 0C 00 CB 0C 00 D5 0C 00 D6 0C 00 02 0D 00 03 0D 00 3E 0D 00 40 0D 00 46 0D 00' + '48 0D 00 4A 0D 00 4C 0D 00 57 0D 00 57 0D 00 82 0D 00 83 0D 00 CF 0D 00 D1 0D 00 D8 0D 00 DF 0D' + '00 F2 0D 00 F3 0D 00 3E 0F 00 3F 0F 00 7F 0F 00 7F 0F 00 2B 10 00 2C 10 00 31 10 00 31 10 00 38' + '10 00 38 10 00 3B 10 00 3C 10 00 56 10 00 57 10 00 62 10 00 64 10 00 67 10 00 6D 10 00 83 10 00' + '84 10 00 87 10 00 8C 10 00 8F 10 00 8F 10 00 9A 10 00 9C 10 00 B6 17 00 B6 17 00 BE 17 00 C5 17' + '00 C7 17 00 C8 17 00 23 19 00 26 19 00 29 19 00 2B 19 00 30 19 00 31 19 00 33 19 00 38 19 00 19' + '1A 00 1A 1A 00 55 1A 00 55 1A 00 57 1A 00 57 1A 00 61 1A 00 61 1A 00 63 1A 00 64 1A 00 6D 1A 00' + '72 1A 00 04 1B 00 04 1B 00 35 1B 00 35 1B 00 3B 1B 00 3B 1B 00 3D 1B 00 41 1B 00 43 1B 00 44 1B' + '00 82 1B 00 82 1B 00 A1 1B 00 A1 1B 00 A6 1B 00 A7 1B 00 AA 1B 00 AA 1B 00 E7 1B 00 E7 1B 00 EA' + '1B 00 EC 1B 00 EE 1B 00 EE 1B 00 F2 1B 00 F3 1B 00 24 1C 00 2B 1C 00 34 1C 00 35 1C 00 E1 1C 00' + 'E1 1C 00 F7 1C 00 F7 1C 00 2E 30 00 2F 30 00 23 A8 00 24 A8 00 27 A8 00 27 A8 00 80 A8 00 81 A8' + '00 B4 A8 00 C3 A8 00 52 A9 00 53 A9 00 83 A9 00 83 A9 00 B4 A9 00 B5 A9 00 BA A9 00 BB A9 00 BE' + 'A9 00 C0 A9 00 2F AA 00 30 AA 00 33 AA 00 34 AA 00 4D AA 00 4D AA 00 7B AA 00 7B AA 00 7D AA 00' + '7D AA 00 EB AA 00 EB AA 00 EE AA 00 EF AA 00 F5 AA 00 F5 AA 00 E3 AB 00 E4 AB 00 E6 AB 00 E7 AB' + '00 E9 AB 00 EA AB 00 EC AB 00 EC AB 00 00 10 01 00 10 01 02 10 01 02 10 01 82 10 01 82 10 01 B0' + '10 01 B2 10 01 B7 10 01 B8 10 01 2C 11 01 2C 11 01 45 11 01 46 11 01 82 11 01 82 11 01 B3 11 01' + 'B5 11 01 BF 11 01 C0 11 01 CE 11 01 CE 11 01 2C 12 01 2E 12 01 32 12 01 33 12 01 35 12 01 35 12' + '01 E0 12 01 E2 12 01 02 13 01 03 13 01 3E 13 01 3F 13 01 41 13 01 44 13 01 47 13 01 48 13 01 4B' + '13 01 4D 13 01 57 13 01 57 13 01 62 13 01 63 13 01 35 14 01 37 14 01 40 14 01 41 14 01 45 14 01' + '45 14 01 B0 14 01 B2 14 01 B9 14 01 B9 14 01 BB 14 01 BE 14 01 C1 14 01 C1 14 01 AF 15 01 B1 15' + '01 B8 15 01 BB 15 01 BE 15 01 BE 15 01 30 16 01 32 16 01 3B 16 01 3C 16 01 3E 16 01 3E 16 01 AC' + '16 01 AC 16 01 AE 16 01 AF 16 01 B6 16 01 B6 16 01 20 17 01 21 17 01 26 17 01 26 17 01 2C 18 01' + '2E 18 01 38 18 01 38 18 01 30 19 01 35 19 01 37 19 01 38 19 01 3D 19 01 3D 19 01 40 19 01 40 19' + '01 42 19 01 42 19 01 D1 19 01 D3 19 01 DC 19 01 DF 19 01 E4 19 01 E4 19 01 39 1A 01 39 1A 01 57' + '1A 01 58 1A 01 97 1A 01 97 1A 01 2F 1C 01 2F 1C 01 3E 1C 01 3E 1C 01 A9 1C 01 A9 1C 01 B1 1C 01' + 'B1 1C 01 B4 1C 01 B4 1C 01 8A 1D 01 8E 1D 01 93 1D 01 94 1D 01 96 1D 01 96 1D 01 F5 1E 01 F6 1E' + '01 51 6F 01 87 6F 01 F0 6F 01 F1 6F 01 65 D1 01 66 D1 01 6D D1 01 72 D1 01 05 05 00 00 00 88 04' + '00 89 04 00 BE 1A 00 BE 1A 00 DD 20 00 E0 20 00 E2 20 00 E4 20 00 70 A6 00 72 A6 00 06 3D 00 00' + '00 30 00 00 39 00 00 60 06 00 69 06 00 F0 06 00 F9 06 00 C0 07 00 C9 07 00 66 09 00 6F 09 00 E6' + '09 00 EF 09 00 66 0A 00 6F 0A 00 E6 0A 00 EF 0A 00 66 0B 00 6F 0B 00 E6 0B 00 EF 0B 00 66 0C 00' + '6F 0C 00 E6 0C 00 EF 0C 00 66 0D 00 6F 0D 00 E6 0D 00 EF 0D 00 50 0E 00 59 0E 00 D0 0E 00 D9 0E' + '00 20 0F 00 29 0F 00 40 10 00 49 10 00 90 10 00 99 10 00 E0 17 00 E9 17 00 10 18 00 19 18 00 46' + '19 00 4F 19 00 D0 19 00 D9 19 00 80 1A 00 89 1A 00 90 1A 00 99 1A 00 50 1B 00 59 1B 00 B0 1B 00' + 'B9 1B 00 40 1C 00 49 1C 00 50 1C 00 59 1C 00 20 A6 00 29 A6 00 D0 A8 00 D9 A8 00 00 A9 00 09 A9' + '00 D0 A9 00 D9 A9 00 F0 A9 00 F9 A9 00 50 AA 00 59 AA 00 F0 AB 00 F9 AB 00 10 FF 00 19 FF 00 A0' + '04 01 A9 04 01 30 0D 01 39 0D 01 66 10 01 6F 10 01 F0 10 01 F9 10 01 36 11 01 3F 11 01 D0 11 01' + 'D9 11 01 F0 12 01 F9 12 01 50 14 01 59 14 01 D0 14 01 D9 14 01 50 16 01 59 16 01 C0 16 01 C9 16' + '01 30 17 01 39 17 01 E0 18 01 E9 18 01 50 19 01 59 19 01 50 1C 01 59 1C 01 50 1D 01 59 1D 01 A0' + '1D 01 A9 1D 01 60 6A 01 69 6A 01 50 6B 01 59 6B 01 CE D7 01 FF D7 01 40 E1 01 49 E1 01 F0 E2 01' + 'F9 E2 01 50 E9 01 59 E9 01 F0 FB 01 F9 FB 01 07 0C 00 00 00 EE 16 00 F0 16 00 60 21 00 82 21 00' + '85 21 00 88 21 00 07 30 00 07 30 00 21 30 00 29 30 00 38 30 00 3A 30 00 E6 A6 00 EF A6 00 40 01' + '01 74 01 01 41 03 01 41 03 01 4A 03 01 4A 03 01 D1 03 01 D5 03 01 00 24 01 6E 24 01 08 47 00 00' + '00 B2 00 00 B3 00 00 B9 00 00 B9 00 00 BC 00 00 BE 00 00 F4 09 00 F9 09 00 72 0B 00 77 0B 00 F0' + '0B 00 F2 0B 00 78 0C 00 7E 0C 00 58 0D 00 5E 0D 00 70 0D 00 78 0D 00 2A 0F 00 33 0F 00 69 13 00' + '7C 13 00 F0 17 00 F9 17 00 DA 19 00 DA 19 00 70 20 00 70 20 00 74 20 00 79 20 00 80 20 00 89 20' + '00 50 21 00 5F 21 00 89 21 00 89 21 00 60 24 00 9B 24 00 EA 24 00 FF 24 00 76 27 00 93 27 00 FD' + '2C 00 FD 2C 00 92 31 00 95 31 00 20 32 00 29 32 00 48 32 00 4F 32 00 51 32 00 5F 32 00 80 32 00' + '89 32 00 B1 32 00 BF 32 00 30 A8 00 35 A8 00 07 01 01 33 01 01 75 01 01 78 01 01 8A 01 01 8B 01' + '01 E1 02 01 FB 02 01 20 03 01 23 03 01 58 08 01 5F 08 01 79 08 01 7F 08 01 A7 08 01 AF 08 01 FB' + '08 01 FF 08 01 16 09 01 1B 09 01 BC 09 01 BD 09 01 C0 09 01 CF 09 01 D2 09 01 FF 09 01 40 0A 01' + '48 0A 01 7D 0A 01 7E 0A 01 9D 0A 01 9F 0A 01 EB 0A 01 EF 0A 01 58 0B 01 5F 0B 01 78 0B 01 7F 0B' + '01 A9 0B 01 AF 0B 01 FA 0C 01 FF 0C 01 60 0E 01 7E 0E 01 1D 0F 01 26 0F 01 51 0F 01 54 0F 01 C5' + '0F 01 CB 0F 01 52 10 01 65 10 01 E1 11 01 F4 11 01 3A 17 01 3B 17 01 EA 18 01 F2 18 01 5A 1C 01' + '6C 1C 01 C0 1F 01 D4 1F 01 5B 6B 01 61 6B 01 80 6E 01 96 6E 01 E0 D2 01 F3 D2 01 60 D3 01 78 D3' + '01 C7 E8 01 CF E8 01 71 EC 01 AB EC 01 AD EC 01 AF EC 01 B1 EC 01 B4 EC 01 01 ED 01 2D ED 01 2F' + 'ED 01 3D ED 01 00 F1 01 0C F1 01 09 07 00 00 00 20 00 00 20 00 00 A0 00 00 A0 00 00 80 16 00 80' + '16 00 00 20 00 0A 20 00 2F 20 00 2F 20 00 5F 20 00 5F 20 00 00 30 00 00 30 00 0A 01 00 00 00 28' + '20 00 28 20 00 0B 05 00 00 00 0A 00 00 0A 00 00 0D 00 00 0D 00 00 1C 00 00 1E 00 00 85 00 00 85' + '00 00 29 20 00 29 20 00 0C 02 00 00 00 00 00 00 1F 00 00 7F 00 00 9F 00 00 0D 14 00 00 00 AD 00' + '00 AD 00 00 00 06 00 05 06 00 1C 06 00 1C 06 00 DD 06 00 DD 06 00 0F 07 00 0F 07 00 E2 08 00 E2' + '08 00 0E 18 00 0E 18 00 0B 20 00 0F 20 00 2A 20 00 2E 20 00 60 20 00 64 20 00 66 20 00 6F 20 00' + 'FF FE 00 FF FE 00 F9 FF 00 FB FF 00 BD 10 01 BD 10 01 CD 10 01 CD 10 01 30 34 01 38 34 01 A0 BC' + '01 A3 BC 01 73 D1 01 7A D1 01 01 00 0E 01 00 0E 20 00 0E 7F 00 0E 0E 01 00 00 00 00 D8 00 FF DF' + '00 0F 03 00 00 00 00 E0 00 FF F8 00 00 00 0F FD FF 0F 00 00 10 FD FF 10 11 3D 00 00 00 B0 02 00' + 'C1 02 00 C6 02 00 D1 02 00 E0 02 00 E4 02 00 EC 02 00 EC 02 00 EE 02 00 EE 02 00 74 03 00 74 03' + '00 7A 03 00 7A 03 00 59 05 00 59 05 00 40 06 00 40 06 00 E5 06 00 E6 06 00 F4 07 00 F5 07 00 FA' + '07 00 FA 07 00 1A 08 00 1A 08 00 24 08 00 24 08 00 28 08 00 28 08 00 71 09 00 71 09 00 46 0E 00' + '46 0E 00 C6 0E 00 C6 0E 00 FC 10 00 FC 10 00 D7 17 00 D7 17 00 43 18 00 43 18 00 A7 1A 00 A7 1A' + '00 78 1C 00 7D 1C 00 2C 1D 00 6A 1D 00 78 1D 00 78 1D 00 9B 1D 00 BF 1D 00 71 20 00 71 20 00 7F' + '20 00 7F 20 00 90 20 00 9C 20 00 7C 2C 00 7D 2C 00 6F 2D 00 6F 2D 00 2F 2E 00 2F 2E 00 05 30 00' + '05 30 00 31 30 00 35 30 00 3B 30 00 3B 30 00 9D 30 00 9E 30 00 FC 30 00 FE 30 00 15 A0 00 15 A0' + '00 F8 A4 00 FD A4 00 0C A6 00 0C A6 00 7F A6 00 7F A6 00 9C A6 00 9D A6 00 17 A7 00 1F A7 00 70' + 'A7 00 70 A7 00 88 A7 00 88 A7 00 F8 A7 00 F9 A7 00 CF A9 00 CF A9 00 E6 A9 00 E6 A9 00 70 AA 00' + '70 AA 00 DD AA 00 DD AA 00 F3 AA 00 F4 AA 00 5C AB 00 5F AB 00 69 AB 00 69 AB 00 70 FF 00 70 FF' + '00 9E FF 00 9F FF 00 40 6B 01 43 6B 01 93 6F 01 9F 6F 01 E0 6F 01 E1 6F 01 E3 6F 01 E3 6F 01 37' + 'E1 01 3D E1 01 4B E9 01 4B E9 01 12 E9 01 00 00 AA 00 00 AA 00 00 BA 00 00 BA 00 00 BB 01 00 BB' + '01 00 C0 01 00 C3 01 00 94 02 00 94 02 00 D0 05 00 EA 05 00 EF 05 00 F2 05 00 20 06 00 3F 06 00' + '41 06 00 4A 06 00 6E 06 00 6F 06 00 71 06 00 D3 06 00 D5 06 00 D5 06 00 EE 06 00 EF 06 00 FA 06' + '00 FC 06 00 FF 06 00 FF 06 00 10 07 00 10 07 00 12 07 00 2F 07 00 4D 07 00 A5 07 00 B1 07 00 B1' + '07 00 CA 07 00 EA 07 00 00 08 00 15 08 00 40 08 00 58 08 00 60 08 00 6A 08 00 A0 08 00 B4 08 00' + 'B6 08 00 C7 08 00 04 09 00 39 09 00 3D 09 00 3D 09 00 50 09 00 50 09 00 58 09 00 61 09 00 72 09' + '00 80 09 00 85 09 00 8C 09 00 8F 09 00 90 09 00 93 09 00 A8 09 00 AA 09 00 B0 09 00 B2 09 00 B2' + '09 00 B6 09 00 B9 09 00 BD 09 00 BD 09 00 CE 09 00 CE 09 00 DC 09 00 DD 09 00 DF 09 00 E1 09 00' + 'F0 09 00 F1 09 00 FC 09 00 FC 09 00 05 0A 00 0A 0A 00 0F 0A 00 10 0A 00 13 0A 00 28 0A 00 2A 0A' + '00 30 0A 00 32 0A 00 33 0A 00 35 0A 00 36 0A 00 38 0A 00 39 0A 00 59 0A 00 5C 0A 00 5E 0A 00 5E' + '0A 00 72 0A 00 74 0A 00 85 0A 00 8D 0A 00 8F 0A 00 91 0A 00 93 0A 00 A8 0A 00 AA 0A 00 B0 0A 00' + 'B2 0A 00 B3 0A 00 B5 0A 00 B9 0A 00 BD 0A 00 BD 0A 00 D0 0A 00 D0 0A 00 E0 0A 00 E1 0A 00 F9 0A' + '00 F9 0A 00 05 0B 00 0C 0B 00 0F 0B 00 10 0B 00 13 0B 00 28 0B 00 2A 0B 00 30 0B 00 32 0B 00 33' + '0B 00 35 0B 00 39 0B 00 3D 0B 00 3D 0B 00 5C 0B 00 5D 0B 00 5F 0B 00 61 0B 00 71 0B 00 71 0B 00' + '83 0B 00 83 0B 00 85 0B 00 8A 0B 00 8E 0B 00 90 0B 00 92 0B 00 95 0B 00 99 0B 00 9A 0B 00 9C 0B' + '00 9C 0B 00 9E 0B 00 9F 0B 00 A3 0B 00 A4 0B 00 A8 0B 00 AA 0B 00 AE 0B 00 B9 0B 00 D0 0B 00 D0' + '0B 00 05 0C 00 0C 0C 00 0E 0C 00 10 0C 00 12 0C 00 28 0C 00 2A 0C 00 39 0C 00 3D 0C 00 3D 0C 00' + '58 0C 00 5A 0C 00 60 0C 00 61 0C 00 80 0C 00 80 0C 00 85 0C 00 8C 0C 00 8E 0C 00 90 0C 00 92 0C' + '00 A8 0C 00 AA 0C 00 B3 0C 00 B5 0C 00 B9 0C 00 BD 0C 00 BD 0C 00 DE 0C 00 DE 0C 00 E0 0C 00 E1' + '0C 00 F1 0C 00 F2 0C 00 04 0D 00 0C 0D 00 0E 0D 00 10 0D 00 12 0D 00 3A 0D 00 3D 0D 00 3D 0D 00' + '4E 0D 00 4E 0D 00 54 0D 00 56 0D 00 5F 0D 00 61 0D 00 7A 0D 00 7F 0D 00 85 0D 00 96 0D 00 9A 0D' + '00 B1 0D 00 B3 0D 00 BB 0D 00 BD 0D 00 BD 0D 00 C0 0D 00 C6 0D 00 01 0E 00 30 0E 00 32 0E 00 33' + '0E 00 40 0E 00 45 0E 00 81 0E 00 82 0E 00 84 0E 00 84 0E 00 86 0E 00 8A 0E 00 8C 0E 00 A3 0E 00' + 'A5 0E 00 A5 0E 00 A7 0E 00 B0 0E 00 B2 0E 00 B3 0E 00 BD 0E 00 BD 0E 00 C0 0E 00 C4 0E 00 DC 0E' + '00 DF 0E 00 00 0F 00 00 0F 00 40 0F 00 47 0F 00 49 0F 00 6C 0F 00 88 0F 00 8C 0F 00 00 10 00 2A' + '10 00 3F 10 00 3F 10 00 50 10 00 55 10 00 5A 10 00 5D 10 00 61 10 00 61 10 00 65 10 00 66 10 00' + '6E 10 00 70 10 00 75 10 00 81 10 00 8E 10 00 8E 10 00 00 11 00 48 12 00 4A 12 00 4D 12 00 50 12' + '00 56 12 00 58 12 00 58 12 00 5A 12 00 5D 12 00 60 12 00 88 12 00 8A 12 00 8D 12 00 90 12 00 B0' + '12 00 B2 12 00 B5 12 00 B8 12 00 BE 12 00 C0 12 00 C0 12 00 C2 12 00 C5 12 00 C8 12 00 D6 12 00' + 'D8 12 00 10 13 00 12 13 00 15 13 00 18 13 00 5A 13 00 80 13 00 8F 13 00 01 14 00 6C 16 00 6F 16' + '00 7F 16 00 81 16 00 9A 16 00 A0 16 00 EA 16 00 F1 16 00 F8 16 00 00 17 00 0C 17 00 0E 17 00 11' + '17 00 20 17 00 31 17 00 40 17 00 51 17 00 60 17 00 6C 17 00 6E 17 00 70 17 00 80 17 00 B3 17 00' + 'DC 17 00 DC 17 00 20 18 00 42 18 00 44 18 00 78 18 00 80 18 00 84 18 00 87 18 00 A8 18 00 AA 18' + '00 AA 18 00 B0 18 00 F5 18 00 00 19 00 1E 19 00 50 19 00 6D 19 00 70 19 00 74 19 00 80 19 00 AB' + '19 00 B0 19 00 C9 19 00 00 1A 00 16 1A 00 20 1A 00 54 1A 00 05 1B 00 33 1B 00 45 1B 00 4B 1B 00' + '83 1B 00 A0 1B 00 AE 1B 00 AF 1B 00 BA 1B 00 E5 1B 00 00 1C 00 23 1C 00 4D 1C 00 4F 1C 00 5A 1C' + '00 77 1C 00 E9 1C 00 EC 1C 00 EE 1C 00 F3 1C 00 F5 1C 00 F6 1C 00 FA 1C 00 FA 1C 00 35 21 00 38' + '21 00 30 2D 00 67 2D 00 80 2D 00 96 2D 00 A0 2D 00 A6 2D 00 A8 2D 00 AE 2D 00 B0 2D 00 B6 2D 00' + 'B8 2D 00 BE 2D 00 C0 2D 00 C6 2D 00 C8 2D 00 CE 2D 00 D0 2D 00 D6 2D 00 D8 2D 00 DE 2D 00 06 30' + '00 06 30 00 3C 30 00 3C 30 00 41 30 00 96 30 00 9F 30 00 9F 30 00 A1 30 00 FA 30 00 FF 30 00 FF' + '30 00 05 31 00 2F 31 00 31 31 00 8E 31 00 A0 31 00 BF 31 00 F0 31 00 FF 31 00 00 34 00 BF 4D 00' + '00 4E 00 FC 9F 00 00 A0 00 14 A0 00 16 A0 00 8C A4 00 D0 A4 00 F7 A4 00 00 A5 00 0B A6 00 10 A6' + '00 1F A6 00 2A A6 00 2B A6 00 6E A6 00 6E A6 00 A0 A6 00 E5 A6 00 8F A7 00 8F A7 00 F7 A7 00 F7' + 'A7 00 FB A7 00 01 A8 00 03 A8 00 05 A8 00 07 A8 00 0A A8 00 0C A8 00 22 A8 00 40 A8 00 73 A8 00' + '82 A8 00 B3 A8 00 F2 A8 00 F7 A8 00 FB A8 00 FB A8 00 FD A8 00 FE A8 00 0A A9 00 25 A9 00 30 A9' + '00 46 A9 00 60 A9 00 7C A9 00 84 A9 00 B2 A9 00 E0 A9 00 E4 A9 00 E7 A9 00 EF A9 00 FA A9 00 FE' + 'A9 00 00 AA 00 28 AA 00 40 AA 00 42 AA 00 44 AA 00 4B AA 00 60 AA 00 6F AA 00 71 AA 00 76 AA 00' + '7A AA 00 7A AA 00 7E AA 00 AF AA 00 B1 AA 00 B1 AA 00 B5 AA 00 B6 AA 00 B9 AA 00 BD AA 00 C0 AA' + '00 C0 AA 00 C2 AA 00 C2 AA 00 DB AA 00 DC AA 00 E0 AA 00 EA AA 00 F2 AA 00 F2 AA 00 01 AB 00 06' + 'AB 00 09 AB 00 0E AB 00 11 AB 00 16 AB 00 20 AB 00 26 AB 00 28 AB 00 2E AB 00 C0 AB 00 E2 AB 00' + '00 AC 00 A3 D7 00 B0 D7 00 C6 D7 00 CB D7 00 FB D7 00 00 F9 00 6D FA 00 70 FA 00 D9 FA 00 1D FB' + '00 1D FB 00 1F FB 00 28 FB 00 2A FB 00 36 FB 00 38 FB 00 3C FB 00 3E FB 00 3E FB 00 40 FB 00 41' + 'FB 00 43 FB 00 44 FB 00 46 FB 00 B1 FB 00 D3 FB 00 3D FD 00 50 FD 00 8F FD 00 92 FD 00 C7 FD 00' + 'F0 FD 00 FB FD 00 70 FE 00 74 FE 00 76 FE 00 FC FE 00 66 FF 00 6F FF 00 71 FF 00 9D FF 00 A0 FF' + '00 BE FF 00 C2 FF 00 C7 FF 00 CA FF 00 CF FF 00 D2 FF 00 D7 FF 00 DA FF 00 DC FF 00 00 00 01 0B' + '00 01 0D 00 01 26 00 01 28 00 01 3A 00 01 3C 00 01 3D 00 01 3F 00 01 4D 00 01 50 00 01 5D 00 01' + '80 00 01 FA 00 01 80 02 01 9C 02 01 A0 02 01 D0 02 01 00 03 01 1F 03 01 2D 03 01 40 03 01 42 03' + '01 49 03 01 50 03 01 75 03 01 80 03 01 9D 03 01 A0 03 01 C3 03 01 C8 03 01 CF 03 01 50 04 01 9D' + '04 01 00 05 01 27 05 01 30 05 01 63 05 01 00 06 01 36 07 01 40 07 01 55 07 01 60 07 01 67 07 01' + '00 08 01 05 08 01 08 08 01 08 08 01 0A 08 01 35 08 01 37 08 01 38 08 01 3C 08 01 3C 08 01 3F 08' + '01 55 08 01 60 08 01 76 08 01 80 08 01 9E 08 01 E0 08 01 F2 08 01 F4 08 01 F5 08 01 00 09 01 15' + '09 01 20 09 01 39 09 01 80 09 01 B7 09 01 BE 09 01 BF 09 01 00 0A 01 00 0A 01 10 0A 01 13 0A 01' + '15 0A 01 17 0A 01 19 0A 01 35 0A 01 60 0A 01 7C 0A 01 80 0A 01 9C 0A 01 C0 0A 01 C7 0A 01 C9 0A' + '01 E4 0A 01 00 0B 01 35 0B 01 40 0B 01 55 0B 01 60 0B 01 72 0B 01 80 0B 01 91 0B 01 00 0C 01 48' + '0C 01 00 0D 01 23 0D 01 80 0E 01 A9 0E 01 B0 0E 01 B1 0E 01 00 0F 01 1C 0F 01 27 0F 01 27 0F 01' + '30 0F 01 45 0F 01 B0 0F 01 C4 0F 01 E0 0F 01 F6 0F 01 03 10 01 37 10 01 83 10 01 AF 10 01 D0 10' + '01 E8 10 01 03 11 01 26 11 01 44 11 01 44 11 01 47 11 01 47 11 01 50 11 01 72 11 01 76 11 01 76' + '11 01 83 11 01 B2 11 01 C1 11 01 C4 11 01 DA 11 01 DA 11 01 DC 11 01 DC 11 01 00 12 01 11 12 01' + '13 12 01 2B 12 01 80 12 01 86 12 01 88 12 01 88 12 01 8A 12 01 8D 12 01 8F 12 01 9D 12 01 9F 12' + '01 A8 12 01 B0 12 01 DE 12 01 05 13 01 0C 13 01 0F 13 01 10 13 01 13 13 01 28 13 01 2A 13 01 30' + '13 01 32 13 01 33 13 01 35 13 01 39 13 01 3D 13 01 3D 13 01 50 13 01 50 13 01 5D 13 01 61 13 01' + '00 14 01 34 14 01 47 14 01 4A 14 01 5F 14 01 61 14 01 80 14 01 AF 14 01 C4 14 01 C5 14 01 C7 14' + '01 C7 14 01 80 15 01 AE 15 01 D8 15 01 DB 15 01 00 16 01 2F 16 01 44 16 01 44 16 01 80 16 01 AA' + '16 01 B8 16 01 B8 16 01 00 17 01 1A 17 01 00 18 01 2B 18 01 FF 18 01 06 19 01 09 19 01 09 19 01' + '0C 19 01 13 19 01 15 19 01 16 19 01 18 19 01 2F 19 01 3F 19 01 3F 19 01 41 19 01 41 19 01 A0 19' + '01 A7 19 01 AA 19 01 D0 19 01 E1 19 01 E1 19 01 E3 19 01 E3 19 01 00 1A 01 00 1A 01 0B 1A 01 32' + '1A 01 3A 1A 01 3A 1A 01 50 1A 01 50 1A 01 5C 1A 01 89 1A 01 9D 1A 01 9D 1A 01 C0 1A 01 F8 1A 01' + '00 1C 01 08 1C 01 0A 1C 01 2E 1C 01 40 1C 01 40 1C 01 72 1C 01 8F 1C 01 00 1D 01 06 1D 01 08 1D' + '01 09 1D 01 0B 1D 01 30 1D 01 46 1D 01 46 1D 01 60 1D 01 65 1D 01 67 1D 01 68 1D 01 6A 1D 01 89' + '1D 01 98 1D 01 98 1D 01 E0 1E 01 F2 1E 01 B0 1F 01 B0 1F 01 00 20 01 99 23 01 80 24 01 43 25 01' + '00 30 01 2E 34 01 00 44 01 46 46 01 00 68 01 38 6A 01 40 6A 01 5E 6A 01 D0 6A 01 ED 6A 01 00 6B' + '01 2F 6B 01 63 6B 01 77 6B 01 7D 6B 01 8F 6B 01 00 6F 01 4A 6F 01 50 6F 01 50 6F 01 00 70 01 F7' + '87 01 00 88 01 D5 8C 01 00 8D 01 08 8D 01 00 B0 01 1E B1 01 50 B1 01 52 B1 01 64 B1 01 67 B1 01' + '70 B1 01 FB B2 01 00 BC 01 6A BC 01 70 BC 01 7C BC 01 80 BC 01 88 BC 01 90 BC 01 99 BC 01 00 E1' + '01 2C E1 01 4E E1 01 4E E1 01 C0 E2 01 EB E2 01 00 E8 01 C4 E8 01 00 EE 01 03 EE 01 05 EE 01 1F' + 'EE 01 21 EE 01 22 EE 01 24 EE 01 24 EE 01 27 EE 01 27 EE 01 29 EE 01 32 EE 01 34 EE 01 37 EE 01' + '39 EE 01 39 EE 01 3B EE 01 3B EE 01 42 EE 01 42 EE 01 47 EE 01 47 EE 01 49 EE 01 49 EE 01 4B EE' + '01 4B EE 01 4D EE 01 4F EE 01 51 EE 01 52 EE 01 54 EE 01 54 EE 01 57 EE 01 57 EE 01 59 EE 01 59' + 'EE 01 5B EE 01 5B EE 01 5D EE 01 5D EE 01 5F EE 01 5F EE 01 61 EE 01 62 EE 01 64 EE 01 64 EE 01' + '67 EE 01 6A EE 01 6C EE 01 72 EE 01 74 EE 01 77 EE 01 79 EE 01 7C EE 01 7E EE 01 7E EE 01 80 EE' + '01 89 EE 01 8B EE 01 9B EE 01 A1 EE 01 A3 EE 01 A5 EE 01 A9 EE 01 AB EE 01 BB EE 01 00 00 02 DD' + 'A6 02 00 A7 02 34 B7 02 40 B7 02 1D B8 02 20 B8 02 A1 CE 02 B0 CE 02 E0 EB 02 00 F8 02 1D FA 02' + '00 00 03 4A 13 03 13 06 00 00 00 5F 00 00 5F 00 00 3F 20 00 40 20 00 54 20 00 54 20 00 33 FE 00' + '34 FE 00 4D FE 00 4F FE 00 3F FF 00 3F FF 00 14 16 00 00 00 2D 00 00 2D 00 00 8A 05 00 8A 05 00' + 'BE 05 00 BE 05 00 00 14 00 00 14 00 06 18 00 06 18 00 10 20 00 15 20 00 53 20 00 53 20 00 7B 20' + '00 7B 20 00 8B 20 00 8B 20 00 12 22 00 12 22 00 17 2E 00 17 2E 00 1A 2E 00 1A 2E 00 3A 2E 00 3B' + '2E 00 40 2E 00 40 2E 00 1C 30 00 1C 30 00 30 30 00 30 30 00 A0 30 00 A0 30 00 31 FE 00 32 FE 00' + '58 FE 00 58 FE 00 63 FE 00 63 FE 00 0D FF 00 0D FF 00 AD 0E 01 AD 0E 01 15 4B 00 00 00 28 00 00' + '28 00 00 5B 00 00 5B 00 00 7B 00 00 7B 00 00 3A 0F 00 3A 0F 00 3C 0F 00 3C 0F 00 9B 16 00 9B 16' + '00 1A 20 00 1A 20 00 1E 20 00 1E 20 00 45 20 00 45 20 00 7D 20 00 7D 20 00 8D 20 00 8D 20 00 08' + '23 00 08 23 00 0A 23 00 0A 23 00 29 23 00 29 23 00 68 27 00 68 27 00 6A 27 00 6A 27 00 6C 27 00' + '6C 27 00 6E 27 00 6E 27 00 70 27 00 70 27 00 72 27 00 72 27 00 74 27 00 74 27 00 C5 27 00 C5 27' + '00 E6 27 00 E6 27 00 E8 27 00 E8 27 00 EA 27 00 EA 27 00 EC 27 00 EC 27 00 EE 27 00 EE 27 00 83' + '29 00 83 29 00 85 29 00 85 29 00 87 29 00 87 29 00 89 29 00 89 29 00 8B 29 00 8B 29 00 8D 29 00' + '8D 29 00 8F 29 00 8F 29 00 91 29 00 91 29 00 93 29 00 93 29 00 95 29 00 95 29 00 97 29 00 97 29' + '00 D8 29 00 D8 29 00 DA 29 00 DA 29 00 FC 29 00 FC 29 00 22 2E 00 22 2E 00 24 2E 00 24 2E 00 26' + '2E 00 26 2E 00 28 2E 00 28 2E 00 42 2E 00 42 2E 00 08 30 00 08 30 00 0A 30 00 0A 30 00 0C 30 00' + '0C 30 00 0E 30 00 0E 30 00 10 30 00 10 30 00 14 30 00 14 30 00 16 30 00 16 30 00 18 30 00 18 30' + '00 1A 30 00 1A 30 00 1D 30 00 1D 30 00 3F FD 00 3F FD 00 17 FE 00 17 FE 00 35 FE 00 35 FE 00 37' + 'FE 00 37 FE 00 39 FE 00 39 FE 00 3B FE 00 3B FE 00 3D FE 00 3D FE 00 3F FE 00 3F FE 00 41 FE 00' + '41 FE 00 43 FE 00 43 FE 00 47 FE 00 47 FE 00 59 FE 00 59 FE 00 5B FE 00 5B FE 00 5D FE 00 5D FE' + '00 08 FF 00 08 FF 00 3B FF 00 3B FF 00 5B FF 00 5B FF 00 5F FF 00 5F FF 00 62 FF 00 62 FF 00 16' + '48 00 00 00 29 00 00 29 00 00 5D 00 00 5D 00 00 7D 00 00 7D 00 00 3B 0F 00 3B 0F 00 3D 0F 00 3D' + '0F 00 9C 16 00 9C 16 00 46 20 00 46 20 00 7E 20 00 7E 20 00 8E 20 00 8E 20 00 09 23 00 09 23 00' + '0B 23 00 0B 23 00 2A 23 00 2A 23 00 69 27 00 69 27 00 6B 27 00 6B 27 00 6D 27 00 6D 27 00 6F 27' + '00 6F 27 00 71 27 00 71 27 00 73 27 00 73 27 00 75 27 00 75 27 00 C6 27 00 C6 27 00 E7 27 00 E7' + '27 00 E9 27 00 E9 27 00 EB 27 00 EB 27 00 ED 27 00 ED 27 00 EF 27 00 EF 27 00 84 29 00 84 29 00' + '86 29 00 86 29 00 88 29 00 88 29 00 8A 29 00 8A 29 00 8C 29 00 8C 29 00 8E 29 00 8E 29 00 90 29' + '00 90 29 00 92 29 00 92 29 00 94 29 00 94 29 00 96 29 00 96 29 00 98 29 00 98 29 00 D9 29 00 D9' + '29 00 DB 29 00 DB 29 00 FD 29 00 FD 29 00 23 2E 00 23 2E 00 25 2E 00 25 2E 00 27 2E 00 27 2E 00' + '29 2E 00 29 2E 00 09 30 00 09 30 00 0B 30 00 0B 30 00 0D 30 00 0D 30 00 0F 30 00 0F 30 00 11 30' + '00 11 30 00 15 30 00 15 30 00 17 30 00 17 30 00 19 30 00 19 30 00 1B 30 00 1B 30 00 1E 30 00 1F' + '30 00 3E FD 00 3E FD 00 18 FE 00 18 FE 00 36 FE 00 36 FE 00 38 FE 00 38 FE 00 3A FE 00 3A FE 00' + '3C FE 00 3C FE 00 3E FE 00 3E FE 00 40 FE 00 40 FE 00 42 FE 00 42 FE 00 44 FE 00 44 FE 00 48 FE' + '00 48 FE 00 5A FE 00 5A FE 00 5C FE 00 5C FE 00 5E FE 00 5E FE 00 09 FF 00 09 FF 00 3D FF 00 3D' + 'FF 00 5D FF 00 5D FF 00 60 FF 00 60 FF 00 63 FF 00 63 FF 00 17 0B 00 00 00 AB 00 00 AB 00 00 18' + '20 00 18 20 00 1B 20 00 1C 20 00 1F 20 00 1F 20 00 39 20 00 39 20 00 02 2E 00 02 2E 00 04 2E 00' + '04 2E 00 09 2E 00 09 2E 00 0C 2E 00 0C 2E 00 1C 2E 00 1C 2E 00 20 2E 00 20 2E 00 18 0A 00 00 00' + 'BB 00 00 BB 00 00 19 20 00 19 20 00 1D 20 00 1D 20 00 3A 20 00 3A 20 00 03 2E 00 03 2E 00 05 2E' + '00 05 2E 00 0A 2E 00 0A 2E 00 0D 2E 00 0D 2E 00 1D 2E 00 1D 2E 00 21 2E 00 21 2E 00 19 B5 00 00' + '00 21 00 00 23 00 00 25 00 00 27 00 00 2A 00 00 2A 00 00 2C 00 00 2C 00 00 2E 00 00 2F 00 00 3A' + '00 00 3B 00 00 3F 00 00 40 00 00 5C 00 00 5C 00 00 A1 00 00 A1 00 00 A7 00 00 A7 00 00 B6 00 00' + 'B7 00 00 BF 00 00 BF 00 00 7E 03 00 7E 03 00 87 03 00 87 03 00 5A 05 00 5F 05 00 89 05 00 89 05' + '00 C0 05 00 C0 05 00 C3 05 00 C3 05 00 C6 05 00 C6 05 00 F3 05 00 F4 05 00 09 06 00 0A 06 00 0C' + '06 00 0D 06 00 1B 06 00 1B 06 00 1E 06 00 1F 06 00 6A 06 00 6D 06 00 D4 06 00 D4 06 00 00 07 00' + '0D 07 00 F7 07 00 F9 07 00 30 08 00 3E 08 00 5E 08 00 5E 08 00 64 09 00 65 09 00 70 09 00 70 09' + '00 FD 09 00 FD 09 00 76 0A 00 76 0A 00 F0 0A 00 F0 0A 00 77 0C 00 77 0C 00 84 0C 00 84 0C 00 F4' + '0D 00 F4 0D 00 4F 0E 00 4F 0E 00 5A 0E 00 5B 0E 00 04 0F 00 12 0F 00 14 0F 00 14 0F 00 85 0F 00' + '85 0F 00 D0 0F 00 D4 0F 00 D9 0F 00 DA 0F 00 4A 10 00 4F 10 00 FB 10 00 FB 10 00 60 13 00 68 13' + '00 6E 16 00 6E 16 00 EB 16 00 ED 16 00 35 17 00 36 17 00 D4 17 00 D6 17 00 D8 17 00 DA 17 00 00' + '18 00 05 18 00 07 18 00 0A 18 00 44 19 00 45 19 00 1E 1A 00 1F 1A 00 A0 1A 00 A6 1A 00 A8 1A 00' + 'AD 1A 00 5A 1B 00 60 1B 00 FC 1B 00 FF 1B 00 3B 1C 00 3F 1C 00 7E 1C 00 7F 1C 00 C0 1C 00 C7 1C' + '00 D3 1C 00 D3 1C 00 16 20 00 17 20 00 20 20 00 27 20 00 30 20 00 38 20 00 3B 20 00 3E 20 00 41' + '20 00 43 20 00 47 20 00 51 20 00 53 20 00 53 20 00 55 20 00 5E 20 00 F9 2C 00 FC 2C 00 FE 2C 00' + 'FF 2C 00 70 2D 00 70 2D 00 00 2E 00 01 2E 00 06 2E 00 08 2E 00 0B 2E 00 0B 2E 00 0E 2E 00 16 2E' + '00 18 2E 00 19 2E 00 1B 2E 00 1B 2E 00 1E 2E 00 1F 2E 00 2A 2E 00 2E 2E 00 30 2E 00 39 2E 00 3C' + '2E 00 3F 2E 00 41 2E 00 41 2E 00 43 2E 00 4F 2E 00 52 2E 00 52 2E 00 01 30 00 03 30 00 3D 30 00' + '3D 30 00 FB 30 00 FB 30 00 FE A4 00 FF A4 00 0D A6 00 0F A6 00 73 A6 00 73 A6 00 7E A6 00 7E A6' + '00 F2 A6 00 F7 A6 00 74 A8 00 77 A8 00 CE A8 00 CF A8 00 F8 A8 00 FA A8 00 FC A8 00 FC A8 00 2E' + 'A9 00 2F A9 00 5F A9 00 5F A9 00 C1 A9 00 CD A9 00 DE A9 00 DF A9 00 5C AA 00 5F AA 00 DE AA 00' + 'DF AA 00 F0 AA 00 F1 AA 00 EB AB 00 EB AB 00 10 FE 00 16 FE 00 19 FE 00 19 FE 00 30 FE 00 30 FE' + '00 45 FE 00 46 FE 00 49 FE 00 4C FE 00 50 FE 00 52 FE 00 54 FE 00 57 FE 00 5F FE 00 61 FE 00 68' + 'FE 00 68 FE 00 6A FE 00 6B FE 00 01 FF 00 03 FF 00 05 FF 00 07 FF 00 0A FF 00 0A FF 00 0C FF 00' + '0C FF 00 0E FF 00 0F FF 00 1A FF 00 1B FF 00 1F FF 00 20 FF 00 3C FF 00 3C FF 00 61 FF 00 61 FF' + '00 64 FF 00 65 FF 00 00 01 01 02 01 01 9F 03 01 9F 03 01 D0 03 01 D0 03 01 6F 05 01 6F 05 01 57' + '08 01 57 08 01 1F 09 01 1F 09 01 3F 09 01 3F 09 01 50 0A 01 58 0A 01 7F 0A 01 7F 0A 01 F0 0A 01' + 'F6 0A 01 39 0B 01 3F 0B 01 99 0B 01 9C 0B 01 55 0F 01 59 0F 01 47 10 01 4D 10 01 BB 10 01 BC 10' + '01 BE 10 01 C1 10 01 40 11 01 43 11 01 74 11 01 75 11 01 C5 11 01 C8 11 01 CD 11 01 CD 11 01 DB' + '11 01 DB 11 01 DD 11 01 DF 11 01 38 12 01 3D 12 01 A9 12 01 A9 12 01 4B 14 01 4F 14 01 5A 14 01' + '5B 14 01 5D 14 01 5D 14 01 C6 14 01 C6 14 01 C1 15 01 D7 15 01 41 16 01 43 16 01 60 16 01 6C 16' + '01 3C 17 01 3E 17 01 3B 18 01 3B 18 01 44 19 01 46 19 01 E2 19 01 E2 19 01 3F 1A 01 46 1A 01 9A' + '1A 01 9C 1A 01 9E 1A 01 A2 1A 01 41 1C 01 45 1C 01 70 1C 01 71 1C 01 F7 1E 01 F8 1E 01 FF 1F 01' + 'FF 1F 01 70 24 01 74 24 01 6E 6A 01 6F 6A 01 F5 6A 01 F5 6A 01 37 6B 01 3B 6B 01 44 6B 01 44 6B' + '01 97 6E 01 9A 6E 01 E2 6F 01 E2 6F 01 9F BC 01 9F BC 01 87 DA 01 8B DA 01 5E E9 01 5F E9 01 1A' + '40 00 00 00 2B 00 00 2B 00 00 3C 00 00 3E 00 00 7C 00 00 7C 00 00 7E 00 00 7E 00 00 AC 00 00 AC' + '00 00 B1 00 00 B1 00 00 D7 00 00 D7 00 00 F7 00 00 F7 00 00 F6 03 00 F6 03 00 06 06 00 08 06 00' + '44 20 00 44 20 00 52 20 00 52 20 00 7A 20 00 7C 20 00 8A 20 00 8C 20 00 18 21 00 18 21 00 40 21' + '00 44 21 00 4B 21 00 4B 21 00 90 21 00 94 21 00 9A 21 00 9B 21 00 A0 21 00 A0 21 00 A3 21 00 A3' + '21 00 A6 21 00 A6 21 00 AE 21 00 AE 21 00 CE 21 00 CF 21 00 D2 21 00 D2 21 00 D4 21 00 D4 21 00' + 'F4 21 00 FF 22 00 20 23 00 21 23 00 7C 23 00 7C 23 00 9B 23 00 B3 23 00 DC 23 00 E1 23 00 B7 25' + '00 B7 25 00 C1 25 00 C1 25 00 F8 25 00 FF 25 00 6F 26 00 6F 26 00 C0 27 00 C4 27 00 C7 27 00 E5' + '27 00 F0 27 00 FF 27 00 00 29 00 82 29 00 99 29 00 D7 29 00 DC 29 00 FB 29 00 FE 29 00 FF 2A 00' + '30 2B 00 44 2B 00 47 2B 00 4C 2B 00 29 FB 00 29 FB 00 62 FE 00 62 FE 00 64 FE 00 66 FE 00 0B FF' + '00 0B FF 00 1C FF 00 1E FF 00 5C FF 00 5C FF 00 5E FF 00 5E FF 00 E2 FF 00 E2 FF 00 E9 FF 00 EC' + 'FF 00 C1 D6 01 C1 D6 01 DB D6 01 DB D6 01 FB D6 01 FB D6 01 15 D7 01 15 D7 01 35 D7 01 35 D7 01' + '4F D7 01 4F D7 01 6F D7 01 6F D7 01 89 D7 01 89 D7 01 A9 D7 01 A9 D7 01 C3 D7 01 C3 D7 01 F0 EE' + '01 F1 EE 01 1B 15 00 00 00 24 00 00 24 00 00 A2 00 00 A5 00 00 8F 05 00 8F 05 00 0B 06 00 0B 06' + '00 FE 07 00 FF 07 00 F2 09 00 F3 09 00 FB 09 00 FB 09 00 F1 0A 00 F1 0A 00 F9 0B 00 F9 0B 00 3F' + '0E 00 3F 0E 00 DB 17 00 DB 17 00 A0 20 00 BF 20 00 38 A8 00 38 A8 00 FC FD 00 FC FD 00 69 FE 00' + '69 FE 00 04 FF 00 04 FF 00 E0 FF 00 E1 FF 00 E5 FF 00 E6 FF 00 DD 1F 01 E0 1F 01 FF E2 01 FF E2' + '01 B0 EC 01 B0 EC 01 1C 1E 00 00 00 5E 00 00 5E 00 00 60 00 00 60 00 00 A8 00 00 A8 00 00 AF 00' + '00 AF 00 00 B4 00 00 B4 00 00 B8 00 00 B8 00 00 C2 02 00 C5 02 00 D2 02 00 DF 02 00 E5 02 00 EB' + '02 00 ED 02 00 ED 02 00 EF 02 00 FF 02 00 75 03 00 75 03 00 84 03 00 85 03 00 BD 1F 00 BD 1F 00' + 'BF 1F 00 C1 1F 00 CD 1F 00 CF 1F 00 DD 1F 00 DF 1F 00 ED 1F 00 EF 1F 00 FD 1F 00 FE 1F 00 9B 30' + '00 9C 30 00 00 A7 00 16 A7 00 20 A7 00 21 A7 00 89 A7 00 8A A7 00 5B AB 00 5B AB 00 6A AB 00 6B' + 'AB 00 B2 FB 00 C1 FB 00 3E FF 00 3E FF 00 40 FF 00 40 FF 00 E3 FF 00 E3 FF 00 FB F3 01 FF F3 01' + '1D B6 00 00 00 A6 00 00 A6 00 00 A9 00 00 A9 00 00 AE 00 00 AE 00 00 B0 00 00 B0 00 00 82 04 00' + '82 04 00 8D 05 00 8E 05 00 0E 06 00 0F 06 00 DE 06 00 DE 06 00 E9 06 00 E9 06 00 FD 06 00 FE 06' + '00 F6 07 00 F6 07 00 FA 09 00 FA 09 00 70 0B 00 70 0B 00 F3 0B 00 F8 0B 00 FA 0B 00 FA 0B 00 7F' + '0C 00 7F 0C 00 4F 0D 00 4F 0D 00 79 0D 00 79 0D 00 01 0F 00 03 0F 00 13 0F 00 13 0F 00 15 0F 00' + '17 0F 00 1A 0F 00 1F 0F 00 34 0F 00 34 0F 00 36 0F 00 36 0F 00 38 0F 00 38 0F 00 BE 0F 00 C5 0F' + '00 C7 0F 00 CC 0F 00 CE 0F 00 CF 0F 00 D5 0F 00 D8 0F 00 9E 10 00 9F 10 00 90 13 00 99 13 00 6D' + '16 00 6D 16 00 40 19 00 40 19 00 DE 19 00 FF 19 00 61 1B 00 6A 1B 00 74 1B 00 7C 1B 00 00 21 00' + '01 21 00 03 21 00 06 21 00 08 21 00 09 21 00 14 21 00 14 21 00 16 21 00 17 21 00 1E 21 00 23 21' + '00 25 21 00 25 21 00 27 21 00 27 21 00 29 21 00 29 21 00 2E 21 00 2E 21 00 3A 21 00 3B 21 00 4A' + '21 00 4A 21 00 4C 21 00 4D 21 00 4F 21 00 4F 21 00 8A 21 00 8B 21 00 95 21 00 99 21 00 9C 21 00' + '9F 21 00 A1 21 00 A2 21 00 A4 21 00 A5 21 00 A7 21 00 AD 21 00 AF 21 00 CD 21 00 D0 21 00 D1 21' + '00 D3 21 00 D3 21 00 D5 21 00 F3 21 00 00 23 00 07 23 00 0C 23 00 1F 23 00 22 23 00 28 23 00 2B' + '23 00 7B 23 00 7D 23 00 9A 23 00 B4 23 00 DB 23 00 E2 23 00 26 24 00 40 24 00 4A 24 00 9C 24 00' + 'E9 24 00 00 25 00 B6 25 00 B8 25 00 C0 25 00 C2 25 00 F7 25 00 00 26 00 6E 26 00 70 26 00 67 27' + '00 94 27 00 BF 27 00 00 28 00 FF 28 00 00 2B 00 2F 2B 00 45 2B 00 46 2B 00 4D 2B 00 73 2B 00 76' + '2B 00 95 2B 00 97 2B 00 FF 2B 00 E5 2C 00 EA 2C 00 50 2E 00 51 2E 00 80 2E 00 99 2E 00 9B 2E 00' + 'F3 2E 00 00 2F 00 D5 2F 00 F0 2F 00 FB 2F 00 04 30 00 04 30 00 12 30 00 13 30 00 20 30 00 20 30' + '00 36 30 00 37 30 00 3E 30 00 3F 30 00 90 31 00 91 31 00 96 31 00 9F 31 00 C0 31 00 E3 31 00 00' + '32 00 1E 32 00 2A 32 00 47 32 00 50 32 00 50 32 00 60 32 00 7F 32 00 8A 32 00 B0 32 00 C0 32 00' + 'FF 33 00 C0 4D 00 FF 4D 00 90 A4 00 C6 A4 00 28 A8 00 2B A8 00 36 A8 00 37 A8 00 39 A8 00 39 A8' + '00 77 AA 00 79 AA 00 FD FD 00 FD FD 00 E4 FF 00 E4 FF 00 E8 FF 00 E8 FF 00 ED FF 00 EE FF 00 FC' + 'FF 00 FD FF 00 37 01 01 3F 01 01 79 01 01 89 01 01 8C 01 01 8E 01 01 90 01 01 9C 01 01 A0 01 01' + 'A0 01 01 D0 01 01 FC 01 01 77 08 01 78 08 01 C8 0A 01 C8 0A 01 3F 17 01 3F 17 01 D5 1F 01 DC 1F' + '01 E1 1F 01 F1 1F 01 3C 6B 01 3F 6B 01 45 6B 01 45 6B 01 9C BC 01 9C BC 01 00 D0 01 F5 D0 01 00' + 'D1 01 26 D1 01 29 D1 01 64 D1 01 6A D1 01 6C D1 01 83 D1 01 84 D1 01 8C D1 01 A9 D1 01 AE D1 01' + 'E8 D1 01 00 D2 01 41 D2 01 45 D2 01 45 D2 01 00 D3 01 56 D3 01 00 D8 01 FF D9 01 37 DA 01 3A DA' + '01 6D DA 01 74 DA 01 76 DA 01 83 DA 01 85 DA 01 86 DA 01 4F E1 01 4F E1 01 AC EC 01 AC EC 01 2E' + 'ED 01 2E ED 01 00 F0 01 2B F0 01 30 F0 01 93 F0 01 A0 F0 01 AE F0 01 B1 F0 01 BF F0 01 C1 F0 01' + 'CF F0 01 D1 F0 01 F5 F0 01 0D F1 01 AD F1 01 E6 F1 01 02 F2 01 10 F2 01 3B F2 01 40 F2 01 48 F2' + '01 50 F2 01 51 F2 01 60 F2 01 65 F2 01 00 F3 01 FA F3 01 00 F4 01 D7 F6 01 E0 F6 01 EC F6 01 F0' + 'F6 01 FC F6 01 00 F7 01 73 F7 01 80 F7 01 D8 F7 01 E0 F7 01 EB F7 01 00 F8 01 0B F8 01 10 F8 01' + '47 F8 01 50 F8 01 59 F8 01 60 F8 01 87 F8 01 90 F8 01 AD F8 01 B0 F8 01 B1 F8 01 00 F9 01 78 F9' + '01 7A F9 01 CB F9 01 CD F9 01 53 FA 01 60 FA 01 6D FA 01 70 FA 01 74 FA 01 78 FA 01 7A FA 01 80' + 'FA 01 86 FA 01 90 FA 01 A8 FA 01 B0 FA 01 B6 FA 01 C0 FA 01 C2 FA 01 D0 FA 01 D6 FA 01 00 FB 01' + '92 FB 01 94 FB 01 CA FB 01 1E BE 02 00 00 41 00 00 5A 00 00 61 00 00 7A 00 00 AA 00 00 AA 00 00' + 'B5 00 00 B5 00 00 BA 00 00 BA 00 00 C0 00 00 D6 00 00 D8 00 00 F6 00 00 F8 00 00 B8 02 00 BB 02' + '00 C1 02 00 D0 02 00 D1 02 00 E0 02 00 E4 02 00 EE 02 00 EE 02 00 70 03 00 73 03 00 76 03 00 77' + '03 00 7A 03 00 7D 03 00 7F 03 00 7F 03 00 86 03 00 86 03 00 88 03 00 8A 03 00 8C 03 00 8C 03 00' + '8E 03 00 A1 03 00 A3 03 00 F5 03 00 F7 03 00 82 04 00 8A 04 00 2F 05 00 31 05 00 56 05 00 59 05' + '00 89 05 00 03 09 00 39 09 00 3B 09 00 3B 09 00 3D 09 00 40 09 00 49 09 00 4C 09 00 4E 09 00 50' + '09 00 58 09 00 61 09 00 64 09 00 80 09 00 82 09 00 83 09 00 85 09 00 8C 09 00 8F 09 00 90 09 00' + '93 09 00 A8 09 00 AA 09 00 B0 09 00 B2 09 00 B2 09 00 B6 09 00 B9 09 00 BD 09 00 C0 09 00 C7 09' + '00 C8 09 00 CB 09 00 CC 09 00 CE 09 00 CE 09 00 D7 09 00 D7 09 00 DC 09 00 DD 09 00 DF 09 00 E1' + '09 00 E6 09 00 F1 09 00 F4 09 00 FA 09 00 FC 09 00 FD 09 00 03 0A 00 03 0A 00 05 0A 00 0A 0A 00' + '0F 0A 00 10 0A 00 13 0A 00 28 0A 00 2A 0A 00 30 0A 00 32 0A 00 33 0A 00 35 0A 00 36 0A 00 38 0A' + '00 39 0A 00 3E 0A 00 40 0A 00 59 0A 00 5C 0A 00 5E 0A 00 5E 0A 00 66 0A 00 6F 0A 00 72 0A 00 74' + '0A 00 76 0A 00 76 0A 00 83 0A 00 83 0A 00 85 0A 00 8D 0A 00 8F 0A 00 91 0A 00 93 0A 00 A8 0A 00' + 'AA 0A 00 B0 0A 00 B2 0A 00 B3 0A 00 B5 0A 00 B9 0A 00 BD 0A 00 C0 0A 00 C9 0A 00 C9 0A 00 CB 0A' + '00 CC 0A 00 D0 0A 00 D0 0A 00 E0 0A 00 E1 0A 00 E6 0A 00 F0 0A 00 F9 0A 00 F9 0A 00 02 0B 00 03' + '0B 00 05 0B 00 0C 0B 00 0F 0B 00 10 0B 00 13 0B 00 28 0B 00 2A 0B 00 30 0B 00 32 0B 00 33 0B 00' + '35 0B 00 39 0B 00 3D 0B 00 3E 0B 00 40 0B 00 40 0B 00 47 0B 00 48 0B 00 4B 0B 00 4C 0B 00 57 0B' + '00 57 0B 00 5C 0B 00 5D 0B 00 5F 0B 00 61 0B 00 66 0B 00 77 0B 00 83 0B 00 83 0B 00 85 0B 00 8A' + '0B 00 8E 0B 00 90 0B 00 92 0B 00 95 0B 00 99 0B 00 9A 0B 00 9C 0B 00 9C 0B 00 9E 0B 00 9F 0B 00' + 'A3 0B 00 A4 0B 00 A8 0B 00 AA 0B 00 AE 0B 00 B9 0B 00 BE 0B 00 BF 0B 00 C1 0B 00 C2 0B 00 C6 0B' + '00 C8 0B 00 CA 0B 00 CC 0B 00 D0 0B 00 D0 0B 00 D7 0B 00 D7 0B 00 E6 0B 00 F2 0B 00 01 0C 00 03' + '0C 00 05 0C 00 0C 0C 00 0E 0C 00 10 0C 00 12 0C 00 28 0C 00 2A 0C 00 39 0C 00 3D 0C 00 3D 0C 00' + '41 0C 00 44 0C 00 58 0C 00 5A 0C 00 60 0C 00 61 0C 00 66 0C 00 6F 0C 00 77 0C 00 77 0C 00 7F 0C' + '00 80 0C 00 82 0C 00 8C 0C 00 8E 0C 00 90 0C 00 92 0C 00 A8 0C 00 AA 0C 00 B3 0C 00 B5 0C 00 B9' + '0C 00 BD 0C 00 C4 0C 00 C6 0C 00 C8 0C 00 CA 0C 00 CB 0C 00 D5 0C 00 D6 0C 00 DE 0C 00 DE 0C 00' + 'E0 0C 00 E1 0C 00 E6 0C 00 EF 0C 00 F1 0C 00 F2 0C 00 02 0D 00 0C 0D 00 0E 0D 00 10 0D 00 12 0D' + '00 3A 0D 00 3D 0D 00 40 0D 00 46 0D 00 48 0D 00 4A 0D 00 4C 0D 00 4E 0D 00 4F 0D 00 54 0D 00 61' + '0D 00 66 0D 00 7F 0D 00 82 0D 00 83 0D 00 85 0D 00 96 0D 00 9A 0D 00 B1 0D 00 B3 0D 00 BB 0D 00' + 'BD 0D 00 BD 0D 00 C0 0D 00 C6 0D 00 CF 0D 00 D1 0D 00 D8 0D 00 DF 0D 00 E6 0D 00 EF 0D 00 F2 0D' + '00 F4 0D 00 01 0E 00 30 0E 00 32 0E 00 33 0E 00 40 0E 00 46 0E 00 4F 0E 00 5B 0E 00 81 0E 00 82' + '0E 00 84 0E 00 84 0E 00 86 0E 00 8A 0E 00 8C 0E 00 A3 0E 00 A5 0E 00 A5 0E 00 A7 0E 00 B0 0E 00' + 'B2 0E 00 B3 0E 00 BD 0E 00 BD 0E 00 C0 0E 00 C4 0E 00 C6 0E 00 C6 0E 00 D0 0E 00 D9 0E 00 DC 0E' + '00 DF 0E 00 00 0F 00 17 0F 00 1A 0F 00 34 0F 00 36 0F 00 36 0F 00 38 0F 00 38 0F 00 3E 0F 00 47' + '0F 00 49 0F 00 6C 0F 00 7F 0F 00 7F 0F 00 85 0F 00 85 0F 00 88 0F 00 8C 0F 00 BE 0F 00 C5 0F 00' + 'C7 0F 00 CC 0F 00 CE 0F 00 DA 0F 00 00 10 00 2C 10 00 31 10 00 31 10 00 38 10 00 38 10 00 3B 10' + '00 3C 10 00 3F 10 00 57 10 00 5A 10 00 5D 10 00 61 10 00 70 10 00 75 10 00 81 10 00 83 10 00 84' + '10 00 87 10 00 8C 10 00 8E 10 00 9C 10 00 9E 10 00 C5 10 00 C7 10 00 C7 10 00 CD 10 00 CD 10 00' + 'D0 10 00 48 12 00 4A 12 00 4D 12 00 50 12 00 56 12 00 58 12 00 58 12 00 5A 12 00 5D 12 00 60 12' + '00 88 12 00 8A 12 00 8D 12 00 90 12 00 B0 12 00 B2 12 00 B5 12 00 B8 12 00 BE 12 00 C0 12 00 C0' + '12 00 C2 12 00 C5 12 00 C8 12 00 D6 12 00 D8 12 00 10 13 00 12 13 00 15 13 00 18 13 00 5A 13 00' + '60 13 00 7C 13 00 80 13 00 8F 13 00 A0 13 00 F5 13 00 F8 13 00 FD 13 00 01 14 00 7F 16 00 81 16' + '00 9A 16 00 A0 16 00 F8 16 00 00 17 00 0C 17 00 0E 17 00 11 17 00 20 17 00 31 17 00 35 17 00 36' + '17 00 40 17 00 51 17 00 60 17 00 6C 17 00 6E 17 00 70 17 00 80 17 00 B3 17 00 B6 17 00 B6 17 00' + 'BE 17 00 C5 17 00 C7 17 00 C8 17 00 D4 17 00 DA 17 00 DC 17 00 DC 17 00 E0 17 00 E9 17 00 10 18' + '00 19 18 00 20 18 00 78 18 00 80 18 00 84 18 00 87 18 00 A8 18 00 AA 18 00 AA 18 00 B0 18 00 F5' + '18 00 00 19 00 1E 19 00 23 19 00 26 19 00 29 19 00 2B 19 00 30 19 00 31 19 00 33 19 00 38 19 00' + '46 19 00 6D 19 00 70 19 00 74 19 00 80 19 00 AB 19 00 B0 19 00 C9 19 00 D0 19 00 DA 19 00 00 1A' + '00 16 1A 00 19 1A 00 1A 1A 00 1E 1A 00 55 1A 00 57 1A 00 57 1A 00 61 1A 00 61 1A 00 63 1A 00 64' + '1A 00 6D 1A 00 72 1A 00 80 1A 00 89 1A 00 90 1A 00 99 1A 00 A0 1A 00 AD 1A 00 04 1B 00 33 1B 00' + '35 1B 00 35 1B 00 3B 1B 00 3B 1B 00 3D 1B 00 41 1B 00 43 1B 00 4B 1B 00 50 1B 00 6A 1B 00 74 1B' + '00 7C 1B 00 82 1B 00 A1 1B 00 A6 1B 00 A7 1B 00 AA 1B 00 AA 1B 00 AE 1B 00 E5 1B 00 E7 1B 00 E7' + '1B 00 EA 1B 00 EC 1B 00 EE 1B 00 EE 1B 00 F2 1B 00 F3 1B 00 FC 1B 00 2B 1C 00 34 1C 00 35 1C 00' + '3B 1C 00 49 1C 00 4D 1C 00 88 1C 00 90 1C 00 BA 1C 00 BD 1C 00 C7 1C 00 D3 1C 00 D3 1C 00 E1 1C' + '00 E1 1C 00 E9 1C 00 EC 1C 00 EE 1C 00 F3 1C 00 F5 1C 00 F7 1C 00 FA 1C 00 FA 1C 00 00 1D 00 BF' + '1D 00 00 1E 00 15 1F 00 18 1F 00 1D 1F 00 20 1F 00 45 1F 00 48 1F 00 4D 1F 00 50 1F 00 57 1F 00' + '59 1F 00 59 1F 00 5B 1F 00 5B 1F 00 5D 1F 00 5D 1F 00 5F 1F 00 7D 1F 00 80 1F 00 B4 1F 00 B6 1F' + '00 BC 1F 00 BE 1F 00 BE 1F 00 C2 1F 00 C4 1F 00 C6 1F 00 CC 1F 00 D0 1F 00 D3 1F 00 D6 1F 00 DB' + '1F 00 E0 1F 00 EC 1F 00 F2 1F 00 F4 1F 00 F6 1F 00 FC 1F 00 0E 20 00 0E 20 00 71 20 00 71 20 00' + '7F 20 00 7F 20 00 90 20 00 9C 20 00 02 21 00 02 21 00 07 21 00 07 21 00 0A 21 00 13 21 00 15 21' + '00 15 21 00 19 21 00 1D 21 00 24 21 00 24 21 00 26 21 00 26 21 00 28 21 00 28 21 00 2A 21 00 2D' + '21 00 2F 21 00 39 21 00 3C 21 00 3F 21 00 45 21 00 49 21 00 4E 21 00 4F 21 00 60 21 00 88 21 00' + '36 23 00 7A 23 00 95 23 00 95 23 00 9C 24 00 E9 24 00 AC 26 00 AC 26 00 00 28 00 FF 28 00 00 2C' + '00 2E 2C 00 30 2C 00 5E 2C 00 60 2C 00 E4 2C 00 EB 2C 00 EE 2C 00 F2 2C 00 F3 2C 00 00 2D 00 25' + '2D 00 27 2D 00 27 2D 00 2D 2D 00 2D 2D 00 30 2D 00 67 2D 00 6F 2D 00 70 2D 00 80 2D 00 96 2D 00' + 'A0 2D 00 A6 2D 00 A8 2D 00 AE 2D 00 B0 2D 00 B6 2D 00 B8 2D 00 BE 2D 00 C0 2D 00 C6 2D 00 C8 2D' + '00 CE 2D 00 D0 2D 00 D6 2D 00 D8 2D 00 DE 2D 00 05 30 00 07 30 00 21 30 00 29 30 00 2E 30 00 2F' + '30 00 31 30 00 35 30 00 38 30 00 3C 30 00 41 30 00 96 30 00 9D 30 00 9F 30 00 A1 30 00 FA 30 00' + 'FC 30 00 FF 30 00 05 31 00 2F 31 00 31 31 00 8E 31 00 90 31 00 BF 31 00 F0 31 00 1C 32 00 20 32' + '00 4F 32 00 60 32 00 7B 32 00 7F 32 00 B0 32 00 C0 32 00 CB 32 00 D0 32 00 76 33 00 7B 33 00 DD' + '33 00 E0 33 00 FE 33 00 00 34 00 BF 4D 00 00 4E 00 FC 9F 00 00 A0 00 8C A4 00 D0 A4 00 0C A6 00' + '10 A6 00 2B A6 00 40 A6 00 6E A6 00 80 A6 00 9D A6 00 A0 A6 00 EF A6 00 F2 A6 00 F7 A6 00 22 A7' + '00 87 A7 00 89 A7 00 BF A7 00 C2 A7 00 CA A7 00 F5 A7 00 01 A8 00 03 A8 00 05 A8 00 07 A8 00 0A' + 'A8 00 0C A8 00 24 A8 00 27 A8 00 27 A8 00 30 A8 00 37 A8 00 40 A8 00 73 A8 00 80 A8 00 C3 A8 00' + 'CE A8 00 D9 A8 00 F2 A8 00 FE A8 00 00 A9 00 25 A9 00 2E A9 00 46 A9 00 52 A9 00 53 A9 00 5F A9' + '00 7C A9 00 83 A9 00 B2 A9 00 B4 A9 00 B5 A9 00 BA A9 00 BB A9 00 BE A9 00 CD A9 00 CF A9 00 D9' + 'A9 00 DE A9 00 E4 A9 00 E6 A9 00 FE A9 00 00 AA 00 28 AA 00 2F AA 00 30 AA 00 33 AA 00 34 AA 00' + '40 AA 00 42 AA 00 44 AA 00 4B AA 00 4D AA 00 4D AA 00 50 AA 00 59 AA 00 5C AA 00 7B AA 00 7D AA' + '00 AF AA 00 B1 AA 00 B1 AA 00 B5 AA 00 B6 AA 00 B9 AA 00 BD AA 00 C0 AA 00 C0 AA 00 C2 AA 00 C2' + 'AA 00 DB AA 00 EB AA 00 EE AA 00 F5 AA 00 01 AB 00 06 AB 00 09 AB 00 0E AB 00 11 AB 00 16 AB 00' + '20 AB 00 26 AB 00 28 AB 00 2E AB 00 30 AB 00 69 AB 00 70 AB 00 E4 AB 00 E6 AB 00 E7 AB 00 E9 AB' + '00 EC AB 00 F0 AB 00 F9 AB 00 00 AC 00 A3 D7 00 B0 D7 00 C6 D7 00 CB D7 00 FB D7 00 00 D8 00 6D' + 'FA 00 70 FA 00 D9 FA 00 00 FB 00 06 FB 00 13 FB 00 17 FB 00 21 FF 00 3A FF 00 41 FF 00 5A FF 00' + '66 FF 00 BE FF 00 C2 FF 00 C7 FF 00 CA FF 00 CF FF 00 D2 FF 00 D7 FF 00 DA FF 00 DC FF 00 00 00' + '01 0B 00 01 0D 00 01 26 00 01 28 00 01 3A 00 01 3C 00 01 3D 00 01 3F 00 01 4D 00 01 50 00 01 5D' + '00 01 80 00 01 FA 00 01 00 01 01 00 01 01 02 01 01 02 01 01 07 01 01 33 01 01 37 01 01 3F 01 01' + '8D 01 01 8E 01 01 D0 01 01 FC 01 01 80 02 01 9C 02 01 A0 02 01 D0 02 01 00 03 01 23 03 01 2D 03' + '01 4A 03 01 50 03 01 75 03 01 80 03 01 9D 03 01 9F 03 01 C3 03 01 C8 03 01 D5 03 01 00 04 01 9D' + '04 01 A0 04 01 A9 04 01 B0 04 01 D3 04 01 D8 04 01 FB 04 01 00 05 01 27 05 01 30 05 01 63 05 01' + '6F 05 01 6F 05 01 00 06 01 36 07 01 40 07 01 55 07 01 60 07 01 67 07 01 00 10 01 00 10 01 02 10' + '01 37 10 01 47 10 01 4D 10 01 66 10 01 6F 10 01 82 10 01 B2 10 01 B7 10 01 B8 10 01 BB 10 01 C1' + '10 01 CD 10 01 CD 10 01 D0 10 01 E8 10 01 F0 10 01 F9 10 01 03 11 01 26 11 01 2C 11 01 2C 11 01' + '36 11 01 47 11 01 50 11 01 72 11 01 74 11 01 76 11 01 82 11 01 B5 11 01 BF 11 01 C8 11 01 CD 11' + '01 CE 11 01 D0 11 01 DF 11 01 E1 11 01 F4 11 01 00 12 01 11 12 01 13 12 01 2E 12 01 32 12 01 33' + '12 01 35 12 01 35 12 01 38 12 01 3D 12 01 80 12 01 86 12 01 88 12 01 88 12 01 8A 12 01 8D 12 01' + '8F 12 01 9D 12 01 9F 12 01 A9 12 01 B0 12 01 DE 12 01 E0 12 01 E2 12 01 F0 12 01 F9 12 01 02 13' + '01 03 13 01 05 13 01 0C 13 01 0F 13 01 10 13 01 13 13 01 28 13 01 2A 13 01 30 13 01 32 13 01 33' + '13 01 35 13 01 39 13 01 3D 13 01 3F 13 01 41 13 01 44 13 01 47 13 01 48 13 01 4B 13 01 4D 13 01' + '50 13 01 50 13 01 57 13 01 57 13 01 5D 13 01 63 13 01 00 14 01 37 14 01 40 14 01 41 14 01 45 14' + '01 45 14 01 47 14 01 5B 14 01 5D 14 01 5D 14 01 5F 14 01 61 14 01 80 14 01 B2 14 01 B9 14 01 B9' + '14 01 BB 14 01 BE 14 01 C1 14 01 C1 14 01 C4 14 01 C7 14 01 D0 14 01 D9 14 01 80 15 01 B1 15 01' + 'B8 15 01 BB 15 01 BE 15 01 BE 15 01 C1 15 01 DB 15 01 00 16 01 32 16 01 3B 16 01 3C 16 01 3E 16' + '01 3E 16 01 41 16 01 44 16 01 50 16 01 59 16 01 80 16 01 AA 16 01 AC 16 01 AC 16 01 AE 16 01 AF' + '16 01 B6 16 01 B6 16 01 B8 16 01 B8 16 01 C0 16 01 C9 16 01 00 17 01 1A 17 01 20 17 01 21 17 01' + '26 17 01 26 17 01 30 17 01 3F 17 01 00 18 01 2E 18 01 38 18 01 38 18 01 3B 18 01 3B 18 01 A0 18' + '01 F2 18 01 FF 18 01 06 19 01 09 19 01 09 19 01 0C 19 01 13 19 01 15 19 01 16 19 01 18 19 01 35' + '19 01 37 19 01 38 19 01 3D 19 01 3D 19 01 3F 19 01 42 19 01 44 19 01 46 19 01 50 19 01 59 19 01' + 'A0 19 01 A7 19 01 AA 19 01 D3 19 01 DC 19 01 DF 19 01 E1 19 01 E4 19 01 00 1A 01 00 1A 01 07 1A' + '01 08 1A 01 0B 1A 01 32 1A 01 39 1A 01 3A 1A 01 3F 1A 01 46 1A 01 50 1A 01 50 1A 01 57 1A 01 58' + '1A 01 5C 1A 01 89 1A 01 97 1A 01 97 1A 01 9A 1A 01 A2 1A 01 C0 1A 01 F8 1A 01 00 1C 01 08 1C 01' + '0A 1C 01 2F 1C 01 3E 1C 01 45 1C 01 50 1C 01 6C 1C 01 70 1C 01 8F 1C 01 A9 1C 01 A9 1C 01 B1 1C' + '01 B1 1C 01 B4 1C 01 B4 1C 01 00 1D 01 06 1D 01 08 1D 01 09 1D 01 0B 1D 01 30 1D 01 46 1D 01 46' + '1D 01 50 1D 01 59 1D 01 60 1D 01 65 1D 01 67 1D 01 68 1D 01 6A 1D 01 8E 1D 01 93 1D 01 94 1D 01' + '96 1D 01 96 1D 01 98 1D 01 98 1D 01 A0 1D 01 A9 1D 01 E0 1E 01 F2 1E 01 F5 1E 01 F8 1E 01 B0 1F' + '01 B0 1F 01 C0 1F 01 D4 1F 01 FF 1F 01 99 23 01 00 24 01 6E 24 01 70 24 01 74 24 01 80 24 01 43' + '25 01 00 30 01 2E 34 01 30 34 01 38 34 01 00 44 01 46 46 01 00 68 01 38 6A 01 40 6A 01 5E 6A 01' + '60 6A 01 69 6A 01 6E 6A 01 6F 6A 01 D0 6A 01 ED 6A 01 F5 6A 01 F5 6A 01 00 6B 01 2F 6B 01 37 6B' + '01 45 6B 01 50 6B 01 59 6B 01 5B 6B 01 61 6B 01 63 6B 01 77 6B 01 7D 6B 01 8F 6B 01 40 6E 01 9A' + '6E 01 00 6F 01 4A 6F 01 50 6F 01 87 6F 01 93 6F 01 9F 6F 01 E0 6F 01 E1 6F 01 E3 6F 01 E3 6F 01' + 'F0 6F 01 F1 6F 01 00 70 01 F7 87 01 00 88 01 D5 8C 01 00 8D 01 08 8D 01 00 B0 01 1E B1 01 50 B1' + '01 52 B1 01 64 B1 01 67 B1 01 70 B1 01 FB B2 01 00 BC 01 6A BC 01 70 BC 01 7C BC 01 80 BC 01 88' + 'BC 01 90 BC 01 99 BC 01 9C BC 01 9C BC 01 9F BC 01 9F BC 01 00 D0 01 F5 D0 01 00 D1 01 26 D1 01' + '29 D1 01 66 D1 01 6A D1 01 72 D1 01 83 D1 01 84 D1 01 8C D1 01 A9 D1 01 AE D1 01 E8 D1 01 E0 D2' + '01 F3 D2 01 60 D3 01 78 D3 01 00 D4 01 54 D4 01 56 D4 01 9C D4 01 9E D4 01 9F D4 01 A2 D4 01 A2' + 'D4 01 A5 D4 01 A6 D4 01 A9 D4 01 AC D4 01 AE D4 01 B9 D4 01 BB D4 01 BB D4 01 BD D4 01 C3 D4 01' + 'C5 D4 01 05 D5 01 07 D5 01 0A D5 01 0D D5 01 14 D5 01 16 D5 01 1C D5 01 1E D5 01 39 D5 01 3B D5' + '01 3E D5 01 40 D5 01 44 D5 01 46 D5 01 46 D5 01 4A D5 01 50 D5 01 52 D5 01 A5 D6 01 A8 D6 01 DA' + 'D6 01 DC D6 01 14 D7 01 16 D7 01 4E D7 01 50 D7 01 88 D7 01 8A D7 01 C2 D7 01 C4 D7 01 CB D7 01' + '00 D8 01 FF D9 01 37 DA 01 3A DA 01 6D DA 01 74 DA 01 76 DA 01 83 DA 01 85 DA 01 8B DA 01 00 E1' + '01 2C E1 01 37 E1 01 3D E1 01 40 E1 01 49 E1 01 4E E1 01 4F E1 01 C0 E2 01 EB E2 01 F0 E2 01 F9' + 'E2 01 10 F1 01 2E F1 01 30 F1 01 69 F1 01 70 F1 01 AC F1 01 E6 F1 01 02 F2 01 10 F2 01 3B F2 01' + '40 F2 01 48 F2 01 50 F2 01 51 F2 01 00 00 02 DD A6 02 00 A7 02 34 B7 02 40 B7 02 1D B8 02 20 B8' + '02 A1 CE 02 B0 CE 02 E0 EB 02 00 F8 02 1D FA 02 00 00 03 4A 13 03 00 00 0F FD FF 0F 00 00 10 FD' + 'FF 10 1F 01 00 00 00 2A 20 00 2A 20 00 20 01 00 00 00 2D 20 00 2D 20 00 21 47 00 00 00 BE 05 00' + 'BE 05 00 C0 05 00 C0 05 00 C3 05 00 C3 05 00 C6 05 00 C6 05 00 D0 05 00 EA 05 00 EF 05 00 F4 05' + '00 C0 07 00 EA 07 00 F4 07 00 F5 07 00 FA 07 00 FA 07 00 FE 07 00 15 08 00 1A 08 00 1A 08 00 24' + '08 00 24 08 00 28 08 00 28 08 00 30 08 00 3E 08 00 40 08 00 58 08 00 5E 08 00 5E 08 00 0F 20 00' + '0F 20 00 1D FB 00 1D FB 00 1F FB 00 28 FB 00 2A FB 00 36 FB 00 38 FB 00 3C FB 00 3E FB 00 3E FB' + '00 40 FB 00 41 FB 00 43 FB 00 44 FB 00 46 FB 00 4F FB 00 00 08 01 05 08 01 08 08 01 08 08 01 0A' + '08 01 35 08 01 37 08 01 38 08 01 3C 08 01 3C 08 01 3F 08 01 55 08 01 57 08 01 9E 08 01 A7 08 01' + 'AF 08 01 E0 08 01 F2 08 01 F4 08 01 F5 08 01 FB 08 01 1B 09 01 20 09 01 39 09 01 3F 09 01 3F 09' + '01 80 09 01 B7 09 01 BC 09 01 CF 09 01 D2 09 01 00 0A 01 10 0A 01 13 0A 01 15 0A 01 17 0A 01 19' + '0A 01 35 0A 01 40 0A 01 48 0A 01 50 0A 01 58 0A 01 60 0A 01 9F 0A 01 C0 0A 01 E4 0A 01 EB 0A 01' + 'F6 0A 01 00 0B 01 35 0B 01 40 0B 01 55 0B 01 58 0B 01 72 0B 01 78 0B 01 91 0B 01 99 0B 01 9C 0B' + '01 A9 0B 01 AF 0B 01 00 0C 01 48 0C 01 80 0C 01 B2 0C 01 C0 0C 01 F2 0C 01 FA 0C 01 FF 0C 01 80' + '0E 01 A9 0E 01 AD 0E 01 AD 0E 01 B0 0E 01 B1 0E 01 00 0F 01 27 0F 01 B0 0F 01 CB 0F 01 E0 0F 01' + 'F6 0F 01 00 E8 01 C4 E8 01 C7 E8 01 CF E8 01 00 E9 01 43 E9 01 4B E9 01 4B E9 01 50 E9 01 59 E9' + '01 5E E9 01 5F E9 01 22 3E 00 00 00 08 06 00 08 06 00 0B 06 00 0B 06 00 0D 06 00 0D 06 00 1B 06' + '00 1C 06 00 1E 06 00 4A 06 00 6D 06 00 6F 06 00 71 06 00 D5 06 00 E5 06 00 E6 06 00 EE 06 00 EF' + '06 00 FA 06 00 0D 07 00 0F 07 00 10 07 00 12 07 00 2F 07 00 4D 07 00 A5 07 00 B1 07 00 B1 07 00' + '60 08 00 6A 08 00 A0 08 00 B4 08 00 B6 08 00 C7 08 00 50 FB 00 C1 FB 00 D3 FB 00 3D FD 00 50 FD' + '00 8F FD 00 92 FD 00 C7 FD 00 F0 FD 00 FC FD 00 70 FE 00 74 FE 00 76 FE 00 FC FE 00 00 0D 01 23' + '0D 01 30 0F 01 45 0F 01 51 0F 01 59 0F 01 71 EC 01 B4 EC 01 01 ED 01 3D ED 01 00 EE 01 03 EE 01' + '05 EE 01 1F EE 01 21 EE 01 22 EE 01 24 EE 01 24 EE 01 27 EE 01 27 EE 01 29 EE 01 32 EE 01 34 EE' + '01 37 EE 01 39 EE 01 39 EE 01 3B EE 01 3B EE 01 42 EE 01 42 EE 01 47 EE 01 47 EE 01 49 EE 01 49' + 'EE 01 4B EE 01 4B EE 01 4D EE 01 4F EE 01 51 EE 01 52 EE 01 54 EE 01 54 EE 01 57 EE 01 57 EE 01' + '59 EE 01 59 EE 01 5B EE 01 5B EE 01 5D EE 01 5D EE 01 5F EE 01 5F EE 01 61 EE 01 62 EE 01 64 EE' + '01 64 EE 01 67 EE 01 6A EE 01 6C EE 01 72 EE 01 74 EE 01 77 EE 01 79 EE 01 7C EE 01 7E EE 01 7E' + 'EE 01 80 EE 01 89 EE 01 8B EE 01 9B EE 01 A1 EE 01 A3 EE 01 A5 EE 01 A9 EE 01 AB EE 01 BB EE 01' + '23 01 00 00 00 2B 20 00 2B 20 00 24 01 00 00 00 2E 20 00 2E 20 00 25 01 00 00 00 2C 20 00 2C 20' + '00 26 0D 00 00 00 30 00 00 39 00 00 B2 00 00 B3 00 00 B9 00 00 B9 00 00 F0 06 00 F9 06 00 70 20' + '00 70 20 00 74 20 00 79 20 00 80 20 00 89 20 00 88 24 00 9B 24 00 10 FF 00 19 FF 00 E1 02 01 FB' + '02 01 CE D7 01 FF D7 01 00 F1 01 0A F1 01 F0 FB 01 F9 FB 01 27 09 00 00 00 2B 00 00 2B 00 00 2D' + '00 00 2D 00 00 7A 20 00 7B 20 00 8A 20 00 8B 20 00 12 22 00 12 22 00 29 FB 00 29 FB 00 62 FE 00' + '63 FE 00 0B FF 00 0B FF 00 0D FF 00 0D FF 00 28 18 00 00 00 23 00 00 25 00 00 A2 00 00 A5 00 00' + 'B0 00 00 B1 00 00 8F 05 00 8F 05 00 09 06 00 0A 06 00 6A 06 00 6A 06 00 F2 09 00 F3 09 00 FB 09' + '00 FB 09 00 F1 0A 00 F1 0A 00 F9 0B 00 F9 0B 00 3F 0E 00 3F 0E 00 DB 17 00 DB 17 00 30 20 00 34' + '20 00 A0 20 00 BF 20 00 2E 21 00 2E 21 00 13 22 00 13 22 00 38 A8 00 39 A8 00 5F FE 00 5F FE 00' + '69 FE 00 6A FE 00 03 FF 00 05 FF 00 E0 FF 00 E1 FF 00 E5 FF 00 E6 FF 00 DD 1F 01 E0 1F 01 FF E2' + '01 FF E2 01 29 07 00 00 00 00 06 00 05 06 00 60 06 00 69 06 00 6B 06 00 6C 06 00 DD 06 00 DD 06' + '00 E2 08 00 E2 08 00 30 0D 01 39 0D 01 60 0E 01 7E 0E 01 2A 0D 00 00 00 2C 00 00 2C 00 00 2E 00' + '00 2F 00 00 3A 00 00 3A 00 00 A0 00 00 A0 00 00 0C 06 00 0C 06 00 2F 20 00 2F 20 00 44 20 00 44' + '20 00 50 FE 00 50 FE 00 52 FE 00 52 FE 00 55 FE 00 55 FE 00 0C FF 00 0C FF 00 0E FF 00 0F FF 00' + '1A FF 00 1A FF 00 2B 0E 00 00 00 00 00 00 08 00 00 0E 00 00 1B 00 00 7F 00 00 84 00 00 86 00 00' + '9F 00 00 AD 00 00 AD 00 00 0E 18 00 0E 18 00 0B 20 00 0D 20 00 60 20 00 64 20 00 6A 20 00 6F 20' + '00 FF FE 00 FF FE 00 A0 BC 01 A3 BC 01 73 D1 01 7A D1 01 01 00 0E 01 00 0E 20 00 0E 7F 00 0E 2C' + '03 00 00 00 09 00 00 09 00 00 0B 00 00 0B 00 00 1F 00 00 1F 00 00 2D 0A 00 00 00 09 00 00 0D 00' + '00 20 00 00 20 00 00 85 00 00 85 00 00 A0 00 00 A0 00 00 80 16 00 80 16 00 00 20 00 0A 20 00 28' + '20 00 29 20 00 2F 20 00 2F 20 00 5F 20 00 5F 20 00 00 30 00 00 30 00 2E BC 00 00 00 21 00 00 22' + '00 00 26 00 00 2A 00 00 3B 00 00 40 00 00 5B 00 00 60 00 00 7B 00 00 7E 00 00 A1 00 00 A1 00 00' + 'A6 00 00 A9 00 00 AB 00 00 AC 00 00 AE 00 00 AF 00 00 B4 00 00 B4 00 00 B6 00 00 B8 00 00 BB 00' + '00 BF 00 00 D7 00 00 D7 00 00 F7 00 00 F7 00 00 B9 02 00 BA 02 00 C2 02 00 CF 02 00 D2 02 00 DF' + '02 00 E5 02 00 ED 02 00 EF 02 00 FF 02 00 74 03 00 75 03 00 7E 03 00 7E 03 00 84 03 00 85 03 00' + '87 03 00 87 03 00 F6 03 00 F6 03 00 8A 05 00 8A 05 00 8D 05 00 8E 05 00 06 06 00 07 06 00 0E 06' + '00 0F 06 00 DE 06 00 DE 06 00 E9 06 00 E9 06 00 F6 07 00 F9 07 00 F3 0B 00 F8 0B 00 FA 0B 00 FA' + '0B 00 78 0C 00 7E 0C 00 3A 0F 00 3D 0F 00 90 13 00 99 13 00 00 14 00 00 14 00 9B 16 00 9C 16 00' + 'F0 17 00 F9 17 00 00 18 00 0A 18 00 40 19 00 40 19 00 44 19 00 45 19 00 DE 19 00 FF 19 00 BD 1F' + '00 BD 1F 00 BF 1F 00 C1 1F 00 CD 1F 00 CF 1F 00 DD 1F 00 DF 1F 00 ED 1F 00 EF 1F 00 FD 1F 00 FE' + '1F 00 10 20 00 27 20 00 35 20 00 43 20 00 45 20 00 5E 20 00 7C 20 00 7E 20 00 8C 20 00 8E 20 00' + '00 21 00 01 21 00 03 21 00 06 21 00 08 21 00 09 21 00 14 21 00 14 21 00 16 21 00 18 21 00 1E 21' + '00 23 21 00 25 21 00 25 21 00 27 21 00 27 21 00 29 21 00 29 21 00 3A 21 00 3B 21 00 40 21 00 44' + '21 00 4A 21 00 4D 21 00 50 21 00 5F 21 00 89 21 00 8B 21 00 90 21 00 11 22 00 14 22 00 35 23 00' + '7B 23 00 94 23 00 96 23 00 26 24 00 40 24 00 4A 24 00 60 24 00 87 24 00 EA 24 00 AB 26 00 AD 26' + '00 FF 27 00 00 29 00 73 2B 00 76 2B 00 95 2B 00 97 2B 00 FF 2B 00 E5 2C 00 EA 2C 00 F9 2C 00 FF' + '2C 00 00 2E 00 52 2E 00 80 2E 00 99 2E 00 9B 2E 00 F3 2E 00 00 2F 00 D5 2F 00 F0 2F 00 FB 2F 00' + '01 30 00 04 30 00 08 30 00 20 30 00 30 30 00 30 30 00 36 30 00 37 30 00 3D 30 00 3F 30 00 9B 30' + '00 9C 30 00 A0 30 00 A0 30 00 FB 30 00 FB 30 00 C0 31 00 E3 31 00 1D 32 00 1E 32 00 50 32 00 5F' + '32 00 7C 32 00 7E 32 00 B1 32 00 BF 32 00 CC 32 00 CF 32 00 77 33 00 7A 33 00 DE 33 00 DF 33 00' + 'FF 33 00 FF 33 00 C0 4D 00 FF 4D 00 90 A4 00 C6 A4 00 0D A6 00 0F A6 00 73 A6 00 73 A6 00 7E A6' + '00 7F A6 00 00 A7 00 21 A7 00 88 A7 00 88 A7 00 28 A8 00 2B A8 00 74 A8 00 77 A8 00 6A AB 00 6B' + 'AB 00 3E FD 00 3F FD 00 FD FD 00 FD FD 00 10 FE 00 19 FE 00 30 FE 00 4F FE 00 51 FE 00 51 FE 00' + '54 FE 00 54 FE 00 56 FE 00 5E FE 00 60 FE 00 61 FE 00 64 FE 00 66 FE 00 68 FE 00 68 FE 00 6B FE' + '00 6B FE 00 01 FF 00 02 FF 00 06 FF 00 0A FF 00 1B FF 00 20 FF 00 3B FF 00 40 FF 00 5B FF 00 65' + 'FF 00 E2 FF 00 E4 FF 00 E8 FF 00 EE FF 00 F9 FF 00 FD FF 00 01 01 01 01 01 01 40 01 01 8C 01 01' + '90 01 01 9C 01 01 A0 01 01 A0 01 01 1F 09 01 1F 09 01 39 0B 01 3F 0B 01 52 10 01 65 10 01 60 16' + '01 6C 16 01 D5 1F 01 DC 1F 01 E1 1F 01 F1 1F 01 E2 6F 01 E2 6F 01 00 D2 01 41 D2 01 45 D2 01 45' + 'D2 01 00 D3 01 56 D3 01 DB D6 01 DB D6 01 15 D7 01 15 D7 01 4F D7 01 4F D7 01 89 D7 01 89 D7 01' + 'C3 D7 01 C3 D7 01 F0 EE 01 F1 EE 01 00 F0 01 2B F0 01 30 F0 01 93 F0 01 A0 F0 01 AE F0 01 B1 F0' + '01 BF F0 01 C1 F0 01 CF F0 01 D1 F0 01 F5 F0 01 0B F1 01 0F F1 01 2F F1 01 2F F1 01 6A F1 01 6F' + 'F1 01 AD F1 01 AD F1 01 60 F2 01 65 F2 01 00 F3 01 D7 F6 01 E0 F6 01 EC F6 01 F0 F6 01 FC F6 01' + '00 F7 01 73 F7 01 80 F7 01 D8 F7 01 E0 F7 01 EB F7 01 00 F8 01 0B F8 01 10 F8 01 47 F8 01 50 F8' + '01 59 F8 01 60 F8 01 87 F8 01 90 F8 01 AD F8 01 B0 F8 01 B1 F8 01 00 F9 01 78 F9 01 7A F9 01 CB' + 'F9 01 CD F9 01 53 FA 01 60 FA 01 6D FA 01 70 FA 01 74 FA 01 78 FA 01 7A FA 01 80 FA 01 86 FA 01' + '90 FA 01 A8 FA 01 B0 FA 01 B6 FA 01 C0 FA 01 C2 FA 01 D0 FA 01 D6 FA 01 00 FB 01 92 FB 01 94 FB' + '01 CA FB 01 2F 01 00 00 00 66 20 00 66 20 00 30 01 00 00 00 67 20 00 67 20 00 31 01 00 00 00 68' + '20 00 68 20 00 32 01 00 00 00 69 20 00 69 20 00 33 87 01 00 00 A0 00 00 A0 00 00 A8 00 00 A8 00' + '00 AA 00 00 AA 00 00 AF 00 00 AF 00 00 B2 00 00 B5 00 00 B8 00 00 BA 00 00 BC 00 00 BE 00 00 C0' + '00 00 C5 00 00 C7 00 00 CF 00 00 D1 00 00 D6 00 00 D9 00 00 DD 00 00 E0 00 00 E5 00 00 E7 00 00' + 'EF 00 00 F1 00 00 F6 00 00 F9 00 00 FD 00 00 FF 00 00 0F 01 00 12 01 00 25 01 00 28 01 00 30 01' + '00 32 01 00 37 01 00 39 01 00 40 01 00 43 01 00 49 01 00 4C 01 00 51 01 00 54 01 00 65 01 00 68' + '01 00 7F 01 00 A0 01 00 A1 01 00 AF 01 00 B0 01 00 C4 01 00 DC 01 00 DE 01 00 E3 01 00 E6 01 00' + 'F5 01 00 F8 01 00 1B 02 00 1E 02 00 1F 02 00 26 02 00 33 02 00 B0 02 00 B8 02 00 D8 02 00 DD 02' + '00 E0 02 00 E4 02 00 40 03 00 41 03 00 43 03 00 44 03 00 74 03 00 74 03 00 7A 03 00 7A 03 00 7E' + '03 00 7E 03 00 84 03 00 8A 03 00 8C 03 00 8C 03 00 8E 03 00 90 03 00 AA 03 00 B0 03 00 CA 03 00' + 'CE 03 00 D0 03 00 D6 03 00 F0 03 00 F2 03 00 F4 03 00 F5 03 00 F9 03 00 F9 03 00 00 04 00 01 04' + '00 03 04 00 03 04 00 07 04 00 07 04 00 0C 04 00 0E 04 00 19 04 00 19 04 00 39 04 00 39 04 00 50' + '04 00 51 04 00 53 04 00 53 04 00 57 04 00 57 04 00 5C 04 00 5E 04 00 76 04 00 77 04 00 C1 04 00' + 'C2 04 00 D0 04 00 D3 04 00 D6 04 00 D7 04 00 DA 04 00 DF 04 00 E2 04 00 E7 04 00 EA 04 00 F5 04' + '00 F8 04 00 F9 04 00 87 05 00 87 05 00 22 06 00 26 06 00 75 06 00 78 06 00 C0 06 00 C0 06 00 C2' + '06 00 C2 06 00 D3 06 00 D3 06 00 29 09 00 29 09 00 31 09 00 31 09 00 34 09 00 34 09 00 58 09 00' + '5F 09 00 CB 09 00 CC 09 00 DC 09 00 DD 09 00 DF 09 00 DF 09 00 33 0A 00 33 0A 00 36 0A 00 36 0A' + '00 59 0A 00 5B 0A 00 5E 0A 00 5E 0A 00 48 0B 00 48 0B 00 4B 0B 00 4C 0B 00 5C 0B 00 5D 0B 00 94' + '0B 00 94 0B 00 CA 0B 00 CC 0B 00 48 0C 00 48 0C 00 C0 0C 00 C0 0C 00 C7 0C 00 C8 0C 00 CA 0C 00' + 'CB 0C 00 4A 0D 00 4C 0D 00 DA 0D 00 DA 0D 00 DC 0D 00 DE 0D 00 33 0E 00 33 0E 00 B3 0E 00 B3 0E' + '00 DC 0E 00 DD 0E 00 0C 0F 00 0C 0F 00 43 0F 00 43 0F 00 4D 0F 00 4D 0F 00 52 0F 00 52 0F 00 57' + '0F 00 57 0F 00 5C 0F 00 5C 0F 00 69 0F 00 69 0F 00 73 0F 00 73 0F 00 75 0F 00 79 0F 00 81 0F 00' + '81 0F 00 93 0F 00 93 0F 00 9D 0F 00 9D 0F 00 A2 0F 00 A2 0F 00 A7 0F 00 A7 0F 00 AC 0F 00 AC 0F' + '00 B9 0F 00 B9 0F 00 26 10 00 26 10 00 FC 10 00 FC 10 00 06 1B 00 06 1B 00 08 1B 00 08 1B 00 0A' + '1B 00 0A 1B 00 0C 1B 00 0C 1B 00 0E 1B 00 0E 1B 00 12 1B 00 12 1B 00 3B 1B 00 3B 1B 00 3D 1B 00' + '3D 1B 00 40 1B 00 41 1B 00 43 1B 00 43 1B 00 2C 1D 00 2E 1D 00 30 1D 00 3A 1D 00 3C 1D 00 4D 1D' + '00 4F 1D 00 6A 1D 00 78 1D 00 78 1D 00 9B 1D 00 BF 1D 00 00 1E 00 9B 1E 00 A0 1E 00 F9 1E 00 00' + '1F 00 15 1F 00 18 1F 00 1D 1F 00 20 1F 00 45 1F 00 48 1F 00 4D 1F 00 50 1F 00 57 1F 00 59 1F 00' + '59 1F 00 5B 1F 00 5B 1F 00 5D 1F 00 5D 1F 00 5F 1F 00 7D 1F 00 80 1F 00 B4 1F 00 B6 1F 00 C4 1F' + '00 C6 1F 00 D3 1F 00 D6 1F 00 DB 1F 00 DD 1F 00 EF 1F 00 F2 1F 00 F4 1F 00 F6 1F 00 FE 1F 00 00' + '20 00 0A 20 00 11 20 00 11 20 00 17 20 00 17 20 00 24 20 00 26 20 00 2F 20 00 2F 20 00 33 20 00' + '34 20 00 36 20 00 37 20 00 3C 20 00 3C 20 00 3E 20 00 3E 20 00 47 20 00 49 20 00 57 20 00 57 20' + '00 5F 20 00 5F 20 00 70 20 00 71 20 00 74 20 00 8E 20 00 90 20 00 9C 20 00 A8 20 00 A8 20 00 00' + '21 00 03 21 00 05 21 00 07 21 00 09 21 00 13 21 00 15 21 00 16 21 00 19 21 00 1D 21 00 20 21 00' + '22 21 00 24 21 00 24 21 00 26 21 00 26 21 00 28 21 00 28 21 00 2A 21 00 2D 21 00 2F 21 00 31 21' + '00 33 21 00 39 21 00 3B 21 00 40 21 00 45 21 00 49 21 00 50 21 00 7F 21 00 89 21 00 89 21 00 9A' + '21 00 9B 21 00 AE 21 00 AE 21 00 CD 21 00 CF 21 00 04 22 00 04 22 00 09 22 00 09 22 00 0C 22 00' + '0C 22 00 24 22 00 24 22 00 26 22 00 26 22 00 2C 22 00 2D 22 00 2F 22 00 30 22 00 41 22 00 41 22' + '00 44 22 00 44 22 00 47 22 00 47 22 00 49 22 00 49 22 00 60 22 00 60 22 00 62 22 00 62 22 00 6D' + '22 00 71 22 00 74 22 00 75 22 00 78 22 00 79 22 00 80 22 00 81 22 00 84 22 00 85 22 00 88 22 00' + '89 22 00 AC 22 00 AF 22 00 E0 22 00 E3 22 00 EA 22 00 ED 22 00 29 23 00 2A 23 00 60 24 00 EA 24' + '00 0C 2A 00 0C 2A 00 74 2A 00 76 2A 00 DC 2A 00 DC 2A 00 7C 2C 00 7D 2C 00 6F 2D 00 6F 2D 00 9F' + '2E 00 9F 2E 00 F3 2E 00 F3 2E 00 00 2F 00 D5 2F 00 00 30 00 00 30 00 36 30 00 36 30 00 38 30 00' + '3A 30 00 4C 30 00 4C 30 00 4E 30 00 4E 30 00 50 30 00 50 30 00 52 30 00 52 30 00 54 30 00 54 30' + '00 56 30 00 56 30 00 58 30 00 58 30 00 5A 30 00 5A 30 00 5C 30 00 5C 30 00 5E 30 00 5E 30 00 60' + '30 00 60 30 00 62 30 00 62 30 00 65 30 00 65 30 00 67 30 00 67 30 00 69 30 00 69 30 00 70 30 00' + '71 30 00 73 30 00 74 30 00 76 30 00 77 30 00 79 30 00 7A 30 00 7C 30 00 7D 30 00 94 30 00 94 30' + '00 9B 30 00 9C 30 00 9E 30 00 9F 30 00 AC 30 00 AC 30 00 AE 30 00 AE 30 00 B0 30 00 B0 30 00 B2' + '30 00 B2 30 00 B4 30 00 B4 30 00 B6 30 00 B6 30 00 B8 30 00 B8 30 00 BA 30 00 BA 30 00 BC 30 00' + 'BC 30 00 BE 30 00 BE 30 00 C0 30 00 C0 30 00 C2 30 00 C2 30 00 C5 30 00 C5 30 00 C7 30 00 C7 30' + '00 C9 30 00 C9 30 00 D0 30 00 D1 30 00 D3 30 00 D4 30 00 D6 30 00 D7 30 00 D9 30 00 DA 30 00 DC' + '30 00 DD 30 00 F4 30 00 F4 30 00 F7 30 00 FA 30 00 FE 30 00 FF 30 00 31 31 00 8E 31 00 92 31 00' + '9F 31 00 00 32 00 1E 32 00 20 32 00 47 32 00 50 32 00 7E 32 00 80 32 00 FF 33 00 9C A6 00 9D A6' + '00 70 A7 00 70 A7 00 F8 A7 00 F9 A7 00 5C AB 00 5F AB 00 69 AB 00 69 AB 00 00 F9 00 0D FA 00 10' + 'FA 00 10 FA 00 12 FA 00 12 FA 00 15 FA 00 1E FA 00 20 FA 00 20 FA 00 22 FA 00 22 FA 00 25 FA 00' + '26 FA 00 2A FA 00 6D FA 00 70 FA 00 D9 FA 00 00 FB 00 06 FB 00 13 FB 00 17 FB 00 1D FB 00 1D FB' + '00 1F FB 00 36 FB 00 38 FB 00 3C FB 00 3E FB 00 3E FB 00 40 FB 00 41 FB 00 43 FB 00 44 FB 00 46' + 'FB 00 B1 FB 00 D3 FB 00 3D FD 00 50 FD 00 8F FD 00 92 FD 00 C7 FD 00 F0 FD 00 FC FD 00 10 FE 00' + '19 FE 00 30 FE 00 44 FE 00 47 FE 00 52 FE 00 54 FE 00 66 FE 00 68 FE 00 6B FE 00 70 FE 00 72 FE' + '00 74 FE 00 74 FE 00 76 FE 00 FC FE 00 01 FF 00 BE FF 00 C2 FF 00 C7 FF 00 CA FF 00 CF FF 00 D2' + 'FF 00 D7 FF 00 DA FF 00 DC FF 00 E0 FF 00 E6 FF 00 E8 FF 00 EE FF 00 9A 10 01 9A 10 01 9C 10 01' + '9C 10 01 AB 10 01 AB 10 01 2E 11 01 2F 11 01 4B 13 01 4C 13 01 BB 14 01 BC 14 01 BE 14 01 BE 14' + '01 BA 15 01 BB 15 01 38 19 01 38 19 01 5E D1 01 64 D1 01 BB D1 01 C0 D1 01 00 D4 01 54 D4 01 56' + 'D4 01 9C D4 01 9E D4 01 9F D4 01 A2 D4 01 A2 D4 01 A5 D4 01 A6 D4 01 A9 D4 01 AC D4 01 AE D4 01' + 'B9 D4 01 BB D4 01 BB D4 01 BD D4 01 C3 D4 01 C5 D4 01 05 D5 01 07 D5 01 0A D5 01 0D D5 01 14 D5' + '01 16 D5 01 1C D5 01 1E D5 01 39 D5 01 3B D5 01 3E D5 01 40 D5 01 44 D5 01 46 D5 01 46 D5 01 4A' + 'D5 01 50 D5 01 52 D5 01 A5 D6 01 A8 D6 01 CB D7 01 CE D7 01 FF D7 01 00 EE 01 03 EE 01 05 EE 01' + '1F EE 01 21 EE 01 22 EE 01 24 EE 01 24 EE 01 27 EE 01 27 EE 01 29 EE 01 32 EE 01 34 EE 01 37 EE' + '01 39 EE 01 39 EE 01 3B EE 01 3B EE 01 42 EE 01 42 EE 01 47 EE 01 47 EE 01 49 EE 01 49 EE 01 4B' + 'EE 01 4B EE 01 4D EE 01 4F EE 01 51 EE 01 52 EE 01 54 EE 01 54 EE 01 57 EE 01 57 EE 01 59 EE 01' + '59 EE 01 5B EE 01 5B EE 01 5D EE 01 5D EE 01 5F EE 01 5F EE 01 61 EE 01 62 EE 01 64 EE 01 64 EE' + '01 67 EE 01 6A EE 01 6C EE 01 72 EE 01 74 EE 01 77 EE 01 79 EE 01 7C EE 01 7E EE 01 7E EE 01 80' + 'EE 01 89 EE 01 8B EE 01 9B EE 01 A1 EE 01 A3 EE 01 A5 EE 01 A9 EE 01 AB EE 01 BB EE 01 00 F1 01' + '0A F1 01 10 F1 01 2E F1 01 30 F1 01 4F F1 01 6A F1 01 6C F1 01 90 F1 01 90 F1 01 00 F2 01 02 F2' + '01 10 F2 01 3B F2 01 40 F2 01 48 F2 01 50 F2 01 51 F2 01 F0 FB 01 F9 FB 01 00 F8 02 1D FA 02 34' + '05 00 00 00 A0 00 00 A0 00 00 0C 0F 00 0C 0F 00 07 20 00 07 20 00 11 20 00 11 20 00 2F 20 00 2F' + '20 00 35 27 01 00 00 28 00 00 29 00 00 5B 00 00 5B 00 00 5D 00 00 5D 00 00 7B 00 00 7B 00 00 7D' + '00 00 7D 00 00 AB 00 00 AB 00 00 BB 00 00 BB 00 00 BE 02 00 BF 02 00 C2 02 00 C3 02 00 D2 02 00' + 'D3 02 00 F1 02 00 F2 02 00 18 03 00 19 03 00 1C 03 00 1C 03 00 39 03 00 39 03 00 50 03 00 51 03' + '00 54 03 00 55 03 00 57 03 00 58 03 00 8D 05 00 8E 05 00 06 07 00 07 07 00 F7 08 00 FA 08 00 D5' + '0F 00 D8 0F 00 F6 1D 00 F8 1D 00 FE 1D 00 FE 1D 00 0E 20 00 0F 20 00 18 20 00 19 20 00 1C 20 00' + '1D 20 00 2A 20 00 2B 20 00 2D 20 00 2E 20 00 39 20 00 3A 20 00 45 20 00 46 20 00 4C 20 00 4D 20' + '00 66 20 00 67 20 00 7D 20 00 7E 20 00 8D 20 00 8E 20 00 D0 20 00 D1 20 00 D6 20 00 D7 20 00 EC' + '20 00 EF 20 00 90 21 00 90 21 00 92 21 00 92 21 00 9A 21 00 9E 21 00 A0 21 00 A0 21 00 A2 21 00' + 'A4 21 00 A6 21 00 A6 21 00 A9 21 00 AC 21 00 B0 21 00 B3 21 00 BC 21 00 C4 21 00 C6 21 00 C7 21' + '00 C9 21 00 C9 21 00 CB 21 00 CD 21 00 CF 21 00 D0 21 00 D2 21 00 D2 21 00 DA 21 00 DD 21 00 E0' + '21 00 E0 21 00 E2 21 00 E2 21 00 E4 21 00 E6 21 00 E8 21 00 E8 21 00 F4 21 00 F4 21 00 F6 21 00' + 'F8 21 00 FA 21 00 FB 21 00 FD 21 00 FE 21 00 A2 22 00 A3 22 00 AB 22 00 AB 22 00 C9 22 00 CC 22' + '00 08 23 00 0F 23 00 1C 23 00 1F 23 00 26 23 00 26 23 00 29 23 00 2B 23 00 45 23 00 48 23 00 9B' + '23 00 A9 23 00 AB 23 00 AD 23 00 B0 23 00 B1 23 00 B8 23 00 B9 23 00 BE 23 00 BF 23 00 CB 23 00' + 'CC 23 00 E9 23 00 EA 23 00 ED 23 00 EE 23 00 F4 23 00 F5 23 00 0C 25 00 2B 25 00 2D 25 00 2E 25' + '00 31 25 00 32 25 00 35 25 00 36 25 00 39 25 00 3A 25 00 3D 25 00 3E 25 00 43 25 00 46 25 00 49' + '25 00 4A 25 00 52 25 00 63 25 00 6D 25 00 72 25 00 74 25 00 74 25 00 76 25 00 76 25 00 78 25 00' + '78 25 00 7A 25 00 7A 25 00 89 25 00 90 25 00 95 25 00 98 25 00 9A 25 00 9A 25 00 9D 25 00 9E 25' + '00 A7 25 00 A8 25 00 B6 25 00 BB 25 00 C0 25 00 C5 25 00 D0 25 00 D1 25 00 D6 25 00 D7 25 00 DC' + '25 00 DF 25 00 E2 25 00 E5 25 00 E7 25 00 EA 25 00 ED 25 00 EE 25 00 F0 25 00 FA 25 00 FF 25 00' + 'FF 25 00 1A 26 00 1C 26 00 1E 26 00 1E 26 00 9E 26 00 9F 26 00 E5 26 00 E6 26 00 0E 27 00 0E 27' + '00 68 27 00 75 27 00 C5 27 00 C6 27 00 D5 27 00 D6 27 00 DD 27 00 DE 27 00 E2 27 00 EF 27 00 F4' + '27 00 F6 27 00 F8 27 00 F9 27 00 FB 27 00 FF 27 00 00 29 00 03 29 00 05 29 00 07 29 00 0C 29 00' + '11 29 00 14 29 00 20 29 00 33 29 00 33 29 00 36 29 00 37 29 00 42 29 00 43 29 00 45 29 00 47 29' + '00 4C 29 00 4D 29 00 4F 29 00 4F 29 00 51 29 00 62 29 00 64 29 00 64 29 00 66 29 00 6D 29 00 71' + '29 00 75 29 00 7C 29 00 7D 29 00 83 29 00 92 29 00 97 29 00 98 29 00 A8 29 00 AF 29 00 B3 29 00' + 'B4 29 00 D1 29 00 D2 29 00 D4 29 00 D5 29 00 D8 29 00 DB 29 00 E8 29 00 E9 29 00 FC 29 00 FD 29' + '00 2D 2A 00 2E 2A 00 34 2A 00 35 2A 00 CD 2A 00 CE 2A 00 E5 2A 00 E5 2A 00 05 2B 00 05 2B 00 0E' + '2B 00 11 2B 00 14 2B 00 17 2B 00 30 2B 00 42 2B 00 45 2B 00 4C 2B 00 60 2B 00 60 2B 00 62 2B 00' + '62 2B 00 6A 2B 00 6A 2B 00 6C 2B 00 6C 2B 00 70 2B 00 70 2B 00 72 2B 00 72 2B 00 7A 2B 00 7A 2B' + '00 7C 2B 00 7C 2B 00 80 2B 00 80 2B 00 82 2B 00 82 2B 00 84 2B 00 84 2B 00 86 2B 00 86 2B 00 88' + '2B 00 88 2B 00 8A 2B 00 8A 2B 00 8C 2B 00 8C 2B 00 8E 2B 00 8E 2B 00 90 2B 00 93 2B 00 95 2B 00' + '95 2B 00 98 2B 00 98 2B 00 9A 2B 00 9A 2B 00 9C 2B 00 9C 2B 00 9E 2B 00 9E 2B 00 A0 2B 00 B7 2B' + '00 C7 2B 00 C8 2B 00 E8 2B 00 EC 2B 00 EE 2B 00 EE 2B 00 02 2E 00 05 2E 00 09 2E 00 0A 2E 00 0C' + '2E 00 0D 2E 00 1C 2E 00 1D 2E 00 20 2E 00 29 2E 00 36 2E 00 37 2E 00 50 2E 00 51 2E 00 F8 2F 00' + 'F9 2F 00 08 30 00 11 30 00 14 30 00 1B 30 00 A7 32 00 A8 32 00 C1 A9 00 C2 A9 00 6A AB 00 6B AB' + '00 3E FD 00 3F FD 00 20 FE 00 25 FE 00 27 FE 00 2C FE 00 2E FE 00 2F FE 00 35 FE 00 44 FE 00 47' + 'FE 00 48 FE 00 59 FE 00 5E FE 00 08 FF 00 09 FF 00 3B FF 00 3B FF 00 3D FF 00 3D FF 00 5B FF 00' + '5B FF 00 5D FF 00 5D FF 00 5F FF 00 60 FF 00 62 FF 00 63 FF 00 E9 FF 00 E9 FF 00 EB FF 00 EB FF' + '00 77 08 01 78 08 01 70 BC 01 70 BC 01 72 BC 01 72 BC 01 06 D1 01 07 D1 01 4A D1 01 4D D1 01 48' + 'F4 01 49 F4 01 0D F5 01 0E F5 01 43 F5 01 44 F5 01 7B F5 01 7B F5 01 7D F5 01 7D F5 01 89 F5 01' + '89 F5 01 98 F5 01 9D F5 01 E6 F5 01 E9 F5 01 EC F5 01 EF F5 01 6C F6 01 6C F6 01 6E F6 01 6E F6' + '01 00 F8 01 00 F8 01 02 F8 01 02 F8 01 04 F8 01 04 F8 01 06 F8 01 06 F8 01 08 F8 01 08 F8 01 0A' + 'F8 01 0A F8 01 10 F8 01 10 F8 01 12 F8 01 12 F8 01 14 F8 01 14 F8 01 16 F8 01 16 F8 01 18 F8 01' + '18 F8 01 1A F8 01 1A F8 01 1C F8 01 1C F8 01 1E F8 01 1E F8 01 20 F8 01 20 F8 01 22 F8 01 22 F8' + '01 24 F8 01 24 F8 01 26 F8 01 26 F8 01 28 F8 01 28 F8 01 2A F8 01 2A F8 01 2C F8 01 2C F8 01 2E' + 'F8 01 2E F8 01 30 F8 01 30 F8 01 32 F8 01 32 F8 01 34 F8 01 34 F8 01 36 F8 01 36 F8 01 38 F8 01' + '38 F8 01 3A F8 01 3A F8 01 3C F8 01 3C F8 01 3E F8 01 3E F8 01 40 F8 01 40 F8 01 42 F8 01 42 F8' + '01 44 F8 01 44 F8 01 46 F8 01 46 F8 01 50 F8 01 50 F8 01 52 F8 01 52 F8 01 60 F8 01 60 F8 01 62' + 'F8 01 62 F8 01 68 F8 01 68 F8 01 6A F8 01 6A F8 01 70 F8 01 70 F8 01 72 F8 01 72 F8 01 78 F8 01' + '78 F8 01 7A F8 01 7A F8 01 80 F8 01 80 F8 01 82 F8 01 82 F8 01 90 F8 01 90 F8 01 92 F8 01 92 F8' + '01 94 F8 01 94 F8 01 96 F8 01 96 F8 01 98 F8 01 98 F8 01 9A F8 01 9A F8 01 A2 F8 01 AB F8 01 1B' + 'F9 01 1C F9 01 68 FB 01 68 FB 01 6A FB 01 6A FB 01 6C FB 01 6C FB 01 6E FB 01 6E FB 01 7C FB 01' + '7F FB 01 87 FB 01 8D FB 01 98 FB 01 99 FB 01 9C FB 01 A5 FB 01 A8 FB 01 AD FB 01 B2 FB 01 B3 FB' + '01 B5 FB 01 B6 FB 01 B9 FB 01 BA FB 01 C7 FB 01 C8 FB 01 28 00 0E 29 00 0E 5B 00 0E 5B 00 0E 5D' + '00 0E 5D 00 0E 7B 00 0E 7B 00 0E 7D 00 0E 7D 00 0E 36 06 00 00 00 30 00 00 39 00 00 41 00 00 46' + '00 00 61 00 00 66 00 00 10 FF 00 19 FF 00 21 FF 00 26 FF 00 41 FF 00 46 FF 00 37 0D 00 00 00 22' + '00 00 22 00 00 27 00 00 27 00 00 AB 00 00 AB 00 00 BB 00 00 BB 00 00 18 20 00 1F 20 00 39 20 00' + '3A 20 00 42 2E 00 42 2E 00 0C 30 00 0F 30 00 1D 30 00 1F 30 00 41 FE 00 44 FE 00 02 FF 00 02 FF' + '00 07 FF 00 07 FF 00 62 FF 00 63 FF 00 38 71 00 00 00 28 00 00 29 00 00 3C 00 00 3C 00 00 3E 00' + '00 3E 00 00 5B 00 00 5B 00 00 5D 00 00 5D 00 00 7B 00 00 7B 00 00 7D 00 00 7D 00 00 AB 00 00 AB' + '00 00 BB 00 00 BB 00 00 3A 0F 00 3D 0F 00 9B 16 00 9C 16 00 39 20 00 3A 20 00 45 20 00 46 20 00' + '7D 20 00 7E 20 00 8D 20 00 8E 20 00 40 21 00 40 21 00 01 22 00 04 22 00 08 22 00 0D 22 00 11 22' + '00 11 22 00 15 22 00 16 22 00 1A 22 00 1D 22 00 1F 22 00 22 22 00 24 22 00 24 22 00 26 22 00 26' + '22 00 2B 22 00 33 22 00 39 22 00 39 22 00 3B 22 00 4C 22 00 52 22 00 55 22 00 5F 22 00 60 22 00' + '62 22 00 62 22 00 64 22 00 6B 22 00 6E 22 00 8C 22 00 8F 22 00 92 22 00 98 22 00 98 22 00 A2 22' + '00 A3 22 00 A6 22 00 B8 22 00 BE 22 00 BF 22 00 C9 22 00 CD 22 00 D0 22 00 D1 22 00 D6 22 00 ED' + '22 00 F0 22 00 FF 22 00 08 23 00 0B 23 00 20 23 00 21 23 00 29 23 00 2A 23 00 68 27 00 75 27 00' + 'C0 27 00 C0 27 00 C3 27 00 C6 27 00 C8 27 00 C9 27 00 CB 27 00 CD 27 00 D3 27 00 D6 27 00 DC 27' + '00 DE 27 00 E2 27 00 EF 27 00 83 29 00 98 29 00 9B 29 00 A0 29 00 A2 29 00 AF 29 00 B8 29 00 B8' + '29 00 C0 29 00 C5 29 00 C9 29 00 C9 29 00 CE 29 00 D2 29 00 D4 29 00 D5 29 00 D8 29 00 DC 29 00' + 'E1 29 00 E1 29 00 E3 29 00 E5 29 00 E8 29 00 E9 29 00 F4 29 00 F9 29 00 FC 29 00 FD 29 00 0A 2A' + '00 1C 2A 00 1E 2A 00 21 2A 00 24 2A 00 24 2A 00 26 2A 00 26 2A 00 29 2A 00 29 2A 00 2B 2A 00 2E' + '2A 00 34 2A 00 35 2A 00 3C 2A 00 3E 2A 00 57 2A 00 58 2A 00 64 2A 00 65 2A 00 6A 2A 00 6D 2A 00' + '6F 2A 00 70 2A 00 73 2A 00 74 2A 00 79 2A 00 A3 2A 00 A6 2A 00 AD 2A 00 AF 2A 00 D6 2A 00 DC 2A' + '00 DC 2A 00 DE 2A 00 DE 2A 00 E2 2A 00 E6 2A 00 EC 2A 00 EE 2A 00 F3 2A 00 F3 2A 00 F7 2A 00 FB' + '2A 00 FD 2A 00 FD 2A 00 FE 2B 00 FE 2B 00 02 2E 00 05 2E 00 09 2E 00 0A 2E 00 0C 2E 00 0D 2E 00' + '1C 2E 00 1D 2E 00 20 2E 00 29 2E 00 08 30 00 11 30 00 14 30 00 1B 30 00 59 FE 00 5E FE 00 64 FE' + '00 65 FE 00 08 FF 00 09 FF 00 1C FF 00 1C FF 00 1E FF 00 1E FF 00 3B FF 00 3B FF 00 3D FF 00 3D' + 'FF 00 5B FF 00 5B FF 00 5D FF 00 5D FF 00 5F FF 00 60 FF 00 62 FF 00 63 FF 00 DB D6 01 DB D6 01' + '15 D7 01 15 D7 01 4F D7 01 4F D7 01 89 D7 01 89 D7 01 C3 D7 01 C3 D7 01 39 A5 02 00 00 00 00 00' + '77 03 00 7A 03 00 7F 03 00 84 03 00 8A 03 00 8C 03 00 8C 03 00 8E 03 00 A1 03 00 A3 03 00 2F 05' + '00 31 05 00 56 05 00 59 05 00 8A 05 00 8D 05 00 8F 05 00 91 05 00 C7 05 00 D0 05 00 EA 05 00 EF' + '05 00 F4 05 00 00 06 00 1C 06 00 1E 06 00 0D 07 00 0F 07 00 4A 07 00 4D 07 00 B1 07 00 C0 07 00' + 'FA 07 00 FD 07 00 2D 08 00 30 08 00 3E 08 00 40 08 00 5B 08 00 5E 08 00 5E 08 00 60 08 00 6A 08' + '00 A0 08 00 B4 08 00 B6 08 00 C7 08 00 D3 08 00 83 09 00 85 09 00 8C 09 00 8F 09 00 90 09 00 93' + '09 00 A8 09 00 AA 09 00 B0 09 00 B2 09 00 B2 09 00 B6 09 00 B9 09 00 BC 09 00 C4 09 00 C7 09 00' + 'C8 09 00 CB 09 00 CE 09 00 D7 09 00 D7 09 00 DC 09 00 DD 09 00 DF 09 00 E3 09 00 E6 09 00 FE 09' + '00 01 0A 00 03 0A 00 05 0A 00 0A 0A 00 0F 0A 00 10 0A 00 13 0A 00 28 0A 00 2A 0A 00 30 0A 00 32' + '0A 00 33 0A 00 35 0A 00 36 0A 00 38 0A 00 39 0A 00 3C 0A 00 3C 0A 00 3E 0A 00 42 0A 00 47 0A 00' + '48 0A 00 4B 0A 00 4D 0A 00 51 0A 00 51 0A 00 59 0A 00 5C 0A 00 5E 0A 00 5E 0A 00 66 0A 00 76 0A' + '00 81 0A 00 83 0A 00 85 0A 00 8D 0A 00 8F 0A 00 91 0A 00 93 0A 00 A8 0A 00 AA 0A 00 B0 0A 00 B2' + '0A 00 B3 0A 00 B5 0A 00 B9 0A 00 BC 0A 00 C5 0A 00 C7 0A 00 C9 0A 00 CB 0A 00 CD 0A 00 D0 0A 00' + 'D0 0A 00 E0 0A 00 E3 0A 00 E6 0A 00 F1 0A 00 F9 0A 00 FF 0A 00 01 0B 00 03 0B 00 05 0B 00 0C 0B' + '00 0F 0B 00 10 0B 00 13 0B 00 28 0B 00 2A 0B 00 30 0B 00 32 0B 00 33 0B 00 35 0B 00 39 0B 00 3C' + '0B 00 44 0B 00 47 0B 00 48 0B 00 4B 0B 00 4D 0B 00 55 0B 00 57 0B 00 5C 0B 00 5D 0B 00 5F 0B 00' + '63 0B 00 66 0B 00 77 0B 00 82 0B 00 83 0B 00 85 0B 00 8A 0B 00 8E 0B 00 90 0B 00 92 0B 00 95 0B' + '00 99 0B 00 9A 0B 00 9C 0B 00 9C 0B 00 9E 0B 00 9F 0B 00 A3 0B 00 A4 0B 00 A8 0B 00 AA 0B 00 AE' + '0B 00 B9 0B 00 BE 0B 00 C2 0B 00 C6 0B 00 C8 0B 00 CA 0B 00 CD 0B 00 D0 0B 00 D0 0B 00 D7 0B 00' + 'D7 0B 00 E6 0B 00 FA 0B 00 00 0C 00 0C 0C 00 0E 0C 00 10 0C 00 12 0C 00 28 0C 00 2A 0C 00 39 0C' + '00 3D 0C 00 44 0C 00 46 0C 00 48 0C 00 4A 0C 00 4D 0C 00 55 0C 00 56 0C 00 58 0C 00 5A 0C 00 60' + '0C 00 63 0C 00 66 0C 00 6F 0C 00 77 0C 00 8C 0C 00 8E 0C 00 90 0C 00 92 0C 00 A8 0C 00 AA 0C 00' + 'B3 0C 00 B5 0C 00 B9 0C 00 BC 0C 00 C4 0C 00 C6 0C 00 C8 0C 00 CA 0C 00 CD 0C 00 D5 0C 00 D6 0C' + '00 DE 0C 00 DE 0C 00 E0 0C 00 E3 0C 00 E6 0C 00 EF 0C 00 F1 0C 00 F2 0C 00 00 0D 00 0C 0D 00 0E' + '0D 00 10 0D 00 12 0D 00 44 0D 00 46 0D 00 48 0D 00 4A 0D 00 4F 0D 00 54 0D 00 63 0D 00 66 0D 00' + '7F 0D 00 81 0D 00 83 0D 00 85 0D 00 96 0D 00 9A 0D 00 B1 0D 00 B3 0D 00 BB 0D 00 BD 0D 00 BD 0D' + '00 C0 0D 00 C6 0D 00 CA 0D 00 CA 0D 00 CF 0D 00 D4 0D 00 D6 0D 00 D6 0D 00 D8 0D 00 DF 0D 00 E6' + '0D 00 EF 0D 00 F2 0D 00 F4 0D 00 01 0E 00 3A 0E 00 3F 0E 00 5B 0E 00 81 0E 00 82 0E 00 84 0E 00' + '84 0E 00 86 0E 00 8A 0E 00 8C 0E 00 A3 0E 00 A5 0E 00 A5 0E 00 A7 0E 00 BD 0E 00 C0 0E 00 C4 0E' + '00 C6 0E 00 C6 0E 00 C8 0E 00 CD 0E 00 D0 0E 00 D9 0E 00 DC 0E 00 DF 0E 00 00 0F 00 47 0F 00 49' + '0F 00 6C 0F 00 71 0F 00 97 0F 00 99 0F 00 BC 0F 00 BE 0F 00 CC 0F 00 CE 0F 00 DA 0F 00 00 10 00' + 'C5 10 00 C7 10 00 C7 10 00 CD 10 00 CD 10 00 D0 10 00 48 12 00 4A 12 00 4D 12 00 50 12 00 56 12' + '00 58 12 00 58 12 00 5A 12 00 5D 12 00 60 12 00 88 12 00 8A 12 00 8D 12 00 90 12 00 B0 12 00 B2' + '12 00 B5 12 00 B8 12 00 BE 12 00 C0 12 00 C0 12 00 C2 12 00 C5 12 00 C8 12 00 D6 12 00 D8 12 00' + '10 13 00 12 13 00 15 13 00 18 13 00 5A 13 00 5D 13 00 7C 13 00 80 13 00 99 13 00 A0 13 00 F5 13' + '00 F8 13 00 FD 13 00 00 14 00 9C 16 00 A0 16 00 F8 16 00 00 17 00 0C 17 00 0E 17 00 14 17 00 20' + '17 00 36 17 00 40 17 00 53 17 00 60 17 00 6C 17 00 6E 17 00 70 17 00 72 17 00 73 17 00 80 17 00' + 'DD 17 00 E0 17 00 E9 17 00 F0 17 00 F9 17 00 00 18 00 0E 18 00 10 18 00 19 18 00 20 18 00 78 18' + '00 80 18 00 AA 18 00 B0 18 00 F5 18 00 00 19 00 1E 19 00 20 19 00 2B 19 00 30 19 00 3B 19 00 40' + '19 00 40 19 00 44 19 00 6D 19 00 70 19 00 74 19 00 80 19 00 AB 19 00 B0 19 00 C9 19 00 D0 19 00' + 'DA 19 00 DE 19 00 1B 1A 00 1E 1A 00 5E 1A 00 60 1A 00 7C 1A 00 7F 1A 00 89 1A 00 90 1A 00 99 1A' + '00 A0 1A 00 AD 1A 00 B0 1A 00 C0 1A 00 00 1B 00 4B 1B 00 50 1B 00 7C 1B 00 80 1B 00 F3 1B 00 FC' + '1B 00 37 1C 00 3B 1C 00 49 1C 00 4D 1C 00 88 1C 00 90 1C 00 BA 1C 00 BD 1C 00 C7 1C 00 D0 1C 00' + 'FA 1C 00 00 1D 00 F9 1D 00 FB 1D 00 15 1F 00 18 1F 00 1D 1F 00 20 1F 00 45 1F 00 48 1F 00 4D 1F' + '00 50 1F 00 57 1F 00 59 1F 00 59 1F 00 5B 1F 00 5B 1F 00 5D 1F 00 5D 1F 00 5F 1F 00 7D 1F 00 80' + '1F 00 B4 1F 00 B6 1F 00 C4 1F 00 C6 1F 00 D3 1F 00 D6 1F 00 DB 1F 00 DD 1F 00 EF 1F 00 F2 1F 00' + 'F4 1F 00 F6 1F 00 FE 1F 00 00 20 00 64 20 00 66 20 00 71 20 00 74 20 00 8E 20 00 90 20 00 9C 20' + '00 A0 20 00 BF 20 00 D0 20 00 F0 20 00 00 21 00 8B 21 00 90 21 00 26 24 00 40 24 00 4A 24 00 60' + '24 00 73 2B 00 76 2B 00 95 2B 00 97 2B 00 2E 2C 00 30 2C 00 5E 2C 00 60 2C 00 F3 2C 00 F9 2C 00' + '25 2D 00 27 2D 00 27 2D 00 2D 2D 00 2D 2D 00 30 2D 00 67 2D 00 6F 2D 00 70 2D 00 7F 2D 00 96 2D' + '00 A0 2D 00 A6 2D 00 A8 2D 00 AE 2D 00 B0 2D 00 B6 2D 00 B8 2D 00 BE 2D 00 C0 2D 00 C6 2D 00 C8' + '2D 00 CE 2D 00 D0 2D 00 D6 2D 00 D8 2D 00 DE 2D 00 E0 2D 00 52 2E 00 80 2E 00 99 2E 00 9B 2E 00' + 'F3 2E 00 00 2F 00 D5 2F 00 F0 2F 00 FB 2F 00 00 30 00 3F 30 00 41 30 00 96 30 00 99 30 00 FF 30' + '00 05 31 00 2F 31 00 31 31 00 8E 31 00 90 31 00 E3 31 00 F0 31 00 1E 32 00 20 32 00 FC 9F 00 00' + 'A0 00 8C A4 00 90 A4 00 C6 A4 00 D0 A4 00 2B A6 00 40 A6 00 F7 A6 00 00 A7 00 BF A7 00 C2 A7 00' + 'CA A7 00 F5 A7 00 2C A8 00 30 A8 00 39 A8 00 40 A8 00 77 A8 00 80 A8 00 C5 A8 00 CE A8 00 D9 A8' + '00 E0 A8 00 53 A9 00 5F A9 00 7C A9 00 80 A9 00 CD A9 00 CF A9 00 D9 A9 00 DE A9 00 FE A9 00 00' + 'AA 00 36 AA 00 40 AA 00 4D AA 00 50 AA 00 59 AA 00 5C AA 00 C2 AA 00 DB AA 00 F6 AA 00 01 AB 00' + '06 AB 00 09 AB 00 0E AB 00 11 AB 00 16 AB 00 20 AB 00 26 AB 00 28 AB 00 2E AB 00 30 AB 00 6B AB' + '00 70 AB 00 ED AB 00 F0 AB 00 F9 AB 00 00 AC 00 A3 D7 00 B0 D7 00 C6 D7 00 CB D7 00 FB D7 00 00' + 'D8 00 6D FA 00 70 FA 00 D9 FA 00 00 FB 00 06 FB 00 13 FB 00 17 FB 00 1D FB 00 36 FB 00 38 FB 00' + '3C FB 00 3E FB 00 3E FB 00 40 FB 00 41 FB 00 43 FB 00 44 FB 00 46 FB 00 C1 FB 00 D3 FB 00 3F FD' + '00 50 FD 00 8F FD 00 92 FD 00 C7 FD 00 F0 FD 00 FD FD 00 00 FE 00 19 FE 00 20 FE 00 52 FE 00 54' + 'FE 00 66 FE 00 68 FE 00 6B FE 00 70 FE 00 74 FE 00 76 FE 00 FC FE 00 FF FE 00 FF FE 00 01 FF 00' + 'BE FF 00 C2 FF 00 C7 FF 00 CA FF 00 CF FF 00 D2 FF 00 D7 FF 00 DA FF 00 DC FF 00 E0 FF 00 E6 FF' + '00 E8 FF 00 EE FF 00 F9 FF 00 FD FF 00 00 00 01 0B 00 01 0D 00 01 26 00 01 28 00 01 3A 00 01 3C' + '00 01 3D 00 01 3F 00 01 4D 00 01 50 00 01 5D 00 01 80 00 01 FA 00 01 00 01 01 02 01 01 07 01 01' + '33 01 01 37 01 01 8E 01 01 90 01 01 9C 01 01 A0 01 01 A0 01 01 D0 01 01 FD 01 01 80 02 01 9C 02' + '01 A0 02 01 D0 02 01 E0 02 01 FB 02 01 00 03 01 23 03 01 2D 03 01 4A 03 01 50 03 01 7A 03 01 80' + '03 01 9D 03 01 9F 03 01 C3 03 01 C8 03 01 D5 03 01 00 04 01 9D 04 01 A0 04 01 A9 04 01 B0 04 01' + 'D3 04 01 D8 04 01 FB 04 01 00 05 01 27 05 01 30 05 01 63 05 01 6F 05 01 6F 05 01 00 06 01 36 07' + '01 40 07 01 55 07 01 60 07 01 67 07 01 00 08 01 05 08 01 08 08 01 08 08 01 0A 08 01 35 08 01 37' + '08 01 38 08 01 3C 08 01 3C 08 01 3F 08 01 55 08 01 57 08 01 9E 08 01 A7 08 01 AF 08 01 E0 08 01' + 'F2 08 01 F4 08 01 F5 08 01 FB 08 01 1B 09 01 1F 09 01 39 09 01 3F 09 01 3F 09 01 80 09 01 B7 09' + '01 BC 09 01 CF 09 01 D2 09 01 03 0A 01 05 0A 01 06 0A 01 0C 0A 01 13 0A 01 15 0A 01 17 0A 01 19' + '0A 01 35 0A 01 38 0A 01 3A 0A 01 3F 0A 01 48 0A 01 50 0A 01 58 0A 01 60 0A 01 9F 0A 01 C0 0A 01' + 'E6 0A 01 EB 0A 01 F6 0A 01 00 0B 01 35 0B 01 39 0B 01 55 0B 01 58 0B 01 72 0B 01 78 0B 01 91 0B' + '01 99 0B 01 9C 0B 01 A9 0B 01 AF 0B 01 00 0C 01 48 0C 01 80 0C 01 B2 0C 01 C0 0C 01 F2 0C 01 FA' + '0C 01 27 0D 01 30 0D 01 39 0D 01 60 0E 01 7E 0E 01 80 0E 01 A9 0E 01 AB 0E 01 AD 0E 01 B0 0E 01' + 'B1 0E 01 00 0F 01 27 0F 01 30 0F 01 59 0F 01 B0 0F 01 CB 0F 01 E0 0F 01 F6 0F 01 00 10 01 4D 10' + '01 52 10 01 6F 10 01 7F 10 01 C1 10 01 CD 10 01 CD 10 01 D0 10 01 E8 10 01 F0 10 01 F9 10 01 00' + '11 01 34 11 01 36 11 01 47 11 01 50 11 01 76 11 01 80 11 01 DF 11 01 E1 11 01 F4 11 01 00 12 01' + '11 12 01 13 12 01 3E 12 01 80 12 01 86 12 01 88 12 01 88 12 01 8A 12 01 8D 12 01 8F 12 01 9D 12' + '01 9F 12 01 A9 12 01 B0 12 01 EA 12 01 F0 12 01 F9 12 01 00 13 01 03 13 01 05 13 01 0C 13 01 0F' + '13 01 10 13 01 13 13 01 28 13 01 2A 13 01 30 13 01 32 13 01 33 13 01 35 13 01 39 13 01 3B 13 01' + '44 13 01 47 13 01 48 13 01 4B 13 01 4D 13 01 50 13 01 50 13 01 57 13 01 57 13 01 5D 13 01 63 13' + '01 66 13 01 6C 13 01 70 13 01 74 13 01 00 14 01 5B 14 01 5D 14 01 61 14 01 80 14 01 C7 14 01 D0' + '14 01 D9 14 01 80 15 01 B5 15 01 B8 15 01 DD 15 01 00 16 01 44 16 01 50 16 01 59 16 01 60 16 01' + '6C 16 01 80 16 01 B8 16 01 C0 16 01 C9 16 01 00 17 01 1A 17 01 1D 17 01 2B 17 01 30 17 01 3F 17' + '01 00 18 01 3B 18 01 A0 18 01 F2 18 01 FF 18 01 06 19 01 09 19 01 09 19 01 0C 19 01 13 19 01 15' + '19 01 16 19 01 18 19 01 35 19 01 37 19 01 38 19 01 3B 19 01 46 19 01 50 19 01 59 19 01 A0 19 01' + 'A7 19 01 AA 19 01 D7 19 01 DA 19 01 E4 19 01 00 1A 01 47 1A 01 50 1A 01 A2 1A 01 C0 1A 01 F8 1A' + '01 00 1C 01 08 1C 01 0A 1C 01 36 1C 01 38 1C 01 45 1C 01 50 1C 01 6C 1C 01 70 1C 01 8F 1C 01 92' + '1C 01 A7 1C 01 A9 1C 01 B6 1C 01 00 1D 01 06 1D 01 08 1D 01 09 1D 01 0B 1D 01 36 1D 01 3A 1D 01' + '3A 1D 01 3C 1D 01 3D 1D 01 3F 1D 01 47 1D 01 50 1D 01 59 1D 01 60 1D 01 65 1D 01 67 1D 01 68 1D' + '01 6A 1D 01 8E 1D 01 90 1D 01 91 1D 01 93 1D 01 98 1D 01 A0 1D 01 A9 1D 01 E0 1E 01 F8 1E 01 B0' + '1F 01 B0 1F 01 C0 1F 01 F1 1F 01 FF 1F 01 99 23 01 00 24 01 6E 24 01 70 24 01 74 24 01 80 24 01' + '43 25 01 00 30 01 2E 34 01 30 34 01 38 34 01 00 44 01 46 46 01 00 68 01 38 6A 01 40 6A 01 5E 6A' + '01 60 6A 01 69 6A 01 6E 6A 01 6F 6A 01 D0 6A 01 ED 6A 01 F0 6A 01 F5 6A 01 00 6B 01 45 6B 01 50' + '6B 01 59 6B 01 5B 6B 01 61 6B 01 63 6B 01 77 6B 01 7D 6B 01 8F 6B 01 40 6E 01 9A 6E 01 00 6F 01' + '4A 6F 01 4F 6F 01 87 6F 01 8F 6F 01 9F 6F 01 E0 6F 01 E4 6F 01 F0 6F 01 F1 6F 01 00 70 01 F7 87' + '01 00 88 01 D5 8C 01 00 8D 01 08 8D 01 00 B0 01 1E B1 01 50 B1 01 52 B1 01 64 B1 01 67 B1 01 70' + 'B1 01 FB B2 01 00 BC 01 6A BC 01 70 BC 01 7C BC 01 80 BC 01 88 BC 01 90 BC 01 99 BC 01 9C BC 01' + 'A3 BC 01 00 D0 01 F5 D0 01 00 D1 01 26 D1 01 29 D1 01 E8 D1 01 00 D2 01 45 D2 01 E0 D2 01 F3 D2' + '01 00 D3 01 56 D3 01 60 D3 01 78 D3 01 00 D4 01 54 D4 01 56 D4 01 9C D4 01 9E D4 01 9F D4 01 A2' + 'D4 01 A2 D4 01 A5 D4 01 A6 D4 01 A9 D4 01 AC D4 01 AE D4 01 B9 D4 01 BB D4 01 BB D4 01 BD D4 01' + 'C3 D4 01 C5 D4 01 05 D5 01 07 D5 01 0A D5 01 0D D5 01 14 D5 01 16 D5 01 1C D5 01 1E D5 01 39 D5' + '01 3B D5 01 3E D5 01 40 D5 01 44 D5 01 46 D5 01 46 D5 01 4A D5 01 50 D5 01 52 D5 01 A5 D6 01 A8' + 'D6 01 CB D7 01 CE D7 01 8B DA 01 9B DA 01 9F DA 01 A1 DA 01 AF DA 01 00 E0 01 06 E0 01 08 E0 01' + '18 E0 01 1B E0 01 21 E0 01 23 E0 01 24 E0 01 26 E0 01 2A E0 01 00 E1 01 2C E1 01 30 E1 01 3D E1' + '01 40 E1 01 49 E1 01 4E E1 01 4F E1 01 C0 E2 01 F9 E2 01 FF E2 01 FF E2 01 00 E8 01 C4 E8 01 C7' + 'E8 01 D6 E8 01 00 E9 01 4B E9 01 50 E9 01 59 E9 01 5E E9 01 5F E9 01 71 EC 01 B4 EC 01 01 ED 01' + '3D ED 01 00 EE 01 03 EE 01 05 EE 01 1F EE 01 21 EE 01 22 EE 01 24 EE 01 24 EE 01 27 EE 01 27 EE' + '01 29 EE 01 32 EE 01 34 EE 01 37 EE 01 39 EE 01 39 EE 01 3B EE 01 3B EE 01 42 EE 01 42 EE 01 47' + 'EE 01 47 EE 01 49 EE 01 49 EE 01 4B EE 01 4B EE 01 4D EE 01 4F EE 01 51 EE 01 52 EE 01 54 EE 01' + '54 EE 01 57 EE 01 57 EE 01 59 EE 01 59 EE 01 5B EE 01 5B EE 01 5D EE 01 5D EE 01 5F EE 01 5F EE' + '01 61 EE 01 62 EE 01 64 EE 01 64 EE 01 67 EE 01 6A EE 01 6C EE 01 72 EE 01 74 EE 01 77 EE 01 79' + 'EE 01 7C EE 01 7E EE 01 7E EE 01 80 EE 01 89 EE 01 8B EE 01 9B EE 01 A1 EE 01 A3 EE 01 A5 EE 01' + 'A9 EE 01 AB EE 01 BB EE 01 F0 EE 01 F1 EE 01 00 F0 01 2B F0 01 30 F0 01 93 F0 01 A0 F0 01 AE F0' + '01 B1 F0 01 BF F0 01 C1 F0 01 CF F0 01 D1 F0 01 F5 F0 01 00 F1 01 AD F1 01 E6 F1 01 02 F2 01 10' + 'F2 01 3B F2 01 40 F2 01 48 F2 01 50 F2 01 51 F2 01 60 F2 01 65 F2 01 00 F3 01 D7 F6 01 E0 F6 01' + 'EC F6 01 F0 F6 01 FC F6 01 00 F7 01 73 F7 01 80 F7 01 D8 F7 01 E0 F7 01 EB F7 01 00 F8 01 0B F8' + '01 10 F8 01 47 F8 01 50 F8 01 59 F8 01 60 F8 01 87 F8 01 90 F8 01 AD F8 01 B0 F8 01 B1 F8 01 00' + 'F9 01 78 F9 01 7A F9 01 CB F9 01 CD F9 01 53 FA 01 60 FA 01 6D FA 01 70 FA 01 74 FA 01 78 FA 01' + '7A FA 01 80 FA 01 86 FA 01 90 FA 01 A8 FA 01 B0 FA 01 B6 FA 01 C0 FA 01 C2 FA 01 D0 FA 01 D6 FA' + '01 00 FB 01 92 FB 01 94 FB 01 CA FB 01 F0 FB 01 F9 FB 01 00 00 02 DD A6 02 00 A7 02 34 B7 02 40' + 'B7 02 1D B8 02 20 B8 02 A1 CE 02 B0 CE 02 E0 EB 02 00 F8 02 1D FA 02 00 00 03 4A 13 03 01 00 0E' + '01 00 0E 20 00 0E 7F 00 0E 00 01 0E EF 01 0E 00 00 0F FD FF 0F 00 00 10 FD FF 10 3A 03 00 00 00' + '30 00 00 39 00 00 41 00 00 46 00 00 61 00 00 66 00 00 3B 04 00 00 00 1C 06 00 1C 06 00 0E 20 00' + '0F 20 00 2A 20 00 2E 20 00 66 20 00 69 20 00 3D 08 00 00 00 49 01 00 49 01 00 73 06 00 73 06 00' + '77 0F 00 77 0F 00 79 0F 00 79 0F 00 A3 17 00 A4 17 00 6A 20 00 6F 20 00 29 23 00 2A 23 00 01 00' + '0E 01 00 0E 3E B0 00 00 00 5E 00 00 5E 00 00 60 00 00 60 00 00 A8 00 00 A8 00 00 AF 00 00 AF 00' + '00 B4 00 00 B4 00 00 B7 00 00 B8 00 00 B0 02 00 4E 03 00 50 03 00 57 03 00 5D 03 00 62 03 00 74' + '03 00 75 03 00 7A 03 00 7A 03 00 84 03 00 85 03 00 83 04 00 87 04 00 59 05 00 59 05 00 91 05 00' + 'A1 05 00 A3 05 00 BD 05 00 BF 05 00 BF 05 00 C1 05 00 C2 05 00 C4 05 00 C4 05 00 4B 06 00 52 06' + '00 57 06 00 58 06 00 DF 06 00 E0 06 00 E5 06 00 E6 06 00 EA 06 00 EC 06 00 30 07 00 4A 07 00 A6' + '07 00 B0 07 00 EB 07 00 F5 07 00 18 08 00 19 08 00 E3 08 00 FE 08 00 3C 09 00 3C 09 00 4D 09 00' + '4D 09 00 51 09 00 54 09 00 71 09 00 71 09 00 BC 09 00 BC 09 00 CD 09 00 CD 09 00 3C 0A 00 3C 0A' + '00 4D 0A 00 4D 0A 00 BC 0A 00 BC 0A 00 CD 0A 00 CD 0A 00 FD 0A 00 FF 0A 00 3C 0B 00 3C 0B 00 4D' + '0B 00 4D 0B 00 55 0B 00 55 0B 00 CD 0B 00 CD 0B 00 4D 0C 00 4D 0C 00 BC 0C 00 BC 0C 00 CD 0C 00' + 'CD 0C 00 3B 0D 00 3C 0D 00 4D 0D 00 4D 0D 00 CA 0D 00 CA 0D 00 47 0E 00 4C 0E 00 4E 0E 00 4E 0E' + '00 BA 0E 00 BA 0E 00 C8 0E 00 CC 0E 00 18 0F 00 19 0F 00 35 0F 00 35 0F 00 37 0F 00 37 0F 00 39' + '0F 00 39 0F 00 3E 0F 00 3F 0F 00 82 0F 00 84 0F 00 86 0F 00 87 0F 00 C6 0F 00 C6 0F 00 37 10 00' + '37 10 00 39 10 00 3A 10 00 63 10 00 64 10 00 69 10 00 6D 10 00 87 10 00 8D 10 00 8F 10 00 8F 10' + '00 9A 10 00 9B 10 00 5D 13 00 5F 13 00 C9 17 00 D3 17 00 DD 17 00 DD 17 00 39 19 00 3B 19 00 75' + '1A 00 7C 1A 00 7F 1A 00 7F 1A 00 B0 1A 00 BD 1A 00 34 1B 00 34 1B 00 44 1B 00 44 1B 00 6B 1B 00' + '73 1B 00 AA 1B 00 AB 1B 00 36 1C 00 37 1C 00 78 1C 00 7D 1C 00 D0 1C 00 E8 1C 00 ED 1C 00 ED 1C' + '00 F4 1C 00 F4 1C 00 F7 1C 00 F9 1C 00 2C 1D 00 6A 1D 00 C4 1D 00 CF 1D 00 F5 1D 00 F9 1D 00 FD' + '1D 00 FF 1D 00 BD 1F 00 BD 1F 00 BF 1F 00 C1 1F 00 CD 1F 00 CF 1F 00 DD 1F 00 DF 1F 00 ED 1F 00' + 'EF 1F 00 FD 1F 00 FE 1F 00 EF 2C 00 F1 2C 00 2F 2E 00 2F 2E 00 2A 30 00 2F 30 00 99 30 00 9C 30' + '00 FC 30 00 FC 30 00 6F A6 00 6F A6 00 7C A6 00 7D A6 00 7F A6 00 7F A6 00 9C A6 00 9D A6 00 F0' + 'A6 00 F1 A6 00 00 A7 00 21 A7 00 88 A7 00 8A A7 00 F8 A7 00 F9 A7 00 C4 A8 00 C4 A8 00 E0 A8 00' + 'F1 A8 00 2B A9 00 2E A9 00 53 A9 00 53 A9 00 B3 A9 00 B3 A9 00 C0 A9 00 C0 A9 00 E5 A9 00 E5 A9' + '00 7B AA 00 7D AA 00 BF AA 00 C2 AA 00 F6 AA 00 F6 AA 00 5B AB 00 5F AB 00 69 AB 00 6B AB 00 EC' + 'AB 00 ED AB 00 1E FB 00 1E FB 00 20 FE 00 2F FE 00 3E FF 00 3E FF 00 40 FF 00 40 FF 00 70 FF 00' + '70 FF 00 9E FF 00 9F FF 00 E3 FF 00 E3 FF 00 E0 02 01 E0 02 01 E5 0A 01 E6 0A 01 22 0D 01 27 0D' + '01 46 0F 01 50 0F 01 B9 10 01 BA 10 01 33 11 01 34 11 01 73 11 01 73 11 01 C0 11 01 C0 11 01 CA' + '11 01 CC 11 01 35 12 01 36 12 01 E9 12 01 EA 12 01 3C 13 01 3C 13 01 4D 13 01 4D 13 01 66 13 01' + '6C 13 01 70 13 01 74 13 01 42 14 01 42 14 01 46 14 01 46 14 01 C2 14 01 C3 14 01 BF 15 01 C0 15' + '01 3F 16 01 3F 16 01 B6 16 01 B7 16 01 2B 17 01 2B 17 01 39 18 01 3A 18 01 3D 19 01 3E 19 01 43' + '19 01 43 19 01 E0 19 01 E0 19 01 34 1A 01 34 1A 01 47 1A 01 47 1A 01 99 1A 01 99 1A 01 3F 1C 01' + '3F 1C 01 42 1D 01 42 1D 01 44 1D 01 45 1D 01 97 1D 01 97 1D 01 F0 6A 01 F4 6A 01 30 6B 01 36 6B' + '01 8F 6F 01 9F 6F 01 F0 6F 01 F1 6F 01 67 D1 01 69 D1 01 6D D1 01 72 D1 01 7B D1 01 82 D1 01 85' + 'D1 01 8B D1 01 AA D1 01 AD D1 01 30 E1 01 36 E1 01 EC E2 01 EF E2 01 D0 E8 01 D6 E8 01 44 E9 01' + '46 E9 01 48 E9 01 4A E9 01 3F 20 00 00 00 B7 00 00 B7 00 00 D0 02 00 D1 02 00 40 06 00 40 06 00' + 'FA 07 00 FA 07 00 55 0B 00 55 0B 00 46 0E 00 46 0E 00 C6 0E 00 C6 0E 00 0A 18 00 0A 18 00 43 18' + '00 43 18 00 A7 1A 00 A7 1A 00 36 1C 00 36 1C 00 7B 1C 00 7B 1C 00 05 30 00 05 30 00 31 30 00 35' + '30 00 9D 30 00 9E 30 00 FC 30 00 FE 30 00 15 A0 00 15 A0 00 0C A6 00 0C A6 00 CF A9 00 CF A9 00' + 'E6 A9 00 E6 A9 00 70 AA 00 70 AA 00 DD AA 00 DD AA 00 F3 AA 00 F4 AA 00 70 FF 00 70 FF 00 5D 13' + '01 5D 13 01 C6 15 01 C8 15 01 98 1A 01 98 1A 01 42 6B 01 43 6B 01 E0 6F 01 E1 6F 01 E3 6F 01 E3' + '6F 01 3C E1 01 3D E1 01 44 E9 01 46 E9 01 40 0A 00 00 00 2D 00 00 2D 00 00 AD 00 00 AD 00 00 8A' + '05 00 8A 05 00 06 18 00 06 18 00 10 20 00 11 20 00 17 2E 00 17 2E 00 FB 30 00 FB 30 00 63 FE 00' + '63 FE 00 0D FF 00 0D FF 00 65 FF 00 65 FF 00 41 13 00 00 00 06 30 00 07 30 00 21 30 00 29 30 00' + '38 30 00 3A 30 00 00 34 00 BF 4D 00 00 4E 00 FC 9F 00 00 F9 00 6D FA 00 70 FA 00 D9 FA 00 E4 6F' + '01 E4 6F 01 00 70 01 F7 87 01 00 88 01 D5 8C 01 00 8D 01 08 8D 01 70 B1 01 FB B2 01 00 00 02 DD' + 'A6 02 00 A7 02 34 B7 02 40 B7 02 1D B8 02 20 B8 02 A1 CE 02 B0 CE 02 E0 EB 02 00 F8 02 1D FA 02' + '00 00 03 4A 13 03 42 02 00 00 00 F0 2F 00 F1 2F 00 F4 2F 00 FB 2F 00 43 01 00 00 00 F2 2F 00 F3' + '2F 00 44 01 00 00 00 0C 20 00 0D 20 00 45 07 00 00 00 40 0E 00 44 0E 00 C0 0E 00 C4 0E 00 B5 19' + '00 B7 19 00 BA 19 00 BA 19 00 B5 AA 00 B6 AA 00 B9 AA 00 B9 AA 00 BB AA 00 BC AA 00 46 12 00 00' + '00 D0 FD 00 EF FD 00 FE FF 00 FF FF 00 FE FF 01 FF FF 01 FE FF 02 FF FF 02 FE FF 03 FF FF 03 FE' + 'FF 04 FF FF 04 FE FF 05 FF FF 05 FE FF 06 FF FF 06 FE FF 07 FF FF 07 FE FF 08 FF FF 08 FE FF 09' + 'FF FF 09 FE FF 0A FF FF 0A FE FF 0B FF FF 0B FE FF 0C FF FF 0C FE FF 0D FF FF 0D FE FF 0E FF FF' + '0E FE FF 0F FF FF 0F FE FF 10 FF FF 10 47 E6 00 00 00 45 03 00 45 03 00 B0 05 00 BD 05 00 BF 05' + '00 BF 05 00 C1 05 00 C2 05 00 C4 05 00 C5 05 00 C7 05 00 C7 05 00 10 06 00 1A 06 00 4B 06 00 57' + '06 00 59 06 00 5F 06 00 70 06 00 70 06 00 D6 06 00 DC 06 00 E1 06 00 E4 06 00 E7 06 00 E8 06 00' + 'ED 06 00 ED 06 00 11 07 00 11 07 00 30 07 00 3F 07 00 A6 07 00 B0 07 00 16 08 00 17 08 00 1B 08' + '00 23 08 00 25 08 00 27 08 00 29 08 00 2C 08 00 D4 08 00 DF 08 00 E3 08 00 E9 08 00 F0 08 00 03' + '09 00 3A 09 00 3B 09 00 3E 09 00 4C 09 00 4E 09 00 4F 09 00 55 09 00 57 09 00 62 09 00 63 09 00' + '81 09 00 83 09 00 BE 09 00 C4 09 00 C7 09 00 C8 09 00 CB 09 00 CC 09 00 D7 09 00 D7 09 00 E2 09' + '00 E3 09 00 01 0A 00 03 0A 00 3E 0A 00 42 0A 00 47 0A 00 48 0A 00 4B 0A 00 4C 0A 00 51 0A 00 51' + '0A 00 70 0A 00 71 0A 00 75 0A 00 75 0A 00 81 0A 00 83 0A 00 BE 0A 00 C5 0A 00 C7 0A 00 C9 0A 00' + 'CB 0A 00 CC 0A 00 E2 0A 00 E3 0A 00 FA 0A 00 FC 0A 00 01 0B 00 03 0B 00 3E 0B 00 44 0B 00 47 0B' + '00 48 0B 00 4B 0B 00 4C 0B 00 56 0B 00 57 0B 00 62 0B 00 63 0B 00 82 0B 00 82 0B 00 BE 0B 00 C2' + '0B 00 C6 0B 00 C8 0B 00 CA 0B 00 CC 0B 00 D7 0B 00 D7 0B 00 00 0C 00 03 0C 00 3E 0C 00 44 0C 00' + '46 0C 00 48 0C 00 4A 0C 00 4C 0C 00 55 0C 00 56 0C 00 62 0C 00 63 0C 00 81 0C 00 83 0C 00 BE 0C' + '00 C4 0C 00 C6 0C 00 C8 0C 00 CA 0C 00 CC 0C 00 D5 0C 00 D6 0C 00 E2 0C 00 E3 0C 00 00 0D 00 03' + '0D 00 3E 0D 00 44 0D 00 46 0D 00 48 0D 00 4A 0D 00 4C 0D 00 57 0D 00 57 0D 00 62 0D 00 63 0D 00' + '81 0D 00 83 0D 00 CF 0D 00 D4 0D 00 D6 0D 00 D6 0D 00 D8 0D 00 DF 0D 00 F2 0D 00 F3 0D 00 31 0E' + '00 31 0E 00 34 0E 00 3A 0E 00 4D 0E 00 4D 0E 00 B1 0E 00 B1 0E 00 B4 0E 00 B9 0E 00 BB 0E 00 BC' + '0E 00 CD 0E 00 CD 0E 00 71 0F 00 81 0F 00 8D 0F 00 97 0F 00 99 0F 00 BC 0F 00 2B 10 00 36 10 00' + '38 10 00 38 10 00 3B 10 00 3E 10 00 56 10 00 59 10 00 5E 10 00 60 10 00 62 10 00 64 10 00 67 10' + '00 6D 10 00 71 10 00 74 10 00 82 10 00 8D 10 00 8F 10 00 8F 10 00 9A 10 00 9D 10 00 12 17 00 13' + '17 00 32 17 00 33 17 00 52 17 00 53 17 00 72 17 00 73 17 00 B6 17 00 C8 17 00 85 18 00 86 18 00' + 'A9 18 00 A9 18 00 20 19 00 2B 19 00 30 19 00 38 19 00 17 1A 00 1B 1A 00 55 1A 00 5E 1A 00 61 1A' + '00 74 1A 00 BF 1A 00 C0 1A 00 00 1B 00 04 1B 00 35 1B 00 43 1B 00 80 1B 00 82 1B 00 A1 1B 00 A9' + '1B 00 AC 1B 00 AD 1B 00 E7 1B 00 F1 1B 00 24 1C 00 36 1C 00 E7 1D 00 F4 1D 00 B6 24 00 E9 24 00' + 'E0 2D 00 FF 2D 00 74 A6 00 7B A6 00 9E A6 00 9F A6 00 02 A8 00 02 A8 00 0B A8 00 0B A8 00 23 A8' + '00 27 A8 00 80 A8 00 81 A8 00 B4 A8 00 C3 A8 00 C5 A8 00 C5 A8 00 FF A8 00 FF A8 00 26 A9 00 2A' + 'A9 00 47 A9 00 52 A9 00 80 A9 00 83 A9 00 B4 A9 00 BF A9 00 E5 A9 00 E5 A9 00 29 AA 00 36 AA 00' + '43 AA 00 43 AA 00 4C AA 00 4D AA 00 7B AA 00 7D AA 00 B0 AA 00 B0 AA 00 B2 AA 00 B4 AA 00 B7 AA' + '00 B8 AA 00 BE AA 00 BE AA 00 EB AA 00 EF AA 00 F5 AA 00 F5 AA 00 E3 AB 00 EA AB 00 1E FB 00 1E' + 'FB 00 76 03 01 7A 03 01 01 0A 01 03 0A 01 05 0A 01 06 0A 01 0C 0A 01 0F 0A 01 24 0D 01 27 0D 01' + 'AB 0E 01 AC 0E 01 00 10 01 02 10 01 38 10 01 45 10 01 82 10 01 82 10 01 B0 10 01 B8 10 01 00 11' + '01 02 11 01 27 11 01 32 11 01 45 11 01 46 11 01 80 11 01 82 11 01 B3 11 01 BF 11 01 CE 11 01 CF' + '11 01 2C 12 01 34 12 01 37 12 01 37 12 01 3E 12 01 3E 12 01 DF 12 01 E8 12 01 00 13 01 03 13 01' + '3E 13 01 44 13 01 47 13 01 48 13 01 4B 13 01 4C 13 01 57 13 01 57 13 01 62 13 01 63 13 01 35 14' + '01 41 14 01 43 14 01 45 14 01 B0 14 01 C1 14 01 AF 15 01 B5 15 01 B8 15 01 BE 15 01 DC 15 01 DD' + '15 01 30 16 01 3E 16 01 40 16 01 40 16 01 AB 16 01 B5 16 01 1D 17 01 2A 17 01 2C 18 01 38 18 01' + '30 19 01 35 19 01 37 19 01 38 19 01 3B 19 01 3C 19 01 40 19 01 40 19 01 42 19 01 42 19 01 D1 19' + '01 D7 19 01 DA 19 01 DF 19 01 E4 19 01 E4 19 01 01 1A 01 0A 1A 01 35 1A 01 39 1A 01 3B 1A 01 3E' + '1A 01 51 1A 01 5B 1A 01 8A 1A 01 97 1A 01 2F 1C 01 36 1C 01 38 1C 01 3E 1C 01 92 1C 01 A7 1C 01' + 'A9 1C 01 B6 1C 01 31 1D 01 36 1D 01 3A 1D 01 3A 1D 01 3C 1D 01 3D 1D 01 3F 1D 01 41 1D 01 43 1D' + '01 43 1D 01 47 1D 01 47 1D 01 8A 1D 01 8E 1D 01 90 1D 01 91 1D 01 93 1D 01 96 1D 01 F3 1E 01 F6' + '1E 01 4F 6F 01 4F 6F 01 51 6F 01 87 6F 01 8F 6F 01 92 6F 01 F0 6F 01 F1 6F 01 9E BC 01 9E BC 01' + '00 E0 01 06 E0 01 08 E0 01 18 E0 01 1B E0 01 21 E0 01 23 E0 01 24 E0 01 26 E0 01 2A E0 01 47 E9' + '01 47 E9 01 30 F1 01 49 F1 01 50 F1 01 69 F1 01 70 F1 01 89 F1 01 48 0B 00 00 00 4F 03 00 4F 03' + '00 5F 11 00 60 11 00 B4 17 00 B5 17 00 65 20 00 65 20 00 64 31 00 64 31 00 A0 FF 00 A0 FF 00 F0' + 'FF 00 F8 FF 00 00 00 0E 00 00 0E 02 00 0E 1F 00 0E 80 00 0E FF 00 0E F0 01 0E FF 0F 0E 49 19 00' + '00 00 BE 09 00 BE 09 00 D7 09 00 D7 09 00 3E 0B 00 3E 0B 00 57 0B 00 57 0B 00 BE 0B 00 BE 0B 00' + 'D7 0B 00 D7 0B 00 C2 0C 00 C2 0C 00 D5 0C 00 D6 0C 00 3E 0D 00 3E 0D 00 57 0D 00 57 0D 00 CF 0D' + '00 CF 0D 00 DF 0D 00 DF 0D 00 35 1B 00 35 1B 00 0C 20 00 0C 20 00 2E 30 00 2F 30 00 9E FF 00 9F' + 'FF 00 3E 13 01 3E 13 01 57 13 01 57 13 01 B0 14 01 B0 14 01 BD 14 01 BD 14 01 AF 15 01 AF 15 01' + '30 19 01 30 19 01 65 D1 01 65 D1 01 6E D1 01 72 D1 01 20 00 0E 7F 00 0E 4A 04 00 00 00 B7 00 00' + 'B7 00 00 87 03 00 87 03 00 69 13 00 71 13 00 DA 19 00 DA 19 00 4B 04 00 00 00 85 18 00 86 18 00' + '18 21 00 18 21 00 2E 21 00 2E 21 00 9B 30 00 9C 30 00 4C 14 00 00 00 AA 00 00 AA 00 00 BA 00 00' + 'BA 00 00 B0 02 00 B8 02 00 C0 02 00 C1 02 00 E0 02 00 E4 02 00 45 03 00 45 03 00 7A 03 00 7A 03' + '00 2C 1D 00 6A 1D 00 78 1D 00 78 1D 00 9B 1D 00 BF 1D 00 71 20 00 71 20 00 7F 20 00 7F 20 00 90' + '20 00 9C 20 00 70 21 00 7F 21 00 D0 24 00 E9 24 00 7C 2C 00 7D 2C 00 9C A6 00 9D A6 00 70 A7 00' + '70 A7 00 F8 A7 00 F9 A7 00 5C AB 00 5F AB 00 4D 86 00 00 00 5E 00 00 5E 00 00 D0 03 00 D2 03 00' + 'D5 03 00 D5 03 00 F0 03 00 F1 03 00 F4 03 00 F5 03 00 16 20 00 16 20 00 32 20 00 34 20 00 40 20' + '00 40 20 00 61 20 00 64 20 00 7D 20 00 7E 20 00 8D 20 00 8E 20 00 D0 20 00 DC 20 00 E1 20 00 E1' + '20 00 E5 20 00 E6 20 00 EB 20 00 EF 20 00 02 21 00 02 21 00 07 21 00 07 21 00 0A 21 00 13 21 00' + '15 21 00 15 21 00 19 21 00 1D 21 00 24 21 00 24 21 00 28 21 00 29 21 00 2C 21 00 2D 21 00 2F 21' + '00 31 21 00 33 21 00 38 21 00 3C 21 00 3F 21 00 45 21 00 49 21 00 95 21 00 99 21 00 9C 21 00 9F' + '21 00 A1 21 00 A2 21 00 A4 21 00 A5 21 00 A7 21 00 A7 21 00 A9 21 00 AD 21 00 B0 21 00 B1 21 00' + 'B6 21 00 B7 21 00 BC 21 00 CD 21 00 D0 21 00 D1 21 00 D3 21 00 D3 21 00 D5 21 00 DB 21 00 DD 21' + '00 DD 21 00 E4 21 00 E5 21 00 08 23 00 0B 23 00 B4 23 00 B5 23 00 B7 23 00 B7 23 00 D0 23 00 D0' + '23 00 E2 23 00 E2 23 00 A0 25 00 A1 25 00 AE 25 00 B6 25 00 BC 25 00 C0 25 00 C6 25 00 C7 25 00' + 'CA 25 00 CB 25 00 CF 25 00 D3 25 00 E2 25 00 E2 25 00 E4 25 00 E4 25 00 E7 25 00 EC 25 00 05 26' + '00 06 26 00 40 26 00 40 26 00 42 26 00 42 26 00 60 26 00 63 26 00 6D 26 00 6E 26 00 C5 27 00 C6' + '27 00 E6 27 00 EF 27 00 83 29 00 98 29 00 D8 29 00 DB 29 00 FC 29 00 FD 29 00 61 FE 00 61 FE 00' + '63 FE 00 63 FE 00 68 FE 00 68 FE 00 3C FF 00 3C FF 00 3E FF 00 3E FF 00 00 D4 01 54 D4 01 56 D4' + '01 9C D4 01 9E D4 01 9F D4 01 A2 D4 01 A2 D4 01 A5 D4 01 A6 D4 01 A9 D4 01 AC D4 01 AE D4 01 B9' + 'D4 01 BB D4 01 BB D4 01 BD D4 01 C3 D4 01 C5 D4 01 05 D5 01 07 D5 01 0A D5 01 0D D5 01 14 D5 01' + '16 D5 01 1C D5 01 1E D5 01 39 D5 01 3B D5 01 3E D5 01 40 D5 01 44 D5 01 46 D5 01 46 D5 01 4A D5' + '01 50 D5 01 52 D5 01 A5 D6 01 A8 D6 01 C0 D6 01 C2 D6 01 DA D6 01 DC D6 01 FA D6 01 FC D6 01 14' + 'D7 01 16 D7 01 34 D7 01 36 D7 01 4E D7 01 50 D7 01 6E D7 01 70 D7 01 88 D7 01 8A D7 01 A8 D7 01' + 'AA D7 01 C2 D7 01 C4 D7 01 CB D7 01 CE D7 01 FF D7 01 00 EE 01 03 EE 01 05 EE 01 1F EE 01 21 EE' + '01 22 EE 01 24 EE 01 24 EE 01 27 EE 01 27 EE 01 29 EE 01 32 EE 01 34 EE 01 37 EE 01 39 EE 01 39' + 'EE 01 3B EE 01 3B EE 01 42 EE 01 42 EE 01 47 EE 01 47 EE 01 49 EE 01 49 EE 01 4B EE 01 4B EE 01' + '4D EE 01 4F EE 01 51 EE 01 52 EE 01 54 EE 01 54 EE 01 57 EE 01 57 EE 01 59 EE 01 59 EE 01 5B EE' + '01 5B EE 01 5D EE 01 5D EE 01 5F EE 01 5F EE 01 61 EE 01 62 EE 01 64 EE 01 64 EE 01 67 EE 01 6A' + 'EE 01 6C EE 01 72 EE 01 74 EE 01 77 EE 01 79 EE 01 7C EE 01 7E EE 01 7E EE 01 80 EE 01 89 EE 01' + '8B EE 01 9B EE 01 A1 EE 01 A3 EE 01 A5 EE 01 A9 EE 01 AB EE 01 BB EE 01 4E 05 00 00 00 60 21 00' + '6F 21 00 B6 24 00 CF 24 00 30 F1 01 49 F1 01 50 F1 01 69 F1 01 70 F1 01 89 F1 01 4F 1C 00 00 00' + '21 00 00 2F 00 00 3A 00 00 40 00 00 5B 00 00 5E 00 00 60 00 00 60 00 00 7B 00 00 7E 00 00 A1 00' + '00 A7 00 00 A9 00 00 A9 00 00 AB 00 00 AC 00 00 AE 00 00 AE 00 00 B0 00 00 B1 00 00 B6 00 00 B6' + '00 00 BB 00 00 BB 00 00 BF 00 00 BF 00 00 D7 00 00 D7 00 00 F7 00 00 F7 00 00 10 20 00 27 20 00' + '30 20 00 3E 20 00 41 20 00 53 20 00 55 20 00 5E 20 00 90 21 00 5F 24 00 00 25 00 75 27 00 94 27' + '00 FF 2B 00 00 2E 00 7F 2E 00 01 30 00 03 30 00 08 30 00 20 30 00 30 30 00 30 30 00 3E FD 00 3F' + 'FD 00 45 FE 00 46 FE 00 50 05 00 00 00 09 00 00 0D 00 00 20 00 00 20 00 00 85 00 00 85 00 00 0E' + '20 00 0F 20 00 28 20 00 29 20 00 51 03 00 00 00 80 2E 00 99 2E 00 9B 2E 00 F3 2E 00 00 2F 00 D5' + '2F 00 52 1F 00 00 00 69 00 00 6A 00 00 2F 01 00 2F 01 00 49 02 00 49 02 00 68 02 00 68 02 00 9D' + '02 00 9D 02 00 B2 02 00 B2 02 00 F3 03 00 F3 03 00 56 04 00 56 04 00 58 04 00 58 04 00 62 1D 00' + '62 1D 00 96 1D 00 96 1D 00 A4 1D 00 A4 1D 00 A8 1D 00 A8 1D 00 2D 1E 00 2D 1E 00 CB 1E 00 CB 1E' + '00 71 20 00 71 20 00 48 21 00 49 21 00 7C 2C 00 7C 2C 00 22 D4 01 23 D4 01 56 D4 01 57 D4 01 8A' + 'D4 01 8B D4 01 BE D4 01 BF D4 01 F2 D4 01 F3 D4 01 26 D5 01 27 D5 01 5A D5 01 5B D5 01 8E D5 01' + '8F D5 01 C2 D5 01 C3 D5 01 F6 D5 01 F7 D5 01 2A D6 01 2B D6 01 5E D6 01 5F D6 01 92 D6 01 93 D6' + '01 54 68 00 00 00 21 00 00 21 00 00 2C 00 00 2C 00 00 2E 00 00 2E 00 00 3A 00 00 3B 00 00 3F 00' + '00 3F 00 00 7E 03 00 7E 03 00 87 03 00 87 03 00 89 05 00 89 05 00 C3 05 00 C3 05 00 0C 06 00 0C' + '06 00 1B 06 00 1B 06 00 1E 06 00 1F 06 00 D4 06 00 D4 06 00 00 07 00 0A 07 00 0C 07 00 0C 07 00' + 'F8 07 00 F9 07 00 30 08 00 3E 08 00 5E 08 00 5E 08 00 64 09 00 65 09 00 5A 0E 00 5B 0E 00 08 0F' + '00 08 0F 00 0D 0F 00 12 0F 00 4A 10 00 4B 10 00 61 13 00 68 13 00 6E 16 00 6E 16 00 EB 16 00 ED' + '16 00 35 17 00 36 17 00 D4 17 00 D6 17 00 DA 17 00 DA 17 00 02 18 00 05 18 00 08 18 00 09 18 00' + '44 19 00 45 19 00 A8 1A 00 AB 1A 00 5A 1B 00 5B 1B 00 5D 1B 00 5F 1B 00 3B 1C 00 3F 1C 00 7E 1C' + '00 7F 1C 00 3C 20 00 3D 20 00 47 20 00 49 20 00 2E 2E 00 2E 2E 00 3C 2E 00 3C 2E 00 41 2E 00 41' + '2E 00 4C 2E 00 4C 2E 00 4E 2E 00 4F 2E 00 01 30 00 02 30 00 FE A4 00 FF A4 00 0D A6 00 0F A6 00' + 'F3 A6 00 F7 A6 00 76 A8 00 77 A8 00 CE A8 00 CF A8 00 2F A9 00 2F A9 00 C7 A9 00 C9 A9 00 5D AA' + '00 5F AA 00 DF AA 00 DF AA 00 F0 AA 00 F1 AA 00 EB AB 00 EB AB 00 50 FE 00 52 FE 00 54 FE 00 57' + 'FE 00 01 FF 00 01 FF 00 0C FF 00 0C FF 00 0E FF 00 0E FF 00 1A FF 00 1B FF 00 1F FF 00 1F FF 00' + '61 FF 00 61 FF 00 64 FF 00 64 FF 00 9F 03 01 9F 03 01 D0 03 01 D0 03 01 57 08 01 57 08 01 1F 09' + '01 1F 09 01 56 0A 01 57 0A 01 F0 0A 01 F5 0A 01 3A 0B 01 3F 0B 01 99 0B 01 9C 0B 01 55 0F 01 59' + '0F 01 47 10 01 4D 10 01 BE 10 01 C1 10 01 41 11 01 43 11 01 C5 11 01 C6 11 01 CD 11 01 CD 11 01' + 'DE 11 01 DF 11 01 38 12 01 3C 12 01 A9 12 01 A9 12 01 4B 14 01 4D 14 01 5A 14 01 5B 14 01 C2 15' + '01 C5 15 01 C9 15 01 D7 15 01 41 16 01 42 16 01 3C 17 01 3E 17 01 44 19 01 44 19 01 46 19 01 46' + '19 01 42 1A 01 43 1A 01 9B 1A 01 9C 1A 01 A1 1A 01 A2 1A 01 41 1C 01 43 1C 01 71 1C 01 71 1C 01' + 'F7 1E 01 F8 1E 01 70 24 01 74 24 01 6E 6A 01 6F 6A 01 F5 6A 01 F5 6A 01 37 6B 01 39 6B 01 44 6B' + '01 44 6B 01 97 6E 01 98 6E 01 9F BC 01 9F BC 01 87 DA 01 8A DA 01 55 0F 00 00 00 00 34 00 BF 4D' + '00 00 4E 00 FC 9F 00 0E FA 00 0F FA 00 11 FA 00 11 FA 00 13 FA 00 14 FA 00 1F FA 00 1F FA 00 21' + 'FA 00 21 FA 00 23 FA 00 24 FA 00 27 FA 00 29 FA 00 00 00 02 DD A6 02 00 A7 02 34 B7 02 40 B7 02' + '1D B8 02 20 B8 02 A1 CE 02 B0 CE 02 E0 EB 02 00 00 03 4A 13 03 56 03 00 00 00 0B 18 00 0D 18 00' + '00 FE 00 0F FE 00 00 01 0E EF 01 0E 57 4C 00 00 00 21 00 00 21 00 00 2E 00 00 2E 00 00 3F 00 00' + '3F 00 00 89 05 00 89 05 00 1E 06 00 1F 06 00 D4 06 00 D4 06 00 00 07 00 02 07 00 F9 07 00 F9 07' + '00 37 08 00 37 08 00 39 08 00 39 08 00 3D 08 00 3E 08 00 64 09 00 65 09 00 4A 10 00 4B 10 00 62' + '13 00 62 13 00 67 13 00 68 13 00 6E 16 00 6E 16 00 35 17 00 36 17 00 03 18 00 03 18 00 09 18 00' + '09 18 00 44 19 00 45 19 00 A8 1A 00 AB 1A 00 5A 1B 00 5B 1B 00 5E 1B 00 5F 1B 00 3B 1C 00 3C 1C' + '00 7E 1C 00 7F 1C 00 3C 20 00 3D 20 00 47 20 00 49 20 00 2E 2E 00 2E 2E 00 3C 2E 00 3C 2E 00 02' + '30 00 02 30 00 FF A4 00 FF A4 00 0E A6 00 0F A6 00 F3 A6 00 F3 A6 00 F7 A6 00 F7 A6 00 76 A8 00' + '77 A8 00 CE A8 00 CF A8 00 2F A9 00 2F A9 00 C8 A9 00 C9 A9 00 5D AA 00 5F AA 00 F0 AA 00 F1 AA' + '00 EB AB 00 EB AB 00 52 FE 00 52 FE 00 56 FE 00 57 FE 00 01 FF 00 01 FF 00 0E FF 00 0E FF 00 1F' + 'FF 00 1F FF 00 61 FF 00 61 FF 00 56 0A 01 57 0A 01 55 0F 01 59 0F 01 47 10 01 48 10 01 BE 10 01' + 'C1 10 01 41 11 01 43 11 01 C5 11 01 C6 11 01 CD 11 01 CD 11 01 DE 11 01 DF 11 01 38 12 01 39 12' + '01 3B 12 01 3C 12 01 A9 12 01 A9 12 01 4B 14 01 4C 14 01 C2 15 01 C3 15 01 C9 15 01 D7 15 01 41' + '16 01 42 16 01 3C 17 01 3E 17 01 44 19 01 44 19 01 46 19 01 46 19 01 42 1A 01 43 1A 01 9B 1A 01' + '9C 1A 01 41 1C 01 42 1C 01 F7 1E 01 F8 1E 01 6E 6A 01 6F 6A 01 F5 6A 01 F5 6A 01 37 6B 01 38 6B' + '01 44 6B 01 44 6B 01 98 6E 01 98 6E 01 9F BC 01 9F BC 01 88 DA 01 88 DA 01 58 06 00 00 00 00 06' + '00 05 06 00 DD 06 00 DD 06 00 0F 07 00 0F 07 00 E2 08 00 E2 08 00 BD 10 01 BD 10 01 CD 10 01 CD' + '10 01 59 01 00 00 00 E6 F1 01 FF F1 01' +} + + +LANGUAGE 0,0 CASE UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE +{ + '20 0B 00 00 41 00 00 01 61 00 00 01 61 00 00 00 00 42 00 00 01 62 00 00 01 62 00 00 00 00 43 00' + '00 01 63 00 00 01 63 00 00 00 00 44 00 00 01 64 00 00 01 64 00 00 00 00 45 00 00 01 65 00 00 01' + '65 00 00 00 00 46 00 00 01 66 00 00 01 66 00 00 00 00 47 00 00 01 67 00 00 01 67 00 00 00 00 48' + '00 00 01 68 00 00 01 68 00 00 00 00 49 00 00 01 69 00 00 01 69 00 00 01 49 00 00 01 49 00 00 4A' + '00 00 01 6A 00 00 01 6A 00 00 01 4A 00 00 01 4A 00 00 4B 00 00 01 6B 00 00 01 6B 00 00 00 00 4C' + '00 00 01 6C 00 00 01 6C 00 00 00 00 4D 00 00 01 6D 00 00 01 6D 00 00 00 00 4E 00 00 01 6E 00 00' + '01 6E 00 00 00 00 4F 00 00 01 6F 00 00 01 6F 00 00 00 00 50 00 00 01 70 00 00 01 70 00 00 00 00' + '51 00 00 01 71 00 00 01 71 00 00 00 00 52 00 00 01 72 00 00 01 72 00 00 00 00 53 00 00 01 73 00' + '00 01 73 00 00 00 00 54 00 00 01 74 00 00 01 74 00 00 00 00 55 00 00 01 75 00 00 01 75 00 00 00' + '00 56 00 00 01 76 00 00 01 76 00 00 00 00 57 00 00 01 77 00 00 01 77 00 00 00 00 58 00 00 01 78' + '00 00 01 78 00 00 00 00 59 00 00 01 79 00 00 01 79 00 00 00 00 5A 00 00 01 7A 00 00 01 7A 00 00' + '00 00 61 00 00 00 00 01 41 00 00 01 41 00 00 62 00 00 00 00 01 42 00 00 01 42 00 00 63 00 00 00' + '00 01 43 00 00 01 43 00 00 64 00 00 00 00 01 44 00 00 01 44 00 00 65 00 00 00 00 01 45 00 00 01' + '45 00 00 66 00 00 00 00 01 46 00 00 01 46 00 00 67 00 00 00 00 01 47 00 00 01 47 00 00 68 00 00' + '00 00 01 48 00 00 01 48 00 00 69 00 00 00 01 69 00 00 01 49 00 00 01 49 00 00 6A 00 00 00 00 01' + '4A 00 00 01 4A 00 00 6B 00 00 00 00 01 4B 00 00 01 4B 00 00 6C 00 00 00 00 01 4C 00 00 01 4C 00' + '00 6D 00 00 00 00 01 4D 00 00 01 4D 00 00 6E 00 00 00 00 01 4E 00 00 01 4E 00 00 6F 00 00 00 00' + '01 4F 00 00 01 4F 00 00 70 00 00 00 00 01 50 00 00 01 50 00 00 71 00 00 00 00 01 51 00 00 01 51' + '00 00 72 00 00 00 00 01 52 00 00 01 52 00 00 73 00 00 00 00 01 53 00 00 01 53 00 00 74 00 00 00' + '00 01 54 00 00 01 54 00 00 75 00 00 00 00 01 55 00 00 01 55 00 00 76 00 00 00 00 01 56 00 00 01' + '56 00 00 77 00 00 00 00 01 57 00 00 01 57 00 00 78 00 00 00 00 01 58 00 00 01 58 00 00 79 00 00' + '00 00 01 59 00 00 01 59 00 00 7A 00 00 00 00 01 5A 00 00 01 5A 00 00 B5 00 00 01 BC 03 00 00 01' + '9C 03 00 01 9C 03 00 C0 00 00 01 E0 00 00 01 E0 00 00 00 00 C1 00 00 01 E1 00 00 01 E1 00 00 00' + '00 C2 00 00 01 E2 00 00 01 E2 00 00 00 00 C3 00 00 01 E3 00 00 01 E3 00 00 00 00 C4 00 00 01 E4' + '00 00 01 E4 00 00 00 00 C5 00 00 01 E5 00 00 01 E5 00 00 00 00 C6 00 00 01 E6 00 00 01 E6 00 00' + '00 00 C7 00 00 01 E7 00 00 01 E7 00 00 00 00 C8 00 00 01 E8 00 00 01 E8 00 00 00 00 C9 00 00 01' + 'E9 00 00 01 E9 00 00 00 00 CA 00 00 01 EA 00 00 01 EA 00 00 00 00 CB 00 00 01 EB 00 00 01 EB 00' + '00 00 00 CC 00 00 01 EC 00 00 01 EC 00 00 01 CC 00 00 01 CC 00 00 CD 00 00 01 ED 00 00 01 ED 00' + '00 01 CD 00 00 01 CD 00 00 CE 00 00 01 EE 00 00 01 EE 00 00 00 00 CF 00 00 01 EF 00 00 01 EF 00' + '00 00 00 D0 00 00 01 F0 00 00 01 F0 00 00 00 00 D1 00 00 01 F1 00 00 01 F1 00 00 00 00 D2 00 00' + '01 F2 00 00 01 F2 00 00 00 00 D3 00 00 01 F3 00 00 01 F3 00 00 00 00 D4 00 00 01 F4 00 00 01 F4' + '00 00 00 00 D5 00 00 01 F5 00 00 01 F5 00 00 00 00 D6 00 00 01 F6 00 00 01 F6 00 00 00 00 D8 00' + '00 01 F8 00 00 01 F8 00 00 00 00 D9 00 00 01 F9 00 00 01 F9 00 00 00 00 DA 00 00 01 FA 00 00 01' + 'FA 00 00 00 00 DB 00 00 01 FB 00 00 01 FB 00 00 00 00 DC 00 00 01 FC 00 00 01 FC 00 00 00 00 DD' + '00 00 01 FD 00 00 01 FD 00 00 00 00 DE 00 00 01 FE 00 00 01 FE 00 00 00 00 DF 00 00 02 73 00 00' + '73 00 00 01 DF 00 00 02 53 00 00 73 00 00 02 53 00 00 53 00 00 E0 00 00 00 00 01 C0 00 00 01 C0' + '00 00 E1 00 00 00 00 01 C1 00 00 01 C1 00 00 E2 00 00 00 00 01 C2 00 00 01 C2 00 00 E3 00 00 00' + '00 01 C3 00 00 01 C3 00 00 E4 00 00 00 00 01 C4 00 00 01 C4 00 00 E5 00 00 00 00 01 C5 00 00 01' + 'C5 00 00 E6 00 00 00 00 01 C6 00 00 01 C6 00 00 E7 00 00 00 00 01 C7 00 00 01 C7 00 00 E8 00 00' + '00 00 01 C8 00 00 01 C8 00 00 E9 00 00 00 00 01 C9 00 00 01 C9 00 00 EA 00 00 00 00 01 CA 00 00' + '01 CA 00 00 EB 00 00 00 00 01 CB 00 00 01 CB 00 00 EC 00 00 00 00 01 CC 00 00 01 CC 00 00 ED 00' + '00 00 00 01 CD 00 00 01 CD 00 00 EE 00 00 00 00 01 CE 00 00 01 CE 00 00 EF 00 00 00 00 01 CF 00' + '00 01 CF 00 00 F0 00 00 00 00 01 D0 00 00 01 D0 00 00 F1 00 00 00 00 01 D1 00 00 01 D1 00 00 F2' + '00 00 00 00 01 D2 00 00 01 D2 00 00 F3 00 00 00 00 01 D3 00 00 01 D3 00 00 F4 00 00 00 00 01 D4' + '00 00 01 D4 00 00 F5 00 00 00 00 01 D5 00 00 01 D5 00 00 F6 00 00 00 00 01 D6 00 00 01 D6 00 00' + 'F8 00 00 00 00 01 D8 00 00 01 D8 00 00 F9 00 00 00 00 01 D9 00 00 01 D9 00 00 FA 00 00 00 00 01' + 'DA 00 00 01 DA 00 00 FB 00 00 00 00 01 DB 00 00 01 DB 00 00 FC 00 00 00 00 01 DC 00 00 01 DC 00' + '00 FD 00 00 00 00 01 DD 00 00 01 DD 00 00 FE 00 00 00 00 01 DE 00 00 01 DE 00 00 FF 00 00 00 00' + '01 78 01 00 01 78 01 00 00 01 00 01 01 01 00 01 01 01 00 00 00 01 01 00 00 00 01 00 01 00 01 00' + '01 00 02 01 00 01 03 01 00 01 03 01 00 00 00 03 01 00 00 00 01 02 01 00 01 02 01 00 04 01 00 01' + '05 01 00 01 05 01 00 00 00 05 01 00 00 00 01 04 01 00 01 04 01 00 06 01 00 01 07 01 00 01 07 01' + '00 00 00 07 01 00 00 00 01 06 01 00 01 06 01 00 08 01 00 01 09 01 00 01 09 01 00 00 00 09 01 00' + '00 00 01 08 01 00 01 08 01 00 0A 01 00 01 0B 01 00 01 0B 01 00 00 00 0B 01 00 00 00 01 0A 01 00' + '01 0A 01 00 0C 01 00 01 0D 01 00 01 0D 01 00 00 00 0D 01 00 00 00 01 0C 01 00 01 0C 01 00 0E 01' + '00 01 0F 01 00 01 0F 01 00 00 00 0F 01 00 00 00 01 0E 01 00 01 0E 01 00 10 01 00 01 11 01 00 01' + '11 01 00 00 00 11 01 00 00 00 01 10 01 00 01 10 01 00 12 01 00 01 13 01 00 01 13 01 00 00 00 13' + '01 00 00 00 01 12 01 00 01 12 01 00 14 01 00 01 15 01 00 01 15 01 00 00 00 15 01 00 00 00 01 14' + '01 00 01 14 01 00 16 01 00 01 17 01 00 01 17 01 00 00 00 17 01 00 00 00 01 16 01 00 01 16 01 00' + '18 01 00 01 19 01 00 01 19 01 00 00 00 19 01 00 00 00 01 18 01 00 01 18 01 00 1A 01 00 01 1B 01' + '00 01 1B 01 00 00 00 1B 01 00 00 00 01 1A 01 00 01 1A 01 00 1C 01 00 01 1D 01 00 01 1D 01 00 00' + '00 1D 01 00 00 00 01 1C 01 00 01 1C 01 00 1E 01 00 01 1F 01 00 01 1F 01 00 00 00 1F 01 00 00 00' + '01 1E 01 00 01 1E 01 00 20 01 00 01 21 01 00 01 21 01 00 00 00 21 01 00 00 00 01 20 01 00 01 20' + '01 00 22 01 00 01 23 01 00 01 23 01 00 00 00 23 01 00 00 00 01 22 01 00 01 22 01 00 24 01 00 01' + '25 01 00 01 25 01 00 00 00 25 01 00 00 00 01 24 01 00 01 24 01 00 26 01 00 01 27 01 00 01 27 01' + '00 00 00 27 01 00 00 00 01 26 01 00 01 26 01 00 28 01 00 01 29 01 00 01 29 01 00 01 28 01 00 01' + '28 01 00 29 01 00 00 00 01 28 01 00 01 28 01 00 2A 01 00 01 2B 01 00 01 2B 01 00 00 00 2B 01 00' + '00 00 01 2A 01 00 01 2A 01 00 2C 01 00 01 2D 01 00 01 2D 01 00 00 00 2D 01 00 00 00 01 2C 01 00' + '01 2C 01 00 2E 01 00 01 2F 01 00 01 2F 01 00 01 2E 01 00 01 2E 01 00 2F 01 00 00 00 01 2E 01 00' + '01 2E 01 00 30 01 00 02 69 00 00 07 03 00 01 69 00 00 01 30 01 00 01 30 01 00 31 01 00 00 00 01' + '49 00 00 01 49 00 00 32 01 00 01 33 01 00 01 33 01 00 00 00 33 01 00 00 00 01 32 01 00 01 32 01' + '00 34 01 00 01 35 01 00 01 35 01 00 00 00 35 01 00 00 00 01 34 01 00 01 34 01 00 36 01 00 01 37' + '01 00 01 37 01 00 00 00 37 01 00 00 00 01 36 01 00 01 36 01 00 39 01 00 01 3A 01 00 01 3A 01 00' + '00 00 3A 01 00 00 00 01 39 01 00 01 39 01 00 3B 01 00 01 3C 01 00 01 3C 01 00 00 00 3C 01 00 00' + '00 01 3B 01 00 01 3B 01 00 3D 01 00 01 3E 01 00 01 3E 01 00 00 00 3E 01 00 00 00 01 3D 01 00 01' + '3D 01 00 3F 01 00 01 40 01 00 01 40 01 00 00 00 40 01 00 00 00 01 3F 01 00 01 3F 01 00 41 01 00' + '01 42 01 00 01 42 01 00 00 00 42 01 00 00 00 01 41 01 00 01 41 01 00 43 01 00 01 44 01 00 01 44' + '01 00 00 00 44 01 00 00 00 01 43 01 00 01 43 01 00 45 01 00 01 46 01 00 01 46 01 00 00 00 46 01' + '00 00 00 01 45 01 00 01 45 01 00 47 01 00 01 48 01 00 01 48 01 00 00 00 48 01 00 00 00 01 47 01' + '00 01 47 01 00 49 01 00 02 BC 02 00 6E 00 00 01 49 01 00 02 BC 02 00 4E 00 00 02 BC 02 00 4E 00' + '00 4A 01 00 01 4B 01 00 01 4B 01 00 00 00 4B 01 00 00 00 01 4A 01 00 01 4A 01 00 4C 01 00 01 4D' + '01 00 01 4D 01 00 00 00 4D 01 00 00 00 01 4C 01 00 01 4C 01 00 4E 01 00 01 4F 01 00 01 4F 01 00' + '00 00 4F 01 00 00 00 01 4E 01 00 01 4E 01 00 50 01 00 01 51 01 00 01 51 01 00 00 00 51 01 00 00' + '00 01 50 01 00 01 50 01 00 52 01 00 01 53 01 00 01 53 01 00 00 00 53 01 00 00 00 01 52 01 00 01' + '52 01 00 54 01 00 01 55 01 00 01 55 01 00 00 00 55 01 00 00 00 01 54 01 00 01 54 01 00 56 01 00' + '01 57 01 00 01 57 01 00 00 00 57 01 00 00 00 01 56 01 00 01 56 01 00 58 01 00 01 59 01 00 01 59' + '01 00 00 00 59 01 00 00 00 01 58 01 00 01 58 01 00 5A 01 00 01 5B 01 00 01 5B 01 00 00 00 5B 01' + '00 00 00 01 5A 01 00 01 5A 01 00 5C 01 00 01 5D 01 00 01 5D 01 00 00 00 5D 01 00 00 00 01 5C 01' + '00 01 5C 01 00 5E 01 00 01 5F 01 00 01 5F 01 00 00 00 5F 01 00 00 00 01 5E 01 00 01 5E 01 00 60' + '01 00 01 61 01 00 01 61 01 00 00 00 61 01 00 00 00 01 60 01 00 01 60 01 00 62 01 00 01 63 01 00' + '01 63 01 00 00 00 63 01 00 00 00 01 62 01 00 01 62 01 00 64 01 00 01 65 01 00 01 65 01 00 00 00' + '65 01 00 00 00 01 64 01 00 01 64 01 00 66 01 00 01 67 01 00 01 67 01 00 00 00 67 01 00 00 00 01' + '66 01 00 01 66 01 00 68 01 00 01 69 01 00 01 69 01 00 00 00 69 01 00 00 00 01 68 01 00 01 68 01' + '00 6A 01 00 01 6B 01 00 01 6B 01 00 00 00 6B 01 00 00 00 01 6A 01 00 01 6A 01 00 6C 01 00 01 6D' + '01 00 01 6D 01 00 00 00 6D 01 00 00 00 01 6C 01 00 01 6C 01 00 6E 01 00 01 6F 01 00 01 6F 01 00' + '00 00 6F 01 00 00 00 01 6E 01 00 01 6E 01 00 70 01 00 01 71 01 00 01 71 01 00 00 00 71 01 00 00' + '00 01 70 01 00 01 70 01 00 72 01 00 01 73 01 00 01 73 01 00 00 00 73 01 00 00 00 01 72 01 00 01' + '72 01 00 74 01 00 01 75 01 00 01 75 01 00 00 00 75 01 00 00 00 01 74 01 00 01 74 01 00 76 01 00' + '01 77 01 00 01 77 01 00 00 00 77 01 00 00 00 01 76 01 00 01 76 01 00 78 01 00 01 FF 00 00 01 FF' + '00 00 00 00 79 01 00 01 7A 01 00 01 7A 01 00 00 00 7A 01 00 00 00 01 79 01 00 01 79 01 00 7B 01' + '00 01 7C 01 00 01 7C 01 00 00 00 7C 01 00 00 00 01 7B 01 00 01 7B 01 00 7D 01 00 01 7E 01 00 01' + '7E 01 00 00 00 7E 01 00 00 00 01 7D 01 00 01 7D 01 00 7F 01 00 01 73 00 00 00 01 53 00 00 01 53' + '00 00 80 01 00 00 00 01 43 02 00 01 43 02 00 81 01 00 01 53 02 00 01 53 02 00 00 00 82 01 00 01' + '83 01 00 01 83 01 00 00 00 83 01 00 00 00 01 82 01 00 01 82 01 00 84 01 00 01 85 01 00 01 85 01' + '00 00 00 85 01 00 00 00 01 84 01 00 01 84 01 00 86 01 00 01 54 02 00 01 54 02 00 00 00 87 01 00' + '01 88 01 00 01 88 01 00 00 00 88 01 00 00 00 01 87 01 00 01 87 01 00 89 01 00 01 56 02 00 01 56' + '02 00 00 00 8A 01 00 01 57 02 00 01 57 02 00 00 00 8B 01 00 01 8C 01 00 01 8C 01 00 00 00 8C 01' + '00 00 00 01 8B 01 00 01 8B 01 00 8E 01 00 01 DD 01 00 01 DD 01 00 00 00 8F 01 00 01 59 02 00 01' + '59 02 00 00 00 90 01 00 01 5B 02 00 01 5B 02 00 00 00 91 01 00 01 92 01 00 01 92 01 00 00 00 92' + '01 00 00 00 01 91 01 00 01 91 01 00 93 01 00 01 60 02 00 01 60 02 00 00 00 94 01 00 01 63 02 00' + '01 63 02 00 00 00 95 01 00 00 00 01 F6 01 00 01 F6 01 00 96 01 00 01 69 02 00 01 69 02 00 00 00' + '97 01 00 01 68 02 00 01 68 02 00 00 00 98 01 00 01 99 01 00 01 99 01 00 00 00 99 01 00 00 00 01' + '98 01 00 01 98 01 00 9A 01 00 00 00 01 3D 02 00 01 3D 02 00 9C 01 00 01 6F 02 00 01 6F 02 00 00' + '00 9D 01 00 01 72 02 00 01 72 02 00 00 00 9E 01 00 00 00 01 20 02 00 01 20 02 00 9F 01 00 01 75' + '02 00 01 75 02 00 00 00 A0 01 00 01 A1 01 00 01 A1 01 00 00 00 A1 01 00 00 00 01 A0 01 00 01 A0' + '01 00 A2 01 00 01 A3 01 00 01 A3 01 00 00 00 A3 01 00 00 00 01 A2 01 00 01 A2 01 00 A4 01 00 01' + 'A5 01 00 01 A5 01 00 00 00 A5 01 00 00 00 01 A4 01 00 01 A4 01 00 A6 01 00 01 80 02 00 01 80 02' + '00 00 00 A7 01 00 01 A8 01 00 01 A8 01 00 00 00 A8 01 00 00 00 01 A7 01 00 01 A7 01 00 A9 01 00' + '01 83 02 00 01 83 02 00 00 00 AC 01 00 01 AD 01 00 01 AD 01 00 00 00 AD 01 00 00 00 01 AC 01 00' + '01 AC 01 00 AE 01 00 01 88 02 00 01 88 02 00 00 00 AF 01 00 01 B0 01 00 01 B0 01 00 00 00 B0 01' + '00 00 00 01 AF 01 00 01 AF 01 00 B1 01 00 01 8A 02 00 01 8A 02 00 00 00 B2 01 00 01 8B 02 00 01' + '8B 02 00 00 00 B3 01 00 01 B4 01 00 01 B4 01 00 00 00 B4 01 00 00 00 01 B3 01 00 01 B3 01 00 B5' + '01 00 01 B6 01 00 01 B6 01 00 00 00 B6 01 00 00 00 01 B5 01 00 01 B5 01 00 B7 01 00 01 92 02 00' + '01 92 02 00 00 00 B8 01 00 01 B9 01 00 01 B9 01 00 00 00 B9 01 00 00 00 01 B8 01 00 01 B8 01 00' + 'BC 01 00 01 BD 01 00 01 BD 01 00 00 00 BD 01 00 00 00 01 BC 01 00 01 BC 01 00 BF 01 00 00 00 01' + 'F7 01 00 01 F7 01 00 C4 01 00 01 C6 01 00 01 C6 01 00 01 C5 01 00 00 C5 01 00 01 C6 01 00 01 C6' + '01 00 01 C5 01 00 01 C4 01 00 C6 01 00 00 00 01 C5 01 00 01 C4 01 00 C7 01 00 01 C9 01 00 01 C9' + '01 00 01 C8 01 00 00 C8 01 00 01 C9 01 00 01 C9 01 00 01 C8 01 00 01 C7 01 00 C9 01 00 00 00 01' + 'C8 01 00 01 C7 01 00 CA 01 00 01 CC 01 00 01 CC 01 00 01 CB 01 00 00 CB 01 00 01 CC 01 00 01 CC' + '01 00 01 CB 01 00 01 CA 01 00 CC 01 00 00 00 01 CB 01 00 01 CA 01 00 CD 01 00 01 CE 01 00 01 CE' + '01 00 00 00 CE 01 00 00 00 01 CD 01 00 01 CD 01 00 CF 01 00 01 D0 01 00 01 D0 01 00 00 00 D0 01' + '00 00 00 01 CF 01 00 01 CF 01 00 D1 01 00 01 D2 01 00 01 D2 01 00 00 00 D2 01 00 00 00 01 D1 01' + '00 01 D1 01 00 D3 01 00 01 D4 01 00 01 D4 01 00 00 00 D4 01 00 00 00 01 D3 01 00 01 D3 01 00 D5' + '01 00 01 D6 01 00 01 D6 01 00 00 00 D6 01 00 00 00 01 D5 01 00 01 D5 01 00 D7 01 00 01 D8 01 00' + '01 D8 01 00 00 00 D8 01 00 00 00 01 D7 01 00 01 D7 01 00 D9 01 00 01 DA 01 00 01 DA 01 00 00 00' + 'DA 01 00 00 00 01 D9 01 00 01 D9 01 00 DB 01 00 01 DC 01 00 01 DC 01 00 00 00 DC 01 00 00 00 01' + 'DB 01 00 01 DB 01 00 DD 01 00 00 00 01 8E 01 00 01 8E 01 00 DE 01 00 01 DF 01 00 01 DF 01 00 00' + '00 DF 01 00 00 00 01 DE 01 00 01 DE 01 00 E0 01 00 01 E1 01 00 01 E1 01 00 00 00 E1 01 00 00 00' + '01 E0 01 00 01 E0 01 00 E2 01 00 01 E3 01 00 01 E3 01 00 00 00 E3 01 00 00 00 01 E2 01 00 01 E2' + '01 00 E4 01 00 01 E5 01 00 01 E5 01 00 00 00 E5 01 00 00 00 01 E4 01 00 01 E4 01 00 E6 01 00 01' + 'E7 01 00 01 E7 01 00 00 00 E7 01 00 00 00 01 E6 01 00 01 E6 01 00 E8 01 00 01 E9 01 00 01 E9 01' + '00 00 00 E9 01 00 00 00 01 E8 01 00 01 E8 01 00 EA 01 00 01 EB 01 00 01 EB 01 00 00 00 EB 01 00' + '00 00 01 EA 01 00 01 EA 01 00 EC 01 00 01 ED 01 00 01 ED 01 00 00 00 ED 01 00 00 00 01 EC 01 00' + '01 EC 01 00 EE 01 00 01 EF 01 00 01 EF 01 00 00 00 EF 01 00 00 00 01 EE 01 00 01 EE 01 00 F0 01' + '00 02 6A 00 00 0C 03 00 01 F0 01 00 02 4A 00 00 0C 03 00 02 4A 00 00 0C 03 00 F1 01 00 01 F3 01' + '00 01 F3 01 00 01 F2 01 00 00 F2 01 00 01 F3 01 00 01 F3 01 00 01 F2 01 00 01 F1 01 00 F3 01 00' + '00 00 01 F2 01 00 01 F1 01 00 F4 01 00 01 F5 01 00 01 F5 01 00 00 00 F5 01 00 00 00 01 F4 01 00' + '01 F4 01 00 F6 01 00 01 95 01 00 01 95 01 00 00 00 F7 01 00 01 BF 01 00 01 BF 01 00 00 00 F8 01' + '00 01 F9 01 00 01 F9 01 00 00 00 F9 01 00 00 00 01 F8 01 00 01 F8 01 00 FA 01 00 01 FB 01 00 01' + 'FB 01 00 00 00 FB 01 00 00 00 01 FA 01 00 01 FA 01 00 FC 01 00 01 FD 01 00 01 FD 01 00 00 00 FD' + '01 00 00 00 01 FC 01 00 01 FC 01 00 FE 01 00 01 FF 01 00 01 FF 01 00 00 00 FF 01 00 00 00 01 FE' + '01 00 01 FE 01 00 00 02 00 01 01 02 00 01 01 02 00 00 00 01 02 00 00 00 01 00 02 00 01 00 02 00' + '02 02 00 01 03 02 00 01 03 02 00 00 00 03 02 00 00 00 01 02 02 00 01 02 02 00 04 02 00 01 05 02' + '00 01 05 02 00 00 00 05 02 00 00 00 01 04 02 00 01 04 02 00 06 02 00 01 07 02 00 01 07 02 00 00' + '00 07 02 00 00 00 01 06 02 00 01 06 02 00 08 02 00 01 09 02 00 01 09 02 00 00 00 09 02 00 00 00' + '01 08 02 00 01 08 02 00 0A 02 00 01 0B 02 00 01 0B 02 00 00 00 0B 02 00 00 00 01 0A 02 00 01 0A' + '02 00 0C 02 00 01 0D 02 00 01 0D 02 00 00 00 0D 02 00 00 00 01 0C 02 00 01 0C 02 00 0E 02 00 01' + '0F 02 00 01 0F 02 00 00 00 0F 02 00 00 00 01 0E 02 00 01 0E 02 00 10 02 00 01 11 02 00 01 11 02' + '00 00 00 11 02 00 00 00 01 10 02 00 01 10 02 00 12 02 00 01 13 02 00 01 13 02 00 00 00 13 02 00' + '00 00 01 12 02 00 01 12 02 00 14 02 00 01 15 02 00 01 15 02 00 00 00 15 02 00 00 00 01 14 02 00' + '01 14 02 00 16 02 00 01 17 02 00 01 17 02 00 00 00 17 02 00 00 00 01 16 02 00 01 16 02 00 18 02' + '00 01 19 02 00 01 19 02 00 00 00 19 02 00 00 00 01 18 02 00 01 18 02 00 1A 02 00 01 1B 02 00 01' + '1B 02 00 00 00 1B 02 00 00 00 01 1A 02 00 01 1A 02 00 1C 02 00 01 1D 02 00 01 1D 02 00 00 00 1D' + '02 00 00 00 01 1C 02 00 01 1C 02 00 1E 02 00 01 1F 02 00 01 1F 02 00 00 00 1F 02 00 00 00 01 1E' + '02 00 01 1E 02 00 20 02 00 01 9E 01 00 01 9E 01 00 00 00 22 02 00 01 23 02 00 01 23 02 00 00 00' + '23 02 00 00 00 01 22 02 00 01 22 02 00 24 02 00 01 25 02 00 01 25 02 00 00 00 25 02 00 00 00 01' + '24 02 00 01 24 02 00 26 02 00 01 27 02 00 01 27 02 00 00 00 27 02 00 00 00 01 26 02 00 01 26 02' + '00 28 02 00 01 29 02 00 01 29 02 00 00 00 29 02 00 00 00 01 28 02 00 01 28 02 00 2A 02 00 01 2B' + '02 00 01 2B 02 00 00 00 2B 02 00 00 00 01 2A 02 00 01 2A 02 00 2C 02 00 01 2D 02 00 01 2D 02 00' + '00 00 2D 02 00 00 00 01 2C 02 00 01 2C 02 00 2E 02 00 01 2F 02 00 01 2F 02 00 00 00 2F 02 00 00' + '00 01 2E 02 00 01 2E 02 00 30 02 00 01 31 02 00 01 31 02 00 00 00 31 02 00 00 00 01 30 02 00 01' + '30 02 00 32 02 00 01 33 02 00 01 33 02 00 00 00 33 02 00 00 00 01 32 02 00 01 32 02 00 3A 02 00' + '01 65 2C 00 01 65 2C 00 00 00 3B 02 00 01 3C 02 00 01 3C 02 00 00 00 3C 02 00 00 00 01 3B 02 00' + '01 3B 02 00 3D 02 00 01 9A 01 00 01 9A 01 00 00 00 3E 02 00 01 66 2C 00 01 66 2C 00 00 00 3F 02' + '00 00 00 01 7E 2C 00 01 7E 2C 00 40 02 00 00 00 01 7F 2C 00 01 7F 2C 00 41 02 00 01 42 02 00 01' + '42 02 00 00 00 42 02 00 00 00 01 41 02 00 01 41 02 00 43 02 00 01 80 01 00 01 80 01 00 00 00 44' + '02 00 01 89 02 00 01 89 02 00 00 00 45 02 00 01 8C 02 00 01 8C 02 00 00 00 46 02 00 01 47 02 00' + '01 47 02 00 00 00 47 02 00 00 00 01 46 02 00 01 46 02 00 48 02 00 01 49 02 00 01 49 02 00 00 00' + '49 02 00 00 00 01 48 02 00 01 48 02 00 4A 02 00 01 4B 02 00 01 4B 02 00 00 00 4B 02 00 00 00 01' + '4A 02 00 01 4A 02 00 4C 02 00 01 4D 02 00 01 4D 02 00 00 00 4D 02 00 00 00 01 4C 02 00 01 4C 02' + '00 4E 02 00 01 4F 02 00 01 4F 02 00 00 00 4F 02 00 00 00 01 4E 02 00 01 4E 02 00 50 02 00 00 00' + '01 6F 2C 00 01 6F 2C 00 51 02 00 00 00 01 6D 2C 00 01 6D 2C 00 52 02 00 00 00 01 70 2C 00 01 70' + '2C 00 53 02 00 00 00 01 81 01 00 01 81 01 00 54 02 00 00 00 01 86 01 00 01 86 01 00 56 02 00 00' + '00 01 89 01 00 01 89 01 00 57 02 00 00 00 01 8A 01 00 01 8A 01 00 59 02 00 00 00 01 8F 01 00 01' + '8F 01 00 5B 02 00 00 00 01 90 01 00 01 90 01 00 5C 02 00 00 00 01 AB A7 00 01 AB A7 00 60 02 00' + '00 00 01 93 01 00 01 93 01 00 61 02 00 00 00 01 AC A7 00 01 AC A7 00 63 02 00 00 00 01 94 01 00' + '01 94 01 00 65 02 00 00 00 01 8D A7 00 01 8D A7 00 66 02 00 00 00 01 AA A7 00 01 AA A7 00 68 02' + '00 00 00 01 97 01 00 01 97 01 00 69 02 00 00 00 01 96 01 00 01 96 01 00 6A 02 00 00 00 01 AE A7' + '00 01 AE A7 00 6B 02 00 00 00 01 62 2C 00 01 62 2C 00 6C 02 00 00 00 01 AD A7 00 01 AD A7 00 6F' + '02 00 00 00 01 9C 01 00 01 9C 01 00 71 02 00 00 00 01 6E 2C 00 01 6E 2C 00 72 02 00 00 00 01 9D' + '01 00 01 9D 01 00 75 02 00 00 00 01 9F 01 00 01 9F 01 00 7D 02 00 00 00 01 64 2C 00 01 64 2C 00' + '80 02 00 00 00 01 A6 01 00 01 A6 01 00 82 02 00 00 00 01 C5 A7 00 01 C5 A7 00 83 02 00 00 00 01' + 'A9 01 00 01 A9 01 00 87 02 00 00 00 01 B1 A7 00 01 B1 A7 00 88 02 00 00 00 01 AE 01 00 01 AE 01' + '00 89 02 00 00 00 01 44 02 00 01 44 02 00 8A 02 00 00 00 01 B1 01 00 01 B1 01 00 8B 02 00 00 00' + '01 B2 01 00 01 B2 01 00 8C 02 00 00 00 01 45 02 00 01 45 02 00 92 02 00 00 00 01 B7 01 00 01 B7' + '01 00 9D 02 00 00 00 01 B2 A7 00 01 B2 A7 00 9E 02 00 00 00 01 B0 A7 00 01 B0 A7 00 07 03 00 00' + '01 07 03 00 01 07 03 00 01 07 03 00 45 03 00 01 B9 03 00 00 01 99 03 00 01 99 03 00 70 03 00 01' + '71 03 00 01 71 03 00 00 00 71 03 00 00 00 01 70 03 00 01 70 03 00 72 03 00 01 73 03 00 01 73 03' + '00 00 00 73 03 00 00 00 01 72 03 00 01 72 03 00 76 03 00 01 77 03 00 01 77 03 00 00 00 77 03 00' + '00 00 01 76 03 00 01 76 03 00 7B 03 00 00 00 01 FD 03 00 01 FD 03 00 7C 03 00 00 00 01 FE 03 00' + '01 FE 03 00 7D 03 00 00 00 01 FF 03 00 01 FF 03 00 7F 03 00 01 F3 03 00 01 F3 03 00 00 00 86 03' + '00 01 AC 03 00 01 AC 03 00 00 00 88 03 00 01 AD 03 00 01 AD 03 00 00 00 89 03 00 01 AE 03 00 01' + 'AE 03 00 00 00 8A 03 00 01 AF 03 00 01 AF 03 00 00 00 8C 03 00 01 CC 03 00 01 CC 03 00 00 00 8E' + '03 00 01 CD 03 00 01 CD 03 00 00 00 8F 03 00 01 CE 03 00 01 CE 03 00 00 00 90 03 00 03 B9 03 00' + '08 03 00 01 03 00 01 90 03 00 03 99 03 00 08 03 00 01 03 00 03 99 03 00 08 03 00 01 03 00 91 03' + '00 01 B1 03 00 01 B1 03 00 00 00 92 03 00 01 B2 03 00 01 B2 03 00 00 00 93 03 00 01 B3 03 00 01' + 'B3 03 00 00 00 94 03 00 01 B4 03 00 01 B4 03 00 00 00 95 03 00 01 B5 03 00 01 B5 03 00 00 00 96' + '03 00 01 B6 03 00 01 B6 03 00 00 00 97 03 00 01 B7 03 00 01 B7 03 00 00 00 98 03 00 01 B8 03 00' + '01 B8 03 00 00 00 99 03 00 01 B9 03 00 01 B9 03 00 00 00 9A 03 00 01 BA 03 00 01 BA 03 00 00 00' + '9B 03 00 01 BB 03 00 01 BB 03 00 00 00 9C 03 00 01 BC 03 00 01 BC 03 00 00 00 9D 03 00 01 BD 03' + '00 01 BD 03 00 00 00 9E 03 00 01 BE 03 00 01 BE 03 00 00 00 9F 03 00 01 BF 03 00 01 BF 03 00 00' + '00 A0 03 00 01 C0 03 00 01 C0 03 00 00 00 A1 03 00 01 C1 03 00 01 C1 03 00 00 00 A3 03 00 01 C3' + '03 00 01 C3 03 00 01 A3 03 00 01 A3 03 00 A4 03 00 01 C4 03 00 01 C4 03 00 00 00 A5 03 00 01 C5' + '03 00 01 C5 03 00 00 00 A6 03 00 01 C6 03 00 01 C6 03 00 00 00 A7 03 00 01 C7 03 00 01 C7 03 00' + '00 00 A8 03 00 01 C8 03 00 01 C8 03 00 00 00 A9 03 00 01 C9 03 00 01 C9 03 00 00 00 AA 03 00 01' + 'CA 03 00 01 CA 03 00 00 00 AB 03 00 01 CB 03 00 01 CB 03 00 00 00 AC 03 00 00 00 01 86 03 00 01' + '86 03 00 AD 03 00 00 00 01 88 03 00 01 88 03 00 AE 03 00 00 00 01 89 03 00 01 89 03 00 AF 03 00' + '00 00 01 8A 03 00 01 8A 03 00 B0 03 00 03 C5 03 00 08 03 00 01 03 00 01 B0 03 00 03 A5 03 00 08' + '03 00 01 03 00 03 A5 03 00 08 03 00 01 03 00 B1 03 00 00 00 01 91 03 00 01 91 03 00 B2 03 00 00' + '00 01 92 03 00 01 92 03 00 B3 03 00 00 00 01 93 03 00 01 93 03 00 B4 03 00 00 00 01 94 03 00 01' + '94 03 00 B5 03 00 00 00 01 95 03 00 01 95 03 00 B6 03 00 00 00 01 96 03 00 01 96 03 00 B7 03 00' + '00 00 01 97 03 00 01 97 03 00 B8 03 00 00 00 01 98 03 00 01 98 03 00 B9 03 00 00 00 01 99 03 00' + '01 99 03 00 BA 03 00 00 00 01 9A 03 00 01 9A 03 00 BB 03 00 00 00 01 9B 03 00 01 9B 03 00 BC 03' + '00 00 00 01 9C 03 00 01 9C 03 00 BD 03 00 00 00 01 9D 03 00 01 9D 03 00 BE 03 00 00 00 01 9E 03' + '00 01 9E 03 00 BF 03 00 00 00 01 9F 03 00 01 9F 03 00 C0 03 00 00 00 01 A0 03 00 01 A0 03 00 C1' + '03 00 00 00 01 A1 03 00 01 A1 03 00 C2 03 00 01 C3 03 00 00 01 A3 03 00 01 A3 03 00 C3 03 00 00' + '00 01 A3 03 00 01 A3 03 00 C4 03 00 00 00 01 A4 03 00 01 A4 03 00 C5 03 00 00 00 01 A5 03 00 01' + 'A5 03 00 C6 03 00 00 00 01 A6 03 00 01 A6 03 00 C7 03 00 00 00 01 A7 03 00 01 A7 03 00 C8 03 00' + '00 00 01 A8 03 00 01 A8 03 00 C9 03 00 00 00 01 A9 03 00 01 A9 03 00 CA 03 00 00 00 01 AA 03 00' + '01 AA 03 00 CB 03 00 00 00 01 AB 03 00 01 AB 03 00 CC 03 00 00 00 01 8C 03 00 01 8C 03 00 CD 03' + '00 00 00 01 8E 03 00 01 8E 03 00 CE 03 00 00 00 01 8F 03 00 01 8F 03 00 CF 03 00 01 D7 03 00 01' + 'D7 03 00 00 00 D0 03 00 01 B2 03 00 00 01 92 03 00 01 92 03 00 D1 03 00 01 B8 03 00 00 01 98 03' + '00 01 98 03 00 D5 03 00 01 C6 03 00 00 01 A6 03 00 01 A6 03 00 D6 03 00 01 C0 03 00 00 01 A0 03' + '00 01 A0 03 00 D7 03 00 00 00 01 CF 03 00 01 CF 03 00 D8 03 00 01 D9 03 00 01 D9 03 00 00 00 D9' + '03 00 00 00 01 D8 03 00 01 D8 03 00 DA 03 00 01 DB 03 00 01 DB 03 00 00 00 DB 03 00 00 00 01 DA' + '03 00 01 DA 03 00 DC 03 00 01 DD 03 00 01 DD 03 00 00 00 DD 03 00 00 00 01 DC 03 00 01 DC 03 00' + 'DE 03 00 01 DF 03 00 01 DF 03 00 00 00 DF 03 00 00 00 01 DE 03 00 01 DE 03 00 E0 03 00 01 E1 03' + '00 01 E1 03 00 00 00 E1 03 00 00 00 01 E0 03 00 01 E0 03 00 E2 03 00 01 E3 03 00 01 E3 03 00 00' + '00 E3 03 00 00 00 01 E2 03 00 01 E2 03 00 E4 03 00 01 E5 03 00 01 E5 03 00 00 00 E5 03 00 00 00' + '01 E4 03 00 01 E4 03 00 E6 03 00 01 E7 03 00 01 E7 03 00 00 00 E7 03 00 00 00 01 E6 03 00 01 E6' + '03 00 E8 03 00 01 E9 03 00 01 E9 03 00 00 00 E9 03 00 00 00 01 E8 03 00 01 E8 03 00 EA 03 00 01' + 'EB 03 00 01 EB 03 00 00 00 EB 03 00 00 00 01 EA 03 00 01 EA 03 00 EC 03 00 01 ED 03 00 01 ED 03' + '00 00 00 ED 03 00 00 00 01 EC 03 00 01 EC 03 00 EE 03 00 01 EF 03 00 01 EF 03 00 00 00 EF 03 00' + '00 00 01 EE 03 00 01 EE 03 00 F0 03 00 01 BA 03 00 00 01 9A 03 00 01 9A 03 00 F1 03 00 01 C1 03' + '00 00 01 A1 03 00 01 A1 03 00 F2 03 00 00 00 01 F9 03 00 01 F9 03 00 F3 03 00 00 00 01 7F 03 00' + '01 7F 03 00 F4 03 00 01 B8 03 00 01 B8 03 00 00 00 F5 03 00 01 B5 03 00 00 01 95 03 00 01 95 03' + '00 F7 03 00 01 F8 03 00 01 F8 03 00 00 00 F8 03 00 00 00 01 F7 03 00 01 F7 03 00 F9 03 00 01 F2' + '03 00 01 F2 03 00 00 00 FA 03 00 01 FB 03 00 01 FB 03 00 00 00 FB 03 00 00 00 01 FA 03 00 01 FA' + '03 00 FD 03 00 01 7B 03 00 01 7B 03 00 00 00 FE 03 00 01 7C 03 00 01 7C 03 00 00 00 FF 03 00 01' + '7D 03 00 01 7D 03 00 00 00 00 04 00 01 50 04 00 01 50 04 00 00 00 01 04 00 01 51 04 00 01 51 04' + '00 00 00 02 04 00 01 52 04 00 01 52 04 00 00 00 03 04 00 01 53 04 00 01 53 04 00 00 00 04 04 00' + '01 54 04 00 01 54 04 00 00 00 05 04 00 01 55 04 00 01 55 04 00 00 00 06 04 00 01 56 04 00 01 56' + '04 00 00 00 07 04 00 01 57 04 00 01 57 04 00 00 00 08 04 00 01 58 04 00 01 58 04 00 00 00 09 04' + '00 01 59 04 00 01 59 04 00 00 00 0A 04 00 01 5A 04 00 01 5A 04 00 00 00 0B 04 00 01 5B 04 00 01' + '5B 04 00 00 00 0C 04 00 01 5C 04 00 01 5C 04 00 00 00 0D 04 00 01 5D 04 00 01 5D 04 00 00 00 0E' + '04 00 01 5E 04 00 01 5E 04 00 00 00 0F 04 00 01 5F 04 00 01 5F 04 00 00 00 10 04 00 01 30 04 00' + '01 30 04 00 00 00 11 04 00 01 31 04 00 01 31 04 00 00 00 12 04 00 01 32 04 00 01 32 04 00 00 00' + '13 04 00 01 33 04 00 01 33 04 00 00 00 14 04 00 01 34 04 00 01 34 04 00 00 00 15 04 00 01 35 04' + '00 01 35 04 00 00 00 16 04 00 01 36 04 00 01 36 04 00 00 00 17 04 00 01 37 04 00 01 37 04 00 00' + '00 18 04 00 01 38 04 00 01 38 04 00 00 00 19 04 00 01 39 04 00 01 39 04 00 00 00 1A 04 00 01 3A' + '04 00 01 3A 04 00 00 00 1B 04 00 01 3B 04 00 01 3B 04 00 00 00 1C 04 00 01 3C 04 00 01 3C 04 00' + '00 00 1D 04 00 01 3D 04 00 01 3D 04 00 00 00 1E 04 00 01 3E 04 00 01 3E 04 00 00 00 1F 04 00 01' + '3F 04 00 01 3F 04 00 00 00 20 04 00 01 40 04 00 01 40 04 00 00 00 21 04 00 01 41 04 00 01 41 04' + '00 00 00 22 04 00 01 42 04 00 01 42 04 00 00 00 23 04 00 01 43 04 00 01 43 04 00 00 00 24 04 00' + '01 44 04 00 01 44 04 00 00 00 25 04 00 01 45 04 00 01 45 04 00 00 00 26 04 00 01 46 04 00 01 46' + '04 00 00 00 27 04 00 01 47 04 00 01 47 04 00 00 00 28 04 00 01 48 04 00 01 48 04 00 00 00 29 04' + '00 01 49 04 00 01 49 04 00 00 00 2A 04 00 01 4A 04 00 01 4A 04 00 00 00 2B 04 00 01 4B 04 00 01' + '4B 04 00 00 00 2C 04 00 01 4C 04 00 01 4C 04 00 00 00 2D 04 00 01 4D 04 00 01 4D 04 00 00 00 2E' + '04 00 01 4E 04 00 01 4E 04 00 00 00 2F 04 00 01 4F 04 00 01 4F 04 00 00 00 30 04 00 00 00 01 10' + '04 00 01 10 04 00 31 04 00 00 00 01 11 04 00 01 11 04 00 32 04 00 00 00 01 12 04 00 01 12 04 00' + '33 04 00 00 00 01 13 04 00 01 13 04 00 34 04 00 00 00 01 14 04 00 01 14 04 00 35 04 00 00 00 01' + '15 04 00 01 15 04 00 36 04 00 00 00 01 16 04 00 01 16 04 00 37 04 00 00 00 01 17 04 00 01 17 04' + '00 38 04 00 00 00 01 18 04 00 01 18 04 00 39 04 00 00 00 01 19 04 00 01 19 04 00 3A 04 00 00 00' + '01 1A 04 00 01 1A 04 00 3B 04 00 00 00 01 1B 04 00 01 1B 04 00 3C 04 00 00 00 01 1C 04 00 01 1C' + '04 00 3D 04 00 00 00 01 1D 04 00 01 1D 04 00 3E 04 00 00 00 01 1E 04 00 01 1E 04 00 3F 04 00 00' + '00 01 1F 04 00 01 1F 04 00 40 04 00 00 00 01 20 04 00 01 20 04 00 41 04 00 00 00 01 21 04 00 01' + '21 04 00 42 04 00 00 00 01 22 04 00 01 22 04 00 43 04 00 00 00 01 23 04 00 01 23 04 00 44 04 00' + '00 00 01 24 04 00 01 24 04 00 45 04 00 00 00 01 25 04 00 01 25 04 00 46 04 00 00 00 01 26 04 00' + '01 26 04 00 47 04 00 00 00 01 27 04 00 01 27 04 00 48 04 00 00 00 01 28 04 00 01 28 04 00 49 04' + '00 00 00 01 29 04 00 01 29 04 00 4A 04 00 00 00 01 2A 04 00 01 2A 04 00 4B 04 00 00 00 01 2B 04' + '00 01 2B 04 00 4C 04 00 00 00 01 2C 04 00 01 2C 04 00 4D 04 00 00 00 01 2D 04 00 01 2D 04 00 4E' + '04 00 00 00 01 2E 04 00 01 2E 04 00 4F 04 00 00 00 01 2F 04 00 01 2F 04 00 50 04 00 00 00 01 00' + '04 00 01 00 04 00 51 04 00 00 00 01 01 04 00 01 01 04 00 52 04 00 00 00 01 02 04 00 01 02 04 00' + '53 04 00 00 00 01 03 04 00 01 03 04 00 54 04 00 00 00 01 04 04 00 01 04 04 00 55 04 00 00 00 01' + '05 04 00 01 05 04 00 56 04 00 00 00 01 06 04 00 01 06 04 00 57 04 00 00 00 01 07 04 00 01 07 04' + '00 58 04 00 00 00 01 08 04 00 01 08 04 00 59 04 00 00 00 01 09 04 00 01 09 04 00 5A 04 00 00 00' + '01 0A 04 00 01 0A 04 00 5B 04 00 00 00 01 0B 04 00 01 0B 04 00 5C 04 00 00 00 01 0C 04 00 01 0C' + '04 00 5D 04 00 00 00 01 0D 04 00 01 0D 04 00 5E 04 00 00 00 01 0E 04 00 01 0E 04 00 5F 04 00 00' + '00 01 0F 04 00 01 0F 04 00 60 04 00 01 61 04 00 01 61 04 00 00 00 61 04 00 00 00 01 60 04 00 01' + '60 04 00 62 04 00 01 63 04 00 01 63 04 00 00 00 63 04 00 00 00 01 62 04 00 01 62 04 00 64 04 00' + '01 65 04 00 01 65 04 00 00 00 65 04 00 00 00 01 64 04 00 01 64 04 00 66 04 00 01 67 04 00 01 67' + '04 00 00 00 67 04 00 00 00 01 66 04 00 01 66 04 00 68 04 00 01 69 04 00 01 69 04 00 00 00 69 04' + '00 00 00 01 68 04 00 01 68 04 00 6A 04 00 01 6B 04 00 01 6B 04 00 00 00 6B 04 00 00 00 01 6A 04' + '00 01 6A 04 00 6C 04 00 01 6D 04 00 01 6D 04 00 00 00 6D 04 00 00 00 01 6C 04 00 01 6C 04 00 6E' + '04 00 01 6F 04 00 01 6F 04 00 00 00 6F 04 00 00 00 01 6E 04 00 01 6E 04 00 70 04 00 01 71 04 00' + '01 71 04 00 00 00 71 04 00 00 00 01 70 04 00 01 70 04 00 72 04 00 01 73 04 00 01 73 04 00 00 00' + '73 04 00 00 00 01 72 04 00 01 72 04 00 74 04 00 01 75 04 00 01 75 04 00 00 00 75 04 00 00 00 01' + '74 04 00 01 74 04 00 76 04 00 01 77 04 00 01 77 04 00 00 00 77 04 00 00 00 01 76 04 00 01 76 04' + '00 78 04 00 01 79 04 00 01 79 04 00 00 00 79 04 00 00 00 01 78 04 00 01 78 04 00 7A 04 00 01 7B' + '04 00 01 7B 04 00 00 00 7B 04 00 00 00 01 7A 04 00 01 7A 04 00 7C 04 00 01 7D 04 00 01 7D 04 00' + '00 00 7D 04 00 00 00 01 7C 04 00 01 7C 04 00 7E 04 00 01 7F 04 00 01 7F 04 00 00 00 7F 04 00 00' + '00 01 7E 04 00 01 7E 04 00 80 04 00 01 81 04 00 01 81 04 00 00 00 81 04 00 00 00 01 80 04 00 01' + '80 04 00 8A 04 00 01 8B 04 00 01 8B 04 00 00 00 8B 04 00 00 00 01 8A 04 00 01 8A 04 00 8C 04 00' + '01 8D 04 00 01 8D 04 00 00 00 8D 04 00 00 00 01 8C 04 00 01 8C 04 00 8E 04 00 01 8F 04 00 01 8F' + '04 00 00 00 8F 04 00 00 00 01 8E 04 00 01 8E 04 00 90 04 00 01 91 04 00 01 91 04 00 00 00 91 04' + '00 00 00 01 90 04 00 01 90 04 00 92 04 00 01 93 04 00 01 93 04 00 00 00 93 04 00 00 00 01 92 04' + '00 01 92 04 00 94 04 00 01 95 04 00 01 95 04 00 00 00 95 04 00 00 00 01 94 04 00 01 94 04 00 96' + '04 00 01 97 04 00 01 97 04 00 00 00 97 04 00 00 00 01 96 04 00 01 96 04 00 98 04 00 01 99 04 00' + '01 99 04 00 00 00 99 04 00 00 00 01 98 04 00 01 98 04 00 9A 04 00 01 9B 04 00 01 9B 04 00 00 00' + '9B 04 00 00 00 01 9A 04 00 01 9A 04 00 9C 04 00 01 9D 04 00 01 9D 04 00 00 00 9D 04 00 00 00 01' + '9C 04 00 01 9C 04 00 9E 04 00 01 9F 04 00 01 9F 04 00 00 00 9F 04 00 00 00 01 9E 04 00 01 9E 04' + '00 A0 04 00 01 A1 04 00 01 A1 04 00 00 00 A1 04 00 00 00 01 A0 04 00 01 A0 04 00 A2 04 00 01 A3' + '04 00 01 A3 04 00 00 00 A3 04 00 00 00 01 A2 04 00 01 A2 04 00 A4 04 00 01 A5 04 00 01 A5 04 00' + '00 00 A5 04 00 00 00 01 A4 04 00 01 A4 04 00 A6 04 00 01 A7 04 00 01 A7 04 00 00 00 A7 04 00 00' + '00 01 A6 04 00 01 A6 04 00 A8 04 00 01 A9 04 00 01 A9 04 00 00 00 A9 04 00 00 00 01 A8 04 00 01' + 'A8 04 00 AA 04 00 01 AB 04 00 01 AB 04 00 00 00 AB 04 00 00 00 01 AA 04 00 01 AA 04 00 AC 04 00' + '01 AD 04 00 01 AD 04 00 00 00 AD 04 00 00 00 01 AC 04 00 01 AC 04 00 AE 04 00 01 AF 04 00 01 AF' + '04 00 00 00 AF 04 00 00 00 01 AE 04 00 01 AE 04 00 B0 04 00 01 B1 04 00 01 B1 04 00 00 00 B1 04' + '00 00 00 01 B0 04 00 01 B0 04 00 B2 04 00 01 B3 04 00 01 B3 04 00 00 00 B3 04 00 00 00 01 B2 04' + '00 01 B2 04 00 B4 04 00 01 B5 04 00 01 B5 04 00 00 00 B5 04 00 00 00 01 B4 04 00 01 B4 04 00 B6' + '04 00 01 B7 04 00 01 B7 04 00 00 00 B7 04 00 00 00 01 B6 04 00 01 B6 04 00 B8 04 00 01 B9 04 00' + '01 B9 04 00 00 00 B9 04 00 00 00 01 B8 04 00 01 B8 04 00 BA 04 00 01 BB 04 00 01 BB 04 00 00 00' + 'BB 04 00 00 00 01 BA 04 00 01 BA 04 00 BC 04 00 01 BD 04 00 01 BD 04 00 00 00 BD 04 00 00 00 01' + 'BC 04 00 01 BC 04 00 BE 04 00 01 BF 04 00 01 BF 04 00 00 00 BF 04 00 00 00 01 BE 04 00 01 BE 04' + '00 C0 04 00 01 CF 04 00 01 CF 04 00 00 00 C1 04 00 01 C2 04 00 01 C2 04 00 00 00 C2 04 00 00 00' + '01 C1 04 00 01 C1 04 00 C3 04 00 01 C4 04 00 01 C4 04 00 00 00 C4 04 00 00 00 01 C3 04 00 01 C3' + '04 00 C5 04 00 01 C6 04 00 01 C6 04 00 00 00 C6 04 00 00 00 01 C5 04 00 01 C5 04 00 C7 04 00 01' + 'C8 04 00 01 C8 04 00 00 00 C8 04 00 00 00 01 C7 04 00 01 C7 04 00 C9 04 00 01 CA 04 00 01 CA 04' + '00 00 00 CA 04 00 00 00 01 C9 04 00 01 C9 04 00 CB 04 00 01 CC 04 00 01 CC 04 00 00 00 CC 04 00' + '00 00 01 CB 04 00 01 CB 04 00 CD 04 00 01 CE 04 00 01 CE 04 00 00 00 CE 04 00 00 00 01 CD 04 00' + '01 CD 04 00 CF 04 00 00 00 01 C0 04 00 01 C0 04 00 D0 04 00 01 D1 04 00 01 D1 04 00 00 00 D1 04' + '00 00 00 01 D0 04 00 01 D0 04 00 D2 04 00 01 D3 04 00 01 D3 04 00 00 00 D3 04 00 00 00 01 D2 04' + '00 01 D2 04 00 D4 04 00 01 D5 04 00 01 D5 04 00 00 00 D5 04 00 00 00 01 D4 04 00 01 D4 04 00 D6' + '04 00 01 D7 04 00 01 D7 04 00 00 00 D7 04 00 00 00 01 D6 04 00 01 D6 04 00 D8 04 00 01 D9 04 00' + '01 D9 04 00 00 00 D9 04 00 00 00 01 D8 04 00 01 D8 04 00 DA 04 00 01 DB 04 00 01 DB 04 00 00 00' + 'DB 04 00 00 00 01 DA 04 00 01 DA 04 00 DC 04 00 01 DD 04 00 01 DD 04 00 00 00 DD 04 00 00 00 01' + 'DC 04 00 01 DC 04 00 DE 04 00 01 DF 04 00 01 DF 04 00 00 00 DF 04 00 00 00 01 DE 04 00 01 DE 04' + '00 E0 04 00 01 E1 04 00 01 E1 04 00 00 00 E1 04 00 00 00 01 E0 04 00 01 E0 04 00 E2 04 00 01 E3' + '04 00 01 E3 04 00 00 00 E3 04 00 00 00 01 E2 04 00 01 E2 04 00 E4 04 00 01 E5 04 00 01 E5 04 00' + '00 00 E5 04 00 00 00 01 E4 04 00 01 E4 04 00 E6 04 00 01 E7 04 00 01 E7 04 00 00 00 E7 04 00 00' + '00 01 E6 04 00 01 E6 04 00 E8 04 00 01 E9 04 00 01 E9 04 00 00 00 E9 04 00 00 00 01 E8 04 00 01' + 'E8 04 00 EA 04 00 01 EB 04 00 01 EB 04 00 00 00 EB 04 00 00 00 01 EA 04 00 01 EA 04 00 EC 04 00' + '01 ED 04 00 01 ED 04 00 00 00 ED 04 00 00 00 01 EC 04 00 01 EC 04 00 EE 04 00 01 EF 04 00 01 EF' + '04 00 00 00 EF 04 00 00 00 01 EE 04 00 01 EE 04 00 F0 04 00 01 F1 04 00 01 F1 04 00 00 00 F1 04' + '00 00 00 01 F0 04 00 01 F0 04 00 F2 04 00 01 F3 04 00 01 F3 04 00 00 00 F3 04 00 00 00 01 F2 04' + '00 01 F2 04 00 F4 04 00 01 F5 04 00 01 F5 04 00 00 00 F5 04 00 00 00 01 F4 04 00 01 F4 04 00 F6' + '04 00 01 F7 04 00 01 F7 04 00 00 00 F7 04 00 00 00 01 F6 04 00 01 F6 04 00 F8 04 00 01 F9 04 00' + '01 F9 04 00 00 00 F9 04 00 00 00 01 F8 04 00 01 F8 04 00 FA 04 00 01 FB 04 00 01 FB 04 00 00 00' + 'FB 04 00 00 00 01 FA 04 00 01 FA 04 00 FC 04 00 01 FD 04 00 01 FD 04 00 00 00 FD 04 00 00 00 01' + 'FC 04 00 01 FC 04 00 FE 04 00 01 FF 04 00 01 FF 04 00 00 00 FF 04 00 00 00 01 FE 04 00 01 FE 04' + '00 00 05 00 01 01 05 00 01 01 05 00 00 00 01 05 00 00 00 01 00 05 00 01 00 05 00 02 05 00 01 03' + '05 00 01 03 05 00 00 00 03 05 00 00 00 01 02 05 00 01 02 05 00 04 05 00 01 05 05 00 01 05 05 00' + '00 00 05 05 00 00 00 01 04 05 00 01 04 05 00 06 05 00 01 07 05 00 01 07 05 00 00 00 07 05 00 00' + '00 01 06 05 00 01 06 05 00 08 05 00 01 09 05 00 01 09 05 00 00 00 09 05 00 00 00 01 08 05 00 01' + '08 05 00 0A 05 00 01 0B 05 00 01 0B 05 00 00 00 0B 05 00 00 00 01 0A 05 00 01 0A 05 00 0C 05 00' + '01 0D 05 00 01 0D 05 00 00 00 0D 05 00 00 00 01 0C 05 00 01 0C 05 00 0E 05 00 01 0F 05 00 01 0F' + '05 00 00 00 0F 05 00 00 00 01 0E 05 00 01 0E 05 00 10 05 00 01 11 05 00 01 11 05 00 00 00 11 05' + '00 00 00 01 10 05 00 01 10 05 00 12 05 00 01 13 05 00 01 13 05 00 00 00 13 05 00 00 00 01 12 05' + '00 01 12 05 00 14 05 00 01 15 05 00 01 15 05 00 00 00 15 05 00 00 00 01 14 05 00 01 14 05 00 16' + '05 00 01 17 05 00 01 17 05 00 00 00 17 05 00 00 00 01 16 05 00 01 16 05 00 18 05 00 01 19 05 00' + '01 19 05 00 00 00 19 05 00 00 00 01 18 05 00 01 18 05 00 1A 05 00 01 1B 05 00 01 1B 05 00 00 00' + '1B 05 00 00 00 01 1A 05 00 01 1A 05 00 1C 05 00 01 1D 05 00 01 1D 05 00 00 00 1D 05 00 00 00 01' + '1C 05 00 01 1C 05 00 1E 05 00 01 1F 05 00 01 1F 05 00 00 00 1F 05 00 00 00 01 1E 05 00 01 1E 05' + '00 20 05 00 01 21 05 00 01 21 05 00 00 00 21 05 00 00 00 01 20 05 00 01 20 05 00 22 05 00 01 23' + '05 00 01 23 05 00 00 00 23 05 00 00 00 01 22 05 00 01 22 05 00 24 05 00 01 25 05 00 01 25 05 00' + '00 00 25 05 00 00 00 01 24 05 00 01 24 05 00 26 05 00 01 27 05 00 01 27 05 00 00 00 27 05 00 00' + '00 01 26 05 00 01 26 05 00 28 05 00 01 29 05 00 01 29 05 00 00 00 29 05 00 00 00 01 28 05 00 01' + '28 05 00 2A 05 00 01 2B 05 00 01 2B 05 00 00 00 2B 05 00 00 00 01 2A 05 00 01 2A 05 00 2C 05 00' + '01 2D 05 00 01 2D 05 00 00 00 2D 05 00 00 00 01 2C 05 00 01 2C 05 00 2E 05 00 01 2F 05 00 01 2F' + '05 00 00 00 2F 05 00 00 00 01 2E 05 00 01 2E 05 00 31 05 00 01 61 05 00 01 61 05 00 00 00 32 05' + '00 01 62 05 00 01 62 05 00 00 00 33 05 00 01 63 05 00 01 63 05 00 00 00 34 05 00 01 64 05 00 01' + '64 05 00 00 00 35 05 00 01 65 05 00 01 65 05 00 00 00 36 05 00 01 66 05 00 01 66 05 00 00 00 37' + '05 00 01 67 05 00 01 67 05 00 00 00 38 05 00 01 68 05 00 01 68 05 00 00 00 39 05 00 01 69 05 00' + '01 69 05 00 00 00 3A 05 00 01 6A 05 00 01 6A 05 00 00 00 3B 05 00 01 6B 05 00 01 6B 05 00 00 00' + '3C 05 00 01 6C 05 00 01 6C 05 00 00 00 3D 05 00 01 6D 05 00 01 6D 05 00 00 00 3E 05 00 01 6E 05' + '00 01 6E 05 00 00 00 3F 05 00 01 6F 05 00 01 6F 05 00 00 00 40 05 00 01 70 05 00 01 70 05 00 00' + '00 41 05 00 01 71 05 00 01 71 05 00 00 00 42 05 00 01 72 05 00 01 72 05 00 00 00 43 05 00 01 73' + '05 00 01 73 05 00 00 00 44 05 00 01 74 05 00 01 74 05 00 00 00 45 05 00 01 75 05 00 01 75 05 00' + '00 00 46 05 00 01 76 05 00 01 76 05 00 00 00 47 05 00 01 77 05 00 01 77 05 00 00 00 48 05 00 01' + '78 05 00 01 78 05 00 00 00 49 05 00 01 79 05 00 01 79 05 00 00 00 4A 05 00 01 7A 05 00 01 7A 05' + '00 00 00 4B 05 00 01 7B 05 00 01 7B 05 00 00 00 4C 05 00 01 7C 05 00 01 7C 05 00 00 00 4D 05 00' + '01 7D 05 00 01 7D 05 00 00 00 4E 05 00 01 7E 05 00 01 7E 05 00 00 00 4F 05 00 01 7F 05 00 01 7F' + '05 00 00 00 50 05 00 01 80 05 00 01 80 05 00 00 00 51 05 00 01 81 05 00 01 81 05 00 00 00 52 05' + '00 01 82 05 00 01 82 05 00 00 00 53 05 00 01 83 05 00 01 83 05 00 00 00 54 05 00 01 84 05 00 01' + '84 05 00 00 00 55 05 00 01 85 05 00 01 85 05 00 00 00 56 05 00 01 86 05 00 01 86 05 00 00 00 61' + '05 00 00 00 01 31 05 00 01 31 05 00 62 05 00 00 00 01 32 05 00 01 32 05 00 63 05 00 00 00 01 33' + '05 00 01 33 05 00 64 05 00 00 00 01 34 05 00 01 34 05 00 65 05 00 00 00 01 35 05 00 01 35 05 00' + '66 05 00 00 00 01 36 05 00 01 36 05 00 67 05 00 00 00 01 37 05 00 01 37 05 00 68 05 00 00 00 01' + '38 05 00 01 38 05 00 69 05 00 00 00 01 39 05 00 01 39 05 00 6A 05 00 00 00 01 3A 05 00 01 3A 05' + '00 6B 05 00 00 00 01 3B 05 00 01 3B 05 00 6C 05 00 00 00 01 3C 05 00 01 3C 05 00 6D 05 00 00 00' + '01 3D 05 00 01 3D 05 00 6E 05 00 00 00 01 3E 05 00 01 3E 05 00 6F 05 00 00 00 01 3F 05 00 01 3F' + '05 00 70 05 00 00 00 01 40 05 00 01 40 05 00 71 05 00 00 00 01 41 05 00 01 41 05 00 72 05 00 00' + '00 01 42 05 00 01 42 05 00 73 05 00 00 00 01 43 05 00 01 43 05 00 74 05 00 00 00 01 44 05 00 01' + '44 05 00 75 05 00 00 00 01 45 05 00 01 45 05 00 76 05 00 00 00 01 46 05 00 01 46 05 00 77 05 00' + '00 00 01 47 05 00 01 47 05 00 78 05 00 00 00 01 48 05 00 01 48 05 00 79 05 00 00 00 01 49 05 00' + '01 49 05 00 7A 05 00 00 00 01 4A 05 00 01 4A 05 00 7B 05 00 00 00 01 4B 05 00 01 4B 05 00 7C 05' + '00 00 00 01 4C 05 00 01 4C 05 00 7D 05 00 00 00 01 4D 05 00 01 4D 05 00 7E 05 00 00 00 01 4E 05' + '00 01 4E 05 00 7F 05 00 00 00 01 4F 05 00 01 4F 05 00 80 05 00 00 00 01 50 05 00 01 50 05 00 81' + '05 00 00 00 01 51 05 00 01 51 05 00 82 05 00 00 00 01 52 05 00 01 52 05 00 83 05 00 00 00 01 53' + '05 00 01 53 05 00 84 05 00 00 00 01 54 05 00 01 54 05 00 85 05 00 00 00 01 55 05 00 01 55 05 00' + '86 05 00 00 00 01 56 05 00 01 56 05 00 87 05 00 02 65 05 00 82 05 00 01 87 05 00 02 35 05 00 82' + '05 00 02 35 05 00 52 05 00 A0 10 00 01 00 2D 00 01 00 2D 00 00 00 A1 10 00 01 01 2D 00 01 01 2D' + '00 00 00 A2 10 00 01 02 2D 00 01 02 2D 00 00 00 A3 10 00 01 03 2D 00 01 03 2D 00 00 00 A4 10 00' + '01 04 2D 00 01 04 2D 00 00 00 A5 10 00 01 05 2D 00 01 05 2D 00 00 00 A6 10 00 01 06 2D 00 01 06' + '2D 00 00 00 A7 10 00 01 07 2D 00 01 07 2D 00 00 00 A8 10 00 01 08 2D 00 01 08 2D 00 00 00 A9 10' + '00 01 09 2D 00 01 09 2D 00 00 00 AA 10 00 01 0A 2D 00 01 0A 2D 00 00 00 AB 10 00 01 0B 2D 00 01' + '0B 2D 00 00 00 AC 10 00 01 0C 2D 00 01 0C 2D 00 00 00 AD 10 00 01 0D 2D 00 01 0D 2D 00 00 00 AE' + '10 00 01 0E 2D 00 01 0E 2D 00 00 00 AF 10 00 01 0F 2D 00 01 0F 2D 00 00 00 B0 10 00 01 10 2D 00' + '01 10 2D 00 00 00 B1 10 00 01 11 2D 00 01 11 2D 00 00 00 B2 10 00 01 12 2D 00 01 12 2D 00 00 00' + 'B3 10 00 01 13 2D 00 01 13 2D 00 00 00 B4 10 00 01 14 2D 00 01 14 2D 00 00 00 B5 10 00 01 15 2D' + '00 01 15 2D 00 00 00 B6 10 00 01 16 2D 00 01 16 2D 00 00 00 B7 10 00 01 17 2D 00 01 17 2D 00 00' + '00 B8 10 00 01 18 2D 00 01 18 2D 00 00 00 B9 10 00 01 19 2D 00 01 19 2D 00 00 00 BA 10 00 01 1A' + '2D 00 01 1A 2D 00 00 00 BB 10 00 01 1B 2D 00 01 1B 2D 00 00 00 BC 10 00 01 1C 2D 00 01 1C 2D 00' + '00 00 BD 10 00 01 1D 2D 00 01 1D 2D 00 00 00 BE 10 00 01 1E 2D 00 01 1E 2D 00 00 00 BF 10 00 01' + '1F 2D 00 01 1F 2D 00 00 00 C0 10 00 01 20 2D 00 01 20 2D 00 00 00 C1 10 00 01 21 2D 00 01 21 2D' + '00 00 00 C2 10 00 01 22 2D 00 01 22 2D 00 00 00 C3 10 00 01 23 2D 00 01 23 2D 00 00 00 C4 10 00' + '01 24 2D 00 01 24 2D 00 00 00 C5 10 00 01 25 2D 00 01 25 2D 00 00 00 C7 10 00 01 27 2D 00 01 27' + '2D 00 00 00 CD 10 00 01 2D 2D 00 01 2D 2D 00 00 00 D0 10 00 00 00 01 D0 10 00 01 90 1C 00 D1 10' + '00 00 00 01 D1 10 00 01 91 1C 00 D2 10 00 00 00 01 D2 10 00 01 92 1C 00 D3 10 00 00 00 01 D3 10' + '00 01 93 1C 00 D4 10 00 00 00 01 D4 10 00 01 94 1C 00 D5 10 00 00 00 01 D5 10 00 01 95 1C 00 D6' + '10 00 00 00 01 D6 10 00 01 96 1C 00 D7 10 00 00 00 01 D7 10 00 01 97 1C 00 D8 10 00 00 00 01 D8' + '10 00 01 98 1C 00 D9 10 00 00 00 01 D9 10 00 01 99 1C 00 DA 10 00 00 00 01 DA 10 00 01 9A 1C 00' + 'DB 10 00 00 00 01 DB 10 00 01 9B 1C 00 DC 10 00 00 00 01 DC 10 00 01 9C 1C 00 DD 10 00 00 00 01' + 'DD 10 00 01 9D 1C 00 DE 10 00 00 00 01 DE 10 00 01 9E 1C 00 DF 10 00 00 00 01 DF 10 00 01 9F 1C' + '00 E0 10 00 00 00 01 E0 10 00 01 A0 1C 00 E1 10 00 00 00 01 E1 10 00 01 A1 1C 00 E2 10 00 00 00' + '01 E2 10 00 01 A2 1C 00 E3 10 00 00 00 01 E3 10 00 01 A3 1C 00 E4 10 00 00 00 01 E4 10 00 01 A4' + '1C 00 E5 10 00 00 00 01 E5 10 00 01 A5 1C 00 E6 10 00 00 00 01 E6 10 00 01 A6 1C 00 E7 10 00 00' + '00 01 E7 10 00 01 A7 1C 00 E8 10 00 00 00 01 E8 10 00 01 A8 1C 00 E9 10 00 00 00 01 E9 10 00 01' + 'A9 1C 00 EA 10 00 00 00 01 EA 10 00 01 AA 1C 00 EB 10 00 00 00 01 EB 10 00 01 AB 1C 00 EC 10 00' + '00 00 01 EC 10 00 01 AC 1C 00 ED 10 00 00 00 01 ED 10 00 01 AD 1C 00 EE 10 00 00 00 01 EE 10 00' + '01 AE 1C 00 EF 10 00 00 00 01 EF 10 00 01 AF 1C 00 F0 10 00 00 00 01 F0 10 00 01 B0 1C 00 F1 10' + '00 00 00 01 F1 10 00 01 B1 1C 00 F2 10 00 00 00 01 F2 10 00 01 B2 1C 00 F3 10 00 00 00 01 F3 10' + '00 01 B3 1C 00 F4 10 00 00 00 01 F4 10 00 01 B4 1C 00 F5 10 00 00 00 01 F5 10 00 01 B5 1C 00 F6' + '10 00 00 00 01 F6 10 00 01 B6 1C 00 F7 10 00 00 00 01 F7 10 00 01 B7 1C 00 F8 10 00 00 00 01 F8' + '10 00 01 B8 1C 00 F9 10 00 00 00 01 F9 10 00 01 B9 1C 00 FA 10 00 00 00 01 FA 10 00 01 BA 1C 00' + 'FD 10 00 00 00 01 FD 10 00 01 BD 1C 00 FE 10 00 00 00 01 FE 10 00 01 BE 1C 00 FF 10 00 00 00 01' + 'FF 10 00 01 BF 1C 00 A0 13 00 00 01 70 AB 00 00 00 A1 13 00 00 01 71 AB 00 00 00 A2 13 00 00 01' + '72 AB 00 00 00 A3 13 00 00 01 73 AB 00 00 00 A4 13 00 00 01 74 AB 00 00 00 A5 13 00 00 01 75 AB' + '00 00 00 A6 13 00 00 01 76 AB 00 00 00 A7 13 00 00 01 77 AB 00 00 00 A8 13 00 00 01 78 AB 00 00' + '00 A9 13 00 00 01 79 AB 00 00 00 AA 13 00 00 01 7A AB 00 00 00 AB 13 00 00 01 7B AB 00 00 00 AC' + '13 00 00 01 7C AB 00 00 00 AD 13 00 00 01 7D AB 00 00 00 AE 13 00 00 01 7E AB 00 00 00 AF 13 00' + '00 01 7F AB 00 00 00 B0 13 00 00 01 80 AB 00 00 00 B1 13 00 00 01 81 AB 00 00 00 B2 13 00 00 01' + '82 AB 00 00 00 B3 13 00 00 01 83 AB 00 00 00 B4 13 00 00 01 84 AB 00 00 00 B5 13 00 00 01 85 AB' + '00 00 00 B6 13 00 00 01 86 AB 00 00 00 B7 13 00 00 01 87 AB 00 00 00 B8 13 00 00 01 88 AB 00 00' + '00 B9 13 00 00 01 89 AB 00 00 00 BA 13 00 00 01 8A AB 00 00 00 BB 13 00 00 01 8B AB 00 00 00 BC' + '13 00 00 01 8C AB 00 00 00 BD 13 00 00 01 8D AB 00 00 00 BE 13 00 00 01 8E AB 00 00 00 BF 13 00' + '00 01 8F AB 00 00 00 C0 13 00 00 01 90 AB 00 00 00 C1 13 00 00 01 91 AB 00 00 00 C2 13 00 00 01' + '92 AB 00 00 00 C3 13 00 00 01 93 AB 00 00 00 C4 13 00 00 01 94 AB 00 00 00 C5 13 00 00 01 95 AB' + '00 00 00 C6 13 00 00 01 96 AB 00 00 00 C7 13 00 00 01 97 AB 00 00 00 C8 13 00 00 01 98 AB 00 00' + '00 C9 13 00 00 01 99 AB 00 00 00 CA 13 00 00 01 9A AB 00 00 00 CB 13 00 00 01 9B AB 00 00 00 CC' + '13 00 00 01 9C AB 00 00 00 CD 13 00 00 01 9D AB 00 00 00 CE 13 00 00 01 9E AB 00 00 00 CF 13 00' + '00 01 9F AB 00 00 00 D0 13 00 00 01 A0 AB 00 00 00 D1 13 00 00 01 A1 AB 00 00 00 D2 13 00 00 01' + 'A2 AB 00 00 00 D3 13 00 00 01 A3 AB 00 00 00 D4 13 00 00 01 A4 AB 00 00 00 D5 13 00 00 01 A5 AB' + '00 00 00 D6 13 00 00 01 A6 AB 00 00 00 D7 13 00 00 01 A7 AB 00 00 00 D8 13 00 00 01 A8 AB 00 00' + '00 D9 13 00 00 01 A9 AB 00 00 00 DA 13 00 00 01 AA AB 00 00 00 DB 13 00 00 01 AB AB 00 00 00 DC' + '13 00 00 01 AC AB 00 00 00 DD 13 00 00 01 AD AB 00 00 00 DE 13 00 00 01 AE AB 00 00 00 DF 13 00' + '00 01 AF AB 00 00 00 E0 13 00 00 01 B0 AB 00 00 00 E1 13 00 00 01 B1 AB 00 00 00 E2 13 00 00 01' + 'B2 AB 00 00 00 E3 13 00 00 01 B3 AB 00 00 00 E4 13 00 00 01 B4 AB 00 00 00 E5 13 00 00 01 B5 AB' + '00 00 00 E6 13 00 00 01 B6 AB 00 00 00 E7 13 00 00 01 B7 AB 00 00 00 E8 13 00 00 01 B8 AB 00 00' + '00 E9 13 00 00 01 B9 AB 00 00 00 EA 13 00 00 01 BA AB 00 00 00 EB 13 00 00 01 BB AB 00 00 00 EC' + '13 00 00 01 BC AB 00 00 00 ED 13 00 00 01 BD AB 00 00 00 EE 13 00 00 01 BE AB 00 00 00 EF 13 00' + '00 01 BF AB 00 00 00 F0 13 00 00 01 F8 13 00 00 00 F1 13 00 00 01 F9 13 00 00 00 F2 13 00 00 01' + 'FA 13 00 00 00 F3 13 00 00 01 FB 13 00 00 00 F4 13 00 00 01 FC 13 00 00 00 F5 13 00 00 01 FD 13' + '00 00 00 F8 13 00 01 F0 13 00 00 01 F0 13 00 01 F0 13 00 F9 13 00 01 F1 13 00 00 01 F1 13 00 01' + 'F1 13 00 FA 13 00 01 F2 13 00 00 01 F2 13 00 01 F2 13 00 FB 13 00 01 F3 13 00 00 01 F3 13 00 01' + 'F3 13 00 FC 13 00 01 F4 13 00 00 01 F4 13 00 01 F4 13 00 FD 13 00 01 F5 13 00 00 01 F5 13 00 01' + 'F5 13 00 80 1C 00 01 32 04 00 00 01 12 04 00 01 12 04 00 81 1C 00 01 34 04 00 00 01 14 04 00 01' + '14 04 00 82 1C 00 01 3E 04 00 00 01 1E 04 00 01 1E 04 00 83 1C 00 01 41 04 00 00 01 21 04 00 01' + '21 04 00 84 1C 00 01 42 04 00 00 01 22 04 00 01 22 04 00 85 1C 00 01 42 04 00 00 01 22 04 00 01' + '22 04 00 86 1C 00 01 4A 04 00 00 01 2A 04 00 01 2A 04 00 87 1C 00 01 63 04 00 00 01 62 04 00 01' + '62 04 00 88 1C 00 01 4B A6 00 00 01 4A A6 00 01 4A A6 00 90 1C 00 01 D0 10 00 01 D0 10 00 00 00' + '91 1C 00 01 D1 10 00 01 D1 10 00 00 00 92 1C 00 01 D2 10 00 01 D2 10 00 00 00 93 1C 00 01 D3 10' + '00 01 D3 10 00 00 00 94 1C 00 01 D4 10 00 01 D4 10 00 00 00 95 1C 00 01 D5 10 00 01 D5 10 00 00' + '00 96 1C 00 01 D6 10 00 01 D6 10 00 00 00 97 1C 00 01 D7 10 00 01 D7 10 00 00 00 98 1C 00 01 D8' + '10 00 01 D8 10 00 00 00 99 1C 00 01 D9 10 00 01 D9 10 00 00 00 9A 1C 00 01 DA 10 00 01 DA 10 00' + '00 00 9B 1C 00 01 DB 10 00 01 DB 10 00 00 00 9C 1C 00 01 DC 10 00 01 DC 10 00 00 00 9D 1C 00 01' + 'DD 10 00 01 DD 10 00 00 00 9E 1C 00 01 DE 10 00 01 DE 10 00 00 00 9F 1C 00 01 DF 10 00 01 DF 10' + '00 00 00 A0 1C 00 01 E0 10 00 01 E0 10 00 00 00 A1 1C 00 01 E1 10 00 01 E1 10 00 00 00 A2 1C 00' + '01 E2 10 00 01 E2 10 00 00 00 A3 1C 00 01 E3 10 00 01 E3 10 00 00 00 A4 1C 00 01 E4 10 00 01 E4' + '10 00 00 00 A5 1C 00 01 E5 10 00 01 E5 10 00 00 00 A6 1C 00 01 E6 10 00 01 E6 10 00 00 00 A7 1C' + '00 01 E7 10 00 01 E7 10 00 00 00 A8 1C 00 01 E8 10 00 01 E8 10 00 00 00 A9 1C 00 01 E9 10 00 01' + 'E9 10 00 00 00 AA 1C 00 01 EA 10 00 01 EA 10 00 00 00 AB 1C 00 01 EB 10 00 01 EB 10 00 00 00 AC' + '1C 00 01 EC 10 00 01 EC 10 00 00 00 AD 1C 00 01 ED 10 00 01 ED 10 00 00 00 AE 1C 00 01 EE 10 00' + '01 EE 10 00 00 00 AF 1C 00 01 EF 10 00 01 EF 10 00 00 00 B0 1C 00 01 F0 10 00 01 F0 10 00 00 00' + 'B1 1C 00 01 F1 10 00 01 F1 10 00 00 00 B2 1C 00 01 F2 10 00 01 F2 10 00 00 00 B3 1C 00 01 F3 10' + '00 01 F3 10 00 00 00 B4 1C 00 01 F4 10 00 01 F4 10 00 00 00 B5 1C 00 01 F5 10 00 01 F5 10 00 00' + '00 B6 1C 00 01 F6 10 00 01 F6 10 00 00 00 B7 1C 00 01 F7 10 00 01 F7 10 00 00 00 B8 1C 00 01 F8' + '10 00 01 F8 10 00 00 00 B9 1C 00 01 F9 10 00 01 F9 10 00 00 00 BA 1C 00 01 FA 10 00 01 FA 10 00' + '00 00 BD 1C 00 01 FD 10 00 01 FD 10 00 00 00 BE 1C 00 01 FE 10 00 01 FE 10 00 00 00 BF 1C 00 01' + 'FF 10 00 01 FF 10 00 00 00 79 1D 00 00 00 01 7D A7 00 01 7D A7 00 7D 1D 00 00 00 01 63 2C 00 01' + '63 2C 00 8E 1D 00 00 00 01 C6 A7 00 01 C6 A7 00 00 1E 00 01 01 1E 00 01 01 1E 00 00 00 01 1E 00' + '00 00 01 00 1E 00 01 00 1E 00 02 1E 00 01 03 1E 00 01 03 1E 00 00 00 03 1E 00 00 00 01 02 1E 00' + '01 02 1E 00 04 1E 00 01 05 1E 00 01 05 1E 00 00 00 05 1E 00 00 00 01 04 1E 00 01 04 1E 00 06 1E' + '00 01 07 1E 00 01 07 1E 00 00 00 07 1E 00 00 00 01 06 1E 00 01 06 1E 00 08 1E 00 01 09 1E 00 01' + '09 1E 00 00 00 09 1E 00 00 00 01 08 1E 00 01 08 1E 00 0A 1E 00 01 0B 1E 00 01 0B 1E 00 00 00 0B' + '1E 00 00 00 01 0A 1E 00 01 0A 1E 00 0C 1E 00 01 0D 1E 00 01 0D 1E 00 00 00 0D 1E 00 00 00 01 0C' + '1E 00 01 0C 1E 00 0E 1E 00 01 0F 1E 00 01 0F 1E 00 00 00 0F 1E 00 00 00 01 0E 1E 00 01 0E 1E 00' + '10 1E 00 01 11 1E 00 01 11 1E 00 00 00 11 1E 00 00 00 01 10 1E 00 01 10 1E 00 12 1E 00 01 13 1E' + '00 01 13 1E 00 00 00 13 1E 00 00 00 01 12 1E 00 01 12 1E 00 14 1E 00 01 15 1E 00 01 15 1E 00 00' + '00 15 1E 00 00 00 01 14 1E 00 01 14 1E 00 16 1E 00 01 17 1E 00 01 17 1E 00 00 00 17 1E 00 00 00' + '01 16 1E 00 01 16 1E 00 18 1E 00 01 19 1E 00 01 19 1E 00 00 00 19 1E 00 00 00 01 18 1E 00 01 18' + '1E 00 1A 1E 00 01 1B 1E 00 01 1B 1E 00 00 00 1B 1E 00 00 00 01 1A 1E 00 01 1A 1E 00 1C 1E 00 01' + '1D 1E 00 01 1D 1E 00 00 00 1D 1E 00 00 00 01 1C 1E 00 01 1C 1E 00 1E 1E 00 01 1F 1E 00 01 1F 1E' + '00 00 00 1F 1E 00 00 00 01 1E 1E 00 01 1E 1E 00 20 1E 00 01 21 1E 00 01 21 1E 00 00 00 21 1E 00' + '00 00 01 20 1E 00 01 20 1E 00 22 1E 00 01 23 1E 00 01 23 1E 00 00 00 23 1E 00 00 00 01 22 1E 00' + '01 22 1E 00 24 1E 00 01 25 1E 00 01 25 1E 00 00 00 25 1E 00 00 00 01 24 1E 00 01 24 1E 00 26 1E' + '00 01 27 1E 00 01 27 1E 00 00 00 27 1E 00 00 00 01 26 1E 00 01 26 1E 00 28 1E 00 01 29 1E 00 01' + '29 1E 00 00 00 29 1E 00 00 00 01 28 1E 00 01 28 1E 00 2A 1E 00 01 2B 1E 00 01 2B 1E 00 00 00 2B' + '1E 00 00 00 01 2A 1E 00 01 2A 1E 00 2C 1E 00 01 2D 1E 00 01 2D 1E 00 00 00 2D 1E 00 00 00 01 2C' + '1E 00 01 2C 1E 00 2E 1E 00 01 2F 1E 00 01 2F 1E 00 00 00 2F 1E 00 00 00 01 2E 1E 00 01 2E 1E 00' + '30 1E 00 01 31 1E 00 01 31 1E 00 00 00 31 1E 00 00 00 01 30 1E 00 01 30 1E 00 32 1E 00 01 33 1E' + '00 01 33 1E 00 00 00 33 1E 00 00 00 01 32 1E 00 01 32 1E 00 34 1E 00 01 35 1E 00 01 35 1E 00 00' + '00 35 1E 00 00 00 01 34 1E 00 01 34 1E 00 36 1E 00 01 37 1E 00 01 37 1E 00 00 00 37 1E 00 00 00' + '01 36 1E 00 01 36 1E 00 38 1E 00 01 39 1E 00 01 39 1E 00 00 00 39 1E 00 00 00 01 38 1E 00 01 38' + '1E 00 3A 1E 00 01 3B 1E 00 01 3B 1E 00 00 00 3B 1E 00 00 00 01 3A 1E 00 01 3A 1E 00 3C 1E 00 01' + '3D 1E 00 01 3D 1E 00 00 00 3D 1E 00 00 00 01 3C 1E 00 01 3C 1E 00 3E 1E 00 01 3F 1E 00 01 3F 1E' + '00 00 00 3F 1E 00 00 00 01 3E 1E 00 01 3E 1E 00 40 1E 00 01 41 1E 00 01 41 1E 00 00 00 41 1E 00' + '00 00 01 40 1E 00 01 40 1E 00 42 1E 00 01 43 1E 00 01 43 1E 00 00 00 43 1E 00 00 00 01 42 1E 00' + '01 42 1E 00 44 1E 00 01 45 1E 00 01 45 1E 00 00 00 45 1E 00 00 00 01 44 1E 00 01 44 1E 00 46 1E' + '00 01 47 1E 00 01 47 1E 00 00 00 47 1E 00 00 00 01 46 1E 00 01 46 1E 00 48 1E 00 01 49 1E 00 01' + '49 1E 00 00 00 49 1E 00 00 00 01 48 1E 00 01 48 1E 00 4A 1E 00 01 4B 1E 00 01 4B 1E 00 00 00 4B' + '1E 00 00 00 01 4A 1E 00 01 4A 1E 00 4C 1E 00 01 4D 1E 00 01 4D 1E 00 00 00 4D 1E 00 00 00 01 4C' + '1E 00 01 4C 1E 00 4E 1E 00 01 4F 1E 00 01 4F 1E 00 00 00 4F 1E 00 00 00 01 4E 1E 00 01 4E 1E 00' + '50 1E 00 01 51 1E 00 01 51 1E 00 00 00 51 1E 00 00 00 01 50 1E 00 01 50 1E 00 52 1E 00 01 53 1E' + '00 01 53 1E 00 00 00 53 1E 00 00 00 01 52 1E 00 01 52 1E 00 54 1E 00 01 55 1E 00 01 55 1E 00 00' + '00 55 1E 00 00 00 01 54 1E 00 01 54 1E 00 56 1E 00 01 57 1E 00 01 57 1E 00 00 00 57 1E 00 00 00' + '01 56 1E 00 01 56 1E 00 58 1E 00 01 59 1E 00 01 59 1E 00 00 00 59 1E 00 00 00 01 58 1E 00 01 58' + '1E 00 5A 1E 00 01 5B 1E 00 01 5B 1E 00 00 00 5B 1E 00 00 00 01 5A 1E 00 01 5A 1E 00 5C 1E 00 01' + '5D 1E 00 01 5D 1E 00 00 00 5D 1E 00 00 00 01 5C 1E 00 01 5C 1E 00 5E 1E 00 01 5F 1E 00 01 5F 1E' + '00 00 00 5F 1E 00 00 00 01 5E 1E 00 01 5E 1E 00 60 1E 00 01 61 1E 00 01 61 1E 00 00 00 61 1E 00' + '00 00 01 60 1E 00 01 60 1E 00 62 1E 00 01 63 1E 00 01 63 1E 00 00 00 63 1E 00 00 00 01 62 1E 00' + '01 62 1E 00 64 1E 00 01 65 1E 00 01 65 1E 00 00 00 65 1E 00 00 00 01 64 1E 00 01 64 1E 00 66 1E' + '00 01 67 1E 00 01 67 1E 00 00 00 67 1E 00 00 00 01 66 1E 00 01 66 1E 00 68 1E 00 01 69 1E 00 01' + '69 1E 00 00 00 69 1E 00 00 00 01 68 1E 00 01 68 1E 00 6A 1E 00 01 6B 1E 00 01 6B 1E 00 00 00 6B' + '1E 00 00 00 01 6A 1E 00 01 6A 1E 00 6C 1E 00 01 6D 1E 00 01 6D 1E 00 00 00 6D 1E 00 00 00 01 6C' + '1E 00 01 6C 1E 00 6E 1E 00 01 6F 1E 00 01 6F 1E 00 00 00 6F 1E 00 00 00 01 6E 1E 00 01 6E 1E 00' + '70 1E 00 01 71 1E 00 01 71 1E 00 00 00 71 1E 00 00 00 01 70 1E 00 01 70 1E 00 72 1E 00 01 73 1E' + '00 01 73 1E 00 00 00 73 1E 00 00 00 01 72 1E 00 01 72 1E 00 74 1E 00 01 75 1E 00 01 75 1E 00 00' + '00 75 1E 00 00 00 01 74 1E 00 01 74 1E 00 76 1E 00 01 77 1E 00 01 77 1E 00 00 00 77 1E 00 00 00' + '01 76 1E 00 01 76 1E 00 78 1E 00 01 79 1E 00 01 79 1E 00 00 00 79 1E 00 00 00 01 78 1E 00 01 78' + '1E 00 7A 1E 00 01 7B 1E 00 01 7B 1E 00 00 00 7B 1E 00 00 00 01 7A 1E 00 01 7A 1E 00 7C 1E 00 01' + '7D 1E 00 01 7D 1E 00 00 00 7D 1E 00 00 00 01 7C 1E 00 01 7C 1E 00 7E 1E 00 01 7F 1E 00 01 7F 1E' + '00 00 00 7F 1E 00 00 00 01 7E 1E 00 01 7E 1E 00 80 1E 00 01 81 1E 00 01 81 1E 00 00 00 81 1E 00' + '00 00 01 80 1E 00 01 80 1E 00 82 1E 00 01 83 1E 00 01 83 1E 00 00 00 83 1E 00 00 00 01 82 1E 00' + '01 82 1E 00 84 1E 00 01 85 1E 00 01 85 1E 00 00 00 85 1E 00 00 00 01 84 1E 00 01 84 1E 00 86 1E' + '00 01 87 1E 00 01 87 1E 00 00 00 87 1E 00 00 00 01 86 1E 00 01 86 1E 00 88 1E 00 01 89 1E 00 01' + '89 1E 00 00 00 89 1E 00 00 00 01 88 1E 00 01 88 1E 00 8A 1E 00 01 8B 1E 00 01 8B 1E 00 00 00 8B' + '1E 00 00 00 01 8A 1E 00 01 8A 1E 00 8C 1E 00 01 8D 1E 00 01 8D 1E 00 00 00 8D 1E 00 00 00 01 8C' + '1E 00 01 8C 1E 00 8E 1E 00 01 8F 1E 00 01 8F 1E 00 00 00 8F 1E 00 00 00 01 8E 1E 00 01 8E 1E 00' + '90 1E 00 01 91 1E 00 01 91 1E 00 00 00 91 1E 00 00 00 01 90 1E 00 01 90 1E 00 92 1E 00 01 93 1E' + '00 01 93 1E 00 00 00 93 1E 00 00 00 01 92 1E 00 01 92 1E 00 94 1E 00 01 95 1E 00 01 95 1E 00 00' + '00 95 1E 00 00 00 01 94 1E 00 01 94 1E 00 96 1E 00 02 68 00 00 31 03 00 01 96 1E 00 02 48 00 00' + '31 03 00 02 48 00 00 31 03 00 97 1E 00 02 74 00 00 08 03 00 01 97 1E 00 02 54 00 00 08 03 00 02' + '54 00 00 08 03 00 98 1E 00 02 77 00 00 0A 03 00 01 98 1E 00 02 57 00 00 0A 03 00 02 57 00 00 0A' + '03 00 99 1E 00 02 79 00 00 0A 03 00 01 99 1E 00 02 59 00 00 0A 03 00 02 59 00 00 0A 03 00 9A 1E' + '00 02 61 00 00 BE 02 00 01 9A 1E 00 02 41 00 00 BE 02 00 02 41 00 00 BE 02 00 9B 1E 00 01 61 1E' + '00 00 01 60 1E 00 01 60 1E 00 9E 1E 00 02 73 00 00 73 00 00 01 DF 00 00 00 00 A0 1E 00 01 A1 1E' + '00 01 A1 1E 00 00 00 A1 1E 00 00 00 01 A0 1E 00 01 A0 1E 00 A2 1E 00 01 A3 1E 00 01 A3 1E 00 00' + '00 A3 1E 00 00 00 01 A2 1E 00 01 A2 1E 00 A4 1E 00 01 A5 1E 00 01 A5 1E 00 00 00 A5 1E 00 00 00' + '01 A4 1E 00 01 A4 1E 00 A6 1E 00 01 A7 1E 00 01 A7 1E 00 00 00 A7 1E 00 00 00 01 A6 1E 00 01 A6' + '1E 00 A8 1E 00 01 A9 1E 00 01 A9 1E 00 00 00 A9 1E 00 00 00 01 A8 1E 00 01 A8 1E 00 AA 1E 00 01' + 'AB 1E 00 01 AB 1E 00 00 00 AB 1E 00 00 00 01 AA 1E 00 01 AA 1E 00 AC 1E 00 01 AD 1E 00 01 AD 1E' + '00 00 00 AD 1E 00 00 00 01 AC 1E 00 01 AC 1E 00 AE 1E 00 01 AF 1E 00 01 AF 1E 00 00 00 AF 1E 00' + '00 00 01 AE 1E 00 01 AE 1E 00 B0 1E 00 01 B1 1E 00 01 B1 1E 00 00 00 B1 1E 00 00 00 01 B0 1E 00' + '01 B0 1E 00 B2 1E 00 01 B3 1E 00 01 B3 1E 00 00 00 B3 1E 00 00 00 01 B2 1E 00 01 B2 1E 00 B4 1E' + '00 01 B5 1E 00 01 B5 1E 00 00 00 B5 1E 00 00 00 01 B4 1E 00 01 B4 1E 00 B6 1E 00 01 B7 1E 00 01' + 'B7 1E 00 00 00 B7 1E 00 00 00 01 B6 1E 00 01 B6 1E 00 B8 1E 00 01 B9 1E 00 01 B9 1E 00 00 00 B9' + '1E 00 00 00 01 B8 1E 00 01 B8 1E 00 BA 1E 00 01 BB 1E 00 01 BB 1E 00 00 00 BB 1E 00 00 00 01 BA' + '1E 00 01 BA 1E 00 BC 1E 00 01 BD 1E 00 01 BD 1E 00 00 00 BD 1E 00 00 00 01 BC 1E 00 01 BC 1E 00' + 'BE 1E 00 01 BF 1E 00 01 BF 1E 00 00 00 BF 1E 00 00 00 01 BE 1E 00 01 BE 1E 00 C0 1E 00 01 C1 1E' + '00 01 C1 1E 00 00 00 C1 1E 00 00 00 01 C0 1E 00 01 C0 1E 00 C2 1E 00 01 C3 1E 00 01 C3 1E 00 00' + '00 C3 1E 00 00 00 01 C2 1E 00 01 C2 1E 00 C4 1E 00 01 C5 1E 00 01 C5 1E 00 00 00 C5 1E 00 00 00' + '01 C4 1E 00 01 C4 1E 00 C6 1E 00 01 C7 1E 00 01 C7 1E 00 00 00 C7 1E 00 00 00 01 C6 1E 00 01 C6' + '1E 00 C8 1E 00 01 C9 1E 00 01 C9 1E 00 00 00 C9 1E 00 00 00 01 C8 1E 00 01 C8 1E 00 CA 1E 00 01' + 'CB 1E 00 01 CB 1E 00 00 00 CB 1E 00 00 00 01 CA 1E 00 01 CA 1E 00 CC 1E 00 01 CD 1E 00 01 CD 1E' + '00 00 00 CD 1E 00 00 00 01 CC 1E 00 01 CC 1E 00 CE 1E 00 01 CF 1E 00 01 CF 1E 00 00 00 CF 1E 00' + '00 00 01 CE 1E 00 01 CE 1E 00 D0 1E 00 01 D1 1E 00 01 D1 1E 00 00 00 D1 1E 00 00 00 01 D0 1E 00' + '01 D0 1E 00 D2 1E 00 01 D3 1E 00 01 D3 1E 00 00 00 D3 1E 00 00 00 01 D2 1E 00 01 D2 1E 00 D4 1E' + '00 01 D5 1E 00 01 D5 1E 00 00 00 D5 1E 00 00 00 01 D4 1E 00 01 D4 1E 00 D6 1E 00 01 D7 1E 00 01' + 'D7 1E 00 00 00 D7 1E 00 00 00 01 D6 1E 00 01 D6 1E 00 D8 1E 00 01 D9 1E 00 01 D9 1E 00 00 00 D9' + '1E 00 00 00 01 D8 1E 00 01 D8 1E 00 DA 1E 00 01 DB 1E 00 01 DB 1E 00 00 00 DB 1E 00 00 00 01 DA' + '1E 00 01 DA 1E 00 DC 1E 00 01 DD 1E 00 01 DD 1E 00 00 00 DD 1E 00 00 00 01 DC 1E 00 01 DC 1E 00' + 'DE 1E 00 01 DF 1E 00 01 DF 1E 00 00 00 DF 1E 00 00 00 01 DE 1E 00 01 DE 1E 00 E0 1E 00 01 E1 1E' + '00 01 E1 1E 00 00 00 E1 1E 00 00 00 01 E0 1E 00 01 E0 1E 00 E2 1E 00 01 E3 1E 00 01 E3 1E 00 00' + '00 E3 1E 00 00 00 01 E2 1E 00 01 E2 1E 00 E4 1E 00 01 E5 1E 00 01 E5 1E 00 00 00 E5 1E 00 00 00' + '01 E4 1E 00 01 E4 1E 00 E6 1E 00 01 E7 1E 00 01 E7 1E 00 00 00 E7 1E 00 00 00 01 E6 1E 00 01 E6' + '1E 00 E8 1E 00 01 E9 1E 00 01 E9 1E 00 00 00 E9 1E 00 00 00 01 E8 1E 00 01 E8 1E 00 EA 1E 00 01' + 'EB 1E 00 01 EB 1E 00 00 00 EB 1E 00 00 00 01 EA 1E 00 01 EA 1E 00 EC 1E 00 01 ED 1E 00 01 ED 1E' + '00 00 00 ED 1E 00 00 00 01 EC 1E 00 01 EC 1E 00 EE 1E 00 01 EF 1E 00 01 EF 1E 00 00 00 EF 1E 00' + '00 00 01 EE 1E 00 01 EE 1E 00 F0 1E 00 01 F1 1E 00 01 F1 1E 00 00 00 F1 1E 00 00 00 01 F0 1E 00' + '01 F0 1E 00 F2 1E 00 01 F3 1E 00 01 F3 1E 00 00 00 F3 1E 00 00 00 01 F2 1E 00 01 F2 1E 00 F4 1E' + '00 01 F5 1E 00 01 F5 1E 00 00 00 F5 1E 00 00 00 01 F4 1E 00 01 F4 1E 00 F6 1E 00 01 F7 1E 00 01' + 'F7 1E 00 00 00 F7 1E 00 00 00 01 F6 1E 00 01 F6 1E 00 F8 1E 00 01 F9 1E 00 01 F9 1E 00 00 00 F9' + '1E 00 00 00 01 F8 1E 00 01 F8 1E 00 FA 1E 00 01 FB 1E 00 01 FB 1E 00 00 00 FB 1E 00 00 00 01 FA' + '1E 00 01 FA 1E 00 FC 1E 00 01 FD 1E 00 01 FD 1E 00 00 00 FD 1E 00 00 00 01 FC 1E 00 01 FC 1E 00' + 'FE 1E 00 01 FF 1E 00 01 FF 1E 00 00 00 FF 1E 00 00 00 01 FE 1E 00 01 FE 1E 00 00 1F 00 00 00 01' + '08 1F 00 01 08 1F 00 01 1F 00 00 00 01 09 1F 00 01 09 1F 00 02 1F 00 00 00 01 0A 1F 00 01 0A 1F' + '00 03 1F 00 00 00 01 0B 1F 00 01 0B 1F 00 04 1F 00 00 00 01 0C 1F 00 01 0C 1F 00 05 1F 00 00 00' + '01 0D 1F 00 01 0D 1F 00 06 1F 00 00 00 01 0E 1F 00 01 0E 1F 00 07 1F 00 00 00 01 0F 1F 00 01 0F' + '1F 00 08 1F 00 01 00 1F 00 01 00 1F 00 00 00 09 1F 00 01 01 1F 00 01 01 1F 00 00 00 0A 1F 00 01' + '02 1F 00 01 02 1F 00 00 00 0B 1F 00 01 03 1F 00 01 03 1F 00 00 00 0C 1F 00 01 04 1F 00 01 04 1F' + '00 00 00 0D 1F 00 01 05 1F 00 01 05 1F 00 00 00 0E 1F 00 01 06 1F 00 01 06 1F 00 00 00 0F 1F 00' + '01 07 1F 00 01 07 1F 00 00 00 10 1F 00 00 00 01 18 1F 00 01 18 1F 00 11 1F 00 00 00 01 19 1F 00' + '01 19 1F 00 12 1F 00 00 00 01 1A 1F 00 01 1A 1F 00 13 1F 00 00 00 01 1B 1F 00 01 1B 1F 00 14 1F' + '00 00 00 01 1C 1F 00 01 1C 1F 00 15 1F 00 00 00 01 1D 1F 00 01 1D 1F 00 18 1F 00 01 10 1F 00 01' + '10 1F 00 00 00 19 1F 00 01 11 1F 00 01 11 1F 00 00 00 1A 1F 00 01 12 1F 00 01 12 1F 00 00 00 1B' + '1F 00 01 13 1F 00 01 13 1F 00 00 00 1C 1F 00 01 14 1F 00 01 14 1F 00 00 00 1D 1F 00 01 15 1F 00' + '01 15 1F 00 00 00 20 1F 00 00 00 01 28 1F 00 01 28 1F 00 21 1F 00 00 00 01 29 1F 00 01 29 1F 00' + '22 1F 00 00 00 01 2A 1F 00 01 2A 1F 00 23 1F 00 00 00 01 2B 1F 00 01 2B 1F 00 24 1F 00 00 00 01' + '2C 1F 00 01 2C 1F 00 25 1F 00 00 00 01 2D 1F 00 01 2D 1F 00 26 1F 00 00 00 01 2E 1F 00 01 2E 1F' + '00 27 1F 00 00 00 01 2F 1F 00 01 2F 1F 00 28 1F 00 01 20 1F 00 01 20 1F 00 00 00 29 1F 00 01 21' + '1F 00 01 21 1F 00 00 00 2A 1F 00 01 22 1F 00 01 22 1F 00 00 00 2B 1F 00 01 23 1F 00 01 23 1F 00' + '00 00 2C 1F 00 01 24 1F 00 01 24 1F 00 00 00 2D 1F 00 01 25 1F 00 01 25 1F 00 00 00 2E 1F 00 01' + '26 1F 00 01 26 1F 00 00 00 2F 1F 00 01 27 1F 00 01 27 1F 00 00 00 30 1F 00 00 00 01 38 1F 00 01' + '38 1F 00 31 1F 00 00 00 01 39 1F 00 01 39 1F 00 32 1F 00 00 00 01 3A 1F 00 01 3A 1F 00 33 1F 00' + '00 00 01 3B 1F 00 01 3B 1F 00 34 1F 00 00 00 01 3C 1F 00 01 3C 1F 00 35 1F 00 00 00 01 3D 1F 00' + '01 3D 1F 00 36 1F 00 00 00 01 3E 1F 00 01 3E 1F 00 37 1F 00 00 00 01 3F 1F 00 01 3F 1F 00 38 1F' + '00 01 30 1F 00 01 30 1F 00 00 00 39 1F 00 01 31 1F 00 01 31 1F 00 00 00 3A 1F 00 01 32 1F 00 01' + '32 1F 00 00 00 3B 1F 00 01 33 1F 00 01 33 1F 00 00 00 3C 1F 00 01 34 1F 00 01 34 1F 00 00 00 3D' + '1F 00 01 35 1F 00 01 35 1F 00 00 00 3E 1F 00 01 36 1F 00 01 36 1F 00 00 00 3F 1F 00 01 37 1F 00' + '01 37 1F 00 00 00 40 1F 00 00 00 01 48 1F 00 01 48 1F 00 41 1F 00 00 00 01 49 1F 00 01 49 1F 00' + '42 1F 00 00 00 01 4A 1F 00 01 4A 1F 00 43 1F 00 00 00 01 4B 1F 00 01 4B 1F 00 44 1F 00 00 00 01' + '4C 1F 00 01 4C 1F 00 45 1F 00 00 00 01 4D 1F 00 01 4D 1F 00 48 1F 00 01 40 1F 00 01 40 1F 00 00' + '00 49 1F 00 01 41 1F 00 01 41 1F 00 00 00 4A 1F 00 01 42 1F 00 01 42 1F 00 00 00 4B 1F 00 01 43' + '1F 00 01 43 1F 00 00 00 4C 1F 00 01 44 1F 00 01 44 1F 00 00 00 4D 1F 00 01 45 1F 00 01 45 1F 00' + '00 00 50 1F 00 02 C5 03 00 13 03 00 01 50 1F 00 02 A5 03 00 13 03 00 02 A5 03 00 13 03 00 51 1F' + '00 00 00 01 59 1F 00 01 59 1F 00 52 1F 00 03 C5 03 00 13 03 00 00 03 00 01 52 1F 00 03 A5 03 00' + '13 03 00 00 03 00 03 A5 03 00 13 03 00 00 03 00 53 1F 00 00 00 01 5B 1F 00 01 5B 1F 00 54 1F 00' + '03 C5 03 00 13 03 00 01 03 00 01 54 1F 00 03 A5 03 00 13 03 00 01 03 00 03 A5 03 00 13 03 00 01' + '03 00 55 1F 00 00 00 01 5D 1F 00 01 5D 1F 00 56 1F 00 03 C5 03 00 13 03 00 42 03 00 01 56 1F 00' + '03 A5 03 00 13 03 00 42 03 00 03 A5 03 00 13 03 00 42 03 00 57 1F 00 00 00 01 5F 1F 00 01 5F 1F' + '00 59 1F 00 01 51 1F 00 01 51 1F 00 00 00 5B 1F 00 01 53 1F 00 01 53 1F 00 00 00 5D 1F 00 01 55' + '1F 00 01 55 1F 00 00 00 5F 1F 00 01 57 1F 00 01 57 1F 00 00 00 60 1F 00 00 00 01 68 1F 00 01 68' + '1F 00 61 1F 00 00 00 01 69 1F 00 01 69 1F 00 62 1F 00 00 00 01 6A 1F 00 01 6A 1F 00 63 1F 00 00' + '00 01 6B 1F 00 01 6B 1F 00 64 1F 00 00 00 01 6C 1F 00 01 6C 1F 00 65 1F 00 00 00 01 6D 1F 00 01' + '6D 1F 00 66 1F 00 00 00 01 6E 1F 00 01 6E 1F 00 67 1F 00 00 00 01 6F 1F 00 01 6F 1F 00 68 1F 00' + '01 60 1F 00 01 60 1F 00 00 00 69 1F 00 01 61 1F 00 01 61 1F 00 00 00 6A 1F 00 01 62 1F 00 01 62' + '1F 00 00 00 6B 1F 00 01 63 1F 00 01 63 1F 00 00 00 6C 1F 00 01 64 1F 00 01 64 1F 00 00 00 6D 1F' + '00 01 65 1F 00 01 65 1F 00 00 00 6E 1F 00 01 66 1F 00 01 66 1F 00 00 00 6F 1F 00 01 67 1F 00 01' + '67 1F 00 00 00 70 1F 00 00 00 01 BA 1F 00 01 BA 1F 00 71 1F 00 00 00 01 BB 1F 00 01 BB 1F 00 72' + '1F 00 00 00 01 C8 1F 00 01 C8 1F 00 73 1F 00 00 00 01 C9 1F 00 01 C9 1F 00 74 1F 00 00 00 01 CA' + '1F 00 01 CA 1F 00 75 1F 00 00 00 01 CB 1F 00 01 CB 1F 00 76 1F 00 00 00 01 DA 1F 00 01 DA 1F 00' + '77 1F 00 00 00 01 DB 1F 00 01 DB 1F 00 78 1F 00 00 00 01 F8 1F 00 01 F8 1F 00 79 1F 00 00 00 01' + 'F9 1F 00 01 F9 1F 00 7A 1F 00 00 00 01 EA 1F 00 01 EA 1F 00 7B 1F 00 00 00 01 EB 1F 00 01 EB 1F' + '00 7C 1F 00 00 00 01 FA 1F 00 01 FA 1F 00 7D 1F 00 00 00 01 FB 1F 00 01 FB 1F 00 80 1F 00 02 00' + '1F 00 B9 03 00 01 80 1F 00 01 88 1F 00 01 88 1F 00 81 1F 00 02 01 1F 00 B9 03 00 01 81 1F 00 01' + '89 1F 00 01 89 1F 00 82 1F 00 02 02 1F 00 B9 03 00 01 82 1F 00 01 8A 1F 00 01 8A 1F 00 83 1F 00' + '02 03 1F 00 B9 03 00 01 83 1F 00 01 8B 1F 00 01 8B 1F 00 84 1F 00 02 04 1F 00 B9 03 00 01 84 1F' + '00 01 8C 1F 00 01 8C 1F 00 85 1F 00 02 05 1F 00 B9 03 00 01 85 1F 00 01 8D 1F 00 01 8D 1F 00 86' + '1F 00 02 06 1F 00 B9 03 00 01 86 1F 00 01 8E 1F 00 01 8E 1F 00 87 1F 00 02 07 1F 00 B9 03 00 01' + '87 1F 00 01 8F 1F 00 01 8F 1F 00 88 1F 00 02 00 1F 00 B9 03 00 01 80 1F 00 01 88 1F 00 02 08 1F' + '00 99 03 00 89 1F 00 02 01 1F 00 B9 03 00 01 81 1F 00 01 89 1F 00 02 09 1F 00 99 03 00 8A 1F 00' + '02 02 1F 00 B9 03 00 01 82 1F 00 01 8A 1F 00 02 0A 1F 00 99 03 00 8B 1F 00 02 03 1F 00 B9 03 00' + '01 83 1F 00 01 8B 1F 00 02 0B 1F 00 99 03 00 8C 1F 00 02 04 1F 00 B9 03 00 01 84 1F 00 01 8C 1F' + '00 02 0C 1F 00 99 03 00 8D 1F 00 02 05 1F 00 B9 03 00 01 85 1F 00 01 8D 1F 00 02 0D 1F 00 99 03' + '00 8E 1F 00 02 06 1F 00 B9 03 00 01 86 1F 00 01 8E 1F 00 02 0E 1F 00 99 03 00 8F 1F 00 02 07 1F' + '00 B9 03 00 01 87 1F 00 01 8F 1F 00 02 0F 1F 00 99 03 00 90 1F 00 02 20 1F 00 B9 03 00 01 90 1F' + '00 01 98 1F 00 01 98 1F 00 91 1F 00 02 21 1F 00 B9 03 00 01 91 1F 00 01 99 1F 00 01 99 1F 00 92' + '1F 00 02 22 1F 00 B9 03 00 01 92 1F 00 01 9A 1F 00 01 9A 1F 00 93 1F 00 02 23 1F 00 B9 03 00 01' + '93 1F 00 01 9B 1F 00 01 9B 1F 00 94 1F 00 02 24 1F 00 B9 03 00 01 94 1F 00 01 9C 1F 00 01 9C 1F' + '00 95 1F 00 02 25 1F 00 B9 03 00 01 95 1F 00 01 9D 1F 00 01 9D 1F 00 96 1F 00 02 26 1F 00 B9 03' + '00 01 96 1F 00 01 9E 1F 00 01 9E 1F 00 97 1F 00 02 27 1F 00 B9 03 00 01 97 1F 00 01 9F 1F 00 01' + '9F 1F 00 98 1F 00 02 20 1F 00 B9 03 00 01 90 1F 00 01 98 1F 00 02 28 1F 00 99 03 00 99 1F 00 02' + '21 1F 00 B9 03 00 01 91 1F 00 01 99 1F 00 02 29 1F 00 99 03 00 9A 1F 00 02 22 1F 00 B9 03 00 01' + '92 1F 00 01 9A 1F 00 02 2A 1F 00 99 03 00 9B 1F 00 02 23 1F 00 B9 03 00 01 93 1F 00 01 9B 1F 00' + '02 2B 1F 00 99 03 00 9C 1F 00 02 24 1F 00 B9 03 00 01 94 1F 00 01 9C 1F 00 02 2C 1F 00 99 03 00' + '9D 1F 00 02 25 1F 00 B9 03 00 01 95 1F 00 01 9D 1F 00 02 2D 1F 00 99 03 00 9E 1F 00 02 26 1F 00' + 'B9 03 00 01 96 1F 00 01 9E 1F 00 02 2E 1F 00 99 03 00 9F 1F 00 02 27 1F 00 B9 03 00 01 97 1F 00' + '01 9F 1F 00 02 2F 1F 00 99 03 00 A0 1F 00 02 60 1F 00 B9 03 00 01 A0 1F 00 01 A8 1F 00 01 A8 1F' + '00 A1 1F 00 02 61 1F 00 B9 03 00 01 A1 1F 00 01 A9 1F 00 01 A9 1F 00 A2 1F 00 02 62 1F 00 B9 03' + '00 01 A2 1F 00 01 AA 1F 00 01 AA 1F 00 A3 1F 00 02 63 1F 00 B9 03 00 01 A3 1F 00 01 AB 1F 00 01' + 'AB 1F 00 A4 1F 00 02 64 1F 00 B9 03 00 01 A4 1F 00 01 AC 1F 00 01 AC 1F 00 A5 1F 00 02 65 1F 00' + 'B9 03 00 01 A5 1F 00 01 AD 1F 00 01 AD 1F 00 A6 1F 00 02 66 1F 00 B9 03 00 01 A6 1F 00 01 AE 1F' + '00 01 AE 1F 00 A7 1F 00 02 67 1F 00 B9 03 00 01 A7 1F 00 01 AF 1F 00 01 AF 1F 00 A8 1F 00 02 60' + '1F 00 B9 03 00 01 A0 1F 00 01 A8 1F 00 02 68 1F 00 99 03 00 A9 1F 00 02 61 1F 00 B9 03 00 01 A1' + '1F 00 01 A9 1F 00 02 69 1F 00 99 03 00 AA 1F 00 02 62 1F 00 B9 03 00 01 A2 1F 00 01 AA 1F 00 02' + '6A 1F 00 99 03 00 AB 1F 00 02 63 1F 00 B9 03 00 01 A3 1F 00 01 AB 1F 00 02 6B 1F 00 99 03 00 AC' + '1F 00 02 64 1F 00 B9 03 00 01 A4 1F 00 01 AC 1F 00 02 6C 1F 00 99 03 00 AD 1F 00 02 65 1F 00 B9' + '03 00 01 A5 1F 00 01 AD 1F 00 02 6D 1F 00 99 03 00 AE 1F 00 02 66 1F 00 B9 03 00 01 A6 1F 00 01' + 'AE 1F 00 02 6E 1F 00 99 03 00 AF 1F 00 02 67 1F 00 B9 03 00 01 A7 1F 00 01 AF 1F 00 02 6F 1F 00' + '99 03 00 B0 1F 00 00 00 01 B8 1F 00 01 B8 1F 00 B1 1F 00 00 00 01 B9 1F 00 01 B9 1F 00 B2 1F 00' + '02 70 1F 00 B9 03 00 01 B2 1F 00 02 BA 1F 00 45 03 00 02 BA 1F 00 99 03 00 B3 1F 00 02 B1 03 00' + 'B9 03 00 01 B3 1F 00 01 BC 1F 00 01 BC 1F 00 B4 1F 00 02 AC 03 00 B9 03 00 01 B4 1F 00 02 86 03' + '00 45 03 00 02 86 03 00 99 03 00 B6 1F 00 02 B1 03 00 42 03 00 01 B6 1F 00 02 91 03 00 42 03 00' + '02 91 03 00 42 03 00 B7 1F 00 03 B1 03 00 42 03 00 B9 03 00 01 B7 1F 00 03 91 03 00 42 03 00 45' + '03 00 03 91 03 00 42 03 00 99 03 00 B8 1F 00 01 B0 1F 00 01 B0 1F 00 00 00 B9 1F 00 01 B1 1F 00' + '01 B1 1F 00 00 00 BA 1F 00 01 70 1F 00 01 70 1F 00 00 00 BB 1F 00 01 71 1F 00 01 71 1F 00 00 00' + 'BC 1F 00 02 B1 03 00 B9 03 00 01 B3 1F 00 01 BC 1F 00 02 91 03 00 99 03 00 BE 1F 00 01 B9 03 00' + '00 01 99 03 00 01 99 03 00 C2 1F 00 02 74 1F 00 B9 03 00 01 C2 1F 00 02 CA 1F 00 45 03 00 02 CA' + '1F 00 99 03 00 C3 1F 00 02 B7 03 00 B9 03 00 01 C3 1F 00 01 CC 1F 00 01 CC 1F 00 C4 1F 00 02 AE' + '03 00 B9 03 00 01 C4 1F 00 02 89 03 00 45 03 00 02 89 03 00 99 03 00 C6 1F 00 02 B7 03 00 42 03' + '00 01 C6 1F 00 02 97 03 00 42 03 00 02 97 03 00 42 03 00 C7 1F 00 03 B7 03 00 42 03 00 B9 03 00' + '01 C7 1F 00 03 97 03 00 42 03 00 45 03 00 03 97 03 00 42 03 00 99 03 00 C8 1F 00 01 72 1F 00 01' + '72 1F 00 00 00 C9 1F 00 01 73 1F 00 01 73 1F 00 00 00 CA 1F 00 01 74 1F 00 01 74 1F 00 00 00 CB' + '1F 00 01 75 1F 00 01 75 1F 00 00 00 CC 1F 00 02 B7 03 00 B9 03 00 01 C3 1F 00 01 CC 1F 00 02 97' + '03 00 99 03 00 D0 1F 00 00 00 01 D8 1F 00 01 D8 1F 00 D1 1F 00 00 00 01 D9 1F 00 01 D9 1F 00 D2' + '1F 00 03 B9 03 00 08 03 00 00 03 00 01 D2 1F 00 03 99 03 00 08 03 00 00 03 00 03 99 03 00 08 03' + '00 00 03 00 D3 1F 00 03 B9 03 00 08 03 00 01 03 00 01 D3 1F 00 03 99 03 00 08 03 00 01 03 00 03' + '99 03 00 08 03 00 01 03 00 D6 1F 00 02 B9 03 00 42 03 00 01 D6 1F 00 02 99 03 00 42 03 00 02 99' + '03 00 42 03 00 D7 1F 00 03 B9 03 00 08 03 00 42 03 00 01 D7 1F 00 03 99 03 00 08 03 00 42 03 00' + '03 99 03 00 08 03 00 42 03 00 D8 1F 00 01 D0 1F 00 01 D0 1F 00 00 00 D9 1F 00 01 D1 1F 00 01 D1' + '1F 00 00 00 DA 1F 00 01 76 1F 00 01 76 1F 00 00 00 DB 1F 00 01 77 1F 00 01 77 1F 00 00 00 E0 1F' + '00 00 00 01 E8 1F 00 01 E8 1F 00 E1 1F 00 00 00 01 E9 1F 00 01 E9 1F 00 E2 1F 00 03 C5 03 00 08' + '03 00 00 03 00 01 E2 1F 00 03 A5 03 00 08 03 00 00 03 00 03 A5 03 00 08 03 00 00 03 00 E3 1F 00' + '03 C5 03 00 08 03 00 01 03 00 01 E3 1F 00 03 A5 03 00 08 03 00 01 03 00 03 A5 03 00 08 03 00 01' + '03 00 E4 1F 00 02 C1 03 00 13 03 00 01 E4 1F 00 02 A1 03 00 13 03 00 02 A1 03 00 13 03 00 E5 1F' + '00 00 00 01 EC 1F 00 01 EC 1F 00 E6 1F 00 02 C5 03 00 42 03 00 01 E6 1F 00 02 A5 03 00 42 03 00' + '02 A5 03 00 42 03 00 E7 1F 00 03 C5 03 00 08 03 00 42 03 00 01 E7 1F 00 03 A5 03 00 08 03 00 42' + '03 00 03 A5 03 00 08 03 00 42 03 00 E8 1F 00 01 E0 1F 00 01 E0 1F 00 00 00 E9 1F 00 01 E1 1F 00' + '01 E1 1F 00 00 00 EA 1F 00 01 7A 1F 00 01 7A 1F 00 00 00 EB 1F 00 01 7B 1F 00 01 7B 1F 00 00 00' + 'EC 1F 00 01 E5 1F 00 01 E5 1F 00 00 00 F2 1F 00 02 7C 1F 00 B9 03 00 01 F2 1F 00 02 FA 1F 00 45' + '03 00 02 FA 1F 00 99 03 00 F3 1F 00 02 C9 03 00 B9 03 00 01 F3 1F 00 01 FC 1F 00 01 FC 1F 00 F4' + '1F 00 02 CE 03 00 B9 03 00 01 F4 1F 00 02 8F 03 00 45 03 00 02 8F 03 00 99 03 00 F6 1F 00 02 C9' + '03 00 42 03 00 01 F6 1F 00 02 A9 03 00 42 03 00 02 A9 03 00 42 03 00 F7 1F 00 03 C9 03 00 42 03' + '00 B9 03 00 01 F7 1F 00 03 A9 03 00 42 03 00 45 03 00 03 A9 03 00 42 03 00 99 03 00 F8 1F 00 01' + '78 1F 00 01 78 1F 00 00 00 F9 1F 00 01 79 1F 00 01 79 1F 00 00 00 FA 1F 00 01 7C 1F 00 01 7C 1F' + '00 00 00 FB 1F 00 01 7D 1F 00 01 7D 1F 00 00 00 FC 1F 00 02 C9 03 00 B9 03 00 01 F3 1F 00 01 FC' + '1F 00 02 A9 03 00 99 03 00 26 21 00 01 C9 03 00 01 C9 03 00 00 00 2A 21 00 01 6B 00 00 01 6B 00' + '00 00 00 2B 21 00 01 E5 00 00 01 E5 00 00 00 00 32 21 00 01 4E 21 00 01 4E 21 00 00 00 4E 21 00' + '00 00 01 32 21 00 01 32 21 00 60 21 00 01 70 21 00 01 70 21 00 00 00 61 21 00 01 71 21 00 01 71' + '21 00 00 00 62 21 00 01 72 21 00 01 72 21 00 00 00 63 21 00 01 73 21 00 01 73 21 00 00 00 64 21' + '00 01 74 21 00 01 74 21 00 00 00 65 21 00 01 75 21 00 01 75 21 00 00 00 66 21 00 01 76 21 00 01' + '76 21 00 00 00 67 21 00 01 77 21 00 01 77 21 00 00 00 68 21 00 01 78 21 00 01 78 21 00 00 00 69' + '21 00 01 79 21 00 01 79 21 00 00 00 6A 21 00 01 7A 21 00 01 7A 21 00 00 00 6B 21 00 01 7B 21 00' + '01 7B 21 00 00 00 6C 21 00 01 7C 21 00 01 7C 21 00 00 00 6D 21 00 01 7D 21 00 01 7D 21 00 00 00' + '6E 21 00 01 7E 21 00 01 7E 21 00 00 00 6F 21 00 01 7F 21 00 01 7F 21 00 00 00 70 21 00 00 00 01' + '60 21 00 01 60 21 00 71 21 00 00 00 01 61 21 00 01 61 21 00 72 21 00 00 00 01 62 21 00 01 62 21' + '00 73 21 00 00 00 01 63 21 00 01 63 21 00 74 21 00 00 00 01 64 21 00 01 64 21 00 75 21 00 00 00' + '01 65 21 00 01 65 21 00 76 21 00 00 00 01 66 21 00 01 66 21 00 77 21 00 00 00 01 67 21 00 01 67' + '21 00 78 21 00 00 00 01 68 21 00 01 68 21 00 79 21 00 00 00 01 69 21 00 01 69 21 00 7A 21 00 00' + '00 01 6A 21 00 01 6A 21 00 7B 21 00 00 00 01 6B 21 00 01 6B 21 00 7C 21 00 00 00 01 6C 21 00 01' + '6C 21 00 7D 21 00 00 00 01 6D 21 00 01 6D 21 00 7E 21 00 00 00 01 6E 21 00 01 6E 21 00 7F 21 00' + '00 00 01 6F 21 00 01 6F 21 00 83 21 00 01 84 21 00 01 84 21 00 00 00 84 21 00 00 00 01 83 21 00' + '01 83 21 00 B6 24 00 01 D0 24 00 01 D0 24 00 00 00 B7 24 00 01 D1 24 00 01 D1 24 00 00 00 B8 24' + '00 01 D2 24 00 01 D2 24 00 00 00 B9 24 00 01 D3 24 00 01 D3 24 00 00 00 BA 24 00 01 D4 24 00 01' + 'D4 24 00 00 00 BB 24 00 01 D5 24 00 01 D5 24 00 00 00 BC 24 00 01 D6 24 00 01 D6 24 00 00 00 BD' + '24 00 01 D7 24 00 01 D7 24 00 00 00 BE 24 00 01 D8 24 00 01 D8 24 00 00 00 BF 24 00 01 D9 24 00' + '01 D9 24 00 00 00 C0 24 00 01 DA 24 00 01 DA 24 00 00 00 C1 24 00 01 DB 24 00 01 DB 24 00 00 00' + 'C2 24 00 01 DC 24 00 01 DC 24 00 00 00 C3 24 00 01 DD 24 00 01 DD 24 00 00 00 C4 24 00 01 DE 24' + '00 01 DE 24 00 00 00 C5 24 00 01 DF 24 00 01 DF 24 00 00 00 C6 24 00 01 E0 24 00 01 E0 24 00 00' + '00 C7 24 00 01 E1 24 00 01 E1 24 00 00 00 C8 24 00 01 E2 24 00 01 E2 24 00 00 00 C9 24 00 01 E3' + '24 00 01 E3 24 00 00 00 CA 24 00 01 E4 24 00 01 E4 24 00 00 00 CB 24 00 01 E5 24 00 01 E5 24 00' + '00 00 CC 24 00 01 E6 24 00 01 E6 24 00 00 00 CD 24 00 01 E7 24 00 01 E7 24 00 00 00 CE 24 00 01' + 'E8 24 00 01 E8 24 00 00 00 CF 24 00 01 E9 24 00 01 E9 24 00 00 00 D0 24 00 00 00 01 B6 24 00 01' + 'B6 24 00 D1 24 00 00 00 01 B7 24 00 01 B7 24 00 D2 24 00 00 00 01 B8 24 00 01 B8 24 00 D3 24 00' + '00 00 01 B9 24 00 01 B9 24 00 D4 24 00 00 00 01 BA 24 00 01 BA 24 00 D5 24 00 00 00 01 BB 24 00' + '01 BB 24 00 D6 24 00 00 00 01 BC 24 00 01 BC 24 00 D7 24 00 00 00 01 BD 24 00 01 BD 24 00 D8 24' + '00 00 00 01 BE 24 00 01 BE 24 00 D9 24 00 00 00 01 BF 24 00 01 BF 24 00 DA 24 00 00 00 01 C0 24' + '00 01 C0 24 00 DB 24 00 00 00 01 C1 24 00 01 C1 24 00 DC 24 00 00 00 01 C2 24 00 01 C2 24 00 DD' + '24 00 00 00 01 C3 24 00 01 C3 24 00 DE 24 00 00 00 01 C4 24 00 01 C4 24 00 DF 24 00 00 00 01 C5' + '24 00 01 C5 24 00 E0 24 00 00 00 01 C6 24 00 01 C6 24 00 E1 24 00 00 00 01 C7 24 00 01 C7 24 00' + 'E2 24 00 00 00 01 C8 24 00 01 C8 24 00 E3 24 00 00 00 01 C9 24 00 01 C9 24 00 E4 24 00 00 00 01' + 'CA 24 00 01 CA 24 00 E5 24 00 00 00 01 CB 24 00 01 CB 24 00 E6 24 00 00 00 01 CC 24 00 01 CC 24' + '00 E7 24 00 00 00 01 CD 24 00 01 CD 24 00 E8 24 00 00 00 01 CE 24 00 01 CE 24 00 E9 24 00 00 00' + '01 CF 24 00 01 CF 24 00 00 2C 00 01 30 2C 00 01 30 2C 00 00 00 01 2C 00 01 31 2C 00 01 31 2C 00' + '00 00 02 2C 00 01 32 2C 00 01 32 2C 00 00 00 03 2C 00 01 33 2C 00 01 33 2C 00 00 00 04 2C 00 01' + '34 2C 00 01 34 2C 00 00 00 05 2C 00 01 35 2C 00 01 35 2C 00 00 00 06 2C 00 01 36 2C 00 01 36 2C' + '00 00 00 07 2C 00 01 37 2C 00 01 37 2C 00 00 00 08 2C 00 01 38 2C 00 01 38 2C 00 00 00 09 2C 00' + '01 39 2C 00 01 39 2C 00 00 00 0A 2C 00 01 3A 2C 00 01 3A 2C 00 00 00 0B 2C 00 01 3B 2C 00 01 3B' + '2C 00 00 00 0C 2C 00 01 3C 2C 00 01 3C 2C 00 00 00 0D 2C 00 01 3D 2C 00 01 3D 2C 00 00 00 0E 2C' + '00 01 3E 2C 00 01 3E 2C 00 00 00 0F 2C 00 01 3F 2C 00 01 3F 2C 00 00 00 10 2C 00 01 40 2C 00 01' + '40 2C 00 00 00 11 2C 00 01 41 2C 00 01 41 2C 00 00 00 12 2C 00 01 42 2C 00 01 42 2C 00 00 00 13' + '2C 00 01 43 2C 00 01 43 2C 00 00 00 14 2C 00 01 44 2C 00 01 44 2C 00 00 00 15 2C 00 01 45 2C 00' + '01 45 2C 00 00 00 16 2C 00 01 46 2C 00 01 46 2C 00 00 00 17 2C 00 01 47 2C 00 01 47 2C 00 00 00' + '18 2C 00 01 48 2C 00 01 48 2C 00 00 00 19 2C 00 01 49 2C 00 01 49 2C 00 00 00 1A 2C 00 01 4A 2C' + '00 01 4A 2C 00 00 00 1B 2C 00 01 4B 2C 00 01 4B 2C 00 00 00 1C 2C 00 01 4C 2C 00 01 4C 2C 00 00' + '00 1D 2C 00 01 4D 2C 00 01 4D 2C 00 00 00 1E 2C 00 01 4E 2C 00 01 4E 2C 00 00 00 1F 2C 00 01 4F' + '2C 00 01 4F 2C 00 00 00 20 2C 00 01 50 2C 00 01 50 2C 00 00 00 21 2C 00 01 51 2C 00 01 51 2C 00' + '00 00 22 2C 00 01 52 2C 00 01 52 2C 00 00 00 23 2C 00 01 53 2C 00 01 53 2C 00 00 00 24 2C 00 01' + '54 2C 00 01 54 2C 00 00 00 25 2C 00 01 55 2C 00 01 55 2C 00 00 00 26 2C 00 01 56 2C 00 01 56 2C' + '00 00 00 27 2C 00 01 57 2C 00 01 57 2C 00 00 00 28 2C 00 01 58 2C 00 01 58 2C 00 00 00 29 2C 00' + '01 59 2C 00 01 59 2C 00 00 00 2A 2C 00 01 5A 2C 00 01 5A 2C 00 00 00 2B 2C 00 01 5B 2C 00 01 5B' + '2C 00 00 00 2C 2C 00 01 5C 2C 00 01 5C 2C 00 00 00 2D 2C 00 01 5D 2C 00 01 5D 2C 00 00 00 2E 2C' + '00 01 5E 2C 00 01 5E 2C 00 00 00 30 2C 00 00 00 01 00 2C 00 01 00 2C 00 31 2C 00 00 00 01 01 2C' + '00 01 01 2C 00 32 2C 00 00 00 01 02 2C 00 01 02 2C 00 33 2C 00 00 00 01 03 2C 00 01 03 2C 00 34' + '2C 00 00 00 01 04 2C 00 01 04 2C 00 35 2C 00 00 00 01 05 2C 00 01 05 2C 00 36 2C 00 00 00 01 06' + '2C 00 01 06 2C 00 37 2C 00 00 00 01 07 2C 00 01 07 2C 00 38 2C 00 00 00 01 08 2C 00 01 08 2C 00' + '39 2C 00 00 00 01 09 2C 00 01 09 2C 00 3A 2C 00 00 00 01 0A 2C 00 01 0A 2C 00 3B 2C 00 00 00 01' + '0B 2C 00 01 0B 2C 00 3C 2C 00 00 00 01 0C 2C 00 01 0C 2C 00 3D 2C 00 00 00 01 0D 2C 00 01 0D 2C' + '00 3E 2C 00 00 00 01 0E 2C 00 01 0E 2C 00 3F 2C 00 00 00 01 0F 2C 00 01 0F 2C 00 40 2C 00 00 00' + '01 10 2C 00 01 10 2C 00 41 2C 00 00 00 01 11 2C 00 01 11 2C 00 42 2C 00 00 00 01 12 2C 00 01 12' + '2C 00 43 2C 00 00 00 01 13 2C 00 01 13 2C 00 44 2C 00 00 00 01 14 2C 00 01 14 2C 00 45 2C 00 00' + '00 01 15 2C 00 01 15 2C 00 46 2C 00 00 00 01 16 2C 00 01 16 2C 00 47 2C 00 00 00 01 17 2C 00 01' + '17 2C 00 48 2C 00 00 00 01 18 2C 00 01 18 2C 00 49 2C 00 00 00 01 19 2C 00 01 19 2C 00 4A 2C 00' + '00 00 01 1A 2C 00 01 1A 2C 00 4B 2C 00 00 00 01 1B 2C 00 01 1B 2C 00 4C 2C 00 00 00 01 1C 2C 00' + '01 1C 2C 00 4D 2C 00 00 00 01 1D 2C 00 01 1D 2C 00 4E 2C 00 00 00 01 1E 2C 00 01 1E 2C 00 4F 2C' + '00 00 00 01 1F 2C 00 01 1F 2C 00 50 2C 00 00 00 01 20 2C 00 01 20 2C 00 51 2C 00 00 00 01 21 2C' + '00 01 21 2C 00 52 2C 00 00 00 01 22 2C 00 01 22 2C 00 53 2C 00 00 00 01 23 2C 00 01 23 2C 00 54' + '2C 00 00 00 01 24 2C 00 01 24 2C 00 55 2C 00 00 00 01 25 2C 00 01 25 2C 00 56 2C 00 00 00 01 26' + '2C 00 01 26 2C 00 57 2C 00 00 00 01 27 2C 00 01 27 2C 00 58 2C 00 00 00 01 28 2C 00 01 28 2C 00' + '59 2C 00 00 00 01 29 2C 00 01 29 2C 00 5A 2C 00 00 00 01 2A 2C 00 01 2A 2C 00 5B 2C 00 00 00 01' + '2B 2C 00 01 2B 2C 00 5C 2C 00 00 00 01 2C 2C 00 01 2C 2C 00 5D 2C 00 00 00 01 2D 2C 00 01 2D 2C' + '00 5E 2C 00 00 00 01 2E 2C 00 01 2E 2C 00 60 2C 00 01 61 2C 00 01 61 2C 00 00 00 61 2C 00 00 00' + '01 60 2C 00 01 60 2C 00 62 2C 00 01 6B 02 00 01 6B 02 00 00 00 63 2C 00 01 7D 1D 00 01 7D 1D 00' + '00 00 64 2C 00 01 7D 02 00 01 7D 02 00 00 00 65 2C 00 00 00 01 3A 02 00 01 3A 02 00 66 2C 00 00' + '00 01 3E 02 00 01 3E 02 00 67 2C 00 01 68 2C 00 01 68 2C 00 00 00 68 2C 00 00 00 01 67 2C 00 01' + '67 2C 00 69 2C 00 01 6A 2C 00 01 6A 2C 00 00 00 6A 2C 00 00 00 01 69 2C 00 01 69 2C 00 6B 2C 00' + '01 6C 2C 00 01 6C 2C 00 00 00 6C 2C 00 00 00 01 6B 2C 00 01 6B 2C 00 6D 2C 00 01 51 02 00 01 51' + '02 00 00 00 6E 2C 00 01 71 02 00 01 71 02 00 00 00 6F 2C 00 01 50 02 00 01 50 02 00 00 00 70 2C' + '00 01 52 02 00 01 52 02 00 00 00 72 2C 00 01 73 2C 00 01 73 2C 00 00 00 73 2C 00 00 00 01 72 2C' + '00 01 72 2C 00 75 2C 00 01 76 2C 00 01 76 2C 00 00 00 76 2C 00 00 00 01 75 2C 00 01 75 2C 00 7E' + '2C 00 01 3F 02 00 01 3F 02 00 00 00 7F 2C 00 01 40 02 00 01 40 02 00 00 00 80 2C 00 01 81 2C 00' + '01 81 2C 00 00 00 81 2C 00 00 00 01 80 2C 00 01 80 2C 00 82 2C 00 01 83 2C 00 01 83 2C 00 00 00' + '83 2C 00 00 00 01 82 2C 00 01 82 2C 00 84 2C 00 01 85 2C 00 01 85 2C 00 00 00 85 2C 00 00 00 01' + '84 2C 00 01 84 2C 00 86 2C 00 01 87 2C 00 01 87 2C 00 00 00 87 2C 00 00 00 01 86 2C 00 01 86 2C' + '00 88 2C 00 01 89 2C 00 01 89 2C 00 00 00 89 2C 00 00 00 01 88 2C 00 01 88 2C 00 8A 2C 00 01 8B' + '2C 00 01 8B 2C 00 00 00 8B 2C 00 00 00 01 8A 2C 00 01 8A 2C 00 8C 2C 00 01 8D 2C 00 01 8D 2C 00' + '00 00 8D 2C 00 00 00 01 8C 2C 00 01 8C 2C 00 8E 2C 00 01 8F 2C 00 01 8F 2C 00 00 00 8F 2C 00 00' + '00 01 8E 2C 00 01 8E 2C 00 90 2C 00 01 91 2C 00 01 91 2C 00 00 00 91 2C 00 00 00 01 90 2C 00 01' + '90 2C 00 92 2C 00 01 93 2C 00 01 93 2C 00 00 00 93 2C 00 00 00 01 92 2C 00 01 92 2C 00 94 2C 00' + '01 95 2C 00 01 95 2C 00 00 00 95 2C 00 00 00 01 94 2C 00 01 94 2C 00 96 2C 00 01 97 2C 00 01 97' + '2C 00 00 00 97 2C 00 00 00 01 96 2C 00 01 96 2C 00 98 2C 00 01 99 2C 00 01 99 2C 00 00 00 99 2C' + '00 00 00 01 98 2C 00 01 98 2C 00 9A 2C 00 01 9B 2C 00 01 9B 2C 00 00 00 9B 2C 00 00 00 01 9A 2C' + '00 01 9A 2C 00 9C 2C 00 01 9D 2C 00 01 9D 2C 00 00 00 9D 2C 00 00 00 01 9C 2C 00 01 9C 2C 00 9E' + '2C 00 01 9F 2C 00 01 9F 2C 00 00 00 9F 2C 00 00 00 01 9E 2C 00 01 9E 2C 00 A0 2C 00 01 A1 2C 00' + '01 A1 2C 00 00 00 A1 2C 00 00 00 01 A0 2C 00 01 A0 2C 00 A2 2C 00 01 A3 2C 00 01 A3 2C 00 00 00' + 'A3 2C 00 00 00 01 A2 2C 00 01 A2 2C 00 A4 2C 00 01 A5 2C 00 01 A5 2C 00 00 00 A5 2C 00 00 00 01' + 'A4 2C 00 01 A4 2C 00 A6 2C 00 01 A7 2C 00 01 A7 2C 00 00 00 A7 2C 00 00 00 01 A6 2C 00 01 A6 2C' + '00 A8 2C 00 01 A9 2C 00 01 A9 2C 00 00 00 A9 2C 00 00 00 01 A8 2C 00 01 A8 2C 00 AA 2C 00 01 AB' + '2C 00 01 AB 2C 00 00 00 AB 2C 00 00 00 01 AA 2C 00 01 AA 2C 00 AC 2C 00 01 AD 2C 00 01 AD 2C 00' + '00 00 AD 2C 00 00 00 01 AC 2C 00 01 AC 2C 00 AE 2C 00 01 AF 2C 00 01 AF 2C 00 00 00 AF 2C 00 00' + '00 01 AE 2C 00 01 AE 2C 00 B0 2C 00 01 B1 2C 00 01 B1 2C 00 00 00 B1 2C 00 00 00 01 B0 2C 00 01' + 'B0 2C 00 B2 2C 00 01 B3 2C 00 01 B3 2C 00 00 00 B3 2C 00 00 00 01 B2 2C 00 01 B2 2C 00 B4 2C 00' + '01 B5 2C 00 01 B5 2C 00 00 00 B5 2C 00 00 00 01 B4 2C 00 01 B4 2C 00 B6 2C 00 01 B7 2C 00 01 B7' + '2C 00 00 00 B7 2C 00 00 00 01 B6 2C 00 01 B6 2C 00 B8 2C 00 01 B9 2C 00 01 B9 2C 00 00 00 B9 2C' + '00 00 00 01 B8 2C 00 01 B8 2C 00 BA 2C 00 01 BB 2C 00 01 BB 2C 00 00 00 BB 2C 00 00 00 01 BA 2C' + '00 01 BA 2C 00 BC 2C 00 01 BD 2C 00 01 BD 2C 00 00 00 BD 2C 00 00 00 01 BC 2C 00 01 BC 2C 00 BE' + '2C 00 01 BF 2C 00 01 BF 2C 00 00 00 BF 2C 00 00 00 01 BE 2C 00 01 BE 2C 00 C0 2C 00 01 C1 2C 00' + '01 C1 2C 00 00 00 C1 2C 00 00 00 01 C0 2C 00 01 C0 2C 00 C2 2C 00 01 C3 2C 00 01 C3 2C 00 00 00' + 'C3 2C 00 00 00 01 C2 2C 00 01 C2 2C 00 C4 2C 00 01 C5 2C 00 01 C5 2C 00 00 00 C5 2C 00 00 00 01' + 'C4 2C 00 01 C4 2C 00 C6 2C 00 01 C7 2C 00 01 C7 2C 00 00 00 C7 2C 00 00 00 01 C6 2C 00 01 C6 2C' + '00 C8 2C 00 01 C9 2C 00 01 C9 2C 00 00 00 C9 2C 00 00 00 01 C8 2C 00 01 C8 2C 00 CA 2C 00 01 CB' + '2C 00 01 CB 2C 00 00 00 CB 2C 00 00 00 01 CA 2C 00 01 CA 2C 00 CC 2C 00 01 CD 2C 00 01 CD 2C 00' + '00 00 CD 2C 00 00 00 01 CC 2C 00 01 CC 2C 00 CE 2C 00 01 CF 2C 00 01 CF 2C 00 00 00 CF 2C 00 00' + '00 01 CE 2C 00 01 CE 2C 00 D0 2C 00 01 D1 2C 00 01 D1 2C 00 00 00 D1 2C 00 00 00 01 D0 2C 00 01' + 'D0 2C 00 D2 2C 00 01 D3 2C 00 01 D3 2C 00 00 00 D3 2C 00 00 00 01 D2 2C 00 01 D2 2C 00 D4 2C 00' + '01 D5 2C 00 01 D5 2C 00 00 00 D5 2C 00 00 00 01 D4 2C 00 01 D4 2C 00 D6 2C 00 01 D7 2C 00 01 D7' + '2C 00 00 00 D7 2C 00 00 00 01 D6 2C 00 01 D6 2C 00 D8 2C 00 01 D9 2C 00 01 D9 2C 00 00 00 D9 2C' + '00 00 00 01 D8 2C 00 01 D8 2C 00 DA 2C 00 01 DB 2C 00 01 DB 2C 00 00 00 DB 2C 00 00 00 01 DA 2C' + '00 01 DA 2C 00 DC 2C 00 01 DD 2C 00 01 DD 2C 00 00 00 DD 2C 00 00 00 01 DC 2C 00 01 DC 2C 00 DE' + '2C 00 01 DF 2C 00 01 DF 2C 00 00 00 DF 2C 00 00 00 01 DE 2C 00 01 DE 2C 00 E0 2C 00 01 E1 2C 00' + '01 E1 2C 00 00 00 E1 2C 00 00 00 01 E0 2C 00 01 E0 2C 00 E2 2C 00 01 E3 2C 00 01 E3 2C 00 00 00' + 'E3 2C 00 00 00 01 E2 2C 00 01 E2 2C 00 EB 2C 00 01 EC 2C 00 01 EC 2C 00 00 00 EC 2C 00 00 00 01' + 'EB 2C 00 01 EB 2C 00 ED 2C 00 01 EE 2C 00 01 EE 2C 00 00 00 EE 2C 00 00 00 01 ED 2C 00 01 ED 2C' + '00 F2 2C 00 01 F3 2C 00 01 F3 2C 00 00 00 F3 2C 00 00 00 01 F2 2C 00 01 F2 2C 00 00 2D 00 00 00' + '01 A0 10 00 01 A0 10 00 01 2D 00 00 00 01 A1 10 00 01 A1 10 00 02 2D 00 00 00 01 A2 10 00 01 A2' + '10 00 03 2D 00 00 00 01 A3 10 00 01 A3 10 00 04 2D 00 00 00 01 A4 10 00 01 A4 10 00 05 2D 00 00' + '00 01 A5 10 00 01 A5 10 00 06 2D 00 00 00 01 A6 10 00 01 A6 10 00 07 2D 00 00 00 01 A7 10 00 01' + 'A7 10 00 08 2D 00 00 00 01 A8 10 00 01 A8 10 00 09 2D 00 00 00 01 A9 10 00 01 A9 10 00 0A 2D 00' + '00 00 01 AA 10 00 01 AA 10 00 0B 2D 00 00 00 01 AB 10 00 01 AB 10 00 0C 2D 00 00 00 01 AC 10 00' + '01 AC 10 00 0D 2D 00 00 00 01 AD 10 00 01 AD 10 00 0E 2D 00 00 00 01 AE 10 00 01 AE 10 00 0F 2D' + '00 00 00 01 AF 10 00 01 AF 10 00 10 2D 00 00 00 01 B0 10 00 01 B0 10 00 11 2D 00 00 00 01 B1 10' + '00 01 B1 10 00 12 2D 00 00 00 01 B2 10 00 01 B2 10 00 13 2D 00 00 00 01 B3 10 00 01 B3 10 00 14' + '2D 00 00 00 01 B4 10 00 01 B4 10 00 15 2D 00 00 00 01 B5 10 00 01 B5 10 00 16 2D 00 00 00 01 B6' + '10 00 01 B6 10 00 17 2D 00 00 00 01 B7 10 00 01 B7 10 00 18 2D 00 00 00 01 B8 10 00 01 B8 10 00' + '19 2D 00 00 00 01 B9 10 00 01 B9 10 00 1A 2D 00 00 00 01 BA 10 00 01 BA 10 00 1B 2D 00 00 00 01' + 'BB 10 00 01 BB 10 00 1C 2D 00 00 00 01 BC 10 00 01 BC 10 00 1D 2D 00 00 00 01 BD 10 00 01 BD 10' + '00 1E 2D 00 00 00 01 BE 10 00 01 BE 10 00 1F 2D 00 00 00 01 BF 10 00 01 BF 10 00 20 2D 00 00 00' + '01 C0 10 00 01 C0 10 00 21 2D 00 00 00 01 C1 10 00 01 C1 10 00 22 2D 00 00 00 01 C2 10 00 01 C2' + '10 00 23 2D 00 00 00 01 C3 10 00 01 C3 10 00 24 2D 00 00 00 01 C4 10 00 01 C4 10 00 25 2D 00 00' + '00 01 C5 10 00 01 C5 10 00 27 2D 00 00 00 01 C7 10 00 01 C7 10 00 2D 2D 00 00 00 01 CD 10 00 01' + 'CD 10 00 40 A6 00 01 41 A6 00 01 41 A6 00 00 00 41 A6 00 00 00 01 40 A6 00 01 40 A6 00 42 A6 00' + '01 43 A6 00 01 43 A6 00 00 00 43 A6 00 00 00 01 42 A6 00 01 42 A6 00 44 A6 00 01 45 A6 00 01 45' + 'A6 00 00 00 45 A6 00 00 00 01 44 A6 00 01 44 A6 00 46 A6 00 01 47 A6 00 01 47 A6 00 00 00 47 A6' + '00 00 00 01 46 A6 00 01 46 A6 00 48 A6 00 01 49 A6 00 01 49 A6 00 00 00 49 A6 00 00 00 01 48 A6' + '00 01 48 A6 00 4A A6 00 01 4B A6 00 01 4B A6 00 00 00 4B A6 00 00 00 01 4A A6 00 01 4A A6 00 4C' + 'A6 00 01 4D A6 00 01 4D A6 00 00 00 4D A6 00 00 00 01 4C A6 00 01 4C A6 00 4E A6 00 01 4F A6 00' + '01 4F A6 00 00 00 4F A6 00 00 00 01 4E A6 00 01 4E A6 00 50 A6 00 01 51 A6 00 01 51 A6 00 00 00' + '51 A6 00 00 00 01 50 A6 00 01 50 A6 00 52 A6 00 01 53 A6 00 01 53 A6 00 00 00 53 A6 00 00 00 01' + '52 A6 00 01 52 A6 00 54 A6 00 01 55 A6 00 01 55 A6 00 00 00 55 A6 00 00 00 01 54 A6 00 01 54 A6' + '00 56 A6 00 01 57 A6 00 01 57 A6 00 00 00 57 A6 00 00 00 01 56 A6 00 01 56 A6 00 58 A6 00 01 59' + 'A6 00 01 59 A6 00 00 00 59 A6 00 00 00 01 58 A6 00 01 58 A6 00 5A A6 00 01 5B A6 00 01 5B A6 00' + '00 00 5B A6 00 00 00 01 5A A6 00 01 5A A6 00 5C A6 00 01 5D A6 00 01 5D A6 00 00 00 5D A6 00 00' + '00 01 5C A6 00 01 5C A6 00 5E A6 00 01 5F A6 00 01 5F A6 00 00 00 5F A6 00 00 00 01 5E A6 00 01' + '5E A6 00 60 A6 00 01 61 A6 00 01 61 A6 00 00 00 61 A6 00 00 00 01 60 A6 00 01 60 A6 00 62 A6 00' + '01 63 A6 00 01 63 A6 00 00 00 63 A6 00 00 00 01 62 A6 00 01 62 A6 00 64 A6 00 01 65 A6 00 01 65' + 'A6 00 00 00 65 A6 00 00 00 01 64 A6 00 01 64 A6 00 66 A6 00 01 67 A6 00 01 67 A6 00 00 00 67 A6' + '00 00 00 01 66 A6 00 01 66 A6 00 68 A6 00 01 69 A6 00 01 69 A6 00 00 00 69 A6 00 00 00 01 68 A6' + '00 01 68 A6 00 6A A6 00 01 6B A6 00 01 6B A6 00 00 00 6B A6 00 00 00 01 6A A6 00 01 6A A6 00 6C' + 'A6 00 01 6D A6 00 01 6D A6 00 00 00 6D A6 00 00 00 01 6C A6 00 01 6C A6 00 80 A6 00 01 81 A6 00' + '01 81 A6 00 00 00 81 A6 00 00 00 01 80 A6 00 01 80 A6 00 82 A6 00 01 83 A6 00 01 83 A6 00 00 00' + '83 A6 00 00 00 01 82 A6 00 01 82 A6 00 84 A6 00 01 85 A6 00 01 85 A6 00 00 00 85 A6 00 00 00 01' + '84 A6 00 01 84 A6 00 86 A6 00 01 87 A6 00 01 87 A6 00 00 00 87 A6 00 00 00 01 86 A6 00 01 86 A6' + '00 88 A6 00 01 89 A6 00 01 89 A6 00 00 00 89 A6 00 00 00 01 88 A6 00 01 88 A6 00 8A A6 00 01 8B' + 'A6 00 01 8B A6 00 00 00 8B A6 00 00 00 01 8A A6 00 01 8A A6 00 8C A6 00 01 8D A6 00 01 8D A6 00' + '00 00 8D A6 00 00 00 01 8C A6 00 01 8C A6 00 8E A6 00 01 8F A6 00 01 8F A6 00 00 00 8F A6 00 00' + '00 01 8E A6 00 01 8E A6 00 90 A6 00 01 91 A6 00 01 91 A6 00 00 00 91 A6 00 00 00 01 90 A6 00 01' + '90 A6 00 92 A6 00 01 93 A6 00 01 93 A6 00 00 00 93 A6 00 00 00 01 92 A6 00 01 92 A6 00 94 A6 00' + '01 95 A6 00 01 95 A6 00 00 00 95 A6 00 00 00 01 94 A6 00 01 94 A6 00 96 A6 00 01 97 A6 00 01 97' + 'A6 00 00 00 97 A6 00 00 00 01 96 A6 00 01 96 A6 00 98 A6 00 01 99 A6 00 01 99 A6 00 00 00 99 A6' + '00 00 00 01 98 A6 00 01 98 A6 00 9A A6 00 01 9B A6 00 01 9B A6 00 00 00 9B A6 00 00 00 01 9A A6' + '00 01 9A A6 00 22 A7 00 01 23 A7 00 01 23 A7 00 00 00 23 A7 00 00 00 01 22 A7 00 01 22 A7 00 24' + 'A7 00 01 25 A7 00 01 25 A7 00 00 00 25 A7 00 00 00 01 24 A7 00 01 24 A7 00 26 A7 00 01 27 A7 00' + '01 27 A7 00 00 00 27 A7 00 00 00 01 26 A7 00 01 26 A7 00 28 A7 00 01 29 A7 00 01 29 A7 00 00 00' + '29 A7 00 00 00 01 28 A7 00 01 28 A7 00 2A A7 00 01 2B A7 00 01 2B A7 00 00 00 2B A7 00 00 00 01' + '2A A7 00 01 2A A7 00 2C A7 00 01 2D A7 00 01 2D A7 00 00 00 2D A7 00 00 00 01 2C A7 00 01 2C A7' + '00 2E A7 00 01 2F A7 00 01 2F A7 00 00 00 2F A7 00 00 00 01 2E A7 00 01 2E A7 00 32 A7 00 01 33' + 'A7 00 01 33 A7 00 00 00 33 A7 00 00 00 01 32 A7 00 01 32 A7 00 34 A7 00 01 35 A7 00 01 35 A7 00' + '00 00 35 A7 00 00 00 01 34 A7 00 01 34 A7 00 36 A7 00 01 37 A7 00 01 37 A7 00 00 00 37 A7 00 00' + '00 01 36 A7 00 01 36 A7 00 38 A7 00 01 39 A7 00 01 39 A7 00 00 00 39 A7 00 00 00 01 38 A7 00 01' + '38 A7 00 3A A7 00 01 3B A7 00 01 3B A7 00 00 00 3B A7 00 00 00 01 3A A7 00 01 3A A7 00 3C A7 00' + '01 3D A7 00 01 3D A7 00 00 00 3D A7 00 00 00 01 3C A7 00 01 3C A7 00 3E A7 00 01 3F A7 00 01 3F' + 'A7 00 00 00 3F A7 00 00 00 01 3E A7 00 01 3E A7 00 40 A7 00 01 41 A7 00 01 41 A7 00 00 00 41 A7' + '00 00 00 01 40 A7 00 01 40 A7 00 42 A7 00 01 43 A7 00 01 43 A7 00 00 00 43 A7 00 00 00 01 42 A7' + '00 01 42 A7 00 44 A7 00 01 45 A7 00 01 45 A7 00 00 00 45 A7 00 00 00 01 44 A7 00 01 44 A7 00 46' + 'A7 00 01 47 A7 00 01 47 A7 00 00 00 47 A7 00 00 00 01 46 A7 00 01 46 A7 00 48 A7 00 01 49 A7 00' + '01 49 A7 00 00 00 49 A7 00 00 00 01 48 A7 00 01 48 A7 00 4A A7 00 01 4B A7 00 01 4B A7 00 00 00' + '4B A7 00 00 00 01 4A A7 00 01 4A A7 00 4C A7 00 01 4D A7 00 01 4D A7 00 00 00 4D A7 00 00 00 01' + '4C A7 00 01 4C A7 00 4E A7 00 01 4F A7 00 01 4F A7 00 00 00 4F A7 00 00 00 01 4E A7 00 01 4E A7' + '00 50 A7 00 01 51 A7 00 01 51 A7 00 00 00 51 A7 00 00 00 01 50 A7 00 01 50 A7 00 52 A7 00 01 53' + 'A7 00 01 53 A7 00 00 00 53 A7 00 00 00 01 52 A7 00 01 52 A7 00 54 A7 00 01 55 A7 00 01 55 A7 00' + '00 00 55 A7 00 00 00 01 54 A7 00 01 54 A7 00 56 A7 00 01 57 A7 00 01 57 A7 00 00 00 57 A7 00 00' + '00 01 56 A7 00 01 56 A7 00 58 A7 00 01 59 A7 00 01 59 A7 00 00 00 59 A7 00 00 00 01 58 A7 00 01' + '58 A7 00 5A A7 00 01 5B A7 00 01 5B A7 00 00 00 5B A7 00 00 00 01 5A A7 00 01 5A A7 00 5C A7 00' + '01 5D A7 00 01 5D A7 00 00 00 5D A7 00 00 00 01 5C A7 00 01 5C A7 00 5E A7 00 01 5F A7 00 01 5F' + 'A7 00 00 00 5F A7 00 00 00 01 5E A7 00 01 5E A7 00 60 A7 00 01 61 A7 00 01 61 A7 00 00 00 61 A7' + '00 00 00 01 60 A7 00 01 60 A7 00 62 A7 00 01 63 A7 00 01 63 A7 00 00 00 63 A7 00 00 00 01 62 A7' + '00 01 62 A7 00 64 A7 00 01 65 A7 00 01 65 A7 00 00 00 65 A7 00 00 00 01 64 A7 00 01 64 A7 00 66' + 'A7 00 01 67 A7 00 01 67 A7 00 00 00 67 A7 00 00 00 01 66 A7 00 01 66 A7 00 68 A7 00 01 69 A7 00' + '01 69 A7 00 00 00 69 A7 00 00 00 01 68 A7 00 01 68 A7 00 6A A7 00 01 6B A7 00 01 6B A7 00 00 00' + '6B A7 00 00 00 01 6A A7 00 01 6A A7 00 6C A7 00 01 6D A7 00 01 6D A7 00 00 00 6D A7 00 00 00 01' + '6C A7 00 01 6C A7 00 6E A7 00 01 6F A7 00 01 6F A7 00 00 00 6F A7 00 00 00 01 6E A7 00 01 6E A7' + '00 79 A7 00 01 7A A7 00 01 7A A7 00 00 00 7A A7 00 00 00 01 79 A7 00 01 79 A7 00 7B A7 00 01 7C' + 'A7 00 01 7C A7 00 00 00 7C A7 00 00 00 01 7B A7 00 01 7B A7 00 7D A7 00 01 79 1D 00 01 79 1D 00' + '00 00 7E A7 00 01 7F A7 00 01 7F A7 00 00 00 7F A7 00 00 00 01 7E A7 00 01 7E A7 00 80 A7 00 01' + '81 A7 00 01 81 A7 00 00 00 81 A7 00 00 00 01 80 A7 00 01 80 A7 00 82 A7 00 01 83 A7 00 01 83 A7' + '00 00 00 83 A7 00 00 00 01 82 A7 00 01 82 A7 00 84 A7 00 01 85 A7 00 01 85 A7 00 00 00 85 A7 00' + '00 00 01 84 A7 00 01 84 A7 00 86 A7 00 01 87 A7 00 01 87 A7 00 00 00 87 A7 00 00 00 01 86 A7 00' + '01 86 A7 00 8B A7 00 01 8C A7 00 01 8C A7 00 00 00 8C A7 00 00 00 01 8B A7 00 01 8B A7 00 8D A7' + '00 01 65 02 00 01 65 02 00 00 00 90 A7 00 01 91 A7 00 01 91 A7 00 00 00 91 A7 00 00 00 01 90 A7' + '00 01 90 A7 00 92 A7 00 01 93 A7 00 01 93 A7 00 00 00 93 A7 00 00 00 01 92 A7 00 01 92 A7 00 94' + 'A7 00 00 00 01 C4 A7 00 01 C4 A7 00 96 A7 00 01 97 A7 00 01 97 A7 00 00 00 97 A7 00 00 00 01 96' + 'A7 00 01 96 A7 00 98 A7 00 01 99 A7 00 01 99 A7 00 00 00 99 A7 00 00 00 01 98 A7 00 01 98 A7 00' + '9A A7 00 01 9B A7 00 01 9B A7 00 00 00 9B A7 00 00 00 01 9A A7 00 01 9A A7 00 9C A7 00 01 9D A7' + '00 01 9D A7 00 00 00 9D A7 00 00 00 01 9C A7 00 01 9C A7 00 9E A7 00 01 9F A7 00 01 9F A7 00 00' + '00 9F A7 00 00 00 01 9E A7 00 01 9E A7 00 A0 A7 00 01 A1 A7 00 01 A1 A7 00 00 00 A1 A7 00 00 00' + '01 A0 A7 00 01 A0 A7 00 A2 A7 00 01 A3 A7 00 01 A3 A7 00 00 00 A3 A7 00 00 00 01 A2 A7 00 01 A2' + 'A7 00 A4 A7 00 01 A5 A7 00 01 A5 A7 00 00 00 A5 A7 00 00 00 01 A4 A7 00 01 A4 A7 00 A6 A7 00 01' + 'A7 A7 00 01 A7 A7 00 00 00 A7 A7 00 00 00 01 A6 A7 00 01 A6 A7 00 A8 A7 00 01 A9 A7 00 01 A9 A7' + '00 00 00 A9 A7 00 00 00 01 A8 A7 00 01 A8 A7 00 AA A7 00 01 66 02 00 01 66 02 00 00 00 AB A7 00' + '01 5C 02 00 01 5C 02 00 00 00 AC A7 00 01 61 02 00 01 61 02 00 00 00 AD A7 00 01 6C 02 00 01 6C' + '02 00 00 00 AE A7 00 01 6A 02 00 01 6A 02 00 00 00 B0 A7 00 01 9E 02 00 01 9E 02 00 00 00 B1 A7' + '00 01 87 02 00 01 87 02 00 00 00 B2 A7 00 01 9D 02 00 01 9D 02 00 00 00 B3 A7 00 01 53 AB 00 01' + '53 AB 00 00 00 B4 A7 00 01 B5 A7 00 01 B5 A7 00 00 00 B5 A7 00 00 00 01 B4 A7 00 01 B4 A7 00 B6' + 'A7 00 01 B7 A7 00 01 B7 A7 00 00 00 B7 A7 00 00 00 01 B6 A7 00 01 B6 A7 00 B8 A7 00 01 B9 A7 00' + '01 B9 A7 00 00 00 B9 A7 00 00 00 01 B8 A7 00 01 B8 A7 00 BA A7 00 01 BB A7 00 01 BB A7 00 00 00' + 'BB A7 00 00 00 01 BA A7 00 01 BA A7 00 BC A7 00 01 BD A7 00 01 BD A7 00 00 00 BD A7 00 00 00 01' + 'BC A7 00 01 BC A7 00 BE A7 00 01 BF A7 00 01 BF A7 00 00 00 BF A7 00 00 00 01 BE A7 00 01 BE A7' + '00 C2 A7 00 01 C3 A7 00 01 C3 A7 00 00 00 C3 A7 00 00 00 01 C2 A7 00 01 C2 A7 00 C4 A7 00 01 94' + 'A7 00 01 94 A7 00 00 00 C5 A7 00 01 82 02 00 01 82 02 00 00 00 C6 A7 00 01 8E 1D 00 01 8E 1D 00' + '00 00 C7 A7 00 01 C8 A7 00 01 C8 A7 00 00 00 C8 A7 00 00 00 01 C7 A7 00 01 C7 A7 00 C9 A7 00 01' + 'CA A7 00 01 CA A7 00 00 00 CA A7 00 00 00 01 C9 A7 00 01 C9 A7 00 F5 A7 00 01 F6 A7 00 01 F6 A7' + '00 00 00 F6 A7 00 00 00 01 F5 A7 00 01 F5 A7 00 53 AB 00 00 00 01 B3 A7 00 01 B3 A7 00 70 AB 00' + '01 A0 13 00 00 01 A0 13 00 01 A0 13 00 71 AB 00 01 A1 13 00 00 01 A1 13 00 01 A1 13 00 72 AB 00' + '01 A2 13 00 00 01 A2 13 00 01 A2 13 00 73 AB 00 01 A3 13 00 00 01 A3 13 00 01 A3 13 00 74 AB 00' + '01 A4 13 00 00 01 A4 13 00 01 A4 13 00 75 AB 00 01 A5 13 00 00 01 A5 13 00 01 A5 13 00 76 AB 00' + '01 A6 13 00 00 01 A6 13 00 01 A6 13 00 77 AB 00 01 A7 13 00 00 01 A7 13 00 01 A7 13 00 78 AB 00' + '01 A8 13 00 00 01 A8 13 00 01 A8 13 00 79 AB 00 01 A9 13 00 00 01 A9 13 00 01 A9 13 00 7A AB 00' + '01 AA 13 00 00 01 AA 13 00 01 AA 13 00 7B AB 00 01 AB 13 00 00 01 AB 13 00 01 AB 13 00 7C AB 00' + '01 AC 13 00 00 01 AC 13 00 01 AC 13 00 7D AB 00 01 AD 13 00 00 01 AD 13 00 01 AD 13 00 7E AB 00' + '01 AE 13 00 00 01 AE 13 00 01 AE 13 00 7F AB 00 01 AF 13 00 00 01 AF 13 00 01 AF 13 00 80 AB 00' + '01 B0 13 00 00 01 B0 13 00 01 B0 13 00 81 AB 00 01 B1 13 00 00 01 B1 13 00 01 B1 13 00 82 AB 00' + '01 B2 13 00 00 01 B2 13 00 01 B2 13 00 83 AB 00 01 B3 13 00 00 01 B3 13 00 01 B3 13 00 84 AB 00' + '01 B4 13 00 00 01 B4 13 00 01 B4 13 00 85 AB 00 01 B5 13 00 00 01 B5 13 00 01 B5 13 00 86 AB 00' + '01 B6 13 00 00 01 B6 13 00 01 B6 13 00 87 AB 00 01 B7 13 00 00 01 B7 13 00 01 B7 13 00 88 AB 00' + '01 B8 13 00 00 01 B8 13 00 01 B8 13 00 89 AB 00 01 B9 13 00 00 01 B9 13 00 01 B9 13 00 8A AB 00' + '01 BA 13 00 00 01 BA 13 00 01 BA 13 00 8B AB 00 01 BB 13 00 00 01 BB 13 00 01 BB 13 00 8C AB 00' + '01 BC 13 00 00 01 BC 13 00 01 BC 13 00 8D AB 00 01 BD 13 00 00 01 BD 13 00 01 BD 13 00 8E AB 00' + '01 BE 13 00 00 01 BE 13 00 01 BE 13 00 8F AB 00 01 BF 13 00 00 01 BF 13 00 01 BF 13 00 90 AB 00' + '01 C0 13 00 00 01 C0 13 00 01 C0 13 00 91 AB 00 01 C1 13 00 00 01 C1 13 00 01 C1 13 00 92 AB 00' + '01 C2 13 00 00 01 C2 13 00 01 C2 13 00 93 AB 00 01 C3 13 00 00 01 C3 13 00 01 C3 13 00 94 AB 00' + '01 C4 13 00 00 01 C4 13 00 01 C4 13 00 95 AB 00 01 C5 13 00 00 01 C5 13 00 01 C5 13 00 96 AB 00' + '01 C6 13 00 00 01 C6 13 00 01 C6 13 00 97 AB 00 01 C7 13 00 00 01 C7 13 00 01 C7 13 00 98 AB 00' + '01 C8 13 00 00 01 C8 13 00 01 C8 13 00 99 AB 00 01 C9 13 00 00 01 C9 13 00 01 C9 13 00 9A AB 00' + '01 CA 13 00 00 01 CA 13 00 01 CA 13 00 9B AB 00 01 CB 13 00 00 01 CB 13 00 01 CB 13 00 9C AB 00' + '01 CC 13 00 00 01 CC 13 00 01 CC 13 00 9D AB 00 01 CD 13 00 00 01 CD 13 00 01 CD 13 00 9E AB 00' + '01 CE 13 00 00 01 CE 13 00 01 CE 13 00 9F AB 00 01 CF 13 00 00 01 CF 13 00 01 CF 13 00 A0 AB 00' + '01 D0 13 00 00 01 D0 13 00 01 D0 13 00 A1 AB 00 01 D1 13 00 00 01 D1 13 00 01 D1 13 00 A2 AB 00' + '01 D2 13 00 00 01 D2 13 00 01 D2 13 00 A3 AB 00 01 D3 13 00 00 01 D3 13 00 01 D3 13 00 A4 AB 00' + '01 D4 13 00 00 01 D4 13 00 01 D4 13 00 A5 AB 00 01 D5 13 00 00 01 D5 13 00 01 D5 13 00 A6 AB 00' + '01 D6 13 00 00 01 D6 13 00 01 D6 13 00 A7 AB 00 01 D7 13 00 00 01 D7 13 00 01 D7 13 00 A8 AB 00' + '01 D8 13 00 00 01 D8 13 00 01 D8 13 00 A9 AB 00 01 D9 13 00 00 01 D9 13 00 01 D9 13 00 AA AB 00' + '01 DA 13 00 00 01 DA 13 00 01 DA 13 00 AB AB 00 01 DB 13 00 00 01 DB 13 00 01 DB 13 00 AC AB 00' + '01 DC 13 00 00 01 DC 13 00 01 DC 13 00 AD AB 00 01 DD 13 00 00 01 DD 13 00 01 DD 13 00 AE AB 00' + '01 DE 13 00 00 01 DE 13 00 01 DE 13 00 AF AB 00 01 DF 13 00 00 01 DF 13 00 01 DF 13 00 B0 AB 00' + '01 E0 13 00 00 01 E0 13 00 01 E0 13 00 B1 AB 00 01 E1 13 00 00 01 E1 13 00 01 E1 13 00 B2 AB 00' + '01 E2 13 00 00 01 E2 13 00 01 E2 13 00 B3 AB 00 01 E3 13 00 00 01 E3 13 00 01 E3 13 00 B4 AB 00' + '01 E4 13 00 00 01 E4 13 00 01 E4 13 00 B5 AB 00 01 E5 13 00 00 01 E5 13 00 01 E5 13 00 B6 AB 00' + '01 E6 13 00 00 01 E6 13 00 01 E6 13 00 B7 AB 00 01 E7 13 00 00 01 E7 13 00 01 E7 13 00 B8 AB 00' + '01 E8 13 00 00 01 E8 13 00 01 E8 13 00 B9 AB 00 01 E9 13 00 00 01 E9 13 00 01 E9 13 00 BA AB 00' + '01 EA 13 00 00 01 EA 13 00 01 EA 13 00 BB AB 00 01 EB 13 00 00 01 EB 13 00 01 EB 13 00 BC AB 00' + '01 EC 13 00 00 01 EC 13 00 01 EC 13 00 BD AB 00 01 ED 13 00 00 01 ED 13 00 01 ED 13 00 BE AB 00' + '01 EE 13 00 00 01 EE 13 00 01 EE 13 00 BF AB 00 01 EF 13 00 00 01 EF 13 00 01 EF 13 00 00 FB 00' + '02 66 00 00 66 00 00 01 00 FB 00 02 46 00 00 66 00 00 02 46 00 00 46 00 00 01 FB 00 02 66 00 00' + '69 00 00 01 01 FB 00 02 46 00 00 69 00 00 02 46 00 00 49 00 00 02 FB 00 02 66 00 00 6C 00 00 01' + '02 FB 00 02 46 00 00 6C 00 00 02 46 00 00 4C 00 00 03 FB 00 03 66 00 00 66 00 00 69 00 00 01 03' + 'FB 00 03 46 00 00 66 00 00 69 00 00 03 46 00 00 46 00 00 49 00 00 04 FB 00 03 66 00 00 66 00 00' + '6C 00 00 01 04 FB 00 03 46 00 00 66 00 00 6C 00 00 03 46 00 00 46 00 00 4C 00 00 05 FB 00 02 73' + '00 00 74 00 00 01 05 FB 00 02 53 00 00 74 00 00 02 53 00 00 54 00 00 06 FB 00 02 73 00 00 74 00' + '00 01 06 FB 00 02 53 00 00 74 00 00 02 53 00 00 54 00 00 13 FB 00 02 74 05 00 76 05 00 01 13 FB' + '00 02 44 05 00 76 05 00 02 44 05 00 46 05 00 14 FB 00 02 74 05 00 65 05 00 01 14 FB 00 02 44 05' + '00 65 05 00 02 44 05 00 35 05 00 15 FB 00 02 74 05 00 6B 05 00 01 15 FB 00 02 44 05 00 6B 05 00' + '02 44 05 00 3B 05 00 16 FB 00 02 7E 05 00 76 05 00 01 16 FB 00 02 4E 05 00 76 05 00 02 4E 05 00' + '46 05 00 17 FB 00 02 74 05 00 6D 05 00 01 17 FB 00 02 44 05 00 6D 05 00 02 44 05 00 3D 05 00 21' + 'FF 00 01 41 FF 00 01 41 FF 00 00 00 22 FF 00 01 42 FF 00 01 42 FF 00 00 00 23 FF 00 01 43 FF 00' + '01 43 FF 00 00 00 24 FF 00 01 44 FF 00 01 44 FF 00 00 00 25 FF 00 01 45 FF 00 01 45 FF 00 00 00' + '26 FF 00 01 46 FF 00 01 46 FF 00 00 00 27 FF 00 01 47 FF 00 01 47 FF 00 00 00 28 FF 00 01 48 FF' + '00 01 48 FF 00 00 00 29 FF 00 01 49 FF 00 01 49 FF 00 00 00 2A FF 00 01 4A FF 00 01 4A FF 00 00' + '00 2B FF 00 01 4B FF 00 01 4B FF 00 00 00 2C FF 00 01 4C FF 00 01 4C FF 00 00 00 2D FF 00 01 4D' + 'FF 00 01 4D FF 00 00 00 2E FF 00 01 4E FF 00 01 4E FF 00 00 00 2F FF 00 01 4F FF 00 01 4F FF 00' + '00 00 30 FF 00 01 50 FF 00 01 50 FF 00 00 00 31 FF 00 01 51 FF 00 01 51 FF 00 00 00 32 FF 00 01' + '52 FF 00 01 52 FF 00 00 00 33 FF 00 01 53 FF 00 01 53 FF 00 00 00 34 FF 00 01 54 FF 00 01 54 FF' + '00 00 00 35 FF 00 01 55 FF 00 01 55 FF 00 00 00 36 FF 00 01 56 FF 00 01 56 FF 00 00 00 37 FF 00' + '01 57 FF 00 01 57 FF 00 00 00 38 FF 00 01 58 FF 00 01 58 FF 00 00 00 39 FF 00 01 59 FF 00 01 59' + 'FF 00 00 00 3A FF 00 01 5A FF 00 01 5A FF 00 00 00 41 FF 00 00 00 01 21 FF 00 01 21 FF 00 42 FF' + '00 00 00 01 22 FF 00 01 22 FF 00 43 FF 00 00 00 01 23 FF 00 01 23 FF 00 44 FF 00 00 00 01 24 FF' + '00 01 24 FF 00 45 FF 00 00 00 01 25 FF 00 01 25 FF 00 46 FF 00 00 00 01 26 FF 00 01 26 FF 00 47' + 'FF 00 00 00 01 27 FF 00 01 27 FF 00 48 FF 00 00 00 01 28 FF 00 01 28 FF 00 49 FF 00 00 00 01 29' + 'FF 00 01 29 FF 00 4A FF 00 00 00 01 2A FF 00 01 2A FF 00 4B FF 00 00 00 01 2B FF 00 01 2B FF 00' + '4C FF 00 00 00 01 2C FF 00 01 2C FF 00 4D FF 00 00 00 01 2D FF 00 01 2D FF 00 4E FF 00 00 00 01' + '2E FF 00 01 2E FF 00 4F FF 00 00 00 01 2F FF 00 01 2F FF 00 50 FF 00 00 00 01 30 FF 00 01 30 FF' + '00 51 FF 00 00 00 01 31 FF 00 01 31 FF 00 52 FF 00 00 00 01 32 FF 00 01 32 FF 00 53 FF 00 00 00' + '01 33 FF 00 01 33 FF 00 54 FF 00 00 00 01 34 FF 00 01 34 FF 00 55 FF 00 00 00 01 35 FF 00 01 35' + 'FF 00 56 FF 00 00 00 01 36 FF 00 01 36 FF 00 57 FF 00 00 00 01 37 FF 00 01 37 FF 00 58 FF 00 00' + '00 01 38 FF 00 01 38 FF 00 59 FF 00 00 00 01 39 FF 00 01 39 FF 00 5A FF 00 00 00 01 3A FF 00 01' + '3A FF 00 00 04 01 01 28 04 01 01 28 04 01 00 00 01 04 01 01 29 04 01 01 29 04 01 00 00 02 04 01' + '01 2A 04 01 01 2A 04 01 00 00 03 04 01 01 2B 04 01 01 2B 04 01 00 00 04 04 01 01 2C 04 01 01 2C' + '04 01 00 00 05 04 01 01 2D 04 01 01 2D 04 01 00 00 06 04 01 01 2E 04 01 01 2E 04 01 00 00 07 04' + '01 01 2F 04 01 01 2F 04 01 00 00 08 04 01 01 30 04 01 01 30 04 01 00 00 09 04 01 01 31 04 01 01' + '31 04 01 00 00 0A 04 01 01 32 04 01 01 32 04 01 00 00 0B 04 01 01 33 04 01 01 33 04 01 00 00 0C' + '04 01 01 34 04 01 01 34 04 01 00 00 0D 04 01 01 35 04 01 01 35 04 01 00 00 0E 04 01 01 36 04 01' + '01 36 04 01 00 00 0F 04 01 01 37 04 01 01 37 04 01 00 00 10 04 01 01 38 04 01 01 38 04 01 00 00' + '11 04 01 01 39 04 01 01 39 04 01 00 00 12 04 01 01 3A 04 01 01 3A 04 01 00 00 13 04 01 01 3B 04' + '01 01 3B 04 01 00 00 14 04 01 01 3C 04 01 01 3C 04 01 00 00 15 04 01 01 3D 04 01 01 3D 04 01 00' + '00 16 04 01 01 3E 04 01 01 3E 04 01 00 00 17 04 01 01 3F 04 01 01 3F 04 01 00 00 18 04 01 01 40' + '04 01 01 40 04 01 00 00 19 04 01 01 41 04 01 01 41 04 01 00 00 1A 04 01 01 42 04 01 01 42 04 01' + '00 00 1B 04 01 01 43 04 01 01 43 04 01 00 00 1C 04 01 01 44 04 01 01 44 04 01 00 00 1D 04 01 01' + '45 04 01 01 45 04 01 00 00 1E 04 01 01 46 04 01 01 46 04 01 00 00 1F 04 01 01 47 04 01 01 47 04' + '01 00 00 20 04 01 01 48 04 01 01 48 04 01 00 00 21 04 01 01 49 04 01 01 49 04 01 00 00 22 04 01' + '01 4A 04 01 01 4A 04 01 00 00 23 04 01 01 4B 04 01 01 4B 04 01 00 00 24 04 01 01 4C 04 01 01 4C' + '04 01 00 00 25 04 01 01 4D 04 01 01 4D 04 01 00 00 26 04 01 01 4E 04 01 01 4E 04 01 00 00 27 04' + '01 01 4F 04 01 01 4F 04 01 00 00 28 04 01 00 00 01 00 04 01 01 00 04 01 29 04 01 00 00 01 01 04' + '01 01 01 04 01 2A 04 01 00 00 01 02 04 01 01 02 04 01 2B 04 01 00 00 01 03 04 01 01 03 04 01 2C' + '04 01 00 00 01 04 04 01 01 04 04 01 2D 04 01 00 00 01 05 04 01 01 05 04 01 2E 04 01 00 00 01 06' + '04 01 01 06 04 01 2F 04 01 00 00 01 07 04 01 01 07 04 01 30 04 01 00 00 01 08 04 01 01 08 04 01' + '31 04 01 00 00 01 09 04 01 01 09 04 01 32 04 01 00 00 01 0A 04 01 01 0A 04 01 33 04 01 00 00 01' + '0B 04 01 01 0B 04 01 34 04 01 00 00 01 0C 04 01 01 0C 04 01 35 04 01 00 00 01 0D 04 01 01 0D 04' + '01 36 04 01 00 00 01 0E 04 01 01 0E 04 01 37 04 01 00 00 01 0F 04 01 01 0F 04 01 38 04 01 00 00' + '01 10 04 01 01 10 04 01 39 04 01 00 00 01 11 04 01 01 11 04 01 3A 04 01 00 00 01 12 04 01 01 12' + '04 01 3B 04 01 00 00 01 13 04 01 01 13 04 01 3C 04 01 00 00 01 14 04 01 01 14 04 01 3D 04 01 00' + '00 01 15 04 01 01 15 04 01 3E 04 01 00 00 01 16 04 01 01 16 04 01 3F 04 01 00 00 01 17 04 01 01' + '17 04 01 40 04 01 00 00 01 18 04 01 01 18 04 01 41 04 01 00 00 01 19 04 01 01 19 04 01 42 04 01' + '00 00 01 1A 04 01 01 1A 04 01 43 04 01 00 00 01 1B 04 01 01 1B 04 01 44 04 01 00 00 01 1C 04 01' + '01 1C 04 01 45 04 01 00 00 01 1D 04 01 01 1D 04 01 46 04 01 00 00 01 1E 04 01 01 1E 04 01 47 04' + '01 00 00 01 1F 04 01 01 1F 04 01 48 04 01 00 00 01 20 04 01 01 20 04 01 49 04 01 00 00 01 21 04' + '01 01 21 04 01 4A 04 01 00 00 01 22 04 01 01 22 04 01 4B 04 01 00 00 01 23 04 01 01 23 04 01 4C' + '04 01 00 00 01 24 04 01 01 24 04 01 4D 04 01 00 00 01 25 04 01 01 25 04 01 4E 04 01 00 00 01 26' + '04 01 01 26 04 01 4F 04 01 00 00 01 27 04 01 01 27 04 01 B0 04 01 01 D8 04 01 01 D8 04 01 00 00' + 'B1 04 01 01 D9 04 01 01 D9 04 01 00 00 B2 04 01 01 DA 04 01 01 DA 04 01 00 00 B3 04 01 01 DB 04' + '01 01 DB 04 01 00 00 B4 04 01 01 DC 04 01 01 DC 04 01 00 00 B5 04 01 01 DD 04 01 01 DD 04 01 00' + '00 B6 04 01 01 DE 04 01 01 DE 04 01 00 00 B7 04 01 01 DF 04 01 01 DF 04 01 00 00 B8 04 01 01 E0' + '04 01 01 E0 04 01 00 00 B9 04 01 01 E1 04 01 01 E1 04 01 00 00 BA 04 01 01 E2 04 01 01 E2 04 01' + '00 00 BB 04 01 01 E3 04 01 01 E3 04 01 00 00 BC 04 01 01 E4 04 01 01 E4 04 01 00 00 BD 04 01 01' + 'E5 04 01 01 E5 04 01 00 00 BE 04 01 01 E6 04 01 01 E6 04 01 00 00 BF 04 01 01 E7 04 01 01 E7 04' + '01 00 00 C0 04 01 01 E8 04 01 01 E8 04 01 00 00 C1 04 01 01 E9 04 01 01 E9 04 01 00 00 C2 04 01' + '01 EA 04 01 01 EA 04 01 00 00 C3 04 01 01 EB 04 01 01 EB 04 01 00 00 C4 04 01 01 EC 04 01 01 EC' + '04 01 00 00 C5 04 01 01 ED 04 01 01 ED 04 01 00 00 C6 04 01 01 EE 04 01 01 EE 04 01 00 00 C7 04' + '01 01 EF 04 01 01 EF 04 01 00 00 C8 04 01 01 F0 04 01 01 F0 04 01 00 00 C9 04 01 01 F1 04 01 01' + 'F1 04 01 00 00 CA 04 01 01 F2 04 01 01 F2 04 01 00 00 CB 04 01 01 F3 04 01 01 F3 04 01 00 00 CC' + '04 01 01 F4 04 01 01 F4 04 01 00 00 CD 04 01 01 F5 04 01 01 F5 04 01 00 00 CE 04 01 01 F6 04 01' + '01 F6 04 01 00 00 CF 04 01 01 F7 04 01 01 F7 04 01 00 00 D0 04 01 01 F8 04 01 01 F8 04 01 00 00' + 'D1 04 01 01 F9 04 01 01 F9 04 01 00 00 D2 04 01 01 FA 04 01 01 FA 04 01 00 00 D3 04 01 01 FB 04' + '01 01 FB 04 01 00 00 D8 04 01 00 00 01 B0 04 01 01 B0 04 01 D9 04 01 00 00 01 B1 04 01 01 B1 04' + '01 DA 04 01 00 00 01 B2 04 01 01 B2 04 01 DB 04 01 00 00 01 B3 04 01 01 B3 04 01 DC 04 01 00 00' + '01 B4 04 01 01 B4 04 01 DD 04 01 00 00 01 B5 04 01 01 B5 04 01 DE 04 01 00 00 01 B6 04 01 01 B6' + '04 01 DF 04 01 00 00 01 B7 04 01 01 B7 04 01 E0 04 01 00 00 01 B8 04 01 01 B8 04 01 E1 04 01 00' + '00 01 B9 04 01 01 B9 04 01 E2 04 01 00 00 01 BA 04 01 01 BA 04 01 E3 04 01 00 00 01 BB 04 01 01' + 'BB 04 01 E4 04 01 00 00 01 BC 04 01 01 BC 04 01 E5 04 01 00 00 01 BD 04 01 01 BD 04 01 E6 04 01' + '00 00 01 BE 04 01 01 BE 04 01 E7 04 01 00 00 01 BF 04 01 01 BF 04 01 E8 04 01 00 00 01 C0 04 01' + '01 C0 04 01 E9 04 01 00 00 01 C1 04 01 01 C1 04 01 EA 04 01 00 00 01 C2 04 01 01 C2 04 01 EB 04' + '01 00 00 01 C3 04 01 01 C3 04 01 EC 04 01 00 00 01 C4 04 01 01 C4 04 01 ED 04 01 00 00 01 C5 04' + '01 01 C5 04 01 EE 04 01 00 00 01 C6 04 01 01 C6 04 01 EF 04 01 00 00 01 C7 04 01 01 C7 04 01 F0' + '04 01 00 00 01 C8 04 01 01 C8 04 01 F1 04 01 00 00 01 C9 04 01 01 C9 04 01 F2 04 01 00 00 01 CA' + '04 01 01 CA 04 01 F3 04 01 00 00 01 CB 04 01 01 CB 04 01 F4 04 01 00 00 01 CC 04 01 01 CC 04 01' + 'F5 04 01 00 00 01 CD 04 01 01 CD 04 01 F6 04 01 00 00 01 CE 04 01 01 CE 04 01 F7 04 01 00 00 01' + 'CF 04 01 01 CF 04 01 F8 04 01 00 00 01 D0 04 01 01 D0 04 01 F9 04 01 00 00 01 D1 04 01 01 D1 04' + '01 FA 04 01 00 00 01 D2 04 01 01 D2 04 01 FB 04 01 00 00 01 D3 04 01 01 D3 04 01 80 0C 01 01 C0' + '0C 01 01 C0 0C 01 00 00 81 0C 01 01 C1 0C 01 01 C1 0C 01 00 00 82 0C 01 01 C2 0C 01 01 C2 0C 01' + '00 00 83 0C 01 01 C3 0C 01 01 C3 0C 01 00 00 84 0C 01 01 C4 0C 01 01 C4 0C 01 00 00 85 0C 01 01' + 'C5 0C 01 01 C5 0C 01 00 00 86 0C 01 01 C6 0C 01 01 C6 0C 01 00 00 87 0C 01 01 C7 0C 01 01 C7 0C' + '01 00 00 88 0C 01 01 C8 0C 01 01 C8 0C 01 00 00 89 0C 01 01 C9 0C 01 01 C9 0C 01 00 00 8A 0C 01' + '01 CA 0C 01 01 CA 0C 01 00 00 8B 0C 01 01 CB 0C 01 01 CB 0C 01 00 00 8C 0C 01 01 CC 0C 01 01 CC' + '0C 01 00 00 8D 0C 01 01 CD 0C 01 01 CD 0C 01 00 00 8E 0C 01 01 CE 0C 01 01 CE 0C 01 00 00 8F 0C' + '01 01 CF 0C 01 01 CF 0C 01 00 00 90 0C 01 01 D0 0C 01 01 D0 0C 01 00 00 91 0C 01 01 D1 0C 01 01' + 'D1 0C 01 00 00 92 0C 01 01 D2 0C 01 01 D2 0C 01 00 00 93 0C 01 01 D3 0C 01 01 D3 0C 01 00 00 94' + '0C 01 01 D4 0C 01 01 D4 0C 01 00 00 95 0C 01 01 D5 0C 01 01 D5 0C 01 00 00 96 0C 01 01 D6 0C 01' + '01 D6 0C 01 00 00 97 0C 01 01 D7 0C 01 01 D7 0C 01 00 00 98 0C 01 01 D8 0C 01 01 D8 0C 01 00 00' + '99 0C 01 01 D9 0C 01 01 D9 0C 01 00 00 9A 0C 01 01 DA 0C 01 01 DA 0C 01 00 00 9B 0C 01 01 DB 0C' + '01 01 DB 0C 01 00 00 9C 0C 01 01 DC 0C 01 01 DC 0C 01 00 00 9D 0C 01 01 DD 0C 01 01 DD 0C 01 00' + '00 9E 0C 01 01 DE 0C 01 01 DE 0C 01 00 00 9F 0C 01 01 DF 0C 01 01 DF 0C 01 00 00 A0 0C 01 01 E0' + '0C 01 01 E0 0C 01 00 00 A1 0C 01 01 E1 0C 01 01 E1 0C 01 00 00 A2 0C 01 01 E2 0C 01 01 E2 0C 01' + '00 00 A3 0C 01 01 E3 0C 01 01 E3 0C 01 00 00 A4 0C 01 01 E4 0C 01 01 E4 0C 01 00 00 A5 0C 01 01' + 'E5 0C 01 01 E5 0C 01 00 00 A6 0C 01 01 E6 0C 01 01 E6 0C 01 00 00 A7 0C 01 01 E7 0C 01 01 E7 0C' + '01 00 00 A8 0C 01 01 E8 0C 01 01 E8 0C 01 00 00 A9 0C 01 01 E9 0C 01 01 E9 0C 01 00 00 AA 0C 01' + '01 EA 0C 01 01 EA 0C 01 00 00 AB 0C 01 01 EB 0C 01 01 EB 0C 01 00 00 AC 0C 01 01 EC 0C 01 01 EC' + '0C 01 00 00 AD 0C 01 01 ED 0C 01 01 ED 0C 01 00 00 AE 0C 01 01 EE 0C 01 01 EE 0C 01 00 00 AF 0C' + '01 01 EF 0C 01 01 EF 0C 01 00 00 B0 0C 01 01 F0 0C 01 01 F0 0C 01 00 00 B1 0C 01 01 F1 0C 01 01' + 'F1 0C 01 00 00 B2 0C 01 01 F2 0C 01 01 F2 0C 01 00 00 C0 0C 01 00 00 01 80 0C 01 01 80 0C 01 C1' + '0C 01 00 00 01 81 0C 01 01 81 0C 01 C2 0C 01 00 00 01 82 0C 01 01 82 0C 01 C3 0C 01 00 00 01 83' + '0C 01 01 83 0C 01 C4 0C 01 00 00 01 84 0C 01 01 84 0C 01 C5 0C 01 00 00 01 85 0C 01 01 85 0C 01' + 'C6 0C 01 00 00 01 86 0C 01 01 86 0C 01 C7 0C 01 00 00 01 87 0C 01 01 87 0C 01 C8 0C 01 00 00 01' + '88 0C 01 01 88 0C 01 C9 0C 01 00 00 01 89 0C 01 01 89 0C 01 CA 0C 01 00 00 01 8A 0C 01 01 8A 0C' + '01 CB 0C 01 00 00 01 8B 0C 01 01 8B 0C 01 CC 0C 01 00 00 01 8C 0C 01 01 8C 0C 01 CD 0C 01 00 00' + '01 8D 0C 01 01 8D 0C 01 CE 0C 01 00 00 01 8E 0C 01 01 8E 0C 01 CF 0C 01 00 00 01 8F 0C 01 01 8F' + '0C 01 D0 0C 01 00 00 01 90 0C 01 01 90 0C 01 D1 0C 01 00 00 01 91 0C 01 01 91 0C 01 D2 0C 01 00' + '00 01 92 0C 01 01 92 0C 01 D3 0C 01 00 00 01 93 0C 01 01 93 0C 01 D4 0C 01 00 00 01 94 0C 01 01' + '94 0C 01 D5 0C 01 00 00 01 95 0C 01 01 95 0C 01 D6 0C 01 00 00 01 96 0C 01 01 96 0C 01 D7 0C 01' + '00 00 01 97 0C 01 01 97 0C 01 D8 0C 01 00 00 01 98 0C 01 01 98 0C 01 D9 0C 01 00 00 01 99 0C 01' + '01 99 0C 01 DA 0C 01 00 00 01 9A 0C 01 01 9A 0C 01 DB 0C 01 00 00 01 9B 0C 01 01 9B 0C 01 DC 0C' + '01 00 00 01 9C 0C 01 01 9C 0C 01 DD 0C 01 00 00 01 9D 0C 01 01 9D 0C 01 DE 0C 01 00 00 01 9E 0C' + '01 01 9E 0C 01 DF 0C 01 00 00 01 9F 0C 01 01 9F 0C 01 E0 0C 01 00 00 01 A0 0C 01 01 A0 0C 01 E1' + '0C 01 00 00 01 A1 0C 01 01 A1 0C 01 E2 0C 01 00 00 01 A2 0C 01 01 A2 0C 01 E3 0C 01 00 00 01 A3' + '0C 01 01 A3 0C 01 E4 0C 01 00 00 01 A4 0C 01 01 A4 0C 01 E5 0C 01 00 00 01 A5 0C 01 01 A5 0C 01' + 'E6 0C 01 00 00 01 A6 0C 01 01 A6 0C 01 E7 0C 01 00 00 01 A7 0C 01 01 A7 0C 01 E8 0C 01 00 00 01' + 'A8 0C 01 01 A8 0C 01 E9 0C 01 00 00 01 A9 0C 01 01 A9 0C 01 EA 0C 01 00 00 01 AA 0C 01 01 AA 0C' + '01 EB 0C 01 00 00 01 AB 0C 01 01 AB 0C 01 EC 0C 01 00 00 01 AC 0C 01 01 AC 0C 01 ED 0C 01 00 00' + '01 AD 0C 01 01 AD 0C 01 EE 0C 01 00 00 01 AE 0C 01 01 AE 0C 01 EF 0C 01 00 00 01 AF 0C 01 01 AF' + '0C 01 F0 0C 01 00 00 01 B0 0C 01 01 B0 0C 01 F1 0C 01 00 00 01 B1 0C 01 01 B1 0C 01 F2 0C 01 00' + '00 01 B2 0C 01 01 B2 0C 01 A0 18 01 01 C0 18 01 01 C0 18 01 00 00 A1 18 01 01 C1 18 01 01 C1 18' + '01 00 00 A2 18 01 01 C2 18 01 01 C2 18 01 00 00 A3 18 01 01 C3 18 01 01 C3 18 01 00 00 A4 18 01' + '01 C4 18 01 01 C4 18 01 00 00 A5 18 01 01 C5 18 01 01 C5 18 01 00 00 A6 18 01 01 C6 18 01 01 C6' + '18 01 00 00 A7 18 01 01 C7 18 01 01 C7 18 01 00 00 A8 18 01 01 C8 18 01 01 C8 18 01 00 00 A9 18' + '01 01 C9 18 01 01 C9 18 01 00 00 AA 18 01 01 CA 18 01 01 CA 18 01 00 00 AB 18 01 01 CB 18 01 01' + 'CB 18 01 00 00 AC 18 01 01 CC 18 01 01 CC 18 01 00 00 AD 18 01 01 CD 18 01 01 CD 18 01 00 00 AE' + '18 01 01 CE 18 01 01 CE 18 01 00 00 AF 18 01 01 CF 18 01 01 CF 18 01 00 00 B0 18 01 01 D0 18 01' + '01 D0 18 01 00 00 B1 18 01 01 D1 18 01 01 D1 18 01 00 00 B2 18 01 01 D2 18 01 01 D2 18 01 00 00' + 'B3 18 01 01 D3 18 01 01 D3 18 01 00 00 B4 18 01 01 D4 18 01 01 D4 18 01 00 00 B5 18 01 01 D5 18' + '01 01 D5 18 01 00 00 B6 18 01 01 D6 18 01 01 D6 18 01 00 00 B7 18 01 01 D7 18 01 01 D7 18 01 00' + '00 B8 18 01 01 D8 18 01 01 D8 18 01 00 00 B9 18 01 01 D9 18 01 01 D9 18 01 00 00 BA 18 01 01 DA' + '18 01 01 DA 18 01 00 00 BB 18 01 01 DB 18 01 01 DB 18 01 00 00 BC 18 01 01 DC 18 01 01 DC 18 01' + '00 00 BD 18 01 01 DD 18 01 01 DD 18 01 00 00 BE 18 01 01 DE 18 01 01 DE 18 01 00 00 BF 18 01 01' + 'DF 18 01 01 DF 18 01 00 00 C0 18 01 00 00 01 A0 18 01 01 A0 18 01 C1 18 01 00 00 01 A1 18 01 01' + 'A1 18 01 C2 18 01 00 00 01 A2 18 01 01 A2 18 01 C3 18 01 00 00 01 A3 18 01 01 A3 18 01 C4 18 01' + '00 00 01 A4 18 01 01 A4 18 01 C5 18 01 00 00 01 A5 18 01 01 A5 18 01 C6 18 01 00 00 01 A6 18 01' + '01 A6 18 01 C7 18 01 00 00 01 A7 18 01 01 A7 18 01 C8 18 01 00 00 01 A8 18 01 01 A8 18 01 C9 18' + '01 00 00 01 A9 18 01 01 A9 18 01 CA 18 01 00 00 01 AA 18 01 01 AA 18 01 CB 18 01 00 00 01 AB 18' + '01 01 AB 18 01 CC 18 01 00 00 01 AC 18 01 01 AC 18 01 CD 18 01 00 00 01 AD 18 01 01 AD 18 01 CE' + '18 01 00 00 01 AE 18 01 01 AE 18 01 CF 18 01 00 00 01 AF 18 01 01 AF 18 01 D0 18 01 00 00 01 B0' + '18 01 01 B0 18 01 D1 18 01 00 00 01 B1 18 01 01 B1 18 01 D2 18 01 00 00 01 B2 18 01 01 B2 18 01' + 'D3 18 01 00 00 01 B3 18 01 01 B3 18 01 D4 18 01 00 00 01 B4 18 01 01 B4 18 01 D5 18 01 00 00 01' + 'B5 18 01 01 B5 18 01 D6 18 01 00 00 01 B6 18 01 01 B6 18 01 D7 18 01 00 00 01 B7 18 01 01 B7 18' + '01 D8 18 01 00 00 01 B8 18 01 01 B8 18 01 D9 18 01 00 00 01 B9 18 01 01 B9 18 01 DA 18 01 00 00' + '01 BA 18 01 01 BA 18 01 DB 18 01 00 00 01 BB 18 01 01 BB 18 01 DC 18 01 00 00 01 BC 18 01 01 BC' + '18 01 DD 18 01 00 00 01 BD 18 01 01 BD 18 01 DE 18 01 00 00 01 BE 18 01 01 BE 18 01 DF 18 01 00' + '00 01 BF 18 01 01 BF 18 01 40 6E 01 01 60 6E 01 01 60 6E 01 00 00 41 6E 01 01 61 6E 01 01 61 6E' + '01 00 00 42 6E 01 01 62 6E 01 01 62 6E 01 00 00 43 6E 01 01 63 6E 01 01 63 6E 01 00 00 44 6E 01' + '01 64 6E 01 01 64 6E 01 00 00 45 6E 01 01 65 6E 01 01 65 6E 01 00 00 46 6E 01 01 66 6E 01 01 66' + '6E 01 00 00 47 6E 01 01 67 6E 01 01 67 6E 01 00 00 48 6E 01 01 68 6E 01 01 68 6E 01 00 00 49 6E' + '01 01 69 6E 01 01 69 6E 01 00 00 4A 6E 01 01 6A 6E 01 01 6A 6E 01 00 00 4B 6E 01 01 6B 6E 01 01' + '6B 6E 01 00 00 4C 6E 01 01 6C 6E 01 01 6C 6E 01 00 00 4D 6E 01 01 6D 6E 01 01 6D 6E 01 00 00 4E' + '6E 01 01 6E 6E 01 01 6E 6E 01 00 00 4F 6E 01 01 6F 6E 01 01 6F 6E 01 00 00 50 6E 01 01 70 6E 01' + '01 70 6E 01 00 00 51 6E 01 01 71 6E 01 01 71 6E 01 00 00 52 6E 01 01 72 6E 01 01 72 6E 01 00 00' + '53 6E 01 01 73 6E 01 01 73 6E 01 00 00 54 6E 01 01 74 6E 01 01 74 6E 01 00 00 55 6E 01 01 75 6E' + '01 01 75 6E 01 00 00 56 6E 01 01 76 6E 01 01 76 6E 01 00 00 57 6E 01 01 77 6E 01 01 77 6E 01 00' + '00 58 6E 01 01 78 6E 01 01 78 6E 01 00 00 59 6E 01 01 79 6E 01 01 79 6E 01 00 00 5A 6E 01 01 7A' + '6E 01 01 7A 6E 01 00 00 5B 6E 01 01 7B 6E 01 01 7B 6E 01 00 00 5C 6E 01 01 7C 6E 01 01 7C 6E 01' + '00 00 5D 6E 01 01 7D 6E 01 01 7D 6E 01 00 00 5E 6E 01 01 7E 6E 01 01 7E 6E 01 00 00 5F 6E 01 01' + '7F 6E 01 01 7F 6E 01 00 00 60 6E 01 00 00 01 40 6E 01 01 40 6E 01 61 6E 01 00 00 01 41 6E 01 01' + '41 6E 01 62 6E 01 00 00 01 42 6E 01 01 42 6E 01 63 6E 01 00 00 01 43 6E 01 01 43 6E 01 64 6E 01' + '00 00 01 44 6E 01 01 44 6E 01 65 6E 01 00 00 01 45 6E 01 01 45 6E 01 66 6E 01 00 00 01 46 6E 01' + '01 46 6E 01 67 6E 01 00 00 01 47 6E 01 01 47 6E 01 68 6E 01 00 00 01 48 6E 01 01 48 6E 01 69 6E' + '01 00 00 01 49 6E 01 01 49 6E 01 6A 6E 01 00 00 01 4A 6E 01 01 4A 6E 01 6B 6E 01 00 00 01 4B 6E' + '01 01 4B 6E 01 6C 6E 01 00 00 01 4C 6E 01 01 4C 6E 01 6D 6E 01 00 00 01 4D 6E 01 01 4D 6E 01 6E' + '6E 01 00 00 01 4E 6E 01 01 4E 6E 01 6F 6E 01 00 00 01 4F 6E 01 01 4F 6E 01 70 6E 01 00 00 01 50' + '6E 01 01 50 6E 01 71 6E 01 00 00 01 51 6E 01 01 51 6E 01 72 6E 01 00 00 01 52 6E 01 01 52 6E 01' + '73 6E 01 00 00 01 53 6E 01 01 53 6E 01 74 6E 01 00 00 01 54 6E 01 01 54 6E 01 75 6E 01 00 00 01' + '55 6E 01 01 55 6E 01 76 6E 01 00 00 01 56 6E 01 01 56 6E 01 77 6E 01 00 00 01 57 6E 01 01 57 6E' + '01 78 6E 01 00 00 01 58 6E 01 01 58 6E 01 79 6E 01 00 00 01 59 6E 01 01 59 6E 01 7A 6E 01 00 00' + '01 5A 6E 01 01 5A 6E 01 7B 6E 01 00 00 01 5B 6E 01 01 5B 6E 01 7C 6E 01 00 00 01 5C 6E 01 01 5C' + '6E 01 7D 6E 01 00 00 01 5D 6E 01 01 5D 6E 01 7E 6E 01 00 00 01 5E 6E 01 01 5E 6E 01 7F 6E 01 00' + '00 01 5F 6E 01 01 5F 6E 01 00 E9 01 01 22 E9 01 01 22 E9 01 00 00 01 E9 01 01 23 E9 01 01 23 E9' + '01 00 00 02 E9 01 01 24 E9 01 01 24 E9 01 00 00 03 E9 01 01 25 E9 01 01 25 E9 01 00 00 04 E9 01' + '01 26 E9 01 01 26 E9 01 00 00 05 E9 01 01 27 E9 01 01 27 E9 01 00 00 06 E9 01 01 28 E9 01 01 28' + 'E9 01 00 00 07 E9 01 01 29 E9 01 01 29 E9 01 00 00 08 E9 01 01 2A E9 01 01 2A E9 01 00 00 09 E9' + '01 01 2B E9 01 01 2B E9 01 00 00 0A E9 01 01 2C E9 01 01 2C E9 01 00 00 0B E9 01 01 2D E9 01 01' + '2D E9 01 00 00 0C E9 01 01 2E E9 01 01 2E E9 01 00 00 0D E9 01 01 2F E9 01 01 2F E9 01 00 00 0E' + 'E9 01 01 30 E9 01 01 30 E9 01 00 00 0F E9 01 01 31 E9 01 01 31 E9 01 00 00 10 E9 01 01 32 E9 01' + '01 32 E9 01 00 00 11 E9 01 01 33 E9 01 01 33 E9 01 00 00 12 E9 01 01 34 E9 01 01 34 E9 01 00 00' + '13 E9 01 01 35 E9 01 01 35 E9 01 00 00 14 E9 01 01 36 E9 01 01 36 E9 01 00 00 15 E9 01 01 37 E9' + '01 01 37 E9 01 00 00 16 E9 01 01 38 E9 01 01 38 E9 01 00 00 17 E9 01 01 39 E9 01 01 39 E9 01 00' + '00 18 E9 01 01 3A E9 01 01 3A E9 01 00 00 19 E9 01 01 3B E9 01 01 3B E9 01 00 00 1A E9 01 01 3C' + 'E9 01 01 3C E9 01 00 00 1B E9 01 01 3D E9 01 01 3D E9 01 00 00 1C E9 01 01 3E E9 01 01 3E E9 01' + '00 00 1D E9 01 01 3F E9 01 01 3F E9 01 00 00 1E E9 01 01 40 E9 01 01 40 E9 01 00 00 1F E9 01 01' + '41 E9 01 01 41 E9 01 00 00 20 E9 01 01 42 E9 01 01 42 E9 01 00 00 21 E9 01 01 43 E9 01 01 43 E9' + '01 00 00 22 E9 01 00 00 01 00 E9 01 01 00 E9 01 23 E9 01 00 00 01 01 E9 01 01 01 E9 01 24 E9 01' + '00 00 01 02 E9 01 01 02 E9 01 25 E9 01 00 00 01 03 E9 01 01 03 E9 01 26 E9 01 00 00 01 04 E9 01' + '01 04 E9 01 27 E9 01 00 00 01 05 E9 01 01 05 E9 01 28 E9 01 00 00 01 06 E9 01 01 06 E9 01 29 E9' + '01 00 00 01 07 E9 01 01 07 E9 01 2A E9 01 00 00 01 08 E9 01 01 08 E9 01 2B E9 01 00 00 01 09 E9' + '01 01 09 E9 01 2C E9 01 00 00 01 0A E9 01 01 0A E9 01 2D E9 01 00 00 01 0B E9 01 01 0B E9 01 2E' + 'E9 01 00 00 01 0C E9 01 01 0C E9 01 2F E9 01 00 00 01 0D E9 01 01 0D E9 01 30 E9 01 00 00 01 0E' + 'E9 01 01 0E E9 01 31 E9 01 00 00 01 0F E9 01 01 0F E9 01 32 E9 01 00 00 01 10 E9 01 01 10 E9 01' + '33 E9 01 00 00 01 11 E9 01 01 11 E9 01 34 E9 01 00 00 01 12 E9 01 01 12 E9 01 35 E9 01 00 00 01' + '13 E9 01 01 13 E9 01 36 E9 01 00 00 01 14 E9 01 01 14 E9 01 37 E9 01 00 00 01 15 E9 01 01 15 E9' + '01 38 E9 01 00 00 01 16 E9 01 01 16 E9 01 39 E9 01 00 00 01 17 E9 01 01 17 E9 01 3A E9 01 00 00' + '01 18 E9 01 01 18 E9 01 3B E9 01 00 00 01 19 E9 01 01 19 E9 01 3C E9 01 00 00 01 1A E9 01 01 1A' + 'E9 01 3D E9 01 00 00 01 1B E9 01 01 1B E9 01 3E E9 01 00 00 01 1C E9 01 01 1C E9 01 3F E9 01 00' + '00 01 1D E9 01 01 1D E9 01 40 E9 01 00 00 01 1E E9 01 01 1E E9 01 41 E9 01 00 00 01 1F E9 01 01' + '1F E9 01 42 E9 01 00 00 01 20 E9 01 01 20 E9 01 43 E9 01 00 00 01 21 E9 01 01 21 E9 01' +} + + +LANGUAGE 0,0 DECOMPOSITION UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE +{ + '68 16 00 00 A0 00 00 01 02 20 00 00 A8 00 00 02 10 20 00 00 08 03 00 AA 00 00 01 08 61 00 00 AF' + '00 00 02 10 20 00 00 04 03 00 B2 00 00 01 08 32 00 00 B3 00 00 01 08 33 00 00 B4 00 00 02 10 20' + '00 00 01 03 00 B5 00 00 01 10 BC 03 00 B8 00 00 02 10 20 00 00 27 03 00 B9 00 00 01 08 31 00 00' + 'BA 00 00 01 08 6F 00 00 BC 00 00 03 0F 31 00 00 44 20 00 34 00 00 BD 00 00 03 0F 31 00 00 44 20' + '00 32 00 00 BE 00 00 03 0F 33 00 00 44 20 00 34 00 00 C0 00 00 02 00 41 00 00 00 03 00 C1 00 00' + '02 00 41 00 00 01 03 00 C2 00 00 02 00 41 00 00 02 03 00 C3 00 00 02 00 41 00 00 03 03 00 C4 00' + '00 02 00 41 00 00 08 03 00 C5 00 00 02 00 41 00 00 0A 03 00 C7 00 00 02 00 43 00 00 27 03 00 C8' + '00 00 02 00 45 00 00 00 03 00 C9 00 00 02 00 45 00 00 01 03 00 CA 00 00 02 00 45 00 00 02 03 00' + 'CB 00 00 02 00 45 00 00 08 03 00 CC 00 00 02 00 49 00 00 00 03 00 CD 00 00 02 00 49 00 00 01 03' + '00 CE 00 00 02 00 49 00 00 02 03 00 CF 00 00 02 00 49 00 00 08 03 00 D1 00 00 02 00 4E 00 00 03' + '03 00 D2 00 00 02 00 4F 00 00 00 03 00 D3 00 00 02 00 4F 00 00 01 03 00 D4 00 00 02 00 4F 00 00' + '02 03 00 D5 00 00 02 00 4F 00 00 03 03 00 D6 00 00 02 00 4F 00 00 08 03 00 D9 00 00 02 00 55 00' + '00 00 03 00 DA 00 00 02 00 55 00 00 01 03 00 DB 00 00 02 00 55 00 00 02 03 00 DC 00 00 02 00 55' + '00 00 08 03 00 DD 00 00 02 00 59 00 00 01 03 00 E0 00 00 02 00 61 00 00 00 03 00 E1 00 00 02 00' + '61 00 00 01 03 00 E2 00 00 02 00 61 00 00 02 03 00 E3 00 00 02 00 61 00 00 03 03 00 E4 00 00 02' + '00 61 00 00 08 03 00 E5 00 00 02 00 61 00 00 0A 03 00 E7 00 00 02 00 63 00 00 27 03 00 E8 00 00' + '02 00 65 00 00 00 03 00 E9 00 00 02 00 65 00 00 01 03 00 EA 00 00 02 00 65 00 00 02 03 00 EB 00' + '00 02 00 65 00 00 08 03 00 EC 00 00 02 00 69 00 00 00 03 00 ED 00 00 02 00 69 00 00 01 03 00 EE' + '00 00 02 00 69 00 00 02 03 00 EF 00 00 02 00 69 00 00 08 03 00 F1 00 00 02 00 6E 00 00 03 03 00' + 'F2 00 00 02 00 6F 00 00 00 03 00 F3 00 00 02 00 6F 00 00 01 03 00 F4 00 00 02 00 6F 00 00 02 03' + '00 F5 00 00 02 00 6F 00 00 03 03 00 F6 00 00 02 00 6F 00 00 08 03 00 F9 00 00 02 00 75 00 00 00' + '03 00 FA 00 00 02 00 75 00 00 01 03 00 FB 00 00 02 00 75 00 00 02 03 00 FC 00 00 02 00 75 00 00' + '08 03 00 FD 00 00 02 00 79 00 00 01 03 00 FF 00 00 02 00 79 00 00 08 03 00 00 01 00 02 00 41 00' + '00 04 03 00 01 01 00 02 00 61 00 00 04 03 00 02 01 00 02 00 41 00 00 06 03 00 03 01 00 02 00 61' + '00 00 06 03 00 04 01 00 02 00 41 00 00 28 03 00 05 01 00 02 00 61 00 00 28 03 00 06 01 00 02 00' + '43 00 00 01 03 00 07 01 00 02 00 63 00 00 01 03 00 08 01 00 02 00 43 00 00 02 03 00 09 01 00 02' + '00 63 00 00 02 03 00 0A 01 00 02 00 43 00 00 07 03 00 0B 01 00 02 00 63 00 00 07 03 00 0C 01 00' + '02 00 43 00 00 0C 03 00 0D 01 00 02 00 63 00 00 0C 03 00 0E 01 00 02 00 44 00 00 0C 03 00 0F 01' + '00 02 00 64 00 00 0C 03 00 12 01 00 02 00 45 00 00 04 03 00 13 01 00 02 00 65 00 00 04 03 00 14' + '01 00 02 00 45 00 00 06 03 00 15 01 00 02 00 65 00 00 06 03 00 16 01 00 02 00 45 00 00 07 03 00' + '17 01 00 02 00 65 00 00 07 03 00 18 01 00 02 00 45 00 00 28 03 00 19 01 00 02 00 65 00 00 28 03' + '00 1A 01 00 02 00 45 00 00 0C 03 00 1B 01 00 02 00 65 00 00 0C 03 00 1C 01 00 02 00 47 00 00 02' + '03 00 1D 01 00 02 00 67 00 00 02 03 00 1E 01 00 02 00 47 00 00 06 03 00 1F 01 00 02 00 67 00 00' + '06 03 00 20 01 00 02 00 47 00 00 07 03 00 21 01 00 02 00 67 00 00 07 03 00 22 01 00 02 00 47 00' + '00 27 03 00 23 01 00 02 00 67 00 00 27 03 00 24 01 00 02 00 48 00 00 02 03 00 25 01 00 02 00 68' + '00 00 02 03 00 28 01 00 02 00 49 00 00 03 03 00 29 01 00 02 00 69 00 00 03 03 00 2A 01 00 02 00' + '49 00 00 04 03 00 2B 01 00 02 00 69 00 00 04 03 00 2C 01 00 02 00 49 00 00 06 03 00 2D 01 00 02' + '00 69 00 00 06 03 00 2E 01 00 02 00 49 00 00 28 03 00 2F 01 00 02 00 69 00 00 28 03 00 30 01 00' + '02 00 49 00 00 07 03 00 32 01 00 02 10 49 00 00 4A 00 00 33 01 00 02 10 69 00 00 6A 00 00 34 01' + '00 02 00 4A 00 00 02 03 00 35 01 00 02 00 6A 00 00 02 03 00 36 01 00 02 00 4B 00 00 27 03 00 37' + '01 00 02 00 6B 00 00 27 03 00 39 01 00 02 00 4C 00 00 01 03 00 3A 01 00 02 00 6C 00 00 01 03 00' + '3B 01 00 02 00 4C 00 00 27 03 00 3C 01 00 02 00 6C 00 00 27 03 00 3D 01 00 02 00 4C 00 00 0C 03' + '00 3E 01 00 02 00 6C 00 00 0C 03 00 3F 01 00 02 10 4C 00 00 B7 00 00 40 01 00 02 10 6C 00 00 B7' + '00 00 43 01 00 02 00 4E 00 00 01 03 00 44 01 00 02 00 6E 00 00 01 03 00 45 01 00 02 00 4E 00 00' + '27 03 00 46 01 00 02 00 6E 00 00 27 03 00 47 01 00 02 00 4E 00 00 0C 03 00 48 01 00 02 00 6E 00' + '00 0C 03 00 49 01 00 02 10 BC 02 00 6E 00 00 4C 01 00 02 00 4F 00 00 04 03 00 4D 01 00 02 00 6F' + '00 00 04 03 00 4E 01 00 02 00 4F 00 00 06 03 00 4F 01 00 02 00 6F 00 00 06 03 00 50 01 00 02 00' + '4F 00 00 0B 03 00 51 01 00 02 00 6F 00 00 0B 03 00 54 01 00 02 00 52 00 00 01 03 00 55 01 00 02' + '00 72 00 00 01 03 00 56 01 00 02 00 52 00 00 27 03 00 57 01 00 02 00 72 00 00 27 03 00 58 01 00' + '02 00 52 00 00 0C 03 00 59 01 00 02 00 72 00 00 0C 03 00 5A 01 00 02 00 53 00 00 01 03 00 5B 01' + '00 02 00 73 00 00 01 03 00 5C 01 00 02 00 53 00 00 02 03 00 5D 01 00 02 00 73 00 00 02 03 00 5E' + '01 00 02 00 53 00 00 27 03 00 5F 01 00 02 00 73 00 00 27 03 00 60 01 00 02 00 53 00 00 0C 03 00' + '61 01 00 02 00 73 00 00 0C 03 00 62 01 00 02 00 54 00 00 27 03 00 63 01 00 02 00 74 00 00 27 03' + '00 64 01 00 02 00 54 00 00 0C 03 00 65 01 00 02 00 74 00 00 0C 03 00 68 01 00 02 00 55 00 00 03' + '03 00 69 01 00 02 00 75 00 00 03 03 00 6A 01 00 02 00 55 00 00 04 03 00 6B 01 00 02 00 75 00 00' + '04 03 00 6C 01 00 02 00 55 00 00 06 03 00 6D 01 00 02 00 75 00 00 06 03 00 6E 01 00 02 00 55 00' + '00 0A 03 00 6F 01 00 02 00 75 00 00 0A 03 00 70 01 00 02 00 55 00 00 0B 03 00 71 01 00 02 00 75' + '00 00 0B 03 00 72 01 00 02 00 55 00 00 28 03 00 73 01 00 02 00 75 00 00 28 03 00 74 01 00 02 00' + '57 00 00 02 03 00 75 01 00 02 00 77 00 00 02 03 00 76 01 00 02 00 59 00 00 02 03 00 77 01 00 02' + '00 79 00 00 02 03 00 78 01 00 02 00 59 00 00 08 03 00 79 01 00 02 00 5A 00 00 01 03 00 7A 01 00' + '02 00 7A 00 00 01 03 00 7B 01 00 02 00 5A 00 00 07 03 00 7C 01 00 02 00 7A 00 00 07 03 00 7D 01' + '00 02 00 5A 00 00 0C 03 00 7E 01 00 02 00 7A 00 00 0C 03 00 7F 01 00 01 10 73 00 00 A0 01 00 02' + '00 4F 00 00 1B 03 00 A1 01 00 02 00 6F 00 00 1B 03 00 AF 01 00 02 00 55 00 00 1B 03 00 B0 01 00' + '02 00 75 00 00 1B 03 00 C4 01 00 03 10 44 00 00 5A 00 00 0C 03 00 C5 01 00 03 10 44 00 00 7A 00' + '00 0C 03 00 C6 01 00 03 10 64 00 00 7A 00 00 0C 03 00 C7 01 00 02 10 4C 00 00 4A 00 00 C8 01 00' + '02 10 4C 00 00 6A 00 00 C9 01 00 02 10 6C 00 00 6A 00 00 CA 01 00 02 10 4E 00 00 4A 00 00 CB 01' + '00 02 10 4E 00 00 6A 00 00 CC 01 00 02 10 6E 00 00 6A 00 00 CD 01 00 02 00 41 00 00 0C 03 00 CE' + '01 00 02 00 61 00 00 0C 03 00 CF 01 00 02 00 49 00 00 0C 03 00 D0 01 00 02 00 69 00 00 0C 03 00' + 'D1 01 00 02 00 4F 00 00 0C 03 00 D2 01 00 02 00 6F 00 00 0C 03 00 D3 01 00 02 00 55 00 00 0C 03' + '00 D4 01 00 02 00 75 00 00 0C 03 00 D5 01 00 03 00 55 00 00 08 03 00 04 03 00 D6 01 00 03 00 75' + '00 00 08 03 00 04 03 00 D7 01 00 03 00 55 00 00 08 03 00 01 03 00 D8 01 00 03 00 75 00 00 08 03' + '00 01 03 00 D9 01 00 03 00 55 00 00 08 03 00 0C 03 00 DA 01 00 03 00 75 00 00 08 03 00 0C 03 00' + 'DB 01 00 03 00 55 00 00 08 03 00 00 03 00 DC 01 00 03 00 75 00 00 08 03 00 00 03 00 DE 01 00 03' + '00 41 00 00 08 03 00 04 03 00 DF 01 00 03 00 61 00 00 08 03 00 04 03 00 E0 01 00 03 00 41 00 00' + '07 03 00 04 03 00 E1 01 00 03 00 61 00 00 07 03 00 04 03 00 E2 01 00 02 00 C6 00 00 04 03 00 E3' + '01 00 02 00 E6 00 00 04 03 00 E6 01 00 02 00 47 00 00 0C 03 00 E7 01 00 02 00 67 00 00 0C 03 00' + 'E8 01 00 02 00 4B 00 00 0C 03 00 E9 01 00 02 00 6B 00 00 0C 03 00 EA 01 00 02 00 4F 00 00 28 03' + '00 EB 01 00 02 00 6F 00 00 28 03 00 EC 01 00 03 00 4F 00 00 28 03 00 04 03 00 ED 01 00 03 00 6F' + '00 00 28 03 00 04 03 00 EE 01 00 02 00 B7 01 00 0C 03 00 EF 01 00 02 00 92 02 00 0C 03 00 F0 01' + '00 02 00 6A 00 00 0C 03 00 F1 01 00 02 10 44 00 00 5A 00 00 F2 01 00 02 10 44 00 00 7A 00 00 F3' + '01 00 02 10 64 00 00 7A 00 00 F4 01 00 02 00 47 00 00 01 03 00 F5 01 00 02 00 67 00 00 01 03 00' + 'F8 01 00 02 00 4E 00 00 00 03 00 F9 01 00 02 00 6E 00 00 00 03 00 FA 01 00 03 00 41 00 00 0A 03' + '00 01 03 00 FB 01 00 03 00 61 00 00 0A 03 00 01 03 00 FC 01 00 02 00 C6 00 00 01 03 00 FD 01 00' + '02 00 E6 00 00 01 03 00 FE 01 00 02 00 D8 00 00 01 03 00 FF 01 00 02 00 F8 00 00 01 03 00 00 02' + '00 02 00 41 00 00 0F 03 00 01 02 00 02 00 61 00 00 0F 03 00 02 02 00 02 00 41 00 00 11 03 00 03' + '02 00 02 00 61 00 00 11 03 00 04 02 00 02 00 45 00 00 0F 03 00 05 02 00 02 00 65 00 00 0F 03 00' + '06 02 00 02 00 45 00 00 11 03 00 07 02 00 02 00 65 00 00 11 03 00 08 02 00 02 00 49 00 00 0F 03' + '00 09 02 00 02 00 69 00 00 0F 03 00 0A 02 00 02 00 49 00 00 11 03 00 0B 02 00 02 00 69 00 00 11' + '03 00 0C 02 00 02 00 4F 00 00 0F 03 00 0D 02 00 02 00 6F 00 00 0F 03 00 0E 02 00 02 00 4F 00 00' + '11 03 00 0F 02 00 02 00 6F 00 00 11 03 00 10 02 00 02 00 52 00 00 0F 03 00 11 02 00 02 00 72 00' + '00 0F 03 00 12 02 00 02 00 52 00 00 11 03 00 13 02 00 02 00 72 00 00 11 03 00 14 02 00 02 00 55' + '00 00 0F 03 00 15 02 00 02 00 75 00 00 0F 03 00 16 02 00 02 00 55 00 00 11 03 00 17 02 00 02 00' + '75 00 00 11 03 00 18 02 00 02 00 53 00 00 26 03 00 19 02 00 02 00 73 00 00 26 03 00 1A 02 00 02' + '00 54 00 00 26 03 00 1B 02 00 02 00 74 00 00 26 03 00 1E 02 00 02 00 48 00 00 0C 03 00 1F 02 00' + '02 00 68 00 00 0C 03 00 26 02 00 02 00 41 00 00 07 03 00 27 02 00 02 00 61 00 00 07 03 00 28 02' + '00 02 00 45 00 00 27 03 00 29 02 00 02 00 65 00 00 27 03 00 2A 02 00 03 00 4F 00 00 08 03 00 04' + '03 00 2B 02 00 03 00 6F 00 00 08 03 00 04 03 00 2C 02 00 03 00 4F 00 00 03 03 00 04 03 00 2D 02' + '00 03 00 6F 00 00 03 03 00 04 03 00 2E 02 00 02 00 4F 00 00 07 03 00 2F 02 00 02 00 6F 00 00 07' + '03 00 30 02 00 03 00 4F 00 00 07 03 00 04 03 00 31 02 00 03 00 6F 00 00 07 03 00 04 03 00 32 02' + '00 02 00 59 00 00 04 03 00 33 02 00 02 00 79 00 00 04 03 00 B0 02 00 01 08 68 00 00 B1 02 00 01' + '08 66 02 00 B2 02 00 01 08 6A 00 00 B3 02 00 01 08 72 00 00 B4 02 00 01 08 79 02 00 B5 02 00 01' + '08 7B 02 00 B6 02 00 01 08 81 02 00 B7 02 00 01 08 77 00 00 B8 02 00 01 08 79 00 00 D8 02 00 02' + '10 20 00 00 06 03 00 D9 02 00 02 10 20 00 00 07 03 00 DA 02 00 02 10 20 00 00 0A 03 00 DB 02 00' + '02 10 20 00 00 28 03 00 DC 02 00 02 10 20 00 00 03 03 00 DD 02 00 02 10 20 00 00 0B 03 00 E0 02' + '00 01 08 63 02 00 E1 02 00 01 08 6C 00 00 E2 02 00 01 08 73 00 00 E3 02 00 01 08 78 00 00 E4 02' + '00 01 08 95 02 00 40 03 00 01 00 00 03 00 41 03 00 01 00 01 03 00 43 03 00 01 00 13 03 00 44 03' + '00 02 00 08 03 00 01 03 00 74 03 00 01 00 B9 02 00 7A 03 00 02 10 20 00 00 45 03 00 7E 03 00 01' + '00 3B 00 00 84 03 00 02 10 20 00 00 01 03 00 85 03 00 03 00 20 00 00 08 03 00 01 03 00 86 03 00' + '02 00 91 03 00 01 03 00 87 03 00 01 00 B7 00 00 88 03 00 02 00 95 03 00 01 03 00 89 03 00 02 00' + '97 03 00 01 03 00 8A 03 00 02 00 99 03 00 01 03 00 8C 03 00 02 00 9F 03 00 01 03 00 8E 03 00 02' + '00 A5 03 00 01 03 00 8F 03 00 02 00 A9 03 00 01 03 00 90 03 00 03 00 B9 03 00 08 03 00 01 03 00' + 'AA 03 00 02 00 99 03 00 08 03 00 AB 03 00 02 00 A5 03 00 08 03 00 AC 03 00 02 00 B1 03 00 01 03' + '00 AD 03 00 02 00 B5 03 00 01 03 00 AE 03 00 02 00 B7 03 00 01 03 00 AF 03 00 02 00 B9 03 00 01' + '03 00 B0 03 00 03 00 C5 03 00 08 03 00 01 03 00 CA 03 00 02 00 B9 03 00 08 03 00 CB 03 00 02 00' + 'C5 03 00 08 03 00 CC 03 00 02 00 BF 03 00 01 03 00 CD 03 00 02 00 C5 03 00 01 03 00 CE 03 00 02' + '00 C9 03 00 01 03 00 D0 03 00 01 10 B2 03 00 D1 03 00 01 10 B8 03 00 D2 03 00 01 10 A5 03 00 D3' + '03 00 02 00 A5 03 00 01 03 00 D4 03 00 02 00 A5 03 00 08 03 00 D5 03 00 01 10 C6 03 00 D6 03 00' + '01 10 C0 03 00 F0 03 00 01 10 BA 03 00 F1 03 00 01 10 C1 03 00 F2 03 00 01 10 C2 03 00 F4 03 00' + '01 10 98 03 00 F5 03 00 01 10 B5 03 00 F9 03 00 01 10 A3 03 00 00 04 00 02 00 15 04 00 00 03 00' + '01 04 00 02 00 15 04 00 08 03 00 03 04 00 02 00 13 04 00 01 03 00 07 04 00 02 00 06 04 00 08 03' + '00 0C 04 00 02 00 1A 04 00 01 03 00 0D 04 00 02 00 18 04 00 00 03 00 0E 04 00 02 00 23 04 00 06' + '03 00 19 04 00 02 00 18 04 00 06 03 00 39 04 00 02 00 38 04 00 06 03 00 50 04 00 02 00 35 04 00' + '00 03 00 51 04 00 02 00 35 04 00 08 03 00 53 04 00 02 00 33 04 00 01 03 00 57 04 00 02 00 56 04' + '00 08 03 00 5C 04 00 02 00 3A 04 00 01 03 00 5D 04 00 02 00 38 04 00 00 03 00 5E 04 00 02 00 43' + '04 00 06 03 00 76 04 00 02 00 74 04 00 0F 03 00 77 04 00 02 00 75 04 00 0F 03 00 C1 04 00 02 00' + '16 04 00 06 03 00 C2 04 00 02 00 36 04 00 06 03 00 D0 04 00 02 00 10 04 00 06 03 00 D1 04 00 02' + '00 30 04 00 06 03 00 D2 04 00 02 00 10 04 00 08 03 00 D3 04 00 02 00 30 04 00 08 03 00 D6 04 00' + '02 00 15 04 00 06 03 00 D7 04 00 02 00 35 04 00 06 03 00 DA 04 00 02 00 D8 04 00 08 03 00 DB 04' + '00 02 00 D9 04 00 08 03 00 DC 04 00 02 00 16 04 00 08 03 00 DD 04 00 02 00 36 04 00 08 03 00 DE' + '04 00 02 00 17 04 00 08 03 00 DF 04 00 02 00 37 04 00 08 03 00 E2 04 00 02 00 18 04 00 04 03 00' + 'E3 04 00 02 00 38 04 00 04 03 00 E4 04 00 02 00 18 04 00 08 03 00 E5 04 00 02 00 38 04 00 08 03' + '00 E6 04 00 02 00 1E 04 00 08 03 00 E7 04 00 02 00 3E 04 00 08 03 00 EA 04 00 02 00 E8 04 00 08' + '03 00 EB 04 00 02 00 E9 04 00 08 03 00 EC 04 00 02 00 2D 04 00 08 03 00 ED 04 00 02 00 4D 04 00' + '08 03 00 EE 04 00 02 00 23 04 00 04 03 00 EF 04 00 02 00 43 04 00 04 03 00 F0 04 00 02 00 23 04' + '00 08 03 00 F1 04 00 02 00 43 04 00 08 03 00 F2 04 00 02 00 23 04 00 0B 03 00 F3 04 00 02 00 43' + '04 00 0B 03 00 F4 04 00 02 00 27 04 00 08 03 00 F5 04 00 02 00 47 04 00 08 03 00 F8 04 00 02 00' + '2B 04 00 08 03 00 F9 04 00 02 00 4B 04 00 08 03 00 87 05 00 02 10 65 05 00 82 05 00 22 06 00 02' + '00 27 06 00 53 06 00 23 06 00 02 00 27 06 00 54 06 00 24 06 00 02 00 48 06 00 54 06 00 25 06 00' + '02 00 27 06 00 55 06 00 26 06 00 02 00 4A 06 00 54 06 00 75 06 00 02 10 27 06 00 74 06 00 76 06' + '00 02 10 48 06 00 74 06 00 77 06 00 02 10 C7 06 00 74 06 00 78 06 00 02 10 4A 06 00 74 06 00 C0' + '06 00 02 00 D5 06 00 54 06 00 C2 06 00 02 00 C1 06 00 54 06 00 D3 06 00 02 00 D2 06 00 54 06 00' + '29 09 00 02 00 28 09 00 3C 09 00 31 09 00 02 00 30 09 00 3C 09 00 34 09 00 02 00 33 09 00 3C 09' + '00 58 09 00 02 00 15 09 00 3C 09 00 59 09 00 02 00 16 09 00 3C 09 00 5A 09 00 02 00 17 09 00 3C' + '09 00 5B 09 00 02 00 1C 09 00 3C 09 00 5C 09 00 02 00 21 09 00 3C 09 00 5D 09 00 02 00 22 09 00' + '3C 09 00 5E 09 00 02 00 2B 09 00 3C 09 00 5F 09 00 02 00 2F 09 00 3C 09 00 CB 09 00 02 00 C7 09' + '00 BE 09 00 CC 09 00 02 00 C7 09 00 D7 09 00 DC 09 00 02 00 A1 09 00 BC 09 00 DD 09 00 02 00 A2' + '09 00 BC 09 00 DF 09 00 02 00 AF 09 00 BC 09 00 33 0A 00 02 00 32 0A 00 3C 0A 00 36 0A 00 02 00' + '38 0A 00 3C 0A 00 59 0A 00 02 00 16 0A 00 3C 0A 00 5A 0A 00 02 00 17 0A 00 3C 0A 00 5B 0A 00 02' + '00 1C 0A 00 3C 0A 00 5E 0A 00 02 00 2B 0A 00 3C 0A 00 48 0B 00 02 00 47 0B 00 56 0B 00 4B 0B 00' + '02 00 47 0B 00 3E 0B 00 4C 0B 00 02 00 47 0B 00 57 0B 00 5C 0B 00 02 00 21 0B 00 3C 0B 00 5D 0B' + '00 02 00 22 0B 00 3C 0B 00 94 0B 00 02 00 92 0B 00 D7 0B 00 CA 0B 00 02 00 C6 0B 00 BE 0B 00 CB' + '0B 00 02 00 C7 0B 00 BE 0B 00 CC 0B 00 02 00 C6 0B 00 D7 0B 00 48 0C 00 02 00 46 0C 00 56 0C 00' + 'C0 0C 00 02 00 BF 0C 00 D5 0C 00 C7 0C 00 02 00 C6 0C 00 D5 0C 00 C8 0C 00 02 00 C6 0C 00 D6 0C' + '00 CA 0C 00 02 00 C6 0C 00 C2 0C 00 CB 0C 00 03 00 C6 0C 00 C2 0C 00 D5 0C 00 4A 0D 00 02 00 46' + '0D 00 3E 0D 00 4B 0D 00 02 00 47 0D 00 3E 0D 00 4C 0D 00 02 00 46 0D 00 57 0D 00 DA 0D 00 02 00' + 'D9 0D 00 CA 0D 00 DC 0D 00 02 00 D9 0D 00 CF 0D 00 DD 0D 00 03 00 D9 0D 00 CF 0D 00 CA 0D 00 DE' + '0D 00 02 00 D9 0D 00 DF 0D 00 33 0E 00 02 10 4D 0E 00 32 0E 00 B3 0E 00 02 10 CD 0E 00 B2 0E 00' + 'DC 0E 00 02 10 AB 0E 00 99 0E 00 DD 0E 00 02 10 AB 0E 00 A1 0E 00 0C 0F 00 01 02 0B 0F 00 43 0F' + '00 02 00 42 0F 00 B7 0F 00 4D 0F 00 02 00 4C 0F 00 B7 0F 00 52 0F 00 02 00 51 0F 00 B7 0F 00 57' + '0F 00 02 00 56 0F 00 B7 0F 00 5C 0F 00 02 00 5B 0F 00 B7 0F 00 69 0F 00 02 00 40 0F 00 B5 0F 00' + '73 0F 00 02 00 71 0F 00 72 0F 00 75 0F 00 02 00 71 0F 00 74 0F 00 76 0F 00 02 00 B2 0F 00 80 0F' + '00 77 0F 00 03 10 B2 0F 00 71 0F 00 80 0F 00 78 0F 00 02 00 B3 0F 00 80 0F 00 79 0F 00 03 10 B3' + '0F 00 71 0F 00 80 0F 00 81 0F 00 02 00 71 0F 00 80 0F 00 93 0F 00 02 00 92 0F 00 B7 0F 00 9D 0F' + '00 02 00 9C 0F 00 B7 0F 00 A2 0F 00 02 00 A1 0F 00 B7 0F 00 A7 0F 00 02 00 A6 0F 00 B7 0F 00 AC' + '0F 00 02 00 AB 0F 00 B7 0F 00 B9 0F 00 02 00 90 0F 00 B5 0F 00 26 10 00 02 00 25 10 00 2E 10 00' + 'FC 10 00 01 08 DC 10 00 06 1B 00 02 00 05 1B 00 35 1B 00 08 1B 00 02 00 07 1B 00 35 1B 00 0A 1B' + '00 02 00 09 1B 00 35 1B 00 0C 1B 00 02 00 0B 1B 00 35 1B 00 0E 1B 00 02 00 0D 1B 00 35 1B 00 12' + '1B 00 02 00 11 1B 00 35 1B 00 3B 1B 00 02 00 3A 1B 00 35 1B 00 3D 1B 00 02 00 3C 1B 00 35 1B 00' + '40 1B 00 02 00 3E 1B 00 35 1B 00 41 1B 00 02 00 3F 1B 00 35 1B 00 43 1B 00 02 00 42 1B 00 35 1B' + '00 2C 1D 00 01 08 41 00 00 2D 1D 00 01 08 C6 00 00 2E 1D 00 01 08 42 00 00 30 1D 00 01 08 44 00' + '00 31 1D 00 01 08 45 00 00 32 1D 00 01 08 8E 01 00 33 1D 00 01 08 47 00 00 34 1D 00 01 08 48 00' + '00 35 1D 00 01 08 49 00 00 36 1D 00 01 08 4A 00 00 37 1D 00 01 08 4B 00 00 38 1D 00 01 08 4C 00' + '00 39 1D 00 01 08 4D 00 00 3A 1D 00 01 08 4E 00 00 3C 1D 00 01 08 4F 00 00 3D 1D 00 01 08 22 02' + '00 3E 1D 00 01 08 50 00 00 3F 1D 00 01 08 52 00 00 40 1D 00 01 08 54 00 00 41 1D 00 01 08 55 00' + '00 42 1D 00 01 08 57 00 00 43 1D 00 01 08 61 00 00 44 1D 00 01 08 50 02 00 45 1D 00 01 08 51 02' + '00 46 1D 00 01 08 02 1D 00 47 1D 00 01 08 62 00 00 48 1D 00 01 08 64 00 00 49 1D 00 01 08 65 00' + '00 4A 1D 00 01 08 59 02 00 4B 1D 00 01 08 5B 02 00 4C 1D 00 01 08 5C 02 00 4D 1D 00 01 08 67 00' + '00 4F 1D 00 01 08 6B 00 00 50 1D 00 01 08 6D 00 00 51 1D 00 01 08 4B 01 00 52 1D 00 01 08 6F 00' + '00 53 1D 00 01 08 54 02 00 54 1D 00 01 08 16 1D 00 55 1D 00 01 08 17 1D 00 56 1D 00 01 08 70 00' + '00 57 1D 00 01 08 74 00 00 58 1D 00 01 08 75 00 00 59 1D 00 01 08 1D 1D 00 5A 1D 00 01 08 6F 02' + '00 5B 1D 00 01 08 76 00 00 5C 1D 00 01 08 25 1D 00 5D 1D 00 01 08 B2 03 00 5E 1D 00 01 08 B3 03' + '00 5F 1D 00 01 08 B4 03 00 60 1D 00 01 08 C6 03 00 61 1D 00 01 08 C7 03 00 62 1D 00 01 09 69 00' + '00 63 1D 00 01 09 72 00 00 64 1D 00 01 09 75 00 00 65 1D 00 01 09 76 00 00 66 1D 00 01 09 B2 03' + '00 67 1D 00 01 09 B3 03 00 68 1D 00 01 09 C1 03 00 69 1D 00 01 09 C6 03 00 6A 1D 00 01 09 C7 03' + '00 78 1D 00 01 08 3D 04 00 9B 1D 00 01 08 52 02 00 9C 1D 00 01 08 63 00 00 9D 1D 00 01 08 55 02' + '00 9E 1D 00 01 08 F0 00 00 9F 1D 00 01 08 5C 02 00 A0 1D 00 01 08 66 00 00 A1 1D 00 01 08 5F 02' + '00 A2 1D 00 01 08 61 02 00 A3 1D 00 01 08 65 02 00 A4 1D 00 01 08 68 02 00 A5 1D 00 01 08 69 02' + '00 A6 1D 00 01 08 6A 02 00 A7 1D 00 01 08 7B 1D 00 A8 1D 00 01 08 9D 02 00 A9 1D 00 01 08 6D 02' + '00 AA 1D 00 01 08 85 1D 00 AB 1D 00 01 08 9F 02 00 AC 1D 00 01 08 71 02 00 AD 1D 00 01 08 70 02' + '00 AE 1D 00 01 08 72 02 00 AF 1D 00 01 08 73 02 00 B0 1D 00 01 08 74 02 00 B1 1D 00 01 08 75 02' + '00 B2 1D 00 01 08 78 02 00 B3 1D 00 01 08 82 02 00 B4 1D 00 01 08 83 02 00 B5 1D 00 01 08 AB 01' + '00 B6 1D 00 01 08 89 02 00 B7 1D 00 01 08 8A 02 00 B8 1D 00 01 08 1C 1D 00 B9 1D 00 01 08 8B 02' + '00 BA 1D 00 01 08 8C 02 00 BB 1D 00 01 08 7A 00 00 BC 1D 00 01 08 90 02 00 BD 1D 00 01 08 91 02' + '00 BE 1D 00 01 08 92 02 00 BF 1D 00 01 08 B8 03 00 00 1E 00 02 00 41 00 00 25 03 00 01 1E 00 02' + '00 61 00 00 25 03 00 02 1E 00 02 00 42 00 00 07 03 00 03 1E 00 02 00 62 00 00 07 03 00 04 1E 00' + '02 00 42 00 00 23 03 00 05 1E 00 02 00 62 00 00 23 03 00 06 1E 00 02 00 42 00 00 31 03 00 07 1E' + '00 02 00 62 00 00 31 03 00 08 1E 00 03 00 43 00 00 27 03 00 01 03 00 09 1E 00 03 00 63 00 00 27' + '03 00 01 03 00 0A 1E 00 02 00 44 00 00 07 03 00 0B 1E 00 02 00 64 00 00 07 03 00 0C 1E 00 02 00' + '44 00 00 23 03 00 0D 1E 00 02 00 64 00 00 23 03 00 0E 1E 00 02 00 44 00 00 31 03 00 0F 1E 00 02' + '00 64 00 00 31 03 00 10 1E 00 02 00 44 00 00 27 03 00 11 1E 00 02 00 64 00 00 27 03 00 12 1E 00' + '02 00 44 00 00 2D 03 00 13 1E 00 02 00 64 00 00 2D 03 00 14 1E 00 03 00 45 00 00 04 03 00 00 03' + '00 15 1E 00 03 00 65 00 00 04 03 00 00 03 00 16 1E 00 03 00 45 00 00 04 03 00 01 03 00 17 1E 00' + '03 00 65 00 00 04 03 00 01 03 00 18 1E 00 02 00 45 00 00 2D 03 00 19 1E 00 02 00 65 00 00 2D 03' + '00 1A 1E 00 02 00 45 00 00 30 03 00 1B 1E 00 02 00 65 00 00 30 03 00 1C 1E 00 03 00 45 00 00 27' + '03 00 06 03 00 1D 1E 00 03 00 65 00 00 27 03 00 06 03 00 1E 1E 00 02 00 46 00 00 07 03 00 1F 1E' + '00 02 00 66 00 00 07 03 00 20 1E 00 02 00 47 00 00 04 03 00 21 1E 00 02 00 67 00 00 04 03 00 22' + '1E 00 02 00 48 00 00 07 03 00 23 1E 00 02 00 68 00 00 07 03 00 24 1E 00 02 00 48 00 00 23 03 00' + '25 1E 00 02 00 68 00 00 23 03 00 26 1E 00 02 00 48 00 00 08 03 00 27 1E 00 02 00 68 00 00 08 03' + '00 28 1E 00 02 00 48 00 00 27 03 00 29 1E 00 02 00 68 00 00 27 03 00 2A 1E 00 02 00 48 00 00 2E' + '03 00 2B 1E 00 02 00 68 00 00 2E 03 00 2C 1E 00 02 00 49 00 00 30 03 00 2D 1E 00 02 00 69 00 00' + '30 03 00 2E 1E 00 03 00 49 00 00 08 03 00 01 03 00 2F 1E 00 03 00 69 00 00 08 03 00 01 03 00 30' + '1E 00 02 00 4B 00 00 01 03 00 31 1E 00 02 00 6B 00 00 01 03 00 32 1E 00 02 00 4B 00 00 23 03 00' + '33 1E 00 02 00 6B 00 00 23 03 00 34 1E 00 02 00 4B 00 00 31 03 00 35 1E 00 02 00 6B 00 00 31 03' + '00 36 1E 00 02 00 4C 00 00 23 03 00 37 1E 00 02 00 6C 00 00 23 03 00 38 1E 00 03 00 4C 00 00 23' + '03 00 04 03 00 39 1E 00 03 00 6C 00 00 23 03 00 04 03 00 3A 1E 00 02 00 4C 00 00 31 03 00 3B 1E' + '00 02 00 6C 00 00 31 03 00 3C 1E 00 02 00 4C 00 00 2D 03 00 3D 1E 00 02 00 6C 00 00 2D 03 00 3E' + '1E 00 02 00 4D 00 00 01 03 00 3F 1E 00 02 00 6D 00 00 01 03 00 40 1E 00 02 00 4D 00 00 07 03 00' + '41 1E 00 02 00 6D 00 00 07 03 00 42 1E 00 02 00 4D 00 00 23 03 00 43 1E 00 02 00 6D 00 00 23 03' + '00 44 1E 00 02 00 4E 00 00 07 03 00 45 1E 00 02 00 6E 00 00 07 03 00 46 1E 00 02 00 4E 00 00 23' + '03 00 47 1E 00 02 00 6E 00 00 23 03 00 48 1E 00 02 00 4E 00 00 31 03 00 49 1E 00 02 00 6E 00 00' + '31 03 00 4A 1E 00 02 00 4E 00 00 2D 03 00 4B 1E 00 02 00 6E 00 00 2D 03 00 4C 1E 00 03 00 4F 00' + '00 03 03 00 01 03 00 4D 1E 00 03 00 6F 00 00 03 03 00 01 03 00 4E 1E 00 03 00 4F 00 00 03 03 00' + '08 03 00 4F 1E 00 03 00 6F 00 00 03 03 00 08 03 00 50 1E 00 03 00 4F 00 00 04 03 00 00 03 00 51' + '1E 00 03 00 6F 00 00 04 03 00 00 03 00 52 1E 00 03 00 4F 00 00 04 03 00 01 03 00 53 1E 00 03 00' + '6F 00 00 04 03 00 01 03 00 54 1E 00 02 00 50 00 00 01 03 00 55 1E 00 02 00 70 00 00 01 03 00 56' + '1E 00 02 00 50 00 00 07 03 00 57 1E 00 02 00 70 00 00 07 03 00 58 1E 00 02 00 52 00 00 07 03 00' + '59 1E 00 02 00 72 00 00 07 03 00 5A 1E 00 02 00 52 00 00 23 03 00 5B 1E 00 02 00 72 00 00 23 03' + '00 5C 1E 00 03 00 52 00 00 23 03 00 04 03 00 5D 1E 00 03 00 72 00 00 23 03 00 04 03 00 5E 1E 00' + '02 00 52 00 00 31 03 00 5F 1E 00 02 00 72 00 00 31 03 00 60 1E 00 02 00 53 00 00 07 03 00 61 1E' + '00 02 00 73 00 00 07 03 00 62 1E 00 02 00 53 00 00 23 03 00 63 1E 00 02 00 73 00 00 23 03 00 64' + '1E 00 03 00 53 00 00 01 03 00 07 03 00 65 1E 00 03 00 73 00 00 01 03 00 07 03 00 66 1E 00 03 00' + '53 00 00 0C 03 00 07 03 00 67 1E 00 03 00 73 00 00 0C 03 00 07 03 00 68 1E 00 03 00 53 00 00 23' + '03 00 07 03 00 69 1E 00 03 00 73 00 00 23 03 00 07 03 00 6A 1E 00 02 00 54 00 00 07 03 00 6B 1E' + '00 02 00 74 00 00 07 03 00 6C 1E 00 02 00 54 00 00 23 03 00 6D 1E 00 02 00 74 00 00 23 03 00 6E' + '1E 00 02 00 54 00 00 31 03 00 6F 1E 00 02 00 74 00 00 31 03 00 70 1E 00 02 00 54 00 00 2D 03 00' + '71 1E 00 02 00 74 00 00 2D 03 00 72 1E 00 02 00 55 00 00 24 03 00 73 1E 00 02 00 75 00 00 24 03' + '00 74 1E 00 02 00 55 00 00 30 03 00 75 1E 00 02 00 75 00 00 30 03 00 76 1E 00 02 00 55 00 00 2D' + '03 00 77 1E 00 02 00 75 00 00 2D 03 00 78 1E 00 03 00 55 00 00 03 03 00 01 03 00 79 1E 00 03 00' + '75 00 00 03 03 00 01 03 00 7A 1E 00 03 00 55 00 00 04 03 00 08 03 00 7B 1E 00 03 00 75 00 00 04' + '03 00 08 03 00 7C 1E 00 02 00 56 00 00 03 03 00 7D 1E 00 02 00 76 00 00 03 03 00 7E 1E 00 02 00' + '56 00 00 23 03 00 7F 1E 00 02 00 76 00 00 23 03 00 80 1E 00 02 00 57 00 00 00 03 00 81 1E 00 02' + '00 77 00 00 00 03 00 82 1E 00 02 00 57 00 00 01 03 00 83 1E 00 02 00 77 00 00 01 03 00 84 1E 00' + '02 00 57 00 00 08 03 00 85 1E 00 02 00 77 00 00 08 03 00 86 1E 00 02 00 57 00 00 07 03 00 87 1E' + '00 02 00 77 00 00 07 03 00 88 1E 00 02 00 57 00 00 23 03 00 89 1E 00 02 00 77 00 00 23 03 00 8A' + '1E 00 02 00 58 00 00 07 03 00 8B 1E 00 02 00 78 00 00 07 03 00 8C 1E 00 02 00 58 00 00 08 03 00' + '8D 1E 00 02 00 78 00 00 08 03 00 8E 1E 00 02 00 59 00 00 07 03 00 8F 1E 00 02 00 79 00 00 07 03' + '00 90 1E 00 02 00 5A 00 00 02 03 00 91 1E 00 02 00 7A 00 00 02 03 00 92 1E 00 02 00 5A 00 00 23' + '03 00 93 1E 00 02 00 7A 00 00 23 03 00 94 1E 00 02 00 5A 00 00 31 03 00 95 1E 00 02 00 7A 00 00' + '31 03 00 96 1E 00 02 00 68 00 00 31 03 00 97 1E 00 02 00 74 00 00 08 03 00 98 1E 00 02 00 77 00' + '00 0A 03 00 99 1E 00 02 00 79 00 00 0A 03 00 9A 1E 00 02 10 61 00 00 BE 02 00 9B 1E 00 02 00 73' + '00 00 07 03 00 A0 1E 00 02 00 41 00 00 23 03 00 A1 1E 00 02 00 61 00 00 23 03 00 A2 1E 00 02 00' + '41 00 00 09 03 00 A3 1E 00 02 00 61 00 00 09 03 00 A4 1E 00 03 00 41 00 00 02 03 00 01 03 00 A5' + '1E 00 03 00 61 00 00 02 03 00 01 03 00 A6 1E 00 03 00 41 00 00 02 03 00 00 03 00 A7 1E 00 03 00' + '61 00 00 02 03 00 00 03 00 A8 1E 00 03 00 41 00 00 02 03 00 09 03 00 A9 1E 00 03 00 61 00 00 02' + '03 00 09 03 00 AA 1E 00 03 00 41 00 00 02 03 00 03 03 00 AB 1E 00 03 00 61 00 00 02 03 00 03 03' + '00 AC 1E 00 03 00 41 00 00 23 03 00 02 03 00 AD 1E 00 03 00 61 00 00 23 03 00 02 03 00 AE 1E 00' + '03 00 41 00 00 06 03 00 01 03 00 AF 1E 00 03 00 61 00 00 06 03 00 01 03 00 B0 1E 00 03 00 41 00' + '00 06 03 00 00 03 00 B1 1E 00 03 00 61 00 00 06 03 00 00 03 00 B2 1E 00 03 00 41 00 00 06 03 00' + '09 03 00 B3 1E 00 03 00 61 00 00 06 03 00 09 03 00 B4 1E 00 03 00 41 00 00 06 03 00 03 03 00 B5' + '1E 00 03 00 61 00 00 06 03 00 03 03 00 B6 1E 00 03 00 41 00 00 23 03 00 06 03 00 B7 1E 00 03 00' + '61 00 00 23 03 00 06 03 00 B8 1E 00 02 00 45 00 00 23 03 00 B9 1E 00 02 00 65 00 00 23 03 00 BA' + '1E 00 02 00 45 00 00 09 03 00 BB 1E 00 02 00 65 00 00 09 03 00 BC 1E 00 02 00 45 00 00 03 03 00' + 'BD 1E 00 02 00 65 00 00 03 03 00 BE 1E 00 03 00 45 00 00 02 03 00 01 03 00 BF 1E 00 03 00 65 00' + '00 02 03 00 01 03 00 C0 1E 00 03 00 45 00 00 02 03 00 00 03 00 C1 1E 00 03 00 65 00 00 02 03 00' + '00 03 00 C2 1E 00 03 00 45 00 00 02 03 00 09 03 00 C3 1E 00 03 00 65 00 00 02 03 00 09 03 00 C4' + '1E 00 03 00 45 00 00 02 03 00 03 03 00 C5 1E 00 03 00 65 00 00 02 03 00 03 03 00 C6 1E 00 03 00' + '45 00 00 23 03 00 02 03 00 C7 1E 00 03 00 65 00 00 23 03 00 02 03 00 C8 1E 00 02 00 49 00 00 09' + '03 00 C9 1E 00 02 00 69 00 00 09 03 00 CA 1E 00 02 00 49 00 00 23 03 00 CB 1E 00 02 00 69 00 00' + '23 03 00 CC 1E 00 02 00 4F 00 00 23 03 00 CD 1E 00 02 00 6F 00 00 23 03 00 CE 1E 00 02 00 4F 00' + '00 09 03 00 CF 1E 00 02 00 6F 00 00 09 03 00 D0 1E 00 03 00 4F 00 00 02 03 00 01 03 00 D1 1E 00' + '03 00 6F 00 00 02 03 00 01 03 00 D2 1E 00 03 00 4F 00 00 02 03 00 00 03 00 D3 1E 00 03 00 6F 00' + '00 02 03 00 00 03 00 D4 1E 00 03 00 4F 00 00 02 03 00 09 03 00 D5 1E 00 03 00 6F 00 00 02 03 00' + '09 03 00 D6 1E 00 03 00 4F 00 00 02 03 00 03 03 00 D7 1E 00 03 00 6F 00 00 02 03 00 03 03 00 D8' + '1E 00 03 00 4F 00 00 23 03 00 02 03 00 D9 1E 00 03 00 6F 00 00 23 03 00 02 03 00 DA 1E 00 03 00' + '4F 00 00 1B 03 00 01 03 00 DB 1E 00 03 00 6F 00 00 1B 03 00 01 03 00 DC 1E 00 03 00 4F 00 00 1B' + '03 00 00 03 00 DD 1E 00 03 00 6F 00 00 1B 03 00 00 03 00 DE 1E 00 03 00 4F 00 00 1B 03 00 09 03' + '00 DF 1E 00 03 00 6F 00 00 1B 03 00 09 03 00 E0 1E 00 03 00 4F 00 00 1B 03 00 03 03 00 E1 1E 00' + '03 00 6F 00 00 1B 03 00 03 03 00 E2 1E 00 03 00 4F 00 00 1B 03 00 23 03 00 E3 1E 00 03 00 6F 00' + '00 1B 03 00 23 03 00 E4 1E 00 02 00 55 00 00 23 03 00 E5 1E 00 02 00 75 00 00 23 03 00 E6 1E 00' + '02 00 55 00 00 09 03 00 E7 1E 00 02 00 75 00 00 09 03 00 E8 1E 00 03 00 55 00 00 1B 03 00 01 03' + '00 E9 1E 00 03 00 75 00 00 1B 03 00 01 03 00 EA 1E 00 03 00 55 00 00 1B 03 00 00 03 00 EB 1E 00' + '03 00 75 00 00 1B 03 00 00 03 00 EC 1E 00 03 00 55 00 00 1B 03 00 09 03 00 ED 1E 00 03 00 75 00' + '00 1B 03 00 09 03 00 EE 1E 00 03 00 55 00 00 1B 03 00 03 03 00 EF 1E 00 03 00 75 00 00 1B 03 00' + '03 03 00 F0 1E 00 03 00 55 00 00 1B 03 00 23 03 00 F1 1E 00 03 00 75 00 00 1B 03 00 23 03 00 F2' + '1E 00 02 00 59 00 00 00 03 00 F3 1E 00 02 00 79 00 00 00 03 00 F4 1E 00 02 00 59 00 00 23 03 00' + 'F5 1E 00 02 00 79 00 00 23 03 00 F6 1E 00 02 00 59 00 00 09 03 00 F7 1E 00 02 00 79 00 00 09 03' + '00 F8 1E 00 02 00 59 00 00 03 03 00 F9 1E 00 02 00 79 00 00 03 03 00 00 1F 00 02 00 B1 03 00 13' + '03 00 01 1F 00 02 00 B1 03 00 14 03 00 02 1F 00 03 00 B1 03 00 13 03 00 00 03 00 03 1F 00 03 00' + 'B1 03 00 14 03 00 00 03 00 04 1F 00 03 00 B1 03 00 13 03 00 01 03 00 05 1F 00 03 00 B1 03 00 14' + '03 00 01 03 00 06 1F 00 03 00 B1 03 00 13 03 00 42 03 00 07 1F 00 03 00 B1 03 00 14 03 00 42 03' + '00 08 1F 00 02 00 91 03 00 13 03 00 09 1F 00 02 00 91 03 00 14 03 00 0A 1F 00 03 00 91 03 00 13' + '03 00 00 03 00 0B 1F 00 03 00 91 03 00 14 03 00 00 03 00 0C 1F 00 03 00 91 03 00 13 03 00 01 03' + '00 0D 1F 00 03 00 91 03 00 14 03 00 01 03 00 0E 1F 00 03 00 91 03 00 13 03 00 42 03 00 0F 1F 00' + '03 00 91 03 00 14 03 00 42 03 00 10 1F 00 02 00 B5 03 00 13 03 00 11 1F 00 02 00 B5 03 00 14 03' + '00 12 1F 00 03 00 B5 03 00 13 03 00 00 03 00 13 1F 00 03 00 B5 03 00 14 03 00 00 03 00 14 1F 00' + '03 00 B5 03 00 13 03 00 01 03 00 15 1F 00 03 00 B5 03 00 14 03 00 01 03 00 18 1F 00 02 00 95 03' + '00 13 03 00 19 1F 00 02 00 95 03 00 14 03 00 1A 1F 00 03 00 95 03 00 13 03 00 00 03 00 1B 1F 00' + '03 00 95 03 00 14 03 00 00 03 00 1C 1F 00 03 00 95 03 00 13 03 00 01 03 00 1D 1F 00 03 00 95 03' + '00 14 03 00 01 03 00 20 1F 00 02 00 B7 03 00 13 03 00 21 1F 00 02 00 B7 03 00 14 03 00 22 1F 00' + '03 00 B7 03 00 13 03 00 00 03 00 23 1F 00 03 00 B7 03 00 14 03 00 00 03 00 24 1F 00 03 00 B7 03' + '00 13 03 00 01 03 00 25 1F 00 03 00 B7 03 00 14 03 00 01 03 00 26 1F 00 03 00 B7 03 00 13 03 00' + '42 03 00 27 1F 00 03 00 B7 03 00 14 03 00 42 03 00 28 1F 00 02 00 97 03 00 13 03 00 29 1F 00 02' + '00 97 03 00 14 03 00 2A 1F 00 03 00 97 03 00 13 03 00 00 03 00 2B 1F 00 03 00 97 03 00 14 03 00' + '00 03 00 2C 1F 00 03 00 97 03 00 13 03 00 01 03 00 2D 1F 00 03 00 97 03 00 14 03 00 01 03 00 2E' + '1F 00 03 00 97 03 00 13 03 00 42 03 00 2F 1F 00 03 00 97 03 00 14 03 00 42 03 00 30 1F 00 02 00' + 'B9 03 00 13 03 00 31 1F 00 02 00 B9 03 00 14 03 00 32 1F 00 03 00 B9 03 00 13 03 00 00 03 00 33' + '1F 00 03 00 B9 03 00 14 03 00 00 03 00 34 1F 00 03 00 B9 03 00 13 03 00 01 03 00 35 1F 00 03 00' + 'B9 03 00 14 03 00 01 03 00 36 1F 00 03 00 B9 03 00 13 03 00 42 03 00 37 1F 00 03 00 B9 03 00 14' + '03 00 42 03 00 38 1F 00 02 00 99 03 00 13 03 00 39 1F 00 02 00 99 03 00 14 03 00 3A 1F 00 03 00' + '99 03 00 13 03 00 00 03 00 3B 1F 00 03 00 99 03 00 14 03 00 00 03 00 3C 1F 00 03 00 99 03 00 13' + '03 00 01 03 00 3D 1F 00 03 00 99 03 00 14 03 00 01 03 00 3E 1F 00 03 00 99 03 00 13 03 00 42 03' + '00 3F 1F 00 03 00 99 03 00 14 03 00 42 03 00 40 1F 00 02 00 BF 03 00 13 03 00 41 1F 00 02 00 BF' + '03 00 14 03 00 42 1F 00 03 00 BF 03 00 13 03 00 00 03 00 43 1F 00 03 00 BF 03 00 14 03 00 00 03' + '00 44 1F 00 03 00 BF 03 00 13 03 00 01 03 00 45 1F 00 03 00 BF 03 00 14 03 00 01 03 00 48 1F 00' + '02 00 9F 03 00 13 03 00 49 1F 00 02 00 9F 03 00 14 03 00 4A 1F 00 03 00 9F 03 00 13 03 00 00 03' + '00 4B 1F 00 03 00 9F 03 00 14 03 00 00 03 00 4C 1F 00 03 00 9F 03 00 13 03 00 01 03 00 4D 1F 00' + '03 00 9F 03 00 14 03 00 01 03 00 50 1F 00 02 00 C5 03 00 13 03 00 51 1F 00 02 00 C5 03 00 14 03' + '00 52 1F 00 03 00 C5 03 00 13 03 00 00 03 00 53 1F 00 03 00 C5 03 00 14 03 00 00 03 00 54 1F 00' + '03 00 C5 03 00 13 03 00 01 03 00 55 1F 00 03 00 C5 03 00 14 03 00 01 03 00 56 1F 00 03 00 C5 03' + '00 13 03 00 42 03 00 57 1F 00 03 00 C5 03 00 14 03 00 42 03 00 59 1F 00 02 00 A5 03 00 14 03 00' + '5B 1F 00 03 00 A5 03 00 14 03 00 00 03 00 5D 1F 00 03 00 A5 03 00 14 03 00 01 03 00 5F 1F 00 03' + '00 A5 03 00 14 03 00 42 03 00 60 1F 00 02 00 C9 03 00 13 03 00 61 1F 00 02 00 C9 03 00 14 03 00' + '62 1F 00 03 00 C9 03 00 13 03 00 00 03 00 63 1F 00 03 00 C9 03 00 14 03 00 00 03 00 64 1F 00 03' + '00 C9 03 00 13 03 00 01 03 00 65 1F 00 03 00 C9 03 00 14 03 00 01 03 00 66 1F 00 03 00 C9 03 00' + '13 03 00 42 03 00 67 1F 00 03 00 C9 03 00 14 03 00 42 03 00 68 1F 00 02 00 A9 03 00 13 03 00 69' + '1F 00 02 00 A9 03 00 14 03 00 6A 1F 00 03 00 A9 03 00 13 03 00 00 03 00 6B 1F 00 03 00 A9 03 00' + '14 03 00 00 03 00 6C 1F 00 03 00 A9 03 00 13 03 00 01 03 00 6D 1F 00 03 00 A9 03 00 14 03 00 01' + '03 00 6E 1F 00 03 00 A9 03 00 13 03 00 42 03 00 6F 1F 00 03 00 A9 03 00 14 03 00 42 03 00 70 1F' + '00 02 00 B1 03 00 00 03 00 71 1F 00 02 00 B1 03 00 01 03 00 72 1F 00 02 00 B5 03 00 00 03 00 73' + '1F 00 02 00 B5 03 00 01 03 00 74 1F 00 02 00 B7 03 00 00 03 00 75 1F 00 02 00 B7 03 00 01 03 00' + '76 1F 00 02 00 B9 03 00 00 03 00 77 1F 00 02 00 B9 03 00 01 03 00 78 1F 00 02 00 BF 03 00 00 03' + '00 79 1F 00 02 00 BF 03 00 01 03 00 7A 1F 00 02 00 C5 03 00 00 03 00 7B 1F 00 02 00 C5 03 00 01' + '03 00 7C 1F 00 02 00 C9 03 00 00 03 00 7D 1F 00 02 00 C9 03 00 01 03 00 80 1F 00 03 00 B1 03 00' + '13 03 00 45 03 00 81 1F 00 03 00 B1 03 00 14 03 00 45 03 00 82 1F 00 04 00 B1 03 00 13 03 00 00' + '03 00 45 03 00 83 1F 00 04 00 B1 03 00 14 03 00 00 03 00 45 03 00 84 1F 00 04 00 B1 03 00 13 03' + '00 01 03 00 45 03 00 85 1F 00 04 00 B1 03 00 14 03 00 01 03 00 45 03 00 86 1F 00 04 00 B1 03 00' + '13 03 00 42 03 00 45 03 00 87 1F 00 04 00 B1 03 00 14 03 00 42 03 00 45 03 00 88 1F 00 03 00 91' + '03 00 13 03 00 45 03 00 89 1F 00 03 00 91 03 00 14 03 00 45 03 00 8A 1F 00 04 00 91 03 00 13 03' + '00 00 03 00 45 03 00 8B 1F 00 04 00 91 03 00 14 03 00 00 03 00 45 03 00 8C 1F 00 04 00 91 03 00' + '13 03 00 01 03 00 45 03 00 8D 1F 00 04 00 91 03 00 14 03 00 01 03 00 45 03 00 8E 1F 00 04 00 91' + '03 00 13 03 00 42 03 00 45 03 00 8F 1F 00 04 00 91 03 00 14 03 00 42 03 00 45 03 00 90 1F 00 03' + '00 B7 03 00 13 03 00 45 03 00 91 1F 00 03 00 B7 03 00 14 03 00 45 03 00 92 1F 00 04 00 B7 03 00' + '13 03 00 00 03 00 45 03 00 93 1F 00 04 00 B7 03 00 14 03 00 00 03 00 45 03 00 94 1F 00 04 00 B7' + '03 00 13 03 00 01 03 00 45 03 00 95 1F 00 04 00 B7 03 00 14 03 00 01 03 00 45 03 00 96 1F 00 04' + '00 B7 03 00 13 03 00 42 03 00 45 03 00 97 1F 00 04 00 B7 03 00 14 03 00 42 03 00 45 03 00 98 1F' + '00 03 00 97 03 00 13 03 00 45 03 00 99 1F 00 03 00 97 03 00 14 03 00 45 03 00 9A 1F 00 04 00 97' + '03 00 13 03 00 00 03 00 45 03 00 9B 1F 00 04 00 97 03 00 14 03 00 00 03 00 45 03 00 9C 1F 00 04' + '00 97 03 00 13 03 00 01 03 00 45 03 00 9D 1F 00 04 00 97 03 00 14 03 00 01 03 00 45 03 00 9E 1F' + '00 04 00 97 03 00 13 03 00 42 03 00 45 03 00 9F 1F 00 04 00 97 03 00 14 03 00 42 03 00 45 03 00' + 'A0 1F 00 03 00 C9 03 00 13 03 00 45 03 00 A1 1F 00 03 00 C9 03 00 14 03 00 45 03 00 A2 1F 00 04' + '00 C9 03 00 13 03 00 00 03 00 45 03 00 A3 1F 00 04 00 C9 03 00 14 03 00 00 03 00 45 03 00 A4 1F' + '00 04 00 C9 03 00 13 03 00 01 03 00 45 03 00 A5 1F 00 04 00 C9 03 00 14 03 00 01 03 00 45 03 00' + 'A6 1F 00 04 00 C9 03 00 13 03 00 42 03 00 45 03 00 A7 1F 00 04 00 C9 03 00 14 03 00 42 03 00 45' + '03 00 A8 1F 00 03 00 A9 03 00 13 03 00 45 03 00 A9 1F 00 03 00 A9 03 00 14 03 00 45 03 00 AA 1F' + '00 04 00 A9 03 00 13 03 00 00 03 00 45 03 00 AB 1F 00 04 00 A9 03 00 14 03 00 00 03 00 45 03 00' + 'AC 1F 00 04 00 A9 03 00 13 03 00 01 03 00 45 03 00 AD 1F 00 04 00 A9 03 00 14 03 00 01 03 00 45' + '03 00 AE 1F 00 04 00 A9 03 00 13 03 00 42 03 00 45 03 00 AF 1F 00 04 00 A9 03 00 14 03 00 42 03' + '00 45 03 00 B0 1F 00 02 00 B1 03 00 06 03 00 B1 1F 00 02 00 B1 03 00 04 03 00 B2 1F 00 03 00 B1' + '03 00 00 03 00 45 03 00 B3 1F 00 02 00 B1 03 00 45 03 00 B4 1F 00 03 00 B1 03 00 01 03 00 45 03' + '00 B6 1F 00 02 00 B1 03 00 42 03 00 B7 1F 00 03 00 B1 03 00 42 03 00 45 03 00 B8 1F 00 02 00 91' + '03 00 06 03 00 B9 1F 00 02 00 91 03 00 04 03 00 BA 1F 00 02 00 91 03 00 00 03 00 BB 1F 00 02 00' + '91 03 00 01 03 00 BC 1F 00 02 00 91 03 00 45 03 00 BD 1F 00 02 10 20 00 00 13 03 00 BE 1F 00 01' + '00 B9 03 00 BF 1F 00 02 10 20 00 00 13 03 00 C0 1F 00 02 10 20 00 00 42 03 00 C1 1F 00 03 00 20' + '00 00 08 03 00 42 03 00 C2 1F 00 03 00 B7 03 00 00 03 00 45 03 00 C3 1F 00 02 00 B7 03 00 45 03' + '00 C4 1F 00 03 00 B7 03 00 01 03 00 45 03 00 C6 1F 00 02 00 B7 03 00 42 03 00 C7 1F 00 03 00 B7' + '03 00 42 03 00 45 03 00 C8 1F 00 02 00 95 03 00 00 03 00 C9 1F 00 02 00 95 03 00 01 03 00 CA 1F' + '00 02 00 97 03 00 00 03 00 CB 1F 00 02 00 97 03 00 01 03 00 CC 1F 00 02 00 97 03 00 45 03 00 CD' + '1F 00 03 00 20 00 00 13 03 00 00 03 00 CE 1F 00 03 00 20 00 00 13 03 00 01 03 00 CF 1F 00 03 00' + '20 00 00 13 03 00 42 03 00 D0 1F 00 02 00 B9 03 00 06 03 00 D1 1F 00 02 00 B9 03 00 04 03 00 D2' + '1F 00 03 00 B9 03 00 08 03 00 00 03 00 D3 1F 00 03 00 B9 03 00 08 03 00 01 03 00 D6 1F 00 02 00' + 'B9 03 00 42 03 00 D7 1F 00 03 00 B9 03 00 08 03 00 42 03 00 D8 1F 00 02 00 99 03 00 06 03 00 D9' + '1F 00 02 00 99 03 00 04 03 00 DA 1F 00 02 00 99 03 00 00 03 00 DB 1F 00 02 00 99 03 00 01 03 00' + 'DD 1F 00 03 00 20 00 00 14 03 00 00 03 00 DE 1F 00 03 00 20 00 00 14 03 00 01 03 00 DF 1F 00 03' + '00 20 00 00 14 03 00 42 03 00 E0 1F 00 02 00 C5 03 00 06 03 00 E1 1F 00 02 00 C5 03 00 04 03 00' + 'E2 1F 00 03 00 C5 03 00 08 03 00 00 03 00 E3 1F 00 03 00 C5 03 00 08 03 00 01 03 00 E4 1F 00 02' + '00 C1 03 00 13 03 00 E5 1F 00 02 00 C1 03 00 14 03 00 E6 1F 00 02 00 C5 03 00 42 03 00 E7 1F 00' + '03 00 C5 03 00 08 03 00 42 03 00 E8 1F 00 02 00 A5 03 00 06 03 00 E9 1F 00 02 00 A5 03 00 04 03' + '00 EA 1F 00 02 00 A5 03 00 00 03 00 EB 1F 00 02 00 A5 03 00 01 03 00 EC 1F 00 02 00 A1 03 00 14' + '03 00 ED 1F 00 03 00 20 00 00 08 03 00 00 03 00 EE 1F 00 03 00 20 00 00 08 03 00 01 03 00 EF 1F' + '00 01 00 60 00 00 F2 1F 00 03 00 C9 03 00 00 03 00 45 03 00 F3 1F 00 02 00 C9 03 00 45 03 00 F4' + '1F 00 03 00 C9 03 00 01 03 00 45 03 00 F6 1F 00 02 00 C9 03 00 42 03 00 F7 1F 00 03 00 C9 03 00' + '42 03 00 45 03 00 F8 1F 00 02 00 9F 03 00 00 03 00 F9 1F 00 02 00 9F 03 00 01 03 00 FA 1F 00 02' + '00 A9 03 00 00 03 00 FB 1F 00 02 00 A9 03 00 01 03 00 FC 1F 00 02 00 A9 03 00 45 03 00 FD 1F 00' + '02 00 20 00 00 01 03 00 FE 1F 00 02 10 20 00 00 14 03 00 00 20 00 01 00 20 00 00 01 20 00 01 00' + '20 00 00 02 20 00 01 10 20 00 00 03 20 00 01 10 20 00 00 04 20 00 01 10 20 00 00 05 20 00 01 10' + '20 00 00 06 20 00 01 10 20 00 00 07 20 00 01 02 20 00 00 08 20 00 01 10 20 00 00 09 20 00 01 10' + '20 00 00 0A 20 00 01 10 20 00 00 11 20 00 01 02 10 20 00 17 20 00 02 10 20 00 00 33 03 00 24 20' + '00 01 10 2E 00 00 25 20 00 02 10 2E 00 00 2E 00 00 26 20 00 03 10 2E 00 00 2E 00 00 2E 00 00 2F' + '20 00 01 02 20 00 00 33 20 00 02 10 32 20 00 32 20 00 34 20 00 03 10 32 20 00 32 20 00 32 20 00' + '36 20 00 02 10 35 20 00 35 20 00 37 20 00 03 10 35 20 00 35 20 00 35 20 00 3C 20 00 02 10 21 00' + '00 21 00 00 3E 20 00 02 10 20 00 00 05 03 00 47 20 00 02 10 3F 00 00 3F 00 00 48 20 00 02 10 3F' + '00 00 21 00 00 49 20 00 02 10 21 00 00 3F 00 00 57 20 00 04 10 32 20 00 32 20 00 32 20 00 32 20' + '00 5F 20 00 01 10 20 00 00 70 20 00 01 08 30 00 00 71 20 00 01 08 69 00 00 74 20 00 01 08 34 00' + '00 75 20 00 01 08 35 00 00 76 20 00 01 08 36 00 00 77 20 00 01 08 37 00 00 78 20 00 01 08 38 00' + '00 79 20 00 01 08 39 00 00 7A 20 00 01 08 2B 00 00 7B 20 00 01 08 12 22 00 7C 20 00 01 08 3D 00' + '00 7D 20 00 01 08 28 00 00 7E 20 00 01 08 29 00 00 7F 20 00 01 08 6E 00 00 80 20 00 01 09 30 00' + '00 81 20 00 01 09 31 00 00 82 20 00 01 09 32 00 00 83 20 00 01 09 33 00 00 84 20 00 01 09 34 00' + '00 85 20 00 01 09 35 00 00 86 20 00 01 09 36 00 00 87 20 00 01 09 37 00 00 88 20 00 01 09 38 00' + '00 89 20 00 01 09 39 00 00 8A 20 00 01 09 2B 00 00 8B 20 00 01 09 12 22 00 8C 20 00 01 09 3D 00' + '00 8D 20 00 01 09 28 00 00 8E 20 00 01 09 29 00 00 90 20 00 01 09 61 00 00 91 20 00 01 09 65 00' + '00 92 20 00 01 09 6F 00 00 93 20 00 01 09 78 00 00 94 20 00 01 09 59 02 00 95 20 00 01 09 68 00' + '00 96 20 00 01 09 6B 00 00 97 20 00 01 09 6C 00 00 98 20 00 01 09 6D 00 00 99 20 00 01 09 6E 00' + '00 9A 20 00 01 09 70 00 00 9B 20 00 01 09 73 00 00 9C 20 00 01 09 74 00 00 A8 20 00 02 10 52 00' + '00 73 00 00 00 21 00 03 10 61 00 00 2F 00 00 63 00 00 01 21 00 03 10 61 00 00 2F 00 00 73 00 00' + '02 21 00 01 01 43 00 00 03 21 00 02 10 B0 00 00 43 00 00 05 21 00 03 10 63 00 00 2F 00 00 6F 00' + '00 06 21 00 03 10 63 00 00 2F 00 00 75 00 00 07 21 00 01 10 90 01 00 09 21 00 02 10 B0 00 00 46' + '00 00 0A 21 00 01 01 67 00 00 0B 21 00 01 01 48 00 00 0C 21 00 01 01 48 00 00 0D 21 00 01 01 48' + '00 00 0E 21 00 01 01 68 00 00 0F 21 00 01 01 27 01 00 10 21 00 01 01 49 00 00 11 21 00 01 01 49' + '00 00 12 21 00 01 01 4C 00 00 13 21 00 01 01 6C 00 00 15 21 00 01 01 4E 00 00 16 21 00 02 10 4E' + '00 00 6F 00 00 19 21 00 01 01 50 00 00 1A 21 00 01 01 51 00 00 1B 21 00 01 01 52 00 00 1C 21 00' + '01 01 52 00 00 1D 21 00 01 01 52 00 00 20 21 00 02 08 53 00 00 4D 00 00 21 21 00 03 10 54 00 00' + '45 00 00 4C 00 00 22 21 00 02 08 54 00 00 4D 00 00 24 21 00 01 01 5A 00 00 26 21 00 01 00 A9 03' + '00 28 21 00 01 01 5A 00 00 2A 21 00 01 00 4B 00 00 2B 21 00 02 00 41 00 00 0A 03 00 2C 21 00 01' + '01 42 00 00 2D 21 00 01 01 43 00 00 2F 21 00 01 01 65 00 00 30 21 00 01 01 45 00 00 31 21 00 01' + '01 46 00 00 33 21 00 01 01 4D 00 00 34 21 00 01 01 6F 00 00 35 21 00 01 10 D0 05 00 36 21 00 01' + '10 D1 05 00 37 21 00 01 10 D2 05 00 38 21 00 01 10 D3 05 00 39 21 00 01 01 69 00 00 3B 21 00 03' + '10 46 00 00 41 00 00 58 00 00 3C 21 00 01 01 C0 03 00 3D 21 00 01 01 B3 03 00 3E 21 00 01 01 93' + '03 00 3F 21 00 01 01 A0 03 00 40 21 00 01 01 11 22 00 45 21 00 01 01 44 00 00 46 21 00 01 01 64' + '00 00 47 21 00 01 01 65 00 00 48 21 00 01 01 69 00 00 49 21 00 01 01 6A 00 00 50 21 00 03 0F 31' + '00 00 44 20 00 37 00 00 51 21 00 03 0F 31 00 00 44 20 00 39 00 00 52 21 00 04 0F 31 00 00 44 20' + '00 31 00 00 30 00 00 53 21 00 03 0F 31 00 00 44 20 00 33 00 00 54 21 00 03 0F 32 00 00 44 20 00' + '33 00 00 55 21 00 03 0F 31 00 00 44 20 00 35 00 00 56 21 00 03 0F 32 00 00 44 20 00 35 00 00 57' + '21 00 03 0F 33 00 00 44 20 00 35 00 00 58 21 00 03 0F 34 00 00 44 20 00 35 00 00 59 21 00 03 0F' + '31 00 00 44 20 00 36 00 00 5A 21 00 03 0F 35 00 00 44 20 00 36 00 00 5B 21 00 03 0F 31 00 00 44' + '20 00 38 00 00 5C 21 00 03 0F 33 00 00 44 20 00 38 00 00 5D 21 00 03 0F 35 00 00 44 20 00 38 00' + '00 5E 21 00 03 0F 37 00 00 44 20 00 38 00 00 5F 21 00 02 0F 31 00 00 44 20 00 60 21 00 01 10 49' + '00 00 61 21 00 02 10 49 00 00 49 00 00 62 21 00 03 10 49 00 00 49 00 00 49 00 00 63 21 00 02 10' + '49 00 00 56 00 00 64 21 00 01 10 56 00 00 65 21 00 02 10 56 00 00 49 00 00 66 21 00 03 10 56 00' + '00 49 00 00 49 00 00 67 21 00 04 10 56 00 00 49 00 00 49 00 00 49 00 00 68 21 00 02 10 49 00 00' + '58 00 00 69 21 00 01 10 58 00 00 6A 21 00 02 10 58 00 00 49 00 00 6B 21 00 03 10 58 00 00 49 00' + '00 49 00 00 6C 21 00 01 10 4C 00 00 6D 21 00 01 10 43 00 00 6E 21 00 01 10 44 00 00 6F 21 00 01' + '10 4D 00 00 70 21 00 01 10 69 00 00 71 21 00 02 10 69 00 00 69 00 00 72 21 00 03 10 69 00 00 69' + '00 00 69 00 00 73 21 00 02 10 69 00 00 76 00 00 74 21 00 01 10 76 00 00 75 21 00 02 10 76 00 00' + '69 00 00 76 21 00 03 10 76 00 00 69 00 00 69 00 00 77 21 00 04 10 76 00 00 69 00 00 69 00 00 69' + '00 00 78 21 00 02 10 69 00 00 78 00 00 79 21 00 01 10 78 00 00 7A 21 00 02 10 78 00 00 69 00 00' + '7B 21 00 03 10 78 00 00 69 00 00 69 00 00 7C 21 00 01 10 6C 00 00 7D 21 00 01 10 63 00 00 7E 21' + '00 01 10 64 00 00 7F 21 00 01 10 6D 00 00 89 21 00 03 0F 30 00 00 44 20 00 33 00 00 9A 21 00 02' + '00 90 21 00 38 03 00 9B 21 00 02 00 92 21 00 38 03 00 AE 21 00 02 00 94 21 00 38 03 00 CD 21 00' + '02 00 D0 21 00 38 03 00 CE 21 00 02 00 D4 21 00 38 03 00 CF 21 00 02 00 D2 21 00 38 03 00 04 22' + '00 02 00 03 22 00 38 03 00 09 22 00 02 00 08 22 00 38 03 00 0C 22 00 02 00 0B 22 00 38 03 00 24' + '22 00 02 00 23 22 00 38 03 00 26 22 00 02 00 25 22 00 38 03 00 2C 22 00 02 10 2B 22 00 2B 22 00' + '2D 22 00 03 10 2B 22 00 2B 22 00 2B 22 00 2F 22 00 02 10 2E 22 00 2E 22 00 30 22 00 03 10 2E 22' + '00 2E 22 00 2E 22 00 41 22 00 02 00 3C 22 00 38 03 00 44 22 00 02 00 43 22 00 38 03 00 47 22 00' + '02 00 45 22 00 38 03 00 49 22 00 02 00 48 22 00 38 03 00 60 22 00 02 00 3D 00 00 38 03 00 62 22' + '00 02 00 61 22 00 38 03 00 6D 22 00 02 00 4D 22 00 38 03 00 6E 22 00 02 00 3C 00 00 38 03 00 6F' + '22 00 02 00 3E 00 00 38 03 00 70 22 00 02 00 64 22 00 38 03 00 71 22 00 02 00 65 22 00 38 03 00' + '74 22 00 02 00 72 22 00 38 03 00 75 22 00 02 00 73 22 00 38 03 00 78 22 00 02 00 76 22 00 38 03' + '00 79 22 00 02 00 77 22 00 38 03 00 80 22 00 02 00 7A 22 00 38 03 00 81 22 00 02 00 7B 22 00 38' + '03 00 84 22 00 02 00 82 22 00 38 03 00 85 22 00 02 00 83 22 00 38 03 00 88 22 00 02 00 86 22 00' + '38 03 00 89 22 00 02 00 87 22 00 38 03 00 AC 22 00 02 00 A2 22 00 38 03 00 AD 22 00 02 00 A8 22' + '00 38 03 00 AE 22 00 02 00 A9 22 00 38 03 00 AF 22 00 02 00 AB 22 00 38 03 00 E0 22 00 02 00 7C' + '22 00 38 03 00 E1 22 00 02 00 7D 22 00 38 03 00 E2 22 00 02 00 91 22 00 38 03 00 E3 22 00 02 00' + '92 22 00 38 03 00 EA 22 00 02 00 B2 22 00 38 03 00 EB 22 00 02 00 B3 22 00 38 03 00 EC 22 00 02' + '00 B4 22 00 38 03 00 ED 22 00 02 00 B5 22 00 38 03 00 29 23 00 01 00 08 30 00 2A 23 00 01 00 09' + '30 00 60 24 00 01 07 31 00 00 61 24 00 01 07 32 00 00 62 24 00 01 07 33 00 00 63 24 00 01 07 34' + '00 00 64 24 00 01 07 35 00 00 65 24 00 01 07 36 00 00 66 24 00 01 07 37 00 00 67 24 00 01 07 38' + '00 00 68 24 00 01 07 39 00 00 69 24 00 02 07 31 00 00 30 00 00 6A 24 00 02 07 31 00 00 31 00 00' + '6B 24 00 02 07 31 00 00 32 00 00 6C 24 00 02 07 31 00 00 33 00 00 6D 24 00 02 07 31 00 00 34 00' + '00 6E 24 00 02 07 31 00 00 35 00 00 6F 24 00 02 07 31 00 00 36 00 00 70 24 00 02 07 31 00 00 37' + '00 00 71 24 00 02 07 31 00 00 38 00 00 72 24 00 02 07 31 00 00 39 00 00 73 24 00 02 07 32 00 00' + '30 00 00 74 24 00 03 10 28 00 00 31 00 00 29 00 00 75 24 00 03 10 28 00 00 32 00 00 29 00 00 76' + '24 00 03 10 28 00 00 33 00 00 29 00 00 77 24 00 03 10 28 00 00 34 00 00 29 00 00 78 24 00 03 10' + '28 00 00 35 00 00 29 00 00 79 24 00 03 10 28 00 00 36 00 00 29 00 00 7A 24 00 03 10 28 00 00 37' + '00 00 29 00 00 7B 24 00 03 10 28 00 00 38 00 00 29 00 00 7C 24 00 03 10 28 00 00 39 00 00 29 00' + '00 7D 24 00 04 10 28 00 00 31 00 00 30 00 00 29 00 00 7E 24 00 04 10 28 00 00 31 00 00 31 00 00' + '29 00 00 7F 24 00 04 10 28 00 00 31 00 00 32 00 00 29 00 00 80 24 00 04 10 28 00 00 31 00 00 33' + '00 00 29 00 00 81 24 00 04 10 28 00 00 31 00 00 34 00 00 29 00 00 82 24 00 04 10 28 00 00 31 00' + '00 35 00 00 29 00 00 83 24 00 04 10 28 00 00 31 00 00 36 00 00 29 00 00 84 24 00 04 10 28 00 00' + '31 00 00 37 00 00 29 00 00 85 24 00 04 10 28 00 00 31 00 00 38 00 00 29 00 00 86 24 00 04 10 28' + '00 00 31 00 00 39 00 00 29 00 00 87 24 00 04 10 28 00 00 32 00 00 30 00 00 29 00 00 88 24 00 02' + '10 31 00 00 2E 00 00 89 24 00 02 10 32 00 00 2E 00 00 8A 24 00 02 10 33 00 00 2E 00 00 8B 24 00' + '02 10 34 00 00 2E 00 00 8C 24 00 02 10 35 00 00 2E 00 00 8D 24 00 02 10 36 00 00 2E 00 00 8E 24' + '00 02 10 37 00 00 2E 00 00 8F 24 00 02 10 38 00 00 2E 00 00 90 24 00 02 10 39 00 00 2E 00 00 91' + '24 00 03 10 31 00 00 30 00 00 2E 00 00 92 24 00 03 10 31 00 00 31 00 00 2E 00 00 93 24 00 03 10' + '31 00 00 32 00 00 2E 00 00 94 24 00 03 10 31 00 00 33 00 00 2E 00 00 95 24 00 03 10 31 00 00 34' + '00 00 2E 00 00 96 24 00 03 10 31 00 00 35 00 00 2E 00 00 97 24 00 03 10 31 00 00 36 00 00 2E 00' + '00 98 24 00 03 10 31 00 00 37 00 00 2E 00 00 99 24 00 03 10 31 00 00 38 00 00 2E 00 00 9A 24 00' + '03 10 31 00 00 39 00 00 2E 00 00 9B 24 00 03 10 32 00 00 30 00 00 2E 00 00 9C 24 00 03 10 28 00' + '00 61 00 00 29 00 00 9D 24 00 03 10 28 00 00 62 00 00 29 00 00 9E 24 00 03 10 28 00 00 63 00 00' + '29 00 00 9F 24 00 03 10 28 00 00 64 00 00 29 00 00 A0 24 00 03 10 28 00 00 65 00 00 29 00 00 A1' + '24 00 03 10 28 00 00 66 00 00 29 00 00 A2 24 00 03 10 28 00 00 67 00 00 29 00 00 A3 24 00 03 10' + '28 00 00 68 00 00 29 00 00 A4 24 00 03 10 28 00 00 69 00 00 29 00 00 A5 24 00 03 10 28 00 00 6A' + '00 00 29 00 00 A6 24 00 03 10 28 00 00 6B 00 00 29 00 00 A7 24 00 03 10 28 00 00 6C 00 00 29 00' + '00 A8 24 00 03 10 28 00 00 6D 00 00 29 00 00 A9 24 00 03 10 28 00 00 6E 00 00 29 00 00 AA 24 00' + '03 10 28 00 00 6F 00 00 29 00 00 AB 24 00 03 10 28 00 00 70 00 00 29 00 00 AC 24 00 03 10 28 00' + '00 71 00 00 29 00 00 AD 24 00 03 10 28 00 00 72 00 00 29 00 00 AE 24 00 03 10 28 00 00 73 00 00' + '29 00 00 AF 24 00 03 10 28 00 00 74 00 00 29 00 00 B0 24 00 03 10 28 00 00 75 00 00 29 00 00 B1' + '24 00 03 10 28 00 00 76 00 00 29 00 00 B2 24 00 03 10 28 00 00 77 00 00 29 00 00 B3 24 00 03 10' + '28 00 00 78 00 00 29 00 00 B4 24 00 03 10 28 00 00 79 00 00 29 00 00 B5 24 00 03 10 28 00 00 7A' + '00 00 29 00 00 B6 24 00 01 07 41 00 00 B7 24 00 01 07 42 00 00 B8 24 00 01 07 43 00 00 B9 24 00' + '01 07 44 00 00 BA 24 00 01 07 45 00 00 BB 24 00 01 07 46 00 00 BC 24 00 01 07 47 00 00 BD 24 00' + '01 07 48 00 00 BE 24 00 01 07 49 00 00 BF 24 00 01 07 4A 00 00 C0 24 00 01 07 4B 00 00 C1 24 00' + '01 07 4C 00 00 C2 24 00 01 07 4D 00 00 C3 24 00 01 07 4E 00 00 C4 24 00 01 07 4F 00 00 C5 24 00' + '01 07 50 00 00 C6 24 00 01 07 51 00 00 C7 24 00 01 07 52 00 00 C8 24 00 01 07 53 00 00 C9 24 00' + '01 07 54 00 00 CA 24 00 01 07 55 00 00 CB 24 00 01 07 56 00 00 CC 24 00 01 07 57 00 00 CD 24 00' + '01 07 58 00 00 CE 24 00 01 07 59 00 00 CF 24 00 01 07 5A 00 00 D0 24 00 01 07 61 00 00 D1 24 00' + '01 07 62 00 00 D2 24 00 01 07 63 00 00 D3 24 00 01 07 64 00 00 D4 24 00 01 07 65 00 00 D5 24 00' + '01 07 66 00 00 D6 24 00 01 07 67 00 00 D7 24 00 01 07 68 00 00 D8 24 00 01 07 69 00 00 D9 24 00' + '01 07 6A 00 00 DA 24 00 01 07 6B 00 00 DB 24 00 01 07 6C 00 00 DC 24 00 01 07 6D 00 00 DD 24 00' + '01 07 6E 00 00 DE 24 00 01 07 6F 00 00 DF 24 00 01 07 70 00 00 E0 24 00 01 07 71 00 00 E1 24 00' + '01 07 72 00 00 E2 24 00 01 07 73 00 00 E3 24 00 01 07 74 00 00 E4 24 00 01 07 75 00 00 E5 24 00' + '01 07 76 00 00 E6 24 00 01 07 77 00 00 E7 24 00 01 07 78 00 00 E8 24 00 01 07 79 00 00 E9 24 00' + '01 07 7A 00 00 EA 24 00 01 07 30 00 00 0C 2A 00 04 10 2B 22 00 2B 22 00 2B 22 00 2B 22 00 74 2A' + '00 03 10 3A 00 00 3A 00 00 3D 00 00 75 2A 00 02 10 3D 00 00 3D 00 00 76 2A 00 03 10 3D 00 00 3D' + '00 00 3D 00 00 DC 2A 00 02 00 DD 2A 00 38 03 00 7C 2C 00 01 09 6A 00 00 7D 2C 00 01 08 56 00 00' + '6F 2D 00 01 08 61 2D 00 9F 2E 00 01 10 CD 6B 00 F3 2E 00 01 10 9F 9F 00 00 2F 00 01 10 00 4E 00' + '01 2F 00 01 10 28 4E 00 02 2F 00 01 10 36 4E 00 03 2F 00 01 10 3F 4E 00 04 2F 00 01 10 59 4E 00' + '05 2F 00 01 10 85 4E 00 06 2F 00 01 10 8C 4E 00 07 2F 00 01 10 A0 4E 00 08 2F 00 01 10 BA 4E 00' + '09 2F 00 01 10 3F 51 00 0A 2F 00 01 10 65 51 00 0B 2F 00 01 10 6B 51 00 0C 2F 00 01 10 82 51 00' + '0D 2F 00 01 10 96 51 00 0E 2F 00 01 10 AB 51 00 0F 2F 00 01 10 E0 51 00 10 2F 00 01 10 F5 51 00' + '11 2F 00 01 10 00 52 00 12 2F 00 01 10 9B 52 00 13 2F 00 01 10 F9 52 00 14 2F 00 01 10 15 53 00' + '15 2F 00 01 10 1A 53 00 16 2F 00 01 10 38 53 00 17 2F 00 01 10 41 53 00 18 2F 00 01 10 5C 53 00' + '19 2F 00 01 10 69 53 00 1A 2F 00 01 10 82 53 00 1B 2F 00 01 10 B6 53 00 1C 2F 00 01 10 C8 53 00' + '1D 2F 00 01 10 E3 53 00 1E 2F 00 01 10 D7 56 00 1F 2F 00 01 10 1F 57 00 20 2F 00 01 10 EB 58 00' + '21 2F 00 01 10 02 59 00 22 2F 00 01 10 0A 59 00 23 2F 00 01 10 15 59 00 24 2F 00 01 10 27 59 00' + '25 2F 00 01 10 73 59 00 26 2F 00 01 10 50 5B 00 27 2F 00 01 10 80 5B 00 28 2F 00 01 10 F8 5B 00' + '29 2F 00 01 10 0F 5C 00 2A 2F 00 01 10 22 5C 00 2B 2F 00 01 10 38 5C 00 2C 2F 00 01 10 6E 5C 00' + '2D 2F 00 01 10 71 5C 00 2E 2F 00 01 10 DB 5D 00 2F 2F 00 01 10 E5 5D 00 30 2F 00 01 10 F1 5D 00' + '31 2F 00 01 10 FE 5D 00 32 2F 00 01 10 72 5E 00 33 2F 00 01 10 7A 5E 00 34 2F 00 01 10 7F 5E 00' + '35 2F 00 01 10 F4 5E 00 36 2F 00 01 10 FE 5E 00 37 2F 00 01 10 0B 5F 00 38 2F 00 01 10 13 5F 00' + '39 2F 00 01 10 50 5F 00 3A 2F 00 01 10 61 5F 00 3B 2F 00 01 10 73 5F 00 3C 2F 00 01 10 C3 5F 00' + '3D 2F 00 01 10 08 62 00 3E 2F 00 01 10 36 62 00 3F 2F 00 01 10 4B 62 00 40 2F 00 01 10 2F 65 00' + '41 2F 00 01 10 34 65 00 42 2F 00 01 10 87 65 00 43 2F 00 01 10 97 65 00 44 2F 00 01 10 A4 65 00' + '45 2F 00 01 10 B9 65 00 46 2F 00 01 10 E0 65 00 47 2F 00 01 10 E5 65 00 48 2F 00 01 10 F0 66 00' + '49 2F 00 01 10 08 67 00 4A 2F 00 01 10 28 67 00 4B 2F 00 01 10 20 6B 00 4C 2F 00 01 10 62 6B 00' + '4D 2F 00 01 10 79 6B 00 4E 2F 00 01 10 B3 6B 00 4F 2F 00 01 10 CB 6B 00 50 2F 00 01 10 D4 6B 00' + '51 2F 00 01 10 DB 6B 00 52 2F 00 01 10 0F 6C 00 53 2F 00 01 10 14 6C 00 54 2F 00 01 10 34 6C 00' + '55 2F 00 01 10 6B 70 00 56 2F 00 01 10 2A 72 00 57 2F 00 01 10 36 72 00 58 2F 00 01 10 3B 72 00' + '59 2F 00 01 10 3F 72 00 5A 2F 00 01 10 47 72 00 5B 2F 00 01 10 59 72 00 5C 2F 00 01 10 5B 72 00' + '5D 2F 00 01 10 AC 72 00 5E 2F 00 01 10 84 73 00 5F 2F 00 01 10 89 73 00 60 2F 00 01 10 DC 74 00' + '61 2F 00 01 10 E6 74 00 62 2F 00 01 10 18 75 00 63 2F 00 01 10 1F 75 00 64 2F 00 01 10 28 75 00' + '65 2F 00 01 10 30 75 00 66 2F 00 01 10 8B 75 00 67 2F 00 01 10 92 75 00 68 2F 00 01 10 76 76 00' + '69 2F 00 01 10 7D 76 00 6A 2F 00 01 10 AE 76 00 6B 2F 00 01 10 BF 76 00 6C 2F 00 01 10 EE 76 00' + '6D 2F 00 01 10 DB 77 00 6E 2F 00 01 10 E2 77 00 6F 2F 00 01 10 F3 77 00 70 2F 00 01 10 3A 79 00' + '71 2F 00 01 10 B8 79 00 72 2F 00 01 10 BE 79 00 73 2F 00 01 10 74 7A 00 74 2F 00 01 10 CB 7A 00' + '75 2F 00 01 10 F9 7A 00 76 2F 00 01 10 73 7C 00 77 2F 00 01 10 F8 7C 00 78 2F 00 01 10 36 7F 00' + '79 2F 00 01 10 51 7F 00 7A 2F 00 01 10 8A 7F 00 7B 2F 00 01 10 BD 7F 00 7C 2F 00 01 10 01 80 00' + '7D 2F 00 01 10 0C 80 00 7E 2F 00 01 10 12 80 00 7F 2F 00 01 10 33 80 00 80 2F 00 01 10 7F 80 00' + '81 2F 00 01 10 89 80 00 82 2F 00 01 10 E3 81 00 83 2F 00 01 10 EA 81 00 84 2F 00 01 10 F3 81 00' + '85 2F 00 01 10 FC 81 00 86 2F 00 01 10 0C 82 00 87 2F 00 01 10 1B 82 00 88 2F 00 01 10 1F 82 00' + '89 2F 00 01 10 6E 82 00 8A 2F 00 01 10 72 82 00 8B 2F 00 01 10 78 82 00 8C 2F 00 01 10 4D 86 00' + '8D 2F 00 01 10 6B 86 00 8E 2F 00 01 10 40 88 00 8F 2F 00 01 10 4C 88 00 90 2F 00 01 10 63 88 00' + '91 2F 00 01 10 7E 89 00 92 2F 00 01 10 8B 89 00 93 2F 00 01 10 D2 89 00 94 2F 00 01 10 00 8A 00' + '95 2F 00 01 10 37 8C 00 96 2F 00 01 10 46 8C 00 97 2F 00 01 10 55 8C 00 98 2F 00 01 10 78 8C 00' + '99 2F 00 01 10 9D 8C 00 9A 2F 00 01 10 64 8D 00 9B 2F 00 01 10 70 8D 00 9C 2F 00 01 10 B3 8D 00' + '9D 2F 00 01 10 AB 8E 00 9E 2F 00 01 10 CA 8E 00 9F 2F 00 01 10 9B 8F 00 A0 2F 00 01 10 B0 8F 00' + 'A1 2F 00 01 10 B5 8F 00 A2 2F 00 01 10 91 90 00 A3 2F 00 01 10 49 91 00 A4 2F 00 01 10 C6 91 00' + 'A5 2F 00 01 10 CC 91 00 A6 2F 00 01 10 D1 91 00 A7 2F 00 01 10 77 95 00 A8 2F 00 01 10 80 95 00' + 'A9 2F 00 01 10 1C 96 00 AA 2F 00 01 10 B6 96 00 AB 2F 00 01 10 B9 96 00 AC 2F 00 01 10 E8 96 00' + 'AD 2F 00 01 10 51 97 00 AE 2F 00 01 10 5E 97 00 AF 2F 00 01 10 62 97 00 B0 2F 00 01 10 69 97 00' + 'B1 2F 00 01 10 CB 97 00 B2 2F 00 01 10 ED 97 00 B3 2F 00 01 10 F3 97 00 B4 2F 00 01 10 01 98 00' + 'B5 2F 00 01 10 A8 98 00 B6 2F 00 01 10 DB 98 00 B7 2F 00 01 10 DF 98 00 B8 2F 00 01 10 96 99 00' + 'B9 2F 00 01 10 99 99 00 BA 2F 00 01 10 AC 99 00 BB 2F 00 01 10 A8 9A 00 BC 2F 00 01 10 D8 9A 00' + 'BD 2F 00 01 10 DF 9A 00 BE 2F 00 01 10 25 9B 00 BF 2F 00 01 10 2F 9B 00 C0 2F 00 01 10 32 9B 00' + 'C1 2F 00 01 10 3C 9B 00 C2 2F 00 01 10 5A 9B 00 C3 2F 00 01 10 E5 9C 00 C4 2F 00 01 10 75 9E 00' + 'C5 2F 00 01 10 7F 9E 00 C6 2F 00 01 10 A5 9E 00 C7 2F 00 01 10 BB 9E 00 C8 2F 00 01 10 C3 9E 00' + 'C9 2F 00 01 10 CD 9E 00 CA 2F 00 01 10 D1 9E 00 CB 2F 00 01 10 F9 9E 00 CC 2F 00 01 10 FD 9E 00' + 'CD 2F 00 01 10 0E 9F 00 CE 2F 00 01 10 13 9F 00 CF 2F 00 01 10 20 9F 00 D0 2F 00 01 10 3B 9F 00' + 'D1 2F 00 01 10 4A 9F 00 D2 2F 00 01 10 52 9F 00 D3 2F 00 01 10 8D 9F 00 D4 2F 00 01 10 9C 9F 00' + 'D5 2F 00 01 10 A0 9F 00 00 30 00 01 0B 20 00 00 36 30 00 01 10 12 30 00 38 30 00 01 10 41 53 00' + '39 30 00 01 10 44 53 00 3A 30 00 01 10 45 53 00 4C 30 00 02 00 4B 30 00 99 30 00 4E 30 00 02 00' + '4D 30 00 99 30 00 50 30 00 02 00 4F 30 00 99 30 00 52 30 00 02 00 51 30 00 99 30 00 54 30 00 02' + '00 53 30 00 99 30 00 56 30 00 02 00 55 30 00 99 30 00 58 30 00 02 00 57 30 00 99 30 00 5A 30 00' + '02 00 59 30 00 99 30 00 5C 30 00 02 00 5B 30 00 99 30 00 5E 30 00 02 00 5D 30 00 99 30 00 60 30' + '00 02 00 5F 30 00 99 30 00 62 30 00 02 00 61 30 00 99 30 00 65 30 00 02 00 64 30 00 99 30 00 67' + '30 00 02 00 66 30 00 99 30 00 69 30 00 02 00 68 30 00 99 30 00 70 30 00 02 00 6F 30 00 99 30 00' + '71 30 00 02 00 6F 30 00 9A 30 00 73 30 00 02 00 72 30 00 99 30 00 74 30 00 02 00 72 30 00 9A 30' + '00 76 30 00 02 00 75 30 00 99 30 00 77 30 00 02 00 75 30 00 9A 30 00 79 30 00 02 00 78 30 00 99' + '30 00 7A 30 00 02 00 78 30 00 9A 30 00 7C 30 00 02 00 7B 30 00 99 30 00 7D 30 00 02 00 7B 30 00' + '9A 30 00 94 30 00 02 00 46 30 00 99 30 00 9B 30 00 02 10 20 00 00 99 30 00 9C 30 00 02 10 20 00' + '00 9A 30 00 9E 30 00 02 00 9D 30 00 99 30 00 9F 30 00 02 0A 88 30 00 8A 30 00 AC 30 00 02 00 AB' + '30 00 99 30 00 AE 30 00 02 00 AD 30 00 99 30 00 B0 30 00 02 00 AF 30 00 99 30 00 B2 30 00 02 00' + 'B1 30 00 99 30 00 B4 30 00 02 00 B3 30 00 99 30 00 B6 30 00 02 00 B5 30 00 99 30 00 B8 30 00 02' + '00 B7 30 00 99 30 00 BA 30 00 02 00 B9 30 00 99 30 00 BC 30 00 02 00 BB 30 00 99 30 00 BE 30 00' + '02 00 BD 30 00 99 30 00 C0 30 00 02 00 BF 30 00 99 30 00 C2 30 00 02 00 C1 30 00 99 30 00 C5 30' + '00 02 00 C4 30 00 99 30 00 C7 30 00 02 00 C6 30 00 99 30 00 C9 30 00 02 00 C8 30 00 99 30 00 D0' + '30 00 02 00 CF 30 00 99 30 00 D1 30 00 02 00 CF 30 00 9A 30 00 D3 30 00 02 00 D2 30 00 99 30 00' + 'D4 30 00 02 00 D2 30 00 9A 30 00 D6 30 00 02 00 D5 30 00 99 30 00 D7 30 00 02 00 D5 30 00 9A 30' + '00 D9 30 00 02 00 D8 30 00 99 30 00 DA 30 00 02 00 D8 30 00 9A 30 00 DC 30 00 02 00 DB 30 00 99' + '30 00 DD 30 00 02 00 DB 30 00 9A 30 00 F4 30 00 02 00 A6 30 00 99 30 00 F7 30 00 02 00 EF 30 00' + '99 30 00 F8 30 00 02 00 F0 30 00 99 30 00 F9 30 00 02 00 F1 30 00 99 30 00 FA 30 00 02 00 F2 30' + '00 99 30 00 FE 30 00 02 00 FD 30 00 99 30 00 FF 30 00 02 0A B3 30 00 C8 30 00 31 31 00 01 10 00' + '11 00 32 31 00 01 10 01 11 00 33 31 00 01 10 AA 11 00 34 31 00 01 10 02 11 00 35 31 00 01 10 AC' + '11 00 36 31 00 01 10 AD 11 00 37 31 00 01 10 03 11 00 38 31 00 01 10 04 11 00 39 31 00 01 10 05' + '11 00 3A 31 00 01 10 B0 11 00 3B 31 00 01 10 B1 11 00 3C 31 00 01 10 B2 11 00 3D 31 00 01 10 B3' + '11 00 3E 31 00 01 10 B4 11 00 3F 31 00 01 10 B5 11 00 40 31 00 01 10 1A 11 00 41 31 00 01 10 06' + '11 00 42 31 00 01 10 07 11 00 43 31 00 01 10 08 11 00 44 31 00 01 10 21 11 00 45 31 00 01 10 09' + '11 00 46 31 00 01 10 0A 11 00 47 31 00 01 10 0B 11 00 48 31 00 01 10 0C 11 00 49 31 00 01 10 0D' + '11 00 4A 31 00 01 10 0E 11 00 4B 31 00 01 10 0F 11 00 4C 31 00 01 10 10 11 00 4D 31 00 01 10 11' + '11 00 4E 31 00 01 10 12 11 00 4F 31 00 01 10 61 11 00 50 31 00 01 10 62 11 00 51 31 00 01 10 63' + '11 00 52 31 00 01 10 64 11 00 53 31 00 01 10 65 11 00 54 31 00 01 10 66 11 00 55 31 00 01 10 67' + '11 00 56 31 00 01 10 68 11 00 57 31 00 01 10 69 11 00 58 31 00 01 10 6A 11 00 59 31 00 01 10 6B' + '11 00 5A 31 00 01 10 6C 11 00 5B 31 00 01 10 6D 11 00 5C 31 00 01 10 6E 11 00 5D 31 00 01 10 6F' + '11 00 5E 31 00 01 10 70 11 00 5F 31 00 01 10 71 11 00 60 31 00 01 10 72 11 00 61 31 00 01 10 73' + '11 00 62 31 00 01 10 74 11 00 63 31 00 01 10 75 11 00 64 31 00 01 10 60 11 00 65 31 00 01 10 14' + '11 00 66 31 00 01 10 15 11 00 67 31 00 01 10 C7 11 00 68 31 00 01 10 C8 11 00 69 31 00 01 10 CC' + '11 00 6A 31 00 01 10 CE 11 00 6B 31 00 01 10 D3 11 00 6C 31 00 01 10 D7 11 00 6D 31 00 01 10 D9' + '11 00 6E 31 00 01 10 1C 11 00 6F 31 00 01 10 DD 11 00 70 31 00 01 10 DF 11 00 71 31 00 01 10 1D' + '11 00 72 31 00 01 10 1E 11 00 73 31 00 01 10 20 11 00 74 31 00 01 10 22 11 00 75 31 00 01 10 23' + '11 00 76 31 00 01 10 27 11 00 77 31 00 01 10 29 11 00 78 31 00 01 10 2B 11 00 79 31 00 01 10 2C' + '11 00 7A 31 00 01 10 2D 11 00 7B 31 00 01 10 2E 11 00 7C 31 00 01 10 2F 11 00 7D 31 00 01 10 32' + '11 00 7E 31 00 01 10 36 11 00 7F 31 00 01 10 40 11 00 80 31 00 01 10 47 11 00 81 31 00 01 10 4C' + '11 00 82 31 00 01 10 F1 11 00 83 31 00 01 10 F2 11 00 84 31 00 01 10 57 11 00 85 31 00 01 10 58' + '11 00 86 31 00 01 10 59 11 00 87 31 00 01 10 84 11 00 88 31 00 01 10 85 11 00 89 31 00 01 10 88' + '11 00 8A 31 00 01 10 91 11 00 8B 31 00 01 10 92 11 00 8C 31 00 01 10 94 11 00 8D 31 00 01 10 9E' + '11 00 8E 31 00 01 10 A1 11 00 92 31 00 01 08 00 4E 00 93 31 00 01 08 8C 4E 00 94 31 00 01 08 09' + '4E 00 95 31 00 01 08 DB 56 00 96 31 00 01 08 0A 4E 00 97 31 00 01 08 2D 4E 00 98 31 00 01 08 0B' + '4E 00 99 31 00 01 08 32 75 00 9A 31 00 01 08 59 4E 00 9B 31 00 01 08 19 4E 00 9C 31 00 01 08 01' + '4E 00 9D 31 00 01 08 29 59 00 9E 31 00 01 08 30 57 00 9F 31 00 01 08 BA 4E 00 00 32 00 03 10 28' + '00 00 00 11 00 29 00 00 01 32 00 03 10 28 00 00 02 11 00 29 00 00 02 32 00 03 10 28 00 00 03 11' + '00 29 00 00 03 32 00 03 10 28 00 00 05 11 00 29 00 00 04 32 00 03 10 28 00 00 06 11 00 29 00 00' + '05 32 00 03 10 28 00 00 07 11 00 29 00 00 06 32 00 03 10 28 00 00 09 11 00 29 00 00 07 32 00 03' + '10 28 00 00 0B 11 00 29 00 00 08 32 00 03 10 28 00 00 0C 11 00 29 00 00 09 32 00 03 10 28 00 00' + '0E 11 00 29 00 00 0A 32 00 03 10 28 00 00 0F 11 00 29 00 00 0B 32 00 03 10 28 00 00 10 11 00 29' + '00 00 0C 32 00 03 10 28 00 00 11 11 00 29 00 00 0D 32 00 03 10 28 00 00 12 11 00 29 00 00 0E 32' + '00 04 10 28 00 00 00 11 00 61 11 00 29 00 00 0F 32 00 04 10 28 00 00 02 11 00 61 11 00 29 00 00' + '10 32 00 04 10 28 00 00 03 11 00 61 11 00 29 00 00 11 32 00 04 10 28 00 00 05 11 00 61 11 00 29' + '00 00 12 32 00 04 10 28 00 00 06 11 00 61 11 00 29 00 00 13 32 00 04 10 28 00 00 07 11 00 61 11' + '00 29 00 00 14 32 00 04 10 28 00 00 09 11 00 61 11 00 29 00 00 15 32 00 04 10 28 00 00 0B 11 00' + '61 11 00 29 00 00 16 32 00 04 10 28 00 00 0C 11 00 61 11 00 29 00 00 17 32 00 04 10 28 00 00 0E' + '11 00 61 11 00 29 00 00 18 32 00 04 10 28 00 00 0F 11 00 61 11 00 29 00 00 19 32 00 04 10 28 00' + '00 10 11 00 61 11 00 29 00 00 1A 32 00 04 10 28 00 00 11 11 00 61 11 00 29 00 00 1B 32 00 04 10' + '28 00 00 12 11 00 61 11 00 29 00 00 1C 32 00 04 10 28 00 00 0C 11 00 6E 11 00 29 00 00 1D 32 00' + '07 10 28 00 00 0B 11 00 69 11 00 0C 11 00 65 11 00 AB 11 00 29 00 00 1E 32 00 06 10 28 00 00 0B' + '11 00 69 11 00 12 11 00 6E 11 00 29 00 00 20 32 00 03 10 28 00 00 00 4E 00 29 00 00 21 32 00 03' + '10 28 00 00 8C 4E 00 29 00 00 22 32 00 03 10 28 00 00 09 4E 00 29 00 00 23 32 00 03 10 28 00 00' + 'DB 56 00 29 00 00 24 32 00 03 10 28 00 00 94 4E 00 29 00 00 25 32 00 03 10 28 00 00 6D 51 00 29' + '00 00 26 32 00 03 10 28 00 00 03 4E 00 29 00 00 27 32 00 03 10 28 00 00 6B 51 00 29 00 00 28 32' + '00 03 10 28 00 00 5D 4E 00 29 00 00 29 32 00 03 10 28 00 00 41 53 00 29 00 00 2A 32 00 03 10 28' + '00 00 08 67 00 29 00 00 2B 32 00 03 10 28 00 00 6B 70 00 29 00 00 2C 32 00 03 10 28 00 00 34 6C' + '00 29 00 00 2D 32 00 03 10 28 00 00 28 67 00 29 00 00 2E 32 00 03 10 28 00 00 D1 91 00 29 00 00' + '2F 32 00 03 10 28 00 00 1F 57 00 29 00 00 30 32 00 03 10 28 00 00 E5 65 00 29 00 00 31 32 00 03' + '10 28 00 00 2A 68 00 29 00 00 32 32 00 03 10 28 00 00 09 67 00 29 00 00 33 32 00 03 10 28 00 00' + '3E 79 00 29 00 00 34 32 00 03 10 28 00 00 0D 54 00 29 00 00 35 32 00 03 10 28 00 00 79 72 00 29' + '00 00 36 32 00 03 10 28 00 00 A1 8C 00 29 00 00 37 32 00 03 10 28 00 00 5D 79 00 29 00 00 38 32' + '00 03 10 28 00 00 B4 52 00 29 00 00 39 32 00 03 10 28 00 00 E3 4E 00 29 00 00 3A 32 00 03 10 28' + '00 00 7C 54 00 29 00 00 3B 32 00 03 10 28 00 00 66 5B 00 29 00 00 3C 32 00 03 10 28 00 00 E3 76' + '00 29 00 00 3D 32 00 03 10 28 00 00 01 4F 00 29 00 00 3E 32 00 03 10 28 00 00 C7 8C 00 29 00 00' + '3F 32 00 03 10 28 00 00 54 53 00 29 00 00 40 32 00 03 10 28 00 00 6D 79 00 29 00 00 41 32 00 03' + '10 28 00 00 11 4F 00 29 00 00 42 32 00 03 10 28 00 00 EA 81 00 29 00 00 43 32 00 03 10 28 00 00' + 'F3 81 00 29 00 00 44 32 00 01 07 4F 55 00 45 32 00 01 07 7C 5E 00 46 32 00 01 07 87 65 00 47 32' + '00 01 07 8F 7B 00 50 32 00 03 0E 50 00 00 54 00 00 45 00 00 51 32 00 02 07 32 00 00 31 00 00 52' + '32 00 02 07 32 00 00 32 00 00 53 32 00 02 07 32 00 00 33 00 00 54 32 00 02 07 32 00 00 34 00 00' + '55 32 00 02 07 32 00 00 35 00 00 56 32 00 02 07 32 00 00 36 00 00 57 32 00 02 07 32 00 00 37 00' + '00 58 32 00 02 07 32 00 00 38 00 00 59 32 00 02 07 32 00 00 39 00 00 5A 32 00 02 07 33 00 00 30' + '00 00 5B 32 00 02 07 33 00 00 31 00 00 5C 32 00 02 07 33 00 00 32 00 00 5D 32 00 02 07 33 00 00' + '33 00 00 5E 32 00 02 07 33 00 00 34 00 00 5F 32 00 02 07 33 00 00 35 00 00 60 32 00 01 07 00 11' + '00 61 32 00 01 07 02 11 00 62 32 00 01 07 03 11 00 63 32 00 01 07 05 11 00 64 32 00 01 07 06 11' + '00 65 32 00 01 07 07 11 00 66 32 00 01 07 09 11 00 67 32 00 01 07 0B 11 00 68 32 00 01 07 0C 11' + '00 69 32 00 01 07 0E 11 00 6A 32 00 01 07 0F 11 00 6B 32 00 01 07 10 11 00 6C 32 00 01 07 11 11' + '00 6D 32 00 01 07 12 11 00 6E 32 00 02 07 00 11 00 61 11 00 6F 32 00 02 07 02 11 00 61 11 00 70' + '32 00 02 07 03 11 00 61 11 00 71 32 00 02 07 05 11 00 61 11 00 72 32 00 02 07 06 11 00 61 11 00' + '73 32 00 02 07 07 11 00 61 11 00 74 32 00 02 07 09 11 00 61 11 00 75 32 00 02 07 0B 11 00 61 11' + '00 76 32 00 02 07 0C 11 00 61 11 00 77 32 00 02 07 0E 11 00 61 11 00 78 32 00 02 07 0F 11 00 61' + '11 00 79 32 00 02 07 10 11 00 61 11 00 7A 32 00 02 07 11 11 00 61 11 00 7B 32 00 02 07 12 11 00' + '61 11 00 7C 32 00 05 07 0E 11 00 61 11 00 B7 11 00 00 11 00 69 11 00 7D 32 00 04 07 0C 11 00 6E' + '11 00 0B 11 00 74 11 00 7E 32 00 02 07 0B 11 00 6E 11 00 80 32 00 01 07 00 4E 00 81 32 00 01 07' + '8C 4E 00 82 32 00 01 07 09 4E 00 83 32 00 01 07 DB 56 00 84 32 00 01 07 94 4E 00 85 32 00 01 07' + '6D 51 00 86 32 00 01 07 03 4E 00 87 32 00 01 07 6B 51 00 88 32 00 01 07 5D 4E 00 89 32 00 01 07' + '41 53 00 8A 32 00 01 07 08 67 00 8B 32 00 01 07 6B 70 00 8C 32 00 01 07 34 6C 00 8D 32 00 01 07' + '28 67 00 8E 32 00 01 07 D1 91 00 8F 32 00 01 07 1F 57 00 90 32 00 01 07 E5 65 00 91 32 00 01 07' + '2A 68 00 92 32 00 01 07 09 67 00 93 32 00 01 07 3E 79 00 94 32 00 01 07 0D 54 00 95 32 00 01 07' + '79 72 00 96 32 00 01 07 A1 8C 00 97 32 00 01 07 5D 79 00 98 32 00 01 07 B4 52 00 99 32 00 01 07' + 'D8 79 00 9A 32 00 01 07 37 75 00 9B 32 00 01 07 73 59 00 9C 32 00 01 07 69 90 00 9D 32 00 01 07' + '2A 51 00 9E 32 00 01 07 70 53 00 9F 32 00 01 07 E8 6C 00 A0 32 00 01 07 05 98 00 A1 32 00 01 07' + '11 4F 00 A2 32 00 01 07 99 51 00 A3 32 00 01 07 63 6B 00 A4 32 00 01 07 0A 4E 00 A5 32 00 01 07' + '2D 4E 00 A6 32 00 01 07 0B 4E 00 A7 32 00 01 07 E6 5D 00 A8 32 00 01 07 F3 53 00 A9 32 00 01 07' + '3B 53 00 AA 32 00 01 07 97 5B 00 AB 32 00 01 07 66 5B 00 AC 32 00 01 07 E3 76 00 AD 32 00 01 07' + '01 4F 00 AE 32 00 01 07 C7 8C 00 AF 32 00 01 07 54 53 00 B0 32 00 01 07 1C 59 00 B1 32 00 02 07' + '33 00 00 36 00 00 B2 32 00 02 07 33 00 00 37 00 00 B3 32 00 02 07 33 00 00 38 00 00 B4 32 00 02' + '07 33 00 00 39 00 00 B5 32 00 02 07 34 00 00 30 00 00 B6 32 00 02 07 34 00 00 31 00 00 B7 32 00' + '02 07 34 00 00 32 00 00 B8 32 00 02 07 34 00 00 33 00 00 B9 32 00 02 07 34 00 00 34 00 00 BA 32' + '00 02 07 34 00 00 35 00 00 BB 32 00 02 07 34 00 00 36 00 00 BC 32 00 02 07 34 00 00 37 00 00 BD' + '32 00 02 07 34 00 00 38 00 00 BE 32 00 02 07 34 00 00 39 00 00 BF 32 00 02 07 35 00 00 30 00 00' + 'C0 32 00 02 10 31 00 00 08 67 00 C1 32 00 02 10 32 00 00 08 67 00 C2 32 00 02 10 33 00 00 08 67' + '00 C3 32 00 02 10 34 00 00 08 67 00 C4 32 00 02 10 35 00 00 08 67 00 C5 32 00 02 10 36 00 00 08' + '67 00 C6 32 00 02 10 37 00 00 08 67 00 C7 32 00 02 10 38 00 00 08 67 00 C8 32 00 02 10 39 00 00' + '08 67 00 C9 32 00 03 10 31 00 00 30 00 00 08 67 00 CA 32 00 03 10 31 00 00 31 00 00 08 67 00 CB' + '32 00 03 10 31 00 00 32 00 00 08 67 00 CC 32 00 02 0E 48 00 00 67 00 00 CD 32 00 03 0E 65 00 00' + '72 00 00 67 00 00 CE 32 00 02 0E 65 00 00 56 00 00 CF 32 00 03 0E 4C 00 00 54 00 00 44 00 00 D0' + '32 00 01 07 A2 30 00 D1 32 00 01 07 A4 30 00 D2 32 00 01 07 A6 30 00 D3 32 00 01 07 A8 30 00 D4' + '32 00 01 07 AA 30 00 D5 32 00 01 07 AB 30 00 D6 32 00 01 07 AD 30 00 D7 32 00 01 07 AF 30 00 D8' + '32 00 01 07 B1 30 00 D9 32 00 01 07 B3 30 00 DA 32 00 01 07 B5 30 00 DB 32 00 01 07 B7 30 00 DC' + '32 00 01 07 B9 30 00 DD 32 00 01 07 BB 30 00 DE 32 00 01 07 BD 30 00 DF 32 00 01 07 BF 30 00 E0' + '32 00 01 07 C1 30 00 E1 32 00 01 07 C4 30 00 E2 32 00 01 07 C6 30 00 E3 32 00 01 07 C8 30 00 E4' + '32 00 01 07 CA 30 00 E5 32 00 01 07 CB 30 00 E6 32 00 01 07 CC 30 00 E7 32 00 01 07 CD 30 00 E8' + '32 00 01 07 CE 30 00 E9 32 00 01 07 CF 30 00 EA 32 00 01 07 D2 30 00 EB 32 00 01 07 D5 30 00 EC' + '32 00 01 07 D8 30 00 ED 32 00 01 07 DB 30 00 EE 32 00 01 07 DE 30 00 EF 32 00 01 07 DF 30 00 F0' + '32 00 01 07 E0 30 00 F1 32 00 01 07 E1 30 00 F2 32 00 01 07 E2 30 00 F3 32 00 01 07 E4 30 00 F4' + '32 00 01 07 E6 30 00 F5 32 00 01 07 E8 30 00 F6 32 00 01 07 E9 30 00 F7 32 00 01 07 EA 30 00 F8' + '32 00 01 07 EB 30 00 F9 32 00 01 07 EC 30 00 FA 32 00 01 07 ED 30 00 FB 32 00 01 07 EF 30 00 FC' + '32 00 01 07 F0 30 00 FD 32 00 01 07 F1 30 00 FE 32 00 01 07 F2 30 00 FF 32 00 02 0E E4 4E 00 8C' + '54 00 00 33 00 05 0E A2 30 00 CF 30 00 9A 30 00 FC 30 00 C8 30 00 01 33 00 04 0E A2 30 00 EB 30' + '00 D5 30 00 A1 30 00 02 33 00 05 0E A2 30 00 F3 30 00 D8 30 00 9A 30 00 A2 30 00 03 33 00 03 0E' + 'A2 30 00 FC 30 00 EB 30 00 04 33 00 05 0E A4 30 00 CB 30 00 F3 30 00 AF 30 00 99 30 00 05 33 00' + '03 0E A4 30 00 F3 30 00 C1 30 00 06 33 00 03 0E A6 30 00 A9 30 00 F3 30 00 07 33 00 06 0E A8 30' + '00 B9 30 00 AF 30 00 FC 30 00 C8 30 00 99 30 00 08 33 00 04 0E A8 30 00 FC 30 00 AB 30 00 FC 30' + '00 09 33 00 03 0E AA 30 00 F3 30 00 B9 30 00 0A 33 00 03 0E AA 30 00 FC 30 00 E0 30 00 0B 33 00' + '03 0E AB 30 00 A4 30 00 EA 30 00 0C 33 00 04 0E AB 30 00 E9 30 00 C3 30 00 C8 30 00 0D 33 00 04' + '0E AB 30 00 ED 30 00 EA 30 00 FC 30 00 0E 33 00 04 0E AB 30 00 99 30 00 ED 30 00 F3 30 00 0F 33' + '00 04 0E AB 30 00 99 30 00 F3 30 00 DE 30 00 10 33 00 06 0E AD 30 00 99 30 00 AD 30 00 99 30 00' + 'AB 30 00 99 30 00 11 33 00 04 0E AD 30 00 99 30 00 CB 30 00 FC 30 00 12 33 00 04 0E AD 30 00 E5' + '30 00 EA 30 00 FC 30 00 13 33 00 08 0E AD 30 00 99 30 00 EB 30 00 AD 30 00 99 30 00 BF 30 00 99' + '30 00 FC 30 00 14 33 00 02 0E AD 30 00 ED 30 00 15 33 00 06 0E AD 30 00 ED 30 00 AF 30 00 99 30' + '00 E9 30 00 E0 30 00 16 33 00 06 0E AD 30 00 ED 30 00 E1 30 00 FC 30 00 C8 30 00 EB 30 00 17 33' + '00 05 0E AD 30 00 ED 30 00 EF 30 00 C3 30 00 C8 30 00 18 33 00 04 0E AF 30 00 99 30 00 E9 30 00' + 'E0 30 00 19 33 00 06 0E AF 30 00 99 30 00 E9 30 00 E0 30 00 C8 30 00 F3 30 00 1A 33 00 06 0E AF' + '30 00 EB 30 00 BB 30 00 99 30 00 A4 30 00 ED 30 00 1B 33 00 04 0E AF 30 00 ED 30 00 FC 30 00 CD' + '30 00 1C 33 00 03 0E B1 30 00 FC 30 00 B9 30 00 1D 33 00 03 0E B3 30 00 EB 30 00 CA 30 00 1E 33' + '00 04 0E B3 30 00 FC 30 00 DB 30 00 9A 30 00 1F 33 00 04 0E B5 30 00 A4 30 00 AF 30 00 EB 30 00' + '20 33 00 05 0E B5 30 00 F3 30 00 C1 30 00 FC 30 00 E0 30 00 21 33 00 05 0E B7 30 00 EA 30 00 F3' + '30 00 AF 30 00 99 30 00 22 33 00 03 0E BB 30 00 F3 30 00 C1 30 00 23 33 00 03 0E BB 30 00 F3 30' + '00 C8 30 00 24 33 00 04 0E BF 30 00 99 30 00 FC 30 00 B9 30 00 25 33 00 03 0E C6 30 00 99 30 00' + 'B7 30 00 26 33 00 03 0E C8 30 00 99 30 00 EB 30 00 27 33 00 02 0E C8 30 00 F3 30 00 28 33 00 02' + '0E CA 30 00 CE 30 00 29 33 00 03 0E CE 30 00 C3 30 00 C8 30 00 2A 33 00 03 0E CF 30 00 A4 30 00' + 'C4 30 00 2B 33 00 06 0E CF 30 00 9A 30 00 FC 30 00 BB 30 00 F3 30 00 C8 30 00 2C 33 00 04 0E CF' + '30 00 9A 30 00 FC 30 00 C4 30 00 2D 33 00 05 0E CF 30 00 99 30 00 FC 30 00 EC 30 00 EB 30 00 2E' + '33 00 06 0E D2 30 00 9A 30 00 A2 30 00 B9 30 00 C8 30 00 EB 30 00 2F 33 00 04 0E D2 30 00 9A 30' + '00 AF 30 00 EB 30 00 30 33 00 03 0E D2 30 00 9A 30 00 B3 30 00 31 33 00 03 0E D2 30 00 99 30 00' + 'EB 30 00 32 33 00 06 0E D5 30 00 A1 30 00 E9 30 00 C3 30 00 C8 30 00 99 30 00 33 33 00 04 0E D5' + '30 00 A3 30 00 FC 30 00 C8 30 00 34 33 00 06 0E D5 30 00 99 30 00 C3 30 00 B7 30 00 A7 30 00 EB' + '30 00 35 33 00 03 0E D5 30 00 E9 30 00 F3 30 00 36 33 00 05 0E D8 30 00 AF 30 00 BF 30 00 FC 30' + '00 EB 30 00 37 33 00 03 0E D8 30 00 9A 30 00 BD 30 00 38 33 00 04 0E D8 30 00 9A 30 00 CB 30 00' + 'D2 30 00 39 33 00 03 0E D8 30 00 EB 30 00 C4 30 00 3A 33 00 04 0E D8 30 00 9A 30 00 F3 30 00 B9' + '30 00 3B 33 00 07 0E D8 30 00 9A 30 00 FC 30 00 D8 30 00 9A 30 00 B7 30 00 99 30 00 3C 33 00 04' + '0E D8 30 00 99 30 00 FC 30 00 BF 30 00 3D 33 00 05 0E DB 30 00 9A 30 00 A4 30 00 F3 30 00 C8 30' + '00 3E 33 00 04 0E DB 30 00 99 30 00 EB 30 00 C8 30 00 3F 33 00 02 0E DB 30 00 F3 30 00 40 33 00' + '07 0E DB 30 00 9A 30 00 F3 30 00 DB 30 00 9A 30 00 C8 30 00 99 30 00 41 33 00 03 0E DB 30 00 FC' + '30 00 EB 30 00 42 33 00 03 0E DB 30 00 FC 30 00 F3 30 00 43 33 00 04 0E DE 30 00 A4 30 00 AF 30' + '00 ED 30 00 44 33 00 03 0E DE 30 00 A4 30 00 EB 30 00 45 33 00 03 0E DE 30 00 C3 30 00 CF 30 00' + '46 33 00 03 0E DE 30 00 EB 30 00 AF 30 00 47 33 00 05 0E DE 30 00 F3 30 00 B7 30 00 E7 30 00 F3' + '30 00 48 33 00 04 0E DF 30 00 AF 30 00 ED 30 00 F3 30 00 49 33 00 02 0E DF 30 00 EA 30 00 4A 33' + '00 06 0E DF 30 00 EA 30 00 CF 30 00 99 30 00 FC 30 00 EB 30 00 4B 33 00 03 0E E1 30 00 AB 30 00' + '99 30 00 4C 33 00 05 0E E1 30 00 AB 30 00 99 30 00 C8 30 00 F3 30 00 4D 33 00 04 0E E1 30 00 FC' + '30 00 C8 30 00 EB 30 00 4E 33 00 04 0E E4 30 00 FC 30 00 C8 30 00 99 30 00 4F 33 00 03 0E E4 30' + '00 FC 30 00 EB 30 00 50 33 00 03 0E E6 30 00 A2 30 00 F3 30 00 51 33 00 04 0E EA 30 00 C3 30 00' + 'C8 30 00 EB 30 00 52 33 00 02 0E EA 30 00 E9 30 00 53 33 00 04 0E EB 30 00 D2 30 00 9A 30 00 FC' + '30 00 54 33 00 05 0E EB 30 00 FC 30 00 D5 30 00 99 30 00 EB 30 00 55 33 00 02 0E EC 30 00 E0 30' + '00 56 33 00 06 0E EC 30 00 F3 30 00 C8 30 00 B1 30 00 99 30 00 F3 30 00 57 33 00 03 0E EF 30 00' + 'C3 30 00 C8 30 00 58 33 00 02 10 30 00 00 B9 70 00 59 33 00 02 10 31 00 00 B9 70 00 5A 33 00 02' + '10 32 00 00 B9 70 00 5B 33 00 02 10 33 00 00 B9 70 00 5C 33 00 02 10 34 00 00 B9 70 00 5D 33 00' + '02 10 35 00 00 B9 70 00 5E 33 00 02 10 36 00 00 B9 70 00 5F 33 00 02 10 37 00 00 B9 70 00 60 33' + '00 02 10 38 00 00 B9 70 00 61 33 00 02 10 39 00 00 B9 70 00 62 33 00 03 10 31 00 00 30 00 00 B9' + '70 00 63 33 00 03 10 31 00 00 31 00 00 B9 70 00 64 33 00 03 10 31 00 00 32 00 00 B9 70 00 65 33' + '00 03 10 31 00 00 33 00 00 B9 70 00 66 33 00 03 10 31 00 00 34 00 00 B9 70 00 67 33 00 03 10 31' + '00 00 35 00 00 B9 70 00 68 33 00 03 10 31 00 00 36 00 00 B9 70 00 69 33 00 03 10 31 00 00 37 00' + '00 B9 70 00 6A 33 00 03 10 31 00 00 38 00 00 B9 70 00 6B 33 00 03 10 31 00 00 39 00 00 B9 70 00' + '6C 33 00 03 10 32 00 00 30 00 00 B9 70 00 6D 33 00 03 10 32 00 00 31 00 00 B9 70 00 6E 33 00 03' + '10 32 00 00 32 00 00 B9 70 00 6F 33 00 03 10 32 00 00 33 00 00 B9 70 00 70 33 00 03 10 32 00 00' + '34 00 00 B9 70 00 71 33 00 03 0E 68 00 00 50 00 00 61 00 00 72 33 00 02 0E 64 00 00 61 00 00 73' + '33 00 02 0E 41 00 00 55 00 00 74 33 00 03 0E 62 00 00 61 00 00 72 00 00 75 33 00 02 0E 6F 00 00' + '56 00 00 76 33 00 02 0E 70 00 00 63 00 00 77 33 00 02 0E 64 00 00 6D 00 00 78 33 00 03 0E 64 00' + '00 6D 00 00 32 00 00 79 33 00 03 0E 64 00 00 6D 00 00 33 00 00 7A 33 00 02 0E 49 00 00 55 00 00' + '7B 33 00 02 0E 73 5E 00 10 62 00 7C 33 00 02 0E 2D 66 00 8C 54 00 7D 33 00 02 0E 27 59 00 63 6B' + '00 7E 33 00 02 0E 0E 66 00 BB 6C 00 7F 33 00 04 0E 2A 68 00 0F 5F 00 1A 4F 00 3E 79 00 80 33 00' + '02 0E 70 00 00 41 00 00 81 33 00 02 0E 6E 00 00 41 00 00 82 33 00 02 0E BC 03 00 41 00 00 83 33' + '00 02 0E 6D 00 00 41 00 00 84 33 00 02 0E 6B 00 00 41 00 00 85 33 00 02 0E 4B 00 00 42 00 00 86' + '33 00 02 0E 4D 00 00 42 00 00 87 33 00 02 0E 47 00 00 42 00 00 88 33 00 03 0E 63 00 00 61 00 00' + '6C 00 00 89 33 00 04 0E 6B 00 00 63 00 00 61 00 00 6C 00 00 8A 33 00 02 0E 70 00 00 46 00 00 8B' + '33 00 02 0E 6E 00 00 46 00 00 8C 33 00 02 0E BC 03 00 46 00 00 8D 33 00 02 0E BC 03 00 67 00 00' + '8E 33 00 02 0E 6D 00 00 67 00 00 8F 33 00 02 0E 6B 00 00 67 00 00 90 33 00 02 0E 48 00 00 7A 00' + '00 91 33 00 03 0E 6B 00 00 48 00 00 7A 00 00 92 33 00 03 0E 4D 00 00 48 00 00 7A 00 00 93 33 00' + '03 0E 47 00 00 48 00 00 7A 00 00 94 33 00 03 0E 54 00 00 48 00 00 7A 00 00 95 33 00 02 0E BC 03' + '00 6C 00 00 96 33 00 02 0E 6D 00 00 6C 00 00 97 33 00 02 0E 64 00 00 6C 00 00 98 33 00 02 0E 6B' + '00 00 6C 00 00 99 33 00 02 0E 66 00 00 6D 00 00 9A 33 00 02 0E 6E 00 00 6D 00 00 9B 33 00 02 0E' + 'BC 03 00 6D 00 00 9C 33 00 02 0E 6D 00 00 6D 00 00 9D 33 00 02 0E 63 00 00 6D 00 00 9E 33 00 02' + '0E 6B 00 00 6D 00 00 9F 33 00 03 0E 6D 00 00 6D 00 00 32 00 00 A0 33 00 03 0E 63 00 00 6D 00 00' + '32 00 00 A1 33 00 02 0E 6D 00 00 32 00 00 A2 33 00 03 0E 6B 00 00 6D 00 00 32 00 00 A3 33 00 03' + '0E 6D 00 00 6D 00 00 33 00 00 A4 33 00 03 0E 63 00 00 6D 00 00 33 00 00 A5 33 00 02 0E 6D 00 00' + '33 00 00 A6 33 00 03 0E 6B 00 00 6D 00 00 33 00 00 A7 33 00 03 0E 6D 00 00 15 22 00 73 00 00 A8' + '33 00 04 0E 6D 00 00 15 22 00 73 00 00 32 00 00 A9 33 00 02 0E 50 00 00 61 00 00 AA 33 00 03 0E' + '6B 00 00 50 00 00 61 00 00 AB 33 00 03 0E 4D 00 00 50 00 00 61 00 00 AC 33 00 03 0E 47 00 00 50' + '00 00 61 00 00 AD 33 00 03 0E 72 00 00 61 00 00 64 00 00 AE 33 00 05 0E 72 00 00 61 00 00 64 00' + '00 15 22 00 73 00 00 AF 33 00 06 0E 72 00 00 61 00 00 64 00 00 15 22 00 73 00 00 32 00 00 B0 33' + '00 02 0E 70 00 00 73 00 00 B1 33 00 02 0E 6E 00 00 73 00 00 B2 33 00 02 0E BC 03 00 73 00 00 B3' + '33 00 02 0E 6D 00 00 73 00 00 B4 33 00 02 0E 70 00 00 56 00 00 B5 33 00 02 0E 6E 00 00 56 00 00' + 'B6 33 00 02 0E BC 03 00 56 00 00 B7 33 00 02 0E 6D 00 00 56 00 00 B8 33 00 02 0E 6B 00 00 56 00' + '00 B9 33 00 02 0E 4D 00 00 56 00 00 BA 33 00 02 0E 70 00 00 57 00 00 BB 33 00 02 0E 6E 00 00 57' + '00 00 BC 33 00 02 0E BC 03 00 57 00 00 BD 33 00 02 0E 6D 00 00 57 00 00 BE 33 00 02 0E 6B 00 00' + '57 00 00 BF 33 00 02 0E 4D 00 00 57 00 00 C0 33 00 02 0E 6B 00 00 A9 03 00 C1 33 00 02 0E 4D 00' + '00 A9 03 00 C2 33 00 04 0E 61 00 00 2E 00 00 6D 00 00 2E 00 00 C3 33 00 02 0E 42 00 00 71 00 00' + 'C4 33 00 02 0E 63 00 00 63 00 00 C5 33 00 02 0E 63 00 00 64 00 00 C6 33 00 04 0E 43 00 00 15 22' + '00 6B 00 00 67 00 00 C7 33 00 03 0E 43 00 00 6F 00 00 2E 00 00 C8 33 00 02 0E 64 00 00 42 00 00' + 'C9 33 00 02 0E 47 00 00 79 00 00 CA 33 00 02 0E 68 00 00 61 00 00 CB 33 00 02 0E 48 00 00 50 00' + '00 CC 33 00 02 0E 69 00 00 6E 00 00 CD 33 00 02 0E 4B 00 00 4B 00 00 CE 33 00 02 0E 4B 00 00 4D' + '00 00 CF 33 00 02 0E 6B 00 00 74 00 00 D0 33 00 02 0E 6C 00 00 6D 00 00 D1 33 00 02 0E 6C 00 00' + '6E 00 00 D2 33 00 03 0E 6C 00 00 6F 00 00 67 00 00 D3 33 00 02 0E 6C 00 00 78 00 00 D4 33 00 02' + '0E 6D 00 00 62 00 00 D5 33 00 03 0E 6D 00 00 69 00 00 6C 00 00 D6 33 00 03 0E 6D 00 00 6F 00 00' + '6C 00 00 D7 33 00 02 0E 50 00 00 48 00 00 D8 33 00 04 0E 70 00 00 2E 00 00 6D 00 00 2E 00 00 D9' + '33 00 03 0E 50 00 00 50 00 00 4D 00 00 DA 33 00 02 0E 50 00 00 52 00 00 DB 33 00 02 0E 73 00 00' + '72 00 00 DC 33 00 02 0E 53 00 00 76 00 00 DD 33 00 02 0E 57 00 00 62 00 00 DE 33 00 03 0E 56 00' + '00 15 22 00 6D 00 00 DF 33 00 03 0E 41 00 00 15 22 00 6D 00 00 E0 33 00 02 10 31 00 00 E5 65 00' + 'E1 33 00 02 10 32 00 00 E5 65 00 E2 33 00 02 10 33 00 00 E5 65 00 E3 33 00 02 10 34 00 00 E5 65' + '00 E4 33 00 02 10 35 00 00 E5 65 00 E5 33 00 02 10 36 00 00 E5 65 00 E6 33 00 02 10 37 00 00 E5' + '65 00 E7 33 00 02 10 38 00 00 E5 65 00 E8 33 00 02 10 39 00 00 E5 65 00 E9 33 00 03 10 31 00 00' + '30 00 00 E5 65 00 EA 33 00 03 10 31 00 00 31 00 00 E5 65 00 EB 33 00 03 10 31 00 00 32 00 00 E5' + '65 00 EC 33 00 03 10 31 00 00 33 00 00 E5 65 00 ED 33 00 03 10 31 00 00 34 00 00 E5 65 00 EE 33' + '00 03 10 31 00 00 35 00 00 E5 65 00 EF 33 00 03 10 31 00 00 36 00 00 E5 65 00 F0 33 00 03 10 31' + '00 00 37 00 00 E5 65 00 F1 33 00 03 10 31 00 00 38 00 00 E5 65 00 F2 33 00 03 10 31 00 00 39 00' + '00 E5 65 00 F3 33 00 03 10 32 00 00 30 00 00 E5 65 00 F4 33 00 03 10 32 00 00 31 00 00 E5 65 00' + 'F5 33 00 03 10 32 00 00 32 00 00 E5 65 00 F6 33 00 03 10 32 00 00 33 00 00 E5 65 00 F7 33 00 03' + '10 32 00 00 34 00 00 E5 65 00 F8 33 00 03 10 32 00 00 35 00 00 E5 65 00 F9 33 00 03 10 32 00 00' + '36 00 00 E5 65 00 FA 33 00 03 10 32 00 00 37 00 00 E5 65 00 FB 33 00 03 10 32 00 00 38 00 00 E5' + '65 00 FC 33 00 03 10 32 00 00 39 00 00 E5 65 00 FD 33 00 03 10 33 00 00 30 00 00 E5 65 00 FE 33' + '00 03 10 33 00 00 31 00 00 E5 65 00 FF 33 00 03 0E 67 00 00 61 00 00 6C 00 00 9C A6 00 01 08 4A' + '04 00 9D A6 00 01 08 4C 04 00 70 A7 00 01 08 6F A7 00 F8 A7 00 01 08 26 01 00 F9 A7 00 01 08 53' + '01 00 5C AB 00 01 08 27 A7 00 5D AB 00 01 08 37 AB 00 5E AB 00 01 08 6B 02 00 5F AB 00 01 08 52' + 'AB 00 69 AB 00 01 08 8D 02 00 00 F9 00 01 00 48 8C 00 01 F9 00 01 00 F4 66 00 02 F9 00 01 00 CA' + '8E 00 03 F9 00 01 00 C8 8C 00 04 F9 00 01 00 D1 6E 00 05 F9 00 01 00 32 4E 00 06 F9 00 01 00 E5' + '53 00 07 F9 00 01 00 9C 9F 00 08 F9 00 01 00 9C 9F 00 09 F9 00 01 00 51 59 00 0A F9 00 01 00 D1' + '91 00 0B F9 00 01 00 87 55 00 0C F9 00 01 00 48 59 00 0D F9 00 01 00 F6 61 00 0E F9 00 01 00 69' + '76 00 0F F9 00 01 00 85 7F 00 10 F9 00 01 00 3F 86 00 11 F9 00 01 00 BA 87 00 12 F9 00 01 00 F8' + '88 00 13 F9 00 01 00 8F 90 00 14 F9 00 01 00 02 6A 00 15 F9 00 01 00 1B 6D 00 16 F9 00 01 00 D9' + '70 00 17 F9 00 01 00 DE 73 00 18 F9 00 01 00 3D 84 00 19 F9 00 01 00 6A 91 00 1A F9 00 01 00 F1' + '99 00 1B F9 00 01 00 82 4E 00 1C F9 00 01 00 75 53 00 1D F9 00 01 00 04 6B 00 1E F9 00 01 00 1B' + '72 00 1F F9 00 01 00 2D 86 00 20 F9 00 01 00 1E 9E 00 21 F9 00 01 00 50 5D 00 22 F9 00 01 00 EB' + '6F 00 23 F9 00 01 00 CD 85 00 24 F9 00 01 00 64 89 00 25 F9 00 01 00 C9 62 00 26 F9 00 01 00 D8' + '81 00 27 F9 00 01 00 1F 88 00 28 F9 00 01 00 CA 5E 00 29 F9 00 01 00 17 67 00 2A F9 00 01 00 6A' + '6D 00 2B F9 00 01 00 FC 72 00 2C F9 00 01 00 CE 90 00 2D F9 00 01 00 86 4F 00 2E F9 00 01 00 B7' + '51 00 2F F9 00 01 00 DE 52 00 30 F9 00 01 00 C4 64 00 31 F9 00 01 00 D3 6A 00 32 F9 00 01 00 10' + '72 00 33 F9 00 01 00 E7 76 00 34 F9 00 01 00 01 80 00 35 F9 00 01 00 06 86 00 36 F9 00 01 00 5C' + '86 00 37 F9 00 01 00 EF 8D 00 38 F9 00 01 00 32 97 00 39 F9 00 01 00 6F 9B 00 3A F9 00 01 00 FA' + '9D 00 3B F9 00 01 00 8C 78 00 3C F9 00 01 00 7F 79 00 3D F9 00 01 00 A0 7D 00 3E F9 00 01 00 C9' + '83 00 3F F9 00 01 00 04 93 00 40 F9 00 01 00 7F 9E 00 41 F9 00 01 00 D6 8A 00 42 F9 00 01 00 DF' + '58 00 43 F9 00 01 00 04 5F 00 44 F9 00 01 00 60 7C 00 45 F9 00 01 00 7E 80 00 46 F9 00 01 00 62' + '72 00 47 F9 00 01 00 CA 78 00 48 F9 00 01 00 C2 8C 00 49 F9 00 01 00 F7 96 00 4A F9 00 01 00 D8' + '58 00 4B F9 00 01 00 62 5C 00 4C F9 00 01 00 13 6A 00 4D F9 00 01 00 DA 6D 00 4E F9 00 01 00 0F' + '6F 00 4F F9 00 01 00 2F 7D 00 50 F9 00 01 00 37 7E 00 51 F9 00 01 00 4B 96 00 52 F9 00 01 00 D2' + '52 00 53 F9 00 01 00 8B 80 00 54 F9 00 01 00 DC 51 00 55 F9 00 01 00 CC 51 00 56 F9 00 01 00 1C' + '7A 00 57 F9 00 01 00 BE 7D 00 58 F9 00 01 00 F1 83 00 59 F9 00 01 00 75 96 00 5A F9 00 01 00 80' + '8B 00 5B F9 00 01 00 CF 62 00 5C F9 00 01 00 02 6A 00 5D F9 00 01 00 FE 8A 00 5E F9 00 01 00 39' + '4E 00 5F F9 00 01 00 E7 5B 00 60 F9 00 01 00 12 60 00 61 F9 00 01 00 87 73 00 62 F9 00 01 00 70' + '75 00 63 F9 00 01 00 17 53 00 64 F9 00 01 00 FB 78 00 65 F9 00 01 00 BF 4F 00 66 F9 00 01 00 A9' + '5F 00 67 F9 00 01 00 0D 4E 00 68 F9 00 01 00 CC 6C 00 69 F9 00 01 00 78 65 00 6A F9 00 01 00 22' + '7D 00 6B F9 00 01 00 C3 53 00 6C F9 00 01 00 5E 58 00 6D F9 00 01 00 01 77 00 6E F9 00 01 00 49' + '84 00 6F F9 00 01 00 AA 8A 00 70 F9 00 01 00 BA 6B 00 71 F9 00 01 00 B0 8F 00 72 F9 00 01 00 88' + '6C 00 73 F9 00 01 00 FE 62 00 74 F9 00 01 00 E5 82 00 75 F9 00 01 00 A0 63 00 76 F9 00 01 00 65' + '75 00 77 F9 00 01 00 AE 4E 00 78 F9 00 01 00 69 51 00 79 F9 00 01 00 C9 51 00 7A F9 00 01 00 81' + '68 00 7B F9 00 01 00 E7 7C 00 7C F9 00 01 00 6F 82 00 7D F9 00 01 00 D2 8A 00 7E F9 00 01 00 CF' + '91 00 7F F9 00 01 00 F5 52 00 80 F9 00 01 00 42 54 00 81 F9 00 01 00 73 59 00 82 F9 00 01 00 EC' + '5E 00 83 F9 00 01 00 C5 65 00 84 F9 00 01 00 FE 6F 00 85 F9 00 01 00 2A 79 00 86 F9 00 01 00 AD' + '95 00 87 F9 00 01 00 6A 9A 00 88 F9 00 01 00 97 9E 00 89 F9 00 01 00 CE 9E 00 8A F9 00 01 00 9B' + '52 00 8B F9 00 01 00 C6 66 00 8C F9 00 01 00 77 6B 00 8D F9 00 01 00 62 8F 00 8E F9 00 01 00 74' + '5E 00 8F F9 00 01 00 90 61 00 90 F9 00 01 00 00 62 00 91 F9 00 01 00 9A 64 00 92 F9 00 01 00 23' + '6F 00 93 F9 00 01 00 49 71 00 94 F9 00 01 00 89 74 00 95 F9 00 01 00 CA 79 00 96 F9 00 01 00 F4' + '7D 00 97 F9 00 01 00 6F 80 00 98 F9 00 01 00 26 8F 00 99 F9 00 01 00 EE 84 00 9A F9 00 01 00 23' + '90 00 9B F9 00 01 00 4A 93 00 9C F9 00 01 00 17 52 00 9D F9 00 01 00 A3 52 00 9E F9 00 01 00 BD' + '54 00 9F F9 00 01 00 C8 70 00 A0 F9 00 01 00 C2 88 00 A1 F9 00 01 00 AA 8A 00 A2 F9 00 01 00 C9' + '5E 00 A3 F9 00 01 00 F5 5F 00 A4 F9 00 01 00 7B 63 00 A5 F9 00 01 00 AE 6B 00 A6 F9 00 01 00 3E' + '7C 00 A7 F9 00 01 00 75 73 00 A8 F9 00 01 00 E4 4E 00 A9 F9 00 01 00 F9 56 00 AA F9 00 01 00 E7' + '5B 00 AB F9 00 01 00 BA 5D 00 AC F9 00 01 00 1C 60 00 AD F9 00 01 00 B2 73 00 AE F9 00 01 00 69' + '74 00 AF F9 00 01 00 9A 7F 00 B0 F9 00 01 00 46 80 00 B1 F9 00 01 00 34 92 00 B2 F9 00 01 00 F6' + '96 00 B3 F9 00 01 00 48 97 00 B4 F9 00 01 00 18 98 00 B5 F9 00 01 00 8B 4F 00 B6 F9 00 01 00 AE' + '79 00 B7 F9 00 01 00 B4 91 00 B8 F9 00 01 00 B8 96 00 B9 F9 00 01 00 E1 60 00 BA F9 00 01 00 86' + '4E 00 BB F9 00 01 00 DA 50 00 BC F9 00 01 00 EE 5B 00 BD F9 00 01 00 3F 5C 00 BE F9 00 01 00 99' + '65 00 BF F9 00 01 00 02 6A 00 C0 F9 00 01 00 CE 71 00 C1 F9 00 01 00 42 76 00 C2 F9 00 01 00 FC' + '84 00 C3 F9 00 01 00 7C 90 00 C4 F9 00 01 00 8D 9F 00 C5 F9 00 01 00 88 66 00 C6 F9 00 01 00 2E' + '96 00 C7 F9 00 01 00 89 52 00 C8 F9 00 01 00 7B 67 00 C9 F9 00 01 00 F3 67 00 CA F9 00 01 00 41' + '6D 00 CB F9 00 01 00 9C 6E 00 CC F9 00 01 00 09 74 00 CD F9 00 01 00 59 75 00 CE F9 00 01 00 6B' + '78 00 CF F9 00 01 00 10 7D 00 D0 F9 00 01 00 5E 98 00 D1 F9 00 01 00 6D 51 00 D2 F9 00 01 00 2E' + '62 00 D3 F9 00 01 00 78 96 00 D4 F9 00 01 00 2B 50 00 D5 F9 00 01 00 19 5D 00 D6 F9 00 01 00 EA' + '6D 00 D7 F9 00 01 00 2A 8F 00 D8 F9 00 01 00 8B 5F 00 D9 F9 00 01 00 44 61 00 DA F9 00 01 00 17' + '68 00 DB F9 00 01 00 87 73 00 DC F9 00 01 00 86 96 00 DD F9 00 01 00 29 52 00 DE F9 00 01 00 0F' + '54 00 DF F9 00 01 00 65 5C 00 E0 F9 00 01 00 13 66 00 E1 F9 00 01 00 4E 67 00 E2 F9 00 01 00 A8' + '68 00 E3 F9 00 01 00 E5 6C 00 E4 F9 00 01 00 06 74 00 E5 F9 00 01 00 E2 75 00 E6 F9 00 01 00 79' + '7F 00 E7 F9 00 01 00 CF 88 00 E8 F9 00 01 00 E1 88 00 E9 F9 00 01 00 CC 91 00 EA F9 00 01 00 E2' + '96 00 EB F9 00 01 00 3F 53 00 EC F9 00 01 00 BA 6E 00 ED F9 00 01 00 1D 54 00 EE F9 00 01 00 D0' + '71 00 EF F9 00 01 00 98 74 00 F0 F9 00 01 00 FA 85 00 F1 F9 00 01 00 A3 96 00 F2 F9 00 01 00 57' + '9C 00 F3 F9 00 01 00 9F 9E 00 F4 F9 00 01 00 97 67 00 F5 F9 00 01 00 CB 6D 00 F6 F9 00 01 00 E8' + '81 00 F7 F9 00 01 00 CB 7A 00 F8 F9 00 01 00 20 7B 00 F9 F9 00 01 00 92 7C 00 FA F9 00 01 00 C0' + '72 00 FB F9 00 01 00 99 70 00 FC F9 00 01 00 58 8B 00 FD F9 00 01 00 C0 4E 00 FE F9 00 01 00 36' + '83 00 FF F9 00 01 00 3A 52 00 00 FA 00 01 00 07 52 00 01 FA 00 01 00 A6 5E 00 02 FA 00 01 00 D3' + '62 00 03 FA 00 01 00 D6 7C 00 04 FA 00 01 00 85 5B 00 05 FA 00 01 00 1E 6D 00 06 FA 00 01 00 B4' + '66 00 07 FA 00 01 00 3B 8F 00 08 FA 00 01 00 4C 88 00 09 FA 00 01 00 4D 96 00 0A FA 00 01 00 8B' + '89 00 0B FA 00 01 00 D3 5E 00 0C FA 00 01 00 40 51 00 0D FA 00 01 00 C0 55 00 10 FA 00 01 00 5A' + '58 00 12 FA 00 01 00 74 66 00 15 FA 00 01 00 DE 51 00 16 FA 00 01 00 2A 73 00 17 FA 00 01 00 CA' + '76 00 18 FA 00 01 00 3C 79 00 19 FA 00 01 00 5E 79 00 1A FA 00 01 00 65 79 00 1B FA 00 01 00 8F' + '79 00 1C FA 00 01 00 56 97 00 1D FA 00 01 00 BE 7C 00 1E FA 00 01 00 BD 7F 00 20 FA 00 01 00 12' + '86 00 22 FA 00 01 00 F8 8A 00 25 FA 00 01 00 38 90 00 26 FA 00 01 00 FD 90 00 2A FA 00 01 00 EF' + '98 00 2B FA 00 01 00 FC 98 00 2C FA 00 01 00 28 99 00 2D FA 00 01 00 B4 9D 00 2E FA 00 01 00 DE' + '90 00 2F FA 00 01 00 B7 96 00 30 FA 00 01 00 AE 4F 00 31 FA 00 01 00 E7 50 00 32 FA 00 01 00 4D' + '51 00 33 FA 00 01 00 C9 52 00 34 FA 00 01 00 E4 52 00 35 FA 00 01 00 51 53 00 36 FA 00 01 00 9D' + '55 00 37 FA 00 01 00 06 56 00 38 FA 00 01 00 68 56 00 39 FA 00 01 00 40 58 00 3A FA 00 01 00 A8' + '58 00 3B FA 00 01 00 64 5C 00 3C FA 00 01 00 6E 5C 00 3D FA 00 01 00 94 60 00 3E FA 00 01 00 68' + '61 00 3F FA 00 01 00 8E 61 00 40 FA 00 01 00 F2 61 00 41 FA 00 01 00 4F 65 00 42 FA 00 01 00 E2' + '65 00 43 FA 00 01 00 91 66 00 44 FA 00 01 00 85 68 00 45 FA 00 01 00 77 6D 00 46 FA 00 01 00 1A' + '6E 00 47 FA 00 01 00 22 6F 00 48 FA 00 01 00 6E 71 00 49 FA 00 01 00 2B 72 00 4A FA 00 01 00 22' + '74 00 4B FA 00 01 00 91 78 00 4C FA 00 01 00 3E 79 00 4D FA 00 01 00 49 79 00 4E FA 00 01 00 48' + '79 00 4F FA 00 01 00 50 79 00 50 FA 00 01 00 56 79 00 51 FA 00 01 00 5D 79 00 52 FA 00 01 00 8D' + '79 00 53 FA 00 01 00 8E 79 00 54 FA 00 01 00 40 7A 00 55 FA 00 01 00 81 7A 00 56 FA 00 01 00 C0' + '7B 00 57 FA 00 01 00 F4 7D 00 58 FA 00 01 00 09 7E 00 59 FA 00 01 00 41 7E 00 5A FA 00 01 00 72' + '7F 00 5B FA 00 01 00 05 80 00 5C FA 00 01 00 ED 81 00 5D FA 00 01 00 79 82 00 5E FA 00 01 00 79' + '82 00 5F FA 00 01 00 57 84 00 60 FA 00 01 00 10 89 00 61 FA 00 01 00 96 89 00 62 FA 00 01 00 01' + '8B 00 63 FA 00 01 00 39 8B 00 64 FA 00 01 00 D3 8C 00 65 FA 00 01 00 08 8D 00 66 FA 00 01 00 B6' + '8F 00 67 FA 00 01 00 38 90 00 68 FA 00 01 00 E3 96 00 69 FA 00 01 00 FF 97 00 6A FA 00 01 00 3B' + '98 00 6B FA 00 01 00 75 60 00 6C FA 00 01 00 EE 42 02 6D FA 00 01 00 18 82 00 70 FA 00 01 00 26' + '4E 00 71 FA 00 01 00 B5 51 00 72 FA 00 01 00 68 51 00 73 FA 00 01 00 80 4F 00 74 FA 00 01 00 45' + '51 00 75 FA 00 01 00 80 51 00 76 FA 00 01 00 C7 52 00 77 FA 00 01 00 FA 52 00 78 FA 00 01 00 9D' + '55 00 79 FA 00 01 00 55 55 00 7A FA 00 01 00 99 55 00 7B FA 00 01 00 E2 55 00 7C FA 00 01 00 5A' + '58 00 7D FA 00 01 00 B3 58 00 7E FA 00 01 00 44 59 00 7F FA 00 01 00 54 59 00 80 FA 00 01 00 62' + '5A 00 81 FA 00 01 00 28 5B 00 82 FA 00 01 00 D2 5E 00 83 FA 00 01 00 D9 5E 00 84 FA 00 01 00 69' + '5F 00 85 FA 00 01 00 AD 5F 00 86 FA 00 01 00 D8 60 00 87 FA 00 01 00 4E 61 00 88 FA 00 01 00 08' + '61 00 89 FA 00 01 00 8E 61 00 8A FA 00 01 00 60 61 00 8B FA 00 01 00 F2 61 00 8C FA 00 01 00 34' + '62 00 8D FA 00 01 00 C4 63 00 8E FA 00 01 00 1C 64 00 8F FA 00 01 00 52 64 00 90 FA 00 01 00 56' + '65 00 91 FA 00 01 00 74 66 00 92 FA 00 01 00 17 67 00 93 FA 00 01 00 1B 67 00 94 FA 00 01 00 56' + '67 00 95 FA 00 01 00 79 6B 00 96 FA 00 01 00 BA 6B 00 97 FA 00 01 00 41 6D 00 98 FA 00 01 00 DB' + '6E 00 99 FA 00 01 00 CB 6E 00 9A FA 00 01 00 22 6F 00 9B FA 00 01 00 1E 70 00 9C FA 00 01 00 6E' + '71 00 9D FA 00 01 00 A7 77 00 9E FA 00 01 00 35 72 00 9F FA 00 01 00 AF 72 00 A0 FA 00 01 00 2A' + '73 00 A1 FA 00 01 00 71 74 00 A2 FA 00 01 00 06 75 00 A3 FA 00 01 00 3B 75 00 A4 FA 00 01 00 1D' + '76 00 A5 FA 00 01 00 1F 76 00 A6 FA 00 01 00 CA 76 00 A7 FA 00 01 00 DB 76 00 A8 FA 00 01 00 F4' + '76 00 A9 FA 00 01 00 4A 77 00 AA FA 00 01 00 40 77 00 AB FA 00 01 00 CC 78 00 AC FA 00 01 00 B1' + '7A 00 AD FA 00 01 00 C0 7B 00 AE FA 00 01 00 7B 7C 00 AF FA 00 01 00 5B 7D 00 B0 FA 00 01 00 F4' + '7D 00 B1 FA 00 01 00 3E 7F 00 B2 FA 00 01 00 05 80 00 B3 FA 00 01 00 52 83 00 B4 FA 00 01 00 EF' + '83 00 B5 FA 00 01 00 79 87 00 B6 FA 00 01 00 41 89 00 B7 FA 00 01 00 86 89 00 B8 FA 00 01 00 96' + '89 00 B9 FA 00 01 00 BF 8A 00 BA FA 00 01 00 F8 8A 00 BB FA 00 01 00 CB 8A 00 BC FA 00 01 00 01' + '8B 00 BD FA 00 01 00 FE 8A 00 BE FA 00 01 00 ED 8A 00 BF FA 00 01 00 39 8B 00 C0 FA 00 01 00 8A' + '8B 00 C1 FA 00 01 00 08 8D 00 C2 FA 00 01 00 38 8F 00 C3 FA 00 01 00 72 90 00 C4 FA 00 01 00 99' + '91 00 C5 FA 00 01 00 76 92 00 C6 FA 00 01 00 7C 96 00 C7 FA 00 01 00 E3 96 00 C8 FA 00 01 00 56' + '97 00 C9 FA 00 01 00 DB 97 00 CA FA 00 01 00 FF 97 00 CB FA 00 01 00 0B 98 00 CC FA 00 01 00 3B' + '98 00 CD FA 00 01 00 12 9B 00 CE FA 00 01 00 9C 9F 00 CF FA 00 01 00 4A 28 02 D0 FA 00 01 00 44' + '28 02 D1 FA 00 01 00 D5 33 02 D2 FA 00 01 00 9D 3B 00 D3 FA 00 01 00 18 40 00 D4 FA 00 01 00 39' + '40 00 D5 FA 00 01 00 49 52 02 D6 FA 00 01 00 D0 5C 02 D7 FA 00 01 00 D3 7E 02 D8 FA 00 01 00 43' + '9F 00 D9 FA 00 01 00 8E 9F 00 00 FB 00 02 10 66 00 00 66 00 00 01 FB 00 02 10 66 00 00 69 00 00' + '02 FB 00 02 10 66 00 00 6C 00 00 03 FB 00 03 10 66 00 00 66 00 00 69 00 00 04 FB 00 03 10 66 00' + '00 66 00 00 6C 00 00 05 FB 00 02 10 73 00 00 74 00 00 06 FB 00 02 10 73 00 00 74 00 00 13 FB 00' + '02 10 74 05 00 76 05 00 14 FB 00 02 10 74 05 00 65 05 00 15 FB 00 02 10 74 05 00 6B 05 00 16 FB' + '00 02 10 7E 05 00 76 05 00 17 FB 00 02 10 74 05 00 6D 05 00 1D FB 00 02 00 D9 05 00 B4 05 00 1F' + 'FB 00 02 00 F2 05 00 B7 05 00 20 FB 00 01 01 E2 05 00 21 FB 00 01 01 D0 05 00 22 FB 00 01 01 D3' + '05 00 23 FB 00 01 01 D4 05 00 24 FB 00 01 01 DB 05 00 25 FB 00 01 01 DC 05 00 26 FB 00 01 01 DD' + '05 00 27 FB 00 01 01 E8 05 00 28 FB 00 01 01 EA 05 00 29 FB 00 01 01 2B 00 00 2A FB 00 02 00 E9' + '05 00 C1 05 00 2B FB 00 02 00 E9 05 00 C2 05 00 2C FB 00 03 00 E9 05 00 BC 05 00 C1 05 00 2D FB' + '00 03 00 E9 05 00 BC 05 00 C2 05 00 2E FB 00 02 00 D0 05 00 B7 05 00 2F FB 00 02 00 D0 05 00 B8' + '05 00 30 FB 00 02 00 D0 05 00 BC 05 00 31 FB 00 02 00 D1 05 00 BC 05 00 32 FB 00 02 00 D2 05 00' + 'BC 05 00 33 FB 00 02 00 D3 05 00 BC 05 00 34 FB 00 02 00 D4 05 00 BC 05 00 35 FB 00 02 00 D5 05' + '00 BC 05 00 36 FB 00 02 00 D6 05 00 BC 05 00 38 FB 00 02 00 D8 05 00 BC 05 00 39 FB 00 02 00 D9' + '05 00 BC 05 00 3A FB 00 02 00 DA 05 00 BC 05 00 3B FB 00 02 00 DB 05 00 BC 05 00 3C FB 00 02 00' + 'DC 05 00 BC 05 00 3E FB 00 02 00 DE 05 00 BC 05 00 40 FB 00 02 00 E0 05 00 BC 05 00 41 FB 00 02' + '00 E1 05 00 BC 05 00 43 FB 00 02 00 E3 05 00 BC 05 00 44 FB 00 02 00 E4 05 00 BC 05 00 46 FB 00' + '02 00 E6 05 00 BC 05 00 47 FB 00 02 00 E7 05 00 BC 05 00 48 FB 00 02 00 E8 05 00 BC 05 00 49 FB' + '00 02 00 E9 05 00 BC 05 00 4A FB 00 02 00 EA 05 00 BC 05 00 4B FB 00 02 00 D5 05 00 B9 05 00 4C' + 'FB 00 02 00 D1 05 00 BF 05 00 4D FB 00 02 00 DB 05 00 BF 05 00 4E FB 00 02 00 E4 05 00 BF 05 00' + '4F FB 00 02 10 D0 05 00 DC 05 00 50 FB 00 01 06 71 06 00 51 FB 00 01 05 71 06 00 52 FB 00 01 06' + '7B 06 00 53 FB 00 01 05 7B 06 00 54 FB 00 01 03 7B 06 00 55 FB 00 01 04 7B 06 00 56 FB 00 01 06' + '7E 06 00 57 FB 00 01 05 7E 06 00 58 FB 00 01 03 7E 06 00 59 FB 00 01 04 7E 06 00 5A FB 00 01 06' + '80 06 00 5B FB 00 01 05 80 06 00 5C FB 00 01 03 80 06 00 5D FB 00 01 04 80 06 00 5E FB 00 01 06' + '7A 06 00 5F FB 00 01 05 7A 06 00 60 FB 00 01 03 7A 06 00 61 FB 00 01 04 7A 06 00 62 FB 00 01 06' + '7F 06 00 63 FB 00 01 05 7F 06 00 64 FB 00 01 03 7F 06 00 65 FB 00 01 04 7F 06 00 66 FB 00 01 06' + '79 06 00 67 FB 00 01 05 79 06 00 68 FB 00 01 03 79 06 00 69 FB 00 01 04 79 06 00 6A FB 00 01 06' + 'A4 06 00 6B FB 00 01 05 A4 06 00 6C FB 00 01 03 A4 06 00 6D FB 00 01 04 A4 06 00 6E FB 00 01 06' + 'A6 06 00 6F FB 00 01 05 A6 06 00 70 FB 00 01 03 A6 06 00 71 FB 00 01 04 A6 06 00 72 FB 00 01 06' + '84 06 00 73 FB 00 01 05 84 06 00 74 FB 00 01 03 84 06 00 75 FB 00 01 04 84 06 00 76 FB 00 01 06' + '83 06 00 77 FB 00 01 05 83 06 00 78 FB 00 01 03 83 06 00 79 FB 00 01 04 83 06 00 7A FB 00 01 06' + '86 06 00 7B FB 00 01 05 86 06 00 7C FB 00 01 03 86 06 00 7D FB 00 01 04 86 06 00 7E FB 00 01 06' + '87 06 00 7F FB 00 01 05 87 06 00 80 FB 00 01 03 87 06 00 81 FB 00 01 04 87 06 00 82 FB 00 01 06' + '8D 06 00 83 FB 00 01 05 8D 06 00 84 FB 00 01 06 8C 06 00 85 FB 00 01 05 8C 06 00 86 FB 00 01 06' + '8E 06 00 87 FB 00 01 05 8E 06 00 88 FB 00 01 06 88 06 00 89 FB 00 01 05 88 06 00 8A FB 00 01 06' + '98 06 00 8B FB 00 01 05 98 06 00 8C FB 00 01 06 91 06 00 8D FB 00 01 05 91 06 00 8E FB 00 01 06' + 'A9 06 00 8F FB 00 01 05 A9 06 00 90 FB 00 01 03 A9 06 00 91 FB 00 01 04 A9 06 00 92 FB 00 01 06' + 'AF 06 00 93 FB 00 01 05 AF 06 00 94 FB 00 01 03 AF 06 00 95 FB 00 01 04 AF 06 00 96 FB 00 01 06' + 'B3 06 00 97 FB 00 01 05 B3 06 00 98 FB 00 01 03 B3 06 00 99 FB 00 01 04 B3 06 00 9A FB 00 01 06' + 'B1 06 00 9B FB 00 01 05 B1 06 00 9C FB 00 01 03 B1 06 00 9D FB 00 01 04 B1 06 00 9E FB 00 01 06' + 'BA 06 00 9F FB 00 01 05 BA 06 00 A0 FB 00 01 06 BB 06 00 A1 FB 00 01 05 BB 06 00 A2 FB 00 01 03' + 'BB 06 00 A3 FB 00 01 04 BB 06 00 A4 FB 00 02 06 D5 06 00 54 06 00 A5 FB 00 02 05 D5 06 00 54 06' + '00 A6 FB 00 01 06 C1 06 00 A7 FB 00 01 05 C1 06 00 A8 FB 00 01 03 C1 06 00 A9 FB 00 01 04 C1 06' + '00 AA FB 00 01 06 BE 06 00 AB FB 00 01 05 BE 06 00 AC FB 00 01 03 BE 06 00 AD FB 00 01 04 BE 06' + '00 AE FB 00 01 06 D2 06 00 AF FB 00 01 05 D2 06 00 B0 FB 00 02 06 D2 06 00 54 06 00 B1 FB 00 02' + '05 D2 06 00 54 06 00 D3 FB 00 01 06 AD 06 00 D4 FB 00 01 05 AD 06 00 D5 FB 00 01 03 AD 06 00 D6' + 'FB 00 01 04 AD 06 00 D7 FB 00 01 06 C7 06 00 D8 FB 00 01 05 C7 06 00 D9 FB 00 01 06 C6 06 00 DA' + 'FB 00 01 05 C6 06 00 DB FB 00 01 06 C8 06 00 DC FB 00 01 05 C8 06 00 DD FB 00 02 06 C7 06 00 74' + '06 00 DE FB 00 01 06 CB 06 00 DF FB 00 01 05 CB 06 00 E0 FB 00 01 06 C5 06 00 E1 FB 00 01 05 C5' + '06 00 E2 FB 00 01 06 C9 06 00 E3 FB 00 01 05 C9 06 00 E4 FB 00 01 06 D0 06 00 E5 FB 00 01 05 D0' + '06 00 E6 FB 00 01 03 D0 06 00 E7 FB 00 01 04 D0 06 00 E8 FB 00 01 03 49 06 00 E9 FB 00 01 04 49' + '06 00 EA FB 00 03 06 4A 06 00 54 06 00 27 06 00 EB FB 00 03 05 4A 06 00 54 06 00 27 06 00 EC FB' + '00 03 06 4A 06 00 54 06 00 D5 06 00 ED FB 00 03 05 4A 06 00 54 06 00 D5 06 00 EE FB 00 03 06 4A' + '06 00 54 06 00 48 06 00 EF FB 00 03 05 4A 06 00 54 06 00 48 06 00 F0 FB 00 03 06 4A 06 00 54 06' + '00 C7 06 00 F1 FB 00 03 05 4A 06 00 54 06 00 C7 06 00 F2 FB 00 03 06 4A 06 00 54 06 00 C6 06 00' + 'F3 FB 00 03 05 4A 06 00 54 06 00 C6 06 00 F4 FB 00 03 06 4A 06 00 54 06 00 C8 06 00 F5 FB 00 03' + '05 4A 06 00 54 06 00 C8 06 00 F6 FB 00 03 06 4A 06 00 54 06 00 D0 06 00 F7 FB 00 03 05 4A 06 00' + '54 06 00 D0 06 00 F8 FB 00 03 03 4A 06 00 54 06 00 D0 06 00 F9 FB 00 03 06 4A 06 00 54 06 00 49' + '06 00 FA FB 00 03 05 4A 06 00 54 06 00 49 06 00 FB FB 00 03 03 4A 06 00 54 06 00 49 06 00 FC FB' + '00 01 06 CC 06 00 FD FB 00 01 05 CC 06 00 FE FB 00 01 03 CC 06 00 FF FB 00 01 04 CC 06 00 00 FC' + '00 03 06 4A 06 00 54 06 00 2C 06 00 01 FC 00 03 06 4A 06 00 54 06 00 2D 06 00 02 FC 00 03 06 4A' + '06 00 54 06 00 45 06 00 03 FC 00 03 06 4A 06 00 54 06 00 49 06 00 04 FC 00 03 06 4A 06 00 54 06' + '00 4A 06 00 05 FC 00 02 06 28 06 00 2C 06 00 06 FC 00 02 06 28 06 00 2D 06 00 07 FC 00 02 06 28' + '06 00 2E 06 00 08 FC 00 02 06 28 06 00 45 06 00 09 FC 00 02 06 28 06 00 49 06 00 0A FC 00 02 06' + '28 06 00 4A 06 00 0B FC 00 02 06 2A 06 00 2C 06 00 0C FC 00 02 06 2A 06 00 2D 06 00 0D FC 00 02' + '06 2A 06 00 2E 06 00 0E FC 00 02 06 2A 06 00 45 06 00 0F FC 00 02 06 2A 06 00 49 06 00 10 FC 00' + '02 06 2A 06 00 4A 06 00 11 FC 00 02 06 2B 06 00 2C 06 00 12 FC 00 02 06 2B 06 00 45 06 00 13 FC' + '00 02 06 2B 06 00 49 06 00 14 FC 00 02 06 2B 06 00 4A 06 00 15 FC 00 02 06 2C 06 00 2D 06 00 16' + 'FC 00 02 06 2C 06 00 45 06 00 17 FC 00 02 06 2D 06 00 2C 06 00 18 FC 00 02 06 2D 06 00 45 06 00' + '19 FC 00 02 06 2E 06 00 2C 06 00 1A FC 00 02 06 2E 06 00 2D 06 00 1B FC 00 02 06 2E 06 00 45 06' + '00 1C FC 00 02 06 33 06 00 2C 06 00 1D FC 00 02 06 33 06 00 2D 06 00 1E FC 00 02 06 33 06 00 2E' + '06 00 1F FC 00 02 06 33 06 00 45 06 00 20 FC 00 02 06 35 06 00 2D 06 00 21 FC 00 02 06 35 06 00' + '45 06 00 22 FC 00 02 06 36 06 00 2C 06 00 23 FC 00 02 06 36 06 00 2D 06 00 24 FC 00 02 06 36 06' + '00 2E 06 00 25 FC 00 02 06 36 06 00 45 06 00 26 FC 00 02 06 37 06 00 2D 06 00 27 FC 00 02 06 37' + '06 00 45 06 00 28 FC 00 02 06 38 06 00 45 06 00 29 FC 00 02 06 39 06 00 2C 06 00 2A FC 00 02 06' + '39 06 00 45 06 00 2B FC 00 02 06 3A 06 00 2C 06 00 2C FC 00 02 06 3A 06 00 45 06 00 2D FC 00 02' + '06 41 06 00 2C 06 00 2E FC 00 02 06 41 06 00 2D 06 00 2F FC 00 02 06 41 06 00 2E 06 00 30 FC 00' + '02 06 41 06 00 45 06 00 31 FC 00 02 06 41 06 00 49 06 00 32 FC 00 02 06 41 06 00 4A 06 00 33 FC' + '00 02 06 42 06 00 2D 06 00 34 FC 00 02 06 42 06 00 45 06 00 35 FC 00 02 06 42 06 00 49 06 00 36' + 'FC 00 02 06 42 06 00 4A 06 00 37 FC 00 02 06 43 06 00 27 06 00 38 FC 00 02 06 43 06 00 2C 06 00' + '39 FC 00 02 06 43 06 00 2D 06 00 3A FC 00 02 06 43 06 00 2E 06 00 3B FC 00 02 06 43 06 00 44 06' + '00 3C FC 00 02 06 43 06 00 45 06 00 3D FC 00 02 06 43 06 00 49 06 00 3E FC 00 02 06 43 06 00 4A' + '06 00 3F FC 00 02 06 44 06 00 2C 06 00 40 FC 00 02 06 44 06 00 2D 06 00 41 FC 00 02 06 44 06 00' + '2E 06 00 42 FC 00 02 06 44 06 00 45 06 00 43 FC 00 02 06 44 06 00 49 06 00 44 FC 00 02 06 44 06' + '00 4A 06 00 45 FC 00 02 06 45 06 00 2C 06 00 46 FC 00 02 06 45 06 00 2D 06 00 47 FC 00 02 06 45' + '06 00 2E 06 00 48 FC 00 02 06 45 06 00 45 06 00 49 FC 00 02 06 45 06 00 49 06 00 4A FC 00 02 06' + '45 06 00 4A 06 00 4B FC 00 02 06 46 06 00 2C 06 00 4C FC 00 02 06 46 06 00 2D 06 00 4D FC 00 02' + '06 46 06 00 2E 06 00 4E FC 00 02 06 46 06 00 45 06 00 4F FC 00 02 06 46 06 00 49 06 00 50 FC 00' + '02 06 46 06 00 4A 06 00 51 FC 00 02 06 47 06 00 2C 06 00 52 FC 00 02 06 47 06 00 45 06 00 53 FC' + '00 02 06 47 06 00 49 06 00 54 FC 00 02 06 47 06 00 4A 06 00 55 FC 00 02 06 4A 06 00 2C 06 00 56' + 'FC 00 02 06 4A 06 00 2D 06 00 57 FC 00 02 06 4A 06 00 2E 06 00 58 FC 00 02 06 4A 06 00 45 06 00' + '59 FC 00 02 06 4A 06 00 49 06 00 5A FC 00 02 06 4A 06 00 4A 06 00 5B FC 00 02 06 30 06 00 70 06' + '00 5C FC 00 02 06 31 06 00 70 06 00 5D FC 00 02 06 49 06 00 70 06 00 5E FC 00 03 06 20 00 00 4C' + '06 00 51 06 00 5F FC 00 03 06 20 00 00 4D 06 00 51 06 00 60 FC 00 03 06 20 00 00 4E 06 00 51 06' + '00 61 FC 00 03 06 20 00 00 4F 06 00 51 06 00 62 FC 00 03 06 20 00 00 50 06 00 51 06 00 63 FC 00' + '03 06 20 00 00 51 06 00 70 06 00 64 FC 00 03 05 4A 06 00 54 06 00 31 06 00 65 FC 00 03 05 4A 06' + '00 54 06 00 32 06 00 66 FC 00 03 05 4A 06 00 54 06 00 45 06 00 67 FC 00 03 05 4A 06 00 54 06 00' + '46 06 00 68 FC 00 03 05 4A 06 00 54 06 00 49 06 00 69 FC 00 03 05 4A 06 00 54 06 00 4A 06 00 6A' + 'FC 00 02 05 28 06 00 31 06 00 6B FC 00 02 05 28 06 00 32 06 00 6C FC 00 02 05 28 06 00 45 06 00' + '6D FC 00 02 05 28 06 00 46 06 00 6E FC 00 02 05 28 06 00 49 06 00 6F FC 00 02 05 28 06 00 4A 06' + '00 70 FC 00 02 05 2A 06 00 31 06 00 71 FC 00 02 05 2A 06 00 32 06 00 72 FC 00 02 05 2A 06 00 45' + '06 00 73 FC 00 02 05 2A 06 00 46 06 00 74 FC 00 02 05 2A 06 00 49 06 00 75 FC 00 02 05 2A 06 00' + '4A 06 00 76 FC 00 02 05 2B 06 00 31 06 00 77 FC 00 02 05 2B 06 00 32 06 00 78 FC 00 02 05 2B 06' + '00 45 06 00 79 FC 00 02 05 2B 06 00 46 06 00 7A FC 00 02 05 2B 06 00 49 06 00 7B FC 00 02 05 2B' + '06 00 4A 06 00 7C FC 00 02 05 41 06 00 49 06 00 7D FC 00 02 05 41 06 00 4A 06 00 7E FC 00 02 05' + '42 06 00 49 06 00 7F FC 00 02 05 42 06 00 4A 06 00 80 FC 00 02 05 43 06 00 27 06 00 81 FC 00 02' + '05 43 06 00 44 06 00 82 FC 00 02 05 43 06 00 45 06 00 83 FC 00 02 05 43 06 00 49 06 00 84 FC 00' + '02 05 43 06 00 4A 06 00 85 FC 00 02 05 44 06 00 45 06 00 86 FC 00 02 05 44 06 00 49 06 00 87 FC' + '00 02 05 44 06 00 4A 06 00 88 FC 00 02 05 45 06 00 27 06 00 89 FC 00 02 05 45 06 00 45 06 00 8A' + 'FC 00 02 05 46 06 00 31 06 00 8B FC 00 02 05 46 06 00 32 06 00 8C FC 00 02 05 46 06 00 45 06 00' + '8D FC 00 02 05 46 06 00 46 06 00 8E FC 00 02 05 46 06 00 49 06 00 8F FC 00 02 05 46 06 00 4A 06' + '00 90 FC 00 02 05 49 06 00 70 06 00 91 FC 00 02 05 4A 06 00 31 06 00 92 FC 00 02 05 4A 06 00 32' + '06 00 93 FC 00 02 05 4A 06 00 45 06 00 94 FC 00 02 05 4A 06 00 46 06 00 95 FC 00 02 05 4A 06 00' + '49 06 00 96 FC 00 02 05 4A 06 00 4A 06 00 97 FC 00 03 03 4A 06 00 54 06 00 2C 06 00 98 FC 00 03' + '03 4A 06 00 54 06 00 2D 06 00 99 FC 00 03 03 4A 06 00 54 06 00 2E 06 00 9A FC 00 03 03 4A 06 00' + '54 06 00 45 06 00 9B FC 00 03 03 4A 06 00 54 06 00 47 06 00 9C FC 00 02 03 28 06 00 2C 06 00 9D' + 'FC 00 02 03 28 06 00 2D 06 00 9E FC 00 02 03 28 06 00 2E 06 00 9F FC 00 02 03 28 06 00 45 06 00' + 'A0 FC 00 02 03 28 06 00 47 06 00 A1 FC 00 02 03 2A 06 00 2C 06 00 A2 FC 00 02 03 2A 06 00 2D 06' + '00 A3 FC 00 02 03 2A 06 00 2E 06 00 A4 FC 00 02 03 2A 06 00 45 06 00 A5 FC 00 02 03 2A 06 00 47' + '06 00 A6 FC 00 02 03 2B 06 00 45 06 00 A7 FC 00 02 03 2C 06 00 2D 06 00 A8 FC 00 02 03 2C 06 00' + '45 06 00 A9 FC 00 02 03 2D 06 00 2C 06 00 AA FC 00 02 03 2D 06 00 45 06 00 AB FC 00 02 03 2E 06' + '00 2C 06 00 AC FC 00 02 03 2E 06 00 45 06 00 AD FC 00 02 03 33 06 00 2C 06 00 AE FC 00 02 03 33' + '06 00 2D 06 00 AF FC 00 02 03 33 06 00 2E 06 00 B0 FC 00 02 03 33 06 00 45 06 00 B1 FC 00 02 03' + '35 06 00 2D 06 00 B2 FC 00 02 03 35 06 00 2E 06 00 B3 FC 00 02 03 35 06 00 45 06 00 B4 FC 00 02' + '03 36 06 00 2C 06 00 B5 FC 00 02 03 36 06 00 2D 06 00 B6 FC 00 02 03 36 06 00 2E 06 00 B7 FC 00' + '02 03 36 06 00 45 06 00 B8 FC 00 02 03 37 06 00 2D 06 00 B9 FC 00 02 03 38 06 00 45 06 00 BA FC' + '00 02 03 39 06 00 2C 06 00 BB FC 00 02 03 39 06 00 45 06 00 BC FC 00 02 03 3A 06 00 2C 06 00 BD' + 'FC 00 02 03 3A 06 00 45 06 00 BE FC 00 02 03 41 06 00 2C 06 00 BF FC 00 02 03 41 06 00 2D 06 00' + 'C0 FC 00 02 03 41 06 00 2E 06 00 C1 FC 00 02 03 41 06 00 45 06 00 C2 FC 00 02 03 42 06 00 2D 06' + '00 C3 FC 00 02 03 42 06 00 45 06 00 C4 FC 00 02 03 43 06 00 2C 06 00 C5 FC 00 02 03 43 06 00 2D' + '06 00 C6 FC 00 02 03 43 06 00 2E 06 00 C7 FC 00 02 03 43 06 00 44 06 00 C8 FC 00 02 03 43 06 00' + '45 06 00 C9 FC 00 02 03 44 06 00 2C 06 00 CA FC 00 02 03 44 06 00 2D 06 00 CB FC 00 02 03 44 06' + '00 2E 06 00 CC FC 00 02 03 44 06 00 45 06 00 CD FC 00 02 03 44 06 00 47 06 00 CE FC 00 02 03 45' + '06 00 2C 06 00 CF FC 00 02 03 45 06 00 2D 06 00 D0 FC 00 02 03 45 06 00 2E 06 00 D1 FC 00 02 03' + '45 06 00 45 06 00 D2 FC 00 02 03 46 06 00 2C 06 00 D3 FC 00 02 03 46 06 00 2D 06 00 D4 FC 00 02' + '03 46 06 00 2E 06 00 D5 FC 00 02 03 46 06 00 45 06 00 D6 FC 00 02 03 46 06 00 47 06 00 D7 FC 00' + '02 03 47 06 00 2C 06 00 D8 FC 00 02 03 47 06 00 45 06 00 D9 FC 00 02 03 47 06 00 70 06 00 DA FC' + '00 02 03 4A 06 00 2C 06 00 DB FC 00 02 03 4A 06 00 2D 06 00 DC FC 00 02 03 4A 06 00 2E 06 00 DD' + 'FC 00 02 03 4A 06 00 45 06 00 DE FC 00 02 03 4A 06 00 47 06 00 DF FC 00 03 04 4A 06 00 54 06 00' + '45 06 00 E0 FC 00 03 04 4A 06 00 54 06 00 47 06 00 E1 FC 00 02 04 28 06 00 45 06 00 E2 FC 00 02' + '04 28 06 00 47 06 00 E3 FC 00 02 04 2A 06 00 45 06 00 E4 FC 00 02 04 2A 06 00 47 06 00 E5 FC 00' + '02 04 2B 06 00 45 06 00 E6 FC 00 02 04 2B 06 00 47 06 00 E7 FC 00 02 04 33 06 00 45 06 00 E8 FC' + '00 02 04 33 06 00 47 06 00 E9 FC 00 02 04 34 06 00 45 06 00 EA FC 00 02 04 34 06 00 47 06 00 EB' + 'FC 00 02 04 43 06 00 44 06 00 EC FC 00 02 04 43 06 00 45 06 00 ED FC 00 02 04 44 06 00 45 06 00' + 'EE FC 00 02 04 46 06 00 45 06 00 EF FC 00 02 04 46 06 00 47 06 00 F0 FC 00 02 04 4A 06 00 45 06' + '00 F1 FC 00 02 04 4A 06 00 47 06 00 F2 FC 00 03 04 40 06 00 4E 06 00 51 06 00 F3 FC 00 03 04 40' + '06 00 4F 06 00 51 06 00 F4 FC 00 03 04 40 06 00 50 06 00 51 06 00 F5 FC 00 02 06 37 06 00 49 06' + '00 F6 FC 00 02 06 37 06 00 4A 06 00 F7 FC 00 02 06 39 06 00 49 06 00 F8 FC 00 02 06 39 06 00 4A' + '06 00 F9 FC 00 02 06 3A 06 00 49 06 00 FA FC 00 02 06 3A 06 00 4A 06 00 FB FC 00 02 06 33 06 00' + '49 06 00 FC FC 00 02 06 33 06 00 4A 06 00 FD FC 00 02 06 34 06 00 49 06 00 FE FC 00 02 06 34 06' + '00 4A 06 00 FF FC 00 02 06 2D 06 00 49 06 00 00 FD 00 02 06 2D 06 00 4A 06 00 01 FD 00 02 06 2C' + '06 00 49 06 00 02 FD 00 02 06 2C 06 00 4A 06 00 03 FD 00 02 06 2E 06 00 49 06 00 04 FD 00 02 06' + '2E 06 00 4A 06 00 05 FD 00 02 06 35 06 00 49 06 00 06 FD 00 02 06 35 06 00 4A 06 00 07 FD 00 02' + '06 36 06 00 49 06 00 08 FD 00 02 06 36 06 00 4A 06 00 09 FD 00 02 06 34 06 00 2C 06 00 0A FD 00' + '02 06 34 06 00 2D 06 00 0B FD 00 02 06 34 06 00 2E 06 00 0C FD 00 02 06 34 06 00 45 06 00 0D FD' + '00 02 06 34 06 00 31 06 00 0E FD 00 02 06 33 06 00 31 06 00 0F FD 00 02 06 35 06 00 31 06 00 10' + 'FD 00 02 06 36 06 00 31 06 00 11 FD 00 02 05 37 06 00 49 06 00 12 FD 00 02 05 37 06 00 4A 06 00' + '13 FD 00 02 05 39 06 00 49 06 00 14 FD 00 02 05 39 06 00 4A 06 00 15 FD 00 02 05 3A 06 00 49 06' + '00 16 FD 00 02 05 3A 06 00 4A 06 00 17 FD 00 02 05 33 06 00 49 06 00 18 FD 00 02 05 33 06 00 4A' + '06 00 19 FD 00 02 05 34 06 00 49 06 00 1A FD 00 02 05 34 06 00 4A 06 00 1B FD 00 02 05 2D 06 00' + '49 06 00 1C FD 00 02 05 2D 06 00 4A 06 00 1D FD 00 02 05 2C 06 00 49 06 00 1E FD 00 02 05 2C 06' + '00 4A 06 00 1F FD 00 02 05 2E 06 00 49 06 00 20 FD 00 02 05 2E 06 00 4A 06 00 21 FD 00 02 05 35' + '06 00 49 06 00 22 FD 00 02 05 35 06 00 4A 06 00 23 FD 00 02 05 36 06 00 49 06 00 24 FD 00 02 05' + '36 06 00 4A 06 00 25 FD 00 02 05 34 06 00 2C 06 00 26 FD 00 02 05 34 06 00 2D 06 00 27 FD 00 02' + '05 34 06 00 2E 06 00 28 FD 00 02 05 34 06 00 45 06 00 29 FD 00 02 05 34 06 00 31 06 00 2A FD 00' + '02 05 33 06 00 31 06 00 2B FD 00 02 05 35 06 00 31 06 00 2C FD 00 02 05 36 06 00 31 06 00 2D FD' + '00 02 03 34 06 00 2C 06 00 2E FD 00 02 03 34 06 00 2D 06 00 2F FD 00 02 03 34 06 00 2E 06 00 30' + 'FD 00 02 03 34 06 00 45 06 00 31 FD 00 02 03 33 06 00 47 06 00 32 FD 00 02 03 34 06 00 47 06 00' + '33 FD 00 02 03 37 06 00 45 06 00 34 FD 00 02 04 33 06 00 2C 06 00 35 FD 00 02 04 33 06 00 2D 06' + '00 36 FD 00 02 04 33 06 00 2E 06 00 37 FD 00 02 04 34 06 00 2C 06 00 38 FD 00 02 04 34 06 00 2D' + '06 00 39 FD 00 02 04 34 06 00 2E 06 00 3A FD 00 02 04 37 06 00 45 06 00 3B FD 00 02 04 38 06 00' + '45 06 00 3C FD 00 02 05 27 06 00 4B 06 00 3D FD 00 02 06 27 06 00 4B 06 00 50 FD 00 03 03 2A 06' + '00 2C 06 00 45 06 00 51 FD 00 03 05 2A 06 00 2D 06 00 2C 06 00 52 FD 00 03 03 2A 06 00 2D 06 00' + '2C 06 00 53 FD 00 03 03 2A 06 00 2D 06 00 45 06 00 54 FD 00 03 03 2A 06 00 2E 06 00 45 06 00 55' + 'FD 00 03 03 2A 06 00 45 06 00 2C 06 00 56 FD 00 03 03 2A 06 00 45 06 00 2D 06 00 57 FD 00 03 03' + '2A 06 00 45 06 00 2E 06 00 58 FD 00 03 05 2C 06 00 45 06 00 2D 06 00 59 FD 00 03 03 2C 06 00 45' + '06 00 2D 06 00 5A FD 00 03 05 2D 06 00 45 06 00 4A 06 00 5B FD 00 03 05 2D 06 00 45 06 00 49 06' + '00 5C FD 00 03 03 33 06 00 2D 06 00 2C 06 00 5D FD 00 03 03 33 06 00 2C 06 00 2D 06 00 5E FD 00' + '03 05 33 06 00 2C 06 00 49 06 00 5F FD 00 03 05 33 06 00 45 06 00 2D 06 00 60 FD 00 03 03 33 06' + '00 45 06 00 2D 06 00 61 FD 00 03 03 33 06 00 45 06 00 2C 06 00 62 FD 00 03 05 33 06 00 45 06 00' + '45 06 00 63 FD 00 03 03 33 06 00 45 06 00 45 06 00 64 FD 00 03 05 35 06 00 2D 06 00 2D 06 00 65' + 'FD 00 03 03 35 06 00 2D 06 00 2D 06 00 66 FD 00 03 05 35 06 00 45 06 00 45 06 00 67 FD 00 03 05' + '34 06 00 2D 06 00 45 06 00 68 FD 00 03 03 34 06 00 2D 06 00 45 06 00 69 FD 00 03 05 34 06 00 2C' + '06 00 4A 06 00 6A FD 00 03 05 34 06 00 45 06 00 2E 06 00 6B FD 00 03 03 34 06 00 45 06 00 2E 06' + '00 6C FD 00 03 05 34 06 00 45 06 00 45 06 00 6D FD 00 03 03 34 06 00 45 06 00 45 06 00 6E FD 00' + '03 05 36 06 00 2D 06 00 49 06 00 6F FD 00 03 05 36 06 00 2E 06 00 45 06 00 70 FD 00 03 03 36 06' + '00 2E 06 00 45 06 00 71 FD 00 03 05 37 06 00 45 06 00 2D 06 00 72 FD 00 03 03 37 06 00 45 06 00' + '2D 06 00 73 FD 00 03 03 37 06 00 45 06 00 45 06 00 74 FD 00 03 05 37 06 00 45 06 00 4A 06 00 75' + 'FD 00 03 05 39 06 00 2C 06 00 45 06 00 76 FD 00 03 05 39 06 00 45 06 00 45 06 00 77 FD 00 03 03' + '39 06 00 45 06 00 45 06 00 78 FD 00 03 05 39 06 00 45 06 00 49 06 00 79 FD 00 03 05 3A 06 00 45' + '06 00 45 06 00 7A FD 00 03 05 3A 06 00 45 06 00 4A 06 00 7B FD 00 03 05 3A 06 00 45 06 00 49 06' + '00 7C FD 00 03 05 41 06 00 2E 06 00 45 06 00 7D FD 00 03 03 41 06 00 2E 06 00 45 06 00 7E FD 00' + '03 05 42 06 00 45 06 00 2D 06 00 7F FD 00 03 05 42 06 00 45 06 00 45 06 00 80 FD 00 03 05 44 06' + '00 2D 06 00 45 06 00 81 FD 00 03 05 44 06 00 2D 06 00 4A 06 00 82 FD 00 03 05 44 06 00 2D 06 00' + '49 06 00 83 FD 00 03 03 44 06 00 2C 06 00 2C 06 00 84 FD 00 03 05 44 06 00 2C 06 00 2C 06 00 85' + 'FD 00 03 05 44 06 00 2E 06 00 45 06 00 86 FD 00 03 03 44 06 00 2E 06 00 45 06 00 87 FD 00 03 05' + '44 06 00 45 06 00 2D 06 00 88 FD 00 03 03 44 06 00 45 06 00 2D 06 00 89 FD 00 03 03 45 06 00 2D' + '06 00 2C 06 00 8A FD 00 03 03 45 06 00 2D 06 00 45 06 00 8B FD 00 03 05 45 06 00 2D 06 00 4A 06' + '00 8C FD 00 03 03 45 06 00 2C 06 00 2D 06 00 8D FD 00 03 03 45 06 00 2C 06 00 45 06 00 8E FD 00' + '03 03 45 06 00 2E 06 00 2C 06 00 8F FD 00 03 03 45 06 00 2E 06 00 45 06 00 92 FD 00 03 03 45 06' + '00 2C 06 00 2E 06 00 93 FD 00 03 03 47 06 00 45 06 00 2C 06 00 94 FD 00 03 03 47 06 00 45 06 00' + '45 06 00 95 FD 00 03 03 46 06 00 2D 06 00 45 06 00 96 FD 00 03 05 46 06 00 2D 06 00 49 06 00 97' + 'FD 00 03 05 46 06 00 2C 06 00 45 06 00 98 FD 00 03 03 46 06 00 2C 06 00 45 06 00 99 FD 00 03 05' + '46 06 00 2C 06 00 49 06 00 9A FD 00 03 05 46 06 00 45 06 00 4A 06 00 9B FD 00 03 05 46 06 00 45' + '06 00 49 06 00 9C FD 00 03 05 4A 06 00 45 06 00 45 06 00 9D FD 00 03 03 4A 06 00 45 06 00 45 06' + '00 9E FD 00 03 05 28 06 00 2E 06 00 4A 06 00 9F FD 00 03 05 2A 06 00 2C 06 00 4A 06 00 A0 FD 00' + '03 05 2A 06 00 2C 06 00 49 06 00 A1 FD 00 03 05 2A 06 00 2E 06 00 4A 06 00 A2 FD 00 03 05 2A 06' + '00 2E 06 00 49 06 00 A3 FD 00 03 05 2A 06 00 45 06 00 4A 06 00 A4 FD 00 03 05 2A 06 00 45 06 00' + '49 06 00 A5 FD 00 03 05 2C 06 00 45 06 00 4A 06 00 A6 FD 00 03 05 2C 06 00 2D 06 00 49 06 00 A7' + 'FD 00 03 05 2C 06 00 45 06 00 49 06 00 A8 FD 00 03 05 33 06 00 2E 06 00 49 06 00 A9 FD 00 03 05' + '35 06 00 2D 06 00 4A 06 00 AA FD 00 03 05 34 06 00 2D 06 00 4A 06 00 AB FD 00 03 05 36 06 00 2D' + '06 00 4A 06 00 AC FD 00 03 05 44 06 00 2C 06 00 4A 06 00 AD FD 00 03 05 44 06 00 45 06 00 4A 06' + '00 AE FD 00 03 05 4A 06 00 2D 06 00 4A 06 00 AF FD 00 03 05 4A 06 00 2C 06 00 4A 06 00 B0 FD 00' + '03 05 4A 06 00 45 06 00 4A 06 00 B1 FD 00 03 05 45 06 00 45 06 00 4A 06 00 B2 FD 00 03 05 42 06' + '00 45 06 00 4A 06 00 B3 FD 00 03 05 46 06 00 2D 06 00 4A 06 00 B4 FD 00 03 03 42 06 00 45 06 00' + '2D 06 00 B5 FD 00 03 03 44 06 00 2D 06 00 45 06 00 B6 FD 00 03 05 39 06 00 45 06 00 4A 06 00 B7' + 'FD 00 03 05 43 06 00 45 06 00 4A 06 00 B8 FD 00 03 03 46 06 00 2C 06 00 2D 06 00 B9 FD 00 03 05' + '45 06 00 2E 06 00 4A 06 00 BA FD 00 03 03 44 06 00 2C 06 00 45 06 00 BB FD 00 03 05 43 06 00 45' + '06 00 45 06 00 BC FD 00 03 05 44 06 00 2C 06 00 45 06 00 BD FD 00 03 05 46 06 00 2C 06 00 2D 06' + '00 BE FD 00 03 05 2C 06 00 2D 06 00 4A 06 00 BF FD 00 03 05 2D 06 00 2C 06 00 4A 06 00 C0 FD 00' + '03 05 45 06 00 2C 06 00 4A 06 00 C1 FD 00 03 05 41 06 00 45 06 00 4A 06 00 C2 FD 00 03 05 28 06' + '00 2D 06 00 4A 06 00 C3 FD 00 03 03 43 06 00 45 06 00 45 06 00 C4 FD 00 03 03 39 06 00 2C 06 00' + '45 06 00 C5 FD 00 03 03 35 06 00 45 06 00 45 06 00 C6 FD 00 03 05 33 06 00 2E 06 00 4A 06 00 C7' + 'FD 00 03 05 46 06 00 2C 06 00 4A 06 00 F0 FD 00 03 06 35 06 00 44 06 00 D2 06 00 F1 FD 00 03 06' + '42 06 00 44 06 00 D2 06 00 F2 FD 00 04 06 27 06 00 44 06 00 44 06 00 47 06 00 F3 FD 00 04 06 27' + '06 00 43 06 00 28 06 00 31 06 00 F4 FD 00 04 06 45 06 00 2D 06 00 45 06 00 2F 06 00 F5 FD 00 04' + '06 35 06 00 44 06 00 39 06 00 45 06 00 F6 FD 00 04 06 31 06 00 33 06 00 48 06 00 44 06 00 F7 FD' + '00 04 06 39 06 00 44 06 00 4A 06 00 47 06 00 F8 FD 00 04 06 48 06 00 33 06 00 44 06 00 45 06 00' + 'F9 FD 00 03 06 35 06 00 44 06 00 49 06 00 FA FD 00 12 06 35 06 00 44 06 00 49 06 00 20 00 00 27' + '06 00 44 06 00 44 06 00 47 06 00 20 00 00 39 06 00 44 06 00 4A 06 00 47 06 00 20 00 00 48 06 00' + '33 06 00 44 06 00 45 06 00 FB FD 00 08 06 2C 06 00 44 06 00 20 00 00 2C 06 00 44 06 00 27 06 00' + '44 06 00 47 06 00 FC FD 00 04 06 31 06 00 CC 06 00 27 06 00 44 06 00 10 FE 00 01 0A 2C 00 00 11' + 'FE 00 01 0A 01 30 00 12 FE 00 01 0A 02 30 00 13 FE 00 01 0A 3A 00 00 14 FE 00 01 0A 3B 00 00 15' + 'FE 00 01 0A 21 00 00 16 FE 00 01 0A 3F 00 00 17 FE 00 01 0A 16 30 00 18 FE 00 01 0A 17 30 00 19' + 'FE 00 03 0A 2E 00 00 2E 00 00 2E 00 00 30 FE 00 02 0A 2E 00 00 2E 00 00 31 FE 00 01 0A 14 20 00' + '32 FE 00 01 0A 13 20 00 33 FE 00 01 0A 5F 00 00 34 FE 00 01 0A 5F 00 00 35 FE 00 01 0A 28 00 00' + '36 FE 00 01 0A 29 00 00 37 FE 00 01 0A 7B 00 00 38 FE 00 01 0A 7D 00 00 39 FE 00 01 0A 14 30 00' + '3A FE 00 01 0A 15 30 00 3B FE 00 01 0A 10 30 00 3C FE 00 01 0A 11 30 00 3D FE 00 01 0A 0A 30 00' + '3E FE 00 01 0A 0B 30 00 3F FE 00 01 0A 08 30 00 40 FE 00 01 0A 09 30 00 41 FE 00 01 0A 0C 30 00' + '42 FE 00 01 0A 0D 30 00 43 FE 00 01 0A 0E 30 00 44 FE 00 01 0A 0F 30 00 47 FE 00 01 0A 5B 00 00' + '48 FE 00 01 0A 5D 00 00 49 FE 00 02 10 20 00 00 05 03 00 4A FE 00 02 10 20 00 00 05 03 00 4B FE' + '00 02 10 20 00 00 05 03 00 4C FE 00 02 10 20 00 00 05 03 00 4D FE 00 01 10 5F 00 00 4E FE 00 01' + '10 5F 00 00 4F FE 00 01 10 5F 00 00 50 FE 00 01 0D 2C 00 00 51 FE 00 01 0D 01 30 00 52 FE 00 01' + '0D 2E 00 00 54 FE 00 01 0D 3B 00 00 55 FE 00 01 0D 3A 00 00 56 FE 00 01 0D 3F 00 00 57 FE 00 01' + '0D 21 00 00 58 FE 00 01 0D 14 20 00 59 FE 00 01 0D 28 00 00 5A FE 00 01 0D 29 00 00 5B FE 00 01' + '0D 7B 00 00 5C FE 00 01 0D 7D 00 00 5D FE 00 01 0D 14 30 00 5E FE 00 01 0D 15 30 00 5F FE 00 01' + '0D 23 00 00 60 FE 00 01 0D 26 00 00 61 FE 00 01 0D 2A 00 00 62 FE 00 01 0D 2B 00 00 63 FE 00 01' + '0D 2D 00 00 64 FE 00 01 0D 3C 00 00 65 FE 00 01 0D 3E 00 00 66 FE 00 01 0D 3D 00 00 68 FE 00 01' + '0D 5C 00 00 69 FE 00 01 0D 24 00 00 6A FE 00 01 0D 25 00 00 6B FE 00 01 0D 40 00 00 70 FE 00 02' + '06 20 00 00 4B 06 00 71 FE 00 02 04 40 06 00 4B 06 00 72 FE 00 02 06 20 00 00 4C 06 00 74 FE 00' + '02 06 20 00 00 4D 06 00 76 FE 00 02 06 20 00 00 4E 06 00 77 FE 00 02 04 40 06 00 4E 06 00 78 FE' + '00 02 06 20 00 00 4F 06 00 79 FE 00 02 04 40 06 00 4F 06 00 7A FE 00 02 06 20 00 00 50 06 00 7B' + 'FE 00 02 04 40 06 00 50 06 00 7C FE 00 02 06 20 00 00 51 06 00 7D FE 00 02 04 40 06 00 51 06 00' + '7E FE 00 02 06 20 00 00 52 06 00 7F FE 00 02 04 40 06 00 52 06 00 80 FE 00 01 06 21 06 00 81 FE' + '00 02 06 27 06 00 53 06 00 82 FE 00 02 05 27 06 00 53 06 00 83 FE 00 02 06 27 06 00 54 06 00 84' + 'FE 00 02 05 27 06 00 54 06 00 85 FE 00 02 06 48 06 00 54 06 00 86 FE 00 02 05 48 06 00 54 06 00' + '87 FE 00 02 06 27 06 00 55 06 00 88 FE 00 02 05 27 06 00 55 06 00 89 FE 00 02 06 4A 06 00 54 06' + '00 8A FE 00 02 05 4A 06 00 54 06 00 8B FE 00 02 03 4A 06 00 54 06 00 8C FE 00 02 04 4A 06 00 54' + '06 00 8D FE 00 01 06 27 06 00 8E FE 00 01 05 27 06 00 8F FE 00 01 06 28 06 00 90 FE 00 01 05 28' + '06 00 91 FE 00 01 03 28 06 00 92 FE 00 01 04 28 06 00 93 FE 00 01 06 29 06 00 94 FE 00 01 05 29' + '06 00 95 FE 00 01 06 2A 06 00 96 FE 00 01 05 2A 06 00 97 FE 00 01 03 2A 06 00 98 FE 00 01 04 2A' + '06 00 99 FE 00 01 06 2B 06 00 9A FE 00 01 05 2B 06 00 9B FE 00 01 03 2B 06 00 9C FE 00 01 04 2B' + '06 00 9D FE 00 01 06 2C 06 00 9E FE 00 01 05 2C 06 00 9F FE 00 01 03 2C 06 00 A0 FE 00 01 04 2C' + '06 00 A1 FE 00 01 06 2D 06 00 A2 FE 00 01 05 2D 06 00 A3 FE 00 01 03 2D 06 00 A4 FE 00 01 04 2D' + '06 00 A5 FE 00 01 06 2E 06 00 A6 FE 00 01 05 2E 06 00 A7 FE 00 01 03 2E 06 00 A8 FE 00 01 04 2E' + '06 00 A9 FE 00 01 06 2F 06 00 AA FE 00 01 05 2F 06 00 AB FE 00 01 06 30 06 00 AC FE 00 01 05 30' + '06 00 AD FE 00 01 06 31 06 00 AE FE 00 01 05 31 06 00 AF FE 00 01 06 32 06 00 B0 FE 00 01 05 32' + '06 00 B1 FE 00 01 06 33 06 00 B2 FE 00 01 05 33 06 00 B3 FE 00 01 03 33 06 00 B4 FE 00 01 04 33' + '06 00 B5 FE 00 01 06 34 06 00 B6 FE 00 01 05 34 06 00 B7 FE 00 01 03 34 06 00 B8 FE 00 01 04 34' + '06 00 B9 FE 00 01 06 35 06 00 BA FE 00 01 05 35 06 00 BB FE 00 01 03 35 06 00 BC FE 00 01 04 35' + '06 00 BD FE 00 01 06 36 06 00 BE FE 00 01 05 36 06 00 BF FE 00 01 03 36 06 00 C0 FE 00 01 04 36' + '06 00 C1 FE 00 01 06 37 06 00 C2 FE 00 01 05 37 06 00 C3 FE 00 01 03 37 06 00 C4 FE 00 01 04 37' + '06 00 C5 FE 00 01 06 38 06 00 C6 FE 00 01 05 38 06 00 C7 FE 00 01 03 38 06 00 C8 FE 00 01 04 38' + '06 00 C9 FE 00 01 06 39 06 00 CA FE 00 01 05 39 06 00 CB FE 00 01 03 39 06 00 CC FE 00 01 04 39' + '06 00 CD FE 00 01 06 3A 06 00 CE FE 00 01 05 3A 06 00 CF FE 00 01 03 3A 06 00 D0 FE 00 01 04 3A' + '06 00 D1 FE 00 01 06 41 06 00 D2 FE 00 01 05 41 06 00 D3 FE 00 01 03 41 06 00 D4 FE 00 01 04 41' + '06 00 D5 FE 00 01 06 42 06 00 D6 FE 00 01 05 42 06 00 D7 FE 00 01 03 42 06 00 D8 FE 00 01 04 42' + '06 00 D9 FE 00 01 06 43 06 00 DA FE 00 01 05 43 06 00 DB FE 00 01 03 43 06 00 DC FE 00 01 04 43' + '06 00 DD FE 00 01 06 44 06 00 DE FE 00 01 05 44 06 00 DF FE 00 01 03 44 06 00 E0 FE 00 01 04 44' + '06 00 E1 FE 00 01 06 45 06 00 E2 FE 00 01 05 45 06 00 E3 FE 00 01 03 45 06 00 E4 FE 00 01 04 45' + '06 00 E5 FE 00 01 06 46 06 00 E6 FE 00 01 05 46 06 00 E7 FE 00 01 03 46 06 00 E8 FE 00 01 04 46' + '06 00 E9 FE 00 01 06 47 06 00 EA FE 00 01 05 47 06 00 EB FE 00 01 03 47 06 00 EC FE 00 01 04 47' + '06 00 ED FE 00 01 06 48 06 00 EE FE 00 01 05 48 06 00 EF FE 00 01 06 49 06 00 F0 FE 00 01 05 49' + '06 00 F1 FE 00 01 06 4A 06 00 F2 FE 00 01 05 4A 06 00 F3 FE 00 01 03 4A 06 00 F4 FE 00 01 04 4A' + '06 00 F5 FE 00 03 06 44 06 00 27 06 00 53 06 00 F6 FE 00 03 05 44 06 00 27 06 00 53 06 00 F7 FE' + '00 03 06 44 06 00 27 06 00 54 06 00 F8 FE 00 03 05 44 06 00 27 06 00 54 06 00 F9 FE 00 03 06 44' + '06 00 27 06 00 55 06 00 FA FE 00 03 05 44 06 00 27 06 00 55 06 00 FB FE 00 02 06 44 06 00 27 06' + '00 FC FE 00 02 05 44 06 00 27 06 00 01 FF 00 01 0B 21 00 00 02 FF 00 01 0B 22 00 00 03 FF 00 01' + '0B 23 00 00 04 FF 00 01 0B 24 00 00 05 FF 00 01 0B 25 00 00 06 FF 00 01 0B 26 00 00 07 FF 00 01' + '0B 27 00 00 08 FF 00 01 0B 28 00 00 09 FF 00 01 0B 29 00 00 0A FF 00 01 0B 2A 00 00 0B FF 00 01' + '0B 2B 00 00 0C FF 00 01 0B 2C 00 00 0D FF 00 01 0B 2D 00 00 0E FF 00 01 0B 2E 00 00 0F FF 00 01' + '0B 2F 00 00 10 FF 00 01 0B 30 00 00 11 FF 00 01 0B 31 00 00 12 FF 00 01 0B 32 00 00 13 FF 00 01' + '0B 33 00 00 14 FF 00 01 0B 34 00 00 15 FF 00 01 0B 35 00 00 16 FF 00 01 0B 36 00 00 17 FF 00 01' + '0B 37 00 00 18 FF 00 01 0B 38 00 00 19 FF 00 01 0B 39 00 00 1A FF 00 01 0B 3A 00 00 1B FF 00 01' + '0B 3B 00 00 1C FF 00 01 0B 3C 00 00 1D FF 00 01 0B 3D 00 00 1E FF 00 01 0B 3E 00 00 1F FF 00 01' + '0B 3F 00 00 20 FF 00 01 0B 40 00 00 21 FF 00 01 0B 41 00 00 22 FF 00 01 0B 42 00 00 23 FF 00 01' + '0B 43 00 00 24 FF 00 01 0B 44 00 00 25 FF 00 01 0B 45 00 00 26 FF 00 01 0B 46 00 00 27 FF 00 01' + '0B 47 00 00 28 FF 00 01 0B 48 00 00 29 FF 00 01 0B 49 00 00 2A FF 00 01 0B 4A 00 00 2B FF 00 01' + '0B 4B 00 00 2C FF 00 01 0B 4C 00 00 2D FF 00 01 0B 4D 00 00 2E FF 00 01 0B 4E 00 00 2F FF 00 01' + '0B 4F 00 00 30 FF 00 01 0B 50 00 00 31 FF 00 01 0B 51 00 00 32 FF 00 01 0B 52 00 00 33 FF 00 01' + '0B 53 00 00 34 FF 00 01 0B 54 00 00 35 FF 00 01 0B 55 00 00 36 FF 00 01 0B 56 00 00 37 FF 00 01' + '0B 57 00 00 38 FF 00 01 0B 58 00 00 39 FF 00 01 0B 59 00 00 3A FF 00 01 0B 5A 00 00 3B FF 00 01' + '0B 5B 00 00 3C FF 00 01 0B 5C 00 00 3D FF 00 01 0B 5D 00 00 3E FF 00 01 0B 5E 00 00 3F FF 00 01' + '0B 5F 00 00 40 FF 00 01 0B 60 00 00 41 FF 00 01 0B 61 00 00 42 FF 00 01 0B 62 00 00 43 FF 00 01' + '0B 63 00 00 44 FF 00 01 0B 64 00 00 45 FF 00 01 0B 65 00 00 46 FF 00 01 0B 66 00 00 47 FF 00 01' + '0B 67 00 00 48 FF 00 01 0B 68 00 00 49 FF 00 01 0B 69 00 00 4A FF 00 01 0B 6A 00 00 4B FF 00 01' + '0B 6B 00 00 4C FF 00 01 0B 6C 00 00 4D FF 00 01 0B 6D 00 00 4E FF 00 01 0B 6E 00 00 4F FF 00 01' + '0B 6F 00 00 50 FF 00 01 0B 70 00 00 51 FF 00 01 0B 71 00 00 52 FF 00 01 0B 72 00 00 53 FF 00 01' + '0B 73 00 00 54 FF 00 01 0B 74 00 00 55 FF 00 01 0B 75 00 00 56 FF 00 01 0B 76 00 00 57 FF 00 01' + '0B 77 00 00 58 FF 00 01 0B 78 00 00 59 FF 00 01 0B 79 00 00 5A FF 00 01 0B 7A 00 00 5B FF 00 01' + '0B 7B 00 00 5C FF 00 01 0B 7C 00 00 5D FF 00 01 0B 7D 00 00 5E FF 00 01 0B 7E 00 00 5F FF 00 01' + '0B 85 29 00 60 FF 00 01 0B 86 29 00 61 FF 00 01 0C 02 30 00 62 FF 00 01 0C 0C 30 00 63 FF 00 01' + '0C 0D 30 00 64 FF 00 01 0C 01 30 00 65 FF 00 01 0C FB 30 00 66 FF 00 01 0C F2 30 00 67 FF 00 01' + '0C A1 30 00 68 FF 00 01 0C A3 30 00 69 FF 00 01 0C A5 30 00 6A FF 00 01 0C A7 30 00 6B FF 00 01' + '0C A9 30 00 6C FF 00 01 0C E3 30 00 6D FF 00 01 0C E5 30 00 6E FF 00 01 0C E7 30 00 6F FF 00 01' + '0C C3 30 00 70 FF 00 01 0C FC 30 00 71 FF 00 01 0C A2 30 00 72 FF 00 01 0C A4 30 00 73 FF 00 01' + '0C A6 30 00 74 FF 00 01 0C A8 30 00 75 FF 00 01 0C AA 30 00 76 FF 00 01 0C AB 30 00 77 FF 00 01' + '0C AD 30 00 78 FF 00 01 0C AF 30 00 79 FF 00 01 0C B1 30 00 7A FF 00 01 0C B3 30 00 7B FF 00 01' + '0C B5 30 00 7C FF 00 01 0C B7 30 00 7D FF 00 01 0C B9 30 00 7E FF 00 01 0C BB 30 00 7F FF 00 01' + '0C BD 30 00 80 FF 00 01 0C BF 30 00 81 FF 00 01 0C C1 30 00 82 FF 00 01 0C C4 30 00 83 FF 00 01' + '0C C6 30 00 84 FF 00 01 0C C8 30 00 85 FF 00 01 0C CA 30 00 86 FF 00 01 0C CB 30 00 87 FF 00 01' + '0C CC 30 00 88 FF 00 01 0C CD 30 00 89 FF 00 01 0C CE 30 00 8A FF 00 01 0C CF 30 00 8B FF 00 01' + '0C D2 30 00 8C FF 00 01 0C D5 30 00 8D FF 00 01 0C D8 30 00 8E FF 00 01 0C DB 30 00 8F FF 00 01' + '0C DE 30 00 90 FF 00 01 0C DF 30 00 91 FF 00 01 0C E0 30 00 92 FF 00 01 0C E1 30 00 93 FF 00 01' + '0C E2 30 00 94 FF 00 01 0C E4 30 00 95 FF 00 01 0C E6 30 00 96 FF 00 01 0C E8 30 00 97 FF 00 01' + '0C E9 30 00 98 FF 00 01 0C EA 30 00 99 FF 00 01 0C EB 30 00 9A FF 00 01 0C EC 30 00 9B FF 00 01' + '0C ED 30 00 9C FF 00 01 0C EF 30 00 9D FF 00 01 0C F3 30 00 9E FF 00 01 0C 99 30 00 9F FF 00 01' + '0C 9A 30 00 A0 FF 00 01 0C 60 11 00 A1 FF 00 01 0C 00 11 00 A2 FF 00 01 0C 01 11 00 A3 FF 00 01' + '0C AA 11 00 A4 FF 00 01 0C 02 11 00 A5 FF 00 01 0C AC 11 00 A6 FF 00 01 0C AD 11 00 A7 FF 00 01' + '0C 03 11 00 A8 FF 00 01 0C 04 11 00 A9 FF 00 01 0C 05 11 00 AA FF 00 01 0C B0 11 00 AB FF 00 01' + '0C B1 11 00 AC FF 00 01 0C B2 11 00 AD FF 00 01 0C B3 11 00 AE FF 00 01 0C B4 11 00 AF FF 00 01' + '0C B5 11 00 B0 FF 00 01 0C 1A 11 00 B1 FF 00 01 0C 06 11 00 B2 FF 00 01 0C 07 11 00 B3 FF 00 01' + '0C 08 11 00 B4 FF 00 01 0C 21 11 00 B5 FF 00 01 0C 09 11 00 B6 FF 00 01 0C 0A 11 00 B7 FF 00 01' + '0C 0B 11 00 B8 FF 00 01 0C 0C 11 00 B9 FF 00 01 0C 0D 11 00 BA FF 00 01 0C 0E 11 00 BB FF 00 01' + '0C 0F 11 00 BC FF 00 01 0C 10 11 00 BD FF 00 01 0C 11 11 00 BE FF 00 01 0C 12 11 00 C2 FF 00 01' + '0C 61 11 00 C3 FF 00 01 0C 62 11 00 C4 FF 00 01 0C 63 11 00 C5 FF 00 01 0C 64 11 00 C6 FF 00 01' + '0C 65 11 00 C7 FF 00 01 0C 66 11 00 CA FF 00 01 0C 67 11 00 CB FF 00 01 0C 68 11 00 CC FF 00 01' + '0C 69 11 00 CD FF 00 01 0C 6A 11 00 CE FF 00 01 0C 6B 11 00 CF FF 00 01 0C 6C 11 00 D2 FF 00 01' + '0C 6D 11 00 D3 FF 00 01 0C 6E 11 00 D4 FF 00 01 0C 6F 11 00 D5 FF 00 01 0C 70 11 00 D6 FF 00 01' + '0C 71 11 00 D7 FF 00 01 0C 72 11 00 DA FF 00 01 0C 73 11 00 DB FF 00 01 0C 74 11 00 DC FF 00 01' + '0C 75 11 00 E0 FF 00 01 0B A2 00 00 E1 FF 00 01 0B A3 00 00 E2 FF 00 01 0B AC 00 00 E3 FF 00 02' + '0B 20 00 00 04 03 00 E4 FF 00 01 0B A6 00 00 E5 FF 00 01 0B A5 00 00 E6 FF 00 01 0B A9 20 00 E8' + 'FF 00 01 0C 02 25 00 E9 FF 00 01 0C 90 21 00 EA FF 00 01 0C 91 21 00 EB FF 00 01 0C 92 21 00 EC' + 'FF 00 01 0C 93 21 00 ED FF 00 01 0C A0 25 00 EE FF 00 01 0C CB 25 00 9A 10 01 02 00 99 10 01 BA' + '10 01 9C 10 01 02 00 9B 10 01 BA 10 01 AB 10 01 02 00 A5 10 01 BA 10 01 2E 11 01 02 00 31 11 01' + '27 11 01 2F 11 01 02 00 32 11 01 27 11 01 4B 13 01 02 00 47 13 01 3E 13 01 4C 13 01 02 00 47 13' + '01 57 13 01 BB 14 01 02 00 B9 14 01 BA 14 01 BC 14 01 02 00 B9 14 01 B0 14 01 BE 14 01 02 00 B9' + '14 01 BD 14 01 BA 15 01 02 00 B8 15 01 AF 15 01 BB 15 01 02 00 B9 15 01 AF 15 01 38 19 01 02 00' + '35 19 01 30 19 01 5E D1 01 02 00 57 D1 01 65 D1 01 5F D1 01 02 00 58 D1 01 65 D1 01 60 D1 01 03' + '00 58 D1 01 65 D1 01 6E D1 01 61 D1 01 03 00 58 D1 01 65 D1 01 6F D1 01 62 D1 01 03 00 58 D1 01' + '65 D1 01 70 D1 01 63 D1 01 03 00 58 D1 01 65 D1 01 71 D1 01 64 D1 01 03 00 58 D1 01 65 D1 01 72' + 'D1 01 BB D1 01 02 00 B9 D1 01 65 D1 01 BC D1 01 02 00 BA D1 01 65 D1 01 BD D1 01 03 00 B9 D1 01' + '65 D1 01 6E D1 01 BE D1 01 03 00 BA D1 01 65 D1 01 6E D1 01 BF D1 01 03 00 B9 D1 01 65 D1 01 6F' + 'D1 01 C0 D1 01 03 00 BA D1 01 65 D1 01 6F D1 01 00 D4 01 01 01 41 00 00 01 D4 01 01 01 42 00 00' + '02 D4 01 01 01 43 00 00 03 D4 01 01 01 44 00 00 04 D4 01 01 01 45 00 00 05 D4 01 01 01 46 00 00' + '06 D4 01 01 01 47 00 00 07 D4 01 01 01 48 00 00 08 D4 01 01 01 49 00 00 09 D4 01 01 01 4A 00 00' + '0A D4 01 01 01 4B 00 00 0B D4 01 01 01 4C 00 00 0C D4 01 01 01 4D 00 00 0D D4 01 01 01 4E 00 00' + '0E D4 01 01 01 4F 00 00 0F D4 01 01 01 50 00 00 10 D4 01 01 01 51 00 00 11 D4 01 01 01 52 00 00' + '12 D4 01 01 01 53 00 00 13 D4 01 01 01 54 00 00 14 D4 01 01 01 55 00 00 15 D4 01 01 01 56 00 00' + '16 D4 01 01 01 57 00 00 17 D4 01 01 01 58 00 00 18 D4 01 01 01 59 00 00 19 D4 01 01 01 5A 00 00' + '1A D4 01 01 01 61 00 00 1B D4 01 01 01 62 00 00 1C D4 01 01 01 63 00 00 1D D4 01 01 01 64 00 00' + '1E D4 01 01 01 65 00 00 1F D4 01 01 01 66 00 00 20 D4 01 01 01 67 00 00 21 D4 01 01 01 68 00 00' + '22 D4 01 01 01 69 00 00 23 D4 01 01 01 6A 00 00 24 D4 01 01 01 6B 00 00 25 D4 01 01 01 6C 00 00' + '26 D4 01 01 01 6D 00 00 27 D4 01 01 01 6E 00 00 28 D4 01 01 01 6F 00 00 29 D4 01 01 01 70 00 00' + '2A D4 01 01 01 71 00 00 2B D4 01 01 01 72 00 00 2C D4 01 01 01 73 00 00 2D D4 01 01 01 74 00 00' + '2E D4 01 01 01 75 00 00 2F D4 01 01 01 76 00 00 30 D4 01 01 01 77 00 00 31 D4 01 01 01 78 00 00' + '32 D4 01 01 01 79 00 00 33 D4 01 01 01 7A 00 00 34 D4 01 01 01 41 00 00 35 D4 01 01 01 42 00 00' + '36 D4 01 01 01 43 00 00 37 D4 01 01 01 44 00 00 38 D4 01 01 01 45 00 00 39 D4 01 01 01 46 00 00' + '3A D4 01 01 01 47 00 00 3B D4 01 01 01 48 00 00 3C D4 01 01 01 49 00 00 3D D4 01 01 01 4A 00 00' + '3E D4 01 01 01 4B 00 00 3F D4 01 01 01 4C 00 00 40 D4 01 01 01 4D 00 00 41 D4 01 01 01 4E 00 00' + '42 D4 01 01 01 4F 00 00 43 D4 01 01 01 50 00 00 44 D4 01 01 01 51 00 00 45 D4 01 01 01 52 00 00' + '46 D4 01 01 01 53 00 00 47 D4 01 01 01 54 00 00 48 D4 01 01 01 55 00 00 49 D4 01 01 01 56 00 00' + '4A D4 01 01 01 57 00 00 4B D4 01 01 01 58 00 00 4C D4 01 01 01 59 00 00 4D D4 01 01 01 5A 00 00' + '4E D4 01 01 01 61 00 00 4F D4 01 01 01 62 00 00 50 D4 01 01 01 63 00 00 51 D4 01 01 01 64 00 00' + '52 D4 01 01 01 65 00 00 53 D4 01 01 01 66 00 00 54 D4 01 01 01 67 00 00 56 D4 01 01 01 69 00 00' + '57 D4 01 01 01 6A 00 00 58 D4 01 01 01 6B 00 00 59 D4 01 01 01 6C 00 00 5A D4 01 01 01 6D 00 00' + '5B D4 01 01 01 6E 00 00 5C D4 01 01 01 6F 00 00 5D D4 01 01 01 70 00 00 5E D4 01 01 01 71 00 00' + '5F D4 01 01 01 72 00 00 60 D4 01 01 01 73 00 00 61 D4 01 01 01 74 00 00 62 D4 01 01 01 75 00 00' + '63 D4 01 01 01 76 00 00 64 D4 01 01 01 77 00 00 65 D4 01 01 01 78 00 00 66 D4 01 01 01 79 00 00' + '67 D4 01 01 01 7A 00 00 68 D4 01 01 01 41 00 00 69 D4 01 01 01 42 00 00 6A D4 01 01 01 43 00 00' + '6B D4 01 01 01 44 00 00 6C D4 01 01 01 45 00 00 6D D4 01 01 01 46 00 00 6E D4 01 01 01 47 00 00' + '6F D4 01 01 01 48 00 00 70 D4 01 01 01 49 00 00 71 D4 01 01 01 4A 00 00 72 D4 01 01 01 4B 00 00' + '73 D4 01 01 01 4C 00 00 74 D4 01 01 01 4D 00 00 75 D4 01 01 01 4E 00 00 76 D4 01 01 01 4F 00 00' + '77 D4 01 01 01 50 00 00 78 D4 01 01 01 51 00 00 79 D4 01 01 01 52 00 00 7A D4 01 01 01 53 00 00' + '7B D4 01 01 01 54 00 00 7C D4 01 01 01 55 00 00 7D D4 01 01 01 56 00 00 7E D4 01 01 01 57 00 00' + '7F D4 01 01 01 58 00 00 80 D4 01 01 01 59 00 00 81 D4 01 01 01 5A 00 00 82 D4 01 01 01 61 00 00' + '83 D4 01 01 01 62 00 00 84 D4 01 01 01 63 00 00 85 D4 01 01 01 64 00 00 86 D4 01 01 01 65 00 00' + '87 D4 01 01 01 66 00 00 88 D4 01 01 01 67 00 00 89 D4 01 01 01 68 00 00 8A D4 01 01 01 69 00 00' + '8B D4 01 01 01 6A 00 00 8C D4 01 01 01 6B 00 00 8D D4 01 01 01 6C 00 00 8E D4 01 01 01 6D 00 00' + '8F D4 01 01 01 6E 00 00 90 D4 01 01 01 6F 00 00 91 D4 01 01 01 70 00 00 92 D4 01 01 01 71 00 00' + '93 D4 01 01 01 72 00 00 94 D4 01 01 01 73 00 00 95 D4 01 01 01 74 00 00 96 D4 01 01 01 75 00 00' + '97 D4 01 01 01 76 00 00 98 D4 01 01 01 77 00 00 99 D4 01 01 01 78 00 00 9A D4 01 01 01 79 00 00' + '9B D4 01 01 01 7A 00 00 9C D4 01 01 01 41 00 00 9E D4 01 01 01 43 00 00 9F D4 01 01 01 44 00 00' + 'A2 D4 01 01 01 47 00 00 A5 D4 01 01 01 4A 00 00 A6 D4 01 01 01 4B 00 00 A9 D4 01 01 01 4E 00 00' + 'AA D4 01 01 01 4F 00 00 AB D4 01 01 01 50 00 00 AC D4 01 01 01 51 00 00 AE D4 01 01 01 53 00 00' + 'AF D4 01 01 01 54 00 00 B0 D4 01 01 01 55 00 00 B1 D4 01 01 01 56 00 00 B2 D4 01 01 01 57 00 00' + 'B3 D4 01 01 01 58 00 00 B4 D4 01 01 01 59 00 00 B5 D4 01 01 01 5A 00 00 B6 D4 01 01 01 61 00 00' + 'B7 D4 01 01 01 62 00 00 B8 D4 01 01 01 63 00 00 B9 D4 01 01 01 64 00 00 BB D4 01 01 01 66 00 00' + 'BD D4 01 01 01 68 00 00 BE D4 01 01 01 69 00 00 BF D4 01 01 01 6A 00 00 C0 D4 01 01 01 6B 00 00' + 'C1 D4 01 01 01 6C 00 00 C2 D4 01 01 01 6D 00 00 C3 D4 01 01 01 6E 00 00 C5 D4 01 01 01 70 00 00' + 'C6 D4 01 01 01 71 00 00 C7 D4 01 01 01 72 00 00 C8 D4 01 01 01 73 00 00 C9 D4 01 01 01 74 00 00' + 'CA D4 01 01 01 75 00 00 CB D4 01 01 01 76 00 00 CC D4 01 01 01 77 00 00 CD D4 01 01 01 78 00 00' + 'CE D4 01 01 01 79 00 00 CF D4 01 01 01 7A 00 00 D0 D4 01 01 01 41 00 00 D1 D4 01 01 01 42 00 00' + 'D2 D4 01 01 01 43 00 00 D3 D4 01 01 01 44 00 00 D4 D4 01 01 01 45 00 00 D5 D4 01 01 01 46 00 00' + 'D6 D4 01 01 01 47 00 00 D7 D4 01 01 01 48 00 00 D8 D4 01 01 01 49 00 00 D9 D4 01 01 01 4A 00 00' + 'DA D4 01 01 01 4B 00 00 DB D4 01 01 01 4C 00 00 DC D4 01 01 01 4D 00 00 DD D4 01 01 01 4E 00 00' + 'DE D4 01 01 01 4F 00 00 DF D4 01 01 01 50 00 00 E0 D4 01 01 01 51 00 00 E1 D4 01 01 01 52 00 00' + 'E2 D4 01 01 01 53 00 00 E3 D4 01 01 01 54 00 00 E4 D4 01 01 01 55 00 00 E5 D4 01 01 01 56 00 00' + 'E6 D4 01 01 01 57 00 00 E7 D4 01 01 01 58 00 00 E8 D4 01 01 01 59 00 00 E9 D4 01 01 01 5A 00 00' + 'EA D4 01 01 01 61 00 00 EB D4 01 01 01 62 00 00 EC D4 01 01 01 63 00 00 ED D4 01 01 01 64 00 00' + 'EE D4 01 01 01 65 00 00 EF D4 01 01 01 66 00 00 F0 D4 01 01 01 67 00 00 F1 D4 01 01 01 68 00 00' + 'F2 D4 01 01 01 69 00 00 F3 D4 01 01 01 6A 00 00 F4 D4 01 01 01 6B 00 00 F5 D4 01 01 01 6C 00 00' + 'F6 D4 01 01 01 6D 00 00 F7 D4 01 01 01 6E 00 00 F8 D4 01 01 01 6F 00 00 F9 D4 01 01 01 70 00 00' + 'FA D4 01 01 01 71 00 00 FB D4 01 01 01 72 00 00 FC D4 01 01 01 73 00 00 FD D4 01 01 01 74 00 00' + 'FE D4 01 01 01 75 00 00 FF D4 01 01 01 76 00 00 00 D5 01 01 01 77 00 00 01 D5 01 01 01 78 00 00' + '02 D5 01 01 01 79 00 00 03 D5 01 01 01 7A 00 00 04 D5 01 01 01 41 00 00 05 D5 01 01 01 42 00 00' + '07 D5 01 01 01 44 00 00 08 D5 01 01 01 45 00 00 09 D5 01 01 01 46 00 00 0A D5 01 01 01 47 00 00' + '0D D5 01 01 01 4A 00 00 0E D5 01 01 01 4B 00 00 0F D5 01 01 01 4C 00 00 10 D5 01 01 01 4D 00 00' + '11 D5 01 01 01 4E 00 00 12 D5 01 01 01 4F 00 00 13 D5 01 01 01 50 00 00 14 D5 01 01 01 51 00 00' + '16 D5 01 01 01 53 00 00 17 D5 01 01 01 54 00 00 18 D5 01 01 01 55 00 00 19 D5 01 01 01 56 00 00' + '1A D5 01 01 01 57 00 00 1B D5 01 01 01 58 00 00 1C D5 01 01 01 59 00 00 1E D5 01 01 01 61 00 00' + '1F D5 01 01 01 62 00 00 20 D5 01 01 01 63 00 00 21 D5 01 01 01 64 00 00 22 D5 01 01 01 65 00 00' + '23 D5 01 01 01 66 00 00 24 D5 01 01 01 67 00 00 25 D5 01 01 01 68 00 00 26 D5 01 01 01 69 00 00' + '27 D5 01 01 01 6A 00 00 28 D5 01 01 01 6B 00 00 29 D5 01 01 01 6C 00 00 2A D5 01 01 01 6D 00 00' + '2B D5 01 01 01 6E 00 00 2C D5 01 01 01 6F 00 00 2D D5 01 01 01 70 00 00 2E D5 01 01 01 71 00 00' + '2F D5 01 01 01 72 00 00 30 D5 01 01 01 73 00 00 31 D5 01 01 01 74 00 00 32 D5 01 01 01 75 00 00' + '33 D5 01 01 01 76 00 00 34 D5 01 01 01 77 00 00 35 D5 01 01 01 78 00 00 36 D5 01 01 01 79 00 00' + '37 D5 01 01 01 7A 00 00 38 D5 01 01 01 41 00 00 39 D5 01 01 01 42 00 00 3B D5 01 01 01 44 00 00' + '3C D5 01 01 01 45 00 00 3D D5 01 01 01 46 00 00 3E D5 01 01 01 47 00 00 40 D5 01 01 01 49 00 00' + '41 D5 01 01 01 4A 00 00 42 D5 01 01 01 4B 00 00 43 D5 01 01 01 4C 00 00 44 D5 01 01 01 4D 00 00' + '46 D5 01 01 01 4F 00 00 4A D5 01 01 01 53 00 00 4B D5 01 01 01 54 00 00 4C D5 01 01 01 55 00 00' + '4D D5 01 01 01 56 00 00 4E D5 01 01 01 57 00 00 4F D5 01 01 01 58 00 00 50 D5 01 01 01 59 00 00' + '52 D5 01 01 01 61 00 00 53 D5 01 01 01 62 00 00 54 D5 01 01 01 63 00 00 55 D5 01 01 01 64 00 00' + '56 D5 01 01 01 65 00 00 57 D5 01 01 01 66 00 00 58 D5 01 01 01 67 00 00 59 D5 01 01 01 68 00 00' + '5A D5 01 01 01 69 00 00 5B D5 01 01 01 6A 00 00 5C D5 01 01 01 6B 00 00 5D D5 01 01 01 6C 00 00' + '5E D5 01 01 01 6D 00 00 5F D5 01 01 01 6E 00 00 60 D5 01 01 01 6F 00 00 61 D5 01 01 01 70 00 00' + '62 D5 01 01 01 71 00 00 63 D5 01 01 01 72 00 00 64 D5 01 01 01 73 00 00 65 D5 01 01 01 74 00 00' + '66 D5 01 01 01 75 00 00 67 D5 01 01 01 76 00 00 68 D5 01 01 01 77 00 00 69 D5 01 01 01 78 00 00' + '6A D5 01 01 01 79 00 00 6B D5 01 01 01 7A 00 00 6C D5 01 01 01 41 00 00 6D D5 01 01 01 42 00 00' + '6E D5 01 01 01 43 00 00 6F D5 01 01 01 44 00 00 70 D5 01 01 01 45 00 00 71 D5 01 01 01 46 00 00' + '72 D5 01 01 01 47 00 00 73 D5 01 01 01 48 00 00 74 D5 01 01 01 49 00 00 75 D5 01 01 01 4A 00 00' + '76 D5 01 01 01 4B 00 00 77 D5 01 01 01 4C 00 00 78 D5 01 01 01 4D 00 00 79 D5 01 01 01 4E 00 00' + '7A D5 01 01 01 4F 00 00 7B D5 01 01 01 50 00 00 7C D5 01 01 01 51 00 00 7D D5 01 01 01 52 00 00' + '7E D5 01 01 01 53 00 00 7F D5 01 01 01 54 00 00 80 D5 01 01 01 55 00 00 81 D5 01 01 01 56 00 00' + '82 D5 01 01 01 57 00 00 83 D5 01 01 01 58 00 00 84 D5 01 01 01 59 00 00 85 D5 01 01 01 5A 00 00' + '86 D5 01 01 01 61 00 00 87 D5 01 01 01 62 00 00 88 D5 01 01 01 63 00 00 89 D5 01 01 01 64 00 00' + '8A D5 01 01 01 65 00 00 8B D5 01 01 01 66 00 00 8C D5 01 01 01 67 00 00 8D D5 01 01 01 68 00 00' + '8E D5 01 01 01 69 00 00 8F D5 01 01 01 6A 00 00 90 D5 01 01 01 6B 00 00 91 D5 01 01 01 6C 00 00' + '92 D5 01 01 01 6D 00 00 93 D5 01 01 01 6E 00 00 94 D5 01 01 01 6F 00 00 95 D5 01 01 01 70 00 00' + '96 D5 01 01 01 71 00 00 97 D5 01 01 01 72 00 00 98 D5 01 01 01 73 00 00 99 D5 01 01 01 74 00 00' + '9A D5 01 01 01 75 00 00 9B D5 01 01 01 76 00 00 9C D5 01 01 01 77 00 00 9D D5 01 01 01 78 00 00' + '9E D5 01 01 01 79 00 00 9F D5 01 01 01 7A 00 00 A0 D5 01 01 01 41 00 00 A1 D5 01 01 01 42 00 00' + 'A2 D5 01 01 01 43 00 00 A3 D5 01 01 01 44 00 00 A4 D5 01 01 01 45 00 00 A5 D5 01 01 01 46 00 00' + 'A6 D5 01 01 01 47 00 00 A7 D5 01 01 01 48 00 00 A8 D5 01 01 01 49 00 00 A9 D5 01 01 01 4A 00 00' + 'AA D5 01 01 01 4B 00 00 AB D5 01 01 01 4C 00 00 AC D5 01 01 01 4D 00 00 AD D5 01 01 01 4E 00 00' + 'AE D5 01 01 01 4F 00 00 AF D5 01 01 01 50 00 00 B0 D5 01 01 01 51 00 00 B1 D5 01 01 01 52 00 00' + 'B2 D5 01 01 01 53 00 00 B3 D5 01 01 01 54 00 00 B4 D5 01 01 01 55 00 00 B5 D5 01 01 01 56 00 00' + 'B6 D5 01 01 01 57 00 00 B7 D5 01 01 01 58 00 00 B8 D5 01 01 01 59 00 00 B9 D5 01 01 01 5A 00 00' + 'BA D5 01 01 01 61 00 00 BB D5 01 01 01 62 00 00 BC D5 01 01 01 63 00 00 BD D5 01 01 01 64 00 00' + 'BE D5 01 01 01 65 00 00 BF D5 01 01 01 66 00 00 C0 D5 01 01 01 67 00 00 C1 D5 01 01 01 68 00 00' + 'C2 D5 01 01 01 69 00 00 C3 D5 01 01 01 6A 00 00 C4 D5 01 01 01 6B 00 00 C5 D5 01 01 01 6C 00 00' + 'C6 D5 01 01 01 6D 00 00 C7 D5 01 01 01 6E 00 00 C8 D5 01 01 01 6F 00 00 C9 D5 01 01 01 70 00 00' + 'CA D5 01 01 01 71 00 00 CB D5 01 01 01 72 00 00 CC D5 01 01 01 73 00 00 CD D5 01 01 01 74 00 00' + 'CE D5 01 01 01 75 00 00 CF D5 01 01 01 76 00 00 D0 D5 01 01 01 77 00 00 D1 D5 01 01 01 78 00 00' + 'D2 D5 01 01 01 79 00 00 D3 D5 01 01 01 7A 00 00 D4 D5 01 01 01 41 00 00 D5 D5 01 01 01 42 00 00' + 'D6 D5 01 01 01 43 00 00 D7 D5 01 01 01 44 00 00 D8 D5 01 01 01 45 00 00 D9 D5 01 01 01 46 00 00' + 'DA D5 01 01 01 47 00 00 DB D5 01 01 01 48 00 00 DC D5 01 01 01 49 00 00 DD D5 01 01 01 4A 00 00' + 'DE D5 01 01 01 4B 00 00 DF D5 01 01 01 4C 00 00 E0 D5 01 01 01 4D 00 00 E1 D5 01 01 01 4E 00 00' + 'E2 D5 01 01 01 4F 00 00 E3 D5 01 01 01 50 00 00 E4 D5 01 01 01 51 00 00 E5 D5 01 01 01 52 00 00' + 'E6 D5 01 01 01 53 00 00 E7 D5 01 01 01 54 00 00 E8 D5 01 01 01 55 00 00 E9 D5 01 01 01 56 00 00' + 'EA D5 01 01 01 57 00 00 EB D5 01 01 01 58 00 00 EC D5 01 01 01 59 00 00 ED D5 01 01 01 5A 00 00' + 'EE D5 01 01 01 61 00 00 EF D5 01 01 01 62 00 00 F0 D5 01 01 01 63 00 00 F1 D5 01 01 01 64 00 00' + 'F2 D5 01 01 01 65 00 00 F3 D5 01 01 01 66 00 00 F4 D5 01 01 01 67 00 00 F5 D5 01 01 01 68 00 00' + 'F6 D5 01 01 01 69 00 00 F7 D5 01 01 01 6A 00 00 F8 D5 01 01 01 6B 00 00 F9 D5 01 01 01 6C 00 00' + 'FA D5 01 01 01 6D 00 00 FB D5 01 01 01 6E 00 00 FC D5 01 01 01 6F 00 00 FD D5 01 01 01 70 00 00' + 'FE D5 01 01 01 71 00 00 FF D5 01 01 01 72 00 00 00 D6 01 01 01 73 00 00 01 D6 01 01 01 74 00 00' + '02 D6 01 01 01 75 00 00 03 D6 01 01 01 76 00 00 04 D6 01 01 01 77 00 00 05 D6 01 01 01 78 00 00' + '06 D6 01 01 01 79 00 00 07 D6 01 01 01 7A 00 00 08 D6 01 01 01 41 00 00 09 D6 01 01 01 42 00 00' + '0A D6 01 01 01 43 00 00 0B D6 01 01 01 44 00 00 0C D6 01 01 01 45 00 00 0D D6 01 01 01 46 00 00' + '0E D6 01 01 01 47 00 00 0F D6 01 01 01 48 00 00 10 D6 01 01 01 49 00 00 11 D6 01 01 01 4A 00 00' + '12 D6 01 01 01 4B 00 00 13 D6 01 01 01 4C 00 00 14 D6 01 01 01 4D 00 00 15 D6 01 01 01 4E 00 00' + '16 D6 01 01 01 4F 00 00 17 D6 01 01 01 50 00 00 18 D6 01 01 01 51 00 00 19 D6 01 01 01 52 00 00' + '1A D6 01 01 01 53 00 00 1B D6 01 01 01 54 00 00 1C D6 01 01 01 55 00 00 1D D6 01 01 01 56 00 00' + '1E D6 01 01 01 57 00 00 1F D6 01 01 01 58 00 00 20 D6 01 01 01 59 00 00 21 D6 01 01 01 5A 00 00' + '22 D6 01 01 01 61 00 00 23 D6 01 01 01 62 00 00 24 D6 01 01 01 63 00 00 25 D6 01 01 01 64 00 00' + '26 D6 01 01 01 65 00 00 27 D6 01 01 01 66 00 00 28 D6 01 01 01 67 00 00 29 D6 01 01 01 68 00 00' + '2A D6 01 01 01 69 00 00 2B D6 01 01 01 6A 00 00 2C D6 01 01 01 6B 00 00 2D D6 01 01 01 6C 00 00' + '2E D6 01 01 01 6D 00 00 2F D6 01 01 01 6E 00 00 30 D6 01 01 01 6F 00 00 31 D6 01 01 01 70 00 00' + '32 D6 01 01 01 71 00 00 33 D6 01 01 01 72 00 00 34 D6 01 01 01 73 00 00 35 D6 01 01 01 74 00 00' + '36 D6 01 01 01 75 00 00 37 D6 01 01 01 76 00 00 38 D6 01 01 01 77 00 00 39 D6 01 01 01 78 00 00' + '3A D6 01 01 01 79 00 00 3B D6 01 01 01 7A 00 00 3C D6 01 01 01 41 00 00 3D D6 01 01 01 42 00 00' + '3E D6 01 01 01 43 00 00 3F D6 01 01 01 44 00 00 40 D6 01 01 01 45 00 00 41 D6 01 01 01 46 00 00' + '42 D6 01 01 01 47 00 00 43 D6 01 01 01 48 00 00 44 D6 01 01 01 49 00 00 45 D6 01 01 01 4A 00 00' + '46 D6 01 01 01 4B 00 00 47 D6 01 01 01 4C 00 00 48 D6 01 01 01 4D 00 00 49 D6 01 01 01 4E 00 00' + '4A D6 01 01 01 4F 00 00 4B D6 01 01 01 50 00 00 4C D6 01 01 01 51 00 00 4D D6 01 01 01 52 00 00' + '4E D6 01 01 01 53 00 00 4F D6 01 01 01 54 00 00 50 D6 01 01 01 55 00 00 51 D6 01 01 01 56 00 00' + '52 D6 01 01 01 57 00 00 53 D6 01 01 01 58 00 00 54 D6 01 01 01 59 00 00 55 D6 01 01 01 5A 00 00' + '56 D6 01 01 01 61 00 00 57 D6 01 01 01 62 00 00 58 D6 01 01 01 63 00 00 59 D6 01 01 01 64 00 00' + '5A D6 01 01 01 65 00 00 5B D6 01 01 01 66 00 00 5C D6 01 01 01 67 00 00 5D D6 01 01 01 68 00 00' + '5E D6 01 01 01 69 00 00 5F D6 01 01 01 6A 00 00 60 D6 01 01 01 6B 00 00 61 D6 01 01 01 6C 00 00' + '62 D6 01 01 01 6D 00 00 63 D6 01 01 01 6E 00 00 64 D6 01 01 01 6F 00 00 65 D6 01 01 01 70 00 00' + '66 D6 01 01 01 71 00 00 67 D6 01 01 01 72 00 00 68 D6 01 01 01 73 00 00 69 D6 01 01 01 74 00 00' + '6A D6 01 01 01 75 00 00 6B D6 01 01 01 76 00 00 6C D6 01 01 01 77 00 00 6D D6 01 01 01 78 00 00' + '6E D6 01 01 01 79 00 00 6F D6 01 01 01 7A 00 00 70 D6 01 01 01 41 00 00 71 D6 01 01 01 42 00 00' + '72 D6 01 01 01 43 00 00 73 D6 01 01 01 44 00 00 74 D6 01 01 01 45 00 00 75 D6 01 01 01 46 00 00' + '76 D6 01 01 01 47 00 00 77 D6 01 01 01 48 00 00 78 D6 01 01 01 49 00 00 79 D6 01 01 01 4A 00 00' + '7A D6 01 01 01 4B 00 00 7B D6 01 01 01 4C 00 00 7C D6 01 01 01 4D 00 00 7D D6 01 01 01 4E 00 00' + '7E D6 01 01 01 4F 00 00 7F D6 01 01 01 50 00 00 80 D6 01 01 01 51 00 00 81 D6 01 01 01 52 00 00' + '82 D6 01 01 01 53 00 00 83 D6 01 01 01 54 00 00 84 D6 01 01 01 55 00 00 85 D6 01 01 01 56 00 00' + '86 D6 01 01 01 57 00 00 87 D6 01 01 01 58 00 00 88 D6 01 01 01 59 00 00 89 D6 01 01 01 5A 00 00' + '8A D6 01 01 01 61 00 00 8B D6 01 01 01 62 00 00 8C D6 01 01 01 63 00 00 8D D6 01 01 01 64 00 00' + '8E D6 01 01 01 65 00 00 8F D6 01 01 01 66 00 00 90 D6 01 01 01 67 00 00 91 D6 01 01 01 68 00 00' + '92 D6 01 01 01 69 00 00 93 D6 01 01 01 6A 00 00 94 D6 01 01 01 6B 00 00 95 D6 01 01 01 6C 00 00' + '96 D6 01 01 01 6D 00 00 97 D6 01 01 01 6E 00 00 98 D6 01 01 01 6F 00 00 99 D6 01 01 01 70 00 00' + '9A D6 01 01 01 71 00 00 9B D6 01 01 01 72 00 00 9C D6 01 01 01 73 00 00 9D D6 01 01 01 74 00 00' + '9E D6 01 01 01 75 00 00 9F D6 01 01 01 76 00 00 A0 D6 01 01 01 77 00 00 A1 D6 01 01 01 78 00 00' + 'A2 D6 01 01 01 79 00 00 A3 D6 01 01 01 7A 00 00 A4 D6 01 01 01 31 01 00 A5 D6 01 01 01 37 02 00' + 'A8 D6 01 01 01 91 03 00 A9 D6 01 01 01 92 03 00 AA D6 01 01 01 93 03 00 AB D6 01 01 01 94 03 00' + 'AC D6 01 01 01 95 03 00 AD D6 01 01 01 96 03 00 AE D6 01 01 01 97 03 00 AF D6 01 01 01 98 03 00' + 'B0 D6 01 01 01 99 03 00 B1 D6 01 01 01 9A 03 00 B2 D6 01 01 01 9B 03 00 B3 D6 01 01 01 9C 03 00' + 'B4 D6 01 01 01 9D 03 00 B5 D6 01 01 01 9E 03 00 B6 D6 01 01 01 9F 03 00 B7 D6 01 01 01 A0 03 00' + 'B8 D6 01 01 01 A1 03 00 B9 D6 01 01 01 98 03 00 BA D6 01 01 01 A3 03 00 BB D6 01 01 01 A4 03 00' + 'BC D6 01 01 01 A5 03 00 BD D6 01 01 01 A6 03 00 BE D6 01 01 01 A7 03 00 BF D6 01 01 01 A8 03 00' + 'C0 D6 01 01 01 A9 03 00 C1 D6 01 01 01 07 22 00 C2 D6 01 01 01 B1 03 00 C3 D6 01 01 01 B2 03 00' + 'C4 D6 01 01 01 B3 03 00 C5 D6 01 01 01 B4 03 00 C6 D6 01 01 01 B5 03 00 C7 D6 01 01 01 B6 03 00' + 'C8 D6 01 01 01 B7 03 00 C9 D6 01 01 01 B8 03 00 CA D6 01 01 01 B9 03 00 CB D6 01 01 01 BA 03 00' + 'CC D6 01 01 01 BB 03 00 CD D6 01 01 01 BC 03 00 CE D6 01 01 01 BD 03 00 CF D6 01 01 01 BE 03 00' + 'D0 D6 01 01 01 BF 03 00 D1 D6 01 01 01 C0 03 00 D2 D6 01 01 01 C1 03 00 D3 D6 01 01 01 C2 03 00' + 'D4 D6 01 01 01 C3 03 00 D5 D6 01 01 01 C4 03 00 D6 D6 01 01 01 C5 03 00 D7 D6 01 01 01 C6 03 00' + 'D8 D6 01 01 01 C7 03 00 D9 D6 01 01 01 C8 03 00 DA D6 01 01 01 C9 03 00 DB D6 01 01 01 02 22 00' + 'DC D6 01 01 01 B5 03 00 DD D6 01 01 01 B8 03 00 DE D6 01 01 01 BA 03 00 DF D6 01 01 01 C6 03 00' + 'E0 D6 01 01 01 C1 03 00 E1 D6 01 01 01 C0 03 00 E2 D6 01 01 01 91 03 00 E3 D6 01 01 01 92 03 00' + 'E4 D6 01 01 01 93 03 00 E5 D6 01 01 01 94 03 00 E6 D6 01 01 01 95 03 00 E7 D6 01 01 01 96 03 00' + 'E8 D6 01 01 01 97 03 00 E9 D6 01 01 01 98 03 00 EA D6 01 01 01 99 03 00 EB D6 01 01 01 9A 03 00' + 'EC D6 01 01 01 9B 03 00 ED D6 01 01 01 9C 03 00 EE D6 01 01 01 9D 03 00 EF D6 01 01 01 9E 03 00' + 'F0 D6 01 01 01 9F 03 00 F1 D6 01 01 01 A0 03 00 F2 D6 01 01 01 A1 03 00 F3 D6 01 01 01 98 03 00' + 'F4 D6 01 01 01 A3 03 00 F5 D6 01 01 01 A4 03 00 F6 D6 01 01 01 A5 03 00 F7 D6 01 01 01 A6 03 00' + 'F8 D6 01 01 01 A7 03 00 F9 D6 01 01 01 A8 03 00 FA D6 01 01 01 A9 03 00 FB D6 01 01 01 07 22 00' + 'FC D6 01 01 01 B1 03 00 FD D6 01 01 01 B2 03 00 FE D6 01 01 01 B3 03 00 FF D6 01 01 01 B4 03 00' + '00 D7 01 01 01 B5 03 00 01 D7 01 01 01 B6 03 00 02 D7 01 01 01 B7 03 00 03 D7 01 01 01 B8 03 00' + '04 D7 01 01 01 B9 03 00 05 D7 01 01 01 BA 03 00 06 D7 01 01 01 BB 03 00 07 D7 01 01 01 BC 03 00' + '08 D7 01 01 01 BD 03 00 09 D7 01 01 01 BE 03 00 0A D7 01 01 01 BF 03 00 0B D7 01 01 01 C0 03 00' + '0C D7 01 01 01 C1 03 00 0D D7 01 01 01 C2 03 00 0E D7 01 01 01 C3 03 00 0F D7 01 01 01 C4 03 00' + '10 D7 01 01 01 C5 03 00 11 D7 01 01 01 C6 03 00 12 D7 01 01 01 C7 03 00 13 D7 01 01 01 C8 03 00' + '14 D7 01 01 01 C9 03 00 15 D7 01 01 01 02 22 00 16 D7 01 01 01 B5 03 00 17 D7 01 01 01 B8 03 00' + '18 D7 01 01 01 BA 03 00 19 D7 01 01 01 C6 03 00 1A D7 01 01 01 C1 03 00 1B D7 01 01 01 C0 03 00' + '1C D7 01 01 01 91 03 00 1D D7 01 01 01 92 03 00 1E D7 01 01 01 93 03 00 1F D7 01 01 01 94 03 00' + '20 D7 01 01 01 95 03 00 21 D7 01 01 01 96 03 00 22 D7 01 01 01 97 03 00 23 D7 01 01 01 98 03 00' + '24 D7 01 01 01 99 03 00 25 D7 01 01 01 9A 03 00 26 D7 01 01 01 9B 03 00 27 D7 01 01 01 9C 03 00' + '28 D7 01 01 01 9D 03 00 29 D7 01 01 01 9E 03 00 2A D7 01 01 01 9F 03 00 2B D7 01 01 01 A0 03 00' + '2C D7 01 01 01 A1 03 00 2D D7 01 01 01 98 03 00 2E D7 01 01 01 A3 03 00 2F D7 01 01 01 A4 03 00' + '30 D7 01 01 01 A5 03 00 31 D7 01 01 01 A6 03 00 32 D7 01 01 01 A7 03 00 33 D7 01 01 01 A8 03 00' + '34 D7 01 01 01 A9 03 00 35 D7 01 01 01 07 22 00 36 D7 01 01 01 B1 03 00 37 D7 01 01 01 B2 03 00' + '38 D7 01 01 01 B3 03 00 39 D7 01 01 01 B4 03 00 3A D7 01 01 01 B5 03 00 3B D7 01 01 01 B6 03 00' + '3C D7 01 01 01 B7 03 00 3D D7 01 01 01 B8 03 00 3E D7 01 01 01 B9 03 00 3F D7 01 01 01 BA 03 00' + '40 D7 01 01 01 BB 03 00 41 D7 01 01 01 BC 03 00 42 D7 01 01 01 BD 03 00 43 D7 01 01 01 BE 03 00' + '44 D7 01 01 01 BF 03 00 45 D7 01 01 01 C0 03 00 46 D7 01 01 01 C1 03 00 47 D7 01 01 01 C2 03 00' + '48 D7 01 01 01 C3 03 00 49 D7 01 01 01 C4 03 00 4A D7 01 01 01 C5 03 00 4B D7 01 01 01 C6 03 00' + '4C D7 01 01 01 C7 03 00 4D D7 01 01 01 C8 03 00 4E D7 01 01 01 C9 03 00 4F D7 01 01 01 02 22 00' + '50 D7 01 01 01 B5 03 00 51 D7 01 01 01 B8 03 00 52 D7 01 01 01 BA 03 00 53 D7 01 01 01 C6 03 00' + '54 D7 01 01 01 C1 03 00 55 D7 01 01 01 C0 03 00 56 D7 01 01 01 91 03 00 57 D7 01 01 01 92 03 00' + '58 D7 01 01 01 93 03 00 59 D7 01 01 01 94 03 00 5A D7 01 01 01 95 03 00 5B D7 01 01 01 96 03 00' + '5C D7 01 01 01 97 03 00 5D D7 01 01 01 98 03 00 5E D7 01 01 01 99 03 00 5F D7 01 01 01 9A 03 00' + '60 D7 01 01 01 9B 03 00 61 D7 01 01 01 9C 03 00 62 D7 01 01 01 9D 03 00 63 D7 01 01 01 9E 03 00' + '64 D7 01 01 01 9F 03 00 65 D7 01 01 01 A0 03 00 66 D7 01 01 01 A1 03 00 67 D7 01 01 01 98 03 00' + '68 D7 01 01 01 A3 03 00 69 D7 01 01 01 A4 03 00 6A D7 01 01 01 A5 03 00 6B D7 01 01 01 A6 03 00' + '6C D7 01 01 01 A7 03 00 6D D7 01 01 01 A8 03 00 6E D7 01 01 01 A9 03 00 6F D7 01 01 01 07 22 00' + '70 D7 01 01 01 B1 03 00 71 D7 01 01 01 B2 03 00 72 D7 01 01 01 B3 03 00 73 D7 01 01 01 B4 03 00' + '74 D7 01 01 01 B5 03 00 75 D7 01 01 01 B6 03 00 76 D7 01 01 01 B7 03 00 77 D7 01 01 01 B8 03 00' + '78 D7 01 01 01 B9 03 00 79 D7 01 01 01 BA 03 00 7A D7 01 01 01 BB 03 00 7B D7 01 01 01 BC 03 00' + '7C D7 01 01 01 BD 03 00 7D D7 01 01 01 BE 03 00 7E D7 01 01 01 BF 03 00 7F D7 01 01 01 C0 03 00' + '80 D7 01 01 01 C1 03 00 81 D7 01 01 01 C2 03 00 82 D7 01 01 01 C3 03 00 83 D7 01 01 01 C4 03 00' + '84 D7 01 01 01 C5 03 00 85 D7 01 01 01 C6 03 00 86 D7 01 01 01 C7 03 00 87 D7 01 01 01 C8 03 00' + '88 D7 01 01 01 C9 03 00 89 D7 01 01 01 02 22 00 8A D7 01 01 01 B5 03 00 8B D7 01 01 01 B8 03 00' + '8C D7 01 01 01 BA 03 00 8D D7 01 01 01 C6 03 00 8E D7 01 01 01 C1 03 00 8F D7 01 01 01 C0 03 00' + '90 D7 01 01 01 91 03 00 91 D7 01 01 01 92 03 00 92 D7 01 01 01 93 03 00 93 D7 01 01 01 94 03 00' + '94 D7 01 01 01 95 03 00 95 D7 01 01 01 96 03 00 96 D7 01 01 01 97 03 00 97 D7 01 01 01 98 03 00' + '98 D7 01 01 01 99 03 00 99 D7 01 01 01 9A 03 00 9A D7 01 01 01 9B 03 00 9B D7 01 01 01 9C 03 00' + '9C D7 01 01 01 9D 03 00 9D D7 01 01 01 9E 03 00 9E D7 01 01 01 9F 03 00 9F D7 01 01 01 A0 03 00' + 'A0 D7 01 01 01 A1 03 00 A1 D7 01 01 01 98 03 00 A2 D7 01 01 01 A3 03 00 A3 D7 01 01 01 A4 03 00' + 'A4 D7 01 01 01 A5 03 00 A5 D7 01 01 01 A6 03 00 A6 D7 01 01 01 A7 03 00 A7 D7 01 01 01 A8 03 00' + 'A8 D7 01 01 01 A9 03 00 A9 D7 01 01 01 07 22 00 AA D7 01 01 01 B1 03 00 AB D7 01 01 01 B2 03 00' + 'AC D7 01 01 01 B3 03 00 AD D7 01 01 01 B4 03 00 AE D7 01 01 01 B5 03 00 AF D7 01 01 01 B6 03 00' + 'B0 D7 01 01 01 B7 03 00 B1 D7 01 01 01 B8 03 00 B2 D7 01 01 01 B9 03 00 B3 D7 01 01 01 BA 03 00' + 'B4 D7 01 01 01 BB 03 00 B5 D7 01 01 01 BC 03 00 B6 D7 01 01 01 BD 03 00 B7 D7 01 01 01 BE 03 00' + 'B8 D7 01 01 01 BF 03 00 B9 D7 01 01 01 C0 03 00 BA D7 01 01 01 C1 03 00 BB D7 01 01 01 C2 03 00' + 'BC D7 01 01 01 C3 03 00 BD D7 01 01 01 C4 03 00 BE D7 01 01 01 C5 03 00 BF D7 01 01 01 C6 03 00' + 'C0 D7 01 01 01 C7 03 00 C1 D7 01 01 01 C8 03 00 C2 D7 01 01 01 C9 03 00 C3 D7 01 01 01 02 22 00' + 'C4 D7 01 01 01 B5 03 00 C5 D7 01 01 01 B8 03 00 C6 D7 01 01 01 BA 03 00 C7 D7 01 01 01 C6 03 00' + 'C8 D7 01 01 01 C1 03 00 C9 D7 01 01 01 C0 03 00 CA D7 01 01 01 DC 03 00 CB D7 01 01 01 DD 03 00' + 'CE D7 01 01 01 30 00 00 CF D7 01 01 01 31 00 00 D0 D7 01 01 01 32 00 00 D1 D7 01 01 01 33 00 00' + 'D2 D7 01 01 01 34 00 00 D3 D7 01 01 01 35 00 00 D4 D7 01 01 01 36 00 00 D5 D7 01 01 01 37 00 00' + 'D6 D7 01 01 01 38 00 00 D7 D7 01 01 01 39 00 00 D8 D7 01 01 01 30 00 00 D9 D7 01 01 01 31 00 00' + 'DA D7 01 01 01 32 00 00 DB D7 01 01 01 33 00 00 DC D7 01 01 01 34 00 00 DD D7 01 01 01 35 00 00' + 'DE D7 01 01 01 36 00 00 DF D7 01 01 01 37 00 00 E0 D7 01 01 01 38 00 00 E1 D7 01 01 01 39 00 00' + 'E2 D7 01 01 01 30 00 00 E3 D7 01 01 01 31 00 00 E4 D7 01 01 01 32 00 00 E5 D7 01 01 01 33 00 00' + 'E6 D7 01 01 01 34 00 00 E7 D7 01 01 01 35 00 00 E8 D7 01 01 01 36 00 00 E9 D7 01 01 01 37 00 00' + 'EA D7 01 01 01 38 00 00 EB D7 01 01 01 39 00 00 EC D7 01 01 01 30 00 00 ED D7 01 01 01 31 00 00' + 'EE D7 01 01 01 32 00 00 EF D7 01 01 01 33 00 00 F0 D7 01 01 01 34 00 00 F1 D7 01 01 01 35 00 00' + 'F2 D7 01 01 01 36 00 00 F3 D7 01 01 01 37 00 00 F4 D7 01 01 01 38 00 00 F5 D7 01 01 01 39 00 00' + 'F6 D7 01 01 01 30 00 00 F7 D7 01 01 01 31 00 00 F8 D7 01 01 01 32 00 00 F9 D7 01 01 01 33 00 00' + 'FA D7 01 01 01 34 00 00 FB D7 01 01 01 35 00 00 FC D7 01 01 01 36 00 00 FD D7 01 01 01 37 00 00' + 'FE D7 01 01 01 38 00 00 FF D7 01 01 01 39 00 00 00 EE 01 01 01 27 06 00 01 EE 01 01 01 28 06 00' + '02 EE 01 01 01 2C 06 00 03 EE 01 01 01 2F 06 00 05 EE 01 01 01 48 06 00 06 EE 01 01 01 32 06 00' + '07 EE 01 01 01 2D 06 00 08 EE 01 01 01 37 06 00 09 EE 01 01 01 4A 06 00 0A EE 01 01 01 43 06 00' + '0B EE 01 01 01 44 06 00 0C EE 01 01 01 45 06 00 0D EE 01 01 01 46 06 00 0E EE 01 01 01 33 06 00' + '0F EE 01 01 01 39 06 00 10 EE 01 01 01 41 06 00 11 EE 01 01 01 35 06 00 12 EE 01 01 01 42 06 00' + '13 EE 01 01 01 31 06 00 14 EE 01 01 01 34 06 00 15 EE 01 01 01 2A 06 00 16 EE 01 01 01 2B 06 00' + '17 EE 01 01 01 2E 06 00 18 EE 01 01 01 30 06 00 19 EE 01 01 01 36 06 00 1A EE 01 01 01 38 06 00' + '1B EE 01 01 01 3A 06 00 1C EE 01 01 01 6E 06 00 1D EE 01 01 01 BA 06 00 1E EE 01 01 01 A1 06 00' + '1F EE 01 01 01 6F 06 00 21 EE 01 01 01 28 06 00 22 EE 01 01 01 2C 06 00 24 EE 01 01 01 47 06 00' + '27 EE 01 01 01 2D 06 00 29 EE 01 01 01 4A 06 00 2A EE 01 01 01 43 06 00 2B EE 01 01 01 44 06 00' + '2C EE 01 01 01 45 06 00 2D EE 01 01 01 46 06 00 2E EE 01 01 01 33 06 00 2F EE 01 01 01 39 06 00' + '30 EE 01 01 01 41 06 00 31 EE 01 01 01 35 06 00 32 EE 01 01 01 42 06 00 34 EE 01 01 01 34 06 00' + '35 EE 01 01 01 2A 06 00 36 EE 01 01 01 2B 06 00 37 EE 01 01 01 2E 06 00 39 EE 01 01 01 36 06 00' + '3B EE 01 01 01 3A 06 00 42 EE 01 01 01 2C 06 00 47 EE 01 01 01 2D 06 00 49 EE 01 01 01 4A 06 00' + '4B EE 01 01 01 44 06 00 4D EE 01 01 01 46 06 00 4E EE 01 01 01 33 06 00 4F EE 01 01 01 39 06 00' + '51 EE 01 01 01 35 06 00 52 EE 01 01 01 42 06 00 54 EE 01 01 01 34 06 00 57 EE 01 01 01 2E 06 00' + '59 EE 01 01 01 36 06 00 5B EE 01 01 01 3A 06 00 5D EE 01 01 01 BA 06 00 5F EE 01 01 01 6F 06 00' + '61 EE 01 01 01 28 06 00 62 EE 01 01 01 2C 06 00 64 EE 01 01 01 47 06 00 67 EE 01 01 01 2D 06 00' + '68 EE 01 01 01 37 06 00 69 EE 01 01 01 4A 06 00 6A EE 01 01 01 43 06 00 6C EE 01 01 01 45 06 00' + '6D EE 01 01 01 46 06 00 6E EE 01 01 01 33 06 00 6F EE 01 01 01 39 06 00 70 EE 01 01 01 41 06 00' + '71 EE 01 01 01 35 06 00 72 EE 01 01 01 42 06 00 74 EE 01 01 01 34 06 00 75 EE 01 01 01 2A 06 00' + '76 EE 01 01 01 2B 06 00 77 EE 01 01 01 2E 06 00 79 EE 01 01 01 36 06 00 7A EE 01 01 01 38 06 00' + '7B EE 01 01 01 3A 06 00 7C EE 01 01 01 6E 06 00 7E EE 01 01 01 A1 06 00 80 EE 01 01 01 27 06 00' + '81 EE 01 01 01 28 06 00 82 EE 01 01 01 2C 06 00 83 EE 01 01 01 2F 06 00 84 EE 01 01 01 47 06 00' + '85 EE 01 01 01 48 06 00 86 EE 01 01 01 32 06 00 87 EE 01 01 01 2D 06 00 88 EE 01 01 01 37 06 00' + '89 EE 01 01 01 4A 06 00 8B EE 01 01 01 44 06 00 8C EE 01 01 01 45 06 00 8D EE 01 01 01 46 06 00' + '8E EE 01 01 01 33 06 00 8F EE 01 01 01 39 06 00 90 EE 01 01 01 41 06 00 91 EE 01 01 01 35 06 00' + '92 EE 01 01 01 42 06 00 93 EE 01 01 01 31 06 00 94 EE 01 01 01 34 06 00 95 EE 01 01 01 2A 06 00' + '96 EE 01 01 01 2B 06 00 97 EE 01 01 01 2E 06 00 98 EE 01 01 01 30 06 00 99 EE 01 01 01 36 06 00' + '9A EE 01 01 01 38 06 00 9B EE 01 01 01 3A 06 00 A1 EE 01 01 01 28 06 00 A2 EE 01 01 01 2C 06 00' + 'A3 EE 01 01 01 2F 06 00 A5 EE 01 01 01 48 06 00 A6 EE 01 01 01 32 06 00 A7 EE 01 01 01 2D 06 00' + 'A8 EE 01 01 01 37 06 00 A9 EE 01 01 01 4A 06 00 AB EE 01 01 01 44 06 00 AC EE 01 01 01 45 06 00' + 'AD EE 01 01 01 46 06 00 AE EE 01 01 01 33 06 00 AF EE 01 01 01 39 06 00 B0 EE 01 01 01 41 06 00' + 'B1 EE 01 01 01 35 06 00 B2 EE 01 01 01 42 06 00 B3 EE 01 01 01 31 06 00 B4 EE 01 01 01 34 06 00' + 'B5 EE 01 01 01 2A 06 00 B6 EE 01 01 01 2B 06 00 B7 EE 01 01 01 2E 06 00 B8 EE 01 01 01 30 06 00' + 'B9 EE 01 01 01 36 06 00 BA EE 01 01 01 38 06 00 BB EE 01 01 01 3A 06 00 00 F1 01 02 10 30 00 00' + '2E 00 00 01 F1 01 02 10 30 00 00 2C 00 00 02 F1 01 02 10 31 00 00 2C 00 00 03 F1 01 02 10 32 00' + '00 2C 00 00 04 F1 01 02 10 33 00 00 2C 00 00 05 F1 01 02 10 34 00 00 2C 00 00 06 F1 01 02 10 35' + '00 00 2C 00 00 07 F1 01 02 10 36 00 00 2C 00 00 08 F1 01 02 10 37 00 00 2C 00 00 09 F1 01 02 10' + '38 00 00 2C 00 00 0A F1 01 02 10 39 00 00 2C 00 00 10 F1 01 03 10 28 00 00 41 00 00 29 00 00 11' + 'F1 01 03 10 28 00 00 42 00 00 29 00 00 12 F1 01 03 10 28 00 00 43 00 00 29 00 00 13 F1 01 03 10' + '28 00 00 44 00 00 29 00 00 14 F1 01 03 10 28 00 00 45 00 00 29 00 00 15 F1 01 03 10 28 00 00 46' + '00 00 29 00 00 16 F1 01 03 10 28 00 00 47 00 00 29 00 00 17 F1 01 03 10 28 00 00 48 00 00 29 00' + '00 18 F1 01 03 10 28 00 00 49 00 00 29 00 00 19 F1 01 03 10 28 00 00 4A 00 00 29 00 00 1A F1 01' + '03 10 28 00 00 4B 00 00 29 00 00 1B F1 01 03 10 28 00 00 4C 00 00 29 00 00 1C F1 01 03 10 28 00' + '00 4D 00 00 29 00 00 1D F1 01 03 10 28 00 00 4E 00 00 29 00 00 1E F1 01 03 10 28 00 00 4F 00 00' + '29 00 00 1F F1 01 03 10 28 00 00 50 00 00 29 00 00 20 F1 01 03 10 28 00 00 51 00 00 29 00 00 21' + 'F1 01 03 10 28 00 00 52 00 00 29 00 00 22 F1 01 03 10 28 00 00 53 00 00 29 00 00 23 F1 01 03 10' + '28 00 00 54 00 00 29 00 00 24 F1 01 03 10 28 00 00 55 00 00 29 00 00 25 F1 01 03 10 28 00 00 56' + '00 00 29 00 00 26 F1 01 03 10 28 00 00 57 00 00 29 00 00 27 F1 01 03 10 28 00 00 58 00 00 29 00' + '00 28 F1 01 03 10 28 00 00 59 00 00 29 00 00 29 F1 01 03 10 28 00 00 5A 00 00 29 00 00 2A F1 01' + '03 10 14 30 00 53 00 00 15 30 00 2B F1 01 01 07 43 00 00 2C F1 01 01 07 52 00 00 2D F1 01 02 07' + '43 00 00 44 00 00 2E F1 01 02 07 57 00 00 5A 00 00 30 F1 01 01 0E 41 00 00 31 F1 01 01 0E 42 00' + '00 32 F1 01 01 0E 43 00 00 33 F1 01 01 0E 44 00 00 34 F1 01 01 0E 45 00 00 35 F1 01 01 0E 46 00' + '00 36 F1 01 01 0E 47 00 00 37 F1 01 01 0E 48 00 00 38 F1 01 01 0E 49 00 00 39 F1 01 01 0E 4A 00' + '00 3A F1 01 01 0E 4B 00 00 3B F1 01 01 0E 4C 00 00 3C F1 01 01 0E 4D 00 00 3D F1 01 01 0E 4E 00' + '00 3E F1 01 01 0E 4F 00 00 3F F1 01 01 0E 50 00 00 40 F1 01 01 0E 51 00 00 41 F1 01 01 0E 52 00' + '00 42 F1 01 01 0E 53 00 00 43 F1 01 01 0E 54 00 00 44 F1 01 01 0E 55 00 00 45 F1 01 01 0E 56 00' + '00 46 F1 01 01 0E 57 00 00 47 F1 01 01 0E 58 00 00 48 F1 01 01 0E 59 00 00 49 F1 01 01 0E 5A 00' + '00 4A F1 01 02 0E 48 00 00 56 00 00 4B F1 01 02 0E 4D 00 00 56 00 00 4C F1 01 02 0E 53 00 00 44' + '00 00 4D F1 01 02 0E 53 00 00 53 00 00 4E F1 01 03 0E 50 00 00 50 00 00 56 00 00 4F F1 01 02 0E' + '57 00 00 43 00 00 6A F1 01 02 08 4D 00 00 43 00 00 6B F1 01 02 08 4D 00 00 44 00 00 6C F1 01 02' + '08 4D 00 00 52 00 00 90 F1 01 02 0E 44 00 00 4A 00 00 00 F2 01 02 0E 7B 30 00 4B 30 00 01 F2 01' + '02 0E B3 30 00 B3 30 00 02 F2 01 01 0E B5 30 00 10 F2 01 01 0E 4B 62 00 11 F2 01 01 0E 57 5B 00' + '12 F2 01 01 0E CC 53 00 13 F2 01 02 0E C6 30 00 99 30 00 14 F2 01 01 0E 8C 4E 00 15 F2 01 01 0E' + '1A 59 00 16 F2 01 01 0E E3 89 00 17 F2 01 01 0E 29 59 00 18 F2 01 01 0E A4 4E 00 19 F2 01 01 0E' + '20 66 00 1A F2 01 01 0E 21 71 00 1B F2 01 01 0E 99 65 00 1C F2 01 01 0E 4D 52 00 1D F2 01 01 0E' + '8C 5F 00 1E F2 01 01 0E 8D 51 00 1F F2 01 01 0E B0 65 00 20 F2 01 01 0E 1D 52 00 21 F2 01 01 0E' + '42 7D 00 22 F2 01 01 0E 1F 75 00 23 F2 01 01 0E A9 8C 00 24 F2 01 01 0E F0 58 00 25 F2 01 01 0E' + '39 54 00 26 F2 01 01 0E 14 6F 00 27 F2 01 01 0E 95 62 00 28 F2 01 01 0E 55 63 00 29 F2 01 01 0E' + '00 4E 00 2A F2 01 01 0E 09 4E 00 2B F2 01 01 0E 4A 90 00 2C F2 01 01 0E E6 5D 00 2D F2 01 01 0E' + '2D 4E 00 2E F2 01 01 0E F3 53 00 2F F2 01 01 0E 07 63 00 30 F2 01 01 0E 70 8D 00 31 F2 01 01 0E' + '53 62 00 32 F2 01 01 0E 81 79 00 33 F2 01 01 0E 7A 7A 00 34 F2 01 01 0E 08 54 00 35 F2 01 01 0E' + '80 6E 00 36 F2 01 01 0E 09 67 00 37 F2 01 01 0E 08 67 00 38 F2 01 01 0E 33 75 00 39 F2 01 01 0E' + '72 52 00 3A F2 01 01 0E B6 55 00 3B F2 01 01 0E 4D 91 00 40 F2 01 03 10 14 30 00 2C 67 00 15 30' + '00 41 F2 01 03 10 14 30 00 09 4E 00 15 30 00 42 F2 01 03 10 14 30 00 8C 4E 00 15 30 00 43 F2 01' + '03 10 14 30 00 89 5B 00 15 30 00 44 F2 01 03 10 14 30 00 B9 70 00 15 30 00 45 F2 01 03 10 14 30' + '00 53 62 00 15 30 00 46 F2 01 03 10 14 30 00 D7 76 00 15 30 00 47 F2 01 03 10 14 30 00 DD 52 00' + '15 30 00 48 F2 01 03 10 14 30 00 57 65 00 15 30 00 50 F2 01 01 07 97 5F 00 51 F2 01 01 07 EF 53' + '00 F0 FB 01 01 01 30 00 00 F1 FB 01 01 01 31 00 00 F2 FB 01 01 01 32 00 00 F3 FB 01 01 01 33 00' + '00 F4 FB 01 01 01 34 00 00 F5 FB 01 01 01 35 00 00 F6 FB 01 01 01 36 00 00 F7 FB 01 01 01 37 00' + '00 F8 FB 01 01 01 38 00 00 F9 FB 01 01 01 39 00 00 00 F8 02 01 00 3D 4E 00 01 F8 02 01 00 38 4E' + '00 02 F8 02 01 00 41 4E 00 03 F8 02 01 00 22 01 02 04 F8 02 01 00 60 4F 00 05 F8 02 01 00 AE 4F' + '00 06 F8 02 01 00 BB 4F 00 07 F8 02 01 00 02 50 00 08 F8 02 01 00 7A 50 00 09 F8 02 01 00 99 50' + '00 0A F8 02 01 00 E7 50 00 0B F8 02 01 00 CF 50 00 0C F8 02 01 00 9E 34 00 0D F8 02 01 00 3A 06' + '02 0E F8 02 01 00 4D 51 00 0F F8 02 01 00 54 51 00 10 F8 02 01 00 64 51 00 11 F8 02 01 00 77 51' + '00 12 F8 02 01 00 1C 05 02 13 F8 02 01 00 B9 34 00 14 F8 02 01 00 67 51 00 15 F8 02 01 00 8D 51' + '00 16 F8 02 01 00 4B 05 02 17 F8 02 01 00 97 51 00 18 F8 02 01 00 A4 51 00 19 F8 02 01 00 CC 4E' + '00 1A F8 02 01 00 AC 51 00 1B F8 02 01 00 B5 51 00 1C F8 02 01 00 DF 91 02 1D F8 02 01 00 F5 51' + '00 1E F8 02 01 00 03 52 00 1F F8 02 01 00 DF 34 00 20 F8 02 01 00 3B 52 00 21 F8 02 01 00 46 52' + '00 22 F8 02 01 00 72 52 00 23 F8 02 01 00 77 52 00 24 F8 02 01 00 15 35 00 25 F8 02 01 00 C7 52' + '00 26 F8 02 01 00 C9 52 00 27 F8 02 01 00 E4 52 00 28 F8 02 01 00 FA 52 00 29 F8 02 01 00 05 53' + '00 2A F8 02 01 00 06 53 00 2B F8 02 01 00 17 53 00 2C F8 02 01 00 49 53 00 2D F8 02 01 00 51 53' + '00 2E F8 02 01 00 5A 53 00 2F F8 02 01 00 73 53 00 30 F8 02 01 00 7D 53 00 31 F8 02 01 00 7F 53' + '00 32 F8 02 01 00 7F 53 00 33 F8 02 01 00 7F 53 00 34 F8 02 01 00 2C 0A 02 35 F8 02 01 00 70 70' + '00 36 F8 02 01 00 CA 53 00 37 F8 02 01 00 DF 53 00 38 F8 02 01 00 63 0B 02 39 F8 02 01 00 EB 53' + '00 3A F8 02 01 00 F1 53 00 3B F8 02 01 00 06 54 00 3C F8 02 01 00 9E 54 00 3D F8 02 01 00 38 54' + '00 3E F8 02 01 00 48 54 00 3F F8 02 01 00 68 54 00 40 F8 02 01 00 A2 54 00 41 F8 02 01 00 F6 54' + '00 42 F8 02 01 00 10 55 00 43 F8 02 01 00 53 55 00 44 F8 02 01 00 63 55 00 45 F8 02 01 00 84 55' + '00 46 F8 02 01 00 84 55 00 47 F8 02 01 00 99 55 00 48 F8 02 01 00 AB 55 00 49 F8 02 01 00 B3 55' + '00 4A F8 02 01 00 C2 55 00 4B F8 02 01 00 16 57 00 4C F8 02 01 00 06 56 00 4D F8 02 01 00 17 57' + '00 4E F8 02 01 00 51 56 00 4F F8 02 01 00 74 56 00 50 F8 02 01 00 07 52 00 51 F8 02 01 00 EE 58' + '00 52 F8 02 01 00 CE 57 00 53 F8 02 01 00 F4 57 00 54 F8 02 01 00 0D 58 00 55 F8 02 01 00 8B 57' + '00 56 F8 02 01 00 32 58 00 57 F8 02 01 00 31 58 00 58 F8 02 01 00 AC 58 00 59 F8 02 01 00 E4 14' + '02 5A F8 02 01 00 F2 58 00 5B F8 02 01 00 F7 58 00 5C F8 02 01 00 06 59 00 5D F8 02 01 00 1A 59' + '00 5E F8 02 01 00 22 59 00 5F F8 02 01 00 62 59 00 60 F8 02 01 00 A8 16 02 61 F8 02 01 00 EA 16' + '02 62 F8 02 01 00 EC 59 00 63 F8 02 01 00 1B 5A 00 64 F8 02 01 00 27 5A 00 65 F8 02 01 00 D8 59' + '00 66 F8 02 01 00 66 5A 00 67 F8 02 01 00 EE 36 00 68 F8 02 01 00 FC 36 00 69 F8 02 01 00 08 5B' + '00 6A F8 02 01 00 3E 5B 00 6B F8 02 01 00 3E 5B 00 6C F8 02 01 00 C8 19 02 6D F8 02 01 00 C3 5B' + '00 6E F8 02 01 00 D8 5B 00 6F F8 02 01 00 E7 5B 00 70 F8 02 01 00 F3 5B 00 71 F8 02 01 00 18 1B' + '02 72 F8 02 01 00 FF 5B 00 73 F8 02 01 00 06 5C 00 74 F8 02 01 00 53 5F 00 75 F8 02 01 00 22 5C' + '00 76 F8 02 01 00 81 37 00 77 F8 02 01 00 60 5C 00 78 F8 02 01 00 6E 5C 00 79 F8 02 01 00 C0 5C' + '00 7A F8 02 01 00 8D 5C 00 7B F8 02 01 00 E4 1D 02 7C F8 02 01 00 43 5D 00 7D F8 02 01 00 E6 1D' + '02 7E F8 02 01 00 6E 5D 00 7F F8 02 01 00 6B 5D 00 80 F8 02 01 00 7C 5D 00 81 F8 02 01 00 E1 5D' + '00 82 F8 02 01 00 E2 5D 00 83 F8 02 01 00 2F 38 00 84 F8 02 01 00 FD 5D 00 85 F8 02 01 00 28 5E' + '00 86 F8 02 01 00 3D 5E 00 87 F8 02 01 00 69 5E 00 88 F8 02 01 00 62 38 00 89 F8 02 01 00 83 21' + '02 8A F8 02 01 00 7C 38 00 8B F8 02 01 00 B0 5E 00 8C F8 02 01 00 B3 5E 00 8D F8 02 01 00 B6 5E' + '00 8E F8 02 01 00 CA 5E 00 8F F8 02 01 00 92 A3 02 90 F8 02 01 00 FE 5E 00 91 F8 02 01 00 31 23' + '02 92 F8 02 01 00 31 23 02 93 F8 02 01 00 01 82 00 94 F8 02 01 00 22 5F 00 95 F8 02 01 00 22 5F' + '00 96 F8 02 01 00 C7 38 00 97 F8 02 01 00 B8 32 02 98 F8 02 01 00 DA 61 02 99 F8 02 01 00 62 5F' + '00 9A F8 02 01 00 6B 5F 00 9B F8 02 01 00 E3 38 00 9C F8 02 01 00 9A 5F 00 9D F8 02 01 00 CD 5F' + '00 9E F8 02 01 00 D7 5F 00 9F F8 02 01 00 F9 5F 00 A0 F8 02 01 00 81 60 00 A1 F8 02 01 00 3A 39' + '00 A2 F8 02 01 00 1C 39 00 A3 F8 02 01 00 94 60 00 A4 F8 02 01 00 D4 26 02 A5 F8 02 01 00 C7 60' + '00 A6 F8 02 01 00 48 61 00 A7 F8 02 01 00 4C 61 00 A8 F8 02 01 00 4E 61 00 A9 F8 02 01 00 4C 61' + '00 AA F8 02 01 00 7A 61 00 AB F8 02 01 00 8E 61 00 AC F8 02 01 00 B2 61 00 AD F8 02 01 00 A4 61' + '00 AE F8 02 01 00 AF 61 00 AF F8 02 01 00 DE 61 00 B0 F8 02 01 00 F2 61 00 B1 F8 02 01 00 F6 61' + '00 B2 F8 02 01 00 10 62 00 B3 F8 02 01 00 1B 62 00 B4 F8 02 01 00 5D 62 00 B5 F8 02 01 00 B1 62' + '00 B6 F8 02 01 00 D4 62 00 B7 F8 02 01 00 50 63 00 B8 F8 02 01 00 0C 2B 02 B9 F8 02 01 00 3D 63' + '00 BA F8 02 01 00 FC 62 00 BB F8 02 01 00 68 63 00 BC F8 02 01 00 83 63 00 BD F8 02 01 00 E4 63' + '00 BE F8 02 01 00 F1 2B 02 BF F8 02 01 00 22 64 00 C0 F8 02 01 00 C5 63 00 C1 F8 02 01 00 A9 63' + '00 C2 F8 02 01 00 2E 3A 00 C3 F8 02 01 00 69 64 00 C4 F8 02 01 00 7E 64 00 C5 F8 02 01 00 9D 64' + '00 C6 F8 02 01 00 77 64 00 C7 F8 02 01 00 6C 3A 00 C8 F8 02 01 00 4F 65 00 C9 F8 02 01 00 6C 65' + '00 CA F8 02 01 00 0A 30 02 CB F8 02 01 00 E3 65 00 CC F8 02 01 00 F8 66 00 CD F8 02 01 00 49 66' + '00 CE F8 02 01 00 19 3B 00 CF F8 02 01 00 91 66 00 D0 F8 02 01 00 08 3B 00 D1 F8 02 01 00 E4 3A' + '00 D2 F8 02 01 00 92 51 00 D3 F8 02 01 00 95 51 00 D4 F8 02 01 00 00 67 00 D5 F8 02 01 00 9C 66' + '00 D6 F8 02 01 00 AD 80 00 D7 F8 02 01 00 D9 43 00 D8 F8 02 01 00 17 67 00 D9 F8 02 01 00 1B 67' + '00 DA F8 02 01 00 21 67 00 DB F8 02 01 00 5E 67 00 DC F8 02 01 00 53 67 00 DD F8 02 01 00 C3 33' + '02 DE F8 02 01 00 49 3B 00 DF F8 02 01 00 FA 67 00 E0 F8 02 01 00 85 67 00 E1 F8 02 01 00 52 68' + '00 E2 F8 02 01 00 85 68 00 E3 F8 02 01 00 6D 34 02 E4 F8 02 01 00 8E 68 00 E5 F8 02 01 00 1F 68' + '00 E6 F8 02 01 00 14 69 00 E7 F8 02 01 00 9D 3B 00 E8 F8 02 01 00 42 69 00 E9 F8 02 01 00 A3 69' + '00 EA F8 02 01 00 EA 69 00 EB F8 02 01 00 A8 6A 00 EC F8 02 01 00 A3 36 02 ED F8 02 01 00 DB 6A' + '00 EE F8 02 01 00 18 3C 00 EF F8 02 01 00 21 6B 00 F0 F8 02 01 00 A7 38 02 F1 F8 02 01 00 54 6B' + '00 F2 F8 02 01 00 4E 3C 00 F3 F8 02 01 00 72 6B 00 F4 F8 02 01 00 9F 6B 00 F5 F8 02 01 00 BA 6B' + '00 F6 F8 02 01 00 BB 6B 00 F7 F8 02 01 00 8D 3A 02 F8 F8 02 01 00 0B 1D 02 F9 F8 02 01 00 FA 3A' + '02 FA F8 02 01 00 4E 6C 00 FB F8 02 01 00 BC 3C 02 FC F8 02 01 00 BF 6C 00 FD F8 02 01 00 CD 6C' + '00 FE F8 02 01 00 67 6C 00 FF F8 02 01 00 16 6D 00 00 F9 02 01 00 3E 6D 00 01 F9 02 01 00 77 6D' + '00 02 F9 02 01 00 41 6D 00 03 F9 02 01 00 69 6D 00 04 F9 02 01 00 78 6D 00 05 F9 02 01 00 85 6D' + '00 06 F9 02 01 00 1E 3D 02 07 F9 02 01 00 34 6D 00 08 F9 02 01 00 2F 6E 00 09 F9 02 01 00 6E 6E' + '00 0A F9 02 01 00 33 3D 00 0B F9 02 01 00 CB 6E 00 0C F9 02 01 00 C7 6E 00 0D F9 02 01 00 D1 3E' + '02 0E F9 02 01 00 F9 6D 00 0F F9 02 01 00 6E 6F 00 10 F9 02 01 00 5E 3F 02 11 F9 02 01 00 8E 3F' + '02 12 F9 02 01 00 C6 6F 00 13 F9 02 01 00 39 70 00 14 F9 02 01 00 1E 70 00 15 F9 02 01 00 1B 70' + '00 16 F9 02 01 00 96 3D 00 17 F9 02 01 00 4A 70 00 18 F9 02 01 00 7D 70 00 19 F9 02 01 00 77 70' + '00 1A F9 02 01 00 AD 70 00 1B F9 02 01 00 25 05 02 1C F9 02 01 00 45 71 00 1D F9 02 01 00 63 42' + '02 1E F9 02 01 00 9C 71 00 1F F9 02 01 00 AB 43 02 20 F9 02 01 00 28 72 00 21 F9 02 01 00 35 72' + '00 22 F9 02 01 00 50 72 00 23 F9 02 01 00 08 46 02 24 F9 02 01 00 80 72 00 25 F9 02 01 00 95 72' + '00 26 F9 02 01 00 35 47 02 27 F9 02 01 00 14 48 02 28 F9 02 01 00 7A 73 00 29 F9 02 01 00 8B 73' + '00 2A F9 02 01 00 AC 3E 00 2B F9 02 01 00 A5 73 00 2C F9 02 01 00 B8 3E 00 2D F9 02 01 00 B8 3E' + '00 2E F9 02 01 00 47 74 00 2F F9 02 01 00 5C 74 00 30 F9 02 01 00 71 74 00 31 F9 02 01 00 85 74' + '00 32 F9 02 01 00 CA 74 00 33 F9 02 01 00 1B 3F 00 34 F9 02 01 00 24 75 00 35 F9 02 01 00 36 4C' + '02 36 F9 02 01 00 3E 75 00 37 F9 02 01 00 92 4C 02 38 F9 02 01 00 70 75 00 39 F9 02 01 00 9F 21' + '02 3A F9 02 01 00 10 76 00 3B F9 02 01 00 A1 4F 02 3C F9 02 01 00 B8 4F 02 3D F9 02 01 00 44 50' + '02 3E F9 02 01 00 FC 3F 00 3F F9 02 01 00 08 40 00 40 F9 02 01 00 F4 76 00 41 F9 02 01 00 F3 50' + '02 42 F9 02 01 00 F2 50 02 43 F9 02 01 00 19 51 02 44 F9 02 01 00 33 51 02 45 F9 02 01 00 1E 77' + '00 46 F9 02 01 00 1F 77 00 47 F9 02 01 00 1F 77 00 48 F9 02 01 00 4A 77 00 49 F9 02 01 00 39 40' + '00 4A F9 02 01 00 8B 77 00 4B F9 02 01 00 46 40 00 4C F9 02 01 00 96 40 00 4D F9 02 01 00 1D 54' + '02 4E F9 02 01 00 4E 78 00 4F F9 02 01 00 8C 78 00 50 F9 02 01 00 CC 78 00 51 F9 02 01 00 E3 40' + '00 52 F9 02 01 00 26 56 02 53 F9 02 01 00 56 79 00 54 F9 02 01 00 9A 56 02 55 F9 02 01 00 C5 56' + '02 56 F9 02 01 00 8F 79 00 57 F9 02 01 00 EB 79 00 58 F9 02 01 00 2F 41 00 59 F9 02 01 00 40 7A' + '00 5A F9 02 01 00 4A 7A 00 5B F9 02 01 00 4F 7A 00 5C F9 02 01 00 7C 59 02 5D F9 02 01 00 A7 5A' + '02 5E F9 02 01 00 A7 5A 02 5F F9 02 01 00 EE 7A 00 60 F9 02 01 00 02 42 00 61 F9 02 01 00 AB 5B' + '02 62 F9 02 01 00 C6 7B 00 63 F9 02 01 00 C9 7B 00 64 F9 02 01 00 27 42 00 65 F9 02 01 00 80 5C' + '02 66 F9 02 01 00 D2 7C 00 67 F9 02 01 00 A0 42 00 68 F9 02 01 00 E8 7C 00 69 F9 02 01 00 E3 7C' + '00 6A F9 02 01 00 00 7D 00 6B F9 02 01 00 86 5F 02 6C F9 02 01 00 63 7D 00 6D F9 02 01 00 01 43' + '00 6E F9 02 01 00 C7 7D 00 6F F9 02 01 00 02 7E 00 70 F9 02 01 00 45 7E 00 71 F9 02 01 00 34 43' + '00 72 F9 02 01 00 28 62 02 73 F9 02 01 00 47 62 02 74 F9 02 01 00 59 43 00 75 F9 02 01 00 D9 62' + '02 76 F9 02 01 00 7A 7F 00 77 F9 02 01 00 3E 63 02 78 F9 02 01 00 95 7F 00 79 F9 02 01 00 FA 7F' + '00 7A F9 02 01 00 05 80 00 7B F9 02 01 00 DA 64 02 7C F9 02 01 00 23 65 02 7D F9 02 01 00 60 80' + '00 7E F9 02 01 00 A8 65 02 7F F9 02 01 00 70 80 00 80 F9 02 01 00 5F 33 02 81 F9 02 01 00 D5 43' + '00 82 F9 02 01 00 B2 80 00 83 F9 02 01 00 03 81 00 84 F9 02 01 00 0B 44 00 85 F9 02 01 00 3E 81' + '00 86 F9 02 01 00 B5 5A 00 87 F9 02 01 00 A7 67 02 88 F9 02 01 00 B5 67 02 89 F9 02 01 00 93 33' + '02 8A F9 02 01 00 9C 33 02 8B F9 02 01 00 01 82 00 8C F9 02 01 00 04 82 00 8D F9 02 01 00 9E 8F' + '00 8E F9 02 01 00 6B 44 00 8F F9 02 01 00 91 82 00 90 F9 02 01 00 8B 82 00 91 F9 02 01 00 9D 82' + '00 92 F9 02 01 00 B3 52 00 93 F9 02 01 00 B1 82 00 94 F9 02 01 00 B3 82 00 95 F9 02 01 00 BD 82' + '00 96 F9 02 01 00 E6 82 00 97 F9 02 01 00 3C 6B 02 98 F9 02 01 00 E5 82 00 99 F9 02 01 00 1D 83' + '00 9A F9 02 01 00 63 83 00 9B F9 02 01 00 AD 83 00 9C F9 02 01 00 23 83 00 9D F9 02 01 00 BD 83' + '00 9E F9 02 01 00 E7 83 00 9F F9 02 01 00 57 84 00 A0 F9 02 01 00 53 83 00 A1 F9 02 01 00 CA 83' + '00 A2 F9 02 01 00 CC 83 00 A3 F9 02 01 00 DC 83 00 A4 F9 02 01 00 36 6C 02 A5 F9 02 01 00 6B 6D' + '02 A6 F9 02 01 00 D5 6C 02 A7 F9 02 01 00 2B 45 00 A8 F9 02 01 00 F1 84 00 A9 F9 02 01 00 F3 84' + '00 AA F9 02 01 00 16 85 00 AB F9 02 01 00 CA 73 02 AC F9 02 01 00 64 85 00 AD F9 02 01 00 2C 6F' + '02 AE F9 02 01 00 5D 45 00 AF F9 02 01 00 61 45 00 B0 F9 02 01 00 B1 6F 02 B1 F9 02 01 00 D2 70' + '02 B2 F9 02 01 00 6B 45 00 B3 F9 02 01 00 50 86 00 B4 F9 02 01 00 5C 86 00 B5 F9 02 01 00 67 86' + '00 B6 F9 02 01 00 69 86 00 B7 F9 02 01 00 A9 86 00 B8 F9 02 01 00 88 86 00 B9 F9 02 01 00 0E 87' + '00 BA F9 02 01 00 E2 86 00 BB F9 02 01 00 79 87 00 BC F9 02 01 00 28 87 00 BD F9 02 01 00 6B 87' + '00 BE F9 02 01 00 86 87 00 BF F9 02 01 00 D7 45 00 C0 F9 02 01 00 E1 87 00 C1 F9 02 01 00 01 88' + '00 C2 F9 02 01 00 F9 45 00 C3 F9 02 01 00 60 88 00 C4 F9 02 01 00 63 88 00 C5 F9 02 01 00 67 76' + '02 C6 F9 02 01 00 D7 88 00 C7 F9 02 01 00 DE 88 00 C8 F9 02 01 00 35 46 00 C9 F9 02 01 00 FA 88' + '00 CA F9 02 01 00 BB 34 00 CB F9 02 01 00 AE 78 02 CC F9 02 01 00 66 79 02 CD F9 02 01 00 BE 46' + '00 CE F9 02 01 00 C7 46 00 CF F9 02 01 00 A0 8A 00 D0 F9 02 01 00 ED 8A 00 D1 F9 02 01 00 8A 8B' + '00 D2 F9 02 01 00 55 8C 00 D3 F9 02 01 00 A8 7C 02 D4 F9 02 01 00 AB 8C 00 D5 F9 02 01 00 C1 8C' + '00 D6 F9 02 01 00 1B 8D 00 D7 F9 02 01 00 77 8D 00 D8 F9 02 01 00 2F 7F 02 D9 F9 02 01 00 04 08' + '02 DA F9 02 01 00 CB 8D 00 DB F9 02 01 00 BC 8D 00 DC F9 02 01 00 F0 8D 00 DD F9 02 01 00 DE 08' + '02 DE F9 02 01 00 D4 8E 00 DF F9 02 01 00 38 8F 00 E0 F9 02 01 00 D2 85 02 E1 F9 02 01 00 ED 85' + '02 E2 F9 02 01 00 94 90 00 E3 F9 02 01 00 F1 90 00 E4 F9 02 01 00 11 91 00 E5 F9 02 01 00 2E 87' + '02 E6 F9 02 01 00 1B 91 00 E7 F9 02 01 00 38 92 00 E8 F9 02 01 00 D7 92 00 E9 F9 02 01 00 D8 92' + '00 EA F9 02 01 00 7C 92 00 EB F9 02 01 00 F9 93 00 EC F9 02 01 00 15 94 00 ED F9 02 01 00 FA 8B' + '02 EE F9 02 01 00 8B 95 00 EF F9 02 01 00 95 49 00 F0 F9 02 01 00 B7 95 00 F1 F9 02 01 00 77 8D' + '02 F2 F9 02 01 00 E6 49 00 F3 F9 02 01 00 C3 96 00 F4 F9 02 01 00 B2 5D 00 F5 F9 02 01 00 23 97' + '00 F6 F9 02 01 00 45 91 02 F7 F9 02 01 00 1A 92 02 F8 F9 02 01 00 6E 4A 00 F9 F9 02 01 00 76 4A' + '00 FA F9 02 01 00 E0 97 00 FB F9 02 01 00 0A 94 02 FC F9 02 01 00 B2 4A 00 FD F9 02 01 00 96 94' + '02 FE F9 02 01 00 0B 98 00 FF F9 02 01 00 0B 98 00 00 FA 02 01 00 29 98 00 01 FA 02 01 00 B6 95' + '02 02 FA 02 01 00 E2 98 00 03 FA 02 01 00 33 4B 00 04 FA 02 01 00 29 99 00 05 FA 02 01 00 A7 99' + '00 06 FA 02 01 00 C2 99 00 07 FA 02 01 00 FE 99 00 08 FA 02 01 00 CE 4B 00 09 FA 02 01 00 30 9B' + '02 0A FA 02 01 00 12 9B 00 0B FA 02 01 00 40 9C 00 0C FA 02 01 00 FD 9C 00 0D FA 02 01 00 CE 4C' + '00 0E FA 02 01 00 ED 4C 00 0F FA 02 01 00 67 9D 00 10 FA 02 01 00 CE A0 02 11 FA 02 01 00 F8 4C' + '00 12 FA 02 01 00 05 A1 02 13 FA 02 01 00 0E A2 02 14 FA 02 01 00 91 A2 02 15 FA 02 01 00 BB 9E' + '00 16 FA 02 01 00 56 4D 00 17 FA 02 01 00 F9 9E 00 18 FA 02 01 00 FE 9E 00 19 FA 02 01 00 05 9F' + '00 1A FA 02 01 00 0F 9F 00 1B FA 02 01 00 16 9F 00 1C FA 02 01 00 3B 9F 00 1D FA 02 01 00 00 A6' + '02' +} + + +LANGUAGE 0,0 COMBINING UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE +{ + '01 0B 34 03 00 38 03 00 D4 1C 00 D4 1C 00 E2 1C 00 E8 1C 00 D2 20 00 D3 20 00 D8 20 00 DA 20 00' + 'E5 20 00 E6 20 00 EA 20 00 EB 20 00 39 0A 01 39 0A 01 F0 6A 01 F4 6A 01 9E BC 01 9E BC 01 67 D1' + '01 69 D1 01 06 01 F0 6F 01 F1 6F 01 07 19 3C 09 00 3C 09 00 BC 09 00 BC 09 00 3C 0A 00 3C 0A 00' + 'BC 0A 00 BC 0A 00 3C 0B 00 3C 0B 00 BC 0C 00 BC 0C 00 37 10 00 37 10 00 34 1B 00 34 1B 00 E6 1B' + '00 E6 1B 00 37 1C 00 37 1C 00 B3 A9 00 B3 A9 00 BA 10 01 BA 10 01 73 11 01 73 11 01 CA 11 01 CA' + '11 01 36 12 01 36 12 01 E9 12 01 E9 12 01 3B 13 01 3C 13 01 46 14 01 46 14 01 C3 14 01 C3 14 01' + 'C0 15 01 C0 15 01 B7 16 01 B7 16 01 3A 18 01 3A 18 01 43 19 01 43 19 01 42 1D 01 42 1D 01 4A E9' + '01 4A E9 01 08 01 99 30 00 9A 30 00 09 36 4D 09 00 4D 09 00 CD 09 00 CD 09 00 4D 0A 00 4D 0A 00' + 'CD 0A 00 CD 0A 00 4D 0B 00 4D 0B 00 CD 0B 00 CD 0B 00 4D 0C 00 4D 0C 00 CD 0C 00 CD 0C 00 3B 0D' + '00 3C 0D 00 4D 0D 00 4D 0D 00 CA 0D 00 CA 0D 00 3A 0E 00 3A 0E 00 BA 0E 00 BA 0E 00 84 0F 00 84' + '0F 00 39 10 00 3A 10 00 14 17 00 14 17 00 34 17 00 34 17 00 D2 17 00 D2 17 00 60 1A 00 60 1A 00' + '44 1B 00 44 1B 00 AA 1B 00 AB 1B 00 F2 1B 00 F3 1B 00 7F 2D 00 7F 2D 00 06 A8 00 06 A8 00 2C A8' + '00 2C A8 00 C4 A8 00 C4 A8 00 53 A9 00 53 A9 00 C0 A9 00 C0 A9 00 F6 AA 00 F6 AA 00 ED AB 00 ED' + 'AB 00 3F 0A 01 3F 0A 01 46 10 01 46 10 01 7F 10 01 7F 10 01 B9 10 01 B9 10 01 33 11 01 34 11 01' + 'C0 11 01 C0 11 01 35 12 01 35 12 01 EA 12 01 EA 12 01 4D 13 01 4D 13 01 42 14 01 42 14 01 C2 14' + '01 C2 14 01 BF 15 01 BF 15 01 3F 16 01 3F 16 01 B6 16 01 B6 16 01 2B 17 01 2B 17 01 39 18 01 39' + '18 01 3D 19 01 3E 19 01 E0 19 01 E0 19 01 34 1A 01 34 1A 01 47 1A 01 47 1A 01 99 1A 01 99 1A 01' + '3F 1C 01 3F 1C 01 44 1D 01 45 1D 01 97 1D 01 97 1D 01 0A 01 B0 05 00 B0 05 00 0B 01 B1 05 00 B1' + '05 00 0C 01 B2 05 00 B2 05 00 0D 01 B3 05 00 B3 05 00 0E 01 B4 05 00 B4 05 00 0F 01 B5 05 00 B5' + '05 00 10 01 B6 05 00 B6 05 00 11 01 B7 05 00 B7 05 00 12 02 B8 05 00 B8 05 00 C7 05 00 C7 05 00' + '13 01 B9 05 00 BA 05 00 14 01 BB 05 00 BB 05 00 15 01 BC 05 00 BC 05 00 16 01 BD 05 00 BD 05 00' + '17 01 BF 05 00 BF 05 00 18 01 C1 05 00 C1 05 00 19 01 C2 05 00 C2 05 00 1A 01 1E FB 00 1E FB 00' + '1B 02 4B 06 00 4B 06 00 F0 08 00 F0 08 00 1C 02 4C 06 00 4C 06 00 F1 08 00 F1 08 00 1D 02 4D 06' + '00 4D 06 00 F2 08 00 F2 08 00 1E 02 18 06 00 18 06 00 4E 06 00 4E 06 00 1F 02 19 06 00 19 06 00' + '4F 06 00 4F 06 00 20 02 1A 06 00 1A 06 00 50 06 00 50 06 00 21 01 51 06 00 51 06 00 22 01 52 06' + '00 52 06 00 23 01 70 06 00 70 06 00 24 01 11 07 00 11 07 00 54 01 55 0C 00 55 0C 00 5B 01 56 0C' + '00 56 0C 00 67 01 38 0E 00 39 0E 00 6B 01 48 0E 00 4B 0E 00 76 01 B8 0E 00 B9 0E 00 7A 01 C8 0E' + '00 CB 0E 00 81 01 71 0F 00 71 0F 00 82 03 72 0F 00 72 0F 00 7A 0F 00 7D 0F 00 80 0F 00 80 0F 00' + '84 01 74 0F 00 74 0F 00 CA 03 21 03 00 22 03 00 27 03 00 28 03 00 D0 1D 00 D0 1D 00 D6 01 CE 1D' + '00 CE 1D 00 D8 04 1B 03 00 1B 03 00 39 0F 00 39 0F 00 65 D1 01 66 D1 01 6E D1 01 72 D1 01 DA 01' + '2A 30 00 2A 30 00 DC 4E 16 03 00 19 03 00 1C 03 00 20 03 00 23 03 00 26 03 00 29 03 00 33 03 00' + '39 03 00 3C 03 00 47 03 00 49 03 00 4D 03 00 4E 03 00 53 03 00 56 03 00 59 03 00 5A 03 00 91 05' + '00 91 05 00 96 05 00 96 05 00 9B 05 00 9B 05 00 A2 05 00 A7 05 00 AA 05 00 AA 05 00 C5 05 00 C5' + '05 00 55 06 00 56 06 00 5C 06 00 5C 06 00 5F 06 00 5F 06 00 E3 06 00 E3 06 00 EA 06 00 EA 06 00' + 'ED 06 00 ED 06 00 31 07 00 31 07 00 34 07 00 34 07 00 37 07 00 39 07 00 3B 07 00 3C 07 00 3E 07' + '00 3E 07 00 42 07 00 42 07 00 44 07 00 44 07 00 46 07 00 46 07 00 48 07 00 48 07 00 F2 07 00 F2' + '07 00 FD 07 00 FD 07 00 59 08 00 5B 08 00 D3 08 00 D3 08 00 E3 08 00 E3 08 00 E6 08 00 E6 08 00' + 'E9 08 00 E9 08 00 ED 08 00 EF 08 00 F6 08 00 F6 08 00 F9 08 00 FA 08 00 52 09 00 52 09 00 18 0F' + '00 19 0F 00 35 0F 00 35 0F 00 37 0F 00 37 0F 00 C6 0F 00 C6 0F 00 8D 10 00 8D 10 00 3B 19 00 3B' + '19 00 18 1A 00 18 1A 00 7F 1A 00 7F 1A 00 B5 1A 00 BA 1A 00 BD 1A 00 BD 1A 00 BF 1A 00 C0 1A 00' + '6C 1B 00 6C 1B 00 D5 1C 00 D9 1C 00 DC 1C 00 DF 1C 00 ED 1C 00 ED 1C 00 C2 1D 00 C2 1D 00 CA 1D' + '00 CA 1D 00 CF 1D 00 CF 1D 00 F9 1D 00 F9 1D 00 FD 1D 00 FD 1D 00 FF 1D 00 FF 1D 00 E8 20 00 E8' + '20 00 EC 20 00 EF 20 00 2B A9 00 2D A9 00 B4 AA 00 B4 AA 00 27 FE 00 2D FE 00 FD 01 01 FD 01 01' + 'E0 02 01 E0 02 01 0D 0A 01 0D 0A 01 3A 0A 01 3A 0A 01 E6 0A 01 E6 0A 01 46 0F 01 47 0F 01 4B 0F' + '01 4B 0F 01 4D 0F 01 50 0F 01 7B D1 01 82 D1 01 8A D1 01 8B D1 01 D0 E8 01 D6 E8 01 DE 04 9A 05' + '00 9A 05 00 AD 05 00 AD 05 00 39 19 00 39 19 00 2D 30 00 2D 30 00 E0 01 2E 30 00 2F 30 00 E2 01' + '6D D1 01 6D D1 01 E4 04 AE 05 00 AE 05 00 A9 18 00 A9 18 00 F7 1D 00 F8 1D 00 2B 30 00 2B 30 00' + 'E6 76 00 03 00 14 03 00 3D 03 00 44 03 00 46 03 00 46 03 00 4A 03 00 4C 03 00 50 03 00 52 03 00' + '57 03 00 57 03 00 5B 03 00 5B 03 00 63 03 00 6F 03 00 83 04 00 87 04 00 92 05 00 95 05 00 97 05' + '00 99 05 00 9C 05 00 A1 05 00 A8 05 00 A9 05 00 AB 05 00 AC 05 00 AF 05 00 AF 05 00 C4 05 00 C4' + '05 00 10 06 00 17 06 00 53 06 00 54 06 00 57 06 00 5B 06 00 5D 06 00 5E 06 00 D6 06 00 DC 06 00' + 'DF 06 00 E2 06 00 E4 06 00 E4 06 00 E7 06 00 E8 06 00 EB 06 00 EC 06 00 30 07 00 30 07 00 32 07' + '00 33 07 00 35 07 00 36 07 00 3A 07 00 3A 07 00 3D 07 00 3D 07 00 3F 07 00 41 07 00 43 07 00 43' + '07 00 45 07 00 45 07 00 47 07 00 47 07 00 49 07 00 4A 07 00 EB 07 00 F1 07 00 F3 07 00 F3 07 00' + '16 08 00 19 08 00 1B 08 00 23 08 00 25 08 00 27 08 00 29 08 00 2D 08 00 D4 08 00 E1 08 00 E4 08' + '00 E5 08 00 E7 08 00 E8 08 00 EA 08 00 EC 08 00 F3 08 00 F5 08 00 F7 08 00 F8 08 00 FB 08 00 FF' + '08 00 51 09 00 51 09 00 53 09 00 54 09 00 FE 09 00 FE 09 00 82 0F 00 83 0F 00 86 0F 00 87 0F 00' + '5D 13 00 5F 13 00 DD 17 00 DD 17 00 3A 19 00 3A 19 00 17 1A 00 17 1A 00 75 1A 00 7C 1A 00 B0 1A' + '00 B4 1A 00 BB 1A 00 BC 1A 00 6B 1B 00 6B 1B 00 6D 1B 00 73 1B 00 D0 1C 00 D2 1C 00 DA 1C 00 DB' + '1C 00 E0 1C 00 E0 1C 00 F4 1C 00 F4 1C 00 F8 1C 00 F9 1C 00 C0 1D 00 C1 1D 00 C3 1D 00 C9 1D 00' + 'CB 1D 00 CC 1D 00 D1 1D 00 F5 1D 00 FB 1D 00 FB 1D 00 FE 1D 00 FE 1D 00 D0 20 00 D1 20 00 D4 20' + '00 D7 20 00 DB 20 00 DC 20 00 E1 20 00 E1 20 00 E7 20 00 E7 20 00 E9 20 00 E9 20 00 F0 20 00 F0' + '20 00 EF 2C 00 F1 2C 00 E0 2D 00 FF 2D 00 6F A6 00 6F A6 00 74 A6 00 7D A6 00 9E A6 00 9F A6 00' + 'F0 A6 00 F1 A6 00 E0 A8 00 F1 A8 00 B0 AA 00 B0 AA 00 B2 AA 00 B3 AA 00 B7 AA 00 B8 AA 00 BE AA' + '00 BF AA 00 C1 AA 00 C1 AA 00 20 FE 00 26 FE 00 2E FE 00 2F FE 00 76 03 01 7A 03 01 0F 0A 01 0F' + '0A 01 38 0A 01 38 0A 01 E5 0A 01 E5 0A 01 24 0D 01 27 0D 01 AB 0E 01 AC 0E 01 48 0F 01 4A 0F 01' + '4C 0F 01 4C 0F 01 00 11 01 02 11 01 66 13 01 6C 13 01 70 13 01 74 13 01 5E 14 01 5E 14 01 30 6B' + '01 36 6B 01 85 D1 01 89 D1 01 AA D1 01 AD D1 01 42 D2 01 44 D2 01 00 E0 01 06 E0 01 08 E0 01 18' + 'E0 01 1B E0 01 21 E0 01 23 E0 01 24 E0 01 26 E0 01 2A E0 01 30 E1 01 36 E1 01 EC E2 01 EF E2 01' + '44 E9 01 49 E9 01 E8 05 15 03 00 15 03 00 1A 03 00 1A 03 00 58 03 00 58 03 00 F6 1D 00 F6 1D 00' + '2C 30 00 2C 30 00 E9 04 5C 03 00 5C 03 00 5F 03 00 5F 03 00 62 03 00 62 03 00 FC 1D 00 FC 1D 00' + 'EA 03 5D 03 00 5E 03 00 60 03 00 61 03 00 CD 1D 00 CD 1D 00 F0 01 45 03 00 45 03 00' +} + + +LANGUAGE 0,0 NUMBERS UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE +{ + '95 00 00 00 00 01 00 00 00 01 00 00 00 01 00 00 00 02 00 00 00 01 00 00 00 03 00 00 00 01 00 00' + '00 04 00 00 00 01 00 00 00 05 00 00 00 01 00 00 00 06 00 00 00 01 00 00 00 07 00 00 00 01 00 00' + '00 08 00 00 00 01 00 00 00 09 00 00 00 01 00 00 00 01 00 00 00 04 00 00 00 01 00 00 00 02 00 00' + '00 03 00 00 00 04 00 00 00 01 00 00 00 10 00 00 00 01 00 00 00 08 00 00 00 03 00 00 00 10 00 00' + '00 10 00 00 00 01 00 00 00 0A 00 00 00 01 00 00 00 64 00 00 00 01 00 00 00 E8 03 00 00 01 00 00' + '00 01 00 00 00 A0 00 00 00 01 00 00 00 28 00 00 00 03 00 00 00 50 00 00 00 01 00 00 00 14 00 00' + '00 01 00 00 00 0A 00 00 00 03 00 00 00 14 00 00 00 01 00 00 00 05 00 00 00 03 00 00 00 02 00 00' + '00 05 00 00 00 02 00 00 00 07 00 00 00 02 00 00 00 09 00 00 00 02 00 00 00 0B 00 00 00 02 00 00' + '00 0D 00 00 00 02 00 00 00 0F 00 00 00 02 00 00 00 11 00 00 00 02 00 00 00 FF FF FF FF 02 00 00' + '00 14 00 00 00 01 00 00 00 1E 00 00 00 01 00 00 00 28 00 00 00 01 00 00 00 32 00 00 00 01 00 00' + '00 3C 00 00 00 01 00 00 00 46 00 00 00 01 00 00 00 50 00 00 00 01 00 00 00 5A 00 00 00 01 00 00' + '00 10 27 00 00 01 00 00 00 11 00 00 00 01 00 00 00 12 00 00 00 01 00 00 00 13 00 00 00 01 00 00' + '00 01 00 00 00 07 00 00 00 01 00 00 00 09 00 00 00 01 00 00 00 03 00 00 00 02 00 00 00 03 00 00' + '00 02 00 00 00 05 00 00 00 03 00 00 00 05 00 00 00 04 00 00 00 05 00 00 00 01 00 00 00 06 00 00' + '00 05 00 00 00 06 00 00 00 03 00 00 00 08 00 00 00 05 00 00 00 08 00 00 00 07 00 00 00 08 00 00' + '00 0B 00 00 00 01 00 00 00 0C 00 00 00 01 00 00 00 F4 01 00 00 01 00 00 00 88 13 00 00 01 00 00' + '00 50 C3 00 00 01 00 00 00 A0 86 01 00 01 00 00 00 0D 00 00 00 01 00 00 00 0E 00 00 00 01 00 00' + '00 0F 00 00 00 01 00 00 00 15 00 00 00 01 00 00 00 16 00 00 00 01 00 00 00 17 00 00 00 01 00 00' + '00 18 00 00 00 01 00 00 00 19 00 00 00 01 00 00 00 1A 00 00 00 01 00 00 00 1B 00 00 00 01 00 00' + '00 1C 00 00 00 01 00 00 00 1D 00 00 00 01 00 00 00 1F 00 00 00 01 00 00 00 20 00 00 00 01 00 00' + '00 21 00 00 00 01 00 00 00 22 00 00 00 01 00 00 00 23 00 00 00 01 00 00 00 24 00 00 00 01 00 00' + '00 25 00 00 00 01 00 00 00 26 00 00 00 01 00 00 00 27 00 00 00 01 00 00 00 29 00 00 00 01 00 00' + '00 2A 00 00 00 01 00 00 00 2B 00 00 00 01 00 00 00 2C 00 00 00 01 00 00 00 2D 00 00 00 01 00 00' + '00 2E 00 00 00 01 00 00 00 2F 00 00 00 01 00 00 00 30 00 00 00 01 00 00 00 31 00 00 00 01 00 00' + '00 C8 00 00 00 01 00 00 00 2C 01 00 00 01 00 00 00 90 01 00 00 01 00 00 00 58 02 00 00 01 00 00' + '00 BC 02 00 00 01 00 00 00 20 03 00 00 01 00 00 00 84 03 00 00 01 00 00 00 D0 07 00 00 01 00 00' + '00 B8 0B 00 00 01 00 00 00 A0 0F 00 00 01 00 00 00 70 17 00 00 01 00 00 00 58 1B 00 00 01 00 00' + '00 40 1F 00 00 01 00 00 00 28 23 00 00 01 00 00 00 20 4E 00 00 01 00 00 00 30 75 00 00 01 00 00' + '00 40 9C 00 00 01 00 00 00 60 EA 00 00 01 00 00 00 70 11 01 00 01 00 00 00 80 38 01 00 01 00 00' + '00 90 5F 01 00 01 00 00 00 0B 00 00 00 0C 00 00 00 40 0D 03 00 01 00 00 00 E0 93 04 00 01 00 00' + '00 80 1A 06 00 01 00 00 00 20 A1 07 00 01 00 00 00 C0 27 09 00 01 00 00 00 60 AE 0A 00 01 00 00' + '00 00 35 0C 00 01 00 00 00 A0 BB 0D 00 01 00 00 00 01 00 00 00 0C 00 00 00 02 00 00 00 0C 00 00' + '00 03 00 00 00 0C 00 00 00 04 00 00 00 0C 00 00 00 05 00 00 00 0C 00 00 00 06 00 00 00 0C 00 00' + '00 07 00 00 00 0C 00 00 00 08 00 00 00 0C 00 00 00 09 00 00 00 0C 00 00 00 0A 00 00 00 0C 00 00' + '00 01 00 00 00 40 01 00 00 01 00 00 00 50 00 00 00 01 00 00 00 40 00 00 00 01 00 00 00 20 00 00' + '00 03 00 00 00 40 00 00 00 C0 4B 03 00 01 00 00 00 80 97 06 00 01 00 00 00 40 42 0F 00 01 00 00' + '00 00 E1 F5 05 01 00 00 00 00 E4 0B 54 01 00 00 00 00 10 A5 D4 01 00 00 00 80 96 98 00 01 00 00' + '00 00 2D 31 01 01 00 00 00 FD 06 00 00 30 00 00 00 31 00 00 01 32 00 00 02 33 00 00 03 34 00 00' + '04 35 00 00 05 36 00 00 06 37 00 00 07 38 00 00 08 39 00 00 09 B2 00 00 02 B3 00 00 03 B9 00 00' + '01 BC 00 00 0A BD 00 00 0B BE 00 00 0C 60 06 00 00 61 06 00 01 62 06 00 02 63 06 00 03 64 06 00' + '04 65 06 00 05 66 06 00 06 67 06 00 07 68 06 00 08 69 06 00 09 F0 06 00 00 F1 06 00 01 F2 06 00' + '02 F3 06 00 03 F4 06 00 04 F5 06 00 05 F6 06 00 06 F7 06 00 07 F8 06 00 08 F9 06 00 09 C0 07 00' + '00 C1 07 00 01 C2 07 00 02 C3 07 00 03 C4 07 00 04 C5 07 00 05 C6 07 00 06 C7 07 00 07 C8 07 00' + '08 C9 07 00 09 66 09 00 00 67 09 00 01 68 09 00 02 69 09 00 03 6A 09 00 04 6B 09 00 05 6C 09 00' + '06 6D 09 00 07 6E 09 00 08 6F 09 00 09 E6 09 00 00 E7 09 00 01 E8 09 00 02 E9 09 00 03 EA 09 00' + '04 EB 09 00 05 EC 09 00 06 ED 09 00 07 EE 09 00 08 EF 09 00 09 F4 09 00 0D F5 09 00 0E F6 09 00' + '0F F7 09 00 0A F8 09 00 0C F9 09 00 10 66 0A 00 00 67 0A 00 01 68 0A 00 02 69 0A 00 03 6A 0A 00' + '04 6B 0A 00 05 6C 0A 00 06 6D 0A 00 07 6E 0A 00 08 6F 0A 00 09 E6 0A 00 00 E7 0A 00 01 E8 0A 00' + '02 E9 0A 00 03 EA 0A 00 04 EB 0A 00 05 EC 0A 00 06 ED 0A 00 07 EE 0A 00 08 EF 0A 00 09 66 0B 00' + '00 67 0B 00 01 68 0B 00 02 69 0B 00 03 6A 0B 00 04 6B 0B 00 05 6C 0B 00 06 6D 0B 00 07 6E 0B 00' + '08 6F 0B 00 09 72 0B 00 0A 73 0B 00 0B 74 0B 00 0C 75 0B 00 0D 76 0B 00 0E 77 0B 00 0F E6 0B 00' + '00 E7 0B 00 01 E8 0B 00 02 E9 0B 00 03 EA 0B 00 04 EB 0B 00 05 EC 0B 00 06 ED 0B 00 07 EE 0B 00' + '08 EF 0B 00 09 F0 0B 00 11 F1 0B 00 12 F2 0B 00 13 66 0C 00 00 67 0C 00 01 68 0C 00 02 69 0C 00' + '03 6A 0C 00 04 6B 0C 00 05 6C 0C 00 06 6D 0C 00 07 6E 0C 00 08 6F 0C 00 09 78 0C 00 00 79 0C 00' + '01 7A 0C 00 02 7B 0C 00 03 7C 0C 00 01 7D 0C 00 02 7E 0C 00 03 E6 0C 00 00 E7 0C 00 01 E8 0C 00' + '02 E9 0C 00 03 EA 0C 00 04 EB 0C 00 05 EC 0C 00 06 ED 0C 00 07 EE 0C 00 08 EF 0C 00 09 58 0D 00' + '14 59 0D 00 15 5A 0D 00 16 5B 0D 00 17 5C 0D 00 18 5D 0D 00 19 5E 0D 00 1A 66 0D 00 00 67 0D 00' + '01 68 0D 00 02 69 0D 00 03 6A 0D 00 04 6B 0D 00 05 6C 0D 00 06 6D 0D 00 07 6E 0D 00 08 6F 0D 00' + '09 70 0D 00 11 71 0D 00 12 72 0D 00 13 73 0D 00 0A 74 0D 00 0B 75 0D 00 0C 76 0D 00 0D 77 0D 00' + '0E 78 0D 00 0F E6 0D 00 00 E7 0D 00 01 E8 0D 00 02 E9 0D 00 03 EA 0D 00 04 EB 0D 00 05 EC 0D 00' + '06 ED 0D 00 07 EE 0D 00 08 EF 0D 00 09 50 0E 00 00 51 0E 00 01 52 0E 00 02 53 0E 00 03 54 0E 00' + '04 55 0E 00 05 56 0E 00 06 57 0E 00 07 58 0E 00 08 59 0E 00 09 D0 0E 00 00 D1 0E 00 01 D2 0E 00' + '02 D3 0E 00 03 D4 0E 00 04 D5 0E 00 05 D6 0E 00 06 D7 0E 00 07 D8 0E 00 08 D9 0E 00 09 20 0F 00' + '00 21 0F 00 01 22 0F 00 02 23 0F 00 03 24 0F 00 04 25 0F 00 05 26 0F 00 06 27 0F 00 07 28 0F 00' + '08 29 0F 00 09 2A 0F 00 0B 2B 0F 00 1B 2C 0F 00 1C 2D 0F 00 1D 2E 0F 00 1E 2F 0F 00 1F 30 0F 00' + '20 31 0F 00 21 32 0F 00 22 33 0F 00 23 40 10 00 00 41 10 00 01 42 10 00 02 43 10 00 03 44 10 00' + '04 45 10 00 05 46 10 00 06 47 10 00 07 48 10 00 08 49 10 00 09 90 10 00 00 91 10 00 01 92 10 00' + '02 93 10 00 03 94 10 00 04 95 10 00 05 96 10 00 06 97 10 00 07 98 10 00 08 99 10 00 09 69 13 00' + '01 6A 13 00 02 6B 13 00 03 6C 13 00 04 6D 13 00 05 6E 13 00 06 6F 13 00 07 70 13 00 08 71 13 00' + '09 72 13 00 11 73 13 00 24 74 13 00 25 75 13 00 26 76 13 00 27 77 13 00 28 78 13 00 29 79 13 00' + '2A 7A 13 00 2B 7B 13 00 12 7C 13 00 2C EE 16 00 2D EF 16 00 2E F0 16 00 2F E0 17 00 00 E1 17 00' + '01 E2 17 00 02 E3 17 00 03 E4 17 00 04 E5 17 00 05 E6 17 00 06 E7 17 00 07 E8 17 00 08 E9 17 00' + '09 F0 17 00 00 F1 17 00 01 F2 17 00 02 F3 17 00 03 F4 17 00 04 F5 17 00 05 F6 17 00 06 F7 17 00' + '07 F8 17 00 08 F9 17 00 09 10 18 00 00 11 18 00 01 12 18 00 02 13 18 00 03 14 18 00 04 15 18 00' + '05 16 18 00 06 17 18 00 07 18 18 00 08 19 18 00 09 46 19 00 00 47 19 00 01 48 19 00 02 49 19 00' + '03 4A 19 00 04 4B 19 00 05 4C 19 00 06 4D 19 00 07 4E 19 00 08 4F 19 00 09 D0 19 00 00 D1 19 00' + '01 D2 19 00 02 D3 19 00 03 D4 19 00 04 D5 19 00 05 D6 19 00 06 D7 19 00 07 D8 19 00 08 D9 19 00' + '09 DA 19 00 01 80 1A 00 00 81 1A 00 01 82 1A 00 02 83 1A 00 03 84 1A 00 04 85 1A 00 05 86 1A 00' + '06 87 1A 00 07 88 1A 00 08 89 1A 00 09 90 1A 00 00 91 1A 00 01 92 1A 00 02 93 1A 00 03 94 1A 00' + '04 95 1A 00 05 96 1A 00 06 97 1A 00 07 98 1A 00 08 99 1A 00 09 50 1B 00 00 51 1B 00 01 52 1B 00' + '02 53 1B 00 03 54 1B 00 04 55 1B 00 05 56 1B 00 06 57 1B 00 07 58 1B 00 08 59 1B 00 09 B0 1B 00' + '00 B1 1B 00 01 B2 1B 00 02 B3 1B 00 03 B4 1B 00 04 B5 1B 00 05 B6 1B 00 06 B7 1B 00 07 B8 1B 00' + '08 B9 1B 00 09 40 1C 00 00 41 1C 00 01 42 1C 00 02 43 1C 00 03 44 1C 00 04 45 1C 00 05 46 1C 00' + '06 47 1C 00 07 48 1C 00 08 49 1C 00 09 50 1C 00 00 51 1C 00 01 52 1C 00 02 53 1C 00 03 54 1C 00' + '04 55 1C 00 05 56 1C 00 06 57 1C 00 07 58 1C 00 08 59 1C 00 09 70 20 00 00 74 20 00 04 75 20 00' + '05 76 20 00 06 77 20 00 07 78 20 00 08 79 20 00 09 80 20 00 00 81 20 00 01 82 20 00 02 83 20 00' + '03 84 20 00 04 85 20 00 05 86 20 00 06 87 20 00 07 88 20 00 08 89 20 00 09 50 21 00 30 51 21 00' + '31 52 21 00 18 53 21 00 32 54 21 00 33 55 21 00 1A 56 21 00 34 57 21 00 35 58 21 00 36 59 21 00' + '37 5A 21 00 38 5B 21 00 0E 5C 21 00 39 5D 21 00 3A 5E 21 00 3B 5F 21 00 01 60 21 00 01 61 21 00' + '02 62 21 00 03 63 21 00 04 64 21 00 05 65 21 00 06 66 21 00 07 67 21 00 08 68 21 00 09 69 21 00' + '11 6A 21 00 3C 6B 21 00 3D 6C 21 00 27 6D 21 00 12 6E 21 00 3E 6F 21 00 13 70 21 00 01 71 21 00' + '02 72 21 00 03 73 21 00 04 74 21 00 05 75 21 00 06 76 21 00 07 77 21 00 08 78 21 00 09 79 21 00' + '11 7A 21 00 3C 7B 21 00 3D 7C 21 00 27 7D 21 00 12 7E 21 00 3E 7F 21 00 13 80 21 00 13 81 21 00' + '3F 82 21 00 2C 85 21 00 06 86 21 00 27 87 21 00 40 88 21 00 41 89 21 00 00 60 24 00 01 61 24 00' + '02 62 24 00 03 63 24 00 04 64 24 00 05 65 24 00 06 66 24 00 07 67 24 00 08 68 24 00 09 69 24 00' + '11 6A 24 00 3C 6B 24 00 3D 6C 24 00 42 6D 24 00 43 6E 24 00 44 6F 24 00 10 70 24 00 2D 71 24 00' + '2E 72 24 00 2F 73 24 00 24 74 24 00 01 75 24 00 02 76 24 00 03 77 24 00 04 78 24 00 05 79 24 00' + '06 7A 24 00 07 7B 24 00 08 7C 24 00 09 7D 24 00 11 7E 24 00 3C 7F 24 00 3D 80 24 00 42 81 24 00' + '43 82 24 00 44 83 24 00 10 84 24 00 2D 85 24 00 2E 86 24 00 2F 87 24 00 24 88 24 00 01 89 24 00' + '02 8A 24 00 03 8B 24 00 04 8C 24 00 05 8D 24 00 06 8E 24 00 07 8F 24 00 08 90 24 00 09 91 24 00' + '11 92 24 00 3C 93 24 00 3D 94 24 00 42 95 24 00 43 96 24 00 44 97 24 00 10 98 24 00 2D 99 24 00' + '2E 9A 24 00 2F 9B 24 00 24 EA 24 00 00 EB 24 00 3C EC 24 00 3D ED 24 00 42 EE 24 00 43 EF 24 00' + '44 F0 24 00 10 F1 24 00 2D F2 24 00 2E F3 24 00 2F F4 24 00 24 F5 24 00 01 F6 24 00 02 F7 24 00' + '03 F8 24 00 04 F9 24 00 05 FA 24 00 06 FB 24 00 07 FC 24 00 08 FD 24 00 09 FE 24 00 11 FF 24 00' + '00 76 27 00 01 77 27 00 02 78 27 00 03 79 27 00 04 7A 27 00 05 7B 27 00 06 7C 27 00 07 7D 27 00' + '08 7E 27 00 09 7F 27 00 11 80 27 00 01 81 27 00 02 82 27 00 03 83 27 00 04 84 27 00 05 85 27 00' + '06 86 27 00 07 87 27 00 08 88 27 00 09 89 27 00 11 8A 27 00 01 8B 27 00 02 8C 27 00 03 8D 27 00' + '04 8E 27 00 05 8F 27 00 06 90 27 00 07 91 27 00 08 92 27 00 09 93 27 00 11 FD 2C 00 0B 07 30 00' + '00 21 30 00 01 22 30 00 02 23 30 00 03 24 30 00 04 25 30 00 05 26 30 00 06 27 30 00 07 28 30 00' + '08 29 30 00 09 38 30 00 11 39 30 00 24 3A 30 00 25 92 31 00 01 93 31 00 02 94 31 00 03 95 31 00' + '04 20 32 00 01 21 32 00 02 22 32 00 03 23 32 00 04 24 32 00 05 25 32 00 06 26 32 00 07 27 32 00' + '08 28 32 00 09 29 32 00 11 48 32 00 11 49 32 00 24 4A 32 00 25 4B 32 00 26 4C 32 00 27 4D 32 00' + '28 4E 32 00 29 4F 32 00 2A 51 32 00 45 52 32 00 46 53 32 00 47 54 32 00 48 55 32 00 49 56 32 00' + '4A 57 32 00 4B 58 32 00 4C 59 32 00 4D 5A 32 00 25 5B 32 00 4E 5C 32 00 4F 5D 32 00 50 5E 32 00' + '51 5F 32 00 52 80 32 00 01 81 32 00 02 82 32 00 03 83 32 00 04 84 32 00 05 85 32 00 06 86 32 00' + '07 87 32 00 08 88 32 00 09 89 32 00 11 B1 32 00 53 B2 32 00 54 B3 32 00 55 B4 32 00 56 B5 32 00' + '26 B6 32 00 57 B7 32 00 58 B8 32 00 59 B9 32 00 5A BA 32 00 5B BB 32 00 5C BC 32 00 5D BD 32 00' + '5E BE 32 00 5F BF 32 00 27 20 A6 00 00 21 A6 00 01 22 A6 00 02 23 A6 00 03 24 A6 00 04 25 A6 00' + '05 26 A6 00 06 27 A6 00 07 28 A6 00 08 29 A6 00 09 E6 A6 00 01 E7 A6 00 02 E8 A6 00 03 E9 A6 00' + '04 EA A6 00 05 EB A6 00 06 EC A6 00 07 ED A6 00 08 EE A6 00 09 EF A6 00 00 30 A8 00 0A 31 A8 00' + '0B 32 A8 00 0C 33 A8 00 0D 34 A8 00 0E 35 A8 00 0F D0 A8 00 00 D1 A8 00 01 D2 A8 00 02 D3 A8 00' + '03 D4 A8 00 04 D5 A8 00 05 D6 A8 00 06 D7 A8 00 07 D8 A8 00 08 D9 A8 00 09 00 A9 00 00 01 A9 00' + '01 02 A9 00 02 03 A9 00 03 04 A9 00 04 05 A9 00 05 06 A9 00 06 07 A9 00 07 08 A9 00 08 09 A9 00' + '09 D0 A9 00 00 D1 A9 00 01 D2 A9 00 02 D3 A9 00 03 D4 A9 00 04 D5 A9 00 05 D6 A9 00 06 D7 A9 00' + '07 D8 A9 00 08 D9 A9 00 09 F0 A9 00 00 F1 A9 00 01 F2 A9 00 02 F3 A9 00 03 F4 A9 00 04 F5 A9 00' + '05 F6 A9 00 06 F7 A9 00 07 F8 A9 00 08 F9 A9 00 09 50 AA 00 00 51 AA 00 01 52 AA 00 02 53 AA 00' + '03 54 AA 00 04 55 AA 00 05 56 AA 00 06 57 AA 00 07 58 AA 00 08 59 AA 00 09 F0 AB 00 00 F1 AB 00' + '01 F2 AB 00 02 F3 AB 00 03 F4 AB 00 04 F5 AB 00 05 F6 AB 00 06 F7 AB 00 07 F8 AB 00 08 F9 AB 00' + '09 6B F9 00 03 73 F9 00 11 78 F9 00 02 B2 F9 00 00 D1 F9 00 06 D3 F9 00 06 FD F9 00 11 10 FF 00' + '00 11 FF 00 01 12 FF 00 02 13 FF 00 03 14 FF 00 04 15 FF 00 05 16 FF 00 06 17 FF 00 07 18 FF 00' + '08 19 FF 00 09 07 01 01 01 08 01 01 02 09 01 01 03 0A 01 01 04 0B 01 01 05 0C 01 01 06 0D 01 01' + '07 0E 01 01 08 0F 01 01 09 10 01 01 11 11 01 01 24 12 01 01 25 13 01 01 26 14 01 01 27 15 01 01' + '28 16 01 01 29 17 01 01 2A 18 01 01 2B 19 01 01 12 1A 01 01 60 1B 01 01 61 1C 01 01 62 1D 01 01' + '3E 1E 01 01 63 1F 01 01 64 20 01 01 65 21 01 01 66 22 01 01 13 23 01 01 67 24 01 01 68 25 01 01' + '69 26 01 01 3F 27 01 01 6A 28 01 01 6B 29 01 01 6C 2A 01 01 6D 2B 01 01 2C 2C 01 01 6E 2D 01 01' + '6F 2E 01 01 70 2F 01 01 40 30 01 01 71 31 01 01 72 32 01 01 73 33 01 01 74 40 01 01 0A 41 01 01' + '0B 42 01 01 01 43 01 01 05 44 01 01 27 45 01 01 3E 46 01 01 3F 47 01 01 40 48 01 01 05 49 01 01' + '11 4A 01 01 27 4B 01 01 12 4C 01 01 3E 4D 01 01 13 4E 01 01 3F 4F 01 01 05 50 01 01 11 51 01 01' + '27 52 01 01 12 53 01 01 3E 54 01 01 13 55 01 01 2C 56 01 01 40 57 01 01 11 58 01 01 01 59 01 01' + '01 5A 01 01 01 5B 01 01 02 5C 01 01 02 5D 01 01 02 5E 01 01 02 5F 01 01 05 60 01 01 11 61 01 01' + '11 62 01 01 11 63 01 01 11 64 01 01 11 65 01 01 25 66 01 01 27 67 01 01 27 68 01 01 27 69 01 01' + '27 6A 01 01 12 6B 01 01 61 6C 01 01 3E 6D 01 01 3E 6E 01 01 3E 6F 01 01 3E 70 01 01 3E 71 01 01' + '13 72 01 01 3F 73 01 01 05 74 01 01 27 75 01 01 0B 76 01 01 0B 77 01 01 33 78 01 01 0C 8A 01 01' + '00 8B 01 01 0A E1 02 01 01 E2 02 01 02 E3 02 01 03 E4 02 01 04 E5 02 01 05 E6 02 01 06 E7 02 01' + '07 E8 02 01 08 E9 02 01 09 EA 02 01 11 EB 02 01 24 EC 02 01 25 ED 02 01 26 EE 02 01 27 EF 02 01' + '28 F0 02 01 29 F1 02 01 2A F2 02 01 2B F3 02 01 12 F4 02 01 60 F5 02 01 61 F6 02 01 62 F7 02 01' + '3E F8 02 01 63 F9 02 01 64 FA 02 01 65 FB 02 01 66 20 03 01 01 21 03 01 05 22 03 01 11 23 03 01' + '27 41 03 01 2B 4A 03 01 66 D1 03 01 01 D2 03 01 02 D3 03 01 11 D4 03 01 24 D5 03 01 12 A0 04 01' + '00 A1 04 01 01 A2 04 01 02 A3 04 01 03 A4 04 01 04 A5 04 01 05 A6 04 01 06 A7 04 01 07 A8 04 01' + '08 A9 04 01 09 58 08 01 01 59 08 01 02 5A 08 01 03 5B 08 01 11 5C 08 01 24 5D 08 01 12 5E 08 01' + '13 5F 08 01 2C 79 08 01 01 7A 08 01 02 7B 08 01 03 7C 08 01 04 7D 08 01 05 7E 08 01 11 7F 08 01' + '24 A7 08 01 01 A8 08 01 02 A9 08 01 03 AA 08 01 04 AB 08 01 04 AC 08 01 05 AD 08 01 11 AE 08 01' + '24 AF 08 01 12 FB 08 01 01 FC 08 01 05 FD 08 01 11 FE 08 01 24 FF 08 01 12 16 09 01 01 17 09 01' + '11 18 09 01 24 19 09 01 12 1A 09 01 02 1B 09 01 03 BC 09 01 75 BD 09 01 0B C0 09 01 01 C1 09 01' + '02 C2 09 01 03 C3 09 01 04 C4 09 01 05 C5 09 01 06 C6 09 01 07 C7 09 01 08 C8 09 01 09 C9 09 01' + '11 CA 09 01 24 CB 09 01 25 CC 09 01 26 CD 09 01 27 CE 09 01 28 CF 09 01 29 D2 09 01 12 D3 09 01' + '60 D4 09 01 61 D5 09 01 62 D6 09 01 3E D7 09 01 63 D8 09 01 64 D9 09 01 65 DA 09 01 66 DB 09 01' + '13 DC 09 01 67 DD 09 01 68 DE 09 01 69 DF 09 01 3F E0 09 01 6A E1 09 01 6B E2 09 01 6C E3 09 01' + '6D E4 09 01 2C E5 09 01 6E E6 09 01 6F E7 09 01 70 E8 09 01 40 E9 09 01 71 EA 09 01 72 EB 09 01' + '73 EC 09 01 74 ED 09 01 41 EE 09 01 76 EF 09 01 77 F0 09 01 78 F1 09 01 79 F2 09 01 7A F3 09 01' + '7B F4 09 01 7C F5 09 01 7D F6 09 01 7E F7 09 01 7F F8 09 01 80 F9 09 01 81 FA 09 01 82 FB 09 01' + '83 FC 09 01 84 FD 09 01 85 FE 09 01 86 FF 09 01 87 40 0A 01 01 41 0A 01 02 42 0A 01 03 43 0A 01' + '04 44 0A 01 11 45 0A 01 24 46 0A 01 12 47 0A 01 13 48 0A 01 0B 7D 0A 01 01 7E 0A 01 27 9D 0A 01' + '01 9E 0A 01 11 9F 0A 01 24 EB 0A 01 01 EC 0A 01 05 ED 0A 01 11 EE 0A 01 24 EF 0A 01 12 58 0B 01' + '01 59 0B 01 02 5A 0B 01 03 5B 0B 01 04 5C 0B 01 11 5D 0B 01 24 5E 0B 01 12 5F 0B 01 13 78 0B 01' + '01 79 0B 01 02 7A 0B 01 03 7B 0B 01 04 7C 0B 01 11 7D 0B 01 24 7E 0B 01 12 7F 0B 01 13 A9 0B 01' + '01 AA 0B 01 02 AB 0B 01 03 AC 0B 01 04 AD 0B 01 11 AE 0B 01 24 AF 0B 01 12 FA 0C 01 01 FB 0C 01' + '05 FC 0C 01 11 FD 0C 01 27 FE 0C 01 12 FF 0C 01 13 30 0D 01 00 31 0D 01 01 32 0D 01 02 33 0D 01' + '03 34 0D 01 04 35 0D 01 05 36 0D 01 06 37 0D 01 07 38 0D 01 08 39 0D 01 09 60 0E 01 01 61 0E 01' + '02 62 0E 01 03 63 0E 01 04 64 0E 01 05 65 0E 01 06 66 0E 01 07 67 0E 01 08 68 0E 01 09 69 0E 01' + '11 6A 0E 01 24 6B 0E 01 25 6C 0E 01 26 6D 0E 01 27 6E 0E 01 28 6F 0E 01 29 70 0E 01 2A 71 0E 01' + '2B 72 0E 01 12 73 0E 01 60 74 0E 01 61 75 0E 01 62 76 0E 01 3E 77 0E 01 63 78 0E 01 64 79 0E 01' + '65 7A 0E 01 66 7B 0E 01 0B 7C 0E 01 0A 7D 0E 01 32 7E 0E 01 33 1D 0F 01 01 1E 0F 01 02 1F 0F 01' + '03 20 0F 01 04 21 0F 01 05 22 0F 01 11 23 0F 01 24 24 0F 01 25 25 0F 01 12 26 0F 01 0B 51 0F 01' + '01 52 0F 01 11 53 0F 01 24 54 0F 01 12 C5 0F 01 01 C6 0F 01 02 C7 0F 01 03 C8 0F 01 04 C9 0F 01' + '11 CA 0F 01 24 CB 0F 01 12 52 10 01 01 53 10 01 02 54 10 01 03 55 10 01 04 56 10 01 05 57 10 01' + '06 58 10 01 07 59 10 01 08 5A 10 01 09 5B 10 01 11 5C 10 01 24 5D 10 01 25 5E 10 01 26 5F 10 01' + '27 60 10 01 28 61 10 01 29 62 10 01 2A 63 10 01 2B 64 10 01 12 65 10 01 13 66 10 01 00 67 10 01' + '01 68 10 01 02 69 10 01 03 6A 10 01 04 6B 10 01 05 6C 10 01 06 6D 10 01 07 6E 10 01 08 6F 10 01' + '09 F0 10 01 00 F1 10 01 01 F2 10 01 02 F3 10 01 03 F4 10 01 04 F5 10 01 05 F6 10 01 06 F7 10 01' + '07 F8 10 01 08 F9 10 01 09 36 11 01 00 37 11 01 01 38 11 01 02 39 11 01 03 3A 11 01 04 3B 11 01' + '05 3C 11 01 06 3D 11 01 07 3E 11 01 08 3F 11 01 09 D0 11 01 00 D1 11 01 01 D2 11 01 02 D3 11 01' + '03 D4 11 01 04 D5 11 01 05 D6 11 01 06 D7 11 01 07 D8 11 01 08 D9 11 01 09 E1 11 01 01 E2 11 01' + '02 E3 11 01 03 E4 11 01 04 E5 11 01 05 E6 11 01 06 E7 11 01 07 E8 11 01 08 E9 11 01 09 EA 11 01' + '11 EB 11 01 24 EC 11 01 25 ED 11 01 26 EE 11 01 27 EF 11 01 28 F0 11 01 29 F1 11 01 2A F2 11 01' + '2B F3 11 01 12 F4 11 01 13 F0 12 01 00 F1 12 01 01 F2 12 01 02 F3 12 01 03 F4 12 01 04 F5 12 01' + '05 F6 12 01 06 F7 12 01 07 F8 12 01 08 F9 12 01 09 50 14 01 00 51 14 01 01 52 14 01 02 53 14 01' + '03 54 14 01 04 55 14 01 05 56 14 01 06 57 14 01 07 58 14 01 08 59 14 01 09 D0 14 01 00 D1 14 01' + '01 D2 14 01 02 D3 14 01 03 D4 14 01 04 D5 14 01 05 D6 14 01 06 D7 14 01 07 D8 14 01 08 D9 14 01' + '09 50 16 01 00 51 16 01 01 52 16 01 02 53 16 01 03 54 16 01 04 55 16 01 05 56 16 01 06 57 16 01' + '07 58 16 01 08 59 16 01 09 C0 16 01 00 C1 16 01 01 C2 16 01 02 C3 16 01 03 C4 16 01 04 C5 16 01' + '05 C6 16 01 06 C7 16 01 07 C8 16 01 08 C9 16 01 09 30 17 01 00 31 17 01 01 32 17 01 02 33 17 01' + '03 34 17 01 04 35 17 01 05 36 17 01 06 37 17 01 07 38 17 01 08 39 17 01 09 3A 17 01 11 3B 17 01' + '24 E0 18 01 00 E1 18 01 01 E2 18 01 02 E3 18 01 03 E4 18 01 04 E5 18 01 05 E6 18 01 06 E7 18 01' + '07 E8 18 01 08 E9 18 01 09 EA 18 01 11 EB 18 01 24 EC 18 01 25 ED 18 01 26 EE 18 01 27 EF 18 01' + '28 F0 18 01 29 F1 18 01 2A F2 18 01 2B 50 19 01 00 51 19 01 01 52 19 01 02 53 19 01 03 54 19 01' + '04 55 19 01 05 56 19 01 06 57 19 01 07 58 19 01 08 59 19 01 09 50 1C 01 00 51 1C 01 01 52 1C 01' + '02 53 1C 01 03 54 1C 01 04 55 1C 01 05 56 1C 01 06 57 1C 01 07 58 1C 01 08 59 1C 01 09 5A 1C 01' + '01 5B 1C 01 02 5C 1C 01 03 5D 1C 01 04 5E 1C 01 05 5F 1C 01 06 60 1C 01 07 61 1C 01 08 62 1C 01' + '09 63 1C 01 11 64 1C 01 24 65 1C 01 25 66 1C 01 26 67 1C 01 27 68 1C 01 28 69 1C 01 29 6A 1C 01' + '2A 6B 1C 01 2B 6C 1C 01 12 50 1D 01 00 51 1D 01 01 52 1D 01 02 53 1D 01 03 54 1D 01 04 55 1D 01' + '05 56 1D 01 06 57 1D 01 07 58 1D 01 08 59 1D 01 09 A0 1D 01 00 A1 1D 01 01 A2 1D 01 02 A3 1D 01' + '03 A4 1D 01 04 A5 1D 01 05 A6 1D 01 06 A7 1D 01 07 A8 1D 01 08 A9 1D 01 09 C0 1F 01 88 C1 1F 01' + '14 C2 1F 01 89 C3 1F 01 8A C4 1F 01 15 C5 1F 01 8B C6 1F 01 16 C7 1F 01 8C C8 1F 01 17 C9 1F 01' + '0D CA 1F 01 0D CB 1F 01 18 CC 1F 01 0E CD 1F 01 19 CE 1F 01 0F CF 1F 01 1A D0 1F 01 0A D1 1F 01' + '0B D2 1F 01 0B D3 1F 01 0C D4 1F 01 88 00 24 01 02 01 24 01 03 02 24 01 04 03 24 01 05 04 24 01' + '06 05 24 01 07 06 24 01 08 07 24 01 09 08 24 01 03 09 24 01 04 0A 24 01 05 0B 24 01 06 0C 24 01' + '07 0D 24 01 08 0E 24 01 09 0F 24 01 04 10 24 01 05 11 24 01 06 12 24 01 07 13 24 01 08 14 24 01' + '09 15 24 01 01 16 24 01 02 17 24 01 03 18 24 01 04 19 24 01 05 1A 24 01 06 1B 24 01 07 1C 24 01' + '08 1D 24 01 09 1E 24 01 01 1F 24 01 02 20 24 01 03 21 24 01 04 22 24 01 05 23 24 01 02 24 24 01' + '03 25 24 01 03 26 24 01 04 27 24 01 05 28 24 01 06 29 24 01 07 2A 24 01 08 2B 24 01 09 2C 24 01' + '01 2D 24 01 02 2E 24 01 03 2F 24 01 03 30 24 01 04 31 24 01 05 32 24 01 8D 33 24 01 8E 34 24 01' + '01 35 24 01 02 36 24 01 03 37 24 01 03 38 24 01 04 39 24 01 05 3A 24 01 03 3B 24 01 03 3C 24 01' + '04 3D 24 01 04 3E 24 01 04 3F 24 01 04 40 24 01 06 41 24 01 07 42 24 01 07 43 24 01 07 44 24 01' + '08 45 24 01 08 46 24 01 09 47 24 01 09 48 24 01 09 49 24 01 09 4A 24 01 02 4B 24 01 03 4C 24 01' + '04 4D 24 01 05 4E 24 01 06 4F 24 01 01 50 24 01 02 51 24 01 03 52 24 01 04 53 24 01 04 54 24 01' + '05 55 24 01 05 56 24 01 02 57 24 01 03 58 24 01 01 59 24 01 02 5A 24 01 32 5B 24 01 33 5C 24 01' + '38 5D 24 01 32 5E 24 01 33 5F 24 01 0E 60 24 01 0A 61 24 01 37 62 24 01 0A 63 24 01 0A 64 24 01' + '0B 65 24 01 32 66 24 01 33 67 24 01 26 68 24 01 27 69 24 01 04 6A 24 01 05 6B 24 01 06 6C 24 01' + '07 6D 24 01 08 6E 24 01 09 60 6A 01 00 61 6A 01 01 62 6A 01 02 63 6A 01 03 64 6A 01 04 65 6A 01' + '05 66 6A 01 06 67 6A 01 07 68 6A 01 08 69 6A 01 09 50 6B 01 00 51 6B 01 01 52 6B 01 02 53 6B 01' + '03 54 6B 01 04 55 6B 01 05 56 6B 01 06 57 6B 01 07 58 6B 01 08 59 6B 01 09 5B 6B 01 11 5C 6B 01' + '12 5D 6B 01 2C 5E 6B 01 8F 5F 6B 01 90 60 6B 01 91 61 6B 01 92 80 6E 01 00 81 6E 01 01 82 6E 01' + '02 83 6E 01 03 84 6E 01 04 85 6E 01 05 86 6E 01 06 87 6E 01 07 88 6E 01 08 89 6E 01 09 8A 6E 01' + '11 8B 6E 01 3C 8C 6E 01 3D 8D 6E 01 42 8E 6E 01 43 8F 6E 01 44 90 6E 01 10 91 6E 01 2D 92 6E 01' + '2E 93 6E 01 2F 94 6E 01 01 95 6E 01 02 96 6E 01 03 E0 D2 01 00 E1 D2 01 01 E2 D2 01 02 E3 D2 01' + '03 E4 D2 01 04 E5 D2 01 05 E6 D2 01 06 E7 D2 01 07 E8 D2 01 08 E9 D2 01 09 EA D2 01 11 EB D2 01' + '3C EC D2 01 3D ED D2 01 42 EE D2 01 43 EF D2 01 44 F0 D2 01 10 F1 D2 01 2D F2 D2 01 2E F3 D2 01' + '2F 60 D3 01 01 61 D3 01 02 62 D3 01 03 63 D3 01 04 64 D3 01 05 65 D3 01 06 66 D3 01 07 67 D3 01' + '08 68 D3 01 09 69 D3 01 11 6A D3 01 24 6B D3 01 25 6C D3 01 26 6D D3 01 27 6E D3 01 28 6F D3 01' + '29 70 D3 01 2A 71 D3 01 2B 72 D3 01 01 73 D3 01 02 74 D3 01 03 75 D3 01 04 76 D3 01 05 77 D3 01' + '01 78 D3 01 05 CE D7 01 00 CF D7 01 01 D0 D7 01 02 D1 D7 01 03 D2 D7 01 04 D3 D7 01 05 D4 D7 01' + '06 D5 D7 01 07 D6 D7 01 08 D7 D7 01 09 D8 D7 01 00 D9 D7 01 01 DA D7 01 02 DB D7 01 03 DC D7 01' + '04 DD D7 01 05 DE D7 01 06 DF D7 01 07 E0 D7 01 08 E1 D7 01 09 E2 D7 01 00 E3 D7 01 01 E4 D7 01' + '02 E5 D7 01 03 E6 D7 01 04 E7 D7 01 05 E8 D7 01 06 E9 D7 01 07 EA D7 01 08 EB D7 01 09 EC D7 01' + '00 ED D7 01 01 EE D7 01 02 EF D7 01 03 F0 D7 01 04 F1 D7 01 05 F2 D7 01 06 F3 D7 01 07 F4 D7 01' + '08 F5 D7 01 09 F6 D7 01 00 F7 D7 01 01 F8 D7 01 02 F9 D7 01 03 FA D7 01 04 FB D7 01 05 FC D7 01' + '06 FD D7 01 07 FE D7 01 08 FF D7 01 09 40 E1 01 00 41 E1 01 01 42 E1 01 02 43 E1 01 03 44 E1 01' + '04 45 E1 01 05 46 E1 01 06 47 E1 01 07 48 E1 01 08 49 E1 01 09 F0 E2 01 00 F1 E2 01 01 F2 E2 01' + '02 F3 E2 01 03 F4 E2 01 04 F5 E2 01 05 F6 E2 01 06 F7 E2 01 07 F8 E2 01 08 F9 E2 01 09 C7 E8 01' + '01 C8 E8 01 02 C9 E8 01 03 CA E8 01 04 CB E8 01 05 CC E8 01 06 CD E8 01 07 CE E8 01 08 CF E8 01' + '09 50 E9 01 00 51 E9 01 01 52 E9 01 02 53 E9 01 03 54 E9 01 04 55 E9 01 05 56 E9 01 06 57 E9 01' + '07 58 E9 01 08 59 E9 01 09 71 EC 01 01 72 EC 01 02 73 EC 01 03 74 EC 01 04 75 EC 01 05 76 EC 01' + '06 77 EC 01 07 78 EC 01 08 79 EC 01 09 7A EC 01 11 7B EC 01 24 7C EC 01 25 7D EC 01 26 7E EC 01' + '27 7F EC 01 28 80 EC 01 29 81 EC 01 2A 82 EC 01 2B 83 EC 01 12 84 EC 01 60 85 EC 01 61 86 EC 01' + '62 87 EC 01 3E 88 EC 01 63 89 EC 01 64 8A EC 01 65 8B EC 01 66 8C EC 01 13 8D EC 01 67 8E EC 01' + '68 8F EC 01 69 90 EC 01 3F 91 EC 01 6A 92 EC 01 6B 93 EC 01 6C 94 EC 01 6D 95 EC 01 2C 96 EC 01' + '6E 97 EC 01 6F 98 EC 01 70 99 EC 01 40 9A EC 01 71 9B EC 01 72 9C EC 01 73 9D EC 01 74 9E EC 01' + '41 9F EC 01 76 A0 EC 01 41 A1 EC 01 93 A2 EC 01 94 A3 EC 01 01 A4 EC 01 02 A5 EC 01 03 A6 EC 01' + '04 A7 EC 01 05 A8 EC 01 06 A9 EC 01 07 AA EC 01 08 AB EC 01 09 AD EC 01 0A AE EC 01 0B AF EC 01' + '0C B1 EC 01 01 B2 EC 01 02 B3 EC 01 2C B4 EC 01 41 01 ED 01 01 02 ED 01 02 03 ED 01 03 04 ED 01' + '04 05 ED 01 05 06 ED 01 06 07 ED 01 07 08 ED 01 08 09 ED 01 09 0A ED 01 11 0B ED 01 24 0C ED 01' + '25 0D ED 01 26 0E ED 01 27 0F ED 01 28 10 ED 01 29 11 ED 01 2A 12 ED 01 2B 13 ED 01 12 14 ED 01' + '60 15 ED 01 61 16 ED 01 62 17 ED 01 3E 18 ED 01 63 19 ED 01 64 1A ED 01 65 1B ED 01 66 1C ED 01' + '13 1D ED 01 67 1E ED 01 68 1F ED 01 69 20 ED 01 3F 21 ED 01 6A 22 ED 01 6B 23 ED 01 6C 24 ED 01' + '6D 25 ED 01 2C 26 ED 01 6E 27 ED 01 6F 28 ED 01 70 29 ED 01 40 2A ED 01 71 2B ED 01 72 2C ED 01' + '73 2D ED 01 74 2F ED 01 02 30 ED 01 03 31 ED 01 04 32 ED 01 05 33 ED 01 06 34 ED 01 07 35 ED 01' + '08 36 ED 01 09 37 ED 01 11 38 ED 01 62 39 ED 01 63 3A ED 01 67 3B ED 01 2C 3C ED 01 0B 3D ED 01' + '37 00 F1 01 00 01 F1 01 00 02 F1 01 01 03 F1 01 02 04 F1 01 03 05 F1 01 04 06 F1 01 05 07 F1 01' + '06 08 F1 01 07 09 F1 01 08 0A F1 01 09 0B F1 01 00 0C F1 01 00 F0 FB 01 00 F1 FB 01 01 F2 FB 01' + '02 F3 FB 01 03 F4 FB 01 04 F5 FB 01 05 F6 FB 01 06 F7 FB 01 07 F8 FB 01 08 F9 FB 01 09 90 F8 02' + '09' +} + + +LANGUAGE 0,0 COMPOSITION UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE +{ + '08 12 00 00 B4 00 00 02 10 20 00 00 01 03 00 84 03 00 02 10 20 00 00 01 03 00 DC 02 00 02 10 20' + '00 00 03 03 00 E3 FF 00 02 0B 20 00 00 04 03 00 AF 00 00 02 10 20 00 00 04 03 00 49 FE 00 02 10' + '20 00 00 05 03 00 3E 20 00 02 10 20 00 00 05 03 00 4A FE 00 02 10 20 00 00 05 03 00 4B FE 00 02' + '10 20 00 00 05 03 00 4C FE 00 02 10 20 00 00 05 03 00 D8 02 00 02 10 20 00 00 06 03 00 D9 02 00' + '02 10 20 00 00 07 03 00 ED 1F 00 03 00 20 00 00 08 03 00 00 03 00 85 03 00 03 00 20 00 00 08 03' + '00 01 03 00 C1 1F 00 03 00 20 00 00 08 03 00 42 03 00 A8 00 00 02 10 20 00 00 08 03 00 DA 02 00' + '02 10 20 00 00 0A 03 00 DD 02 00 02 10 20 00 00 0B 03 00 CD 1F 00 03 00 20 00 00 13 03 00 00 03' + '00 CE 1F 00 03 00 20 00 00 13 03 00 01 03 00 CF 1F 00 03 00 20 00 00 13 03 00 42 03 00 BF 1F 00' + '02 10 20 00 00 13 03 00 BD 1F 00 02 10 20 00 00 13 03 00 DD 1F 00 03 00 20 00 00 14 03 00 00 03' + '00 DE 1F 00 03 00 20 00 00 14 03 00 01 03 00 DF 1F 00 03 00 20 00 00 14 03 00 42 03 00 FE 1F 00' + '02 10 20 00 00 14 03 00 B8 00 00 02 10 20 00 00 27 03 00 DB 02 00 02 10 20 00 00 28 03 00 17 20' + '00 02 10 20 00 00 33 03 00 C0 1F 00 02 10 20 00 00 42 03 00 7A 03 00 02 10 20 00 00 45 03 00 70' + 'FE 00 02 06 20 00 00 4B 06 00 5E FC 00 03 06 20 00 00 4C 06 00 51 06 00 72 FE 00 02 06 20 00 00' + '4C 06 00 5F FC 00 03 06 20 00 00 4D 06 00 51 06 00 74 FE 00 02 06 20 00 00 4D 06 00 60 FC 00 03' + '06 20 00 00 4E 06 00 51 06 00 76 FE 00 02 06 20 00 00 4E 06 00 61 FC 00 03 06 20 00 00 4F 06 00' + '51 06 00 78 FE 00 02 06 20 00 00 4F 06 00 62 FC 00 03 06 20 00 00 50 06 00 51 06 00 7A FE 00 02' + '06 20 00 00 50 06 00 63 FC 00 03 06 20 00 00 51 06 00 70 06 00 7C FE 00 02 06 20 00 00 51 06 00' + '7E FE 00 02 06 20 00 00 52 06 00 9B 30 00 02 10 20 00 00 99 30 00 9C 30 00 02 10 20 00 00 9A 30' + '00 0A 20 00 01 10 20 00 00 09 20 00 01 10 20 00 00 2F 20 00 01 02 20 00 00 5F 20 00 01 10 20 00' + '00 A0 00 00 01 02 20 00 00 02 20 00 01 10 20 00 00 03 20 00 01 10 20 00 00 04 20 00 01 10 20 00' + '00 06 20 00 01 10 20 00 00 05 20 00 01 10 20 00 00 08 20 00 01 10 20 00 00 07 20 00 01 02 20 00' + '00 00 30 00 01 0B 20 00 00 3C 20 00 02 10 21 00 00 21 00 00 49 20 00 02 10 21 00 00 3F 00 00 57' + 'FE 00 01 0D 21 00 00 15 FE 00 01 0A 21 00 00 01 FF 00 01 0B 21 00 00 02 FF 00 01 0B 22 00 00 5F' + 'FE 00 01 0D 23 00 00 03 FF 00 01 0B 23 00 00 04 FF 00 01 0B 24 00 00 69 FE 00 01 0D 24 00 00 6A' + 'FE 00 01 0D 25 00 00 05 FF 00 01 0B 25 00 00 06 FF 00 01 0B 26 00 00 60 FE 00 01 0D 26 00 00 07' + 'FF 00 01 0B 27 00 00 74 24 00 03 10 28 00 00 31 00 00 29 00 00 7D 24 00 04 10 28 00 00 31 00 00' + '30 00 00 29 00 00 7E 24 00 04 10 28 00 00 31 00 00 31 00 00 29 00 00 7F 24 00 04 10 28 00 00 31' + '00 00 32 00 00 29 00 00 80 24 00 04 10 28 00 00 31 00 00 33 00 00 29 00 00 81 24 00 04 10 28 00' + '00 31 00 00 34 00 00 29 00 00 82 24 00 04 10 28 00 00 31 00 00 35 00 00 29 00 00 83 24 00 04 10' + '28 00 00 31 00 00 36 00 00 29 00 00 84 24 00 04 10 28 00 00 31 00 00 37 00 00 29 00 00 85 24 00' + '04 10 28 00 00 31 00 00 38 00 00 29 00 00 86 24 00 04 10 28 00 00 31 00 00 39 00 00 29 00 00 75' + '24 00 03 10 28 00 00 32 00 00 29 00 00 87 24 00 04 10 28 00 00 32 00 00 30 00 00 29 00 00 76 24' + '00 03 10 28 00 00 33 00 00 29 00 00 77 24 00 03 10 28 00 00 34 00 00 29 00 00 78 24 00 03 10 28' + '00 00 35 00 00 29 00 00 79 24 00 03 10 28 00 00 36 00 00 29 00 00 7A 24 00 03 10 28 00 00 37 00' + '00 29 00 00 7B 24 00 03 10 28 00 00 38 00 00 29 00 00 7C 24 00 03 10 28 00 00 39 00 00 29 00 00' + '10 F1 01 03 10 28 00 00 41 00 00 29 00 00 11 F1 01 03 10 28 00 00 42 00 00 29 00 00 12 F1 01 03' + '10 28 00 00 43 00 00 29 00 00 13 F1 01 03 10 28 00 00 44 00 00 29 00 00 14 F1 01 03 10 28 00 00' + '45 00 00 29 00 00 15 F1 01 03 10 28 00 00 46 00 00 29 00 00 16 F1 01 03 10 28 00 00 47 00 00 29' + '00 00 17 F1 01 03 10 28 00 00 48 00 00 29 00 00 18 F1 01 03 10 28 00 00 49 00 00 29 00 00 19 F1' + '01 03 10 28 00 00 4A 00 00 29 00 00 1A F1 01 03 10 28 00 00 4B 00 00 29 00 00 1B F1 01 03 10 28' + '00 00 4C 00 00 29 00 00 1C F1 01 03 10 28 00 00 4D 00 00 29 00 00 1D F1 01 03 10 28 00 00 4E 00' + '00 29 00 00 1E F1 01 03 10 28 00 00 4F 00 00 29 00 00 1F F1 01 03 10 28 00 00 50 00 00 29 00 00' + '20 F1 01 03 10 28 00 00 51 00 00 29 00 00 21 F1 01 03 10 28 00 00 52 00 00 29 00 00 22 F1 01 03' + '10 28 00 00 53 00 00 29 00 00 23 F1 01 03 10 28 00 00 54 00 00 29 00 00 24 F1 01 03 10 28 00 00' + '55 00 00 29 00 00 25 F1 01 03 10 28 00 00 56 00 00 29 00 00 26 F1 01 03 10 28 00 00 57 00 00 29' + '00 00 27 F1 01 03 10 28 00 00 58 00 00 29 00 00 28 F1 01 03 10 28 00 00 59 00 00 29 00 00 29 F1' + '01 03 10 28 00 00 5A 00 00 29 00 00 9C 24 00 03 10 28 00 00 61 00 00 29 00 00 9D 24 00 03 10 28' + '00 00 62 00 00 29 00 00 9E 24 00 03 10 28 00 00 63 00 00 29 00 00 9F 24 00 03 10 28 00 00 64 00' + '00 29 00 00 A0 24 00 03 10 28 00 00 65 00 00 29 00 00 A1 24 00 03 10 28 00 00 66 00 00 29 00 00' + 'A2 24 00 03 10 28 00 00 67 00 00 29 00 00 A3 24 00 03 10 28 00 00 68 00 00 29 00 00 A4 24 00 03' + '10 28 00 00 69 00 00 29 00 00 A5 24 00 03 10 28 00 00 6A 00 00 29 00 00 A6 24 00 03 10 28 00 00' + '6B 00 00 29 00 00 A7 24 00 03 10 28 00 00 6C 00 00 29 00 00 A8 24 00 03 10 28 00 00 6D 00 00 29' + '00 00 A9 24 00 03 10 28 00 00 6E 00 00 29 00 00 AA 24 00 03 10 28 00 00 6F 00 00 29 00 00 AB 24' + '00 03 10 28 00 00 70 00 00 29 00 00 AC 24 00 03 10 28 00 00 71 00 00 29 00 00 AD 24 00 03 10 28' + '00 00 72 00 00 29 00 00 AE 24 00 03 10 28 00 00 73 00 00 29 00 00 AF 24 00 03 10 28 00 00 74 00' + '00 29 00 00 B0 24 00 03 10 28 00 00 75 00 00 29 00 00 B1 24 00 03 10 28 00 00 76 00 00 29 00 00' + 'B2 24 00 03 10 28 00 00 77 00 00 29 00 00 B3 24 00 03 10 28 00 00 78 00 00 29 00 00 B4 24 00 03' + '10 28 00 00 79 00 00 29 00 00 B5 24 00 03 10 28 00 00 7A 00 00 29 00 00 00 32 00 03 10 28 00 00' + '00 11 00 29 00 00 0E 32 00 04 10 28 00 00 00 11 00 61 11 00 29 00 00 01 32 00 03 10 28 00 00 02' + '11 00 29 00 00 0F 32 00 04 10 28 00 00 02 11 00 61 11 00 29 00 00 02 32 00 03 10 28 00 00 03 11' + '00 29 00 00 10 32 00 04 10 28 00 00 03 11 00 61 11 00 29 00 00 03 32 00 03 10 28 00 00 05 11 00' + '29 00 00 11 32 00 04 10 28 00 00 05 11 00 61 11 00 29 00 00 04 32 00 03 10 28 00 00 06 11 00 29' + '00 00 12 32 00 04 10 28 00 00 06 11 00 61 11 00 29 00 00 05 32 00 03 10 28 00 00 07 11 00 29 00' + '00 13 32 00 04 10 28 00 00 07 11 00 61 11 00 29 00 00 06 32 00 03 10 28 00 00 09 11 00 29 00 00' + '14 32 00 04 10 28 00 00 09 11 00 61 11 00 29 00 00 07 32 00 03 10 28 00 00 0B 11 00 29 00 00 15' + '32 00 04 10 28 00 00 0B 11 00 61 11 00 29 00 00 1D 32 00 07 10 28 00 00 0B 11 00 69 11 00 0C 11' + '00 65 11 00 AB 11 00 29 00 00 1E 32 00 06 10 28 00 00 0B 11 00 69 11 00 12 11 00 6E 11 00 29 00' + '00 08 32 00 03 10 28 00 00 0C 11 00 29 00 00 16 32 00 04 10 28 00 00 0C 11 00 61 11 00 29 00 00' + '1C 32 00 04 10 28 00 00 0C 11 00 6E 11 00 29 00 00 09 32 00 03 10 28 00 00 0E 11 00 29 00 00 17' + '32 00 04 10 28 00 00 0E 11 00 61 11 00 29 00 00 0A 32 00 03 10 28 00 00 0F 11 00 29 00 00 18 32' + '00 04 10 28 00 00 0F 11 00 61 11 00 29 00 00 0B 32 00 03 10 28 00 00 10 11 00 29 00 00 19 32 00' + '04 10 28 00 00 10 11 00 61 11 00 29 00 00 0C 32 00 03 10 28 00 00 11 11 00 29 00 00 1A 32 00 04' + '10 28 00 00 11 11 00 61 11 00 29 00 00 0D 32 00 03 10 28 00 00 12 11 00 29 00 00 1B 32 00 04 10' + '28 00 00 12 11 00 61 11 00 29 00 00 20 32 00 03 10 28 00 00 00 4E 00 29 00 00 26 32 00 03 10 28' + '00 00 03 4E 00 29 00 00 22 32 00 03 10 28 00 00 09 4E 00 29 00 00 28 32 00 03 10 28 00 00 5D 4E' + '00 29 00 00 21 32 00 03 10 28 00 00 8C 4E 00 29 00 00 24 32 00 03 10 28 00 00 94 4E 00 29 00 00' + '39 32 00 03 10 28 00 00 E3 4E 00 29 00 00 3D 32 00 03 10 28 00 00 01 4F 00 29 00 00 41 32 00 03' + '10 28 00 00 11 4F 00 29 00 00 27 32 00 03 10 28 00 00 6B 51 00 29 00 00 25 32 00 03 10 28 00 00' + '6D 51 00 29 00 00 38 32 00 03 10 28 00 00 B4 52 00 29 00 00 29 32 00 03 10 28 00 00 41 53 00 29' + '00 00 3F 32 00 03 10 28 00 00 54 53 00 29 00 00 34 32 00 03 10 28 00 00 0D 54 00 29 00 00 3A 32' + '00 03 10 28 00 00 7C 54 00 29 00 00 23 32 00 03 10 28 00 00 DB 56 00 29 00 00 2F 32 00 03 10 28' + '00 00 1F 57 00 29 00 00 3B 32 00 03 10 28 00 00 66 5B 00 29 00 00 30 32 00 03 10 28 00 00 E5 65' + '00 29 00 00 2A 32 00 03 10 28 00 00 08 67 00 29 00 00 32 32 00 03 10 28 00 00 09 67 00 29 00 00' + '2D 32 00 03 10 28 00 00 28 67 00 29 00 00 31 32 00 03 10 28 00 00 2A 68 00 29 00 00 2C 32 00 03' + '10 28 00 00 34 6C 00 29 00 00 2B 32 00 03 10 28 00 00 6B 70 00 29 00 00 35 32 00 03 10 28 00 00' + '79 72 00 29 00 00 3C 32 00 03 10 28 00 00 E3 76 00 29 00 00 33 32 00 03 10 28 00 00 3E 79 00 29' + '00 00 37 32 00 03 10 28 00 00 5D 79 00 29 00 00 40 32 00 03 10 28 00 00 6D 79 00 29 00 00 42 32' + '00 03 10 28 00 00 EA 81 00 29 00 00 43 32 00 03 10 28 00 00 F3 81 00 29 00 00 36 32 00 03 10 28' + '00 00 A1 8C 00 29 00 00 3E 32 00 03 10 28 00 00 C7 8C 00 29 00 00 2E 32 00 03 10 28 00 00 D1 91' + '00 29 00 00 7D 20 00 01 08 28 00 00 08 FF 00 01 0B 28 00 00 35 FE 00 01 0A 28 00 00 59 FE 00 01' + '0D 28 00 00 8D 20 00 01 09 28 00 00 5A FE 00 01 0D 29 00 00 09 FF 00 01 0B 29 00 00 8E 20 00 01' + '09 29 00 00 7E 20 00 01 08 29 00 00 36 FE 00 01 0A 29 00 00 0A FF 00 01 0B 2A 00 00 61 FE 00 01' + '0D 2A 00 00 7A 20 00 01 08 2B 00 00 8A 20 00 01 09 2B 00 00 29 FB 00 01 01 2B 00 00 62 FE 00 01' + '0D 2B 00 00 0B FF 00 01 0B 2B 00 00 50 FE 00 01 0D 2C 00 00 0C FF 00 01 0B 2C 00 00 10 FE 00 01' + '0A 2C 00 00 0D FF 00 01 0B 2D 00 00 63 FE 00 01 0D 2D 00 00 19 FE 00 03 0A 2E 00 00 2E 00 00 2E' + '00 00 26 20 00 03 10 2E 00 00 2E 00 00 2E 00 00 30 FE 00 02 0A 2E 00 00 2E 00 00 25 20 00 02 10' + '2E 00 00 2E 00 00 52 FE 00 01 0D 2E 00 00 24 20 00 01 10 2E 00 00 0E FF 00 01 0B 2E 00 00 0F FF' + '00 01 0B 2F 00 00 01 F1 01 02 10 30 00 00 2C 00 00 00 F1 01 02 10 30 00 00 2E 00 00 89 21 00 03' + '0F 30 00 00 44 20 00 33 00 00 58 33 00 02 10 30 00 00 B9 70 00 D8 D7 01 01 01 30 00 00 E2 D7 01' + '01 01 30 00 00 CE D7 01 01 01 30 00 00 10 FF 00 01 0B 30 00 00 F0 FB 01 01 01 30 00 00 EA 24 00' + '01 07 30 00 00 EC D7 01 01 01 30 00 00 80 20 00 01 09 30 00 00 70 20 00 01 08 30 00 00 F6 D7 01' + '01 01 30 00 00 02 F1 01 02 10 31 00 00 2C 00 00 88 24 00 02 10 31 00 00 2E 00 00 91 24 00 03 10' + '31 00 00 30 00 00 2E 00 00 E9 33 00 03 10 31 00 00 30 00 00 E5 65 00 C9 32 00 03 10 31 00 00 30' + '00 00 08 67 00 62 33 00 03 10 31 00 00 30 00 00 B9 70 00 69 24 00 02 07 31 00 00 30 00 00 92 24' + '00 03 10 31 00 00 31 00 00 2E 00 00 EA 33 00 03 10 31 00 00 31 00 00 E5 65 00 CA 32 00 03 10 31' + '00 00 31 00 00 08 67 00 63 33 00 03 10 31 00 00 31 00 00 B9 70 00 6A 24 00 02 07 31 00 00 31 00' + '00 93 24 00 03 10 31 00 00 32 00 00 2E 00 00 EB 33 00 03 10 31 00 00 32 00 00 E5 65 00 CB 32 00' + '03 10 31 00 00 32 00 00 08 67 00 64 33 00 03 10 31 00 00 32 00 00 B9 70 00 6B 24 00 02 07 31 00' + '00 32 00 00 94 24 00 03 10 31 00 00 33 00 00 2E 00 00 EC 33 00 03 10 31 00 00 33 00 00 E5 65 00' + '65 33 00 03 10 31 00 00 33 00 00 B9 70 00 6C 24 00 02 07 31 00 00 33 00 00 95 24 00 03 10 31 00' + '00 34 00 00 2E 00 00 ED 33 00 03 10 31 00 00 34 00 00 E5 65 00 66 33 00 03 10 31 00 00 34 00 00' + 'B9 70 00 6D 24 00 02 07 31 00 00 34 00 00 96 24 00 03 10 31 00 00 35 00 00 2E 00 00 EE 33 00 03' + '10 31 00 00 35 00 00 E5 65 00 67 33 00 03 10 31 00 00 35 00 00 B9 70 00 6E 24 00 02 07 31 00 00' + '35 00 00 97 24 00 03 10 31 00 00 36 00 00 2E 00 00 EF 33 00 03 10 31 00 00 36 00 00 E5 65 00 68' + '33 00 03 10 31 00 00 36 00 00 B9 70 00 6F 24 00 02 07 31 00 00 36 00 00 98 24 00 03 10 31 00 00' + '37 00 00 2E 00 00 F0 33 00 03 10 31 00 00 37 00 00 E5 65 00 69 33 00 03 10 31 00 00 37 00 00 B9' + '70 00 70 24 00 02 07 31 00 00 37 00 00 99 24 00 03 10 31 00 00 38 00 00 2E 00 00 F1 33 00 03 10' + '31 00 00 38 00 00 E5 65 00 6A 33 00 03 10 31 00 00 38 00 00 B9 70 00 71 24 00 02 07 31 00 00 38' + '00 00 9A 24 00 03 10 31 00 00 39 00 00 2E 00 00 F2 33 00 03 10 31 00 00 39 00 00 E5 65 00 6B 33' + '00 03 10 31 00 00 39 00 00 B9 70 00 72 24 00 02 07 31 00 00 39 00 00 52 21 00 04 0F 31 00 00 44' + '20 00 31 00 00 30 00 00 BD 00 00 03 0F 31 00 00 44 20 00 32 00 00 53 21 00 03 0F 31 00 00 44 20' + '00 33 00 00 BC 00 00 03 0F 31 00 00 44 20 00 34 00 00 55 21 00 03 0F 31 00 00 44 20 00 35 00 00' + '59 21 00 03 0F 31 00 00 44 20 00 36 00 00 50 21 00 03 0F 31 00 00 44 20 00 37 00 00 5B 21 00 03' + '0F 31 00 00 44 20 00 38 00 00 51 21 00 03 0F 31 00 00 44 20 00 39 00 00 5F 21 00 02 0F 31 00 00' + '44 20 00 E0 33 00 02 10 31 00 00 E5 65 00 C0 32 00 02 10 31 00 00 08 67 00 59 33 00 02 10 31 00' + '00 B9 70 00 81 20 00 01 09 31 00 00 D9 D7 01 01 01 31 00 00 E3 D7 01 01 01 31 00 00 F7 D7 01 01' + '01 31 00 00 60 24 00 01 07 31 00 00 F1 FB 01 01 01 31 00 00 11 FF 00 01 0B 31 00 00 ED D7 01 01' + '01 31 00 00 CF D7 01 01 01 31 00 00 B9 00 00 01 08 31 00 00 03 F1 01 02 10 32 00 00 2C 00 00 89' + '24 00 02 10 32 00 00 2E 00 00 9B 24 00 03 10 32 00 00 30 00 00 2E 00 00 F3 33 00 03 10 32 00 00' + '30 00 00 E5 65 00 6C 33 00 03 10 32 00 00 30 00 00 B9 70 00 73 24 00 02 07 32 00 00 30 00 00 F4' + '33 00 03 10 32 00 00 31 00 00 E5 65 00 6D 33 00 03 10 32 00 00 31 00 00 B9 70 00 51 32 00 02 07' + '32 00 00 31 00 00 F5 33 00 03 10 32 00 00 32 00 00 E5 65 00 6E 33 00 03 10 32 00 00 32 00 00 B9' + '70 00 52 32 00 02 07 32 00 00 32 00 00 F6 33 00 03 10 32 00 00 33 00 00 E5 65 00 6F 33 00 03 10' + '32 00 00 33 00 00 B9 70 00 53 32 00 02 07 32 00 00 33 00 00 F7 33 00 03 10 32 00 00 34 00 00 E5' + '65 00 70 33 00 03 10 32 00 00 34 00 00 B9 70 00 54 32 00 02 07 32 00 00 34 00 00 F8 33 00 03 10' + '32 00 00 35 00 00 E5 65 00 55 32 00 02 07 32 00 00 35 00 00 F9 33 00 03 10 32 00 00 36 00 00 E5' + '65 00 56 32 00 02 07 32 00 00 36 00 00 FA 33 00 03 10 32 00 00 37 00 00 E5 65 00 57 32 00 02 07' + '32 00 00 37 00 00 FB 33 00 03 10 32 00 00 38 00 00 E5 65 00 58 32 00 02 07 32 00 00 38 00 00 FC' + '33 00 03 10 32 00 00 39 00 00 E5 65 00 59 32 00 02 07 32 00 00 39 00 00 54 21 00 03 0F 32 00 00' + '44 20 00 33 00 00 56 21 00 03 0F 32 00 00 44 20 00 35 00 00 E1 33 00 02 10 32 00 00 E5 65 00 C1' + '32 00 02 10 32 00 00 08 67 00 5A 33 00 02 10 32 00 00 B9 70 00 82 20 00 01 09 32 00 00 61 24 00' + '01 07 32 00 00 B2 00 00 01 08 32 00 00 12 FF 00 01 0B 32 00 00 F2 FB 01 01 01 32 00 00 E4 D7 01' + '01 01 32 00 00 EE D7 01 01 01 32 00 00 D0 D7 01 01 01 32 00 00 DA D7 01 01 01 32 00 00 F8 D7 01' + '01 01 32 00 00 04 F1 01 02 10 33 00 00 2C 00 00 8A 24 00 02 10 33 00 00 2E 00 00 FD 33 00 03 10' + '33 00 00 30 00 00 E5 65 00 5A 32 00 02 07 33 00 00 30 00 00 FE 33 00 03 10 33 00 00 31 00 00 E5' + '65 00 5B 32 00 02 07 33 00 00 31 00 00 5C 32 00 02 07 33 00 00 32 00 00 5D 32 00 02 07 33 00 00' + '33 00 00 5E 32 00 02 07 33 00 00 34 00 00 5F 32 00 02 07 33 00 00 35 00 00 B1 32 00 02 07 33 00' + '00 36 00 00 B2 32 00 02 07 33 00 00 37 00 00 B3 32 00 02 07 33 00 00 38 00 00 B4 32 00 02 07 33' + '00 00 39 00 00 BE 00 00 03 0F 33 00 00 44 20 00 34 00 00 57 21 00 03 0F 33 00 00 44 20 00 35 00' + '00 5C 21 00 03 0F 33 00 00 44 20 00 38 00 00 E2 33 00 02 10 33 00 00 E5 65 00 C2 32 00 02 10 33' + '00 00 08 67 00 5B 33 00 02 10 33 00 00 B9 70 00 F3 FB 01 01 01 33 00 00 13 FF 00 01 0B 33 00 00' + 'D1 D7 01 01 01 33 00 00 B3 00 00 01 08 33 00 00 F9 D7 01 01 01 33 00 00 EF D7 01 01 01 33 00 00' + 'DB D7 01 01 01 33 00 00 E5 D7 01 01 01 33 00 00 83 20 00 01 09 33 00 00 62 24 00 01 07 33 00 00' + '05 F1 01 02 10 34 00 00 2C 00 00 8B 24 00 02 10 34 00 00 2E 00 00 B5 32 00 02 07 34 00 00 30 00' + '00 B6 32 00 02 07 34 00 00 31 00 00 B7 32 00 02 07 34 00 00 32 00 00 B8 32 00 02 07 34 00 00 33' + '00 00 B9 32 00 02 07 34 00 00 34 00 00 BA 32 00 02 07 34 00 00 35 00 00 BB 32 00 02 07 34 00 00' + '36 00 00 BC 32 00 02 07 34 00 00 37 00 00 BD 32 00 02 07 34 00 00 38 00 00 BE 32 00 02 07 34 00' + '00 39 00 00 58 21 00 03 0F 34 00 00 44 20 00 35 00 00 E3 33 00 02 10 34 00 00 E5 65 00 C3 32 00' + '02 10 34 00 00 08 67 00 5C 33 00 02 10 34 00 00 B9 70 00 FA D7 01 01 01 34 00 00 DC D7 01 01 01' + '34 00 00 63 24 00 01 07 34 00 00 E6 D7 01 01 01 34 00 00 F0 D7 01 01 01 34 00 00 F4 FB 01 01 01' + '34 00 00 84 20 00 01 09 34 00 00 D2 D7 01 01 01 34 00 00 14 FF 00 01 0B 34 00 00 74 20 00 01 08' + '34 00 00 06 F1 01 02 10 35 00 00 2C 00 00 8C 24 00 02 10 35 00 00 2E 00 00 BF 32 00 02 07 35 00' + '00 30 00 00 5A 21 00 03 0F 35 00 00 44 20 00 36 00 00 5D 21 00 03 0F 35 00 00 44 20 00 38 00 00' + 'E4 33 00 02 10 35 00 00 E5 65 00 C4 32 00 02 10 35 00 00 08 67 00 5D 33 00 02 10 35 00 00 B9 70' + '00 E7 D7 01 01 01 35 00 00 D3 D7 01 01 01 35 00 00 85 20 00 01 09 35 00 00 FB D7 01 01 01 35 00' + '00 DD D7 01 01 01 35 00 00 F1 D7 01 01 01 35 00 00 F5 FB 01 01 01 35 00 00 75 20 00 01 08 35 00' + '00 64 24 00 01 07 35 00 00 15 FF 00 01 0B 35 00 00 07 F1 01 02 10 36 00 00 2C 00 00 8D 24 00 02' + '10 36 00 00 2E 00 00 E5 33 00 02 10 36 00 00 E5 65 00 C5 32 00 02 10 36 00 00 08 67 00 5E 33 00' + '02 10 36 00 00 B9 70 00 F6 FB 01 01 01 36 00 00 16 FF 00 01 0B 36 00 00 65 24 00 01 07 36 00 00' + '86 20 00 01 09 36 00 00 D4 D7 01 01 01 36 00 00 DE D7 01 01 01 36 00 00 76 20 00 01 08 36 00 00' + 'E8 D7 01 01 01 36 00 00 F2 D7 01 01 01 36 00 00 FC D7 01 01 01 36 00 00 08 F1 01 02 10 37 00 00' + '2C 00 00 8E 24 00 02 10 37 00 00 2E 00 00 5E 21 00 03 0F 37 00 00 44 20 00 38 00 00 E6 33 00 02' + '10 37 00 00 E5 65 00 C6 32 00 02 10 37 00 00 08 67 00 5F 33 00 02 10 37 00 00 B9 70 00 17 FF 00' + '01 0B 37 00 00 F7 FB 01 01 01 37 00 00 D5 D7 01 01 01 37 00 00 F3 D7 01 01 01 37 00 00 E9 D7 01' + '01 01 37 00 00 77 20 00 01 08 37 00 00 DF D7 01 01 01 37 00 00 66 24 00 01 07 37 00 00 FD D7 01' + '01 01 37 00 00 87 20 00 01 09 37 00 00 09 F1 01 02 10 38 00 00 2C 00 00 8F 24 00 02 10 38 00 00' + '2E 00 00 E7 33 00 02 10 38 00 00 E5 65 00 C7 32 00 02 10 38 00 00 08 67 00 60 33 00 02 10 38 00' + '00 B9 70 00 F4 D7 01 01 01 38 00 00 88 20 00 01 09 38 00 00 18 FF 00 01 0B 38 00 00 F8 FB 01 01' + '01 38 00 00 EA D7 01 01 01 38 00 00 E0 D7 01 01 01 38 00 00 67 24 00 01 07 38 00 00 78 20 00 01' + '08 38 00 00 FE D7 01 01 01 38 00 00 D6 D7 01 01 01 38 00 00 0A F1 01 02 10 39 00 00 2C 00 00 90' + '24 00 02 10 39 00 00 2E 00 00 E8 33 00 02 10 39 00 00 E5 65 00 C8 32 00 02 10 39 00 00 08 67 00' + '61 33 00 02 10 39 00 00 B9 70 00 19 FF 00 01 0B 39 00 00 FF D7 01 01 01 39 00 00 79 20 00 01 08' + '39 00 00 EB D7 01 01 01 39 00 00 68 24 00 01 07 39 00 00 D7 D7 01 01 01 39 00 00 F9 FB 01 01 01' + '39 00 00 F5 D7 01 01 01 39 00 00 E1 D7 01 01 01 39 00 00 89 20 00 01 09 39 00 00 74 2A 00 03 10' + '3A 00 00 3A 00 00 3D 00 00 55 FE 00 01 0D 3A 00 00 13 FE 00 01 0A 3A 00 00 1A FF 00 01 0B 3A 00' + '00 14 FE 00 01 0A 3B 00 00 54 FE 00 01 0D 3B 00 00 1B FF 00 01 0B 3B 00 00 6E 22 00 02 00 3C 00' + '00 38 03 00 1C FF 00 01 0B 3C 00 00 64 FE 00 01 0D 3C 00 00 76 2A 00 03 10 3D 00 00 3D 00 00 3D' + '00 00 75 2A 00 02 10 3D 00 00 3D 00 00 60 22 00 02 00 3D 00 00 38 03 00 7C 20 00 01 08 3D 00 00' + '8C 20 00 01 09 3D 00 00 1D FF 00 01 0B 3D 00 00 66 FE 00 01 0D 3D 00 00 6F 22 00 02 00 3E 00 00' + '38 03 00 65 FE 00 01 0D 3E 00 00 1E FF 00 01 0B 3E 00 00 48 20 00 02 10 3F 00 00 21 00 00 47 20' + '00 02 10 3F 00 00 3F 00 00 1F FF 00 01 0B 3F 00 00 56 FE 00 01 0D 3F 00 00 16 FE 00 01 0A 3F 00' + '00 6B FE 00 01 0D 40 00 00 20 FF 00 01 0B 40 00 00 73 33 00 02 0E 41 00 00 55 00 00 C0 00 00 02' + '00 41 00 00 00 03 00 C1 00 00 02 00 41 00 00 01 03 00 A6 1E 00 03 00 41 00 00 02 03 00 00 03 00' + 'A4 1E 00 03 00 41 00 00 02 03 00 01 03 00 AA 1E 00 03 00 41 00 00 02 03 00 03 03 00 A8 1E 00 03' + '00 41 00 00 02 03 00 09 03 00 C2 00 00 02 00 41 00 00 02 03 00 C3 00 00 02 00 41 00 00 03 03 00' + '00 01 00 02 00 41 00 00 04 03 00 B0 1E 00 03 00 41 00 00 06 03 00 00 03 00 AE 1E 00 03 00 41 00' + '00 06 03 00 01 03 00 B4 1E 00 03 00 41 00 00 06 03 00 03 03 00 B2 1E 00 03 00 41 00 00 06 03 00' + '09 03 00 02 01 00 02 00 41 00 00 06 03 00 E0 01 00 03 00 41 00 00 07 03 00 04 03 00 26 02 00 02' + '00 41 00 00 07 03 00 DE 01 00 03 00 41 00 00 08 03 00 04 03 00 C4 00 00 02 00 41 00 00 08 03 00' + 'A2 1E 00 02 00 41 00 00 09 03 00 FA 01 00 03 00 41 00 00 0A 03 00 01 03 00 C5 00 00 02 00 41 00' + '00 0A 03 00 CD 01 00 02 00 41 00 00 0C 03 00 00 02 00 02 00 41 00 00 0F 03 00 02 02 00 02 00 41' + '00 00 11 03 00 AC 1E 00 03 00 41 00 00 23 03 00 02 03 00 B6 1E 00 03 00 41 00 00 23 03 00 06 03' + '00 A0 1E 00 02 00 41 00 00 23 03 00 00 1E 00 02 00 41 00 00 25 03 00 04 01 00 02 00 41 00 00 28' + '03 00 DF 33 00 03 0E 41 00 00 15 22 00 6D 00 00 21 FF 00 01 0B 41 00 00 38 D5 01 01 01 41 00 00' + '3C D6 01 01 01 41 00 00 A0 D5 01 01 01 41 00 00 2C 1D 00 01 08 41 00 00 04 D5 01 01 01 41 00 00' + '6C D5 01 01 01 41 00 00 30 F1 01 01 0E 41 00 00 68 D4 01 01 01 41 00 00 B6 24 00 01 07 41 00 00' + '9C D4 01 01 01 41 00 00 D4 D5 01 01 01 41 00 00 D0 D4 01 01 01 41 00 00 70 D6 01 01 01 41 00 00' + '08 D6 01 01 01 41 00 00 00 D4 01 01 01 41 00 00 34 D4 01 01 01 41 00 00 C3 33 00 02 0E 42 00 00' + '71 00 00 02 1E 00 02 00 42 00 00 07 03 00 04 1E 00 02 00 42 00 00 23 03 00 06 1E 00 02 00 42 00' + '00 31 03 00 3D D6 01 01 01 42 00 00 31 F1 01 01 0E 42 00 00 05 D5 01 01 01 42 00 00 39 D5 01 01' + '01 42 00 00 01 D4 01 01 01 42 00 00 D1 D4 01 01 01 42 00 00 35 D4 01 01 01 42 00 00 71 D6 01 01' + '01 42 00 00 09 D6 01 01 01 42 00 00 B7 24 00 01 07 42 00 00 D5 D5 01 01 01 42 00 00 2C 21 00 01' + '01 42 00 00 A1 D5 01 01 01 42 00 00 2E 1D 00 01 08 42 00 00 6D D5 01 01 01 42 00 00 69 D4 01 01' + '01 42 00 00 22 FF 00 01 0B 42 00 00 2D F1 01 02 07 43 00 00 44 00 00 C7 33 00 03 0E 43 00 00 6F' + '00 00 2E 00 00 06 01 00 02 00 43 00 00 01 03 00 08 01 00 02 00 43 00 00 02 03 00 0A 01 00 02 00' + '43 00 00 07 03 00 0C 01 00 02 00 43 00 00 0C 03 00 08 1E 00 03 00 43 00 00 27 03 00 01 03 00 C7' + '00 00 02 00 43 00 00 27 03 00 C6 33 00 04 0E 43 00 00 15 22 00 6B 00 00 67 00 00 6E D5 01 01 01' + '43 00 00 3E D6 01 01 01 43 00 00 9E D4 01 01 01 43 00 00 32 F1 01 01 0E 43 00 00 2B F1 01 01 07' + '43 00 00 02 21 00 01 01 43 00 00 A2 D5 01 01 01 43 00 00 6A D4 01 01 01 43 00 00 6D 21 00 01 10' + '43 00 00 02 D4 01 01 01 43 00 00 B8 24 00 01 07 43 00 00 0A D6 01 01 01 43 00 00 D2 D4 01 01 01' + '43 00 00 23 FF 00 01 0B 43 00 00 36 D4 01 01 01 43 00 00 2D 21 00 01 01 43 00 00 72 D6 01 01 01' + '43 00 00 D6 D5 01 01 01 43 00 00 90 F1 01 02 0E 44 00 00 4A 00 00 C4 01 00 03 10 44 00 00 5A 00' + '00 0C 03 00 F1 01 00 02 10 44 00 00 5A 00 00 C5 01 00 03 10 44 00 00 7A 00 00 0C 03 00 F2 01 00' + '02 10 44 00 00 7A 00 00 0A 1E 00 02 00 44 00 00 07 03 00 0E 01 00 02 00 44 00 00 0C 03 00 0C 1E' + '00 02 00 44 00 00 23 03 00 10 1E 00 02 00 44 00 00 27 03 00 12 1E 00 02 00 44 00 00 2D 03 00 0E' + '1E 00 02 00 44 00 00 31 03 00 A3 D5 01 01 01 44 00 00 6B D4 01 01 01 44 00 00 B9 24 00 01 07 44' + '00 00 24 FF 00 01 0B 44 00 00 45 21 00 01 01 44 00 00 D3 D4 01 01 01 44 00 00 07 D5 01 01 01 44' + '00 00 0B D6 01 01 01 44 00 00 3B D5 01 01 01 44 00 00 03 D4 01 01 01 44 00 00 6F D5 01 01 01 44' + '00 00 3F D6 01 01 01 44 00 00 33 F1 01 01 0E 44 00 00 30 1D 00 01 08 44 00 00 73 D6 01 01 01 44' + '00 00 6E 21 00 01 10 44 00 00 37 D4 01 01 01 44 00 00 9F D4 01 01 01 44 00 00 D7 D5 01 01 01 44' + '00 00 C8 00 00 02 00 45 00 00 00 03 00 C9 00 00 02 00 45 00 00 01 03 00 C0 1E 00 03 00 45 00 00' + '02 03 00 00 03 00 BE 1E 00 03 00 45 00 00 02 03 00 01 03 00 C4 1E 00 03 00 45 00 00 02 03 00 03' + '03 00 C2 1E 00 03 00 45 00 00 02 03 00 09 03 00 CA 00 00 02 00 45 00 00 02 03 00 BC 1E 00 02 00' + '45 00 00 03 03 00 14 1E 00 03 00 45 00 00 04 03 00 00 03 00 16 1E 00 03 00 45 00 00 04 03 00 01' + '03 00 12 01 00 02 00 45 00 00 04 03 00 14 01 00 02 00 45 00 00 06 03 00 16 01 00 02 00 45 00 00' + '07 03 00 CB 00 00 02 00 45 00 00 08 03 00 BA 1E 00 02 00 45 00 00 09 03 00 1A 01 00 02 00 45 00' + '00 0C 03 00 04 02 00 02 00 45 00 00 0F 03 00 06 02 00 02 00 45 00 00 11 03 00 C6 1E 00 03 00 45' + '00 00 23 03 00 02 03 00 B8 1E 00 02 00 45 00 00 23 03 00 1C 1E 00 03 00 45 00 00 27 03 00 06 03' + '00 28 02 00 02 00 45 00 00 27 03 00 18 01 00 02 00 45 00 00 28 03 00 18 1E 00 02 00 45 00 00 2D' + '03 00 1A 1E 00 02 00 45 00 00 30 03 00 31 1D 00 01 08 45 00 00 08 D5 01 01 01 45 00 00 D8 D5 01' + '01 01 45 00 00 0C D6 01 01 01 45 00 00 D4 D4 01 01 01 45 00 00 04 D4 01 01 01 45 00 00 3C D5 01' + '01 01 45 00 00 34 F1 01 01 0E 45 00 00 74 D6 01 01 01 45 00 00 38 D4 01 01 01 45 00 00 6C D4 01' + '01 01 45 00 00 A4 D5 01 01 01 45 00 00 BA 24 00 01 07 45 00 00 30 21 00 01 01 45 00 00 70 D5 01' + '01 01 45 00 00 40 D6 01 01 01 45 00 00 25 FF 00 01 0B 45 00 00 3B 21 00 03 10 46 00 00 41 00 00' + '58 00 00 1E 1E 00 02 00 46 00 00 07 03 00 3D D5 01 01 01 46 00 00 26 FF 00 01 0B 46 00 00 39 D4' + '01 01 01 46 00 00 71 D5 01 01 01 46 00 00 05 D4 01 01 01 46 00 00 0D D6 01 01 01 46 00 00 A5 D5' + '01 01 01 46 00 00 BB 24 00 01 07 46 00 00 D5 D4 01 01 01 46 00 00 41 D6 01 01 01 46 00 00 6D D4' + '01 01 01 46 00 00 31 21 00 01 01 46 00 00 35 F1 01 01 0E 46 00 00 D9 D5 01 01 01 46 00 00 75 D6' + '01 01 01 46 00 00 09 D5 01 01 01 46 00 00 87 33 00 02 0E 47 00 00 42 00 00 93 33 00 03 0E 47 00' + '00 48 00 00 7A 00 00 AC 33 00 03 0E 47 00 00 50 00 00 61 00 00 C9 33 00 02 0E 47 00 00 79 00 00' + 'F4 01 00 02 00 47 00 00 01 03 00 1C 01 00 02 00 47 00 00 02 03 00 20 1E 00 02 00 47 00 00 04 03' + '00 1E 01 00 02 00 47 00 00 06 03 00 20 01 00 02 00 47 00 00 07 03 00 E6 01 00 02 00 47 00 00 0C' + '03 00 22 01 00 02 00 47 00 00 27 03 00 72 D5 01 01 01 47 00 00 76 D6 01 01 01 47 00 00 BC 24 00' + '01 07 47 00 00 DA D5 01 01 01 47 00 00 3A D4 01 01 01 47 00 00 A2 D4 01 01 01 47 00 00 6E D4 01' + '01 01 47 00 00 A6 D5 01 01 01 47 00 00 27 FF 00 01 0B 47 00 00 42 D6 01 01 01 47 00 00 36 F1 01' + '01 0E 47 00 00 0E D6 01 01 01 47 00 00 D6 D4 01 01 01 47 00 00 3E D5 01 01 01 47 00 00 0A D5 01' + '01 01 47 00 00 06 D4 01 01 01 47 00 00 33 1D 00 01 08 47 00 00 CB 33 00 02 0E 48 00 00 50 00 00' + '4A F1 01 02 0E 48 00 00 56 00 00 CC 32 00 02 0E 48 00 00 67 00 00 90 33 00 02 0E 48 00 00 7A 00' + '00 24 01 00 02 00 48 00 00 02 03 00 22 1E 00 02 00 48 00 00 07 03 00 26 1E 00 02 00 48 00 00 08' + '03 00 1E 02 00 02 00 48 00 00 0C 03 00 24 1E 00 02 00 48 00 00 23 03 00 28 1E 00 02 00 48 00 00' + '27 03 00 2A 1E 00 02 00 48 00 00 2E 03 00 DB D5 01 01 01 48 00 00 3B D4 01 01 01 48 00 00 0C 21' + '00 01 01 48 00 00 0B 21 00 01 01 48 00 00 28 FF 00 01 0B 48 00 00 0D 21 00 01 01 48 00 00 BD 24' + '00 01 07 48 00 00 0F D6 01 01 01 48 00 00 6F D4 01 01 01 48 00 00 73 D5 01 01 01 48 00 00 07 D4' + '01 01 01 48 00 00 37 F1 01 01 0E 48 00 00 D7 D4 01 01 01 48 00 00 43 D6 01 01 01 48 00 00 A7 D5' + '01 01 01 48 00 00 34 1D 00 01 08 48 00 00 77 D6 01 01 01 48 00 00 62 21 00 03 10 49 00 00 49 00' + '00 49 00 00 61 21 00 02 10 49 00 00 49 00 00 32 01 00 02 10 49 00 00 4A 00 00 7A 33 00 02 0E 49' + '00 00 55 00 00 63 21 00 02 10 49 00 00 56 00 00 68 21 00 02 10 49 00 00 58 00 00 CC 00 00 02 00' + '49 00 00 00 03 00 CD 00 00 02 00 49 00 00 01 03 00 CE 00 00 02 00 49 00 00 02 03 00 28 01 00 02' + '00 49 00 00 03 03 00 2A 01 00 02 00 49 00 00 04 03 00 2C 01 00 02 00 49 00 00 06 03 00 30 01 00' + '02 00 49 00 00 07 03 00 2E 1E 00 03 00 49 00 00 08 03 00 01 03 00 CF 00 00 02 00 49 00 00 08 03' + '00 C8 1E 00 02 00 49 00 00 09 03 00 CF 01 00 02 00 49 00 00 0C 03 00 08 02 00 02 00 49 00 00 0F' + '03 00 0A 02 00 02 00 49 00 00 11 03 00 CA 1E 00 02 00 49 00 00 23 03 00 2E 01 00 02 00 49 00 00' + '28 03 00 2C 1E 00 02 00 49 00 00 30 03 00 60 21 00 01 10 49 00 00 D8 D4 01 01 01 49 00 00 29 FF' + '00 01 0B 49 00 00 35 1D 00 01 08 49 00 00 78 D6 01 01 01 49 00 00 08 D4 01 01 01 49 00 00 74 D5' + '01 01 01 49 00 00 BE 24 00 01 07 49 00 00 DC D5 01 01 01 49 00 00 10 21 00 01 01 49 00 00 11 21' + '00 01 01 49 00 00 40 D5 01 01 01 49 00 00 70 D4 01 01 01 49 00 00 3C D4 01 01 01 49 00 00 44 D6' + '01 01 01 49 00 00 10 D6 01 01 01 49 00 00 A8 D5 01 01 01 49 00 00 38 F1 01 01 0E 49 00 00 34 01' + '00 02 00 4A 00 00 02 03 00 71 D4 01 01 01 4A 00 00 79 D6 01 01 01 4A 00 00 BF 24 00 01 07 4A 00' + '00 75 D5 01 01 01 4A 00 00 39 F1 01 01 0E 4A 00 00 45 D6 01 01 01 4A 00 00 41 D5 01 01 01 4A 00' + '00 0D D5 01 01 01 4A 00 00 D9 D4 01 01 01 4A 00 00 36 1D 00 01 08 4A 00 00 DD D5 01 01 01 4A 00' + '00 11 D6 01 01 01 4A 00 00 09 D4 01 01 01 4A 00 00 2A FF 00 01 0B 4A 00 00 A9 D5 01 01 01 4A 00' + '00 A5 D4 01 01 01 4A 00 00 3D D4 01 01 01 4A 00 00 85 33 00 02 0E 4B 00 00 42 00 00 CD 33 00 02' + '0E 4B 00 00 4B 00 00 CE 33 00 02 0E 4B 00 00 4D 00 00 30 1E 00 02 00 4B 00 00 01 03 00 E8 01 00' + '02 00 4B 00 00 0C 03 00 32 1E 00 02 00 4B 00 00 23 03 00 36 01 00 02 00 4B 00 00 27 03 00 34 1E' + '00 02 00 4B 00 00 31 03 00 0A D4 01 01 01 4B 00 00 A6 D4 01 01 01 4B 00 00 C0 24 00 01 07 4B 00' + '00 12 D6 01 01 01 4B 00 00 76 D5 01 01 01 4B 00 00 0E D5 01 01 01 4B 00 00 42 D5 01 01 01 4B 00' + '00 3E D4 01 01 01 4B 00 00 46 D6 01 01 01 4B 00 00 3A F1 01 01 0E 4B 00 00 37 1D 00 01 08 4B 00' + '00 AA D5 01 01 01 4B 00 00 DA D4 01 01 01 4B 00 00 DE D5 01 01 01 4B 00 00 7A D6 01 01 01 4B 00' + '00 72 D4 01 01 01 4B 00 00 2B FF 00 01 0B 4B 00 00 C7 01 00 02 10 4C 00 00 4A 00 00 CF 32 00 03' + '0E 4C 00 00 54 00 00 44 00 00 C8 01 00 02 10 4C 00 00 6A 00 00 3F 01 00 02 10 4C 00 00 B7 00 00' + '39 01 00 02 00 4C 00 00 01 03 00 3D 01 00 02 00 4C 00 00 0C 03 00 38 1E 00 03 00 4C 00 00 23 03' + '00 04 03 00 36 1E 00 02 00 4C 00 00 23 03 00 3B 01 00 02 00 4C 00 00 27 03 00 3C 1E 00 02 00 4C' + '00 00 2D 03 00 3A 1E 00 02 00 4C 00 00 31 03 00 6C 21 00 01 10 4C 00 00 0F D5 01 01 01 4C 00 00' + 'DB D4 01 01 01 4C 00 00 77 D5 01 01 01 4C 00 00 3F D4 01 01 01 4C 00 00 AB D5 01 01 01 4C 00 00' + '3B F1 01 01 0E 4C 00 00 73 D4 01 01 01 4C 00 00 12 21 00 01 01 4C 00 00 C1 24 00 01 07 4C 00 00' + '47 D6 01 01 01 4C 00 00 43 D5 01 01 01 4C 00 00 2C FF 00 01 0B 4C 00 00 0B D4 01 01 01 4C 00 00' + '38 1D 00 01 08 4C 00 00 13 D6 01 01 01 4C 00 00 7B D6 01 01 01 4C 00 00 DF D5 01 01 01 4C 00 00' + '86 33 00 02 0E 4D 00 00 42 00 00 6A F1 01 02 08 4D 00 00 43 00 00 6B F1 01 02 08 4D 00 00 44 00' + '00 92 33 00 03 0E 4D 00 00 48 00 00 7A 00 00 AB 33 00 03 0E 4D 00 00 50 00 00 61 00 00 6C F1 01' + '02 08 4D 00 00 52 00 00 4B F1 01 02 0E 4D 00 00 56 00 00 B9 33 00 02 0E 4D 00 00 56 00 00 BF 33' + '00 02 0E 4D 00 00 57 00 00 3E 1E 00 02 00 4D 00 00 01 03 00 40 1E 00 02 00 4D 00 00 07 03 00 42' + '1E 00 02 00 4D 00 00 23 03 00 C1 33 00 02 0E 4D 00 00 A9 03 00 44 D5 01 01 01 4D 00 00 C2 24 00' + '01 07 4D 00 00 74 D4 01 01 01 4D 00 00 0C D4 01 01 01 4D 00 00 6F 21 00 01 10 4D 00 00 33 21 00' + '01 01 4D 00 00 40 D4 01 01 01 4D 00 00 AC D5 01 01 01 4D 00 00 E0 D5 01 01 01 4D 00 00 10 D5 01' + '01 01 4D 00 00 7C D6 01 01 01 4D 00 00 3C F1 01 01 0E 4D 00 00 2D FF 00 01 0B 4D 00 00 DC D4 01' + '01 01 4D 00 00 48 D6 01 01 01 4D 00 00 39 1D 00 01 08 4D 00 00 78 D5 01 01 01 4D 00 00 14 D6 01' + '01 01 4D 00 00 CA 01 00 02 10 4E 00 00 4A 00 00 CB 01 00 02 10 4E 00 00 6A 00 00 16 21 00 02 10' + '4E 00 00 6F 00 00 F8 01 00 02 00 4E 00 00 00 03 00 43 01 00 02 00 4E 00 00 01 03 00 D1 00 00 02' + '00 4E 00 00 03 03 00 44 1E 00 02 00 4E 00 00 07 03 00 47 01 00 02 00 4E 00 00 0C 03 00 46 1E 00' + '02 00 4E 00 00 23 03 00 45 01 00 02 00 4E 00 00 27 03 00 4A 1E 00 02 00 4E 00 00 2D 03 00 48 1E' + '00 02 00 4E 00 00 31 03 00 2E FF 00 01 0B 4E 00 00 C3 24 00 01 07 4E 00 00 41 D4 01 01 01 4E 00' + '00 79 D5 01 01 01 4E 00 00 A9 D4 01 01 01 4E 00 00 7D D6 01 01 01 4E 00 00 15 D6 01 01 01 4E 00' + '00 AD D5 01 01 01 4E 00 00 DD D4 01 01 01 4E 00 00 0D D4 01 01 01 4E 00 00 75 D4 01 01 01 4E 00' + '00 49 D6 01 01 01 4E 00 00 E1 D5 01 01 01 4E 00 00 3A 1D 00 01 08 4E 00 00 3D F1 01 01 0E 4E 00' + '00 11 D5 01 01 01 4E 00 00 15 21 00 01 01 4E 00 00 D2 00 00 02 00 4F 00 00 00 03 00 D3 00 00 02' + '00 4F 00 00 01 03 00 D2 1E 00 03 00 4F 00 00 02 03 00 00 03 00 D0 1E 00 03 00 4F 00 00 02 03 00' + '01 03 00 D6 1E 00 03 00 4F 00 00 02 03 00 03 03 00 D4 1E 00 03 00 4F 00 00 02 03 00 09 03 00 D4' + '00 00 02 00 4F 00 00 02 03 00 4C 1E 00 03 00 4F 00 00 03 03 00 01 03 00 2C 02 00 03 00 4F 00 00' + '03 03 00 04 03 00 4E 1E 00 03 00 4F 00 00 03 03 00 08 03 00 D5 00 00 02 00 4F 00 00 03 03 00 50' + '1E 00 03 00 4F 00 00 04 03 00 00 03 00 52 1E 00 03 00 4F 00 00 04 03 00 01 03 00 4C 01 00 02 00' + '4F 00 00 04 03 00 4E 01 00 02 00 4F 00 00 06 03 00 30 02 00 03 00 4F 00 00 07 03 00 04 03 00 2E' + '02 00 02 00 4F 00 00 07 03 00 2A 02 00 03 00 4F 00 00 08 03 00 04 03 00 D6 00 00 02 00 4F 00 00' + '08 03 00 CE 1E 00 02 00 4F 00 00 09 03 00 50 01 00 02 00 4F 00 00 0B 03 00 D1 01 00 02 00 4F 00' + '00 0C 03 00 0C 02 00 02 00 4F 00 00 0F 03 00 0E 02 00 02 00 4F 00 00 11 03 00 DC 1E 00 03 00 4F' + '00 00 1B 03 00 00 03 00 DA 1E 00 03 00 4F 00 00 1B 03 00 01 03 00 E0 1E 00 03 00 4F 00 00 1B 03' + '00 03 03 00 DE 1E 00 03 00 4F 00 00 1B 03 00 09 03 00 E2 1E 00 03 00 4F 00 00 1B 03 00 23 03 00' + 'A0 01 00 02 00 4F 00 00 1B 03 00 D8 1E 00 03 00 4F 00 00 23 03 00 02 03 00 CC 1E 00 02 00 4F 00' + '00 23 03 00 EC 01 00 03 00 4F 00 00 28 03 00 04 03 00 EA 01 00 02 00 4F 00 00 28 03 00 42 D4 01' + '01 01 4F 00 00 16 D6 01 01 01 4F 00 00 2F FF 00 01 0B 4F 00 00 4A D6 01 01 01 4F 00 00 46 D5 01' + '01 01 4F 00 00 7A D5 01 01 01 4F 00 00 12 D5 01 01 01 4F 00 00 3C 1D 00 01 08 4F 00 00 C4 24 00' + '01 07 4F 00 00 76 D4 01 01 01 4F 00 00 E2 D5 01 01 01 4F 00 00 0E D4 01 01 01 4F 00 00 AA D4 01' + '01 01 4F 00 00 3E F1 01 01 0E 4F 00 00 7E D6 01 01 01 4F 00 00 DE D4 01 01 01 4F 00 00 AE D5 01' + '01 01 4F 00 00 D7 33 00 02 0E 50 00 00 48 00 00 D9 33 00 03 0E 50 00 00 50 00 00 4D 00 00 4E F1' + '01 03 0E 50 00 00 50 00 00 56 00 00 DA 33 00 02 0E 50 00 00 52 00 00 50 32 00 03 0E 50 00 00 54' + '00 00 45 00 00 A9 33 00 02 0E 50 00 00 61 00 00 54 1E 00 02 00 50 00 00 01 03 00 56 1E 00 02 00' + '50 00 00 07 03 00 30 FF 00 01 0B 50 00 00 C5 24 00 01 07 50 00 00 7B D5 01 01 01 50 00 00 7F D6' + '01 01 01 50 00 00 3F F1 01 01 0E 50 00 00 DF D4 01 01 01 50 00 00 AF D5 01 01 01 50 00 00 AB D4' + '01 01 01 50 00 00 3E 1D 00 01 08 50 00 00 13 D5 01 01 01 50 00 00 4B D6 01 01 01 50 00 00 77 D4' + '01 01 01 50 00 00 43 D4 01 01 01 50 00 00 19 21 00 01 01 50 00 00 E3 D5 01 01 01 50 00 00 17 D6' + '01 01 01 50 00 00 0F D4 01 01 01 50 00 00 1A 21 00 01 01 51 00 00 78 D4 01 01 01 51 00 00 80 D6' + '01 01 01 51 00 00 18 D6 01 01 01 51 00 00 4C D6 01 01 01 51 00 00 E0 D4 01 01 01 51 00 00 7C D5' + '01 01 01 51 00 00 10 D4 01 01 01 51 00 00 C6 24 00 01 07 51 00 00 14 D5 01 01 01 51 00 00 E4 D5' + '01 01 01 51 00 00 44 D4 01 01 01 51 00 00 40 F1 01 01 0E 51 00 00 B0 D5 01 01 01 51 00 00 31 FF' + '00 01 0B 51 00 00 AC D4 01 01 01 51 00 00 A8 20 00 02 10 52 00 00 73 00 00 54 01 00 02 00 52 00' + '00 01 03 00 58 1E 00 02 00 52 00 00 07 03 00 58 01 00 02 00 52 00 00 0C 03 00 10 02 00 02 00 52' + '00 00 0F 03 00 12 02 00 02 00 52 00 00 11 03 00 5C 1E 00 03 00 52 00 00 23 03 00 04 03 00 5A 1E' + '00 02 00 52 00 00 23 03 00 56 01 00 02 00 52 00 00 27 03 00 5E 1E 00 02 00 52 00 00 31 03 00 4D' + 'D6 01 01 01 52 00 00 32 FF 00 01 0B 52 00 00 45 D4 01 01 01 52 00 00 2C F1 01 01 07 52 00 00 41' + 'F1 01 01 0E 52 00 00 B1 D5 01 01 01 52 00 00 7D D5 01 01 01 52 00 00 1B 21 00 01 01 52 00 00 19' + 'D6 01 01 01 52 00 00 1D 21 00 01 01 52 00 00 1C 21 00 01 01 52 00 00 C7 24 00 01 07 52 00 00 3F' + '1D 00 01 08 52 00 00 11 D4 01 01 01 52 00 00 E5 D5 01 01 01 52 00 00 81 D6 01 01 01 52 00 00 79' + 'D4 01 01 01 52 00 00 E1 D4 01 01 01 52 00 00 4C F1 01 02 0E 53 00 00 44 00 00 20 21 00 02 08 53' + '00 00 4D 00 00 4D F1 01 02 0E 53 00 00 53 00 00 DC 33 00 02 0E 53 00 00 76 00 00 64 1E 00 03 00' + '53 00 00 01 03 00 07 03 00 5A 01 00 02 00 53 00 00 01 03 00 5C 01 00 02 00 53 00 00 02 03 00 60' + '1E 00 02 00 53 00 00 07 03 00 66 1E 00 03 00 53 00 00 0C 03 00 07 03 00 60 01 00 02 00 53 00 00' + '0C 03 00 68 1E 00 03 00 53 00 00 23 03 00 07 03 00 62 1E 00 02 00 53 00 00 23 03 00 18 02 00 02' + '00 53 00 00 26 03 00 5E 01 00 02 00 53 00 00 27 03 00 1A D6 01 01 01 53 00 00 4A D5 01 01 01 53' + '00 00 7A D4 01 01 01 53 00 00 AE D4 01 01 01 53 00 00 E6 D5 01 01 01 53 00 00 C8 24 00 01 07 53' + '00 00 7E D5 01 01 01 53 00 00 82 D6 01 01 01 53 00 00 B2 D5 01 01 01 53 00 00 42 F1 01 01 0E 53' + '00 00 46 D4 01 01 01 53 00 00 E2 D4 01 01 01 53 00 00 16 D5 01 01 01 53 00 00 12 D4 01 01 01 53' + '00 00 4E D6 01 01 01 53 00 00 33 FF 00 01 0B 53 00 00 21 21 00 03 10 54 00 00 45 00 00 4C 00 00' + '94 33 00 03 0E 54 00 00 48 00 00 7A 00 00 22 21 00 02 08 54 00 00 4D 00 00 6A 1E 00 02 00 54 00' + '00 07 03 00 64 01 00 02 00 54 00 00 0C 03 00 6C 1E 00 02 00 54 00 00 23 03 00 1A 02 00 02 00 54' + '00 00 26 03 00 62 01 00 02 00 54 00 00 27 03 00 70 1E 00 02 00 54 00 00 2D 03 00 6E 1E 00 02 00' + '54 00 00 31 03 00 C9 24 00 01 07 54 00 00 E3 D4 01 01 01 54 00 00 1B D6 01 01 01 54 00 00 17 D5' + '01 01 01 54 00 00 4B D5 01 01 01 54 00 00 83 D6 01 01 01 54 00 00 13 D4 01 01 01 54 00 00 4F D6' + '01 01 01 54 00 00 43 F1 01 01 0E 54 00 00 7B D4 01 01 01 54 00 00 7F D5 01 01 01 54 00 00 E7 D5' + '01 01 01 54 00 00 AF D4 01 01 01 54 00 00 47 D4 01 01 01 54 00 00 40 1D 00 01 08 54 00 00 B3 D5' + '01 01 01 54 00 00 34 FF 00 01 0B 54 00 00 D9 00 00 02 00 55 00 00 00 03 00 DA 00 00 02 00 55 00' + '00 01 03 00 DB 00 00 02 00 55 00 00 02 03 00 78 1E 00 03 00 55 00 00 03 03 00 01 03 00 68 01 00' + '02 00 55 00 00 03 03 00 7A 1E 00 03 00 55 00 00 04 03 00 08 03 00 6A 01 00 02 00 55 00 00 04 03' + '00 6C 01 00 02 00 55 00 00 06 03 00 DB 01 00 03 00 55 00 00 08 03 00 00 03 00 D7 01 00 03 00 55' + '00 00 08 03 00 01 03 00 D5 01 00 03 00 55 00 00 08 03 00 04 03 00 D9 01 00 03 00 55 00 00 08 03' + '00 0C 03 00 DC 00 00 02 00 55 00 00 08 03 00 E6 1E 00 02 00 55 00 00 09 03 00 6E 01 00 02 00 55' + '00 00 0A 03 00 70 01 00 02 00 55 00 00 0B 03 00 D3 01 00 02 00 55 00 00 0C 03 00 14 02 00 02 00' + '55 00 00 0F 03 00 16 02 00 02 00 55 00 00 11 03 00 EA 1E 00 03 00 55 00 00 1B 03 00 00 03 00 E8' + '1E 00 03 00 55 00 00 1B 03 00 01 03 00 EE 1E 00 03 00 55 00 00 1B 03 00 03 03 00 EC 1E 00 03 00' + '55 00 00 1B 03 00 09 03 00 F0 1E 00 03 00 55 00 00 1B 03 00 23 03 00 AF 01 00 02 00 55 00 00 1B' + '03 00 E4 1E 00 02 00 55 00 00 23 03 00 72 1E 00 02 00 55 00 00 24 03 00 72 01 00 02 00 55 00 00' + '28 03 00 76 1E 00 02 00 55 00 00 2D 03 00 74 1E 00 02 00 55 00 00 30 03 00 E8 D5 01 01 01 55 00' + '00 CA 24 00 01 07 55 00 00 14 D4 01 01 01 55 00 00 4C D5 01 01 01 55 00 00 44 F1 01 01 0E 55 00' + '00 50 D6 01 01 01 55 00 00 41 1D 00 01 08 55 00 00 48 D4 01 01 01 55 00 00 80 D5 01 01 01 55 00' + '00 B4 D5 01 01 01 55 00 00 35 FF 00 01 0B 55 00 00 B0 D4 01 01 01 55 00 00 7C D4 01 01 01 55 00' + '00 1C D6 01 01 01 55 00 00 84 D6 01 01 01 55 00 00 18 D5 01 01 01 55 00 00 E4 D4 01 01 01 55 00' + '00 67 21 00 04 10 56 00 00 49 00 00 49 00 00 49 00 00 66 21 00 03 10 56 00 00 49 00 00 49 00 00' + '65 21 00 02 10 56 00 00 49 00 00 7C 1E 00 02 00 56 00 00 03 03 00 7E 1E 00 02 00 56 00 00 23 03' + '00 DE 33 00 03 0E 56 00 00 15 22 00 6D 00 00 CB 24 00 01 07 56 00 00 B1 D4 01 01 01 56 00 00 45' + 'F1 01 01 0E 56 00 00 E5 D4 01 01 01 56 00 00 85 D6 01 01 01 56 00 00 81 D5 01 01 01 56 00 00 51' + 'D6 01 01 01 56 00 00 64 21 00 01 10 56 00 00 36 FF 00 01 0B 56 00 00 1D D6 01 01 01 56 00 00 7D' + '2C 00 01 08 56 00 00 7D D4 01 01 01 56 00 00 49 D4 01 01 01 56 00 00 B5 D5 01 01 01 56 00 00 19' + 'D5 01 01 01 56 00 00 15 D4 01 01 01 56 00 00 4D D5 01 01 01 56 00 00 E9 D5 01 01 01 56 00 00 4F' + 'F1 01 02 0E 57 00 00 43 00 00 2E F1 01 02 07 57 00 00 5A 00 00 DD 33 00 02 0E 57 00 00 62 00 00' + '80 1E 00 02 00 57 00 00 00 03 00 82 1E 00 02 00 57 00 00 01 03 00 74 01 00 02 00 57 00 00 02 03' + '00 86 1E 00 02 00 57 00 00 07 03 00 84 1E 00 02 00 57 00 00 08 03 00 88 1E 00 02 00 57 00 00 23' + '03 00 42 1D 00 01 08 57 00 00 7E D4 01 01 01 57 00 00 CC 24 00 01 07 57 00 00 B6 D5 01 01 01 57' + '00 00 4A D4 01 01 01 57 00 00 B2 D4 01 01 01 57 00 00 46 F1 01 01 0E 57 00 00 E6 D4 01 01 01 57' + '00 00 1E D6 01 01 01 57 00 00 86 D6 01 01 01 57 00 00 82 D5 01 01 01 57 00 00 EA D5 01 01 01 57' + '00 00 52 D6 01 01 01 57 00 00 1A D5 01 01 01 57 00 00 4E D5 01 01 01 57 00 00 37 FF 00 01 0B 57' + '00 00 16 D4 01 01 01 57 00 00 6B 21 00 03 10 58 00 00 49 00 00 49 00 00 6A 21 00 02 10 58 00 00' + '49 00 00 8A 1E 00 02 00 58 00 00 07 03 00 8C 1E 00 02 00 58 00 00 08 03 00 47 F1 01 01 0E 58 00' + '00 4F D5 01 01 01 58 00 00 1F D6 01 01 01 58 00 00 7F D4 01 01 01 58 00 00 B3 D4 01 01 01 58 00' + '00 38 FF 00 01 0B 58 00 00 B7 D5 01 01 01 58 00 00 83 D5 01 01 01 58 00 00 E7 D4 01 01 01 58 00' + '00 CD 24 00 01 07 58 00 00 53 D6 01 01 01 58 00 00 87 D6 01 01 01 58 00 00 69 21 00 01 10 58 00' + '00 4B D4 01 01 01 58 00 00 1B D5 01 01 01 58 00 00 EB D5 01 01 01 58 00 00 17 D4 01 01 01 58 00' + '00 F2 1E 00 02 00 59 00 00 00 03 00 DD 00 00 02 00 59 00 00 01 03 00 76 01 00 02 00 59 00 00 02' + '03 00 F8 1E 00 02 00 59 00 00 03 03 00 32 02 00 02 00 59 00 00 04 03 00 8E 1E 00 02 00 59 00 00' + '07 03 00 78 01 00 02 00 59 00 00 08 03 00 F6 1E 00 02 00 59 00 00 09 03 00 F4 1E 00 02 00 59 00' + '00 23 03 00 80 D4 01 01 01 59 00 00 20 D6 01 01 01 59 00 00 CE 24 00 01 07 59 00 00 B4 D4 01 01' + '01 59 00 00 4C D4 01 01 01 59 00 00 88 D6 01 01 01 59 00 00 18 D4 01 01 01 59 00 00 50 D5 01 01' + '01 59 00 00 39 FF 00 01 0B 59 00 00 1C D5 01 01 01 59 00 00 B8 D5 01 01 01 59 00 00 54 D6 01 01' + '01 59 00 00 EC D5 01 01 01 59 00 00 84 D5 01 01 01 59 00 00 48 F1 01 01 0E 59 00 00 E8 D4 01 01' + '01 59 00 00 79 01 00 02 00 5A 00 00 01 03 00 90 1E 00 02 00 5A 00 00 02 03 00 7B 01 00 02 00 5A' + '00 00 07 03 00 7D 01 00 02 00 5A 00 00 0C 03 00 92 1E 00 02 00 5A 00 00 23 03 00 94 1E 00 02 00' + '5A 00 00 31 03 00 19 D4 01 01 01 5A 00 00 89 D6 01 01 01 5A 00 00 3A FF 00 01 0B 5A 00 00 ED D5' + '01 01 01 5A 00 00 21 D6 01 01 01 5A 00 00 81 D4 01 01 01 5A 00 00 B5 D4 01 01 01 5A 00 00 CF 24' + '00 01 07 5A 00 00 49 F1 01 01 0E 5A 00 00 E9 D4 01 01 01 5A 00 00 85 D5 01 01 01 5A 00 00 55 D6' + '01 01 01 5A 00 00 28 21 00 01 01 5A 00 00 24 21 00 01 01 5A 00 00 B9 D5 01 01 01 5A 00 00 4D D4' + '01 01 01 5A 00 00 3B FF 00 01 0B 5B 00 00 47 FE 00 01 0A 5B 00 00 3C FF 00 01 0B 5C 00 00 68 FE' + '00 01 0D 5C 00 00 3D FF 00 01 0B 5D 00 00 48 FE 00 01 0A 5D 00 00 3E FF 00 01 0B 5E 00 00 4D FE' + '00 01 10 5F 00 00 4E FE 00 01 10 5F 00 00 4F FE 00 01 10 5F 00 00 34 FE 00 01 0A 5F 00 00 33 FE' + '00 01 0A 5F 00 00 3F FF 00 01 0B 5F 00 00 40 FF 00 01 0B 60 00 00 C2 33 00 04 0E 61 00 00 2E 00' + '00 6D 00 00 2E 00 00 00 21 00 03 10 61 00 00 2F 00 00 63 00 00 01 21 00 03 10 61 00 00 2F 00 00' + '73 00 00 9A 1E 00 02 10 61 00 00 BE 02 00 E0 00 00 02 00 61 00 00 00 03 00 E1 00 00 02 00 61 00' + '00 01 03 00 A7 1E 00 03 00 61 00 00 02 03 00 00 03 00 A5 1E 00 03 00 61 00 00 02 03 00 01 03 00' + 'AB 1E 00 03 00 61 00 00 02 03 00 03 03 00 A9 1E 00 03 00 61 00 00 02 03 00 09 03 00 E2 00 00 02' + '00 61 00 00 02 03 00 E3 00 00 02 00 61 00 00 03 03 00 01 01 00 02 00 61 00 00 04 03 00 B1 1E 00' + '03 00 61 00 00 06 03 00 00 03 00 AF 1E 00 03 00 61 00 00 06 03 00 01 03 00 B5 1E 00 03 00 61 00' + '00 06 03 00 03 03 00 B3 1E 00 03 00 61 00 00 06 03 00 09 03 00 03 01 00 02 00 61 00 00 06 03 00' + 'E1 01 00 03 00 61 00 00 07 03 00 04 03 00 27 02 00 02 00 61 00 00 07 03 00 DF 01 00 03 00 61 00' + '00 08 03 00 04 03 00 E4 00 00 02 00 61 00 00 08 03 00 A3 1E 00 02 00 61 00 00 09 03 00 FB 01 00' + '03 00 61 00 00 0A 03 00 01 03 00 E5 00 00 02 00 61 00 00 0A 03 00 CE 01 00 02 00 61 00 00 0C 03' + '00 01 02 00 02 00 61 00 00 0F 03 00 03 02 00 02 00 61 00 00 11 03 00 AD 1E 00 03 00 61 00 00 23' + '03 00 02 03 00 B7 1E 00 03 00 61 00 00 23 03 00 06 03 00 A1 1E 00 02 00 61 00 00 23 03 00 01 1E' + '00 02 00 61 00 00 25 03 00 05 01 00 02 00 61 00 00 28 03 00 22 D6 01 01 01 61 00 00 4E D4 01 01' + '01 61 00 00 86 D5 01 01 01 61 00 00 D0 24 00 01 07 61 00 00 1A D4 01 01 01 61 00 00 EE D5 01 01' + '01 61 00 00 1E D5 01 01 01 61 00 00 EA D4 01 01 01 61 00 00 B6 D4 01 01 01 61 00 00 43 1D 00 01' + '08 61 00 00 41 FF 00 01 0B 61 00 00 82 D4 01 01 01 61 00 00 52 D5 01 01 01 61 00 00 8A D6 01 01' + '01 61 00 00 90 20 00 01 09 61 00 00 BA D5 01 01 01 61 00 00 56 D6 01 01 01 61 00 00 AA 00 00 01' + '08 61 00 00 74 33 00 03 0E 62 00 00 61 00 00 72 00 00 03 1E 00 02 00 62 00 00 07 03 00 05 1E 00' + '02 00 62 00 00 23 03 00 07 1E 00 02 00 62 00 00 31 03 00 87 D5 01 01 01 62 00 00 EF D5 01 01 01' + '62 00 00 8B D6 01 01 01 62 00 00 42 FF 00 01 0B 62 00 00 4F D4 01 01 01 62 00 00 83 D4 01 01 01' + '62 00 00 1F D5 01 01 01 62 00 00 23 D6 01 01 01 62 00 00 B7 D4 01 01 01 62 00 00 57 D6 01 01 01' + '62 00 00 53 D5 01 01 01 62 00 00 D1 24 00 01 07 62 00 00 EB D4 01 01 01 62 00 00 47 1D 00 01 08' + '62 00 00 BB D5 01 01 01 62 00 00 1B D4 01 01 01 62 00 00 05 21 00 03 10 63 00 00 2F 00 00 6F 00' + '00 06 21 00 03 10 63 00 00 2F 00 00 75 00 00 88 33 00 03 0E 63 00 00 61 00 00 6C 00 00 C4 33 00' + '02 0E 63 00 00 63 00 00 C5 33 00 02 0E 63 00 00 64 00 00 A0 33 00 03 0E 63 00 00 6D 00 00 32 00' + '00 A4 33 00 03 0E 63 00 00 6D 00 00 33 00 00 9D 33 00 02 0E 63 00 00 6D 00 00 07 01 00 02 00 63' + '00 00 01 03 00 09 01 00 02 00 63 00 00 02 03 00 0B 01 00 02 00 63 00 00 07 03 00 0D 01 00 02 00' + '63 00 00 0C 03 00 09 1E 00 03 00 63 00 00 27 03 00 01 03 00 E7 00 00 02 00 63 00 00 27 03 00 BC' + 'D5 01 01 01 63 00 00 84 D4 01 01 01 63 00 00 54 D5 01 01 01 63 00 00 43 FF 00 01 0B 63 00 00 D2' + '24 00 01 07 63 00 00 F0 D5 01 01 01 63 00 00 7D 21 00 01 10 63 00 00 20 D5 01 01 01 63 00 00 88' + 'D5 01 01 01 63 00 00 9C 1D 00 01 08 63 00 00 58 D6 01 01 01 63 00 00 EC D4 01 01 01 63 00 00 1C' + 'D4 01 01 01 63 00 00 B8 D4 01 01 01 63 00 00 24 D6 01 01 01 63 00 00 50 D4 01 01 01 63 00 00 8C' + 'D6 01 01 01 63 00 00 C8 33 00 02 0E 64 00 00 42 00 00 72 33 00 02 0E 64 00 00 61 00 00 97 33 00' + '02 0E 64 00 00 6C 00 00 78 33 00 03 0E 64 00 00 6D 00 00 32 00 00 79 33 00 03 0E 64 00 00 6D 00' + '00 33 00 00 77 33 00 02 0E 64 00 00 6D 00 00 C6 01 00 03 10 64 00 00 7A 00 00 0C 03 00 F3 01 00' + '02 10 64 00 00 7A 00 00 0B 1E 00 02 00 64 00 00 07 03 00 0F 01 00 02 00 64 00 00 0C 03 00 0D 1E' + '00 02 00 64 00 00 23 03 00 11 1E 00 02 00 64 00 00 27 03 00 13 1E 00 02 00 64 00 00 2D 03 00 0F' + '1E 00 02 00 64 00 00 31 03 00 7E 21 00 01 10 64 00 00 8D D6 01 01 01 64 00 00 F1 D5 01 01 01 64' + '00 00 B9 D4 01 01 01 64 00 00 1D D4 01 01 01 64 00 00 BD D5 01 01 01 64 00 00 46 21 00 01 01 64' + '00 00 48 1D 00 01 08 64 00 00 25 D6 01 01 01 64 00 00 D3 24 00 01 07 64 00 00 89 D5 01 01 01 64' + '00 00 55 D5 01 01 01 64 00 00 21 D5 01 01 01 64 00 00 59 D6 01 01 01 64 00 00 ED D4 01 01 01 64' + '00 00 44 FF 00 01 0B 64 00 00 85 D4 01 01 01 64 00 00 51 D4 01 01 01 64 00 00 CE 32 00 02 0E 65' + '00 00 56 00 00 CD 32 00 03 0E 65 00 00 72 00 00 67 00 00 E8 00 00 02 00 65 00 00 00 03 00 E9 00' + '00 02 00 65 00 00 01 03 00 C1 1E 00 03 00 65 00 00 02 03 00 00 03 00 BF 1E 00 03 00 65 00 00 02' + '03 00 01 03 00 C5 1E 00 03 00 65 00 00 02 03 00 03 03 00 C3 1E 00 03 00 65 00 00 02 03 00 09 03' + '00 EA 00 00 02 00 65 00 00 02 03 00 BD 1E 00 02 00 65 00 00 03 03 00 15 1E 00 03 00 65 00 00 04' + '03 00 00 03 00 17 1E 00 03 00 65 00 00 04 03 00 01 03 00 13 01 00 02 00 65 00 00 04 03 00 15 01' + '00 02 00 65 00 00 06 03 00 17 01 00 02 00 65 00 00 07 03 00 EB 00 00 02 00 65 00 00 08 03 00 BB' + '1E 00 02 00 65 00 00 09 03 00 1B 01 00 02 00 65 00 00 0C 03 00 05 02 00 02 00 65 00 00 0F 03 00' + '07 02 00 02 00 65 00 00 11 03 00 C7 1E 00 03 00 65 00 00 23 03 00 02 03 00 B9 1E 00 02 00 65 00' + '00 23 03 00 1D 1E 00 03 00 65 00 00 27 03 00 06 03 00 29 02 00 02 00 65 00 00 27 03 00 19 01 00' + '02 00 65 00 00 28 03 00 19 1E 00 02 00 65 00 00 2D 03 00 1B 1E 00 02 00 65 00 00 30 03 00 22 D5' + '01 01 01 65 00 00 F2 D5 01 01 01 65 00 00 26 D6 01 01 01 65 00 00 5A D6 01 01 01 65 00 00 EE D4' + '01 01 01 65 00 00 8E D6 01 01 01 65 00 00 49 1D 00 01 08 65 00 00 56 D5 01 01 01 65 00 00 47 21' + '00 01 01 65 00 00 8A D5 01 01 01 65 00 00 52 D4 01 01 01 65 00 00 BE D5 01 01 01 65 00 00 2F 21' + '00 01 01 65 00 00 91 20 00 01 09 65 00 00 45 FF 00 01 0B 65 00 00 D4 24 00 01 07 65 00 00 1E D4' + '01 01 01 65 00 00 86 D4 01 01 01 65 00 00 03 FB 00 03 10 66 00 00 66 00 00 69 00 00 04 FB 00 03' + '10 66 00 00 66 00 00 6C 00 00 00 FB 00 02 10 66 00 00 66 00 00 01 FB 00 02 10 66 00 00 69 00 00' + '02 FB 00 02 10 66 00 00 6C 00 00 99 33 00 02 0E 66 00 00 6D 00 00 1F 1E 00 02 00 66 00 00 07 03' + '00 BF D5 01 01 01 66 00 00 F3 D5 01 01 01 66 00 00 BB D4 01 01 01 66 00 00 1F D4 01 01 01 66 00' + '00 A0 1D 00 01 08 66 00 00 D5 24 00 01 07 66 00 00 8F D6 01 01 01 66 00 00 57 D5 01 01 01 66 00' + '00 46 FF 00 01 0B 66 00 00 5B D6 01 01 01 66 00 00 27 D6 01 01 01 66 00 00 87 D4 01 01 01 66 00' + '00 23 D5 01 01 01 66 00 00 53 D4 01 01 01 66 00 00 8B D5 01 01 01 66 00 00 EF D4 01 01 01 66 00' + '00 FF 33 00 03 0E 67 00 00 61 00 00 6C 00 00 F5 01 00 02 00 67 00 00 01 03 00 1D 01 00 02 00 67' + '00 00 02 03 00 21 1E 00 02 00 67 00 00 04 03 00 1F 01 00 02 00 67 00 00 06 03 00 21 01 00 02 00' + '67 00 00 07 03 00 E7 01 00 02 00 67 00 00 0C 03 00 23 01 00 02 00 67 00 00 27 03 00 5C D6 01 01' + '01 67 00 00 58 D5 01 01 01 67 00 00 88 D4 01 01 01 67 00 00 20 D4 01 01 01 67 00 00 C0 D5 01 01' + '01 67 00 00 D6 24 00 01 07 67 00 00 0A 21 00 01 01 67 00 00 47 FF 00 01 0B 67 00 00 F4 D5 01 01' + '01 67 00 00 F0 D4 01 01 01 67 00 00 54 D4 01 01 01 67 00 00 4D 1D 00 01 08 67 00 00 8C D5 01 01' + '01 67 00 00 28 D6 01 01 01 67 00 00 90 D6 01 01 01 67 00 00 24 D5 01 01 01 67 00 00 71 33 00 03' + '0E 68 00 00 50 00 00 61 00 00 CA 33 00 02 0E 68 00 00 61 00 00 25 01 00 02 00 68 00 00 02 03 00' + '23 1E 00 02 00 68 00 00 07 03 00 27 1E 00 02 00 68 00 00 08 03 00 1F 02 00 02 00 68 00 00 0C 03' + '00 25 1E 00 02 00 68 00 00 23 03 00 29 1E 00 02 00 68 00 00 27 03 00 2B 1E 00 02 00 68 00 00 2E' + '03 00 96 1E 00 02 00 68 00 00 31 03 00 F5 D5 01 01 01 68 00 00 25 D5 01 01 01 68 00 00 8D D5 01' + '01 01 68 00 00 0E 21 00 01 01 68 00 00 C1 D5 01 01 01 68 00 00 21 D4 01 01 01 68 00 00 48 FF 00' + '01 0B 68 00 00 29 D6 01 01 01 68 00 00 91 D6 01 01 01 68 00 00 89 D4 01 01 01 68 00 00 5D D6 01' + '01 01 68 00 00 D7 24 00 01 07 68 00 00 95 20 00 01 09 68 00 00 F1 D4 01 01 01 68 00 00 B0 02 00' + '01 08 68 00 00 BD D4 01 01 01 68 00 00 59 D5 01 01 01 68 00 00 72 21 00 03 10 69 00 00 69 00 00' + '69 00 00 71 21 00 02 10 69 00 00 69 00 00 33 01 00 02 10 69 00 00 6A 00 00 CC 33 00 02 0E 69 00' + '00 6E 00 00 73 21 00 02 10 69 00 00 76 00 00 78 21 00 02 10 69 00 00 78 00 00 EC 00 00 02 00 69' + '00 00 00 03 00 ED 00 00 02 00 69 00 00 01 03 00 EE 00 00 02 00 69 00 00 02 03 00 29 01 00 02 00' + '69 00 00 03 03 00 2B 01 00 02 00 69 00 00 04 03 00 2D 01 00 02 00 69 00 00 06 03 00 2F 1E 00 03' + '00 69 00 00 08 03 00 01 03 00 EF 00 00 02 00 69 00 00 08 03 00 C9 1E 00 02 00 69 00 00 09 03 00' + 'D0 01 00 02 00 69 00 00 0C 03 00 09 02 00 02 00 69 00 00 0F 03 00 0B 02 00 02 00 69 00 00 11 03' + '00 CB 1E 00 02 00 69 00 00 23 03 00 2F 01 00 02 00 69 00 00 28 03 00 2D 1E 00 02 00 69 00 00 30' + '03 00 8E D5 01 01 01 69 00 00 BE D4 01 01 01 69 00 00 56 D4 01 01 01 69 00 00 70 21 00 01 10 69' + '00 00 26 D5 01 01 01 69 00 00 62 1D 00 01 09 69 00 00 F6 D5 01 01 01 69 00 00 48 21 00 01 01 69' + '00 00 5E D6 01 01 01 69 00 00 2A D6 01 01 01 69 00 00 D8 24 00 01 07 69 00 00 49 FF 00 01 0B 69' + '00 00 22 D4 01 01 01 69 00 00 5A D5 01 01 01 69 00 00 71 20 00 01 08 69 00 00 F2 D4 01 01 01 69' + '00 00 92 D6 01 01 01 69 00 00 C2 D5 01 01 01 69 00 00 8A D4 01 01 01 69 00 00 39 21 00 01 01 69' + '00 00 35 01 00 02 00 6A 00 00 02 03 00 F0 01 00 02 00 6A 00 00 0C 03 00 C3 D5 01 01 01 6A 00 00' + '5B D5 01 01 01 6A 00 00 49 21 00 01 01 6A 00 00 BF D4 01 01 01 6A 00 00 8F D5 01 01 01 6A 00 00' + '57 D4 01 01 01 6A 00 00 7C 2C 00 01 09 6A 00 00 5F D6 01 01 01 6A 00 00 B2 02 00 01 08 6A 00 00' + '2B D6 01 01 01 6A 00 00 F3 D4 01 01 01 6A 00 00 D9 24 00 01 07 6A 00 00 4A FF 00 01 0B 6A 00 00' + '93 D6 01 01 01 6A 00 00 23 D4 01 01 01 6A 00 00 8B D4 01 01 01 6A 00 00 27 D5 01 01 01 6A 00 00' + 'F7 D5 01 01 01 6A 00 00 84 33 00 02 0E 6B 00 00 41 00 00 91 33 00 03 0E 6B 00 00 48 00 00 7A 00' + '00 AA 33 00 03 0E 6B 00 00 50 00 00 61 00 00 B8 33 00 02 0E 6B 00 00 56 00 00 BE 33 00 02 0E 6B' + '00 00 57 00 00 89 33 00 04 0E 6B 00 00 63 00 00 61 00 00 6C 00 00 8F 33 00 02 0E 6B 00 00 67 00' + '00 98 33 00 02 0E 6B 00 00 6C 00 00 A2 33 00 03 0E 6B 00 00 6D 00 00 32 00 00 A6 33 00 03 0E 6B' + '00 00 6D 00 00 33 00 00 9E 33 00 02 0E 6B 00 00 6D 00 00 CF 33 00 02 0E 6B 00 00 74 00 00 31 1E' + '00 02 00 6B 00 00 01 03 00 E9 01 00 02 00 6B 00 00 0C 03 00 33 1E 00 02 00 6B 00 00 23 03 00 37' + '01 00 02 00 6B 00 00 27 03 00 35 1E 00 02 00 6B 00 00 31 03 00 C0 33 00 02 0E 6B 00 00 A9 03 00' + 'C0 D4 01 01 01 6B 00 00 96 20 00 01 09 6B 00 00 5C D5 01 01 01 6B 00 00 DA 24 00 01 07 6B 00 00' + '4B FF 00 01 0B 6B 00 00 2C D6 01 01 01 6B 00 00 8C D4 01 01 01 6B 00 00 60 D6 01 01 01 6B 00 00' + '94 D6 01 01 01 6B 00 00 90 D5 01 01 01 6B 00 00 4F 1D 00 01 08 6B 00 00 C4 D5 01 01 01 6B 00 00' + 'F8 D5 01 01 01 6B 00 00 28 D5 01 01 01 6B 00 00 58 D4 01 01 01 6B 00 00 24 D4 01 01 01 6B 00 00' + 'F4 D4 01 01 01 6B 00 00 C9 01 00 02 10 6C 00 00 6A 00 00 D0 33 00 02 0E 6C 00 00 6D 00 00 D1 33' + '00 02 0E 6C 00 00 6E 00 00 D2 33 00 03 0E 6C 00 00 6F 00 00 67 00 00 D3 33 00 02 0E 6C 00 00 78' + '00 00 40 01 00 02 10 6C 00 00 B7 00 00 3A 01 00 02 00 6C 00 00 01 03 00 3E 01 00 02 00 6C 00 00' + '0C 03 00 39 1E 00 03 00 6C 00 00 23 03 00 04 03 00 37 1E 00 02 00 6C 00 00 23 03 00 3C 01 00 02' + '00 6C 00 00 27 03 00 3D 1E 00 02 00 6C 00 00 2D 03 00 3B 1E 00 02 00 6C 00 00 31 03 00 91 D5 01' + '01 01 6C 00 00 25 D4 01 01 01 6C 00 00 C1 D4 01 01 01 6C 00 00 59 D4 01 01 01 6C 00 00 95 D6 01' + '01 01 6C 00 00 8D D4 01 01 01 6C 00 00 13 21 00 01 01 6C 00 00 5D D5 01 01 01 6C 00 00 97 20 00' + '01 09 6C 00 00 4C FF 00 01 0B 6C 00 00 7C 21 00 01 10 6C 00 00 29 D5 01 01 01 6C 00 00 C5 D5 01' + '01 01 6C 00 00 F9 D5 01 01 01 6C 00 00 E1 02 00 01 08 6C 00 00 F5 D4 01 01 01 6C 00 00 DB 24 00' + '01 07 6C 00 00 61 D6 01 01 01 6C 00 00 2D D6 01 01 01 6C 00 00 A1 33 00 02 0E 6D 00 00 32 00 00' + 'A5 33 00 02 0E 6D 00 00 33 00 00 83 33 00 02 0E 6D 00 00 41 00 00 B7 33 00 02 0E 6D 00 00 56 00' + '00 BD 33 00 02 0E 6D 00 00 57 00 00 D4 33 00 02 0E 6D 00 00 62 00 00 8E 33 00 02 0E 6D 00 00 67' + '00 00 D5 33 00 03 0E 6D 00 00 69 00 00 6C 00 00 96 33 00 02 0E 6D 00 00 6C 00 00 9F 33 00 03 0E' + '6D 00 00 6D 00 00 32 00 00 A3 33 00 03 0E 6D 00 00 6D 00 00 33 00 00 9C 33 00 02 0E 6D 00 00 6D' + '00 00 D6 33 00 03 0E 6D 00 00 6F 00 00 6C 00 00 B3 33 00 02 0E 6D 00 00 73 00 00 3F 1E 00 02 00' + '6D 00 00 01 03 00 41 1E 00 02 00 6D 00 00 07 03 00 43 1E 00 02 00 6D 00 00 23 03 00 A8 33 00 04' + '0E 6D 00 00 15 22 00 73 00 00 32 00 00 A7 33 00 03 0E 6D 00 00 15 22 00 73 00 00 98 20 00 01 09' + '6D 00 00 8E D4 01 01 01 6D 00 00 2A D5 01 01 01 6D 00 00 2E D6 01 01 01 6D 00 00 DC 24 00 01 07' + '6D 00 00 26 D4 01 01 01 6D 00 00 4D FF 00 01 0B 6D 00 00 FA D5 01 01 01 6D 00 00 96 D6 01 01 01' + '6D 00 00 5A D4 01 01 01 6D 00 00 50 1D 00 01 08 6D 00 00 5E D5 01 01 01 6D 00 00 F6 D4 01 01 01' + '6D 00 00 7F 21 00 01 10 6D 00 00 C2 D4 01 01 01 6D 00 00 62 D6 01 01 01 6D 00 00 92 D5 01 01 01' + '6D 00 00 C6 D5 01 01 01 6D 00 00 81 33 00 02 0E 6E 00 00 41 00 00 8B 33 00 02 0E 6E 00 00 46 00' + '00 B5 33 00 02 0E 6E 00 00 56 00 00 BB 33 00 02 0E 6E 00 00 57 00 00 CC 01 00 02 10 6E 00 00 6A' + '00 00 9A 33 00 02 0E 6E 00 00 6D 00 00 B1 33 00 02 0E 6E 00 00 73 00 00 F9 01 00 02 00 6E 00 00' + '00 03 00 44 01 00 02 00 6E 00 00 01 03 00 F1 00 00 02 00 6E 00 00 03 03 00 45 1E 00 02 00 6E 00' + '00 07 03 00 48 01 00 02 00 6E 00 00 0C 03 00 47 1E 00 02 00 6E 00 00 23 03 00 46 01 00 02 00 6E' + '00 00 27 03 00 4B 1E 00 02 00 6E 00 00 2D 03 00 49 1E 00 02 00 6E 00 00 31 03 00 DD 24 00 01 07' + '6E 00 00 8F D4 01 01 01 6E 00 00 FB D5 01 01 01 6E 00 00 97 D6 01 01 01 6E 00 00 5B D4 01 01 01' + '6E 00 00 C7 D5 01 01 01 6E 00 00 4E FF 00 01 0B 6E 00 00 99 20 00 01 09 6E 00 00 C3 D4 01 01 01' + '6E 00 00 2F D6 01 01 01 6E 00 00 7F 20 00 01 08 6E 00 00 F7 D4 01 01 01 6E 00 00 93 D5 01 01 01' + '6E 00 00 2B D5 01 01 01 6E 00 00 5F D5 01 01 01 6E 00 00 63 D6 01 01 01 6E 00 00 27 D4 01 01 01' + '6E 00 00 75 33 00 02 0E 6F 00 00 56 00 00 F2 00 00 02 00 6F 00 00 00 03 00 F3 00 00 02 00 6F 00' + '00 01 03 00 D3 1E 00 03 00 6F 00 00 02 03 00 00 03 00 D1 1E 00 03 00 6F 00 00 02 03 00 01 03 00' + 'D7 1E 00 03 00 6F 00 00 02 03 00 03 03 00 D5 1E 00 03 00 6F 00 00 02 03 00 09 03 00 F4 00 00 02' + '00 6F 00 00 02 03 00 4D 1E 00 03 00 6F 00 00 03 03 00 01 03 00 2D 02 00 03 00 6F 00 00 03 03 00' + '04 03 00 4F 1E 00 03 00 6F 00 00 03 03 00 08 03 00 F5 00 00 02 00 6F 00 00 03 03 00 51 1E 00 03' + '00 6F 00 00 04 03 00 00 03 00 53 1E 00 03 00 6F 00 00 04 03 00 01 03 00 4D 01 00 02 00 6F 00 00' + '04 03 00 4F 01 00 02 00 6F 00 00 06 03 00 31 02 00 03 00 6F 00 00 07 03 00 04 03 00 2F 02 00 02' + '00 6F 00 00 07 03 00 2B 02 00 03 00 6F 00 00 08 03 00 04 03 00 F6 00 00 02 00 6F 00 00 08 03 00' + 'CF 1E 00 02 00 6F 00 00 09 03 00 51 01 00 02 00 6F 00 00 0B 03 00 D2 01 00 02 00 6F 00 00 0C 03' + '00 0D 02 00 02 00 6F 00 00 0F 03 00 0F 02 00 02 00 6F 00 00 11 03 00 DD 1E 00 03 00 6F 00 00 1B' + '03 00 00 03 00 DB 1E 00 03 00 6F 00 00 1B 03 00 01 03 00 E1 1E 00 03 00 6F 00 00 1B 03 00 03 03' + '00 DF 1E 00 03 00 6F 00 00 1B 03 00 09 03 00 E3 1E 00 03 00 6F 00 00 1B 03 00 23 03 00 A1 01 00' + '02 00 6F 00 00 1B 03 00 D9 1E 00 03 00 6F 00 00 23 03 00 02 03 00 CD 1E 00 02 00 6F 00 00 23 03' + '00 ED 01 00 03 00 6F 00 00 28 03 00 04 03 00 EB 01 00 02 00 6F 00 00 28 03 00 52 1D 00 01 08 6F' + '00 00 94 D5 01 01 01 6F 00 00 5C D4 01 01 01 6F 00 00 98 D6 01 01 01 6F 00 00 DE 24 00 01 07 6F' + '00 00 4F FF 00 01 0B 6F 00 00 C8 D5 01 01 01 6F 00 00 30 D6 01 01 01 6F 00 00 BA 00 00 01 08 6F' + '00 00 2C D5 01 01 01 6F 00 00 FC D5 01 01 01 6F 00 00 F8 D4 01 01 01 6F 00 00 60 D5 01 01 01 6F' + '00 00 64 D6 01 01 01 6F 00 00 34 21 00 01 01 6F 00 00 92 20 00 01 09 6F 00 00 90 D4 01 01 01 6F' + '00 00 28 D4 01 01 01 6F 00 00 D8 33 00 04 0E 70 00 00 2E 00 00 6D 00 00 2E 00 00 80 33 00 02 0E' + '70 00 00 41 00 00 8A 33 00 02 0E 70 00 00 46 00 00 B4 33 00 02 0E 70 00 00 56 00 00 BA 33 00 02' + '0E 70 00 00 57 00 00 76 33 00 02 0E 70 00 00 63 00 00 B0 33 00 02 0E 70 00 00 73 00 00 55 1E 00' + '02 00 70 00 00 01 03 00 57 1E 00 02 00 70 00 00 07 03 00 29 D4 01 01 01 70 00 00 95 D5 01 01 01' + '70 00 00 91 D4 01 01 01 70 00 00 99 D6 01 01 01 70 00 00 FD D5 01 01 01 70 00 00 56 1D 00 01 08' + '70 00 00 5D D4 01 01 01 70 00 00 50 FF 00 01 0B 70 00 00 31 D6 01 01 01 70 00 00 65 D6 01 01 01' + '70 00 00 C5 D4 01 01 01 70 00 00 2D D5 01 01 01 70 00 00 9A 20 00 01 09 70 00 00 61 D5 01 01 01' + '70 00 00 DF 24 00 01 07 70 00 00 F9 D4 01 01 01 70 00 00 C9 D5 01 01 01 70 00 00 9A D6 01 01 01' + '71 00 00 62 D5 01 01 01 71 00 00 5E D4 01 01 01 71 00 00 2A D4 01 01 01 71 00 00 FE D5 01 01 01' + '71 00 00 FA D4 01 01 01 71 00 00 66 D6 01 01 01 71 00 00 2E D5 01 01 01 71 00 00 92 D4 01 01 01' + '71 00 00 C6 D4 01 01 01 71 00 00 51 FF 00 01 0B 71 00 00 32 D6 01 01 01 71 00 00 CA D5 01 01 01' + '71 00 00 E0 24 00 01 07 71 00 00 96 D5 01 01 01 71 00 00 AF 33 00 06 0E 72 00 00 61 00 00 64 00' + '00 15 22 00 73 00 00 32 00 00 AE 33 00 05 0E 72 00 00 61 00 00 64 00 00 15 22 00 73 00 00 AD 33' + '00 03 0E 72 00 00 61 00 00 64 00 00 55 01 00 02 00 72 00 00 01 03 00 59 1E 00 02 00 72 00 00 07' + '03 00 59 01 00 02 00 72 00 00 0C 03 00 11 02 00 02 00 72 00 00 0F 03 00 13 02 00 02 00 72 00 00' + '11 03 00 5D 1E 00 03 00 72 00 00 23 03 00 04 03 00 5B 1E 00 02 00 72 00 00 23 03 00 57 01 00 02' + '00 72 00 00 27 03 00 5F 1E 00 02 00 72 00 00 31 03 00 B3 02 00 01 08 72 00 00 63 1D 00 01 09 72' + '00 00 93 D4 01 01 01 72 00 00 33 D6 01 01 01 72 00 00 67 D6 01 01 01 72 00 00 9B D6 01 01 01 72' + '00 00 C7 D4 01 01 01 72 00 00 2F D5 01 01 01 72 00 00 FB D4 01 01 01 72 00 00 5F D4 01 01 01 72' + '00 00 FF D5 01 01 01 72 00 00 63 D5 01 01 01 72 00 00 52 FF 00 01 0B 72 00 00 2B D4 01 01 01 72' + '00 00 97 D5 01 01 01 72 00 00 CB D5 01 01 01 72 00 00 E1 24 00 01 07 72 00 00 DB 33 00 02 0E 73' + '00 00 72 00 00 06 FB 00 02 10 73 00 00 74 00 00 05 FB 00 02 10 73 00 00 74 00 00 65 1E 00 03 00' + '73 00 00 01 03 00 07 03 00 5B 01 00 02 00 73 00 00 01 03 00 5D 01 00 02 00 73 00 00 02 03 00 9B' + '1E 00 02 00 73 00 00 07 03 00 61 1E 00 02 00 73 00 00 07 03 00 67 1E 00 03 00 73 00 00 0C 03 00' + '07 03 00 61 01 00 02 00 73 00 00 0C 03 00 69 1E 00 03 00 73 00 00 23 03 00 07 03 00 63 1E 00 02' + '00 73 00 00 23 03 00 19 02 00 02 00 73 00 00 26 03 00 5F 01 00 02 00 73 00 00 27 03 00 CC D5 01' + '01 01 73 00 00 68 D6 01 01 01 73 00 00 98 D5 01 01 01 73 00 00 C8 D4 01 01 01 73 00 00 FC D4 01' + '01 01 73 00 00 7F 01 00 01 10 73 00 00 9C D6 01 01 01 73 00 00 60 D4 01 01 01 73 00 00 00 D6 01' + '01 01 73 00 00 53 FF 00 01 0B 73 00 00 2C D4 01 01 01 73 00 00 64 D5 01 01 01 73 00 00 34 D6 01' + '01 01 73 00 00 94 D4 01 01 01 73 00 00 9B 20 00 01 09 73 00 00 E2 02 00 01 08 73 00 00 E2 24 00' + '01 07 73 00 00 30 D5 01 01 01 73 00 00 6B 1E 00 02 00 74 00 00 07 03 00 97 1E 00 02 00 74 00 00' + '08 03 00 65 01 00 02 00 74 00 00 0C 03 00 6D 1E 00 02 00 74 00 00 23 03 00 1B 02 00 02 00 74 00' + '00 26 03 00 63 01 00 02 00 74 00 00 27 03 00 71 1E 00 02 00 74 00 00 2D 03 00 6F 1E 00 02 00 74' + '00 00 31 03 00 61 D4 01 01 01 74 00 00 CD D5 01 01 01 74 00 00 65 D5 01 01 01 74 00 00 2D D4 01' + '01 01 74 00 00 E3 24 00 01 07 74 00 00 31 D5 01 01 01 74 00 00 95 D4 01 01 01 74 00 00 99 D5 01' + '01 01 74 00 00 FD D4 01 01 01 74 00 00 C9 D4 01 01 01 74 00 00 9C 20 00 01 09 74 00 00 35 D6 01' + '01 01 74 00 00 69 D6 01 01 01 74 00 00 57 1D 00 01 08 74 00 00 54 FF 00 01 0B 74 00 00 9D D6 01' + '01 01 74 00 00 01 D6 01 01 01 74 00 00 F9 00 00 02 00 75 00 00 00 03 00 FA 00 00 02 00 75 00 00' + '01 03 00 FB 00 00 02 00 75 00 00 02 03 00 79 1E 00 03 00 75 00 00 03 03 00 01 03 00 69 01 00 02' + '00 75 00 00 03 03 00 7B 1E 00 03 00 75 00 00 04 03 00 08 03 00 6B 01 00 02 00 75 00 00 04 03 00' + '6D 01 00 02 00 75 00 00 06 03 00 DC 01 00 03 00 75 00 00 08 03 00 00 03 00 D8 01 00 03 00 75 00' + '00 08 03 00 01 03 00 D6 01 00 03 00 75 00 00 08 03 00 04 03 00 DA 01 00 03 00 75 00 00 08 03 00' + '0C 03 00 FC 00 00 02 00 75 00 00 08 03 00 E7 1E 00 02 00 75 00 00 09 03 00 6F 01 00 02 00 75 00' + '00 0A 03 00 71 01 00 02 00 75 00 00 0B 03 00 D4 01 00 02 00 75 00 00 0C 03 00 15 02 00 02 00 75' + '00 00 0F 03 00 17 02 00 02 00 75 00 00 11 03 00 EB 1E 00 03 00 75 00 00 1B 03 00 00 03 00 E9 1E' + '00 03 00 75 00 00 1B 03 00 01 03 00 EF 1E 00 03 00 75 00 00 1B 03 00 03 03 00 ED 1E 00 03 00 75' + '00 00 1B 03 00 09 03 00 F1 1E 00 03 00 75 00 00 1B 03 00 23 03 00 B0 01 00 02 00 75 00 00 1B 03' + '00 E5 1E 00 02 00 75 00 00 23 03 00 73 1E 00 02 00 75 00 00 24 03 00 73 01 00 02 00 75 00 00 28' + '03 00 77 1E 00 02 00 75 00 00 2D 03 00 75 1E 00 02 00 75 00 00 30 03 00 55 FF 00 01 0B 75 00 00' + 'FE D4 01 01 01 75 00 00 CA D4 01 01 01 75 00 00 E4 24 00 01 07 75 00 00 CE D5 01 01 01 75 00 00' + '9E D6 01 01 01 75 00 00 66 D5 01 01 01 75 00 00 2E D4 01 01 01 75 00 00 36 D6 01 01 01 75 00 00' + '9A D5 01 01 01 75 00 00 6A D6 01 01 01 75 00 00 64 1D 00 01 09 75 00 00 58 1D 00 01 08 75 00 00' + '96 D4 01 01 01 75 00 00 02 D6 01 01 01 75 00 00 32 D5 01 01 01 75 00 00 62 D4 01 01 01 75 00 00' + '77 21 00 04 10 76 00 00 69 00 00 69 00 00 69 00 00 76 21 00 03 10 76 00 00 69 00 00 69 00 00 75' + '21 00 02 10 76 00 00 69 00 00 7D 1E 00 02 00 76 00 00 03 03 00 7F 1E 00 02 00 76 00 00 23 03 00' + '03 D6 01 01 01 76 00 00 74 21 00 01 10 76 00 00 37 D6 01 01 01 76 00 00 E5 24 00 01 07 76 00 00' + '63 D4 01 01 01 76 00 00 CB D4 01 01 01 76 00 00 CF D5 01 01 01 76 00 00 65 1D 00 01 09 76 00 00' + 'FF D4 01 01 01 76 00 00 67 D5 01 01 01 76 00 00 33 D5 01 01 01 76 00 00 9F D6 01 01 01 76 00 00' + '97 D4 01 01 01 76 00 00 5B 1D 00 01 08 76 00 00 9B D5 01 01 01 76 00 00 2F D4 01 01 01 76 00 00' + '56 FF 00 01 0B 76 00 00 6B D6 01 01 01 76 00 00 81 1E 00 02 00 77 00 00 00 03 00 83 1E 00 02 00' + '77 00 00 01 03 00 75 01 00 02 00 77 00 00 02 03 00 87 1E 00 02 00 77 00 00 07 03 00 85 1E 00 02' + '00 77 00 00 08 03 00 98 1E 00 02 00 77 00 00 0A 03 00 89 1E 00 02 00 77 00 00 23 03 00 B7 02 00' + '01 08 77 00 00 64 D4 01 01 01 77 00 00 34 D5 01 01 01 77 00 00 E6 24 00 01 07 77 00 00 D0 D5 01' + '01 01 77 00 00 38 D6 01 01 01 77 00 00 57 FF 00 01 0B 77 00 00 9C D5 01 01 01 77 00 00 68 D5 01' + '01 01 77 00 00 A0 D6 01 01 01 77 00 00 6C D6 01 01 01 77 00 00 00 D5 01 01 01 77 00 00 30 D4 01' + '01 01 77 00 00 04 D6 01 01 01 77 00 00 98 D4 01 01 01 77 00 00 CC D4 01 01 01 77 00 00 7B 21 00' + '03 10 78 00 00 69 00 00 69 00 00 7A 21 00 02 10 78 00 00 69 00 00 8B 1E 00 02 00 78 00 00 07 03' + '00 8D 1E 00 02 00 78 00 00 08 03 00 79 21 00 01 10 78 00 00 D1 D5 01 01 01 78 00 00 35 D5 01 01' + '01 78 00 00 93 20 00 01 09 78 00 00 58 FF 00 01 0B 78 00 00 05 D6 01 01 01 78 00 00 6D D6 01 01' + '01 78 00 00 A1 D6 01 01 01 78 00 00 31 D4 01 01 01 78 00 00 69 D5 01 01 01 78 00 00 39 D6 01 01' + '01 78 00 00 99 D4 01 01 01 78 00 00 CD D4 01 01 01 78 00 00 9D D5 01 01 01 78 00 00 E3 02 00 01' + '08 78 00 00 65 D4 01 01 01 78 00 00 E7 24 00 01 07 78 00 00 01 D5 01 01 01 78 00 00 F3 1E 00 02' + '00 79 00 00 00 03 00 FD 00 00 02 00 79 00 00 01 03 00 77 01 00 02 00 79 00 00 02 03 00 F9 1E 00' + '02 00 79 00 00 03 03 00 33 02 00 02 00 79 00 00 04 03 00 8F 1E 00 02 00 79 00 00 07 03 00 FF 00' + '00 02 00 79 00 00 08 03 00 F7 1E 00 02 00 79 00 00 09 03 00 99 1E 00 02 00 79 00 00 0A 03 00 F5' + '1E 00 02 00 79 00 00 23 03 00 E8 24 00 01 07 79 00 00 32 D4 01 01 01 79 00 00 02 D5 01 01 01 79' + '00 00 36 D5 01 01 01 79 00 00 9E D5 01 01 01 79 00 00 9A D4 01 01 01 79 00 00 A2 D6 01 01 01 79' + '00 00 06 D6 01 01 01 79 00 00 6A D5 01 01 01 79 00 00 59 FF 00 01 0B 79 00 00 66 D4 01 01 01 79' + '00 00 3A D6 01 01 01 79 00 00 D2 D5 01 01 01 79 00 00 B8 02 00 01 08 79 00 00 CE D4 01 01 01 79' + '00 00 6E D6 01 01 01 79 00 00 7A 01 00 02 00 7A 00 00 01 03 00 91 1E 00 02 00 7A 00 00 02 03 00' + '7C 01 00 02 00 7A 00 00 07 03 00 7E 01 00 02 00 7A 00 00 0C 03 00 93 1E 00 02 00 7A 00 00 23 03' + '00 95 1E 00 02 00 7A 00 00 31 03 00 37 D5 01 01 01 7A 00 00 9F D5 01 01 01 7A 00 00 D3 D5 01 01' + '01 7A 00 00 07 D6 01 01 01 7A 00 00 5A FF 00 01 0B 7A 00 00 6B D5 01 01 01 7A 00 00 03 D5 01 01' + '01 7A 00 00 9B D4 01 01 01 7A 00 00 CF D4 01 01 01 7A 00 00 BB 1D 00 01 08 7A 00 00 33 D4 01 01' + '01 7A 00 00 E9 24 00 01 07 7A 00 00 67 D4 01 01 01 7A 00 00 A3 D6 01 01 01 7A 00 00 6F D6 01 01' + '01 7A 00 00 3B D6 01 01 01 7A 00 00 37 FE 00 01 0A 7B 00 00 5B FE 00 01 0D 7B 00 00 5B FF 00 01' + '0B 7B 00 00 5C FF 00 01 0B 7C 00 00 5C FE 00 01 0D 7D 00 00 38 FE 00 01 0A 7D 00 00 5D FF 00 01' + '0B 7D 00 00 5E FF 00 01 0B 7E 00 00 E0 FF 00 01 0B A2 00 00 E1 FF 00 01 0B A3 00 00 E5 FF 00 01' + '0B A5 00 00 E4 FF 00 01 0B A6 00 00 E2 FF 00 01 0B AC 00 00 03 21 00 02 10 B0 00 00 43 00 00 09' + '21 00 02 10 B0 00 00 46 00 00 FC 01 00 02 00 C6 00 00 01 03 00 E2 01 00 02 00 C6 00 00 04 03 00' + '2D 1D 00 01 08 C6 00 00 FE 01 00 02 00 D8 00 00 01 03 00 FD 01 00 02 00 E6 00 00 01 03 00 E3 01' + '00 02 00 E6 00 00 04 03 00 9E 1D 00 01 08 F0 00 00 FF 01 00 02 00 F8 00 00 01 03 00 F8 A7 00 01' + '08 26 01 00 0F 21 00 01 01 27 01 00 A4 D6 01 01 01 31 01 00 51 1D 00 01 08 4B 01 00 F9 A7 00 01' + '08 53 01 00 32 1D 00 01 08 8E 01 00 07 21 00 01 10 90 01 00 B5 1D 00 01 08 AB 01 00 EE 01 00 02' + '00 B7 01 00 0C 03 00 3D 1D 00 01 08 22 02 00 A5 D6 01 01 01 37 02 00 44 1D 00 01 08 50 02 00 45' + '1D 00 01 08 51 02 00 9B 1D 00 01 08 52 02 00 53 1D 00 01 08 54 02 00 9D 1D 00 01 08 55 02 00 4A' + '1D 00 01 08 59 02 00 94 20 00 01 09 59 02 00 4B 1D 00 01 08 5B 02 00 9F 1D 00 01 08 5C 02 00 4C' + '1D 00 01 08 5C 02 00 A1 1D 00 01 08 5F 02 00 A2 1D 00 01 08 61 02 00 E0 02 00 01 08 63 02 00 A3' + '1D 00 01 08 65 02 00 B1 02 00 01 08 66 02 00 A4 1D 00 01 08 68 02 00 A5 1D 00 01 08 69 02 00 A6' + '1D 00 01 08 6A 02 00 5E AB 00 01 08 6B 02 00 A9 1D 00 01 08 6D 02 00 5A 1D 00 01 08 6F 02 00 AD' + '1D 00 01 08 70 02 00 AC 1D 00 01 08 71 02 00 AE 1D 00 01 08 72 02 00 AF 1D 00 01 08 73 02 00 B0' + '1D 00 01 08 74 02 00 B1 1D 00 01 08 75 02 00 B2 1D 00 01 08 78 02 00 B4 02 00 01 08 79 02 00 B5' + '02 00 01 08 7B 02 00 B6 02 00 01 08 81 02 00 B3 1D 00 01 08 82 02 00 B4 1D 00 01 08 83 02 00 B6' + '1D 00 01 08 89 02 00 B7 1D 00 01 08 8A 02 00 B9 1D 00 01 08 8B 02 00 BA 1D 00 01 08 8C 02 00 69' + 'AB 00 01 08 8D 02 00 BC 1D 00 01 08 90 02 00 BD 1D 00 01 08 91 02 00 EF 01 00 02 00 92 02 00 0C' + '03 00 BE 1D 00 01 08 92 02 00 E4 02 00 01 08 95 02 00 A8 1D 00 01 08 9D 02 00 AB 1D 00 01 08 9F' + '02 00 49 01 00 02 10 BC 02 00 6E 00 00 BA 1F 00 02 00 91 03 00 00 03 00 86 03 00 02 00 91 03 00' + '01 03 00 B9 1F 00 02 00 91 03 00 04 03 00 B8 1F 00 02 00 91 03 00 06 03 00 8A 1F 00 04 00 91 03' + '00 13 03 00 00 03 00 45 03 00 0A 1F 00 03 00 91 03 00 13 03 00 00 03 00 8C 1F 00 04 00 91 03 00' + '13 03 00 01 03 00 45 03 00 0C 1F 00 03 00 91 03 00 13 03 00 01 03 00 8E 1F 00 04 00 91 03 00 13' + '03 00 42 03 00 45 03 00 0E 1F 00 03 00 91 03 00 13 03 00 42 03 00 88 1F 00 03 00 91 03 00 13 03' + '00 45 03 00 08 1F 00 02 00 91 03 00 13 03 00 8B 1F 00 04 00 91 03 00 14 03 00 00 03 00 45 03 00' + '0B 1F 00 03 00 91 03 00 14 03 00 00 03 00 8D 1F 00 04 00 91 03 00 14 03 00 01 03 00 45 03 00 0D' + '1F 00 03 00 91 03 00 14 03 00 01 03 00 8F 1F 00 04 00 91 03 00 14 03 00 42 03 00 45 03 00 0F 1F' + '00 03 00 91 03 00 14 03 00 42 03 00 89 1F 00 03 00 91 03 00 14 03 00 45 03 00 09 1F 00 02 00 91' + '03 00 14 03 00 BC 1F 00 02 00 91 03 00 45 03 00 90 D7 01 01 01 91 03 00 56 D7 01 01 01 91 03 00' + 'A8 D6 01 01 01 91 03 00 1C D7 01 01 01 91 03 00 E2 D6 01 01 01 91 03 00 57 D7 01 01 01 92 03 00' + '91 D7 01 01 01 92 03 00 E3 D6 01 01 01 92 03 00 1D D7 01 01 01 92 03 00 A9 D6 01 01 01 92 03 00' + '92 D7 01 01 01 93 03 00 AA D6 01 01 01 93 03 00 58 D7 01 01 01 93 03 00 1E D7 01 01 01 93 03 00' + 'E4 D6 01 01 01 93 03 00 3E 21 00 01 01 93 03 00 59 D7 01 01 01 94 03 00 93 D7 01 01 01 94 03 00' + '1F D7 01 01 01 94 03 00 E5 D6 01 01 01 94 03 00 AB D6 01 01 01 94 03 00 C8 1F 00 02 00 95 03 00' + '00 03 00 88 03 00 02 00 95 03 00 01 03 00 1A 1F 00 03 00 95 03 00 13 03 00 00 03 00 1C 1F 00 03' + '00 95 03 00 13 03 00 01 03 00 18 1F 00 02 00 95 03 00 13 03 00 1B 1F 00 03 00 95 03 00 14 03 00' + '00 03 00 1D 1F 00 03 00 95 03 00 14 03 00 01 03 00 19 1F 00 02 00 95 03 00 14 03 00 AC D6 01 01' + '01 95 03 00 94 D7 01 01 01 95 03 00 E6 D6 01 01 01 95 03 00 5A D7 01 01 01 95 03 00 20 D7 01 01' + '01 95 03 00 21 D7 01 01 01 96 03 00 95 D7 01 01 01 96 03 00 AD D6 01 01 01 96 03 00 E7 D6 01 01' + '01 96 03 00 5B D7 01 01 01 96 03 00 CA 1F 00 02 00 97 03 00 00 03 00 89 03 00 02 00 97 03 00 01' + '03 00 9A 1F 00 04 00 97 03 00 13 03 00 00 03 00 45 03 00 2A 1F 00 03 00 97 03 00 13 03 00 00 03' + '00 9C 1F 00 04 00 97 03 00 13 03 00 01 03 00 45 03 00 2C 1F 00 03 00 97 03 00 13 03 00 01 03 00' + '9E 1F 00 04 00 97 03 00 13 03 00 42 03 00 45 03 00 2E 1F 00 03 00 97 03 00 13 03 00 42 03 00 98' + '1F 00 03 00 97 03 00 13 03 00 45 03 00 28 1F 00 02 00 97 03 00 13 03 00 9B 1F 00 04 00 97 03 00' + '14 03 00 00 03 00 45 03 00 2B 1F 00 03 00 97 03 00 14 03 00 00 03 00 9D 1F 00 04 00 97 03 00 14' + '03 00 01 03 00 45 03 00 2D 1F 00 03 00 97 03 00 14 03 00 01 03 00 9F 1F 00 04 00 97 03 00 14 03' + '00 42 03 00 45 03 00 2F 1F 00 03 00 97 03 00 14 03 00 42 03 00 99 1F 00 03 00 97 03 00 14 03 00' + '45 03 00 29 1F 00 02 00 97 03 00 14 03 00 CC 1F 00 02 00 97 03 00 45 03 00 5C D7 01 01 01 97 03' + '00 E8 D6 01 01 01 97 03 00 AE D6 01 01 01 97 03 00 96 D7 01 01 01 97 03 00 22 D7 01 01 01 97 03' + '00 67 D7 01 01 01 98 03 00 AF D6 01 01 01 98 03 00 97 D7 01 01 01 98 03 00 A1 D7 01 01 01 98 03' + '00 F3 D6 01 01 01 98 03 00 F4 03 00 01 10 98 03 00 5D D7 01 01 01 98 03 00 E9 D6 01 01 01 98 03' + '00 2D D7 01 01 01 98 03 00 23 D7 01 01 01 98 03 00 B9 D6 01 01 01 98 03 00 DA 1F 00 02 00 99 03' + '00 00 03 00 8A 03 00 02 00 99 03 00 01 03 00 D9 1F 00 02 00 99 03 00 04 03 00 D8 1F 00 02 00 99' + '03 00 06 03 00 AA 03 00 02 00 99 03 00 08 03 00 3A 1F 00 03 00 99 03 00 13 03 00 00 03 00 3C 1F' + '00 03 00 99 03 00 13 03 00 01 03 00 3E 1F 00 03 00 99 03 00 13 03 00 42 03 00 38 1F 00 02 00 99' + '03 00 13 03 00 3B 1F 00 03 00 99 03 00 14 03 00 00 03 00 3D 1F 00 03 00 99 03 00 14 03 00 01 03' + '00 3F 1F 00 03 00 99 03 00 14 03 00 42 03 00 39 1F 00 02 00 99 03 00 14 03 00 B0 D6 01 01 01 99' + '03 00 5E D7 01 01 01 99 03 00 EA D6 01 01 01 99 03 00 98 D7 01 01 01 99 03 00 24 D7 01 01 01 99' + '03 00 25 D7 01 01 01 9A 03 00 B1 D6 01 01 01 9A 03 00 5F D7 01 01 01 9A 03 00 EB D6 01 01 01 9A' + '03 00 99 D7 01 01 01 9A 03 00 9A D7 01 01 01 9B 03 00 26 D7 01 01 01 9B 03 00 B2 D6 01 01 01 9B' + '03 00 60 D7 01 01 01 9B 03 00 EC D6 01 01 01 9B 03 00 61 D7 01 01 01 9C 03 00 ED D6 01 01 01 9C' + '03 00 9B D7 01 01 01 9C 03 00 27 D7 01 01 01 9C 03 00 B3 D6 01 01 01 9C 03 00 9C D7 01 01 01 9D' + '03 00 B4 D6 01 01 01 9D 03 00 EE D6 01 01 01 9D 03 00 62 D7 01 01 01 9D 03 00 28 D7 01 01 01 9D' + '03 00 63 D7 01 01 01 9E 03 00 9D D7 01 01 01 9E 03 00 B5 D6 01 01 01 9E 03 00 29 D7 01 01 01 9E' + '03 00 EF D6 01 01 01 9E 03 00 F8 1F 00 02 00 9F 03 00 00 03 00 8C 03 00 02 00 9F 03 00 01 03 00' + '4A 1F 00 03 00 9F 03 00 13 03 00 00 03 00 4C 1F 00 03 00 9F 03 00 13 03 00 01 03 00 48 1F 00 02' + '00 9F 03 00 13 03 00 4B 1F 00 03 00 9F 03 00 14 03 00 00 03 00 4D 1F 00 03 00 9F 03 00 14 03 00' + '01 03 00 49 1F 00 02 00 9F 03 00 14 03 00 64 D7 01 01 01 9F 03 00 2A D7 01 01 01 9F 03 00 F0 D6' + '01 01 01 9F 03 00 9E D7 01 01 01 9F 03 00 B6 D6 01 01 01 9F 03 00 3F 21 00 01 01 A0 03 00 65 D7' + '01 01 01 A0 03 00 F1 D6 01 01 01 A0 03 00 2B D7 01 01 01 A0 03 00 B7 D6 01 01 01 A0 03 00 9F D7' + '01 01 01 A0 03 00 EC 1F 00 02 00 A1 03 00 14 03 00 B8 D6 01 01 01 A1 03 00 F2 D6 01 01 01 A1 03' + '00 A0 D7 01 01 01 A1 03 00 66 D7 01 01 01 A1 03 00 2C D7 01 01 01 A1 03 00 F9 03 00 01 10 A3 03' + '00 2E D7 01 01 01 A3 03 00 68 D7 01 01 01 A3 03 00 F4 D6 01 01 01 A3 03 00 A2 D7 01 01 01 A3 03' + '00 BA D6 01 01 01 A3 03 00 69 D7 01 01 01 A4 03 00 A3 D7 01 01 01 A4 03 00 F5 D6 01 01 01 A4 03' + '00 BB D6 01 01 01 A4 03 00 2F D7 01 01 01 A4 03 00 EA 1F 00 02 00 A5 03 00 00 03 00 8E 03 00 02' + '00 A5 03 00 01 03 00 D3 03 00 02 00 A5 03 00 01 03 00 E9 1F 00 02 00 A5 03 00 04 03 00 E8 1F 00' + '02 00 A5 03 00 06 03 00 D4 03 00 02 00 A5 03 00 08 03 00 AB 03 00 02 00 A5 03 00 08 03 00 5B 1F' + '00 03 00 A5 03 00 14 03 00 00 03 00 5D 1F 00 03 00 A5 03 00 14 03 00 01 03 00 5F 1F 00 03 00 A5' + '03 00 14 03 00 42 03 00 59 1F 00 02 00 A5 03 00 14 03 00 F6 D6 01 01 01 A5 03 00 6A D7 01 01 01' + 'A5 03 00 A4 D7 01 01 01 A5 03 00 30 D7 01 01 01 A5 03 00 D2 03 00 01 10 A5 03 00 BC D6 01 01 01' + 'A5 03 00 BD D6 01 01 01 A6 03 00 A5 D7 01 01 01 A6 03 00 31 D7 01 01 01 A6 03 00 6B D7 01 01 01' + 'A6 03 00 F7 D6 01 01 01 A6 03 00 BE D6 01 01 01 A7 03 00 A6 D7 01 01 01 A7 03 00 32 D7 01 01 01' + 'A7 03 00 6C D7 01 01 01 A7 03 00 F8 D6 01 01 01 A7 03 00 F9 D6 01 01 01 A8 03 00 33 D7 01 01 01' + 'A8 03 00 A7 D7 01 01 01 A8 03 00 BF D6 01 01 01 A8 03 00 6D D7 01 01 01 A8 03 00 FA 1F 00 02 00' + 'A9 03 00 00 03 00 8F 03 00 02 00 A9 03 00 01 03 00 AA 1F 00 04 00 A9 03 00 13 03 00 00 03 00 45' + '03 00 6A 1F 00 03 00 A9 03 00 13 03 00 00 03 00 AC 1F 00 04 00 A9 03 00 13 03 00 01 03 00 45 03' + '00 6C 1F 00 03 00 A9 03 00 13 03 00 01 03 00 AE 1F 00 04 00 A9 03 00 13 03 00 42 03 00 45 03 00' + '6E 1F 00 03 00 A9 03 00 13 03 00 42 03 00 A8 1F 00 03 00 A9 03 00 13 03 00 45 03 00 68 1F 00 02' + '00 A9 03 00 13 03 00 AB 1F 00 04 00 A9 03 00 14 03 00 00 03 00 45 03 00 6B 1F 00 03 00 A9 03 00' + '14 03 00 00 03 00 AD 1F 00 04 00 A9 03 00 14 03 00 01 03 00 45 03 00 6D 1F 00 03 00 A9 03 00 14' + '03 00 01 03 00 AF 1F 00 04 00 A9 03 00 14 03 00 42 03 00 45 03 00 6F 1F 00 03 00 A9 03 00 14 03' + '00 42 03 00 A9 1F 00 03 00 A9 03 00 14 03 00 45 03 00 69 1F 00 02 00 A9 03 00 14 03 00 FC 1F 00' + '02 00 A9 03 00 45 03 00 34 D7 01 01 01 A9 03 00 6E D7 01 01 01 A9 03 00 C0 D6 01 01 01 A9 03 00' + 'FA D6 01 01 01 A9 03 00 A8 D7 01 01 01 A9 03 00 B2 1F 00 03 00 B1 03 00 00 03 00 45 03 00 70 1F' + '00 02 00 B1 03 00 00 03 00 B4 1F 00 03 00 B1 03 00 01 03 00 45 03 00 AC 03 00 02 00 B1 03 00 01' + '03 00 B1 1F 00 02 00 B1 03 00 04 03 00 B0 1F 00 02 00 B1 03 00 06 03 00 82 1F 00 04 00 B1 03 00' + '13 03 00 00 03 00 45 03 00 02 1F 00 03 00 B1 03 00 13 03 00 00 03 00 84 1F 00 04 00 B1 03 00 13' + '03 00 01 03 00 45 03 00 04 1F 00 03 00 B1 03 00 13 03 00 01 03 00 86 1F 00 04 00 B1 03 00 13 03' + '00 42 03 00 45 03 00 06 1F 00 03 00 B1 03 00 13 03 00 42 03 00 80 1F 00 03 00 B1 03 00 13 03 00' + '45 03 00 00 1F 00 02 00 B1 03 00 13 03 00 83 1F 00 04 00 B1 03 00 14 03 00 00 03 00 45 03 00 03' + '1F 00 03 00 B1 03 00 14 03 00 00 03 00 85 1F 00 04 00 B1 03 00 14 03 00 01 03 00 45 03 00 05 1F' + '00 03 00 B1 03 00 14 03 00 01 03 00 87 1F 00 04 00 B1 03 00 14 03 00 42 03 00 45 03 00 07 1F 00' + '03 00 B1 03 00 14 03 00 42 03 00 81 1F 00 03 00 B1 03 00 14 03 00 45 03 00 01 1F 00 02 00 B1 03' + '00 14 03 00 B7 1F 00 03 00 B1 03 00 42 03 00 45 03 00 B6 1F 00 02 00 B1 03 00 42 03 00 B3 1F 00' + '02 00 B1 03 00 45 03 00 AA D7 01 01 01 B1 03 00 C2 D6 01 01 01 B1 03 00 FC D6 01 01 01 B1 03 00' + '70 D7 01 01 01 B1 03 00 36 D7 01 01 01 B1 03 00 C3 D6 01 01 01 B2 03 00 D0 03 00 01 10 B2 03 00' + '66 1D 00 01 09 B2 03 00 71 D7 01 01 01 B2 03 00 FD D6 01 01 01 B2 03 00 5D 1D 00 01 08 B2 03 00' + 'AB D7 01 01 01 B2 03 00 37 D7 01 01 01 B2 03 00 72 D7 01 01 01 B3 03 00 38 D7 01 01 01 B3 03 00' + 'AC D7 01 01 01 B3 03 00 5E 1D 00 01 08 B3 03 00 3D 21 00 01 01 B3 03 00 C4 D6 01 01 01 B3 03 00' + 'FE D6 01 01 01 B3 03 00 67 1D 00 01 09 B3 03 00 73 D7 01 01 01 B4 03 00 C5 D6 01 01 01 B4 03 00' + 'AD D7 01 01 01 B4 03 00 39 D7 01 01 01 B4 03 00 FF D6 01 01 01 B4 03 00 5F 1D 00 01 08 B4 03 00' + '72 1F 00 02 00 B5 03 00 00 03 00 AD 03 00 02 00 B5 03 00 01 03 00 12 1F 00 03 00 B5 03 00 13 03' + '00 00 03 00 14 1F 00 03 00 B5 03 00 13 03 00 01 03 00 10 1F 00 02 00 B5 03 00 13 03 00 13 1F 00' + '03 00 B5 03 00 14 03 00 00 03 00 15 1F 00 03 00 B5 03 00 14 03 00 01 03 00 11 1F 00 02 00 B5 03' + '00 14 03 00 74 D7 01 01 01 B5 03 00 3A D7 01 01 01 B5 03 00 50 D7 01 01 01 B5 03 00 F5 03 00 01' + '10 B5 03 00 C6 D6 01 01 01 B5 03 00 C4 D7 01 01 01 B5 03 00 DC D6 01 01 01 B5 03 00 00 D7 01 01' + '01 B5 03 00 16 D7 01 01 01 B5 03 00 AE D7 01 01 01 B5 03 00 8A D7 01 01 01 B5 03 00 AF D7 01 01' + '01 B6 03 00 01 D7 01 01 01 B6 03 00 C7 D6 01 01 01 B6 03 00 3B D7 01 01 01 B6 03 00 75 D7 01 01' + '01 B6 03 00 C2 1F 00 03 00 B7 03 00 00 03 00 45 03 00 74 1F 00 02 00 B7 03 00 00 03 00 C4 1F 00' + '03 00 B7 03 00 01 03 00 45 03 00 AE 03 00 02 00 B7 03 00 01 03 00 92 1F 00 04 00 B7 03 00 13 03' + '00 00 03 00 45 03 00 22 1F 00 03 00 B7 03 00 13 03 00 00 03 00 94 1F 00 04 00 B7 03 00 13 03 00' + '01 03 00 45 03 00 24 1F 00 03 00 B7 03 00 13 03 00 01 03 00 96 1F 00 04 00 B7 03 00 13 03 00 42' + '03 00 45 03 00 26 1F 00 03 00 B7 03 00 13 03 00 42 03 00 90 1F 00 03 00 B7 03 00 13 03 00 45 03' + '00 20 1F 00 02 00 B7 03 00 13 03 00 93 1F 00 04 00 B7 03 00 14 03 00 00 03 00 45 03 00 23 1F 00' + '03 00 B7 03 00 14 03 00 00 03 00 95 1F 00 04 00 B7 03 00 14 03 00 01 03 00 45 03 00 25 1F 00 03' + '00 B7 03 00 14 03 00 01 03 00 97 1F 00 04 00 B7 03 00 14 03 00 42 03 00 45 03 00 27 1F 00 03 00' + 'B7 03 00 14 03 00 42 03 00 91 1F 00 03 00 B7 03 00 14 03 00 45 03 00 21 1F 00 02 00 B7 03 00 14' + '03 00 C7 1F 00 03 00 B7 03 00 42 03 00 45 03 00 C6 1F 00 02 00 B7 03 00 42 03 00 C3 1F 00 02 00' + 'B7 03 00 45 03 00 3C D7 01 01 01 B7 03 00 B0 D7 01 01 01 B7 03 00 C8 D6 01 01 01 B7 03 00 02 D7' + '01 01 01 B7 03 00 76 D7 01 01 01 B7 03 00 C5 D7 01 01 01 B8 03 00 3D D7 01 01 01 B8 03 00 D1 03' + '00 01 10 B8 03 00 17 D7 01 01 01 B8 03 00 51 D7 01 01 01 B8 03 00 77 D7 01 01 01 B8 03 00 B1 D7' + '01 01 01 B8 03 00 C9 D6 01 01 01 B8 03 00 BF 1D 00 01 08 B8 03 00 8B D7 01 01 01 B8 03 00 03 D7' + '01 01 01 B8 03 00 DD D6 01 01 01 B8 03 00 76 1F 00 02 00 B9 03 00 00 03 00 AF 03 00 02 00 B9 03' + '00 01 03 00 D1 1F 00 02 00 B9 03 00 04 03 00 D0 1F 00 02 00 B9 03 00 06 03 00 D2 1F 00 03 00 B9' + '03 00 08 03 00 00 03 00 90 03 00 03 00 B9 03 00 08 03 00 01 03 00 D7 1F 00 03 00 B9 03 00 08 03' + '00 42 03 00 CA 03 00 02 00 B9 03 00 08 03 00 32 1F 00 03 00 B9 03 00 13 03 00 00 03 00 34 1F 00' + '03 00 B9 03 00 13 03 00 01 03 00 36 1F 00 03 00 B9 03 00 13 03 00 42 03 00 30 1F 00 02 00 B9 03' + '00 13 03 00 33 1F 00 03 00 B9 03 00 14 03 00 00 03 00 35 1F 00 03 00 B9 03 00 14 03 00 01 03 00' + '37 1F 00 03 00 B9 03 00 14 03 00 42 03 00 31 1F 00 02 00 B9 03 00 14 03 00 D6 1F 00 02 00 B9 03' + '00 42 03 00 04 D7 01 01 01 B9 03 00 B2 D7 01 01 01 B9 03 00 78 D7 01 01 01 B9 03 00 3E D7 01 01' + '01 B9 03 00 CA D6 01 01 01 B9 03 00 8C D7 01 01 01 BA 03 00 DE D6 01 01 01 BA 03 00 52 D7 01 01' + '01 BA 03 00 79 D7 01 01 01 BA 03 00 3F D7 01 01 01 BA 03 00 CB D6 01 01 01 BA 03 00 18 D7 01 01' + '01 BA 03 00 C6 D7 01 01 01 BA 03 00 B3 D7 01 01 01 BA 03 00 05 D7 01 01 01 BA 03 00 F0 03 00 01' + '10 BA 03 00 40 D7 01 01 01 BB 03 00 06 D7 01 01 01 BB 03 00 B4 D7 01 01 01 BB 03 00 CC D6 01 01' + '01 BB 03 00 7A D7 01 01 01 BB 03 00 82 33 00 02 0E BC 03 00 41 00 00 8C 33 00 02 0E BC 03 00 46' + '00 00 B6 33 00 02 0E BC 03 00 56 00 00 BC 33 00 02 0E BC 03 00 57 00 00 8D 33 00 02 0E BC 03 00' + '67 00 00 95 33 00 02 0E BC 03 00 6C 00 00 9B 33 00 02 0E BC 03 00 6D 00 00 B2 33 00 02 0E BC 03' + '00 73 00 00 B5 00 00 01 10 BC 03 00 CD D6 01 01 01 BC 03 00 7B D7 01 01 01 BC 03 00 B5 D7 01 01' + '01 BC 03 00 07 D7 01 01 01 BC 03 00 41 D7 01 01 01 BC 03 00 CE D6 01 01 01 BD 03 00 08 D7 01 01' + '01 BD 03 00 7C D7 01 01 01 BD 03 00 42 D7 01 01 01 BD 03 00 B6 D7 01 01 01 BD 03 00 CF D6 01 01' + '01 BE 03 00 7D D7 01 01 01 BE 03 00 B7 D7 01 01 01 BE 03 00 43 D7 01 01 01 BE 03 00 09 D7 01 01' + '01 BE 03 00 78 1F 00 02 00 BF 03 00 00 03 00 CC 03 00 02 00 BF 03 00 01 03 00 42 1F 00 03 00 BF' + '03 00 13 03 00 00 03 00 44 1F 00 03 00 BF 03 00 13 03 00 01 03 00 40 1F 00 02 00 BF 03 00 13 03' + '00 43 1F 00 03 00 BF 03 00 14 03 00 00 03 00 45 1F 00 03 00 BF 03 00 14 03 00 01 03 00 41 1F 00' + '02 00 BF 03 00 14 03 00 7E D7 01 01 01 BF 03 00 44 D7 01 01 01 BF 03 00 D0 D6 01 01 01 BF 03 00' + 'B8 D7 01 01 01 BF 03 00 0A D7 01 01 01 BF 03 00 8F D7 01 01 01 C0 03 00 7F D7 01 01 01 C0 03 00' + 'C9 D7 01 01 01 C0 03 00 D1 D6 01 01 01 C0 03 00 D6 03 00 01 10 C0 03 00 B9 D7 01 01 01 C0 03 00' + '45 D7 01 01 01 C0 03 00 E1 D6 01 01 01 C0 03 00 3C 21 00 01 01 C0 03 00 0B D7 01 01 01 C0 03 00' + '1B D7 01 01 01 C0 03 00 55 D7 01 01 01 C0 03 00 E4 1F 00 02 00 C1 03 00 13 03 00 E5 1F 00 02 00' + 'C1 03 00 14 03 00 0C D7 01 01 01 C1 03 00 80 D7 01 01 01 C1 03 00 BA D7 01 01 01 C1 03 00 54 D7' + '01 01 01 C1 03 00 46 D7 01 01 01 C1 03 00 8E D7 01 01 01 C1 03 00 68 1D 00 01 09 C1 03 00 E0 D6' + '01 01 01 C1 03 00 C8 D7 01 01 01 C1 03 00 D2 D6 01 01 01 C1 03 00 F1 03 00 01 10 C1 03 00 1A D7' + '01 01 01 C1 03 00 0D D7 01 01 01 C2 03 00 81 D7 01 01 01 C2 03 00 47 D7 01 01 01 C2 03 00 F2 03' + '00 01 10 C2 03 00 BB D7 01 01 01 C2 03 00 D3 D6 01 01 01 C2 03 00 82 D7 01 01 01 C3 03 00 BC D7' + '01 01 01 C3 03 00 48 D7 01 01 01 C3 03 00 0E D7 01 01 01 C3 03 00 D4 D6 01 01 01 C3 03 00 49 D7' + '01 01 01 C4 03 00 D5 D6 01 01 01 C4 03 00 83 D7 01 01 01 C4 03 00 BD D7 01 01 01 C4 03 00 0F D7' + '01 01 01 C4 03 00 7A 1F 00 02 00 C5 03 00 00 03 00 CD 03 00 02 00 C5 03 00 01 03 00 E1 1F 00 02' + '00 C5 03 00 04 03 00 E0 1F 00 02 00 C5 03 00 06 03 00 E2 1F 00 03 00 C5 03 00 08 03 00 00 03 00' + 'B0 03 00 03 00 C5 03 00 08 03 00 01 03 00 E7 1F 00 03 00 C5 03 00 08 03 00 42 03 00 CB 03 00 02' + '00 C5 03 00 08 03 00 52 1F 00 03 00 C5 03 00 13 03 00 00 03 00 54 1F 00 03 00 C5 03 00 13 03 00' + '01 03 00 56 1F 00 03 00 C5 03 00 13 03 00 42 03 00 50 1F 00 02 00 C5 03 00 13 03 00 53 1F 00 03' + '00 C5 03 00 14 03 00 00 03 00 55 1F 00 03 00 C5 03 00 14 03 00 01 03 00 57 1F 00 03 00 C5 03 00' + '14 03 00 42 03 00 51 1F 00 02 00 C5 03 00 14 03 00 E6 1F 00 02 00 C5 03 00 42 03 00 84 D7 01 01' + '01 C5 03 00 D6 D6 01 01 01 C5 03 00 4A D7 01 01 01 C5 03 00 10 D7 01 01 01 C5 03 00 BE D7 01 01' + '01 C5 03 00 BF D7 01 01 01 C6 03 00 19 D7 01 01 01 C6 03 00 C7 D7 01 01 01 C6 03 00 4B D7 01 01' + '01 C6 03 00 85 D7 01 01 01 C6 03 00 8D D7 01 01 01 C6 03 00 53 D7 01 01 01 C6 03 00 60 1D 00 01' + '08 C6 03 00 D5 03 00 01 10 C6 03 00 D7 D6 01 01 01 C6 03 00 69 1D 00 01 09 C6 03 00 11 D7 01 01' + '01 C6 03 00 DF D6 01 01 01 C6 03 00 61 1D 00 01 08 C7 03 00 C0 D7 01 01 01 C7 03 00 4C D7 01 01' + '01 C7 03 00 12 D7 01 01 01 C7 03 00 D8 D6 01 01 01 C7 03 00 86 D7 01 01 01 C7 03 00 6A 1D 00 01' + '09 C7 03 00 13 D7 01 01 01 C8 03 00 C1 D7 01 01 01 C8 03 00 87 D7 01 01 01 C8 03 00 D9 D6 01 01' + '01 C8 03 00 4D D7 01 01 01 C8 03 00 F2 1F 00 03 00 C9 03 00 00 03 00 45 03 00 7C 1F 00 02 00 C9' + '03 00 00 03 00 F4 1F 00 03 00 C9 03 00 01 03 00 45 03 00 CE 03 00 02 00 C9 03 00 01 03 00 A2 1F' + '00 04 00 C9 03 00 13 03 00 00 03 00 45 03 00 62 1F 00 03 00 C9 03 00 13 03 00 00 03 00 A4 1F 00' + '04 00 C9 03 00 13 03 00 01 03 00 45 03 00 64 1F 00 03 00 C9 03 00 13 03 00 01 03 00 A6 1F 00 04' + '00 C9 03 00 13 03 00 42 03 00 45 03 00 66 1F 00 03 00 C9 03 00 13 03 00 42 03 00 A0 1F 00 03 00' + 'C9 03 00 13 03 00 45 03 00 60 1F 00 02 00 C9 03 00 13 03 00 A3 1F 00 04 00 C9 03 00 14 03 00 00' + '03 00 45 03 00 63 1F 00 03 00 C9 03 00 14 03 00 00 03 00 A5 1F 00 04 00 C9 03 00 14 03 00 01 03' + '00 45 03 00 65 1F 00 03 00 C9 03 00 14 03 00 01 03 00 A7 1F 00 04 00 C9 03 00 14 03 00 42 03 00' + '45 03 00 67 1F 00 03 00 C9 03 00 14 03 00 42 03 00 A1 1F 00 03 00 C9 03 00 14 03 00 45 03 00 61' + '1F 00 02 00 C9 03 00 14 03 00 F7 1F 00 03 00 C9 03 00 42 03 00 45 03 00 F6 1F 00 02 00 C9 03 00' + '42 03 00 F3 1F 00 02 00 C9 03 00 45 03 00 88 D7 01 01 01 C9 03 00 DA D6 01 01 01 C9 03 00 C2 D7' + '01 01 01 C9 03 00 4E D7 01 01 01 C9 03 00 14 D7 01 01 01 C9 03 00 CA D7 01 01 01 DC 03 00 CB D7' + '01 01 01 DD 03 00 07 04 00 02 00 06 04 00 08 03 00 D0 04 00 02 00 10 04 00 06 03 00 D2 04 00 02' + '00 10 04 00 08 03 00 03 04 00 02 00 13 04 00 01 03 00 00 04 00 02 00 15 04 00 00 03 00 D6 04 00' + '02 00 15 04 00 06 03 00 01 04 00 02 00 15 04 00 08 03 00 C1 04 00 02 00 16 04 00 06 03 00 DC 04' + '00 02 00 16 04 00 08 03 00 DE 04 00 02 00 17 04 00 08 03 00 0D 04 00 02 00 18 04 00 00 03 00 E2' + '04 00 02 00 18 04 00 04 03 00 19 04 00 02 00 18 04 00 06 03 00 E4 04 00 02 00 18 04 00 08 03 00' + '0C 04 00 02 00 1A 04 00 01 03 00 E6 04 00 02 00 1E 04 00 08 03 00 EE 04 00 02 00 23 04 00 04 03' + '00 0E 04 00 02 00 23 04 00 06 03 00 F0 04 00 02 00 23 04 00 08 03 00 F2 04 00 02 00 23 04 00 0B' + '03 00 F4 04 00 02 00 27 04 00 08 03 00 F8 04 00 02 00 2B 04 00 08 03 00 EC 04 00 02 00 2D 04 00' + '08 03 00 D1 04 00 02 00 30 04 00 06 03 00 D3 04 00 02 00 30 04 00 08 03 00 53 04 00 02 00 33 04' + '00 01 03 00 50 04 00 02 00 35 04 00 00 03 00 D7 04 00 02 00 35 04 00 06 03 00 51 04 00 02 00 35' + '04 00 08 03 00 C2 04 00 02 00 36 04 00 06 03 00 DD 04 00 02 00 36 04 00 08 03 00 DF 04 00 02 00' + '37 04 00 08 03 00 5D 04 00 02 00 38 04 00 00 03 00 E3 04 00 02 00 38 04 00 04 03 00 39 04 00 02' + '00 38 04 00 06 03 00 E5 04 00 02 00 38 04 00 08 03 00 5C 04 00 02 00 3A 04 00 01 03 00 78 1D 00' + '01 08 3D 04 00 E7 04 00 02 00 3E 04 00 08 03 00 EF 04 00 02 00 43 04 00 04 03 00 5E 04 00 02 00' + '43 04 00 06 03 00 F1 04 00 02 00 43 04 00 08 03 00 F3 04 00 02 00 43 04 00 0B 03 00 F5 04 00 02' + '00 47 04 00 08 03 00 9C A6 00 01 08 4A 04 00 F9 04 00 02 00 4B 04 00 08 03 00 9D A6 00 01 08 4C' + '04 00 ED 04 00 02 00 4D 04 00 08 03 00 57 04 00 02 00 56 04 00 08 03 00 76 04 00 02 00 74 04 00' + '0F 03 00 77 04 00 02 00 75 04 00 0F 03 00 DA 04 00 02 00 D8 04 00 08 03 00 DB 04 00 02 00 D9 04' + '00 08 03 00 EA 04 00 02 00 E8 04 00 08 03 00 EB 04 00 02 00 E9 04 00 08 03 00 87 05 00 02 10 65' + '05 00 82 05 00 14 FB 00 02 10 74 05 00 65 05 00 15 FB 00 02 10 74 05 00 6B 05 00 17 FB 00 02 10' + '74 05 00 6D 05 00 13 FB 00 02 10 74 05 00 76 05 00 16 FB 00 02 10 7E 05 00 76 05 00 4F FB 00 02' + '10 D0 05 00 DC 05 00 21 FB 00 01 01 D0 05 00 35 21 00 01 10 D0 05 00 36 21 00 01 10 D1 05 00 37' + '21 00 01 10 D2 05 00 22 FB 00 01 01 D3 05 00 38 21 00 01 10 D3 05 00 23 FB 00 01 01 D4 05 00 24' + 'FB 00 01 01 DB 05 00 25 FB 00 01 01 DC 05 00 26 FB 00 01 01 DD 05 00 20 FB 00 01 01 E2 05 00 27' + 'FB 00 01 01 E8 05 00 28 FB 00 01 01 EA 05 00 80 FE 00 01 06 21 06 00 F3 FD 00 04 06 27 06 00 43' + '06 00 28 06 00 31 06 00 F2 FD 00 04 06 27 06 00 44 06 00 44 06 00 47 06 00 3D FD 00 02 06 27 06' + '00 4B 06 00 3C FD 00 02 05 27 06 00 4B 06 00 82 FE 00 02 05 27 06 00 53 06 00 22 06 00 02 00 27' + '06 00 53 06 00 81 FE 00 02 06 27 06 00 53 06 00 23 06 00 02 00 27 06 00 54 06 00 84 FE 00 02 05' + '27 06 00 54 06 00 83 FE 00 02 06 27 06 00 54 06 00 25 06 00 02 00 27 06 00 55 06 00 88 FE 00 02' + '05 27 06 00 55 06 00 87 FE 00 02 06 27 06 00 55 06 00 75 06 00 02 10 27 06 00 74 06 00 80 EE 01' + '01 01 27 06 00 8D FE 00 01 06 27 06 00 00 EE 01 01 01 27 06 00 8E FE 00 01 05 27 06 00 05 FC 00' + '02 06 28 06 00 2C 06 00 9C FC 00 02 03 28 06 00 2C 06 00 C2 FD 00 03 05 28 06 00 2D 06 00 4A 06' + '00 9D FC 00 02 03 28 06 00 2D 06 00 06 FC 00 02 06 28 06 00 2D 06 00 9E FD 00 03 05 28 06 00 2E' + '06 00 4A 06 00 07 FC 00 02 06 28 06 00 2E 06 00 9E FC 00 02 03 28 06 00 2E 06 00 6A FC 00 02 05' + '28 06 00 31 06 00 6B FC 00 02 05 28 06 00 32 06 00 08 FC 00 02 06 28 06 00 45 06 00 9F FC 00 02' + '03 28 06 00 45 06 00 E1 FC 00 02 04 28 06 00 45 06 00 6C FC 00 02 05 28 06 00 45 06 00 6D FC 00' + '02 05 28 06 00 46 06 00 A0 FC 00 02 03 28 06 00 47 06 00 E2 FC 00 02 04 28 06 00 47 06 00 09 FC' + '00 02 06 28 06 00 49 06 00 6E FC 00 02 05 28 06 00 49 06 00 0A FC 00 02 06 28 06 00 4A 06 00 6F' + 'FC 00 02 05 28 06 00 4A 06 00 61 EE 01 01 01 28 06 00 21 EE 01 01 01 28 06 00 91 FE 00 01 03 28' + '06 00 8F FE 00 01 06 28 06 00 90 FE 00 01 05 28 06 00 01 EE 01 01 01 28 06 00 A1 EE 01 01 01 28' + '06 00 81 EE 01 01 01 28 06 00 92 FE 00 01 04 28 06 00 94 FE 00 01 05 29 06 00 93 FE 00 01 06 29' + '06 00 50 FD 00 03 03 2A 06 00 2C 06 00 45 06 00 A0 FD 00 03 05 2A 06 00 2C 06 00 49 06 00 9F FD' + '00 03 05 2A 06 00 2C 06 00 4A 06 00 0B FC 00 02 06 2A 06 00 2C 06 00 A1 FC 00 02 03 2A 06 00 2C' + '06 00 52 FD 00 03 03 2A 06 00 2D 06 00 2C 06 00 51 FD 00 03 05 2A 06 00 2D 06 00 2C 06 00 53 FD' + '00 03 03 2A 06 00 2D 06 00 45 06 00 0C FC 00 02 06 2A 06 00 2D 06 00 A2 FC 00 02 03 2A 06 00 2D' + '06 00 54 FD 00 03 03 2A 06 00 2E 06 00 45 06 00 A2 FD 00 03 05 2A 06 00 2E 06 00 49 06 00 A1 FD' + '00 03 05 2A 06 00 2E 06 00 4A 06 00 0D FC 00 02 06 2A 06 00 2E 06 00 A3 FC 00 02 03 2A 06 00 2E' + '06 00 70 FC 00 02 05 2A 06 00 31 06 00 71 FC 00 02 05 2A 06 00 32 06 00 55 FD 00 03 03 2A 06 00' + '45 06 00 2C 06 00 56 FD 00 03 03 2A 06 00 45 06 00 2D 06 00 57 FD 00 03 03 2A 06 00 45 06 00 2E' + '06 00 A4 FD 00 03 05 2A 06 00 45 06 00 49 06 00 A3 FD 00 03 05 2A 06 00 45 06 00 4A 06 00 0E FC' + '00 02 06 2A 06 00 45 06 00 A4 FC 00 02 03 2A 06 00 45 06 00 E3 FC 00 02 04 2A 06 00 45 06 00 72' + 'FC 00 02 05 2A 06 00 45 06 00 73 FC 00 02 05 2A 06 00 46 06 00 A5 FC 00 02 03 2A 06 00 47 06 00' + 'E4 FC 00 02 04 2A 06 00 47 06 00 74 FC 00 02 05 2A 06 00 49 06 00 0F FC 00 02 06 2A 06 00 49 06' + '00 75 FC 00 02 05 2A 06 00 4A 06 00 10 FC 00 02 06 2A 06 00 4A 06 00 75 EE 01 01 01 2A 06 00 95' + 'FE 00 01 06 2A 06 00 15 EE 01 01 01 2A 06 00 35 EE 01 01 01 2A 06 00 95 EE 01 01 01 2A 06 00 98' + 'FE 00 01 04 2A 06 00 97 FE 00 01 03 2A 06 00 96 FE 00 01 05 2A 06 00 B5 EE 01 01 01 2A 06 00 11' + 'FC 00 02 06 2B 06 00 2C 06 00 76 FC 00 02 05 2B 06 00 31 06 00 77 FC 00 02 05 2B 06 00 32 06 00' + '78 FC 00 02 05 2B 06 00 45 06 00 E5 FC 00 02 04 2B 06 00 45 06 00 A6 FC 00 02 03 2B 06 00 45 06' + '00 12 FC 00 02 06 2B 06 00 45 06 00 79 FC 00 02 05 2B 06 00 46 06 00 E6 FC 00 02 04 2B 06 00 47' + '06 00 7A FC 00 02 05 2B 06 00 49 06 00 13 FC 00 02 06 2B 06 00 49 06 00 14 FC 00 02 06 2B 06 00' + '4A 06 00 7B FC 00 02 05 2B 06 00 4A 06 00 B6 EE 01 01 01 2B 06 00 96 EE 01 01 01 2B 06 00 9B FE' + '00 01 03 2B 06 00 9C FE 00 01 04 2B 06 00 99 FE 00 01 06 2B 06 00 9A FE 00 01 05 2B 06 00 36 EE' + '01 01 01 2B 06 00 76 EE 01 01 01 2B 06 00 16 EE 01 01 01 2B 06 00 A6 FD 00 03 05 2C 06 00 2D 06' + '00 49 06 00 BE FD 00 03 05 2C 06 00 2D 06 00 4A 06 00 A7 FC 00 02 03 2C 06 00 2D 06 00 15 FC 00' + '02 06 2C 06 00 2D 06 00 FB FD 00 08 06 2C 06 00 44 06 00 20 00 00 2C 06 00 44 06 00 27 06 00 44' + '06 00 47 06 00 58 FD 00 03 05 2C 06 00 45 06 00 2D 06 00 59 FD 00 03 03 2C 06 00 45 06 00 2D 06' + '00 A7 FD 00 03 05 2C 06 00 45 06 00 49 06 00 A5 FD 00 03 05 2C 06 00 45 06 00 4A 06 00 A8 FC 00' + '02 03 2C 06 00 45 06 00 16 FC 00 02 06 2C 06 00 45 06 00 1D FD 00 02 05 2C 06 00 49 06 00 01 FD' + '00 02 06 2C 06 00 49 06 00 02 FD 00 02 06 2C 06 00 4A 06 00 1E FD 00 02 05 2C 06 00 4A 06 00 9E' + 'FE 00 01 05 2C 06 00 9F FE 00 01 03 2C 06 00 9D FE 00 01 06 2C 06 00 A2 EE 01 01 01 2C 06 00 82' + 'EE 01 01 01 2C 06 00 62 EE 01 01 01 2C 06 00 42 EE 01 01 01 2C 06 00 02 EE 01 01 01 2C 06 00 22' + 'EE 01 01 01 2C 06 00 A0 FE 00 01 04 2C 06 00 BF FD 00 03 05 2D 06 00 2C 06 00 4A 06 00 A9 FC 00' + '02 03 2D 06 00 2C 06 00 17 FC 00 02 06 2D 06 00 2C 06 00 5B FD 00 03 05 2D 06 00 45 06 00 49 06' + '00 5A FD 00 03 05 2D 06 00 45 06 00 4A 06 00 18 FC 00 02 06 2D 06 00 45 06 00 AA FC 00 02 03 2D' + '06 00 45 06 00 1B FD 00 02 05 2D 06 00 49 06 00 FF FC 00 02 06 2D 06 00 49 06 00 1C FD 00 02 05' + '2D 06 00 4A 06 00 00 FD 00 02 06 2D 06 00 4A 06 00 47 EE 01 01 01 2D 06 00 67 EE 01 01 01 2D 06' + '00 87 EE 01 01 01 2D 06 00 A7 EE 01 01 01 2D 06 00 A4 FE 00 01 04 2D 06 00 07 EE 01 01 01 2D 06' + '00 27 EE 01 01 01 2D 06 00 A1 FE 00 01 06 2D 06 00 A3 FE 00 01 03 2D 06 00 A2 FE 00 01 05 2D 06' + '00 AB FC 00 02 03 2E 06 00 2C 06 00 19 FC 00 02 06 2E 06 00 2C 06 00 1A FC 00 02 06 2E 06 00 2D' + '06 00 1B FC 00 02 06 2E 06 00 45 06 00 AC FC 00 02 03 2E 06 00 45 06 00 03 FD 00 02 06 2E 06 00' + '49 06 00 1F FD 00 02 05 2E 06 00 49 06 00 20 FD 00 02 05 2E 06 00 4A 06 00 04 FD 00 02 06 2E 06' + '00 4A 06 00 17 EE 01 01 01 2E 06 00 77 EE 01 01 01 2E 06 00 B7 EE 01 01 01 2E 06 00 A5 FE 00 01' + '06 2E 06 00 A6 FE 00 01 05 2E 06 00 A7 FE 00 01 03 2E 06 00 A8 FE 00 01 04 2E 06 00 97 EE 01 01' + '01 2E 06 00 37 EE 01 01 01 2E 06 00 57 EE 01 01 01 2E 06 00 A9 FE 00 01 06 2F 06 00 03 EE 01 01' + '01 2F 06 00 83 EE 01 01 01 2F 06 00 A3 EE 01 01 01 2F 06 00 AA FE 00 01 05 2F 06 00 5B FC 00 02' + '06 30 06 00 70 06 00 B8 EE 01 01 01 30 06 00 98 EE 01 01 01 30 06 00 18 EE 01 01 01 30 06 00 AB' + 'FE 00 01 06 30 06 00 AC FE 00 01 05 30 06 00 F6 FD 00 04 06 31 06 00 33 06 00 48 06 00 44 06 00' + '5C FC 00 02 06 31 06 00 70 06 00 FC FD 00 04 06 31 06 00 CC 06 00 27 06 00 44 06 00 13 EE 01 01' + '01 31 06 00 B3 EE 01 01 01 31 06 00 AD FE 00 01 06 31 06 00 93 EE 01 01 01 31 06 00 AE FE 00 01' + '05 31 06 00 B0 FE 00 01 05 32 06 00 A6 EE 01 01 01 32 06 00 86 EE 01 01 01 32 06 00 06 EE 01 01' + '01 32 06 00 AF FE 00 01 06 32 06 00 5D FD 00 03 03 33 06 00 2C 06 00 2D 06 00 5E FD 00 03 05 33' + '06 00 2C 06 00 49 06 00 1C FC 00 02 06 33 06 00 2C 06 00 34 FD 00 02 04 33 06 00 2C 06 00 AD FC' + '00 02 03 33 06 00 2C 06 00 5C FD 00 03 03 33 06 00 2D 06 00 2C 06 00 35 FD 00 02 04 33 06 00 2D' + '06 00 1D FC 00 02 06 33 06 00 2D 06 00 AE FC 00 02 03 33 06 00 2D 06 00 A8 FD 00 03 05 33 06 00' + '2E 06 00 49 06 00 C6 FD 00 03 05 33 06 00 2E 06 00 4A 06 00 AF FC 00 02 03 33 06 00 2E 06 00 1E' + 'FC 00 02 06 33 06 00 2E 06 00 36 FD 00 02 04 33 06 00 2E 06 00 2A FD 00 02 05 33 06 00 31 06 00' + '0E FD 00 02 06 33 06 00 31 06 00 61 FD 00 03 03 33 06 00 45 06 00 2C 06 00 60 FD 00 03 03 33 06' + '00 45 06 00 2D 06 00 5F FD 00 03 05 33 06 00 45 06 00 2D 06 00 62 FD 00 03 05 33 06 00 45 06 00' + '45 06 00 63 FD 00 03 03 33 06 00 45 06 00 45 06 00 E7 FC 00 02 04 33 06 00 45 06 00 1F FC 00 02' + '06 33 06 00 45 06 00 B0 FC 00 02 03 33 06 00 45 06 00 31 FD 00 02 03 33 06 00 47 06 00 E8 FC 00' + '02 04 33 06 00 47 06 00 FB FC 00 02 06 33 06 00 49 06 00 17 FD 00 02 05 33 06 00 49 06 00 18 FD' + '00 02 05 33 06 00 4A 06 00 FC FC 00 02 06 33 06 00 4A 06 00 0E EE 01 01 01 33 06 00 8E EE 01 01' + '01 33 06 00 AE EE 01 01 01 33 06 00 B1 FE 00 01 06 33 06 00 B2 FE 00 01 05 33 06 00 4E EE 01 01' + '01 33 06 00 6E EE 01 01 01 33 06 00 2E EE 01 01 01 33 06 00 B4 FE 00 01 04 33 06 00 B3 FE 00 01' + '03 33 06 00 69 FD 00 03 05 34 06 00 2C 06 00 4A 06 00 37 FD 00 02 04 34 06 00 2C 06 00 09 FD 00' + '02 06 34 06 00 2C 06 00 2D FD 00 02 03 34 06 00 2C 06 00 25 FD 00 02 05 34 06 00 2C 06 00 68 FD' + '00 03 03 34 06 00 2D 06 00 45 06 00 67 FD 00 03 05 34 06 00 2D 06 00 45 06 00 AA FD 00 03 05 34' + '06 00 2D 06 00 4A 06 00 38 FD 00 02 04 34 06 00 2D 06 00 2E FD 00 02 03 34 06 00 2D 06 00 26 FD' + '00 02 05 34 06 00 2D 06 00 0A FD 00 02 06 34 06 00 2D 06 00 0B FD 00 02 06 34 06 00 2E 06 00 39' + 'FD 00 02 04 34 06 00 2E 06 00 27 FD 00 02 05 34 06 00 2E 06 00 2F FD 00 02 03 34 06 00 2E 06 00' + '29 FD 00 02 05 34 06 00 31 06 00 0D FD 00 02 06 34 06 00 31 06 00 6B FD 00 03 03 34 06 00 45 06' + '00 2E 06 00 6A FD 00 03 05 34 06 00 45 06 00 2E 06 00 6D FD 00 03 03 34 06 00 45 06 00 45 06 00' + '6C FD 00 03 05 34 06 00 45 06 00 45 06 00 28 FD 00 02 05 34 06 00 45 06 00 0C FD 00 02 06 34 06' + '00 45 06 00 E9 FC 00 02 04 34 06 00 45 06 00 30 FD 00 02 03 34 06 00 45 06 00 EA FC 00 02 04 34' + '06 00 47 06 00 32 FD 00 02 03 34 06 00 47 06 00 FD FC 00 02 06 34 06 00 49 06 00 19 FD 00 02 05' + '34 06 00 49 06 00 FE FC 00 02 06 34 06 00 4A 06 00 1A FD 00 02 05 34 06 00 4A 06 00 B8 FE 00 01' + '04 34 06 00 74 EE 01 01 01 34 06 00 14 EE 01 01 01 34 06 00 B4 EE 01 01 01 34 06 00 34 EE 01 01' + '01 34 06 00 B5 FE 00 01 06 34 06 00 94 EE 01 01 01 34 06 00 B6 FE 00 01 05 34 06 00 54 EE 01 01' + '01 34 06 00 B7 FE 00 01 03 34 06 00 64 FD 00 03 05 35 06 00 2D 06 00 2D 06 00 65 FD 00 03 03 35' + '06 00 2D 06 00 2D 06 00 A9 FD 00 03 05 35 06 00 2D 06 00 4A 06 00 20 FC 00 02 06 35 06 00 2D 06' + '00 B1 FC 00 02 03 35 06 00 2D 06 00 B2 FC 00 02 03 35 06 00 2E 06 00 2B FD 00 02 05 35 06 00 31' + '06 00 0F FD 00 02 06 35 06 00 31 06 00 F5 FD 00 04 06 35 06 00 44 06 00 39 06 00 45 06 00 FA FD' + '00 12 06 35 06 00 44 06 00 49 06 00 20 00 00 27 06 00 44 06 00 44 06 00 47 06 00 20 00 00 39 06' + '00 44 06 00 4A 06 00 47 06 00 20 00 00 48 06 00 33 06 00 44 06 00 45 06 00 F9 FD 00 03 06 35 06' + '00 44 06 00 49 06 00 F0 FD 00 03 06 35 06 00 44 06 00 D2 06 00 C5 FD 00 03 03 35 06 00 45 06 00' + '45 06 00 66 FD 00 03 05 35 06 00 45 06 00 45 06 00 B3 FC 00 02 03 35 06 00 45 06 00 21 FC 00 02' + '06 35 06 00 45 06 00 21 FD 00 02 05 35 06 00 49 06 00 05 FD 00 02 06 35 06 00 49 06 00 22 FD 00' + '02 05 35 06 00 4A 06 00 06 FD 00 02 06 35 06 00 4A 06 00 BB FE 00 01 03 35 06 00 71 EE 01 01 01' + '35 06 00 11 EE 01 01 01 35 06 00 BC FE 00 01 04 35 06 00 91 EE 01 01 01 35 06 00 BA FE 00 01 05' + '35 06 00 51 EE 01 01 01 35 06 00 B1 EE 01 01 01 35 06 00 31 EE 01 01 01 35 06 00 B9 FE 00 01 06' + '35 06 00 22 FC 00 02 06 36 06 00 2C 06 00 B4 FC 00 02 03 36 06 00 2C 06 00 6E FD 00 03 05 36 06' + '00 2D 06 00 49 06 00 AB FD 00 03 05 36 06 00 2D 06 00 4A 06 00 23 FC 00 02 06 36 06 00 2D 06 00' + 'B5 FC 00 02 03 36 06 00 2D 06 00 6F FD 00 03 05 36 06 00 2E 06 00 45 06 00 70 FD 00 03 03 36 06' + '00 2E 06 00 45 06 00 24 FC 00 02 06 36 06 00 2E 06 00 B6 FC 00 02 03 36 06 00 2E 06 00 10 FD 00' + '02 06 36 06 00 31 06 00 2C FD 00 02 05 36 06 00 31 06 00 25 FC 00 02 06 36 06 00 45 06 00 B7 FC' + '00 02 03 36 06 00 45 06 00 23 FD 00 02 05 36 06 00 49 06 00 07 FD 00 02 06 36 06 00 49 06 00 24' + 'FD 00 02 05 36 06 00 4A 06 00 08 FD 00 02 06 36 06 00 4A 06 00 19 EE 01 01 01 36 06 00 59 EE 01' + '01 01 36 06 00 79 EE 01 01 01 36 06 00 B9 EE 01 01 01 36 06 00 BF FE 00 01 03 36 06 00 BE FE 00' + '01 05 36 06 00 39 EE 01 01 01 36 06 00 99 EE 01 01 01 36 06 00 BD FE 00 01 06 36 06 00 C0 FE 00' + '01 04 36 06 00 B8 FC 00 02 03 37 06 00 2D 06 00 26 FC 00 02 06 37 06 00 2D 06 00 71 FD 00 03 05' + '37 06 00 45 06 00 2D 06 00 72 FD 00 03 03 37 06 00 45 06 00 2D 06 00 73 FD 00 03 03 37 06 00 45' + '06 00 45 06 00 74 FD 00 03 05 37 06 00 45 06 00 4A 06 00 27 FC 00 02 06 37 06 00 45 06 00 3A FD' + '00 02 04 37 06 00 45 06 00 33 FD 00 02 03 37 06 00 45 06 00 11 FD 00 02 05 37 06 00 49 06 00 F5' + 'FC 00 02 06 37 06 00 49 06 00 12 FD 00 02 05 37 06 00 4A 06 00 F6 FC 00 02 06 37 06 00 4A 06 00' + '08 EE 01 01 01 37 06 00 88 EE 01 01 01 37 06 00 68 EE 01 01 01 37 06 00 C2 FE 00 01 05 37 06 00' + 'C1 FE 00 01 06 37 06 00 C3 FE 00 01 03 37 06 00 A8 EE 01 01 01 37 06 00 C4 FE 00 01 04 37 06 00' + '3B FD 00 02 04 38 06 00 45 06 00 B9 FC 00 02 03 38 06 00 45 06 00 28 FC 00 02 06 38 06 00 45 06' + '00 C5 FE 00 01 06 38 06 00 7A EE 01 01 01 38 06 00 C6 FE 00 01 05 38 06 00 1A EE 01 01 01 38 06' + '00 BA EE 01 01 01 38 06 00 C7 FE 00 01 03 38 06 00 C8 FE 00 01 04 38 06 00 9A EE 01 01 01 38 06' + '00 75 FD 00 03 05 39 06 00 2C 06 00 45 06 00 C4 FD 00 03 03 39 06 00 2C 06 00 45 06 00 29 FC 00' + '02 06 39 06 00 2C 06 00 BA FC 00 02 03 39 06 00 2C 06 00 F7 FD 00 04 06 39 06 00 44 06 00 4A 06' + '00 47 06 00 77 FD 00 03 03 39 06 00 45 06 00 45 06 00 76 FD 00 03 05 39 06 00 45 06 00 45 06 00' + '78 FD 00 03 05 39 06 00 45 06 00 49 06 00 B6 FD 00 03 05 39 06 00 45 06 00 4A 06 00 BB FC 00 02' + '03 39 06 00 45 06 00 2A FC 00 02 06 39 06 00 45 06 00 13 FD 00 02 05 39 06 00 49 06 00 F7 FC 00' + '02 06 39 06 00 49 06 00 14 FD 00 02 05 39 06 00 4A 06 00 F8 FC 00 02 06 39 06 00 4A 06 00 4F EE' + '01 01 01 39 06 00 C9 FE 00 01 06 39 06 00 CA FE 00 01 05 39 06 00 2F EE 01 01 01 39 06 00 CC FE' + '00 01 04 39 06 00 CB FE 00 01 03 39 06 00 AF EE 01 01 01 39 06 00 6F EE 01 01 01 39 06 00 8F EE' + '01 01 01 39 06 00 0F EE 01 01 01 39 06 00 2B FC 00 02 06 3A 06 00 2C 06 00 BC FC 00 02 03 3A 06' + '00 2C 06 00 79 FD 00 03 05 3A 06 00 45 06 00 45 06 00 7B FD 00 03 05 3A 06 00 45 06 00 49 06 00' + '7A FD 00 03 05 3A 06 00 45 06 00 4A 06 00 2C FC 00 02 06 3A 06 00 45 06 00 BD FC 00 02 03 3A 06' + '00 45 06 00 F9 FC 00 02 06 3A 06 00 49 06 00 15 FD 00 02 05 3A 06 00 49 06 00 FA FC 00 02 06 3A' + '06 00 4A 06 00 16 FD 00 02 05 3A 06 00 4A 06 00 9B EE 01 01 01 3A 06 00 3B EE 01 01 01 3A 06 00' + 'CD FE 00 01 06 3A 06 00 CE FE 00 01 05 3A 06 00 5B EE 01 01 01 3A 06 00 7B EE 01 01 01 3A 06 00' + 'BB EE 01 01 01 3A 06 00 CF FE 00 01 03 3A 06 00 D0 FE 00 01 04 3A 06 00 1B EE 01 01 01 3A 06 00' + '71 FE 00 02 04 40 06 00 4B 06 00 F2 FC 00 03 04 40 06 00 4E 06 00 51 06 00 77 FE 00 02 04 40 06' + '00 4E 06 00 F3 FC 00 03 04 40 06 00 4F 06 00 51 06 00 79 FE 00 02 04 40 06 00 4F 06 00 F4 FC 00' + '03 04 40 06 00 50 06 00 51 06 00 7B FE 00 02 04 40 06 00 50 06 00 7D FE 00 02 04 40 06 00 51 06' + '00 7F FE 00 02 04 40 06 00 52 06 00 BE FC 00 02 03 41 06 00 2C 06 00 2D FC 00 02 06 41 06 00 2C' + '06 00 BF FC 00 02 03 41 06 00 2D 06 00 2E FC 00 02 06 41 06 00 2D 06 00 7D FD 00 03 03 41 06 00' + '2E 06 00 45 06 00 7C FD 00 03 05 41 06 00 2E 06 00 45 06 00 2F FC 00 02 06 41 06 00 2E 06 00 C0' + 'FC 00 02 03 41 06 00 2E 06 00 C1 FD 00 03 05 41 06 00 45 06 00 4A 06 00 C1 FC 00 02 03 41 06 00' + '45 06 00 30 FC 00 02 06 41 06 00 45 06 00 31 FC 00 02 06 41 06 00 49 06 00 7C FC 00 02 05 41 06' + '00 49 06 00 7D FC 00 02 05 41 06 00 4A 06 00 32 FC 00 02 06 41 06 00 4A 06 00 B0 EE 01 01 01 41' + '06 00 D3 FE 00 01 03 41 06 00 D4 FE 00 01 04 41 06 00 D1 FE 00 01 06 41 06 00 D2 FE 00 01 05 41' + '06 00 70 EE 01 01 01 41 06 00 90 EE 01 01 01 41 06 00 10 EE 01 01 01 41 06 00 30 EE 01 01 01 41' + '06 00 C2 FC 00 02 03 42 06 00 2D 06 00 33 FC 00 02 06 42 06 00 2D 06 00 F1 FD 00 03 06 42 06 00' + '44 06 00 D2 06 00 7E FD 00 03 05 42 06 00 45 06 00 2D 06 00 B4 FD 00 03 03 42 06 00 45 06 00 2D' + '06 00 7F FD 00 03 05 42 06 00 45 06 00 45 06 00 B2 FD 00 03 05 42 06 00 45 06 00 4A 06 00 34 FC' + '00 02 06 42 06 00 45 06 00 C3 FC 00 02 03 42 06 00 45 06 00 7E FC 00 02 05 42 06 00 49 06 00 35' + 'FC 00 02 06 42 06 00 49 06 00 36 FC 00 02 06 42 06 00 4A 06 00 7F FC 00 02 05 42 06 00 4A 06 00' + '32 EE 01 01 01 42 06 00 B2 EE 01 01 01 42 06 00 D5 FE 00 01 06 42 06 00 92 EE 01 01 01 42 06 00' + '12 EE 01 01 01 42 06 00 D6 FE 00 01 05 42 06 00 52 EE 01 01 01 42 06 00 D8 FE 00 01 04 42 06 00' + 'D7 FE 00 01 03 42 06 00 72 EE 01 01 01 42 06 00 80 FC 00 02 05 43 06 00 27 06 00 37 FC 00 02 06' + '43 06 00 27 06 00 38 FC 00 02 06 43 06 00 2C 06 00 C4 FC 00 02 03 43 06 00 2C 06 00 C5 FC 00 02' + '03 43 06 00 2D 06 00 39 FC 00 02 06 43 06 00 2D 06 00 3A FC 00 02 06 43 06 00 2E 06 00 C6 FC 00' + '02 03 43 06 00 2E 06 00 3B FC 00 02 06 43 06 00 44 06 00 81 FC 00 02 05 43 06 00 44 06 00 C7 FC' + '00 02 03 43 06 00 44 06 00 EB FC 00 02 04 43 06 00 44 06 00 BB FD 00 03 05 43 06 00 45 06 00 45' + '06 00 C3 FD 00 03 03 43 06 00 45 06 00 45 06 00 B7 FD 00 03 05 43 06 00 45 06 00 4A 06 00 EC FC' + '00 02 04 43 06 00 45 06 00 82 FC 00 02 05 43 06 00 45 06 00 3C FC 00 02 06 43 06 00 45 06 00 C8' + 'FC 00 02 03 43 06 00 45 06 00 3D FC 00 02 06 43 06 00 49 06 00 83 FC 00 02 05 43 06 00 49 06 00' + '84 FC 00 02 05 43 06 00 4A 06 00 3E FC 00 02 06 43 06 00 4A 06 00 6A EE 01 01 01 43 06 00 D9 FE' + '00 01 06 43 06 00 DA FE 00 01 05 43 06 00 2A EE 01 01 01 43 06 00 0A EE 01 01 01 43 06 00 DB FE' + '00 01 03 43 06 00 DC FE 00 01 04 43 06 00 F6 FE 00 03 05 44 06 00 27 06 00 53 06 00 F5 FE 00 03' + '06 44 06 00 27 06 00 53 06 00 F7 FE 00 03 06 44 06 00 27 06 00 54 06 00 F8 FE 00 03 05 44 06 00' + '27 06 00 54 06 00 FA FE 00 03 05 44 06 00 27 06 00 55 06 00 F9 FE 00 03 06 44 06 00 27 06 00 55' + '06 00 FC FE 00 02 05 44 06 00 27 06 00 FB FE 00 02 06 44 06 00 27 06 00 83 FD 00 03 03 44 06 00' + '2C 06 00 2C 06 00 84 FD 00 03 05 44 06 00 2C 06 00 2C 06 00 BA FD 00 03 03 44 06 00 2C 06 00 45' + '06 00 BC FD 00 03 05 44 06 00 2C 06 00 45 06 00 AC FD 00 03 05 44 06 00 2C 06 00 4A 06 00 C9 FC' + '00 02 03 44 06 00 2C 06 00 3F FC 00 02 06 44 06 00 2C 06 00 B5 FD 00 03 03 44 06 00 2D 06 00 45' + '06 00 80 FD 00 03 05 44 06 00 2D 06 00 45 06 00 82 FD 00 03 05 44 06 00 2D 06 00 49 06 00 81 FD' + '00 03 05 44 06 00 2D 06 00 4A 06 00 40 FC 00 02 06 44 06 00 2D 06 00 CA FC 00 02 03 44 06 00 2D' + '06 00 86 FD 00 03 03 44 06 00 2E 06 00 45 06 00 85 FD 00 03 05 44 06 00 2E 06 00 45 06 00 41 FC' + '00 02 06 44 06 00 2E 06 00 CB FC 00 02 03 44 06 00 2E 06 00 87 FD 00 03 05 44 06 00 45 06 00 2D' + '06 00 88 FD 00 03 03 44 06 00 45 06 00 2D 06 00 AD FD 00 03 05 44 06 00 45 06 00 4A 06 00 CC FC' + '00 02 03 44 06 00 45 06 00 85 FC 00 02 05 44 06 00 45 06 00 ED FC 00 02 04 44 06 00 45 06 00 42' + 'FC 00 02 06 44 06 00 45 06 00 CD FC 00 02 03 44 06 00 47 06 00 86 FC 00 02 05 44 06 00 49 06 00' + '43 FC 00 02 06 44 06 00 49 06 00 44 FC 00 02 06 44 06 00 4A 06 00 87 FC 00 02 05 44 06 00 4A 06' + '00 8B EE 01 01 01 44 06 00 2B EE 01 01 01 44 06 00 0B EE 01 01 01 44 06 00 4B EE 01 01 01 44 06' + '00 DF FE 00 01 03 44 06 00 E0 FE 00 01 04 44 06 00 DE FE 00 01 05 44 06 00 AB EE 01 01 01 44 06' + '00 DD FE 00 01 06 44 06 00 88 FC 00 02 05 45 06 00 27 06 00 8C FD 00 03 03 45 06 00 2C 06 00 2D' + '06 00 92 FD 00 03 03 45 06 00 2C 06 00 2E 06 00 8D FD 00 03 03 45 06 00 2C 06 00 45 06 00 C0 FD' + '00 03 05 45 06 00 2C 06 00 4A 06 00 CE FC 00 02 03 45 06 00 2C 06 00 45 FC 00 02 06 45 06 00 2C' + '06 00 89 FD 00 03 03 45 06 00 2D 06 00 2C 06 00 F4 FD 00 04 06 45 06 00 2D 06 00 45 06 00 2F 06' + '00 8A FD 00 03 03 45 06 00 2D 06 00 45 06 00 8B FD 00 03 05 45 06 00 2D 06 00 4A 06 00 CF FC 00' + '02 03 45 06 00 2D 06 00 46 FC 00 02 06 45 06 00 2D 06 00 8E FD 00 03 03 45 06 00 2E 06 00 2C 06' + '00 8F FD 00 03 03 45 06 00 2E 06 00 45 06 00 B9 FD 00 03 05 45 06 00 2E 06 00 4A 06 00 D0 FC 00' + '02 03 45 06 00 2E 06 00 47 FC 00 02 06 45 06 00 2E 06 00 B1 FD 00 03 05 45 06 00 45 06 00 4A 06' + '00 89 FC 00 02 05 45 06 00 45 06 00 D1 FC 00 02 03 45 06 00 45 06 00 48 FC 00 02 06 45 06 00 45' + '06 00 49 FC 00 02 06 45 06 00 49 06 00 4A FC 00 02 06 45 06 00 4A 06 00 E1 FE 00 01 06 45 06 00' + '2C EE 01 01 01 45 06 00 0C EE 01 01 01 45 06 00 8C EE 01 01 01 45 06 00 6C EE 01 01 01 45 06 00' + 'AC EE 01 01 01 45 06 00 E4 FE 00 01 04 45 06 00 E2 FE 00 01 05 45 06 00 E3 FE 00 01 03 45 06 00' + 'B8 FD 00 03 03 46 06 00 2C 06 00 2D 06 00 BD FD 00 03 05 46 06 00 2C 06 00 2D 06 00 97 FD 00 03' + '05 46 06 00 2C 06 00 45 06 00 98 FD 00 03 03 46 06 00 2C 06 00 45 06 00 99 FD 00 03 05 46 06 00' + '2C 06 00 49 06 00 C7 FD 00 03 05 46 06 00 2C 06 00 4A 06 00 4B FC 00 02 06 46 06 00 2C 06 00 D2' + 'FC 00 02 03 46 06 00 2C 06 00 95 FD 00 03 03 46 06 00 2D 06 00 45 06 00 96 FD 00 03 05 46 06 00' + '2D 06 00 49 06 00 B3 FD 00 03 05 46 06 00 2D 06 00 4A 06 00 4C FC 00 02 06 46 06 00 2D 06 00 D3' + 'FC 00 02 03 46 06 00 2D 06 00 4D FC 00 02 06 46 06 00 2E 06 00 D4 FC 00 02 03 46 06 00 2E 06 00' + '8A FC 00 02 05 46 06 00 31 06 00 8B FC 00 02 05 46 06 00 32 06 00 9B FD 00 03 05 46 06 00 45 06' + '00 49 06 00 9A FD 00 03 05 46 06 00 45 06 00 4A 06 00 EE FC 00 02 04 46 06 00 45 06 00 8C FC 00' + '02 05 46 06 00 45 06 00 4E FC 00 02 06 46 06 00 45 06 00 D5 FC 00 02 03 46 06 00 45 06 00 8D FC' + '00 02 05 46 06 00 46 06 00 D6 FC 00 02 03 46 06 00 47 06 00 EF FC 00 02 04 46 06 00 47 06 00 4F' + 'FC 00 02 06 46 06 00 49 06 00 8E FC 00 02 05 46 06 00 49 06 00 50 FC 00 02 06 46 06 00 4A 06 00' + '8F FC 00 02 05 46 06 00 4A 06 00 4D EE 01 01 01 46 06 00 6D EE 01 01 01 46 06 00 E8 FE 00 01 04' + '46 06 00 E7 FE 00 01 03 46 06 00 0D EE 01 01 01 46 06 00 AD EE 01 01 01 46 06 00 E5 FE 00 01 06' + '46 06 00 E6 FE 00 01 05 46 06 00 8D EE 01 01 01 46 06 00 2D EE 01 01 01 46 06 00 D7 FC 00 02 03' + '47 06 00 2C 06 00 51 FC 00 02 06 47 06 00 2C 06 00 93 FD 00 03 03 47 06 00 45 06 00 2C 06 00 94' + 'FD 00 03 03 47 06 00 45 06 00 45 06 00 52 FC 00 02 06 47 06 00 45 06 00 D8 FC 00 02 03 47 06 00' + '45 06 00 53 FC 00 02 06 47 06 00 49 06 00 54 FC 00 02 06 47 06 00 4A 06 00 D9 FC 00 02 03 47 06' + '00 70 06 00 24 EE 01 01 01 47 06 00 E9 FE 00 01 06 47 06 00 EC FE 00 01 04 47 06 00 64 EE 01 01' + '01 47 06 00 84 EE 01 01 01 47 06 00 EA FE 00 01 05 47 06 00 EB FE 00 01 03 47 06 00 F8 FD 00 04' + '06 48 06 00 33 06 00 44 06 00 45 06 00 24 06 00 02 00 48 06 00 54 06 00 85 FE 00 02 06 48 06 00' + '54 06 00 86 FE 00 02 05 48 06 00 54 06 00 76 06 00 02 10 48 06 00 74 06 00 EE FE 00 01 05 48 06' + '00 ED FE 00 01 06 48 06 00 85 EE 01 01 01 48 06 00 A5 EE 01 01 01 48 06 00 05 EE 01 01 01 48 06' + '00 90 FC 00 02 05 49 06 00 70 06 00 5D FC 00 02 06 49 06 00 70 06 00 EF FE 00 01 06 49 06 00 E8' + 'FB 00 01 03 49 06 00 E9 FB 00 01 04 49 06 00 F0 FE 00 01 05 49 06 00 AF FD 00 03 05 4A 06 00 2C' + '06 00 4A 06 00 55 FC 00 02 06 4A 06 00 2C 06 00 DA FC 00 02 03 4A 06 00 2C 06 00 AE FD 00 03 05' + '4A 06 00 2D 06 00 4A 06 00 56 FC 00 02 06 4A 06 00 2D 06 00 DB FC 00 02 03 4A 06 00 2D 06 00 DC' + 'FC 00 02 03 4A 06 00 2E 06 00 57 FC 00 02 06 4A 06 00 2E 06 00 91 FC 00 02 05 4A 06 00 31 06 00' + '92 FC 00 02 05 4A 06 00 32 06 00 9D FD 00 03 03 4A 06 00 45 06 00 45 06 00 9C FD 00 03 05 4A 06' + '00 45 06 00 45 06 00 B0 FD 00 03 05 4A 06 00 45 06 00 4A 06 00 58 FC 00 02 06 4A 06 00 45 06 00' + '93 FC 00 02 05 4A 06 00 45 06 00 DD FC 00 02 03 4A 06 00 45 06 00 F0 FC 00 02 04 4A 06 00 45 06' + '00 94 FC 00 02 05 4A 06 00 46 06 00 DE FC 00 02 03 4A 06 00 47 06 00 F1 FC 00 02 04 4A 06 00 47' + '06 00 95 FC 00 02 05 4A 06 00 49 06 00 59 FC 00 02 06 4A 06 00 49 06 00 5A FC 00 02 06 4A 06 00' + '4A 06 00 96 FC 00 02 05 4A 06 00 4A 06 00 EA FB 00 03 06 4A 06 00 54 06 00 27 06 00 EB FB 00 03' + '05 4A 06 00 54 06 00 27 06 00 00 FC 00 03 06 4A 06 00 54 06 00 2C 06 00 97 FC 00 03 03 4A 06 00' + '54 06 00 2C 06 00 01 FC 00 03 06 4A 06 00 54 06 00 2D 06 00 98 FC 00 03 03 4A 06 00 54 06 00 2D' + '06 00 99 FC 00 03 03 4A 06 00 54 06 00 2E 06 00 64 FC 00 03 05 4A 06 00 54 06 00 31 06 00 65 FC' + '00 03 05 4A 06 00 54 06 00 32 06 00 9A FC 00 03 03 4A 06 00 54 06 00 45 06 00 DF FC 00 03 04 4A' + '06 00 54 06 00 45 06 00 66 FC 00 03 05 4A 06 00 54 06 00 45 06 00 02 FC 00 03 06 4A 06 00 54 06' + '00 45 06 00 67 FC 00 03 05 4A 06 00 54 06 00 46 06 00 9B FC 00 03 03 4A 06 00 54 06 00 47 06 00' + 'E0 FC 00 03 04 4A 06 00 54 06 00 47 06 00 EF FB 00 03 05 4A 06 00 54 06 00 48 06 00 EE FB 00 03' + '06 4A 06 00 54 06 00 48 06 00 F9 FB 00 03 06 4A 06 00 54 06 00 49 06 00 68 FC 00 03 05 4A 06 00' + '54 06 00 49 06 00 03 FC 00 03 06 4A 06 00 54 06 00 49 06 00 FB FB 00 03 03 4A 06 00 54 06 00 49' + '06 00 FA FB 00 03 05 4A 06 00 54 06 00 49 06 00 04 FC 00 03 06 4A 06 00 54 06 00 4A 06 00 69 FC' + '00 03 05 4A 06 00 54 06 00 4A 06 00 F2 FB 00 03 06 4A 06 00 54 06 00 C6 06 00 F3 FB 00 03 05 4A' + '06 00 54 06 00 C6 06 00 F1 FB 00 03 05 4A 06 00 54 06 00 C7 06 00 F0 FB 00 03 06 4A 06 00 54 06' + '00 C7 06 00 F5 FB 00 03 05 4A 06 00 54 06 00 C8 06 00 F4 FB 00 03 06 4A 06 00 54 06 00 C8 06 00' + 'F7 FB 00 03 05 4A 06 00 54 06 00 D0 06 00 F6 FB 00 03 06 4A 06 00 54 06 00 D0 06 00 F8 FB 00 03' + '03 4A 06 00 54 06 00 D0 06 00 EC FB 00 03 06 4A 06 00 54 06 00 D5 06 00 ED FB 00 03 05 4A 06 00' + '54 06 00 D5 06 00 89 FE 00 02 06 4A 06 00 54 06 00 8B FE 00 02 03 4A 06 00 54 06 00 8C FE 00 02' + '04 4A 06 00 54 06 00 8A FE 00 02 05 4A 06 00 54 06 00 26 06 00 02 00 4A 06 00 54 06 00 78 06 00' + '02 10 4A 06 00 74 06 00 29 EE 01 01 01 4A 06 00 49 EE 01 01 01 4A 06 00 69 EE 01 01 01 4A 06 00' + 'F3 FE 00 01 03 4A 06 00 09 EE 01 01 01 4A 06 00 A9 EE 01 01 01 4A 06 00 89 EE 01 01 01 4A 06 00' + 'F4 FE 00 01 04 4A 06 00 F2 FE 00 01 05 4A 06 00 F1 FE 00 01 06 4A 06 00 1C EE 01 01 01 6E 06 00' + '7C EE 01 01 01 6E 06 00 5F EE 01 01 01 6F 06 00 1F EE 01 01 01 6F 06 00 50 FB 00 01 06 71 06 00' + '51 FB 00 01 05 71 06 00 68 FB 00 01 03 79 06 00 69 FB 00 01 04 79 06 00 66 FB 00 01 06 79 06 00' + '67 FB 00 01 05 79 06 00 60 FB 00 01 03 7A 06 00 61 FB 00 01 04 7A 06 00 5E FB 00 01 06 7A 06 00' + '5F FB 00 01 05 7A 06 00 54 FB 00 01 03 7B 06 00 55 FB 00 01 04 7B 06 00 52 FB 00 01 06 7B 06 00' + '53 FB 00 01 05 7B 06 00 58 FB 00 01 03 7E 06 00 59 FB 00 01 04 7E 06 00 56 FB 00 01 06 7E 06 00' + '57 FB 00 01 05 7E 06 00 63 FB 00 01 05 7F 06 00 62 FB 00 01 06 7F 06 00 65 FB 00 01 04 7F 06 00' + '64 FB 00 01 03 7F 06 00 5B FB 00 01 05 80 06 00 5A FB 00 01 06 80 06 00 5D FB 00 01 04 80 06 00' + '5C FB 00 01 03 80 06 00 78 FB 00 01 03 83 06 00 79 FB 00 01 04 83 06 00 76 FB 00 01 06 83 06 00' + '77 FB 00 01 05 83 06 00 74 FB 00 01 03 84 06 00 75 FB 00 01 04 84 06 00 72 FB 00 01 06 84 06 00' + '73 FB 00 01 05 84 06 00 7D FB 00 01 04 86 06 00 7C FB 00 01 03 86 06 00 7B FB 00 01 05 86 06 00' + '7A FB 00 01 06 86 06 00 80 FB 00 01 03 87 06 00 81 FB 00 01 04 87 06 00 7E FB 00 01 06 87 06 00' + '7F FB 00 01 05 87 06 00 89 FB 00 01 05 88 06 00 88 FB 00 01 06 88 06 00 84 FB 00 01 06 8C 06 00' + '85 FB 00 01 05 8C 06 00 82 FB 00 01 06 8D 06 00 83 FB 00 01 05 8D 06 00 87 FB 00 01 05 8E 06 00' + '86 FB 00 01 06 8E 06 00 8D FB 00 01 05 91 06 00 8C FB 00 01 06 91 06 00 8A FB 00 01 06 98 06 00' + '8B FB 00 01 05 98 06 00 1E EE 01 01 01 A1 06 00 7E EE 01 01 01 A1 06 00 6D FB 00 01 04 A4 06 00' + '6C FB 00 01 03 A4 06 00 6A FB 00 01 06 A4 06 00 6B FB 00 01 05 A4 06 00 6F FB 00 01 05 A6 06 00' + '6E FB 00 01 06 A6 06 00 71 FB 00 01 04 A6 06 00 70 FB 00 01 03 A6 06 00 91 FB 00 01 04 A9 06 00' + '8E FB 00 01 06 A9 06 00 8F FB 00 01 05 A9 06 00 90 FB 00 01 03 A9 06 00 D5 FB 00 01 03 AD 06 00' + 'D6 FB 00 01 04 AD 06 00 D3 FB 00 01 06 AD 06 00 D4 FB 00 01 05 AD 06 00 93 FB 00 01 05 AF 06 00' + '92 FB 00 01 06 AF 06 00 95 FB 00 01 04 AF 06 00 94 FB 00 01 03 AF 06 00 9B FB 00 01 05 B1 06 00' + '9A FB 00 01 06 B1 06 00 9D FB 00 01 04 B1 06 00 9C FB 00 01 03 B1 06 00 97 FB 00 01 05 B3 06 00' + '96 FB 00 01 06 B3 06 00 99 FB 00 01 04 B3 06 00 98 FB 00 01 03 B3 06 00 9E FB 00 01 06 BA 06 00' + '1D EE 01 01 01 BA 06 00 9F FB 00 01 05 BA 06 00 5D EE 01 01 01 BA 06 00 A0 FB 00 01 06 BB 06 00' + 'A1 FB 00 01 05 BB 06 00 A2 FB 00 01 03 BB 06 00 A3 FB 00 01 04 BB 06 00 AD FB 00 01 04 BE 06 00' + 'AA FB 00 01 06 BE 06 00 AB FB 00 01 05 BE 06 00 AC FB 00 01 03 BE 06 00 C2 06 00 02 00 C1 06 00' + '54 06 00 A7 FB 00 01 05 C1 06 00 A6 FB 00 01 06 C1 06 00 A8 FB 00 01 03 C1 06 00 A9 FB 00 01 04' + 'C1 06 00 E0 FB 00 01 06 C5 06 00 E1 FB 00 01 05 C5 06 00 D9 FB 00 01 06 C6 06 00 DA FB 00 01 05' + 'C6 06 00 DD FB 00 02 06 C7 06 00 74 06 00 77 06 00 02 10 C7 06 00 74 06 00 D7 FB 00 01 06 C7 06' + '00 D8 FB 00 01 05 C7 06 00 DB FB 00 01 06 C8 06 00 DC FB 00 01 05 C8 06 00 E2 FB 00 01 06 C9 06' + '00 E3 FB 00 01 05 C9 06 00 DE FB 00 01 06 CB 06 00 DF FB 00 01 05 CB 06 00 FD FB 00 01 05 CC 06' + '00 FC FB 00 01 06 CC 06 00 FF FB 00 01 04 CC 06 00 FE FB 00 01 03 CC 06 00 E6 FB 00 01 03 D0 06' + '00 E7 FB 00 01 04 D0 06 00 E4 FB 00 01 06 D0 06 00 E5 FB 00 01 05 D0 06 00 B1 FB 00 02 05 D2 06' + '00 54 06 00 D3 06 00 02 00 D2 06 00 54 06 00 B0 FB 00 02 06 D2 06 00 54 06 00 AE FB 00 01 06 D2' + '06 00 AF FB 00 01 05 D2 06 00 A5 FB 00 02 05 D5 06 00 54 06 00 A4 FB 00 02 06 D5 06 00 54 06 00' + 'C0 06 00 02 00 D5 06 00 54 06 00 29 09 00 02 00 28 09 00 3C 09 00 31 09 00 02 00 30 09 00 3C 09' + '00 34 09 00 02 00 33 09 00 3C 09 00 CB 09 00 02 00 C7 09 00 BE 09 00 CC 09 00 02 00 C7 09 00 D7' + '09 00 4B 0B 00 02 00 47 0B 00 3E 0B 00 48 0B 00 02 00 47 0B 00 56 0B 00 4C 0B 00 02 00 47 0B 00' + '57 0B 00 94 0B 00 02 00 92 0B 00 D7 0B 00 CA 0B 00 02 00 C6 0B 00 BE 0B 00 CC 0B 00 02 00 C6 0B' + '00 D7 0B 00 CB 0B 00 02 00 C7 0B 00 BE 0B 00 48 0C 00 02 00 46 0C 00 56 0C 00 C0 0C 00 02 00 BF' + '0C 00 D5 0C 00 CB 0C 00 03 00 C6 0C 00 C2 0C 00 D5 0C 00 CA 0C 00 02 00 C6 0C 00 C2 0C 00 C7 0C' + '00 02 00 C6 0C 00 D5 0C 00 C8 0C 00 02 00 C6 0C 00 D6 0C 00 4A 0D 00 02 00 46 0D 00 3E 0D 00 4C' + '0D 00 02 00 46 0D 00 57 0D 00 4B 0D 00 02 00 47 0D 00 3E 0D 00 DA 0D 00 02 00 D9 0D 00 CA 0D 00' + 'DD 0D 00 03 00 D9 0D 00 CF 0D 00 CA 0D 00 DC 0D 00 02 00 D9 0D 00 CF 0D 00 DE 0D 00 02 00 D9 0D' + '00 DF 0D 00 33 0E 00 02 10 4D 0E 00 32 0E 00 DC 0E 00 02 10 AB 0E 00 99 0E 00 DD 0E 00 02 10 AB' + '0E 00 A1 0E 00 B3 0E 00 02 10 CD 0E 00 B2 0E 00 0C 0F 00 01 02 0B 0F 00 77 0F 00 03 10 B2 0F 00' + '71 0F 00 80 0F 00 79 0F 00 03 10 B3 0F 00 71 0F 00 80 0F 00 26 10 00 02 00 25 10 00 2E 10 00 FC' + '10 00 01 08 DC 10 00 6E 32 00 02 07 00 11 00 61 11 00 31 31 00 01 10 00 11 00 A1 FF 00 01 0C 00' + '11 00 60 32 00 01 07 00 11 00 A2 FF 00 01 0C 01 11 00 32 31 00 01 10 01 11 00 6F 32 00 02 07 02' + '11 00 61 11 00 61 32 00 01 07 02 11 00 A4 FF 00 01 0C 02 11 00 34 31 00 01 10 02 11 00 70 32 00' + '02 07 03 11 00 61 11 00 37 31 00 01 10 03 11 00 A7 FF 00 01 0C 03 11 00 62 32 00 01 07 03 11 00' + 'A8 FF 00 01 0C 04 11 00 38 31 00 01 10 04 11 00 71 32 00 02 07 05 11 00 61 11 00 39 31 00 01 10' + '05 11 00 A9 FF 00 01 0C 05 11 00 63 32 00 01 07 05 11 00 72 32 00 02 07 06 11 00 61 11 00 41 31' + '00 01 10 06 11 00 B1 FF 00 01 0C 06 11 00 64 32 00 01 07 06 11 00 73 32 00 02 07 07 11 00 61 11' + '00 65 32 00 01 07 07 11 00 42 31 00 01 10 07 11 00 B2 FF 00 01 0C 07 11 00 B3 FF 00 01 0C 08 11' + '00 43 31 00 01 10 08 11 00 74 32 00 02 07 09 11 00 61 11 00 B5 FF 00 01 0C 09 11 00 66 32 00 01' + '07 09 11 00 45 31 00 01 10 09 11 00 B6 FF 00 01 0C 0A 11 00 46 31 00 01 10 0A 11 00 75 32 00 02' + '07 0B 11 00 61 11 00 7E 32 00 02 07 0B 11 00 6E 11 00 67 32 00 01 07 0B 11 00 47 31 00 01 10 0B' + '11 00 B7 FF 00 01 0C 0B 11 00 76 32 00 02 07 0C 11 00 61 11 00 7D 32 00 04 07 0C 11 00 6E 11 00' + '0B 11 00 74 11 00 B8 FF 00 01 0C 0C 11 00 48 31 00 01 10 0C 11 00 68 32 00 01 07 0C 11 00 49 31' + '00 01 10 0D 11 00 B9 FF 00 01 0C 0D 11 00 7C 32 00 05 07 0E 11 00 61 11 00 B7 11 00 00 11 00 69' + '11 00 77 32 00 02 07 0E 11 00 61 11 00 BA FF 00 01 0C 0E 11 00 4A 31 00 01 10 0E 11 00 69 32 00' + '01 07 0E 11 00 78 32 00 02 07 0F 11 00 61 11 00 BB FF 00 01 0C 0F 11 00 6A 32 00 01 07 0F 11 00' + '4B 31 00 01 10 0F 11 00 79 32 00 02 07 10 11 00 61 11 00 4C 31 00 01 10 10 11 00 6B 32 00 01 07' + '10 11 00 BC FF 00 01 0C 10 11 00 7A 32 00 02 07 11 11 00 61 11 00 4D 31 00 01 10 11 11 00 6C 32' + '00 01 07 11 11 00 BD FF 00 01 0C 11 11 00 7B 32 00 02 07 12 11 00 61 11 00 BE FF 00 01 0C 12 11' + '00 6D 32 00 01 07 12 11 00 4E 31 00 01 10 12 11 00 65 31 00 01 10 14 11 00 66 31 00 01 10 15 11' + '00 40 31 00 01 10 1A 11 00 B0 FF 00 01 0C 1A 11 00 6E 31 00 01 10 1C 11 00 71 31 00 01 10 1D 11' + '00 72 31 00 01 10 1E 11 00 73 31 00 01 10 20 11 00 B4 FF 00 01 0C 21 11 00 44 31 00 01 10 21 11' + '00 74 31 00 01 10 22 11 00 75 31 00 01 10 23 11 00 76 31 00 01 10 27 11 00 77 31 00 01 10 29 11' + '00 78 31 00 01 10 2B 11 00 79 31 00 01 10 2C 11 00 7A 31 00 01 10 2D 11 00 7B 31 00 01 10 2E 11' + '00 7C 31 00 01 10 2F 11 00 7D 31 00 01 10 32 11 00 7E 31 00 01 10 36 11 00 7F 31 00 01 10 40 11' + '00 80 31 00 01 10 47 11 00 81 31 00 01 10 4C 11 00 84 31 00 01 10 57 11 00 85 31 00 01 10 58 11' + '00 86 31 00 01 10 59 11 00 A0 FF 00 01 0C 60 11 00 64 31 00 01 10 60 11 00 4F 31 00 01 10 61 11' + '00 C2 FF 00 01 0C 61 11 00 50 31 00 01 10 62 11 00 C3 FF 00 01 0C 62 11 00 51 31 00 01 10 63 11' + '00 C4 FF 00 01 0C 63 11 00 52 31 00 01 10 64 11 00 C5 FF 00 01 0C 64 11 00 53 31 00 01 10 65 11' + '00 C6 FF 00 01 0C 65 11 00 54 31 00 01 10 66 11 00 C7 FF 00 01 0C 66 11 00 CA FF 00 01 0C 67 11' + '00 55 31 00 01 10 67 11 00 CB FF 00 01 0C 68 11 00 56 31 00 01 10 68 11 00 CC FF 00 01 0C 69 11' + '00 57 31 00 01 10 69 11 00 CD FF 00 01 0C 6A 11 00 58 31 00 01 10 6A 11 00 CE FF 00 01 0C 6B 11' + '00 59 31 00 01 10 6B 11 00 5A 31 00 01 10 6C 11 00 CF FF 00 01 0C 6C 11 00 5B 31 00 01 10 6D 11' + '00 D2 FF 00 01 0C 6D 11 00 D3 FF 00 01 0C 6E 11 00 5C 31 00 01 10 6E 11 00 D4 FF 00 01 0C 6F 11' + '00 5D 31 00 01 10 6F 11 00 D5 FF 00 01 0C 70 11 00 5E 31 00 01 10 70 11 00 D6 FF 00 01 0C 71 11' + '00 5F 31 00 01 10 71 11 00 D7 FF 00 01 0C 72 11 00 60 31 00 01 10 72 11 00 61 31 00 01 10 73 11' + '00 DA FF 00 01 0C 73 11 00 62 31 00 01 10 74 11 00 DB FF 00 01 0C 74 11 00 63 31 00 01 10 75 11' + '00 DC FF 00 01 0C 75 11 00 87 31 00 01 10 84 11 00 88 31 00 01 10 85 11 00 89 31 00 01 10 88 11' + '00 8A 31 00 01 10 91 11 00 8B 31 00 01 10 92 11 00 8C 31 00 01 10 94 11 00 8D 31 00 01 10 9E 11' + '00 8E 31 00 01 10 A1 11 00 A3 FF 00 01 0C AA 11 00 33 31 00 01 10 AA 11 00 35 31 00 01 10 AC 11' + '00 A5 FF 00 01 0C AC 11 00 36 31 00 01 10 AD 11 00 A6 FF 00 01 0C AD 11 00 AA FF 00 01 0C B0 11' + '00 3A 31 00 01 10 B0 11 00 3B 31 00 01 10 B1 11 00 AB FF 00 01 0C B1 11 00 3C 31 00 01 10 B2 11' + '00 AC FF 00 01 0C B2 11 00 AD FF 00 01 0C B3 11 00 3D 31 00 01 10 B3 11 00 AE FF 00 01 0C B4 11' + '00 3E 31 00 01 10 B4 11 00 AF FF 00 01 0C B5 11 00 3F 31 00 01 10 B5 11 00 67 31 00 01 10 C7 11' + '00 68 31 00 01 10 C8 11 00 69 31 00 01 10 CC 11 00 6A 31 00 01 10 CE 11 00 6B 31 00 01 10 D3 11' + '00 6C 31 00 01 10 D7 11 00 6D 31 00 01 10 D9 11 00 6F 31 00 01 10 DD 11 00 70 31 00 01 10 DF 11' + '00 82 31 00 01 10 F1 11 00 83 31 00 01 10 F2 11 00 06 1B 00 02 00 05 1B 00 35 1B 00 08 1B 00 02' + '00 07 1B 00 35 1B 00 0A 1B 00 02 00 09 1B 00 35 1B 00 0C 1B 00 02 00 0B 1B 00 35 1B 00 0E 1B 00' + '02 00 0D 1B 00 35 1B 00 12 1B 00 02 00 11 1B 00 35 1B 00 3B 1B 00 02 00 3A 1B 00 35 1B 00 3D 1B' + '00 02 00 3C 1B 00 35 1B 00 40 1B 00 02 00 3E 1B 00 35 1B 00 41 1B 00 02 00 3F 1B 00 35 1B 00 43' + '1B 00 02 00 42 1B 00 35 1B 00 46 1D 00 01 08 02 1D 00 54 1D 00 01 08 16 1D 00 55 1D 00 01 08 17' + '1D 00 B8 1D 00 01 08 1C 1D 00 59 1D 00 01 08 1D 1D 00 5C 1D 00 01 08 25 1D 00 A7 1D 00 01 08 7B' + '1D 00 AA 1D 00 01 08 85 1D 00 11 20 00 01 02 10 20 00 32 FE 00 01 0A 13 20 00 31 FE 00 01 0A 14' + '20 00 58 FE 00 01 0D 14 20 00 57 20 00 04 10 32 20 00 32 20 00 32 20 00 32 20 00 34 20 00 03 10' + '32 20 00 32 20 00 32 20 00 33 20 00 02 10 32 20 00 32 20 00 37 20 00 03 10 35 20 00 35 20 00 35' + '20 00 36 20 00 02 10 35 20 00 35 20 00 E6 FF 00 01 0B A9 20 00 9A 21 00 02 00 90 21 00 38 03 00' + 'E9 FF 00 01 0C 90 21 00 EA FF 00 01 0C 91 21 00 9B 21 00 02 00 92 21 00 38 03 00 EB FF 00 01 0C' + '92 21 00 EC FF 00 01 0C 93 21 00 AE 21 00 02 00 94 21 00 38 03 00 CD 21 00 02 00 D0 21 00 38 03' + '00 CF 21 00 02 00 D2 21 00 38 03 00 CE 21 00 02 00 D4 21 00 38 03 00 C3 D7 01 01 01 02 22 00 15' + 'D7 01 01 01 02 22 00 DB D6 01 01 01 02 22 00 89 D7 01 01 01 02 22 00 4F D7 01 01 01 02 22 00 04' + '22 00 02 00 03 22 00 38 03 00 A9 D7 01 01 01 07 22 00 35 D7 01 01 01 07 22 00 C1 D6 01 01 01 07' + '22 00 6F D7 01 01 01 07 22 00 FB D6 01 01 01 07 22 00 09 22 00 02 00 08 22 00 38 03 00 0C 22 00' + '02 00 0B 22 00 38 03 00 40 21 00 01 01 11 22 00 8B 20 00 01 09 12 22 00 7B 20 00 01 08 12 22 00' + '24 22 00 02 00 23 22 00 38 03 00 26 22 00 02 00 25 22 00 38 03 00 0C 2A 00 04 10 2B 22 00 2B 22' + '00 2B 22 00 2B 22 00 2D 22 00 03 10 2B 22 00 2B 22 00 2B 22 00 2C 22 00 02 10 2B 22 00 2B 22 00' + '30 22 00 03 10 2E 22 00 2E 22 00 2E 22 00 2F 22 00 02 10 2E 22 00 2E 22 00 41 22 00 02 00 3C 22' + '00 38 03 00 44 22 00 02 00 43 22 00 38 03 00 47 22 00 02 00 45 22 00 38 03 00 49 22 00 02 00 48' + '22 00 38 03 00 6D 22 00 02 00 4D 22 00 38 03 00 62 22 00 02 00 61 22 00 38 03 00 70 22 00 02 00' + '64 22 00 38 03 00 71 22 00 02 00 65 22 00 38 03 00 74 22 00 02 00 72 22 00 38 03 00 75 22 00 02' + '00 73 22 00 38 03 00 78 22 00 02 00 76 22 00 38 03 00 79 22 00 02 00 77 22 00 38 03 00 80 22 00' + '02 00 7A 22 00 38 03 00 81 22 00 02 00 7B 22 00 38 03 00 E0 22 00 02 00 7C 22 00 38 03 00 E1 22' + '00 02 00 7D 22 00 38 03 00 84 22 00 02 00 82 22 00 38 03 00 85 22 00 02 00 83 22 00 38 03 00 88' + '22 00 02 00 86 22 00 38 03 00 89 22 00 02 00 87 22 00 38 03 00 E2 22 00 02 00 91 22 00 38 03 00' + 'E3 22 00 02 00 92 22 00 38 03 00 AC 22 00 02 00 A2 22 00 38 03 00 AD 22 00 02 00 A8 22 00 38 03' + '00 AE 22 00 02 00 A9 22 00 38 03 00 AF 22 00 02 00 AB 22 00 38 03 00 EA 22 00 02 00 B2 22 00 38' + '03 00 EB 22 00 02 00 B3 22 00 38 03 00 EC 22 00 02 00 B4 22 00 38 03 00 ED 22 00 02 00 B5 22 00' + '38 03 00 E8 FF 00 01 0C 02 25 00 ED FF 00 01 0C A0 25 00 EE FF 00 01 0C CB 25 00 5F FF 00 01 0B' + '85 29 00 60 FF 00 01 0B 86 29 00 6F 2D 00 01 08 61 2D 00 51 FE 00 01 0D 01 30 00 64 FF 00 01 0C' + '01 30 00 11 FE 00 01 0A 01 30 00 61 FF 00 01 0C 02 30 00 12 FE 00 01 0A 02 30 00 3F FE 00 01 0A' + '08 30 00 40 FE 00 01 0A 09 30 00 3D FE 00 01 0A 0A 30 00 3E FE 00 01 0A 0B 30 00 62 FF 00 01 0C' + '0C 30 00 41 FE 00 01 0A 0C 30 00 42 FE 00 01 0A 0D 30 00 63 FF 00 01 0C 0D 30 00 43 FE 00 01 0A' + '0E 30 00 44 FE 00 01 0A 0F 30 00 3B FE 00 01 0A 10 30 00 3C FE 00 01 0A 11 30 00 36 30 00 01 10' + '12 30 00 2A F1 01 03 10 14 30 00 53 00 00 15 30 00 41 F2 01 03 10 14 30 00 09 4E 00 15 30 00 42' + 'F2 01 03 10 14 30 00 8C 4E 00 15 30 00 47 F2 01 03 10 14 30 00 DD 52 00 15 30 00 43 F2 01 03 10' + '14 30 00 89 5B 00 15 30 00 45 F2 01 03 10 14 30 00 53 62 00 15 30 00 48 F2 01 03 10 14 30 00 57' + '65 00 15 30 00 40 F2 01 03 10 14 30 00 2C 67 00 15 30 00 44 F2 01 03 10 14 30 00 B9 70 00 15 30' + '00 46 F2 01 03 10 14 30 00 D7 76 00 15 30 00 39 FE 00 01 0A 14 30 00 5D FE 00 01 0D 14 30 00 3A' + 'FE 00 01 0A 15 30 00 5E FE 00 01 0D 15 30 00 17 FE 00 01 0A 16 30 00 18 FE 00 01 0A 17 30 00 94' + '30 00 02 00 46 30 00 99 30 00 4C 30 00 02 00 4B 30 00 99 30 00 4E 30 00 02 00 4D 30 00 99 30 00' + '50 30 00 02 00 4F 30 00 99 30 00 52 30 00 02 00 51 30 00 99 30 00 54 30 00 02 00 53 30 00 99 30' + '00 56 30 00 02 00 55 30 00 99 30 00 58 30 00 02 00 57 30 00 99 30 00 5A 30 00 02 00 59 30 00 99' + '30 00 5C 30 00 02 00 5B 30 00 99 30 00 5E 30 00 02 00 5D 30 00 99 30 00 60 30 00 02 00 5F 30 00' + '99 30 00 62 30 00 02 00 61 30 00 99 30 00 65 30 00 02 00 64 30 00 99 30 00 67 30 00 02 00 66 30' + '00 99 30 00 69 30 00 02 00 68 30 00 99 30 00 70 30 00 02 00 6F 30 00 99 30 00 71 30 00 02 00 6F' + '30 00 9A 30 00 73 30 00 02 00 72 30 00 99 30 00 74 30 00 02 00 72 30 00 9A 30 00 76 30 00 02 00' + '75 30 00 99 30 00 77 30 00 02 00 75 30 00 9A 30 00 79 30 00 02 00 78 30 00 99 30 00 7A 30 00 02' + '00 78 30 00 9A 30 00 00 F2 01 02 0E 7B 30 00 4B 30 00 7C 30 00 02 00 7B 30 00 99 30 00 7D 30 00' + '02 00 7B 30 00 9A 30 00 9F 30 00 02 0A 88 30 00 8A 30 00 9E FF 00 01 0C 99 30 00 9F FF 00 01 0C' + '9A 30 00 9E 30 00 02 00 9D 30 00 99 30 00 67 FF 00 01 0C A1 30 00 00 33 00 05 0E A2 30 00 CF 30' + '00 9A 30 00 FC 30 00 C8 30 00 01 33 00 04 0E A2 30 00 EB 30 00 D5 30 00 A1 30 00 02 33 00 05 0E' + 'A2 30 00 F3 30 00 D8 30 00 9A 30 00 A2 30 00 03 33 00 03 0E A2 30 00 FC 30 00 EB 30 00 D0 32 00' + '01 07 A2 30 00 71 FF 00 01 0C A2 30 00 68 FF 00 01 0C A3 30 00 04 33 00 05 0E A4 30 00 CB 30 00' + 'F3 30 00 AF 30 00 99 30 00 05 33 00 03 0E A4 30 00 F3 30 00 C1 30 00 72 FF 00 01 0C A4 30 00 D1' + '32 00 01 07 A4 30 00 69 FF 00 01 0C A5 30 00 F4 30 00 02 00 A6 30 00 99 30 00 06 33 00 03 0E A6' + '30 00 A9 30 00 F3 30 00 73 FF 00 01 0C A6 30 00 D2 32 00 01 07 A6 30 00 6A FF 00 01 0C A7 30 00' + '07 33 00 06 0E A8 30 00 B9 30 00 AF 30 00 FC 30 00 C8 30 00 99 30 00 08 33 00 04 0E A8 30 00 FC' + '30 00 AB 30 00 FC 30 00 74 FF 00 01 0C A8 30 00 D3 32 00 01 07 A8 30 00 6B FF 00 01 0C A9 30 00' + '09 33 00 03 0E AA 30 00 F3 30 00 B9 30 00 0A 33 00 03 0E AA 30 00 FC 30 00 E0 30 00 D4 32 00 01' + '07 AA 30 00 75 FF 00 01 0C AA 30 00 0E 33 00 04 0E AB 30 00 99 30 00 ED 30 00 F3 30 00 0F 33 00' + '04 0E AB 30 00 99 30 00 F3 30 00 DE 30 00 AC 30 00 02 00 AB 30 00 99 30 00 0B 33 00 03 0E AB 30' + '00 A4 30 00 EA 30 00 0C 33 00 04 0E AB 30 00 E9 30 00 C3 30 00 C8 30 00 0D 33 00 04 0E AB 30 00' + 'ED 30 00 EA 30 00 FC 30 00 76 FF 00 01 0C AB 30 00 D5 32 00 01 07 AB 30 00 10 33 00 06 0E AD 30' + '00 99 30 00 AD 30 00 99 30 00 AB 30 00 99 30 00 11 33 00 04 0E AD 30 00 99 30 00 CB 30 00 FC 30' + '00 13 33 00 08 0E AD 30 00 99 30 00 EB 30 00 AD 30 00 99 30 00 BF 30 00 99 30 00 FC 30 00 AE 30' + '00 02 00 AD 30 00 99 30 00 12 33 00 04 0E AD 30 00 E5 30 00 EA 30 00 FC 30 00 15 33 00 06 0E AD' + '30 00 ED 30 00 AF 30 00 99 30 00 E9 30 00 E0 30 00 16 33 00 06 0E AD 30 00 ED 30 00 E1 30 00 FC' + '30 00 C8 30 00 EB 30 00 17 33 00 05 0E AD 30 00 ED 30 00 EF 30 00 C3 30 00 C8 30 00 14 33 00 02' + '0E AD 30 00 ED 30 00 77 FF 00 01 0C AD 30 00 D6 32 00 01 07 AD 30 00 19 33 00 06 0E AF 30 00 99' + '30 00 E9 30 00 E0 30 00 C8 30 00 F3 30 00 18 33 00 04 0E AF 30 00 99 30 00 E9 30 00 E0 30 00 B0' + '30 00 02 00 AF 30 00 99 30 00 1A 33 00 06 0E AF 30 00 EB 30 00 BB 30 00 99 30 00 A4 30 00 ED 30' + '00 1B 33 00 04 0E AF 30 00 ED 30 00 FC 30 00 CD 30 00 78 FF 00 01 0C AF 30 00 D7 32 00 01 07 AF' + '30 00 B2 30 00 02 00 B1 30 00 99 30 00 1C 33 00 03 0E B1 30 00 FC 30 00 B9 30 00 D8 32 00 01 07' + 'B1 30 00 79 FF 00 01 0C B1 30 00 B4 30 00 02 00 B3 30 00 99 30 00 01 F2 01 02 0E B3 30 00 B3 30' + '00 FF 30 00 02 0A B3 30 00 C8 30 00 1D 33 00 03 0E B3 30 00 EB 30 00 CA 30 00 1E 33 00 04 0E B3' + '30 00 FC 30 00 DB 30 00 9A 30 00 D9 32 00 01 07 B3 30 00 7A FF 00 01 0C B3 30 00 B6 30 00 02 00' + 'B5 30 00 99 30 00 1F 33 00 04 0E B5 30 00 A4 30 00 AF 30 00 EB 30 00 20 33 00 05 0E B5 30 00 F3' + '30 00 C1 30 00 FC 30 00 E0 30 00 7B FF 00 01 0C B5 30 00 DA 32 00 01 07 B5 30 00 02 F2 01 01 0E' + 'B5 30 00 B8 30 00 02 00 B7 30 00 99 30 00 21 33 00 05 0E B7 30 00 EA 30 00 F3 30 00 AF 30 00 99' + '30 00 DB 32 00 01 07 B7 30 00 7C FF 00 01 0C B7 30 00 BA 30 00 02 00 B9 30 00 99 30 00 7D FF 00' + '01 0C B9 30 00 DC 32 00 01 07 B9 30 00 BC 30 00 02 00 BB 30 00 99 30 00 22 33 00 03 0E BB 30 00' + 'F3 30 00 C1 30 00 23 33 00 03 0E BB 30 00 F3 30 00 C8 30 00 DD 32 00 01 07 BB 30 00 7E FF 00 01' + '0C BB 30 00 BE 30 00 02 00 BD 30 00 99 30 00 7F FF 00 01 0C BD 30 00 DE 32 00 01 07 BD 30 00 24' + '33 00 04 0E BF 30 00 99 30 00 FC 30 00 B9 30 00 C0 30 00 02 00 BF 30 00 99 30 00 DF 32 00 01 07' + 'BF 30 00 80 FF 00 01 0C BF 30 00 C2 30 00 02 00 C1 30 00 99 30 00 81 FF 00 01 0C C1 30 00 E0 32' + '00 01 07 C1 30 00 6F FF 00 01 0C C3 30 00 C5 30 00 02 00 C4 30 00 99 30 00 82 FF 00 01 0C C4 30' + '00 E1 32 00 01 07 C4 30 00 25 33 00 03 0E C6 30 00 99 30 00 B7 30 00 13 F2 01 02 0E C6 30 00 99' + '30 00 C7 30 00 02 00 C6 30 00 99 30 00 83 FF 00 01 0C C6 30 00 E2 32 00 01 07 C6 30 00 26 33 00' + '03 0E C8 30 00 99 30 00 EB 30 00 C9 30 00 02 00 C8 30 00 99 30 00 27 33 00 02 0E C8 30 00 F3 30' + '00 E3 32 00 01 07 C8 30 00 84 FF 00 01 0C C8 30 00 28 33 00 02 0E CA 30 00 CE 30 00 E4 32 00 01' + '07 CA 30 00 85 FF 00 01 0C CA 30 00 E5 32 00 01 07 CB 30 00 86 FF 00 01 0C CB 30 00 E6 32 00 01' + '07 CC 30 00 87 FF 00 01 0C CC 30 00 E7 32 00 01 07 CD 30 00 88 FF 00 01 0C CD 30 00 29 33 00 03' + '0E CE 30 00 C3 30 00 C8 30 00 E8 32 00 01 07 CE 30 00 89 FF 00 01 0C CE 30 00 2D 33 00 05 0E CF' + '30 00 99 30 00 FC 30 00 EC 30 00 EB 30 00 D0 30 00 02 00 CF 30 00 99 30 00 2B 33 00 06 0E CF 30' + '00 9A 30 00 FC 30 00 BB 30 00 F3 30 00 C8 30 00 2C 33 00 04 0E CF 30 00 9A 30 00 FC 30 00 C4 30' + '00 D1 30 00 02 00 CF 30 00 9A 30 00 2A 33 00 03 0E CF 30 00 A4 30 00 C4 30 00 8A FF 00 01 0C CF' + '30 00 E9 32 00 01 07 CF 30 00 31 33 00 03 0E D2 30 00 99 30 00 EB 30 00 D3 30 00 02 00 D2 30 00' + '99 30 00 2E 33 00 06 0E D2 30 00 9A 30 00 A2 30 00 B9 30 00 C8 30 00 EB 30 00 2F 33 00 04 0E D2' + '30 00 9A 30 00 AF 30 00 EB 30 00 30 33 00 03 0E D2 30 00 9A 30 00 B3 30 00 D4 30 00 02 00 D2 30' + '00 9A 30 00 EA 32 00 01 07 D2 30 00 8B FF 00 01 0C D2 30 00 34 33 00 06 0E D5 30 00 99 30 00 C3' + '30 00 B7 30 00 A7 30 00 EB 30 00 D6 30 00 02 00 D5 30 00 99 30 00 D7 30 00 02 00 D5 30 00 9A 30' + '00 32 33 00 06 0E D5 30 00 A1 30 00 E9 30 00 C3 30 00 C8 30 00 99 30 00 33 33 00 04 0E D5 30 00' + 'A3 30 00 FC 30 00 C8 30 00 35 33 00 03 0E D5 30 00 E9 30 00 F3 30 00 8C FF 00 01 0C D5 30 00 EB' + '32 00 01 07 D5 30 00 3C 33 00 04 0E D8 30 00 99 30 00 FC 30 00 BF 30 00 D9 30 00 02 00 D8 30 00' + '99 30 00 37 33 00 03 0E D8 30 00 9A 30 00 BD 30 00 38 33 00 04 0E D8 30 00 9A 30 00 CB 30 00 D2' + '30 00 3A 33 00 04 0E D8 30 00 9A 30 00 F3 30 00 B9 30 00 3B 33 00 07 0E D8 30 00 9A 30 00 FC 30' + '00 D8 30 00 9A 30 00 B7 30 00 99 30 00 DA 30 00 02 00 D8 30 00 9A 30 00 36 33 00 05 0E D8 30 00' + 'AF 30 00 BF 30 00 FC 30 00 EB 30 00 39 33 00 03 0E D8 30 00 EB 30 00 C4 30 00 8D FF 00 01 0C D8' + '30 00 EC 32 00 01 07 D8 30 00 3E 33 00 04 0E DB 30 00 99 30 00 EB 30 00 C8 30 00 DC 30 00 02 00' + 'DB 30 00 99 30 00 3D 33 00 05 0E DB 30 00 9A 30 00 A4 30 00 F3 30 00 C8 30 00 40 33 00 07 0E DB' + '30 00 9A 30 00 F3 30 00 DB 30 00 9A 30 00 C8 30 00 99 30 00 DD 30 00 02 00 DB 30 00 9A 30 00 3F' + '33 00 02 0E DB 30 00 F3 30 00 41 33 00 03 0E DB 30 00 FC 30 00 EB 30 00 42 33 00 03 0E DB 30 00' + 'FC 30 00 F3 30 00 8E FF 00 01 0C DB 30 00 ED 32 00 01 07 DB 30 00 43 33 00 04 0E DE 30 00 A4 30' + '00 AF 30 00 ED 30 00 44 33 00 03 0E DE 30 00 A4 30 00 EB 30 00 45 33 00 03 0E DE 30 00 C3 30 00' + 'CF 30 00 46 33 00 03 0E DE 30 00 EB 30 00 AF 30 00 47 33 00 05 0E DE 30 00 F3 30 00 B7 30 00 E7' + '30 00 F3 30 00 8F FF 00 01 0C DE 30 00 EE 32 00 01 07 DE 30 00 48 33 00 04 0E DF 30 00 AF 30 00' + 'ED 30 00 F3 30 00 4A 33 00 06 0E DF 30 00 EA 30 00 CF 30 00 99 30 00 FC 30 00 EB 30 00 49 33 00' + '02 0E DF 30 00 EA 30 00 EF 32 00 01 07 DF 30 00 90 FF 00 01 0C DF 30 00 F0 32 00 01 07 E0 30 00' + '91 FF 00 01 0C E0 30 00 4C 33 00 05 0E E1 30 00 AB 30 00 99 30 00 C8 30 00 F3 30 00 4B 33 00 03' + '0E E1 30 00 AB 30 00 99 30 00 4D 33 00 04 0E E1 30 00 FC 30 00 C8 30 00 EB 30 00 92 FF 00 01 0C' + 'E1 30 00 F1 32 00 01 07 E1 30 00 F2 32 00 01 07 E2 30 00 93 FF 00 01 0C E2 30 00 6C FF 00 01 0C' + 'E3 30 00 4E 33 00 04 0E E4 30 00 FC 30 00 C8 30 00 99 30 00 4F 33 00 03 0E E4 30 00 FC 30 00 EB' + '30 00 94 FF 00 01 0C E4 30 00 F3 32 00 01 07 E4 30 00 6D FF 00 01 0C E5 30 00 50 33 00 03 0E E6' + '30 00 A2 30 00 F3 30 00 95 FF 00 01 0C E6 30 00 F4 32 00 01 07 E6 30 00 6E FF 00 01 0C E7 30 00' + '96 FF 00 01 0C E8 30 00 F5 32 00 01 07 E8 30 00 F6 32 00 01 07 E9 30 00 97 FF 00 01 0C E9 30 00' + '51 33 00 04 0E EA 30 00 C3 30 00 C8 30 00 EB 30 00 52 33 00 02 0E EA 30 00 E9 30 00 F7 32 00 01' + '07 EA 30 00 98 FF 00 01 0C EA 30 00 53 33 00 04 0E EB 30 00 D2 30 00 9A 30 00 FC 30 00 54 33 00' + '05 0E EB 30 00 FC 30 00 D5 30 00 99 30 00 EB 30 00 F8 32 00 01 07 EB 30 00 99 FF 00 01 0C EB 30' + '00 55 33 00 02 0E EC 30 00 E0 30 00 56 33 00 06 0E EC 30 00 F3 30 00 C8 30 00 B1 30 00 99 30 00' + 'F3 30 00 F9 32 00 01 07 EC 30 00 9A FF 00 01 0C EC 30 00 9B FF 00 01 0C ED 30 00 FA 32 00 01 07' + 'ED 30 00 F7 30 00 02 00 EF 30 00 99 30 00 57 33 00 03 0E EF 30 00 C3 30 00 C8 30 00 FB 32 00 01' + '07 EF 30 00 9C FF 00 01 0C EF 30 00 F8 30 00 02 00 F0 30 00 99 30 00 FC 32 00 01 07 F0 30 00 F9' + '30 00 02 00 F1 30 00 99 30 00 FD 32 00 01 07 F1 30 00 FA 30 00 02 00 F2 30 00 99 30 00 66 FF 00' + '01 0C F2 30 00 FE 32 00 01 07 F2 30 00 9D FF 00 01 0C F3 30 00 65 FF 00 01 0C FB 30 00 70 FF 00' + '01 0C FC 30 00 FE 30 00 02 00 FD 30 00 99 30 00 80 32 00 01 07 00 4E 00 29 F2 01 01 0E 00 4E 00' + '00 2F 00 01 10 00 4E 00 92 31 00 01 08 00 4E 00 9C 31 00 01 08 01 4E 00 86 32 00 01 07 03 4E 00' + '94 31 00 01 08 09 4E 00 82 32 00 01 07 09 4E 00 2A F2 01 01 0E 09 4E 00 96 31 00 01 08 0A 4E 00' + 'A4 32 00 01 07 0A 4E 00 A6 32 00 01 07 0B 4E 00 98 31 00 01 08 0B 4E 00 9B 31 00 01 08 19 4E 00' + '01 2F 00 01 10 28 4E 00 A5 32 00 01 07 2D 4E 00 2D F2 01 01 0E 2D 4E 00 97 31 00 01 08 2D 4E 00' + '02 2F 00 01 10 36 4E 00 03 2F 00 01 10 3F 4E 00 9A 31 00 01 08 59 4E 00 04 2F 00 01 10 59 4E 00' + '88 32 00 01 07 5D 4E 00 05 2F 00 01 10 85 4E 00 93 31 00 01 08 8C 4E 00 06 2F 00 01 10 8C 4E 00' + '14 F2 01 01 0E 8C 4E 00 81 32 00 01 07 8C 4E 00 84 32 00 01 07 94 4E 00 07 2F 00 01 10 A0 4E 00' + '18 F2 01 01 0E A4 4E 00 08 2F 00 01 10 BA 4E 00 9F 31 00 01 08 BA 4E 00 FF 32 00 02 0E E4 4E 00' + '8C 54 00 AD 32 00 01 07 01 4F 00 A1 32 00 01 07 11 4F 00 9D 32 00 01 07 2A 51 00 09 2F 00 01 10' + '3F 51 00 0A 2F 00 01 10 65 51 00 87 32 00 01 07 6B 51 00 0B 2F 00 01 10 6B 51 00 85 32 00 01 07' + '6D 51 00 0C 2F 00 01 10 82 51 00 1E F2 01 01 0E 8D 51 00 0D 2F 00 01 10 96 51 00 A2 32 00 01 07' + '99 51 00 0E 2F 00 01 10 AB 51 00 0F 2F 00 01 10 E0 51 00 10 2F 00 01 10 F5 51 00 11 2F 00 01 10' + '00 52 00 20 F2 01 01 0E 1D 52 00 1C F2 01 01 0E 4D 52 00 39 F2 01 01 0E 72 52 00 12 2F 00 01 10' + '9B 52 00 98 32 00 01 07 B4 52 00 13 2F 00 01 10 F9 52 00 14 2F 00 01 10 15 53 00 15 2F 00 01 10' + '1A 53 00 16 2F 00 01 10 38 53 00 A9 32 00 01 07 3B 53 00 89 32 00 01 07 41 53 00 38 30 00 01 10' + '41 53 00 17 2F 00 01 10 41 53 00 39 30 00 01 10 44 53 00 3A 30 00 01 10 45 53 00 AF 32 00 01 07' + '54 53 00 18 2F 00 01 10 5C 53 00 19 2F 00 01 10 69 53 00 9E 32 00 01 07 70 53 00 1A 2F 00 01 10' + '82 53 00 1B 2F 00 01 10 B6 53 00 1C 2F 00 01 10 C8 53 00 12 F2 01 01 0E CC 53 00 1D 2F 00 01 10' + 'E3 53 00 51 F2 01 01 07 EF 53 00 2E F2 01 01 0E F3 53 00 A8 32 00 01 07 F3 53 00 34 F2 01 01 0E' + '08 54 00 94 32 00 01 07 0D 54 00 25 F2 01 01 0E 39 54 00 44 32 00 01 07 4F 55 00 3A F2 01 01 0E' + 'B6 55 00 1E 2F 00 01 10 D7 56 00 83 32 00 01 07 DB 56 00 95 31 00 01 08 DB 56 00 8F 32 00 01 07' + '1F 57 00 1F 2F 00 01 10 1F 57 00 9E 31 00 01 08 30 57 00 20 2F 00 01 10 EB 58 00 24 F2 01 01 0E' + 'F0 58 00 21 2F 00 01 10 02 59 00 22 2F 00 01 10 0A 59 00 23 2F 00 01 10 15 59 00 15 F2 01 01 0E' + '1A 59 00 B0 32 00 01 07 1C 59 00 7D 33 00 02 0E 27 59 00 63 6B 00 24 2F 00 01 10 27 59 00 17 F2' + '01 01 0E 29 59 00 9D 31 00 01 08 29 59 00 25 2F 00 01 10 73 59 00 9B 32 00 01 07 73 59 00 26 2F' + '00 01 10 50 5B 00 11 F2 01 01 0E 57 5B 00 AB 32 00 01 07 66 5B 00 27 2F 00 01 10 80 5B 00 AA 32' + '00 01 07 97 5B 00 28 2F 00 01 10 F8 5B 00 29 2F 00 01 10 0F 5C 00 2A 2F 00 01 10 22 5C 00 2B 2F' + '00 01 10 38 5C 00 2C 2F 00 01 10 6E 5C 00 2D 2F 00 01 10 71 5C 00 2E 2F 00 01 10 DB 5D 00 2F 2F' + '00 01 10 E5 5D 00 2C F2 01 01 0E E6 5D 00 A7 32 00 01 07 E6 5D 00 30 2F 00 01 10 F1 5D 00 31 2F' + '00 01 10 FE 5D 00 32 2F 00 01 10 72 5E 00 7B 33 00 02 0E 73 5E 00 10 62 00 33 2F 00 01 10 7A 5E' + '00 45 32 00 01 07 7C 5E 00 34 2F 00 01 10 7F 5E 00 35 2F 00 01 10 F4 5E 00 36 2F 00 01 10 FE 5E' + '00 37 2F 00 01 10 0B 5F 00 38 2F 00 01 10 13 5F 00 39 2F 00 01 10 50 5F 00 3A 2F 00 01 10 61 5F' + '00 3B 2F 00 01 10 73 5F 00 1D F2 01 01 0E 8C 5F 00 50 F2 01 01 07 97 5F 00 3C 2F 00 01 10 C3 5F' + '00 3D 2F 00 01 10 08 62 00 3E 2F 00 01 10 36 62 00 3F 2F 00 01 10 4B 62 00 10 F2 01 01 0E 4B 62' + '00 31 F2 01 01 0E 53 62 00 27 F2 01 01 0E 95 62 00 2F F2 01 01 0E 07 63 00 28 F2 01 01 0E 55 63' + '00 40 2F 00 01 10 2F 65 00 41 2F 00 01 10 34 65 00 42 2F 00 01 10 87 65 00 46 32 00 01 07 87 65' + '00 43 2F 00 01 10 97 65 00 1B F2 01 01 0E 99 65 00 44 2F 00 01 10 A4 65 00 1F F2 01 01 0E B0 65' + '00 45 2F 00 01 10 B9 65 00 46 2F 00 01 10 E0 65 00 90 32 00 01 07 E5 65 00 47 2F 00 01 10 E5 65' + '00 7E 33 00 02 0E 0E 66 00 BB 6C 00 19 F2 01 01 0E 20 66 00 7C 33 00 02 0E 2D 66 00 8C 54 00 48' + '2F 00 01 10 F0 66 00 8A 32 00 01 07 08 67 00 49 2F 00 01 10 08 67 00 37 F2 01 01 0E 08 67 00 36' + 'F2 01 01 0E 09 67 00 92 32 00 01 07 09 67 00 8D 32 00 01 07 28 67 00 4A 2F 00 01 10 28 67 00 7F' + '33 00 04 0E 2A 68 00 0F 5F 00 1A 4F 00 3E 79 00 91 32 00 01 07 2A 68 00 4B 2F 00 01 10 20 6B 00' + '4C 2F 00 01 10 62 6B 00 A3 32 00 01 07 63 6B 00 4D 2F 00 01 10 79 6B 00 4E 2F 00 01 10 B3 6B 00' + '4F 2F 00 01 10 CB 6B 00 9F 2E 00 01 10 CD 6B 00 50 2F 00 01 10 D4 6B 00 51 2F 00 01 10 DB 6B 00' + '52 2F 00 01 10 0F 6C 00 53 2F 00 01 10 14 6C 00 54 2F 00 01 10 34 6C 00 8C 32 00 01 07 34 6C 00' + '9F 32 00 01 07 E8 6C 00 35 F2 01 01 0E 80 6E 00 26 F2 01 01 0E 14 6F 00 55 2F 00 01 10 6B 70 00' + '8B 32 00 01 07 6B 70 00 1A F2 01 01 0E 21 71 00 56 2F 00 01 10 2A 72 00 57 2F 00 01 10 36 72 00' + '58 2F 00 01 10 3B 72 00 59 2F 00 01 10 3F 72 00 5A 2F 00 01 10 47 72 00 5B 2F 00 01 10 59 72 00' + '5C 2F 00 01 10 5B 72 00 95 32 00 01 07 79 72 00 5D 2F 00 01 10 AC 72 00 5E 2F 00 01 10 84 73 00' + '5F 2F 00 01 10 89 73 00 60 2F 00 01 10 DC 74 00 61 2F 00 01 10 E6 74 00 62 2F 00 01 10 18 75 00' + '22 F2 01 01 0E 1F 75 00 63 2F 00 01 10 1F 75 00 64 2F 00 01 10 28 75 00 65 2F 00 01 10 30 75 00' + '99 31 00 01 08 32 75 00 38 F2 01 01 0E 33 75 00 9A 32 00 01 07 37 75 00 66 2F 00 01 10 8B 75 00' + '67 2F 00 01 10 92 75 00 68 2F 00 01 10 76 76 00 69 2F 00 01 10 7D 76 00 6A 2F 00 01 10 AE 76 00' + '6B 2F 00 01 10 BF 76 00 AC 32 00 01 07 E3 76 00 6C 2F 00 01 10 EE 76 00 6D 2F 00 01 10 DB 77 00' + '6E 2F 00 01 10 E2 77 00 6F 2F 00 01 10 F3 77 00 70 2F 00 01 10 3A 79 00 93 32 00 01 07 3E 79 00' + '97 32 00 01 07 5D 79 00 32 F2 01 01 0E 81 79 00 71 2F 00 01 10 B8 79 00 72 2F 00 01 10 BE 79 00' + '99 32 00 01 07 D8 79 00 73 2F 00 01 10 74 7A 00 33 F2 01 01 0E 7A 7A 00 74 2F 00 01 10 CB 7A 00' + '75 2F 00 01 10 F9 7A 00 47 32 00 01 07 8F 7B 00 76 2F 00 01 10 73 7C 00 77 2F 00 01 10 F8 7C 00' + '21 F2 01 01 0E 42 7D 00 78 2F 00 01 10 36 7F 00 79 2F 00 01 10 51 7F 00 7A 2F 00 01 10 8A 7F 00' + '7B 2F 00 01 10 BD 7F 00 7C 2F 00 01 10 01 80 00 7D 2F 00 01 10 0C 80 00 7E 2F 00 01 10 12 80 00' + '7F 2F 00 01 10 33 80 00 80 2F 00 01 10 7F 80 00 81 2F 00 01 10 89 80 00 82 2F 00 01 10 E3 81 00' + '83 2F 00 01 10 EA 81 00 84 2F 00 01 10 F3 81 00 85 2F 00 01 10 FC 81 00 86 2F 00 01 10 0C 82 00' + '87 2F 00 01 10 1B 82 00 88 2F 00 01 10 1F 82 00 89 2F 00 01 10 6E 82 00 8A 2F 00 01 10 72 82 00' + '8B 2F 00 01 10 78 82 00 8C 2F 00 01 10 4D 86 00 8D 2F 00 01 10 6B 86 00 8E 2F 00 01 10 40 88 00' + '8F 2F 00 01 10 4C 88 00 90 2F 00 01 10 63 88 00 91 2F 00 01 10 7E 89 00 92 2F 00 01 10 8B 89 00' + '93 2F 00 01 10 D2 89 00 16 F2 01 01 0E E3 89 00 94 2F 00 01 10 00 8A 00 95 2F 00 01 10 37 8C 00' + '96 2F 00 01 10 46 8C 00 97 2F 00 01 10 55 8C 00 98 2F 00 01 10 78 8C 00 99 2F 00 01 10 9D 8C 00' + '96 32 00 01 07 A1 8C 00 23 F2 01 01 0E A9 8C 00 AE 32 00 01 07 C7 8C 00 9A 2F 00 01 10 64 8D 00' + '9B 2F 00 01 10 70 8D 00 30 F2 01 01 0E 70 8D 00 9C 2F 00 01 10 B3 8D 00 9D 2F 00 01 10 AB 8E 00' + '9E 2F 00 01 10 CA 8E 00 9F 2F 00 01 10 9B 8F 00 A0 2F 00 01 10 B0 8F 00 A1 2F 00 01 10 B5 8F 00' + '2B F2 01 01 0E 4A 90 00 9C 32 00 01 07 69 90 00 A2 2F 00 01 10 91 90 00 A3 2F 00 01 10 49 91 00' + '3B F2 01 01 0E 4D 91 00 A4 2F 00 01 10 C6 91 00 A5 2F 00 01 10 CC 91 00 8E 32 00 01 07 D1 91 00' + 'A6 2F 00 01 10 D1 91 00 A7 2F 00 01 10 77 95 00 A8 2F 00 01 10 80 95 00 A9 2F 00 01 10 1C 96 00' + 'AA 2F 00 01 10 B6 96 00 AB 2F 00 01 10 B9 96 00 AC 2F 00 01 10 E8 96 00 AD 2F 00 01 10 51 97 00' + 'AE 2F 00 01 10 5E 97 00 AF 2F 00 01 10 62 97 00 B0 2F 00 01 10 69 97 00 B1 2F 00 01 10 CB 97 00' + 'B2 2F 00 01 10 ED 97 00 B3 2F 00 01 10 F3 97 00 B4 2F 00 01 10 01 98 00 A0 32 00 01 07 05 98 00' + 'B5 2F 00 01 10 A8 98 00 B6 2F 00 01 10 DB 98 00 B7 2F 00 01 10 DF 98 00 B8 2F 00 01 10 96 99 00' + 'B9 2F 00 01 10 99 99 00 BA 2F 00 01 10 AC 99 00 BB 2F 00 01 10 A8 9A 00 BC 2F 00 01 10 D8 9A 00' + 'BD 2F 00 01 10 DF 9A 00 BE 2F 00 01 10 25 9B 00 BF 2F 00 01 10 2F 9B 00 C0 2F 00 01 10 32 9B 00' + 'C1 2F 00 01 10 3C 9B 00 C2 2F 00 01 10 5A 9B 00 C3 2F 00 01 10 E5 9C 00 C4 2F 00 01 10 75 9E 00' + 'C5 2F 00 01 10 7F 9E 00 C6 2F 00 01 10 A5 9E 00 C7 2F 00 01 10 BB 9E 00 C8 2F 00 01 10 C3 9E 00' + 'C9 2F 00 01 10 CD 9E 00 CA 2F 00 01 10 D1 9E 00 CB 2F 00 01 10 F9 9E 00 CC 2F 00 01 10 FD 9E 00' + 'CD 2F 00 01 10 0E 9F 00 CE 2F 00 01 10 13 9F 00 CF 2F 00 01 10 20 9F 00 D0 2F 00 01 10 3B 9F 00' + 'D1 2F 00 01 10 4A 9F 00 D2 2F 00 01 10 52 9F 00 D3 2F 00 01 10 8D 9F 00 D4 2F 00 01 10 9C 9F 00' + 'F3 2E 00 01 10 9F 9F 00 D5 2F 00 01 10 A0 9F 00 5C AB 00 01 08 27 A7 00 70 A7 00 01 08 6F A7 00' + '5D AB 00 01 08 37 AB 00 5F AB 00 01 08 52 AB 00 9A 10 01 02 00 99 10 01 BA 10 01 9C 10 01 02 00' + '9B 10 01 BA 10 01 AB 10 01 02 00 A5 10 01 BA 10 01 2E 11 01 02 00 31 11 01 27 11 01 2F 11 01 02' + '00 32 11 01 27 11 01 4B 13 01 02 00 47 13 01 3E 13 01 4C 13 01 02 00 47 13 01 57 13 01 BC 14 01' + '02 00 B9 14 01 B0 14 01 BB 14 01 02 00 B9 14 01 BA 14 01 BE 14 01 02 00 B9 14 01 BD 14 01 BA 15' + '01 02 00 B8 15 01 AF 15 01 BB 15 01 02 00 B9 15 01 AF 15 01 38 19 01 02 00 35 19 01 30 19 01' +} diff --git a/3rdParty/JCL/source/common/JclUnicodeBzip2.rc b/3rdParty/JCL/source/common/JclUnicodeBzip2.rc index a3e356a5..2436452a 100644 --- a/3rdParty/JCL/source/common/JclUnicodeBzip2.rc +++ b/3rdParty/JCL/source/common/JclUnicodeBzip2.rc @@ -1,2717 +1,2717 @@ -/**************************************************************************************************** - - - ..\..\jcl\source\common\JclUnicodeBzip2.rc - - - Produced by UDExtract written by Dipl. Ing. Mike Lischke, public@lischke-online.de - - -****************************************************************************************************/ - - -LANGUAGE 0,0 CATEGORIES UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE -{ - '42 5A 68 39 31 41 59 26 53 59 D6 39 5D 66 00 0B 86 FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF' - 'FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF E0 48 6B A8 6A AF 8E 3C A8 22 84 8A 8A' - '22 A0 01 10 80 82 04 08 A8 80 90 14 05 01 09 21 40 55 14 22 A8 0F 1E 00 6E 01 40 0A 28 14 E8 25' - '2A 35 C3 DF 6F A3 A0 C8 3A 35 D9 2C AB A3 BB 14 49 D6 73 36 9A 1B B2 C6 E6 CF A5 9B B0 6A A2 4D' - '55 00 19 BD C0 D0 01 76 A3 A1 9B 02 49 CC 5A D8 00 00 00 1D 74 00 00 1C 00 69 E9 EB AF 50 00 1C' - 'EB 4E 5B 40 74 E4 68 34 EB 56 3A 96 B0 6A 6D 48 82 68 26 26 9A 09 82 69 93 4D 3D 4C 4C 4C D0 13' - '26 06 82 1E 8C 8D 03 53 D2 A7 E9 80 13 D2 60 99 31 A6 80 F4 9A 6A 9E 08 C9 80 11 B4 26 1A 06 82' - '66 46 86 88 D3 46 1A 19 1A 11 E8 34 8D A3 46 A7 A6 64 D2 1A A8 24 A4 91 34 64 F3 18 4D 00 40 4D' - '06 89 84 D1 34 CA 4F D1 4D 1A 68 69 EA 00 00 00 00 F5 00 34 1A 0D A8 F4 40 7A 80 1A 00 00 00 D0' - '00 00 00 00 00 68 00 0D 03 40 D0 04 95 20 D1 98 04 4D 01 34 D3 40 08 69 A1 3D 04 68 99 1A 9E 90' - '00 C8 03 40 19 00 00 00 00 34 03 40 00 00 00 00 00 00 00 00 00 00 00 03 08 00 92 12 12 34 68 20' - '10 3D 11 E8 13 06 93 4D 27 E8 D4 A7 ED 27 9A 09 A9 E8 98 C9 29 BD A9 95 3F D0 68 2A 7F 94 44 D8' - '32 93 26 7A 93 D3 18 8D 1A A6 8D 0F D5 0D EA 7A A3 D4 3F 53 D4 4F 28 6F 52 7E 7A A5 1E A6 80 F5' - '3F 52 69 91 EA 37 A9 1E A3 C9 1E A3 4F 53 F5 40 69 A7 EA 87 EA 6A 7A 65 01 0A 94 4D 08 D1 28 F6' - 'A6 A7 E2 A3 F5 3C 4A 6F 4A 33 6A 69 31 E9 A6 A9 8D 47 A3 D2 87 B4 44 F2 9E D5 3D 43 D2 7A 4D B4' - 'A6 87 A6 44 D9 4F 53 D4 07 EA 9B 19 53 D4 F5 01 ED 23 D5 1F AA 06 9F A4 43 C9 3D 11 BD 49 E9 A9' - '9E A9 EA 68 1E A7 E8 69 4F 49 EA 6F 54 34 3F 4A 36 A6 86 83 D4 7A 9E 93 64 9E A3 D4 7A 08 24 94' - '0A 68 02 69 A6 89 98 46 86 9E A0 D3 53 4D 1A 6D 49 BD 1A 6A 6D 43 D4 F5 1E A6 6A 9B 29 B2 26 C1' - '4D E9 1E 83 21 B4 10 8D 0D A6 A9 EA 7E A8 7A 6A 78 D0 A0 F6 94 F4 3D 46 93 D4 FD 26 9A 9F A9 B5' - '32 99 3D 32 6A 36 6A 9F 95 3D 23 66 89 A9 A7 A4 7A 35 33 53 C8 9A 62 03 34 F5 46 AD 5F 58 68 D1' - '68 D1 43 BD 50 A2 AA 76 BB BD FB 02 0A E6 E1 FA 01 0B 67 A7 8F EF F8 F8 7E 4F 1B DD AC 7B 9E DC' - '46 61 F6 21 2B 57 C3 D7 66 E3 E4 2F 7F AD 67 AD FF C7 9F 47 A5 ED 79 9B D7 E3 5D 0C C9 76 D1 F7' - 'BC 9B CC F5 DF 65 EB 76 1F EC 77 49 DA 81 92 8D 92 62 66 F8 EB FF 9A 24 E3 83 2B 59 AC 2D 64 99' - 'B2 CB 39 EE C1 6C CA A3 E6 21 8A 8D E7 91 35 B4 E4 EA CF CF EB 5D CF CB F3 52 1D 2C 77 5A 8C 5B' - '4B 37 FD C8 B9 79 E3 DC CE 33 BA BC 45 D8 FC 6C C9 9E 29 8F BE AA F0 37 A5 1E 6B 90 CB A3 8A 09' - 'F5 CA 56 63 40 5D 8D 5F 32 78 D7 B3 B3 5E 5E 0C 4A F5 9A FA 63 4F 7F 17 F2 20 C0 92 B7 6C 19 E7' - '5B 02 87 B1 69 B0 94 A5 29 98 EE D4 C5 AC 3C CC 61 93 3C F3 48 99 91 F1 32 C6 CA 60 EF 13 EC D6' - 'D6 24 C1 2A 18 DB F9 96 EE 5A 69 79 39 AB CB 46 D9 B6 05 83 6E 4E 15 38 8B 3D C9 DC 0F 8E 36 FC' - '19 CA 76 3D 8F 86 77 83 37 88 E4 BC 55 49 47 09 59 C3 A8 E1 AA 92 EF 0E 1D 9F C1 24 8E 26 3C 1A' - '1B 6A 75 02 1E C4 0E 9E B2 CB 20 85 91 A8 E8 55 ED 10 9F 30 7F 96 FB AC C3 E0 B6 21 67 5B CC 2E' - '2F 95 4E 57 19 C4 5B E8 16 26 EF 6F 96 C9 B6 AB 31 A1 FD 61 EE F5 DD 02 B5 87 A3 42 FD 7B A8 56' - '16 E7 80 A6 97 EC 33 42 E5 D7 5A 7A 41 32 DA CB 03 44 48 92 81 41 2C 8A AD A9 AC 1D 6D AB 41 2E' - '1C 3E 8E 52 D0 58 0D 75 32 5C E7 B6 5B A7 B8 BB 53 79 80 8A C8 29 F2 0D 8E 60 6D 57 9F F7 B4 94' - 'C8 88 1E 78 B2 E1 78 A7 EF 9B EC B5 91 49 E8 6D 8A EC 2C 58 A7 04 D3 15 DE 99 2A 0E E2 CA 1D BA' - '57 26 CD FF 56 DF C7 4D EA EC C4 DE 3D A8 ED 3E 8A BF F4 AF E8 20 6C 67 A7 AA B9 C6 67 D2 81 3C' - 'D5 73 48 95 66 FF EB AA E8 0F CA F5 2C 27 5C ED 32 77 AB 57 E3 5E E2 9A 46 28 6D 2B 4F 93 2C 38' - 'D9 AB 03 55 E3 AF 22 04 C4 41 44 0A F8 B7 DD D5 95 D9 AA B4 F2 AC 5A 40 D3 E8 96 6D 54 AB 35 9C' - '55 2A D1 48 E8 56 0A 88 ED 17 A8 AC 02 60 62 28 BF 93 04 B9 62 F6 BA 61 58 9A D9 61 FF 04 A8 98' - '4E 4B 57 0D 9E 33 86 68 84 89 3B E8 E5 F5 17 D2 19 28 3C D7 D8 6A 50 38 02 0B 50 7C 7C 79 7D EE' - 'A2 95 F0 75 53 49 5D 24 69 85 23 18 52 44 8B CD 9E 84 68 D1 BF 18 4E 71 B4 96 69 89 91 31 31 E5' - 'AB 0B 6D 91 8E 63 2D 2B 1E E1 DE F3 67 A0 CD 42 3C AF 72 8A 2E 22 44 22 88 91 5E 89 87 96 E3 D1' - '5E F1 E7 6E 79 B1 CD AE 73 C0 BB E0 EE B2 71 B6 E3 84 71 97 8A D9 AE 6E 5B 52 EF EE 5E B1 38 8A' - '8C 55 14 44 81 7E 07 23 A1 98 8A 71 C9 29 5E BF 46 62 54 72 5E 39 14 E0 13 53 26 10 4F 1A 9A 3D' - 'EF 43 BD 0E 75 08 28 18 60 88 10 2D 32 F2 2B 9C A0 3C 6A E3 82 79 54 02 62 A4 E4 E1 C8 71 BC E1' - 'CC 61 B7 B2 52 72 59 43 21 90 F4 30 0B 88 8C 08 A2 11 35 49 61 92 CA 73 AE 75 CE B7 69 D1 7B 2A' - 'D0 66 28 C2 FD 66 53 47 BF 71 56 15 8C F7 DF 25 9A 8B 4B 2D 60 64 4A D4 CB 4B 0B 11 64 76 F0 22' - '50 61 16 83 86 AF 1E 79 D8 C5 BC 7C 13 44 DC 4C CA E1 CC C1 60 BA F7 A7 9D 8E 89 30 28 3B 3A 32' - '2F 0F 5F 25 34 F1 F9 3E 37 44 F6 58 79 38 F6 B5 7C 31 E0 3E 17 AC CC 80 DC BC AB 0F 3B DF 90 54' - '06 41 8C 54 9E 7B 31 50 6B 0E 75 CC AF 25 CD 3A 2F ED 56 B6 07 86 75 C2 38 91 39 8C 13 86 83 5A' - '35 35 70 2E 05 E8 D7 0F 0B 22 47 11 92 48 3C 78 F3 6D 59 E7 49 24 E8 92 08 81 02 04 09 89 8A 91' - 'CB 33 34 EB 68 4A A4 3C 4F 1E 38 CA B2 AE 83 CE AF 05 1D 04 C9 4C 99 18 10 44 08 1B 8B 71 3C C8' - 'D1 A2 63 19 DF 0C C8 72 1C 38 61 BA D1 A3 41 B9 B3 3C 3B 90 70 E1 C6 6D F8 5C 9E B7 7A 68 CB 24' - 'A5 02 C8 DE 28 8C 51 12 24 4F 20 79 E1 F1 DE F4 FE 97 90 87 95 BC B9 34 A9 A2 63 4A 7B 14 9E 8C' - '71 3A 9E B6 E2 68 D3 5D E1 AD AD 4D 43 53 4A B7 7B E5 EA C6 97 06 EC C5 1C B7 AD 55 4C 8C 71 28' - '91 37 3B C4 CD 06 71 EA 59 E6 32 44 82 52 28 8A 34 2A 49 25 22 07 29 1C B4 12 22 40 F8 E8 E9 F2' - 'A2 48 88 44 22 44 A2 24 51 01 F6 50 40 7B 46 83 53 46 21 A5 C3 87 61 A0 2B 2B 3B 1E 0F 0B 90 EF' - '8C 7A AD 3D 0F 1C 34 D4 0E 59 C3 23 41 A9 B8 78 B6 21 C8 70 E4 E2 65 14 19 03 21 12 B2 05 85 91' - '8F A4 9D 84 F3 E9 4C 20 9C 9C 39 38 72 B1 CE 1C A1 11 AD 34 6A 69 3A 9D 13 88 DD 9D 4E 4E B4 F1' - '06 70 B1 CE 2D 0D DB 5F 0E 2A 02 80 B2 C5 C3 4D AA A3 7E BD 45 85 89 16 16 1A 4B 8B 0D D9 93 57' - '45 40 6D E7 B9 38 70 E5 9D E6 5C B1 CB 1D C7 51 E4 7A 39 10 50 20 40 E0 37 65 A2 64 C8 C6 11 BA' - '51 89 74 91 22 44 83 A0 81 4C 00 C8 19 88 90 1E 3D E1 8D E9 E3 C7 8E 1C 19 3C E0 E1 C3 BC D8 FD' - '30 1E 3D 3C E1 8F 0F 6B 41 33 04 C5 00 B4 91 85 03 87 0E 59 53 B0 72 70 E1 C5 24 F3 9A 1A A7 0A' - '45 31 31 32 25 CB 01 41 40 8C 48 87 69 76 97 71 61 B2 C2 CB 1B 41 62 57 58 58 78 28 F3 0C AB 84' - 'A9 2B 47 8F 1E 5D EB 17 B8 70 DD D6 0D 43 64 BA 45 70 F0 CE B8 34 D0 67 30 ED EE C4 C8 A2 44 89' - '82 C1 60 BB BA 62 51 BA C5 15 14 51 A5 94 51 41 45 0F 37 90 F1 E3 CC F6 16 06 FF 07 76 04 37 99' - '64 0E 8C 1F A9 90 5C 0B B0 03 87 0E 34 DA 34 E8 70 D1 BB B7 3B 21 C3 B4 06 43 20 F3 B9 0C 39 9B' - '96 81 D8 28 70 3A EE B6 C1 71 48 DD A9 04 89 12 1E F1 F4 D0 9F 45 00 EA CD 9A D9 B6 68 51 9B 14' - 'C5 93 9C 7C 6B AD 5C A0 3D 8C 1E 59 0E A9 24 B4 A0 E4 98 E4 62 54 A2 D8 D0 59 4B 43 99 53 49 4A' - 'A5 91 51 48 C9 11 44 A2 03 B0 24 39 17 22 C5 D2 69 E0 0C F6 96 F3 4A 5D 75 D9 ED 36 AE 19 7D E2' - 'E4 B8 B6 E2 FC E7 89 94 26 C0 C0 CE B9 CE 62 D2 D0 CC 6A 34 99 0E 3C 8B 84 A2 89 D9 7F 84 94 94' - '8D AB 6A 89 18 91 22 55 07 8F B5 C3 8B 1E 0F 56 41 72 C2 07 31 CB 22 57 2D BC C5 FB 0B 0B D7 05' - '84 C8 10 50 7F 6E 82 04 0A D4 0D F1 E3 CB 9E 64 59 13 C3 AA 14 0C 7D D4 22 04 0C 17 B2 66 89 A1' - '48 D9 39 A9 93 44 E1 63 51 34 19 2A 9C 9E 13 D5 9D A0 D1 AD 5C E0 E1 C7 3F 1F 1C 90 44 07 38 71' - 'C5 6C E7 32 64 C8 91 CA 9E 0F 16 C4 E1 CE B8 68 49 C6 0D 0F C8 10 36 04 56 F7 5C E5 29 34 10 59' - 'D7 4A 88 44 8E 5A 47 06 8A 42 06 5B 29 29 08 91 44 48 BD 68 34 AD B7 3E 47 99 79 5E 3D 0E 1A DB' - 'D3 86 97 9D 94 E1 D2 39 0E 9F 13 5A A9 4E 41 98 70 E7 28 B9 C3 87 0E 4B 22 70 E1 D6 B0 B4 63 15' - 'AC 62 A0 81 01 E3 E9 81 0C 43 20 B5 41 10 50 32 85 0A 85 02 1B B0 82 7A A9 10 50 08 40 1E 76 07' - '56 D4 D1 A9 A3 45 4A 70 E7 21 C5 20 F9 18 0F 4F 07 8F 37 9C 38 1C EA 1E F1 E0 76 F1 71 B2 F8 9D' - '91 9D 69 08 A2 24 79 B7 E8 0C AA 04 15 C5 06 AD EA 15 ED 50 20 48 C6 B1 C3 99 D7 4E 5C EF 38 D9' - '03 05 79 81 10 C3 03 7A A2 A3 52 EA D5 BE C5 A4 B4 B7 4A B9 8C 5C 8B B8 60 59 D1 5A CA 69 5C 8B' - '30 65 37 11 40 65 30 36 65 C3 0C 30 30 DD A9 54 52 71 94 06 95 D1 18 90 08 1B 7B D8 98 F1 E4 EB' - '09 49 4A CE 5E 99 93 66 26 2B 27 3C E4 AA 5A F4 93 69 61 3A 27 31 9C B3 CD 31 31 30 40 27 27 9D' - '13 58 AC 0B 16 FB 43 50 E4 E1 D8 30 D2 60 56 F1 E3 C7 83 D0 E2 BC D0 3B 2D 9C 27 9C D4 1B 68 9D' - '1D CA DA 34 69 37 14 A4 E4 F4 AA 43 93 53 D4 6B A2 07 0C 14 30 7B C7 9C A5 81 41 AA 04 0D 4B 28' - '50 FD 29 A4 83 61 AA 5E 21 32 64 C9 04 62 67 90 48 5A 42 61 D0 7A 49 9B C1 66 F4 A4 48 8A D9 25' - '2A 28 24 5C 9F D9 4F 1C B5 23 31 A9 E3 C7 B8 71 C2 6D 57 2B 95 14 46 54 78 AA 24 17 42 84 08 0F' - '1E 6D E9 89 A9 6A 46 53 8D 3C 78 D1 A7 10 E4 E2 69 8C 0B 6D 0C FC 98 CA F2 57 A3 41 C6 6E 0D 1A' - '35 5C E1 C5 C9 E0 F0 78 9E 9E 0F 2E 2E 57 AE 9A 4D 01 55 45 34 F7 62 44 88 A3 9C 29 29 51 4F 4F' - '53 19 15 75 98 CC 66 E9 BB BD B3 B2 53 8C 31 97 E6 A6 99 C9 D5 03 4E 66 6A 1C 38 E2 A0 80 E3 AB' - '13 D3 9B 72 77 73 49 07 98 06 14 16 8F 07 8F 2E 38 FA B9 83 B0 FC CC A5 62 A6 9A 4D 42 E8 1C 75' - 'AF 9E 72 72 6C 66 33 97 88 60 C3 B4 D3 9B AD 94 70 E1 DD CA 1F 92 81 40 B4 7A 78 E4 56 56 55 5D' - '0B 1A C9 93 79 6B AC AC 80 C1 83 C5 59 5D 7C 6B 6B 01 83 0B 18 30 60 C1 92 EB AE 9E B8 3D 4A 07' - '0A 89 12 64 08 10 20 40 81 A0 B0 80 0F 16 82 03 C1 E6 D0 C8 75 44 89 15 12 31 23 BC 49 5A 10 B4' - '51 88 FB 48 10 20 40 BA 31 BC A3 1D 81 CF 13 8B 8A 25 C0 40 81 C2 A2 A5 D6 26 4E E4 FC B0 32 AF' - '02 CC A5 21 A4 48 9B 62 6B 24 04 8B 8B A4 17 0D 2E 01 A3 55 CE 70 E4 9C 38 CE E5 AC 37 07 12 1C' - '38 D8 F2 F1 43 87 0E 13 8D 0D 0C C6 65 41 9B 15 B0 2D 02 03 C8 0F 31 09 E9 3C B2 E0 1E 06 12 95' - '29 65 30 5D D5 12 72 72 64 4C 4C 4C 4D 86 05 F4 A6 D5 48 D1 A5 28 70 B8 4C EC D6 3C 79 60 5C B0' - '0D 34 94 85 29 52 52 53 4E D5 FC EC D2 B0 3B 79 D4 95 EB 59 D5 B6 96 DA 63 EA B6 E5 DB 24 EA EE' - 'F7 0D 61 AC D0 68 34 1A 34 68 CF 9C 27 0C E6 73 59 AC CA 6B 30 0B 91 CF 71 6C 07 0E 39 A7 53 8A' - '63 86 72 72 72 72 72 75 9D A6 E7 53 4C 02 5B 07 58 3C 79 D2 42 08 81 8C 78 F4 F4 F4 F7 0D 39 EF' - '94 94 C8 13 30 95 10 20 72 28 B9 38 71 9C 2E B8 E9 BB 07 7A 44 88 A8 A8 A8 90 50 84 06 72 3D F3' - '1E 3C 7B C3 59 02 07 3F 44 A8 34 1A 0A 28 D0 5B 61 63 28 0B A7 22 44 91 29 12 18 6B 69 CA D7 51' - 'A5 C7 52 B8 81 03 7D 3C 5D D2 03 D3 C7 B9 FC 9E 5D 14 40 70 E2 C0 29 70 D3 B2 76 CB 78 EF 40 79' - '8D EF 79 61 02 04 3B B4 63 89 12 2B 81 76 4E 50 89 BF 28 9B FC A4 C9 12 22 41 10 20 F1 EF 38 DC' - '30 60 C1 88 60 C1 99 17 9D 92 E3 70 D2 23 87 0E 1A 34 69 9D 74 EA EB 27 0E 27 CF B6 27 06 69 48' - '91 E6 78 7C F1 7A D2 D2 DB 6D B5 50 5C AC 1C D1 A4 AA 53 B2 8C F8 CC 66 CD 86 CD 8B 64 D2 9C 1A' - '17 4D AD 69 66 CB 46 2E 12 8A 0E 7E 5A 51 C5 C9 5B 2B 2B 0A CA C6 57 55 E5 CB 4A B0 B2 4E C5 81' - '55 45 5A 8A EB 63 0A F7 2A AC 62 E8 2C 3B 4B 52 38 B9 46 61 B7 B7 22 C0 BA FB C8 17 72 B0 C0 C0' - 'D9 DE 66 53 83 29 16 33 94 62 38 70 36 5E 5D 6D 31 89 41 40 F7 8C D2 B9 09 CE 09 4C E4 A6 62 FC' - '66 35 8C 92 DA 8C 6B 1F 68 C8 63 34 F5 4B 19 A3 38 77 89 4C CD 18 C1 A5 05 E7 02 6B 46 97 05 D5' - '10 20 35 BA DC E6 56 87 8F 7A 79 5C 02 BA 0A 1E 39 AE 62 8B 8C 86 35 D5 91 63 B5 8B 78 DD 2C 8D' - '89 99 BA B2 9B B9 82 24 54 16 EF 02 EC CA 85 A3 47 83 83 21 18 EB 13 DC 54 D3 B1 E1 5C 0D 68 9A' - '6B D0 71 35 A5 64 56 3C 67 01 56 99 D6 66 EC 8D 33 08 70 E6 18 59 D5 03 70 6F A3 70 E3 18 0E 1C' - 'E2 63 87 27 1A F3 B7 5B 87 07 65 E3 D3 8E 75 99 73 28 10 20 70 DA 4B B7 87 37 04 60 F7 8E 4F 1E' - '27 91 20 44 71 D2 12 A1 EF 72 9A 52 5C 88 C8 19 32 12 0C 07 9B 4D 71 51 20 27 4C 72 73 9A 39 C8' - '70 ED 94 6E 28 07 73 BB A9 13 53 26 2D 05 9C A7 AA 40 82 20 39 A7 10 D5 3E 54 D2 83 99 6F AE 50' - '86 85 B9 03 00 A0 DF D2 46 26 38 98 A2 45 44 E1 0D 0A AA 8A 97 12 AD 73 AB 17 31 69 4C 48 4E 4C' - '4C 4C 4A EC F3 CE 4F 9D 0D 33 83 93 9C 9A 0D 32 EA AC 78 F1 E3 E3 01 E7 43 D3 C4 F4 3C 78 34 6C' - 'C9 9D 36 14 13 26 4C 90 65 99 34 3C B8 57 10 36 90 20 67 84 73 12 24 48 94 85 22 4A E5 72 B9 5B' - '72 B4 2D AA DD FC 86 4C 96 96 16 16 15 4E 61 72 78 F7 A7 0C 32 0D 1A 34 63 13 68 0D 1E 1A 1C 39' - '38 71 BD CD 01 E3 C7 A7 89 C3 DE E3 C6 5C 69 C6 2B 4B 78 1E 5A 40 81 04 63 B4 79 0A 23 41 C4 9E' - '34 7A 1E F1 C6 FB C7 8C 07 26 BA FD 17 96 95 99 58 A0 40 83 C9 90 21 02 04 E2 56 56 AB 55 95 18' - 'CC 66 38 81 51 B8 B5 28 2B 8D 03 C7 99 3B 04 09 91 3C D2 91 22 51 2E 9D EB DB AA 24 42 E5 22 48' - '80 F1 C3 87 38 1C 39 65 56 A7 26 8D 01 A4 87 1E 10 78 F1 CE 1C 54 32 29 CB 20 B8 49 4B E9 A6 72' - '62 55 2F 88 13 29 8C 8A 0A 0A 58 AA 64 B9 36 F1 C3 AA 45 C3 06 0F 79 5C 0E 5B 0F 3C 78 F5 15 17' - 'D5 51 73 19 72 69 90 C6 76 77 4D D3 74 EC 1A 16 85 51 33 71 89 89 8C 18 6E 03 7B EE 35 A8 2D C1' - 'E7 23 8C AF 1C 39 A3 5A 4C AC 97 69 A3 46 19 86 8C 18 C1 89 8C 18 67 60 F4 34 B1 A4 1C D3 91 78' - '83 2B 2A 3B 2A 49 8C 18 56 58 B5 D4 AA 29 29 1D 88 A7 31 1C 68 8A 2A 2A 2A 2A A8 B1 31 6D DE 5B' - '56 41 AC 3B 21 34 E1 C3 46 AB 93 57 77 A4 CC E5 9A D2 D2 03 DE 3C B6 03 9B 69 DB 7A D1 02 07 58' - 'C9 03 20 67 A6 44 89 12 91 70 A6 4C 9C EF 71 21 84 65 69 22 08 87 55 FB D1 23 AC 91 02 2B 26 5A' - '86 2A D1 59 99 85 65 A9 8C 61 26 F8 D1 1E 3D 3C 79 79 E7 39 0B D0 20 9E F3 2C 07 B8 D9 9D C1 B0' - '89 11 EA 28 51 22 5F ED AE 39 6F 1A 96 65 D3 05 0B FA 19 10 BF 35 95 15 2A 42 9A 4A 4E F6 2A 0A' - '91 52 E3 55 95 40 20 34 BE 62 03 C6 0C 2B 37 4A EB 2B 5C 54 5A C2 B2 A1 EA B1 FB 17 4A 73 46 0D' - '3B CD 1A 7B DA 70 D1 8B 4F 20 C1 8A A2 A2 6A A2 A3 CD 10 15 95 15 15 15 15 2A AA 2A 5B B5 15 15' - '04 62 C3 4A 68 D4 9B C4 87 0F 56 0F 3A 88 10 37 A2 B4 40 D1 02 02 80 F3 B0 BB 0B 32 EC A8 1D F2' - '52 CE 4C 9F 09 3D DB 0C CB BB 69 6A 56 96 91 07 8E 2E 38 98 54 54 91 56 F5 66 55 95 65 59 53 D0' - 'F4 3C 68 D6 88 6B 5A 65 59 4A 8A 8D C2 3D 86 8C 49 83 18 69 2B AC B1 9D 76 30 D4 34 4D 18 3D 30' - '60 C1 EC DD 61 5A 2B AC B5 56 56 56 1A 31 99 D3 CB 58 93 0D D6 8C 61 B8 DB 35 11 78 D3 C0 38 1C' - '2A 07 51 95 E5 1B CA E5 72 CC 77 55 EA F5 6A A2 82 8A 0B 5E 54 AA 32 91 88 7B 0A A0 29 89 42 3A' - '54 02 62 10 80 E1 A1 E1 1A B4 0D 33 8B 3A 69 9D 38 61 61 E2 8D 3C 76 96 34 62 E1 56 27 07 20 E2' - 'DB 76 44 F0 C4 1E 27 8F 3B 89 A7 94 E7 1B 80 E1 CE 2D 35 40 82 C8 45 11 22 5A AD 57 28 93 91 18' - '1F 2C 1A 62 40 DE 89 10 89 12 E5 A1 75 44 20 65 0C E7 5F 91 4C DA B4 13 27 25 21 4A 43 E7 02 10' - 'C8 A1 DC 88 F1 C3 90 EA 36 0F 33 A7 0E E5 73 B5 8E 2D 56 90 20 3C 21 43 CC AB 71 73 2D 6B 5F 5C' - 'E3 B4 9C 47 9A 60 0F 4A 19 62 34 D0 37 C7 4E 1A 58 76 D3 C7 8E 04 E7 38 E1 4F 61 A3 3B 86 0C 24' - 'D1 A8 61 95 19 51 72 1C 5C 9E 3D 6E 10 81 61 12 31 84 0E D2 DA A4 A4 A4 AC 14 D1 DB A7 36 CA 94' - '0B 39 74 D2 A8 20 42 05 6A 04 09 18 C8 28 18 0A 85 62 D0 9E 3C DD 63 89 83 46 66 99 D5 C3 C7 8F' - '55 83 D1 76 59 48 8A 04 0B 2A 07 0E 5D 09 EF EF C0 E0 1E 0F 79 B1 E9 EF 7B C3 C6 4C ED 60 60 52' - '52 B4 AD 21 94 56 15 9A 94 4E 9E 2A 8C CB 31 C2 C6 5A 78 7C 05 CA E0 BA C5 61 5A AA AA 87 99 D4' - '06 92 E3 C6 69 E8 59 32 B2 55 2A C0 C8 8D 7A 94 48 91 89 94 DE 09 48 52 0D E8 C4 88 9A 6E 30 AC' - 'E9 58 D6 23 10 65 52 0D 81 C4 C2 61 D7 73 87 0E 32 8F 84 08 1A 17 31 D9 59 97 39 13 3C 0E 0A 38' - '24 69 24 13 13 4C 4C 16 85 28 DF 55 00 E0 9C 9C A4 29 73 51 39 A9 78 55 6B B6 AC 78 E1 C8 B8 2D' - '4F 1A 5A 27 1C 09 E3 DE F7 F4 40 B0 CF E1 0C E0 F1 E3 81 D6 83 D1 A5 6F 2B 55 85 92 94 8D 4A 50' - '20 73 C0 4C F0 F6 93 8C A7 40 FE 01 E6 61 E3 CE D4 08 5C 8B 91 BE 27 9A 58 68 0A CA 8D 08 C8 15' - '2C 61 9A CE CB 2C 69 D6 DF 4E 1C 38 1C A2 0F 37 37 94 48 AC D1 78 F7 0E 1C 0E 43 90 E0 70 6F 09' - 'C3 94 C1 F2 EF 40 CC A0 66 23 14 58 9A 33 45 75 9A D7 22 38 5A 72 38 76 A1 3B 99 E5 8A 0B BF B9' - '03 4C AB 87 C1 40 65 06 A1 CE 74 8C 72 C5 C4 60 2C 05 7A A2 F3 6F 4A E2 54 94 9D B5 5D 6B 36 82' - 'F6 9D 26 B5 C5 B9 D6 5A B5 68 34 A3 3A D3 A4 D8 5A 59 12 72 DB 32 4D 43 53 46 8D B9 C3 42 B2 B3' - '58 56 8A EA 5D 0B A8 E7 18 0C 34 03 42 3C 6E 25 D2 0F 59 28 56 40 80 A1 62 D9 25 29 11 2D 20 41' - 'C3 93 87 2E 54 35 EC 18 49 A3 4F 38 89 27 0E 72 70 E4 48 5D 0A 63 CC 81 9F 3E 59 1C D2 37 56 59' - '8A 64 E6 B9 C4 71 88 8F 14 89 4A 39 60 3F 58 41 10 0D 71 22 5C 1A 8C AA 51 22 F4 3C B5 39 C3 46' - '9C 69 BC 4C 2B 2B 25 CC B6 AF 29 0D 4D 1A A6 35 48 1C BA 2F 5E 79 BD 02 04 2E 07 0E 1C 56 48 AC' - 'B4 19 C8 D0 69 DB 4D 68 D1 A6 D3 58 58 F0 80 40 D4 FD 5B 22 6C 09 16 CE 61 63 AF 78 F1 E2 78 39' - 'C8 71 42 37 8F 12 29 D3 93 F7 1A 0D 6A 9C 9C 9C 34 8A AD 0A 43 8B 87 9B 13 F7 54 21 03 31 12 2A' - '27 16 74 48 59 D4 8C CB 4C 88 C6 2A 24 51 30 55 39 39 3F 2A 8A B3 4B 38 1A 34 CB 71 AD E5 67 35' - '1B EA 31 78 50 86 40 81 0B 75 19 4C A6 40 C8 5A 6F EF 96 8E 1E 3C 7A 72 ED 42 88 10 20 42 04 32' - '91 5B 8B 78 DE 99 D5 62 B1 58 58 58 A4 A4 A4 A2 69 C8 DE F2 CA 38 1C 6C 07 8F 33 0C 2E B8 C8 34' - 'CE 5A 75 38 DA F1 E3 C7 8F 5D F2 04 21 0E F6 8B 74 1D E3 B5 68 AE C9 69 62 99 32 6B 4A B1 73 2B' - '57 0A 89 12 31 A2 85 0E 37 A1 C5 6F 06 3C 78 F4 F2 54 66 98 D7 61 29 8D C3 10 C1 83 06 30 60 C9' - '0C 34 9A 5A 45 0E 43 87 0E 0D EE 45 08 10 37 F8 C2 04 07 8F 4F 1E 3D 75 28 1C 47 91 01 E7 1C 20' - 'B2 C4 E2 37 E4 44 E1 91 22 04 07 9B AC 18 98 0C 54 2B 06 8D 1A 34 9C CC 83 8D 03 E5 03 5E 89 11' - '90 4A 44 94 89 12 53 26 4C 26 4D 5C 5D 65 84 89 48 25 24 A4 12 24 48 DC 90 48 91 09 65 1E F2 75' - '39 30 6F 4D 31 34 C5 2A 73 4E 9D 3A 56 95 44 0A 91 61 04 49 27 D1 77 D8 B5 9A A8 38 20 0F 1E 50' - 'FD 50 82 86 63 57 3C 07 1A 32 C7 1F 52 E3 54 14 50 B5 0C 88 65 EB D2 2C B5 54 44 22 B0 51 BC A0' - 'CC 39 A6 C2 75 91 64 C9 90 CF 7E BB C9 96 80 98 98 D0 13 AC 92 24 48 92 23 2A 24 4A 39 0A 25 12' - '2B 8C 91 CD C6 4C 3C 91 65 B1 4C 9A 90 48 9D 46 78 39 AA 2D 0F 15 C5 20 F5 C5 9B 63 F9 07 8F 4F' - '43 D3 56 B5 E1 53 13 4C 64 DD 45 A9 8C 2F 50 C3 20 DA FA AB 2C 0B 2C 6A 18 26 A6 A6 8C 18 15 95' - 'F1 EA B3 C1 A4 5E 30 67 C8 64 4B 3A 63 25 25 52 E7 2A 3A B4 A7 56 F1 F1 84 73 F9 B7 83 F5 C0 20' - '87 A7 AB 48 23 46 B4 44 61 CA A0 41 41 37 46 BE 56 6A 78 6C D8 BD 56 82 04 20 40 82 63 17 35 12' - '32 05 08 C2 84 40 BA ED 29 C5 AF B4 1A 35 A4 A1 8C B0 C6 61 92 DB 75 58 13 99 58 9A D3 C2 AC ED' - '31 C3 9C 5A F5 5C 17 7B 99 50 50 9E 8C CD 44 E4 C9 99 42 7A DA 62 6B 46 E0 9C 9C ED F5 6B 87 2B' - '5E 8B 08 5B C3 0A 03 8A 2A 2A 24 08 41 9A 28 4E 1C 39 0E 77 53 DF 5A F1 18 3C CE A0 F7 8F 38 C8' - '0F 21 62 B3 C5 30 89 1E A8 F8 9A D6 1D E6 79 05 B2 5A 58 77 CB 11 DE F1 AF 63 3C 06 A5 B7 94 3C' - 'E7 B6 71 07 49 9F 67 B1 7A 4C 38 7B F5 75 EB E9 95 EF FA CF 33 8A 7F 53 EA FF F5 E7 F8 3C BF 4F' - 'D7 B8 1B 39 D6 7D 4C B5 8E 1D B3 AC 17 0D 53 86 A9 EE 5D 5C B8 D6 CC CD 76 E1 80 E1 82 E5 3B 02' - 'C7 3E 89 B0 19 E7 6A 7A C5 29 8D 94 06 1C 40 6B E0 36 6E 1F 25 F0 9C 36 0E 18 6E 1D 8B B1 B2 4C' - '5E 6E A3 BB 65 15 60 2A BE A9 F5 2C F7 B1 55 F5 6F DB E7 E1 6A F3 12 AB 17 8F 56 22 AC 60 3D F3' - 'DF 1B A9 BD 1B 80 37 06 CF 4A 62 E0 C5 C1 0D D9 70 E7 5E 76 05 8D 8A F3 E7 65 88 5E B0 C3 1C 49' - 'D4 1C 51 D5 B5 5E B1 7B 33 7C 5A FE 67 F5 31 B4 5F E0 76 A7 62 CE DA AE CE D5 7B 53 F8 AD 78 45' - 'E2 0F E4 72 67 6E CA E4 D7 B8 3B 95 AF 74 BF CC EE CE F0 E1 CE A8 E6 4E D8 FD A7 4C 77 27 6A 77' - '07 7A 77 C6 50 EF DF D7 BD 5F 00 F0 57 EE 29 89 46 37 E7 84 40 E1 99 53 C4 3C 52 C2 0E 32 C0 E2' - '9E 39 FD 2C 4B E4 2F 92 65 8C B9 E5 1E 1F 2F 58 79 5B 25 EB 97 07 C8 5C C6 BF 9B CD 72 66 0F 30' - 'CC CC 81 A7 4E 7A FF 6F DB F7 FD FA 7D 3E A7 F6 B9 A9 AE B9 9B 9B ED F6 FB 9D C9 59 55 F6 38 03' - 'B2 7B A7 7A 78 E6 54 CA 70 F8 27 84 78 BC 49 B2 F7 36 B9 B9 BE D2 93 A2 B9 C9 CE 89 9C 3D 63 FB' - '4D F6 67 25 D5 39 DE 67 B2 CC F3 EF 6E 6F BE C4 EB 1E 06 3C 2C 78 98 9F 63 C6 C7 F8 7F D3 DF 3E' - '47 E5 2F C0 B0 28 0C 62 0F 2A C0 F3 61 D6 C2 0A 16 3C 67 B8 67 59 58 F1 AF CE F4 BF 42 EA FD B5' - 'F9 0F 93 C2 B9 E6 A2 09 8A 26 18 60 FF CC 51 B5 5F A5 74 26 91 6B F3 AE 95 A7 61 18 F1 55 19 53' - 'A5 BB 34 C5 E1 A0 68 D5 84 41 E9 60 14 C9 A3 0B A7 C5 D8 DA 2F D4 C2 97 EB 58 80 F6 2E 95 45 07' - '69 D2 9B 30 E9 80 3D 25 D1 A8 2E DD AD DA FC EA B3 84 F4 25 12 02 44 E8 F6 FC DE 5F 18 C4 F9 D5' - 'D4 1F C0 D4 F3 96 FF AA E7 98 0F 7F 51 AA C3 68 1E 9B 67 DF 23 CE 78 53 AA 5D E7 D3 16 D3 25 F2' - 'BA 57 90 B1 5E 5E 0F B4 3D 39 E9 8D AE D7 13 0E 13 FD 4F 51 A7 B0 69 0F 5E EE A3 25 EC 65 E3 93' - 'D2 AA D6 27 D1 88 3D 6E A4 61 5F DA BC CF 31 34 99 6F F8 3E B1 3C 57 FF BD 56 BF A7 0D 6A B3 26' - '15 34 D2 B5 59 5A A9 18 8C 66 24 B0 98 D7 8D 81 75 2C 24 55 8B 1A BE 15 23 C1 4A F3 58 15 05 0B' - 'BF 5D EA 8A 94 0B C5 E5 5F 97 45 3A 81 C8 CE AE BC 55 52 C0 AA 55 90 47 9F 58 8D CC 4A FA F2 95' - 'D4 A2 F2 A4 C2 B2 AB C5 E5 A9 A7 F9 27 FA FD 25 63 75 B1 8B 0E CE 07 A2 18 0C FF EF FE 84 3C E5' - 'A7 B6 AF 2A B4 54 79 19 2C 2C 0A EC 47 0F 46 01 F8 6A 1C 5E 25 6A CB 5A 30 E7 A7 05 39 69 46 32' - '88 2F F7 34 31 56 50 B0 88 A4 AD 8B 3F 31 7C 24 AA C6 B1 1E A3 D4 2D AE F4 D4 0C 06 0C CC F1 0F' - '5B 9B 13 8E 09 2A 51 BB 85 55 54 96 31 9B 73 D2 BF E3 3F 0A A7 B1 40 61 3C FA A8 D2 B0 7A BD B8' - '9A 30 EC 7F 3A A7 93 48 C3 89 84 A1 D0 56 7D 81 5D 44 03 75 6B D9 46 E9 A1 7A 51 CE 31 F3 9F B6' - '47 ED 8C D7 DB 72 E0 71 51 75 25 52 0D 53 93 19 D1 B8 6C 53 6E 1B 89 FB 9A F7 56 DA F4 DE AD 87' - '0F 38 D4 34 EC 2E B2 F4 EA B1 94 0E 45 75 1E A1 42 92 92 6B 4A DF 31 1E 83 39 03 21 14 C2 B5 69' - 'C9 B8 99 CF ED 63 3D 16 54 31 65 1A 58 3A 8B 9C 8B B2 2D E5 F5 8A 31 B4 ED 83 B4 71 27 B9 70 BE' - '8D 70 4D D2 E4 5A 23 95 39 6F 5A C2 A5 AC 5A CB 08 C4 C6 47 1D 14 2C 64 1E 8E 8A E0 23 BC 11 5A' - '04 E4 E1 C8 82 F4 D5 EA 91 52 C6 63 58 CD 35 2D C0 EB AA 51 4A A5 16 AB 0C 61 34 30 62 DA 45 6A' - '16 65 A9 67 71 B7 86 04 0C 54 43 72 88 AB 57 1E AE 9F 5D 57 EA 8C 4E 08 91 20 9A 71 2D E7 19 91' - 'A4 DB B0 34 9A 2C 78 F1 EB 32 85 CA EF 44 63 C5 88 A4 CE 58 62 C7 D7 DF 10 F3 52 AA AA 4C 78 CF' - '21 64 34 9E 1A 87 85 75 86 3C 42 8E 54 65 F6 42 B8 1D 25 CE 1A 88 A6 8D 06 A3 94 C5 88 31 04 CC' - '41 FB EA 02 26 38 75 54 13 0A 8A 91 52 31 76 B2 08 A9 6F 2E 9F 15 35 81 8F 58 68 D5 9D 30 45 47' - '93 80 23 CE B1 58 8A C6 64 A1 73 2B ED A1 34 46 02 AE 65 00 BE 8B F5 F6 E9 15 1C 0A A0 F1 29 97' - 'A7 D7 3A DC 17 3F 5D 6E A3 73 22 70 44 E3 B8 82 68 A1 A4 9E F4 70 E8 32 8C 79 C5 05 E5 2B 91 95' - '78 75 97 1B 03 6A 2D 20 6A 66 84 52 1D 7A 77 9E 9E 8A 51 59 E3 AA 7B 7B 51 84 47 65 76 93 16 FE' - 'CB C6 2C 9B 2C F7 24 C1 61 C3 51 E2 EF DE 2B 36 88 A8 C6 F1 0E C5 48 38 A4 B6 28 D8 B7 96 0D DD' - '8B 62 D6 9C 23 32 DE D1 58 15 18 8E AC 18 84 60 38 55 A1 89 18 04 30 D0 BA 6B A3 21 4C 37 11 E6' - 'FA DB 6B B0 22 F5 B9 4A EB F6 B9 19 49 5D 21 31 1C 39 8D 3A D9 6A 3C D2 CD B8 AC 45 E2 84 60 36' - 'AB E1 81 71 2E C1 48 88 10 5A B9 30 B5 61 B2 B5 80 CC B1 AA D6 3F 2F 89 A8 C2 AF 40 C8 AA 26 B0' - 'AC 4A F9 89 18 0A 4D AD 59 57 02 C5 83 7B 1A 31 87 6F D0 52 61 33 2E A5 03 AF 78 C3 CE 62 34 A3' - '9F 3A C6 8E 1A 49 A9 26 73 34 F3 DA 17 16 60 AE B2 D4 66 2C 4D 5D DE BF 2F 42 E5 5D A2 96 99 C3' - '52 18 61 0C 07 A0 58 D3 57 83 09 95 64 0D C2 B4 61 D2 53 80 F2 EE BE 17 CA D7 4E 2E 65 52 2F 62' - '26 BA CA 44 16 1C 34 A1 CA 65 23 16 25 7C DA 74 5A B1 A2 F3 96 02 F7 96 B0 08 65 F1 FB 4E 99 04' - '48 AC 5D C5 8F 1F 7B B6 5C BB AB C4 17 59 7A 8B 47 C1 39 17 AA CA 95 1D 9E D4 31 23 10 56 6D 75' - '8E B2 DB DB DB 2E 18 30 61 CB 21 3A 92 F7 64 1C 54 B0 8A F2 E3 58 6F 37 BA 74 F3 52 29 23 98 DA' - '62 AD 63 31 F1 D9 5D 69 B8 E2 61 BE 60 6A 30 98 4A 2B 54 2A 82 37 D5 6B 22 91 45 18 2A C4 B1 28' - 'AB F1 24 8B 56 A5 4A 62 AC B4 9C 90 45 84 AA A9 13 0C 52 59 67 47 69 22 11 01 40 FD C3 42 22 63' - '33 39 60 14 AE 83 D3 C9 68 C0 63 58 8B 15 F3 3E 73 3A 39 96 FB 82 B3 12 64 28 55 0B 89 70 2C 7A' - '96 23 35 9C 4A FD 46 0A 91 1A C2 A5 52 C2 14 A2 77 A8 C4 8D C9 95 0A 4A B7 9C 3D F4 66 5E 6E AD' - '4A 4C 32 A2 F0 38 46 6E 75 35 85 18 11 8C 35 DF 46 15 81 17 2F 25 6C 5C E6 6C 68 DF 2D 5A D6 00' - '29 15 8B 80 62 31 0E 47 28 D5 8A 93 08 F4 E5 B0 C4 BD 4A A4 59 7C 18 8C 1E 3F 1A C0 30 C1 4A E2' - 'C0 60 31 23 3A 6A C8 AC 4E EB 55 42 A8 D0 36 E5 49 72 EC E2 58 B3 14 6B AB C8 08 A8 AD 95 79 A4' - 'AE 53 C4 11 08 9D 41 42 AE 25 69 44 D2 44 94 B5 0A 62 49 95 2A 02 11 1A A9 04 E8 EC A4 42 77 2A' - '41 42 CC 4E 23 38 8A F5 44 F3 C4 10 44 C8 C1 81 37 08 61 46 1C 38 16 03 06 DC 31 54 F2 2B 66 54' - 'AA A8 8A C1 B5 4F BA 47 69 AD 49 14 E9 8A 9C D6 4A 03 2F 06 75 67 D4 89 F2 C8 9E 61 52 98 75 AB' - '50 A2 79 D1 04 19 AC BB 84 FD BB 57 A9 5B 50 57 43 B9 98 54 E1 8C EA 65 50 68 2C C0 64 12 50 B4' - '5A 6A 7D 72 B4 A8 58 B9 96 25 48 31 31 4D 71 F7 95 7B 4C 5B A3 13 96 EA C6 67 C3 D9 2F 62 5E 55' - 'DE A7 E4 D1 6A CE AB 54 D3 EA D6 5B 2C 98 99 75 C9 C9 88 83 B1 62 44 89 16 44 94 A4 98 D1 0C 86' - '56 93 AC DE 7A 0D 6B 8D 52 59 4A C5 D8 4D 3B 46 BA 3C 9E 1E DF 8E B2 28 C8 DA E4 C2 B5 6C 4C 10' - 'C0 61 65 34 D2 61 4B 84 BC 2B 6F 07 4A F1 18 B1 45 50 DE 0C 37 D6 4B F8 D7 01 35 CA 62 B5 5A B8' - '97 01 8F 19 4D E1 E9 A5 DC DA 2A C6 DE C7 28 F5 A1 5F 5A D7 61 64 4C 3E 9C 32 38 D6 AF 62 50 54' - 'C0 BE A7 8B 06 D2 0F 5C 5B 16 DA CE B6 C8 F6 97 DD 84 9C EB 69 15 2A 95 4B B8 A0 75 6A 39 2C 5A' - '56 C5 42 F0 85 26 D2 82 83 D9 D8 06 1E DB 4D D1 6F 29 ED 0F 76 26 18 0E 59 B7 FF 2B FE 47 F9 1E' - '8F ED 7E C6 CC 39 6F 78 0D 54 DE 0C 39 BC 9A B1 AB 1A F9 AD 17 F3 7A 30 C0 FB A6 BC 61 0F B8 6E' - '46 DE 6D C6 E2 61 4D 82 F6 BB 6A E1 0B C3 65 36 82 61 17 EF 11 0C 5E 17 86 F8 6F 86 88 BC 6A B7' - '8B F4 97 85 E1 78 5E 17 85 E1 A0 31 85 E1 A6 2F 79 55 BA A3 A5 74 E8 E5 34 38 07 4E BE CB A1 66' - '91 74 93 94 A7 AE 0D 29 A5 34 66 94 D2 FD 8B 69 97 63 0F BE 48 81 4B D0 E8 B5 E6 CB 28 74 3D B5' - 'EF 9F 86 FF 7F 4E 8B 94 94 94 E0 54 0A 84 47 F8 DE 02 7F 1C 2D E6 5D F7 22 46 E9 EB E0 12 20 6E' - '86 E3 E0 D1 ED D7 B1 C3 0F BE E9 63 12 62 10 6C 8A A9 53 CB 72 26 9C 1D 92 E5 2B 94 EE DD 3C 42' - '62 C4 8B 4A 13 21 80 D1 C7 ED A7 B5 4C 3A E4 91 CB C4 4C D9 93 27 21 99 33 07 72 92 49 98 76 99' - '1B 21 0F E9 BD 3A FB B4 7F FB 19 8C C5 CE EC 7F 6D D3 17 F8 78 78 77 82 EE CC 33 C8 0F 24 8B B6' - '1D BF CE 17 AA 35 D6 BE F9 F4 9F 26 7F 73 E7 E2 03 A1 44 DD 46 6E A5 91 9A A0 A2 52 66 66 EA 43' - 'F5 02 8E A4 7D 83 9B F6 79 D2 A2 93 4F EC A6 3D 93 32 48 A4 42 C2 6E DA 04 84 E1 81 FA 00 ED 00' - 'E3 D4 93 91 EC 3E 34 ED 29 8B 2A 77 6B 0F FF 4C EF 5B B9 17 F2 0B D1 4C 28 C1 F0 D6 9C 58 CE 17' - '2C CB 1E A1 EA 1C 41 EA 1C 41 8A 31 47 8C 7A 87 10 71 47 F8 3D 43 CC 3C F3 D4 38 53 8E 38 E3 8F' - '35 6E 54 C0 BE 63 9A 64 37 33 21 9B 1C 5A E1 45 B5 6B F9 0E 36 30 AC AF 1F 8C 87 80 08 97 60 55' - 'F9 6D 36 C3 5F 19 86 D3 95 89 22 C9 B2 39 08 4D E0 14 C3 48 65 C8 8A C0 F7 86 AC 70 D5 AB C8 C1' - 'D2 3D D2 82 54 02 22 60 4C 92 00 02 05 65 48 4D 66 9D AF 55 96 5A 72 87 24 71 B8 B9 7C 22 64 C5' - '57 EB 79 F6 A7 D6 70 D6 55 BA DB 7E 34 94 B4 A7 26 DD 74 AB A5 34 86 94 D2 9D 89 A5 3D 53 34 69' - '4D 29 EC 1C C9 8F 39 E3 1E 63 CC 79 B4 97 56 B5 E7 88 EF 1F E8 DB 8E 80 F6 0C 71 D0 1D 09 B9 17' - '5D 97 57 D4 D1 2D A5 A1 A7 74 E8 CF F4 D1 7A 25 B9 3A 22 E6 79 6E 97 28 76 E7 7C 5D 1A 82 E8 BB' - '33 C7 C4 77 07 02 5D 9C 01 C1 1F BC BB 39 12 EC BB 3C 73 BC 2E CB B3 B0 3A C3 AD 2E 8B B3 2E 76' - '26 80 F0 8D 01 76 5D 97 67 8A 78 A7 98 65 CC C1 F3 97 67 9D 64 5F 35 77 5E 72 F9 DC C1 9A 3E 93' - 'CE 33 25 D9 8E 2E DF E8 3F 59 FD A7 F6 9F A2 FE 45 8F 17 C9 8E 8B FD 38 8A D1 F8 AE FF 9B 15 9C' - 'AC F5 9E B4 45 68 AC F5 9E B3 D6 9A 2B 45 67 AD 11 5A 2B 3D 67 AC F5 A6 8A D1 59 EB 44 56 8A CF' - '59 FA 0F D1 7A CF 59 EB 3D 67 E8 BF 46 9C 56 8A C4 F1 82 F2 C7 8A 78 C6 64 F3 E5 17 BE 5C A6 21' - 'A0 23 05 DC B2 6E 98 0D 06 21 5D D6 A1 B4 52 9B 0E 6D 99 4D C2 94 37 DC 15 3F 2C 23 E7 9F A1 E9' - '74 D3 DA 87 6E B7 47 8B 12 B7 4B 6E 5D 67 86 8D 8E 3B 0E 8B A7 DD 13 0E 98 81 61 7C 9C 13 0E 97' - '56 7D 5F 65 6E B0 41 6E 96 E8 BA 2E 8B A2 E8 BA 3D C3 D0 2E 8B A3 DE 2E 8B AA F2 FB 2B 9B F9 16' - 'E9 6E BA 4B EB AD D1 74 7F E3 6D 37 02 E8 BA 2E 8F 90 F7 4B A3 34 A3 4F 9A 76 A3 DA 09 4E D2 A7' - 'D9 62 B1 36 82 D8 16 8A DF AB E2 08 B2 F5 29 B6 DA DE D7 75 6E 9A 45 39 51 7B 90 17 16 15 20 AB' - '83 2C 82 20 F3 AA 40 43 91 6D 12 01 F4 AF 89 1E AF 5C F4 F9 6F B7 BA 1F 03 E2 58 0D 9B 8E 3B 39' - '4C A7 45 24 CC C0 4C 03 09 14 42 4E 7B 2E BA 15 32 A8 8B F2 5F 81 BE 8B F5 F8 14 BE E2 6E 91 37' - '78 81 1C 20 23 44 48 6E F4 97 B0 DA 2A 01 6B 08 11 ED 57 8C 33 6C 95 EF C4 1D 55 1B 78 AF C3 C1' - 'EB 4F EC 25 C6 02 E6 2B 31 13 73 93 9E 15 A4 DC E5 E4 4E 0C BD 94 76 70 29 D7 9A B9 B4 4B 9D 75' - '27 2C CA 81 0F AC B1 AB 7D 1A B1 63 16 1A BF 69 79 11 A9 16 CF BB 52 8C 9D 4E A9 F2 13 50 AD 48' - 'D3 07 03 4C 35 1A 8C 3E E5 9E 2B F9 27 6B A3 97 1E BB 92 6C 4B 3A B2 E3 DF D5 F2 AF 41 61 A6 13' - '26 49 30 98 21 9B DF E1 7F B0 4C DE D2 D7 76 30 C2 BE AB CC 70 41 54 C3 C0 69 A0 8E 74 35 16 A5' - '44 32 F4 46 3C 5C A5 36 D4 63 E6 60 71 D4 CF E8 19 70 A0 68 C2 D5 D9 32 63 6F 25 2C E5 41 B6 C0' - 'F7 D2 FB 5D B4 5C 1B 0E B0 97 24 5C 7A 5D CD 03 4C E1 3F 90 CD 0C 73 3E A7 17 FB AD B2 90 13 33' - '30 21 92 CD BA 6F 6E CF E5 6A BC 3F 95 EB D2 F3 4F 33 93 BC 39 3C 9C A2 0F 2C E4 1C 81 CE 41 E1' - '1A E1 F8 F6 7E E1 FE 56 CD AD 0C E7 B7 6A D9 AB 62 BD B2 B3 9E F7 DD A0 85 0C EC 67 95 9E EB 0D' - '73 15 65 70 AF D2 31 DB 2C 5E 86 32 05 DF FD 99 A8 79 7C 83 98 9E C1 83 3C AB 05 3B BA 2A CC B2' - 'BD 58 85 7A BE A1 52 A8 0C 89 85 6A 99 AB 72 27 43 DE 84 7B 97 47 3E E5 46 3B C6 34 AB CA 59 65' - '2C 3D 80 96 4A 88 4C 99 86 13 08 19 2E BD C1 AE 9C 35 A6 77 9B 85 CF DF 5D 9C CE D5 B9 D4 73 B0' - 'DF FF 2A BF DB 20 D0 9E 8C D2 BE 62 A7 75 13 FC 4E 3D D4 79 1A 51 06 9E AC 40 F5 2B 80 1C 27 05' - '81 47 2A 96 8A AB 21 F3 E2 55 94 7A 05 15 12 B3 34 4D 64 6F 35 67 88 DB 15 61 7A A2 D9 8F 25 BA' - 'A9 FE 85 D0 30 94 AA A0 54 AA A8 15 E4 57 79 5D E5 66 55 DB 0A 8B 53 DC 14 D7 65 10 46 3F 0E 31' - '46 11 38 B9 81 D0 39 E1 D3 58 AD D3 0B AA 53 BF 4E 9F 4E 76 BA 25 63 03 C2 66 76 E6 05 5E 60 31' - '15 DC 08 6F 9B C1 BD 7E 05 23 AF C3 00 3F 98 AB 3A 30 33 E2 FA CB 26 CD 69 BF 38 7C 88 96 EB 14' - '4C FC 7E E9 49 9B E1 2D 10 44 8C 6A A2 D1 6C 46 B5 51 EA 9A 26 CF E8 60 D2 FD 75 67 66 2D DB 26' - '4C 90 54 60 6E 26 DF C9 C7 98 98 EC 28 C0 D3 BE 39 46 4E B5 FB B7 7E FB 67 BB 77 AF 82 F6 4F CE' - '7E 62 6E DD F0 6E DE 4F 92 E9 DE 4B 27 22 64 EA 0A 3A 9F 2D FF D5 C7 EF D7 A3 43 19 2B C0 CA 56' - '7D 9B D4 F2 C2 BF 8D ED 27 47 07 82 50 5D 17 D3 64 1D E9 D0 3E E5 2F 8C 6C 24 ED 8C F6 8F B7 19' - 'A8 6C 85 F5 16 42 F4 D6 42 C8 59 0B 21 64 2F 61 7B 0B EF F3 D7 9B F6 62 AD 99 7C F2 DF C3 FD 25' - 'C0 C1 39 A3 8C 1B E5 C0 9D F7 85 FD 37 E9 0B E3 92 87 DE 9A 2D EE 37 7D A1 D0 39 8E 61 92 9E 14' - 'E6 3C 6B 41 9C CB AD C1 70 E5 31 95 54 CA D9 6E 87 C6 A6 29 96 75 6E 54 A6 61 AC D3 99 79 1C B9' - '65 AE 33 F8 78 27 DD 6F 94 66 FF 91 9D 54 33 5C E8 D4 B5 F4 AF 51 49 8D A4 6A 3B 94 14 02 16 06' - '16 15 70 5C A0 5A 56 6C 3B CA AB FF C2 B0 96 05 2A C4 A4 49 86 19 32 10 C8 37 8E 9B 37 6F 1A 8F' - '85 71 14 7E 0C 9C 37 C3 5C 17 5A 95 70 B4 AA E1 5C 2C 95 92 B2 56 4A C9 5A 45 63 BF DE B3 1E 65' - '9B 65 3B 4A DF B9 20 ED C8 79 65 7B 93 0D 94 AD 9B 01 D1 94 12 A3 69 0D 9E 63 2A E9 AC 1B 47 03' - '2B 46 8E 08 7B AB C6 25 3B F2 0E 37 95 AF E0 F7 F1 93 06 56 A3 4E D4 8F CC 8B 08 D7 0A B4 03 18' - 'AE BA BB CA 91 55 4E 92 95 54 AA A3 55 1A A1 82 B6 8A BA AA 75 54 4A 8D 54 6A A8 55 5D C8 24 11' - 'C7 A7 D8 F1 CF 7D 26 6C 0F 50 3F A8 33 3B 60 F4 83 52 57 EA 63 0A A7 BC 9E 0A 6A 0B 08 20 CA 63' - '17 40 DB 4D 3F 9A 6B C9 69 4F 44 DA 7C 1E 68 E1 83 80 64 39 81 17 E6 8C E6 1B D6 63 75 77 74 7C' - 'C6 DE B9 5E 59 1D B0 57 9B 9E A2 B5 B5 48 D9 A1 84 0C 96 E5 C1 BA 7E 94 7C 0A AC DF CD 44 99 B9' - 'DD EC DB A2 5B A5 EB 2D D2 BA 0A 8C 54 62 B1 DF 0F B6 30 08 8F AF B5 28 A6 16 4C 58 C2 0B 05 42' - 'A2 C0 CD F3 D5 6E AE 20 8B 84 53 77 18 58 1F 81 5D F5 58 C3 01 22 C6 17 09 17 16 AF 8E E0 12 CC' - '20 16 D4 D9 DB 0D 23 FA EF 8B 6B EB 60 C5 B3 B8 54 5A A2 D5 85 56 01 58 05 68 95 E4 2B 1B 6F 1F' - '66 CC 78 F9 1B 46 96 36 8A 5B 6D BD 11 3C A7 FD 15 8D 0F E2 90 B1 91 8C 9D AE 69 3E 36 A6 C5 A6' - '8F 51 17 36 4D F5 85 C5 27 8E 29 1D AE 0F 93 B7 5A 81 FC 95 DA E0 F5 ED B2 C6 74 F0 71 F4 E9 8D' - '8F 64 98 A0 A1 0F 3E C8 CC AB 3A 18 1B 87 CE E4 4D 7F 6E 70 F3 DD DE 75 73 C6 E5 DC BB 97 72 F3' - '5A FE 9B 3D CD C5 2C 79 E6 EC C3 A8 62 57 43 F0 9A 96 2E 2D FB 36 A7 14 3B 40 C5 09 57 77 25 3C' - '5F 9E 4F E8 5B 69 65 07 EA 34 0F F9 15 5F E2 59 C4 30 F8 B8 91 7D 88 89 D6 E3 7D F7 E6 59 14 F1' - '41 ED BD FC 05 DE C6 01 54 CA CB AB A2 A8 85 7A 15 78 0A B7 AA BF 07 0A FA B0 FC B7 C5 A6 E5 47' - '72 45 9F 96 A4 1E 84 09 ED D0 8E 1D A5 AD 08 17 B5 8B D2 90 58 85 D8 08 4C A1 73 C3 70 E4 1E FB' - 'AF 6C 13 86 95 40 84 B2 88 1A 91 84 DA 4E 9B B2 09 F7 0D E1 2F C2 EF B3 7F 24 51 C5 24 4D 99 B3' - '74 7B 88 77 3A C1 F2 8D 51 8F 6D 1A 73 0E ED 17 67 06 E5 CA D1 A3 64 E5 6F 1A A5 4F AC E8 BE A5' - 'B4 5C 35 C9 5D 31 74 8C BD AE BC F3 CC E6 FC BC 91 E1 7D 5A 3A BC 38 BF A0 B0 BF 31 99 60 06 97' - '3B 60 33 AA 7E 1B F8 87 65 0F D0 94 BE 42 CF 15 2B F4 E5 E0 51 C1 D5 23 C6 66 3C 64 E1 70 C9 08' - 'F9 6C EC 80 64 C8 96 C4 52 89 35 EB B8 5A 98 C7 F4 50 26 8B AF 8E DA E3 A8 8C A3 E4 B8 DB 8E BD' - '87 9D 19 ED D5 B3 1C E6 B7 3E 10 D7 02 25 C7 0F 14 84 E9 FA 07 4C B9 DB EA 5A B5 C7 0A D7 A0 AC' - '25 6E F0 77 AE BD DD D2 A9 99 B8 28 4F 84 A8 2D 8E 7D 17 B2 9F FC 0C 4F 8D 78 E7 66 38 36 0B 7B' - '63 0A CB 31 0D 34 B1 2D 6C DF 60 BF 8B F8 7B 5D 00 7A F3 FB 87 9B 32 FC 94 EA B1 34 0C CB 65 12' - '9A 09 22 43 BB 6A 6F 15 64 BB DB B6 82 D4 0D 4F A0 36 81 9C 82 BA F5 78 8C D6 CC 67 59 11 30 76' - 'C9 94 09 91 43 49 41 98 58 63 C4 31 D6 F0 F4 3E 07 E2 7D 5F 86 9A 8A 2C 5A BA 8F 39 53 00 FB E1' - '96 3B A7 01 3B 0D CA F3 FD 4D 25 9C E3 3B D5 EE 88 E0 FE C6 77 00 C0 8A 84 52 C5 E0 15 45 08 A4' - 'B5 45 DD AD 96 21 7F D8 29 8A DB 31 4B D7 94 D8 7B 91 19 E1 ED 3C B0 0D 78 9C 99 D8 27 3F 26 F4' - '6A BB 31 AE 6B 3B 3A AE F8 8B DA B3 42 F7 43 10 3F 21 18 26 FE 84 C0 B4 DB 06 21 A2 C3 1F 30 8B' - '46 70 96 D6 F1 0B 44 9B 56 27 F7 E4 AD 52 6D 90 58 1A CC 74 A4 0F 7E E6 C6 0D 58 35 34 45 20 17' - '78 BB CD B6 C7 AE 64 5E 78 73 6F 8A D3 3B FD 97 0E 8A E2 AF CC CB C7 F6 CC B4 91 46 FD 35 5E C7' - 'CB 9D 7C 45 66 DC 5A F3 61 69 6A 1F 46 F7 EC 7D 8B B1 86 1F 3D D1 5F 95 6E BE 03 72 DD 6E D7 72' - '3D CF 3A 11 09 49 9B 4D C1 12 E1 FA C5 7F 82 58 8A 30 63 85 CB 13 13 8B 10 60 B9 2B 0A 0F 28 48' - '7D 34 E1 87 12 C4 61 19 4C 5D DF 39 8E D7 F6 4C 3B 33 E9 0E AB D1 7B 13 6D 33 90 75 9C 6A F5 92' - '92 61 BF DF 28 A7 EC 96 43 2A 2A 52 79 56 ED 05 A8 50 5A DA 24 68 7C 1A 81 AA EA 60 D1 93 FD 32' - 'D4 EA 4D B4 AC 5B 96 2D A9 6E B5 AF A2 2B AF 5E DD BE CC FE 3E 8F 9C 35 48 56 B3 B2 FB C1 24 21' - '60 91 59 84 10 BB CD 7A E9 AD 0B 2B 1C 43 87 9E 72 C6 FB C0 76 80 73 2C 21 DF C9 B2 F6 8E E1 EC' - '5E 75 E5 5D EB BD 1D E3 D7 3C DB ED 9E 1A F0 96 8D 66 56 2D 4E 2E F1 43 50 C5 74 B1 4A 1A E2 AE' - 'B3 A7 9F A6 74 72 EB 0E EA F8 96 FC CA D0 D2 9D A9 F8 32 AF F7 46 F0 75 9A 8F 40 EE 87 65 B2 72' - '51 87 C9 0F 24 E5 2B F7 D8 D9 BD 93 5E 2A 86 28 6A 1A D4 AA F5 AA 8E 5B 22 35 D3 F7 BC 63 08 F9' - 'F6 BF CD 6D 47 8C 0F 27 A5 0B 03 37 4E B1 08 4B 26 98 D5 D7 4A B6 51 68 6D 97 01 70 14 FC F8 DB' - '21 A7 F8 F4 CF 9E C5 6A 18 6C 5B 4F 07 EF 78 78 2E 80 BD 40 C0 6A 5B 69 14 D8 76 D5 06 FF AB C6' - '2D 59 40 99 51 34 A9 55 72 95 5A 57 2B D5 5F 9C BC E5 55 5E 2A 85 4B 85 A0 EE BB AB 97 2E 6D 4D' - '5B B4 B8 59 05 7C B8 55 CD E2 07 94 1B 80 E5 95 EC B7 0A C3 70 87 FA 54 F9 88 93 1A 81 86 D5 0D' - '99 B5 A5 C8 5F 41 72 D5 2A 74 AD C3 3E CB AE 4C 86 13 00 3D C3 71 3A 30 A5 B2 D9 61 C9 02 5B A3' - '82 66 35 85 64 BB DE 11 98 7E 66 5D 54 39 23 2D 6B B6 69 6E 40 55 59 11 EE 4F 1E BB 60 44 56 BD' - 'F0 5C 3F F6 6C 40 7C A8 8C 3A 71 9D FA 86 A8 7D 5A D8 D5 8D 4B E3 86 3E E6 03 47 19 E7 E6 AD 41' - 'CE E5 20 E1 2A D9 41 AA 6B 1E DA B1 57 CB 31 56 AD B0 33 4A AF 29 4A 16 50 A0 9F E7 E8 63 C6 74' - 'C1 11 05 DE 55 62 07 35 2C 83 18 CC DF 9A 7A 03 0D 04 99 B1 EE 8C DA CF 98 C5 71 6E 7B 7C B3 0F' - '4D E8 64 EB D1 D9 F2 CA 85 70 30 41 48 14 91 4A 83 1B DD DD 18 D9 7E 69 91 2C 2A F1 B0 6C 36 43' - '54 1E 83 74 DA 83 F4 B7 1E 11 46 C6 59 9E EA 40 41 56 01 FC 6B FF 81 5B 09 86 8C C3 08 B1 07 7A' - '1C 0C 2C 58 6D 16 17 7E 29 10 62 15 FF 9F 4C 42 A1 D5 13 73 CA A9 18 A9 7B 81 C7 D4 B3 B3 FC 5F' - '80 6D 7A 99 0E D9 26 2F 22 EF 1C 7C 97 B3 0C BB D8 B2 62 53 F4 A9 E2 2E 86 02 18 21 9E 93 CC 1A' - 'C3 B6 79 69 96 B4 E4 9A D6 6B 32 96 7F B9 A5 BA 2A DF 9D 2C E9 C7 D8 91 92 79 A9 A6 CA 7E BD CD' - 'E1 7B C1 26 BF AE 35 4C 2A 05 55 14 79 C9 C3 CC C0 60 39 78 81 EF 68 A7 C5 0E C8 E3 1D 32 C7 7B' - '99 CC 19 D7 D9 DA 22 5C 92 E2 93 1B AE F6 74 B1 65 AA 0B 15 4D A1 AF 8F 40 AA AD 7F 7A AC B8 05' - '59 FA 96 C0 40 3C C4 B2 0E AC E7 A8 70 05 1B 5E 22 6E 18 90 25 21 DB 13 0F 11 48 B3 81 B8 DD ED' - 'AA 2F 93 20 5C 7F A3 C9 5F 1F CB 9B C8 FB 47 24 97 AB FF 73 FD BF F3 D9 9D 61 89 35 71 BD B3 5C' - 'E3 CF 22 F0 CD 9F 34 2E 47 90 3F A0 6E 92 9D 2F D7 2A E4 8D 2E 48 F2 44 DE 90 B3 E8 FB 4A FC 16' - 'FA 3F 48 DB 8E ED E6 C7 66 E2 9B C8 C8 F4 37 CF 1C 65 12 11 8E D1 33 F9 2A D8 08 A5 D8 46 11 E9' - '25 8E 43 1D A7 75 19 1E 6F DF 56 7F F7 0E DD 02 86 83 24 73 C8 09 20 C9 1D 9E 8F 44 3B 50 3B 32' - 'EB 49 D4 23 1C 12 92 BB 5B EE 07 52 EC 16 2A 0F 05 46 5A AF C5 81 31 AB 52 B6 34 ED 4F 23 8E 56' - '98 62 CC 91 19 A5 63 B0 E4 49 BF 93 80 CE 4E 38 CD C0 9C 5C D5 3C 7C 1A 06 72 9D 48 E7 8C F3 8D' - '1A 68 2F BC 4E CA 42 F8 E9 0A 48 7C BE 20 C8 26 04 33 01 53 34 DA 8B 0E BB 22 7A 8F E7 1C 85 EC' - 'F1 89 66 69 96 AD 4A DB DA F6 5A B6 13 2B 1B E0 6C A1 FE 65 AB 4F CF 3E 8D 84 A8 2B E1 2C 70 81' - 'E4 DE 13 E6 BE 09 4B 9D 74 67 05 79 46 0F 26 39 F4 2F 55 78 92 E7 63 1C 7F CC F0 EB 34 23 05 40' - 'B1 24 30 DD A6 D3 CE 0C 9A E7 83 EE 50 46 FD C9 7F BF DD 22 4A 61 AF E6 FA 16 F5 B6 FE 87 AF 2A' - '33 82 39 FA 03 90 30 8E 30 A1 61 A6 B1 6F D6 81 6B B4 7E 7A 0E 89 70 5D 4B B3 F8 C7 65 3E 26 C0' - '49 49 BF 5E 5B 5B 34 5D D4 B1 D5 F7 20 93 7E 60 88 A5 81 43 4C 09 80 40 29 61 48 FF 53 46 21 07' - 'BE 37 5E FA 48 0D D5 17 03 BC 95 67 BD 36 9B E0 0E 18 B3 90 57 F3 B7 D9 BD B4 16 75 73 46 4A CF' - 'F7 B1 C2 40 9C DF AC 86 2D 70 3C 35 38 A9 7D AC 40 A5 67 29 CF 16 0F E0 5A 46 0B 9C B8 96 5F 9E' - 'FD 42 9C 63 19 4C 03 F5 8A 25 B7 6D 6B A9 4E B0 3E 24 97 B3 AC 44 8A 1B FA F0 01 F7 32 AD 60 84' - '96 C1 31 2D 7C C0 CB 68 58 C2 51 35 B8 FA 83 0C 77 16 35 63 59 C6 EA 9E B8 E3 FF 33 A7 E3 30 99' - '53 45 94 C7 89 52 03 21 32 19 6C 39 FD 12 D1 EB DF BF 2E EF CF F4 FA 7F 55 AE E4 A1 23 A8 69 62' - 'D8 B5 A2 A4 88 30 52 5A EF CE 63 50 F5 9D B4 66 02 3B D0 29 75 07 CE B0 B1 C4 C9 AB 58 F5 65 29' - '2E E6 7D 9F AB 7C BD 67 B8 42 3A D9 1A CE B0 6B E0 DB 6B A9 59 B4 88 51 69 16 A1 F1 02 3C 83 E2' - '1C 6B 2B 76 16 8B D0 D8 DF 51 74 56 7E 84 F7 41 60 46 AA 37 86 8C 0D EA D7 55 53 95 84 73 8C B1' - '8E 1C 2E 35 68 D1 A1 C6 8B 95 AD 50 AB D4 0C 3C F4 A3 DC 1E A5 66 6E C6 CB DB 51 18 C6 E1 6D 9C' - 'F5 8D BF AF 60 41 D2 98 F9 F6 BE FE D4 EC C1 6D 46 12 64 0C BA B8 86 7B D9 44 CE 2B 01 5E B0 E6' - '3E 5B DE CE FA D5 58 17 D1 95 CA AA 21 5F 23 6D 33 A6 14 7A EF E9 6F CE 54 F4 AA 71 3C C6 25 D5' - 'C1 AC 4D D2 FE AA D5 F7 F8 E7 68 47 94 AA AE 92 E5 9F B2 35 F2 B7 15 BA AA B5 BA 6B DB B7 8E 26' - '90 FC 62 6B C9 BE 4A 95 F2 6B F2 E7 C0 54 9A A8 15 40 AB 03 7D 81 09 E9 0B C5 28 8F 50 A6 09 EC' - 'F6 0B 33 09 02 C6 C8 2F 65 B4 68 90 28 33 CA 4A 98 6A 28 34 01 54 18 48 6F 50 43 81 A6 68 68 7E' - '53 F2 9F F2 9F 4A FC EF 79 1A 7E DA 5A 88 DC BE A1 F9 6F D3 3B 33 E7 3D 53 E0 3B 53 E0 3E 03 45' - '06 BE 4A E5 8C B9 E5 19 73 2E 70 46 6C F2 8F E8 79 67 B4 66 8E 9C EA 4F 68 CD 1E B9 9A 3D 73 DA' - '38 73 F4 97 60 E2 CE 68 DE CC 41 E6 9D 79 D8 19 23 14 75 46 3C F3 4E 0C EC 4E 10 E1 0E 6C E0 4E' - '78 C5 98 B3 85 31 66 1C E1 4E 00 D1 1D 91 F4 1E 11 F4 1F B0 FA 8E 60 E2 4C C9 FF 4F F8 7A 87 A8' - '7A 27 F7 3D 13 86 3A 83 CD 3F B9 E6 9E 71 E7 9C A1 99 3A 13 D4 3D 43 F6 1F F8 E6 0E 60 D1 9C C9' - '91 3A 63 D6 34 06 84 EC 4E AB D8 BD 9A F9 C7 F8 3D 83 4C 75 87 56 75 87 D8 65 8F 50 F1 8C B9 E4' - '19 73 FC 9E 99 EA 19 F3 E3 33 E7 C6 66 4E A8 EB 4D 41 F5 97 87 5E 78 67 62 76 26 54 EC 0E C8 E7' - 'B6 4B 9D 9D 78 76 BB B5 CD AF B6 68 CE FC F6 CC E9 96 3C 33 BA 32 C6 74 CE 99 C3 DB 33 A7 98 79' - '67 98 66 0F 30 F3 0F 34 D0 1F 49 EF 19 C3 4C 5E 1E D9 F0 9E 89 99 2E CB C2 F0 F4 8D 31 A6 3F D9' - 'A6 3E 93 EA BF EB 58 2B F5 9F 59 F6 1E B9 ED 97 47 C6 67 CF 8C D4 1F 59 A6 3E C3 EA 2E CB C3 4E' - '7D 87 D6 69 CF FC 68 0F FC 7D 67 D6 5E 17 87 CA 69 0D 29 78 6A 0B B2 E8 BB 34 E6 A0 FA CF AC FA' - '8D 31 76 69 8D 39 79 81 5D 22 FD 45 E1 F5 9F 57 FC B3 89 0F AE 03 70 1F 2B 81 F9 94 7E 7D 08 C1' - '68 D9 4A 52 A9 94 A0 81 43 75 C9 2F A1 29 AA 55 26 E9 E6 A3 F4 B6 6D 43 E4 57 9F FD 00 F8 95 E0' - '4E E7 76 6E 73 AB D6 6A AE 97 EA A8 3F D8 1C 54 EF AC 0E 7E 95 C2 03 82 07 A6 8B 86 4F 5C 3B BE' - 'F4 7F 33 AA D0 3F 25 9E D7 C9 D8 CD 7D 3F 4E 46 CB 5B 61 E2 47 2D 48 57 DB 57 EB 1D AD AD 5A A7' - '2B 87 55 72 70 AC 20 22 05 5D 7D 5C 5B B5 55 CB 4C AB 1D AA 7C 6D 28 68 FC 26 5D FF 82 B2 8C 95' - 'EF 9F 66 CD BC C9 53 18 EB 45 91 BB DD 1B 70 C6 0E FA 5B 7C 58 CD 50 9C DC 2D A6 D4 C7 FC 0F 2D' - 'FC 13 AC 35 47 56 66 EA 8C EC D9 33 F5 86 8B D3 49 2D 42 C9 23 C0 FA 7E 9F 9B 32 BF 37 55 D9 EC' - 'C6 6B 5E 9A AB 0B 3D 48 29 71 20 54 93 10 8B 47 4E 29 6B 29 B4 06 8D 69 46 5B E3 76 C9 47 46 4D' - '1A 51 E4 5A B4 A3 62 8D B7 99 EE 4B CC 7C BE 6F 46 4A A6 2B 35 5A 95 65 62 FE F9 02 C8 7C 5B 87' - 'D5 BE 16 05 F7 BC 2B 9E 7A C3 F3 F6 59 43 A5 98 18 DC 75 75 9E 94 E7 9A 87 36 CB 7A 1F 33 10 36' - '6A F0 AA D9 AB 2C 2A 3A 3B CA FE 8A F3 38 F2 BE C7 E7 A1 58 0F 94 3E 68 2A 00 EA CC D0 79 B4 4A' - 'F3 79 C3 86 3B 34 2A 67 CB 32 F7 61 64 EA BC 9A 78 0F 20 B0 C1 91 F0 C8 C0 F9 07 CA 2A C1 83 60' - 'AB B7 D2 DE D3 C5 DF 16 8D 4B 6F 00 B4 B1 69 F7 CB 1E 00 5F 75 02 27 6F 5E BE B4 65 6A 40 83 BA' - '2B 75 89 C9 C9 F2 E2 B3 61 81 7F D5 AF B4 55 DA 7D 57 69 5D B1 09 A7 0F CD B0 7D 75 A3 78 C7 05' - '58 5B 5B 0B 83 04 3E 29 81 05 86 D6 A8 5B E0 FE 94 D5 A9 A8 BC 67 E5 73 C6 36 36 37 1F C0 3B FD' - 'FE 7F D0 F8 7E 0D 33 33 BE 35 A2 F0 59 30 C0 C3 24 07 39 0E 38 2F 9C DE AB 05 DC C9 E6 38 BE E2' - '98 55 3E 5D 5B 7A 71 53 5E F0 62 CA BE D3 70 86 F7 72 7F 5B 22 9D E4 31 0F 02 E9 D0 5F D4 B0 9F' - '50 FB 42 15 67 00 CD 31 90 FB 71 21 E2 D5 9B 01 E0 78 0A B3 0A 82 58 CB 05 A9 88 E5 2C 26 2C 22' - '92 3B 36 A8 35 BF 11 05 9C 1F 4A 0E FF D8 B0 F0 65 8D DB DE CA E7 16 9F 6B 2F AF 99 76 11 03 8C' - 'CB 5C B9 16 9C CC 0A 11 99 08 98 6C CC 61 12 A8 D2 9B 30 29 8E 69 3E C1 4D 94 4A 62 BE 38 F7 98' - 'C5 E6 19 67 24 B8 67 EF 71 C7 F9 FE 34 7A CB 61 D0 BE 25 F3 19 8E 0F F0 49 3E 90 2C 78 87 89 BB' - '4F 60 B0 D4 03 8B 13 F3 F8 D1 C8 13 E0 FE 29 E2 9F 54 FA 8F 88 4F CC 21 33 E8 8E 17 DF 1E 01 E1' - '99 1E 1C 67 2B C1 CE 97 98 E4 CB 77 83 E4 B3 4E 7A F9 63 BA 83 27 65 CB 82 9D D1 A0 1C C0 78 04' - '19 59 8E E3 91 A3 1A 32 9B 21 A3 E6 36 49 77 B4 E4 4B F6 7B 12 EC FC 81 4E 42 05 29 02 82 00 13' - 'D8 25 F9 67 38 3F 4D 1E 83 F4 CF 0C 91 19 D5 C7 CB 66 DF 38 F1 CF 79 A0 33 63 9C F4 46 6B ED CB' - '4B 68 A0 32 99 61 9A E2 8C 88 E3 88 B8 D8 D9 4E 2B 18 AC 5A 9D AB 7C 8E A9 77 FB AA 3A 2E 0F 06' - '8B 2F 95 91 A5 E0 4E 64 A7 06 30 62 C7 9B 29 F4 E2 66 FB 2C F0 3E 81 82 8A 8A C2 C4 F8 7C 1C 2B' - '66 FA F6 A5 5E C2 00 11 14 11 40 20 1A D4 BC DE 93 6C 4C 9A 6E 27 8C 9D DF F8 69 B7 17 A1 78 A8' - 'C3 5F 1F 6A 19 D9 86 E8 20 13 F1 BD 6A 18 61 07 F2 C7 E2 DF 97 CB 1C CD 36 9A 63 62 D1 88 1D 06' - '86 C7 A1 D0 B1 05 A6 EE D0 E8 25 A4 21 68 6D 76 BD 03 58 57 A7 3C A8 E8 26 7E BF F2 D7 0B FE 65' - '6D 76 BD 60 44 61 D3 03 0C 84 C0 C6 E2 93 D2 EB FC 7B 85 F3 17 E8 18 FE 0D 73 E2 34 AB A5 E6 B7' - '2B 2E D1 3F D9 B1 A2 A2 CC E6 D3 8B C0 1D 3C C0 70 74 09 41 90 26 49 37 C0 C7 12 4E 8B B2 89 69' - 'BF BC C9 64 EA F7 F6 DE 8F 2F D0 C9 57 32 6F 20 23 69 AA D0 68 EC 46 8B C8 C7 8C 7F E7 0D 8F BA' - '8F 4C 9F E7 B7 DD 3F 7E FB 6B A5 99 50 DE 2F C9 8F 0F F4 AD CE E7 CF 7C F4 5C 2E 79 4D 37 27 BB' - 'F3 FB BE 8B 79 CD C8 73 A2 51 53 53 7C 32 B5 D8 EB 5B 59 A0 9E 4C 2E DD 84 1E 3B 38 AE F7 9F 96' - 'BF 8F 77 9A 2F 4C 05 FA E4 F7 72 95 89 7A B4 BF E4 19 67 8F 5C C8 BD 28 08 24 08 14 80 00 11 40' - '22 B1 55 75 11 FC F7 53 BA 7B A7 F0 34 E6 04 BE 97 E3 04 75 A7 E5 34 E7 E6 2F 63 5D EF 76 D5 0F' - 'DD 63 38 97 15 37 36 E4 F4 91 72 E5 27 97 57 F2 6A D8 B7 F2 2E 42 E3 C9 A3 17 87 CB 4B 71 71 32' - 'C7 26 7E 43 DD 3F 51 BA 56 97 76 6F 5B 65 76 65 E6 25 AE 94 6E F9 57 8A FF C4 04 2A 04 52 10 30' - '8C A4 9B 62 C0 4A 93 02 C4 BE 27 39 FC 3C 1F 4D F7 DF BF C3 F1 F3 0D 8F 14 65 A8 2F 97 DD 74 AF' - '0E 6B A6 1C 50 4A F1 07 8E F3 56 BB DC 76 0B EB EC F8 87 88 5E 1D 39 D4 9E 19 9A 3D 63 1E 67 CC' - 'F9 CF 9C F9 78 79 2F CB B3 AF E1 3A 13 C0 2C 51 AD A9 4D 1C E2 6B F4 67 43 2F C9 FC 93 44 23 2F' - 'B8 41 B7 8F EB CD 0E B0 93 81 FF A3 1F D1 1D 2F B0 48 DD A4 86 1E 50 4C 60 1A 46 08 C8 A6 B7 97' - 'BB FB 2D 58 B8 A0 37 FE D5 B0 2A 25 14 A5 00 80 04 00 3E 43 F2 74 79 FE 3F 54 4A 0E 48 DE EF 7E' - '8D E8 9E 1B CF EF F3 F3 FB 2F DE 7D 24 46 8F 47 07 A2 CF 8A FF F1 D2 E9 69 E0 33 FF 1B 59 0C F9' - '3C 83 0D D9 D7 EA B5 7E 27 50 B8 9D EB 8C 6A 4A 75 86 06 49 0C 26 14 DB 75 B0 AB CA EA EA EA AA' - '18 5D 2E 51 79 5B 59 CA AD 73 81 19 B8 2B 09 D2 CC C6 9B 4D 54 EA 73 7E 56 9E A1 A0 2B 4A C2 21' - '56 6A 0D 39 A6 AA C7 D4 B1 1B 18 BB A3 F7 8F 70 7B 2F 79 BF E5 8F CD F5 BE 83 6B E8 74 8F 3E 87' - 'A2 58 46 09 DA 93 A3 AE F5 99 0A 38 71 E9 F8 54 6C 5E 75 7F C6 10 FC BF 36 C7 45 B2 3B 53 66 3B' - '53 67 3A 31 13 54 62 42 D3 68 3F 11 90 89 84 AC 80 BA C5 16 BB F8 9B B6 5B 0E 7C DB 4C 91 B7 19' - '23 6F 32 46 E0 64 8F C6 64 8D C4 C9 1B 91 92 3A 5B EA EE 8B 92 37 53 24 73 A6 DC 63 CD E0 C9 18' - '6F 81 7C 85 DE 4E E0 DE 8F E8 74 C7 1A 7C 47 C4 71 E6 58 EA 8F 4C D3 9D F1 94 3F 59 E5 1C 91 EA' - '1F E4 D3 9D 79 D6 1E A1 E6 9C 31 D8 9E A1 A7 33 26 64 BB 3D 63 C8 3F 91 98 3C C3 C9 3C 93 B9 3C' - '73 1A 63 4E E8 F4 0C B1 EB 1D 29 72 7A 07 F5 3B E3 BE 3C B3 28 65 0E A8 EF 4E F8 CA 1D E1 FC CF' - 'E0 79 67 5A 7F 53 DD 3C 13 AF 39 CE 0E C4 31 31 FB 0D 29 E6 13 FF B9 83 48 CA CC 91 70 72 52 51' - '9C 33 A7 D3 01 B2 45 0D 40 01 14 14 8A 08 04 7C EB 08 F2 1F 21 FC 49 E1 3E EA 75 DC 07 26 F8 B4' - 'D1 9F 8F 1A CB D7 99 33 BA 97 74 F4 8F D9 BF 60 F4 4F 40 F3 EF 3A EE 1E 6D DB BF 50 F3 2E D9 E6' - '1D 77 23 AC 35 C1 E6 D8 68 06 83 64 93 F0 73 AF 2B 7F CD 3E 52 46 EA 4D EB A5 B8 E2 36 68 3B EB' - '24 4B 4F 4E AD 62 55 B1 23 CA CD 92 50 7E B4 14 53 0C 4D 7A 5D B8 70 39 FD 82 45 0B 3F AB E3 0C' - '07 09 E2 A4 4E 89 B8 1E 89 F8 CC FB D7 B4 C1 F1 D7 7C 7C 70 42 34 9A B9 D5 7B FE F3 41 E0 22 AD' - '41 E9 C9 E3 9C A1 C8 E0 E2 1F 2B 8F B4 3D 19 B8 0E 00 76 9B 6F CB 0C 78 7B 3D 01 E6 06 05 98 48' - '6E A3 C2 C3 1D 15 A3 97 2A 4F C5 E9 3D F7 89 91 FE CD 36 7A 30 12 AC 40 4C 3A F8 39 51 AF 65 77' - '76 7B D5 DD 3B 7D 8B C9 AF 6F 69 CA F6 2F 5E ED EE DE F5 FF D6 23 AD 14 8F AD 61 D5 9B A7 25 FF' - '3B B2 30 A3 B4 7C 27 C2 7B 97 C2 A0 D8 4A CB 06 6C 27 EA DA 95 7B 05 79 DD AA B5 6D AF 08 6A 0B' - '2B D5 4A DC CF EE 7E D2 AF 9D B5 D9 4F 68 9D BA 55 25 DB DF 5D D6 12 D9 42 97 97 B7 CF ED 9A C4' - '33 70 D6 D1 F1 5D 85 D8 52 8F 30 76 2A 07 83 DD 4A 81 50 27 46 4C 4E C3 27 6C 46 89 BC A7 08 E5' - '26 A6 BA DD 6A 89 FF EB B1 5C E4 72 B0 CA 8E B5 67 23 19 6B 18 02 EC F6 76 96 1E 48 6E B3 86 E4' - 'DB 6C ED 4B 02 C0 9C 21 1C 23 86 FC 4A 08 F1 1E 37 83 76 33 E3 3F 08 9B 91 26 24 C4 98 D0 6D 76' - '9B 4D 1E D3 69 B4 D9 DD 76 79 43 D2 F6 5B 2C 67 76 2F DC F6 99 F3 FE 20 69 70 B4 D2 C6 EF E7 9B' - '10 47 09 32 13 33 30 C9 98 06 0A 89 52 49 09 68 20 E5 7D C6 7F E0 62 EF 37 4E D1 F8 DD 30 78 07' - '16 EF F8 B7 A4 C9 3C C6 72 A6 A3 4C 9A C9 AC AD 04 16 AC 0C 32 03 73 E0 70 1B 80 DC FC 98 E0 FD' - 'C7 FF 09 F7 6F C7 7F F6 77 D5 CA 61 5D 31 0E BE DB 13 BA 6D 7F 3D 3A D3 4C BF F3 45 EC 49 D7 2A' - 'DC 6E 3B E3 15 A5 29 55 B0 02 00 81 14 A4 52 92 CD F4 6E BD 1B C9 74 BD B7 A7 ED B3 BE 06 98 D3' - 'B2 B2 CD 20 52 EE CE B9 E9 1C 7A 6C AB 9C B4 4A 18 4C 09 86 66 66 60 84 92 80 62 4E D3 0E 04 92' - '52 19 48 86 59 08 89 80 80 94 82 08 49 99 88 48 19 82 12 58 66 14 98 66 66 19 62 09 58 86 56 59' - '9E CE 70 CA 4B 10 C0 10 41 D7 CA 18 52 62 44 A2 44 90 EC E7 0F 61 80 C0 C8 90 90 4C 21 44 10 93' - '00 CB 04 12 92 CA 76 F0 81 84 A4 08 1C FC 2E 04 66 22 60 62 61 24 62 58 A4 28 1F C6 97 46 32 41' - '32 51 10 44 04 04 A4 42 13 4C 0E 13 02 E0 12 20 25 26 09 02 20 71 18 99 28 89 84 A1 91 8E C6 03' - '09 04 49 32 4C 44 04 C0 32 92 14 A4 30 C0 C8 10 92 49 02 41 04 91 D9 41 FE AC 8E 45 A0 88 64 26' - '18 59 52 04 84 34 B0 AE 03 7D 2E 02 52 60 A6 09 18 65 28 74 60 4C 00 5E 34 18 0C 98 50 C4 84 C1' - '01 ED 30 21 80 24 65 65 08 A8 13 BD 0C 3C 91 8D 7B 94 00 CA 13 0C 23 2C 25 22 40 49 42 55 2B 24' - '10 04 CC 13 50 4D 14 CC 25 24 10 CA C3 2C 83 2A 44 44 91 24 84 B3 08 4A CA B3 01 4B 41 2B 21 0D' - '33 04 2C 41 A8 87 12 B4 04 A4 24 31 10 84 24 11 21 9F 06 14 80 A6 98 60 62 52 95 92 25 88 21 26' - '58 02 11 A4 28 1C 12 18 12 06 65 94 95 22 01 9C 18 00 C2 12 04 24 88 44 2C C1 24 AD 05 04 92 25' - '2B 0B 22 4C C9 33 01 32 CC 23 04 B0 B2 0D 29 30 49 28 C4 09 2C 0C C0 C1 0C C2 A4 AC AC 53 03 0C' - '9B D8 13 09 0B 10 93 33 22 4A 48 CC AC CA B3 04 92 79 7D D5 8F B1 30 EA DD DF 6C EF 0E 5D C8 7C' - 'A4 C9 DC 9E 95 D3 FD 51 A6 A7 19 5D 21 75 0C AC 2C 1F 12 39 33 A1 ED 1D F3 E4 97 9D BB AE 94 EA' - '2D 5C 74 67 53 68 C5 12 BD 2F 54 97 50 FF 4A 79 39 62 A2 ED A4 14 6C 63 B1 E8 0B FB 21 33 4C 13' - '03 0B 0A C1 24 DD 99 7A 9E 7B 57 E7 3D 3F 87 E1 E5 31 83 75 A3 A2 01 5E 98 19 0C 86 43 66 7B E1' - 'FF 75 C7 58 9E D3 4C E3 FB 18 FF 7A 44 CD 22 DC 6C 81 FD 72 D3 E8 3F 58 E0 D2 C4 71 5D 43 A9 18' - '49 94 24 86 64 19 86 64 20 84 65 09 26 13 94 85 30 C8 90 CA 49 25 29 23 03 04 29 29 14 0C 92 30' - '40 CB 2D 04 42 50 31 0D 34 90 4A C9 01 49 40 13 0C 95 32 40 90 15 14 01 24 2C C2 10 90 1B 52 41' - 'C0 4B 48 04 04 38 21 C4 A1 30 11 2B 44 C0 90 91 80 80 C0 42 44 23 4B 38 C6 06 28 92 66 86 61 82' - '60 19 94 A0 60 08 12 21 6A 80 64 21 08 09 46 20 48 2F 2A 44 30 10 29 27 91 80 70 CA C7 DE 06 14' - '70 12 49 2B 0C A9 01 50 33 28 40 1D D3 58 54 C2 C0 10 D4 21 29 44 A2 45 42 13 00 4C 21 04 03 40' - '93 13 21 2C 11 04 C2 33 0A C2 C2 43 22 4C 0C 41 30 04 10 11 30 4B 10 B1 01 12 84 C3 44 90 34 11' - '24 84 31 2C 04 01 30 4C 30 42 4C 4C 2C F9 FC 03 88 88 19 82 29 96 24 18 0A 62 86 08 89 26 01 94' - '99 88 24 92 16 24 99 28 02 02 0E F9 A2 30 91 30 4C 01 04 10 04 8F 35 47 71 83 6F 93 06 51 26 21' - '21 82 60 5A 82 40 A5 7E A5 30 B8 02 09 18 58 46 66 4D 1E 27 A5 DB FF 14 58 FE FF B9 6C 96 4F 81' - 'D1 99 B4 CA 14 1E 82 80 4B 17 15 ED 60 FB 5E 4E 18 95 15 74 E2 2F F0 F9 BD F7 1A EC 4E F5 9F AE' - 'B5 67 F4 8D 99 BB 9B 61 B7 9B 79 BF 9C 91 C9 9A 63 6C 3E B3 BF 36 43 BF 36 D3 6E 36 F3 BF 3E C3' - '83 3E B3 C1 31 87 82 6F 47 82 6F C7 82 6A 0F D0 7E 73 F3 9B F1 E1 1B F9 D1 1E 11 A5 3C 33 4A 71' - '46 94 D2 9A 43 4B 63 B1 E3 B1 76 B1 C7 32 C3 8E 2E 56 E5 71 D9 91 2C 87 22 E5 8A 86 10 18 97 E8' - '0A 45 D2 1A 43 48 69 0D 21 C6 1A 43 A7 3A 83 48 70 66 90 EC 0E 43 FB 5E 19 7B 23 92 39 23 30 76' - 'C7 28 72 C7 2C 76 F1 6B 8B 5D 70 6E 55 5A 4D 55 7B 72 2B D6 4B 06 CF F1 76 8C 62 DC 8F FE F8 2D' - '03 AB 6A CC 03 69 4C 87 05 41 14 A5 0F A9 41 15 BB 64 F4 B3 24 64 72 FA A9 C4 9C 33 86 70 CE 19' - 'C8 55 FB 4B CA 18 6A 92 EA 17 D2 3B 33 C2 D3 AE A3 85 22 69 CF F2 75 47 EF 3A 73 A7 3F A1 FC 0E' - 'B4 F1 CF 54 EB CD 88 B9 2E 4B 92 E4 B9 2E 4B 92 E4 B9 2E 4B 92 E4 B9 2E 4B 92 E4 B9 2E 4B 92 E4' - 'B9 2E 4B 92 E4 B9 2E 4B 9C 5A DC CE 86 24 17 20 64 0C 81 90 32 06 40 C8 19 03 20 64 0C 81 90 32' - '06 40 E7 CE 7C E1 CE 8E 47 48 A3 D6 67 AD 51 28 72 06 48 E4 4E 4B 15 92 32 26 44 C8 99 13 22 64' - '4E 1E 46 33 73 54 42 8B D2 AD AE 95 8D 29 D2 99 19 15 C8 AE 44 C8 99 13 21 A4 D2 19 02 E4 E9 0E' - '90 E9 0E 88 E9 0E 8C B9 3C A2 F0 BC 2F 0B C3 E1 32 C7 90 5E 17 85 DF 6B 96 78 73 93 85 D1 ED 17' - '47 F7 2E 8C E9 74 7B 86 E3 F1 FE 9C BD 77 5D 67 DC F5 9C 7E 51 DB 7C 8D 69 BC D6 F3 C3 CD A7 3D' - '40 3E 5A 64 32 61 32 60 5D 46 54 E4 A9 57 18 32 3A 00 FE DA 7E C0 F0 06 CC B3 C4 1F E0 E0 14 93' - '3B 7E 40 DC 09 30 CC 98 E4 4E 76 03 3B 8E 82 6D 0E CF 68 4E D3 A0 C6 0D 75 CE 79 D8 07 AE 49 EB' - '02 C3 E0 96 71 89 07 11 89 1F 18 63 7F 68 7E 59 9E 6E A4 63 CA AE 72 08 4E B6 DB 8F F8 DA FB EB' - '3A 39 FE F3 0E 9B F1 6E 7E 4E F9 8F 47 48 07 4B 12 43 12 61 DA 4C 47 27 E2 95 9B 35 7A 5E 18 E9' - 'B1 F1 B1 09 C4 E3 5C B7 1B 94 69 B2 1B 29 AE F8 7D 58 FB DB 73 84 0A C6 AF 6C F5 1F 64 6E 63 96' - '4C 75 A1 98 40 C7 85 2D 01 78 2C 18 8A 18 18 AC 08 6B 80 6D ED D4 DD D5 87 8B CE D6 09 97 42 14' - '50 A0 B8 2E DA 3B 90 69 6F AE 2B E8 8B 80 AF 07 02 90 5E C6 DD DD C1 41 1F D8 84 F0 93 09 90 32' - '06 12 60 3D BB DA 07 4E 46 62 60 C7 F1 E7 8F 60 E3 C2 C3 37 FD 5E B0 51 41 07 2C 4C 0B 1C C0 58' - 'E4 CB 37 96 6E 8C 20 E4 2A A9 C4 13 B2 B2 A1 EA E7 F5 86 64 E4 E3 31 3F 8B EF E2 F6 6C F0 64 1E' - '74 FE 73 92 F8 A7 C5 3F B8 73 58 39 82 AF 8E 21 85 B0 61 B6 0C 71 0B F2 C6 EC D7 17 77 CE 60 45' - '55 82 A7 75 B1 3C 2F 62 DD 80 F1 DB C5 8A F1 52 74 E2 03 0E A8 07 6C 87 68 F6 1F 6C 97 75 5C DD' - 'C0 89 B0 DE 00 43 0A 96 A8 D5 FC 7E 16 DC 03 9D 24 99 29 25 F8 7E 6B 22 FA E3 E3 E1 F3 5B 0C F7' - '7A FD 93 AD D0 F8 CF FA 29 F4 41 F6 95 DA 56 45 57 A5 5F 43 F3 81 0F CF F7 D4 9D 0B AB 03 96 A6' - 'AC D8 DB D9 3C 2B 8B C2 8C 18 3E C8 B0 D2 A1 FD 55 D8 3D 4E 5D 66 5D 0D 2C 99 39 67 93 0D 8A 4A' - 'CB 0B 04 A4 24 24 42 C3 29 32 04 8C 0C 2C AC C8 13 03 13 01 09 40 9D 9A 4E 09 3C 67 72 FB 27 8A' - 'EB 1D 38 66 17 3C 60 60 93 D9 84 8E 18 99 82 53 FE E7 46 57 20 45 03 F2 24 0C 04 89 32 B1 32 4D' - '20 50 B2 C9 32 0D 2F 46 9E AD 30 64 02 40 D7 48 67 26 C9 30 65 66 12 11 21 91 86 46 49 42 81 20' - '25 20 08 3D DF 71 DB FB AF 79 FE 58 CC FC F7 7E E5 C6 62 7A 27 40 FB A6 E0 BC 37 4B 4A B4 B8 59' - '83 29 C2 35 2B C8 32 B3 02 D2 84 90 24 92 34 2C 13 21 02 D2 85 04 B0 2C 12 05 13 24 CB 30 C2 41' - '30 AC 30 32 30 B0 4A 90 40 90 C3 30 13 09 03 02 4C AC 30 04 CC 42 12 48 04 90 A9 42 41 20 4C 24' - 'CB 10 31 34 83 2C 09 42 94 92 4A 04 32 24 42 24 81 20 4C 70 93 D5 A6 04 72 24 35 30 AC 32 6D DB' - '0C 93 30 48 32 13 42 26 4C 86 4C B0 A3 4E 77 E4 A7 D6 67 96 41 75 4C EE E7 99 53 EC DD B8 D8 82' - '1D DE 11 AE 9F B9 E4 33 FB 82 F9 07 86 7E D7 6C 4D 79 C7 2C 8E 31 FA CB 72 DC 93 A8 C1 DB DF DA' - '60 26 98 18 64 86 4D CE F0 19 CF 15 8F 1A 0F 58 89 88 C9 50 95 09 90 1F 50 6F AE C9 B1 14 3C 04' - '93 24 C3 24 0C C2 A4 EE 2D 01 DF CF 1B D4 ED 72 B6 5C E8 A0 DF 7B 68 90 31 DE D4 EF 37 85 37 BE' - 'C9 C2 06 45 0A 32 88 F5 C4 71 51 C5 4F 3A 9E 52 72 9D F4 1B DD EA 6C C4 F4 1E CF 78 9E FD 3C E7' - '65 DA F0 7A DE BB 93 40 D9 CC 4B 47 0F F5 23 59 A1 A4 46 F5 1D 24 74 D1 5A 8E 27 C8 1F 5F D3 F0' - '9D 60 B8 F5 51 EF A3 5A 8D 1A 28 91 BE 11 9B 47 AD A6 0E 1E B3 50 EE 67 DB D6 7B 57 9D EC 50 68' - 'B2 3E C7 DE B7 C7 FC DF 3E 3B 63 8B 58 C4 C2 4C 30 26 4C A1 CC 1A E8 ED 50 E0 FA 2C 72 D1 5D B9' - 'BF 1D 87 9B 95 F9 7B FA 09 49 2E D5 FE 1F AA 8A EB 0F C8 C7 AD 55 E1 55 0C A5 1A AB 0D 36 87 DA' - '66 8A B3 5B 00 28 6A 54 2B AA 2A 68 11 49 A6 53 95 75 D5 FF 29 94 4F 5F F2 AA 35 5E 55 79 68 97' - '76 39 6E A3 6C AD E6 08 50 45 1D 25 A6 54 31 6D 0D E9 B8 7F 77 12 40 F3 E4 DA DA AE 5E 26 13 6D' - '9F F0 F2 58 BD 74 0D 7F 80 81 C3 18 B9 73 10 B1 E6 FE 1E 30 E6 35 21 B1 01 E5 18 99 46 64 28 59' - '9D 79 01 80 22 82 87 20 62 CF CC 2B B0 D0 30 6D 21 68 46 A4 7C D5 13 82 60 1D 36 9C 43 B8 F1 14' - '7B 67 28 21 C6 C4 54 C2 85 50 84 98 09 84 82 0A 40 8A 7C CC 20 60 20 88 88 59 83 FA 61 0C 04 2A' - '41 02 6B 61 1C 03 00 7A A8 38 2F 40 F9 8E D9 E7 DE C9 F8 AF 50 E8 9A 21 A6 28 92 61 92 64 99 88' - '84 82 49 DB A4 38 43 C9 F7 C5 B2 C6 E7 1E 4B D3 B6 77 C9 39 AF 49 15 1C A9 93 4F A7 46 18 62 58' - '20 F7 BA BE EE AF DD 3A 13 B9 33 BB 93 26 73 9B 3D 03 40 24 08 2A 14 98 09 61 08 08 16 24 12 60' - '59 A9 57 F0 BF EB 1B 6C 19 32 39 0E 3B D7 99 07 30 4A CC 9D 54 6B FF 9B BC E3 6E A6 6D 0D 1E 16' - 'FA 6F 0C 9A 4F D5 A5 5E D3 B1 B2 54 CD F2 B0 99 05 46 4C C0 0C 32 01 93 52 05 3E DD 21 C3 02 49' - '07 82 FA CE CF 8D 7C EE E7 2E E3 C2 CC 68 02 E8 8C 79 E2 F8 38 C9 8F EE C1 C7 CE 55 C3 25 6F EF' - '84 58 93 F1 53 27 E5 27 FC A6 C5 33 6C 12 78 45 80 8B 64 73 51 4E 8C 8A 35 E2 3B C1 1B D1 10 C4' - '64 04 61 C4 47 F9 68 9E 47 BA 8B 14 5A 88 F2 C4 62 84 59 08 E6 88 C5 88 F9 51 F2 A2 DC 46 ED 1C' - '24 67 11 C3 4D D2 78 69 C6 4E F5 38 E2 77 C9 D6 26 E9 3A 54 F5 A9 BC 4F C8 4E B5 39 94 D8 74 0E' - 'D1 57 97 87 8C C0 E2 10 26 EF 6B 25 87 7C F4 8F 68 FE 73 FA EF A8 7D CB ED 5E 89 F3 1D 32 9A 82' - '86 10 99 08 08 7A 3B B0 BC 27 C5 C0 78 BE E7 25 FF A6 37 1C F1 B1 CB 8C DA C3 47 8A 44 F7 3A 5A' - 'F1 BD 35 41 C6 2D 1D D6 22 B5 B5 48 32 E9 84 32 BA 73 A4 9D F2 83 48 36 E1 D4 87 48 1A A0 CF 3B' - 'C7 41 34 CC B3 04 C1 10 10 43 5C 0B 5D 3C 08 13 29 28 41 1A CD 1C 03 91 86 65 A4 62 4F 77 E7 BA' - '5F 61 D3 77 E7 1C D8 9E 3F F2 6B 78 9D 5E A1 4D 48 4A 45 21 24 33 AA 77 F8 D8 62 F9 8F AF 73 DE' - '61 CC 86 80 C1 12 94 3D 63 3F 09 F5 0F CD 74 1C A8 E6 60 82 06 D7 60 3A 96 36 47 BF 3B 03 B0 36' - '99 CD E7 79 76 DE 1D A9 C1 3F 0C EF BE AE F6 E7 74 71 8F 60 68 8D 71 CC 2C 4D 71 42 50 9A 43 48' - '58 1E 91 B3 35 E7 A4 50 15 47 62 78 F2 C9 A8 74 C9 AA 59 37 69 A4 57 50 77 C7 3E 7A A3 D7 9E 09' - 'C6 36 A7 17 45 BA 1D FB 7B D3 CC 3C 93 9C 3C 83 8B 99 DA A8 73 2C 12 48 9B 57 81 E8 7C 57 72 FE' - '3B CD BC 17 92 74 9F 62 F7 0F 4E FE B3 A9 54 E4 06 41 99 EC 7F C0 16 AC 13 ED 86 9F BC 6E 87 D8' - '5B 70 2E DA 5B 9D CC E9 4D D0 EC 8D 0D DB FF 5D EE D2 6A 16 65 0A 4A B8 41 E7 57 C2 A6 55 9C EC' - '9D A3 B2 76 8E D1 E5 9F 11 34 95 3E 8D 90 21 EA F5 B9 03 EB C3 60 1F 2F 3D B3 9C 26 72 58 9B 29' - '49 51 D8 28 C2 8C 38 8A 8C 28 C2 B5 D7 03 B8 08 EE 70 68 C2 90 29 24 8B E3 87 FB FA 9C 6E CD 41' - 'AB 35 AC C3 02 C3 01 12 01 12 1E 4D C4 C7 CB F9 F9 99 93 5A 26 78 89 1A 1C 10 A4 08 56 BE 68 54' - '10 98 78 8B AC 8F 24 06 10 8C 92 C9 26 85 F8 0E 88 38 DA BC 4C 77 E1 1D 26 29 E7 A5 C8 7E 0F D5' - 'FC 76 3D 8E E3 22 04 DD EE 97 3C 76 39 80 C8 C7 25 17 75 F7 9B 21 52 B5 2E 4C C2 99 33 F5 1D 21' - 'B6 E3 97 F0 AE CC F6 BB 15 CD 8B 72 ED C6 34 DB D0 BF C1 FB C9 FD 86 8B 19 24 49 0B 7E 93 29 26' - 'DD 8B 7F 9E 02 49 6A 7A AF 65 C3 1B 82 05 91 01 13 29 99 F5 36 FB 60 04 D1 FC CF 92 D8 B6 2D 6C' - '38 5D C7 76 CE EE 31 79 D1 6F 0F CC BC F2 8F 9C AD 4A BA 6A 26 D7 C0 C5 E5 36 8B EA AE 9C DD FC' - '66 F9 AC 30 60 9C 30 ED DD 54 C0 12 05 E5 CC A4 86 FB FF BA 72 34 1A 5D 0E C7 35 9B 88 FE 70 49' - '4B 01 82 BD 1B C3 48 25 41 25 4E 08 2C 41 54 EA 6A A9 9A 9C 14 10 7A 5C 12 97 98 59 88 99 87 0C' - '19 68 B4 1B 75 9C 9D BC C5 4E A7 16 C5 B8 0D 47 18 EF C6 6C 6F C2 D6 D9 D8 75 F7 D6 93 96 15 33' - '78 85 EB 36 20 E4 B1 17 D1 EC E6 63 AE 87 27 C5 34 1F 0B 43 B6 B9 62 99 45 E2 A5 67 79 AA 91 3D' - 'EA 96 BA 50 5D 32 0B 8B DD 6C 54 C8 F7 59 F7 DA 0A C3 05 03 23 E3 10 55 C7 BA ED C2 02 A6 83 A5' - 'F7 F6 B4 AC 07 13 CA B0 EC F7 11 AF 66 D0 35 DE E8 72 42 A8 36 01 BB 0B D0 BD 09 7B C0 F3 4E 9E' - '53 2B DB 12 9B A3 15 35 CC 85 D7 E1 1C F8 DE E6 1F 19 16 31 40 FC 0B FE F1 B5 7C 86 80 4F 56 A3' - 'BD D0 FB FB 94 17 DB F3 BB F0 24 82 51 08 25 10 82 49 39 F7 77 77 84 EE CD 03 BB 33 36 02 C2 88' - '9A 4A 22 61 48 4C 0C 92 06 13 30 0C 03 6D 71 2D B3 B8 9A CD 86 0E CF 67 89 75 69 B5 C4 FF F1 77' - '24 53 85 09 0D 63 95 D6 60' -} - - -LANGUAGE 0,0 CASE UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE -{ - '42 5A 68 39 31 41 59 26 53 59 A9 EB DF 7D 00 33 B1 7F FF FF FF FF FF FF FF FF FF FF FF FF FF FF' - 'FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF E0 4F EB 80 00 00 00 00 07 DF 09 40 00' - 'A0 80 50 01 F0 00 00 00 00 00 00 E8 50 00 00 00 00 A8 B1 60 09 28 29 28 42 A8 03 E3 EF 01 80 1F' - '60 44 01 00 09 04 00 40 00 CE 53 B6 49 77 BE EF 7D 80 D0 04 82 52 A9 86 D4 64 05 00 90 9B 36 00' - '00 C4 44 AD 93 63 06 64 00 98 00 00 00 00 06 C6 00 00 00 00 85 0C 2C D8 C0 00 00 00 00 36 30 03' - '62 2A A7 FE AA 51 13 47 EA 53 D3 23 51 EA 7E A4 0D FA 93 26 09 9A 62 1A 63 D4 20 F6 A9 A1 00 D0' - 'F5 1A 3C 43 46 9E 8C D5 36 69 EA 07 E5 24 C0 86 26 9A 7A 41 A7 A8 66 A6 26 4D 31 3D 19 02 34 D3' - 'D0 62 0D 09 93 34 9B 53 06 89 8D 1A 98 C8 C2 36 94 C8 7A AA 19 4F F5 52 13 D0 09 4F F5 14 F5 3D' - '4F FF 54 0F D5 3D 36 A3 D4 13 FD 53 D4 7A 34 C9 1E A6 8F D4 C5 34 7A 8C 7A A6 79 49 E8 D5 34 3D' - '4D 1B D4 F1 53 4D 49 1F E5 50 7B D5 4F 7A 4A 7E A8 01 A0 68 F5 1B F5 51 FE AA 0F 4D 4D 34 FF 54' - '9F AA 3D EA 88 3D 26 81 9F AA 9F FA AA 7E A6 A3 D4 C8 69 B2 9F FA A5 3F 54 FD 51 FA A6 86 FD 54' - '68 67 A9 FA A8 F2 9A 7F A9 A8 D4 12 A7 A4 46 D9 4A 95 43 D2 06 81 33 D4 26 8D 30 02 61 32 68 C9' - '9A 98 4C 02 60 00 01 30 04 C0 00 62 98 26 98 00 00 00 00 83 00 00 00 02 30 23 4D 0C 00 13 00 00' - '44 F4 61 29 42 A7 AA 79 10 00 00 00 01 FA A0 00 D0 00 00 D0 68 03 40 00 00 00 00 00 00 00 00 00' - '00 00 0D 00 00 00 00 00 00 00 04 9E A9 52 A6 93 4A 60 D4 7A 0C 83 4F 42 66 44 40 68 D0 03 20 0C' - '99 33 26 A1 A0 07 A7 A4 20 68 D1 A3 10 F4 80 0D 00 00 00 00 03 F5 40 06 80 00 00 00 00 3F 54 00' - '03 FD 54 00 02 46 95 2A 50 CA 1E A0 0D 01 EA 3D 26 D1 E4 99 3D 46 9E A1 A9 EA 07 A8 00 00 68 00' - '0F FD 55 00 03 35 07 A8 34 66 FD 52 4C 1A 10 00 00 00 00 06 46 4C 86 40 1A 68 00 00 06 80 D1 A0' - '06 83 EC DE FD BF 76 FB EF 82 DF C1 C2 23 FC 38 30 B0 C9 21 CE 88 89 8A 8B 8C 29 9F 63 E4 64 B4' - 'CA CB 6B DF CC CD CE 6C DF 3F 41 C3 97 4E F4 74 9E 1F E0 DF F7 3C 5F 5B EB FB B8 69 F2 97 5D 75' - 'D7 5D 75 F8 8B 2C B2 CB 2C B2 CB 2C B2 CB 2C B2 DF 5D 75 D7 5D 74 17 5D 75 D7 5E 54 A9 5D FE FF' - '7F BF DF EF F7 FB FD FE FF 7F BF DF F3 EE 55 57 39 E7 FE 81 E8 3E 85 E2 3C 52 36 B0 62 4B 00 4A' - 'D2 57 96 96 14 B0 25 89 7A DB 37 6D 96 DB 37 6D 96 DB 37 6D 96 DB 37 6D 96 D6 04 B1 25 81 2C 49' - '60 4B 12 58 12 C4 9B 37 6D 96 DB 37 6D 96 DB 37 78 DA 65 60 55 64 9C 1E 54 99 6D F8 B8 B2 E4 32' - '39 16 5C 86 47 22 CB 90 C9 B3 75 93 9B AB 76 4D D6 4E 0D D5 BB 1E EB 27 37 56 EC 9B AC DC 77 06' - '9C 3E 27 59 0E D1 38 0D 92 70 0C 84 A4 73 AC 65 A7 AD 07 6D 51 C9 6B 12 38 0F 8B 5D AF 5E 06 D9' - '74 AD DB 6D 36 F2 ED B6 9A B7 6E 49 11 99 0C 52 44 6E 43 14 91 1B 90 C9 19 0E D2 48 85 69 25 E6' - 'AA DD B6 D1 0A D2 4A 91 24 E8 49 24 49 24 92 49 EE 5D DD B2 63 6F 3B 5B CF 13 24 32 4C 6D E2 57' - 'AD BE 94 9F 38 4E EE EA 5B B9 92 48 94 99 9D 49 12 4F 33 1F 87 90 92 4F 47 33 30 93 DD 76 7A CC' - 'CC CC CE EC CD 52 C9 DE D6 B5 24 BB 12 49 3D 49 26 92 4C 81 A9 27 1B 6D C8 DB 6D A0 92 52 4A 6D' - 'B7 18 0D B6 50 44 B4 A0 6D B3 44 92 58 48 93 44 92 58 5E D3 B2 22 DD B6 D9 76 F1 B6 8C B7 8D B8' - 'D0 76 DB 8D 07 6D A4 6E 3C 6D 60 A3 64 94 50 49 56 0A 36 49 47 F2 9D B7 AC A0 BD 91 BD 46 4C 9D' - 'E5 BA 89 78 C9 6D 13 21 86 43 8A D6 24 73 BC F1 96 92 39 6B 13 4D AC B7 8D A9 23 E9 6E 6F 78 C8' - 'B3 67 61 D5 09 C5 98 8B 69 17 6F 1B 88 BB 78 FB 8E 4F 57 90 C3 6A D2 28 DA B4 8A 36 AD 25 8A 3C' - '7D 47 11 C9 0C 51 C4 72 43 22 C1 1B 2D DA 4B 12 B4 96 25 69 2C 40 93 84 12 70 CB 09 22 95 86 DB' - '4D DB 6D 96 2C 58 39 78 AC 9B 23 32 F3 16 59 B2 D6 5A C4 52 A4 71 23 67 0E 5E 35 DB 9E 0C 5D 1B' - '6F 1B 58 12 C4 96 04 B1 2E 99 BB 6C B6 D9 BB 6C B6 D9 BB 6C B6 D9 BB 6C B6 B0 25 89 2C 09 62 4B' - '02 58 92 C0 96 24 D9 BB 6C B6 D9 BB 6C B6 D9 0D E3 6B 1D BC 48 93 7E 1B 21 6D F7 A2 CB 90 C8 E4' - '59 72 19 1C 8B 2D E3 7A E4 67 B5 1E BA 7D 75 BD 9B D9 D4 47 3A E9 75 D4 9B AC 9C 86 47 1A C9 91' - 'DC EA FA 45 74 B0 2B 24 E0 36 49 C0 33 49 48 E6 E3 2D C4 42 B4 A8 E3 B5 89 1C 07 C0 5B D4 EA 60' - '92 17 4A DD B6 D3 6F 2E DB 69 AB 76 F6 43 91 E3 2D C4 6E 43 14 91 78 37 BA 76 46 76 E6 36 D1 0A' - 'D2 5E 03 41 DB 6D 10 92 46 89 24 93 12 24 92 49 26 D2 EE 93 B3 BB AE B2 47 9D AD E7 6C 90 C9 31' - 'B7 89 5E B6 FB 54 99 92 48 94 99 92 48 94 99 9B 24 49 3C CC 7E 12 42 49 3D 1C CC C2 4F 75 F7 B1' - '76 1C CC CC CE EC CE 90 CC EB B9 28 92 5D A9 24 BB 62 49 37 49 26 46 A4 9B 8D B6 98 49 28 85 2E' - 'C6 DE EE B1 2E 49 36 3B B9 92 44 5D BC 4A 36 B6 E6 49 11 0A D2 48 CB 78 D2 44 2B 49 23 DB B9 3C' - '0F 05 F6 F6 76 24 B7 75 25 BB A9 2D DD 49 6E EC 6D F6 1D 49 6E EF 5B 24 CD 24 EE EC 6D E4 24 C9' - 'D5 46 D9 EB 52 5B B1 25 94 C9 2D C4 94 84 99 1D 24 B2 99 25 B7 1B 62 65 E4 9D 46 DC CC C9 E0 EE' - 'F5 24 7D 74 92 EB C6 27 67 64 91 BD 4B 52 DD 6D 2E B5 2E BA 7D 74 DB 50 93 14 8D 9E ED 26 28 DB' - '68 E6 32 E3 92 33 99 0C 8E 35 DA 74 EA D5 11 CB 5D A5 A6 D2 38 C9 69 B4 A6 4C 9D B1 1D B7 8C BE' - 'ED 8D 6E 6E 9D 36 AD 22 8D AB 48 A2 82 49 1B D7 8F A8 E2 39 21 8A 38 AE 4C 8D 60 6D 96 EE 36 CB' - '76 92 C4 AD 25 88 12 70 82 4E 17 61 24 52 B0 DB 69 84 92 28 5F 88 C1 32 F2 5C 8B 11 CB B2 6C 96' - '81 B2 4D 1C C3 83 33 48 A0 38 3C 3D D5 81 EA 48 36 5E D9 6D C8 D2 D9 72 36 F6 AC 6C AF 7A DA DB' - '2D 0B 48 C5 04 62 82 31 41 18 C0 6F 3B BB 01 BB BB 01 8C 06 28 23 14 11 8A 08 AE EE C0 63 1D DC' - '57 5D D6 34 58 D1 62 D5 CA D5 E6 B5 55 E1 BD EB 73 E8 D7 27 8C B1 BE 36 C6 CE E6 C6 F3 B1 B3 BA' - 'A3 7C 75 06 CE AC F9 C9 ED 78 E3 C4 3E 3C B0 D7 AD A7 90 A6 BE 46 C1 B3 C9 51 BE 4E 83 67 77 5B' - 'E5 2C 6C F2 B5 BE 5A C6 87 E4 E7 3F 28 DC DF 95 73 F2 CD CD F9 7E EF CC 2E 6F CC B9 F9 A5 CC 46' - '25 96 CE BE 87 2E B9 E5 DF 13 D7 6C 39 77 D4 E5 D7 B2 72 EF CF 61 DF D2 72 E8 A7 2E 93 27 4A F4' - 'AC E8 F4 59 39 1D 16 76 5D 26 4E 5D 83 3B 1F 00 C9 CB B1 67 2E C9 87 67 CB A6 F2 F0 5D 08 6E DB' - 'C1 BD 4E CF A1 37 2F 09 B7 2E A6 0D CB C2 BC BC 37 42 6E 5E 1F 1B 97 69 8D 4B 4B 4B 42 D2 DE D2' - '83 55 68 2A D6 82 D4 68 35 56 C6 8A C6 C6 B5 A3 62 AD 8D 8D 15 1A 0D 15 ED 6E A1 A8 AC 6C 6E DB' - '46 C6 8A 9A EB 36 6E DB 5D 66 AA 9A EA 6A 2A 34 68 A9 AE B9 63 76 73 51 AA C7 3A E6 B1 AA C6 B5' - '6A 6B AE 58 D1 AB 51 AA C6 8D 5A 8D 56 35 AA B4 6A B1 55 5A 35 58 D6 AD 52 AB 1A 95 56 89 55 8D' - '6A AD 6A B1 AD 5A B5 50 6B 55 68 D5 60 AA A3 5A AC 15 54 6F EC 5D 72 82 AA B5 AA 82 AA B7 F8 EE' - 'BA 87 F2 5D 75 3F 97 3A C3 F9 AE BA 9F CF 9D 61 FD 14 D7 59 FD 3B 68 7F 55 D7 53 D0 DD 98 7F 5D' - 'D9 9F D9 B6 87 F6 D3 64 F1 57 FB 8E 38 D3 B7 BF DE 53 8B C5 3F C3 6C 1E 8A 9B 27 F8 DD 75 9F E5' - '75 D7 D1 DD 73 7F CD E1 E1 E5 5C DF F4 5C FF AA E5 1F F7 6E 57 FE 17 2F FC B7 2B FF 41 A7 A4 B1' - 'B3 FF 2B 7F F6 83 4E A1 5E 7D F7 06 A7 3E BD DC FB F6 0D 4E 7D FD DC FA 38 35 E6 74 9D CF B0 C1' - 'AF 3F 00 EE 7D 8E 0D 4E 7D 97 5D B8 BC FC 0A 1A 9C FA 6E A7 4F A6 86 A7 4F A6 EB CF C1 21 AF 3F' - '06 EE 7D 9E 35 E7 E1 1D CF A9 A6 A7 3F 0A EE 7E 1B 4D 79 F8 77 73 ED 34 9C FD 79 9D 0A 73 ED 53' - '5E 7E BE 86 A7 3F 60 F8 7E 38 E7 EC 49 AF 3F 63 4D CF B6 D0 E7 4E C6 DB F1 9F 11 F0 9E CF E2 0E' - 'E8 F8 1E F5 F1 3E DB 03 AB 9A CE AB AA DF 0B C7 A5 DD 6F 79 ED F4 D6 5E 82 9F 31 D7 9C F0 CF 7D' - 'F3 2F 1E 06 29 EE BD C7 BA F7 27 93 C8 8C 53 E7 3E 72 F1 E1 18 A0 8C 50 46 30 18 CF 3B B8 63 01' - '8C 06 28 23 14 11 8A 7E 13 B8 FA 1E DC C1 11 88 28 B1 A2 C6 8B 1A B7 BD 57 E0 DA B7 CE FC ED D7' - 'AD 6D 6D F4 8B D5 36 31 62 8D EC F3 72 8D 1D 2B 97 99 EB FA F1 EF DD AE 6F 24 B9 63 46 8D 14 51' - 'EE DB 95 D3 94 51 8C 63 18 8C 46 31 AB F0 2F A2 6D F4 2B E8 1B 7E 03 D9 7A B0 F0 5B EF EB E0 3C' - 'CB CC 78 DB AC B3 D3 2C 9F 27 C1 D0 BA 75 B6 4F 92 B3 D3 EC 9E 2A CF 13 43 E4 6F C8 74 8F 54 D0' - 'A9 4F 5A D3 E3 DF 79 57 B2 FB C7 57 B3 5B 7A A5 F0 ED 05 11 A0 B0 68 8D 11 46 34 63 63 1B 14 68' - 'A2 C5 1A 31 A2 8D 18 D1 A2 28 8A 22 88 A2 34 45 11 62 31 1A 23 11 62 28 8A 22 88 A2 32 46 92 28' - '8D 11 7D DD C8 D1 11 16 22 88 B1 14 46 88 A2 35 F8 2F 61 78 F1 18 8D 24 63 62 8A 8A 4A 8A 2C 18' - 'D8 A4 D8 DE E3 BB 5F 2C B9 8D 8D 1A 31 5A 35 AB D5 2F BB 2D F3 8F 9B 5B E6 9E F1 AF 49 F3 2D 7B' - 'B7 DD 56 FB A2 FB 9A DF 72 6F 58 D7 AC 5F 6F 6B ED CF B6 B7 CC 7C 0F 5F 6C 57 DA DF 6A 6B DD 37' - 'CB B7 B9 57 B8 5F 2D F2 5D AF 95 7D A5 BE 51 F2 6D 7B FC 8F 83 AA F5 04 79 15 E3 BE 08 AF 1D F0' - '9E 3F 38 B1 94 D3 18 CC B6 F2 0D 34 D0 D3 65 36 F2 7A B6 31 88 43 31 42 10 CC 93 20 D0 D3 43 4D' - '94 DB CE 18 CA 69 8C 66 5B 79 C3 4D 34 34 D9 4D BC 8C 65 41 45 08 43 32 4C 91 44 D0 D3 4D 36 F2' - 'C6 53 4C 65 34 DB C8 D3 4D 0D 34 D3 6F 2C 65 34 C6 53 4D BC 8D 34 D0 D3 4D 36 F2 C6 53 4C 65 34' - 'DB C8 D3 4D 0D 34 D3 6F 2C 65 34 C6 53 4D BC 8D 34 D0 D3 65 36 F2 C6 53 4C 63 32 DB C8 D3 43 10' - 'D3 65 36 F2 C6 53 4C 63 32 DB CF 69 A6 86 23 49 B2 9B 79 ED 8C CB 5A 18 CC B6 F3 DA 69 A6 8D 26' - 'AE EF 3D 59 66 6D 68 B2 AE EF 3D 2B 56 AD 1A 56 9A 6D E5 8C A6 98 CA 69 B7 91 A6 9A 1A 69 A6 DE' - '58 CA 69 8C A6 9B 79 1A 69 A1 A6 9A 6D E5 8C A6 98 CA 69 B7 9C 34 D0 C4 34 D5 DD E5 B1 99 69 8C' - 'A6 DE 4B 56 AD 16 AD 94 DB CB 11 62 B2 CB 33 77 79 3D 55 35 16 26 11 14 85 49 33 FE C5 CE 1C 33' - 'C5 C3 87 0C F3 9C E1 AE 2E 2E 2E 23 8B 9C 2B 9C E6 78 B9 C3 86 78 B8 70 E1 9E 73 9C 35 C5 C5 C5' - 'C4 71 73 85 71 34 D8 CC B4 C6 33 2F 9C E1 AE 72 90 B8 B8 B8 B8 B8 B8 9A 6C 66 5B 19 96 9B 29 A6' - '9A 18 9A 69 A6 9A 6C 66 5B 19 96 9B 29 A1 A6 9A 69 A6 9A 69 C8 43 52 10 CC 53 8F 86 B9 CA 42 E2' - 'E2 E2 E2 E2 E2 69 B1 99 6C 66 5D 95 6A D5 D9 5B D8 CC EF B3 B3 2F 66 CD 9A DA B5 77 F2 AB 2D 36' - '57 91 85 71 73 87 08 6A 42 0C 67 4D 3B E2 CB 4D 8C CB 4D 96 66 EC B2 CB 3A B5 76 55 AB B2 CC DA' - 'BB 2C CD D9 65 96 75 7B 2B 6B 6B 7B 2B 6B 6A EC AB B2 AE CB 33 76 54 65 34 D3 65 37 43 4D 94 D9' - '4D 8C B2 CB 3B B5 6A EC AB 56 AE CA BB 2A EC B2 CD 5D C5 96 9A 6C A6 9B D5 9A BB 2A FA 2C B2 F3' - '67 76 AE CE 8C 9E 41 35 86 9B 8B 32 10 86 A1 0E 19 38 70 9C 16 B8 B9 C3 86 4E 2E 70 AC 71 72 15' - '21 08 6A 10 86 48 29 0A 8A 42 19 22 90 AC 45 21 52 10 86 A1 08 64 82 90 A8 A3 28 69 B2 B0 D8 CC' - 'B6 33 2C 63 32 31 36 53 4D 48 51 14 85 63 0C 65 36 53 65 31 8C CE 08 A4 E2 CF 17 17 38 56 38 2E' - '70 A3 87 08 66 42 A4 2A 71 70 E1 AC 71 73 85 71 71 73 85 11 48 51 08 43 32 15 21 50 84 33 88 A4' - '2A 29 E0 43 24 52 14 42 10 CC 83 32 C6 33 38 6F B6 69 A7 E4 DD 19 22 90 A2 13 B8 6A 43 C0 E8 D4' - '21 0C E2 4E E1 A8 A7 3A 32 45 21 41 08 A1 99 0E 10 D4 21 E4 57 0D 62 71 70 CF 17 3C 38 64 E2 90' - 'A1 8C A6 CF 01 9A 63 19 9C 3E 28 66 29 C8 64 8A 42 86 45 06 70 67 6C 63 33 8B B2 AF 65 1B 5B D9' - '46 C6 AC B3 4D 94 C6 33 38 BB 2A F6 51 B5 BD 9B 1A B2 CE DB 29 8C AD DE 6C D5 EC A3 6B AD 9D 9D' - '9A BD 95 B3 65 6F 65 6F B2 8E D7 7D 9D 9D 9A DA EC EC AE ED 56 D1 B3 65 79 22 69 A6 8B 1E 59 E0' - '4C 43 72 10 B3 58 88 63 29 B2 9A 69 A6 86 45 3C 95 70 E1 C3 7C 5C E1 C3 38 89 B2 9B 29 A6 9A 68' - '67 33 08 42 1B 92 E0 CE B1 35 9C C8 54 85 49 79 89 A2 10 84 21 D4 51 8C CE 1C 55 21 51 45 21 51' - '4F 24 AC 43 8B 87 0E 1D 71 71 73 87 0C E1 CC E6 42 A2 8A 42 A2 B4 69 42 77 08 43 B8 AD 77 08 67' - '12 67 32 15 14 52 15 15 A2 0C 63 34 D3 4D 8C CE 1A 6C A6 9A 69 AB 45 91 31 8C E9 A6 9B 2B 16 B8' - '9B 29 B1 99 6B 16 4C B1 8C 63 18 C1 B5 56 AE CA BB 2C CB 45 A4 59 65 96 59 65 96 16 B7 B2 B7 B3' - '66 71 D8 D6 CD 9B 36 6C DD A0 DA 6A EC AB B2 CB 35 8B 2C B2 CB 2C B3 78 DA 3B EC AE FB 3B 32 1D' - 'F6 76 7F C3 96 59 65 E9 62 C5 76 56 F6 6C D9 A3 6C B2 CB 2C B3 76 AC B2 AE CA BB 2C B3 45 F3 90' - '84 39 AE 1C 38 4E 2E 09 B2 B7 D9 56 B6 89 B3 66 CD 9D 6F 65 5F 05 57 65 16 CA B5 E0 9A 2E CB 33' - '65 96 59 67 45 BC D9 A2 EC AB 56 BB 56 5A B3 36 59 51 8C 66 8B B2 8B B2 CC DA B5 6A CB 2A CB 36' - '6C D9 D1 B5 D6 CA 37 92 B6 B6 B6 8D BC DE AC B2 CB 3B 3A B2 D5 76 8D F3 15 6A D5 39 57 04 A9 C9' - '52 8D 48 2E 0E D1 5B BC BD 1A 2A 68 95 92 A7 25 4A 2D 6C B2 9A 68 6F 14 D3 65 76 2E CE F1 D9 D9' - 'AE D0 D5 AB 5E 1D 53 78 A6 9A 1A 6C AD 9B C6 CD 9A 37 BA DA F1 15 E8 AD AD A6 8B 5D 59 57 66 8B' - '2C B3 BB 38 A8 EC 4D 34 F4 53 4D 34 5A EA CA BB 34 59 65 9D 96 BA 56 AD 5E 8A B5 76 55 88 E8 B2' - 'AE CD 16 59 D1 B5 A5 B5 BC E2 BB 4C 68 A8 14 AB 99 C9 52 A5 2A 82 95 08 26 76 73 34 68 D1 B4 38' - 'F9 B5 77 9B C5 96 59 DD CA 36 26 9E 9E 32 D3 4D 17 65 5E F1 B3 66 CE 86 8B 15 AB BC 55 AD A3 6F' - '39 BB 2A EF 16 76 6A EC CE 6D 5A BB C5 5A ED 16 B7 B2 B7 BC 6C D9 A3 68 D8 B6 B6 BC 45 E5 6B 2B' - 'C3 B2 9A 69 88 D0 CA 36 E9 AC B3 B1 8C E8 69 A3 6E 9A CA 6C A6 9A 66 A8 58 65 1B 74 D6 59 D8 C6' - '74 35 A4 D1 B7 4D 65 3E CA 69 A6 2D 32 8D BA 6B 2C EC 63 3A 1A 34 26 8D BA 6B 29 F6 53 4D 0D 69' - '94 6D D3 59 67 63 19 D3 16 93 46 DD 35 94 E6 2A 28 88 A4 28 B9 51 66 13 10 87 43 4D 1B 74 D6 53' - '78 A6 9A 1B 28 DB A6 B2 C7 86 69 A2 42 A2 2E 54 59 52 62 A2 8A 10 86 4B 95 16 61 31 0D 44 48 54' - '45 CA 8B 2A 4C 54 51 12 10 C9 72 A2 CC 26 21 A6 3A 6B 1B 74 D6 53 65 35 11 21 0C E2 E5 45 98 42' - '1A 88 93 15 16 2E 54 59 53 BA 69 A1 E8 66 4D BA 6B 2C EC 66 9A 66 8A 68 DB A6 B2 9F 74 D3 43 D6' - '19 93 6E 9A CB 18 CD 31 94 D1 B7 4D 65 3E EB D5 54 51 13 A2 19 2E 54 59 87 79 90 86 49 D6 0A 88' - 'B9 51 65 45 C5 C5 C5 C5 C3 87 6B 86 87 CA E2 CF 0A DA E7 0E 19 98 51 17 2A 2C A8 A2 8A 28 A1 0A' - '2E 54 50 51 48 43 27 39 49 71 1C E5 71 1C E6 2B 8B 8B 8B 87 0E 19 39 CA E2 CF 0A 90 86 58 9A 36' - 'E9 AC A6 9A 69 A8 42 19 2E 54 59 85 48 43 38 78 4D 1B 74 D3 4D 34 5E 15 A2 EE AE CA BB 28 D8 8D' - 'EE B6 B7 75 6A D3 46 B0 9A 1B A6 CE CC B6 33 24 3A 21 92 4A 8A 77 51 45 11 05 D0 A2 24 A9 0A 90' - 'A8 88 13 10 CB 4D 3E A9 A6 EB 0C E8 A6 89 2A 43 BC C8 50 C5 A1 95 6A D5 AE 26 9A 18 33 C4 59 8A' - '29 0A 8A 42 88 31 99 69 A6 9A 69 A1 89 89 A6 9B 29 A6 CA 06 0C 66 5A 69 BC 53 4D 60 6C A6 8E 4A' - '90 A6 CA 18 C6 66 D5 AB 56 AD 62 D5 D9 56 AE CB CD 88 B1 6D 35 E3 1D 34 F8 43 31 62 42 A2 92 A4' - '21 08 74 41 45 14 95 14 E4 33 16 24 2A 29 2A 42 42 1D 10 52 54 95 14 65 35 86 C7 96 E9 B1 8C D0' - 'C4 DD 37 4D 39 0C C5 34 42 6A 4A 90 DC 21 D1 05 A5 25 49 51 45 CE 15 C5 8E 70 E1 CD 73 95 CE 15' - 'CE 1C 32 70 5C 5C E5 73 95 C5 C5 CE 15 C5 8E 70 E1 CD 73 95 CE 15 CE 1C 32 70 5C 5C E5 73 95 C5' - 'C8 54 44 21 09 A9 2A 42 10 D6 22 8A 4A 92 A2 90 A8 88 42 13 52 54 84 21 AC 45 14 95 25 45 38 70' - 'CF 11 C3 87 0E 6B 9C AE 70 E1 C3 87 58 E2 E2 E7 2B 9C AE 2E 6E 19 88 86 88 4D 49 52 1B 84 3A C4' - '5A 52 54 95 14 DC 32 78 28 68 84 D4 95 21 E0 70 D6 22 8A 4A 92 A2 9B 66 46 64 63 D3 74 D9 B6 6B' - '0D 65 37 4D D3 4D 48 51 05 08 4C C9 52 15 21 58 8A 29 2A 4A 8A 28 86 31 8F 4D D3 65 35 E0 B1 14' - '52 54 95 14 52 14 42 10 9A 92 A4 29 AC 34 D3 74 DD 34 D9 43 18 C7 A6 FA CE A8 54 12 5C 76 03 15' - 'B4 E9 E3 76 1D 5D 3A 12 84 97 25 81 1F 59 C5 86 4B 2F 57 74 AC EC B3 58 B5 77 57 74 95 DD 1B 36' - '6F 3B DD 2D 95 C6 1B B6 14 B6 2D D3 C6 E9 67 1D D5 B7 6C 53 1D 82 A5 09 2A 64 12 84 1C 82 09 2E' - '0A 82 0E 4A 95 2B 15 04 38 81 14 4F 2E 8D 04 AA 64 12 85 31 4D DB 0D DD 3E 06 E9 E3 74 F0 4A 02' - 'BB C2 AB 28 57 82 2B 98 E9 60 C1 95 B5 8D 1A EA 83 D7 C3 BC 2C 6A 5A EB 5D 02 3A D2 49 6C A4 07' - '91 79 99 5E 1E 68 DB BC DF 32 E5 78 E9 CF 34 04 40 06 D3 C9 E4 78 DB C3 C3 BA AB 9E 72 F2 57 8F' - '30 22 08 80 06 31 6F 17 90 C7 9D D7 9D E7 79 3C 79 CB CD 16 F0 F0 BC 79 BD 77 DF 79 ED 07 88 B0' - '65 65 6F 76 60 32 23 0B 17 7B CE D6 01 2D EE 80 EF BA A4 39 54 02 57 CA 4A E9 0E 55 00 95 D2 57' - '48 72 A8 04 AE 92 BA 43 9C 62 C3 77 4D BC 63 93 9C E0 AA C1 82 A4 BA 91 E3 04 57 30 60 C6 F2 B1' - 'DA 18 39 CB 16 96 56 27 8C 72 A8 06 EE 9B BA 43 95 40 25 74 95 D2 1C AA 01 01 4A E9 2B 42 95 2A' - 'BE 73 06 65 D2 57 48 57 18 B0 5D F2 D2 C5 E0 DD 55 60 C1 4E 5D 48 F1 F5 7C E6 0C 15 25 D4 8F A3' - 'A3 9C C1 A2 B7 6E B7 5E 40 C5 55 07 6D DF 10 E7 29 01 4A D2 BA 42 95 0E 72 0A B7 6D DD 30 87 38' - '15 91 CC 15 5D CE F7 BD 75 15 C5 6B 6F 88 51 37 5A 6D A4 CD 21 A1 2B A8 AE 25 0D 21 44 DD 60 44' - 'A2 DD F0 8E 6E 5C 05 DB 08 68 A4 39 81 8C 6E 35 05 31 CC 10 64 98 87 08 A1 76 86 74 F3 BD 77 91' - 'E6 B1 89 80 0D 55 F5 D6 79 7E 51 97 E0 F2 5D D6 3B 58 D2 7D 75 96 F7 96 A0 6F 0B 0F 26 6E B1 DA' - '31 A5 E0 4E B3 26 F3 15 A3 B5 8D 23 9A AB 9D E5 BB CE 74 34 71 8E 11 5D 1B E8 21 BB 33 8C 71 0E' - '60 E6 EA CD 0C 6E EE 71 8E 21 CC 12 B4 2C D0 C6 EE E7 18 A4 39 83 75 66 86 37 77 28 BB AE DC BE' - '14 F3 D6 78 F9 D6 A4 79 C6 AE 89 9A 0D 2C 43 AA 6F BC B7 79 36 87 DD 63 49 D2 BE BA 79 D7 5B 95' - 'BB 7D 4B E2 09 74 8E EC CA 92 FA 97 C4 12 D4 77 66 49 74 C7 32 B2 13 25 A1 44 71 E3 25 BB 43 94' - 'F3 19 F0 B2 E3 BA 83 9D 0E 55 EF 6F 49 6E EE 50 0C 21 CA DD 3A 95 49 75 03 E0 43 9C AC 31 46 FB' - 'B6 67 18 41 0E 6A D7 B1 D6 BB AE 40 C7 3A 1C CA D3 A7 92 5D 00 78 39 07 39 2E 18 B9 25 F0 F0 71' - '8E 75 BA B5 72 0A 03 05 71 77 32 D7 18 A6 2B 4A 73 C4 CF 5C 92 E3 76 D6 31 D2 D6 AB 4B 03 DF 7B' - 'DE F7 B3 6B B5 D7 4F BD 76 DD F2 BA EB A9 A2 A9 02 4E 6C 72 49 38 85 13 D8 8D 47 24 4F 7A C8 1B' - 'EA 17 D4 EB 75 CE AB 72 75 72 64 3D 3E 9F 62 7D 9D 99 03 14 83 D4 77 B1 F7 76 AE E3 B5 6B 6B 1D' - '2F 0E B1 5D 3E E4 8F 75 75 6B 7C AC 77 3B CF 73 79 92 3D 5A B5 B5 8D 3A E9 74 FB 6D BD B7 4D 5A' - 'C7 4B B4 69 F4 DE D9 BC 78 23 2B C1 34 FA BB DA D1 C4 2B B0 D9 1A 35 EE 98 38 45 6E 6E 68 9B 2F' - '62 E5 11 56 29 82 FA EF 3A ED 69 04 58 CA 8A D1 7D 5D CB 9B C1 DA C6 51 68 BD 5D DE FB 31 D2 2A' - 'EA D1 7D 5D DD F7 82 77 58 CA 2D 1A D6 F7 BD F6 77 DE 03 0B 09 61 22 B0 85 8C BA B4 68 BB BD F4' - '13 BA C6 73 5B 46 B7 DF 7A B4 1D 23 2B 4B B4 4E B7 D7 77 D8 74 8C A3 6B 9E 25 1D 5D EF 58 0F 04' - '57 1E 70 73 AD EF 7D 60 34 8A DE E9 E5 6B DD D5 CA A2 2A F6 E0 E5 45 24 5C AA 22 AC 53 1C A6 5B' - '71 D5 56 8A C1 A3 95 A6 46 AA A8 8A B1 4C 72 99 78 86 0E 70 0A B9 8C F2 9E 3C 63 07 38 05 8B 57' - 'CA 58 B1 33 95 55 A2 88 C9 75 C8 A6 30 C7 38 05 58 B7 7C A6 DE 31 25 F2 AB 05 CB E5 4C F0 93 A9' - 'AA 73 80 73 05 ED F0 BC D6 F7 DE 74 F0 06 10 24 09 05 63 06 6B 79 C1 B4 6F 7D F7 A3 05 5E 61 AA' - '82 A4 98 C5 72 AC 72 DD F2 9E 5B 6E 25 5C AC BA 99 CA 82 02 28 12 0C D5 67 75 9E A8 29 06 EA 83' - 'BB AD EE 8E B7 40 6F 35 8D D5 76 8D 62 CA AB 15 40 71 5D A0 B1 67 39 99 7C 42 90 AC 57 CE 2C BE' - '21 48 12 B2 AA AC 71 04 11 59 55 40 71 65 A0 B2 EB B0 56 F8 5B E6 82 35 2D 3A 29 8A D5 7C D3 7A' - '66 49 6C 52 1C C8 72 15 26 26 2A D5 F2 E5 91 0A 86 0A 63 84 71 43 90 29 70 52 1C 23 92 1C 8A 64' - '14 85 11 59 22 31 CC AA 22 B0 54 91 18 1C BA A2 2B 4D D6 EE B3 B2 69 AA 42 A1 BA DC D4 74 BC AA' - '22 B3 2D E3 45 EC CA A2 29 E5 CC 88 C2 F2 9F 05 21 CC 18 5A 2C 72 AC 73 43 6D 16 2B 96 29 86 DA' - '2C 72 AC 71 24 4A 06 86 0A AB 39 84 30 DD A1 56 2B 2D 92 F6 EA B0 71 AC 4D 01 82 C7 0E 59 37 40' - '67 65 F1 86 4B 34 85 56 0E 5A C2 78 C3 37 4C 32 F2 AA C1 27 93 E5 CA F1 BE 89 84 D3 3F ED CB 9A' - '4F CF FF CF CF E8 77 94 74 67 BA 54 3E 95 15 2A 9A 7A 8A AA C6 75 BB F8 2B 3D EF DF 51 BE FB 77' - 'BF 66 E7 79 BB DD 57 2C B0 DE 74 A7 E7 E2 A7 E7 E7 A7 61 3A 26 9C 5A BE DA DF B5 79 FD 19 33 C9' - 'CA 6B DF 6D A0 EF 44 FD 48 93 92 43 42 F0 7F 04 68 E1 20 E6 54 F5 69 69 28 FA 94 5D 3E 94 FB 4F' - '14 FC 54 EC 52 34 68 D1 A3 46 8D 1A 34 68 D1 A3 46 8D 1A 34 68 D1 C2 42 41 C1 C1 C1 C1 C1 C1 C1' - 'C1 C1 C1 C1 C1 F0 38 1C 0E 07 02 08 20 82 08 20 82 08 20 82 08 20 82 08 20 82 08 20 82 08 20 82' - '08 20 82 08 20 82 08 34 34 34 34 34 34 34 34 34 34 34 34 3D E7 BC F7 9E F3 DE 7A 5E 97 A5 E9 7A' - '5E 97 A5 FB 3F 9E F7 D0 10 00 00 00 00 00 00 00 5B F6 F5 57 D2 EA AF E0 80 00 00 01 E3 BB BB BB' - 'BB 80 00 00 0A D7 99 FA 6E E0 00 00 00 00 00 00 00 05 BC 95 57 93 55 79 00 00 00 00 F1 DD DD DC' - '00 00 00 77 75 7D 23 7E 35 BF 18 B5 FA CF A0 DF 40 F7 BF 3C F2 7C F3 F7 9F 7D 7D 2F DF 9F BD F9' - 'F1 E7 44 8A F8 A1 C3 8B 16 11 82 C4 A2 C8 C3 FE CC 16 A5 12 71 A3 87 C2 0B A3 82 F8 E1 2B 1E 2C' - 'E4 04 AD A1 00 B5 93 12 FC 31 2F 6C 40 18 5B CA 8B 89 61 73 C6 17 52 E2 EF 8E 3B 73 02 F2 60 75' - '39 02 B1 30 AC 4C 2B 26 45 5F 24 55 72 85 57 2C 55 73 05 54 D0 EE D5 E1 73 90 56 62 74 10 33 EB' - 'CE 0C 7A DE 88 C8 EE CF 0C 09 F1 82 D2 81 06 0D 08 CA C2 A2 0B 7A 81 7B 5A 44 0D 6D 7A A2 DD 48' - '2A 91 9A CE 9C 33 CE C8 A8 D5 5D D4 86 DD EA B1 2D 79 58 32 3A C3 27 AE 2B 56 EC DA 57 07 19 6B' - '06 DD AD 78 77 F0 6D B4 B3 5E 2D 40 DF E1 DB E7 AE 0F 76 DB 3E A6 3F BB EF B8 B4 16 DB 0D 73 0F' - '65 D3 00 EE DC 68 DC 0F 5A F6 E4 7A AF 3B 43 D3 3E E8 7A 7E 9B DB B1 A3 DB 1E 8F 82 F0 78 6F 45' - '93 EE C9 3B A4 23 44 15 E4 C0 21 1A 20 B1 26 09 08 D1 03 4C 10 D3 08 34 C3 0D 31 03 46 61 F6 28' - 'CA C6 19 5D E1 8F B8 CA C8 0F 72 43 D6 81 EE 50 7B 96 1E E2 87 BD F0 F7 30 3D CD 0D 09 9C 42 1E' - '80 F6 E3 FB EC 0F CF 07 E8 03 DC 0D 02 B8 41 A0 FC F5 70 7A 4D 51 1C 07 40 8E 34 33 DB B6 CE CD' - 'CC EF B5 CB CA F2 C8 D0 13 27 23 1F BD 8D 8A 4F 24 8C C1 31 30 C9 FF 58 58 38 1D D6 57 FD CB E6' - '37 B7 9D BB BB AE D5 CC ED C4 E7 42 DE 6D 87 42 DA 6E D6 D2 6E CD 7A 85 CB 54 59 4E D8 D8 57 CE' - 'AC AE 9F EC 56 F5 FA D4 35 93 B5 55 33 B5 1D 19 C9 C5 6A B7 B4 D3 74 B4 94 7D 4A 2E 9D 0D 07 4A' - '7F 83 3A 45 04 9B 27 3F 9C 9F 9B 35 CC E5 FC FF CF 7C EF 96 F2 BE 53 BB F8 0E A7 6F E4 FC 97 91' - 'F2 1E 3C F1 DD D7 55 CF B9 7A B3 E6 7B BC 2A 2D AC DB 61 6D B6 80 00 00 00 00 0E BB BA EE 02 22' - '22 24 92 49 2E BA EB AE BA 49 24 92 49 24 92 49 24 92 49 24 92 49 25 EF DD 75 DD 75 DD 75 DD 75' - 'C8 88 88 88 88 89 AA D7 D1 6A AF 9F 00 00 00 03 C7 77 77 77 77 00 00 16 DB 6D A8 8A 22 88 A2 28' - '8A 22 88 A2 28 8A 22 88 A2 28 8A 22 88 A2 28 8A 22 88 A2 52 94 A5 29 4A 22 22 22 22 22 22 23 75' - 'D7 5D 75 D7 5D 75 D7 5D 24 92 49 24 92 49 79 3C DF 17 89 24 92 49 24 92 49 25 57 84 F1 36 36 8D' - 'B4 6D 01 06 8D A2 4D 8D A2 A3 68 DA 36 8D 8D A3 63 68 D8 DA 36 36 8D 8D A3 63 68 D8 DA 36 36 8D' - '8D A3 63 68 D4 6D 1B 1B 45 A3 68 A8 DA 2A 35 15 1A 8A 8D A3 63 68 D8 BC D6 AE 6C 6D 1B 1B 46 C6' - 'D0 9A 8D 42 F7 B7 6D CD 46 C6 D1 B1 B4 6B 15 93 50 13 23 02 D0 8A 30 2D 08 A3 02 D2 0A 30 2D 08' - 'A2 42 94 82 88 1C 22 43 22 43 22 43 22 06 44 86 44 B6 D2 64 48 64 65 29 32 21 32 24 32 24 32 20' - '64 40 C8 81 91 26 44 99 10 32 30 32 21 32 20 64 48 64 64 C8 90 C8 93 22 43 22 4C 89 0C 89 32 24' - '32 21 91 21 91 26 44 86 44 0C 89 0C 88 19 12 19 12 64 48 64 49 91 21 91 93 22 43 22 4C 89 0C 89' - '32 30 3B C2 87 08 C0 E1 18 16 86 44 26 46 05 A1 91 21 91 81 68 64 48 64 60 5A 48 A3 02 D2 45 19' - '2D 24 51 92 D2 45 18 16 C0 14 60 5B 00 51 81 68 02 8C 0B 64 8A 30 2D 24 51 81 69 22 8C 0B 49 14' - '64 AB 68 DB 45 B4 6A C5 58 D6 8B 68 D6 8D 51 AD 1A A3 6A 36 C6 D8 D6 2B 1A D2 49 0E F2 89 20 A3' - '24 14 42 0A 24 82 89 20 A2 10 51 24 14 40 8A 24 82 88 11 44 90 51 08 28 84 14 42 0A 21 05 19 01' - '46 10 51 08 28 C9 14 64 05 19 01 46 00 A3 24 51 80 28 C0 14 60 0A 30 05 18 41 46 48 A3 24 51 09' - '96 D4 5A 8B 51 6A 2D 45 A8 D5 16 A3 54 6D 46 A8 D6 8D B1 B5 1B 51 54 6D 46 DA 36 A3 6A 35 A3 54' - '5A 8A D1 B6 8D 68 D5 15 A2 D4 5A 8A A2 D4 5B D5 77 6D 45 8D B1 63 5A 2C 6A 8B 1A A2 C6 D4 58 D5' - '16 35 45 8B 51 62 A8 B1 54 58 B5 16 2D 45 8B 51 62 D4 58 DB 78 EE 2C 6A 82 C5 A8 2C 55 16 35 45' - '8D 51 63 6C 58 B5 16 35 A2 C6 B4 58 B5 16 35 45 8D A8 B1 B5 16 36 C5 8D 51 62 D4 CD 25 B3 C2 ED' - '79 BD 76 D3 C2 ED 78 EB B0 17 51 86 46 40 BA 8C 32 32 05 D4 61 91 08 5D 46 64 48 17 51 86 46 01' - '75 19 91 84 2E A3 32 30 0B A8 CC 89 02 EA 33 23 08 5D 46 64 42 17 51 86 46 49 75 19 91 92 5D 46' - '64 61 2E A2 4C 8C 92 EA 24 C8 C9 2E A2 4C 89 25 D4 49 91 84 C8 93 22 13 22 4C 88 4C 89 32 30 99' - '12 64 64 94 D4 49 91 00 E1 38 A6 27 08 80 70 9C 53 13 84 40 38 4E 29 89 C2 20 1C 27 14 C4 E1 12' - '4E 13 8A 62 70 89 27 09 C5 31 38 44 93 84 E2 98 9C 22 49 C2 71 4C 48 64 D4 C4 86 4D 4D 08 64 D4' - 'D0 86 4D 4D 08 64 D4 C1 0C 9A 9A 40 C9 A9 A4 0C 9A 98 02 DB 43 26 A6 08 64 D4 C4 0C 9A 98 21 93' - '53 04 32 6A 62 06 4D 4C 40 C9 A9 A1 32 6A 62 4C 9A 9A 01 93 53 42 19 12 02 8C 91 44 91 44 22 89' - '22 88 02 88 02 89 0B 5F 9F 90 20 22 07 E2 11 F9 F8 11 D3 A7 4E 9D 3A 74 E9 D3 A7 4E 9D 3A 74 E5' - 'CB 97 2E 5C B9 76 EB 41 BA 4B 94 BD 0C DC DC D6 7B AC DC 48 F8 FE 2E 7E 74 8C 86 6B 4C DC D8 D6' - 'B9 65 CA 89 C9 C6 C6 8F E2 77 E3 B1 A4 30 E6 22 8E 90 C6 4A 89 12 24 48 91 22 44 89 12 24 48 91' - '22 44 89 B6 DB 6D B6 DB 6D B6 DB 6D B6 DB 6D B6 DB 6D B6 DB 6D B6 DB 6D A6 DB 6D B6 DB 6D B6 DB' - '69 B6 DB 6D B6 DB 6D B6 DB 6D B9 D3 82 7E 40 64 E4 86 DB 81 B7 94 1B 79 61 3E 78 6D D0 0D BA 21' - 'B6 40 DB CC 0D BA 41 4E 98 6D 94 36 CC 1B 75 02 B5 7F E0 2B FA 42 BF F2 15 FF A0 AF 74 15 EE C2' - 'BD E0 57 F5 05 7F 58 71 4F BD 14 EE 37 3B 95 5B E0 A9 C2 B7 10 41 C6 FC 54 C0 1F 16 10 F8 B1 03' - 'F0 68 E8 E8 E8 E8 E8 BF 9C FF 49 FD 18 FD 58 CF E8 D7 8B AD 04 30 C3 12 51 67 C5 A3 16 90 A2 8B' - '4B 02 29 5E EE 94 FE CE 97 07 B1 14 30 68 BF A1 D7 EB 67 F5 6B F5 3A 7E 39 DD 2C EE 8B D5 AA BB' - '9B 50 C5 CC 25 1A 1E F4 EA 13 F1 66 70 64 DF DF 5D 5E DE 69 FC 31 05 08 41 6C 0B DB 5D 5A E1 25' - '68 84 20 00 10 0F 7B 65 9D 9C BB 99 DE 9E E6 B2 99 BF E9 74 BA 18 D3 78 D3 EA 31 BC 6F BF 4E 3F' - 'FE E3 EA 6A 69 D0 E4 B4 A2 C9 69 46 D3 A7 D3 F8 3D FE FF 7F BF DF EF EC F7 FB FD FF 81 DF EF 7C' - '9F A6 B7 94 B2 CB 2C B2 CB 2C B2 CB 2C B2 CB 2C B2 CB 2C B2 CB 2C B2 CB 2D 2A 54 A9 52 A3 4A 95' - '2A 54 A9 52 A5 4A 95 2A 54 A9 52 B9 D2 A5 4A 95 2B D1 BD BB E1 DD 1D 75 73 71 70 BC 6D 9E 99 C7' - '01 C0 70 01 C7 1C 07 02 13 CB 22 0D A2 1E 36 AE D7 6A 12 6D 85 A6 DC 7A 18 9F F3 85 F1 61 B9 D6' - '10 8F DD D0 42 43 C3 C3 A4 EC 32 F4 3F 11 2D 41 22 08 09 7C 08 C4 13 3C 80 97 AA 10 11 8F A2 80' - '97 04 8B CF 7E 19 E4 F1 DF 92 3E 3E FB B6 4F C8 4D 02 02 13 5B A0 FC 80 97 80 9A 00 77 B0 70 1D' - 'F3 40 EF A7 EC 7B BE 2D 04 B4 2E F4 2F 34 2F 52 CF BB 6B C3 7B E4 75 AF AD 4E EB 74 2D 67 7D 1B' - 'FE BA 63 EB E0 70 DC 3B D8 C1 FE 7E 0E 9C 89 FF ED 26 05 68 CA 81 68 17 82 5D 2F A5 87 4F E5 E2' - '79 5F 5A 64 CE 01 DD 8C 5B 5E C6 36 6D 99 B7 5A 4C F0 F4 9A D2 39 BD 2C 7D 29 DE 65 08 6F E3 0D' - 'FC B0 BE BD C7 9E 93 56 83 42 1C 68 1C 34 22 06 24 48 C4 8A 18 9F 96 2D 07 9B 89 0B 18 83 13 F3' - '15 02 0C 43 0C 44 A3 12 34 62 78 BB F5 9E 2F D1 74 FC 67 89 67 59 FC 4F 8D 7B C7 F0 F7 37 E5 FE' - '5B B8 EE 3A CE E3 B8 3D FA 75 93 AD 28 C3 BE 7A 1E B8 E3 7A 3C 6C DA 4B C3 7A 47 AF FA 48 19 80' - '65 65 00 06 66 60 16 28 0A 1E A3 EA 19 83 96 7B BD CB C5 6F 81 A3 D2 FD D7 DA 9F 3C 77 67 3B EF' - '59 CE 73 5C E3 E9 DB 57 E4 3D F3 DE 7F D3 E5 58 F2 5F 1B E3 73 CF 1F F0 9F 07 E2 F8 BE 2F 60 5F' - '8B E3 3C EF 37 CB F4 3C E4 1E 7F E6 41 FF CF E0 3F 3F 7F 60 42 79 42 34 79 40 C3 CC 7F 8C D5 45' - 'C5 44 6A 8E F3 3C DD 52 48 02 47 79 1E 89 38 48 3F 51 28 5A F0 FC CD 3E CE 97 07 B1 C0 8A 0B FE' - '17 34 03 AE 2E 06 7F 23 AB C0 AF 73 D4 E9 F4 B3 AF 2D AE 14 E7 72 2E 7C 9F 1F A2 0F 56 AA EE 6F' - '1A A7 17 0B DD 7D 33 E5 DE E7 DC 7C B7 CA FD 9B D1 F6 7F 25 EB FE 51 F1 BE F9 DF 27 F6 8F 5B F4' - 'E8 C4 11 17 E2 67 09 10 84 7E 00 10 2D 5A B5 6E A9 6E 9A E5 CD 97 B6 B3 B3 D3 6F A7 43 FC E8 6F' - '1D 78 5D F8 7C 7A 54 3D 56 54 14 4C 99 53 FA B4 94 90 D4 EC 95 32 56 CA A1 95 4B 2B FB FB FF 17' - '72 FB C5 7D 5D 5D 7D D9 76 B3 B3 F2 1F 7A FB EB 31 BF 74 67 EF 87 87 86 FA 21 A1 61 78 3F 85 85' - '81 96 76 52 CC 55 D5 54 A4 55 4F 4E A5 4F 56 4E B5 D2 BA 6A 6A 6A 6A 6A 6A 6A 6A 6A 6A 6A 6A 6A' - '9A 65 89 63 69 BA 74 29 52 A5 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C' - '63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18' - 'C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 E0 6F FE AD DE EC 9B 9F E5 D3 E1' - '47 47 B8 EE 38 BF A6 A5 71 D5 71 2E E3 01 C6 0B 8C 22 73 B0 88 E3 0D C6 23 86 6E 31 5C 63 11 C6' - '0B E2 63 BF 39 C8 73 92 E5 A3 9C A2 39 CB 72 D5 CC E7 E9 9C 80 D9 7A 33 9F AB 67 E9 4E 7A 73 9F' - 'AE 73 D4 9C F5 67 3D 69 CF 5E 73 D8 9C FD 93 9E CF C7 ED 6C A7 B3 80 DE 0B 6A 6C C8 D9 93 B2 AE' - 'CC AD 95 B6 57 D9 97 97 85 B3 87 B2 C6 CE 26 CC CD 9C 5E E1 3B 99 9D CA 5D CA 7D C2 F7 0D DC A9' - 'DC CD 53 FE 14 FD 2A 7F CA 9F F4 A7 74 A7 76 A7 78 A7 EA 73 4C 3C 04 FB 87 81 50 76 AC 3B A8 0E' - 'EA 43 BA A1 A3 56 30 6B 06 0F 58 78 3A E3 0A B4 69 F6 03 EA E0 EF B2 1F 2C 0F 6B C6 25 80 63 62' - '18 D9 0C 95 A2 F9 70 66 BC 33 B3 17 F6 82 DA D4 60 DB 0C 26 01 95 B8 D3 B8 18 77 23 07 B4 30 EE' - '86 1D D8 C5 ED 8C 5B C0 D2 F4 3C 62 34 AF 86 97 70 69 5F 8D 16 41 DF 74 3B C0 0E DB 60 87 58 41' - 'BE 18 75 88 33 99 87 58 A1 D6 30 EF 7E 57 98 E3 C7 90 3C 79 21 E3 40 E7 28 39 CB 0E 5A 87 3D F0' - 'E7 30 39 CD 0E 73 83 96 C1 CB 70 E7 3C 39 D0 0E 5C 03 DC 83 DD 07 AE C7 8B 44 78 34 83 C7 83 C4' - '78 78 78 79 A5 A2 ED D3 97 1A 19 ED DB 67 66 E6 77 DA E5 E5 34 C9 C8 C7 EF 63 62 B3 C4 C3 C2 C1' - 'C0 EE B2 BF EE 5F 31 BD BC ED DD DD 76 AE 6E 2D D8 5B 5A DA 59 AF 5C B6 CA C6 C2 BD 67 66 BB B1' - '5B D7 DA A1 D8 6B B5 C4 F5 FC FE B5 65 5D 55 4D 42 B5 54 F4 CA 7A B4 B4 94 7D 4A 2E 9D 0D 07 4A' - '7E 7A 77 A2 A2 72 6F A1 CF E7 27 E6 CD 73 39 7C AE 4C CA 6E 44 C7 1E 5F 8D 2D 2B 29 C5 E2 70 E4' - 'E4 A4 64 23 E3 B8 51 B0 50 5B 68 2D 54 14 14 14 11 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 79' - 'E7 9E 79 E7 9E 79 E7 9E 7E CD 56 D1 52 15 5B 55 5B 65 5B 75 5F 02 AF 85 57 C4 AB E3 55 02 A9 12' - 'AF 91 56 E1 57 CA AB E6 55 F3 FA 79 5E 9E 56 56 53 8E 38 E3 8E 38 E3 8E 38 E3 8E 38 E3 8E 38 E3' - '8E 38 E3 8E 38 E3 8E 38 E3 8E 38 E3 8E 38 E3 8E 38 E3 8E 38 E3 8E 38 E3 8E 38 E3 8E 38 E3 8E 38' - 'E3 8E 38 E3 8E 38 E7 BF D8 00 0D 8D 8D 8D 8D 8D 8D 8D 8D 8D 8D 8D 8D 8D 8E E7 73 DE A9 98 52 A5' - '4A 95 2A 54 A9 53 CD 52 A7 9D CE 52 A5 4A 95 27 7A A7 7A C7 7A E7 7B 07 7E C3 BD 93 BD A3 B5 A7' - '7B 67 6B 8E D7 9D B0 3B DC 3B DD 3B DE 3B 62 77 BE 76 C8 ED 99 DB 43 90 9D B5 3B 6C 76 DC EF 80' - 'EF 84 EF 88 EF 8C E8 13 91 1D F2 1D B8 3B E5 3B E6 3B E7 3B F6 9D FB 8E FD E7 7F 03 BF 8C AA F9' - '65 FC 65 F2 EB F8 EB E6 17 F2 17 A6 5F 2D 32 BF 92 BF 94 BF 96 BF 98 BE 69 7F 35 7A FE 72 FE 7A' - 'F4 FE 92 7F 4D 3F EB 4F EA 27 F5 53 FA C9 FD 74 FE C2 7F D8 9F D9 4F ED 27 D6 A7 F6 D3 EB 93 EB' - 'D3 EC 13 FB 89 FD D4 FE F2 7D 8A 7F 7D 3E C9 3E CD 3E D1 3A 14 FB 54 FB 64 FB 74 FF 02 7F 85 3F' - 'C4 9F E3 4F 02 9D 12 7F 91 3E E3 9B 35 CC E5 F2 B9 33 29 B9 13 1C 79 7E 34 B4 AC A7 17 89 C3 93' - '92 91 90 8F 8E E1 46 A5 31 63 22 E2 A2 62 0E 87 49 0D EA 42 F6 74 BB 11 43 06 8B FA 1D 7E B6 7F' - '56 BF 53 A7 D2 CE E8 BD 5A AB B9 B5 0C 5A 74 B3 09 46 84 FC B7 32 80 E0 03 80 0E 00 38 00 00 EC' - 'A3 82 D4 00 2D 00 0E 00 CA 72 D7 27 22 76 3B 6D 33 34 78 D8 B3 31 18 C3 C2 5F F3 3D 0F CB FC AD' - 'DD BD DF E3 DD F9 1B BF 27 77 71 AA F6 B6 6D 6D 1A DA B5 B6 6A C1 AD BB 5B 86 B7 2D 7B 4D 6E 9A' - 'F8 BC 5E 37 DE 3D AE D5 0A 14 28 50 A1 42 85 0A 14 28 50 A1 42 85 0A 14 28 58 61 86 18 61 86 18' - '61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 89 93 03 17 14 35 71 83 54 61' - 'AB 34 35 59 0D 56 83 55 B0 D5 C7 0D 59 C0 8E AC AC 8B 55 35 78 59 36 B2 35 5C 0D 5C A0 D5 CB 0D' - '59 E1 AB 40 35 68 86 A9 04 4F F3 15 FF 40 AF FE 82 BF FA 8A FF EC 16 2C 58 B1 62 C5 8B 16 2C 58' - 'B1 62 C5 8B 16 2C 58 B1 62 C5 8B 16 2C 58 B1 62 C5 9E 1F 0F 87 C5 E2 F1 78 B5 AE B5 92 D6 BB D6' - 'BC C9 BD D6 BE D6 E8 6B 0B 5A FF 59 3C BC 0D 6C 17 14 D6 91 AD 27 59 5D 69 5A CB 6B 2F AD 2F 5B' - '08 D8 7A CC 25 DA A5 DB 25 DB A5 F8 12 FC 29 7E 24 BF 1A 58 14 A8 92 FC 89 77 09 7E 54 BF 32 5F' - '9D 2F ED FC 66 0F 91 6C F6 3F AC 9A B3 16 32 2E 2A 26 20 E8 7D 6D 0F 78 DF 03 CC D3 EC E9 76 32' - '22 86 0D 17 F4 3A FD 66 4E 39 4F 27 3F AB 5F A9 91 6D E3 74 FA 59 DD 17 AD AD B9 95 B8 1C 0F 2E' - 'AB B9 B5 0C 5B 6A 7C 46 F8 1E 5D CD 2C C2 51 A1 3F 2F 87 94 E6 4C C4 32 72 27 63 B7 C1 6F EE 8E' - '00 B4 00 38 00 00 E0 03 80 0E 19 C1 6A 00 C4 11 11 10 5D 38 62 48 88 88 22 2E 9C 31 10 DA C2 22' - '0B 9C 30 46 20 88 B9 C3 11 0B 08 88 2E 70 C7 C7 77 46 20 88 BC 38 60 13 26 4C 99 32 64 C9 93 26' - '4C 99 32 64 C9 93 26 4D 3C C3 1E DF 1D 83 06 0C 18 30 60 C1 83 06 0C 18 30 60 C1 83 06 0C 18 30' - '60 C3 D5 F5 7D 55 14 51 45 14 51 45 14 51 45 14 51 45 14 51 45 14 51 45 14 51 45 14 51 45 14 51' - '45 14 51 45 14 51 45 14 53 5F AF D7 EB F6 1E E0 8F 8F 4B 1F 1F 1F 1F 1A F9 F6 33 CE F3 CC 77 99' - '0F 32 5E 34 79 94 F3 2D E3 57 9D F7 99 8F 33 5E 67 3C 6C F1 BB CC F7 9A 1E DF 87 DB FA 9E DE EE' - 'EE EB F2 1F 92 FA AF CA 7D 67 D7 7E 5B F8 4F E1 BE C3 F8 8F CC 7F 15 FC 67 C6 FC D7 D9 7D A7 DB' - '7F 1D F9 CF E4 3F 92 FB 8F E5 3F 96 FC F7 E8 3F 45 F2 3F 98 FD 27 E9 BE 57 CC FD 47 F3 5F 75 FA' - 'AF D6 7D E7 FA 2F E7 3F D2 7F A6 FF 51 FA EF F5 5F CF 7F AC FF 5C EE B6 7F 56 BF 53 A7 D2 CE E8' - 'BD 5A AB B9 B5 0C 5A 74 B3 09 46 84 FC BC A7 32 72 27 63 B6 D3 33 47 8D 8B 33 EB BF 5C FA DF D6' - 'BE B3 F5 8F AB FC 77 D5 BE AB F1 BE F3 E6 8C 22 20 BE 6D C3 04 62 08 8B 9C 31 11 11 10 5C E1 80' - '1C 01 68 00 70 00 01 C0 07 00 1D 6A 16 A0 01 68 00 EB AE BA EB AE BA EB AE BA EB AE BA EB AE BA' - 'EB AE BA EB AE BA EB AE BA EB AE F8 7C 3E 1F 0F 87 C3 E1 F0 FB 7E D7 B6 70 84 21 08 42 10 84 21' - '08 42 10 84 21 08 42 10 84 21 08 42 10 84 21 08 42 10 84 21 0A 6C D9 B3 66 CD 9B 36 6C D9 B3 66' - 'CD 9B 36 6C DC FD ED ED ED ED ED ED ED ED ED ED ED ED EF 3F CF F3 FC FF 3F CF ED 5D 79 A5 29 4A' - '52 94 A5 29 4A 52 94 B6 E5 5C B2 CB 84 5C 32 B0 5C 42 CC 2E 29 71 8A 32 CD 2B 25 68 AD 97 1C B3' - '8B 90 5C 92 B8 5C A2 E5 96 79 68 16 89 48 5C C2 D2 A5 48 B4 CA 53 18 C6 31 8C 63 18 C6 31 8C 63' - '18 C6 31 8C 63 16 9D 2C C2 51 A1 3F 2F 29 CC 9C 89 D8 ED B4 CC D1 E3 62 CC C4 63 0F 09 69 4A 94' - 'A5 29 4A 52 94 A5 29 4A 52 94 A5 29 4A 52 94 A5 29 4A 52 94 A5 29 4A 5A 99 A0 70 01 C0 07 00 1C' - '00 70 01 83 04 62 08 8C 18 88 C6 20 03 80 00 2D 00 00 2D 00 2F EF EF FF EF DA C0 AA 9A 69 A6 9A' - '69 A6 9A 69 A6 9A 69 A6 9A 69 A6 9A 69 A6 9A 69 A6 9A 69 A6 9A 69 A6 9F 6F 03 B7 DB ED F6 FB 6A' - 'F6 FB 69 D7 C0 AF 83 5D 4A F2 2B C9 AE AD 79 55 D6 AE BD 79 75 F0 AB E1 D7 62 BE 25 79 95 F1 6B' - 'E3 57 1D 79 B5 D9 AE D5 76 EB E3 D7 9D 5F 22 BE 4D 77 2B E5 57 CB AF 3E BD 0A F4 68 D1 A3 46 8D' - '1A 34 68 D1 A3 46 8D 1A 34 27 E5 E5 39 93 91 3B 1D B6 99 9A 3C 6C 59 98 8C 61 E1 4B 5D 69 4A C9' - '90 A6 0E 02 75 EB D7 AF 5E BF 0B 85 C2 E1 70 B8 5E 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6' - '31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C' - '63 18 C6 A2 F5 47 B3 5E 75 EA AF 56 79 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 7B C7 79 E7 9E 79 E7 9E' - '79 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 79 E7' - '9E 79 E7 9E 79 E7 9E 79 E7 9E AA EE 6D 43 67 67 1C 00 70 5A 5A 5A 00 01 C0 00 07 00 1C 01 68 00' - '01 88 23 18 88 30 62 48 C4 11 18 31 04 44 44 41 89 23 07 00 00 1C 01 68 00 01 68 00 70 2A AA AA' - 'AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA A0 82 08 20 82 08 20 82 08 20 82' - '08 20 82 08 20 82 08 20 82 08 20 82 08 46 8C 15 2A 54 A9 52 A5 4A 95 2A 54 A9 52 A5 43 18 C6 31' - '8C 63 18 C6 31 8C 63 0F 9E 38 C3 B8 1C 71 A2 3B 91 DD 0D 21 DD 8E F0 77 A3 BE 1F 40 62 1D F8 D3' - '1E 00 F0 46 A0 E4 0E 48 D5 1C A1 AC 35 C7 2C 78 43 C3 1B 03 C4 1C C1 E2 9D 33 11 8C 3C 29 6B AD' - '29 59 32 14 C1 C0 4E FC 5F 19 F1 7E DF DB 7A 3E 87 B5 F6 9F 15 EC FD 97 B1 F3 FE 3F E4 11 11 06' - '0C 11 88 22 30 62 22 22 30 60 C1 18 08 00 04 00 80 3F 00 03 F0 12 52 52 52 52 52 52 52 32 49 52' - 'A5 4A 95 2A 54 A9 52 A5 4A 95 2A 54 BB 2D 96 CB 65 B2 97 2E 5C B9 72 E5 CB 97 2E 5C B9 72 E5 CB' - '97 2E 5C B9 72 D6 5B 08 E1 08 42 10 84 21 08 42 10 84 21 08 42 10 84 21 08 42 10 84 21 08 42 10' - '84 21 08 42 12 CB 81 C0 07 00 1C 00 70 01 C0 00 16 80 00 16 80 1D DF E5 FD 1D DD 3B CC F3 23 10' - '44 60 C5 E5 F2 F9 7C BE 5F 2F 97 CB E5 F2 F9 7C BE 5F 2F 99 A3 A3 A3 A3 A3 A3 A3 A3 A3 69 67 42' - 'B9 6D 95 8D 85 7A C5 95 BD 7E B5 65 5D 55 4D 43 EF 1F 8B C3 A9 E0 7B 5C F3 4B 2F 2D D3 97 0E 1C' - '6D F3 FE 06 F1 71 51 27 2D B2 B1 B1 89 88 3B 7F 05 F7 EF BE EF B7 7B F6 7D 7F 56 F3 77 BA 8E DD' - '46 28 9C 9B E8 73 F9 C9 F9 B3 5C CE 5F 2B 93 32 9B 91 50 AD 55 3D 32 9E AD 75 2D 25 5D 7D 77 62' - 'B5 61 8C 63 18 C6 31 8C 63 18 C5 29 4A 52 94 A5 29 4A 52 94 A5 29 4A 52 94 A5 29 4A 52 94 A5 29' - '4A 52 94 A5 29 4A 52 94 A5 29 4A 52 94 A5 29 4A 52 94 A5 29 4A 52 94 A5 29 4A 52 94 A5 29 4A 52' - '94 A5 29 4A 52 94 A5 29 4A 52 94 A5 29 4B F3 D7 C6 C6 8B 1E 10 6D 1C 1B 47 86 D2 01 B4 88 6D 24' - '1B 49 86 DC 30 DB 88 1B 71 43 69 40 DA 54 5D 4B 06 DC 60 DA 5C 36 E3 86 D3 01 B7 20 36 4C 1B 4C' - '86 DC 90 DB 94 1B 72 C6 9F 30 37 9A 0D F9 A1 BA 70 DF 9C 1B F3 C3 7E 80 6F 36 1B CE 06 EA 06 77' - '44 67 4E 8C E9 E1 9D 3E 33 BA 43 3A 80 67 50 8C CE 98 CE A2 19 DD 40 FA 8C 3E A4 0F A9 43 EE A8' - '7C 4D EA D4 0F A9 C3 E5 41 F2 B0 FA A0 3E A9 0F AA 83 EA B0 FA B0 3E EB 0D 4E B8 F0 D6 87 DD 80' - 'FA B8 3E EC 87 CB 03 3A F0 CE C0 33 B1 0C EC 83 35 A1 F2 E0 F9 78 B3 B3 18 D6 83 1A D4 63 5B 06' - '4C 03 2B 70 CA E0 32 B9 0C BB 41 95 D0 65 76 19 76 C3 2B C0 CA F4 32 62 19 5F 06 5D C0 CA FC 77' - '99 0E EF 74 38 C0 0E 30 43 8C 20 E3 0C 38 C4 0E 19 87 18 A1 C6 30 71 DE 0E 31 C3 8C 80 E3 24 38' - '68 1C 65 07 19 61 C3 51 A9 DF 1A 99 83 53 34 6A 67 0D 46 C3 51 B8 D4 CF 1A 9A 03 51 C0 D4 72 35' - '1D 07 CE C3 ED 10 FB 48 3E 78 34 9E 0D 2D 47 CF 9F 3E D5 EA FC 5E 47 91 E4 69 F8 1E 9E F3 4B 45' - 'DB A7 2E 34 33 DB B6 CE CD CC EF B5 CB CA 69 93 91 8F DE C6 C5 67 89 87 85 83 81 DD 65 7F DC BE' - '63 7B 79 DB BB BA ED 5C 5B B0 B6 B5 B4 B3 5E B9 6D 95 8D 85 7A CE CD 77 62 B7 AF D6 AC AB AA A9' - 'A8 57 FA 15 53 D3 29 EA D2 D2 51 F5 28 BA 74 34 1D 29 F9 E9 DE 8A 89 C9 BE 87 3F 9C 9F 9B 35 CC' - 'E5 F2 B9 33 29 B9 13 1C 79 7E 34 B4 AC A7 17 89 C3 93 92 91 F0 C8 02 00 FC 03 F0 04 00 80 10 00' - '1F 80 00 DE 14 BE 18 DF 09 5E 99 EA 57 B1 6E E3 1D 95 D9 9D C5 E8 46 68 17 40 DA 11 79 D1 99 C5' - 'CE CB CB CB CB FE F9 10 F8 E7 63 C4 63 EE 57 43 B3 39 9C 43 3F E1 D6 8A 67 F3 AB 8B C4 56 66 69' - '59 C0 C0 C0 C0 C0 C0 C0 C0 C0 C0 C0 C0 C0 C0 C0 C0 C0 B4 D3 4D 34 D3 4D 34 D3 4D 34 D3 4D 34 D3' - '4D 34 D3 4D 34 D3 4D 34 D3 4D 34 D3 4D 34 D3 4D 34 D3 4D 34 D3 4D 34 D3 4D 35 FA 2D F8 B1 FF 4A' - '77 8B 23 F4 F2 7C 4E 7A 39 5E 2E 4F 23 8F C6 E2 F1 38 76 D9 7E 8C FF 72 87 C0 A3 EE 13 D2 CC F7' - '38 BC 4E 1D B7 8D C2 F2 69 7A 54 F7 CB FA 86 DF A9 F0 73 77 DD FD 5A BB FC 9E 47 1F 8D C5 E2 70' - 'ED AB 7C 27 B7 FA 3F AD 9D BF D2 DA E9 EF F5 3E 1D 7D FE 4F 23 8F C6 E2 F1 38 76 DD 5F 87 9F FF' - 'DD 6F D7 EB F8 3E F5 30 5E 0F C9 F8 FC AF C5 E4 F9 1B F7 BC 07 B0 6F 61 1E F9 3E 46 AF 54 8E 8F' - 'F0 3F 83 49 0A 7C 35 2A 43 E1 FA A7 1F E6 7F B7 96 FF F9 3F 1F 95 F8 A1 F9 87 63 44 26 89 C1 8A' - '99 8B C1 8A 97 8B BE 3A 3E 22 DA 32 50 B7 65 92 33 0A 92 2A 78 47 75 64 A9 78 4D 1E B1 2B 1E 13' - '4A B4 95 AF 08 F2 B8 96 EF 09 71 5E 4B B7 84 7B 64 47 CF 48 FA F8 97 D7 C4 7D 6C 4B 3D 32 1F 6E' - '4B 6D 32 3D B9 25 C6 99 3C 17 44 BA D3 26 9D 4F 6A AB FF 6D 7F A2 D6 8D 0D F3 BE 65 1A 13 F2 FD' - 'A3 BD 6F DE F9 5F 1F E9 5A 86 61 3F 7F F9 3F 83 E8 FF 0D 8E 0F 03 30 9C 13 17 30 9B A7 7C 8A 54' - 'A9 52 A5 4A 95 2A 54 A9 52 A5 4A 95 2E 4F 23 8F C6 E2 F1 38 76 DF 1A 9D 3A 74 E9 D3 A7 4E 9D 3A' - '74 E9 D3 A7 4F 93 C8 E3 F1 B8 BC 4E 1D B5 3A 74 E9 D3 A7 4E 9D 3A 74 E9 D3 A7 4E 9F 27 91 C7 E3' - '71 78 9C 3B 6F 5F E6 FF 2F AF FD 9F 2B D7 A5 F3 A8 7F 5F CC FF 0F E9 F9 78 DC 7E 3F 1A AF 1F 8E' - '6E 47 22 DF 93 C9 E4 F2 59 F1 FC 8B 7F 22 D3 C1 A4 C9 DB AB F7 0E 1A 34 68 D9 FD FD FD FD FD FD' - 'FD FD FD FD FD FE F6 F6 F6 F6 F6 E6 E6 E6 E6 E6 E5 72 E5 CB 97 2E 5C BA BA BA BA BA BA BA BA BA' - 'AE AE AE AE 53 86 75 5D 5A B5 6A D5 D1 D1 D1 D1 D1 D1 D1 D1 F9 B3 53 53 5F 9E 6B 93 C9 96 96 E3' - 'F1 FF 44 BC 9C 9C 9C 9C 9C 9C 9C 99 8C 63 1B CD F3 7C DF 5B EF 6A CF 9F 3E 7C F9 D3 A7 4E 9D 3A' - '74 E5 55 55 55 55 55 55 54 BE D4 D4 D4 D4 D4 D4 D4 D4 D8 F7 FF 69 EC 9D EC 9D EC 9D EC 9D EC 93' - '04 98 24 C1 25 F1 2F 89 7C 4B E2 5F 12 F8 97 C4 BE 22 D2 2D 22 D2 2D 22 D2 2D 22 D2 2D 22 DB 0E' - 'BC BD 45 45 3D 3D 3C B4 07 B1 8C 41 18 31 11 11 10 5E C6 70 16 80 1F 43 91 B9 B9 B9 F6 1B 9B 9B' - '9B 9B 9B 9B 9E 5E E7 CF F7 3E 35 BD BD BD BD BD BD BD BD BD BD BD BD BD BD BD BD BD BF CE F2 01' - '14 51 45 14 51 46 74 E9 D3 F2 32 32 32 32 23 DB C7 F2 23 F9 31 FE C6 3F 95 1F EC A3 F9 71 FE CE' - '39 F1 F9 51 F9 71 F9 71 F9 91 F9 B1 F9 D1 D0 F8 E8 86 05 0B 98 F7 1E C7 CF F8 9F 61 F1 1F 0F F0' - 'DF 0B EB FD 77 C2 7C 1F C1 7C 0F AD F4 7D 1A 30 44 5E DA 70 C4 44 51 44 41 74 E1 83 04 62 08 20' - '04 40 40 80 00 40 08 FC 02 E5 C9 D3 E3 E8 F4 FA 1B 1D 8C 5C 5E 46 8E 4E 8B 06 13 D3 D4 AC 29 68' - '11 22 D6 6B 35 9A CD 66 B0 F3 CF 3C F3 CF 3C F3 CF 3C F3 CF 3C F3 CF 3F DA F8 9F 09 D7 73 FF 0E' - 'B6 FF AD BF FE FB FE 9F ED FA 9B FE A7 C4 F4 3D 0F 79 E8 67 6F FF C9 F2 39 52 39 72 39 92 39 B2' - '39 D2 10 91 CF 91 1A 45 C4 88 F2 11 91 73 22 EA 42 52 2E E4 5E 48 BD 91 7D 23 A1 20 52 2F E4 27' - '23 02 46 0C 85 24 48 53 07 01 3B F1 74 2F AF 6F 2E D2 BA B9 46 3D C4 6E 7A 1C EE 6F 33 97 CA 92' - 'A8 1C 00 70 01 C0 07 00 1C 00 00 74 A3 82 D4 0C 68 23 10 44 5D 38 45 88 88 88 82 EB B8 8D 04 62' - '08 8B A7 08 B1 8C 41 88 2E 72 34 11 8A 22 2E 70 B1 11 8B 10 5D DC 46 82 31 44 45 DD C1 63 D4 F5' - '3E 47 D4 F5 3D 4F 53 D4 F4 FD 3F 4F D3 F4 FD 3F 4F D3 F5 3D 46 8D 1A 34 73 E2 AD AD AD AD AD AD' - '37 89 83 5B 46 B6 AD 6D 9A BB 5C ED 7F B0 EE CD DA 44 91 29 21 A1 78 BC 3E FC 2B 5C B5 B6 56 36' - '19 4D 32 72 16 D9 58 D8 63 F7 B1 B1 6A 6A 15 AA CD C5 F1 23 84 83 E0 6F E0 BE FD F7 DD F6 EF 7E' - 'CE 0C A7 17 89 C3 93 92 91 90 8F 8E A2 D1 C5 84 84 84 84 84 84 84 84 84 8A 28 A2 8A 28 A2 8A 28' - 'A2 8A 28 A2 8A 28 A2 8A 28 A2 8A 28 A2 8A 28 A2 8A 28 61 86 18 61 86 18 61 86 18 61 86 18 61 86' - '18 61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61' - '86 1E FF 67 83 0B 59 59 59 59 58 C1 83 06 0C 18 30 60 ED DB B7 6E DD BC 7C D1 A3 46 8D 1A 1E FA' - 'EA EA EA EA EA EB B3 75 81 81 77 63 81 81 81 37 AD 9B F6 E6 F5 D3 7A F9 BD 84 DF B9 37 EE CD FB' - 'D3 7B 19 BF 7E 6F 65 37 B3 9B DA 4D A1 9B DA DA 4E 6D ED 14 7C 2A 3E 25 1F 1A 88 15 08 94 7C 8A' - '37 0A 3E 55 1F 32 8F 9D 47 ED 51 FB 94 7E F5 1F C1 47 F1 51 FC BB 3D 1F A2 BE 77 FA DE CF 6E 67' - 'BF BC F7 F8 9E FA 67 BF CC F7 FA 9E DD 4F 6E E7 B7 93 DF 54 F7 D7 3D F6 4F 6F 6D 27 45 A5 A5 A5' - '0D 0D A7 4C 5A 51 0F 2A D3 A8 3D 7B 4F 6B D7 41 79 48 3B 74 A3 CE FC DB 9F EA F3 AA 1E 29 17 14' - 'C1 E5 38 C9 54 32 55 8C 9A 81 93 52 1E 55 07 95 61 E5 60 79 D6 0D 7A E1 AD 68 6B D8 0D 6B 83 CE' - 'C8 78 B0 3C AF 0F 2C 06 65 88 CC B2 19 8B 46 62 E0 7A F0 F2 CC 1F 68 18 DA 86 36 C1 8B 00 C6 DC' - '31 B8 0C 6E 43 1E D0 63 74 18 DD 86 3D B0 C6 F0 31 BD 0C 58 8C 8B E1 91 DC 19 17 E3 21 90 C8 EE' - '8C 8C 01 91 82 32 30 86 46 18 C8 C4 0E 19 87 D8 A1 9E 28 67 89 87 85 83 81 DD 65 7F DC BE 63 7B' - '79 DB 35 DA 5B AE D5 CD C5 BB 0B 6B 5B 4B 35 EB 96 D9 58 D8 73 2B F9 AB 13 F6 6B BB 15 BD 7E B5' - '65 5D 55 4D 42 B5 54 FD 5A 5A 5A 4A 4A 3E A7 53 A7 43 41 D2 9F 9E EA 4F 4E F4 54 4E 4D F4 39 FC' - 'E4 FC D9 AE 67 2F 95 C9 99 4D C8 98 E3 CB F1 A5 A5 65 38 BC 4E 1C 9C 94 8C 84 7C 77 0A 35 29 8B' - '19 17 15 13 10 74 32 40 40 08 03 F1 00 20 00 11 20 40 08 03 F1 00 01 02 44 89 12 24 48 91 22 44' - '89 12 43 42 C2 C2 E9 E9 E9 E9 E9 E9 E9 E9 E9 E9 E9 E9 E9 F6 74 BB 1D 8E C7 62 2D 04 92 49 24 92' - '49 24 92 49 24 92 49 24 92 49 24 92 49 24 92 49 24 92 49 24 92 49 24 92 49 24 92 49 24 92 49 24' - '92 49 24 92 49 24 92 49 24 92 49 24 92 49 24 92 49 24 92 49 24 92 4B D0 F4 3D 08 C5 11 17 A0 E1' - '16 31 88 D1 05 CE 46 82 31 44 45 DD D6 22 0B 04 58 49 4B 04 45 88 83 62 0C 18 D0 44 58 22 22 C4' - '1B 10 46 34 11 65 DC EE 88 8B 10 58 82 31 A0 8B 04 44 58 2C 41 18 D1 05 82 22 2C 18 2C 41 18 B0' - '41 64 22 23 44 45 88 23 1A 20 B2 11 11 A3 06 C4 11 8D 04 58 22 23 44 45 88 22 C4 68 E9 C8 36 08' - '8C 11 A3 04 4B 54 A8 82 31 11 46 22 0B 04 46 08 D1 83 05 9D B7 1C 23 11 06 22 1B 4B 04 46 08 8C' - 'BB D0 9C 3A F1 D7 8E C1 66 41 88 83 10 45 82 30 44 67 5D CC 16 20 8C 44 1A 65 24 58 22 30 44 53' - 'AE DC 83 62 08 C6 30 60 88 B0 44 60 C4 66 44 16 20 8C 44 18 22 2C 11 18 22 33 22 0B 3A EB 84 62' - '20 C1 11 60 8C 11 18 82 31 12 62 20 C1 11 82 23 04 46 20 8C 04 98 88 29 D5 C9 D2 23 04 46 08 88' - 'CB A7 41 18 89 31 10 60 8C 11 18 22 31 04 62 24 C4 41 9D 77 22 22 23 04 46 20 C1 88 83 3A EE 44' - '44 46 08 8C 41 83 11 04 44 44 46 08 C1 18 31 10 44 44 60 8C 18 31 10 44 45 24 60 C6 22 E9 C8 31' - '05 DD D1 11 18 BA 70 D1 11 8C 46 0B A7 23 44 11 11 88 8B A7 22 88 8C 41 82 E9 C8 D1 04 44 40 E7' - '45 D3 86 88 81 DE 27 45 E0 30 60 BA 70 B1 04 44 44 5D 39 14 44 5C E1 83 05 CE 16 21 94 B9 D1 11' - '11 73 91 44 45 CE 18 30 5C E1 62 0A 22 20 48 B9 C8 A2 21 10 30 60 B9 C2 C4 11 10 24 04 40 10 00' - '1F 88 01 00 20 00 6F 95 7D DF 4F D6 A9 56 FD 57 01 54 1A A8 84 71 31 2D E1 55 B7 49 50 DD BB 76' - 'ED DB B7 ED F6 D0 41 04 10 41 04 10 41 04 10 41 04 10 41 04 10 41 04 10 41 04 10 41 04 39 F1 83' - 'DA B3 66 CD 9B 36 6C D9 B3 66 CD 9B 36 6C D9 B3 66 CD 9B 36 6C D9 B3 66 CD 9B 36 6C A0 3E 78 E3' - '0E E0 71 C6 88 EE 47 74 34 87 76 3B C1 DE 8E F8 7D 01 88 77 E3 4C 78 03 C1 1A 83 90 39 23 54 72' - '86 B0 D7 1C B1 E1 0F 0C 6C 0F 10 73 07 8B 33 11 8C 3C 29 6B AD 29 59 32 14 C1 C0 4F EA 1F 4F F8' - 'CF 8B F6 FE DB D1 F4 3D AF B4 F8 AF 67 EC BD 8F 9F F1 FF 20 30 5F 60 72 34 11 11 11 17 38 68 8C' - '44 18 2E EE 8B 24 44 44 44 45 93 06 20 C1 18 D2 66 EA 74 44 44 44 59 11 77 72 0B A9 C2 EE EB 24' - '44 44 44 63 49 88 81 10 22 2C 97 77 44 44 44 59 28 0C 11 64 B9 C2 22 22 2C 49 18 30 46 8C 04 44' - '44 58 92 30 60 BB BB 46 03 04 44 44 68 C9 82 E7 08 B1 20 44 44 68 C9 18 34 18 22 24 88 C2 52 44' - '60 22 40 30 44 49 11 84 A0 22 30 18 0C 98 88 92 30 94 91 19 33 AE E6 03 04 44 06 04 A4 88 C9 18' - '80 8C 44 91 9D 75 C3 11 19 23 11 11 18 88 08 C1 88 8C 49 18 88 88 C4 19 30 62 22 30 44 41 88 C4' - '49 9D 77 30 62 23 26 08 23 04 44 13 BE C3 2F 1E 18 0A 48 8C 91 46 20 8C 11 12 60 C0 52 44 64 C4' - '41 18 20 C9 44 60 29 23 26 22 08 82 22 4C EF 12 F1 E1 82 24 88 C1 8C 41 06 22 24 D3 C5 4F 17 8E' - 'DA C1 53 04 11 11 92 8C 41 06 22 20 30 04 44 64 A3 10 46 22 48 C1 82 22 32 46 22 00 C4 49 83 04' - '44 60 C6 20 8B 11 82 24 A7 5D 73 04 50 14 91 82 20 8A 08 C1 12 68 C6 08 A0 29 23 04 44 11 41 18' - '22 4C F1 5B C2 6F 1E 18 22 80 A4 8C F6 3E 7F C4 FB 0F 88 F8 7F 86 F8 5F 5F EB BE 13 E0 FE 0B E0' - '7D 6F B3 9A 3C 6C 59 98 8C 59 B3 66 CD 9B 36 6C D9 B3 66 CD 9B 28 A2 8A 28 A2 8A 28 A2 8A 28 A2' - '8A 28 A2 8A 28 A2 8A 28 A2 8A 28 A2 8A 28 A2 8A 28 A0 BD C8 2F 74 0B A4 0B DD 82 F7 80 B9 DC 60' - '5E F8 17 E8 02 E2 05 EF C1 74 C1 7C 00 5F 04 17 50 17 90 0B C9 0C C5 43 32 50 66 2C 19 8B 86 64' - 'B0 CC C2 0C CC 30 DA 60 36 B1 03 6A 60 6D 62 86 D6 30 6D 0C 36 A6 86 D3 21 B4 D0 6D 36 1B 58 E1' - 'B5 38 36 B2 03 6B 24 0E C8 9D 8E DB 4C CD 1E 36 2C CC 46 30 F0 A5 AE B4 A5 64 C8 53 07 01 3B F1' - '7C 67 C5 FA EF 6F ED BD 1F 43 DA FB 4F 91 F9 2A 31 04 50 46 08 9F 33 EE FD DF EC 7F 61 D7 FA 9F' - '43 FD 7F D3 FC FE 7F F9 78 2A D5 AB 56 AD 5A B5 6A D5 AB 56 AD 5A B5 6A D5 AB 56 AD 5A BD 8E AD' - '7E 9E 76 76 76 74 AA B5 5D 75 DF 07 83 C1 E0 F0 78 3C 1D EE F7 7B BD DE EF 7F 73 63 18 C6 31 8C' - '63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18' - 'C6 31 8C 63 1F 73 5D 90 D7 68 3B AD 87 77 1C 3B B3 83 BB 90 1D DC 90 DD 70 37 72 83 77 2C 37 67' - '86 ED 00 DD A2 1B A4 0D 4C C0 D4 A4 1A 94 C3 50 A1 A8 60 CE A8 1A 99 A1 A8 E8 6A 55 0D 4A C1 93' - '13 BA 11 3B B1 13 BC 11 3F 50 6B 15 F6 08 AD E8 8A B6 FB 90 45 EF 84 5A 58 24 0C 0B C0 05 83 0C' - '0C 8C 35 4B C1 13 30 A3 89 28 90 4A 43 8D 5C A1 C2 42 20 34 91 8A 12 31 62 47 2C A8 38 A6 1E 8F' - 'DF 20 94 48 46 88 45 B2 31 C2 46 3C 71 24 03 1B 99 24 1D A6 3C 30 C7 88 18 F1 43 19 40 C6 54 31' - '96 1B 5F 99 17 BF B4 F3 BD 4F F7 FA 18 F1 83 19 70 C7 8E 18 CC 06 3C 80 C5 30 BD 99 1E C6 D3 5F' - 'E7 A6 E4 4C 71 E5 F8 D2 D2 B2 9C 5E 27 0E 4E 4A 46 42 3E 3B 85 1A 94 C5 8C 8B 8A 89 88 3B DD 87' - '49 B1 86 FE 90 BB 4E 0F E0 85 1C 26 DF 6B 07 C0 82 D1 7F 42 4F 5F AD 3B 3F AB 5F A8 C7 4B 3B A3' - '41 EA D5 5D CD A8 62 D3 A5 98 4A 34 3D F7 BE 03 80 00 2D 00 00 0E 00 38 E0 00 A4 8C 98 88 22 82' - '23 11 26 7E 73 F3 B2 F1 E1 82 28 0C 44 60 88 08 01 08 00 04 00 80 3F 00 03 F0 E1 50 50 50 50 50' - '50 50 50 50 7B 31 9E CC 66 B7 5B 19 ED C6 7B 71 9E 7E BA 33 5D 19 3D 41 E8 AB AC CF A3 E9 4B F3' - 'B0 BC EF 3B D2 63 5F 13 5E 66 BC CD 7C 5D 7C 6D 71 EB CD D7 67 5D AD 7A 4E D4 A3 4B 77 ED E8 D0' - 'A5 47 B4 4E D6 67 6A 97 6A 9F 68 BD A6 08 42 10 84 21 08 42 10 84 21 08 42 10 84 21 08 42 10 84' - '21 08 42 10 84 21 08 42 10 84 21 08 42 10 84 21 08 42 10 84 21 08 42 10 84 21 08 42 10 84 21 29' - '52 00 0B 40 00 03 80 0E 38 0C 44 60 2F 72 E4 11 41 11 83 24 46 08 A0 31 11 92 2E 72 08 A0 88 C1' - '80 8C 11 40 62 32 60 D0 45 04 18 32 45 DF 2E BC 78 C4 11 40 44 46 48 A2 20 8A 08 20 C0 46 08 A0' - '29 23 24 62 08 A0 88 22 40 C6 08 A0 22 32 46 20 8A 08 82 22 48 BB C2 F1 E3 04 50 18 08 C0 58 82' - '28 20 C4 44 91 9A D6 2D 78 AF 1D E3 04 50 11 82 32 51 04 50 41 C3 91 12 46 08 A0 8C 11 83 B7 75' - '10 45 11 88 88 92 23 04 50 18 23 34 C4 11 41 01 11 24 46 08 A0 30 46 02 88 22 31 88 88 37 39 14' - '45 8C 18 4C 51 1B 04 44 41 44 51 16 28 08 C1 11 8A 23 62 08 31 49 78 B7 83 BC 22 88 B1 82 30 51' - '8C 51 B1 04 44 11 88 A2 2C 60 31 49 18 A3 60 C4 41 45 77 85 DE 11 45 88 C1 82 23 14 6C 1C 39 11' - '49 88 A2 C4 60 A2 28 8C 51 B1 88 8C 60 C4 51 16 30 60 8B BB B1 46 C4 44 44 18 A2 C5 26 08 22 8C' - '6C 11 88 84 C5 18 B1 11 18 31 14 63 62 4C 44 18 A3 16 32 46 0C 51 8D 83 11 09 A3 16 22 30 41 46' - '36 24 C4 11 A3 16 32 46 0C 41 A3 1B 04 62 20 8A 8C 58 88 8C 18 8D 8C 6C 11 88 82 2A 31 62 22 30' - '62 36 31 B0 62 08 8A 8C 58 88 C4 44 6C 63 60 C6 48 8A 8C 58 88 8C 44 6C 62 82 30 44 45 46 31 11' - '11 88 8D 8C 51 26 08 88 A8 C6 32 44 62 23 63 14 49 14 44 54 63 11 11 88 8D 8C 51 24 44 45 46 31' - '92 31 11 B1 8A 08 80 80 70 A8 63 A8 63 E8 64 28 64 68 64 A8 64 E8 73 33 38 B4 52 94 52 B4 52 D4' - '5C 6A 29 7A 2E 3D 14 C5 17 22 8A 02 02 02 02 02 02 02 02 02 02 02 02 34 68 D1 A3 46 8D 1A 34 68' - 'D1 A3 46 8D 1A 34 68 D1 A3 46 B8 8E 08 DC D8 B1 62 C5 8B 16 2C 58 B1 62 C5 8B 16 2C 58 B1 62 C5' - '8B 16 2C 58 B1 62 C5 8B 0C DC 33 1D 94 59 B9 66 E9 94 99 BB 66 F1 9B D6 6F 99 E8 32 26 6F D9 4D' - '9C 06 70 59 51 99 0C C9 65 56 65 32 B3 2B B3 2D 9C 26 70 D9 61 9C 46 66 33 8A CE 33 23 66 6B 2C' - '9D 34 78 D8 B3 31 18 C3 C2 96 BA D2 95 93 21 4C 1C 04 EF C5 D0 BE F6 FE DB D1 F4 3D AF B4 F8 AF' - '67 EC BC FF 3E 2A 31 88 88 C4 46 C6 28 22 22 2A 31 88 C1 88 8D 8C 50 44 44 45 46 31 83 11 1B 18' - 'A0 88 88 A8 C6 23 21 B1 46 08 92 A2 88 8D 26 36 28 C1 92 28 8D 14 45 24 60 28 A3 12 44 9A 28 88' - '8C 51 44 98 34 63 26 0C 51 40 44 44 68 A4 88 C4 45 14 07 9E 77 5F 01 F0 1E FF EB 3C 9E 4F 37 D6' - '7B 0F 61 E4 F2 79 3C CF 33 D5 FA BF 57 EA FD 5F 9F E7 9E F9 EF 91 16 48 8C 44 18 22 20 08 01 08' - '08 08 01 08 08 08 40 40 FC 40 41 E9 7A 5E 95 35 9D 3D 9A AB 35 76 75 16 75 36 75 56 75 74 15 76' - '75 96 3F 76 C7 A8 79 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 79 FC A9 AC 56 AD 5A B5' - '6A D5 AB 56 AD 5A B5 6A D5 AB 56 AD 5A B5 6A D5 AB 1F 27 95 27 97 27 99 27 9B 27 9D 25 09 3C F9' - '31 A4 DC 49 8F 25 19 37 32 6E A4 A5 26 EE 4D E4 9B D9 37 D2 7A 12 45 26 FE 4A 72 70 24 E0 C9 52' - '4C 85 30 70 13 BF 17 42 FA F6 F2 ED 2B AB 94 63 DC 46 E7 A1 CE E6 F3 39 7C A5 55 38 00 E0 03 80' - '2D 00 0E FF F1 77 24 53 85 09 0A 9E BD F7 D0' -} - - -LANGUAGE 0,0 DECOMPOSITION UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE -{ - '42 5A 68 39 31 41 59 26 53 59 D6 98 E4 73 00 55 E0 FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF' - 'FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF E0 5D 34 BD 07 43 D0 03 40 00 09 00 1C' - '07 D0 88 2F 00 54 65 96 24 81 4F 29 20 02 EC 00 68 29 20 49 20 2A 42 15 52 40 0A 14 05 0D 14 00' - 'D0 54 AA 54 12 F7 C7 C0 00 0F 80 01 00 7D 45 3D 18 00 59 10 3E 21 BC DD 2B 10 65 6F 0F 9F 6F 97' - 'AE EF 80 00 3D 61 6A 2F 7A 52 7A 90 35 E7 67 2A AB 06 13 E5 00 76 32 BA 2F 44 87 70 D6 75 AD F3' - '0F BB CD D8 3E 83 DA 52 FB 61 52 A0 0A 1E 95 25 20 54 D0 D0 00 A2 4A A8 0A A9 44 80 00 00 78 00' - '0C 86 02 30 40 00 00 00 A0 01 F1 89 48 D2 46 8C D4 1A 7A 4F 14 3C 44 F4 F5 18 53 C3 51 9A 68 00' - '13 32 62 62 31 0C 04 D3 26 46 13 D0 C2 19 19 32 64 64 C8 64 C2 60 68 31 1A 34 D0 D0 00 0C 41 A6' - '11 84 C0 60 93 4C 13 C8 0C 86 15 54 22 6A 62 02 68 19 00 00 41 A6 23 46 9A 1A 01 91 36 89 A6 86' - '40 21 FA A3 02 69 A0 D3 26 D4 34 D3 46 48 A7 E4 61 A0 00 4D A6 93 D0 06 10 34 31 01 A4 7A 9E 80' - '32 9E A9 98 54 7E 29 E4 31 A9 80 34 D1 34 DA 2A 0D 04 D0 1A 21 04 8D 34 C8 68 26 98 93 62 6A 3C' - '42 64 C9 3F 26 81 4D 84 DA 8C 4D 31 4D 95 3D 47 E9 4C 86 9E A6 9A 69 E5 1E A0 07 A8 1E A3 4F 51' - 'EA 68 7A 81 A0 00 00 00 1A 00 01 EA 00 1A 62 31 3D 34 9E 50 01 A0 1A 9E D2 48 93 02 26 42 31 4D' - '33 46 86 90 F4 29 B4 0C 84 D3 6A 6F 3D 45 00 00 26 10 F4 26 26 00 00 8C 46 43 26 00 01 32 60 26' - '20 C0 41 A3 09 E8 8F 53 D1 06 04 69 A6 02 61 30 9A 60 4C 06 82 4F 54 A9 45 26 9A 8D A2 33 28 F5' - '30 4D 31 1A 34 34 C9 93 4D 18 13 20 62 34 64 69 A1 A0 D3 1A 69 31 19 34 F5 0D 18 00 26 99 31 0C' - '46 01 34 D1 A3 40 68 00 00 D0 C8 C6 81 19 19 1E 41 34 1A 68 64 C0 00 49 A9 10 4C 89 A1 34 4C 80' - '89 E0 04 34 4F 53 00 C8 98 26 4D 30 99 32 64 32 64 D3 46 86 8C 9A 6A 30 0D 1A 9E 44 CC 4D 32 61' - '4D A6 26 44 F4 6A 61 A6 8C 09 A6 A7 A6 8D 34 1A 34 9E 8C 9A 46 D0 D4 F1 34 31 34 D4 D3 3D 53 F5' - '46 09 9E E7 F0 2A 62 E3 E7 B4 7C AF 2F AA E4 FA 0C FF 3F CE 5C 07 3C 3A DE 7F 2D C8 3E EE BF 1C' - 'FE 91 5E 6F 94 E7 74 5C F6 93 9F 65 8D 3F 2A C6 B5 AB 5E 67 5F 5B 5B 84 06 C3 61 B0 D8 6C 3F 8E' - 'C3 61 B0 D8 72 25 7F 9A 97 7E 2F 9E D3 12 FA FD 2E 2E 17 F8 79 DB ED 8F 91 E4 F9 5C 0E AF AB 96' - '9D 42 9C CC DC EC F5 5A 0A D6 2D 5D A2 BD 83 16 5A 6C DA B6 6E E1 C8 82 8C EB 51 DE AB C7 AF 9F' - 'C0 D6 1C 88 50 E2 45 8C 4C 79 12 4B 30 ED 9E DF 77 B8 DD 6E 35 FA FD 7E BF 5F AF 39 CE 73 9F 4C' - '8A 28 A2 8A 38 18 F8 FE 0F 93 CB F9 55 6A 72 38 9A 0C E5 5A AC B1 55 8A AE DD D5 79 57 EB FA 78' - '9F 76 74 33 EE F3 FB 8F 3B CE F9 AF 37 F2 9F C3 F7 3A 2D BE 01 B5 73 46 D7 C0 4D 11 06 2C 04 82' - '22 00 22 03 09 EB A7 AE CA 51 17 CB 1C FB AD 74 18 10 B5 6B 3D 87 AB 6B 1F 8D C6 FC 22 02 73 A2' - '15 07 6C 41 E7 FB 77 EE 9D 30 E1 D1 8C 63 32 F5 64 51 B3 B3 83 05 EA CB 2A AB 87 5C E0 F3 82 F3' - '75 32 23 D6 BD C2 44 08 00 30 14 76 F6 C9 48 3B 33 40 11 10 10 11 46 04 08 10 1B BF 7E FD FB 96' - '00 4C E7 C8 B0 62 C3 69 31 A2 6C B3 E7 BE 85 73 E8 3E 7C DF 56 FD FD DD DB 56 AD DB C1 D8 6C 2C' - 'AC BA 3E 8B 61 B0 BF B9 DE 44 BF B1 A5 37 7B 5B 6B 6A AD 84 B0 19 93 22 D8 25 33 BC 42 C5 24 E1' - '59 20 63 21 16 29 8D 1E 39 4B 26 4A 6C 3C 78 F1 E3 F4 5A 4A 70 DD AB 69 4E 5C B9 55 EB ED B6 DF' - '71 B9 F0 FC 4F 17 C6 EB 7C 65 14 87 6D 5B 23 73 01 E4 07 BB DB BB DC 6D ED EE 57 2F 78 6F EF A0' - 'AB E3 38 26 47 6B 72 AD 0B 44 FD DB F9 C9 DE 3C 34 D2 F7 A6 00 F7 72 F9 DE 0F EF A7 58 96 EA 15' - 'D3 D8 31 2C 7A DB FB 9B 9B 8B 86 CD AE 2D 2E 25 08 84 89 15 B5 F1 A3 46 8D 71 16 27 5D 9B 90 48' - '16 52 60 C6 F1 0E 64 6F 9A 47 AF 30 22 8C 59 72 FC 57 EF D5 AD 81 02 04 09 12 21 42 72 15 AE 53' - '84 EF AA 44 0F 7F 05 EB EF 1B 1C 3B C7 AF 5E BD 7A F5 CB D7 AF 5E BD 64 27 28 E8 BB D8 86 33 31' - 'D1 03 19 68 B1 4B 70 B1 01 F9 66 39 88 5B 0B 84 80 0B 32 2A 85 DD 5F D9 DA E6 E3 54 A0 22 E1 48' - '50 10 F2 30 1E 95 58 65 2E 7F 05 0A 8B 3F 2E F3 09 0C 37 CF 8B 52 BD 0C 16 5B 96 A2 48 5E B1 58' - '5A 8D D6 56 5C 92 49 24 92 49 24 92 66 C3 9E DC DC 9C B6 63 B2 6E 6E 4D FD CE 8F 41 FD 3D B0 E5' - '79 2D DC FE AB F3 BD 03 0C 23 BC 45 A9 73 2C 30 58 B1 C6 8D 69 B2 8E D8 2E F6 C5 0B F7 92 0B 30' - '1D 5D 3C 93 25 5B 27 97 38 AA AA F6 B3 13 09 C5 26 28 E1 B6 6C FE 85 AE 55 86 1B 36 99 75 61 9C' - '95 97 89 96 7E FE 24 4A 58 31 A3 59 D0 AD CB D6 A4 A2 C5 AD 4D 38 46 C6 B2 AF 2D F3 95 71 0D 59' - '36 69 66 46 8D 1A 32 90 92 AE B0 98 58 8E 17 41 F3 54 72 AD CF 35 15 66 B1 35 AC C9 93 26 3D 7A' - 'F5 EE 03 B7 68 3C B1 92 C1 72 D2 A5 45 8A FD 2B 05 2B AB 97 55 56 96 EF 2B AB 8D 1D BC A7 55 8E' - '59 46 43 15 24 47 B0 8E CD F5 EC 99 11 E0 CF B4 B8 B3 B1 A9 52 A5 4A 95 2A 54 A9 86 A2 8A 28 A2' - '8A 28 A2 96 37 36 74 6C EC 28 D1 9F 63 46 8D B5 A5 AE 46 FA EA EA EA EA FE FF 22 FE 95 EB 46 EC' - '96 DE B5 0B E7 0C BC 36 66 8D C1 5D BD 7F 46 3C B9 72 E5 CB 97 2E 5C BA 4D A4 D6 56 DF 33 7D 2E' - 'FA 65 E4 2B B5 6D E6 DB D8 D2 A4 E6 CE 64 CB A6 B1 A9 81 2D E5 C9 93 26 4C 99 32 64 C9 68 A2 8A' - '28 A2 8A 28 A2 95 CE 06 C6 66 7D DC 07 11 24 52 75 70 23 F1 BD AF 56 2D 8B 7A C8 21 04 44 60 8A' - '10 50 42 0A 08 19 A5 75 75 95 95 73 5A D3 B7 B8 B1 97 3D DD 37 16 A2 02 04 07 2E 4A C8 94 44 AB' - 'DD 42 9D 67 63 36 3C 17 16 2C 59 D6 BA B7 94 D6 23 FB 9B 49 B3 E1 53 81 08 40 60 C1 2D 71 01 40' - '86 53 88 BC 6A D6 E9 9B 18 B4 DA AA 0A B5 41 A9 01 74 0C 22 F6 8D 10 C1 6D 79 2A CA 74 66 CD 01' - 'A3 64 01 06 A8 21 75 83 41 74 E3 CD AC 91 BE CA 22 E1 F0 83 06 BD 9E 6D F9 BC EE 67 2E FB F7 B0' - 'B1 DC EE 6B D6 DF BF 2B 99 CC E4 DB C0 3A 8A 9B 9B 9A F0 DB 91 1E 3C 43 65 16 50 14 15 85 61 2E' - '5B 1B 1A 7A B1 64 48 8D FC B1 1B 2E 0B 8B 61 6C 25 81 6A BC 59 12 22 EF F2 B8 F6 09 C6 91 1B 16' - 'F4 F1 6B 64 43 B7 B5 6A 94 28 B1 5E 7A 12 59 10 BD 4D E3 F7 EF 77 D8 E8 C7 7D 01 E3 3E 8E 42 77' - '4A 3E 9A E3 F9 71 A8 A2 F6 24 05 6D 58 73 79 7F 79 4E E1 A2 4F E1 42 BE DF 9D E2 2E 30 6C 6E 56' - '87 15 87 B9 5E 2A F6 CB C1 41 58 6D DB DF D4 52 31 55 7A BD B1 2D B1 90 A2 25 42 89 71 44 0A 86' - '64 A0 E2 B2 BA 7B 4C 67 08 04 38 D2 22 C6 84 95 75 74 A8 CF A4 52 CB 26 AC 28 D2 33 67 B0 56 4B' - 'A7 CE E4 D9 35 3C 0B 8B 7C DA EC 40 11 38 82 02 08 0B 36 97 70 9C DE 50 C6 84 D1 56 D6 6E 5B 59' - '16 F1 AA 70 9E C2 86 9A 98 B4 13 90 98 3D 81 0D 38 AB 19 35 D1 4C 1E 3E AD 79 97 4F 3A 90 3A 6B' - '5A D6 8D 14 D2 08 F4 1F 24 A2 6E D3 72 11 1D C6 AE 9A D4 0D 06 BE 0C 15 F2 CB A6 0C D9 C4 B2 87' - 'A0 B2 4D CB 2A E6 A7 CD 92 FF 32 A4 17 34 68 CC 8D 1B 32 9D 8B 8A 20 5A 11 22 63 E3 9F 06 D5 3B' - 'C8 8F 34 19 09 CA 88 DD 57 B1 66 56 D8 24 FE F8 2C 63 CE C3 C8 6E D1 A3 46 8D 0D 7A D3 3B 74 DA' - '41 F1 DA 41 65 E2 B3 A7 C8 91 7D 99 55 DA 79 D7 50 23 66 6F 13 96 83 DB 4B CB A8 E9 66 51 B3 8D' - '12 25 4C CC 46 6D EB 21 42 C8 03 D0 6E 16 10 20 64 70 12 B4 B0 7E FD 13 DA 51 7A F7 D2 91 45 DB' - 'BD 2B 26 25 60 31 2A 7C 81 00 73 36 15 BC 08 1A 35 D9 95 CC 29 12 74 38 7A 3D 12 AD 0E EA 0A B1' - 'AC A2 37 E4 ED 81 61 52 0D 29 12 8B 1F 46 9B 44 A4 DA C2 85 56 62 62 0D 19 B3 35 08 4F AA 99 E4' - '00 BD 74 D6 33 4A 36 CE E1 2C 7B 29 EC 2D 55 D0 24 68 E2 2E 9C A0 05 10 28 E0 51 BB 83 06 AA A9' - '65 2C 33 52 56 BC AA D6 36 83 4C D1 F4 F4 00 D0 A1 21 A6 7C 07 9A 0F ED EB 0A EE 4A F3 E9 C7 8A' - '82 D9 50 59 A5 9A E5 29 4A 56 AF CE 73 C1 85 3D 50 CC 48 90 56 52 79 3E AC 58 B6 D2 54 49 37 0E' - 'E7 DA E6 91 8E 9E 63 2B 6D 6A AC 5D 1A 4E 65 BB B5 AC 81 01 2C 4A F9 C9 DA 97 92 86 BE 76 1A B7' - '35 D0 D6 A0 B6 82 1C 36 E0 AD 7A 73 5E E7 2C 21 C3 72 A5 7A 78 D4 6E 64 C5 8A 9B 6C DC A4 14 52' - '54 B8 D1 94 AF 4D 3B 2E 42 14 24 91 9B 29 04 E3 D4 83 05 35 2B EC 93 A0 7E 42 04 08 B4 0E B1 00' - 'A5 AF 55 5B 59 90 20 60 BA 46 B6 34 08 07 3B 7D 03 E7 D4 E3 C3 4B 19 77 EF D6 8A 8C 87 4E 8A F8' - '70 DD 3A 9C 6A 6E 9D 4D 35 0C F3 0C 52 39 F3 AE 5C D6 1C F4 1C B9 CF 47 45 1C BB 0C 4F 39 DF 30' - 'C4 E3 D1 7E CB 33 8E 7B 96 59 E4 ED 11 46 93 2C D9 CF A7 5D 99 76 EE CC E7 CC BB 77 38 F6 F3 9E' - '3C 31 A5 CD 65 9B 14 51 BB 61 85 0E 57 1A 69 08 6C CF 3E 2B 37 4B 4D 39 FA E3 E3 76 B5 52 CC DE' - '36 9A 4D 9B CB D3 4E C3 36 CF 13 5E B6 6F 1A DA 5D B1 E5 66 8D 04 F2 74 D1 60 7E 3E 59 33 76 E3' - 'DC CB 29 75 25 29 EC CF 30 D0 EE 67 9B B3 63 5E 9A 70 6F C7 5D 15 7A 79 E7 C7 39 F0 DC 38 F4 15' - '46 E1 BB 78 E6 34 26 CD CC 6C 1B 17 26 33 66 C5 7E 92 E5 2D 4C 3C 03 1B 0A C0 A5 46 23 E3 3A A9' - '23 28 67 15 30 CB 32 A3 62 96 A2 25 2D 4C 32 95 54 2D 2A 2A 73 36 C2 58 AD 72 8D 27 19 2C 15 8B' - '4C D8 17 0A D0 46 92 38 0D A1 59 A3 49 19 74 D8 3D 26 D4 D8 36 19 B0 06 15 C5 9E 19 A1 33 69 68' - 'F8 F8 0E 6D 1E 99 B2 C9 1A A5 48 90 A0 3D 51 45 14 51 45 14 51 45 14 51 45 2E DF 1E D4 CB BD 9E' - 'D9 D5 7B CA 54 2D 5D 22 F5 A5 AB C3 5C 30 E9 A4 F7 C8 CB 6F 69 00 D4 F0 1B 5A C3 3C D6 F6 B4 30' - '65 4A 6F 6D 4A FD BD C5 35 E8 C0 C1 6B 72 FB 05 B5 D3 9B 76 8D 9E DD 39 B9 6A E2 EA 85 D4 C3 5D' - '5F 5E 30 BD E4 AC 07 2A 50 7D 4D C9 AB 1E B3 78 C5 E1 AB 69 B1 76 D6 B5 DB 9B 0B 9B A4 E8 B3 76' - 'F6 3C 8B E7 56 D4 5E C8 75 7B 31 F5 F3 BB 59 A9 3A 66 F6 AD BB 6B F6 2F 8F 46 7D FB 37 DA 66 4F' - '49 D5 FB BB CA 40 EA FE FA E6 93 A9 56 93 2D DD 4A BD BC 95 68 EA 53 CA 96 F4 DD CB B1 9C E1 D4' - 'CB 1A FA 6E E5 DF 2B 4D 99 77 C6 BC 73 61 7B 4D CC AF 99 FB E8 6C 57 7C F7 E1 18 30 5D 57 7D D7' - '17 99 47 72 AF D5 42 BE B6 4C 68 90 5F 32 DD 45 14 51 45 14 51 45 14 51 45 14 51 45 14 51 4C A4' - '15 BE BA FC 08 0D BE BA 75 20 30 FA A3 E7 74 6A 39 7B 80 FE A3 98 15 1B C1 9C DA 15 46 B0 F0 6A' - '2F 16 A2 F1 70 97 87 E5 65 1A C2 59 7E 5B 28 DA 13 F7 F8 2E 60 9A 9B 98 34 9C 41 9E D6 0D C2 F0' - '6B 2F 17 87 F7 25 78 D6 24 BE 25 E3 78 DC CD E2 B1 A4 5D 38 88 5A 2D E1 DB B5 85 6C BC 2C AE C0' - '44 36 01 5E 80 11 02 08 88 E8 84 82 82 00 24 01 79 3B 5C 49 31 30 FD 7C EC C2 26 2C 12 89 E3 B5' - 'C1 9A 24 C2 20 4F 3E EA 08 B4 CC 0F 45 DC 63 28 6C CA 64 84 10 C8 32 42 62 A3 03 49 19 88 B2 9A' - '67 86 E4 40 8D E4 EE 77 93 AF 0C 90 26 31 8A 4A 08 A8 A1 14 83 30 8C 92 18 A9 90 49 21 64 34 8C' - '65 AE 79 96 40 18 15 FB 19 4D 85 86 7D BB 45 24 94 22 22 78 A5 DB 69 13 C7 4E DA E4 4C D5 19 28' - 'D1 45 24 43 0C D7 E3 6B 5E 94 5B 5E 3B 5A E2 DA 5B 66 B5 36 D9 AD 5E AD B6 DE E9 A3 12 16 C6 8B' - '26 31 89 23 18 B0 D5 57 AC DE 89 BC D7 5C AF BB FC D7 90 BA AE 82 D0 59 98 40 EF 8C 50 2D 8D 07' - '95 4C 98 64 FD 6A 7B 84 15 76 34 99 D5 16 70 73 65 D5 22 28 AA C9 92 14 C9 4C 7F 6A B1 90 1D 94' - '4A 44 58 70 49 27 6E FF 80 01 25 10 99 79 28 A2 A4 48 12 13 79 3B 70 C4 26 F3 1A BB A4 0A 1B 97' - '62 8B 62 F1 E7 65 DE 1E 19 DD CD 9C 5D 6F 2E EB 8B C7 77 77 0D CE 93 77 17 48 17 9C EE C1 E1 1A' - 'DC 23 6E EE 0D EA 0D 77 B9 F5 DE 38 DC 88 1C BA 73 B7 31 7A 6B 76 47 89 A3 C8 EF 2D D0 EE 23 49' - '80 2A 92 5C C0 F0 CE CC E9 91 97 EA 2A F8 7C 4E BB B7 F6 FC 72 8F DD FB FE 8D D6 D4 2D 93 69 7B' - 'E6 9F BF 00 B2 03 98 9F E0 DC 4B 0D F3 32 DA E3 C4 1A 60 35 64 3C 97 6E C0 B9 7C C9 6E 97 00 F8' - '9B D2 A9 52 1D AF 84 4A F8 A5 93 0A 69 55 99 60 31 43 05 4F A6 FF 25 BD BA A6 96 4D 9B 5E 52 C8' - 'ED AB 63 2D AE 93 A2 E8 1B B8 36 F2 6C 45 1B 59 DD AB 25 EE B2 5C 6D A1 21 64 24 51 31 D0 B1 24' - '74 81 B4 DB 09 07 01 5E C5 98 5A 26 26 D5 35 8E 02 A7 6A 76 C2 18 31 AA 06 9A BC B5 D2 A5 72 EE' - '45 11 8D E5 A2 57 06 95 55 5A 55 80 BA 18 2B BB C4 3B 26 A9 A5 2F 6A B3 85 20 6D 36 DB 69 B7 64' - 'D4 06 DA 12 14 24 51 31 D2 16 16 83 A4 0F 0B A8 A2 6E 8A 88 70 16 38 DA 59 C2 D4 98 9B 55 82 16' - '0D 53 48 6A 27 85 18 3B 32 CA 26 06 02 4C B7 71 71 A4 BE 5B B1 C6 EE 18 A0 B0 58 A5 F2 AB 29 6D' - '53 C2 52 76 69 D5 EA 53 48 A7 4A EE 95 DA B1 7B B6 38 A9 A2 64 B1 74 2C 94 8B 2A 25 26 FB 51 C1' - '45 17 45 98 1A 18 CC 36 16 AC 0C 50 A3 A8 9A B3 65 58 B1 49 6B 15 B3 7D 58 AA 38 63 2C 3E 61 26' - '02 60 A8 5E 2D 9D 87 08 10 45 18 89 3C FC 21 E7 C8 80 A4 81 D2 36 EC 99 2E B7 6C E6 EB 57 56 CD' - '5C DA 36 7A 54 AB C3 78 B5 74 C6 4D 19 A6 13 09 B6 DC B6 16 46 D3 AA 92 75 72 09 24 E0 2F B0 E9' - '7B B0 18 30 82 84 22 98 6B AF 24 F9 8D 84 A2 8D 6D D8 2A 5F 2A 8B 6F 7A 3C B9 B4 08 05 52 44 02' - '01 49 22 01 00 80 5B 74 B7 4B 1D 23 41 6E 9D A9 4D 6F A7 4D B7 6A 8D 3B 0A C0 E2 51 6C AD 7E 23' - '78 9D 2B C3 91 2A 5F 2A BE 1D FB A5 F3 78 62 30 9C 99 A0 50 1C 15 79 AC B8 95 36 C0 D7 9C 64 B7' - '8F 17 19 2E A6 BA 55 D9 BA 6A 0D 78 64 B7 8F 1D 45 D4 D7 6D E4 D5 49 B5 25 57 95 57 29 9C AB D5' - '3C 76 D2 AF 52 5A E0 18 4C 06 48 83 11 11 45 19 D0 04 87 41 0B 97 A8 5A 01 39 F8 C0 97 B0 2A B0' - '49 52 D2 D6 8A AC 2B 9E 0E 73 14 05 AB 5E 73 CC 8D 8B 78 D5 BC F5 1A 69 63 49 25 61 AD F9 6F 3C' - 'EF 1E 62 EE EB BB A2 22 22 22 36 DE 44 E7 CE 23 28 0E 85 4E 90 D0 E0 13 95 CD AE 73 98 CC 39 95' - '87 C5 E7 78 5E 9F 0C 44 E6 84 0C CA 80 2B 05 11 10 64 1E D4 25 4A 39 A0 72 F6 F2 00 1C 56 92 72' - 'E4 39 39 77 36 1A 3C 55 C7 A0 54 BB D4 F1 FD E7 92 BF 18 E2 30 E0 DF 09 47 32 E5 1B 5D BB 49 52' - 'F9 D7 90 EF 5B BC DF CB C3 11 C8 42 73 28 A0 A4 51 A0 62 95 54 9B 77 42 70 60 75 D8 14 6F 77 EF' - '81 45 F4 AD F8 F0 1B AF 80 E2 30 01 22 11 D4 D6 C6 DB 94 66 EB A9 52 F9 D6 BE 07 A8 DB 81 86 22' - 'A2 CD 1A 88 BB D0 16 EA EB BA 5C AE 81 DC E4 51 A3 14 3C F7 9B FC EE 05 F1 E0 DD 6E 0A 85 42 23' - '30 D2 BE AB E8 38 FE 3E FC 4C 72 11 04 44 10 44 43 5A 2B 65 6B 56 D4 4A 19 7C 6B 5D 79 9F 13 9B' - '89 8E 42 43 7D 14 7D 5E 95 AD 54 84 52 DE AD BE 9B 06 88 32 1B 41 81 FA 2D 2A C2 0A E8 EC 02 06' - '9B FD FF E4 3E F7 F0 D8 4A 40 C8 00 0C 18 13 B2 2F 59 05 CF 54 02 19 C7 09 83 10 A6 3D BD 5E EF' - 'FE 2C 25 22 C1 84 A9 D6 C8 B2 F8 F8 8E 66 B9 E9 81 96 51 38 28 AC 1D 34 2A 5F 1F AA F2 D4 5E E2' - '13 9E 12 87 36 73 F8 86 14 9A 51 FB 1E 55 60 23 1D 02 04 13 9A D5 75 19 05 26 92 34 7F D5 DD DB' - 'F5 64 52 1D 13 FA 40 FC 4B 20 22 C2 04 16 37 3B 99 42 89 D7 8F FB A0 20 18 74 50 70 6E C0 2F 6C' - 'ED 60 10 A1 3A ED FA FC 8F AF E6 E2 6C CB 38 41 64 05 02 3B 28 85 0F 0A 56 AE 18 15 2F 8D 76 FE' - 'B7 9B 6B 99 56 24 82 21 05 02 28 06 75 6C CA 97 C2 AF D2 FC 9F 19 DF B1 31 12 17 00 C2 00 2E 7E' - 'DF 50 6C A6 EF 0E 7F 1E 79 E8 10 3E 12 DC 4F 69 FA FA A4 24 26 35 00 69 A8 DD C0 42 ED 49 3A 57' - 'EF 2E 9F 5A F2 12 0E 2E 47 E2 E2 18 C0 01 09 A4 9D 57 F0 3D 9F B5 BC 84 84 C5 C0 AA 07 83 C0 04' - '28 45 34 CE D7 E2 E9 21 59 D0 81 D8 D6 C4 85 06 4D CB 7D FD BE CE D2 15 9D 06 46 11 CE 1F 3E E4' - 'A4 D2 4E 2E 3B 37 BF 87 21 29 83 00 11 83 73 7B 02 08 50 64 F6 74 F1 2D 6B 48 4A 74 CC 20 57 37' - '60 10 A1 14 E0 7C AD 68 88 C8 8E A7 5A 80 82 0C 9C 88 E5 F5 69 BB 21 21 31 91 CD 6D 60 48 50 8A' - '6C CB DC ED 30 61 12 F9 34 5A 10 32 83 24 F3 F7 34 CA 22 39 50 50 10 80 10 42 3F 92 76 64 28 1E' - 'DE 87 81 D9 B5 44 40 95 81 84 E9 9D AC 10 A1 14 C8 70 67 56 0D 19 42 A1 44 38 4E B1 20 10 A1 24' - 'FB 7B 7E AA D9 3C 84 A6 60 00 46 0C 18 30 E0 2A 84 78 3B 90 42 63 FC 63 F5 1E D6 11 91 84 42 43' - 'AA 56 A8 50 64 F3 2B F8 34 60 D1 31 25 BC 04 12 A9 53 28 1E AF B2 E9 63 FE 0F 61 29 98 09 DD 50' - 'A0 EC 96 B9 21 40 FF 29 9F 59 FA EE E2 53 32 20 5A 29 21 A1 83 30 66 44 A3 DE 41 DC 21 41 93 6B' - 'FE 05 58 34 41 C2 56 96 9A 5F 4D 25 31 97 77 69 DD 34 D0 C3 BC 40 15 55 55 55 55 6D B6 DB 4D F5' - '56 DB 7C 26 3E 13 18 C7 C3 7D 0F 13 C1 9C FF 0F 87 C5 AE 7F 81 C0 E6 26 E6 9B F2 7D 63 D0 96 93' - '5D F1 A8 11 10 E3 0E 21 95 17 8F C7 24 28 32 7D B6 5D CE CE FC 44 64 01 D3 ED D1 0E A0 19 41 93' - '5E 7B 6B CB 68 83 90 E1 23 09 E2 82 74 77 24 26 94 1D FC 5F D4 7A B9 C8 50 88 50 21 00 48 60 00' - '55 ED 40 07 67 0C 85 08 A6 4F C7 D1 DE 42 53 06 01 68 A0 00 41 14 1E 97 4B DD 09 A2 9D 5B E3 3F' - '7B 79 09 10 00 4C 18 40 44 43 C9 45 17 2B AD EE 02 13 49 36 5F 7A FE 55 E4 24 0A 61 34 40 A2 FA' - '25 EE 41 09 A4 E3 BC F9 3A DD 84 81 01 20 60 9C 8D 01 BB A3 BA 13 49 38 F7 E3 DF E0 DE 42 44 5D' - 'B3 04 05 0C 80 0A 44 5E DE 4B 00 6E 31 85 35 42 84 93 F0 B1 F9 5C 6E 62 42 40 10 C1 95 02 82 BF' - '74 E1 00 C0 B1 D3 86 59 12 14 68 9D 5C BC BC BB B9 48 5E 60 19 99 91 99 10 A1 E2 04 7A FD AB C4' - '44 77 99 A6 6C 48 4C 7D 0C F9 B9 EF E7 90 CE 60 81 83 2C 8E A1 53 18 4C 60 21 83 28 CD 3E DB 1D' - 'F7 DC 6F E2 42 44 2E 66 46 0A 9B 0B BD 22 0A A2 04 99 64 99 64 02 14 68 9D FF E0 F8 D8 C4 44 41' - '38 30 53 C0 F9 0A A2 11 C4 30 78 C1 21 73 2C 9E AF 67 EB B7 2D 11 12 0E 64 57 C9 10 2B 63 0D 8C' - '21 4A 89 D5 B3 EA F8 71 18 93 70 24 F1 FC 64 29 11 87 90 49 64 51 88 1C 50 BE D3 8B C2 70 F1 61' - '5A 11 21 44 F4 D3 A1 E2 D7 31 12 19 99 14 C1 A9 A0 83 CD D9 DC 12 14 A6 9A BC F3 7B 30 62 8E 53' - '35 50 EE F0 79 04 11 3D D8 FC 5F 25 DC 52 54 A7 01 85 77 48 C4 12 13 49 38 8F D5 E5 5E F2 15 9E' - '75 E5 91 0E 40 2F 90 20 CC 38 88 BA 68 B4 D0 21 48 F8 7E 67 5F 2C 84 E3 63 02 7B 51 09 DD 62 E0' - '21 31 BF 41 EC 24 D6 91 E5 D1 08 14 40 FD D3 AC 9C 82 1F 50 C9 0A 27 7F 37 F2 FA B1 48 94 9D 10' - '9D D5 AC 48 18 ED F4 FA 5E CD A7 11 61 B5 28 4E EB 17 04 84 C7 E4 5F F0 FE 85 F8 78 34 CF 80 D0' - '18 8B 15 16 08 CA 0A 47 82 A8 EA FE 83 7D F2 DF 4C 12 89 AE 3D 1E 56 31 88 CB 00 CC C0 A1 10 00' - 'CC 80 40 88 1D D5 9C 90 9A 49 07 F3 A6 D0 6A 03 31 23 40 11 00 87 9D 9B 30 69 5A 13 B0 42 89 AF' - '3B 99 2C 3B 46 A0 19 99 9C CC B9 21 54 21 07 66 5A 5F 2B CA 98 36 D3 B5 78 CD 74 C3 1D 4C C1 11' - '01 54 A4 4A 59 24 97 90 08 5A 8E 4A DB B7 5C F6 86 C3 36 D7 FA 5F A2 D7 0D 10 48 28 25 01 16 AB' - '5E B5 6C 51 29 1A DB AF F9 BF 2F 3B C9 C8 8E 88 A4 08 18 2F C9 28 81 E3 06 F7 0C 1A 69 0B F8 97' - 'F0 AF 28 CA E0 8C CC 85 0E 0A 63 BE EF 60 C0 C3 5F 13 C0 26 11 35 C7 4B 1E 8E 31 20 E4 54 32 24' - '33 00 91 41 11 12 20 30 7C 57 B3 91 30 68 A3 F9 CF EA 3C 62 4E 60 21 10 24 30 40 17 C6 5A 0A F8' - '57 BA 90 62 63 BF 73 BC E2 5D E5 2B 80 74 44 34 80 53 DB D3 68 8C 5D 70 94 A1 46 89 8E 56 AF 7F' - '88 CA 56 06 88 10 C1 96 30 A2 03 E2 76 32 CB 22 A1 44 FE 0F BB D9 BD 96 52 95 C1 99 80 88 83 9E' - '8A 0F 07 7B DC A4 51 9A 78 7E 45 FB 17 8C B2 D6 45 3C 25 78 1F 23 F1 71 BE 4B 5C 3B F8 5E 12 63' - '30 C6 B9 3A AD FB F0 C0 DE 64 0B 14 45 52 30 55 6A 9B 2B 5A DF 5D 75 98 CC 72 AE 3E 9B 97 B7 6E' - '38 9A 88 19 8A 99 9A 03 7B 3F D1 4B 90 62 F7 4B 8F 0F 18 C5 C4 CA E1 08 20 30 30 8A 0F 0B 85 B5' - 'C0 41 19 74 FC 7F A3 7B B1 48 58 84 CC 21 98 E2 9C 37 AD 11 0C 5F 0A 8C 48 4D 2E 1E 77 1E F0 29' - 'E5 96 E8 B6 AA 96 2A F0 AA 1F 17 7D 6D 8E A2 95 31 E7 F8 F4 D2 61 B2 0A 26 36 02 4B 51 6D 36 69' - '6A D2 91 98 65 A7 5F A1 69 81 A4 C5 51 06 46 08 52 0C 22 90 E9 A0 5B 35 96 D6 08 23 97 9B E6 D8' - '98 50 18 02 26 01 A7 3B A4 97 80 6F 35 EE A9 72 24 26 D2 F7 B9 30 B0 23 28 99 18 BF 3F 89 08 03' - '1D F4 6E B7 17 28 29 46 BA 3E BE 54 0A 22 40 CA 5D A4 43 7B 3A A3 CA 24 20 46 FC 97 3B 13 08 90' - '07 1B 78 0A A0 DD 9D 76 38 42 8D 1F C7 F9 FC A8 17 6E 56 00 CC C1 9C F1 8D D5 86 5A B3 5C F3 24' - '28 F2 36 E5 91 30 6B DF 01 44 2E AE AE E8 51 A6 AF A9 7F 66 05 11 11 7E 36 EC 20 78 D5 85 C6 00' - '42 8E 3B 58 E4 E0 A2 22 31 8D AA 21 8D 58 5C 61 0C CF E5 21 4A DE BF 53 E2 A9 30 61 8E 22 05 BE' - 'CB AD EE 43 E5 A9 4A FE FF EA 5C AB 18 DC CB 7D 7D 7D 78 5C 62 0A 52 AD FD 6B A9 5E 33 90 0E 70' - '73 78 BC 81 21 46 DE C7 3B EB 36 CC 7D 37 09 98 31 8A 2A 28 23 2D 24 AD 61 23 2A CF 78 AB 9B 5D' - '8A 33 F3 FE 87 B6 A4 D6 A8 43 32 90 06 67 6C DC 3B 91 31 46 9A 59 0A 13 AA 19 44 D0 15 95 50 9E' - '2B 43 4C 0E 36 61 31 B6 3D 77 51 AC C7 5D 4A 11 44 CD 46 9C AB 53 5D 43 09 8E 7E 77 E7 F6 ED BC' - 'C7 6E A6 60 88 80 AA 59 2B BA ED BD 86 EE EC 70 2F 72 62 95 FB 3B 3C 8B 94 6A 6E 60 4C 18 75 70' - 'EE C6 65 1D 3B BE A5 89 AD 52 24 91 91 19 18 B4 2C 2D 62 0C 51 9E 5E F7 E0 7E 46 05 57 05 33 13' - '01 03 AB 87 72 0C 51 9F E8 38 75 FB 50 28 BD 89 0C 19 CC C8 90 CC 81 27 51 C9 09 47 76 30 17 B8' - '01 8A 34 BF 89 A7 BC 81 46 B7 08 0A 60 18 77 0E E5 02 69 A7 37 CE 7F 59 89 9D C0 43 ED D3 80 C4' - '06 30 31 81 03 23 46 60 F0 77 73 EB 37 4B EE DD 43 92 52 25 24 62 6B A9 AE A5 E6 19 D6 BD 2F 55' - '79 AE B3 12 4C 90 DE 56 F4 B2 EE DC 6E DD 75 0C 34 EE 9C 35 36 ED 93 16 26 3B 01 29 7C 1D 8D 34' - '02 F3 0C F8 72 F4 D6 9A 68 62 0B 14 4C AA 94 95 50 A5 5A 0A 8A 98 D8 D0 D3 49 84 C7 3D 3A ED B6' - '9A E8 65 95 C8 94 2E B8 6A 6B A8 79 78 96 94 BF 57 C4 EA C0 A3 63 17 C0 E0 06 81 41 9F 8C D9 0C' - 'B2 0C 51 A5 FB 97 E5 C0 0A B9 09 19 9A CA DC 95 67 75 1B 8B 6D 06 61 9F 4F CC EF 96 0D 71 C7 61' - '49 4A CA E5 02 29 9B 98 48 1B C5 C2 B8 32 8E 7C 2E E5 38 D4 8C C8 CC 1C 82 40 85 AB 00 C0 CD FB' - '0C F0 2F B4 19 8E 7E 17 BD 76 CB 06 7B 66 2A 99 50 54 8C 10 A4 A6 FB 6C 5C 33 16 61 60 B6 00 C9' - 'A5 D1 E2 EB CE 04 F5 13 29 8E 48 6B A8 80 63 17 95 C2 DC 19 46 79 FC 77 50 27 52 29 48 42 C8 14' - '40 F9 D1 B0 5B 10 06 51 9F CD EF BE BB CA 80 14 B0 99 4E 0F 52 C2 ED C0 DA 5B 6C 66 1B FA 1D 74' - '0D 76 10 C8 CB 54 A1 76 E1 A9 6D 56 0C C3 3D 77 E7 E1 EE 1B 35 0C C5 59 33 A4 A2 9C 6F A1 6D 01' - '98 E5 A6 99 E9 70 D9 89 48 54 E2 82 A1 6A 46 4D 2A FA 7E 45 A0 05 A2 5B D3 B1 AB B3 8D EB C4 C8' - '19 46 9A AC 80 4D 98 8C 54 C3 C2 A3 D5 A8 62 97 C7 DE E8 58 0A 31 44 AB 51 CC A8 81 34 B9 D2 A2' - '81 46 11 26 A7 2A 84 20 4C FE C7 62 A0 57 74 84 44 8C ED 61 CD B1 08 13 4E DB D3 B4 00 B5 A4 26' - '67 1B 71 D6 C0 19 34 ED AF AE A0 5B 86 22 5B 86 EE EA E6 51 A3 E3 97 CE 80 17 88 94 DD 3B 6E EA' - 'C6 51 9B FC 4C 1A 81 68 C4 19 9D 6B E8 AD 41 93 4B E6 F5 E7 58 01 58 94 8C DA B7 5A 91 19 34 AF' - 'E9 7D 0E 94 00 B4 4A 5A 1B BF 3D 5C 11 94 67 8D E9 DA 00 5A 20 4A C7 CA 7C D5 C8 CA 33 7F AB C6' - 'EB C0 07 94 81 99 DA D9 AD 88 C9 A5 6F AD F6 0A 05 58 A2 0C EB 5C 2D 62 68 51 97 13 E3 55 40 97' - 'A9 12 90 B4 2D E1 C2 C0 CB BE B5 AC 04 EA 22 2B 5F 5D 6A 40 19 34 AF CD AA 81 56 27 95 AD D8 58' - '9E 7E CD C2 95 2B AD AA F0 02 91 12 1E E3 F4 16 C4 0C 9A 56 EF AD D3 80 16 89 48 5A DA D6 C4 46' - '4D 2B 76 47 5D 40 AB 14 7F 1D DF A5 08 CA 11 A0 E6 7D 8A 81 46 E1 31 24 74 FA 8A D1 98 65 5C BE' - '56 97 9A 69 0C BB 15 AA A4 56 AA 9A 4C E9 D7 AC AD 60 CC 27 8D AF 28 15 AA 52 13 40 7F 5F B7 B2' - 'AE 01 94 67 95 B8 CA 05 BA D1 12 16 E3 EE AD 8C 9A 7D 2E 4C 54 0A FA 91 12 D0 EC D6 EF A0 1C 8C' - 'A5 4C BD A3 75 02 96 28 83 30 66 0E 5D 8B 75 D6 C0 19 46 7D FF A0 EF 00 1E 22 43 EB FA DF 09 6C' - '40 C9 A5 6D 2D DE 40 0B 68 52 E4 99 A2 21 83 33 44 43 43 14 17 D0 D1 C8 CA 13 E8 F6 DD E0 03 C4' - '48 52 B7 5B 19 34 BA FE CA 01 4C 02 60 B1 7C 8D 51 91 AE 12 49 4C 81 35 E8 2D A9 19 8E CE B7 7F' - 'D5 D8 36 7E 46 26 53 5B 91 0C 81 0E D6 8B 60 0C A3 3D CF 2F D9 78 01 5D 38 A7 3A 19 FC 16 D7 88' - '5C CA 34 BF A3 7E 64 00 AB 89 4C 3C 1F DF C1 C8 8C 08 F1 FF 16 FD 77 02 BC F9 CC DE F7 CA 17 05' - 'A9 04 B4 E3 63 9D 80 30 F2 9F CC 86 BF 12 17 23 28 BB BF 9C E0 55 CA 40 CC 1C D2 89 F3 6F 1F 79' - 'E2 34 41 94 AF D1 BF 3E E0 56 42 F3 09 CB F0 D2 C0 18 85 B8 DC 9B 58 0B 46 C3 9A 74 50 6E C3 D1' - '57 32 69 F8 FD 9C FD 58 01 D7 7E 51 CC 1D 2F 72 F4 16 E6 51 A7 CE EB 5F AD 00 2E F2 13 E5 BF 25' - '5C 03 0D 37 F0 DF A1 00 1D E4 27 E2 B9 17 80 AE 0C 36 E7 1D DD C0 77 00 48 8C 8C 4D F9 E9 63 07' - '09 7B EF 49 00 A4 68 22 12 8B 45 A1 86 95 F1 55 02 BC 5A C8 4E D9 BA B8 23 6A 7B EF 39 D4 07 8C' - 'BD A9 85 73 F2 BC 15 63 06 F8 67 AF 47 E9 F6 DC 36 E5 3A FC D5 4A AA 55 2B 47 41 B0 D6 DE 1E AE' - 'D8 C3 11 14 BE 9C EB C0 0B C4 39 89 FA 76 4B 03 10 F2 5F C5 7E 9B 80 F2 74 DA A1 6B 7C C2 98 F8' - '10 C0 06 22 29 76 FB 47 80 0F 1E 35 90 A8 EF 55 72 30 C2 8F C5 F5 94 07 6B 19 4A D6 81 EC 85 88' - '1C 44 ED BF 9F A7 00 1E 36 30 27 EA BF 41 5C 11 86 13 7D FF 5D 40 B4 62 2C 0C 92 D6 28 19 17 BE' - '85 81 88 89 DB A3 C9 E5 40 07 89 58 C4 DD F8 15 C1 86 13 7F 4D FB 70 01 F1 C7 3B 69 3E 5D B0 1A' - '6D 80 D1 66 A6 89 A3 A2 AD 09 35 82 D8 D1 C5 CF 12 CF 7A F5 8C 20 39 BB A0 B1 03 0C 27 6F AB 9A' - '95 A2 2D 61 30 6B 6B 05 51 62 06 18 4F E0 6F EA CE 04 F2 1F 0E B4 06 AE E8 4E 46 18 4D E3 E8 77' - 'F0 2B 46 A0 18 33 07 CC 06 87 4E C2 20 B0 06 20 25 68 D6 B0 2A D2 93 14 9B A0 81 18 80 95 78 2D' - 'F2 E0 56 90 9D 85 0C CC 3E 4D B0 1A 6D 80 D0 B6 56 A5 65 8C A5 8E 9D 2A 9A 8B 62 CD 5D 65 D3 AF' - '4F 65 A2 B4 65 7B 05 0A EE 8E 66 01 88 09 F5 7A 8E F0 27 8C EC 41 00 33 06 64 66 68 F9 28 1D 26' - '0F F9 3C 00 C6 14 4D 10 80 26 10 40 82 BB B7 BA 95 E3 29 04 AD 10 54 14 03 2A 09 65 CF DB E0 C0' - 'AD 39 09 DA D0 35 16 2F 38 D0 44 4F 73 C0 CD E0 4F 2D 80 02 F6 C9 28 0F E1 DD 03 83 80 D5 F6 9A' - '9D C9 E5 A4 C2 5A D0 51 60 0C 30 B7 56 DE D5 8A D2 18 F8 22 D5 10 BD D0 5C 8C 40 5F D8 BE 57 2B' - 'D8 A4 0C C1 E8 46 10 53 E4 BC 0C 28 72 30 C3 D3 B5 AC 4C 7F 65 10 B5 A2 0A 02 31 01 E9 FC 8E F7' - '6D 49 B0 0F 20 88 27 6B 08 1F A8 CF 10 83 5F A1 A3 B9 30 70 99 85 13 BB BC 1C 06 1E F9 6F E1 79' - '5E 8B 97 12 25 37 70 03 AB 80 61 87 DC F8 FB 7C CB 15 A2 04 BE 65 8B 88 F0 70 71 D5 BB E6 EA 37' - '27 88 A9 03 00 CC 8C C8 C1 CF D7 77 57 23 0C 2D F2 9F BF 72 77 12 50 84 86 0C 4D D6 CB 62 30 C2' - 'DD EF 66 85 56 08 28 5C 65 13 B6 4E AE 44 64 C1 FD D6 47 62 76 8A 8B 4E 02 16 B1 11 39 91 3C 22' - '0C 44 71 3E 15 EE E1 B1 74 53 B0 A5 52 AA 95 4A 51 2D B7 6E DB 6D 91 30 3A 6B FA 8E E7 A9 86 2F' - '57 C5 F6 61 44 1D EA AE 44 0C 30 78 66 EE 35 C6 47 D1 C6 14 42 F7 2B 2D C1 18 61 EC 7C BB DC 5D' - 'A2 6B 7B A8 83 D9 2C 44 62 19 7A FD 9A 8B 34 4C 03 A6 48 28 46 21 BD DA A5 05 18 14 78 28 82 84' - '46 20 29 E7 F1 39 D5 15 88 E2 83 29 DA DB A6 66 A1 C0 30 C7 FB 2F 35 E7 61 69 15 49 49 02 4D AA' - '82 A0 C3 1E 3B 5D 5A 06 02 80 C4 69 40 94 23 28 1D F4 A5 03 01 40 81 02 46 94 50 61 68 08 C3 1F' - '2B BB D3 A0 CA 20 51 50 4A B5 09 52 06 20 74 F0 7C AC A9 35 C8 CD D5 76 5B 5D 4B 58 4C 1D 7A 6F' - '31 A4 D3 13 17 49 73 A5 96 BE B8 6A A5 B5 88 C7 C1 E0 E4 F6 27 90 91 8A BA 05 B0 3B 03 0A 7B 9E' - '75 AA 55 8C 4F 87 84 20 5A 83 A8 43 28 B3 DF BA 8F 9D D2 69 BF 2C A8 A2 AB 60 B5 B0 89 77 C9 F7' - '0D 9B 26 13 30 51 31 CC 73 04 B3 C9 E2 79 99 CC 03 3F 9C A3 2D 83 B0 12 CE CF A1 CE 70 60 1B 04' - 'C6 B3 16 84 C0 31 03 9F B7 7A 15 22 07 83 5D 97 F2 DA C2 E0 EE 0C 7B C3 C7 9F 8C 16 28 4E EE A2' - '97 B9 4A 59 D7 A3 D7 59 81 97 06 96 33 D8 37 22 59 F9 DC A5 8D B9 51 86 4E 40 96 7B 5F AD EB D0' - '98 AC 65 19 91 1C CC 29 E3 C7 DD 99 6A 88 A0 32 95 07 56 A0 28 81 D7 95 42 58 03 41 CB 2C A4 B1' - '77 9B 9E 52 D7 17 63 2B 3C F3 2C AC 4B B9 9D D7 39 6B AE 66 25 16 CF 3B C2 C5 DF 1B 9E 72 F0 BE' - '46 59 58 00 62 5D D9 DC 3B B6 72 FA 98 8E 48 16 94 80 51 03 A7 81 32 58 14 CC 24 C4 E6 00 51 03' - 'F9 FE 7D A8 4C 28 0C 46 94 A0 52 EF 33 BA F7 8D 93 EC F1 34 11 13 2D 00 D2 8B 3B B6 6C D9 3C 96' - '33 66 DA 99 E9 26 97 2D 20 75 BD 6A 5F 2A 20 A8 40 15 28 54 10 3A 72 69 42 A4 41 50 52 82 82 07' - 'DC EE FB 74 2A 44 15 08 85 28 42 82 07 E2 FD 69 94 D8 31 94 E7 30 50 10 3B 72 A6 5A 98 86 AA 0A' - '50 A8 18 FE E7 CC F6 2A 4C 05 29 4A 50 31 FB 3B FF 46 80 30 63 28 D2 94 52 0C 18 FD 8B 4C 08 40' - '18 99 A2 4E 73 21 00 C7 6E 24 C0 84 0C A1 20 08 A5 22 63 30 C7 8F 2E F4 01 98 C0 98 9C C8 A0 20' - '74 F2 2D 30 18 84 E7 32 98 81 CF 99 E0 CC 06 29 CE 60 4C 40 E7 D7 EE 4C 06 13 13 CC CC BB 9F D9' - '64 1C 58 60 CC CC F3 87 DB 60 60 F9 0C C2 D6 54 32 32 CA 4B 97 7C 87 A9 C8 2F 75 72 32 CA 05 CB' - 'BF 55 96 41 7B A6 59 65 72 EF 6C FA DE 1C C3 0C 1F 2A EC 00 0A 50 13 0F 08 FD C9 81 25 31 A4 E7' - '32 60 C6 FE 56 28 18 4C 4E 64 53 10 39 FA D2 10 09 02 49 11 20 30 A5 A6 CC 26 06 06 84 1B 44 10' - '01 20 90 78 79 D3 F4 5A FC 6C 1E 27 CD DE 7D 7F 56 EF EC ED 6F BC 48 9D 97 77 B2 DA 79 4C AB F8' - 'E9 E8 26 69 B6 AF F8 28 F9 95 1E 8F 1F 4E 02 9D A5 14 ED 17 06 6B B1 2D FA 70 7E AF 63 7B EF 69' - 'E2 7C 7F 5F 4E 62 7B 69 31 F2 7C 8D 39 D5 1C C9 5E 6C FE B0 E4 55 C1 4F DB 43 F9 2C BB E5 D7 60' - 'D4 49 4A 87 09 6D 8D 1D AF 46 FA CB 0E 9A DE BF BE E6 1E 8D AD 9A 0B 19 AA 8A A9 5B 0A 39 B9 C4' - '54 21 65 56 77 ED 67 E7 ED D6 AE C2 65 87 7E CB 17 4B 4B 1B 53 53 15 D3 A6 59 7A 97 BA 96 54 E0' - '54 02 79 C9 8A 9B 8A 66 AB B1 8D 5C 2B B8 CF 5E FD C7 DC 7A 4F 4F DE A1 00 A3 28 53 7F 9D BB 47' - 'A3 73 27 D9 AE 22 29 50 21 32 0A 02 94 20 09 4A 94 0C 11 49 28 90 18 D0 FF 67 57 0C 49 09 22 48' - 'A4 63 4C 6C A6 82 33 46 18 4A 42 10 81 11 10 FF 9B 8D 04 C6 20 C3 FD 0B 82 12 69 13 61 4D 84 09' - '19 A2 82 9A 44 48 36 18 30 B3 4C C1 8C A4 4C A0 CC 9B 18 10 14 89 31 85 11 52 4C 94 99 0A 26 C2' - '50 6F B1 EE A2 09 24 D8 C8 80 45 18 98 5F F2 71 0A 63 12 C9 98 C6 49 12 49 A2 98 C0 CA 23 24 08' - 'CC 9A 29 96 F9 0E DC 92 89 21 21 49 02 30 88 69 30 33 48 C8 82 02 05 31 12 62 14 40 26 15 F6 6B' - '91 26 61 29 9B CF 57 E4 99 7E 86 DA BB 4C D7 76 ED 33 4B 34 B3 4B 34 B3 5D D5 DA 24 EC 9A 56 EB' - 'BB FA 00 00 6E 59 04 00 06 38 AC 46 DC 01 B9 60 80 00 0D CB 20 80 00 C7 2C 82 00 03 1C 56 08 00' - '00 DC B1 1B 70 63 96 23 80 0C 6D 80 00 0D C5 60 80 00 0D B6 00 03 1B 60 00 31 B6 0D 80 36 D8 00' - '00 DB 60 D8 03 6D 83 60 0D B1 B6 0C 6D 80 00 0D B6 00 00 36 D8 00 00 DB 60 00 03 6D 80 00 0D B6' - '00 00 36 D8 00 00 DB 1B 60 0D B6 00 00 36 D8 00 00 DB 60 00 03 6D 80 00 0D B6 00 03 1B 60 00 03' - '6D 80 00 C6 D8 D8 00 DB 60 00 03 6D 80 00 0D B6 00 00 36 D8 00 00 DB 60 00 03 6D 80 00 0D C4 10' - '00 18 E2 08 00 00 DB 60 00 03 69 B0 00 01 8C 00 00 18 C0 00 01 8C 00 00 1A 18 00 00 20 00 00 04' - '00 00 00 80 00 00 10 00 00 05 5A 27 66 9D 9C C9 93 26 4B 29 93 26 4C 99 32 64 C9 97 92 ED D3 26' - '4C 99 32 64 C9 93 33 15 25 14 54 94 54 BA EA E5 14 51 45 49 52 51 45 14 54 94 51 45 E8 6D 7A E5' - 'EB 96 A4 54 12 58 88 CA D7 99 BC 56 2A DA 8D B1 16 A3 6C 6A 8A A9 9A C1 B5 A3 58 DA 2D 62 B1 B4' - 'CD 6A C9 B5 63 59 2D A2 B1 B6 4D 63 6D 15 B4 6B 56 8B 6A 8D 5B 1B 56 8D B6 CA 0D 7D 35 FB CB D3' - '2F F0 EF DE FF 56 36 3D 6E 90 CD 26 92 AA 41 9A 41 08 06 10 60 41 06 49 0B 79 23 65 AD DA DB 6D' - 'E4 D3 5A 2A 8D 6B 1B 6B 10 48 48 92 00 C9 02 43 3F 61 6B 03 35 12 01 7B 54 B3 0F D2 F3 18 DA 01' - '82 02 C8 40 DC 90 25 20 40 31 61 2C 90 9F A6 C2 5F ED A8 08 4B B2 40 E0 DC 54 22 C2 2C 22 92 29' - '23 08 C9 6D 99 B6 66 B1 AC 6B 1A AA F2 B6 D4 FC 83 5D 58 29 24 8B 24 91 B9 BE C1 00 B4 A2 A1 8D' - 'F1 B4 2F 55 0A AA 85 55 41 64 16 04 98 AC 40 42 76 DF F2 F0 1D 9F 5D D9 F7 BE 9B BD 7F 67 CA FF' - '0F F3 F9 BD 36 FE 9B DC 7B 8F D2 F6 7D 0C 5F 0E 2F 9B 13 CD F2 FC C8 BE 6E 62 84 7E AF 65 5F B1' - 'E9 76 5B 2D 8D 96 CA 74 EE A7 AA B4 D9 66 F0 F0 F2 D8 9F 66 5F 77 BB DE 75 18 7D 4C E2 00 70 44' - '80 13 A4 54 90 EF 8F EF A0 49 FA 0C 3C CB 09 80 80 1F 72 81 F7 08 7E 63 24 27 E7 32 49 82 2C 03' - 'CC 33 FD EC 24 27 F6 B0 21 3B 44 00 D8 92 62 7C CA FE 47 CD 30 D5 0F 32 FD EF DE D4 0C FD 75 7D' - 'EB EB 9F 42 93 FB 1F F8 33 F9 7C DD 7A E7 F2 DF BF 60 7E 5B EC 1F C5 5F D0 5F 6E FA 16 BF DE BF' - 'A2 FA A6 DF F6 79 DF 47 DA BA 8F AA 7A 3F 1F C1 7D 8A DF 9F 56 D5 F2 8B 6B FD 3F 3D F1 0B 9E 1C' - '31 E2 ED BA 43 27 5D 75 CE 89 DD 6E 26 64 D1 2A 6C 9B A7 03 77 57 72 AE 94 DD DD A6 BB B9 34 4D' - '33 60 4B 13 9B 98 13 28 60 4B BA BA 92 62 46 51 96 48 05 25 4B 1A 62 1C E8 46 98 08 91 9A 1B BB' - '82 32 03 28 90 9D DC C8 B9 D4 8E 5D 10 92 26 89 74 3A 92 89 00 86 07 77 0D 09 26 3B AE 92 64 05' - '73 8B BB 76 17 13 C7 AE B6 AB 5E 69 AA D5 2F A4 6E D7 A4 EE B1 8D 8B 21 55 82 A3 6F 74 FA 0E D5' - 'BC 2C 91 46 88 50 58 28 28 28 2C 90 9F 4C FD 19 F5 1F 87 FA CF 89 F5 5F 30 A3 C8 F2 F6 7F 63 B6' - '3C 01 40 81 DF 34 E0 78 07 D4 19 00 43 FA 05 5D D7 82 18 68 88 61 85 42 FF 22 3E E5 BE 6C 2F E6' - '1C B8 63 61 28 4C 2E 51 FF 29 BE 24 DD E7 A3 95 50 A8 68 7D D0 7C 80 7D 3E 58 6A B3 B8 FA EF E7' - '97 1C AE 80 31 B9 10 DF 68 72 D8 BA E0 70 EF 72 21 C8 8C 5D CF B5 45 21 F8 03 85 FD 5E FF 67 84' - '7E 53 F2 3B CD 7B 9F 0B 47 50 F9 CB D1 EE 7E 35 2E FE F9 F6 BD CD 57 F0 0A A5 55 55 55 55 55 F4' - '7E 83 F4 2F 7C 0A A1 57 0F 3F 8F D9 7F AF AD D9 C2 78 93 92 8F 17 F1 37 5B 85 F9 75 DD D7 86 AB' - 'E6 35 E5 3F CB BA 7A 4F 3B 9F A4 FD 3F EE F1 9D 77 55 E5 BA 3F C1 E4 D3 D0 15 4D CA A5 57 88 AA' - '55 55 54 44 62 C4 82 63 37 40 50 48 0A 80 08 88 A2 94 54 E2 A6 11 62 AC 94 48 91 21 C1 87 0A 20' - '26 DD BB 78 AE 05 74 81 25 D7 6E DD 87 09 03 64 C9 14 1C B2 52 81 90 63 40 0C C8 F8 79 7D FF AB' - 'EC 77 9E AF 83 DF F8 1B 6F 5D E4 5F 57 EA F9 BA 1E 87 F2 D7 F9 1F DB 75 BA FA 3E CF CF 8F EE 70' - '37 FC 4F 4B DC B8 B9 D2 81 3E DF EB 06 CB CA CD 6C BC DB BD BD B8 20 02 01 6C 01 43 A8 9F 7E 8A' - '47 0A 60 88 38 00 A7 4A 9A 21 78 20 88 5F 5E D5 02 B5 CE 63 1A 02 F9 86 86 35 40 6C 88 36 45 B3' - '56 A7 57 F3 17 22 1F B4 0C 08 6D 79 DF D0 A8 AC A8 88 88 8B B0 90 0B AE 73 A0 AA BB 58 2C 08 3F' - '01 00 82 00 D6 E9 F7 18 E9 1E 47 77 0D 91 87 8C 81 62 91 03 2D C7 80 B2 D0 07 8E 63 24 73 F1 CE' - 'B3 B7 7C 72 94 BE AA B2 1D C0 50 C6 75 EA C4 5A 4C 9C 1C E4 AC E4 9A C8 69 CE 31 F4 BD 1F 4B 5A' - 'AC A4 EF 4A 3B CA 4C D4 A3 BB C2 13 9B BD 6A EE F3 9C 63 18 B3 33 56 B6 44 8C 63 16 67 92 AE FF' - 'EE B8 3E 96 AD 57 BE AD 59 65 A6 9A A7 38 C7 3C F5 6A E8 42 13 9D EF 5A DE F2 93 35 29 7B DE EC' - 'D4 A5 EF 6B 5E F2 93 33 33 33 35 29 6B 2A DE 73 9C E3 1B D2 90 86 BF D4 EC D9 F4 BA 2F CB 1D 43' - '18 D5 AF 11 78 52 94 2C EC F5 CA 34 8D 68 73 9A 2C 58 E6 D6 36 64 C5 2D 85 8A ED A1 15 43 72 C2' - 'A3 1F 8A A0 40 31 54 E5 50 AD 66 B4 A5 73 C6 95 6A 00 75 A4 98 A5 E6 ED 38 AC CF 6F 31 92 95 1F' - 'C9 5A 16 9B 45 4C 63 58 7F CB A7 00 F5 6D B9 8C 0F 3F E3 E0 E0 3C B4 28 14 BA 75 76 B1 51 AD 79' - '68 63 18 D0 65 BC 2B BD 51 8C 63 7E 89 95 DD 04 4C 66 7B 22 C4 63 F2 41 0F CE 25 FA 91 0A 52 C1' - '49 BD DA 08 70 8C F1 77 3C 15 0A E3 9E 2B 46 F7 2A 94 B8 C5 B8 46 DA FE 61 8C BD D1 8A E6 87 CF' - 'DA DD 37 77 E0 84 F0 0F 49 CC F0 2F 31 55 55 55 55 55 7A 0E 2E F5 7B 8A B7 ED F7 AD 32 FD 19 8E' - 'C5 66 CD AB 94 39 13 35 57 55 E4 09 2B DF 24 51 6D AA AA 54 A9 55 52 A5 4A AA 95 2A 55 54 A9 52' - 'AA A5 4A 91 B3 27 60 AD AA AE 86 B5 55 70 B6 67 17 6B 94 AE 50 DD 7A C6 30 21 19 5C 56 C6 90 ED' - '3C 52 BC C5 69 25 48 45 40 A3 50 B2 9A 86 29 4A 5C 54 40 80 13 23 C1 40 10 3F F1 38 39 98 83 3E' - '82 14 A4 9C F9 AA E4 64 41 0B 77 7D 0B 8E 9C 75 DF E4 F2 E0 B0 21 E4 F0 2C 7A 2A BE 4C 78 75 F9' - '2B AC D8 93 CD 05 8A F3 21 3C D7 4E 6D 2B 54 A8 6A 06 75 61 51 A1 00 8E E1 3C 8F 50 D5 E6 7C A5' - '45 1A BD 42 A1 4A 5C 21 00 05 54 63 09 04 2E 64 3F 33 38 29 BE 31 9F AD 52 B8 EF 30 4C F8 CF 30' - '22 15 4C 01 70 63 17 00 D3 9E BB 83 80 63 18 D8 13 04 07 6F 97 B8 DE F6 10 84 3A 9D 89 2F 8A 90' - '85 78 20 59 76 BF EE BC 0B 18 1D 7A 11 22 1D 2F 21 21 D9 86 D6 95 43 63 36 53 04 D6 26 49 6B BA' - '05 4C D5 0A 4B C1 39 F0 E3 14 C9 3B 35 72 58 73 7E E3 62 16 4E 20 AC B5 35 54 2C E2 97 8F 81 C7' - '0C 38 F3 6A AB 8F 55 5F A1 26 EA B9 30 C7 5E 1A AA B5 D5 56 0F 83 52 6F F2 9B EB C9 9E 61 37 52' - '4D BD B4 97 52 9A C3 5E 93 58 6B C5 2E 76 6B 0D 74 92 93 5E D1 D7 EE AD D0 4D 61 AD EF B5 9A DE' - 'B7 C6 D8 48 E3 72 47 1B B2 6E E6 B0 D9 E9 8D 61 C6 CD 6E A7 38 C1 C5 A3 8A 1C 51 25 92 47 C2 80' - 'A1 CF 1C D6 A5 91 94 31 8D 06 4E 0A B5 A7 3D 6E 09 CE 73 85 75 38 28 81 CF 5D 62 7A 88 82 30 A9' - '3D 00 26 04 BA 49 98 65 DA 40 56 65 F9 4B 36 7B 65 40 20 58 DF A0 95 95 FA 24 20 39 A9 67 48 E6' - '4A CE 96 55 40 20 5A 22 D8 27 D2 33 E3 04 2B 87 8A 50 A2 54 6D A9 3C 73 6F 48 B9 5A 34 D7 00 56' - '35 CD 32 A5 75 7C 96 50 63 5D 86 02 70 8E 73 E0 5B 3C 75 77 80 EA 79 CF 75 79 82 B8 10 12 BB B8' - '31 8C 95 D5 0C 04 5B 39 52 D6 61 94 B9 7E B8 01 1C 0D 1A E7 E0 61 6D 29 56 66 29 23 F9 98 0C 9B' - '74 50 2B 6B CB 73 3A 13 A2 7B 5D F2 E9 37 4D 1B 63 16 41 DF 50 6E 8C 44 52 1B 58 87 78 63 DA BD' - '72 8C EB 28 E3 49 8D 7A 9A E1 1D 3A 98 7E 06 6A F4 DB 29 6C EF E2 AB 4A 42 38 BA 74 97 1D A8 33' - 'F4 A7 1E F2 AB 4E 8C D3 CA 66 3C 8E 0B DE A2 98 DD 75 D9 1E 61 C3 CB 86 CE 4E DA C5 F5 B7 1A AC' - 'F1 46 E3 E8 A3 97 56 F2 24 73 A9 50 AA 81 AD 6A 18 C6 CB 61 BF 80 77 4E B0 EC CE 63 61 B0 61 06' - 'EF 30 D0 32 A8 36 75 7C F2 22 2A 81 F0 CA 61 84 DB B8 B4 6C B6 47 B9 38 C6 32 EE 3E 23 BD 3E E4' - '38 19 BB 96 6E 5A 71 FB 91 E1 84 3B 99 73 4F B1 DC CF A8 CC DB DB 78 19 72 EB D0 63 AF 7B CB 74' - '19 76 2B 0D 73 47 10 CD 35 B5 93 5B 47 1B 6A 2C 5E 5E 30 BA 26 B8 B9 2C AD B5 B9 AD 52 D2 B5 0D' - 'A8 B3 5B 6D F3 CF D1 DE A9 DA F3 5A F2 F9 BE 41 97 0E 72 27 8D E3 C1 32 F0 B8 1D DD 1C B9 73 8E' - 'E7 71 C8 B9 73 9C AE 77 5C 05 DD B9 12 EE B8 AE 74 BA 6E 4B 1D E3 CA EB 15 47 81 04 15 0A 9F 7F' - '3F ED A1 BB EB FE B9 8E 97 EC FF 39 6F DB B0 DA B8 CF 5F 63 A5 FB CA 66 BF AD D5 9D C1 73 3B D2' - '6B 76 D6 F3 D8 DF B9 D5 6B 18 DA D1 DE C2 EE BB A5 A6 75 01 14 06 CD A2 8F B3 F6 36 B6 07 BC 2F' - '0B C2 C7 45 EF F5 7D FF 7C F7 17 5D 94 F3 C4 F1 03 0F F5 FE B1 1A F8 BE 2B BD 12 A1 76 61 78 DC' - 'CF 2D FC 3F AB 7B FE 87 C3 FE 1F 04 13 E1 7F 9D 48 48 1C FF 7D A0 F1 47 83 45 10 A9 50 A6 0C 0C' - 'FD 70 37 48 49 97 4E F1 2C 51 59 AE 00 07 8F 61 EA FA 48 70 3B 0E BF 1F DE D0 61 EE 2D 33 D9 48' - 'F6 B9 FA 82 2D 3F 7F 5E 40 68 39 7E 49 06 A2 42 13 B1 EB 88 D6 40 06 ED F5 0C EB 40 DD 8A EB AE' - 'EC FA 1A 2A 52 7C DB 43 F4 7D 19 1A 1D 0E 3C 4A 31 44 19 68 91 60 88 BB 94 1F 9E 0F 7C 50 02 05' - '98 E9 83 D7 BB 5F A0 AF 5D F5 EB AD D7 6B A4 AE 59 DA EB BB 75 C9 E1 84 B4 69 A8 C6 D3 B3 4D 02' - '1B 41 62 C0 84 21 21 05 84 17 5D DB AE 5D 37 3A B3 73 A9 DD 6E 92 BA 0E BA 44 18 0B 0A B2 46 24' - '30 68 64 0B B4 53 09 E4 BF 3B E6 F6 3F 2B B9 D7 C9 BD 6D DD F7 D3 EC 3F 75 FD DF A9 9C EA F0 DC' - '38 E7 9C 94 3E 74 03 DE 39 BF AA 47 1F 08 D9 0A 1C 0A 96 29 52 F4 4C 9A 46 1F 7C BB 6D 6C 13 DC' - 'B2 53 EE AC BF 15 E3 F9 EA 46 30 1F D8 51 F8 59 43 BB 26 CA AD EC 33 7A EC DE B5 1B 9F 26 FF B4' - '9B F4 F2 6F 9C EC BB 3D 61 55 FF 04 E3 C8 66 FB 57 6F F6 24 99 6C DF 52 72 7E 0E 9A 11 24 26 17' - '16 0C D5 8C 14 56 9B B2 82 47 1B BB BB B5 B7 06 EC 78 33 1B AD 7E 40 3E 44 A0 79 CA F4 94 C4 02' - 'AC A0 D2 38 EA BC A2 35 A8 84 10 F5 84 C9 75 6A AB 33 E9 8D 34 D3 37 CF 3C E1 9E BD 34 D5 A9 B4' - 'D3 91 AB 93 29 06 CA 23 46 E4 B2 6A CA 53 80 55 D4 89 64 5B A4 2D 18 E9 29 64 8B 22 81 8D A0 C8' - '26 91 B2 DE D1 AE 6C 33 CF 3C E5 96 48 35 63 4C B2 C2 C5 D2 07 6B 4A 42 21 44 84 25 34 55 B5 94' - 'AF 9C A5 2C ED 67 7A BB 9B 85 A6 83 6E B1 9C 2F 75 55 5C F3 CF 72 F8 86 98 12 59 4A 52 A6 EE E7' - '08 DA CB B9 AE FA 1E CB D5 AF 4D 7D 39 6E 2A 44 26 C3 AB 18 EC 56 93 9F 1A 75 99 B0 D5 BA A3 8A' - '1C 24 06 E8 60 9A 93 6E 38 BC 5D BB 76 E3 56 99 DF 6F 1B 86 BA 5A 5C 54 B0 51 21 AB 60 3D C8 D0' - '63 79 25 13 7D B4 A8 CA 42 38 0F 4C 71 45 44 EF 29 6F 65 9E EC 5E 31 8C 72 B4 EF 57 D2 93 C5 F5' - 'D6 A3 70 E0 37 10 30 C2 4C C6 E1 C0 1C 5F 28 08 41 E5 0B 33 40 59 45 AD 66 8C F6 6B 5D CD C8 EA' - 'B2 6C D7 B2 10 3D 7A D3 5E CD 9B 36 6C D9 AF 72 D6 AD 33 50 95 AD 6B 26 BC 92 D6 A5 29 19 C9 99' - 'A9 39 CA 53 33 A6 B8 D4 6D 58 2A ED DB 7B EE 63 2D AF 9D EF 8B DE FB 76 EB 8E DD 9B 76 AD B6 ED' - 'C6 D6 D8 77 BB 5E F7 78 3C CF 34 53 4D BB 72 DB 54 1B 76 D2 87 56 AE DD BB 36 63 66 59 63 17 BB' - 'BB EC D9 B3 51 6A D9 B7 6A ED 7D AB B4 F6 3B E7 7B A5 DE 79 B9 A0 62 54 44 42 43 0A 8A 15 15 76' - 'ED DB B7 6F 13 74 7F 65 C5 30 F0 18 BA 0A E1 05 77 BE C3 E3 7F E7 EF 3E 5C 95 57 5F D3 D2 D2 E4' - '43 50 D6 43 F0 22 AB C3 31 F0 8C 00 4A 14 20 1D D1 03 42 03 D8 54 0C 37 E9 B2 B0 20 AC A9 51 C6' - 'F5 78 C0 F7 48 E2 A9 44 E6 FF F2 A0 FF CC DC 89 33 06 3C EF BB F2 19 02 B9 E9 27 0E 4D 8F 8E 6A' - '93 2C 38 99 0E B0 71 3E 46 0A 1C DC E7 26 A9 B7 1A FB 8B 71 3A 4A EB 25 31 54 34 E8 FD 0B 0E C5' - '53 59 E7 DE 47 14 EF D6 6B EE B9 F0 CF 64 3F A3 15 E5 F3 FF 86 E7 CE 96 C4 E7 5A D7 1D 95 39 5A' - '06 2A 73 CF 43 FD BB 3D 03 99 D1 8D 10 C5 69 42 69 9C 9C D6 FF F8 93 6B 79 C6 29 8C 54 12 8F 78' - '64 4C 6D 62 30 FD CB E3 24 91 A2 98 4B EF DA 1A F1 2B F9 FE E2 6B 9A 99 8A 79 13 78 6A 18 D2 8C' - 'A8 16 27 0D 43 19 93 28 86 0D B7 B4 E8 C6 2A 6B A8 9F 7D 5A 73 32 66 A8 98 FB C1 58 B1 CC 26 5E' - 'DB F8 B9 6A 6B 63 2D 02 D8 B7 65 B7 2B 0D 0D 6B EC B1 34 C8 99 16 BF 65 03 30 73 50 33 06 2C FE' - 'E9 83 99 73 2C 91 AE 8C FC C6 9E 64 93 56 CF 6A 9B 43 16 B5 12 95 78 AA BA C3 DF D6 8A B0 55 F0' - '3E EA D6 86 E4 12 35 45 46 34 AB 2F 47 86 D2 87 42 16 94 F8 DE 4D 29 0A 41 C9 C3 AB D5 4D 19 33' - 'BE 97 12 73 75 7A E4 F0 A7 27 02 AF 5C A7 33 C8 D5 55 CC D6 9A DA E6 77 34 D5 70 B2 CB 73 28 AA' - 'F3 55 E6 62 6B C2 91 6E 45 26 A9 05 5D 71 09 C2 CD 7E 53 C1 4C 1A 22 1C A3 08 A7 85 52 65 0D AC' - '66 FF 00 89 E4 0B AB CC B1 64 C6 45 C9 17 79 37 99 1E EB 60 C1 F0 39 5C 5E 5B 64 31 79 56 4D EE' - '0B 13 E1 E4 29 4C 90 C3 7A 65 3B 06 C0 5C F7 7C E7 62 30 3D EE 80 CE 6F 36 35 7F AE 80 87 4B 41' - '17 4B 40 D7 7B 80 F9 82 04 39 AA 09 39 F6 9E 43 B5 50 1C E2 6D 4D F9 6E 37 78 AA CA DB 7C 58 2A' - 'AF 02 ED 5E 82 AD 2B E1 68 D9 2A B5 B8 16 32 56 2E C1 C2 0A A2 3A BD 2F 30 F2 3B F7 57 E6 1A B6' - 'F4 0F 3F 7A 0E DE 7F D0 00 0B AF 41 FD CB C5 72 C8 45 05 FC E6 52 0B 06 ED 37 AA AB 53 69 29 91' - '4B 7F 7E 25 A5 D9 8A 0F 23 72 8B 1E 1B 95 3B 76 DC F0 D7 2C 53 BB 85 BC 54 6B BC B6 25 46 B5 E1' - '63 B9 AC EB 96 AA A4 09 54 55 50 AA 28 2A AD DA F7 B5 72 D4 B4 68 E8 69 E5 F2 C7 90 89 A8 EB 45' - 'A7 75 AE EE B5 D1 58 B5 74 D7 35 7D 0B 6D 57 88 9A D1 8C BC 35 C1 E6 7F 89 E2 40 85 A3 9E 56 0B' - '22 0C 05 7F 5E A5 22 C8 A2 82 90 CA 20 28 E7 52 59 22 CC 50 2A D6 D9 60 97 84 82 20 08 20 22 24' - '00 FC B8 9C 4E 27 7B DF E2 77 BC 4A DB DE 97 AE F0 67 C4 F8 3A 21 CB 65 30 FF 8E D3 69 B1 AB B1' - 'C6 B6 58 00 33 BA 1F F7 78 6C D2 1B 77 27 4B 21 3A 87 A8 3A CE A6 C4 62 F5 95 42 AC 89 D5 E1 D7' - 'DE 5E F7 B0 4B 31 60 20 42 4A 95 2A B6 0E 3B 9C DB DC 78 70 E1 A2 40 5D A8 8E 59 00 20 20 40 07' - '4E 90 21 0A 00 22 24 9F 38 AF 04 86 23 C7 69 94 08 89 C4 40 80 22 4B 2B 2E 67 29 CC FA 9E E4 C9' - 'B6 16 17 B5 9D E6 D4 A1 DF BF 0C AD 82 52 C0 BE BB A0 E2 0C 9C F3 CE 79 F1 17 A3 42 FD 01 4A C2' - '2F 44 94 AC 01 48 74 58 D4 03 26 00 5E 24 42 73 FE 6B 9D C3 E0 B9 D9 78 4F 0B CE E5 16 3D 37 9C' - '3F 1E E7 06 62 C4 84 15 84 51 DE F0 A8 F2 5E 50 28 72 AD 45 89 0C 04 81 29 44 80 B1 82 A9 E0 3E' - '73 A5 F4 BD E7 BF 77 AE F5 C9 D2 F4 C5 7A 6F F3 4E A3 A2 B3 6D FC 29 C5 C7 69 68 AC 83 CA B5 16' - '91 39 1A 8C 27 71 E2 E1 F2 7D 97 DB 65 FD 07 C3 EE BE E3 F7 F6 CC 61 D6 57 13 BE 70 E0 59 44 5C' - '1F 08 D5 B8 D2 C7 72 6E AE 0D 9B 31 A1 A4 15 8C 4A 6A 86 BB 4E 87 66 5C 8E 15 E3 C5 E2 4A 48 F6' - '9E BB 04 B2 50 C1 6A AA 45 45 40 A4 97 FC FF 0D 85 AE 2A 64 C3 5A C3 17 83 77 78 D4 88 4D A8 F9' - 'D7 92 2C 20 9E 18 5D C8 EE 38 A9 25 4C 4D 51 57 BC 40 62 A2 92 20 6B 3D E4 26 34 A9 DA 89 85 55' - '62 E5 DC 90 4C 81 D2 45 10 31 44 40 1A 7D BA 36 7A 08 77 9F 27 5B F5 77 DF F9 EB E6 77 FF 0F 67' - 'D9 F6 7D 5F 03 D5 DC 90 24 CA ED 4E 3F 66 4F 68 44 4D 8A 58 C8 3F A3 D3 FD C7 63 E6 3B F7 8D F0' - '7E FF B8 FA 4E E5 B7 AB 80 77 07 B7 9D 6D 07 6D EC 3B 85 01 DB 92 EC 50 72 54 93 FF BE AB BB 7C' - 'EF AB 67 DD FC 1E 57 15 FF 05 13 F8 3B C7 C0 DD 84 44 90 78 1E 43 92 F2 71 1A 6D 79 06 FC 9E 0D' - '00 05 46 65 DD AE 5E 3D 3D 82 02 33 CC 7E 97 C7 89 00 45 2D 0A D6 2E 4A AC 2D 1A A6 B1 B4 A9 CB' - 'AA 97 80 0C 10 04 BD B0 BD EC CA 1B C9 E3 B4 9A F0 B7 69 A3 49 AE EA 76 EA BB BB BB AE 4A A4 28' - '51 15 8A C4 16 AD 57 B5 EC 55 54 25 15 45 C6 5A 67 8E C4 E9 76 EE B9 2A 0C 55 E1 BA 69 48 BD ED' - '6B A5 AD 50 B3 49 25 24 02 86 44 42 CA 80 53 20 6A 28 DB C1 96 B1 11 62 4C C0 9E 77 E5 AE C0 A7' - '46 F1 55 B8 33 1A DF FB EE 3E 0D 77 CE 04 23 77 C2 DD 8F 8D CD BF 52 CB C7 5F 17 63 3E 7F 9D 6F' - 'C3 83 07 2B A8 87 1A 24 4E 1C 58 B1 62 C5 8B F5 69 FE AF 3F ED FA F8 B5 FC 5F 4B ED F4 E5 F8 FF' - 'C3 0A C6 65 84 A8 F1 E2 C4 89 0E 1C 38 70 D7 5D 75 D7 5D 75 D7 5D 75 D7 5C D8 6D 73 6D B1 1B E6' - 'DC 2F FF 5C FC 4C 74 EC EB 1D 11 B6 B1 5D 73 1F 3B DD E3 ED 73 F4 C1 FB 4D 3A 1B 19 BA 71 D4 8F' - 'D8 3E C8 A7 C7 43 62 3E 70 F6 C3 D9 8F 50 3F B8 7B B1 C8 1E BE D7 9C B0 D9 68 E7 EB B4 7E D7 AF' - 'AC ED FB 0D EF D3 E3 78 BC B7 5D F1 F2 F4 67 D5 AB 7D 56 AD 2A B4 B3 15 6A D5 AB 56 AD 5C 4C 3A' - 'B5 71 26 D5 B8 BF AB 87 53 0B 29 82 A5 5A B5 5F 55 AB 56 EA AD 5A B5 6E AA D5 AB 56 AE 05 5A 95' - '3B 9C 3C 60 B7 02 12 13 D4 9F 39 50 EE 4F 4E CB A4 3B 88 81 8B 65 C6 83 AB EA AB 06 28 4C 59 3F' - '03 BF FD 07 9C 7B FE 12 04 36 A1 9A 2C 99 A2 93 F1 BD 87 E2 FD E1 F2 FE BE BB BE 5F B2 90 21 A2' - '6B D8 55 8B 32 CC 2C 0F 61 44 37 24 D9 B7 D4 EB EF EB 08 66 84 D1 81 A3 2C 32 1B 18 79 B4 F8 FF' - 'BB 41 CE 66 68 49 4C A6 01 8B 24 32 42 1E 4D 03 01 20 10 0B 01 02 11 06 E8 01 00 2F 0E 9A 27 A3' - 'C7 FE FA 0F 1F 65 E4 81 32 B5 95 98 0F 3A 4C 0F 0B BA AF E3 2C 40 78 1E D8 81 08 00 F8 48 04 01' - '7A 81 08 D4 48 51 20 04 01 20 76 9E 27 87 23 44 FA 46 CB 96 B8 DB 5C 76 BB 86 79 7D DE CB 6D BB' - '85 0A 12 6B BF 2A 7B FA 26 F3 AA BF 95 97 C1 F0 3C E5 7A 75 7F 1F 6E DD 36 AB CB 2C DA 5A A5 2A' - '72 10 E0 58 4B 4B C1 DB 6F 37 7D 79 73 F3 1F 5A 1E 97 4A 64 8A DF BB 7F F7 F1 38 7C 4E 1D 6C D5' - 'FE 16 22 6A 4E C4 DC FC E4 E4 E4 E4 E4 E4 E4 E4 E7 17 0F 0E A5 02 CE ED 6F 27 A6 C6 53 97 CD D7' - '80 0C B1 E0 01 03 F6 9E 00 03 2B 94 40 BD 66 BF 5F AF 57 5E AC CB 1E 73 9F EB 36 7B 3D 9E DB 85' - 'E8 6F FA 5D DF 41 AD BB E7 B9 DD 56 AF 57 CD 72 FA BD 8F 33 A6 F0 3C 1F D9 57 3D C9 D4 C1 A7 EC' - 'F7 FB D4 DE B7 AF DE 4D DE 8D A2 99 BA CB 3B 38 8A D0 EA AC 35 EE 22 34 73 33 96 08 EB EB 3E 9A' - 'EA ED 64 7C BE 8F 37 5A 24 7B 94 D6 BC 44 C9 A1 69 2D E7 DA 5A 5A 5A 5A DC 59 1F AD B3 AE 3F 5D' - '9D 9C 93 BE 92 9A 82 7D 14 FD FC 2C 0B FC 01 07 C2 CF C3 35 CA C7 0E 28 9B 95 1C 28 24 47 39 7C' - '35 4D 0A D3 C5 C7 4B 71 7D 81 79 7D 83 7B 64 25 EC 70 DA DC 06 8D 62 B7 4E 86 84 B1 E6 7E 70 9A' - '90 5D C3 86 D9 42 7C B6 D0 1C C1 8E 54 76 0D 57 B4 D3 66 C9 9B 46 82 C1 6B 06 40 ED 07 6A F3 54' - '78 A4 43 D5 D5 81 00 88 A4 C2 26 21 03 8E 3C 62 0A 2A 44 88 F0 C1 D6 3C 08 20 01 0C F0 00 6B F7' - '26 C0 B2 B2 81 BE F4 75 9D 56 6B 21 D4 AF D5 B2 D3 FA 7C DF E1 B6 FB 7D 4C 59 56 95 1F 3F D1 E6' - 'F9 BF 45 29 66 6E BD 13 34 A9 36 D2 9E 86 17 37 6E B6 8F 63 7C B2 90 7B CF D3 72 BA 97 6D CE 7B' - '73 29 C7 F9 06 B6 5F 55 CA DA 7D 3C EE 7F D6 C1 85 5B 4B 35 5D FC 6E 49 D3 FF 64 AF 2E DC 34 9C' - '69 AF C2 34 68 AC 73 73 73 2C E2 D2 66 CB C1 83 DE B5 52 A2 69 0C 0D 6D 64 EA 14 3E AB CB 9E C9' - 'EB E4 BA 74 EA DF 2B 27 27 C1 70 92 84 A2 B5 19 B3 66 A2 C0 AB C6 96 37 B7 C4 C6 24 46 ED 9B A9' - '47 8B 6F 6E 49 24 B9 72 E4 92 43 0F 2D 33 55 31 A3 60 88 23 F7 D0 D5 2A 8E EB 2B 29 EB 82 08 20' - '61 86 0C B2 DF 9A 68 C2 8C D9 A3 62 63 12 3E B0 E4 93 16 0C 18 86 C2 86 54 0D 6C 30 40 BE 3D BD' - '3D F1 9E 3B 1B 64 CD F1 6D AE A7 EE 5A EC 84 0E F1 E3 C4 FD C5 88 81 0C 5F 33 76 9F 43 DE 77 3F' - 'F3 BE DF 6F 77 BE 4F 93 E2 F8 BE 06 FB F0 B8 B8 A3 75 AA D4 D9 4D B2 B1 B2 B2 ED 3B 2B EB 3E 57' - '49 67 3E D3 AB EA AD A9 DF D3 A3 65 93 CE F3 B6 BF E3 FC 7F 0F DB AB D9 7D 3D 67 0B 59 CC 73 3F' - 'D7 F1 E9 B5 BA BD 56 96 A7 36 1C E0 13 A3 40 9D 18 81 44 03 24 82 08 0A 02 40 13 14 BF B7 19 21' - '02 66 10 40 44 00 22 89 03 31 00 C5 11 EE 7B 67 1B CD A7 F0 57 B6 E8 3C CF 31 AE D5 A3 5C FF 4F' - '17 A7 F8 7B B3 F6 36 3E 83 93 38 5F CF FE FF F1 9F 9D E8 EC 3C EF 4E C0 FF A9 51 55 7D 57 E0 9B' - '57 F8 FE 3C 8E 27 0F 91 F7 F2 BD 9F 77 DC 68 87 6D B6 96 49 70 93 32 B3 6B 83 40 B4 AE D2 09 4C' - 'FE 84 B4 BE FF 7D C9 A5 A5 5F 90 8F 22 AA AB 83 14 C3 2E 4C BD AD 5B 5D 77 C6 A2 E6 F3 57 51 76' - 'EC AC 29 11 CD F4 E7 15 C9 F0 E7 75 FB 07 1B 4D 93 82 87 31 CD 20 00 15 44 08 4D 4F 49 34 FA 6D' - '6E 7B D8 CF E7 B5 FA 6D 1F 25 5D 9E BD CE 5E 5E E7 3A EE BB D5 F5 BA FE BF AD C1 DC 6E 3B B3 FB' - 'D3 ED DB B8 CC 9F 95 EC 4F 4F F1 81 07 28 13 C7 B9 5B CE F7 A7 80 55 2C AA 6E DC D7 1F 1E 63 F0' - 'DB F1 B7 1F 47 1B E9 B0 F9 6C 2C 2D AA AA 11 CC F5 7C 3F 87 FD 6F 85 EE BA 6F 4B D4 FA 39 D4 A1' - 'D5 7A 5B B7 28 7C 41 D5 B3 C4 B2 2C 90 EB 3D 37 F5 7A 8B FA 71 84 80 F8 87 80 00 00 7C 4F 13 D7' - 'DC FF 4F A3 A7 E7 79 DF 8F 1B A6 CF 2B 58 78 30 60 B0 86 C5 82 FD 07 0A CA 09 64 38 70 A1 42 A9' - 'A8 A9 99 75 D6 61 D6 2B 51 91 10 61 C3 90 30 C3 4A 4A 73 39 8F 9F 3E 0E 0C 24 C8 AA 6F 67 A8 7B' - '53 F3 FC 9E 4F 57 AB A2 C3 49 83 07 15 74 74 7D 0E 85 1D 1C AC AF 31 73 77 15 A1 87 2E DD CB 87' - '2E 66 66 42 9A A7 A7 A7 A7 D6 1E 6E 6E 6E 92 76 75 15 A8 82 08 20 99 99 94 6A D5 A1 43 4F 4E 85' - '0D 4D 4D 10 12 1F 8A 87 9F F3 FF 65 7E BF 02 7A 26 4F 40 92 65 95 ED E4 D9 24 BF B3 A8 48 A7 B1' - '45 F6 60 C2 C0 58 05 92 85 54 5A A9 0A C7 B7 32 3B 25 99 A5 49 59 64 69 28 7C 14 00 D5 90 0C 5F' - '64 C8 62 7C 9F D2 A8 4D 4D DE B9 E0 AA AA 6E D9 B7 B4 AA AB 59 70 2A AF 7B E1 26 68 3E A6 A9 21' - 'BD 24 DE 92 01 BD 84 DE 90 DE 90 DE 90 9C CE 65 1B F7 D6 AC 9C 79 D0 06 BA 79 4F A1 F0 5E 0B DA' - '7D 8E 67 27 07 33 78 D5 54 A6 26 D4 92 D2 CF 78 04 8D D2 0A AA BD AD BC D9 0D A2 D6 4B 66 FB 3B' - '5B 97 5A 7F 01 86 9D 28 0D 3A 47 06 E9 05 55 5D 67 76 69 B7 6B 24 B3 BD E6 8E 17 22 AD 8B 48 58' - '6B A9 46 AC 0B 2D AC 96 85 21 7B DE D2 AA A4 96 19 2D 6B EB 7C 12 4D 58 13 5D 3E A3 D3 DE 01 8B' - '01 D3 4B 06 8C 0B 36 12 59 2D 6A 0B DA D6 90 2C C5 85 9B 5F 4C 2F 24 D1 03 95 C7 CA AB 40 37 61' - '49 C3 42 CE 06 04 FE EF 03 52 68 CE 07 75 54 B3 29 02 CD 70 51 55 52 5D 15 65 AC 66 A6 21 C4 84' - '55 04 08 80 09 00 08 B0 90 3B D9 EC 5C 79 7C 3F 2B D8 E1 3F 91 D2 F7 FE 75 0E 17 EF F6 3F CF 93' - 'E0 78 76 D9 1C 7F 0B 9A 7F 48 92 BB 2B F8 FB 56 F9 EE AC 52 59 6D 32 F4 3E 26 6A E5 37 8B F0 26' - 'D5 D7 DB 6C FF BE 94 CB BE 12 DE 85 93 49 BE BA B6 F3 9C F4 1C AD A3 0B A5 E4 CB 8E 3F 4A 87 F4' - 'FB 5D F5 37 8D 68 F4 7B D2 CB 9E D3 2E D3 E6 D4 61 A8 ED D5 75 D5 BC B2 EC 89 3F 8E 3D 34 CB D6' - 'FD 11 C4 A3 B1 5B 4B D4 C7 AF 5B 38 AF 4D 63 09 EA 5A AE D2 7E FE 7D 6A CA 4B 60 97 5F 56 97 72' - '91 FD BA 66 A9 2B 57 26 BE C2 6D A3 7E FF 06 4D BD FE 12 FC 35 F8 3A 86 B3 72 ED 3B 77 0E 1C 0F' - '03 3C 7C CD 47 A2 E4 AB 54 F9 62 E7 7A B9 CB B4 60 2A 1D 80 FA 4C 58 BC 7C 3B 00 13 03 F6 F1 3C' - '20 3F 67 87 AE 00 10 29 8B 24 F0 DE 66 8B 09 D2 B3 B2 7D 53 76 65 18 8E 9E F3 D1 FE 17 63 ED FE' - '07 9E F0 7D CB F7 3F 47 DA 7A EF 59 E8 FC B6 CB 2E F7 95 D3 47 F5 CE ED 67 BC FA EE 82 F5 7B A8' - '3E DF 83 BF ED B0 DA 74 79 1F 4E 3E 15 7C F7 DF F6 DD 5B 4D 4B BF 7E F9 F3 87 10 64 48 90 4C E9' - 'D6 5A FD 7E 7B AA E3 74 FE 7F F9 43 F2 F7 3A CF AF EF C5 3A 5F 77 56 A1 B3 43 EB 09 78 CA B5 57' - 'D3 2E FD A2 3F 13 6D 86 ED 54 D6 61 A2 5D 0A 2B 7F EF 28 8E E7 DF 41 E9 52 21 5F A0 D0 A8 28 3F' - 'C3 61 BE 4D 46 AB 2B A4 E1 F1 17 F3 47 50 D9 C2 6A 72 CE 10 F0 11 43 6B 05 0D 9A 28 7B A3 E8 3E' - 'FF 90 7C DF A0 C7 45 31 A7 79 27 35 BD FA CE B9 AB 9C 1C 6F 37 6E C6 C6 DC 5C DE E6 E4 D1 F8 CF' - 'C3 C4 3F CF B1 DD FC 3F 77 DB F6 25 B2 17 96 D3 B6 66 ED F7 46 EF 0D DD FA E6 92 6D A5 A9 AE CD' - '6F 69 B6 B6 9F 46 DB 6F 5F 75 D4 74 F2 EF 7E 2B EB 63 5E F8 7F 89 5F 19 5E B9 5E 49 45 14 57 B9' - 'FC 7F 7F 9B E3 F8 5E 17 96 7B C3 EC EB B2 ED ED 47 5C 2B 96 58 59 36 BA B9 3A 08 70 AC C6 DC A6' - 'C8 FE DE C8 1E 39 EF 27 D9 BA 87 75 12 E5 44 EE 6E 6C AE 6E 5A AC 94 9B 59 E9 CF 9E C1 11 39 D2' - '3A 8C 0D EF 1F F4 FC 9C 02 ED 43 2F FA 68 1A 46 8D 1A 34 65 77 31 68 43 CD 37 22 A5 2A D3 B8 F4' - '7F 91 F7 4D CE 87 B9 D2 33 26 BA E1 C2 FD 1C FB F3 1C 79 9E 04 EB CB B1 FC 75 D0 CF 03 3D 5E 5D' - '8F C7 E8 CF 9A 7D 28 A1 1F 9B 55 3B 83 F3 3C DE DB 65 14 99 A1 F4 4E 64 63 C7 E3 F9 06 9C ED DD' - '74 B4 C2 64 2A 67 9A A3 41 4E E9 03 D4 70 F2 26 25 2A 2C 7C C9 3E A6 07 E6 52 74 DE 8E DB 23 8C' - '8C 34 6C DE B9 4D EA 56 69 3A 3A 31 D1 8C 8B C5 51 B6 B6 52 00 0D 72 16 72 2D AD AD A4 BA 8B 09' - 'CE 36 34 68 19 C7 84 9B 5F 22 50 2A E7 33 62 F5 CC 75 9F 14 A5 CD 1C 16 13 88 98 25 A3 34 B2 6C' - '2C D3 72 FD 65 10 07 42 A1 41 5B 47 2B B3 63 67 9A 3B 90 90 9B 7C 83 9D 86 B1 21 35 9B 2D D5 7C' - 'C1 04 20 AA 75 71 D0 C7 B6 C7 3B 22 D4 6D 05 57 30 8E E4 4E B4 F9 E5 28 88 67 22 36 82 0B 2E 8C' - '87 96 4E A7 43 5D 61 42 DE 91 69 0D 2F 04 34 62 00 1A 0D B8 8E DD 02 90 03 49 CA A0 4A 8F 77 5D' - '03 FA 7D B9 CD CE 5C E5 CE 5C E5 CE 5C 1A 18 D0 C6 BB C2 B2 8A 3E 91 D3 58 63 69 2C 2E 9F F6 7D' - '7F D1 F8 BE 07 B5 FC EF 39 BB E5 7D F7 86 FF CF 6B FF 2C 0A 4C 99 FA FD 25 9C 54 F9 32 08 E8 E1' - 'CA E1 DD 72 C8 54 97 96 95 8D D7 3A EA EA 52 EA EB A1 75 74 4C 16 CD 33 94 C7 9B A1 51 44 A3 B6' - 'A2 8D 45 22 8E E2 8E EA 8E F2 8A 55 14 CA 22 93 53 A9 4E 2E B3 C8 3A 9A 4B 97 3B 0A 4C 58 6C 50' - 'B1 76 E9 B0 88 DA 06 17 E5 F9 80 08 20 1E 3D 5E 85 15 DD E8 7B BC 5B 6F 7D 7A 15 D2 7E FD 11 11' - '00 22 23 CE 81 40 A2 1C E8 81 39 D1 38 91 30 41 00 40 92 AF FB 89 72 EF 66 7C 97 D9 D9 99 D7 9C' - 'FF 61 1F C3 91 AD 93 26 4C 9B 4F 35 A4 3F 56 59 F5 EF AD 2B 5F 2D EC F0 28 FD CE 9D 25 34 DF C3' - 'F0 FD 53 5D 59 9E 87 43 EE E8 6F E8 A8 7A EB 56 A0 5A B5 12 D5 B6 CB 7B 6B 69 96 AD B5 48 92 C2' - 'D5 BE 45 75 E5 BA 5B 8B 8E 52 34 57 07 ED B8 C6 22 44 89 13 9C 68 21 DF 9D 70 73 26 4C 99 2A C6' - '54 CB 11 04 CC CA 04 08 10 20 AE 40 81 02 04 08 0F 9F 3E 7C F9 F3 E7 CF 9F 3E 7C F9 F3 F8 82 E2' - '8B 92 2A 81 56 8A A4 55 C2 E6 2C 56 E0 5D 01 59 31 15 90 AC 18 E3 32 48 EF 09 2B 78 C4 93 89 23' - '14 D6 B8 B8 8D 71 9B E4 88 D0 48 11 83 25 71 AA 87 19 71 32 63 B6 D3 64 71 8D 1E 34 24 E7 CE 09' - '7E FE 30 E3 BB 85 A9 A9 0E 21 31 22 93 20 A3 4D 34 D8 A6 9B F2 81 C0 F9 35 C0 00 78 F0 07 BD EF' - '83 C2 03 F7 1E 00 03 C0 1E 3C 78 10 40 EC 5A 40 1E ED 45 0F 65 4A 81 CD 96 0A 4E C5 86 2E 09 B0' - 'AA 2A 7D C7 43 BE 67 75 9D FC 3C CE F4 C6 6E E3 EE 23 8D C2 DF DF A6 60 99 37 0F 86 D3 85 40 BB' - 'B1 69 B2 E4 A8 F3 FF 26 D8 4A F9 3C B4 E9 F2 DC B5 B8 98 95 51 79 99 A3 37 A1 A3 39 D6 69 D8 F0' - '44 81 41 3F 58 16 75 66 F5 FB 9A 3A 30 F4 D9 F7 BA 32 F3 06 1F AF AD AD 57 5C AE BD 5D 86 81 FD' - '0B 1D 0B 2D 08 CA E2 AC 5C 80 55 23 B9 62 F9 96 00 90 C8 C3 C3 BE C4 D5 0C 31 C4 D1 13 47 50 58' - 'D8 7D AA 1A 0B EA 2A 6A 3C 13 E8 F1 12 E1 A6 B3 49 76 8B 01 13 CD 5D 52 CA 51 9A 56 A9 4F 0A 7A' - '53 E2 9F 95 00 AD 62 87 28 82 A0 95 08 A8 7A B0 DE 43 7B 0E 1C 38 70 E1 C3 87 1F 58 78 F1 49 CD' - '54 D1 63 F7 ED 9B 69 B1 62 70 CF A0 3F 17 51 E3 BD 43 8C 32 44 89 23 12 4B E8 F0 A3 43 8E 59 A6' - '1B 0A 14 68 D1 A3 48 8E 59 87 1D D4 75 1D 46 FD 7A 7F 43 F0 7C 97 E3 BA E8 BC 7F 91 E0 F9 12 38' - 'C2 29 55 2E 8A 8D B5 76 EA 53 77 49 AC 30 C2 49 DE 39 D5 24 7C CD 14 3D 01 0E C6 8A 7B 2F BE C2' - 'D0 DA 55 15 3F 97 FB FD 4F BD C3 C5 E3 B5 B5 B5 B4 47 20 38 C9 25 02 A4 DD 36 46 E9 26 55 60 95' - 'B3 37 A4 56 48 D9 10 9C D9 42 B0 F6 76 6F 16 64 08 B7 2E 24 67 CF 9D B4 10 B2 22 AA 5B 05 55 B6' - 'E0 49 90 C8 1D B5 02 B7 51 42 1B 5D BB 6A E9 A9 54 55 BA 4E CF 3F 81 AA D3 A1 E9 40 08 21 1C 6E' - '24 13 4D F6 1D AC 9A 6D 35 65 A5 AB 1A 44 27 B2 D6 A7 AB 51 76 B3 A0 45 BF D0 1B D1 9D E8 16 86' - '28 DD 59 96 BE 10 34 73 D2 A4 95 B6 8A 12 5D BE B5 74 D0 AA 2A 76 5E 5B FD 3D 5F E6 FE 1E 50 09' - '2C F1 92 92 E6 B0 62 20 E6 66 40 B5 98 29 2E 8A 10 19 68 7A 68 90 31 10 88 10 78 DE 56 29 A3 46' - '85 2A 95 53 4E 11 BA 49 95 A2 E9 5B A9 B5 65 A5 A4 BF 87 56 79 D9 F8 9D E3 FE 97 F7 1F 51 5C 27' - '0E FA AE 19 66 96 D1 AB 70 E0 13 6B 26 F4 9B F7 EF B7 CF 72 FE 4F B5 6E 43 9B A5 41 40 33 73 F0' - 'FD FE DE E5 00 31 64 DC 93 26 C3 92 6B D0 57 84 FE 1A F1 18 50 43 63 0D 8E 7F 99 F1 4B 7C 34 39' - 'C9 03 89 21 9B 0E 5E CD E5 8D 3E 97 AE B7 B0 F8 35 03 11 14 26 59 6F F3 BF 81 CA EA F9 D7 CC E8' - 'A0 3A 24 8B 00 E3 64 52 0A 4E A3 6D 2B 66 95 67 0B 3B 26 B6 DA EA D0 E0 F2 CD BE 08 A4 90 1B 96' - '09 9A EA CB 33 79 D4 81 92 8E AD 6B 5A DA 0B 51 C2 A8 E7 BF 5B D6 F9 BE C3 18 48 63 BF 82 AB 7D' - 'AA 80 1B 89 04 D5 74 AD 9D D9 2C CD 5B 14 D3 73 49 6D 15 4D 10 7A AA 25 4E DC 5F 73 D7 FF 97 27' - 'F3 3B 2C 35 6A 92 6A 6D B7 46 A9 23 4E 48 DD 05 55 D2 B2 D4 EC 62 AA EF 61 C9 BE E0 DB 84 B5 55' - '08 9C 36 A3 1F B7 B1 64 D5 DB 4A AE D0 04 EA 48 D3 01 52 41 04 67 AB 0E D5 40 D1 71 A7 69 2A F4' - '00 6C 48 6D 40 32 41 54 36 24 AD BB 6A 58 43 6A 7D 0F B2 F6 1B FF F5 E5 F3 90 03 26 07 0A 1C 33' - '8A D6 96 2C B6 B4 85 AF 54 5E F6 96 60 5A D4 41 49 6B 54 8B 02 5D 24 14 01 40 95 7A BF 15 04 38' - '92 1C 4C C9 13 8A AB 85 30 42 D1 E1 4F 49 F1 BB BE 1C 98 6D DC 29 C1 45 15 4B 6B 05 9B 70 55 55' - 'AC B7 C5 62 8D AD 86 18 12 6A 90 31 51 DC E7 BA E2 A3 14 DC 97 DC CA D7 4B 09 4A 5A 9B 48 59 D6' - 'FA DA 06 A8 45 20 62 A0 CD 5D 75 B8 C6 36 0A D6 A8 7F 72 B5 B4 75 D9 72 D7 BB 02 16 63 19 B1 D9' - 'B2 F3 2B A8 36 65 49 60 D8 9E F3 DA DC 80 69 A5 04 37 6E BD EF 02 6C 64 99 C7 6B B7 6D C0 DB 72' - '8F BC FD FF 79 96 04 C1 84 74 D7 75 55 2D 17 8D 36 4D 15 1C 85 53 77 8A 47 76 D0 86 5C 09 1B 6E' - '05 04 A9 1B 6A DA AA F3 06 6E 60 52 41 42 17 BE 18 DE 01 B5 C9 24 C9 44 37 3B 30 BA 88 C3 75 E8' - 'EC 3F C7 1B 81 74 0C 73 A8 05 81 26 6E 18 5E 61 49 40 E7 46 5E 7B EE F3 F2 1E D7 4B 43 66 74 42' - '99 25 44 35 AB EB 4D 15 4B 4C C2 D2 9D 71 28 F1 94 18 32 18 53 41 0B 82 19 3F C1 9E 18 62 A3 0C' - 'D3 1D 2F A5 AB 5F 69 E9 4B FC 34 9E B5 A3 8C 12 86 F3 E4 F6 1B 98 FE 7C 49 D7 68 9F 9B BB BF DB' - 'E4 A2 B2 4B 2C B6 69 14 51 C3 69 19 DE 3C 33 9F 0D 9D 9F C7 D4 09 DC 90 93 35 19 0C 7A 7E 9E E0' - '74 C9 EE F9 3E AA DE 6B 6D FC AF 67 F0 B0 C7 E1 F0 7C 6F A4 A2 1B 99 03 00 78 78 78 6E B7 A0 45' - '95 0C 2A 8E 2E D3 E5 FE EF F5 BD 9F 81 CF 5F D2 F5 3E AA E1 09 6E 22 20 40 05 C0 05 BB 72 90 8D' - 'C4 2D 3C 1C 6B 1E 87 41 8F FB F8 7F B3 BA DB FD 3E 16 A7 D7 FA AF 39 7F F0 A2 3D 13 9F 91 B7 DF' - '4F 3F 5F ED BB 77 AF FF 2D 75 F7 3D 75 BE 8F C6 F4 FD 67 65 E2 AC 42 75 63 20 75 10 43 A9 7A BC' - 'BA BC 0C 59 83 8D 50 74 45 2F BD A6 E3 40 C4 FE 9D 6E B3 EE 95 A8 81 87 FE 76 33 0C 64 9C 7A C9' - 'A5 60 E7 88 B7 71 D5 78 5C 08 5D 33 F2 10 90 8A 80 01 02 10 88 09 02 24 40 28 18 C8 14 04 80 E4' - '43 7B EE 59 75 D9 8E 57 4D EE CE A7 F1 71 7E 5D 32 54 F9 CD 64 17 DD F6 37 C3 C7 FD 3C A2 1F 8D' - 'F8 FB BC 47 BC FD 7E FB C1 EA F1 F7 3B FB 9F 27 8A EA 7A 92 07 52 81 E3 59 3A 98 93 CA 75 98 DB' - '1E B6 AB 12 E9 3A D4 FB 3F B3 F5 18 76 AF 59 D6 7A FF 0B FC 9E EB 8B DF 6B FD DE B7 BF F2 B8 2A' - 'A4 00 E3 64 03 8C 48 A4 E5 E1 C9 79 70 12 01 C4 3F 4C 9F E3 68 FB 75 EC F6 BF 80 68 34 F9 4D F2' - 'BC 43 FC 6E 18 12 10 8C 35 40 09 24 48 42 B0 44 01 D1 4E 43 5C 55 AC 6A C0 8A 1C B6 8F 4B F2 FA' - '6E D6 FC F7 C8 B9 E3 33 F3 9F 37 B4 B1 09 C4 C8 6D 89 C5 C5 C2 DE 70 D5 43 02 5A 8F D8 3D B7 71' - 'F4 7E FB CC E1 FF 7D 90 E6 EC A2 1A B0 85 47 73 6B 97 21 50 40 80 D0 43 06 F7 85 D0 7A 98 1E A7' - '7F 69 D8 FB BA DD 8F 07 72 D6 6B 00 C0 80 10 01 C9 04 1D 3A 28 00 3A 10 AC BC CF D5 8F D7 72 3B' - '6C DC D4 BD ED E9 FF B4 2C DE 32 80 BE F5 D4 DE D7 18 A0 F8 40 80 26 14 00 08 0E C0 44 44 41 F3' - 'E2 90 8F 84 0D BA 71 FD 98 E9 0F E6 00 90 08 B0 80 40 10 00 69 03 BA F6 F9 8F 73 A5 5F BF EC 1D' - '7A C1 A1 88 6E 4F FD 77 FD 61 95 B5 61 6C BA 00 04 76 24 21 1D 50 CF 4A AB B9 FF 5D 82 11 6C 91' - 'DA 9B 90 EB F4 DD A3 67 21 0F 8C 50 0A C1 00 06 44 80 00 CD 64 7F 17 23 5D A9 FE FC 16 3B 2B 5F' - '9F 92 F6 D6 DC 76 3B A7 24 21 28 89 04 40 01 D0 81 19 FF 5C 6B FE 83 65 DE EB F9 27 8C E1 F5 7E' - '65 B6 EB F7 7D 99 19 2D B9 76 9D 83 B0 00 0A F1 0C 51 02 3E 10 24 A0 7E 72 5C 6B 8B EC CC F3 A1' - '65 37 B8 1F 96 B9 EF C7 76 17 B3 B5 5F 9F 3B F6 9E 93 CA F3 BB 1F 63 50 9D 13 27 44 93 9C FB 6F' - '87 F8 9E 1F F8 2F F8 FE 3F B2 CF A6 FE 6A 80 6E 61 01 18 A4 D1 18 17 6E 72 1C 80 02 4D 1A 00 05' - '28 1C B7 65 0E 9F A3 F4 F5 5E C2 85 CD 1B 8F A9 F6 D2 1A 69 61 78 BE DF 7A AB 5D 53 9D FE D2 89' - '39 19 27 35 25 D2 5B 92 A1 DA D8 14 2A 73 70 B4 E7 30 E6 E0 51 E0 7F A7 AF EE FE BE B6 7B BC 3F' - '53 BC EF FD ED B5 F6 9E EF B3 FF E7 BF FE 3C BC 1F C3 F0 BA 73 F8 00 52 3C CA 87 3E AC 85 46 59' - '6F A5 B7 D4 EC 9D 4B 6E DA 9B E1 79 C3 A7 FC 9F FF C8 ED 9C F7 E1 F6 FE 7F 8F A3 4F 8B 36 77 04' - 'AD A9 A8 F6 9D 80 45 43 8F 95 6C D9 68 61 2A 60 8E 34 71 77 3E D3 BF 78 0F A1 FF 6F 4F ED 75 ED' - 'DB B8 AD 24 AD D4 00 28 A2 83 C4 F1 3C 48 B3 B1 78 D3 EF 7F 1F C6 FD 8F C2 ED 9E AF D6 7D 8F 8A' - 'EC BF 9B F6 B0 D9 FE 3D 2D 7F 17 06 BF CF EC B0 92 4E 6F 3D F3 7D 45 BA 01 E8 59 0A 67 36 11 92' - '31 E8 6A 58 2C BD 0D A6 69 D0 27 D9 7B 8F AE FE 9F F0 F5 9F C7 F2 70 D7 B3 F4 5E DF 3F 8F E5 78' - '78 F9 39 41 39 4C 9D 8B 21 C8 A2 3C BC AA 70 21 88 20 20 08 A0 1F EC F4 E6 6E 04 A0 51 14 0B 89' - '1C E4 00 BF 1E D0 41 64 51 E2 77 98 FC 0E E3 43 67 B3 EE 5F 3E 5C 00 39 62 A2 9C DE 6D 85 9C BE' - '3A 39 A9 FF 63 83 EB AB 97 F3 F7 EB 3C 87 AF E0 D7 87 86 C1 21 B4 45 4E 16 6F C2 EA 0B C3 54 65' - '54 2C C2 1C 29 FD 1E DB F6 FF BB 1C D9 9B B5 90 A6 4D 95 40 1B 05 76 D0 6D 66 49 70 C6 8E 97 C7' - 'F4 F4 71 FA 2C B3 D7 6D 89 26 C4 47 88 DC E2 97 89 76 15 37 55 1B 93 EE BB 7F DC F6 7F 7F FE DE' - '3B 87 D0 7B 7F A2 CA D6 FE 7E B7 F3 7E FB F1 3B 3C BE 27 33 9E F9 95 D0 74 14 42 9E 6A 15 55 4C' - '81 CD 45 15 7A 0A 96 E7 C1 B9 61 5E 81 96 B1 46 3B 2C 78 5F 3D D3 D7 BE EC B7 DB B4 FA 0E C3 E2' - 'F3 DF CD BF CB FF 5F 1F 32 E4 0E AD 93 98 3C A5 45 94 82 BC F7 2E 8B 8A 81 7C AD 39 EB 12 87 9E' - '4A F7 4F 91 E9 7F 7B C7 F8 9E E3 F2 B9 FF 3F DE FF F7 B3 C8 68 77 2E BF 87 97 F8 95 CB E7 54 87' - '2D 93 9C 8B 21 CB 55 79 A3 CE A2 D3 2A 36 5A 73 93 13 3A 3E 5F 90 FC 9E 0F C2 FC BF 6D DC 6F F4' - '7D 7E DD 46 70 BC A4 85 32 36 95 00 88 A7 1F 17 1D A5 C7 8D 2E F1 A7 0F 8A FD 8E BF EC 3B 87 DD' - 'F8 EB 6D D7 C5 7D D6 D3 8B 8F 19 26 37 95 24 78 91 38 D2 F6 29 59 C6 9C 69 FB FE 4F AA EA 3E E3' - 'E6 FF 0F 55 F8 DD 47 BF 76 40 8E CF 81 F6 1C AE 3F CA A2 73 39 95 21 CA 43 97 7A E4 64 8C E6 24' - 'A4 C1 3B EF F1 74 DD 2F D5 BE F7 F4 76 6F F6 5F 02 D0 E0 E1 A9 0A 4D C9 22 90 00 40 45 B0 B7 24' - '44 0C 22 24 50 41 07 08 43 E5 BE 6E 96 77 57 91 D4 B6 CE FF AD 25 4F EF E5 6C B8 9F F3 D6 68 DF' - 'B7 F3 1E 3D 1E 1E 86 82 74 16 A1 79 CC 3B DB 21 4C 82 23 D1 33 0C 0A 3A 26 B0 25 19 F4 55 CB F4' - 'FE A3 F3 3F CF E0 FE DF DF E5 EB BD 65 B7 6E FD 3A DF C9 52 14 F0 F1 D8 B1 39 18 71 A4 15 39 36' - '51 39 12 F9 D7 43 FC BF AF E2 78 3B DF C8 F7 1C CC 7C 66 EE BF FD 37 F0 A7 28 12 2F 2D 00 A6 4E' - '46 43 8D 20 10 44 41 94 50 50 48 46 47 9F E2 F2 7F 1E 07 D8 27 A1 EE 49 F9 78 1E DF E2 F2 7D A7' - '6E ED D0 91 EB E4 08 00 08 09 00 8E 84 44 04 8F 4E 83 D1 39 04 E8 20 40 41 EC 0F 2E 3F 67 C2 4F' - 'B4 FB 32 3A 1D 5F 0B E0 88 B6 95 46 9F B9 C6 B0 40 80 0D 44 0E A9 03 91 58 33 9E 49 CF 27 33 E9' - '38 0F 19 D2 EF C7 A1 F4 3E 7F 1F E6 DC 04 DE 92 64 31 9C 0D 84 B5 74 76 85 B7 EF F7 7C CF 4B F6' - 'F6 FB CE CD F1 DB 36 74 95 00 DC 32 73 52 1B 91 60 09 1B 08 11 01 04 5A F4 9D 9C DF D2 87 8F F4' - '76 5E B1 B4 3E 6F 25 B3 4F FA A1 DA 2D CF 7D 1F 5F 15 A6 40 C7 5B FA 42 7E FB DD BD D3 FD 1D B2' - '21 3E 71 3A 46 10 ED 4A 91 9D AD 95 06 68 97 B1 E3 3A DE 93 D8 D7 6C FC EE ED F9 9E 6B CE FD D5' - '6A 72 32 CB 26 00 23 22 1C 88 90 84 F6 7D D7 92 34 BD 2F A2 86 D1 38 2D 9B 36 6C 63 90 8D 44 08' - '40 69 FF 6B 3D 3E 8B B6 C3 E0 EE 73 3D 6F E8 78 BD DF F3 40 3A A4 0E C5 52 74 5D 17 1F 83 F7 5E' - '8B 93 C3 7D 6E CF CA FC 5B FD AB D4 61 24 52 70 24 DB CA 65 FB 43 F4 C8 F8 02 9D 6D 6D 6D 69 C0' - '80 71 20 26 20 01 CD FC BD ED 1D 87 ED F8 BC 4F D1 2F 3A B7 F6 34 88 C3 0C 30 70 20 30 22 22 20' - '46 04 09 4B CE D1 26 05 E6 2D 38 39 3A CC F6 B7 A3 FC BE B5 BB 36 50 65 97 20 00 0C 8D E0 82 02' - '04 26 67 6B A8 FC 2F 4A A1 BA B8 77 F8 0A 90 08 D0 40 02 18 81 22 86 BF 6C EE 1F 5D AB EC 6C 7C' - '09 2F B5 55 BE 89 B2 3C 69 BD 33 77 6C 90 81 14 04 08 4C 7F 83 5D 4E BB 6A B6 5F 7B A5 C9 EA 3C' - 'AF AE F9 C4 E9 D3 21 32 40 02 7A 9B FC 9D 22 0F 27 4E 49 65 96 5A 01 C8 40 11 02 13 C7 F1 BE 1C' - '1E 4E E1 14 98 40 81 98 10 02 89 00 81 DC 79 F8 0D FB 1F B7 63 D0 97 F7 EC BD 3D E7 4E BA AF 9F' - '3E 31 01 C8 80 01 3C 6B FA 63 D9 38 F6 FD AE 0A 60 BA EB AE 60 20 3E D4 20 00 01 FD F5 38 3A E2' - 'DC 7D 37 F9 E2 F6 7D DD 7F 0D 95 D8 61 C1 40 9A A1 20 13 32 20 4C 3C DD 8A 3F 7D 53 CE D3 C3 3C' - 'E5 48 04 4C 44 48 45 84 09 03 9E F2 B8 EB 1D 0E D9 1E 8D 1B 6C 97 6E 64 36 A4 DA A9 3F 3F A4 F6' - '8B E4 CF F5 CF A3 C8 26 C4 14 0D 89 3D 0F B2 F9 EE D3 ED 7A AF 2F CF 6A 0F ED 68 79 44 CB C4 FD' - '5C B6 B0 B0 40 00 18 1B A1 A0 8A 00 51 00 00 D5 66 8D 30 BA 22 F2 BE 5D 67 FD E0 95 B3 66 80 43' - '73 37 A4 9F 4F C6 FB DD D7 CF 3A 84 9E BB E3 FC 2F D4 EC FF C7 B4 BF C0 F9 9E A5 D2 07 42 C9 3D' - '1D BF B7 F1 BF 5F BF 5F 9B CF F3 DF 36 B7 E4 E5 A1 C0 6C 04 E8 44 84 0B 71 21 3D 8E 08 E9 71 D0' - 'D4 F7 19 25 F7 7D 4F FB 38 ED 7F 0E C1 A9 00 81 86 22 01 2F AD E4 BC E4 60 52 49 F0 3D BF 47 F4' - 'FF 85 D1 63 C1 FC 5B A1 63 44 35 40 A6 4E 81 03 C8 F4 FF 95 91 2E 19 32 18 A0 7F 87 D4 FD 36 30' - 'BE 8C 87 5C C0 3C D7 76 F1 1E 3B FC B8 FB A6 50 34 82 40 BD 10 00 0A F4 7F 0F 97 D3 D3 6D D5 E1' - 'F5 FF EF C7 E7 22 A7 9B D4 6B 7E 0F A5 D1 01 90 20 41 12 08 81 09 BC E0 71 76 BE 7E 5F 03 39 F5' - 'DF 83 F5 9A 7E CE 9E 03 E4 70 48 1C 2A 0C 0E B0 E2 A0 0F BE EC F9 9F 53 E7 BC 5F 63 A7 A9 F6 1C' - '3D EF 5C B9 D5 91 0E 0F 9F D3 79 27 73 54 9C 3F B5 E5 3C C7 86 F3 7D DB C1 7C 1D 84 9C 10 40 87' - '79 49 09 CF A7 74 67 13 0D E8 1E 1F 9B DF B9 BA 43 02 4D 12 10 F3 DE AF FD BD 77 6C F7 9D A6 3E' - 'FB 48 6C 09 C2 A9 27 E0 F8 FE EF B6 44 80 71 10 00 04 44 08 4E C3 91 E8 F2 A8 90 0E 42 11 11 20' - '13 E2 C8 8F EB EE 3E 4D 46 58 BE D2 74 BB 9D 2A CE BF CB 72 03 76 E0 00 42 F4 FE A7 BC 13 FE 1D' - 'AD 1F 5E C7 E3 4B 7E 7D 27 82 91 FF 08 8D C8 00 E4 80 20 04 72 24 21 20 94 09 41 DB 50 BB 16 13' - '89 BC 8C B2 4B B0 EC 18 4E C7 8B CC 5A 06 0D B0 69 18 06 1E EF 2C E1 78 64 84 2A 1D E7 4F C8 F2' - '78 43 16 69 AD 4A 62 9B 10 9A A1 34 0B 34 4C 59 66 1D D5 52 61 C5 F8 56 CA 1B B7 6E DD 81 35 76' - 'EE A8 1B 52 7A 3E D5 F8 1D A7 75 E0 86 24 D1 24 CD 92 D0 40 B6 9A 36 93 8C 60 06 0A 2A EF DF BF' - '7E 13 8D 9A 24 D8 80 6C B5 41 D2 E5 A0 1C EF 5B EF BF D7 C0 FA 2E 87 2D 47 89 93 6A 1A CD A9 41' - '83 14 93 72 56 14 12 86 4E 36 4E 3E 3E 3E 3C 72 C4 8B B1 13 46 15 20 17 60 6C 60 6C D9 B3 65 F5' - '19 34 43 60 E8 94 8B 20 68 31 BE 16 81 76 E9 20 59 88 6C D9 B3 66 39 E5 05 36 6C A8 4D 10 34 DB' - 'EE AA 66 DE 97 3A 84 31 64 B9 8E 34 1B 76 ED DB 96 8B A5 00 BA F9 6D D4 58 98 2B 24 D0 DA CA B6' - '54 43 16 10 BA 46 05 E8 6F 50 C6 AA B0 68 97 49 30 82 05 5A A5 32 42 C8 02 C6 32 06 0C C1 C1 08' - '63 84 0C 5B 12 52 10 A4 91 51 59 26 2C C5 97 48 45 03 72 06 04 2C 9B 76 D4 2E 06 78 54 21 68 61' - '86 DD B7 30 86 89 A6 A5 01 B3 0A 24 AA B2 C8 94 DA 42 29 05 08 91 26 0E 08 5D 2E 92 30 D9 B3 66' - 'CC 26 0C 0C 52 99 22 91 04 86 69 B3 65 43 07 04 35 64 A9 0B 54 92 90 8A 33 72 4B 58 35 D7 5D 6E' - '4D 5D 10 0C E1 9D 12 4A 82 17 61 2C A9 25 A0 C9 66 EC 84 B3 01 0C F3 B4 90 DA DC 2B 4A 0C D3 1C' - '71 09 9E D2 B6 30 C9 26 D6 4C CD 34 A9 86 86 98 92 CC 93 34 93 08 61 85 A6 08 06 8C 34 72 61 4C' - 'BB 20 19 31 0C B2 B0 40 CB 1C AD 09 92 49 8E 34 4C 55 C1 0C 18 B1 43 46 06 AE 59 6D B1 8A 19 E7' - '41 B1 0B A4 D8 C9 49 30 C2 A5 91 61 76 4A 49 7C 30 B1 24 B2 59 45 B5 04 34 C2 A3 B3 66 CD 30 08' - '68 87 2F 8B 8F B6 F9 EF C9 EC FC 77 E5 7A 1F 63 EA BD E7 BD F8 07 EA EF E9 BE 1F 7D F5 87 DA 7A' - 'F2 A9 8D 67 03 CF A6 C3 67 3C 74 4C 27 49 45 49 CF A4 A4 E8 FA 35 A0 3B 5B DA C1 32 64 C5 03 26' - '4E D7 6A 16 42 79 CF EF EB FE 3E 3F 1B CA F7 BD 3D B7 D3 FE 37 E6 FA 1E A5 D7 CA 83 D3 A2 81 5D' - 'E4 A3 66 FB CA 67 FC 24 DD 79 9B 4F 36 9B DB FB FD 3F C7 DD C5 D8 EF 9E 7C 2A 76 31 E0 7C B9 1A' - '73 1B 2E 4B 34 FA 78 9C 7C 13 3D E6 76 58 D7 1C 7E 25 8D EF 53 E6 8D 4F D6 A2 47 6A 9F 2B AD 8E' - 'C5 CD 2F 47 55 BB E3 E3 D6 59 62 45 BC C0 D5 65 DC 9D EB AA 67 A7 09 35 26 6B 2B 45 D8 95 57 D2' - '71 1D 66 9D 94 F8 DC 77 39 9A B1 D4 BE 52 DE 16 61 82 A9 79 DB 52 94 FE 70 A1 8D 0E C7 31 29 2E' - '9C C6 79 65 9A 3A ED 54 12 74 50 B4 B6 61 15 1C 4B 88 2B 22 E5 3C 31 E2 EC CD 30 B2 E2 6A AD 15' - 'B6 69 8A 9C AA 5B 25 63 E5 BA 2F 1A 48 5E 74 19 05 B2 22 2B D8 CD 64 14 24 17 30 23 6A 91 00 67' - 'B0 60 3B 2E 29 CF 21 91 08 C3 21 19 16 4C 98 63 9E 00 10 11 9E 04 17 E7 81 04 51 45 24 61 86 18' - 'C7 42 8A 28 A2 8B 24 61 86 18 D7 4E 9D 3A 74 E9 D3 A7 4E 9D 0A 58 C2 8A 58 C3 0C 30 C3 0C 30 C3' - '0C 30 C3 0C 37 B0 30 C3 0C 30 A6 0C 30 C3 0C 30 C2 8A 28 A2 08 20 41 04 10 41 04 10 41 04 10 41' - '04 10 41 04 10 41 04 10 41 04 10 41 04 10 41 04 10 41 38 70 E1 C3 87 12 5C B9 72 E5 CB 97 2E 5C' - '96 10 46 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 9C 20' - '82 08 20 82 08 20 82 08 20 82 08 20 82 08 20 82 08 20 82 08 20 82 08 20 82 08 20 82 08 20 82 08' - '20 82 08 20 82 08 11 A6 9A 6E A1 A6 9C 73 D3 8E 38 E3 8E 38 E3 BF DC 13 87 D7 02 00 05 E6 EB 80' - '00 F0 2F 35 C0 82 00 0B F7 FE E8 8E 1D 3A 74 30 C3 0A 28 A6 9A 2F EE 10 40 82 0B C7 70 E1 B3 66' - 'CD 1A 34 D3 35 9B 26 4C 98 1A C5 79 AC 0D 35 86 96 96 92 E5 CB 96 2C 59 A1 A1 A1 9F 9F 9F 9B 9B' - '9A A5 4A 93 4D 52 9D 3A 7C AC AC AC 8C 8C 8C 6C 6C 6C 4C 4C 4C 2C 2C 2C 0C 0C 0B EB EB EB DB DB' - 'DB CB CB CB AB AB AB 9B 9B 9B 8B 8B 84 68 D1 DB 5B 5B 22 44 89 02 04 16 56 56 56 36 36 27 CF 9F' - 'B0 B0 B0 AF AF AF A0 AE AE AE AD AD AD AD AC AC AC AC AB AB AB AB 34 D3 4D AD 30 C3 0F 9C 61 96' - '65 96 5C 67 B1 5E C4 7B 0D EC 27 B0 5E 90 F4 81 5E E9 90 F4 87 A4 3D 21 F1 0F 88 7C 43 E2 1F 10' - 'F8 87 A4 3E 21 F1 0F 88 7C 43 E2 1F 10 F4 87 A4 3D 7A 41 11 A0 C1 83 1A 14 28 D0 E1 C3 87 0F EE' - 'E2 F1 7E FF BF F5 FD 7F 5F D7 F2 FD 7F 5F D3 24 84 00 E6 84 81 C2 F3 F7 15 9A CE 4B 40 F5 A7 21' - '85 42 03 7E 43 0A DA 1B 3A 0C 2B 78 DC 7D 05 4A 32 6C B3 F5 2E 6B AC B3 D5 3F 39 73 B3 D8 77 B6' - '53 73 99 CB FB 49 F9 BC AD 2A 56 F7 19 AC AF A1 E1 EC FC ED CE CF CC DC 6C F7 BB 7D 9E EF 6D B3' - 'F2 7C 2D 9F 91 E0 EC EF 0F A2 EF 56 CD 5D A2 AD BA 45 5A 95 15 6D CD AD 72 4B 5A E4 96 B5 C9 2D' - '6B 92 5A D6 A4 B5 AC 48 8A A5 22 2A 94 88 8B B9 44 5A 54 47 5D 22 3A ED 12 0B A2 D1 5D 48 B6 BA' - '2A DE EA 32 4A 46 77 79 B1 31 EF 2C 30 AF 61 5F 55 99 06 FF 15 A9 6A C8 53 8A 93 2A 48 F9 09 DB' - 'C8 D1 D6 D0 53 83 9D 1E 06 72 A2 9F E8 1A 53 F5 A6 95 03 48 D2 B5 98 9A E8 A7 03 B7 6F A4 6B E2' - '86 20 51 5A 9A 51 1A 86 95 05 E1 B1 E1 BF 36 44 51 CD 8F 26 31 51 62 C3 34 B9 05 1A 61 67 1C 71' - 'C7 1C 77 E6 00 1E 41 E0 41 3C 78 10 40 E2 1E 00 00 7D 23 DF FA 78 03 C0 28 77 FA 22 98 32 60 C2' - '52 01 49 08 A0 79 26 18 B8 AA B8 D4 A9 5D F7 2B 28 AA 49 8A B0 B3 25 92 4B 2B 29 90 98 E2 18 B6' - '09 92 B2 60 CC 2F 30 B1 2E 32 42 ED 92 C2 10 B5 CB DA 90 98 20 62 86 18 51 31 60 60 C2 5D 85 92' - 'ED 63 52 42 F7 B1 68 A0 60 C8 5D 0C 17 0A 20 14 84 2D 85 ED 2A AF 69 30 64 30 40 98 A1 58 50 A6' - '0C 90 B2 4B 20 17 40 B6 34 B7 64 C1 20 17 49 76 F5 52 EC 81 7B 53 7A 02 59 25 20 5D 0C 58 1D BB' - '2F 65 F9 1D 77 E6 FF A7 FF BE BB D9 FD 14 A4 D7 2A F3 6F FE B7 BB 9B 2D 95 37 FC A0 F6 EE BF 95' - '07 37 AF 93 CD BB DE F3 FD FA 7E 52 5D F7 F6 C3 FC 79 1B 3E E7 A9 59 B2 A3 DD F5 7D AA 4D E4 E6' - '0F E7 B6 A8 99 A3 C9 9A DD 50 E2 CB DD F1 FE 6B 0D B7 7F 91 2E 97 F1 FB CF 99 27 99 45 F9 73 FB' - '78 B3 57 9F 6D 9D 62 8E EF 20 FF 66 AF 2A 8E 75 2A 19 D4 92 D4 E7 F9 76 E8 29 6C 67 B1 65 D0 4D' - '59 62 5D CF 55 CE DB 54 5E D1 24 30 BC EA D5 18 D9 95 B9 B9 74 20 80 07 AA 78 00 00 E9 9E 00 10' - '3C C3 DC 19 5D 70 07 84 80 4C 41 20 20 20 54 50 02 12 BE B2 DB 37 3F C8 E4 7A 6F D9 93 BA CE 78' - 'F8 1E 27 89 B9 DC 6D F6 FD 36 DF 6D B6 F0 3A 6E FE 6D CE B3 07 C9 A5 97 EF B0 B6 B4 F9 0E E2 BE' - 'C7 F6 F8 97 FA F9 D6 77 D9 8D 76 66 D7 9C CE EC 35 BD B7 67 D4 F4 B9 3C D6 97 13 07 0B 0F D2 EE' - '7B 2F E9 9D DF EF FB 2F E7 9D AC 07 E2 48 A2 44 04 00 2B 04 00 37 9D 22 3A CC AE 1C 7C 46 B1 1D' - '33 06 0C 3B 7C 47 8F F3 2E E2 61 E5 E0 57 E6 32 D9 7C BE 62 5D 7D 7D 64 AB 09 56 15 F9 8B 19 B9' - '9B 1A 76 34 6C F1 72 D8 95 31 72 D9 6C B6 59 62 56 08 64 0D D0 90 08 E8 40 84 02 88 10 03 20 C8' - '01 C4 44 44 80 40 11 00 02 08 90 84 20 1C 40 9E FE C8 F0 EE E8 CB C4 F4 BC CA 5F 6F 27 E1 7D 5D' - '86 C9 F6 AB E5 93 9B E1 DD 7D 52 68 A0 97 F7 AA A9 2B 63 67 06 2C 2E 16 92 5A A4 B8 52 F2 DC 0B' - 'FB 4A C9 EB 56 3F 0C AC E2 6E 2E CD 05 64 B4 B7 BA EF AB C4 EA 21 D5 DD 1B F5 5C CE ED 5E 58 0E' - 'A1 2F 37 A4 E3 7D 6F 06 CA 07 15 24 49 FB E4 7D EB 8E A7 E1 C5 65 CF 16 95 16 09 AB 12 E7 2C 90' - 'BE BA 6F B6 FA 97 C1 D9 9B 61 54 CD 9A BA 36 7D DA 3A 45 4D 50 B2 ED 76 5E 1A D2 45 7E 55 EC 82' - 'E3 E5 AC 2A D2 E2 A5 DC 42 46 AC C0 22 C0 D8 A8 71 A4 6B 42 74 89 34 18 B8 CD 33 C6 CF 52 AA FF' - '3D CD FC 3C C3 64 48 71 A1 27 4A 03 DC F5 EB D6 2D 19 74 69 0D 5A 44 80 49 2F A3 C0 35 E3 37 2E' - '61 41 79 10 87 E6 8A 54 77 B0 49 2D F1 45 0F 23 58 B8 B1 A4 C3 87 26 39 C6 1D 1C E3 8E 34 D3 93' - '82 0D 61 E3 C7 80 00 0C 83 C7 8F 02 07 87 F0 2E AD 25 85 CF 8D 5F 2D DF F1 BC CC 6B BE CF 4F 91' - '38 54 A8 B2 5C A5 E9 4E 97 C8 D2 F9 56 7B 71 55 B1 45 F4 70 DA 6E 0E DC 50 D7 D8 CA DD FB 49 64' - '06 44 EA CE BE EB D9 2A CE 79 E6 D6 8F DE 7A 77 1B 85 F5 29 61 4E AF A9 A5 D1 96 93 8F 12 D2 82' - '2E F9 1E 0F 77 48 DE B6 4C 19 4E E3 5E 6F 36 62 7B A7 A7 D2 A6 2D 11 5D 86 59 97 88 90 F5 12 D6' - 'E9 4B 31 61 DD EC 69 24 EA 67 BF 41 1A 80 DC 94 58 1D 94 CB E0 F7 AD 5F 56 A9 AC 3B 39 5C 17 D6' - 'AD D4 E9 D8 BD 7A DE E9 21 59 42 06 6E 82 3C DD 3B E1 EF F0 5D 30 CF 7E CC 8C FB E8 99 91 94 6B' - '61 B0 8B 86 B1 9B 4C 86 41 2D 1D C2 96 A3 47 7E B1 7A E1 56 E9 B2 21 F4 83 5E 3A 36 2C 59 0E 22' - 'BA 22 2C 58 30 75 1E BF 84 F6 14 58 04 41 88 54 28 D1 8A 34 92 E4 48 90 59 A6 1C 69 D8 CD CD DC' - '27 1F 95 BB 51 5B 4A 57 CD D4 F1 56 68 FA DF BC A1 79 1E A4 8D DE C5 EF AB 63 F0 7A 9B 33 2C 30' - 'F7 E9 20 EF CD 3F BA FF EA A7 9E ED BF 4B 69 EF D0 54 FD 99 13 54 36 BF 66 6C 9B 7C 7F C3 E4 AB' - 'BE EC FC 0A 1D 5E 73 E9 53 50 7D C9 FE 8A 2E 3F 5D 29 5D 1E 2E 8C F8 A8 A7 F9 5C E8 29 D9 E9 F4' - 'F0 AC CB 56 FA E4 82 EF 93 77 CF E5 4A 59 38 1D 96 4E A7 4E BB 03 AA AD FA 5A 6E E5 76 91 BD C7' - '56 AC 5E 55 DA E2 5D 68 C6 AF 3A C5 FA 68 8A 2B 11 62 65 DD B5 B6 8F 81 6E 9E 32 97 0D 0D 2D 5D' - 'A5 98 EE 70 1A E6 43 63 10 4B E7 AB F5 A0 3C 67 8A 4B 56 0D 70 F3 82 14 80 B4 9B BE 8E 1B 2C D7' - '8F 60 C1 92 29 8E 9E 16 48 CC 4A 7A 61 B0 E4 1C 5E A3 D8 2E 85 32 1C 1D 68 A5 94 69 70 0A 8A 51' - '86 44 92 49 25 47 28 B8 E6 1A 69 87 1D 88 00 00 58 9E 04 F1 E0 0F 1E 04 0C 13 C0 83 B3 D2 B9 A7' - '94 FE BE 26 D6 70 B5 DB D2 D8 FC FF 57 10 D0 FE EA DC FE CF 0E B8 34 3D 8C 8F 8F 83 D4 BE CE 91' - 'B2 F4 26 E5 F9 9B EF A3 FB E8 9C 8F BF 3B BC E1 4D 0F 3B A1 9C 8F 4F E6 9A C3 C9 E6 3C 9F F9 9A' - '7E 49 27 B6 D4 EB FB F9 69 37 15 73 9F A6 83 2D FE E9 D6 2F 1E E6 A7 22 9E 91 CD EF 00 9A 15 5A' - '9D 7D 04 FD 9A FB 8C 87 7D DB 0B 0C 9C CA 05 D3 F4 D8 4E 2D 27 DC 8D 21 2A E2 DD C2 66 D5 26 21' - '6B AD 34 DC 60 AA 46 4B 95 AD 58 B3 D6 BD 76 91 BD 8E 53 62 AF 33 5E A9 5F 10 4B F8 2C F1 A1 A9' - 'C8 42 D8 76 22 67 99 86 45 D4 57 89 F0 31 B2 E1 38 0D CE AB C6 79 27 27 CC 68 FB 42 03 88 50 17' - '36 4F FD 7A 3C 81 F9 FB ED DF EA DF F6 7F A4 D7 A5 71 02 2E 06 E3 CF F9 A9 3E 19 BD 92 E7 7E F9' - 'F4 36 9E 30 20 00 07 EA 3C 08 2F 21 EC 0D 7F 75 B0 CC 90 38 5E D2 A4 6A FE 6F 6F EF 41 4B DC F7' - 'B1 EA 90 78 3B 7B 7D 1E 47 C4 5C 71 3D F9 59 C4 AB E8 4F CF FE 89 D6 4A 52 FE 1D CE 97 2B 0F 9D' - '70 61 36 59 28 28 B8 59 0D 38 5D FF CD 1F 77 B1 CF BA 9A E5 57 1D 73 97 A2 B7 1B B6 87 AF D5 13' - '57 1C 51 63 C1 91 81 85 51 70 87 BE 35 DD 46 05 9A 70 F0 2A AA 34 71 56 3F 6C E1 CB 54 2C 99 E8' - 'A1 7F 80 8B 5A 26 B4 23 72 ED EF 2F 51 B5 5E 9A E7 1F 47 0D 65 B3 4C 55 CC 97 68 DF 31 CD D0 D3' - '74 2B 10 F1 F1 45 88 13 A8 29 DD A0 BC 44 9A F2 F6 F5 2E 46 00 4E F4 4E 93 04 98 91 64 18 69 25' - '96 64 92 CC 34 E5 DA 5E 58 19 C7 81 04 1B 8A 8F AA 63 EB 98 B7 A8 F3 BD 1D EF 49 1D 47 DD 33 6F' - '55 BC 96 F5 B6 46 C4 70 41 24 40 78 2B C3 9D 6A 48 84 69 65 43 28 91 E3 C2 82 69 86 C7 30 D8 F2' - '67 6C D7 63 4E 1F 9D B1 9E B1 E2 CF 59 4F D9 4F 9F 57 88 E5 66 F3 83 B9 DF 6F B8 3B DD FD 35 C3' - '05 15 17 2C 14 D9 61 69 E7 A1 C5 67 A1 6D 8E CD 5D C6 4B 35 89 32 52 E5 5D 65 5E 65 DE 65 5E E5' - 'DF 65 B3 5B 82 A1 9A EC 3A 8A 87 C4 44 8D 12 82 1C 28 91 22 15 5F 63 62 7E C6 2B 68 F1 E3 B3 79' - '1F 22 4D CD B2 C6 6F 61 C7 8F 1E 3C 78 F1 EE D2 47 91 8F 7B 81 8F 87 81 85 86 D5 AB 56 AD 1A 34' - '66 CC E6 8D 1A 34 66 63 43 5A B5 35 B3 63 9B 36 6C D9 B3 90 82 09 C3 C8 5A A4 19 14 A7 F0 CC 8F' - 'AD 0C B8 F0 63 6B 0E 3C 68 66 49 2A 49 C6 C9 30 E3 8D 3A 49 C7 1C 77 86 08 00 4A 9E 04 10 41 E7' - '9E 00 13 88 89 02 A6 2E 2E 2E 2E 2E 2E 2E 2E 2E 2E 2E 2E 2E 2E 2E 9B 4D A8 D3 E9 F4 99 FD 4E A7' - '45 A2 D1 72 7C A7 35 CD 72 9A 7D 3E 8B 4F A7 C9 C9 C9 C9 C9 C9 E3 EC 7D 2F 4B 63 B1 E8 CC 4C 4C' - '4C 6C A6 26 66 7D 99 99 9E 0F 03 81 C0 DF EF F7 FF 77 03 A7 F3 ED 3E 7D BD AA 2D DB 14 28 10 32' - 'B3 AF 76 CE B0 47 75 95 75 34 B5 35 75 7E 0F 03 AE 7D 45 55 51 AE 0D 30 DE A9 86 98 69 8F 67 8C' - '35 FD A7 67 A8 6B E9 A9 AE AF 58 CC AC A9 E3 7B 19 66 A7 4E 9D 3A 74 F1 94 27 50 A0 85 2A 4A 8A' - '4A 98 C6 AA CF 54 A9 51 A4 AB 8F 26 42 54 B2 16 C9 BB BC 30 D3 8E 54 CD 9E 0E 12 E6 1A 5A 58 DA' - '4C 57 F7 00 00 09 E3 C0 80 06 9F 91 E3 7D 7B 9D BF 91 E8 7A 3B 6F CB CB 2E 3C 68 64 66 3E D5 75' - 'E5 F3 3F 1D 87 17 85 BE E8 F2 BD CF 5E 5C E3 24 C7 26 2A E8 23 C0 F4 E5 9E F4 7D EF 7B 9F 29 FA' - '71 F7 1F 17 C5 B9 FB 3A D2 9D 1E 61 A6 17 26 44 72 89 8D 17 75 B9 E1 76 27 7A F3 BF 6C EF 5E 72' - '5E 57 8D C3 E2 F6 B8 DC 6E 5F 74 E3 8E 38 E3 8E 38 E3 8E E7 65 E5 C9 93 92 59 65 96 58 A2 BF 82' - 'ED D8 41 2E 7C FA 69 83 06 12 24 0E 38 E3 DC DC E5 A4 51 72 92 E3 29 45 DA 7B C5 4A 15 67 67 DF' - '5F 28 CF CD CE C5 CF 8D 1A 35 C6 2E 76 16 16 76 02 9C 0C 1C CB DC DC CD 0D 05 09 D3 A7 4E 9D 3A' - 'A4 F8 EA 15 43 91 22 44 8C FC DC DC FC F5 4F B4 01 03 6E 01 E0 40 04 53 C0 8D AE 18 66 ED DB B7' - '14 51 44 14 61 BF D2 52 53 85 C2 E2 F0 F8 DC 6F 1D F4 58 A4 92 49 24 10 38 F1 A3 46 8B 18 92 49' - '91 22 46 CE 66 6A 5E 5F A9 D4 E9 74 A6 A6 BA DD 6E C7 62 82 82 82 82 82 80 B2 FB 5D AD CE E7 73' - 'B9 E7 73 B9 D3 3D A9 92 E6 66 BA 74 14 33 D3 D3 33 34 34 34 3D 95 7D EE F2 BB AB B4 29 E8 DA AC' - 'A5 21 B2 34 59 64 5B 27 21 BD 6D C5 72 92 1C 25 CD CE 72 12 A1 C2 BE 56 3A C1 C3 C2 5C 3E 88 E2' - '63 2F 1D 80 E2 E4 B1 7E 33 88 4A 64 63 64 5D A8 92 A6 F5 3C 42 B0 17 8B 99 86 2B 1C E1 59 64 0B' - 'A6 AF 2D 5A 75 6E 54 C7 59 9A B3 30 55 6A 96 AA 59 A3 A2 1B C1 1E 47 84 EA 4B F2 F5 4B D6 2E 33' - 'F2 0B 25 D8 FA AE E4 7A 4A AF C7 17 72 45 38 50 90 D6 98 E4 73' -} - - -LANGUAGE 0,0 COMBINING UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE -{ - '42 5A 68 39 31 41 59 26 53 59 D0 E8 B1 5C 00 01 20 FF FF FF FF FF FF FF FF FF FF BF FF FF FF FB' - 'BF FF 1E FF BA 33 BD B1 FF FF FF FF FF FF FF FF FE FF FF D0 05 18 00 D4 C0 A6 4F 03 40 55 53 FD' - 'A8 22 33 52 68 D0 DA 4C 4F 53 F5 1E 54 D1 90 1E A1 A3 4C 81 EA 06 8D 34 1B 4C 50 00 C9 E5 34 D0' - 'D3 C2 13 C9 92 1A 19 19 03 08 68 03 40 C0 8D A6 91 E9 0F 41 32 00 0C 9A 68 32 62 32 30 D2 11 53' - 'F4 A7 A4 34 D4 F5 06 A3 D1 91 03 D4 F2 9F AA 0F 29 BD 50 7A 13 CA 1A 0C 86 26 41 E9 0C 8C 08 0C' - '41 A1 88 19 34 01 93 10 69 91 93 46 40 60 43 4C 10 32 1A 68 34 C0 11 A6 8D 00 68 1A 00 D4 F2 24' - '4C 44 C4 CA 9E C4 D5 3F 15 0F 48 C9 A0 00 03 40 00 68 00 00 00 00 1A 00 00 68 34 00 32 79 40 00' - '00 00 00 00 00 D0 06 80 00 6D 42 00 00 0D 00 00 00 00 00 64 D0 00 34 00 00 00 00 00 60 8D 0D 0D' - '00 00 00 00 00 00 06 8D 00 00 00 00 34 06 86 09 35 4A 46 A6 88 C2 61 0D 19 3D 08 C9 A0 34 00 F5' - '19 30 9A 64 30 4D 3D 4D 34 D0 34 06 86 80 01 91 91 80 40 0C 40 68 68 68 00 69 91 A6 83 4D 03 4D' - '00 0C 4C 40 F4 8C 08 D3 36 6B 4F EC 35 39 A1 09 4D 06 12 D9 BA CC 5C D4 BD 7D 9A BB BB C9 1A F6' - '9D C3 FF 8A 20 90 98 37 62 82 25 D1 59 25 3A 0A AE 50 E5 52 6A 6B 1E 90 46 6A A4 89 8C 2B 0A FA' - '4B 56 04 10 DA 2B E9 52 89 2A E0 6A 43 0A C4 83 04 94 46 9C 69 B3 CC F8 82 F8 C1 3C 63 01 90 60' - '11 17 2B B3 02 08 24 02 49 C3 C2 64 4C E2 71 38 A9 40 92 40 09 86 24 AC C9 99 9A ED AA 1D F0 E6' - '95 D2 08 C2 25 88 6A 49 42 C2 44 11 8C AB 59 40 46 5A D1 AE 48 8D EC 79 E9 08 96 92 5B 85 D8 BA' - '12 C8 E2 26 AC CA 0C 74 83 68 BD 77 22 17 4C 28 04 43 2C 44 E4 98 42 9E 89 7D 81 37 AD 33 45 33' - '31 0C 4E 12 21 DD 89 AA 31 45 9C 58 C4 8A 48 CD 48 35 F7 09 D8 21 40 23 0C 10 CA E8 42 A1 15 05' - '41 4C 54 16 22 05 54 A1 7E E0 C2 17 43 18 B3 49 26 2B 22 E0 92 C9 62 52 BB 18 E8 D1 43 57 B9 4E' - '61 19 64 21 C1 04 39 14 05 17 76 09 46 87 8B 84 1A 21 99 5F 49 92 0A 41 82 DB 44 4A A4 61 3D 27' - '7A 1E DC 44 63 4D 83 2A 02 98 83 5A 8B 8F 74 C9 22 48 20 61 26 09 83 0B 40 88 91 82 EF B1 92 32' - 'B9 FF 6B 40 A9 69 79 7D 1E B0 B3 4C 08 08 25 10 C6 5C 13 24 C0 88 8B 17 16 4A 48 88 8E E7 D4 78' - '6E 04 EC 49 00 F2 27 62 5C A9 87 2E 31 C5 43 A2 D8 DD FA 7F 48 D3 16 67 9E FD 31 62 DD E7 33 28' - '09 70 D6 B3 AD 70 BC 65 39 71 6C F9 65 AC 21 98 6E 9D AC 4B D5 47 1A AC 41 36 14 52 2A 05 61 8E' - '6F DE 98 0B 1A 34 75 6A 79 F8 A0 54 2B A5 B0 86 24 58 53 17 91 2A 70 21 17 A0 40 09 73 02 E1 57' - 'BC 47 22 F6 A0 D3 15 80 20 80 03 15 E5 75 35 90 0B E3 EB DB 54 58 37 6A D9 AD 76 14 14 2B 35 13' - '99 22 FC FD 00 D9 B1 D0 87 6C DE B7 3B AD AC 70 2C 59 21 21 BE 91 92 92 5E FE C1 83 12 74 D2 92' - 'A3 64 C9 98 34 2D AF 1D AC BE F1 7B CA 14 FA 7F 45 C4 EC F7 42 CF 49 6D F8 A9 6D 54 DE AF C5 64' - 'E2 B3 D4 E6 B7 71 5D 61 63 65 5B E9 A9 6C 36 ED EA FC 64 38 71 58 0E 5C F2 2B EB A6 66 66 F1 26' - '17 5F 60 79 E7 9E 79 E7 1D E7 B1 38 E3 8E 38 E8 2C 41 EF 90 48 D7 49 AE 8E 89 8A A3 8B A4 8B 6D' - '73 75 4E A2 35 DC C4 46 23 30 C3 25 94 D4 72 54 AB 53 18 A8 23 5E D5 34 FB FE 4A B7 69 12 2B 92' - '35 D0 17 46 90 69 A6 CA 0A 5A 62 F3 AD DF 1D 18 2F 5F 48 14 D4 D4 F2 75 01 26 C3 C0 1E 10 6C DA' - 'A8 19 03 30 64 0C C1 B8 33 7C ED B4 81 2E F1 FE F0 B2 12 CD E8 7B 45 95 31 34 DA 6A 67 09 D4 D6' - '82 E2 97 F4 10 BD 38 60 BD BD 87 06 B1 10 E1 10 91 22 45 18 EF ED FD FE 00 3A 74 E4 E1 46 C2 AC' - 'D2 FF 15 94 35 55 85 A0 2D 01 2A B5 25 16 51 60 40 11 4D 4A 94 73 CF A5 7C CE E2 C5 52 84 E5 31' - '39 CA 4E 20 90 F3 4F 29 75 5A 91 12 94 A9 B9 3A 03 4A 94 7B 8C D3 1C 0E 0D F9 77 06 DB 5F AC D2' - 'D1 A0 BB 44 B3 44 A0 51 88 EA F9 E1 EF F8 7C 87 D2 B4 B5 2A 84 1D A8 6D AE C4 62 28 F5 6F AA DF' - '89 52 10 0B 9F 0D 13 F2 31 3D DB 88 D7 84 A3 FB 3B 12 04 90 28 FB AC 8B 8B 62 89 5A 51 38 72 A0' - '56 EA A2 86 00 41 2C 37 E9 92 26 1A 5B 4B 56 2E CC 77 B8 D0 23 8B 76 62 A2 F0 CD DB 49 7C 6D 9C' - 'CE 6C 88 A6 AC 7C 51 7B 43 EE 84 BE 71 10 32 06 5B 2E 19 65 10 1F 16 34 6F 48 12 F5 24 26 53 0C' - 'DE C1 E5 0D A7 AC 7C FC 75 0D 06 42 CE E7 B3 D3 6A B5 2D F7 A7 30 8B 0A E5 F7 3E 7B DF D3 8F DB' - 'C3 3E 77 3C 5A 04 34 52 28 BE 83 11 A9 C4 B6 4B FC BA 56 FB 29 67 81 3F 83 06 82 7D 15 01 2E 84' - 'C2 18 4F 42 06 39 F4 F4 49 C3 5B 7C B6 47 00 9C 17 D6 38 20 57 2B 09 0D 9B CB 57 78 09 79 74 24' - '4E BC 12 88 87 0A 13 0C 3A 2F B8 68 41 CC 50 62 E0 F1 59 09 C7 38 50 70 9C CC AF 14 27 13 3D 3D' - '86 3A B3 BC EF 8A DB 80 6B F7 8A 41 51 16 28 2B 19 DF EF 34 30 D5 EF 17 52 15 59 A4 B2 E7 AC B3' - 'BB 1C 3D 6D 4F EE AD 5A E2 CE 30 7F 7A 14 44 4B 26 50 50 40 63 14 11 04 62 20 A1 8C 49 46 46 0C' - '60 C8 C5 45 06 0C 62 22 28 CC 4D 0A 0D 1A 0D 1C 23 02 A4 AF A0 14 54 16 41 62 92 72 AC DD D0 A8' - '30 88 A7 25 71 F5 2B 3B 34 AD 63 10 63 55 A4 55 6B D0 A2 B1 18 0B 05 8C 60 22 CA EA 12 83 3E E3' - 'B0 CC E8 70 64 D4 97 F6 F3 A2 56 07 B9 8F E7 DE 2B 32 23 0C CF 01 C1 0F 41 4B 9A EB BF E9 79 5D' - 'AC 4F 0B 9B B0 50 08 DD 30 48 2A 8A 0A 0A 31 63 BE B4 55 18 B1 6E 23 44 05 06 28 20 A0 C4 46 41' - '41 19 22 C8 ED 7E 4D AE D3 1D DD 6D B6 FF EF 89 B8 DC 75 7F FE 7E D1 6C 2C 6C 68 49 6D 41 48 2C' - 'BC 7F DC 66 92 CB DC F4 7F 9A EB F5 A0 28 16 16 14 98 27 94 49 5A 82 31 10 39 AD 45 4A 90 F2 2D' - 'CF BF 52 56 09 11 91 48 2C 14 80 A4 0D A0 C2 8C 36 3E B5 AF 09 CB 58 55 03 72 2E E4 8A 70 A1 21' - 'A1 D1 62 B8' -} - - -LANGUAGE 0,0 NUMBERS UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE -{ - '42 5A 68 39 31 41 59 26 53 59 42 0C 06 9B 00 0E 15 FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF' - 'FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF E0 12 5B 77 C0 E0 03 EC 0F 7C BE F8 04' - '0F 7C 94 00 07 92 3D F6 AB B3 A7 08 8E A3 6F 9D 0A 7C DE 6E 14 BD F3 B7 87 CC 5D 5C 64 F4 93 54' - 'D3 D3 51 A6 DA 6A 9E 3D 54 D3 D3 D4 8F 46 A6 9E A3 D4 D1 EA 7A 86 C9 3D A2 9B 53 C9 94 FD 26 D4' - 'C4 9B 28 F4 CC 92 3D 23 0F D4 51 A3 CA 79 27 A9 BF 53 46 A9 E1 94 66 12 63 2A 7A 4D A9 FA 69 30' - 'A6 CD 47 EA A7 E5 40 FD 49 A1 A6 6D 1A 14 F7 94 A7 94 F4 9F E9 26 A7 B5 23 C6 A9 FA 65 27 E2 A1' - 'BD 4C D5 3F 54 F5 08 A7 A9 13 4D 26 8F 48 D0 62 9B 7A 44 D3 68 F4 8D 34 46 34 1E A9 EA 7A 69 A6' - '86 8C 48 6C 40 89 9F A5 1A 7A 09 A6 9E D5 1A 7A 69 13 63 12 21 EC 84 64 8F 53 6A 7E A8 C9 A1 B5' - '00 03 D2 03 D2 7A 35 34 63 50 03 4D 1A 7A 34 9A 00 0C 99 A8 C1 94 15 34 C9 32 4D 4F D3 06 4C 86' - '32 A6 94 D2 04 60 04 CF 54 60 F5 0D 00 36 A2 62 6D 4C 00 00 23 01 34 C0 00 8F F5 20 00 02 62 18' - '8C 04 61 30 98 8F D4 00 D4 C2 62 18 01 30 00 00 00 8A 78 84 C2 26 D2 68 6A 4D E5 26 09 B4 53 21' - 'B2 99 31 32 00 D0 00 19 31 1E A0 34 00 34 06 80 00 19 1A 1B 50 00 68 06 80 00 00 68 00 00 00 00' - '00 00 00 00 11 34 C4 94 4D 34 3D 41 B5 34 D8 A7 A4 D9 11 A0 62 00 00 00 1A 00 00 00 00 06 80 00' - '0C 9A 00 00 00 D0 00 00 00 00 00 00 00 00 00 01 A3 40 04 9A 92 45 3C 91 93 20 9E 89 3D 32 18 46' - 'A7 94 7A 07 AA 7A 4C 47 A9 A6 4C C4 4D 34 D0 F5 1A 66 51 A3 43 46 43 D4 F5 19 03 4D A8 34 7A 80' - '19 0F D5 03 D0 9A 69 A0 36 A0 CD 4D 0D 00 19 00 00 00 68 31 31 3D 40 D0 03 46 9C C3 EF 11 F7 9E' - '2E 32 1F 86 E1 CD 09 D3 74 98 D0 5E A2 37 DF B9 24 13 4F 8D 9D 4D 39 4A 5D 55 D8 C6 B8 27 1B 72' - '63 52 47 47 96 96 42 43 82 99 3C 9C A7 C1 A5 95 96 97 50 A2 66 32 62 76 8C F4 D4 94 DB 68 13 CA' - '04 41 44 B4 C4 04 B4 B4 9E 92 08 10 CC 80 E4 17 90 92 F6 BA C2 45 C2 78 E6 90 A5 AD 52 61 12 10' - '52 0C C1 49 7A 10 0A 22 01 51 9B 84 0A 1C 38 30 E1 C1 8F 8F 87 0A 2F 0F 89 5C 43 72 59 A4 00 B3' - '0D 0B 49 73 8C 85 24 26 A9 97 2A 5F A0 B9 02 69 50 0B 6A 6A 06 AD 81 E1 58 70 7E 6A B0 BC 55 6B' - '6D D2 BD BE F9 8D 7C BB 3B D7 E4 E3 DD 7D 37 EE AB E4 5A 13 80 EB 68 27 1B F1 2A 1C 73 03 8F 43' - '5E C3 60 93 62 87 20 CF 96 CF 98 84 F9 A8 4D 7F 75 44 86 87 51 F0 AD 20 6A 9A 42 6A 75 F5 B1 43' - 'C1 6A 2E DD DD 36 09 85 D6 70 BA 6E 0B 5B 78 EF 5A FB AC 1C 8D D4 18 F6 A0 C6 43 81 4C 7C 8D DE' - 'A3 FD DE D6 33 23 23 23 37 91 7B 23 39 83 13 AD BC 7B DC 4D EE C1 85 90 35 88 B2 43 0A 42 28 18' - 'A8 71 37 68 A6 79 F2 BD 7C A4 41 48 72 92 30 0F C1 18 8C 2C 1A EC 61 84 49 65 34 AD 94 D5 A5 45' - '17 E2 80 97 DF 46 0B 6E 1E 73 E8 E8 A0 AC 4D EC 2C B6 AA 69 A6 8A 41 71 5D B5 32 90 8F 38 A7 03' - '54 01 34 35 02 69 59 81 D2 4E B5 AD 6B 08 A2 74 04 2A 1C 10 1E 73 86 14 D0 29 A4 5A 15 A9 4A 42' - '86 A8 AE 8D 33 10 8F 18 46 B1 19 A1 AC 53 4A CC 21 24 EB 5A D6 B1 89 97 42 E1 52 03 01 E8 38 CE' - '91 4D 22 D0 92 B5 29 47 52 E1 88 11 23 C4 30 05 0B 00 9A 25 82 69 59 81 D2 D0 B5 AD 6B 08 9D 75' - 'C4 4B 8E 73 CE 79 5D 3D 0E 63 96 84 21 08 4C 31 3A 7A 9E 21 0C E7 29 AD 96 15 35 09 51 9A C9 27' - '52 94 A5 36 26 DD 69 12 D3 9C F3 9E 56 CF 43 6C 6A D0 84 21 09 86 26 CF 51 08 66 B5 4D 6C B0 A9' - 'A8 4A 8C D6 49 3A 94 A5 29 B1 36 EB 4C 54 B6 08 0F 39 E5 68 50 87 31 D5 25 29 4A 69 86 27 51 7E' - 'B7 88 77 39 6E 74 D0 AD C9 A5 66 73 65 A1 6B 5A D6 E8 9D 75 C4 4B 8E 73 CE 79 5D 3D 0E B1 CB 42' - '10 84 26 18 9D 3D 44 78 CD 6A 9A D9 61 53 50 95 19 AC 92 75 29 4A 53 62 6D D6 91 2D 39 CF 39 E5' - '6C F4 36 C6 AD 08 42 10 98 62 6C F5 10 99 86 5C 92 96 31 0D BF 4B 6B 96 75 A6 AB 10 9B D8 CA 66' - '34 30 B2 32 D1 7A 48 0F 32 EA A5 88 2D 88 61 2E 4F 5C 2D 86 37 E5 39 69 B9 20 AA 98 E5 8C 62 28' - '14 42 45 06 D1 82 22 19 9B 74 44 40 43 33 30 01 7D 52 C5 37 D7 49 A0 30 DE CC 77 6C C5 D7 64 8D' - 'FC 4B 61 B9 BD 83 05 5F B9 AB 92 D2 95 55 AA A5 AA AC 55 55 56 2C 14 55 DC E6 71 30 61 0B D6 2D' - '75 AD 66 93 05 92 D2 D6 AA AA AA A5 2D 54 5E 9C A3 4C A6 99 4D 17 21 9B 2A 98 A5 30 A6 CB 15 63' - '28 8B 1B 58 25 FB 95 80 C5 2C 22 53 4D 12 84 52 21 49 16 41 45 14 89 8D 44 A5 44 41 44 45 01 D5' - 'D5 0C 55 E7 19 AE 49 24 3F 0B 24 B9 35 DD 4F F7 C9 F3 7D 2F 1D 95 FD 66 83 49 77 E3 53 0C 9A A7' - '79 FC F7 A9 EE 74 08 A6 50 E6 3A 08 B3 44 A8 E7 92 10 6D 7F 33 C6 71 0C B0 B5 B6 AC 69 6E E9 DB' - 'CE AA 78 8D 3C C5 93 9B 59 0D FD 0C 4C 3C 9C 7C 5D ED 45 05 B2 AD 98 DE C5 82 34 9C 9E 57 16 6A' - 'B5 1E DE A6 C2 56 D6 5F 68 20 73 F1 DE 75 96 F3 CF AE 47 C9 4A 99 3A 85 35 F2 93 1B AA B5 06 BC' - '93 0A 8B F7 E7 53 28 B3 B4 B5 9A B6 52 96 B9 12 A4 6A 55 4B 1F 92 35 13 11 0C 7E 10 F9 F9 07 FD' - 'EC C4 01 70 BB BA 59 6A 5D 6E 69 88 EB 3B 97 3B 47 B9 B4 5B FB 2B AB EB EB 1B DB D7 3B 2E AD A6' - '7D F0 C4 95 1A 9C 07 6B 19 05 00 80 95 D1 BD 43 A8 E6 92 9E DE 9E 9C B2 3F 08 31 4C 33 67 B6 CB' - '75 BA 6E 97 E7 36 94 50 27 27 93 39 64 D2 CC 2B 4F 7F 46 06 97 62 1A B6 C5 55 63 06 36 E7 18 BB' - '83 5B 2E 82 EA A2 BF 54 17 0D 54 D8 5B 85 74 9B 09 B0 E1 3A 4B 46 1C 26 A8 6D 7E 12 DA 57 88 7B' - '6D 31 23 29 2D B5 F2 4C 81 B2 DB 68 85 8C 86 DC 16 C2 06 B9 0D B6 C7 70 F0 60 24 98 2C 4D 0F DE' - '13 88 C0 46 CC 22 75 38 5F 84 A4 12 BC 71 13 46 52 10 45 F7 A7 43 AB 11 A2 B8 04 06 F5 C0 3C 20' - 'D1 8E E1 C9 00 C8 36 26 87 C4 C2 27 24 A2 26 A1 A2 F8 94 98 30 3E F4 18 30 1A FC 22 53 14 B3 50' - 'EA 8E 23 44 11 08 0C 57 20 74 0E 11 8E 03 84 81 15 68 A1 F0 30 01 F0 16 61 1C 27 91 2E C0 FA 8A' - 'F1 80 24 38 16 74 B6 A0 0A 0E 15 06 34 0D 00 BC 60 8C 17 3C CF 81 80 0E 48 DC E3 4B 5B 1F 61 5E' - '33 19 98 3B CC 92 6A D2 C6 4C 76 31 97 A0 AD 8C BC 66 46 C5 4F 33 EC 33 18 72 46 C6 1A C9 AC 63' - 'E6 2B C6 63 33 07 23 24 9A B4 B1 93 1D 8C 65 E8 2B 63 2F 19 91 B1 53 CC FB 0C C6 1C 91 B1 86 96' - 'B6 3E C2 BD 7E 28 2C 86 02 12 ED F4 CA 85 E3 56 CB A7 AE BB 2A B2 82 98 AC 51 6B 56 B1 0D 05 45' - '08 9A 92 A2 68 2A C9 8C 45 23 72 A2 05 5C C2 F5 82 4C A0 50 85 68 DA A8 6E 9C 8B 77 28 10 37 2F' - 'A6 ED 00 14 8C B4 D5 4A DE E2 39 24 9E 79 E6 5D DB 2B 0E 21 EE AD 09 D5 32 39 A1 92 B2 6B 1C D5' - '5D 56 AA 59 51 EF 71 54 20 4C 65 0C 42 E6 D8 04 88 88 00 C0 E0 08 A2 35 3E 21 8A 27 4A FA F2 21' - '40 2C 96 C3 AA 4B 5C D6 F7 BD E4 F7 BD F2 47 1C 6E 63 5B 3B 9C E7 39 CE 73 9E 30 44 21 10 C4 31' - '44 51 49 1C 71 C7 5A A2 E3 8E 28 A2 73 9C E6 B5 AD 6B 5A D6 B5 AD 6B 5A D6 B5 8C 63 19 50 DA D6' - 'B5 AD 6B 5A 23 5E 55 04 68 9E 71 10 1B 06 13 41 18 0C 04 0D 22 14 A8 45 08 80 01 2B C1 9A BD 78' - '2E BA D6 96 B3 49 58 4C 17 60 6A 96 D6 58 8C 58 17 DA C1 98 CC 60 BC C1 60 0B 18 B6 31 18 62 2C' - '63 18 88 28 88 86 88 88 88 88 88 88 28 88 D9 8C 41 32 69 40 66 26 64 44 46 66 66 44 44 44 44 44' - '44 44 44 44 44 44 44 66 66 64 44 55 66 CD AD 56 B5 CD 34 D9 56 AA 2D 25 28 A5 51 32 4B 22 99 93' - '16 58 5B E5 F2 52 AA A0 A3 18 B1 23 E3 9A 11 8A C4 8A 8F 8C 70 EB DB EE F7 FC 3E 33 48 6C D4 8C' - 'A3 E6 DA 03 E9 F5 FB 45 48 C9 46 FE 24 BF 39 2F D7 ED D3 65 22 C1 60 02 00 F1 6A 58 A8 11 51 44' - '62 84 45 58 28 88 89 16 0C 8C 45 05 18 C5 89 11 11 8A A1 37 AD 8F 5D B5 E2 6D FC F5 7E 07 6B C2' - '77 1D 1F 27 AB E7 31 F1 D0 46 3C 63 2A 0A 02 2A 28 8C 59 11 56 0B 11 11 82 C1 9C 32 50 8B 14 62' - '0A 2A 4A A2 91 8A B0 EC 3A AF B5 F6 FE E7 DD FB DD 3F DF E9 BA 7C D6 69 82 2A 74 B4 15 16 02 2B' - '14 46 2C 11 51 82 C4 44 41 41 9A 46 52 B1 46 31 62 4A CD DA C8 C5 58 1A 7A A6 08 87 B7 A0 A8 B0' - '44 58 A2 20 B0 45 46 0A A2 22 82 83 33 8D 2A 0A 31 8B 12 55 5F 6C 8C 56 21 DE FD 27 78 F1 9F 67' - '71 C1 6E 38 3D C7 0F B8 E1 7D 0E 77 6F 95 B7 D6 ED F2 B8 7D BE 83 40 C1 1D CD 05 0A 08 AA 88 C5' - '04 54 60 B1 64 50 4D 1B 4A 8A A3 18 B1 A6 1A 2B 52 31 54 9D C7 67 A9 ED 3F 6E EF B5 ED BB 7F DD' - 'F1 F7 9E 23 1B 19 82 3C B5 05 73 2D 24 45 11 18 A0 8A 8C 16 29 14 13 56 D2 B1 46 31 65 51 33 B6' - 'A4 62 A9 1D 97 CF E1 36 1E EB E8 65 7B BE BF 5B D8 75 7D 67 D1 EC 7F EF C0 FA 9F AB FF 75 DD 5F' - '65 D6 6E FE C7 65 DD 6E F7 CD 1B 04 74 B4 14 2C 11 44 46 28 22 A3 05 8A 45 0E 0E A5 2B 14 63 16' - '55 13 7F B5 23 04 44 40 26 AB 9F 4D D7 CD EB E6 AB DD 6C 8E B0 C0 D9 E0 58 D9 ED 30 1B AE 5C C1' - '7A F5 FA 1A AB 85 F4 EB EF 58 30 60 C1 83 06 18 8F 29 3C DD A7 69 DF 57 FB EB 75 F2 7F CB 6F F7' - '2F 4A 95 CD 9B 9B BE CF 6B B7 DC CA CB FF 9E B8 7A F6 7E 7A 75 5C E2 A7 DA 75 2E 5C 6D EC 95 2A' - '54 AD 5A B7 DC DF 8B D9 EC B6 7C 7F 84 82 8F 3E 94 0A AA 0A 31 51 48 8B 16 28 2C 14 36 15 B6 6D' - '10 51 15 18 C2 AA 53 1F 0F 54 86 CB 49 E2 76 5A 26 92 AD 23 5A 24 69 1C D2 3D A4 CB 44 A9 5A 77' - '58 B5 7D 6C CE F3 97 CB 45 CB F6 FA F9 BF 4E 13 D0 E2 E4 E7 76 76 E9 23 80 04 04 04 42 B1 29 E0' - '0E E2 54 A5 96 59 65 96 59 65 C5 96 8C B8 92 E1 CB 2B D5 C6 E3 73 39 98 6A D5 AB 8C 79 CC DD 3B' - 'B8 B5 74 F2 DE D9 DB AD D3 B7 76 F2 AE AD DD 3B 59 3E A3 76 21 36 45 68 92 02 40 08 91 E3 E9 8F' - '00 11 37 13 37 CE 30 AC F9 86 15 9C 30 C2 A2 0C 30 C3 0C C8 C8 C8 C8 C8 C8 D4 32 30 65 65 65 67' - '33 99 5C 6E 64 84 D0 1E E9 5F 21 33 58 FF 6E 3E 1C 38 30 00 00 00 00 00 00 06 4E 4E 4E 4C 97 8F' - 'F6 B1 94 DC FA 12 32 07 23 63 D7 78 AB 97 2E 2B 70 57 E7 92 54 F9 F8 B2 D1 81 7D C1 84 4A AC 5C' - '02 2B F0 C6 C7 AA C5 43 84 88 94 51 08 9E 17 0D E5 60 E0 E0 E0 E0 AF A2 5D 51 4D 45 2E BA 86 82' - '7D 6A C5 2A 69 E9 E7 56 AD 5A B5 6D 4D 4E CA 5C 26 04 07 18 92 3D 1C 2B 3C 2C 2C 29 E9 07 FB EC' - '3C 3C 3F C5 93 26 58 BB D9 B9 B9 B8 56 47 71 7A A2 42 9A 85 97 84 96 F0 0E EC 29 36 5B 22 DB 10' - '04 14 CE 5D 83 A8 77 69 3F 04 9F D5 87 4D EF 5D F6 25 E7 43 27 EC 5F 79 11 14 C2 F1 1B 1B C8 C6' - '0F CD 62 FC DD 43 F3 75 4F CD 64 FF 5C D1 FB F7 35 0E 75 BA D7 2E 5C DE 36 6C D9 B4 45 A9 C0 82' - '91 00 53 A0 0E C4 30 B8 35 14 AF D5 14 CA F8 F4 EA FD FE 3A BD 0A 95 1A 3C 85 9A 35 56 4D 6A EC' - 'BF 84 49 5B 56 A6 4D B9 91 4C 9B A2 E8 BA 2E 4F 92 E4 75 5A A5 67 B3 69 11 92 22 82 2A 2B 14 9D' - '03 4A A4 20 AD 81 81 44 89 75 02 D5 8B 33 24 06 F8 40 08 CD 00 88 08 05 A9 24 81 03 F8 6A 75 14' - '8C 58 2F A3 52 F5 F5 D5 CD CD CB D7 AF 5E BD BB B4 C1 87 0D E8 90 11 02 22 22 20 24 5D 09 F3 C4' - '6F 98 5B 5C 30 AD 5F 59 46 DA 89 B2 E6 D4 2D A8 1B 4F CF 36 C1 E3 D5 57 98 73 71 3B 4E D4 6B 9B' - '71 CD 9B CD EA E3 DE ED 83 DE 0E 58 E5 8E 58 E5 8E 58 E5 8E 5F F8 10 CA 6D 85 DE 0C 6D 47 FA B3' - '74 A5 AC 64 D9 9E C5 A5 5D 36 C2 9F 5F 50 D6 A6 A4 DB FE EE FE FE FF 85 C2 39 BB 76 ED DB A4 AC' - 'D4 24 3D B6 3E 7B 9D B6 91 C8 C7 C8 C6 E5 7B FC A9 33 A4 D3 C9 26 91 90 4A 5C 73 87 0E 1C 31 62' - 'A1 42 88 93 59 45 86 8D C9 F3 D7 6D 6E B1 35 F7 5B 07 B5 7C DD 8F 39 B6 45 67 4A B7 A5 5D D3 AF' - 'B0 76 2F 0C 4F 06 B9 F8 BE 92 B6 EA DC 2B ED 2B 68 AF F9 56 DA E5 CA CB 35 8B 1D 1E 34 0E 14 18' - '42 5C 07 49 55 DC 1B 4C 67 43 3A 1B 50 67 A3 7F A3 3E D7 93 DB 19 27 0F 85 09 7C 05 E2 2F 11 78' - '8B C4 5E 22 F1 37 82 1E 13 76 24 BC 29 98 11 EB CC 8E 64 73 23 99 1C C8 E6 4D 99 EF 60 69 FD 1E' - '7C 57 84 BD 7A F1 C7 1D 06 D7 58 0D 8F DF AE 36 D4 DB 83 6E 0D B8 36 E0 DB 83 6D CD B7 36 52 79' - 'C8 4B 00 0B 25 7C 5F C3 06 DF C4 A3 14 51 6E 1A E8 E8 7C B7 B7 97 6D 5A B5 F7 BA 0B 56 AD 5A 7B' - '60 24 70 02 5B 3F 49 46 2B 01 58 0A C0 56 02 B0 17 88 C3 76 66 57 6D 5B 0E 7E CC 43 8B 48 4E 61' - '93 2D 0B 2E 33 1E 34 C6 1C 29 4D 0A 2B 40 51 85 46 95 55 0C 57 1F E6 E3 F3 D2 B2 A4 D5 E2 25 4D' - '53 51 4C D1 95 2E AB 52 69 A6 9A 6F 1D AF 23 17 E7 54 A5 4C 8C E4 D1 8A 49 3C 21 C9 14 FB 83 E2' - '80 95 50 04 E7 09 C5 AA F0 10 0A 12 60 D0 13 9D 27 9B C1 57 35 0B C8 56 64 F7 22 75 4E 4E 2A C5' - '59 3E F4 F2 BE C7 27 46 AF B3 D0 48 9B B5 D1 5D 27 DB C8 A3 57 7F D1 5D 4D 7B E5 D2 31 E0 64 32' - '33 2B E4 A8 D6 5B 5F EF E7 94 DF D0 4E 3E C8 94 3B F2 2E 92 40 AD 71 FE 05 CA EA 2F 4D 62 E9 DA' - '2B A5 DD 5C C6 84 60 70 63 67 58 F6 0A 69 F9 74 B8 D4 94 7E CA 5C 4C D5 C5 34 69 97 97 95 95 D6' - 'E4 54 FB 68 9E E4 B4 CD CD 67 9D 9D 73 57 8A 91 1E FA A9 EF 63 33 B2 9D A6 71 29 D4 4C 59 3C B1' - '78 9A FF 22 69 3B D2 3B 9A 0C 58 B1 9C C2 D3 B7 7B 9F 89 89 3C C5 EB 56 DF A6 3E 3E 3E 3D 0D DD' - 'C7 31 52 D9 FE 56 05 FA A5 B8 0A 6F 56 B6 C1 A0 91 9E 0C 29 90 17 D6 F3 56 59 11 1B 51 29 0D 4B' - '4B 91 57 B9 7A BE DB 84 BE 5A 0A DA B4 CC B7 80 A3 11 61 EB 0B C5 77 4F C5 82 00 0B 86 1F 14 05' - '83 93 BD A7 BD BC A7 BC BB A7 BB E7 2A E7 5D 27 BA 58 99 65 CA 5B 9E 6D BF 35 3E 02 84 FC F5 1C' - 'D7 5B A7 D2 9A 5E EF 6D 85 D2 E4 05 88 AD 9E 2D 0B 1B 3B D6 2D A9 B6 DE D7 02 D9 EA 59 6E 56 F5' - '8C 35 CE DE B8 16 CF 4C CB 65 5E B1 86 EA 05 D9 B2 B8 6E 62 C6 14 97 3D 22 57 B9 78 6D A6 66 F1' - '2E 66 E6 8C F7 2B 75 A2 F5 09 4E 7B C3 6B AC 5C C5 CF 74 7C 55 D7 0A 7C 16 6F 5E 72 C6 E9 6C F6' - 'E1 BD 75 65 A3 77 51 8D AE CA CF 42 91 0C 21 28 9F 81 E1 6F 63 90 5C 8C A0 DA 41 92 8E 01 89 4B' - 'D1 D1 45 50 C5 CF E8 A7 A3 27 61 E4 76 67 36 94 47 28 92 A0 AE CA D5 43 F0 54 5A 23 AC AC 42 85' - '3A 4B 45 14 7C 4F 6A 93 8C 51 45 14 51 45 15 AA E1 E3 EF FB 7D B8 8D 02 08 F2 00 D9 B5 2D 63 2C' - '3A 78 A7 35 09 00 61 33 27 06 69 3C 8E D9 11 88 2C B8 FC BB 03 61 18 D3 99 62 C4 C6 22 38 57 AD' - '09 8A 50 94 72 8B 06 0C 46 9E 35 6B 8B 58 4F 1A B5 C2 8E 30 61 32 00 88 40 76 E7 AD 00 08 1B 41' - '27 89 72 4B 31 66 6D B2 16 46 6D 38 EA E4 B2 2A FD F2 91 5B 57 28 EC 1B 8C D3 42 31 57 C1 30 A8' - '90 21 11 10 7A 41 08 04 09 89 4B 12 81 49 04 89 89 36 65 04 A9 21 E5 EC 35 E2 A4 96 ED C3 4A 81' - '51 13 F6 87 C8 2A A9 09 B5 D2 8A 94 A3 2C F5 54 C8 AA BB BC CD CA A6 AC 6D CA 22 BD 66 39 1B 25' - '69 9B 94 4C F5 DB B1 20 01 55 A0 0A F2 94 E9 20 11 9C B0 C2 10 73 53 E1 18 04 CB 06 08 41 CB DA' - '61 1A 84 12 B7 19 04 1C DD A6 11 84 23 52 D5 D8 74 10 41 C7 AF 08 C1 63 4A 08 42 0C F4 F8 26 0A' - '1B E4 10 84 CB 79 64 BC EA 34 74 93 DC 66 F9 7B 17 DC 9A D1 E8 5D 35 E4 B9 0E A3 39 CB D8 B9 D1' - '4F 5F A7 B2 4E 99 1B 31 82 84 4E 40 D0 A2 3E 85 1B 44 30 C6 1A 18 4F 7C B8 C0 44 2C AF 4F 4A 47' - 'A6 DC ED 68 85 37 87 A3 13 F3 72 66 70 EC 61 43 CF CA FD F6 6D 0D F3 73 AE C5 45 91 BE E9 27 DC' - '33 CD 4E B3 6D 8F B7 0C 50 AA DD 2F 40 23 A5 22 1B 72 2D 3C 43 12 21 48 38 F2 05 30 60 28 CB 87' - '12 08 75 80 2C 41 16 F6 88 72 91 20 7E 5A 08 10 83 F3 44 EE 8C 86 24 0D 21 01 08 1A E0 1C 1B C2' - '58 D0 90 80 84 1E 2D FF 30 30 74 08 25 B1 A0 21 17 AF 84 A2 17 2B 95 A8 20 47 4B 7A C3 BF B7 9B' - '37 EA A1 A1 6C D1 7E AE 6C DD 59 30 C6 5D 15 EA 2F 55 E6 CF 49 77 B4 E4 28 DF BF 7E C5 FB F8 B2' - '02 2C 73 49 0F 12 28 C9 02 46 4E 4B 46 71 C7 1C 71 C7 1C 71 C7 1C 74 52 3C F1 01 28 31 B2 BC 38' - '61 4C 48 20 14 88 4F 90 09 C4 A9 6E 18 49 21 21 00 B3 3C 40 27 18 49 1F 1A 4E 04 84 02 6A 1B 67' - '96 EF 1D 71 1D BB 77 5A ED DD 0E 8A 9F 1D 1D A1 D0 46 46 56 26 0A 07 03 09 3F 90 A6 BA 53 05 C9' - '28 29 C3 08 52 08 A4 12 87 A3 D4 5F C4 AA 71 6D 29 82 D5 2B 4A 8D 1C 80 C0 62 C6 0C B8 B2 C6 F4' - 'CA 81 02 1B DE 51 6B 8B 1B B1 C2 00 D1 3C 36 55 99 1D 32 C6 38 97 03 18 5B DD B6 61 D9 2C 8B 6A' - '2C 18 6A DF D7 95 C9 2E EE A3 DC D4 93 76 47 5B BD B7 52 2D 88 2C B5 AE 1D D9 6B C6 DD BE AB 50' - '36 D8 25 5B 2F 65 91 CB 54 E1 07 0E 5E CC 55 A4 6A A1 60 E5 EC EA B5 6A 39 6B 68 D1 67 55 96 4C' - '42 D7 0B 0E CD B5 5A 97 69 90 5B 36 61 EE 92 EA 13 45 CD 68 EA 28 28 3B 8A EC CA 27 1C 21 70 B2' - '08 75 73 03 B7 28 34 7C 0A C0 77 02 41 81 6E 0B 76 6F A6 11 2E C1 6D D0 81 EC 4B A0 29 CA 78 0C' - '1E C5 08 2E 21 08 1C C5 42 81 9C 42 DB 18 5D 61 A1 40 93 78 61 D3 1D E0 19 62 F1 94 59 52 6F E3' - 'A0 D2 37 F8 65 E2 51 7F 68 B3 C5 5F 4E C4 5F 60 D8 62 2F 70 65 98 2C 38 D5 7B 82 70 29 A9 BD C4' - '90 4E DC 0B D4 73 DF 7D A8 5A C4 9B D1 D0 50 14 43 65 3A 05 D2 14 AD 3A 0A 42 96 EC 5A 48 DB 05' - 'B6 76 2D C8 39 CE 38 08 2C DC 0C DE 5F 99 5C 6C 4E 2D BE 29 E4 44 34 F8 5D 88 6A 07 12 28 F8 15' - '47 21 60 99 01 BC 08 14 7D D5 63 3D 88 F4 92 69 1C D2 8C C1 3A 3C 30 E7 47 97 1E 30 21 3C AD 70' - '04 66 CD 9B 32 1B 36 6C D9 B2 0F 8B 7E 82 D3 96 73 C6 04 1E DA 0B 04 C1 AE A4 55 3D D5 8B EE 6B' - 'AF FC C9 67 FA 6B 73 E9 76 7F 57 1C FE 7F F1 E1 81 59 D7 E3 C5 8B 76 C5 8B 16 2C 58 B1 0E 3A B3' - '58 F9 9C 38 01 CD 63 30 D9 5B F2 5A FB B5 AD E8 BB E6 92 4D F6 0F C3 06 EE 65 81 6F BC 05 BE 1F' - '9E 41 9B F2 63 DB 28 DB 79 56 F6 3F A7 3D 45 D8 73 D4 79 F9 FA 73 F9 FA 4C 41 90 34 73 85 40 F4' - '38 B3 A8 39 D2 A4 73 85 48 F3 E5 48 E7 0A 91 D0 3D E8 A4 73 B2 9A 47 99 AF DA D6 C0 C4 87 03 33' - '6E 66 22 BA 0A 65 49 88 29 96 30 70 40 34 10 56 AF C1 C1 A1 30 10 51 00 0A 10 15 2E 5C B9 72 E7' - 'D6 E0 50 D0 CA 9A B9 72 E3 4D 37 5D 57 0E D4 40 26 04 13 2E B1 C6 7C DD F1 CF 56 3D DA E3 3E 2D' - 'F3 E7 CF 6E 7B FE FB 77 70 F1 D6 96 DC 40 0A 10 58 AB F5 A0 8A 8B 00 34 42 72 87 45 04 04 41 45' - 'C0 01 0A FA 76 13 72 4D B1 F6 6A 74 95 BB 7E A4 E4 BD 7B 8C B5 93 56 16 79 53 EB 39 F6 99 4B A7' - 'FE DD CE 52 FA 2C 7D D6 5D 23 1F 96 DA 97 55 B9 C7 E8 BA A6 A6 B5 7E A0 08 D6 B2 50 04 6B 19 1F' - '02 35 74 A7 EA 99 50 3B 9E 66 B1 9A C6 79 C7 F7 CB B3 79 8C ED F5 F6 06 07 03 0F 0F 0F 0F 0E B9' - 'AC 4C 21 08 C7 4D 33 2D 28 9A 3E 92 8E 81 64 7C 1B 52 40 11 47 B5 10 08 04 6D 6A 82 FF 01 E9 D0' - 'BF C0 61 F1 AF 39 81 BA 59 B7 03 89 CC A1 53 32 E2 7E 9E D3 79 BC ED 77 9D B7 31 B4 D6 62 E2 F3' - '68 5A 67 DC E7 43 97 97 97 97 97 97 97 97 97 DE 71 78 84 2A 68 DD F3 6B BE DD CE A1 47 7C DF AB' - '3F B6 B7 3E DE 65 8D EF 40 1F 79 AD 77 92 FE EF 28 6A 81 9D D5 3B 42 EE B1 DA 27 AD 5E EA 69 EA' - '37 EB 5B 37 6E DD BB 7E 96 36 36 36 7E 26 27 6B 41 F2 E2 49 24 7E 8F 47 A0 41 04 12 4B 26 58 CE' - 'DD 3A 77 AB AB AA F9 F6 EA 4E 3C 1E A0 0B 17 0B AF 30 09 73 07 90 9E 20 F1 10 04 40 11 36 44 D1' - '1D F7 EF 02 36 65 8F 6F A7 D3 C3 C1 A6 EB 9F EA 32 CD CC C6 2B 08 92 49 69 91 D9 24 87 8F 3F 67' - '8F 1A 34 69 18 CD 9B 3C FC FE 5E 7C 34 5D 30 3C C0 16 2E 16 93 85 7A 0C 5B 6E 9D 3B 2D 99 77 59' - '4E BB 39 6E 79 CF 32 D9 0E EB 5A F1 79 36 E7 92 B2 BB 3B 5B DF D0 F1 95 9F CD E3 F1 EE 56 A7 4D' - '36 93 3B 25 81 1E FD 49 18 80 E3 C8 05 C5 77 2E FB 90 23 10 1A 08 05 E5 79 36 F4 24 21 86 11 CF' - '56 67 13 3F 9D DA D5 93 5E 99 2F 43 F1 B3 BD FB 6D 53 4C 9A 27 B1 CF F7 FF 2F 53 25 32 1E C7 3F' - 'C6 F9 8A 99 29 38 F7 59 AB 18 8C D9 41 68 21 50 78 AB 3D 1F A9 E6 F8 79 8D 15 1A 47 04 50 5B 08' - '57 1D 17 07 66 99 B4 47 C2 57 B5 71 70 CB 9C 43 7E 96 44 28 40 5C 69 A3 50 CB C0 7B B0 86 33 66' - 'CE 99 9B 2D 25 9C 14 1C 2E 64 13 7F E2 EE 48 A7 0A 12 08 41 80 D3 60' -} - - -LANGUAGE 0,0 COMPOSITION UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE -{ - '42 5A 68 39 31 41 59 26 53 59 09 E8 CD 9F 00 58 FE 7F FF FF FF FF FF FF FF FF FF FF FF FF FF FF' - 'FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF E0 4A F4 BD 00 00 00 00 00 00 08 7C 21' - '5F 68 A5 33 32 D0 AA D0 A9 3E C0 6F 61 95 51 4A 08 A4 2A 88 40 00 0A 00 00 01 48 41 F1 F3 20 00' - '1D 15 17 41 AF BD 7A 7D 12 BD 98 00 09 7C E3 D3 A1 E0 00 1E E3 48 7D 1E F4 A8 02 5C 9A 43 BD 4E' - '1D F0 01 4A 75 A2 EF BE B0 3C 3D 3C F8 28 73 92 0F 41 F6 82 92 8A 28 4A 7C B6 8D 04 40 24 1A 22' - 'D5 00 0A 02 AA FB C0 00 50 E0 FB 2B 9B 00 00 00 C8 A5 32 9E 14 1E A0 34 F5 3D A4 D4 FD 29 ED 0D' - '27 A3 4D 19 03 53 32 98 D3 21 EA 1A 34 66 91 80 9A 66 80 D0 31 30 02 69 89 9A 46 86 10 CD 1A 64' - '27 A6 41 A3 21 A0 C8 4D 36 26 4D 31 34 30 06 26 91 80 35 30 00 CA AA 15 4F 34 40 23 01 31 0C 9A' - '00 00 01 0C 9A 60 44 D1 91 A4 62 64 43 46 D1 09 E5 1A 6D 13 31 46 99 03 4F 50 7A 9E A6 9E A6 20' - '36 49 A6 68 C4 D2 63 24 DA 1A 69 90 68 86 83 47 A2 00 D3 4C 4C 83 7A 88 F2 69 1E 9E 92 06 A6 10' - '13 20 8C 91 A0 89 B5 1E A9 E1 19 04 66 A6 D0 6A 3D 21 ED 44 F4 86 8D A4 03 46 4C 43 10 68 D0 D0' - '06 80 00 00 D0 1A 0D 0D 32 64 19 01 E9 34 68 68 D1 90 0D 34 C9 A1 A3 43 10 03 4F 48 03 40 94 C4' - '8D 24 50 26 42 68 69 4C D4 DE A8 F6 A8 F5 1B D5 3D 47 A9 A0 D1 ED 49 B5 19 07 A9 E2 9E A0 32 00' - '00 00 68 0D 3D 40 7A 80 00 03 46 40 00 00 00 00 0D 1A 00 00 1E A0 68 19 03 D4 00 0F D5 04 9A 52' - '52 29 86 93 4C 4D A4 D3 4C 09 A6 9E A7 A9 A1 B5 00 D3 4C 4D 0D 06 4D A8 C9 88 1A 00 CD 43 41 E8' - '26 99 06 D4 6C 88 C8 01 9A 46 46 8D 1B 48 D3 D4 34 7A 4D 34 0D A4 D0 D3 6A 0D 1A 1A 3D 4C 8D 36' - 'A6 98 41 A3 11 90 64 02 4D 44 40 A1 0F 51 30 93 46 09 30 29 9B 54 F0 53 C6 4D 53 C8 DA 8D 4F 48' - 'F4 81 E9 3D A5 3D 43 C5 0D 0D A6 8D 47 A2 36 90 D3 CA 7B 44 43 F5 4C 9E A7 A8 7A 9E A0 D9 43 D4' - '34 0D 0D A8 C9 8D 4F 44 3F 4A 0D 1E 0A 68 D0 68 0C D2 1A 69 A3 D4 DA 83 4C 35 0E 4F A8 E7 F6 9A' - 'F7 F8 7A 8E 7F 59 D1 F4 DD 97 A9 F5 BD B6 C0 B2 DD DA 0F 54 BF AD DC F5 72 7D BF 5C 6E AB D4 75' - '9D 9F A3 47 D2 45 EB BD 67 61 DA 45 8B 35 87 DD EC 67 B5 FA ED 6E BF D5 D7 FB 1E BF AD EB F9 88' - '75 39 93 9E D7 F5 89 B1 5C 7C EE 1D FE 3E 36 C7 DE F7 A5 E9 BB 1C 5A 4E 97 C3 96 81 0A 2C C4 69' - '33 52 E7 26 4E A3 3D 4E 8E 92 A5 6B 16 AF 60 C5 90 2C C4 69 A7 A8 D5 B3 77 0E 5D 3B 78 F4 57 CF' - 'E0 41 85 0E 2C 68 F2 24 8F 2B 2B 2B 2B BE DF 79 7E 5F 97 E5 98 C6 31 8C 63 18 A0 63 1B B1 D7 D8' - 'F6 3D F7 C3 F4 1C D4 D1 EB FD 07 37 AD EB 7A 3D 1E BD A6 7C 08 F1 FC 4F 4B E9 7E E7 4B FD BC BE' - 'AC 5F 1F B1 87 D0 BA F6 CF F1 F6 AD 3F 9D 21 C6 88 11 12 48 AA A0 BE CD 5A 8A D2 D5 10 C6 26 9A' - '86 19 69 80 0C 72 24 4C 8A F2 DF 8B D9 22 8A 69 F8 7E 33 9E 6F 9B F7 A5 0B D6 1B EE 3E 5F E1 A8' - '97 BC 73 F7 9F 90 0D 34 00 00 D3 46 35 CB 92 A5 76 CD 26 9A 69 BE FF 6D 0C 28 89 D5 CB 67 BE 55' - 'B3 E2 0A 40 BC 84 7D 4F 81 D9 FB AE DE 2A A3 18 C6 31 AB 26 4C 95 A4 C8 90 C4 89 0A 28 D0 8C 73' - '2A 3D EF 67 7B BF CE 4D 38 C9 76 92 3C 4B B9 A9 FC 9C F9 D2 49 DE DD 5B D7 BD 8B 59 BE 37 6F AC' - '2C EB BF AE DF 8B 6A CD 78 61 FD 1A 15 EC 54 F5 F5 2B 08 2B 4D 9F F0 3C 13 5A B4 49 E0 16 D8 A4' - '52 B3 48 01 4A 6E A6 EB D2 64 C5 52 4B AB AE BA EA 2E BC 0E 95 C7 76 70 E0 BD 27 E0 F8 5E 1F C2' - 'DE 45 16 A3 BA 8C 60 72 3C 78 F1 DB 49 C7 14 75 C1 3B 7D 50 17 27 0E C3 C6 45 15 55 7C A5 51 6A' - 'A4 A6 8F EA D5 5E 0F 08 F7 5D 59 66 C4 28 B4 E2 F7 55 BC 36 9A 82 0B 97 21 6E 1C 6D 28 D6 3C 58' - '9C 72 4B EE 5C 83 BA 7B F5 F1 E3 71 CC 78 36 A6 73 08 41 4E 88 AC EC B3 3D A1 4A 68 D6 6C FC 22' - '8A 39 D0 B8 F6 9A 74 D5 A7 4E 92 34 27 CF 9F 3D 71 2D B9 39 D5 CC 28 A7 78 B2 40 24 E2 E2 17 7A' - 'B2 CE 38 E3 89 B8 E3 8E 38 C8 8E 5C 91 60 80 BB 26 13 C1 45 47 C3 66 E4 41 55 0A 70 A2 1F 0F 29' - 'E2 10 33 0C 21 E2 33 79 FE A7 78 57 84 DA 05 3C 9C DC F6 C3 49 EF 07 B2 D0 4D 6F 3C 02 D3 1E 38' - '6E 18 98 58 9C 16 F5 20 15 D8 60 3E 2B 35 55 AA 00 00 00 00 00 00 00 00 00 00 A1 DC 86 9A 09 66' - '26 68 E8 81 46 FB 44 E5 A4 4B 4C B2 06 86 B7 21 74 4E 83 41 34 30 C0 18 53 B0 C9 2E 36 A1 0A 59' - '49 82 39 38 C6 01 8F 13 D3 26 5C BB 2F 61 14 52 5F 3C 99 0C 94 B3 F3 AE BE 57 31 C7 D9 D2 DB 77' - 'F4 B8 E6 ED 6B 12 E5 EF 55 A1 B3 62 CF 51 42 85 1D 8B 34 03 6A 32 EB E1 60 E9 16 AD 05 4A D5 C6' - '81 60 9D 58 29 56 AD 5A B6 B3 8B 52 B8 6E BA C2 66 62 28 06 ED 95 AC 39 61 AB 16 2C 58 71 C8 EC' - 'B3 2B 2C 81 BA 9C F9 E1 46 89 CF 3D 6A 03 50 A0 84 E9 E9 E0 3E 53 05 97 4B 69 0B AE D0 66 8D 04' - '5A D3 42 85 AA 11 F2 64 A5 36 8B F6 EE 6C DE 7B 5E 7E 3E 8D 1C 7D 3B A7 8F 75 04 10 41 04 0E DA' - 'AB 8E F6 CD BB B5 F6 6E DF B7 B3 B7 8A FF 0F 3F 26 3C 98 F7 33 70 E8 CA 94 66 03 83 09 33 2A C3' - '78 8C C3 51 F6 F6 2A 54 9D 52 A5 4A 95 2A 55 CF 9B 33 13 A7 E0 C7 9A BE 6B 05 9D 92 4E C5 7D 8B' - '10 2C 5A 88 B1 B7 41 9D 22 89 23 02 06 9B 36 6C C9 93 26 4C 3C F3 E6 A0 82 0A 22 8A 27 EE 58 61' - 'B7 2A AC EC A6 B0 0C 6A 51 85 2B B5 66 6E 48 90 31 0D E2 48 18 0E 39 08 32 6A 4D AA 16 E7 DA A9' - '3C CC 5F AF 46 C5 2C CC 5D 18 86 28 82 60 8D 34 40 21 07 37 4E 3B 13 6E B5 4A CD D8 6D DD D8 BD' - '8E 8B F1 B4 C1 B5 85 BD 0E 8A 48 C7 22 E0 0C 42 98 27 DF 28 C6 3A 94 A2 E3 A9 7A F4 A8 C9 0A 34' - '61 10 71 22 C5 01 0C 57 2B 5C D3 61 6A 77 5F A3 E3 EA 5E 30 97 1A A3 58 64 13 98 AD C6 42 DD C7' - 'E7 F9 15 4E 52 24 61 C6 8C 41 BA AC 59 B3 E8 D1 4E F0 D2 88 A0 D4 50 83 CA 9C DA 12 D1 D6 34 22' - '24 34 92 20 EE 24 FC 30 BE 4D 69 A3 11 31 A6 99 07 E2 F0 7C 7B 71 A0 99 31 FF 97 BE AC 58 91 63' - '11 50 27 9B 56 AC E5 61 9D 0F 1F 89 13 A1 99 0E 47 4D 2E 64 32 8E CE C9 F2 51 7D BF 21 78 62 1E' - 'D4 78 F9 7E 56 6A 07 C2 F5 36 4F E5 71 70 6C 5D 4A 44 A8 D7 6E 5D 39 E9 52 B2 1E D3 BB 79 F3 64' - 'C2 A1 F2 A0 45 BE 31 96 D1 05 4A 33 14 84 A6 C7 A3 CC 4D 04 D4 4A 54 15 DF DF 51 24 68 9A E8 AF' - '67 20 B0 0C 61 84 37 C6 22 93 80 05 3D 2A 30 CA 8D 14 52 9F 97 B9 C7 3A 8D 18 12 72 6C D8 78 91' - '9B 69 45 E1 C9 83 89 03 56 7A 9D 17 99 CD 96 51 F9 7E 5A 92 DF 18 C6 B8 C4 22 11 96 B0 16 D6 48' - 'A8 A3 80 CE C9 82 08 EA 23 03 8B C8 3A 74 93 EF 9E 27 1E A0 7F 20 F5 15 4D 44 85 2D C7 52 95 83' - '02 9C 84 45 81 D8 C8 21 4D 03 C5 1E 8B AB AA 81 F7 D9 12 68 D1 E0 50 4C 71 35 86 54 AE 5D 95 51' - '17 2E BA 7C 93 2C B9 FC 1C BB 10 41 CB E2 4A 1C 77 E6 4C CE 75 85 81 48 C6 A5 26 4E EF 28 D7 78' - 'D2 53 DC 25 74 39 68 21 2A 1A F0 D3 2D 49 71 E1 43 36 23 3D BB C4 AA 68 29 1A 33 8D E1 86 1D AE' - '54 A8 AE 3B 0C 75 61 87 8C 86 AD 8B B3 4B C3 94 83 B1 BA F4 C9 9C 6E 19 9C 68 60 83 C9 13 3B F4' - '9E 7B E6 9D 8E EC 71 52 93 24 FC 12 F1 3C F1 B1 4D A9 89 D7 7E 5D 2E 2C 0F 3D D6 33 1E F2 91 2A' - '8A 50 5A AA 48 91 65 5B 7E 8A 75 24 C9 BF 64 F2 E4 EF 10 6C CC 33 95 FA C1 07 59 B0 24 86 84 63' - 'F4 D7 C3 0C 3C E4 8F 7A 4D 7C 21 C3 70 F1 88 EB A0 AD 8A 61 22 01 AB 03 D2 74 5F 64 A8 BB 63 65' - 'E7 B8 5B 11 F3 D2 18 C6 F2 A4 10 80 34 73 09 27 D1 72 91 D7 41 2D 9C F0 F5 39 E6 46 F4 49 B7 68' - '82 D0 FB 69 79 2E 9D 82 C3 05 91 3E 79 84 E7 2E 18 4B 65 15 33 0A 2A 86 50 00 02 51 49 28 CB A0' - '2E 73 D3 01 93 DC F4 3C 9C 92 F1 20 A2 11 67 4E B2 A4 B4 37 95 A1 29 93 14 4B 75 4D 9A 54 F3 F8' - 'D9 8D D4 BB 1C E6 F8 B6 DE 96 2A 54 70 3C B2 53 09 B7 57 C9 BD 1E 55 64 55 DB 7F 34 D6 67 CB 96' - '8F 2D 0C A3 47 72 EF 3A 64 C4 77 30 A1 C8 D7 0C 27 D9 8D B9 02 25 E7 5B 7D 05 7A 98 6F A3 BC 75' - '57 DF A7 84 63 64 47 0E 26 0D E6 D3 42 17 DF C6 6E 6C A9 4E 50 92 77 02 FB AF BE B9 72 1F AC 4F' - '11 D1 D0 6E DD F2 B3 C7 C8 1B 93 D8 62 8F 11 C9 73 17 9F 40 CB AF 54 06 B6 F4 BE B7 60 E7 E4 34' - 'D5 F3 51 61 8B A5 9F B9 B0 D5 E3 60 D4 DB 77 F8 70 E8 6D BC 33 8E 8D A2 9C 7B 5E 8C ED 56 5C 70' - '85 2C 0D B7 70 C6 B5 99 B6 C0 CC 5D 65 99 26 52 AA CC 15 0D B6 18 64 CB 6F 30 4D 49 3C DE A8 AC' - 'A3 77 6F 85 96 77 2F 6E F0 B8 E5 FA B0 6C AA EA F7 DE E0 8F 1C EB C4 AB 1E 38 5D 97 B0 DB 67 5C' - '8D B6 C1 AE F2 D4 94 CB 31 C7 70 E9 3A 1B 6C F9 C9 F1 DB 6E C4 6A D2 A8 C7 4C A5 64 E0 0A 6B 2C' - '58 D4 55 55 9A A7 57 58 88 4E A2 B1 4B AD 55 4B 49 55 40 38 C4 26 CE C0 06 94 80 37 73 85 6D 44' - '4B 52 75 8B 17 5C 50 0D 77 00 14 4C 21 4C 8A EA 4C 28 EA 52 F1 68 A8 4B B7 74 6B 8B 60 EB E7 64' - '5A B5 93 AE CF D2 C9 6E CE A9 A7 51 AF 9B 4B 76 76 CB 41 99 EB 61 B7 91 1C CD 5B B9 02 93 50 B9' - '29 8D B9 46 40 C5 02 34 42 81 67 4C 3D FD 48 94 0C 08 1B 04 8D BD BB CA 2A C5 C8 22 97 61 E6 71' - '32 67 19 C5 1C B6 5A 6D 6D 4E 9D 9B 3D 10 62 9E C6 D6 7A 6A ED 7C DB DB 55 66 E0 C9 8D 25 29 6D' - '41 A0 CA 17 21 18 C7 67 63 69 60 16 35 36 ED AD 92 76 86 24 3E 5D 0C BB 0D 7D 0C EC ED 9A 0C 8C' - '98 B9 33 B0 6C D6 A0 CA C5 E9 EC CD D9 6B 6D D6 A9 B7 B7 B2 8D 18 F1 F6 6B D3 CA DE DB B7 2B 37' - '93 A1 86 76 E4 72 E1 47 71 9D B3 47 A8 C7 A4 D9 D8 DC 67 73 6F 0E E3 35 30 D0 46 A3 54 F1 5C B2' - 'D5 4C 97 EA E7 52 AC 9C 7B 2D D4 AD 76 C3 72 20 67 3E 35 A8 6D 69 57 47 CE 75 DB 79 97 A3 FF 1B' - '62 45 E6 68 FD BD 8D C5 26 0A A6 9A 7B 8A 68 72 97 DB DD 49 39 6F A3 1D 88 B4 E8 A0 82 08 20 82' - '0A 22 88 00 02 28 A2 8A 28 A2 8D 69 29 F4 B3 A3 92 33 AB EB 75 8C 79 CD AD E8 F9 CB 65 97 41 ED' - '4B B0 5D 4B C9 64 BB AB 4A 0D 6A BF E1 97 75 52 6B 80 8F 29 2B 51 74 45 7D E5 9A 3B 3A B2 9B 2C' - '8C D2 A5 A5 B8 CB F7 64 0D 9A 3B 6B A2 F6 48 C8 E3 90 38 C9 59 BB 23 69 65 1D D9 5D 48 1C 5D 29' - 'B9 9C 8C C2 86 92 BA E9 F6 2E 5D 61 4F 3E 86 FE 3A CD EE F5 A2 ED 47 12 20 81 81 7A 3D 09 98 F1' - '14 32 01 10 44 55 24 2D AA 83 10 B6 14 64 55 91 62 30 51 51 22 20 8D 4A 2B 10 FF D0 86 69 49 0C' - '58 42 A9 20 92 46 10 19 24 61 03 6E 92 4E 12 0B 14 45 49 16 0A 44 62 C5 8A 22 2C 58 A4 56 00 1F' - '34 7C 46 6F 45 21 F2 FF F3 83 0A BC 0B 41 6C CC 0F 9E 62 81 7A 50 7E 99 35 61 AB FB 14 FB 94 15' - '77 69 36 AA 2F 34 6C CC 2A 44 51 55 93 54 29 92 98 F8 D5 A4 80 EF 44 A4 45 87 4A 49 3B 8F AD 00' - '24 A2 13 5F 5B 14 54 88 8A A8 8A 8C C5 95 58 A2 A3 33 50 2D 11 55 05 65 4B 14 14 91 70 F7 B2 97' - '0E 18 DB 59 1A A5 26 64 A5 53 16 DB 55 95 A2 32 D5 28 8A A9 F5 AD 8A B8 45 84 AA 8B 25 B5 56 6C' - 'CC 2E E1 4B 8A B2 A2 8A AD 4A 35 B2 B1 4E F2 CB 11 6C 60 B8 6B 25 0A D5 28 B0 46 00 AA 49 83 3E' - '9D DD 0C 6E 37 0D 13 D4 FE 2D A5 A8 B4 58 05 D9 1B 99 35 74 15 64 33 32 58 D9 B0 F1 1E 7B FE A2' - '90 83 55 6C 2F 41 BD 5A 0B A4 E9 B7 B1 A6 CB 7C 6F 86 73 E4 C2 1B 7C 39 9B C1 B3 39 F7 E2 64 1C' - '56 4A A5 CD 52 BB 6F 65 AD 13 2E CC D3 49 0C 19 8E 42 09 AB 62 6D 41 B4 84 93 72 35 1B 2E 9D 26' - 'EA 09 89 16 8D A2 2A 8A B5 1E 93 45 B6 84 3A B0 85 BB 52 10 7B D4 A8 1A 6D 05 DD D4 BA 6D E8 69' - 'B3 4B 50 A6 09 84 2F 33 11 BA C1 54 A2 AA 8A C1 2E A9 52 81 91 C8 41 35 63 1A 50 6D 6A C8 41 2B' - '77 06 A3 66 F7 52 94 75 62 62 45 EC 66 D1 68 1A 20 B7 6F 6A 2A 89 08 D1 A1 15 D5 F9 1D 46 17 A7' - '3E 6D C6 58 A0 A2 9A 34 CC 34 22 37 75 6C A2 E3 88 A7 04 9C 43 9B 96 82 26 84 A9 D2 68 F0 C6 78' - '18 ED 09 56 8E 1B AD 78 C8 F5 B4 0C EB 89 89 B3 9E 16 2F 15 32 10 60 D6 1E 12 88 20 82 21 C9 42' - '1C 91 10 14 90 33 A9 2C 46 22 52 59 1A CA 40 A1 23 02 B2 0B 23 B7 88 18 66 08 14 62 C4 60 B1 83' - '15 18 A8 C9 25 24 82 C8 DC EF 24 9D EC 82 49 3A 0C 6E 78 FF 3E 06 58 41 42 11 4C F3 73 76 1D 83' - 'C8 59 69 D5 95 52 6B B1 0F 2F A2 D7 6E FE 16 36 CB 92 0D B1 B6 49 20 DB 1B 63 6C FB B5 9E 53 3C' - '4D 0D D7 F3 51 2D 1E CE 7F 2B CD 57 10 A9 94 C5 B1 93 25 F9 D5 E3 47 90 7A 8C BD 2A DA 19 39 61' - '92 83 98 0D E3 2A 20 20 08 8C 3A AC 44 98 70 C4 4A 0C 28 81 62 40 C3 11 25 48 83 0B 24 C0 0A 0A' - '48 88 23 11 01 91 90 50 0C B2 52 0C 69 93 B8 BA 90 42 76 E8 06 04 08 8A 43 B4 12 1D A8 74 17 50' - 'B8 04 EC C6 04 C5 82 23 04 95 2E 5D C5 56 15 DB 07 61 8A 02 C0 87 57 65 64 52 5C 09 D8 05 83 04' - '8B 04 44 42 2B 09 9D D9 DB 8C D1 6D 2D A2 8A 28 A2 8A 28 B2 4C 23 D9 39 1A C0 78 2A 79 43 89 D2' - '4E B7 62 BB 08 63 B1 42 27 6C 10 30 52 1B 4A 29 46 21 69 56 5A 4A A0 2C 36 60 3B D6 C6 00 73 D4' - '93 94 87 53 96 0D 4D BA BD 2A E9 33 09 D2 1A 18 71 CD 09 47 4F 06 97 AA 70 6B 18 84 34 1E 24 03' - '10 36 52 49 D2 10 D8 6F 28 AE 64 FA 6D 0A 37 77 4B DE 84 4A 49 04 14 49 07 53 5B 36 C1 5D 6D AB' - '64 C1 B5 23 42 89 11 E1 01 12 95 65 0A 55 15 4A 22 08 82 51 55 11 92 A8 AE A7 1D CE 4C F1 BD 6E' - '80 63 7A 46 81 91 11 01 86 68 A3 A3 D4 D6 83 0C 69 48 D0 C0 D9 A4 CB 96 5E 5A 13 15 1D C4 1E 2E' - '9D A7 8F 11 79 4D 88 A2 BC 28 0D A8 A9 1E D5 9B 3C 60 A4 DE B7 4B DE 55 4D 92 B2 E5 0B CC AA 89' - 'A5 15 97 2C BC C6 C4 15 D8 43 3B 6E 6F E5 5D 6B 29 BE 86 31 6D 6F F1 4E AF 6F E0 B1 D7 B6 F9 07' - 'FC B4 B6 CA AE CC F5 67 75 DD 05 F4 FF 10 CB 96 7A 2C F2 F9 6C 9F 30 B6 AA 63 FB 5B 2E 5C 20 B2' - '02 C8 0B 24 47 9D 2B 47 0C BC D5 F9 2B 2C C1 20 A1 05 80 2C 82 84 CD 65 97 8A ED 69 65 F8 19 36' - '89 60 6F E9 EB 6E 3E 87 A7 15 C3 82 7D 64 34 2B 3E 36 D4 08 2C 16 82 3B 4A 04 C4 69 F6 2F 40 81' - '43 C8 3D 1E 4C 46 9F 32 1A F0 EC E0 23 9C D2 A9 B7 E1 65 CB A1 69 45 52 DF D7 98 C8 62 1E D6 FE' - '1B AB DB E9 8E 08 0A 42 DA DA A9 6F CC C7 29 69 69 54 B7 E6 64 09 A5 A4 4B 7C 64 88 E9 FC C2 DA' - 'AB D3 F4 99 22 17 DA 34 C2 5B EE C7 28 18 2A 7A 5A 55 17 7F 1E C8 17 4B EC 6B 6A A5 BF C6 6E 12' - 'DA 1F 95 6D 44 AD FB DD C2 5A AA 28 49 24 2A AF 10 48 3C BC 55 6B E2 E6 10 15 8C F4 7E 0B C5 57' - 'A7 E0 C8 40 5D B4 47 D9 E2 AB 5F 6A CC 25 A0 7F 50 84 58 F1 54 5F 03 30 96 AA 8A EA 0D 0D 09 09' - '55 43 DB 5E 2A 96 FD B6 42 EA E8 A7 92 B5 C6 A8 5B EA B5 D4 B3 BC 03 E4 A0 52 AA AA AA AA AA AA' - '8C 62 18 E0 18 C6 A8 C8 37 86 41 F5 C3 20 DD 1C 89 75 67 48 EA D9 01 4F 9B 3B E9 74 16 55 79 DB' - 'E1 15 13 D9 1A 2C 51 54 7B 33 D9 23 C9 3D A2 A9 6F B2 62 81 F3 6F 48 25 CD 32 EC F4 D1 F2 05 65' - 'E2 AB DB FF 33 1D 51 06 14 35 45 14 98 B7 B7 B1 16 69 FC 46 38 20 AE 40 0A 25 4C C7 8A AF 4F A6' - '3A 00 82 19 55 47 AC E1 95 93 15 5E DF 8D 8C A8 34 33 7D 9E D5 5E BD BA 21 41 04 57 7A 43 59 8F' - '15 63 4A FC 1A 2A 4F 40 90 30 C0 2E 49 E1 6F 66 1D BB CA DD C2 EB 5C D4 6F 64 58 06 2C 9E 7B 7F' - 'CE 60 D0 9C 71 B7 0C CE F5 D7 A3 5B 04 48 2C 30 EF 88 FC ED D9 A7 E0 E9 F4 AB 4B EE 3D 0E 8C 15' - '07 89 68 8F EA BC 7C 41 AC 7E 56 3A 30 40 88 73 CF 39 21 5A 18 9E 5B 8E 33 C3 3B 6E 2B C9 D1 50' - 'D8 64 DF 98 AA 2F 8E 37 E3 46 8D 9C 7E A3 1D 1C 55 57 D3 64 EB AE B5 D2 AD F1 F4 C7 47 10 21 09' - '77 18 81 3D 08 30 51 4E 60 BD 4E 6F 39 D3 E7 CF 3B 34 7C D7 39 40 73 B0 C3 69 8B 9C E4 E2 34 6D' - 'FB 96 5C AE E6 AB 9C E6 B6 8D 2F 77 C2 E5 F9 50 F9 8F 4A AF 6F E9 EC B9 DB 5E 7D 39 04 9F 39 7B' - '55 A5 84 66 D5 5F 48 33 2F 6A AD 61 1E 5A FA E7 A4 3B 2E BD 2E 4C 5E A6 98 97 56 C3 11 66 64 D2' - '2D 6E 33 BA BA EF B4 BC B3 0D 68 D6 C6 01 88 2A A2 C1 12 82 93 56 8E BF 7D B6 31 06 93 E2 7C 12' - '41 60 52 41 43 6C DE E6 95 5E DC 69 EE 92 B4 E9 B0 BE 5D 97 99 78 AB 49 E2 7B 12 12 15 5D 95 44' - '64 0A 16 9A 79 7D 73 32 D6 AD 6A 60 11 10 15 4A 44 A0 84 50 98 90 0A 23 A5 99 ED 33 0D A7 8F 15' - '5A 50 A9 5D 4B E5 F1 E5 D6 93 C7 BA A5 6E 51 42 2A 44 2D 6F D3 CD 1A C7 1B 30 A4 95 17 1A 8B C8' - '4B 11 7D F9 96 69 3C 73 75 49 55 34 82 94 2A AA 9C 10 BE 06 F7 65 E9 A6 F6 A8 94 55 34 01 5F 26' - 'EC F6 D9 99 56 B1 BD 82 49 46 8F 43 CF BD 1E EB 27 1F 2B 5C 69 BD 0D 0D 09 A3 C3 CB B3 E4 B3 8B' - '2A D7 1B DD 2A 1B 74 C7 B5 BD E6 67 4A 53 32 28 F8 1E 57 C9 FF 8B 5C EA B5 C6 FC 39 98 CD 29 C1' - '60 B1 44 55 23 05 56 A9 B5 6B 4C 69 A6 67 67 5A EF 6A B6 D4 A0 28 6D 5A 1D B5 DA E9 98 F1 FA 4B' - '96 34 02 F9 4B 2F 5D B6 F3 5B E4 D3 6E F1 9F 45 8D A1 94 A5 3C 9A 65 8B B7 3B 76 77 5A D8 31 F2' - '92 B6 EA 0E E8 8C 9E E2 66 61 AA DE 4A D2 0A 32 80 93 C1 AC 3B 69 B6 D5 80 CE A1 46 D2 D5 10 64' - '60 85 23 2E 1B 56 1F 0F 3B 77 3B 64 D3 69 46 83 0B 64 6B B3 DC 63 03 EA 35 DF 7A C5 6B AA 67 45' - '20 88 47 5E CE 43 D5 7E EF 7D BB 76 35 59 D8 19 B1 54 49 66 B3 2C 35 95 C9 CA 05 7E 24 3E AF 9C' - 'FA 46 AB 7D 03 36 09 24 88 D3 CE DC E7 35 5B E5 31 A4 2C E6 66 6A B7 80 C6 74 9F 3A E4 CF 8C EB' - '7C A6 3A 16 76 C9 88 F8 2A B7 81 D4 80 B9 32 67 1D 6F 2B 72 02 3E 67 59 33 E1 3A DF 01 FE 2E 05' - '1D 7D F8 DC DF 33 4D A5 7E D7 98 C0 31 05 54 58 25 D0 92 56 90 94 A9 C5 F6 97 66 59 A3 01 F3 63' - '48 B4 84 BB 73 5C 39 BA DF 01 EB 8D 56 1A 0A 51 3C CE A6 BF 3B 89 9D A5 6D B1 42 28 98 45 A7 6A' - 'D8 DB 13 3A 83 CD 96 08 42 01 24 88 87 ED F2 C8 AD 73 7A 3C FB 36 72 9E 96 2A BA 46 4C 32 F4 85' - '94 F3 75 4E AD 02 A4 65 E1 97 5A C0 D6 15 68 B0 66 4C 32 EB 58 0F 37 4D 09 5A AA 69 51 4F 74 A9' - 'F8 3D 7D E8 E6 AB 7B 05 67 62 89 81 5D B6 D8 DB 13 3B 53 1D B6 0A 7C 8E 79 B1 4F 1C 70 71 88 65' - 'E2 3C 3C 18 4A 44 29 83 1D B6 D8 DB 13 3B 53 36 E3 7C 2A C8 53 94 1E 12 9E 38 E0 E3 30 CF 01 C7' - '12 61 15 C6 80 94 6D FB 0C 77 7B E6 69 B8 6F B9 60 B1 44 C5 52 91 82 AB 50 A8 9B F2 E3 27 06 FA' - 'EA 3B 87 5B 2E EC A4 31 75 CD F0 E7 A3 98 97 01 6E 0F DE 89 8B AF AA 6B A3 41 AC A2 FB D8 82 D0' - 'D2 74 9E 63 30 B0 D6 51 8F 40 92 47 91 69 88 14 68 53 9C DF 0D 06 F9 57 30 A4 84 5B BA 35 0B 12' - '3E 47 76 4B 42 D5 17 BA 89 21 02 AA 54 20 B4 26 ED C1 23 76 6C 81 7A 0D E8 BA B3 CE 34 C8 5A 3E' - '26 F0 81 AD D1 7B AA BB 2F C0 E1 6B E5 B7 84 0D 65 17 B2 EA ED 53 12 F8 96 6C 81 7A 0D E8 A2 EB' - '9A 62 5F DD D6 12 8B CA 2F 2A C4 A9 21 20 BA 43 5B BD 90 35 BA 2D 9E 3B C5 8C C3 DD DD 6F 94 71' - 'C4 8D A3 2F 0F A8 D8 6F 28 D3 95 88 FE F5 E1 ED 6F 69 60 69 92 B7 B3 D0 85 9B A3 72 08 DE FD AD' - '96 B6 1B F1 17 69 2C CF 94 81 78 1E 6E 5D A4 B3 32 05 E5 1B C8 5F 81 73 9C D1 62 E5 1C 64 C5 EF' - '73 E5 E0 6B 28 C9 04 96 F7 C8 17 BA 36 EA 25 BD FC BC B4 2D D1 B7 53 A5 99 C8 1A CA 31 D4 C5 FD' - 'FC EA 06 B2 8C 75 12 DE F9 02 F7 46 DD 41 2D EF DD 4D 2A F4 32 89 F1 DC D2 47 2F 9E 75 86 B0 35' - '27 1E 67 A7 03 59 46 3A 86 F7 EB 4D 2F 47 C2 EB 39 46 99 0F 8B CF 04 0B DD 1B 75 0D EF D7 81 7B' - 'A3 6E A7 F9 3C F6 13 54 69 D4 F3 2D FA 4C 2F 6D 56 F6 1F 03 49 24 36 D2 48 62 34 D6 7B 76 17 81' - '9B 21 6C 5E FF C7 E3 81 AC A3 19 0D EF 90 2F 74 6F DD 43 A3 5C D7 3D E5 D1 BE 51 AC 20 90 91 67' - 'F9 7C 7E B4 0B CA 31 90 F7 DD 93 09 AA 35 D1 E4 B4 92 1B 69 24 31 1A 37 9E 28 17 CA 38 C8 6F 7F' - '2D 0B 4B 74 6F 94 41 20 5E F1 33 47 35 55 54 53 20 1E 63 8B 0C ED 0C F9 AC 61 F3 AE D9 A4 84 E7' - 'DE C3 4D A1 9E 0B 31 E9 5F 4D A7 3D 5B 0D DD 1C 91 1B 9B FA 1B D2 A5 B0 D7 52 F2 73 EB B7 A4 2C' - '0C 64 FA 19 F0 3D C5 86 B6 1A E8 82 42 15 FC A7 35 E1 F5 34 1B E0 6A 44 85 EF FE 8D 90 D0 7A 8F' - 'BF A4 99 AC E1 E3 81 7C A3 99 05 7E 5C AF 73 03 59 46 64 2F 33 C7 2A F2 8C C8 5F D2 B2 AB C7 0F' - 'AD EB 81 CE 55 4A 54 8D 73 1D 5D EE 8D C8 5E E6 E5 5E E8 DF AF 0B CE BD FC 2F 28 C7 D2 2D AF F6' - '7A 16 1B A3 7B 3E 3E D2 48 6D A4 90 F1 24 C4 F3 AE 4A D7 C8 F5 47 57 7E 04 3F A2 F8 4E A1 B0 DB' - '5D D8 AF 6F B0 65 D6 8C A3 1E D5 5E 67 AF 2A CC A3 1E 2A BC 98 7A B6 68 CA 31 ED 1F 1C B5 F4 7C' - 'FA 4C AB 39 47 1D 71 55 E6 16 80 F1 DD 68 CA 31 C5 B4 3C CF 8F 96 91 94 66 44 95 79 5A 49 0D B4' - '92 1A 54 8D 72 72 05 99 46 43 D3 DE 85 33 18 59 81 90 CC D0 A6 3C 20 59 81 8F 42 15 EF 6E 8B 36' - '1B 7B A4 24 2F 64 DE BD B3 61 0D 86 EC 85 EB 18 43 61 B8 6D 5B 4B B3 49 21 B6 92 43 48 B4 CB CC' - 'B5 50 2C C0 DB 9A F3 42 66 3A 95 81 93 02 C4 A9 20 55 48 7F ED D9 68 25 24 51 56 6C 37 35 6C DE' - 'DD 43 61 B9 16 B7 B2 1E E9 1A 30 32 6E C7 FE EC 75 0D D6 E6 EC 7B DD C0 B3 75 B8 7C 1F 58 D1 39' - 'C6 10 CA CE 10 48 42 0F F7 BD D6 CB 48 DD 35 F6 08 4D EB DD DD 88 DD 2C 12 55 BD C4 6E F6 7A 6F' - '29 0B 83 2F 99 90 BA DD 74 EA 6F 60 6E 55 9B AD B8 85 FF 0D F6 46 59 A3 2B 1C D8 3A 4A 92 A4 27' - 'F1 B3 25 59 95 98 5C 1D 5A 11 32 6E EC 46 AB 6E 43 55 DA CB CE 72 05 99 5C 83 32 C9 99 41 C5 45' - '72 EB 46 09 AD 25 E6 69 24 36 D2 48 69 0A 66 64 AB 30 4D 78 BA F7 C4 2F 9C E4 AB 38 77 71 79 3B' - '76 97 D7 55 D4 AB 3A 3A 84 9D 75 2B 9A 07 A3 6C A9 7C 74 68 D6 8A 9E FB 4C 22 D1 A8 77 15 5E F7' - 'E0 49 40 B5 86 4A 74 8D 5E F6 3A B5 A1 94 EE C6 11 58 9D 6A 0C 6B 5A 82 35 56 B4 6E 03 53 7A 1D' - '45 75 A8 44 6D EF 63 AB F9 3C AC 85 AC B3 C3 52 F9 AE 24 4A B5 BA C8 44 62 AD 12 9F 37 5B 96 BC' - '1E 02 8B D4 54 A7 49 A6 F8 14 C5 19 95 2D CC 68 C0 A2 56 06 53 88 C3 BA 25 8A 9A BA DC A2 6C D5' - '30 F3 96 EB 7B 0F 5F 9E D2 6F 82 A6 B2 B2 56 F6 CD 6C 49 0F C1 94 CD A2 F4 36 25 74 CB 44 B6 34' - 'AE BB 44 AA F1 27 99 A2 DC C6 85 8E 06 53 71 A1 41 B6 53 71 A1 63 6C 29 B9 46 59 78 65 38 8D 42' - 'CA 90 0A 6E 38 2C 2B 09 43 89 9B 3A A9 8C 8C A7 31 AD 12 B0 CA 71 2A 61 2F 00 32 9C 4A 93 6C 49' - '80 B7 13 BA B8 62 04 C4 A7 12 A9 85 95 29 B9 8B 35 66 64 33 29 D5 7B E9 E9 DB 34 E9 F3 75 B9 D2' - '16 CD 90 5A A6 17 77 51 58 31 AA BB 95 15 82 69 09 5D CA 8A C1 D3 5E 6B 0A A9 50 56 0D A0 83 A6' - 'A0 36 AA 3A 79 60 EA EE 9A 80 C8 4A 6A 06 DC AB 1B 42 56 08 7D 2B 27 48 8B 40 EA C9 4D 40 6D 46' - 'D7 91 58 46 7B C7 A0 02 53 56 0D AE 5C A8 AC 4E 0E 9A 83 73 E9 8E A2 B3 E5 5E FF 9D DF 5F 0B E2' - 'FB 3F 40 10 C4 6B A8 69 B7 43 D3 B7 F4 79 B4 9C E9 8D 6A 69 9A 23 D4 33 B6 25 04 F0 F7 FC 15 DB' - '0E EA 76 98 FF 54 EF 07 BD 3A 53 97 DE 9E 9C EE 70 68 7E 54 E6 F9 5D 69 5A E9 69 8E AF D5 B9 CF' - 'FB A8 B7 9B CF C2 67 4F 51 AD 2B 63 DC 52 52 A8 4E 7E B4 A6 7B 31 EB 89 F8 11 13 39 7E 6B 1E F6' - 'F6 DA EA 8E 8D 53 F4 64 E7 AA 28 FA E6 49 CE 59 99 EC 99 28 51 5E 21 5A D2 B6 B6 B7 C8 B3 0C A6' - 'BA B9 4D 78 91 25 EB 16 3E 36 0C 13 60 31 CB 63 94 AA 4E 7E 8A E9 3F B7 AD EB 3F EF DB EA FA DE' - 'D3 5D AE EB FA FE A3 57 AD D6 FD 7E A3 5B D2 FD DE AB A0 D8 B3 B0 51 DD 09 02 C1 8C 2D 96 0C 60' - '91 82 46 09 18 24 61 68 58 20 C1 09 B4 6E AA B4 D2 69 39 43 69 46 A9 A5 0A 70 83 4D 0E 54 91 B6' - '36 D2 52 84 38 DB 4D B2 51 1A 89 83 6A 15 20 90 88 DB 25 63 18 6C 69 89 6E 16 5A 89 4A B5 2A E0' - '89 71 6A 96 B4 6A AD 14 41 2A 23 6B 28 5A A8 CA 2C B5 B4 6D B6 D4 A8 B6 B1 A5 2B 4A 30 6C 59 4A' - '8D 2B 55 B1 A8 D2 89 5A 56 B6 96 D2 AD 6D B6 DA 2B 6B 4A 25 1B 69 46 21 54 AA B4 46 A0 DA 32 96' - 'C5 B5 AD 95 A5 95 54 B5 B4 5B 5B 6B 5A 96 56 B6 25 06 2C AB 45 AA B6 B6 8D A8 D1 1A 96 B6 A5 2B' - '45 18 C6 8B 6B 4B 62 54 A3 5B 6D 1B 83 18 56 62 53 06 2E 29 54 A3 56 DA 51 B1 62 D9 42 C5 12 8A' - '51 AB 54 6D 54 AD 2A D6 8C 69 6C A3 45 2D 63 50 6A 31 1B 44 B6 35 89 54 AB 6D 32 05 55 15 54 15' - '45 46 31 51 41 18 AA 22 08 AA 8A B1 11 54 46 64 5A 2A C5 11 88 C5 62 0A A8 82 A8 22 88 2C 15 40' - '58 28 A0 B0 51 4A 25 41 45 91 45 82 91 41 41 41 62 A9 14 14 8B 16 28 A4 E2 48 6E 66 E6 40 45 01' - '54 44 8A 28 B1 08 6C 58 45 80 10 58 44 60 2C 20 B2 45 00 16 0B 16 45 91 48 02 90 16 00 B2 41 61' - '14 15 19 20 45 8A 12 0A 41 48 2C 80 A4 05 90 51 41 64 91 42 02 90 84 16 10 05 92 11 49 08 2C 84' - '88 2A C3 EE 0F 60 7F 62 7D 3F DA 47 68 68 93 69 55 20 CD A0 81 00 B8 16 44 84 B0 92 49 88 24 82' - 'C9 16 10 8B 24 22 81 21 22 48 03 24 09 0F EA EB 77 19 B8 90 0B BA 96 C3 1F 6B EC AE 01 94 05 90' - '81 CC 90 92 1A 30 94 90 9F 01 84 C7 ED 28 08 4C 32 00 13 74 20 29 24 59 24 8F 39 D1 61 00 B9 45' - '41 C5 86 4C 30 C1 60 40 CD 2C 40 61 92 67 FB AD EF B4 CF 76 9B CE DD BB F5 DF BB F9 77 6D 7D 9F' - '43 1C F9 FB FC 2D 6F A9 7B AE 3F EA 1F C6 3D AE 3F F7 FB DE B5 59 2F 66 86 94 91 2A 1D 91 2F 77' - 'DD A9 AA F7 89 6F 77 5B AF B7 76 DB EE 3A 77 0F B3 F5 FB 9F 0C 07 70 90 0D B0 48 49 C8 B0 0D 4A' - '40 C0 81 3A 54 E3 92 2C 9A 84 81 3A 94 09 38 94 E6 D2 48 4E C1 84 92 71 EC 03 5E 39 0D 4E 21 A4' - '75 FF 6B 7D A6 B2 81 DE 35 1A BD 26 5F 8D 27 B6 7F CA 73 BC 85 E4 39 CB A5 D3 50 39 C7 91 7A B4' - 'E7 3A BB A8 49 A8 ED EC 9A D7 67 40 43 5B 7B 97 AA E2 2C 84 9D 9F C0 DC F0 1A D4 24 90 9A F4 18' - '29 16 2C 8A 44 54 02 2A 80 A0 02 91 11 41 60 A0 A0 B0 50 50 50 59 21 3D 32 FD 1F A8 F0 F0 66 23' - '0C 53 E7 29 98 C8 68 72 DE F8 0F 40 5A AA 8A AA AA FA BE 17 4B 8C 9C C2 D1 D8 6E C5 B9 7E 9E BB' - '68 F7 7F A8 22 11 78 C3 23 3F 1A 7C 96 EC 9D 6B C5 BD CF 9F 92 8E D1 E3 8D 15 10 BF 3B A2 EA 6D' - 'CB 96 71 CA D2 93 D2 D9 22 49 79 1B 49 24 92 4B CB E5 F0 DD FA 3D 12 1C 1B F3 9B C6 FD 26 F8 CF' - '1E 61 22 55 90 65 C8 ED 02 E4 12 19 C6 14 16 7C B3 86 7C 62 EB 9A 65 3E B7 E1 FB FE 8F A4 FA BF' - '1B 9B F3 FE 83 D1 69 E9 F3 41 87 B5 DA C1 DA 9E AB A9 24 13 A9 12 72 4A 13 61 6B 91 3D 37 E8 80' - '42 25 E7 A4 04 5D DD 77 9B E6 FB E0 7F 50 08 80 06 C4 00 3D BF 3A B3 1F E9 DD 81 68 DA 82 1C 27' - '09 1D A1 6D 08 70 65 B3 F5 80 E5 5B E9 45 52 F2 7F E6 FE 10 59 65 A2 DB 29 6A CF B9 97 12 2C 0D' - '1C D1 3A CE 5D CE 94 88 8A 64 62 7B 70 59 03 A5 18 A6 70 CE 03 38 11 02 47 78 04 B9 38 84 40 F3' - '9E 3E 4C 41 97 A4 2F 38 C5 30 CD E7 15 06 3B 53 79 C6 31 4B FB E8 48 67 EE 80 07 B9 1A 13 09 EF' - 'C6 1C EE 74 12 F9 D4 28 6E 77 3B 9D CF 1D AD 7B DE F7 BE 73 9C E7 29 4A 52 94 E6 F7 BD EF 7C E7' - '39 91 46 31 8C 63 27 39 CE 73 A6 E7 39 CE 74 E0 F7 BD EF 7E 8D DC 76 2D 0C 98 B1 62 C5 65 96 59' - '65 98 B1 62 D7 46 31 8C 63 4A 52 94 94 A5 29 4A 94 A4 21 08 42 11 AA A8 42 10 84 25 27 BD EF 7B' - 'DA D6 B5 AD 9C E1 28 F4 D2 94 A7 3B EC AE BD 7F 3C 19 64 A5 A8 E9 10 00 0B 77 24 3E 12 AD 94 AA' - '18 D0 5D 34 E2 B0 52 96 1A 87 16 2B D5 0A 52 94 AA 54 E9 80 00 1A 20 84 CD 6A 73 C0 03 A5 20 03' - 'F3 21 2D B1 08 C6 E9 14 94 48 4E 92 B6 41 72 94 A5 FB 4F A4 AB 66 C1 D9 99 AD 6F F0 D3 94 57 64' - 'AA AB F9 29 A1 BC AE BF 62 D6 93 5B 92 8B 25 DD AA D8 AA 63 BA EF E6 77 EE EE CB A5 BB 44 A2 0D' - 'CE 6C 84 59 66 A6 5E 29 4B E0 26 B7 7E 60 05 7D E3 15 82 EA 60 C7 58 0B AF B1 B0 BC 63 19 6B E6' - '17 77 69 66 0B B8 78 9A 67 F7 AD 82 13 C8 64 3B AE CD BC AE ED 6A AA AA F7 ED 9B 76 CB 21 55 55' - '7B ED 36 9B 54 35 BA E9 7F 89 84 86 D9 34 CA DC F3 00 68 3A 49 42 A8 60 1A D5 0A 14 2A A8 50 A1' - '55 42 85 1C 1B 5A D0 D0 D0 AA A1 42 83 65 7A 6A 36 6D C4 48 55 BF 2E D3 32 CD E3 85 C0 EF DB 04' - 'F8 BA 13 50 A5 3C D3 27 96 0A 60 EE E1 C9 1F 88 85 29 4A 5F 15 01 48 01 44 10 88 2C 19 8F 75 EA' - 'E5 BA 52 D6 44 54 6A 12 21 06 BB 24 92 31 0A 24 10 40 A8 B0 00 22 51 7E 1C 04 B0 42 2B E7 84 7A' - '24 22 19 CF 27 EE D2 00 BE 55 F6 BB F4 6F CF D0 5C 40 9E 85 69 51 7B CB 8D 10 51 0D BC 32 D8 D5' - '14 A5 B0 53 CC 63 69 21 34 98 42 13 80 52 B8 40 97 A6 63 86 33 CD CE BC 54 22 9A 39 8D F8 15 6C' - '34 81 08 84 67 D0 36 92 94 A5 73 EF DA C2 5D 94 85 10 42 29 4B EF 4F F5 53 4A 1A F2 01 8C 69 49' - '7F D3 F4 60 2C 46 4C 63 48 55 44 97 C4 94 48 82 38 E3 6E 83 DB 38 B3 17 80 A5 9E 5A DA 52 D6 04' - 'C7 87 27 0E F1 C0 F1 23 EF 45 BB 14 87 AD BC 43 34 3C B1 96 B4 42 6E C8 D0 C2 9B A5 D2 DA C0 8E' - '92 00 C2 35 E0 8F 22 EB 20 1A CC 56 11 78 B5 4A 50 66 72 F2 CA B0 E5 90 8B 46 B8 37 8A 01 20 09' - '17 78 04 21 00 6B BC 04 24 5D 55 8F E1 18 84 41 EA BE 8E A2 88 42 5C 32 48 8D 7F 49 E2 89 B0 5D' - '28 69 98 C6 94 13 E0 21 08 F2 1B A6 10 89 C7 6E 64 62 69 18 03 29 9F C0 48 DA 93 12 83 88 2D 27' - '8B 80 62 D4 9D F1 C6 D5 3A BA 42 10 8E 3A 7B 09 0B 8F AC 01 7A 1A D3 E3 A9 6A 9E E8 14 65 A8 53' - '8A 91 82 DA ED 1C 23 8E 95 A0 C6 84 4E 49 D0 58 91 04 54 68 DD 53 55 3B C0 F8 68 40 49 53 DB D0' - '02 11 77 C2 C3 BB FA 8F 89 10 45 6A C9 48 0D 38 1A 4F 88 21 19 49 1B 16 6D 6C 92 DE 94 13 DF D2' - '12 2F 69 DB 5B 06 92 08 53 87 6D 13 B0 EE 47 EF 35 53 D4 94 73 84 69 5A B2 9A AD AB 54 78 18 33' - 'D8 AE D1 55 62 DE 00 88 21 0F 8F 20 31 45 D0 7D D4 0D 3C B2 5A DA C5 51 41 0A 21 42 B3 CD 27 B3' - '89 ED 26 32 FD E2 92 58 96 62 EF 0C DE E9 F7 0C F3 47 9A F9 CC 98 85 E3 97 39 8F 87 0A 0A 4B 38' - 'E2 BC 6B B9 CA 39 90 1E 70 CA 6B F1 8C 95 02 90 D3 4B 75 62 C6 4C 92 23 5C 28 8A 24 49 CA E2 46' - 'C8 D7 31 4F B0 06 57 84 36 A8 9E 8C 63 CE BE 53 0E 85 73 4D 29 70 3F 52 59 61 AD D6 B5 AD 9F 16' - 'B9 B3 5B F4 F5 93 6B 42 E8 EB 11 A6 D6 EA 6B DC E7 37 52 42 1A 32 D4 8A AE 17 EF F7 3A FD E7 43' - '51 5A D3 42 BA BD C5 C8 A4 5B C2 63 74 34 36 AD DC 4D CE 73 5A 56 AE 86 D9 75 2B 73 64 DD C5 91' - '2E 24 64 1E 5E 34 13 A5 35 BC 7D 39 26 33 25 9C A5 6E 06 CC 5D A6 A5 24 FD E2 21 C6 41 53 57 86' - '13 6D 61 21 FB C4 7A 43 BB DD 18 F4 BD 3E A5 7D 06 B7 DC F6 7A 3D 0E DA 78 5D BF E8 3C 77 CF E9' - '09 21 34 61 00 48 21 01 59 01 48 C2 49 2D 7E AF 8B 87 4E 19 F2 94 88 AC 69 52 AA 84 4C 4C 55 18' - '98 4A 88 DB 63 6C AD 4A 5A DA B5 16 56 B5 A3 0A 2A A8 96 CA 8A 25 A5 50 AD 12 C6 54 48 B8 CD 64' - '48 52 1C DF E8 D4 F8 2D 06 FB D5 7C ED 7F 8D E3 B3 9B 0F 19 B1 67 F7 DD 5F CC E8 39 ED 56 77 B7' - 'FA BD 06 93 8F D2 FF 2E 93 4B 3E 7E E4 F5 BF 0B A1 92 98 F3 C9 25 D7 A6 69 DD 49 5B 5C 87 40 2D' - '13 C7 9B AA E1 ED B6 CE FE 6F 9B 71 3A 88 5F 37 CD F3 BC EF 33 CA CB F3 57 79 99 2E 35 DF D3 A9' - 'D8 F6 3F 4F C9 EB 36 5D 97 59 DB 74 FF 93 AF DA 36 8E 2A DE 87 A1 DF 02 07 6D DA F7 58 20 01 E4' - 'F6 DA 1C 19 BF 22 88 59 61 58 A2 2A C7 CC AA B2 C6 22 20 CA 52 41 04 41 0B F0 7C FF 89 E2 D8 F9' - '39 7A 9D 62 F7 D6 C3 A8 7F 9E 2D FE 7A 72 04 2F A9 81 53 D9 14 48 82 74 7D 5B C3 24 41 3C 21 3A' - 'F1 49 4B 0A 5A 52 16 C2 96 CA 54 70 C5 71 30 89 8B 44 44 65 29 54 63 2D 29 4A 14 B6 52 D2 96 CA' - '54 A3 2D 95 80 CA D8 B5 25 11 0A 2A D2 88 83 01 61 60 19 21 0C 39 15 03 6D EA 7A CE 4E DF BD DF' - 'F9 BF 91 CD E8 76 BE 53 C0 F7 CE 93 7A CE 7B 1D 8B F3 76 17 3E 9E 36 FE 2D 9B 88 9D B5 53 4E 1A' - '5C 02 AB 3E 14 59 FA CF 99 F2 0A 7C 73 DA F0 BD E3 AE 6F 94 83 9C A3 76 41 02 F0 E6 91 AC FA C5' - '3E F2 A7 C4 99 F3 19 0F F7 AB FD 59 CF D4 4D AE 50 FE DB 34 34 6C 1A DE 52 59 13 F0 D6 E1 8A 92' - '6E 11 37 8C F1 5F CB 26 32 4D 06 D4 26 EA 91 B1 39 35 0D F9 F5 3C 65 93 86 81 A3 C2 4B 44 29 FF' - 'D5 6C 83 86 A9 03 81 B5 4D E7 38 BD F9 1E A1 0A 07 0D 0D 1D 08 DE EB 2A 3A 65 A5 75 59 54 AD 7E' - '31 18 5D 0A 92 8F 2A AF B8 62 B0 43 34 2E A9 A7 5E 37 BD 50 EC 44 42 92 DC D2 95 75 B9 F0 80 89' - '88 10 B5 D5 A0 B8 A0 41 C3 01 28 A2 D9 23 3A 03 58 D9 4A C5 AD 4E C0 EE 9C AA B9 4E 69 35 52 98' - 'B5 AD 38 23 D5 4D 5F 61 9A 4E BB 5C A1 CF 75 1E E7 08 C5 B6 AE 3C 61 C8 2C 7D 62 D3 B2 A6 D9 92' - 'CB 1B 03 96 45 7C 5E E8 5F 9D 0D 21 97 1C EB 2B E9 06 C8 F1 8D 2A 13 72 5E 6D 0D CE 3A 87 19 1B' - '5D 48 3C DF 53 90 60 83 20 A0 34 19 A3 1E 55 20 B8 1D 79 8B 5E 18 61 7D 97 62 86 17 67 B5 D1 C7' - '79 A2 06 8B 9E A4 74 0E AF 39 09 ED D2 C7 09 3E A3 37 E4 17 66 09 5D 20 56 D6 EC EB 6E 93 8D C8' - 'EA 9E FA AE 9C ED 98 B5 C7 85 33 D0 B0 A9 2D 2C 84 44 B3 9C 0A 6A D5 AC 4C E2 26 D9 A3 E6 6E 08' - '77 B9 8A B9 13 22 3A FB D1 1A 1A 95 D7 8A CB 2C B3 15 A3 20 C5 29 47 0B 94 B1 DC EA 52 94 93 D6' - '29 4A 20 89 2C 0A 11 82 AA 3A 10 8D 8D 52 B9 66 1A 31 8A AA B2 96 11 63 98 A0 AA DC 83 26 41 7A' - 'DD 8F 0C 13 01 8B 12 4A 72 94 A2 EC 30 30 F4 23 24 47 5F 3C 44 21 03 B6 11 84 67 4A 89 B1 04 D2' - '7E 0A 22 D3 AE 41 12 F3 85 96 B6 52 C2 BC 71 AA 31 8B EE AA A2 83 53 05 C1 71 10 72 99 DE 8F 53' - 'A6 18 AA C3 1C 69 4C CC D1 D9 DF 1A 5F 6B 44 5A 60 AB 31 F7 A5 F9 77 1E 0F 76 7E 29 EC 4D BB 9F' - 'BF F1 C5 F6 FF E3 EE 31 D8 85 DD D9 CA 7C 66 48 7C D3 74 54 BF 69 E9 8A B8 14 86 14 9F 15 B9 25' - '88 25 0E B9 BE 48 B2 80 67 9C AC 9A 47 10 DF FA A0 A6 74 F0 28 49 C4 C0 0E 2E CD 95 24 F9 53 52' - '3A 69 D5 C2 75 B3 9B 9E 7B 73 DE 74 24 98 88 C0 B3 32 CE A2 94 6A E7 BE 58 40 29 D7 F6 AB 08 6A' - '89 0C 43 12 25 21 8F F6 68 A9 64 10 57 B0 6F B5 40 51 AF 46 8B 1A D2 87 27 4E CF 8E A9 62 F9 49' - '07 BF B5 50 87 C0 8B 28 25 FE 5B 06 6C D8 B6 15 90 54 77 34 6D F4 6C 55 E1 1D BE A4 57 69 F8 23' - '45 CC 58 C1 4E C7 64 E1 DE D7 EB F9 D5 4D 74 B9 17 C5 33 D7 42 ED F9 30 AB 9D 2F BF 14 58 B6 7F' - 'A0 13 3D C2 A3 1A 4C EF 29 16 4B 77 E8 20 62 99 55 AA 50 BA DB 67 94 E8 A9 32 9F C0 4D B0 4A 54' - 'F4 0A 35 C6 D6 6D 49 95 33 5D FD B8 EC D4 BC 56 99 97 76 DD 20 B8 7C 60 9F F3 DC 8C A1 00 8A 1D' - '70 AC 97 76 EF F3 34 50 8F 38 4F 4A D7 32 B5 D9 FB 84 7A F7 C7 AA EC F8 17 A5 17 8A E0 9B BE EC' - '5B 7E 28 A3 B1 39 B4 C5 5A 6D E3 5A 24 D5 33 3A 93 73 CD 0D A5 04 A9 CB AD 73 93 4B 81 A9 ED AF' - '8A 2B 92 A5 88 4D F9 2A 55 6C C9 36 3D 3B 81 EC 91 67 A0 FB A0 13 7B 7B 9F A5 B0 9A 60 BB 0C 29' - '0B F6 11 AC 43 5D C8 CE FA F5 C8 F4 BC E7 4D 75 CF 7E 9B 5E 59 C7 08 54 80 F2 69 C9 0D 45 9A 74' - '44 DE 8E C4 50 48 1C 95 1C 50 F1 B4 1D 74 D1 CB 92 0D 0F 6C F1 37 27 47 6E F2 1E 19 21 CD AF 66' - '93 5E CA 39 E4 94 B5 4D AF 07 47 77 AF 71 A8 FC 06 A3 5F 1C D7 68 1E B0 CF 87 6C BA 62 DB 7C CA' - 'CF A1 B0 E0 6E 74 2D EA F5 A7 BA 53 9D 67 AE 51 45 37 10 DE 90 CC 8C C8 78 24 3E 00 CF 40 EA AC' - 'CF 7F 99 F0 2A 72 3E 14 11 20 85 CA 63 1D 58 F3 1D B5 D5 D8 38 BF E4 78 71 79 E9 3A E1 B6 7D 9B' - 'DE 8D EF 93 D2 58 F5 91 0F 33 54 DA A3 6F CB 9E FC F7 A3 B5 6D 48 F2 2C 60 63 39 32 74 5A 2C 4E' - '17 44 AA AA A9 4D 17 CD 30 15 23 12 0B CF 32 A0 B0 70 D3 8A AA BA 6E 52 0B 02 FF 0F 42 E6 19 11' - '82 38 64 A4 8B 86 54 06 CB 25 70 C2 89 06 DA A9 30 02 C2 C9 25 48 B9 95 01 A5 56 D9 02 5A DB 62' - '31 62 31 CA DD 5D C8 6C 68 DD E3 87 39 17 0A 28 C0 5A 20 89 0A AA 21 55 44 15 08 B2 41 60 73 0C' - '90 0C 0A 30 82 C5 8C 55 59 24 06 3A 69 61 68 83 01 7F A6 CA 45 92 1A 44 05 5D 10 0C A0 63 54 25' - 'E3 10 92 58 22 A1 E9 7B AE FF AD D5 F9 47 A4 EF 3D 17 BC F2 59 F0 2B 9E 42 75 B9 53 CB A9 64 62' - 'F5 92 95 91 3B 59 EB 62 62 EE C2 16 41 56 03 03 5D 6A 4B 05 67 6D D9 BD D3 13 6D F5 B2 6A 66 07' - '97 F3 1E B7 EE BE 47 63 B3 DD FB 5E DB F7 56 7D 87 63 CD 76 E6 9F 77 7D 48 1C 9E D3 D8 EB D1 4A' - 'CC 75 CA 56 11 7B 29 4A C8 4C 76 6A 01 A3 24 0C 49 D8 F6 3D 7E 9F 99 EB EB F6 7E 7B B1 C8 F6 5E' - '82 55 78 D5 D2 D8 58 90 82 B0 8A 3C 95 ED AA B9 62 50 2C C7 5A 8B 24 30 24 09 4A 24 05 05 4F 9B' - 'EE 7B AF 73 ED 3F 9D E2 7B DE B7 79 DE 77 B7 F9 3E 2C BF 20 5D F4 FA 89 D6 EA DC B8 AC 83 7D 6A' - '2E 4E DA AA 20 79 7E 5D 4F 0F ED 3D 96 BF 7E 7D F7 B1 F5 5F 77 CF 34 87 97 A3 A4 72 E5 59 30 A2' - '2E 5F 40 DC 6C 89 83 74 CA 8B 98 E3 16 34 68 C1 8C 65 6D 10 B0 68 AD 18 95 8B 55 0C 60 C4 46 22' - '2E 82 96 22 61 28 C1 5A A9 29 45 40 A4 98 F7 5D FE 6F 02 B2 73 63 47 2B 87 4C 5D 94 28 8B D6 59' - '0D C6 2D EF 4A 13 49 42 C0 B6 D2 2D DE B5 06 DF 44 24 83 68 EF A9 1C CB 2D 55 BD DD DD E2 96 A4' - '8A DE B3 7B 1D 78 3E 6F F0 3F 7F F6 5D 9F B8 BF D9 9B 40 3A 6B BF 2B 0E 7E B7 2A 03 A8 98 62 86' - '69 40 F9 5E DB 97 B7 4E E5 F5 9F 1F EF 3B AC 7D 2A 27 C1 EE 7F B5 D1 98 89 20 F5 9E DB A8 E2 4E' - '44 19 0C 2A 1D 58 AA 45 54 54 8A 46 25 B0 A9 8D 95 8A A2 AA 8B 1C F8 FB B1 15 55 45 04 82 A1 08' - '60 95 59 B8 D5 35 A5 CA 9D 7A A9 88 00 C1 00 4C 5E 71 8B 65 09 8B A8 23 0B 49 50 60 B0 46 16 83' - '65 81 68 D1 65 2B 28 A2 2B 15 88 2D 72 B8 C4 B6 84 A5 A6 4C C0 86 2D 2A 34 4A 0D 65 80 8C 50 88' - '82 08 65 8C 62 5B 48 A0 11 19 11 0A A8 05 64 16 02 82 C9 92 C4 84 51 45 90 48 88 88 17 59 93 A3' - 'F4 9D 90 EC 58 C3 04 03 A1 1D 2A 57 BA D5 E2 D3 FB 37 F5 3C 65 63 3C AC 1D 85 A5 D7 DD 9B 8B C7' - '75 BD A5 4F 90 2F 19 D8 CE F6 0F 09 E7 BC 63 9E 79 E7 8A 2F 33 EA FD DF AD D3 FA F3 7E C8 BB DF' - '37 BE A3 E9 B1 7D 85 69 52 A1 3E 08 1F A9 26 4C 97 F5 5A 30 7D 29 49 C2 14 A4 29 4A 52 CB 3B 52' - 'E6 65 FD D2 8F C5 D5 D7 D7 DB C7 BC C6 1C 7E 3E 4A FE CF 0E 7B 27 29 74 C8 94 AD CA D9 E4 C1 D3' - 'C1 F7 A5 78 53 13 BB C3 DF E6 EF CD EB 2D FA B7 FB 87 FD 73 FD AB FC 39 3D 95 6E 70 FB 8E F7 AE' - 'E8 FC 8F 4F D8 79 DE 07 B8 FA FE DB F7 3B 6F C8 FA 3D 2D 8B 5E 9E D7 3B 9D AC 4E F3 BD FF 55 D5' - '7A 61 69 F8 D7 F7 AF F4 D3 BE 3E 57 23 3D D2 88 5C 8E 87 43 A0 C8 BA 1D 0E 86 3E 7F 3F 9E B7 BE' - '17 43 D5 78 7D B7 7D E0 77 FF 5D E0 78 47 CD 92 77 0F 75 E8 DA 87 CE 3D D3 2D 92 65 A3 35 0F 0F' - 'BD AB 45 09 F5 7D FF 83 F5 4F A1 C9 02 1C C8 6A 30 9F F1 F7 DE DF E4 9F 27 CD D7 B0 D6 40 86 C9' - 'E9 78 AB 2D 96 C2 C7 CC 54 26 78 FC 2D BD F9 90 D5 90 DB 7A 09 63 24 EB 33 0C 02 99 4C 09 68 42' - 'D2 4E C5 D4 8F 35 10 F3 59 D3 4C FE A3 F3 3E F3 F3 FE F7 DD FB F8 7A BE EB BA F5 3D 5F D2 7F 23' - 'DE ED DD CF C7 D8 09 9D 00 36 86 41 CE D2 67 31 48 69 B9 7D 3E D7 BF 67 7A 8E 8B 84 D0 72 DA 0F' - '71 CB EC 9E 8B 51 CF F3 BC EE D5 E9 FA 76 D6 9E A5 2F B2 57 60 1F AD 61 F2 87 F3 71 B6 52 77 04' - '8A DB 02 CF C1 89 DD BF 31 86 68 DC 9B 99 7E 8B AF B3 F2 FC 27 3A 4F FA 7F 93 4E A5 7D 83 9B 29' - '5E 07 13 85 C1 E1 69 D8 CD B0 58 FE F7 B3 3B 3D 47 3F 3F 3F 3F 3F 3F 3F 3F 69 4F D7 51 5D 5B 70' - '8B 43 9B CE E8 6B 00 21 32 44 80 00 6E FE 8D 67 F9 77 E7 27 27 3C F9 CF 3F DA D8 F4 74 6C BC 35' - '5E 03 19 B8 99 16 E6 E6 A6 7E 4E AF 53 A1 2F 2F CD 96 97 A0 E6 7E F6 F7 14 5F B7 E9 C1 DC FC FB' - '8F 8F BD 59 DD 11 A1 9C EE F4 8C E3 9A 49 6D AD B5 73 8E 09 9A 36 9E A9 93 34 1D 7B 53 36 A4 CA' - '14 28 E0 D4 BC D7 49 C3 B8 58 58 46 38 F8 58 5A AA 33 A6 3C 5E 2F 17 88 CD ED B9 6B 4B 82 85 8A' - '22 44 6A C0 D5 7D 49 8A 9E C9 D7 98 67 70 DB B8 C5 49 8C 33 08 6C 58 77 58 42 86 0B B7 50 C7 D1' - '7A 96 14 25 98 F9 37 F7 A7 71 30 0E E2 E1 5B 87 85 0C 25 D7 A1 1A 4E 99 AB 46 8F 13 6A 66 A4 67' - 'A7 1B 51 E0 AC 10 A0 CB 60 E9 DB D8 90 E2 69 2F D1 5C B1 6A B5 AB 97 08 2A FD 58 AD 96 3D 5E DD' - 'B3 D7 E2 BF 6C D9 DB B1 60 46 7D 1A 00 AF 5E BD 84 2C 48 91 A3 45 7E 41 E1 10 08 10 72 55 CE FF' - 'DA 74 23 AB 86 9A 85 55 4A 6B 7E BD F6 C4 F2 CA DF A7 75 E9 EE AB 24 4A 6B E3 A8 FA B9 DE AE 1F' - '2F 75 9D EC 60 25 75 7D 2D BB 4D F4 72 5A 99 96 E0 87 71 9F 5B C5 DC F2 79 7F 6A 95 2A ED 11 92' - '3D C3 1E 7F EB E3 17 64 62 57 A9 2A FD FB ED 04 28 50 58 BE A5 41 CE 78 F2 9C A7 93 27 A6 4D C3' - '97 39 19 39 2D AB 31 E6 CF 4C 9E 66 CD 99 53 E7 B1 BB 45 AD A1 42 84 D1 5A B5 67 AB A1 5C AC B0' - '33 75 06 04 10 97 2D 5C 78 A1 B2 90 60 C1 5C B9 74 18 2C 18 61 E9 63 40 81 76 C5 8B 86 FA B9 39' - '30 C2 38 71 B6 83 C7 8F 17 2E 5A AA 34 66 B2 24 2D 58 B5 3E 72 78 30 20 E9 B4 D3 EE 3B 8E DF B1' - 'EC 7F AF 77 D9 76 7D CF 5D AE D5 43 81 7E 86 99 29 06 70 89 A5 64 31 12 31 18 8A 44 88 04 75 9A' - 'C0 35 9C 30 08 10 F2 BF 90 04 4D 79 93 6B 1D C3 2D 88 71 ED F0 B7 6C 6D DF 6A FC 5F 17 C7 B6 E8' - '73 B6 5E DE CB DC D9 6C AB BB DB 7D 9F 23 8D B3 F7 FD E2 55 3F 07 CF B8 F9 FE 3B 0D 97 53 A9 EF' - 'D0 AD 5B 35 2F 55 A7 57 9B D2 E6 73 52 BF A5 99 E8 CB F2 3A 13 C4 7A 60 10 FA F5 84 35 84 40 22' - '44 03 47 11 6B 0C BD 96 93 19 9B EE 6D 26 FD 4A 43 6D E6 30 60 D0 FD 3E 67 4F CA F8 0F 61 D1 74' - '5C D6 C3 AF F0 79 CD 36 D9 4C B2 D4 A1 4B 55 7E DC 7F 63 8B AD F4 F6 0A 7D BF 5B 61 EE D9 DA 6C' - 'EB AC 0E 78 3B F4 69 39 7C B9 6E 3F 1A 5B 91 CD F8 36 FF 2E 87 DD F7 4C DD DD 5D E5 F8 3E FC 2A' - '74 A2 F6 4B 74 E0 75 66 BA DC 1E 07 2F BB DD 50 7C B9 FE FF 7F 84 F2 3C 7B A8 F7 F6 49 49 DE FE' - 'EA 3A 3D 14 C4 AA CB 14 ED C0 A4 30 96 96 82 97 F2 40 17 57 B2 F4 E0 28 9D 58 E2 44 17 63 EB AB' - '1D E9 3B 6E 67 F2 73 79 9D A7 47 AD E8 50 E6 64 EA 31 E4 EA 3B 9E E7 E7 7F 17 73 DC F7 1A 3B FF' - 'F7 F6 FD E7 3B BC 5A E1 7A 1A 69 8A 6A 5A 69 62 34 99 20 00 07 8C 00 08 F9 5D CA C3 BE FC C9 C2' - '47 E8 B8 9C A9 BF E3 EF E4 7E 12 9C 8E B5 A5 A5 A7 D9 73 61 5D BF 9F 29 BF F6 BC F7 47 D5 6A F7' - '1D CB E1 49 CB 5C F7 81 2B E6 F3 CF 04 91 64 34 F9 EA 49 26 10 0C 63 C4 68 77 1F 2F 37 EC FB 3C' - '9E 3C DA AC 96 AD 9B C7 70 A6 16 82 95 29 17 E6 BE 62 95 D4 67 51 9D 57 D7 57 CE 33 9E 81 43 01' - 'A6 93 A7 6F 1F C3 10 41 3A 5D 2E 7F 3D BB 76 E0 BC 7B 7F 71 5E 6E 96 A7 B3 4D 4D 2D 2D 41 40 9D' - '4A 85 2A 58 77 EA EA FA 9D 4A BA B9 8E 7F 3D 32 F6 0C 01 06 65 7B 16 0C 58 CE CE B2 9B AE AE AE' - 'AE 74 EE 86 86 86 8A 8F AF E2 2E 10 41 04 12 04 15 99 B9 B7 17 15 B5 B7 17 15 F5 FD A2 04 08 01' - 'DA ED 4B F7 76 7E 59 00 3B 84 64 F7 C9 0C DE 6F 2C 01 2E AA C2 44 4F A2 A8 EA 96 CB 6C B6 CC DE' - '29 86 5E 0A 85 7C 0D 6E 42 E4 24 D9 FB E6 49 30 84 0F 80 F0 C8 69 24 D8 E3 E7 4E ED 36 ED 4F DD' - '5C 24 70 5A 24 92 F5 55 B5 F3 8C 74 51 E0 55 41 47 7A 8D 80 4C 83 04 C8 30 33 1E 33 13 A1 C8 98' - '23 61 B1 82 A8 ED F5 35 3A 47 09 5D 30 46 66 C6 86 35 4C 10 FC CC 8D C4 BC D1 05 EA 8F 37 85 BF' - '1B 28 F1 F8 B3 CD E4 D5 4E FC E5 3C F7 CF 76 D8 B5 8B 70 F1 A0 8C 58 07 5B 6E 2E 07 75 E1 50 6A' - '91 66 E3 39 9E 18 62 EA DC 52 50 5A 15 54 0B 29 90 B4 26 39 B1 9C 61 22 C9 CC C8 1C 71 EA 7D E6' - '00 34 41 78 77 4D D9 0A 10 A4 B7 18 C5 91 65 21 2D 91 64 A6 B8 C5 86 58 4E 10 39 72 E5 57 09 87' - 'A1 A7 A9 4D 1D 24 09 F8 DE 15 49 C2 0F 35 0B 3A 10 B4 2D 87 4A AA 35 41 84 87 49 B6 C1 C2 71 75' - '29 59 26 EC 3E CB E7 3A DE 6B ED FE 37 DA FD EF C4 F1 DD DF B6 FC 7F BA EF BE 2F B8 48 11 AB 83' - '1B 3F BA 39 79 66 FD A7 64 F2 7D 67 57 48 DA 15 BC 2D BA CA CD FA 15 A5 97 DE A9 3F 40 96 D0 C7' - 'CB BA CF 9C D4 E0 A6 E9 16 59 41 44 95 7D 0F 46 E3 95 F7 E8 5F 29 7F 30 F1 E4 D5 47 43 F6 D3 9B' - '95 5B 54 9F B7 D5 4C DF B8 99 54 BD 6E 2E 5D 4D 7D 12 56 A5 29 82 A5 C7 79 DC A0 6C BF AC F0 2A' - 'AB 44 D5 94 18 F6 49 A9 52 E9 67 29 A7 F2 58 55 F9 18 A4 B2 4D DC B9 64 A3 02 CA 2D E5 DB 83 26' - 'D6 DD DA 28 37 81 86 BB 3F 05 B9 D8 77 58 38 7A 18 9A 07 5A 48 58 C7 4F 29 83 16 2C 5E 39 CC 76' - '81 A3 66 79 59 A8 DB A5 4D A7 A8 91 32 77 29 5D A9 77 9F A1 A0 D9 E3 CD 20 30 7F 76 BE 83 39 70' - '05 18 15 52 89 BF F9 2D C3 19 9B C5 0C D3 83 49 67 35 A6 BC 0A 67 3A 6E 54 97 CF E8 68 D5 EF 3E' - '44 66 B0 AE 4A D7 74 F6 D9 78 3C E9 FB AE 05 37 E1 4F EE 5A 4C E8 A6 DF 0B B8 B1 B0 DC 69 7D F3' - '5C CF CF 23 14 A5 3F 2B 87 7E 66 8A 71 CB 97 0E 1B B7 16 14 88 70 69 86 B7 A0 FB DD F6 B0 FE DF' - 'A4 02 84 74 15 D6 7F 27 DF 67 63 4F B1 E5 EF 88 A3 89 35 E6 EB 3F DA 12 EF 3F 30 FF 9F 04 8C 79' - 'B3 81 0E AB CE F4 5E D9 5F FA 33 BD CA AE 5E C9 2A 1D 7B D3 E9 BF B6 55 A3 E2 FB F4 79 6E 77 96' - '8F 2B DC 74 F4 D5 DB 57 91 D1 3E 82 E3 E7 BB 83 3D 51 FB E6 9E 69 75 05 DC 12 CB DD 96 3D 32 1D' - 'B9 0F E9 FC 4D FA 3B 22 4D 82 9C 09 49 95 11 96 F8 3E D5 B0 08 A3 89 78 7E DB F6 BE 07 97 E5 F9' - '76 CF FC 03 5D 19 A9 15 9C 45 20 41 28 BE DC A4 F0 7E B6 C9 6C D2 B6 0B E1 21 71 0B F4 3B 79 78' - '7E BD 5C 25 85 3B 35 FC DA 70 4D FA 44 43 CC AF 5F FF BB A8 67 BB A0 59 CB 3A 6C CF 08 F7 9E 26' - 'D3 BE E1 4A 06 F2 3B FE F7 ED 74 FF 9F EA 7F 8F D1 F8 9E 3F BB F3 BE CF C7 F2 3E 7F BB F8 DE E7' - 'EA F2 3E C7 42 1A 02 20 F9 A4 7C 02 75 1C B2 F2 E5 C4 68 88 50 3A 92 49 D5 1A A2 A7 50 5E 7F 9F' - '7E 39 51 39 47 9E 78 1E 32 A0 31 10 44 19 06 42 21 10 2F F4 F3 D4 9B A3 CA 19 55 11 05 BE 4B D9' - '54 74 87 9F 33 00 74 C5 BC 70 3C 03 5C 5B CC EF A6 3D 14 B4 4E A0 76 4A 03 8C 1F 0A 2C 71 8B 85' - '7E 48 F7 5C 68 16 4A D2 85 55 B5 33 60 DE 23 58 5A 9D E9 33 E9 56 5B E2 86 30 9A 10 24 2B 51 EA' - 'B5 99 E6 C1 1A 1F 15 77 7D 75 30 80 ED DC E4 16 30 DE 59 55 0B 34 77 55 EB 65 24 7B 4F 26 7B E6' - '38 25 8C 4F A2 50 40 E9 55 46 22 16 70 F0 1F 2D 66 F8 26 B2 B3 7D 7A 71 2A BF 2A 1A 22 4B 9A C4' - 'E5 28 8C 6D 89 01 80 C6 35 28 1A 98 0A 09 04 9F D1 23 08 9E 9A 2E C4 6C 67 80 A4 09 66 DA AA 20' - '62 E1 09 02 E9 4A 45 BE 27 26 B1 38 84 1B BD 14 CE 4E 2B 9D 3E 67 8F 78 39 6D 35 72 BE 55 B2 9D' - '15 D7 57 96 4B 6C 8A F9 88 31 7A 59 8D CB 12 8B 1D 46 F4 BB 73 54 7D 32 00 C4 FE CA 3D F0 A2 0B' - 'C0 E8 08 63 F7 A1 10 3D 27 A8 B2 1E 86 DC C4 A2 AE A5 A8 B5 95 A9 5A 95 A9 5A 95 A9 5A 95 A9 5A' - '9C 31 0C 61 32 72 6F 0D 9B C1 93 92 FD FE 1F E6 76 1F 9F D7 F0 1A EA DF E7 FD 32 E6 5B 9C 5D A5' - '13 07 05 D6 8E 82 7E 92 0C A8 C2 CC 1E 99 3C 6F 9E 2A 5B FE 75 FA A3 72 E6 CD F5 0D 9B EA 9B 37' - '0F 55 82 E4 88 A2 D1 D5 21 24 86 AD 0F 69 0F 6D 0D 62 1E E2 1E EA 1E F2 1A D4 30 61 D8 EA 57 08' - 'F1 BE AE A6 86 7E 7B 50 A3 C1 7E AB C4 A9 AE 9B 06 66 57 06 17 0F EB 21 05 38 B4 14 2F 16 E0 C4' - '90 E2 74 77 24 A2 33 08 A2 8A 2A AA A3 C5 18 38 97 8B 64 E2 D9 99 9B 96 A5 CF 6F 3F 13 3F 9F DD' - 'FC 1F 65 BC 70 5E 0F 82 CE F1 9A 7D BF 53 EB 4D EB F5 FA FD 7D B7 AE B9 FF BF 36 E6 C7 E1 EB 59' - '4D FF 6E 25 5E DE 7F B5 DD EB FD 3F 4E FA 8A 8E 86 66 67 85 33 C3 AA A9 EC 28 50 71 42 82 EA 14' - '18 51 DB 51 5A A1 45 D5 DE 1D A6 43 1C BB 33 86 8D 1A 35 CE 31 E2 BC 2D 73 C9 1A FA FA F8 C0 38' - '1A A1 9D 1E F4 75 6A D5 AB 4B 85 9A AC F1 7A 1A 12 E5 CB 97 2E 50 B9 72 E5 CB 97 2C 58 B1 62 C5' - '8B 16 2C 58 B1 62 C5 8B 1E 13 18 4C A1 32 C4 4A 22 21 14 88 8B 39 33 21 12 89 A3 9E 26 88 9A 2B' - '32 15 1A 6B 8D 7E 0C 28 70 CF C6 C7 19 7E 4E 42 FC 8D 3F 1B 35 DA 6E E1 07 0F 3C 64 AF 5A 67 C3' - '8F 15 82 C5 63 C9 5C DD 74 31 DC B2 86 E9 D4 21 5E B5 7F A9 A9 02 0C 38 10 A1 C6 88 30 C3 0D 04' - '61 B7 60 7D 44 40 22 44 89 10 37 04 7E 72 3F F0 44 00 08 80 46 2C 9E 0D 54 86 6B F3 B6 52 94 28' - '1D 89 61 96 1E 02 65 34 12 BC 1B B2 33 DA DF F4 A1 DE A4 F5 75 D5 B3 A8 F7 9C 11 7F 8E 2F 0B 0F' - '07 4B 07 07 8D C6 5D C5 A9 CF A8 F1 7C 5C C4 3D 2E 7B 0C 64 DC D9 74 08 32 C1 5F 7B 3B D6 43 81' - '98 A7 AF 9C A6 96 91 75 45 94 07 75 3D 9B 30 92 59 F0 1D 03 59 58 1A C5 B5 B3 53 93 B2 4B 5A DA' - '5A 26 28 9A D5 31 5C E2 D9 D6 D9 D6 F9 D0 93 41 4F 9E 5C 44 4F 41 54 E5 5E 23 37 E2 9E 3C 74 FB' - '60 C3 7A CD 4B 35 3A 82 42 3C 4A AE A0 ED 55 7D 66 29 6B B3 F7 E7 B0 6E 0D 1C 31 88 61 BB 66 D2' - '22 21 47 11 B4 46 F1 1C 44 73 11 D4 47 71 1E 44 7B 10 58 9A B1 1F 44 7E D9 FB 77 EE 1F BF 7E FD' - 'FB F7 EF E2 BC 7B 16 0C 34 69 57 26 74 E9 83 05 8A 95 0E D1 CB B7 42 6A 37 6B A8 3C 99 31 A3 47' - '69 0E 1B 98 AF A1 3F 8B 20 69 23 3E 7D 0A 14 28 51 A2 FF F3 FF BE C7 B1 EC 7B 1E C7 B5 0F 92 F6' - 'BF 0C F8 7F 0D 91 A4 E0 D2 D1 22 15 DC 6A E5 A5 7A 68 33 99 0F 3F DB 51 0E BD 50 8D 10 F3 F5 34' - '8E 19 FB 6E FE 8B FA DC DA F3 F0 F3 F3 8A E3 48 52 44 E1 1A 6A 48 E2 5A 22 07 A2 8C 5D DB AA 38' - 'F5 06 2B EE 33 B6 87 5A 5A 40 E0 FB A0 E4 E9 9D 98 9A A1 8D A1 40 EE DD E8 AA C4 91 40 A0 C6 2A' - 'EA 72 55 AE E8 7D B5 12 A5 9C 5D 86 D3 69 C8 E2 14 A5 DA 4B CD 94 20 55 42 8C 62 EE A7 64 CB 47' - '51 93 B7 79 69 2E 9F 4D 77 5D D3 82 4A 5D 3B D5 07 5D 72 55 0F 72 10 45 E1 A9 6D 21 4F 1C 56 10' - '08 F1 C6 E5 59 C6 2B 30 36 12 0E F4 50 A8 9D 90 E2 EA 32 76 90 5D 75 D9 A9 72 5D 37 1C 4A FB 2A' - '7A D5 07 81 55 19 C7 F5 7F 86 CE 67 66 FA A8 24 A4 6E 2E CB 54 1C 54 1D 75 D4 A0 F0 E8 61 33 9A' - '92 5B 20 89 7C F5 8E 8A 59 02 B1 50 D9 09 AB 03 0E DB 1A 59 0A 8C 95 8A DE 06 2A 02 90 35 60 29' - '3A 2A 88 86 F7 77 5D 40 94 B8 CF 0F 81 25 E1 4E 37 04 94 A7 DA 4B DD 07 65 C6 E8 3A 5A EC CA 8B' - '32 D7 19 BB 11 46 12 0E BB 53 5C 29 4A 2D CE 2F 17 90 34 42 6D 74 6C E0 65 8B 30 D3 77 47 0C C4' - '36 DB 7B DE 91 5C 62 AE 51 6D AA 8E 66 48 0A 8C E1 94 EB C5 9C 59 40 98 A8 AD F0 EB 38 24 92 D2' - 'ED 48 8C 74 DB 4E C2 4E CE D4 BA 48 71 B4 31 19 8C 33 58 CE 21 26 C8 43 56 65 14 14 8C 8F 1B DD' - 'BC 35 20 02 C8 6C CD 82 A8 E1 C6 2D 31 80 2D 97 2E A5 B2 17 65 49 68 0B 24 59 0B 61 0E 12 49 94' - '26 6A B3 55 24 38 40 A3 8A DA 74 B4 8A BA 54 8D F5 C1 21 34 C4 ED B8 0B A7 13 6E 24 A4 D6 94 56' - '21 34 42 52 AA 21 AA 9B 51 5B B5 38 CC 35 E2 82 A5 4A 98 BA 96 85 5F 0D 9C 24 E1 90 59 0B 55 E1' - 'A1 44 DF 84 A5 2E 99 C5 94 A3 C5 0E F5 5B 63 18 A4 24 59 B5 52 C5 13 44 DB 43 10 76 4C 58 5D DD' - '8C 61 03 6D AA 48 B0 E3 8A C2 49 A3 03 8D 77 9D A0 0D 1D 9D 32 3A E9 55 57 4B B4 ED 23 82 71 2A' - '8E 95 DC BB 57 2F 69 DD 5B 9A 42 18 9C 82 92 21 34 31 3B 91 21 44 D2 82 67 0C D1 05 01 64 86 1A' - '19 0D B1 50 2D 46 2B B6 37 BA 1E CD 86 91 A7 54 D0 1B B6 51 12 A4 09 0D 9A 57 13 DA 37 BB 20 E2' - '09 1D 53 45 1A 97 0B 50 2E C6 D4 1C 54 E6 94 46 D1 60 71 00 14 C8 C3 18 AA D5 50 10 89 8D 61 31' - '8E 2C BA 5A 5D 0F 3D DC 7B 4E A3 75 90 BD 9B AF 4B 1A FE 7D 12 66 D7 15 73 E7 DA AF CB D2 97 4B' - '98 EE 71 D3 5B 9A C0 18 26 40 81 31 80 B3 0B 23 73 50 01 B7 5E AB 79 54 5A 0A 75 A7 90 B7 22 60' - '92 07 46 21 B4 55 7B 41 14 63 12 90 34 74 7D B7 4B F5 7E B3 EE 7E 4F BE F8 1E BB E1 6B AB F5 3F' - '1F A7 D5 61 0E A8 C9 3A 70 41 50 84 77 19 AD C1 06 22 ED 3A 9E 43 F7 7B 08 AE A7 4F 45 63 04 CC' - 'C0 02 44 42 86 C0 62 64 14 AA 27 42 61 FC 4F 07 C8 7E EF D1 FD B7 AF ED FF B9 FF 0C E9 EC FD 95' - '1E 2F 99 F4 5F 59 9F 0F C5 EC 76 C0 1D 84 87 5E 24 63 DA 6A DC 27 65 ED 26 31 E8 BE 63 F6 3E 77' - '0E F4 C0 03 74 92 6C 24 52 55 42 99 6D 3B 6F D8 F1 73 A2 49 9E 7A 81 5A 9A D9 46 26 D5 97 0E 8C' - 'CD C9 4C 42 F9 FA FF 8B AA 2B 96 31 25 88 4B 8D CE 31 96 D8 8F B9 7E 75 10 3B 5B 21 AB 09 42 B7' - '48 C2 DD B1 46 AF B5 FA FC 6A C0 98 88 C3 3A 50 6A F7 BE 37 AB F0 7E 61 7F C7 F7 87 95 E7 F4 5D' - '6E 9D C0 AA 2A 49 CE 2A 74 E8 E9 27 4D 98 54 60 65 81 D1 8F 75 F5 5E 2F FD 1F 69 F1 BF 83 BF 49' - '81 CC 90 EF 39 BE 8F DE F9 3F AE FE 86 BB 8C 0D D2 1C B7 F8 5E 47 FB 3F 61 E2 56 B2 1D BA 2C 86' - 'BD D7 E6 BC 4F 17 6F FE 7A 4D 88 74 D2 0C E9 9C 75 F9 AB D6 F7 3F 07 B9 F9 9E 67 9B B2 C2 1B 3E' - '27 45 04 87 91 F2 59 B9 3C 96 4E CE 93 0A 03 36 AA 17 14 55 B5 48 07 2D D5 04 54 34 51 69 09 23' - '4F 11 96 F6 9A 0F B6 FC D1 F4 1F 3D DB 1E 77 B7 54 21 55 57 0D 3A 84 07 D1 4E 87 DB BB 86 A7 CF' - 'DE 73 50 A3 4D D1 5B 12 41 C6 0F 97 74 22 CD 69 D1 8F 34 EA 84 8A 0C 45 1A 46 98 52 F4 6B 5B 22' - '81 E4 F9 7A BE F7 DA FD 3F CC F0 FE 3F E4 5F AA D6 00 74 FA 8F 55 7A D5 21 4C 87 4E 29 8E B6 03' - '03 CB AB A0 1D FF D6 7A EC EF C6 DB 90 DD 92 6E E6 A9 5B 66 97 C5 94 A2 C4 F6 FD 9F D6 6D 4A 84' - 'A5 78 E3 59 21 A8 A9 C2 71 C6 F5 99 B3 27 AE 9A 5E FB D9 00 DD D1 14 77 43 7C CC 41 77 C1 45 AA' - '52 CD 92 A9 36 70 90 76 6A 13 22 B7 50 DB 6D 6F 28 8C 6B 5D 6E 48 61 53 62 86 26 D5 69 2C D5 AD' - 'AA 6C FB EE 93 F6 FF 81 F9 5F ED F3 9F 99 FC DE 97 33 CB 95 01 C9 AA AA 18 4E 92 5A 52 AF 2C 1C' - '83 1A E6 91 E4 CA 4C D5 31 4F C0 EE 7F BD DF 57 F9 5D 3A 36 A2 43 98 66 E8 B2 91 63 45 51 C5 D6' - '10 2B 9D E8 4D 05 78 55 3A 4D 73 1D 06 91 41 B5 B4 96 0D 08 E6 E1 77 42 E6 39 5E BB 62 AE 96 2A' - '04 20 AA 22 49 56 2A 66 DE 2E 36 5F 4F BC B8 73 AB 09 84 26 35 DE 91 55 88 CD F7 A3 47 BB 9F AE' - '18 02 93 6C 24 DF 8A 90 DA B7 B8 4D B8 66 58 1E DF 1B 7B 3F 67 67 1C 51 05 84 37 DA 99 C4 7A 2E' - 'A1 BF 35 4F 1D E4 3B EF 53 F5 1E 27 D4 E9 F0 FE 2F 3F 3F 2E 57 21 D4 A2 88 74 98 47 A9 45 2A 37' - 'A5 66 CA 31 CA AB 95 52 2F CA F4 F7 B7 1B 5C 0D 6B 74 B0 36 60 28 82 86 34 DF 8C 4F FD 7D 06 BA' - '3B 03 0E 1A 42 2C 26 8C 84 57 54 DD 97 A5 43 7F 77 E2 78 41 BE 7C 7F CD D5 78 8F 6B 39 90 B6 D3' - '01 84 41 82 B2 04 05 64 65 62 B0 C2 13 8A D2 0B C7 F2 7D 87 73 FB FB FE 97 E5 73 40 36 64 37 45' - '83 0E 67 9D 3A 19 E6 FF C9 EB F5 24 D9 21 91 88 A5 1A 56 CD BB 27 51 D1 72 92 64 42 5A 29 10 CE' - '2A 68 86 3F 89 F5 FE D1 FC 1F 97 FC AC FD 93 F2 F6 E6 F1 7C DF B9 F3 99 90 E4 F2 42 75 19 0E 55' - '25 A5 C4 DD F8 BE E3 D6 7C F6 82 94 A5 15 8C 14 D8 98 60 E3 FC 7D BD BA DB 18 D5 52 B4 32 44 C6' - '32 1C B7 20 81 8C C6 41 81 69 4D D2 80 CB 09 80 34 8E BA EB AD A0 06 90 60 E1 BD E7 E7 ED 55 F0' - '8C 55 8C 8B 09 80 66 EF 9C FE CB 95 DA 4A 52 AA 4C 60 AB 30 8C 30 6B 77 5B 12 3E 8F 41 AC 01 E4' - '18 2D E8 38 3E 63 97 FB 90 78 60 A0 20 C0 75 DB CB 96 42 17 58 C6 99 80 B2 0E 95 0E E1 0B 48 7E' - 'F7 D3 D6 DB EF BE 21 B3 24 BD 5E AE 83 DB F4 CA 3E 77 F5 5F 33 39 CD C2 BD 45 45 7D 07 B1 F5 AF' - '4F CB A0 AC 15 50 D1 43 60 52 05 09 0F C6 FF 33 E1 7F EF C6 FA 8E DF 4F C9 E3 7E A7 2A 03 9D 31' - 'D7 EE EC 52 1E EB C6 7F 5B CE B4 06 FA 65 1F 3D FF 6E F3 31 94 1F 45 F3 9F 7E 95 5E 24 51 FB 0F' - 'CE 7F 6B C3 DF 54 7B 94 55 7C 6F F4 7E 8F CB FC 1C 1A E8 10 F3 C2 CE AF 57 9B 13 99 85 24 34 D2' - '15 68 61 25 24 2C 8C B6 49 50 6D 21 D3 64 3F 23 D7 EB 60 69 04 0E CA 43 DC FB BF A6 F6 3A 43 20' - '73 09 0F 47 F8 5E CB B5 E9 BE F7 C1 D4 81 BA 82 07 54 E2 88 5F 5F E1 7A AF F7 62 68 C9 9E D6 A4' - '0F B3 F6 BE C2 E1 34 83 24 27 70 92 07 3F 6B 8B 21 D1 EA 7A 36 86 20 1B 32 49 F2 3D B7 D2 FC 2F' - 'C3 D6 1A 04 E6 12 1E DA C9 50 2D 21 DD DC 28 0B 60 7E 2F D1 7E 3F EE 3E C7 F7 3E 5B F5 5F 0F 9A' - '1C DC D0 0F B6 ED 7F 03 DC 7B 4F 3B F8 9F 03 FD 3F F6 EC 73 01 D1 06 07 43 21 44 43 C8 32 C4 85' - 'C8 D3 0B 43 BC 48 7A 86 4A 7A 78 69 10 98 D3 44 2E 19 42 54 3F 4B E5 3C AF A8 CC 34 E2 A7 0C 58' - 'EF 40 70 C8 71 68 51 34 4B 48 63 9F E8 74 86 FC DC FC FB 43 8E 7A E7 64 3E 93 B5 F3 FF 13 DF F4' - '43 48 6E 84 A8 32 6F BE 1B 39 08 49 95 59 CF D1 D1 D2 CC E4 CD D9 BA 12 B7 A8 57 18 2E 43 FA 9F' - 'B2 FF 97 9F FD 1F 8E ED 6B CC 72 A9 39 90 E6 9C E9 53 22 43 A1 C5 D4 04 64 3A 5D 3E 5C B4 D3 42' - '6E 9B A9 86 14 48 61 84 DB 4D B6 E0 CC 9B A1 B1 BD 4A 45 84 DC 65 D6 6C 0B 8E 80 22 A4 19 D7 5D' - '73 32 8E 91 3A 65 55 F5 47 CD 78 2E F6 98 51 A2 63 3C 71 C7 36 BB 1B D4 9C 73 78 77 8C 15 32 32' - '1C E1 CE E7 18 81 AB 09 86 46 D0 31 57 0C 3A 61 28 C2 43 30 40 AB 6A 00 5B 10 64 CB 32 E5 84 D3' - '21 A2 4B 81 4C 25 24 88 32 1A 26 8C 30 90 8A 43 01 4C 9C 3B B0 C0 1A E6 80 B8 71 CD AE B8 32 4D' - 'F7 E2 D6 6E 90 4C DA C8 85 80 24 61 87 2C CA 43 10 DB 6D F7 CC CB 26 88 05 41 03 7D AB 76 65 01' - 'CC 85 40 14 79 DB 64 B3 8E 37 E3 10 DB 7A 84 DB 68 50 41 83 0C 30 2C 48 5C 10 BC 50 01 70 CC 80' - '1D D5 F6 55 C4 16 8D EF 61 58 BB 9D 33 88 A3 AE 1D 2A EB 4B AD 92 D0 37 48 66 18 CD CC A0 6C 86' - '8C 37 60 2C C2 12 6A C4 33 20 15 BC C8 62 28 DE DD 1A 5B 4D 06 A9 55 1A EF BE F6 69 06 63 36 C5' - '40 58 61 C2 58 C0 58 55 E2 E4 0B 6D 2D 45 42 6F A3 33 9D 6E 8A 34 80 E3 19 42 53 6C 6D D1 D2 D2' - 'E8 10 6D 55 09 12 10 62 10 85 F4 3B 8F 2D F2 D1 3F E9 65 FE AF 37 D4 75 BE 03 72 68 F5 FE 63 DE' - 'CF DE 79 5F 4D FF 83 F9 72 FF 13 D8 7F A7 D3 C1 3A D7 E9 69 A7 77 8D 9B C1 6B B2 CE A6 8D 35 B4' - '69 4B BE B2 F8 EA 2C 36 D3 DD 3C 6A 8C AF CE B7 E7 6D A8 4B 9F 6D D6 E3 69 72 3E DB 9A 0C 82 B9' - '8E BC 75 FE 1A 7A D2 75 5A 1C 91 6E 71 95 D4 5E 26 D5 B8 99 CB 25 D2 17 BF 76 AE BB 15 E2 DA 2B' - '4B EE DA 7A DD 35 7D FB D2 6B EE 73 EC 52 C0 4F 74 A2 0E 36 16 6D BB 5B 7B 85 F6 EA CF 56 48 0D' - '59 53 A9 13 AC 2A 94 55 49 72 72 95 A1 6C 12 24 68 1D 63 69 2B 7E BF 4E 1B 33 B9 0A A4 3A 6F E3' - '7B 10 F3 C5 8C 10 8D E3 F2 31 6B 21 02 1D 1D 00 45 46 1B D1 73 A1 B2 D3 88 D1 E6 AB 77 43 AE 78' - '1E A3 D7 FA 82 B4 77 15 BB A7 22 C9 86 F1 D4 18 2F 47 93 08 68 31 9E BC 22 40 85 D1 10 08 01 04' - '21 19 88 24 46 82 34 08 46 60 B3 66 CE 43 30 D9 89 19 98 6D 1A 34 11 A3 41 1A 08 D2 48 91 9A 08' - '18 81 B3 11 98 61 B3 10 40 83 10 41 19 88 27 CA CE 48 8D 02 66 18 82 33 10 41 19 04 CC 30 82 0D' - '8B 26 4C 81 60 C5 88 20 82 C1 8B 20 58 31 62 08 20 82 C9 90 20 B0 64 08 2C 59 31 04 16 2C 59 49' - '60 C9 8B 26 0C 58 B1 64 30 20 B2 05 8B 10 41 19 88 40 84 10 2C 82 08 26 41 04 08 4C 99 02 10 41' - '31 64 08 4C 82 08 10 81 08 70 83 05 90 21 06 18 60 84 18 20 86 10 6C 82 0C 30 D9 32 04 30 C2 08' - '20 83 04 10 42 0C 30 83 0D 90 21 06 18 21 06 C8 20 83 8E 30 C3 34 1B 50 61 C7 90 38 C3 0E 3C 81' - 'C6 1F D0 1C 8B B2 20 00 06 A2 3D 60 00 11 21 23 58 00 04 15 6D F8 41 82 CC 4D 36 62 08 08 6C C6' - '66 37 FB 82 CC 26 20 FA 2B D8 AF 60 BD 6A B5 9A 43 2D 57 A3 A4 36 8E 8A 91 B4 24 8D A4 9F 43 3F' - '3D 42 74 E9 53 A5 49 9D 9B 98 8D 06 66 62 2C B4 12 46 45 97 95 E4 C9 F1 F9 32 32 32 72 0F 9F 3F' - '8A 7F 1B 0F 13 04 EE 1E 16 11 D3 98 18 37 D8 18 06 CD DF 9A BE BD BC BC BC 33 77 76 62 E4 CD C9' - '72 F6 D7 17 05 4B 5C 5A DB 5B 14 2C 56 D0 A9 5B 3B 4B 5A 9B 32 85 09 D9 93 B3 B1 26 4C 9F 83 C2' - '4E CA 38 C3 0D 1C A4 79 11 87 B7 91 1A 31 78 EE 21 41 71 01 CB E7 2D DF 38 D5 15 C0 6D D6 0A E0' - '51 5C 0A E1 C0 A2 B9 15 C8 AE 5C 0A 2B A7 02 B8 15 C8 A2 BA 70 2B 91 45 72 DC 57 02 8A E1 C0 B0' - 'B5 75 75 61 3E 7C FA 13 F7 EF DF BF 81 02 04 18 23 8E 3C 51 C7 1C 79 80 08 00 06 BA F1 46 4C C7' - '0F 81 E7 FF DE D3 73 FB 7A 5E 86 D3 A1 BB 81 9D 52 F9 F8 75 4C EA BC FC 5C FD DA 37 77 7C FE 7D' - '4B BB BC EA F9 6E ED D8 B5 CC E6 E5 DF BF 7F 99 9B 17 51 B1 C7 FE 0F 91 DD FB 6F 07 C6 F8 BD DD' - 'E5 D9 3C 3B AC 3B 43 24 F0 AC F0 0C CE 59 DA 98 EF 1C B4 38 62 E6 CE FE FE CC C5 99 A3 26 0A 1A' - '35 68 64 CD 99 A3 46 6D 49 98 35 73 62 6A E4 D5 8D C9 A9 06 24 5F 8E 6C C9 83 63 DB 97 39 7E 5E' - '4C 83 06 CC 9B 8B 0E F0 DD 8E 62 BC 0A EC 88 07 0D E3 3E C2 C1 18 FB EB 9F 22 FC 91 4F 49 4E 2C' - '7C 94 08 DE F9 23 E6 32 53 8B 17 33 35 DC 4C D7 49 86 88 9D E4 47 43 68 43 19 E2 A5 8B C4 88 F4' - '66 3A 0F 19 2A 6F 0C 31 9A 3C 68 34 58 82 B6 19 BC 41 9F 8C EE 04 68 70 A0 BF 7E 34 77 E3 42 91' - '1A 30 E3 8C 38 C3 8E 38 FC C0 00 F4 88 80 40 89 10 00 0F 48 F7 6C 49 E5 A8 BC 54 91 42 07 D2 26' - '31 59 45 41 9E 15 E8 17 21 A2 29 86 16 90 B5 4A 42 1A 67 42 D8 84 C3 2E E6 2C C0 80 53 86 16 32' - '4C 18 C5 DA 49 94 31 8A 32 C9 2D 94 DD 66 C9 2F 16 58 B0 94 CC 21 0C 55 04 59 25 63 16 5D E2 E4' - '98 42 65 99 BA 2B 14 49 77 41 0C 30 BB CD AC 99 49 0C 33 08 18 41 4C 92 4C 62 B9 58 13 16 CC 92' - '1B A3 AA E6 B7 3E 7F 5F E8 3F D6 F9 EA BB AD F3 47 A2 E3 FA 1E 87 95 E7 3C 5F 01 EB 7E 97 CB D9' - 'D8 17 F5 3A 38 39 5B FE 97 63 71 DF EA CB 70 0E 73 BE 03 FF 1F 2A B6 80 9D 67 C9 FA 7C 38 B4 9B' - '7D FF 43 B9 F6 4F F9 27 FB FD C3 9F C1 2C 89 59 FA F2 B2 9B C9 C3 7C BE 6C 68 F6 D3 1D B9 63 98' - 'F3 5D 2A 2E E2 1B 8E F7 12 CF B5 63 55 97 6D D0 EC 17 35 D4 B0 2A 6A 98 B7 8A C3 A7 75 35 91 41' - '51 73 6E 7C E5 3F CD E6 79 2F 9F A7 EE BD DF D4 EE FE 2E B3 57 D3 7C 5E 9F EE 6B 39 40 F0 AC 26' - '8D F3 DB 65 30 C9 BD B0 A9 96 65 21 B8 ED DB 5F C7 DD C1 DF D3 D1 F4 70 3F 3B FD C5 F1 AB DB CB' - 'BB BA 5B BB A3 25 E9 8B EC 7E 4E 9E E7 0B 71 F8 5C 6E 8A FD 1F B7 83 61 57 48 6B 71 3D B3 F7 B6' - 'FB C9 BF C6 FF AA EA 3D 7F AD F6 BE D3 F4 FD 8F 67 D9 74 78 DA 75 EF 7C DE EF DA 79 3C EF 99 F3' - '3B AF 95 CC A0 29 03 14 23 11 06 28 82 F1 3D 81 BD 5F 1F 8D 33 7E 2C 0D 33 26 4B F8 B7 E3 BD C4' - 'DC 1C 6E 4C 8A 5C AE 0E 4F 27 95 56 95 29 F4 EA 53 A9 83 95 66 C7 15 9D 16 76 6E 72 38 37 F7 B9' - '1C 1C 1C 1C 09 8A 83 37 5D FE C2 0A 04 BB FE 58 46 00 B2 45 21 04 60 0C 40 02 1B 6D 8F BF AD FF' - 'AF 73 E0 DA FA BB 16 33 A8 69 92 7E E8 F1 6A 78 A6 37 F3 12 AB 2A D1 D7 96 EA 54 2A 6A B2 5E F4' - 'FF 6D 1C BD 65 DE 45 FC F5 7D 82 AB FC EF 0D BF 5E 8B 49 9F 32 F6 90 FD DA 7B 0B B4 7D F4 15 44' - 'AF 6F FB B5 FD 9B 5B 50 6F 6D 4D A7 C6 B3 C1 57 AB 21 AC 10 83 77 7B DB 54 B6 E9 7E 52 F4 17 C7' - '6E B0 EF 72 FC 66 D5 5D E4 E4 B5 C3 C7 44 C1 82 F4 41 C3 09 E4 56 AD 9F A7 4C 85 CE 6E 9D 45 81' - '33 C7 ED F0 0D 93 29 92 EA 13 77 EF 9E 0A EE 24 41 62 43 81 0A 0C 78 EA 54 FA 86 08 90 20 05 5C' - 'D6 D3 81 B5 E0 12 9A D8 6C 7E 1F D6 AA 6B 6D C2 25 37 F0 6F F6 BF 0B 26 8D 1B 36 6C D9 B3 66 AF' - '9F 3E 7D AB AB AB 26 24 48 90 A1 C4 89 10 71 C7 1C 71 C7 E4 52 9A B3 E3 D1 F2 29 3F 8A 4E 3F F1' - 'D7 E5 75 F9 54 77 76 47 EF 25 78 BB DF D7 F5 E2 F0 38 7D 5A B3 96 F3 5D B3 97 1D 7F 0E 11 8A 72' - '67 6E AA 6D 0E DD D5 DA 9D BC ED 5A D6 15 EE 15 EF 16 EF 15 AE 2D 5E 58 ED EF 82 DC E9 AB 1A FB' - '04 8F DF BF 1A A4 64 E3 A8 6C C6 D0 A9 5B 52 A1 62 8A 28 87 51 3B D4 D4 D4 BA 35 88 93 41 6A D5' - 'AB 56 AD 5A 70 D2 D5 CF B0 B1 1E B5 C4 C6 D5 6D 05 E8 AE DE C1 16 04 18 30 20 41 1C 71 C7 89 16' - '14 38 71 62 44 8A 38 E3 8E 38 EC 9B BE 6C 2C 98 31 1D 3F 93 15 E3 F9 11 75 61 3C 7A F6 13 F9 31' - 'E2 47 1C 68 F2 47 1C 61 E3 8E 38 E3 F9 40 79 44 40 00 00 00 EB 11 02 60 89 00 00 DD CA 4A 4A 4A' - '4A 4A 4A 4A 4A 4A 4A 4A 4A 4A 4A 72 79 3C C9 69 6E 47 02 5E 5F 8F C7 E3 F1 38 BD 0E 87 16 5A 5B' - '8F 2D 2D 31 31 31 31 31 31 2D B3 DA 7B BB 4D A4 D4 EC EC EC EF C7 3B 43 43 FD A8 68 78 BC 4E 27' - '13 87 C3 E1 F0 B8 93 FF 6C A7 DB BC 32 63 F4 55 72 5C BA BB 8B 56 AB 6C D9 B5 B3 27 E1 AE F0 93' - '27 65 65 A7 31 E0 B1 B1 19 90 D2 46 A3 92 34 91 A4 B8 A7 92 33 AF 15 55 00 CE 68 A8 A8 E9 24 F9' - '3C 94 E3 54 65 8C 81 02 04 08 10 42 42 81 0A 11 51 22 89 06 1A 28 43 25 CD 4A 95 28 D0 D3 45 8F' - '1A FE FE 32 88 E7 30 24 8C 38 E9 56 AD C5 C6 CF D2 D0 D0 C8 D0 55 A3 DD 00 0A 72 20 10 59 E9 7F' - '3D FE F7 79 E9 7B 7E E7 E1 CF D7 48 8B 09 F8 B9 8E 5B 69 EB BA 3C CF 67 91 C6 FD 66 B9 DB 7F 8A' - '70 79 31 E2 C3 83 9F AA F5 DE CE 6D C4 D7 F7 FE F3 1D 5E A4 B7 E3 B9 DC EF 7F 6A 4E AC D7 44 69' - '32 23 C6 8B 12 1C 28 3F 9E F7 8D 51 4D D8 A6 E0 D3 76 29 67 3A DC 9E 3F 20 97 27 93 2F DE 1C 71' - 'C7 1C 71 C7 1C 71 FA 79 79 71 E3 E5 48 91 22 44 81 04 75 AA D5 A8 41 67 B9 73 45 A5 A5 A5 1A 33' - 'D7 AF 5E DF 5F 65 9A 43 7C 6A F7 C8 84 E2 0C 04 A8 52 A4 CD 3A 75 0E 6A 34 98 F9 B0 A1 42 BD C7' - '49 8D 8C 93 11 16 26 2E 66 12 3C CC EC E4 28 10 20 40 81 02 54 19 28 52 BF 87 16 34 6C D4 68 F3' - '73 52 B9 CE 20 06 F0 02 24 08 34 68 D1 A3 16 2C 58 88 20 8C C4 68 D3 FD 7A BD 5E 37 1B 91 C7 E4' - 'F2 7F F1 CC 18 30 E1 C3 86 28 AF 5E C2 85 0A 0C 28 70 E1 C6 8D 1B 6D 43 45 39 39 41 41 3D 3D 45' - '45 49 49 51 51 53 53 53 53 53 53 22 41 22 5F 8F E5 F9 6F 7A 7D 3E 9D 09 2A 19 14 34 53 F5 35 74' - 'F4 F4 34 35 75 75 75 49 AB 6B 53 1B 39 72 82 B1 7A 7A E1 58 5D 98 CB 16 E9 00 AC 6D 2F 4A 22 15' - '95 FA 34 80 84 95 E8 47 53 3D 4E F4 3C 6C F7 AA 5E B3 C8 D1 7B A4 F4 4C A5 4E 9A 32 7C 8A 36 47' - '8C E2 18 E8 B0 90 40 89 89 A2 26 61 E1 15 24 11 5F 8C 45 89 B2 D3 20 4C 0A 28 A9 D1 A7 CC 11 32' - '55 09 53 A9 52 1B 76 6D E2 BE D3 8E EA 43 69 0F 24 42 74 2C 88 6D 5E B6 6B 18 30 08 01 FF E2 EE' - '48 A7 0A 12 01 3D 19 B3 E0' -} +/**************************************************************************************************** + + + ..\..\jcl\source\common\JclUnicodeBzip2.rc + + + Produced by UDExtract written by Dipl. Ing. Mike Lischke, public@lischke-online.de + + +****************************************************************************************************/ + + +LANGUAGE 0,0 CATEGORIES UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE +{ + '42 5A 68 39 31 41 59 26 53 59 D6 39 5D 66 00 0B 86 FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF' + 'FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF E0 48 6B A8 6A AF 8E 3C A8 22 84 8A 8A' + '22 A0 01 10 80 82 04 08 A8 80 90 14 05 01 09 21 40 55 14 22 A8 0F 1E 00 6E 01 40 0A 28 14 E8 25' + '2A 35 C3 DF 6F A3 A0 C8 3A 35 D9 2C AB A3 BB 14 49 D6 73 36 9A 1B B2 C6 E6 CF A5 9B B0 6A A2 4D' + '55 00 19 BD C0 D0 01 76 A3 A1 9B 02 49 CC 5A D8 00 00 00 1D 74 00 00 1C 00 69 E9 EB AF 50 00 1C' + 'EB 4E 5B 40 74 E4 68 34 EB 56 3A 96 B0 6A 6D 48 82 68 26 26 9A 09 82 69 93 4D 3D 4C 4C 4C D0 13' + '26 06 82 1E 8C 8D 03 53 D2 A7 E9 80 13 D2 60 99 31 A6 80 F4 9A 6A 9E 08 C9 80 11 B4 26 1A 06 82' + '66 46 86 88 D3 46 1A 19 1A 11 E8 34 8D A3 46 A7 A6 64 D2 1A A8 24 A4 91 34 64 F3 18 4D 00 40 4D' + '06 89 84 D1 34 CA 4F D1 4D 1A 68 69 EA 00 00 00 00 F5 00 34 1A 0D A8 F4 40 7A 80 1A 00 00 00 D0' + '00 00 00 00 00 68 00 0D 03 40 D0 04 95 20 D1 98 04 4D 01 34 D3 40 08 69 A1 3D 04 68 99 1A 9E 90' + '00 C8 03 40 19 00 00 00 00 34 03 40 00 00 00 00 00 00 00 00 00 00 00 03 08 00 92 12 12 34 68 20' + '10 3D 11 E8 13 06 93 4D 27 E8 D4 A7 ED 27 9A 09 A9 E8 98 C9 29 BD A9 95 3F D0 68 2A 7F 94 44 D8' + '32 93 26 7A 93 D3 18 8D 1A A6 8D 0F D5 0D EA 7A A3 D4 3F 53 D4 4F 28 6F 52 7E 7A A5 1E A6 80 F5' + '3F 52 69 91 EA 37 A9 1E A3 C9 1E A3 4F 53 F5 40 69 A7 EA 87 EA 6A 7A 65 01 0A 94 4D 08 D1 28 F6' + 'A6 A7 E2 A3 F5 3C 4A 6F 4A 33 6A 69 31 E9 A6 A9 8D 47 A3 D2 87 B4 44 F2 9E D5 3D 43 D2 7A 4D B4' + 'A6 87 A6 44 D9 4F 53 D4 07 EA 9B 19 53 D4 F5 01 ED 23 D5 1F AA 06 9F A4 43 C9 3D 11 BD 49 E9 A9' + '9E A9 EA 68 1E A7 E8 69 4F 49 EA 6F 54 34 3F 4A 36 A6 86 83 D4 7A 9E 93 64 9E A3 D4 7A 08 24 94' + '0A 68 02 69 A6 89 98 46 86 9E A0 D3 53 4D 1A 6D 49 BD 1A 6A 6D 43 D4 F5 1E A6 6A 9B 29 B2 26 C1' + '4D E9 1E 83 21 B4 10 8D 0D A6 A9 EA 7E A8 7A 6A 78 D0 A0 F6 94 F4 3D 46 93 D4 FD 26 9A 9F A9 B5' + '32 99 3D 32 6A 36 6A 9F 95 3D 23 66 89 A9 A7 A4 7A 35 33 53 C8 9A 62 03 34 F5 46 AD 5F 58 68 D1' + '68 D1 43 BD 50 A2 AA 76 BB BD FB 02 0A E6 E1 FA 01 0B 67 A7 8F EF F8 F8 7E 4F 1B DD AC 7B 9E DC' + '46 61 F6 21 2B 57 C3 D7 66 E3 E4 2F 7F AD 67 AD FF C7 9F 47 A5 ED 79 9B D7 E3 5D 0C C9 76 D1 F7' + 'BC 9B CC F5 DF 65 EB 76 1F EC 77 49 DA 81 92 8D 92 62 66 F8 EB FF 9A 24 E3 83 2B 59 AC 2D 64 99' + 'B2 CB 39 EE C1 6C CA A3 E6 21 8A 8D E7 91 35 B4 E4 EA CF CF EB 5D CF CB F3 52 1D 2C 77 5A 8C 5B' + '4B 37 FD C8 B9 79 E3 DC CE 33 BA BC 45 D8 FC 6C C9 9E 29 8F BE AA F0 37 A5 1E 6B 90 CB A3 8A 09' + 'F5 CA 56 63 40 5D 8D 5F 32 78 D7 B3 B3 5E 5E 0C 4A F5 9A FA 63 4F 7F 17 F2 20 C0 92 B7 6C 19 E7' + '5B 02 87 B1 69 B0 94 A5 29 98 EE D4 C5 AC 3C CC 61 93 3C F3 48 99 91 F1 32 C6 CA 60 EF 13 EC D6' + 'D6 24 C1 2A 18 DB F9 96 EE 5A 69 79 39 AB CB 46 D9 B6 05 83 6E 4E 15 38 8B 3D C9 DC 0F 8E 36 FC' + '19 CA 76 3D 8F 86 77 83 37 88 E4 BC 55 49 47 09 59 C3 A8 E1 AA 92 EF 0E 1D 9F C1 24 8E 26 3C 1A' + '1B 6A 75 02 1E C4 0E 9E B2 CB 20 85 91 A8 E8 55 ED 10 9F 30 7F 96 FB AC C3 E0 B6 21 67 5B CC 2E' + '2F 95 4E 57 19 C4 5B E8 16 26 EF 6F 96 C9 B6 AB 31 A1 FD 61 EE F5 DD 02 B5 87 A3 42 FD 7B A8 56' + '16 E7 80 A6 97 EC 33 42 E5 D7 5A 7A 41 32 DA CB 03 44 48 92 81 41 2C 8A AD A9 AC 1D 6D AB 41 2E' + '1C 3E 8E 52 D0 58 0D 75 32 5C E7 B6 5B A7 B8 BB 53 79 80 8A C8 29 F2 0D 8E 60 6D 57 9F F7 B4 94' + 'C8 88 1E 78 B2 E1 78 A7 EF 9B EC B5 91 49 E8 6D 8A EC 2C 58 A7 04 D3 15 DE 99 2A 0E E2 CA 1D BA' + '57 26 CD FF 56 DF C7 4D EA EC C4 DE 3D A8 ED 3E 8A BF F4 AF E8 20 6C 67 A7 AA B9 C6 67 D2 81 3C' + 'D5 73 48 95 66 FF EB AA E8 0F CA F5 2C 27 5C ED 32 77 AB 57 E3 5E E2 9A 46 28 6D 2B 4F 93 2C 38' + 'D9 AB 03 55 E3 AF 22 04 C4 41 44 0A F8 B7 DD D5 95 D9 AA B4 F2 AC 5A 40 D3 E8 96 6D 54 AB 35 9C' + '55 2A D1 48 E8 56 0A 88 ED 17 A8 AC 02 60 62 28 BF 93 04 B9 62 F6 BA 61 58 9A D9 61 FF 04 A8 98' + '4E 4B 57 0D 9E 33 86 68 84 89 3B E8 E5 F5 17 D2 19 28 3C D7 D8 6A 50 38 02 0B 50 7C 7C 79 7D EE' + 'A2 95 F0 75 53 49 5D 24 69 85 23 18 52 44 8B CD 9E 84 68 D1 BF 18 4E 71 B4 96 69 89 91 31 31 E5' + 'AB 0B 6D 91 8E 63 2D 2B 1E E1 DE F3 67 A0 CD 42 3C AF 72 8A 2E 22 44 22 88 91 5E 89 87 96 E3 D1' + '5E F1 E7 6E 79 B1 CD AE 73 C0 BB E0 EE B2 71 B6 E3 84 71 97 8A D9 AE 6E 5B 52 EF EE 5E B1 38 8A' + '8C 55 14 44 81 7E 07 23 A1 98 8A 71 C9 29 5E BF 46 62 54 72 5E 39 14 E0 13 53 26 10 4F 1A 9A 3D' + 'EF 43 BD 0E 75 08 28 18 60 88 10 2D 32 F2 2B 9C A0 3C 6A E3 82 79 54 02 62 A4 E4 E1 C8 71 BC E1' + 'CC 61 B7 B2 52 72 59 43 21 90 F4 30 0B 88 8C 08 A2 11 35 49 61 92 CA 73 AE 75 CE B7 69 D1 7B 2A' + 'D0 66 28 C2 FD 66 53 47 BF 71 56 15 8C F7 DF 25 9A 8B 4B 2D 60 64 4A D4 CB 4B 0B 11 64 76 F0 22' + '50 61 16 83 86 AF 1E 79 D8 C5 BC 7C 13 44 DC 4C CA E1 CC C1 60 BA F7 A7 9D 8E 89 30 28 3B 3A 32' + '2F 0F 5F 25 34 F1 F9 3E 37 44 F6 58 79 38 F6 B5 7C 31 E0 3E 17 AC CC 80 DC BC AB 0F 3B DF 90 54' + '06 41 8C 54 9E 7B 31 50 6B 0E 75 CC AF 25 CD 3A 2F ED 56 B6 07 86 75 C2 38 91 39 8C 13 86 83 5A' + '35 35 70 2E 05 E8 D7 0F 0B 22 47 11 92 48 3C 78 F3 6D 59 E7 49 24 E8 92 08 81 02 04 09 89 8A 91' + 'CB 33 34 EB 68 4A A4 3C 4F 1E 38 CA B2 AE 83 CE AF 05 1D 04 C9 4C 99 18 10 44 08 1B 8B 71 3C C8' + 'D1 A2 63 19 DF 0C C8 72 1C 38 61 BA D1 A3 41 B9 B3 3C 3B 90 70 E1 C6 6D F8 5C 9E B7 7A 68 CB 24' + 'A5 02 C8 DE 28 8C 51 12 24 4F 20 79 E1 F1 DE F4 FE 97 90 87 95 BC B9 34 A9 A2 63 4A 7B 14 9E 8C' + '71 3A 9E B6 E2 68 D3 5D E1 AD AD 4D 43 53 4A B7 7B E5 EA C6 97 06 EC C5 1C B7 AD 55 4C 8C 71 28' + '91 37 3B C4 CD 06 71 EA 59 E6 32 44 82 52 28 8A 34 2A 49 25 22 07 29 1C B4 12 22 40 F8 E8 E9 F2' + 'A2 48 88 44 22 44 A2 24 51 01 F6 50 40 7B 46 83 53 46 21 A5 C3 87 61 A0 2B 2B 3B 1E 0F 0B 90 EF' + '8C 7A AD 3D 0F 1C 34 D4 0E 59 C3 23 41 A9 B8 78 B6 21 C8 70 E4 E2 65 14 19 03 21 12 B2 05 85 91' + '8F A4 9D 84 F3 E9 4C 20 9C 9C 39 38 72 B1 CE 1C A1 11 AD 34 6A 69 3A 9D 13 88 DD 9D 4E 4E B4 F1' + '06 70 B1 CE 2D 0D DB 5F 0E 2A 02 80 B2 C5 C3 4D AA A3 7E BD 45 85 89 16 16 1A 4B 8B 0D D9 93 57' + '45 40 6D E7 B9 38 70 E5 9D E6 5C B1 CB 1D C7 51 E4 7A 39 10 50 20 40 E0 37 65 A2 64 C8 C6 11 BA' + '51 89 74 91 22 44 83 A0 81 4C 00 C8 19 88 90 1E 3D E1 8D E9 E3 C7 8E 1C 19 3C E0 E1 C3 BC D8 FD' + '30 1E 3D 3C E1 8F 0F 6B 41 33 04 C5 00 B4 91 85 03 87 0E 59 53 B0 72 70 E1 C5 24 F3 9A 1A A7 0A' + '45 31 31 32 25 CB 01 41 40 8C 48 87 69 76 97 71 61 B2 C2 CB 1B 41 62 57 58 58 78 28 F3 0C AB 84' + 'A9 2B 47 8F 1E 5D EB 17 B8 70 DD D6 0D 43 64 BA 45 70 F0 CE B8 34 D0 67 30 ED EE C4 C8 A2 44 89' + '82 C1 60 BB BA 62 51 BA C5 15 14 51 A5 94 51 41 45 0F 37 90 F1 E3 CC F6 16 06 FF 07 76 04 37 99' + '64 0E 8C 1F A9 90 5C 0B B0 03 87 0E 34 DA 34 E8 70 D1 BB B7 3B 21 C3 B4 06 43 20 F3 B9 0C 39 9B' + '96 81 D8 28 70 3A EE B6 C1 71 48 DD A9 04 89 12 1E F1 F4 D0 9F 45 00 EA CD 9A D9 B6 68 51 9B 14' + 'C5 93 9C 7C 6B AD 5C A0 3D 8C 1E 59 0E A9 24 B4 A0 E4 98 E4 62 54 A2 D8 D0 59 4B 43 99 53 49 4A' + 'A5 91 51 48 C9 11 44 A2 03 B0 24 39 17 22 C5 D2 69 E0 0C F6 96 F3 4A 5D 75 D9 ED 36 AE 19 7D E2' + 'E4 B8 B6 E2 FC E7 89 94 26 C0 C0 CE B9 CE 62 D2 D0 CC 6A 34 99 0E 3C 8B 84 A2 89 D9 7F 84 94 94' + '8D AB 6A 89 18 91 22 55 07 8F B5 C3 8B 1E 0F 56 41 72 C2 07 31 CB 22 57 2D BC C5 FB 0B 0B D7 05' + '84 C8 10 50 7F 6E 82 04 0A D4 0D F1 E3 CB 9E 64 59 13 C3 AA 14 0C 7D D4 22 04 0C 17 B2 66 89 A1' + '48 D9 39 A9 93 44 E1 63 51 34 19 2A 9C 9E 13 D5 9D A0 D1 AD 5C E0 E1 C7 3F 1F 1C 90 44 07 38 71' + 'C5 6C E7 32 64 C8 91 CA 9E 0F 16 C4 E1 CE B8 68 49 C6 0D 0F C8 10 36 04 56 F7 5C E5 29 34 10 59' + 'D7 4A 88 44 8E 5A 47 06 8A 42 06 5B 29 29 08 91 44 48 BD 68 34 AD B7 3E 47 99 79 5E 3D 0E 1A DB' + 'D3 86 97 9D 94 E1 D2 39 0E 9F 13 5A A9 4E 41 98 70 E7 28 B9 C3 87 0E 4B 22 70 E1 D6 B0 B4 63 15' + 'AC 62 A0 81 01 E3 E9 81 0C 43 20 B5 41 10 50 32 85 0A 85 02 1B B0 82 7A A9 10 50 08 40 1E 76 07' + '56 D4 D1 A9 A3 45 4A 70 E7 21 C5 20 F9 18 0F 4F 07 8F 37 9C 38 1C EA 1E F1 E0 76 F1 71 B2 F8 9D' + '91 9D 69 08 A2 24 79 B7 E8 0C AA 04 15 C5 06 AD EA 15 ED 50 20 48 C6 B1 C3 99 D7 4E 5C EF 38 D9' + '03 05 79 81 10 C3 03 7A A2 A3 52 EA D5 BE C5 A4 B4 B7 4A B9 8C 5C 8B B8 60 59 D1 5A CA 69 5C 8B' + '30 65 37 11 40 65 30 36 65 C3 0C 30 30 DD A9 54 52 71 94 06 95 D1 18 90 08 1B 7B D8 98 F1 E4 EB' + '09 49 4A CE 5E 99 93 66 26 2B 27 3C E4 AA 5A F4 93 69 61 3A 27 31 9C B3 CD 31 31 30 40 27 27 9D' + '13 58 AC 0B 16 FB 43 50 E4 E1 D8 30 D2 60 56 F1 E3 C7 83 D0 E2 BC D0 3B 2D 9C 27 9C D4 1B 68 9D' + '1D CA DA 34 69 37 14 A4 E4 F4 AA 43 93 53 D4 6B A2 07 0C 14 30 7B C7 9C A5 81 41 AA 04 0D 4B 28' + '50 FD 29 A4 83 61 AA 5E 21 32 64 C9 04 62 67 90 48 5A 42 61 D0 7A 49 9B C1 66 F4 A4 48 8A D9 25' + '2A 28 24 5C 9F D9 4F 1C B5 23 31 A9 E3 C7 B8 71 C2 6D 57 2B 95 14 46 54 78 AA 24 17 42 84 08 0F' + '1E 6D E9 89 A9 6A 46 53 8D 3C 78 D1 A7 10 E4 E2 69 8C 0B 6D 0C FC 98 CA F2 57 A3 41 C6 6E 0D 1A' + '35 5C E1 C5 C9 E0 F0 78 9E 9E 0F 2E 2E 57 AE 9A 4D 01 55 45 34 F7 62 44 88 A3 9C 29 29 51 4F 4F' + '53 19 15 75 98 CC 66 E9 BB BD B3 B2 53 8C 31 97 E6 A6 99 C9 D5 03 4E 66 6A 1C 38 E2 A0 80 E3 AB' + '13 D3 9B 72 77 73 49 07 98 06 14 16 8F 07 8F 2E 38 FA B9 83 B0 FC CC A5 62 A6 9A 4D 42 E8 1C 75' + 'AF 9E 72 72 6C 66 33 97 88 60 C3 B4 D3 9B AD 94 70 E1 DD CA 1F 92 81 40 B4 7A 78 E4 56 56 55 5D' + '0B 1A C9 93 79 6B AC AC 80 C1 83 C5 59 5D 7C 6B 6B 01 83 0B 18 30 60 C1 92 EB AE 9E B8 3D 4A 07' + '0A 89 12 64 08 10 20 40 81 A0 B0 80 0F 16 82 03 C1 E6 D0 C8 75 44 89 15 12 31 23 BC 49 5A 10 B4' + '51 88 FB 48 10 20 40 BA 31 BC A3 1D 81 CF 13 8B 8A 25 C0 40 81 C2 A2 A5 D6 26 4E E4 FC B0 32 AF' + '02 CC A5 21 A4 48 9B 62 6B 24 04 8B 8B A4 17 0D 2E 01 A3 55 CE 70 E4 9C 38 CE E5 AC 37 07 12 1C' + '38 D8 F2 F1 43 87 0E 13 8D 0D 0C C6 65 41 9B 15 B0 2D 02 03 C8 0F 31 09 E9 3C B2 E0 1E 06 12 95' + '29 65 30 5D D5 12 72 72 64 4C 4C 4C 4D 86 05 F4 A6 D5 48 D1 A5 28 70 B8 4C EC D6 3C 79 60 5C B0' + '0D 34 94 85 29 52 52 53 4E D5 FC EC D2 B0 3B 79 D4 95 EB 59 D5 B6 96 DA 63 EA B6 E5 DB 24 EA EE' + 'F7 0D 61 AC D0 68 34 1A 34 68 CF 9C 27 0C E6 73 59 AC CA 6B 30 0B 91 CF 71 6C 07 0E 39 A7 53 8A' + '63 86 72 72 72 72 72 75 9D A6 E7 53 4C 02 5B 07 58 3C 79 D2 42 08 81 8C 78 F4 F4 F4 F7 0D 39 EF' + '94 94 C8 13 30 95 10 20 72 28 B9 38 71 9C 2E B8 E9 BB 07 7A 44 88 A8 A8 A8 90 50 84 06 72 3D F3' + '1E 3C 7B C3 59 02 07 3F 44 A8 34 1A 0A 28 D0 5B 61 63 28 0B A7 22 44 91 29 12 18 6B 69 CA D7 51' + 'A5 C7 52 B8 81 03 7D 3C 5D D2 03 D3 C7 B9 FC 9E 5D 14 40 70 E2 C0 29 70 D3 B2 76 CB 78 EF 40 79' + '8D EF 79 61 02 04 3B B4 63 89 12 2B 81 76 4E 50 89 BF 28 9B FC A4 C9 12 22 41 10 20 F1 EF 38 DC' + '30 60 C1 88 60 C1 99 17 9D 92 E3 70 D2 23 87 0E 1A 34 69 9D 74 EA EB 27 0E 27 CF B6 27 06 69 48' + '91 E6 78 7C F1 7A D2 D2 DB 6D B5 50 5C AC 1C D1 A4 AA 53 B2 8C F8 CC 66 CD 86 CD 8B 64 D2 9C 1A' + '17 4D AD 69 66 CB 46 2E 12 8A 0E 7E 5A 51 C5 C9 5B 2B 2B 0A CA C6 57 55 E5 CB 4A B0 B2 4E C5 81' + '55 45 5A 8A EB 63 0A F7 2A AC 62 E8 2C 3B 4B 52 38 B9 46 61 B7 B7 22 C0 BA FB C8 17 72 B0 C0 C0' + 'D9 DE 66 53 83 29 16 33 94 62 38 70 36 5E 5D 6D 31 89 41 40 F7 8C D2 B9 09 CE 09 4C E4 A6 62 FC' + '66 35 8C 92 DA 8C 6B 1F 68 C8 63 34 F5 4B 19 A3 38 77 89 4C CD 18 C1 A5 05 E7 02 6B 46 97 05 D5' + '10 20 35 BA DC E6 56 87 8F 7A 79 5C 02 BA 0A 1E 39 AE 62 8B 8C 86 35 D5 91 63 B5 8B 78 DD 2C 8D' + '89 99 BA B2 9B B9 82 24 54 16 EF 02 EC CA 85 A3 47 83 83 21 18 EB 13 DC 54 D3 B1 E1 5C 0D 68 9A' + '6B D0 71 35 A5 64 56 3C 67 01 56 99 D6 66 EC 8D 33 08 70 E6 18 59 D5 03 70 6F A3 70 E3 18 0E 1C' + 'E2 63 87 27 1A F3 B7 5B 87 07 65 E3 D3 8E 75 99 73 28 10 20 70 DA 4B B7 87 37 04 60 F7 8E 4F 1E' + '27 91 20 44 71 D2 12 A1 EF 72 9A 52 5C 88 C8 19 32 12 0C 07 9B 4D 71 51 20 27 4C 72 73 9A 39 C8' + '70 ED 94 6E 28 07 73 BB A9 13 53 26 2D 05 9C A7 AA 40 82 20 39 A7 10 D5 3E 54 D2 83 99 6F AE 50' + '86 85 B9 03 00 A0 DF D2 46 26 38 98 A2 45 44 E1 0D 0A AA 8A 97 12 AD 73 AB 17 31 69 4C 48 4E 4C' + '4C 4C 4A EC F3 CE 4F 9D 0D 33 83 93 9C 9A 0D 32 EA AC 78 F1 E3 E3 01 E7 43 D3 C4 F4 3C 78 34 6C' + 'C9 9D 36 14 13 26 4C 90 65 99 34 3C B8 57 10 36 90 20 67 84 73 12 24 48 94 85 22 4A E5 72 B9 5B' + '72 B4 2D AA DD FC 86 4C 96 96 16 16 15 4E 61 72 78 F7 A7 0C 32 0D 1A 34 63 13 68 0D 1E 1A 1C 39' + '38 71 BD CD 01 E3 C7 A7 89 C3 DE E3 C6 5C 69 C6 2B 4B 78 1E 5A 40 81 04 63 B4 79 0A 23 41 C4 9E' + '34 7A 1E F1 C6 FB C7 8C 07 26 BA FD 17 96 95 99 58 A0 40 83 C9 90 21 02 04 E2 56 56 AB 55 95 18' + 'CC 66 38 81 51 B8 B5 28 2B 8D 03 C7 99 3B 04 09 91 3C D2 91 22 51 2E 9D EB DB AA 24 42 E5 22 48' + '80 F1 C3 87 38 1C 39 65 56 A7 26 8D 01 A4 87 1E 10 78 F1 CE 1C 54 32 29 CB 20 B8 49 4B E9 A6 72' + '62 55 2F 88 13 29 8C 8A 0A 0A 58 AA 64 B9 36 F1 C3 AA 45 C3 06 0F 79 5C 0E 5B 0F 3C 78 F5 15 17' + 'D5 51 73 19 72 69 90 C6 76 77 4D D3 74 EC 1A 16 85 51 33 71 89 89 8C 18 6E 03 7B EE 35 A8 2D C1' + 'E7 23 8C AF 1C 39 A3 5A 4C AC 97 69 A3 46 19 86 8C 18 C1 89 8C 18 67 60 F4 34 B1 A4 1C D3 91 78' + '83 2B 2A 3B 2A 49 8C 18 56 58 B5 D4 AA 29 29 1D 88 A7 31 1C 68 8A 2A 2A 2A 2A A8 B1 31 6D DE 5B' + '56 41 AC 3B 21 34 E1 C3 46 AB 93 57 77 A4 CC E5 9A D2 D2 03 DE 3C B6 03 9B 69 DB 7A D1 02 07 58' + 'C9 03 20 67 A6 44 89 12 91 70 A6 4C 9C EF 71 21 84 65 69 22 08 87 55 FB D1 23 AC 91 02 2B 26 5A' + '86 2A D1 59 99 85 65 A9 8C 61 26 F8 D1 1E 3D 3C 79 79 E7 39 0B D0 20 9E F3 2C 07 B8 D9 9D C1 B0' + '89 11 EA 28 51 22 5F ED AE 39 6F 1A 96 65 D3 05 0B FA 19 10 BF 35 95 15 2A 42 9A 4A 4E F6 2A 0A' + '91 52 E3 55 95 40 20 34 BE 62 03 C6 0C 2B 37 4A EB 2B 5C 54 5A C2 B2 A1 EA B1 FB 17 4A 73 46 0D' + '3B CD 1A 7B DA 70 D1 8B 4F 20 C1 8A A2 A2 6A A2 A3 CD 10 15 95 15 15 15 15 2A AA 2A 5B B5 15 15' + '04 62 C3 4A 68 D4 9B C4 87 0F 56 0F 3A 88 10 37 A2 B4 40 D1 02 02 80 F3 B0 BB 0B 32 EC A8 1D F2' + '52 CE 4C 9F 09 3D DB 0C CB BB 69 6A 56 96 91 07 8E 2E 38 98 54 54 91 56 F5 66 55 95 65 59 53 D0' + 'F4 3C 68 D6 88 6B 5A 65 59 4A 8A 8D C2 3D 86 8C 49 83 18 69 2B AC B1 9D 76 30 D4 34 4D 18 3D 30' + '60 C1 EC DD 61 5A 2B AC B5 56 56 56 1A 31 99 D3 CB 58 93 0D D6 8C 61 B8 DB 35 11 78 D3 C0 38 1C' + '2A 07 51 95 E5 1B CA E5 72 CC 77 55 EA F5 6A A2 82 8A 0B 5E 54 AA 32 91 88 7B 0A A0 29 89 42 3A' + '54 02 62 10 80 E1 A1 E1 1A B4 0D 33 8B 3A 69 9D 38 61 61 E2 8D 3C 76 96 34 62 E1 56 27 07 20 E2' + 'DB 76 44 F0 C4 1E 27 8F 3B 89 A7 94 E7 1B 80 E1 CE 2D 35 40 82 C8 45 11 22 5A AD 57 28 93 91 18' + '1F 2C 1A 62 40 DE 89 10 89 12 E5 A1 75 44 20 65 0C E7 5F 91 4C DA B4 13 27 25 21 4A 43 E7 02 10' + 'C8 A1 DC 88 F1 C3 90 EA 36 0F 33 A7 0E E5 73 B5 8E 2D 56 90 20 3C 21 43 CC AB 71 73 2D 6B 5F 5C' + 'E3 B4 9C 47 9A 60 0F 4A 19 62 34 D0 37 C7 4E 1A 58 76 D3 C7 8E 04 E7 38 E1 4F 61 A3 3B 86 0C 24' + 'D1 A8 61 95 19 51 72 1C 5C 9E 3D 6E 10 81 61 12 31 84 0E D2 DA A4 A4 A4 AC 14 D1 DB A7 36 CA 94' + '0B 39 74 D2 A8 20 42 05 6A 04 09 18 C8 28 18 0A 85 62 D0 9E 3C DD 63 89 83 46 66 99 D5 C3 C7 8F' + '55 83 D1 76 59 48 8A 04 0B 2A 07 0E 5D 09 EF EF C0 E0 1E 0F 79 B1 E9 EF 7B C3 C6 4C ED 60 60 52' + '52 B4 AD 21 94 56 15 9A 94 4E 9E 2A 8C CB 31 C2 C6 5A 78 7C 05 CA E0 BA C5 61 5A AA AA 87 99 D4' + '06 92 E3 C6 69 E8 59 32 B2 55 2A C0 C8 8D 7A 94 48 91 89 94 DE 09 48 52 0D E8 C4 88 9A 6E 30 AC' + 'E9 58 D6 23 10 65 52 0D 81 C4 C2 61 D7 73 87 0E 32 8F 84 08 1A 17 31 D9 59 97 39 13 3C 0E 0A 38' + '24 69 24 13 13 4C 4C 16 85 28 DF 55 00 E0 9C 9C A4 29 73 51 39 A9 78 55 6B B6 AC 78 E1 C8 B8 2D' + '4F 1A 5A 27 1C 09 E3 DE F7 F4 40 B0 CF E1 0C E0 F1 E3 81 D6 83 D1 A5 6F 2B 55 85 92 94 8D 4A 50' + '20 73 C0 4C F0 F6 93 8C A7 40 FE 01 E6 61 E3 CE D4 08 5C 8B 91 BE 27 9A 58 68 0A CA 8D 08 C8 15' + '2C 61 9A CE CB 2C 69 D6 DF 4E 1C 38 1C A2 0F 37 37 94 48 AC D1 78 F7 0E 1C 0E 43 90 E0 70 6F 09' + 'C3 94 C1 F2 EF 40 CC A0 66 23 14 58 9A 33 45 75 9A D7 22 38 5A 72 38 76 A1 3B 99 E5 8A 0B BF B9' + '03 4C AB 87 C1 40 65 06 A1 CE 74 8C 72 C5 C4 60 2C 05 7A A2 F3 6F 4A E2 54 94 9D B5 5D 6B 36 82' + 'F6 9D 26 B5 C5 B9 D6 5A B5 68 34 A3 3A D3 A4 D8 5A 59 12 72 DB 32 4D 43 53 46 8D B9 C3 42 B2 B3' + '58 56 8A EA 5D 0B A8 E7 18 0C 34 03 42 3C 6E 25 D2 0F 59 28 56 40 80 A1 62 D9 25 29 11 2D 20 41' + 'C3 93 87 2E 54 35 EC 18 49 A3 4F 38 89 27 0E 72 70 E4 48 5D 0A 63 CC 81 9F 3E 59 1C D2 37 56 59' + '8A 64 E6 B9 C4 71 88 8F 14 89 4A 39 60 3F 58 41 10 0D 71 22 5C 1A 8C AA 51 22 F4 3C B5 39 C3 46' + '9C 69 BC 4C 2B 2B 25 CC B6 AF 29 0D 4D 1A A6 35 48 1C BA 2F 5E 79 BD 02 04 2E 07 0E 1C 56 48 AC' + 'B4 19 C8 D0 69 DB 4D 68 D1 A6 D3 58 58 F0 80 40 D4 FD 5B 22 6C 09 16 CE 61 63 AF 78 F1 E2 78 39' + 'C8 71 42 37 8F 12 29 D3 93 F7 1A 0D 6A 9C 9C 9C 34 8A AD 0A 43 8B 87 9B 13 F7 54 21 03 31 12 2A' + '27 16 74 48 59 D4 8C CB 4C 88 C6 2A 24 51 30 55 39 39 3F 2A 8A B3 4B 38 1A 34 CB 71 AD E5 67 35' + '1B EA 31 78 50 86 40 81 0B 75 19 4C A6 40 C8 5A 6F EF 96 8E 1E 3C 7A 72 ED 42 88 10 20 42 04 32' + '91 5B 8B 78 DE 99 D5 62 B1 58 58 58 A4 A4 A4 A2 69 C8 DE F2 CA 38 1C 6C 07 8F 33 0C 2E B8 C8 34' + 'CE 5A 75 38 DA F1 E3 C7 8F 5D F2 04 21 0E F6 8B 74 1D E3 B5 68 AE C9 69 62 99 32 6B 4A B1 73 2B' + '57 0A 89 12 31 A2 85 0E 37 A1 C5 6F 06 3C 78 F4 F2 54 66 98 D7 61 29 8D C3 10 C1 83 06 30 60 C9' + '0C 34 9A 5A 45 0E 43 87 0E 0D EE 45 08 10 37 F8 C2 04 07 8F 4F 1E 3D 75 28 1C 47 91 01 E7 1C 20' + 'B2 C4 E2 37 E4 44 E1 91 22 04 07 9B AC 18 98 0C 54 2B 06 8D 1A 34 9C CC 83 8D 03 E5 03 5E 89 11' + '90 4A 44 94 89 12 53 26 4C 26 4D 5C 5D 65 84 89 48 25 24 A4 12 24 48 DC 90 48 91 09 65 1E F2 75' + '39 30 6F 4D 31 34 C5 2A 73 4E 9D 3A 56 95 44 0A 91 61 04 49 27 D1 77 D8 B5 9A A8 38 20 0F 1E 50' + 'FD 50 82 86 63 57 3C 07 1A 32 C7 1F 52 E3 54 14 50 B5 0C 88 65 EB D2 2C B5 54 44 22 B0 51 BC A0' + 'CC 39 A6 C2 75 91 64 C9 90 CF 7E BB C9 96 80 98 98 D0 13 AC 92 24 48 92 23 2A 24 4A 39 0A 25 12' + '2B 8C 91 CD C6 4C 3C 91 65 B1 4C 9A 90 48 9D 46 78 39 AA 2D 0F 15 C5 20 F5 C5 9B 63 F9 07 8F 4F' + '43 D3 56 B5 E1 53 13 4C 64 DD 45 A9 8C 2F 50 C3 20 DA FA AB 2C 0B 2C 6A 18 26 A6 A6 8C 18 15 95' + 'F1 EA B3 C1 A4 5E 30 67 C8 64 4B 3A 63 25 25 52 E7 2A 3A B4 A7 56 F1 F1 84 73 F9 B7 83 F5 C0 20' + '87 A7 AB 48 23 46 B4 44 61 CA A0 41 41 37 46 BE 56 6A 78 6C D8 BD 56 82 04 20 40 82 63 17 35 12' + '32 05 08 C2 84 40 BA ED 29 C5 AF B4 1A 35 A4 A1 8C B0 C6 61 92 DB 75 58 13 99 58 9A D3 C2 AC ED' + '31 C3 9C 5A F5 5C 17 7B 99 50 50 9E 8C CD 44 E4 C9 99 42 7A DA 62 6B 46 E0 9C 9C ED F5 6B 87 2B' + '5E 8B 08 5B C3 0A 03 8A 2A 2A 24 08 41 9A 28 4E 1C 39 0E 77 53 DF 5A F1 18 3C CE A0 F7 8F 38 C8' + '0F 21 62 B3 C5 30 89 1E A8 F8 9A D6 1D E6 79 05 B2 5A 58 77 CB 11 DE F1 AF 63 3C 06 A5 B7 94 3C' + 'E7 B6 71 07 49 9F 67 B1 7A 4C 38 7B F5 75 EB E9 95 EF FA CF 33 8A 7F 53 EA FF F5 E7 F8 3C BF 4F' + 'D7 B8 1B 39 D6 7D 4C B5 8E 1D B3 AC 17 0D 53 86 A9 EE 5D 5C B8 D6 CC CD 76 E1 80 E1 82 E5 3B 02' + 'C7 3E 89 B0 19 E7 6A 7A C5 29 8D 94 06 1C 40 6B E0 36 6E 1F 25 F0 9C 36 0E 18 6E 1D 8B B1 B2 4C' + '5E 6E A3 BB 65 15 60 2A BE A9 F5 2C F7 B1 55 F5 6F DB E7 E1 6A F3 12 AB 17 8F 56 22 AC 60 3D F3' + 'DF 1B A9 BD 1B 80 37 06 CF 4A 62 E0 C5 C1 0D D9 70 E7 5E 76 05 8D 8A F3 E7 65 88 5E B0 C3 1C 49' + 'D4 1C 51 D5 B5 5E B1 7B 33 7C 5A FE 67 F5 31 B4 5F E0 76 A7 62 CE DA AE CE D5 7B 53 F8 AD 78 45' + 'E2 0F E4 72 67 6E CA E4 D7 B8 3B 95 AF 74 BF CC EE CE F0 E1 CE A8 E6 4E D8 FD A7 4C 77 27 6A 77' + '07 7A 77 C6 50 EF DF D7 BD 5F 00 F0 57 EE 29 89 46 37 E7 84 40 E1 99 53 C4 3C 52 C2 0E 32 C0 E2' + '9E 39 FD 2C 4B E4 2F 92 65 8C B9 E5 1E 1F 2F 58 79 5B 25 EB 97 07 C8 5C C6 BF 9B CD 72 66 0F 30' + 'CC CC 81 A7 4E 7A FF 6F DB F7 FD FA 7D 3E A7 F6 B9 A9 AE B9 9B 9B ED F6 FB 9D C9 59 55 F6 38 03' + 'B2 7B A7 7A 78 E6 54 CA 70 F8 27 84 78 BC 49 B2 F7 36 B9 B9 BE D2 93 A2 B9 C9 CE 89 9C 3D 63 FB' + '4D F6 67 25 D5 39 DE 67 B2 CC F3 EF 6E 6F BE C4 EB 1E 06 3C 2C 78 98 9F 63 C6 C7 F8 7F D3 DF 3E' + '47 E5 2F C0 B0 28 0C 62 0F 2A C0 F3 61 D6 C2 0A 16 3C 67 B8 67 59 58 F1 AF CE F4 BF 42 EA FD B5' + 'F9 0F 93 C2 B9 E6 A2 09 8A 26 18 60 FF CC 51 B5 5F A5 74 26 91 6B F3 AE 95 A7 61 18 F1 55 19 53' + 'A5 BB 34 C5 E1 A0 68 D5 84 41 E9 60 14 C9 A3 0B A7 C5 D8 DA 2F D4 C2 97 EB 58 80 F6 2E 95 45 07' + '69 D2 9B 30 E9 80 3D 25 D1 A8 2E DD AD DA FC EA B3 84 F4 25 12 02 44 E8 F6 FC DE 5F 18 C4 F9 D5' + 'D4 1F C0 D4 F3 96 FF AA E7 98 0F 7F 51 AA C3 68 1E 9B 67 DF 23 CE 78 53 AA 5D E7 D3 16 D3 25 F2' + 'BA 57 90 B1 5E 5E 0F B4 3D 39 E9 8D AE D7 13 0E 13 FD 4F 51 A7 B0 69 0F 5E EE A3 25 EC 65 E3 93' + 'D2 AA D6 27 D1 88 3D 6E A4 61 5F DA BC CF 31 34 99 6F F8 3E B1 3C 57 FF BD 56 BF A7 0D 6A B3 26' + '15 34 D2 B5 59 5A A9 18 8C 66 24 B0 98 D7 8D 81 75 2C 24 55 8B 1A BE 15 23 C1 4A F3 58 15 05 0B' + 'BF 5D EA 8A 94 0B C5 E5 5F 97 45 3A 81 C8 CE AE BC 55 52 C0 AA 55 90 47 9F 58 8D CC 4A FA F2 95' + 'D4 A2 F2 A4 C2 B2 AB C5 E5 A9 A7 F9 27 FA FD 25 63 75 B1 8B 0E CE 07 A2 18 0C FF EF FE 84 3C E5' + 'A7 B6 AF 2A B4 54 79 19 2C 2C 0A EC 47 0F 46 01 F8 6A 1C 5E 25 6A CB 5A 30 E7 A7 05 39 69 46 32' + '88 2F F7 34 31 56 50 B0 88 A4 AD 8B 3F 31 7C 24 AA C6 B1 1E A3 D4 2D AE F4 D4 0C 06 0C CC F1 0F' + '5B 9B 13 8E 09 2A 51 BB 85 55 54 96 31 9B 73 D2 BF E3 3F 0A A7 B1 40 61 3C FA A8 D2 B0 7A BD B8' + '9A 30 EC 7F 3A A7 93 48 C3 89 84 A1 D0 56 7D 81 5D 44 03 75 6B D9 46 E9 A1 7A 51 CE 31 F3 9F B6' + '47 ED 8C D7 DB 72 E0 71 51 75 25 52 0D 53 93 19 D1 B8 6C 53 6E 1B 89 FB 9A F7 56 DA F4 DE AD 87' + '0F 38 D4 34 EC 2E B2 F4 EA B1 94 0E 45 75 1E A1 42 92 92 6B 4A DF 31 1E 83 39 03 21 14 C2 B5 69' + 'C9 B8 99 CF ED 63 3D 16 54 31 65 1A 58 3A 8B 9C 8B B2 2D E5 F5 8A 31 B4 ED 83 B4 71 27 B9 70 BE' + '8D 70 4D D2 E4 5A 23 95 39 6F 5A C2 A5 AC 5A CB 08 C4 C6 47 1D 14 2C 64 1E 8E 8A E0 23 BC 11 5A' + '04 E4 E1 C8 82 F4 D5 EA 91 52 C6 63 58 CD 35 2D C0 EB AA 51 4A A5 16 AB 0C 61 34 30 62 DA 45 6A' + '16 65 A9 67 71 B7 86 04 0C 54 43 72 88 AB 57 1E AE 9F 5D 57 EA 8C 4E 08 91 20 9A 71 2D E7 19 91' + 'A4 DB B0 34 9A 2C 78 F1 EB 32 85 CA EF 44 63 C5 88 A4 CE 58 62 C7 D7 DF 10 F3 52 AA AA 4C 78 CF' + '21 64 34 9E 1A 87 85 75 86 3C 42 8E 54 65 F6 42 B8 1D 25 CE 1A 88 A6 8D 06 A3 94 C5 88 31 04 CC' + '41 FB EA 02 26 38 75 54 13 0A 8A 91 52 31 76 B2 08 A9 6F 2E 9F 15 35 81 8F 58 68 D5 9D 30 45 47' + '93 80 23 CE B1 58 8A C6 64 A1 73 2B ED A1 34 46 02 AE 65 00 BE 8B F5 F6 E9 15 1C 0A A0 F1 29 97' + 'A7 D7 3A DC 17 3F 5D 6E A3 73 22 70 44 E3 B8 82 68 A1 A4 9E F4 70 E8 32 8C 79 C5 05 E5 2B 91 95' + '78 75 97 1B 03 6A 2D 20 6A 66 84 52 1D 7A 77 9E 9E 8A 51 59 E3 AA 7B 7B 51 84 47 65 76 93 16 FE' + 'CB C6 2C 9B 2C F7 24 C1 61 C3 51 E2 EF DE 2B 36 88 A8 C6 F1 0E C5 48 38 A4 B6 28 D8 B7 96 0D DD' + '8B 62 D6 9C 23 32 DE D1 58 15 18 8E AC 18 84 60 38 55 A1 89 18 04 30 D0 BA 6B A3 21 4C 37 11 E6' + 'FA DB 6B B0 22 F5 B9 4A EB F6 B9 19 49 5D 21 31 1C 39 8D 3A D9 6A 3C D2 CD B8 AC 45 E2 84 60 36' + 'AB E1 81 71 2E C1 48 88 10 5A B9 30 B5 61 B2 B5 80 CC B1 AA D6 3F 2F 89 A8 C2 AF 40 C8 AA 26 B0' + 'AC 4A F9 89 18 0A 4D AD 59 57 02 C5 83 7B 1A 31 87 6F D0 52 61 33 2E A5 03 AF 78 C3 CE 62 34 A3' + '9F 3A C6 8E 1A 49 A9 26 73 34 F3 DA 17 16 60 AE B2 D4 66 2C 4D 5D DE BF 2F 42 E5 5D A2 96 99 C3' + '52 18 61 0C 07 A0 58 D3 57 83 09 95 64 0D C2 B4 61 D2 53 80 F2 EE BE 17 CA D7 4E 2E 65 52 2F 62' + '26 BA CA 44 16 1C 34 A1 CA 65 23 16 25 7C DA 74 5A B1 A2 F3 96 02 F7 96 B0 08 65 F1 FB 4E 99 04' + '48 AC 5D C5 8F 1F 7B B6 5C BB AB C4 17 59 7A 8B 47 C1 39 17 AA CA 95 1D 9E D4 31 23 10 56 6D 75' + '8E B2 DB DB DB 2E 18 30 61 CB 21 3A 92 F7 64 1C 54 B0 8A F2 E3 58 6F 37 BA 74 F3 52 29 23 98 DA' + '62 AD 63 31 F1 D9 5D 69 B8 E2 61 BE 60 6A 30 98 4A 2B 54 2A 82 37 D5 6B 22 91 45 18 2A C4 B1 28' + 'AB F1 24 8B 56 A5 4A 62 AC B4 9C 90 45 84 AA A9 13 0C 52 59 67 47 69 22 11 01 40 FD C3 42 22 63' + '33 39 60 14 AE 83 D3 C9 68 C0 63 58 8B 15 F3 3E 73 3A 39 96 FB 82 B3 12 64 28 55 0B 89 70 2C 7A' + '96 23 35 9C 4A FD 46 0A 91 1A C2 A5 52 C2 14 A2 77 A8 C4 8D C9 95 0A 4A B7 9C 3D F4 66 5E 6E AD' + '4A 4C 32 A2 F0 38 46 6E 75 35 85 18 11 8C 35 DF 46 15 81 17 2F 25 6C 5C E6 6C 68 DF 2D 5A D6 00' + '29 15 8B 80 62 31 0E 47 28 D5 8A 93 08 F4 E5 B0 C4 BD 4A A4 59 7C 18 8C 1E 3F 1A C0 30 C1 4A E2' + 'C0 60 31 23 3A 6A C8 AC 4E EB 55 42 A8 D0 36 E5 49 72 EC E2 58 B3 14 6B AB C8 08 A8 AD 95 79 A4' + 'AE 53 C4 11 08 9D 41 42 AE 25 69 44 D2 44 94 B5 0A 62 49 95 2A 02 11 1A A9 04 E8 EC A4 42 77 2A' + '41 42 CC 4E 23 38 8A F5 44 F3 C4 10 44 C8 C1 81 37 08 61 46 1C 38 16 03 06 DC 31 54 F2 2B 66 54' + 'AA A8 8A C1 B5 4F BA 47 69 AD 49 14 E9 8A 9C D6 4A 03 2F 06 75 67 D4 89 F2 C8 9E 61 52 98 75 AB' + '50 A2 79 D1 04 19 AC BB 84 FD BB 57 A9 5B 50 57 43 B9 98 54 E1 8C EA 65 50 68 2C C0 64 12 50 B4' + '5A 6A 7D 72 B4 A8 58 B9 96 25 48 31 31 4D 71 F7 95 7B 4C 5B A3 13 96 EA C6 67 C3 D9 2F 62 5E 55' + 'DE A7 E4 D1 6A CE AB 54 D3 EA D6 5B 2C 98 99 75 C9 C9 88 83 B1 62 44 89 16 44 94 A4 98 D1 0C 86' + '56 93 AC DE 7A 0D 6B 8D 52 59 4A C5 D8 4D 3B 46 BA 3C 9E 1E DF 8E B2 28 C8 DA E4 C2 B5 6C 4C 10' + 'C0 61 65 34 D2 61 4B 84 BC 2B 6F 07 4A F1 18 B1 45 50 DE 0C 37 D6 4B F8 D7 01 35 CA 62 B5 5A B8' + '97 01 8F 19 4D E1 E9 A5 DC DA 2A C6 DE C7 28 F5 A1 5F 5A D7 61 64 4C 3E 9C 32 38 D6 AF 62 50 54' + 'C0 BE A7 8B 06 D2 0F 5C 5B 16 DA CE B6 C8 F6 97 DD 84 9C EB 69 15 2A 95 4B B8 A0 75 6A 39 2C 5A' + '56 C5 42 F0 85 26 D2 82 83 D9 D8 06 1E DB 4D D1 6F 29 ED 0F 76 26 18 0E 59 B7 FF 2B FE 47 F9 1E' + '8F ED 7E C6 CC 39 6F 78 0D 54 DE 0C 39 BC 9A B1 AB 1A F9 AD 17 F3 7A 30 C0 FB A6 BC 61 0F B8 6E' + '46 DE 6D C6 E2 61 4D 82 F6 BB 6A E1 0B C3 65 36 82 61 17 EF 11 0C 5E 17 86 F8 6F 86 88 BC 6A B7' + '8B F4 97 85 E1 78 5E 17 85 E1 A0 31 85 E1 A6 2F 79 55 BA A3 A5 74 E8 E5 34 38 07 4E BE CB A1 66' + '91 74 93 94 A7 AE 0D 29 A5 34 66 94 D2 FD 8B 69 97 63 0F BE 48 81 4B D0 E8 B5 E6 CB 28 74 3D B5' + 'EF 9F 86 FF 7F 4E 8B 94 94 94 E0 54 0A 84 47 F8 DE 02 7F 1C 2D E6 5D F7 22 46 E9 EB E0 12 20 6E' + '86 E3 E0 D1 ED D7 B1 C3 0F BE E9 63 12 62 10 6C 8A A9 53 CB 72 26 9C 1D 92 E5 2B 94 EE DD 3C 42' + '62 C4 8B 4A 13 21 80 D1 C7 ED A7 B5 4C 3A E4 91 CB C4 4C D9 93 27 21 99 33 07 72 92 49 98 76 99' + '1B 21 0F E9 BD 3A FB B4 7F FB 19 8C C5 CE EC 7F 6D D3 17 F8 78 78 77 82 EE CC 33 C8 0F 24 8B B6' + '1D BF CE 17 AA 35 D6 BE F9 F4 9F 26 7F 73 E7 E2 03 A1 44 DD 46 6E A5 91 9A A0 A2 52 66 66 EA 43' + 'F5 02 8E A4 7D 83 9B F6 79 D2 A2 93 4F EC A6 3D 93 32 48 A4 42 C2 6E DA 04 84 E1 81 FA 00 ED 00' + 'E3 D4 93 91 EC 3E 34 ED 29 8B 2A 77 6B 0F FF 4C EF 5B B9 17 F2 0B D1 4C 28 C1 F0 D6 9C 58 CE 17' + '2C CB 1E A1 EA 1C 41 EA 1C 41 8A 31 47 8C 7A 87 10 71 47 F8 3D 43 CC 3C F3 D4 38 53 8E 38 E3 8F' + '35 6E 54 C0 BE 63 9A 64 37 33 21 9B 1C 5A E1 45 B5 6B F9 0E 36 30 AC AF 1F 8C 87 80 08 97 60 55' + 'F9 6D 36 C3 5F 19 86 D3 95 89 22 C9 B2 39 08 4D E0 14 C3 48 65 C8 8A C0 F7 86 AC 70 D5 AB C8 C1' + 'D2 3D D2 82 54 02 22 60 4C 92 00 02 05 65 48 4D 66 9D AF 55 96 5A 72 87 24 71 B8 B9 7C 22 64 C5' + '57 EB 79 F6 A7 D6 70 D6 55 BA DB 7E 34 94 B4 A7 26 DD 74 AB A5 34 86 94 D2 9D 89 A5 3D 53 34 69' + '4D 29 EC 1C C9 8F 39 E3 1E 63 CC 79 B4 97 56 B5 E7 88 EF 1F E8 DB 8E 80 F6 0C 71 D0 1D 09 B9 17' + '5D 97 57 D4 D1 2D A5 A1 A7 74 E8 CF F4 D1 7A 25 B9 3A 22 E6 79 6E 97 28 76 E7 7C 5D 1A 82 E8 BB' + '33 C7 C4 77 07 02 5D 9C 01 C1 1F BC BB 39 12 EC BB 3C 73 BC 2E CB B3 B0 3A C3 AD 2E 8B B3 2E 76' + '26 80 F0 8D 01 76 5D 97 67 8A 78 A7 98 65 CC C1 F3 97 67 9D 64 5F 35 77 5E 72 F9 DC C1 9A 3E 93' + 'CE 33 25 D9 8E 2E DF E8 3F 59 FD A7 F6 9F A2 FE 45 8F 17 C9 8E 8B FD 38 8A D1 F8 AE FF 9B 15 9C' + 'AC F5 9E B4 45 68 AC F5 9E B3 D6 9A 2B 45 67 AD 11 5A 2B 3D 67 AC F5 A6 8A D1 59 EB 44 56 8A CF' + '59 FA 0F D1 7A CF 59 EB 3D 67 E8 BF 46 9C 56 8A C4 F1 82 F2 C7 8A 78 C6 64 F3 E5 17 BE 5C A6 21' + 'A0 23 05 DC B2 6E 98 0D 06 21 5D D6 A1 B4 52 9B 0E 6D 99 4D C2 94 37 DC 15 3F 2C 23 E7 9F A1 E9' + '74 D3 DA 87 6E B7 47 8B 12 B7 4B 6E 5D 67 86 8D 8E 3B 0E 8B A7 DD 13 0E 98 81 61 7C 9C 13 0E 97' + '56 7D 5F 65 6E B0 41 6E 96 E8 BA 2E 8B A2 E8 BA 3D C3 D0 2E 8B A3 DE 2E 8B AA F2 FB 2B 9B F9 16' + 'E9 6E BA 4B EB AD D1 74 7F E3 6D 37 02 E8 BA 2E 8F 90 F7 4B A3 34 A3 4F 9A 76 A3 DA 09 4E D2 A7' + 'D9 62 B1 36 82 D8 16 8A DF AB E2 08 B2 F5 29 B6 DA DE D7 75 6E 9A 45 39 51 7B 90 17 16 15 20 AB' + '83 2C 82 20 F3 AA 40 43 91 6D 12 01 F4 AF 89 1E AF 5C F4 F9 6F B7 BA 1F 03 E2 58 0D 9B 8E 3B 39' + '4C A7 45 24 CC C0 4C 03 09 14 42 4E 7B 2E BA 15 32 A8 8B F2 5F 81 BE 8B F5 F8 14 BE E2 6E 91 37' + '78 81 1C 20 23 44 48 6E F4 97 B0 DA 2A 01 6B 08 11 ED 57 8C 33 6C 95 EF C4 1D 55 1B 78 AF C3 C1' + 'EB 4F EC 25 C6 02 E6 2B 31 13 73 93 9E 15 A4 DC E5 E4 4E 0C BD 94 76 70 29 D7 9A B9 B4 4B 9D 75' + '27 2C CA 81 0F AC B1 AB 7D 1A B1 63 16 1A BF 69 79 11 A9 16 CF BB 52 8C 9D 4E A9 F2 13 50 AD 48' + 'D3 07 03 4C 35 1A 8C 3E E5 9E 2B F9 27 6B A3 97 1E BB 92 6C 4B 3A B2 E3 DF D5 F2 AF 41 61 A6 13' + '26 49 30 98 21 9B DF E1 7F B0 4C DE D2 D7 76 30 C2 BE AB CC 70 41 54 C3 C0 69 A0 8E 74 35 16 A5' + '44 32 F4 46 3C 5C A5 36 D4 63 E6 60 71 D4 CF E8 19 70 A0 68 C2 D5 D9 32 63 6F 25 2C E5 41 B6 C0' + 'F7 D2 FB 5D B4 5C 1B 0E B0 97 24 5C 7A 5D CD 03 4C E1 3F 90 CD 0C 73 3E A7 17 FB AD B2 90 13 33' + '30 21 92 CD BA 6F 6E CF E5 6A BC 3F 95 EB D2 F3 4F 33 93 BC 39 3C 9C A2 0F 2C E4 1C 81 CE 41 E1' + '1A E1 F8 F6 7E E1 FE 56 CD AD 0C E7 B7 6A D9 AB 62 BD B2 B3 9E F7 DD A0 85 0C EC 67 95 9E EB 0D' + '73 15 65 70 AF D2 31 DB 2C 5E 86 32 05 DF FD 99 A8 79 7C 83 98 9E C1 83 3C AB 05 3B BA 2A CC B2' + 'BD 58 85 7A BE A1 52 A8 0C 89 85 6A 99 AB 72 27 43 DE 84 7B 97 47 3E E5 46 3B C6 34 AB CA 59 65' + '2C 3D 80 96 4A 88 4C 99 86 13 08 19 2E BD C1 AE 9C 35 A6 77 9B 85 CF DF 5D 9C CE D5 B9 D4 73 B0' + 'DF FF 2A BF DB 20 D0 9E 8C D2 BE 62 A7 75 13 FC 4E 3D D4 79 1A 51 06 9E AC 40 F5 2B 80 1C 27 05' + '81 47 2A 96 8A AB 21 F3 E2 55 94 7A 05 15 12 B3 34 4D 64 6F 35 67 88 DB 15 61 7A A2 D9 8F 25 BA' + 'A9 FE 85 D0 30 94 AA A0 54 AA A8 15 E4 57 79 5D E5 66 55 DB 0A 8B 53 DC 14 D7 65 10 46 3F 0E 31' + '46 11 38 B9 81 D0 39 E1 D3 58 AD D3 0B AA 53 BF 4E 9F 4E 76 BA 25 63 03 C2 66 76 E6 05 5E 60 31' + '15 DC 08 6F 9B C1 BD 7E 05 23 AF C3 00 3F 98 AB 3A 30 33 E2 FA CB 26 CD 69 BF 38 7C 88 96 EB 14' + '4C FC 7E E9 49 9B E1 2D 10 44 8C 6A A2 D1 6C 46 B5 51 EA 9A 26 CF E8 60 D2 FD 75 67 66 2D DB 26' + '4C 90 54 60 6E 26 DF C9 C7 98 98 EC 28 C0 D3 BE 39 46 4E B5 FB B7 7E FB 67 BB 77 AF 82 F6 4F CE' + '7E 62 6E DD F0 6E DE 4F 92 E9 DE 4B 27 22 64 EA 0A 3A 9F 2D FF D5 C7 EF D7 A3 43 19 2B C0 CA 56' + '7D 9B D4 F2 C2 BF 8D ED 27 47 07 82 50 5D 17 D3 64 1D E9 D0 3E E5 2F 8C 6C 24 ED 8C F6 8F B7 19' + 'A8 6C 85 F5 16 42 F4 D6 42 C8 59 0B 21 64 2F 61 7B 0B EF F3 D7 9B F6 62 AD 99 7C F2 DF C3 FD 25' + 'C0 C1 39 A3 8C 1B E5 C0 9D F7 85 FD 37 E9 0B E3 92 87 DE 9A 2D EE 37 7D A1 D0 39 8E 61 92 9E 14' + 'E6 3C 6B 41 9C CB AD C1 70 E5 31 95 54 CA D9 6E 87 C6 A6 29 96 75 6E 54 A6 61 AC D3 99 79 1C B9' + '65 AE 33 F8 78 27 DD 6F 94 66 FF 91 9D 54 33 5C E8 D4 B5 F4 AF 51 49 8D A4 6A 3B 94 14 02 16 06' + '16 15 70 5C A0 5A 56 6C 3B CA AB FF C2 B0 96 05 2A C4 A4 49 86 19 32 10 C8 37 8E 9B 37 6F 1A 8F' + '85 71 14 7E 0C 9C 37 C3 5C 17 5A 95 70 B4 AA E1 5C 2C 95 92 B2 56 4A C9 5A 45 63 BF DE B3 1E 65' + '9B 65 3B 4A DF B9 20 ED C8 79 65 7B 93 0D 94 AD 9B 01 D1 94 12 A3 69 0D 9E 63 2A E9 AC 1B 47 03' + '2B 46 8E 08 7B AB C6 25 3B F2 0E 37 95 AF E0 F7 F1 93 06 56 A3 4E D4 8F CC 8B 08 D7 0A B4 03 18' + 'AE BA BB CA 91 55 4E 92 95 54 AA A3 55 1A A1 82 B6 8A BA AA 75 54 4A 8D 54 6A A8 55 5D C8 24 11' + 'C7 A7 D8 F1 CF 7D 26 6C 0F 50 3F A8 33 3B 60 F4 83 52 57 EA 63 0A A7 BC 9E 0A 6A 0B 08 20 CA 63' + '17 40 DB 4D 3F 9A 6B C9 69 4F 44 DA 7C 1E 68 E1 83 80 64 39 81 17 E6 8C E6 1B D6 63 75 77 74 7C' + 'C6 DE B9 5E 59 1D B0 57 9B 9E A2 B5 B5 48 D9 A1 84 0C 96 E5 C1 BA 7E 94 7C 0A AC DF CD 44 99 B9' + 'DD EC DB A2 5B A5 EB 2D D2 BA 0A 8C 54 62 B1 DF 0F B6 30 08 8F AF B5 28 A6 16 4C 58 C2 0B 05 42' + 'A2 C0 CD F3 D5 6E AE 20 8B 84 53 77 18 58 1F 81 5D F5 58 C3 01 22 C6 17 09 17 16 AF 8E E0 12 CC' + '20 16 D4 D9 DB 0D 23 FA EF 8B 6B EB 60 C5 B3 B8 54 5A A2 D5 85 56 01 58 05 68 95 E4 2B 1B 6F 1F' + '66 CC 78 F9 1B 46 96 36 8A 5B 6D BD 11 3C A7 FD 15 8D 0F E2 90 B1 91 8C 9D AE 69 3E 36 A6 C5 A6' + '8F 51 17 36 4D F5 85 C5 27 8E 29 1D AE 0F 93 B7 5A 81 FC 95 DA E0 F5 ED B2 C6 74 F0 71 F4 E9 8D' + '8F 64 98 A0 A1 0F 3E C8 CC AB 3A 18 1B 87 CE E4 4D 7F 6E 70 F3 DD DE 75 73 C6 E5 DC BB 97 72 F3' + '5A FE 9B 3D CD C5 2C 79 E6 EC C3 A8 62 57 43 F0 9A 96 2E 2D FB 36 A7 14 3B 40 C5 09 57 77 25 3C' + '5F 9E 4F E8 5B 69 65 07 EA 34 0F F9 15 5F E2 59 C4 30 F8 B8 91 7D 88 89 D6 E3 7D F7 E6 59 14 F1' + '41 ED BD FC 05 DE C6 01 54 CA CB AB A2 A8 85 7A 15 78 0A B7 AA BF 07 0A FA B0 FC B7 C5 A6 E5 47' + '72 45 9F 96 A4 1E 84 09 ED D0 8E 1D A5 AD 08 17 B5 8B D2 90 58 85 D8 08 4C A1 73 C3 70 E4 1E FB' + 'AF 6C 13 86 95 40 84 B2 88 1A 91 84 DA 4E 9B B2 09 F7 0D E1 2F C2 EF B3 7F 24 51 C5 24 4D 99 B3' + '74 7B 88 77 3A C1 F2 8D 51 8F 6D 1A 73 0E ED 17 67 06 E5 CA D1 A3 64 E5 6F 1A A5 4F AC E8 BE A5' + 'B4 5C 35 C9 5D 31 74 8C BD AE BC F3 CC E6 FC BC 91 E1 7D 5A 3A BC 38 BF A0 B0 BF 31 99 60 06 97' + '3B 60 33 AA 7E 1B F8 87 65 0F D0 94 BE 42 CF 15 2B F4 E5 E0 51 C1 D5 23 C6 66 3C 64 E1 70 C9 08' + 'F9 6C EC 80 64 C8 96 C4 52 89 35 EB B8 5A 98 C7 F4 50 26 8B AF 8E DA E3 A8 8C A3 E4 B8 DB 8E BD' + '87 9D 19 ED D5 B3 1C E6 B7 3E 10 D7 02 25 C7 0F 14 84 E9 FA 07 4C B9 DB EA 5A B5 C7 0A D7 A0 AC' + '25 6E F0 77 AE BD DD D2 A9 99 B8 28 4F 84 A8 2D 8E 7D 17 B2 9F FC 0C 4F 8D 78 E7 66 38 36 0B 7B' + '63 0A CB 31 0D 34 B1 2D 6C DF 60 BF 8B F8 7B 5D 00 7A F3 FB 87 9B 32 FC 94 EA B1 34 0C CB 65 12' + '9A 09 22 43 BB 6A 6F 15 64 BB DB B6 82 D4 0D 4F A0 36 81 9C 82 BA F5 78 8C D6 CC 67 59 11 30 76' + 'C9 94 09 91 43 49 41 98 58 63 C4 31 D6 F0 F4 3E 07 E2 7D 5F 86 9A 8A 2C 5A BA 8F 39 53 00 FB E1' + '96 3B A7 01 3B 0D CA F3 FD 4D 25 9C E3 3B D5 EE 88 E0 FE C6 77 00 C0 8A 84 52 C5 E0 15 45 08 A4' + 'B5 45 DD AD 96 21 7F D8 29 8A DB 31 4B D7 94 D8 7B 91 19 E1 ED 3C B0 0D 78 9C 99 D8 27 3F 26 F4' + '6A BB 31 AE 6B 3B 3A AE F8 8B DA B3 42 F7 43 10 3F 21 18 26 FE 84 C0 B4 DB 06 21 A2 C3 1F 30 8B' + '46 70 96 D6 F1 0B 44 9B 56 27 F7 E4 AD 52 6D 90 58 1A CC 74 A4 0F 7E E6 C6 0D 58 35 34 45 20 17' + '78 BB CD B6 C7 AE 64 5E 78 73 6F 8A D3 3B FD 97 0E 8A E2 AF CC CB C7 F6 CC B4 91 46 FD 35 5E C7' + 'CB 9D 7C 45 66 DC 5A F3 61 69 6A 1F 46 F7 EC 7D 8B B1 86 1F 3D D1 5F 95 6E BE 03 72 DD 6E D7 72' + '3D CF 3A 11 09 49 9B 4D C1 12 E1 FA C5 7F 82 58 8A 30 63 85 CB 13 13 8B 10 60 B9 2B 0A 0F 28 48' + '7D 34 E1 87 12 C4 61 19 4C 5D DF 39 8E D7 F6 4C 3B 33 E9 0E AB D1 7B 13 6D 33 90 75 9C 6A F5 92' + '92 61 BF DF 28 A7 EC 96 43 2A 2A 52 79 56 ED 05 A8 50 5A DA 24 68 7C 1A 81 AA EA 60 D1 93 FD 32' + 'D4 EA 4D B4 AC 5B 96 2D A9 6E B5 AF A2 2B AF 5E DD BE CC FE 3E 8F 9C 35 48 56 B3 B2 FB C1 24 21' + '60 91 59 84 10 BB CD 7A E9 AD 0B 2B 1C 43 87 9E 72 C6 FB C0 76 80 73 2C 21 DF C9 B2 F6 8E E1 EC' + '5E 75 E5 5D EB BD 1D E3 D7 3C DB ED 9E 1A F0 96 8D 66 56 2D 4E 2E F1 43 50 C5 74 B1 4A 1A E2 AE' + 'B3 A7 9F A6 74 72 EB 0E EA F8 96 FC CA D0 D2 9D A9 F8 32 AF F7 46 F0 75 9A 8F 40 EE 87 65 B2 72' + '51 87 C9 0F 24 E5 2B F7 D8 D9 BD 93 5E 2A 86 28 6A 1A D4 AA F5 AA 8E 5B 22 35 D3 F7 BC 63 08 F9' + 'F6 BF CD 6D 47 8C 0F 27 A5 0B 03 37 4E B1 08 4B 26 98 D5 D7 4A B6 51 68 6D 97 01 70 14 FC F8 DB' + '21 A7 F8 F4 CF 9E C5 6A 18 6C 5B 4F 07 EF 78 78 2E 80 BD 40 C0 6A 5B 69 14 D8 76 D5 06 FF AB C6' + '2D 59 40 99 51 34 A9 55 72 95 5A 57 2B D5 5F 9C BC E5 55 5E 2A 85 4B 85 A0 EE BB AB 97 2E 6D 4D' + '5B B4 B8 59 05 7C B8 55 CD E2 07 94 1B 80 E5 95 EC B7 0A C3 70 87 FA 54 F9 88 93 1A 81 86 D5 0D' + '99 B5 A5 C8 5F 41 72 D5 2A 74 AD C3 3E CB AE 4C 86 13 00 3D C3 71 3A 30 A5 B2 D9 61 C9 02 5B A3' + '82 66 35 85 64 BB DE 11 98 7E 66 5D 54 39 23 2D 6B B6 69 6E 40 55 59 11 EE 4F 1E BB 60 44 56 BD' + 'F0 5C 3F F6 6C 40 7C A8 8C 3A 71 9D FA 86 A8 7D 5A D8 D5 8D 4B E3 86 3E E6 03 47 19 E7 E6 AD 41' + 'CE E5 20 E1 2A D9 41 AA 6B 1E DA B1 57 CB 31 56 AD B0 33 4A AF 29 4A 16 50 A0 9F E7 E8 63 C6 74' + 'C1 11 05 DE 55 62 07 35 2C 83 18 CC DF 9A 7A 03 0D 04 99 B1 EE 8C DA CF 98 C5 71 6E 7B 7C B3 0F' + '4D E8 64 EB D1 D9 F2 CA 85 70 30 41 48 14 91 4A 83 1B DD DD 18 D9 7E 69 91 2C 2A F1 B0 6C 36 43' + '54 1E 83 74 DA 83 F4 B7 1E 11 46 C6 59 9E EA 40 41 56 01 FC 6B FF 81 5B 09 86 8C C3 08 B1 07 7A' + '1C 0C 2C 58 6D 16 17 7E 29 10 62 15 FF 9F 4C 42 A1 D5 13 73 CA A9 18 A9 7B 81 C7 D4 B3 B3 FC 5F' + '80 6D 7A 99 0E D9 26 2F 22 EF 1C 7C 97 B3 0C BB D8 B2 62 53 F4 A9 E2 2E 86 02 18 21 9E 93 CC 1A' + 'C3 B6 79 69 96 B4 E4 9A D6 6B 32 96 7F B9 A5 BA 2A DF 9D 2C E9 C7 D8 91 92 79 A9 A6 CA 7E BD CD' + 'E1 7B C1 26 BF AE 35 4C 2A 05 55 14 79 C9 C3 CC C0 60 39 78 81 EF 68 A7 C5 0E C8 E3 1D 32 C7 7B' + '99 CC 19 D7 D9 DA 22 5C 92 E2 93 1B AE F6 74 B1 65 AA 0B 15 4D A1 AF 8F 40 AA AD 7F 7A AC B8 05' + '59 FA 96 C0 40 3C C4 B2 0E AC E7 A8 70 05 1B 5E 22 6E 18 90 25 21 DB 13 0F 11 48 B3 81 B8 DD ED' + 'AA 2F 93 20 5C 7F A3 C9 5F 1F CB 9B C8 FB 47 24 97 AB FF 73 FD BF F3 D9 9D 61 89 35 71 BD B3 5C' + 'E3 CF 22 F0 CD 9F 34 2E 47 90 3F A0 6E 92 9D 2F D7 2A E4 8D 2E 48 F2 44 DE 90 B3 E8 FB 4A FC 16' + 'FA 3F 48 DB 8E ED E6 C7 66 E2 9B C8 C8 F4 37 CF 1C 65 12 11 8E D1 33 F9 2A D8 08 A5 D8 46 11 E9' + '25 8E 43 1D A7 75 19 1E 6F DF 56 7F F7 0E DD 02 86 83 24 73 C8 09 20 C9 1D 9E 8F 44 3B 50 3B 32' + 'EB 49 D4 23 1C 12 92 BB 5B EE 07 52 EC 16 2A 0F 05 46 5A AF C5 81 31 AB 52 B6 34 ED 4F 23 8E 56' + '98 62 CC 91 19 A5 63 B0 E4 49 BF 93 80 CE 4E 38 CD C0 9C 5C D5 3C 7C 1A 06 72 9D 48 E7 8C F3 8D' + '1A 68 2F BC 4E CA 42 F8 E9 0A 48 7C BE 20 C8 26 04 33 01 53 34 DA 8B 0E BB 22 7A 8F E7 1C 85 EC' + 'F1 89 66 69 96 AD 4A DB DA F6 5A B6 13 2B 1B E0 6C A1 FE 65 AB 4F CF 3E 8D 84 A8 2B E1 2C 70 81' + 'E4 DE 13 E6 BE 09 4B 9D 74 67 05 79 46 0F 26 39 F4 2F 55 78 92 E7 63 1C 7F CC F0 EB 34 23 05 40' + 'B1 24 30 DD A6 D3 CE 0C 9A E7 83 EE 50 46 FD C9 7F BF DD 22 4A 61 AF E6 FA 16 F5 B6 FE 87 AF 2A' + '33 82 39 FA 03 90 30 8E 30 A1 61 A6 B1 6F D6 81 6B B4 7E 7A 0E 89 70 5D 4B B3 F8 C7 65 3E 26 C0' + '49 49 BF 5E 5B 5B 34 5D D4 B1 D5 F7 20 93 7E 60 88 A5 81 43 4C 09 80 40 29 61 48 FF 53 46 21 07' + 'BE 37 5E FA 48 0D D5 17 03 BC 95 67 BD 36 9B E0 0E 18 B3 90 57 F3 B7 D9 BD B4 16 75 73 46 4A CF' + 'F7 B1 C2 40 9C DF AC 86 2D 70 3C 35 38 A9 7D AC 40 A5 67 29 CF 16 0F E0 5A 46 0B 9C B8 96 5F 9E' + 'FD 42 9C 63 19 4C 03 F5 8A 25 B7 6D 6B A9 4E B0 3E 24 97 B3 AC 44 8A 1B FA F0 01 F7 32 AD 60 84' + '96 C1 31 2D 7C C0 CB 68 58 C2 51 35 B8 FA 83 0C 77 16 35 63 59 C6 EA 9E B8 E3 FF 33 A7 E3 30 99' + '53 45 94 C7 89 52 03 21 32 19 6C 39 FD 12 D1 EB DF BF 2E EF CF F4 FA 7F 55 AE E4 A1 23 A8 69 62' + 'D8 B5 A2 A4 88 30 52 5A EF CE 63 50 F5 9D B4 66 02 3B D0 29 75 07 CE B0 B1 C4 C9 AB 58 F5 65 29' + '2E E6 7D 9F AB 7C BD 67 B8 42 3A D9 1A CE B0 6B E0 DB 6B A9 59 B4 88 51 69 16 A1 F1 02 3C 83 E2' + '1C 6B 2B 76 16 8B D0 D8 DF 51 74 56 7E 84 F7 41 60 46 AA 37 86 8C 0D EA D7 55 53 95 84 73 8C B1' + '8E 1C 2E 35 68 D1 A1 C6 8B 95 AD 50 AB D4 0C 3C F4 A3 DC 1E A5 66 6E C6 CB DB 51 18 C6 E1 6D 9C' + 'F5 8D BF AF 60 41 D2 98 F9 F6 BE FE D4 EC C1 6D 46 12 64 0C BA B8 86 7B D9 44 CE 2B 01 5E B0 E6' + '3E 5B DE CE FA D5 58 17 D1 95 CA AA 21 5F 23 6D 33 A6 14 7A EF E9 6F CE 54 F4 AA 71 3C C6 25 D5' + 'C1 AC 4D D2 FE AA D5 F7 F8 E7 68 47 94 AA AE 92 E5 9F B2 35 F2 B7 15 BA AA B5 BA 6B DB B7 8E 26' + '90 FC 62 6B C9 BE 4A 95 F2 6B F2 E7 C0 54 9A A8 15 40 AB 03 7D 81 09 E9 0B C5 28 8F 50 A6 09 EC' + 'F6 0B 33 09 02 C6 C8 2F 65 B4 68 90 28 33 CA 4A 98 6A 28 34 01 54 18 48 6F 50 43 81 A6 68 68 7E' + '53 F2 9F F2 9F 4A FC EF 79 1A 7E DA 5A 88 DC BE A1 F9 6F D3 3B 33 E7 3D 53 E0 3B 53 E0 3E 03 45' + '06 BE 4A E5 8C B9 E5 19 73 2E 70 46 6C F2 8F E8 79 67 B4 66 8E 9C EA 4F 68 CD 1E B9 9A 3D 73 DA' + '38 73 F4 97 60 E2 CE 68 DE CC 41 E6 9D 79 D8 19 23 14 75 46 3C F3 4E 0C EC 4E 10 E1 0E 6C E0 4E' + '78 C5 98 B3 85 31 66 1C E1 4E 00 D1 1D 91 F4 1E 11 F4 1F B0 FA 8E 60 E2 4C C9 FF 4F F8 7A 87 A8' + '7A 27 F7 3D 13 86 3A 83 CD 3F B9 E6 9E 71 E7 9C A1 99 3A 13 D4 3D 43 F6 1F F8 E6 0E 60 D1 9C C9' + '91 3A 63 D6 34 06 84 EC 4E AB D8 BD 9A F9 C7 F8 3D 83 4C 75 87 56 75 87 D8 65 8F 50 F1 8C B9 E4' + '19 73 FC 9E 99 EA 19 F3 E3 33 E7 C6 66 4E A8 EB 4D 41 F5 97 87 5E 78 67 62 76 26 54 EC 0E C8 E7' + 'B6 4B 9D 9D 78 76 BB B5 CD AF B6 68 CE FC F6 CC E9 96 3C 33 BA 32 C6 74 CE 99 C3 DB 33 A7 98 79' + '67 98 66 0F 30 F3 0F 34 D0 1F 49 EF 19 C3 4C 5E 1E D9 F0 9E 89 99 2E CB C2 F0 F4 8D 31 A6 3F D9' + 'A6 3E 93 EA BF EB 58 2B F5 9F 59 F6 1E B9 ED 97 47 C6 67 CF 8C D4 1F 59 A6 3E C3 EA 2E CB C3 4E' + '7D 87 D6 69 CF FC 68 0F FC 7D 67 D6 5E 17 87 CA 69 0D 29 78 6A 0B B2 E8 BB 34 E6 A0 FA CF AC FA' + '8D 31 76 69 8D 39 79 81 5D 22 FD 45 E1 F5 9F 57 FC B3 89 0F AE 03 70 1F 2B 81 F9 94 7E 7D 08 C1' + '68 D9 4A 52 A9 94 A0 81 43 75 C9 2F A1 29 AA 55 26 E9 E6 A3 F4 B6 6D 43 E4 57 9F FD 00 F8 95 E0' + '4E E7 76 6E 73 AB D6 6A AE 97 EA A8 3F D8 1C 54 EF AC 0E 7E 95 C2 03 82 07 A6 8B 86 4F 5C 3B BE' + 'F4 7F 33 AA D0 3F 25 9E D7 C9 D8 CD 7D 3F 4E 46 CB 5B 61 E2 47 2D 48 57 DB 57 EB 1D AD AD 5A A7' + '2B 87 55 72 70 AC 20 22 05 5D 7D 5C 5B B5 55 CB 4C AB 1D AA 7C 6D 28 68 FC 26 5D FF 82 B2 8C 95' + 'EF 9F 66 CD BC C9 53 18 EB 45 91 BB DD 1B 70 C6 0E FA 5B 7C 58 CD 50 9C DC 2D A6 D4 C7 FC 0F 2D' + 'FC 13 AC 35 47 56 66 EA 8C EC D9 33 F5 86 8B D3 49 2D 42 C9 23 C0 FA 7E 9F 9B 32 BF 37 55 D9 EC' + 'C6 6B 5E 9A AB 0B 3D 48 29 71 20 54 93 10 8B 47 4E 29 6B 29 B4 06 8D 69 46 5B E3 76 C9 47 46 4D' + '1A 51 E4 5A B4 A3 62 8D B7 99 EE 4B CC 7C BE 6F 46 4A A6 2B 35 5A 95 65 62 FE F9 02 C8 7C 5B 87' + 'D5 BE 16 05 F7 BC 2B 9E 7A C3 F3 F6 59 43 A5 98 18 DC 75 75 9E 94 E7 9A 87 36 CB 7A 1F 33 10 36' + '6A F0 AA D9 AB 2C 2A 3A 3B CA FE 8A F3 38 F2 BE C7 E7 A1 58 0F 94 3E 68 2A 00 EA CC D0 79 B4 4A' + 'F3 79 C3 86 3B 34 2A 67 CB 32 F7 61 64 EA BC 9A 78 0F 20 B0 C1 91 F0 C8 C0 F9 07 CA 2A C1 83 60' + 'AB B7 D2 DE D3 C5 DF 16 8D 4B 6F 00 B4 B1 69 F7 CB 1E 00 5F 75 02 27 6F 5E BE B4 65 6A 40 83 BA' + '2B 75 89 C9 C9 F2 E2 B3 61 81 7F D5 AF B4 55 DA 7D 57 69 5D B1 09 A7 0F CD B0 7D 75 A3 78 C7 05' + '58 5B 5B 0B 83 04 3E 29 81 05 86 D6 A8 5B E0 FE 94 D5 A9 A8 BC 67 E5 73 C6 36 36 37 1F C0 3B FD' + 'FE 7F D0 F8 7E 0D 33 33 BE 35 A2 F0 59 30 C0 C3 24 07 39 0E 38 2F 9C DE AB 05 DC C9 E6 38 BE E2' + '98 55 3E 5D 5B 7A 71 53 5E F0 62 CA BE D3 70 86 F7 72 7F 5B 22 9D E4 31 0F 02 E9 D0 5F D4 B0 9F' + '50 FB 42 15 67 00 CD 31 90 FB 71 21 E2 D5 9B 01 E0 78 0A B3 0A 82 58 CB 05 A9 88 E5 2C 26 2C 22' + '92 3B 36 A8 35 BF 11 05 9C 1F 4A 0E FF D8 B0 F0 65 8D DB DE CA E7 16 9F 6B 2F AF 99 76 11 03 8C' + 'CB 5C B9 16 9C CC 0A 11 99 08 98 6C CC 61 12 A8 D2 9B 30 29 8E 69 3E C1 4D 94 4A 62 BE 38 F7 98' + 'C5 E6 19 67 24 B8 67 EF 71 C7 F9 FE 34 7A CB 61 D0 BE 25 F3 19 8E 0F F0 49 3E 90 2C 78 87 89 BB' + '4F 60 B0 D4 03 8B 13 F3 F8 D1 C8 13 E0 FE 29 E2 9F 54 FA 8F 88 4F CC 21 33 E8 8E 17 DF 1E 01 E1' + '99 1E 1C 67 2B C1 CE 97 98 E4 CB 77 83 E4 B3 4E 7A F9 63 BA 83 27 65 CB 82 9D D1 A0 1C C0 78 04' + '19 59 8E E3 91 A3 1A 32 9B 21 A3 E6 36 49 77 B4 E4 4B F6 7B 12 EC FC 81 4E 42 05 29 02 82 00 13' + 'D8 25 F9 67 38 3F 4D 1E 83 F4 CF 0C 91 19 D5 C7 CB 66 DF 38 F1 CF 79 A0 33 63 9C F4 46 6B ED CB' + '4B 68 A0 32 99 61 9A E2 8C 88 E3 88 B8 D8 D9 4E 2B 18 AC 5A 9D AB 7C 8E A9 77 FB AA 3A 2E 0F 06' + '8B 2F 95 91 A5 E0 4E 64 A7 06 30 62 C7 9B 29 F4 E2 66 FB 2C F0 3E 81 82 8A 8A C2 C4 F8 7C 1C 2B' + '66 FA F6 A5 5E C2 00 11 14 11 40 20 1A D4 BC DE 93 6C 4C 9A 6E 27 8C 9D DF F8 69 B7 17 A1 78 A8' + 'C3 5F 1F 6A 19 D9 86 E8 20 13 F1 BD 6A 18 61 07 F2 C7 E2 DF 97 CB 1C CD 36 9A 63 62 D1 88 1D 06' + '86 C7 A1 D0 B1 05 A6 EE D0 E8 25 A4 21 68 6D 76 BD 03 58 57 A7 3C A8 E8 26 7E BF F2 D7 0B FE 65' + '6D 76 BD 60 44 61 D3 03 0C 84 C0 C6 E2 93 D2 EB FC 7B 85 F3 17 E8 18 FE 0D 73 E2 34 AB A5 E6 B7' + '2B 2E D1 3F D9 B1 A2 A2 CC E6 D3 8B C0 1D 3C C0 70 74 09 41 90 26 49 37 C0 C7 12 4E 8B B2 89 69' + 'BF BC C9 64 EA F7 F6 DE 8F 2F D0 C9 57 32 6F 20 23 69 AA D0 68 EC 46 8B C8 C7 8C 7F E7 0D 8F BA' + '8F 4C 9F E7 B7 DD 3F 7E FB 6B A5 99 50 DE 2F C9 8F 0F F4 AD CE E7 CF 7C F4 5C 2E 79 4D 37 27 BB' + 'F3 FB BE 8B 79 CD C8 73 A2 51 53 53 7C 32 B5 D8 EB 5B 59 A0 9E 4C 2E DD 84 1E 3B 38 AE F7 9F 96' + 'BF 8F 77 9A 2F 4C 05 FA E4 F7 72 95 89 7A B4 BF E4 19 67 8F 5C C8 BD 28 08 24 08 14 80 00 11 40' + '22 B1 55 75 11 FC F7 53 BA 7B A7 F0 34 E6 04 BE 97 E3 04 75 A7 E5 34 E7 E6 2F 63 5D EF 76 D5 0F' + 'DD 63 38 97 15 37 36 E4 F4 91 72 E5 27 97 57 F2 6A D8 B7 F2 2E 42 E3 C9 A3 17 87 CB 4B 71 71 32' + 'C7 26 7E 43 DD 3F 51 BA 56 97 76 6F 5B 65 76 65 E6 25 AE 94 6E F9 57 8A FF C4 04 2A 04 52 10 30' + '8C A4 9B 62 C0 4A 93 02 C4 BE 27 39 FC 3C 1F 4D F7 DF BF C3 F1 F3 0D 8F 14 65 A8 2F 97 DD 74 AF' + '0E 6B A6 1C 50 4A F1 07 8E F3 56 BB DC 76 0B EB EC F8 87 88 5E 1D 39 D4 9E 19 9A 3D 63 1E 67 CC' + 'F9 CF 9C F9 78 79 2F CB B3 AF E1 3A 13 C0 2C 51 AD A9 4D 1C E2 6B F4 67 43 2F C9 FC 93 44 23 2F' + 'B8 41 B7 8F EB CD 0E B0 93 81 FF A3 1F D1 1D 2F B0 48 DD A4 86 1E 50 4C 60 1A 46 08 C8 A6 B7 97' + 'BB FB 2D 58 B8 A0 37 FE D5 B0 2A 25 14 A5 00 80 04 00 3E 43 F2 74 79 FE 3F 54 4A 0E 48 DE EF 7E' + '8D E8 9E 1B CF EF F3 F3 FB 2F DE 7D 24 46 8F 47 07 A2 CF 8A FF F1 D2 E9 69 E0 33 FF 1B 59 0C F9' + '3C 83 0D D9 D7 EA B5 7E 27 50 B8 9D EB 8C 6A 4A 75 86 06 49 0C 26 14 DB 75 B0 AB CA EA EA EA AA' + '18 5D 2E 51 79 5B 59 CA AD 73 81 19 B8 2B 09 D2 CC C6 9B 4D 54 EA 73 7E 56 9E A1 A0 2B 4A C2 21' + '56 6A 0D 39 A6 AA C7 D4 B1 1B 18 BB A3 F7 8F 70 7B 2F 79 BF E5 8F CD F5 BE 83 6B E8 74 8F 3E 87' + 'A2 58 46 09 DA 93 A3 AE F5 99 0A 38 71 E9 F8 54 6C 5E 75 7F C6 10 FC BF 36 C7 45 B2 3B 53 66 3B' + '53 67 3A 31 13 54 62 42 D3 68 3F 11 90 89 84 AC 80 BA C5 16 BB F8 9B B6 5B 0E 7C DB 4C 91 B7 19' + '23 6F 32 46 E0 64 8F C6 64 8D C4 C9 1B 91 92 3A 5B EA EE 8B 92 37 53 24 73 A6 DC 63 CD E0 C9 18' + '6F 81 7C 85 DE 4E E0 DE 8F E8 74 C7 1A 7C 47 C4 71 E6 58 EA 8F 4C D3 9D F1 94 3F 59 E5 1C 91 EA' + '1F E4 D3 9D 79 D6 1E A1 E6 9C 31 D8 9E A1 A7 33 26 64 BB 3D 63 C8 3F 91 98 3C C3 C9 3C 93 B9 3C' + '73 1A 63 4E E8 F4 0C B1 EB 1D 29 72 7A 07 F5 3B E3 BE 3C B3 28 65 0E A8 EF 4E F8 CA 1D E1 FC CF' + 'E0 79 67 5A 7F 53 DD 3C 13 AF 39 CE 0E C4 31 31 FB 0D 29 E6 13 FF B9 83 48 CA CC 91 70 72 52 51' + '9C 33 A7 D3 01 B2 45 0D 40 01 14 14 8A 08 04 7C EB 08 F2 1F 21 FC 49 E1 3E EA 75 DC 07 26 F8 B4' + 'D1 9F 8F 1A CB D7 99 33 BA 97 74 F4 8F D9 BF 60 F4 4F 40 F3 EF 3A EE 1E 6D DB BF 50 F3 2E D9 E6' + '1D 77 23 AC 35 C1 E6 D8 68 06 83 64 93 F0 73 AF 2B 7F CD 3E 52 46 EA 4D EB A5 B8 E2 36 68 3B EB' + '24 4B 4F 4E AD 62 55 B1 23 CA CD 92 50 7E B4 14 53 0C 4D 7A 5D B8 70 39 FD 82 45 0B 3F AB E3 0C' + '07 09 E2 A4 4E 89 B8 1E 89 F8 CC FB D7 B4 C1 F1 D7 7C 7C 70 42 34 9A B9 D5 7B FE F3 41 E0 22 AD' + '41 E9 C9 E3 9C A1 C8 E0 E2 1F 2B 8F B4 3D 19 B8 0E 00 76 9B 6F CB 0C 78 7B 3D 01 E6 06 05 98 48' + '6E A3 C2 C3 1D 15 A3 97 2A 4F C5 E9 3D F7 89 91 FE CD 36 7A 30 12 AC 40 4C 3A F8 39 51 AF 65 77' + '76 7B D5 DD 3B 7D 8B C9 AF 6F 69 CA F6 2F 5E ED EE DE F5 FF D6 23 AD 14 8F AD 61 D5 9B A7 25 FF' + '3B B2 30 A3 B4 7C 27 C2 7B 97 C2 A0 D8 4A CB 06 6C 27 EA DA 95 7B 05 79 DD AA B5 6D AF 08 6A 0B' + '2B D5 4A DC CF EE 7E D2 AF 9D B5 D9 4F 68 9D BA 55 25 DB DF 5D D6 12 D9 42 97 97 B7 CF ED 9A C4' + '33 70 D6 D1 F1 5D 85 D8 52 8F 30 76 2A 07 83 DD 4A 81 50 27 46 4C 4E C3 27 6C 46 89 BC A7 08 E5' + '26 A6 BA DD 6A 89 FF EB B1 5C E4 72 B0 CA 8E B5 67 23 19 6B 18 02 EC F6 76 96 1E 48 6E B3 86 E4' + 'DB 6C ED 4B 02 C0 9C 21 1C 23 86 FC 4A 08 F1 1E 37 83 76 33 E3 3F 08 9B 91 26 24 C4 98 D0 6D 76' + '9B 4D 1E D3 69 B4 D9 DD 76 79 43 D2 F6 5B 2C 67 76 2F DC F6 99 F3 FE 20 69 70 B4 D2 C6 EF E7 9B' + '10 47 09 32 13 33 30 C9 98 06 0A 89 52 49 09 68 20 E5 7D C6 7F E0 62 EF 37 4E D1 F8 DD 30 78 07' + '16 EF F8 B7 A4 C9 3C C6 72 A6 A3 4C 9A C9 AC AD 04 16 AC 0C 32 03 73 E0 70 1B 80 DC FC 98 E0 FD' + 'C7 FF 09 F7 6F C7 7F F6 77 D5 CA 61 5D 31 0E BE DB 13 BA 6D 7F 3D 3A D3 4C BF F3 45 EC 49 D7 2A' + 'DC 6E 3B E3 15 A5 29 55 B0 02 00 81 14 A4 52 92 CD F4 6E BD 1B C9 74 BD B7 A7 ED B3 BE 06 98 D3' + 'B2 B2 CD 20 52 EE CE B9 E9 1C 7A 6C AB 9C B4 4A 18 4C 09 86 66 66 60 84 92 80 62 4E D3 0E 04 92' + '52 19 48 86 59 08 89 80 80 94 82 08 49 99 88 48 19 82 12 58 66 14 98 66 66 19 62 09 58 86 56 59' + '9E CE 70 CA 4B 10 C0 10 41 D7 CA 18 52 62 44 A2 44 90 EC E7 0F 61 80 C0 C8 90 90 4C 21 44 10 93' + '00 CB 04 12 92 CA 76 F0 81 84 A4 08 1C FC 2E 04 66 22 60 62 61 24 62 58 A4 28 1F C6 97 46 32 41' + '32 51 10 44 04 04 A4 42 13 4C 0E 13 02 E0 12 20 25 26 09 02 20 71 18 99 28 89 84 A1 91 8E C6 03' + '09 04 49 32 4C 44 04 C0 32 92 14 A4 30 C0 C8 10 92 49 02 41 04 91 D9 41 FE AC 8E 45 A0 88 64 26' + '18 59 52 04 84 34 B0 AE 03 7D 2E 02 52 60 A6 09 18 65 28 74 60 4C 00 5E 34 18 0C 98 50 C4 84 C1' + '01 ED 30 21 80 24 65 65 08 A8 13 BD 0C 3C 91 8D 7B 94 00 CA 13 0C 23 2C 25 22 40 49 42 55 2B 24' + '10 04 CC 13 50 4D 14 CC 25 24 10 CA C3 2C 83 2A 44 44 91 24 84 B3 08 4A CA B3 01 4B 41 2B 21 0D' + '33 04 2C 41 A8 87 12 B4 04 A4 24 31 10 84 24 11 21 9F 06 14 80 A6 98 60 62 52 95 92 25 88 21 26' + '58 02 11 A4 28 1C 12 18 12 06 65 94 95 22 01 9C 18 00 C2 12 04 24 88 44 2C C1 24 AD 05 04 92 25' + '2B 0B 22 4C C9 33 01 32 CC 23 04 B0 B2 0D 29 30 49 28 C4 09 2C 0C C0 C1 0C C2 A4 AC AC 53 03 0C' + '9B D8 13 09 0B 10 93 33 22 4A 48 CC AC CA B3 04 92 79 7D D5 8F B1 30 EA DD DF 6C EF 0E 5D C8 7C' + 'A4 C9 DC 9E 95 D3 FD 51 A6 A7 19 5D 21 75 0C AC 2C 1F 12 39 33 A1 ED 1D F3 E4 97 9D BB AE 94 EA' + '2D 5C 74 67 53 68 C5 12 BD 2F 54 97 50 FF 4A 79 39 62 A2 ED A4 14 6C 63 B1 E8 0B FB 21 33 4C 13' + '03 0B 0A C1 24 DD 99 7A 9E 7B 57 E7 3D 3F 87 E1 E5 31 83 75 A3 A2 01 5E 98 19 0C 86 43 66 7B E1' + 'FF 75 C7 58 9E D3 4C E3 FB 18 FF 7A 44 CD 22 DC 6C 81 FD 72 D3 E8 3F 58 E0 D2 C4 71 5D 43 A9 18' + '49 94 24 86 64 19 86 64 20 84 65 09 26 13 94 85 30 C8 90 CA 49 25 29 23 03 04 29 29 14 0C 92 30' + '40 CB 2D 04 42 50 31 0D 34 90 4A C9 01 49 40 13 0C 95 32 40 90 15 14 01 24 2C C2 10 90 1B 52 41' + 'C0 4B 48 04 04 38 21 C4 A1 30 11 2B 44 C0 90 91 80 80 C0 42 44 23 4B 38 C6 06 28 92 66 86 61 82' + '60 19 94 A0 60 08 12 21 6A 80 64 21 08 09 46 20 48 2F 2A 44 30 10 29 27 91 80 70 CA C7 DE 06 14' + '70 12 49 2B 0C A9 01 50 33 28 40 1D D3 58 54 C2 C0 10 D4 21 29 44 A2 45 42 13 00 4C 21 04 03 40' + '93 13 21 2C 11 04 C2 33 0A C2 C2 43 22 4C 0C 41 30 04 10 11 30 4B 10 B1 01 12 84 C3 44 90 34 11' + '24 84 31 2C 04 01 30 4C 30 42 4C 4C 2C F9 FC 03 88 88 19 82 29 96 24 18 0A 62 86 08 89 26 01 94' + '99 88 24 92 16 24 99 28 02 02 0E F9 A2 30 91 30 4C 01 04 10 04 8F 35 47 71 83 6F 93 06 51 26 21' + '21 82 60 5A 82 40 A5 7E A5 30 B8 02 09 18 58 46 66 4D 1E 27 A5 DB FF 14 58 FE FF B9 6C 96 4F 81' + 'D1 99 B4 CA 14 1E 82 80 4B 17 15 ED 60 FB 5E 4E 18 95 15 74 E2 2F F0 F9 BD F7 1A EC 4E F5 9F AE' + 'B5 67 F4 8D 99 BB 9B 61 B7 9B 79 BF 9C 91 C9 9A 63 6C 3E B3 BF 36 43 BF 36 D3 6E 36 F3 BF 3E C3' + '83 3E B3 C1 31 87 82 6F 47 82 6F C7 82 6A 0F D0 7E 73 F3 9B F1 E1 1B F9 D1 1E 11 A5 3C 33 4A 71' + '46 94 D2 9A 43 4B 63 B1 E3 B1 76 B1 C7 32 C3 8E 2E 56 E5 71 D9 91 2C 87 22 E5 8A 86 10 18 97 E8' + '0A 45 D2 1A 43 48 69 0D 21 C6 1A 43 A7 3A 83 48 70 66 90 EC 0E 43 FB 5E 19 7B 23 92 39 23 30 76' + 'C7 28 72 C7 2C 76 F1 6B 8B 5D 70 6E 55 5A 4D 55 7B 72 2B D6 4B 06 CF F1 76 8C 62 DC 8F FE F8 2D' + '03 AB 6A CC 03 69 4C 87 05 41 14 A5 0F A9 41 15 BB 64 F4 B3 24 64 72 FA A9 C4 9C 33 86 70 CE 19' + 'C8 55 FB 4B CA 18 6A 92 EA 17 D2 3B 33 C2 D3 AE A3 85 22 69 CF F2 75 47 EF 3A 73 A7 3F A1 FC 0E' + 'B4 F1 CF 54 EB CD 88 B9 2E 4B 92 E4 B9 2E 4B 92 E4 B9 2E 4B 92 E4 B9 2E 4B 92 E4 B9 2E 4B 92 E4' + 'B9 2E 4B 92 E4 B9 2E 4B 9C 5A DC CE 86 24 17 20 64 0C 81 90 32 06 40 C8 19 03 20 64 0C 81 90 32' + '06 40 E7 CE 7C E1 CE 8E 47 48 A3 D6 67 AD 51 28 72 06 48 E4 4E 4B 15 92 32 26 44 C8 99 13 22 64' + '4E 1E 46 33 73 54 42 8B D2 AD AE 95 8D 29 D2 99 19 15 C8 AE 44 C8 99 13 21 A4 D2 19 02 E4 E9 0E' + '90 E9 0E 88 E9 0E 8C B9 3C A2 F0 BC 2F 0B C3 E1 32 C7 90 5E 17 85 DF 6B 96 78 73 93 85 D1 ED 17' + '47 F7 2E 8C E9 74 7B 86 E3 F1 FE 9C BD 77 5D 67 DC F5 9C 7E 51 DB 7C 8D 69 BC D6 F3 C3 CD A7 3D' + '40 3E 5A 64 32 61 32 60 5D 46 54 E4 A9 57 18 32 3A 00 FE DA 7E C0 F0 06 CC B3 C4 1F E0 E0 14 93' + '3B 7E 40 DC 09 30 CC 98 E4 4E 76 03 3B 8E 82 6D 0E CF 68 4E D3 A0 C6 0D 75 CE 79 D8 07 AE 49 EB' + '02 C3 E0 96 71 89 07 11 89 1F 18 63 7F 68 7E 59 9E 6E A4 63 CA AE 72 08 4E B6 DB 8F F8 DA FB EB' + '3A 39 FE F3 0E 9B F1 6E 7E 4E F9 8F 47 48 07 4B 12 43 12 61 DA 4C 47 27 E2 95 9B 35 7A 5E 18 E9' + 'B1 F1 B1 09 C4 E3 5C B7 1B 94 69 B2 1B 29 AE F8 7D 58 FB DB 73 84 0A C6 AF 6C F5 1F 64 6E 63 96' + '4C 75 A1 98 40 C7 85 2D 01 78 2C 18 8A 18 18 AC 08 6B 80 6D ED D4 DD D5 87 8B CE D6 09 97 42 14' + '50 A0 B8 2E DA 3B 90 69 6F AE 2B E8 8B 80 AF 07 02 90 5E C6 DD DD C1 41 1F D8 84 F0 93 09 90 32' + '06 12 60 3D BB DA 07 4E 46 62 60 C7 F1 E7 8F 60 E3 C2 C3 37 FD 5E B0 51 41 07 2C 4C 0B 1C C0 58' + 'E4 CB 37 96 6E 8C 20 E4 2A A9 C4 13 B2 B2 A1 EA E7 F5 86 64 E4 E3 31 3F 8B EF E2 F6 6C F0 64 1E' + '74 FE 73 92 F8 A7 C5 3F B8 73 58 39 82 AF 8E 21 85 B0 61 B6 0C 71 0B F2 C6 EC D7 17 77 CE 60 45' + '55 82 A7 75 B1 3C 2F 62 DD 80 F1 DB C5 8A F1 52 74 E2 03 0E A8 07 6C 87 68 F6 1F 6C 97 75 5C DD' + 'C0 89 B0 DE 00 43 0A 96 A8 D5 FC 7E 16 DC 03 9D 24 99 29 25 F8 7E 6B 22 FA E3 E3 E1 F3 5B 0C F7' + '7A FD 93 AD D0 F8 CF FA 29 F4 41 F6 95 DA 56 45 57 A5 5F 43 F3 81 0F CF F7 D4 9D 0B AB 03 96 A6' + 'AC D8 DB D9 3C 2B 8B C2 8C 18 3E C8 B0 D2 A1 FD 55 D8 3D 4E 5D 66 5D 0D 2C 99 39 67 93 0D 8A 4A' + 'CB 0B 04 A4 24 24 42 C3 29 32 04 8C 0C 2C AC C8 13 03 13 01 09 40 9D 9A 4E 09 3C 67 72 FB 27 8A' + 'EB 1D 38 66 17 3C 60 60 93 D9 84 8E 18 99 82 53 FE E7 46 57 20 45 03 F2 24 0C 04 89 32 B1 32 4D' + '20 50 B2 C9 32 0D 2F 46 9E AD 30 64 02 40 D7 48 67 26 C9 30 65 66 12 11 21 91 86 46 49 42 81 20' + '25 20 08 3D DF 71 DB FB AF 79 FE 58 CC FC F7 7E E5 C6 62 7A 27 40 FB A6 E0 BC 37 4B 4A B4 B8 59' + '83 29 C2 35 2B C8 32 B3 02 D2 84 90 24 92 34 2C 13 21 02 D2 85 04 B0 2C 12 05 13 24 CB 30 C2 41' + '30 AC 30 32 30 B0 4A 90 40 90 C3 30 13 09 03 02 4C AC 30 04 CC 42 12 48 04 90 A9 42 41 20 4C 24' + 'CB 10 31 34 83 2C 09 42 94 92 4A 04 32 24 42 24 81 20 4C 70 93 D5 A6 04 72 24 35 30 AC 32 6D DB' + '0C 93 30 48 32 13 42 26 4C 86 4C B0 A3 4E 77 E4 A7 D6 67 96 41 75 4C EE E7 99 53 EC DD B8 D8 82' + '1D DE 11 AE 9F B9 E4 33 FB 82 F9 07 86 7E D7 6C 4D 79 C7 2C 8E 31 FA CB 72 DC 93 A8 C1 DB DF DA' + '60 26 98 18 64 86 4D CE F0 19 CF 15 8F 1A 0F 58 89 88 C9 50 95 09 90 1F 50 6F AE C9 B1 14 3C 04' + '93 24 C3 24 0C C2 A4 EE 2D 01 DF CF 1B D4 ED 72 B6 5C E8 A0 DF 7B 68 90 31 DE D4 EF 37 85 37 BE' + 'C9 C2 06 45 0A 32 88 F5 C4 71 51 C5 4F 3A 9E 52 72 9D F4 1B DD EA 6C C4 F4 1E CF 78 9E FD 3C E7' + '65 DA F0 7A DE BB 93 40 D9 CC 4B 47 0F F5 23 59 A1 A4 46 F5 1D 24 74 D1 5A 8E 27 C8 1F 5F D3 F0' + '9D 60 B8 F5 51 EF A3 5A 8D 1A 28 91 BE 11 9B 47 AD A6 0E 1E B3 50 EE 67 DB D6 7B 57 9D EC 50 68' + 'B2 3E C7 DE B7 C7 FC DF 3E 3B 63 8B 58 C4 C2 4C 30 26 4C A1 CC 1A E8 ED 50 E0 FA 2C 72 D1 5D B9' + 'BF 1D 87 9B 95 F9 7B FA 09 49 2E D5 FE 1F AA 8A EB 0F C8 C7 AD 55 E1 55 0C A5 1A AB 0D 36 87 DA' + '66 8A B3 5B 00 28 6A 54 2B AA 2A 68 11 49 A6 53 95 75 D5 FF 29 94 4F 5F F2 AA 35 5E 55 79 68 97' + '76 39 6E A3 6C AD E6 08 50 45 1D 25 A6 54 31 6D 0D E9 B8 7F 77 12 40 F3 E4 DA DA AE 5E 26 13 6D' + '9F F0 F2 58 BD 74 0D 7F 80 81 C3 18 B9 73 10 B1 E6 FE 1E 30 E6 35 21 B1 01 E5 18 99 46 64 28 59' + '9D 79 01 80 22 82 87 20 62 CF CC 2B B0 D0 30 6D 21 68 46 A4 7C D5 13 82 60 1D 36 9C 43 B8 F1 14' + '7B 67 28 21 C6 C4 54 C2 85 50 84 98 09 84 82 0A 40 8A 7C CC 20 60 20 88 88 59 83 FA 61 0C 04 2A' + '41 02 6B 61 1C 03 00 7A A8 38 2F 40 F9 8E D9 E7 DE C9 F8 AF 50 E8 9A 21 A6 28 92 61 92 64 99 88' + '84 82 49 DB A4 38 43 C9 F7 C5 B2 C6 E7 1E 4B D3 B6 77 C9 39 AF 49 15 1C A9 93 4F A7 46 18 62 58' + '20 F7 BA BE EE AF DD 3A 13 B9 33 BB 93 26 73 9B 3D 03 40 24 08 2A 14 98 09 61 08 08 16 24 12 60' + '59 A9 57 F0 BF EB 1B 6C 19 32 39 0E 3B D7 99 07 30 4A CC 9D 54 6B FF 9B BC E3 6E A6 6D 0D 1E 16' + 'FA 6F 0C 9A 4F D5 A5 5E D3 B1 B2 54 CD F2 B0 99 05 46 4C C0 0C 32 01 93 52 05 3E DD 21 C3 02 49' + '07 82 FA CE CF 8D 7C EE E7 2E E3 C2 CC 68 02 E8 8C 79 E2 F8 38 C9 8F EE C1 C7 CE 55 C3 25 6F EF' + '84 58 93 F1 53 27 E5 27 FC A6 C5 33 6C 12 78 45 80 8B 64 73 51 4E 8C 8A 35 E2 3B C1 1B D1 10 C4' + '64 04 61 C4 47 F9 68 9E 47 BA 8B 14 5A 88 F2 C4 62 84 59 08 E6 88 C5 88 F9 51 F2 A2 DC 46 ED 1C' + '24 67 11 C3 4D D2 78 69 C6 4E F5 38 E2 77 C9 D6 26 E9 3A 54 F5 A9 BC 4F C8 4E B5 39 94 D8 74 0E' + 'D1 57 97 87 8C C0 E2 10 26 EF 6B 25 87 7C F4 8F 68 FE 73 FA EF A8 7D CB ED 5E 89 F3 1D 32 9A 82' + '86 10 99 08 08 7A 3B B0 BC 27 C5 C0 78 BE E7 25 FF A6 37 1C F1 B1 CB 8C DA C3 47 8A 44 F7 3A 5A' + 'F1 BD 35 41 C6 2D 1D D6 22 B5 B5 48 32 E9 84 32 BA 73 A4 9D F2 83 48 36 E1 D4 87 48 1A A0 CF 3B' + 'C7 41 34 CC B3 04 C1 10 10 43 5C 0B 5D 3C 08 13 29 28 41 1A CD 1C 03 91 86 65 A4 62 4F 77 E7 BA' + '5F 61 D3 77 E7 1C D8 9E 3F F2 6B 78 9D 5E A1 4D 48 4A 45 21 24 33 AA 77 F8 D8 62 F9 8F AF 73 DE' + '61 CC 86 80 C1 12 94 3D 63 3F 09 F5 0F CD 74 1C A8 E6 60 82 06 D7 60 3A 96 36 47 BF 3B 03 B0 36' + '99 CD E7 79 76 DE 1D A9 C1 3F 0C EF BE AE F6 E7 74 71 8F 60 68 8D 71 CC 2C 4D 71 42 50 9A 43 48' + '58 1E 91 B3 35 E7 A4 50 15 47 62 78 F2 C9 A8 74 C9 AA 59 37 69 A4 57 50 77 C7 3E 7A A3 D7 9E 09' + 'C6 36 A7 17 45 BA 1D FB 7B D3 CC 3C 93 9C 3C 83 8B 99 DA A8 73 2C 12 48 9B 57 81 E8 7C 57 72 FE' + '3B CD BC 17 92 74 9F 62 F7 0F 4E FE B3 A9 54 E4 06 41 99 EC 7F C0 16 AC 13 ED 86 9F BC 6E 87 D8' + '5B 70 2E DA 5B 9D CC E9 4D D0 EC 8D 0D DB FF 5D EE D2 6A 16 65 0A 4A B8 41 E7 57 C2 A6 55 9C EC' + '9D A3 B2 76 8E D1 E5 9F 11 34 95 3E 8D 90 21 EA F5 B9 03 EB C3 60 1F 2F 3D B3 9C 26 72 58 9B 29' + '49 51 D8 28 C2 8C 38 8A 8C 28 C2 B5 D7 03 B8 08 EE 70 68 C2 90 29 24 8B E3 87 FB FA 9C 6E CD 41' + 'AB 35 AC C3 02 C3 01 12 01 12 1E 4D C4 C7 CB F9 F9 99 93 5A 26 78 89 1A 1C 10 A4 08 56 BE 68 54' + '10 98 78 8B AC 8F 24 06 10 8C 92 C9 26 85 F8 0E 88 38 DA BC 4C 77 E1 1D 26 29 E7 A5 C8 7E 0F D5' + 'FC 76 3D 8E E3 22 04 DD EE 97 3C 76 39 80 C8 C7 25 17 75 F7 9B 21 52 B5 2E 4C C2 99 33 F5 1D 21' + 'B6 E3 97 F0 AE CC F6 BB 15 CD 8B 72 ED C6 34 DB D0 BF C1 FB C9 FD 86 8B 19 24 49 0B 7E 93 29 26' + 'DD 8B 7F 9E 02 49 6A 7A AF 65 C3 1B 82 05 91 01 13 29 99 F5 36 FB 60 04 D1 FC CF 92 D8 B6 2D 6C' + '38 5D C7 76 CE EE 31 79 D1 6F 0F CC BC F2 8F 9C AD 4A BA 6A 26 D7 C0 C5 E5 36 8B EA AE 9C DD FC' + '66 F9 AC 30 60 9C 30 ED DD 54 C0 12 05 E5 CC A4 86 FB FF BA 72 34 1A 5D 0E C7 35 9B 88 FE 70 49' + '4B 01 82 BD 1B C3 48 25 41 25 4E 08 2C 41 54 EA 6A A9 9A 9C 14 10 7A 5C 12 97 98 59 88 99 87 0C' + '19 68 B4 1B 75 9C 9D BC C5 4E A7 16 C5 B8 0D 47 18 EF C6 6C 6F C2 D6 D9 D8 75 F7 D6 93 96 15 33' + '78 85 EB 36 20 E4 B1 17 D1 EC E6 63 AE 87 27 C5 34 1F 0B 43 B6 B9 62 99 45 E2 A5 67 79 AA 91 3D' + 'EA 96 BA 50 5D 32 0B 8B DD 6C 54 C8 F7 59 F7 DA 0A C3 05 03 23 E3 10 55 C7 BA ED C2 02 A6 83 A5' + 'F7 F6 B4 AC 07 13 CA B0 EC F7 11 AF 66 D0 35 DE E8 72 42 A8 36 01 BB 0B D0 BD 09 7B C0 F3 4E 9E' + '53 2B DB 12 9B A3 15 35 CC 85 D7 E1 1C F8 DE E6 1F 19 16 31 40 FC 0B FE F1 B5 7C 86 80 4F 56 A3' + 'BD D0 FB FB 94 17 DB F3 BB F0 24 82 51 08 25 10 82 49 39 F7 77 77 84 EE CD 03 BB 33 36 02 C2 88' + '9A 4A 22 61 48 4C 0C 92 06 13 30 0C 03 6D 71 2D B3 B8 9A CD 86 0E CF 67 89 75 69 B5 C4 FF F1 77' + '24 53 85 09 0D 63 95 D6 60' +} + + +LANGUAGE 0,0 CASE UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE +{ + '42 5A 68 39 31 41 59 26 53 59 A9 EB DF 7D 00 33 B1 7F FF FF FF FF FF FF FF FF FF FF FF FF FF FF' + 'FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF E0 4F EB 80 00 00 00 00 07 DF 09 40 00' + 'A0 80 50 01 F0 00 00 00 00 00 00 E8 50 00 00 00 00 A8 B1 60 09 28 29 28 42 A8 03 E3 EF 01 80 1F' + '60 44 01 00 09 04 00 40 00 CE 53 B6 49 77 BE EF 7D 80 D0 04 82 52 A9 86 D4 64 05 00 90 9B 36 00' + '00 C4 44 AD 93 63 06 64 00 98 00 00 00 00 06 C6 00 00 00 00 85 0C 2C D8 C0 00 00 00 00 36 30 03' + '62 2A A7 FE AA 51 13 47 EA 53 D3 23 51 EA 7E A4 0D FA 93 26 09 9A 62 1A 63 D4 20 F6 A9 A1 00 D0' + 'F5 1A 3C 43 46 9E 8C D5 36 69 EA 07 E5 24 C0 86 26 9A 7A 41 A7 A8 66 A6 26 4D 31 3D 19 02 34 D3' + 'D0 62 0D 09 93 34 9B 53 06 89 8D 1A 98 C8 C2 36 94 C8 7A AA 19 4F F5 52 13 D0 09 4F F5 14 F5 3D' + '4F FF 54 0F D5 3D 36 A3 D4 13 FD 53 D4 7A 34 C9 1E A6 8F D4 C5 34 7A 8C 7A A6 79 49 E8 D5 34 3D' + '4D 1B D4 F1 53 4D 49 1F E5 50 7B D5 4F 7A 4A 7E A8 01 A0 68 F5 1B F5 51 FE AA 0F 4D 4D 34 FF 54' + '9F AA 3D EA 88 3D 26 81 9F AA 9F FA AA 7E A6 A3 D4 C8 69 B2 9F FA A5 3F 54 FD 51 FA A6 86 FD 54' + '68 67 A9 FA A8 F2 9A 7F A9 A8 D4 12 A7 A4 46 D9 4A 95 43 D2 06 81 33 D4 26 8D 30 02 61 32 68 C9' + '9A 98 4C 02 60 00 01 30 04 C0 00 62 98 26 98 00 00 00 00 83 00 00 00 02 30 23 4D 0C 00 13 00 00' + '44 F4 61 29 42 A7 AA 79 10 00 00 00 01 FA A0 00 D0 00 00 D0 68 03 40 00 00 00 00 00 00 00 00 00' + '00 00 0D 00 00 00 00 00 00 00 04 9E A9 52 A6 93 4A 60 D4 7A 0C 83 4F 42 66 44 40 68 D0 03 20 0C' + '99 33 26 A1 A0 07 A7 A4 20 68 D1 A3 10 F4 80 0D 00 00 00 00 03 F5 40 06 80 00 00 00 00 3F 54 00' + '03 FD 54 00 02 46 95 2A 50 CA 1E A0 0D 01 EA 3D 26 D1 E4 99 3D 46 9E A1 A9 EA 07 A8 00 00 68 00' + '0F FD 55 00 03 35 07 A8 34 66 FD 52 4C 1A 10 00 00 00 00 06 46 4C 86 40 1A 68 00 00 06 80 D1 A0' + '06 83 EC DE FD BF 76 FB EF 82 DF C1 C2 23 FC 38 30 B0 C9 21 CE 88 89 8A 8B 8C 29 9F 63 E4 64 B4' + 'CA CB 6B DF CC CD CE 6C DF 3F 41 C3 97 4E F4 74 9E 1F E0 DF F7 3C 5F 5B EB FB B8 69 F2 97 5D 75' + 'D7 5D 75 F8 8B 2C B2 CB 2C B2 CB 2C B2 CB 2C B2 DF 5D 75 D7 5D 74 17 5D 75 D7 5E 54 A9 5D FE FF' + '7F BF DF EF F7 FB FD FE FF 7F BF DF F3 EE 55 57 39 E7 FE 81 E8 3E 85 E2 3C 52 36 B0 62 4B 00 4A' + 'D2 57 96 96 14 B0 25 89 7A DB 37 6D 96 DB 37 6D 96 DB 37 6D 96 DB 37 6D 96 D6 04 B1 25 81 2C 49' + '60 4B 12 58 12 C4 9B 37 6D 96 DB 37 6D 96 DB 37 78 DA 65 60 55 64 9C 1E 54 99 6D F8 B8 B2 E4 32' + '39 16 5C 86 47 22 CB 90 C9 B3 75 93 9B AB 76 4D D6 4E 0D D5 BB 1E EB 27 37 56 EC 9B AC DC 77 06' + '9C 3E 27 59 0E D1 38 0D 92 70 0C 84 A4 73 AC 65 A7 AD 07 6D 51 C9 6B 12 38 0F 8B 5D AF 5E 06 D9' + '74 AD DB 6D 36 F2 ED B6 9A B7 6E 49 11 99 0C 52 44 6E 43 14 91 1B 90 C9 19 0E D2 48 85 69 25 E6' + 'AA DD B6 D1 0A D2 4A 91 24 E8 49 24 49 24 92 49 EE 5D DD B2 63 6F 3B 5B CF 13 24 32 4C 6D E2 57' + 'AD BE 94 9F 38 4E EE EA 5B B9 92 48 94 99 9D 49 12 4F 33 1F 87 90 92 4F 47 33 30 93 DD 76 7A CC' + 'CC CC CE EC CD 52 C9 DE D6 B5 24 BB 12 49 3D 49 26 92 4C 81 A9 27 1B 6D C8 DB 6D A0 92 52 4A 6D' + 'B7 18 0D B6 50 44 B4 A0 6D B3 44 92 58 48 93 44 92 58 5E D3 B2 22 DD B6 D9 76 F1 B6 8C B7 8D B8' + 'D0 76 DB 8D 07 6D A4 6E 3C 6D 60 A3 64 94 50 49 56 0A 36 49 47 F2 9D B7 AC A0 BD 91 BD 46 4C 9D' + 'E5 BA 89 78 C9 6D 13 21 86 43 8A D6 24 73 BC F1 96 92 39 6B 13 4D AC B7 8D A9 23 E9 6E 6F 78 C8' + 'B3 67 61 D5 09 C5 98 8B 69 17 6F 1B 88 BB 78 FB 8E 4F 57 90 C3 6A D2 28 DA B4 8A 36 AD 25 8A 3C' + '7D 47 11 C9 0C 51 C4 72 43 22 C1 1B 2D DA 4B 12 B4 96 25 69 2C 40 93 84 12 70 CB 09 22 95 86 DB' + '4D DB 6D 96 2C 58 39 78 AC 9B 23 32 F3 16 59 B2 D6 5A C4 52 A4 71 23 67 0E 5E 35 DB 9E 0C 5D 1B' + '6F 1B 58 12 C4 96 04 B1 2E 99 BB 6C B6 D9 BB 6C B6 D9 BB 6C B6 D9 BB 6C B6 B0 25 89 2C 09 62 4B' + '02 58 92 C0 96 24 D9 BB 6C B6 D9 BB 6C B6 D9 0D E3 6B 1D BC 48 93 7E 1B 21 6D F7 A2 CB 90 C8 E4' + '59 72 19 1C 8B 2D E3 7A E4 67 B5 1E BA 7D 75 BD 9B D9 D4 47 3A E9 75 D4 9B AC 9C 86 47 1A C9 91' + 'DC EA FA 45 74 B0 2B 24 E0 36 49 C0 33 49 48 E6 E3 2D C4 42 B4 A8 E3 B5 89 1C 07 C0 5B D4 EA 60' + '92 17 4A DD B6 D3 6F 2E DB 69 AB 76 F6 43 91 E3 2D C4 6E 43 14 91 78 37 BA 76 46 76 E6 36 D1 0A' + 'D2 5E 03 41 DB 6D 10 92 46 89 24 93 12 24 92 49 26 D2 EE 93 B3 BB AE B2 47 9D AD E7 6C 90 C9 31' + 'B7 89 5E B6 FB 54 99 92 48 94 99 92 48 94 99 9B 24 49 3C CC 7E 12 42 49 3D 1C CC C2 4F 75 F7 B1' + '76 1C CC CC CE EC CE 90 CC EB B9 28 92 5D A9 24 BB 62 49 37 49 26 46 A4 9B 8D B6 98 49 28 85 2E' + 'C6 DE EE B1 2E 49 36 3B B9 92 44 5D BC 4A 36 B6 E6 49 11 0A D2 48 CB 78 D2 44 2B 49 23 DB B9 3C' + '0F 05 F6 F6 76 24 B7 75 25 BB A9 2D DD 49 6E EC 6D F6 1D 49 6E EF 5B 24 CD 24 EE EC 6D E4 24 C9' + 'D5 46 D9 EB 52 5B B1 25 94 C9 2D C4 94 84 99 1D 24 B2 99 25 B7 1B 62 65 E4 9D 46 DC CC C9 E0 EE' + 'F5 24 7D 74 92 EB C6 27 67 64 91 BD 4B 52 DD 6D 2E B5 2E BA 7D 74 DB 50 93 14 8D 9E ED 26 28 DB' + '68 E6 32 E3 92 33 99 0C 8E 35 DA 74 EA D5 11 CB 5D A5 A6 D2 38 C9 69 B4 A6 4C 9D B1 1D B7 8C BE' + 'ED 8D 6E 6E 9D 36 AD 22 8D AB 48 A2 82 49 1B D7 8F A8 E2 39 21 8A 38 AE 4C 8D 60 6D 96 EE 36 CB' + '76 92 C4 AD 25 88 12 70 82 4E 17 61 24 52 B0 DB 69 84 92 28 5F 88 C1 32 F2 5C 8B 11 CB B2 6C 96' + '81 B2 4D 1C C3 83 33 48 A0 38 3C 3D D5 81 EA 48 36 5E D9 6D C8 D2 D9 72 36 F6 AC 6C AF 7A DA DB' + '2D 0B 48 C5 04 62 82 31 41 18 C0 6F 3B BB 01 BB BB 01 8C 06 28 23 14 11 8A 08 AE EE C0 63 1D DC' + '57 5D D6 34 58 D1 62 D5 CA D5 E6 B5 55 E1 BD EB 73 E8 D7 27 8C B1 BE 36 C6 CE E6 C6 F3 B1 B3 BA' + 'A3 7C 75 06 CE AC F9 C9 ED 78 E3 C4 3E 3C B0 D7 AD A7 90 A6 BE 46 C1 B3 C9 51 BE 4E 83 67 77 5B' + 'E5 2C 6C F2 B5 BE 5A C6 87 E4 E7 3F 28 DC DF 95 73 F2 CD CD F9 7E EF CC 2E 6F CC B9 F9 A5 CC 46' + '25 96 CE BE 87 2E B9 E5 DF 13 D7 6C 39 77 D4 E5 D7 B2 72 EF CF 61 DF D2 72 E8 A7 2E 93 27 4A F4' + 'AC E8 F4 59 39 1D 16 76 5D 26 4E 5D 83 3B 1F 00 C9 CB B1 67 2E C9 87 67 CB A6 F2 F0 5D 08 6E DB' + 'C1 BD 4E CF A1 37 2F 09 B7 2E A6 0D CB C2 BC BC 37 42 6E 5E 1F 1B 97 69 8D 4B 4B 4B 42 D2 DE D2' + '83 55 68 2A D6 82 D4 68 35 56 C6 8A C6 C6 B5 A3 62 AD 8D 8D 15 1A 0D 15 ED 6E A1 A8 AC 6C 6E DB' + '46 C6 8A 9A EB 36 6E DB 5D 66 AA 9A EA 6A 2A 34 68 A9 AE B9 63 76 73 51 AA C7 3A E6 B1 AA C6 B5' + '6A 6B AE 58 D1 AB 51 AA C6 8D 5A 8D 56 35 AA B4 6A B1 55 5A 35 58 D6 AD 52 AB 1A 95 56 89 55 8D' + '6A AD 6A B1 AD 5A B5 50 6B 55 68 D5 60 AA A3 5A AC 15 54 6F EC 5D 72 82 AA B5 AA 82 AA B7 F8 EE' + 'BA 87 F2 5D 75 3F 97 3A C3 F9 AE BA 9F CF 9D 61 FD 14 D7 59 FD 3B 68 7F 55 D7 53 D0 DD 98 7F 5D' + 'D9 9F D9 B6 87 F6 D3 64 F1 57 FB 8E 38 D3 B7 BF DE 53 8B C5 3F C3 6C 1E 8A 9B 27 F8 DD 75 9F E5' + '75 D7 D1 DD 73 7F CD E1 E1 E5 5C DF F4 5C FF AA E5 1F F7 6E 57 FE 17 2F FC B7 2B FF 41 A7 A4 B1' + 'B3 FF 2B 7F F6 83 4E A1 5E 7D F7 06 A7 3E BD DC FB F6 0D 4E 7D FD DC FA 38 35 E6 74 9D CF B0 C1' + 'AF 3F 00 EE 7D 8E 0D 4E 7D 97 5D B8 BC FC 0A 1A 9C FA 6E A7 4F A6 86 A7 4F A6 EB CF C1 21 AF 3F' + '06 EE 7D 9E 35 E7 E1 1D CF A9 A6 A7 3F 0A EE 7E 1B 4D 79 F8 77 73 ED 34 9C FD 79 9D 0A 73 ED 53' + '5E 7E BE 86 A7 3F 60 F8 7E 38 E7 EC 49 AF 3F 63 4D CF B6 D0 E7 4E C6 DB F1 9F 11 F0 9E CF E2 0E' + 'E8 F8 1E F5 F1 3E DB 03 AB 9A CE AB AA DF 0B C7 A5 DD 6F 79 ED F4 D6 5E 82 9F 31 D7 9C F0 CF 7D' + 'F3 2F 1E 06 29 EE BD C7 BA F7 27 93 C8 8C 53 E7 3E 72 F1 E1 18 A0 8C 50 46 30 18 CF 3B B8 63 01' + '8C 06 28 23 14 11 8A 7E 13 B8 FA 1E DC C1 11 88 28 B1 A2 C6 8B 1A B7 BD 57 E0 DA B7 CE FC ED D7' + 'AD 6D 6D F4 8B D5 36 31 62 8D EC F3 72 8D 1D 2B 97 99 EB FA F1 EF DD AE 6F 24 B9 63 46 8D 14 51' + 'EE DB 95 D3 94 51 8C 63 18 8C 46 31 AB F0 2F A2 6D F4 2B E8 1B 7E 03 D9 7A B0 F0 5B EF EB E0 3C' + 'CB CC 78 DB AC B3 D3 2C 9F 27 C1 D0 BA 75 B6 4F 92 B3 D3 EC 9E 2A CF 13 43 E4 6F C8 74 8F 54 D0' + 'A9 4F 5A D3 E3 DF 79 57 B2 FB C7 57 B3 5B 7A A5 F0 ED 05 11 A0 B0 68 8D 11 46 34 63 63 1B 14 68' + 'A2 C5 1A 31 A2 8D 18 D1 A2 28 8A 22 88 A2 34 45 11 62 31 1A 23 11 62 28 8A 22 88 A2 32 46 92 28' + '8D 11 7D DD C8 D1 11 16 22 88 B1 14 46 88 A2 35 F8 2F 61 78 F1 18 8D 24 63 62 8A 8A 4A 8A 2C 18' + 'D8 A4 D8 DE E3 BB 5F 2C B9 8D 8D 1A 31 5A 35 AB D5 2F BB 2D F3 8F 9B 5B E6 9E F1 AF 49 F3 2D 7B' + 'B7 DD 56 FB A2 FB 9A DF 72 6F 58 D7 AC 5F 6F 6B ED CF B6 B7 CC 7C 0F 5F 6C 57 DA DF 6A 6B DD 37' + 'CB B7 B9 57 B8 5F 2D F2 5D AF 95 7D A5 BE 51 F2 6D 7B FC 8F 83 AA F5 04 79 15 E3 BE 08 AF 1D F0' + '9E 3F 38 B1 94 D3 18 CC B6 F2 0D 34 D0 D3 65 36 F2 7A B6 31 88 43 31 42 10 CC 93 20 D0 D3 43 4D' + '94 DB CE 18 CA 69 8C 66 5B 79 C3 4D 34 34 D9 4D BC 8C 65 41 45 08 43 32 4C 91 44 D0 D3 4D 36 F2' + 'C6 53 4C 65 34 DB C8 D3 4D 0D 34 D3 6F 2C 65 34 C6 53 4D BC 8D 34 D0 D3 4D 36 F2 C6 53 4C 65 34' + 'DB C8 D3 4D 0D 34 D3 6F 2C 65 34 C6 53 4D BC 8D 34 D0 D3 65 36 F2 C6 53 4C 63 32 DB C8 D3 43 10' + 'D3 65 36 F2 C6 53 4C 63 32 DB CF 69 A6 86 23 49 B2 9B 79 ED 8C CB 5A 18 CC B6 F3 DA 69 A6 8D 26' + 'AE EF 3D 59 66 6D 68 B2 AE EF 3D 2B 56 AD 1A 56 9A 6D E5 8C A6 98 CA 69 B7 91 A6 9A 1A 69 A6 DE' + '58 CA 69 8C A6 9B 79 1A 69 A1 A6 9A 6D E5 8C A6 98 CA 69 B7 9C 34 D0 C4 34 D5 DD E5 B1 99 69 8C' + 'A6 DE 4B 56 AD 16 AD 94 DB CB 11 62 B2 CB 33 77 79 3D 55 35 16 26 11 14 85 49 33 FE C5 CE 1C 33' + 'C5 C3 87 0C F3 9C E1 AE 2E 2E 2E 23 8B 9C 2B 9C E6 78 B9 C3 86 78 B8 70 E1 9E 73 9C 35 C5 C5 C5' + 'C4 71 73 85 71 34 D8 CC B4 C6 33 2F 9C E1 AE 72 90 B8 B8 B8 B8 B8 B8 9A 6C 66 5B 19 96 9B 29 A6' + '9A 18 9A 69 A6 9A 6C 66 5B 19 96 9B 29 A1 A6 9A 69 A6 9A 69 C8 43 52 10 CC 53 8F 86 B9 CA 42 E2' + 'E2 E2 E2 E2 E2 69 B1 99 6C 66 5D 95 6A D5 D9 5B D8 CC EF B3 B3 2F 66 CD 9A DA B5 77 F2 AB 2D 36' + '57 91 85 71 73 87 08 6A 42 0C 67 4D 3B E2 CB 4D 8C CB 4D 96 66 EC B2 CB 3A B5 76 55 AB B2 CC DA' + 'BB 2C CD D9 65 96 75 7B 2B 6B 6B 7B 2B 6B 6A EC AB B2 AE CB 33 76 54 65 34 D3 65 37 43 4D 94 D9' + '4D 8C B2 CB 3B B5 6A EC AB 56 AE CA BB 2A EC B2 CD 5D C5 96 9A 6C A6 9B D5 9A BB 2A FA 2C B2 F3' + '67 76 AE CE 8C 9E 41 35 86 9B 8B 32 10 86 A1 0E 19 38 70 9C 16 B8 B9 C3 86 4E 2E 70 AC 71 72 15' + '21 08 6A 10 86 48 29 0A 8A 42 19 22 90 AC 45 21 52 10 86 A1 08 64 82 90 A8 A3 28 69 B2 B0 D8 CC' + 'B6 33 2C 63 32 31 36 53 4D 48 51 14 85 63 0C 65 36 53 65 31 8C CE 08 A4 E2 CF 17 17 38 56 38 2E' + '70 A3 87 08 66 42 A4 2A 71 70 E1 AC 71 73 85 71 71 73 85 11 48 51 08 43 32 15 21 50 84 33 88 A4' + '2A 29 E0 43 24 52 14 42 10 CC 83 32 C6 33 38 6F B6 69 A7 E4 DD 19 22 90 A2 13 B8 6A 43 C0 E8 D4' + '21 0C E2 4E E1 A8 A7 3A 32 45 21 41 08 A1 99 0E 10 D4 21 E4 57 0D 62 71 70 CF 17 3C 38 64 E2 90' + 'A1 8C A6 CF 01 9A 63 19 9C 3E 28 66 29 C8 64 8A 42 86 45 06 70 67 6C 63 33 8B B2 AF 65 1B 5B D9' + '46 C6 AC B3 4D 94 C6 33 38 BB 2A F6 51 B5 BD 9B 1A B2 CE DB 29 8C AD DE 6C D5 EC A3 6B AD 9D 9D' + '9A BD 95 B3 65 6F 65 6F B2 8E D7 7D 9D 9D 9A DA EC EC AE ED 56 D1 B3 65 79 22 69 A6 8B 1E 59 E0' + '4C 43 72 10 B3 58 88 63 29 B2 9A 69 A6 86 45 3C 95 70 E1 C3 7C 5C E1 C3 38 89 B2 9B 29 A6 9A 68' + '67 33 08 42 1B 92 E0 CE B1 35 9C C8 54 85 49 79 89 A2 10 84 21 D4 51 8C CE 1C 55 21 51 45 21 51' + '4F 24 AC 43 8B 87 0E 1D 71 71 73 87 0C E1 CC E6 42 A2 8A 42 A2 B4 69 42 77 08 43 B8 AD 77 08 67' + '12 67 32 15 14 52 15 15 A2 0C 63 34 D3 4D 8C CE 1A 6C A6 9A 69 AB 45 91 31 8C E9 A6 9B 2B 16 B8' + '9B 29 B1 99 6B 16 4C B1 8C 63 18 C1 B5 56 AE CA BB 2C CB 45 A4 59 65 96 59 65 96 16 B7 B2 B7 B3' + '66 71 D8 D6 CD 9B 36 6C DD A0 DA 6A EC AB B2 CB 35 8B 2C B2 CB 2C B3 78 DA 3B EC AE FB 3B 32 1D' + 'F6 76 7F C3 96 59 65 E9 62 C5 76 56 F6 6C D9 A3 6C B2 CB 2C B3 76 AC B2 AE CA BB 2C B3 45 F3 90' + '84 39 AE 1C 38 4E 2E 09 B2 B7 D9 56 B6 89 B3 66 CD 9D 6F 65 5F 05 57 65 16 CA B5 E0 9A 2E CB 33' + '65 96 59 67 45 BC D9 A2 EC AB 56 BB 56 5A B3 36 59 51 8C 66 8B B2 8B B2 CC DA B5 6A CB 2A CB 36' + '6C D9 D1 B5 D6 CA 37 92 B6 B6 B6 8D BC DE AC B2 CB 3B 3A B2 D5 76 8D F3 15 6A D5 39 57 04 A9 C9' + '52 8D 48 2E 0E D1 5B BC BD 1A 2A 68 95 92 A7 25 4A 2D 6C B2 9A 68 6F 14 D3 65 76 2E CE F1 D9 D9' + 'AE D0 D5 AB 5E 1D 53 78 A6 9A 1A 6C AD 9B C6 CD 9A 37 BA DA F1 15 E8 AD AD A6 8B 5D 59 57 66 8B' + '2C B3 BB 38 A8 EC 4D 34 F4 53 4D 34 5A EA CA BB 34 59 65 9D 96 BA 56 AD 5E 8A B5 76 55 88 E8 B2' + 'AE CD 16 59 D1 B5 A5 B5 BC E2 BB 4C 68 A8 14 AB 99 C9 52 A5 2A 82 95 08 26 76 73 34 68 D1 B4 38' + 'F9 B5 77 9B C5 96 59 DD CA 36 26 9E 9E 32 D3 4D 17 65 5E F1 B3 66 CE 86 8B 15 AB BC 55 AD A3 6F' + '39 BB 2A EF 16 76 6A EC CE 6D 5A BB C5 5A ED 16 B7 B2 B7 BC 6C D9 A3 68 D8 B6 B6 BC 45 E5 6B 2B' + 'C3 B2 9A 69 88 D0 CA 36 E9 AC B3 B1 8C E8 69 A3 6E 9A CA 6C A6 9A 66 A8 58 65 1B 74 D6 59 D8 C6' + '74 35 A4 D1 B7 4D 65 3E CA 69 A6 2D 32 8D BA 6B 2C EC 63 3A 1A 34 26 8D BA 6B 29 F6 53 4D 0D 69' + '94 6D D3 59 67 63 19 D3 16 93 46 DD 35 94 E6 2A 28 88 A4 28 B9 51 66 13 10 87 43 4D 1B 74 D6 53' + '78 A6 9A 1B 28 DB A6 B2 C7 86 69 A2 42 A2 2E 54 59 52 62 A2 8A 10 86 4B 95 16 61 31 0D 44 48 54' + '45 CA 8B 2A 4C 54 51 12 10 C9 72 A2 CC 26 21 A6 3A 6B 1B 74 D6 53 65 35 11 21 0C E2 E5 45 98 42' + '1A 88 93 15 16 2E 54 59 53 BA 69 A1 E8 66 4D BA 6B 2C EC 66 9A 66 8A 68 DB A6 B2 9F 74 D3 43 D6' + '19 93 6E 9A CB 18 CD 31 94 D1 B7 4D 65 3E EB D5 54 51 13 A2 19 2E 54 59 87 79 90 86 49 D6 0A 88' + 'B9 51 65 45 C5 C5 C5 C5 C3 87 6B 86 87 CA E2 CF 0A DA E7 0E 19 98 51 17 2A 2C A8 A2 8A 28 A1 0A' + '2E 54 50 51 48 43 27 39 49 71 1C E5 71 1C E6 2B 8B 8B 8B 87 0E 19 39 CA E2 CF 0A 90 86 58 9A 36' + 'E9 AC A6 9A 69 A8 42 19 2E 54 59 85 48 43 38 78 4D 1B 74 D3 4D 34 5E 15 A2 EE AE CA BB 28 D8 8D' + 'EE B6 B7 75 6A D3 46 B0 9A 1B A6 CE CC B6 33 24 3A 21 92 4A 8A 77 51 45 11 05 D0 A2 24 A9 0A 90' + 'A8 88 13 10 CB 4D 3E A9 A6 EB 0C E8 A6 89 2A 43 BC C8 50 C5 A1 95 6A D5 AE 26 9A 18 33 C4 59 8A' + '29 0A 8A 42 88 31 99 69 A6 9A 69 A1 89 89 A6 9B 29 A6 CA 06 0C 66 5A 69 BC 53 4D 60 6C A6 8E 4A' + '90 A6 CA 18 C6 66 D5 AB 56 AD 62 D5 D9 56 AE CB CD 88 B1 6D 35 E3 1D 34 F8 43 31 62 42 A2 92 A4' + '21 08 74 41 45 14 95 14 E4 33 16 24 2A 29 2A 42 42 1D 10 52 54 95 14 65 35 86 C7 96 E9 B1 8C D0' + 'C4 DD 37 4D 39 0C C5 34 42 6A 4A 90 DC 21 D1 05 A5 25 49 51 45 CE 15 C5 8E 70 E1 CD 73 95 CE 15' + 'CE 1C 32 70 5C 5C E5 73 95 C5 C5 CE 15 C5 8E 70 E1 CD 73 95 CE 15 CE 1C 32 70 5C 5C E5 73 95 C5' + 'C8 54 44 21 09 A9 2A 42 10 D6 22 8A 4A 92 A2 90 A8 88 42 13 52 54 84 21 AC 45 14 95 25 45 38 70' + 'CF 11 C3 87 0E 6B 9C AE 70 E1 C3 87 58 E2 E2 E7 2B 9C AE 2E 6E 19 88 86 88 4D 49 52 1B 84 3A C4' + '5A 52 54 95 14 DC 32 78 28 68 84 D4 95 21 E0 70 D6 22 8A 4A 92 A2 9B 66 46 64 63 D3 74 D9 B6 6B' + '0D 65 37 4D D3 4D 48 51 05 08 4C C9 52 15 21 58 8A 29 2A 4A 8A 28 86 31 8F 4D D3 65 35 E0 B1 14' + '52 54 95 14 52 14 42 10 9A 92 A4 29 AC 34 D3 74 DD 34 D9 43 18 C7 A6 FA CE A8 54 12 5C 76 03 15' + 'B4 E9 E3 76 1D 5D 3A 12 84 97 25 81 1F 59 C5 86 4B 2F 57 74 AC EC B3 58 B5 77 57 74 95 DD 1B 36' + '6F 3B DD 2D 95 C6 1B B6 14 B6 2D D3 C6 E9 67 1D D5 B7 6C 53 1D 82 A5 09 2A 64 12 84 1C 82 09 2E' + '0A 82 0E 4A 95 2B 15 04 38 81 14 4F 2E 8D 04 AA 64 12 85 31 4D DB 0D DD 3E 06 E9 E3 74 F0 4A 02' + 'BB C2 AB 28 57 82 2B 98 E9 60 C1 95 B5 8D 1A EA 83 D7 C3 BC 2C 6A 5A EB 5D 02 3A D2 49 6C A4 07' + '91 79 99 5E 1E 68 DB BC DF 32 E5 78 E9 CF 34 04 40 06 D3 C9 E4 78 DB C3 C3 BA AB 9E 72 F2 57 8F' + '30 22 08 80 06 31 6F 17 90 C7 9D D7 9D E7 79 3C 79 CB CD 16 F0 F0 BC 79 BD 77 DF 79 ED 07 88 B0' + '65 65 6F 76 60 32 23 0B 17 7B CE D6 01 2D EE 80 EF BA A4 39 54 02 57 CA 4A E9 0E 55 00 95 D2 57' + '48 72 A8 04 AE 92 BA 43 9C 62 C3 77 4D BC 63 93 9C E0 AA C1 82 A4 BA 91 E3 04 57 30 60 C6 F2 B1' + 'DA 18 39 CB 16 96 56 27 8C 72 A8 06 EE 9B BA 43 95 40 25 74 95 D2 1C AA 01 01 4A E9 2B 42 95 2A' + 'BE 73 06 65 D2 57 48 57 18 B0 5D F2 D2 C5 E0 DD 55 60 C1 4E 5D 48 F1 F5 7C E6 0C 15 25 D4 8F A3' + 'A3 9C C1 A2 B7 6E B7 5E 40 C5 55 07 6D DF 10 E7 29 01 4A D2 BA 42 95 0E 72 0A B7 6D DD 30 87 38' + '15 91 CC 15 5D CE F7 BD 75 15 C5 6B 6F 88 51 37 5A 6D A4 CD 21 A1 2B A8 AE 25 0D 21 44 DD 60 44' + 'A2 DD F0 8E 6E 5C 05 DB 08 68 A4 39 81 8C 6E 35 05 31 CC 10 64 98 87 08 A1 76 86 74 F3 BD 77 91' + 'E6 B1 89 80 0D 55 F5 D6 79 7E 51 97 E0 F2 5D D6 3B 58 D2 7D 75 96 F7 96 A0 6F 0B 0F 26 6E B1 DA' + '31 A5 E0 4E B3 26 F3 15 A3 B5 8D 23 9A AB 9D E5 BB CE 74 34 71 8E 11 5D 1B E8 21 BB 33 8C 71 0E' + '60 E6 EA CD 0C 6E EE 71 8E 21 CC 12 B4 2C D0 C6 EE E7 18 A4 39 83 75 66 86 37 77 28 BB AE DC BE' + '14 F3 D6 78 F9 D6 A4 79 C6 AE 89 9A 0D 2C 43 AA 6F BC B7 79 36 87 DD 63 49 D2 BE BA 79 D7 5B 95' + 'BB 7D 4B E2 09 74 8E EC CA 92 FA 97 C4 12 D4 77 66 49 74 C7 32 B2 13 25 A1 44 71 E3 25 BB 43 94' + 'F3 19 F0 B2 E3 BA 83 9D 0E 55 EF 6F 49 6E EE 50 0C 21 CA DD 3A 95 49 75 03 E0 43 9C AC 31 46 FB' + 'B6 67 18 41 0E 6A D7 B1 D6 BB AE 40 C7 3A 1C CA D3 A7 92 5D 00 78 39 07 39 2E 18 B9 25 F0 F0 71' + '8E 75 BA B5 72 0A 03 05 71 77 32 D7 18 A6 2B 4A 73 C4 CF 5C 92 E3 76 D6 31 D2 D6 AB 4B 03 DF 7B' + 'DE F7 B3 6B B5 D7 4F BD 76 DD F2 BA EB A9 A2 A9 02 4E 6C 72 49 38 85 13 D8 8D 47 24 4F 7A C8 1B' + 'EA 17 D4 EB 75 CE AB 72 75 72 64 3D 3E 9F 62 7D 9D 99 03 14 83 D4 77 B1 F7 76 AE E3 B5 6B 6B 1D' + '2F 0E B1 5D 3E E4 8F 75 75 6B 7C AC 77 3B CF 73 79 92 3D 5A B5 B5 8D 3A E9 74 FB 6D BD B7 4D 5A' + 'C7 4B B4 69 F4 DE D9 BC 78 23 2B C1 34 FA BB DA D1 C4 2B B0 D9 1A 35 EE 98 38 45 6E 6E 68 9B 2F' + '62 E5 11 56 29 82 FA EF 3A ED 69 04 58 CA 8A D1 7D 5D CB 9B C1 DA C6 51 68 BD 5D DE FB 31 D2 2A' + 'EA D1 7D 5D DD F7 82 77 58 CA 2D 1A D6 F7 BD F6 77 DE 03 0B 09 61 22 B0 85 8C BA B4 68 BB BD F4' + '13 BA C6 73 5B 46 B7 DF 7A B4 1D 23 2B 4B B4 4E B7 D7 77 D8 74 8C A3 6B 9E 25 1D 5D EF 58 0F 04' + '57 1E 70 73 AD EF 7D 60 34 8A DE E9 E5 6B DD D5 CA A2 2A F6 E0 E5 45 24 5C AA 22 AC 53 1C A6 5B' + '71 D5 56 8A C1 A3 95 A6 46 AA A8 8A B1 4C 72 99 78 86 0E 70 0A B9 8C F2 9E 3C 63 07 38 05 8B 57' + 'CA 58 B1 33 95 55 A2 88 C9 75 C8 A6 30 C7 38 05 58 B7 7C A6 DE 31 25 F2 AB 05 CB E5 4C F0 93 A9' + 'AA 73 80 73 05 ED F0 BC D6 F7 DE 74 F0 06 10 24 09 05 63 06 6B 79 C1 B4 6F 7D F7 A3 05 5E 61 AA' + '82 A4 98 C5 72 AC 72 DD F2 9E 5B 6E 25 5C AC BA 99 CA 82 02 28 12 0C D5 67 75 9E A8 29 06 EA 83' + 'BB AD EE 8E B7 40 6F 35 8D D5 76 8D 62 CA AB 15 40 71 5D A0 B1 67 39 99 7C 42 90 AC 57 CE 2C BE' + '21 48 12 B2 AA AC 71 04 11 59 55 40 71 65 A0 B2 EB B0 56 F8 5B E6 82 35 2D 3A 29 8A D5 7C D3 7A' + '66 49 6C 52 1C C8 72 15 26 26 2A D5 F2 E5 91 0A 86 0A 63 84 71 43 90 29 70 52 1C 23 92 1C 8A 64' + '14 85 11 59 22 31 CC AA 22 B0 54 91 18 1C BA A2 2B 4D D6 EE B3 B2 69 AA 42 A1 BA DC D4 74 BC AA' + '22 B3 2D E3 45 EC CA A2 29 E5 CC 88 C2 F2 9F 05 21 CC 18 5A 2C 72 AC 73 43 6D 16 2B 96 29 86 DA' + '2C 72 AC 71 24 4A 06 86 0A AB 39 84 30 DD A1 56 2B 2D 92 F6 EA B0 71 AC 4D 01 82 C7 0E 59 37 40' + '67 65 F1 86 4B 34 85 56 0E 5A C2 78 C3 37 4C 32 F2 AA C1 27 93 E5 CA F1 BE 89 84 D3 3F ED CB 9A' + '4F CF FF CF CF E8 77 94 74 67 BA 54 3E 95 15 2A 9A 7A 8A AA C6 75 BB F8 2B 3D EF DF 51 BE FB 77' + 'BF 66 E7 79 BB DD 57 2C B0 DE 74 A7 E7 E2 A7 E7 E7 A7 61 3A 26 9C 5A BE DA DF B5 79 FD 19 33 C9' + 'CA 6B DF 6D A0 EF 44 FD 48 93 92 43 42 F0 7F 04 68 E1 20 E6 54 F5 69 69 28 FA 94 5D 3E 94 FB 4F' + '14 FC 54 EC 52 34 68 D1 A3 46 8D 1A 34 68 D1 A3 46 8D 1A 34 68 D1 C2 42 41 C1 C1 C1 C1 C1 C1 C1' + 'C1 C1 C1 C1 C1 F0 38 1C 0E 07 02 08 20 82 08 20 82 08 20 82 08 20 82 08 20 82 08 20 82 08 20 82' + '08 20 82 08 20 82 08 34 34 34 34 34 34 34 34 34 34 34 34 3D E7 BC F7 9E F3 DE 7A 5E 97 A5 E9 7A' + '5E 97 A5 FB 3F 9E F7 D0 10 00 00 00 00 00 00 00 5B F6 F5 57 D2 EA AF E0 80 00 00 01 E3 BB BB BB' + 'BB 80 00 00 0A D7 99 FA 6E E0 00 00 00 00 00 00 00 05 BC 95 57 93 55 79 00 00 00 00 F1 DD DD DC' + '00 00 00 77 75 7D 23 7E 35 BF 18 B5 FA CF A0 DF 40 F7 BF 3C F2 7C F3 F7 9F 7D 7D 2F DF 9F BD F9' + 'F1 E7 44 8A F8 A1 C3 8B 16 11 82 C4 A2 C8 C3 FE CC 16 A5 12 71 A3 87 C2 0B A3 82 F8 E1 2B 1E 2C' + 'E4 04 AD A1 00 B5 93 12 FC 31 2F 6C 40 18 5B CA 8B 89 61 73 C6 17 52 E2 EF 8E 3B 73 02 F2 60 75' + '39 02 B1 30 AC 4C 2B 26 45 5F 24 55 72 85 57 2C 55 73 05 54 D0 EE D5 E1 73 90 56 62 74 10 33 EB' + 'CE 0C 7A DE 88 C8 EE CF 0C 09 F1 82 D2 81 06 0D 08 CA C2 A2 0B 7A 81 7B 5A 44 0D 6D 7A A2 DD 48' + '2A 91 9A CE 9C 33 CE C8 A8 D5 5D D4 86 DD EA B1 2D 79 58 32 3A C3 27 AE 2B 56 EC DA 57 07 19 6B' + '06 DD AD 78 77 F0 6D B4 B3 5E 2D 40 DF E1 DB E7 AE 0F 76 DB 3E A6 3F BB EF B8 B4 16 DB 0D 73 0F' + '65 D3 00 EE DC 68 DC 0F 5A F6 E4 7A AF 3B 43 D3 3E E8 7A 7E 9B DB B1 A3 DB 1E 8F 82 F0 78 6F 45' + '93 EE C9 3B A4 23 44 15 E4 C0 21 1A 20 B1 26 09 08 D1 03 4C 10 D3 08 34 C3 0D 31 03 46 61 F6 28' + 'CA C6 19 5D E1 8F B8 CA C8 0F 72 43 D6 81 EE 50 7B 96 1E E2 87 BD F0 F7 30 3D CD 0D 09 9C 42 1E' + '80 F6 E3 FB EC 0F CF 07 E8 03 DC 0D 02 B8 41 A0 FC F5 70 7A 4D 51 1C 07 40 8E 34 33 DB B6 CE CD' + 'CC EF B5 CB CA F2 C8 D0 13 27 23 1F BD 8D 8A 4F 24 8C C1 31 30 C9 FF 58 58 38 1D D6 57 FD CB E6' + '37 B7 9D BB BB AE D5 CC ED C4 E7 42 DE 6D 87 42 DA 6E D6 D2 6E CD 7A 85 CB 54 59 4E D8 D8 57 CE' + 'AC AE 9F EC 56 F5 FA D4 35 93 B5 55 33 B5 1D 19 C9 C5 6A B7 B4 D3 74 B4 94 7D 4A 2E 9D 0D 07 4A' + '7F 83 3A 45 04 9B 27 3F 9C 9F 9B 35 CC E5 FC FF CF 7C EF 96 F2 BE 53 BB F8 0E A7 6F E4 FC 97 91' + 'F2 1E 3C F1 DD D7 55 CF B9 7A B3 E6 7B BC 2A 2D AC DB 61 6D B6 80 00 00 00 00 0E BB BA EE 02 22' + '22 24 92 49 2E BA EB AE BA 49 24 92 49 24 92 49 24 92 49 24 92 49 25 EF DD 75 DD 75 DD 75 DD 75' + 'C8 88 88 88 88 89 AA D7 D1 6A AF 9F 00 00 00 03 C7 77 77 77 77 00 00 16 DB 6D A8 8A 22 88 A2 28' + '8A 22 88 A2 28 8A 22 88 A2 28 8A 22 88 A2 28 8A 22 88 A2 52 94 A5 29 4A 22 22 22 22 22 22 23 75' + 'D7 5D 75 D7 5D 75 D7 5D 24 92 49 24 92 49 79 3C DF 17 89 24 92 49 24 92 49 25 57 84 F1 36 36 8D' + 'B4 6D 01 06 8D A2 4D 8D A2 A3 68 DA 36 8D 8D A3 63 68 D8 DA 36 36 8D 8D A3 63 68 D8 DA 36 36 8D' + '8D A3 63 68 D4 6D 1B 1B 45 A3 68 A8 DA 2A 35 15 1A 8A 8D A3 63 68 D8 BC D6 AE 6C 6D 1B 1B 46 C6' + 'D0 9A 8D 42 F7 B7 6D CD 46 C6 D1 B1 B4 6B 15 93 50 13 23 02 D0 8A 30 2D 08 A3 02 D2 0A 30 2D 08' + 'A2 42 94 82 88 1C 22 43 22 43 22 43 22 06 44 86 44 B6 D2 64 48 64 65 29 32 21 32 24 32 24 32 20' + '64 40 C8 81 91 26 44 99 10 32 30 32 21 32 20 64 48 64 64 C8 90 C8 93 22 43 22 4C 89 0C 89 32 24' + '32 21 91 21 91 26 44 86 44 0C 89 0C 88 19 12 19 12 64 48 64 49 91 21 91 93 22 43 22 4C 89 0C 89' + '32 30 3B C2 87 08 C0 E1 18 16 86 44 26 46 05 A1 91 21 91 81 68 64 48 64 60 5A 48 A3 02 D2 45 19' + '2D 24 51 92 D2 45 18 16 C0 14 60 5B 00 51 81 68 02 8C 0B 64 8A 30 2D 24 51 81 69 22 8C 0B 49 14' + '64 AB 68 DB 45 B4 6A C5 58 D6 8B 68 D6 8D 51 AD 1A A3 6A 36 C6 D8 D6 2B 1A D2 49 0E F2 89 20 A3' + '24 14 42 0A 24 82 89 20 A2 10 51 24 14 40 8A 24 82 88 11 44 90 51 08 28 84 14 42 0A 21 05 19 01' + '46 10 51 08 28 C9 14 64 05 19 01 46 00 A3 24 51 80 28 C0 14 60 0A 30 05 18 41 46 48 A3 24 51 09' + '96 D4 5A 8B 51 6A 2D 45 A8 D5 16 A3 54 6D 46 A8 D6 8D B1 B5 1B 51 54 6D 46 DA 36 A3 6A 35 A3 54' + '5A 8A D1 B6 8D 68 D5 15 A2 D4 5A 8A A2 D4 5B D5 77 6D 45 8D B1 63 5A 2C 6A 8B 1A A2 C6 D4 58 D5' + '16 35 45 8B 51 62 A8 B1 54 58 B5 16 2D 45 8B 51 62 D4 58 DB 78 EE 2C 6A 82 C5 A8 2C 55 16 35 45' + '8D 51 63 6C 58 B5 16 35 A2 C6 B4 58 B5 16 35 45 8D A8 B1 B5 16 36 C5 8D 51 62 D4 CD 25 B3 C2 ED' + '79 BD 76 D3 C2 ED 78 EB B0 17 51 86 46 40 BA 8C 32 32 05 D4 61 91 08 5D 46 64 48 17 51 86 46 01' + '75 19 91 84 2E A3 32 30 0B A8 CC 89 02 EA 33 23 08 5D 46 64 42 17 51 86 46 49 75 19 91 92 5D 46' + '64 61 2E A2 4C 8C 92 EA 24 C8 C9 2E A2 4C 89 25 D4 49 91 84 C8 93 22 13 22 4C 88 4C 89 32 30 99' + '12 64 64 94 D4 49 91 00 E1 38 A6 27 08 80 70 9C 53 13 84 40 38 4E 29 89 C2 20 1C 27 14 C4 E1 12' + '4E 13 8A 62 70 89 27 09 C5 31 38 44 93 84 E2 98 9C 22 49 C2 71 4C 48 64 D4 C4 86 4D 4D 08 64 D4' + 'D0 86 4D 4D 08 64 D4 C1 0C 9A 9A 40 C9 A9 A4 0C 9A 98 02 DB 43 26 A6 08 64 D4 C4 0C 9A 98 21 93' + '53 04 32 6A 62 06 4D 4C 40 C9 A9 A1 32 6A 62 4C 9A 9A 01 93 53 42 19 12 02 8C 91 44 91 44 22 89' + '22 88 02 88 02 89 0B 5F 9F 90 20 22 07 E2 11 F9 F8 11 D3 A7 4E 9D 3A 74 E9 D3 A7 4E 9D 3A 74 E5' + 'CB 97 2E 5C B9 76 EB 41 BA 4B 94 BD 0C DC DC D6 7B AC DC 48 F8 FE 2E 7E 74 8C 86 6B 4C DC D8 D6' + 'B9 65 CA 89 C9 C6 C6 8F E2 77 E3 B1 A4 30 E6 22 8E 90 C6 4A 89 12 24 48 91 22 44 89 12 24 48 91' + '22 44 89 B6 DB 6D B6 DB 6D B6 DB 6D B6 DB 6D B6 DB 6D B6 DB 6D B6 DB 6D A6 DB 6D B6 DB 6D B6 DB' + '69 B6 DB 6D B6 DB 6D B6 DB 6D B9 D3 82 7E 40 64 E4 86 DB 81 B7 94 1B 79 61 3E 78 6D D0 0D BA 21' + 'B6 40 DB CC 0D BA 41 4E 98 6D 94 36 CC 1B 75 02 B5 7F E0 2B FA 42 BF F2 15 FF A0 AF 74 15 EE C2' + 'BD E0 57 F5 05 7F 58 71 4F BD 14 EE 37 3B 95 5B E0 A9 C2 B7 10 41 C6 FC 54 C0 1F 16 10 F8 B1 03' + 'F0 68 E8 E8 E8 E8 E8 BF 9C FF 49 FD 18 FD 58 CF E8 D7 8B AD 04 30 C3 12 51 67 C5 A3 16 90 A2 8B' + '4B 02 29 5E EE 94 FE CE 97 07 B1 14 30 68 BF A1 D7 EB 67 F5 6B F5 3A 7E 39 DD 2C EE 8B D5 AA BB' + '9B 50 C5 CC 25 1A 1E F4 EA 13 F1 66 70 64 DF DF 5D 5E DE 69 FC 31 05 08 41 6C 0B DB 5D 5A E1 25' + '68 84 20 00 10 0F 7B 65 9D 9C BB 99 DE 9E E6 B2 99 BF E9 74 BA 18 D3 78 D3 EA 31 BC 6F BF 4E 3F' + 'FE E3 EA 6A 69 D0 E4 B4 A2 C9 69 46 D3 A7 D3 F8 3D FE FF 7F BF DF EF EC F7 FB FD FF 81 DF EF 7C' + '9F A6 B7 94 B2 CB 2C B2 CB 2C B2 CB 2C B2 CB 2C B2 CB 2C B2 CB 2C B2 CB 2D 2A 54 A9 52 A3 4A 95' + '2A 54 A9 52 A5 4A 95 2A 54 A9 52 B9 D2 A5 4A 95 2B D1 BD BB E1 DD 1D 75 73 71 70 BC 6D 9E 99 C7' + '01 C0 70 01 C7 1C 07 02 13 CB 22 0D A2 1E 36 AE D7 6A 12 6D 85 A6 DC 7A 18 9F F3 85 F1 61 B9 D6' + '10 8F DD D0 42 43 C3 C3 A4 EC 32 F4 3F 11 2D 41 22 08 09 7C 08 C4 13 3C 80 97 AA 10 11 8F A2 80' + '97 04 8B CF 7E 19 E4 F1 DF 92 3E 3E FB B6 4F C8 4D 02 02 13 5B A0 FC 80 97 80 9A 00 77 B0 70 1D' + 'F3 40 EF A7 EC 7B BE 2D 04 B4 2E F4 2F 34 2F 52 CF BB 6B C3 7B E4 75 AF AD 4E EB 74 2D 67 7D 1B' + 'FE BA 63 EB E0 70 DC 3B D8 C1 FE 7E 0E 9C 89 FF ED 26 05 68 CA 81 68 17 82 5D 2F A5 87 4F E5 E2' + '79 5F 5A 64 CE 01 DD 8C 5B 5E C6 36 6D 99 B7 5A 4C F0 F4 9A D2 39 BD 2C 7D 29 DE 65 08 6F E3 0D' + 'FC B0 BE BD C7 9E 93 56 83 42 1C 68 1C 34 22 06 24 48 C4 8A 18 9F 96 2D 07 9B 89 0B 18 83 13 F3' + '15 02 0C 43 0C 44 A3 12 34 62 78 BB F5 9E 2F D1 74 FC 67 89 67 59 FC 4F 8D 7B C7 F0 F7 37 E5 FE' + '5B B8 EE 3A CE E3 B8 3D FA 75 93 AD 28 C3 BE 7A 1E B8 E3 7A 3C 6C DA 4B C3 7A 47 AF FA 48 19 80' + '65 65 00 06 66 60 16 28 0A 1E A3 EA 19 83 96 7B BD CB C5 6F 81 A3 D2 FD D7 DA 9F 3C 77 67 3B EF' + '59 CE 73 5C E3 E9 DB 57 E4 3D F3 DE 7F D3 E5 58 F2 5F 1B E3 73 CF 1F F0 9F 07 E2 F8 BE 2F 60 5F' + '8B E3 3C EF 37 CB F4 3C E4 1E 7F E6 41 FF CF E0 3F 3F 7F 60 42 79 42 34 79 40 C3 CC 7F 8C D5 45' + 'C5 44 6A 8E F3 3C DD 52 48 02 47 79 1E 89 38 48 3F 51 28 5A F0 FC CD 3E CE 97 07 B1 C0 8A 0B FE' + '17 34 03 AE 2E 06 7F 23 AB C0 AF 73 D4 E9 F4 B3 AF 2D AE 14 E7 72 2E 7C 9F 1F A2 0F 56 AA EE 6F' + '1A A7 17 0B DD 7D 33 E5 DE E7 DC 7C B7 CA FD 9B D1 F6 7F 25 EB FE 51 F1 BE F9 DF 27 F6 8F 5B F4' + 'E8 C4 11 17 E2 67 09 10 84 7E 00 10 2D 5A B5 6E A9 6E 9A E5 CD 97 B6 B3 B3 D3 6F A7 43 FC E8 6F' + '1D 78 5D F8 7C 7A 54 3D 56 54 14 4C 99 53 FA B4 94 90 D4 EC 95 32 56 CA A1 95 4B 2B FB FB FF 17' + '72 FB C5 7D 5D 5D 7D D9 76 B3 B3 F2 1F 7A FB EB 31 BF 74 67 EF 87 87 86 FA 21 A1 61 78 3F 85 85' + '81 96 76 52 CC 55 D5 54 A4 55 4F 4E A5 4F 56 4E B5 D2 BA 6A 6A 6A 6A 6A 6A 6A 6A 6A 6A 6A 6A 6A' + '9A 65 89 63 69 BA 74 29 52 A5 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C' + '63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18' + 'C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 E0 6F FE AD DE EC 9B 9F E5 D3 E1' + '47 47 B8 EE 38 BF A6 A5 71 D5 71 2E E3 01 C6 0B 8C 22 73 B0 88 E3 0D C6 23 86 6E 31 5C 63 11 C6' + '0B E2 63 BF 39 C8 73 92 E5 A3 9C A2 39 CB 72 D5 CC E7 E9 9C 80 D9 7A 33 9F AB 67 E9 4E 7A 73 9F' + 'AE 73 D4 9C F5 67 3D 69 CF 5E 73 D8 9C FD 93 9E CF C7 ED 6C A7 B3 80 DE 0B 6A 6C C8 D9 93 B2 AE' + 'CC AD 95 B6 57 D9 97 97 85 B3 87 B2 C6 CE 26 CC CD 9C 5E E1 3B 99 9D CA 5D CA 7D C2 F7 0D DC A9' + 'DC CD 53 FE 14 FD 2A 7F CA 9F F4 A7 74 A7 76 A7 78 A7 EA 73 4C 3C 04 FB 87 81 50 76 AC 3B A8 0E' + 'EA 43 BA A1 A3 56 30 6B 06 0F 58 78 3A E3 0A B4 69 F6 03 EA E0 EF B2 1F 2C 0F 6B C6 25 80 63 62' + '18 D9 0C 95 A2 F9 70 66 BC 33 B3 17 F6 82 DA D4 60 DB 0C 26 01 95 B8 D3 B8 18 77 23 07 B4 30 EE' + '86 1D D8 C5 ED 8C 5B C0 D2 F4 3C 62 34 AF 86 97 70 69 5F 8D 16 41 DF 74 3B C0 0E DB 60 87 58 41' + 'BE 18 75 88 33 99 87 58 A1 D6 30 EF 7E 57 98 E3 C7 90 3C 79 21 E3 40 E7 28 39 CB 0E 5A 87 3D F0' + 'E7 30 39 CD 0E 73 83 96 C1 CB 70 E7 3C 39 D0 0E 5C 03 DC 83 DD 07 AE C7 8B 44 78 34 83 C7 83 C4' + '78 78 78 79 A5 A2 ED D3 97 1A 19 ED DB 67 66 E6 77 DA E5 E5 34 C9 C8 C7 EF 63 62 B3 C4 C3 C2 C1' + 'C0 EE B2 BF EE 5F 31 BD BC ED DD DD 76 AE 6E 2D D8 5B 5A DA 59 AF 5C B6 CA C6 C2 BD 67 66 BB B1' + '5B D7 DA A1 D8 6B B5 C4 F5 FC FE B5 65 5D 55 4D 42 B5 54 F4 CA 7A B4 B4 94 7D 4A 2E 9D 0D 07 4A' + '7E 7A 77 A2 A2 72 6F A1 CF E7 27 E6 CD 73 39 7C AE 4C CA 6E 44 C7 1E 5F 8D 2D 2B 29 C5 E2 70 E4' + 'E4 A4 64 23 E3 B8 51 B0 50 5B 68 2D 54 14 14 14 11 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 79' + 'E7 9E 79 E7 9E 79 E7 9E 7E CD 56 D1 52 15 5B 55 5B 65 5B 75 5F 02 AF 85 57 C4 AB E3 55 02 A9 12' + 'AF 91 56 E1 57 CA AB E6 55 F3 FA 79 5E 9E 56 56 53 8E 38 E3 8E 38 E3 8E 38 E3 8E 38 E3 8E 38 E3' + '8E 38 E3 8E 38 E3 8E 38 E3 8E 38 E3 8E 38 E3 8E 38 E3 8E 38 E3 8E 38 E3 8E 38 E3 8E 38 E3 8E 38' + 'E3 8E 38 E3 8E 38 E7 BF D8 00 0D 8D 8D 8D 8D 8D 8D 8D 8D 8D 8D 8D 8D 8D 8E E7 73 DE A9 98 52 A5' + '4A 95 2A 54 A9 53 CD 52 A7 9D CE 52 A5 4A 95 27 7A A7 7A C7 7A E7 7B 07 7E C3 BD 93 BD A3 B5 A7' + '7B 67 6B 8E D7 9D B0 3B DC 3B DD 3B DE 3B 62 77 BE 76 C8 ED 99 DB 43 90 9D B5 3B 6C 76 DC EF 80' + 'EF 84 EF 88 EF 8C E8 13 91 1D F2 1D B8 3B E5 3B E6 3B E7 3B F6 9D FB 8E FD E7 7F 03 BF 8C AA F9' + '65 FC 65 F2 EB F8 EB E6 17 F2 17 A6 5F 2D 32 BF 92 BF 94 BF 96 BF 98 BE 69 7F 35 7A FE 72 FE 7A' + 'F4 FE 92 7F 4D 3F EB 4F EA 27 F5 53 FA C9 FD 74 FE C2 7F D8 9F D9 4F ED 27 D6 A7 F6 D3 EB 93 EB' + 'D3 EC 13 FB 89 FD D4 FE F2 7D 8A 7F 7D 3E C9 3E CD 3E D1 3A 14 FB 54 FB 64 FB 74 FF 02 7F 85 3F' + 'C4 9F E3 4F 02 9D 12 7F 91 3E E3 9B 35 CC E5 F2 B9 33 29 B9 13 1C 79 7E 34 B4 AC A7 17 89 C3 93' + '92 91 90 8F 8E E1 46 A5 31 63 22 E2 A2 62 0E 87 49 0D EA 42 F6 74 BB 11 43 06 8B FA 1D 7E B6 7F' + '56 BF 53 A7 D2 CE E8 BD 5A AB B9 B5 0C 5A 74 B3 09 46 84 FC B7 32 80 E0 03 80 0E 00 38 00 00 EC' + 'A3 82 D4 00 2D 00 0E 00 CA 72 D7 27 22 76 3B 6D 33 34 78 D8 B3 31 18 C3 C2 5F F3 3D 0F CB FC AD' + 'DD BD DF E3 DD F9 1B BF 27 77 71 AA F6 B6 6D 6D 1A DA B5 B6 6A C1 AD BB 5B 86 B7 2D 7B 4D 6E 9A' + 'F8 BC 5E 37 DE 3D AE D5 0A 14 28 50 A1 42 85 0A 14 28 50 A1 42 85 0A 14 28 58 61 86 18 61 86 18' + '61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 89 93 03 17 14 35 71 83 54 61' + 'AB 34 35 59 0D 56 83 55 B0 D5 C7 0D 59 C0 8E AC AC 8B 55 35 78 59 36 B2 35 5C 0D 5C A0 D5 CB 0D' + '59 E1 AB 40 35 68 86 A9 04 4F F3 15 FF 40 AF FE 82 BF FA 8A FF EC 16 2C 58 B1 62 C5 8B 16 2C 58' + 'B1 62 C5 8B 16 2C 58 B1 62 C5 8B 16 2C 58 B1 62 C5 9E 1F 0F 87 C5 E2 F1 78 B5 AE B5 92 D6 BB D6' + 'BC C9 BD D6 BE D6 E8 6B 0B 5A FF 59 3C BC 0D 6C 17 14 D6 91 AD 27 59 5D 69 5A CB 6B 2F AD 2F 5B' + '08 D8 7A CC 25 DA A5 DB 25 DB A5 F8 12 FC 29 7E 24 BF 1A 58 14 A8 92 FC 89 77 09 7E 54 BF 32 5F' + '9D 2F ED FC 66 0F 91 6C F6 3F AC 9A B3 16 32 2E 2A 26 20 E8 7D 6D 0F 78 DF 03 CC D3 EC E9 76 32' + '22 86 0D 17 F4 3A FD 66 4E 39 4F 27 3F AB 5F A9 91 6D E3 74 FA 59 DD 17 AD AD B9 95 B8 1C 0F 2E' + 'AB B9 B5 0C 5B 6A 7C 46 F8 1E 5D CD 2C C2 51 A1 3F 2F 87 94 E6 4C C4 32 72 27 63 B7 C1 6F EE 8E' + '00 B4 00 38 00 00 E0 03 80 0E 19 C1 6A 00 C4 11 11 10 5D 38 62 48 88 88 22 2E 9C 31 10 DA C2 22' + '0B 9C 30 46 20 88 B9 C3 11 0B 08 88 2E 70 C7 C7 77 46 20 88 BC 38 60 13 26 4C 99 32 64 C9 93 26' + '4C 99 32 64 C9 93 26 4D 3C C3 1E DF 1D 83 06 0C 18 30 60 C1 83 06 0C 18 30 60 C1 83 06 0C 18 30' + '60 C3 D5 F5 7D 55 14 51 45 14 51 45 14 51 45 14 51 45 14 51 45 14 51 45 14 51 45 14 51 45 14 51' + '45 14 51 45 14 51 45 14 53 5F AF D7 EB F6 1E E0 8F 8F 4B 1F 1F 1F 1F 1A F9 F6 33 CE F3 CC 77 99' + '0F 32 5E 34 79 94 F3 2D E3 57 9D F7 99 8F 33 5E 67 3C 6C F1 BB CC F7 9A 1E DF 87 DB FA 9E DE EE' + 'EE EB F2 1F 92 FA AF CA 7D 67 D7 7E 5B F8 4F E1 BE C3 F8 8F CC 7F 15 FC 67 C6 FC D7 D9 7D A7 DB' + '7F 1D F9 CF E4 3F 92 FB 8F E5 3F 96 FC F7 E8 3F 45 F2 3F 98 FD 27 E9 BE 57 CC FD 47 F3 5F 75 FA' + 'AF D6 7D E7 FA 2F E7 3F D2 7F A6 FF 51 FA EF F5 5F CF 7F AC FF 5C EE B6 7F 56 BF 53 A7 D2 CE E8' + 'BD 5A AB B9 B5 0C 5A 74 B3 09 46 84 FC BC A7 32 72 27 63 B6 D3 33 47 8D 8B 33 EB BF 5C FA DF D6' + 'BE B3 F5 8F AB FC 77 D5 BE AB F1 BE F3 E6 8C 22 20 BE 6D C3 04 62 08 8B 9C 31 11 11 10 5C E1 80' + '1C 01 68 00 70 00 01 C0 07 00 1D 6A 16 A0 01 68 00 EB AE BA EB AE BA EB AE BA EB AE BA EB AE BA' + 'EB AE BA EB AE BA EB AE BA EB AE F8 7C 3E 1F 0F 87 C3 E1 F0 FB 7E D7 B6 70 84 21 08 42 10 84 21' + '08 42 10 84 21 08 42 10 84 21 08 42 10 84 21 08 42 10 84 21 0A 6C D9 B3 66 CD 9B 36 6C D9 B3 66' + 'CD 9B 36 6C DC FD ED ED ED ED ED ED ED ED ED ED ED ED EF 3F CF F3 FC FF 3F CF ED 5D 79 A5 29 4A' + '52 94 A5 29 4A 52 94 B6 E5 5C B2 CB 84 5C 32 B0 5C 42 CC 2E 29 71 8A 32 CD 2B 25 68 AD 97 1C B3' + '8B 90 5C 92 B8 5C A2 E5 96 79 68 16 89 48 5C C2 D2 A5 48 B4 CA 53 18 C6 31 8C 63 18 C6 31 8C 63' + '18 C6 31 8C 63 16 9D 2C C2 51 A1 3F 2F 29 CC 9C 89 D8 ED B4 CC D1 E3 62 CC C4 63 0F 09 69 4A 94' + 'A5 29 4A 52 94 A5 29 4A 52 94 A5 29 4A 52 94 A5 29 4A 52 94 A5 29 4A 5A 99 A0 70 01 C0 07 00 1C' + '00 70 01 83 04 62 08 8C 18 88 C6 20 03 80 00 2D 00 00 2D 00 2F EF EF FF EF DA C0 AA 9A 69 A6 9A' + '69 A6 9A 69 A6 9A 69 A6 9A 69 A6 9A 69 A6 9A 69 A6 9A 69 A6 9A 69 A6 9F 6F 03 B7 DB ED F6 FB 6A' + 'F6 FB 69 D7 C0 AF 83 5D 4A F2 2B C9 AE AD 79 55 D6 AE BD 79 75 F0 AB E1 D7 62 BE 25 79 95 F1 6B' + 'E3 57 1D 79 B5 D9 AE D5 76 EB E3 D7 9D 5F 22 BE 4D 77 2B E5 57 CB AF 3E BD 0A F4 68 D1 A3 46 8D' + '1A 34 68 D1 A3 46 8D 1A 34 27 E5 E5 39 93 91 3B 1D B6 99 9A 3C 6C 59 98 8C 61 E1 4B 5D 69 4A C9' + '90 A6 0E 02 75 EB D7 AF 5E BF 0B 85 C2 E1 70 B8 5E 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6' + '31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C' + '63 18 C6 A2 F5 47 B3 5E 75 EA AF 56 79 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 7B C7 79 E7 9E 79 E7 9E' + '79 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 79 E7' + '9E 79 E7 9E 79 E7 9E 79 E7 9E AA EE 6D 43 67 67 1C 00 70 5A 5A 5A 00 01 C0 00 07 00 1C 01 68 00' + '01 88 23 18 88 30 62 48 C4 11 18 31 04 44 44 41 89 23 07 00 00 1C 01 68 00 01 68 00 70 2A AA AA' + 'AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA AA A0 82 08 20 82 08 20 82 08 20 82' + '08 20 82 08 20 82 08 20 82 08 20 82 08 46 8C 15 2A 54 A9 52 A5 4A 95 2A 54 A9 52 A5 43 18 C6 31' + '8C 63 18 C6 31 8C 63 0F 9E 38 C3 B8 1C 71 A2 3B 91 DD 0D 21 DD 8E F0 77 A3 BE 1F 40 62 1D F8 D3' + '1E 00 F0 46 A0 E4 0E 48 D5 1C A1 AC 35 C7 2C 78 43 C3 1B 03 C4 1C C1 E2 9D 33 11 8C 3C 29 6B AD' + '29 59 32 14 C1 C0 4E FC 5F 19 F1 7E DF DB 7A 3E 87 B5 F6 9F 15 EC FD 97 B1 F3 FE 3F E4 11 11 06' + '0C 11 88 22 30 62 22 22 30 60 C1 18 08 00 04 00 80 3F 00 03 F0 12 52 52 52 52 52 52 52 32 49 52' + 'A5 4A 95 2A 54 A9 52 A5 4A 95 2A 54 BB 2D 96 CB 65 B2 97 2E 5C B9 72 E5 CB 97 2E 5C B9 72 E5 CB' + '97 2E 5C B9 72 D6 5B 08 E1 08 42 10 84 21 08 42 10 84 21 08 42 10 84 21 08 42 10 84 21 08 42 10' + '84 21 08 42 12 CB 81 C0 07 00 1C 00 70 01 C0 00 16 80 00 16 80 1D DF E5 FD 1D DD 3B CC F3 23 10' + '44 60 C5 E5 F2 F9 7C BE 5F 2F 97 CB E5 F2 F9 7C BE 5F 2F 99 A3 A3 A3 A3 A3 A3 A3 A3 A3 69 67 42' + 'B9 6D 95 8D 85 7A C5 95 BD 7E B5 65 5D 55 4D 43 EF 1F 8B C3 A9 E0 7B 5C F3 4B 2F 2D D3 97 0E 1C' + '6D F3 FE 06 F1 71 51 27 2D B2 B1 B1 89 88 3B 7F 05 F7 EF BE EF B7 7B F6 7D 7F 56 F3 77 BA 8E DD' + '46 28 9C 9B E8 73 F9 C9 F9 B3 5C CE 5F 2B 93 32 9B 91 50 AD 55 3D 32 9E AD 75 2D 25 5D 7D 77 62' + 'B5 61 8C 63 18 C6 31 8C 63 18 C5 29 4A 52 94 A5 29 4A 52 94 A5 29 4A 52 94 A5 29 4A 52 94 A5 29' + '4A 52 94 A5 29 4A 52 94 A5 29 4A 52 94 A5 29 4A 52 94 A5 29 4A 52 94 A5 29 4A 52 94 A5 29 4A 52' + '94 A5 29 4A 52 94 A5 29 4A 52 94 A5 29 4B F3 D7 C6 C6 8B 1E 10 6D 1C 1B 47 86 D2 01 B4 88 6D 24' + '1B 49 86 DC 30 DB 88 1B 71 43 69 40 DA 54 5D 4B 06 DC 60 DA 5C 36 E3 86 D3 01 B7 20 36 4C 1B 4C' + '86 DC 90 DB 94 1B 72 C6 9F 30 37 9A 0D F9 A1 BA 70 DF 9C 1B F3 C3 7E 80 6F 36 1B CE 06 EA 06 77' + '44 67 4E 8C E9 E1 9D 3E 33 BA 43 3A 80 67 50 8C CE 98 CE A2 19 DD 40 FA 8C 3E A4 0F A9 43 EE A8' + '7C 4D EA D4 0F A9 C3 E5 41 F2 B0 FA A0 3E A9 0F AA 83 EA B0 FA B0 3E EB 0D 4E B8 F0 D6 87 DD 80' + 'FA B8 3E EC 87 CB 03 3A F0 CE C0 33 B1 0C EC 83 35 A1 F2 E0 F9 78 B3 B3 18 D6 83 1A D4 63 5B 06' + '4C 03 2B 70 CA E0 32 B9 0C BB 41 95 D0 65 76 19 76 C3 2B C0 CA F4 32 62 19 5F 06 5D C0 CA FC 77' + '99 0E EF 74 38 C0 0E 30 43 8C 20 E3 0C 38 C4 0E 19 87 18 A1 C6 30 71 DE 0E 31 C3 8C 80 E3 24 38' + '68 1C 65 07 19 61 C3 51 A9 DF 1A 99 83 53 34 6A 67 0D 46 C3 51 B8 D4 CF 1A 9A 03 51 C0 D4 72 35' + '1D 07 CE C3 ED 10 FB 48 3E 78 34 9E 0D 2D 47 CF 9F 3E D5 EA FC 5E 47 91 E4 69 F8 1E 9E F3 4B 45' + 'DB A7 2E 34 33 DB B6 CE CD CC EF B5 CB CA 69 93 91 8F DE C6 C5 67 89 87 85 83 81 DD 65 7F DC BE' + '63 7B 79 DB BB BA ED 5C 5B B0 B6 B5 B4 B3 5E B9 6D 95 8D 85 7A CE CD 77 62 B7 AF D6 AC AB AA A9' + 'A8 57 FA 15 53 D3 29 EA D2 D2 51 F5 28 BA 74 34 1D 29 F9 E9 DE 8A 89 C9 BE 87 3F 9C 9F 9B 35 CC' + 'E5 F2 B9 33 29 B9 13 1C 79 7E 34 B4 AC A7 17 89 C3 93 92 91 F0 C8 02 00 FC 03 F0 04 00 80 10 00' + '1F 80 00 DE 14 BE 18 DF 09 5E 99 EA 57 B1 6E E3 1D 95 D9 9D C5 E8 46 68 17 40 DA 11 79 D1 99 C5' + 'CE CB CB CB CB FE F9 10 F8 E7 63 C4 63 EE 57 43 B3 39 9C 43 3F E1 D6 8A 67 F3 AB 8B C4 56 66 69' + '59 C0 C0 C0 C0 C0 C0 C0 C0 C0 C0 C0 C0 C0 C0 C0 C0 C0 B4 D3 4D 34 D3 4D 34 D3 4D 34 D3 4D 34 D3' + '4D 34 D3 4D 34 D3 4D 34 D3 4D 34 D3 4D 34 D3 4D 34 D3 4D 34 D3 4D 34 D3 4D 35 FA 2D F8 B1 FF 4A' + '77 8B 23 F4 F2 7C 4E 7A 39 5E 2E 4F 23 8F C6 E2 F1 38 76 D9 7E 8C FF 72 87 C0 A3 EE 13 D2 CC F7' + '38 BC 4E 1D B7 8D C2 F2 69 7A 54 F7 CB FA 86 DF A9 F0 73 77 DD FD 5A BB FC 9E 47 1F 8D C5 E2 70' + 'ED AB 7C 27 B7 FA 3F AD 9D BF D2 DA E9 EF F5 3E 1D 7D FE 4F 23 8F C6 E2 F1 38 76 DD 5F 87 9F FF' + 'DD 6F D7 EB F8 3E F5 30 5E 0F C9 F8 FC AF C5 E4 F9 1B F7 BC 07 B0 6F 61 1E F9 3E 46 AF 54 8E 8F' + 'F0 3F 83 49 0A 7C 35 2A 43 E1 FA A7 1F E6 7F B7 96 FF F9 3F 1F 95 F8 A1 F9 87 63 44 26 89 C1 8A' + '99 8B C1 8A 97 8B BE 3A 3E 22 DA 32 50 B7 65 92 33 0A 92 2A 78 47 75 64 A9 78 4D 1E B1 2B 1E 13' + '4A B4 95 AF 08 F2 B8 96 EF 09 71 5E 4B B7 84 7B 64 47 CF 48 FA F8 97 D7 C4 7D 6C 4B 3D 32 1F 6E' + '4B 6D 32 3D B9 25 C6 99 3C 17 44 BA D3 26 9D 4F 6A AB FF 6D 7F A2 D6 8D 0D F3 BE 65 1A 13 F2 FD' + 'A3 BD 6F DE F9 5F 1F E9 5A 86 61 3F 7F F9 3F 83 E8 FF 0D 8E 0F 03 30 9C 13 17 30 9B A7 7C 8A 54' + 'A9 52 A5 4A 95 2A 54 A9 52 A5 4A 95 2E 4F 23 8F C6 E2 F1 38 76 DF 1A 9D 3A 74 E9 D3 A7 4E 9D 3A' + '74 E9 D3 A7 4F 93 C8 E3 F1 B8 BC 4E 1D B5 3A 74 E9 D3 A7 4E 9D 3A 74 E9 D3 A7 4E 9F 27 91 C7 E3' + '71 78 9C 3B 6F 5F E6 FF 2F AF FD 9F 2B D7 A5 F3 A8 7F 5F CC FF 0F E9 F9 78 DC 7E 3F 1A AF 1F 8E' + '6E 47 22 DF 93 C9 E4 F2 59 F1 FC 8B 7F 22 D3 C1 A4 C9 DB AB F7 0E 1A 34 68 D9 FD FD FD FD FD FD' + 'FD FD FD FD FD FE F6 F6 F6 F6 F6 E6 E6 E6 E6 E6 E5 72 E5 CB 97 2E 5C BA BA BA BA BA BA BA BA BA' + 'AE AE AE AE 53 86 75 5D 5A B5 6A D5 D1 D1 D1 D1 D1 D1 D1 D1 F9 B3 53 53 5F 9E 6B 93 C9 96 96 E3' + 'F1 FF 44 BC 9C 9C 9C 9C 9C 9C 9C 99 8C 63 1B CD F3 7C DF 5B EF 6A CF 9F 3E 7C F9 D3 A7 4E 9D 3A' + '74 E5 55 55 55 55 55 55 54 BE D4 D4 D4 D4 D4 D4 D4 D4 D8 F7 FF 69 EC 9D EC 9D EC 9D EC 9D EC 93' + '04 98 24 C1 25 F1 2F 89 7C 4B E2 5F 12 F8 97 C4 BE 22 D2 2D 22 D2 2D 22 D2 2D 22 D2 2D 22 DB 0E' + 'BC BD 45 45 3D 3D 3C B4 07 B1 8C 41 18 31 11 11 10 5E C6 70 16 80 1F 43 91 B9 B9 B9 F6 1B 9B 9B' + '9B 9B 9B 9B 9E 5E E7 CF F7 3E 35 BD BD BD BD BD BD BD BD BD BD BD BD BD BD BD BD BD BF CE F2 01' + '14 51 45 14 51 46 74 E9 D3 F2 32 32 32 32 23 DB C7 F2 23 F9 31 FE C6 3F 95 1F EC A3 F9 71 FE CE' + '39 F1 F9 51 F9 71 F9 71 F9 91 F9 B1 F9 D1 D0 F8 E8 86 05 0B 98 F7 1E C7 CF F8 9F 61 F1 1F 0F F0' + 'DF 0B EB FD 77 C2 7C 1F C1 7C 0F AD F4 7D 1A 30 44 5E DA 70 C4 44 51 44 41 74 E1 83 04 62 08 20' + '04 40 40 80 00 40 08 FC 02 E5 C9 D3 E3 E8 F4 FA 1B 1D 8C 5C 5E 46 8E 4E 8B 06 13 D3 D4 AC 29 68' + '11 22 D6 6B 35 9A CD 66 B0 F3 CF 3C F3 CF 3C F3 CF 3C F3 CF 3C F3 CF 3F DA F8 9F 09 D7 73 FF 0E' + 'B6 FF AD BF FE FB FE 9F ED FA 9B FE A7 C4 F4 3D 0F 79 E8 67 6F FF C9 F2 39 52 39 72 39 92 39 B2' + '39 D2 10 91 CF 91 1A 45 C4 88 F2 11 91 73 22 EA 42 52 2E E4 5E 48 BD 91 7D 23 A1 20 52 2F E4 27' + '23 02 46 0C 85 24 48 53 07 01 3B F1 74 2F AF 6F 2E D2 BA B9 46 3D C4 6E 7A 1C EE 6F 33 97 CA 92' + 'A8 1C 00 70 01 C0 07 00 1C 00 00 74 A3 82 D4 0C 68 23 10 44 5D 38 45 88 88 88 82 EB B8 8D 04 62' + '08 8B A7 08 B1 8C 41 88 2E 72 34 11 8A 22 2E 70 B1 11 8B 10 5D DC 46 82 31 44 45 DD C1 63 D4 F5' + '3E 47 D4 F5 3D 4F 53 D4 F4 FD 3F 4F D3 F4 FD 3F 4F D3 F5 3D 46 8D 1A 34 73 E2 AD AD AD AD AD AD' + '37 89 83 5B 46 B6 AD 6D 9A BB 5C ED 7F B0 EE CD DA 44 91 29 21 A1 78 BC 3E FC 2B 5C B5 B6 56 36' + '19 4D 32 72 16 D9 58 D8 63 F7 B1 B1 6A 6A 15 AA CD C5 F1 23 84 83 E0 6F E0 BE FD F7 DD F6 EF 7E' + 'CE 0C A7 17 89 C3 93 92 91 90 8F 8E A2 D1 C5 84 84 84 84 84 84 84 84 84 8A 28 A2 8A 28 A2 8A 28' + 'A2 8A 28 A2 8A 28 A2 8A 28 A2 8A 28 A2 8A 28 A2 8A 28 61 86 18 61 86 18 61 86 18 61 86 18 61 86' + '18 61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61' + '86 1E FF 67 83 0B 59 59 59 59 58 C1 83 06 0C 18 30 60 ED DB B7 6E DD BC 7C D1 A3 46 8D 1A 1E FA' + 'EA EA EA EA EA EB B3 75 81 81 77 63 81 81 81 37 AD 9B F6 E6 F5 D3 7A F9 BD 84 DF B9 37 EE CD FB' + 'D3 7B 19 BF 7E 6F 65 37 B3 9B DA 4D A1 9B DA DA 4E 6D ED 14 7C 2A 3E 25 1F 1A 88 15 08 94 7C 8A' + '37 0A 3E 55 1F 32 8F 9D 47 ED 51 FB 94 7E F5 1F C1 47 F1 51 FC BB 3D 1F A2 BE 77 FA DE CF 6E 67' + 'BF BC F7 F8 9E FA 67 BF CC F7 FA 9E DD 4F 6E E7 B7 93 DF 54 F7 D7 3D F6 4F 6F 6D 27 45 A5 A5 A5' + '0D 0D A7 4C 5A 51 0F 2A D3 A8 3D 7B 4F 6B D7 41 79 48 3B 74 A3 CE FC DB 9F EA F3 AA 1E 29 17 14' + 'C1 E5 38 C9 54 32 55 8C 9A 81 93 52 1E 55 07 95 61 E5 60 79 D6 0D 7A E1 AD 68 6B D8 0D 6B 83 CE' + 'C8 78 B0 3C AF 0F 2C 06 65 88 CC B2 19 8B 46 62 E0 7A F0 F2 CC 1F 68 18 DA 86 36 C1 8B 00 C6 DC' + '31 B8 0C 6E 43 1E D0 63 74 18 DD 86 3D B0 C6 F0 31 BD 0C 58 8C 8B E1 91 DC 19 17 E3 21 90 C8 EE' + '8C 8C 01 91 82 32 30 86 46 18 C8 C4 0E 19 87 D8 A1 9E 28 67 89 87 85 83 81 DD 65 7F DC BE 63 7B' + '79 DB 35 DA 5B AE D5 CD C5 BB 0B 6B 5B 4B 35 EB 96 D9 58 D8 73 2B F9 AB 13 F6 6B BB 15 BD 7E B5' + '65 5D 55 4D 42 B5 54 FD 5A 5A 5A 4A 4A 3E A7 53 A7 43 41 D2 9F 9E EA 4F 4E F4 54 4E 4D F4 39 FC' + 'E4 FC D9 AE 67 2F 95 C9 99 4D C8 98 E3 CB F1 A5 A5 65 38 BC 4E 1C 9C 94 8C 84 7C 77 0A 35 29 8B' + '19 17 15 13 10 74 32 40 40 08 03 F1 00 20 00 11 20 40 08 03 F1 00 01 02 44 89 12 24 48 91 22 44' + '89 12 43 42 C2 C2 E9 E9 E9 E9 E9 E9 E9 E9 E9 E9 E9 E9 E9 F6 74 BB 1D 8E C7 62 2D 04 92 49 24 92' + '49 24 92 49 24 92 49 24 92 49 24 92 49 24 92 49 24 92 49 24 92 49 24 92 49 24 92 49 24 92 49 24' + '92 49 24 92 49 24 92 49 24 92 49 24 92 49 24 92 49 24 92 49 24 92 4B D0 F4 3D 08 C5 11 17 A0 E1' + '16 31 88 D1 05 CE 46 82 31 44 45 DD D6 22 0B 04 58 49 4B 04 45 88 83 62 0C 18 D0 44 58 22 22 C4' + '1B 10 46 34 11 65 DC EE 88 8B 10 58 82 31 A0 8B 04 44 58 2C 41 18 D1 05 82 22 2C 18 2C 41 18 B0' + '41 64 22 23 44 45 88 23 1A 20 B2 11 11 A3 06 C4 11 8D 04 58 22 23 44 45 88 22 C4 68 E9 C8 36 08' + '8C 11 A3 04 4B 54 A8 82 31 11 46 22 0B 04 46 08 D1 83 05 9D B7 1C 23 11 06 22 1B 4B 04 46 08 8C' + 'BB D0 9C 3A F1 D7 8E C1 66 41 88 83 10 45 82 30 44 67 5D CC 16 20 8C 44 1A 65 24 58 22 30 44 53' + 'AE DC 83 62 08 C6 30 60 88 B0 44 60 C4 66 44 16 20 8C 44 18 22 2C 11 18 22 33 22 0B 3A EB 84 62' + '20 C1 11 60 8C 11 18 82 31 12 62 20 C1 11 82 23 04 46 20 8C 04 98 88 29 D5 C9 D2 23 04 46 08 88' + 'CB A7 41 18 89 31 10 60 8C 11 18 22 31 04 62 24 C4 41 9D 77 22 22 23 04 46 20 C1 88 83 3A EE 44' + '44 46 08 8C 41 83 11 04 44 44 46 08 C1 18 31 10 44 44 60 8C 18 31 10 44 45 24 60 C6 22 E9 C8 31' + '05 DD D1 11 18 BA 70 D1 11 8C 46 0B A7 23 44 11 11 88 8B A7 22 88 8C 41 82 E9 C8 D1 04 44 40 E7' + '45 D3 86 88 81 DE 27 45 E0 30 60 BA 70 B1 04 44 44 5D 39 14 44 5C E1 83 05 CE 16 21 94 B9 D1 11' + '11 73 91 44 45 CE 18 30 5C E1 62 0A 22 20 48 B9 C8 A2 21 10 30 60 B9 C2 C4 11 10 24 04 40 10 00' + '1F 88 01 00 20 00 6F 95 7D DF 4F D6 A9 56 FD 57 01 54 1A A8 84 71 31 2D E1 55 B7 49 50 DD BB 76' + 'ED DB B7 ED F6 D0 41 04 10 41 04 10 41 04 10 41 04 10 41 04 10 41 04 10 41 04 10 41 04 39 F1 83' + 'DA B3 66 CD 9B 36 6C D9 B3 66 CD 9B 36 6C D9 B3 66 CD 9B 36 6C D9 B3 66 CD 9B 36 6C A0 3E 78 E3' + '0E E0 71 C6 88 EE 47 74 34 87 76 3B C1 DE 8E F8 7D 01 88 77 E3 4C 78 03 C1 1A 83 90 39 23 54 72' + '86 B0 D7 1C B1 E1 0F 0C 6C 0F 10 73 07 8B 33 11 8C 3C 29 6B AD 29 59 32 14 C1 C0 4F EA 1F 4F F8' + 'CF 8B F6 FE DB D1 F4 3D AF B4 F8 AF 67 EC BD 8F 9F F1 FF 20 30 5F 60 72 34 11 11 11 17 38 68 8C' + '44 18 2E EE 8B 24 44 44 44 45 93 06 20 C1 18 D2 66 EA 74 44 44 44 59 11 77 72 0B A9 C2 EE EB 24' + '44 44 44 63 49 88 81 10 22 2C 97 77 44 44 44 59 28 0C 11 64 B9 C2 22 22 2C 49 18 30 46 8C 04 44' + '44 58 92 30 60 BB BB 46 03 04 44 44 68 C9 82 E7 08 B1 20 44 44 68 C9 18 34 18 22 24 88 C2 52 44' + '60 22 40 30 44 49 11 84 A0 22 30 18 0C 98 88 92 30 94 91 19 33 AE E6 03 04 44 06 04 A4 88 C9 18' + '80 8C 44 91 9D 75 C3 11 19 23 11 11 18 88 08 C1 88 8C 49 18 88 88 C4 19 30 62 22 30 44 41 88 C4' + '49 9D 77 30 62 23 26 08 23 04 44 13 BE C3 2F 1E 18 0A 48 8C 91 46 20 8C 11 12 60 C0 52 44 64 C4' + '41 18 20 C9 44 60 29 23 26 22 08 82 22 4C EF 12 F1 E1 82 24 88 C1 8C 41 06 22 24 D3 C5 4F 17 8E' + 'DA C1 53 04 11 11 92 8C 41 06 22 20 30 04 44 64 A3 10 46 22 48 C1 82 22 32 46 22 00 C4 49 83 04' + '44 60 C6 20 8B 11 82 24 A7 5D 73 04 50 14 91 82 20 8A 08 C1 12 68 C6 08 A0 29 23 04 44 11 41 18' + '22 4C F1 5B C2 6F 1E 18 22 80 A4 8C F6 3E 7F C4 FB 0F 88 F8 7F 86 F8 5F 5F EB BE 13 E0 FE 0B E0' + '7D 6F B3 9A 3C 6C 59 98 8C 59 B3 66 CD 9B 36 6C D9 B3 66 CD 9B 28 A2 8A 28 A2 8A 28 A2 8A 28 A2' + '8A 28 A2 8A 28 A2 8A 28 A2 8A 28 A2 8A 28 A2 8A 28 A0 BD C8 2F 74 0B A4 0B DD 82 F7 80 B9 DC 60' + '5E F8 17 E8 02 E2 05 EF C1 74 C1 7C 00 5F 04 17 50 17 90 0B C9 0C C5 43 32 50 66 2C 19 8B 86 64' + 'B0 CC C2 0C CC 30 DA 60 36 B1 03 6A 60 6D 62 86 D6 30 6D 0C 36 A6 86 D3 21 B4 D0 6D 36 1B 58 E1' + 'B5 38 36 B2 03 6B 24 0E C8 9D 8E DB 4C CD 1E 36 2C CC 46 30 F0 A5 AE B4 A5 64 C8 53 07 01 3B F1' + '7C 67 C5 FA EF 6F ED BD 1F 43 DA FB 4F 91 F9 2A 31 04 50 46 08 9F 33 EE FD DF EC 7F 61 D7 FA 9F' + '43 FD 7F D3 FC FE 7F F9 78 2A D5 AB 56 AD 5A B5 6A D5 AB 56 AD 5A B5 6A D5 AB 56 AD 5A BD 8E AD' + '7E 9E 76 76 76 74 AA B5 5D 75 DF 07 83 C1 E0 F0 78 3C 1D EE F7 7B BD DE EF 7F 73 63 18 C6 31 8C' + '63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18 C6 31 8C 63 18' + 'C6 31 8C 63 1F 73 5D 90 D7 68 3B AD 87 77 1C 3B B3 83 BB 90 1D DC 90 DD 70 37 72 83 77 2C 37 67' + '86 ED 00 DD A2 1B A4 0D 4C C0 D4 A4 1A 94 C3 50 A1 A8 60 CE A8 1A 99 A1 A8 E8 6A 55 0D 4A C1 93' + '13 BA 11 3B B1 13 BC 11 3F 50 6B 15 F6 08 AD E8 8A B6 FB 90 45 EF 84 5A 58 24 0C 0B C0 05 83 0C' + '0C 8C 35 4B C1 13 30 A3 89 28 90 4A 43 8D 5C A1 C2 42 20 34 91 8A 12 31 62 47 2C A8 38 A6 1E 8F' + 'DF 20 94 48 46 88 45 B2 31 C2 46 3C 71 24 03 1B 99 24 1D A6 3C 30 C7 88 18 F1 43 19 40 C6 54 31' + '96 1B 5F 99 17 BF B4 F3 BD 4F F7 FA 18 F1 83 19 70 C7 8E 18 CC 06 3C 80 C5 30 BD 99 1E C6 D3 5F' + 'E7 A6 E4 4C 71 E5 F8 D2 D2 B2 9C 5E 27 0E 4E 4A 46 42 3E 3B 85 1A 94 C5 8C 8B 8A 89 88 3B DD 87' + '49 B1 86 FE 90 BB 4E 0F E0 85 1C 26 DF 6B 07 C0 82 D1 7F 42 4F 5F AD 3B 3F AB 5F A8 C7 4B 3B A3' + '41 EA D5 5D CD A8 62 D3 A5 98 4A 34 3D F7 BE 03 80 00 2D 00 00 0E 00 38 E0 00 A4 8C 98 88 22 82' + '23 11 26 7E 73 F3 B2 F1 E1 82 28 0C 44 60 88 08 01 08 00 04 00 80 3F 00 03 F0 E1 50 50 50 50 50' + '50 50 50 50 7B 31 9E CC 66 B7 5B 19 ED C6 7B 71 9E 7E BA 33 5D 19 3D 41 E8 AB AC CF A3 E9 4B F3' + 'B0 BC EF 3B D2 63 5F 13 5E 66 BC CD 7C 5D 7C 6D 71 EB CD D7 67 5D AD 7A 4E D4 A3 4B 77 ED E8 D0' + 'A5 47 B4 4E D6 67 6A 97 6A 9F 68 BD A6 08 42 10 84 21 08 42 10 84 21 08 42 10 84 21 08 42 10 84' + '21 08 42 10 84 21 08 42 10 84 21 08 42 10 84 21 08 42 10 84 21 08 42 10 84 21 08 42 10 84 21 29' + '52 00 0B 40 00 03 80 0E 38 0C 44 60 2F 72 E4 11 41 11 83 24 46 08 A0 31 11 92 2E 72 08 A0 88 C1' + '80 8C 11 40 62 32 60 D0 45 04 18 32 45 DF 2E BC 78 C4 11 40 44 46 48 A2 20 8A 08 20 C0 46 08 A0' + '29 23 24 62 08 A0 88 22 40 C6 08 A0 22 32 46 20 8A 08 82 22 48 BB C2 F1 E3 04 50 18 08 C0 58 82' + '28 20 C4 44 91 9A D6 2D 78 AF 1D E3 04 50 11 82 32 51 04 50 41 C3 91 12 46 08 A0 8C 11 83 B7 75' + '10 45 11 88 88 92 23 04 50 18 23 34 C4 11 41 01 11 24 46 08 A0 30 46 02 88 22 31 88 88 37 39 14' + '45 8C 18 4C 51 1B 04 44 41 44 51 16 28 08 C1 11 8A 23 62 08 31 49 78 B7 83 BC 22 88 B1 82 30 51' + '8C 51 B1 04 44 11 88 A2 2C 60 31 49 18 A3 60 C4 41 45 77 85 DE 11 45 88 C1 82 23 14 6C 1C 39 11' + '49 88 A2 C4 60 A2 28 8C 51 B1 88 8C 60 C4 51 16 30 60 8B BB B1 46 C4 44 44 18 A2 C5 26 08 22 8C' + '6C 11 88 84 C5 18 B1 11 18 31 14 63 62 4C 44 18 A3 16 32 46 0C 51 8D 83 11 09 A3 16 22 30 41 46' + '36 24 C4 11 A3 16 32 46 0C 41 A3 1B 04 62 20 8A 8C 58 88 8C 18 8D 8C 6C 11 88 82 2A 31 62 22 30' + '62 36 31 B0 62 08 8A 8C 58 88 C4 44 6C 63 60 C6 48 8A 8C 58 88 8C 44 6C 62 82 30 44 45 46 31 11' + '11 88 8D 8C 51 26 08 88 A8 C6 32 44 62 23 63 14 49 14 44 54 63 11 11 88 8D 8C 51 24 44 45 46 31' + '92 31 11 B1 8A 08 80 80 70 A8 63 A8 63 E8 64 28 64 68 64 A8 64 E8 73 33 38 B4 52 94 52 B4 52 D4' + '5C 6A 29 7A 2E 3D 14 C5 17 22 8A 02 02 02 02 02 02 02 02 02 02 02 02 34 68 D1 A3 46 8D 1A 34 68' + 'D1 A3 46 8D 1A 34 68 D1 A3 46 B8 8E 08 DC D8 B1 62 C5 8B 16 2C 58 B1 62 C5 8B 16 2C 58 B1 62 C5' + '8B 16 2C 58 B1 62 C5 8B 0C DC 33 1D 94 59 B9 66 E9 94 99 BB 66 F1 9B D6 6F 99 E8 32 26 6F D9 4D' + '9C 06 70 59 51 99 0C C9 65 56 65 32 B3 2B B3 2D 9C 26 70 D9 61 9C 46 66 33 8A CE 33 23 66 6B 2C' + '9D 34 78 D8 B3 31 18 C3 C2 96 BA D2 95 93 21 4C 1C 04 EF C5 D0 BE F6 FE DB D1 F4 3D AF B4 F8 AF' + '67 EC BC FF 3E 2A 31 88 88 C4 46 C6 28 22 22 2A 31 88 C1 88 8D 8C 50 44 44 45 46 31 83 11 1B 18' + 'A0 88 88 A8 C6 23 21 B1 46 08 92 A2 88 8D 26 36 28 C1 92 28 8D 14 45 24 60 28 A3 12 44 9A 28 88' + '8C 51 44 98 34 63 26 0C 51 40 44 44 68 A4 88 C4 45 14 07 9E 77 5F 01 F0 1E FF EB 3C 9E 4F 37 D6' + '7B 0F 61 E4 F2 79 3C CF 33 D5 FA BF 57 EA FD 5F 9F E7 9E F9 EF 91 16 48 8C 44 18 22 20 08 01 08' + '08 08 01 08 08 08 40 40 FC 40 41 E9 7A 5E 95 35 9D 3D 9A AB 35 76 75 16 75 36 75 56 75 74 15 76' + '75 96 3F 76 C7 A8 79 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 79 E7 9E 79 FC A9 AC 56 AD 5A B5' + '6A D5 AB 56 AD 5A B5 6A D5 AB 56 AD 5A B5 6A D5 AB 1F 27 95 27 97 27 99 27 9B 27 9D 25 09 3C F9' + '31 A4 DC 49 8F 25 19 37 32 6E A4 A5 26 EE 4D E4 9B D9 37 D2 7A 12 45 26 FE 4A 72 70 24 E0 C9 52' + '4C 85 30 70 13 BF 17 42 FA F6 F2 ED 2B AB 94 63 DC 46 E7 A1 CE E6 F3 39 7C A5 55 38 00 E0 03 80' + '2D 00 0E FF F1 77 24 53 85 09 0A 9E BD F7 D0' +} + + +LANGUAGE 0,0 DECOMPOSITION UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE +{ + '42 5A 68 39 31 41 59 26 53 59 D6 98 E4 73 00 55 E0 FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF' + 'FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF E0 5D 34 BD 07 43 D0 03 40 00 09 00 1C' + '07 D0 88 2F 00 54 65 96 24 81 4F 29 20 02 EC 00 68 29 20 49 20 2A 42 15 52 40 0A 14 05 0D 14 00' + 'D0 54 AA 54 12 F7 C7 C0 00 0F 80 01 00 7D 45 3D 18 00 59 10 3E 21 BC DD 2B 10 65 6F 0F 9F 6F 97' + 'AE EF 80 00 3D 61 6A 2F 7A 52 7A 90 35 E7 67 2A AB 06 13 E5 00 76 32 BA 2F 44 87 70 D6 75 AD F3' + '0F BB CD D8 3E 83 DA 52 FB 61 52 A0 0A 1E 95 25 20 54 D0 D0 00 A2 4A A8 0A A9 44 80 00 00 78 00' + '0C 86 02 30 40 00 00 00 A0 01 F1 89 48 D2 46 8C D4 1A 7A 4F 14 3C 44 F4 F5 18 53 C3 51 9A 68 00' + '13 32 62 62 31 0C 04 D3 26 46 13 D0 C2 19 19 32 64 64 C8 64 C2 60 68 31 1A 34 D0 D0 00 0C 41 A6' + '11 84 C0 60 93 4C 13 C8 0C 86 15 54 22 6A 62 02 68 19 00 00 41 A6 23 46 9A 1A 01 91 36 89 A6 86' + '40 21 FA A3 02 69 A0 D3 26 D4 34 D3 46 48 A7 E4 61 A0 00 4D A6 93 D0 06 10 34 31 01 A4 7A 9E 80' + '32 9E A9 98 54 7E 29 E4 31 A9 80 34 D1 34 DA 2A 0D 04 D0 1A 21 04 8D 34 C8 68 26 98 93 62 6A 3C' + '42 64 C9 3F 26 81 4D 84 DA 8C 4D 31 4D 95 3D 47 E9 4C 86 9E A6 9A 69 E5 1E A0 07 A8 1E A3 4F 51' + 'EA 68 7A 81 A0 00 00 00 1A 00 01 EA 00 1A 62 31 3D 34 9E 50 01 A0 1A 9E D2 48 93 02 26 42 31 4D' + '33 46 86 90 F4 29 B4 0C 84 D3 6A 6F 3D 45 00 00 26 10 F4 26 26 00 00 8C 46 43 26 00 01 32 60 26' + '20 C0 41 A3 09 E8 8F 53 D1 06 04 69 A6 02 61 30 9A 60 4C 06 82 4F 54 A9 45 26 9A 8D A2 33 28 F5' + '30 4D 31 1A 34 34 C9 93 4D 18 13 20 62 34 64 69 A1 A0 D3 1A 69 31 19 34 F5 0D 18 00 26 99 31 0C' + '46 01 34 D1 A3 40 68 00 00 D0 C8 C6 81 19 19 1E 41 34 1A 68 64 C0 00 49 A9 10 4C 89 A1 34 4C 80' + '89 E0 04 34 4F 53 00 C8 98 26 4D 30 99 32 64 32 64 D3 46 86 8C 9A 6A 30 0D 1A 9E 44 CC 4D 32 61' + '4D A6 26 44 F4 6A 61 A6 8C 09 A6 A7 A6 8D 34 1A 34 9E 8C 9A 46 D0 D4 F1 34 31 34 D4 D3 3D 53 F5' + '46 09 9E E7 F0 2A 62 E3 E7 B4 7C AF 2F AA E4 FA 0C FF 3F CE 5C 07 3C 3A DE 7F 2D C8 3E EE BF 1C' + 'FE 91 5E 6F 94 E7 74 5C F6 93 9F 65 8D 3F 2A C6 B5 AB 5E 67 5F 5B 5B 84 06 C3 61 B0 D8 6C 3F 8E' + 'C3 61 B0 D8 72 25 7F 9A 97 7E 2F 9E D3 12 FA FD 2E 2E 17 F8 79 DB ED 8F 91 E4 F9 5C 0E AF AB 96' + '9D 42 9C CC DC EC F5 5A 0A D6 2D 5D A2 BD 83 16 5A 6C DA B6 6E E1 C8 82 8C EB 51 DE AB C7 AF 9F' + 'C0 D6 1C 88 50 E2 45 8C 4C 79 12 4B 30 ED 9E DF 77 B8 DD 6E 35 FA FD 7E BF 5F AF 39 CE 73 9F 4C' + '8A 28 A2 8A 38 18 F8 FE 0F 93 CB F9 55 6A 72 38 9A 0C E5 5A AC B1 55 8A AE DD D5 79 57 EB FA 78' + '9F 76 74 33 EE F3 FB 8F 3B CE F9 AF 37 F2 9F C3 F7 3A 2D BE 01 B5 73 46 D7 C0 4D 11 06 2C 04 82' + '22 00 22 03 09 EB A7 AE CA 51 17 CB 1C FB AD 74 18 10 B5 6B 3D 87 AB 6B 1F 8D C6 FC 22 02 73 A2' + '15 07 6C 41 E7 FB 77 EE 9D 30 E1 D1 8C 63 32 F5 64 51 B3 B3 83 05 EA CB 2A AB 87 5C E0 F3 82 F3' + '75 32 23 D6 BD C2 44 08 00 30 14 76 F6 C9 48 3B 33 40 11 10 10 11 46 04 08 10 1B BF 7E FD FB 96' + '00 4C E7 C8 B0 62 C3 69 31 A2 6C B3 E7 BE 85 73 E8 3E 7C DF 56 FD FD DD DB 56 AD DB C1 D8 6C 2C' + 'AC BA 3E 8B 61 B0 BF B9 DE 44 BF B1 A5 37 7B 5B 6B 6A AD 84 B0 19 93 22 D8 25 33 BC 42 C5 24 E1' + '59 20 63 21 16 29 8D 1E 39 4B 26 4A 6C 3C 78 F1 E3 F4 5A 4A 70 DD AB 69 4E 5C B9 55 EB ED B6 DF' + '71 B9 F0 FC 4F 17 C6 EB 7C 65 14 87 6D 5B 23 73 01 E4 07 BB DB BB DC 6D ED EE 57 2F 78 6F EF A0' + 'AB E3 38 26 47 6B 72 AD 0B 44 FD DB F9 C9 DE 3C 34 D2 F7 A6 00 F7 72 F9 DE 0F EF A7 58 96 EA 15' + 'D3 D8 31 2C 7A DB FB 9B 9B 8B 86 CD AE 2D 2E 25 08 84 89 15 B5 F1 A3 46 8D 71 16 27 5D 9B 90 48' + '16 52 60 C6 F1 0E 64 6F 9A 47 AF 30 22 8C 59 72 FC 57 EF D5 AD 81 02 04 09 12 21 42 72 15 AE 53' + '84 EF AA 44 0F 7F 05 EB EF 1B 1C 3B C7 AF 5E BD 7A F5 CB D7 AF 5E BD 64 27 28 E8 BB D8 86 33 31' + 'D1 03 19 68 B1 4B 70 B1 01 F9 66 39 88 5B 0B 84 80 0B 32 2A 85 DD 5F D9 DA E6 E3 54 A0 22 E1 48' + '50 10 F2 30 1E 95 58 65 2E 7F 05 0A 8B 3F 2E F3 09 0C 37 CF 8B 52 BD 0C 16 5B 96 A2 48 5E B1 58' + '5A 8D D6 56 5C 92 49 24 92 49 24 92 66 C3 9E DC DC 9C B6 63 B2 6E 6E 4D FD CE 8F 41 FD 3D B0 E5' + '79 2D DC FE AB F3 BD 03 0C 23 BC 45 A9 73 2C 30 58 B1 C6 8D 69 B2 8E D8 2E F6 C5 0B F7 92 0B 30' + '1D 5D 3C 93 25 5B 27 97 38 AA AA F6 B3 13 09 C5 26 28 E1 B6 6C FE 85 AE 55 86 1B 36 99 75 61 9C' + '95 97 89 96 7E FE 24 4A 58 31 A3 59 D0 AD CB D6 A4 A2 C5 AD 4D 38 46 C6 B2 AF 2D F3 95 71 0D 59' + '36 69 66 46 8D 1A 32 90 92 AE B0 98 58 8E 17 41 F3 54 72 AD CF 35 15 66 B1 35 AC C9 93 26 3D 7A' + 'F5 EE 03 B7 68 3C B1 92 C1 72 D2 A5 45 8A FD 2B 05 2B AB 97 55 56 96 EF 2B AB 8D 1D BC A7 55 8E' + '59 46 43 15 24 47 B0 8E CD F5 EC 99 11 E0 CF B4 B8 B3 B1 A9 52 A5 4A 95 2A 54 A9 86 A2 8A 28 A2' + '8A 28 A2 96 37 36 74 6C EC 28 D1 9F 63 46 8D B5 A5 AE 46 FA EA EA EA EA FE FF 22 FE 95 EB 46 EC' + '96 DE B5 0B E7 0C BC 36 66 8D C1 5D BD 7F 46 3C B9 72 E5 CB 97 2E 5C BA 4D A4 D6 56 DF 33 7D 2E' + 'FA 65 E4 2B B5 6D E6 DB D8 D2 A4 E6 CE 64 CB A6 B1 A9 81 2D E5 C9 93 26 4C 99 32 64 C9 68 A2 8A' + '28 A2 8A 28 A2 95 CE 06 C6 66 7D DC 07 11 24 52 75 70 23 F1 BD AF 56 2D 8B 7A C8 21 04 44 60 8A' + '10 50 42 0A 08 19 A5 75 75 95 95 73 5A D3 B7 B8 B1 97 3D DD 37 16 A2 02 04 07 2E 4A C8 94 44 AB' + 'DD 42 9D 67 63 36 3C 17 16 2C 59 D6 BA B7 94 D6 23 FB 9B 49 B3 E1 53 81 08 40 60 C1 2D 71 01 40' + '86 53 88 BC 6A D6 E9 9B 18 B4 DA AA 0A B5 41 A9 01 74 0C 22 F6 8D 10 C1 6D 79 2A CA 74 66 CD 01' + 'A3 64 01 06 A8 21 75 83 41 74 E3 CD AC 91 BE CA 22 E1 F0 83 06 BD 9E 6D F9 BC EE 67 2E FB F7 B0' + 'B1 DC EE 6B D6 DF BF 2B 99 CC E4 DB C0 3A 8A 9B 9B 9A F0 DB 91 1E 3C 43 65 16 50 14 15 85 61 2E' + '5B 1B 1A 7A B1 64 48 8D FC B1 1B 2E 0B 8B 61 6C 25 81 6A BC 59 12 22 EF F2 B8 F6 09 C6 91 1B 16' + 'F4 F1 6B 64 43 B7 B5 6A 94 28 B1 5E 7A 12 59 10 BD 4D E3 F7 EF 77 D8 E8 C7 7D 01 E3 3E 8E 42 77' + '4A 3E 9A E3 F9 71 A8 A2 F6 24 05 6D 58 73 79 7F 79 4E E1 A2 4F E1 42 BE DF 9D E2 2E 30 6C 6E 56' + '87 15 87 B9 5E 2A F6 CB C1 41 58 6D DB DF D4 52 31 55 7A BD B1 2D B1 90 A2 25 42 89 71 44 0A 86' + '64 A0 E2 B2 BA 7B 4C 67 08 04 38 D2 22 C6 84 95 75 74 A8 CF A4 52 CB 26 AC 28 D2 33 67 B0 56 4B' + 'A7 CE E4 D9 35 3C 0B 8B 7C DA EC 40 11 38 82 02 08 0B 36 97 70 9C DE 50 C6 84 D1 56 D6 6E 5B 59' + '16 F1 AA 70 9E C2 86 9A 98 B4 13 90 98 3D 81 0D 38 AB 19 35 D1 4C 1E 3E AD 79 97 4F 3A 90 3A 6B' + '5A D6 8D 14 D2 08 F4 1F 24 A2 6E D3 72 11 1D C6 AE 9A D4 0D 06 BE 0C 15 F2 CB A6 0C D9 C4 B2 87' + 'A0 B2 4D CB 2A E6 A7 CD 92 FF 32 A4 17 34 68 CC 8D 1B 32 9D 8B 8A 20 5A 11 22 63 E3 9F 06 D5 3B' + 'C8 8F 34 19 09 CA 88 DD 57 B1 66 56 D8 24 FE F8 2C 63 CE C3 C8 6E D1 A3 46 8D 0D 7A D3 3B 74 DA' + '41 F1 DA 41 65 E2 B3 A7 C8 91 7D 99 55 DA 79 D7 50 23 66 6F 13 96 83 DB 4B CB A8 E9 66 51 B3 8D' + '12 25 4C CC 46 6D EB 21 42 C8 03 D0 6E 16 10 20 64 70 12 B4 B0 7E FD 13 DA 51 7A F7 D2 91 45 DB' + 'BD 2B 26 25 60 31 2A 7C 81 00 73 36 15 BC 08 1A 35 D9 95 CC 29 12 74 38 7A 3D 12 AD 0E EA 0A B1' + 'AC A2 37 E4 ED 81 61 52 0D 29 12 8B 1F 46 9B 44 A4 DA C2 85 56 62 62 0D 19 B3 35 08 4F AA 99 E4' + '00 BD 74 D6 33 4A 36 CE E1 2C 7B 29 EC 2D 55 D0 24 68 E2 2E 9C A0 05 10 28 E0 51 BB 83 06 AA A9' + '65 2C 33 52 56 BC AA D6 36 83 4C D1 F4 F4 00 D0 A1 21 A6 7C 07 9A 0F ED EB 0A EE 4A F3 E9 C7 8A' + '82 D9 50 59 A5 9A E5 29 4A 56 AF CE 73 C1 85 3D 50 CC 48 90 56 52 79 3E AC 58 B6 D2 54 49 37 0E' + 'E7 DA E6 91 8E 9E 63 2B 6D 6A AC 5D 1A 4E 65 BB B5 AC 81 01 2C 4A F9 C9 DA 97 92 86 BE 76 1A B7' + '35 D0 D6 A0 B6 82 1C 36 E0 AD 7A 73 5E E7 2C 21 C3 72 A5 7A 78 D4 6E 64 C5 8A 9B 6C DC A4 14 52' + '54 B8 D1 94 AF 4D 3B 2E 42 14 24 91 9B 29 04 E3 D4 83 05 35 2B EC 93 A0 7E 42 04 08 B4 0E B1 00' + 'A5 AF 55 5B 59 90 20 60 BA 46 B6 34 08 07 3B 7D 03 E7 D4 E3 C3 4B 19 77 EF D6 8A 8C 87 4E 8A F8' + '70 DD 3A 9C 6A 6E 9D 4D 35 0C F3 0C 52 39 F3 AE 5C D6 1C F4 1C B9 CF 47 45 1C BB 0C 4F 39 DF 30' + 'C4 E3 D1 7E CB 33 8E 7B 96 59 E4 ED 11 46 93 2C D9 CF A7 5D 99 76 EE CC E7 CC BB 77 38 F6 F3 9E' + '3C 31 A5 CD 65 9B 14 51 BB 61 85 0E 57 1A 69 08 6C CF 3E 2B 37 4B 4D 39 FA E3 E3 76 B5 52 CC DE' + '36 9A 4D 9B CB D3 4E C3 36 CF 13 5E B6 6F 1A DA 5D B1 E5 66 8D 04 F2 74 D1 60 7E 3E 59 33 76 E3' + 'DC CB 29 75 25 29 EC CF 30 D0 EE 67 9B B3 63 5E 9A 70 6F C7 5D 15 7A 79 E7 C7 39 F0 DC 38 F4 15' + '46 E1 BB 78 E6 34 26 CD CC 6C 1B 17 26 33 66 C5 7E 92 E5 2D 4C 3C 03 1B 0A C0 A5 46 23 E3 3A A9' + '23 28 67 15 30 CB 32 A3 62 96 A2 25 2D 4C 32 95 54 2D 2A 2A 73 36 C2 58 AD 72 8D 27 19 2C 15 8B' + '4C D8 17 0A D0 46 92 38 0D A1 59 A3 49 19 74 D8 3D 26 D4 D8 36 19 B0 06 15 C5 9E 19 A1 33 69 68' + 'F8 F8 0E 6D 1E 99 B2 C9 1A A5 48 90 A0 3D 51 45 14 51 45 14 51 45 14 51 45 2E DF 1E D4 CB BD 9E' + 'D9 D5 7B CA 54 2D 5D 22 F5 A5 AB C3 5C 30 E9 A4 F7 C8 CB 6F 69 00 D4 F0 1B 5A C3 3C D6 F6 B4 30' + '65 4A 6F 6D 4A FD BD C5 35 E8 C0 C1 6B 72 FB 05 B5 D3 9B 76 8D 9E DD 39 B9 6A E2 EA 85 D4 C3 5D' + '5F 5E 30 BD E4 AC 07 2A 50 7D 4D C9 AB 1E B3 78 C5 E1 AB 69 B1 76 D6 B5 DB 9B 0B 9B A4 E8 B3 76' + 'F6 3C 8B E7 56 D4 5E C8 75 7B 31 F5 F3 BB 59 A9 3A 66 F6 AD BB 6B F6 2F 8F 46 7D FB 37 DA 66 4F' + '49 D5 FB BB CA 40 EA FE FA E6 93 A9 56 93 2D DD 4A BD BC 95 68 EA 53 CA 96 F4 DD CB B1 9C E1 D4' + 'CB 1A FA 6E E5 DF 2B 4D 99 77 C6 BC 73 61 7B 4D CC AF 99 FB E8 6C 57 7C F7 E1 18 30 5D 57 7D D7' + '17 99 47 72 AF D5 42 BE B6 4C 68 90 5F 32 DD 45 14 51 45 14 51 45 14 51 45 14 51 45 14 51 4C A4' + '15 BE BA FC 08 0D BE BA 75 20 30 FA A3 E7 74 6A 39 7B 80 FE A3 98 15 1B C1 9C DA 15 46 B0 F0 6A' + '2F 16 A2 F1 70 97 87 E5 65 1A C2 59 7E 5B 28 DA 13 F7 F8 2E 60 9A 9B 98 34 9C 41 9E D6 0D C2 F0' + '6B 2F 17 87 F7 25 78 D6 24 BE 25 E3 78 DC CD E2 B1 A4 5D 38 88 5A 2D E1 DB B5 85 6C BC 2C AE C0' + '44 36 01 5E 80 11 02 08 88 E8 84 82 82 00 24 01 79 3B 5C 49 31 30 FD 7C EC C2 26 2C 12 89 E3 B5' + 'C1 9A 24 C2 20 4F 3E EA 08 B4 CC 0F 45 DC 63 28 6C CA 64 84 10 C8 32 42 62 A3 03 49 19 88 B2 9A' + '67 86 E4 40 8D E4 EE 77 93 AF 0C 90 26 31 8A 4A 08 A8 A1 14 83 30 8C 92 18 A9 90 49 21 64 34 8C' + '65 AE 79 96 40 18 15 FB 19 4D 85 86 7D BB 45 24 94 22 22 78 A5 DB 69 13 C7 4E DA E4 4C D5 19 28' + 'D1 45 24 43 0C D7 E3 6B 5E 94 5B 5E 3B 5A E2 DA 5B 66 B5 36 D9 AD 5E AD B6 DE E9 A3 12 16 C6 8B' + '26 31 89 23 18 B0 D5 57 AC DE 89 BC D7 5C AF BB FC D7 90 BA AE 82 D0 59 98 40 EF 8C 50 2D 8D 07' + '95 4C 98 64 FD 6A 7B 84 15 76 34 99 D5 16 70 73 65 D5 22 28 AA C9 92 14 C9 4C 7F 6A B1 90 1D 94' + '4A 44 58 70 49 27 6E FF 80 01 25 10 99 79 28 A2 A4 48 12 13 79 3B 70 C4 26 F3 1A BB A4 0A 1B 97' + '62 8B 62 F1 E7 65 DE 1E 19 DD CD 9C 5D 6F 2E EB 8B C7 77 77 0D CE 93 77 17 48 17 9C EE C1 E1 1A' + 'DC 23 6E EE 0D EA 0D 77 B9 F5 DE 38 DC 88 1C BA 73 B7 31 7A 6B 76 47 89 A3 C8 EF 2D D0 EE 23 49' + '80 2A 92 5C C0 F0 CE CC E9 91 97 EA 2A F8 7C 4E BB B7 F6 FC 72 8F DD FB FE 8D D6 D4 2D 93 69 7B' + 'E6 9F BF 00 B2 03 98 9F E0 DC 4B 0D F3 32 DA E3 C4 1A 60 35 64 3C 97 6E C0 B9 7C C9 6E 97 00 F8' + '9B D2 A9 52 1D AF 84 4A F8 A5 93 0A 69 55 99 60 31 43 05 4F A6 FF 25 BD BA A6 96 4D 9B 5E 52 C8' + 'ED AB 63 2D AE 93 A2 E8 1B B8 36 F2 6C 45 1B 59 DD AB 25 EE B2 5C 6D A1 21 64 24 51 31 D0 B1 24' + '74 81 B4 DB 09 07 01 5E C5 98 5A 26 26 D5 35 8E 02 A7 6A 76 C2 18 31 AA 06 9A BC B5 D2 A5 72 EE' + '45 11 8D E5 A2 57 06 95 55 5A 55 80 BA 18 2B BB C4 3B 26 A9 A5 2F 6A B3 85 20 6D 36 DB 69 B7 64' + 'D4 06 DA 12 14 24 51 31 D2 16 16 83 A4 0F 0B A8 A2 6E 8A 88 70 16 38 DA 59 C2 D4 98 9B 55 82 16' + '0D 53 48 6A 27 85 18 3B 32 CA 26 06 02 4C B7 71 71 A4 BE 5B B1 C6 EE 18 A0 B0 58 A5 F2 AB 29 6D' + '53 C2 52 76 69 D5 EA 53 48 A7 4A EE 95 DA B1 7B B6 38 A9 A2 64 B1 74 2C 94 8B 2A 25 26 FB 51 C1' + '45 17 45 98 1A 18 CC 36 16 AC 0C 50 A3 A8 9A B3 65 58 B1 49 6B 15 B3 7D 58 AA 38 63 2C 3E 61 26' + '02 60 A8 5E 2D 9D 87 08 10 45 18 89 3C FC 21 E7 C8 80 A4 81 D2 36 EC 99 2E B7 6C E6 EB 57 56 CD' + '5C DA 36 7A 54 AB C3 78 B5 74 C6 4D 19 A6 13 09 B6 DC B6 16 46 D3 AA 92 75 72 09 24 E0 2F B0 E9' + '7B B0 18 30 82 84 22 98 6B AF 24 F9 8D 84 A2 8D 6D D8 2A 5F 2A 8B 6F 7A 3C B9 B4 08 05 52 44 02' + '01 49 22 01 00 80 5B 74 B7 4B 1D 23 41 6E 9D A9 4D 6F A7 4D B7 6A 8D 3B 0A C0 E2 51 6C AD 7E 23' + '78 9D 2B C3 91 2A 5F 2A BE 1D FB A5 F3 78 62 30 9C 99 A0 50 1C 15 79 AC B8 95 36 C0 D7 9C 64 B7' + '8F 17 19 2E A6 BA 55 D9 BA 6A 0D 78 64 B7 8F 1D 45 D4 D7 6D E4 D5 49 B5 25 57 95 57 29 9C AB D5' + '3C 76 D2 AF 52 5A E0 18 4C 06 48 83 11 11 45 19 D0 04 87 41 0B 97 A8 5A 01 39 F8 C0 97 B0 2A B0' + '49 52 D2 D6 8A AC 2B 9E 0E 73 14 05 AB 5E 73 CC 8D 8B 78 D5 BC F5 1A 69 63 49 25 61 AD F9 6F 3C' + 'EF 1E 62 EE EB BB A2 22 22 22 36 DE 44 E7 CE 23 28 0E 85 4E 90 D0 E0 13 95 CD AE 73 98 CC 39 95' + '87 C5 E7 78 5E 9F 0C 44 E6 84 0C CA 80 2B 05 11 10 64 1E D4 25 4A 39 A0 72 F6 F2 00 1C 56 92 72' + 'E4 39 39 77 36 1A 3C 55 C7 A0 54 BB D4 F1 FD E7 92 BF 18 E2 30 E0 DF 09 47 32 E5 1B 5D BB 49 52' + 'F9 D7 90 EF 5B BC DF CB C3 11 C8 42 73 28 A0 A4 51 A0 62 95 54 9B 77 42 70 60 75 D8 14 6F 77 EF' + '81 45 F4 AD F8 F0 1B AF 80 E2 30 01 22 11 D4 D6 C6 DB 94 66 EB A9 52 F9 D6 BE 07 A8 DB 81 86 22' + 'A2 CD 1A 88 BB D0 16 EA EB BA 5C AE 81 DC E4 51 A3 14 3C F7 9B FC EE 05 F1 E0 DD 6E 0A 85 42 23' + '30 D2 BE AB E8 38 FE 3E FC 4C 72 11 04 44 10 44 43 5A 2B 65 6B 56 D4 4A 19 7C 6B 5D 79 9F 13 9B' + '89 8E 42 43 7D 14 7D 5E 95 AD 54 84 52 DE AD BE 9B 06 88 32 1B 41 81 FA 2D 2A C2 0A E8 EC 02 06' + '9B FD FF E4 3E F7 F0 D8 4A 40 C8 00 0C 18 13 B2 2F 59 05 CF 54 02 19 C7 09 83 10 A6 3D BD 5E EF' + 'FE 2C 25 22 C1 84 A9 D6 C8 B2 F8 F8 8E 66 B9 E9 81 96 51 38 28 AC 1D 34 2A 5F 1F AA F2 D4 5E E2' + '13 9E 12 87 36 73 F8 86 14 9A 51 FB 1E 55 60 23 1D 02 04 13 9A D5 75 19 05 26 92 34 7F D5 DD DB' + 'F5 64 52 1D 13 FA 40 FC 4B 20 22 C2 04 16 37 3B 99 42 89 D7 8F FB A0 20 18 74 50 70 6E C0 2F 6C' + 'ED 60 10 A1 3A ED FA FC 8F AF E6 E2 6C CB 38 41 64 05 02 3B 28 85 0F 0A 56 AE 18 15 2F 8D 76 FE' + 'B7 9B 6B 99 56 24 82 21 05 02 28 06 75 6C CA 97 C2 AF D2 FC 9F 19 DF B1 31 12 17 00 C2 00 2E 7E' + 'DF 50 6C A6 EF 0E 7F 1E 79 E8 10 3E 12 DC 4F 69 FA FA A4 24 26 35 00 69 A8 DD C0 42 ED 49 3A 57' + 'EF 2E 9F 5A F2 12 0E 2E 47 E2 E2 18 C0 01 09 A4 9D 57 F0 3D 9F B5 BC 84 84 C5 C0 AA 07 83 C0 04' + '28 45 34 CE D7 E2 E9 21 59 D0 81 D8 D6 C4 85 06 4D CB 7D FD BE CE D2 15 9D 06 46 11 CE 1F 3E E4' + 'A4 D2 4E 2E 3B 37 BF 87 21 29 83 00 11 83 73 7B 02 08 50 64 F6 74 F1 2D 6B 48 4A 74 CC 20 57 37' + '60 10 A1 14 E0 7C AD 68 88 C8 8E A7 5A 80 82 0C 9C 88 E5 F5 69 BB 21 21 31 91 CD 6D 60 48 50 8A' + '6C CB DC ED 30 61 12 F9 34 5A 10 32 83 24 F3 F7 34 CA 22 39 50 50 10 80 10 42 3F 92 76 64 28 1E' + 'DE 87 81 D9 B5 44 40 95 81 84 E9 9D AC 10 A1 14 C8 70 67 56 0D 19 42 A1 44 38 4E B1 20 10 A1 24' + 'FB 7B 7E AA D9 3C 84 A6 60 00 46 0C 18 30 E0 2A 84 78 3B 90 42 63 FC 63 F5 1E D6 11 91 84 42 43' + 'AA 56 A8 50 64 F3 2B F8 34 60 D1 31 25 BC 04 12 A9 53 28 1E AF B2 E9 63 FE 0F 61 29 98 09 DD 50' + 'A0 EC 96 B9 21 40 FF 29 9F 59 FA EE E2 53 32 20 5A 29 21 A1 83 30 66 44 A3 DE 41 DC 21 41 93 6B' + 'FE 05 58 34 41 C2 56 96 9A 5F 4D 25 31 97 77 69 DD 34 D0 C3 BC 40 15 55 55 55 55 6D B6 DB 4D F5' + '56 DB 7C 26 3E 13 18 C7 C3 7D 0F 13 C1 9C FF 0F 87 C5 AE 7F 81 C0 E6 26 E6 9B F2 7D 63 D0 96 93' + '5D F1 A8 11 10 E3 0E 21 95 17 8F C7 24 28 32 7D B6 5D CE CE FC 44 64 01 D3 ED D1 0E A0 19 41 93' + '5E 7B 6B CB 68 83 90 E1 23 09 E2 82 74 77 24 26 94 1D FC 5F D4 7A B9 C8 50 88 50 21 00 48 60 00' + '55 ED 40 07 67 0C 85 08 A6 4F C7 D1 DE 42 53 06 01 68 A0 00 41 14 1E 97 4B DD 09 A2 9D 5B E3 3F' + '7B 79 09 10 00 4C 18 40 44 43 C9 45 17 2B AD EE 02 13 49 36 5F 7A FE 55 E4 24 0A 61 34 40 A2 FA' + '25 EE 41 09 A4 E3 BC F9 3A DD 84 81 01 20 60 9C 8D 01 BB A3 BA 13 49 38 F7 E3 DF E0 DE 42 44 5D' + 'B3 04 05 0C 80 0A 44 5E DE 4B 00 6E 31 85 35 42 84 93 F0 B1 F9 5C 6E 62 42 40 10 C1 95 02 82 BF' + '74 E1 00 C0 B1 D3 86 59 12 14 68 9D 5C BC BC BB B9 48 5E 60 19 99 91 99 10 A1 E2 04 7A FD AB C4' + '44 77 99 A6 6C 48 4C 7D 0C F9 B9 EF E7 90 CE 60 81 83 2C 8E A1 53 18 4C 60 21 83 28 CD 3E DB 1D' + 'F7 DC 6F E2 42 44 2E 66 46 0A 9B 0B BD 22 0A A2 04 99 64 99 64 02 14 68 9D FF E0 F8 D8 C4 44 41' + '38 30 53 C0 F9 0A A2 11 C4 30 78 C1 21 73 2C 9E AF 67 EB B7 2D 11 12 0E 64 57 C9 10 2B 63 0D 8C' + '21 4A 89 D5 B3 EA F8 71 18 93 70 24 F1 FC 64 29 11 87 90 49 64 51 88 1C 50 BE D3 8B C2 70 F1 61' + '5A 11 21 44 F4 D3 A1 E2 D7 31 12 19 99 14 C1 A9 A0 83 CD D9 DC 12 14 A6 9A BC F3 7B 30 62 8E 53' + '35 50 EE F0 79 04 11 3D D8 FC 5F 25 DC 52 54 A7 01 85 77 48 C4 12 13 49 38 8F D5 E5 5E F2 15 9E' + '75 E5 91 0E 40 2F 90 20 CC 38 88 BA 68 B4 D0 21 48 F8 7E 67 5F 2C 84 E3 63 02 7B 51 09 DD 62 E0' + '21 31 BF 41 EC 24 D6 91 E5 D1 08 14 40 FD D3 AC 9C 82 1F 50 C9 0A 27 7F 37 F2 FA B1 48 94 9D 10' + '9D D5 AC 48 18 ED F4 FA 5E CD A7 11 61 B5 28 4E EB 17 04 84 C7 E4 5F F0 FE 85 F8 78 34 CF 80 D0' + '18 8B 15 16 08 CA 0A 47 82 A8 EA FE 83 7D F2 DF 4C 12 89 AE 3D 1E 56 31 88 CB 00 CC C0 A1 10 00' + 'CC 80 40 88 1D D5 9C 90 9A 49 07 F3 A6 D0 6A 03 31 23 40 11 00 87 9D 9B 30 69 5A 13 B0 42 89 AF' + '3B 99 2C 3B 46 A0 19 99 9C CC B9 21 54 21 07 66 5A 5F 2B CA 98 36 D3 B5 78 CD 74 C3 1D 4C C1 11' + '01 54 A4 4A 59 24 97 90 08 5A 8E 4A DB B7 5C F6 86 C3 36 D7 FA 5F A2 D7 0D 10 48 28 25 01 16 AB' + '5E B5 6C 51 29 1A DB AF F9 BF 2F 3B C9 C8 8E 88 A4 08 18 2F C9 28 81 E3 06 F7 0C 1A 69 0B F8 97' + 'F0 AF 28 CA E0 8C CC 85 0E 0A 63 BE EF 60 C0 C3 5F 13 C0 26 11 35 C7 4B 1E 8E 31 20 E4 54 32 24' + '33 00 91 41 11 12 20 30 7C 57 B3 91 30 68 A3 F9 CF EA 3C 62 4E 60 21 10 24 30 40 17 C6 5A 0A F8' + '57 BA 90 62 63 BF 73 BC E2 5D E5 2B 80 74 44 34 80 53 DB D3 68 8C 5D 70 94 A1 46 89 8E 56 AF 7F' + '88 CA 56 06 88 10 C1 96 30 A2 03 E2 76 32 CB 22 A1 44 FE 0F BB D9 BD 96 52 95 C1 99 80 88 83 9E' + '8A 0F 07 7B DC A4 51 9A 78 7E 45 FB 17 8C B2 D6 45 3C 25 78 1F 23 F1 71 BE 4B 5C 3B F8 5E 12 63' + '30 C6 B9 3A AD FB F0 C0 DE 64 0B 14 45 52 30 55 6A 9B 2B 5A DF 5D 75 98 CC 72 AE 3E 9B 97 B7 6E' + '38 9A 88 19 8A 99 9A 03 7B 3F D1 4B 90 62 F7 4B 8F 0F 18 C5 C4 CA E1 08 20 30 30 8A 0F 0B 85 B5' + 'C0 41 19 74 FC 7F A3 7B B1 48 58 84 CC 21 98 E2 9C 37 AD 11 0C 5F 0A 8C 48 4D 2E 1E 77 1E F0 29' + 'E5 96 E8 B6 AA 96 2A F0 AA 1F 17 7D 6D 8E A2 95 31 E7 F8 F4 D2 61 B2 0A 26 36 02 4B 51 6D 36 69' + '6A D2 91 98 65 A7 5F A1 69 81 A4 C5 51 06 46 08 52 0C 22 90 E9 A0 5B 35 96 D6 08 23 97 9B E6 D8' + '98 50 18 02 26 01 A7 3B A4 97 80 6F 35 EE A9 72 24 26 D2 F7 B9 30 B0 23 28 99 18 BF 3F 89 08 03' + '1D F4 6E B7 17 28 29 46 BA 3E BE 54 0A 22 40 CA 5D A4 43 7B 3A A3 CA 24 20 46 FC 97 3B 13 08 90' + '07 1B 78 0A A0 DD 9D 76 38 42 8D 1F C7 F9 FC A8 17 6E 56 00 CC C1 9C F1 8D D5 86 5A B3 5C F3 24' + '28 F2 36 E5 91 30 6B DF 01 44 2E AE AE E8 51 A6 AF A9 7F 66 05 11 11 7E 36 EC 20 78 D5 85 C6 00' + '42 8E 3B 58 E4 E0 A2 22 31 8D AA 21 8D 58 5C 61 0C CF E5 21 4A DE BF 53 E2 A9 30 61 8E 22 05 BE' + 'CB AD EE 43 E5 A9 4A FE FF EA 5C AB 18 DC CB 7D 7D 7D 78 5C 62 0A 52 AD FD 6B A9 5E 33 90 0E 70' + '73 78 BC 81 21 46 DE C7 3B EB 36 CC 7D 37 09 98 31 8A 2A 28 23 2D 24 AD 61 23 2A CF 78 AB 9B 5D' + '8A 33 F3 FE 87 B6 A4 D6 A8 43 32 90 06 67 6C DC 3B 91 31 46 9A 59 0A 13 AA 19 44 D0 15 95 50 9E' + '2B 43 4C 0E 36 61 31 B6 3D 77 51 AC C7 5D 4A 11 44 CD 46 9C AB 53 5D 43 09 8E 7E 77 E7 F6 ED BC' + 'C7 6E A6 60 88 80 AA 59 2B BA ED BD 86 EE EC 70 2F 72 62 95 FB 3B 3C 8B 94 6A 6E 60 4C 18 75 70' + 'EE C6 65 1D 3B BE A5 89 AD 52 24 91 91 19 18 B4 2C 2D 62 0C 51 9E 5E F7 E0 7E 46 05 57 05 33 13' + '01 03 AB 87 72 0C 51 9F E8 38 75 FB 50 28 BD 89 0C 19 CC C8 90 CC 81 27 51 C9 09 47 76 30 17 B8' + '01 8A 34 BF 89 A7 BC 81 46 B7 08 0A 60 18 77 0E E5 02 69 A7 37 CE 7F 59 89 9D C0 43 ED D3 80 C4' + '06 30 31 81 03 23 46 60 F0 77 73 EB 37 4B EE DD 43 92 52 25 24 62 6B A9 AE A5 E6 19 D6 BD 2F 55' + '79 AE B3 12 4C 90 DE 56 F4 B2 EE DC 6E DD 75 0C 34 EE 9C 35 36 ED 93 16 26 3B 01 29 7C 1D 8D 34' + '02 F3 0C F8 72 F4 D6 9A 68 62 0B 14 4C AA 94 95 50 A5 5A 0A 8A 98 D8 D0 D3 49 84 C7 3D 3A ED B6' + '9A E8 65 95 C8 94 2E B8 6A 6B A8 79 78 96 94 BF 57 C4 EA C0 A3 63 17 C0 E0 06 81 41 9F 8C D9 0C' + 'B2 0C 51 A5 FB 97 E5 C0 0A B9 09 19 9A CA DC 95 67 75 1B 8B 6D 06 61 9F 4F CC EF 96 0D 71 C7 61' + '49 4A CA E5 02 29 9B 98 48 1B C5 C2 B8 32 8E 7C 2E E5 38 D4 8C C8 CC 1C 82 40 85 AB 00 C0 CD FB' + '0C F0 2F B4 19 8E 7E 17 BD 76 CB 06 7B 66 2A 99 50 54 8C 10 A4 A6 FB 6C 5C 33 16 61 60 B6 00 C9' + 'A5 D1 E2 EB CE 04 F5 13 29 8E 48 6B A8 80 63 17 95 C2 DC 19 46 79 FC 77 50 27 52 29 48 42 C8 14' + '40 F9 D1 B0 5B 10 06 51 9F CD EF BE BB CA 80 14 B0 99 4E 0F 52 C2 ED C0 DA 5B 6C 66 1B FA 1D 74' + '0D 76 10 C8 CB 54 A1 76 E1 A9 6D 56 0C C3 3D 77 E7 E1 EE 1B 35 0C C5 59 33 A4 A2 9C 6F A1 6D 01' + '98 E5 A6 99 E9 70 D9 89 48 54 E2 82 A1 6A 46 4D 2A FA 7E 45 A0 05 A2 5B D3 B1 AB B3 8D EB C4 C8' + '19 46 9A AC 80 4D 98 8C 54 C3 C2 A3 D5 A8 62 97 C7 DE E8 58 0A 31 44 AB 51 CC A8 81 34 B9 D2 A2' + '81 46 11 26 A7 2A 84 20 4C FE C7 62 A0 57 74 84 44 8C ED 61 CD B1 08 13 4E DB D3 B4 00 B5 A4 26' + '67 1B 71 D6 C0 19 34 ED AF AE A0 5B 86 22 5B 86 EE EA E6 51 A3 E3 97 CE 80 17 88 94 DD 3B 6E EA' + 'C6 51 9B FC 4C 1A 81 68 C4 19 9D 6B E8 AD 41 93 4B E6 F5 E7 58 01 58 94 8C DA B7 5A 91 19 34 AF' + 'E9 7D 0E 94 00 B4 4A 5A 1B BF 3D 5C 11 94 67 8D E9 DA 00 5A 20 4A C7 CA 7C D5 C8 CA 33 7F AB C6' + 'EB C0 07 94 81 99 DA D9 AD 88 C9 A5 6F AD F6 0A 05 58 A2 0C EB 5C 2D 62 68 51 97 13 E3 55 40 97' + 'A9 12 90 B4 2D E1 C2 C0 CB BE B5 AC 04 EA 22 2B 5F 5D 6A 40 19 34 AF CD AA 81 56 27 95 AD D8 58' + '9E 7E CD C2 95 2B AD AA F0 02 91 12 1E E3 F4 16 C4 0C 9A 56 EF AD D3 80 16 89 48 5A DA D6 C4 46' + '4D 2B 76 47 5D 40 AB 14 7F 1D DF A5 08 CA 11 A0 E6 7D 8A 81 46 E1 31 24 74 FA 8A D1 98 65 5C BE' + '56 97 9A 69 0C BB 15 AA A4 56 AA 9A 4C E9 D7 AC AD 60 CC 27 8D AF 28 15 AA 52 13 40 7F 5F B7 B2' + 'AE 01 94 67 95 B8 CA 05 BA D1 12 16 E3 EE AD 8C 9A 7D 2E 4C 54 0A FA 91 12 D0 EC D6 EF A0 1C 8C' + 'A5 4C BD A3 75 02 96 28 83 30 66 0E 5D 8B 75 D6 C0 19 46 7D FF A0 EF 00 1E 22 43 EB FA DF 09 6C' + '40 C9 A5 6D 2D DE 40 0B 68 52 E4 99 A2 21 83 33 44 43 43 14 17 D0 D1 C8 CA 13 E8 F6 DD E0 03 C4' + '48 52 B7 5B 19 34 BA FE CA 01 4C 02 60 B1 7C 8D 51 91 AE 12 49 4C 81 35 E8 2D A9 19 8E CE B7 7F' + 'D5 D8 36 7E 46 26 53 5B 91 0C 81 0E D6 8B 60 0C A3 3D CF 2F D9 78 01 5D 38 A7 3A 19 FC 16 D7 88' + '5C CA 34 BF A3 7E 64 00 AB 89 4C 3C 1F DF C1 C8 8C 08 F1 FF 16 FD 77 02 BC F9 CC DE F7 CA 17 05' + 'A9 04 B4 E3 63 9D 80 30 F2 9F CC 86 BF 12 17 23 28 BB BF 9C E0 55 CA 40 CC 1C D2 89 F3 6F 1F 79' + 'E2 34 41 94 AF D1 BF 3E E0 56 42 F3 09 CB F0 D2 C0 18 85 B8 DC 9B 58 0B 46 C3 9A 74 50 6E C3 D1' + '57 32 69 F8 FD 9C FD 58 01 D7 7E 51 CC 1D 2F 72 F4 16 E6 51 A7 CE EB 5F AD 00 2E F2 13 E5 BF 25' + '5C 03 0D 37 F0 DF A1 00 1D E4 27 E2 B9 17 80 AE 0C 36 E7 1D DD C0 77 00 48 8C 8C 4D F9 E9 63 07' + '09 7B EF 49 00 A4 68 22 12 8B 45 A1 86 95 F1 55 02 BC 5A C8 4E D9 BA B8 23 6A 7B EF 39 D4 07 8C' + 'BD A9 85 73 F2 BC 15 63 06 F8 67 AF 47 E9 F6 DC 36 E5 3A FC D5 4A AA 55 2B 47 41 B0 D6 DE 1E AE' + 'D8 C3 11 14 BE 9C EB C0 0B C4 39 89 FA 76 4B 03 10 F2 5F C5 7E 9B 80 F2 74 DA A1 6B 7C C2 98 F8' + '10 C0 06 22 29 76 FB 47 80 0F 1E 35 90 A8 EF 55 72 30 C2 8F C5 F5 94 07 6B 19 4A D6 81 EC 85 88' + '1C 44 ED BF 9F A7 00 1E 36 30 27 EA BF 41 5C 11 86 13 7D FF 5D 40 B4 62 2C 0C 92 D6 28 19 17 BE' + '85 81 88 89 DB A3 C9 E5 40 07 89 58 C4 DD F8 15 C1 86 13 7F 4D FB 70 01 F1 C7 3B 69 3E 5D B0 1A' + '6D 80 D1 66 A6 89 A3 A2 AD 09 35 82 D8 D1 C5 CF 12 CF 7A F5 8C 20 39 BB A0 B1 03 0C 27 6F AB 9A' + '95 A2 2D 61 30 6B 6B 05 51 62 06 18 4F E0 6F EA CE 04 F2 1F 0E B4 06 AE E8 4E 46 18 4D E3 E8 77' + 'F0 2B 46 A0 18 33 07 CC 06 87 4E C2 20 B0 06 20 25 68 D6 B0 2A D2 93 14 9B A0 81 18 80 95 78 2D' + 'F2 E0 56 90 9D 85 0C CC 3E 4D B0 1A 6D 80 D0 B6 56 A5 65 8C A5 8E 9D 2A 9A 8B 62 CD 5D 65 D3 AF' + '4F 65 A2 B4 65 7B 05 0A EE 8E 66 01 88 09 F5 7A 8E F0 27 8C EC 41 00 33 06 64 66 68 F9 28 1D 26' + '0F F9 3C 00 C6 14 4D 10 80 26 10 40 82 BB B7 BA 95 E3 29 04 AD 10 54 14 03 2A 09 65 CF DB E0 C0' + 'AD 39 09 DA D0 35 16 2F 38 D0 44 4F 73 C0 CD E0 4F 2D 80 02 F6 C9 28 0F E1 DD 03 83 80 D5 F6 9A' + '9D C9 E5 A4 C2 5A D0 51 60 0C 30 B7 56 DE D5 8A D2 18 F8 22 D5 10 BD D0 5C 8C 40 5F D8 BE 57 2B' + 'D8 A4 0C C1 E8 46 10 53 E4 BC 0C 28 72 30 C3 D3 B5 AC 4C 7F 65 10 B5 A2 0A 02 31 01 E9 FC 8E F7' + '6D 49 B0 0F 20 88 27 6B 08 1F A8 CF 10 83 5F A1 A3 B9 30 70 99 85 13 BB BC 1C 06 1E F9 6F E1 79' + '5E 8B 97 12 25 37 70 03 AB 80 61 87 DC F8 FB 7C CB 15 A2 04 BE 65 8B 88 F0 70 71 D5 BB E6 EA 37' + '27 88 A9 03 00 CC 8C C8 C1 CF D7 77 57 23 0C 2D F2 9F BF 72 77 12 50 84 86 0C 4D D6 CB 62 30 C2' + 'DD EF 66 85 56 08 28 5C 65 13 B6 4E AE 44 64 C1 FD D6 47 62 76 8A 8B 4E 02 16 B1 11 39 91 3C 22' + '0C 44 71 3E 15 EE E1 B1 74 53 B0 A5 52 AA 95 4A 51 2D B7 6E DB 6D 91 30 3A 6B FA 8E E7 A9 86 2F' + '57 C5 F6 61 44 1D EA AE 44 0C 30 78 66 EE 35 C6 47 D1 C6 14 42 F7 2B 2D C1 18 61 EC 7C BB DC 5D' + 'A2 6B 7B A8 83 D9 2C 44 62 19 7A FD 9A 8B 34 4C 03 A6 48 28 46 21 BD DA A5 05 18 14 78 28 82 84' + '46 20 29 E7 F1 39 D5 15 88 E2 83 29 DA DB A6 66 A1 C0 30 C7 FB 2F 35 E7 61 69 15 49 49 02 4D AA' + '82 A0 C3 1E 3B 5D 5A 06 02 80 C4 69 40 94 23 28 1D F4 A5 03 01 40 81 02 46 94 50 61 68 08 C3 1F' + '2B BB D3 A0 CA 20 51 50 4A B5 09 52 06 20 74 F0 7C AC A9 35 C8 CD D5 76 5B 5D 4B 58 4C 1D 7A 6F' + '31 A4 D3 13 17 49 73 A5 96 BE B8 6A A5 B5 88 C7 C1 E0 E4 F6 27 90 91 8A BA 05 B0 3B 03 0A 7B 9E' + '75 AA 55 8C 4F 87 84 20 5A 83 A8 43 28 B3 DF BA 8F 9D D2 69 BF 2C A8 A2 AB 60 B5 B0 89 77 C9 F7' + '0D 9B 26 13 30 51 31 CC 73 04 B3 C9 E2 79 99 CC 03 3F 9C A3 2D 83 B0 12 CE CF A1 CE 70 60 1B 04' + 'C6 B3 16 84 C0 31 03 9F B7 7A 15 22 07 83 5D 97 F2 DA C2 E0 EE 0C 7B C3 C7 9F 8C 16 28 4E EE A2' + '97 B9 4A 59 D7 A3 D7 59 81 97 06 96 33 D8 37 22 59 F9 DC A5 8D B9 51 86 4E 40 96 7B 5F AD EB D0' + '98 AC 65 19 91 1C CC 29 E3 C7 DD 99 6A 88 A0 32 95 07 56 A0 28 81 D7 95 42 58 03 41 CB 2C A4 B1' + '77 9B 9E 52 D7 17 63 2B 3C F3 2C AC 4B B9 9D D7 39 6B AE 66 25 16 CF 3B C2 C5 DF 1B 9E 72 F0 BE' + '46 59 58 00 62 5D D9 DC 3B B6 72 FA 98 8E 48 16 94 80 51 03 A7 81 32 58 14 CC 24 C4 E6 00 51 03' + 'F9 FE 7D A8 4C 28 0C 46 94 A0 52 EF 33 BA F7 8D 93 EC F1 34 11 13 2D 00 D2 8B 3B B6 6C D9 3C 96' + '33 66 DA 99 E9 26 97 2D 20 75 BD 6A 5F 2A 20 A8 40 15 28 54 10 3A 72 69 42 A4 41 50 52 82 82 07' + 'DC EE FB 74 2A 44 15 08 85 28 42 82 07 E2 FD 69 94 D8 31 94 E7 30 50 10 3B 72 A6 5A 98 86 AA 0A' + '50 A8 18 FE E7 CC F6 2A 4C 05 29 4A 50 31 FB 3B FF 46 80 30 63 28 D2 94 52 0C 18 FD 8B 4C 08 40' + '18 99 A2 4E 73 21 00 C7 6E 24 C0 84 0C A1 20 08 A5 22 63 30 C7 8F 2E F4 01 98 C0 98 9C C8 A0 20' + '74 F2 2D 30 18 84 E7 32 98 81 CF 99 E0 CC 06 29 CE 60 4C 40 E7 D7 EE 4C 06 13 13 CC CC BB 9F D9' + '64 1C 58 60 CC CC F3 87 DB 60 60 F9 0C C2 D6 54 32 32 CA 4B 97 7C 87 A9 C8 2F 75 72 32 CA 05 CB' + 'BF 55 96 41 7B A6 59 65 72 EF 6C FA DE 1C C3 0C 1F 2A EC 00 0A 50 13 0F 08 FD C9 81 25 31 A4 E7' + '32 60 C6 FE 56 28 18 4C 4E 64 53 10 39 FA D2 10 09 02 49 11 20 30 A5 A6 CC 26 06 06 84 1B 44 10' + '01 20 90 78 79 D3 F4 5A FC 6C 1E 27 CD DE 7D 7F 56 EF EC ED 6F BC 48 9D 97 77 B2 DA 79 4C AB F8' + 'E9 E8 26 69 B6 AF F8 28 F9 95 1E 8F 1F 4E 02 9D A5 14 ED 17 06 6B B1 2D FA 70 7E AF 63 7B EF 69' + 'E2 7C 7F 5F 4E 62 7B 69 31 F2 7C 8D 39 D5 1C C9 5E 6C FE B0 E4 55 C1 4F DB 43 F9 2C BB E5 D7 60' + 'D4 49 4A 87 09 6D 8D 1D AF 46 FA CB 0E 9A DE BF BE E6 1E 8D AD 9A 0B 19 AA 8A A9 5B 0A 39 B9 C4' + '54 21 65 56 77 ED 67 E7 ED D6 AE C2 65 87 7E CB 17 4B 4B 1B 53 53 15 D3 A6 59 7A 97 BA 96 54 E0' + '54 02 79 C9 8A 9B 8A 66 AB B1 8D 5C 2B B8 CF 5E FD C7 DC 7A 4F 4F DE A1 00 A3 28 53 7F 9D BB 47' + 'A3 73 27 D9 AE 22 29 50 21 32 0A 02 94 20 09 4A 94 0C 11 49 28 90 18 D0 FF 67 57 0C 49 09 22 48' + 'A4 63 4C 6C A6 82 33 46 18 4A 42 10 81 11 10 FF 9B 8D 04 C6 20 C3 FD 0B 82 12 69 13 61 4D 84 09' + '19 A2 82 9A 44 48 36 18 30 B3 4C C1 8C A4 4C A0 CC 9B 18 10 14 89 31 85 11 52 4C 94 99 0A 26 C2' + '50 6F B1 EE A2 09 24 D8 C8 80 45 18 98 5F F2 71 0A 63 12 C9 98 C6 49 12 49 A2 98 C0 CA 23 24 08' + 'CC 9A 29 96 F9 0E DC 92 89 21 21 49 02 30 88 69 30 33 48 C8 82 02 05 31 12 62 14 40 26 15 F6 6B' + '91 26 61 29 9B CF 57 E4 99 7E 86 DA BB 4C D7 76 ED 33 4B 34 B3 4B 34 B3 5D D5 DA 24 EC 9A 56 EB' + 'BB FA 00 00 6E 59 04 00 06 38 AC 46 DC 01 B9 60 80 00 0D CB 20 80 00 C7 2C 82 00 03 1C 56 08 00' + '00 DC B1 1B 70 63 96 23 80 0C 6D 80 00 0D C5 60 80 00 0D B6 00 03 1B 60 00 31 B6 0D 80 36 D8 00' + '00 DB 60 D8 03 6D 83 60 0D B1 B6 0C 6D 80 00 0D B6 00 00 36 D8 00 00 DB 60 00 03 6D 80 00 0D B6' + '00 00 36 D8 00 00 DB 1B 60 0D B6 00 00 36 D8 00 00 DB 60 00 03 6D 80 00 0D B6 00 03 1B 60 00 03' + '6D 80 00 C6 D8 D8 00 DB 60 00 03 6D 80 00 0D B6 00 00 36 D8 00 00 DB 60 00 03 6D 80 00 0D C4 10' + '00 18 E2 08 00 00 DB 60 00 03 69 B0 00 01 8C 00 00 18 C0 00 01 8C 00 00 1A 18 00 00 20 00 00 04' + '00 00 00 80 00 00 10 00 00 05 5A 27 66 9D 9C C9 93 26 4B 29 93 26 4C 99 32 64 C9 97 92 ED D3 26' + '4C 99 32 64 C9 93 33 15 25 14 54 94 54 BA EA E5 14 51 45 49 52 51 45 14 54 94 51 45 E8 6D 7A E5' + 'EB 96 A4 54 12 58 88 CA D7 99 BC 56 2A DA 8D B1 16 A3 6C 6A 8A A9 9A C1 B5 A3 58 DA 2D 62 B1 B4' + 'CD 6A C9 B5 63 59 2D A2 B1 B6 4D 63 6D 15 B4 6B 56 8B 6A 8D 5B 1B 56 8D B6 CA 0D 7D 35 FB CB D3' + '2F F0 EF DE FF 56 36 3D 6E 90 CD 26 92 AA 41 9A 41 08 06 10 60 41 06 49 0B 79 23 65 AD DA DB 6D' + 'E4 D3 5A 2A 8D 6B 1B 6B 10 48 48 92 00 C9 02 43 3F 61 6B 03 35 12 01 7B 54 B3 0F D2 F3 18 DA 01' + '82 02 C8 40 DC 90 25 20 40 31 61 2C 90 9F A6 C2 5F ED A8 08 4B B2 40 E0 DC 54 22 C2 2C 22 92 29' + '23 08 C9 6D 99 B6 66 B1 AC 6B 1A AA F2 B6 D4 FC 83 5D 58 29 24 8B 24 91 B9 BE C1 00 B4 A2 A1 8D' + 'F1 B4 2F 55 0A AA 85 55 41 64 16 04 98 AC 40 42 76 DF F2 F0 1D 9F 5D D9 F7 BE 9B BD 7F 67 CA FF' + '0F F3 F9 BD 36 FE 9B DC 7B 8F D2 F6 7D 0C 5F 0E 2F 9B 13 CD F2 FC C8 BE 6E 62 84 7E AF 65 5F B1' + 'E9 76 5B 2D 8D 96 CA 74 EE A7 AA B4 D9 66 F0 F0 F2 D8 9F 66 5F 77 BB DE 75 18 7D 4C E2 00 70 44' + '80 13 A4 54 90 EF 8F EF A0 49 FA 0C 3C CB 09 80 80 1F 72 81 F7 08 7E 63 24 27 E7 32 49 82 2C 03' + 'CC 33 FD EC 24 27 F6 B0 21 3B 44 00 D8 92 62 7C CA FE 47 CD 30 D5 0F 32 FD EF DE D4 0C FD 75 7D' + 'EB EB 9F 42 93 FB 1F F8 33 F9 7C DD 7A E7 F2 DF BF 60 7E 5B EC 1F C5 5F D0 5F 6E FA 16 BF DE BF' + 'A2 FA A6 DF F6 79 DF 47 DA BA 8F AA 7A 3F 1F C1 7D 8A DF 9F 56 D5 F2 8B 6B FD 3F 3D F1 0B 9E 1C' + '31 E2 ED BA 43 27 5D 75 CE 89 DD 6E 26 64 D1 2A 6C 9B A7 03 77 57 72 AE 94 DD DD A6 BB B9 34 4D' + '33 60 4B 13 9B 98 13 28 60 4B BA BA 92 62 46 51 96 48 05 25 4B 1A 62 1C E8 46 98 08 91 9A 1B BB' + '82 32 03 28 90 9D DC C8 B9 D4 8E 5D 10 92 26 89 74 3A 92 89 00 86 07 77 0D 09 26 3B AE 92 64 05' + '73 8B BB 76 17 13 C7 AE B6 AB 5E 69 AA D5 2F A4 6E D7 A4 EE B1 8D 8B 21 55 82 A3 6F 74 FA 0E D5' + 'BC 2C 91 46 88 50 58 28 28 28 2C 90 9F 4C FD 19 F5 1F 87 FA CF 89 F5 5F 30 A3 C8 F2 F6 7F 63 B6' + '3C 01 40 81 DF 34 E0 78 07 D4 19 00 43 FA 05 5D D7 82 18 68 88 61 85 42 FF 22 3E E5 BE 6C 2F E6' + '1C B8 63 61 28 4C 2E 51 FF 29 BE 24 DD E7 A3 95 50 A8 68 7D D0 7C 80 7D 3E 58 6A B3 B8 FA EF E7' + '97 1C AE 80 31 B9 10 DF 68 72 D8 BA E0 70 EF 72 21 C8 8C 5D CF B5 45 21 F8 03 85 FD 5E FF 67 84' + '7E 53 F2 3B CD 7B 9F 0B 47 50 F9 CB D1 EE 7E 35 2E FE F9 F6 BD CD 57 F0 0A A5 55 55 55 55 55 F4' + '7E 83 F4 2F 7C 0A A1 57 0F 3F 8F D9 7F AF AD D9 C2 78 93 92 8F 17 F1 37 5B 85 F9 75 DD D7 86 AB' + 'E6 35 E5 3F CB BA 7A 4F 3B 9F A4 FD 3F EE F1 9D 77 55 E5 BA 3F C1 E4 D3 D0 15 4D CA A5 57 88 AA' + '55 55 54 44 62 C4 82 63 37 40 50 48 0A 80 08 88 A2 94 54 E2 A6 11 62 AC 94 48 91 21 C1 87 0A 20' + '26 DD BB 78 AE 05 74 81 25 D7 6E DD 87 09 03 64 C9 14 1C B2 52 81 90 63 40 0C C8 F8 79 7D FF AB' + 'EC 77 9E AF 83 DF F8 1B 6F 5D E4 5F 57 EA F9 BA 1E 87 F2 D7 F9 1F DB 75 BA FA 3E CF CF 8F EE 70' + '37 FC 4F 4B DC B8 B9 D2 81 3E DF EB 06 CB CA CD 6C BC DB BD BD B8 20 02 01 6C 01 43 A8 9F 7E 8A' + '47 0A 60 88 38 00 A7 4A 9A 21 78 20 88 5F 5E D5 02 B5 CE 63 1A 02 F9 86 86 35 40 6C 88 36 45 B3' + '56 A7 57 F3 17 22 1F B4 0C 08 6D 79 DF D0 A8 AC A8 88 88 8B B0 90 0B AE 73 A0 AA BB 58 2C 08 3F' + '01 00 82 00 D6 E9 F7 18 E9 1E 47 77 0D 91 87 8C 81 62 91 03 2D C7 80 B2 D0 07 8E 63 24 73 F1 CE' + 'B3 B7 7C 72 94 BE AA B2 1D C0 50 C6 75 EA C4 5A 4C 9C 1C E4 AC E4 9A C8 69 CE 31 F4 BD 1F 4B 5A' + 'AC A4 EF 4A 3B CA 4C D4 A3 BB C2 13 9B BD 6A EE F3 9C 63 18 B3 33 56 B6 44 8C 63 16 67 92 AE FF' + 'EE B8 3E 96 AD 57 BE AD 59 65 A6 9A A7 38 C7 3C F5 6A E8 42 13 9D EF 5A DE F2 93 35 29 7B DE EC' + 'D4 A5 EF 6B 5E F2 93 33 33 33 35 29 6B 2A DE 73 9C E3 1B D2 90 86 BF D4 EC D9 F4 BA 2F CB 1D 43' + '18 D5 AF 11 78 52 94 2C EC F5 CA 34 8D 68 73 9A 2C 58 E6 D6 36 64 C5 2D 85 8A ED A1 15 43 72 C2' + 'A3 1F 8A A0 40 31 54 E5 50 AD 66 B4 A5 73 C6 95 6A 00 75 A4 98 A5 E6 ED 38 AC CF 6F 31 92 95 1F' + 'C9 5A 16 9B 45 4C 63 58 7F CB A7 00 F5 6D B9 8C 0F 3F E3 E0 E0 3C B4 28 14 BA 75 76 B1 51 AD 79' + '68 63 18 D0 65 BC 2B BD 51 8C 63 7E 89 95 DD 04 4C 66 7B 22 C4 63 F2 41 0F CE 25 FA 91 0A 52 C1' + '49 BD DA 08 70 8C F1 77 3C 15 0A E3 9E 2B 46 F7 2A 94 B8 C5 B8 46 DA FE 61 8C BD D1 8A E6 87 CF' + 'DA DD 37 77 E0 84 F0 0F 49 CC F0 2F 31 55 55 55 55 55 7A 0E 2E F5 7B 8A B7 ED F7 AD 32 FD 19 8E' + 'C5 66 CD AB 94 39 13 35 57 55 E4 09 2B DF 24 51 6D AA AA 54 A9 55 52 A5 4A AA 95 2A 55 54 A9 52' + 'AA A5 4A 91 B3 27 60 AD AA AE 86 B5 55 70 B6 67 17 6B 94 AE 50 DD 7A C6 30 21 19 5C 56 C6 90 ED' + '3C 52 BC C5 69 25 48 45 40 A3 50 B2 9A 86 29 4A 5C 54 40 80 13 23 C1 40 10 3F F1 38 39 98 83 3E' + '82 14 A4 9C F9 AA E4 64 41 0B 77 7D 0B 8E 9C 75 DF E4 F2 E0 B0 21 E4 F0 2C 7A 2A BE 4C 78 75 F9' + '2B AC D8 93 CD 05 8A F3 21 3C D7 4E 6D 2B 54 A8 6A 06 75 61 51 A1 00 8E E1 3C 8F 50 D5 E6 7C A5' + '45 1A BD 42 A1 4A 5C 21 00 05 54 63 09 04 2E 64 3F 33 38 29 BE 31 9F AD 52 B8 EF 30 4C F8 CF 30' + '22 15 4C 01 70 63 17 00 D3 9E BB 83 80 63 18 D8 13 04 07 6F 97 B8 DE F6 10 84 3A 9D 89 2F 8A 90' + '85 78 20 59 76 BF EE BC 0B 18 1D 7A 11 22 1D 2F 21 21 D9 86 D6 95 43 63 36 53 04 D6 26 49 6B BA' + '05 4C D5 0A 4B C1 39 F0 E3 14 C9 3B 35 72 58 73 7E E3 62 16 4E 20 AC B5 35 54 2C E2 97 8F 81 C7' + '0C 38 F3 6A AB 8F 55 5F A1 26 EA B9 30 C7 5E 1A AA B5 D5 56 0F 83 52 6F F2 9B EB C9 9E 61 37 52' + '4D BD B4 97 52 9A C3 5E 93 58 6B C5 2E 76 6B 0D 74 92 93 5E D1 D7 EE AD D0 4D 61 AD EF B5 9A DE' + 'B7 C6 D8 48 E3 72 47 1B B2 6E E6 B0 D9 E9 8D 61 C6 CD 6E A7 38 C1 C5 A3 8A 1C 51 25 92 47 C2 80' + 'A1 CF 1C D6 A5 91 94 31 8D 06 4E 0A B5 A7 3D 6E 09 CE 73 85 75 38 28 81 CF 5D 62 7A 88 82 30 A9' + '3D 00 26 04 BA 49 98 65 DA 40 56 65 F9 4B 36 7B 65 40 20 58 DF A0 95 95 FA 24 20 39 A9 67 48 E6' + '4A CE 96 55 40 20 5A 22 D8 27 D2 33 E3 04 2B 87 8A 50 A2 54 6D A9 3C 73 6F 48 B9 5A 34 D7 00 56' + '35 CD 32 A5 75 7C 96 50 63 5D 86 02 70 8E 73 E0 5B 3C 75 77 80 EA 79 CF 75 79 82 B8 10 12 BB B8' + '31 8C 95 D5 0C 04 5B 39 52 D6 61 94 B9 7E B8 01 1C 0D 1A E7 E0 61 6D 29 56 66 29 23 F9 98 0C 9B' + '74 50 2B 6B CB 73 3A 13 A2 7B 5D F2 E9 37 4D 1B 63 16 41 DF 50 6E 8C 44 52 1B 58 87 78 63 DA BD' + '72 8C EB 28 E3 49 8D 7A 9A E1 1D 3A 98 7E 06 6A F4 DB 29 6C EF E2 AB 4A 42 38 BA 74 97 1D A8 33' + 'F4 A7 1E F2 AB 4E 8C D3 CA 66 3C 8E 0B DE A2 98 DD 75 D9 1E 61 C3 CB 86 CE 4E DA C5 F5 B7 1A AC' + 'F1 46 E3 E8 A3 97 56 F2 24 73 A9 50 AA 81 AD 6A 18 C6 CB 61 BF 80 77 4E B0 EC CE 63 61 B0 61 06' + 'EF 30 D0 32 A8 36 75 7C F2 22 2A 81 F0 CA 61 84 DB B8 B4 6C B6 47 B9 38 C6 32 EE 3E 23 BD 3E E4' + '38 19 BB 96 6E 5A 71 FB 91 E1 84 3B 99 73 4F B1 DC CF A8 CC DB DB 78 19 72 EB D0 63 AF 7B CB 74' + '19 76 2B 0D 73 47 10 CD 35 B5 93 5B 47 1B 6A 2C 5E 5E 30 BA 26 B8 B9 2C AD B5 B9 AD 52 D2 B5 0D' + 'A8 B3 5B 6D F3 CF D1 DE A9 DA F3 5A F2 F9 BE 41 97 0E 72 27 8D E3 C1 32 F0 B8 1D DD 1C B9 73 8E' + 'E7 71 C8 B9 73 9C AE 77 5C 05 DD B9 12 EE B8 AE 74 BA 6E 4B 1D E3 CA EB 15 47 81 04 15 0A 9F 7F' + '3F ED A1 BB EB FE B9 8E 97 EC FF 39 6F DB B0 DA B8 CF 5F 63 A5 FB CA 66 BF AD D5 9D C1 73 3B D2' + '6B 76 D6 F3 D8 DF B9 D5 6B 18 DA D1 DE C2 EE BB A5 A6 75 01 14 06 CD A2 8F B3 F6 36 B6 07 BC 2F' + '0B C2 C7 45 EF F5 7D FF 7C F7 17 5D 94 F3 C4 F1 03 0F F5 FE B1 1A F8 BE 2B BD 12 A1 76 61 78 DC' + 'CF 2D FC 3F AB 7B FE 87 C3 FE 1F 04 13 E1 7F 9D 48 48 1C FF 7D A0 F1 47 83 45 10 A9 50 A6 0C 0C' + 'FD 70 37 48 49 97 4E F1 2C 51 59 AE 00 07 8F 61 EA FA 48 70 3B 0E BF 1F DE D0 61 EE 2D 33 D9 48' + 'F6 B9 FA 82 2D 3F 7F 5E 40 68 39 7E 49 06 A2 42 13 B1 EB 88 D6 40 06 ED F5 0C EB 40 DD 8A EB AE' + 'EC FA 1A 2A 52 7C DB 43 F4 7D 19 1A 1D 0E 3C 4A 31 44 19 68 91 60 88 BB 94 1F 9E 0F 7C 50 02 05' + '98 E9 83 D7 BB 5F A0 AF 5D F5 EB AD D7 6B A4 AE 59 DA EB BB 75 C9 E1 84 B4 69 A8 C6 D3 B3 4D 02' + '1B 41 62 C0 84 21 21 05 84 17 5D DB AE 5D 37 3A B3 73 A9 DD 6E 92 BA 0E BA 44 18 0B 0A B2 46 24' + '30 68 64 0B B4 53 09 E4 BF 3B E6 F6 3F 2B B9 D7 C9 BD 6D DD F7 D3 EC 3F 75 FD DF A9 9C EA F0 DC' + '38 E7 9C 94 3E 74 03 DE 39 BF AA 47 1F 08 D9 0A 1C 0A 96 29 52 F4 4C 9A 46 1F 7C BB 6D 6C 13 DC' + 'B2 53 EE AC BF 15 E3 F9 EA 46 30 1F D8 51 F8 59 43 BB 26 CA AD EC 33 7A EC DE B5 1B 9F 26 FF B4' + '9B F4 F2 6F 9C EC BB 3D 61 55 FF 04 E3 C8 66 FB 57 6F F6 24 99 6C DF 52 72 7E 0E 9A 11 24 26 17' + '16 0C D5 8C 14 56 9B B2 82 47 1B BB BB B5 B7 06 EC 78 33 1B AD 7E 40 3E 44 A0 79 CA F4 94 C4 02' + 'AC A0 D2 38 EA BC A2 35 A8 84 10 F5 84 C9 75 6A AB 33 E9 8D 34 D3 37 CF 3C E1 9E BD 34 D5 A9 B4' + 'D3 91 AB 93 29 06 CA 23 46 E4 B2 6A CA 53 80 55 D4 89 64 5B A4 2D 18 E9 29 64 8B 22 81 8D A0 C8' + '26 91 B2 DE D1 AE 6C 33 CF 3C E5 96 48 35 63 4C B2 C2 C5 D2 07 6B 4A 42 21 44 84 25 34 55 B5 94' + 'AF 9C A5 2C ED 67 7A BB 9B 85 A6 83 6E B1 9C 2F 75 55 5C F3 CF 72 F8 86 98 12 59 4A 52 A6 EE E7' + '08 DA CB B9 AE FA 1E CB D5 AF 4D 7D 39 6E 2A 44 26 C3 AB 18 EC 56 93 9F 1A 75 99 B0 D5 BA A3 8A' + '1C 24 06 E8 60 9A 93 6E 38 BC 5D BB 76 E3 56 99 DF 6F 1B 86 BA 5A 5C 54 B0 51 21 AB 60 3D C8 D0' + '63 79 25 13 7D B4 A8 CA 42 38 0F 4C 71 45 44 EF 29 6F 65 9E EC 5E 31 8C 72 B4 EF 57 D2 93 C5 F5' + 'D6 A3 70 E0 37 10 30 C2 4C C6 E1 C0 1C 5F 28 08 41 E5 0B 33 40 59 45 AD 66 8C F6 6B 5D CD C8 EA' + 'B2 6C D7 B2 10 3D 7A D3 5E CD 9B 36 6C D9 AF 72 D6 AD 33 50 95 AD 6B 26 BC 92 D6 A5 29 19 C9 99' + 'A9 39 CA 53 33 A6 B8 D4 6D 58 2A ED DB 7B EE 63 2D AF 9D EF 8B DE FB 76 EB 8E DD 9B 76 AD B6 ED' + 'C6 D6 D8 77 BB 5E F7 78 3C CF 34 53 4D BB 72 DB 54 1B 76 D2 87 56 AE DD BB 36 63 66 59 63 17 BB' + 'BB EC D9 B3 51 6A D9 B7 6A ED 7D AB B4 F6 3B E7 7B A5 DE 79 B9 A0 62 54 44 42 43 0A 8A 15 15 76' + 'ED DB B7 6F 13 74 7F 65 C5 30 F0 18 BA 0A E1 05 77 BE C3 E3 7F E7 EF 3E 5C 95 57 5F D3 D2 D2 E4' + '43 50 D6 43 F0 22 AB C3 31 F0 8C 00 4A 14 20 1D D1 03 42 03 D8 54 0C 37 E9 B2 B0 20 AC A9 51 C6' + 'F5 78 C0 F7 48 E2 A9 44 E6 FF F2 A0 FF CC DC 89 33 06 3C EF BB F2 19 02 B9 E9 27 0E 4D 8F 8E 6A' + '93 2C 38 99 0E B0 71 3E 46 0A 1C DC E7 26 A9 B7 1A FB 8B 71 3A 4A EB 25 31 54 34 E8 FD 0B 0E C5' + '53 59 E7 DE 47 14 EF D6 6B EE B9 F0 CF 64 3F A3 15 E5 F3 FF 86 E7 CE 96 C4 E7 5A D7 1D 95 39 5A' + '06 2A 73 CF 43 FD BB 3D 03 99 D1 8D 10 C5 69 42 69 9C 9C D6 FF F8 93 6B 79 C6 29 8C 54 12 8F 78' + '64 4C 6D 62 30 FD CB E3 24 91 A2 98 4B EF DA 1A F1 2B F9 FE E2 6B 9A 99 8A 79 13 78 6A 18 D2 8C' + 'A8 16 27 0D 43 19 93 28 86 0D B7 B4 E8 C6 2A 6B A8 9F 7D 5A 73 32 66 A8 98 FB C1 58 B1 CC 26 5E' + 'DB F8 B9 6A 6B 63 2D 02 D8 B7 65 B7 2B 0D 0D 6B EC B1 34 C8 99 16 BF 65 03 30 73 50 33 06 2C FE' + 'E9 83 99 73 2C 91 AE 8C FC C6 9E 64 93 56 CF 6A 9B 43 16 B5 12 95 78 AA BA C3 DF D6 8A B0 55 F0' + '3E EA D6 86 E4 12 35 45 46 34 AB 2F 47 86 D2 87 42 16 94 F8 DE 4D 29 0A 41 C9 C3 AB D5 4D 19 33' + 'BE 97 12 73 75 7A E4 F0 A7 27 02 AF 5C A7 33 C8 D5 55 CC D6 9A DA E6 77 34 D5 70 B2 CB 73 28 AA' + 'F3 55 E6 62 6B C2 91 6E 45 26 A9 05 5D 71 09 C2 CD 7E 53 C1 4C 1A 22 1C A3 08 A7 85 52 65 0D AC' + '66 FF 00 89 E4 0B AB CC B1 64 C6 45 C9 17 79 37 99 1E EB 60 C1 F0 39 5C 5E 5B 64 31 79 56 4D EE' + '0B 13 E1 E4 29 4C 90 C3 7A 65 3B 06 C0 5C F7 7C E7 62 30 3D EE 80 CE 6F 36 35 7F AE 80 87 4B 41' + '17 4B 40 D7 7B 80 F9 82 04 39 AA 09 39 F6 9E 43 B5 50 1C E2 6D 4D F9 6E 37 78 AA CA DB 7C 58 2A' + 'AF 02 ED 5E 82 AD 2B E1 68 D9 2A B5 B8 16 32 56 2E C1 C2 0A A2 3A BD 2F 30 F2 3B F7 57 E6 1A B6' + 'F4 0F 3F 7A 0E DE 7F D0 00 0B AF 41 FD CB C5 72 C8 45 05 FC E6 52 0B 06 ED 37 AA AB 53 69 29 91' + '4B 7F 7E 25 A5 D9 8A 0F 23 72 8B 1E 1B 95 3B 76 DC F0 D7 2C 53 BB 85 BC 54 6B BC B6 25 46 B5 E1' + '63 B9 AC EB 96 AA A4 09 54 55 50 AA 28 2A AD DA F7 B5 72 D4 B4 68 E8 69 E5 F2 C7 90 89 A8 EB 45' + 'A7 75 AE EE B5 D1 58 B5 74 D7 35 7D 0B 6D 57 88 9A D1 8C BC 35 C1 E6 7F 89 E2 40 85 A3 9E 56 0B' + '22 0C 05 7F 5E A5 22 C8 A2 82 90 CA 20 28 E7 52 59 22 CC 50 2A D6 D9 60 97 84 82 20 08 20 22 24' + '00 FC B8 9C 4E 27 7B DF E2 77 BC 4A DB DE 97 AE F0 67 C4 F8 3A 21 CB 65 30 FF 8E D3 69 B1 AB B1' + 'C6 B6 58 00 33 BA 1F F7 78 6C D2 1B 77 27 4B 21 3A 87 A8 3A CE A6 C4 62 F5 95 42 AC 89 D5 E1 D7' + 'DE 5E F7 B0 4B 31 60 20 42 4A 95 2A B6 0E 3B 9C DB DC 78 70 E1 A2 40 5D A8 8E 59 00 20 20 40 07' + '4E 90 21 0A 00 22 24 9F 38 AF 04 86 23 C7 69 94 08 89 C4 40 80 22 4B 2B 2E 67 29 CC FA 9E E4 C9' + 'B6 16 17 B5 9D E6 D4 A1 DF BF 0C AD 82 52 C0 BE BB A0 E2 0C 9C F3 CE 79 F1 17 A3 42 FD 01 4A C2' + '2F 44 94 AC 01 48 74 58 D4 03 26 00 5E 24 42 73 FE 6B 9D C3 E0 B9 D9 78 4F 0B CE E5 16 3D 37 9C' + '3F 1E E7 06 62 C4 84 15 84 51 DE F0 A8 F2 5E 50 28 72 AD 45 89 0C 04 81 29 44 80 B1 82 A9 E0 3E' + '73 A5 F4 BD E7 BF 77 AE F5 C9 D2 F4 C5 7A 6F F3 4E A3 A2 B3 6D FC 29 C5 C7 69 68 AC 83 CA B5 16' + '91 39 1A 8C 27 71 E2 E1 F2 7D 97 DB 65 FD 07 C3 EE BE E3 F7 F6 CC 61 D6 57 13 BE 70 E0 59 44 5C' + '1F 08 D5 B8 D2 C7 72 6E AE 0D 9B 31 A1 A4 15 8C 4A 6A 86 BB 4E 87 66 5C 8E 15 E3 C5 E2 4A 48 F6' + '9E BB 04 B2 50 C1 6A AA 45 45 40 A4 97 FC FF 0D 85 AE 2A 64 C3 5A C3 17 83 77 78 D4 88 4D A8 F9' + 'D7 92 2C 20 9E 18 5D C8 EE 38 A9 25 4C 4D 51 57 BC 40 62 A2 92 20 6B 3D E4 26 34 A9 DA 89 85 55' + '62 E5 DC 90 4C 81 D2 45 10 31 44 40 1A 7D BA 36 7A 08 77 9F 27 5B F5 77 DF F9 EB E6 77 FF 0F 67' + 'D9 F6 7D 5F 03 D5 DC 90 24 CA ED 4E 3F 66 4F 68 44 4D 8A 58 C8 3F A3 D3 FD C7 63 E6 3B F7 8D F0' + '7E FF B8 FA 4E E5 B7 AB 80 77 07 B7 9D 6D 07 6D EC 3B 85 01 DB 92 EC 50 72 54 93 FF BE AB BB 7C' + 'EF AB 67 DD FC 1E 57 15 FF 05 13 F8 3B C7 C0 DD 84 44 90 78 1E 43 92 F2 71 1A 6D 79 06 FC 9E 0D' + '00 05 46 65 DD AE 5E 3D 3D 82 02 33 CC 7E 97 C7 89 00 45 2D 0A D6 2E 4A AC 2D 1A A6 B1 B4 A9 CB' + 'AA 97 80 0C 10 04 BD B0 BD EC CA 1B C9 E3 B4 9A F0 B7 69 A3 49 AE EA 76 EA BB BB BB AE 4A A4 28' + '51 15 8A C4 16 AD 57 B5 EC 55 54 25 15 45 C6 5A 67 8E C4 E9 76 EE B9 2A 0C 55 E1 BA 69 48 BD ED' + '6B A5 AD 50 B3 49 25 24 02 86 44 42 CA 80 53 20 6A 28 DB C1 96 B1 11 62 4C C0 9E 77 E5 AE C0 A7' + '46 F1 55 B8 33 1A DF FB EE 3E 0D 77 CE 04 23 77 C2 DD 8F 8D CD BF 52 CB C7 5F 17 63 3E 7F 9D 6F' + 'C3 83 07 2B A8 87 1A 24 4E 1C 58 B1 62 C5 8B F5 69 FE AF 3F ED FA F8 B5 FC 5F 4B ED F4 E5 F8 FF' + 'C3 0A C6 65 84 A8 F1 E2 C4 89 0E 1C 38 70 D7 5D 75 D7 5D 75 D7 5D 75 D7 5C D8 6D 73 6D B1 1B E6' + 'DC 2F FF 5C FC 4C 74 EC EB 1D 11 B6 B1 5D 73 1F 3B DD E3 ED 73 F4 C1 FB 4D 3A 1B 19 BA 71 D4 8F' + 'D8 3E C8 A7 C7 43 62 3E 70 F6 C3 D9 8F 50 3F B8 7B B1 C8 1E BE D7 9C B0 D9 68 E7 EB B4 7E D7 AF' + 'AC ED FB 0D EF D3 E3 78 BC B7 5D F1 F2 F4 67 D5 AB 7D 56 AD 2A B4 B3 15 6A D5 AB 56 AD 5C 4C 3A' + 'B5 71 26 D5 B8 BF AB 87 53 0B 29 82 A5 5A B5 5F 55 AB 56 EA AD 5A B5 6E AA D5 AB 56 AE 05 5A 95' + '3B 9C 3C 60 B7 02 12 13 D4 9F 39 50 EE 4F 4E CB A4 3B 88 81 8B 65 C6 83 AB EA AB 06 28 4C 59 3F' + '03 BF FD 07 9C 7B FE 12 04 36 A1 9A 2C 99 A2 93 F1 BD 87 E2 FD E1 F2 FE BE BB BE 5F B2 90 21 A2' + '6B D8 55 8B 32 CC 2C 0F 61 44 37 24 D9 B7 D4 EB EF EB 08 66 84 D1 81 A3 2C 32 1B 18 79 B4 F8 FF' + 'BB 41 CE 66 68 49 4C A6 01 8B 24 32 42 1E 4D 03 01 20 10 0B 01 02 11 06 E8 01 00 2F 0E 9A 27 A3' + 'C7 FE FA 0F 1F 65 E4 81 32 B5 95 98 0F 3A 4C 0F 0B BA AF E3 2C 40 78 1E D8 81 08 00 F8 48 04 01' + '7A 81 08 D4 48 51 20 04 01 20 76 9E 27 87 23 44 FA 46 CB 96 B8 DB 5C 76 BB 86 79 7D DE CB 6D BB' + '85 0A 12 6B BF 2A 7B FA 26 F3 AA BF 95 97 C1 F0 3C E5 7A 75 7F 1F 6E DD 36 AB CB 2C DA 5A A5 2A' + '72 10 E0 58 4B 4B C1 DB 6F 37 7D 79 73 F3 1F 5A 1E 97 4A 64 8A DF BB 7F F7 F1 38 7C 4E 1D 6C D5' + 'FE 16 22 6A 4E C4 DC FC E4 E4 E4 E4 E4 E4 E4 E4 E7 17 0F 0E A5 02 CE ED 6F 27 A6 C6 53 97 CD D7' + '80 0C B1 E0 01 03 F6 9E 00 03 2B 94 40 BD 66 BF 5F AF 57 5E AC CB 1E 73 9F EB 36 7B 3D 9E DB 85' + 'E8 6F FA 5D DF 41 AD BB E7 B9 DD 56 AF 57 CD 72 FA BD 8F 33 A6 F0 3C 1F D9 57 3D C9 D4 C1 A7 EC' + 'F7 FB D4 DE B7 AF DE 4D DE 8D A2 99 BA CB 3B 38 8A D0 EA AC 35 EE 22 34 73 33 96 08 EB EB 3E 9A' + 'EA ED 64 7C BE 8F 37 5A 24 7B 94 D6 BC 44 C9 A1 69 2D E7 DA 5A 5A 5A 5A DC 59 1F AD B3 AE 3F 5D' + '9D 9C 93 BE 92 9A 82 7D 14 FD FC 2C 0B FC 01 07 C2 CF C3 35 CA C7 0E 28 9B 95 1C 28 24 47 39 7C' + '35 4D 0A D3 C5 C7 4B 71 7D 81 79 7D 83 7B 64 25 EC 70 DA DC 06 8D 62 B7 4E 86 84 B1 E6 7E 70 9A' + '90 5D C3 86 D9 42 7C B6 D0 1C C1 8E 54 76 0D 57 B4 D3 66 C9 9B 46 82 C1 6B 06 40 ED 07 6A F3 54' + '78 A4 43 D5 D5 81 00 88 A4 C2 26 21 03 8E 3C 62 0A 2A 44 88 F0 C1 D6 3C 08 20 01 0C F0 00 6B F7' + '26 C0 B2 B2 81 BE F4 75 9D 56 6B 21 D4 AF D5 B2 D3 FA 7C DF E1 B6 FB 7D 4C 59 56 95 1F 3F D1 E6' + 'F9 BF 45 29 66 6E BD 13 34 A9 36 D2 9E 86 17 37 6E B6 8F 63 7C B2 90 7B CF D3 72 BA 97 6D CE 7B' + '73 29 C7 F9 06 B6 5F 55 CA DA 7D 3C EE 7F D6 C1 85 5B 4B 35 5D FC 6E 49 D3 FF 64 AF 2E DC 34 9C' + '69 AF C2 34 68 AC 73 73 73 2C E2 D2 66 CB C1 83 DE B5 52 A2 69 0C 0D 6D 64 EA 14 3E AB CB 9E C9' + 'EB E4 BA 74 EA DF 2B 27 27 C1 70 92 84 A2 B5 19 B3 66 A2 C0 AB C6 96 37 B7 C4 C6 24 46 ED 9B A9' + '47 8B 6F 6E 49 24 B9 72 E4 92 43 0F 2D 33 55 31 A3 60 88 23 F7 D0 D5 2A 8E EB 2B 29 EB 82 08 20' + '61 86 0C B2 DF 9A 68 C2 8C D9 A3 62 63 12 3E B0 E4 93 16 0C 18 86 C2 86 54 0D 6C 30 40 BE 3D BD' + '3D F1 9E 3B 1B 64 CD F1 6D AE A7 EE 5A EC 84 0E F1 E3 C4 FD C5 88 81 0C 5F 33 76 9F 43 DE 77 3F' + 'F3 BE DF 6F 77 BE 4F 93 E2 F8 BE 06 FB F0 B8 B8 A3 75 AA D4 D9 4D B2 B1 B2 B2 ED 3B 2B EB 3E 57' + '49 67 3E D3 AB EA AD A9 DF D3 A3 65 93 CE F3 B6 BF E3 FC 7F 0F DB AB D9 7D 3D 67 0B 59 CC 73 3F' + 'D7 F1 E9 B5 BA BD 56 96 A7 36 1C E0 13 A3 40 9D 18 81 44 03 24 82 08 0A 02 40 13 14 BF B7 19 21' + '02 66 10 40 44 00 22 89 03 31 00 C5 11 EE 7B 67 1B CD A7 F0 57 B6 E8 3C CF 31 AE D5 A3 5C FF 4F' + '17 A7 F8 7B B3 F6 36 3E 83 93 38 5F CF FE FF F1 9F 9D E8 EC 3C EF 4E C0 FF A9 51 55 7D 57 E0 9B' + '57 F8 FE 3C 8E 27 0F 91 F7 F2 BD 9F 77 DC 68 87 6D B6 96 49 70 93 32 B3 6B 83 40 B4 AE D2 09 4C' + 'FE 84 B4 BE FF 7D C9 A5 A5 5F 90 8F 22 AA AB 83 14 C3 2E 4C BD AD 5B 5D 77 C6 A2 E6 F3 57 51 76' + 'EC AC 29 11 CD F4 E7 15 C9 F0 E7 75 FB 07 1B 4D 93 82 87 31 CD 20 00 15 44 08 4D 4F 49 34 FA 6D' + '6E 7B D8 CF E7 B5 FA 6D 1F 25 5D 9E BD CE 5E 5E E7 3A EE BB D5 F5 BA FE BF AD C1 DC 6E 3B B3 FB' + 'D3 ED DB B8 CC 9F 95 EC 4F 4F F1 81 07 28 13 C7 B9 5B CE F7 A7 80 55 2C AA 6E DC D7 1F 1E 63 F0' + 'DB F1 B7 1F 47 1B E9 B0 F9 6C 2C 2D AA AA 11 CC F5 7C 3F 87 FD 6F 85 EE BA 6F 4B D4 FA 39 D4 A1' + 'D5 7A 5B B7 28 7C 41 D5 B3 C4 B2 2C 90 EB 3D 37 F5 7A 8B FA 71 84 80 F8 87 80 00 00 7C 4F 13 D7' + 'DC FF 4F A3 A7 E7 79 DF 8F 1B A6 CF 2B 58 78 30 60 B0 86 C5 82 FD 07 0A CA 09 64 38 70 A1 42 A9' + 'A8 A9 99 75 D6 61 D6 2B 51 91 10 61 C3 90 30 C3 4A 4A 73 39 8F 9F 3E 0E 0C 24 C8 AA 6F 67 A8 7B' + '53 F3 FC 9E 4F 57 AB A2 C3 49 83 07 15 74 74 7D 0E 85 1D 1C AC AF 31 73 77 15 A1 87 2E DD CB 87' + '2E 66 66 42 9A A7 A7 A7 A7 D6 1E 6E 6E 6E 92 76 75 15 A8 82 08 20 99 99 94 6A D5 A1 43 4F 4E 85' + '0D 4D 4D 10 12 1F 8A 87 9F F3 FF 65 7E BF 02 7A 26 4F 40 92 65 95 ED E4 D9 24 BF B3 A8 48 A7 B1' + '45 F6 60 C2 C0 58 05 92 85 54 5A A9 0A C7 B7 32 3B 25 99 A5 49 59 64 69 28 7C 14 00 D5 90 0C 5F' + '64 C8 62 7C 9F D2 A8 4D 4D DE B9 E0 AA AA 6E D9 B7 B4 AA AB 59 70 2A AF 7B E1 26 68 3E A6 A9 21' + 'BD 24 DE 92 01 BD 84 DE 90 DE 90 DE 90 9C CE 65 1B F7 D6 AC 9C 79 D0 06 BA 79 4F A1 F0 5E 0B DA' + '7D 8E 67 27 07 33 78 D5 54 A6 26 D4 92 D2 CF 78 04 8D D2 0A AA BD AD BC D9 0D A2 D6 4B 66 FB 3B' + '5B 97 5A 7F 01 86 9D 28 0D 3A 47 06 E9 05 55 5D 67 76 69 B7 6B 24 B3 BD E6 8E 17 22 AD 8B 48 58' + '6B A9 46 AC 0B 2D AC 96 85 21 7B DE D2 AA A4 96 19 2D 6B EB 7C 12 4D 58 13 5D 3E A3 D3 DE 01 8B' + '01 D3 4B 06 8C 0B 36 12 59 2D 6A 0B DA D6 90 2C C5 85 9B 5F 4C 2F 24 D1 03 95 C7 CA AB 40 37 61' + '49 C3 42 CE 06 04 FE EF 03 52 68 CE 07 75 54 B3 29 02 CD 70 51 55 52 5D 15 65 AC 66 A6 21 C4 84' + '55 04 08 80 09 00 08 B0 90 3B D9 EC 5C 79 7C 3F 2B D8 E1 3F 91 D2 F7 FE 75 0E 17 EF F6 3F CF 93' + 'E0 78 76 D9 1C 7F 0B 9A 7F 48 92 BB 2B F8 FB 56 F9 EE AC 52 59 6D 32 F4 3E 26 6A E5 37 8B F0 26' + 'D5 D7 DB 6C FF BE 94 CB BE 12 DE 85 93 49 BE BA B6 F3 9C F4 1C AD A3 0B A5 E4 CB 8E 3F 4A 87 F4' + 'FB 5D F5 37 8D 68 F4 7B D2 CB 9E D3 2E D3 E6 D4 61 A8 ED D5 75 D5 BC B2 EC 89 3F 8E 3D 34 CB D6' + 'FD 11 C4 A3 B1 5B 4B D4 C7 AF 5B 38 AF 4D 63 09 EA 5A AE D2 7E FE 7D 6A CA 4B 60 97 5F 56 97 72' + '91 FD BA 66 A9 2B 57 26 BE C2 6D A3 7E FF 06 4D BD FE 12 FC 35 F8 3A 86 B3 72 ED 3B 77 0E 1C 0F' + '03 3C 7C CD 47 A2 E4 AB 54 F9 62 E7 7A B9 CB B4 60 2A 1D 80 FA 4C 58 BC 7C 3B 00 13 03 F6 F1 3C' + '20 3F 67 87 AE 00 10 29 8B 24 F0 DE 66 8B 09 D2 B3 B2 7D 53 76 65 18 8E 9E F3 D1 FE 17 63 ED FE' + '07 9E F0 7D CB F7 3F 47 DA 7A EF 59 E8 FC B6 CB 2E F7 95 D3 47 F5 CE ED 67 BC FA EE 82 F5 7B A8' + '3E DF 83 BF ED B0 DA 74 79 1F 4E 3E 15 7C F7 DF F6 DD 5B 4D 4B BF 7E F9 F3 87 10 64 48 90 4C E9' + 'D6 5A FD 7E 7B AA E3 74 FE 7F F9 43 F2 F7 3A CF AF EF C5 3A 5F 77 56 A1 B3 43 EB 09 78 CA B5 57' + 'D3 2E FD A2 3F 13 6D 86 ED 54 D6 61 A2 5D 0A 2B 7F EF 28 8E E7 DF 41 E9 52 21 5F A0 D0 A8 28 3F' + 'C3 61 BE 4D 46 AB 2B A4 E1 F1 17 F3 47 50 D9 C2 6A 72 CE 10 F0 11 43 6B 05 0D 9A 28 7B A3 E8 3E' + 'FF 90 7C DF A0 C7 45 31 A7 79 27 35 BD FA CE B9 AB 9C 1C 6F 37 6E C6 C6 DC 5C DE E6 E4 D1 F8 CF' + 'C3 C4 3F CF B1 DD FC 3F 77 DB F6 25 B2 17 96 D3 B6 66 ED F7 46 EF 0D DD FA E6 92 6D A5 A9 AE CD' + '6F 69 B6 B6 9F 46 DB 6F 5F 75 D4 74 F2 EF 7E 2B EB 63 5E F8 7F 89 5F 19 5E B9 5E 49 45 14 57 B9' + 'FC 7F 7F 9B E3 F8 5E 17 96 7B C3 EC EB B2 ED ED 47 5C 2B 96 58 59 36 BA B9 3A 08 70 AC C6 DC A6' + 'C8 FE DE C8 1E 39 EF 27 D9 BA 87 75 12 E5 44 EE 6E 6C AE 6E 5A AC 94 9B 59 E9 CF 9E C1 11 39 D2' + '3A 8C 0D EF 1F F4 FC 9C 02 ED 43 2F FA 68 1A 46 8D 1A 34 65 77 31 68 43 CD 37 22 A5 2A D3 B8 F4' + '7F 91 F7 4D CE 87 B9 D2 33 26 BA E1 C2 FD 1C FB F3 1C 79 9E 04 EB CB B1 FC 75 D0 CF 03 3D 5E 5D' + '8F C7 E8 CF 9A 7D 28 A1 1F 9B 55 3B 83 F3 3C DE DB 65 14 99 A1 F4 4E 64 63 C7 E3 F9 06 9C ED DD' + '74 B4 C2 64 2A 67 9A A3 41 4E E9 03 D4 70 F2 26 25 2A 2C 7C C9 3E A6 07 E6 52 74 DE 8E DB 23 8C' + '8C 34 6C DE B9 4D EA 56 69 3A 3A 31 D1 8C 8B C5 51 B6 B6 52 00 0D 72 16 72 2D AD AD A4 BA 8B 09' + 'CE 36 34 68 19 C7 84 9B 5F 22 50 2A E7 33 62 F5 CC 75 9F 14 A5 CD 1C 16 13 88 98 25 A3 34 B2 6C' + '2C D3 72 FD 65 10 07 42 A1 41 5B 47 2B B3 63 67 9A 3B 90 90 9B 7C 83 9D 86 B1 21 35 9B 2D D5 7C' + 'C1 04 20 AA 75 71 D0 C7 B6 C7 3B 22 D4 6D 05 57 30 8E E4 4E B4 F9 E5 28 88 67 22 36 82 0B 2E 8C' + '87 96 4E A7 43 5D 61 42 DE 91 69 0D 2F 04 34 62 00 1A 0D B8 8E DD 02 90 03 49 CA A0 4A 8F 77 5D' + '03 FA 7D B9 CD CE 5C E5 CE 5C E5 CE 5C 1A 18 D0 C6 BB C2 B2 8A 3E 91 D3 58 63 69 2C 2E 9F F6 7D' + '7F D1 F8 BE 07 B5 FC EF 39 BB E5 7D F7 86 FF CF 6B FF 2C 0A 4C 99 FA FD 25 9C 54 F9 32 08 E8 E1' + 'CA E1 DD 72 C8 54 97 96 95 8D D7 3A EA EA 52 EA EB A1 75 74 4C 16 CD 33 94 C7 9B A1 51 44 A3 B6' + 'A2 8D 45 22 8E E2 8E EA 8E F2 8A 55 14 CA 22 93 53 A9 4E 2E B3 C8 3A 9A 4B 97 3B 0A 4C 58 6C 50' + 'B1 76 E9 B0 88 DA 06 17 E5 F9 80 08 20 1E 3D 5E 85 15 DD E8 7B BC 5B 6F 7D 7A 15 D2 7E FD 11 11' + '00 22 23 CE 81 40 A2 1C E8 81 39 D1 38 91 30 41 00 40 92 AF FB 89 72 EF 66 7C 97 D9 D9 99 D7 9C' + 'FF 61 1F C3 91 AD 93 26 4C 9B 4F 35 A4 3F 56 59 F5 EF AD 2B 5F 2D EC F0 28 FD CE 9D 25 34 DF C3' + 'F0 FD 53 5D 59 9E 87 43 EE E8 6F E8 A8 7A EB 56 A0 5A B5 12 D5 B6 CB 7B 6B 69 96 AD B5 48 92 C2' + 'D5 BE 45 75 E5 BA 5B 8B 8E 52 34 57 07 ED B8 C6 22 44 89 13 9C 68 21 DF 9D 70 73 26 4C 99 2A C6' + '54 CB 11 04 CC CA 04 08 10 20 AE 40 81 02 04 08 0F 9F 3E 7C F9 F3 E7 CF 9F 3E 7C F9 F3 F8 82 E2' + '8B 92 2A 81 56 8A A4 55 C2 E6 2C 56 E0 5D 01 59 31 15 90 AC 18 E3 32 48 EF 09 2B 78 C4 93 89 23' + '14 D6 B8 B8 8D 71 9B E4 88 D0 48 11 83 25 71 AA 87 19 71 32 63 B6 D3 64 71 8D 1E 34 24 E7 CE 09' + '7E FE 30 E3 BB 85 A9 A9 0E 21 31 22 93 20 A3 4D 34 D8 A6 9B F2 81 C0 F9 35 C0 00 78 F0 07 BD EF' + '83 C2 03 F7 1E 00 03 C0 1E 3C 78 10 40 EC 5A 40 1E ED 45 0F 65 4A 81 CD 96 0A 4E C5 86 2E 09 B0' + 'AA 2A 7D C7 43 BE 67 75 9D FC 3C CE F4 C6 6E E3 EE 23 8D C2 DF DF A6 60 99 37 0F 86 D3 85 40 BB' + 'B1 69 B2 E4 A8 F3 FF 26 D8 4A F9 3C B4 E9 F2 DC B5 B8 98 95 51 79 99 A3 37 A1 A3 39 D6 69 D8 F0' + '44 81 41 3F 58 16 75 66 F5 FB 9A 3A 30 F4 D9 F7 BA 32 F3 06 1F AF AD AD 57 5C AE BD 5D 86 81 FD' + '0B 1D 0B 2D 08 CA E2 AC 5C 80 55 23 B9 62 F9 96 00 90 C8 C3 C3 BE C4 D5 0C 31 C4 D1 13 47 50 58' + 'D8 7D AA 1A 0B EA 2A 6A 3C 13 E8 F1 12 E1 A6 B3 49 76 8B 01 13 CD 5D 52 CA 51 9A 56 A9 4F 0A 7A' + '53 E2 9F 95 00 AD 62 87 28 82 A0 95 08 A8 7A B0 DE 43 7B 0E 1C 38 70 E1 C3 87 1F 58 78 F1 49 CD' + '54 D1 63 F7 ED 9B 69 B1 62 70 CF A0 3F 17 51 E3 BD 43 8C 32 44 89 23 12 4B E8 F0 A3 43 8E 59 A6' + '1B 0A 14 68 D1 A3 48 8E 59 87 1D D4 75 1D 46 FD 7A 7F 43 F0 7C 97 E3 BA E8 BC 7F 91 E0 F9 12 38' + 'C2 29 55 2E 8A 8D B5 76 EA 53 77 49 AC 30 C2 49 DE 39 D5 24 7C CD 14 3D 01 0E C6 8A 7B 2F BE C2' + 'D0 DA 55 15 3F 97 FB FD 4F BD C3 C5 E3 B5 B5 B5 B4 47 20 38 C9 25 02 A4 DD 36 46 E9 26 55 60 95' + 'B3 37 A4 56 48 D9 10 9C D9 42 B0 F6 76 6F 16 64 08 B7 2E 24 67 CF 9D B4 10 B2 22 AA 5B 05 55 B6' + 'E0 49 90 C8 1D B5 02 B7 51 42 1B 5D BB 6A E9 A9 54 55 BA 4E CF 3F 81 AA D3 A1 E9 40 08 21 1C 6E' + '24 13 4D F6 1D AC 9A 6D 35 65 A5 AB 1A 44 27 B2 D6 A7 AB 51 76 B3 A0 45 BF D0 1B D1 9D E8 16 86' + '28 DD 59 96 BE 10 34 73 D2 A4 95 B6 8A 12 5D BE B5 74 D0 AA 2A 76 5E 5B FD 3D 5F E6 FE 1E 50 09' + '2C F1 92 92 E6 B0 62 20 E6 66 40 B5 98 29 2E 8A 10 19 68 7A 68 90 31 10 88 10 78 DE 56 29 A3 46' + '85 2A 95 53 4E 11 BA 49 95 A2 E9 5B A9 B5 65 A5 A4 BF 87 56 79 D9 F8 9D E3 FE 97 F7 1F 51 5C 27' + '0E FA AE 19 66 96 D1 AB 70 E0 13 6B 26 F4 9B F7 EF B7 CF 72 FE 4F B5 6E 43 9B A5 41 40 33 73 F0' + 'FD FE DE E5 00 31 64 DC 93 26 C3 92 6B D0 57 84 FE 1A F1 18 50 43 63 0D 8E 7F 99 F1 4B 7C 34 39' + 'C9 03 89 21 9B 0E 5E CD E5 8D 3E 97 AE B7 B0 F8 35 03 11 14 26 59 6F F3 BF 81 CA EA F9 D7 CC E8' + 'A0 3A 24 8B 00 E3 64 52 0A 4E A3 6D 2B 66 95 67 0B 3B 26 B6 DA EA D0 E0 F2 CD BE 08 A4 90 1B 96' + '09 9A EA CB 33 79 D4 81 92 8E AD 6B 5A DA 0B 51 C2 A8 E7 BF 5B D6 F9 BE C3 18 48 63 BF 82 AB 7D' + 'AA 80 1B 89 04 D5 74 AD 9D D9 2C CD 5B 14 D3 73 49 6D 15 4D 10 7A AA 25 4E DC 5F 73 D7 FF 97 27' + 'F3 3B 2C 35 6A 92 6A 6D B7 46 A9 23 4E 48 DD 05 55 D2 B2 D4 EC 62 AA EF 61 C9 BE E0 DB 84 B5 55' + '08 9C 36 A3 1F B7 B1 64 D5 DB 4A AE D0 04 EA 48 D3 01 52 41 04 67 AB 0E D5 40 D1 71 A7 69 2A F4' + '00 6C 48 6D 40 32 41 54 36 24 AD BB 6A 58 43 6A 7D 0F B2 F6 1B FF F5 E5 F3 90 03 26 07 0A 1C 33' + '8A D6 96 2C B6 B4 85 AF 54 5E F6 96 60 5A D4 41 49 6B 54 8B 02 5D 24 14 01 40 95 7A BF 15 04 38' + '92 1C 4C C9 13 8A AB 85 30 42 D1 E1 4F 49 F1 BB BE 1C 98 6D DC 29 C1 45 15 4B 6B 05 9B 70 55 55' + 'AC B7 C5 62 8D AD 86 18 12 6A 90 31 51 DC E7 BA E2 A3 14 DC 97 DC CA D7 4B 09 4A 5A 9B 48 59 D6' + 'FA DA 06 A8 45 20 62 A0 CD 5D 75 B8 C6 36 0A D6 A8 7F 72 B5 B4 75 D9 72 D7 BB 02 16 63 19 B1 D9' + 'B2 F3 2B A8 36 65 49 60 D8 9E F3 DA DC 80 69 A5 04 37 6E BD EF 02 6C 64 99 C7 6B B7 6D C0 DB 72' + '8F BC FD FF 79 96 04 C1 84 74 D7 75 55 2D 17 8D 36 4D 15 1C 85 53 77 8A 47 76 D0 86 5C 09 1B 6E' + '05 04 A9 1B 6A DA AA F3 06 6E 60 52 41 42 17 BE 18 DE 01 B5 C9 24 C9 44 37 3B 30 BA 88 C3 75 E8' + 'EC 3F C7 1B 81 74 0C 73 A8 05 81 26 6E 18 5E 61 49 40 E7 46 5E 7B EE F3 F2 1E D7 4B 43 66 74 42' + '99 25 44 35 AB EB 4D 15 4B 4C C2 D2 9D 71 28 F1 94 18 32 18 53 41 0B 82 19 3F C1 9E 18 62 A3 0C' + 'D3 1D 2F A5 AB 5F 69 E9 4B FC 34 9E B5 A3 8C 12 86 F3 E4 F6 1B 98 FE 7C 49 D7 68 9F 9B BB BF DB' + 'E4 A2 B2 4B 2C B6 69 14 51 C3 69 19 DE 3C 33 9F 0D 9D 9F C7 D4 09 DC 90 93 35 19 0C 7A 7E 9E E0' + '74 C9 EE F9 3E AA DE 6B 6D FC AF 67 F0 B0 C7 E1 F0 7C 6F A4 A2 1B 99 03 00 78 78 78 6E B7 A0 45' + '95 0C 2A 8E 2E D3 E5 FE EF F5 BD 9F 81 CF 5F D2 F5 3E AA E1 09 6E 22 20 40 05 C0 05 BB 72 90 8D' + 'C4 2D 3C 1C 6B 1E 87 41 8F FB F8 7F B3 BA DB FD 3E 16 A7 D7 FA AF 39 7F F0 A2 3D 13 9F 91 B7 DF' + '4F 3F 5F ED BB 77 AF FF 2D 75 F7 3D 75 BE 8F C6 F4 FD 67 65 E2 AC 42 75 63 20 75 10 43 A9 7A BC' + 'BA BC 0C 59 83 8D 50 74 45 2F BD A6 E3 40 C4 FE 9D 6E B3 EE 95 A8 81 87 FE 76 33 0C 64 9C 7A C9' + 'A5 60 E7 88 B7 71 D5 78 5C 08 5D 33 F2 10 90 8A 80 01 02 10 88 09 02 24 40 28 18 C8 14 04 80 E4' + '43 7B EE 59 75 D9 8E 57 4D EE CE A7 F1 71 7E 5D 32 54 F9 CD 64 17 DD F6 37 C3 C7 FD 3C A2 1F 8D' + 'F8 FB BC 47 BC FD 7E FB C1 EA F1 F7 3B FB 9F 27 8A EA 7A 92 07 52 81 E3 59 3A 98 93 CA 75 98 DB' + '1E B6 AB 12 E9 3A D4 FB 3F B3 F5 18 76 AF 59 D6 7A FF 0B FC 9E EB 8B DF 6B FD DE B7 BF F2 B8 2A' + 'A4 00 E3 64 03 8C 48 A4 E5 E1 C9 79 70 12 01 C4 3F 4C 9F E3 68 FB 75 EC F6 BF 80 68 34 F9 4D F2' + 'BC 43 FC 6E 18 12 10 8C 35 40 09 24 48 42 B0 44 01 D1 4E 43 5C 55 AC 6A C0 8A 1C B6 8F 4B F2 FA' + '6E D6 FC F7 C8 B9 E3 33 F3 9F 37 B4 B1 09 C4 C8 6D 89 C5 C5 C2 DE 70 D5 43 02 5A 8F D8 3D B7 71' + 'F4 7E FB CC E1 FF 7D 90 E6 EC A2 1A B0 85 47 73 6B 97 21 50 40 80 D0 43 06 F7 85 D0 7A 98 1E A7' + '7F 69 D8 FB BA DD 8F 07 72 D6 6B 00 C0 80 10 01 C9 04 1D 3A 28 00 3A 10 AC BC CF D5 8F D7 72 3B' + '6C DC D4 BD ED E9 FF B4 2C DE 32 80 BE F5 D4 DE D7 18 A0 F8 40 80 26 14 00 08 0E C0 44 44 41 F3' + 'E2 90 8F 84 0D BA 71 FD 98 E9 0F E6 00 90 08 B0 80 40 10 00 69 03 BA F6 F9 8F 73 A5 5F BF EC 1D' + '7A C1 A1 88 6E 4F FD 77 FD 61 95 B5 61 6C BA 00 04 76 24 21 1D 50 CF 4A AB B9 FF 5D 82 11 6C 91' + 'DA 9B 90 EB F4 DD A3 67 21 0F 8C 50 0A C1 00 06 44 80 00 CD 64 7F 17 23 5D A9 FE FC 16 3B 2B 5F' + '9F 92 F6 D6 DC 76 3B A7 24 21 28 89 04 40 01 D0 81 19 FF 5C 6B FE 83 65 DE EB F9 27 8C E1 F5 7E' + '65 B6 EB F7 7D 99 19 2D B9 76 9D 83 B0 00 0A F1 0C 51 02 3E 10 24 A0 7E 72 5C 6B 8B EC CC F3 A1' + '65 37 B8 1F 96 B9 EF C7 76 17 B3 B5 5F 9F 3B F6 9E 93 CA F3 BB 1F 63 50 9D 13 27 44 93 9C FB 6F' + '87 F8 9E 1F F8 2F F8 FE 3F B2 CF A6 FE 6A 80 6E 61 01 18 A4 D1 18 17 6E 72 1C 80 02 4D 1A 00 05' + '28 1C B7 65 0E 9F A3 F4 F5 5E C2 85 CD 1B 8F A9 F6 D2 1A 69 61 78 BE DF 7A AB 5D 53 9D FE D2 89' + '39 19 27 35 25 D2 5B 92 A1 DA D8 14 2A 73 70 B4 E7 30 E6 E0 51 E0 7F A7 AF EE FE BE B6 7B BC 3F' + '53 BC EF FD ED B5 F6 9E EF B3 FF E7 BF FE 3C BC 1F C3 F0 BA 73 F8 00 52 3C CA 87 3E AC 85 46 59' + '6F A5 B7 D4 EC 9D 4B 6E DA 9B E1 79 C3 A7 FC 9F FF C8 ED 9C F7 E1 F6 FE 7F 8F A3 4F 8B 36 77 04' + 'AD A9 A8 F6 9D 80 45 43 8F 95 6C D9 68 61 2A 60 8E 34 71 77 3E D3 BF 78 0F A1 FF 6F 4F ED 75 ED' + 'DB B8 AD 24 AD D4 00 28 A2 83 C4 F1 3C 48 B3 B1 78 D3 EF 7F 1F C6 FD 8F C2 ED 9E AF D6 7D 8F 8A' + 'EC BF 9B F6 B0 D9 FE 3D 2D 7F 17 06 BF CF EC B0 92 4E 6F 3D F3 7D 45 BA 01 E8 59 0A 67 36 11 92' + '31 E8 6A 58 2C BD 0D A6 69 D0 27 D9 7B 8F AE FE 9F F0 F5 9F C7 F2 70 D7 B3 F4 5E DF 3F 8F E5 78' + '78 F9 39 41 39 4C 9D 8B 21 C8 A2 3C BC AA 70 21 88 20 20 08 A0 1F EC F4 E6 6E 04 A0 51 14 0B 89' + '1C E4 00 BF 1E D0 41 64 51 E2 77 98 FC 0E E3 43 67 B3 EE 5F 3E 5C 00 39 62 A2 9C DE 6D 85 9C BE' + '3A 39 A9 FF 63 83 EB AB 97 F3 F7 EB 3C 87 AF E0 D7 87 86 C1 21 B4 45 4E 16 6F C2 EA 0B C3 54 65' + '54 2C C2 1C 29 FD 1E DB F6 FF BB 1C D9 9B B5 90 A6 4D 95 40 1B 05 76 D0 6D 66 49 70 C6 8E 97 C7' + 'F4 F4 71 FA 2C B3 D7 6D 89 26 C4 47 88 DC E2 97 89 76 15 37 55 1B 93 EE BB 7F DC F6 7F 7F FE DE' + '3B 87 D0 7B 7F A2 CA D6 FE 7E B7 F3 7E FB F1 3B 3C BE 27 33 9E F9 95 D0 74 14 42 9E 6A 15 55 4C' + '81 CD 45 15 7A 0A 96 E7 C1 B9 61 5E 81 96 B1 46 3B 2C 78 5F 3D D3 D7 BE EC B7 DB B4 FA 0E C3 E2' + 'F3 DF CD BF CB FF 5F 1F 32 E4 0E AD 93 98 3C A5 45 94 82 BC F7 2E 8B 8A 81 7C AD 39 EB 12 87 9E' + '4A F7 4F 91 E9 7F 7B C7 F8 9E E3 F2 B9 FF 3F DE FF F7 B3 C8 68 77 2E BF 87 97 F8 95 CB E7 54 87' + '2D 93 9C 8B 21 CB 55 79 A3 CE A2 D3 2A 36 5A 73 93 13 3A 3E 5F 90 FC 9E 0F C2 FC BF 6D DC 6F F4' + '7D 7E DD 46 70 BC A4 85 32 36 95 00 88 A7 1F 17 1D A5 C7 8D 2E F1 A7 0F 8A FD 8E BF EC 3B 87 DD' + 'F8 EB 6D D7 C5 7D D6 D3 8B 8F 19 26 37 95 24 78 91 38 D2 F6 29 59 C6 9C 69 FB FE 4F AA EA 3E E3' + 'E6 FF 0F 55 F8 DD 47 BF 76 40 8E CF 81 F6 1C AE 3F CA A2 73 39 95 21 CA 43 97 7A E4 64 8C E6 24' + 'A4 C1 3B EF F1 74 DD 2F D5 BE F7 F4 76 6F F6 5F 02 D0 E0 E1 A9 0A 4D C9 22 90 00 40 45 B0 B7 24' + '44 0C 22 24 50 41 07 08 43 E5 BE 6E 96 77 57 91 D4 B6 CE FF AD 25 4F EF E5 6C B8 9F F3 D6 68 DF' + 'B7 F3 1E 3D 1E 1E 86 82 74 16 A1 79 CC 3B DB 21 4C 82 23 D1 33 0C 0A 3A 26 B0 25 19 F4 55 CB F4' + 'FE A3 F3 3F CF E0 FE DF DF E5 EB BD 65 B7 6E FD 3A DF C9 52 14 F0 F1 D8 B1 39 18 71 A4 15 39 36' + '51 39 12 F9 D7 43 FC BF AF E2 78 3B DF C8 F7 1C CC 7C 66 EE BF FD 37 F0 A7 28 12 2F 2D 00 A6 4E' + '46 43 8D 20 10 44 41 94 50 50 48 46 47 9F E2 F2 7F 1E 07 D8 27 A1 EE 49 F9 78 1E DF E2 F2 7D A7' + '6E ED D0 91 EB E4 08 00 08 09 00 8E 84 44 04 8F 4E 83 D1 39 04 E8 20 40 41 EC 0F 2E 3F 67 C2 4F' + 'B4 FB 32 3A 1D 5F 0B E0 88 B6 95 46 9F B9 C6 B0 40 80 0D 44 0E A9 03 91 58 33 9E 49 CF 27 33 E9' + '38 0F 19 D2 EF C7 A1 F4 3E 7F 1F E6 DC 04 DE 92 64 31 9C 0D 84 B5 74 76 85 B7 EF F7 7C CF 4B F6' + 'F6 FB CE CD F1 DB 36 74 95 00 DC 32 73 52 1B 91 60 09 1B 08 11 01 04 5A F4 9D 9C DF D2 87 8F F4' + '76 5E B1 B4 3E 6F 25 B3 4F FA A1 DA 2D CF 7D 1F 5F 15 A6 40 C7 5B FA 42 7E FB DD BD D3 FD 1D B2' + '21 3E 71 3A 46 10 ED 4A 91 9D AD 95 06 68 97 B1 E3 3A DE 93 D8 D7 6C FC EE ED F9 9E 6B CE FD D5' + '6A 72 32 CB 26 00 23 22 1C 88 90 84 F6 7D D7 92 34 BD 2F A2 86 D1 38 2D 9B 36 6C 63 90 8D 44 08' + '40 69 FF 6B 3D 3E 8B B6 C3 E0 EE 73 3D 6F E8 78 BD DF F3 40 3A A4 0E C5 52 74 5D 17 1F 83 F7 5E' + '8B 93 C3 7D 6E CF CA FC 5B FD AB D4 61 24 52 70 24 DB CA 65 FB 43 F4 C8 F8 02 9D 6D 6D 6D 69 C0' + '80 71 20 26 20 01 CD FC BD ED 1D 87 ED F8 BC 4F D1 2F 3A B7 F6 34 88 C3 0C 30 70 20 30 22 22 20' + '46 04 09 4B CE D1 26 05 E6 2D 38 39 3A CC F6 B7 A3 FC BE B5 BB 36 50 65 97 20 00 0C 8D E0 82 02' + '04 26 67 6B A8 FC 2F 4A A1 BA B8 77 F8 0A 90 08 D0 40 02 18 81 22 86 BF 6C EE 1F 5D AB EC 6C 7C' + '09 2F B5 55 BE 89 B2 3C 69 BD 33 77 6C 90 81 14 04 08 4C 7F 83 5D 4E BB 6A B6 5F 7B A5 C9 EA 3C' + 'AF AE F9 C4 E9 D3 21 32 40 02 7A 9B FC 9D 22 0F 27 4E 49 65 96 5A 01 C8 40 11 02 13 C7 F1 BE 1C' + '1E 4E E1 14 98 40 81 98 10 02 89 00 81 DC 79 F8 0D FB 1F B7 63 D0 97 F7 EC BD 3D E7 4E BA AF 9F' + '3E 31 01 C8 80 01 3C 6B FA 63 D9 38 F6 FD AE 0A 60 BA EB AE 60 20 3E D4 20 00 01 FD F5 38 3A E2' + 'DC 7D 37 F9 E2 F6 7D DD 7F 0D 95 D8 61 C1 40 9A A1 20 13 32 20 4C 3C DD 8A 3F 7D 53 CE D3 C3 3C' + 'E5 48 04 4C 44 48 45 84 09 03 9E F2 B8 EB 1D 0E D9 1E 8D 1B 6C 97 6E 64 36 A4 DA A9 3F 3F A4 F6' + '8B E4 CF F5 CF A3 C8 26 C4 14 0D 89 3D 0F B2 F9 EE D3 ED 7A AF 2F CF 6A 0F ED 68 79 44 CB C4 FD' + '5C B6 B0 B0 40 00 18 1B A1 A0 8A 00 51 00 00 D5 66 8D 30 BA 22 F2 BE 5D 67 FD E0 95 B3 66 80 43' + '73 37 A4 9F 4F C6 FB DD D7 CF 3A 84 9E BB E3 FC 2F D4 EC FF C7 B4 BF C0 F9 9E A5 D2 07 42 C9 3D' + '1D BF B7 F1 BF 5F BF 5F 9B CF F3 DF 36 B7 E4 E5 A1 C0 6C 04 E8 44 84 0B 71 21 3D 8E 08 E9 71 D0' + 'D4 F7 19 25 F7 7D 4F FB 38 ED 7F 0E C1 A9 00 81 86 22 01 2F AD E4 BC E4 60 52 49 F0 3D BF 47 F4' + 'FF 85 D1 63 C1 FC 5B A1 63 44 35 40 A6 4E 81 03 C8 F4 FF 95 91 2E 19 32 18 A0 7F 87 D4 FD 36 30' + 'BE 8C 87 5C C0 3C D7 76 F1 1E 3B FC B8 FB A6 50 34 82 40 BD 10 00 0A F4 7F 0F 97 D3 D3 6D D5 E1' + 'F5 FF EF C7 E7 22 A7 9B D4 6B 7E 0F A5 D1 01 90 20 41 12 08 81 09 BC E0 71 76 BE 7E 5F 03 39 F5' + 'DF 83 F5 9A 7E CE 9E 03 E4 70 48 1C 2A 0C 0E B0 E2 A0 0F BE EC F9 9F 53 E7 BC 5F 63 A7 A9 F6 1C' + '3D EF 5C B9 D5 91 0E 0F 9F D3 79 27 73 54 9C 3F B5 E5 3C C7 86 F3 7D DB C1 7C 1D 84 9C 10 40 87' + '79 49 09 CF A7 74 67 13 0D E8 1E 1F 9B DF B9 BA 43 02 4D 12 10 F3 DE AF FD BD 77 6C F7 9D A6 3E' + 'FB 48 6C 09 C2 A9 27 E0 F8 FE EF B6 44 80 71 10 00 04 44 08 4E C3 91 E8 F2 A8 90 0E 42 11 11 20' + '13 E2 C8 8F EB EE 3E 4D 46 58 BE D2 74 BB 9D 2A CE BF CB 72 03 76 E0 00 42 F4 FE A7 BC 13 FE 1D' + 'AD 1F 5E C7 E3 4B 7E 7D 27 82 91 FF 08 8D C8 00 E4 80 20 04 72 24 21 20 94 09 41 DB 50 BB 16 13' + '89 BC 8C B2 4B B0 EC 18 4E C7 8B CC 5A 06 0D B0 69 18 06 1E EF 2C E1 78 64 84 2A 1D E7 4F C8 F2' + '78 43 16 69 AD 4A 62 9B 10 9A A1 34 0B 34 4C 59 66 1D D5 52 61 C5 F8 56 CA 1B B7 6E DD 81 35 76' + 'EE A8 1B 52 7A 3E D5 F8 1D A7 75 E0 86 24 D1 24 CD 92 D0 40 B6 9A 36 93 8C 60 06 0A 2A EF DF BF' + '7E 13 8D 9A 24 D8 80 6C B5 41 D2 E5 A0 1C EF 5B EF BF D7 C0 FA 2E 87 2D 47 89 93 6A 1A CD A9 41' + '83 14 93 72 56 14 12 86 4E 36 4E 3E 3E 3E 3C 72 C4 8B B1 13 46 15 20 17 60 6C 60 6C D9 B3 65 F5' + '19 34 43 60 E8 94 8B 20 68 31 BE 16 81 76 E9 20 59 88 6C D9 B3 66 39 E5 05 36 6C A8 4D 10 34 DB' + 'EE AA 66 DE 97 3A 84 31 64 B9 8E 34 1B 76 ED DB 96 8B A5 00 BA F9 6D D4 58 98 2B 24 D0 DA CA B6' + '54 43 16 10 BA 46 05 E8 6F 50 C6 AA B0 68 97 49 30 82 05 5A A5 32 42 C8 02 C6 32 06 0C C1 C1 08' + '63 84 0C 5B 12 52 10 A4 91 51 59 26 2C C5 97 48 45 03 72 06 04 2C 9B 76 D4 2E 06 78 54 21 68 61' + '86 DD B7 30 86 89 A6 A5 01 B3 0A 24 AA B2 C8 94 DA 42 29 05 08 91 26 0E 08 5D 2E 92 30 D9 B3 66' + 'CC 26 0C 0C 52 99 22 91 04 86 69 B3 65 43 07 04 35 64 A9 0B 54 92 90 8A 33 72 4B 58 35 D7 5D 6E' + '4D 5D 10 0C E1 9D 12 4A 82 17 61 2C A9 25 A0 C9 66 EC 84 B3 01 0C F3 B4 90 DA DC 2B 4A 0C D3 1C' + '71 09 9E D2 B6 30 C9 26 D6 4C CD 34 A9 86 86 98 92 CC 93 34 93 08 61 85 A6 08 06 8C 34 72 61 4C' + 'BB 20 19 31 0C B2 B0 40 CB 1C AD 09 92 49 8E 34 4C 55 C1 0C 18 B1 43 46 06 AE 59 6D B1 8A 19 E7' + '41 B1 0B A4 D8 C9 49 30 C2 A5 91 61 76 4A 49 7C 30 B1 24 B2 59 45 B5 04 34 C2 A3 B3 66 CD 30 08' + '68 87 2F 8B 8F B6 F9 EF C9 EC FC 77 E5 7A 1F 63 EA BD E7 BD F8 07 EA EF E9 BE 1F 7D F5 87 DA 7A' + 'F2 A9 8D 67 03 CF A6 C3 67 3C 74 4C 27 49 45 49 CF A4 A4 E8 FA 35 A0 3B 5B DA C1 32 64 C5 03 26' + '4E D7 6A 16 42 79 CF EF EB FE 3E 3F 1B CA F7 BD 3D B7 D3 FE 37 E6 FA 1E A5 D7 CA 83 D3 A2 81 5D' + 'E4 A3 66 FB CA 67 FC 24 DD 79 9B 4F 36 9B DB FB FD 3F C7 DD C5 D8 EF 9E 7C 2A 76 31 E0 7C B9 1A' + '73 1B 2E 4B 34 FA 78 9C 7C 13 3D E6 76 58 D7 1C 7E 25 8D EF 53 E6 8D 4F D6 A2 47 6A 9F 2B AD 8E' + 'C5 CD 2F 47 55 BB E3 E3 D6 59 62 45 BC C0 D5 65 DC 9D EB AA 67 A7 09 35 26 6B 2B 45 D8 95 57 D2' + '71 1D 66 9D 94 F8 DC 77 39 9A B1 D4 BE 52 DE 16 61 82 A9 79 DB 52 94 FE 70 A1 8D 0E C7 31 29 2E' + '9C C6 79 65 9A 3A ED 54 12 74 50 B4 B6 61 15 1C 4B 88 2B 22 E5 3C 31 E2 EC CD 30 B2 E2 6A AD 15' + 'B6 69 8A 9C AA 5B 25 63 E5 BA 2F 1A 48 5E 74 19 05 B2 22 2B D8 CD 64 14 24 17 30 23 6A 91 00 67' + 'B0 60 3B 2E 29 CF 21 91 08 C3 21 19 16 4C 98 63 9E 00 10 11 9E 04 17 E7 81 04 51 45 24 61 86 18' + 'C7 42 8A 28 A2 8B 24 61 86 18 D7 4E 9D 3A 74 E9 D3 A7 4E 9D 0A 58 C2 8A 58 C3 0C 30 C3 0C 30 C3' + '0C 30 C3 0C 37 B0 30 C3 0C 30 A6 0C 30 C3 0C 30 C2 8A 28 A2 08 20 41 04 10 41 04 10 41 04 10 41' + '04 10 41 04 10 41 04 10 41 04 10 41 04 10 41 04 10 41 38 70 E1 C3 87 12 5C B9 72 E5 CB 97 2E 5C' + '96 10 46 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 86 18 61 9C 20' + '82 08 20 82 08 20 82 08 20 82 08 20 82 08 20 82 08 20 82 08 20 82 08 20 82 08 20 82 08 20 82 08' + '20 82 08 20 82 08 11 A6 9A 6E A1 A6 9C 73 D3 8E 38 E3 8E 38 E3 BF DC 13 87 D7 02 00 05 E6 EB 80' + '00 F0 2F 35 C0 82 00 0B F7 FE E8 8E 1D 3A 74 30 C3 0A 28 A6 9A 2F EE 10 40 82 0B C7 70 E1 B3 66' + 'CD 1A 34 D3 35 9B 26 4C 98 1A C5 79 AC 0D 35 86 96 96 92 E5 CB 96 2C 59 A1 A1 A1 9F 9F 9F 9B 9B' + '9A A5 4A 93 4D 52 9D 3A 7C AC AC AC 8C 8C 8C 6C 6C 6C 4C 4C 4C 2C 2C 2C 0C 0C 0B EB EB EB DB DB' + 'DB CB CB CB AB AB AB 9B 9B 9B 8B 8B 84 68 D1 DB 5B 5B 22 44 89 02 04 16 56 56 56 36 36 27 CF 9F' + 'B0 B0 B0 AF AF AF A0 AE AE AE AD AD AD AD AC AC AC AC AB AB AB AB 34 D3 4D AD 30 C3 0F 9C 61 96' + '65 96 5C 67 B1 5E C4 7B 0D EC 27 B0 5E 90 F4 81 5E E9 90 F4 87 A4 3D 21 F1 0F 88 7C 43 E2 1F 10' + 'F8 87 A4 3E 21 F1 0F 88 7C 43 E2 1F 10 F4 87 A4 3D 7A 41 11 A0 C1 83 1A 14 28 D0 E1 C3 87 0F EE' + 'E2 F1 7E FF BF F5 FD 7F 5F D7 F2 FD 7F 5F D3 24 84 00 E6 84 81 C2 F3 F7 15 9A CE 4B 40 F5 A7 21' + '85 42 03 7E 43 0A DA 1B 3A 0C 2B 78 DC 7D 05 4A 32 6C B3 F5 2E 6B AC B3 D5 3F 39 73 B3 D8 77 B6' + '53 73 99 CB FB 49 F9 BC AD 2A 56 F7 19 AC AF A1 E1 EC FC ED CE CF CC DC 6C F7 BB 7D 9E EF 6D B3' + 'F2 7C 2D 9F 91 E0 EC EF 0F A2 EF 56 CD 5D A2 AD BA 45 5A 95 15 6D CD AD 72 4B 5A E4 96 B5 C9 2D' + '6B 92 5A D6 A4 B5 AC 48 8A A5 22 2A 94 88 8B B9 44 5A 54 47 5D 22 3A ED 12 0B A2 D1 5D 48 B6 BA' + '2A DE EA 32 4A 46 77 79 B1 31 EF 2C 30 AF 61 5F 55 99 06 FF 15 A9 6A C8 53 8A 93 2A 48 F9 09 DB' + 'C8 D1 D6 D0 53 83 9D 1E 06 72 A2 9F E8 1A 53 F5 A6 95 03 48 D2 B5 98 9A E8 A7 03 B7 6F A4 6B E2' + '86 20 51 5A 9A 51 1A 86 95 05 E1 B1 E1 BF 36 44 51 CD 8F 26 31 51 62 C3 34 B9 05 1A 61 67 1C 71' + 'C7 1C 77 E6 00 1E 41 E0 41 3C 78 10 40 E2 1E 00 00 7D 23 DF FA 78 03 C0 28 77 FA 22 98 32 60 C2' + '52 01 49 08 A0 79 26 18 B8 AA B8 D4 A9 5D F7 2B 28 AA 49 8A B0 B3 25 92 4B 2B 29 90 98 E2 18 B6' + '09 92 B2 60 CC 2F 30 B1 2E 32 42 ED 92 C2 10 B5 CB DA 90 98 20 62 86 18 51 31 60 60 C2 5D 85 92' + 'ED 63 52 42 F7 B1 68 A0 60 C8 5D 0C 17 0A 20 14 84 2D 85 ED 2A AF 69 30 64 30 40 98 A1 58 50 A6' + '0C 90 B2 4B 20 17 40 B6 34 B7 64 C1 20 17 49 76 F5 52 EC 81 7B 53 7A 02 59 25 20 5D 0C 58 1D BB' + '2F 65 F9 1D 77 E6 FF A7 FF BE BB D9 FD 14 A4 D7 2A F3 6F FE B7 BB 9B 2D 95 37 FC A0 F6 EE BF 95' + '07 37 AF 93 CD BB DE F3 FD FA 7E 52 5D F7 F6 C3 FC 79 1B 3E E7 A9 59 B2 A3 DD F5 7D AA 4D E4 E6' + '0F E7 B6 A8 99 A3 C9 9A DD 50 E2 CB DD F1 FE 6B 0D B7 7F 91 2E 97 F1 FB CF 99 27 99 45 F9 73 FB' + '78 B3 57 9F 6D 9D 62 8E EF 20 FF 66 AF 2A 8E 75 2A 19 D4 92 D4 E7 F9 76 E8 29 6C 67 B1 65 D0 4D' + '59 62 5D CF 55 CE DB 54 5E D1 24 30 BC EA D5 18 D9 95 B9 B9 74 20 80 07 AA 78 00 00 E9 9E 00 10' + '3C C3 DC 19 5D 70 07 84 80 4C 41 20 20 20 54 50 02 12 BE B2 DB 37 3F C8 E4 7A 6F D9 93 BA CE 78' + 'F8 1E 27 89 B9 DC 6D F6 FD 36 DF 6D B6 F0 3A 6E FE 6D CE B3 07 C9 A5 97 EF B0 B6 B4 F9 0E E2 BE' + 'C7 F6 F8 97 FA F9 D6 77 D9 8D 76 66 D7 9C CE EC 35 BD B7 67 D4 F4 B9 3C D6 97 13 07 0B 0F D2 EE' + '7B 2F E9 9D DF EF FB 2F E7 9D AC 07 E2 48 A2 44 04 00 2B 04 00 37 9D 22 3A CC AE 1C 7C 46 B1 1D' + '33 06 0C 3B 7C 47 8F F3 2E E2 61 E5 E0 57 E6 32 D9 7C BE 62 5D 7D 7D 64 AB 09 56 15 F9 8B 19 B9' + '9B 1A 76 34 6C F1 72 D8 95 31 72 D9 6C B6 59 62 56 08 64 0D D0 90 08 E8 40 84 02 88 10 03 20 C8' + '01 C4 44 44 80 40 11 00 02 08 90 84 20 1C 40 9E FE C8 F0 EE E8 CB C4 F4 BC CA 5F 6F 27 E1 7D 5D' + '86 C9 F6 AB E5 93 9B E1 DD 7D 52 68 A0 97 F7 AA A9 2B 63 67 06 2C 2E 16 92 5A A4 B8 52 F2 DC 0B' + 'FB 4A C9 EB 56 3F 0C AC E2 6E 2E CD 05 64 B4 B7 BA EF AB C4 EA 21 D5 DD 1B F5 5C CE ED 5E 58 0E' + 'A1 2F 37 A4 E3 7D 6F 06 CA 07 15 24 49 FB E4 7D EB 8E A7 E1 C5 65 CF 16 95 16 09 AB 12 E7 2C 90' + 'BE BA 6F B6 FA 97 C1 D9 9B 61 54 CD 9A BA 36 7D DA 3A 45 4D 50 B2 ED 76 5E 1A D2 45 7E 55 EC 82' + 'E3 E5 AC 2A D2 E2 A5 DC 42 46 AC C0 22 C0 D8 A8 71 A4 6B 42 74 89 34 18 B8 CD 33 C6 CF 52 AA FF' + '3D CD FC 3C C3 64 48 71 A1 27 4A 03 DC F5 EB D6 2D 19 74 69 0D 5A 44 80 49 2F A3 C0 35 E3 37 2E' + '61 41 79 10 87 E6 8A 54 77 B0 49 2D F1 45 0F 23 58 B8 B1 A4 C3 87 26 39 C6 1D 1C E3 8E 34 D3 93' + '82 0D 61 E3 C7 80 00 0C 83 C7 8F 02 07 87 F0 2E AD 25 85 CF 8D 5F 2D DF F1 BC CC 6B BE CF 4F 91' + '38 54 A8 B2 5C A5 E9 4E 97 C8 D2 F9 56 7B 71 55 B1 45 F4 70 DA 6E 0E DC 50 D7 D8 CA DD FB 49 64' + '06 44 EA CE BE EB D9 2A CE 79 E6 D6 8F DE 7A 77 1B 85 F5 29 61 4E AF A9 A5 D1 96 93 8F 12 D2 82' + '2E F9 1E 0F 77 48 DE B6 4C 19 4E E3 5E 6F 36 62 7B A7 A7 D2 A6 2D 11 5D 86 59 97 88 90 F5 12 D6' + 'E9 4B 31 61 DD EC 69 24 EA 67 BF 41 1A 80 DC 94 58 1D 94 CB E0 F7 AD 5F 56 A9 AC 3B 39 5C 17 D6' + 'AD D4 E9 D8 BD 7A DE E9 21 59 42 06 6E 82 3C DD 3B E1 EF F0 5D 30 CF 7E CC 8C FB E8 99 91 94 6B' + '61 B0 8B 86 B1 9B 4C 86 41 2D 1D C2 96 A3 47 7E B1 7A E1 56 E9 B2 21 F4 83 5E 3A 36 2C 59 0E 22' + 'BA 22 2C 58 30 75 1E BF 84 F6 14 58 04 41 88 54 28 D1 8A 34 92 E4 48 90 59 A6 1C 69 D8 CD CD DC' + '27 1F 95 BB 51 5B 4A 57 CD D4 F1 56 68 FA DF BC A1 79 1E A4 8D DE C5 EF AB 63 F0 7A 9B 33 2C 30' + 'F7 E9 20 EF CD 3F BA FF EA A7 9E ED BF 4B 69 EF D0 54 FD 99 13 54 36 BF 66 6C 9B 7C 7F C3 E4 AB' + 'BE EC FC 0A 1D 5E 73 E9 53 50 7D C9 FE 8A 2E 3F 5D 29 5D 1E 2E 8C F8 A8 A7 F9 5C E8 29 D9 E9 F4' + 'F0 AC CB 56 FA E4 82 EF 93 77 CF E5 4A 59 38 1D 96 4E A7 4E BB 03 AA AD FA 5A 6E E5 76 91 BD C7' + '56 AC 5E 55 DA E2 5D 68 C6 AF 3A C5 FA 68 8A 2B 11 62 65 DD B5 B6 8F 81 6E 9E 32 97 0D 0D 2D 5D' + 'A5 98 EE 70 1A E6 43 63 10 4B E7 AB F5 A0 3C 67 8A 4B 56 0D 70 F3 82 14 80 B4 9B BE 8E 1B 2C D7' + '8F 60 C1 92 29 8E 9E 16 48 CC 4A 7A 61 B0 E4 1C 5E A3 D8 2E 85 32 1C 1D 68 A5 94 69 70 0A 8A 51' + '86 44 92 49 25 47 28 B8 E6 1A 69 87 1D 88 00 00 58 9E 04 F1 E0 0F 1E 04 0C 13 C0 83 B3 D2 B9 A7' + '94 FE BE 26 D6 70 B5 DB D2 D8 FC FF 57 10 D0 FE EA DC FE CF 0E B8 34 3D 8C 8F 8F 83 D4 BE CE 91' + 'B2 F4 26 E5 F9 9B EF A3 FB E8 9C 8F BF 3B BC E1 4D 0F 3B A1 9C 8F 4F E6 9A C3 C9 E6 3C 9F F9 9A' + '7E 49 27 B6 D4 EB FB F9 69 37 15 73 9F A6 83 2D FE E9 D6 2F 1E E6 A7 22 9E 91 CD EF 00 9A 15 5A' + '9D 7D 04 FD 9A FB 8C 87 7D DB 0B 0C 9C CA 05 D3 F4 D8 4E 2D 27 DC 8D 21 2A E2 DD C2 66 D5 26 21' + '6B AD 34 DC 60 AA 46 4B 95 AD 58 B3 D6 BD 76 91 BD 8E 53 62 AF 33 5E A9 5F 10 4B F8 2C F1 A1 A9' + 'C8 42 D8 76 22 67 99 86 45 D4 57 89 F0 31 B2 E1 38 0D CE AB C6 79 27 27 CC 68 FB 42 03 88 50 17' + '36 4F FD 7A 3C 81 F9 FB ED DF EA DF F6 7F A4 D7 A5 71 02 2E 06 E3 CF F9 A9 3E 19 BD 92 E7 7E F9' + 'F4 36 9E 30 20 00 07 EA 3C 08 2F 21 EC 0D 7F 75 B0 CC 90 38 5E D2 A4 6A FE 6F 6F EF 41 4B DC F7' + 'B1 EA 90 78 3B 7B 7D 1E 47 C4 5C 71 3D F9 59 C4 AB E8 4F CF FE 89 D6 4A 52 FE 1D CE 97 2B 0F 9D' + '70 61 36 59 28 28 B8 59 0D 38 5D FF CD 1F 77 B1 CF BA 9A E5 57 1D 73 97 A2 B7 1B B6 87 AF D5 13' + '57 1C 51 63 C1 91 81 85 51 70 87 BE 35 DD 46 05 9A 70 F0 2A AA 34 71 56 3F 6C E1 CB 54 2C 99 E8' + 'A1 7F 80 8B 5A 26 B4 23 72 ED EF 2F 51 B5 5E 9A E7 1F 47 0D 65 B3 4C 55 CC 97 68 DF 31 CD D0 D3' + '74 2B 10 F1 F1 45 88 13 A8 29 DD A0 BC 44 9A F2 F6 F5 2E 46 00 4E F4 4E 93 04 98 91 64 18 69 25' + '96 64 92 CC 34 E5 DA 5E 58 19 C7 81 04 1B 8A 8F AA 63 EB 98 B7 A8 F3 BD 1D EF 49 1D 47 DD 33 6F' + '55 BC 96 F5 B6 46 C4 70 41 24 40 78 2B C3 9D 6A 48 84 69 65 43 28 91 E3 C2 82 69 86 C7 30 D8 F2' + '67 6C D7 63 4E 1F 9D B1 9E B1 E2 CF 59 4F D9 4F 9F 57 88 E5 66 F3 83 B9 DF 6F B8 3B DD FD 35 C3' + '05 15 17 2C 14 D9 61 69 E7 A1 C5 67 A1 6D 8E CD 5D C6 4B 35 89 32 52 E5 5D 65 5E 65 DE 65 5E E5' + 'DF 65 B3 5B 82 A1 9A EC 3A 8A 87 C4 44 8D 12 82 1C 28 91 22 15 5F 63 62 7E C6 2B 68 F1 E3 B3 79' + '1F 22 4D CD B2 C6 6F 61 C7 8F 1E 3C 78 F1 EE D2 47 91 8F 7B 81 8F 87 81 85 86 D5 AB 56 AD 1A 34' + '66 CC E6 8D 1A 34 66 63 43 5A B5 35 B3 63 9B 36 6C D9 B3 90 82 09 C3 C8 5A A4 19 14 A7 F0 CC 8F' + 'AD 0C B8 F0 63 6B 0E 3C 68 66 49 2A 49 C6 C9 30 E3 8D 3A 49 C7 1C 77 86 08 00 4A 9E 04 10 41 E7' + '9E 00 13 88 89 02 A6 2E 2E 2E 2E 2E 2E 2E 2E 2E 2E 2E 2E 2E 2E 2E 9B 4D A8 D3 E9 F4 99 FD 4E A7' + '45 A2 D1 72 7C A7 35 CD 72 9A 7D 3E 8B 4F A7 C9 C9 C9 C9 C9 C9 E3 EC 7D 2F 4B 63 B1 E8 CC 4C 4C' + '4C 6C A6 26 66 7D 99 99 9E 0F 03 81 C0 DF EF F7 FF 77 03 A7 F3 ED 3E 7D BD AA 2D DB 14 28 10 32' + 'B3 AF 76 CE B0 47 75 95 75 34 B5 35 75 7E 0F 03 AE 7D 45 55 51 AE 0D 30 DE A9 86 98 69 8F 67 8C' + '35 FD A7 67 A8 6B E9 A9 AE AF 58 CC AC A9 E3 7B 19 66 A7 4E 9D 3A 74 F1 94 27 50 A0 85 2A 4A 8A' + '4A 98 C6 AA CF 54 A9 51 A4 AB 8F 26 42 54 B2 16 C9 BB BC 30 D3 8E 54 CD 9E 0E 12 E6 1A 5A 58 DA' + '4C 57 F7 00 00 09 E3 C0 80 06 9F 91 E3 7D 7B 9D BF 91 E8 7A 3B 6F CB CB 2E 3C 68 64 66 3E D5 75' + 'E5 F3 3F 1D 87 17 85 BE E8 F2 BD CF 5E 5C E3 24 C7 26 2A E8 23 C0 F4 E5 9E F4 7D EF 7B 9F 29 FA' + '71 F7 1F 17 C5 B9 FB 3A D2 9D 1E 61 A6 17 26 44 72 89 8D 17 75 B9 E1 76 27 7A F3 BF 6C EF 5E 72' + '5E 57 8D C3 E2 F6 B8 DC 6E 5F 74 E3 8E 38 E3 8E 38 E3 8E E7 65 E5 C9 93 92 59 65 96 58 A2 BF 82' + 'ED D8 41 2E 7C FA 69 83 06 12 24 0E 38 E3 DC DC E5 A4 51 72 92 E3 29 45 DA 7B C5 4A 15 67 67 DF' + '5F 28 CF CD CE C5 CF 8D 1A 35 C6 2E 76 16 16 76 02 9C 0C 1C CB DC DC CD 0D 05 09 D3 A7 4E 9D 3A' + 'A4 F8 EA 15 43 91 22 44 8C FC DC DC FC F5 4F B4 01 03 6E 01 E0 40 04 53 C0 8D AE 18 66 ED DB B7' + '14 51 44 14 61 BF D2 52 53 85 C2 E2 F0 F8 DC 6F 1D F4 58 A4 92 49 24 10 38 F1 A3 46 8B 18 92 49' + '91 22 46 CE 66 6A 5E 5F A9 D4 E9 74 A6 A6 BA DD 6E C7 62 82 82 82 82 82 80 B2 FB 5D AD CE E7 73' + 'B9 E7 73 B9 D3 3D A9 92 E6 66 BA 74 14 33 D3 D3 33 34 34 34 3D 95 7D EE F2 BB AB B4 29 E8 DA AC' + 'A5 21 B2 34 59 64 5B 27 21 BD 6D C5 72 92 1C 25 CD CE 72 12 A1 C2 BE 56 3A C1 C3 C2 5C 3E 88 E2' + '63 2F 1D 80 E2 E4 B1 7E 33 88 4A 64 63 64 5D A8 92 A6 F5 3C 42 B0 17 8B 99 86 2B 1C E1 59 64 0B' + 'A6 AF 2D 5A 75 6E 54 C7 59 9A B3 30 55 6A 96 AA 59 A3 A2 1B C1 1E 47 84 EA 4B F2 F5 4B D6 2E 33' + 'F2 0B 25 D8 FA AE E4 7A 4A AF C7 17 72 45 38 50 90 D6 98 E4 73' +} + + +LANGUAGE 0,0 COMBINING UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE +{ + '42 5A 68 39 31 41 59 26 53 59 D0 E8 B1 5C 00 01 20 FF FF FF FF FF FF FF FF FF FF BF FF FF FF FB' + 'BF FF 1E FF BA 33 BD B1 FF FF FF FF FF FF FF FF FE FF FF D0 05 18 00 D4 C0 A6 4F 03 40 55 53 FD' + 'A8 22 33 52 68 D0 DA 4C 4F 53 F5 1E 54 D1 90 1E A1 A3 4C 81 EA 06 8D 34 1B 4C 50 00 C9 E5 34 D0' + 'D3 C2 13 C9 92 1A 19 19 03 08 68 03 40 C0 8D A6 91 E9 0F 41 32 00 0C 9A 68 32 62 32 30 D2 11 53' + 'F4 A7 A4 34 D4 F5 06 A3 D1 91 03 D4 F2 9F AA 0F 29 BD 50 7A 13 CA 1A 0C 86 26 41 E9 0C 8C 08 0C' + '41 A1 88 19 34 01 93 10 69 91 93 46 40 60 43 4C 10 32 1A 68 34 C0 11 A6 8D 00 68 1A 00 D4 F2 24' + '4C 44 C4 CA 9E C4 D5 3F 15 0F 48 C9 A0 00 03 40 00 68 00 00 00 00 1A 00 00 68 34 00 32 79 40 00' + '00 00 00 00 00 D0 06 80 00 6D 42 00 00 0D 00 00 00 00 00 64 D0 00 34 00 00 00 00 00 60 8D 0D 0D' + '00 00 00 00 00 00 06 8D 00 00 00 00 34 06 86 09 35 4A 46 A6 88 C2 61 0D 19 3D 08 C9 A0 34 00 F5' + '19 30 9A 64 30 4D 3D 4D 34 D0 34 06 86 80 01 91 91 80 40 0C 40 68 68 68 00 69 91 A6 83 4D 03 4D' + '00 0C 4C 40 F4 8C 08 D3 36 6B 4F EC 35 39 A1 09 4D 06 12 D9 BA CC 5C D4 BD 7D 9A BB BB C9 1A F6' + '9D C3 FF 8A 20 90 98 37 62 82 25 D1 59 25 3A 0A AE 50 E5 52 6A 6B 1E 90 46 6A A4 89 8C 2B 0A FA' + '4B 56 04 10 DA 2B E9 52 89 2A E0 6A 43 0A C4 83 04 94 46 9C 69 B3 CC F8 82 F8 C1 3C 63 01 90 60' + '11 17 2B B3 02 08 24 02 49 C3 C2 64 4C E2 71 38 A9 40 92 40 09 86 24 AC C9 99 9A ED AA 1D F0 E6' + '95 D2 08 C2 25 88 6A 49 42 C2 44 11 8C AB 59 40 46 5A D1 AE 48 8D EC 79 E9 08 96 92 5B 85 D8 BA' + '12 C8 E2 26 AC CA 0C 74 83 68 BD 77 22 17 4C 28 04 43 2C 44 E4 98 42 9E 89 7D 81 37 AD 33 45 33' + '31 0C 4E 12 21 DD 89 AA 31 45 9C 58 C4 8A 48 CD 48 35 F7 09 D8 21 40 23 0C 10 CA E8 42 A1 15 05' + '41 4C 54 16 22 05 54 A1 7E E0 C2 17 43 18 B3 49 26 2B 22 E0 92 C9 62 52 BB 18 E8 D1 43 57 B9 4E' + '61 19 64 21 C1 04 39 14 05 17 76 09 46 87 8B 84 1A 21 99 5F 49 92 0A 41 82 DB 44 4A A4 61 3D 27' + '7A 1E DC 44 63 4D 83 2A 02 98 83 5A 8B 8F 74 C9 22 48 20 61 26 09 83 0B 40 88 91 82 EF B1 92 32' + 'B9 FF 6B 40 A9 69 79 7D 1E B0 B3 4C 08 08 25 10 C6 5C 13 24 C0 88 8B 17 16 4A 48 88 8E E7 D4 78' + '6E 04 EC 49 00 F2 27 62 5C A9 87 2E 31 C5 43 A2 D8 DD FA 7F 48 D3 16 67 9E FD 31 62 DD E7 33 28' + '09 70 D6 B3 AD 70 BC 65 39 71 6C F9 65 AC 21 98 6E 9D AC 4B D5 47 1A AC 41 36 14 52 2A 05 61 8E' + '6F DE 98 0B 1A 34 75 6A 79 F8 A0 54 2B A5 B0 86 24 58 53 17 91 2A 70 21 17 A0 40 09 73 02 E1 57' + 'BC 47 22 F6 A0 D3 15 80 20 80 03 15 E5 75 35 90 0B E3 EB DB 54 58 37 6A D9 AD 76 14 14 2B 35 13' + '99 22 FC FD 00 D9 B1 D0 87 6C DE B7 3B AD AC 70 2C 59 21 21 BE 91 92 92 5E FE C1 83 12 74 D2 92' + 'A3 64 C9 98 34 2D AF 1D AC BE F1 7B CA 14 FA 7F 45 C4 EC F7 42 CF 49 6D F8 A9 6D 54 DE AF C5 64' + 'E2 B3 D4 E6 B7 71 5D 61 63 65 5B E9 A9 6C 36 ED EA FC 64 38 71 58 0E 5C F2 2B EB A6 66 66 F1 26' + '17 5F 60 79 E7 9E 79 E7 1D E7 B1 38 E3 8E 38 E8 2C 41 EF 90 48 D7 49 AE 8E 89 8A A3 8B A4 8B 6D' + '73 75 4E A2 35 DC C4 46 23 30 C3 25 94 D4 72 54 AB 53 18 A8 23 5E D5 34 FB FE 4A B7 69 12 2B 92' + '35 D0 17 46 90 69 A6 CA 0A 5A 62 F3 AD DF 1D 18 2F 5F 48 14 D4 D4 F2 75 01 26 C3 C0 1E 10 6C DA' + 'A8 19 03 30 64 0C C1 B8 33 7C ED B4 81 2E F1 FE F0 B2 12 CD E8 7B 45 95 31 34 DA 6A 67 09 D4 D6' + '82 E2 97 F4 10 BD 38 60 BD BD 87 06 B1 10 E1 10 91 22 45 18 EF ED FD FE 00 3A 74 E4 E1 46 C2 AC' + 'D2 FF 15 94 35 55 85 A0 2D 01 2A B5 25 16 51 60 40 11 4D 4A 94 73 CF A5 7C CE E2 C5 52 84 E5 31' + '39 CA 4E 20 90 F3 4F 29 75 5A 91 12 94 A9 B9 3A 03 4A 94 7B 8C D3 1C 0E 0D F9 77 06 DB 5F AC D2' + 'D1 A0 BB 44 B3 44 A0 51 88 EA F9 E1 EF F8 7C 87 D2 B4 B5 2A 84 1D A8 6D AE C4 62 28 F5 6F AA DF' + '89 52 10 0B 9F 0D 13 F2 31 3D DB 88 D7 84 A3 FB 3B 12 04 90 28 FB AC 8B 8B 62 89 5A 51 38 72 A0' + '56 EA A2 86 00 41 2C 37 E9 92 26 1A 5B 4B 56 2E CC 77 B8 D0 23 8B 76 62 A2 F0 CD DB 49 7C 6D 9C' + 'CE 6C 88 A6 AC 7C 51 7B 43 EE 84 BE 71 10 32 06 5B 2E 19 65 10 1F 16 34 6F 48 12 F5 24 26 53 0C' + 'DE C1 E5 0D A7 AC 7C FC 75 0D 06 42 CE E7 B3 D3 6A B5 2D F7 A7 30 8B 0A E5 F7 3E 7B DF D3 8F DB' + 'C3 3E 77 3C 5A 04 34 52 28 BE 83 11 A9 C4 B6 4B FC BA 56 FB 29 67 81 3F 83 06 82 7D 15 01 2E 84' + 'C2 18 4F 42 06 39 F4 F4 49 C3 5B 7C B6 47 00 9C 17 D6 38 20 57 2B 09 0D 9B CB 57 78 09 79 74 24' + '4E BC 12 88 87 0A 13 0C 3A 2F B8 68 41 CC 50 62 E0 F1 59 09 C7 38 50 70 9C CC AF 14 27 13 3D 3D' + '86 3A B3 BC EF 8A DB 80 6B F7 8A 41 51 16 28 2B 19 DF EF 34 30 D5 EF 17 52 15 59 A4 B2 E7 AC B3' + 'BB 1C 3D 6D 4F EE AD 5A E2 CE 30 7F 7A 14 44 4B 26 50 50 40 63 14 11 04 62 20 A1 8C 49 46 46 0C' + '60 C8 C5 45 06 0C 62 22 28 CC 4D 0A 0D 1A 0D 1C 23 02 A4 AF A0 14 54 16 41 62 92 72 AC DD D0 A8' + '30 88 A7 25 71 F5 2B 3B 34 AD 63 10 63 55 A4 55 6B D0 A2 B1 18 0B 05 8C 60 22 CA EA 12 83 3E E3' + 'B0 CC E8 70 64 D4 97 F6 F3 A2 56 07 B9 8F E7 DE 2B 32 23 0C CF 01 C1 0F 41 4B 9A EB BF E9 79 5D' + 'AC 4F 0B 9B B0 50 08 DD 30 48 2A 8A 0A 0A 31 63 BE B4 55 18 B1 6E 23 44 05 06 28 20 A0 C4 46 41' + '41 19 22 C8 ED 7E 4D AE D3 1D DD 6D B6 FF EF 89 B8 DC 75 7F FE 7E D1 6C 2C 6C 68 49 6D 41 48 2C' + 'BC 7F DC 66 92 CB DC F4 7F 9A EB F5 A0 28 16 16 14 98 27 94 49 5A 82 31 10 39 AD 45 4A 90 F2 2D' + 'CF BF 52 56 09 11 91 48 2C 14 80 A4 0D A0 C2 8C 36 3E B5 AF 09 CB 58 55 03 72 2E E4 8A 70 A1 21' + 'A1 D1 62 B8' +} + + +LANGUAGE 0,0 NUMBERS UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE +{ + '42 5A 68 39 31 41 59 26 53 59 42 0C 06 9B 00 0E 15 FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF' + 'FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF E0 12 5B 77 C0 E0 03 EC 0F 7C BE F8 04' + '0F 7C 94 00 07 92 3D F6 AB B3 A7 08 8E A3 6F 9D 0A 7C DE 6E 14 BD F3 B7 87 CC 5D 5C 64 F4 93 54' + 'D3 D3 51 A6 DA 6A 9E 3D 54 D3 D3 D4 8F 46 A6 9E A3 D4 D1 EA 7A 86 C9 3D A2 9B 53 C9 94 FD 26 D4' + 'C4 9B 28 F4 CC 92 3D 23 0F D4 51 A3 CA 79 27 A9 BF 53 46 A9 E1 94 66 12 63 2A 7A 4D A9 FA 69 30' + 'A6 CD 47 EA A7 E5 40 FD 49 A1 A6 6D 1A 14 F7 94 A7 94 F4 9F E9 26 A7 B5 23 C6 A9 FA 65 27 E2 A1' + 'BD 4C D5 3F 54 F5 08 A7 A9 13 4D 26 8F 48 D0 62 9B 7A 44 D3 68 F4 8D 34 46 34 1E A9 EA 7A 69 A6' + '86 8C 48 6C 40 89 9F A5 1A 7A 09 A6 9E D5 1A 7A 69 13 63 12 21 EC 84 64 8F 53 6A 7E A8 C9 A1 B5' + '00 03 D2 03 D2 7A 35 34 63 50 03 4D 1A 7A 34 9A 00 0C 99 A8 C1 94 15 34 C9 32 4D 4F D3 06 4C 86' + '32 A6 94 D2 04 60 04 CF 54 60 F5 0D 00 36 A2 62 6D 4C 00 00 23 01 34 C0 00 8F F5 20 00 02 62 18' + '8C 04 61 30 98 8F D4 00 D4 C2 62 18 01 30 00 00 00 8A 78 84 C2 26 D2 68 6A 4D E5 26 09 B4 53 21' + 'B2 99 31 32 00 D0 00 19 31 1E A0 34 00 34 06 80 00 19 1A 1B 50 00 68 06 80 00 00 68 00 00 00 00' + '00 00 00 00 11 34 C4 94 4D 34 3D 41 B5 34 D8 A7 A4 D9 11 A0 62 00 00 00 1A 00 00 00 00 06 80 00' + '0C 9A 00 00 00 D0 00 00 00 00 00 00 00 00 00 01 A3 40 04 9A 92 45 3C 91 93 20 9E 89 3D 32 18 46' + 'A7 94 7A 07 AA 7A 4C 47 A9 A6 4C C4 4D 34 D0 F5 1A 66 51 A3 43 46 43 D4 F5 19 03 4D A8 34 7A 80' + '19 0F D5 03 D0 9A 69 A0 36 A0 CD 4D 0D 00 19 00 00 00 68 31 31 3D 40 D0 03 46 9C C3 EF 11 F7 9E' + '2E 32 1F 86 E1 CD 09 D3 74 98 D0 5E A2 37 DF B9 24 13 4F 8D 9D 4D 39 4A 5D 55 D8 C6 B8 27 1B 72' + '63 52 47 47 96 96 42 43 82 99 3C 9C A7 C1 A5 95 96 97 50 A2 66 32 62 76 8C F4 D4 94 DB 68 13 CA' + '04 41 44 B4 C4 04 B4 B4 9E 92 08 10 CC 80 E4 17 90 92 F6 BA C2 45 C2 78 E6 90 A5 AD 52 61 12 10' + '52 0C C1 49 7A 10 0A 22 01 51 9B 84 0A 1C 38 30 E1 C1 8F 8F 87 0A 2F 0F 89 5C 43 72 59 A4 00 B3' + '0D 0B 49 73 8C 85 24 26 A9 97 2A 5F A0 B9 02 69 50 0B 6A 6A 06 AD 81 E1 58 70 7E 6A B0 BC 55 6B' + '6D D2 BD BE F9 8D 7C BB 3B D7 E4 E3 DD 7D 37 EE AB E4 5A 13 80 EB 68 27 1B F1 2A 1C 73 03 8F 43' + '5E C3 60 93 62 87 20 CF 96 CF 98 84 F9 A8 4D 7F 75 44 86 87 51 F0 AD 20 6A 9A 42 6A 75 F5 B1 43' + 'C1 6A 2E DD DD 36 09 85 D6 70 BA 6E 0B 5B 78 EF 5A FB AC 1C 8D D4 18 F6 A0 C6 43 81 4C 7C 8D DE' + 'A3 FD DE D6 33 23 23 23 37 91 7B 23 39 83 13 AD BC 7B DC 4D EE C1 85 90 35 88 B2 43 0A 42 28 18' + 'A8 71 37 68 A6 79 F2 BD 7C A4 41 48 72 92 30 0F C1 18 8C 2C 1A EC 61 84 49 65 34 AD 94 D5 A5 45' + '17 E2 80 97 DF 46 0B 6E 1E 73 E8 E8 A0 AC 4D EC 2C B6 AA 69 A6 8A 41 71 5D B5 32 90 8F 38 A7 03' + '54 01 34 35 02 69 59 81 D2 4E B5 AD 6B 08 A2 74 04 2A 1C 10 1E 73 86 14 D0 29 A4 5A 15 A9 4A 42' + '86 A8 AE 8D 33 10 8F 18 46 B1 19 A1 AC 53 4A CC 21 24 EB 5A D6 B1 89 97 42 E1 52 03 01 E8 38 CE' + '91 4D 22 D0 92 B5 29 47 52 E1 88 11 23 C4 30 05 0B 00 9A 25 82 69 59 81 D2 D0 B5 AD 6B 08 9D 75' + 'C4 4B 8E 73 CE 79 5D 3D 0E 63 96 84 21 08 4C 31 3A 7A 9E 21 0C E7 29 AD 96 15 35 09 51 9A C9 27' + '52 94 A5 36 26 DD 69 12 D3 9C F3 9E 56 CF 43 6C 6A D0 84 21 09 86 26 CF 51 08 66 B5 4D 6C B0 A9' + 'A8 4A 8C D6 49 3A 94 A5 29 B1 36 EB 4C 54 B6 08 0F 39 E5 68 50 87 31 D5 25 29 4A 69 86 27 51 7E' + 'B7 88 77 39 6E 74 D0 AD C9 A5 66 73 65 A1 6B 5A D6 E8 9D 75 C4 4B 8E 73 CE 79 5D 3D 0E B1 CB 42' + '10 84 26 18 9D 3D 44 78 CD 6A 9A D9 61 53 50 95 19 AC 92 75 29 4A 53 62 6D D6 91 2D 39 CF 39 E5' + '6C F4 36 C6 AD 08 42 10 98 62 6C F5 10 99 86 5C 92 96 31 0D BF 4B 6B 96 75 A6 AB 10 9B D8 CA 66' + '34 30 B2 32 D1 7A 48 0F 32 EA A5 88 2D 88 61 2E 4F 5C 2D 86 37 E5 39 69 B9 20 AA 98 E5 8C 62 28' + '14 42 45 06 D1 82 22 19 9B 74 44 40 43 33 30 01 7D 52 C5 37 D7 49 A0 30 DE CC 77 6C C5 D7 64 8D' + 'FC 4B 61 B9 BD 83 05 5F B9 AB 92 D2 95 55 AA A5 AA AC 55 55 56 2C 14 55 DC E6 71 30 61 0B D6 2D' + '75 AD 66 93 05 92 D2 D6 AA AA AA A5 2D 54 5E 9C A3 4C A6 99 4D 17 21 9B 2A 98 A5 30 A6 CB 15 63' + '28 8B 1B 58 25 FB 95 80 C5 2C 22 53 4D 12 84 52 21 49 16 41 45 14 89 8D 44 A5 44 41 44 45 01 D5' + 'D5 0C 55 E7 19 AE 49 24 3F 0B 24 B9 35 DD 4F F7 C9 F3 7D 2F 1D 95 FD 66 83 49 77 E3 53 0C 9A A7' + '79 FC F7 A9 EE 74 08 A6 50 E6 3A 08 B3 44 A8 E7 92 10 6D 7F 33 C6 71 0C B0 B5 B6 AC 69 6E E9 DB' + 'CE AA 78 8D 3C C5 93 9B 59 0D FD 0C 4C 3C 9C 7C 5D ED 45 05 B2 AD 98 DE C5 82 34 9C 9E 57 16 6A' + 'B5 1E DE A6 C2 56 D6 5F 68 20 73 F1 DE 75 96 F3 CF AE 47 C9 4A 99 3A 85 35 F2 93 1B AA B5 06 BC' + '93 0A 8B F7 E7 53 28 B3 B4 B5 9A B6 52 96 B9 12 A4 6A 55 4B 1F 92 35 13 11 0C 7E 10 F9 F9 07 FD' + 'EC C4 01 70 BB BA 59 6A 5D 6E 69 88 EB 3B 97 3B 47 B9 B4 5B FB 2B AB EB EB 1B DB D7 3B 2E AD A6' + '7D F0 C4 95 1A 9C 07 6B 19 05 00 80 95 D1 BD 43 A8 E6 92 9E DE 9E 9C B2 3F 08 31 4C 33 67 B6 CB' + '75 BA 6E 97 E7 36 94 50 27 27 93 39 64 D2 CC 2B 4F 7F 46 06 97 62 1A B6 C5 55 63 06 36 E7 18 BB' + '83 5B 2E 82 EA A2 BF 54 17 0D 54 D8 5B 85 74 9B 09 B0 E1 3A 4B 46 1C 26 A8 6D 7E 12 DA 57 88 7B' + '6D 31 23 29 2D B5 F2 4C 81 B2 DB 68 85 8C 86 DC 16 C2 06 B9 0D B6 C7 70 F0 60 24 98 2C 4D 0F DE' + '13 88 C0 46 CC 22 75 38 5F 84 A4 12 BC 71 13 46 52 10 45 F7 A7 43 AB 11 A2 B8 04 06 F5 C0 3C 20' + 'D1 8E E1 C9 00 C8 36 26 87 C4 C2 27 24 A2 26 A1 A2 F8 94 98 30 3E F4 18 30 1A FC 22 53 14 B3 50' + 'EA 8E 23 44 11 08 0C 57 20 74 0E 11 8E 03 84 81 15 68 A1 F0 30 01 F0 16 61 1C 27 91 2E C0 FA 8A' + 'F1 80 24 38 16 74 B6 A0 0A 0E 15 06 34 0D 00 BC 60 8C 17 3C CF 81 80 0E 48 DC E3 4B 5B 1F 61 5E' + '33 19 98 3B CC 92 6A D2 C6 4C 76 31 97 A0 AD 8C BC 66 46 C5 4F 33 EC 33 18 72 46 C6 1A C9 AC 63' + 'E6 2B C6 63 33 07 23 24 9A B4 B1 93 1D 8C 65 E8 2B 63 2F 19 91 B1 53 CC FB 0C C6 1C 91 B1 86 96' + 'B6 3E C2 BD 7E 28 2C 86 02 12 ED F4 CA 85 E3 56 CB A7 AE BB 2A B2 82 98 AC 51 6B 56 B1 0D 05 45' + '08 9A 92 A2 68 2A C9 8C 45 23 72 A2 05 5C C2 F5 82 4C A0 50 85 68 DA A8 6E 9C 8B 77 28 10 37 2F' + 'A6 ED 00 14 8C B4 D5 4A DE E2 39 24 9E 79 E6 5D DB 2B 0E 21 EE AD 09 D5 32 39 A1 92 B2 6B 1C D5' + '5D 56 AA 59 51 EF 71 54 20 4C 65 0C 42 E6 D8 04 88 88 00 C0 E0 08 A2 35 3E 21 8A 27 4A FA F2 21' + '40 2C 96 C3 AA 4B 5C D6 F7 BD E4 F7 BD F2 47 1C 6E 63 5B 3B 9C E7 39 CE 73 9E 30 44 21 10 C4 31' + '44 51 49 1C 71 C7 5A A2 E3 8E 28 A2 73 9C E6 B5 AD 6B 5A D6 B5 AD 6B 5A D6 B5 8C 63 19 50 DA D6' + 'B5 AD 6B 5A 23 5E 55 04 68 9E 71 10 1B 06 13 41 18 0C 04 0D 22 14 A8 45 08 80 01 2B C1 9A BD 78' + '2E BA D6 96 B3 49 58 4C 17 60 6A 96 D6 58 8C 58 17 DA C1 98 CC 60 BC C1 60 0B 18 B6 31 18 62 2C' + '63 18 88 28 88 86 88 88 88 88 88 88 28 88 D9 8C 41 32 69 40 66 26 64 44 46 66 66 44 44 44 44 44' + '44 44 44 44 44 44 44 66 66 64 44 55 66 CD AD 56 B5 CD 34 D9 56 AA 2D 25 28 A5 51 32 4B 22 99 93' + '16 58 5B E5 F2 52 AA A0 A3 18 B1 23 E3 9A 11 8A C4 8A 8F 8C 70 EB DB EE F7 FC 3E 33 48 6C D4 8C' + 'A3 E6 DA 03 E9 F5 FB 45 48 C9 46 FE 24 BF 39 2F D7 ED D3 65 22 C1 60 02 00 F1 6A 58 A8 11 51 44' + '62 84 45 58 28 88 89 16 0C 8C 45 05 18 C5 89 11 11 8A A1 37 AD 8F 5D B5 E2 6D FC F5 7E 07 6B C2' + '77 1D 1F 27 AB E7 31 F1 D0 46 3C 63 2A 0A 02 2A 28 8C 59 11 56 0B 11 11 82 C1 9C 32 50 8B 14 62' + '0A 2A 4A A2 91 8A B0 EC 3A AF B5 F6 FE E7 DD FB DD 3F DF E9 BA 7C D6 69 82 2A 74 B4 15 16 02 2B' + '14 46 2C 11 51 82 C4 44 41 41 9A 46 52 B1 46 31 62 4A CD DA C8 C5 58 1A 7A A6 08 87 B7 A0 A8 B0' + '44 58 A2 20 B0 45 46 0A A2 22 82 83 33 8D 2A 0A 31 8B 12 55 5F 6C 8C 56 21 DE FD 27 78 F1 9F 67' + '71 C1 6E 38 3D C7 0F B8 E1 7D 0E 77 6F 95 B7 D6 ED F2 B8 7D BE 83 40 C1 1D CD 05 0A 08 AA 88 C5' + '04 54 60 B1 64 50 4D 1B 4A 8A A3 18 B1 A6 1A 2B 52 31 54 9D C7 67 A9 ED 3F 6E EF B5 ED BB 7F DD' + 'F1 F7 9E 23 1B 19 82 3C B5 05 73 2D 24 45 11 18 A0 8A 8C 16 29 14 13 56 D2 B1 46 31 65 51 33 B6' + 'A4 62 A9 1D 97 CF E1 36 1E EB E8 65 7B BE BF 5B D8 75 7D 67 D1 EC 7F EF C0 FA 9F AB FF 75 DD 5F' + '65 D6 6E FE C7 65 DD 6E F7 CD 1B 04 74 B4 14 2C 11 44 46 28 22 A3 05 8A 45 0E 0E A5 2B 14 63 16' + '55 13 7F B5 23 04 44 40 26 AB 9F 4D D7 CD EB E6 AB DD 6C 8E B0 C0 D9 E0 58 D9 ED 30 1B AE 5C C1' + '7A F5 FA 1A AB 85 F4 EB EF 58 30 60 C1 83 06 18 8F 29 3C DD A7 69 DF 57 FB EB 75 F2 7F CB 6F F7' + '2F 4A 95 CD 9B 9B BE CF 6B B7 DC CA CB FF 9E B8 7A F6 7E 7A 75 5C E2 A7 DA 75 2E 5C 6D EC 95 2A' + '54 AD 5A B7 DC DF 8B D9 EC B6 7C 7F 84 82 8F 3E 94 0A AA 0A 31 51 48 8B 16 28 2C 14 36 15 B6 6D' + '10 51 15 18 C2 AA 53 1F 0F 54 86 CB 49 E2 76 5A 26 92 AD 23 5A 24 69 1C D2 3D A4 CB 44 A9 5A 77' + '58 B5 7D 6C CE F3 97 CB 45 CB F6 FA F9 BF 4E 13 D0 E2 E4 E7 76 76 E9 23 80 04 04 04 42 B1 29 E0' + '0E E2 54 A5 96 59 65 96 59 65 C5 96 8C B8 92 E1 CB 2B D5 C6 E3 73 39 98 6A D5 AB 8C 79 CC DD 3B' + 'B8 B5 74 F2 DE D9 DB AD D3 B7 76 F2 AE AD DD 3B 59 3E A3 76 21 36 45 68 92 02 40 08 91 E3 E9 8F' + '00 11 37 13 37 CE 30 AC F9 86 15 9C 30 C2 A2 0C 30 C3 0C C8 C8 C8 C8 C8 C8 D4 32 30 65 65 65 67' + '33 99 5C 6E 64 84 D0 1E E9 5F 21 33 58 FF 6E 3E 1C 38 30 00 00 00 00 00 00 06 4E 4E 4E 4C 97 8F' + 'F6 B1 94 DC FA 12 32 07 23 63 D7 78 AB 97 2E 2B 70 57 E7 92 54 F9 F8 B2 D1 81 7D C1 84 4A AC 5C' + '02 2B F0 C6 C7 AA C5 43 84 88 94 51 08 9E 17 0D E5 60 E0 E0 E0 E0 AF A2 5D 51 4D 45 2E BA 86 82' + '7D 6A C5 2A 69 E9 E7 56 AD 5A B5 6D 4D 4E CA 5C 26 04 07 18 92 3D 1C 2B 3C 2C 2C 29 E9 07 FB EC' + '3C 3C 3F C5 93 26 58 BB D9 B9 B9 B8 56 47 71 7A A2 42 9A 85 97 84 96 F0 0E EC 29 36 5B 22 DB 10' + '04 14 CE 5D 83 A8 77 69 3F 04 9F D5 87 4D EF 5D F6 25 E7 43 27 EC 5F 79 11 14 C2 F1 1B 1B C8 C6' + '0F CD 62 FC DD 43 F3 75 4F CD 64 FF 5C D1 FB F7 35 0E 75 BA D7 2E 5C DE 36 6C D9 B4 45 A9 C0 82' + '91 00 53 A0 0E C4 30 B8 35 14 AF D5 14 CA F8 F4 EA FD FE 3A BD 0A 95 1A 3C 85 9A 35 56 4D 6A EC' + 'BF 84 49 5B 56 A6 4D B9 91 4C 9B A2 E8 BA 2E 4F 92 E4 75 5A A5 67 B3 69 11 92 22 82 2A 2B 14 9D' + '03 4A A4 20 AD 81 81 44 89 75 02 D5 8B 33 24 06 F8 40 08 CD 00 88 08 05 A9 24 81 03 F8 6A 75 14' + '8C 58 2F A3 52 F5 F5 D5 CD CD CB D7 AF 5E BD BB B4 C1 87 0D E8 90 11 02 22 22 20 24 5D 09 F3 C4' + '6F 98 5B 5C 30 AD 5F 59 46 DA 89 B2 E6 D4 2D A8 1B 4F CF 36 C1 E3 D5 57 98 73 71 3B 4E D4 6B 9B' + '71 CD 9B CD EA E3 DE ED 83 DE 0E 58 E5 8E 58 E5 8E 58 E5 8E 5F F8 10 CA 6D 85 DE 0C 6D 47 FA B3' + '74 A5 AC 64 D9 9E C5 A5 5D 36 C2 9F 5F 50 D6 A6 A4 DB FE EE FE FE FF 85 C2 39 BB 76 ED DB A4 AC' + 'D4 24 3D B6 3E 7B 9D B6 91 C8 C7 C8 C6 E5 7B FC A9 33 A4 D3 C9 26 91 90 4A 5C 73 87 0E 1C 31 62' + 'A1 42 88 93 59 45 86 8D C9 F3 D7 6D 6E B1 35 F7 5B 07 B5 7C DD 8F 39 B6 45 67 4A B7 A5 5D D3 AF' + 'B0 76 2F 0C 4F 06 B9 F8 BE 92 B6 EA DC 2B ED 2B 68 AF F9 56 DA E5 CA CB 35 8B 1D 1E 34 0E 14 18' + '42 5C 07 49 55 DC 1B 4C 67 43 3A 1B 50 67 A3 7F A3 3E D7 93 DB 19 27 0F 85 09 7C 05 E2 2F 11 78' + '8B C4 5E 22 F1 37 82 1E 13 76 24 BC 29 98 11 EB CC 8E 64 73 23 99 1C C8 E6 4D 99 EF 60 69 FD 1E' + '7C 57 84 BD 7A F1 C7 1D 06 D7 58 0D 8F DF AE 36 D4 DB 83 6E 0D B8 36 E0 DB 83 6D CD B7 36 52 79' + 'C8 4B 00 0B 25 7C 5F C3 06 DF C4 A3 14 51 6E 1A E8 E8 7C B7 B7 97 6D 5A B5 F7 BA 0B 56 AD 5A 7B' + '60 24 70 02 5B 3F 49 46 2B 01 58 0A C0 56 02 B0 17 88 C3 76 66 57 6D 5B 0E 7E CC 43 8B 48 4E 61' + '93 2D 0B 2E 33 1E 34 C6 1C 29 4D 0A 2B 40 51 85 46 95 55 0C 57 1F E6 E3 F3 D2 B2 A4 D5 E2 25 4D' + '53 51 4C D1 95 2E AB 52 69 A6 9A 6F 1D AF 23 17 E7 54 A5 4C 8C E4 D1 8A 49 3C 21 C9 14 FB 83 E2' + '80 95 50 04 E7 09 C5 AA F0 10 0A 12 60 D0 13 9D 27 9B C1 57 35 0B C8 56 64 F7 22 75 4E 4E 2A C5' + '59 3E F4 F2 BE C7 27 46 AF B3 D0 48 9B B5 D1 5D 27 DB C8 A3 57 7F D1 5D 4D 7B E5 D2 31 E0 64 32' + '33 2B E4 A8 D6 5B 5F EF E7 94 DF D0 4E 3E C8 94 3B F2 2E 92 40 AD 71 FE 05 CA EA 2F 4D 62 E9 DA' + '2B A5 DD 5C C6 84 60 70 63 67 58 F6 0A 69 F9 74 B8 D4 94 7E CA 5C 4C D5 C5 34 69 97 97 95 95 D6' + 'E4 54 FB 68 9E E4 B4 CD CD 67 9D 9D 73 57 8A 91 1E FA A9 EF 63 33 B2 9D A6 71 29 D4 4C 59 3C B1' + '78 9A FF 22 69 3B D2 3B 9A 0C 58 B1 9C C2 D3 B7 7B 9F 89 89 3C C5 EB 56 DF A6 3E 3E 3E 3D 0D DD' + 'C7 31 52 D9 FE 56 05 FA A5 B8 0A 6F 56 B6 C1 A0 91 9E 0C 29 90 17 D6 F3 56 59 11 1B 51 29 0D 4B' + '4B 91 57 B9 7A BE DB 84 BE 5A 0A DA B4 CC B7 80 A3 11 61 EB 0B C5 77 4F C5 82 00 0B 86 1F 14 05' + '83 93 BD A7 BD BC A7 BC BB A7 BB E7 2A E7 5D 27 BA 58 99 65 CA 5B 9E 6D BF 35 3E 02 84 FC F5 1C' + 'D7 5B A7 D2 9A 5E EF 6D 85 D2 E4 05 88 AD 9E 2D 0B 1B 3B D6 2D A9 B6 DE D7 02 D9 EA 59 6E 56 F5' + '8C 35 CE DE B8 16 CF 4C CB 65 5E B1 86 EA 05 D9 B2 B8 6E 62 C6 14 97 3D 22 57 B9 78 6D A6 66 F1' + '2E 66 E6 8C F7 2B 75 A2 F5 09 4E 7B C3 6B AC 5C C5 CF 74 7C 55 D7 0A 7C 16 6F 5E 72 C6 E9 6C F6' + 'E1 BD 75 65 A3 77 51 8D AE CA CF 42 91 0C 21 28 9F 81 E1 6F 63 90 5C 8C A0 DA 41 92 8E 01 89 4B' + 'D1 D1 45 50 C5 CF E8 A7 A3 27 61 E4 76 67 36 94 47 28 92 A0 AE CA D5 43 F0 54 5A 23 AC AC 42 85' + '3A 4B 45 14 7C 4F 6A 93 8C 51 45 14 51 45 15 AA E1 E3 EF FB 7D B8 8D 02 08 F2 00 D9 B5 2D 63 2C' + '3A 78 A7 35 09 00 61 33 27 06 69 3C 8E D9 11 88 2C B8 FC BB 03 61 18 D3 99 62 C4 C6 22 38 57 AD' + '09 8A 50 94 72 8B 06 0C 46 9E 35 6B 8B 58 4F 1A B5 C2 8E 30 61 32 00 88 40 76 E7 AD 00 08 1B 41' + '27 89 72 4B 31 66 6D B2 16 46 6D 38 EA E4 B2 2A FD F2 91 5B 57 28 EC 1B 8C D3 42 31 57 C1 30 A8' + '90 21 11 10 7A 41 08 04 09 89 4B 12 81 49 04 89 89 36 65 04 A9 21 E5 EC 35 E2 A4 96 ED C3 4A 81' + '51 13 F6 87 C8 2A A9 09 B5 D2 8A 94 A3 2C F5 54 C8 AA BB BC CD CA A6 AC 6D CA 22 BD 66 39 1B 25' + '69 9B 94 4C F5 DB B1 20 01 55 A0 0A F2 94 E9 20 11 9C B0 C2 10 73 53 E1 18 04 CB 06 08 41 CB DA' + '61 1A 84 12 B7 19 04 1C DD A6 11 84 23 52 D5 D8 74 10 41 C7 AF 08 C1 63 4A 08 42 0C F4 F8 26 0A' + '1B E4 10 84 CB 79 64 BC EA 34 74 93 DC 66 F9 7B 17 DC 9A D1 E8 5D 35 E4 B9 0E A3 39 CB D8 B9 D1' + '4F 5F A7 B2 4E 99 1B 31 82 84 4E 40 D0 A2 3E 85 1B 44 30 C6 1A 18 4F 7C B8 C0 44 2C AF 4F 4A 47' + 'A6 DC ED 68 85 37 87 A3 13 F3 72 66 70 EC 61 43 CF CA FD F6 6D 0D F3 73 AE C5 45 91 BE E9 27 DC' + '33 CD 4E B3 6D 8F B7 0C 50 AA DD 2F 40 23 A5 22 1B 72 2D 3C 43 12 21 48 38 F2 05 30 60 28 CB 87' + '12 08 75 80 2C 41 16 F6 88 72 91 20 7E 5A 08 10 83 F3 44 EE 8C 86 24 0D 21 01 08 1A E0 1C 1B C2' + '58 D0 90 80 84 1E 2D FF 30 30 74 08 25 B1 A0 21 17 AF 84 A2 17 2B 95 A8 20 47 4B 7A C3 BF B7 9B' + '37 EA A1 A1 6C D1 7E AE 6C DD 59 30 C6 5D 15 EA 2F 55 E6 CF 49 77 B4 E4 28 DF BF 7E C5 FB F8 B2' + '02 2C 73 49 0F 12 28 C9 02 46 4E 4B 46 71 C7 1C 71 C7 1C 71 C7 1C 74 52 3C F1 01 28 31 B2 BC 38' + '61 4C 48 20 14 88 4F 90 09 C4 A9 6E 18 49 21 21 00 B3 3C 40 27 18 49 1F 1A 4E 04 84 02 6A 1B 67' + '96 EF 1D 71 1D BB 77 5A ED DD 0E 8A 9F 1D 1D A1 D0 46 46 56 26 0A 07 03 09 3F 90 A6 BA 53 05 C9' + '28 29 C3 08 52 08 A4 12 87 A3 D4 5F C4 AA 71 6D 29 82 D5 2B 4A 8D 1C 80 C0 62 C6 0C B8 B2 C6 F4' + 'CA 81 02 1B DE 51 6B 8B 1B B1 C2 00 D1 3C 36 55 99 1D 32 C6 38 97 03 18 5B DD B6 61 D9 2C 8B 6A' + '2C 18 6A DF D7 95 C9 2E EE A3 DC D4 93 76 47 5B BD B7 52 2D 88 2C B5 AE 1D D9 6B C6 DD BE AB 50' + '36 D8 25 5B 2F 65 91 CB 54 E1 07 0E 5E CC 55 A4 6A A1 60 E5 EC EA B5 6A 39 6B 68 D1 67 55 96 4C' + '42 D7 0B 0E CD B5 5A 97 69 90 5B 36 61 EE 92 EA 13 45 CD 68 EA 28 28 3B 8A EC CA 27 1C 21 70 B2' + '08 75 73 03 B7 28 34 7C 0A C0 77 02 41 81 6E 0B 76 6F A6 11 2E C1 6D D0 81 EC 4B A0 29 CA 78 0C' + '1E C5 08 2E 21 08 1C C5 42 81 9C 42 DB 18 5D 61 A1 40 93 78 61 D3 1D E0 19 62 F1 94 59 52 6F E3' + 'A0 D2 37 F8 65 E2 51 7F 68 B3 C5 5F 4E C4 5F 60 D8 62 2F 70 65 98 2C 38 D5 7B 82 70 29 A9 BD C4' + '90 4E DC 0B D4 73 DF 7D A8 5A C4 9B D1 D0 50 14 43 65 3A 05 D2 14 AD 3A 0A 42 96 EC 5A 48 DB 05' + 'B6 76 2D C8 39 CE 38 08 2C DC 0C DE 5F 99 5C 6C 4E 2D BE 29 E4 44 34 F8 5D 88 6A 07 12 28 F8 15' + '47 21 60 99 01 BC 08 14 7D D5 63 3D 88 F4 92 69 1C D2 8C C1 3A 3C 30 E7 47 97 1E 30 21 3C AD 70' + '04 66 CD 9B 32 1B 36 6C D9 B2 0F 8B 7E 82 D3 96 73 C6 04 1E DA 0B 04 C1 AE A4 55 3D D5 8B EE 6B' + 'AF FC C9 67 FA 6B 73 E9 76 7F 57 1C FE 7F F1 E1 81 59 D7 E3 C5 8B 76 C5 8B 16 2C 58 B1 0E 3A B3' + '58 F9 9C 38 01 CD 63 30 D9 5B F2 5A FB B5 AD E8 BB E6 92 4D F6 0F C3 06 EE 65 81 6F BC 05 BE 1F' + '9E 41 9B F2 63 DB 28 DB 79 56 F6 3F A7 3D 45 D8 73 D4 79 F9 FA 73 F9 FA 4C 41 90 34 73 85 40 F4' + '38 B3 A8 39 D2 A4 73 85 48 F3 E5 48 E7 0A 91 D0 3D E8 A4 73 B2 9A 47 99 AF DA D6 C0 C4 87 03 33' + '6E 66 22 BA 0A 65 49 88 29 96 30 70 40 34 10 56 AF C1 C1 A1 30 10 51 00 0A 10 15 2E 5C B9 72 E7' + 'D6 E0 50 D0 CA 9A B9 72 E3 4D 37 5D 57 0E D4 40 26 04 13 2E B1 C6 7C DD F1 CF 56 3D DA E3 3E 2D' + 'F3 E7 CF 6E 7B FE FB 77 70 F1 D6 96 DC 40 0A 10 58 AB F5 A0 8A 8B 00 34 42 72 87 45 04 04 41 45' + 'C0 01 0A FA 76 13 72 4D B1 F6 6A 74 95 BB 7E A4 E4 BD 7B 8C B5 93 56 16 79 53 EB 39 F6 99 4B A7' + 'FE DD CE 52 FA 2C 7D D6 5D 23 1F 96 DA 97 55 B9 C7 E8 BA A6 A6 B5 7E A0 08 D6 B2 50 04 6B 19 1F' + '02 35 74 A7 EA 99 50 3B 9E 66 B1 9A C6 79 C7 F7 CB B3 79 8C ED F5 F6 06 07 03 0F 0F 0F 0F 0E B9' + 'AC 4C 21 08 C7 4D 33 2D 28 9A 3E 92 8E 81 64 7C 1B 52 40 11 47 B5 10 08 04 6D 6A 82 FF 01 E9 D0' + 'BF C0 61 F1 AF 39 81 BA 59 B7 03 89 CC A1 53 32 E2 7E 9E D3 79 BC ED 77 9D B7 31 B4 D6 62 E2 F3' + '68 5A 67 DC E7 43 97 97 97 97 97 97 97 97 97 DE 71 78 84 2A 68 DD F3 6B BE DD CE A1 47 7C DF AB' + '3F B6 B7 3E DE 65 8D EF 40 1F 79 AD 77 92 FE EF 28 6A 81 9D D5 3B 42 EE B1 DA 27 AD 5E EA 69 EA' + '37 EB 5B 37 6E DD BB 7E 96 36 36 36 7E 26 27 6B 41 F2 E2 49 24 7E 8F 47 A0 41 04 12 4B 26 58 CE' + 'DD 3A 77 AB AB AA F9 F6 EA 4E 3C 1E A0 0B 17 0B AF 30 09 73 07 90 9E 20 F1 10 04 40 11 36 44 D1' + '1D F7 EF 02 36 65 8F 6F A7 D3 C3 C1 A6 EB 9F EA 32 CD CC C6 2B 08 92 49 69 91 D9 24 87 8F 3F 67' + '8F 1A 34 69 18 CD 9B 3C FC FE 5E 7C 34 5D 30 3C C0 16 2E 16 93 85 7A 0C 5B 6E 9D 3B 2D 99 77 59' + '4E BB 39 6E 79 CF 32 D9 0E EB 5A F1 79 36 E7 92 B2 BB 3B 5B DF D0 F1 95 9F CD E3 F1 EE 56 A7 4D' + '36 93 3B 25 81 1E FD 49 18 80 E3 C8 05 C5 77 2E FB 90 23 10 1A 08 05 E5 79 36 F4 24 21 86 11 CF' + '56 67 13 3F 9D DA D5 93 5E 99 2F 43 F1 B3 BD FB 6D 53 4C 9A 27 B1 CF F7 FF 2F 53 25 32 1E C7 3F' + 'C6 F9 8A 99 29 38 F7 59 AB 18 8C D9 41 68 21 50 78 AB 3D 1F A9 E6 F8 79 8D 15 1A 47 04 50 5B 08' + '57 1D 17 07 66 99 B4 47 C2 57 B5 71 70 CB 9C 43 7E 96 44 28 40 5C 69 A3 50 CB C0 7B B0 86 33 66' + 'CE 99 9B 2D 25 9C 14 1C 2E 64 13 7F E2 EE 48 A7 0A 12 08 41 80 D3 60' +} + + +LANGUAGE 0,0 COMPOSITION UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE +{ + '42 5A 68 39 31 41 59 26 53 59 09 E8 CD 9F 00 58 FE 7F FF FF FF FF FF FF FF FF FF FF FF FF FF FF' + 'FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF E0 4A F4 BD 00 00 00 00 00 00 08 7C 21' + '5F 68 A5 33 32 D0 AA D0 A9 3E C0 6F 61 95 51 4A 08 A4 2A 88 40 00 0A 00 00 01 48 41 F1 F3 20 00' + '1D 15 17 41 AF BD 7A 7D 12 BD 98 00 09 7C E3 D3 A1 E0 00 1E E3 48 7D 1E F4 A8 02 5C 9A 43 BD 4E' + '1D F0 01 4A 75 A2 EF BE B0 3C 3D 3C F8 28 73 92 0F 41 F6 82 92 8A 28 4A 7C B6 8D 04 40 24 1A 22' + 'D5 00 0A 02 AA FB C0 00 50 E0 FB 2B 9B 00 00 00 C8 A5 32 9E 14 1E A0 34 F5 3D A4 D4 FD 29 ED 0D' + '27 A3 4D 19 03 53 32 98 D3 21 EA 1A 34 66 91 80 9A 66 80 D0 31 30 02 69 89 9A 46 86 10 CD 1A 64' + '27 A6 41 A3 21 A0 C8 4D 36 26 4D 31 34 30 06 26 91 80 35 30 00 CA AA 15 4F 34 40 23 01 31 0C 9A' + '00 00 01 0C 9A 60 44 D1 91 A4 62 64 43 46 D1 09 E5 1A 6D 13 31 46 99 03 4F 50 7A 9E A6 9E A6 20' + '36 49 A6 68 C4 D2 63 24 DA 1A 69 90 68 86 83 47 A2 00 D3 4C 4C 83 7A 88 F2 69 1E 9E 92 06 A6 10' + '13 20 8C 91 A0 89 B5 1E A9 E1 19 04 66 A6 D0 6A 3D 21 ED 44 F4 86 8D A4 03 46 4C 43 10 68 D0 D0' + '06 80 00 00 D0 1A 0D 0D 32 64 19 01 E9 34 68 68 D1 90 0D 34 C9 A1 A3 43 10 03 4F 48 03 40 94 C4' + '8D 24 50 26 42 68 69 4C D4 DE A8 F6 A8 F5 1B D5 3D 47 A9 A0 D1 ED 49 B5 19 07 A9 E2 9E A0 32 00' + '00 00 68 0D 3D 40 7A 80 00 03 46 40 00 00 00 00 0D 1A 00 00 1E A0 68 19 03 D4 00 0F D5 04 9A 52' + '52 29 86 93 4C 4D A4 D3 4C 09 A6 9E A7 A9 A1 B5 00 D3 4C 4D 0D 06 4D A8 C9 88 1A 00 CD 43 41 E8' + '26 99 06 D4 6C 88 C8 01 9A 46 46 8D 1B 48 D3 D4 34 7A 4D 34 0D A4 D0 D3 6A 0D 1A 1A 3D 4C 8D 36' + 'A6 98 41 A3 11 90 64 02 4D 44 40 A1 0F 51 30 93 46 09 30 29 9B 54 F0 53 C6 4D 53 C8 DA 8D 4F 48' + 'F4 81 E9 3D A5 3D 43 C5 0D 0D A6 8D 47 A2 36 90 D3 CA 7B 44 43 F5 4C 9E A7 A8 7A 9E A0 D9 43 D4' + '34 0D 0D A8 C9 8D 4F 44 3F 4A 0D 1E 0A 68 D0 68 0C D2 1A 69 A3 D4 DA 83 4C 35 0E 4F A8 E7 F6 9A' + 'F7 F8 7A 8E 7F 59 D1 F4 DD 97 A9 F5 BD B6 C0 B2 DD DA 0F 54 BF AD DC F5 72 7D BF 5C 6E AB D4 75' + '9D 9F A3 47 D2 45 EB BD 67 61 DA 45 8B 35 87 DD EC 67 B5 FA ED 6E BF D5 D7 FB 1E BF AD EB F9 88' + '75 39 93 9E D7 F5 89 B1 5C 7C EE 1D FE 3E 36 C7 DE F7 A5 E9 BB 1C 5A 4E 97 C3 96 81 0A 2C C4 69' + '33 52 E7 26 4E A3 3D 4E 8E 92 A5 6B 16 AF 60 C5 90 2C C4 69 A7 A8 D5 B3 77 0E 5D 3B 78 F4 57 CF' + 'E0 41 85 0E 2C 68 F2 24 8F 2B 2B 2B 2B BE DF 79 7E 5F 97 E5 98 C6 31 8C 63 18 A0 63 1B B1 D7 D8' + 'F6 3D F7 C3 F4 1C D4 D1 EB FD 07 37 AD EB 7A 3D 1E BD A6 7C 08 F1 FC 4F 4B E9 7E E7 4B FD BC BE' + 'AC 5F 1F B1 87 D0 BA F6 CF F1 F6 AD 3F 9D 21 C6 88 11 12 48 AA A0 BE CD 5A 8A D2 D5 10 C6 26 9A' + '86 19 69 80 0C 72 24 4C 8A F2 DF 8B D9 22 8A 69 F8 7E 33 9E 6F 9B F7 A5 0B D6 1B EE 3E 5F E1 A8' + '97 BC 73 F7 9F 90 0D 34 00 00 D3 46 35 CB 92 A5 76 CD 26 9A 69 BE FF 6D 0C 28 89 D5 CB 67 BE 55' + 'B3 E2 0A 40 BC 84 7D 4F 81 D9 FB AE DE 2A A3 18 C6 31 AB 26 4C 95 A4 C8 90 C4 89 0A 28 D0 8C 73' + '2A 3D EF 67 7B BF CE 4D 38 C9 76 92 3C 4B B9 A9 FC 9C F9 D2 49 DE DD 5B D7 BD 8B 59 BE 37 6F AC' + '2C EB BF AE DF 8B 6A CD 78 61 FD 1A 15 EC 54 F5 F5 2B 08 2B 4D 9F F0 3C 13 5A B4 49 E0 16 D8 A4' + '52 B3 48 01 4A 6E A6 EB D2 64 C5 52 4B AB AE BA EA 2E BC 0E 95 C7 76 70 E0 BD 27 E0 F8 5E 1F C2' + 'DE 45 16 A3 BA 8C 60 72 3C 78 F1 DB 49 C7 14 75 C1 3B 7D 50 17 27 0E C3 C6 45 15 55 7C A5 51 6A' + 'A4 A6 8F EA D5 5E 0F 08 F7 5D 59 66 C4 28 B4 E2 F7 55 BC 36 9A 82 0B 97 21 6E 1C 6D 28 D6 3C 58' + '9C 72 4B EE 5C 83 BA 7B F5 F1 E3 71 CC 78 36 A6 73 08 41 4E 88 AC EC B3 3D A1 4A 68 D6 6C FC 22' + '8A 39 D0 B8 F6 9A 74 D5 A7 4E 92 34 27 CF 9F 3D 71 2D B9 39 D5 CC 28 A7 78 B2 40 24 E2 E2 17 7A' + 'B2 CE 38 E3 89 B8 E3 8E 38 C8 8E 5C 91 60 80 BB 26 13 C1 45 47 C3 66 E4 41 55 0A 70 A2 1F 0F 29' + 'E2 10 33 0C 21 E2 33 79 FE A7 78 57 84 DA 05 3C 9C DC F6 C3 49 EF 07 B2 D0 4D 6F 3C 02 D3 1E 38' + '6E 18 98 58 9C 16 F5 20 15 D8 60 3E 2B 35 55 AA 00 00 00 00 00 00 00 00 00 00 A1 DC 86 9A 09 66' + '26 68 E8 81 46 FB 44 E5 A4 4B 4C B2 06 86 B7 21 74 4E 83 41 34 30 C0 18 53 B0 C9 2E 36 A1 0A 59' + '49 82 39 38 C6 01 8F 13 D3 26 5C BB 2F 61 14 52 5F 3C 99 0C 94 B3 F3 AE BE 57 31 C7 D9 D2 DB 77' + 'F4 B8 E6 ED 6B 12 E5 EF 55 A1 B3 62 CF 51 42 85 1D 8B 34 03 6A 32 EB E1 60 E9 16 AD 05 4A D5 C6' + '81 60 9D 58 29 56 AD 5A B6 B3 8B 52 B8 6E BA C2 66 62 28 06 ED 95 AC 39 61 AB 16 2C 58 71 C8 EC' + 'B3 2B 2C 81 BA 9C F9 E1 46 89 CF 3D 6A 03 50 A0 84 E9 E9 E0 3E 53 05 97 4B 69 0B AE D0 66 8D 04' + '5A D3 42 85 AA 11 F2 64 A5 36 8B F6 EE 6C DE 7B 5E 7E 3E 8D 1C 7D 3B A7 8F 75 04 10 41 04 0E DA' + 'AB 8E F6 CD BB B5 F6 6E DF B7 B3 B7 8A FF 0F 3F 26 3C 98 F7 33 70 E8 CA 94 66 03 83 09 33 2A C3' + '78 8C C3 51 F6 F6 2A 54 9D 52 A5 4A 95 2A 55 CF 9B 33 13 A7 E0 C7 9A BE 6B 05 9D 92 4E C5 7D 8B' + '10 2C 5A 88 B1 B7 41 9D 22 89 23 02 06 9B 36 6C C9 93 26 4C 3C F3 E6 A0 82 0A 22 8A 27 EE 58 61' + 'B7 2A AC EC A6 B0 0C 6A 51 85 2B B5 66 6E 48 90 31 0D E2 48 18 0E 39 08 32 6A 4D AA 16 E7 DA A9' + '3C CC 5F AF 46 C5 2C CC 5D 18 86 28 82 60 8D 34 40 21 07 37 4E 3B 13 6E B5 4A CD D8 6D DD D8 BD' + '8E 8B F1 B4 C1 B5 85 BD 0E 8A 48 C7 22 E0 0C 42 98 27 DF 28 C6 3A 94 A2 E3 A9 7A F4 A8 C9 0A 34' + '61 10 71 22 C5 01 0C 57 2B 5C D3 61 6A 77 5F A3 E3 EA 5E 30 97 1A A3 58 64 13 98 AD C6 42 DD C7' + 'E7 F9 15 4E 52 24 61 C6 8C 41 BA AC 59 B3 E8 D1 4E F0 D2 88 A0 D4 50 83 CA 9C DA 12 D1 D6 34 22' + '24 34 92 20 EE 24 FC 30 BE 4D 69 A3 11 31 A6 99 07 E2 F0 7C 7B 71 A0 99 31 FF 97 BE AC 58 91 63' + '11 50 27 9B 56 AC E5 61 9D 0F 1F 89 13 A1 99 0E 47 4D 2E 64 32 8E CE C9 F2 51 7D BF 21 78 62 1E' + 'D4 78 F9 7E 56 6A 07 C2 F5 36 4F E5 71 70 6C 5D 4A 44 A8 D7 6E 5D 39 E9 52 B2 1E D3 BB 79 F3 64' + 'C2 A1 F2 A0 45 BE 31 96 D1 05 4A 33 14 84 A6 C7 A3 CC 4D 04 D4 4A 54 15 DF DF 51 24 68 9A E8 AF' + '67 20 B0 0C 61 84 37 C6 22 93 80 05 3D 2A 30 CA 8D 14 52 9F 97 B9 C7 3A 8D 18 12 72 6C D8 78 91' + '9B 69 45 E1 C9 83 89 03 56 7A 9D 17 99 CD 96 51 F9 7E 5A 92 DF 18 C6 B8 C4 22 11 96 B0 16 D6 48' + 'A8 A3 80 CE C9 82 08 EA 23 03 8B C8 3A 74 93 EF 9E 27 1E A0 7F 20 F5 15 4D 44 85 2D C7 52 95 83' + '02 9C 84 45 81 D8 C8 21 4D 03 C5 1E 8B AB AA 81 F7 D9 12 68 D1 E0 50 4C 71 35 86 54 AE 5D 95 51' + '17 2E BA 7C 93 2C B9 FC 1C BB 10 41 CB E2 4A 1C 77 E6 4C CE 75 85 81 48 C6 A5 26 4E EF 28 D7 78' + 'D2 53 DC 25 74 39 68 21 2A 1A F0 D3 2D 49 71 E1 43 36 23 3D BB C4 AA 68 29 1A 33 8D E1 86 1D AE' + '54 A8 AE 3B 0C 75 61 87 8C 86 AD 8B B3 4B C3 94 83 B1 BA F4 C9 9C 6E 19 9C 68 60 83 C9 13 3B F4' + '9E 7B E6 9D 8E EC 71 52 93 24 FC 12 F1 3C F1 B1 4D A9 89 D7 7E 5D 2E 2C 0F 3D D6 33 1E F2 91 2A' + '8A 50 5A AA 48 91 65 5B 7E 8A 75 24 C9 BF 64 F2 E4 EF 10 6C CC 33 95 FA C1 07 59 B0 24 86 84 63' + 'F4 D7 C3 0C 3C E4 8F 7A 4D 7C 21 C3 70 F1 88 EB A0 AD 8A 61 22 01 AB 03 D2 74 5F 64 A8 BB 63 65' + 'E7 B8 5B 11 F3 D2 18 C6 F2 A4 10 80 34 73 09 27 D1 72 91 D7 41 2D 9C F0 F5 39 E6 46 F4 49 B7 68' + '82 D0 FB 69 79 2E 9D 82 C3 05 91 3E 79 84 E7 2E 18 4B 65 15 33 0A 2A 86 50 00 02 51 49 28 CB A0' + '2E 73 D3 01 93 DC F4 3C 9C 92 F1 20 A2 11 67 4E B2 A4 B4 37 95 A1 29 93 14 4B 75 4D 9A 54 F3 F8' + 'D9 8D D4 BB 1C E6 F8 B6 DE 96 2A 54 70 3C B2 53 09 B7 57 C9 BD 1E 55 64 55 DB 7F 34 D6 67 CB 96' + '8F 2D 0C A3 47 72 EF 3A 64 C4 77 30 A1 C8 D7 0C 27 D9 8D B9 02 25 E7 5B 7D 05 7A 98 6F A3 BC 75' + '57 DF A7 84 63 64 47 0E 26 0D E6 D3 42 17 DF C6 6E 6C A9 4E 50 92 77 02 FB AF BE B9 72 1F AC 4F' + '11 D1 D0 6E DD F2 B3 C7 C8 1B 93 D8 62 8F 11 C9 73 17 9F 40 CB AF 54 06 B6 F4 BE B7 60 E7 E4 34' + 'D5 F3 51 61 8B A5 9F B9 B0 D5 E3 60 D4 DB 77 F8 70 E8 6D BC 33 8E 8D A2 9C 7B 5E 8C ED 56 5C 70' + '85 2C 0D B7 70 C6 B5 99 B6 C0 CC 5D 65 99 26 52 AA CC 15 0D B6 18 64 CB 6F 30 4D 49 3C DE A8 AC' + 'A3 77 6F 85 96 77 2F 6E F0 B8 E5 FA B0 6C AA EA F7 DE E0 8F 1C EB C4 AB 1E 38 5D 97 B0 DB 67 5C' + '8D B6 C1 AE F2 D4 94 CB 31 C7 70 E9 3A 1B 6C F9 C9 F1 DB 6E C4 6A D2 A8 C7 4C A5 64 E0 0A 6B 2C' + '58 D4 55 55 9A A7 57 58 88 4E A2 B1 4B AD 55 4B 49 55 40 38 C4 26 CE C0 06 94 80 37 73 85 6D 44' + '4B 52 75 8B 17 5C 50 0D 77 00 14 4C 21 4C 8A EA 4C 28 EA 52 F1 68 A8 4B B7 74 6B 8B 60 EB E7 64' + '5A B5 93 AE CF D2 C9 6E CE A9 A7 51 AF 9B 4B 76 76 CB 41 99 EB 61 B7 91 1C CD 5B B9 02 93 50 B9' + '29 8D B9 46 40 C5 02 34 42 81 67 4C 3D FD 48 94 0C 08 1B 04 8D BD BB CA 2A C5 C8 22 97 61 E6 71' + '32 67 19 C5 1C B6 5A 6D 6D 4E 9D 9B 3D 10 62 9E C6 D6 7A 6A ED 7C DB DB 55 66 E0 C9 8D 25 29 6D' + '41 A0 CA 17 21 18 C7 67 63 69 60 16 35 36 ED AD 92 76 86 24 3E 5D 0C BB 0D 7D 0C EC ED 9A 0C 8C' + '98 B9 33 B0 6C D6 A0 CA C5 E9 EC CD D9 6B 6D D6 A9 B7 B7 B2 8D 18 F1 F6 6B D3 CA DE DB B7 2B 37' + '93 A1 86 76 E4 72 E1 47 71 9D B3 47 A8 C7 A4 D9 D8 DC 67 73 6F 0E E3 35 30 D0 46 A3 54 F1 5C B2' + 'D5 4C 97 EA E7 52 AC 9C 7B 2D D4 AD 76 C3 72 20 67 3E 35 A8 6D 69 57 47 CE 75 DB 79 97 A3 FF 1B' + '62 45 E6 68 FD BD 8D C5 26 0A A6 9A 7B 8A 68 72 97 DB DD 49 39 6F A3 1D 88 B4 E8 A0 82 08 20 82' + '0A 22 88 00 02 28 A2 8A 28 A2 8D 69 29 F4 B3 A3 92 33 AB EB 75 8C 79 CD AD E8 F9 CB 65 97 41 ED' + '4B B0 5D 4B C9 64 BB AB 4A 0D 6A BF E1 97 75 52 6B 80 8F 29 2B 51 74 45 7D E5 9A 3B 3A B2 9B 2C' + '8C D2 A5 A5 B8 CB F7 64 0D 9A 3B 6B A2 F6 48 C8 E3 90 38 C9 59 BB 23 69 65 1D D9 5D 48 1C 5D 29' + 'B9 9C 8C C2 86 92 BA E9 F6 2E 5D 61 4F 3E 86 FE 3A CD EE F5 A2 ED 47 12 20 81 81 7A 3D 09 98 F1' + '14 32 01 10 44 55 24 2D AA 83 10 B6 14 64 55 91 62 30 51 51 22 20 8D 4A 2B 10 FF D0 86 69 49 0C' + '58 42 A9 20 92 46 10 19 24 61 03 6E 92 4E 12 0B 14 45 49 16 0A 44 62 C5 8A 22 2C 58 A4 56 00 1F' + '34 7C 46 6F 45 21 F2 FF F3 83 0A BC 0B 41 6C CC 0F 9E 62 81 7A 50 7E 99 35 61 AB FB 14 FB 94 15' + '77 69 36 AA 2F 34 6C CC 2A 44 51 55 93 54 29 92 98 F8 D5 A4 80 EF 44 A4 45 87 4A 49 3B 8F AD 00' + '24 A2 13 5F 5B 14 54 88 8A A8 8A 8C C5 95 58 A2 A3 33 50 2D 11 55 05 65 4B 14 14 91 70 F7 B2 97' + '0E 18 DB 59 1A A5 26 64 A5 53 16 DB 55 95 A2 32 D5 28 8A A9 F5 AD 8A B8 45 84 AA 8B 25 B5 56 6C' + 'CC 2E E1 4B 8A B2 A2 8A AD 4A 35 B2 B1 4E F2 CB 11 6C 60 B8 6B 25 0A D5 28 B0 46 00 AA 49 83 3E' + '9D DD 0C 6E 37 0D 13 D4 FE 2D A5 A8 B4 58 05 D9 1B 99 35 74 15 64 33 32 58 D9 B0 F1 1E 7B FE A2' + '90 83 55 6C 2F 41 BD 5A 0B A4 E9 B7 B1 A6 CB 7C 6F 86 73 E4 C2 1B 7C 39 9B C1 B3 39 F7 E2 64 1C' + '56 4A A5 CD 52 BB 6F 65 AD 13 2E CC D3 49 0C 19 8E 42 09 AB 62 6D 41 B4 84 93 72 35 1B 2E 9D 26' + 'EA 09 89 16 8D A2 2A 8A B5 1E 93 45 B6 84 3A B0 85 BB 52 10 7B D4 A8 1A 6D 05 DD D4 BA 6D E8 69' + 'B3 4B 50 A6 09 84 2F 33 11 BA C1 54 A2 AA 8A C1 2E A9 52 81 91 C8 41 35 63 1A 50 6D 6A C8 41 2B' + '77 06 A3 66 F7 52 94 75 62 62 45 EC 66 D1 68 1A 20 B7 6F 6A 2A 89 08 D1 A1 15 D5 F9 1D 46 17 A7' + '3E 6D C6 58 A0 A2 9A 34 CC 34 22 37 75 6C A2 E3 88 A7 04 9C 43 9B 96 82 26 84 A9 D2 68 F0 C6 78' + '18 ED 09 56 8E 1B AD 78 C8 F5 B4 0C EB 89 89 B3 9E 16 2F 15 32 10 60 D6 1E 12 88 20 82 21 C9 42' + '1C 91 10 14 90 33 A9 2C 46 22 52 59 1A CA 40 A1 23 02 B2 0B 23 B7 88 18 66 08 14 62 C4 60 B1 83' + '15 18 A8 C9 25 24 82 C8 DC EF 24 9D EC 82 49 3A 0C 6E 78 FF 3E 06 58 41 42 11 4C F3 73 76 1D 83' + 'C8 59 69 D5 95 52 6B B1 0F 2F A2 D7 6E FE 16 36 CB 92 0D B1 B6 49 20 DB 1B 63 6C FB B5 9E 53 3C' + '4D 0D D7 F3 51 2D 1E CE 7F 2B CD 57 10 A9 94 C5 B1 93 25 F9 D5 E3 47 90 7A 8C BD 2A DA 19 39 61' + '92 83 98 0D E3 2A 20 20 08 8C 3A AC 44 98 70 C4 4A 0C 28 81 62 40 C3 11 25 48 83 0B 24 C0 0A 0A' + '48 88 23 11 01 91 90 50 0C B2 52 0C 69 93 B8 BA 90 42 76 E8 06 04 08 8A 43 B4 12 1D A8 74 17 50' + 'B8 04 EC C6 04 C5 82 23 04 95 2E 5D C5 56 15 DB 07 61 8A 02 C0 87 57 65 64 52 5C 09 D8 05 83 04' + '8B 04 44 42 2B 09 9D D9 DB 8C D1 6D 2D A2 8A 28 A2 8A 28 B2 4C 23 D9 39 1A C0 78 2A 79 43 89 D2' + '4E B7 62 BB 08 63 B1 42 27 6C 10 30 52 1B 4A 29 46 21 69 56 5A 4A A0 2C 36 60 3B D6 C6 00 73 D4' + '93 94 87 53 96 0D 4D BA BD 2A E9 33 09 D2 1A 18 71 CD 09 47 4F 06 97 AA 70 6B 18 84 34 1E 24 03' + '10 36 52 49 D2 10 D8 6F 28 AE 64 FA 6D 0A 37 77 4B DE 84 4A 49 04 14 49 07 53 5B 36 C1 5D 6D AB' + '64 C1 B5 23 42 89 11 E1 01 12 95 65 0A 55 15 4A 22 08 82 51 55 11 92 A8 AE A7 1D CE 4C F1 BD 6E' + '80 63 7A 46 81 91 11 01 86 68 A3 A3 D4 D6 83 0C 69 48 D0 C0 D9 A4 CB 96 5E 5A 13 15 1D C4 1E 2E' + '9D A7 8F 11 79 4D 88 A2 BC 28 0D A8 A9 1E D5 9B 3C 60 A4 DE B7 4B DE 55 4D 92 B2 E5 0B CC AA 89' + 'A5 15 97 2C BC C6 C4 15 D8 43 3B 6E 6F E5 5D 6B 29 BE 86 31 6D 6F F1 4E AF 6F E0 B1 D7 B6 F9 07' + 'FC B4 B6 CA AE CC F5 67 75 DD 05 F4 FF 10 CB 96 7A 2C F2 F9 6C 9F 30 B6 AA 63 FB 5B 2E 5C 20 B2' + '02 C8 0B 24 47 9D 2B 47 0C BC D5 F9 2B 2C C1 20 A1 05 80 2C 82 84 CD 65 97 8A ED 69 65 F8 19 36' + '89 60 6F E9 EB 6E 3E 87 A7 15 C3 82 7D 64 34 2B 3E 36 D4 08 2C 16 82 3B 4A 04 C4 69 F6 2F 40 81' + '43 C8 3D 1E 4C 46 9F 32 1A F0 EC E0 23 9C D2 A9 B7 E1 65 CB A1 69 45 52 DF D7 98 C8 62 1E D6 FE' + '1B AB DB E9 8E 08 0A 42 DA DA A9 6F CC C7 29 69 69 54 B7 E6 64 09 A5 A4 4B 7C 64 88 E9 FC C2 DA' + 'AB D3 F4 99 22 17 DA 34 C2 5B EE C7 28 18 2A 7A 5A 55 17 7F 1E C8 17 4B EC 6B 6A A5 BF C6 6E 12' + 'DA 1F 95 6D 44 AD FB DD C2 5A AA 28 49 24 2A AF 10 48 3C BC 55 6B E2 E6 10 15 8C F4 7E 0B C5 57' + 'A7 E0 C8 40 5D B4 47 D9 E2 AB 5F 6A CC 25 A0 7F 50 84 58 F1 54 5F 03 30 96 AA 8A EA 0D 0D 09 09' + '55 43 DB 5E 2A 96 FD B6 42 EA E8 A7 92 B5 C6 A8 5B EA B5 D4 B3 BC 03 E4 A0 52 AA AA AA AA AA AA' + '8C 62 18 E0 18 C6 A8 C8 37 86 41 F5 C3 20 DD 1C 89 75 67 48 EA D9 01 4F 9B 3B E9 74 16 55 79 DB' + 'E1 15 13 D9 1A 2C 51 54 7B 33 D9 23 C9 3D A2 A9 6F B2 62 81 F3 6F 48 25 CD 32 EC F4 D1 F2 05 65' + 'E2 AB DB FF 33 1D 51 06 14 35 45 14 98 B7 B7 B1 16 69 FC 46 38 20 AE 40 0A 25 4C C7 8A AF 4F A6' + '3A 00 82 19 55 47 AC E1 95 93 15 5E DF 8D 8C A8 34 33 7D 9E D5 5E BD BA 21 41 04 57 7A 43 59 8F' + '15 63 4A FC 1A 2A 4F 40 90 30 C0 2E 49 E1 6F 66 1D BB CA DD C2 EB 5C D4 6F 64 58 06 2C 9E 7B 7F' + 'CE 60 D0 9C 71 B7 0C CE F5 D7 A3 5B 04 48 2C 30 EF 88 FC ED D9 A7 E0 E9 F4 AB 4B EE 3D 0E 8C 15' + '07 89 68 8F EA BC 7C 41 AC 7E 56 3A 30 40 88 73 CF 39 21 5A 18 9E 5B 8E 33 C3 3B 6E 2B C9 D1 50' + 'D8 64 DF 98 AA 2F 8E 37 E3 46 8D 9C 7E A3 1D 1C 55 57 D3 64 EB AE B5 D2 AD F1 F4 C7 47 10 21 09' + '77 18 81 3D 08 30 51 4E 60 BD 4E 6F 39 D3 E7 CF 3B 34 7C D7 39 40 73 B0 C3 69 8B 9C E4 E2 34 6D' + 'FB 96 5C AE E6 AB 9C E6 B6 8D 2F 77 C2 E5 F9 50 F9 8F 4A AF 6F E9 EC B9 DB 5E 7D 39 04 9F 39 7B' + '55 A5 84 66 D5 5F 48 33 2F 6A AD 61 1E 5A FA E7 A4 3B 2E BD 2E 4C 5E A6 98 97 56 C3 11 66 64 D2' + '2D 6E 33 BA BA EF B4 BC B3 0D 68 D6 C6 01 88 2A A2 C1 12 82 93 56 8E BF 7D B6 31 06 93 E2 7C 12' + '41 60 52 41 43 6C DE E6 95 5E DC 69 EE 92 B4 E9 B0 BE 5D 97 99 78 AB 49 E2 7B 12 12 15 5D 95 44' + '64 0A 16 9A 79 7D 73 32 D6 AD 6A 60 11 10 15 4A 44 A0 84 50 98 90 0A 23 A5 99 ED 33 0D A7 8F 15' + '5A 50 A9 5D 4B E5 F1 E5 D6 93 C7 BA A5 6E 51 42 2A 44 2D 6F D3 CD 1A C7 1B 30 A4 95 17 1A 8B C8' + '4B 11 7D F9 96 69 3C 73 75 49 55 34 82 94 2A AA 9C 10 BE 06 F7 65 E9 A6 F6 A8 94 55 34 01 5F 26' + 'EC F6 D9 99 56 B1 BD 82 49 46 8F 43 CF BD 1E EB 27 1F 2B 5C 69 BD 0D 0D 09 A3 C3 CB B3 E4 B3 8B' + '2A D7 1B DD 2A 1B 74 C7 B5 BD E6 67 4A 53 32 28 F8 1E 57 C9 FF 8B 5C EA B5 C6 FC 39 98 CD 29 C1' + '60 B1 44 55 23 05 56 A9 B5 6B 4C 69 A6 67 67 5A EF 6A B6 D4 A0 28 6D 5A 1D B5 DA E9 98 F1 FA 4B' + '96 34 02 F9 4B 2F 5D B6 F3 5B E4 D3 6E F1 9F 45 8D A1 94 A5 3C 9A 65 8B B7 3B 76 77 5A D8 31 F2' + '92 B6 EA 0E E8 8C 9E E2 66 61 AA DE 4A D2 0A 32 80 93 C1 AC 3B 69 B6 D5 80 CE A1 46 D2 D5 10 64' + '60 85 23 2E 1B 56 1F 0F 3B 77 3B 64 D3 69 46 83 0B 64 6B B3 DC 63 03 EA 35 DF 7A C5 6B AA 67 45' + '20 88 47 5E CE 43 D5 7E EF 7D BB 76 35 59 D8 19 B1 54 49 66 B3 2C 35 95 C9 CA 05 7E 24 3E AF 9C' + 'FA 46 AB 7D 03 36 09 24 88 D3 CE DC E7 35 5B E5 31 A4 2C E6 66 6A B7 80 C6 74 9F 3A E4 CF 8C EB' + '7C A6 3A 16 76 C9 88 F8 2A B7 81 D4 80 B9 32 67 1D 6F 2B 72 02 3E 67 59 33 E1 3A DF 01 FE 2E 05' + '1D 7D F8 DC DF 33 4D A5 7E D7 98 C0 31 05 54 58 25 D0 92 56 90 94 A9 C5 F6 97 66 59 A3 01 F3 63' + '48 B4 84 BB 73 5C 39 BA DF 01 EB 8D 56 1A 0A 51 3C CE A6 BF 3B 89 9D A5 6D B1 42 28 98 45 A7 6A' + 'D8 DB 13 3A 83 CD 96 08 42 01 24 88 87 ED F2 C8 AD 73 7A 3C FB 36 72 9E 96 2A BA 46 4C 32 F4 85' + '94 F3 75 4E AD 02 A4 65 E1 97 5A C0 D6 15 68 B0 66 4C 32 EB 58 0F 37 4D 09 5A AA 69 51 4F 74 A9' + 'F8 3D 7D E8 E6 AB 7B 05 67 62 89 81 5D B6 D8 DB 13 3B 53 1D B6 0A 7C 8E 79 B1 4F 1C 70 71 88 65' + 'E2 3C 3C 18 4A 44 29 83 1D B6 D8 DB 13 3B 53 36 E3 7C 2A C8 53 94 1E 12 9E 38 E0 E3 30 CF 01 C7' + '12 61 15 C6 80 94 6D FB 0C 77 7B E6 69 B8 6F B9 60 B1 44 C5 52 91 82 AB 50 A8 9B F2 E3 27 06 FA' + 'EA 3B 87 5B 2E EC A4 31 75 CD F0 E7 A3 98 97 01 6E 0F DE 89 8B AF AA 6B A3 41 AC A2 FB D8 82 D0' + 'D2 74 9E 63 30 B0 D6 51 8F 40 92 47 91 69 88 14 68 53 9C DF 0D 06 F9 57 30 A4 84 5B BA 35 0B 12' + '3E 47 76 4B 42 D5 17 BA 89 21 02 AA 54 20 B4 26 ED C1 23 76 6C 81 7A 0D E8 BA B3 CE 34 C8 5A 3E' + '26 F0 81 AD D1 7B AA BB 2F C0 E1 6B E5 B7 84 0D 65 17 B2 EA ED 53 12 F8 96 6C 81 7A 0D E8 A2 EB' + '9A 62 5F DD D6 12 8B CA 2F 2A C4 A9 21 20 BA 43 5B BD 90 35 BA 2D 9E 3B C5 8C C3 DD DD 6F 94 71' + 'C4 8D A3 2F 0F A8 D8 6F 28 D3 95 88 FE F5 E1 ED 6F 69 60 69 92 B7 B3 D0 85 9B A3 72 08 DE FD AD' + '96 B6 1B F1 17 69 2C CF 94 81 78 1E 6E 5D A4 B3 32 05 E5 1B C8 5F 81 73 9C D1 62 E5 1C 64 C5 EF' + '73 E5 E0 6B 28 C9 04 96 F7 C8 17 BA 36 EA 25 BD FC BC B4 2D D1 B7 53 A5 99 C8 1A CA 31 D4 C5 FD' + 'FC EA 06 B2 8C 75 12 DE F9 02 F7 46 DD 41 2D EF DD 4D 2A F4 32 89 F1 DC D2 47 2F 9E 75 86 B0 35' + '27 1E 67 A7 03 59 46 3A 86 F7 EB 4D 2F 47 C2 EB 39 46 99 0F 8B CF 04 0B DD 1B 75 0D EF D7 81 7B' + 'A3 6E A7 F9 3C F6 13 54 69 D4 F3 2D FA 4C 2F 6D 56 F6 1F 03 49 24 36 D2 48 62 34 D6 7B 76 17 81' + '9B 21 6C 5E FF C7 E3 81 AC A3 19 0D EF 90 2F 74 6F DD 43 A3 5C D7 3D E5 D1 BE 51 AC 20 90 91 67' + 'F9 7C 7E B4 0B CA 31 90 F7 DD 93 09 AA 35 D1 E4 B4 92 1B 69 24 31 1A 37 9E 28 17 CA 38 C8 6F 7F' + '2D 0B 4B 74 6F 94 41 20 5E F1 33 47 35 55 54 53 20 1E 63 8B 0C ED 0C F9 AC 61 F3 AE D9 A4 84 E7' + 'DE C3 4D A1 9E 0B 31 E9 5F 4D A7 3D 5B 0D DD 1C 91 1B 9B FA 1B D2 A5 B0 D7 52 F2 73 EB B7 A4 2C' + '0C 64 FA 19 F0 3D C5 86 B6 1A E8 82 42 15 FC A7 35 E1 F5 34 1B E0 6A 44 85 EF FE 8D 90 D0 7A 8F' + 'BF A4 99 AC E1 E3 81 7C A3 99 05 7E 5C AF 73 03 59 46 64 2F 33 C7 2A F2 8C C8 5F D2 B2 AB C7 0F' + 'AD EB 81 CE 55 4A 54 8D 73 1D 5D EE 8D C8 5E E6 E5 5E E8 DF AF 0B CE BD FC 2F 28 C7 D2 2D AF F6' + '7A 16 1B A3 7B 3E 3E D2 48 6D A4 90 F1 24 C4 F3 AE 4A D7 C8 F5 47 57 7E 04 3F A2 F8 4E A1 B0 DB' + '5D D8 AF 6F B0 65 D6 8C A3 1E D5 5E 67 AF 2A CC A3 1E 2A BC 98 7A B6 68 CA 31 ED 1F 1C B5 F4 7C' + 'FA 4C AB 39 47 1D 71 55 E6 16 80 F1 DD 68 CA 31 C5 B4 3C CF 8F 96 91 94 66 44 95 79 5A 49 0D B4' + '92 1A 54 8D 72 72 05 99 46 43 D3 DE 85 33 18 59 81 90 CC D0 A6 3C 20 59 81 8F 42 15 EF 6E 8B 36' + '1B 7B A4 24 2F 64 DE BD B3 61 0D 86 EC 85 EB 18 43 61 B8 6D 5B 4B B3 49 21 B6 92 43 48 B4 CB CC' + 'B5 50 2C C0 DB 9A F3 42 66 3A 95 81 93 02 C4 A9 20 55 48 7F ED D9 68 25 24 51 56 6C 37 35 6C DE' + 'DD 43 61 B9 16 B7 B2 1E E9 1A 30 32 6E C7 FE EC 75 0D D6 E6 EC 7B DD C0 B3 75 B8 7C 1F 58 D1 39' + 'C6 10 CA CE 10 48 42 0F F7 BD D6 CB 48 DD 35 F6 08 4D EB DD DD 88 DD 2C 12 55 BD C4 6E F6 7A 6F' + '29 0B 83 2F 99 90 BA DD 74 EA 6F 60 6E 55 9B AD B8 85 FF 0D F6 46 59 A3 2B 1C D8 3A 4A 92 A4 27' + 'F1 B3 25 59 95 98 5C 1D 5A 11 32 6E EC 46 AB 6E 43 55 DA CB CE 72 05 99 5C 83 32 C9 99 41 C5 45' + '72 EB 46 09 AD 25 E6 69 24 36 D2 48 69 0A 66 64 AB 30 4D 78 BA F7 C4 2F 9C E4 AB 38 77 71 79 3B' + '76 97 D7 55 D4 AB 3A 3A 84 9D 75 2B 9A 07 A3 6C A9 7C 74 68 D6 8A 9E FB 4C 22 D1 A8 77 15 5E F7' + 'E0 49 40 B5 86 4A 74 8D 5E F6 3A B5 A1 94 EE C6 11 58 9D 6A 0C 6B 5A 82 35 56 B4 6E 03 53 7A 1D' + '45 75 A8 44 6D EF 63 AB F9 3C AC 85 AC B3 C3 52 F9 AE 24 4A B5 BA C8 44 62 AD 12 9F 37 5B 96 BC' + '1E 02 8B D4 54 A7 49 A6 F8 14 C5 19 95 2D CC 68 C0 A2 56 06 53 88 C3 BA 25 8A 9A BA DC A2 6C D5' + '30 F3 96 EB 7B 0F 5F 9E D2 6F 82 A6 B2 B2 56 F6 CD 6C 49 0F C1 94 CD A2 F4 36 25 74 CB 44 B6 34' + 'AE BB 44 AA F1 27 99 A2 DC C6 85 8E 06 53 71 A1 41 B6 53 71 A1 63 6C 29 B9 46 59 78 65 38 8D 42' + 'CA 90 0A 6E 38 2C 2B 09 43 89 9B 3A A9 8C 8C A7 31 AD 12 B0 CA 71 2A 61 2F 00 32 9C 4A 93 6C 49' + '80 B7 13 BA B8 62 04 C4 A7 12 A9 85 95 29 B9 8B 35 66 64 33 29 D5 7B E9 E9 DB 34 E9 F3 75 B9 D2' + '16 CD 90 5A A6 17 77 51 58 31 AA BB 95 15 82 69 09 5D CA 8A C1 D3 5E 6B 0A A9 50 56 0D A0 83 A6' + 'A0 36 AA 3A 79 60 EA EE 9A 80 C8 4A 6A 06 DC AB 1B 42 56 08 7D 2B 27 48 8B 40 EA C9 4D 40 6D 46' + 'D7 91 58 46 7B C7 A0 02 53 56 0D AE 5C A8 AC 4E 0E 9A 83 73 E9 8E A2 B3 E5 5E FF 9D DF 5F 0B E2' + 'FB 3F 40 10 C4 6B A8 69 B7 43 D3 B7 F4 79 B4 9C E9 8D 6A 69 9A 23 D4 33 B6 25 04 F0 F7 FC 15 DB' + '0E EA 76 98 FF 54 EF 07 BD 3A 53 97 DE 9E 9C EE 70 68 7E 54 E6 F9 5D 69 5A E9 69 8E AF D5 B9 CF' + 'FB A8 B7 9B CF C2 67 4F 51 AD 2B 63 DC 52 52 A8 4E 7E B4 A6 7B 31 EB 89 F8 11 13 39 7E 6B 1E F6' + 'F6 DA EA 8E 8D 53 F4 64 E7 AA 28 FA E6 49 CE 59 99 EC 99 28 51 5E 21 5A D2 B6 B6 B7 C8 B3 0C A6' + 'BA B9 4D 78 91 25 EB 16 3E 36 0C 13 60 31 CB 63 94 AA 4E 7E 8A E9 3F B7 AD EB 3F EF DB EA FA DE' + 'D3 5D AE EB FA FE A3 57 AD D6 FD 7E A3 5B D2 FD DE AB A0 D8 B3 B0 51 DD 09 02 C1 8C 2D 96 0C 60' + '91 82 46 09 18 24 61 68 58 20 C1 09 B4 6E AA B4 D2 69 39 43 69 46 A9 A5 0A 70 83 4D 0E 54 91 B6' + '36 D2 52 84 38 DB 4D B2 51 1A 89 83 6A 15 20 90 88 DB 25 63 18 6C 69 89 6E 16 5A 89 4A B5 2A E0' + '89 71 6A 96 B4 6A AD 14 41 2A 23 6B 28 5A A8 CA 2C B5 B4 6D B6 D4 A8 B6 B1 A5 2B 4A 30 6C 59 4A' + '8D 2B 55 B1 A8 D2 89 5A 56 B6 96 D2 AD 6D B6 DA 2B 6B 4A 25 1B 69 46 21 54 AA B4 46 A0 DA 32 96' + 'C5 B5 AD 95 A5 95 54 B5 B4 5B 5B 6B 5A 96 56 B6 25 06 2C AB 45 AA B6 B6 8D A8 D1 1A 96 B6 A5 2B' + '45 18 C6 8B 6B 4B 62 54 A3 5B 6D 1B 83 18 56 62 53 06 2E 29 54 A3 56 DA 51 B1 62 D9 42 C5 12 8A' + '51 AB 54 6D 54 AD 2A D6 8C 69 6C A3 45 2D 63 50 6A 31 1B 44 B6 35 89 54 AB 6D 32 05 55 15 54 15' + '45 46 31 51 41 18 AA 22 08 AA 8A B1 11 54 46 64 5A 2A C5 11 88 C5 62 0A A8 82 A8 22 88 2C 15 40' + '58 28 A0 B0 51 4A 25 41 45 91 45 82 91 41 41 41 62 A9 14 14 8B 16 28 A4 E2 48 6E 66 E6 40 45 01' + '54 44 8A 28 B1 08 6C 58 45 80 10 58 44 60 2C 20 B2 45 00 16 0B 16 45 91 48 02 90 16 00 B2 41 61' + '14 15 19 20 45 8A 12 0A 41 48 2C 80 A4 05 90 51 41 64 91 42 02 90 84 16 10 05 92 11 49 08 2C 84' + '88 2A C3 EE 0F 60 7F 62 7D 3F DA 47 68 68 93 69 55 20 CD A0 81 00 B8 16 44 84 B0 92 49 88 24 82' + 'C9 16 10 8B 24 22 81 21 22 48 03 24 09 0F EA EB 77 19 B8 90 0B BA 96 C3 1F 6B EC AE 01 94 05 90' + '81 CC 90 92 1A 30 94 90 9F 01 84 C7 ED 28 08 4C 32 00 13 74 20 29 24 59 24 8F 39 D1 61 00 B9 45' + '41 C5 86 4C 30 C1 60 40 CD 2C 40 61 92 67 FB AD EF B4 CF 76 9B CE DD BB F5 DF BB F9 77 6D 7D 9F' + '43 1C F9 FB FC 2D 6F A9 7B AE 3F EA 1F C6 3D AE 3F F7 FB DE B5 59 2F 66 86 94 91 2A 1D 91 2F 77' + 'DD A9 AA F7 89 6F 77 5B AF B7 76 DB EE 3A 77 0F B3 F5 FB 9F 0C 07 70 90 0D B0 48 49 C8 B0 0D 4A' + '40 C0 81 3A 54 E3 92 2C 9A 84 81 3A 94 09 38 94 E6 D2 48 4E C1 84 92 71 EC 03 5E 39 0D 4E 21 A4' + '75 FF 6B 7D A6 B2 81 DE 35 1A BD 26 5F 8D 27 B6 7F CA 73 BC 85 E4 39 CB A5 D3 50 39 C7 91 7A B4' + 'E7 3A BB A8 49 A8 ED EC 9A D7 67 40 43 5B 7B 97 AA E2 2C 84 9D 9F C0 DC F0 1A D4 24 90 9A F4 18' + '29 16 2C 8A 44 54 02 2A 80 A0 02 91 11 41 60 A0 A0 B0 50 50 50 59 21 3D 32 FD 1F A8 F0 F0 66 23' + '0C 53 E7 29 98 C8 68 72 DE F8 0F 40 5A AA 8A AA AA FA BE 17 4B 8C 9C C2 D1 D8 6E C5 B9 7E 9E BB' + '68 F7 7F A8 22 11 78 C3 23 3F 1A 7C 96 EC 9D 6B C5 BD CF 9F 92 8E D1 E3 8D 15 10 BF 3B A2 EA 6D' + 'CB 96 71 CA D2 93 D2 D9 22 49 79 1B 49 24 92 4B CB E5 F0 DD FA 3D 12 1C 1B F3 9B C6 FD 26 F8 CF' + '1E 61 22 55 90 65 C8 ED 02 E4 12 19 C6 14 16 7C B3 86 7C 62 EB 9A 65 3E B7 E1 FB FE 8F A4 FA BF' + '1B 9B F3 FE 83 D1 69 E9 F3 41 87 B5 DA C1 DA 9E AB A9 24 13 A9 12 72 4A 13 61 6B 91 3D 37 E8 80' + '42 25 E7 A4 04 5D DD 77 9B E6 FB E0 7F 50 08 80 06 C4 00 3D BF 3A B3 1F E9 DD 81 68 DA 82 1C 27' + '09 1D A1 6D 08 70 65 B3 F5 80 E5 5B E9 45 52 F2 7F E6 FE 10 59 65 A2 DB 29 6A CF B9 97 12 2C 0D' + '1C D1 3A CE 5D CE 94 88 8A 64 62 7B 70 59 03 A5 18 A6 70 CE 03 38 11 02 47 78 04 B9 38 84 40 F3' + '9E 3E 4C 41 97 A4 2F 38 C5 30 CD E7 15 06 3B 53 79 C6 31 4B FB E8 48 67 EE 80 07 B9 1A 13 09 EF' + 'C6 1C EE 74 12 F9 D4 28 6E 77 3B 9D CF 1D AD 7B DE F7 BE 73 9C E7 29 4A 52 94 E6 F7 BD EF 7C E7' + '39 91 46 31 8C 63 27 39 CE 73 A6 E7 39 CE 74 E0 F7 BD EF 7E 8D DC 76 2D 0C 98 B1 62 C5 65 96 59' + '65 98 B1 62 D7 46 31 8C 63 4A 52 94 94 A5 29 4A 94 A4 21 08 42 11 AA A8 42 10 84 25 27 BD EF 7B' + 'DA D6 B5 AD 9C E1 28 F4 D2 94 A7 3B EC AE BD 7F 3C 19 64 A5 A8 E9 10 00 0B 77 24 3E 12 AD 94 AA' + '18 D0 5D 34 E2 B0 52 96 1A 87 16 2B D5 0A 52 94 AA 54 E9 80 00 1A 20 84 CD 6A 73 C0 03 A5 20 03' + 'F3 21 2D B1 08 C6 E9 14 94 48 4E 92 B6 41 72 94 A5 FB 4F A4 AB 66 C1 D9 99 AD 6F F0 D3 94 57 64' + 'AA AB F9 29 A1 BC AE BF 62 D6 93 5B 92 8B 25 DD AA D8 AA 63 BA EF E6 77 EE EE CB A5 BB 44 A2 0D' + 'CE 6C 84 59 66 A6 5E 29 4B E0 26 B7 7E 60 05 7D E3 15 82 EA 60 C7 58 0B AF B1 B0 BC 63 19 6B E6' + '17 77 69 66 0B B8 78 9A 67 F7 AD 82 13 C8 64 3B AE CD BC AE ED 6A AA AA F7 ED 9B 76 CB 21 55 55' + '7B ED 36 9B 54 35 BA E9 7F 89 84 86 D9 34 CA DC F3 00 68 3A 49 42 A8 60 1A D5 0A 14 2A A8 50 A1' + '55 42 85 1C 1B 5A D0 D0 D0 AA A1 42 83 65 7A 6A 36 6D C4 48 55 BF 2E D3 32 CD E3 85 C0 EF DB 04' + 'F8 BA 13 50 A5 3C D3 27 96 0A 60 EE E1 C9 1F 88 85 29 4A 5F 15 01 48 01 44 10 88 2C 19 8F 75 EA' + 'E5 BA 52 D6 44 54 6A 12 21 06 BB 24 92 31 0A 24 10 40 A8 B0 00 22 51 7E 1C 04 B0 42 2B E7 84 7A' + '24 22 19 CF 27 EE D2 00 BE 55 F6 BB F4 6F CF D0 5C 40 9E 85 69 51 7B CB 8D 10 51 0D BC 32 D8 D5' + '14 A5 B0 53 CC 63 69 21 34 98 42 13 80 52 B8 40 97 A6 63 86 33 CD CE BC 54 22 9A 39 8D F8 15 6C' + '34 81 08 84 67 D0 36 92 94 A5 73 EF DA C2 5D 94 85 10 42 29 4B EF 4F F5 53 4A 1A F2 01 8C 69 49' + '7F D3 F4 60 2C 46 4C 63 48 55 44 97 C4 94 48 82 38 E3 6E 83 DB 38 B3 17 80 A5 9E 5A DA 52 D6 04' + 'C7 87 27 0E F1 C0 F1 23 EF 45 BB 14 87 AD BC 43 34 3C B1 96 B4 42 6E C8 D0 C2 9B A5 D2 DA C0 8E' + '92 00 C2 35 E0 8F 22 EB 20 1A CC 56 11 78 B5 4A 50 66 72 F2 CA B0 E5 90 8B 46 B8 37 8A 01 20 09' + '17 78 04 21 00 6B BC 04 24 5D 55 8F E1 18 84 41 EA BE 8E A2 88 42 5C 32 48 8D 7F 49 E2 89 B0 5D' + '28 69 98 C6 94 13 E0 21 08 F2 1B A6 10 89 C7 6E 64 62 69 18 03 29 9F C0 48 DA 93 12 83 88 2D 27' + '8B 80 62 D4 9D F1 C6 D5 3A BA 42 10 8E 3A 7B 09 0B 8F AC 01 7A 1A D3 E3 A9 6A 9E E8 14 65 A8 53' + '8A 91 82 DA ED 1C 23 8E 95 A0 C6 84 4E 49 D0 58 91 04 54 68 DD 53 55 3B C0 F8 68 40 49 53 DB D0' + '02 11 77 C2 C3 BB FA 8F 89 10 45 6A C9 48 0D 38 1A 4F 88 21 19 49 1B 16 6D 6C 92 DE 94 13 DF D2' + '12 2F 69 DB 5B 06 92 08 53 87 6D 13 B0 EE 47 EF 35 53 D4 94 73 84 69 5A B2 9A AD AB 54 78 18 33' + 'D8 AE D1 55 62 DE 00 88 21 0F 8F 20 31 45 D0 7D D4 0D 3C B2 5A DA C5 51 41 0A 21 42 B3 CD 27 B3' + '89 ED 26 32 FD E2 92 58 96 62 EF 0C DE E9 F7 0C F3 47 9A F9 CC 98 85 E3 97 39 8F 87 0A 0A 4B 38' + 'E2 BC 6B B9 CA 39 90 1E 70 CA 6B F1 8C 95 02 90 D3 4B 75 62 C6 4C 92 23 5C 28 8A 24 49 CA E2 46' + 'C8 D7 31 4F B0 06 57 84 36 A8 9E 8C 63 CE BE 53 0E 85 73 4D 29 70 3F 52 59 61 AD D6 B5 AD 9F 16' + 'B9 B3 5B F4 F5 93 6B 42 E8 EB 11 A6 D6 EA 6B DC E7 37 52 42 1A 32 D4 8A AE 17 EF F7 3A FD E7 43' + '51 5A D3 42 BA BD C5 C8 A4 5B C2 63 74 34 36 AD DC 4D CE 73 5A 56 AE 86 D9 75 2B 73 64 DD C5 91' + '2E 24 64 1E 5E 34 13 A5 35 BC 7D 39 26 33 25 9C A5 6E 06 CC 5D A6 A5 24 FD E2 21 C6 41 53 57 86' + '13 6D 61 21 FB C4 7A 43 BB DD 18 F4 BD 3E A5 7D 06 B7 DC F6 7A 3D 0E DA 78 5D BF E8 3C 77 CF E9' + '09 21 34 61 00 48 21 01 59 01 48 C2 49 2D 7E AF 8B 87 4E 19 F2 94 88 AC 69 52 AA 84 4C 4C 55 18' + '98 4A 88 DB 63 6C AD 4A 5A DA B5 16 56 B5 A3 0A 2A A8 96 CA 8A 25 A5 50 AD 12 C6 54 48 B8 CD 64' + '48 52 1C DF E8 D4 F8 2D 06 FB D5 7C ED 7F 8D E3 B3 9B 0F 19 B1 67 F7 DD 5F CC E8 39 ED 56 77 B7' + 'FA BD 06 93 8F D2 FF 2E 93 4B 3E 7E E4 F5 BF 0B A1 92 98 F3 C9 25 D7 A6 69 DD 49 5B 5C 87 40 2D' + '13 C7 9B AA E1 ED B6 CE FE 6F 9B 71 3A 88 5F 37 CD F3 BC EF 33 CA CB F3 57 79 99 2E 35 DF D3 A9' + 'D8 F6 3F 4F C9 EB 36 5D 97 59 DB 74 FF 93 AF DA 36 8E 2A DE 87 A1 DF 02 07 6D DA F7 58 20 01 E4' + 'F6 DA 1C 19 BF 22 88 59 61 58 A2 2A C7 CC AA B2 C6 22 20 CA 52 41 04 41 0B F0 7C FF 89 E2 D8 F9' + '39 7A 9D 62 F7 D6 C3 A8 7F 9E 2D FE 7A 72 04 2F A9 81 53 D9 14 48 82 74 7D 5B C3 24 41 3C 21 3A' + 'F1 49 4B 0A 5A 52 16 C2 96 CA 54 70 C5 71 30 89 8B 44 44 65 29 54 63 2D 29 4A 14 B6 52 D2 96 CA' + '54 A3 2D 95 80 CA D8 B5 25 11 0A 2A D2 88 83 01 61 60 19 21 0C 39 15 03 6D EA 7A CE 4E DF BD DF' + 'F9 BF 91 CD E8 76 BE 53 C0 F7 CE 93 7A CE 7B 1D 8B F3 76 17 3E 9E 36 FE 2D 9B 88 9D B5 53 4E 1A' + '5C 02 AB 3E 14 59 FA CF 99 F2 0A 7C 73 DA F0 BD E3 AE 6F 94 83 9C A3 76 41 02 F0 E6 91 AC FA C5' + '3E F2 A7 C4 99 F3 19 0F F7 AB FD 59 CF D4 4D AE 50 FE DB 34 34 6C 1A DE 52 59 13 F0 D6 E1 8A 92' + '6E 11 37 8C F1 5F CB 26 32 4D 06 D4 26 EA 91 B1 39 35 0D F9 F5 3C 65 93 86 81 A3 C2 4B 44 29 FF' + 'D5 6C 83 86 A9 03 81 B5 4D E7 38 BD F9 1E A1 0A 07 0D 0D 1D 08 DE EB 2A 3A 65 A5 75 59 54 AD 7E' + '31 18 5D 0A 92 8F 2A AF B8 62 B0 43 34 2E A9 A7 5E 37 BD 50 EC 44 42 92 DC D2 95 75 B9 F0 80 89' + '88 10 B5 D5 A0 B8 A0 41 C3 01 28 A2 D9 23 3A 03 58 D9 4A C5 AD 4E C0 EE 9C AA B9 4E 69 35 52 98' + 'B5 AD 38 23 D5 4D 5F 61 9A 4E BB 5C A1 CF 75 1E E7 08 C5 B6 AE 3C 61 C8 2C 7D 62 D3 B2 A6 D9 92' + 'CB 1B 03 96 45 7C 5E E8 5F 9D 0D 21 97 1C EB 2B E9 06 C8 F1 8D 2A 13 72 5E 6D 0D CE 3A 87 19 1B' + '5D 48 3C DF 53 90 60 83 20 A0 34 19 A3 1E 55 20 B8 1D 79 8B 5E 18 61 7D 97 62 86 17 67 B5 D1 C7' + '79 A2 06 8B 9E A4 74 0E AF 39 09 ED D2 C7 09 3E A3 37 E4 17 66 09 5D 20 56 D6 EC EB 6E 93 8D C8' + 'EA 9E FA AE 9C ED 98 B5 C7 85 33 D0 B0 A9 2D 2C 84 44 B3 9C 0A 6A D5 AC 4C E2 26 D9 A3 E6 6E 08' + '77 B9 8A B9 13 22 3A FB D1 1A 1A 95 D7 8A CB 2C B3 15 A3 20 C5 29 47 0B 94 B1 DC EA 52 94 93 D6' + '29 4A 20 89 2C 0A 11 82 AA 3A 10 8D 8D 52 B9 66 1A 31 8A AA B2 96 11 63 98 A0 AA DC 83 26 41 7A' + 'DD 8F 0C 13 01 8B 12 4A 72 94 A2 EC 30 30 F4 23 24 47 5F 3C 44 21 03 B6 11 84 67 4A 89 B1 04 D2' + '7E 0A 22 D3 AE 41 12 F3 85 96 B6 52 C2 BC 71 AA 31 8B EE AA A2 83 53 05 C1 71 10 72 99 DE 8F 53' + 'A6 18 AA C3 1C 69 4C CC D1 D9 DF 1A 5F 6B 44 5A 60 AB 31 F7 A5 F9 77 1E 0F 76 7E 29 EC 4D BB 9F' + 'BF F1 C5 F6 FF E3 EE 31 D8 85 DD D9 CA 7C 66 48 7C D3 74 54 BF 69 E9 8A B8 14 86 14 9F 15 B9 25' + '88 25 0E B9 BE 48 B2 80 67 9C AC 9A 47 10 DF FA A0 A6 74 F0 28 49 C4 C0 0E 2E CD 95 24 F9 53 52' + '3A 69 D5 C2 75 B3 9B 9E 7B 73 DE 74 24 98 88 C0 B3 32 CE A2 94 6A E7 BE 58 40 29 D7 F6 AB 08 6A' + '89 0C 43 12 25 21 8F F6 68 A9 64 10 57 B0 6F B5 40 51 AF 46 8B 1A D2 87 27 4E CF 8E A9 62 F9 49' + '07 BF B5 50 87 C0 8B 28 25 FE 5B 06 6C D8 B6 15 90 54 77 34 6D F4 6C 55 E1 1D BE A4 57 69 F8 23' + '45 CC 58 C1 4E C7 64 E1 DE D7 EB F9 D5 4D 74 B9 17 C5 33 D7 42 ED F9 30 AB 9D 2F BF 14 58 B6 7F' + 'A0 13 3D C2 A3 1A 4C EF 29 16 4B 77 E8 20 62 99 55 AA 50 BA DB 67 94 E8 A9 32 9F C0 4D B0 4A 54' + 'F4 0A 35 C6 D6 6D 49 95 33 5D FD B8 EC D4 BC 56 99 97 76 DD 20 B8 7C 60 9F F3 DC 8C A1 00 8A 1D' + '70 AC 97 76 EF F3 34 50 8F 38 4F 4A D7 32 B5 D9 FB 84 7A F7 C7 AA EC F8 17 A5 17 8A E0 9B BE EC' + '5B 7E 28 A3 B1 39 B4 C5 5A 6D E3 5A 24 D5 33 3A 93 73 CD 0D A5 04 A9 CB AD 73 93 4B 81 A9 ED AF' + '8A 2B 92 A5 88 4D F9 2A 55 6C C9 36 3D 3B 81 EC 91 67 A0 FB A0 13 7B 7B 9F A5 B0 9A 60 BB 0C 29' + '0B F6 11 AC 43 5D C8 CE FA F5 C8 F4 BC E7 4D 75 CF 7E 9B 5E 59 C7 08 54 80 F2 69 C9 0D 45 9A 74' + '44 DE 8E C4 50 48 1C 95 1C 50 F1 B4 1D 74 D1 CB 92 0D 0F 6C F1 37 27 47 6E F2 1E 19 21 CD AF 66' + '93 5E CA 39 E4 94 B5 4D AF 07 47 77 AF 71 A8 FC 06 A3 5F 1C D7 68 1E B0 CF 87 6C BA 62 DB 7C CA' + 'CF A1 B0 E0 6E 74 2D EA F5 A7 BA 53 9D 67 AE 51 45 37 10 DE 90 CC 8C C8 78 24 3E 00 CF 40 EA AC' + 'CF 7F 99 F0 2A 72 3E 14 11 20 85 CA 63 1D 58 F3 1D B5 D5 D8 38 BF E4 78 71 79 E9 3A E1 B6 7D 9B' + 'DE 8D EF 93 D2 58 F5 91 0F 33 54 DA A3 6F CB 9E FC F7 A3 B5 6D 48 F2 2C 60 63 39 32 74 5A 2C 4E' + '17 44 AA AA A9 4D 17 CD 30 15 23 12 0B CF 32 A0 B0 70 D3 8A AA BA 6E 52 0B 02 FF 0F 42 E6 19 11' + '82 38 64 A4 8B 86 54 06 CB 25 70 C2 89 06 DA A9 30 02 C2 C9 25 48 B9 95 01 A5 56 D9 02 5A DB 62' + '31 62 31 CA DD 5D C8 6C 68 DD E3 87 39 17 0A 28 C0 5A 20 89 0A AA 21 55 44 15 08 B2 41 60 73 0C' + '90 0C 0A 30 82 C5 8C 55 59 24 06 3A 69 61 68 83 01 7F A6 CA 45 92 1A 44 05 5D 10 0C A0 63 54 25' + 'E3 10 92 58 22 A1 E9 7B AE FF AD D5 F9 47 A4 EF 3D 17 BC F2 59 F0 2B 9E 42 75 B9 53 CB A9 64 62' + 'F5 92 95 91 3B 59 EB 62 62 EE C2 16 41 56 03 03 5D 6A 4B 05 67 6D D9 BD D3 13 6D F5 B2 6A 66 07' + '97 F3 1E B7 EE BE 47 63 B3 DD FB 5E DB F7 56 7D 87 63 CD 76 E6 9F 77 7D 48 1C 9E D3 D8 EB D1 4A' + 'CC 75 CA 56 11 7B 29 4A C8 4C 76 6A 01 A3 24 0C 49 D8 F6 3D 7E 9F 99 EB EB F6 7E 7B B1 C8 F6 5E' + '82 55 78 D5 D2 D8 58 90 82 B0 8A 3C 95 ED AA B9 62 50 2C C7 5A 8B 24 30 24 09 4A 24 05 05 4F 9B' + 'EE 7B AF 73 ED 3F 9D E2 7B DE B7 79 DE 77 B7 F9 3E 2C BF 20 5D F4 FA 89 D6 EA DC B8 AC 83 7D 6A' + '2E 4E DA AA 20 79 7E 5D 4F 0F ED 3D 96 BF 7E 7D F7 B1 F5 5F 77 CF 34 87 97 A3 A4 72 E5 59 30 A2' + '2E 5F 40 DC 6C 89 83 74 CA 8B 98 E3 16 34 68 C1 8C 65 6D 10 B0 68 AD 18 95 8B 55 0C 60 C4 46 22' + '2E 82 96 22 61 28 C1 5A A9 29 45 40 A4 98 F7 5D FE 6F 02 B2 73 63 47 2B 87 4C 5D 94 28 8B D6 59' + '0D C6 2D EF 4A 13 49 42 C0 B6 D2 2D DE B5 06 DF 44 24 83 68 EF A9 1C CB 2D 55 BD DD DD E2 96 A4' + '8A DE B3 7B 1D 78 3E 6F F0 3F 7F F6 5D 9F B8 BF D9 9B 40 3A 6B BF 2B 0E 7E B7 2A 03 A8 98 62 86' + '69 40 F9 5E DB 97 B7 4E E5 F5 9F 1F EF 3B AC 7D 2A 27 C1 EE 7F B5 D1 98 89 20 F5 9E DB A8 E2 4E' + '44 19 0C 2A 1D 58 AA 45 54 54 8A 46 25 B0 A9 8D 95 8A A2 AA 8B 1C F8 FB B1 15 55 45 04 82 A1 08' + '60 95 59 B8 D5 35 A5 CA 9D 7A A9 88 00 C1 00 4C 5E 71 8B 65 09 8B A8 23 0B 49 50 60 B0 46 16 83' + '65 81 68 D1 65 2B 28 A2 2B 15 88 2D 72 B8 C4 B6 84 A5 A6 4C C0 86 2D 2A 34 4A 0D 65 80 8C 50 88' + '82 08 65 8C 62 5B 48 A0 11 19 11 0A A8 05 64 16 02 82 C9 92 C4 84 51 45 90 48 88 88 17 59 93 A3' + 'F4 9D 90 EC 58 C3 04 03 A1 1D 2A 57 BA D5 E2 D3 FB 37 F5 3C 65 63 3C AC 1D 85 A5 D7 DD 9B 8B C7' + '75 BD A5 4F 90 2F 19 D8 CE F6 0F 09 E7 BC 63 9E 79 E7 8A 2F 33 EA FD DF AD D3 FA F3 7E C8 BB DF' + '37 BE A3 E9 B1 7D 85 69 52 A1 3E 08 1F A9 26 4C 97 F5 5A 30 7D 29 49 C2 14 A4 29 4A 52 CB 3B 52' + 'E6 65 FD D2 8F C5 D5 D7 D7 DB C7 BC C6 1C 7E 3E 4A FE CF 0E 7B 27 29 74 C8 94 AD CA D9 E4 C1 D3' + 'C1 F7 A5 78 53 13 BB C3 DF E6 EF CD EB 2D FA B7 FB 87 FD 73 FD AB FC 39 3D 95 6E 70 FB 8E F7 AE' + 'E8 FC 8F 4F D8 79 DE 07 B8 FA FE DB F7 3B 6F C8 FA 3D 2D 8B 5E 9E D7 3B 9D AC 4E F3 BD FF 55 D5' + '7A 61 69 F8 D7 F7 AF F4 D3 BE 3E 57 23 3D D2 88 5C 8E 87 43 A0 C8 BA 1D 0E 86 3E 7F 3F 9E B7 BE' + '17 43 D5 78 7D B7 7D E0 77 FF 5D E0 78 47 CD 92 77 0F 75 E8 DA 87 CE 3D D3 2D 92 65 A3 35 0F 0F' + 'BD AB 45 09 F5 7D FF 83 F5 4F A1 C9 02 1C C8 6A 30 9F F1 F7 DE DF E4 9F 27 CD D7 B0 D6 40 86 C9' + 'E9 78 AB 2D 96 C2 C7 CC 54 26 78 FC 2D BD F9 90 D5 90 DB 7A 09 63 24 EB 33 0C 02 99 4C 09 68 42' + 'D2 4E C5 D4 8F 35 10 F3 59 D3 4C FE A3 F3 3E F3 F3 FE F7 DD FB F8 7A BE EB BA F5 3D 5F D2 7F 23' + 'DE ED DD CF C7 D8 09 9D 00 36 86 41 CE D2 67 31 48 69 B9 7D 3E D7 BF 67 7A 8E 8B 84 D0 72 DA 0F' + '71 CB EC 9E 8B 51 CF F3 BC EE D5 E9 FA 76 D6 9E A5 2F B2 57 60 1F AD 61 F2 87 F3 71 B6 52 77 04' + '8A DB 02 CF C1 89 DD BF 31 86 68 DC 9B 99 7E 8B AF B3 F2 FC 27 3A 4F FA 7F 93 4E A5 7D 83 9B 29' + '5E 07 13 85 C1 E1 69 D8 CD B0 58 FE F7 B3 3B 3D 47 3F 3F 3F 3F 3F 3F 3F 3F 69 4F D7 51 5D 5B 70' + '8B 43 9B CE E8 6B 00 21 32 44 80 00 6E FE 8D 67 F9 77 E7 27 27 3C F9 CF 3F DA D8 F4 74 6C BC 35' + '5E 03 19 B8 99 16 E6 E6 A6 7E 4E AF 53 A1 2F 2F CD 96 97 A0 E6 7E F6 F7 14 5F B7 E9 C1 DC FC FB' + '8F 8F BD 59 DD 11 A1 9C EE F4 8C E3 9A 49 6D AD B5 73 8E 09 9A 36 9E A9 93 34 1D 7B 53 36 A4 CA' + '14 28 E0 D4 BC D7 49 C3 B8 58 58 46 38 F8 58 5A AA 33 A6 3C 5E 2F 17 88 CD ED B9 6B 4B 82 85 8A' + '22 44 6A C0 D5 7D 49 8A 9E C9 D7 98 67 70 DB B8 C5 49 8C 33 08 6C 58 77 58 42 86 0B B7 50 C7 D1' + '7A 96 14 25 98 F9 37 F7 A7 71 30 0E E2 E1 5B 87 85 0C 25 D7 A1 1A 4E 99 AB 46 8F 13 6A 66 A4 67' + 'A7 1B 51 E0 AC 10 A0 CB 60 E9 DB D8 90 E2 69 2F D1 5C B1 6A B5 AB 97 08 2A FD 58 AD 96 3D 5E DD' + 'B3 D7 E2 BF 6C D9 DB B1 60 46 7D 1A 00 AF 5E BD 84 2C 48 91 A3 45 7E 41 E1 10 08 10 72 55 CE FF' + 'DA 74 23 AB 86 9A 85 55 4A 6B 7E BD F6 C4 F2 CA DF A7 75 E9 EE AB 24 4A 6B E3 A8 FA B9 DE AE 1F' + '2F 75 9D EC 60 25 75 7D 2D BB 4D F4 72 5A 99 96 E0 87 71 9F 5B C5 DC F2 79 7F 6A 95 2A ED 11 92' + '3D C3 1E 7F EB E3 17 64 62 57 A9 2A FD FB ED 04 28 50 58 BE A5 41 CE 78 F2 9C A7 93 27 A6 4D C3' + '97 39 19 39 2D AB 31 E6 CF 4C 9E 66 CD 99 53 E7 B1 BB 45 AD A1 42 84 D1 5A B5 67 AB A1 5C AC B0' + '33 75 06 04 10 97 2D 5C 78 A1 B2 90 60 C1 5C B9 74 18 2C 18 61 E9 63 40 81 76 C5 8B 86 FA B9 39' + '30 C2 38 71 B6 83 C7 8F 17 2E 5A AA 34 66 B2 24 2D 58 B5 3E 72 78 30 20 E9 B4 D3 EE 3B 8E DF B1' + 'EC 7F AF 77 D9 76 7D CF 5D AE D5 43 81 7E 86 99 29 06 70 89 A5 64 31 12 31 18 8A 44 88 04 75 9A' + 'C0 35 9C 30 08 10 F2 BF 90 04 4D 79 93 6B 1D C3 2D 88 71 ED F0 B7 6C 6D DF 6A FC 5F 17 C7 B6 E8' + '73 B6 5E DE CB DC D9 6C AB BB DB 7D 9F 23 8D B3 F7 FD E2 55 3F 07 CF B8 F9 FE 3B 0D 97 53 A9 EF' + 'D0 AD 5B 35 2F 55 A7 57 9B D2 E6 73 52 BF A5 99 E8 CB F2 3A 13 C4 7A 60 10 FA F5 84 35 84 40 22' + '44 03 47 11 6B 0C BD 96 93 19 9B EE 6D 26 FD 4A 43 6D E6 30 60 D0 FD 3E 67 4F CA F8 0F 61 D1 74' + '5C D6 C3 AF F0 79 CD 36 D9 4C B2 D4 A1 4B 55 7E DC 7F 63 8B AD F4 F6 0A 7D BF 5B 61 EE D9 DA 6C' + 'EB AC 0E 78 3B F4 69 39 7C B9 6E 3F 1A 5B 91 CD F8 36 FF 2E 87 DD F7 4C DD DD 5D E5 F8 3E FC 2A' + '74 A2 F6 4B 74 E0 75 66 BA DC 1E 07 2F BB DD 50 7C B9 FE FF 7F 84 F2 3C 7B A8 F7 F6 49 49 DE FE' + 'EA 3A 3D 14 C4 AA CB 14 ED C0 A4 30 96 96 82 97 F2 40 17 57 B2 F4 E0 28 9D 58 E2 44 17 63 EB AB' + '1D E9 3B 6E 67 F2 73 79 9D A7 47 AD E8 50 E6 64 EA 31 E4 EA 3B 9E E7 E7 7F 17 73 DC F7 1A 3B FF' + 'F7 F6 FD E7 3B BC 5A E1 7A 1A 69 8A 6A 5A 69 62 34 99 20 00 07 8C 00 08 F9 5D CA C3 BE FC C9 C2' + '47 E8 B8 9C A9 BF E3 EF E4 7E 12 9C 8E B5 A5 A5 A7 D9 73 61 5D BF 9F 29 BF F6 BC F7 47 D5 6A F7' + '1D CB E1 49 CB 5C F7 81 2B E6 F3 CF 04 91 64 34 F9 EA 49 26 10 0C 63 C4 68 77 1F 2F 37 EC FB 3C' + '9E 3C DA AC 96 AD 9B C7 70 A6 16 82 95 29 17 E6 BE 62 95 D4 67 51 9D 57 D7 57 CE 33 9E 81 43 01' + 'A6 93 A7 6F 1F C3 10 41 3A 5D 2E 7F 3D BB 76 E0 BC 7B 7F 71 5E 6E 96 A7 B3 4D 4D 2D 2D 41 40 9D' + '4A 85 2A 58 77 EA EA FA 9D 4A BA B9 8E 7F 3D 32 F6 0C 01 06 65 7B 16 0C 58 CE CE B2 9B AE AE AE' + 'AE 74 EE 86 86 86 8A 8F AF E2 2E 10 41 04 12 04 15 99 B9 B7 17 15 B5 B7 17 15 F5 FD A2 04 08 01' + 'DA ED 4B F7 76 7E 59 00 3B 84 64 F7 C9 0C DE 6F 2C 01 2E AA C2 44 4F A2 A8 EA 96 CB 6C B6 CC DE' + '29 86 5E 0A 85 7C 0D 6E 42 E4 24 D9 FB E6 49 30 84 0F 80 F0 C8 69 24 D8 E3 E7 4E ED 36 ED 4F DD' + '5C 24 70 5A 24 92 F5 55 B5 F3 8C 74 51 E0 55 41 47 7A 8D 80 4C 83 04 C8 30 33 1E 33 13 A1 C8 98' + '23 61 B1 82 A8 ED F5 35 3A 47 09 5D 30 46 66 C6 86 35 4C 10 FC CC 8D C4 BC D1 05 EA 8F 37 85 BF' + '1B 28 F1 F8 B3 CD E4 D5 4E FC E5 3C F7 CF 76 D8 B5 8B 70 F1 A0 8C 58 07 5B 6E 2E 07 75 E1 50 6A' + '91 66 E3 39 9E 18 62 EA DC 52 50 5A 15 54 0B 29 90 B4 26 39 B1 9C 61 22 C9 CC C8 1C 71 EA 7D E6' + '00 34 41 78 77 4D D9 0A 10 A4 B7 18 C5 91 65 21 2D 91 64 A6 B8 C5 86 58 4E 10 39 72 E5 57 09 87' + 'A1 A7 A9 4D 1D 24 09 F8 DE 15 49 C2 0F 35 0B 3A 10 B4 2D 87 4A AA 35 41 84 87 49 B6 C1 C2 71 75' + '29 59 26 EC 3E CB E7 3A DE 6B ED FE 37 DA FD EF C4 F1 DD DF B6 FC 7F BA EF BE 2F B8 48 11 AB 83' + '1B 3F BA 39 79 66 FD A7 64 F2 7D 67 57 48 DA 15 BC 2D BA CA CD FA 15 A5 97 DE A9 3F 40 96 D0 C7' + 'CB BA CF 9C D4 E0 A6 E9 16 59 41 44 95 7D 0F 46 E3 95 F7 E8 5F 29 7F 30 F1 E4 D5 47 43 F6 D3 9B' + '95 5B 54 9F B7 D5 4C DF B8 99 54 BD 6E 2E 5D 4D 7D 12 56 A5 29 82 A5 C7 79 DC A0 6C BF AC F0 2A' + 'AB 44 D5 94 18 F6 49 A9 52 E9 67 29 A7 F2 58 55 F9 18 A4 B2 4D DC B9 64 A3 02 CA 2D E5 DB 83 26' + 'D6 DD DA 28 37 81 86 BB 3F 05 B9 D8 77 58 38 7A 18 9A 07 5A 48 58 C7 4F 29 83 16 2C 5E 39 CC 76' + '81 A3 66 79 59 A8 DB A5 4D A7 A8 91 32 77 29 5D A9 77 9F A1 A0 D9 E3 CD 20 30 7F 76 BE 83 39 70' + '05 18 15 52 89 BF F9 2D C3 19 9B C5 0C D3 83 49 67 35 A6 BC 0A 67 3A 6E 54 97 CF E8 68 D5 EF 3E' + '44 66 B0 AE 4A D7 74 F6 D9 78 3C E9 FB AE 05 37 E1 4F EE 5A 4C E8 A6 DF 0B B8 B1 B0 DC 69 7D F3' + '5C CF CF 23 14 A5 3F 2B 87 7E 66 8A 71 CB 97 0E 1B B7 16 14 88 70 69 86 B7 A0 FB DD F6 B0 FE DF' + 'A4 02 84 74 15 D6 7F 27 DF 67 63 4F B1 E5 EF 88 A3 89 35 E6 EB 3F DA 12 EF 3F 30 FF 9F 04 8C 79' + 'B3 81 0E AB CE F4 5E D9 5F FA 33 BD CA AE 5E C9 2A 1D 7B D3 E9 BF B6 55 A3 E2 FB F4 79 6E 77 96' + '8F 2B DC 74 F4 D5 DB 57 91 D1 3E 82 E3 E7 BB 83 3D 51 FB E6 9E 69 75 05 DC 12 CB DD 96 3D 32 1D' + 'B9 0F E9 FC 4D FA 3B 22 4D 82 9C 09 49 95 11 96 F8 3E D5 B0 08 A3 89 78 7E DB F6 BE 07 97 E5 F9' + '76 CF FC 03 5D 19 A9 15 9C 45 20 41 28 BE DC A4 F0 7E B6 C9 6C D2 B6 0B E1 21 71 0B F4 3B 79 78' + '7E BD 5C 25 85 3B 35 FC DA 70 4D FA 44 43 CC AF 5F FF BB A8 67 BB A0 59 CB 3A 6C CF 08 F7 9E 26' + 'D3 BE E1 4A 06 F2 3B FE F7 ED 74 FF 9F EA 7F 8F D1 F8 9E 3F BB F3 BE CF C7 F2 3E 7F BB F8 DE E7' + 'EA F2 3E C7 42 1A 02 20 F9 A4 7C 02 75 1C B2 F2 E5 C4 68 88 50 3A 92 49 D5 1A A2 A7 50 5E 7F 9F' + '7E 39 51 39 47 9E 78 1E 32 A0 31 10 44 19 06 42 21 10 2F F4 F3 D4 9B A3 CA 19 55 11 05 BE 4B D9' + '54 74 87 9F 33 00 74 C5 BC 70 3C 03 5C 5B CC EF A6 3D 14 B4 4E A0 76 4A 03 8C 1F 0A 2C 71 8B 85' + '7E 48 F7 5C 68 16 4A D2 85 55 B5 33 60 DE 23 58 5A 9D E9 33 E9 56 5B E2 86 30 9A 10 24 2B 51 EA' + 'B5 99 E6 C1 1A 1F 15 77 7D 75 30 80 ED DC E4 16 30 DE 59 55 0B 34 77 55 EB 65 24 7B 4F 26 7B E6' + '38 25 8C 4F A2 50 40 E9 55 46 22 16 70 F0 1F 2D 66 F8 26 B2 B3 7D 7A 71 2A BF 2A 1A 22 4B 9A C4' + 'E5 28 8C 6D 89 01 80 C6 35 28 1A 98 0A 09 04 9F D1 23 08 9E 9A 2E C4 6C 67 80 A4 09 66 DA AA 20' + '62 E1 09 02 E9 4A 45 BE 27 26 B1 38 84 1B BD 14 CE 4E 2B 9D 3E 67 8F 78 39 6D 35 72 BE 55 B2 9D' + '15 D7 57 96 4B 6C 8A F9 88 31 7A 59 8D CB 12 8B 1D 46 F4 BB 73 54 7D 32 00 C4 FE CA 3D F0 A2 0B' + 'C0 E8 08 63 F7 A1 10 3D 27 A8 B2 1E 86 DC C4 A2 AE A5 A8 B5 95 A9 5A 95 A9 5A 95 A9 5A 95 A9 5A' + '9C 31 0C 61 32 72 6F 0D 9B C1 93 92 FD FE 1F E6 76 1F 9F D7 F0 1A EA DF E7 FD 32 E6 5B 9C 5D A5' + '13 07 05 D6 8E 82 7E 92 0C A8 C2 CC 1E 99 3C 6F 9E 2A 5B FE 75 FA A3 72 E6 CD F5 0D 9B EA 9B 37' + '0F 55 82 E4 88 A2 D1 D5 21 24 86 AD 0F 69 0F 6D 0D 62 1E E2 1E EA 1E F2 1A D4 30 61 D8 EA 57 08' + 'F1 BE AE A6 86 7E 7B 50 A3 C1 7E AB C4 A9 AE 9B 06 66 57 06 17 0F EB 21 05 38 B4 14 2F 16 E0 C4' + '90 E2 74 77 24 A2 33 08 A2 8A 2A AA A3 C5 18 38 97 8B 64 E2 D9 99 9B 96 A5 CF 6F 3F 13 3F 9F DD' + 'FC 1F 65 BC 70 5E 0F 82 CE F1 9A 7D BF 53 EB 4D EB F5 FA FD 7D B7 AE B9 FF BF 36 E6 C7 E1 EB 59' + '4D FF 6E 25 5E DE 7F B5 DD EB FD 3F 4E FA 8A 8E 86 66 67 85 33 C3 AA A9 EC 28 50 71 42 82 EA 14' + '18 51 DB 51 5A A1 45 D5 DE 1D A6 43 1C BB 33 86 8D 1A 35 CE 31 E2 BC 2D 73 C9 1A FA FA F8 C0 38' + '1A A1 9D 1E F4 75 6A D5 AB 4B 85 9A AC F1 7A 1A 12 E5 CB 97 2E 50 B9 72 E5 CB 97 2C 58 B1 62 C5' + '8B 16 2C 58 B1 62 C5 8B 1E 13 18 4C A1 32 C4 4A 22 21 14 88 8B 39 33 21 12 89 A3 9E 26 88 9A 2B' + '32 15 1A 6B 8D 7E 0C 28 70 CF C6 C7 19 7E 4E 42 FC 8D 3F 1B 35 DA 6E E1 07 0F 3C 64 AF 5A 67 C3' + '8F 15 82 C5 63 C9 5C DD 74 31 DC B2 86 E9 D4 21 5E B5 7F A9 A9 02 0C 38 10 A1 C6 88 30 C3 0D 04' + '61 B7 60 7D 44 40 22 44 89 10 37 04 7E 72 3F F0 44 00 08 80 46 2C 9E 0D 54 86 6B F3 B6 52 94 28' + '1D 89 61 96 1E 02 65 34 12 BC 1B B2 33 DA DF F4 A1 DE A4 F5 75 D5 B3 A8 F7 9C 11 7F 8E 2F 0B 0F' + '07 4B 07 07 8D C6 5D C5 A9 CF A8 F1 7C 5C C4 3D 2E 7B 0C 64 DC D9 74 08 32 C1 5F 7B 3B D6 43 81' + '98 A7 AF 9C A6 96 91 75 45 94 07 75 3D 9B 30 92 59 F0 1D 03 59 58 1A C5 B5 B3 53 93 B2 4B 5A DA' + '5A 26 28 9A D5 31 5C E2 D9 D6 D9 D6 F9 D0 93 41 4F 9E 5C 44 4F 41 54 E5 5E 23 37 E2 9E 3C 74 FB' + '60 C3 7A CD 4B 35 3A 82 42 3C 4A AE A0 ED 55 7D 66 29 6B B3 F7 E7 B0 6E 0D 1C 31 88 61 BB 66 D2' + '22 21 47 11 B4 46 F1 1C 44 73 11 D4 47 71 1E 44 7B 10 58 9A B1 1F 44 7E D9 FB 77 EE 1F BF 7E FD' + 'FB F7 EF E2 BC 7B 16 0C 34 69 57 26 74 E9 83 05 8A 95 0E D1 CB B7 42 6A 37 6B A8 3C 99 31 A3 47' + '69 0E 1B 98 AF A1 3F 8B 20 69 23 3E 7D 0A 14 28 51 A2 FF F3 FF BE C7 B1 EC 7B 1E C7 B5 0F 92 F6' + 'BF 0C F8 7F 0D 91 A4 E0 D2 D1 22 15 DC 6A E5 A5 7A 68 33 99 0F 3F DB 51 0E BD 50 8D 10 F3 F5 34' + '8E 19 FB 6E FE 8B FA DC DA F3 F0 F3 F3 8A E3 48 52 44 E1 1A 6A 48 E2 5A 22 07 A2 8C 5D DB AA 38' + 'F5 06 2B EE 33 B6 87 5A 5A 40 E0 FB A0 E4 E9 9D 98 9A A1 8D A1 40 EE DD E8 AA C4 91 40 A0 C6 2A' + 'EA 72 55 AE E8 7D B5 12 A5 9C 5D 86 D3 69 C8 E2 14 A5 DA 4B CD 94 20 55 42 8C 62 EE A7 64 CB 47' + '51 93 B7 79 69 2E 9F 4D 77 5D D3 82 4A 5D 3B D5 07 5D 72 55 0F 72 10 45 E1 A9 6D 21 4F 1C 56 10' + '08 F1 C6 E5 59 C6 2B 30 36 12 0E F4 50 A8 9D 90 E2 EA 32 76 90 5D 75 D9 A9 72 5D 37 1C 4A FB 2A' + '7A D5 07 81 55 19 C7 F5 7F 86 CE 67 66 FA A8 24 A4 6E 2E CB 54 1C 54 1D 75 D4 A0 F0 E8 61 33 9A' + '92 5B 20 89 7C F5 8E 8A 59 02 B1 50 D9 09 AB 03 0E DB 1A 59 0A 8C 95 8A DE 06 2A 02 90 35 60 29' + '3A 2A 88 86 F7 77 5D 40 94 B8 CF 0F 81 25 E1 4E 37 04 94 A7 DA 4B DD 07 65 C6 E8 3A 5A EC CA 8B' + '32 D7 19 BB 11 46 12 0E BB 53 5C 29 4A 2D CE 2F 17 90 34 42 6D 74 6C E0 65 8B 30 D3 77 47 0C C4' + '36 DB 7B DE 91 5C 62 AE 51 6D AA 8E 66 48 0A 8C E1 94 EB C5 9C 59 40 98 A8 AD F0 EB 38 24 92 D2' + 'ED 48 8C 74 DB 4E C2 4E CE D4 BA 48 71 B4 31 19 8C 33 58 CE 21 26 C8 43 56 65 14 14 8C 8F 1B DD' + 'BC 35 20 02 C8 6C CD 82 A8 E1 C6 2D 31 80 2D 97 2E A5 B2 17 65 49 68 0B 24 59 0B 61 0E 12 49 94' + '26 6A B3 55 24 38 40 A3 8A DA 74 B4 8A BA 54 8D F5 C1 21 34 C4 ED B8 0B A7 13 6E 24 A4 D6 94 56' + '21 34 42 52 AA 21 AA 9B 51 5B B5 38 CC 35 E2 82 A5 4A 98 BA 96 85 5F 0D 9C 24 E1 90 59 0B 55 E1' + 'A1 44 DF 84 A5 2E 99 C5 94 A3 C5 0E F5 5B 63 18 A4 24 59 B5 52 C5 13 44 DB 43 10 76 4C 58 5D DD' + '8C 61 03 6D AA 48 B0 E3 8A C2 49 A3 03 8D 77 9D A0 0D 1D 9D 32 3A E9 55 57 4B B4 ED 23 82 71 2A' + '8E 95 DC BB 57 2F 69 DD 5B 9A 42 18 9C 82 92 21 34 31 3B 91 21 44 D2 82 67 0C D1 05 01 64 86 1A' + '19 0D B1 50 2D 46 2B B6 37 BA 1E CD 86 91 A7 54 D0 1B B6 51 12 A4 09 0D 9A 57 13 DA 37 BB 20 E2' + '09 1D 53 45 1A 97 0B 50 2E C6 D4 1C 54 E6 94 46 D1 60 71 00 14 C8 C3 18 AA D5 50 10 89 8D 61 31' + '8E 2C BA 5A 5D 0F 3D DC 7B 4E A3 75 90 BD 9B AF 4B 1A FE 7D 12 66 D7 15 73 E7 DA AF CB D2 97 4B' + '98 EE 71 D3 5B 9A C0 18 26 40 81 31 80 B3 0B 23 73 50 01 B7 5E AB 79 54 5A 0A 75 A7 90 B7 22 60' + '92 07 46 21 B4 55 7B 41 14 63 12 90 34 74 7D B7 4B F5 7E B3 EE 7E 4F BE F8 1E BB E1 6B AB F5 3F' + '1F A7 D5 61 0E A8 C9 3A 70 41 50 84 77 19 AD C1 06 22 ED 3A 9E 43 F7 7B 08 AE A7 4F 45 63 04 CC' + 'C0 02 44 42 86 C0 62 64 14 AA 27 42 61 FC 4F 07 C8 7E EF D1 FD B7 AF ED FF B9 FF 0C E9 EC FD 95' + '1E 2F 99 F4 5F 59 9F 0F C5 EC 76 C0 1D 84 87 5E 24 63 DA 6A DC 27 65 ED 26 31 E8 BE 63 F6 3E 77' + '0E F4 C0 03 74 92 6C 24 52 55 42 99 6D 3B 6F D8 F1 73 A2 49 9E 7A 81 5A 9A D9 46 26 D5 97 0E 8C' + 'CD C9 4C 42 F9 FA FF 8B AA 2B 96 31 25 88 4B 8D CE 31 96 D8 8F B9 7E 75 10 3B 5B 21 AB 09 42 B7' + '48 C2 DD B1 46 AF B5 FA FC 6A C0 98 88 C3 3A 50 6A F7 BE 37 AB F0 7E 61 7F C7 F7 87 95 E7 F4 5D' + '6E 9D C0 AA 2A 49 CE 2A 74 E8 E9 27 4D 98 54 60 65 81 D1 8F 75 F5 5E 2F FD 1F 69 F1 BF 83 BF 49' + '81 CC 90 EF 39 BE 8F DE F9 3F AE FE 86 BB 8C 0D D2 1C B7 F8 5E 47 FB 3F 61 E2 56 B2 1D BA 2C 86' + 'BD D7 E6 BC 4F 17 6F FE 7A 4D 88 74 D2 0C E9 9C 75 F9 AB D6 F7 3F 07 B9 F9 9E 67 9B B2 C2 1B 3E' + '27 45 04 87 91 F2 59 B9 3C 96 4E CE 93 0A 03 36 AA 17 14 55 B5 48 07 2D D5 04 54 34 51 69 09 23' + '4F 11 96 F6 9A 0F B6 FC D1 F4 1F 3D DB 1E 77 B7 54 21 55 57 0D 3A 84 07 D1 4E 87 DB BB 86 A7 CF' + 'DE 73 50 A3 4D D1 5B 12 41 C6 0F 97 74 22 CD 69 D1 8F 34 EA 84 8A 0C 45 1A 46 98 52 F4 6B 5B 22' + '81 E4 F9 7A BE F7 DA FD 3F CC F0 FE 3F E4 5F AA D6 00 74 FA 8F 55 7A D5 21 4C 87 4E 29 8E B6 03' + '03 CB AB A0 1D FF D6 7A EC EF C6 DB 90 DD 92 6E E6 A9 5B 66 97 C5 94 A2 C4 F6 FD 9F D6 6D 4A 84' + 'A5 78 E3 59 21 A8 A9 C2 71 C6 F5 99 B3 27 AE 9A 5E FB D9 00 DD D1 14 77 43 7C CC 41 77 C1 45 AA' + '52 CD 92 A9 36 70 90 76 6A 13 22 B7 50 DB 6D 6F 28 8C 6B 5D 6E 48 61 53 62 86 26 D5 69 2C D5 AD' + 'AA 6C FB EE 93 F6 FF 81 F9 5F ED F3 9F 99 FC DE 97 33 CB 95 01 C9 AA AA 18 4E 92 5A 52 AF 2C 1C' + '83 1A E6 91 E4 CA 4C D5 31 4F C0 EE 7F BD DF 57 F9 5D 3A 36 A2 43 98 66 E8 B2 91 63 45 51 C5 D6' + '10 2B 9D E8 4D 05 78 55 3A 4D 73 1D 06 91 41 B5 B4 96 0D 08 E6 E1 77 42 E6 39 5E BB 62 AE 96 2A' + '04 20 AA 22 49 56 2A 66 DE 2E 36 5F 4F BC B8 73 AB 09 84 26 35 DE 91 55 88 CD F7 A3 47 BB 9F AE' + '18 02 93 6C 24 DF 8A 90 DA B7 B8 4D B8 66 58 1E DF 1B 7B 3F 67 67 1C 51 05 84 37 DA 99 C4 7A 2E' + 'A1 BF 35 4F 1D E4 3B EF 53 F5 1E 27 D4 E9 F0 FE 2F 3F 3F 2E 57 21 D4 A2 88 74 98 47 A9 45 2A 37' + 'A5 66 CA 31 CA AB 95 52 2F CA F4 F7 B7 1B 5C 0D 6B 74 B0 36 60 28 82 86 34 DF 8C 4F FD 7D 06 BA' + '3B 03 0E 1A 42 2C 26 8C 84 57 54 DD 97 A5 43 7F 77 E2 78 41 BE 7C 7F CD D5 78 8F 6B 39 90 B6 D3' + '01 84 41 82 B2 04 05 64 65 62 B0 C2 13 8A D2 0B C7 F2 7D 87 73 FB FB FE 97 E5 73 40 36 64 37 45' + '83 0E 67 9D 3A 19 E6 FF C9 EB F5 24 D9 21 91 88 A5 1A 56 CD BB 27 51 D1 72 92 64 42 5A 29 10 CE' + '2A 68 86 3F 89 F5 FE D1 FC 1F 97 FC AC FD 93 F2 F6 E6 F1 7C DF B9 F3 99 90 E4 F2 42 75 19 0E 55' + '25 A5 C4 DD F8 BE E3 D6 7C F6 82 94 A5 15 8C 14 D8 98 60 E3 FC 7D BD BA DB 18 D5 52 B4 32 44 C6' + '32 1C B7 20 81 8C C6 41 81 69 4D D2 80 CB 09 80 34 8E BA EB AD A0 06 90 60 E1 BD E7 E7 ED 55 F0' + '8C 55 8C 8B 09 80 66 EF 9C FE CB 95 DA 4A 52 AA 4C 60 AB 30 8C 30 6B 77 5B 12 3E 8F 41 AC 01 E4' + '18 2D E8 38 3E 63 97 FB 90 78 60 A0 20 C0 75 DB CB 96 42 17 58 C6 99 80 B2 0E 95 0E E1 0B 48 7E' + 'F7 D3 D6 DB EF BE 21 B3 24 BD 5E AE 83 DB F4 CA 3E 77 F5 5F 33 39 CD C2 BD 45 45 7D 07 B1 F5 AF' + '4F CB A0 AC 15 50 D1 43 60 52 05 09 0F C6 FF 33 E1 7F EF C6 FA 8E DF 4F C9 E3 7E A7 2A 03 9D 31' + 'D7 EE EC 52 1E EB C6 7F 5B CE B4 06 FA 65 1F 3D FF 6E F3 31 94 1F 45 F3 9F 7E 95 5E 24 51 FB 0F' + 'CE 7F 6B C3 DF 54 7B 94 55 7C 6F F4 7E 8F CB FC 1C 1A E8 10 F3 C2 CE AF 57 9B 13 99 85 24 34 D2' + '15 68 61 25 24 2C 8C B6 49 50 6D 21 D3 64 3F 23 D7 EB 60 69 04 0E CA 43 DC FB BF A6 F6 3A 43 20' + '73 09 0F 47 F8 5E CB B5 E9 BE F7 C1 D4 81 BA 82 07 54 E2 88 5F 5F E1 7A AF F7 62 68 C9 9E D6 A4' + '0F B3 F6 BE C2 E1 34 83 24 27 70 92 07 3F 6B 8B 21 D1 EA 7A 36 86 20 1B 32 49 F2 3D B7 D2 FC 2F' + 'C3 D6 1A 04 E6 12 1E DA C9 50 2D 21 DD DC 28 0B 60 7E 2F D1 7E 3F EE 3E C7 F7 3E 5B F5 5F 0F 9A' + '1C DC D0 0F B6 ED 7F 03 DC 7B 4F 3B F8 9F 03 FD 3F F6 EC 73 01 D1 06 07 43 21 44 43 C8 32 C4 85' + 'C8 D3 0B 43 BC 48 7A 86 4A 7A 78 69 10 98 D3 44 2E 19 42 54 3F 4B E5 3C AF A8 CC 34 E2 A7 0C 58' + 'EF 40 70 C8 71 68 51 34 4B 48 63 9F E8 74 86 FC DC FC FB 43 8E 7A E7 64 3E 93 B5 F3 FF 13 DF F4' + '43 48 6E 84 A8 32 6F BE 1B 39 08 49 95 59 CF D1 D1 D2 CC E4 CD D9 BA 12 B7 A8 57 18 2E 43 FA 9F' + 'B2 FF 97 9F FD 1F 8E ED 6B CC 72 A9 39 90 E6 9C E9 53 22 43 A1 C5 D4 04 64 3A 5D 3E 5C B4 D3 42' + '6E 9B A9 86 14 48 61 84 DB 4D B6 E0 CC 9B A1 B1 BD 4A 45 84 DC 65 D6 6C 0B 8E 80 22 A4 19 D7 5D' + '73 32 8E 91 3A 65 55 F5 47 CD 78 2E F6 98 51 A2 63 3C 71 C7 36 BB 1B D4 9C 73 78 77 8C 15 32 32' + '1C E1 CE E7 18 81 AB 09 86 46 D0 31 57 0C 3A 61 28 C2 43 30 40 AB 6A 00 5B 10 64 CB 32 E5 84 D3' + '21 A2 4B 81 4C 25 24 88 32 1A 26 8C 30 90 8A 43 01 4C 9C 3B B0 C0 1A E6 80 B8 71 CD AE B8 32 4D' + 'F7 E2 D6 6E 90 4C DA C8 85 80 24 61 87 2C CA 43 10 DB 6D F7 CC CB 26 88 05 41 03 7D AB 76 65 01' + 'CC 85 40 14 79 DB 64 B3 8E 37 E3 10 DB 7A 84 DB 68 50 41 83 0C 30 2C 48 5C 10 BC 50 01 70 CC 80' + '1D D5 F6 55 C4 16 8D EF 61 58 BB 9D 33 88 A3 AE 1D 2A EB 4B AD 92 D0 37 48 66 18 CD CC A0 6C 86' + '8C 37 60 2C C2 12 6A C4 33 20 15 BC C8 62 28 DE DD 1A 5B 4D 06 A9 55 1A EF BE F6 69 06 63 36 C5' + '40 58 61 C2 58 C0 58 55 E2 E4 0B 6D 2D 45 42 6F A3 33 9D 6E 8A 34 80 E3 19 42 53 6C 6D D1 D2 D2' + 'E8 10 6D 55 09 12 10 62 10 85 F4 3B 8F 2D F2 D1 3F E9 65 FE AF 37 D4 75 BE 03 72 68 F5 FE 63 DE' + 'CF DE 79 5F 4D FF 83 F9 72 FF 13 D8 7F A7 D3 C1 3A D7 E9 69 A7 77 8D 9B C1 6B B2 CE A6 8D 35 B4' + '69 4B BE B2 F8 EA 2C 36 D3 DD 3C 6A 8C AF CE B7 E7 6D A8 4B 9F 6D D6 E3 69 72 3E DB 9A 0C 82 B9' + '8E BC 75 FE 1A 7A D2 75 5A 1C 91 6E 71 95 D4 5E 26 D5 B8 99 CB 25 D2 17 BF 76 AE BB 15 E2 DA 2B' + '4B EE DA 7A DD 35 7D FB D2 6B EE 73 EC 52 C0 4F 74 A2 0E 36 16 6D BB 5B 7B 85 F6 EA CF 56 48 0D' + '59 53 A9 13 AC 2A 94 55 49 72 72 95 A1 6C 12 24 68 1D 63 69 2B 7E BF 4E 1B 33 B9 0A A4 3A 6F E3' + '7B 10 F3 C5 8C 10 8D E3 F2 31 6B 21 02 1D 1D 00 45 46 1B D1 73 A1 B2 D3 88 D1 E6 AB 77 43 AE 78' + '1E A3 D7 FA 82 B4 77 15 BB A7 22 C9 86 F1 D4 18 2F 47 93 08 68 31 9E BC 22 40 85 D1 10 08 01 04' + '21 19 88 24 46 82 34 08 46 60 B3 66 CE 43 30 D9 89 19 98 6D 1A 34 11 A3 41 1A 08 D2 48 91 9A 08' + '18 81 B3 11 98 61 B3 10 40 83 10 41 19 88 27 CA CE 48 8D 02 66 18 82 33 10 41 19 04 CC 30 82 0D' + '8B 26 4C 81 60 C5 88 20 82 C1 8B 20 58 31 62 08 20 82 C9 90 20 B0 64 08 2C 59 31 04 16 2C 59 49' + '60 C9 8B 26 0C 58 B1 64 30 20 B2 05 8B 10 41 19 88 40 84 10 2C 82 08 26 41 04 08 4C 99 02 10 41' + '31 64 08 4C 82 08 10 81 08 70 83 05 90 21 06 18 60 84 18 20 86 10 6C 82 0C 30 D9 32 04 30 C2 08' + '20 83 04 10 42 0C 30 83 0D 90 21 06 18 21 06 C8 20 83 8E 30 C3 34 1B 50 61 C7 90 38 C3 0E 3C 81' + 'C6 1F D0 1C 8B B2 20 00 06 A2 3D 60 00 11 21 23 58 00 04 15 6D F8 41 82 CC 4D 36 62 08 08 6C C6' + '66 37 FB 82 CC 26 20 FA 2B D8 AF 60 BD 6A B5 9A 43 2D 57 A3 A4 36 8E 8A 91 B4 24 8D A4 9F 43 3F' + '3D 42 74 E9 53 A5 49 9D 9B 98 8D 06 66 62 2C B4 12 46 45 97 95 E4 C9 F1 F9 32 32 32 72 0F 9F 3F' + '8A 7F 1B 0F 13 04 EE 1E 16 11 D3 98 18 37 D8 18 06 CD DF 9A BE BD BC BC BC 33 77 76 62 E4 CD C9' + '72 F6 D7 17 05 4B 5C 5A DB 5B 14 2C 56 D0 A9 5B 3B 4B 5A 9B 32 85 09 D9 93 B3 B1 26 4C 9F 83 C2' + '4E CA 38 C3 0D 1C A4 79 11 87 B7 91 1A 31 78 EE 21 41 71 01 CB E7 2D DF 38 D5 15 C0 6D D6 0A E0' + '51 5C 0A E1 C0 A2 B9 15 C8 AE 5C 0A 2B A7 02 B8 15 C8 A2 BA 70 2B 91 45 72 DC 57 02 8A E1 C0 B0' + 'B5 75 75 61 3E 7C FA 13 F7 EF DF BF 81 02 04 18 23 8E 3C 51 C7 1C 79 80 08 00 06 BA F1 46 4C C7' + '0F 81 E7 FF DE D3 73 FB 7A 5E 86 D3 A1 BB 81 9D 52 F9 F8 75 4C EA BC FC 5C FD DA 37 77 7C FE 7D' + '4B BB BC EA F9 6E ED D8 B5 CC E6 E5 DF BF 7F 99 9B 17 51 B1 C7 FE 0F 91 DD FB 6F 07 C6 F8 BD DD' + 'E5 D9 3C 3B AC 3B 43 24 F0 AC F0 0C CE 59 DA 98 EF 1C B4 38 62 E6 CE FE FE CC C5 99 A3 26 0A 1A' + '35 68 64 CD 99 A3 46 6D 49 98 35 73 62 6A E4 D5 8D C9 A9 06 24 5F 8E 6C C9 83 63 DB 97 39 7E 5E' + '4C 83 06 CC 9B 8B 0E F0 DD 8E 62 BC 0A EC 88 07 0D E3 3E C2 C1 18 FB EB 9F 22 FC 91 4F 49 4E 2C' + '7C 94 08 DE F9 23 E6 32 53 8B 17 33 35 DC 4C D7 49 86 88 9D E4 47 43 68 43 19 E2 A5 8B C4 88 F4' + '66 3A 0F 19 2A 6F 0C 31 9A 3C 68 34 58 82 B6 19 BC 41 9F 8C EE 04 68 70 A0 BF 7E 34 77 E3 42 91' + '1A 30 E3 8C 38 C3 8E 38 FC C0 00 F4 88 80 40 89 10 00 0F 48 F7 6C 49 E5 A8 BC 54 91 42 07 D2 26' + '31 59 45 41 9E 15 E8 17 21 A2 29 86 16 90 B5 4A 42 1A 67 42 D8 84 C3 2E E6 2C C0 80 53 86 16 32' + '4C 18 C5 DA 49 94 31 8A 32 C9 2D 94 DD 66 C9 2F 16 58 B0 94 CC 21 0C 55 04 59 25 63 16 5D E2 E4' + '98 42 65 99 BA 2B 14 49 77 41 0C 30 BB CD AC 99 49 0C 33 08 18 41 4C 92 4C 62 B9 58 13 16 CC 92' + '1B A3 AA E6 B7 3E 7F 5F E8 3F D6 F9 EA BB AD F3 47 A2 E3 FA 1E 87 95 E7 3C 5F 01 EB 7E 97 CB D9' + 'D8 17 F5 3A 38 39 5B FE 97 63 71 DF EA CB 70 0E 73 BE 03 FF 1F 2A B6 80 9D 67 C9 FA 7C 38 B4 9B' + '7D FF 43 B9 F6 4F F9 27 FB FD C3 9F C1 2C 89 59 FA F2 B2 9B C9 C3 7C BE 6C 68 F6 D3 1D B9 63 98' + 'F3 5D 2A 2E E2 1B 8E F7 12 CF B5 63 55 97 6D D0 EC 17 35 D4 B0 2A 6A 98 B7 8A C3 A7 75 35 91 41' + '51 73 6E 7C E5 3F CD E6 79 2F 9F A7 EE BD DF D4 EE FE 2E B3 57 D3 7C 5E 9F EE 6B 39 40 F0 AC 26' + '8D F3 DB 65 30 C9 BD B0 A9 96 65 21 B8 ED DB 5F C7 DD C1 DF D3 D1 F4 70 3F 3B FD C5 F1 AB DB CB' + 'BB BA 5B BB A3 25 E9 8B EC 7E 4E 9E E7 0B 71 F8 5C 6E 8A FD 1F B7 83 61 57 48 6B 71 3D B3 F7 B6' + 'FB C9 BF C6 FF AA EA 3D 7F AD F6 BE D3 F4 FD 8F 67 D9 74 78 DA 75 EF 7C DE EF DA 79 3C EF 99 F3' + '3B AF 95 CC A0 29 03 14 23 11 06 28 82 F1 3D 81 BD 5F 1F 8D 33 7E 2C 0D 33 26 4B F8 B7 E3 BD C4' + 'DC 1C 6E 4C 8A 5C AE 0E 4F 27 95 56 95 29 F4 EA 53 A9 83 95 66 C7 15 9D 16 76 6E 72 38 37 F7 B9' + '1C 1C 1C 1C 09 8A 83 37 5D FE C2 0A 04 BB FE 58 46 00 B2 45 21 04 60 0C 40 02 1B 6D 8F BF AD FF' + 'AF 73 E0 DA FA BB 16 33 A8 69 92 7E E8 F1 6A 78 A6 37 F3 12 AB 2A D1 D7 96 EA 54 2A 6A B2 5E F4' + 'FF 6D 1C BD 65 DE 45 FC F5 7D 82 AB FC EF 0D BF 5E 8B 49 9F 32 F6 90 FD DA 7B 0B B4 7D F4 15 44' + 'AF 6F FB B5 FD 9B 5B 50 6F 6D 4D A7 C6 B3 C1 57 AB 21 AC 10 83 77 7B DB 54 B6 E9 7E 52 F4 17 C7' + '6E B0 EF 72 FC 66 D5 5D E4 E4 B5 C3 C7 44 C1 82 F4 41 C3 09 E4 56 AD 9F A7 4C 85 CE 6E 9D 45 81' + '33 C7 ED F0 0D 93 29 92 EA 13 77 EF 9E 0A EE 24 41 62 43 81 0A 0C 78 EA 54 FA 86 08 90 20 05 5C' + 'D6 D3 81 B5 E0 12 9A D8 6C 7E 1F D6 AA 6B 6D C2 25 37 F0 6F F6 BF 0B 26 8D 1B 36 6C D9 B3 66 AF' + '9F 3E 7D AB AB AB 26 24 48 90 A1 C4 89 10 71 C7 1C 71 C7 E4 52 9A B3 E3 D1 F2 29 3F 8A 4E 3F F1' + 'D7 E5 75 F9 54 77 76 47 EF 25 78 BB DF D7 F5 E2 F0 38 7D 5A B3 96 F3 5D B3 97 1D 7F 0E 11 8A 72' + '67 6E AA 6D 0E DD D5 DA 9D BC ED 5A D6 15 EE 15 EF 16 EF 15 AE 2D 5E 58 ED EF 82 DC E9 AB 1A FB' + '04 8F DF BF 1A A4 64 E3 A8 6C C6 D0 A9 5B 52 A1 62 8A 28 87 51 3B D4 D4 D4 BA 35 88 93 41 6A D5' + 'AB 56 AD 5A 70 D2 D5 CF B0 B1 1E B5 C4 C6 D5 6D 05 E8 AE DE C1 16 04 18 30 20 41 1C 71 C7 89 16' + '14 38 71 62 44 8A 38 E3 8E 38 EC 9B BE 6C 2C 98 31 1D 3F 93 15 E3 F9 11 75 61 3C 7A F6 13 F9 31' + 'E2 47 1C 68 F2 47 1C 61 E3 8E 38 E3 F9 40 79 44 40 00 00 00 EB 11 02 60 89 00 00 DD CA 4A 4A 4A' + '4A 4A 4A 4A 4A 4A 4A 4A 4A 4A 4A 72 79 3C C9 69 6E 47 02 5E 5F 8F C7 E3 F1 38 BD 0E 87 16 5A 5B' + '8F 2D 2D 31 31 31 31 31 31 2D B3 DA 7B BB 4D A4 D4 EC EC EC EF C7 3B 43 43 FD A8 68 78 BC 4E 27' + '13 87 C3 E1 F0 B8 93 FF 6C A7 DB BC 32 63 F4 55 72 5C BA BB 8B 56 AB 6C D9 B5 B3 27 E1 AE F0 93' + '27 65 65 A7 31 E0 B1 B1 19 90 D2 46 A3 92 34 91 A4 B8 A7 92 33 AF 15 55 00 CE 68 A8 A8 E9 24 F9' + '3C 94 E3 54 65 8C 81 02 04 08 10 42 42 81 0A 11 51 22 89 06 1A 28 43 25 CD 4A 95 28 D0 D3 45 8F' + '1A FE FE 32 88 E7 30 24 8C 38 E9 56 AD C5 C6 CF D2 D0 D0 C8 D0 55 A3 DD 00 0A 72 20 10 59 E9 7F' + '3D FE F7 79 E9 7B 7E E7 E1 CF D7 48 8B 09 F8 B9 8E 5B 69 EB BA 3C CF 67 91 C6 FD 66 B9 DB 7F 8A' + '70 79 31 E2 C3 83 9F AA F5 DE CE 6D C4 D7 F7 FE F3 1D 5E A4 B7 E3 B9 DC EF 7F 6A 4E AC D7 44 69' + '32 23 C6 8B 12 1C 28 3F 9E F7 8D 51 4D D8 A6 E0 D3 76 29 67 3A DC 9E 3F 20 97 27 93 2F DE 1C 71' + 'C7 1C 71 C7 1C 71 FA 79 79 71 E3 E5 48 91 22 44 81 04 75 AA D5 A8 41 67 B9 73 45 A5 A5 A5 1A 33' + 'D7 AF 5E DF 5F 65 9A 43 7C 6A F7 C8 84 E2 0C 04 A8 52 A4 CD 3A 75 0E 6A 34 98 F9 B0 A1 42 BD C7' + '49 8D 8C 93 11 16 26 2E 66 12 3C CC EC E4 28 10 20 40 81 02 54 19 28 52 BF 87 16 34 6C D4 68 F3' + '73 52 B9 CE 20 06 F0 02 24 08 34 68 D1 A3 16 2C 58 88 20 8C C4 68 D3 FD 7A BD 5E 37 1B 91 C7 E4' + 'F2 7F F1 CC 18 30 E1 C3 86 28 AF 5E C2 85 0A 0C 28 70 E1 C6 8D 1B 6D 43 45 39 39 41 41 3D 3D 45' + '45 49 49 51 51 53 53 53 53 53 53 22 41 22 5F 8F E5 F9 6F 7A 7D 3E 9D 09 2A 19 14 34 53 F5 35 74' + 'F4 F4 34 35 75 75 75 49 AB 6B 53 1B 39 72 82 B1 7A 7A E1 58 5D 98 CB 16 E9 00 AC 6D 2F 4A 22 15' + '95 FA 34 80 84 95 E8 47 53 3D 4E F4 3C 6C F7 AA 5E B3 C8 D1 7B A4 F4 4C A5 4E 9A 32 7C 8A 36 47' + '8C E2 18 E8 B0 90 40 89 89 A2 26 61 E1 15 24 11 5F 8C 45 89 B2 D3 20 4C 0A 28 A9 D1 A7 CC 11 32' + '55 09 53 A9 52 1B 76 6D E2 BE D3 8E EA 43 69 0F 24 42 74 2C 88 6D 5E B6 6B 18 30 08 01 FF E2 EE' + '48 A7 0A 12 01 3D 19 B3 E0' +} diff --git a/3rdParty/JCL/source/common/JclUnicodeZLib.rc b/3rdParty/JCL/source/common/JclUnicodeZLib.rc index e7f9c36e..3b94fb9f 100644 --- a/3rdParty/JCL/source/common/JclUnicodeZLib.rc +++ b/3rdParty/JCL/source/common/JclUnicodeZLib.rc @@ -1,2672 +1,2672 @@ -/**************************************************************************************************** - - - ..\..\jcl\source\common\JclUnicodeZLib.rc - - - Produced by UDExtract written by Dipl. Ing. Mike Lischke, public@lischke-online.de - - -****************************************************************************************************/ - - -LANGUAGE 0,0 CATEGORIES UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE -{ - '78 DA DC DD 07 78 94 55 B7 36 FE 7B 65 52 A6 65 66 52 48 9D 30 33 09 21 A4 32 84 DE 43 2F 82 04' - '5E 15 B1 40 44 45 05 A4 28 76 94 08 36 B0 80 5D 14 05 5B AA 0A 58 10 95 12 15 C4 86 24 92 A2 08' - '12 40 51 10 42 E8 90 40 E6 3F CF BD 99 9C A1 E8 E1 3D E7 7C FF EF BB 8E D7 EF D2 A8 5C 58 26 3C' - 'FB D9 7B DD 6B 2F 3C 10 00 F4 01 AE 02 CA 80 6A E0 27 E0 57 00 A2 09 A0 40 0A 26 3D 19 C9 4C 16' - 'B2 51 38 45 52 14 C5 50 1C D9 A9 25 39 29 91 5A 51 6B 6A 43 69 94 41 59 E4 A6 6C EA 40 9D A8 2B' - '75 A7 9E D4 9B FA 50 3F 1A 40 83 68 28 0D A3 4B 29 97 46 D1 65 74 05 5D 49 57 D1 35 34 96 F2 68' - '3C DD 40 13 E8 66 9A 48 93 69 0A 4D A3 DB 68 06 DD 49 77 0B EE 11 DC 47 F7 D3 83 82 D9 82 87 E8' - '11 C1 A3 82 B9 82 C7 05 4F 09 9E 16 3C 2B 78 4E F0 82 E0 25 C1 22 C1 AB 82 C5 82 25 82 37 E8 2D' - '2A 10 14 0A 8A E9 1D 7A 4F B0 54 B0 5C F0 81 E0 23 FA 58 B0 52 B0 8A D6 D1 06 FA 96 36 D2 26 AA' - 'A0 CD 54 45 35 F4 33 FD 42 BF 52 2D ED A4 DF 68 37 FD 49 7B 69 1F D5 D1 41 3A 42 C7 04 27 04 0D' - '74 8A 9A 08 01 9A 00 0A A4 60 D2 93 91 CC 64 21 1B 85 53 24 45 51 0C C5 91 9D 5A 92 93 12 A9 15' - 'B5 A6 36 94 46 19 94 45 6E CA A6 6E 01 E8 1E 80 9E 01 E8 15 80 3E D4 2F 00 03 03 30 98 86 D2 30' - 'BA 94 A6 E9 34 B7 D1 9D 34 8B 1E A1 C7 74 98 A7 C3 13 F4 94 0E F3 75 78 5A 87 D7 75 78 53 87 52' - '1D 36 D1 8F 3A 54 EA F0 13 6D A1 AD F4 2B D5 D2 4E FA 8D 76 D3 9F B4 97 F6 51 1D 1D A1 E3 74 52' - '87 06 1D 4E EB D0 36 10 79 34 9E 6E A0 09 74 33 4D A4 C9 34 85 A6 D1 6D 34 83 EE A4 BB E9 5E 9A' - '49 0F 50 3E CD A3 27 E8 29 5A 40 CF D0 73 F4 02 BD 44 2F D3 22 7A 8D 96 D0 1B F4 16 15 50 11 95' - 'D0 3B F4 1E 2D A3 F7 E9 43 5A 41 2B E9 53 5A 45 6B A8 2C 10 9F 07 E2 4B 5A 4F 1B E8 1B FA 8E 36' - '52 39 FD 48 95 54 4D 3F D1 16 DA 4A BF 52 2D ED A4 DF 68 37 FD 49 7B 69 1F D5 51 3D 1D A2 23 74' - '8C 4E 50 03 9D A2 26 42 90 26 80 02 29 98 F4 64 24 33 59 C8 46 E1 14 49 51 14 43 71 64 A7 96 E4' - 'A4 44 6A 45 AD A9 0D A5 51 06 65 51 BB 20 5C 11 84 25 36 AC B7 61 03 6D A4 25 11 38 1A 81 05 76' - '7C 6A C7 6A 3B D6 DA 81 96 9A 00 0A A4 60 D2 93 91 CC 64 21 1B 85 53 24 45 51 0C C5 91 9D 5A 92' - '93 12 A9 15 B5 A6 36 94 46 19 94 45 6E CA A6 0E D4 89 BA 50 37 EA 41 BD 28 87 FA 52 7F 1A 48 83' - '69 28 0D A3 4B 29 97 46 D1 65 74 05 5D 49 57 D1 35 34 96 F2 68 3C DD 40 13 E8 66 9A 48 93 69 0A' - '4D A3 DB 68 06 DD 49 77 D3 BD 34 93 1E A0 7C 9A 4D 0F D1 23 F4 18 CD A3 27 E8 29 5A 40 CF D0 73' - 'F4 1A 2D A1 37 E8 2D 2A A0 22 2A A1 77 E8 3D 5A 46 EF D3 87 B4 82 56 D2 A7 B4 8A D6 50 19 7D 41' - 'EB E8 2B FA 9A BE A5 EF E9 07 2A A7 1F A9 92 AA E9 27 DA 42 5B E9 57 AA A5 9D F4 1B ED A6 3F 69' - '2F ED A3 3A AA A7 43 74 84 8E D1 09 6A A0 53 D4 44 7A 07 AC 0E C4 38 90 E0 40 1B 07 DA 3A D0 C5' - '81 DE 0E 0C 76 60 B8 03 63 E8 6A BA 96 C6 D1 CD 0E 4C 75 60 A5 03 9F 39 F0 B5 03 DF 39 F0 93 03' - 'BF 38 F0 A7 03 FB 1C 38 E1 40 A3 03 01 2E 4D 08 99 5C 08 75 C1 E6 42 B8 0B 2D 28 D6 85 04 17 5A' - '51 6B 6A 43 69 2E 64 BA E0 76 A1 BD 0B BD 5C E8 ED C2 00 9A 43 C8 40 56 06 F2 68 7C 06 6E C8 C0' - '4D 74 0B 4D A2 5B 33 30 2D 03 B7 D1 1D F4 40 06 F2 33 30 9B 1E A2 47 E8 31 9A 47 4F D0 53 B4 80' - '9E A1 E7 E8 05 7A 89 5E A6 45 F4 1A 2D A1 37 E8 2D 2A A0 22 2A A1 77 E8 3D 5A 46 EF D3 87 B4 82' - '56 D2 A7 B4 8A D6 50 19 7D 41 EB E8 2B FA 9A BE A5 EF E9 07 2A A7 1F A9 92 AA E9 27 DA 42 5B E9' - '57 AA A5 9D F4 17 ED A7 43 94 53 A0 E9 4B FD 69 20 0D A6 A1 34 8C 2E A5 5C 1A 45 97 D1 15 74 25' - '5D 45 D7 D0 58 CA A3 F1 74 03 4D A0 9B 69 22 4D A6 7C 9A 4D 0F D1 23 F4 18 CD A3 27 E8 29 5A 40' - 'CF D0 73 F4 02 BD 44 2F 53 62 A1 A6 15 B5 A6 36 94 46 19 94 45 D9 D4 81 3A 51 17 EA 46 3D A8 17' - 'E5 50 5F EA 4F 03 69 30 0D A5 61 74 29 E5 D2 28 BA 8C AE A0 2B E9 2A BA 86 C6 52 1E 8D A7 1B 68' - '02 DD 4C 13 69 32 4D A1 7B E8 3E BA BF 10 0F 14 22 9F 66 D3 43 F4 08 3D 4E 4F D2 02 7A 86 5E A0' - '97 E8 65 5A 44 AF D1 12 7A 83 DE A2 02 2A A2 92 42 BC 57 88 65 85 F8 B0 10 2B 68 25 7D 4A AB 68' - '0D 7D 41 EB 0A B1 A1 10 DF D0 51 72 79 D0 CD 03 EF AE 2F 25 50 96 05 CA E6 40 C9 37 CB FB 66 59' - '12 23 6B 63 24 67 8A 8C F3 6E 6C 2A 25 B6 52 3A 54 CA F0 4A B9 B9 52 1E AC 94 45 F4 5A A5 2C AE' - '94 37 E8 ED 4A 29 A8 94 E2 4A 79 A7 52 DE AB 94 8F 2A A5 BC 52 F6 54 4A 60 95 04 55 49 48 95 18' - 'AB 24 B4 4A 22 AB 24 AA 4A EC 55 D2 A5 4A BA 56 49 F7 2A E9 55 25 39 55 D2 BF 4A 06 D2 D0 2A C9' - 'AD 92 C9 55 F2 70 95 2C A9 92 4F AA A4 B2 4A F6 57 89 BE 5A 5C D5 D2 A3 5A 2E AF 96 69 D5 32 B7' - '5A 8A AA A5 AC 5A 76 56 4B 43 B5 D8 6B A4 43 8D 5C 51 23 53 6A 64 41 8D 14 D5 C8 B7 84 3D E2 DA' - '23 F2 B0 77 83 71 1D 70 2F F0 11 6D 07 8E 01 27 00 EF 7F B9 88 46 47 41 14 42 06 32 51 28 59 29' - '8C 22 A8 05 45 53 2C C5 53 02 39 C8 45 49 94 4C 29 94 4A E9 94 49 6D A9 1D B5 A7 8E D4 59 D0 45' - 'D0 8D 7A 50 2F CA A1 BE D4 9F 06 D2 60 C1 10 C1 25 34 9C 46 D0 48 FA 17 5D 4E A3 69 0C 5D 4D D7' - 'D2 38 BA 8E AE A7 1B E9 26 BA 85 26 D1 AD 34 95 A6 D3 ED 74 07 DD 45 F7 D2 4C 7A 40 90 2F 98 43' - '0F D3 63 F4 84 E0 49 C1 33 F4 3C 2D 14 BC 22 78 8D 5E A7 37 E9 6D 2A A2 12 41 A9 E0 5D 5A 46 1F' - 'D2 0A FA 44 F0 A9 60 B5 60 AD E0 2B FA 86 BE A7 1F A8 9C 7E A4 4A AA A6 9F 68 0B 6D 15 6C 13 6C' - 'A7 1D B4 8B 7E A7 3F 68 0F FD 45 FB E9 80 A0 5E 70 98 8E D2 49 6A A4 D3 E4 21 09 D0 E8 28 88 42' - 'C8 40 26 0A 25 2B 85 51 04 B5 A0 68 8A A5 78 4A 20 07 B9 28 89 92 29 85 52 29 9D 32 A9 2D B5 A3' - 'F6 01 E8 1A 80 1E D4 3B 00 39 01 E8 4B 83 68 08 5D 42 C3 69 44 00 9E 0D C0 F3 01 58 1A 80 E9 3A' - 'CD ED 74 17 DD A7 C3 FD 3A 2C A0 77 74 F8 41 87 72 1D 2A 74 A8 D2 A1 46 87 9F E9 17 DA 46 DB 69' - '07 ED A2 DF E9 0F DA 43 7F D1 7E 3A A0 C3 61 1D 8E D2 09 6A D4 E1 94 0E EE 40 8C 0B C4 75 74 3D' - 'DD 48 37 D1 2D 34 89 6E A5 A9 34 9D 6E A7 3B E8 2E BA 87 EE A3 FB 69 16 3D 48 8F D3 93 34 9F 9E' - 'A6 67 E9 79 7A 91 16 D2 2B F4 2A 2D A6 D7 E9 4D 7A 9B 0A A9 98 4A E9 5D 5A 4A CB E9 03 FA 88 3E' - 'A6 4F E8 33 5A 4D 6B E9 0B 5A 47 5F D1 D7 F4 2D 7D 4F 3F 04 62 53 20 2A 68 33 55 51 0D FD 4C BF' - 'D0 36 DA 4E 3B 68 17 FD 4E 7F D0 1E FA 8B F6 D3 01 3A 48 87 E9 28 1D A7 93 D4 48 A7 C9 43 12 A4' - 'D1 51 10 85 90 81 4C 14 4A 56 0A A3 08 6A 41 D1 14 4B F1 94 40 0E 72 51 12 25 53 0A A5 52 3A 65' - '52 5B CA 0B C2 63 41 28 B7 A1 C1 86 D3 36 78 6C 38 11 81 D3 11 C8 B7 E3 31 EF 06 37 01 E9 09 98' - '94 80 BB 12 70 4F 02 5E 4E 80 B4 D4 E8 28 88 42 C8 40 26 0A 25 2B 85 51 04 B5 A0 68 8A A5 78 4A' - '20 07 B9 28 89 92 29 85 52 29 9D 32 A9 2D B5 A3 F6 D4 91 3A 53 57 EA 4E 3D A9 37 F5 A1 7E 34 80' - '06 D1 10 BA 84 86 D3 08 1A 49 FF A2 CB 69 34 8D A1 AB E9 5A 1A 47 D7 D1 F5 74 23 DD 44 B7 D0 24' - 'BA 95 A6 D2 74 BA 9D EE A0 BB E8 1E BA 8F EE A7 59 F4 20 CD A1 87 E9 51 9A 4B 8F D3 93 34 9F 9E' - 'A6 67 E9 F9 96 78 B5 25 16 D3 EB F4 26 BD 4D 85 54 4C A5 F4 2E 2D A5 E5 F4 01 7D 44 1F D3 27 F4' - '19 AD A6 B5 F4 39 7D 49 EB 69 03 7D 43 DF D1 46 DA 44 15 B4 99 AA A8 86 7E A6 5F 68 1B 6D A7 1D' - 'B4 8B 7E A7 3F 68 0F FD 45 FB E9 00 1D A4 C3 74 94 8E D3 49 6A A4 D3 E4 F1 7E 3F 3B 60 73 A0 85' - '03 4E 07 52 1C 70 3B D0 D9 81 1C 07 06 38 90 EB C0 68 07 F2 1C B8 C9 81 69 0E DC EF 40 BE 03 8F' - '3A B0 C0 81 17 1D 58 E2 40 A1 03 CB 1C F8 D0 81 15 0E 7C EC C0 1A FA C2 81 75 0E 7C E5 C0 06 07' - 'CA 1D D8 EC 40 B5 03 35 0E D4 3A F0 87 03 87 1C 38 E2 C0 31 07 8E 3B 60 74 69 2C 2E 58 5D 88 A0' - 'B6 D4 81 BA 52 0F 17 7A BA 30 D0 85 21 2E 5C 4A 0F 91 3B 03 63 33 70 1D DD 98 81 09 19 B8 99 26' - 'D2 64 9A 4E B7 67 60 46 06 EE CC C0 7D 19 78 90 E6 D0 C3 F4 28 CD A5 C7 E9 49 9A 4F 4F D3 B3 F4' - '3C BD 48 0B E9 15 7A 95 16 D3 EB F4 26 BD 4D 85 54 4C A5 F4 2E 2D A5 E5 F4 01 7D 44 1F D3 27 F4' - '19 AD A6 B5 F4 39 7D 49 EB 69 03 7D 43 DF D1 46 DA 44 15 B4 99 AA A8 86 7E A6 5F 68 1B 6D A7 1D' - 'B4 2B 03 BF 65 60 1F D5 D1 61 42 26 92 33 91 42 99 D4 A7 40 D3 8F 06 D0 20 1A 42 97 D0 70 1A 41' - '23 E9 5F 74 39 8D A6 31 74 35 5D 4B E3 E8 3A BA 9E 6E A4 9B E8 16 9A 44 B7 D2 83 34 87 1E A6 47' - '69 2E 3D 4E 4F D2 7C 7A 9A 9E A5 E7 E9 45 5A 48 AF 50 52 A1 26 99 52 28 95 D2 29 93 DA 16 A2 5D' - '21 DA 53 47 EA 4C 5D A9 3B F5 A4 DE D4 87 FA D1 00 1A 44 43 E8 12 1A 4E 23 68 24 FD 8B 2E A7 D1' - '34 86 AE A6 6B 69 1C 5D 47 D7 D3 8D 74 13 DD 42 93 E8 56 9A 4A D3 0B 71 77 21 EE A5 99 34 8B 1E' - 'A4 39 F4 30 3D 4A 4F D0 53 F4 34 3D 5B 88 E7 0B F1 22 2D A4 57 E8 55 5A 4C AF D3 9B F4 36 15 52' - '31 2D A5 8F E8 63 FA 84 3E A3 D5 B4 96 BE A4 AF E9 5B 3A 46 0D E4 2E C5 55 A5 C8 2B C5 CD A5 98' - '56 8A B5 A5 40 23 82 1B 11 D1 88 E8 46 F4 F1 E0 2A 0F DA 04 CA 88 40 F9 29 50 1A 03 A5 CC 2C 87' - 'CC 52 16 23 DB 63 24 6F 8A CC 9A 22 71 95 D2 BE 52 2E AD 94 CB 2A E5 8A 4A B9 A9 52 66 57 CA 2B' - '95 B2 A2 52 3E A9 94 CF 68 75 A5 7C 59 29 EB 2B 65 53 A5 EC AD 14 5D 95 B4 AC 92 CE 55 32 AA 4A' - '26 55 C9 23 55 B2 B8 4A 3E AD 92 CD 55 52 E7 DD 43 57 4B 62 B5 74 AF 96 2B AA 65 6A B5 CC AB 96' - 'B7 AB E5 8B 6A D9 52 2D 5B AB 65 47 B5 9C AA 96 C8 1A 89 AA 91 F8 1A E9 54 23 97 D6 48 6E 8D 5C' - '5E 23 D3 6A E4 B1 1A 99 57 23 F3 6B A4 A4 46 BE A8 91 75 35 F2 4D 8D 7C 47 89 7B A4 DF 1E 09 30' - '02 58 2F 9A AF E9 3B 3A 44 8F 39 30 DF 81 97 1C 58 EC 40 91 03 4B 1D 58 45 DF D3 29 D2 79 B7 9F' - '80 0E 53 75 98 13 88 B9 DE 17 DF 20 AC 0E C2 5A FA 3C 08 5F 04 61 5D 10 D6 07 61 03 D9 82 11 17' - '8C 4B 82 31 2E 18 D3 A8 3A 18 5B 83 B1 3D 18 BF 05 E3 8F 60 FC 19 8C BD C1 D8 1F 8C B0 10 8D 3B' - '04 43 43 50 10 82 65 21 F8 2B 04 87 43 70 9A A2 F4 88 D5 23 5E 8F 24 3D 92 F5 48 D1 23 55 8F 4C' - '3D C6 E8 71 B5 1E 9B F5 D8 A1 C7 2E 3D 02 0C E8 46 3D A8 8F 01 83 0D 18 4E 23 0D 18 6D C0 78 03' - 'AE 37 E0 41 5A 45 9F 1B B0 CE 80 8D B4 D3 80 5D 06 34 91 18 E1 FD 9F D5 83 FA 18 D1 D7 88 41 46' - '0C 36 E2 12 23 86 1B 31 92 A6 19 31 DD 88 3B E8 41 23 66 1B B1 8A 3E 37 62 BD 11 1B 8C F8 DA 88' - '8D B4 D3 88 5D 46 34 18 E1 31 42 4C 9A 1E D4 9B FA 98 D0 DF 84 E1 74 B9 09 57 98 30 DE 84 EB 4D' - '98 4D 65 B4 91 60 D6 04 52 2F 33 72 CC 18 68 C6 60 33 86 9A 31 DC 8C CB CD B8 C2 8C F1 66 5C 6F' - 'C6 83 B4 8A D6 D2 57 F4 BD 19 1B CD D8 69 C6 2E EF 4F 15 0A 09 45 F7 50 F4 08 45 9F 50 F4 0F C5' - '70 1A 1F 8A EB 43 F1 20 7D 4B 3F 86 A2 32 14 D5 D4 CE A2 E9 60 41 37 0B 06 59 70 A9 05 CB E9 43' - '0B 56 59 F0 B5 05 1B 2D 88 B1 22 D6 8A 8E D4 99 BA D2 74 2B 1E B0 22 DF 8A 87 AC 78 C4 8A 47 AD' - '78 D2 8A 17 AD 58 68 C5 2A 2B BE A2 4C 1B DC 36 64 DB D0 D9 86 AE 36 74 B3 A1 A7 0D BD 6C B8 D2' - '86 31 36 8C B5 21 CF 86 E9 36 CC B0 61 36 3D 6C C3 23 36 3C 49 AF D2 B5 11 18 17 81 F0 68 44 46' - '23 3B 1A 1D A2 31 2A 1A FF 8A C6 6D D1 B8 3D 1A 1F 46 E3 A3 68 7C 1C 8D D5 D1 F8 8A BE 89 C6 E6' - '68 6C 23 53 0C 42 63 F0 70 0C 1E 89 41 31 39 63 91 18 8B 94 58 B4 89 45 36 75 8D 45 F7 58 44 C7' - '21 26 0E F1 74 05 5D 19 87 B1 71 C8 A3 F1 74 63 1C 26 C7 E1 F6 38 CC 8C C3 2C 5A 16 87 B2 38 20' - '1E BA 78 74 A0 4E F1 E8 16 8F 1E D4 97 26 C5 E3 F6 78 E4 C7 E3 C1 78 BC 11 8F B7 E3 51 14 8F E2' - '78 94 C6 E3 DD 78 EC A6 3F E3 B1 27 1E FB E9 40 3C 0E C6 23 C3 8E F6 76 74 B2 A3 B3 1D E5 76 FC' - '68 47 A5 1D B5 76 EC B4 E3 4F 3B F6 D3 11 3A 61 C7 49 3B CA 12 70 32 01 8D 09 F0 24 A0 DC 89 7A' - '27 0E 64 E0 60 06 66 65 6A 6A 33 E1 C9 44 9A 1B 99 6E 2C 74 E3 65 37 A6 16 E0 B6 02 CC 28 C0 FD' - '05 78 AD 00 8B 0B 50 5F 80 83 05 08 28 D2 04 93 89 92 8B D0 BA 08 19 B4 AE 08 EB 8B 50 5B 84 83' - '45 F0 50 EB 62 64 16 63 50 31 46 16 23 BF 18 B3 8B F1 01 AD 28 C6 27 C5 58 55 8C D5 C5 F8 9D 52' - '4B 90 55 82 76 25 C8 2E 41 C7 12 74 2A 41 3F 1A 46 33 69 19 BD 5F 82 0F 4B F0 71 09 56 96 60 4D' - '09 D6 96 E0 73 DA 57 82 FD 25 38 46 BF 97 6A FE A4 FD D4 B2 51 83 26 58 9B E0 6C 42 DB 26 9C 16' - 'F1 AA 0D D0 DC A9 93 7B 75 22 46 D1 19 25 C8 28 C1 46 31 1B C5 6A 94 2E 46 E9 66 94 DE F4 BB 51' - '76 1B A5 55 A8 A4 84 4A A9 45 DE B1 C8 40 AB E4 5A 45 6C 9A 2E 36 19 68 93 59 36 79 D0 26 1F D8' - '64 85 4D 3E B1 C9 A7 36 ED 64 31 20 4C 52 C2 24 3D 4C 32 C3 A4 43 98 DC 4E F9 61 F2 60 98 AC 08' - '93 35 61 F2 4D 98 7C 1F 26 9B A8 6D B8 B4 0B 97 0E D4 29 5C 3A 87 4B 2F DA 4E BB C2 65 6F B8 76' - '4E 29 11 D2 3D 42 7A 44 48 0E 4D 88 90 C9 11 32 2D 42 66 44 48 97 48 E9 1D 29 7D 23 A5 7F A4 0C' - 'A4 B1 F4 41 A4 AC 8C 94 4F 69 6D A4 94 45 CA 17 91 F2 65 A4 BC DF 42 3E 6A 21 AB 5A C8 EA 16 B2' - 'B6 85 94 B5 90 AD 2D 64 5B 0B 69 1F 25 DD A2 A4 27 F5 8E 92 9C 28 29 A5 77 69 59 94 7C 14 25 1F' - '53 42 B4 38 A2 25 31 5A 92 A3 25 25 5A D2 A3 A5 6D 8C 74 8E 91 AE 31 D2 2D 46 BA C7 4A 8F 58 E9' - '45 FD A8 32 56 6A 62 65 4B AC FC 12 2B B5 24 71 62 8C 93 F6 71 D2 25 4E BA C7 49 AF 38 19 44 23' - 'E3 E4 8A 38 19 13 27 57 C7 C9 BC 38 79 21 4E 5E 8A 93 85 71 E2 B6 4B 27 BB 74 B1 4B 4F BB F4 A6' - '67 EC 52 68 97 12 BB 2C B3 CB FB 76 F9 C0 2E 1F D9 65 85 5D DA 25 48 A7 04 E9 46 3D 12 A4 67 82' - 'F4 4E 90 01 09 32 88 16 24 C8 D3 09 F2 3C BD 48 87 5B CA 91 96 52 3F 51 8E 4C 14 F7 24 E9 34 49' - '46 4C D5 CC 9F 2A CF 4C 95 DF E8 D5 55 F2 DA 2A B9 A9 42 6E A9 90 FB 2A 64 76 85 3C 5C 21 8F 57' - '48 49 85 BC 5B 21 7D 7F 94 FE 3F 6A A7 8C 9D B6 48 F7 2D 32 79 8B DC 41 0F D1 2B 5B 64 F1 16 79' - '7D 8B 2C DD A2 C5 6E 82 6B 45 5F 2B 31 B5 12 5F 2B AE 5A 49 AA 95 56 B5 D2 BA 56 D2 6A C5 BD 43' - '3A ED 90 7D 3B E5 C0 4E 29 FF 53 AA FF 94 FE 7B 64 E8 1E 81 58 0E 88 25 70 A9 B6 36 1B 34 DD A9' - '97 01 39 06 0C 31 60 98 01 97 1A 30 C2 80 D9 06 CC 31 60 8D 01 65 06 6C 30 E0 6B 03 BE 33 E0 7B' - '03 6A 48 67 D4 F4 32 22 C7 88 39 B4 C6 88 32 23 BE A1 EF 8C F8 DE BB 2A 9A A0 33 A1 17 E5 D0 20' - '13 06 9B 70 89 09 C3 4C 18 4D 6B 4C 58 6B C2 E7 26 7C 61 C2 57 26 7C 6D C2 B7 26 7C 6F 42 0D 89' - '19 3A 33 FA 98 D1 DF 8C D9 66 CC 31 63 0D 95 99 B1 CE 8C 0D 66 7C 6D C6 B7 66 7C 67 46 95 19 D5' - '66 04 84 42 17 8A 5E A1 C8 09 C5 C0 50 0C 0E C5 D0 50 0C 0B C5 68 9A 1D 8A 39 A1 D8 14 8A 8A 50' - 'FC 14 8A ED A1 38 14 8A C3 DE 1F 6F 45 6F 2B 66 51 BA 0D 19 36 B4 A3 2E D4 DD 86 1E 36 5C 61 C3' - '68 1B C6 DB 70 83 0D 37 D9 70 AB 0D 73 6C 78 C8 86 47 6D 78 C2 86 F9 F4 B2 0D 8B 6C 58 11 AD 59' - '13 8D F5 D1 D8 10 8D AF A3 91 14 8B D6 B1 48 8D 45 7A 2C DC B1 68 17 8B F6 B1 E8 12 8B D8 38 C4' - 'C5 E1 72 1A 4D D7 D1 F5 71 B8 21 0E B7 C6 E1 B6 38 04 C6 6B 3A 52 77 EA 19 8F 3E F1 E8 17 8F FE' - 'F1 98 4D AF 53 41 3C 0A E3 51 42 7F D0 DE 78 EC 8B 47 1D 1D 8A C7 E1 78 B4 B2 23 DD 8E 0E 76 74' - 'B4 63 07 1D A7 2C 37 DA BA 91 54 84 56 45 48 A1 FC 22 3C 58 84 0F 8B F0 65 11 46 15 E3 5F C5 98' - '43 1F 16 E3 A3 62 7C 5A 8C CF 8A B1 A6 18 65 C5 68 5B 02 77 09 DA 97 A0 43 09 86 D3 7D 74 3F FD' - '45 75 25 38 50 82 A3 B4 AB 14 BF 95 62 77 29 FE 28 C5 9E 52 EC 2D C5 3E 52 31 C2 00 9A 4D CB 6C' - 'F2 BE 4D 3E B6 C9 4A 9B 64 84 69 06 84 C9 C0 30 99 4D 1F 84 C9 47 61 B2 36 4C CA C2 E4 07 CA 08' - '97 AC 70 C9 0E 97 F6 E1 D2 91 6A C3 65 67 B8 04 44 88 2E 42 7A 45 48 EF 08 E9 13 21 FD 23 64 50' - '84 0C 8E 90 4B 22 64 78 84 8C A6 F1 11 72 7D 84 74 8C 94 CE 91 92 13 29 7D 22 65 00 2D F3 3E E1' - '22 E5 13 FA 2C 52 D6 44 CA E7 B4 B4 85 2C 6F 21 2B 5B C8 67 2D 64 0D B9 A3 24 3B 4A BA 47 49 8F' - '28 E9 45 EF D0 7B 51 B2 34 4A 56 90 33 5A 5C D1 D2 9A 32 62 24 2B 46 BA 90 3B 56 3A C6 4A E7 58' - 'E9 12 2B 3D 29 87 FA 52 45 AC 6C 8E 95 AD B1 B2 3D 56 7E A3 AE 71 9A D1 71 72 65 9C BC 48 6D ED' - '9A 5E 54 4C CB E9 43 9A 97 20 4F 25 C8 B3 09 F2 5C 82 BC 40 47 5B CA B1 96 32 72 AA 3C 3A 55 EA' - 'A7 CA C1 A9 72 63 85 4C A8 90 5B 2B E4 B6 0A 09 0A F2 3E 1E 1E E3 5B FB 9A 38 CD 36 27 6A 9D D8' - 'E9 C4 6F 4E 4C E3 EA 1E DC D3 FB 43 DC 40 57 20 2F 18 B7 04 A3 3E 18 27 83 51 16 82 6F 42 30 C1' - '80 A9 06 EC 36 E0 80 01 13 8C 98 6A C4 6E 23 0E 18 31 C1 84 A9 26 EC 36 E1 80 09 13 CC 98 6A C6' - '6E 33 0E 98 31 21 14 53 43 B1 3B 14 07 42 91 6B C1 18 0B CA 2D F8 D9 02 A7 15 A9 56 E4 D8 30 C4' - '86 05 36 2C B4 A1 36 1A 7B A2 61 8B 41 6C 0C 06 C6 62 44 2C CA 63 F1 73 2C F2 E3 30 37 0E 0B E2' - 'B0 30 0E B9 F1 18 13 8F 65 F1 F8 24 1E 39 76 0C B1 23 D7 8E 31 76 38 0B 90 5A 80 F2 22 FC 5C 04' - '14 C3 50 8C F2 62 FC 5C 8C FA 62 9C 2C 46 6E 09 C6 94 A0 BE 14 27 4B 61 F3 20 D6 83 25 81 52 1C' - '28 EE 50 E9 1A 2A 13 6C 32 D5 26 F5 36 39 69 93 4E 61 D2 3B 4C CA C3 E4 E7 30 A9 0F 97 93 E1 92' - '1B 29 63 22 A5 3C 52 7E 8E 94 DC 28 19 13 25 65 51 F2 4D 94 B8 A3 A5 6B B4 D4 C6 C8 9E 18 C9 8D' - '95 31 B1 92 6B 97 31 76 C9 4D 90 31 09 B2 24 41 8A 13 24 6F A2 DC 32 51 72 27 C9 98 49 F2 43 8D' - '78 6A 24 67 87 0C D9 21 F5 3B E5 E4 4E C9 DD 23 63 F6 48 7D A3 9C 6C 94 10 EF 7B 38 EA A2 50 1F' - '85 3C 17 66 BB F0 B0 0B 8F B9 10 E2 D6 B8 DC 48 75 A3 8B 1B DD DC D8 5D 80 03 05 C8 11 99 21 D2' - '47 A7 19 4A 15 3A A9 D2 69 81 DB 29 AD 44 3F C8 FB 93 BD 0F 7C 00 7C 42 AB 80 35 C0 11 03 4E 1A' - '70 9B 09 77 99 50 6F C2 21 13 EE 36 E3 01 33 AE 0C C5 D8 50 4C 0B C5 DD A1 48 B3 A2 BD 15 B7 44' - '60 66 04 EA A3 71 32 1A 5B 62 35 D3 9C 9A 19 4E DC E3 44 BE 13 73 9D C8 75 61 9C 0B 73 29 AF 15' - '5E 69 85 BD AD E0 69 85 3B 53 F0 6C 0A 4E 67 68 9E 69 87 E7 DB C1 99 8D D4 6C 0C CE C6 88 6C 8C' - 'CC C6 B8 6C E4 67 63 6E 36 96 67 63 6D 36 DC 45 E8 58 84 10 91 F6 22 77 88 DC 2D 32 4F E4 71 91' - '1D 01 D2 18 20 4E 9D 24 E9 E4 4A BD 8C D3 CB 3D 7A 99 A5 97 42 BD 2C D5 4B A3 5E 3C 7A 89 32 48' - 'BC 41 56 19 64 B5 41 CA 0C B2 C9 20 3F 1A C4 63 90 1C A3 0C 36 CA FD 46 79 C0 28 AF 1A 65 B1 51' - 'FE 32 CA 01 A3 5C 69 92 71 26 B9 DB 24 B3 4C 52 6C 92 A5 26 69 30 8B C7 2C 79 16 79 C0 22 09 56' - '69 6D 95 91 56 B9 CC 2A EB AD F2 9D 55 46 D9 E4 46 9B EC 08 93 23 61 D2 2D 5A BA 47 CB DE 18 39' - '14 23 57 D9 65 B2 5D CA 1C 52 E9 90 AB 27 C9 75 93 24 7F 8A BC 30 45 6A 7F 94 C3 3F 4A DE 66 B9' - '7B B3 6C F8 53 36 FD 29 D3 F7 49 E9 3E 79 77 9F 2C DD 27 CB F7 C9 87 FB 44 F6 4B E6 7E 69 BB 5F' - '7A EE D7 D2 B2 E6 83 62 08 F1 7E 5C 4E 5A 42 F9 51 1A EF 9F 1B 9D 68 4B E3 48 FB 35 E9 D6 12 DA' - '40 1B A7 C6 A4 FD 5A 36 52 28 A9 B8 DD C3 94 EA D4 98 03 C0 DF 1C C0 2C 60 B1 F7 47 45 7A FF EC' - '5D 42 30 82 82 61 A7 6D 64 0D D1 EC D4 6B 2C 31 1A 93 13 56 27 D2 9C C8 72 22 CF 89 1B 9C 98 E0' - 'C4 54 27 3C 4D 9A 93 1E 34 7A B0 DA 26 5E 1B C9 DD 41 BA 74 90 25 AB E4 CD 55 72 7B 85 DC 5B 21' - '2A 4A EE 84 65 16 2C 16 ED DF 1D 3F C1 B3 1D 56 9D F6 65 2D 3C 27 BC 7F B0 9E F6 58 BD AB C4 69' - '8F 2D 4C 7B F6 2C 0B C0 E7 01 F8 2A 00 15 01 A8 0D C0 6F 01 D8 47 75 34 43 A7 B9 97 C6 04 69 72' - '82 35 BF 07 63 77 30 8E 84 E0 68 08 1A 28 4E AF 69 45 6D 68 BA 41 33 D0 A2 F9 8A 4E D9 34 35 D1' - '9A 7E 31 9A C2 38 CD DD 76 DC 6F 47 46 02 26 26 E0 6E 7A 25 01 6B 13 30 DD A9 99 45 0B 9C 58 E4' - 'C4 CC 0C DC 9F 81 A9 99 9A B6 59 9A 20 B7 A6 9D 1B 1D DD E8 4E AF BA F1 9A 1B A7 DC 68 72 A3 C5' - '12 CD 89 B7 70 FA 2D 98 0B 34 B3 68 51 01 5E 2D 40 74 21 1C 85 98 46 8F D1 89 42 9C 2C C4 A6 62' - 'CD 6E 9A 56 A2 D9 46 87 4B 70 A4 04 D7 94 62 5C 29 6E A1 69 1E CD 6B 1E 2C F6 20 67 92 F4 9B 24' - 'CF 4E 95 C5 53 A5 76 AA EC 98 2A BB A8 F3 0E E9 B9 43 2E D9 A3 09 F7 BE 39 A2 84 3E A5 CF 44 53' - '26 F8 52 F0 5C 80 A6 3C 08 7B 83 70 20 08 87 82 E0 0C 46 EF 60 F4 09 C6 D0 60 4C 09 C6 D4 60 4C' - '0F C6 E6 60 54 51 5D 30 0E 04 A3 21 18 A7 82 E1 21 5B 88 26 3C 04 6D 43 30 3C 04 6F 87 60 39 7D' - '1B 82 BD DE EF 7C 3D 5A E8 91 A3 C7 95 7A E4 E9 31 51 8F 25 7A 7C A8 C7 0A 3D 36 E8 11 68 40 57' - '03 7A 52 2E 5D 69 C0 75 DE 87 98 01 F9 06 3C 6C C0 13 06 CC 37 60 81 01 CF 1A 50 64 40 89 01 CB' - '0C 78 9F 56 18 F0 89 01 AB E9 07 DA 6A C0 36 03 B6 1B B0 C3 80 7A 03 0E 1A 70 8A 82 8C 30 1A 61' - '35 C2 66 44 84 11 6D 8C 48 33 C2 6D 44 B6 11 ED 8D E8 68 44 27 23 BA 18 D1 D5 88 31 46 5C 63 C4' - '58 BA CD 88 19 46 3C 6C C4 93 46 CC 37 E2 69 23 9E 35 A2 C8 88 12 23 96 19 F1 BE 11 1F 18 F1 91' - '11 9F 18 B1 9A CA A9 D6 88 1D 46 9C A4 20 13 CC 26 58 4D B0 99 10 61 42 1B 13 D2 4C 70 9B 90 6D' - '42 7B 13 3A 9A D0 D5 84 9E 74 8D 09 D7 9A 30 CE 84 EB 4C 98 4E 73 E8 61 13 E6 99 F0 94 09 0B 4C' - '78 C6 84 E7 4D 58 68 C2 CB 26 2C A2 D7 4C 58 6C C2 9B 26 BC 65 42 91 09 25 26 BC 67 C2 27 26 94' - '53 90 19 66 33 2C 66 D8 CC 08 37 A3 8D 19 69 66 74 35 A3 27 5D 69 C6 55 66 E4 99 71 9D 19 F9 F4' - 'B0 19 4F 98 F1 94 19 0B CC 78 C6 8C 22 33 4A CC F8 C0 8C 8F CC F8 C4 8C D5 F4 2B D5 9A B1 C3 8C' - '83 66 1C 32 23 30 14 E6 50 58 42 61 0B 45 78 28 BA 85 A2 27 5D 4A 97 85 E2 8A 50 8C 0B C5 75 A1' - 'B8 37 14 B3 42 F1 70 28 5E 08 C5 CB A1 58 1E 8A 0F 42 F1 59 28 56 53 59 28 BE 0A F5 6E 70 E0 B6' - '20 DB 82 F6 16 E4 58 30 C0 82 07 2D 98 6D C1 43 F4 88 05 F3 2C 78 C2 82 37 2D 78 9B 0A 2D 58 66' - 'C1 FB 16 7C 60 C1 6A 2A B3 60 9D 05 5B 2D D8 6E F1 3E 76 34 39 56 0C B2 62 88 15 93 AD 78 CC 8A' - '27 B4 07 11 D2 6C E8 4D B9 36 5C 6E C3 55 36 5C 6B C3 75 74 A3 0D 13 6C 98 62 C3 34 1B EE B0 E1' - '41 1B 9E 22 84 61 70 38 86 86 63 78 38 72 C3 71 45 38 AE A4 AB C2 71 6D 38 F2 C2 F1 58 38 E6 85' - 'E3 C9 70 2C 08 C7 B2 70 BC 1F 8E 8F C2 B1 32 1C 6B C2 51 46 5F 84 63 7D 38 BE 0E 47 75 38 7E 0A' - '87 2D 02 E1 11 68 11 81 98 08 5C 15 81 FC 08 CC 8F 80 44 62 72 14 A6 46 61 56 14 1E 8C C2 CB 51' - '58 12 85 BD 51 38 18 85 13 DE 35 23 1A E6 68 58 A2 11 16 0D 67 34 DA 45 23 27 1A 23 A3 91 17 8D' - 'C9 D1 98 12 8D 69 D1 C8 8F C6 07 D1 D8 4A CE 18 F4 8D 41 FF 18 DC 1D 83 FC 18 3C 14 83 47 63 50' - '14 83 12 5A 16 83 A3 31 40 2C 5A C6 22 37 16 B7 7A 5F 03 62 31 C3 FB 42 16 8B D2 58 2C 8B C5 37' - 'B1 40 1C A2 E2 E0 8C C3 65 71 08 8A 47 FB 78 0C 88 C7 25 F1 98 13 8F 25 F1 78 2F 1E 4B E3 F1 69' - '3C 7E 8F D7 16 A7 24 3B 86 DB 31 C2 8E AB EC B8 CB 8E 3D 76 EC B3 A3 CE 8E C3 76 1C B5 E3 98 1D' - '0D D4 D1 85 2E 2E B8 33 71 53 26 F2 33 F1 42 26 96 64 A2 20 13 45 99 78 2F 13 CB 32 B1 22 13 2B' - '33 B1 26 13 65 99 F8 2A 13 5F 67 E2 87 4C 94 67 A2 3A 13 3F 65 E2 D7 4C 04 BB 35 3D A8 8F 1B 2F' - 'B8 B1 98 5E 77 A3 C1 0D 0F 05 B5 43 DB 76 68 D7 0E 4F B5 C3 92 76 58 DB 0E F5 ED E0 69 07 74 C0' - 'DA E1 C0 A5 38 B5 58 5B 8D 23 97 20 6A 09 9E 78 0B E5 6F E1 F8 5B C0 DB 30 15 C0 56 00 47 01 D2' - '0A 90 5E 80 29 B4 A4 00 BF 17 60 7E A1 E6 38 35 16 42 8A A0 2B 42 90 F7 F5 A6 08 C6 22 98 8B 90' - '58 84 9C 22 DC 5E 84 D9 45 F8 A0 08 87 8A 70 BC 08 8D 74 BA 08 4D DE 1F 56 8C E4 62 B8 8B 31 B0' - '18 79 C5 98 59 8C 87 8A F1 7E 31 6A 8B F1 5B 31 FE 28 C6 81 62 34 14 A3 A9 58 7B 5E B7 29 41 4E' - '09 FA 96 A0 7F 09 2E 29 41 5E 09 A6 96 60 7A 09 EE 2C C1 BD F4 40 09 96 96 60 39 7D 54 82 15 25' - 'F8 A4 04 AB 4B 50 46 5F D0 2F 25 D8 5A 82 DA 12 EC 2D C1 21 92 52 04 97 C2 50 0A 4B 29 C2 4A 11' - '55 0A 67 29 5A 97 A2 4D 29 B2 4A 51 56 8A 9D DE 2D DD 3B 78 B3 06 CB 6A F0 55 0D BE AB 41 63 0D' - '70 12 B7 36 60 5A 03 7E 6E 40 42 A3 C6 D1 88 36 8D 48 6B 44 A7 46 74 69 44 8F 46 F4 A2 9C 46 F4' - '69 44 BF 46 F4 6F C4 C0 46 2C 6F C4 E6 46 F4 3C 8D DC D3 98 7F 1A CF 9C C6 86 D3 A8 3F 8D C6 D3' - '98 D6 84 19 4D B8 B3 09 A7 9A 30 C1 83 A9 1E 4C F7 E0 55 EF EB BB 07 6B 3C F8 C2 83 0D 1E 7C EB' - 'C1 26 0F 7E F4 A0 C6 83 2D 1E 6C F5 68 5D 6E 26 ED 4C 5B 5A 43 DA 40 BA 41 7A 40 7A 42 7A 43 86' - '43 72 21 D7 42 F2 21 0D DE DF 07 C8 A2 00 59 12 20 E5 01 5A 26 D0 A1 93 4C 9D E4 E8 A4 AF 4E 86' - 'E8 24 57 27 77 E8 24 5F 27 AF EA 64 89 4E BE D4 C9 D7 3A D9 E4 FD EB 81 F2 6A A0 96 1E 4C 09 12' - '77 90 5C 1F A4 B5 D0 75 0A 91 9C 10 B9 3C 44 F2 42 E4 A6 10 AD 9D 2E 48 2F 7A 32 EA A5 A3 5E 3A' - 'EB A5 8B 5E 7A 50 6F BD 5C AE 97 3C BD DC A9 97 7C BD BC A6 97 5A BD 1C D2 CB 11 BD 1C D5 6B 59' - 'C4 16 06 71 1A A4 AB 41 F2 0D F2 B1 41 D6 18 64 AD E1 4C 7F 9E CD 28 11 46 69 61 94 68 A3 C4 1A' - 'A5 A3 51 F2 8C 32 D3 28 F9 46 59 64 94 32 A3 6C 30 CA 37 46 F9 CD A8 A5 19 3B 9A 24 C7 24 97 9B' - '24 CF 24 B7 99 24 DF 24 4F 9B B4 F6 BE C1 66 2D E5 98 14 2A F9 16 29 B6 C8 32 8B 2C B7 68 89 47' - 'BB 55 52 C8 6D 95 01 56 59 66 95 75 56 A9 B5 CA 31 AB E8 6C D2 D9 26 73 6C B2 D4 26 E5 36 F9 D3' - '26 BA 30 69 1D 26 FD 69 10 E5 86 C9 6D 61 72 27 CD 09 93 F7 C3 E4 F3 30 59 17 26 5B 68 2B 21 5C' - 'C2 C2 25 22 5C D2 C3 25 3F 5C 1E 09 97 C7 68 5E B8 3C 19 2E F3 C3 E5 D5 70 59 1C 2E 45 E1 B2 2C' - '5C 7E 0D 97 A0 08 31 47 88 35 42 6C 11 12 11 21 6D 22 24 2D 42 DC 11 92 1D 21 ED BD DB FA 08 E9' - '1A 21 3D 29 97 AE 8D 90 EB 22 B4 56 C5 0E 91 32 28 52 86 46 CA B8 48 B9 2E 52 F2 BD 3B FB 48 59' - '17 29 EB 23 65 03 E5 B7 90 F7 5A C8 4F 2D E4 97 16 5A 53 63 DB 28 E9 4F F9 51 52 12 25 2B 09 D1' - '12 17 AD 35 3B A6 C7 88 27 46 82 63 C5 40 E6 58 89 88 95 16 B1 12 15 2B 31 B1 D2 36 56 7A 53 1F' - '5A 12 2B 85 B1 52 12 2B E5 B1 B2 83 76 91 EA 98 34 C5 49 76 9C 74 A3 5C BA 26 4E E6 C6 C9 AB 54' - '16 27 27 D8 55 A9 B7 8B D1 2E 59 76 C9 A1 DB EC 32 DF AE 65 4D 83 13 44 9F 20 86 04 31 25 88 3B' - '41 06 52 5E 82 DC 98 20 37 25 C8 CD 09 32 31 41 E6 26 C8 4B 54 DB 52 0E B5 94 65 0E 0D 9C B2 30' - '49 F2 5B 49 BF 64 AD ED 32 AB 83 96 23 1D 38 50 6B 70 EC 32 51 72 26 CA D8 89 52 3E 51 F6 4F D4' - 'D2 9E 6D 27 C9 F5 93 E4 AE 49 72 FF 24 99 3F 49 CB 7C 0E 9D 2A B9 84 69 72 FC 51 2D C9 59 C5 24' - 'A7 FE 49 2D 8D D9 72 B9 E4 2E 97 51 CB E5 86 E5 72 D3 72 99 B6 5C 1A DF D7 9A 11 27 AE 92 69 AB' - '64 E6 2A C9 5F 25 8F AD 92 05 AB 64 E1 2A 2D 57 99 B1 43 2E A5 B2 9D F2 D7 4E AD A1 70 DD 9F 5A' - '13 A1 AE 4E 82 EA C4 51 27 AE 3A 49 AC 93 56 94 42 A9 75 92 5D 27 1D EA A4 73 9D 74 A5 EE D4 97' - '06 D1 10 BA 84 86 D7 C9 88 3A 19 59 27 A3 EA E4 32 1A 4D 63 E8 6A BA 96 C6 D1 75 75 32 BE 4E 6E' - 'A0 9B EA 64 62 9D 4C AE 93 DB EA 64 46 9D DC 55 27 F7 D4 C9 CC 3A 79 80 F2 EB 64 6E 9D 3C 5E 27' - 'AF D4 C9 EB 75 F2 66 9D BC 5D 27 C5 75 52 5A 27 9F D5 69 3D 8E DB 0A 02 50 18 D0 E1 E3 80 9C 8F' - '03 12 56 06 38 57 06 BC FE 43 C0 B2 1F 02 6A FF 0A C0 89 80 84 06 EF AE 4C 37 34 42 17 11 EC 7D' - '58 8D A3 DE 4E E4 38 71 19 B5 6F 42 87 26 0C 6F C2 88 26 F4 F6 68 22 BD 6B 3B 32 69 5E 90 66 0D' - '21 52 13 1C A3 B1 39 D1 C2 89 7F D1 7D F4 38 85 27 6A A2 B3 34 71 D4 2D 0B DD B3 90 43 76 B7 C6' - '4D 4B A8 5D 13 B2 9B 70 25 5D 4F A1 1E CD BB 16 F1 6A 71 89 B6 FB A4 AB E9 3E EA 66 D5 F4 A0 57' - 'A2 34 71 4E 4D 4B 1A 40 F7 D3 93 A4 4F D2 18 29 95 6E 4E D1 4C A4 C9 34 85 A6 D1 6D 34 83 D6 D3' - '6E FA 93 F6 D2 3E AA A3 39 A9 9A 87 E9 51 9A 4B 8F D3 93 34 9F 9E A6 67 E9 79 7A 91 7E A2 2D 74' - '8A 12 B3 34 AD A8 35 B5 A1 BE A4 77 6B 8C 64 26 0B D9 28 92 A2 28 86 E2 28 81 7A 9F D6 44 37 69' - '3A 52 67 EA 4A DD A9 27 F5 A6 3E D4 8F 06 D1 18 BA 9A AE 25 BD 47 D3 9D AE A6 71 34 9E A2 06 7B' - '3F C6 54 BA 96 EE A7 EE 56 4D 4F 5A 14 A5 19 E8 D4 3C 40 4F 91 21 49 63 A2 34 BA 25 45 33 89 6E' - 'A5 A9 34 9D 6E A7 3B E8 2B FA 83 F6 D0 5F B4 9F 0E D0 43 A9 9A 47 E8 31 9A 47 4F D0 53 B4 80 9E' - 'A1 E7 E8 05 7A 89 7E A6 5F E8 34 25 65 69 92 29 85 52 C9 E0 D6 98 28 94 AC 14 46 2D 28 9A 62 29' - '9E 5A BA E1 70 A3 D7 69 4D 4C 93 A6 13 75 A1 6E D4 83 7A 51 0E F5 A5 FE 34 98 AE A2 6B 68 2C 19' - '3C 9A 9E 74 2D E5 D1 F5 14 6D F2 7E 68 A5 14 E3 D4 C4 3B 61 77 C2 41 5D 29 20 4B 13 48 06 32 93' - '9D 9C 14 A3 C5 3F 3E A3 58 A7 26 81 BA 91 2E 4B 13 44 46 0A A5 04 72 51 EC 47 DE 9F C0 05 24 01' - 'C9 40 0A 90 46 19 94 05 B4 F5 3E 0F BC DF 4B DE 67 1A 90 03 5C 43 AF 53 21 AD 00 3E 06 D6 D2 03' - '3A CD A3 74 55 10 C6 05 61 2E 95 D1 97 F4 15 1D 0E C2 91 20 18 82 61 0C 86 39 18 A1 C1 88 A7 96' - 'C1 70 04 63 62 30 6E 0D 46 25 21 04 A1 21 38 1E 82 93 21 70 EB D1 4B 8F B1 74 83 01 37 1A 30 8D' - '4E D3 9D 46 4D 3D DD 65 D6 3C 44 47 42 35 23 2C 9A AB 2C B8 DA 82 40 2B C2 AD 88 A4 87 A9 DC 8A' - '4A 2B 7E B6 62 8B 15 43 6D 18 61 43 23 E5 45 E0 E6 08 4C 89 D2 FC 15 85 FD 51 E8 18 8D 4E D1 A8' - '8C 46 75 34 7E 8A C6 96 68 EF 07 88 A0 18 84 C4 C0 E8 DD 7E C5 62 80 77 8F 15 07 47 1C 96 C4 A1' - '20 0E 45 71 78 37 0E 57 C5 23 2F 1E A7 E2 E1 89 47 77 3B 7A DB F1 80 1D B3 EC 28 B3 63 83 1D 9B' - '29 CA 89 68 27 9C 4E A4 38 E1 76 A2 8B 13 DD 9D E8 E5 44 1F 27 FA 39 31 C8 89 91 BE 25 E1 72 27' - 'C6 3A 71 32 03 A7 32 D0 94 01 4F 06 A6 65 6A BC 1F 98 64 21 D8 FB 00 CB 82 89 2C 59 88 F2 7E 97' - '78 3F E7 2C C4 53 CB 2C 38 B2 90 96 85 AC 2C B8 B3 D0 35 0B 3D B2 D0 3B 0B 7D A8 5F 16 46 64 61' - '14 89 1B 3A 37 7A 52 23 35 BD 05 CF 5B 08 2D 80 B5 00 B7 D3 03 74 A8 00 C7 0B 30 A3 08 77 15 E1' - '87 22 6C 2A C2 89 22 34 14 E1 14 65 15 A3 6D 31 C6 D1 E7 C5 D8 58 8C 5F 8B B1 BD 18 D7 94 60 5C' - '09 7E 2D C1 F6 12 D4 97 E0 60 09 FE 2A D5 D8 9A 10 D5 84 58 72 D3 80 26 0C 6C C2 90 26 0C 6B 42' - '6E 13 46 35 E1 B2 26 8C 6E C2 B8 26 5C D7 84 9B 69 62 13 26 35 41 3C D0 79 10 E4 41 88 07 46 32' - '93 C5 03 AB 07 71 1E C4 7B E0 F0 C0 E9 41 0F BA 8E 6E F0 E0 46 76 14 05 88 2C D6 69 CA 69 6A 90' - '66 B4 5E E3 30 68 7A 53 AE 51 AE 34 CA 2C AA 37 CA 31 A3 74 35 49 6F 93 2C 34 C9 22 EF 1B BA 55' - 'C6 58 65 90 4D 86 DB E4 33 9B AC B2 C9 1A 9B 7C 6E 93 9C 30 E9 17 26 33 C2 E4 8E 30 59 1F 26 5F' - '87 C9 46 FA 85 B6 85 C9 F6 30 E9 12 2E 3D C3 A5 98 2E 89 94 11 91 72 55 A4 5C 1D 29 D7 D2 57 F4' - '79 0B A9 69 21 7D A2 A4 5F 94 E4 45 C9 E4 28 E9 11 2D BD A2 A5 7B 8C A6 7F AC 0C 8C 95 9D D4 3B' - '4E 06 C6 C9 CB 71 B2 28 4E 5E 8B 93 37 E2 A4 8F 5D 06 D8 65 9A 5D A6 DB E5 78 4B 39 D1 52 3C 0E' - 'CD B4 56 32 A3 95 4C 99 28 53 27 CA 51 EA 3C 49 BA 4F 92 FE F4 E2 14 79 79 8A EC 9C AA 59 BC 4A' - 'F3 E8 16 79 7C 8B 8C DD 23 E3 F6 48 9C F7 B9 80 74 EA 01 F4 02 66 D2 03 F4 0E 2D A7 1A 3A 4E C7' - '74 9A E0 60 E8 83 D1 DF A9 19 45 F7 3A 31 D3 89 79 4E 3C E1 7D 2A BA 34 39 2E F4 77 E1 12 5A E0' - 'C2 73 2E BC EC C2 2B 2E 2C A1 37 A9 80 DE A3 1F 5C D8 E4 C2 8F 54 49 47 5C F0 24 C2 99 04 57 12' - '66 D2 2B 49 F8 20 09 5B 93 B0 23 09 1F 27 6B 3E A7 13 C9 F0 24 63 6A 6B 4D 59 0A D6 A5 60 43 0A' - '7E 4F 41 7D 0A 3C 29 DA 0A 3B 3B 15 0B 53 51 93 8A AD A9 68 4C 45 53 2A 3C 69 70 A7 A3 7F 3A 06' - 'A5 63 58 3A 52 1B 35 E3 9B 34 37 78 37 BA 4D 30 79 34 76 0F 5A 7A 70 0D 8D A5 9D B4 C7 83 7D 1E' - '7C 5E 2D 5E BF 50 23 B5 A8 D1 74 A4 11 34 95 E6 52 31 7D 49 F5 75 72 B0 4E E2 5B 78 3F 84 56 F4' - '86 76 B0 81 F9 41 1A 53 B0 A6 29 04 9E 10 1C 32 E0 B0 01 8D 74 D0 A8 39 69 D2 F4 B6 68 7E 89 D6' - '2C 71 62 AD F7 D1 53 A4 39 75 5A 73 4B 93 26 D0 A3 A9 F5 60 87 07 BF 7B B0 DB 83 6D 0E A9 F5 7E' - 'EB EC D4 2C DB A7 B1 B7 F4 FE 2B 8C A5 3C 2A A2 A5 F4 21 AD A4 2F 02 B0 3E 00 3F 06 60 7B 00 7E' - '0F 80 F7 35 7A 3F 1D 08 80 27 00 77 E8 34 0F E9 F0 B0 0E AB 1D 9A B5 0E 7C EE C0 46 07 36 39 BC' - 'FF 58 6C 77 60 BF 03 07 1C 38 ED 40 93 03 AF B8 B1 C8 AD 2D 45 51 85 70 16 C2 55 88 B9 85 98 57' - '88 AB 4B 35 13 4B 31 A9 14 EF 37 E2 F3 46 F4 F2 68 72 68 17 35 1E 16 CF 61 49 F0 AE 61 28 A0 62' - '7A 8F 96 D1 EC 40 CD 93 41 78 2A 08 96 60 58 83 F1 2B ED A1 D3 DE FF B9 C1 38 16 A2 69 30 68 A6' - '99 34 87 4D 38 61 42 03 CD 32 6B 46 84 6A EE 21 B1 42 67 45 04 B5 B0 22 DA 8A 38 2B 1C 56 74 A0' - '4E D4 85 D6 58 B1 DE 8A 0D 56 7C 6F C5 0F 56 6C B2 A2 CA 8A 9F AC 78 CD 86 C5 36 2C 88 C0 C2 08' - 'DC 1A A5 C9 89 D5 FC 1A 0B 4F 2C AE 8B C7 C4 78 CC 88 C7 CC 78 6D 71 17 17 74 2E 04 BB A0 77 C1' - 'E0 42 24 45 B9 10 ED 42 4B 17 92 5C 48 A6 14 4A A5 2C EA E6 42 77 17 86 D2 30 17 86 BB 30 82 E6' - 'B9 F0 B8 0B CF BB B0 D0 85 45 2E 2C 76 E1 75 17 DE 70 E1 2D 17 DE 76 A1 D0 85 77 5D 58 EA C2 46' - '17 CA 5D A8 70 61 33 55 B9 70 98 6F 1A 21 49 30 27 C1 91 84 C4 24 B4 49 42 7A 12 EE 4B C2 FD 49' - '78 39 09 1F 26 E1 97 24 EC 4C 42 EB 56 C8 69 85 A1 AD B0 A8 15 F6 B4 D2 5E 4E 56 24 63 65 32 CA' - '92 F1 45 32 8E 7B DF 55 5A 63 4A 6B 4C 6B 8D 9B 52 F0 5C 0A D6 A6 68 FB 18 4F 1B ED 31 D4 36 1D' - '03 D2 31 30 1D C3 D3 71 7B 3A EE 4C C7 F3 E9 78 31 1D 9E 74 FC 9E 81 BD 19 C8 CD C2 C8 2C E4 67' - '61 61 16 5E C9 C2 61 BE E7 54 B5 45 7D 5B 34 B6 45 A0 5B 13 EE 46 84 1B 4E EA E4 46 67 EF 4B A2' - 'F7 E5 DE 8D 05 ED F0 74 3B BC D0 0E 8B DB A1 AC 1D 76 B5 03 B2 D1 32 1B 69 D9 18 94 8D 5C CA CB' - 'C6 AC 6C CC CB C6 B2 6C 94 65 C3 D3 1E 65 C3 E1 19 8E 05 6F E1 AB B7 D0 A6 08 E9 45 E8 54 84 CE' - '45 E8 4A 77 95 E0 9E 12 9C 3E AD F9 CD A3 F9 93 F6 7B 50 E7 C1 29 0F 4E 7B D0 59 A4 B7 C8 3D 22' - '73 45 9E 10 79 4A 64 81 C8 22 91 25 54 2E 72 4A E4 2E BD DC AD 97 AF 8D 9A DE D1 9A 2A 87 6C 75' - 'C8 0E 87 1C 74 48 8F 49 D2 7B 92 0C A0 45 AB 34 28 97 A3 E5 DA 0D 42 AD 2B 24 B5 42 6E A8 90 89' - '15 32 B9 42 E6 54 C8 43 15 F2 44 85 14 57 C8 7B 15 F2 67 85 D6 66 D9 E7 47 19 40 D8 2C 57 6C D6' - 'DA 2C 3D 3F 4B E7 2D D2 6D 8B DC BA 45 66 6C 91 3B B7 C8 9C 2D F2 F0 16 79 64 8B 8C D8 A1 79 67' - '9F 26 6B BF 06 F5 92 5E 2F EE 7A 79 B6 5E 96 D4 CB 7B F5 B2 BC 5E D6 D6 CB E7 F5 B2 A9 5E 2A EA' - 'E5 68 BD 84 1E 94 77 0F CA EE 83 12 70 48 6C 87 A4 FB 21 C9 39 24 83 0F 49 EE 21 19 79 48 F2 0E' - 'C9 8D 87 B4 B6 CC 86 C3 DA AD 44 35 C7 A4 F6 98 EC 3B 26 F5 C7 E4 D4 31 C1 71 B9 FD B8 E4 1F 97' - '9F 8E 4B ED 71 F9 EB B8 76 67 91 E9 84 D8 4E C8 A0 13 92 7B 42 C6 9C 90 BC 13 F2 E8 09 59 70 42' - 'DE 3D 21 CB 4E C8 F2 13 5A 63 E7 DD 27 E5 DE 93 F2 DD 49 D9 78 52 FE D5 20 79 0D 72 6B 83 4C 6B' - '90 19 0D 72 77 83 DC DB 20 F9 0D F2 48 83 2C 68 90 A2 06 59 D6 20 2B 1A A4 AC 41 BE 68 90 F2 06' - 'A9 6E D0 9A 42 9F 69 94 E7 1A E5 DB 46 69 B9 A6 F9 A2 2E D5 B5 AC 2A 71 AA 77 59 D5 E3 9A 2F F0' - '52 7D CC 2B 03 F0 19 0B A4 E5 7E 05 52 55 1A 9D C6 2E CC 3B D9 85 79 2F BB 30 FF E1 42 22 75 15' - 'D1 51 DE 16 34 9B 77 F7 B4 F5 5D EC 32 86 AF E0 3A 56 DF 54 88 AC E7 D9 21 B2 E6 4A DC 0D AC C4' - 'A9 40 D9 45 D6 E3 CE 09 9D A9 DA 9C 8A 9E F9 57 E8 76 B3 42 77 84 0F C8 53 7C 59 57 C1 B4 8B AF' - 'D6 A9 08 9B 7F CD 4E 05 56 54 E5 4E BD FA AB 80 DB 45 56 F1 CE 09 C1 F9 57 F4 76 73 0B A1 EA 7A' - '2A 1C 77 91 D5 BD 7F 08 D0 F9 57 FD 26 30 B6 F1 DF A9 FA FD 5D 1C 4F 55 03 55 28 6F 37 63 21 2A' - '9A F7 CF F5 41 15 DC F3 AF 12 AA D0 8F DA 44 CD 62 C5 70 F6 7F 56 31 5C C7 30 FA 39 41 3F FF 1A' - 'A2 8A 10 A9 4A 62 C0 85 2A 89 E7 84 01 2F E5 82 79 19 EB 89 13 58 4F 54 C1 C0 7F AE 2A FA C7 06' - '55 50 E9 10 B7 7F E7 54 1B 07 72 37 78 F5 7F B5 E6 A8 E2 06 2A FC D4 5C 7F 54 CB F8 39 0B 78 2F' - 'BF 8A A4 8A 2E AA 0D A7 AA 4E 9E B3 BC 6F 61 BD F2 82 C1 C6 DE 0C 36 36 D7 2E 9B EB 95 FE F1 C6' - 'A7 18 6C 7C ED BC 8B 9C CA 6D FF 67 AB 99 79 8C 18 A9 9A A6 BA 34 4A F5 D4 4A E4 59 95 CD 0B D6' - '34 D5 76 FA EF 2A 9B E7 87 34 2B B9 E5 56 15 4F FF 90 99 F3 22 EA 9E 7F 17 F0 1C F8 37 F5 D0 72' - 'C6 A5 54 55 54 85 40 5B FE 63 08 D4 3F DC B6 84 DB FE 40 56 51 2F 18 0B BD 24 5E 0B C0 35 BF A6' - 'CD 3E 2F 1C FA 1E 2B AD 7F 17 11 3D 15 FF 1F 11 D1 EE 0C CF 0D 67 07 73 F3 75 5D CD C7 0A 2A 40' - '7A 4E 7D F6 B8 AF 3E 0B 06 61 D0 52 EB FE 54 17 1E 39 D9 F7 A9 AE 3A 52 DD 9F 17 BC F0 48 75 82' - 'AA BE CF 55 E7 F5 7D 7E EF D7 F7 F9 0B FB 3E F7 F9 F5 7D 9E 72 30 44 E4 BC 40 00 C7 FF 82 24 23' - 'FB 41 2F E6 6A A4 B6 BE 3E 51 75 35 92 EA 13 F5 BE A8 E6 31 79 D7 29 09 F7 26 E1 79 52 AF 93 EF' - 'B4 D6 9C 79 61 E4 F5 49 AA 97 34 8F 5D 8F 7F B1 DF F1 D0 DF F4 3B AA 5A F6 54 1E B8 FC D7 2A DA' - '41 7E 49 40 15 E9 55 F1 A2 2E 7E 35 EE 57 FD 6A DC A7 CE AB 71 2F F0 D5 B8 ED D9 5A 24 6F 04 5F' - '39 EF E3 5B A7 7A E5 FC 2E 1B E5 D9 B8 B3 3D EE 6B 8F 6D ED 51 DB 1E 4D ED CF AD 86 AB 3A B8 99' - '15 F0 74 DE 67 34 85 77 09 BD CA 0A F8 01 DF B1 4E 22 7B FE E6 B2 F7 EE 0B F6 DB 1D BD 50 35 BC' - '39 92 EC E6 8B AD AA 8C E7 33 98 FC 03 A3 9C 87 58 13 07 6B E2 59 AC 89 AB C0 F2 38 56 C6 E7 B0' - '32 7E 4E 6C 79 23 73 52 3F F3 C0 E8 37 A6 A5 9A 6B E5 FE 71 66 FF BA B9 8A 36 AB 90 E8 35 BE 80' - 'F3 C5 D4 CD 55 FC F9 E8 7F 56 31 77 AB 58 D6 D9 E1 E8 7D A5 67 02 A9 17 A8 A4 FF F4 1F 95 74 FF' - '4E 44 75 7D 8F EA 47 9C F0 3F 54 01 57 57 E2 04 90 0A 61 AA 4D C3 93 DC 2E A8 2D C2 39 55 F2 24' - '56 C9 87 9E 5D 1F 5F EC AB 8F 6B 29 54 D6 C7 55 C4 56 5D 33 A4 FA 26 FD 2B E6 EA 98 EC 02 75 73' - '5F 54 BC B3 ED CC 71 98 8A E7 CE F6 0B 8C 7F C6 A3 31 95 37 54 95 68 15 DE 55 F5 68 15 27 EF E4' - '57 8F 9E C1 7A F4 6C 5F A8 5C 1D A2 FD C0 98 EF F6 B0 33 F1 CE E6 AA F4 39 31 73 75 B8 F6 0F 75' - 'EA 62 5F 9D 5A 05 D2 55 68 58 C5 D2 2F B2 72 7D C1 E8 BA AA 65 AB 00 FB B5 0C B0 E3 BC 00 FB 20' - 'BF 63 BE E6 1A F7 05 23 ED EB 58 EF 56 21 E6 FC F3 E2 ED 9F FB 2A E0 E7 84 DC FB B0 1A AE 42 CF' - 'AA 26 7E 7E EC 5D 55 C9 55 24 5A D5 CA FD 83 F0 6E 6E 28 E1 17 87 57 07 8E 4B 18 A3 FD 87 7A FA' - '39 91 F9 DE 0C CB AB 63 4A 15 B6 6E AE B0 37 C7 E7 77 30 3E AF 2A EC 21 71 A2 F7 D5 D9 BB B2 CE' - 'AE 8E 35 55 B5 5D 85 EB 55 CD 5D 45 EC 5F E6 41 E7 39 95 77 15 BA 1F 60 D7 82 DD 93 79 00 3A FF' - '42 01 FC BF AB C8 AB 20 F8 39 75 F9 73 A2 FA AA 46 AF C2 E2 AA 52 7F 94 07 AC AA 5E AF 02 C6 1E' - '87 56 B5 57 C9 6E 75 E4 EA 5F C1 57 79 DB F3 EB F8 2A 7A AE 0E 67 55 4D 5F 1D D1 AA CA 7E 67 6E' - 'E8 55 30 5D 05 98 FD 6B FD 39 3C BA 6D AE F8 3F 3A F5 02 01 52 D5 58 F0 DF 4F 02 A8 43 05 75 40' - '7C CE D1 C2 04 1E 2D DC 76 A1 A3 05 FF A0 35 7C 5D D7 FF 7C 49 D9 F9 7D D8 17 BC AA AC E5 3F 5E' - '55 36 AA 4A EB C3 2E F2 F5 61 AB 0E 6C D5 7B AD BA AE 55 BF F5 77 35 FF 74 D4 F1 F8 96 33 F9 07' - '15 C2 55 2D 01 97 F2 F0 43 65 21 54 7B 80 ED A0 64 1D 14 F7 41 B9 E5 A0 4C 3B 28 EF FC FD 21 C7' - 'C5 E7 0D FC 93 D6 0E 2D 8B 9D C6 6C B7 53 FB 32 D3 A9 71 69 BD 03 2A 5C 70 7E 05 AE 39 06 7C 24' - '48 EB 06 D9 1B 72 56 DA BA 29 44 8B F2 9E 9F B9 56 15 38 15 F1 55 75 38 2B 43 E5 FF 56 48 6C 44' - '23 2E 26 52 35 9A 61 2A D5 23 E0 1F A9 6A D4 6B 9D 02 2A 52 A5 EA 31 2A 58 B5 CA D7 35 70 C1 60' - '95 EA 23 50 95 9B 3C F6 11 94 31 58 F5 17 EB 37 FE F1 AA 2B 19 AF BA 9B F1 2A 55 D1 51 FD 05 2A' - '6A A5 6E D9 53 D7 06 A8 8E 03 15 BB 52 91 8A E6 F0 55 0A 03 57 DF F9 02 57 2A 12 A3 FA 08 C0 C6' - '7D 95 D7 56 7D 23 AA 8E 92 D8 CB FB 71 E9 59 11 51 C7 F6 A1 BE C2 A8 9D 85 D1 A1 AC 8A AA 8C 76' - '95 2F 22 DF 9C D1 0E 65 DC FF 82 E9 EC F3 B3 D8 B9 3C 0F BF 60 52 EF D4 D9 49 3D 95 2C 53 09 B2' - '91 2C 6C 4D F7 B5 3E 68 4D 0F FF 2B 32 3E 49 DA 2F 99 74 A7 A6 95 F6 65 16 3B 24 92 B5 2F 33 9C' - '9A D6 A1 CD 4D 54 FE AD 38 AA 95 EA FC 76 9A C7 D8 42 A3 9A 93 54 EB 8B 6A 18 C2 41 31 1E 3C D3' - '24 94 62 68 2E 9A A9 28 D0 BD 8C F9 CC F3 8B F9 34 97 92 AE F7 15 91 54 78 A7 8D 77 3F 7B A6 5E' - 'AF 4A 3D CB 58 5D 53 05 1F 55 52 9F 48 17 53 F0 71 3B D1 C1 79 A6 EC A3 0E FD 23 12 35 5D 78 30' - '3D 8E 35 D6 5B 58 5D 55 75 D5 BF 2B 01 A5 6A 8D 2F AA 09 45 F5 99 4D 0A C6 64 5F 2B 8A 6A 42 51' - '1D 5A AA 3F 27 4D FB 3F 7A 4E C8 A0 9B AF 67 C6 CC 4C 80 EA 96 51 B5 C1 5C 5F DD D7 EB 72 3A A7' - 'AC EB 95 6E 51 DD 31 7A C0 A2 B5 E3 6B 3D 32 0F 01 8F B0 53 46 35 C9 34 B7 C1 84 FA 1A 60 26 FA' - '35 C0 FC 5D A3 4B 86 D6 DD 62 20 13 39 28 D3 A8 FE 72 A8 AF E1 47 B5 EA 9C DF F6 D3 86 CD 3B E7' - '37 FF 64 AD 52 D1 8B 44 AD 96 A1 85 2E BA 33 62 71 35 6B 67 F7 B1 7A AA 82 16 AA 2E C5 DD 85 56' - '97 6A AE A6 AD 60 35 ED 33 46 2F FC 6B AB 9F 04 E0 D3 00 AD CA B6 C9 AF CA D6 5C 5F 9B C1 FA 9A' - '8A 6A A8 2A 9B 0A 6C A8 8A AC 4A A4 A9 72 57 70 30 42 82 2F 50 F4 3A C6 30 86 7F 89 4B 35 9F 75' - '63 D6 48 15 A5 54 9A ED 15 E6 8E 54 F3 19 18 90 50 65 2A 15 93 50 C5 AA 8B A9 F1 D9 18 8A E8 C8' - '20 C4 00 86 1F 66 32 C5 F4 04 53 4C FF 50 E2 8A F9 FB 12 97 2A 6E A9 EA F2 50 16 B7 9A DB E0 1E' - '67 A5 39 2C 11 91 89 E8 C8 EA D4 73 49 78 C1 AF 28 95 D7 0A 8F B2 49 AE B4 35 DE 6D 7D A6 36 7C' - 'C1 52 D3 49 C6 33 C0 40 C5 DF 15 9C 84 05 27 3D 4B 4D 2A BD A7 0A 4E 3D 59 70 52 F5 4D 95 E7 53' - '31 0C 55 76 4A 60 D9 29 97 4D 78 33 B3 F1 80 AF 09 EF FB 6C 6C CA C6 5D ED 71 6F 7B FC DA 1E DB' - 'DB 6B F5 A7 73 4A 50 E7 44 38 66 15 68 F5 53 97 AF 49 49 15 A8 54 9C 43 D5 4F 7B 31 D4 A6 0A 54' - '36 5F 30 63 44 13 46 D2 65 74 05 53 4F 79 8C 64 A8 CA B7 0A 66 4C F2 05 33 02 3C 08 66 24 23 9E' - '01 8C EE AC C3 5E CD E8 C5 4E 5F D1 AB CE A3 F5 A1 9D F6 78 F7 B1 DA 6F 39 AC 75 F9 17 BA 54 0C' - '43 C5 2D 54 4B 9F 8A 40 F8 17 BA 54 50 E1 FC 92 95 AA AF AB CA BA AA A9 AB 6A BA 7F 1D FD 62 CA' - '54 A6 83 62 3D 28 6D 69 E2 41 99 CA AA 95 57 73 81 EA FF C1 D2 54 5B 6D 35 9B C0 8E 3F B7 F6 E5' - '4D 4E 4D 3B ED CB 9B 9D 9A 6C ED CB 5B 9C 9A F6 DE 6D C0 99 E7 98 2A E1 AB 32 96 2A E4 BF CF 62' - 'D6 4A 16 B3 54 2F 6A 19 B0 1E D8 00 6C 02 2A 58 DE FA 19 D8 A6 F5 03 E2 77 E0 0F E0 00 70 90 05' - 'AF 93 C0 69 DE DD 6B E5 10 9A 64 0E 92 51 33 63 3A 73 48 4C 0E 87 C1 0C E1 E8 97 91 1C F4 72 23' - '47 B6 CC E2 18 95 D7 39 28 65 19 07 A2 6C E5 50 93 5D 1C 61 72 94 E3 49 E2 39 32 C4 C1 01 21 ED' - '03 B4 BE C3 95 01 F8 29 00 DB 7C 65 B5 1C 1D FA E8 D0 4F 87 FE BA B3 FA 0E 9B 1F 85 FE 05 B5 05' - '3A 94 E8 B0 4C 87 6F 7D 97 9E 56 EB 50 AF C3 21 8E E5 38 CA 99 1C 5E 08 84 04 42 47 21 64 0E 84' - '25 10 B1 D4 95 72 03 31 32 10 FF A2 D1 74 4D 20 C6 72 08 C7 5D 1C 62 F1 05 07 54 6C E6 50 8A 1A' - '8E A3 D8 CE E1 13 7F 70 D4 C4 51 8E 91 38 19 88 47 83 34 89 C1 68 1D 8C 3B 82 71 77 30 CA E8 0B' - 'DA 4C A9 06 4D 3B EA 40 57 1A 30 CE 57 9E 6B 2E C9 79 B5 67 89 AD 13 8D 31 E2 6A 5F 59 6D B0 5F' - 'E9 4A 15 AD 9E 23 55 60 1A CC CB 89 CA C8 FF 5E 07 55 B2 D9 42 5B 43 F1 6B A8 56 67 69 CF BA C9' - '07 2C 91 6C B3 C0 6C D5 F4 A3 E1 34 8A 46 D3 35 74 0B DD 4E 77 58 71 8F 15 0F D2 B3 F4 2A BD 41' - '85 F4 0E 7D 42 AD 6D 1A D5 03 1A 1C AF D1 93 91 CC 64 A1 70 6A 3E 90 F7 CA F1 1D CB 7B 65 24 20' - '2B 01 EE 04 74 4B 40 8F 04 0C 4F C0 88 F3 3A 47 D1 12 AF 70 88 C2 C9 96 DA CB C0 7F E7 F0 5C 1D' - '98 37 1F 95 6F E3 B2 D7 7C 54 EE 5D FC D4 5B 44 18 45 53 2B EF 2B A9 EF 8D A2 3D 5F E0 3A 39 D1' - 'D9 89 1E D4 8B 06 39 31 C4 89 D1 A4 DE 3A A6 F1 B0 7D 06 97 4C 75 D8 5E 44 E0 DA 19 C4 23 77 83' - 'EF C8 3D CA 77 E4 EE 74 21 F1 1F 0F DE DB 71 2C 41 57 DF 6A AA 8E DF BD 4B E9 2C 5F 47 B9 8A 6B' - 'A9 70 D6 46 86 B3 02 13 35 06 32 53 2B 6A 4D 19 89 C8 4C 44 DB 44 B8 13 D1 87 FA D3 20 1A 42 79' - '34 9E 6E 4D C4 F4 44 CC 48 C4 1D 89 B8 3B 11 F7 24 22 3F 11 0F 26 E2 A1 44 3C 9C 88 C7 12 31 37' - '11 EF 24 62 69 22 6A 13 B1 2B 11 7B 13 B1 3F 51 8B A9 A7 25 69 0B B9 77 15 37 A7 69 66 A4 E1 CE' - '34 6C 25 FF 3E E0 C5 59 9A C3 7E CB B6 7A 7F EB 44 AA 95 7F 18 5D 4A B9 34 8A 2E A3 2B E8 4A BA' - '8A AE A1 B1 94 47 E3 E9 46 BA 89 6E A1 69 6E 4C 77 E3 76 37 66 B8 71 A7 1B 77 B9 71 8F 1B F7 BA' - '31 D3 8D FB DD 78 8E D4 2B C2 6B 2C 19 BC 43 EF D1 32 7A 9F 3E A4 15 B4 92 3E A5 55 B4 86 CA E8' - '0B 5A 4F 1B E8 1B 2A 77 A3 C2 8D CD 6E 54 BA 51 ED 46 8D 1B 3F BB B1 C5 8D AD 6E 6C 73 E3 08 1D' - '67 C1 A2 89 05 0B 55 AA 78 86 49 19 95 91 71 FA 32 32 0F F0 DE 00 EF 4B 89 EA 93 56 1D D2 AA 37' - 'DA BF FB D9 BB 60 84 36 C0 46 E1 D4 A2 01 2D 1B E0 A4 44 4A 6E 40 EB 06 A4 35 5C F8 98 BD F9 5C' - 'E2 BF D6 B6 76 CA EF 75 A7 3F C3 F9 2A 7B 3A C1 F7 66 E3 DD 2A DF C6 DD 72 F3 86 59 FE F1 30 BF' - '96 1B 27 F5 A2 F3 B2 4D BC 16 51 29 65 85 49 DB 30 ED D0 78 58 84 76 E4 BB 8A A7 BE 5E 9F F2 80' - 'B7 0B 0F 51 C7 32 A7 F3 59 85 94 55 FC DF 39 2E FB AE C6 B7 9D FD DF D1 E0 C3 4D 79 F3 01 DD 08' - 'BE D2 4D 3E 28 0B 08 87 2E 7C 4C A7 36 F1 EA 38 AE 83 76 73 C3 99 9D 2B 97 B8 10 A7 46 3D B0 D5' - '43 BA 63 8A B0 CD 26 D5 D7 69 A3 1A 35 54 BF 8D 6A D7 50 BD 00 2A CA BF 26 00 6B B9 81 FB 92 1B' - 'B8 CD 01 38 18 80 43 01 88 D1 21 56 07 3B 75 A5 5C 1D 46 EA 70 99 0E 97 EB 30 5A 87 2B 75 BE AD' - '5B 08 42 42 70 5C 8F 06 FD 99 C4 E0 B1 04 9C 48 40 13 59 78 66 17 C3 86 01 3B 1B 06 D2 78 FA 91' - 'C9 83 8F AE 6C 1E 18 C0 66 91 61 4E 0C E7 4B E3 4D 6C F8 79 80 0D 3F DE F5 A3 DC 89 0A 27 AA 9D' - 'A8 71 62 9F 13 07 9C DA 86 C9 EB 19 F2 3E F1 5F F3 05 74 55 2C 50 05 74 8B 5D 78 C7 85 65 2E 7C' - 'E0 C2 2A 17 D6 B9 F0 95 0B 1B 5C F8 86 BE F3 2D 0F E5 BE F8 EE 16 17 B6 B9 50 4B 3B E9 37 17 76' - 'BB F0 27 1D A1 63 2E 9C 70 A1 C1 85 46 17 4E BB D0 E4 FD 27 26 E2 CD 44 94 D2 37 89 F8 3E 51 6B' - '4F B2 26 C1 CE CC 61 6B 4A 65 EC 70 40 12 06 33 0C 5C 9C 84 D2 24 BC 9B 84 65 49 58 9E 84 95 49' - 'F8 24 09 6B 92 B0 36 09 DF 25 E1 FB 24 EC 49 C2 DE 24 EC 4F 42 5D 12 8E 24 E1 68 12 CC C9 48 4F' - '46 66 32 B2 92 D1 2E 19 D9 C9 E8 98 8C 4E C9 E8 9A 8C 6E C9 E8 99 8C 5E C9 E8 97 8C 81 C9 18 92' - '8C A1 C9 18 95 8C EB 93 71 6B 32 6E 4B C6 0C BA 93 EE A6 7B 69 6E 32 16 24 E3 F9 64 BC 94 8C 97' - 'E9 D5 64 BC 96 8C C2 64 14 31 00 F9 19 03 90 EB 93 51 9E 8C 8A 64 54 27 A3 26 19 5B 93 B1 3D 19' - '3B 93 F1 7B 32 FE 48 C6 DE 64 EC 4F 46 5D 32 EA 93 D1 C0 3C B3 57 5C 6B D8 5B A3 25 BD D6 1A 8B' - '5B E3 F7 D6 D8 DD 1A 96 14 CD CD 6C E8 59 CF 86 9E AA 14 54 A7 60 5B 0A 7E 4D C1 4E 36 F1 1C 49' - 'C1 B1 14 9C 48 C1 C9 14 34 FA 82 D0 BA 54 04 A5 22 24 15 E6 54 84 A5 22 32 15 CE 54 B4 A7 4E A9' - 'E8 9C 8A BE A9 E8 97 8A 01 A9 18 94 8A 61 A9 18 9E 8A 11 34 32 15 E3 53 71 03 4D 48 C5 AD A9 98' - '9E 8A 3B 52 31 33 15 F7 B3 D1 EB 19 B6 6C BD 94 8A A2 54 2C 4D C5 07 A9 F8 30 15 15 A9 F8 31 15' - '95 A9 A8 62 2B D7 2F A9 F8 33 15 7B D8 CA 75 3A 15 99 69 C8 4A 43 87 34 74 4C C3 C6 34 FC 90 86' - 'DF 29 28 5D 63 49 47 58 3A 22 D3 11 9D AE 45 B5 FB 32 1D 3A 2C 1D 79 34 9E 26 D2 64 9A 46 B7 D1' - 'BD 34 93 F2 69 36 3D 44 8F D0 63 34 8F 9E A0 A7 68 41 3A 9E E5 79 80 D7 4B F4 32 2D A2 D7 68 49' - '3A 3E 4E C7 86 74 7C 9D 8E 3F D3 B1 2F 1D 75 14 C0 A6 1D 03 9B 76 CC 6C DA B1 B3 69 C7 C9 56 A7' - '4E 59 E8 9C 75 26 C5 7A A2 2D 4E B6 D5 0E 0F C2 D8 96 16 EF 46 61 36 8A B2 B5 4E 8B 2F 8A CF DA' - 'BE 3B 9B 90 DC 84 94 26 64 34 21 8B 97 23 76 F4 AD 6A 83 D9 72 36 96 9D 66 06 5F A7 99 6A 5D 52' - 'FD 66 AA 81 69 1C 1B 98 C6 B3 81 69 0F FD 45 2A 77 3A 8D 35 A1 DB 28 B8 42 42 2A 64 68 85 0C AF' - '90 C1 47 64 C8 11 09 3D 2A 96 A3 D2 EF A8 F4 3F 2A F7 D1 FD 34 97 5E 3A 2A AF 1E 95 DD 47 65 CF' - '51 D9 77 54 0E 1C 95 C9 C7 34 53 48 DB DE 9D 90 00 0A A4 60 D2 93 91 6C 14 4E 91 14 45 31 14 47' - '76 6A 49 4E 4A A4 56 D4 9A DA 50 1A 65 50 16 B9 29 9B 3A 50 27 EA 42 DD A8 07 F5 A2 1C EA 4B FD' - '69 20 E5 D2 28 CA A3 F1 74 33 4D A4 69 74 1B DD 4D F7 52 3E CD A6 05 F4 0C 3D 47 2F D0 4B F4 32' - 'BD 71 42 4A 4F 48 FC 49 B1 9F 94 9B 1B 35 13 69 32 4D A1 99 8D 32 AB 51 1E 6D 94 27 1B E5 A5 46' - '59 D8 28 8B 1A E5 ED 46 29 6A 94 77 1B E5 FD 46 F9 A0 51 3E 6A 94 15 8D F2 49 A3 7C DA 28 1B 1A' - 'E5 EB 46 69 03 4B 2A 2C 57 D3 B5 74 1F DD 4F 9D 82 9B CF CB FB 00 03 99 86 9D 80 33 27 E2 2E 0F' - '5A 33 F9 30 D0 83 CE DA 31 70 22 A5 90 FF 2A 18 E3 EB 85 F3 AE 46 AA 2F D3 CC 86 BE 04 B6 EC F5' - 'E1 F7 6E 00 8F 95 42 48 7D 5F 76 99 0E DF 52 DB C3 D7 90 D2 EB E2 96 5D 75 7E A9 CE 2C FD 17 41' - 'FF 85 2F 87 9B 1C E1 06 46 9F 88 D0 44 ED 98 D0 AB 45 22 A2 12 11 97 88 84 44 38 12 91 78 F6 96' - '26 3D 11 ED 13 D1 95 BA 27 62 58 22 46 25 E2 F2 44 8C F3 DB C6 DC 90 88 49 89 98 92 88 27 12 31' - '3F 11 CF 24 E2 25 52 CB 59 41 22 56 26 62 4D 22 D6 72 51 DB 98 88 F2 44 54 24 A2 9A 9B 99 FA 44' - 'AD C3 45 CF 3E 4E D5 E7 A2 B6 37 EA C1 5E 46 5F F2 F1 FE 75 0A BE 49 C1 77 29 D8 98 82 CD 7C D4' - '6F F5 7B D4 CF E1 83 F7 95 54 2C 49 C5 1B 7C FC AE A4 B2 54 AC 4F C5 37 F4 C3 D9 8F E2 AD A9 D8' - '41 BB 52 F1 BB EF B1 7C 24 15 27 7D 0F 67 63 1A EC 69 68 99 06 57 1A 5A 51 6B 4A A5 74 BF 47 77' - '8F 34 F4 4A C3 E8 34 5C 99 86 1B D2 70 63 1A 26 A6 E1 D6 34 4C 4D C3 B4 34 DC CE 1D DA 3D 69 78' - '33 0D 05 69 78 37 0D 4B D3 50 ED DB B0 FD 4A 3B D3 B0 3B 0D FB D2 50 97 86 C3 74 3C 0D 8D 69 38' - '4D 4D E9 9A 7F 7E B4 FA 3F 48 D5 23 F1 86 26 DC E8 7B 30 DA 7D 8D 3C 2D 2F EE 21 F9 CF 27 8E 5D' - 'DF 56 17 7A A9 80 F7 AC F3 CE A0 54 A8 DB 3F C8 AD 8E E6 E7 07 69 97 74 6F 38 BB 86 0B 5F 99 50' - '15 02 87 B2 04 B8 3C 44 AB ED 36 F0 C6 ED 4C BF EA ED D5 BE EA ED F9 A5 C1 CD FA 8B 8D 7F AF E2' - '45 DB CD F1 EF F3 83 DF BB 18 FC 56 57 6F FF 5B 61 6F 75 49 77 AF BF B9 A4 FB 9C 10 F8 9D BC AA' - 'FB 22 83 DF AB 7C 17 79 AB E0 F7 46 BF E0 F7 2E 06 BF 0F 32 F5 AD 2E F5 BE C8 E0 77 0F 5E F6 DD' - '1C F9 56 57 7E FB 47 BE AF F7 45 BE 67 FF F7 22 DF FE 61 EF 8D E7 85 BD 1B 78 99 F8 DF C5 BC FB' - '5F E8 62 F1 E6 C8 F7 F5 7E 91 EF 7F 88 79 AF 3A 3B E6 BD F1 BC 98 F7 AE B3 63 DE 38 3B E6 DD DF' - '2F E0 AD A2 DD D7 FB A2 DD 0F 5E 44 B4 5B 5D 5C BE C9 EF E2 F2 0B C6 BC BB B1 BA 79 31 D1 EE 73' - 'E2 DC EA A2 F3 73 42 DD CD E1 ED E9 7E D7 9A AF 39 3B B0 FD FF 73 DC FA 5A 5F DC 7A E1 D9 71 6B' - '44 6A 0B D7 39 41 EB 48 06 AD 55 C4 FA 5F 67 47 AC D5 E5 E9 F9 BC 24 5D 45 A9 9B 0B 75 96 98 73' - '63 D5 E7 44 A9 9D BE 10 75 F7 D8 FF 28 E9 FD 43 88 FA D7 58 ED 52 F5 96 BE EB D4 D5 E5 E9 E7 84' - 'A5 9B 2F 52 57 D1 E8 99 BC 30 5D 45 9D 3B FF 7D C8 B9 DC 17 63 56 57 9F FF 9F 3E 89 55 97 26 9E' - '73 8E AA CA E7 EA CA 75 F8 CA 87 FE C5 42 FF D2 A0 7F D8 F8 30 0B 84 FF 10 30 9E F5 5F 0A 18 D7' - '66 FE 53 B9 11 2C 2B AA 98 F1 C2 0B 45 8B 77 31 5A AC CE EB 9A A3 C2 AA 70 58 FE D6 99 A8 F0 71' - '96 0C FD 23 C1 19 8C FE 76 65 F4 F7 2E 46 7F D7 FB A2 BF B5 45 FF 11 F4 CD 3F 3B D6 AB 02 BD 9D' - '18 E2 F5 0F EE AA 50 EE B1 8B 88 E3 4E 62 1C 77 FF BF 1F C1 4D F8 CF 4E 05 55 44 A6 F7 79 A7 82' - 'A7 4F 6B 57 CC C7 F2 8A F9 F3 CF 03 9B 4F 02 55 AA E0 E2 CF 03 55 E1 F3 DF 8A FB FA 07 7D CF EF' - '08 3C 7D 76 DC B7 96 51 94 73 42 BF F7 FE 8F 87 7E FF DB C9 2E C7 DF 27 BB FC 2F EE 3F 27 DF D5' - '7C 89 FF F9 29 AF DD 67 A7 BC BA FE FB 29 AF 94 50 F1 4F AF A8 C4 57 E9 79 89 2F 37 03 52 67 E5' - 'BE 18 7B 1E C5 D8 F3 AC BF 89 3A 83 03 03 9A 43 CE 77 72 6C C0 F9 61 E6 5E 17 11 5D DE EB 0B 2D' - 'E3 A2 43 CB DD 2F 22 AE EC 3F 78 00 BE A0 B2 8A 28 FB 47 91 3F 62 14 79 1B E3 C7 CD 61 63 55 9E' - 'CF 3F 2F 5A 9C C0 11 02 CD A1 E2 7F 2B 48 DC FD 42 E1 61 35 6C 40 C5 86 07 31 1B 7C 7E 0C 58 8D' - '13 38 27 06 AC 86 0A 14 73 90 C0 39 01 E0 F3 87 0A 0C FA FB 30 B0 1A 33 F0 EC D9 31 60 FF 00 F0' - 'C1 FF B9 00 70 BD 2F 00 7C 91 D1 DF 11 8C FE CE F7 45 7F 7F FB 1F 0D FD BE 79 5E DC 57 75 0C 0F' - 'F8 F1 4C B8 57 C5 2F FE 2F 46 7C 55 CD E2 F1 7F 67 30 83 8A F5 BA 2F 14 EB 3D B9 F3 4C E8 AD 39' - 'D5 59 CD 54 E7 39 79 CE FF 7D 41 C9 8B 8F C8 E0 E2 3A B9 FF 1F 0C CA 9C A9 EC 5C 74 0C DB 3F 29' - 'A8 86 76 F8 07 B3 BB E9 2E 78 12 D6 3D D0 FB 97 D5 65 DD 16 BF 4B B9 27 30 7E D3 53 EF FD 9B 43' - '18 83 B9 3D 58 73 97 55 73 0F BD 19 8D B7 A2 CF C4 16 D5 19 8F FA 17 E8 B5 EC 3F BD 7C E3 63 C6' - '76 96 05 E0 52 D6 8D 46 EB 70 AD 0E E3 75 67 02 81 2A 0B A3 02 81 73 02 F1 68 E0 99 FB B8 9F 0E' - 'C2 EB 41 78 F3 42 43 C1 BC 2E 09 C6 A8 60 8C 0E C6 95 1C 01 56 EB 8B 25 EF 0D C6 BE E0 73 87 7F' - '1D 0D 41 0C C7 7E ED D2 A3 49 7F 66 A4 57 F3 30 AF CB 0C 67 6E F4 56 63 BC D4 00 2F 75 12 30 9C' - 'D4 28 2E 35 7E EB 34 F7 E8 6A E4 56 F3 98 AD CB 7D 43 B5 86 73 8F AB 46 65 6D 24 35 12 4B 0D C3' - '52 FB C8 41 16 0C E3 AC 2B AF 4F C9 BB FF FB FE EF 07 5D A9 E9 23 B3 FD 06 5D A9 E1 56 9D FD C6' - '5A 5D CF B9 23 B7 70 EE C8 A3 1C 5F D5 3C 71 E4 15 DF 10 2B FF D1 54 6A EC D4 1D 67 0F 93 5A 1D' - '77 66 8C 54 7F 52 A3 A3 4A 38 2B 4A 8D 82 52 B7 99 97 9F 37 04 EA 38 87 40 A9 5B CE D7 25 60 53' - '02 8E 72 57 74 9A 03 A1 2E 26 66 A9 C6 45 A9 7B CF D3 D8 98 B8 90 C9 82 53 34 B5 40 33 93 E3 A2' - 'FC 6F 39 57 43 A3 9A 03 84 F3 7C 95 FC 75 9C 15 A5 06 45 A5 B3 E7 EF 5F A4 86 43 95 91 1A 0B A5' - 'BA F4 D6 F2 AD 5F 8D 76 BA DA 97 02 98 C4 EE BA E6 D1 4E 6A A8 93 FF 45 2E FE 37 A4 AB 4B 5D D4' - 'B0 27 35 C8 29 91 83 9C D4 08 27 35 AA A9 BD DF 78 A6 32 FA 96 83 99 3A 72 12 D3 1E BE 43 F5 E0' - 'D0 A5 E1 E4 FF EE D3 97 13 97 D4 B8 25 35 56 49 8D 52 EA CD D9 49 2B 38 26 29 9D EF 35 6A 28 52' - '4F BF 71 48 6A 04 52 87 38 8D 1A 7B B4 90 D4 60 A3 BE 09 9A FE 1C 5A A4 46 14 F9 0F 27 52 EB B6' - '5A B1 D5 40 22 35 FF E3 FC B1 44 17 1C 27 34 70 8F 0C E6 50 A1 DE DE ED A9 F6 18 F0 52 F7 4D A8' - 'CB F6 55 CB 87 FA 05 E4 7F 9D BE 91 89 5D FF 8B F4 3B 71 1C D9 7D E4 7F 31 FE F9 57 E2 AB CB F0' - 'FF F9 A2 7B F5 D1 5D CB B7 CC AF 5A C8 D7 2D B4 B9 4F 5E 7D 79 D1 BD 7F 87 52 0F 2E C3 EA 3F 25' - 'C7 D8 7C 7D A6 4A 75 AB C8 72 F3 C5 99 5A 4A 8A 17 64 AA B0 AC FF B5 97 37 52 9F 08 2D A9 7E DE' - '34 8E B3 BA 63 FD EE 3F 56 D3 A0 CE 7F 51 3A F3 5A 74 D1 0B 45 5F ED B0 D7 BB 03 3F D8 16 47 B8' - '0F EF A7 25 2E 0F B5 C5 E1 B6 E0 0C 46 33 73 E9 03 B4 20 7D 8E 05 FD 7D 87 53 1F C5 E2 E3 58 7C' - '4A CD FD AB 5E 9F 95 60 55 09 06 86 7B 7F 78 F9 69 1C 38 8D 26 0F 3C 1E EF EF C5 E3 91 26 4F 80' - 'C7 13 D0 E4 D1 79 3C BA 26 4F A0 C7 13 D8 E4 09 F2 78 82 9A 3C C1 1E 4F 70 93 27 C4 E3 09 69 F2' - 'E8 3D 1E 7D 93 C7 E0 F1 18 9A 3C 46 8F C7 D8 E4 31 79 3C A6 26 8F D9 E3 31 37 79 42 3D 9E D0 26' - '8F C5 E3 B1 34 79 AC 1E 8F B5 C9 63 F3 78 6C 83 76 7B FF 81 03 74 9A 65 17 37 29 D2 BB 3A 8C 39' - '6F 5E E4 0E BF 79 91 FB CF 9E 17 D9 DB B7 64 44 E9 11 7D DE 8C C8 0C 3D 2A F5 D8 CE 45 64 8F 1E' - 'F5 7A ED 6A 93 6E BE E1 58 CD 63 B1 2E 3F 7B 3A A4 1A 91 B5 EE 42 23 B2 D4 8C 48 F1 0D CA F2 3F' - '72 1E F6 37 73 21 D5 18 2D FF 83 E4 EF FD 26 42 9E F2 1D 1E F7 3A FB 60 78 18 07 41 8E 3E 7B 16' - 'E4 9A BF 19 A9 05 DE DB D1 EB EC 83 DB 61 E7 4D 84 54 A3 B6 FC 0F 65 BF F7 1D CA 36 4F 84 54 A3' - 'B6 FA 5F 68 D4 56 F3 5C C8 39 17 3A 58 55 63 B7 FC A7 43 0E A7 E6 E9 90 9F 58 F0 19 67 44 6E A4' - 'E9 8C 6A FA CF 7F 4C B7 A1 93 DF 3D 16 BD 38 A0 AB 79 E6 A3 FF 98 AE E6 F9 8F FE 8B E6 AB 36 6D' - 'E6 63 04 67 3E B6 3F 7B E6 E3 0A DE 06 71 CE 54 47 75 24 D9 85 93 1C E3 79 55 C3 58 5E D2 30 23' - '0E 6B 7D 87 8B 6A 4C 57 3F 1E 2E AA 4B 17 8A E3 F1 0E E7 30 FE C1 A9 8B AD F8 8C FB 23 01 47 12' - 'B0 82 B7 05 A8 C9 89 33 0A 70 9F 6F 4E A2 9A 90 A8 66 23 26 9D 37 88 6B 3D 35 CF 46 4C E3 6C C4' - '51 3C FA 52 A3 B9 D6 FA CD 43 F4 9F 81 38 DC D7 B0 7E C1 19 88 6B D8 A4 EE 3F A0 6B AF 6F 59 FC' - 'BB C9 86 FE 73 0C 55 2B 76 17 9B 0C F0 1B DC B5 D2 6F 76 61 B6 6F 70 57 BE 6F 70 D7 5A B6 56 6F' - 'E2 C8 AE 0E 1C 53 E8 3F A9 F0 4F DF 31 43 AF B3 8F 10 86 9D 37 AC AB 4F A4 F4 F3 8D E9 52 43 B9' - 'D4 51 C1 1A DF 14 42 37 7B 94 73 7C F3 07 3F E2 B4 C1 34 0E DF 3A 67 EC 96 9A 33 78 CE D8 2D B5' - 'F5 6F 1E BB A5 E6 0C 76 64 BB B0 9A 33 38 D2 37 5B 50 8D E0 52 C7 00 BD CE DE FA 5F 70 86 60 9F' - '04 E9 47 6A 92 E0 BC B3 37 FA 2F 70 92 E0 B1 96 67 A6 07 8E F4 6D B2 9F F1 2D D6 AF 71 86 E0 3F' - '6F 34 07 ED D1 B8 0F CA 90 83 92 EB EB 10 9D 7B 50 06 6B 37 C4 8E D0 69 C6 85 21 2F EC CC 98 D3' - '1B 9D 9A 1B DA 69 96 F0 F6 FC 7A 0F 4E 68 E7 86 DE 8D 87 25 00 16 07 2C F9 5A 63 94 A5 5E 2C 1E' - 'AB 65 48 AC D6 04 CA C7 9F 7A DE A9 41 7F CD 63 FD D6 F8 9E 38 5F 98 35 EA D9 D1 8B 8F 0C F5 8C' - 'D8 44 DB 49 DD 64 E2 5D A8 BC D4 CD 15 EA C5 AB 17 BF 09 D4 A7 BE 8C 1F F3 6A F2 7E D2 5E DE CF' - 'CF EB C6 0A CD 14 BE B8 A8 ED D2 D0 C0 E6 D7 11 D5 82 74 4B 04 A6 47 9C 99 52 75 89 F6 37 D5 AF' - '6F 75 0F A4 EA 4E 53 51 D7 61 DA E0 23 FF 31 37 2A ED FF FF 75 77 36 21 51 85 51 18 3E 67 26 4B' - 'A5 CC 7E 0C D1 CA 99 EC 8E FD 1A 44 90 96 91 69 0B 2B ED 8F 50 4B D2 B4 45 11 64 6D 6A DB 2E C2' - 'A0 A2 20 82 08 12 02 95 48 28 2A 17 45 89 62 56 2E 94 9A 3B 0B FB A3 48 5B D4 22 93 7E B8 1B BB' - 'DF 7B FA 6E DF 38 8E D9 2A 08 9E 8D 3B C1 F7 CE F8 7D F7 3D CF 69 87 4A 4B DA FE F2 15 25 A7 9A' - '89 6C FE 39 8A C6 72 1F 1E 78 69 FF C6 EB A6 96 9D F4 8E 5A 7D 7E 7A E6 27 1B 7C F6 D3 90 1E 0E' - '98 13 50 AC 44 35 BB 10 D4 E2 D5 C1 A8 0A DD CB 00 BD 05 03 01 1A 0C D0 47 14 E9 26 62 40 59 84' - '09 A6 65 D1 15 EC BC 68 03 CA 38 7A BE 26 54 F1 6E A0 8A 77 33 48 77 83 D4 86 42 5E AC B0 EF 05' - '1A 78 AF 50 BC 1B 08 FE 6A 18 DC CE A6 3B D9 D4 06 FA C0 3B 70 D5 A2 46 8B 5A D1 54 BB 8F A6 DA' - '23 8B BA 2D 7A 6A 51 8F 45 BD 16 3D 47 4D CD E5 3D F8 60 D1 27 8B 12 42 34 39 44 85 A0 08 EC 0B' - 'D1 FE 10 1D 86 E0 4F 4A 69 83 46 3B 41 EA 5F D2 2D A8 C5 B4 91 FC 8B 27 D3 46 A2 75 95 03 C2 3F' - 'B9 6A 6A 37 76 7B 3B C6 6E EF 55 C6 6E EF 7A 63 B7 77 B3 B1 DB FB 3F AB D6 6E 55 C5 D8 7D 41 3A' - '12 54 5F A4 BD 0B 29 F6 43 6E DB 5C 99 81 94 09 50 99 7E F4 AE 30 BC 19 C8 26 2D E6 F4 66 20 5B' - 'F5 D4 EB 5D 70 4F 8F 41 8E 9A 84 4C D5 32 65 D1 28 7B EA E4 73 41 AA 81 54 F2 18 E4 91 23 4B D5' - '84 DE 09 AD 3C 36 27 F1 A4 3A 27 02 E2 ED 09 63 4E 7C CA 0D 8E 4C 79 EE 50 F7 3D B1 2F DE 76 66' - 'A9 E1 2A A2 43 EE CF AC D8 E4 53 1C 04 57 C0 2D 30 EC 57 94 4F 52 54 82 BA 79 8A 8B E0 1A 68 06' - 'CB E7 2B 7A 80 7C 9A 95 E0 B1 77 3F BB 5C 16 84 39 1B D1 AF 08 73 43 98 4F 87 F9 41 98 1F 86 F9' - '4B 98 87 C3 1C B2 39 C7 E6 3D 36 57 D9 7C C6 E6 B3 36 77 D8 DC 69 F3 37 9B BF DB BC 24 C2 4B 23' - '5C 1D E1 9A 08 9F 8F F0 85 08 EF 3A 28 7F A5 A0 31 B3 9B 6B 88 C1 D7 47 AB BF 45 FA 2D B2 01 99' - 'E5 35 E5 DE 9E D6 3B 79 0A 4D 05 3F E2 C8 BD 45 D6 9D 38 5D 31 0D CA EE CD A9 B4 25 95 6A C7 95' - '72 F7 03 1F A4 DC 89 E9 94 A4 A5 DC CD 19 74 1D 22 EE AA 4C DA 9B 49 35 D1 22 EE 82 00 AD D3 43' - '33 B9 90 63 17 00 D1 62 97 82 AD 90 63 BB 19 F1 45 AB B0 87 F1 3A F4 B8 A1 BF 5E 01 E5 75 77 0B' - '3D 69 A1 BD D0 5C BF 89 D1 5C 9B 22 6B 1E 51 78 33 CD 29 86 AA 3A CB 90 54 BB 98 7A 6A 53 4C 5D' - '9E CC 15 90 51 7F 4D E6 35 71 64 D4 A2 A1 DE 00 0D 75 D7 0C 7E A4 05 D4 AF B5 7A BA C0 50 4F 97' - '69 F5 74 47 1A 77 A5 F1 13 2D 9D 2E D2 BA E9 8D 5A E2 E2 52 94 C1 C5 19 7C 19 A2 E9 46 2D 9A 2E' - '86 65 DA 13 4D 8F A9 98 CE 37 14 D3 97 EA 7F CB A5 1B FA DD DF 5C 75 A3 8C 43 79 8A 43 D3 1D 9A' - '01 66 39 34 DB A1 2C 10 04 D9 0E 2D 74 28 C7 A1 C5 0E FD E1 50 8E E3 78 B9 7A 52 65 37 BC EC 0B' - '97 CB DB 8A 52 2F EA 12 72 89 B7 44 7A 54 80 7D C8 AD CB EA 44 45 3E 58 87 18 4B 80 25 AE 75 B3' - '14 07 8C D0 4A 5C FD E9 8A A4 38 11 AD D6 11 2D F8 53 44 7D 08 E4 08 02 99 A2 03 29 99 1C 33 96' - '8F 8D 58 9A 81 94 F1 FA 72 23 90 12 45 33 84 12 33 2F 54 25 13 08 55 FE 4C 5E 1B 1D AD 52 84 AA' - 'F3 6F 42 E5 C6 A9 48 07 69 54 84 F2 74 84 2E 19 11 3A D5 AF A8 9C EC 49 09 62 77 62 9A 9B 2E 77' - 'AB FB 97 C1 21 1E 19 E2 9F D8 AA E9 DA' -} - - -LANGUAGE 0,0 CASE UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE -{ - '78 DA 6D BD 05 A0 AE 55 D5 B5 3D E6 3E 84 22 2A 0A 28 EA 86 07 90 F6 6C 94 54 41 A5 BB 5B 4C BA' - '41 BA 91 6E A4 BB FB D0 25 2D 21 DD DD DD 25 60 80 89 F5 5F 63 CC 73 78 F1 3B FF F7 BD D7 9C 63' - 'CE B9 F7 B3 F7 B3 E6 DA F7 5A 8B E3 7D 3F D3 7E 46 5A 48 AA B5 1B 69 61 C4 3A 8D B4 08 62 DD 46' - '5A 14 B1 5E 23 2D 86 58 BF 91 16 47 6C D0 48 4B 20 36 6C A4 25 11 1B 35 D2 52 88 8D C7 B2 54 B3' - '34 6E 93 B1 2C DD 2C 83 DB B4 91 96 45 6C D6 48 CB 21 36 6F A4 E5 11 5B 34 D2 0A 88 5F 34 D2 8A' - '88 2D 1B 69 25 C4 56 8D B4 32 62 EB 46 5A 05 B1 4D 23 AD 8A D8 B6 91 56 43 6C D7 48 AB 23 B6 6F' - 'A4 35 10 3B 34 D2 0F 11 3B 36 D2 9A 88 9D 1A E9 47 88 9D 1B 29 A3 5A 0B 35 19 D5 5A B8 C9 A8 D6' - '22 4D 46 B5 16 6D 32 AA B5 58 93 51 AD C5 9B 8C 6A 2D D1 64 54 6B C9 66 63 FD EF D0 6E 92 E2 D8' - '41 CD 60 D6 32 4D 06 B3 96 6D 32 98 B5 5C 93 C1 AC E5 9B 0C 66 AD D0 64 30 6B C5 26 83 59 2B 35' - '19 CC 5A B9 C9 60 D6 2A 4D 06 B3 56 6D 32 98 B5 5A 93 C1 AC D5 9B 0C 66 AD D1 64 30 EB 87 4D 06' - 'B3 D6 6C 32 98 F5 A3 E6 2A DC 0D A3 30 27 8F 0A BF 45 BE DC 48 B7 20 5E 69 A4 5B 11 AF 36 D2 6D' - '88 D7 1A E9 76 C4 EB 8D 74 07 E2 8D 46 BA 13 F1 66 23 DD 85 78 AB 91 EE 46 BC DD 48 F7 20 DE 69' - 'A4 7B 11 BF 6B A4 FB 10 EF 36 D2 FD 88 F7 C6 72 7F F3 00 EE FD B1 3C D0 3C 88 FB 7D 23 3D 84 F8' - '43 23 3D 8C F8 63 23 3D 82 F8 53 23 3D 8A F8 A0 91 1E 43 7C D8 48 8F 23 FE DC 48 4F 20 FE D2 48' - '4F 22 FE DA 48 4F 23 FE DE 48 CF 20 FE D1 48 CF 22 3E 6A A4 E7 10 FF 6C A4 E7 11 FF 6A A4 17 10' - 'FF 6E A4 17 11 FF 69 A4 97 A4 A1 6D 32 21 CA 72 95 48 3B FE 2F 5D AA DF 36 E9 52 DD D2 A4 4B 75' - '6B 93 2E D5 6D 4D BA 54 B7 37 E9 52 DD D1 A4 4B 75 67 93 2E D5 5D 4D BA 54 77 37 E9 52 DD D3 A4' - '4B 75 6F 93 2E D5 7D CD 7B 09 C6 F6 E9 FD 04 63 3B 94 CE D4 83 4D 3A 53 0F 35 E9 4C 3D DC A4 33' - 'F5 48 93 CE D4 A3 4D 3A 53 8F 35 E9 4C 3D DE A4 33 F5 44 93 CE D4 93 4D 3A 53 4F 37 E9 4C 3D D3' - 'A4 33 F5 6C 93 CE D4 73 4D 3A 53 CF 37 E9 4C BD D0 A4 33 F5 62 F3 DF 04 3B 56 10 AE 1A 74 CC D8' - 'FF 3F 84 19 D5 48 31 E5 14 4C 80 9B B0 91 62 CA 29 98 08 37 71 23 C5 94 53 F0 29 DC A7 1B 29 A6' - '9C 82 49 70 9F 69 A4 98 72 0A 26 C5 7D B6 91 62 CA 29 F8 1C EE F3 8D 14 53 4E C1 64 B8 2F 34 52' - '4C 39 05 5F C4 4D DE 48 31 E5 14 4C 81 9B B2 91 62 CA 29 F8 12 EE CB 8D 14 53 4E C1 54 B8 AF 34' - '52 4C 39 05 5F C5 7D AD 91 62 CA 29 18 C6 4D DD 48 31 E5 14 4C 83 1B 34 52 4C 39 05 D3 E2 A6 6B' - 'A4 98 72 0A A6 C7 7D BD 91 62 CA 29 98 01 37 63 23 C5 94 53 30 13 6E E6 46 8A 29 A7 60 16 DC AC' - '63 99 A5 99 35 F5 B1 C1 6C B8 6F 34 52 4C 39 05 A3 71 23 8D 14 53 4E C1 EC B8 6F 8E 65 F6 E6 9B' - 'A9 8F 0D BE C5 24 63 E1 9A 78 54 AF 5F 84 66 8E 7C C9 D8 C5 6C 4E 72 73 35 52 4C 39 05 73 E3 E6' - '69 A4 98 72 0A E6 C5 7D BB 91 62 CA 29 F8 2E 6E BE 46 8A 29 A7 60 7E DC F7 1A 29 A6 9C 82 EF E3' - '7E D0 48 31 E5 14 2C 80 5B B0 91 62 CA 29 58 08 B7 70 C3 C6 2A 15 A7 60 11 DC A2 0D 1B AB 54 9C' - '82 C5 70 8B 37 6C AC 52 71 0A 96 C0 2D D9 B0 B1 4A C5 29 58 8A 01 BC 61 C8 AB 77 8D 95 2C DF 63' - 'DD D2 7C C9 32 0D 7B AB 7C 97 53 B0 2C 6E B9 86 BD 55 2A 4E C1 F2 B8 15 1A F6 56 A9 38 05 2B E2' - '56 6A D8 5B A5 E2 14 AC 8C 5B A5 E1 1A 9F 8A 53 B0 2A 6E B5 86 BD 55 2A 4E C1 EA B8 35 1A F6 56' - 'A9 38 05 3F C4 AD D9 B0 B7 4A C5 29 F8 11 EE C7 8D 14 53 4E C1 4F 70 3F 6D A4 98 72 0A 7E 86 FB' - '79 23 C5 94 53 B0 16 6E ED 86 9D 5A 2A 4E C1 3A B8 75 1B 76 6A A9 38 05 EB E1 D6 6F D8 A9 A5 E2' - '14 6C 80 DB B0 61 A7 96 8A 53 B0 11 6E E3 86 9D 5A 2A 4E C1 26 B8 4D 1B B6 69 A9 38 05 9B E1 36' - '6F D8 A6 A5 E2 14 6C 81 FB 45 C3 36 2D 15 A7 60 4B DC 56 0D DB B4 54 9C 82 AD 71 DB 34 2C C5 A9' - '38 05 DB E2 B6 6B D8 A6 A5 E2 14 6C 8F DB A1 61 9B 96 8A 53 E0 55 83 F5 A3 B2 86 EC 44 B0 73 C3' - '36 2D 5F E6 14 EC 82 DB B5 91 62 CA 29 D8 0D F7 CB 46 8A 29 A7 60 F7 EA 3D F9 B8 5D E4 1E FD D7' - '31 14 F6 F4 0C 1B 0A D2 5E 04 7B 37 52 4C 39 05 FB E0 F6 6D A4 98 72 0A F6 F3 CC 1B 0A D2 FE 04' - '07 34 52 4C 39 05 07 7A 1A 0E 05 E9 20 4F D1 A1 20 1D 4C 70 48 23 C5 94 53 70 28 EE 85 46 3A CC' - '93 77 28 48 87 7B BE 0E 05 E9 08 82 23 1B 29 A6 9C 82 A3 3C F3 86 82 74 B4 E7 DE 50 90 8E C9 97' - 'FD B5 C2 B1 9E 47 43 41 3A CE B3 68 28 48 C7 13 9C D0 48 31 E5 14 9C D8 17 AC A1 70 B2 A7 CE 50' - '90 4E F1 24 18 0A D2 A9 BD B0 0C 85 D3 3C 27 86 82 74 3A C1 19 8D 14 53 4E C1 99 B8 B3 1A 29 A6' - '9C 82 B3 71 E7 34 52 4C 39 05 E7 E2 F6 18 0A D2 18 82 F3 1A 29 A6 9C 82 F3 DD DC A1 20 5D 44 70' - '71 23 C5 94 53 70 89 5B 38 14 A4 4B 09 2E 6B A4 98 72 0A 2E C7 1D 34 14 A4 2B DC B3 A1 20 FD 9A' - 'E0 CA 46 8A 29 A7 E0 2A DC D5 8D 14 53 4E C1 35 6E E1 50 90 AE 25 B8 AE 91 62 CA 29 B8 01 77 63' - '23 C5 94 53 70 73 82 BF 55 B8 1D 77 E7 58 EE A0 70 C7 FF C6 45 FD CE 7C FD D8 E0 2E DC 3D 63 B9' - '9B C2 DD FF 1B 17 F5 7B F2 F5 63 83 7B 71 F7 8F E5 3E 0A F7 FD 6F 5C D4 EF CF D7 8F 0D 1E C0 3D' - 'D8 70 34 49 C5 29 78 08 F7 70 C3 D1 24 15 A7 E0 11 DC A3 0D 47 93 54 9C 82 C7 70 8F 37 1C 4D 52' - '71 0A 9E C0 3D D9 70 34 49 C5 29 78 0A F7 74 C3 39 25 15 A7 E0 19 DC B3 0D E7 94 54 9C 82 E7 70' - 'CF 37 9C 53 52 71 0A F2 37 59 FE 0B 85 17 71 2F 35 9C 53 52 71 0A 5E C6 BD D2 70 30 49 C5 29 78' - '15 F7 5A C3 C1 24 15 A7 E0 75 DC 1B 0D 07 93 54 9C 82 37 71 6F 35 1C 4C 52 71 0A DE C6 BD D3 70' - '30 49 C5 29 F8 1D EE DD 86 83 49 2A 4E C1 7B B8 F7 1B 0E 26 A9 38 05 BF C7 FD A1 E1 60 92 8A 53' - 'F0 47 76 03 9B 48 93 B2 B3 B2 5C 3A 72 AC FB 13 5F F2 E1 58 3E E0 9B 3E F8 DF B8 A8 7F 98 D7 1A' - '1B FC 19 F7 97 86 03 4B 2A 4E 81 AF 4B C7 34 92 27 F4 CD 0D A7 17 C4 3F 1A 4E 2F F9 1E A7 E0 23' - 'DC 3F 1B 4E 2F A9 38 05 FF C2 FD BB E1 F4 92 8A 53 F0 1F 2F 3A 0D A7 97 54 9C 02 F1 87 58 8D 8F' - '27 39 BD 0C 85 21 DC A8 86 D3 4B 97 87 C2 04 B8 09 1B 4E 2F A9 38 05 13 E1 26 6E D8 95 A6 E2 14' - '7C 0A F7 E9 86 D3 4B 2A 4E C1 24 B8 CF 34 9C 5E 52 71 0A 26 C5 7D B6 E1 F4 92 8A 53 F0 39 DC E7' - '1B 4E 2F A9 38 05 93 E1 BE D0 70 7A 49 C5 29 F8 22 6E F2 86 D3 4B 2A 4E C1 14 B8 29 1B 4E 2F A9' - '38 05 5F C2 7D B9 E1 F4 92 8A 53 30 15 EE 2B 0D A7 97 54 9C 82 AF E2 BE D6 70 7A 49 C5 29 18 C6' - '4D DD 70 7A 49 C5 29 98 06 37 68 38 BD A4 E2 14 78 45 61 6D A9 AC 2F D3 13 7C BD E1 C0 92 2F 73' - '0A 66 C0 CD D8 70 60 49 C5 29 98 09 37 73 C3 81 25 15 A7 60 16 DC AC 8D 14 53 4E C1 6C B8 6F 34' - '1C 55 52 71 0A 46 E3 46 1A 8E 2A A9 38 05 B3 E3 BE D9 48 31 E5 14 7C 0B 37 47 23 C5 94 53 30 27' - '6E AE 86 B3 49 2A 4E C1 7C B8 F5 47 07 69 7E 82 EF 35 1C 2D F2 65 4E 81 97 65 16 E8 CA 22 FD 03' - '82 0D 46 07 69 81 7C D9 2F 47 87 05 13 EC 3E 3A 2C C4 97 2D DC 70 B4 48 C5 29 F0 4E 69 8F 0A 1C' - '2D 08 0E 6C A4 C5 10 87 34 1C 2D 10 4B 34 52 4C 39 05 4B E2 96 6A A4 98 72 0A 96 C6 2D D3 70 96' - '48 C5 29 58 16 B7 5C C3 59 22 15 A7 60 79 DC 0A 0D 67 89 54 9C 82 15 13 FC 62 74 58 29 C1 E6 A3' - 'C3 CA 09 B6 1C 1D B2 D5 2B 6F FC 20 DB B6 F2 26 0E B2 39 2B 6F D5 20 9B B3 F2 56 0D B2 EB 2A EF' - 'C1 20 BB AE F2 1E 0C 7E 92 E0 C2 31 21 1B AD F2 B6 0B D6 4E 70 D1 98 90 5D 57 79 0F 06 EB 27 F8' - 'D5 98 B0 41 82 0B C6 84 EC BA CA 7B 30 C8 7E AC BC 3B 83 4D 12 5C 32 26 6C 9A 60 9D D1 61 B3 04' - '17 8F 09 D9 82 95 37 64 B0 55 82 2D 46 87 EC C7 CA BB 33 C8 16 AC BC 21 83 DD 12 AC 37 3A 64 07' - '55 DE 4F C1 5E 09 EE 18 13 B2 69 2A 6F A1 60 FF 04 97 8F 09 07 F4 EF 56 21 33 A3 3C 4F E0 A0 FE' - 'B2 0A D9 1A 95 37 4A 90 39 53 9E 41 90 3D 4F 79 07 04 A7 F4 97 8D 09 A7 26 B8 6C 4C 98 D8 FF 81' - 'D6 A7 FA B1 2C 86 BB CE B9 13 46 85 2D 71 5B 35 1C 56 46 A5 E7 A3 C2 D6 B8 6D 1A 0E 2B A9 38 05' - 'DB E3 76 68 38 92 A4 E2 14 EC 92 E0 DF A3 C2 AE 09 FE 33 2A EC 96 E0 BF A3 C2 EE B8 0F 1B 69 3F' - 'C4 45 0D 07 00 C4 C5 8D 74 20 E2 92 86 03 00 E2 D2 86 3D 3F E2 FE 46 3A 14 F1 40 C3 9E 1F F1 60' - 'C3 9E 7F 94 46 F1 66 3F 45 CC FF 39 3A 61 5C F4 7F EA 08 EC E5 0D 67 01 C4 15 8D 74 14 E2 D7 0D' - '67 01 C4 95 0D 67 01 C4 55 8D 74 2C E2 EA 86 B3 00 E2 9A 86 B3 00 E2 DA 86 B3 40 8F 7C 46 5F 27' - '22 AE 6F A4 93 10 BF 69 24 FF C7 F4 1B 1A 0E 06 88 1B 1B 0E 06 88 9B 1A E9 34 C4 CD 0D 07 03 C4' - '6F 1B 0E 06 88 5B 1A CE 02 88 DB C6 72 56 73 36 EE F6 86 13 01 E2 8E 46 3A 17 71 67 C3 89 00 71' - '57 C3 89 00 71 77 23 9D 8F B8 A7 91 2E 40 DC DB 48 17 22 EE 6B 38 2B A4 E3 EE 2E A4 9F E5 EE 42' - 'FA 59 EE 2E A4 9F E5 EE C2 65 34 E6 8E 8F 1B E6 E8 9C 8F 1B F6 B1 4A A3 CA 6D 83 34 AA DC 36 48' - 'A3 CA 6D 83 34 AA DC 36 48 A3 CA 6D 83 34 AA DC 36 48 A3 CA 6D 83 34 AA DC 36 48 A3 C6 FD 9D A4' - '51 E5 B6 41 1A 55 6E 1B A4 51 E3 FE 0D 24 8D 2A B7 0D D2 A8 72 DB 20 8D 2A B7 0D D2 A8 72 DB 20' - '8D 2A B7 0D 6E ED 66 7D DC AD DB 52 1C 1B A4 65 E5 06 42 5A 56 6E 20 A4 65 E5 06 42 5A 56 6E 20' - 'A4 65 E5 06 42 5A 56 6E 20 A4 65 E5 06 42 5A 56 6E 20 E4 CF AA FC 47 06 F9 B3 2A FF 91 41 FE AC' - 'CA 7F 64 F0 10 EE A9 86 63 C8 D8 BF 9A 71 BD 78 64 EC BC 1F 37 9A 4F 8C 9D 58 E3 7E C9 27 C7 CE' - 'D7 71 A3 90 17 29 BF 24 3C 8D 7B A6 91 62 CA 29 78 16 F7 5C 23 C5 94 53 F0 3C EE 85 46 8A 29 A7' - 'E0 45 DC 4B 0D 67 8D 54 9C 82 97 71 AF 34 9C 35 52 71 0A 5E C5 BD D6 70 D6 48 C5 29 78 1D F7 46' - 'C3 59 23 15 A7 E0 4D DC 5B 0D 67 8D 54 9C 82 B7 71 EF 34 9C 35 52 71 0A 7E 87 7B B7 E1 AC 91 8A' - '53 F0 1E EE FD 86 B3 46 2A 4E C1 EF 71 7F 68 38 6B A4 E2 14 FC 71 EC 25 65 DC 44 FD D3 D8 EB C0' - 'B8 D9 F5 41 BE F8 1F A3 42 AE BE E5 6B 31 FC F9 93 97 AA BF 8C BD B4 8D FB 83 F9 1B EE EF 0D E7' - '89 7C 9B 53 E0 97 FA A0 91 3E 42 FC B3 E1 3C 91 2F 73 0A BC 22 EC D2 48 5E 11 76 6D 38 42 20 76' - '6B F8 7F 13 A8 56 6C 7C 12 50 AD D4 70 B6 40 AC DC 70 84 40 AC D2 F0 2D 88 55 1B 8E 10 88 D5 1A' - '69 22 C4 EA 0D 47 08 C4 1A 8D F4 29 C4 0F 1B 8E 10 88 35 1B 69 12 C4 8F 1A 8E 10 88 1F 37 9C D6' - '10 3F 69 38 42 20 7E DA 48 9F 43 FC AC E1 08 81 F8 79 23 4D 86 F8 56 C3 11 02 31 47 23 7D 11 31' - '67 C3 11 02 31 57 23 4D 81 98 BB E1 08 81 98 A7 91 BE 84 98 B7 E1 08 81 F8 76 23 4D 85 F8 4E C3' - '11 02 F1 DD 46 FA 2A 62 BE 86 23 04 62 FE 46 1A 46 7C AF E1 08 81 F8 7E 23 4D 83 F8 41 C3 11 02' - 'B1 40 23 4D 8B 58 B0 91 A6 43 2C D4 70 9E 40 2C DC 70 9E 40 2C D2 48 33 20 16 6D 38 4F 20 16 6B' - 'A4 99 10 8B 37 9C 27 10 4B 34 D2 2C 88 25 1B CE 13 88 A5 1A 69 36 C4 D2 0D E7 09 C4 32 8D 34 1A' - 'B1 6C C3 79 02 B1 5C 23 CD 8E 58 BE E1 3C 81 58 A1 91 D2 97 72 97 20 7D 29 77 09 D2 97 72 97 20' - '7D 29 77 09 D2 97 72 97 20 7D 29 77 09 D2 97 72 97 20 7D 29 77 09 D2 97 72 97 20 7D 29 77 09 D2' - '97 72 97 20 7D 29 77 09 D2 97 72 97 20 7D 29 77 09 D2 97 72 97 20 7D 29 77 09 D2 97 72 97 20 7D' - '29 77 09 D2 97 72 97 20 7D 29 77 09 D2 97 72 97 20 7D 29 77 09 D2 97 72 97 20 7D 29 77 09 D2 97' - '72 97 20 7D 29 77 09 D2 97 72 97 20 7D 29 77 09 D2 97 72 97 20 7D 29 77 09 D2 97 72 97 20 7D 29' - '77 09 FA 3A E0 AB 02 E4 3A 50 BE 2A 40 AE 03 E5 AB 02 E4 3A 50 BE 2A C0 AA 7D ED 98 20 E4 3A 50' - 'BE 2A 40 AE 03 E5 AB 02 E4 3A 50 BE 2A 40 AE 03 E5 AB 02 E4 3A 50 BE 2A 40 AE 03 E5 AB 02 E4 3A' - '50 BE 2A 40 AE 03 E5 AB 02 E4 3A 50 BE 2A 40 AE 03 E5 AB 02 E4 3A 50 BE 2A C0 5A B8 B5 1B 29 A6' - '9C 82 75 70 EB 36 52 4C 39 05 EB E1 D6 6F A4 98 72 0A 36 C0 6D D8 48 31 E5 14 6C 84 DB B8 91 62' - 'CA 29 D8 04 B7 69 23 C5 94 53 B0 19 6E F3 46 8A 29 A7 60 0B DC 2F 1A 29 A6 9C 82 2D 71 5B 35 1C' - '1E 52 71 0A B6 C6 6D D3 70 78 48 C5 29 D8 16 B7 5D 23 C5 94 53 B0 3D 6E 87 86 63 45 2A 4E C1 8E' - 'B8 9D 1A 29 A6 9C 82 9D 71 BB 34 52 4C 39 05 BB E2 76 6B A4 98 72 0A 7E 89 DB BD 91 62 CA 29 D8' - '03 B7 67 23 C5 94 53 70 10 EE E0 46 8A 29 A7 E0 10 DC AF 1A 29 A6 9C 82 43 71 87 35 9C 4B 52 71' - '0A 0E C7 1D D1 48 31 E5 14 1C 89 3B AA E1 FC 91 8A 53 70 34 EE 98 86 F3 47 2A 4E C1 B1 B8 E3 1A' - 'CE 1F A9 38 05 C7 E3 4E 68 38 7F A4 E2 14 9C 88 3B A9 E1 FC 91 8A 53 70 32 EE 94 86 F3 47 2A 4E' - 'C1 A9 B8 D3 1A CE 1F A9 38 05 A7 E3 CE 68 38 7F A4 E2 14 9C 89 3B AB E1 30 92 8A 53 70 36 EE 9C' - '86 63 48 2A 4E C1 B9 B8 31 0D C7 90 54 9C 82 F3 70 E7 37 1C 43 52 71 0A 2E C0 5D D8 70 0C 49 C5' - '29 B8 08 77 71 23 C5 94 53 70 09 EE D2 46 8A 29 A7 E0 32 DC E5 8D 14 53 4E C1 15 B8 5F 37 52 4C' - '39 05 57 E2 AE 6A A4 98 72 0A AE C6 5D D3 48 31 E5 14 5C 8B BB AE 91 62 CA 29 B8 1E F7 9B 46 8A' - '29 A7 E0 06 DC 8D 8D 14 53 4E C1 4D B8 9B 1B 29 A6 9C 82 DF E2 1E 6A A4 5B 10 B7 36 52 4C 39 05' - 'B7 E1 6E 6F A4 98 72 0A EE C0 DD D9 48 31 E5 14 DC 85 BB BB 91 62 CA 29 B8 07 77 6F 23 C5 94 53' - '70 1F EE FE 46 8A 29 A7 E0 01 DC 83 8D 14 53 4E 41 7E F5 F2 1B 81 87 71 8F 34 52 4C 39 05 8F E2' - '1E 6B A4 98 72 0A 1E C7 3D D1 48 31 E5 14 3C 89 7B AA 91 62 CA 29 78 1A F7 4C C3 31 24 15 A7 E0' - '59 DC 73 0D C7 90 54 9C 82 E7 71 2F 34 1C 43 52 71 0A 5E C4 BD D4 70 0C 49 C5 29 78 19 F7 4A C3' - '31 24 15 A7 E0 55 DC 6B 0D C7 90 54 9C 82 D7 71 6F 34 1C 43 52 71 0A DE C4 BD D5 70 0C 49 C5 29' - '78 1B F7 4E C3 31 24 15 A7 E0 77 B8 77 1B 8E 21 A9 38 05 EF E1 DE 6F 38 86 A4 E2 14 FC 1E F7 87' - '86 63 48 2A 4E C1 1F 71 7F 6A A4 98 72 0A 3E C0 7D D8 48 31 E5 14 FC 19 F7 97 86 03 48 2A 4E C1' - '5F 71 7F 6B A4 98 72 0A FE 8E FB 47 23 C5 94 53 F0 11 EE 9F 0D 47 91 54 9C 82 7F E1 FE DD 48 31' - 'E5 14 FC 07 F7 DF 86 73 49 2A 4E 81 26 64 D3 D1 78 3B 91 4D C9 84 61 08 37 AA E1 5C 92 8A 53 30' - '01 6E C2 86 EF 4F C5 29 98 08 37 71 C3 B9 24 15 A7 E0 53 B8 4F 37 9C 4B 52 71 0A 26 C1 7D A6 E1' - '5C 92 8A 53 30 29 EE B3 0D E7 92 54 9C 82 CF E1 3E DF 70 2E 49 C5 29 98 0C F7 85 86 73 49 2A 4E' - 'C1 17 71 93 37 9C 4B 52 71 0A A6 C0 4D D9 70 2E 49 C5 29 F8 12 EE CB 0D E7 92 54 9C 82 A9 70 5F' - '69 38 97 A4 E2 14 7C 15 F7 B5 86 73 49 2A 4E C1 30 6E EA 86 73 49 2A 4E C1 34 B8 41 C3 B9 24 15' - 'A7 60 5A DC 74 0D E7 92 54 9C 82 E9 71 5F 6F 38 97 A4 E2 14 CC 80 9B B1 E1 5C 92 8A 53 30 13 6E' - 'E6 86 73 49 2A 4E C1 2C B8 59 1B CE 25 A9 38 05 B3 E1 BE D1 70 2E 49 C5 29 18 8D 1B 69 38 97 A4' - 'E2 14 CC 8E FB 66 C3 B9 24 15 A7 60 0E DC DA 8D 34 27 62 9D 46 9A 0B B1 6E 23 CD 8D 58 AF 91 E6' - '41 AC DF 48 F3 22 36 68 A4 6F 23 36 6C A4 EF 20 36 6A A4 EF 22 36 6E A4 F9 10 9B 34 D2 FC 88 4D' - '1B E9 7B 88 CD 1A E9 FB 88 CD 1B E9 07 88 2D 1A 69 01 C4 2F 1A 69 41 C4 96 8D B4 10 62 AB 46 5A' - '18 B1 75 23 2D 82 D8 A6 91 16 45 6C DB 48 8B 21 B6 6B A4 C5 11 DB 37 D2 12 88 1D 1A 69 49 C4 8E' - '8D B4 14 62 A7 46 5A 1A B1 73 23 2D 83 D8 A5 91 96 45 EC DA 48 CB 21 76 6B A4 E5 11 BF 6C A4 15' - '10 BB 37 D2 8A 88 3D 1A 69 25 C4 9E 8D B4 32 62 AF 46 5A 05 B1 77 23 AD 8A D8 A7 91 56 43 EC DB' - '48 AB 23 F6 6B 38 08 A4 F5 EE 39 A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5' - '9E 43 BA 5C EE 39 A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5 9E 43 BA 5C EE' - '39 A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5 9E' - '43 BA 5C EE 39 A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5 9E 43 BA 5C EE 39' - 'A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5 9E 43' - 'BA 5C EE 39 A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5 9E C3 FE 2C 1A EB E7 75 CA 72 9E 48 3B 5E EF F4' - 'C9 58 54 46 02 FB 68 82 1A 09 D2 99 04 43 23 81 7D 34 C1 A8 91 20 9D 4D 30 C1 48 60 1F 4D 30 E1' - '48 90 CE 25 98 68 24 B0 8F 26 98 78 24 48 E7 11 7C 6A 24 B0 8F 26 F8 F4 48 90 2E 20 98 64 24 B0' - '8F 26 F8 CC 48 90 2E 22 98 74 24 B0 8F 26 F8 EC 48 90 2E 21 F8 DC 48 60 1F 4D F0 F9 91 20 5D 46' - '30 D9 48 60 1F 4D F0 85 91 20 5D 41 F0 C5 91 C0 3E 9A 60 F2 91 20 5D 49 30 C5 48 60 1F 4D 30 E5' - '48 90 AE 26 F8 D2 48 60 1F 4D F0 E5 91 20 5D 4B 30 D5 48 60 1F 4D F0 95 91 20 5D 4F F0 D5 91 C0' - '3E 9A E0 6B 23 41 BA 81 60 78 24 B0 8F 26 98 7A 24 48 37 11 4C 33 12 D8 47 13 0C 46 82 F4 5B 82' - '69 47 02 FB 68 82 E9 46 02 FB 68 82 E9 47 82 74 1B C1 D7 47 02 FB 68 82 19 46 82 74 07 C1 8C 23' - '41 BA 8B 60 E6 91 20 3D 40 30 32 12 A4 87 27 CB 96 96 D4 E1 C3 7A 24 01 B6 8E 18 D6 A3 09 B0 75' - 'E4 B0 1E 4B 80 AD A3 86 F5 78 02 6C 1D 3D AC 27 12 60 EB 98 61 3D 99 00 5B C7 0E EB A9 04 D8 3A' - '6E 58 4F 27 C0 D6 F1 C3 7A 26 01 B6 4E 18 D6 B3 09 B0 75 E2 B0 9E 4B 80 AD 93 86 F5 7C 02 6C 9D' - '3C AC 17 12 60 EB 94 61 BD 98 00 5B A7 0E EB A5 04 D8 3A 6D 58 2F 27 C0 D6 E9 C3 7A 25 01 B6 CE' - '18 D6 AB 09 B0 75 E6 B0 5E 4B 80 AD B3 86 F5 7A 02 6C 9D 3D AC 37 12 60 EB 9C 61 BD 99 00 5B E7' - '0E EB AD 04 D8 1A 33 AC B7 13 60 EB BC 61 BD 93 00 5B E7 0F EB 77 09 B0 75 C1 B0 DE 4D 80 AD 0B' - '87 F5 5E 02 6C 5D 34 AC F7 13 60 EB E2 61 FD 3E 01 B6 2E 19 D6 1F 12 60 EB D2 61 FD 31 01 B6 2E' - '1B D6 9F 12 60 EB F2 61 7D 90 00 5B 57 0C EB C3 04 D8 FA F5 B0 FE 9C 00 5B 57 0E EB 2F 09 B0 75' - 'D5 B0 FE 9A 00 5B 57 0F EB 6F 09 B0 75 CD B0 FE 9E 00 5B D7 0E EB 1F 09 B0 75 DD B0 3E 4A 80 AD' - 'EB 87 F5 EF 04 D8 BA 71 58 FF 49 80 AD 9B 86 F5 DF 04 D8 BA 79 58 A7 4F EE FF 3E 73 A1 2F 2D 56' - '5B 59 9D 69 B5 B5 D5 59 56 DB 58 9D 6D B5 AD D5 39 56 DB 59 9D 6B B5 BD D5 18 AB 1D AC CE B3 DA' - 'D1 EA 7C AB 9D AC 2E B0 DA D9 EA 42 AB 5D AC 2E B2 DA D5 EA 62 AB DD AC 2E B1 FA A5 D5 A5 56 BB' - '5B 5D 66 B5 87 D5 E5 56 7B 5A 5D 61 B5 97 D5 AF AD F6 B6 BA D2 6A 1F AB AB AC F6 B5 BA DA 6A 3F' - 'AB 6B AC F6 B7 BA D6 EA 00 AB EB AC 0E B4 BA DE EA 20 AB DF 58 1D 6C 75 83 D5 21 56 37 5A FD CA' - 'EA 26 AB 43 AD 6E B6 3A CC EA B7 56 87 5B DD 62 75 84 D5 AD 56 47 5A DD 66 75 94 D5 ED 56 47 5B' - 'DD 61 75 8C D5 9D 56 C7 5A DD 65 75 9C D5 DD 56 C7 5B DD 63 75 82 D5 BD 56 27 5A DD 67 75 92 D5' - 'FD 56 27 5B 3D 60 75 8A D5 83 56 A7 5A 3D 64 75 9A D5 C3 56 A7 5B 3D 62 75 86 D5 A3 56 67 5A 3D' - '66 75 96 D5 E3 56 67 5B 3D 61 75 8E D5 93 56 E7 5A 3D 65 35 C6 EA 69 AB F3 AC 9E B1 3A DF EA 59' - 'AB 0B AC 9E B3 BA D0 EA 79 AB 8B AC 5E B0 BA D8 EA 45 AB 4B AC 5E B2 BA D4 EA 65 AB CB AC 5E B1' - 'BA DC EA 55 AB 2B AC 5E B3 FA B5 D5 EB 56 57 5A BD 61 75 95 D5 9B 56 57 5B BD 65 75 8D D5 DB 56' - 'D7 5A BD 63 75 9D D5 EF AC AE B7 7A D7 EA 37 56 EF 59 DD 60 F5 BE D5 8D 56 BF B7 BA C9 EA 0F 56' - '37 5B FD D1 EA EF 93 FB C8 6A F5 0F AB 0F AC 3E B2 FA D0 EA 9F 56 7F B6 FA 97 D5 5F AC FE 6D C5' - 'B7 55 BE FF 8F 2D F8 E6 CA AB FC A9 05 2F 51 79 AD 0F 5A F0 42 95 57 FC B0 05 2F 57 79 DD 3F B7' - 'E0 45 2B AF FE 97 16 7B 0C F7 BF 15 8D FB 27 89 3D 87 FB 5F 88 C6 FD 43 C4 5E C3 FD EF 35 E3 FE' - '59 60 EF E1 FE 87 99 71 FF FD 7F 9F E1 FE B7 99 71 FF 04 B0 EF FF 13 EF 37 DC FF A6 32 EE 3F DD' - 'EF 3F DC FF 2D 7A DC 7F 85 3E 80 78 99 73 BD C3 3A 37 B0 2E 65 7D CA 4A C5 BA 94 F5 29 2B 15 EB' - '52 D6 A7 AC 54 AC 4B 59 9F B2 52 B1 2E 65 7D CA 4A C5 BA 94 F5 29 2B 15 EB 52 D6 A7 AC 54 AC 4B' - '59 9F B2 52 B1 2E 65 7D CA 4A C5 BA 94 F5 29 2B 15 EB 52 D6 A7 AC 54 AC 4B 59 9F B2 52 B1 2E 65' - '7D CA 4A C5 BA 94 F5 29 2B 15 EB 52 D6 A7 AC 54 AC 4B 59 9F B2 52 B1 2E 65 7D CA 4A C5 BA 94 F5' - '29 2B 15 EB 52 D6 A7 AC 54 AC 4B 59 9F B2 52 B1 2E 65 7D CA 4A C5 BA 94 F5 29 2B 15 EB 52 D6 A7' - 'AC 54 AC 4B 59 9F B2 52 B1 2E 65 7D CA 4A C5 BA 94 F5 29 2B 15 EB 52 D6 A7 AC 54 AC 4B 59 9F B2' - '52 B1 2E 65 7D CA 4A C5 BA 94 F5 29 2B 15 EB 52 D6 A7 AC 54 AC 4B 59 9F B2 52 B1 2E 65 7D CA 4A' - 'C5 BA 94 F5 29 2B 15 EB 52 D6 A7 AC 54 AC 4B 59 9F B2 52 B1 2E 65 7D CA 4A C5 BA 94 F5 29 2B 15' - 'EB 52 D6 A7 AC 54 AC 4B 59 9F B2 52 B1 2E 65 7D CA 4A C5 BA 94 F5 29 2B 15 EB 52 D6 A7 AC 54 AC' - '4B 59 9F B2 52 B1 2E 65 7D CA 4A C5 BA 94 F5 29 2B D5 4E 53 E7 1E 84 31 61 B7 04 EB 8E 0E 87 26' - 'B8 73 4C D0 34 EC 8A 1B CF F8 FC E7 98 69 C2 10 6E 54 23 C5 94 53 30 01 6E C2 46 8A 29 A7 60 22' - 'DC C4 8D 14 53 4E C1 A7 70 9F 6E A4 98 72 0A 26 C1 7D A6 91 62 CA 29 98 14 F7 D9 46 8A 29 A7 E0' - '73 B8 CF 37 52 4C 39 05 93 E1 BE D0 48 31 E5 14 7C 11 37 79 23 C5 94 53 30 05 6E CA 46 8A 29 A7' - 'E0 4B B8 2F 37 52 4C 39 05 53 E1 BE D2 48 31 E5 14 7C 15 F7 B5 46 8A 29 A7 60 18 37 75 23 C5 94' - '53 30 0D 6E D0 48 83 6E C5 34 61 5A DC 74 8D 14 53 4E C1 F4 B8 AF 37 52 4C 39 05 33 E0 66 6C A4' - '98 72 0A 66 C2 CD DC 48 31 E5 14 CC 82 9B B5 91 62 CA 29 98 0D F7 8D 46 8A 29 A7 60 34 6E A4 91' - '62 CA 29 98 1D F7 CD 46 8A 29 A7 E0 5B B8 39 1A 29 A6 9C 82 39 71 73 35 52 4C 39 05 73 E3 E6 69' - 'A4 98 72 0A E6 C5 7D BB 91 62 CA 29 F8 0E EE BB 8D 14 53 4E C1 7C B8 F9 1B 29 A6 9C 82 EF E1 BE' - 'DF 48 31 E5 14 FC 00 B7 40 23 C5 94 53 B0 20 6E A1 46 8A 29 A7 60 61 DC 22 8D 14 53 4E C1 A2 B8' - 'C5 1A 29 A6 9C 82 C5 71 4B 34 52 4C 39 05 4B E2 96 6A A4 98 72 0A 96 C6 2D D3 48 31 E5 14 2C 8B' - '5B AE 91 62 CA 29 58 1E B7 42 23 C5 94 53 B0 22 6E A5 46 8A 29 A7 60 65 DC 2A 8D 14 53 4E C1 AA' - 'B8 D5 1A 29 A6 9C 82 D5 71 6B 34 52 4C 39 05 3F C4 AD D9 48 31 E5 14 FC 08 F7 E3 46 8A 29 A7 E0' - '27 B8 9F 36 52 4C 39 05 3F C3 FD BC 91 62 CA 29 58 0B B7 76 23 C5 94 53 B0 0E 6E DD 46 8A 29 A7' - '60 3D DC FA 8D 14 53 4E C1 06 B8 0D 1B 29 A6 9C 82 8D 70 1B 37 52 4C 39 05 9B E0 36 6D A4 98 72' - '0A 36 C3 6D DE 48 31 E5 14 6C 81 FB 45 23 C5 94 53 B0 25 6E AB 46 8A 29 A7 60 6B DC 36 8D 14 53' - '4E C1 B6 B8 ED 1A 29 A6 9C 82 ED 71 3B 34 52 4C 39 05 3B E2 76 6A 58 4B 52 71 0A 76 C6 ED D2 48' - '31 E5 14 EC 8A DB AD 91 62 CA 29 F8 25 6E F7 46 8A 29 A7 60 0F DC 9E 8D 14 53 4E C1 5E B8 BD 1B' - '29 A6 9C 82 7D 70 FB 36 52 4C 39 05 FB E1 F6 6F A4 98 72 0A 0E C0 1D D8 48 31 E5 14 1C 84 3B B8' - '91 62 CA 29 38 04 F7 AB 46 8A 29 A7 E0 50 DC 61 8D 14 53 4E C1 E1 B8 23 1A 36 73 A9 38 05 47 E2' - '8E 6A D8 CC A5 E2 14 1C 8D 3B A6 61 33 97 8A 53 70 2C CB F0 46 5C 27 FD 3F AF 44 2E 19 39 D6 1D' - '47 62 5B E5 7F C7 69 B9 6A E4 58 77 3C 89 1D A4 49 FC 3F 17 44 AE 11 39 D6 9D 40 62 A7 AE 59 AE' - 'D9 B5 76 27 92 58 9B 5D 85 FF 07 FC C8 85 22 C7 BA 93 C6 FE 15 8D FB FB 39 75 9A 4F 3E 10 81 6D' - '1F E9 33 1A B6 7D 79 17 4E C1 99 B8 B3 1A B6 7D A9 38 05 67 E3 CE 69 D8 F6 A5 E2 14 9C 8B 1B D3' - 'B0 ED 4B C5 29 38 0F 77 7E C3 B6 2F 15 A7 E0 02 DC 85 0D DB BE 54 9C 82 8B 70 17 37 6C FB 52 71' - '0A 2E C1 5D DA B0 ED 4B C5 29 B8 0C 77 79 C3 B6 2F 15 A7 E0 0A DC AF 1B B6 7D A9 38 05 57 E2 AE' - '6A D8 F6 A5 E2 14 5C 8D BB A6 61 DB 97 8A 53 70 2D EE BA 86 6D 5F 2A 4E C1 F5 B8 DF 34 9C B1 53' - '71 0A 6E C0 DD D8 B0 21 4C C5 29 B8 09 77 73 C3 86 30 15 A7 E0 B7 B8 5B 1A 4E DD A9 38 05 B7 E2' - '6E 6B 38 7B A7 E2 14 DC 8E BB A3 E1 04 9E 8A 53 70 27 EE AE 86 73 78 2A 4E C1 DD B8 7B 1A 4E E3' - 'A9 38 05 F7 E2 EE 6B 38 93 A7 E2 14 DC 8F 7B A0 E1 64 9E 8A 53 F0 20 EE A1 86 F3 79 2A 4E C1 C3' - 'B8 47 1A 4E E9 A9 38 05 8F E2 1E 6B 38 AB A7 E2 14 3C 8E 7B A2 E1 C4 9E 8A 53 F0 24 EE A9 86 73' - '7B 2A 4E C1 D3 B8 67 1A 4E EF A9 38 05 CF E2 9E 6B 38 C3 A7 E2 14 3C 8F 7B A1 E1 24 9F 8A 53 F0' - '22 EE A5 86 F3 7C 2A 4E C1 CB B8 57 1A 4E F5 A9 38 05 AF E2 5E 6B 38 DB A7 E2 14 BC 8E 7B A3 E1' - '84 9F 8A 53 F0 26 EE AD 86 73 7E 2A 4E C1 DB B8 77 1A 4E FB A9 38 05 BF C3 BD DB 70 E6 4F C5 29' - '78 0F F7 7E C3 C9 3F 15 A7 E0 F7 B8 3F 34 9C FF 53 71 0A FE 88 FB 53 23 C5 94 53 F0 01 EE C3 46' - '8A 29 A7 E0 CF B8 BF 34 52 4C 39 05 7F C5 FD AD 91 62 CA 29 F8 3B EE 1F 8D 14 53 4E C1 47 B8 7F' - '36 52 4C 39 05 FF C2 FD BB 91 62 CA 29 F8 0F EE BF 8D 14 53 4E 81 06 39 B4 0C 9A 04 9F 1E 84 A1' - '04 93 0C C2 A8 04 9F 19 84 09 12 4C 3A 08 13 26 F8 EC 20 4C 94 E0 73 83 30 71 82 CF 0F 82 5F 5D' - '0D 27 25 44 35 5C A0 11 43 0D 27 25 C4 A8 46 F2 4F 98 A0 E1 A4 84 98 B0 91 FC 13 26 6A 38 29 21' - '26 6E A4 C9 F2 43 A7 1A 84 2F 24 F8 CA 20 7C 31 C1 57 07 61 F2 04 5F 1B 84 29 12 0C 0F C2 94 09' - 'A6 1E 04 BF CE 64 0D E7 21 C4 17 1A C9 AF F3 C5 86 F3 10 62 F2 46 F2 EB 4C D1 70 1E 42 4C D9 48' - 'D3 E6 A5 67 19 84 E9 12 CC 3A 08 D3 27 98 6D 10 BE 9E E0 1B 83 30 43 82 D1 83 30 63 82 91 41 98' - '29 C1 EC 83 30 73 82 6F 0E 82 7F C2 B4 0D A7 1E C4 74 8D E4 9F 30 7D C3 A9 07 F1 F5 46 F2 4F 98' - 'A1 E1 D4 83 98 B1 91 FC 13 66 6A 38 F5 20 66 6E A4 6F E5 87 7E 67 10 E6 48 F0 DD 41 98 33 C1 7C' - '83 30 57 82 F9 07 61 EE 04 DF 1B 84 79 12 7C 7F 10 E6 4D F0 83 41 F8 76 82 05 06 C1 3F E1 5B 0D' - 'A7 1E C4 1C 8D E4 9F 30 67 C3 A9 07 31 57 23 F9 27 CC DD 70 EA 41 CC D3 48 FE 09 F3 36 9C 7A 10' - 'DF 6E A4 05 F3 43 97 1C 84 85 12 2C 35 08 0B 27 58 7A 10 16 49 B0 CC 20 2C 9A 60 D9 41 58 2C C1' - '72 83 E0 D7 59 B0 E1 6C 83 58 A8 91 FC 3A 0B 37 9C 6D 10 8B 34 92 5F 67 D1 86 B3 0D 62 B1 46 5A' - '91 3F C8 3B 46 69 72 F6 37 96 E7 44 8E 75 2B E5 C7 AE 39 08 2B 0F 72 83 0C 69 F1 B5 8E CE 19 17' - 'FD 9F 5A 25 DF F1 E3 41 58 F5 E3 EF F0 2D 35 AB 7E FC 1D 35 EA 13 6A B5 7C C7 4F 07 61 F5 8F BF' - '63 61 8A AB 7F FC 1D 0B 8F FA 84 5A 23 DF F1 F3 41 F0 2F B7 52 C3 F1 07 B1 4A C3 89 07 B1 5A C3' - '21 07 B1 46 23 AD 95 17 D8 68 10 D6 4E B0 F1 20 AC 93 60 93 41 58 37 C1 A6 83 B0 5E 82 CD 06 61' - 'FD 04 9B 0F C2 06 09 B6 18 84 0D 13 FC 62 10 FC 13 D6 6A 38 E4 20 D6 6E 24 FF 84 75 1A 0E 39 88' - '75 1B C9 3F 61 BD 86 43 0E 62 FD 46 F2 4F D8 A0 E1 90 83 D8 B0 91 B6 CC 0F BD 7E 10 B6 4A F0 9B' - '41 D8 3A C1 DD 83 B0 4D 82 7B 06 61 DB 04 F7 0E C2 76 09 EE 1B 84 ED 13 3C 3B 08 3B 24 78 6E 10' - '76 4C F0 F7 41 D8 29 C1 3F 06 61 E7 04 BF 1B 84 5D 12 BC 3B 08 BB 26 F8 68 10 76 4B F0 CF 41 D8' - '83 D9 C6 45 DB F7 A5 21 EB 80 66 4F B2 D5 59 64 1D D8 EC 45 76 A8 B3 C8 3A A8 D9 9B EC A8 CE 22' - 'EB E0 66 1F B2 13 74 16 59 87 34 FB 92 9D B0 B3 C8 FA 55 B3 1F D9 89 3A 8B AC 43 9B FD C9 4E DC' - '59 64 1D D6 1C 30 DE EF 3B C4 DA 73 C2 28 1D 38 DE AF 3C F4 E9 14 0E 1A EF B7 1E 9A 24 85 83 C7' - 'FB C5 87 3E 93 C2 21 E3 FD EE 43 93 A6 F0 AB F1 7E FD A1 CF A6 70 E8 78 EF 60 E8 73 29 1C 36 DE' - '9B 18 FA 7C 0A 87 A3 A6 ED 02 B2 8E 6F 8E 20 3B 5D 67 91 75 42 73 24 D9 E9 3B 8B AC 13 9B A3 C8' - '7E BD B3 C8 3A A9 39 9A EC 0C 9D 45 D6 C9 CD 31 64 67 EC 2C B2 4E 69 8E 25 3B 53 67 91 75 6A 73' - '1C D9 99 3B 8B AC D3 9A E3 C7 FB 7D 87 66 C9 1B 39 61 BC 5F 79 68 D6 14 4E 1C EF B7 1E 9A 2D 85' - '93 C6 FB C5 87 BE 91 C2 C9 E3 FD EE 43 A3 53 38 65 BC 5F 7F 68 24 85 53 C7 7B 07 43 B3 A7 70 DA' - '78 6F 62 E8 9B 29 9C 8E 5A AB 0B C8 3A AF 39 83 EC DA 9D 45 D6 F9 CD 99 64 D7 E9 2C B2 2E 68 CE' - '22 BB 6E 67 91 75 61 73 36 D9 F5 3A 8B AC 8B 9A 73 C8 AE DF 59 64 5D DC 9C 4B 76 83 CE 22 EB 92' - '66 0C D9 0D 3B 8B AC 4B 9B F3 C6 FB 7D 87 36 CA 1B 39 7F BC 5F 79 68 E3 14 2E 18 EF B7 1E DA 24' - '85 0B C7 FB C5 87 36 4D E1 A2 F1 7E F7 A1 CD 52 B8 78 BC 5F 7F 68 F3 14 2E 19 EF 1D 0C 6D 91 C2' - 'A5 E3 BD 89 A1 5F A4 70 59 2E 3A D7 0E C2 E5 09 AE 1B 84 2B F8 9A 2D FB 5B 2C B9 78 2E 36 2A 8E' - 'EF FA 35 89 CB 73 23 66 21 EB 86 E6 4A B2 17 75 D6 72 BF DC D4 6C C7 77 5C DD DF E1 85 CB F2 88' - 'C8 B1 EE 1A 56 B2 AE F9 5B 1D 75 9E EF 1E AB 78 01 FF 8A 97 35 9C 6C 11 97 37 92 2F ED 5B 36 9C' - '6C 11 5B 35 D2 0D E3 FD 9A FE 89 BC D8 4D 83 FF BD D9 FA 56 2A DB F6 7B B5 BC B7 DF EB BD 79 AF' - 'B7 91 B8 A6 5F 04 59 F7 37 B7 93 BD A4 B3 96 07 F6 7B 3D 30 AF 7E 67 7F 87 DF AB E5 71 FD 5E DB' - 'DD C5 BB BB E6 E3 F7 EA E8 B8 8F DF EB 71 E3 DE AB 97 A4 AD 1B 4E BD 88 6D 1A C9 4B D2 B6 0D A7' - '5E C4 76 8D 74 FF 78 BF A6 7F 22 2F F6 70 9A FA F4 20 3C 92 E0 99 41 78 74 30 EE 2E 6C EF 59 1C' - '9D 30 2E FA 3F F5 D8 E0 93 B7 6A 3F 36 F8 FF BD 55 FB 49 7E DA 75 FD 8E 2D 4F E8 77 DC EE A9 8F' - '5F C0 E5 A7 3E 7E 81 85 47 7D 42 F9 D7 7B B8 E1 5C 8C 78 A4 91 BC D4 6E DF 70 2E 46 EC D0 48 2F' - 'E7 BD BC 3D 08 AF 24 78 67 10 5E 1D 8C BB 5B D9 6F EC D5 C1 B8 7B 94 35 EA 13 EA B5 C1 27 6F 69' - '7E 6D F0 FF 7B 4B F3 EB BC 9B 5B 7A 33 66 79 46 EF FF DA BD 91 1F F9 DE 20 BC D9 1B 45 BF C5 37' - '7B A3 B8 F0 A8 71 EE AD 8F 7F 92 CB 6F 7D FC 93 16 1E F5 09 E5 F7 F1 72 C3 49 1A F1 4A 23 79 E3' - 'B0 73 C3 49 1A B1 4B 23 F9 67 BF D1 48 1F F0 63 77 ED 39 6C F9 51 CF E1 8F 32 87 3F 24 71 4F 4F' - '0E 64 FD AB F9 33 D9 07 3B 6B 79 58 CF E1 C3 32 6B FE DA DF E1 5F D8 F2 FC 7E 3F ED FE C6 3B B8' - 'E7 E3 39 EC E8 FC 8F E7 F0 F9 E3 E6 B0 37 42 3B 36 9C A4 11 3B 35 92 B7 3B BB 36 9C A4 11 BB 35' - 'D2 BF C6 FB 35 FD 13 79 B1 99 A6 FB C4 9D ED B3 4D F7 89 67 20 7F 63 BA 4F 3C 9A 76 4E 82 E5 1B' - '29 A6 9C 82 B5 70 5B 36 D2 DA 88 AD 1A 69 1D C4 D6 8D B4 2E 62 9B 46 5A 0F B1 6D 23 AD 8F D8 AE' - '91 36 40 6C DF 48 1B 22 76 68 A4 8D 10 3B 36 6C 6A 11 3B 35 6C 6A 11 3B 37 6C 6A 11 BB 34 6C 6A' - '11 BB 36 6C 6A 11 BB 35 6C 6A 11 BF 6C D8 D4 22 76 6F D8 D4 E6 CD F9 5D 41 DE 47 F9 5D 41 DE 47' - 'F9 5D 41 DE 47 F9 5D 41 DE 47 F9 5D 41 DE 47 F9 5D 41 DE 47 F9 5D 41 DE 47 F9 5D 41 DE 47 F9 5D' - '41 DE 47 F9 5D 41 DE 47 F9 5D 41 DE 47 F9 5D 41 DE 47 F9 5D 41 DE 47 F9 5D 41 DE 47 F9 5D 41 DE' - '47 F9 5D C1 DE B8 7D 1A 29 A6 9C 82 AB 67 E0 AA D0 48 D7 20 1E 69 A4 6B 11 8F 36 AC 08 88 C7 1A' - '56 04 C4 E3 0D 2B 02 E2 89 86 15 01 F1 64 23 DD 88 78 AA 91 6E 42 3C DD 48 37 23 9E 69 A4 DF 22' - '9E 6D A4 5B 10 CF 35 D2 AD 88 E7 1B E9 36 C4 0B 8D 74 3B E2 C5 46 BA 03 F1 52 23 DD 89 78 B9 91' - 'EE 42 BC D2 48 77 23 5E 6D B8 EA 23 5E 6B B8 EA 23 5E 6F B8 EA 23 DE 68 B8 EA 23 DE 6C A4 07 10' - '6F 35 D2 83 88 B7 1B E9 21 C4 3B 8D 94 91 2C 8F 2B 64 24 CB E3 0A 19 C9 F2 B8 42 46 B2 3C AE 90' - '91 2C 8F 2B 64 24 CB E3 0A 19 C9 F2 B8 42 46 B2 3C AE 90 91 2C 8F 2B 64 24 CB E3 0A 19 C9 F2 B8' - '42 46 B2 3C AE 90 91 2C 8F 2B 64 24 CB E3 0A 19 C9 F2 B8 42 46 B2 3C AE 90 91 2C 8F 2B 64 24 CB' - 'E3 0A 19 C9 F2 B8 42 46 B2 3C AE 90 91 2C 8F 2B 64 24 CB E3 0A 19 C9 F2 B8 42 46 B2 3C AE 90 91' - '2C 8F 2B 64 24 CB E3 0A 1A AD FA 56 E3 FF 6A A4 9A A3 11 1B 65 2E 3F 0D 6B 0E 62 AE 46 9A 00 31' - '77 23 4D 88 98 A7 91 26 42 CC DB 48 13 23 BE DD 48 9F 42 7C A7 91 3E 8D F8 6E 23 4D 82 98 AF 91' - '3E 83 98 BF 91 26 45 7C AF 91 3E 8B F8 7E 23 7D 0E F1 83 46 FA 3C 62 81 46 9A 0C B1 60 23 7D 01' - 'B1 50 23 7D 11 B1 70 23 4D 8E 58 A4 91 A6 40 2C DA 48 53 22 16 6B A4 2F 21 16 6F A4 2F 23 96 68' - 'A4 A9 10 4B 36 D2 57 10 4B 35 D2 57 11 4B 37 D2 D7 10 CB 34 D2 30 62 D9 46 9A 1A B1 5C 23 4D 83' - '58 BE 91 06 88 15 1A 69 5A C4 8A 8D 34 1D 62 A5 46 9A 1E B1 72 23 7D 1D B1 4A 23 CD 80 58 B5 91' - '66 44 AC D6 48 33 21 56 6F A4 99 11 6B 34 D2 2C 88 1F 36 D2 AC 88 35 1B D6 2C C4 8F 1A D6 2C C4' - '8F 1B A6 0E E2 27 8D 34 82 F8 69 23 CD 8E F8 59 23 F5 D4 F2 44 83 4C AD F2 44 83 4C AD F2 44 83' - '4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD' - 'F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44' - '83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C' - 'AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2' - '44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83' - '4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD' - 'F2 44 83 4C AD F2 44 83 4C AD F2 44 83 9F F4 65 69 74 C8 D4 2A 4F 34 C8 D4 2A 4F 34 58 0B B7 76' - 'C3 1E 29 15 A7 C0 0F E7 DA 74 28 B0 47 22 D8 6D EA C0 1E C9 C1 50 60 8F 94 EF F1 73 DD 20 8F 68' - '2B 3F B0 0D 36 E4 CB 36 6A D8 23 A5 E2 14 6C 8C DB A4 61 8F 94 8A 53 B0 29 6E B3 86 3D 52 2A 4E' - '81 1F 84 B6 D2 50 60 8F 44 B0 D5 50 60 8F E4 3F F2 A1 C0 1E C9 7F D7 43 41 DA 9A 60 9B 46 8A 29' - 'A7 60 3B DC F6 8D 14 53 4E 81 1F 2D B7 C0 50 90 FC 68 B9 05 87 82 B4 07 C1 9E 8D 14 53 4E C1 5E' - 'B8 BD 1B 29 A6 9C 82 7D 70 FB 36 52 4C 39 05 FB E1 F6 6F A4 98 72 0A 0E C0 1D D8 48 31 E5 14 1C' - '84 3B B8 91 62 CA 29 38 04 F7 AB 46 8A 29 A7 E0 50 DC 61 8D 14 53 4E C1 E1 B8 23 1A 29 A6 9C 82' - '23 71 47 35 52 4C 39 05 47 E3 8E 69 A4 98 72 0A 8E C5 1D D7 48 31 E5 14 1C 8F 3B A1 91 62 CA 29' - '38 11 77 52 23 C5 94 53 70 32 EE 94 46 8A 29 A7 E0 54 DC 69 8D 14 53 4E C1 E9 B8 33 1A 29 A6 9C' - '82 33 71 67 35 52 4C 39 05 67 E3 CE 69 A4 98 72 0A CE C5 8D 69 A4 98 72 0A CE C3 9D DF 48 31 E5' - '14 5C 80 BB B0 91 62 CA 29 B8 08 77 71 23 C5 94 53 70 09 EE D2 46 8A 29 A7 E0 32 DC E5 8D 14 53' - '4E C1 15 B8 5F 37 52 4C 39 05 57 E2 AE 6A A4 98 72 0A AE C6 5D D3 B0 A5 4E C5 29 B8 16 77 5D C3' - '96 3A 15 A7 E0 7A DC 6F 1A B6 D4 A9 38 05 37 E0 6E 6C D8 52 A7 E2 14 DC 84 BB B9 61 4B 9D 8A 53' - 'F0 5B DC 2D 0D 5B EA 54 9C 82 5B 71 B7 35 6C A9 53 71 0A 6E C7 DD D1 B0 A5 4E C5 29 B8 13 77 57' - 'C3 96 3A 15 A7 E0 6E DC 3D 0D 5B EA 54 9C 82 7B 71 F7 35 6C A9 53 71 0A EE C7 3D D0 B0 A5 4E C5' - '29 78 10 F7 50 C3 96 3A 15 A7 E0 61 DC 23 8D 14 53 4E C1 A3 B8 C7 1A 29 A6 9C 82 C7 71 4F 34 52' - '4C 39 05 4F E2 9E 6A A4 98 72 0A 9E C6 3D D3 48 31 E5 14 3C 8B 7B AE 91 62 CA 29 78 1E F7 42 23' - 'C5 94 53 F0 22 EE A5 46 8A 29 A7 E0 65 DC 2B 8D 14 53 4E C1 AB B8 D7 1A 29 A6 9C 82 77 71 EF 35' - '52 4C 39 05 EF E3 7E DF 48 31 E5 14 7C 80 FB B0 91 62 CA 29 C8 9D 76 E5 FB EE 4C 02 DF 77 07 B9' - 'D3 AE 7C DF 1D E4 4E BB F2 7D 77 90 3B ED CA F7 DD 41 EE B4 2B DF 77 07 B9 D3 AE 7C DF 1D E4 4E' - 'BB F2 7D 77 90 3B ED CA F7 DD 41 EE B4 2B DF 77 07 B9 D3 AE 7C DF 1D E4 4E BB F2 7D 77 90 3B ED' - 'CA F7 DD 41 EE B4 2B DF 77 07 B9 D3 AE 7C DF 1D E4 4E BB F2 7D 77 90 3B ED CA F7 DD 41 EE B4 2B' - 'DF 77 07 B9 D3 AE 7C DF 1D E4 4E BB F2 7D 77 90 3B ED CA F7 DD 41 EE B4 2B DF 77 07 B9 D3 AE 7C' - 'DF 1D E4 4E BB F2 7D 77 90 3B ED CA F7 DD 41 EE B4 2B DF 77 07 B9 D3 AE 7C DF 1D E4 4E BB F2 7D' - '77 90 3B ED CA F7 DD 41 EE B4 2B DF 77 07 B9 D3 AE 7C DF 1D E4 4E BB F2 7D 77 90 3B ED CA F7 DD' - '41 EE B4 2B DF 77 07 B9 D3 AE 7C DF 1D E4 4E BB F2 7D 77 90 3B ED CA F7 DD 41 EE B4 2B DF 77 07' - 'B9 D3 AE 7C DF 1D E4 4E BB F2 7D 77 B0 E0 B9 9C 3C 1A 29 A6 9C 82 85 71 8B 34 52 4C 39 05 8B E2' - '16 6B A4 98 72 0A 16 C7 2D D1 48 31 E5 14 2C 89 5B AA 91 62 CA 29 F0 8D 15 CB 34 52 CC B8 7B 2D' - '96 C5 2D D7 48 31 E5 14 2C 8F 5B A1 91 62 CA 29 58 11 B7 52 23 C5 94 53 B0 32 6E 95 46 8A 29 A7' - '60 55 DC 6A 8D 14 53 4E C1 EA B8 35 1A 29 A6 9C 82 1F E2 D6 6C A4 98 72 0A 7E 84 FB 71 23 C5 94' - '53 F0 13 DC 4F 1B 29 A6 9C 82 9F E1 7E DE 48 31 E5 14 AC 85 5B BB 61 D3 98 8A 53 B0 0E 6E DD 86' - '4D 63 2A 4E C1 7A B8 F5 1B 36 8D A9 38 05 1B E0 36 6C A4 98 72 0A 36 C2 6D DC 48 31 E5 14 6C 82' - 'DB B4 91 62 CA 29 D8 0C B7 79 23 C5 94 53 B0 07 6E CF 86 FD 5B 2A 4E C1 5E B8 BD 1B F6 6F A9 38' - '05 FB E0 F6 6D D8 BF A5 E2 14 EC 87 DB BF 61 FF 96 8A 53 70 00 EE C0 86 FD 5B 2A 4E C1 41 B8 83' - '1B F6 6F A9 38 05 87 E0 7E D5 B0 7F 4B C5 29 38 14 77 58 C3 FE 2D 15 A7 E0 70 DC 11 0D FB B7 54' - '9C 82 23 71 47 35 EC DF 52 71 0A 8E C6 1D D3 B0 7F 4B C5 29 38 16 77 5C C3 FE 2D 15 A7 E0 78 DC' - '09 0D FB B7 54 9C 82 13 71 27 35 EC DF 52 71 0A A6 1F C3 61 A7 E1 88 3D 26 87 A1 31 61 06 DC 8C' - '0D 47 EC 54 9C 82 99 70 33 37 1C B1 53 71 0A 66 C1 CD DA 70 C4 4E C5 29 98 0D F7 8D 86 23 76 2A' - '4E C1 68 DC 48 C3 BA 92 8A 53 30 3B EE 9B 8D 14 53 4E C1 9C B8 B9 1A 29 A6 9C 82 B9 71 F3 34 52' - '4C 39 05 F3 E2 BE DD 48 31 E5 14 7C 07 F7 DD 46 8A 29 A7 60 3E DC FC 8D 14 53 4E C1 F7 70 DF 6F' - 'A4 98 72 0A 7E 80 5B A0 91 62 CA 29 58 10 B7 50 C3 D5 32 15 A7 60 61 DC 22 0D 57 CB 54 9C 82 45' - '71 8B 35 5C 2D 53 71 0A 16 C7 2D D1 70 B5 4C C5 29 58 12 B7 54 C3 D5 32 15 A7 60 69 DC 32 0D 57' - 'CB 54 9C 82 65 71 CB 35 5C 2D 53 71 0A 96 C7 AD D0 70 B5 4C C5 29 58 11 B7 52 C3 D5 32 15 A7 60' - '65 DC 2A 0D 57 CB 54 9C 82 55 71 AB 35 5C 2D 53 71 0A 56 C7 AD D1 70 B5 4C C5 29 F8 21 6E CD 86' - 'AB 65 2A 4E C1 8F 70 3F 6E B8 5A A6 E2 14 FC 04 F7 D3 86 AB 65 2A 4E C1 CF 70 3F 6F B8 5A A6 E2' - '14 AC 85 5B BB E1 6A 99 8A 53 B0 0E 6E DD 86 AB 65 2A 4E C1 7A B8 F5 1B AE 96 A9 38 05 1B E0 36' - '6C B8 5A A6 E2 14 6C 84 DB B8 E1 6A 99 8A 53 B0 09 6E D3 86 AB 65 2A 4E C1 66 B8 CD 1B AE 96 A9' - '38 05 5B E0 7E D1 70 C4 4E C5 29 D8 09 B7 73 23 C5 94 53 B0 0B 6E D7 46 8A 29 A7 C0 77 91 ED 34' - '75 90 7E 49 B0 7B C3 11 3B 5F E6 14 EC 81 DB B3 E1 12 9D 8A 53 B0 17 6E EF 86 4B 74 2A 4E C1 3E' - 'B8 7D 1B 2E D1 A9 38 05 FB E1 F6 6F B8 44 A7 E2 14 1C 8C 3B A4 91 62 CA 29 F0 33 CD D7 1F 0A D2' - 'E1 04 47 34 5C 61 F3 65 4E C1 91 B8 A3 1A AE B0 A9 38 05 47 27 B8 7D 4C 38 16 77 5C C3 45 35 15' - 'A7 E0 78 DC 09 0D 17 D5 54 9C 82 13 71 27 35 5C 54 53 71 0A 4E C6 9D D2 70 28 4E C5 29 38 15 77' - '5A C3 A1 38 15 A7 E0 74 DC 19 0D 87 E2 54 9C 82 33 71 67 35 1C 8A 53 71 0A CE C6 9D D3 70 28 4E' - 'C5 29 38 17 37 A6 E1 50 9C 8A 53 70 1E EE FC 86 43 71 2A 4E 81 1F 0C BF C1 50 E0 50 EC 3F 96 A1' - '20 F9 C9 F2 6B 0F 05 0E C5 9E 76 43 41 F2 53 E2 37 19 0A 92 9F 9D 7E EA 50 E0 1C EC 7E 0E 05 C9' - '8F 58 3F 65 28 70 0E F6 85 E1 C2 20 5D 49 70 55 C3 39 38 BF 8E 53 70 35 EE 9A 86 73 70 2A 4E C1' - 'B5 B8 EB 1A CE C1 A9 38 05 D7 E3 7E D3 70 0E 4E C5 29 B8 01 77 63 C3 39 38 15 A7 E0 26 DC CD 0D' - 'E7 E0 54 9C 82 5B 71 B7 35 9C 76 53 71 0A 3C 6B 8E 6E 38 ED 7A 7A 0F 05 C9 F7 5A 1E 3A 75 E0 B4' - '4B 70 77 23 C5 94 53 70 0F EE DE 46 8A 29 A7 E0 2F B8 BF 36 52 4C 39 05 19 AF F2 E8 C1 96 0C 60' - '9E 4C 80 31 5B 11 E7 F9 04 18 B3 35 71 9E 52 80 31 DB 10 E7 59 05 18 B3 2D 71 9E 58 80 31 DB 11' - 'E7 B9 05 18 B3 3D 71 9E 5E 80 31 3B 10 E7 19 06 18 B3 23 71 9E 64 80 31 3B 11 E7 79 06 18 B3 33' - '71 9E 6A 80 31 BB 10 E7 D9 06 18 B3 2B 71 9E 70 80 31 BB 11 E7 39 07 18 F3 4B E2 3C ED 00 63 76' - '27 CE 33 0F 30 66 0F E2 3C F9 00 63 F6 24 CE F3 0F 30 66 2F E2 3C 05 01 63 F6 26 CE B3 10 30 66' - '1F E2 3C 11 01 63 F6 25 CE 73 11 30 66 3F E2 3C 1D 01 63 F6 27 CE 33 12 30 E6 00 E2 3C 29 01 63' - '0E 24 CE F3 12 30 E6 20 E2 3C 35 01 63 0E 26 CE B3 13 30 E6 10 E2 3C 41 01 63 7E 45 9C E7 28 60' - 'CC A1 C4 79 9A 02 C6 1C 46 9C 67 2A 60 CC E1 C4 79 B2 02 C6 1C 41 9C E7 2B 60 CC 91 C4 79 CA 02' - 'C6 1C 45 9C 67 2D 60 CC D1 C4 79 E2 02 C6 1C 43 9C E7 2E 60 CC B1 C4 79 FA 02 C6 1C 47 9C 67 30' - '60 CC F1 C4 79 12 03 C6 9C 40 9C E7 31 60 CC 89 C4 79 2A 03 C6 9C 44 9C 67 33 60 CC C9 C4 79 42' - '03 C6 9C 42 9C E7 34 60 CC A9 C4 79 5A 03 C6 9C 46 9C 67 36 60 CC E9 C4 79 72 03 C6 9C 41 9C E7' - '37 60 CC 99 C4 79 8A 03 C6 9C 45 9C 67 39 60 CC D9 C4 79 A2 03 C6 9C 43 9C E7 3A 60 CC B9 C4 79' - 'BA 03 C6 8C 21 CE 33 1E 30 E6 3C E2 3C E9 01 63 CE 27 CE F3 1E 30 E6 02 E2 3C F5 01 63 2E 24 CE' - 'B3 1F 30 E6 22 E2 3C 01 02 63 2E 26 CE 73 20 30 E6 12 E2 3C 0D 02 63 2E 25 CE 33 21 30 E6 32 E2' - '3C 19 02 63 2E 27 CE F3 21 30 E6 0A E2 3C 25 02 63 7E 4D 9C 67 45 60 CC 95 C4 79 62 04 C6 5C 45' - '9C E7 46 60 CC D5 C4 79 7A 04 C6 5C 43 9C 67 48 60 CC B5 C4 79 92 04 C6 5C 47 9C E7 49 60 CC F5' - 'C4 79 AA 04 C6 FC 86 38 CF 96 C0 98 1B 88 F3 84 09 8C B9 91 38 CF 99 C0 98 9B 88 F3 B4 09 8C B9' - '99 38 CF 9C C0 44 FC 53 43 1B E4 03 A6 CB 72 F1 48 BB C5 F3 61 BF AE F9 03 39 AB 6B 1B 77 6D 29' - '5C D7 FC C1 DC 43 5D DB AC 6B CB 4A A3 FE A9 51 FD 9A FE 56 47 8B 8F 8B 46 F5 2B F3 02 13 7C FC' - '45 7E 8D 09 3E FE A2 CD 3E FE 22 5E 69 C2 7F E6 86 39 7F 2C B7 65 7F A0 B4 DD AA D2 44 FF 57 9B' - 'E8 FF AD 4D 4E 62 DB 3C C9 AB 2C 17 8D B4 5B 7C 42 4D D1 35 3F AC 6E 8A AE AD DF B5 79 26 D4 94' - '5D F3 A3 E7 A6 EC DA A6 5D 9B 7F 42 7D 89 C4 2F FB 35 2D 97 EF D7 5C 3E AF F9 E5 FE 3E 3F 98 EE' - 'CB FD 7D 9B F7 F7 7D 7F 42 4D F7 5F 4E 2A 8D 34 3D 62 E1 86 63 22 62 91 46 9A 01 B1 68 C3 31 11' - 'B1 58 23 CD 84 58 BC E1 98 88 58 A2 91 66 41 2C D9 70 4C 44 2C D5 48 B3 21 96 6E 38 26 22 96 69' - 'A4 D1 88 65 1B 8E 89 88 E5 1A 69 76 C4 F2 0D C7 44 C4 0A 8D F4 2D C4 8A 8D 34 07 62 A5 46 9A 13' - 'B1 72 C3 01 12 B1 4A 23 CD 8D 58 B5 E1 00 89 58 AD 91 E6 45 AC DE 70 80 44 AC D1 48 DF 41 FC B0' - 'E1 00 89 58 B3 91 E6 43 FC A8 E1 C8 F7 DF FC C3 E3 7F 43 46 B2 3C AE 90 91 2C 8F 2B 64 24 CB E3' - '0A 19 C9 F2 B8 42 46 B2 3C AE 90 91 2C 8F 2B 64 24 CB E3 0A 19 C9 F2 B8 42 46 B2 3C AE 90 91 2C' - '8F 2B 64 24 CB E3 0A 19 C9 F2 B8 42 46 B2 3C AE 90 91 2C 8F 2B 64 24 CB E3 0A 19 C9 F2 B8 42 46' - 'B2 3C AE 90 91 2C 8F 2B 64 24 CB E3 0A 19 C9 F2 B8 42 46 B2 3C AE 90 91 2C 8F 2B 64 24 CB E3 0A' - '19 C9 F2 B8 42 46 B2 3C AE A0 09 AA 66 69 F2 09 CE 35 6B E3 4F 3E A8 9A AD F1 27 1F 54 7D A3 F1' - '27 1F 54 8D 6E FC C9 07 55 23 8D 3F F9 A0 6A F6 C6 9F 7C 50 F5 CD C6 9F 7C 50 F5 AD C6 9F 7C 50' - '35 47 E3 4F 3E A8 9A B3 F1 27 1F 54 CD D5 F8 93 0F AA E6 6E FC C9 07 55 F3 34 FE E4 83 AA 79 1B' - '7F F2 41 D5 B7 1B 7F F2 41 D5 77 1A 7F F2 41 D5 77 1B 7F F2 41 D5 7C 8D 3F F9 A0 6A FE C6 9F 7C' - '50 F5 BD C6 9F 7C 50 F5 FD C6 9F 7C 50 F5 83 C6 9F 7C 50 B5 40 E3 4F 3E A8 5A B0 F1 27 1F 54 2D' - 'D4 F8 93 0F AA 16 6E FC C9 07 55 8B 34 FE E4 83 AA 45 1B 7F F2 41 D5 62 8D 3F F9 A0 6A F1 C6 9F' - '7C 50 B5 44 E3 4F 3E A8 5A B2 F1 27 1F 54 2D D5 F8 93 0F AA 96 6E FC C9 07 55 CB 34 FE E4 83 AA' - '65 1B 7F F2 41 D5 72 8D 3F F9 A0 6A F9 C6 9F 7C 50 B5 42 E3 4F 3E C8 C7 80 13 42 FA 5F 9E 0D 90' - 'FE 97 67 03 A4 FF E5 D9 00 A3 7B CE 10 40 FA 5F 9E 0D 90 FE 97 67 03 A4 FF E5 D9 00 E9 7F 79 36' - '40 FA 5F 9E 0D 90 FE 97 67 03 A4 FF E5 D9 00 E9 7F 79 36 40 FA 5F 9E 0D 90 FE 97 67 03 A4 FF E5' - 'D9 00 E9 7F 79 36 40 FA 5F 9E 0D 90 FE 97 67 03 A4 FF E5 D9 00 E9 7F 79 36 40 FA 5F 9E 0D 90 FE' - '97 67 03 A4 FF E5 D9 00 E9 7F 79 36 40 FA 5F 9E 0D 90 FE 97 67 03 A4 FF E5 D9 00 E9 7F 79 36 40' - 'FA 5F 9E 0D 90 FE 97 67 03 A4 FF E5 D9 00 E9 7F 79 36 40 FA 5F 9E 0D 90 FE 97 67 03 A4 FF E5 D9' - '00 E9 7F 79 36 40 FA 5F 9E 0D 90 FE 97 67 03 A4 FF E5 D9 00 97 E1 9E 6E FC 04 F2 AA 67 1A 4E A0' - '88 67 1B 3F 81 BC EA B9 86 13 28 E2 F9 C6 4F 20 AF 7A A1 91 AE 46 BC D8 F8 09 E4 55 2F 35 D2 B5' - '88 97 1B 3F 81 BC EA 95 46 BA 1E F1 6A E3 27 90 57 BD D6 48 37 20 5E 6F FC 04 F2 AA 37 1A E9 26' - 'C4 9B 8D 9F 40 5E F5 56 23 FD 16 F1 76 E3 27 90 57 BD D3 F8 09 E4 55 BF 6B 38 9B 22 DE 6D FC 04' - 'F2 AA F7 1A CE A6 88 F7 1B 3F 81 BC EA F7 0D 67 53 C4 1F 1A 3F 81 BC EA 8F 8D 74 0F E2 4F 8D 9F' - '40 5E F5 41 23 DD 87 F8 B0 F1 13 C8 AB FE DC 48 0F 20 FE D2 F8 09 E4 55 7F 6D A4 87 10 7F 6B A4' - '87 11 7F 6F FC 04 F2 AA 7F 34 D2 A3 88 8F 1A 3F 81 9C 8D 5B 23 A5 97 E9 2C A4 97 E5 CE 42 7A 59' - 'EE 2C A4 97 E5 CE 42 7A 59 EE 2C A4 97 E5 CE 42 7A 59 EE 2C A4 97 E5 CE 42 7A 59 EE 2C A4 97 E5' - 'CE 42 7A 59 EE 2C A4 97 E5 CE 42 7A 59 EE 2C A4 97 E5 CE 42 7A 59 EE 2C A4 97 E5 CE 42 7A 59 EE' - '2C A4 97 E5 CE 42 7A 59 EE 2C A4 97 E5 CE 42 7A 59 EE 2C A4 97 E5 CE 42 7A 59 EE 2C A4 97 E5 CE' - '42 7A 59 EE 2C A4 97 E5 CE 42 7A 59 EE 2C A4 97 E5 CE 42 7A 59 EE 2C A4 97 E5 CE 42 7A 59 EE 2C' - 'A4 97 E5 CE 42 7A 59 EE 2C A4 97 E5 CE 42 7A 59 EE 2C A4 97 E5 CE C2 1E 93 F2 EE 1B 69 4F C4 2D' - '8D B4 17 E2 D6 46 DA 1B 71 5B 23 ED 83 B8 BD 91 F6 45 DC D1 48 FB 21 EE 6C A4 FD 11 77 35 D2 01' - '88 BB 1B E9 40 C4 3D 8D 74 10 E2 DE 46 3A 18 71 5F 23 1D 82 B8 BF 91 7E 85 78 A0 91 0E 45 3C D8' - '48 87 21 1E 6A A4 C3 11 0F 37 D2 11 88 47 1A E9 48 C4 A3 8D 74 14 E2 B1 46 3A 1A F1 78 23 1D 83' - '78 A2 91 8E 45 3C D9 48 C7 21 9E 6A A4 E3 11 4F 37 D2 09 88 67 1A E9 44 C4 B3 8D 74 12 E2 B9 46' - '3A 19 F1 7C 23 9D 82 78 A1 91 4E 45 BC D8 48 A7 21 5E 6A A4 D3 11 2F 37 D2 19 88 57 1A E9 4C C4' - 'AB 8D 74 16 E2 B5 46 3A 1B F1 7A 23 9D 83 78 A3 91 CE 45 BC D9 48 63 10 6F 35 D2 79 88 B7 1B E9' - '7C C4 3B 8D 74 01 E2 77 8D 74 21 E2 DD 46 BA 08 F1 5E 23 5D 8C 78 BF 91 2E 41 FC BE 91 2E 45 FC' - 'A1 91 2E 43 FC B1 61 5D 40 FC A9 61 5D 40 7C D0 70 B9 B5 C9 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84' - '4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7' - 'F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4' - '84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C' - 'C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2' - 'E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84' - '4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7' - 'F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4' - '84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 D3 A7 E2 4A D9 F0 D7 88 B8 A5 E1 AF 11 71 6B C3' - '5F 23 E2 B6 86 BF 46 C4 ED 0D 7F 8D 88 3B 1A FE 1A 11 77 36 FC 35 22 EE 6A F8 6B 44 DC DD F0 D7' - '88 B8 A7 E1 AF 11 71 6F C3 5F 23 E2 BE 86 BF 46 C4 FD 0D 7F 8D 88 07 1A FE 1A 11 0F 36 FC 35 22' - '1E 6A F8 6B 44 3C DC F0 D7 88 78 A4 E1 AF 11 F1 68 C3 2E 0D F1 58 C3 2E 0D F1 78 C3 2E 0D F1 44' - 'C3 2E 0D F1 64 C3 2E 0D F1 54 C3 2E 0D F1 74 C3 2E 0D F1 4C C3 2E 0D F1 6C C3 2E 0D F1 5C C3 2E' - '0D F1 7C C3 2E 0D F1 42 C3 2E 0D F1 62 C3 2E 0D F1 52 C3 65 63 AA 4C 4B 42 48 5F CA 5D 82 F4 A5' - 'DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA' - '5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC' - '25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D' - '82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25' - '48 5F CA 5D 82 05 B7 A8 5A AB 91 16 42 AC DD 48 0B 23 D6 69 A4 45 10 EB 36 D2 A2 88 F5 1A 69 31' - 'C4 FA 8D B4 38 62 83 46 5A 02 B1 61 23 2D 89 D8 A8 91 96 42 6C DC 48 4B 23 36 69 A4 65 10 9B 36' - 'D2 B2 88 CD 1A 69 39 C4 E6 8D B4 3C 62 8B 46 5A 01 F1 8B 46 5A 11 B1 65 23 AD 84 D8 AA 91 56 46' - '6C DD 48 AB 20 B6 69 A4 55 11 DB 36 D2 6A 88 ED 1A 69 75 C4 F6 8D B4 06 62 87 46 FA 21 62 C7 46' - '5A 13 B1 53 23 FD 08 B1 73 23 FD 18 B1 4B 23 FD 04 B1 6B 23 FD 14 B1 5B 23 FD 0C F1 CB 46 FA 39' - '62 F7 46 4A 5F D2 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5' - 'DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA' - '5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC' - '25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D' - '82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 02 BD C3 E9 BC F1 7F E0 E7 74 DE 48 43 88' - '19 1A 69 14 62 C6 46 9A 00 31 53 23 4D 88 98 B9 91 26 42 CC D2 48 13 23 66 6D A4 4F 21 66 6B A4' - '4F 23 BE D1 48 93 20 46 37 D2 67 10 23 8D 34 29 62 F6 46 FA 2C E2 9B 8D F4 39 C4 B7 1A E9 F3 88' - '39 1A 69 32 C4 9C 8D F4 05 C4 5C 8D F4 45 C4 DC 8D 34 39 62 9E 46 9A 02 31 6F 23 4D 89 F8 76 23' - '7D 09 F1 9D 46 FA 32 E2 BB 8D 34 15 62 BE 46 FA 0A 62 FE 46 FA 2A E2 7B 8D F4 35 C4 F7 1B 69 18' - 'F1 83 46 9A 1A B1 40 23 4D 83 58 B0 91 06 88 85 1A 69 5A C4 C2 8D 34 1D 62 91 46 EA 8E B9 7F 90' - '8E 95 FB 07 E9 58 B9 7F 90 8E 95 FB 07 E9 58 B9 7F 90 8E 95 FB 07 E9 58 B9 7F 90 8E 95 FB 07 E9' - '58 B9 7F 90 8E 95 FB 07 E9 58 B9 7F 90 8E 95 FB 07 E9 58 B9 7F 90 8E 95 FB 07 E9 58 B9 7F 90 8E' - '95 FB 07 E9 58 B9 7F 90 8E 95 FB 07 E9 58 B9 7F 90 8E 95 FB 07 E9 58 B9 7F 90 8E 95 FB 07 E9 58' - 'B9 7F 90 8E 95 FB 07 E9 58 B9 7F 90 8E 95 FB 07 E9 58 B9 7F 90 8E 95 FB 07 E9 58 B9 7F 90 8E 95' - 'FB 07 E9 58 B9 7F 90 8E 95 FB 07 E9 58 B9 7F 90 8E 95 FB 07 FF 1F EF 00 88 4D' -} - - -LANGUAGE 0,0 DECOMPOSITION UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE -{ - '78 DA 5C 9D 05 74 55 C7 D7 C5 77 12 12 5C 1E 52 27 01 5A 28 45 1F 09 0E A5 B8 13 08 EE 1E 5C 03' - '04 82 BB 7B 5B 5C 4A 15 77 8A 15 A8 02 05 2A 40 43 69 A1 EE D4 F5 5F 01 FA ED 3D 73 5E 6E D7 B7' - 'D6 5B FC F6 39 67 EE CC BC 39 73 67 E6 BE F7 80 41 77 00 4F 00 51 D1 C5 80 AD 40 74 01 32 47 0C' - 'B6 D3 95 A3 0F B0 C7 5C D9 62 B0 5F AE 44 E0 80 98 04 1C B4 50 54 0C 0E F1 CF 02 2F C4 E0 88 B9' - '1E 8C C1 51 95 AA 04 1C 13 47 02 2F 00 31 F9 69 37 2C 86 CA C0 89 C0 62 8D 27 65 25 45 62 2F B2' - '12 D4 03 7D 78 C9 24 9B 78 D9 64 74 0C 5E 31 19 13 83 57 4D B2 C7 AF 99 CC 15 83 33 92 0D 5C 37' - 'CE 4A 36 72 95 BD 6E 92 95 9D 33 C9 CA CE 9B 64 0D 17 24 9B B9 B2 6F 98 64 D9 37 4D B2 EC 5B 26' - '59 F6 A2 64 B2 EB C3 25 C9 D6 EE B2 CB 26 79 D9 3B 26 79 59 A6 49 96 BD 62 92 35 BC 27 D9 C1 5D' - 'F6 BE 49 5E 76 CD 24 2F BB 6E 92 65 3F 90 EC E2 0A 7C 2C D9 C7 5D F6 89 49 7A 3F 35 C9 CB 3E 33' - 'C9 D6 3E 37 C9 1A BE 30 C9 D1 F9 4A B2 9F 1B 9D AF 25 53 5D 65 DF 98 64 65 37 4C B2 B2 6F 4D B2' - '86 EF 24 07 BB B2 DF 9B 64 D9 1F 4C B2 EC 8F 26 59 F6 67 C9 11 AE 0F BF 48 8E 74 97 FD 6A 92 97' - 'FD 66 92 97 FD 6E 92 65 FF 30 C9 1A FE 92 1C E7 2E FB DB 24 2F FB C7 24 2F BB 69 92 65 6F 49 66' - 'B8 02 FF 9A A4 17 51 7E 3E 70 E6 46 45 F9 37 4F 19 6D DE B8 18 C4 98 97 32 9B 79 4B C7 20 D6 BC' - '94 71 51 7E 1A B1 DE EC 51 7E CC 28 73 98 97 7D C8 69 5E CA 5C E6 CD 1E 83 DC E6 A5 CC 63 DE 3C' - '31 C8 6B 5E CA 7C 92 0D 9D CC 2F D9 DF C9 82 51 7E 22 B2 93 85 A2 FC A8 53 16 36 2F 3B 59 C4 BC' - '94 77 98 97 4D DC 69 5E CA BB CC CB AE DF 6D 5E CA 7B CC CB 26 EE 35 2F E5 7D 92 4D 5C D7 8B 4A' - '0E 74 32 DE BC 6C 22 C1 BC 94 C5 CC CB 26 8A 9B 97 B2 84 79 39 8D EE 37 2F E5 03 92 4D 5D 65 25' - '25 07 39 59 3A CA DF 38 CC F1 43 51 7E 96 50 96 31 2F DF 66 59 F3 52 96 33 2F 1B 2E 6F 5E CA 0A' - 'E6 E5 1B AA 68 5E CA B0 79 D9 9D 44 CA 02 94 CD 81 24 49 16 18 02 54 56 81 E6 AE 0F 55 24 87 38' - '59 55 B2 85 EB 6F 35 C9 A1 4E D6 90 6C E9 72 5C 53 72 98 93 B5 CC CB 02 B5 CD 4B F9 B0 79 39 92' - '75 CC 4B F9 88 1A A6 F7 30 50 57 72 98 93 0D A2 FC 52 C1 CA 1A 46 F9 FB 82 B2 91 79 59 59 63 F3' - '52 36 31 2F 2B 6B 6A 5E CA 66 AA EC 05 67 B5 8C F2 0B 08 07 AA 55 94 BF 5B 28 93 CD CB 81 6A 6D' - '5E CA 36 E6 CD 1D 83 14 F3 52 B6 97 6C EB FA D0 41 32 CD C9 8E E6 65 1F 3A 99 97 B2 B3 79 D9 87' - '2E E6 A5 EC 2A D9 CE 5D D6 4D 72 8C 93 DD CD CB F1 ED 61 5E CA 9E E6 65 65 BD CC 4B D9 DB BC AC' - 'AC 8F 79 29 FB 4A B6 77 05 FA 49 8E 75 B2 BF 79 59 20 D5 BC 94 83 A2 FC E2 C8 69 34 38 CA AF 04' - '94 43 CC CB 21 19 6A 5E CA 61 E6 E5 90 0C 37 2F E5 08 F3 72 45 1C 69 5E CA 51 E6 E5 40 8D 36 2F' - '65 9A 79 39 E5 C6 98 97 72 AC 64 27 F7 36 C7 49 8E 77 32 3D CA AF D5 94 E3 A3 FC 6A 44 39 C1 BC' - '5C 98 32 24 BB BA 31 9B 28 39 D1 C9 49 E6 E5 54 9E 6C 5E CA 29 E6 E5 3B 9E 6A 5E CA 69 51 DC 6E' - '39 66 4F 58 82 EF 8D C1 16 4B 30 E5 1E EB 2C E5 5E EB 2C E5 AB 51 88 29 C0 45 C7 57 F6 9A 59 BE' - 'BE D3 B2 FA 47 AC 33 36 8B 79 DB 9C 35 C9 DB E6 75 9B D0 94 E7 24 93 5D 81 F3 26 E9 BD 20 39 C2' - 'C9 37 6C 39 65 65 6F DA 72 4A F9 96 DD AC 94 6F DB 2D 4C 79 D1 DE 03 E5 25 7B 0F 94 97 ED 3D 50' - 'BE 63 EF 81 32 93 FD B4 1D 91 69 BD 22 6B 5C C4 7A 37 88 71 34 AF 06 31 5A EF 05 31 D6 F2 7E 10' - 'A3 75 2D 88 51 5C 0F 62 14 1F CA AA 17 69 E1 23 59 7D 22 D6 C7 16 CB EE AC 4F 2C E6 AD 4F D5 E5' - 'D3 6E EE 7D 26 F9 A5 93 5F DA 82 C9 46 BF B2 05 93 F2 6B 5B 8B 28 BF B1 B5 88 F2 86 8D 0A 67 D9' - 'B7 36 2A 94 DF A9 15 EF 65 7D DF CB 1A 19 B1 7E 50 B1 C3 51 BA F8 47 C9 95 D1 92 3F D9 A2 47 F9' - 'B3 F2 E3 27 C0 2F 26 99 EF 5F 25 7D EA 7F B3 FE 71 C0 7E B7 FE 51 FE 69 2B 12 DB FA CB 56 24 ED' - 'C9 F6 EE 73 B9 F1 FD C7 DE BD B7 6E DA BB A7 BC 65 EF 9E F2 B6 E4 55 BF 49 4B FE E9 24 85 9B 29' - 'F9 79 65 B4 9F 29 94 D1 E6 0D 71 93 36 2F 65 B6 68 BF 91 B1 40 6C B4 DF C8 28 E3 CC CB 02 D9 CD' - '4B 99 23 DA CF 35 16 C8 19 ED E7 1A 65 2E F3 B2 40 6E F3 52 E6 89 F6 63 CD 02 79 A3 FD 58 53 E6' - '33 2F 0B E4 37 2F 65 81 68 BF 20 B2 40 28 DA 2F 88 94 05 CD CB 02 85 CC 4B 59 38 DA CF 61 16 28' - '12 ED E7 30 E5 1D E6 65 81 3B CD 4B 79 57 B4 5F 10 4B 71 EB 8E F6 0B 22 E5 3D D1 7E E9 A3 BC 37' - 'DA 2F 7D 94 F1 D1 7E 8B 65 4E 13 A2 FD 16 4B 59 CA C6 8C 33 F0 41 1B 33 CA D2 36 3A 5C 47 1F B2' - 'D1 A1 2C 13 ED E7 91 9F C9 65 A3 FD 3C F2 56 39 8B C5 38 AB BC C5 BC 55 C1 C6 84 15 57 B4 31 A1' - '0C DB 15 7E EE 57 B2 2B BC 95 18 ED 97 3D CA A4 68 BF 18 52 EE 8D E6 33 01 BB BD 4F 1C 10 8D FD' - '22 67 E9 01 91 83 77 50 CC 88 C6 21 71 52 34 9E 17 67 70 7A 8B 5C 65 8F B8 38 70 35 DA 3F 6E 70' - '35 7F CF 24 9B 7D DF 24 67 E3 35 93 BC 45 AE 9B E4 3B F9 C0 24 17 F6 8F 55 53 BF 68 7C 22 72 75' - 'FB 54 E4 E0 7F 26 4E 00 3E 17 1F 8F 46 5D CE 4F CD FB 7A 22 E7 6D 03 B1 10 37 74 4E 56 5B 64 C6' - 'CA 75 94 4B 74 8C AF BD 11 97 6C B9 6A 01 B3 63 B2 9E 94 E6 70 4A A3 58 64 61 9A AB CB 57 38 39' - '4F 65 79 5A 98 2F D7 E3 CE B5 40 72 B5 93 0B 25 D7 3A B9 58 72 B3 93 4B 25 9F 71 72 99 E4 36 27' - '97 AB 89 A3 31 D6 C4 76 BB 92 D6 0E 2B 4E B9 53 72 9F 2B B0 4B F2 90 93 BB 25 0F 3B B9 47 F2 A8' - '93 7B 55 DF 6B 91 FA CE 59 80 D6 79 49 1F B8 20 79 CA 15 78 C3 BC 7A 74 92 7C DD C9 B7 F9 67 81' - 'FD 5C EE C5 23 5C EB 45 F6 E5 72 F0 16 DE 09 BA 97 A9 E8 69 2E F1 E2 8B 5C C6 C4 63 5C C3 C4 97' - 'F8 50 21 BE CC C7 08 71 0D D7 2B 91 EF E1 2F F1 29 2E 2B D9 58 55 91 6C CA 58 94 49 D6 1A 23 59' - '28 9B 3B CF 4B C6 39 6F 1E C9 7B 9C 37 AF E4 5D EE B2 7C 92 F7 67 D3 D4 BA DB BC 94 35 24 AB 3B' - 'D9 46 B2 8A 2B 9B 62 92 95 B5 93 4C 72 95 75 92 EC E8 BC DD 25 6B 3A 6F 0F AB 81 97 F5 94 6C E0' - '2A 4B 97 1C 9B 4D EB C3 78 C9 71 4E BE 24 79 87 2B F0 B2 64 55 27 DF 96 2C E0 E4 45 C9 B0 93 97' - 'CC CB D6 2E 9B 97 F2 8A BD 79 16 78 D7 3A 49 F9 BE E4 55 57 E0 9A E4 7B 4E 5E B7 D6 F4 B8 69 AD' - '51 7E 28 79 A7 93 1F 49 56 73 F2 53 1B 12 6D 70 F6 86 28 3F 37 AF 1E 37 CD 4B F9 A5 64 BC 93 5F' - '49 D6 71 F2 86 E4 D7 4E 7E 2B F9 8D 93 DF 49 96 77 F2 7B C9 56 4E FE 60 B9 60 13 3F DA 98 51 FE' - '64 5E 3D 6E 9A 97 F2 17 F3 F2 DE FE D5 BC 94 BF 49 3E E8 0A FC 2E D9 C4 C9 3F 25 CB 3A F9 97 64' - '0B 27 E7 C5 F2 66 4D 8D C5 CC 58 94 88 D3 65 71 68 17 87 FB 4D B6 8F C3 03 92 4D 9D 2C 69 DE 0E' - '71 28 25 D9 DC 79 C7 51 16 A0 77 6C 1C D2 25 9B 3A 39 5E F2 8C 93 13 24 9B 3B F9 A2 2E CB 74 97' - 'BD 2C F9 92 93 97 25 2F 39 F9 50 4E CA D2 39 51 3B 27 2A 49 86 9D AC 2C 99 E4 64 67 C9 22 4E 76' - '91 BC C3 C9 AE 92 77 3A D9 4D F2 3E 27 BB 4B 16 77 B2 87 64 09 27 7B 4A 96 75 B2 97 64 45 27 CF' - '4B 9E C9 89 93 39 71 C1 E4 BB 39 71 5D 72 4B 4E BC 90 13 1F 48 3E E9 E4 47 92 7B 9C 4C CA 45 99' - '98 0B B5 73 A1 AA 64 75 27 BB 48 DE E1 64 57 C9 3B 9D EC 26 79 9F 93 3D 25 CB 3A D9 34 B7 32 94' - '1B 1D 73 A3 85 C9 3A B9 D1 D2 64 A7 DC E8 2E 59 3C 37 6A E7 46 0F C9 12 4E 3E 26 B9 32 37 DE CD' - '8D 73 92 A7 73 E3 64 6E 9C 97 3C E3 E4 05 F3 B2 40 D3 3C 94 8D F3 A0 63 1E BC 28 79 2A 0F 32 F3' - 'E0 8C E4 69 27 CF 9A BC 92 07 E7 4C BE 9C 07 E7 F3 F0 B6 F5 92 65 9A E7 55 25 79 51 27 2F 5A 48' - '36 71 B2 A5 79 3B E5 C5 FB 92 EF E5 C5 B9 BC B8 6E F2 AD BC F8 20 2F 2B F1 92 81 0F 2D F0 51 5E' - '24 E5 E3 AC 68 95 0F 89 F9 70 40 F2 8D 7C D8 9F 0F D7 25 77 E4 C3 DA 7C F8 C0 E4 96 7C C8 93 9F' - 'E7 A5 DC F9 D1 20 3F 2F AF 9F 1F 87 F3 A3 95 64 4B 27 DB 4A A6 38 D9 49 B2 A3 93 DD 25 BB 39 39' - '58 B2 6E 7E 1C CA 8F 31 92 A3 F3 23 2D 3F C6 99 1C 9B 1F E9 92 FB F3 63 7A 7E 8C CF CF 87 03 CA' - 'D1 CE 9A A0 C0 01 27 33 14 38 10 09 CC B0 8B 29 1F 95 5C E9 1A DA 28 B9 C1 C9 27 25 B7 38 F9 9C' - 'E4 B3 4E EE 94 DC E1 E4 51 C9 E5 AE 53 A5 0A 50 96 2C 80 0A 05 70 B3 00 77 E0 EB 05 10 77 2F 5D' - 'B1 F7 A2 CA BD C8 21 99 DD C9 5C 92 39 9D CC 23 99 DB C9 7C 92 79 9D 2C 28 19 72 B2 96 64 4D 27' - '1F 96 AC ED 64 5D C9 3A 4E D6 93 7C C4 C9 06 92 F5 9D 2C 57 94 1D E0 C1 AA BC C8 63 6D 05 B1 3E' - '10 16 79 88 AE 24 F2 88 95 28 2E 8D 42 92 C8 63 74 65 91 C7 B4 2A 22 0F 9D 55 45 3E 32 55 13 79' - 'E0 AF 2E F2 D9 AA 86 D8 0A A8 29 F2 A0 5D 5B E4 71 EA 61 B1 04 FB 26 B6 01 1E 11 79 C8 AC 2B F2' - '50 58 4F E4 41 B2 BE C8 A7 D0 06 45 FD 27 B6 0D 5D 79 9E FA C4 14 CE 45 31 BA 28 9A 88 7D 81 A6' - '22 4F FC CD 44 9E 07 9B 8B 5D B8 FA 89 DD 38 85 C4 EE 5C 7B 45 3E 03 B4 16 F9 54 D2 46 1C 0E A4' - 'B8 FE 47 A1 6D 51 FF C1 6E 3B D7 1F 9E 53 C5 3B 8A A2 83 78 67 51 74 14 47 01 9D 44 9E 5C 3B 8B' - '3C ED 76 11 8B 16 45 57 77 3D 67 A4 98 0E 74 17 4B 16 45 0F 91 27 85 9E E2 81 18 F4 12 0F C6 A0' - 'B7 1B 7F 3E 67 88 67 62 D0 97 CC C9 13 7C 3F 91 87 C6 FE 22 EB 4F 15 59 DF 00 91 F5 0C 14 59 CF' - '20 91 67 87 C1 22 EB 19 22 B2 9E 09 AA EF E1 6C 58 EF C6 97 B3 55 EC 07 6C 74 E3 1B 8D 4D E2 4F' - 'C0 66 1B 97 27 C4 01 C0 16 B1 17 57 40 37 EE D1 78 CA 8D 67 34 9E 16 07 F1 24 23 0E E6 3C 17 87' - '44 E3 39 71 52 51 6C 15 37 F2 B0 E6 C6 33 1A DB C5 39 45 B1 43 DC 1C 8D 9D E2 E8 68 EC 72 E3 17' - '8D DD 62 1A 97 57 71 4C 34 F6 BA F1 E4 E9 CD 8D 27 EF 52 71 02 6F 4A 71 66 34 0E 8A B3 78 A4 13' - '77 44 E1 79 71 01 CF 75 E2 C2 68 1C 11 EF 2B 8A A3 E2 A2 68 1C 13 17 47 E3 B8 C8 C7 C0 17 C4 E5' - 'D1 38 21 AE 88 C6 49 91 4F 93 A7 44 9E DC 10 EF 1F 34 4A F2 6C 15 EF 1F 34 28 A3 25 EB BB F3 77' - '8C 64 5F FF 04 60 DE FB F9 C8 66 5E CA 38 F3 56 E2 39 CC BC 94 39 E2 B9 2E FA 0F ED 79 4E CA 29' - 'AB 5F C4 CA 15 EF 3F 31 D5 A7 AB F1 FE 13 53 7D BA 6A 5E 56 99 D7 BC 94 F9 CC CB 2A F3 9B 97 B2' - '80 79 59 5F C8 BC 94 05 CD 5B 9E 0F 6E E6 A5 2C AC B6 FD 27 B1 14 45 64 A5 46 AC 3B 82 18 FB 75' - '67 10 A3 75 57 BC 7F D8 62 15 77 C7 FB 87 2D CA 7B CC 1B E6 43 9C 79 29 EF B3 7A D8 09 9E C8 8A' - '5A 3D DE 8A 57 B1 C6 EE 2D 26 48 0E 70 B2 58 BC 7F 3C 67 5B C5 E3 FD E3 39 65 89 78 FF 30 C8 02' - 'F7 C7 FB 87 41 CA 07 CC CB E1 28 69 5E CA 52 E6 E5 21 E7 41 F3 52 96 36 AF 1E 11 CD AB 47 44 F3' - '56 E0 F3 A1 79 29 CB C5 FB 07 68 BE 81 F2 F1 FE 01 9A B2 82 7A DF 2C F2 4C 53 51 D6 E0 88 15 8E' - 'F7 1F 6F 50 56 8A F7 1F 6F 50 26 9A 97 9D 4A 32 2F 65 65 F3 32 5D 55 CC 4B 59 35 DE 7F D4 CA 02' - 'D5 E2 FD 47 AD 94 D5 D5 8A F7 72 14 6A C8 1A 16 B1 6A DA 15 BC B8 96 5D 41 59 DB BC 4C C9 C3 E6' - 'A5 AC 23 D9 CA 75 EA 11 C9 E1 4E D6 35 2F 87 B2 9E 79 29 EB 9B 97 AD 34 30 2F 65 C3 78 FF 01 09' - '0B 34 8A F7 1F 90 50 36 36 2F 0B 34 31 2F 65 53 F3 B2 3B CD CC 4B D9 DC BC EC 4E 0B F3 52 B6 8C' - 'CF 7A 10 67 8F 5A C5 67 3D 88 D3 4A 0E 62 1C E6 D6 41 8C 56 1B 8B F9 F9 9A 62 31 6F B5 0D 62 AC' - 'A5 5D 10 A3 D5 5E 4D B7 F1 9F 0B 4B 8E F2 9F 0B 9B 97 6F A9 93 79 29 3B C7 FB 0F 3C 28 BB C4 FB' - '0F 3C 28 BB 9A 97 6F B4 9B 79 29 BB AB 95 B6 91 DC F4 90 95 16 B1 7A DA 15 1C 84 5E 76 05 65 EF' - '78 FF 61 08 AB EC 13 EF 3F 0C A1 EC 6B 5E 5E D9 CF BC 94 FD 55 9F FF 2C 9A 65 52 65 8D 89 58 03' - '2C 96 C7 59 03 2D E6 AD 41 16 BB DF 59 83 2D E6 AD 21 F1 FE 63 17 CA A1 F1 FE 63 17 CA 61 E6 65' - '99 E1 E6 A5 1C 61 5E 76 7B A4 79 29 47 99 97 69 1C 6D 5E CA B4 78 FF D1 CF 03 6C 2B DE 7F F4 43' - '39 D6 BC BC 91 C6 99 97 32 DD BC BC 6C BC 79 29 27 C4 FB 0F 2B FD 2C C8 88 F7 1F 56 7A 6B A2 C5' - 'B2 B9 59 30 C9 62 DE 9A AC 2A 3A BA 92 53 24 D3 9D 9C 6A 5E BE 8D 69 E6 A5 9C 1E EF 3F D5 E6 F5' - '33 E2 FD A7 DA 94 33 CD CB 86 66 99 97 72 B6 79 D9 C4 1C F3 52 CE 35 2F 07 6D 9E 79 29 E7 9B 97' - '4D 2C 30 2F E5 42 C9 CE AE C0 22 C9 09 4E 2E 36 2F 2B 5B 62 5E CA A5 F1 FE C3 24 16 58 16 EF 3F' - '4C A2 5C 1E EF 3F 22 8F 8E C1 8A 78 FF 11 39 E5 4A F3 B2 89 47 CD 4B F9 98 79 99 A2 C7 CD 4B B9' - 'CA 16 38 CA D5 96 2D B6 B6 C6 3A 99 2B 06 6B AD 35 CA 75 94 05 B8 E5 9D 8C C6 FA 60 6E 3E 61 7B' - '22 9B D8 62 7B 22 E5 93 E6 CD 19 83 A7 CC 4B F9 74 BC FF E8 34 DA 65 ED 99 78 FF D1 A9 B7 9E 0D' - '62 14 CF 05 31 8A AD 41 8C B5 6C 0B 62 B4 B6 07 31 E6 75 47 10 A3 B5 D3 62 EC 10 1D BB 2C E6 AD' - 'DD 16 8B F3 9F F9 58 CC 5B 7B 83 18 C5 BE 20 46 B1 3F 88 B1 F5 03 41 8C D6 C1 20 C6 D6 0F 05 31' - '5A CF 07 7D A1 E3 70 D0 17 5A 47 6C 9F A4 75 D4 F6 49 CA 63 E6 65 C5 C7 CD 4B F9 82 79 59 E5 09' - 'F3 52 9E B4 3D D5 8F E5 29 DB 53 BD F5 62 10 D3 EF 0A 82 18 C5 CB 41 8C 75 BF 12 C4 68 BD 1A C4' - 'D8 C2 6B 41 8C D6 69 8B F9 B1 3C 63 31 6F 9D B5 9D 92 55 BC 6E 3B 25 E5 39 F3 B2 CC 79 F3 52 5E' - '88 F7 1F AB 52 BE 11 EF 3F 56 A5 7C D3 BC BC EC 2D F3 52 BE 6D 2B B8 7F 57 17 6D 05 F7 D6 A5 20' - 'A6 DF 22 04 31 8A 77 82 18 6B C9 0C 62 B4 AE 04 31 BE AB 77 83 18 AD AB 16 F3 EF EA 3D 8B 79 EB' - '7D 8B DD EB 5A BF 66 31 6F 5D 0F 62 14 1F 04 31 7D AD 12 C4 D8 FA 47 41 8C D6 C7 41 8C AD 7F 12' - 'C4 68 7D 1A C4 D8 81 CF 82 18 AD CF 6D BD A4 FC C2 D6 4B CA 2F CD CB 8A BF 32 2F E5 D7 B6 52 FA' - '9E 7E 63 2B A5 B7 6E 04 31 8A 6F 83 18 C5 77 41 8C B5 7C 1F C4 68 FD 10 C4 D8 D3 1F 83 18 AD 9F' - '82 18 FB F4 73 10 A3 F5 8B AD 69 FA 79 84 AD 32 94 BF 99 97 05 7E 37 2F E5 1F E6 65 73 FF 33 2F' - 'E5 9F E6 65 43 7F 99 97 12 09 FE 03 DE 42 7C 57 26 0B 33 69 09 BA 95 9D 97 22 C6 AC C2 CE CA 16' - 'C4 38 0E B1 41 8C 56 5C 10 AB CF 2D 32 88 D1 CA 91 E0 3F C3 66 2C A7 49 06 72 A9 CC 8A 48 4B B9' - 'CD F2 2D E5 09 62 FA D0 35 88 D1 CA 17 C4 58 77 FE 20 46 AB 40 82 FF A4 9A B1 90 49 06 0A AA CC' - 'A1 48 4B 85 CC F2 2D 15 0E 62 AC BB 48 10 D3 69 3D C1 7F D0 CE D8 DD 26 19 B8 47 65 1E 8F D4 76' - 'AF 59 BE B6 FB 82 18 AF 2F 1A C4 68 15 4B F0 1F 9D 33 56 DC 24 03 25 54 E6 70 A4 B6 FB CD F2 B5' - '3D 10 C4 78 7D C9 20 46 AB 54 10 E3 FB 7E 30 88 D1 2A 9D E0 BF 15 60 EC 21 93 0C 94 51 99 D5 91' - '96 CA 9A E5 5B 2A 17 C4 58 77 F9 20 46 AB 42 10 63 DD 15 83 18 AD 70 82 FF A8 9F B1 4A 26 19 48' - '4C F0 5F 2F F8 96 92 CC F2 2D 55 0E 62 AC BB 4A 10 A3 55 35 88 B1 EE 6A 41 8C 56 F5 04 FF 25 05' - '63 35 4C 32 50 53 65 D6 46 5A AA 65 96 6F A9 76 10 63 DD 0F 07 31 5A 75 82 18 EB 7E 24 88 D1 AA' - '9B E0 BF A8 60 AC 9E 49 05 54 E6 54 A4 A5 06 66 F9 96 1A 06 31 FD 6C 23 88 D1 6A 9A E0 BF 8B 61' - 'AC 99 49 06 9A AB CC E6 48 6D 2D CC F2 B5 B5 0C 62 3A D5 07 31 5A 6D 12 FC 37 27 8C A5 98 64 A0' - '6D 82 FF FA C5 D7 D6 CE 2C 5F 5B FB 20 A6 63 7B 10 D3 C9 3D 88 F1 7D 77 0A 62 B4 BA 24 F8 AF 5A' - '68 75 53 E0 99 48 85 3D 02 8B 55 F4 0A 2C 5E D4 3B C1 7F 9B C3 0A FB 98 64 A0 AF CA BC 1E E9 5E' - '3F B3 7C 6D FD 83 18 6B 4B 0D 62 B4 06 04 31 D6 3D 30 88 D1 1A 94 E0 BF CC 62 6C B0 49 06 86 A8' - 'CC B6 48 4B 43 CD F2 2D 0D 0B 62 AC 7B 78 10 A3 35 22 88 B1 EE 91 41 8C D6 28 5B 1B E9 1B 9D 90' - 'F5 95 58 9A AD 2E 7A 28 48 C8 FA 76 6C AC DD D7 5A BE 13 B2 BE 28 4B B7 3B 83 DE F1 09 59 DF 99' - '4D B0 B9 45 6F 46 42 D6 57 63 13 2D AB F4 4E 4A C8 FA 96 6C B2 0D 26 BD 53 12 B2 BE 30 9B 1E 2C' - 'B9 8D 78 12 0F 96 5C 5A 33 13 90 2D 58 C6 E9 98 65 8E C2 11 C7 EC A0 44 94 73 CC 09 4A 78 C7 DC' - 'A0 44 7D E7 98 17 94 F0 8E F9 C1 52 4C 6B 41 B0 14 D3 5A A8 C2 2B FE D3 83 45 E6 C8 EA C1 E2 A0' - '84 6F 70 49 50 C2 3B 96 06 25 7C 83 CB 82 12 DE B1 3C 58 06 69 AD 08 96 41 5A 2B 55 F8 F0 7F 7A' - 'F0 A8 39 B2 7A F0 58 50 C2 37 F8 78 50 C2 3B 56 05 25 7C 83 AB 83 12 DE B1 26 58 1E 69 AD 0D 96' - '47 5A EB 54 78 F5 7F 7A B0 DE 1C 59 3D D8 10 94 F0 0D 6E 0C 4A 78 C7 A6 A0 84 6F 70 73 50 C2 3B' - '9E 08 EE 13 5A 5B 82 FB 84 D6 93 2A FC FA 7F 7A F0 94 39 B2 7A F0 74 50 C2 37 F8 4C 50 C2 3B 9E' - '0D 4A F8 06 9F 0B 4A 78 C7 D6 E0 FE A1 B5 2D B8 7F 68 6D 57 E1 6D FF E9 C1 0E 73 64 F5 60 67 50' - 'C2 37 B8 2B 28 E1 1D BB 83 12 BE C1 3D 41 09 EF D8 6B B7 26 9F 12 F6 99 D4 EF 91 ED 9E F0 ED 1C' - 'B0 00 E5 41 0B F8 EA 9F B7 00 AB 3A 6C 01 5F EB 11 3B AD B0 D6 A3 26 59 EB 31 93 2C 79 3C 21 EB' - 'DB F9 17 4C F2 B2 13 09 FE CB 7C 76 F7 64 82 BE F2 E7 7E 10 B8 5E 34 C9 26 5E 4A C8 FA AA 9F D6' - 'CB 36 7B 7D 6F 5F B1 05 84 F2 55 0B F8 DE 9E B6 00 AF 38 63 01 DF DB B3 76 46 51 FE 13 B2 7E 22' - '70 CE 4E 00 F4 9E 4F C8 FA B5 C0 05 93 BC EC 0D EB 84 4F D0 9B 81 C5 62 6F 05 16 DB 78 DB 56 2F' - '7D AF 6C 92 C3 71 29 21 EB C7 04 7A A6 48 F8 EF 4F 0B AE 58 31 5E FC 6E 10 A0 75 D5 F6 70 FD 2E' - 'C3 24 AB 7A DF 24 4B 5E 4B C8 FA 39 C3 07 D6 09 3F 61 3E 0C 2C C6 3E 0A 2C D6 FA B1 2D 99 AC F5' - '13 93 FA AD 55 42 D6 AF 13 28 3E 4B F8 EF 6F 15 3E 57 B1 97 DC CC FA C2 24 AB FA D2 2E 66 95 5F' - '05 C5 69 7D 6D BB 22 1B F8 C6 24 1B B8 61 52 8F 03 09 59 3F 56 F8 4E 72 8B AB EF FB 20 CF 14 3F' - '24 FC F7 07 1E 3F 6A 86 F4 06 7E B1 FB D6 67 FF 57 5B E6 29 7F B3 80 CF FE 1F 16 60 67 FE 67 01' - '9F FD 3F ED 74 A1 5F 61 25 64 FD FE E3 6F DB 1C E9 FD 27 21 EB F7 1F 37 4D F2 B2 5B 92 FE 87 27' - 'B7 6D 62 6A 9C 8B B1 53 F2 1A A3 49 F7 D3 18 63 36 63 AC 31 CE 98 BD 98 FF 6B 02 39 CC CE 69 CC' - '65 0C 29 4E 71 67 31 DF 54 12 0F B9 0A 55 00 4A CA 45 F2 55 AA 18 62 4C F2 55 D1 EA 4C 52 81 C4' - '62 E0 AB B2 0A 78 C9 57 55 05 AA 14 03 5F D5 14 F0 92 AF DA 0A 14 07 F8 AA 63 0D C6 C6 A0 89 E4' - '23 00 5F 4D 4D B2 40 33 2B 4B AB 53 31 64 0B 6A E7 AB 97 F5 7E 14 99 23 0C 8C 16 F9 60 3E 56 AC' - '0C 8C 13 AB 00 E9 62 55 60 BC 58 0D 98 20 56 07 32 C4 1A C0 44 B1 2C 30 49 2C 58 02 93 C5 87 81' - '29 62 69 60 AA F8 10 30 4D 1C 01 4C 27 73 B2 BD 19 62 25 60 A6 98 08 CC 12 93 80 D9 22 DB 9F 23' - 'B2 FD B9 22 DB 9F 27 B2 FD F9 22 DB 5F 20 B2 FD 85 22 DB 5F 24 B2 FD C5 22 DB 5F 22 B2 FD A5 22' - 'DB 5F 2E F6 01 56 88 A9 C0 4A 91 CF D1 8F 8A 13 80 C7 C4 2E 5C 60 C4 41 C0 2A 71 28 B0 5A 1C 06' - 'AC 11 87 03 6B 45 BE 8F 75 E2 28 60 BD 38 06 D8 20 8E 05 B6 6A CC DB 42 9F 90 31 05 31 FA D0 AC' - '22 DC 6F E8 03 4B BF 11 2E 8E A8 A8 06 9C 7C C5 59 7C 2F F4 0D 50 AC 0A F4 73 05 F4 43 E6 C0 E2' - '53 73 76 16 2F B0 3C 0A 39 AD 78 63 4E 3F D5 30 10 C8 2D EA 77 71 C6 BC C6 7C 22 DF 48 7E F1 C1' - '28 14 10 F5 2B 40 63 41 B1 25 97 41 91 6F B0 88 98 0C DC 51 DC FF B6 95 7D B8 5B AE 36 C0 3D 62' - '0A 9F DD 45 BE B7 FB 8C 45 8D C5 78 49 8E 76 D0 97 04 C5 D5 ED F6 D0 E7 43 AC BB 84 02 ED 5D E0' - '01 95 ED CA FB 80 D4 6D 5A DA EC 32 B2 5B 00 65 8B 67 FD 3D 96 72 0A D5 07 CA DB 18 55 14 F5 FD' - '91 C8 8A 2B 89 1C 81 24 91 55 57 16 D9 DD 2A 1A A4 B7 63 51 55 BC 18 8B 6A E2 A5 58 54 17 2F C7' - 'A2 86 CA 71 8A D7 52 1F 79 3D 5B EB 0C D4 96 F7 45 3E 4C 89 07 F8 18 25 3E CA 07 28 F1 09 3E 3A' - '89 A1 12 68 24 36 E4 D0 8B FD 81 26 D6 AB A6 56 6B 33 71 08 D0 A6 78 D6 DF F1 E1 74 4D 09 2C 4E' - 'D6 B6 C5 91 CD 2C FE C9 BB A0 5D 10 E6 DC 6F 2F 2B 31 62 75 08 62 BC 0F 3A 06 31 5A 9D 8A 67 FD' - 'D5 21 5A 9D 65 55 8E 58 5D 82 EB 78 DF 74 95 55 25 62 75 0B 62 BC 87 BA 07 B5 D0 EA 11 94 A4 D5' - '53 56 B5 88 D5 8B D9 B1 EB 7A 6B 34 39 7F FA 14 F7 7F F3 80 AF BE 1A 50 2F F9 EA 67 81 8E 40 7F' - '95 25 53 E5 EA E8 A2 03 54 B6 63 A4 EC 40 0E 48 60 F1 35 C8 2E 66 62 06 EB 62 72 88 5C 9D 5D 74' - 'A8 2E EE 1C 29 3B 4C 05 38 CB 86 8B 9C 27 23 44 66 68 A4 C8 79 31 4A 64 66 46 17 F7 7F 31 82 AF' - '34 55 E0 25 5F 63 2C 90 CE 65 4F 65 C9 71 72 A5 BB 68 BA CA A6 47 CA 8E 57 4F B3 2C BE 26 D8 C5' - '5C 3B 32 74 31 39 51 AE 09 2E 3A 49 17 4F 88 94 9D AC 02 BC C7 A6 88 BC A9 A7 8A 9C 43 D3 44 2E' - '2A 0B 34 D8 E1 48 E2 D7 E9 56 58 5E 1C D5 79 B6 96 5C E9 E4 6E C9 C7 9C 7C 43 F2 6D 27 DF 94 7C' - 'C7 C9 B7 24 2F 39 99 AD 04 65 4C 09 C9 9C 92 39 9C CC 23 99 DB C9 07 24 EF 77 B2 94 64 49 27 CB' - '51 16 28 5B 02 7C 95 2F C1 FE 7B C9 57 45 05 2A 94 00 5F 61 05 BC E4 AB 9E 2E AE ED 2E 6E 28 D9' - 'C0 C9 26 92 8D 9C 6C 26 D9 D4 C9 DE 92 5C 99 29 FB 4A F6 71 DE E1 92 AD 9C 1C E1 2A 73 05 46 4A' - 'D6 71 72 94 64 7F 57 60 B4 64 AA 93 63 25 D3 9C 1C 27 39 C6 C9 09 92 E9 4E 66 48 8E 77 72 BA E4' - '44 27 67 48 4E 72 72 B6 E4 4C 27 E7 48 CE 72 72 BE E4 5C 27 17 48 CE 73 72 A7 E4 93 4E EE 92 DC' - 'EA E4 6E C9 6D 4E EE 91 DC E1 E4 C7 92 93 9D FC 44 72 8A 93 9F 4A AE 70 F2 33 C9 95 4E DE 90 DC' - 'EF E4 B7 92 07 9C FC 4E F2 A0 93 DF 4B 1E 72 F2 A1 FB B9 50 72 A7 2E 23 72 07 ED FD 00 A2 B2 F3' - '96 EC 23 72 61 E8 2B 72 F6 F4 13 B9 18 F4 17 79 3B A7 8A BC F5 07 88 BC A1 07 8A BC A5 07 89 5C' - '93 06 3F 80 E8 EC 7E 35 1A 62 92 AF A1 26 59 F1 30 93 AC 7B B8 49 56 3F C2 24 5B 18 69 92 8D 8C' - '32 C9 76 46 9B 64 53 69 26 D9 DA 18 C9 44 D7 DA D8 07 38 93 4A BB D6 B8 3F 8F 33 2B D1 59 E9 66' - '25 39 6B BC 59 95 9D 35 C1 AC 2A CE CA 30 AB AA B3 26 9A 55 CD 59 93 CC AA EE AC C9 66 D5 70 D6' - '94 07 78 3F FB D6 C3 CE 31 35 70 F8 1E 4D 0B 1C BE 53 D3 03 87 EF D7 8C C0 E1 BB 36 33 70 F8 DE' - 'CD 0A 1C BE 83 B3 03 87 EF E3 9C C0 E1 BB 39 37 70 F8 9E CE 33 47 62 A4 A7 F3 39 86 05 2A B9 73' - 'E4 02 C9 44 27 17 4A 26 39 B9 48 B2 B2 93 8B 25 AB 38 B9 44 B2 AA 93 4B 25 AB 39 B9 4C B2 BA 93' - 'CB 25 6B 38 B9 42 63 E5 87 86 D6 4A B3 7C 9B 8F 9A E5 9B 7D CC 2C DF F2 E3 66 F9 C6 57 99 E5 DB' - '5F 6D 96 EF C2 1A B3 7C 2F D6 9A E5 3B B2 CE 2C DF 97 F5 B2 12 23 7D D9 60 59 EC E3 86 62 A3 59' - '7D 9D B5 C9 AC 7E CE DA 6C 56 7F 67 3D 61 56 AA B3 B6 98 35 C0 59 4F 9A 35 D0 59 4F 99 35 C8 59' - '4F 9B 35 D8 59 CF 98 35 C4 59 CF 9A 35 D4 59 CF 99 35 CC 59 5B CD 1A EE AC 6D 66 8D 70 D6 76 B3' - '46 3A 6B 87 59 A3 9C B5 D3 AC D1 CE DA 65 56 9A B3 76 9B 35 C6 59 7B CC 1A EB AC BD 66 8D 73 D6' - '3E B3 D2 9D B5 DF AC F1 CE 3A 60 D6 04 67 1D 34 2B C3 59 87 CC 9A E8 AC E7 B5 44 F0 94 74 58 E4' - '81 EC 88 C8 8D F6 A8 C8 8D F6 98 C8 03 D9 71 91 07 AA 17 C4 26 C0 09 91 47 D0 93 22 37 EA 53 62' - '73 E0 45 91 67 BD 97 44 6E DC 2F 8B DC A8 5F 11 79 E4 7C 55 6C 0D BC 26 F2 DC 79 5A E4 B9 F3 8C' - 'C8 73 E6 59 91 E7 CC D7 45 1E 2B CF 89 1D 80 F3 22 4F 11 17 C4 4E C0 1B 22 8F 09 6F 8A 5D 80 B7' - '44 9E 35 DF 16 39 71 2E 8A 9C 32 97 44 4E 96 CB 22 A7 C9 3B 22 27 48 A6 C8 A9 71 45 E4 A4 78 57' - 'E4 74 B8 2A 72 22 BC 27 72 0A BC 2F 32 F9 D7 44 A6 FD BA C8 84 7F 20 32 D5 1F 8A 4C F2 47 22 D3' - 'FB B1 C8 C4 7E 22 32 A5 9F 8A FA 6B 17 22 D3 F8 B9 C8 04 7E 21 32 75 5F 8A 4C DA 57 22 D3 F5 B5' - 'C8 44 7D 23 32 45 37 44 DE 16 79 CA 70 85 C8 DA AC F9 1A 5B 86 69 AC 09 F0 C5 0D 77 5C 19 DE D7' - '0F 3B 99 AE 80 97 7C 5D 67 00 1F 94 D1 EE 32 B9 1C 1F 5F F8 96 A6 90 39 38 94 23 CB EB E7 7D E5' - 'B1 B9 02 4F 28 6F 0C C5 AF E2 E6 CD 7A 1E 89 2A 80 64 44 89 A5 93 11 2D 56 4D 46 8C F8 48 32 B2' - '89 5D 92 11 2B CE 49 46 9C B8 38 19 D9 C5 27 92 91 43 3C 96 8C 9C AE 7C 0A 72 89 A9 29 C8 2D 0E' - '4D 41 1E 71 66 0A F2 8A AB 52 90 4F DC 91 82 FC E2 C7 29 28 20 FE 9E 82 90 EB 47 5B 14 14 D7 B7' - '45 21 F1 AF B6 28 2C 16 69 87 22 E2 3D ED 70 87 58 BD 1D EE 14 EB B5 C3 5D 62 F7 76 B8 5B 1C DC' - '0E F7 B8 F6 DA E1 5E F1 F9 76 B8 4F 3C DB 0E 45 C5 CF DA 21 5E 7C B7 23 12 C4 84 4E 28 26 7E DB' - '19 C5 C5 E8 2E 28 21 E6 EA 82 FB 5D BB 5D F0 80 F8 60 17 94 14 C7 74 41 29 B1 4D 37 3C 28 4E EF' - '86 D2 E2 9F DD F0 90 98 BF 3B CA 88 25 BA A3 AC EB 67 77 94 13 47 74 47 79 71 74 77 54 10 AF F5' - '40 45 F1 8B 1E 08 8B 3F F7 40 25 F1 76 0F 24 8A 69 3D 91 24 4E EC 89 CA E2 B4 9E A8 22 FE D6 13' - '55 5D B9 9E A8 26 E6 EE 85 EA 62 A1 5E A8 E1 FA D5 0B 35 C5 3E BD 50 CB F5 B7 17 6A 8B AF F4 C2' - 'C3 62 8E BE A8 E3 F2 DB 17 8F 88 2D FA A2 AE 58 31 15 F5 C4 CA A9 A8 2F CE 4B 45 03 71 75 2A 1A' - '8A 4F A7 A2 91 78 34 15 8D 5D DE 52 D1 C4 F5 3F 15 4D C5 9F 06 A0 99 AB 7F 20 9A BB 79 34 10 2D' - 'C4 62 43 D1 52 EC 3B 14 AD C4 8C A1 48 16 0F 0C 45 6B F1 FC 50 B4 11 DF 19 8A 14 37 2E 43 D1 D6' - '8D E3 30 B4 13 0B 0F 43 7B D7 AF 61 E8 E0 E6 D3 28 74 14 CB A4 A1 93 7B 1F 69 E8 2C D6 4A 43 17' - '37 FF D2 D0 55 6C 92 86 6E 6E DE A6 A1 BB D8 2D 0D 3D C4 9D 69 E8 29 CE 1E 83 5E E2 82 31 E8 2D' - '5E 1F 8B 3E E2 97 63 D1 57 BC 6B 1C FA B9 F9 31 0E FD DD FB 19 87 54 31 3C 0E 03 C4 45 E3 30 50' - '5C 39 0E 83 C4 F4 74 0C 16 A7 A4 63 88 B8 3B 1D 43 C5 53 E9 18 26 FE 90 8E E1 EE FD 8D C7 08 F1' - 'D3 F1 18 29 FE 3A 1E A3 C4 9A 19 18 2D 1E C9 40 9A 78 32 03 63 C4 B1 13 31 D6 8D D3 44 8C 73 F7' - 'C3 44 A4 BB BC 4E C6 78 37 EF 26 63 82 1B 87 69 C8 10 53 A6 61 A2 B8 70 1A 26 89 27 A6 61 B2 18' - '35 1D 53 C4 3C D3 31 55 2C 38 1D D3 C4 A4 E9 98 EE E6 D7 74 CC 70 E3 31 1D 33 DD 7D 32 03 B3 C4' - '1B 33 30 DB F5 73 06 E6 88 37 67 60 AE AB 67 26 E6 89 F7 CE C4 7C 37 4E 33 B1 C0 CD F3 99 58 E8' - 'E6 EF 4C 2C 12 27 CC C4 62 B1 D5 5C 2C 71 F9 9B 8B A5 62 DD F9 58 26 B6 9C 8F E5 62 BF F9 58 21' - '4E 5D 80 95 6E 7C 17 E0 51 F1 D2 02 3C E6 D6 85 85 78 5C AC B6 18 AB C4 C6 8B B1 5A EC B0 18 6B' - '5C 3B 8B B1 56 DC B8 18 EB C4 FE 4B B0 5E 1C B5 04 1B DC 7C 5B 82 8D 6E DD 59 8A 4D E2 B9 A5 D8' - 'EC D6 99 65 78 42 DC BB 0C 5B C4 43 CB F0 A4 B8 62 39 9E 12 9B AD C0 D3 E2 E9 15 78 46 BC B0 02' - 'CF 8A 17 57 E0 39 71 FC E3 D8 EA D6 81 C7 B1 4D BC 6F 15 B6 BB 75 67 15 76 B8 FB 65 15 76 8A 5F' - 'AF C2 2E 97 9F D5 D8 2D F6 5C 8D 3D EE BE 58 8D BD 6E DD 5A 8D 7D 2E CF AB B1 5F FC 7E 35 0E B8' - '71 5F 8D 83 2E 7F 6B 70 48 DC BA 06 CF BB 79 B4 06 87 C5 8F D6 E0 88 5B 57 D7 E2 A8 B8 76 2D 8E' - 'B9 79 BE 16 C7 5D F9 75 78 41 BC BA 0E 27 5C F9 75 38 29 96 5C 8F 53 EE BE 5F 8F 17 C5 C4 F5 78' - '49 AC BD 1E 2F 8B 5D D7 E3 15 77 7F 6F C0 AB E2 B8 4D 78 CD CD 93 4D 38 2D 3E B3 09 67 C4 E3 9B' - '70 D6 AD 2F 9B F0 BA F8 C6 26 9C 73 E3 B3 09 E7 DD 7C DD 84 0B E2 AD 4D 78 43 CC B7 19 6F BA F5' - '6A 33 DE 72 EB C3 66 BC ED EE DF CD B8 28 36 DF 8C 4B 62 DB CD B8 2C 2E D9 8C 77 C4 0D 9B 91 E9' - 'F6 9B CD 3A 35 46 E5 2E C6 43 67 58 F3 38 8C EA 61 BF 0F D4 10 1B B6 43 4D B1 51 3B B4 0C EB 47' - 'B8 61 AC 0D 23 59 B2 95 93 6D 24 5B 3B D9 56 32 C5 C9 F6 92 ED 9C EC 28 D9 C1 C9 CE 92 9D 9C EC' - '2A D9 C5 C9 EE 92 DD 9C EC 29 D9 C3 C9 DE 92 BD 9C EC 2B D9 C7 C9 54 C9 FE 4E 0E 94 1C E0 E4 60' - 'C9 41 4E 8E 92 1C E9 E4 68 93 EB C2 18 23 99 E6 BC 63 4D D2 9B 2E 39 CE 79 C7 9B A4 37 43 72 82' - 'F3 4E 34 49 EF 64 C9 49 CE 3B C5 24 BD 8F 49 36 76 DE F5 61 FF 49 33 E5 06 93 2C B0 49 05 36 BA' - '02 9B 29 73 CD 0F 63 61 18 3B E5 DD E1 BC BB 25 77 39 B9 57 72 8F 93 FB 25 F7 39 79 50 F2 80 93' - 'CF 4B 1E 72 F2 88 E4 61 27 8F 49 1E 75 F2 05 C9 E3 4E 9E 94 3C E1 E4 8B 92 A7 9C 7C 59 F2 25 27' - '5F 93 7C D5 C9 33 92 A7 9D 7C 5D F2 AC 93 6F 4B BE E5 E4 45 93 7C 43 97 25 2F 39 EF 3B 26 E9 BD' - '22 99 E9 BC EF 9A A4 F7 3D C9 AB CE FB BE 49 7A AF 4B 5E 73 DE 0F 4C D2 FB 9B E4 B3 CE FB 3F C9' - '1F 9D FC 53 F2 27 27 FF 92 FC D9 C9 BF 25 7F 71 F2 B6 E4 2D 27 FF D5 F8 72 A0 D8 FB 4A 95 B4 C2' - '85 90 28 46 85 90 24 6E 0F A1 B2 18 1D 42 15 71 67 08 55 C5 5D 21 54 13 63 42 A8 2E 66 0B A1 86' - '18 1B 42 4D 71 6F 08 B5 C4 7D 21 D4 16 F7 87 F0 B0 78 20 84 3A E2 C1 10 1E 11 0F 85 50 57 BC 27' - '84 7A 62 5C 08 F5 C5 EC 21 34 10 73 84 D0 50 2C 1E 42 23 31 67 08 8D C5 5C 21 34 11 73 87 D0 54' - 'CC 13 42 33 31 6F 08 CD C5 7C 21 B4 10 F3 87 D0 52 2C 10 42 2B 31 14 42 B2 58 30 84 D6 62 9F 10' - 'DA 88 7D 43 48 11 FB 85 D0 56 EC 1F 42 3B 31 35 84 F6 E2 80 10 3A 88 03 43 E8 28 0E 0A A1 93 38' - '38 84 CE E2 90 10 BA 88 43 43 E8 2A 0E 0B A1 9B 38 3C 84 EE E2 88 10 7A 88 23 43 E8 29 8E 0A A1' - '97 38 3A 84 DE 62 5A 08 7D C4 31 21 F4 15 C7 86 D0 4F 1C 17 42 7F B1 77 08 A9 62 E1 10 06 88 45' - '42 18 28 9E 09 61 90 78 36 84 C1 E2 85 10 86 88 6F 86 30 54 BC 1C C2 30 F1 DD 10 86 8B EF 85 30' - '42 BC 2F 84 91 E2 07 21 8C 12 3F 0A 61 B4 58 34 84 34 31 3E 84 31 62 B1 10 C6 8A 25 42 18 27 DE' - '1F 42 BA F8 60 08 E3 C5 87 42 98 20 96 0D 21 43 2C 17 C2 44 B1 7C 08 93 C4 0A 21 4C 16 2B 86 30' - '45 4C 0C 61 AA 58 35 84 69 62 DD 10 A6 8B 4D 42 98 21 B6 0C 61 A6 F8 73 08 B3 C4 5F 42 98 2D 76' - '0A 61 8E D8 39 84 B9 62 97 10 E6 89 B3 43 98 2F CE 09 61 81 38 3F 84 85 E2 8A 10 16 89 2B 43 58' - '2C 3E 16 C2 12 71 53 08 4B C5 2D 21 AC 24 73 F0 89 E3 51 91 4F 12 8F 89 39 93 F1 B8 78 AD 23 56' - '89 B9 92 B1 5A 2C 9F 8C 35 62 EE 64 AC 15 13 C7 61 9D C8 27 92 F5 E2 DD C9 D8 20 46 25 63 A3 F8' - '50 17 6C 12 C3 9D B0 59 E4 93 09 12 FD 23 30 6F 31 3E 02 47 99 15 ED AC 68 B3 62 9C 15 63 56 AC' - 'B3 B2 99 15 E7 AC 58 B3 B2 3B 2B CE AC 9C CE CA 6E 56 6E 67 E5 30 2B 8F B3 72 9A 95 CF 59 B9 CC' - 'CA EF AC DC 66 15 70 56 1E B3 42 CE CA 6B 56 41 67 E5 4B F4 1F 19 F1 3D F4 71 8E FC E6 88 8E 38' - '0A 98 23 26 E2 08 99 23 36 E2 28 68 8E B8 88 A3 90 39 B2 47 1C 85 CD 91 33 E2 28 62 8E DC 11 C7' - '1D E6 C8 13 71 DC 69 8E 7C 11 C7 5D E6 C8 1F 71 DC 6D 8E 02 11 C7 3D E6 08 45 1C F7 9A A3 60 C4' - '71 5F D0 CA 08 E7 28 9A 88 EC D6 0F DE F8 74 73 79 D8 E1 22 F1 89 88 0B 22 05 23 17 14 8B E4 3C' - '59 56 71 B3 16 3B AB 44 24 77 CE BA DF 2C 4E 3C 5A 0F 98 F5 98 8B 95 34 6B 78 8A AC 52 91 B9 E2' - '62 0F 9A 35 D4 C5 4A 9B D5 C3 C5 1E 32 8B C7 12 5A 65 CC E2 C3 11 AD B2 91 EB 46 C9 2A 67 16 1F' - '70 68 95 37 AB B4 2B 59 C1 2C 1E 36 69 55 34 8B 8F AC B4 C2 66 F1 01 8C 56 25 B3 CA 0C 92 95 18' - '79 7F AE 96 24 B3 EA 64 C8 AA 6C 56 DE F6 B2 AA 98 95 91 26 AB AA 59 5B 16 CB AA 16 79 47 EE BA' - 'EA 66 1D 6C 2B AB 86 59 9F B9 77 5B D3 AC C9 AE CE 5A 66 0D E8 26 AB 76 A4 64 BA AC 87 CD 8A 6A' - '2D AB 8E 59 67 5C 7B 8F 98 D5 DE 8D 59 DD C8 C8 BB D6 EB 45 EE 0C 77 5D 7D B3 F8 70 42 AB 81 59' - 'BF 3A AB 61 A2 3E 70 EA 80 46 E2 E4 9E 68 2C F2 69 B6 89 B8 6C 12 DA B0 74 BE 36 80 FF 42 33 25' - 'D1 7F 76 5D 09 68 6B 92 AF 76 26 F5 FD 9D C9 CA 40 07 93 FA E6 CE 64 55 A0 93 C9 6A 40 67 93 D5' - '81 2E 26 6B 00 5D 25 93 DC 67 9D DD 4C B2 B5 EE 26 59 A6 87 49 BE 7A 9A 64 6B BD 4C B2 B5 DE EA' - 'BA EE 7B 91 B7 7B 5F 91 77 79 3F 91 37 77 7F 91 F7 74 AA C8 5B 79 80 C8 3B 78 A0 C8 DB 62 90 C8' - '5B 66 B0 C8 DB 74 88 C8 BB 73 A8 C8 9B 72 98 C8 7B 71 B8 A8 1B 48 4D FB 75 66 A4 A4 5F 61 46 49' - 'FA B5 65 B4 A4 5F 55 D2 24 FD 7A 32 46 D2 AF 24 63 25 FD 1A 32 4E D2 AF 1E E9 92 7E DD 18 2F E9' - '57 8C 09 92 7E AD C8 90 F4 AB C4 44 49 BF 3E 4C 92 F4 2B C3 E4 44 C4 DA 65 87 43 5A 0A 79 C7 4F' - 'E1 52 91 DD AF 13 6C 86 BB F7 54 6B 91 8E E9 6E E4 92 31 43 E4 BD 3F D3 8D 4C 32 66 89 BC DF 67' - '8B BC D3 E7 88 BC C7 E7 BA 91 4D C6 3C 91 F7 F5 7C 91 77 F4 02 91 F7 F2 42 91 77 F1 22 17 1F 85' - 'C5 22 EF DC 25 22 EF D9 A5 22 EF D6 65 22 EF D3 E5 22 EF D0 15 22 EF CD 95 AE FD 81 78 54 E4 FD' - 'F8 98 C8 3B F1 71 91 F7 E0 2A 91 77 DF 6A D7 6E 06 D6 88 BC E3 D6 8A 57 33 B0 4E AC 36 0E EB C5' - '31 5D B0 41 1C BC 1C 1B 5D FD 29 D8 24 8E 6A 87 CD E2 D7 C3 F0 84 9B 21 6B B0 C5 65 B8 35 9E 14' - 'D7 A6 E0 29 B1 DF 50 3C 2D 72 A3 7D 46 E4 46 FB AC 9B 31 C9 78 4E FC B2 07 B6 8A BF B6 C3 36 B1' - '56 3B 6C 17 57 77 C3 0E 91 F7 F7 4E 91 77 F6 2E 91 F7 F4 6E 91 77 F3 1E 91 F7 F1 5E F1 BE 2E D8' - '67 93 99 F7 CB 7E 93 BC 5F 0E 98 E4 FD 72 D0 24 EF 97 43 92 95 DD FD F2 BC 49 DE 2F 87 4D F2 7E' - '39 62 92 C5 8F 9A E4 EB 98 49 DE 2F C7 4D B2 B5 17 4C B2 B5 13 26 D9 DA 49 93 6C ED 94 64 15 D7' - 'DA 8B 89 FE 3B 18 E6 F7 A5 44 FF 1D 0C E5 CB 89 FE 3B 18 CA 57 12 FD 77 30 94 AF 26 FA EF 60 28' - '5F 4B F4 DF C1 50 9E 4E F4 DF C1 50 9E 49 F4 DF C1 50 9E 4D F4 DF C1 50 BE 9E 98 F5 1D 0C AD 73' - '89 59 DF C1 D0 3A 9F 98 F5 1D 0C AD 0B BC 28 5F 53 F7 FD C5 1B 5A B1 52 DD 17 06 B4 DE 54 20 D5' - '7D 15 FF 96 02 2D DD 52 D6 10 78 5B 63 FD 24 1F 7E C4 A7 C3 B8 24 F2 09 E5 B2 B8 95 8F 3F E2 F6' - '30 32 45 3E CC 5D 11 F9 24 F7 AE C8 C7 B8 AB 22 9F E1 DE 13 F9 5C F2 BE C8 A7 B7 6B 22 1F DD AE' - '8B 7C 6E FB 40 E4 43 DB 87 22 9F D8 3E 12 F9 B8 F6 B1 C8 67 B5 4F 44 3E A8 7D 2A F2 29 ED 33 91' - '0F 39 9F 8B E7 C2 F8 42 3C 1F C6 97 E2 85 30 BE 12 DF 08 E3 6B F1 CD 30 BE 11 F9 F0 76 43 E4 E3' - 'DA B7 22 1F D0 BE 73 F7 40 18 DF BB 7B 37 8C 1F C4 0F C3 F8 51 FC 28 8C 9F C4 8F C3 F8 59 FC 24' - '8C 5F C4 4F C3 F8 55 FC 9C 4F 6C 6E 4E 87 F1 BB BB 37 C2 F8 43 FC 86 8F 6F E2 0D 3E BB 89 DF F2' - 'C1 4D FC 8E 4F 6D E2 F7 61 FC 23 F2 F1 EE A6 C8 67 BB 5B 22 1F EC 6E 8B 7C AA FB 57 09 F9 3C 19' - '8B DB 6B 4A C6 E6 63 0A FC A3 E7 4D F7 6C 17 95 84 6C F2 B1 66 BE 89 2D 7C E8 B3 42 BF 86 ED 01' - '93 3A 26 89 99 7C D2 5D C2 72 D9 54 82 19 3C EF 0A F9 27 EC 58 95 78 DA 39 38 C6 71 B2 98 DB 6D' - 'CE C1 1B 27 2E 1F 33 7C D4 15 F6 CD F2 92 1C 6A 79 AB 73 EC 70 7F E6 D4 55 DB DD 25 2C 9A CB 2C' - '06 38 6A B9 65 B1 18 9B E0 58 E4 D1 A5 B4 38 3C AF B8 EA F2 9A E3 7B 17 E6 25 F9 CC B1 D6 F9 58' - '63 FE C0 41 8B 79 29 A0 5E F9 4F 0A FC 9F 3E 18 52 39 EF 38 EF 6A 2A 68 8E 2F 22 55 17 4A 42 0E' - '2B F1 6D E4 5A FF 71 00 83 85 93 38 DA BB 5C A3 45 AC 81 EF 23 63 F4 8D 7B 27 77 04 EE 4F 22 A3' - 'C1 7A EE D4 A0 7A F7 8F 91 77 75 97 9A FE EF B5 77 EB DA FF 3A CE BA 77 73 8F B9 59 8D FF B4 E2' - '69 57 CF BD 76 F9 F7 AE 19 4E E1 FB 34 88 FB 9C C5 01 2E 2A EB 80 BB 8A D3 3E 5E 85 0F B8 98 FF' - '04 21 41 8E 43 AE 2E 5F 75 31 F5 F0 50 24 C5 3E 2D C5 E5 3B EC 46 26 6B 2A 94 50 BD C7 23 E5 EE' - '0F 2C 76 F6 01 55 9A 35 58 EC 44 49 85 FD 67 25 AC A6 94 AC B3 91 A1 7D 50 63 E9 DF 61 69 49 F6' - '92 F7 DF 43 2A F3 66 64 88 CA C8 7A CB F5 92 F7 74 59 0D 44 D6 EC CE 6A B5 9C 5A CD 72 B3 5C 79' - '75 FB AD 48 37 BE 73 AD 55 D0 B5 97 22 33 FE 68 24 2F 15 75 AD 77 FB 61 08 AB 45 EF E0 70 55 32' - 'CB F7 38 51 75 F8 DB 28 6B 6A 32 92 A4 3A E8 7E 2A 92 EF CA 56 6E AD 2B C4 37 FE 9C BB BC 8A 2A' - 'CB 74 D7 B2 E3 55 D5 C9 AB AE D9 53 91 5B AF 9A 4A F8 DB 92 4B 5B 75 D5 EB 2D CE 55 F6 A2 86 85' - 'BF 75 EF B2 66 10 F6 B7 54 AD 24 64 37 C7 CD C8 DD ED 3F F4 AA 6D 45 FD 80 B0 B9 87 D5 B8 9F 08' - '4F 47 86 B1 8E 0A 5D 8B BC 57 3A 1E 51 56 AE B9 70 5D 55 7D 2D D2 96 17 FE CD D7 53 9F AE 45 DE' - '40 FD C0 62 B9 06 AA F1 C3 C8 1C E3 3C 6D A8 B0 77 B0 70 23 B3 5E 71 4B 56 63 B3 BE 75 85 9B A8' - '83 1F BA 5A F8 16 BE 72 A2 A9 AA FB 28 52 17 1D CD D4 C1 8F DC F4 6C AE 21 F7 32 2B F1 AC A9 85' - '2A FD 24 72 F3 B7 54 A5 59 96 9F 7A AD 54 E9 7F EF D4 64 39 3E FF CF 42 D6 5A 75 7C 1E A9 B1 8D' - 'AC 2F DD 24 E2 D5 29 2A 7C 23 32 17 18 6E AB 2E DD 70 39 6E A7 D8 B7 61 FB CC 8F 57 B7 57 F3 DF' - '3A 99 19 19 E6 0E 2A FF 9D BB D9 3A EA 2D 7C 17 C9 C6 BE C8 5A D6 49 0D 66 AD 19 9D 59 BE 00 F7' - 'EF A3 A3 D0 25 C9 1F 18 28 BB 26 F9 03 03 65 B7 24 7F 60 A0 EC 9E E4 0F 0C 94 3D 92 FC 81 81 B2' - '67 92 3F 30 50 F6 4A F2 07 06 CA DE 49 FE C0 40 D9 27 C9 1F 18 28 FB 26 65 1D 18 68 F5 4B CA 3A' - '30 D0 EA 9F 94 75 60 A0 95 9A 94 F5 A3 0D 5A 03 92 B2 7E B4 41 6B 60 52 D6 8F 36 68 0D 4A CA FA' - 'D1 06 AD C1 49 59 3F DA A0 35 24 29 EB 47 1B B4 86 26 65 FD 68 83 D6 B0 A4 AC 1F 6D D0 1A 6E 96' - 'EF CB 08 B3 7C 5F 46 9A E5 FB 32 CA 2C DF 97 D1 1A CD 41 D0 BF C4 D0 87 67 1A 8D 7E 7F 27 C7 48' - 'D6 83 FE 7A E9 58 95 E9 EB 0B 00 E3 14 18 E9 4E 3C E9 92 A3 DC AF 41 C6 DB 95 C3 81 09 2A EE 25' - '9B C9 08 2C B6 3F 51 C5 9A B9 5A 27 49 8E E9 89 02 7D 31 59 B2 FC 00 ED D9 53 24 1F EC 02 9E 86' - 'A7 4A E6 1B 80 E3 C3 30 4D 53 87 07 F6 FC BD 70 4F 6B 3D 39 4F B7 96 D9 C1 19 92 23 9C 9C 29 F9' - '82 FB 8B E0 B3 24 87 3B EF 6C C9 A1 4E CE 91 6C 01 FD 1B 31 73 25 5B 39 39 4F B2 89 93 F3 D5 DB' - '7E EE AD 0E 03 16 A8 D9 A1 EE FD 79 C7 42 6B B6 31 B0 C8 9A A5 5C 6C CD 52 2E 31 C9 93 E1 52 EB' - '01 E5 32 EB 01 E5 F2 24 7F 90 9C 08 AC 50 5B F4 7A 6B A5 AC 56 11 EB 51 59 4D 22 D6 63 B2 DA 47' - 'AC C7 AD 0D F6 67 95 B5 41 B9 DA 12 A0 1F 52 5B 73 94 6B 25 07 B8 D1 5F 67 1D A6 5C 6F 35 50 6E' - 'B0 1A F8 DA 28 D9 CF C9 4D 56 03 E5 66 B5 3D 3C 92 CD 27 6C 7C BC B5 C5 2E A6 7C D2 DE 8C B7 9E' - '0A 2E 62 D2 9F 0E 2E A2 F5 8C 5D 44 F9 6C 70 11 AD E7 EC A2 22 25 F4 F3 9B AD 1A FB 2C 8B 75 6E' - 'D3 75 7E 9A 6E B7 EB BC B5 C3 46 CE 5B 3B 6D E4 BC B5 4B 56 9A 93 1C 9B DD 5A 70 B2 2C 5F F3 1E' - 'AD 32 FF CF C7 D6 F6 5A A6 69 ED B3 81 A3 DC 6F 03 47 79 C0 DE 06 E5 41 2B CB 3B E2 90 95 A5 7C' - 'DE CA 52 1E B6 B2 94 47 6C 64 29 8F DA 0C A4 3C 66 35 74 E2 D3 92 D5 40 F9 82 D5 40 79 C2 6A A0' - '3C 69 35 50 9E B2 1A 28 5F 34 EF B6 18 BC 64 5E CA 97 35 88 7D DC AF BA 86 BB 3F 5F 51 AC BE FB' - 'ED D3 AB 96 6E BE 5E 33 C9 01 38 AD 2B 1A B8 81 F0 13 F6 8C 46 B0 81 FB 25 15 AF 3F 6B B3 8C 55' - 'BC 6E 77 4D 06 70 4E 72 90 1B C3 F3 36 BF 39 FC 17 24 07 BB 5F 64 BD 61 F7 1D 5F 6F 9A 64 07 DF' - 'B2 3E 8F E5 D3 92 E4 30 D7 CB 8B 26 79 D9 25 B5 3D CC B5 CD 9E 5C B6 C0 04 E0 1D 1B 0E 2E 4A 99' - '36 6B 06 BB F9 7E C5 AC 91 CE 7A D7 A6 0C FB 73 55 EF 6B D4 7F 46 E2 BD 24 FF C1 53 1B D7 95 F7' - 'AD 64 5B E0 9A 5B 97 DC 52 77 5D B2 9D FB 8D D7 07 92 9D 5C 8B 1F EA CA 8E 6E 88 58 D5 47 B2 EA' - '45 AC 8F 6D 0F FA 22 15 9F D8 1E 44 F9 A9 ED 41 94 9F D9 1E 44 F9 B9 ED 41 94 5F D8 1E 44 F9 A5' - 'ED 41 94 5F D9 1E 44 F9 B5 ED 41 94 DF 04 7B 10 AD 1B C1 1E 44 EB DB 60 0F A2 F5 5D B0 07 D1 FA' - '3E D8 83 68 FD 10 EC 41 B4 7E 0C F6 20 5A 3F 05 7B 10 AD 9F 83 3D 88 D6 2F C1 1E 44 EB D7 60 0F' - 'A2 F5 5B B0 07 D1 FA 3D D8 83 68 FD 11 EC 41 B4 FE 17 EC 41 B4 FE 34 CB F7 E5 2F B3 7C 5F FE 36' - 'CB F7 E5 1F B3 7C 5F 6E 9A E5 FB 72 4B 56 52 A4 2F B7 CD F2 7D F9 57 49 1A 18 59 C5 37 3C AB 7F' - '30 2F 1B 36 8A 2D B3 61 D4 73 FA 07 E3 9E C3 9F 62 A9 28 FC 25 B6 8B 42 F7 1D E4 83 CF A1 87 58' - '6D 07 7A 8A 43 A3 D1 4B 6C BB 03 83 C5 25 D1 C0 5F 88 42 D3 C5 88 12 7F 1B 80 68 F1 DC 52 C4 88' - '67 17 23 9B 78 71 04 62 C5 C4 64 C4 89 5F B4 43 76 71 C3 66 E4 30 E6 14 53 BA 20 97 2B BF 02 B9' - 'C5 79 1D 90 C7 D5 DF 05 79 C5 3F FA 20 9F 38 38 1D F9 C5 39 D3 50 40 7C 64 2E 42 E2 B1 79 28 28' - 'FE 39 1F 85 C4 65 CB 51 58 8C 1E 82 22 E2 BD C3 71 87 F8 DE 28 DC 29 7E 38 06 77 89 0F CF C6 DD' - 'E2 90 15 B8 47 FC 79 2D EE 15 67 26 E3 3E 71 5C 3B 14 15 B3 0D 45 BC AB 27 0D 09 62 F9 B9 28 26' - 'C6 6F 42 71 B1 4D 0F 94 10 BF 1D 89 FB C5 37 E6 E0 01 B1 FF 02 94 14 5F EF 8B 52 E2 D5 19 78 50' - '4C 98 8F D2 6E BC 7A E2 21 F1 CE 81 28 E3 FA 31 1C 65 C5 9B 69 28 27 BE B9 1C E5 C5 B9 AD 51 41' - '3C 9C 82 8A AE FF 6D 11 16 5F ED 8F 4A E2 E5 21 48 14 0B A4 21 49 FC 2A 1D 95 C5 A8 E9 A8 22 C6' - 'CD 45 55 B1 FB 5C 54 13 7F 5C 82 EA 2E 2F AB 51 43 1C B9 1E 35 C5 BF 37 A2 96 B8 78 02 6A 8B D3' - '32 F0 B0 F8 C4 14 D4 71 EF 63 16 1E 71 E3 F1 28 EA BA F8 26 D4 13 AF 2C 44 7D F1 A3 CE 68 E0 E2' - 'BD D0 50 EC 3D 19 8D C4 A9 D3 D1 58 EC 9B 86 26 EE 7D 4F 40 53 F1 E5 C5 68 26 FE 6F 15 9A BB F1' - 'E9 8C 16 AE 5C 77 B4 14 0B 0D 41 2B F1 FD E1 48 16 F3 8F 44 6B B1 E2 14 B4 11 AB 4D 45 8A D8 62' - '15 DA 8A 97 DA A2 9D B8 68 3A DA 8B D7 53 D0 41 BC 90 82 8E E2 7D 13 D1 49 3C 39 05 9D 5D BE 67' - 'A1 8B CB F3 2A 74 15 A7 2F 42 37 F1 AD BE E8 6E F3 A7 87 78 7B 21 7A 8A 35 92 D1 CB 8D 6F 37 F4' - '16 0B F6 46 1F 37 5F C7 A0 AF 38 6A 1C FA B9 7C B6 43 7F F1 9F 09 48 15 4F B5 C6 00 71 5B 2F 0C' - '14 F3 26 63 90 EB D7 30 0C 16 27 A4 62 88 58 62 0A 86 8A AF B4 C3 30 B1 67 67 0C 77 79 1C 8F 11' - '62 B3 D9 18 29 6E 5F 88 51 6E DE 0F C5 68 71 EF 32 A4 89 F3 87 61 8C EB 6F 5F 8C 75 F7 DB 4C 8C' - '73 F9 EB 87 74 31 75 1C C6 8B BB 93 31 C1 DD 4F 29 C8 70 79 4D C1 44 71 C6 20 4C 72 EF 6F 32 26' - 'BB 79 31 13 53 DC B8 2E C4 54 37 2E 2B 30 4D FC BD 2D A6 8B F5 DB 63 86 38 A6 0B 66 8A DF F5 C4' - '2C F1 B5 54 CC 76 FD 18 89 39 62 99 0C CC 15 77 3D 8E 79 6E 9E AF C3 7C 71 F5 26 2C 70 F3 7C 13' - '16 8A EB DB 62 91 78 9A C7 62 71 FC 50 2C 71 F3 61 19 96 8A 63 7B 62 99 B8 BC 0F 96 8B DC 99 56' - '88 EB FA 63 A5 78 FF 48 3C EA C6 69 34 1E 13 17 8C C5 E3 6E BE 65 60 95 5B A7 A6 60 B5 7B 5F D3' - 'B1 46 2C B5 0C 6B C5 1F 66 63 9D BB 7E 39 D6 8B CD 1F C5 06 97 C7 B6 D8 28 3E D5 16 9B C4 13 ED' - 'B1 D9 AD 6F A3 F0 84 9B BF F3 B1 C5 F2 F1 A4 1B C7 9E 78 CA 8D 4F 2F 3C 2D 4E EA 87 67 DC 78 0F' - 'C5 B3 62 9D C9 78 CE CD B7 31 D8 2A 7E 9E 8C 6D E2 5F 1D B1 DD E6 D5 0E 97 D7 1E D8 E9 E6 6B 6F' - 'EC 12 F7 8F C1 6E 97 AF B1 D8 E3 DE EF 34 EC 15 1B 4F C7 3E B1 F2 4A EC 77 EB E4 2A 1C 70 EB E6' - '6A 1C 14 EF 5A 83 43 EE 7E 68 8D E7 5D 3F 32 70 58 3C B8 02 47 C4 23 AB 70 54 FC A4 37 8E B9 75' - '26 19 C7 DD FD D6 06 2F B8 71 E9 86 13 6E 9D ED 8E 93 E2 DA 54 9C B2 FB E2 45 97 B7 D1 78 C9 CD' - '83 74 BC EC D6 AD D9 78 45 9C BC 1C AF 8A 4B 36 E3 35 37 2F 07 E0 B4 58 61 15 CE B8 BC B4 C5 59' - '37 3E 03 F1 BA F8 EB 40 9C 13 EB 0D C7 79 B7 2F 8C C0 05 31 E7 58 BC 21 76 19 87 37 C5 A1 13 F0' - '96 5B E7 A6 E0 6D 77 7F AC C1 45 71 78 0A 2E B9 FA FB E2 B2 BB 9F 56 E1 1D B1 6C 1B 64 8A 77 F7' - 'C0 15 F1 C6 70 BC EB E6 E3 32 5C 75 E3 D2 0B EF 89 0D FB E0 7D 97 EF 41 B8 66 F7 F3 75 37 1E AB' - 'F0 81 F8 50 5B 7C E8 D6 9F F6 F8 C8 DD 47 DD F1 B1 5B 9F 06 E0 13 31 79 20 3E 15 B7 0E C2 67 EE' - 'BE 1B 86 CF DD BA 3B 16 5F 88 9F 8E C3 97 62 C6 34 7C E5 EE A3 F9 F8 DA 8D FB 7C 7C E3 D6 81 15' - 'B8 E1 CA AD C2 B7 6E BC DB E1 3B 37 0F 46 E0 7B B1 68 7B FC 20 BE 3D 1A 3F 8A 6B C6 E2 27 B7 5E' - 'CF C1 CF 6E 7E AE C2 2F 62 A7 0D F8 55 DC BC 09 BF B9 FB 6B 20 7E 17 CF 0F C7 1F E2 D7 33 F0 3F' - '67 4F C4 9F 62 B1 49 F8 4B 5C 39 19 7F 8B 2F A6 E1 1F 97 E7 51 B8 29 76 5E 84 5B CE 9F 8C DB 62' - 'D5 59 F8 57 AC C9 23 E3 DF 64 F6 B6 88 12 9F ED 89 68 F1 72 5F C4 88 57 26 23 9B 38 A7 1B 62 C5' - 'F8 E1 88 13 0F 0E 40 76 B1 D6 32 E4 10 5B CE 47 4E B1 D5 2A E4 12 17 2D 40 6E 57 4F 4F E4 11 EB' - 'A6 20 AF F8 62 07 14 10 BB 76 46 41 71 EC 00 14 11 3F 4C C1 1D 62 99 31 B8 53 3C 97 8E BB C4 DA' - '19 B8 5B EC 99 81 7B C4 D4 0C DC 2B 2E CB C0 7D 62 C7 D5 28 2A 9E 9C 8C 78 F1 C4 34 14 13 0B CE' - '45 09 F1 CF 85 28 29 56 5F 8E 52 E2 AD E5 28 23 FE B8 06 65 C5 9B 6B 50 4E 2C BD 16 E5 DD FB DA' - '88 0A AE 3F CB 51 51 3C BC 0A 61 71 77 6B 54 12 BF 6A 83 44 F7 3E 53 90 24 BE DE 16 95 C5 CF DB' - 'A2 8A 98 D2 0E 55 C5 8D 1D 50 4D 8C EB 88 EA E2 A0 8E A8 E1 C6 A1 33 6A 8A 5B 3B A3 96 D8 BF 3B' - '6A 8B 23 BA E3 61 F1 B1 DE A8 E3 CA F7 C1 23 E2 D2 3E A8 2B FE D2 07 F5 C4 D6 A9 A8 2F 7E 9A 8A' - '06 E2 8A 01 68 E8 F2 33 08 8D C4 F1 C3 D1 58 BC 67 04 9A 88 25 46 A2 A9 AB 7F 34 9A 89 65 D3 D0' - 'DC F9 C7 A2 85 BB 7E 02 5A 8A 75 32 D0 4A 6C 96 81 64 B1 69 06 5A 8B 6D 32 D0 C6 8D 73 06 52 C4' - '1E 19 68 2B 2E C9 40 3B D7 BF 0C B4 77 EF 6B 22 3A 88 33 26 A2 A3 CB F3 24 74 FA DB AF D3 9D C5' - '9C 53 D1 45 AC 37 15 5D C5 B4 69 E8 26 C6 4E 47 77 F1 FB 19 E8 21 66 CC 44 4F 63 2F B1 D3 6C F4' - '16 0B 2C 40 1F 71 D5 02 F4 15 A3 16 A1 9F 58 63 11 FA BB 79 B6 18 A9 62 8E 25 18 20 3E BF 0C 03' - '2D EF 83 C4 CF 56 61 B0 F8 EF 6A 0C 71 F3 76 0D 86 8A E3 7A 63 98 F8 43 FD E8 E1 E2 5D 33 31 4A' - '2C 95 8C D1 E2 A1 14 A4 B9 7C A4 60 8C 38 BD 35 C6 8A 8D 52 30 CE D9 29 48 17 CF B4 C5 78 F1 EF' - 'B6 98 60 F9 CF 10 3B 74 C0 44 71 6D 07 4C 72 79 EB 80 C9 36 FF A7 88 07 3A 63 AA D8 B0 0B A6 89' - 'ED BB 60 BA D8 B7 2B 66 B8 79 D9 0D 33 C5 4B DC 8F C5 F7 7A 62 B6 38 B8 17 E6 88 BB 7A 61 AE 78' - 'B5 37 E6 89 C9 7D 30 DF 8D 43 1F 2C B0 F9 B3 50 EC DD 07 8B 6C 1E 2D 16 2B F7 C5 12 F1 D5 7E 58' - '2A DE D7 1F CB C4 B6 FD B1 DC E5 3B 15 2B EC FE 5C F9 B7 3F D7 3E 2A DE 3B 10 8F B9 F8 40 3C EE' - 'F2 34 14 AB FE F6 E7 97 D5 7F FB 75 7F 8D 78 6D 04 D6 8A E7 47 60 9D CD C3 F5 6E FD 18 85 0D 36' - '1F 37 8A CF 8D C7 26 B1 4A 1A 36 8B 7B D2 F0 84 AD 03 5B C4 D1 63 F1 A4 BB 8F C6 E1 29 97 B7 71' - '78 5A 2C 9A 8E 67 C4 84 74 3C 6B EB C5 73 AE DD 74 6C 75 F3 2E 1D DB C4 E6 E3 B1 DD CD CF F1 D8' - '21 5E 98 80 9D E2 BE 89 D8 65 F3 74 B7 38 69 32 F6 88 DD A6 60 AF CD DB 7D EE BE 98 86 FD 36 4F' - '0F B8 F1 99 85 83 6E FD 98 85 43 EE FD CF C3 F3 EE 7D 2F C0 61 71 EE 02 1C B1 79 7A 54 3C B5 10' - 'C7 6C 1D 3A EE C6 63 21 5E B0 F9 7B E2 6F 7F 1E 3D E9 E6 FF 42 9C B2 F9 FC A2 B8 70 11 5E B2 F9' - 'FC B2 9B C7 CB F0 8A BB 6F B8 1F BB F9 B4 02 AF 89 E9 2B 71 5A 9C CC FD D8 E6 F9 59 5B 17 5F 77' - 'E3 B1 1A E7 6C DE 9F 17 73 AF C1 05 9B FF 6F B8 75 72 3D DE FC DB 3F BF BD E5 C6 AB 74 F4 DB 6E' - '3E 96 8E BE 28 66 26 45 5F 72 F3 B9 16 2E BB FB A3 2E DE 71 FD AC 8B 4C B7 5E B4 8D BE 22 BE DD' - '3D FA 5D 77 1F 4E 8D BE 2A 36 D8 8C F7 DC FC DB 0C FC C3 87 FF 01 EE AF D2 45 99 D4 7F 8C 68 92' - '0F B4 31 FF F0 61 D7 17 D0 7F 75 17 58 8C C5 AA D8 18 F7 21 4B 5C 20 0B 49 8E 8D 45 7A 2C 0A 9B' - '4C 8D 45 11 93 43 63 71 87 E4 54 57 E0 4E F3 0E 8F 45 D1 7F F4 9F 0A C4 E2 60 2C 12 24 7F 89 C5' - 'E1 58 14 FB 07 51 51 9F C6 A2 B8 F8 76 2C 4A 88 97 63 71 BF F8 4E 2C 1E 10 AF C5 A2 A4 78 3D 16' - 'A5 C4 0F 62 F1 A0 F8 75 2C 4A 8B 37 62 F1 90 58 16 28 A3 AA BF 89 C5 4B B1 28 6B F2 E5 58 94 FB' - '47 FF 99 64 2C 5E 70 81 F2 81 C5 58 05 15 7B DB 75 A6 A2 C9 23 B1 08 9B 64 99 4A 92 17 9D 4C 94' - 'BC E4 64 92 E4 65 27 2B 4B BE E3 64 15 C9 4C 27 AB 4A 5E 71 B2 BA E4 55 27 6B D8 28 50 D6 94 7C' - 'DF C9 5A 92 D7 9C AC 2D 79 DD C9 3A 92 1F 3A 59 57 F2 63 27 EB 49 7E E2 64 03 C9 CF 9C 6C 28 F9' - 'B9 93 8D 25 BF 74 B2 89 E4 57 4E 36 95 FC DA C9 66 36 30 94 CD 25 6F 38 D9 C2 BA 7E 34 16 2D ED' - '1D 9F 8A 45 2B EB 19 65 B2 35 41 D9 5A 69 E5 E8 B0 9F 6D 38 F0 71 A3 E3 90 42 C6 92 6D 65 4F 8A' - '43 3B D9 64 7B 32 86 EC 40 66 23 3B 2A 3E 35 0E 9D 14 27 3B 2B 4E 76 51 9C EC AA F8 F4 38 74 53' - '9C EC AE 38 D9 43 71 B2 A7 E2 13 E3 D0 4B 71 B2 B7 E2 64 1F C5 C9 BE 8A 4F 8B 43 3F C5 C9 FE 8A' - '93 A9 8A 93 03 14 CF 88 C3 40 C5 C9 41 8A 93 83 15 27 87 28 FE 74 1C 86 2A 4E 0E 53 9C 1C AE 38' - '39 42 F1 67 E3 30 52 71 72 94 E2 E4 68 C5 C9 34 C5 67 C7 61 8C E2 E4 58 C5 C9 71 8A 93 E9 8A CF' - '8A C3 78 C5 C9 09 8A 93 19 8A 93 13 15 9F 1B 87 49 8A 93 93 15 27 A7 28 4E 4E 55 7C 5E 1C A6 29' - '4E 4E 57 9C 9C A1 38 39 53 F1 25 71 98 A5 38 39 5B F6 E2 38 CC 91 4D CE 95 BD 34 0E F3 64 93 F3' - '65 CF 8F C3 02 D9 E4 42 D9 6B E2 B0 48 36 B9 58 F6 8A 38 2C 91 4D 2E 95 BD 2D 0E CB 64 93 CB D5' - '3E B9 42 ED 93 2B 15 DF 13 87 47 15 27 1F 53 9C 7C 5C 71 72 95 E2 07 E2 B0 5A 71 72 8D E2 E4 5A' - 'C5 C9 75 8A EF 8B C3 7A C5 C9 0D 8A 93 1B 15 27 37 29 7E 2C 0E 9B 15 27 9F 90 7D 3C 0E 5B 64 93' - '4F AA 3C F9 94 CA 93 4F 73 AA C6 F9 FF CB E6 19 CA 58 2F 9F D5 55 2F C5 E1 39 5D 45 6E D5 55 E4' - '36 5D 45 6E 57 FC 64 1C 76 28 4E EE 54 9C DC A5 38 B9 5B F1 4B 71 D8 A3 38 B9 57 AD F8 FF 1B 67' - '9F 5A F1 F2 B2 4A ED 8A C3 3B 2A 45 66 AA 16 F2 8A 6A 21 DF 55 FC 4C 1C AE 2A 4E BE 27 FB 74 1C' - 'DE 97 4D 5E 93 7D 36 0E D7 65 93 1F A8 15 FF BF F5 7C A8 D0 F9 38 7C A4 10 F9 B1 EC D7 E2 F0 89' - '6C F2 53 D9 AF C7 E1 33 D9 E4 E7 B2 DF 8E C3 17 B2 C9 2F D5 15 F2 2B 75 85 FC 5A 76 B3 38 7C 23' - '9B BC C1 35 32 CE FF CF 41 0F C6 E1 5B 5A B1 59 D6 77 41 8C A3 F9 7D 10 A3 F5 43 10 6B 1A 87 1F' - '83 18 AD 9F 82 18 DF C4 CF 41 8C D6 2F 41 8C 6F FC D7 20 46 EB B7 20 C6 41 F8 3D 88 D1 FA 23 88' - 'F1 5D FC 2F 88 D1 FA 93 56 4C 96 F5 57 50 92 EF EF EF A0 24 AD 7F 82 92 B4 6E 6A AC 2E C4 E1 96' - 'C6 8A BC AD B1 21 FF D5 D8 90 B8 99 55 53 B9 38 44 05 56 F9 38 44 07 56 A3 38 C4 DC FC 6F 9B D9' - '02 8B 7F C6 DE 64 32 4B BB 2A E2 4C F2 FA EC 26 2B C4 21 87 49 D6 93 D3 24 2B C9 65 92 35 E4 96' - '2C E3 6A C8 63 92 35 E4 35 C9 1A F2 99 64 0D F9 4D B2 86 02 26 59 43 48 B2 AC AB A1 A0 49 96 2D' - '64 92 65 0B 9B 64 D9 22 92 E5 5C 13 77 98 64 D9 3B 25 CB BB 1A EE 32 49 EF DD 92 15 9C F7 1E 93' - '0C DC 6B 92 05 EE 93 4C 72 05 8A 9A 64 81 78 93 2C 93 60 92 65 8B 49 56 71 05 8A 9B A4 B7 84 64' - '55 57 C3 FD 26 59 E0 01 93 AC A1 A4 49 96 2D 25 59 CD 15 78 D0 24 BD A5 25 AB 3B F9 90 64 0D 57' - '59 19 93 F4 96 95 AC E9 BC E5 4C D2 5B 5E B2 9E F3 56 30 C9 7A 2B 9A 64 C3 61 93 2C 5B C9 24 47' - '32 D1 24 47 32 49 B2 BE BB AC B2 49 96 AD 62 92 65 AB 9A 64 D9 6A 92 0D DC 6D 57 DD 24 1B AE 61' - '92 35 D4 34 C9 86 6B 99 6C 18 87 DA 26 59 EF C3 26 59 6F 1D 93 AC F7 11 C9 86 AE B2 BA 26 59 59' - '3D 93 AC AC BE 49 D6 D0 C0 24 6B 68 68 92 35 34 92 6C E4 6A 68 6C 92 35 34 31 C9 1A 9A 9A E4 AB' - '99 49 D6 D0 DC 24 6B 68 21 D9 D8 D5 D0 D2 24 6B 68 65 92 35 24 9B 64 F1 D6 26 59 43 1B 93 AC 21' - '45 B2 89 AB A1 AD 49 96 6D 67 92 65 DB 9B 64 D9 0E 92 CD 5D D9 8E 26 D9 5A 27 93 6C AD B3 49 D6' - 'D0 C5 24 6B E8 6A 92 AF 6E 92 61 6E F9 3C 95 48 56 72 B2 87 64 33 27 7B EA 06 2F 06 B4 64 CF 78' - '42 31 AB 95 B3 7A 9B 95 EC AC 3E 66 B5 76 56 5F B3 DA 38 AB 9F 59 29 AE CE FE 37 B3 16 2A B6 97' - '1A 58 89 3C CB 04 16 3B 3D 30 B0 38 3A 83 6E FE 77 81 1B 1C 58 FC 73 08 BB 1C 5B DA 55 38 D4 24' - '6B 1B 66 92 55 0D 37 C9 7A 46 98 64 25 23 4D B2 86 51 92 65 5C 0D A3 4D B2 86 34 93 AC 61 8C 49' - 'D6 30 D6 24 6B 18 67 92 35 A4 4B 96 75 35 8C 37 C9 1A 26 98 64 0D 19 26 59 C3 44 93 AC 61 92 49' - 'D6 30 59 D2 DF 5C 53 4C D2 3B 55 D2 DF 46 D3 4C D2 3B 5D D2 DF 46 33 4C 72 16 CF 34 C9 D6 66 99' - 'E4 65 B3 4D F2 B2 39 92 FE 26 98 6B 92 05 E6 99 64 81 F9 92 8D 5C BD 0B 4C F2 B5 50 B2 B1 7B 6F' - '8B 4C F2 BD 2D 36 C9 02 4B 4C F2 B5 D4 24 EB 5D 66 92 F5 2E 97 F4 93 6A 85 64 73 57 D9 4A 93 AC' - 'EC 51 93 AC EC 31 93 BC F2 71 93 BC 72 95 49 BE 56 DF CC DA DD 38 F9 D7 04 16 E7 FF DA C0 E2 2D' - 'B0 2E B0 58 F1 FA C0 E2 2D B4 81 15 C6 F8 FD 6A A3 49 5E BF C9 24 2F DE 6C 92 57 3E 61 92 97 6D' - '91 F4 9B D4 93 26 79 D9 53 26 79 D9 D3 26 79 D9 33 26 79 D9 B3 92 7E 22 3C 27 E9 37 9E AD 26 E9' - 'DD 26 E9 37 9E ED 26 E9 DD 21 E9 37 9E 9D 26 E9 DD 25 E9 77 9B DD 26 59 7C 8F 49 96 D9 6B 92 65' - 'F7 49 FA DD 66 BF 49 16 38 60 92 05 0E 4A FA 8D E7 90 49 96 7D DE 24 CB 1E 36 C9 B2 47 24 FD C6' - '73 54 D2 EF 36 C7 24 FD 6E 73 DC 24 BD 2F 48 FA DD E6 84 49 7A 4F 4A FA DD E6 94 49 56 F6 A2 49' - 'B6 F6 92 49 96 7D 59 D2 EF 2B AF 98 A4 F7 55 49 BF 6D BC 66 92 05 4E 9B 64 0D 67 4C 72 46 9F 35' - 'C9 CB 5E 97 F4 1B C4 39 93 BC EC BC 49 5E 76 C1 24 CB BE 61 92 79 7B 53 D2 EF 0A 6F 99 E4 65 6F' - '9B E4 65 17 4D F2 75 49 D2 AF FF 97 4D B2 EC 3B 26 59 36 D3 24 CB 5E 31 C9 26 DE 95 F4 8B FE 55' - '93 2C F0 9E 49 DE 31 EF 4B FA 95 FE 9A 49 D6 7B DD 24 EB FD C0 24 2F FB D0 24 AF FC 88 D3 3D 5B' - 'D6 E4 FF 38 B0 18 FB 84 C5 B2 F9 B9 FD A9 49 7A 3F 93 F4 53 F7 73 93 F4 7E 21 E9 A7 EE 97 26 E9' - 'FD 4A D2 4F B1 AF 4D D2 FB 8D 64 65 E7 BD 61 92 DE 6F 25 7D 46 BE 33 C9 02 DF 4B FA 01 FF 41 D2' - '0F CC 8F 26 79 D9 4F 92 FE 6D FD 6C 92 DE 5F F4 46 EA C6 D9 C6 F3 AB 59 7E E3 F9 CD 2C BF F1 FC' - '6E 67 23 AE 1E 7F 98 64 15 FF B3 03 11 BD 7F 9A A4 F7 2F 3B 10 E9 28 6D 92 DE 7F EC D4 A6 43 B4' - '49 7A 6F 49 56 76 DE DB 26 E9 FD D7 8E 8B F4 E2 96 97 F4 46 DD F2 47 4B 7A A3 4D D2 1B 73 CB 9F' - '1C 75 88 36 A9 13 F4 2D 7F 1A A4 37 CE 24 BD D9 6F F9 73 1F BD 39 4C D2 9B F3 96 6F 98 F5 E5 32' - 'C9 06 73 9B 64 7D 79 4C 72 F0 F2 9A E4 8A 9B EF 96 7F 17 94 F9 AD 09 CA 02 56 2F 65 88 32 D6 8F' - '59 41 93 6C AD 90 A4 1F B3 C2 26 75 82 96 F4 63 76 87 49 7A EF 94 F4 63 76 97 49 7A EF 96 F4 63' - '76 8F 49 7A EF 95 F4 63 76 9F 49 7A 8B 4A FA 31 8B 37 49 6F 82 A4 1F B3 62 26 E9 2D 2E E9 C7 AC' - '84 49 7A EF 97 F4 63 F6 80 49 7A 4B 5A C3 AC AF 94 49 9D A0 4D B2 BE D2 26 75 82 36 C9 21 29 63' - 'EF 82 B2 AC 35 41 59 CE EA A5 2C 4F 19 E3 EB AD 60 52 27 68 93 3A 41 9B D4 09 FA 96 5F 99 39 91' - '13 CD 4B 99 74 CB AF AB 2C 50 F9 96 BF 99 58 59 15 93 AC AC AA 49 56 56 ED 96 BF AF 58 A0 BA 49' - '16 A8 61 92 05 6A 4A FA CA 6A 49 FA 45 BA B6 FA CB 6D BD 05 4F D0 4A B7 97 6D 6E 71 4B F4 BB 19' - 'CB A4 D0 8A F5 1B 9A 4E A0 16 F3 56 BB C0 62 C9 F6 66 F9 FD A8 83 59 7E 9D EC 18 58 3A 90 06 96' - 'CE A4 6A A1 5C 24 D6 45 B1 2C AB AB 62 BE 7A 1D 4E 03 8B 59 EC AE 92 49 91 BE F4 30 CB 6F A2 3D' - '55 D2 5B 2C D9 CB 2C 5F 67 6F 2B E9 AD 3E 81 C5 C2 7D 83 92 7C F5 0B 62 7C F5 57 CC EF 9A 7C A5' - '2A 96 65 0D B0 98 2F 39 50 56 E5 C8 B8 0C 52 C9 2C 6B B0 C5 FC 04 1E 62 96 1F 89 A1 56 D2 5B C3' - '82 98 8E AB 41 8C AF 11 8A F9 5D 59 87 56 B3 FC C8 8F 52 C9 2C 6B B4 62 D5 22 EF 36 4D B1 2C 6B' - '4C 60 F1 35 36 28 C9 9E 8D 93 55 23 32 0B D2 CD F2 25 C7 EB BA 2C 6B 42 10 63 5F 32 64 D5 8C C4' - '26 06 16 EB 9C 14 58 2C 39 59 56 BD 48 3F A7 A8 CE 2C 6B AA 62 F5 23 FD 9C 16 58 7C 4D 97 D5 30' - '32 9E 33 02 8B 2D CC 0C 2C B6 30 4B 75 FA FD 9D AF D9 16 F3 D6 1C B3 7C 7B 73 AD A4 B7 E6 59 CC' - 'B7 3E DF 62 DE 5A 20 AB 51 64 D6 2D 0C 2C FE B9 48 D7 35 8A F4 65 B1 C5 FC 8C 5C 12 58 FC 73 A9' - '59 FE 18 B7 2C B0 F8 E7 CA A0 24 1D 8F CA 6A 12 99 9F 8F 05 16 5F 8F CB 6A 1C 69 7D 95 5A 6F 1C' - '79 EF AB CD F2 ED AD B1 92 DE 5A 1B C4 58 72 9D 59 3E 47 EB 03 8B B1 0D B7 FC 33 95 6F 6F E3 2D' - '7F 58 F6 D6 26 C5 FC B1 98 BE CD B6 4E F8 79 FD 44 60 B1 96 2D 66 F9 92 4F 06 16 63 4F 99 E5 5B' - '7F 3A B0 18 7B 26 58 19 18 7B D6 2C FF FE 9E 0B 62 B4 B6 DA 7D EB EB DC 16 DC A9 BC 6E 7B 70 37' - 'D2 DA 11 DC 39 B4 76 06 73 82 D6 AE 20 EF B4 76 DB 7B F7 25 F7 98 E5 4B EE 0D C6 85 7F EE B3 BC' - '7B 6B 7F 30 5B 69 1D 08 B2 42 EB A0 46 30 6B 5E 1F B2 99 E5 F3 F7 7C 70 1F B1 E4 61 59 0D 22 D6' - '91 20 7F 3A 67 5B 7B 7E 3C 8F 05 B3 9C BE E3 C1 75 3A 70 07 EF 8F D6 89 20 EF AC E5 64 30 9E AC' - 'E5 94 AD AD FE FD BD 68 2D 78 EB 25 BB 53 7D 5F 5E B6 BC FB EB 5E 51 EB 59 ED BD 6A 2B 83 6F EF' - '35 5B 23 7D EC 74 90 23 5E 77 26 E8 0B AD 9F 68 E9 E0 C1 AE 5E E2 C9 4E 56 FD 88 F5 CB 2D 64 D3' - 'D6 D4 D0 BD 38 F9 7F 35 07 5B F5 0F F8 BF C9 91 75 17 56 E4 29 4F 0E 5F 9D 1F D0 3F E4 60 C9 24' - 'F7 21 2D DD FF 93 A3 86 93 FE 08 F9 A7 1C 4D 5D 09 3F 03 FE 0A BA A4 03 E0 2D 14 0C AC 62 C0 7F' - '3B 44 F3 BF 55 D1 FC 6F 45 FF DC 42 0E 9D F1 1A BA 88 17 0F 46 2E BD 69 1D BB 10 F1 15 B8 8D A8' - '5C E5 80 90 18 15 46 41 31 3A 8C 42 62 4D A0 B0 58 0B 28 22 16 07 EE 10 1F 01 EE 14 EF 08 E3 2E' - 'F1 CE 30 EE BE 8D 98 5C 59 FF DA 7F F8 36 A2 CD AA A4 02 85 8B 21 51 2C 54 0C 49 62 2F A0 B2 B1' - '8A A8 7F CE 56 D4 BF AB 20 4E 02 AA 8B 53 F8 4E DD F5 61 D4 14 8B 84 51 4B 2C 10 46 6D 31 14 C6' - 'C3 62 AE 30 EA 88 B9 C3 78 44 CC 11 46 5D 31 67 18 F5 C4 3C 61 D4 17 F3 86 D1 40 CC 17 46 43 31' - '7F 18 4D C4 6E 1C 42 B1 07 D0 EC 76 D6 FF 31 D0 3C 90 2D 02 D9 32 90 AD 78 4D 01 BE 87 64 63 6B' - '63 1B 32 2F 07 35 45 E4 A0 B6 15 39 16 ED 45 0E 66 07 91 83 DB 51 D4 FF 55 20 72 70 3B 8B 1C AB' - '2E 22 C7 A4 AB C8 31 E9 26 72 4C BA 8B 1C 93 1E AE 5C 18 3D 45 8E 49 2F F1 7E A0 B7 58 0A E8 23' - '96 01 FA 8A 65 81 7E 62 79 A0 BF 58 1B 48 15 EB 00 03 C4 87 81 41 62 77 60 B0 F8 00 30 44 2C 09' - '0C 15 EB 02 A3 F8 96 F5 F1 19 4F 6B A3 29 F5 78 43 99 66 DE 96 DC CB 4D B6 E2 D6 6D 92 CF 46 E3' - 'AD 2C E5 04 F3 F2 19 29 C3 BC 94 13 CD CB 67 A5 49 E6 A5 9C 6C 5E 3E 3E 4D 31 2F E5 54 F3 B6 E5' - 'FE 6C 5E CA E9 EC 61 5C 71 6E CB B7 FD 79 B2 1D F7 E4 DB FE 94 49 39 CB BC 7C E0 9C 6D 5E CA 39' - 'F2 36 75 72 AE BC 5E CE B3 B2 1D B8 03 5B 59 CA 05 B7 FD 47 95 2C B0 F0 B6 FF F4 87 72 D1 6D FF' - '84 4B B9 F8 B6 7F 2A A4 5C A2 BE F0 B2 A5 A4 2E 5F 26 9B 2B C6 72 D9 E4 0A 52 9F E0 AC 24 F5 B4' - 'FB A8 E2 0F 71 93 55 9C 7C 5C 36 37 A3 55 B2 C9 D5 2A 4F AE 51 79 72 AD E2 7C F2 5D A7 38 B9 5E' - '71 72 83 E2 E4 46 C5 79 BF 6F 52 9C DC AC 38 F9 84 E2 E4 16 C5 B9 66 3D A9 B8 3E 30 52 9C 7C 5A' - '71 F2 19 C5 B9 5A 3E AB 38 F9 9C E2 E4 56 C5 C9 6D 8A 73 B5 DB AE 38 B9 43 76 98 9B 9A 6C 72 97' - '6C AE 2D BB 65 93 7B 64 27 72 F3 92 4D EE 93 CD 65 6A BF 6C F2 80 EA 27 0F AA 7E F2 90 E2 DC 38' - '9F 57 9C 3C AC 38 79 44 71 F2 A8 E2 5C 13 8F 29 4E 1E 57 9C 7C 41 71 F2 84 E2 DC 6A 4F 2A 4E 9E' - '52 9C 7C 51 71 F2 25 C5 79 E0 7C 59 71 F2 15 C5 C9 57 15 27 5F 53 9C 4F 2A A7 15 27 CF 28 4E 9E' - '55 9C 7C 5D 71 2E BC E7 14 27 CF 2B 4E 5E 50 9C 7C 43 71 1E 37 DF 54 9C 7C 4B 71 F2 6D C5 C9 8B' - '8A 73 5B BB A4 38 79 59 71 F2 1D C5 C9 4C C5 B9 0D 5D 51 9C 7C 57 71 F2 AA E2 E4 7B 8A 73 13 7A' - '5F 71 F2 9A E2 E4 75 C5 C9 0F 14 E7 92 FE A1 E2 E4 47 8A 93 1F 2B 4E 7E A2 B8 3E 6D 51 9C FC 4C' - '71 7D CE A2 38 F9 85 E2 DC 22 BF 54 9C FC 4A 71 F2 6B C5 C9 6F 14 E7 1E 72 43 71 7D A4 A2 38 F9' - '9D E2 E4 F7 8A F3 66 FA 41 71 7D 53 29 9B BB D7 4F B2 C9 9F 65 F3 56 F9 45 36 F9 AB AE 27 7F D3' - 'F5 E4 EF DC 42 E2 FC 66 C5 7B F7 8F DB FE 28 E1 AD FF 05 31 DE 69 7F 06 31 5A 7F 05 31 DE B1 7F' - '07 31 5A FF DC F6 5F AE D0 BA 79 DB 7F C4 4C 19 F5 2F A2 72 73 BD 8D 16 4B 00 31 22 D7 CF 6C 22' - 'D7 BF 58 91 EB 5F 9C C8 F5 34 BB F8 20 90 43 D4 BF 1C 24 EA 5F AB 12 B9 CE E6 16 B9 CE E6 11 B9' - 'EE E7 15 B9 DE E6 13 B9 EE E7 17 2B 02 05 C4 30 37 5B B1 12 50 50 4C 04 0A 89 49 DC 6C C5 CA DC' - '6C C5 2A DC 6C C5 AA DC 6C C5 6A C0 5D 62 75 E0 6E B1 06 70 8F C8 7D E4 5E 91 FB CA 7D 22 D7 F7' - 'A2 22 D7 F5 78 91 EB 7C 82 C8 7D A6 98 C8 F5 BC B8 58 0F 28 21 D6 07 EE 17 1B 00 0F 88 0D 81 92' - '62 23 A0 94 D8 98 87 0F B1 09 50 5A 6C 0A 3C 24 36 03 CA 88 CD 81 B2 62 0B 1E 36 44 FD D7 EB 62' - '2B 6E FF 62 32 50 51 6C CD 63 81 D8 86 67 02 31 05 48 14 DB 02 49 62 3B 9E 09 C4 F6 3C 13 88 1D' - '78 26 10 3B F2 4C 20 76 E2 99 40 EC CC 33 81 D8 05 A8 29 76 05 6A 89 DC C3 6B 8B DC C7 1E 16 B9' - '97 D7 11 7B 02 8F 88 DC 97 EB 8A BD 81 7A 62 1F A0 BE D8 17 68 20 F6 03 1A 8A FD 81 46 62 2A D0' - '58 1C 00 34 11 07 F2 8C 20 0E E2 19 41 1C 0C 34 17 87 70 5F 14 87 72 27 14 87 71 1B 14 87 73 0F' - '14 47 70 D7 13 47 72 9F 13 47 71 67 13 47 73 2F 13 D3 80 76 E2 18 9E 0F C4 B1 3C 1F 88 E3 78 3E' - '10 D3 79 3E 10 C7 F3 7C 20 4E 00 BA 88 19 3C 1F 88 13 79 3E 10 75 3E 10 27 F3 7C 20 F2 9C D0 53' - '9C 0A F4 12 E7 3C 84 DE E2 DC 87 D0 87 CC C3 43 5E 5F 91 67 A3 7E 22 CF 46 FD 45 9E 57 52 C5 7F' - 'C2 18 20 FE 12 C6 40 71 4B 18 83 C4 A7 C2 18 2C 3E 13 C6 10 F1 B9 30 86 8A DB C2 18 26 7E 16 C6' - '70 F1 8B 30 46 88 5F 85 31 52 7C 25 8C 51 E2 CD 30 46 8B 4F 86 91 26 3E 1D C6 18 F1 D9 30 C6 8A' - '5B C3 18 27 6E 0F 23 5D DC 11 C6 78 71 57 18 13 C4 3D 61 64 88 FB C2 98 28 1E 08 63 92 78 28 8C' - 'C9 E2 E1 30 A6 88 47 C3 98 2A 1E 0F 63 9A 78 22 8C E9 E2 A9 30 66 88 2F 85 31 53 7C 35 8C 59 E2' - 'E9 30 66 8B 67 C3 98 23 9E 0B 63 AE 78 3E 8C 79 E2 85 30 E6 8B 6F 84 B1 40 7C 33 8C 85 E2 5B 61' - '2C 12 2F 85 B1 58 CC 0C 63 89 78 35 8C A5 E2 B5 30 96 89 1F 86 B1 5C FC 28 8C 15 E2 C7 61 AC 14' - '3F 09 E3 51 F1 D3 30 1E 13 3F 0F E3 71 F1 CB 30 56 89 5F 87 B1 5A FC 26 8C 35 E2 8D 30 D6 8A DF' - '86 B1 4E FC 2E 8C F5 E2 F7 61 6C 10 7F 0C 63 A3 F8 6B 18 9B 44 FD 63 A5 E2 BA 30 9E 10 7B 87 B0' - '45 44 08 4F BA 7C 87 F0 94 1B EF 10 9E 76 F3 22 84 67 C4 9D 21 3C EB C6 3D 84 E7 C4 98 10 B6 8A' - 'D9 42 D8 26 C6 86 B0 5D DC 1B C2 0E 97 8F 10 76 8A FB 43 D8 E5 F2 12 C2 6E F1 60 08 7B 5C 7E 42' - 'D8 2B DE 13 C2 3E 31 2E 84 FD 62 F6 10 0E 88 39 42 38 28 16 0F E1 90 98 33 84 E7 C5 5C 21 1C 16' - '73 87 70 C4 CD D7 10 8E BA F9 1A C2 31 31 5F 08 C7 C5 FC 21 BC 20 16 08 E1 84 18 0A E1 A4 58 30' - '84 97 C5 3E 21 BC 22 F6 0D E1 55 B1 5F 08 AF 89 FD 43 38 2D A6 86 70 46 1C 10 C2 39 71 60 08 E7' - 'C5 41 21 5C 10 07 87 F0 86 38 24 84 37 C5 A1 21 BC 25 0E 0B E1 92 38 3C 84 CB E2 88 10 DE 11 47' - '86 90 29 8E 0A E1 8A 38 3A 84 77 C5 B4 10 DE 17 C7 84 70 4D 1C 1B C2 75 71 5C 08 1F EB FE 7C 12' - 'F8 44 7C 0A F8 54 DC 09 7C F6 2F A2 F5 6F FA 66 8B C1 E7 72 3D 0B 7C 21 3E 03 7C 29 6E 2B 86 AF' - '5D EA 4A E2 1B 71 79 71 DC 10 57 14 C7 B7 E2 CA E2 F8 4E 7C B4 38 BE 17 9F 28 89 1F DC D4 2E 89' - '75 05 A2 A2 B1 B6 40 D4 B1 02 51 1B 24 D7 3B B9 43 F2 19 27 2B 84 28 2B 85 A2 1E 0C 45 55 94 4C' - '74 B2 45 21 CA 26 85 A2 EA 14 8A 6A 69 B2 53 A1 A8 E3 85 29 8F 16 8E 3A 56 38 EA 05 93 7B 0B 47' - '9D 34 79 82 81 22 94 47 8A 44 ED 29 12 75 5C F2 A8 93 D5 EF A6 AC 72 77 54 F8 EE A8 9E 17 29 3B' - '5D 8C 4A BD 18 D5 4B B2 B3 93 BD 2F 46 C5 98 1C 71 31 AA 4F 60 8D BC 18 D5 37 B0 46 5D 8C EA 17' - '58 A3 2F 46 F5 0F AC B4 8B 51 C7 55 E1 51 67 BD 20 79 CC C9 13 2A 73 34 52 F7 49 59 C7 22 D6 A9' - '20 C6 96 5E 0C 62 B4 F0 4E 54 54 14 F7 D0 28 91 7B 68 B4 A8 FF DF 4C E4 1E 9A 4D E4 1E 1A 2B 72' - '0F 8D 13 B9 87 66 17 B9 87 E6 10 F5 1F C7 8B DC 43 73 89 DC 43 73 8B DC 43 F3 88 DC 43 F3 8A DC' - '43 F3 89 DC 43 F3 8B DC 43 0B 88 DC 43 43 22 F7 D0 82 22 F7 D0 42 22 F7 D0 C2 22 F7 D0 22 22 F7' - 'D0 3B 44 EE A1 77 8A DC 43 EF 12 B9 87 DE 2D 72 0F BD 47 E4 9E 78 AF C8 3D F1 3E 91 7B 62 51 91' - '7B 62 BC C8 3D 31 41 E4 9E 58 4C E4 9E 58 5C E4 9E 58 42 D4 FF 73 2F 72 4F 7C 40 E4 9E 58 52 E4' - '9E 58 4A E4 9E F8 A0 C8 3D B1 B4 A8 FF 0F 44 E4 9E 58 46 E4 9E 58 56 E4 9E 58 4E E4 9E 58 5E E4' - '9E 58 41 E4 9E 58 51 E4 9E 18 16 B9 27 56 12 B9 27 26 8A DC 13 93 44 EE 89 95 2D 3F 55 2C 3F 55' - '2D 3F D5 2C 3F D5 2D 3F 35 2C 3F 35 2D 3F B5 2C 3F B5 2D 3F 0F 5B 7E EA 58 7E 1E B1 FC D4 B5 FC' - 'D4 B3 FC D4 B7 FC 34 B0 FC 34 B4 FC 34 B2 FC 34 B6 FC 34 B1 FC 34 B5 FC 34 B3 FC 34 B7 FC B4 B0' - 'FC B4 B4 FC B4 B2 FC 24 5B 7E 5A 5B 7E DA 58 7E 52 2C 3F 6D 2D 3F ED 2C 3F ED 2D 3F 1D 2D 2F 9D' - '2C 2F 9D 2D 2F 5D 2C 2F 5D 2D 2F DD 2C 2F DD 2D 2F 3D 2C 2F 3D 2D 2F BD 2C 2F BD 2D 2F 7D 2C 2F' - '7D 2D 2F FD 2C 2F FD 2D 2F A9 96 97 01 96 97 81 96 97 41 96 97 C1 96 97 21 96 97 A1 96 97 61 96' - '97 E1 96 97 11 96 97 91 96 97 51 96 97 D1 96 97 34 CB CB 18 CB CB 58 CB CB 38 CB 4B BA E5 65 BC' - 'E5 65 82 E5 25 C3 F2 32 D1 F2 32 C9 F2 32 D9 F2 32 C5 F2 32 D5 F2 32 CD F2 32 DD F2 32 C3 F2 32' - 'D3 F2 32 CB F2 32 DB F2 32 C7 F2 32 D7 F2 32 CF F2 32 DF F2 B2 C0 EE 9B 85 96 9F 45 96 9F C5 96' - '9F 25 96 9F A5 96 9F 65 96 9F E5 96 9F 15 96 9F 95 96 9F 47 2D 3F 8F 59 7E 1E B7 FC AC B2 FC AC' - 'B6 FC AC B1 FC AC B5 FC AC B3 FC AC B7 FC 6C B0 FC 6C B2 BC 6C B6 BC 3C 69 79 78 C6 C6 FD 59 1B' - 'F7 6D 36 CE DB 6D 9C 77 D8 38 EF B4 71 DE 6D E3 BB C7 C6 77 AF 8D EF 3E 1B DF FD 36 BE 07 6C 7C' - '0F DA F8 1E B2 F1 7D DE C6 F7 B0 8D EF 11 1B DF A3 36 BE C7 6D 5C 4F D8 78 9E B4 F1 3C 65 E3 F9' - 'A2 8D E7 4B 36 9E 2F DB 78 BE 62 E3 F9 9A 8D E3 69 1B C7 33 36 8E 67 6D 1C 5F B7 71 3C 67 E3 78' - 'DE C6 F1 82 8D E3 1B 36 8E 6F DA 38 BE 65 E3 F8 B6 8D E3 45 9B E7 97 6C 3C 2F DB 78 BE 63 F3 3C' - 'D3 E6 F9 15 1B DF 77 6D 9E 5F B5 79 FE 9E 8D F7 FB 36 DE D7 6C 9E 5F B7 79 FE 81 8D FF 87 36 FE' - '1F D9 F8 7F 6C E3 FF 89 CD F3 4F 2D 0F 9F 59 1E 3E B7 3C 7C 61 79 F8 D2 F2 F0 95 E5 E1 6B CB C3' - '37 96 87 1B 96 87 6F 2D 0F DF 59 1E BE B7 3C FC 60 F3 FC 47 CB C7 4F 36 CF 7F B6 BC FC 62 79 F9' - 'D5 F2 F2 9B E5 E5 77 CB CB 1F 96 97 FF 59 5E FE B4 79 FE 97 E5 E7 6F CB CF 3F 96 9F 9B 96 9F 5B' - '96 9F DB 96 9F 7F 2D 3F C8 F4 F9 89 CA F4 F9 89 CE F4 F9 89 C9 F4 F9 C9 96 E9 F3 13 9B E9 F3 93' - '3D D3 E7 25 47 A6 CF 4B CE 4C 9F 97 5C 99 3E 2F 79 33 7D 1E F2 65 FA 3C E4 CF F4 79 28 90 E9 F3' - '10 CA F4 79 28 98 E9 F3 50 28 D3 E7 A1 70 A6 CF C3 1D 99 7E FC EF CC F4 E3 7F 57 A6 1F FF BB 33' - 'FD F8 DF 93 E9 C7 FF DE 4C 3F FE F7 65 FA F1 8F CF F4 E3 9E 90 E9 C7 BD 58 A6 1F F7 E2 99 7E DC' - '4B 64 FA 71 BF 3F D3 8F FB 03 99 7E DC 4B 66 FA 71 2F 95 E9 C7 FD C1 4C 3F EE A5 33 FD B8 3F 94' - 'E9 C7 BD 4C A6 1F F7 B2 99 7E DC CB 65 FA 71 2F 9F E9 C7 BD 42 A6 1F F7 8A 99 7E DC C3 99 7E DC' - '2B 65 FA 71 4F CC F4 E3 9E 94 E9 C7 BD B2 8D 7B 15 1B F7 AA 36 EE D5 6C DC AB DB B8 D7 B0 71 AF' - '65 E3 5E DB C6 FD 61 1B F7 3A 36 EE 75 33 FD 7D 50 CF C6 BF BE 8D 7F 03 1B FF 86 36 FE 8D 6D DC' - '9B DB 38 B7 B0 71 6E 69 E3 DC CA C6 39 D9 C6 B9 B5 8D 73 1B 1B E7 B6 36 CE ED 6C 9C DB DB 38 77' - 'B0 71 EE 68 E3 DC C9 C6 B9 B3 8D 73 17 1B E7 AE 36 CE DD 6C 9C BB DB 38 F7 B0 71 EE 69 E3 DC CB' - 'C6 B9 B7 8D 73 1F 1B E7 BE 36 CE FD 6C 9C FB DB 38 A7 DA 38 0F B0 71 1E 68 E3 3C C8 C6 79 B0 8D' - 'F3 10 1B E7 A1 36 CE C3 6C 9C 87 DB 38 8F C8 F4 EB CF 48 1B EF 51 36 DE A3 6D BC D3 6C BC C7 64' - 'FA F5 67 AC 8D FB 38 1B F7 74 1B F7 F1 36 EE 13 6C DC 33 6C DE 4F B4 F1 9F 64 F3 7E B2 CD FB 29' - '99 7E FD 99 6A 79 99 66 79 99 6E 79 99 61 79 99 69 79 99 65 79 99 6D 79 99 93 E9 D7 9F B9 96 9F' - '79 96 9F F9 96 9F 05 96 9F 85 96 9F 45 96 9F C5 96 9F 25 96 9F A5 96 9F 65 96 9F E5 96 9F 15 96' - '9F 95 96 9F 47 2D 3F 8F 59 7E 1E B7 FC AC B2 FC AC B6 FC AC B1 FC AC B5 FC AC B3 FC AC B7 FC 6C' - 'B0 FC 6C B4 FC 6C B2 FC 6C B6 FC 3C 61 F9 D9 62 F9 79 D2 F2 F3 94 E5 E7 69 CB CF 33 96 9F 67 2D' - '3F CF 59 7E B6 5A 7E B6 59 7E B6 5B 7E 76 58 7E 76 5A 7E 76 59 7E 76 5B 7E F6 58 7E F6 5A 7E F6' - '59 7E F6 5B 7E 0E 58 7E 0E 5A 7E 0E 59 7E 9E B7 FC 1C B6 FC 1C B1 FC 1C B5 FC 1C B3 FC 1C B7 FC' - 'BC 60 F9 39 61 F9 39 69 F9 39 65 F9 79 D1 F2 F3 92 E5 E7 65 CB CF 2B 96 9F 57 2D 3F AF 59 7E 4E' - '5B 7E CE 58 7E CE 5A 7E 5E B7 FC 9C B3 FC 9C B7 FC 5C B0 FC BC 61 F9 79 D3 F2 F3 96 E5 E7 6D CB' - 'CF 45 CB CF 25 CB CF 65 CB CF 3B 96 9F 4C CB CF 15 CB CF BB 96 9F AB 96 9F F7 2C 3F EF 5B 7E AE' - '59 7E AE 5B 7E 3E B0 FC 7C 68 F9 F9 C8 F2 F3 B1 E5 E7 13 CB CF A7 96 9F CF 2C 3F 9F 5B 7E BE B0' - 'FC 7C 69 F9 F9 CA F2 F3 B5 E5 E7 1B CB CF 0D CB CF B7 96 9F EF 2C 3F DF 5B 7E 7E B0 FC FC 68 F9' - 'F9 C9 F2 F3 B3 E5 E7 17 CB CF AF 96 9F DF 2C 3F BF 5B 7E FE B0 FC FC CF F2 F3 A7 E5 E7 2F CB CF' - 'DF 96 9F 7F 2C 3F 37 2D 3F B7 2C 3F B7 2D 3F FF 5A 7E 70 C5 E7 27 EA 8A CF 4F F4 15 9F 9F 98 2B' - '3E 3F D9 AE F8 FC C4 5E F1 F9 89 BB E2 F3 93 FD 8A CF 4F 8E 2B 3E 3F 39 AF F8 FC E4 BA E2 F3 93' - 'FB 8A CF 4F 9E 2B 3E 3F 79 AF F8 FC E4 BB E2 F3 93 FF 8A CF 4F 81 2B 3E 3F A1 2B 3E 3F 05 AF F8' - 'FC 14 BA E2 F3 53 F8 8A CF 4F 91 2B 3E 3F 77 5C F1 F9 B9 F3 CA FF B5 74 16 D0 51 5D 5D 14 DE DC' - '29 03 85 0A A5 B8 5B 71 09 24 40 70 48 70 09 51 42 08 21 24 01 82 05 82 BB 06 6B 81 16 77 87 16' - '28 D2 02 85 22 55 A8 7B FB B7 F3 EA EE 0E 54 A0 54 FE B7 CF DB 6B B1 D6 77 4F 32 73 EF 39 E7 BB' - 'F7 BD 37 6B 01 13 F8 A9 14 09 FC 54 8E 04 7E AA 44 02 3F 55 23 81 9F 6A 91 C0 4F F5 48 E0 A7 46' - '24 F0 53 33 12 F8 A9 15 09 FC D4 8E 04 7E EA 44 02 3F 75 23 81 9F 7A 91 C0 CF 5D 91 C0 4F FD 48' - 'E0 A7 41 24 F0 D3 30 12 F8 69 14 09 FC 34 8E 04 7E 9A 44 02 3F 4D 23 81 9F 66 91 C0 4F F3 48 E0' - 'A7 45 24 F0 13 15 09 FC B4 8C 04 7E 5A 45 02 3F D1 91 C0 4F 8C FC B4 96 9F 36 F2 D3 56 7E 62 E5' - 'A7 9D FC B4 97 9F 0E F2 D3 51 7E 3A C9 4F 67 F9 E9 22 3F 5D E5 A7 9B FC C4 C9 4F BC FC 74 97 9F' - '1E F2 D3 53 7E 7A C9 4F 6F F9 E9 23 3F 7D E5 A7 9F FC F4 97 9F 01 F2 93 20 3F 03 E5 27 51 7E 92' - 'E4 27 59 7E 52 E4 27 55 7E D2 E4 67 90 FC A4 CB CF 60 F9 C9 90 9F 21 F2 93 29 3F 43 E5 27 4B 7E' - '86 C9 4F B6 FC 0C 97 9F 1C F9 C9 95 9F 3C F9 19 21 3F 23 E5 67 94 FC E4 CB CF 68 F9 19 23 3F 63' - 'E5 67 9C FC 8C 97 9F 02 F9 99 20 3F 13 E5 A7 50 7E 26 C9 CF 64 F9 99 22 3F 53 E5 67 9A FC 4C 97' - '9F 19 F2 33 53 7E 66 C9 CF 6C F9 99 23 3F 73 E5 67 9E FC CC 97 9F 05 F2 B3 50 7E 16 C9 CF 62 F9' - '29 92 9F 25 F2 B3 54 7E 96 C9 CF 72 F9 59 21 3F 77 CB CF 3D F2 B3 52 7E 56 C9 CF 6A F9 B9 57 7E' - 'EE 93 9F 35 F2 B3 56 7E D6 C9 CF 7A F9 D9 20 3F 1B E5 67 93 FC 6C 96 9F 2D F2 B3 55 7E B6 C9 CF' - '76 F9 D9 21 3F 3B E5 67 97 FC EC 96 9F 3D F2 B3 57 7E F6 C9 CF 7E F9 39 40 B6 2C 86 FB C9 B6 0E' - '87 C8 B5 21 1C 26 D7 85 F0 20 B9 3E 84 23 E4 86 10 8E 92 1B 43 38 46 6E 0A E1 38 B9 39 84 87 C8' - '2D 21 3C 4C 6E 0D E1 04 B9 2D 84 93 E4 F6 10 4E 91 3B 42 78 84 DC 19 C2 69 72 57 08 67 C8 DD 21' - '3C 4A EE 09 E1 2C B9 37 84 73 9A EF 3C B9 3F 84 0B E4 81 10 1E 23 EF 0F E1 71 F2 81 10 9E 20 0F' - '86 F0 24 79 28 84 A7 48 FE 77 98 64 89 3A B8 48 9E 08 E1 12 79 32 84 67 C8 53 21 3C 4B 3E 12 C2' - '73 E4 E9 10 9E 27 CF 84 F0 02 F9 68 08 2F 92 67 43 78 89 3C 17 C2 CB E4 F9 10 5E 21 2F 84 F0 2A' - 'F9 58 08 AF 91 8F 87 F0 3A F9 44 08 6F 90 4F 86 F0 26 F9 54 08 6F 91 4F 87 F0 3F F2 62 08 6F 93' - '97 42 78 87 7C 26 84 08 F9 6C 08 1E F9 5C 08 EF 92 CF 87 F0 1E F9 42 08 EF 93 2F 86 F0 01 E9 EA' - 'E0 43 E5 FB 91 F2 FB 58 79 7D A2 F7 7F AA F5 3E D3 FA 9F CB E7 17 F2 F9 A5 7C 7E 25 9F 5F CB E7' - '37 F2 F9 AD 7C 7E A7 FE 7F 2F 9F 3F C8 E7 8F F2 F9 93 7C FE 2C 9F BF C8 E7 AF F2 79 59 3E AF C8' - 'E7 55 CD F7 9B 7C FE 2E 9F 7F C8 E7 9F F2 79 4D 3E AF CB E7 5F F2 79 43 3E FF 96 CF 7F E4 F3 5F' - 'F9 FC 4F 3E E1 05 FD 29 E6 05 3E 9D 17 F8 0C 79 41 BF 6E F2 02 9F C5 BD A0 6F 61 2F F0 59 C2 0B' - '7C 96 F4 02 9F 37 7B 81 CF 52 5E E0 B3 B4 17 F4 F3 16 2F E8 EF AD 5E E0 F3 36 2F F0 79 BB 17 F8' - '2C E3 05 3E EF F0 02 1F 65 BD C0 E7 9D 5E E0 B3 9C 17 F8 2C EF 05 3E 2B 28 DF 8A CA AF 92 F2 AA' - 'AC F7 57 D1 7A 55 B5 7E 35 2F F0 59 DD 0B 7C D6 F0 02 9F 35 BD C0 67 2D 2F F0 59 DB 0B 7C D6 F1' - '02 9F 75 BD A0 FF F5 BC C0 E7 5D 5E E0 B3 BE 17 F8 6C E0 05 3E 1B 7A 81 CF 46 5E E0 B3 B1 17 F8' - '6C E2 05 3E 9B 7A 81 CF 66 9A AF B9 17 F8 6C E1 05 3E A3 BC C0 67 4B 2F F0 D9 CA 0B 7C 46 7B 81' - 'CF 18 2F F0 D9 DA 0B 7C B6 F1 02 9F 6D BD C0 67 AC 17 F8 6C E7 05 3E DB AB 3F 1D E4 B3 A3 7C 76' - '52 BF 3A CB 67 17 F5 AD AB 7C 76 93 CF 38 F9 8C 97 CF EE F2 D9 43 FD EC A9 FE F6 92 CF DE F2 D9' - '47 3E FB CA 67 3F F9 E8 2F 9F 03 E4 33 41 3E 07 CA 67 A2 F2 4D 52 7E C9 CA 2B 45 EF 4F D5 7A 69' - '5A 7F 90 7C A6 CB E7 60 F9 CC 90 CF 21 F2 99 29 9F 43 E5 33 4B FD 1F 26 9F D9 F2 39 5C 3E 73 E4' - '33 57 3E F3 E4 73 84 7C 8E 94 CF 51 F2 99 AF F9 46 CB E7 18 F9 1C 2B 9F E3 E4 73 BC 7C 16 C8 E7' - '04 F9 9C 28 9F 85 F2 39 49 3E 27 CB E7 14 F9 9C AA FE 4C 93 CF E9 F2 39 43 FD 9A 29 9F B3 D4 B7' - 'D9 F2 39 47 3E E7 CA E7 3C F9 9C 2F 9F 0B D4 CF 85 EA EF 22 F9 5C 2C 9F 45 F2 B9 44 3E 97 CA C7' - '32 F9 5C 2E 9F 2B E4 F3 6E F9 BC 47 F9 AE 54 7E AB 94 D7 6A BD FF 5E AD 77 9F D6 5F 23 9F 6B E5' - '73 9D 7C AE 97 CF 0D F2 B9 51 3E 37 C9 E7 66 F5 7F 8B 7C 6E 95 CF 6D F2 B9 5D 3E 77 C8 E7 4E F9' - 'DC 25 9F BB E5 73 8F 7C EE D5 7C FB E4 73 BF 7C 1E 90 CF FB E5 F3 01 F9 3C 28 9F 87 E4 F3 B0 7C' - '3E 28 9F 47 E4 F3 A8 7C 1E 93 CF E3 EA CF 43 F2 F9 B0 7C 9E 50 BF 4E CA E7 29 F5 ED 11 F9 3C 2D' - '9F 67 E4 F3 51 F9 3C 2B 9F E7 D4 CF F3 EA EF 05 F9 7C 4C 3E 1F 97 CF 27 E4 F3 49 F9 78 4A 3E 9F' - '96 CF 8B F2 79 49 3E 9F 51 BE CF 2A BF E7 94 D7 F3 7A FF 0B 5A EF 45 AD FF 12 F9 A1 7F FF 27 3F' - 'F2 EF F7 64 94 FF F9 9E 6C E9 7F BE 27 5B F9 9F EF C9 68 FF F3 3D 19 E3 7F BE 27 5B FB 9F EF C9' - '36 FE E7 7B B2 AD FF 71 94 8C F5 6F 53 64 3B FF F3 BD E6 7B 4F F3 BD AF F9 3E D0 7C 1F 6A BE 8F' - '34 DF C7 9A EF 13 CD F7 A9 E6 FB 4C F3 7D AE F9 BE D0 7C 5F 6A BE AF 34 DF D7 9A EF 1B CD F7 AD' - 'E6 FB 4E F3 7D AF F9 7E D0 7C 3F 6A BE 9F 34 DF CF 9A EF 17 CD F7 AB E6 BB AC F9 AE 68 BE AB 9A' - 'EF 37 CD F7 BB E6 FB 43 F3 FD A9 F9 AE 69 BE EB 9A EF 2F CD 77 43 F3 FD AD F9 FE D1 7C FF 6A BE' - 'FF 34 1F 7E F6 C9 BF 6B 47 36 0C C3 91 4D C3 08 91 2D C2 28 4E F6 0E 23 4C B6 0A A3 04 D9 2C 8C' - '92 64 DB 30 6E 26 FB 86 51 8A 8C 0F A3 34 D9 3D 8C 5B 48 FE 8B 42 B2 67 18 B7 91 D1 61 DC 4E B6' - '0B A3 0C D9 2D 8C 3B C8 D6 61 94 25 E3 C2 B8 93 6C 19 46 39 32 26 8C F2 64 E3 30 2A 90 4D C2 A8' - '48 36 0F A3 12 19 15 46 65 B2 4D 18 55 C8 D8 30 AA 92 ED C3 A8 46 4E 08 A3 3A 79 3E 8C 1A E4 DE' - '30 6A 92 13 C3 A8 AD 7A EB A8 DE 7A 64 AF 30 1A A8 BE 46 AA AB B1 EA 6A A2 BA 9A AA AE 66 AA AB' - 'B9 EA 6A A1 BA A2 54 57 4B D5 D5 4A 75 C5 A8 9E D6 AA A7 8D EA 69 AB 7A DA A9 8E 0E CA 3F 4E 79' - 'F5 52 3E 7D 94 4F 3F E5 31 40 EB 27 68 FD 81 5A 3F 49 EB 26 6B DD 54 AD 9B AE 75 32 B4 4E A6 D6' - 'C9 52 7F B2 D5 97 1C F5 25 57 EB 8F 50 5F F2 95 C7 68 79 1F A3 7C C6 AA 3F E3 D5 97 02 E5 35 41' - '79 4D 54 5E 85 EA CB 24 E5 37 59 F9 4D 55 7E D3 D4 97 E9 EA CB 0C E5 3B 4B F9 CE 96 DF 39 CA 7B' - 'AE FC CE 97 D7 85 DA C7 8B 94 FF 62 E5 5F A4 7D BC 44 75 2C D5 7E 5E A6 FD BC 5C 75 AD 50 5D 77' - 'AB AE 95 EA F3 2A D5 B5 5A 75 DD AB BA EE 53 5D 6B 54 D7 5A D5 B5 4E 75 AD D7 3E DE A0 FA 36 AA' - 'BE 4D AA 6F B3 EA DB A2 7D BC 55 75 6E 53 9D DB 55 E7 5E D5 B3 4F F5 EC 57 3D F7 AB 8E 07 54 C7' - '41 D5 71 48 75 1C 56 1D 47 54 C7 51 D5 71 4C 75 1C 57 1D 0F A9 8E 87 55 C7 09 D5 71 52 75 9C 52' - '1D 8F A8 8E D3 AA E3 8C EA 78 54 75 9C 55 1D E7 54 C7 79 D5 71 41 75 E0 72 31 FB C6 99 E6 40 31' - '0D 9B 02 8E C3 96 36 0C 71 D8 CA 86 37 71 18 6D C3 E2 1C C6 D8 30 CC 61 6B 1B 96 E0 B0 8D 0D 4B' - '72 D8 D6 86 37 73 18 6B C3 52 1C B6 B3 61 99 CB C5 82 2F 31 85 7D 9B AC A2 38 8B CA 2A 8A B7 E8' - '4E 45 DD 2D 2A A7 A8 87 45 E5 15 F5 B4 A8 82 A2 5E 16 55 54 D4 DB A2 4A 8A FA 58 54 59 51 5F 8B' - 'AA 28 EA 67 51 55 45 FD 2D AA A6 68 80 45 D5 15 25 58 54 43 D1 40 8B 6A 2A 4A B4 A8 96 A2 24 8B' - '6A 2B 4A B6 A8 8E A2 14 8B EA 2A 4A B5 A8 9E A2 34 8B EE 52 34 C8 A2 FA 8A D2 2D 6A A0 68 B0 45' - '0D 15 65 58 D4 48 D1 10 8B 1A 33 2A 17 C5 F5 CA 47 A1 C9 65 FF 09 C8 6F 6D 53 D2 4F A8 99 2F 85' - 'B1 DF DF E6 1C A6 DB DB A2 FC DF F2 9B 20 5A 92 BE 96 56 A4 FF AA 68 D2 7F 69 0C E9 4B 68 4D FA' - 'ED 6F 43 FA 8D 6F 4B FA 2D 8F 25 FD 66 B7 23 FD 36 B7 27 FD 06 77 20 FD D6 76 24 FD A6 76 22 FD' - '76 76 26 FD 46 76 21 FD 16 76 25 FD E6 75 23 FD 2C E3 48 BF 80 78 92 5F 4A 48 FA 4D EA 41 FA ED' - 'E9 49 FA A9 F7 22 FD 96 F4 26 FD 66 F4 21 FD 7A FA FA A5 31 2F FF A5 FD 38 0C BE AA A4 3F 87 29' - '56 FB 00 0D FD 3F 09 7E BF F4 6D 1A FE 6B 06 F2 17 E9 B6 1B C7 FA C3 92 03 6C 38 4E 43 FE 9D 1B' - '0D FD 2C D7 F0 B5 DD 6D 5F E1 8A 3F 9C 13 85 7E 51 28 C6 E1 29 FB CA 31 77 C5 4F E7 74 14 CA 90' - 'FD 72 71 07 99 9E 89 B2 E4 2B 29 B8 93 2F 0D BE 52 AD 1C 7F B4 2A 01 E5 C9 2A 19 A8 40 7E 71 37' - '2A 92 8D 32 50 89 3C 90 80 CA 64 AD 51 A8 42 D6 9E 84 AA E4 D6 91 A8 46 0E 48 46 75 9B 27 1B 35' - 'C8 D5 49 A8 49 3E 3C 12 B5 C8 EA C9 A8 4D C6 CD 43 1D B2 E6 34 D4 25 0F AF 42 3D F2 D7 C1 B8 8B' - '6C 97 8A FA 64 B9 89 68 40 6E CC 45 43 32 2D 0F 8D 48 FF 44 34 26 6F 4E 40 13 B2 EF 1A 34 25 BF' - 'CE 42 33 B2 59 02 9A 93 57 53 D0 82 2C 91 87 28 B2 70 35 5A 92 29 B9 68 45 2E 9A 85 68 72 F6 6C' - 'C4 90 25 53 D1 9A 5C 38 01 6D 6C FE 7C B4 B5 9F E7 23 96 8C 9E 86 76 E4 E4 64 B4 27 CF A4 A1 83' - 'D5 BD 16 5D AF 04 BB BE 69 3E 77 7D 37 45 7E 82 7E 14 A7 68 95 45 F1 8A EE CE 64 D4 5D D1 B9 42' - '46 3D 14 F9 09 FA 51 4F 45 DE 74 46 BD 14 7D 94 CC A8 B7 A2 F4 91 8C 12 FD 2C 4A 6C CE 46 12 F9' - '4B 0A 7E BD 11 3C 20 5E BE 11 3C 20 5E B9 11 3C 20 5E BD 11 3C 20 FE 76 23 78 40 FC FD 46 F0 80' - 'F8 C7 8D E0 01 F1 CF 1B C1 03 E2 B5 1B C1 03 E2 F5 1B 7A 40 BC E6 8A A1 53 02 8A 91 B1 09 70 64' - 'B7 04 84 C8 3A C5 DC 4D E4 F0 81 28 4E 1E 1F 88 30 79 61 20 4A 90 2E 11 25 C9 D9 89 B8 99 DC 9A' - '88 52 E4 37 89 28 4D BE 9E 88 5B C8 5D 31 B8 95 6C 1F 76 B7 91 03 92 70 3B 99 9A 84 32 E4 88 24' - 'DC 41 CE 48 42 59 B2 5A 71 77 27 79 2E 06 E5 C8 FC 24 94 27 FD 5D 57 81 EC 57 DC 55 24 37 27 A1' - '12 79 20 09 95 C9 57 12 50 85 3C 9A 84 AA E4 E9 24 54 23 3F 59 EB AA 93 BF 27 A1 06 19 4A 46 4D' - 'FB 79 0C 6A 91 1D FC DD 4B F6 4C 46 1D D2 DF 05 75 2D 9F 64 D4 23 CB B7 C6 5D E4 F3 C9 A8 4F BE' - '98 8C 06 E4 97 C9 68 48 FE 95 8C 46 64 F1 14 34 26 C3 29 68 42 56 4C 41 53 B2 4F 0A 9A 91 49 29' - '68 4E 0E F1 77 2F 39 25 05 51 E4 BC 14 B4 24 17 A4 A0 95 18 2D C6 90 4D 4B B9 D6 64 61 21 DA 90' - '2F A5 A0 AD E5 9F 82 58 32 AF B4 6B 47 FE 90 82 F6 E4 E5 14 74 B0 3C 52 D1 D1 FA 9F 8A 4E E6 37' - '15 9D C9 DE A9 E8 42 8E 4E 45 57 72 5F 2A BA 91 7F A4 22 8E 2C 93 86 78 32 25 0D DD 6D FE 34 F4' - '20 97 A4 A1 A7 D8 CB 7C A7 A1 37 79 24 0D 7D C8 53 69 E8 4B 5E 4C 43 3F B2 42 3A FA 5B 1E 83 30' - 'C0 FA 91 8E 04 EB C3 20 0C 24 A7 0E 42 22 E9 DF 3E 92 C8 9F 07 23 99 7C 2D 1D 29 E4 6F E9 48 25' - '6F 1D 8C 34 72 65 3A 06 91 AD 06 23 9D 6C 39 18 83 CD F7 60 64 98 8F 72 6E 08 79 65 30 32 C9 3F' - '07 63 A8 AD 9F 81 2C D2 BF FA 0D B3 7D 9D 81 6C 32 37 03 C3 C9 43 15 5C 0E F9 7D 05 97 4B FE 98' - '81 3C B2 EA 10 8C 20 1B 0C C1 48 F2 DD 0C 8C 22 47 0D 41 BE E5 DB 06 A3 C9 BF DB 60 0C 59 32 13' - '63 C9 CE 99 18 27 8E 27 5F A8 EC 0A C8 4B 99 98 60 F3 64 62 A2 9D 93 4C 14 92 57 33 31 89 AC 54' - 'D5 4D 26 FF CB C4 14 CB 7B 28 A6 9A 87 6C 4C B3 BC 87 62 3A B9 A8 2D 66 D8 B9 1C 8A 99 E4 84 A1' - '98 45 3E 35 14 B3 ED 9C 0C C5 1C EB 47 75 37 97 8C CF C2 3C F2 EB EA 6E BE BD 3E 0B 0B C8 71 59' - '58 48 CE CD C2 22 F2 B3 2C 2C 26 3F CF 42 11 D9 22 16 4B C8 7F B2 B0 94 6C 38 0C CB EC 7A 31 0C' - 'CB C9 31 C3 B0 C2 FA 18 8B BB C9 A2 DA EE 1E 9B 2F 16 2B C9 87 87 61 95 ED 8B 61 58 4D 9E 19 86' - '7B 6D FF 0E C3 7D E4 BA FD 6E 0D F9 EF 30 AC 35 9F 75 DD 3A 71 3D 59 6C 31 36 58 DD D9 D8 28 6E' - 'B2 73 18 8B CD E4 D9 56 6E 0B F9 7E 8E DB 6A 79 64 63 9B D5 95 8D ED E4 17 B1 D8 41 6E CB C6 4E' - 'F2 D5 6C EC 22 BD 6C EC 26 AF 67 63 8F F5 73 38 F6 DA F5 A9 1D F6 D9 F5 A7 1D F6 93 1B 86 E3 00' - 'F9 76 7D 77 BF AD 3B 1C 0F D8 F9 C9 C1 41 B2 7F 0E 0E 91 09 39 38 AC F8 41 BB 1E E6 E0 08 79 6F' - '0E 8E 92 27 73 70 CC AE 53 39 38 4E 3E 94 83 87 C8 8F 73 F0 B0 ED D7 1C 9C B0 F3 97 83 93 76 FE' - '72 71 CA F6 5F 2E 1E 21 B3 72 71 9A 3C 91 8B 33 96 4F 2E 1E 25 13 F3 70 96 BC A5 89 3B 67 5E F2' - '70 DE F6 63 2E 2E D8 F9 CE C3 63 E6 25 0F 8F DB 7E C8 C3 13 76 7D 68 E2 9E B4 7E 8E C0 53 E4 B3' - '79 78 9A 3C 9C 87 8B 64 F3 F6 B8 64 7E 47 E0 19 72 FE 08 3C 4B EE 1C 81 E7 EC BA 38 02 CF 93 E3' - 'DB E3 05 72 E0 48 BC 68 F1 48 BC 44 96 8A 72 2F 5B FF 47 E2 15 F2 DA 28 BC 6A D7 C1 51 78 8D AC' - 'DC 01 AF 93 6B 47 E1 0D 3B 37 1D F0 A6 E5 D7 1E 6F D9 BE 48 C2 FF C8 8D 49 78 9B 44 3E DE 21 77' - '8C 42 84 3C B6 10 1E F9 5E 3C DE B5 EB 4A 3E DE B3 7E E5 E3 7D B2 76 3E 3E 20 87 E5 E3 43 3B 3F' - 'F9 F8 C8 CE 5F B4 FB D8 F2 E8 80 4F EC BA 9D 8F 4F C9 A5 F9 F8 8C 4C 1E 8D CF 2D 1E 8D 2F C8 82' - '18 F7 A5 79 1C 8D AF C8 9A A3 F1 35 59 6E 0C BE B1 7E 74 C0 B7 64 DC 18 7C 47 EE 1F 83 EF ED 3A' - '32 06 3F D8 75 65 2C 7E B4 9F B7 71 3F 91 1F 8C C5 CF 76 CE 3B E2 17 CB 73 1C 7E 25 0F C6 BA CB' - '76 3F 1C 87 2B B6 9F 3A E2 AA DD 87 C6 E1 37 72 F7 38 FC 4E 9E 1F 87 3F EC FE 3B 0E 7F DA 39 6F' - 'EF AE 91 A5 AB BB EB 56 4F 7B F7 97 BD 7F 3C 6E 90 8F 75 74 7F 93 4F 8E C7 3F B6 FF C7 E3 5F BB' - '9F 8E C7 7F 76 7D 2E F0 1F 04 78 9D 2A 40 31 72 46 01 1C D9 AD 00 21 72 4C 01 6E 22 67 16 A0 38' - 'B9 B4 00 61 B2 46 27 57 82 8C 29 40 49 B2 C5 04 DC 4C 4E 98 80 52 64 74 27 94 26 5F 9E 80 5B C8' - 'E7 27 E0 56 F2 CD CE EE 36 F2 7A 01 6E B7 D7 4F 44 19 72 58 17 77 07 79 6F 17 57 96 7C 6E 22 EE' - '24 DB 15 A2 9C AD E7 3F 42 91 55 0B 51 81 DC D4 09 15 C9 BE 85 A8 44 CE 2B 44 65 CB BF 10 55 C8' - '63 85 A8 4A DE 55 DC 55 23 7B 4C 42 75 32 2F CE D5 20 77 4C 42 4D F2 48 BC AB 45 36 9C 8C DA 64' - 'EB C9 A8 43 26 4E 46 5D B2 64 4F 57 8F 5C 38 19 77 91 1B 27 A3 BE BD AE 97 6B 40 96 EB ED 1A 92' - 'B3 A7 A0 11 B9 72 0A 1A 93 47 3B A3 09 79 FF 14 34 25 CF 76 46 33 B1 39 D9 6B 2A 5A 90 43 A7 22' - '8A 9C 34 15 2D AD BF 53 D1 8A 7C 69 2A A2 AD DE 2E 88 21 EB 4D 43 6B B2 4D 7F D7 C6 7C 4D 43 5B' - '72 5D 7F 17 4B 16 FA 4F AF E4 EE DA AE 3D 59 66 3A 3A 90 7B 07 BA 8E B6 EE 40 D7 89 EC 9E E8 3A' - '93 7F 77 41 17 AB AF 2B BA 92 BF 4D 47 37 F2 6A A2 8B 23 AF 24 BA 78 B2 72 92 EB 6E 3E 93 5C 0F' - 'F3 30 03 3D C9 9A 33 D0 4B EC 6D 1E 66 A0 8F F9 EA 8A BE D6 87 19 E8 47 F6 EC 8A FE E6 AB 2B 06' - '90 D5 53 5D 02 99 30 13 03 C9 55 33 91 48 BE 32 13 49 E4 17 5D 91 4C D6 1F E4 52 C8 41 B3 90 4A' - '6E 1B E4 D2 C8 67 07 B9 41 E4 7D B3 90 4E FE 30 0B 83 6D FF 75 43 06 D9 75 36 86 58 3E B3 91 49' - '0E 9C 8D A1 E4 DC 0C 97 45 1E 1C E2 86 89 D9 E4 CF B3 31 9C 74 71 C8 B1 FD 90 E9 72 6D FF CD 41' - '1E F9 E2 1C 8C 20 1B C4 61 A4 ED 83 A1 6E 14 F9 D6 5C E4 93 7B E2 30 9A FC 76 2E C6 58 FE 73 31' - '96 04 BF A6 CB E7 B2 6C 37 DE F6 DD 3C 14 90 C5 E2 31 C1 CE C3 3C 4C B4 75 E7 A3 D0 F6 E7 7C 4C' - 'B2 F3 14 8F C9 B6 1F 73 DD 14 DB 27 B9 6E 2A 99 11 8F 69 E4 7B B9 6E BA ED B7 05 98 61 FB 20 CF' - 'CD B4 7D B9 00 B3 C8 BF 16 60 36 59 7C 21 E6 90 EF 8F 70 73 C9 BA 23 DD 3C 72 F8 42 CC 27 0F 8D' - '74 0B 6C DF 2C C4 42 32 3B DA 2D 22 DF 89 C7 62 F2 E4 42 14 91 A1 45 58 42 96 EE 8E A5 B6 DE 22' - '2C 23 4F 0F C1 72 EB 63 BE 5B 61 71 BE BB 9B 5C 1F ED EE B1 F3 15 ED 56 5E 0F EE DF AB C8 9B 16' - '63 35 B9 8B 5F D3 C5 FB 73 77 DC 47 AE 5D 8C 35 B6 5F 16 63 2D B9 73 31 D6 91 A7 92 B1 9E 3C E1' - 'DF FF 2D 5E 8C 8D E4 E3 8B B1 89 FC 7A 31 36 93 1D C7 B9 2D E4 57 8B B1 D5 F6 57 11 B6 59 BF 8B' - 'B0 DD AE 03 45 D8 61 F5 17 61 A7 BD BF 08 BB C8 6F 8A B0 9B 4C 5F 82 3D 64 4A 11 F6 DA B9 2B C2' - '3E DB 8F 45 D8 4F 7E 58 84 03 76 EE C6 BB FB 2D EF 02 F7 80 F5 69 BC 3B 48 36 E9 81 43 E4 E5 25' - '38 6C E7 67 09 1E 24 2B 2C C5 11 9B 6F 8A 3B 4A 8E 58 8A 63 64 D3 89 EE 38 99 D5 03 0F 91 39 3D' - 'F0 B0 D5 39 D1 9D B0 7D 55 E8 4E DA 3A 3D 70 CA AE 43 CB F0 88 5D 27 96 E1 34 99 BF 0C 67 EC BA' - 'BC 0C 8F 92 87 97 E1 2C B9 62 19 CE 91 B7 2D C7 79 F2 F3 65 B8 40 CE 5A 8E C7 6C 3F 2D C7 E3 36' - 'EF 72 3C 61 FB 72 39 9E 24 BD 1E 78 8A FC 6C 39 9E 36 5F 2B 70 D1 AE CF 3D 70 C9 F6 CB 0A 3C 63' - 'FD 5C 81 67 6D FD E9 EE 39 7B DF 0A 3C 4F 7E BC 02 2F D8 F5 B0 27 5E B4 FD B7 02 2F 91 17 62 F0' - '32 79 7C A6 7B 85 1C 35 CB BD 4A 3E D1 13 AF D9 FE EF 89 D7 ED FC DC 83 37 C8 9F EE C1 9B E4 3D' - '2B F1 16 99 B6 0A FF B3 7D 3A D7 BD 6D E7 72 15 DE 21 9F 5E 85 88 5D 17 57 C3 B3 EB FD 6A BC 6B' - 'E7 7F 81 7B CF F6 59 49 F7 BE DD 77 56 E3 03 F2 B1 D5 F8 90 FC 75 35 3E B2 7C 4B BA 8F C9 B7 EF' - 'C5 27 64 EC 7D F8 D4 FA BE D4 7D 66 79 2C 75 9F 93 1B D6 E0 0B F3 BA 06 5F 92 77 AC C5 57 64 F3' - 'E5 EE 6B 5B 7F 2D BE B1 F7 AF C3 B7 D6 8F 75 F8 8E 7C 77 1D BE B7 EB CD 3A FC 60 7D 5C 8F 1F C9' - 'F2 1B F0 93 F5 67 A5 FB D9 F6 FB 46 FC 62 E7 B6 0F 7E 25 1F DD 88 CB 41 3D EE 8A ED EF 3E B8 4A' - '5E DA 84 DF EC 3C 66 E1 77 DB C7 9B F1 87 5D 2F D6 BA 3F C9 2A EB DC 35 BB 8F F6 C5 75 72 7A 5F' - 'FC 45 7E BA 19 37 C8 52 1B DC DF F6 FE BE F8 C7 AE C3 1B DC BF 76 9E B7 E0 3F 11 7F F9 6C B4 05' - 'C5 C8 33 1B 9D 23 3F DF 82 10 19 DD 0F 37 D9 EF B7 A2 38 79 70 2B C2 E4 C5 AD 28 41 FE BB 15 25' - 'C9 D7 FA E1 66 32 6A BB 2B 45 96 DD 8E D2 64 D7 1D B8 85 FC 67 07 6E B5 D7 F5 C7 6D E4 4F FD 71' - '3B 99 BF 13 65 EC E7 7B DC 1D E4 B5 FE 28 4B 16 DF EB EE 24 6F DB E7 CA 91 6B F7 B9 F2 E4 85 5D' - 'A8 40 0E 1A 80 8A E4 F5 5D A8 64 79 EC 42 65 7B DF 6E 54 21 6F DF 8D AA 64 85 DD A8 46 76 D8 8D' - 'EA 24 1E 70 FF 07 1C 47 E8 49' -} - - -LANGUAGE 0,0 COMBINING UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE -{ - '78 DA 1D D5 59 70 14 65 14 05 E0 73 E7 4F 77 FF 09 C9 74 C2 84 24 D3 33 AD 8D 20 88 10 1C 25 04' - '12 82 94 18 C2 3A 88 80 A0 22 E0 52 4A 09 28 2E C8 03 6A A1 B8 95 5A 3E 68 95 5A A8 A5 A5 0F 91' - '0C 2E C8 22 5B 94 80 3B 1A A5 01 51 11 75 08 10 92 00 45 02 88 20 12 FC EF AD FA 5E CF 7D 3A 75' - '2E F5 A8 50 18 AE B0 27 C9 5A 92 68 4B 62 57 80 DD 01 7E 0D B0 2F C0 E1 00 AD 01 3A 02 1C 0D 50' - '95 47 46 E7 7C 3A 3D 9F DE 6E 64 F3 42 BA 37 24 9B 3A 17 51 D7 22 72 E2 35 B9 30 1A 45 4D 1E 6B' - '14 35 3D 58 63 3E 1B 56 C8 2A 12 AC 55 0C 4B B2 B5 0D 6C 73 21 19 0F 17 B1 1D A2 B2 27 6B 17 23' - '62 54 13 A3 BA 62 F6 85 68 EA C5 36 94 B0 EA 32 76 7D 9C 8D F6 D9 84 76 A6 69 45 0A 6F A4 90 5B' - '99 CE 85 D1 2C D2 79 AC 59 A4 7B B0 66 91 CE 67 CD 62 44 01 6A 0A 90 16 3B 44 75 94 6D 16 4F BB' - 'AC AA 10 D5 85 28 2E 65 15 62 97 B8 DD 63 B5 09 96 49 60 55 02 27 13 38 95 C0 B2 72 66 AF 64 83' - 'C4 97 62 5A 03 6B 12 67 32 EC F8 2A 36 2A 8F 8C BA 42 B6 4C 6C 12 43 8A A8 A2 88 9A C4 D0 9E AC' - '43 A4 63 6C 74 31 DB 2E B6 F6 62 A3 4A D8 A7 62 60 29 AB 2A 63 23 E3 74 6D 9C B2 A2 C2 63 63 C5' - '0A 31 2A C9 6A 7D 1A E3 D3 EB 22 8F 56 5B 30 7A D0 27 16 8C 7C 5A 63 C1 28 A0 B5 16 8C 28 AD B3' - '60 B8 B4 DE 82 51 48 9F 5A 30 8A 68 83 05 A3 67 64 A3 05 E3 1B 11 A3 4D 16 36 5B 28 A6 2D 16 8C' - '5E D4 68 C1 28 A1 CF 2C 18 A5 B4 D5 82 51 46 DB 2C 18 71 DA 6E C1 F0 E8 92 F3 30 12 91 89 36 8C' - '4E CD 92 91 49 36 8C 2E CD FC 48 DA 86 71 52 B3 4B 22 65 36 8C C9 E2 D2 48 DC 86 71 83 08 22 9E' - '0D 63 8A E8 4D 37 DA 30 2E A3 A9 36 8C 3E F4 80 0D A3 2F 15 39 30 A6 D3 4D F9 30 66 D1 8C 7C 18' - 'F3 68 78 14 55 51 2C A0 71 51 4C 8C 62 09 6D 8C 62 53 14 4B E9 DB 28 BE 8F E2 49 7A D0 85 B1 5C' - '3D E4 C2 58 EA E2 71 17 4F 88 A7 69 B1 0B 63 87 EA AD 70 99 42 7F 85 2B 14 76 FA 6C 2F FD E8 C3' - 'F8 35 27 A1 60 54 B9 EC EE 90 EE 09 E9 FE 90 1E 0A 69 1F 5D 99 82 B1 7F 72 89 42 5C 21 A9 10 28' - 'F4 51 E8 A7 30 40 61 88 C9 28 D4 28 8C 55 18 AF 90 56 98 AC 30 4D 61 86 C2 2D 0A B7 2A BC 6C B1' - 'D7 C4 9B E2 3D 0B EF 5B C8 88 AF C4 4D 36 66 D8 B8 4D CC 15 07 45 87 38 2E AE 76 58 85 18 E6 A0' - 'CA C1 08 07 35 0E AE 15 A3 45 AD A8 13 E3 C4 49 71 41 DC A2 31 4B 63 B7 38 28 5A 45 BB 38 AE 71' - '42 E3 8C 38 A7 F1 AF C6 D4 5C 56 E6 22 EE 62 A8 18 26 BE 16 2F 15 B2 11 71 56 E6 B1 65 62 BD 87' - 'CD 1E 3E 13 5B 3D 34 79 58 98 60 3F 27 F1 5B 12 FB 93 F8 2B 89 E3 62 BB CF 76 88 9F C4 39 71 41' - '5C 14 6D 01 3B 16 E0 44 80 81 0D 28 6F C0 BA 0C EB DF 8D F2 6E 5C 20 32 B2 11 56 90 C7 AA 45 AB' - 'A8 73 69 AC 4B 13 45 DA A5 29 2E 3D 1A D2 F2 90 5E 08 E9 C5 90 76 B6 D1 DE 36 FA 33 E7 0D 0B C6' - '87 A2 2A CE CA 53 2C 4B 83 53 B8 2A 85 16 BA 2F 64 87 72 3E B2 60 34 94 B1 7F 7C 9C F5 31 30 C5' - '5A 97 40 A1 58 61 A4 42 AD 42 9D 98 A0 30 49 61 8A C2 54 85 99 62 96 B8 4B 61 91 C2 53 39 78 2E' - '07 AF 58 78 D5 C2 EB 16 56 58 78 CB C2 BB 16 56 9A F3 16 56 59 F8 C0 C2 C7 E2 4B 51 68 A3 D4 C6' - '34 1B D3 6D CC B4 31 CB C6 6C 1B 73 6C EC B5 B1 DF C6 5F 36 5A 6C 1C 12 47 6C B4 D9 38 6A E3 98' - '8D 94 C3 AE 71 30 C4 C1 50 07 95 0E AA C5 48 31 CA C1 75 0E AE 17 63 C4 58 31 DE C1 04 07 47 1D' - '74 39 38 25 4A 34 E2 1A 09 8D 3E 1A 97 6B F4 D7 18 A0 51 AE B1 47 E3 80 C6 21 8D C3 1A 47 34 DA' - '34 3A 34 8E 69 9C D2 F8 5B E3 1F 8D B3 1A E7 35 2E 6A DC 98 CB A6 E5 62 7A 2E BA C5 72 17 4F B9' - '78 D6 C5 73 2E 66 C7 30 37 86 3F 4A 59 75 9C 95 7A EC 11 0F 8F 79 58 ED 61 9D 87 2D 1E 1A 3D 2C' - '48 B0 FB 12 78 38 81 9D E6 89 26 B1 2F 89 DF 93 C8 8A D3 E2 6C 12 E7 92 68 F2 B1 CD C7 17 3E BE' - 'F3 F1 BD 8F 1F 7C 84 3E FE F6 71 5E 74 8B 9D 01 C2 00 7B 02 FC 12 E0 F7 00 FB 03 1C 10 47 44 BB' - 'E8 14 27 06 A1 6B 10 B2 E5 B8 58 8E 45 F5 6C 71 3D 1E AF C7 DB F5 78 A7 1E 9D F5 E8 AA 47 76 25' - 'BA 56 62 75 86 AD C9 60 6D 06 1B 32 D8 98 C1 E7 19 6C CD 60 9B 08 BA D1 AF 1B 83 BB 71 55 37 96' - '28 5A AA C8 CD 63 C3 C5 61 D1 B7 80 FA 17 D0 AA 28 7D 10 A5 71 2E 4D 70 69 92 30 E3 1E 29 A2 7B' - '62 B4 30 46 0F C4 68 71 8C E6 14 B3 D4 02 AA 5C 40 CF 84 F4 7C 48 99 90 3E 0C 69 F4 2E AA DD 45' - 'A6 C0 76 96 74 96 CA B2 94 C8 52 EF 2C F5 C9 52 DF 2C F5 CB D2 95 59 4A 1D A0 CA 03 74 AC 85 4E' - 'B4 50 6D 3B 8D 6F A7 36 AB 97 82 E1 89 9B C5 19 9F 0D 4A B1 F6 9C DB 14 8C B9 E2 4E F1 9F CF 3A' - 'D4 6C 85 39 0A B7 2B DC A1 D0 EC B3 4E 1A A3 60 FC 0F E7 99 FD 83' -} - - -LANGUAGE 0,0 NUMBERS UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE -{ - '78 DA 5D 97 07 78 54 D7 B5 EF D7 FF 4C 3D 1A 4D D3 60 69 04 C2 D2 98 91 44 35 62 70 C1 0D 03 EE' - '9D DE 7B 11 20 81 E8 BD 18 6C D3 5C B1 71 CB AD A9 44 C0 4D F2 E2 E4 DE 9B DC 9B DC EB C4 71 4B' - 'B5 25 6C EC DC 66 70 41 82 19 40 34 83 B1 CD FB C5 3A 7E 8F F7 F4 7D FB 5B 73 F6 FA ED FF 5E 7B' - 'CF 9A B5 8E 9E 33 FE 74 C9 70 3C EB F3 AC DF B3 01 CF 06 3D 1B F2 6C D8 B3 EE 25 1A FE 4B B4 7C' - '97 3C 27 2E 59 E3 F3 9E BF 9E 2B F2 EC 6C CF B6 F9 FE AF DE 37 3D DB D3 5B 37 DC 7B EE 72 C9 5A' - 'DF 25 CF 01 EF D9 F1 3E 3B 5E BC 8E 17 E7 5F 6C C4 B3 51 CF C6 3D 9B F4 EC 45 FE 9C 4B 34 2F BF' - '24 86 BF D8 9C 67 6F F4 EC ED 9E FD 3A B6 89 5F 9F B9 B6 D3 26 BD E7 12 CF A6 2E B9 AF D0 FF 77' - '87 BE 4B EE CE B9 E4 3C 01 EF 2E 2F FD 2E 02 9E F5 79 F7 1A F0 6C C8 B3 11 8F 2D F6 EC 69 75 DA' - 'ED 29 2F DE 57 BC 3B DE AA AF 6C D4 E3 62 9E 8D 7B F6 32 CF 96 7A B6 CC B3 69 CF 96 7B B6 AB 67' - 'BB 79 B6 C2 B3 DD 3D 5B E9 D9 2A CF 66 3C 7B 85 67 7B 78 36 EB D9 6A CF D6 78 B6 D6 B3 BD 3C DB' - 'DB B3 7D 3C DB D7 B3 FD 3C 7B A5 67 FB 7B B6 CE B3 03 3C FB C6 D7 EB BC 7B D9 E9 D9 F1 4E A7 FD' - '85 67 AB BC 7C 7C C4 B3 6F 85 3A ED CF 22 DE FD C5 3B ED E2 32 6F 7D B7 4E 3B A4 D2 CB 9B 1E 9E' - 'CE FD 5E 1C 2B 3C FF DF 74 DA E9 47 BC F5 C9 CE EF 61 D3 A0 4E BB 73 5A A7 8D 78 DF E1 90 A8 EF' - 'AB E7 0F 76 F9 3B B9 AE C1 4E DD 6F 85 BE B2 2F D7 BA 9D 7A 3F 2C FA CA DA D5 C5 9D F1 FD 6B F4' - 'FF E4 5B B1 97 57 C5 5E DE 14 7B 79 55 EC E5 4F B1 97 53 C5 5E 1E 15 7B B9 54 EC E5 68 B1 F7 9B' - 'FB 3A A7 86 E8 FF CD FD 21 97 7C C7 3E EF F9 E5 7B 3A E3 DE F4 42 67 BC 43 86 C5 3B E3 3B 78 26' - 'F0 95 FD 28 32 FA 2B 9B F8 DE FE AF B8 E7 5F EC F4 F7 1B A0 BF D8 2F 82 9D DF 1D DF 9B F8 ED 39' - '03 91 BE 8A B0 AF 26 E4 6B 08 F7 5A 42 1D 44 98 D7 11 E2 4B F8 7F 82 FF E7 B0 BF 20 D4 5F 72 7D' - 'FF 46 B8 D3 D1 98 C1 F6 33 83 E6 CC 0A 9A 6F 76 D0 FC 73 82 16 A8 0F 5A 70 6E D0 42 F3 82 16 9E' - '1F 34 F7 04 5C 07 DC 49 B8 53 70 A7 E1 CE C0 9D 85 FB 14 EE 1C DC 79 B8 97 B9 9C 5F 71 ED BF 0E' - '99 F3 4A C8 7C BF 09 99 FF D5 90 05 5E 0B 59 F0 F5 90 85 DE 08 59 F8 CD 90 B9 F5 5C DA 5C BE 96' - '79 AE 39 F3 5D F3 35 B8 E6 6F 74 2D B0 C0 B5 E0 42 D7 42 4D AE 85 17 B9 E6 7E 02 77 18 AE 0D AE' - '1D EE 08 DC 51 B8 3C 5C 01 EE 18 DC 71 B8 D3 AE 45 CF B8 16 3B EB 5A FC 53 D7 8A CE B9 56 7C DE' - 'B5 44 3D 5F CA 5C BE F6 79 45 EC 53 C4 3E 45 EC 53 C4 3E 45 EC 53 C4 3E 45 EC 53 C4 3E 70 87 E1' - 'DA E0 DA E1 8E C0 1D 85 CB C3 15 E0 8E C1 1D 87 AB 27 E9 E6 46 D0 8B A0 17 41 2F 82 5E 04 BD 08' - '7A 11 F4 22 E8 45 CC 5D 1A B1 A2 65 11 8B 2C 8F 58 F1 8A 88 45 57 46 2C B6 2A 62 F1 4F 58 7F 98' - 'F5 6D AC 6F 67 FD 11 D6 1F 65 7D 9E F5 05 D6 1F 63 FD 71 D6 9F 88 58 B2 23 62 25 27 23 96 AA 27' - 'A9 E6 92 B2 F3 8A D9 B3 98 3D 8B D9 B3 98 3D 8B D9 B3 98 3D 8B D9 B3 D8 DC D5 70 6B E0 D6 C2 AD' - '83 5B CF E7 0D 7C DE C8 E7 4F F0 1D E6 B9 8D E7 76 9E 8F A0 71 14 8D 3C 1A 05 34 8E A1 71 1C 8D' - 'F1 51 EB 32 21 6A 97 4D 8C 5A E9 A4 A8 95 4D 8E 5A 7A 4A D4 CA A7 46 AD 6B 3D 85 70 2E 3F 99 79' - '51 E2 88 12 47 94 38 A2 C4 11 25 8E 28 71 44 89 23 6A EE E2 A8 25 97 44 AD 64 69 D4 52 CB A2 56' - 'B4 3C 6A 91 15 51 2B 5E 19 B5 E8 AA A8 C5 56 47 B9 07 B4 0E A3 D5 86 56 3B 5A 47 D0 3A 8A 56 1E' - 'AD 02 5A C7 D0 3A 8E D6 70 8A EE 88 98 69 64 CC 9C 51 31 F3 8D 8E 99 7F 4C CC 02 63 63 16 1C 17' - 'B3 D0 F8 98 85 27 C4 CC 7D 0B EE 6D B8 16 B8 56 B8 FD 70 EF C0 BD 0B 77 00 EE 3D B8 F7 E1 AA A8' - '49 19 7E 66 57 C4 CD E9 11 37 5F 36 6E FE EA B8 05 6A E2 16 AC 8D 5B A8 67 DC C2 BD E2 E6 F6 8E' - '5B A4 4F DC BA F5 8D 5B 45 BF B8 75 BF 32 6E 97 F7 8F 5B 65 5D DC AA 06 C4 2D 93 8B DB 15 03 E3' - 'D6 63 08 CD 7A 68 C2 34 2C 61 CE 2D 09 F3 DD 9A 30 FF 6D 09 0B DC 9E B0 E0 1D 09 0B DD 99 B0 F0' - '5D 09 73 77 C2 3D 0D F7 0C DC 2E B8 67 E1 9E 83 7B 1E EE 05 B8 17 E1 BE 01 37 3F 65 6A 48 99 D3' - '98 32 DF 82 94 F9 17 A6 2C D0 94 B2 E0 A2 94 85 16 A7 2C BC 24 45 6E A5 2C B9 2C 65 D9 E5 29 AB' - '5E 91 B2 9A 95 29 AB 5D 95 B2 9E AB 53 D6 6B 4D CA 7A AF 4D 59 9F 75 29 2B 59 9F B2 BE C7 4A AD' - 'DF F1 52 BB F2 44 A9 F5 FF 80 3A 7C B0 CC 74 A8 CC 9C 0F CB CC F7 51 99 F9 3F 2E B3 C0 27 65 16' - '3C 5C 66 A1 B6 32 0B B7 97 91 7B 70 1D 70 27 E1 4E C1 9D 86 3B 03 77 16 EE 53 B8 73 70 E7 E1 12' - '34 BA 64 DA 54 92 36 27 95 36 5F 97 B4 F9 2F 4B 5B A0 34 6D C1 B2 B4 85 D2 69 0B 97 A7 CD BD 9D' - '46 78 47 B9 E9 CE 72 73 EE 2A 37 DF DD E5 E6 BF A7 DC 02 F7 96 5B F0 BE 72 0B DD 5F 6E E1 07 CA' - 'F9 0E E1 DE 86 6B 81 6B 85 DB 0F F7 0E DC BB 70 07 E0 DE 83 7B 1F EE CF 30 9B 68 AA 9B BB 9A 1E' - 'EA 6A CE C3 5D CD F7 48 57 F3 6F E9 6A 81 AD 5D 2D B8 AD AB 85 B6 77 B5 F0 8E AE DC 3B DC D3 70' - 'CF C0 ED 82 7B 16 EE 39 B8 E7 E1 5E 80 7B 11 EE 1B 70 C3 E9 4D 23 BA 91 67 DD C8 B3 6E E4 59 37' - 'F2 AC 1B 79 D6 8D 3C EB 46 9E 75 23 CF BA 99 FB BF E0 7E 0C F7 12 DC 4F E0 7E 0A F7 8F 70 FF 04' - 'F7 CF 70 3F 83 FB 39 DC 10 9A FC D0 0A F2 A2 82 BC A8 20 2F 2A C8 8B 0A F2 A2 82 BC A8 20 2F 2A' - 'C8 8B 0A F6 85 1B 01 37 12 6E 14 DC 68 B8 31 70 63 E1 C6 C1 8D 87 9B 00 B7 98 C6 B1 BC CA FC 2B' - 'AA 2C B0 B2 CA 82 AB AA 2C B4 BA CA C2 6B AA CC DD 84 6F 73 15 77 51 C5 5D 54 71 17 70 5B E0 B6' - 'C2 6D 83 DB 0E B7 03 6E 78 C6 EA 46 64 6C C0 C8 8C A5 47 65 2C 37 3A 63 03 C7 64 AC EB D8 8C 5D' - '35 2E 63 57 8F CF D8 35 13 32 76 ED C4 8C 0D 9A 94 B1 D8 E4 8C 5D 37 25 63 D7 4F CD D8 0D D3 32' - 'A6 E9 8C 19 19 73 66 66 CC 37 2B 63 FE D9 19 0B CC C9 58 B0 3E 63 A1 B9 19 0B CF CB 90 BF 19 4B' - '36 64 EC C6 C6 8C DD B4 20 63 B5 0B 33 56 D2 94 B1 C1 8B 32 96 5A CC FA 25 AC 5F CA FA 65 AC 5F' - 'CE FA 15 AC 5F C9 FA 55 AC 5F CD FA 35 AC 5F CB FA 75 AC 5F CF FA 0D AC DF C8 FA 07 59 BF 89 B1' - '39 63 37 3F 94 B1 BE 5B 58 B7 15 FF B6 8C 0D D9 9E B1 A1 3B 78 69 9A 9E 25 BE 2C F1 65 89 2F 4B' - '7C 59 E2 CB 12 5F 96 F8 B2 C4 97 25 BE 2C F1 65 89 2F 4B 7C 59 1B B6 30 6B B7 34 65 ED D6 45 59' - '4B 2C CE 5A BF 25 59 BB 72 69 D6 FA 2F CB F2 FB 42 6F 05 7A 2B D1 5B 85 DE 6A F4 D6 A0 B7 16 BD' - '75 E8 AD 47 6F 03 7A 1B D1 7B 10 BD 4D E8 6D 46 EF 21 F4 1E 46 EF 11 F4 B6 A0 B7 15 BD 6D E8 6D' - '47 6F 07 7A 8F A2 F7 18 7A 8F A3 F7 04 7A 4F A2 F7 14 7A 3B D1 7B 1A BD 67 D0 DB 85 DE B3 E8 3D' - '87 DE F3 E8 BD 80 DE 8B E8 7D 03 BD BF 42 EF AF D1 3B C2 0B E1 51 D8 3C 6C 01 F6 18 EC 71 D8 13' - 'B0 1D B0 27 61 4F C1 9E 86 3D C3 DE 67 D9 FB 53 F6 3E C7 DE E7 D9 FB 33 F6 BE C0 DE 9F B3 F7 17' - 'EC FD 25 7B 5F 44 73 65 AD 69 55 AD 39 AB 6B CD B7 A6 D6 FC 6B 6B 2D B0 AE D6 82 EB 6B 2D B4 A1' - 'D6 C2 1B 6B CD 7D B0 D6 92 9B E0 36 C3 3D 04 F7 30 DC 23 70 5B E0 B6 C2 6D 83 DB 0E B7 03 EE 51' - 'B8 C7 E0 1E 87 7B 02 EE 49 B8 A7 E0 76 C2 3D 0D F7 0C DC 2E B8 2F FA 5A 24 C4 0B 4D A6 8E FA 5C' - '47 7D AE A3 3E D7 51 9F EB A8 CF 75 D4 E7 3A EA 73 1D F5 B9 CE DC 41 75 96 BC AE CE B2 D7 D7 59' - 'F5 33 03 4C BB 06 98 F3 EC 00 F3 3D 37 C0 FC 55 39 53 26 67 CE 15 39 F3 F5 C8 99 3F 9B B3 40 75' - 'CE 82 35 39 0B D5 E6 2C DC 33 67 6E AF 9C 25 EF 64 DC 95 B3 EC DD 39 AB BE 27 67 35 F7 E6 AC F6' - 'BE 9C F5 BC 3F 67 BD 1E C8 59 EF 11 39 BB 6D 64 CE 6E 1F 95 B3 3B 46 E7 EC CE 31 39 BB 6B 6C CE' - 'EE 1E 97 B3 7B C6 E7 EC DE 09 39 BB 6F 22 6B 27 E5 EC FE C9 39 7B 60 4A CE 86 4F CD D9 88 69 39' - '1B B9 89 18 36 13 C3 43 C4 F0 30 31 3C 42 0C 5B 88 61 2B 31 6C 23 86 ED C4 B0 83 FD 7F 9C B3 51' - '2F E5 6C F4 4F 72 36 E6 A7 39 1B FB 8F C4 F1 4F 39 1B F7 CF 39 1B FF B3 9C 4D F8 79 CE 26 FE 4B' - 'CE 26 FD 6B CE 26 FF 22 67 53 7E 99 B3 A9 FF 96 B3 69 FF 4E AC 55 BB B9 AB DD DC D5 6E EE 6A 37' - '77 B5 9B BB DA CD 5D ED E6 AE 76 73 57 BB B9 AB DD BC DB C0 1C 86 69 83 69 87 39 02 73 14 26 0F' - '53 80 39 06 73 1C AD BA 66 2B 1A D0 6C 91 5C B3 15 0F 6C B6 E8 55 CD 16 BB BA D9 E2 6F 35 53 97' - '9B A9 CB CD D4 E5 66 EA 72 33 75 B9 99 BA DC 4C 5D 6E A6 2E 37 53 97 9B 79 0D DE C3 CB E5 1E 93' - 'B3 C7 1C DF 1E F3 F9 F7 98 3F B0 C7 02 C1 3D 16 0C ED B1 50 78 8F 85 DD 3D D4 79 B8 B7 E1 5A E0' - '5A E1 F6 C3 BD 03 F7 2E DC 01 B8 F7 E0 DE 87 3B 01 D7 01 77 12 EE 14 DC 69 B8 33 70 67 E1 3E 85' - '3B 07 77 1E 6E F8 5E 6A E8 5E 6A E8 5E 6A E8 5E 6A E8 5E 6A E8 5E 6A E8 5E 6A E8 5E 6A E8 5E 6A' - 'E8 5E F4 F6 A1 B7 0F BD 7D E8 ED 43 6F 1F 7A FB D0 DB 87 DE 3E F4 F6 A1 B7 CF DC C6 F3 D4 A7 F3' - '96 5C 7D DE 9C 97 CE 13 EB 79 0B B6 32 BE 60 2E 71 91 9E 77 91 9E 77 91 9E 77 91 9E 77 91 9E 77' - '91 9E 77 91 9E 77 91 9E 77 91 9E 77 D1 DC 90 A4 B0 E4 B8 92 AF 48 F2 47 A4 40 B1 14 8C 4A A1 18' - 'AE B8 E4 26 A4 64 52 CA 96 48 D5 29 A9 A6 8B 54 7B 99 D4 B3 54 EA 55 26 F5 4E 4B 7D CA A5 92 AE' - 'D2 F4 6E D2 8C 0A 69 66 77 69 F0 E5 D2 AC 4A 69 76 95 34 27 23 D5 5F 21 A5 7A 48 73 B3 D2 BC 6A' - '69 7E 8D 74 73 AD D4 D0 53 6A EC 25 2D E8 2D 2D EC 23 F5 ED 2B 35 F5 93 16 5D 29 2D EE 2F 0D A9' - '93 96 F0 9F C4 D2 9C B4 6C A0 B4 7C 88 54 34 54 8A 0C 23 F6 5B 88 F7 56 E2 B9 8D FD 6E 47 EF 0E' - 'F8 3B 99 BB 8B 98 EF 66 FE 1E E2 BA 17 DF 7D EC 7D 3F FE 07 F0 0D C7 37 02 DF 48 7C A3 F0 8D C6' - '37 86 7D C7 B2 76 1C BE F1 E8 4E 60 4C 64 4C E2 6E 26 33 A6 30 A6 32 A6 B1 7E 3A CC 0C C6 4C C6' - '2C C6 6C C6 1C EE A6 1E CD B9 8C 79 8C F9 8C 06 F4 1B B9 8F 05 EC B1 90 D1 C4 58 C4 58 CC 58 C2' - '9E 4B 89 67 19 7A CB 61 57 70 9E 95 8C 55 D2 C0 D5 52 F1 A3 FC E7 F4 18 E7 3C E8 48 87 1C 39 1F' - '3A F2 7D E4 C8 FF B1 A3 C0 27 8E 82 87 1D 85 DA 1C 85 DB 1D B9 47 1C 25 8F 3A CA E6 1D 55 17 1C' - 'D5 1C 73 54 7B DC 51 CF 13 8E 7A 75 38 EA 7D D2 51 9F 53 8E 4A 4E 3B 9A 7E C6 D1 8C B3 8E 66 7E' - 'EA 68 F0 39 47 B3 CE 3B 9A FD 99 A3 39 17 1C D5 57 F9 A4 8C 4F 81 2B 7C 4A F6 F0 A9 76 A8 4F 7D' - 'EE F6 A9 FE 6D E6 5B 7C 72 5A 99 DF EF 53 F6 1D 9F 4A BE E9 97 7D CB 2F 7D DB 2F E7 3B 7E F9 BE' - 'EB 97 FF 7B 7E 05 76 FB 15 FC BE 5F A1 66 BF C2 7B FC 72 C7 93 5C 13 C2 72 26 86 E5 9B 14 56 72' - '72 58 D9 29 61 95 4C 0D 2B 35 2D AC BE 6B F0 AF C5 BF 0E FF FA B0 FC 1B C2 0A 6C 84 7B 10 EE FB' - 'F8 9A F1 ED C1 B7 17 DF 3E C6 3F E0 FF 01 FE 1F E2 FF 11 3A 17 60 3E 67 EE 0B E6 BE 64 EE 22 73' - 'A5 24 73 99 AB 64 DA 55 B6 DC 25 2F 5D 39 DD 5C F9 7E E1 6A C5 2F 5D 45 5E C6 FF 2B E6 7E CD DC' - '2B AE FC BF 71 15 78 D5 55 F0 35 57 A1 D7 5D 85 DF 70 E5 BE C9 FA DF B2 FE 77 AE AA 7F EF AA E6' - '0F AE 6A FF E8 AA E7 9F 5C F5 6A 41 B3 D5 D5 F4 FD AE 66 BC E3 6A E6 BB AE 06 1F 70 35 EB 3D 57' - 'B3 DF 77 35 E7 CF AE EA FF C3 55 EA 3F 5D CD FD 2F 57 F3 FE DB D5 FC FF 71 75 F3 07 AE 1A 0E BA' - '6A 3C E4 6A C1 87 AE 16 7E E4 AA EF C7 AE 9A 3E 71 B5 E8 B0 AB C5 6D AE 86 B4 BB 5A 72 C4 D5 D2' - 'A3 AE 96 E5 5D 2D 2F B8 1A 7A CC D5 CA E3 AE 56 9D 70 B5 BA C3 D5 9A 93 AE D6 9E 72 B5 EE B4 AB' - 'F5 67 5C 6D 38 EB 6A E3 A7 AE 1E 3C E7 6A D3 79 57 9B 3F 73 F5 D0 05 57 0F 7F EE EA 91 2F 5C 6D' - 'F9 D2 D5 D6 8B AE B6 0D E1 07 3E B4 48 CE B0 22 F9 6E 29 92 FF D6 22 25 6F 2B 52 F6 F6 22 95 DC' - '51 A4 D4 9D 45 8A 6C 80 D9 58 A4 DA BF C5 FE 1D FE BF C7 7F 94 CF F9 22 05 0A 3C 1F E3 F9 38 FC' - '78 0A C5 84 08 DF 6B 84 EF 35 22 FF E4 88 92 53 22 CA 4E 8D A8 64 5A 44 A9 D5 F8 D7 E0 5F 8B 7F' - '1D FE F5 F8 37 E0 DF 88 FF 41 FC 7B F0 EF C5 BF 0F FF 3F E0 FF 01 FE 1F E2 FF 11 FE CF 28 40 17' - '8A 15 F8 BC 58 C9 2F 8A 55 FB 65 31 65 AC 58 A9 BA A8 6C 00 85 29 17 95 33 30 2A DF 55 51 F9 AF' - '8E 2A 70 4D 54 C1 6B A3 0A 0D 8A 2A 7C 5D 54 EE 74 0A D7 8C 98 9C 99 31 F9 66 C5 E4 9F 1D 53 60' - '4E 4C C1 FA 98 42 73 63 0A CF 8B C9 9D 1F 53 B2 21 A6 6C 63 4C D5 0B 62 AA 59 18 53 6D 53 4C 3D' - '17 C5 D4 6B 71 4C BD 97 C4 D4 67 69 4C 25 CB 62 9A BE 3C A6 19 2B 62 9A B9 32 A6 C1 AB 62 9A B5' - '3A A6 D9 6B 62 9A B3 36 A6 FA 75 31 45 D6 C7 54 B4 21 A6 DC C6 98 06 76 A7 60 5E 1E 97 53 19 97' - 'AF 2A 2E 7F 26 CE EF 29 CE EF 29 AE 6C 36 AE EA EA B8 4A 6A E2 8A 8C 80 1B C9 FC 28 E6 47 33 F7' - '2A CF AF B1 EE 75 D6 BD C1 BA 37 F1 FD 16 DF EF F0 8D A4 00 8F 4A C8 19 9D 90 6F 4C 42 FE B1 09' - '05 C6 25 14 1C 9F 50 68 42 42 E1 89 09 B9 93 12 FC B6 12 FC B6 12 AA 9E 9A 50 CD B4 84 6A A7 27' - 'D4 73 46 42 BD 66 26 D4 7B 56 42 7D 66 27 54 32 27 A1 54 7D 42 36 17 CD 79 68 CE 47 B3 01 CD 46' - '34 17 A0 B9 10 CD 26 34 17 A1 79 02 AE 03 EE 24 DC 29 B8 D3 70 67 E0 CE C2 7D 0A 77 0E EE 3C DC' - '35 49 D9 B5 34 88 41 49 39 D7 25 E5 BB 3E 29 FF 0D 49 05 6E 4C 2A 78 53 52 A1 C1 49 85 6F 4E CA' - '7D 0B EE 6D B8 16 B8 56 B8 FD 70 EF C0 BD 0B 77 00 EE 3D B8 F7 E1 0E C2 1C 82 F9 10 E6 23 98 8F' - '61 3E 81 39 0C D3 06 D3 0E 73 24 49 CD 4B 52 F3 92 D4 BC 24 35 2F 49 CD 4B 52 F3 92 D4 BC 24 35' - '2F 49 CD 4B 52 F3 92 4A 9D 28 E1 1C 34 AF 93 25 9C A3 84 73 94 70 8E 12 CE 51 C2 39 4A 38 47 09' - 'E7 28 91 3B BC 8B 6C 04 CD 6D 64 17 39 A3 BA C8 37 BA 8B FC 63 BA 28 30 B6 8B 82 E3 BA 28 34 BE' - '8B C2 13 BA 70 0E B8 B7 E1 5A E0 5A E1 F6 C3 BD 03 F7 2E DC 01 B8 F7 E0 DE 87 1B 5E 8A 1E 4D 72' - '64 29 7A A5 E8 95 A2 57 8A 5E 29 7A A5 E8 95 A2 57 2A F7 65 B8 5F C1 FD 1A EE 15 B8 DF C0 BD 0A' - 'F7 1A DC EB 70 6F C0 BD 09 57 57 46 FE D3 70 73 65 E4 7F 19 F9 5F 46 FE 97 91 FF 65 E4 7F 19 F9' - '5F 46 FE 97 C9 BD BE 4C C9 1B CA 94 FD 20 2D 3B 48 73 3E 94 E6 2E D3 DC 65 9A BB 4C 73 97 69 EE' - '32 CD 5D A6 B9 CB 34 77 99 E6 2E D3 DC 65 9A BB 4C 73 97 69 EE 32 CD 5D A6 B9 CB 34 77 99 56 9F' - 'E1 E5 9C 85 26 3F B2 9C B3 94 73 96 72 CE 52 CE 59 CA 39 4B 39 67 29 E7 2C E5 9C B9 02 8E 17 80' - '91 15 70 15 70 15 70 15 70 15 70 15 70 15 70 15 72 27 C2 4C 82 99 0C 33 05 66 2A CC 34 98 E9 30' - 'BC 40 84 67 C2 CC AA A0 B7 56 28 3B A7 82 DE 5A A1 9A B9 15 F4 D6 0A F5 9C 5F A1 5E 0D 15 EA DD' - '58 A1 3E 0B 2A 54 32 BC 3B 7B F2 C2 31 B2 3B 7B 76 67 CF EE EC D9 9D 3D BB B3 67 77 F6 EC CE 9E' - 'DD E5 7E 13 EE 5B 70 DF 86 FB 0E DC 77 E1 BE 07 B7 1B EE FB 70 CD 70 7B E0 5E AE D4 F6 5F 55 AA' - 'CB AF 2B B5 E3 95 4A 3D FA 9B 4A 5D F6 6A A5 1E 7B AD 52 A5 AF 57 EA F1 37 2A 55 F6 66 A5 A2 BF' - '65 FC AE 52 E9 DF 57 2A F6 87 4A 95 FF B1 52 F1 3F 55 AA EB 5B 95 2A 7A BB 52 91 16 46 6B A5 8A' - 'F7 A3 67 59 D1 A1 E5 73 B2 F2 FB B2 0A F8 B3 0A 06 B2 0A 05 B3 0A 87 B2 72 C3 F8 5C 7C 45 F8 22' - 'F8 8A F1 45 F1 C5 F0 C5 99 4F 30 9F 64 BE 84 F9 14 F3 5D 98 BF 8C 17 A9 52 74 CB 58 9B 86 29 87' - 'E9 0A D3 0D A6 02 A6 3B CC E5 30 95 30 55 30 19 98 2B 60 7A F0 9C E5 B9 9A 51 C3 5C 2D 73 3D 59' - 'D7 8B 75 BD 59 D7 87 75 7D 59 D7 0F EE 4A 98 FE 8C 3A B8 01 70 B9 AC 9E 18 98 D5 93 57 E1 BF 1A' - 'FF 35 F8 AE 65 0C C2 7F 1D FE EB F9 7C 03 E3 46 9E 6F 62 0C 66 DC CC 18 82 FE 50 F4 87 31 6E 61' - 'DC CA 3E B7 31 6E 67 AF 3B 18 77 32 EE 62 DC 8D E6 3D AC BF 97 35 F7 A1 77 3F EB 1E 60 AF E1 CC' - '8F 60 7E 24 F3 A3 18 A3 F1 8D 61 8C 65 7E 1C F3 E3 61 26 F0 79 62 56 B9 49 59 0D 9C 9C D5 A0 29' - '7C 9E CA E7 69 59 C5 A6 67 55 34 23 AB 6B 67 62 67 31 66 67 15 99 83 BF 1E 3F 2F A4 35 F3 B2 BC' - 'B3 A1 DB 80 66 23 7B 2E 20 C6 85 C4 D7 44 4C D3 1B 64 33 78 99 9B D9 20 67 56 83 7C B3 1B E4 9F' - 'D3 A0 40 7D 83 82 73 1B 14 9A D7 A0 F0 FC 06 72 BF 91 3C E4 85 6F 64 23 79 D8 48 1E 36 92 87 8D' - 'C4 D8 48 1E 36 92 87 8D E4 61 23 B5 BA 91 5A DD A8 92 29 8D EA 3B B5 51 4F 4D 6B D4 CE E9 8D 7A' - '7A 46 A3 9E D9 D4 24 DB CC 8B E2 43 4D 72 1E 6E 92 EF 91 26 F9 B7 34 29 B0 B5 49 C1 6D 4D 0A 6D' - '6F 52 78 47 93 DC 47 9B 94 7C AC 49 37 3E DE A4 9B 9E 68 D2 B0 27 9B 74 CB 53 4D BA 75 67 93 12' - '4F 37 A9 DF 33 4D BA 72 57 93 FA 3F 8B D6 73 68 3D 8F D6 07 2D D4 83 16 EA 41 0B F5 A0 85 7A D0' - '42 3D 68 A1 1E B4 50 0F 5A A8 07 2D D4 83 16 EA 41 0B F5 A0 45 37 E6 5B 74 53 A1 45 C3 8E B5 E8' - '96 E3 2D BA F5 44 8B 12 1D 2D EA 77 B2 45 57 9E 6A 51 FF E9 AD F4 D9 56 FA 6C 2B 7D B6 95 3E DB' - '4A 9F 6D A5 CF B6 D2 67 5B E9 B3 AD F4 D9 56 FA 6C 2B 7D B6 95 3E DB 4A 9F 6D A5 CF B6 D2 67 5B' - 'E9 B3 AD F4 D9 56 FA 2C 3A CB D0 59 8E CE 0A 74 56 A2 B3 8A B9 D5 D8 3F 1E 90 FD E9 80 F4 D6 01' - '39 6F 1F 90 AF E5 80 FC AD 07 14 D8 7F 40 C1 77 0E 28 F4 EE 01 85 0F 1C 90 FB 1E DC FB 70 7F 86' - 'FB 0F B8 FF 84 FB 2F B8 FF 86 FB 1F B8 0F E0 0E C2 1D 82 FB 10 EE 23 B8 8F E1 3E 81 3B 0C D7 06' - 'D7 0E 77 04 EE 28 5C 1E AE 00 77 0C EE 38 DC 09 B8 0E B8 93 70 A7 E0 4E C3 9D 81 3B 0B F7 29 DC' - '39 B8 F3 70 9F C1 5D 80 FB 1C EE 0B B8 2F E1 2E C2 0D 39 28 1B 7A 50 1A 76 50 CE 2D 07 E5 BB F5' - 'A0 FC B7 1D 54 E0 F6 83 0A DE 71 50 A1 3B 0F 2A 7C D7 41 7A EE 21 7A D5 21 7A D5 21 7A D5 21 7A' - 'D5 21 7A D5 21 7A D5 21 7A D5 21 7A D5 21 7A D5 21 B9 AF B7 49 6F B4 C9 79 B3 4D BE DF B6 C9 FF' - 'BB 36 05 7E DF A6 E0 1F DA 14 FA 63 9B C2 7F 6A 23 1F DB C9 C7 76 F2 B1 9D 7C 6C 27 1F DB C9 C7' - '76 F2 B1 9D 7C 6C 27 1F DB C9 C7 76 B9 4B F2 FC 73 95 97 B3 2C 2F DF F2 BC FC 2B F2 0A AC CC 2B' - 'B8 2A AF D0 EA BC C2 6B F2 72 D7 E6 95 5C 97 57 76 7D 5E D5 1B F2 AA D9 98 57 ED 83 79 F5 DC 94' - '57 AF CD 79 F5 7E 28 AF 3E 0F E7 55 F2 48 5E D3 B7 E4 35 63 6B 5E 33 B7 E5 35 78 7B 5E B3 76 E4' - '35 FB D1 BC E6 3C 96 57 FD E3 79 A5 9E C8 6B EE 93 79 CD 7B 2A AF F9 3B F3 BA F9 E9 BC 1A 9E C9' - 'AB 71 57 5E 0B 9E CD 6B E1 73 79 F5 7D 3E AF A6 17 F2 5A F4 62 5E 8B BF 91 D7 90 BF CA 6B C9 5F' - 'E7 B5 F4 6F F2 5A F6 B7 79 2D FF BB BC 86 FE 7D 5E 2B BF 89 FD 56 5E BB BE 9D D7 B3 DF E1 1C DF' - 'E5 1C DF E3 1C BB 39 C7 F7 39 47 33 E7 D8 C3 39 F6 72 8E 7D 9C E3 07 79 15 FD 30 AF C8 8F F2 2A' - 'FE 31 FC 4B F0 3F 61 BF 9F A2 A3 02 FF E0 15 E4 F8 0A F2 F9 0B F2 07 0A 0A 04 0B 0A 86 0A 0A 85' - '0B 0A BB 05 B9 45 05 25 23 05 65 8B 0B AA 8E 16 54 13 2B A8 36 5E 50 CF 44 41 BD 92 05 F5 2E 29' - 'A8 4F AA A0 92 2E 05 4D BF AC A0 19 A5 05 CD 2C 2B 68 70 BA A0 59 E5 05 CD EE 5A D0 9C 6E 05 D5' - '57 14 94 EA 5E D0 DC CB 0B 9A 57 59 D0 FC AA 82 6E CE 14 D4 70 45 41 8D 3D 0A 5A 90 2D 68 61 75' - '41 7D 6B 0A 6A AA 2D 68 51 CF 82 16 F7 2A 68 48 EF 82 96 F4 29 68 69 DF 82 96 F5 2B 68 79 7F E2' - 'AD 23 DE 01 C4 9B 23 DE 81 C4 7B 15 F1 5E 4D BC D7 10 EF B5 C4 3B 88 18 AE 63 FF EB D9 EF 06 34' - '6F 2C 28 72 53 41 D7 5A 87 4C 0C A7 83 7F FE 3B E4 F8 3B E4 0B 74 C8 1F EC 50 20 D4 A1 60 B8 43' - '21 B7 43 E1 A2 0E B9 11 B8 62 C6 89 0B E4 E7 05 F2 F3 02 F9 79 81 FC BC 40 7E 5E 20 3F 2F 90 9F' - '17 C8 CF 0B E4 E7 05 B9 3B CF 39 EE FF 06 F5 F2 31 02' -} - - -LANGUAGE 0,0 COMPOSITION UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE -{ - '78 DA 5D 5D 05 98 94 D5 FB 7D 67 86 5D 1A 76 48 01 E9 94 5C 76 69 10 E9 EE 25 A5 BB BB 43 09 01' - '41 41 01 91 16 44 51 41 90 46 4A B1 41 C5 C4 DD 41 05 EC 04 0B DB 1F E1 FF 9C 7B CF EC E7 F3 7F' - '9E 79 38 E7 BC 71 E3 BD F7 BB DF 37 33 BB 4B B6 7C 66 87 CD C2 49 A5 CC 42 11 5B 1C C9 A4 17 C3' - '9E 46 22 F6 E5 BF 16 CE 09 9A 25 62 FB 14 0B DA F6 A6 A7 09 11 6B 5C 2A 93 B6 0B AC ED 03 DA 21' - 'A0 1F AA DD C4 88 7D 24 9A 35 62 3F 96 B4 88 81 66 8B A0 47 5B 12 C9 54 18 C9 4B 81 AF 59 C4 76' - '6A 04 50 1F 2B 3F 47 C4 2E 89 E6 8C D8 DB 0A CF EF 9A 7A 27 50 68 EA DD 40 A1 A9 17 4A FA 24 A8' - 'E7 03 7A 49 31 05 5C FE 27 81 42 FE A7 81 42 FE 4D 25 41 1D D3 A8 2A 46 EC 82 86 52 29 62 85 55' - '97 D4 88 BD A8 58 A4 CD 51 91 5B 46 6C 12 EA 92 08 DA 3E D1 06 5C B7 08 69 87 44 EB 9A 68 53 E4' - '80 1A 28 47 47 E7 98 26 07 D4 20 39 3A 39 C7 0C 39 A0 06 CB D1 D9 39 66 C9 01 35 44 8E 2E CE 31' - '47 0E A8 A1 72 C0 3A 29 D1 E6 C9 01 75 B7 68 B7 44 DB 9C EC 87 BD 31 D9 B6 88 6E 4A B6 1C A5 2C' - '44 9A 5D 58 03 18 06 0E 94 7E D4 BC 0E 4B 47 84 59 84 89 C2 04 61 36 61 56 B5 63 C9 16 E2 DE 6B' - 'C4 52 96 36 C3 AB AD E8 1D 66 BD 6E 5A 28 37 68 41 60 0E 60 E8 5F 44 03 C3 C4 32 18 05 FD 65 D1' - '2B 35 30 0B B1 9C D9 68 DA 81 63 88 E5 D1 3B ED C0 44 62 05 B3 41 B4 03 B3 52 57 34 9B 56 CE 22' - '49 95 CC 6A 9A DD 66 76 57 39 CB 22 95 EC 0C 77 07 06 1F 31 3F 30 A4 38 C3 82 C0 90 EA 0C 0B 03' - '43 2D 67 58 14 18 6A 3B C3 3D 81 A1 8E 33 2C 0E 0C 75 9D 61 49 60 A8 E7 0C 4B 03 43 7D 67 98 AE' - '71 FB 41 DC 2B 77 4A 7C DC 33 E4 F6 43 9A 29 E5 C7 33 4B CA 0F 66 B6 94 1F C9 1C 29 3F 8C B9 52' - '7E 0C F3 A4 FC 00 92 AE 86 9C 6A EA 54 54 AA 99 53 F9 A4 9A 3B 95 5F AA 85 53 05 A4 5A 3A 55 50' - 'AA 95 53 85 A4 5A 3B 55 58 AA 8D 53 B7 48 B5 75 AA 88 54 3B A7 8A 4A B5 77 AA 98 54 07 A7 6E 95' - 'EA E8 54 71 A9 4E 4E 95 90 EA EC 54 49 A9 2E 4E 95 92 EA EA 54 69 A9 6E 4E 95 91 4A 73 AA AC 54' - '77 A7 CA 49 F5 70 AA BC 54 4F A7 2A 48 F5 72 AA A2 54 6F A7 2A 49 F5 71 EA 36 A9 3B 9D DA A2 CA' - '0F 76 EA 11 A9 21 4E 6D 95 1A EA D4 36 A9 61 4E 3D 2A 35 DC A9 ED 52 23 9C 7A 4C 6A A4 53 8F 4B' - '8D 72 6A 87 D4 68 A7 9E 90 1A E3 D4 93 52 63 9D 7A 4A 6A 9C 53 3B A5 C6 3B B5 4B 6A 82 53 4F 4B' - '4D 74 6A B7 D4 24 A7 F6 48 4D 76 EA 19 A9 29 4E ED 95 9A EA D4 3E A9 69 4E ED 97 9A EE D4 01 A9' - '19 4E 1D 94 9A E9 D4 21 A9 59 4E 1D 96 9A ED D4 11 A9 39 4E E1 1A 72 CA A2 54 79 52 FC 85 05 35' - 'D8 19 42 72 87 9D CA 2B 77 38 EE 0E CB 1D 71 2A 49 EE 48 DC 1D 91 3B C1 A9 A8 DC 09 71 77 16 B9' - '13 9D CA 27 77 62 DC 9D 20 77 56 A7 F2 CB 9D 35 EE 4E 94 3B BB 53 05 E4 CE 1E 77 67 95 3B A7 53' - '05 E5 CE 19 77 17 4F B1 AC 32 8C 8E 5A AE A8 0D 8F DA 6E E7 29 91 62 89 81 27 5F D4 26 38 73 36' - 'B5 97 CB A9 42 6A 2F 57 BC BD 5B 03 83 8F CF AE F8 3C 4E 15 96 3B 4F 3C 3E 87 DC 79 9D BA 45 EE' - 'BC 71 77 4E B9 93 9C 2A 22 77 52 DC 9D 4B EE A8 53 45 E5 8E C6 DD B9 E5 CE E7 54 31 B9 F3 C5 DD' - 'A5 E2 6B DE C9 5D A5 F1 35 74 AA 4C BC AA 4E 55 92 EA EF 54 69 A9 15 4E 95 93 5A EB 54 7D A9 2F' - '9D BA 5D 2A D4 99 AA 69 7C B4 4E 55 94 1A DB D5 9D 18 52 E3 9D AA 27 75 B8 9B 3B 15 A4 9A A6 51' - 'DD 21 D5 DD A9 5A 52 B9 BB 53 35 90 9A E7 54 59 A9 0B 3D A9 6A 48 95 EC 45 D5 50 6A 44 5F AA 64' - 'A9 AF 87 53 55 96 CA 36 92 2A 25 5E 09 A7 AA 49 55 72 AA A6 54 E5 51 54 55 A5 6A 8D A3 AA 12 9F' - 'DF 24 AA DA 52 B3 A7 50 35 8A 57 69 06 55 AA 54 E3 D9 54 75 E3 B5 76 AA 49 BC 2E 4E 35 93 BA BC' - '90 AA B9 D4 6F 4E D5 91 DA BE 82 AA B1 D4 19 A7 AA 4B BD BF DA DD EE F1 28 92 8D F3 E3 C3 00 EF' - '88 7C D8 E0 19 CC 87 04 E0 4A F8 B3 F3 14 A6 E6 16 66 1C F0 01 DA F9 74 C0 7C F6 C8 3C EE 61 FA' - '2B E3 9C 66 3C 70 0E FD 55 CC EE 63 3C F0 B6 6B 16 0A 01 87 D0 0F CC C9 78 60 17 EA AA D8 C5 D4' - 'C0 24 B6 07 CC 4D 5D 0D 67 3B FD C0 22 37 2D 92 A3 3A 66 E1 5E 15 4A 61 2E 99 2A 19 CF 73 F2 95' - 'E7 63 94 A7 DD 98 09 2C C7 87 2F 60 1E B6 08 CC 4B AC 81 FD 78 35 14 4E C2 23 03 3A 33 51 78 97' - '97 B6 48 5E D0 16 A5 F8 00 D1 3B D5 9C E3 F8 24 FB F0 7C 28 14 02 FD 42 F8 8E 30 89 CD 01 7F B9' - 'E6 F5 E5 72 16 CA 0A FC 41 FE 05 2C 00 70 12 0B 02 FC 53 F6 30 FB AC E9 BA 5F 56 CE 1C 45 F7 AB' - '79 20 FB 47 30 A8 EF 53 33 15 76 E5 1B 29 99 0A BB 72 48 E0 C3 E8 46 A3 89 AC 5E AD 51 13 BE C1' - 'CB A9 99 0A 4D BC 99 92 A9 D0 C4 D0 C0 87 26 C6 A8 09 BC 1E 52 13 29 AE 89 2B A9 99 0A 4D 9C 4D' - 'C9 54 68 62 58 E0 43 13 63 D5 04 D4 5A 35 91 EA 9A F8 21 35 53 A1 89 E1 81 42 D2 38 25 41 3D AC' - 'A4 5A 2E E9 C7 D4 4C 85 A4 11 81 42 D2 78 25 41 AD 53 52 6D 97 F4 53 6A A6 42 D2 C8 40 21 69 82' - '92 A0 D6 2B A9 8E 4B FA 39 35 53 21 69 54 A0 90 34 51 49 50 1B 94 54 D7 25 FD 92 9A A9 90 34 3A' - '50 48 9A A4 24 A8 8D 4A AA E7 92 AE A6 66 2A 24 8D 09 14 92 26 2B 09 6A 93 92 EA BB A4 5F 53 33' - '15 92 C6 06 0A 49 53 94 04 D5 AD B4 65 C9 5B D3 6D 5D BF 13 9E C7 41 2E 03 56 24 AD 74 A6 42 A9' - '9F 0B 7C A8 61 8F C0 87 E2 F4 09 14 66 DD 25 50 98 4E DF 40 61 9C 5D 03 85 01 0C 2C 6D 61 A9 CF' - '52 FD 96 C6 78 5F 4C F1 14 BB A5 8F AC 18 F7 42 5E 16 A0 1F F1 72 00 7E 29 FC 4B 38 88 97 11 F0' - 'EA 35 AF A3 BC CC 80 3F CA FF AE F0 38 2E E4 6C C0 08 2F A7 14 77 39 2D E7 E5 E4 B7 EE 66 D6 31' - '25 7E 39 FD 96 9A A9 30 AE 71 81 C2 78 A6 B2 8E 5E FD 2E 87 1F FE F8 40 21 AC 6B 8A 0F 83 FA 43' - '0E 7F 59 4C 08 14 C2 BA 29 0C AF 3F E5 F0 5B 7F 62 A0 10 96 A6 30 A8 BF E4 F0 9B 7D 52 A0 10 D6' - '5D 61 50 7F CB E1 B7 77 0F 39 A0 FE 91 C3 6F E1 9E 72 40 FD 4F 0E BF 4D 7B C9 01 75 4D 0E BF 15' - '7B CB 01 75 5D 0E BF DD FA C8 01 D5 9D AB 9D 12 DF 41 3D 03 85 FE 3F 4F F5 45 47 C6 4B 29 9E 62' - 'C1 EF 94 15 93 58 C4 05 07 1D CC 85 05 1E E4 C2 01 F3 71 61 81 BF 72 A1 81 5F 9D F7 F8 93 F0 3D' - 'E1 C7 C2 BF 85 59 B8 E0 A9 6E C1 EF E3 82 FB 83 E6 06 C7 9E 1A 5F E2 3B 39 76 AF 6E CA E1 17 B5' - 'AF 1C 50 FD 44 D1 64 7F 51 BC 06 88 A2 E4 03 45 31 C9 03 A2 28 EB 41 51 14 F2 90 28 4A 77 58 14' - 'C5 3A C5 0B 2C 35 7E 81 F5 2A 9D A9 D0 4E BF 40 21 E9 8B 54 3F 7C 8C EB E5 14 4F 51 BA BE B2 A2' - '74 BF B1 34 A0 F9 59 2A E0 FB E7 BD 3E C4 12 02 FF 91 FE 59 78 41 F8 B5 F0 1E 96 1E 38 84 A5 07' - '26 B0 74 B5 5C E9 EE 67 E9 FC 71 7B 84 63 AF E5 8A F5 AC 28 CA 73 54 14 E5 39 26 CA 41 89 E2 75' - '42 14 D3 3A 29 8A F2 3C 27 8A F2 3C 2F 8A 99 9E 12 45 79 7A B3 04 B5 E2 05 F9 32 D5 0F 03 25 78' - '25 C5 53 94 A0 9F AC 28 C1 FF 38 15 D0 8B C2 A1 9C 0A F0 1B E9 5F 84 BF 5F F3 B8 98 53 06 9E 93' - 'BD 00 4B 07 9C C6 BB 30 30 91 25 A8 ED 4A B0 82 25 F0 37 8F 17 38 BE DA AE 04 77 72 7C B5 E3 67' - '60 FF 40 61 1A 5F A5 FA 0C 8C F6 D5 14 4F 31 DA FE B2 62 B4 DF B2 57 D0 0F 84 4B 38 1A E0 35 E9' - '4B C2 AB C2 3F AE 79 9C CE D1 01 87 71 76 C0 82 1C 35 30 2B 47 5B C7 8D 76 25 47 EB EF 5A 5F A7' - '7A 8A 61 BC 96 E2 29 86 31 40 56 0C E3 4F 36 0B 5A 88 CD 00 87 B3 59 E0 52 0E 07 98 7E DE FB 3F' - '11 CE 60 F7 C0 EF A4 7F 15 5E 17 66 E3 30 EA BA 61 3C C0 61 F8 FB E0 00 D6 A6 6E BC 36 DF A4 7A' - '07 06 75 3A C5 53 0C 6A A0 AC 18 54 61 0E 06 F4 2F 0E 0E 98 71 DE E3 6F C2 EF 85 33 39 18 E0 A7' - 'D2 23 38 78 E0 0D E9 7B 39 09 60 76 0E AA 9E 1B D4 83 1C 94 BF CF 7E 9B EA 29 86 71 26 C5 53 0C' - '63 90 AC 18 C6 EF 6C 06 74 19 9B 01 DE C2 61 01 FF BE E6 ED 97 E5 FF 4C 38 92 DD 03 67 71 58 C0' - '9B B2 C7 84 39 38 8C FA 6E 18 AB 38 0C 7F E7 FE 2E D5 53 0C E3 F5 14 4F 31 8C C1 B2 62 18 45 D8' - '2D E8 BF 6C 06 38 9B CD 03 AF 48 8F 62 B7 C0 F3 D2 FF 5C F3 F8 87 F4 E7 C2 E5 9C 06 70 5A 65 1C' - '73 0D F0 26 08 EF BB 70 5B E7 23 30 68 7E 3E 54 03 8B B2 37 60 01 EA 86 38 D0 E9 07 16 A3 1D 38' - 'A1 8C 85 AD 11 2E D5 88 DD 4A 13 E8 30 86 00 67 B0 E1 DB 5D AB 78 4D AF 8C 19 78 3A 88 39 B7 BB' - '9C 79 1C 3C E8 0A 0E 06 58 9C 6D 00 47 B0 0D E0 44 86 36 76 A1 C3 69 02 2D C1 10 60 1B 3E B7 DF' - 'E1 3E 09 6D 2D 8A 57 49 7A 81 3D 19 0D 2C C4 71 03 C7 52 37 C1 9B 57 FA 81 53 51 D0 3C 4D DD 07' - '4F 2F E2 C9 9A 1F CC 59 C4 5E 12 0D 45 EC C9 12 D0 A0 61 F7 F1 F7 8E 40 C1 F7 74 A0 22 11 DB 19' - 'A8 EC 11 7B 59 4D 40 BD 22 8A 18 0B 79 9A 25 62 FB 15 9E E8 1A DE 1B 28 34 7C 38 50 48 3A 18 28' - '34 1C 56 13 50 9F 85 BC 23 6B 84 0D 56 08 7B 07 D4 27 72 64 73 8E 57 D5 3F D4 63 25 3C 45 3B FF' - '53 4C 0E D7 E3 6B 8A 81 7A 5B 1D E4 8A D0 E6 68 5E 74 2B 1A 8D D8 1E 8D A7 6C 84 B3 7B 36 50 18' - 'D2 A3 EA 00 CA 44 CB 63 10 6A B2 52 C4 3E C5 DD 94 05 2F 58 86 1F 78 95 E6 32 40 D5 CB C0 66 04' - '36 8A 79 7C 54 BA 6A 71 EC 0B D6 4B 7A 9C 30 F9 6A 28 C4 56 46 A5 7B FD 2C 37 3B 70 8B 74 BA E2' - 'DE 93 9E A4 76 B3 09 4D F6 5A C2 57 B8 0D 9A B9 CF D2 C2 1C 76 33 5F 54 51 4E 4D B4 66 C4 6E 67' - '1B A4 1C 03 30 21 C3 EB FA C2 50 BA C7 F7 85 B5 85 93 95 97 5D 78 94 63 06 66 28 AF 6A 69 73 B8' - '5D BA 3A E7 0E 1C 2F 3D 5A ED 94 61 CD 80 D5 70 6E 64 6D EE 3E 21 3E C3 A2 36 77 1F 13 E2 E8 48' - '64 B5 9B BB DD 9B 4D 14 EB 94 43 14 F3 CA 25 8A 15 CE C6 D5 6B EE BE A8 41 F8 19 F3 0E A8 D3 A9' - '96 85 4D 62 9D C6 BA CF 3B 27 70 18 30 34 8E 79 DC 9A EE 31 85 65 00 56 01 72 38 61 4E 03 F8 98' - 'E2 C7 28 6E 3C EC 49 F4 4B 1F E3 F4 81 39 D4 DE 39 D9 CB 72 7A C0 3A D2 D5 D4 DE 14 C5 C5 D4 EE' - '2A 4C 3F 4F 0B F7 61 F6 AB D8 CA 49 2D DC E7 BE 98 D2 55 CC 4E EA 35 39 E6 38 C7 AF 72 40 E5 E0' - '72 B6 70 C5 C8 13 F2 14 01 B9 64 C5 7A 27 89 A2 12 F9 44 AB 21 56 14 BB E0 71 0E 03 74 6C BA C7' - 'E3 9C 0E B0 1C 87 0F 6C C9 61 03 3F 90 3F AB E2 73 C6 3C 36 94 8E C8 3F 51 FA 0E F9 53 59 56 60' - '32 77 01 70 AA EC 13 58 46 60 5D E5 6D 13 9E 57 FE EB 5C C2 96 EE 14 7B 43 14 0B FB 22 97 B9 65' - 'FC 14 3B 15 28 F8 5E 0D 14 0E 9B 97 03 85 43 E2 4D 35 01 F5 5C 09 4F 11 53 40 31 59 5C 6B 85 02' - '85 D6 F2 85 7C 18 54 01 51 1C 0B 85 44 51 EF B3 6A 12 A7 D1 09 35 89 8E 8A 2A 00 AB 90 25 EC 29' - '0E 9D 44 51 1C 3A A7 D5 8B 3F 74 8E 29 13 EA 56 39 2A BA F3 A7 92 32 A0 6E 51 93 38 74 6E 51 38' - '96 B0 A8 68 72 C4 6A B2 B4 1C 09 4B 07 FC 50 98 2B E6 31 3D DD 63 16 61 23 F9 6B 71 69 80 D3 14' - '57 4F FE 71 C2 1D 8A 3B C1 2D C1 AE B8 15 80 93 64 6F A2 BC F2 DC 2A C0 86 78 0C 4A 6A E5 BE 14' - 'EA 8D 53 93 03 6C E5 4A 75 3B 13 40 2B 30 10 58 3F DD EB C9 B2 27 48 E7 8E 79 7C 42 F6 93 EC 18' - '98 21 7F 53 F9 C7 4B D7 E4 80 80 B5 39 11 E0 47 CA 9B AE B8 EC D2 F7 F2 54 6C ED BE 9F 7A 88 27' - '4C 6B F7 B5 12 2E 9F 3D 52 5D DC B7 2B 6F 28 6C 36 1E A2 59 F3 D6 6E CB DD 2A 8A D5 2A 55 C2 53' - 'EC 89 12 B2 62 A9 4A 89 62 A2 DF 88 62 F5 CB 88 62 01 A7 70 18 A0 33 62 1E 9F E3 B4 80 1F CB DE' - '20 DD E3 63 C2 09 C2 27 E5 AF C8 B2 71 F8 CA AF C3 E9 02 F3 48 C7 14 DF 58 F1 39 84 89 B2 A7 72' - '7F 00 CF 72 7E 6D DC 6C DB F1 D0 69 E3 BE 99 7A 2B C5 5B 71 34 AE 52 00 2A 53 8E C3 6F E3 66 5D' - 'A6 84 A7 98 5F 05 51 EC F9 12 61 4F 31 D5 72 B2 62 13 57 12 C5 AC 2B 8B 56 8F D8 05 0E 08 B4 61' - 'BA C7 5C 5C 37 60 4E 61 25 4E 10 98 5B FA 79 16 08 98 37 E6 E3 27 2A 6F AA DA C9 2A 5D 97 85 00' - '9E 97 6E AE F8 A7 14 57 8B 13 07 CE 94 7D 08 37 68 5B F7 2D 22 5E 83 4B E3 18 F5 34 25 E4 29 CE' - 'E0 39 AC 41 5B F7 20 35 54 01 28 D2 28 51 EC EB B7 78 DD B7 75 07 D3 DB A2 D8 25 EF 88 A2 5E 95' - '42 9E E2 80 A9 2C 8A 0D 53 55 14 1B 26 59 14 05 AD CE 8B BE 6D FC 27 22 DE 55 23 50 AF 97 F0 14' - '47 CA BB 0A E7 5D 2E EC 29 8E 94 1C A2 38 52 DE 54 2C EA 5F 5D B1 38 2B AA CA 8A 03 62 10 CF 5A' - 'D0 0F 59 27 7E 85 CA 7A 03 6B B3 3E C0 59 31 6F CF 26 FF B4 0C 8F A7 B8 0E C0 8B D2 49 5C 1F F6' - '29 6C 22 FB 24 E5 35 12 B6 50 7B 49 C2 9D 8A AB C7 F5 02 D6 E2 28 DB B9 62 4D 66 0A E8 EC 98 C7' - '17 D8 25 70 7A 86 D7 F5 99 02 6C 29 7F 53 D9 73 0B 3F 52 7E 1D 4E 05 78 49 F6 A8 E2 B3 CB 5F 99' - '53 06 EE 92 FF 09 D9 6F 17 2E E1 B2 B7 77 47 C4 DB A2 78 BD 23 DA 11 65 64 39 DB BB B5 FE 2E E4' - '29 16 24 45 56 94 BE 8E AC D8 FA B5 64 C5 ED 35 07 DB 07 7D 52 F8 22 E7 07 CC 17 F3 7A 46 86 C7' - '3C C2 66 C2 C6 8A 6F A5 B8 06 AC 03 B0 2E E7 09 7C 5A 71 1F 2B EE 13 E9 39 8A 9F 22 7B 15 CE 1B' - '78 86 3B BC 83 DB E1 EF A6 E0 D0 EB E0 BE B1 E6 7D 56 8E 31 B8 65 8B 1E 45 D9 39 99 0E 6E B6 B7' - '8B 62 B6 F5 B8 5B 3B B8 D9 62 47 D7 29 E1 1D 50 0D 15 83 B9 37 92 15 B7 A8 06 A2 28 C3 38 EE 40' - 'D0 BC 1C 26 F0 42 BA C7 99 D2 77 48 EF 96 6E C8 E9 02 A7 CA 9E 8F 3B 0E F8 12 CB 07 6C 1D F3 F6' - 'E6 8A AF CA 69 02 73 2A BE 1E CB 04 CC AF B8 B9 C2 4F 15 BF 94 0B DB D1 2D F7 18 1C 85 D9 3A BA' - '1F 57 18 2B 8A B2 AC E1 9D A1 63 FC 3E B1 5B CA DF 27 C6 29 AC 1B F6 08 CF D1 8E EE 88 38 AE 26' - '41 5F 10 ED 85 75 64 0D 3A BA 42 36 11 C5 65 DF 4C 14 A5 7B 49 B1 BB 22 D6 82 83 03 7D 99 93 04' - '4E 4B F7 3A 97 70 22 8B 08 4C 65 31 80 4D 64 DF A3 BC CF 84 49 C2 79 31 8F 8D 58 4C 60 35 16 09' - '78 51 79 6D E4 AF CF 62 01 67 29 AF 80 EC 6F 72 3F 74 72 7B E6 AC 28 76 49 A1 D2 9E E2 19 FD 6F' - '2E 7B 27 77 14 36 17 C5 3C DF 37 4F 71 FE B5 28 E1 29 A6 DC 5A 01 D8 46 AD 64 C5 EC 5B CA 8A 8D' - 'D3 4E 56 6C 9C 36 A2 D8 38 D5 39 66 D0 57 58 13 60 53 8E 1D 38 3B C3 E3 2E E9 BB 62 1E 0B 0A 9F' - '91 FF 92 FC B9 85 D3 85 6D 15 F7 B9 E2 1A B0 06 C0 DB 59 2B 60 54 F6 82 AC 35 F0 1C 27 D5 D9 4D' - 'F5 03 51 4C F5 1C 2F 88 CE F1 C7 D1 F7 02 05 5F 2C 50 A8 44 7A A0 70 A4 A7 AB 09 A8 0E 72 44 5C' - '52 D5 70 A6 C2 15 D6 29 F0 E1 96 90 A1 24 A8 2E 72 F8 07 D7 6E 81 42 13 1D 42 3E 8C F9 A2 BC E7' - 'A8 61 FF 16 BB 7A D8 3B A0 2A CB E1 DF 62 C7 D4 07 D4 3B 25 3C C5 70 BB A8 9D 9C 58 5C 51 BE CB' - '50 23 B8 19 E5 11 C5 CD E8 A2 06 53 CC 0D ED E3 40 61 68 9F 05 0A 93 F8 24 50 E8 E3 8B 40 61 5F' - '3C AA 6E A0 3E 94 C3 3F 30 BF A5 51 41 FD 10 F2 8E 4A 6E E4 97 95 01 D5 8C 6B 0C 5A 28 E6 B1 06' - 'F7 10 B0 9D 74 AB 0C 8F 73 84 F9 84 8D B8 07 80 AF 72 AF 01 67 A8 9D 2F E4 CF 23 FD B4 B0 31 F7' - '0A F0 6E B5 FB 89 EC 7B 15 7F 9E 97 76 17 77 86 7C C4 03 A4 8B 3B 40 70 61 75 BA 1A 8A 2B 9C 16' - '1F 2B 0C C7 49 97 14 1F D6 DD FD 84 D4 2E 39 70 E4 74 E7 B4 BB B8 3D D7 53 14 6B 97 CC 89 81 BE' - 'C6 01 03 E7 B2 63 E0 FC 98 C7 3B 38 40 E0 A7 E9 5E EF 93 7F B7 74 63 4E 18 98 5F F6 F6 CA 9B 29' - '7F 73 61 11 5E 04 C0 2F 15 57 58 71 79 E5 2F 4A 7F 57 1C 20 D4 C0 05 31 8F B7 08 3B 08 3F 93 7F' - '5E 86 C7 24 E9 D3 1C 3F B0 80 EC 5F 09 5B C8 DF 84 F3 00 EE 97 BD 26 E7 0D DC 23 FF 4E 7E 5E D6' - 'CD FD 94 50 77 6E 83 6E AE 50 BD 4B 78 8A 42 F5 96 15 BB 36 29 EC 29 76 6D 3E 51 EC DA 7E DC 64' - 'DD E2 77 B6 3B 95 09 D5 53 99 38 A0 06 C8 8A 53 A9 23 27 04 9A C2 81 00 5B A6 7B 5D 95 9F 1D 00' - '9B 72 C0 C0 03 19 DE 7E 97 B0 18 0B 05 2C A2 FC E2 D2 B7 0A CF B0 10 C0 3B B8 30 1C 99 DA FD 5A' - 'F9 0B 95 37 5B F6 CF 85 1D 78 1B 4A 73 37 AE 52 38 9E B3 A5 B9 6D D6 51 56 BC 2E 72 2B A5 B9 9F' - '8E 1A C6 A9 A6 B9 0A A1 32 77 72 7E 5E F5 13 C5 55 36 A8 84 A7 08 18 A1 F0 5C 2E 7C 90 62 A0 46' - 'C9 51 D6 39 86 28 03 EA 96 B0 A7 15 50 32 85 A3 7A 45 39 74 D0 76 19 1E E7 A4 7B DC 2B FC 46 F6' - 'D7 59 02 E0 DD D2 8B 94 77 50 BA 19 4B 0B 6C A5 BC 2F 84 85 E4 CF 27 DD 49 79 A9 5C 22 60 69 3E' - 'FB FB EB 0A F7 FF B5 BC 1E BB C7 6F EF 65 58 B3 EE AE 66 63 38 8F EE 6E E6 C3 42 9E 62 AE E3 64' - 'C5 EC 8A 86 3D C5 EC 86 28 00 B3 9B A4 00 DC BC 26 88 62 9B BC C1 B9 80 7E C9 31 01 8B C5 3C 16' - 'CE F0 D8 5E 78 8F EC F9 15 D7 59 BA 39 E7 0A 9C 2B FB 7C C5 7F 2B DC 27 7B 6B 61 13 6E 1B E0 21' - 'F9 6B 71 EE C0 8F 78 AA F7 70 37 AF 8F 45 B1 DE 17 44 B1 DE B3 B8 96 3D E2 37 A1 51 21 EF 80 9A' - '23 47 16 77 07 1A 23 07 D4 38 51 DC 5A 2E 84 7C 8C FF 19 EF F3 81 42 53 19 81 42 D2 47 81 42 51' - '2F AA 7F A8 6F 4A 78 8A FB C0 04 35 9C 03 45 15 C5 6D E7 03 51 A4 15 08 7B 8A 0B B8 90 28 2E E0' - 'CB 1A A8 BF ED 7C 17 28 0C E2 A7 40 61 4A 3F 04 0A DD FD 12 28 2C EE 3E 75 03 F5 95 86 04 EB 14' - 'D1 72 A0 0A C0 5D 66 86 AC 58 F2 69 A2 78 AB F5 1D 4B 0F FA 26 97 1E 58 20 DD EB 0E B2 B7 E0 92' - '02 BB C4 BC 6E CA 25 03 B6 51 DC 02 C5 1D 16 D6 E6 12 02 F7 CB 3F 4F 78 AB F2 17 0B 6F 51 FC 57' - 'F2 8F 2C 6D 59 92 7A C6 DF EA E2 35 82 FB 3F D3 30 9C 0F 71 5E CD E3 E0 7B BA D5 BE 5B 14 73 FE' - '84 17 48 CF F8 C7 DB 67 39 1B A8 03 6C 1D D8 92 B3 00 7E 2D BD 24 E6 71 61 86 C7 AE D2 C3 F8 C4' - '0A AC C3 59 00 8B CB 7E 57 55 CC 9A A8 FC B6 C2 23 CA 2F 22 2C 28 7B 47 E9 EF 85 9D 79 B2 F5 72' - 'CF EC D5 F9 E9 71 2F F7 29 E9 25 1E 72 BD DC 8F C6 2E E0 4C 7A B9 1D BF 48 14 1B 61 5A C8 53 EC' - 'F8 A5 B2 E2 3A 5F 2C 8A 7D B8 4C 14 05 68 C6 85 01 BD 9B 43 00 BE C5 12 00 9F CD F0 BA 9D EC 07' - '85 AD 58 12 E0 37 D2 25 62 1E 97 0A 17 29 EF B2 B0 9B EC 45 A5 3B 09 EB B2 54 C0 42 6A 67 2C D7' - 'AD 77 7C DD C6 70 DD BC BA 8F 63 ED ED 66 B0 42 14 33 68 CD 61 80 76 66 73 C0 92 31 8F F3 D3 3D' - '1E 12 D6 63 37 C0 A3 8A BB 47 F8 AD FC 6F 73 BA C0 34 E5 DF 2B 1C CD 15 05 B6 57 5C 31 E5 5D 11' - '16 96 FD 57 0E A9 8F 5B 80 4B E6 29 16 60 46 C8 53 2C C0 DF 0A C0 B6 4B 09 7B 8A 13 E2 01 59 31' - 'A9 59 8A C5 A4 FE 94 15 D7 EB EF A2 58 A1 05 EC 0A B4 54 CC E3 3B 1C 32 F0 B0 EC 1D 84 CB E4 BF' - '45 BA 4B 86 C7 FA 2C 01 F0 56 E9 63 C2 EE 8A FF 41 7A B1 B0 0D 4B 0B FC 4E ED CC E6 00 EF 74 F3' - '5A 55 C2 53 CC 6B AE AC 98 C1 5D A2 38 B4 D6 28 00 C3 5E 2B 8A FB 43 11 B6 04 BA 3C E6 B1 01 47' - '04 FC 31 C3 EB D2 B2 2F 54 DC 11 E1 BB 9C 29 B0 2D 47 04 FC 5E F6 25 CA EB A1 BC 4A 7C AC 00 96' - '13 1E 97 BF A3 E2 1B B2 BF BE B8 7F F0 4B 45 60 23 EA 7E 66 A3 F8 E5 22 F0 76 EA FE 98 39 FD C0' - 'C6 D4 03 90 0F 9D 34 10 7B 56 D8 59 58 8B 71 C0 54 E1 1D 8C 07 36 21 0E C2 1B 5B 7E 17 33 D8 7D' - 'B7 33 DE FD 6B DC DC 30 D4 70 3F C1 1E 0A 14 9E E4 36 A1 4E 54 A7 C2 F6 19 77 D0 60 B7 99 3E 17' - '45 D1 9F E2 D1 3D 38 FE E6 EB 89 40 C1 B7 3B 50 D8 60 BB 02 C5 77 1A 6A 02 EA 4B 51 DE F7 42 9E' - '62 13 1E 50 B8 FF 46 73 5F A0 D0 F0 91 40 21 E9 50 A0 D0 70 44 4D 40 7D 1E F2 0E FF 76 AB 62 D8' - '3B A0 3E 95 C3 DF 10 BF 52 FF 50 8F 97 F0 14 ED 5C 53 8C FF 46 F3 6B C5 40 BD A3 0E B0 A1 42 6A' - '12 77 C1 88 28 EE 82 CF 68 3C FE BD D2 D1 40 61 48 DB D5 01 54 48 B4 7C C4 12 D4 24 6E 68 65 B8' - '6B 40 3B A5 7B 5C 9A E1 F1 3D EE 36 60 51 D9 7F 92 BD 84 F0 B2 EC CF 0A 9B F3 E4 04 36 E5 AA 03' - '17 C9 DE 4D F1 F7 A9 9F 55 FC 8E 1C 78 42 F6 9E B2 3F 6D 3E 7F 1A 6F 41 43 DC DB 9F 29 58 08 8E' - '79 88 AB 61 82 28 9F 3C 45 71 31 DD CB 66 40 7F 16 DE 1F F3 D8 8C C3 00 76 4E F7 FA 1E 61 49 C5' - '95 55 DC 51 D9 7B 49 A7 C9 FF 3E A7 0F BC 22 7F 6B 4E 0F 78 52 FE 62 B2 27 70 F7 0E 75 BB 77 22' - 'F6 40 A0 A6 E3 08 E2 54 86 FA 0F 8F F0 FE 92 F7 A9 A1 6E CB BF 26 3A CC EC 51 C5 8C 77 3F 69 B4' - '23 50 A9 66 8F 28 0C 2A 2B 17 6C A8 BB 00 B2 8B 62 A9 73 8A A2 3A B9 45 B1 49 B2 73 03 0C 8D 7F' - '29 FA AD 79 07 D4 73 1C 3B E8 E2 74 8F DD A5 9B B3 56 C0 73 9C 33 F0 17 D9 EF E2 A9 0F 2C 25 BD' - '4C B8 85 B5 00 F6 8E 79 FD 83 DA BB 55 78 4C 58 4E FE 2E D2 2B A4 5F E7 BC 86 B9 8F E1 A6 88 A2' - '44 EB 45 51 AA 59 2C C3 B0 78 51 66 07 0A 45 99 A9 30 A8 D3 FC 7E 74 58 FC FB D1 DF F8 61 95 57' - '39 B9 3F 86 B9 BA E4 0D 79 8A 80 DC B2 62 03 45 45 51 94 FC A2 78 A0 CB 2B 8A 6D 75 37 A7 0E BA' - '92 43 06 5E CD F0 78 3C DD 63 71 E1 F3 B2 B7 E2 59 0B 6C C3 D2 00 CB 2B EF 03 96 14 B8 5C 71 3D' - '84 A5 85 7D 14 F7 A3 DA 6B C1 A5 00 2E 91 EE 2A 7C 87 5F D7 0C 77 1F 1C BC CD 4F 0B 86 BB AB 63' - '24 6E 4B 5C DE E1 EE 90 FC 5E 94 BF 64 C9 2D 30 3C 7E 48 BE 10 28 FE AC 44 A0 70 96 BD 12 28 9C' - '41 97 D5 04 D4 F3 25 3C 45 4C 41 C5 F8 CF 9D 0A 07 0A AD E5 0F F9 30 A8 82 A2 38 75 0A 8B 62 01' - 'AE A8 49 1C 76 27 D5 24 3A 2A A6 00 2C 4B 42 D8 53 9C 69 59 45 71 A6 9D 51 2F FE 4C 3B AE 4C A8' - 'E2 72 F8 2F 4C 6F 53 06 54 11 35 89 33 AD 88 C2 B1 A6 C5 44 F1 90 5E 86 35 07 FD 55 58 21 E6 F1' - '4E E1 4F E9 1E 1F 90 6E CB B5 64 CD 15 DF 9A 6B 0C BC 4F BA 9B E2 4F 49 D7 90 7F 35 4F 38 60 4B' - 'AE 25 30 9D 7B 00 58 42 F1 4B 85 91 6B D8 BE 23 DC EF 66 8D 46 01 03 85 2B C0 AE 61 33 7B 15 12' - '45 4C 58 14 01 1B 79 19 8C 70 97 41 49 4E 71 84 2B F6 0B 1C 0A E8 6F C2 93 E9 1E 4B 0A 1F E5 94' - '80 19 1C 12 F0 C1 98 B7 F7 52 7C 2B 0E 19 D8 57 F6 8A C2 7B 95 5F 56 71 69 D2 F7 4B FF 2C FD 2F' - '2F D5 91 F1 13 EF 0F AE C8 48 B7 21 8B 8B 62 2D 4B 97 F0 14 3B A6 A4 AC 58 C8 D2 A2 98 C4 B7 A2' - 'D8 1B 65 45 B1 BC FD 38 14 D0 DE 19 1E 97 A5 7B 2C 25 7C 51 F6 18 A7 06 CC C1 D5 00 B6 E6 94 80' - 'BF CB FF 8B E2 BB 0B 3B B2 24 C0 15 F2 57 52 3F AB 84 E5 64 9F CC A9 8D 8A 7F 19 F0 26 CB 3F CA' - 'D1 F2 1C E3 28 37 B5 B2 25 3C C5 24 2A 8A 62 DB 97 0C 7B 8A F9 94 97 15 FB F8 36 51 4C AD 8A 68' - 'F5 88 AD 13 C5 11 F4 07 3B 06 2D 2F 5C 29 CC C3 89 01 5F 92 2E 9D EE B1 0D 27 CA DF E5 8B 79 BD' - '5A B8 5C FE FE D2 E7 59 20 E0 C3 DC A6 C0 AB F2 EF 0F A3 10 C0 E7 A5 FB A8 FD 29 BC A7 8D 76 FB' - '0F AF C9 7C 2B E2 69 6A C8 D3 31 78 9B C4 72 8C 76 BF F6 37 55 01 33 70 8C 8B CE C2 2D 82 A7 C0' - '68 77 4C FD 28 CA B7 E8 A2 28 DD 6D 21 4F 71 DC 54 11 C5 06 A9 26 8A 0D 52 83 D7 FD E8 F8 27 0C' - '3F 2B 13 EA 8D 12 9E E2 54 79 4F E1 BC 09 86 3D C5 A9 92 53 14 A7 CA 59 C5 A2 FE 35 14 8B E3 A2' - '9A AC 38 23 1E E0 A4 41 4F A5 7B EC 29 9C C4 FB 01 B0 82 FC 43 B0 6B B2 03 FF 94 6E C3 45 01 0E' - '88 79 5D 59 F8 21 8B 0D 6C CB C5 01 96 51 7B 77 2A 6F 32 7F 72 10 F8 AB EC 6B 94 F7 B2 FC F7 C9' - '5E 5F ED D7 E6 A8 C7 B8 8A FD 22 8A C9 BE C2 68 D0 BE C2 B6 8C 06 BE 90 EE F5 83 B2 F7 92 9E 87' - '37 E2 D9 81 03 63 5E 1F E4 D2 03 AB 48 FF A6 B8 8F 38 7A 60 3B 8E 1E F8 90 FC 65 E5 BF 5F 58 51' - 'ED FF 25 5C CC ED 30 D6 FD 48 C8 6A 5E 36 63 E3 1F B9 3D 2D E5 2F A2 63 0A C3 4D ED 94 28 DE FA' - '2E E7 DB 85 B1 EE 39 C9 1F 23 0F CA 87 8B 70 83 28 AC 8F A9 29 FF 8C F0 64 A0 F0 8C B0 55 61 50' - 'EF 8A 4E C3 35 C5 65 1E EB 36 DE F7 21 4F 51 BB 54 59 B1 25 EA CA 8A 4B B2 B6 AC B8 0E 5F 54 0B' - 'BB 40 39 5F D0 75 BC 74 80 FD 32 BC FE 98 75 02 B6 67 9D 80 55 63 DE BE 42 F1 83 A4 D7 0A 57 29' - 'AF 33 CF 1E E0 AB D2 7F 0B 2B 09 7B 2B BF 9C F0 77 E1 1B BC F2 C6 B9 2B EF 3D 8E 6E 9C 9B EA FB' - 'A2 B8 08 CF B1 1C E3 DC 23 29 AA F6 81 1C B8 0E 9B 28 F3 28 DE 76 72 B6 E3 5C 39 1A 8B A2 1C F5' - '79 99 8D 8B 7F 24 5E B7 84 77 40 35 52 0C 8A 73 BB AC B8 BD 36 14 45 9D 56 73 D0 A0 E5 D3 3D BE' - '24 EC 23 7C 38 E6 71 A5 74 7E 6E 52 60 7F E5 AD 67 51 81 1D 58 44 E0 3C 5E 72 FC 1D 63 F9 5F 13' - 'FE 23 FC 9C 9B 96 77 19 B5 77 81 8B 00 1C AC 7E AA 09 B7 73 F6 7E 97 3C 21 CA 5F 0D 10 C5 16 3D' - '2A 8A 6D F8 BC 28 B6 61 BA 28 9E F1 1F 10 45 29 33 58 D8 F1 EE F8 43 D3 EB E4 00 DD 26 87 EF E8' - 'F1 40 A1 AF 2D 0A C3 2B 26 C7 44 97 74 48 0E BC EF BD 83 85 1C EF 56 A3 A9 28 EE 22 CD 45 51 FF' - '9D BC 2C C6 BB 8F E6 A6 BA 3E 9E 52 53 DE B0 81 D5 83 7A 80 D5 00 56 CE F0 58 3D E6 F1 22 AB 03' - 'AC 20 7F 47 56 19 F8 3F C5 AD 53 DC 9D F2 77 E1 D6 04 0E 90 FF 4F D9 E7 73 55 80 2F 4B 0F 51 DE' - '1A C5 9D 16 2E E4 D4 26 B8 FA DE 2F DA CA EC 88 28 4A 7D 52 94 1F B2 71 53 4E 70 DB 79 93 AC 68' - 'E1 80 28 26 F7 0F F7 DE 04 77 F7 68 21 8A 3A 5D 35 4F 71 CB 68 59 C2 53 94 AC 8D 02 B0 97 5B CB' - '8A EA B5 92 15 BB B7 BD AC D8 BD 6D 45 B1 7B 2F B1 3E A0 0F 72 5E C0 6B 19 1E D7 C7 3C F6 95 FD' - '8C EC 9D 58 3F E0 46 D6 1D F8 8A FC 35 14 3F 9F 07 3B F0 2F D9 1F 52 5E 15 E1 40 E1 50 C5 57 54' - 'DC 74 CE 7A A2 AB D0 AF 9C DF 44 37 EB DF 44 31 EB 0F 78 81 4E 8C 3F DA BF 1F 28 F8 CE 07 0A 45' - 'C9 08 14 3F 42 53 13 50 1D E5 F0 9F FB 57 0B 67 2A 5C F1 9D 03 1F EE AD 7F 28 09 AA AB 1C FE 4D' - '40 5A A0 D0 44 C7 90 0F 63 BE 28 EE D8 35 D5 B0 FF 34 A4 46 D8 3B A0 AA C8 E1 3F 0D F9 53 7D 40' - 'BD 5B C2 53 0C B7 AB DA C9 19 B1 73 A2 7C 0B A7 46 70 57 CF 2B 8A BB FA 25 0D C6 7F 0B 70 21 50' - '18 DA E7 81 C2 24 3E 0D 14 FA F8 32 50 D8 22 DB D5 0D D4 47 72 F8 37 1F 6F 6B 54 50 3F 86 BC C3' - '7F F9 7C 45 19 50 DD 78 B9 80 AE E5 B2 02 FB A5 7B DC 10 F3 F8 09 B7 17 B0 33 B7 0D F0 75 C5 25' - 'CB 7F C2 7C 7E 55 D9 AF 0B FF 56 3B 83 A4 87 29 BE 16 0F 4F E0 1A 6E 3F E0 2A C5 55 12 7E C8 D3' - '62 D2 7F 3E 73 5B C0 7D 35 C9 5D 8F F7 89 E2 7A 3C 2C 8A DD 76 42 14 D7 E3 0C 51 DC 81 F7 8B E2' - '22 EC C1 32 4C 72 7B B0 97 28 D6 F2 36 76 08 FA 70 86 C7 D5 D2 1B 63 1E 6F C8 DE 93 05 02 F6 97' - 'BF 0B 0B 01 AC A9 B8 E1 C2 D7 E4 AF A6 BC 4D 9C 20 70 B0 F4 A7 2C 24 F0 1F C5 BD 11 8F 63 FE 64' - '9C 47 19 1E 07 A4 7B AC 2C BC 29 FB FF A4 47 28 BE BA EC 6B 64 3F 2D EC CA F1 01 53 14 F7 A6 E2' - '3E 63 FF C0 75 D2 FB 52 2D 31 CF 14 F7 A8 32 EC 3F 87 F3 DE 54 4B F8 FF E6 67 78 60 67 DA 7A 70' - 'F3 4C 71 E5 EC 53 C2 53 94 B3 8F AC D8 EB D1 B0 A7 D8 EB F9 45 B1 D7 FB 73 6B 4E 89 DF 9F FB 2A' - '13 AA 97 32 71 C2 0D 94 15 C7 DA 21 DE 24 41 87 F2 79 15 F8 10 A7 07 4C 8D 79 1C 29 DC 2C 3C 23' - '7F 8D 0C 8F D7 A4 07 0A FF 95 7D A8 B0 1B CB 04 AC 22 FF 7A D9 CF 0A 3F 67 B9 80 17 B8 8F A6 BA' - '0F 2D 12 F9 26 76 AA 7B 22 4B 08 E8 70 CE 6B 6A FC FB E9 BE 9C 8C 57 FD 45 71 21 6E 2E E1 29 02' - '06 07 74 A4 32 FD 57 D5 83 15 0E 35 5A 0E FF 55 F5 50 65 40 15 09 7B 5A 01 A5 52 38 AA F6 16 87' - '0C 3A 2A E6 71 83 F4 EB E9 1E AF 0B E7 87 70 07 04 6E 51 DC 20 D9 4D 3A 8D 25 01 56 95 7D 98 DA' - 'A9 25 FF 5A D9 37 73 67 03 BF E0 12 11 59 2A 60 B2 E2 C7 72 C0 D3 DC 14 D7 8B E2 88 1C 1E F2 14' - 'F3 1B 2F 2B 66 54 2C EC 29 66 34 54 01 98 D1 64 05 E0 4E 37 51 14 5B 62 30 FB 07 7D 3B C3 E3 70' - '61 35 D9 BF E4 38 18 2A FB C3 B2 6F 94 BE 21 FD 86 70 0B E7 01 AC 1D F3 7A B4 B0 17 AF 78 60 77' - 'D6 03 F8 88 EC 21 E1 3F 3C F7 A7 BB DB DB FF 44 B1 DC D7 44 B1 DC B3 B9 7E D3 E3 B7 A9 D1 21 EF' - '80 9A 2B 87 FF 7A 7A AC 1C 50 E3 45 71 F3 B9 18 F2 31 FE EB E9 0F 03 C5 9F D1 0A 14 92 3E 0E 14' - '8A 7A 5D FD 43 7D 5B C2 53 DC 29 26 AA E1 1C 28 AA 28 6E 4C E9 A2 48 2B 18 F6 14 17 6B 61 51 5C' - 'AC 57 34 50 7F 63 FA 3E 50 7C 07 1B 28 4C E9 C7 40 A1 BB AB 81 C2 E2 EE 57 37 50 5F 6B 48 B0 4E' - '15 2D 07 AA 00 DC 87 66 CA 8A 25 9F 2E 8A 77 B5 3D B8 04 A0 37 B9 64 C0 37 85 5F 71 A9 81 EF 64' - '78 BD 35 E6 71 84 74 75 C5 D5 91 7D 93 EC 63 A4 87 F1 54 01 F6 E6 52 03 D7 29 3E 2C 7F 8A E2 87' - 'C8 3E 93 5F 4F CF 88 7F 94 C0 0F 09 F8 D9 42 A6 61 3A 3F 2F F0 EA 2E 0E 7E 86 5B ED F9 A2 98 73' - '84 ED 82 4E E3 43 28 B0 AE F4 D7 9C 07 70 68 BA D7 67 85 EF 66 78 1C CE 71 02 FF 95 7D A4 EC A9' - 'C2 6D 6A 67 BD FC 7D 39 1F E0 66 F9 6B C8 DE 93 75 04 8E 55 FC 42 0E 6D A6 DB C2 F7 88 62 65 A7' - '87 3C C5 16 BE 57 56 5C C3 4B 44 B1 B1 36 88 62 37 2D 17 C5 E4 8E F2 1C 00 1D C6 CE 80 B5 32 3C' - '7E C3 C9 01 DF 93 AE 17 F3 D8 8B 83 01 6E 91 7D 94 F0 51 F9 C7 09 4D F6 64 B5 9B 45 F6 0D D2 6F' - '09 E7 72 2D 66 C5 D7 62 0E D7 C2 AB FB 39 C6 59 6E 12 2B 45 31 89 D9 5C 03 D0 F7 D9 3C B0 B6 F0' - '21 1E 07 C0 DE 1C 1E 30 21 E6 ED E3 85 DB 85 35 D3 3D 8E 56 5E 7D D9 37 CA FE B6 F0 11 F9 BF 64' - '79 80 C3 65 FF 96 65 01 86 E4 FF 8D 43 9B ED D6 E2 86 79 8A B5 98 19 F2 14 6B F1 8F 02 B0 A5 52' - 'C3 9E E2 EA 7F 50 56 4C EE 5F A5 61 72 7F C9 8A 6B 71 A3 28 16 EB 0F 51 2C D6 77 EC 1D 34 85 A3' - '61 FB 19 1E EB 08 B7 0A 37 C9 FF 58 CC 63 A2 70 8C FC 7D 58 25 E0 08 C5 35 90 FF 9C FC C7 38 6B' - 'E0 3B F2 4F 90 7F 0E E7 35 C7 4D 71 75 09 4F 31 C5 79 B2 62 32 77 8B E2 6C 7A 48 01 18 F6 C3 A2' - 'B8 0D D4 65 0F A0 DB 84 1F 08 B3 C6 3C DE C9 91 01 C7 CA 1E 11 6E 4E F7 F8 AE F0 24 AF 15 60 AA' - 'F4 F7 AC 0C 70 A4 F4 E3 6A 6F A2 B0 A1 B0 2E BF 2D 9E 8B 6B 8D DF 3A 13 D9 1F B0 1F 71 1E 90 F6' - 'BB B0 DD 19 07 EC 4F 3B 70 00 F1 6E 3C 88 11 1F C3 13 06 F1 71 9C 01 C4 27 70 A6 11 9F C4 ED 94' - 'B8 07 E3 E6 46 DE EF 7E 68 24 BB 28 1E 7C AF B3 3C A7 5D FD BE 10 E5 C7 8D 9C 0B E8 4D 9A 3E 74' - 'DE 1B A4 DF 38 FA A5 28 02 B7 32 F0 17 1C 28 34 FD ED BC 7F 3F 05 53 85 90 E5 E5 93 79 C5 90 ED' - 'E0 3C 6B 86 AC AB FB D1 FD 90 FD 43 7F 5A C8 52 A8 1F 08 59 56 5E 3F AB 42 76 84 7A 77 C8 7E 62' - '53 47 43 5C B0 DB 69 2A 13 B6 27 D8 44 DD B0 B5 70 3F B0 19 B6 96 C4 AE 61 DB EC 7E 4E 30 6C 69' - 'EE 07 BF C2 F6 88 FB 69 A2 B0 B5 23 F6 09 DB 5A 5E 82 C0 F6 D4 7D C3 B6 8D D8 2F 6C 1D 84 DB 89' - '03 C3 F6 98 FB CA 36 6C 9F 71 93 0D 0D DB E3 EE 0B 8F B0 1D A0 1E 11 B6 1D D4 A3 30 0E E2 E8 B0' - '3D 49 1C 13 B6 01 BB F9 B1 55 D8 76 B9 CF 08 C2 76 A7 7B F3 13 B6 67 DC 33 7E D8 F6 10 27 87 6D' - '2F 71 4A D8 F6 11 A7 86 6D BF 7B 22 40 FB EE 76 11 B6 83 C4 59 61 3B EC 36 79 D8 8E 10 E7 86 ED' - '59 E2 C2 B0 1D A2 7F 11 FC C4 7B 60 27 2E 47 95 88 F7 85 ED 38 F1 FE B0 9D 20 AE 08 DB 68 8E 6B' - '65 D8 9E A3 5E 15 B6 E7 89 AB C3 F6 33 4B BB 26 CC D2 9E A2 09 F4 2B 76 F1 70 D8 76 52 3F 12 B6' - 'DD C4 6D 61 6B CB 8F 22 9E 73 1F 0A 9C 28 89 AC D5 EE CE BD 34 E2 29 96 F9 B8 AC D8 04 C7 44 F1' - 'B4 71 5F 49 CB 42 EA FF 4A 69 CB 88 E5 E0 9F 16 CD 34 AC 08 DC 21 E7 CE 15 B8 61 78 20 70 37 73' - 'EE 3C 81 1B 86 65 81 82 2F 9B 7A 85 BA 5F 79 05 E2 BD E6 54 A4 37 AC 0C DC BE D7 DC 81 1B 86 07' - '03 B7 EF 35 6F E0 86 61 79 A0 E0 CB AE 5E A1 9E 13 85 75 15 7F 09 1F B4 A7 70 67 CC E3 AD D2 5F' - '48 F7 A2 5E 83 E6 84 5F C6 3C 16 97 DE 25 BD 86 FA A1 88 3D 1D F3 D8 5B BA 84 F0 2B D9 1B F3 1A' - '03 F6 A1 7D 2D 4E 38 61 49 E1 D7 31 8F BB 85 AF 73 C8 0F BB A2 2C 8B 78 8A 02 14 E5 0C 1F 8E AF' - 'D1 AD 81 82 EF 16 65 40 15 93 C3 17 B5 78 A0 10 56 44 61 50 7B D8 17 E8 DA F3 1E BF 91 BE 53 BA' - '94 B0 34 71 1D DA 10 3E 13 F3 F8 AD B0 AF EC 6F B2 E9 F5 AE CF E5 11 4F D1 E1 26 2E DA FA FF 6C' - 'B4 CA 1C 4F A6 61 4B E0 F6 4B 5E 35 70 C3 B0 35 70 FB 25 AF 1E B8 61 D8 10 28 F8 2A 69 00 50 9B' - '95 97 B9 D1 AA 28 D2 1B 1E 09 DC BE D7 6A 81 1B 86 6D 81 DB F7 5A 23 70 C3 B0 31 50 F0 DD A6 5E' - 'A1 DE 12 85 B5 1F 8B 02 FA 5D CC E3 5E E1 3A D9 CB 08 47 12 37 44 6C 5F CC E3 7A E9 ED C2 DF 64' - 'FF 1D 03 4B 02 F6 97 FD 7B D9 AB 49 97 15 1E 97 FD 63 0E 65 A3 9B EC 7D 11 4F 31 B1 8F 64 C5 59' - 'F0 A1 28 CE 82 A7 15 80 C7 88 06 9C DA C6 F8 E2 34 0A 14 3F 73 0F 14 8A 50 4F F9 50 0D E5 F0 B5' - 'BD 3D 50 48 BA 23 50 48 AA AF 24 A8 FD 1C 28 E8 80 F3 1E 2F 4B 6F 90 2E 27 2C 4F DC 14 B1 03 31' - '8F 03 A5 AF 48 6F 94 DE 44 DC 1C B1 0A C2 83 31 8F 83 A4 7F 90 1E 4C BD 05 EF 5F 62 1E 37 4B 57' - '14 1E 92 7D 0B F5 23 11 3B 1C F3 F8 93 70 88 EC 95 84 43 89 5B B1 A5 84 47 62 1E 6F 93 FE 59 FA' - '6F 4E 7D 9B 3F 5C 23 9E A2 3C ED 58 9E 6D F1 7A 77 08 14 7C 6D 94 01 D5 5E 0E 5F E1 8E 81 42 58' - '5B 85 41 0D 63 9F A0 95 85 BF C4 3C 6E 95 7E 56 FA 0E 9E 46 8F E2 AD 39 ED C0 AB 31 8F 55 A4 8F' - '4A 6F 93 FE 81 5D 6C 77 5D 1C A3 0B F4 57 E1 A3 E7 3D 8E 10 56 15 FE C3 FD FA 38 AE 57 6A E0 28' - 'E1 EF 31 8F 8F 49 9F 90 1E 4D BD 23 62 8F 0B FF 88 79 3C 29 AC 21 FB 65 0E E5 09 57 86 07 22 9E' - 'F2 23 E6 80 7E AF 00 6C F1 EF 44 B1 C5 D3 15 80 2D BE 3B A0 7D 59 C8 27 E2 65 ED 1F 28 B4 33 30' - '50 D8 B8 7D D4 14 D4 9F 1C 11 E8 98 F3 1E 77 08 93 85 E7 38 73 E0 73 8A 7B 9E F8 24 DA 3A EF B1' - 'A6 70 AC F0 2F F9 4F 11 9F 8A D8 93 E7 3D A6 08 C7 09 FF 96 FF 1F E2 4E BC 25 38 EF F1 29 E1 0B' - 'B2 8F 97 FE 1F 87 BC CB CD EC C1 88 A7 FC 13 2A 3C DA 76 FD E7 38 1E C3 79 66 1A F6 04 6E 7F 30' - '8E 0B DC 30 EC 0D DC FE 60 9C 10 B8 F9 B7 D1 03 05 DF 28 0D 00 6A B7 F2 32 8F E3 B1 8A F4 86 67' - '02 B7 EF 75 7C E0 86 61 5F E0 F6 BD 4E 0C DC 30 EC 0A 14 7C A3 D5 2B D4 75 51 58 6B B1 28 A0 13' - '84 2F C6 3C FE 4F B8 53 F6 83 6C EB 40 7C 94 93 D8 80 57 87 E5 F0 E3 DB 13 F1 0E A8 03 8A E1 5F' - '98 11 C5 7E 5B C4 21 1F F8 4F 99 C3 CA F7 86 C5 81 DB 37 98 25 70 C3 B0 34 70 FB 09 27 06 6E 18' - '16 04 0A 3E 53 AF 50 F7 28 2F B3 CC 11 45 7A C3 92 C0 ED 7B 4D 08 DC 30 DC 1B B8 7D AF 59 03 37' - '0C 0B 03 05 5F 48 BD 42 1D 95 C3 27 3D 2B 07 D4 21 51 58 9F 66 7D 41 5F 8E 79 BC 2E 9C 24 7B 1D' - 'E1 2B B4 1F 8C D8 7B BC 88 80 23 F8 39 08 70 F2 79 6F BF 21 7F 7F 3E FD 02 77 CB 5E 57 38 85 78' - '08 77 27 E1 1E E1 00 C6 03 6F E7 C9 07 7C 35 E6 ED 37 85 23 D9 0F 70 2A E3 0F 47 EC B5 98 C7 67' - 'A4 EB 0B FF 95 7D 20 DB 03 4E E1 14 8F F8 4D 1C F1 94 7F 93 83 15 39 12 5F EC 02 81 82 2F 49 19' - '50 F9 E5 F0 AB 53 30 50 08 8B 2A 0C 6A 1A FB 06 6D 20 EC 22 FC 83 35 02 9E 8E 79 FD AA EC 17 A5' - '4D BA 90 70 AF F0 3E E1 3E E2 B3 68 44 78 26 E6 B1 A1 F4 74 E1 CB 1C D8 D1 F8 96 9A C6 81 79 F5' - 'AA 1C 7E 33 ED 8D 78 07 D4 1A EE A4 A3 FF D9 FD 65 14 E9 0D 6B 03 B7 4F 2D 17 B8 61 58 17 B8 FD' - '96 AA 10 B8 61 58 15 28 F8 4A 69 38 50 0F 29 2F 73 F7 97 55 A4 37 3C 1C B8 7D AF E5 03 37 0C EB' - '03 B7 EF B5 62 E0 86 61 75 A0 E0 2B AD 5E A1 CE C8 E1 93 4E CB 01 F5 8A 28 AC 8D 58 49 D0 FD C2' - 'D7 63 1E C3 D2 33 84 AF 11 8F 61 97 0A DF E7 0A 03 0B 4B 77 15 CE 14 1E 10 BE 11 F3 F8 02 77 25' - 'F0 7E D9 23 C2 4B F2 CF E0 90 8E FB 9F 16 8F 78 CA DF 83 96 15 27 D8 7B A2 38 C1 CE 71 5E C7 23' - 'FA 38 7A 55 24 53 F1 5B DB C0 87 89 BE A9 A6 A0 52 E4 F0 EB 5C 2B 50 48 AA 13 28 24 25 AB 27 A8' - '54 39 FC 32 D5 0E 14 92 EA 06 0A 49 35 95 04 15 13 85 35 0B 67 09 7A 50 38 4B D8 58 F8 66 CC E3' - '0A EA 13 11 FB 24 E6 B1 9B F4 6C E1 1D C2 B3 F2 DF 22 7D 5A 78 48 98 20 FC 85 AB 03 6C 42 7D 12' - '45 13 1E 16 BE 15 F3 38 47 7A 11 BF 51 7A CE FD ED AE 15 A2 AD CC 9E 15 ED 69 F6 9C 68 2F B3 95' - 'A2 23 CD 1E 16 1D 67 B6 59 74 BC D9 41 D1 A9 66 47 0C E3 00 7D 9B FD 01 E7 9E F7 78 44 98 55 D8' - '54 F8 0E E3 9E C7 7A 9D F7 38 4F D8 4C F8 AC F0 5D C6 9D 8A D8 5D E7 3D 1E 15 36 17 66 17 CE E2' - '52 BC E0 16 EF AD 88 A7 58 B9 66 5C B9 17 E2 5B A1 45 A0 F8 17 06 94 01 D5 5C 0E 5D B4 81 E2 8F' - '95 28 0C EA 6E F6 05 DA 42 F8 5E CC E3 31 E9 1C C2 07 89 2F 46 6C BE F0 0D E1 FB 31 8F 31 AE 19' - 'F0 B8 EC 2D 85 9F CB DF 88 F7 07 60 4E D9 8B 09 7B 08 BF E2 90 5E 72 23 FF 5A 14 A3 CB 45 2F E8' - '02 E1 09 61 77 61 2B E1 03 C2 51 BC DB 00 3F 8B 79 FD BA EC E7 A4 AF 72 94 C0 A2 B2 E7 26 BE 8C' - '5B B0 B0 B5 F0 57 C6 01 4F 4A 7F 10 F3 B8 88 FA 15 3C 82 0A DB 08 F3 08 D3 63 1E DB 52 BF 1A B1' - '8C 98 C7 7B A4 9F 17 E6 15 CE E1 54 5F 73 2B F4 76 C4 53 FE A0 82 AC 38 37 3E 13 C5 B9 F1 05 97' - 'F0 B5 F8 B9 B1 3F 92 A9 F8 93 FD 81 0F D7 ED 59 35 05 D5 4D 0E BF 59 BA 07 8A BF 47 1E 28 24 75' - '51 4F 50 69 72 F8 AD D3 23 50 FC BE 3F 50 48 EA AA 24 A8 6F 44 61 5D CC D9 81 C6 62 1E DB 49 27' - '09 4F 09 5F 20 9E 8E 58 11 E1 19 61 7B E1 12 E1 4A 61 9A 70 90 FB 6C 16 D5 E5 2A 01 CF C7 BC 7D' - '34 57 1F 18 55 DC A7 B2 0F 66 FC 19 3C 9B D2 0E EC 20 CC 27 FC 30 E6 71 A9 F4 18 B6 03 CC 4F FD' - '7A C4 5E 12 DE 2B FC 28 E6 B1 A3 F4 AF AC C9 1B F1 9B E3 3C 16 C2 AB DF E5 F0 B7 C5 77 22 DE 01' - 'F5 18 EF 89 6F FC E7 3E 3E 44 91 DE B0 23 70 FB D4 61 81 9B 7F C9 31 70 FB 9B E3 88 C0 0D C3 A3' - '81 82 6F 90 86 03 F5 B8 F2 32 EF E3 43 15 E9 0D 4F 04 6E DF EB F0 C0 CD DF B6 0A DC BE D7 91 81' - '1B 86 ED 81 82 6F B0 7A 85 FA 4B 0E 9F F4 A7 1C 50 BF 89 C2 BA 8C 95 04 FD 38 E6 F1 65 E9 4E C2' - '02 C2 37 89 17 B1 C3 89 97 70 02 67 41 13 89 59 B8 D3 DF 23 4D CA E2 EE B0 A2 B0 46 48 F3 67 E1' - 'F8 8D B4 60 16 CE 34 26 CA DF E8 12 45 EC 4B A4 85 9C F5 A2 28 AC 9F 90 16 76 34 37 E9 2D AE 85' - '2F 44 71 89 16 11 45 DA 57 A2 FC FE 98 B4 A8 EB F8 1B D2 12 CE FA 13 69 59 97 96 47 14 69 BF 88' - '22 E0 57 D1 9C D8 3C A4 15 9D F5 6F D2 2A 8E FE 40 5A CD D1 F7 49 93 5D 0B 1F 88 C2 9A 46 9A EA' - '3A EE 42 5A DB 8D F7 BC 28 62 BB 8A 22 F6 65 D2 3A CE 7A 49 14 D6 4F 49 EB 3A DA 9F B4 9E 6B E1' - '4B 51 0C BD BE 28 D2 BE 16 45 6C 3F D2 06 AE E3 59 BC E0 6E CF 62 DF D2 D4 D8 79 7F 26 6D EE D2' - '07 88 22 FD AA 28 02 7E 13 C5 CC FF 20 6D ED AC 5B 9E E4 5F 75 CA 62 FF D0 D4 DE 99 1E A1 A9 43' - '16 FB 91 A6 8E CE D4 8B B4 A7 A3 33 48 A7 65 E1 B7 EF 33 49 A7 3B FA 31 E9 87 2E E0 02 E9 47 8E' - '5E 26 FD CE D1 2B A4 DF 3B 7A 6F 82 85 93 86 27 D8 A2 04 2B C0 1F 4A 99 96 60 50 05 45 C7 26 58' - '61 D1 F1 09 96 5F 74 46 82 15 22 BD DB D1 CE A4 EF 25 D8 C5 04 2B CD FF F2 01 B4 36 BF E2 01 D6' - '21 BE 9F 60 75 89 E7 12 AC 0C FD 1F 24 58 3D 6A 60 59 EA F4 04 2B 47 BC 90 60 E5 89 68 A7 02 F1' - '52 82 95 22 7E 91 60 15 89 DF 25 58 25 E2 E5 04 5B 70 D3 42 89 A5 13 ED B7 1B 96 25 B1 62 A2 35' - '4F B4 4A 89 56 33 D1 7E 95 A1 85 7B B5 4E B4 DB 6F 58 98 86 F6 89 D6 08 34 C1 D3 45 37 3D 4D 4B' - 'B4 32 89 DC 77 8E 2E BC E9 63 41 CB CA DA 3D D1 16 2B 16 F4 1E 05 80 96 57 40 8F 44 5B A6 00 D0' - '7B 15 00 3A 1D 01 49 A0 D3 12 6D C1 4F B8 7C 41 57 72 D4 40 93 7E 00 9A 89 09 D7 91 85 F1 57 4D' - 'B4 2D A0 11 4F 5F BE 61 91 04 D0 6A 89 D6 2E D1 1E 91 03 2A 51 E1 A0 5B 15 53 DD C5 64 95 03 6A' - 'AB C2 41 C7 80 26 F8 EA 8C 15 4D 49 B4 6C 8A 6D 99 68 DB 14 0B FA 39 68 16 4F C7 29 16 74 BC 68' - 'AB 44 7B 54 B1 A8 EC 17 8A 05 CD AE C6 DA 26 DA 04 C5 82 E6 90 15 23 9B 28 2B E8 60 4E 1E B4 B4' - '70 35 8A C0 16 1F 64 71 80 AB 58 14 60 48 FE ED C2 85 C2 35 F0 B3 DB B5 8C BB 2D D1 1E 62 1E B0' - '0B 4A 11 A9 EC 2A 87 21 3F CA C2 78 85 91 6C 0B 14 46 90 93 E3 F2 6A 3B A7 E3 69 37 E5 57 73 AA' - 'AB 32 BC 4A 0B 7C 68 3B 97 F2 A1 1E 53 3E 68 77 C5 54 77 31 8F 29 BF BA EB 7F 7B A0 D0 7F 6E E5' - '43 3D AE 7C D0 49 2C 51 65 B7 4C 93 45 B1 4C 3D D4 6A 4B 37 8E 9E 81 42 8F BD 02 85 FC 1D EA A3' - 'A5 EB F1 F1 40 A1 C7 3C EA 11 6A 87 7A 04 FD 92 0B E8 E9 14 F5 08 3A 55 14 8B FD 84 62 B1 C2 5F' - '29 16 74 9A 02 D0 4B 5E B5 0B 3A 5D 56 F4 96 24 2B E8 74 2E 1A E8 C3 5C 24 60 41 E9 DA 71 BB 70' - '03 17 15 B8 9E 9B 01 B8 8E 8B 0B 3C 22 7F 94 4D 56 71 35 98 C1 8E AA B8 3A CD 14 45 9D 66 89 62' - '02 5F 73 A8 9E 3E C9 09 78 9A 4F 2D 80 CE 56 2C 66 F8 8D 62 31 AD 39 B2 62 2E F9 15 0B 5A 40 14' - '73 99 AB 00 D0 67 39 2C D0 75 C2 CD 1C 36 70 0B A7 01 DC C8 E9 02 37 71 1A C0 3A 8A 9B 21 2C 24' - '7C 92 AB 54 D5 2D 26 FA 3A 15 28 F4 F1 14 C7 EE 55 41 0E C2 D3 6B 37 2C 1B 29 0E B7 52 66 9E 54' - '8C 9F 75 BD D5 80 DF 1E 7D B8 3D 32 D5 53 81 0F 5D 3D 11 28 74 B5 53 5D 41 15 52 57 A0 C5 79 5C' - 'FA EB 27 74 C3 5B 41 C3 A2 48 2B A1 00 D0 AD 9C 28 E8 36 16 02 F8 08 0B 00 7C 8C 13 05 2E 12 0E' - '11 36 13 86 85 65 84 8F B2 80 C0 17 38 BE 6A F1 0B 76 17 C7 E7 55 61 8E CF D3 BE 8A F1 33 BA 33' - '50 C8 B8 45 61 50 4F 2B 19 B4 18 07 EC 6B FD AF 02 40 6F 95 15 69 76 C3 5B 41 5B 73 44 A0 23 85' - 'F7 0A 9F 12 EE E0 48 81 59 A5 2B 0A B7 73 E6 C0 C7 59 09 9E 10 AC 0C 70 37 87 51 DD 0D BC 08 FB' - 'F6 B4 A8 28 02 8A 89 62 9C 7B 14 0B 1A B9 E1 AD 18 67 49 8E D3 D3 52 A2 18 67 16 05 80 16 E6 10' - '40 67 0A 8F 0A 9F E0 90 80 4F 72 28 C0 A7 38 34 E0 4E 4E 01 B8 5E 71 75 85 BD 84 BB 98 57 03 63' - 'A0 06 DE 23 7C 5C F8 34 DB 03 F6 E5 C8 93 DD FF B8 79 8C 2E D0 0D C2 5B 84 BB D9 14 70 0F 53 80' - '7F F2 36 8D 2B 38 35 D1 DA B8 DD DB 8F 6D D4 74 6D 5C 97 EF AD F8 CE CE CF 46 60 38 24 7C 86 8D' - '01 1F 92 DE CB 46 81 FB 89 38 0B 9E A4 1D B8 54 98 28 DC C7 3C 60 7F 5E 18 A9 AE FE A8 FB 00 6E' - '9C D4 F8 9D E2 56 8E C3 AB 5A A8 6C 16 4F 9F E1 82 78 DA 4F C9 7E 0F D6 56 0C 54 71 65 82 EE 55' - '38 E8 4E B5 EE D7 ED 74 A0 B0 5E FB 14 06 55 42 C9 A0 75 D4 24 68 65 2E 73 AA 3B EA F2 DC F0 01' - 'A0 83 35 02 7F 4B 18 14 28 74 37 50 1D 78 35 24 50 78 0D 0D 22 F1 FA F6 BA EF 06 B4 A4 3A 07 DD' - 'AF 21 81 D6 BC E1 29 CE 95 EF 14 0B 7A 4D B1 98 4C 61 8D 0E F4 16 51 4C EA BA 02 78 D7 61 DD 41' - '1F 10 EE 15 1E E0 3A 00 0F 72 BD 80 9D 64 9F 20 AC 2E 3C CC FD 09 3C C4 FD 0A 1C CD E9 D4 8A 1F' - '0A 75 59 27 AF B2 B3 38 9E 56 E3 A8 3D 2D CF 41 79 3A 8A 53 AF 15 BF 7F 8F 54 3B 3A 1F 02 85 56' - 'EB A9 55 A8 EA 6A 0A B4 82 9A 02 CD A1 BE 40 73 8A 62 A5 EA 2B 0D B4 A2 62 41 6B A8 05 D0 DB 64' - 'C5 FA E5 56 1A 9F C7 34 2E 7F 07 1F A3 91 78 35 3E F0 F1 69 2C F0 E1 55 49 AD F1 61 44 AD 81 7E' - '7F DD 0F 02 34 59 3D 83 5E 96 15 8B 97 22 2B E8 8D EB 3E 0D 8B 57 44 8D 81 DE 94 15 85 28 2A 2B' - 'E8 31 AE 03 E8 34 AE 0B B0 80 F0 B0 B0 96 F0 08 D7 15 B8 56 FA 59 AE 2F B0 BB F4 51 AE 23 70 18' - 'E7 52 DB 95 10 AF E1 9C 67 A6 DA 15 F8 D0 73 29 8E C7 AB 03 DC 99 9E 1E 14 45 91 AA 70 94 B5 5D' - '2D F3 DE F0 B1 A0 7F F0 04 A9 ED CE 8E FA AE 06 FF BB 61 F9 64 68 EB 6E 9C FF 7D 87 00 59 DF F1' - '76 71 D9 C6 1D 4C 2D 5C EA 3F 18 50 90 FA 4B A0 CE 25 DA 6B 1A BA 5F 94 11 1A BA 57 87 34 48 D0' - 'D2 9A 05 A9 C6 8B A6 12 34 5E D0 32 B2 62 00 89 B2 82 9E 64 B9 40 27 B3 7C C0 A8 F0 39 2E 07 70' - 'B5 F4 09 96 19 D8 55 FA 80 B0 A6 F0 38 97 05 58 86 C3 A8 E3 AE 87 C3 1C 9C A7 13 38 EA 3A F1 47' - '90 DD 81 C2 08 CA 2A 03 EA 88 32 40 27 2A C6 DF A0 26 B1 06 99 AA 9C 32 A0 9E 55 06 68 D2 0D 6F' - 'C5 D2 54 E5 54 3D 2D AF 58 A4 1D 55 2C 68 59 05 60 30 59 95 06 5A 4E 56 0C 2A 9B AC A0 45 38 43' - 'D0 3E C2 D9 C2 E3 C2 17 58 41 E0 29 56 08 58 5F F6 8D C2 E7 59 19 E0 8B AC 28 F0 18 87 51 D7 5F' - 'F1 1C 9C A7 93 39 DF BA F1 33 75 0A E7 9B A9 A6 06 0A AF 69 41 24 46 57 51 4D 40 35 E0 F1 E0 69' - 'EA 0D DF 07 68 94 93 AA EB E6 F7 87 62 41 F3 C9 8A 16 FE 94 95 B3 E6 90 41 97 09 47 09 5F E6 D4' - '80 2F 71 2A C0 57 38 65 E0 4E F9 5F E5 D4 80 0D 39 82 7A AE DB E3 9C A5 A7 95 D8 81 A7 AF B1 01' - 'D0 39 4C 04 9E 66 C3 C0 A2 D2 27 84 67 D8 01 F0 75 36 0C DC 24 FB 74 CE BD 7E FC ED D7 AB AC 4B' - 'A6 BA 8D DD 78 75 82 9D 7B FA 17 AF D2 FF 5E 79 33 95 E4 8B 39 43 0D 7A 35 2B 50 A8 D1 B3 81 E2' - '85 A2 36 A1 2A AB 27 D0 FC AC 63 7D 17 FE 97 AC 7C 9E 97 15 69 7F CB 0A DA 99 93 00 7D 83 45 00' - 'BE C9 C9 03 6B C8 FE 16 27 0B 3C CB C9 03 F7 C9 3E 51 F8 A0 30 AF B0 0A 9B 6E E0 66 F9 1C 07 E7' - 'E9 6C 8E BA 41 7C 46 73 03 85 71 CD 09 14 C6 53 55 F9 50 CF 2B 9F 47 91 AC 08 2F C8 69 78 FA 3F' - '59 91 56 48 56 D0 CD 1C 09 68 43 E1 DB 9C 19 F0 1D CE 0C D8 57 F6 B9 C2 93 C2 77 39 43 E0 7B 9C' - '31 B0 98 EC 93 6F 62 FF 34 71 9F 9D FC 7A DD 22 A4 FE BF 6B 9F 29 07 D4 6F 72 F8 FF AE 7D B6 1C' - '50 BF CB E1 FF BB F6 B9 72 40 DD 25 0A EB 7C D1 6E B8 5C 39 E5 A6 FE 76 CE C9 79 FA 82 AC BC 33' - 'CB 0A 7A 17 F7 4C D3 F8 F1 33 8F 55 CC 54 35 14 06 F5 A2 92 41 5F 52 8C AF F4 4B 72 F0 9E A9 70' - '3E FB 88 A2 BC F3 F8 AE CF D3 BB 44 91 96 A2 00 D0 FD AC 10 E8 07 AC 1C 30 9D 95 03 BE CF 8A 03' - 'CF B1 E2 C0 49 8A 5B 25 4C 12 26 0B 5F E6 48 9A B9 49 A5 B2 75 4F AF F2 86 D3 2C 7E C3 B9 9B 63' - '6F 16 3F 7C 0E 73 EE 99 6A 7E E0 C3 EB 60 A0 30 C6 5A 6A 10 EA 15 75 03 7A 37 E7 D3 CC 4D AD B6' - '02 40 EB 88 22 6D BE 02 38 61 8E 12 F4 A0 30 83 B3 03 AE 91 CE 27 8C 71 B6 C0 6E D2 1F B2 1A C0' - 'F3 AC 0E 70 8A EC 0B D8 74 73 F7 84 5F 97 1D 7A 5A 4F 14 CB FD 2A C7 E9 E9 6B A2 98 64 7D 05 80' - '36 10 C5 92 9E 56 00 68 43 59 51 AF 85 EA 02 F4 8C 02 40 AF F0 71 C8 D3 93 AC 51 F3 78 C5 5E 61' - '35 33 D5 D1 C0 87 D9 FF A0 24 A8 45 6A 15 B4 91 FA 02 7D 5D 1D 80 DE 2E 2B 4A 79 8F 62 41 17 8B' - 'A2 B1 C6 0A 00 1D C3 6A 80 7E C4 6A 02 3F 66 F5 80 95 65 CF 21 BC C0 EA 01 2F B2 9A C0 3F 6F 62' - '74 FE 9D 7F 1A 6E 1E 50 89 99 EA AF 40 75 C7 21 17 44 42 FD 2F 50 3D 70 9E 04 91 50 D7 F9 29 A6' - '57 D7 F8 29 A6 A7 F7 B0 2A 2D DC 32 E0 B5 F8 86 CF F7 EA 44 E0 C3 BC 9F 0B 7C 7C 0B 1B 28 CC F3' - '0D 96 C7 AB 3B AE FB B6 41 8F 28 DF 3F 87 2F 50 86 57 8B 02 85 EA 2D 0C 14 5A 6B A2 26 A0 DE 54' - 'C3 A0 4B D5 9A BF F6 97 28 C3 AB A6 CA 80 3A AB 0C D0 7B 15 E3 AF 9F 65 CA F7 EA 99 C0 87 1E DF' - '52 12 1B BE EE CB 04 FA 23 77 85 A7 CD D4 01 E8 DB 8A C5 0D 6D A9 62 31 83 E6 0A 00 6D 21 8A 76' - 'EF 55 00 E8 FD 5C 6A D0 2A C2 9C C2 F6 C2 4F B9 05 80 9F 71 0B 00 3F E1 56 01 EE 96 FF 12 B7 10' - '70 19 9B 6C E9 D6 6E 05 67 D4 32 FE 3E 77 4D A0 30 F7 95 81 C2 BF 2F 72 B6 2D E3 AB F5 0E 67 20' - '1F C7 EA E9 72 65 F8 37 BE BF F3 E6 DD 32 BE 5A 35 12 ED BE C0 8D 7F EF 57 83 7E C1 DE 55 83 50' - 'AD D4 20 E8 03 CA F0 9F 84 3C 18 28 3E A3 28 DF BF 51 7E 4F F9 50 AD 95 0F 7A 40 31 7E 89 96 6B' - 'DE 78 BD AF 70 BC DA 28 9C 37 59 51 AC 40 3B 51 A4 7D CE B2 71 82 2C 23 DF 4E 09 57 08 C7 09 F7' - '08 BF 62 F9 81 5F B0 FC FC 0C 95 CB 02 3C C6 E1 B7 8A D7 FA 79 0E 2D 53 AD 0F 14 22 37 04 91 50' - '1B 03 1F 06 76 26 50 18 5B 7B 0E D3 AB 73 9C 92 A7 0F 2B DF 17 7A 9D 32 FC 75 72 28 50 C8 EF A0' - '7C A8 0F 94 0F DA 51 56 54 30 5D 56 D0 FB 58 BE 56 EE B9 FC 7E D1 14 3C 45 A8 3D 5F B6 4D 81 42' - 'EB 3F 71 F7 7B B5 42 19 A0 9D D4 3A 68 86 5A 07 5D A9 00 BC 62 B2 E2 F2 F8 59 2D 80 76 56 1A 7A' - '79 40 B1 A0 5D 64 45 6F 0F CA 0A DA 91 4B 01 3A 5E F8 1D 97 04 F8 2D 97 02 98 5B F6 67 84 5F 73' - '89 F9 59 2F 97 0C B8 52 F6 6A C2 F3 1C 51 6B FF A9 3F 3B F4 F4 21 96 B9 75 FC 53 96 B5 81 C2 AB' - '9B C2 40 3F 54 32 68 9A AC 18 78 77 51 8C F6 23 05 4C C2 9B 18 76 08 FA 3D 07 04 FC 81 03 07 0E' - '93 7D B1 F0 32 07 0A BC C2 09 01 FF E6 B5 F6 DF F7 A4 E5 F8 DD 53 1B 77 A2 2F E1 51 ED E9 52 1E' - 'E0 9E CE E0 77 4F 6D DC 77 4F 3F B1 31 D0 1F D9 29 70 09 3B 01 3E 21 4C 10 AE 62 81 DB BA 71 F6' - 'E7 E8 3D FD 99 59 A0 DF 5D C3 50 80 DF 03 B3 F0 7D 30 5B 05 EE E3 96 68 17 DF B0 3D 98 E8 D5 C7' - '9C B6 A7 7B 15 E3 37 65 4F C5 40 5D 50 0C E8 45 51 7E FA A8 00 D0 D5 1C 53 3B B7 29 D7 88 62 53' - '3E C2 B5 68 17 5F 8B 2D 6A DD AB FD 81 C2 BF BD D5 14 D4 43 CA 07 BD A4 BE 40 7F E1 0E F4 74 AD' - '02 B0 21 3E 51 00 4A 7F 55 01 A0 0F 2B 00 B3 EE A3 76 F9 B1 B3 28 5E EB 14 80 D7 E5 6B B8 B3 B6' - '73 4B 81 73 F8 CA 35 3F 28 AF EC 7A A6 0F C5 59 7F DD 4F C6 AB 50 E0 43 51 36 04 3E A8 8D 81 42' - '69 86 5D CF 6C 13 D5 19 1E 28 14 68 53 10 89 89 7D CA 87 EF 4C 35 22 88 84 0A 07 FD F1 73 B1 C0' - '87 2A 6C 0E 5A C1 EC 3F 0B 5A E1 95 1B CC 08 5B E7 A7 60 B6 50 FF 04 0A F5 19 15 B4 09 15 B9 FE' - '5F DF B5 6B 99 3D F0 7D CC B5 FF 46 66 09 22 F1 EF E8 A0 15 FC FB 6B D0 C3 69 BC EB 08 F2 A0 AE' - '06 EA 0C D6 37 88 84 FA 23 F0 BD 8E 3B 58 E0 83 FA 2B F0 BD 87 E7 AB C0 07 F5 77 30 4E A8 1F 02' - '5F 06 2E AB 20 0F 6A F9 4D BF 1B A0 EE BF E9 37 11 E8 8A 9B 7E 13 81 DE 77 D3 EF 11 D0 0A BC 88' - '3D 9D C5 CB B5 9D BB 5C 6F E3 E5 C8 AD 25 1C 2D FC 8D 67 01 30 BB F4 2E E1 72 E1 EF 3C 4B 58 1B' - '5E 98 C0 AB BC 70 81 B7 D2 3F 01 6F 63 84 03 89 13 13 AD A4 B0 0B 2E E8 C4 C9 38 F9 80 09 C0 51' - 'BC D0 67 A3 5F 5E E8 C0 11 F4 03 47 D2 0F 1C 44 FF 9C 44 1B 4C 3F 70 00 FD C0 81 F4 03 BB D3 3F' - '17 47 01 FD C0 6E F4 03 D3 E8 07 F6 A6 FF 6E 5C 42 F4 03 7B D2 0F EC 45 3F 70 28 71 7E A2 0D A1' - '1D 38 9C 71 C0 61 CC 03 F6 A5 7F 01 AE 3B FA 81 FD E9 07 F6 A3 1F 38 8B 78 0F DE 7D D2 0E 9C C1' - '38 E0 4C E6 01 A7 D1 BF 38 D1 A6 D3 0F 9C 42 3F 70 2A FD C0 BB 68 5F 8A 7A 31 0E 38 97 76 E0 1C' - 'C6 01 17 D0 7E 2F 9E 48 19 07 BC 9B 76 E0 7C C6 01 97 13 97 E1 31 8C 76 E0 62 E2 0A 1C BB B4 03' - '17 51 AF C4 73 35 35 F0 5E E2 03 38 BC 69 07 AE A4 5E 8D 3D 43 0D BC 8F B8 01 DB 89 76 60 09 AE' - 'DB 76 F4 2B 1C CF 71 EC C0 73 0A C7 05 1C C3 78 E0 58 C6 03 27 12 9F 4C B4 09 B4 03 27 33 1E 38' - '89 F1 C0 D5 D4 BB 70 D7 A5 1F F8 20 E3 81 AB E8 07 66 10 9F C1 6D 9B 71 C0 0F 18 07 4C 67 1C F0' - '21 E2 3E 9C CF B4 03 1F 66 1C 70 2D F3 80 9B E9 3F 80 33 89 7E E0 23 F4 03 B7 D0 0F 5C 4F FF 21' - '1C 9E F4 03 37 D2 0F DC 40 3F 70 2B ED 27 12 AD 38 E7 0B DC C6 78 60 7F E9 47 E9 3F 99 68 DB 69' - '07 3E C6 3C E0 E3 6C 07 F8 0C F1 54 A2 3D CD 38 E0 6E C6 01 F7 30 0E F8 32 AF C2 97 DC 55 F8 14' - '5D A0 4F 32 14 B8 93 21 C0 5D 6C 02 F8 19 ED AF E1 91 91 71 C0 8F A8 71 E4 7C 4C 0D BC 74 0D 17' - 'FF 19 77 15 CF E4 05 ED E9 79 46 81 7E C8 28 E0 05 6A 1C 38 17 A9 81 5F 50 BF 81 07 49 6A E0 27' - 'D4 67 71 6C 53 03 6F 10 DF C2 DB 33 DA 81 FF 72 34 C0 9B 1C 1D F0 1B 22 8E A5 6F 69 07 7E C5 38' - 'E0 D7 CC 03 1E C0 A8 12 CE B9 09 7E C0 B9 7A BA 9F 63 F5 74 2F 13 40 F7 31 01 F8 04 13 32 9C 6B' - '07 A3 3C 7D 91 B9 9E DE 96 1D B4 52 76 6B 94 DD 6A 92 26 3B 5A 8B 34 D5 D1 B3 A4 67 B2 DB A9 EC' - 'F6 96 E8 F9 EC D6 3E 27 7F CA 29 A7 35 CE 69 6D 44 7B E6 B4 0E A2 BD 72 DA 5A D2 35 39 ED 7C 4E' - '7B 93 F4 74 4E 3B 95 D3 DE 12 85 F5 2C E9 19 67 6D 93 8B FF D7 66 2E EB 99 CB 5E 24 7D 21 97 65' - 'E4 B2 B3 B9 2C 62 A7 73 D9 CB 4E BD 49 87 57 67 44 61 7D 5D 34 96 CB DA E5 66 23 B9 AD 71 6E EB' - '20 DA 2B B7 B5 27 6D ED AC 1F 93 7E 94 DB DE CC 6D 97 72 A3 69 D0 77 9D BA 28 07 D4 27 A2 9F E6' - 'B6 D4 3C 58 F5 8E 79 2C 25 8F 5D 24 DD 9D C7 36 E6 B1 4B A2 DB F3 D8 21 D2 B7 F3 D8 C1 3C 96 2B' - 'AF 85 C2 39 F3 DA CC BC 16 49 3A 98 D7 26 E7 B5 05 79 6D 36 D5 A1 B8 AA 90 84 A6 CB 27 59 F5 24' - 'BB 9E 64 A1 6C 17 93 6C 02 FF B7 7A 8B DA E0 A8 D5 AC 69 A1 24 D0 ED FF 5A 28 17 70 50 8A 85 E8' - '7A 8C 3A 14 B5 14 FA 81 13 99 12 76 29 83 19 02 BA 83 21 C0 5A 0C 01 4E 62 48 C4 85 D4 A5 09 F4' - '29 86 00 87 30 05 B8 93 3A 4B D4 EA D1 0F 9C CC 94 04 97 52 9F 26 D0 5D 0C 01 0E 65 0A 70 0A 43' - '12 5D 48 53 86 80 1E 60 08 70 18 43 80 53 19 92 D5 85 0C A7 09 B4 19 43 81 07 19 0A 3C 44 CC 16' - 'B5 E6 B4 03 A7 31 25 BB 4B 39 42 17 E8 08 A6 02 5B 32 04 F8 2C ED 39 A2 D6 8A 1A 38 9D 29 39 5D' - 'CA DD A2 13 A2 36 92 59 A0 AD 19 05 3C CA 2C E0 0C 86 E4 72 D1 77 A5 58 16 52 44 C3 31 2D 6A C7' - '18 03 43 1B E6 00 47 B1 0D 60 5B EA DC 51 3B 4E 3F 70 5E 8A 25 64 CD E3 DA 38 1A 35 2C CA E8 A8' - 'CD 64 BB DE 76 82 61 A0 ED 98 06 1C CD 66 80 B3 18 92 D7 85 9C 64 08 E8 18 BA 80 ED 19 0A 9C CD' - '90 24 17 D2 81 26 D0 B1 0C 01 3E C7 14 E0 1C 86 44 5D 48 47 86 80 8E 63 08 F0 79 86 00 E7 32 24' - '9F 0B 39 45 13 E8 78 86 00 3B 31 05 38 9C 58 00 C5 25 16 8C 5A 13 62 D1 A8 ED 67 3C 70 02 F5 AD' - 'D8 08 C4 E2 58 6D 62 09 2C 29 B1 54 D4 0E 33 AE 74 D4 5A 50 03 A7 11 CB 60 31 88 65 51 66 62 45' - '94 85 78 1B E6 4E AC 82 09 12 AB 62 16 C4 6A 18 2A B1 3A 4A 4A AC 81 35 21 A6 60 25 89 75 A2 36' - '9F D8 24 6A 0B 88 AD A3 B6 90 D8 21 6A 8B 89 BD A2 B6 84 D8 3B 6A 4B 89 7D A2 F6 28 C7 35 08 5B' - '90 1A D8 99 88 3A BC 4C 3B B0 0B F5 90 A8 BD 42 0D EC 4A 3D 34 6A AF 52 03 BB 51 0F 8B DA 6B D4' - 'C0 34 EA E1 51 3B 4D 0D EC 4E 3D 22 6A 67 A8 81 6F 12 47 46 AD 07 ED C0 B3 D4 A3 A2 D6 93 1A F8' - '16 35 B6 47 2F 6A E0 DB D4 63 A2 D6 9B 1A F8 0E F5 D8 A8 F5 A1 06 DE 49 1C 17 B5 77 69 07 F6 A5' - '1E 1F B5 73 D4 C0 0F 88 D8 B0 FD 68 07 A6 53 4F 8C 5A 7F 6A 60 06 F5 A4 A8 0D A0 06 C6 A8 27 47' - '6D 20 35 F0 3C F5 14 1C 27 D4 C0 C1 C4 A9 51 FB 98 76 E0 10 6A 5C 0A 17 A8 81 43 A9 A7 47 ED 22' - '35 F0 5E EA C5 51 5B 46 5C 12 B5 E5 C4 65 51 BB 8F B8 3A 6A F7 13 D7 44 6D 05 71 6D D4 56 12 B7' - '46 ED 01 E2 F6 A8 3D CE 76 9E 8E 5A 2A 35 B0 36 71 4F D4 9E A0 1D 58 87 FA 99 A8 3D 49 0D 7C 9A' - 'B8 3F 6A 0D 68 07 36 24 1E 88 DA 6E DA 81 8D A8 0F 46 6D 0F 35 F0 19 E2 A1 A8 DD 4E 3B 70 2F F5' - 'E1 A8 35 A6 06 EE A3 3E 12 B5 3B A8 81 23 89 67 70 A9 13 5F C7 B5 4A 7C 0B 17 26 F1 1D 5C 7D C4' - '0F 70 89 11 CF E3 3A 22 7E 84 63 97 78 09 67 2B F1 D3 A8 2D 22 5E 8D DA 3D C4 5F A3 96 58 0C 87' - '7B 42 31 AB 5D CC B2 91 66 75 34 07 69 76 47 73 91 E6 74 34 0F 69 6E 47 F3 91 46 1D 6D 48 DA C0' - 'D1 DB 49 1B 39 DA 84 B4 B1 A3 4D 49 EF 70 B4 39 69 33 47 5B F1 87 95 C3 C5 AD 3B B1 50 71 EB 41' - '2C 5C DC 8E 11 6F 2D 6E 7D 88 C5 8B 5B 3F 62 F9 E2 F6 14 71 6E 71 7B 9A B8 A4 B8 45 4B E1 CE 95' - '54 CA 52 F8 D7 69 F2 97 B2 9A C4 02 A5 AC 37 FF 6A 0D B0 57 29 CB 92 94 02 7F FC 55 AB 14 6E 6A' - '99 2A 95 FF 75 9D A7 75 E9 A8 5D CA FC AB 0E 1D 9E 7E C3 3F 60 B3 AB 94 6D 2A 8D 51 AF 2A 6D F5' - '22 F6 3D 97 05 F4 32 71 75 69 DB 4C D7 1A E7 BA 42 13 E8 0F C4 87 4A DB 5E BA D6 3A D7 DB A4 EF' - '39 FA 2E E9 39 47 DF 21 4D 77 F4 15 FE 60 7D B8 8C 15 14 5E 88 79 5C 2E DD 59 98 A5 0C 52 22 65' - '98 B2 8B A6 AC 65 AC B6 F0 A5 98 C7 89 D2 D7 A4 B3 33 25 9B 4B C9 45 9A D3 D1 26 FC BD A0 68 19' - 'BB 9F 7F A8 26 5F 19 9B CB 3F 96 0A 2C C7 90 B2 2E A4 02 69 79 9F 58 19 B5 AC 52 C6 32 5F D5 CA' - 'A0 64 99 AA 2A 22 A5 92 E9 A8 5E C6 FC AB 06 1D 9E 36 65 6B 8D 5C 6B 2D 48 9B 3B DA 9A B4 A5 A3' - '6D 49 DB 38 3A 9E B4 A3 A3 43 48 07 3B 3A 89 74 98 A3 93 49 87 3B 3A 8D 74 8A A3 D3 49 A7 3A 3A' - '8B 74 86 A3 B3 49 67 3A BA 80 74 8E A3 0B 49 E7 3A FA 19 E9 3C 47 3F 27 BD CB D1 C5 A4 8B 1C 5D' - '42 7A 8F A3 CB 48 97 3A BA 9C F4 5E 47 BF 20 5D ED E8 97 A4 6B 1C DD 43 FA 98 A3 CF 90 EE 74 74' - '2F E9 2E 47 F7 91 EE 76 F4 32 E9 41 47 AF 90 1E 72 F4 07 D2 C3 8E FE 48 7A C4 D1 EF DC 53 53 79' - 'FB 91 F8 68 79 FB 89 78 B6 BC 0D E4 6E 5D 72 9B 0D 22 2E BD CD 26 56 E3 DF 16 AA 66 5D 79 41 84' - '92 6D 98 7B 20 4B B6 28 2F 14 E0 60 D7 4E B2 E5 A3 06 DE 41 CC 96 6C 4D 88 D9 93 ED 76 62 8E 64' - '6B 4C CC 99 6C 43 DC 43 47 B2 35 A5 06 36 23 E6 4E B6 A1 EE 61 23 D9 9A 53 E7 49 B6 16 C4 BC C9' - 'D6 90 98 94 6C 8D 88 D1 64 AB 93 CC 3B 7A B2 55 BE 1A 8A 24 15 48 E6 7F 4F 58 10 AD FD EA 55 F6' - '4E 54 CD A4 56 38 D5 5A EA 52 37 AA E6 52 CB FB 52 B5 94 4A 1B 42 D5 46 AA D7 70 AA 26 52 55 47' - '52 B5 90 3A 3E 89 AA 95 D4 F9 19 54 F5 DD A1 91 6C FD DD A1 91 6C 0D A8 61 1F 40 0D 2C 4C 5D 28' - 'D9 6E 21 16 4E B6 B5 C9 7C 3E 4F B6 8D C9 D6 81 B4 BD A3 9D 48 3B 3A DA 85 B4 B3 A3 DD 48 BB 3A' - 'DA 9D 34 CD D1 9E A4 3D 1C ED 4D DA CB D1 3B 49 FB 38 DA 8F B4 AF A3 03 48 FB 3B 3A 88 74 A0 A3' - '43 48 07 3B 3A 9C 74 98 A3 23 49 47 38 3A 9A 74 94 A3 93 48 27 3A 3A 59 74 53 B2 4D 25 9D E2 AC' - 'D3 44 61 9D 41 3A DD 59 67 8A C2 3A 9B 74 96 B3 CE 11 85 D5 7E 0D 85 F3 CC 4D E6 FC E7 D1 3A D7' - '05 DC 25 8A 80 6D A0 39 96 25 DB 7D C9 B6 95 FB 03 DE 6D 44 B8 B6 32 EA 11 3F 68 9A B6 27 F3 4F' - '74 27 E4 79 2C D9 DE 75 B9 D7 93 ED 75 EC 15 FE FD 5C D8 AE 24 5B 46 B2 21 28 AC A0 DF 92 ED 43' - '17 07 1E E1 1F 74 7D CC A5 20 EE 3D 3E 3B 42 4D 66 B3 C0 51 C4 C7 93 2D 0B 33 77 24 DB 59 97 BC' - 'CF 75 9D C0 CC 1D CE F0 52 B2 4D 61 24 D4 FB 6C 01 38 9A FA 89 64 FB 9D 63 7D D2 25 24 32 01 74' - '97 CB 99 CA 00 A8 73 4C 00 8E A1 7E 2A D9 B2 F2 8F D1 EE C4 66 73 FD F8 99 20 39 1B 27 B3 D3 19' - '76 BB 7F A7 31 1E 86 0F 98 0F 1C 4B 8D A6 B3 B3 97 A7 5D 17 68 22 87 14 12 3E 4B B6 74 C6 42 4D' - '77 8F 26 C9 96 87 8D EE 76 ED FF E8 32 F2 06 06 A8 4F 92 6D 0F 87 EF 0D 39 D9 14 28 26 77 39 D9' - '72 29 F2 FB 64 7B C5 8D 31 B7 0C 3F 3A 37 FA 9B C1 4E 60 C8 60 A7 C0 24 4E EC 19 D7 94 FF D7 37' - '1B 65 9E 37 9C 75 79 F9 53 2D 9B 0C 57 E2 A1 2F B8 7F E1 DC CB F1 78 5B 3E 25 7E 1D EF B0 A0 3A' - 'F8 31 BE 42 DF BB 49 17 0A CC 9F C7 0B 8A 86 0B 73 49 BD F9 E7 F8 1C 0A F0 57 88 BD 6D A6 7B 2A' - '4B B6 18 47 0F 2C C2 56 FE DB EC EB AE 44 B7 70 10 FF 35 EF E7 00 BD A1 A8 52 D0 D9 49 67 D8 E1' - '5A 2E A6 94 1F DD 60 DE 4E B6 59 EC 0A 86 F3 EC 0A 78 90 4D 1C 70 19 B7 B2 E6 07 5C 20 16 F3 43' - '06 40 CD 76 4F 84 C9 76 98 81 87 5C 60 88 97 13 28 5E FF F2 C2 39 E4 06 58 9C E9 87 DC 08 DE 4C' - 'B6 12 EC F8 90 6B EC 82 DB FE 1F B1 3D 18 E6 B8 27 C9 64 7B 96 ED 1D 71 ED 95 64 EC 11 37 64 3F' - '83 52 2C D7 91 F8 6E F7 DB 69 AE 7B C2 4C B6 8F D9 0E 30 FC 6B 28 C4 98 63 6C E7 A8 6B A7 34 D3' - '8E BA 15 CA BC 70 2E 30 1C B6 79 4C 07 9E 60 F8 71 7F FD D3 04 7A 91 21 C0 E7 E8 F2 C5 2B C3 B9' - '9C 8C 0F A0 6C A0 30 CF 4B 0C 87 BA 9B E9 C0 53 4C 7B DE A5 CD A7 09 F4 13 86 00 CB 71 62 99 DB' - '09 5D BC C8 58 6F F8 94 31 A0 0B 98 03 7C 99 AE 97 9C 6B 21 4D A0 9F 31 04 38 91 1A 9B E6 35 86' - 'BC EA 42 16 D1 04 FA 39 43 80 E5 39 C4 D3 CE 85 49 E6 E7 02 79 75 86 39 9E DE C3 1C D0 2F 98 03' - 'AC C0 9C D7 E3 7B FF 0D 06 7A 55 91 3B D3 6F B9 2F 19 0B BA 98 B9 C0 4A 74 61 79 DF 49 B6 AF E8' - '02 5D 42 17 F0 6B 6A 5C 55 4B DD 0D 3E D9 BE A1 7E 2B D9 EE A5 06 7E 4B 8D 1D B8 8C 1A 78 1B BB' - '7F 27 7E 35 7C 47 2F D4 72 7A 81 D5 B8 96 EF C6 4B F7 83 3F 30 39 44 6F AB C2 ED 9E 79 FE 66 AE' - '4D 55 16 3C D3 8C BA BC AF 14 18 2A B3 BF 77 DD 2E 83 E3 3E F6 03 F5 3D FB 05 D6 A4 F7 5C BC 18' - '1F 30 CD AB EA EC E9 5C FC 04 3F 1E BF A2 6B B0 27 6F F6 7B 36 59 0D 6C 72 D7 45 BA 1A 80 BA CC' - '1E 40 EF 67 8F C0 5A 6C 30 C3 B5 FD 8A 5B AD A7 5C 7E 8C 19 DE 7C 5E 14 C9 29 0A DE FE 9F C3 0F' - '11 A9 EC 1D E6 C7 E3 67 4C 6D F6 9E E1 82 50 89 15 EC 0A EA 0A BB 06 36 62 F8 87 F1 62 62 B3 7D' - 'C4 1E BC A1 2E 33 FD 1D 0A 3B B6 9E 22 37 B9 03 12 A3 6D 10 18 FC 21 DF 30 D5 B2 CA 70 3D 7E 6B' - 'F3 97 DF C7 6A 14 86 3A 5C BD 0F 5D 69 5E 88 DF EE EA AB A3 2B AE FE 2B 39 44 A8 1F 38 44 60 63' - 'F6 73 21 5E 7F CC E8 22 5B F3 86 DB D9 9A 3F 45 76 C4 57 BA 09 87 71 21 3E 2E 4F 7C 6D 2E 29 11' - '86 3B B8 5B 2F B8 88 A6 EC FD 42 7C 2C CD 02 05 DF 03 1C 0B D4 8F 1C 0B B0 39 C7 F2 49 FC 3C C2' - 'D1 D9 82 E1 DE 80 E4 96 52 AF B8 27 80 56 52 57 5C 70 6B 0E F5 13 D7 2A 8A F2 AD 23 0F B2 79 D8' - '7E 62 F3 C0 36 6C FE D3 78 DB 08 68 C7 45 FE D4 9D 5B 99 3B 1E CD B5 E5 E8 BD F9 67 A6 82 AE 62' - '53 C0 5F A8 71 28 AE A6 06 76 60 B7 9F C7 EF 72 FE D2 6D CF 81 65 DA 3A B2 D3 FF DE 92 D6 30 15' - '86 AB 6C 0A F8 2B F1 8B 64 7B 88 76 E0 38 E2 97 78 5A 64 E2 57 FF 79 38 E8 CC 76 BF 8A 0F 72 2D' - 'C3 A0 7E 63 3A 70 3C 35 EE 92 5D 18 F5 8D BB 66 30 96 87 69 85 FA 9D 51 C0 09 D4 A8 CE 3A E2 77' - 'C9 F6 07 ED C0 3F 89 D8 C3 EB 69 07 76 65 E7 97 E3 1B 1F DD 75 63 4D 2E BB 7D FE 17 63 41 37 30' - '16 98 C6 D8 2B C9 BA EA 30 BA EE 2C CA 15 47 33 E2 1B EB 6F 26 01 37 32 09 D8 83 ED FD E0 6E 30' - '3D B9 0A 3F C4 F7 D7 81 F8 73 C9 3F CC 80 79 13 33 80 9B 89 58 B7 FF D1 0E FC 8B DB ED 67 17 DD' - '8B 73 CE BC BF 5F 63 00 D4 16 26 00 FF 66 E0 2F 7E 7D E9 02 FD 87 A6 AB CE 74 83 26 D0 FF D1 F4' - 'AB 33 8D 60 22 E8 4D BA 80 8F 50 63 44 C3 89 D7 F0 B4 4C C4 E4 6E 32 E5 86 4B 59 E0 3E CD EE 64' - 'B7 F1 E6 08 B4 1A FC B4 BB 93 AD A9 89 37 57 C0 2D C4 50 27 5B EA 3E 9F EE 64 6B A9 F1 5E 66 91' - 'FB 2C B8 93 55 66 1E 70 1D ED 39 3A D9 0E DA 81 4F BA 4F 7D 3B D9 06 DA 81 9B 89 45 3A 59 88 ED' - '57 EA 64 4F D0 5F AD 93 55 63 3E 70 3D FD C0 30 FD 75 3A 59 84 78 47 27 DB 44 7B 9F 4E 96 85 1A' - 'B8 8C 79 FD 3B 59 02 F5 92 4E F6 10 FD 78 37 95 48 0D 2C C0 F6 80 0B 19 07 5C 4C 5C DB C9 B2 D2' - 'FF 68 27 BB 85 FE 1D 9D 2C 1B F5 89 4E B6 8D F9 C0 7F F9 BF 1F 7E D5 C9 56 74 B7 67 98 12 EA 6C' - 'DB DD 87 B9 9D ED 11 62 E5 AE 96 DD 0D A9 AB E5 20 0E EF 6A F7 D2 3E B6 AB E5 A4 06 2E A1 1E DF' - 'D5 72 51 2F EA 6A 25 D8 D5 CA AE 96 9B 7A 5D 57 7B 8C FE 8D 5D 2D 0F F5 EE AE 96 97 F8 59 57 4B' - '22 FE D1 D5 A2 AE F4 DD AC 14 F3 8A 77 B3 5B 89 1D BB 59 7D E2 94 6E 96 8F FE CD DD 6C 03 DB 39' - 'DC CD F2 53 FF D3 CD 0A 10 0B A6 59 41 62 D1 34 2B 44 AC 97 66 BB 18 D7 30 CD 96 13 9B A6 59 3D' - 'BE 3F 05 16 AE E1 B1 3E 75 8B 34 6B 40 6C 99 66 FB 18 D7 3D CD 6E A1 BF 5F 9A 15 21 8E 4E B3 AD' - 'B4 4F 4A B3 A2 6E 5E 69 56 8C F8 6C 9A DD 4A 7C 3D CD F2 71 7C 6F A5 59 71 EA 2F D3 AC 2B 74 D6' - '9F D3 AC 3A ED BF A5 D9 4E E6 03 6B 51 67 EB 6E 6B A9 73 77 B7 F2 D4 F5 BB 5B 0B EA CE 3D AC 01' - 'F5 B3 3D AC 04 DB 39 DF D3 EE 71 87 6B 4F 7B 98 4B 04 7C 90 BA 64 2F 2B 49 3F 70 2B ED C9 BD AC' - '14 F5 95 DE 56 8E F9 BF F4 B6 D2 D4 E1 3E 56 86 98 A3 8F 95 75 F5 E9 63 05 E9 2F DA C7 F6 B3 9D' - '5B FB D8 5D BC 92 2B F6 B1 A1 63 AD 1C 43 40 0B 33 E4 B6 3E F6 08 9B 06 96 A7 7D 6A 1F DB CC 14' - '60 05 EA 2E 7D 2D CA B8 5E 7D 6D 37 ED 23 FA 5A 45 DA 17 F4 B5 A7 A9 D7 F7 B5 4A D4 7F F7 B5 DB' - '88 79 FB 59 65 62 99 7E 56 C5 2D 4D 3F AB 4A 9C D0 CF AA 11 27 F7 B3 EA C4 0B FD AD 06 F1 EB FE' - '56 95 ED 7F D3 DF 9E 72 A7 5F 7F 4B A6 FD 6A 7F AB 49 BC D9 DF 52 88 53 06 D8 5C F7 7F 5E 0C B0' - 'A4 21 96 4A D3 9C 01 D6 92 29 F3 06 58 2D EA F9 03 AC 36 F1 F7 01 56 C7 A5 0E B0 BA C4 9C 03 AD' - '1E 31 FF 40 AB EF A6 34 D0 1A 10 07 0F B4 86 6E CA 03 AD B8 BB 90 06 5A 17 AE E6 FA 81 D6 88 F6' - '57 06 DA ED C4 6C 43 AC B1 BB 50 87 D8 1D C4 F6 43 2C 89 F1 C0 9A C4 B4 21 56 91 F8 F0 10 AB 41' - 'CC 3A D4 2A 11 7B 0C B5 26 8C AF 31 DC 9A 12 6B 0D B7 66 C4 7B 87 5B 2B 8E 1B D8 9C 7A FD 70 2B' - 'C6 F8 8D C3 AD 05 F5 8E E1 56 92 7A FF 70 6B 49 7D 1C F1 EE EA 19 6E AB 98 F7 F5 70 6B ED 4A 37' - 'DC EE 66 49 F2 8C B0 93 E3 AC 08 53 4A 8D B0 79 34 55 1B C1 6B BB 0D A3 7E 19 61 F7 31 2B DB 48' - '6B EB 66 33 D2 EA BA BD 39 D2 EA B8 E3 6C A4 AD 71 C7 DB 48 5B 49 AC 34 D2 DA B9 63 6B A4 CD E7' - '2D A3 F2 28 CB 3B D0 8A 76 B6 C6 B3 6D B5 3B 1C 46 59 7B 06 94 1A 6B 1D 88 43 C6 DA E3 B4 63 67' - '75 A4 9E 3D D6 3A 11 0F 8D B5 CE C4 B3 63 6D 5B 75 E0 DB 63 AD 0B 75 FA 58 EB EA 76 C0 58 EB E6' - '76 CC 38 4B 23 16 18 67 DD 5D 99 C6 D9 0A B6 07 DC E6 EE 7B E3 AC 36 07 BA 60 82 55 20 16 98 68' - '3D DC 21 34 C9 EE 77 87 D2 24 2B 4A 7B E9 C9 D6 93 F6 CA 53 AC 97 5B AE 29 D6 9B D8 70 8A F5 71' - '87 D9 14 BB 93 D8 7A 8A F5 75 E7 EB 14 EB 47 EC 3B C5 1E 66 3B B3 A7 58 7F EA 3D 53 6C 00 71 F1' - '54 1B 48 5C 3E D5 06 11 2F 4E B3 C1 C4 6F A6 D9 10 E2 2D D3 AD 0C FB 2D 39 DD 86 BA 8B 74 BA 0D' - '73 85 9B 6E C3 89 C9 D3 6D 23 AF AC 94 E9 56 8F 71 A9 D3 6D 13 FB A9 3B DD 46 D0 7F FF 74 1B 49' - '5C 33 DD 46 11 67 CC B0 D1 C4 BB 66 D8 18 E2 DE 19 36 96 F8 C2 0C DB C3 BC 2F 67 D8 38 EA 9F 66' - 'D8 78 57 BF 99 36 81 F8 C5 4C 9B 48 FC 6D A6 4D 22 36 98 6D 0F 31 1E EB B5 DE DD 3F 66 5B 0A FB' - '5F 38 DB 26 D3 7F 6C B6 4D 21 9E 9A 6D 1B DD D3 E5 6C 9B 4A 3D 6D 8E A5 32 6E CE 1C 9B E6 D6 6D' - '8E 4D 77 87 EE 1C 6B CD B8 07 E7 DA 0C 77 B9 CC B3 99 EE 8A 9F 67 A5 19 DF EC 2E 9B E5 EA 3D DF' - '66 13 BB CE B7 39 C4 FB E6 DB 5C E2 F3 F3 6D 1E 31 B4 C0 EE 22 E6 5A 60 77 13 F3 2D B0 F9 C4 D4' - '05 B6 C0 5D BE 0B 6C A1 AB F7 02 5B E4 0E D7 85 76 0F F1 F2 42 5B EC E6 B7 D0 96 10 AF 2F B4 A5' - 'AE 9D 45 76 2F B1 D8 22 5B E6 EA BF C8 96 BB 93 66 91 DD E7 4E 8C 45 76 3F 71 D6 22 5B 41 EC B8' - 'D4 56 BA 7D B3 D4 1E 20 36 59 66 0F 12 3B 2C B3 55 C4 A1 CB 6C 35 F1 EE E5 B6 C6 AD CF 72 7B 88' - '78 6E B9 15 E2 3C BF 5C 6E 6B DD 4D EB 3E 7B 98 58 77 85 AD 23 B6 5A 61 EB 89 3D 56 D8 06 D7 DF' - '0A DB 48 7C 04 7E D6 6D FB 0A 2B CB FC 5D 2B 6C 2F F5 99 15 B6 89 FE 61 2B 6D 33 71 D2 4A 4B A6' - '1F B8 C5 5D 37 2B ED 11 77 D3 7C C0 B6 12 DF 7C C0 B6 B9 9B E1 83 F6 28 71 FF 83 B6 9D 78 E4 41' - 'AB C2 BC 76 AB 6C 0B DB 1D BD CA 1E A3 7D F5 2A 7B 9C D8 76 B5 35 74 37 D5 D5 B6 83 FA F4 6A 7B' - '82 F8 D6 6A 7B 80 F1 EF AF B6 27 A9 81 4F 11 67 3E 6C 3B DD C9 FE B0 ED 22 DE BA CE 9E 76 37 BF' - '75 B6 DB 1D 43 EB 6C 0F F1 BB 75 F6 8C 5B E7 F5 B6 97 38 60 BD ED 73 E7 C0 7A DB EF 6E A2 EB ED' - '80 DB 3F EB ED 20 F1 C7 F5 76 C8 AD DF 7A 3B EC F6 C1 06 7B D4 7D 99 BF C1 8E 50 EF DC 60 CF BA' - 'FD BC C1 8E 12 3F DD 60 C7 DC 43 C4 46 3B 4E DC B8 D1 4E B8 EB 72 A3 9D 74 F1 9B EC 39 E2 87 9B' - 'EC 79 17 BF C9 4E 11 CB 6F B6 17 DC 71 BB D9 5E 24 A6 6C B6 97 88 8D 36 DB CB C4 3B 37 DB 2B EE' - 'D8 DC 62 AF 12 A7 6F B5 D7 DC BE DB 6A A7 89 4F 6C B5 33 C4 93 5B ED 75 77 FC 6F B5 37 88 6F 6F' - 'B5 37 5D 9D B6 DA 59 77 3D 6C B5 B7 88 37 B6 DA DB C4 3C DB EC 1D 77 7B D9 66 EF BA 73 71 9B BD' - 'E7 CE 9D 6D F6 3E B1 DD 36 3B 47 EC B6 CD 3E 20 AE DC 66 E9 C4 2D DB EC 37 9E 8B DB B6 59 86 7B' - '5E DB 66 FD F8 07 F7 2B 3E 65 93 F8 7F 1B 4C 7C CA FA 53 D7 DD 6D 03 89 DD 76 DB A6 A4 50 D8 36' - '26 85 4E 24 85 B6 90 6E 76 74 37 E9 13 8E 56 8F 82 D6 8C 86 2A 46 43 35 48 53 1C 6D 9F 1F B4 75' - 'FE 50 E3 FC A1 0E A2 BD F2 87 9E 2B 00 7A BC 40 68 7F 81 D0 49 D1 13 05 42 A7 44 9F 87 2A 08 7A' - 'AC 60 68 5F C1 D0 49 D2 E3 8E D6 2B 02 5A BB 48 28 B9 48 E8 FF 00 75 E8 A3 2C' -} +/**************************************************************************************************** + + + ..\..\jcl\source\common\JclUnicodeZLib.rc + + + Produced by UDExtract written by Dipl. Ing. Mike Lischke, public@lischke-online.de + + +****************************************************************************************************/ + + +LANGUAGE 0,0 CATEGORIES UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE +{ + '78 DA DC DD 07 78 94 55 B7 36 FE 7B 65 52 A6 65 66 52 48 9D 30 33 09 21 A4 32 84 DE 43 2F 82 04' + '5E 15 B1 40 44 45 05 A4 28 76 94 08 36 B0 80 5D 14 05 5B AA 0A 58 10 95 12 15 C4 86 24 92 A2 08' + '12 40 51 10 42 E8 90 40 E6 3F CF BD 99 9C A1 E8 E1 3D E7 7C FF EF BB 8E D7 EF D2 A8 5C 58 26 3C' + 'FB D9 7B DD 6B 2F 3C 10 00 F4 01 AE 02 CA 80 6A E0 27 E0 57 00 A2 09 A0 40 0A 26 3D 19 C9 4C 16' + 'B2 51 38 45 52 14 C5 50 1C D9 A9 25 39 29 91 5A 51 6B 6A 43 69 94 41 59 E4 A6 6C EA 40 9D A8 2B' + '75 A7 9E D4 9B FA 50 3F 1A 40 83 68 28 0D A3 4B 29 97 46 D1 65 74 05 5D 49 57 D1 35 34 96 F2 68' + '3C DD 40 13 E8 66 9A 48 93 69 0A 4D A3 DB 68 06 DD 49 77 0B EE 11 DC 47 F7 D3 83 82 D9 82 87 E8' + '11 C1 A3 82 B9 82 C7 05 4F 09 9E 16 3C 2B 78 4E F0 82 E0 25 C1 22 C1 AB 82 C5 82 25 82 37 E8 2D' + '2A 10 14 0A 8A E9 1D 7A 4F B0 54 B0 5C F0 81 E0 23 FA 58 B0 52 B0 8A D6 D1 06 FA 96 36 D2 26 AA' + 'A0 CD 54 45 35 F4 33 FD 42 BF 52 2D ED A4 DF 68 37 FD 49 7B 69 1F D5 D1 41 3A 42 C7 04 27 04 0D' + '74 8A 9A 08 01 9A 00 0A A4 60 D2 93 91 CC 64 21 1B 85 53 24 45 51 0C C5 91 9D 5A 92 93 12 A9 15' + 'B5 A6 36 94 46 19 94 45 6E CA A6 6E 01 E8 1E 80 9E 01 E8 15 80 3E D4 2F 00 03 03 30 98 86 D2 30' + 'BA 94 A6 E9 34 B7 D1 9D 34 8B 1E A1 C7 74 98 A7 C3 13 F4 94 0E F3 75 78 5A 87 D7 75 78 53 87 52' + '1D 36 D1 8F 3A 54 EA F0 13 6D A1 AD F4 2B D5 D2 4E FA 8D 76 D3 9F B4 97 F6 51 1D 1D A1 E3 74 52' + '87 06 1D 4E EB D0 36 10 79 34 9E 6E A0 09 74 33 4D A4 C9 34 85 A6 D1 6D 34 83 EE A4 BB E9 5E 9A' + '49 0F 50 3E CD A3 27 E8 29 5A 40 CF D0 73 F4 02 BD 44 2F D3 22 7A 8D 96 D0 1B F4 16 15 50 11 95' + 'D0 3B F4 1E 2D A3 F7 E9 43 5A 41 2B E9 53 5A 45 6B A8 2C 10 9F 07 E2 4B 5A 4F 1B E8 1B FA 8E 36' + '52 39 FD 48 95 54 4D 3F D1 16 DA 4A BF 52 2D ED A4 DF 68 37 FD 49 7B 69 1F D5 51 3D 1D A2 23 74' + '8C 4E 50 03 9D A2 26 42 90 26 80 02 29 98 F4 64 24 33 59 C8 46 E1 14 49 51 14 43 71 64 A7 96 E4' + 'A4 44 6A 45 AD A9 0D A5 51 06 65 51 BB 20 5C 11 84 25 36 AC B7 61 03 6D A4 25 11 38 1A 81 05 76' + '7C 6A C7 6A 3B D6 DA 81 96 9A 00 0A A4 60 D2 93 91 CC 64 21 1B 85 53 24 45 51 0C C5 91 9D 5A 92' + '93 12 A9 15 B5 A6 36 94 46 19 94 45 6E CA A6 0E D4 89 BA 50 37 EA 41 BD 28 87 FA 52 7F 1A 48 83' + '69 28 0D A3 4B 29 97 46 D1 65 74 05 5D 49 57 D1 35 34 96 F2 68 3C DD 40 13 E8 66 9A 48 93 69 0A' + '4D A3 DB 68 06 DD 49 77 D3 BD 34 93 1E A0 7C 9A 4D 0F D1 23 F4 18 CD A3 27 E8 29 5A 40 CF D0 73' + 'F4 1A 2D A1 37 E8 2D 2A A0 22 2A A1 77 E8 3D 5A 46 EF D3 87 B4 82 56 D2 A7 B4 8A D6 50 19 7D 41' + 'EB E8 2B FA 9A BE A5 EF E9 07 2A A7 1F A9 92 AA E9 27 DA 42 5B E9 57 AA A5 9D F4 1B ED A6 3F 69' + '2F ED A3 3A AA A7 43 74 84 8E D1 09 6A A0 53 D4 44 7A 07 AC 0E C4 38 90 E0 40 1B 07 DA 3A D0 C5' + '81 DE 0E 0C 76 60 B8 03 63 E8 6A BA 96 C6 D1 CD 0E 4C 75 60 A5 03 9F 39 F0 B5 03 DF 39 F0 93 03' + 'BF 38 F0 A7 03 FB 1C 38 E1 40 A3 03 01 2E 4D 08 99 5C 08 75 C1 E6 42 B8 0B 2D 28 D6 85 04 17 5A' + '51 6B 6A 43 69 2E 64 BA E0 76 A1 BD 0B BD 5C E8 ED C2 00 9A 43 C8 40 56 06 F2 68 7C 06 6E C8 C0' + '4D 74 0B 4D A2 5B 33 30 2D 03 B7 D1 1D F4 40 06 F2 33 30 9B 1E A2 47 E8 31 9A 47 4F D0 53 B4 80' + '9E A1 E7 E8 05 7A 89 5E A6 45 F4 1A 2D A1 37 E8 2D 2A A0 22 2A A1 77 E8 3D 5A 46 EF D3 87 B4 82' + '56 D2 A7 B4 8A D6 50 19 7D 41 EB E8 2B FA 9A BE A5 EF E9 07 2A A7 1F A9 92 AA E9 27 DA 42 5B E9' + '57 AA A5 9D F4 17 ED A7 43 94 53 A0 E9 4B FD 69 20 0D A6 A1 34 8C 2E A5 5C 1A 45 97 D1 15 74 25' + '5D 45 D7 D0 58 CA A3 F1 74 03 4D A0 9B 69 22 4D A6 7C 9A 4D 0F D1 23 F4 18 CD A3 27 E8 29 5A 40' + 'CF D0 73 F4 02 BD 44 2F 53 62 A1 A6 15 B5 A6 36 94 46 19 94 45 D9 D4 81 3A 51 17 EA 46 3D A8 17' + 'E5 50 5F EA 4F 03 69 30 0D A5 61 74 29 E5 D2 28 BA 8C AE A0 2B E9 2A BA 86 C6 52 1E 8D A7 1B 68' + '02 DD 4C 13 69 32 4D A1 7B E8 3E BA BF 10 0F 14 22 9F 66 D3 43 F4 08 3D 4E 4F D2 02 7A 86 5E A0' + '97 E8 65 5A 44 AF D1 12 7A 83 DE A2 02 2A A2 92 42 BC 57 88 65 85 F8 B0 10 2B 68 25 7D 4A AB 68' + '0D 7D 41 EB 0A B1 A1 10 DF D0 51 72 79 D0 CD 03 EF AE 2F 25 50 96 05 CA E6 40 C9 37 CB FB 66 59' + '12 23 6B 63 24 67 8A 8C F3 6E 6C 2A 25 B6 52 3A 54 CA F0 4A B9 B9 52 1E AC 94 45 F4 5A A5 2C AE' + '94 37 E8 ED 4A 29 A8 94 E2 4A 79 A7 52 DE AB 94 8F 2A A5 BC 52 F6 54 4A 60 95 04 55 49 48 95 18' + 'AB 24 B4 4A 22 AB 24 AA 4A EC 55 D2 A5 4A BA 56 49 F7 2A E9 55 25 39 55 D2 BF 4A 06 D2 D0 2A C9' + 'AD 92 C9 55 F2 70 95 2C A9 92 4F AA A4 B2 4A F6 57 89 BE 5A 5C D5 D2 A3 5A 2E AF 96 69 D5 32 B7' + '5A 8A AA A5 AC 5A 76 56 4B 43 B5 D8 6B A4 43 8D 5C 51 23 53 6A 64 41 8D 14 D5 C8 B7 84 3D E2 DA' + '23 F2 B0 77 83 71 1D 70 2F F0 11 6D 07 8E 01 27 00 EF 7F B9 88 46 47 41 14 42 06 32 51 28 59 29' + '8C 22 A8 05 45 53 2C C5 53 02 39 C8 45 49 94 4C 29 94 4A E9 94 49 6D A9 1D B5 A7 8E D4 59 D0 45' + 'D0 8D 7A 50 2F CA A1 BE D4 9F 06 D2 60 C1 10 C1 25 34 9C 46 D0 48 FA 17 5D 4E A3 69 0C 5D 4D D7' + 'D2 38 BA 8E AE A7 1B E9 26 BA 85 26 D1 AD 34 95 A6 D3 ED 74 07 DD 45 F7 D2 4C 7A 40 90 2F 98 43' + '0F D3 63 F4 84 E0 49 C1 33 F4 3C 2D 14 BC 22 78 8D 5E A7 37 E9 6D 2A A2 12 41 A9 E0 5D 5A 46 1F' + 'D2 0A FA 44 F0 A9 60 B5 60 AD E0 2B FA 86 BE A7 1F A8 9C 7E A4 4A AA A6 9F 68 0B 6D 15 6C 13 6C' + 'A7 1D B4 8B 7E A7 3F 68 0F FD 45 FB E9 80 A0 5E 70 98 8E D2 49 6A A4 D3 E4 21 09 D0 E8 28 88 42' + 'C8 40 26 0A 25 2B 85 51 04 B5 A0 68 8A A5 78 4A 20 07 B9 28 89 92 29 85 52 29 9D 32 A9 2D B5 A3' + 'F6 01 E8 1A 80 1E D4 3B 00 39 01 E8 4B 83 68 08 5D 42 C3 69 44 00 9E 0D C0 F3 01 58 1A 80 E9 3A' + 'CD ED 74 17 DD A7 C3 FD 3A 2C A0 77 74 F8 41 87 72 1D 2A 74 A8 D2 A1 46 87 9F E9 17 DA 46 DB 69' + '07 ED A2 DF E9 0F DA 43 7F D1 7E 3A A0 C3 61 1D 8E D2 09 6A D4 E1 94 0E EE 40 8C 0B C4 75 74 3D' + 'DD 48 37 D1 2D 34 89 6E A5 A9 34 9D 6E A7 3B E8 2E BA 87 EE A3 FB 69 16 3D 48 8F D3 93 34 9F 9E' + 'A6 67 E9 79 7A 91 16 D2 2B F4 2A 2D A6 D7 E9 4D 7A 9B 0A A9 98 4A E9 5D 5A 4A CB E9 03 FA 88 3E' + 'A6 4F E8 33 5A 4D 6B E9 0B 5A 47 5F D1 D7 F4 2D 7D 4F 3F 04 62 53 20 2A 68 33 55 51 0D FD 4C BF' + 'D0 36 DA 4E 3B 68 17 FD 4E 7F D0 1E FA 8B F6 D3 01 3A 48 87 E9 28 1D A7 93 D4 48 A7 C9 43 12 A4' + 'D1 51 10 85 90 81 4C 14 4A 56 0A A3 08 6A 41 D1 14 4B F1 94 40 0E 72 51 12 25 53 0A A5 52 3A 65' + '52 5B CA 0B C2 63 41 28 B7 A1 C1 86 D3 36 78 6C 38 11 81 D3 11 C8 B7 E3 31 EF 06 37 01 E9 09 98' + '94 80 BB 12 70 4F 02 5E 4E 80 B4 D4 E8 28 88 42 C8 40 26 0A 25 2B 85 51 04 B5 A0 68 8A A5 78 4A' + '20 07 B9 28 89 92 29 85 52 29 9D 32 A9 2D B5 A3 F6 D4 91 3A 53 57 EA 4E 3D A9 37 F5 A1 7E 34 80' + '06 D1 10 BA 84 86 D3 08 1A 49 FF A2 CB 69 34 8D A1 AB E9 5A 1A 47 D7 D1 F5 74 23 DD 44 B7 D0 24' + 'BA 95 A6 D2 74 BA 9D EE A0 BB E8 1E BA 8F EE A7 59 F4 20 CD A1 87 E9 51 9A 4B 8F D3 93 34 9F 9E' + 'A6 67 E9 F9 96 78 B5 25 16 D3 EB F4 26 BD 4D 85 54 4C A5 F4 2E 2D A5 E5 F4 01 7D 44 1F D3 27 F4' + '19 AD A6 B5 F4 39 7D 49 EB 69 03 7D 43 DF D1 46 DA 44 15 B4 99 AA A8 86 7E A6 5F 68 1B 6D A7 1D' + 'B4 8B 7E A7 3F 68 0F FD 45 FB E9 00 1D A4 C3 74 94 8E D3 49 6A A4 D3 E4 F1 7E 3F 3B 60 73 A0 85' + '03 4E 07 52 1C 70 3B D0 D9 81 1C 07 06 38 90 EB C0 68 07 F2 1C B8 C9 81 69 0E DC EF 40 BE 03 8F' + '3A B0 C0 81 17 1D 58 E2 40 A1 03 CB 1C F8 D0 81 15 0E 7C EC C0 1A FA C2 81 75 0E 7C E5 C0 06 07' + 'CA 1D D8 EC 40 B5 03 35 0E D4 3A F0 87 03 87 1C 38 E2 C0 31 07 8E 3B 60 74 69 2C 2E 58 5D 88 A0' + 'B6 D4 81 BA 52 0F 17 7A BA 30 D0 85 21 2E 5C 4A 0F 91 3B 03 63 33 70 1D DD 98 81 09 19 B8 99 26' + 'D2 64 9A 4E B7 67 60 46 06 EE CC C0 7D 19 78 90 E6 D0 C3 F4 28 CD A5 C7 E9 49 9A 4F 4F D3 B3 F4' + '3C BD 48 0B E9 15 7A 95 16 D3 EB F4 26 BD 4D 85 54 4C A5 F4 2E 2D A5 E5 F4 01 7D 44 1F D3 27 F4' + '19 AD A6 B5 F4 39 7D 49 EB 69 03 7D 43 DF D1 46 DA 44 15 B4 99 AA A8 86 7E A6 5F 68 1B 6D A7 1D' + 'B4 2B 03 BF 65 60 1F D5 D1 61 42 26 92 33 91 42 99 D4 A7 40 D3 8F 06 D0 20 1A 42 97 D0 70 1A 41' + '23 E9 5F 74 39 8D A6 31 74 35 5D 4B E3 E8 3A BA 9E 6E A4 9B E8 16 9A 44 B7 D2 83 34 87 1E A6 47' + '69 2E 3D 4E 4F D2 7C 7A 9A 9E A5 E7 E9 45 5A 48 AF 50 52 A1 26 99 52 28 95 D2 29 93 DA 16 A2 5D' + '21 DA 53 47 EA 4C 5D A9 3B F5 A4 DE D4 87 FA D1 00 1A 44 43 E8 12 1A 4E 23 68 24 FD 8B 2E A7 D1' + '34 86 AE A6 6B 69 1C 5D 47 D7 D3 8D 74 13 DD 42 93 E8 56 9A 4A D3 0B 71 77 21 EE A5 99 34 8B 1E' + 'A4 39 F4 30 3D 4A 4F D0 53 F4 34 3D 5B 88 E7 0B F1 22 2D A4 57 E8 55 5A 4C AF D3 9B F4 36 15 52' + '31 2D A5 8F E8 63 FA 84 3E A3 D5 B4 96 BE A4 AF E9 5B 3A 46 0D E4 2E C5 55 A5 C8 2B C5 CD A5 98' + '56 8A B5 A5 40 23 82 1B 11 D1 88 E8 46 F4 F1 E0 2A 0F DA 04 CA 88 40 F9 29 50 1A 03 A5 CC 2C 87' + 'CC 52 16 23 DB 63 24 6F 8A CC 9A 22 71 95 D2 BE 52 2E AD 94 CB 2A E5 8A 4A B9 A9 52 66 57 CA 2B' + '95 B2 A2 52 3E A9 94 CF 68 75 A5 7C 59 29 EB 2B 65 53 A5 EC AD 14 5D 95 B4 AC 92 CE 55 32 AA 4A' + '26 55 C9 23 55 B2 B8 4A 3E AD 92 CD 55 52 E7 DD 43 57 4B 62 B5 74 AF 96 2B AA 65 6A B5 CC AB 96' + 'B7 AB E5 8B 6A D9 52 2D 5B AB 65 47 B5 9C AA 96 C8 1A 89 AA 91 F8 1A E9 54 23 97 D6 48 6E 8D 5C' + '5E 23 D3 6A E4 B1 1A 99 57 23 F3 6B A4 A4 46 BE A8 91 75 35 F2 4D 8D 7C 47 89 7B A4 DF 1E 09 30' + '02 58 2F 9A AF E9 3B 3A 44 8F 39 30 DF 81 97 1C 58 EC 40 91 03 4B 1D 58 45 DF D3 29 D2 79 B7 9F' + '80 0E 53 75 98 13 88 B9 DE 17 DF 20 AC 0E C2 5A FA 3C 08 5F 04 61 5D 10 D6 07 61 03 D9 82 11 17' + '8C 4B 82 31 2E 18 D3 A8 3A 18 5B 83 B1 3D 18 BF 05 E3 8F 60 FC 19 8C BD C1 D8 1F 8C B0 10 8D 3B' + '04 43 43 50 10 82 65 21 F8 2B 04 87 43 70 9A A2 F4 88 D5 23 5E 8F 24 3D 92 F5 48 D1 23 55 8F 4C' + '3D C6 E8 71 B5 1E 9B F5 D8 A1 C7 2E 3D 02 0C E8 46 3D A8 8F 01 83 0D 18 4E 23 0D 18 6D C0 78 03' + 'AE 37 E0 41 5A 45 9F 1B B0 CE 80 8D B4 D3 80 5D 06 34 91 18 E1 FD 9F D5 83 FA 18 D1 D7 88 41 46' + '0C 36 E2 12 23 86 1B 31 92 A6 19 31 DD 88 3B E8 41 23 66 1B B1 8A 3E 37 62 BD 11 1B 8C F8 DA 88' + '8D B4 D3 88 5D 46 34 18 E1 31 42 4C 9A 1E D4 9B FA 98 D0 DF 84 E1 74 B9 09 57 98 30 DE 84 EB 4D' + '98 4D 65 B4 91 60 D6 04 52 2F 33 72 CC 18 68 C6 60 33 86 9A 31 DC 8C CB CD B8 C2 8C F1 66 5C 6F' + 'C6 83 B4 8A D6 D2 57 F4 BD 19 1B CD D8 69 C6 2E EF 4F 15 0A 09 45 F7 50 F4 08 45 9F 50 F4 0F C5' + '70 1A 1F 8A EB 43 F1 20 7D 4B 3F 86 A2 32 14 D5 D4 CE A2 E9 60 41 37 0B 06 59 70 A9 05 CB E9 43' + '0B 56 59 F0 B5 05 1B 2D 88 B1 22 D6 8A 8E D4 99 BA D2 74 2B 1E B0 22 DF 8A 87 AC 78 C4 8A 47 AD' + '78 D2 8A 17 AD 58 68 C5 2A 2B BE A2 4C 1B DC 36 64 DB D0 D9 86 AE 36 74 B3 A1 A7 0D BD 6C B8 D2' + '86 31 36 8C B5 21 CF 86 E9 36 CC B0 61 36 3D 6C C3 23 36 3C 49 AF D2 B5 11 18 17 81 F0 68 44 46' + '23 3B 1A 1D A2 31 2A 1A FF 8A C6 6D D1 B8 3D 1A 1F 46 E3 A3 68 7C 1C 8D D5 D1 F8 8A BE 89 C6 E6' + '68 6C 23 53 0C 42 63 F0 70 0C 1E 89 41 31 39 63 91 18 8B 94 58 B4 89 45 36 75 8D 45 F7 58 44 C7' + '21 26 0E F1 74 05 5D 19 87 B1 71 C8 A3 F1 74 63 1C 26 C7 E1 F6 38 CC 8C C3 2C 5A 16 87 B2 38 20' + '1E BA 78 74 A0 4E F1 E8 16 8F 1E D4 97 26 C5 E3 F6 78 E4 C7 E3 C1 78 BC 11 8F B7 E3 51 14 8F E2' + '78 94 C6 E3 DD 78 EC A6 3F E3 B1 27 1E FB E9 40 3C 0E C6 23 C3 8E F6 76 74 B2 A3 B3 1D E5 76 FC' + '68 47 A5 1D B5 76 EC B4 E3 4F 3B F6 D3 11 3A 61 C7 49 3B CA 12 70 32 01 8D 09 F0 24 A0 DC 89 7A' + '27 0E 64 E0 60 06 66 65 6A 6A 33 E1 C9 44 9A 1B 99 6E 2C 74 E3 65 37 A6 16 E0 B6 02 CC 28 C0 FD' + '05 78 AD 00 8B 0B 50 5F 80 83 05 08 28 D2 04 93 89 92 8B D0 BA 08 19 B4 AE 08 EB 8B 50 5B 84 83' + '45 F0 50 EB 62 64 16 63 50 31 46 16 23 BF 18 B3 8B F1 01 AD 28 C6 27 C5 58 55 8C D5 C5 F8 9D 52' + '4B 90 55 82 76 25 C8 2E 41 C7 12 74 2A 41 3F 1A 46 33 69 19 BD 5F 82 0F 4B F0 71 09 56 96 60 4D' + '09 D6 96 E0 73 DA 57 82 FD 25 38 46 BF 97 6A FE A4 FD D4 B2 51 83 26 58 9B E0 6C 42 DB 26 9C 16' + 'F1 AA 0D D0 DC A9 93 7B 75 22 46 D1 19 25 C8 28 C1 46 31 1B C5 6A 94 2E 46 E9 66 94 DE F4 BB 51' + '76 1B A5 55 A8 A4 84 4A A9 45 DE B1 C8 40 AB E4 5A 45 6C 9A 2E 36 19 68 93 59 36 79 D0 26 1F D8' + '64 85 4D 3E B1 C9 A7 36 ED 64 31 20 4C 52 C2 24 3D 4C 32 C3 A4 43 98 DC 4E F9 61 F2 60 98 AC 08' + '93 35 61 F2 4D 98 7C 1F 26 9B A8 6D B8 B4 0B 97 0E D4 29 5C 3A 87 4B 2F DA 4E BB C2 65 6F B8 76' + '4E 29 11 D2 3D 42 7A 44 48 0E 4D 88 90 C9 11 32 2D 42 66 44 48 97 48 E9 1D 29 7D 23 A5 7F A4 0C' + 'A4 B1 F4 41 A4 AC 8C 94 4F 69 6D A4 94 45 CA 17 91 F2 65 A4 BC DF 42 3E 6A 21 AB 5A C8 EA 16 B2' + 'B6 85 94 B5 90 AD 2D 64 5B 0B 69 1F 25 DD A2 A4 27 F5 8E 92 9C 28 29 A5 77 69 59 94 7C 14 25 1F' + '53 42 B4 38 A2 25 31 5A 92 A3 25 25 5A D2 A3 A5 6D 8C 74 8E 91 AE 31 D2 2D 46 BA C7 4A 8F 58 E9' + '45 FD A8 32 56 6A 62 65 4B AC FC 12 2B B5 24 71 62 8C 93 F6 71 D2 25 4E BA C7 49 AF 38 19 44 23' + 'E3 E4 8A 38 19 13 27 57 C7 C9 BC 38 79 21 4E 5E 8A 93 85 71 E2 B6 4B 27 BB 74 B1 4B 4F BB F4 A6' + '67 EC 52 68 97 12 BB 2C B3 CB FB 76 F9 C0 2E 1F D9 65 85 5D DA 25 48 A7 04 E9 46 3D 12 A4 67 82' + 'F4 4E 90 01 09 32 88 16 24 C8 D3 09 F2 3C BD 48 87 5B CA 91 96 52 3F 51 8E 4C 14 F7 24 E9 34 49' + '46 4C D5 CC 9F 2A CF 4C 95 DF E8 D5 55 F2 DA 2A B9 A9 42 6E A9 90 FB 2A 64 76 85 3C 5C 21 8F 57' + '48 49 85 BC 5B 21 7D 7F 94 FE 3F 6A A7 8C 9D B6 48 F7 2D 32 79 8B DC 41 0F D1 2B 5B 64 F1 16 79' + '7D 8B 2C DD A2 C5 6E 82 6B 45 5F 2B 31 B5 12 5F 2B AE 5A 49 AA 95 56 B5 D2 BA 56 D2 6A C5 BD 43' + '3A ED 90 7D 3B E5 C0 4E 29 FF 53 AA FF 94 FE 7B 64 E8 1E 81 58 0E 88 25 70 A9 B6 36 1B 34 DD A9' + '97 01 39 06 0C 31 60 98 01 97 1A 30 C2 80 D9 06 CC 31 60 8D 01 65 06 6C 30 E0 6B 03 BE 33 E0 7B' + '03 6A 48 67 D4 F4 32 22 C7 88 39 B4 C6 88 32 23 BE A1 EF 8C F8 DE BB 2A 9A A0 33 A1 17 E5 D0 20' + '13 06 9B 70 89 09 C3 4C 18 4D 6B 4C 58 6B C2 E7 26 7C 61 C2 57 26 7C 6D C2 B7 26 7C 6F 42 0D 89' + '19 3A 33 FA 98 D1 DF 8C D9 66 CC 31 63 0D 95 99 B1 CE 8C 0D 66 7C 6D C6 B7 66 7C 67 46 95 19 D5' + '66 04 84 42 17 8A 5E A1 C8 09 C5 C0 50 0C 0E C5 D0 50 0C 0B C5 68 9A 1D 8A 39 A1 D8 14 8A 8A 50' + 'FC 14 8A ED A1 38 14 8A C3 DE 1F 6F 45 6F 2B 66 51 BA 0D 19 36 B4 A3 2E D4 DD 86 1E 36 5C 61 C3' + '68 1B C6 DB 70 83 0D 37 D9 70 AB 0D 73 6C 78 C8 86 47 6D 78 C2 86 F9 F4 B2 0D 8B 6C 58 11 AD 59' + '13 8D F5 D1 D8 10 8D AF A3 91 14 8B D6 B1 48 8D 45 7A 2C DC B1 68 17 8B F6 B1 E8 12 8B D8 38 C4' + 'C5 E1 72 1A 4D D7 D1 F5 71 B8 21 0E B7 C6 E1 B6 38 04 C6 6B 3A 52 77 EA 19 8F 3E F1 E8 17 8F FE' + 'F1 98 4D AF 53 41 3C 0A E3 51 42 7F D0 DE 78 EC 8B 47 1D 1D 8A C7 E1 78 B4 B2 23 DD 8E 0E 76 74' + 'B4 63 07 1D A7 2C 37 DA BA 91 54 84 56 45 48 A1 FC 22 3C 58 84 0F 8B F0 65 11 46 15 E3 5F C5 98' + '43 1F 16 E3 A3 62 7C 5A 8C CF 8A B1 A6 18 65 C5 68 5B 02 77 09 DA 97 A0 43 09 86 D3 7D 74 3F FD' + '45 75 25 38 50 82 A3 B4 AB 14 BF 95 62 77 29 FE 28 C5 9E 52 EC 2D C5 3E 52 31 C2 00 9A 4D CB 6C' + 'F2 BE 4D 3E B6 C9 4A 9B 64 84 69 06 84 C9 C0 30 99 4D 1F 84 C9 47 61 B2 36 4C CA C2 E4 07 CA 08' + '97 AC 70 C9 0E 97 F6 E1 D2 91 6A C3 65 67 B8 04 44 88 2E 42 7A 45 48 EF 08 E9 13 21 FD 23 64 50' + '84 0C 8E 90 4B 22 64 78 84 8C A6 F1 11 72 7D 84 74 8C 94 CE 91 92 13 29 7D 22 65 00 2D F3 3E E1' + '22 E5 13 FA 2C 52 D6 44 CA E7 B4 B4 85 2C 6F 21 2B 5B C8 67 2D 64 0D B9 A3 24 3B 4A BA 47 49 8F' + '28 E9 45 EF D0 7B 51 B2 34 4A 56 90 33 5A 5C D1 D2 9A 32 62 24 2B 46 BA 90 3B 56 3A C6 4A E7 58' + 'E9 12 2B 3D 29 87 FA 52 45 AC 6C 8E 95 AD B1 B2 3D 56 7E A3 AE 71 9A D1 71 72 65 9C BC 48 6D ED' + '9A 5E 54 4C CB E9 43 9A 97 20 4F 25 C8 B3 09 F2 5C 82 BC 40 47 5B CA B1 96 32 72 AA 3C 3A 55 EA' + 'A7 CA C1 A9 72 63 85 4C A8 90 5B 2B E4 B6 0A 09 0A F2 3E 1E 1E E3 5B FB 9A 38 CD 36 27 6A 9D D8' + 'E9 C4 6F 4E 4C E3 EA 1E DC D3 FB 43 DC 40 57 20 2F 18 B7 04 A3 3E 18 27 83 51 16 82 6F 42 30 C1' + '80 A9 06 EC 36 E0 80 01 13 8C 98 6A C4 6E 23 0E 18 31 C1 84 A9 26 EC 36 E1 80 09 13 CC 98 6A C6' + '6E 33 0E 98 31 21 14 53 43 B1 3B 14 07 42 91 6B C1 18 0B CA 2D F8 D9 02 A7 15 A9 56 E4 D8 30 C4' + '86 05 36 2C B4 A1 36 1A 7B A2 61 8B 41 6C 0C 06 C6 62 44 2C CA 63 F1 73 2C F2 E3 30 37 0E 0B E2' + 'B0 30 0E B9 F1 18 13 8F 65 F1 F8 24 1E 39 76 0C B1 23 D7 8E 31 76 38 0B 90 5A 80 F2 22 FC 5C 04' + '14 C3 50 8C F2 62 FC 5C 8C FA 62 9C 2C 46 6E 09 C6 94 A0 BE 14 27 4B 61 F3 20 D6 83 25 81 52 1C' + '28 EE 50 E9 1A 2A 13 6C 32 D5 26 F5 36 39 69 93 4E 61 D2 3B 4C CA C3 E4 E7 30 A9 0F 97 93 E1 92' + '1B 29 63 22 A5 3C 52 7E 8E 94 DC 28 19 13 25 65 51 F2 4D 94 B8 A3 A5 6B B4 D4 C6 C8 9E 18 C9 8D' + '95 31 B1 92 6B 97 31 76 C9 4D 90 31 09 B2 24 41 8A 13 24 6F A2 DC 32 51 72 27 C9 98 49 F2 43 8D' + '78 6A 24 67 87 0C D9 21 F5 3B E5 E4 4E C9 DD 23 63 F6 48 7D A3 9C 6C 94 10 EF 7B 38 EA A2 50 1F' + '85 3C 17 66 BB F0 B0 0B 8F B9 10 E2 D6 B8 DC 48 75 A3 8B 1B DD DC D8 5D 80 03 05 C8 11 99 21 D2' + '47 A7 19 4A 15 3A A9 D2 69 81 DB 29 AD 44 3F C8 FB 93 BD 0F 7C 00 7C 42 AB 80 35 C0 11 03 4E 1A' + '70 9B 09 77 99 50 6F C2 21 13 EE 36 E3 01 33 AE 0C C5 D8 50 4C 0B C5 DD A1 48 B3 A2 BD 15 B7 44' + '60 66 04 EA A3 71 32 1A 5B 62 35 D3 9C 9A 19 4E DC E3 44 BE 13 73 9D C8 75 61 9C 0B 73 29 AF 15' + '5E 69 85 BD AD E0 69 85 3B 53 F0 6C 0A 4E 67 68 9E 69 87 E7 DB C1 99 8D D4 6C 0C CE C6 88 6C 8C' + 'CC C6 B8 6C E4 67 63 6E 36 96 67 63 6D 36 DC 45 E8 58 84 10 91 F6 22 77 88 DC 2D 32 4F E4 71 91' + '1D 01 D2 18 20 4E 9D 24 E9 E4 4A BD 8C D3 CB 3D 7A 99 A5 97 42 BD 2C D5 4B A3 5E 3C 7A 89 32 48' + 'BC 41 56 19 64 B5 41 CA 0C B2 C9 20 3F 1A C4 63 90 1C A3 0C 36 CA FD 46 79 C0 28 AF 1A 65 B1 51' + 'FE 32 CA 01 A3 5C 69 92 71 26 B9 DB 24 B3 4C 52 6C 92 A5 26 69 30 8B C7 2C 79 16 79 C0 22 09 56' + '69 6D 95 91 56 B9 CC 2A EB AD F2 9D 55 46 D9 E4 46 9B EC 08 93 23 61 D2 2D 5A BA 47 CB DE 18 39' + '14 23 57 D9 65 B2 5D CA 1C 52 E9 90 AB 27 C9 75 93 24 7F 8A BC 30 45 6A 7F 94 C3 3F 4A DE 66 B9' + '7B B3 6C F8 53 36 FD 29 D3 F7 49 E9 3E 79 77 9F 2C DD 27 CB F7 C9 87 FB 44 F6 4B E6 7E 69 BB 5F' + '7A EE D7 D2 B2 E6 83 62 08 F1 7E 5C 4E 5A 42 F9 51 1A EF 9F 1B 9D 68 4B E3 48 FB 35 E9 D6 12 DA' + '40 1B A7 C6 A4 FD 5A 36 52 28 A9 B8 DD C3 94 EA D4 98 03 C0 DF 1C C0 2C 60 B1 F7 47 45 7A FF EC' + '5D 42 30 82 82 61 A7 6D 64 0D D1 EC D4 6B 2C 31 1A 93 13 56 27 D2 9C C8 72 22 CF 89 1B 9C 98 E0' + 'C4 54 27 3C 4D 9A 93 1E 34 7A B0 DA 26 5E 1B C9 DD 41 BA 74 90 25 AB E4 CD 55 72 7B 85 DC 5B 21' + '2A 4A EE 84 65 16 2C 16 ED DF 1D 3F C1 B3 1D 56 9D F6 65 2D 3C 27 BC 7F B0 9E F6 58 BD AB C4 69' + '8F 2D 4C 7B F6 2C 0B C0 E7 01 F8 2A 00 15 01 A8 0D C0 6F 01 D8 47 75 34 43 A7 B9 97 C6 04 69 72' + '82 35 BF 07 63 77 30 8E 84 E0 68 08 1A 28 4E AF 69 45 6D 68 BA 41 33 D0 A2 F9 8A 4E D9 34 35 D1' + '9A 7E 31 9A C2 38 CD DD 76 DC 6F 47 46 02 26 26 E0 6E 7A 25 01 6B 13 30 DD A9 99 45 0B 9C 58 E4' + 'C4 CC 0C DC 9F 81 A9 99 9A B6 59 9A 20 B7 A6 9D 1B 1D DD E8 4E AF BA F1 9A 1B A7 DC 68 72 A3 C5' + '12 CD 89 B7 70 FA 2D 98 0B 34 B3 68 51 01 5E 2D 40 74 21 1C 85 98 46 8F D1 89 42 9C 2C C4 A6 62' + 'CD 6E 9A 56 A2 D9 46 87 4B 70 A4 04 D7 94 62 5C 29 6E A1 69 1E CD 6B 1E 2C F6 20 67 92 F4 9B 24' + 'CF 4E 95 C5 53 A5 76 AA EC 98 2A BB A8 F3 0E E9 B9 43 2E D9 A3 09 F7 BE 39 A2 84 3E A5 CF 44 53' + '26 F8 52 F0 5C 80 A6 3C 08 7B 83 70 20 08 87 82 E0 0C 46 EF 60 F4 09 C6 D0 60 4C 09 C6 D4 60 4C' + '0F C6 E6 60 54 51 5D 30 0E 04 A3 21 18 A7 82 E1 21 5B 88 26 3C 04 6D 43 30 3C 04 6F 87 60 39 7D' + '1B 82 BD DE EF 7C 3D 5A E8 91 A3 C7 95 7A E4 E9 31 51 8F 25 7A 7C A8 C7 0A 3D 36 E8 11 68 40 57' + '03 7A 52 2E 5D 69 C0 75 DE 87 98 01 F9 06 3C 6C C0 13 06 CC 37 60 81 01 CF 1A 50 64 40 89 01 CB' + '0C 78 9F 56 18 F0 89 01 AB E9 07 DA 6A C0 36 03 B6 1B B0 C3 80 7A 03 0E 1A 70 8A 82 8C 30 1A 61' + '35 C2 66 44 84 11 6D 8C 48 33 C2 6D 44 B6 11 ED 8D E8 68 44 27 23 BA 18 D1 D5 88 31 46 5C 63 C4' + '58 BA CD 88 19 46 3C 6C C4 93 46 CC 37 E2 69 23 9E 35 A2 C8 88 12 23 96 19 F1 BE 11 1F 18 F1 91' + '11 9F 18 B1 9A CA A9 D6 88 1D 46 9C A4 20 13 CC 26 58 4D B0 99 10 61 42 1B 13 D2 4C 70 9B 90 6D' + '42 7B 13 3A 9A D0 D5 84 9E 74 8D 09 D7 9A 30 CE 84 EB 4C 98 4E 73 E8 61 13 E6 99 F0 94 09 0B 4C' + '78 C6 84 E7 4D 58 68 C2 CB 26 2C A2 D7 4C 58 6C C2 9B 26 BC 65 42 91 09 25 26 BC 67 C2 27 26 94' + '53 90 19 66 33 2C 66 D8 CC 08 37 A3 8D 19 69 66 74 35 A3 27 5D 69 C6 55 66 E4 99 71 9D 19 F9 F4' + 'B0 19 4F 98 F1 94 19 0B CC 78 C6 8C 22 33 4A CC F8 C0 8C 8F CC F8 C4 8C D5 F4 2B D5 9A B1 C3 8C' + '83 66 1C 32 23 30 14 E6 50 58 42 61 0B 45 78 28 BA 85 A2 27 5D 4A 97 85 E2 8A 50 8C 0B C5 75 A1' + 'B8 37 14 B3 42 F1 70 28 5E 08 C5 CB A1 58 1E 8A 0F 42 F1 59 28 56 53 59 28 BE 0A F5 6E 70 E0 B6' + '20 DB 82 F6 16 E4 58 30 C0 82 07 2D 98 6D C1 43 F4 88 05 F3 2C 78 C2 82 37 2D 78 9B 0A 2D 58 66' + 'C1 FB 16 7C 60 C1 6A 2A B3 60 9D 05 5B 2D D8 6E F1 3E 76 34 39 56 0C B2 62 88 15 93 AD 78 CC 8A' + '27 B4 07 11 D2 6C E8 4D B9 36 5C 6E C3 55 36 5C 6B C3 75 74 A3 0D 13 6C 98 62 C3 34 1B EE B0 E1' + '41 1B 9E 22 84 61 70 38 86 86 63 78 38 72 C3 71 45 38 AE A4 AB C2 71 6D 38 F2 C2 F1 58 38 E6 85' + 'E3 C9 70 2C 08 C7 B2 70 BC 1F 8E 8F C2 B1 32 1C 6B C2 51 46 5F 84 63 7D 38 BE 0E 47 75 38 7E 0A' + '87 2D 02 E1 11 68 11 81 98 08 5C 15 81 FC 08 CC 8F 80 44 62 72 14 A6 46 61 56 14 1E 8C C2 CB 51' + '58 12 85 BD 51 38 18 85 13 DE 35 23 1A E6 68 58 A2 11 16 0D 67 34 DA 45 23 27 1A 23 A3 91 17 8D' + 'C9 D1 98 12 8D 69 D1 C8 8F C6 07 D1 D8 4A CE 18 F4 8D 41 FF 18 DC 1D 83 FC 18 3C 14 83 47 63 50' + '14 83 12 5A 16 83 A3 31 40 2C 5A C6 22 37 16 B7 7A 5F 03 62 31 C3 FB 42 16 8B D2 58 2C 8B C5 37' + 'B1 40 1C A2 E2 E0 8C C3 65 71 08 8A 47 FB 78 0C 88 C7 25 F1 98 13 8F 25 F1 78 2F 1E 4B E3 F1 69' + '3C 7E 8F D7 16 A7 24 3B 86 DB 31 C2 8E AB EC B8 CB 8E 3D 76 EC B3 A3 CE 8E C3 76 1C B5 E3 98 1D' + '0D D4 D1 85 2E 2E B8 33 71 53 26 F2 33 F1 42 26 96 64 A2 20 13 45 99 78 2F 13 CB 32 B1 22 13 2B' + '33 B1 26 13 65 99 F8 2A 13 5F 67 E2 87 4C 94 67 A2 3A 13 3F 65 E2 D7 4C 04 BB 35 3D A8 8F 1B 2F' + 'B8 B1 98 5E 77 A3 C1 0D 0F 05 B5 43 DB 76 68 D7 0E 4F B5 C3 92 76 58 DB 0E F5 ED E0 69 07 74 C0' + 'DA E1 C0 A5 38 B5 58 5B 8D 23 97 20 6A 09 9E 78 0B E5 6F E1 F8 5B C0 DB 30 15 C0 56 00 47 01 D2' + '0A 90 5E 80 29 B4 A4 00 BF 17 60 7E A1 E6 38 35 16 42 8A A0 2B 42 90 F7 F5 A6 08 C6 22 98 8B 90' + '58 84 9C 22 DC 5E 84 D9 45 F8 A0 08 87 8A 70 BC 08 8D 74 BA 08 4D DE 1F 56 8C E4 62 B8 8B 31 B0' + '18 79 C5 98 59 8C 87 8A F1 7E 31 6A 8B F1 5B 31 FE 28 C6 81 62 34 14 A3 A9 58 7B 5E B7 29 41 4E' + '09 FA 96 A0 7F 09 2E 29 41 5E 09 A6 96 60 7A 09 EE 2C C1 BD F4 40 09 96 96 60 39 7D 54 82 15 25' + 'F8 A4 04 AB 4B 50 46 5F D0 2F 25 D8 5A 82 DA 12 EC 2D C1 21 92 52 04 97 C2 50 0A 4B 29 C2 4A 11' + '55 0A 67 29 5A 97 A2 4D 29 B2 4A 51 56 8A 9D DE 2D DD 3B 78 B3 06 CB 6A F0 55 0D BE AB 41 63 0D' + '70 12 B7 36 60 5A 03 7E 6E 40 42 A3 C6 D1 88 36 8D 48 6B 44 A7 46 74 69 44 8F 46 F4 A2 9C 46 F4' + '69 44 BF 46 F4 6F C4 C0 46 2C 6F C4 E6 46 F4 3C 8D DC D3 98 7F 1A CF 9C C6 86 D3 A8 3F 8D C6 D3' + '98 D6 84 19 4D B8 B3 09 A7 9A 30 C1 83 A9 1E 4C F7 E0 55 EF EB BB 07 6B 3C F8 C2 83 0D 1E 7C EB' + 'C1 26 0F 7E F4 A0 C6 83 2D 1E 6C F5 68 5D 6E 26 ED 4C 5B 5A 43 DA 40 BA 41 7A 40 7A 42 7A 43 86' + '43 72 21 D7 42 F2 21 0D DE DF 07 C8 A2 00 59 12 20 E5 01 5A 26 D0 A1 93 4C 9D E4 E8 A4 AF 4E 86' + 'E8 24 57 27 77 E8 24 5F 27 AF EA 64 89 4E BE D4 C9 D7 3A D9 E4 FD EB 81 F2 6A A0 96 1E 4C 09 12' + '77 90 5C 1F A4 B5 D0 75 0A 91 9C 10 B9 3C 44 F2 42 E4 A6 10 AD 9D 2E 48 2F 7A 32 EA A5 A3 5E 3A' + 'EB A5 8B 5E 7A 50 6F BD 5C AE 97 3C BD DC A9 97 7C BD BC A6 97 5A BD 1C D2 CB 11 BD 1C D5 6B 59' + 'C4 16 06 71 1A A4 AB 41 F2 0D F2 B1 41 D6 18 64 AD E1 4C 7F 9E CD 28 11 46 69 61 94 68 A3 C4 1A' + 'A5 A3 51 F2 8C 32 D3 28 F9 46 59 64 94 32 A3 6C 30 CA 37 46 F9 CD A8 A5 19 3B 9A 24 C7 24 97 9B' + '24 CF 24 B7 99 24 DF 24 4F 9B B4 F6 BE C1 66 2D E5 98 14 2A F9 16 29 B6 C8 32 8B 2C B7 68 89 47' + 'BB 55 52 C8 6D 95 01 56 59 66 95 75 56 A9 B5 CA 31 AB E8 6C D2 D9 26 73 6C B2 D4 26 E5 36 F9 D3' + '26 BA 30 69 1D 26 FD 69 10 E5 86 C9 6D 61 72 27 CD 09 93 F7 C3 E4 F3 30 59 17 26 5B 68 2B 21 5C' + 'C2 C2 25 22 5C D2 C3 25 3F 5C 1E 09 97 C7 68 5E B8 3C 19 2E F3 C3 E5 D5 70 59 1C 2E 45 E1 B2 2C' + '5C 7E 0D 97 A0 08 31 47 88 35 42 6C 11 12 11 21 6D 22 24 2D 42 DC 11 92 1D 21 ED BD DB FA 08 E9' + '1A 21 3D 29 97 AE 8D 90 EB 22 B4 56 C5 0E 91 32 28 52 86 46 CA B8 48 B9 2E 52 F2 BD 3B FB 48 59' + '17 29 EB 23 65 03 E5 B7 90 F7 5A C8 4F 2D E4 97 16 5A 53 63 DB 28 E9 4F F9 51 52 12 25 2B 09 D1' + '12 17 AD 35 3B A6 C7 88 27 46 82 63 C5 40 E6 58 89 88 95 16 B1 12 15 2B 31 B1 D2 36 56 7A 53 1F' + '5A 12 2B 85 B1 52 12 2B E5 B1 B2 83 76 91 EA 98 34 C5 49 76 9C 74 A3 5C BA 26 4E E6 C6 C9 AB 54' + '16 27 27 D8 55 A9 B7 8B D1 2E 59 76 C9 A1 DB EC 32 DF AE 65 4D 83 13 44 9F 20 86 04 31 25 88 3B' + '41 06 52 5E 82 DC 98 20 37 25 C8 CD 09 32 31 41 E6 26 C8 4B 54 DB 52 0E B5 94 65 0E 0D 9C B2 30' + '49 F2 5B 49 BF 64 AD ED 32 AB 83 96 23 1D 38 50 6B 70 EC 32 51 72 26 CA D8 89 52 3E 51 F6 4F D4' + 'D2 9E 6D 27 C9 F5 93 E4 AE 49 72 FF 24 99 3F 49 CB 7C 0E 9D 2A B9 84 69 72 FC 51 2D C9 59 C5 24' + 'A7 FE 49 2D 8D D9 72 B9 E4 2E 97 51 CB E5 86 E5 72 D3 72 99 B6 5C 1A DF D7 9A 11 27 AE 92 69 AB' + '64 E6 2A C9 5F 25 8F AD 92 05 AB 64 E1 2A 2D 57 99 B1 43 2E A5 B2 9D F2 D7 4E AD A1 70 DD 9F 5A' + '13 A1 AE 4E 82 EA C4 51 27 AE 3A 49 AC 93 56 94 42 A9 75 92 5D 27 1D EA A4 73 9D 74 A5 EE D4 97' + '06 D1 10 BA 84 86 D7 C9 88 3A 19 59 27 A3 EA E4 32 1A 4D 63 E8 6A BA 96 C6 D1 75 75 32 BE 4E 6E' + 'A0 9B EA 64 62 9D 4C AE 93 DB EA 64 46 9D DC 55 27 F7 D4 C9 CC 3A 79 80 F2 EB 64 6E 9D 3C 5E 27' + 'AF D4 C9 EB 75 F2 66 9D BC 5D 27 C5 75 52 5A 27 9F D5 69 3D 8E DB 0A 02 50 18 D0 E1 E3 80 9C 8F' + '03 12 56 06 38 57 06 BC FE 43 C0 B2 1F 02 6A FF 0A C0 89 80 84 06 EF AE 4C 37 34 42 17 11 EC 7D' + '58 8D A3 DE 4E E4 38 71 19 B5 6F 42 87 26 0C 6F C2 88 26 F4 F6 68 22 BD 6B 3B 32 69 5E 90 66 0D' + '21 52 13 1C A3 B1 39 D1 C2 89 7F D1 7D F4 38 85 27 6A A2 B3 34 71 D4 2D 0B DD B3 90 43 76 B7 C6' + '4D 4B A8 5D 13 B2 9B 70 25 5D 4F A1 1E CD BB 16 F1 6A 71 89 B6 FB A4 AB E9 3E EA 66 D5 F4 A0 57' + 'A2 34 71 4E 4D 4B 1A 40 F7 D3 93 A4 4F D2 18 29 95 6E 4E D1 4C A4 C9 34 85 A6 D1 6D 34 83 D6 D3' + '6E FA 93 F6 D2 3E AA A3 39 A9 9A 87 E9 51 9A 4B 8F D3 93 34 9F 9E A6 67 E9 79 7A 91 7E A2 2D 74' + '8A 12 B3 34 AD A8 35 B5 A1 BE A4 77 6B 8C 64 26 0B D9 28 92 A2 28 86 E2 28 81 7A 9F D6 44 37 69' + '3A 52 67 EA 4A DD A9 27 F5 A6 3E D4 8F 06 D1 18 BA 9A AE 25 BD 47 D3 9D AE A6 71 34 9E A2 06 7B' + '3F C6 54 BA 96 EE A7 EE 56 4D 4F 5A 14 A5 19 E8 D4 3C 40 4F 91 21 49 63 A2 34 BA 25 45 33 89 6E' + 'A5 A9 34 9D 6E A7 3B E8 2B FA 83 F6 D0 5F B4 9F 0E D0 43 A9 9A 47 E8 31 9A 47 4F D0 53 B4 80 9E' + 'A1 E7 E8 05 7A 89 7E A6 5F E8 34 25 65 69 92 29 85 52 C9 E0 D6 98 28 94 AC 14 46 2D 28 9A 62 29' + '9E 5A BA E1 70 A3 D7 69 4D 4C 93 A6 13 75 A1 6E D4 83 7A 51 0E F5 A5 FE 34 98 AE A2 6B 68 2C 19' + '3C 9A 9E 74 2D E5 D1 F5 14 6D F2 7E 68 A5 14 E3 D4 C4 3B 61 77 C2 41 5D 29 20 4B 13 48 06 32 93' + '9D 9C 14 A3 C5 3F 3E A3 58 A7 26 81 BA 91 2E 4B 13 44 46 0A A5 04 72 51 EC 47 DE 9F C0 05 24 01' + 'C9 40 0A 90 46 19 94 05 B4 F5 3E 0F BC DF 4B DE 67 1A 90 03 5C 43 AF 53 21 AD 00 3E 06 D6 D2 03' + '3A CD A3 74 55 10 C6 05 61 2E 95 D1 97 F4 15 1D 0E C2 91 20 18 82 61 0C 86 39 18 A1 C1 88 A7 96' + 'C1 70 04 63 62 30 6E 0D 46 25 21 04 A1 21 38 1E 82 93 21 70 EB D1 4B 8F B1 74 83 01 37 1A 30 8D' + '4E D3 9D 46 4D 3D DD 65 D6 3C 44 47 42 35 23 2C 9A AB 2C B8 DA 82 40 2B C2 AD 88 A4 87 A9 DC 8A' + '4A 2B 7E B6 62 8B 15 43 6D 18 61 43 23 E5 45 E0 E6 08 4C 89 D2 FC 15 85 FD 51 E8 18 8D 4E D1 A8' + '8C 46 75 34 7E 8A C6 96 68 EF 07 88 A0 18 84 C4 C0 E8 DD 7E C5 62 80 77 8F 15 07 47 1C 96 C4 A1' + '20 0E 45 71 78 37 0E 57 C5 23 2F 1E A7 E2 E1 89 47 77 3B 7A DB F1 80 1D B3 EC 28 B3 63 83 1D 9B' + '29 CA 89 68 27 9C 4E A4 38 E1 76 A2 8B 13 DD 9D E8 E5 44 1F 27 FA 39 31 C8 89 91 BE 25 E1 72 27' + 'C6 3A 71 32 03 A7 32 D0 94 01 4F 06 A6 65 6A BC 1F 98 64 21 D8 FB 00 CB 82 89 2C 59 88 F2 7E 97' + '78 3F E7 2C C4 53 CB 2C 38 B2 90 96 85 AC 2C B8 B3 D0 35 0B 3D B2 D0 3B 0B 7D A8 5F 16 46 64 61' + '14 89 1B 3A 37 7A 52 23 35 BD 05 CF 5B 08 2D 80 B5 00 B7 D3 03 74 A8 00 C7 0B 30 A3 08 77 15 E1' + '87 22 6C 2A C2 89 22 34 14 E1 14 65 15 A3 6D 31 C6 D1 E7 C5 D8 58 8C 5F 8B B1 BD 18 D7 94 60 5C' + '09 7E 2D C1 F6 12 D4 97 E0 60 09 FE 2A D5 D8 9A 10 D5 84 58 72 D3 80 26 0C 6C C2 90 26 0C 6B 42' + '6E 13 46 35 E1 B2 26 8C 6E C2 B8 26 5C D7 84 9B 69 62 13 26 35 41 3C D0 79 10 E4 41 88 07 46 32' + '93 C5 03 AB 07 71 1E C4 7B E0 F0 C0 E9 41 0F BA 8E 6E F0 E0 46 76 14 05 88 2C D6 69 CA 69 6A 90' + '66 B4 5E E3 30 68 7A 53 AE 51 AE 34 CA 2C AA 37 CA 31 A3 74 35 49 6F 93 2C 34 C9 22 EF 1B BA 55' + 'C6 58 65 90 4D 86 DB E4 33 9B AC B2 C9 1A 9B 7C 6E 93 9C 30 E9 17 26 33 C2 E4 8E 30 59 1F 26 5F' + '87 C9 46 FA 85 B6 85 C9 F6 30 E9 12 2E 3D C3 A5 98 2E 89 94 11 91 72 55 A4 5C 1D 29 D7 D2 57 F4' + '79 0B A9 69 21 7D A2 A4 5F 94 E4 45 C9 E4 28 E9 11 2D BD A2 A5 7B 8C A6 7F AC 0C 8C 95 9D D4 3B' + '4E 06 C6 C9 CB 71 B2 28 4E 5E 8B 93 37 E2 A4 8F 5D 06 D8 65 9A 5D A6 DB E5 78 4B 39 D1 52 3C 0E' + 'CD B4 56 32 A3 95 4C 99 28 53 27 CA 51 EA 3C 49 BA 4F 92 FE F4 E2 14 79 79 8A EC 9C AA 59 BC 4A' + 'F3 E8 16 79 7C 8B 8C DD 23 E3 F6 48 9C F7 B9 80 74 EA 01 F4 02 66 D2 03 F4 0E 2D A7 1A 3A 4E C7' + '74 9A E0 60 E8 83 D1 DF A9 19 45 F7 3A 31 D3 89 79 4E 3C E1 7D 2A BA 34 39 2E F4 77 E1 12 5A E0' + 'C2 73 2E BC EC C2 2B 2E 2C A1 37 A9 80 DE A3 1F 5C D8 E4 C2 8F 54 49 47 5C F0 24 C2 99 04 57 12' + '66 D2 2B 49 F8 20 09 5B 93 B0 23 09 1F 27 6B 3E A7 13 C9 F0 24 63 6A 6B 4D 59 0A D6 A5 60 43 0A' + '7E 4F 41 7D 0A 3C 29 DA 0A 3B 3B 15 0B 53 51 93 8A AD A9 68 4C 45 53 2A 3C 69 70 A7 A3 7F 3A 06' + 'A5 63 58 3A 52 1B 35 E3 9B 34 37 78 37 BA 4D 30 79 34 76 0F 5A 7A 70 0D 8D A5 9D B4 C7 83 7D 1E' + '7C 5E 2D 5E BF 50 23 B5 A8 D1 74 A4 11 34 95 E6 52 31 7D 49 F5 75 72 B0 4E E2 5B 78 3F 84 56 F4' + '86 76 B0 81 F9 41 1A 53 B0 A6 29 04 9E 10 1C 32 E0 B0 01 8D 74 D0 A8 39 69 D2 F4 B6 68 7E 89 D6' + '2C 71 62 AD F7 D1 53 A4 39 75 5A 73 4B 93 26 D0 A3 A9 F5 60 87 07 BF 7B B0 DB 83 6D 0E A9 F5 7E' + 'EB EC D4 2C DB A7 B1 B7 F4 FE 2B 8C A5 3C 2A A2 A5 F4 21 AD A4 2F 02 B0 3E 00 3F 06 60 7B 00 7E' + '0F 80 F7 35 7A 3F 1D 08 80 27 00 77 E8 34 0F E9 F0 B0 0E AB 1D 9A B5 0E 7C EE C0 46 07 36 39 BC' + 'FF 58 6C 77 60 BF 03 07 1C 38 ED 40 93 03 AF B8 B1 C8 AD 2D 45 51 85 70 16 C2 55 88 B9 85 98 57' + '88 AB 4B 35 13 4B 31 A9 14 EF 37 E2 F3 46 F4 F2 68 72 68 17 35 1E 16 CF 61 49 F0 AE 61 28 A0 62' + '7A 8F 96 D1 EC 40 CD 93 41 78 2A 08 96 60 58 83 F1 2B ED A1 D3 DE FF B9 C1 38 16 A2 69 30 68 A6' + '99 34 87 4D 38 61 42 03 CD 32 6B 46 84 6A EE 21 B1 42 67 45 04 B5 B0 22 DA 8A 38 2B 1C 56 74 A0' + '4E D4 85 D6 58 B1 DE 8A 0D 56 7C 6F C5 0F 56 6C B2 A2 CA 8A 9F AC 78 CD 86 C5 36 2C 88 C0 C2 08' + 'DC 1A A5 C9 89 D5 FC 1A 0B 4F 2C AE 8B C7 C4 78 CC 88 C7 CC 78 6D 71 17 17 74 2E 04 BB A0 77 C1' + 'E0 42 24 45 B9 10 ED 42 4B 17 92 5C 48 A6 14 4A A5 2C EA E6 42 77 17 86 D2 30 17 86 BB 30 82 E6' + 'B9 F0 B8 0B CF BB B0 D0 85 45 2E 2C 76 E1 75 17 DE 70 E1 2D 17 DE 76 A1 D0 85 77 5D 58 EA C2 46' + '17 CA 5D A8 70 61 33 55 B9 70 98 6F 1A 21 49 30 27 C1 91 84 C4 24 B4 49 42 7A 12 EE 4B C2 FD 49' + '78 39 09 1F 26 E1 97 24 EC 4C 42 EB 56 C8 69 85 A1 AD B0 A8 15 F6 B4 D2 5E 4E 56 24 63 65 32 CA' + '92 F1 45 32 8E 7B DF 55 5A 63 4A 6B 4C 6B 8D 9B 52 F0 5C 0A D6 A6 68 FB 18 4F 1B ED 31 D4 36 1D' + '03 D2 31 30 1D C3 D3 71 7B 3A EE 4C C7 F3 E9 78 31 1D 9E 74 FC 9E 81 BD 19 C8 CD C2 C8 2C E4 67' + '61 61 16 5E C9 C2 61 BE E7 54 B5 45 7D 5B 34 B6 45 A0 5B 13 EE 46 84 1B 4E EA E4 46 67 EF 4B A2' + 'F7 E5 DE 8D 05 ED F0 74 3B BC D0 0E 8B DB A1 AC 1D 76 B5 03 B2 D1 32 1B 69 D9 18 94 8D 5C CA CB' + 'C6 AC 6C CC CB C6 B2 6C 94 65 C3 D3 1E 65 C3 E1 19 8E 05 6F E1 AB B7 D0 A6 08 E9 45 E8 54 84 CE' + '45 E8 4A 77 95 E0 9E 12 9C 3E AD F9 CD A3 F9 93 F6 7B 50 E7 C1 29 0F 4E 7B D0 59 A4 B7 C8 3D 22' + '73 45 9E 10 79 4A 64 81 C8 22 91 25 54 2E 72 4A E4 2E BD DC AD 97 AF 8D 9A DE D1 9A 2A 87 6C 75' + 'C8 0E 87 1C 74 48 8F 49 D2 7B 92 0C A0 45 AB 34 28 97 A3 E5 DA 0D 42 AD 2B 24 B5 42 6E A8 90 89' + '15 32 B9 42 E6 54 C8 43 15 F2 44 85 14 57 C8 7B 15 F2 67 85 D6 66 D9 E7 47 19 40 D8 2C 57 6C D6' + 'DA 2C 3D 3F 4B E7 2D D2 6D 8B DC BA 45 66 6C 91 3B B7 C8 9C 2D F2 F0 16 79 64 8B 8C D8 A1 79 67' + '9F 26 6B BF 06 F5 92 5E 2F EE 7A 79 B6 5E 96 D4 CB 7B F5 B2 BC 5E D6 D6 CB E7 F5 B2 A9 5E 2A EA' + 'E5 68 BD 84 1E 94 77 0F CA EE 83 12 70 48 6C 87 A4 FB 21 C9 39 24 83 0F 49 EE 21 19 79 48 F2 0E' + 'C9 8D 87 B4 B6 CC 86 C3 DA AD 44 35 C7 A4 F6 98 EC 3B 26 F5 C7 E4 D4 31 C1 71 B9 FD B8 E4 1F 97' + '9F 8E 4B ED 71 F9 EB B8 76 67 91 E9 84 D8 4E C8 A0 13 92 7B 42 C6 9C 90 BC 13 F2 E8 09 59 70 42' + 'DE 3D 21 CB 4E C8 F2 13 5A 63 E7 DD 27 E5 DE 93 F2 DD 49 D9 78 52 FE D5 20 79 0D 72 6B 83 4C 6B' + '90 19 0D 72 77 83 DC DB 20 F9 0D F2 48 83 2C 68 90 A2 06 59 D6 20 2B 1A A4 AC 41 BE 68 90 F2 06' + 'A9 6E D0 9A 42 9F 69 94 E7 1A E5 DB 46 69 B9 A6 F9 A2 2E D5 B5 AC 2A 71 AA 77 59 D5 E3 9A 2F F0' + '52 7D CC 2B 03 F0 19 0B A4 E5 7E 05 52 55 1A 9D C6 2E CC 3B D9 85 79 2F BB 30 FF E1 42 22 75 15' + 'D1 51 DE 16 34 9B 77 F7 B4 F5 5D EC 32 86 AF E0 3A 56 DF 54 88 AC E7 D9 21 B2 E6 4A DC 0D AC C4' + 'A9 40 D9 45 D6 E3 CE 09 9D A9 DA 9C 8A 9E F9 57 E8 76 B3 42 77 84 0F C8 53 7C 59 57 C1 B4 8B AF' + 'D6 A9 08 9B 7F CD 4E 05 56 54 E5 4E BD FA AB 80 DB 45 56 F1 CE 09 C1 F9 57 F4 76 73 0B A1 EA 7A' + '2A 1C 77 91 D5 BD 7F 08 D0 F9 57 FD 26 30 B6 F1 DF A9 FA FD 5D 1C 4F 55 03 55 28 6F 37 63 21 2A' + '9A F7 CF F5 41 15 DC F3 AF 12 AA D0 8F DA 44 CD 62 C5 70 F6 7F 56 31 5C C7 30 FA 39 41 3F FF 1A' + 'A2 8A 10 A9 4A 62 C0 85 2A 89 E7 84 01 2F E5 82 79 19 EB 89 13 58 4F 54 C1 C0 7F AE 2A FA C7 06' + '55 50 E9 10 B7 7F E7 54 1B 07 72 37 78 F5 7F B5 E6 A8 E2 06 2A FC D4 5C 7F 54 CB F8 39 0B 78 2F' + 'BF 8A A4 8A 2E AA 0D A7 AA 4E 9E B3 BC 6F 61 BD F2 82 C1 C6 DE 0C 36 36 D7 2E 9B EB 95 FE F1 C6' + 'A7 18 6C 7C ED BC 8B 9C CA 6D FF 67 AB 99 79 8C 18 A9 9A A6 BA 34 4A F5 D4 4A E4 59 95 CD 0B D6' + '34 D5 76 FA EF 2A 9B E7 87 34 2B B9 E5 56 15 4F FF 90 99 F3 22 EA 9E 7F 17 F0 1C F8 37 F5 D0 72' + 'C6 A5 54 55 54 85 40 5B FE 63 08 D4 3F DC B6 84 DB FE 40 56 51 2F 18 0B BD 24 5E 0B C0 35 BF A6' + 'CD 3E 2F 1C FA 1E 2B AD 7F 17 11 3D 15 FF 1F 11 D1 EE 0C CF 0D 67 07 73 F3 75 5D CD C7 0A 2A 40' + '7A 4E 7D F6 B8 AF 3E 0B 06 61 D0 52 EB FE 54 17 1E 39 D9 F7 A9 AE 3A 52 DD 9F 17 BC F0 48 75 82' + 'AA BE CF 55 E7 F5 7D 7E EF D7 F7 F9 0B FB 3E F7 F9 F5 7D 9E 72 30 44 E4 BC 40 00 C7 FF 82 24 23' + 'FB 41 2F E6 6A A4 B6 BE 3E 51 75 35 92 EA 13 F5 BE A8 E6 31 79 D7 29 09 F7 26 E1 79 52 AF 93 EF' + 'B4 D6 9C 79 61 E4 F5 49 AA 97 34 8F 5D 8F 7F B1 DF F1 D0 DF F4 3B AA 5A F6 54 1E B8 FC D7 2A DA' + '41 7E 49 40 15 E9 55 F1 A2 2E 7E 35 EE 57 FD 6A DC A7 CE AB 71 2F F0 D5 B8 ED D9 5A 24 6F 04 5F' + '39 EF E3 5B A7 7A E5 FC 2E 1B E5 D9 B8 B3 3D EE 6B 8F 6D ED 51 DB 1E 4D ED CF AD 86 AB 3A B8 99' + '15 F0 74 DE 67 34 85 77 09 BD CA 0A F8 01 DF B1 4E 22 7B FE E6 B2 F7 EE 0B F6 DB 1D BD 50 35 BC' + '39 92 EC E6 8B AD AA 8C E7 33 98 FC 03 A3 9C 87 58 13 07 6B E2 59 AC 89 AB C0 F2 38 56 C6 E7 B0' + '32 7E 4E 6C 79 23 73 52 3F F3 C0 E8 37 A6 A5 9A 6B E5 FE 71 66 FF BA B9 8A 36 AB 90 E8 35 BE 80' + 'F3 C5 D4 CD 55 FC F9 E8 7F 56 31 77 AB 58 D6 D9 E1 E8 7D A5 67 02 A9 17 A8 A4 FF F4 1F 95 74 FF' + '4E 44 75 7D 8F EA 47 9C F0 3F 54 01 57 57 E2 04 90 0A 61 AA 4D C3 93 DC 2E A8 2D C2 39 55 F2 24' + '56 C9 87 9E 5D 1F 5F EC AB 8F 6B 29 54 D6 C7 55 C4 56 5D 33 A4 FA 26 FD 2B E6 EA 98 EC 02 75 73' + '5F 54 BC B3 ED CC 71 98 8A E7 CE F6 0B 8C 7F C6 A3 31 95 37 54 95 68 15 DE 55 F5 68 15 27 EF E4' + '57 8F 9E C1 7A F4 6C 5F A8 5C 1D A2 FD C0 98 EF F6 B0 33 F1 CE E6 AA F4 39 31 73 75 B8 F6 0F 75' + 'EA 62 5F 9D 5A 05 D2 55 68 58 C5 D2 2F B2 72 7D C1 E8 BA AA 65 AB 00 FB B5 0C B0 E3 BC 00 FB 20' + 'BF 63 BE E6 1A F7 05 23 ED EB 58 EF 56 21 E6 FC F3 E2 ED 9F FB 2A E0 E7 84 DC FB B0 1A AE 42 CF' + 'AA 26 7E 7E EC 5D 55 C9 55 24 5A D5 CA FD 83 F0 6E 6E 28 E1 17 87 57 07 8E 4B 18 A3 FD 87 7A FA' + '39 91 F9 DE 0C CB AB 63 4A 15 B6 6E AE B0 37 C7 E7 77 30 3E AF 2A EC 21 71 A2 F7 D5 D9 BB B2 CE' + 'AE 8E 35 55 B5 5D 85 EB 55 CD 5D 45 EC 5F E6 41 E7 39 95 77 15 BA 1F 60 D7 82 DD 93 79 00 3A FF' + '42 01 FC BF AB C8 AB 20 F8 39 75 F9 73 A2 FA AA 46 AF C2 E2 AA 52 7F 94 07 AC AA 5E AF 02 C6 1E' + '87 56 B5 57 C9 6E 75 E4 EA 5F C1 57 79 DB F3 EB F8 2A 7A AE 0E 67 55 4D 5F 1D D1 AA CA 7E 67 6E' + 'E8 55 30 5D 05 98 FD 6B FD 39 3C BA 6D AE F8 3F 3A F5 02 01 52 D5 58 F0 DF 4F 02 A8 43 05 75 40' + '7C CE D1 C2 04 1E 2D DC 76 A1 A3 05 FF A0 35 7C 5D D7 FF 7C 49 D9 F9 7D D8 17 BC AA AC E5 3F 5E' + '55 36 AA 4A EB C3 2E F2 F5 61 AB 0E 6C D5 7B AD BA AE 55 BF F5 77 35 FF 74 D4 F1 F8 96 33 F9 07' + '15 C2 55 2D 01 97 F2 F0 43 65 21 54 7B 80 ED A0 64 1D 14 F7 41 B9 E5 A0 4C 3B 28 EF FC FD 21 C7' + 'C5 E7 0D FC 93 D6 0E 2D 8B 9D C6 6C B7 53 FB 32 D3 A9 71 69 BD 03 2A 5C 70 7E 05 AE 39 06 7C 24' + '48 EB 06 D9 1B 72 56 DA BA 29 44 8B F2 9E 9F B9 56 15 38 15 F1 55 75 38 2B 43 E5 FF 56 48 6C 44' + '23 2E 26 52 35 9A 61 2A D5 23 E0 1F A9 6A D4 6B 9D 02 2A 52 A5 EA 31 2A 58 B5 CA D7 35 70 C1 60' + '95 EA 23 50 95 9B 3C F6 11 94 31 58 F5 17 EB 37 FE F1 AA 2B 19 AF BA 9B F1 2A 55 D1 51 FD 05 2A' + '6A A5 6E D9 53 D7 06 A8 8E 03 15 BB 52 91 8A E6 F0 55 0A 03 57 DF F9 02 57 2A 12 A3 FA 08 C0 C6' + '7D 95 D7 56 7D 23 AA 8E 92 D8 CB FB 71 E9 59 11 51 C7 F6 A1 BE C2 A8 9D 85 D1 A1 AC 8A AA 8C 76' + '95 2F 22 DF 9C D1 0E 65 DC FF 82 E9 EC F3 B3 D8 B9 3C 0F BF 60 52 EF D4 D9 49 3D 95 2C 53 09 B2' + '91 2C 6C 4D F7 B5 3E 68 4D 0F FF 2B 32 3E 49 DA 2F 99 74 A7 A6 95 F6 65 16 3B 24 92 B5 2F 33 9C' + '9A D6 A1 CD 4D 54 FE AD 38 AA 95 EA FC 76 9A C7 D8 42 A3 9A 93 54 EB 8B 6A 18 C2 41 31 1E 3C D3' + '24 94 62 68 2E 9A A9 28 D0 BD 8C F9 CC F3 8B F9 34 97 92 AE F7 15 91 54 78 A7 8D 77 3F 7B A6 5E' + 'AF 4A 3D CB 58 5D 53 05 1F 55 52 9F 48 17 53 F0 71 3B D1 C1 79 A6 EC A3 0E FD 23 12 35 5D 78 30' + '3D 8E 35 D6 5B 58 5D 55 75 D5 BF 2B 01 A5 6A 8D 2F AA 09 45 F5 99 4D 0A C6 64 5F 2B 8A 6A 42 51' + '1D 5A AA 3F 27 4D FB 3F 7A 4E C8 A0 9B AF 67 C6 CC 4C 80 EA 96 51 B5 C1 5C 5F DD D7 EB 72 3A A7' + 'AC EB 95 6E 51 DD 31 7A C0 A2 B5 E3 6B 3D 32 0F 01 8F B0 53 46 35 C9 34 B7 C1 84 FA 1A 60 26 FA' + '35 C0 FC 5D A3 4B 86 D6 DD 62 20 13 39 28 D3 A8 FE 72 A8 AF E1 47 B5 EA 9C DF F6 D3 86 CD 3B E7' + '37 FF 64 AD 52 D1 8B 44 AD 96 A1 85 2E BA 33 62 71 35 6B 67 F7 B1 7A AA 82 16 AA 2E C5 DD 85 56' + '97 6A AE A6 AD 60 35 ED 33 46 2F FC 6B AB 9F 04 E0 D3 00 AD CA B6 C9 AF CA D6 5C 5F 9B C1 FA 9A' + '8A 6A A8 2A 9B 0A 6C A8 8A AC 4A A4 A9 72 57 70 30 42 82 2F 50 F4 3A C6 30 86 7F 89 4B 35 9F 75' + '63 D6 48 15 A5 54 9A ED 15 E6 8E 54 F3 19 18 90 50 65 2A 15 93 50 C5 AA 8B A9 F1 D9 18 8A E8 C8' + '20 C4 00 86 1F 66 32 C5 F4 04 53 4C FF 50 E2 8A F9 FB 12 97 2A 6E A9 EA F2 50 16 B7 9A DB E0 1E' + '67 A5 39 2C 11 91 89 E8 C8 EA D4 73 49 78 C1 AF 28 95 D7 0A 8F B2 49 AE B4 35 DE 6D 7D A6 36 7C' + 'C1 52 D3 49 C6 33 C0 40 C5 DF 15 9C 84 05 27 3D 4B 4D 2A BD A7 0A 4E 3D 59 70 52 F5 4D 95 E7 53' + '31 0C 55 76 4A 60 D9 29 97 4D 78 33 B3 F1 80 AF 09 EF FB 6C 6C CA C6 5D ED 71 6F 7B FC DA 1E DB' + 'DB 6B F5 A7 73 4A 50 E7 44 38 66 15 68 F5 53 97 AF 49 49 15 A8 54 9C 43 D5 4F 7B 31 D4 A6 0A 54' + '36 5F 30 63 44 13 46 D2 65 74 05 53 4F 79 8C 64 A8 CA B7 0A 66 4C F2 05 33 02 3C 08 66 24 23 9E' + '01 8C EE AC C3 5E CD E8 C5 4E 5F D1 AB CE A3 F5 A1 9D F6 78 F7 B1 DA 6F 39 AC 75 F9 17 BA 54 0C' + '43 C5 2D 54 4B 9F 8A 40 F8 17 BA 54 50 E1 FC 92 95 AA AF AB CA BA AA A9 AB 6A BA 7F 1D FD 62 CA' + '54 A6 83 62 3D 28 6D 69 E2 41 99 CA AA 95 57 73 81 EA FF C1 D2 54 5B 6D 35 9B C0 8E 3F B7 F6 E5' + '4D 4E 4D 3B ED CB 9B 9D 9A 6C ED CB 5B 9C 9A F6 DE 6D C0 99 E7 98 2A E1 AB 32 96 2A E4 BF CF 62' + 'D6 4A 16 B3 54 2F 6A 19 B0 1E D8 00 6C 02 2A 58 DE FA 19 D8 A6 F5 03 E2 77 E0 0F E0 00 70 90 05' + 'AF 93 C0 69 DE DD 6B E5 10 9A 64 0E 92 51 33 63 3A 73 48 4C 0E 87 C1 0C E1 E8 97 91 1C F4 72 23' + '47 B6 CC E2 18 95 D7 39 28 65 19 07 A2 6C E5 50 93 5D 1C 61 72 94 E3 49 E2 39 32 C4 C1 01 21 ED' + '03 B4 BE C3 95 01 F8 29 00 DB 7C 65 B5 1C 1D FA E8 D0 4F 87 FE BA B3 FA 0E 9B 1F 85 FE 05 B5 05' + '3A 94 E8 B0 4C 87 6F 7D 97 9E 56 EB 50 AF C3 21 8E E5 38 CA 99 1C 5E 08 84 04 42 47 21 64 0E 84' + '25 10 B1 D4 95 72 03 31 32 10 FF A2 D1 74 4D 20 C6 72 08 C7 5D 1C 62 F1 05 07 54 6C E6 50 8A 1A' + '8E A3 D8 CE E1 13 7F 70 D4 C4 51 8E 91 38 19 88 47 83 34 89 C1 68 1D 8C 3B 82 71 77 30 CA E8 0B' + 'DA 4C A9 06 4D 3B EA 40 57 1A 30 CE 57 9E 6B 2E C9 79 B5 67 89 AD 13 8D 31 E2 6A 5F 59 6D B0 5F' + 'E9 4A 15 AD 9E 23 55 60 1A CC CB 89 CA C8 FF 5E 07 55 B2 D9 42 5B 43 F1 6B A8 56 67 69 CF BA C9' + '07 2C 91 6C B3 C0 6C D5 F4 A3 E1 34 8A 46 D3 35 74 0B DD 4E 77 58 71 8F 15 0F D2 B3 F4 2A BD 41' + '85 F4 0E 7D 42 AD 6D 1A D5 03 1A 1C AF D1 93 91 CC 64 A1 70 6A 3E 90 F7 CA F1 1D CB 7B 65 24 20' + '2B 01 EE 04 74 4B 40 8F 04 0C 4F C0 88 F3 3A 47 D1 12 AF 70 88 C2 C9 96 DA CB C0 7F E7 F0 5C 1D' + '98 37 1F 95 6F E3 B2 D7 7C 54 EE 5D FC D4 5B 44 18 45 53 2B EF 2B A9 EF 8D A2 3D 5F E0 3A 39 D1' + 'D9 89 1E D4 8B 06 39 31 C4 89 D1 A4 DE 3A A6 F1 B0 7D 06 97 4C 75 D8 5E 44 E0 DA 19 C4 23 77 83' + 'EF C8 3D CA 77 E4 EE 74 21 F1 1F 0F DE DB 71 2C 41 57 DF 6A AA 8E DF BD 4B E9 2C 5F 47 B9 8A 6B' + 'A9 70 D6 46 86 B3 02 13 35 06 32 53 2B 6A 4D 19 89 C8 4C 44 DB 44 B8 13 D1 87 FA D3 20 1A 42 79' + '34 9E 6E 4D C4 F4 44 CC 48 C4 1D 89 B8 3B 11 F7 24 22 3F 11 0F 26 E2 A1 44 3C 9C 88 C7 12 31 37' + '11 EF 24 62 69 22 6A 13 B1 2B 11 7B 13 B1 3F 51 8B A9 A7 25 69 0B B9 77 15 37 A7 69 66 A4 E1 CE' + '34 6C 25 FF 3E E0 C5 59 9A C3 7E CB B6 7A 7F EB 44 AA 95 7F 18 5D 4A B9 34 8A 2E A3 2B E8 4A BA' + '8A AE A1 B1 94 47 E3 E9 46 BA 89 6E A1 69 6E 4C 77 E3 76 37 66 B8 71 A7 1B 77 B9 71 8F 1B F7 BA' + '31 D3 8D FB DD 78 8E D4 2B C2 6B 2C 19 BC 43 EF D1 32 7A 9F 3E A4 15 B4 92 3E A5 55 B4 86 CA E8' + '0B 5A 4F 1B E8 1B 2A 77 A3 C2 8D CD 6E 54 BA 51 ED 46 8D 1B 3F BB B1 C5 8D AD 6E 6C 73 E3 08 1D' + '67 C1 A2 89 05 0B 55 AA 78 86 49 19 95 91 71 FA 32 32 0F F0 DE 00 EF 4B 89 EA 93 56 1D D2 AA 37' + 'DA BF FB D9 BB 60 84 36 C0 46 E1 D4 A2 01 2D 1B E0 A4 44 4A 6E 40 EB 06 A4 35 5C F8 98 BD F9 5C' + 'E2 BF D6 B6 76 CA EF 75 A7 3F C3 F9 2A 7B 3A C1 F7 66 E3 DD 2A DF C6 DD 72 F3 86 59 FE F1 30 BF' + '96 1B 27 F5 A2 F3 B2 4D BC 16 51 29 65 85 49 DB 30 ED D0 78 58 84 76 E4 BB 8A A7 BE 5E 9F F2 80' + 'B7 0B 0F 51 C7 32 A7 F3 59 85 94 55 FC DF 39 2E FB AE C6 B7 9D FD DF D1 E0 C3 4D 79 F3 01 DD 08' + 'BE D2 4D 3E 28 0B 08 87 2E 7C 4C A7 36 F1 EA 38 AE 83 76 73 C3 99 9D 2B 97 B8 10 A7 46 3D B0 D5' + '43 BA 63 8A B0 CD 26 D5 D7 69 A3 1A 35 54 BF 8D 6A D7 50 BD 00 2A CA BF 26 00 6B B9 81 FB 92 1B' + 'B8 CD 01 38 18 80 43 01 88 D1 21 56 07 3B 75 A5 5C 1D 46 EA 70 99 0E 97 EB 30 5A 87 2B 75 BE AD' + '5B 08 42 42 70 5C 8F 06 FD 99 C4 E0 B1 04 9C 48 40 13 59 78 66 17 C3 86 01 3B 1B 06 D2 78 FA 91' + 'C9 83 8F AE 6C 1E 18 C0 66 91 61 4E 0C E7 4B E3 4D 6C F8 79 80 0D 3F DE F5 A3 DC 89 0A 27 AA 9D' + 'A8 71 62 9F 13 07 9C DA 86 C9 EB 19 F2 3E F1 5F F3 05 74 55 2C 50 05 74 8B 5D 78 C7 85 65 2E 7C' + 'E0 C2 2A 17 D6 B9 F0 95 0B 1B 5C F8 86 BE F3 2D 0F E5 BE F8 EE 16 17 B6 B9 50 4B 3B E9 37 17 76' + 'BB F0 27 1D A1 63 2E 9C 70 A1 C1 85 46 17 4E BB D0 E4 FD 27 26 E2 CD 44 94 D2 37 89 F8 3E 51 6B' + '4F B2 26 C1 CE CC 61 6B 4A 65 EC 70 40 12 06 33 0C 5C 9C 84 D2 24 BC 9B 84 65 49 58 9E 84 95 49' + 'F8 24 09 6B 92 B0 36 09 DF 25 E1 FB 24 EC 49 C2 DE 24 EC 4F 42 5D 12 8E 24 E1 68 12 CC C9 48 4F' + '46 66 32 B2 92 D1 2E 19 D9 C9 E8 98 8C 4E C9 E8 9A 8C 6E C9 E8 99 8C 5E C9 E8 97 8C 81 C9 18 92' + '8C A1 C9 18 95 8C EB 93 71 6B 32 6E 4B C6 0C BA 93 EE A6 7B 69 6E 32 16 24 E3 F9 64 BC 94 8C 97' + 'E9 D5 64 BC 96 8C C2 64 14 31 00 F9 19 03 90 EB 93 51 9E 8C 8A 64 54 27 A3 26 19 5B 93 B1 3D 19' + '3B 93 F1 7B 32 FE 48 C6 DE 64 EC 4F 46 5D 32 EA 93 D1 C0 3C B3 57 5C 6B D8 5B A3 25 BD D6 1A 8B' + '5B E3 F7 D6 D8 DD 1A 96 14 CD CD 6C E8 59 CF 86 9E AA 14 54 A7 60 5B 0A 7E 4D C1 4E 36 F1 1C 49' + 'C1 B1 14 9C 48 C1 C9 14 34 FA 82 D0 BA 54 04 A5 22 24 15 E6 54 84 A5 22 32 15 CE 54 B4 A7 4E A9' + 'E8 9C 8A BE A9 E8 97 8A 01 A9 18 94 8A 61 A9 18 9E 8A 11 34 32 15 E3 53 71 03 4D 48 C5 AD A9 98' + '9E 8A 3B 52 31 33 15 F7 B3 D1 EB 19 B6 6C BD 94 8A A2 54 2C 4D C5 07 A9 F8 30 15 15 A9 F8 31 15' + '95 A9 A8 62 2B D7 2F A9 F8 33 15 7B D8 CA 75 3A 15 99 69 C8 4A 43 87 34 74 4C C3 C6 34 FC 90 86' + 'DF 29 28 5D 63 49 47 58 3A 22 D3 11 9D AE 45 B5 FB 32 1D 3A 2C 1D 79 34 9E 26 D2 64 9A 46 B7 D1' + 'BD 34 93 F2 69 36 3D 44 8F D0 63 34 8F 9E A0 A7 68 41 3A 9E E5 79 80 D7 4B F4 32 2D A2 D7 68 49' + '3A 3E 4E C7 86 74 7C 9D 8E 3F D3 B1 2F 1D 75 14 C0 A6 1D 03 9B 76 CC 6C DA B1 B3 69 C7 C9 56 A7' + '4E 59 E8 9C 75 26 C5 7A A2 2D 4E B6 D5 0E 0F C2 D8 96 16 EF 46 61 36 8A B2 B5 4E 8B 2F 8A CF DA' + 'BE 3B 9B 90 DC 84 94 26 64 34 21 8B 97 23 76 F4 AD 6A 83 D9 72 36 96 9D 66 06 5F A7 99 6A 5D 52' + 'FD 66 AA 81 69 1C 1B 98 C6 B3 81 69 0F FD 45 2A 77 3A 8D 35 A1 DB 28 B8 42 42 2A 64 68 85 0C AF' + '90 C1 47 64 C8 11 09 3D 2A 96 A3 D2 EF A8 F4 3F 2A F7 D1 FD 34 97 5E 3A 2A AF 1E 95 DD 47 65 CF' + '51 D9 77 54 0E 1C 95 C9 C7 34 53 48 DB DE 9D 90 00 0A A4 60 D2 93 91 6C 14 4E 91 14 45 31 14 47' + '76 6A 49 4E 4A A4 56 D4 9A DA 50 1A 65 50 16 B9 29 9B 3A 50 27 EA 42 DD A8 07 F5 A2 1C EA 4B FD' + '69 20 E5 D2 28 CA A3 F1 74 33 4D A4 69 74 1B DD 4D F7 52 3E CD A6 05 F4 0C 3D 47 2F D0 4B F4 32' + 'BD 71 42 4A 4F 48 FC 49 B1 9F 94 9B 1B 35 13 69 32 4D A1 99 8D 32 AB 51 1E 6D 94 27 1B E5 A5 46' + '59 D8 28 8B 1A E5 ED 46 29 6A 94 77 1B E5 FD 46 F9 A0 51 3E 6A 94 15 8D F2 49 A3 7C DA 28 1B 1A' + 'E5 EB 46 69 03 4B 2A 2C 57 D3 B5 74 1F DD 4F 9D 82 9B CF CB FB 00 03 99 86 9D 80 33 27 E2 2E 0F' + '5A 33 F9 30 D0 83 CE DA 31 70 22 A5 90 FF 2A 18 E3 EB 85 F3 AE 46 AA 2F D3 CC 86 BE 04 B6 EC F5' + 'E1 F7 6E 00 8F 95 42 48 7D 5F 76 99 0E DF 52 DB C3 D7 90 D2 EB E2 96 5D 75 7E A9 CE 2C FD 17 41' + 'FF 85 2F 87 9B 1C E1 06 46 9F 88 D0 44 ED 98 D0 AB 45 22 A2 12 11 97 88 84 44 38 12 91 78 F6 96' + '26 3D 11 ED 13 D1 95 BA 27 62 58 22 46 25 E2 F2 44 8C F3 DB C6 DC 90 88 49 89 98 92 88 27 12 31' + '3F 11 CF 24 E2 25 52 CB 59 41 22 56 26 62 4D 22 D6 72 51 DB 98 88 F2 44 54 24 A2 9A 9B 99 FA 44' + 'AD C3 45 CF 3E 4E D5 E7 A2 B6 37 EA C1 5E 46 5F F2 F1 FE 75 0A BE 49 C1 77 29 D8 98 82 CD 7C D4' + '6F F5 7B D4 CF E1 83 F7 95 54 2C 49 C5 1B 7C FC AE A4 B2 54 AC 4F C5 37 F4 C3 D9 8F E2 AD A9 D8' + '41 BB 52 F1 BB EF B1 7C 24 15 27 7D 0F 67 63 1A EC 69 68 99 06 57 1A 5A 51 6B 4A A5 74 BF 47 77' + '8F 34 F4 4A C3 E8 34 5C 99 86 1B D2 70 63 1A 26 A6 E1 D6 34 4C 4D C3 B4 34 DC CE 1D DA 3D 69 78' + '33 0D 05 69 78 37 0D 4B D3 50 ED DB B0 FD 4A 3B D3 B0 3B 0D FB D2 50 97 86 C3 74 3C 0D 8D 69 38' + '4D 4D E9 9A 7F 7E B4 FA 3F 48 D5 23 F1 86 26 DC E8 7B 30 DA 7D 8D 3C 2D 2F EE 21 F9 CF 27 8E 5D' + 'DF 56 17 7A A9 80 F7 AC F3 CE A0 54 A8 DB 3F C8 AD 8E E6 E7 07 69 97 74 6F 38 BB 86 0B 5F 99 50' + '15 02 87 B2 04 B8 3C 44 AB ED 36 F0 C6 ED 4C BF EA ED D5 BE EA ED F9 A5 C1 CD FA 8B 8D 7F AF E2' + '45 DB CD F1 EF F3 83 DF BB 18 FC 56 57 6F FF 5B 61 6F 75 49 77 AF BF B9 A4 FB 9C 10 F8 9D BC AA' + 'FB 22 83 DF AB 7C 17 79 AB E0 F7 46 BF E0 F7 2E 06 BF 0F 32 F5 AD 2E F5 BE C8 E0 77 0F 5E F6 DD' + '1C F9 56 57 7E FB 47 BE AF F7 45 BE 67 FF F7 22 DF FE 61 EF 8D E7 85 BD 1B 78 99 F8 DF C5 BC FB' + '5F E8 62 F1 E6 C8 F7 F5 7E 91 EF 7F 88 79 AF 3A 3B E6 BD F1 BC 98 F7 AE B3 63 DE 38 3B E6 DD DF' + '2F E0 AD A2 DD D7 FB A2 DD 0F 5E 44 B4 5B 5D 5C BE C9 EF E2 F2 0B C6 BC BB B1 BA 79 31 D1 EE 73' + 'E2 DC EA A2 F3 73 42 DD CD E1 ED E9 7E D7 9A AF 39 3B B0 FD FF 73 DC FA 5A 5F DC 7A E1 D9 71 6B' + '44 6A 0B D7 39 41 EB 48 06 AD 55 C4 FA 5F 67 47 AC D5 E5 E9 F9 BC 24 5D 45 A9 9B 0B 75 96 98 73' + '63 D5 E7 44 A9 9D BE 10 75 F7 D8 FF 28 E9 FD 43 88 FA D7 58 ED 52 F5 96 BE EB D4 D5 E5 E9 E7 84' + 'A5 9B 2F 52 57 D1 E8 99 BC 30 5D 45 9D 3B FF 7D C8 B9 DC 17 63 56 57 9F FF 9F 3E 89 55 97 26 9E' + '73 8E AA CA E7 EA CA 75 F8 CA 87 FE C5 42 FF D2 A0 7F D8 F8 30 0B 84 FF 10 30 9E F5 5F 0A 18 D7' + '66 FE 53 B9 11 2C 2B AA 98 F1 C2 0B 45 8B 77 31 5A AC CE EB 9A A3 C2 AA 70 58 FE D6 99 A8 F0 71' + '96 0C FD 23 C1 19 8C FE 76 65 F4 F7 2E 46 7F D7 FB A2 BF B5 45 FF 11 F4 CD 3F 3B D6 AB 02 BD 9D' + '18 E2 F5 0F EE AA 50 EE B1 8B 88 E3 4E 62 1C 77 FF BF 1F C1 4D F8 CF 4E 05 55 44 A6 F7 79 A7 82' + 'A7 4F 6B 57 CC C7 F2 8A F9 F3 CF 03 9B 4F 02 55 AA E0 E2 CF 03 55 E1 F3 DF 8A FB FA 07 7D CF EF' + '08 3C 7D 76 DC B7 96 51 94 73 42 BF F7 FE 8F 87 7E FF DB C9 2E C7 DF 27 BB FC 2F EE 3F 27 DF D5' + '7C 89 FF F9 29 AF DD 67 A7 BC BA FE FB 29 AF 94 50 F1 4F AF A8 C4 57 E9 79 89 2F 37 03 52 67 E5' + 'BE 18 7B 1E C5 D8 F3 AC BF 89 3A 83 03 03 9A 43 CE 77 72 6C C0 F9 61 E6 5E 17 11 5D DE EB 0B 2D' + 'E3 A2 43 CB DD 2F 22 AE EC 3F 78 00 BE A0 B2 8A 28 FB 47 91 3F 62 14 79 1B E3 C7 CD 61 63 55 9E' + 'CF 3F 2F 5A 9C C0 11 02 CD A1 E2 7F 2B 48 DC FD 42 E1 61 35 6C 40 C5 86 07 31 1B 7C 7E 0C 58 8D' + '13 38 27 06 AC 86 0A 14 73 90 C0 39 01 E0 F3 87 0A 0C FA FB 30 B0 1A 33 F0 EC D9 31 60 FF 00 F0' + 'C1 FF B9 00 70 BD 2F 00 7C 91 D1 DF 11 8C FE CE F7 45 7F 7F FB 1F 0D FD BE 79 5E DC 57 75 0C 0F' + 'F8 F1 4C B8 57 C5 2F FE 2F 46 7C 55 CD E2 F1 7F 67 30 83 8A F5 BA 2F 14 EB 3D B9 F3 4C E8 AD 39' + 'D5 59 CD 54 E7 39 79 CE FF 7D 41 C9 8B 8F C8 E0 E2 3A B9 FF 1F 0C CA 9C A9 EC 5C 74 0C DB 3F 29' + 'A8 86 76 F8 07 B3 BB E9 2E 78 12 D6 3D D0 FB 97 D5 65 DD 16 BF 4B B9 27 30 7E D3 53 EF FD 9B 43' + '18 83 B9 3D 58 73 97 55 73 0F BD 19 8D B7 A2 CF C4 16 D5 19 8F FA 17 E8 B5 EC 3F BD 7C E3 63 C6' + '76 96 05 E0 52 D6 8D 46 EB 70 AD 0E E3 75 67 02 81 2A 0B A3 02 81 73 02 F1 68 E0 99 FB B8 9F 0E' + 'C2 EB 41 78 F3 42 43 C1 BC 2E 09 C6 A8 60 8C 0E C6 95 1C 01 56 EB 8B 25 EF 0D C6 BE E0 73 87 7F' + '1D 0D 41 0C C7 7E ED D2 A3 49 7F 66 A4 57 F3 30 AF CB 0C 67 6E F4 56 63 BC D4 00 2F 75 12 30 9C' + 'D4 28 2E 35 7E EB 34 F7 E8 6A E4 56 F3 98 AD CB 7D 43 B5 86 73 8F AB 46 65 6D 24 35 12 4B 0D C3' + '52 FB C8 41 16 0C E3 AC 2B AF 4F C9 BB FF FB FE EF 07 5D A9 E9 23 B3 FD 06 5D A9 E1 56 9D FD C6' + '5A 5D CF B9 23 B7 70 EE C8 A3 1C 5F D5 3C 71 E4 15 DF 10 2B FF D1 54 6A EC D4 1D 67 0F 93 5A 1D' + '77 66 8C 54 7F 52 A3 A3 4A 38 2B 4A 8D 82 52 B7 99 97 9F 37 04 EA 38 87 40 A9 5B CE D7 25 60 53' + '02 8E 72 57 74 9A 03 A1 2E 26 66 A9 C6 45 A9 7B CF D3 D8 98 B8 90 C9 82 53 34 B5 40 33 93 E3 A2' + 'FC 6F 39 57 43 A3 9A 03 84 F3 7C 95 FC 75 9C 15 A5 06 45 A5 B3 E7 EF 5F A4 86 43 95 91 1A 0B A5' + 'BA F4 D6 F2 AD 5F 8D 76 BA DA 97 02 98 C4 EE BA E6 D1 4E 6A A8 93 FF 45 2E FE 37 A4 AB 4B 5D D4' + 'B0 27 35 C8 29 91 83 9C D4 08 27 35 AA A9 BD DF 78 A6 32 FA 96 83 99 3A 72 12 D3 1E BE 43 F5 E0' + 'D0 A5 E1 E4 FF EE D3 97 13 97 D4 B8 25 35 56 49 8D 52 EA CD D9 49 2B 38 26 29 9D EF 35 6A 28 52' + '4F BF 71 48 6A 04 52 87 38 8D 1A 7B B4 90 D4 60 A3 BE 09 9A FE 1C 5A A4 46 14 F9 0F 27 52 EB B6' + '5A B1 D5 40 22 35 FF E3 FC B1 44 17 1C 27 34 70 8F 0C E6 50 A1 DE DE ED A9 F6 18 F0 52 F7 4D A8' + 'CB F6 55 CB 87 FA 05 E4 7F 9D BE 91 89 5D FF 8B F4 3B 71 1C D9 7D E4 7F 31 FE F9 57 E2 AB CB F0' + 'FF F9 A2 7B F5 D1 5D CB B7 CC AF 5A C8 D7 2D B4 B9 4F 5E 7D 79 D1 BD 7F 87 52 0F 2E C3 EA 3F 25' + 'C7 D8 7C 7D A6 4A 75 AB C8 72 F3 C5 99 5A 4A 8A 17 64 AA B0 AC FF B5 97 37 52 9F 08 2D A9 7E DE' + '34 8E B3 BA 63 FD EE 3F 56 D3 A0 CE 7F 51 3A F3 5A 74 D1 0B 45 5F ED B0 D7 BB 03 3F D8 16 47 B8' + '0F EF A7 25 2E 0F B5 C5 E1 B6 E0 0C 46 33 73 E9 03 B4 20 7D 8E 05 FD 7D 87 53 1F C5 E2 E3 58 7C' + '4A CD FD AB 5E 9F 95 60 55 09 06 86 7B 7F 78 F9 69 1C 38 8D 26 0F 3C 1E EF EF C5 E3 91 26 4F 80' + 'C7 13 D0 E4 D1 79 3C BA 26 4F A0 C7 13 D8 E4 09 F2 78 82 9A 3C C1 1E 4F 70 93 27 C4 E3 09 69 F2' + 'E8 3D 1E 7D 93 C7 E0 F1 18 9A 3C 46 8F C7 D8 E4 31 79 3C A6 26 8F D9 E3 31 37 79 42 3D 9E D0 26' + '8F C5 E3 B1 34 79 AC 1E 8F B5 C9 63 F3 78 6C 83 76 7B FF 81 03 74 9A 65 17 37 29 D2 BB 3A 8C 39' + '6F 5E E4 0E BF 79 91 FB CF 9E 17 D9 DB B7 64 44 E9 11 7D DE 8C C8 0C 3D 2A F5 D8 CE 45 64 8F 1E' + 'F5 7A ED 6A 93 6E BE E1 58 CD 63 B1 2E 3F 7B 3A A4 1A 91 B5 EE 42 23 B2 D4 8C 48 F1 0D CA F2 3F' + '72 1E F6 37 73 21 D5 18 2D FF 83 E4 EF FD 26 42 9E F2 1D 1E F7 3A FB 60 78 18 07 41 8E 3E 7B 16' + 'E4 9A BF 19 A9 05 DE DB D1 EB EC 83 DB 61 E7 4D 84 54 A3 B6 FC 0F 65 BF F7 1D CA 36 4F 84 54 A3' + 'B6 FA 5F 68 D4 56 F3 5C C8 39 17 3A 58 55 63 B7 FC A7 43 0E A7 E6 E9 90 9F 58 F0 19 67 44 6E A4' + 'E9 8C 6A FA CF 7F 4C B7 A1 93 DF 3D 16 BD 38 A0 AB 79 E6 A3 FF 98 AE E6 F9 8F FE 8B E6 AB 36 6D' + 'E6 63 04 67 3E B6 3F 7B E6 E3 0A DE 06 71 CE 54 47 75 24 D9 85 93 1C E3 79 55 C3 58 5E D2 30 23' + '0E 6B 7D 87 8B 6A 4C 57 3F 1E 2E AA 4B 17 8A E3 F1 0E E7 30 FE C1 A9 8B AD F8 8C FB 23 01 47 12' + 'B0 82 B7 05 A8 C9 89 33 0A 70 9F 6F 4E A2 9A 90 A8 66 23 26 9D 37 88 6B 3D 35 CF 46 4C E3 6C C4' + '51 3C FA 52 A3 B9 D6 FA CD 43 F4 9F 81 38 DC D7 B0 7E C1 19 88 6B D8 A4 EE 3F A0 6B AF 6F 59 FC' + 'BB C9 86 FE 73 0C 55 2B 76 17 9B 0C F0 1B DC B5 D2 6F 76 61 B6 6F 70 57 BE 6F 70 D7 5A B6 56 6F' + 'E2 C8 AE 0E 1C 53 E8 3F A9 F0 4F DF 31 43 AF B3 8F 10 86 9D 37 AC AB 4F A4 F4 F3 8D E9 52 43 B9' + 'D4 51 C1 1A DF 14 42 37 7B 94 73 7C F3 07 3F E2 B4 C1 34 0E DF 3A 67 EC 96 9A 33 78 CE D8 2D B5' + 'F5 6F 1E BB A5 E6 0C 76 64 BB B0 9A 33 38 D2 37 5B 50 8D E0 52 C7 00 BD CE DE FA 5F 70 86 60 9F' + '04 E9 47 6A 92 E0 BC B3 37 FA 2F 70 92 E0 B1 96 67 A6 07 8E F4 6D B2 9F F1 2D D6 AF 71 86 E0 3F' + '6F 34 07 ED D1 B8 0F CA 90 83 92 EB EB 10 9D 7B 50 06 6B 37 C4 8E D0 69 C6 85 21 2F EC CC 98 D3' + '1B 9D 9A 1B DA 69 96 F0 F6 FC 7A 0F 4E 68 E7 86 DE 8D 87 25 00 16 07 2C F9 5A 63 94 A5 5E 2C 1E' + 'AB 65 48 AC D6 04 CA C7 9F 7A DE A9 41 7F CD 63 FD D6 F8 9E 38 5F 98 35 EA D9 D1 8B 8F 0C F5 8C' + 'D8 44 DB 49 DD 64 E2 5D A8 BC D4 CD 15 EA C5 AB 17 BF 09 D4 A7 BE 8C 1F F3 6A F2 7E D2 5E DE CF' + 'CF EB C6 0A CD 14 BE B8 A8 ED D2 D0 C0 E6 D7 11 D5 82 74 4B 04 A6 47 9C 99 52 75 89 F6 37 D5 AF' + '6F 75 0F A4 EA 4E 53 51 D7 61 DA E0 23 FF 31 37 2A ED FF FF 75 77 36 21 51 85 51 18 3E 67 26 4B' + 'A5 CC 7E 0C D1 CA 99 EC 8E FD 1A 44 90 96 91 69 0B 2B ED 8F 50 4B D2 B4 45 11 64 6D 6A DB 2E C2' + 'A0 A2 20 82 08 12 02 95 48 28 2A 17 45 89 62 56 2E 94 9A 3B 0B FB A3 48 5B D4 22 93 7E B8 1B BB' + 'DF 7B FA 6E DF 38 8E D9 2A 08 9E 8D 3B C1 F7 CE F8 7D F7 3D CF 69 87 4A 4B DA FE F2 15 25 A7 9A' + '89 6C FE 39 8A C6 72 1F 1E 78 69 FF C6 EB A6 96 9D F4 8E 5A 7D 7E 7A E6 27 1B 7C F6 D3 90 1E 0E' + '98 13 50 AC 44 35 BB 10 D4 E2 D5 C1 A8 0A DD CB 00 BD 05 03 01 1A 0C D0 47 14 E9 26 62 40 59 84' + '09 A6 65 D1 15 EC BC 68 03 CA 38 7A BE 26 54 F1 6E A0 8A 77 33 48 77 83 D4 86 42 5E AC B0 EF 05' + '1A 78 AF 50 BC 1B 08 FE 6A 18 DC CE A6 3B D9 D4 06 FA C0 3B 70 D5 A2 46 8B 5A D1 54 BB 8F A6 DA' + '23 8B BA 2D 7A 6A 51 8F 45 BD 16 3D 47 4D CD E5 3D F8 60 D1 27 8B 12 42 34 39 44 85 A0 08 EC 0B' + 'D1 FE 10 1D 86 E0 4F 4A 69 83 46 3B 41 EA 5F D2 2D A8 C5 B4 91 FC 8B 27 D3 46 A2 75 95 03 C2 3F' + 'B9 6A 6A 37 76 7B 3B C6 6E EF 55 C6 6E EF 7A 63 B7 77 B3 B1 DB FB 3F AB D6 6E 55 C5 D8 7D 41 3A' + '12 54 5F A4 BD 0B 29 F6 43 6E DB 5C 99 81 94 09 50 99 7E F4 AE 30 BC 19 C8 26 2D E6 F4 66 20 5B' + 'F5 D4 EB 5D 70 4F 8F 41 8E 9A 84 4C D5 32 65 D1 28 7B EA E4 73 41 AA 81 54 F2 18 E4 91 23 4B D5' + '84 DE 09 AD 3C 36 27 F1 A4 3A 27 02 E2 ED 09 63 4E 7C CA 0D 8E 4C 79 EE 50 F7 3D B1 2F DE 76 66' + 'A9 E1 2A A2 43 EE CF AC D8 E4 53 1C 04 57 C0 2D 30 EC 57 94 4F 52 54 82 BA 79 8A 8B E0 1A 68 06' + 'CB E7 2B 7A 80 7C 9A 95 E0 B1 77 3F BB 5C 16 84 39 1B D1 AF 08 73 43 98 4F 87 F9 41 98 1F 86 F9' + '4B 98 87 C3 1C B2 39 C7 E6 3D 36 57 D9 7C C6 E6 B3 36 77 D8 DC 69 F3 37 9B BF DB BC 24 C2 4B 23' + '5C 1D E1 9A 08 9F 8F F0 85 08 EF 3A 28 7F A5 A0 31 B3 9B 6B 88 C1 D7 47 AB BF 45 FA 2D B2 01 99' + 'E5 35 E5 DE 9E D6 3B 79 0A 4D 05 3F E2 C8 BD 45 D6 9D 38 5D 31 0D CA EE CD A9 B4 25 95 6A C7 95' + '72 F7 03 1F A4 DC 89 E9 94 A4 A5 DC CD 19 74 1D 22 EE AA 4C DA 9B 49 35 D1 22 EE 82 00 AD D3 43' + '33 B9 90 63 17 00 D1 62 97 82 AD 90 63 BB 19 F1 45 AB B0 87 F1 3A F4 B8 A1 BF 5E 01 E5 75 77 0B' + '3D 69 A1 BD D0 5C BF 89 D1 5C 9B 22 6B 1E 51 78 33 CD 29 86 AA 3A CB 90 54 BB 98 7A 6A 53 4C 5D' + '9E CC 15 90 51 7F 4D E6 35 71 64 D4 A2 A1 DE 00 0D 75 D7 0C 7E A4 05 D4 AF B5 7A BA C0 50 4F 97' + '69 F5 74 47 1A 77 A5 F1 13 2D 9D 2E D2 BA E9 8D 5A E2 E2 52 94 C1 C5 19 7C 19 A2 E9 46 2D 9A 2E' + '86 65 DA 13 4D 8F A9 98 CE 37 14 D3 97 EA 7F CB A5 1B FA DD DF 5C 75 A3 8C 43 79 8A 43 D3 1D 9A' + '01 66 39 34 DB A1 2C 10 04 D9 0E 2D 74 28 C7 A1 C5 0E FD E1 50 8E E3 78 B9 7A 52 65 37 BC EC 0B' + '97 CB DB 8A 52 2F EA 12 72 89 B7 44 7A 54 80 7D C8 AD CB EA 44 45 3E 58 87 18 4B 80 25 AE 75 B3' + '14 07 8C D0 4A 5C FD E9 8A A4 38 11 AD D6 11 2D F8 53 44 7D 08 E4 08 02 99 A2 03 29 99 1C 33 96' + '8F 8D 58 9A 81 94 F1 FA 72 23 90 12 45 33 84 12 33 2F 54 25 13 08 55 FE 4C 5E 1B 1D AD 52 84 AA' + 'F3 6F 42 E5 C6 A9 48 07 69 54 84 F2 74 84 2E 19 11 3A D5 AF A8 9C EC 49 09 62 77 62 9A 9B 2E 77' + 'AB FB 97 C1 21 1E 19 E2 9F D8 AA E9 DA' +} + + +LANGUAGE 0,0 CASE UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE +{ + '78 DA 6D BD 05 A0 AE 55 D5 B5 3D E6 3E 84 22 2A 0A 28 EA 86 07 90 F6 6C 94 54 41 A5 BB 5B 4C BA' + '41 BA 91 6E A4 BB FB D0 25 2D 21 DD DD DD 25 60 80 89 F5 5F 63 CC 73 78 F1 3B FF F7 BD D7 9C 63' + 'CE B9 F7 B3 F7 B3 E6 DA F7 5A 8B E3 7D 3F D3 7E 46 5A 48 AA B5 1B 69 61 C4 3A 8D B4 08 62 DD 46' + '5A 14 B1 5E 23 2D 86 58 BF 91 16 47 6C D0 48 4B 20 36 6C A4 25 11 1B 35 D2 52 88 8D C7 B2 54 B3' + '34 6E 93 B1 2C DD 2C 83 DB B4 91 96 45 6C D6 48 CB 21 36 6F A4 E5 11 5B 34 D2 0A 88 5F 34 D2 8A' + '88 2D 1B 69 25 C4 56 8D B4 32 62 EB 46 5A 05 B1 4D 23 AD 8A D8 B6 91 56 43 6C D7 48 AB 23 B6 6F' + 'A4 35 10 3B 34 D2 0F 11 3B 36 D2 9A 88 9D 1A E9 47 88 9D 1B 29 A3 5A 0B 35 19 D5 5A B8 C9 A8 D6' + '22 4D 46 B5 16 6D 32 AA B5 58 93 51 AD C5 9B 8C 6A 2D D1 64 54 6B C9 66 63 FD EF D0 6E 92 E2 D8' + '41 CD 60 D6 32 4D 06 B3 96 6D 32 98 B5 5C 93 C1 AC E5 9B 0C 66 AD D0 64 30 6B C5 26 83 59 2B 35' + '19 CC 5A B9 C9 60 D6 2A 4D 06 B3 56 6D 32 98 B5 5A 93 C1 AC D5 9B 0C 66 AD D1 64 30 EB 87 4D 06' + 'B3 D6 6C 32 98 F5 A3 E6 2A DC 0D A3 30 27 8F 0A BF 45 BE DC 48 B7 20 5E 69 A4 5B 11 AF 36 D2 6D' + '88 D7 1A E9 76 C4 EB 8D 74 07 E2 8D 46 BA 13 F1 66 23 DD 85 78 AB 91 EE 46 BC DD 48 F7 20 DE 69' + 'A4 7B 11 BF 6B A4 FB 10 EF 36 D2 FD 88 F7 C6 72 7F F3 00 EE FD B1 3C D0 3C 88 FB 7D 23 3D 84 F8' + '43 23 3D 8C F8 63 23 3D 82 F8 53 23 3D 8A F8 A0 91 1E 43 7C D8 48 8F 23 FE DC 48 4F 20 FE D2 48' + '4F 22 FE DA 48 4F 23 FE DE 48 CF 20 FE D1 48 CF 22 3E 6A A4 E7 10 FF 6C A4 E7 11 FF 6A A4 17 10' + 'FF 6E A4 17 11 FF 69 A4 97 A4 A1 6D 32 21 CA 72 95 48 3B FE 2F 5D AA DF 36 E9 52 DD D2 A4 4B 75' + '6B 93 2E D5 6D 4D BA 54 B7 37 E9 52 DD D1 A4 4B 75 67 93 2E D5 5D 4D BA 54 77 37 E9 52 DD D3 A4' + '4B 75 6F 93 2E D5 7D CD 7B 09 C6 F6 E9 FD 04 63 3B 94 CE D4 83 4D 3A 53 0F 35 E9 4C 3D DC A4 33' + 'F5 48 93 CE D4 A3 4D 3A 53 8F 35 E9 4C 3D DE A4 33 F5 44 93 CE D4 93 4D 3A 53 4F 37 E9 4C 3D D3' + 'A4 33 F5 6C 93 CE D4 73 4D 3A 53 CF 37 E9 4C BD D0 A4 33 F5 62 F3 DF 04 3B 56 10 AE 1A 74 CC D8' + 'FF 3F 84 19 D5 48 31 E5 14 4C 80 9B B0 91 62 CA 29 98 08 37 71 23 C5 94 53 F0 29 DC A7 1B 29 A6' + '9C 82 49 70 9F 69 A4 98 72 0A 26 C5 7D B6 91 62 CA 29 F8 1C EE F3 8D 14 53 4E C1 64 B8 2F 34 52' + '4C 39 05 5F C4 4D DE 48 31 E5 14 4C 81 9B B2 91 62 CA 29 F8 12 EE CB 8D 14 53 4E C1 54 B8 AF 34' + '52 4C 39 05 5F C5 7D AD 91 62 CA 29 18 C6 4D DD 48 31 E5 14 4C 83 1B 34 52 4C 39 05 D3 E2 A6 6B' + 'A4 98 72 0A A6 C7 7D BD 91 62 CA 29 98 01 37 63 23 C5 94 53 30 13 6E E6 46 8A 29 A7 60 16 DC AC' + '63 99 A5 99 35 F5 B1 C1 6C B8 6F 34 52 4C 39 05 A3 71 23 8D 14 53 4E C1 EC B8 6F 8E 65 F6 E6 9B' + 'A9 8F 0D BE C5 24 63 E1 9A 78 54 AF 5F 84 66 8E 7C C9 D8 C5 6C 4E 72 73 35 52 4C 39 05 73 E3 E6' + '69 A4 98 72 0A E6 C5 7D BB 91 62 CA 29 F8 2E 6E BE 46 8A 29 A7 60 7E DC F7 1A 29 A6 9C 82 EF E3' + '7E D0 48 31 E5 14 2C 80 5B B0 91 62 CA 29 58 08 B7 70 C3 C6 2A 15 A7 60 11 DC A2 0D 1B AB 54 9C' + '82 C5 70 8B 37 6C AC 52 71 0A 96 C0 2D D9 B0 B1 4A C5 29 58 8A 01 BC 61 C8 AB 77 8D 95 2C DF 63' + 'DD D2 7C C9 32 0D 7B AB 7C 97 53 B0 2C 6E B9 86 BD 55 2A 4E C1 F2 B8 15 1A F6 56 A9 38 05 2B E2' + '56 6A D8 5B A5 E2 14 AC 8C 5B A5 E1 1A 9F 8A 53 B0 2A 6E B5 86 BD 55 2A 4E C1 EA B8 35 1A F6 56' + 'A9 38 05 3F C4 AD D9 B0 B7 4A C5 29 F8 11 EE C7 8D 14 53 4E C1 4F 70 3F 6D A4 98 72 0A 7E 86 FB' + '79 23 C5 94 53 B0 16 6E ED 86 9D 5A 2A 4E C1 3A B8 75 1B 76 6A A9 38 05 EB E1 D6 6F D8 A9 A5 E2' + '14 6C 80 DB B0 61 A7 96 8A 53 B0 11 6E E3 86 9D 5A 2A 4E C1 26 B8 4D 1B B6 69 A9 38 05 9B E1 36' + '6F D8 A6 A5 E2 14 6C 81 FB 45 C3 36 2D 15 A7 60 4B DC 56 0D DB B4 54 9C 82 AD 71 DB 34 2C C5 A9' + '38 05 DB E2 B6 6B D8 A6 A5 E2 14 6C 8F DB A1 61 9B 96 8A 53 E0 55 83 F5 A3 B2 86 EC 44 B0 73 C3' + '36 2D 5F E6 14 EC 82 DB B5 91 62 CA 29 D8 0D F7 CB 46 8A 29 A7 60 F7 EA 3D F9 B8 5D E4 1E FD D7' + '31 14 F6 F4 0C 1B 0A D2 5E 04 7B 37 52 4C 39 05 FB E0 F6 6D A4 98 72 0A F6 F3 CC 1B 0A D2 FE 04' + '07 34 52 4C 39 05 07 7A 1A 0E 05 E9 20 4F D1 A1 20 1D 4C 70 48 23 C5 94 53 70 28 EE 85 46 3A CC' + '93 77 28 48 87 7B BE 0E 05 E9 08 82 23 1B 29 A6 9C 82 A3 3C F3 86 82 74 B4 E7 DE 50 90 8E C9 97' + 'FD B5 C2 B1 9E 47 43 41 3A CE B3 68 28 48 C7 13 9C D0 48 31 E5 14 9C D8 17 AC A1 70 B2 A7 CE 50' + '90 4E F1 24 18 0A D2 A9 BD B0 0C 85 D3 3C 27 86 82 74 3A C1 19 8D 14 53 4E C1 99 B8 B3 1A 29 A6' + '9C 82 B3 71 E7 34 52 4C 39 05 E7 E2 F6 18 0A D2 18 82 F3 1A 29 A6 9C 82 F3 DD DC A1 20 5D 44 70' + '71 23 C5 94 53 70 89 5B 38 14 A4 4B 09 2E 6B A4 98 72 0A 2E C7 1D 34 14 A4 2B DC B3 A1 20 FD 9A' + 'E0 CA 46 8A 29 A7 E0 2A DC D5 8D 14 53 4E C1 35 6E E1 50 90 AE 25 B8 AE 91 62 CA 29 B8 01 77 63' + '23 C5 94 53 70 73 82 BF 55 B8 1D 77 E7 58 EE A0 70 C7 FF C6 45 FD CE 7C FD D8 E0 2E DC 3D 63 B9' + '9B C2 DD FF 1B 17 F5 7B F2 F5 63 83 7B 71 F7 8F E5 3E 0A F7 FD 6F 5C D4 EF CF D7 8F 0D 1E C0 3D' + 'D8 70 34 49 C5 29 78 08 F7 70 C3 D1 24 15 A7 E0 11 DC A3 0D 47 93 54 9C 82 C7 70 8F 37 1C 4D 52' + '71 0A 9E C0 3D D9 70 34 49 C5 29 78 0A F7 74 C3 39 25 15 A7 E0 19 DC B3 0D E7 94 54 9C 82 E7 70' + 'CF 37 9C 53 52 71 0A F2 37 59 FE 0B 85 17 71 2F 35 9C 53 52 71 0A 5E C6 BD D2 70 30 49 C5 29 78' + '15 F7 5A C3 C1 24 15 A7 E0 75 DC 1B 0D 07 93 54 9C 82 37 71 6F 35 1C 4C 52 71 0A DE C6 BD D3 70' + '30 49 C5 29 F8 1D EE DD 86 83 49 2A 4E C1 7B B8 F7 1B 0E 26 A9 38 05 BF C7 FD A1 E1 60 92 8A 53' + 'F0 47 76 03 9B 48 93 B2 B3 B2 5C 3A 72 AC FB 13 5F F2 E1 58 3E E0 9B 3E F8 DF B8 A8 7F 98 D7 1A' + '1B FC 19 F7 97 86 03 4B 2A 4E 81 AF 4B C7 34 92 27 F4 CD 0D A7 17 C4 3F 1A 4E 2F F9 1E A7 E0 23' + 'DC 3F 1B 4E 2F A9 38 05 FF C2 FD BB E1 F4 92 8A 53 F0 1F 2F 3A 0D A7 97 54 9C 02 F1 87 58 8D 8F' + '27 39 BD 0C 85 21 DC A8 86 D3 4B 97 87 C2 04 B8 09 1B 4E 2F A9 38 05 13 E1 26 6E D8 95 A6 E2 14' + '7C 0A F7 E9 86 D3 4B 2A 4E C1 24 B8 CF 34 9C 5E 52 71 0A 26 C5 7D B6 E1 F4 92 8A 53 F0 39 DC E7' + '1B 4E 2F A9 38 05 93 E1 BE D0 70 7A 49 C5 29 F8 22 6E F2 86 D3 4B 2A 4E C1 14 B8 29 1B 4E 2F A9' + '38 05 5F C2 7D B9 E1 F4 92 8A 53 30 15 EE 2B 0D A7 97 54 9C 82 AF E2 BE D6 70 7A 49 C5 29 18 C6' + '4D DD 70 7A 49 C5 29 98 06 37 68 38 BD A4 E2 14 78 45 61 6D A9 AC 2F D3 13 7C BD E1 C0 92 2F 73' + '0A 66 C0 CD D8 70 60 49 C5 29 98 09 37 73 C3 81 25 15 A7 60 16 DC AC 8D 14 53 4E C1 6C B8 6F 34' + '1C 55 52 71 0A 46 E3 46 1A 8E 2A A9 38 05 B3 E3 BE D9 48 31 E5 14 7C 0B 37 47 23 C5 94 53 30 27' + '6E AE 86 B3 49 2A 4E C1 7C B8 F5 47 07 69 7E 82 EF 35 1C 2D F2 65 4E 81 97 65 16 E8 CA 22 FD 03' + '82 0D 46 07 69 81 7C D9 2F 47 87 05 13 EC 3E 3A 2C C4 97 2D DC 70 B4 48 C5 29 F0 4E 69 8F 0A 1C' + '2D 08 0E 6C A4 C5 10 87 34 1C 2D 10 4B 34 52 4C 39 05 4B E2 96 6A A4 98 72 0A 96 C6 2D D3 70 96' + '48 C5 29 58 16 B7 5C C3 59 22 15 A7 60 79 DC 0A 0D 67 89 54 9C 82 15 13 FC 62 74 58 29 C1 E6 A3' + 'C3 CA 09 B6 1C 1D B2 D5 2B 6F FC 20 DB B6 F2 26 0E B2 39 2B 6F D5 20 9B B3 F2 56 0D B2 EB 2A EF' + 'C1 20 BB AE F2 1E 0C 7E 92 E0 C2 31 21 1B AD F2 B6 0B D6 4E 70 D1 98 90 5D 57 79 0F 06 EB 27 F8' + 'D5 98 B0 41 82 0B C6 84 EC BA CA 7B 30 C8 7E AC BC 3B 83 4D 12 5C 32 26 6C 9A 60 9D D1 61 B3 04' + '17 8F 09 D9 82 95 37 64 B0 55 82 2D 46 87 EC C7 CA BB 33 C8 16 AC BC 21 83 DD 12 AC 37 3A 64 07' + '55 DE 4F C1 5E 09 EE 18 13 B2 69 2A 6F A1 60 FF 04 97 8F 09 07 F4 EF 56 21 33 A3 3C 4F E0 A0 FE' + 'B2 0A D9 1A 95 37 4A 90 39 53 9E 41 90 3D 4F 79 07 04 A7 F4 97 8D 09 A7 26 B8 6C 4C 98 D8 FF 81' + 'D6 A7 FA B1 2C 86 BB CE B9 13 46 85 2D 71 5B 35 1C 56 46 A5 E7 A3 C2 D6 B8 6D 1A 0E 2B A9 38 05' + 'DB E3 76 68 38 92 A4 E2 14 EC 92 E0 DF A3 C2 AE 09 FE 33 2A EC 96 E0 BF A3 C2 EE B8 0F 1B 69 3F' + 'C4 45 0D 07 00 C4 C5 8D 74 20 E2 92 86 03 00 E2 D2 86 3D 3F E2 FE 46 3A 14 F1 40 C3 9E 1F F1 60' + 'C3 9E 7F 94 46 F1 66 3F 45 CC FF 39 3A 61 5C F4 7F EA 08 EC E5 0D 67 01 C4 15 8D 74 14 E2 D7 0D' + '67 01 C4 95 0D 67 01 C4 55 8D 74 2C E2 EA 86 B3 00 E2 9A 86 B3 00 E2 DA 86 B3 40 8F 7C 46 5F 27' + '22 AE 6F A4 93 10 BF 69 24 FF C7 F4 1B 1A 0E 06 88 1B 1B 0E 06 88 9B 1A E9 34 C4 CD 0D 07 03 C4' + '6F 1B 0E 06 88 5B 1A CE 02 88 DB C6 72 56 73 36 EE F6 86 13 01 E2 8E 46 3A 17 71 67 C3 89 00 71' + '57 C3 89 00 71 77 23 9D 8F B8 A7 91 2E 40 DC DB 48 17 22 EE 6B 38 2B A4 E3 EE 2E A4 9F E5 EE 42' + 'FA 59 EE 2E A4 9F E5 EE C2 65 34 E6 8E 8F 1B E6 E8 9C 8F 1B F6 B1 4A A3 CA 6D 83 34 AA DC 36 48' + 'A3 CA 6D 83 34 AA DC 36 48 A3 CA 6D 83 34 AA DC 36 48 A3 CA 6D 83 34 AA DC 36 48 A3 C6 FD 9D A4' + '51 E5 B6 41 1A 55 6E 1B A4 51 E3 FE 0D 24 8D 2A B7 0D D2 A8 72 DB 20 8D 2A B7 0D D2 A8 72 DB 20' + '8D 2A B7 0D 6E ED 66 7D DC AD DB 52 1C 1B A4 65 E5 06 42 5A 56 6E 20 A4 65 E5 06 42 5A 56 6E 20' + 'A4 65 E5 06 42 5A 56 6E 20 A4 65 E5 06 42 5A 56 6E 20 E4 CF AA FC 47 06 F9 B3 2A FF 91 41 FE AC' + 'CA 7F 64 F0 10 EE A9 86 63 C8 D8 BF 9A 71 BD 78 64 EC BC 1F 37 9A 4F 8C 9D 58 E3 7E C9 27 C7 CE' + 'D7 71 A3 90 17 29 BF 24 3C 8D 7B A6 91 62 CA 29 78 16 F7 5C 23 C5 94 53 F0 3C EE 85 46 8A 29 A7' + 'E0 45 DC 4B 0D 67 8D 54 9C 82 97 71 AF 34 9C 35 52 71 0A 5E C5 BD D6 70 D6 48 C5 29 78 1D F7 46' + 'C3 59 23 15 A7 E0 4D DC 5B 0D 67 8D 54 9C 82 B7 71 EF 34 9C 35 52 71 0A 7E 87 7B B7 E1 AC 91 8A' + '53 F0 1E EE FD 86 B3 46 2A 4E C1 EF 71 7F 68 38 6B A4 E2 14 FC 71 EC 25 65 DC 44 FD D3 D8 EB C0' + 'B8 D9 F5 41 BE F8 1F A3 42 AE BE E5 6B 31 FC F9 93 97 AA BF 8C BD B4 8D FB 83 F9 1B EE EF 0D E7' + '89 7C 9B 53 E0 97 FA A0 91 3E 42 FC B3 E1 3C 91 2F 73 0A BC 22 EC D2 48 5E 11 76 6D 38 42 20 76' + '6B F8 7F 13 A8 56 6C 7C 12 50 AD D4 70 B6 40 AC DC 70 84 40 AC D2 F0 2D 88 55 1B 8E 10 88 D5 1A' + '69 22 C4 EA 0D 47 08 C4 1A 8D F4 29 C4 0F 1B 8E 10 88 35 1B 69 12 C4 8F 1A 8E 10 88 1F 37 9C D6' + '10 3F 69 38 42 20 7E DA 48 9F 43 FC AC E1 08 81 F8 79 23 4D 86 F8 56 C3 11 02 31 47 23 7D 11 31' + '67 C3 11 02 31 57 23 4D 81 98 BB E1 08 81 98 A7 91 BE 84 98 B7 E1 08 81 F8 76 23 4D 85 F8 4E C3' + '11 02 F1 DD 46 FA 2A 62 BE 86 23 04 62 FE 46 1A 46 7C AF E1 08 81 F8 7E 23 4D 83 F8 41 C3 11 02' + 'B1 40 23 4D 8B 58 B0 91 A6 43 2C D4 70 9E 40 2C DC 70 9E 40 2C D2 48 33 20 16 6D 38 4F 20 16 6B' + 'A4 99 10 8B 37 9C 27 10 4B 34 D2 2C 88 25 1B CE 13 88 A5 1A 69 36 C4 D2 0D E7 09 C4 32 8D 34 1A' + 'B1 6C C3 79 02 B1 5C 23 CD 8E 58 BE E1 3C 81 58 A1 91 D2 97 72 97 20 7D 29 77 09 D2 97 72 97 20' + '7D 29 77 09 D2 97 72 97 20 7D 29 77 09 D2 97 72 97 20 7D 29 77 09 D2 97 72 97 20 7D 29 77 09 D2' + '97 72 97 20 7D 29 77 09 D2 97 72 97 20 7D 29 77 09 D2 97 72 97 20 7D 29 77 09 D2 97 72 97 20 7D' + '29 77 09 D2 97 72 97 20 7D 29 77 09 D2 97 72 97 20 7D 29 77 09 D2 97 72 97 20 7D 29 77 09 D2 97' + '72 97 20 7D 29 77 09 D2 97 72 97 20 7D 29 77 09 D2 97 72 97 20 7D 29 77 09 D2 97 72 97 20 7D 29' + '77 09 FA 3A E0 AB 02 E4 3A 50 BE 2A 40 AE 03 E5 AB 02 E4 3A 50 BE 2A C0 AA 7D ED 98 20 E4 3A 50' + 'BE 2A 40 AE 03 E5 AB 02 E4 3A 50 BE 2A 40 AE 03 E5 AB 02 E4 3A 50 BE 2A 40 AE 03 E5 AB 02 E4 3A' + '50 BE 2A 40 AE 03 E5 AB 02 E4 3A 50 BE 2A 40 AE 03 E5 AB 02 E4 3A 50 BE 2A C0 5A B8 B5 1B 29 A6' + '9C 82 75 70 EB 36 52 4C 39 05 EB E1 D6 6F A4 98 72 0A 36 C0 6D D8 48 31 E5 14 6C 84 DB B8 91 62' + 'CA 29 D8 04 B7 69 23 C5 94 53 B0 19 6E F3 46 8A 29 A7 60 0B DC 2F 1A 29 A6 9C 82 2D 71 5B 35 1C' + '1E 52 71 0A B6 C6 6D D3 70 78 48 C5 29 D8 16 B7 5D 23 C5 94 53 B0 3D 6E 87 86 63 45 2A 4E C1 8E' + 'B8 9D 1A 29 A6 9C 82 9D 71 BB 34 52 4C 39 05 BB E2 76 6B A4 98 72 0A 7E 89 DB BD 91 62 CA 29 D8' + '03 B7 67 23 C5 94 53 70 10 EE E0 46 8A 29 A7 E0 10 DC AF 1A 29 A6 9C 82 43 71 87 35 9C 4B 52 71' + '0A 0E C7 1D D1 48 31 E5 14 1C 89 3B AA E1 FC 91 8A 53 70 34 EE 98 86 F3 47 2A 4E C1 B1 B8 E3 1A' + 'CE 1F A9 38 05 C7 E3 4E 68 38 7F A4 E2 14 9C 88 3B A9 E1 FC 91 8A 53 70 32 EE 94 86 F3 47 2A 4E' + 'C1 A9 B8 D3 1A CE 1F A9 38 05 A7 E3 CE 68 38 7F A4 E2 14 9C 89 3B AB E1 30 92 8A 53 70 36 EE 9C' + '86 63 48 2A 4E C1 B9 B8 31 0D C7 90 54 9C 82 F3 70 E7 37 1C 43 52 71 0A 2E C0 5D D8 70 0C 49 C5' + '29 B8 08 77 71 23 C5 94 53 70 09 EE D2 46 8A 29 A7 E0 32 DC E5 8D 14 53 4E C1 15 B8 5F 37 52 4C' + '39 05 57 E2 AE 6A A4 98 72 0A AE C6 5D D3 48 31 E5 14 5C 8B BB AE 91 62 CA 29 B8 1E F7 9B 46 8A' + '29 A7 E0 06 DC 8D 8D 14 53 4E C1 4D B8 9B 1B 29 A6 9C 82 DF E2 1E 6A A4 5B 10 B7 36 52 4C 39 05' + 'B7 E1 6E 6F A4 98 72 0A EE C0 DD D9 48 31 E5 14 DC 85 BB BB 91 62 CA 29 B8 07 77 6F 23 C5 94 53' + '70 1F EE FE 46 8A 29 A7 E0 01 DC 83 8D 14 53 4E 41 7E F5 F2 1B 81 87 71 8F 34 52 4C 39 05 8F E2' + '1E 6B A4 98 72 0A 1E C7 3D D1 48 31 E5 14 3C 89 7B AA 91 62 CA 29 78 1A F7 4C C3 31 24 15 A7 E0' + '59 DC 73 0D C7 90 54 9C 82 E7 71 2F 34 1C 43 52 71 0A 5E C4 BD D4 70 0C 49 C5 29 78 19 F7 4A C3' + '31 24 15 A7 E0 55 DC 6B 0D C7 90 54 9C 82 D7 71 6F 34 1C 43 52 71 0A DE C4 BD D5 70 0C 49 C5 29' + '78 1B F7 4E C3 31 24 15 A7 E0 77 B8 77 1B 8E 21 A9 38 05 EF E1 DE 6F 38 86 A4 E2 14 FC 1E F7 87' + '86 63 48 2A 4E C1 1F 71 7F 6A A4 98 72 0A 3E C0 7D D8 48 31 E5 14 FC 19 F7 97 86 03 48 2A 4E C1' + '5F 71 7F 6B A4 98 72 0A FE 8E FB 47 23 C5 94 53 F0 11 EE 9F 0D 47 91 54 9C 82 7F E1 FE DD 48 31' + 'E5 14 FC 07 F7 DF 86 73 49 2A 4E 81 26 64 D3 D1 78 3B 91 4D C9 84 61 08 37 AA E1 5C 92 8A 53 30' + '01 6E C2 86 EF 4F C5 29 98 08 37 71 C3 B9 24 15 A7 E0 53 B8 4F 37 9C 4B 52 71 0A 26 C1 7D A6 E1' + '5C 92 8A 53 30 29 EE B3 0D E7 92 54 9C 82 CF E1 3E DF 70 2E 49 C5 29 98 0C F7 85 86 73 49 2A 4E' + 'C1 17 71 93 37 9C 4B 52 71 0A A6 C0 4D D9 70 2E 49 C5 29 F8 12 EE CB 0D E7 92 54 9C 82 A9 70 5F' + '69 38 97 A4 E2 14 7C 15 F7 B5 86 73 49 2A 4E C1 30 6E EA 86 73 49 2A 4E C1 34 B8 41 C3 B9 24 15' + 'A7 60 5A DC 74 0D E7 92 54 9C 82 E9 71 5F 6F 38 97 A4 E2 14 CC 80 9B B1 E1 5C 92 8A 53 30 13 6E' + 'E6 86 73 49 2A 4E C1 2C B8 59 1B CE 25 A9 38 05 B3 E1 BE D1 70 2E 49 C5 29 18 8D 1B 69 38 97 A4' + 'E2 14 CC 8E FB 66 C3 B9 24 15 A7 60 0E DC DA 8D 34 27 62 9D 46 9A 0B B1 6E 23 CD 8D 58 AF 91 E6' + '41 AC DF 48 F3 22 36 68 A4 6F 23 36 6C A4 EF 20 36 6A A4 EF 22 36 6E A4 F9 10 9B 34 D2 FC 88 4D' + '1B E9 7B 88 CD 1A E9 FB 88 CD 1B E9 07 88 2D 1A 69 01 C4 2F 1A 69 41 C4 96 8D B4 10 62 AB 46 5A' + '18 B1 75 23 2D 82 D8 A6 91 16 45 6C DB 48 8B 21 B6 6B A4 C5 11 DB 37 D2 12 88 1D 1A 69 49 C4 8E' + '8D B4 14 62 A7 46 5A 1A B1 73 23 2D 83 D8 A5 91 96 45 EC DA 48 CB 21 76 6B A4 E5 11 BF 6C A4 15' + '10 BB 37 D2 8A 88 3D 1A 69 25 C4 9E 8D B4 32 62 AF 46 5A 05 B1 77 23 AD 8A D8 A7 91 56 43 EC DB' + '48 AB 23 F6 6B 38 08 A4 F5 EE 39 A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5' + '9E 43 BA 5C EE 39 A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5 9E 43 BA 5C EE' + '39 A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5 9E' + '43 BA 5C EE 39 A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5 9E 43 BA 5C EE 39' + 'A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5 9E 43' + 'BA 5C EE 39 A4 CB E5 9E 43 BA 5C EE 39 A4 CB E5 9E C3 FE 2C 1A EB E7 75 CA 72 9E 48 3B 5E EF F4' + 'C9 58 54 46 02 FB 68 82 1A 09 D2 99 04 43 23 81 7D 34 C1 A8 91 20 9D 4D 30 C1 48 60 1F 4D 30 E1' + '48 90 CE 25 98 68 24 B0 8F 26 98 78 24 48 E7 11 7C 6A 24 B0 8F 26 F8 F4 48 90 2E 20 98 64 24 B0' + '8F 26 F8 CC 48 90 2E 22 98 74 24 B0 8F 26 F8 EC 48 90 2E 21 F8 DC 48 60 1F 4D F0 F9 91 20 5D 46' + '30 D9 48 60 1F 4D F0 85 91 20 5D 41 F0 C5 91 C0 3E 9A 60 F2 91 20 5D 49 30 C5 48 60 1F 4D 30 E5' + '48 90 AE 26 F8 D2 48 60 1F 4D F0 E5 91 20 5D 4B 30 D5 48 60 1F 4D F0 95 91 20 5D 4F F0 D5 91 C0' + '3E 9A E0 6B 23 41 BA 81 60 78 24 B0 8F 26 98 7A 24 48 37 11 4C 33 12 D8 47 13 0C 46 82 F4 5B 82' + '69 47 02 FB 68 82 E9 46 02 FB 68 82 E9 47 82 74 1B C1 D7 47 02 FB 68 82 19 46 82 74 07 C1 8C 23' + '41 BA 8B 60 E6 91 20 3D 40 30 32 12 A4 87 27 CB 96 96 D4 E1 C3 7A 24 01 B6 8E 18 D6 A3 09 B0 75' + 'E4 B0 1E 4B 80 AD A3 86 F5 78 02 6C 1D 3D AC 27 12 60 EB 98 61 3D 99 00 5B C7 0E EB A9 04 D8 3A' + '6E 58 4F 27 C0 D6 F1 C3 7A 26 01 B6 4E 18 D6 B3 09 B0 75 E2 B0 9E 4B 80 AD 93 86 F5 7C 02 6C 9D' + '3C AC 17 12 60 EB 94 61 BD 98 00 5B A7 0E EB A5 04 D8 3A 6D 58 2F 27 C0 D6 E9 C3 7A 25 01 B6 CE' + '18 D6 AB 09 B0 75 E6 B0 5E 4B 80 AD B3 86 F5 7A 02 6C 9D 3D AC 37 12 60 EB 9C 61 BD 99 00 5B E7' + '0E EB AD 04 D8 1A 33 AC B7 13 60 EB BC 61 BD 93 00 5B E7 0F EB 77 09 B0 75 C1 B0 DE 4D 80 AD 0B' + '87 F5 5E 02 6C 5D 34 AC F7 13 60 EB E2 61 FD 3E 01 B6 2E 19 D6 1F 12 60 EB D2 61 FD 31 01 B6 2E' + '1B D6 9F 12 60 EB F2 61 7D 90 00 5B 57 0C EB C3 04 D8 FA F5 B0 FE 9C 00 5B 57 0E EB 2F 09 B0 75' + 'D5 B0 FE 9A 00 5B 57 0F EB 6F 09 B0 75 CD B0 FE 9E 00 5B D7 0E EB 1F 09 B0 75 DD B0 3E 4A 80 AD' + 'EB 87 F5 EF 04 D8 BA 71 58 FF 49 80 AD 9B 86 F5 DF 04 D8 BA 79 58 A7 4F EE FF 3E 73 A1 2F 2D 56' + '5B 59 9D 69 B5 B5 D5 59 56 DB 58 9D 6D B5 AD D5 39 56 DB 59 9D 6B B5 BD D5 18 AB 1D AC CE B3 DA' + 'D1 EA 7C AB 9D AC 2E B0 DA D9 EA 42 AB 5D AC 2E B2 DA D5 EA 62 AB DD AC 2E B1 FA A5 D5 A5 56 BB' + '5B 5D 66 B5 87 D5 E5 56 7B 5A 5D 61 B5 97 D5 AF AD F6 B6 BA D2 6A 1F AB AB AC F6 B5 BA DA 6A 3F' + 'AB 6B AC F6 B7 BA D6 EA 00 AB EB AC 0E B4 BA DE EA 20 AB DF 58 1D 6C 75 83 D5 21 56 37 5A FD CA' + 'EA 26 AB 43 AD 6E B6 3A CC EA B7 56 87 5B DD 62 75 84 D5 AD 56 47 5A DD 66 75 94 D5 ED 56 47 5B' + 'DD 61 75 8C D5 9D 56 C7 5A DD 65 75 9C D5 DD 56 C7 5B DD 63 75 82 D5 BD 56 27 5A DD 67 75 92 D5' + 'FD 56 27 5B 3D 60 75 8A D5 83 56 A7 5A 3D 64 75 9A D5 C3 56 A7 5B 3D 62 75 86 D5 A3 56 67 5A 3D' + '66 75 96 D5 E3 56 67 5B 3D 61 75 8E D5 93 56 E7 5A 3D 65 35 C6 EA 69 AB F3 AC 9E B1 3A DF EA 59' + 'AB 0B AC 9E B3 BA D0 EA 79 AB 8B AC 5E B0 BA D8 EA 45 AB 4B AC 5E B2 BA D4 EA 65 AB CB AC 5E B1' + 'BA DC EA 55 AB 2B AC 5E B3 FA B5 D5 EB 56 57 5A BD 61 75 95 D5 9B 56 57 5B BD 65 75 8D D5 DB 56' + 'D7 5A BD 63 75 9D D5 EF AC AE B7 7A D7 EA 37 56 EF 59 DD 60 F5 BE D5 8D 56 BF B7 BA C9 EA 0F 56' + '37 5B FD D1 EA EF 93 FB C8 6A F5 0F AB 0F AC 3E B2 FA D0 EA 9F 56 7F B6 FA 97 D5 5F AC FE 6D C5' + 'B7 55 BE FF 8F 2D F8 E6 CA AB FC A9 05 2F 51 79 AD 0F 5A F0 42 95 57 FC B0 05 2F 57 79 DD 3F B7' + 'E0 45 2B AF FE 97 16 7B 0C F7 BF 15 8D FB 27 89 3D 87 FB 5F 88 C6 FD 43 C4 5E C3 FD EF 35 E3 FE' + '59 60 EF E1 FE 87 99 71 FF FD 7F 9F E1 FE B7 99 71 FF 04 B0 EF FF 13 EF 37 DC FF A6 32 EE 3F DD' + 'EF 3F DC FF 2D 7A DC 7F 85 3E 80 78 99 73 BD C3 3A 37 B0 2E 65 7D CA 4A C5 BA 94 F5 29 2B 15 EB' + '52 D6 A7 AC 54 AC 4B 59 9F B2 52 B1 2E 65 7D CA 4A C5 BA 94 F5 29 2B 15 EB 52 D6 A7 AC 54 AC 4B' + '59 9F B2 52 B1 2E 65 7D CA 4A C5 BA 94 F5 29 2B 15 EB 52 D6 A7 AC 54 AC 4B 59 9F B2 52 B1 2E 65' + '7D CA 4A C5 BA 94 F5 29 2B 15 EB 52 D6 A7 AC 54 AC 4B 59 9F B2 52 B1 2E 65 7D CA 4A C5 BA 94 F5' + '29 2B 15 EB 52 D6 A7 AC 54 AC 4B 59 9F B2 52 B1 2E 65 7D CA 4A C5 BA 94 F5 29 2B 15 EB 52 D6 A7' + 'AC 54 AC 4B 59 9F B2 52 B1 2E 65 7D CA 4A C5 BA 94 F5 29 2B 15 EB 52 D6 A7 AC 54 AC 4B 59 9F B2' + '52 B1 2E 65 7D CA 4A C5 BA 94 F5 29 2B 15 EB 52 D6 A7 AC 54 AC 4B 59 9F B2 52 B1 2E 65 7D CA 4A' + 'C5 BA 94 F5 29 2B 15 EB 52 D6 A7 AC 54 AC 4B 59 9F B2 52 B1 2E 65 7D CA 4A C5 BA 94 F5 29 2B 15' + 'EB 52 D6 A7 AC 54 AC 4B 59 9F B2 52 B1 2E 65 7D CA 4A C5 BA 94 F5 29 2B 15 EB 52 D6 A7 AC 54 AC' + '4B 59 9F B2 52 B1 2E 65 7D CA 4A C5 BA 94 F5 29 2B D5 4E 53 E7 1E 84 31 61 B7 04 EB 8E 0E 87 26' + 'B8 73 4C D0 34 EC 8A 1B CF F8 FC E7 98 69 C2 10 6E 54 23 C5 94 53 30 01 6E C2 46 8A 29 A7 60 22' + 'DC C4 8D 14 53 4E C1 A7 70 9F 6E A4 98 72 0A 26 C1 7D A6 91 62 CA 29 98 14 F7 D9 46 8A 29 A7 E0' + '73 B8 CF 37 52 4C 39 05 93 E1 BE D0 48 31 E5 14 7C 11 37 79 23 C5 94 53 30 05 6E CA 46 8A 29 A7' + 'E0 4B B8 2F 37 52 4C 39 05 53 E1 BE D2 48 31 E5 14 7C 15 F7 B5 46 8A 29 A7 60 18 37 75 23 C5 94' + '53 30 0D 6E D0 48 83 6E C5 34 61 5A DC 74 8D 14 53 4E C1 F4 B8 AF 37 52 4C 39 05 33 E0 66 6C A4' + '98 72 0A 66 C2 CD DC 48 31 E5 14 CC 82 9B B5 91 62 CA 29 98 0D F7 8D 46 8A 29 A7 60 34 6E A4 91' + '62 CA 29 98 1D F7 CD 46 8A 29 A7 E0 5B B8 39 1A 29 A6 9C 82 39 71 73 35 52 4C 39 05 73 E3 E6 69' + 'A4 98 72 0A E6 C5 7D BB 91 62 CA 29 F8 0E EE BB 8D 14 53 4E C1 7C B8 F9 1B 29 A6 9C 82 EF E1 BE' + 'DF 48 31 E5 14 FC 00 B7 40 23 C5 94 53 B0 20 6E A1 46 8A 29 A7 60 61 DC 22 8D 14 53 4E C1 A2 B8' + 'C5 1A 29 A6 9C 82 C5 71 4B 34 52 4C 39 05 4B E2 96 6A A4 98 72 0A 96 C6 2D D3 48 31 E5 14 2C 8B' + '5B AE 91 62 CA 29 58 1E B7 42 23 C5 94 53 B0 22 6E A5 46 8A 29 A7 60 65 DC 2A 8D 14 53 4E C1 AA' + 'B8 D5 1A 29 A6 9C 82 D5 71 6B 34 52 4C 39 05 3F C4 AD D9 48 31 E5 14 FC 08 F7 E3 46 8A 29 A7 E0' + '27 B8 9F 36 52 4C 39 05 3F C3 FD BC 91 62 CA 29 58 0B B7 76 23 C5 94 53 B0 0E 6E DD 46 8A 29 A7' + '60 3D DC FA 8D 14 53 4E C1 06 B8 0D 1B 29 A6 9C 82 8D 70 1B 37 52 4C 39 05 9B E0 36 6D A4 98 72' + '0A 36 C3 6D DE 48 31 E5 14 6C 81 FB 45 23 C5 94 53 B0 25 6E AB 46 8A 29 A7 60 6B DC 36 8D 14 53' + '4E C1 B6 B8 ED 1A 29 A6 9C 82 ED 71 3B 34 52 4C 39 05 3B E2 76 6A 58 4B 52 71 0A 76 C6 ED D2 48' + '31 E5 14 EC 8A DB AD 91 62 CA 29 F8 25 6E F7 46 8A 29 A7 60 0F DC 9E 8D 14 53 4E C1 5E B8 BD 1B' + '29 A6 9C 82 7D 70 FB 36 52 4C 39 05 FB E1 F6 6F A4 98 72 0A 0E C0 1D D8 48 31 E5 14 1C 84 3B B8' + '91 62 CA 29 38 04 F7 AB 46 8A 29 A7 E0 50 DC 61 8D 14 53 4E C1 E1 B8 23 1A 36 73 A9 38 05 47 E2' + '8E 6A D8 CC A5 E2 14 1C 8D 3B A6 61 33 97 8A 53 70 2C CB F0 46 5C 27 FD 3F AF 44 2E 19 39 D6 1D' + '47 62 5B E5 7F C7 69 B9 6A E4 58 77 3C 89 1D A4 49 FC 3F 17 44 AE 11 39 D6 9D 40 62 A7 AE 59 AE' + 'D9 B5 76 27 92 58 9B 5D 85 FF 07 FC C8 85 22 C7 BA 93 C6 FE 15 8D FB FB 39 75 9A 4F 3E 10 81 6D' + '1F E9 33 1A B6 7D 79 17 4E C1 99 B8 B3 1A B6 7D A9 38 05 67 E3 CE 69 D8 F6 A5 E2 14 9C 8B 1B D3' + 'B0 ED 4B C5 29 38 0F 77 7E C3 B6 2F 15 A7 E0 02 DC 85 0D DB BE 54 9C 82 8B 70 17 37 6C FB 52 71' + '0A 2E C1 5D DA B0 ED 4B C5 29 B8 0C 77 79 C3 B6 2F 15 A7 E0 0A DC AF 1B B6 7D A9 38 05 57 E2 AE' + '6A D8 F6 A5 E2 14 5C 8D BB A6 61 DB 97 8A 53 70 2D EE BA 86 6D 5F 2A 4E C1 F5 B8 DF 34 9C B1 53' + '71 0A 6E C0 DD D8 B0 21 4C C5 29 B8 09 77 73 C3 86 30 15 A7 E0 B7 B8 5B 1A 4E DD A9 38 05 B7 E2' + '6E 6B 38 7B A7 E2 14 DC 8E BB A3 E1 04 9E 8A 53 70 27 EE AE 86 73 78 2A 4E C1 DD B8 7B 1A 4E E3' + 'A9 38 05 F7 E2 EE 6B 38 93 A7 E2 14 DC 8F 7B A0 E1 64 9E 8A 53 F0 20 EE A1 86 F3 79 2A 4E C1 C3' + 'B8 47 1A 4E E9 A9 38 05 8F E2 1E 6B 38 AB A7 E2 14 3C 8E 7B A2 E1 C4 9E 8A 53 F0 24 EE A9 86 73' + '7B 2A 4E C1 D3 B8 67 1A 4E EF A9 38 05 CF E2 9E 6B 38 C3 A7 E2 14 3C 8F 7B A1 E1 24 9F 8A 53 F0' + '22 EE A5 86 F3 7C 2A 4E C1 CB B8 57 1A 4E F5 A9 38 05 AF E2 5E 6B 38 DB A7 E2 14 BC 8E 7B A3 E1' + '84 9F 8A 53 F0 26 EE AD 86 73 7E 2A 4E C1 DB B8 77 1A 4E FB A9 38 05 BF C3 BD DB 70 E6 4F C5 29' + '78 0F F7 7E C3 C9 3F 15 A7 E0 F7 B8 3F 34 9C FF 53 71 0A FE 88 FB 53 23 C5 94 53 F0 01 EE C3 46' + '8A 29 A7 E0 CF B8 BF 34 52 4C 39 05 7F C5 FD AD 91 62 CA 29 F8 3B EE 1F 8D 14 53 4E C1 47 B8 7F' + '36 52 4C 39 05 FF C2 FD BB 91 62 CA 29 F8 0F EE BF 8D 14 53 4E 81 06 39 B4 0C 9A 04 9F 1E 84 A1' + '04 93 0C C2 A8 04 9F 19 84 09 12 4C 3A 08 13 26 F8 EC 20 4C 94 E0 73 83 30 71 82 CF 0F 82 5F 5D' + '0D 27 25 44 35 5C A0 11 43 0D 27 25 C4 A8 46 F2 4F 98 A0 E1 A4 84 98 B0 91 FC 13 26 6A 38 29 21' + '26 6E A4 C9 F2 43 A7 1A 84 2F 24 F8 CA 20 7C 31 C1 57 07 61 F2 04 5F 1B 84 29 12 0C 0F C2 94 09' + 'A6 1E 04 BF CE 64 0D E7 21 C4 17 1A C9 AF F3 C5 86 F3 10 62 F2 46 F2 EB 4C D1 70 1E 42 4C D9 48' + 'D3 E6 A5 67 19 84 E9 12 CC 3A 08 D3 27 98 6D 10 BE 9E E0 1B 83 30 43 82 D1 83 30 63 82 91 41 98' + '29 C1 EC 83 30 73 82 6F 0E 82 7F C2 B4 0D A7 1E C4 74 8D E4 9F 30 7D C3 A9 07 F1 F5 46 F2 4F 98' + 'A1 E1 D4 83 98 B1 91 FC 13 66 6A 38 F5 20 66 6E A4 6F E5 87 7E 67 10 E6 48 F0 DD 41 98 33 C1 7C' + '83 30 57 82 F9 07 61 EE 04 DF 1B 84 79 12 7C 7F 10 E6 4D F0 83 41 F8 76 82 05 06 C1 3F E1 5B 0D' + 'A7 1E C4 1C 8D E4 9F 30 67 C3 A9 07 31 57 23 F9 27 CC DD 70 EA 41 CC D3 48 FE 09 F3 36 9C 7A 10' + 'DF 6E A4 05 F3 43 97 1C 84 85 12 2C 35 08 0B 27 58 7A 10 16 49 B0 CC 20 2C 9A 60 D9 41 58 2C C1' + '72 83 E0 D7 59 B0 E1 6C 83 58 A8 91 FC 3A 0B 37 9C 6D 10 8B 34 92 5F 67 D1 86 B3 0D 62 B1 46 5A' + '91 3F C8 3B 46 69 72 F6 37 96 E7 44 8E 75 2B E5 C7 AE 39 08 2B 0F 72 83 0C 69 F1 B5 8E CE 19 17' + 'FD 9F 5A 25 DF F1 E3 41 58 F5 E3 EF F0 2D 35 AB 7E FC 1D 35 EA 13 6A B5 7C C7 4F 07 61 F5 8F BF' + '63 61 8A AB 7F FC 1D 0B 8F FA 84 5A 23 DF F1 F3 41 F0 2F B7 52 C3 F1 07 B1 4A C3 89 07 B1 5A C3' + '21 07 B1 46 23 AD 95 17 D8 68 10 D6 4E B0 F1 20 AC 93 60 93 41 58 37 C1 A6 83 B0 5E 82 CD 06 61' + 'FD 04 9B 0F C2 06 09 B6 18 84 0D 13 FC 62 10 FC 13 D6 6A 38 E4 20 D6 6E 24 FF 84 75 1A 0E 39 88' + '75 1B C9 3F 61 BD 86 43 0E 62 FD 46 F2 4F D8 A0 E1 90 83 D8 B0 91 B6 CC 0F BD 7E 10 B6 4A F0 9B' + '41 D8 3A C1 DD 83 B0 4D 82 7B 06 61 DB 04 F7 0E C2 76 09 EE 1B 84 ED 13 3C 3B 08 3B 24 78 6E 10' + '76 4C F0 F7 41 D8 29 C1 3F 06 61 E7 04 BF 1B 84 5D 12 BC 3B 08 BB 26 F8 68 10 76 4B F0 CF 41 D8' + '83 D9 C6 45 DB F7 A5 21 EB 80 66 4F B2 D5 59 64 1D D8 EC 45 76 A8 B3 C8 3A A8 D9 9B EC A8 CE 22' + 'EB E0 66 1F B2 13 74 16 59 87 34 FB 92 9D B0 B3 C8 FA 55 B3 1F D9 89 3A 8B AC 43 9B FD C9 4E DC' + '59 64 1D D6 1C 30 DE EF 3B C4 DA 73 C2 28 1D 38 DE AF 3C F4 E9 14 0E 1A EF B7 1E 9A 24 85 83 C7' + 'FB C5 87 3E 93 C2 21 E3 FD EE 43 93 A6 F0 AB F1 7E FD A1 CF A6 70 E8 78 EF 60 E8 73 29 1C 36 DE' + '9B 18 FA 7C 0A 87 A3 A6 ED 02 B2 8E 6F 8E 20 3B 5D 67 91 75 42 73 24 D9 E9 3B 8B AC 13 9B A3 C8' + '7E BD B3 C8 3A A9 39 9A EC 0C 9D 45 D6 C9 CD 31 64 67 EC 2C B2 4E 69 8E 25 3B 53 67 91 75 6A 73' + '1C D9 99 3B 8B AC D3 9A E3 C7 FB 7D 87 66 C9 1B 39 61 BC 5F 79 68 D6 14 4E 1C EF B7 1E 9A 2D 85' + '93 C6 FB C5 87 BE 91 C2 C9 E3 FD EE 43 A3 53 38 65 BC 5F 7F 68 24 85 53 C7 7B 07 43 B3 A7 70 DA' + '78 6F 62 E8 9B 29 9C 8E 5A AB 0B C8 3A AF 39 83 EC DA 9D 45 D6 F9 CD 99 64 D7 E9 2C B2 2E 68 CE' + '22 BB 6E 67 91 75 61 73 36 D9 F5 3A 8B AC 8B 9A 73 C8 AE DF 59 64 5D DC 9C 4B 76 83 CE 22 EB 92' + '66 0C D9 0D 3B 8B AC 4B 9B F3 C6 FB 7D 87 36 CA 1B 39 7F BC 5F 79 68 E3 14 2E 18 EF B7 1E DA 24' + '85 0B C7 FB C5 87 36 4D E1 A2 F1 7E F7 A1 CD 52 B8 78 BC 5F 7F 68 F3 14 2E 19 EF 1D 0C 6D 91 C2' + 'A5 E3 BD 89 A1 5F A4 70 59 2E 3A D7 0E C2 E5 09 AE 1B 84 2B F8 9A 2D FB 5B 2C B9 78 2E 36 2A 8E' + 'EF FA 35 89 CB 73 23 66 21 EB 86 E6 4A B2 17 75 D6 72 BF DC D4 6C C7 77 5C DD DF E1 85 CB F2 88' + 'C8 B1 EE 1A 56 B2 AE F9 5B 1D 75 9E EF 1E AB 78 01 FF 8A 97 35 9C 6C 11 97 37 92 2F ED 5B 36 9C' + '6C 11 5B 35 D2 0D E3 FD 9A FE 89 BC D8 4D 83 FF BD D9 FA 56 2A DB F6 7B B5 BC B7 DF EB BD 79 AF' + 'B7 91 B8 A6 5F 04 59 F7 37 B7 93 BD A4 B3 96 07 F6 7B 3D 30 AF 7E 67 7F 87 DF AB E5 71 FD 5E DB' + 'DD C5 BB BB E6 E3 F7 EA E8 B8 8F DF EB 71 E3 DE AB 97 A4 AD 1B 4E BD 88 6D 1A C9 4B D2 B6 0D A7' + '5E C4 76 8D 74 FF 78 BF A6 7F 22 2F F6 70 9A FA F4 20 3C 92 E0 99 41 78 74 30 EE 2E 6C EF 59 1C' + '9D 30 2E FA 3F F5 D8 E0 93 B7 6A 3F 36 F8 FF BD 55 FB 49 7E DA 75 FD 8E 2D 4F E8 77 DC EE A9 8F' + '5F C0 E5 A7 3E 7E 81 85 47 7D 42 F9 D7 7B B8 E1 5C 8C 78 A4 91 BC D4 6E DF 70 2E 46 EC D0 48 2F' + 'E7 BD BC 3D 08 AF 24 78 67 10 5E 1D 8C BB 5B D9 6F EC D5 C1 B8 7B 94 35 EA 13 EA B5 C1 27 6F 69' + '7E 6D F0 FF 7B 4B F3 EB BC 9B 5B 7A 33 66 79 46 EF FF DA BD 91 1F F9 DE 20 BC D9 1B 45 BF C5 37' + '7B A3 B8 F0 A8 71 EE AD 8F 7F 92 CB 6F 7D FC 93 16 1E F5 09 E5 F7 F1 72 C3 49 1A F1 4A 23 79 E3' + 'B0 73 C3 49 1A B1 4B 23 F9 67 BF D1 48 1F F0 63 77 ED 39 6C F9 51 CF E1 8F 32 87 3F 24 71 4F 4F' + '0E 64 FD AB F9 33 D9 07 3B 6B 79 58 CF E1 C3 32 6B FE DA DF E1 5F D8 F2 FC 7E 3F ED FE C6 3B B8' + 'E7 E3 39 EC E8 FC 8F E7 F0 F9 E3 E6 B0 37 42 3B 36 9C A4 11 3B 35 92 B7 3B BB 36 9C A4 11 BB 35' + 'D2 BF C6 FB 35 FD 13 79 B1 99 A6 FB C4 9D ED B3 4D F7 89 67 20 7F 63 BA 4F 3C 9A 76 4E 82 E5 1B' + '29 A6 9C 82 B5 70 5B 36 D2 DA 88 AD 1A 69 1D C4 D6 8D B4 2E 62 9B 46 5A 0F B1 6D 23 AD 8F D8 AE' + '91 36 40 6C DF 48 1B 22 76 68 A4 8D 10 3B 36 6C 6A 11 3B 35 6C 6A 11 3B 37 6C 6A 11 BB 34 6C 6A' + '11 BB 36 6C 6A 11 BB 35 6C 6A 11 BF 6C D8 D4 22 76 6F D8 D4 E6 CD F9 5D 41 DE 47 F9 5D 41 DE 47' + 'F9 5D 41 DE 47 F9 5D 41 DE 47 F9 5D 41 DE 47 F9 5D 41 DE 47 F9 5D 41 DE 47 F9 5D 41 DE 47 F9 5D' + '41 DE 47 F9 5D 41 DE 47 F9 5D 41 DE 47 F9 5D 41 DE 47 F9 5D 41 DE 47 F9 5D 41 DE 47 F9 5D 41 DE' + '47 F9 5D C1 DE B8 7D 1A 29 A6 9C 82 AB 67 E0 AA D0 48 D7 20 1E 69 A4 6B 11 8F 36 AC 08 88 C7 1A' + '56 04 C4 E3 0D 2B 02 E2 89 86 15 01 F1 64 23 DD 88 78 AA 91 6E 42 3C DD 48 37 23 9E 69 A4 DF 22' + '9E 6D A4 5B 10 CF 35 D2 AD 88 E7 1B E9 36 C4 0B 8D 74 3B E2 C5 46 BA 03 F1 52 23 DD 89 78 B9 91' + 'EE 42 BC D2 48 77 23 5E 6D B8 EA 23 5E 6B B8 EA 23 5E 6F B8 EA 23 DE 68 B8 EA 23 DE 6C A4 07 10' + '6F 35 D2 83 88 B7 1B E9 21 C4 3B 8D 94 91 2C 8F 2B 64 24 CB E3 0A 19 C9 F2 B8 42 46 B2 3C AE 90' + '91 2C 8F 2B 64 24 CB E3 0A 19 C9 F2 B8 42 46 B2 3C AE 90 91 2C 8F 2B 64 24 CB E3 0A 19 C9 F2 B8' + '42 46 B2 3C AE 90 91 2C 8F 2B 64 24 CB E3 0A 19 C9 F2 B8 42 46 B2 3C AE 90 91 2C 8F 2B 64 24 CB' + 'E3 0A 19 C9 F2 B8 42 46 B2 3C AE 90 91 2C 8F 2B 64 24 CB E3 0A 19 C9 F2 B8 42 46 B2 3C AE 90 91' + '2C 8F 2B 64 24 CB E3 0A 1A AD FA 56 E3 FF 6A A4 9A A3 11 1B 65 2E 3F 0D 6B 0E 62 AE 46 9A 00 31' + '77 23 4D 88 98 A7 91 26 42 CC DB 48 13 23 BE DD 48 9F 42 7C A7 91 3E 8D F8 6E 23 4D 82 98 AF 91' + '3E 83 98 BF 91 26 45 7C AF 91 3E 8B F8 7E 23 7D 0E F1 83 46 FA 3C 62 81 46 9A 0C B1 60 23 7D 01' + 'B1 50 23 7D 11 B1 70 23 4D 8E 58 A4 91 A6 40 2C DA 48 53 22 16 6B A4 2F 21 16 6F A4 2F 23 96 68' + 'A4 A9 10 4B 36 D2 57 10 4B 35 D2 57 11 4B 37 D2 D7 10 CB 34 D2 30 62 D9 46 9A 1A B1 5C 23 4D 83' + '58 BE 91 06 88 15 1A 69 5A C4 8A 8D 34 1D 62 A5 46 9A 1E B1 72 23 7D 1D B1 4A 23 CD 80 58 B5 91' + '66 44 AC D6 48 33 21 56 6F A4 99 11 6B 34 D2 2C 88 1F 36 D2 AC 88 35 1B D6 2C C4 8F 1A D6 2C C4' + '8F 1B A6 0E E2 27 8D 34 82 F8 69 23 CD 8E F8 59 23 F5 D4 F2 44 83 4C AD F2 44 83 4C AD F2 44 83' + '4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD' + 'F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44' + '83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C' + 'AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2' + '44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83' + '4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD F2 44 83 4C AD' + 'F2 44 83 4C AD F2 44 83 4C AD F2 44 83 9F F4 65 69 74 C8 D4 2A 4F 34 C8 D4 2A 4F 34 58 0B B7 76' + 'C3 1E 29 15 A7 C0 0F E7 DA 74 28 B0 47 22 D8 6D EA C0 1E C9 C1 50 60 8F 94 EF F1 73 DD 20 8F 68' + '2B 3F B0 0D 36 E4 CB 36 6A D8 23 A5 E2 14 6C 8C DB A4 61 8F 94 8A 53 B0 29 6E B3 86 3D 52 2A 4E' + '81 1F 84 B6 D2 50 60 8F 44 B0 D5 50 60 8F E4 3F F2 A1 C0 1E C9 7F D7 43 41 DA 9A 60 9B 46 8A 29' + 'A7 60 3B DC F6 8D 14 53 4E 81 1F 2D B7 C0 50 90 FC 68 B9 05 87 82 B4 07 C1 9E 8D 14 53 4E C1 5E' + 'B8 BD 1B 29 A6 9C 82 7D 70 FB 36 52 4C 39 05 FB E1 F6 6F A4 98 72 0A 0E C0 1D D8 48 31 E5 14 1C' + '84 3B B8 91 62 CA 29 38 04 F7 AB 46 8A 29 A7 E0 50 DC 61 8D 14 53 4E C1 E1 B8 23 1A 29 A6 9C 82' + '23 71 47 35 52 4C 39 05 47 E3 8E 69 A4 98 72 0A 8E C5 1D D7 48 31 E5 14 1C 8F 3B A1 91 62 CA 29' + '38 11 77 52 23 C5 94 53 70 32 EE 94 46 8A 29 A7 E0 54 DC 69 8D 14 53 4E C1 E9 B8 33 1A 29 A6 9C' + '82 33 71 67 35 52 4C 39 05 67 E3 CE 69 A4 98 72 0A CE C5 8D 69 A4 98 72 0A CE C3 9D DF 48 31 E5' + '14 5C 80 BB B0 91 62 CA 29 B8 08 77 71 23 C5 94 53 70 09 EE D2 46 8A 29 A7 E0 32 DC E5 8D 14 53' + '4E C1 15 B8 5F 37 52 4C 39 05 57 E2 AE 6A A4 98 72 0A AE C6 5D D3 B0 A5 4E C5 29 B8 16 77 5D C3' + '96 3A 15 A7 E0 7A DC 6F 1A B6 D4 A9 38 05 37 E0 6E 6C D8 52 A7 E2 14 DC 84 BB B9 61 4B 9D 8A 53' + 'F0 5B DC 2D 0D 5B EA 54 9C 82 5B 71 B7 35 6C A9 53 71 0A 6E C7 DD D1 B0 A5 4E C5 29 B8 13 77 57' + 'C3 96 3A 15 A7 E0 6E DC 3D 0D 5B EA 54 9C 82 7B 71 F7 35 6C A9 53 71 0A EE C7 3D D0 B0 A5 4E C5' + '29 78 10 F7 50 C3 96 3A 15 A7 E0 61 DC 23 8D 14 53 4E C1 A3 B8 C7 1A 29 A6 9C 82 C7 71 4F 34 52' + '4C 39 05 4F E2 9E 6A A4 98 72 0A 9E C6 3D D3 48 31 E5 14 3C 8B 7B AE 91 62 CA 29 78 1E F7 42 23' + 'C5 94 53 F0 22 EE A5 46 8A 29 A7 E0 65 DC 2B 8D 14 53 4E C1 AB B8 D7 1A 29 A6 9C 82 77 71 EF 35' + '52 4C 39 05 EF E3 7E DF 48 31 E5 14 7C 80 FB B0 91 62 CA 29 C8 9D 76 E5 FB EE 4C 02 DF 77 07 B9' + 'D3 AE 7C DF 1D E4 4E BB F2 7D 77 90 3B ED CA F7 DD 41 EE B4 2B DF 77 07 B9 D3 AE 7C DF 1D E4 4E' + 'BB F2 7D 77 90 3B ED CA F7 DD 41 EE B4 2B DF 77 07 B9 D3 AE 7C DF 1D E4 4E BB F2 7D 77 90 3B ED' + 'CA F7 DD 41 EE B4 2B DF 77 07 B9 D3 AE 7C DF 1D E4 4E BB F2 7D 77 90 3B ED CA F7 DD 41 EE B4 2B' + 'DF 77 07 B9 D3 AE 7C DF 1D E4 4E BB F2 7D 77 90 3B ED CA F7 DD 41 EE B4 2B DF 77 07 B9 D3 AE 7C' + 'DF 1D E4 4E BB F2 7D 77 90 3B ED CA F7 DD 41 EE B4 2B DF 77 07 B9 D3 AE 7C DF 1D E4 4E BB F2 7D' + '77 90 3B ED CA F7 DD 41 EE B4 2B DF 77 07 B9 D3 AE 7C DF 1D E4 4E BB F2 7D 77 90 3B ED CA F7 DD' + '41 EE B4 2B DF 77 07 B9 D3 AE 7C DF 1D E4 4E BB F2 7D 77 90 3B ED CA F7 DD 41 EE B4 2B DF 77 07' + 'B9 D3 AE 7C DF 1D E4 4E BB F2 7D 77 B0 E0 B9 9C 3C 1A 29 A6 9C 82 85 71 8B 34 52 4C 39 05 8B E2' + '16 6B A4 98 72 0A 16 C7 2D D1 48 31 E5 14 2C 89 5B AA 91 62 CA 29 F0 8D 15 CB 34 52 CC B8 7B 2D' + '96 C5 2D D7 48 31 E5 14 2C 8F 5B A1 91 62 CA 29 58 11 B7 52 23 C5 94 53 B0 32 6E 95 46 8A 29 A7' + '60 55 DC 6A 8D 14 53 4E C1 EA B8 35 1A 29 A6 9C 82 1F E2 D6 6C A4 98 72 0A 7E 84 FB 71 23 C5 94' + '53 F0 13 DC 4F 1B 29 A6 9C 82 9F E1 7E DE 48 31 E5 14 AC 85 5B BB 61 D3 98 8A 53 B0 0E 6E DD 86' + '4D 63 2A 4E C1 7A B8 F5 1B 36 8D A9 38 05 1B E0 36 6C A4 98 72 0A 36 C2 6D DC 48 31 E5 14 6C 82' + 'DB B4 91 62 CA 29 D8 0C B7 79 23 C5 94 53 B0 07 6E CF 86 FD 5B 2A 4E C1 5E B8 BD 1B F6 6F A9 38' + '05 FB E0 F6 6D D8 BF A5 E2 14 EC 87 DB BF 61 FF 96 8A 53 70 00 EE C0 86 FD 5B 2A 4E C1 41 B8 83' + '1B F6 6F A9 38 05 87 E0 7E D5 B0 7F 4B C5 29 38 14 77 58 C3 FE 2D 15 A7 E0 70 DC 11 0D FB B7 54' + '9C 82 23 71 47 35 EC DF 52 71 0A 8E C6 1D D3 B0 7F 4B C5 29 38 16 77 5C C3 FE 2D 15 A7 E0 78 DC' + '09 0D FB B7 54 9C 82 13 71 27 35 EC DF 52 71 0A A6 1F C3 61 A7 E1 88 3D 26 87 A1 31 61 06 DC 8C' + '0D 47 EC 54 9C 82 99 70 33 37 1C B1 53 71 0A 66 C1 CD DA 70 C4 4E C5 29 98 0D F7 8D 86 23 76 2A' + '4E C1 68 DC 48 C3 BA 92 8A 53 30 3B EE 9B 8D 14 53 4E C1 9C B8 B9 1A 29 A6 9C 82 B9 71 F3 34 52' + '4C 39 05 F3 E2 BE DD 48 31 E5 14 7C 07 F7 DD 46 8A 29 A7 60 3E DC FC 8D 14 53 4E C1 F7 70 DF 6F' + 'A4 98 72 0A 7E 80 5B A0 91 62 CA 29 58 10 B7 50 C3 D5 32 15 A7 60 61 DC 22 0D 57 CB 54 9C 82 45' + '71 8B 35 5C 2D 53 71 0A 16 C7 2D D1 70 B5 4C C5 29 58 12 B7 54 C3 D5 32 15 A7 60 69 DC 32 0D 57' + 'CB 54 9C 82 65 71 CB 35 5C 2D 53 71 0A 96 C7 AD D0 70 B5 4C C5 29 58 11 B7 52 C3 D5 32 15 A7 60' + '65 DC 2A 0D 57 CB 54 9C 82 55 71 AB 35 5C 2D 53 71 0A 56 C7 AD D1 70 B5 4C C5 29 F8 21 6E CD 86' + 'AB 65 2A 4E C1 8F 70 3F 6E B8 5A A6 E2 14 FC 04 F7 D3 86 AB 65 2A 4E C1 CF 70 3F 6F B8 5A A6 E2' + '14 AC 85 5B BB E1 6A 99 8A 53 B0 0E 6E DD 86 AB 65 2A 4E C1 7A B8 F5 1B AE 96 A9 38 05 1B E0 36' + '6C B8 5A A6 E2 14 6C 84 DB B8 E1 6A 99 8A 53 B0 09 6E D3 86 AB 65 2A 4E C1 66 B8 CD 1B AE 96 A9' + '38 05 5B E0 7E D1 70 C4 4E C5 29 D8 09 B7 73 23 C5 94 53 B0 0B 6E D7 46 8A 29 A7 C0 77 91 ED 34' + '75 90 7E 49 B0 7B C3 11 3B 5F E6 14 EC 81 DB B3 E1 12 9D 8A 53 B0 17 6E EF 86 4B 74 2A 4E C1 3E' + 'B8 7D 1B 2E D1 A9 38 05 FB E1 F6 6F B8 44 A7 E2 14 1C 8C 3B A4 91 62 CA 29 F0 33 CD D7 1F 0A D2' + 'E1 04 47 34 5C 61 F3 65 4E C1 91 B8 A3 1A AE B0 A9 38 05 47 27 B8 7D 4C 38 16 77 5C C3 45 35 15' + 'A7 E0 78 DC 09 0D 17 D5 54 9C 82 13 71 27 35 5C 54 53 71 0A 4E C6 9D D2 70 28 4E C5 29 38 15 77' + '5A C3 A1 38 15 A7 E0 74 DC 19 0D 87 E2 54 9C 82 33 71 67 35 1C 8A 53 71 0A CE C6 9D D3 70 28 4E' + 'C5 29 38 17 37 A6 E1 50 9C 8A 53 70 1E EE FC 86 43 71 2A 4E 81 1F 0C BF C1 50 E0 50 EC 3F 96 A1' + '20 F9 C9 F2 6B 0F 05 0E C5 9E 76 43 41 F2 53 E2 37 19 0A 92 9F 9D 7E EA 50 E0 1C EC 7E 0E 05 C9' + '8F 58 3F 65 28 70 0E F6 85 E1 C2 20 5D 49 70 55 C3 39 38 BF 8E 53 70 35 EE 9A 86 73 70 2A 4E C1' + 'B5 B8 EB 1A CE C1 A9 38 05 D7 E3 7E D3 70 0E 4E C5 29 B8 01 77 63 C3 39 38 15 A7 E0 26 DC CD 0D' + 'E7 E0 54 9C 82 5B 71 B7 35 9C 76 53 71 0A 3C 6B 8E 6E 38 ED 7A 7A 0F 05 C9 F7 5A 1E 3A 75 E0 B4' + '4B 70 77 23 C5 94 53 70 0F EE DE 46 8A 29 A7 E0 2F B8 BF 36 52 4C 39 05 19 AF F2 E8 C1 96 0C 60' + '9E 4C 80 31 5B 11 E7 F9 04 18 B3 35 71 9E 52 80 31 DB 10 E7 59 05 18 B3 2D 71 9E 58 80 31 DB 11' + 'E7 B9 05 18 B3 3D 71 9E 5E 80 31 3B 10 E7 19 06 18 B3 23 71 9E 64 80 31 3B 11 E7 79 06 18 B3 33' + '71 9E 6A 80 31 BB 10 E7 D9 06 18 B3 2B 71 9E 70 80 31 BB 11 E7 39 07 18 F3 4B E2 3C ED 00 63 76' + '27 CE 33 0F 30 66 0F E2 3C F9 00 63 F6 24 CE F3 0F 30 66 2F E2 3C 05 01 63 F6 26 CE B3 10 30 66' + '1F E2 3C 11 01 63 F6 25 CE 73 11 30 66 3F E2 3C 1D 01 63 F6 27 CE 33 12 30 E6 00 E2 3C 29 01 63' + '0E 24 CE F3 12 30 E6 20 E2 3C 35 01 63 0E 26 CE B3 13 30 E6 10 E2 3C 41 01 63 7E 45 9C E7 28 60' + 'CC A1 C4 79 9A 02 C6 1C 46 9C 67 2A 60 CC E1 C4 79 B2 02 C6 1C 41 9C E7 2B 60 CC 91 C4 79 CA 02' + 'C6 1C 45 9C 67 2D 60 CC D1 C4 79 E2 02 C6 1C 43 9C E7 2E 60 CC B1 C4 79 FA 02 C6 1C 47 9C 67 30' + '60 CC F1 C4 79 12 03 C6 9C 40 9C E7 31 60 CC 89 C4 79 2A 03 C6 9C 44 9C 67 33 60 CC C9 C4 79 42' + '03 C6 9C 42 9C E7 34 60 CC A9 C4 79 5A 03 C6 9C 46 9C 67 36 60 CC E9 C4 79 72 03 C6 9C 41 9C E7' + '37 60 CC 99 C4 79 8A 03 C6 9C 45 9C 67 39 60 CC D9 C4 79 A2 03 C6 9C 43 9C E7 3A 60 CC B9 C4 79' + 'BA 03 C6 8C 21 CE 33 1E 30 E6 3C E2 3C E9 01 63 CE 27 CE F3 1E 30 E6 02 E2 3C F5 01 63 2E 24 CE' + 'B3 1F 30 E6 22 E2 3C 01 02 63 2E 26 CE 73 20 30 E6 12 E2 3C 0D 02 63 2E 25 CE 33 21 30 E6 32 E2' + '3C 19 02 63 2E 27 CE F3 21 30 E6 0A E2 3C 25 02 63 7E 4D 9C 67 45 60 CC 95 C4 79 62 04 C6 5C 45' + '9C E7 46 60 CC D5 C4 79 7A 04 C6 5C 43 9C 67 48 60 CC B5 C4 79 92 04 C6 5C 47 9C E7 49 60 CC F5' + 'C4 79 AA 04 C6 FC 86 38 CF 96 C0 98 1B 88 F3 84 09 8C B9 91 38 CF 99 C0 98 9B 88 F3 B4 09 8C B9' + '99 38 CF 9C C0 44 FC 53 43 1B E4 03 A6 CB 72 F1 48 BB C5 F3 61 BF AE F9 03 39 AB 6B 1B 77 6D 29' + '5C D7 FC C1 DC 43 5D DB AC 6B CB 4A A3 FE A9 51 FD 9A FE 56 47 8B 8F 8B 46 F5 2B F3 02 13 7C FC' + '45 7E 8D 09 3E FE A2 CD 3E FE 22 5E 69 C2 7F E6 86 39 7F 2C B7 65 7F A0 B4 DD AA D2 44 FF 57 9B' + 'E8 FF AD 4D 4E 62 DB 3C C9 AB 2C 17 8D B4 5B 7C 42 4D D1 35 3F AC 6E 8A AE AD DF B5 79 26 D4 94' + '5D F3 A3 E7 A6 EC DA A6 5D 9B 7F 42 7D 89 C4 2F FB 35 2D 97 EF D7 5C 3E AF F9 E5 FE 3E 3F 98 EE' + 'CB FD 7D 9B F7 F7 7D 7F 42 4D F7 5F 4E 2A 8D 34 3D 62 E1 86 63 22 62 91 46 9A 01 B1 68 C3 31 11' + 'B1 58 23 CD 84 58 BC E1 98 88 58 A2 91 66 41 2C D9 70 4C 44 2C D5 48 B3 21 96 6E 38 26 22 96 69' + 'A4 D1 88 65 1B 8E 89 88 E5 1A 69 76 C4 F2 0D C7 44 C4 0A 8D F4 2D C4 8A 8D 34 07 62 A5 46 9A 13' + 'B1 72 C3 01 12 B1 4A 23 CD 8D 58 B5 E1 00 89 58 AD 91 E6 45 AC DE 70 80 44 AC D1 48 DF 41 FC B0' + 'E1 00 89 58 B3 91 E6 43 FC A8 E1 C8 F7 DF FC C3 E3 7F 43 46 B2 3C AE 90 91 2C 8F 2B 64 24 CB E3' + '0A 19 C9 F2 B8 42 46 B2 3C AE 90 91 2C 8F 2B 64 24 CB E3 0A 19 C9 F2 B8 42 46 B2 3C AE 90 91 2C' + '8F 2B 64 24 CB E3 0A 19 C9 F2 B8 42 46 B2 3C AE 90 91 2C 8F 2B 64 24 CB E3 0A 19 C9 F2 B8 42 46' + 'B2 3C AE 90 91 2C 8F 2B 64 24 CB E3 0A 19 C9 F2 B8 42 46 B2 3C AE 90 91 2C 8F 2B 64 24 CB E3 0A' + '19 C9 F2 B8 42 46 B2 3C AE A0 09 AA 66 69 F2 09 CE 35 6B E3 4F 3E A8 9A AD F1 27 1F 54 7D A3 F1' + '27 1F 54 8D 6E FC C9 07 55 23 8D 3F F9 A0 6A F6 C6 9F 7C 50 F5 CD C6 9F 7C 50 F5 AD C6 9F 7C 50' + '35 47 E3 4F 3E A8 9A B3 F1 27 1F 54 CD D5 F8 93 0F AA E6 6E FC C9 07 55 F3 34 FE E4 83 AA 79 1B' + '7F F2 41 D5 B7 1B 7F F2 41 D5 77 1A 7F F2 41 D5 77 1B 7F F2 41 D5 7C 8D 3F F9 A0 6A FE C6 9F 7C' + '50 F5 BD C6 9F 7C 50 F5 FD C6 9F 7C 50 F5 83 C6 9F 7C 50 B5 40 E3 4F 3E A8 5A B0 F1 27 1F 54 2D' + 'D4 F8 93 0F AA 16 6E FC C9 07 55 8B 34 FE E4 83 AA 45 1B 7F F2 41 D5 62 8D 3F F9 A0 6A F1 C6 9F' + '7C 50 B5 44 E3 4F 3E A8 5A B2 F1 27 1F 54 2D D5 F8 93 0F AA 96 6E FC C9 07 55 CB 34 FE E4 83 AA' + '65 1B 7F F2 41 D5 72 8D 3F F9 A0 6A F9 C6 9F 7C 50 B5 42 E3 4F 3E C8 C7 80 13 42 FA 5F 9E 0D 90' + 'FE 97 67 03 A4 FF E5 D9 00 A3 7B CE 10 40 FA 5F 9E 0D 90 FE 97 67 03 A4 FF E5 D9 00 E9 7F 79 36' + '40 FA 5F 9E 0D 90 FE 97 67 03 A4 FF E5 D9 00 E9 7F 79 36 40 FA 5F 9E 0D 90 FE 97 67 03 A4 FF E5' + 'D9 00 E9 7F 79 36 40 FA 5F 9E 0D 90 FE 97 67 03 A4 FF E5 D9 00 E9 7F 79 36 40 FA 5F 9E 0D 90 FE' + '97 67 03 A4 FF E5 D9 00 E9 7F 79 36 40 FA 5F 9E 0D 90 FE 97 67 03 A4 FF E5 D9 00 E9 7F 79 36 40' + 'FA 5F 9E 0D 90 FE 97 67 03 A4 FF E5 D9 00 E9 7F 79 36 40 FA 5F 9E 0D 90 FE 97 67 03 A4 FF E5 D9' + '00 E9 7F 79 36 40 FA 5F 9E 0D 90 FE 97 67 03 A4 FF E5 D9 00 97 E1 9E 6E FC 04 F2 AA 67 1A 4E A0' + '88 67 1B 3F 81 BC EA B9 86 13 28 E2 F9 C6 4F 20 AF 7A A1 91 AE 46 BC D8 F8 09 E4 55 2F 35 D2 B5' + '88 97 1B 3F 81 BC EA 95 46 BA 1E F1 6A E3 27 90 57 BD D6 48 37 20 5E 6F FC 04 F2 AA 37 1A E9 26' + 'C4 9B 8D 9F 40 5E F5 56 23 FD 16 F1 76 E3 27 90 57 BD D3 F8 09 E4 55 BF 6B 38 9B 22 DE 6D FC 04' + 'F2 AA F7 1A CE A6 88 F7 1B 3F 81 BC EA F7 0D 67 53 C4 1F 1A 3F 81 BC EA 8F 8D 74 0F E2 4F 8D 9F' + '40 5E F5 41 23 DD 87 F8 B0 F1 13 C8 AB FE DC 48 0F 20 FE D2 F8 09 E4 55 7F 6D A4 87 10 7F 6B A4' + '87 11 7F 6F FC 04 F2 AA 7F 34 D2 A3 88 8F 1A 3F 81 9C 8D 5B 23 A5 97 E9 2C A4 97 E5 CE 42 7A 59' + 'EE 2C A4 97 E5 CE 42 7A 59 EE 2C A4 97 E5 CE 42 7A 59 EE 2C A4 97 E5 CE 42 7A 59 EE 2C A4 97 E5' + 'CE 42 7A 59 EE 2C A4 97 E5 CE 42 7A 59 EE 2C A4 97 E5 CE 42 7A 59 EE 2C A4 97 E5 CE 42 7A 59 EE' + '2C A4 97 E5 CE 42 7A 59 EE 2C A4 97 E5 CE 42 7A 59 EE 2C A4 97 E5 CE 42 7A 59 EE 2C A4 97 E5 CE' + '42 7A 59 EE 2C A4 97 E5 CE 42 7A 59 EE 2C A4 97 E5 CE 42 7A 59 EE 2C A4 97 E5 CE 42 7A 59 EE 2C' + 'A4 97 E5 CE 42 7A 59 EE 2C A4 97 E5 CE 42 7A 59 EE 2C A4 97 E5 CE C2 1E 93 F2 EE 1B 69 4F C4 2D' + '8D B4 17 E2 D6 46 DA 1B 71 5B 23 ED 83 B8 BD 91 F6 45 DC D1 48 FB 21 EE 6C A4 FD 11 77 35 D2 01' + '88 BB 1B E9 40 C4 3D 8D 74 10 E2 DE 46 3A 18 71 5F 23 1D 82 B8 BF 91 7E 85 78 A0 91 0E 45 3C D8' + '48 87 21 1E 6A A4 C3 11 0F 37 D2 11 88 47 1A E9 48 C4 A3 8D 74 14 E2 B1 46 3A 1A F1 78 23 1D 83' + '78 A2 91 8E 45 3C D9 48 C7 21 9E 6A A4 E3 11 4F 37 D2 09 88 67 1A E9 44 C4 B3 8D 74 12 E2 B9 46' + '3A 19 F1 7C 23 9D 82 78 A1 91 4E 45 BC D8 48 A7 21 5E 6A A4 D3 11 2F 37 D2 19 88 57 1A E9 4C C4' + 'AB 8D 74 16 E2 B5 46 3A 1B F1 7A 23 9D 83 78 A3 91 CE 45 BC D9 48 63 10 6F 35 D2 79 88 B7 1B E9' + '7C C4 3B 8D 74 01 E2 77 8D 74 21 E2 DD 46 BA 08 F1 5E 23 5D 8C 78 BF 91 2E 41 FC BE 91 2E 45 FC' + 'A1 91 2E 43 FC B1 61 5D 40 FC A9 61 5D 40 7C D0 70 B9 B5 C9 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84' + '4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7' + 'F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4' + '84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C' + 'C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2' + 'E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84' + '4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7' + 'F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4' + '84 4C C7 F2 E4 84 4C C7 F2 E4 84 4C C7 F2 E4 84 D3 A7 E2 4A D9 F0 D7 88 B8 A5 E1 AF 11 71 6B C3' + '5F 23 E2 B6 86 BF 46 C4 ED 0D 7F 8D 88 3B 1A FE 1A 11 77 36 FC 35 22 EE 6A F8 6B 44 DC DD F0 D7' + '88 B8 A7 E1 AF 11 71 6F C3 5F 23 E2 BE 86 BF 46 C4 FD 0D 7F 8D 88 07 1A FE 1A 11 0F 36 FC 35 22' + '1E 6A F8 6B 44 3C DC F0 D7 88 78 A4 E1 AF 11 F1 68 C3 2E 0D F1 58 C3 2E 0D F1 78 C3 2E 0D F1 44' + 'C3 2E 0D F1 64 C3 2E 0D F1 54 C3 2E 0D F1 74 C3 2E 0D F1 4C C3 2E 0D F1 6C C3 2E 0D F1 5C C3 2E' + '0D F1 7C C3 2E 0D F1 42 C3 2E 0D F1 62 C3 2E 0D F1 52 C3 65 63 AA 4C 4B 42 48 5F CA 5D 82 F4 A5' + 'DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA' + '5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC' + '25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D' + '82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25' + '48 5F CA 5D 82 05 B7 A8 5A AB 91 16 42 AC DD 48 0B 23 D6 69 A4 45 10 EB 36 D2 A2 88 F5 1A 69 31' + 'C4 FA 8D B4 38 62 83 46 5A 02 B1 61 23 2D 89 D8 A8 91 96 42 6C DC 48 4B 23 36 69 A4 65 10 9B 36' + 'D2 B2 88 CD 1A 69 39 C4 E6 8D B4 3C 62 8B 46 5A 01 F1 8B 46 5A 11 B1 65 23 AD 84 D8 AA 91 56 46' + '6C DD 48 AB 20 B6 69 A4 55 11 DB 36 D2 6A 88 ED 1A 69 75 C4 F6 8D B4 06 62 87 46 FA 21 62 C7 46' + '5A 13 B1 53 23 FD 08 B1 73 23 FD 18 B1 4B 23 FD 04 B1 6B 23 FD 14 B1 5B 23 FD 0C F1 CB 46 FA 39' + '62 F7 46 4A 5F D2 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5' + 'DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA' + '5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC' + '25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D' + '82 F4 A5 DC 25 48 5F CA 5D 82 F4 A5 DC 25 48 5F CA 5D 02 BD C3 E9 BC F1 7F E0 E7 74 DE 48 43 88' + '19 1A 69 14 62 C6 46 9A 00 31 53 23 4D 88 98 B9 91 26 42 CC D2 48 13 23 66 6D A4 4F 21 66 6B A4' + '4F 23 BE D1 48 93 20 46 37 D2 67 10 23 8D 34 29 62 F6 46 FA 2C E2 9B 8D F4 39 C4 B7 1A E9 F3 88' + '39 1A 69 32 C4 9C 8D F4 05 C4 5C 8D F4 45 C4 DC 8D 34 39 62 9E 46 9A 02 31 6F 23 4D 89 F8 76 23' + '7D 09 F1 9D 46 FA 32 E2 BB 8D 34 15 62 BE 46 FA 0A 62 FE 46 FA 2A E2 7B 8D F4 35 C4 F7 1B 69 18' + 'F1 83 46 9A 1A B1 40 23 4D 83 58 B0 91 06 88 85 1A 69 5A C4 C2 8D 34 1D 62 91 46 EA 8E B9 7F 90' + '8E 95 FB 07 E9 58 B9 7F 90 8E 95 FB 07 E9 58 B9 7F 90 8E 95 FB 07 E9 58 B9 7F 90 8E 95 FB 07 E9' + '58 B9 7F 90 8E 95 FB 07 E9 58 B9 7F 90 8E 95 FB 07 E9 58 B9 7F 90 8E 95 FB 07 E9 58 B9 7F 90 8E' + '95 FB 07 E9 58 B9 7F 90 8E 95 FB 07 E9 58 B9 7F 90 8E 95 FB 07 E9 58 B9 7F 90 8E 95 FB 07 E9 58' + 'B9 7F 90 8E 95 FB 07 E9 58 B9 7F 90 8E 95 FB 07 E9 58 B9 7F 90 8E 95 FB 07 E9 58 B9 7F 90 8E 95' + 'FB 07 E9 58 B9 7F 90 8E 95 FB 07 E9 58 B9 7F 90 8E 95 FB 07 FF 1F EF 00 88 4D' +} + + +LANGUAGE 0,0 DECOMPOSITION UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE +{ + '78 DA 5C 9D 05 74 55 C7 D7 C5 77 12 12 5C 1E 52 27 01 5A 28 45 1F 09 0E A5 B8 13 08 EE 1E 5C 03' + '04 82 BB 7B 5B 5C 4A 15 77 8A 15 A8 02 05 2A 40 43 69 A1 EE D4 F5 5F 01 FA ED 3D 73 5E 6E D7 B7' + 'D6 5B FC F6 39 67 EE CC BC 39 73 67 E6 BE F7 80 41 77 00 4F 00 51 D1 C5 80 AD 40 74 01 32 47 0C' + 'B6 D3 95 A3 0F B0 C7 5C D9 62 B0 5F AE 44 E0 80 98 04 1C B4 50 54 0C 0E F1 CF 02 2F C4 E0 88 B9' + '1E 8C C1 51 95 AA 04 1C 13 47 02 2F 00 31 F9 69 37 2C 86 CA C0 89 C0 62 8D 27 65 25 45 62 2F B2' + '12 D4 03 7D 78 C9 24 9B 78 D9 64 74 0C 5E 31 19 13 83 57 4D B2 C7 AF 99 CC 15 83 33 92 0D 5C 37' + 'CE 4A 36 72 95 BD 6E 92 95 9D 33 C9 CA CE 9B 64 0D 17 24 9B B9 B2 6F 98 64 D9 37 4D B2 EC 5B 26' + '59 F6 A2 64 B2 EB C3 25 C9 D6 EE B2 CB 26 79 D9 3B 26 79 59 A6 49 96 BD 62 92 35 BC 27 D9 C1 5D' + 'F6 BE 49 5E 76 CD 24 2F BB 6E 92 65 3F 90 EC E2 0A 7C 2C D9 C7 5D F6 89 49 7A 3F 35 C9 CB 3E 33' + 'C9 D6 3E 37 C9 1A BE 30 C9 D1 F9 4A B2 9F 1B 9D AF 25 53 5D 65 DF 98 64 65 37 4C B2 B2 6F 4D B2' + '86 EF 24 07 BB B2 DF 9B 64 D9 1F 4C B2 EC 8F 26 59 F6 67 C9 11 AE 0F BF 48 8E 74 97 FD 6A 92 97' + 'FD 66 92 97 FD 6E 92 65 FF 30 C9 1A FE 92 1C E7 2E FB DB 24 2F FB C7 24 2F BB 69 92 65 6F 49 66' + 'B8 02 FF 9A A4 17 51 7E 3E 70 E6 46 45 F9 37 4F 19 6D DE B8 18 C4 98 97 32 9B 79 4B C7 20 D6 BC' + '94 71 51 7E 1A B1 DE EC 51 7E CC 28 73 98 97 7D C8 69 5E CA 5C E6 CD 1E 83 DC E6 A5 CC 63 DE 3C' + '31 C8 6B 5E CA 7C 92 0D 9D CC 2F D9 DF C9 82 51 7E 22 B2 93 85 A2 FC A8 53 16 36 2F 3B 59 C4 BC' + '94 77 98 97 4D DC 69 5E CA BB CC CB AE DF 6D 5E CA 7B CC CB 26 EE 35 2F E5 7D 92 4D 5C D7 8B 4A' + '0E 74 32 DE BC 6C 22 C1 BC 94 C5 CC CB 26 8A 9B 97 B2 84 79 39 8D EE 37 2F E5 03 92 4D 5D 65 25' + '25 07 39 59 3A CA DF 38 CC F1 43 51 7E 96 50 96 31 2F DF 66 59 F3 52 96 33 2F 1B 2E 6F 5E CA 0A' + 'E6 E5 1B AA 68 5E CA B0 79 D9 9D 44 CA 02 94 CD 81 24 49 16 18 02 54 56 81 E6 AE 0F 55 24 87 38' + '59 55 B2 85 EB 6F 35 C9 A1 4E D6 90 6C E9 72 5C 53 72 98 93 B5 CC CB 02 B5 CD 4B F9 B0 79 39 92' + '75 CC 4B F9 88 1A A6 F7 30 50 57 72 98 93 0D A2 FC 52 C1 CA 1A 46 F9 FB 82 B2 91 79 59 59 63 F3' + '52 36 31 2F 2B 6B 6A 5E CA 66 AA EC 05 67 B5 8C F2 0B 08 07 AA 55 94 BF 5B 28 93 CD CB 81 6A 6D' + '5E CA 36 E6 CD 1D 83 14 F3 52 B6 97 6C EB FA D0 41 32 CD C9 8E E6 65 1F 3A 99 97 B2 B3 79 D9 87' + '2E E6 A5 EC 2A D9 CE 5D D6 4D 72 8C 93 DD CD CB F1 ED 61 5E CA 9E E6 65 65 BD CC 4B D9 DB BC AC' + 'AC 8F 79 29 FB 4A B6 77 05 FA 49 8E 75 B2 BF 79 59 20 D5 BC 94 83 A2 FC E2 C8 69 34 38 CA AF 04' + '94 43 CC CB 21 19 6A 5E CA 61 E6 E5 90 0C 37 2F E5 08 F3 72 45 1C 69 5E CA 51 E6 E5 40 8D 36 2F' + '65 9A 79 39 E5 C6 98 97 72 AC 64 27 F7 36 C7 49 8E 77 32 3D CA AF D5 94 E3 A3 FC 6A 44 39 C1 BC' + '5C 98 32 24 BB BA 31 9B 28 39 D1 C9 49 E6 E5 54 9E 6C 5E CA 29 E6 E5 3B 9E 6A 5E CA 69 51 DC 6E' + '39 66 4F 58 82 EF 8D C1 16 4B 30 E5 1E EB 2C E5 5E EB 2C E5 AB 51 88 29 C0 45 C7 57 F6 9A 59 BE' + 'BE D3 B2 FA 47 AC 33 36 8B 79 DB 9C 35 C9 DB E6 75 9B D0 94 E7 24 93 5D 81 F3 26 E9 BD 20 39 C2' + 'C9 37 6C 39 65 65 6F DA 72 4A F9 96 DD AC 94 6F DB 2D 4C 79 D1 DE 03 E5 25 7B 0F 94 97 ED 3D 50' + 'BE 63 EF 81 32 93 FD B4 1D 91 69 BD 22 6B 5C C4 7A 37 88 71 34 AF 06 31 5A EF 05 31 D6 F2 7E 10' + 'A3 75 2D 88 51 5C 0F 62 14 1F CA AA 17 69 E1 23 59 7D 22 D6 C7 16 CB EE AC 4F 2C E6 AD 4F D5 E5' + 'D3 6E EE 7D 26 F9 A5 93 5F DA 82 C9 46 BF B2 05 93 F2 6B 5B 8B 28 BF B1 B5 88 F2 86 8D 0A 67 D9' + 'B7 36 2A 94 DF A9 15 EF 65 7D DF CB 1A 19 B1 7E 50 B1 C3 51 BA F8 47 C9 95 D1 92 3F D9 A2 47 F9' + 'B3 F2 E3 27 C0 2F 26 99 EF 5F 25 7D EA 7F B3 FE 71 C0 7E B7 FE 51 FE 69 2B 12 DB FA CB 56 24 ED' + 'C9 F6 EE 73 B9 F1 FD C7 DE BD B7 6E DA BB A7 BC 65 EF 9E F2 B6 E4 55 BF 49 4B FE E9 24 85 9B 29' + 'F9 79 65 B4 9F 29 94 D1 E6 0D 71 93 36 2F 65 B6 68 BF 91 B1 40 6C B4 DF C8 28 E3 CC CB 02 D9 CD' + '4B 99 23 DA CF 35 16 C8 19 ED E7 1A 65 2E F3 B2 40 6E F3 52 E6 89 F6 63 CD 02 79 A3 FD 58 53 E6' + '33 2F 0B E4 37 2F 65 81 68 BF 20 B2 40 28 DA 2F 88 94 05 CD CB 02 85 CC 4B 59 38 DA CF 61 16 28' + '12 ED E7 30 E5 1D E6 65 81 3B CD 4B 79 57 B4 5F 10 4B 71 EB 8E F6 0B 22 E5 3D D1 7E E9 A3 BC 37' + 'DA 2F 7D 94 F1 D1 7E 8B 65 4E 13 A2 FD 16 4B 59 CA C6 8C 33 F0 41 1B 33 CA D2 36 3A 5C 47 1F B2' + 'D1 A1 2C 13 ED E7 91 9F C9 65 A3 FD 3C F2 56 39 8B C5 38 AB BC C5 BC 55 C1 C6 84 15 57 B4 31 A1' + '0C DB 15 7E EE 57 B2 2B BC 95 18 ED 97 3D CA A4 68 BF 18 52 EE 8D E6 33 01 BB BD 4F 1C 10 8D FD' + '22 67 E9 01 91 83 77 50 CC 88 C6 21 71 52 34 9E 17 67 70 7A 8B 5C 65 8F B8 38 70 35 DA 3F 6E 70' + '35 7F CF 24 9B 7D DF 24 67 E3 35 93 BC 45 AE 9B E4 3B F9 C0 24 17 F6 8F 55 53 BF 68 7C 22 72 75' + 'FB 54 E4 E0 7F 26 4E 00 3E 17 1F 8F 46 5D CE 4F CD FB 7A 22 E7 6D 03 B1 10 37 74 4E 56 5B 64 C6' + 'CA 75 94 4B 74 8C AF BD 11 97 6C B9 6A 01 B3 63 B2 9E 94 E6 70 4A A3 58 64 61 9A AB CB 57 38 39' + '4F 65 79 5A 98 2F D7 E3 CE B5 40 72 B5 93 0B 25 D7 3A B9 58 72 B3 93 4B 25 9F 71 72 99 E4 36 27' + '97 AB 89 A3 31 D6 C4 76 BB 92 D6 0E 2B 4E B9 53 72 9F 2B B0 4B F2 90 93 BB 25 0F 3B B9 47 F2 A8' + '93 7B 55 DF 6B 91 FA CE 59 80 D6 79 49 1F B8 20 79 CA 15 78 C3 BC 7A 74 92 7C DD C9 B7 F9 67 81' + 'FD 5C EE C5 23 5C EB 45 F6 E5 72 F0 16 DE 09 BA 97 A9 E8 69 2E F1 E2 8B 5C C6 C4 63 5C C3 C4 97' + 'F8 50 21 BE CC C7 08 71 0D D7 2B 91 EF E1 2F F1 29 2E 2B D9 58 55 91 6C CA 58 94 49 D6 1A 23 59' + '28 9B 3B CF 4B C6 39 6F 1E C9 7B 9C 37 AF E4 5D EE B2 7C 92 F7 67 D3 D4 BA DB BC 94 35 24 AB 3B' + 'D9 46 B2 8A 2B 9B 62 92 95 B5 93 4C 72 95 75 92 EC E8 BC DD 25 6B 3A 6F 0F AB 81 97 F5 94 6C E0' + '2A 4B 97 1C 9B 4D EB C3 78 C9 71 4E BE 24 79 87 2B F0 B2 64 55 27 DF 96 2C E0 E4 45 C9 B0 93 97' + 'CC CB D6 2E 9B 97 F2 8A BD 79 16 78 D7 3A 49 F9 BE E4 55 57 E0 9A E4 7B 4E 5E B7 D6 F4 B8 69 AD' + '51 7E 28 79 A7 93 1F 49 56 73 F2 53 1B 12 6D 70 F6 86 28 3F 37 AF 1E 37 CD 4B F9 A5 64 BC 93 5F' + '49 D6 71 F2 86 E4 D7 4E 7E 2B F9 8D 93 DF 49 96 77 F2 7B C9 56 4E FE 60 B9 60 13 3F DA 98 51 FE' + '64 5E 3D 6E 9A 97 F2 17 F3 F2 DE FE D5 BC 94 BF 49 3E E8 0A FC 2E D9 C4 C9 3F 25 CB 3A F9 97 64' + '0B 27 E7 C5 F2 66 4D 8D C5 CC 58 94 88 D3 65 71 68 17 87 FB 4D B6 8F C3 03 92 4D 9D 2C 69 DE 0E' + '71 28 25 D9 DC 79 C7 51 16 A0 77 6C 1C D2 25 9B 3A 39 5E F2 8C 93 13 24 9B 3B F9 A2 2E CB 74 97' + 'BD 2C F9 92 93 97 25 2F 39 F9 50 4E CA D2 39 51 3B 27 2A 49 86 9D AC 2C 99 E4 64 67 C9 22 4E 76' + '91 BC C3 C9 AE 92 77 3A D9 4D F2 3E 27 BB 4B 16 77 B2 87 64 09 27 7B 4A 96 75 B2 97 64 45 27 CF' + '4B 9E C9 89 93 39 71 C1 E4 BB 39 71 5D 72 4B 4E BC 90 13 1F 48 3E E9 E4 47 92 7B 9C 4C CA 45 99' + '98 0B B5 73 A1 AA 64 75 27 BB 48 DE E1 64 57 C9 3B 9D EC 26 79 9F 93 3D 25 CB 3A D9 34 B7 32 94' + '1B 1D 73 A3 85 C9 3A B9 D1 D2 64 A7 DC E8 2E 59 3C 37 6A E7 46 0F C9 12 4E 3E 26 B9 32 37 DE CD' + '8D 73 92 A7 73 E3 64 6E 9C 97 3C E3 E4 05 F3 B2 40 D3 3C 94 8D F3 A0 63 1E BC 28 79 2A 0F 32 F3' + 'E0 8C E4 69 27 CF 9A BC 92 07 E7 4C BE 9C 07 E7 F3 F0 B6 F5 92 65 9A E7 55 25 79 51 27 2F 5A 48' + '36 71 B2 A5 79 3B E5 C5 FB 92 EF E5 C5 B9 BC B8 6E F2 AD BC F8 20 2F 2B F1 92 81 0F 2D F0 51 5E' + '24 E5 E3 AC 68 95 0F 89 F9 70 40 F2 8D 7C D8 9F 0F D7 25 77 E4 C3 DA 7C F8 C0 E4 96 7C C8 93 9F' + 'E7 A5 DC F9 D1 20 3F 2F AF 9F 1F 87 F3 A3 95 64 4B 27 DB 4A A6 38 D9 49 B2 A3 93 DD 25 BB 39 39' + '58 B2 6E 7E 1C CA 8F 31 92 A3 F3 23 2D 3F C6 99 1C 9B 1F E9 92 FB F3 63 7A 7E 8C CF CF 87 03 CA' + 'D1 CE 9A A0 C0 01 27 33 14 38 10 09 CC B0 8B 29 1F 95 5C E9 1A DA 28 B9 C1 C9 27 25 B7 38 F9 9C' + 'E4 B3 4E EE 94 DC E1 E4 51 C9 E5 AE 53 A5 0A 50 96 2C 80 0A 05 70 B3 00 77 E0 EB 05 10 77 2F 5D' + 'B1 F7 A2 CA BD C8 21 99 DD C9 5C 92 39 9D CC 23 99 DB C9 7C 92 79 9D 2C 28 19 72 B2 96 64 4D 27' + '1F 96 AC ED 64 5D C9 3A 4E D6 93 7C C4 C9 06 92 F5 9D 2C 57 94 1D E0 C1 AA BC C8 63 6D 05 B1 3E' + '10 16 79 88 AE 24 F2 88 95 28 2E 8D 42 92 C8 63 74 65 91 C7 B4 2A 22 0F 9D 55 45 3E 32 55 13 79' + 'E0 AF 2E F2 D9 AA 86 D8 0A A8 29 F2 A0 5D 5B E4 71 EA 61 B1 04 FB 26 B6 01 1E 11 79 C8 AC 2B F2' + '50 58 4F E4 41 B2 BE C8 A7 D0 06 45 FD 27 B6 0D 5D 79 9E FA C4 14 CE 45 31 BA 28 9A 88 7D 81 A6' + '22 4F FC CD 44 9E 07 9B 8B 5D B8 FA 89 DD 38 85 C4 EE 5C 7B 45 3E 03 B4 16 F9 54 D2 46 1C 0E A4' + 'B8 FE 47 A1 6D 51 FF C1 6E 3B D7 1F 9E 53 C5 3B 8A A2 83 78 67 51 74 14 47 01 9D 44 9E 5C 3B 8B' + '3C ED 76 11 8B 16 45 57 77 3D 67 A4 98 0E 74 17 4B 16 45 0F 91 27 85 9E E2 81 18 F4 12 0F C6 A0' + 'B7 1B 7F 3E 67 88 67 62 D0 97 CC C9 13 7C 3F 91 87 C6 FE 22 EB 4F 15 59 DF 00 91 F5 0C 14 59 CF' + '20 91 67 87 C1 22 EB 19 22 B2 9E 09 AA EF E1 6C 58 EF C6 97 B3 55 EC 07 6C 74 E3 1B 8D 4D E2 4F' + 'C0 66 1B 97 27 C4 01 C0 16 B1 17 57 40 37 EE D1 78 CA 8D 67 34 9E 16 07 F1 24 23 0E E6 3C 17 87' + '44 E3 39 71 52 51 6C 15 37 F2 B0 E6 C6 33 1A DB C5 39 45 B1 43 DC 1C 8D 9D E2 E8 68 EC 72 E3 17' + '8D DD 62 1A 97 57 71 4C 34 F6 BA F1 E4 E9 CD 8D 27 EF 52 71 02 6F 4A 71 66 34 0E 8A B3 78 A4 13' + '77 44 E1 79 71 01 CF 75 E2 C2 68 1C 11 EF 2B 8A A3 E2 A2 68 1C 13 17 47 E3 B8 C8 C7 C0 17 C4 E5' + 'D1 38 21 AE 88 C6 49 91 4F 93 A7 44 9E DC 10 EF 1F 34 4A F2 6C 15 EF 1F 34 28 A3 25 EB BB F3 77' + '8C 64 5F FF 04 60 DE FB F9 C8 66 5E CA 38 F3 56 E2 39 CC BC 94 39 E2 B9 2E FA 0F ED 79 4E CA 29' + 'AB 5F C4 CA 15 EF 3F 31 D5 A7 AB F1 FE 13 53 7D BA 6A 5E 56 99 D7 BC 94 F9 CC CB 2A F3 9B 97 B2' + '80 79 59 5F C8 BC 94 05 CD 5B 9E 0F 6E E6 A5 2C AC B6 FD 27 B1 14 45 64 A5 46 AC 3B 82 18 FB 75' + '67 10 A3 75 57 BC 7F D8 62 15 77 C7 FB 87 2D CA 7B CC 1B E6 43 9C 79 29 EF B3 7A D8 09 9E C8 8A' + '5A 3D DE 8A 57 B1 C6 EE 2D 26 48 0E 70 B2 58 BC 7F 3C 67 5B C5 E3 FD E3 39 65 89 78 FF 30 C8 02' + 'F7 C7 FB 87 41 CA 07 CC CB E1 28 69 5E CA 52 E6 E5 21 E7 41 F3 52 96 36 AF 1E 11 CD AB 47 44 F3' + '56 E0 F3 A1 79 29 CB C5 FB 07 68 BE 81 F2 F1 FE 01 9A B2 82 7A DF 2C F2 4C 53 51 D6 E0 88 15 8E' + 'F7 1F 6F 50 56 8A F7 1F 6F 50 26 9A 97 9D 4A 32 2F 65 65 F3 32 5D 55 CC 4B 59 35 DE 7F D4 CA 02' + 'D5 E2 FD 47 AD 94 D5 D5 8A F7 72 14 6A C8 1A 16 B1 6A DA 15 BC B8 96 5D 41 59 DB BC 4C C9 C3 E6' + 'A5 AC 23 D9 CA 75 EA 11 C9 E1 4E D6 35 2F 87 B2 9E 79 29 EB 9B 97 AD 34 30 2F 65 C3 78 FF 01 09' + '0B 34 8A F7 1F 90 50 36 36 2F 0B 34 31 2F 65 53 F3 B2 3B CD CC 4B D9 DC BC EC 4E 0B F3 52 B6 8C' + 'CF 7A 10 67 8F 5A C5 67 3D 88 D3 4A 0E 62 1C E6 D6 41 8C 56 1B 8B F9 F9 9A 62 31 6F B5 0D 62 AC' + 'A5 5D 10 A3 D5 5E 4D B7 F1 9F 0B 4B 8E F2 9F 0B 9B 97 6F A9 93 79 29 3B C7 FB 0F 3C 28 BB C4 FB' + '0F 3C 28 BB 9A 97 6F B4 9B 79 29 BB AB 95 B6 91 DC F4 90 95 16 B1 7A DA 15 1C 84 5E 76 05 65 EF' + '78 FF 61 08 AB EC 13 EF 3F 0C A1 EC 6B 5E 5E D9 CF BC 94 FD 55 9F FF 2C 9A 65 52 65 8D 89 58 03' + '2C 96 C7 59 03 2D E6 AD 41 16 BB DF 59 83 2D E6 AD 21 F1 FE 63 17 CA A1 F1 FE 63 17 CA 61 E6 65' + '99 E1 E6 A5 1C 61 5E 76 7B A4 79 29 47 99 97 69 1C 6D 5E CA B4 78 FF D1 CF 03 6C 2B DE 7F F4 43' + '39 D6 BC BC 91 C6 99 97 32 DD BC BC 6C BC 79 29 27 C4 FB 0F 2B FD 2C C8 88 F7 1F 56 7A 6B A2 C5' + 'B2 B9 59 30 C9 62 DE 9A AC 2A 3A BA 92 53 24 D3 9D 9C 6A 5E BE 8D 69 E6 A5 9C 1E EF 3F D5 E6 F5' + '33 E2 FD A7 DA 94 33 CD CB 86 66 99 97 72 B6 79 D9 C4 1C F3 52 CE 35 2F 07 6D 9E 79 29 E7 9B 97' + '4D 2C 30 2F E5 42 C9 CE AE C0 22 C9 09 4E 2E 36 2F 2B 5B 62 5E CA A5 F1 FE C3 24 16 58 16 EF 3F' + '4C A2 5C 1E EF 3F 22 8F 8E C1 8A 78 FF 11 39 E5 4A F3 B2 89 47 CD 4B F9 98 79 99 A2 C7 CD 4B B9' + 'CA 16 38 CA D5 96 2D B6 B6 C6 3A 99 2B 06 6B AD 35 CA 75 94 05 B8 E5 9D 8C C6 FA 60 6E 3E 61 7B' + '22 9B D8 62 7B 22 E5 93 E6 CD 19 83 A7 CC 4B F9 74 BC FF E8 34 DA 65 ED 99 78 FF D1 A9 B7 9E 0D' + '62 14 CF 05 31 8A AD 41 8C B5 6C 0B 62 B4 B6 07 31 E6 75 47 10 A3 B5 D3 62 EC 10 1D BB 2C E6 AD' + 'DD 16 8B F3 9F F9 58 CC 5B 7B 83 18 C5 BE 20 46 B1 3F 88 B1 F5 03 41 8C D6 C1 20 C6 D6 0F 05 31' + '5A CF 07 7D A1 E3 70 D0 17 5A 47 6C 9F A4 75 D4 F6 49 CA 63 E6 65 C5 C7 CD 4B F9 82 79 59 E5 09' + 'F3 52 9E B4 3D D5 8F E5 29 DB 53 BD F5 62 10 D3 EF 0A 82 18 C5 CB 41 8C 75 BF 12 C4 68 BD 1A C4' + 'D8 C2 6B 41 8C D6 69 8B F9 B1 3C 63 31 6F 9D B5 9D 92 55 BC 6E 3B 25 E5 39 F3 B2 CC 79 F3 52 5E' + '88 F7 1F AB 52 BE 11 EF 3F 56 A5 7C D3 BC BC EC 2D F3 52 BE 6D 2B B8 7F 57 17 6D 05 F7 D6 A5 20' + 'A6 DF 22 04 31 8A 77 82 18 6B C9 0C 62 B4 AE 04 31 BE AB 77 83 18 AD AB 16 F3 EF EA 3D 8B 79 EB' + '7D 8B DD EB 5A BF 66 31 6F 5D 0F 62 14 1F 04 31 7D AD 12 C4 D8 FA 47 41 8C D6 C7 41 8C AD 7F 12' + 'C4 68 7D 1A C4 D8 81 CF 82 18 AD CF 6D BD A4 FC C2 D6 4B CA 2F CD CB 8A BF 32 2F E5 D7 B6 52 FA' + '9E 7E 63 2B A5 B7 6E 04 31 8A 6F 83 18 C5 77 41 8C B5 7C 1F C4 68 FD 10 C4 D8 D3 1F 83 18 AD 9F' + '82 18 FB F4 73 10 A3 F5 8B AD 69 FA 79 84 AD 32 94 BF 99 97 05 7E 37 2F E5 1F E6 65 73 FF 33 2F' + 'E5 9F E6 65 43 7F 99 97 12 09 FE 03 DE 42 7C 57 26 0B 33 69 09 BA 95 9D 97 22 C6 AC C2 CE CA 16' + 'C4 38 0E B1 41 8C 56 5C 10 AB CF 2D 32 88 D1 CA 91 E0 3F C3 66 2C A7 49 06 72 A9 CC 8A 48 4B B9' + 'CD F2 2D E5 09 62 FA D0 35 88 D1 CA 17 C4 58 77 FE 20 46 AB 40 82 FF A4 9A B1 90 49 06 0A AA CC' + 'A1 48 4B 85 CC F2 2D 15 0E 62 AC BB 48 10 D3 69 3D C1 7F D0 CE D8 DD 26 19 B8 47 65 1E 8F D4 76' + 'AF 59 BE B6 FB 82 18 AF 2F 1A C4 68 15 4B F0 1F 9D 33 56 DC 24 03 25 54 E6 70 A4 B6 FB CD F2 B5' + '3D 10 C4 78 7D C9 20 46 AB 54 10 E3 FB 7E 30 88 D1 2A 9D E0 BF 15 60 EC 21 93 0C 94 51 99 D5 91' + '96 CA 9A E5 5B 2A 17 C4 58 77 F9 20 46 AB 42 10 63 DD 15 83 18 AD 70 82 FF A8 9F B1 4A 26 19 48' + '4C F0 5F 2F F8 96 92 CC F2 2D 55 0E 62 AC BB 4A 10 A3 55 35 88 B1 EE 6A 41 8C 56 F5 04 FF 25 05' + '63 35 4C 32 50 53 65 D6 46 5A AA 65 96 6F A9 76 10 63 DD 0F 07 31 5A 75 82 18 EB 7E 24 88 D1 AA' + '9B E0 BF A8 60 AC 9E 49 05 54 E6 54 A4 A5 06 66 F9 96 1A 06 31 FD 6C 23 88 D1 6A 9A E0 BF 8B 61' + 'AC 99 49 06 9A AB CC E6 48 6D 2D CC F2 B5 B5 0C 62 3A D5 07 31 5A 6D 12 FC 37 27 8C A5 98 64 A0' + '6D 82 FF FA C5 D7 D6 CE 2C 5F 5B FB 20 A6 63 7B 10 D3 C9 3D 88 F1 7D 77 0A 62 B4 BA 24 F8 AF 5A' + '68 75 53 E0 99 48 85 3D 02 8B 55 F4 0A 2C 5E D4 3B C1 7F 9B C3 0A FB 98 64 A0 AF CA BC 1E E9 5E' + '3F B3 7C 6D FD 83 18 6B 4B 0D 62 B4 06 04 31 D6 3D 30 88 D1 1A 94 E0 BF CC 62 6C B0 49 06 86 A8' + 'CC B6 48 4B 43 CD F2 2D 0D 0B 62 AC 7B 78 10 A3 35 22 88 B1 EE 91 41 8C D6 28 5B 1B E9 1B 9D 90' + 'F5 95 58 9A AD 2E 7A 28 48 C8 FA 76 6C AC DD D7 5A BE 13 B2 BE 28 4B B7 3B 83 DE F1 09 59 DF 99' + '4D B0 B9 45 6F 46 42 D6 57 63 13 2D AB F4 4E 4A C8 FA 96 6C B2 0D 26 BD 53 12 B2 BE 30 9B 1E 2C' + 'B9 8D 78 12 0F 96 5C 5A 33 13 90 2D 58 C6 E9 98 65 8E C2 11 C7 EC A0 44 94 73 CC 09 4A 78 C7 DC' + 'A0 44 7D E7 98 17 94 F0 8E F9 C1 52 4C 6B 41 B0 14 D3 5A A8 C2 2B FE D3 83 45 E6 C8 EA C1 E2 A0' + '84 6F 70 49 50 C2 3B 96 06 25 7C 83 CB 82 12 DE B1 3C 58 06 69 AD 08 96 41 5A 2B 55 F8 F0 7F 7A' + 'F0 A8 39 B2 7A F0 58 50 C2 37 F8 78 50 C2 3B 56 05 25 7C 83 AB 83 12 DE B1 26 58 1E 69 AD 0D 96' + '47 5A EB 54 78 F5 7F 7A B0 DE 1C 59 3D D8 10 94 F0 0D 6E 0C 4A 78 C7 A6 A0 84 6F 70 73 50 C2 3B' + '9E 08 EE 13 5A 5B 82 FB 84 D6 93 2A FC FA 7F 7A F0 94 39 B2 7A F0 74 50 C2 37 F8 4C 50 C2 3B 9E' + '0D 4A F8 06 9F 0B 4A 78 C7 D6 E0 FE A1 B5 2D B8 7F 68 6D 57 E1 6D FF E9 C1 0E 73 64 F5 60 67 50' + 'C2 37 B8 2B 28 E1 1D BB 83 12 BE C1 3D 41 09 EF D8 6B B7 26 9F 12 F6 99 D4 EF 91 ED 9E F0 ED 1C' + 'B0 00 E5 41 0B F8 EA 9F B7 00 AB 3A 6C 01 5F EB 11 3B AD B0 D6 A3 26 59 EB 31 93 2C 79 3C 21 EB' + 'DB F9 17 4C F2 B2 13 09 FE CB 7C 76 F7 64 82 BE F2 E7 7E 10 B8 5E 34 C9 26 5E 4A C8 FA AA 9F D6' + 'CB 36 7B 7D 6F 5F B1 05 84 F2 55 0B F8 DE 9E B6 00 AF 38 63 01 DF DB B3 76 46 51 FE 13 B2 7E 22' + '70 CE 4E 00 F4 9E 4F C8 FA B5 C0 05 93 BC EC 0D EB 84 4F D0 9B 81 C5 62 6F 05 16 DB 78 DB 56 2F' + '7D AF 6C 92 C3 71 29 21 EB C7 04 7A A6 48 F8 EF 4F 0B AE 58 31 5E FC 6E 10 A0 75 D5 F6 70 FD 2E' + 'C3 24 AB 7A DF 24 4B 5E 4B C8 FA 39 C3 07 D6 09 3F 61 3E 0C 2C C6 3E 0A 2C D6 FA B1 2D 99 AC F5' + '13 93 FA AD 55 42 D6 AF 13 28 3E 4B F8 EF 6F 15 3E 57 B1 97 DC CC FA C2 24 AB FA D2 2E 66 95 5F' + '05 C5 69 7D 6D BB 22 1B F8 C6 24 1B B8 61 52 8F 03 09 59 3F 56 F8 4E 72 8B AB EF FB 20 CF 14 3F' + '24 FC F7 07 1E 3F 6A 86 F4 06 7E B1 FB D6 67 FF 57 5B E6 29 7F B3 80 CF FE 1F 16 60 67 FE 67 01' + '9F FD 3F ED 74 A1 5F 61 25 64 FD FE E3 6F DB 1C E9 FD 27 21 EB F7 1F 37 4D F2 B2 5B 92 FE 87 27' + 'B7 6D 62 6A 9C 8B B1 53 F2 1A A3 49 F7 D3 18 63 36 63 AC 31 CE 98 BD 98 FF 6B 02 39 CC CE 69 CC' + '65 0C 29 4E 71 67 31 DF 54 12 0F B9 0A 55 00 4A CA 45 F2 55 AA 18 62 4C F2 55 D1 EA 4C 52 81 C4' + '62 E0 AB B2 0A 78 C9 57 55 05 AA 14 03 5F D5 14 F0 92 AF DA 0A 14 07 F8 AA 63 0D C6 C6 A0 89 E4' + '23 00 5F 4D 4D B2 40 33 2B 4B AB 53 31 64 0B 6A E7 AB 97 F5 7E 14 99 23 0C 8C 16 F9 60 3E 56 AC' + '0C 8C 13 AB 00 E9 62 55 60 BC 58 0D 98 20 56 07 32 C4 1A C0 44 B1 2C 30 49 2C 58 02 93 C5 87 81' + '29 62 69 60 AA F8 10 30 4D 1C 01 4C 27 73 B2 BD 19 62 25 60 A6 98 08 CC 12 93 80 D9 22 DB 9F 23' + 'B2 FD B9 22 DB 9F 27 B2 FD F9 22 DB 5F 20 B2 FD 85 22 DB 5F 24 B2 FD C5 22 DB 5F 22 B2 FD A5 22' + 'DB 5F 2E F6 01 56 88 A9 C0 4A 91 CF D1 8F 8A 13 80 C7 C4 2E 5C 60 C4 41 C0 2A 71 28 B0 5A 1C 06' + 'AC 11 87 03 6B 45 BE 8F 75 E2 28 60 BD 38 06 D8 20 8E 05 B6 6A CC DB 42 9F 90 31 05 31 FA D0 AC' + '22 DC 6F E8 03 4B BF 11 2E 8E A8 A8 06 9C 7C C5 59 7C 2F F4 0D 50 AC 0A F4 73 05 F4 43 E6 C0 E2' + '53 73 76 16 2F B0 3C 0A 39 AD 78 63 4E 3F D5 30 10 C8 2D EA 77 71 C6 BC C6 7C 22 DF 48 7E F1 C1' + '28 14 10 F5 2B 40 63 41 B1 25 97 41 91 6F B0 88 98 0C DC 51 DC FF B6 95 7D B8 5B AE 36 C0 3D 62' + '0A 9F DD 45 BE B7 FB 8C 45 8D C5 78 49 8E 76 D0 97 04 C5 D5 ED F6 D0 E7 43 AC BB 84 02 ED 5D E0' + '01 95 ED CA FB 80 D4 6D 5A DA EC 32 B2 5B 00 65 8B 67 FD 3D 96 72 0A D5 07 CA DB 18 55 14 F5 FD' + '91 C8 8A 2B 89 1C 81 24 91 55 57 16 D9 DD 2A 1A A4 B7 63 51 55 BC 18 8B 6A E2 A5 58 54 17 2F C7' + 'A2 86 CA 71 8A D7 52 1F 79 3D 5B EB 0C D4 96 F7 45 3E 4C 89 07 F8 18 25 3E CA 07 28 F1 09 3E 3A' + '89 A1 12 68 24 36 E4 D0 8B FD 81 26 D6 AB A6 56 6B 33 71 08 D0 A6 78 D6 DF F1 E1 74 4D 09 2C 4E' + 'D6 B6 C5 91 CD 2C FE C9 BB A0 5D 10 E6 DC 6F 2F 2B 31 62 75 08 62 BC 0F 3A 06 31 5A 9D 8A 67 FD' + 'D5 21 5A 9D 65 55 8E 58 5D 82 EB 78 DF 74 95 55 25 62 75 0B 62 BC 87 BA 07 B5 D0 EA 11 94 A4 D5' + '53 56 B5 88 D5 8B D9 B1 EB 7A 6B 34 39 7F FA 14 F7 7F F3 80 AF BE 1A 50 2F F9 EA 67 81 8E 40 7F' + '95 25 53 E5 EA E8 A2 03 54 B6 63 A4 EC 40 0E 48 60 F1 35 C8 2E 66 62 06 EB 62 72 88 5C 9D 5D 74' + 'A8 2E EE 1C 29 3B 4C 05 38 CB 86 8B 9C 27 23 44 66 68 A4 C8 79 31 4A 64 66 46 17 F7 7F 31 82 AF' + '34 55 E0 25 5F 63 2C 90 CE 65 4F 65 C9 71 72 A5 BB 68 BA CA A6 47 CA 8E 57 4F B3 2C BE 26 D8 C5' + '5C 3B 32 74 31 39 51 AE 09 2E 3A 49 17 4F 88 94 9D AC 02 BC C7 A6 88 BC A9 A7 8A 9C 43 D3 44 2E' + '2A 0B 34 D8 E1 48 E2 D7 E9 56 58 5E 1C D5 79 B6 96 5C E9 E4 6E C9 C7 9C 7C 43 F2 6D 27 DF 94 7C' + 'C7 C9 B7 24 2F 39 99 AD 04 65 4C 09 C9 9C 92 39 9C CC 23 99 DB C9 07 24 EF 77 B2 94 64 49 27 CB' + '51 16 28 5B 02 7C 95 2F C1 FE 7B C9 57 45 05 2A 94 00 5F 61 05 BC E4 AB 9E 2E AE ED 2E 6E 28 D9' + 'C0 C9 26 92 8D 9C 6C 26 D9 D4 C9 DE 92 5C 99 29 FB 4A F6 71 DE E1 92 AD 9C 1C E1 2A 73 05 46 4A' + 'D6 71 72 94 64 7F 57 60 B4 64 AA 93 63 25 D3 9C 1C 27 39 C6 C9 09 92 E9 4E 66 48 8E 77 72 BA E4' + '44 27 67 48 4E 72 72 B6 E4 4C 27 E7 48 CE 72 72 BE E4 5C 27 17 48 CE 73 72 A7 E4 93 4E EE 92 DC' + 'EA E4 6E C9 6D 4E EE 91 DC E1 E4 C7 92 93 9D FC 44 72 8A 93 9F 4A AE 70 F2 33 C9 95 4E DE 90 DC' + 'EF E4 B7 92 07 9C FC 4E F2 A0 93 DF 4B 1E 72 F2 A1 FB B9 50 72 A7 2E 23 72 07 ED FD 00 A2 B2 F3' + '96 EC 23 72 61 E8 2B 72 F6 F4 13 B9 18 F4 17 79 3B A7 8A BC F5 07 88 BC A1 07 8A BC A5 07 89 5C' + '93 06 3F 80 E8 EC 7E 35 1A 62 92 AF A1 26 59 F1 30 93 AC 7B B8 49 56 3F C2 24 5B 18 69 92 8D 8C' + '32 C9 76 46 9B 64 53 69 26 D9 DA 18 C9 44 D7 DA D8 07 38 93 4A BB D6 B8 3F 8F 33 2B D1 59 E9 66' + '25 39 6B BC 59 95 9D 35 C1 AC 2A CE CA 30 AB AA B3 26 9A 55 CD 59 93 CC AA EE AC C9 66 D5 70 D6' + '94 07 78 3F FB D6 C3 CE 31 35 70 F8 1E 4D 0B 1C BE 53 D3 03 87 EF D7 8C C0 E1 BB 36 33 70 F8 DE' + 'CD 0A 1C BE 83 B3 03 87 EF E3 9C C0 E1 BB 39 37 70 F8 9E CE 33 47 62 A4 A7 F3 39 86 05 2A B9 73' + 'E4 02 C9 44 27 17 4A 26 39 B9 48 B2 B2 93 8B 25 AB 38 B9 44 B2 AA 93 4B 25 AB 39 B9 4C B2 BA 93' + 'CB 25 6B 38 B9 42 63 E5 87 86 D6 4A B3 7C 9B 8F 9A E5 9B 7D CC 2C DF F2 E3 66 F9 C6 57 99 E5 DB' + '5F 6D 96 EF C2 1A B3 7C 2F D6 9A E5 3B B2 CE 2C DF 97 F5 B2 12 23 7D D9 60 59 EC E3 86 62 A3 59' + '7D 9D B5 C9 AC 7E CE DA 6C 56 7F 67 3D 61 56 AA B3 B6 98 35 C0 59 4F 9A 35 D0 59 4F 99 35 C8 59' + '4F 9B 35 D8 59 CF 98 35 C4 59 CF 9A 35 D4 59 CF 99 35 CC 59 5B CD 1A EE AC 6D 66 8D 70 D6 76 B3' + '46 3A 6B 87 59 A3 9C B5 D3 AC D1 CE DA 65 56 9A B3 76 9B 35 C6 59 7B CC 1A EB AC BD 66 8D 73 D6' + '3E B3 D2 9D B5 DF AC F1 CE 3A 60 D6 04 67 1D 34 2B C3 59 87 CC 9A E8 AC E7 B5 44 F0 94 74 58 E4' + '81 EC 88 C8 8D F6 A8 C8 8D F6 98 C8 03 D9 71 91 07 AA 17 C4 26 C0 09 91 47 D0 93 22 37 EA 53 62' + '73 E0 45 91 67 BD 97 44 6E DC 2F 8B DC A8 5F 11 79 E4 7C 55 6C 0D BC 26 F2 DC 79 5A E4 B9 F3 8C' + 'C8 73 E6 59 91 E7 CC D7 45 1E 2B CF 89 1D 80 F3 22 4F 11 17 C4 4E C0 1B 22 8F 09 6F 8A 5D 80 B7' + '44 9E 35 DF 16 39 71 2E 8A 9C 32 97 44 4E 96 CB 22 A7 C9 3B 22 27 48 A6 C8 A9 71 45 E4 A4 78 57' + 'E4 74 B8 2A 72 22 BC 27 72 0A BC 2F 32 F9 D7 44 A6 FD BA C8 84 7F 20 32 D5 1F 8A 4C F2 47 22 D3' + 'FB B1 C8 C4 7E 22 32 A5 9F 8A FA 6B 17 22 D3 F8 B9 C8 04 7E 21 32 75 5F 8A 4C DA 57 22 D3 F5 B5' + 'C8 44 7D 23 32 45 37 44 DE 16 79 CA 70 85 C8 DA AC F9 1A 5B 86 69 AC 09 F0 C5 0D 77 5C 19 DE D7' + '0F 3B 99 AE 80 97 7C 5D 67 00 1F 94 D1 EE 32 B9 1C 1F 5F F8 96 A6 90 39 38 94 23 CB EB E7 7D E5' + 'B1 B9 02 4F 28 6F 0C C5 AF E2 E6 CD 7A 1E 89 2A 80 64 44 89 A5 93 11 2D 56 4D 46 8C F8 48 32 B2' + '89 5D 92 11 2B CE 49 46 9C B8 38 19 D9 C5 27 92 91 43 3C 96 8C 9C AE 7C 0A 72 89 A9 29 C8 2D 0E' + '4D 41 1E 71 66 0A F2 8A AB 52 90 4F DC 91 82 FC E2 C7 29 28 20 FE 9E 82 90 EB 47 5B 14 14 D7 B7' + '45 21 F1 AF B6 28 2C 16 69 87 22 E2 3D ED 70 87 58 BD 1D EE 14 EB B5 C3 5D 62 F7 76 B8 5B 1C DC' + '0E F7 B8 F6 DA E1 5E F1 F9 76 B8 4F 3C DB 0E 45 C5 CF DA 21 5E 7C B7 23 12 C4 84 4E 28 26 7E DB' + '19 C5 C5 E8 2E 28 21 E6 EA 82 FB 5D BB 5D F0 80 F8 60 17 94 14 C7 74 41 29 B1 4D 37 3C 28 4E EF' + '86 D2 E2 9F DD F0 90 98 BF 3B CA 88 25 BA A3 AC EB 67 77 94 13 47 74 47 79 71 74 77 54 10 AF F5' + '40 45 F1 8B 1E 08 8B 3F F7 40 25 F1 76 0F 24 8A 69 3D 91 24 4E EC 89 CA E2 B4 9E A8 22 FE D6 13' + '55 5D B9 9E A8 26 E6 EE 85 EA 62 A1 5E A8 E1 FA D5 0B 35 C5 3E BD 50 CB F5 B7 17 6A 8B AF F4 C2' + 'C3 62 8E BE A8 E3 F2 DB 17 8F 88 2D FA A2 AE 58 31 15 F5 C4 CA A9 A8 2F CE 4B 45 03 71 75 2A 1A' + '8A 4F A7 A2 91 78 34 15 8D 5D DE 52 D1 C4 F5 3F 15 4D C5 9F 06 A0 99 AB 7F 20 9A BB 79 34 10 2D' + 'C4 62 43 D1 52 EC 3B 14 AD C4 8C A1 48 16 0F 0C 45 6B F1 FC 50 B4 11 DF 19 8A 14 37 2E 43 D1 D6' + '8D E3 30 B4 13 0B 0F 43 7B D7 AF 61 E8 E0 E6 D3 28 74 14 CB A4 A1 93 7B 1F 69 E8 2C D6 4A 43 17' + '37 FF D2 D0 55 6C 92 86 6E 6E DE A6 A1 BB D8 2D 0D 3D C4 9D 69 E8 29 CE 1E 83 5E E2 82 31 E8 2D' + '5E 1F 8B 3E E2 97 63 D1 57 BC 6B 1C FA B9 F9 31 0E FD DD FB 19 87 54 31 3C 0E 03 C4 45 E3 30 50' + '5C 39 0E 83 C4 F4 74 0C 16 A7 A4 63 88 B8 3B 1D 43 C5 53 E9 18 26 FE 90 8E E1 EE FD 8D C7 08 F1' + 'D3 F1 18 29 FE 3A 1E A3 C4 9A 19 18 2D 1E C9 40 9A 78 32 03 63 C4 B1 13 31 D6 8D D3 44 8C 73 F7' + 'C3 44 A4 BB BC 4E C6 78 37 EF 26 63 82 1B 87 69 C8 10 53 A6 61 A2 B8 70 1A 26 89 27 A6 61 B2 18' + '35 1D 53 C4 3C D3 31 55 2C 38 1D D3 C4 A4 E9 98 EE E6 D7 74 CC 70 E3 31 1D 33 DD 7D 32 03 B3 C4' + '1B 33 30 DB F5 73 06 E6 88 37 67 60 AE AB 67 26 E6 89 F7 CE C4 7C 37 4E 33 B1 C0 CD F3 99 58 E8' + 'E6 EF 4C 2C 12 27 CC C4 62 B1 D5 5C 2C 71 F9 9B 8B A5 62 DD F9 58 26 B6 9C 8F E5 62 BF F9 58 21' + '4E 5D 80 95 6E 7C 17 E0 51 F1 D2 02 3C E6 D6 85 85 78 5C AC B6 18 AB C4 C6 8B B1 5A EC B0 18 6B' + '5C 3B 8B B1 56 DC B8 18 EB C4 FE 4B B0 5E 1C B5 04 1B DC 7C 5B 82 8D 6E DD 59 8A 4D E2 B9 A5 D8' + 'EC D6 99 65 78 42 DC BB 0C 5B C4 43 CB F0 A4 B8 62 39 9E 12 9B AD C0 D3 E2 E9 15 78 46 BC B0 02' + 'CF 8A 17 57 E0 39 71 FC E3 D8 EA D6 81 C7 B1 4D BC 6F 15 B6 BB 75 67 15 76 B8 FB 65 15 76 8A 5F' + 'AF C2 2E 97 9F D5 D8 2D F6 5C 8D 3D EE BE 58 8D BD 6E DD 5A 8D 7D 2E CF AB B1 5F FC 7E 35 0E B8' + '71 5F 8D 83 2E 7F 6B 70 48 DC BA 06 CF BB 79 B4 06 87 C5 8F D6 E0 88 5B 57 D7 E2 A8 B8 76 2D 8E' + 'B9 79 BE 16 C7 5D F9 75 78 41 BC BA 0E 27 5C F9 75 38 29 96 5C 8F 53 EE BE 5F 8F 17 C5 C4 F5 78' + '49 AC BD 1E 2F 8B 5D D7 E3 15 77 7F 6F C0 AB E2 B8 4D 78 CD CD 93 4D 38 2D 3E B3 09 67 C4 E3 9B' + '70 D6 AD 2F 9B F0 BA F8 C6 26 9C 73 E3 B3 09 E7 DD 7C DD 84 0B E2 AD 4D 78 43 CC B7 19 6F BA F5' + '6A 33 DE 72 EB C3 66 BC ED EE DF CD B8 28 36 DF 8C 4B 62 DB CD B8 2C 2E D9 8C 77 C4 0D 9B 91 E9' + 'F6 9B CD 3A 35 46 E5 2E C6 43 67 58 F3 38 8C EA 61 BF 0F D4 10 1B B6 43 4D B1 51 3B B4 0C EB 47' + 'B8 61 AC 0D 23 59 B2 95 93 6D 24 5B 3B D9 56 32 C5 C9 F6 92 ED 9C EC 28 D9 C1 C9 CE 92 9D 9C EC' + '2A D9 C5 C9 EE 92 DD 9C EC 29 D9 C3 C9 DE 92 BD 9C EC 2B D9 C7 C9 54 C9 FE 4E 0E 94 1C E0 E4 60' + 'C9 41 4E 8E 92 1C E9 E4 68 93 EB C2 18 23 99 E6 BC 63 4D D2 9B 2E 39 CE 79 C7 9B A4 37 43 72 82' + 'F3 4E 34 49 EF 64 C9 49 CE 3B C5 24 BD 8F 49 36 76 DE F5 61 FF 49 33 E5 06 93 2C B0 49 05 36 BA' + '02 9B 29 73 CD 0F 63 61 18 3B E5 DD E1 BC BB 25 77 39 B9 57 72 8F 93 FB 25 F7 39 79 50 F2 80 93' + 'CF 4B 1E 72 F2 88 E4 61 27 8F 49 1E 75 F2 05 C9 E3 4E 9E 94 3C E1 E4 8B 92 A7 9C 7C 59 F2 25 27' + '5F 93 7C D5 C9 33 92 A7 9D 7C 5D F2 AC 93 6F 4B BE E5 E4 45 93 7C 43 97 25 2F 39 EF 3B 26 E9 BD' + '22 99 E9 BC EF 9A A4 F7 3D C9 AB CE FB BE 49 7A AF 4B 5E 73 DE 0F 4C D2 FB 9B E4 B3 CE FB 3F C9' + '1F 9D FC 53 F2 27 27 FF 92 FC D9 C9 BF 25 7F 71 F2 B6 E4 2D 27 FF D5 F8 72 A0 D8 FB 4A 95 B4 C2' + '85 90 28 46 85 90 24 6E 0F A1 B2 18 1D 42 15 71 67 08 55 C5 5D 21 54 13 63 42 A8 2E 66 0B A1 86' + '18 1B 42 4D 71 6F 08 B5 C4 7D 21 D4 16 F7 87 F0 B0 78 20 84 3A E2 C1 10 1E 11 0F 85 50 57 BC 27' + '84 7A 62 5C 08 F5 C5 EC 21 34 10 73 84 D0 50 2C 1E 42 23 31 67 08 8D C5 5C 21 34 11 73 87 D0 54' + 'CC 13 42 33 31 6F 08 CD C5 7C 21 B4 10 F3 87 D0 52 2C 10 42 2B 31 14 42 B2 58 30 84 D6 62 9F 10' + 'DA 88 7D 43 48 11 FB 85 D0 56 EC 1F 42 3B 31 35 84 F6 E2 80 10 3A 88 03 43 E8 28 0E 0A A1 93 38' + '38 84 CE E2 90 10 BA 88 43 43 E8 2A 0E 0B A1 9B 38 3C 84 EE E2 88 10 7A 88 23 43 E8 29 8E 0A A1' + '97 38 3A 84 DE 62 5A 08 7D C4 31 21 F4 15 C7 86 D0 4F 1C 17 42 7F B1 77 08 A9 62 E1 10 06 88 45' + '42 18 28 9E 09 61 90 78 36 84 C1 E2 85 10 86 88 6F 86 30 54 BC 1C C2 30 F1 DD 10 86 8B EF 85 30' + '42 BC 2F 84 91 E2 07 21 8C 12 3F 0A 61 B4 58 34 84 34 31 3E 84 31 62 B1 10 C6 8A 25 42 18 27 DE' + '1F 42 BA F8 60 08 E3 C5 87 42 98 20 96 0D 21 43 2C 17 C2 44 B1 7C 08 93 C4 0A 21 4C 16 2B 86 30' + '45 4C 0C 61 AA 58 35 84 69 62 DD 10 A6 8B 4D 42 98 21 B6 0C 61 A6 F8 73 08 B3 C4 5F 42 98 2D 76' + '0A 61 8E D8 39 84 B9 62 97 10 E6 89 B3 43 98 2F CE 09 61 81 38 3F 84 85 E2 8A 10 16 89 2B 43 58' + '2C 3E 16 C2 12 71 53 08 4B C5 2D 21 AC 24 73 F0 89 E3 51 91 4F 12 8F 89 39 93 F1 B8 78 AD 23 56' + '89 B9 92 B1 5A 2C 9F 8C 35 62 EE 64 AC 15 13 C7 61 9D C8 27 92 F5 E2 DD C9 D8 20 46 25 63 A3 F8' + '50 17 6C 12 C3 9D B0 59 E4 93 09 12 FD 23 30 6F 31 3E 02 47 99 15 ED AC 68 B3 62 9C 15 63 56 AC' + 'B3 B2 99 15 E7 AC 58 B3 B2 3B 2B CE AC 9C CE CA 6E 56 6E 67 E5 30 2B 8F B3 72 9A 95 CF 59 B9 CC' + 'CA EF AC DC 66 15 70 56 1E B3 42 CE CA 6B 56 41 67 E5 4B F4 1F 19 F1 3D F4 71 8E FC E6 88 8E 38' + '0A 98 23 26 E2 08 99 23 36 E2 28 68 8E B8 88 A3 90 39 B2 47 1C 85 CD 91 33 E2 28 62 8E DC 11 C7' + '1D E6 C8 13 71 DC 69 8E 7C 11 C7 5D E6 C8 1F 71 DC 6D 8E 02 11 C7 3D E6 08 45 1C F7 9A A3 60 C4' + '71 5F D0 CA 08 E7 28 9A 88 EC D6 0F DE F8 74 73 79 D8 E1 22 F1 89 88 0B 22 05 23 17 14 8B E4 3C' + '59 56 71 B3 16 3B AB 44 24 77 CE BA DF 2C 4E 3C 5A 0F 98 F5 98 8B 95 34 6B 78 8A AC 52 91 B9 E2' + '62 0F 9A 35 D4 C5 4A 9B D5 C3 C5 1E 32 8B C7 12 5A 65 CC E2 C3 11 AD B2 91 EB 46 C9 2A 67 16 1F' + '70 68 95 37 AB B4 2B 59 C1 2C 1E 36 69 55 34 8B 8F AC B4 C2 66 F1 01 8C 56 25 B3 CA 0C 92 95 18' + '79 7F AE 96 24 B3 EA 64 C8 AA 6C 56 DE F6 B2 AA 98 95 91 26 AB AA 59 5B 16 CB AA 16 79 47 EE BA' + 'EA 66 1D 6C 2B AB 86 59 9F B9 77 5B D3 AC C9 AE CE 5A 66 0D E8 26 AB 76 A4 64 BA AC 87 CD 8A 6A' + '2D AB 8E 59 67 5C 7B 8F 98 D5 DE 8D 59 DD C8 C8 BB D6 EB 45 EE 0C 77 5D 7D B3 F8 70 42 AB 81 59' + 'BF 3A AB 61 A2 3E 70 EA 80 46 E2 E4 9E 68 2C F2 69 B6 89 B8 6C 12 DA B0 74 BE 36 80 FF 42 33 25' + 'D1 7F 76 5D 09 68 6B 92 AF 76 26 F5 FD 9D C9 CA 40 07 93 FA E6 CE 64 55 A0 93 C9 6A 40 67 93 D5' + '81 2E 26 6B 00 5D 25 93 DC 67 9D DD 4C B2 B5 EE 26 59 A6 87 49 BE 7A 9A 64 6B BD 4C B2 B5 DE EA' + 'BA EE 7B 91 B7 7B 5F 91 77 79 3F 91 37 77 7F 91 F7 74 AA C8 5B 79 80 C8 3B 78 A0 C8 DB 62 90 C8' + '5B 66 B0 C8 DB 74 88 C8 BB 73 A8 C8 9B 72 98 C8 7B 71 B8 A8 1B 48 4D FB 75 66 A4 A4 5F 61 46 49' + 'FA B5 65 B4 A4 5F 55 D2 24 FD 7A 32 46 D2 AF 24 63 25 FD 1A 32 4E D2 AF 1E E9 92 7E DD 18 2F E9' + '57 8C 09 92 7E AD C8 90 F4 AB C4 44 49 BF 3E 4C 92 F4 2B C3 E4 44 C4 DA 65 87 43 5A 0A 79 C7 4F' + 'E1 52 91 DD AF 13 6C 86 BB F7 54 6B 91 8E E9 6E E4 92 31 43 E4 BD 3F D3 8D 4C 32 66 89 BC DF 67' + '8B BC D3 E7 88 BC C7 E7 BA 91 4D C6 3C 91 F7 F5 7C 91 77 F4 02 91 F7 F2 42 91 77 F1 22 17 1F 85' + 'C5 22 EF DC 25 22 EF D9 A5 22 EF D6 65 22 EF D3 E5 22 EF D0 15 22 EF CD 95 AE FD 81 78 54 E4 FD' + 'F8 98 C8 3B F1 71 91 F7 E0 2A 91 77 DF 6A D7 6E 06 D6 88 BC E3 D6 8A 57 33 B0 4E AC 36 0E EB C5' + '31 5D B0 41 1C BC 1C 1B 5D FD 29 D8 24 8E 6A 87 CD E2 D7 C3 F0 84 9B 21 6B B0 C5 65 B8 35 9E 14' + 'D7 A6 E0 29 B1 DF 50 3C 2D 72 A3 7D 46 E4 46 FB AC 9B 31 C9 78 4E FC B2 07 B6 8A BF B6 C3 36 B1' + '56 3B 6C 17 57 77 C3 0E 91 F7 F7 4E 91 77 F6 2E 91 F7 F4 6E 91 77 F3 1E 91 F7 F1 5E F1 BE 2E D8' + '67 93 99 F7 CB 7E 93 BC 5F 0E 98 E4 FD 72 D0 24 EF 97 43 92 95 DD FD F2 BC 49 DE 2F 87 4D F2 7E' + '39 62 92 C5 8F 9A E4 EB 98 49 DE 2F C7 4D B2 B5 17 4C B2 B5 13 26 D9 DA 49 93 6C ED 94 64 15 D7' + 'DA 8B 89 FE 3B 18 E6 F7 A5 44 FF 1D 0C E5 CB 89 FE 3B 18 CA 57 12 FD 77 30 94 AF 26 FA EF 60 28' + '5F 4B F4 DF C1 50 9E 4E F4 DF C1 50 9E 49 F4 DF C1 50 9E 4D F4 DF C1 50 BE 9E 98 F5 1D 0C AD 73' + '89 59 DF C1 D0 3A 9F 98 F5 1D 0C AD 0B BC 28 5F 53 F7 FD C5 1B 5A B1 52 DD 17 06 B4 DE 54 20 D5' + '7D 15 FF 96 02 2D DD 52 D6 10 78 5B 63 FD 24 1F 7E C4 A7 C3 B8 24 F2 09 E5 B2 B8 95 8F 3F E2 F6' + '30 32 45 3E CC 5D 11 F9 24 F7 AE C8 C7 B8 AB 22 9F E1 DE 13 F9 5C F2 BE C8 A7 B7 6B 22 1F DD AE' + '8B 7C 6E FB 40 E4 43 DB 87 22 9F D8 3E 12 F9 B8 F6 B1 C8 67 B5 4F 44 3E A8 7D 2A F2 29 ED 33 91' + '0F 39 9F 8B E7 C2 F8 42 3C 1F C6 97 E2 85 30 BE 12 DF 08 E3 6B F1 CD 30 BE 11 F9 F0 76 43 E4 E3' + 'DA B7 22 1F D0 BE 73 F7 40 18 DF BB 7B 37 8C 1F C4 0F C3 F8 51 FC 28 8C 9F C4 8F C3 F8 59 FC 24' + '8C 5F C4 4F C3 F8 55 FC 9C 4F 6C 6E 4E 87 F1 BB BB 37 C2 F8 43 FC 86 8F 6F E2 0D 3E BB 89 DF F2' + 'C1 4D FC 8E 4F 6D E2 F7 61 FC 23 F2 F1 EE A6 C8 67 BB 5B 22 1F EC 6E 8B 7C AA FB 57 09 F9 3C 19' + '8B DB 6B 4A C6 E6 63 0A FC A3 E7 4D F7 6C 17 95 84 6C F2 B1 66 BE 89 2D 7C E8 B3 42 BF 86 ED 01' + '93 3A 26 89 99 7C D2 5D C2 72 D9 54 82 19 3C EF 0A F9 27 EC 58 95 78 DA 39 38 C6 71 B2 98 DB 6D' + 'CE C1 1B 27 2E 1F 33 7C D4 15 F6 CD F2 92 1C 6A 79 AB 73 EC 70 7F E6 D4 55 DB DD 25 2C 9A CB 2C' + '06 38 6A B9 65 B1 18 9B E0 58 E4 D1 A5 B4 38 3C AF B8 EA F2 9A E3 7B 17 E6 25 F9 CC B1 D6 F9 58' + '63 FE C0 41 8B 79 29 A0 5E F9 4F 0A FC 9F 3E 18 52 39 EF 38 EF 6A 2A 68 8E 2F 22 55 17 4A 42 0E' + '2B F1 6D E4 5A FF 71 00 83 85 93 38 DA BB 5C A3 45 AC 81 EF 23 63 F4 8D 7B 27 77 04 EE 4F 22 A3' + 'C1 7A EE D4 A0 7A F7 8F 91 77 75 97 9A FE EF B5 77 EB DA FF 3A CE BA 77 73 8F B9 59 8D FF B4 E2' + '69 57 CF BD 76 F9 F7 AE 19 4E E1 FB 34 88 FB 9C C5 01 2E 2A EB 80 BB 8A D3 3E 5E 85 0F B8 98 FF' + '04 21 41 8E 43 AE 2E 5F 75 31 F5 F0 50 24 C5 3E 2D C5 E5 3B EC 46 26 6B 2A 94 50 BD C7 23 E5 EE' + '0F 2C 76 F6 01 55 9A 35 58 EC 44 49 85 FD 67 25 AC A6 94 AC B3 91 A1 7D 50 63 E9 DF 61 69 49 F6' + '92 F7 DF 43 2A F3 66 64 88 CA C8 7A CB F5 92 F7 74 59 0D 44 D6 EC CE 6A B5 9C 5A CD 72 B3 5C 79' + '75 FB AD 48 37 BE 73 AD 55 D0 B5 97 22 33 FE 68 24 2F 15 75 AD 77 FB 61 08 AB 45 EF E0 70 55 32' + 'CB F7 38 51 75 F8 DB 28 6B 6A 32 92 A4 3A E8 7E 2A 92 EF CA 56 6E AD 2B C4 37 FE 9C BB BC 8A 2A' + 'CB 74 D7 B2 E3 55 D5 C9 AB AE D9 53 91 5B AF 9A 4A F8 DB 92 4B 5B 75 D5 EB 2D CE 55 F6 A2 86 85' + 'BF 75 EF B2 66 10 F6 B7 54 AD 24 64 37 C7 CD C8 DD ED 3F F4 AA 6D 45 FD 80 B0 B9 87 D5 B8 9F 08' + '4F 47 86 B1 8E 0A 5D 8B BC 57 3A 1E 51 56 AE B9 70 5D 55 7D 2D D2 96 17 FE CD D7 53 9F AE 45 DE' + '40 FD C0 62 B9 06 AA F1 C3 C8 1C E3 3C 6D A8 B0 77 B0 70 23 B3 5E 71 4B 56 63 B3 BE 75 85 9B A8' + '83 1F BA 5A F8 16 BE 72 A2 A9 AA FB 28 52 17 1D CD D4 C1 8F DC F4 6C AE 21 F7 32 2B F1 AC A9 85' + '2A FD 24 72 F3 B7 54 A5 59 96 9F 7A AD 54 E9 7F EF D4 64 39 3E FF CF 42 D6 5A 75 7C 1E A9 B1 8D' + 'AC 2F DD 24 E2 D5 29 2A 7C 23 32 17 18 6E AB 2E DD 70 39 6E A7 D8 B7 61 FB CC 8F 57 B7 57 F3 DF' + '3A 99 19 19 E6 0E 2A FF 9D BB D9 3A EA 2D 7C 17 C9 C6 BE C8 5A D6 49 0D 66 AD 19 9D 59 BE 00 F7' + 'EF A3 A3 D0 25 C9 1F 18 28 BB 26 F9 03 03 65 B7 24 7F 60 A0 EC 9E E4 0F 0C 94 3D 92 FC 81 81 B2' + '67 92 3F 30 50 F6 4A F2 07 06 CA DE 49 FE C0 40 D9 27 C9 1F 18 28 FB 26 65 1D 18 68 F5 4B CA 3A' + '30 D0 EA 9F 94 75 60 A0 95 9A 94 F5 A3 0D 5A 03 92 B2 7E B4 41 6B 60 52 D6 8F 36 68 0D 4A CA FA' + 'D1 06 AD C1 49 59 3F DA A0 35 24 29 EB 47 1B B4 86 26 65 FD 68 83 D6 B0 A4 AC 1F 6D D0 1A 6E 96' + 'EF CB 08 B3 7C 5F 46 9A E5 FB 32 CA 2C DF 97 D1 1A CD 41 D0 BF C4 D0 87 67 1A 8D 7E 7F 27 C7 48' + 'D6 83 FE 7A E9 58 95 E9 EB 0B 00 E3 14 18 E9 4E 3C E9 92 A3 DC AF 41 C6 DB 95 C3 81 09 2A EE 25' + '9B C9 08 2C B6 3F 51 C5 9A B9 5A 27 49 8E E9 89 02 7D 31 59 B2 FC 00 ED D9 53 24 1F EC 02 9E 86' + 'A7 4A E6 1B 80 E3 C3 30 4D 53 87 07 F6 FC BD 70 4F 6B 3D 39 4F B7 96 D9 C1 19 92 23 9C 9C 29 F9' + '82 FB 8B E0 B3 24 87 3B EF 6C C9 A1 4E CE 91 6C 01 FD 1B 31 73 25 5B 39 39 4F B2 89 93 F3 D5 DB' + '7E EE AD 0E 03 16 A8 D9 A1 EE FD 79 C7 42 6B B6 31 B0 C8 9A A5 5C 6C CD 52 2E 31 C9 93 E1 52 EB' + '01 E5 32 EB 01 E5 F2 24 7F 90 9C 08 AC 50 5B F4 7A 6B A5 AC 56 11 EB 51 59 4D 22 D6 63 B2 DA 47' + 'AC C7 AD 0D F6 67 95 B5 41 B9 DA 12 A0 1F 52 5B 73 94 6B 25 07 B8 D1 5F 67 1D A6 5C 6F 35 50 6E' + 'B0 1A F8 DA 28 D9 CF C9 4D 56 03 E5 66 B5 3D 3C 92 CD 27 6C 7C BC B5 C5 2E A6 7C D2 DE 8C B7 9E' + '0A 2E 62 D2 9F 0E 2E A2 F5 8C 5D 44 F9 6C 70 11 AD E7 EC A2 22 25 F4 F3 9B AD 1A FB 2C 8B 75 6E' + 'D3 75 7E 9A 6E B7 EB BC B5 C3 46 CE 5B 3B 6D E4 BC B5 4B 56 9A 93 1C 9B DD 5A 70 B2 2C 5F F3 1E' + 'AD 32 FF CF C7 D6 F6 5A A6 69 ED B3 81 A3 DC 6F 03 47 79 C0 DE 06 E5 41 2B CB 3B E2 90 95 A5 7C' + 'DE CA 52 1E B6 B2 94 47 6C 64 29 8F DA 0C A4 3C 66 35 74 E2 D3 92 D5 40 F9 82 D5 40 79 C2 6A A0' + '3C 69 35 50 9E B2 1A 28 5F 34 EF B6 18 BC 64 5E CA 97 35 88 7D DC AF BA 86 BB 3F 5F 51 AC BE FB' + 'ED D3 AB 96 6E BE 5E 33 C9 01 38 AD 2B 1A B8 81 F0 13 F6 8C 46 B0 81 FB 25 15 AF 3F 6B B3 8C 55' + 'BC 6E 77 4D 06 70 4E 72 90 1B C3 F3 36 BF 39 FC 17 24 07 BB 5F 64 BD 61 F7 1D 5F 6F 9A 64 07 DF' + 'B2 3E 8F E5 D3 92 E4 30 D7 CB 8B 26 79 D9 25 B5 3D CC B5 CD 9E 5C B6 C0 04 E0 1D 1B 0E 2E 4A 99' + '36 6B 06 BB F9 7E C5 AC 91 CE 7A D7 A6 0C FB 73 55 EF 6B D4 7F 46 E2 BD 24 FF C1 53 1B D7 95 F7' + 'AD 64 5B E0 9A 5B 97 DC 52 77 5D B2 9D FB 8D D7 07 92 9D 5C 8B 1F EA CA 8E 6E 88 58 D5 47 B2 EA' + '45 AC 8F 6D 0F FA 22 15 9F D8 1E 44 F9 A9 ED 41 94 9F D9 1E 44 F9 B9 ED 41 94 5F D8 1E 44 F9 A5' + 'ED 41 94 5F D9 1E 44 F9 B5 ED 41 94 DF 04 7B 10 AD 1B C1 1E 44 EB DB 60 0F A2 F5 5D B0 07 D1 FA' + '3E D8 83 68 FD 10 EC 41 B4 7E 0C F6 20 5A 3F 05 7B 10 AD 9F 83 3D 88 D6 2F C1 1E 44 EB D7 60 0F' + 'A2 F5 5B B0 07 D1 FA 3D D8 83 68 FD 11 EC 41 B4 FE 17 EC 41 B4 FE 34 CB F7 E5 2F B3 7C 5F FE 36' + 'CB F7 E5 1F B3 7C 5F 6E 9A E5 FB 72 4B 56 52 A4 2F B7 CD F2 7D F9 57 49 1A 18 59 C5 37 3C AB 7F' + '30 2F 1B 36 8A 2D B3 61 D4 73 FA 07 E3 9E C3 9F 62 A9 28 FC 25 B6 8B 42 F7 1D E4 83 CF A1 87 58' + '6D 07 7A 8A 43 A3 D1 4B 6C BB 03 83 C5 25 D1 C0 5F 88 42 D3 C5 88 12 7F 1B 80 68 F1 DC 52 C4 88' + '67 17 23 9B 78 71 04 62 C5 C4 64 C4 89 5F B4 43 76 71 C3 66 E4 30 E6 14 53 BA 20 97 2B BF 02 B9' + 'C5 79 1D 90 C7 D5 DF 05 79 C5 3F FA 20 9F 38 38 1D F9 C5 39 D3 50 40 7C 64 2E 42 E2 B1 79 28 28' + 'FE 39 1F 85 C4 65 CB 51 58 8C 1E 82 22 E2 BD C3 71 87 F8 DE 28 DC 29 7E 38 06 77 89 0F CF C6 DD' + 'E2 90 15 B8 47 FC 79 2D EE 15 67 26 E3 3E 71 5C 3B 14 15 B3 0D 45 BC AB 27 0D 09 62 F9 B9 28 26' + 'C6 6F 42 71 B1 4D 0F 94 10 BF 1D 89 FB C5 37 E6 E0 01 B1 FF 02 94 14 5F EF 8B 52 E2 D5 19 78 50' + '4C 98 8F D2 6E BC 7A E2 21 F1 CE 81 28 E3 FA 31 1C 65 C5 9B 69 28 27 BE B9 1C E5 C5 B9 AD 51 41' + '3C 9C 82 8A AE FF 6D 11 16 5F ED 8F 4A E2 E5 21 48 14 0B A4 21 49 FC 2A 1D 95 C5 A8 E9 A8 22 C6' + 'CD 45 55 B1 FB 5C 54 13 7F 5C 82 EA 2E 2F AB 51 43 1C B9 1E 35 C5 BF 37 A2 96 B8 78 02 6A 8B D3' + '32 F0 B0 F8 C4 14 D4 71 EF 63 16 1E 71 E3 F1 28 EA BA F8 26 D4 13 AF 2C 44 7D F1 A3 CE 68 E0 E2' + 'BD D0 50 EC 3D 19 8D C4 A9 D3 D1 58 EC 9B 86 26 EE 7D 4F 40 53 F1 E5 C5 68 26 FE 6F 15 9A BB F1' + 'E9 8C 16 AE 5C 77 B4 14 0B 0D 41 2B F1 FD E1 48 16 F3 8F 44 6B B1 E2 14 B4 11 AB 4D 45 8A D8 62' + '15 DA 8A 97 DA A2 9D B8 68 3A DA 8B D7 53 D0 41 BC 90 82 8E E2 7D 13 D1 49 3C 39 05 9D 5D BE 67' + 'A1 8B CB F3 2A 74 15 A7 2F 42 37 F1 AD BE E8 6E F3 A7 87 78 7B 21 7A 8A 35 92 D1 CB 8D 6F 37 F4' + '16 0B F6 46 1F 37 5F C7 A0 AF 38 6A 1C FA B9 7C B6 43 7F F1 9F 09 48 15 4F B5 C6 00 71 5B 2F 0C' + '14 F3 26 63 90 EB D7 30 0C 16 27 A4 62 88 58 62 0A 86 8A AF B4 C3 30 B1 67 67 0C 77 79 1C 8F 11' + '62 B3 D9 18 29 6E 5F 88 51 6E DE 0F C5 68 71 EF 32 A4 89 F3 87 61 8C EB 6F 5F 8C 75 F7 DB 4C 8C' + '73 F9 EB 87 74 31 75 1C C6 8B BB 93 31 C1 DD 4F 29 C8 70 79 4D C1 44 71 C6 20 4C 72 EF 6F 32 26' + 'BB 79 31 13 53 DC B8 2E C4 54 37 2E 2B 30 4D FC BD 2D A6 8B F5 DB 63 86 38 A6 0B 66 8A DF F5 C4' + '2C F1 B5 54 CC 76 FD 18 89 39 62 99 0C CC 15 77 3D 8E 79 6E 9E AF C3 7C 71 F5 26 2C 70 F3 7C 13' + '16 8A EB DB 62 91 78 9A C7 62 71 FC 50 2C 71 F3 61 19 96 8A 63 7B 62 99 B8 BC 0F 96 8B DC 99 56' + '88 EB FA 63 A5 78 FF 48 3C EA C6 69 34 1E 13 17 8C C5 E3 6E BE 65 60 95 5B A7 A6 60 B5 7B 5F D3' + 'B1 46 2C B5 0C 6B C5 1F 66 63 9D BB 7E 39 D6 8B CD 1F C5 06 97 C7 B6 D8 28 3E D5 16 9B C4 13 ED' + 'B1 D9 AD 6F A3 F0 84 9B BF F3 B1 C5 F2 F1 A4 1B C7 9E 78 CA 8D 4F 2F 3C 2D 4E EA 87 67 DC 78 0F' + 'C5 B3 62 9D C9 78 CE CD B7 31 D8 2A 7E 9E 8C 6D E2 5F 1D B1 DD E6 D5 0E 97 D7 1E D8 E9 E6 6B 6F' + 'EC 12 F7 8F C1 6E 97 AF B1 D8 E3 DE EF 34 EC 15 1B 4F C7 3E B1 F2 4A EC 77 EB E4 2A 1C 70 EB E6' + '6A 1C 14 EF 5A 83 43 EE 7E 68 8D E7 5D 3F 32 70 58 3C B8 02 47 C4 23 AB 70 54 FC A4 37 8E B9 75' + '26 19 C7 DD FD D6 06 2F B8 71 E9 86 13 6E 9D ED 8E 93 E2 DA 54 9C B2 FB E2 45 97 B7 D1 78 C9 CD' + '83 74 BC EC D6 AD D9 78 45 9C BC 1C AF 8A 4B 36 E3 35 37 2F 07 E0 B4 58 61 15 CE B8 BC B4 C5 59' + '37 3E 03 F1 BA F8 EB 40 9C 13 EB 0D C7 79 B7 2F 8C C0 05 31 E7 58 BC 21 76 19 87 37 C5 A1 13 F0' + '96 5B E7 A6 E0 6D 77 7F AC C1 45 71 78 0A 2E B9 FA FB E2 B2 BB 9F 56 E1 1D B1 6C 1B 64 8A 77 F7' + 'C0 15 F1 C6 70 BC EB E6 E3 32 5C 75 E3 D2 0B EF 89 0D FB E0 7D 97 EF 41 B8 66 F7 F3 75 37 1E AB' + 'F0 81 F8 50 5B 7C E8 D6 9F F6 F8 C8 DD 47 DD F1 B1 5B 9F 06 E0 13 31 79 20 3E 15 B7 0E C2 67 EE' + 'BE 1B 86 CF DD BA 3B 16 5F 88 9F 8E C3 97 62 C6 34 7C E5 EE A3 F9 F8 DA 8D FB 7C 7C E3 D6 81 15' + 'B8 E1 CA AD C2 B7 6E BC DB E1 3B 37 0F 46 E0 7B B1 68 7B FC 20 BE 3D 1A 3F 8A 6B C6 E2 27 B7 5E' + 'CF C1 CF 6E 7E AE C2 2F 62 A7 0D F8 55 DC BC 09 BF B9 FB 6B 20 7E 17 CF 0F C7 1F E2 D7 33 F0 3F' + '67 4F C4 9F 62 B1 49 F8 4B 5C 39 19 7F 8B 2F A6 E1 1F 97 E7 51 B8 29 76 5E 84 5B CE 9F 8C DB 62' + 'D5 59 F8 57 AC C9 23 E3 DF 64 F6 B6 88 12 9F ED 89 68 F1 72 5F C4 88 57 26 23 9B 38 A7 1B 62 C5' + 'F8 E1 88 13 0F 0E 40 76 B1 D6 32 E4 10 5B CE 47 4E B1 D5 2A E4 12 17 2D 40 6E 57 4F 4F E4 11 EB' + 'A6 20 AF F8 62 07 14 10 BB 76 46 41 71 EC 00 14 11 3F 4C C1 1D 62 99 31 B8 53 3C 97 8E BB C4 DA' + '19 B8 5B EC 99 81 7B C4 D4 0C DC 2B 2E CB C0 7D 62 C7 D5 28 2A 9E 9C 8C 78 F1 C4 34 14 13 0B CE' + '45 09 F1 CF 85 28 29 56 5F 8E 52 E2 AD E5 28 23 FE B8 06 65 C5 9B 6B 50 4E 2C BD 16 E5 DD FB DA' + '88 0A AE 3F CB 51 51 3C BC 0A 61 71 77 6B 54 12 BF 6A 83 44 F7 3E 53 90 24 BE DE 16 95 C5 CF DB' + 'A2 8A 98 D2 0E 55 C5 8D 1D 50 4D 8C EB 88 EA E2 A0 8E A8 E1 C6 A1 33 6A 8A 5B 3B A3 96 D8 BF 3B' + '6A 8B 23 BA E3 61 F1 B1 DE A8 E3 CA F7 C1 23 E2 D2 3E A8 2B FE D2 07 F5 C4 D6 A9 A8 2F 7E 9A 8A' + '06 E2 8A 01 68 E8 F2 33 08 8D C4 F1 C3 D1 58 BC 67 04 9A 88 25 46 A2 A9 AB 7F 34 9A 89 65 D3 D0' + 'DC F9 C7 A2 85 BB 7E 02 5A 8A 75 32 D0 4A 6C 96 81 64 B1 69 06 5A 8B 6D 32 D0 C6 8D 73 06 52 C4' + '1E 19 68 2B 2E C9 40 3B D7 BF 0C B4 77 EF 6B 22 3A 88 33 26 A2 A3 CB F3 24 74 FA DB AF D3 9D C5' + '9C 53 D1 45 AC 37 15 5D C5 B4 69 E8 26 C6 4E 47 77 F1 FB 19 E8 21 66 CC 44 4F 63 2F B1 D3 6C F4' + '16 0B 2C 40 1F 71 D5 02 F4 15 A3 16 A1 9F 58 63 11 FA BB 79 B6 18 A9 62 8E 25 18 20 3E BF 0C 03' + '2D EF 83 C4 CF 56 61 B0 F8 EF 6A 0C 71 F3 76 0D 86 8A E3 7A 63 98 F8 43 FD E8 E1 E2 5D 33 31 4A' + '2C 95 8C D1 E2 A1 14 A4 B9 7C A4 60 8C 38 BD 35 C6 8A 8D 52 30 CE D9 29 48 17 CF B4 C5 78 F1 EF' + 'B6 98 60 F9 CF 10 3B 74 C0 44 71 6D 07 4C 72 79 EB 80 C9 36 FF A7 88 07 3A 63 AA D8 B0 0B A6 89' + 'ED BB 60 BA D8 B7 2B 66 B8 79 D9 0D 33 C5 4B DC 8F C5 F7 7A 62 B6 38 B8 17 E6 88 BB 7A 61 AE 78' + 'B5 37 E6 89 C9 7D 30 DF 8D 43 1F 2C B0 F9 B3 50 EC DD 07 8B 6C 1E 2D 16 2B F7 C5 12 F1 D5 7E 58' + '2A DE D7 1F CB C4 B6 FD B1 DC E5 3B 15 2B EC FE 5C F9 B7 3F D7 3E 2A DE 3B 10 8F B9 F8 40 3C EE' + 'F2 34 14 AB FE F6 E7 97 D5 7F FB 75 7F 8D 78 6D 04 D6 8A E7 47 60 9D CD C3 F5 6E FD 18 85 0D 36' + '1F 37 8A CF 8D C7 26 B1 4A 1A 36 8B 7B D2 F0 84 AD 03 5B C4 D1 63 F1 A4 BB 8F C6 E1 29 97 B7 71' + '78 5A 2C 9A 8E 67 C4 84 74 3C 6B EB C5 73 AE DD 74 6C 75 F3 2E 1D DB C4 E6 E3 B1 DD CD CF F1 D8' + '21 5E 98 80 9D E2 BE 89 D8 65 F3 74 B7 38 69 32 F6 88 DD A6 60 AF CD DB 7D EE BE 98 86 FD 36 4F' + '0F B8 F1 99 85 83 6E FD 98 85 43 EE FD CF C3 F3 EE 7D 2F C0 61 71 EE 02 1C B1 79 7A 54 3C B5 10' + 'C7 6C 1D 3A EE C6 63 21 5E B0 F9 7B E2 6F 7F 1E 3D E9 E6 FF 42 9C B2 F9 FC A2 B8 70 11 5E B2 F9' + 'FC B2 9B C7 CB F0 8A BB 6F B8 1F BB F9 B4 02 AF 89 E9 2B 71 5A 9C CC FD D8 E6 F9 59 5B 17 5F 77' + 'E3 B1 1A E7 6C DE 9F 17 73 AF C1 05 9B FF 6F B8 75 72 3D DE FC DB 3F BF BD E5 C6 AB 74 F4 DB 6E' + '3E 96 8E BE 28 66 26 45 5F 72 F3 B9 16 2E BB FB A3 2E DE 71 FD AC 8B 4C B7 5E B4 8D BE 22 BE DD' + '3D FA 5D 77 1F 4E 8D BE 2A 36 D8 8C F7 DC FC DB 0C FC C3 87 FF 01 EE AF D2 45 99 D4 7F 8C 68 92' + '0F B4 31 FF F0 61 D7 17 D0 7F 75 17 58 8C C5 AA D8 18 F7 21 4B 5C 20 0B 49 8E 8D 45 7A 2C 0A 9B' + '4C 8D 45 11 93 43 63 71 87 E4 54 57 E0 4E F3 0E 8F 45 D1 7F F4 9F 0A C4 E2 60 2C 12 24 7F 89 C5' + 'E1 58 14 FB 07 51 51 9F C6 A2 B8 F8 76 2C 4A 88 97 63 71 BF F8 4E 2C 1E 10 AF C5 A2 A4 78 3D 16' + 'A5 C4 0F 62 F1 A0 F8 75 2C 4A 8B 37 62 F1 90 58 16 28 A3 AA BF 89 C5 4B B1 28 6B F2 E5 58 94 FB' + '47 FF 99 64 2C 5E 70 81 F2 81 C5 58 05 15 7B DB 75 A6 A2 C9 23 B1 08 9B 64 99 4A 92 17 9D 4C 94' + 'BC E4 64 92 E4 65 27 2B 4B BE E3 64 15 C9 4C 27 AB 4A 5E 71 B2 BA E4 55 27 6B D8 28 50 D6 94 7C' + 'DF C9 5A 92 D7 9C AC 2D 79 DD C9 3A 92 1F 3A 59 57 F2 63 27 EB 49 7E E2 64 03 C9 CF 9C 6C 28 F9' + 'B9 93 8D 25 BF 74 B2 89 E4 57 4E 36 95 FC DA C9 66 36 30 94 CD 25 6F 38 D9 C2 BA 7E 34 16 2D ED' + '1D 9F 8A 45 2B EB 19 65 B2 35 41 D9 5A 69 E5 E8 B0 9F 6D 38 F0 71 A3 E3 90 42 C6 92 6D 65 4F 8A' + '43 3B D9 64 7B 32 86 EC 40 66 23 3B 2A 3E 35 0E 9D 14 27 3B 2B 4E 76 51 9C EC AA F8 F4 38 74 53' + '9C EC AE 38 D9 43 71 B2 A7 E2 13 E3 D0 4B 71 B2 B7 E2 64 1F C5 C9 BE 8A 4F 8B 43 3F C5 C9 FE 8A' + '93 A9 8A 93 03 14 CF 88 C3 40 C5 C9 41 8A 93 83 15 27 87 28 FE 74 1C 86 2A 4E 0E 53 9C 1C AE 38' + '39 42 F1 67 E3 30 52 71 72 94 E2 E4 68 C5 C9 34 C5 67 C7 61 8C E2 E4 58 C5 C9 71 8A 93 E9 8A CF' + '8A C3 78 C5 C9 09 8A 93 19 8A 93 13 15 9F 1B 87 49 8A 93 93 15 27 A7 28 4E 4E 55 7C 5E 1C A6 29' + '4E 4E 57 9C 9C A1 38 39 53 F1 25 71 98 A5 38 39 5B F6 E2 38 CC 91 4D CE 95 BD 34 0E F3 64 93 F3' + '65 CF 8F C3 02 D9 E4 42 D9 6B E2 B0 48 36 B9 58 F6 8A 38 2C 91 4D 2E 95 BD 2D 0E CB 64 93 CB D5' + '3E B9 42 ED 93 2B 15 DF 13 87 47 15 27 1F 53 9C 7C 5C 71 72 95 E2 07 E2 B0 5A 71 72 8D E2 E4 5A' + 'C5 C9 75 8A EF 8B C3 7A C5 C9 0D 8A 93 1B 15 27 37 29 7E 2C 0E 9B 15 27 9F 90 7D 3C 0E 5B 64 93' + '4F AA 3C F9 94 CA 93 4F 73 AA C6 F9 FF CB E6 19 CA 58 2F 9F D5 55 2F C5 E1 39 5D 45 6E D5 55 E4' + '36 5D 45 6E 57 FC 64 1C 76 28 4E EE 54 9C DC A5 38 B9 5B F1 4B 71 D8 A3 38 B9 57 AD F8 FF 1B 67' + '9F 5A F1 F2 B2 4A ED 8A C3 3B 2A 45 66 AA 16 F2 8A 6A 21 DF 55 FC 4C 1C AE 2A 4E BE 27 FB 74 1C' + 'DE 97 4D 5E 93 7D 36 0E D7 65 93 1F A8 15 FF BF F5 7C A8 D0 F9 38 7C A4 10 F9 B1 EC D7 E2 F0 89' + '6C F2 53 D9 AF C7 E1 33 D9 E4 E7 B2 DF 8E C3 17 B2 C9 2F D5 15 F2 2B 75 85 FC 5A 76 B3 38 7C 23' + '9B BC C1 35 32 CE FF CF 41 0F C6 E1 5B 5A B1 59 D6 77 41 8C A3 F9 7D 10 A3 F5 43 10 6B 1A 87 1F' + '83 18 AD 9F 82 18 DF C4 CF 41 8C D6 2F 41 8C 6F FC D7 20 46 EB B7 20 C6 41 F8 3D 88 D1 FA 23 88' + 'F1 5D FC 2F 88 D1 FA 93 56 4C 96 F5 57 50 92 EF EF EF A0 24 AD 7F 82 92 B4 6E 6A AC 2E C4 E1 96' + 'C6 8A BC AD B1 21 FF D5 D8 90 B8 99 55 53 B9 38 44 05 56 F9 38 44 07 56 A3 38 C4 DC FC 6F 9B D9' + '02 8B 7F C6 DE 64 32 4B BB 2A E2 4C F2 FA EC 26 2B C4 21 87 49 D6 93 D3 24 2B C9 65 92 35 E4 96' + '2C E3 6A C8 63 92 35 E4 35 C9 1A F2 99 64 0D F9 4D B2 86 02 26 59 43 48 B2 AC AB A1 A0 49 96 2D' + '64 92 65 0B 9B 64 D9 22 92 E5 5C 13 77 98 64 D9 3B 25 CB BB 1A EE 32 49 EF DD 92 15 9C F7 1E 93' + '0C DC 6B 92 05 EE 93 4C 72 05 8A 9A 64 81 78 93 2C 93 60 92 65 8B 49 56 71 05 8A 9B A4 B7 84 64' + '55 57 C3 FD 26 59 E0 01 93 AC A1 A4 49 96 2D 25 59 CD 15 78 D0 24 BD A5 25 AB 3B F9 90 64 0D 57' + '59 19 93 F4 96 95 AC E9 BC E5 4C D2 5B 5E B2 9E F3 56 30 C9 7A 2B 9A 64 C3 61 93 2C 5B C9 24 47' + '32 D1 24 47 32 49 B2 BE BB AC B2 49 96 AD 62 92 65 AB 9A 64 D9 6A 92 0D DC 6D 57 DD 24 1B AE 61' + '92 35 D4 34 C9 86 6B 99 6C 18 87 DA 26 59 EF C3 26 59 6F 1D 93 AC F7 11 C9 86 AE B2 BA 26 59 59' + '3D 93 AC AC BE 49 D6 D0 C0 24 6B 68 68 92 35 34 92 6C E4 6A 68 6C 92 35 34 31 C9 1A 9A 9A E4 AB' + '99 49 D6 D0 DC 24 6B 68 21 D9 D8 D5 D0 D2 24 6B 68 65 92 35 24 9B 64 F1 D6 26 59 43 1B 93 AC 21' + '45 B2 89 AB A1 AD 49 96 6D 67 92 65 DB 9B 64 D9 0E 92 CD 5D D9 8E 26 D9 5A 27 93 6C AD B3 49 D6' + 'D0 C5 24 6B E8 6A 92 AF 6E 92 61 6E F9 3C 95 48 56 72 B2 87 64 33 27 7B EA 06 2F 06 B4 64 CF 78' + '42 31 AB 95 B3 7A 9B 95 EC AC 3E 66 B5 76 56 5F B3 DA 38 AB 9F 59 29 AE CE FE 37 B3 16 2A B6 97' + '1A 58 89 3C CB 04 16 3B 3D 30 B0 38 3A 83 6E FE 77 81 1B 1C 58 FC 73 08 BB 1C 5B DA 55 38 D4 24' + '6B 1B 66 92 55 0D 37 C9 7A 46 98 64 25 23 4D B2 86 51 92 65 5C 0D A3 4D B2 86 34 93 AC 61 8C 49' + 'D6 30 D6 24 6B 18 67 92 35 A4 4B 96 75 35 8C 37 C9 1A 26 98 64 0D 19 26 59 C3 44 93 AC 61 92 49' + 'D6 30 59 D2 DF 5C 53 4C D2 3B 55 D2 DF 46 D3 4C D2 3B 5D D2 DF 46 33 4C 72 16 CF 34 C9 D6 66 99' + 'E4 65 B3 4D F2 B2 39 92 FE 26 98 6B 92 05 E6 99 64 81 F9 92 8D 5C BD 0B 4C F2 B5 50 B2 B1 7B 6F' + '8B 4C F2 BD 2D 36 C9 02 4B 4C F2 B5 D4 24 EB 5D 66 92 F5 2E 97 F4 93 6A 85 64 73 57 D9 4A 93 AC' + 'EC 51 93 AC EC 31 93 BC F2 71 93 BC 72 95 49 BE 56 DF CC DA DD 38 F9 D7 04 16 E7 FF DA C0 E2 2D' + 'B0 2E B0 58 F1 FA C0 E2 2D B4 81 15 C6 F8 FD 6A A3 49 5E BF C9 24 2F DE 6C 92 57 3E 61 92 97 6D' + '91 F4 9B D4 93 26 79 D9 53 26 79 D9 D3 26 79 D9 33 26 79 D9 B3 92 7E 22 3C 27 E9 37 9E AD 26 E9' + 'DD 26 E9 37 9E ED 26 E9 DD 21 E9 37 9E 9D 26 E9 DD 25 E9 77 9B DD 26 59 7C 8F 49 96 D9 6B 92 65' + 'F7 49 FA DD 66 BF 49 16 38 60 92 05 0E 4A FA 8D E7 90 49 96 7D DE 24 CB 1E 36 C9 B2 47 24 FD C6' + '73 54 D2 EF 36 C7 24 FD 6E 73 DC 24 BD 2F 48 FA DD E6 84 49 7A 4F 4A FA DD E6 94 49 56 F6 A2 49' + 'B6 F6 92 49 96 7D 59 D2 EF 2B AF 98 A4 F7 55 49 BF 6D BC 66 92 05 4E 9B 64 0D 67 4C 72 46 9F 35' + 'C9 CB 5E 97 F4 1B C4 39 93 BC EC BC 49 5E 76 C1 24 CB BE 61 92 79 7B 53 D2 EF 0A 6F 99 E4 65 6F' + '9B E4 65 17 4D F2 75 49 D2 AF FF 97 4D B2 EC 3B 26 59 36 D3 24 CB 5E 31 C9 26 DE 95 F4 8B FE 55' + '93 2C F0 9E 49 DE 31 EF 4B FA 95 FE 9A 49 D6 7B DD 24 EB FD C0 24 2F FB D0 24 AF FC 88 D3 3D 5B' + 'D6 E4 FF 38 B0 18 FB 84 C5 B2 F9 B9 FD A9 49 7A 3F 93 F4 53 F7 73 93 F4 7E 21 E9 A7 EE 97 26 E9' + 'FD 4A D2 4F B1 AF 4D D2 FB 8D 64 65 E7 BD 61 92 DE 6F 25 7D 46 BE 33 C9 02 DF 4B FA 01 FF 41 D2' + '0F CC 8F 26 79 D9 4F 92 FE 6D FD 6C 92 DE 5F F4 46 EA C6 D9 C6 F3 AB 59 7E E3 F9 CD 2C BF F1 FC' + '6E 67 23 AE 1E 7F 98 64 15 FF B3 03 11 BD 7F 9A A4 F7 2F 3B 10 E9 28 6D 92 DE 7F EC D4 A6 43 B4' + '49 7A 6F 49 56 76 DE DB 26 E9 FD D7 8E 8B F4 E2 96 97 F4 46 DD F2 47 4B 7A A3 4D D2 1B 73 CB 9F' + '1C 75 88 36 A9 13 F4 2D 7F 1A A4 37 CE 24 BD D9 6F F9 73 1F BD 39 4C D2 9B F3 96 6F 98 F5 E5 32' + 'C9 06 73 9B 64 7D 79 4C 72 F0 F2 9A E4 8A 9B EF 96 7F 17 94 F9 AD 09 CA 02 56 2F 65 88 32 D6 8F' + '59 41 93 6C AD 90 A4 1F B3 C2 26 75 82 96 F4 63 76 87 49 7A EF 94 F4 63 76 97 49 7A EF 96 F4 63' + '76 8F 49 7A EF 95 F4 63 76 9F 49 7A 8B 4A FA 31 8B 37 49 6F 82 A4 1F B3 62 26 E9 2D 2E E9 C7 AC' + '84 49 7A EF 97 F4 63 F6 80 49 7A 4B 5A C3 AC AF 94 49 9D A0 4D B2 BE D2 26 75 82 36 C9 21 29 63' + 'EF 82 B2 AC 35 41 59 CE EA A5 2C 4F 19 E3 EB AD 60 52 27 68 93 3A 41 9B D4 09 FA 96 5F 99 39 91' + '13 CD 4B 99 74 CB AF AB 2C 50 F9 96 BF 99 58 59 15 93 AC AC AA 49 56 56 ED 96 BF AF 58 A0 BA 49' + '16 A8 61 92 05 6A 4A FA CA 6A 49 FA 45 BA B6 FA CB 6D BD 05 4F D0 4A B7 97 6D 6E 71 4B F4 BB 19' + 'CB A4 D0 8A F5 1B 9A 4E A0 16 F3 56 BB C0 62 C9 F6 66 F9 FD A8 83 59 7E 9D EC 18 58 3A 90 06 96' + 'CE A4 6A A1 5C 24 D6 45 B1 2C AB AB 62 BE 7A 1D 4E 03 8B 59 EC AE 92 49 91 BE F4 30 CB 6F A2 3D' + '55 D2 5B 2C D9 CB 2C 5F 67 6F 2B E9 AD 3E 81 C5 C2 7D 83 92 7C F5 0B 62 7C F5 57 CC EF 9A 7C A5' + '2A 96 65 0D B0 98 2F 39 50 56 E5 C8 B8 0C 52 C9 2C 6B B0 C5 FC 04 1E 62 96 1F 89 A1 56 D2 5B C3' + '82 98 8E AB 41 8C AF 11 8A F9 5D 59 87 56 B3 FC C8 8F 52 C9 2C 6B B4 62 D5 22 EF 36 4D B1 2C 6B' + '4C 60 F1 35 36 28 C9 9E 8D 93 55 23 32 0B D2 CD F2 25 C7 EB BA 2C 6B 42 10 63 5F 32 64 D5 8C C4' + '26 06 16 EB 9C 14 58 2C 39 59 56 BD 48 3F A7 A8 CE 2C 6B AA 62 F5 23 FD 9C 16 58 7C 4D 97 D5 30' + '32 9E 33 02 8B 2D CC 0C 2C B6 30 4B 75 FA FD 9D AF D9 16 F3 D6 1C B3 7C 7B 73 AD A4 B7 E6 59 CC' + 'B7 3E DF 62 DE 5A 20 AB 51 64 D6 2D 0C 2C FE B9 48 D7 35 8A F4 65 B1 C5 FC 8C 5C 12 58 FC 73 A9' + '59 FE 18 B7 2C B0 F8 E7 CA A0 24 1D 8F CA 6A 12 99 9F 8F 05 16 5F 8F CB 6A 1C 69 7D 95 5A 6F 1C' + '79 EF AB CD F2 ED AD B1 92 DE 5A 1B C4 58 72 9D 59 3E 47 EB 03 8B B1 0D B7 FC 33 95 6F 6F E3 2D' + '7F 58 F6 D6 26 C5 FC B1 98 BE CD B6 4E F8 79 FD 44 60 B1 96 2D 66 F9 92 4F 06 16 63 4F 99 E5 5B' + '7F 3A B0 18 7B 26 58 19 18 7B D6 2C FF FE 9E 0B 62 B4 B6 DA 7D EB EB DC 16 DC A9 BC 6E 7B 70 37' + 'D2 DA 11 DC 39 B4 76 06 73 82 D6 AE 20 EF B4 76 DB 7B F7 25 F7 98 E5 4B EE 0D C6 85 7F EE B3 BC' + '7B 6B 7F 30 5B 69 1D 08 B2 42 EB A0 46 30 6B 5E 1F B2 99 E5 F3 F7 7C 70 1F B1 E4 61 59 0D 22 D6' + '91 20 7F 3A 67 5B 7B 7E 3C 8F 05 B3 9C BE E3 C1 75 3A 70 07 EF 8F D6 89 20 EF AC E5 64 30 9E AC' + 'E5 94 AD AD FE FD BD 68 2D 78 EB 25 BB 53 7D 5F 5E B6 BC FB EB 5E 51 EB 59 ED BD 6A 2B 83 6F EF' + '35 5B 23 7D EC 74 90 23 5E 77 26 E8 0B AD 9F 68 E9 E0 C1 AE 5E E2 C9 4E 56 FD 88 F5 CB 2D 64 D3' + 'D6 D4 D0 BD 38 F9 7F 35 07 5B F5 0F F8 BF C9 91 75 17 56 E4 29 4F 0E 5F 9D 1F D0 3F E4 60 C9 24' + 'F7 21 2D DD FF 93 A3 86 93 FE 08 F9 A7 1C 4D 5D 09 3F 03 FE 0A BA A4 03 E0 2D 14 0C AC 62 C0 7F' + '3B 44 F3 BF 55 D1 FC 6F 45 FF DC 42 0E 9D F1 1A BA 88 17 0F 46 2E BD 69 1D BB 10 F1 15 B8 8D A8' + '5C E5 80 90 18 15 46 41 31 3A 8C 42 62 4D A0 B0 58 0B 28 22 16 07 EE 10 1F 01 EE 14 EF 08 E3 2E' + 'F1 CE 30 EE BE 8D 98 5C 59 FF DA 7F F8 36 A2 CD AA A4 02 85 8B 21 51 2C 54 0C 49 62 2F A0 B2 B1' + '8A A8 7F CE 56 D4 BF AB 20 4E 02 AA 8B 53 F8 4E DD F5 61 D4 14 8B 84 51 4B 2C 10 46 6D 31 14 C6' + 'C3 62 AE 30 EA 88 B9 C3 78 44 CC 11 46 5D 31 67 18 F5 C4 3C 61 D4 17 F3 86 D1 40 CC 17 46 43 31' + '7F 18 4D C4 6E 1C 42 B1 07 D0 EC 76 D6 FF 31 D0 3C 90 2D 02 D9 32 90 AD 78 4D 01 BE 87 64 63 6B' + '63 1B 32 2F 07 35 45 E4 A0 B6 15 39 16 ED 45 0E 66 07 91 83 DB 51 D4 FF 55 20 72 70 3B 8B 1C AB' + '2E 22 C7 A4 AB C8 31 E9 26 72 4C BA 8B 1C 93 1E AE 5C 18 3D 45 8E 49 2F F1 7E A0 B7 58 0A E8 23' + '96 01 FA 8A 65 81 7E 62 79 A0 BF 58 1B 48 15 EB 00 03 C4 87 81 41 62 77 60 B0 F8 00 30 44 2C 09' + '0C 15 EB 02 A3 F8 96 F5 F1 19 4F 6B A3 29 F5 78 43 99 66 DE 96 DC CB 4D B6 E2 D6 6D 92 CF 46 E3' + 'AD 2C E5 04 F3 F2 19 29 C3 BC 94 13 CD CB 67 A5 49 E6 A5 9C 6C 5E 3E 3E 4D 31 2F E5 54 F3 B6 E5' + 'FE 6C 5E CA E9 EC 61 5C 71 6E CB B7 FD 79 B2 1D F7 E4 DB FE 94 49 39 CB BC 7C E0 9C 6D 5E CA 39' + 'F2 36 75 72 AE BC 5E CE B3 B2 1D B8 03 5B 59 CA 05 B7 FD 47 95 2C B0 F0 B6 FF F4 87 72 D1 6D FF' + '84 4B B9 F8 B6 7F 2A A4 5C A2 BE F0 B2 A5 A4 2E 5F 26 9B 2B C6 72 D9 E4 0A 52 9F E0 AC 24 F5 B4' + 'FB A8 E2 0F 71 93 55 9C 7C 5C 36 37 A3 55 B2 C9 D5 2A 4F AE 51 79 72 AD E2 7C F2 5D A7 38 B9 5E' + '71 72 83 E2 E4 46 C5 79 BF 6F 52 9C DC AC 38 F9 84 E2 E4 16 C5 B9 66 3D A9 B8 3E 30 52 9C 7C 5A' + '71 F2 19 C5 B9 5A 3E AB 38 F9 9C E2 E4 56 C5 C9 6D 8A 73 B5 DB AE 38 B9 43 76 98 9B 9A 6C 72 97' + '6C AE 2D BB 65 93 7B 64 27 72 F3 92 4D EE 93 CD 65 6A BF 6C F2 80 EA 27 0F AA 7E F2 90 E2 DC 38' + '9F 57 9C 3C AC 38 79 44 71 F2 A8 E2 5C 13 8F 29 4E 1E 57 9C 7C 41 71 F2 84 E2 DC 6A 4F 2A 4E 9E' + '52 9C 7C 51 71 F2 25 C5 79 E0 7C 59 71 F2 15 C5 C9 57 15 27 5F 53 9C 4F 2A A7 15 27 CF 28 4E 9E' + '55 9C 7C 5D 71 2E BC E7 14 27 CF 2B 4E 5E 50 9C 7C 43 71 1E 37 DF 54 9C 7C 4B 71 F2 6D C5 C9 8B' + '8A 73 5B BB A4 38 79 59 71 F2 1D C5 C9 4C C5 B9 0D 5D 51 9C 7C 57 71 F2 AA E2 E4 7B 8A 73 13 7A' + '5F 71 F2 9A E2 E4 75 C5 C9 0F 14 E7 92 FE A1 E2 E4 47 8A 93 1F 2B 4E 7E A2 B8 3E 6D 51 9C FC 4C' + '71 7D CE A2 38 F9 85 E2 DC 22 BF 54 9C FC 4A 71 F2 6B C5 C9 6F 14 E7 1E 72 43 71 7D A4 A2 38 F9' + '9D E2 E4 F7 8A F3 66 FA 41 71 7D 53 29 9B BB D7 4F B2 C9 9F 65 F3 56 F9 45 36 F9 AB AE 27 7F D3' + 'F5 E4 EF DC 42 E2 FC 66 C5 7B F7 8F DB FE 28 E1 AD FF 05 31 DE 69 7F 06 31 5A 7F 05 31 DE B1 7F' + '07 31 5A FF DC F6 5F AE D0 BA 79 DB 7F C4 4C 19 F5 2F A2 72 73 BD 8D 16 4B 00 31 22 D7 CF 6C 22' + 'D7 BF 58 91 EB 5F 9C C8 F5 34 BB F8 20 90 43 D4 BF 1C 24 EA 5F AB 12 B9 CE E6 16 B9 CE E6 11 B9' + 'EE E7 15 B9 DE E6 13 B9 EE E7 17 2B 02 05 C4 30 37 5B B1 12 50 50 4C 04 0A 89 49 DC 6C C5 CA DC' + '6C C5 2A DC 6C C5 AA DC 6C C5 6A C0 5D 62 75 E0 6E B1 06 70 8F C8 7D E4 5E 91 FB CA 7D 22 D7 F7' + 'A2 22 D7 F5 78 91 EB 7C 82 C8 7D A6 98 C8 F5 BC B8 58 0F 28 21 D6 07 EE 17 1B 00 0F 88 0D 81 92' + '62 23 A0 94 D8 98 87 0F B1 09 50 5A 6C 0A 3C 24 36 03 CA 88 CD 81 B2 62 0B 1E 36 44 FD D7 EB 62' + '2B 6E FF 62 32 50 51 6C CD 63 81 D8 86 67 02 31 05 48 14 DB 02 49 62 3B 9E 09 C4 F6 3C 13 88 1D' + '78 26 10 3B F2 4C 20 76 E2 99 40 EC CC 33 81 D8 05 A8 29 76 05 6A 89 DC C3 6B 8B DC C7 1E 16 B9' + '97 D7 11 7B 02 8F 88 DC 97 EB 8A BD 81 7A 62 1F A0 BE D8 17 68 20 F6 03 1A 8A FD 81 46 62 2A D0' + '58 1C 00 34 11 07 F2 8C 20 0E E2 19 41 1C 0C 34 17 87 70 5F 14 87 72 27 14 87 71 1B 14 87 73 0F' + '14 47 70 D7 13 47 72 9F 13 47 71 67 13 47 73 2F 13 D3 80 76 E2 18 9E 0F C4 B1 3C 1F 88 E3 78 3E' + '10 D3 79 3E 10 C7 F3 7C 20 4E 00 BA 88 19 3C 1F 88 13 79 3E 10 75 3E 10 27 F3 7C 20 F2 9C D0 53' + '9C 0A F4 12 E7 3C 84 DE E2 DC 87 D0 87 CC C3 43 5E 5F 91 67 A3 7E 22 CF 46 FD 45 9E 57 52 C5 7F' + 'C2 18 20 FE 12 C6 40 71 4B 18 83 C4 A7 C2 18 2C 3E 13 C6 10 F1 B9 30 86 8A DB C2 18 26 7E 16 C6' + '70 F1 8B 30 46 88 5F 85 31 52 7C 25 8C 51 E2 CD 30 46 8B 4F 86 91 26 3E 1D C6 18 F1 D9 30 C6 8A' + '5B C3 18 27 6E 0F 23 5D DC 11 C6 78 71 57 18 13 C4 3D 61 64 88 FB C2 98 28 1E 08 63 92 78 28 8C' + 'C9 E2 E1 30 A6 88 47 C3 98 2A 1E 0F 63 9A 78 22 8C E9 E2 A9 30 66 88 2F 85 31 53 7C 35 8C 59 E2' + 'E9 30 66 8B 67 C3 98 23 9E 0B 63 AE 78 3E 8C 79 E2 85 30 E6 8B 6F 84 B1 40 7C 33 8C 85 E2 5B 61' + '2C 12 2F 85 B1 58 CC 0C 63 89 78 35 8C A5 E2 B5 30 96 89 1F 86 B1 5C FC 28 8C 15 E2 C7 61 AC 14' + '3F 09 E3 51 F1 D3 30 1E 13 3F 0F E3 71 F1 CB 30 56 89 5F 87 B1 5A FC 26 8C 35 E2 8D 30 D6 8A DF' + '86 B1 4E FC 2E 8C F5 E2 F7 61 6C 10 7F 0C 63 A3 F8 6B 18 9B 44 FD 63 A5 E2 BA 30 9E 10 7B 87 B0' + '45 44 08 4F BA 7C 87 F0 94 1B EF 10 9E 76 F3 22 84 67 C4 9D 21 3C EB C6 3D 84 E7 C4 98 10 B6 8A' + 'D9 42 D8 26 C6 86 B0 5D DC 1B C2 0E 97 8F 10 76 8A FB 43 D8 E5 F2 12 C2 6E F1 60 08 7B 5C 7E 42' + 'D8 2B DE 13 C2 3E 31 2E 84 FD 62 F6 10 0E 88 39 42 38 28 16 0F E1 90 98 33 84 E7 C5 5C 21 1C 16' + '73 87 70 C4 CD D7 10 8E BA F9 1A C2 31 31 5F 08 C7 C5 FC 21 BC 20 16 08 E1 84 18 0A E1 A4 58 30' + '84 97 C5 3E 21 BC 22 F6 0D E1 55 B1 5F 08 AF 89 FD 43 38 2D A6 86 70 46 1C 10 C2 39 71 60 08 E7' + 'C5 41 21 5C 10 07 87 F0 86 38 24 84 37 C5 A1 21 BC 25 0E 0B E1 92 38 3C 84 CB E2 88 10 DE 11 47' + '86 90 29 8E 0A E1 8A 38 3A 84 77 C5 B4 10 DE 17 C7 84 70 4D 1C 1B C2 75 71 5C 08 1F EB FE 7C 12' + 'F8 44 7C 0A F8 54 DC 09 7C F6 2F A2 F5 6F FA 66 8B C1 E7 72 3D 0B 7C 21 3E 03 7C 29 6E 2B 86 AF' + '5D EA 4A E2 1B 71 79 71 DC 10 57 14 C7 B7 E2 CA E2 F8 4E 7C B4 38 BE 17 9F 28 89 1F DC D4 2E 89' + '75 05 A2 A2 B1 B6 40 D4 B1 02 51 1B 24 D7 3B B9 43 F2 19 27 2B 84 28 2B 85 A2 1E 0C 45 55 94 4C' + '74 B2 45 21 CA 26 85 A2 EA 14 8A 6A 69 B2 53 A1 A8 E3 85 29 8F 16 8E 3A 56 38 EA 05 93 7B 0B 47' + '9D 34 79 82 81 22 94 47 8A 44 ED 29 12 75 5C F2 A8 93 D5 EF A6 AC 72 77 54 F8 EE A8 9E 17 29 3B' + '5D 8C 4A BD 18 D5 4B B2 B3 93 BD 2F 46 C5 98 1C 71 31 AA 4F 60 8D BC 18 D5 37 B0 46 5D 8C EA 17' + '58 A3 2F 46 F5 0F AC B4 8B 51 C7 55 E1 51 67 BD 20 79 CC C9 13 2A 73 34 52 F7 49 59 C7 22 D6 A9' + '20 C6 96 5E 0C 62 B4 F0 4E 54 54 14 F7 D0 28 91 7B 68 B4 A8 FF DF 4C E4 1E 9A 4D E4 1E 1A 2B 72' + '0F 8D 13 B9 87 66 17 B9 87 E6 10 F5 1F C7 8B DC 43 73 89 DC 43 73 8B DC 43 F3 88 DC 43 F3 8A DC' + '43 F3 89 DC 43 F3 8B DC 43 0B 88 DC 43 43 22 F7 D0 82 22 F7 D0 42 22 F7 D0 C2 22 F7 D0 22 22 F7' + 'D0 3B 44 EE A1 77 8A DC 43 EF 12 B9 87 DE 2D 72 0F BD 47 E4 9E 78 AF C8 3D F1 3E 91 7B 62 51 91' + '7B 62 BC C8 3D 31 41 E4 9E 58 4C E4 9E 58 5C E4 9E 58 42 D4 FF 73 2F 72 4F 7C 40 E4 9E 58 52 E4' + '9E 58 4A E4 9E F8 A0 C8 3D B1 B4 A8 FF 0F 44 E4 9E 58 46 E4 9E 58 56 E4 9E 58 4E E4 9E 58 5E E4' + '9E 58 41 E4 9E 58 51 E4 9E 18 16 B9 27 56 12 B9 27 26 8A DC 13 93 44 EE 89 95 2D 3F 55 2C 3F 55' + '2D 3F D5 2C 3F D5 2D 3F 35 2C 3F 35 2D 3F B5 2C 3F B5 2D 3F 0F 5B 7E EA 58 7E 1E B1 FC D4 B5 FC' + 'D4 B3 FC D4 B7 FC 34 B0 FC 34 B4 FC 34 B2 FC 34 B6 FC 34 B1 FC 34 B5 FC 34 B3 FC 34 B7 FC B4 B0' + 'FC B4 B4 FC B4 B2 FC 24 5B 7E 5A 5B 7E DA 58 7E 52 2C 3F 6D 2D 3F ED 2C 3F ED 2D 3F 1D 2D 2F 9D' + '2C 2F 9D 2D 2F 5D 2C 2F 5D 2D 2F DD 2C 2F DD 2D 2F 3D 2C 2F 3D 2D 2F BD 2C 2F BD 2D 2F 7D 2C 2F' + '7D 2D 2F FD 2C 2F FD 2D 2F A9 96 97 01 96 97 81 96 97 41 96 97 C1 96 97 21 96 97 A1 96 97 61 96' + '97 E1 96 97 11 96 97 91 96 97 51 96 97 D1 96 97 34 CB CB 18 CB CB 58 CB CB 38 CB 4B BA E5 65 BC' + 'E5 65 82 E5 25 C3 F2 32 D1 F2 32 C9 F2 32 D9 F2 32 C5 F2 32 D5 F2 32 CD F2 32 DD F2 32 C3 F2 32' + 'D3 F2 32 CB F2 32 DB F2 32 C7 F2 32 D7 F2 32 CF F2 32 DF F2 B2 C0 EE 9B 85 96 9F 45 96 9F C5 96' + '9F 25 96 9F A5 96 9F 65 96 9F E5 96 9F 15 96 9F 95 96 9F 47 2D 3F 8F 59 7E 1E B7 FC AC B2 FC AC' + 'B6 FC AC B1 FC AC B5 FC AC B3 FC AC B7 FC 6C B0 FC 6C B2 BC 6C B6 BC 3C 69 79 78 C6 C6 FD 59 1B' + 'F7 6D 36 CE DB 6D 9C 77 D8 38 EF B4 71 DE 6D E3 BB C7 C6 77 AF 8D EF 3E 1B DF FD 36 BE 07 6C 7C' + '0F DA F8 1E B2 F1 7D DE C6 F7 B0 8D EF 11 1B DF A3 36 BE C7 6D 5C 4F D8 78 9E B4 F1 3C 65 E3 F9' + 'A2 8D E7 4B 36 9E 2F DB 78 BE 62 E3 F9 9A 8D E3 69 1B C7 33 36 8E 67 6D 1C 5F B7 71 3C 67 E3 78' + 'DE C6 F1 82 8D E3 1B 36 8E 6F DA 38 BE 65 E3 F8 B6 8D E3 45 9B E7 97 6C 3C 2F DB 78 BE 63 F3 3C' + 'D3 E6 F9 15 1B DF 77 6D 9E 5F B5 79 FE 9E 8D F7 FB 36 DE D7 6C 9E 5F B7 79 FE 81 8D FF 87 36 FE' + '1F D9 F8 7F 6C E3 FF 89 CD F3 4F 2D 0F 9F 59 1E 3E B7 3C 7C 61 79 F8 D2 F2 F0 95 E5 E1 6B CB C3' + '37 96 87 1B 96 87 6F 2D 0F DF 59 1E BE B7 3C FC 60 F3 FC 47 CB C7 4F 36 CF 7F B6 BC FC 62 79 F9' + 'D5 F2 F2 9B E5 E5 77 CB CB 1F 96 97 FF 59 5E FE B4 79 FE 97 E5 E7 6F CB CF 3F 96 9F 9B 96 9F 5B' + '96 9F DB 96 9F 7F 2D 3F C8 F4 F9 89 CA F4 F9 89 CE F4 F9 89 C9 F4 F9 C9 96 E9 F3 13 9B E9 F3 93' + '3D D3 E7 25 47 A6 CF 4B CE 4C 9F 97 5C 99 3E 2F 79 33 7D 1E F2 65 FA 3C E4 CF F4 79 28 90 E9 F3' + '10 CA F4 79 28 98 E9 F3 50 28 D3 E7 A1 70 A6 CF C3 1D 99 7E FC EF CC F4 E3 7F 57 A6 1F FF BB 33' + 'FD F8 DF 93 E9 C7 FF DE 4C 3F FE F7 65 FA F1 8F CF F4 E3 9E 90 E9 C7 BD 58 A6 1F F7 E2 99 7E DC' + '4B 64 FA 71 BF 3F D3 8F FB 03 99 7E DC 4B 66 FA 71 2F 95 E9 C7 FD C1 4C 3F EE A5 33 FD B8 3F 94' + 'E9 C7 BD 4C A6 1F F7 B2 99 7E DC CB 65 FA 71 2F 9F E9 C7 BD 42 A6 1F F7 8A 99 7E DC C3 99 7E DC' + '2B 65 FA 71 4F CC F4 E3 9E 94 E9 C7 BD B2 8D 7B 15 1B F7 AA 36 EE D5 6C DC AB DB B8 D7 B0 71 AF' + '65 E3 5E DB C6 FD 61 1B F7 3A 36 EE 75 33 FD 7D 50 CF C6 BF BE 8D 7F 03 1B FF 86 36 FE 8D 6D DC' + '9B DB 38 B7 B0 71 6E 69 E3 DC CA C6 39 D9 C6 B9 B5 8D 73 1B 1B E7 B6 36 CE ED 6C 9C DB DB 38 77' + 'B0 71 EE 68 E3 DC C9 C6 B9 B3 8D 73 17 1B E7 AE 36 CE DD 6C 9C BB DB 38 F7 B0 71 EE 69 E3 DC CB' + 'C6 B9 B7 8D 73 1F 1B E7 BE 36 CE FD 6C 9C FB DB 38 A7 DA 38 0F B0 71 1E 68 E3 3C C8 C6 79 B0 8D' + 'F3 10 1B E7 A1 36 CE C3 6C 9C 87 DB 38 8F C8 F4 EB CF 48 1B EF 51 36 DE A3 6D BC D3 6C BC C7 64' + 'FA F5 67 AC 8D FB 38 1B F7 74 1B F7 F1 36 EE 13 6C DC 33 6C DE 4F B4 F1 9F 64 F3 7E B2 CD FB 29' + '99 7E FD 99 6A 79 99 66 79 99 6E 79 99 61 79 99 69 79 99 65 79 99 6D 79 99 93 E9 D7 9F B9 96 9F' + '79 96 9F F9 96 9F 05 96 9F 85 96 9F 45 96 9F C5 96 9F 25 96 9F A5 96 9F 65 96 9F E5 96 9F 15 96' + '9F 95 96 9F 47 2D 3F 8F 59 7E 1E B7 FC AC B2 FC AC B6 FC AC B1 FC AC B5 FC AC B3 FC AC B7 FC 6C' + 'B0 FC 6C B4 FC 6C B2 FC 6C B6 FC 3C 61 F9 D9 62 F9 79 D2 F2 F3 94 E5 E7 69 CB CF 33 96 9F 67 2D' + '3F CF 59 7E B6 5A 7E B6 59 7E B6 5B 7E 76 58 7E 76 5A 7E 76 59 7E 76 5B 7E F6 58 7E F6 5A 7E F6' + '59 7E F6 5B 7E 0E 58 7E 0E 5A 7E 0E 59 7E 9E B7 FC 1C B6 FC 1C B1 FC 1C B5 FC 1C B3 FC 1C B7 FC' + 'BC 60 F9 39 61 F9 39 69 F9 39 65 F9 79 D1 F2 F3 92 E5 E7 65 CB CF 2B 96 9F 57 2D 3F AF 59 7E 4E' + '5B 7E CE 58 7E CE 5A 7E 5E B7 FC 9C B3 FC 9C B7 FC 5C B0 FC BC 61 F9 79 D3 F2 F3 96 E5 E7 6D CB' + 'CF 45 CB CF 25 CB CF 65 CB CF 3B 96 9F 4C CB CF 15 CB CF BB 96 9F AB 96 9F F7 2C 3F EF 5B 7E AE' + '59 7E AE 5B 7E 3E B0 FC 7C 68 F9 F9 C8 F2 F3 B1 E5 E7 13 CB CF A7 96 9F CF 2C 3F 9F 5B 7E BE B0' + 'FC 7C 69 F9 F9 CA F2 F3 B5 E5 E7 1B CB CF 0D CB CF B7 96 9F EF 2C 3F DF 5B 7E 7E B0 FC FC 68 F9' + 'F9 C9 F2 F3 B3 E5 E7 17 CB CF AF 96 9F DF 2C 3F BF 5B 7E FE B0 FC FC CF F2 F3 A7 E5 E7 2F CB CF' + 'DF 96 9F 7F 2C 3F 37 2D 3F B7 2C 3F B7 2D 3F FF 5A 7E 70 C5 E7 27 EA 8A CF 4F F4 15 9F 9F 98 2B' + '3E 3F D9 AE F8 FC C4 5E F1 F9 89 BB E2 F3 93 FD 8A CF 4F 8E 2B 3E 3F 39 AF F8 FC E4 BA E2 F3 93' + 'FB 8A CF 4F 9E 2B 3E 3F 79 AF F8 FC E4 BB E2 F3 93 FF 8A CF 4F 81 2B 3E 3F A1 2B 3E 3F 05 AF F8' + 'FC 14 BA E2 F3 53 F8 8A CF 4F 91 2B 3E 3F 77 5C F1 F9 B9 F3 CA FF B5 74 16 D0 51 5D 5D 14 DE DC' + '29 03 85 0A A5 B8 5B 71 09 24 40 70 48 70 09 51 42 08 21 24 01 82 05 82 BB 06 6B 81 16 77 87 16' + '28 D2 02 85 22 55 A8 7B FB B7 F3 EA EE 0E 54 A0 54 FE B7 CF DB 6B B1 D6 77 4F 32 73 EF 39 E7 BB' + 'F7 BD 37 6B 01 13 F8 A9 14 09 FC 54 8E 04 7E AA 44 02 3F 55 23 81 9F 6A 91 C0 4F F5 48 E0 A7 46' + '24 F0 53 33 12 F8 A9 15 09 FC D4 8E 04 7E EA 44 02 3F 75 23 81 9F 7A 91 C0 CF 5D 91 C0 4F FD 48' + 'E0 A7 41 24 F0 D3 30 12 F8 69 14 09 FC 34 8E 04 7E 9A 44 02 3F 4D 23 81 9F 66 91 C0 4F F3 48 E0' + 'A7 45 24 F0 13 15 09 FC B4 8C 04 7E 5A 45 02 3F D1 91 C0 4F 8C FC B4 96 9F 36 F2 D3 56 7E 62 E5' + 'A7 9D FC B4 97 9F 0E F2 D3 51 7E 3A C9 4F 67 F9 E9 22 3F 5D E5 A7 9B FC C4 C9 4F BC FC 74 97 9F' + '1E F2 D3 53 7E 7A C9 4F 6F F9 E9 23 3F 7D E5 A7 9F FC F4 97 9F 01 F2 93 20 3F 03 E5 27 51 7E 92' + 'E4 27 59 7E 52 E4 27 55 7E D2 E4 67 90 FC A4 CB CF 60 F9 C9 90 9F 21 F2 93 29 3F 43 E5 27 4B 7E' + '86 C9 4F B6 FC 0C 97 9F 1C F9 C9 95 9F 3C F9 19 21 3F 23 E5 67 94 FC E4 CB CF 68 F9 19 23 3F 63' + 'E5 67 9C FC 8C 97 9F 02 F9 99 20 3F 13 E5 A7 50 7E 26 C9 CF 64 F9 99 22 3F 53 E5 67 9A FC 4C 97' + '9F 19 F2 33 53 7E 66 C9 CF 6C F9 99 23 3F 73 E5 67 9E FC CC 97 9F 05 F2 B3 50 7E 16 C9 CF 62 F9' + '29 92 9F 25 F2 B3 54 7E 96 C9 CF 72 F9 59 21 3F 77 CB CF 3D F2 B3 52 7E 56 C9 CF 6A F9 B9 57 7E' + 'EE 93 9F 35 F2 B3 56 7E D6 C9 CF 7A F9 D9 20 3F 1B E5 67 93 FC 6C 96 9F 2D F2 B3 55 7E B6 C9 CF' + '76 F9 D9 21 3F 3B E5 67 97 FC EC 96 9F 3D F2 B3 57 7E F6 C9 CF 7E F9 39 40 B6 2C 86 FB C9 B6 0E' + '87 C8 B5 21 1C 26 D7 85 F0 20 B9 3E 84 23 E4 86 10 8E 92 1B 43 38 46 6E 0A E1 38 B9 39 84 87 C8' + '2D 21 3C 4C 6E 0D E1 04 B9 2D 84 93 E4 F6 10 4E 91 3B 42 78 84 DC 19 C2 69 72 57 08 67 C8 DD 21' + '3C 4A EE 09 E1 2C B9 37 84 73 9A EF 3C B9 3F 84 0B E4 81 10 1E 23 EF 0F E1 71 F2 81 10 9E 20 0F' + '86 F0 24 79 28 84 A7 48 FE 77 98 64 89 3A B8 48 9E 08 E1 12 79 32 84 67 C8 53 21 3C 4B 3E 12 C2' + '73 E4 E9 10 9E 27 CF 84 F0 02 F9 68 08 2F 92 67 43 78 89 3C 17 C2 CB E4 F9 10 5E 21 2F 84 F0 2A' + 'F9 58 08 AF 91 8F 87 F0 3A F9 44 08 6F 90 4F 86 F0 26 F9 54 08 6F 91 4F 87 F0 3F F2 62 08 6F 93' + '97 42 78 87 7C 26 84 08 F9 6C 08 1E F9 5C 08 EF 92 CF 87 F0 1E F9 42 08 EF 93 2F 86 F0 01 E9 EA' + 'E0 43 E5 FB 91 F2 FB 58 79 7D A2 F7 7F AA F5 3E D3 FA 9F CB E7 17 F2 F9 A5 7C 7E 25 9F 5F CB E7' + '37 F2 F9 AD 7C 7E A7 FE 7F 2F 9F 3F C8 E7 8F F2 F9 93 7C FE 2C 9F BF C8 E7 AF F2 79 59 3E AF C8' + 'E7 55 CD F7 9B 7C FE 2E 9F 7F C8 E7 9F F2 79 4D 3E AF CB E7 5F F2 79 43 3E FF 96 CF 7F E4 F3 5F' + 'F9 FC 4F 3E E1 05 FD 29 E6 05 3E 9D 17 F8 0C 79 41 BF 6E F2 02 9F C5 BD A0 6F 61 2F F0 59 C2 0B' + '7C 96 F4 02 9F 37 7B 81 CF 52 5E E0 B3 B4 17 F4 F3 16 2F E8 EF AD 5E E0 F3 36 2F F0 79 BB 17 F8' + '2C E3 05 3E EF F0 02 1F 65 BD C0 E7 9D 5E E0 B3 9C 17 F8 2C EF 05 3E 2B 28 DF 8A CA AF 92 F2 AA' + 'AC F7 57 D1 7A 55 B5 7E 35 2F F0 59 DD 0B 7C D6 F0 02 9F 35 BD C0 67 2D 2F F0 59 DB 0B 7C D6 F1' + '02 9F 75 BD A0 FF F5 BC C0 E7 5D 5E E0 B3 BE 17 F8 6C E0 05 3E 1B 7A 81 CF 46 5E E0 B3 B1 17 F8' + '6C E2 05 3E 9B 7A 81 CF 66 9A AF B9 17 F8 6C E1 05 3E A3 BC C0 67 4B 2F F0 D9 CA 0B 7C 46 7B 81' + 'CF 18 2F F0 D9 DA 0B 7C B6 F1 02 9F 6D BD C0 67 AC 17 F8 6C E7 05 3E DB AB 3F 1D E4 B3 A3 7C 76' + '52 BF 3A CB 67 17 F5 AD AB 7C 76 93 CF 38 F9 8C 97 CF EE F2 D9 43 FD EC A9 FE F6 92 CF DE F2 D9' + '47 3E FB CA 67 3F F9 E8 2F 9F 03 E4 33 41 3E 07 CA 67 A2 F2 4D 52 7E C9 CA 2B 45 EF 4F D5 7A 69' + '5A 7F 90 7C A6 CB E7 60 F9 CC 90 CF 21 F2 99 29 9F 43 E5 33 4B FD 1F 26 9F D9 F2 39 5C 3E 73 E4' + '33 57 3E F3 E4 73 84 7C 8E 94 CF 51 F2 99 AF F9 46 CB E7 18 F9 1C 2B 9F E3 E4 73 BC 7C 16 C8 E7' + '04 F9 9C 28 9F 85 F2 39 49 3E 27 CB E7 14 F9 9C AA FE 4C 93 CF E9 F2 39 43 FD 9A 29 9F B3 D4 B7' + 'D9 F2 39 47 3E E7 CA E7 3C F9 9C 2F 9F 0B D4 CF 85 EA EF 22 F9 5C 2C 9F 45 F2 B9 44 3E 97 CA C7' + '32 F9 5C 2E 9F 2B E4 F3 6E F9 BC 47 F9 AE 54 7E AB 94 D7 6A BD FF 5E AD 77 9F D6 5F 23 9F 6B E5' + '73 9D 7C AE 97 CF 0D F2 B9 51 3E 37 C9 E7 66 F5 7F 8B 7C 6E 95 CF 6D F2 B9 5D 3E 77 C8 E7 4E F9' + 'DC 25 9F BB E5 73 8F 7C EE D5 7C FB E4 73 BF 7C 1E 90 CF FB E5 F3 01 F9 3C 28 9F 87 E4 F3 B0 7C' + '3E 28 9F 47 E4 F3 A8 7C 1E 93 CF E3 EA CF 43 F2 F9 B0 7C 9E 50 BF 4E CA E7 29 F5 ED 11 F9 3C 2D' + '9F 67 E4 F3 51 F9 3C 2B 9F E7 D4 CF F3 EA EF 05 F9 7C 4C 3E 1F 97 CF 27 E4 F3 49 F9 78 4A 3E 9F' + '96 CF 8B F2 79 49 3E 9F 51 BE CF 2A BF E7 94 D7 F3 7A FF 0B 5A EF 45 AD FF 12 F9 A1 7F FF 27 3F' + 'F2 EF F7 64 94 FF F9 9E 6C E9 7F BE 27 5B F9 9F EF C9 68 FF F3 3D 19 E3 7F BE 27 5B FB 9F EF C9' + '36 FE E7 7B B2 AD FF 71 94 8C F5 6F 53 64 3B FF F3 BD E6 7B 4F F3 BD AF F9 3E D0 7C 1F 6A BE 8F' + '34 DF C7 9A EF 13 CD F7 A9 E6 FB 4C F3 7D AE F9 BE D0 7C 5F 6A BE AF 34 DF D7 9A EF 1B CD F7 AD' + 'E6 FB 4E F3 7D AF F9 7E D0 7C 3F 6A BE 9F 34 DF CF 9A EF 17 CD F7 AB E6 BB AC F9 AE 68 BE AB 9A' + 'EF 37 CD F7 BB E6 FB 43 F3 FD A9 F9 AE 69 BE EB 9A EF 2F CD 77 43 F3 FD AD F9 FE D1 7C FF 6A BE' + 'FF 34 1F 7E F6 C9 BF 6B 47 36 0C C3 91 4D C3 08 91 2D C2 28 4E F6 0E 23 4C B6 0A A3 04 D9 2C 8C' + '92 64 DB 30 6E 26 FB 86 51 8A 8C 0F A3 34 D9 3D 8C 5B 48 FE 8B 42 B2 67 18 B7 91 D1 61 DC 4E B6' + '0B A3 0C D9 2D 8C 3B C8 D6 61 94 25 E3 C2 B8 93 6C 19 46 39 32 26 8C F2 64 E3 30 2A 90 4D C2 A8' + '48 36 0F A3 12 19 15 46 65 B2 4D 18 55 C8 D8 30 AA 92 ED C3 A8 46 4E 08 A3 3A 79 3E 8C 1A E4 DE' + '30 6A 92 13 C3 A8 AD 7A EB A8 DE 7A 64 AF 30 1A A8 BE 46 AA AB B1 EA 6A A2 BA 9A AA AE 66 AA AB' + 'B9 EA 6A A1 BA A2 54 57 4B D5 D5 4A 75 C5 A8 9E D6 AA A7 8D EA 69 AB 7A DA A9 8E 0E CA 3F 4E 79' + 'F5 52 3E 7D 94 4F 3F E5 31 40 EB 27 68 FD 81 5A 3F 49 EB 26 6B DD 54 AD 9B AE 75 32 B4 4E A6 D6' + 'C9 52 7F B2 D5 97 1C F5 25 57 EB 8F 50 5F F2 95 C7 68 79 1F A3 7C C6 AA 3F E3 D5 97 02 E5 35 41' + '79 4D 54 5E 85 EA CB 24 E5 37 59 F9 4D 55 7E D3 D4 97 E9 EA CB 0C E5 3B 4B F9 CE 96 DF 39 CA 7B' + 'AE FC CE 97 D7 85 DA C7 8B 94 FF 62 E5 5F A4 7D BC 44 75 2C D5 7E 5E A6 FD BC 5C 75 AD 50 5D 77' + 'AB AE 95 EA F3 2A D5 B5 5A 75 DD AB BA EE 53 5D 6B 54 D7 5A D5 B5 4E 75 AD D7 3E DE A0 FA 36 AA' + 'BE 4D AA 6F B3 EA DB A2 7D BC 55 75 6E 53 9D DB 55 E7 5E D5 B3 4F F5 EC 57 3D F7 AB 8E 07 54 C7' + '41 D5 71 48 75 1C 56 1D 47 54 C7 51 D5 71 4C 75 1C 57 1D 0F A9 8E 87 55 C7 09 D5 71 52 75 9C 52' + '1D 8F A8 8E D3 AA E3 8C EA 78 54 75 9C 55 1D E7 54 C7 79 D5 71 41 75 E0 72 31 FB C6 99 E6 40 31' + '0D 9B 02 8E C3 96 36 0C 71 D8 CA 86 37 71 18 6D C3 E2 1C C6 D8 30 CC 61 6B 1B 96 E0 B0 8D 0D 4B' + '72 D8 D6 86 37 73 18 6B C3 52 1C B6 B3 61 99 CB C5 82 2F 31 85 7D 9B AC A2 38 8B CA 2A 8A B7 E8' + '4E 45 DD 2D 2A A7 A8 87 45 E5 15 F5 B4 A8 82 A2 5E 16 55 54 D4 DB A2 4A 8A FA 58 54 59 51 5F 8B' + 'AA 28 EA 67 51 55 45 FD 2D AA A6 68 80 45 D5 15 25 58 54 43 D1 40 8B 6A 2A 4A B4 A8 96 A2 24 8B' + '6A 2B 4A B6 A8 8E A2 14 8B EA 2A 4A B5 A8 9E A2 34 8B EE 52 34 C8 A2 FA 8A D2 2D 6A A0 68 B0 45' + '0D 15 65 58 D4 48 D1 10 8B 1A 33 2A 17 C5 F5 CA 47 A1 C9 65 FF 09 C8 6F 6D 53 D2 4F A8 99 2F 85' + 'B1 DF DF E6 1C A6 DB DB A2 FC DF F2 9B 20 5A 92 BE 96 56 A4 FF AA 68 D2 7F 69 0C E9 4B 68 4D FA' + 'ED 6F 43 FA 8D 6F 4B FA 2D 8F 25 FD 66 B7 23 FD 36 B7 27 FD 06 77 20 FD D6 76 24 FD A6 76 22 FD' + '76 76 26 FD 46 76 21 FD 16 76 25 FD E6 75 23 FD 2C E3 48 BF 80 78 92 5F 4A 48 FA 4D EA 41 FA ED' + 'E9 49 FA A9 F7 22 FD 96 F4 26 FD 66 F4 21 FD 7A FA FA A5 31 2F FF A5 FD 38 0C BE AA A4 3F 87 29' + '56 FB 00 0D FD 3F 09 7E BF F4 6D 1A FE 6B 06 F2 17 E9 B6 1B C7 FA C3 92 03 6C 38 4E 43 FE 9D 1B' + '0D FD 2C D7 F0 B5 DD 6D 5F E1 8A 3F 9C 13 85 7E 51 28 C6 E1 29 FB CA 31 77 C5 4F E7 74 14 CA 90' + 'FD 72 71 07 99 9E 89 B2 E4 2B 29 B8 93 2F 0D BE 52 AD 1C 7F B4 2A 01 E5 C9 2A 19 A8 40 7E 71 37' + '2A 92 8D 32 50 89 3C 90 80 CA 64 AD 51 A8 42 D6 9E 84 AA E4 D6 91 A8 46 0E 48 46 75 9B 27 1B 35' + 'C8 D5 49 A8 49 3E 3C 12 B5 C8 EA C9 A8 4D C6 CD 43 1D B2 E6 34 D4 25 0F AF 42 3D F2 D7 C1 B8 8B' + '6C 97 8A FA 64 B9 89 68 40 6E CC 45 43 32 2D 0F 8D 48 FF 44 34 26 6F 4E 40 13 B2 EF 1A 34 25 BF' + 'CE 42 33 B2 59 02 9A 93 57 53 D0 82 2C 91 87 28 B2 70 35 5A 92 29 B9 68 45 2E 9A 85 68 72 F6 6C' + 'C4 90 25 53 D1 9A 5C 38 01 6D 6C FE 7C B4 B5 9F E7 23 96 8C 9E 86 76 E4 E4 64 B4 27 CF A4 A1 83' + 'D5 BD 16 5D AF 04 BB BE 69 3E 77 7D 37 45 7E 82 7E 14 A7 68 95 45 F1 8A EE CE 64 D4 5D D1 B9 42' + '46 3D 14 F9 09 FA 51 4F 45 DE 74 46 BD 14 7D 94 CC A8 B7 A2 F4 91 8C 12 FD 2C 4A 6C CE 46 12 F9' + '4B 0A 7E BD 11 3C 20 5E BE 11 3C 20 5E B9 11 3C 20 5E BD 11 3C 20 FE 76 23 78 40 FC FD 46 F0 80' + 'F8 C7 8D E0 01 F1 CF 1B C1 03 E2 B5 1B C1 03 E2 F5 1B 7A 40 BC E6 8A A1 53 02 8A 91 B1 09 70 64' + 'B7 04 84 C8 3A C5 DC 4D E4 F0 81 28 4E 1E 1F 88 30 79 61 20 4A 90 2E 11 25 C9 D9 89 B8 99 DC 9A' + '88 52 E4 37 89 28 4D BE 9E 88 5B C8 5D 31 B8 95 6C 1F 76 B7 91 03 92 70 3B 99 9A 84 32 E4 88 24' + 'DC 41 CE 48 42 59 B2 5A 71 77 27 79 2E 06 E5 C8 FC 24 94 27 FD 5D 57 81 EC 57 DC 55 24 37 27 A1' + '12 79 20 09 95 C9 57 12 50 85 3C 9A 84 AA E4 E9 24 54 23 3F 59 EB AA 93 BF 27 A1 06 19 4A 46 4D' + 'FB 79 0C 6A 91 1D FC DD 4B F6 4C 46 1D D2 DF 05 75 2D 9F 64 D4 23 CB B7 C6 5D E4 F3 C9 A8 4F BE' + '98 8C 06 E4 97 C9 68 48 FE 95 8C 46 64 F1 14 34 26 C3 29 68 42 56 4C 41 53 B2 4F 0A 9A 91 49 29' + '68 4E 0E F1 77 2F 39 25 05 51 E4 BC 14 B4 24 17 A4 A0 95 18 2D C6 90 4D 4B B9 D6 64 61 21 DA 90' + '2F A5 A0 AD E5 9F 82 58 32 AF B4 6B 47 FE 90 82 F6 E4 E5 14 74 B0 3C 52 D1 D1 FA 9F 8A 4E E6 37' + '15 9D C9 DE A9 E8 42 8E 4E 45 57 72 5F 2A BA 91 7F A4 22 8E 2C 93 86 78 32 25 0D DD 6D FE 34 F4' + '20 97 A4 A1 A7 D8 CB 7C A7 A1 37 79 24 0D 7D C8 53 69 E8 4B 5E 4C 43 3F B2 42 3A FA 5B 1E 83 30' + 'C0 FA 91 8E 04 EB C3 20 0C 24 A7 0E 42 22 E9 DF 3E 92 C8 9F 07 23 99 7C 2D 1D 29 E4 6F E9 48 25' + '6F 1D 8C 34 72 65 3A 06 91 AD 06 23 9D 6C 39 18 83 CD F7 60 64 98 8F 72 6E 08 79 65 30 32 C9 3F' + '07 63 A8 AD 9F 81 2C D2 BF FA 0D B3 7D 9D 81 6C 32 37 03 C3 C9 43 15 5C 0E F9 7D 05 97 4B FE 98' + '81 3C B2 EA 10 8C 20 1B 0C C1 48 F2 DD 0C 8C 22 47 0D 41 BE E5 DB 06 A3 C9 BF DB 60 0C 59 32 13' + '63 C9 CE 99 18 27 8E 27 5F A8 EC 0A C8 4B 99 98 60 F3 64 62 A2 9D 93 4C 14 92 57 33 31 89 AC 54' + 'D5 4D 26 FF CB C4 14 CB 7B 28 A6 9A 87 6C 4C B3 BC 87 62 3A B9 A8 2D 66 D8 B9 1C 8A 99 E4 84 A1' + '98 45 3E 35 14 B3 ED 9C 0C C5 1C EB 47 75 37 97 8C CF C2 3C F2 EB EA 6E BE BD 3E 0B 0B C8 71 59' + '58 48 CE CD C2 22 F2 B3 2C 2C 26 3F CF 42 11 D9 22 16 4B C8 7F B2 B0 94 6C 38 0C CB EC 7A 31 0C' + 'CB C9 31 C3 B0 C2 FA 18 8B BB C9 A2 DA EE 1E 9B 2F 16 2B C9 87 87 61 95 ED 8B 61 58 4D 9E 19 86' + '7B 6D FF 0E C3 7D E4 BA FD 6E 0D F9 EF 30 AC 35 9F 75 DD 3A 71 3D 59 6C 31 36 58 DD D9 D8 28 6E' + 'B2 73 18 8B CD E4 D9 56 6E 0B F9 7E 8E DB 6A 79 64 63 9B D5 95 8D ED E4 17 B1 D8 41 6E CB C6 4E' + 'F2 D5 6C EC 22 BD 6C EC 26 AF 67 63 8F F5 73 38 F6 DA F5 A9 1D F6 D9 F5 A7 1D F6 93 1B 86 E3 00' + 'F9 76 7D 77 BF AD 3B 1C 0F D8 F9 C9 C1 41 B2 7F 0E 0E 91 09 39 38 AC F8 41 BB 1E E6 E0 08 79 6F' + '0E 8E 92 27 73 70 CC AE 53 39 38 4E 3E 94 83 87 C8 8F 73 F0 B0 ED D7 1C 9C B0 F3 97 83 93 76 FE' + '72 71 CA F6 5F 2E 1E 21 B3 72 71 9A 3C 91 8B 33 96 4F 2E 1E 25 13 F3 70 96 BC A5 89 3B 67 5E F2' + '70 DE F6 63 2E 2E D8 F9 CE C3 63 E6 25 0F 8F DB 7E C8 C3 13 76 7D 68 E2 9E B4 7E 8E C0 53 E4 B3' + '79 78 9A 3C 9C 87 8B 64 F3 F6 B8 64 7E 47 E0 19 72 FE 08 3C 4B EE 1C 81 E7 EC BA 38 02 CF 93 E3' + 'DB E3 05 72 E0 48 BC 68 F1 48 BC 44 96 8A 72 2F 5B FF 47 E2 15 F2 DA 28 BC 6A D7 C1 51 78 8D AC' + 'DC 01 AF 93 6B 47 E1 0D 3B 37 1D F0 A6 E5 D7 1E 6F D9 BE 48 C2 FF C8 8D 49 78 9B 44 3E DE 21 77' + '8C 42 84 3C B6 10 1E F9 5E 3C DE B5 EB 4A 3E DE B3 7E E5 E3 7D B2 76 3E 3E 20 87 E5 E3 43 3B 3F' + 'F9 F8 C8 CE 5F B4 FB D8 F2 E8 80 4F EC BA 9D 8F 4F C9 A5 F9 F8 8C 4C 1E 8D CF 2D 1E 8D 2F C8 82' + '18 F7 A5 79 1C 8D AF C8 9A A3 F1 35 59 6E 0C BE B1 7E 74 C0 B7 64 DC 18 7C 47 EE 1F 83 EF ED 3A' + '32 06 3F D8 75 65 2C 7E B4 9F B7 71 3F 91 1F 8C C5 CF 76 CE 3B E2 17 CB 73 1C 7E 25 0F C6 BA CB' + '76 3F 1C 87 2B B6 9F 3A E2 AA DD 87 C6 E1 37 72 F7 38 FC 4E 9E 1F 87 3F EC FE 3B 0E 7F DA 39 6F' + 'EF AE 91 A5 AB BB EB 56 4F 7B F7 97 BD 7F 3C 6E 90 8F 75 74 7F 93 4F 8E C7 3F B6 FF C7 E3 5F BB' + '9F 8E C7 7F 76 7D 2E F0 1F 04 78 9D 2A 40 31 72 46 01 1C D9 AD 00 21 72 4C 01 6E 22 67 16 A0 38' + 'B9 B4 00 61 B2 46 27 57 82 8C 29 40 49 B2 C5 04 DC 4C 4E 98 80 52 64 74 27 94 26 5F 9E 80 5B C8' + 'E7 27 E0 56 F2 CD CE EE 36 F2 7A 01 6E B7 D7 4F 44 19 72 58 17 77 07 79 6F 17 57 96 7C 6E 22 EE' + '24 DB 15 A2 9C AD E7 3F 42 91 55 0B 51 81 DC D4 09 15 C9 BE 85 A8 44 CE 2B 44 65 CB BF 10 55 C8' + '63 85 A8 4A DE 55 DC 55 23 7B 4C 42 75 32 2F CE D5 20 77 4C 42 4D F2 48 BC AB 45 36 9C 8C DA 64' + 'EB C9 A8 43 26 4E 46 5D B2 64 4F 57 8F 5C 38 19 77 91 1B 27 A3 BE BD AE 97 6B 40 96 EB ED 1A 92' + 'B3 A7 A0 11 B9 72 0A 1A 93 47 3B A3 09 79 FF 14 34 25 CF 76 46 33 B1 39 D9 6B 2A 5A 90 43 A7 22' + '8A 9C 34 15 2D AD BF 53 D1 8A 7C 69 2A A2 AD DE 2E 88 21 EB 4D 43 6B B2 4D 7F D7 C6 7C 4D 43 5B' + '72 5D 7F 17 4B 16 FA 4F AF E4 EE DA AE 3D 59 66 3A 3A 90 7B 07 BA 8E B6 EE 40 D7 89 EC 9E E8 3A' + '93 7F 77 41 17 AB AF 2B BA 92 BF 4D 47 37 F2 6A A2 8B 23 AF 24 BA 78 B2 72 92 EB 6E 3E 93 5C 0F' + 'F3 30 03 3D C9 9A 33 D0 4B EC 6D 1E 66 A0 8F F9 EA 8A BE D6 87 19 E8 47 F6 EC 8A FE E6 AB 2B 06' + '90 D5 53 5D 02 99 30 13 03 C9 55 33 91 48 BE 32 13 49 E4 17 5D 91 4C D6 1F E4 52 C8 41 B3 90 4A' + '6E 1B E4 D2 C8 67 07 B9 41 E4 7D B3 90 4E FE 30 0B 83 6D FF 75 43 06 D9 75 36 86 58 3E B3 91 49' + '0E 9C 8D A1 E4 DC 0C 97 45 1E 1C E2 86 89 D9 E4 CF B3 31 9C 74 71 C8 B1 FD 90 E9 72 6D FF CD 41' + '1E F9 E2 1C 8C 20 1B C4 61 A4 ED 83 A1 6E 14 F9 D6 5C E4 93 7B E2 30 9A FC 76 2E C6 58 FE 73 31' + '96 04 BF A6 CB E7 B2 6C 37 DE F6 DD 3C 14 90 C5 E2 31 C1 CE C3 3C 4C B4 75 E7 A3 D0 F6 E7 7C 4C' + 'B2 F3 14 8F C9 B6 1F 73 DD 14 DB 27 B9 6E 2A 99 11 8F 69 E4 7B B9 6E BA ED B7 05 98 61 FB 20 CF' + 'CD B4 7D B9 00 B3 C8 BF 16 60 36 59 7C 21 E6 90 EF 8F 70 73 C9 BA 23 DD 3C 72 F8 42 CC 27 0F 8D' + '74 0B 6C DF 2C C4 42 32 3B DA 2D 22 DF 89 C7 62 F2 E4 42 14 91 A1 45 58 42 96 EE 8E A5 B6 DE 22' + '2C 23 4F 0F C1 72 EB 63 BE 5B 61 71 BE BB 9B 5C 1F ED EE B1 F3 15 ED 56 5E 0F EE DF AB C8 9B 16' + '63 35 B9 8B 5F D3 C5 FB 73 77 DC 47 AE 5D 8C 35 B6 5F 16 63 2D B9 73 31 D6 91 A7 92 B1 9E 3C E1' + 'DF FF 2D 5E 8C 8D E4 E3 8B B1 89 FC 7A 31 36 93 1D C7 B9 2D E4 57 8B B1 D5 F6 57 11 B6 59 BF 8B' + 'B0 DD AE 03 45 D8 61 F5 17 61 A7 BD BF 08 BB C8 6F 8A B0 9B 4C 5F 82 3D 64 4A 11 F6 DA B9 2B C2' + '3E DB 8F 45 D8 4F 7E 58 84 03 76 EE C6 BB FB 2D EF 02 F7 80 F5 69 BC 3B 48 36 E9 81 43 E4 E5 25' + '38 6C E7 67 09 1E 24 2B 2C C5 11 9B 6F 8A 3B 4A 8E 58 8A 63 64 D3 89 EE 38 99 D5 03 0F 91 39 3D' + 'F0 B0 D5 39 D1 9D B0 7D 55 E8 4E DA 3A 3D 70 CA AE 43 CB F0 88 5D 27 96 E1 34 99 BF 0C 67 EC BA' + 'BC 0C 8F 92 87 97 E1 2C B9 62 19 CE 91 B7 2D C7 79 F2 F3 65 B8 40 CE 5A 8E C7 6C 3F 2D C7 E3 36' + 'EF 72 3C 61 FB 72 39 9E 24 BD 1E 78 8A FC 6C 39 9E 36 5F 2B 70 D1 AE CF 3D 70 C9 F6 CB 0A 3C 63' + 'FD 5C 81 67 6D FD E9 EE 39 7B DF 0A 3C 4F 7E BC 02 2F D8 F5 B0 27 5E B4 FD B7 02 2F 91 17 62 F0' + '32 79 7C A6 7B 85 1C 35 CB BD 4A 3E D1 13 AF D9 FE EF 89 D7 ED FC DC 83 37 C8 9F EE C1 9B E4 3D' + '2B F1 16 99 B6 0A FF B3 7D 3A D7 BD 6D E7 72 15 DE 21 9F 5E 85 88 5D 17 57 C3 B3 EB FD 6A BC 6B' + 'E7 7F 81 7B CF F6 59 49 F7 BE DD 77 56 E3 03 F2 B1 D5 F8 90 FC 75 35 3E B2 7C 4B BA 8F C9 B7 EF' + 'C5 27 64 EC 7D F8 D4 FA BE D4 7D 66 79 2C 75 9F 93 1B D6 E0 0B F3 BA 06 5F 92 77 AC C5 57 64 F3' + 'E5 EE 6B 5B 7F 2D BE B1 F7 AF C3 B7 D6 8F 75 F8 8E 7C 77 1D BE B7 EB CD 3A FC 60 7D 5C 8F 1F C9' + 'F2 1B F0 93 F5 67 A5 FB D9 F6 FB 46 FC 62 E7 B6 0F 7E 25 1F DD 88 CB 41 3D EE 8A ED EF 3E B8 4A' + '5E DA 84 DF EC 3C 66 E1 77 DB C7 9B F1 87 5D 2F D6 BA 3F C9 2A EB DC 35 BB 8F F6 C5 75 72 7A 5F' + 'FC 45 7E BA 19 37 C8 52 1B DC DF F6 FE BE F8 C7 AE C3 1B DC BF 76 9E B7 E0 3F 11 7F F9 6C B4 05' + 'C5 C8 33 1B 9D 23 3F DF 82 10 19 DD 0F 37 D9 EF B7 A2 38 79 70 2B C2 E4 C5 AD 28 41 FE BB 15 25' + 'C9 D7 FA E1 66 32 6A BB 2B 45 96 DD 8E D2 64 D7 1D B8 85 FC 67 07 6E B5 D7 F5 C7 6D E4 4F FD 71' + '3B 99 BF 13 65 EC E7 7B DC 1D E4 B5 FE 28 4B 16 DF EB EE 24 6F DB E7 CA 91 6B F7 B9 F2 E4 85 5D' + 'A8 40 0E 1A 80 8A E4 F5 5D A8 64 79 EC 42 65 7B DF 6E 54 21 6F DF 8D AA 64 85 DD A8 46 76 D8 8D' + 'EA 24 1E 70 FF 07 1C 47 E8 49' +} + + +LANGUAGE 0,0 COMBINING UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE +{ + '78 DA 1D D5 59 70 14 65 14 05 E0 73 E7 4F 77 FF 09 C9 74 C2 84 24 D3 33 AD 8D 20 88 10 1C 25 04' + '12 82 94 18 C2 3A 88 80 A0 22 E0 52 4A 09 28 2E C8 03 6A A1 B8 95 5A 3E 68 95 5A A8 A5 A5 0F 91' + '0C 2E C8 22 5B 94 80 3B 1A A5 01 51 11 75 08 10 92 00 45 02 88 20 12 FC EF AD FA 5E CF 7D 3A 75' + '2E F5 A8 50 18 AE B0 27 C9 5A 92 68 4B 62 57 80 DD 01 7E 0D B0 2F C0 E1 00 AD 01 3A 02 1C 0D 50' + '95 47 46 E7 7C 3A 3D 9F DE 6E 64 F3 42 BA 37 24 9B 3A 17 51 D7 22 72 E2 35 B9 30 1A 45 4D 1E 6B' + '14 35 3D 58 63 3E 1B 56 C8 2A 12 AC 55 0C 4B B2 B5 0D 6C 73 21 19 0F 17 B1 1D A2 B2 27 6B 17 23' + '62 54 13 A3 BA 62 F6 85 68 EA C5 36 94 B0 EA 32 76 7D 9C 8D F6 D9 84 76 A6 69 45 0A 6F A4 90 5B' + '99 CE 85 D1 2C D2 79 AC 59 A4 7B B0 66 91 CE 67 CD 62 44 01 6A 0A 90 16 3B 44 75 94 6D 16 4F BB' + 'AC AA 10 D5 85 28 2E 65 15 62 97 B8 DD 63 B5 09 96 49 60 55 02 27 13 38 95 C0 B2 72 66 AF 64 83' + 'C4 97 62 5A 03 6B 12 67 32 EC F8 2A 36 2A 8F 8C BA 42 B6 4C 6C 12 43 8A A8 A2 88 9A C4 D0 9E AC' + '43 A4 63 6C 74 31 DB 2E B6 F6 62 A3 4A D8 A7 62 60 29 AB 2A 63 23 E3 74 6D 9C B2 A2 C2 63 63 C5' + '0A 31 2A C9 6A 7D 1A E3 D3 EB 22 8F 56 5B 30 7A D0 27 16 8C 7C 5A 63 C1 28 A0 B5 16 8C 28 AD B3' + '60 B8 B4 DE 82 51 48 9F 5A 30 8A 68 83 05 A3 67 64 A3 05 E3 1B 11 A3 4D 16 36 5B 28 A6 2D 16 8C' + '5E D4 68 C1 28 A1 CF 2C 18 A5 B4 D5 82 51 46 DB 2C 18 71 DA 6E C1 F0 E8 92 F3 30 12 91 89 36 8C' + '4E CD 92 91 49 36 8C 2E CD FC 48 DA 86 71 52 B3 4B 22 65 36 8C C9 E2 D2 48 DC 86 71 83 08 22 9E' + '0D 63 8A E8 4D 37 DA 30 2E A3 A9 36 8C 3E F4 80 0D A3 2F 15 39 30 A6 D3 4D F9 30 66 D1 8C 7C 18' + 'F3 68 78 14 55 51 2C A0 71 51 4C 8C 62 09 6D 8C 62 53 14 4B E9 DB 28 BE 8F E2 49 7A D0 85 B1 5C' + '3D E4 C2 58 EA E2 71 17 4F 88 A7 69 B1 0B 63 87 EA AD 70 99 42 7F 85 2B 14 76 FA 6C 2F FD E8 C3' + 'F8 35 27 A1 60 54 B9 EC EE 90 EE 09 E9 FE 90 1E 0A 69 1F 5D 99 82 B1 7F 72 89 42 5C 21 A9 10 28' + 'F4 51 E8 A7 30 40 61 88 C9 28 D4 28 8C 55 18 AF 90 56 98 AC 30 4D 61 86 C2 2D 0A B7 2A BC 6C B1' + 'D7 C4 9B E2 3D 0B EF 5B C8 88 AF C4 4D 36 66 D8 B8 4D CC 15 07 45 87 38 2E AE 76 58 85 18 E6 A0' + 'CA C1 08 07 35 0E AE 15 A3 45 AD A8 13 E3 C4 49 71 41 DC A2 31 4B 63 B7 38 28 5A 45 BB 38 AE 71' + '42 E3 8C 38 A7 F1 AF C6 D4 5C 56 E6 22 EE 62 A8 18 26 BE 16 2F 15 B2 11 71 56 E6 B1 65 62 BD 87' + 'CD 1E 3E 13 5B 3D 34 79 58 98 60 3F 27 F1 5B 12 FB 93 F8 2B 89 E3 62 BB CF 76 88 9F C4 39 71 41' + '5C 14 6D 01 3B 16 E0 44 80 81 0D 28 6F C0 BA 0C EB DF 8D F2 6E 5C 20 32 B2 11 56 90 C7 AA 45 AB' + 'A8 73 69 AC 4B 13 45 DA A5 29 2E 3D 1A D2 F2 90 5E 08 E9 C5 90 76 B6 D1 DE 36 FA 33 E7 0D 0B C6' + '87 A2 2A CE CA 53 2C 4B 83 53 B8 2A 85 16 BA 2F 64 87 72 3E B2 60 34 94 B1 7F 7C 9C F5 31 30 C5' + '5A 97 40 A1 58 61 A4 42 AD 42 9D 98 A0 30 49 61 8A C2 54 85 99 62 96 B8 4B 61 91 C2 53 39 78 2E' + '07 AF 58 78 D5 C2 EB 16 56 58 78 CB C2 BB 16 56 9A F3 16 56 59 F8 C0 C2 C7 E2 4B 51 68 A3 D4 C6' + '34 1B D3 6D CC B4 31 CB C6 6C 1B 73 6C EC B5 B1 DF C6 5F 36 5A 6C 1C 12 47 6C B4 D9 38 6A E3 98' + '8D 94 C3 AE 71 30 C4 C1 50 07 95 0E AA C5 48 31 CA C1 75 0E AE 17 63 C4 58 31 DE C1 04 07 47 1D' + '74 39 38 25 4A 34 E2 1A 09 8D 3E 1A 97 6B F4 D7 18 A0 51 AE B1 47 E3 80 C6 21 8D C3 1A 47 34 DA' + '34 3A 34 8E 69 9C D2 F8 5B E3 1F 8D B3 1A E7 35 2E 6A DC 98 CB A6 E5 62 7A 2E BA C5 72 17 4F B9' + '78 D6 C5 73 2E 66 C7 30 37 86 3F 4A 59 75 9C 95 7A EC 11 0F 8F 79 58 ED 61 9D 87 2D 1E 1A 3D 2C' + '48 B0 FB 12 78 38 81 9D E6 89 26 B1 2F 89 DF 93 C8 8A D3 E2 6C 12 E7 92 68 F2 B1 CD C7 17 3E BE' + 'F3 F1 BD 8F 1F 7C 84 3E FE F6 71 5E 74 8B 9D 01 C2 00 7B 02 FC 12 E0 F7 00 FB 03 1C 10 47 44 BB' + 'E8 14 27 06 A1 6B 10 B2 E5 B8 58 8E 45 F5 6C 71 3D 1E AF C7 DB F5 78 A7 1E 9D F5 E8 AA 47 76 25' + 'BA 56 62 75 86 AD C9 60 6D 06 1B 32 D8 98 C1 E7 19 6C CD 60 9B 08 BA D1 AF 1B 83 BB 71 55 37 96' + '28 5A AA C8 CD 63 C3 C5 61 D1 B7 80 FA 17 D0 AA 28 7D 10 A5 71 2E 4D 70 69 92 30 E3 1E 29 A2 7B' + '62 B4 30 46 0F C4 68 71 8C E6 14 B3 D4 02 AA 5C 40 CF 84 F4 7C 48 99 90 3E 0C 69 F4 2E AA DD 45' + 'A6 C0 76 96 74 96 CA B2 94 C8 52 EF 2C F5 C9 52 DF 2C F5 CB D2 95 59 4A 1D A0 CA 03 74 AC 85 4E' + 'B4 50 6D 3B 8D 6F A7 36 AB 97 82 E1 89 9B C5 19 9F 0D 4A B1 F6 9C DB 14 8C B9 E2 4E F1 9F CF 3A' + 'D4 6C 85 39 0A B7 2B DC A1 D0 EC B3 4E 1A A3 60 FC 0F E7 99 FD 83' +} + + +LANGUAGE 0,0 NUMBERS UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE +{ + '78 DA 5D 97 07 78 54 D7 B5 EF D7 FF 4C 3D 1A 4D D3 60 69 04 C2 D2 98 91 44 35 62 70 C1 0D 03 EE' + '9D DE 7B 11 20 81 E8 BD 18 6C D3 5C B1 71 CB AD A9 44 C0 4D F2 E2 E4 DE 9B DC 9B DC EB C4 71 4B' + 'B5 25 6C EC DC 66 70 41 82 19 40 34 83 B1 CD FB C5 3A 7E 8F F7 F4 7D FB 5B 73 F6 FA ED FF 5E 7B' + 'CF 9A B5 8E 9E 33 FE 74 C9 70 3C EB F3 AC DF B3 01 CF 06 3D 1B F2 6C D8 B3 EE 25 1A FE 4B B4 7C' + '97 3C 27 2E 59 E3 F3 9E BF 9E 2B F2 EC 6C CF B6 F9 FE AF DE 37 3D DB D3 5B 37 DC 7B EE 72 C9 5A' + 'DF 25 CF 01 EF D9 F1 3E 3B 5E BC 8E 17 E7 5F 6C C4 B3 51 CF C6 3D 9B F4 EC 45 FE 9C 4B 34 2F BF' + '24 86 BF D8 9C 67 6F F4 EC ED 9E FD 3A B6 89 5F 9F B9 B6 D3 26 BD E7 12 CF A6 2E B9 AF D0 FF 77' + '87 BE 4B EE CE B9 E4 3C 01 EF 2E 2F FD 2E 02 9E F5 79 F7 1A F0 6C C8 B3 11 8F 2D F6 EC 69 75 DA' + 'ED 29 2F DE 57 BC 3B DE AA AF 6C D4 E3 62 9E 8D 7B F6 32 CF 96 7A B6 CC B3 69 CF 96 7B B6 AB 67' + 'BB 79 B6 C2 B3 DD 3D 5B E9 D9 2A CF 66 3C 7B 85 67 7B 78 36 EB D9 6A CF D6 78 B6 D6 B3 BD 3C DB' + 'DB B3 7D 3C DB D7 B3 FD 3C 7B A5 67 FB 7B B6 CE B3 03 3C FB C6 D7 EB BC 7B D9 E9 D9 F1 4E A7 FD' + '85 67 AB BC 7C 7C C4 B3 6F 85 3A ED CF 22 DE FD C5 3B ED E2 32 6F 7D B7 4E 3B A4 D2 CB 9B 1E 9E' + 'CE FD 5E 1C 2B 3C FF DF 74 DA E9 47 BC F5 C9 CE EF 61 D3 A0 4E BB 73 5A A7 8D 78 DF E1 90 A8 EF' + 'AB E7 0F 76 F9 3B B9 AE C1 4E DD 6F 85 BE B2 2F D7 BA 9D 7A 3F 2C FA CA DA D5 C5 9D F1 FD 6B F4' + 'FF E4 5B B1 97 57 C5 5E DE 14 7B 79 55 EC E5 4F B1 97 53 C5 5E 1E 15 7B B9 54 EC E5 68 B1 F7 9B' + 'FB 3A A7 86 E8 FF CD FD 21 97 7C C7 3E EF F9 E5 7B 3A E3 DE F4 42 67 BC 43 86 C5 3B E3 3B 78 26' + 'F0 95 FD 28 32 FA 2B 9B F8 DE FE AF B8 E7 5F EC F4 F7 1B A0 BF D8 2F 82 9D DF 1D DF 9B F8 ED 39' + '03 91 BE 8A B0 AF 26 E4 6B 08 F7 5A 42 1D 44 98 D7 11 E2 4B F8 7F 82 FF E7 B0 BF 20 D4 5F 72 7D' + 'FF 46 B8 D3 D1 98 C1 F6 33 83 E6 CC 0A 9A 6F 76 D0 FC 73 82 16 A8 0F 5A 70 6E D0 42 F3 82 16 9E' + '1F 34 F7 04 5C 07 DC 49 B8 53 70 A7 E1 CE C0 9D 85 FB 14 EE 1C DC 79 B8 97 B9 9C 5F 71 ED BF 0E' + '99 F3 4A C8 7C BF 09 99 FF D5 90 05 5E 0B 59 F0 F5 90 85 DE 08 59 F8 CD 90 B9 F5 5C DA 5C BE 96' + '79 AE 39 F3 5D F3 35 B8 E6 6F 74 2D B0 C0 B5 E0 42 D7 42 4D AE 85 17 B9 E6 7E 02 77 18 AE 0D AE' + '1D EE 08 DC 51 B8 3C 5C 01 EE 18 DC 71 B8 D3 AE 45 CF B8 16 3B EB 5A FC 53 D7 8A CE B9 56 7C DE' + 'B5 44 3D 5F CA 5C BE F6 79 45 EC 53 C4 3E 45 EC 53 C4 3E 45 EC 53 C4 3E 45 EC 53 C4 3E 70 87 E1' + 'DA E0 DA E1 8E C0 1D 85 CB C3 15 E0 8E C1 1D 87 AB 27 E9 E6 46 D0 8B A0 17 41 2F 82 5E 04 BD 08' + '7A 11 F4 22 E8 45 CC 5D 1A B1 A2 65 11 8B 2C 8F 58 F1 8A 88 45 57 46 2C B6 2A 62 F1 4F 58 7F 98' + 'F5 6D AC 6F 67 FD 11 D6 1F 65 7D 9E F5 05 D6 1F 63 FD 71 D6 9F 88 58 B2 23 62 25 27 23 96 AA 27' + 'A9 E6 92 B2 F3 8A D9 B3 98 3D 8B D9 B3 98 3D 8B D9 B3 98 3D 8B D9 B3 D8 DC D5 70 6B E0 D6 C2 AD' + '83 5B CF E7 0D 7C DE C8 E7 4F F0 1D E6 B9 8D E7 76 9E 8F A0 71 14 8D 3C 1A 05 34 8E A1 71 1C 8D' + 'F1 51 EB 32 21 6A 97 4D 8C 5A E9 A4 A8 95 4D 8E 5A 7A 4A D4 CA A7 46 AD 6B 3D 85 70 2E 3F 99 79' + '51 E2 88 12 47 94 38 A2 C4 11 25 8E 28 71 44 89 23 6A EE E2 A8 25 97 44 AD 64 69 D4 52 CB A2 56' + 'B4 3C 6A 91 15 51 2B 5E 19 B5 E8 AA A8 C5 56 47 B9 07 B4 0E A3 D5 86 56 3B 5A 47 D0 3A 8A 56 1E' + 'AD 02 5A C7 D0 3A 8E D6 70 8A EE 88 98 69 64 CC 9C 51 31 F3 8D 8E 99 7F 4C CC 02 63 63 16 1C 17' + 'B3 D0 F8 98 85 27 C4 CC 7D 0B EE 6D B8 16 B8 56 B8 FD 70 EF C0 BD 0B 77 00 EE 3D B8 F7 E1 AA A8' + '49 19 7E 66 57 C4 CD E9 11 37 5F 36 6E FE EA B8 05 6A E2 16 AC 8D 5B A8 67 DC C2 BD E2 E6 F6 8E' + '5B A4 4F DC BA F5 8D 5B 45 BF B8 75 BF 32 6E 97 F7 8F 5B 65 5D DC AA 06 C4 2D 93 8B DB 15 03 E3' + 'D6 63 08 CD 7A 68 C2 34 2C 61 CE 2D 09 F3 DD 9A 30 FF 6D 09 0B DC 9E B0 E0 1D 09 0B DD 99 B0 F0' + '5D 09 73 77 C2 3D 0D F7 0C DC 2E B8 67 E1 9E 83 7B 1E EE 05 B8 17 E1 BE 01 37 3F 65 6A 48 99 D3' + '98 32 DF 82 94 F9 17 A6 2C D0 94 B2 E0 A2 94 85 16 A7 2C BC 24 45 6E A5 2C B9 2C 65 D9 E5 29 AB' + '5E 91 B2 9A 95 29 AB 5D 95 B2 9E AB 53 D6 6B 4D CA 7A AF 4D 59 9F 75 29 2B 59 9F B2 BE C7 4A AD' + 'DF F1 52 BB F2 44 A9 F5 FF 80 3A 7C B0 CC 74 A8 CC 9C 0F CB CC F7 51 99 F9 3F 2E B3 C0 27 65 16' + '3C 5C 66 A1 B6 32 0B B7 97 91 7B 70 1D 70 27 E1 4E C1 9D 86 3B 03 77 16 EE 53 B8 73 70 E7 E1 12' + '34 BA 64 DA 54 92 36 27 95 36 5F 97 B4 F9 2F 4B 5B A0 34 6D C1 B2 B4 85 D2 69 0B 97 A7 CD BD 9D' + '46 78 47 B9 E9 CE 72 73 EE 2A 37 DF DD E5 E6 BF A7 DC 02 F7 96 5B F0 BE 72 0B DD 5F 6E E1 07 CA' + 'F9 0E E1 DE 86 6B 81 6B 85 DB 0F F7 0E DC BB 70 07 E0 DE 83 7B 1F EE CF 30 9B 68 AA 9B BB 9A 1E' + 'EA 6A CE C3 5D CD F7 48 57 F3 6F E9 6A 81 AD 5D 2D B8 AD AB 85 B6 77 B5 F0 8E AE DC 3B DC D3 70' + 'CF C0 ED 82 7B 16 EE 39 B8 E7 E1 5E 80 7B 11 EE 1B 70 C3 E9 4D 23 BA 91 67 DD C8 B3 6E E4 59 37' + 'F2 AC 1B 79 D6 8D 3C EB 46 9E 75 23 CF BA 99 FB BF E0 7E 0C F7 12 DC 4F E0 7E 0A F7 8F 70 FF 04' + 'F7 CF 70 3F 83 FB 39 DC 10 9A FC D0 0A F2 A2 82 BC A8 20 2F 2A C8 8B 0A F2 A2 82 BC A8 20 2F 2A' + 'C8 8B 0A F6 85 1B 01 37 12 6E 14 DC 68 B8 31 70 63 E1 C6 C1 8D 87 9B 00 B7 98 C6 B1 BC CA FC 2B' + 'AA 2C B0 B2 CA 82 AB AA 2C B4 BA CA C2 6B AA CC DD 84 6F 73 15 77 51 C5 5D 54 71 17 70 5B E0 B6' + 'C2 6D 83 DB 0E B7 03 6E 78 C6 EA 46 64 6C C0 C8 8C A5 47 65 2C 37 3A 63 03 C7 64 AC EB D8 8C 5D' + '35 2E 63 57 8F CF D8 35 13 32 76 ED C4 8C 0D 9A 94 B1 D8 E4 8C 5D 37 25 63 D7 4F CD D8 0D D3 32' + 'A6 E9 8C 19 19 73 66 66 CC 37 2B 63 FE D9 19 0B CC C9 58 B0 3E 63 A1 B9 19 0B CF CB 90 BF 19 4B' + '36 64 EC C6 C6 8C DD B4 20 63 B5 0B 33 56 D2 94 B1 C1 8B 32 96 5A CC FA 25 AC 5F CA FA 65 AC 5F' + 'CE FA 15 AC 5F C9 FA 55 AC 5F CD FA 35 AC 5F CB FA 75 AC 5F CF FA 0D AC DF C8 FA 07 59 BF 89 B1' + '39 63 37 3F 94 B1 BE 5B 58 B7 15 FF B6 8C 0D D9 9E B1 A1 3B 78 69 9A 9E 25 BE 2C F1 65 89 2F 4B' + '7C 59 E2 CB 12 5F 96 F8 B2 C4 97 25 BE 2C F1 65 89 2F 4B 7C 59 1B B6 30 6B B7 34 65 ED D6 45 59' + '4B 2C CE 5A BF 25 59 BB 72 69 D6 FA 2F CB F2 FB 42 6F 05 7A 2B D1 5B 85 DE 6A F4 D6 A0 B7 16 BD' + '75 E8 AD 47 6F 03 7A 1B D1 7B 10 BD 4D E8 6D 46 EF 21 F4 1E 46 EF 11 F4 B6 A0 B7 15 BD 6D E8 6D' + '47 6F 07 7A 8F A2 F7 18 7A 8F A3 F7 04 7A 4F A2 F7 14 7A 3B D1 7B 1A BD 67 D0 DB 85 DE B3 E8 3D' + '87 DE F3 E8 BD 80 DE 8B E8 7D 03 BD BF 42 EF AF D1 3B C2 0B E1 51 D8 3C 6C 01 F6 18 EC 71 D8 13' + 'B0 1D B0 27 61 4F C1 9E 86 3D C3 DE 67 D9 FB 53 F6 3E C7 DE E7 D9 FB 33 F6 BE C0 DE 9F B3 F7 17' + 'EC FD 25 7B 5F 44 73 65 AD 69 55 AD 39 AB 6B CD B7 A6 D6 FC 6B 6B 2D B0 AE D6 82 EB 6B 2D B4 A1' + 'D6 C2 1B 6B CD 7D B0 D6 92 9B E0 36 C3 3D 04 F7 30 DC 23 70 5B E0 B6 C2 6D 83 DB 0E B7 03 EE 51' + 'B8 C7 E0 1E 87 7B 02 EE 49 B8 A7 E0 76 C2 3D 0D F7 0C DC 2E B8 2F FA 5A 24 C4 0B 4D A6 8E FA 5C' + '47 7D AE A3 3E D7 51 9F EB A8 CF 75 D4 E7 3A EA 73 1D F5 B9 CE DC 41 75 96 BC AE CE B2 D7 D7 59' + 'F5 33 03 4C BB 06 98 F3 EC 00 F3 3D 37 C0 FC 55 39 53 26 67 CE 15 39 F3 F5 C8 99 3F 9B B3 40 75' + 'CE 82 35 39 0B D5 E6 2C DC 33 67 6E AF 9C 25 EF 64 DC 95 B3 EC DD 39 AB BE 27 67 35 F7 E6 AC F6' + 'BE 9C F5 BC 3F 67 BD 1E C8 59 EF 11 39 BB 6D 64 CE 6E 1F 95 B3 3B 46 E7 EC CE 31 39 BB 6B 6C CE' + 'EE 1E 97 B3 7B C6 E7 EC DE 09 39 BB 6F 22 6B 27 E5 EC FE C9 39 7B 60 4A CE 86 4F CD D9 88 69 39' + '1B B9 89 18 36 13 C3 43 C4 F0 30 31 3C 42 0C 5B 88 61 2B 31 6C 23 86 ED C4 B0 83 FD 7F 9C B3 51' + '2F E5 6C F4 4F 72 36 E6 A7 39 1B FB 8F C4 F1 4F 39 1B F7 CF 39 1B FF B3 9C 4D F8 79 CE 26 FE 4B' + 'CE 26 FD 6B CE 26 FF 22 67 53 7E 99 B3 A9 FF 96 B3 69 FF 4E AC 55 BB B9 AB DD DC D5 6E EE 6A 37' + '77 B5 9B BB DA CD 5D ED E6 AE 76 73 57 BB B9 AB DD BC DB C0 1C 86 69 83 69 87 39 02 73 14 26 0F' + '53 80 39 06 73 1C AD BA 66 2B 1A D0 6C 91 5C B3 15 0F 6C B6 E8 55 CD 16 BB BA D9 E2 6F 35 53 97' + '9B A9 CB CD D4 E5 66 EA 72 33 75 B9 99 BA DC 4C 5D 6E A6 2E 37 53 97 9B 79 0D DE C3 CB E5 1E 93' + 'B3 C7 1C DF 1E F3 F9 F7 98 3F B0 C7 02 C1 3D 16 0C ED B1 50 78 8F 85 DD 3D D4 79 B8 B7 E1 5A E0' + '5A E1 F6 C3 BD 03 F7 2E DC 01 B8 F7 E0 DE 87 3B 01 D7 01 77 12 EE 14 DC 69 B8 33 70 67 E1 3E 85' + '3B 07 77 1E 6E F8 5E 6A E8 5E 6A E8 5E 6A E8 5E 6A E8 5E 6A E8 5E 6A E8 5E 6A E8 5E 6A E8 5E 6A' + 'E8 5E F4 F6 A1 B7 0F BD 7D E8 ED 43 6F 1F 7A FB D0 DB 87 DE 3E F4 F6 A1 B7 CF DC C6 F3 D4 A7 F3' + '96 5C 7D DE 9C 97 CE 13 EB 79 0B B6 32 BE 60 2E 71 91 9E 77 91 9E 77 91 9E 77 91 9E 77 91 9E 77' + '91 9E 77 91 9E 77 91 9E 77 91 9E 77 D1 DC 90 A4 B0 E4 B8 92 AF 48 F2 47 A4 40 B1 14 8C 4A A1 18' + 'AE B8 E4 26 A4 64 52 CA 96 48 D5 29 A9 A6 8B 54 7B 99 D4 B3 54 EA 55 26 F5 4E 4B 7D CA A5 92 AE' + 'D2 F4 6E D2 8C 0A 69 66 77 69 F0 E5 D2 AC 4A 69 76 95 34 27 23 D5 5F 21 A5 7A 48 73 B3 D2 BC 6A' + '69 7E 8D 74 73 AD D4 D0 53 6A EC 25 2D E8 2D 2D EC 23 F5 ED 2B 35 F5 93 16 5D 29 2D EE 2F 0D A9' + '93 96 F0 9F C4 D2 9C B4 6C A0 B4 7C 88 54 34 54 8A 0C 23 F6 5B 88 F7 56 E2 B9 8D FD 6E 47 EF 0E' + 'F8 3B 99 BB 8B 98 EF 66 FE 1E E2 BA 17 DF 7D EC 7D 3F FE 07 F0 0D C7 37 02 DF 48 7C A3 F0 8D C6' + '37 86 7D C7 B2 76 1C BE F1 E8 4E 60 4C 64 4C E2 6E 26 33 A6 30 A6 32 A6 B1 7E 3A CC 0C C6 4C C6' + '2C C6 6C C6 1C EE A6 1E CD B9 8C 79 8C F9 8C 06 F4 1B B9 8F 05 EC B1 90 D1 C4 58 C4 58 CC 58 C2' + '9E 4B 89 67 19 7A CB 61 57 70 9E 95 8C 55 D2 C0 D5 52 F1 A3 FC E7 F4 18 E7 3C E8 48 87 1C 39 1F' + '3A F2 7D E4 C8 FF B1 A3 C0 27 8E 82 87 1D 85 DA 1C 85 DB 1D B9 47 1C 25 8F 3A CA E6 1D 55 17 1C' + 'D5 1C 73 54 7B DC 51 CF 13 8E 7A 75 38 EA 7D D2 51 9F 53 8E 4A 4E 3B 9A 7E C6 D1 8C B3 8E 66 7E' + 'EA 68 F0 39 47 B3 CE 3B 9A FD 99 A3 39 17 1C D5 57 F9 A4 8C 4F 81 2B 7C 4A F6 F0 A9 76 A8 4F 7D' + 'EE F6 A9 FE 6D E6 5B 7C 72 5A 99 DF EF 53 F6 1D 9F 4A BE E9 97 7D CB 2F 7D DB 2F E7 3B 7E F9 BE' + 'EB 97 FF 7B 7E 05 76 FB 15 FC BE 5F A1 66 BF C2 7B FC 72 C7 93 5C 13 C2 72 26 86 E5 9B 14 56 72' + '72 58 D9 29 61 95 4C 0D 2B 35 2D AC BE 6B F0 AF C5 BF 0E FF FA B0 FC 1B C2 0A 6C 84 7B 10 EE FB' + 'F8 9A F1 ED C1 B7 17 DF 3E C6 3F E0 FF 01 FE 1F E2 FF 11 3A 17 60 3E 67 EE 0B E6 BE 64 EE 22 73' + 'A5 24 73 99 AB 64 DA 55 B6 DC 25 2F 5D 39 DD 5C F9 7E E1 6A C5 2F 5D 45 5E C6 FF 2B E6 7E CD DC' + '2B AE FC BF 71 15 78 D5 55 F0 35 57 A1 D7 5D 85 DF 70 E5 BE C9 FA DF B2 FE 77 AE AA 7F EF AA E6' + '0F AE 6A FF E8 AA E7 9F 5C F5 6A 41 B3 D5 D5 F4 FD AE 66 BC E3 6A E6 BB AE 06 1F 70 35 EB 3D 57' + 'B3 DF 77 35 E7 CF AE EA FF C3 55 EA 3F 5D CD FD 2F 57 F3 FE DB D5 FC FF 71 75 F3 07 AE 1A 0E BA' + '6A 3C E4 6A C1 87 AE 16 7E E4 AA EF C7 AE 9A 3E 71 B5 E8 B0 AB C5 6D AE 86 B4 BB 5A 72 C4 D5 D2' + 'A3 AE 96 E5 5D 2D 2F B8 1A 7A CC D5 CA E3 AE 56 9D 70 B5 BA C3 D5 9A 93 AE D6 9E 72 B5 EE B4 AB' + 'F5 67 5C 6D 38 EB 6A E3 A7 AE 1E 3C E7 6A D3 79 57 9B 3F 73 F5 D0 05 57 0F 7F EE EA 91 2F 5C 6D' + 'F9 D2 D5 D6 8B AE B6 0D E1 07 3E B4 48 CE B0 22 F9 6E 29 92 FF D6 22 25 6F 2B 52 F6 F6 22 95 DC' + '51 A4 D4 9D 45 8A 6C 80 D9 58 A4 DA BF C5 FE 1D FE BF C7 7F 94 CF F9 22 05 0A 3C 1F E3 F9 38 FC' + '78 0A C5 84 08 DF 6B 84 EF 35 22 FF E4 88 92 53 22 CA 4E 8D A8 64 5A 44 A9 D5 F8 D7 E0 5F 8B 7F' + '1D FE F5 F8 37 E0 DF 88 FF 41 FC 7B F0 EF C5 BF 0F FF 3F E0 FF 01 FE 1F E2 FF 11 FE CF 28 40 17' + '8A 15 F8 BC 58 C9 2F 8A 55 FB 65 31 65 AC 58 A9 BA A8 6C 00 85 29 17 95 33 30 2A DF 55 51 F9 AF' + '8E 2A 70 4D 54 C1 6B A3 0A 0D 8A 2A 7C 5D 54 EE 74 0A D7 8C 98 9C 99 31 F9 66 C5 E4 9F 1D 53 60' + '4E 4C C1 FA 98 42 73 63 0A CF 8B C9 9D 1F 53 B2 21 A6 6C 63 4C D5 0B 62 AA 59 18 53 6D 53 4C 3D' + '17 C5 D4 6B 71 4C BD 97 C4 D4 67 69 4C 25 CB 62 9A BE 3C A6 19 2B 62 9A B9 32 A6 C1 AB 62 9A B5' + '3A A6 D9 6B 62 9A B3 36 A6 FA 75 31 45 D6 C7 54 B4 21 A6 DC C6 98 06 76 A7 60 5E 1E 97 53 19 97' + 'AF 2A 2E 7F 26 CE EF 29 CE EF 29 AE 6C 36 AE EA EA B8 4A 6A E2 8A 8C 80 1B C9 FC 28 E6 47 33 F7' + '2A CF AF B1 EE 75 D6 BD C1 BA 37 F1 FD 16 DF EF F0 8D A4 00 8F 4A C8 19 9D 90 6F 4C 42 FE B1 09' + '05 C6 25 14 1C 9F 50 68 42 42 E1 89 09 B9 93 12 FC B6 12 FC B6 12 AA 9E 9A 50 CD B4 84 6A A7 27' + 'D4 73 46 42 BD 66 26 D4 7B 56 42 7D 66 27 54 32 27 A1 54 7D 42 36 17 CD 79 68 CE 47 B3 01 CD 46' + '34 17 A0 B9 10 CD 26 34 17 A1 79 02 AE 03 EE 24 DC 29 B8 D3 70 67 E0 CE C2 7D 0A 77 0E EE 3C DC' + '35 49 D9 B5 34 88 41 49 39 D7 25 E5 BB 3E 29 FF 0D 49 05 6E 4C 2A 78 53 52 A1 C1 49 85 6F 4E CA' + '7D 0B EE 6D B8 16 B8 56 B8 FD 70 EF C0 BD 0B 77 00 EE 3D B8 F7 E1 0E C2 1C 82 F9 10 E6 23 98 8F' + '61 3E 81 39 0C D3 06 D3 0E 73 24 49 CD 4B 52 F3 92 D4 BC 24 35 2F 49 CD 4B 52 F3 92 D4 BC 24 35' + '2F 49 CD 4B 52 F3 92 4A 9D 28 E1 1C 34 AF 93 25 9C A3 84 73 94 70 8E 12 CE 51 C2 39 4A 38 47 09' + 'E7 28 91 3B BC 8B 6C 04 CD 6D 64 17 39 A3 BA C8 37 BA 8B FC 63 BA 28 30 B6 8B 82 E3 BA 28 34 BE' + '8B C2 13 BA 70 0E B8 B7 E1 5A E0 5A E1 F6 C3 BD 03 F7 2E DC 01 B8 F7 E0 DE 87 1B 5E 8A 1E 4D 72' + '64 29 7A A5 E8 95 A2 57 8A 5E 29 7A A5 E8 95 A2 57 2A F7 65 B8 5F C1 FD 1A EE 15 B8 DF C0 BD 0A' + 'F7 1A DC EB 70 6F C0 BD 09 57 57 46 FE D3 70 73 65 E4 7F 19 F9 5F 46 FE 97 91 FF 65 E4 7F 19 F9' + '5F 46 FE 97 C9 BD BE 4C C9 1B CA 94 FD 20 2D 3B 48 73 3E 94 E6 2E D3 DC 65 9A BB 4C 73 97 69 EE' + '32 CD 5D A6 B9 CB 34 77 99 E6 2E D3 DC 65 9A BB 4C 73 97 69 EE 32 CD 5D A6 B9 CB 34 77 99 56 9F' + 'E1 E5 9C 85 26 3F B2 9C B3 94 73 96 72 CE 52 CE 59 CA 39 4B 39 67 29 E7 2C E5 9C B9 02 8E 17 80' + '91 15 70 15 70 15 70 15 70 15 70 15 70 15 70 15 72 27 C2 4C 82 99 0C 33 05 66 2A CC 34 98 E9 30' + 'BC 40 84 67 C2 CC AA A0 B7 56 28 3B A7 82 DE 5A A1 9A B9 15 F4 D6 0A F5 9C 5F A1 5E 0D 15 EA DD' + '58 A1 3E 0B 2A 54 32 BC 3B 7B F2 C2 31 B2 3B 7B 76 67 CF EE EC D9 9D 3D BB B3 67 77 F6 EC CE 9E' + 'DD E5 7E 13 EE 5B 70 DF 86 FB 0E DC 77 E1 BE 07 B7 1B EE FB 70 CD 70 7B E0 5E AE D4 F6 5F 55 AA' + 'CB AF 2B B5 E3 95 4A 3D FA 9B 4A 5D F6 6A A5 1E 7B AD 52 A5 AF 57 EA F1 37 2A 55 F6 66 A5 A2 BF' + '65 FC AE 52 E9 DF 57 2A F6 87 4A 95 FF B1 52 F1 3F 55 AA EB 5B 95 2A 7A BB 52 91 16 46 6B A5 8A' + 'F7 A3 67 59 D1 A1 E5 73 B2 F2 FB B2 0A F8 B3 0A 06 B2 0A 05 B3 0A 87 B2 72 C3 F8 5C 7C 45 F8 22' + 'F8 8A F1 45 F1 C5 F0 C5 99 4F 30 9F 64 BE 84 F9 14 F3 5D 98 BF 8C 17 A9 52 74 CB 58 9B 86 29 87' + 'E9 0A D3 0D A6 02 A6 3B CC E5 30 95 30 55 30 19 98 2B 60 7A F0 9C E5 B9 9A 51 C3 5C 2D 73 3D 59' + 'D7 8B 75 BD 59 D7 87 75 7D 59 D7 0F EE 4A 98 FE 8C 3A B8 01 70 B9 AC 9E 18 98 D5 93 57 E1 BF 1A' + 'FF 35 F8 AE 65 0C C2 7F 1D FE EB F9 7C 03 E3 46 9E 6F 62 0C 66 DC CC 18 82 FE 50 F4 87 31 6E 61' + 'DC CA 3E B7 31 6E 67 AF 3B 18 77 32 EE 62 DC 8D E6 3D AC BF 97 35 F7 A1 77 3F EB 1E 60 AF E1 CC' + '8F 60 7E 24 F3 A3 18 A3 F1 8D 61 8C 65 7E 1C F3 E3 61 26 F0 79 62 56 B9 49 59 0D 9C 9C D5 A0 29' + '7C 9E CA E7 69 59 C5 A6 67 55 34 23 AB 6B 67 62 67 31 66 67 15 99 83 BF 1E 3F 2F A4 35 F3 B2 BC' + 'B3 A1 DB 80 66 23 7B 2E 20 C6 85 C4 D7 44 4C D3 1B 64 33 78 99 9B D9 20 67 56 83 7C B3 1B E4 9F' + 'D3 A0 40 7D 83 82 73 1B 14 9A D7 A0 F0 FC 06 72 BF 91 3C E4 85 6F 64 23 79 D8 48 1E 36 92 87 8D' + 'C4 D8 48 1E 36 92 87 8D E4 61 23 B5 BA 91 5A DD A8 92 29 8D EA 3B B5 51 4F 4D 6B D4 CE E9 8D 7A' + '7A 46 A3 9E D9 D4 24 DB CC 8B E2 43 4D 72 1E 6E 92 EF 91 26 F9 B7 34 29 B0 B5 49 C1 6D 4D 0A 6D' + '6F 52 78 47 93 DC 47 9B 94 7C AC 49 37 3E DE A4 9B 9E 68 D2 B0 27 9B 74 CB 53 4D BA 75 67 93 12' + '4F 37 A9 DF 33 4D BA 72 57 93 FA 3F 8B D6 73 68 3D 8F D6 07 2D D4 83 16 EA 41 0B F5 A0 85 7A D0' + '42 3D 68 A1 1E B4 50 0F 5A A8 07 2D D4 83 16 EA 41 0B F5 A0 45 37 E6 5B 74 53 A1 45 C3 8E B5 E8' + '96 E3 2D BA F5 44 8B 12 1D 2D EA 77 B2 45 57 9E 6A 51 FF E9 AD F4 D9 56 FA 6C 2B 7D B6 95 3E DB' + '4A 9F 6D A5 CF B6 D2 67 5B E9 B3 AD F4 D9 56 FA 6C 2B 7D B6 95 3E DB 4A 9F 6D A5 CF B6 D2 67 5B' + 'E9 B3 AD F4 D9 56 FA 2C 3A CB D0 59 8E CE 0A 74 56 A2 B3 8A B9 D5 D8 3F 1E 90 FD E9 80 F4 D6 01' + '39 6F 1F 90 AF E5 80 FC AD 07 14 D8 7F 40 C1 77 0E 28 F4 EE 01 85 0F 1C 90 FB 1E DC FB 70 7F 86' + 'FB 0F B8 FF 84 FB 2F B8 FF 86 FB 1F B8 0F E0 0E C2 1D 82 FB 10 EE 23 B8 8F E1 3E 81 3B 0C D7 06' + 'D7 0E 77 04 EE 28 5C 1E AE 00 77 0C EE 38 DC 09 B8 0E B8 93 70 A7 E0 4E C3 9D 81 3B 0B F7 29 DC' + '39 B8 F3 70 9F C1 5D 80 FB 1C EE 0B B8 2F E1 2E C2 0D 39 28 1B 7A 50 1A 76 50 CE 2D 07 E5 BB F5' + 'A0 FC B7 1D 54 E0 F6 83 0A DE 71 50 A1 3B 0F 2A 7C D7 41 7A EE 21 7A D5 21 7A D5 21 7A D5 21 7A' + 'D5 21 7A D5 21 7A D5 21 7A D5 21 7A D5 21 7A D5 21 B9 AF B7 49 6F B4 C9 79 B3 4D BE DF B6 C9 FF' + 'BB 36 05 7E DF A6 E0 1F DA 14 FA 63 9B C2 7F 6A 23 1F DB C9 C7 76 F2 B1 9D 7C 6C 27 1F DB C9 C7' + '76 F2 B1 9D 7C 6C 27 1F DB C9 C7 76 B9 4B F2 FC 73 95 97 B3 2C 2F DF F2 BC FC 2B F2 0A AC CC 2B' + 'B8 2A AF D0 EA BC C2 6B F2 72 D7 E6 95 5C 97 57 76 7D 5E D5 1B F2 AA D9 98 57 ED 83 79 F5 DC 94' + '57 AF CD 79 F5 7E 28 AF 3E 0F E7 55 F2 48 5E D3 B7 E4 35 63 6B 5E 33 B7 E5 35 78 7B 5E B3 76 E4' + '35 FB D1 BC E6 3C 96 57 FD E3 79 A5 9E C8 6B EE 93 79 CD 7B 2A AF F9 3B F3 BA F9 E9 BC 1A 9E C9' + 'AB 71 57 5E 0B 9E CD 6B E1 73 79 F5 7D 3E AF A6 17 F2 5A F4 62 5E 8B BF 91 D7 90 BF CA 6B C9 5F' + 'E7 B5 F4 6F F2 5A F6 B7 79 2D FF BB BC 86 FE 7D 5E 2B BF 89 FD 56 5E BB BE 9D D7 B3 DF E1 1C DF' + 'E5 1C DF E3 1C BB 39 C7 F7 39 47 33 E7 D8 C3 39 F6 72 8E 7D 9C E3 07 79 15 FD 30 AF C8 8F F2 2A' + 'FE 31 FC 4B F0 3F 61 BF 9F A2 A3 02 FF E0 15 E4 F8 0A F2 F9 0B F2 07 0A 0A 04 0B 0A 86 0A 0A 85' + '0B 0A BB 05 B9 45 05 25 23 05 65 8B 0B AA 8E 16 54 13 2B A8 36 5E 50 CF 44 41 BD 92 05 F5 2E 29' + 'A8 4F AA A0 92 2E 05 4D BF AC A0 19 A5 05 CD 2C 2B 68 70 BA A0 59 E5 05 CD EE 5A D0 9C 6E 05 D5' + '57 14 94 EA 5E D0 DC CB 0B 9A 57 59 D0 FC AA 82 6E CE 14 D4 70 45 41 8D 3D 0A 5A 90 2D 68 61 75' + '41 7D 6B 0A 6A AA 2D 68 51 CF 82 16 F7 2A 68 48 EF 82 96 F4 29 68 69 DF 82 96 F5 2B 68 79 7F E2' + 'AD 23 DE 01 C4 9B 23 DE 81 C4 7B 15 F1 5E 4D BC D7 10 EF B5 C4 3B 88 18 AE 63 FF EB D9 EF 06 34' + '6F 2C 28 72 53 41 D7 5A 87 4C 0C A7 83 7F FE 3B E4 F8 3B E4 0B 74 C8 1F EC 50 20 D4 A1 60 B8 43' + '21 B7 43 E1 A2 0E B9 11 B8 62 C6 89 0B E4 E7 05 F2 F3 02 F9 79 81 FC BC 40 7E 5E 20 3F 2F 90 9F' + '17 C8 CF 0B E4 E7 05 B9 3B CF 39 EE FF 06 F5 F2 31 02' +} + + +LANGUAGE 0,0 COMPOSITION UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE +{ + '78 DA 5D 5D 05 98 94 D5 FB 7D 67 86 5D 1A 76 48 01 E9 94 5C 76 69 10 E9 EE 25 A5 BB BB 43 09 01' + '41 41 01 91 16 44 51 41 90 46 4A B1 41 C5 C4 DD 41 05 EC 04 0B DB 1F E1 FF 9C 7B CF EC E7 F3 7F' + '9E 79 38 E7 BC 71 E3 BD F7 BB DF 37 33 BB 4B B6 7C 66 87 CD C2 49 A5 CC 42 11 5B 1C C9 A4 17 C3' + '9E 46 22 F6 E5 BF 16 CE 09 9A 25 62 FB 14 0B DA F6 A6 A7 09 11 6B 5C 2A 93 B6 0B AC ED 03 DA 21' + 'A0 1F AA DD C4 88 7D 24 9A 35 62 3F 96 B4 88 81 66 8B A0 47 5B 12 C9 54 18 C9 4B 81 AF 59 C4 76' + '6A 04 50 1F 2B 3F 47 C4 2E 89 E6 8C D8 DB 0A CF EF 9A 7A 27 50 68 EA DD 40 A1 A9 17 4A FA 24 A8' + 'E7 03 7A 49 31 05 5C FE 27 81 42 FE A7 81 42 FE 4D 25 41 1D D3 A8 2A 46 EC 82 86 52 29 62 85 55' + '97 D4 88 BD A8 58 A4 CD 51 91 5B 46 6C 12 EA 92 08 DA 3E D1 06 5C B7 08 69 87 44 EB 9A 68 53 E4' + '80 1A 28 47 47 E7 98 26 07 D4 20 39 3A 39 C7 0C 39 A0 06 CB D1 D9 39 66 C9 01 35 44 8E 2E CE 31' + '47 0E A8 A1 72 C0 3A 29 D1 E6 C9 01 75 B7 68 B7 44 DB 9C EC 87 BD 31 D9 B6 88 6E 4A B6 1C A5 2C' + '44 9A 5D 58 03 18 06 0E 94 7E D4 BC 0E 4B 47 84 59 84 89 C2 04 61 36 61 56 B5 63 C9 16 E2 DE 6B' + 'C4 52 96 36 C3 AB AD E8 1D 66 BD 6E 5A 28 37 68 41 60 0E 60 E8 5F 44 03 C3 C4 32 18 05 FD 65 D1' + '2B 35 30 0B B1 9C D9 68 DA 81 63 88 E5 D1 3B ED C0 44 62 05 B3 41 B4 03 B3 52 57 34 9B 56 CE 22' + '49 95 CC 6A 9A DD 66 76 57 39 CB 22 95 EC 0C 77 07 06 1F 31 3F 30 A4 38 C3 82 C0 90 EA 0C 0B 03' + '43 2D 67 58 14 18 6A 3B C3 3D 81 A1 8E 33 2C 0E 0C 75 9D 61 49 60 A8 E7 0C 4B 03 43 7D 67 98 AE' + '71 FB 41 DC 2B 77 4A 7C DC 33 E4 F6 43 9A 29 E5 C7 33 4B CA 0F 66 B6 94 1F C9 1C 29 3F 8C B9 52' + '7E 0C F3 A4 FC 00 92 AE 86 9C 6A EA 54 54 AA 99 53 F9 A4 9A 3B 95 5F AA 85 53 05 A4 5A 3A 55 50' + 'AA 95 53 85 A4 5A 3B 55 58 AA 8D 53 B7 48 B5 75 AA 88 54 3B A7 8A 4A B5 77 AA 98 54 07 A7 6E 95' + 'EA E8 54 71 A9 4E 4E 95 90 EA EC 54 49 A9 2E 4E 95 92 EA EA 54 69 A9 6E 4E 95 91 4A 73 AA AC 54' + '77 A7 CA 49 F5 70 AA BC 54 4F A7 2A 48 F5 72 AA A2 54 6F A7 2A 49 F5 71 EA 36 A9 3B 9D DA A2 CA' + '0F 76 EA 11 A9 21 4E 6D 95 1A EA D4 36 A9 61 4E 3D 2A 35 DC A9 ED 52 23 9C 7A 4C 6A A4 53 8F 4B' + '8D 72 6A 87 D4 68 A7 9E 90 1A E3 D4 93 52 63 9D 7A 4A 6A 9C 53 3B A5 C6 3B B5 4B 6A 82 53 4F 4B' + '4D 74 6A B7 D4 24 A7 F6 48 4D 76 EA 19 A9 29 4E ED 95 9A EA D4 3E A9 69 4E ED 97 9A EE D4 01 A9' + '19 4E 1D 94 9A E9 D4 21 A9 59 4E 1D 96 9A ED D4 11 A9 39 4E E1 1A 72 CA A2 54 79 52 FC 85 05 35' + 'D8 19 42 72 87 9D CA 2B 77 38 EE 0E CB 1D 71 2A 49 EE 48 DC 1D 91 3B C1 A9 A8 DC 09 71 77 16 B9' + '13 9D CA 27 77 62 DC 9D 20 77 56 A7 F2 CB 9D 35 EE 4E 94 3B BB 53 05 E4 CE 1E 77 67 95 3B A7 53' + '05 E5 CE 19 77 17 4F B1 AC 32 8C 8E 5A AE A8 0D 8F DA 6E E7 29 91 62 89 81 27 5F D4 26 38 73 36' + 'B5 97 CB A9 42 6A 2F 57 BC BD 5B 03 83 8F CF AE F8 3C 4E 15 96 3B 4F 3C 3E 87 DC 79 9D BA 45 EE' + 'BC 71 77 4E B9 93 9C 2A 22 77 52 DC 9D 4B EE A8 53 45 E5 8E C6 DD B9 E5 CE E7 54 31 B9 F3 C5 DD' + 'A5 E2 6B DE C9 5D A5 F1 35 74 AA 4C BC AA 4E 55 92 EA EF 54 69 A9 15 4E 95 93 5A EB 54 7D A9 2F' + '9D BA 5D 2A D4 99 AA 69 7C B4 4E 55 94 1A DB D5 9D 18 52 E3 9D AA 27 75 B8 9B 3B 15 A4 9A A6 51' + 'DD 21 D5 DD A9 5A 52 B9 BB 53 35 90 9A E7 54 59 A9 0B 3D A9 6A 48 95 EC 45 D5 50 6A 44 5F AA 64' + 'A9 AF 87 53 55 96 CA 36 92 2A 25 5E 09 A7 AA 49 55 72 AA A6 54 E5 51 54 55 A5 6A 8D A3 AA 12 9F' + 'DF 24 AA DA 52 B3 A7 50 35 8A 57 69 06 55 AA 54 E3 D9 54 75 E3 B5 76 AA 49 BC 2E 4E 35 93 BA BC' + '90 AA B9 D4 6F 4E D5 91 DA BE 82 AA B1 D4 19 A7 AA 4B BD BF DA DD EE F1 28 92 8D F3 E3 C3 00 EF' + '88 7C D8 E0 19 CC 87 04 E0 4A F8 B3 F3 14 A6 E6 16 66 1C F0 01 DA F9 74 C0 7C F6 C8 3C EE 61 FA' + '2B E3 9C 66 3C 70 0E FD 55 CC EE 63 3C F0 B6 6B 16 0A 01 87 D0 0F CC C9 78 60 17 EA AA D8 C5 D4' + 'C0 24 B6 07 CC 4D 5D 0D 67 3B FD C0 22 37 2D 92 A3 3A 66 E1 5E 15 4A 61 2E 99 2A 19 CF 73 F2 95' + 'E7 63 94 A7 DD 98 09 2C C7 87 2F 60 1E B6 08 CC 4B AC 81 FD 78 35 14 4E C2 23 03 3A 33 51 78 97' + '97 B6 48 5E D0 16 A5 F8 00 D1 3B D5 9C E3 F8 24 FB F0 7C 28 14 02 FD 42 F8 8E 30 89 CD 01 7F B9' + 'E6 F5 E5 72 16 CA 0A FC 41 FE 05 2C 00 70 12 0B 02 FC 53 F6 30 FB AC E9 BA 5F 56 CE 1C 45 F7 AB' + '79 20 FB 47 30 A8 EF 53 33 15 76 E5 1B 29 99 0A BB 72 48 E0 C3 E8 46 A3 89 AC 5E AD 51 13 BE C1' + 'CB A9 99 0A 4D BC 99 92 A9 D0 C4 D0 C0 87 26 C6 A8 09 BC 1E 52 13 29 AE 89 2B A9 99 0A 4D 9C 4D' + 'C9 54 68 62 58 E0 43 13 63 D5 04 D4 5A 35 91 EA 9A F8 21 35 53 A1 89 E1 81 42 D2 38 25 41 3D AC' + 'A4 5A 2E E9 C7 D4 4C 85 A4 11 81 42 D2 78 25 41 AD 53 52 6D 97 F4 53 6A A6 42 D2 C8 40 21 69 82' + '92 A0 D6 2B A9 8E 4B FA 39 35 53 21 69 54 A0 90 34 51 49 50 1B 94 54 D7 25 FD 92 9A A9 90 34 3A' + '50 48 9A A4 24 A8 8D 4A AA E7 92 AE A6 66 2A 24 8D 09 14 92 26 2B 09 6A 93 92 EA BB A4 5F 53 33' + '15 92 C6 06 0A 49 53 94 04 D5 AD B4 65 C9 5B D3 6D 5D BF 13 9E C7 41 2E 03 56 24 AD 74 A6 42 A9' + '9F 0B 7C A8 61 8F C0 87 E2 F4 09 14 66 DD 25 50 98 4E DF 40 61 9C 5D 03 85 01 0C 2C 6D 61 A9 CF' + '52 FD 96 C6 78 5F 4C F1 14 BB A5 8F AC 18 F7 42 5E 16 A0 1F F1 72 00 7E 29 FC 4B 38 88 97 11 F0' + 'EA 35 AF A3 BC CC 80 3F CA FF AE F0 38 2E E4 6C C0 08 2F A7 14 77 39 2D E7 E5 E4 B7 EE 66 D6 31' + '25 7E 39 FD 96 9A A9 30 AE 71 81 C2 78 A6 B2 8E 5E FD 2E 87 1F FE F8 40 21 AC 6B 8A 0F 83 FA 43' + '0E 7F 59 4C 08 14 C2 BA 29 0C AF 3F E5 F0 5B 7F 62 A0 10 96 A6 30 A8 BF E4 F0 9B 7D 52 A0 10 D6' + '5D 61 50 7F CB E1 B7 77 0F 39 A0 FE 91 C3 6F E1 9E 72 40 FD 4F 0E BF 4D 7B C9 01 75 4D 0E BF 15' + '7B CB 01 75 5D 0E BF DD FA C8 01 D5 9D AB 9D 12 DF 41 3D 03 85 FE 3F 4F F5 45 47 C6 4B 29 9E 62' + 'C1 EF 94 15 93 58 C4 05 07 1D CC 85 05 1E E4 C2 01 F3 71 61 81 BF 72 A1 81 5F 9D F7 F8 93 F0 3D' + 'E1 C7 C2 BF 85 59 B8 E0 A9 6E C1 EF E3 82 FB 83 E6 06 C7 9E 1A 5F E2 3B 39 76 AF 6E CA E1 17 B5' + 'AF 1C 50 FD 44 D1 64 7F 51 BC 06 88 A2 E4 03 45 31 C9 03 A2 28 EB 41 51 14 F2 90 28 4A 77 58 14' + 'C5 3A C5 0B 2C 35 7E 81 F5 2A 9D A9 D0 4E BF 40 21 E9 8B 54 3F 7C 8C EB E5 14 4F 51 BA BE B2 A2' + '74 BF B1 34 A0 F9 59 2A E0 FB E7 BD 3E C4 12 02 FF 91 FE 59 78 41 F8 B5 F0 1E 96 1E 38 84 A5 07' + '26 B0 74 B5 5C E9 EE 67 E9 FC 71 7B 84 63 AF E5 8A F5 AC 28 CA 73 54 14 E5 39 26 CA 41 89 E2 75' + '42 14 D3 3A 29 8A F2 3C 27 8A F2 3C 2F 8A 99 9E 12 45 79 7A B3 04 B5 E2 05 F9 32 D5 0F 03 25 78' + '25 C5 53 94 A0 9F AC 28 C1 FF 38 15 D0 8B C2 A1 9C 0A F0 1B E9 5F 84 BF 5F F3 B8 98 53 06 9E 93' + 'BD 00 4B 07 9C C6 BB 30 30 91 25 A8 ED 4A B0 82 25 F0 37 8F 17 38 BE DA AE 04 77 72 7C B5 E3 67' + '60 FF 40 61 1A 5F A5 FA 0C 8C F6 D5 14 4F 31 DA FE B2 62 B4 DF B2 57 D0 0F 84 4B 38 1A E0 35 E9' + '4B C2 AB C2 3F AE 79 9C CE D1 01 87 71 76 C0 82 1C 35 30 2B 47 5B C7 8D 76 25 47 EB EF 5A 5F A7' + '7A 8A 61 BC 96 E2 29 86 31 40 56 0C E3 4F 36 0B 5A 88 CD 00 87 B3 59 E0 52 0E 07 98 7E DE FB 3F' + '11 CE 60 F7 C0 EF A4 7F 15 5E 17 66 E3 30 EA BA 61 3C C0 61 F8 FB E0 00 D6 A6 6E BC 36 DF A4 7A' + '07 06 75 3A C5 53 0C 6A A0 AC 18 54 61 0E 06 F4 2F 0E 0E 98 71 DE E3 6F C2 EF 85 33 39 18 E0 A7' + 'D2 23 38 78 E0 0D E9 7B 39 09 60 76 0E AA 9E 1B D4 83 1C 94 BF CF 7E 9B EA 29 86 71 26 C5 53 0C' + '63 90 AC 18 C6 EF 6C 06 74 19 9B 01 DE C2 61 01 FF BE E6 ED 97 E5 FF 4C 38 92 DD 03 67 71 58 C0' + '9B B2 C7 84 39 38 8C FA 6E 18 AB 38 0C 7F E7 FE 2E D5 53 0C E3 F5 14 4F 31 8C C1 B2 62 18 45 D8' + '2D E8 BF 6C 06 38 9B CD 03 AF 48 8F 62 B7 C0 F3 D2 FF 5C F3 F8 87 F4 E7 C2 E5 9C 06 70 5A 65 1C' + '73 0D F0 26 08 EF BB 70 5B E7 23 30 68 7E 3E 54 03 8B B2 37 60 01 EA 86 38 D0 E9 07 16 A3 1D 38' + 'A1 8C 85 AD 11 2E D5 88 DD 4A 13 E8 30 86 00 67 B0 E1 DB 5D AB 78 4D AF 8C 19 78 3A 88 39 B7 BB' + '9C 79 1C 3C E8 0A 0E 06 58 9C 6D 00 47 B0 0D E0 44 86 36 76 A1 C3 69 02 2D C1 10 60 1B 3E B7 DF' + 'E1 3E 09 6D 2D 8A 57 49 7A 81 3D 19 0D 2C C4 71 03 C7 52 37 C1 9B 57 FA 81 53 51 D0 3C 4D DD 07' + '4F 2F E2 C9 9A 1F CC 59 C4 5E 12 0D 45 EC C9 12 D0 A0 61 F7 F1 F7 8E 40 C1 F7 74 A0 22 11 DB 19' + 'A8 EC 11 7B 59 4D 40 BD 22 8A 18 0B 79 9A 25 62 FB 15 9E E8 1A DE 1B 28 34 7C 38 50 48 3A 18 28' + '34 1C 56 13 50 9F 85 BC 23 6B 84 0D 56 08 7B 07 D4 27 72 64 73 8E 57 D5 3F D4 63 25 3C 45 3B FF' + '53 4C 0E D7 E3 6B 8A 81 7A 5B 1D E4 8A D0 E6 68 5E 74 2B 1A 8D D8 1E 8D A7 6C 84 B3 7B 36 50 18' + 'D2 A3 EA 00 CA 44 CB 63 10 6A B2 52 C4 3E C5 DD 94 05 2F 58 86 1F 78 95 E6 32 40 D5 CB C0 66 04' + '36 8A 79 7C 54 BA 6A 71 EC 0B D6 4B 7A 9C 30 F9 6A 28 C4 56 46 A5 7B FD 2C 37 3B 70 8B 74 BA E2' + 'DE 93 9E A4 76 B3 09 4D F6 5A C2 57 B8 0D 9A B9 CF D2 C2 1C 76 33 5F 54 51 4E 4D B4 66 C4 6E 67' + '1B A4 1C 03 30 21 C3 EB FA C2 50 BA C7 F7 85 B5 85 93 95 97 5D 78 94 63 06 66 28 AF 6A 69 73 B8' + '5D BA 3A E7 0E 1C 2F 3D 5A ED 94 61 CD 80 D5 70 6E 64 6D EE 3E 21 3E C3 A2 36 77 1F 13 E2 E8 48' + '64 B5 9B BB DD 9B 4D 14 EB 94 43 14 F3 CA 25 8A 15 CE C6 D5 6B EE BE A8 41 F8 19 F3 0E A8 D3 A9' + '96 85 4D 62 9D C6 BA CF 3B 27 70 18 30 34 8E 79 DC 9A EE 31 85 65 00 56 01 72 38 61 4E 03 F8 98' + 'E2 C7 28 6E 3C EC 49 F4 4B 1F E3 F4 81 39 D4 DE 39 D9 CB 72 7A C0 3A D2 D5 D4 DE 14 C5 C5 D4 EE' + '2A 4C 3F 4F 0B F7 61 F6 AB D8 CA 49 2D DC E7 BE 98 D2 55 CC 4E EA 35 39 E6 38 C7 AF 72 40 E5 E0' + '72 B6 70 C5 C8 13 F2 14 01 B9 64 C5 7A 27 89 A2 12 F9 44 AB 21 56 14 BB E0 71 0E 03 74 6C BA C7' + 'E3 9C 0E B0 1C 87 0F 6C C9 61 03 3F 90 3F AB E2 73 C6 3C 36 94 8E C8 3F 51 FA 0E F9 53 59 56 60' + '32 77 01 70 AA EC 13 58 46 60 5D E5 6D 13 9E 57 FE EB 5C C2 96 EE 14 7B 43 14 0B FB 22 97 B9 65' + 'FC 14 3B 15 28 F8 5E 0D 14 0E 9B 97 03 85 43 E2 4D 35 01 F5 5C 09 4F 11 53 40 31 59 5C 6B 85 02' + '85 D6 F2 85 7C 18 54 01 51 1C 0B 85 44 51 EF B3 6A 12 A7 D1 09 35 89 8E 8A 2A 00 AB 90 25 EC 29' + '0E 9D 44 51 1C 3A A7 D5 8B 3F 74 8E 29 13 EA 56 39 2A BA F3 A7 92 32 A0 6E 51 93 38 74 6E 51 38' + '96 B0 A8 68 72 C4 6A B2 B4 1C 09 4B 07 FC 50 98 2B E6 31 3D DD 63 16 61 23 F9 6B 71 69 80 D3 14' + '57 4F FE 71 C2 1D 8A 3B C1 2D C1 AE B8 15 80 93 64 6F A2 BC F2 DC 2A C0 86 78 0C 4A 6A E5 BE 14' + 'EA 8D 53 93 03 6C E5 4A 75 3B 13 40 2B 30 10 58 3F DD EB C9 B2 27 48 E7 8E 79 7C 42 F6 93 EC 18' + '98 21 7F 53 F9 C7 4B D7 E4 80 80 B5 39 11 E0 47 CA 9B AE B8 EC D2 F7 F2 54 6C ED BE 9F 7A 88 27' + '4C 6B F7 B5 12 2E 9F 3D 52 5D DC B7 2B 6F 28 6C 36 1E A2 59 F3 D6 6E CB DD 2A 8A D5 2A 55 C2 53' + 'EC 89 12 B2 62 A9 4A 89 62 A2 DF 88 62 F5 CB 88 62 01 A7 70 18 A0 33 62 1E 9F E3 B4 80 1F CB DE' + '20 DD E3 63 C2 09 C2 27 E5 AF C8 B2 71 F8 CA AF C3 E9 02 F3 48 C7 14 DF 58 F1 39 84 89 B2 A7 72' + '7F 00 CF 72 7E 6D DC 6C DB F1 D0 69 E3 BE 99 7A 2B C5 5B 71 34 AE 52 00 2A 53 8E C3 6F E3 66 5D' + 'A6 84 A7 98 5F 05 51 EC F9 12 61 4F 31 D5 72 B2 62 13 57 12 C5 AC 2B 8B 56 8F D8 05 0E 08 B4 61' + 'BA C7 5C 5C 37 60 4E 61 25 4E 10 98 5B FA 79 16 08 98 37 E6 E3 27 2A 6F AA DA C9 2A 5D 97 85 00' + '9E 97 6E AE F8 A7 14 57 8B 13 07 CE 94 7D 08 37 68 5B F7 2D 22 5E 83 4B E3 18 F5 34 25 E4 29 CE' + 'E0 39 AC 41 5B F7 20 35 54 01 28 D2 28 51 EC EB B7 78 DD B7 75 07 D3 DB A2 D8 25 EF 88 A2 5E 95' + '42 9E E2 80 A9 2C 8A 0D 53 55 14 1B 26 59 14 05 AD CE 8B BE 6D FC 27 22 DE 55 23 50 AF 97 F0 14' + '47 CA BB 0A E7 5D 2E EC 29 8E 94 1C A2 38 52 DE 54 2C EA 5F 5D B1 38 2B AA CA 8A 03 62 10 CF 5A' + 'D0 0F 59 27 7E 85 CA 7A 03 6B B3 3E C0 59 31 6F CF 26 FF B4 0C 8F A7 B8 0E C0 8B D2 49 5C 1F F6' + '29 6C 22 FB 24 E5 35 12 B6 50 7B 49 C2 9D 8A AB C7 F5 02 D6 E2 28 DB B9 62 4D 66 0A E8 EC 98 C7' + '17 D8 25 70 7A 86 D7 F5 99 02 6C 29 7F 53 D9 73 0B 3F 52 7E 1D 4E 05 78 49 F6 A8 E2 B3 CB 5F 99' + '53 06 EE 92 FF 09 D9 6F 17 2E E1 B2 B7 77 47 C4 DB A2 78 BD 23 DA 11 65 64 39 DB BB B5 FE 2E E4' + '29 16 24 45 56 94 BE 8E AC D8 FA B5 64 C5 ED 35 07 DB 07 7D 52 F8 22 E7 07 CC 17 F3 7A 46 86 C7' + '3C C2 66 C2 C6 8A 6F A5 B8 06 AC 03 B0 2E E7 09 7C 5A 71 1F 2B EE 13 E9 39 8A 9F 22 7B 15 CE 1B' + '78 86 3B BC 83 DB E1 EF A6 E0 D0 EB E0 BE B1 E6 7D 56 8E 31 B8 65 8B 1E 45 D9 39 99 0E 6E B6 B7' + '8B 62 B6 F5 B8 5B 3B B8 D9 62 47 D7 29 E1 1D 50 0D 15 83 B9 37 92 15 B7 A8 06 A2 28 C3 38 EE 40' + 'D0 BC 1C 26 F0 42 BA C7 99 D2 77 48 EF 96 6E C8 E9 02 A7 CA 9E 8F 3B 0E F8 12 CB 07 6C 1D F3 F6' + 'E6 8A AF CA 69 02 73 2A BE 1E CB 04 CC AF B8 B9 C2 4F 15 BF 94 0B DB D1 2D F7 18 1C 85 D9 3A BA' + '1F 57 18 2B 8A B2 AC E1 9D A1 63 FC 3E B1 5B CA DF 27 C6 29 AC 1B F6 08 CF D1 8E EE 88 38 AE 26' + '41 5F 10 ED 85 75 64 0D 3A BA 42 36 11 C5 65 DF 4C 14 A5 7B 49 B1 BB 22 D6 82 83 03 7D 99 93 04' + '4E 4B F7 3A 97 70 22 8B 08 4C 65 31 80 4D 64 DF A3 BC CF 84 49 C2 79 31 8F 8D 58 4C 60 35 16 09' + '78 51 79 6D E4 AF CF 62 01 67 29 AF 80 EC 6F 72 3F 74 72 7B E6 AC 28 76 49 A1 D2 9E E2 19 FD 6F' + '2E 7B 27 77 14 36 17 C5 3C DF 37 4F 71 FE B5 28 E1 29 A6 DC 5A 01 D8 46 AD 64 C5 EC 5B CA 8A 8D' + 'D3 4E 56 6C 9C 36 A2 D8 38 D5 39 66 D0 57 58 13 60 53 8E 1D 38 3B C3 E3 2E E9 BB 62 1E 0B 0A 9F' + '91 FF 92 FC B9 85 D3 85 6D 15 F7 B9 E2 1A B0 06 C0 DB 59 2B 60 54 F6 82 AC 35 F0 1C 27 D5 D9 4D' + 'F5 03 51 4C F5 1C 2F 88 CE F1 C7 D1 F7 02 05 5F 2C 50 A8 44 7A A0 70 A4 A7 AB 09 A8 0E 72 44 5C' + '52 D5 70 A6 C2 15 D6 29 F0 E1 96 90 A1 24 A8 2E 72 F8 07 D7 6E 81 42 13 1D 42 3E 8C F9 A2 BC E7' + 'A8 61 FF 16 BB 7A D8 3B A0 2A CB E1 DF 62 C7 D4 07 D4 3B 25 3C C5 70 BB A8 9D 9C 58 5C 51 BE CB' + '50 23 B8 19 E5 11 C5 CD E8 A2 06 53 CC 0D ED E3 40 61 68 9F 05 0A 93 F8 24 50 E8 E3 8B 40 61 5F' + '3C AA 6E A0 3E 94 C3 3F 30 BF A5 51 41 FD 10 F2 8E 4A 6E E4 97 95 01 D5 8C 6B 0C 5A 28 E6 B1 06' + 'F7 10 B0 9D 74 AB 0C 8F 73 84 F9 84 8D B8 07 80 AF 72 AF 01 67 A8 9D 2F E4 CF 23 FD B4 B0 31 F7' + '0A F0 6E B5 FB 89 EC 7B 15 7F 9E 97 76 17 77 86 7C C4 03 A4 8B 3B 40 70 61 75 BA 1A 8A 2B 9C 16' + '1F 2B 0C C7 49 97 14 1F D6 DD FD 84 D4 2E 39 70 E4 74 E7 B4 BB B8 3D D7 53 14 6B 97 CC 89 81 BE' + 'C6 01 03 E7 B2 63 E0 FC 98 C7 3B 38 40 E0 A7 E9 5E EF 93 7F B7 74 63 4E 18 98 5F F6 F6 CA 9B 29' + '7F 73 61 11 5E 04 C0 2F 15 57 58 71 79 E5 2F 4A 7F 57 1C 20 D4 C0 05 31 8F B7 08 3B 08 3F 93 7F' + '5E 86 C7 24 E9 D3 1C 3F B0 80 EC 5F 09 5B C8 DF 84 F3 00 EE 97 BD 26 E7 0D DC 23 FF 4E 7E 5E D6' + 'CD FD 94 50 77 6E 83 6E AE 50 BD 4B 78 8A 42 F5 96 15 BB 36 29 EC 29 76 6D 3E 51 EC DA 7E DC 64' + 'DD E2 77 B6 3B 95 09 D5 53 99 38 A0 06 C8 8A 53 A9 23 27 04 9A C2 81 00 5B A6 7B 5D 95 9F 1D 00' + '9B 72 C0 C0 03 19 DE 7E 97 B0 18 0B 05 2C A2 FC E2 D2 B7 0A CF B0 10 C0 3B B8 30 1C 99 DA FD 5A' + 'F9 0B 95 37 5B F6 CF 85 1D 78 1B 4A 73 37 AE 52 38 9E B3 A5 B9 6D D6 51 56 BC 2E 72 2B A5 B9 9F' + '8E 1A C6 A9 A6 B9 0A A1 32 77 72 7E 5E F5 13 C5 55 36 A8 84 A7 08 18 A1 F0 5C 2E 7C 90 62 A0 46' + 'C9 51 D6 39 86 28 03 EA 96 B0 A7 15 50 32 85 A3 7A 45 39 74 D0 76 19 1E E7 A4 7B DC 2B FC 46 F6' + 'D7 59 02 E0 DD D2 8B 94 77 50 BA 19 4B 0B 6C A5 BC 2F 84 85 E4 CF 27 DD 49 79 A9 5C 22 60 69 3E' + 'FB FB EB 0A F7 FF B5 BC 1E BB C7 6F EF 65 58 B3 EE AE 66 63 38 8F EE 6E E6 C3 42 9E 62 AE E3 64' + 'C5 EC 8A 86 3D C5 EC 86 28 00 B3 9B A4 00 DC BC 26 88 62 9B BC C1 B9 80 7E C9 31 01 8B C5 3C 16' + 'CE F0 D8 5E 78 8F EC F9 15 D7 59 BA 39 E7 0A 9C 2B FB 7C C5 7F 2B DC 27 7B 6B 61 13 6E 1B E0 21' + 'F9 6B 71 EE C0 8F 78 AA F7 70 37 AF 8F 45 B1 DE 17 44 B1 DE B3 B8 96 3D E2 37 A1 51 21 EF 80 9A' + '23 47 16 77 07 1A 23 07 D4 38 51 DC 5A 2E 84 7C 8C FF 19 EF F3 81 42 53 19 81 42 D2 47 81 42 51' + '2F AA 7F A8 6F 4A 78 8A FB C0 04 35 9C 03 45 15 C5 6D E7 03 51 A4 15 08 7B 8A 0B B8 90 28 2E E0' + 'CB 1A A8 BF ED 7C 17 28 0C E2 A7 40 61 4A 3F 04 0A DD FD 12 28 2C EE 3E 75 03 F5 95 86 04 EB 14' + 'D1 72 A0 0A C0 5D 66 86 AC 58 F2 69 A2 78 AB F5 1D 4B 0F FA 26 97 1E 58 20 DD EB 0E B2 B7 E0 92' + '02 BB C4 BC 6E CA 25 03 B6 51 DC 02 C5 1D 16 D6 E6 12 02 F7 CB 3F 4F 78 AB F2 17 0B 6F 51 FC 57' + 'F2 8F 2C 6D 59 92 7A C6 DF EA E2 35 82 FB 3F D3 30 9C 0F 71 5E CD E3 E0 7B BA D5 BE 5B 14 73 FE' + '84 17 48 CF F8 C7 DB 67 39 1B A8 03 6C 1D D8 92 B3 00 7E 2D BD 24 E6 71 61 86 C7 AE D2 C3 F8 C4' + '0A AC C3 59 00 8B CB 7E 57 55 CC 9A A8 FC B6 C2 23 CA 2F 22 2C 28 7B 47 E9 EF 85 9D 79 B2 F5 72' + 'CF EC D5 F9 E9 71 2F F7 29 E9 25 1E 72 BD DC 8F C6 2E E0 4C 7A B9 1D BF 48 14 1B 61 5A C8 53 EC' + 'F8 A5 B2 E2 3A 5F 2C 8A 7D B8 4C 14 05 68 C6 85 01 BD 9B 43 00 BE C5 12 00 9F CD F0 BA 9D EC 07' + '85 AD 58 12 E0 37 D2 25 62 1E 97 0A 17 29 EF B2 B0 9B EC 45 A5 3B 09 EB B2 54 C0 42 6A 67 2C D7' + 'AD 77 7C DD C6 70 DD BC BA 8F 63 ED ED 66 B0 42 14 33 68 CD 61 80 76 66 73 C0 92 31 8F F3 D3 3D' + '1E 12 D6 63 37 C0 A3 8A BB 47 F8 AD FC 6F 73 BA C0 34 E5 DF 2B 1C CD 15 05 B6 57 5C 31 E5 5D 11' + '16 96 FD 57 0E A9 8F 5B 80 4B E6 29 16 60 46 C8 53 2C C0 DF 0A C0 B6 4B 09 7B 8A 13 E2 01 59 31' + 'A9 59 8A C5 A4 FE 94 15 D7 EB EF A2 58 A1 05 EC 0A B4 54 CC E3 3B 1C 32 F0 B0 EC 1D 84 CB E4 BF' + '45 BA 4B 86 C7 FA 2C 01 F0 56 E9 63 C2 EE 8A FF 41 7A B1 B0 0D 4B 0B FC 4E ED CC E6 00 EF 74 F3' + '5A 55 C2 53 CC 6B AE AC 98 C1 5D A2 38 B4 D6 28 00 C3 5E 2B 8A FB 43 11 B6 04 BA 3C E6 B1 01 47' + '04 FC 31 C3 EB D2 B2 2F 54 DC 11 E1 BB 9C 29 B0 2D 47 04 FC 5E F6 25 CA EB A1 BC 4A 7C AC 00 96' + '13 1E 97 BF A3 E2 1B B2 BF BE B8 7F F0 4B 45 60 23 EA 7E 66 A3 F8 E5 22 F0 76 EA FE 98 39 FD C0' + 'C6 D4 03 90 0F 9D 34 10 7B 56 D8 59 58 8B 71 C0 54 E1 1D 8C 07 36 21 0E C2 1B 5B 7E 17 33 D8 7D' + 'B7 33 DE FD 6B DC DC 30 D4 70 3F C1 1E 0A 14 9E E4 36 A1 4E 54 A7 C2 F6 19 77 D0 60 B7 99 3E 17' + '45 D1 9F E2 D1 3D 38 FE E6 EB 89 40 C1 B7 3B 50 D8 60 BB 02 C5 77 1A 6A 02 EA 4B 51 DE F7 42 9E' + '62 13 1E 50 B8 FF 46 73 5F A0 D0 F0 91 40 21 E9 50 A0 D0 70 44 4D 40 7D 1E F2 0E FF 76 AB 62 D8' + '3B A0 3E 95 C3 DF 10 BF 52 FF 50 8F 97 F0 14 ED 5C 53 8C FF 46 F3 6B C5 40 BD A3 0E B0 A1 42 6A' + '12 77 C1 88 28 EE 82 CF 68 3C FE BD D2 D1 40 61 48 DB D5 01 54 48 B4 7C C4 12 D4 24 6E 68 65 B8' + '6B 40 3B A5 7B 5C 9A E1 F1 3D EE 36 60 51 D9 7F 92 BD 84 F0 B2 EC CF 0A 9B F3 E4 04 36 E5 AA 03' + '17 C9 DE 4D F1 F7 A9 9F 55 FC 8E 1C 78 42 F6 9E B2 3F 6D 3E 7F 1A 6F 41 43 DC DB 9F 29 58 08 8E' + '79 88 AB 61 82 28 9F 3C 45 71 31 DD CB 66 40 7F 16 DE 1F F3 D8 8C C3 00 76 4E F7 FA 1E 61 49 C5' + '95 55 DC 51 D9 7B 49 A7 C9 FF 3E A7 0F BC 22 7F 6B 4E 0F 78 52 FE 62 B2 27 70 F7 0E 75 BB 77 22' + 'F6 40 A0 A6 E3 08 E2 54 86 FA 0F 8F F0 FE 92 F7 A9 A1 6E CB BF 26 3A CC EC 51 C5 8C 77 3F 69 B4' + '23 50 A9 66 8F 28 0C 2A 2B 17 6C A8 BB 00 B2 8B 62 A9 73 8A A2 3A B9 45 B1 49 B2 73 03 0C 8D 7F' + '29 FA AD 79 07 D4 73 1C 3B E8 E2 74 8F DD A5 9B B3 56 C0 73 9C 33 F0 17 D9 EF E2 A9 0F 2C 25 BD' + '4C B8 85 B5 00 F6 8E 79 FD 83 DA BB 55 78 4C 58 4E FE 2E D2 2B A4 5F E7 BC 86 B9 8F E1 A6 88 A2' + '44 EB 45 51 AA 59 2C C3 B0 78 51 66 07 0A 45 99 A9 30 A8 D3 FC 7E 74 58 FC FB D1 DF F8 61 95 57' + '39 B9 3F 86 B9 BA E4 0D 79 8A 80 DC B2 62 03 45 45 51 94 FC A2 78 A0 CB 2B 8A 6D 75 37 A7 0E BA' + '92 43 06 5E CD F0 78 3C DD 63 71 E1 F3 B2 B7 E2 59 0B 6C C3 D2 00 CB 2B EF 03 96 14 B8 5C 71 3D' + '84 A5 85 7D 14 F7 A3 DA 6B C1 A5 00 2E 91 EE 2A 7C 87 5F D7 0C 77 1F 1C BC CD 4F 0B 86 BB AB 63' + '24 6E 4B 5C DE E1 EE 90 FC 5E 94 BF 64 C9 2D 30 3C 7E 48 BE 10 28 FE AC 44 A0 70 96 BD 12 28 9C' + '41 97 D5 04 D4 F3 25 3C 45 4C 41 C5 F8 CF 9D 0A 07 0A AD E5 0F F9 30 A8 82 A2 38 75 0A 8B 62 01' + 'AE A8 49 1C 76 27 D5 24 3A 2A A6 00 2C 4B 42 D8 53 9C 69 59 45 71 A6 9D 51 2F FE 4C 3B AE 4C A8' + 'E2 72 F8 2F 4C 6F 53 06 54 11 35 89 33 AD 88 C2 B1 A6 C5 44 F1 90 5E 86 35 07 FD 55 58 21 E6 F1' + '4E E1 4F E9 1E 1F 90 6E CB B5 64 CD 15 DF 9A 6B 0C BC 4F BA 9B E2 4F 49 D7 90 7F 35 4F 38 60 4B' + 'AE 25 30 9D 7B 00 58 42 F1 4B 85 91 6B D8 BE 23 DC EF 66 8D 46 01 03 85 2B C0 AE 61 33 7B 15 12' + '45 4C 58 14 01 1B 79 19 8C 70 97 41 49 4E 71 84 2B F6 0B 1C 0A E8 6F C2 93 E9 1E 4B 0A 1F E5 94' + '80 19 1C 12 F0 C1 98 B7 F7 52 7C 2B 0E 19 D8 57 F6 8A C2 7B 95 5F 56 71 69 D2 F7 4B FF 2C FD 2F' + '2F D5 91 F1 13 EF 0F AE C8 48 B7 21 8B 8B 62 2D 4B 97 F0 14 3B A6 A4 AC 58 C8 D2 A2 98 C4 B7 A2' + 'D8 1B 65 45 B1 BC FD 38 14 D0 DE 19 1E 97 A5 7B 2C 25 7C 51 F6 18 A7 06 CC C1 D5 00 B6 E6 94 80' + 'BF CB FF 8B E2 BB 0B 3B B2 24 C0 15 F2 57 52 3F AB 84 E5 64 9F CC A9 8D 8A 7F 19 F0 26 CB 3F CA' + 'D1 F2 1C E3 28 37 B5 B2 25 3C C5 24 2A 8A 62 DB 97 0C 7B 8A F9 94 97 15 FB F8 36 51 4C AD 8A 68' + 'F5 88 AD 13 C5 11 F4 07 3B 06 2D 2F 5C 29 CC C3 89 01 5F 92 2E 9D EE B1 0D 27 CA DF E5 8B 79 BD' + '5A B8 5C FE FE D2 E7 59 20 E0 C3 DC A6 C0 AB F2 EF 0F A3 10 C0 E7 A5 FB A8 FD 29 BC A7 8D 76 FB' + '0F AF C9 7C 2B E2 69 6A C8 D3 31 78 9B C4 72 8C 76 BF F6 37 55 01 33 70 8C 8B CE C2 2D 82 A7 C0' + '68 77 4C FD 28 CA B7 E8 A2 28 DD 6D 21 4F 71 DC 54 11 C5 06 A9 26 8A 0D 52 83 D7 FD E8 F8 27 0C' + '3F 2B 13 EA 8D 12 9E E2 54 79 4F E1 BC 09 86 3D C5 A9 92 53 14 A7 CA 59 C5 A2 FE 35 14 8B E3 A2' + '9A AC 38 23 1E E0 A4 41 4F A5 7B EC 29 9C C4 FB 01 B0 82 FC 43 B0 6B B2 03 FF 94 6E C3 45 01 0E' + '88 79 5D 59 F8 21 8B 0D 6C CB C5 01 96 51 7B 77 2A 6F 32 7F 72 10 F8 AB EC 6B 94 F7 B2 FC F7 C9' + '5E 5F ED D7 E6 A8 C7 B8 8A FD 22 8A C9 BE C2 68 D0 BE C2 B6 8C 06 BE 90 EE F5 83 B2 F7 92 9E 87' + '37 E2 D9 81 03 63 5E 1F E4 D2 03 AB 48 FF A6 B8 8F 38 7A 60 3B 8E 1E F8 90 FC 65 E5 BF 5F 58 51' + 'ED FF 25 5C CC ED 30 D6 FD 48 C8 6A 5E 36 63 E3 1F B9 3D 2D E5 2F A2 63 0A C3 4D ED 94 28 DE FA' + '2E E7 DB 85 B1 EE 39 C9 1F 23 0F CA 87 8B 70 83 28 AC 8F A9 29 FF 8C F0 64 A0 F0 8C B0 55 61 50' + 'EF 8A 4E C3 35 C5 65 1E EB 36 DE F7 21 4F 51 BB 54 59 B1 25 EA CA 8A 4B B2 B6 AC B8 0E 5F 54 0B' + 'BB 40 39 5F D0 75 BC 74 80 FD 32 BC FE 98 75 02 B6 67 9D 80 55 63 DE BE 42 F1 83 A4 D7 0A 57 29' + 'AF 33 CF 1E E0 AB D2 7F 0B 2B 09 7B 2B BF 9C F0 77 E1 1B BC F2 C6 B9 2B EF 3D 8E 6E 9C 9B EA FB' + 'A2 B8 08 CF B1 1C E3 DC 23 29 AA F6 81 1C B8 0E 9B 28 F3 28 DE 76 72 B6 E3 5C 39 1A 8B A2 1C F5' + '79 99 8D 8B 7F 24 5E B7 84 77 40 35 52 0C 8A 73 BB AC B8 BD 36 14 45 9D 56 73 D0 A0 E5 D3 3D BE' + '24 EC 23 7C 38 E6 71 A5 74 7E 6E 52 60 7F E5 AD 67 51 81 1D 58 44 E0 3C 5E 72 FC 1D 63 F9 5F 13' + 'FE 23 FC 9C 9B 96 77 19 B5 77 81 8B 00 1C AC 7E AA 09 B7 73 F6 7E 97 3C 21 CA 5F 0D 10 C5 16 3D' + '2A 8A 6D F8 BC 28 B6 61 BA 28 9E F1 1F 10 45 29 33 58 D8 F1 EE F8 43 D3 EB E4 00 DD 26 87 EF E8' + 'F1 40 A1 AF 2D 0A C3 2B 26 C7 44 97 74 48 0E BC EF BD 83 85 1C EF 56 A3 A9 28 EE 22 CD 45 51 FF' + '9D BC 2C C6 BB 8F E6 A6 BA 3E 9E 52 53 DE B0 81 D5 83 7A 80 D5 00 56 CE F0 58 3D E6 F1 22 AB 03' + 'AC 20 7F 47 56 19 F8 3F C5 AD 53 DC 9D F2 77 E1 D6 04 0E 90 FF 4F D9 E7 73 55 80 2F 4B 0F 51 DE' + '1A C5 9D 16 2E E4 D4 26 B8 FA DE 2F DA CA EC 88 28 4A 7D 52 94 1F B2 71 53 4E 70 DB 79 93 AC 68' + 'E1 80 28 26 F7 0F F7 DE 04 77 F7 68 21 8A 3A 5D 35 4F 71 CB 68 59 C2 53 94 AC 8D 02 B0 97 5B CB' + '8A EA B5 92 15 BB B7 BD AC D8 BD 6D 45 B1 7B 2F B1 3E A0 0F 72 5E C0 6B 19 1E D7 C7 3C F6 95 FD' + '8C EC 9D 58 3F E0 46 D6 1D F8 8A FC 35 14 3F 9F 07 3B F0 2F D9 1F 52 5E 15 E1 40 E1 50 C5 57 54' + 'DC 74 CE 7A A2 AB D0 AF 9C DF 44 37 EB DF 44 31 EB 0F 78 81 4E 8C 3F DA BF 1F 28 F8 CE 07 0A 45' + 'C9 08 14 3F 42 53 13 50 1D E5 F0 9F FB 57 0B 67 2A 5C F1 9D 03 1F EE AD 7F 28 09 AA AB 1C FE 4D' + '40 5A A0 D0 44 C7 90 0F 63 BE 28 EE D8 35 D5 B0 FF 34 A4 46 D8 3B A0 AA C8 E1 3F 0D F9 53 7D 40' + 'BD 5B C2 53 0C B7 AB DA C9 19 B1 73 A2 7C 0B A7 46 70 57 CF 2B 8A BB FA 25 0D C6 7F 0B 70 21 50' + '18 DA E7 81 C2 24 3E 0D 14 FA F8 32 50 D8 22 DB D5 0D D4 47 72 F8 37 1F 6F 6B 54 50 3F 86 BC C3' + '7F F9 7C 45 19 50 DD 78 B9 80 AE E5 B2 02 FB A5 7B DC 10 F3 F8 09 B7 17 B0 33 B7 0D F0 75 C5 25' + 'CB 7F C2 7C 7E 55 D9 AF 0B FF 56 3B 83 A4 87 29 BE 16 0F 4F E0 1A 6E 3F E0 2A C5 55 12 7E C8 D3' + '62 D2 7F 3E 73 5B C0 7D 35 C9 5D 8F F7 89 E2 7A 3C 2C 8A DD 76 42 14 D7 E3 0C 51 DC 81 F7 8B E2' + '22 EC C1 32 4C 72 7B B0 97 28 D6 F2 36 76 08 FA 70 86 C7 D5 D2 1B 63 1E 6F C8 DE 93 05 02 F6 97' + 'BF 0B 0B 01 AC A9 B8 E1 C2 D7 E4 AF A6 BC 4D 9C 20 70 B0 F4 A7 2C 24 F0 1F C5 BD 11 8F 63 FE 64' + '9C 47 19 1E 07 A4 7B AC 2C BC 29 FB FF A4 47 28 BE BA EC 6B 64 3F 2D EC CA F1 01 53 14 F7 A6 E2' + '3E 63 FF C0 75 D2 FB 52 2D 31 CF 14 F7 A8 32 EC 3F 87 F3 DE 54 4B F8 FF E6 67 78 60 67 DA 7A 70' + 'F3 4C 71 E5 EC 53 C2 53 94 B3 8F AC D8 EB D1 B0 A7 D8 EB F9 45 B1 D7 FB 73 6B 4E 89 DF 9F FB 2A' + '13 AA 97 32 71 C2 0D 94 15 C7 DA 21 DE 24 41 87 F2 79 15 F8 10 A7 07 4C 8D 79 1C 29 DC 2C 3C 23' + '7F 8D 0C 8F D7 A4 07 0A FF 95 7D A8 B0 1B CB 04 AC 22 FF 7A D9 CF 0A 3F 67 B9 80 17 B8 8F A6 BA' + '0F 2D 12 F9 26 76 AA 7B 22 4B 08 E8 70 CE 6B 6A FC FB E9 BE 9C 8C 57 FD 45 71 21 6E 2E E1 29 02' + '06 07 74 A4 32 FD 57 D5 83 15 0E 35 5A 0E FF 55 F5 50 65 40 15 09 7B 5A 01 A5 52 38 AA F6 16 87' + '0C 3A 2A E6 71 83 F4 EB E9 1E AF 0B E7 87 70 07 04 6E 51 DC 20 D9 4D 3A 8D 25 01 56 95 7D 98 DA' + 'A9 25 FF 5A D9 37 73 67 03 BF E0 12 11 59 2A 60 B2 E2 C7 72 C0 D3 DC 14 D7 8B E2 88 1C 1E F2 14' + 'F3 1B 2F 2B 66 54 2C EC 29 66 34 54 01 98 D1 64 05 E0 4E 37 51 14 5B 62 30 FB 07 7D 3B C3 E3 70' + '61 35 D9 BF E4 38 18 2A FB C3 B2 6F 94 BE 21 FD 86 70 0B E7 01 AC 1D F3 7A B4 B0 17 AF 78 60 77' + 'D6 03 F8 88 EC 21 E1 3F 3C F7 A7 BB DB DB FF 44 B1 DC D7 44 B1 DC B3 B9 7E D3 E3 B7 A9 D1 21 EF' + '80 9A 2B 87 FF 7A 7A AC 1C 50 E3 45 71 F3 B9 18 F2 31 FE EB E9 0F 03 C5 9F D1 0A 14 92 3E 0E 14' + '8A 7A 5D FD 43 7D 5B C2 53 DC 29 26 AA E1 1C 28 AA 28 6E 4C E9 A2 48 2B 18 F6 14 17 6B 61 51 5C' + 'AC 57 34 50 7F 63 FA 3E 50 7C 07 1B 28 4C E9 C7 40 A1 BB AB 81 C2 E2 EE 57 37 50 5F 6B 48 B0 4E' + '15 2D 07 AA 00 DC 87 66 CA 8A 25 9F 2E 8A 77 B5 3D B8 04 A0 37 B9 64 C0 37 85 5F 71 A9 81 EF 64' + '78 BD 35 E6 71 84 74 75 C5 D5 91 7D 93 EC 63 A4 87 F1 54 01 F6 E6 52 03 D7 29 3E 2C 7F 8A E2 87' + 'C8 3E 93 5F 4F CF 88 7F 94 C0 0F 09 F8 D9 42 A6 61 3A 3F 2F F0 EA 2E 0E 7E 86 5B ED F9 A2 98 73' + '84 ED 82 4E E3 43 28 B0 AE F4 D7 9C 07 70 68 BA D7 67 85 EF 66 78 1C CE 71 02 FF 95 7D A4 EC A9' + 'C2 6D 6A 67 BD FC 7D 39 1F E0 66 F9 6B C8 DE 93 75 04 8E 55 FC 42 0E 6D A6 DB C2 F7 88 62 65 A7' + '87 3C C5 16 BE 57 56 5C C3 4B 44 B1 B1 36 88 62 37 2D 17 C5 E4 8E F2 1C 00 1D C6 CE 80 B5 32 3C' + '7E C3 C9 01 DF 93 AE 17 F3 D8 8B 83 01 6E 91 7D 94 F0 51 F9 C7 09 4D F6 64 B5 9B 45 F6 0D D2 6F' + '09 E7 72 2D 66 C5 D7 62 0E D7 C2 AB FB 39 C6 59 6E 12 2B 45 31 89 D9 5C 03 D0 F7 D9 3C B0 B6 F0' + '21 1E 07 C0 DE 1C 1E 30 21 E6 ED E3 85 DB 85 35 D3 3D 8E 56 5E 7D D9 37 CA FE B6 F0 11 F9 BF 64' + '79 80 C3 65 FF 96 65 01 86 E4 FF 8D 43 9B ED D6 E2 86 79 8A B5 98 19 F2 14 6B F1 8F 02 B0 A5 52' + 'C3 9E E2 EA 7F 50 56 4C EE 5F A5 61 72 7F C9 8A 6B 71 A3 28 16 EB 0F 51 2C D6 77 EC 1D 34 85 A3' + '61 FB 19 1E EB 08 B7 0A 37 C9 FF 58 CC 63 A2 70 8C FC 7D 58 25 E0 08 C5 35 90 FF 9C FC C7 38 6B' + 'E0 3B F2 4F 90 7F 0E E7 35 C7 4D 71 75 09 4F 31 C5 79 B2 62 32 77 8B E2 6C 7A 48 01 18 F6 C3 A2' + 'B8 0D D4 65 0F A0 DB 84 1F 08 B3 C6 3C DE C9 91 01 C7 CA 1E 11 6E 4E F7 F8 AE F0 24 AF 15 60 AA' + 'F4 F7 AC 0C 70 A4 F4 E3 6A 6F A2 B0 A1 B0 2E BF 2D 9E 8B 6B 8D DF 3A 13 D9 1F B0 1F 71 1E 90 F6' + 'BB B0 DD 19 07 EC 4F 3B 70 00 F1 6E 3C 88 11 1F C3 13 06 F1 71 9C 01 C4 27 70 A6 11 9F C4 ED 94' + 'B8 07 E3 E6 46 DE EF 7E 68 24 BB 28 1E 7C AF B3 3C A7 5D FD BE 10 E5 C7 8D 9C 0B E8 4D 9A 3E 74' + 'DE 1B A4 DF 38 FA A5 28 02 B7 32 F0 17 1C 28 34 FD ED BC 7F 3F 05 53 85 90 E5 E5 93 79 C5 90 ED' + 'E0 3C 6B 86 AC AB FB D1 FD 90 FD 43 7F 5A C8 52 A8 1F 08 59 56 5E 3F AB 42 76 84 7A 77 C8 7E 62' + '53 47 43 5C B0 DB 69 2A 13 B6 27 D8 44 DD B0 B5 70 3F B0 19 B6 96 C4 AE 61 DB EC 7E 4E 30 6C 69' + 'EE 07 BF C2 F6 88 FB 69 A2 B0 B5 23 F6 09 DB 5A 5E 82 C0 F6 D4 7D C3 B6 8D D8 2F 6C 1D 84 DB 89' + '03 C3 F6 98 FB CA 36 6C 9F 71 93 0D 0D DB E3 EE 0B 8F B0 1D A0 1E 11 B6 1D D4 A3 30 0E E2 E8 B0' + '3D 49 1C 13 B6 01 BB F9 B1 55 D8 76 B9 CF 08 C2 76 A7 7B F3 13 B6 67 DC 33 7E D8 F6 10 27 87 6D' + '2F 71 4A D8 F6 11 A7 86 6D BF 7B 22 40 FB EE 76 11 B6 83 C4 59 61 3B EC 36 79 D8 8E 10 E7 86 ED' + '59 E2 C2 B0 1D A2 7F 11 FC C4 7B 60 27 2E 47 95 88 F7 85 ED 38 F1 FE B0 9D 20 AE 08 DB 68 8E 6B' + '65 D8 9E A3 5E 15 B6 E7 89 AB C3 F6 33 4B BB 26 CC D2 9E A2 09 F4 2B 76 F1 70 D8 76 52 3F 12 B6' + 'DD C4 6D 61 6B CB 8F 22 9E 73 1F 0A 9C 28 89 AC D5 EE CE BD 34 E2 29 96 F9 B8 AC D8 04 C7 44 F1' + 'B4 71 5F 49 CB 42 EA FF 4A 69 CB 88 E5 E0 9F 16 CD 34 AC 08 DC 21 E7 CE 15 B8 61 78 20 70 37 73' + 'EE 3C 81 1B 86 65 81 82 2F 9B 7A 85 BA 5F 79 05 E2 BD E6 54 A4 37 AC 0C DC BE D7 DC 81 1B 86 07' + '03 B7 EF 35 6F E0 86 61 79 A0 E0 CB AE 5E A1 9E 13 85 75 15 7F 09 1F B4 A7 70 67 CC E3 AD D2 5F' + '48 F7 A2 5E 83 E6 84 5F C6 3C 16 97 DE 25 BD 86 FA A1 88 3D 1D F3 D8 5B BA 84 F0 2B D9 1B F3 1A' + '03 F6 A1 7D 2D 4E 38 61 49 E1 D7 31 8F BB 85 AF 73 C8 0F BB A2 2C 8B 78 8A 02 14 E5 0C 1F 8E AF' + 'D1 AD 81 82 EF 16 65 40 15 93 C3 17 B5 78 A0 10 56 44 61 50 7B D8 17 E8 DA F3 1E BF 91 BE 53 BA' + '94 B0 34 71 1D DA 10 3E 13 F3 F8 AD B0 AF EC 6F B2 E9 F5 AE CF E5 11 4F D1 E1 26 2E DA FA FF 6C' + 'B4 CA 1C 4F A6 61 4B E0 F6 4B 5E 35 70 C3 B0 35 70 FB 25 AF 1E B8 61 D8 10 28 F8 2A 69 00 50 9B' + '95 97 B9 D1 AA 28 D2 1B 1E 09 DC BE D7 6A 81 1B 86 6D 81 DB F7 5A 23 70 C3 B0 31 50 F0 DD A6 5E' + 'A1 DE 12 85 B5 1F 8B 02 FA 5D CC E3 5E E1 3A D9 CB 08 47 12 37 44 6C 5F CC E3 7A E9 ED C2 DF 64' + 'FF 1D 03 4B 02 F6 97 FD 7B D9 AB 49 97 15 1E 97 FD 63 0E 65 A3 9B EC 7D 11 4F 31 B1 8F 64 C5 59' + 'F0 A1 28 CE 82 A7 15 80 C7 88 06 9C DA C6 F8 E2 34 0A 14 3F 73 0F 14 8A 50 4F F9 50 0D E5 F0 B5' + 'BD 3D 50 48 BA 23 50 48 AA AF 24 A8 FD 1C 28 E8 80 F3 1E 2F 4B 6F 90 2E 27 2C 4F DC 14 B1 03 31' + '8F 03 A5 AF 48 6F 94 DE 44 DC 1C B1 0A C2 83 31 8F 83 A4 7F 90 1E 4C BD 05 EF 5F 62 1E 37 4B 57' + '14 1E 92 7D 0B F5 23 11 3B 1C F3 F8 93 70 88 EC 95 84 43 89 5B B1 A5 84 47 62 1E 6F 93 FE 59 FA' + '6F 4E 7D 9B 3F 5C 23 9E A2 3C ED 58 9E 6D F1 7A 77 08 14 7C 6D 94 01 D5 5E 0E 5F E1 8E 81 42 58' + '5B 85 41 0D 63 9F A0 95 85 BF C4 3C 6E 95 7E 56 FA 0E 9E 46 8F E2 AD 39 ED C0 AB 31 8F 55 A4 8F' + '4A 6F 93 FE 81 5D 6C 77 5D 1C A3 0B F4 57 E1 A3 E7 3D 8E 10 56 15 FE C3 FD FA 38 AE 57 6A E0 28' + 'E1 EF 31 8F 8F 49 9F 90 1E 4D BD 23 62 8F 0B FF 88 79 3C 29 AC 21 FB 65 0E E5 09 57 86 07 22 9E' + 'F2 23 E6 80 7E AF 00 6C F1 EF 44 B1 C5 D3 15 80 2D BE 3B A0 7D 59 C8 27 E2 65 ED 1F 28 B4 33 30' + '50 D8 B8 7D D4 14 D4 9F 1C 11 E8 98 F3 1E 77 08 93 85 E7 38 73 E0 73 8A 7B 9E F8 24 DA 3A EF B1' + 'A6 70 AC F0 2F F9 4F 11 9F 8A D8 93 E7 3D A6 08 C7 09 FF 96 FF 1F E2 4E BC 25 38 EF F1 29 E1 0B' + 'B2 8F 97 FE 1F 87 BC CB CD EC C1 88 A7 FC 13 2A 3C DA 76 FD E7 38 1E C3 79 66 1A F6 04 6E 7F 30' + '8E 0B DC 30 EC 0D DC FE 60 9C 10 B8 F9 B7 D1 03 05 DF 28 0D 00 6A B7 F2 32 8F E3 B1 8A F4 86 67' + '02 B7 EF 75 7C E0 86 61 5F E0 F6 BD 4E 0C DC 30 EC 0A 14 7C A3 D5 2B D4 75 51 58 6B B1 28 A0 13' + '84 2F C6 3C FE 4F B8 53 F6 83 6C EB 40 7C 94 93 D8 80 57 87 E5 F0 E3 DB 13 F1 0E A8 03 8A E1 5F' + '98 11 C5 7E 5B C4 21 1F F8 4F 99 C3 CA F7 86 C5 81 DB 37 98 25 70 C3 B0 34 70 FB 09 27 06 6E 18' + '16 04 0A 3E 53 AF 50 F7 28 2F B3 CC 11 45 7A C3 92 C0 ED 7B 4D 08 DC 30 DC 1B B8 7D AF 59 03 37' + '0C 0B 03 05 5F 48 BD 42 1D 95 C3 27 3D 2B 07 D4 21 51 58 9F 66 7D 41 5F 8E 79 BC 2E 9C 24 7B 1D' + 'E1 2B B4 1F 8C D8 7B BC 88 80 23 F8 39 08 70 F2 79 6F BF 21 7F 7F 3E FD 02 77 CB 5E 57 38 85 78' + '08 77 27 E1 1E E1 00 C6 03 6F E7 C9 07 7C 35 E6 ED 37 85 23 D9 0F 70 2A E3 0F 47 EC B5 98 C7 67' + 'A4 EB 0B FF 95 7D 20 DB 03 4E E1 14 8F F8 4D 1C F1 94 7F 93 83 15 39 12 5F EC 02 81 82 2F 49 19' + '50 F9 E5 F0 AB 53 30 50 08 8B 2A 0C 6A 1A FB 06 6D 20 EC 22 FC 83 35 02 9E 8E 79 FD AA EC 17 A5' + '4D BA 90 70 AF F0 3E E1 3E E2 B3 68 44 78 26 E6 B1 A1 F4 74 E1 CB 1C D8 D1 F8 96 9A C6 81 79 F5' + 'AA 1C 7E 33 ED 8D 78 07 D4 1A EE A4 A3 FF D9 FD 65 14 E9 0D 6B 03 B7 4F 2D 17 B8 61 58 17 B8 FD' + '96 AA 10 B8 61 58 15 28 F8 4A 69 38 50 0F 29 2F 73 F7 97 55 A4 37 3C 1C B8 7D AF E5 03 37 0C EB' + '03 B7 EF B5 62 E0 86 61 75 A0 E0 2B AD 5E A1 CE C8 E1 93 4E CB 01 F5 8A 28 AC 8D 58 49 D0 FD C2' + 'D7 63 1E C3 D2 33 84 AF 11 8F 61 97 0A DF E7 0A 03 0B 4B 77 15 CE 14 1E 10 BE 11 F3 F8 02 77 25' + 'F0 7E D9 23 C2 4B F2 CF E0 90 8E FB 9F 16 8F 78 CA DF 83 96 15 27 D8 7B A2 38 C1 CE 71 5E C7 23' + 'FA 38 7A 55 24 53 F1 5B DB C0 87 89 BE A9 A6 A0 52 E4 F0 EB 5C 2B 50 48 AA 13 28 24 25 AB 27 A8' + '54 39 FC 32 D5 0E 14 92 EA 06 0A 49 35 95 04 15 13 85 35 0B 67 09 7A 50 38 4B D8 58 F8 66 CC E3' + '0A EA 13 11 FB 24 E6 B1 9B F4 6C E1 1D C2 B3 F2 DF 22 7D 5A 78 48 98 20 FC 85 AB 03 6C 42 7D 12' + '45 13 1E 16 BE 15 F3 38 47 7A 11 BF 51 7A CE FD ED AE 15 A2 AD CC 9E 15 ED 69 F6 9C 68 2F B3 95' + 'A2 23 CD 1E 16 1D 67 B6 59 74 BC D9 41 D1 A9 66 47 0C E3 00 7D 9B FD 01 E7 9E F7 78 44 98 55 D8' + '54 F8 0E E3 9E C7 7A 9D F7 38 4F D8 4C F8 AC F0 5D C6 9D 8A D8 5D E7 3D 1E 15 36 17 66 17 CE E2' + '52 BC E0 16 EF AD 88 A7 58 B9 66 5C B9 17 E2 5B A1 45 A0 F8 17 06 94 01 D5 5C 0E 5D B4 81 E2 8F' + '95 28 0C EA 6E F6 05 DA 42 F8 5E CC E3 31 E9 1C C2 07 89 2F 46 6C BE F0 0D E1 FB 31 8F 31 AE 19' + 'F0 B8 EC 2D 85 9F CB DF 88 F7 07 60 4E D9 8B 09 7B 08 BF E2 90 5E 72 23 FF 5A 14 A3 CB 45 2F E8' + '02 E1 09 61 77 61 2B E1 03 C2 51 BC DB 00 3F 8B 79 FD BA EC E7 A4 AF 72 94 C0 A2 B2 E7 26 BE 8C' + '5B B0 B0 B5 F0 57 C6 01 4F 4A 7F 10 F3 B8 88 FA 15 3C 82 0A DB 08 F3 08 D3 63 1E DB 52 BF 1A B1' + '8C 98 C7 7B A4 9F 17 E6 15 CE E1 54 5F 73 2B F4 76 C4 53 FE A0 82 AC 38 37 3E 13 C5 B9 F1 05 97' + 'F0 B5 F8 B9 B1 3F 92 A9 F8 93 FD 81 0F D7 ED 59 35 05 D5 4D 0E BF 59 BA 07 8A BF 47 1E 28 24 75' + '51 4F 50 69 72 F8 AD D3 23 50 FC BE 3F 50 48 EA AA 24 A8 6F 44 61 5D CC D9 81 C6 62 1E DB 49 27' + '09 4F 09 5F 20 9E 8E 58 11 E1 19 61 7B E1 12 E1 4A 61 9A 70 90 FB 6C 16 D5 E5 2A 01 CF C7 BC 7D' + '34 57 1F 18 55 DC A7 B2 0F 66 FC 19 3C 9B D2 0E EC 20 CC 27 FC 30 E6 71 A9 F4 18 B6 03 CC 4F FD' + '7A C4 5E 12 DE 2B FC 28 E6 B1 A3 F4 AF AC C9 1B F1 9B E3 3C 16 C2 AB DF E5 F0 B7 C5 77 22 DE 01' + 'F5 18 EF 89 6F FC E7 3E 3E 44 91 DE B0 23 70 FB D4 61 81 9B 7F C9 31 70 FB 9B E3 88 C0 0D C3 A3' + '81 82 6F 90 86 03 F5 B8 F2 32 EF E3 43 15 E9 0D 4F 04 6E DF EB F0 C0 CD DF B6 0A DC BE D7 91 81' + '1B 86 ED 81 82 6F B0 7A 85 FA 4B 0E 9F F4 A7 1C 50 BF 89 C2 BA 8C 95 04 FD 38 E6 F1 65 E9 4E C2' + '02 C2 37 89 17 B1 C3 89 97 70 02 67 41 13 89 59 B8 D3 DF 23 4D CA E2 EE B0 A2 B0 46 48 F3 67 E1' + 'F8 8D B4 60 16 CE 34 26 CA DF E8 12 45 EC 4B A4 85 9C F5 A2 28 AC 9F 90 16 76 34 37 E9 2D AE 85' + '2F 44 71 89 16 11 45 DA 57 A2 FC FE 98 B4 A8 EB F8 1B D2 12 CE FA 13 69 59 97 96 47 14 69 BF 88' + '22 E0 57 D1 9C D8 3C A4 15 9D F5 6F D2 2A 8E FE 40 5A CD D1 F7 49 93 5D 0B 1F 88 C2 9A 46 9A EA' + '3A EE 42 5A DB 8D F7 BC 28 62 BB 8A 22 F6 65 D2 3A CE 7A 49 14 D6 4F 49 EB 3A DA 9F B4 9E 6B E1' + '4B 51 0C BD BE 28 D2 BE 16 45 6C 3F D2 06 AE E3 59 BC E0 6E CF 62 DF D2 D4 D8 79 7F 26 6D EE D2' + '07 88 22 FD AA 28 02 7E 13 C5 CC FF 20 6D ED AC 5B 9E E4 5F 75 CA 62 FF D0 D4 DE 99 1E A1 A9 43' + '16 FB 91 A6 8E CE D4 8B B4 A7 A3 33 48 A7 65 E1 B7 EF 33 49 A7 3B FA 31 E9 87 2E E0 02 E9 47 8E' + '5E 26 FD CE D1 2B A4 DF 3B 7A 6F 82 85 93 86 27 D8 A2 04 2B C0 1F 4A 99 96 60 50 05 45 C7 26 58' + '61 D1 F1 09 96 5F 74 46 82 15 22 BD DB D1 CE A4 EF 25 D8 C5 04 2B CD FF F2 01 B4 36 BF E2 01 D6' + '21 BE 9F 60 75 89 E7 12 AC 0C FD 1F 24 58 3D 6A 60 59 EA F4 04 2B 47 BC 90 60 E5 89 68 A7 02 F1' + '52 82 95 22 7E 91 60 15 89 DF 25 58 25 E2 E5 04 5B 70 D3 42 89 A5 13 ED B7 1B 96 25 B1 62 A2 35' + '4F B4 4A 89 56 33 D1 7E 95 A1 85 7B B5 4E B4 DB 6F 58 98 86 F6 89 D6 08 34 C1 D3 45 37 3D 4D 4B' + 'B4 32 89 DC 77 8E 2E BC E9 63 41 CB CA DA 3D D1 16 2B 16 F4 1E 05 80 96 57 40 8F 44 5B A6 00 D0' + '7B 15 00 3A 1D 01 49 A0 D3 12 6D C1 4F B8 7C 41 57 72 D4 40 93 7E 00 9A 89 09 D7 91 85 F1 57 4D' + 'B4 2D A0 11 4F 5F BE 61 91 04 D0 6A 89 D6 2E D1 1E 91 03 2A 51 E1 A0 5B 15 53 DD C5 64 95 03 6A' + 'AB C2 41 C7 80 26 F8 EA 8C 15 4D 49 B4 6C 8A 6D 99 68 DB 14 0B FA 39 68 16 4F C7 29 16 74 BC 68' + 'AB 44 7B 54 B1 A8 EC 17 8A 05 CD AE C6 DA 26 DA 04 C5 82 E6 90 15 23 9B 28 2B E8 60 4E 1E B4 B4' + '70 35 8A C0 16 1F 64 71 80 AB 58 14 60 48 FE ED C2 85 C2 35 F0 B3 DB B5 8C BB 2D D1 1E 62 1E B0' + '0B 4A 11 A9 EC 2A 87 21 3F CA C2 78 85 91 6C 0B 14 46 90 93 E3 F2 6A 3B A7 E3 69 37 E5 57 73 AA' + 'AB 32 BC 4A 0B 7C 68 3B 97 F2 A1 1E 53 3E 68 77 C5 54 77 31 8F 29 BF BA EB 7F 7B A0 D0 7F 6E E5' + '43 3D AE 7C D0 49 2C 51 65 B7 4C 93 45 B1 4C 3D D4 6A 4B 37 8E 9E 81 42 8F BD 02 85 FC 1D EA A3' + 'A5 EB F1 F1 40 A1 C7 3C EA 11 6A 87 7A 04 FD 92 0B E8 E9 14 F5 08 3A 55 14 8B FD 84 62 B1 C2 5F' + '29 16 74 9A 02 D0 4B 5E B5 0B 3A 5D 56 F4 96 24 2B E8 74 2E 1A E8 C3 5C 24 60 41 E9 DA 71 BB 70' + '03 17 15 B8 9E 9B 01 B8 8E 8B 0B 3C 22 7F 94 4D 56 71 35 98 C1 8E AA B8 3A CD 14 45 9D 66 89 62' + '02 5F 73 A8 9E 3E C9 09 78 9A 4F 2D 80 CE 56 2C 66 F8 8D 62 31 AD 39 B2 62 2E F9 15 0B 5A 40 14' + '73 99 AB 00 D0 67 39 2C D0 75 C2 CD 1C 36 70 0B A7 01 DC C8 E9 02 37 71 1A C0 3A 8A 9B 21 2C 24' + '7C 92 AB 54 D5 2D 26 FA 3A 15 28 F4 F1 14 C7 EE 55 41 0E C2 D3 6B 37 2C 1B 29 0E B7 52 66 9E 54' + '8C 9F 75 BD D5 80 DF 1E 7D B8 3D 32 D5 53 81 0F 5D 3D 11 28 74 B5 53 5D 41 15 52 57 A0 C5 79 5C' + 'FA EB 27 74 C3 5B 41 C3 A2 48 2B A1 00 D0 AD 9C 28 E8 36 16 02 F8 08 0B 00 7C 8C 13 05 2E 12 0E' + '11 36 13 86 85 65 84 8F B2 80 C0 17 38 BE 6A F1 0B 76 17 C7 E7 55 61 8E CF D3 BE 8A F1 33 BA 33' + '50 C8 B8 45 61 50 4F 2B 19 B4 18 07 EC 6B FD AF 02 40 6F 95 15 69 76 C3 5B 41 5B 73 44 A0 23 85' + 'F7 0A 9F 12 EE E0 48 81 59 A5 2B 0A B7 73 E6 C0 C7 59 09 9E 10 AC 0C 70 37 87 51 DD 0D BC 08 FB' + 'F6 B4 A8 28 02 8A 89 62 9C 7B 14 0B 1A B9 E1 AD 18 67 49 8E D3 D3 52 A2 18 67 16 05 80 16 E6 10' + '40 67 0A 8F 0A 9F E0 90 80 4F 72 28 C0 A7 38 34 E0 4E 4E 01 B8 5E 71 75 85 BD 84 BB 98 57 03 63' + 'A0 06 DE 23 7C 5C F8 34 DB 03 F6 E5 C8 93 DD FF B8 79 8C 2E D0 0D C2 5B 84 BB D9 14 70 0F 53 80' + '7F F2 36 8D 2B 38 35 D1 DA B8 DD DB 8F 6D D4 74 6D 5C 97 EF AD F8 CE CE CF 46 60 38 24 7C 86 8D' + '01 1F 92 DE CB 46 81 FB 89 38 0B 9E A4 1D B8 54 98 28 DC C7 3C 60 7F 5E 18 A9 AE FE A8 FB 00 6E' + '9C D4 F8 9D E2 56 8E C3 AB 5A A8 6C 16 4F 9F E1 82 78 DA 4F C9 7E 0F D6 56 0C 54 71 65 82 EE 55' + '38 E8 4E B5 EE D7 ED 74 A0 B0 5E FB 14 06 55 42 C9 A0 75 D4 24 68 65 2E 73 AA 3B EA F2 DC F0 01' + 'A0 83 35 02 7F 4B 18 14 28 74 37 50 1D 78 35 24 50 78 0D 0D 22 F1 FA F6 BA EF 06 B4 A4 3A 07 DD' + 'AF 21 81 D6 BC E1 29 CE 95 EF 14 0B 7A 4D B1 98 4C 61 8D 0E F4 16 51 4C EA BA 02 78 D7 61 DD 41' + '1F 10 EE 15 1E E0 3A 00 0F 72 BD 80 9D 64 9F 20 AC 2E 3C CC FD 09 3C C4 FD 0A 1C CD E9 D4 8A 1F' + '0A 75 59 27 AF B2 B3 38 9E 56 E3 A8 3D 2D CF 41 79 3A 8A 53 AF 15 BF 7F 8F 54 3B 3A 1F 02 85 56' + 'EB A9 55 A8 EA 6A 0A B4 82 9A 02 CD A1 BE 40 73 8A 62 A5 EA 2B 0D B4 A2 62 41 6B A8 05 D0 DB 64' + 'C5 FA E5 56 1A 9F C7 34 2E 7F 07 1F A3 91 78 35 3E F0 F1 69 2C F0 E1 55 49 AD F1 61 44 AD 81 7E' + '7F DD 0F 02 34 59 3D 83 5E 96 15 8B 97 22 2B E8 8D EB 3E 0D 8B 57 44 8D 81 DE 94 15 85 28 2A 2B' + 'E8 31 AE 03 E8 34 AE 0B B0 80 F0 B0 B0 96 F0 08 D7 15 B8 56 FA 59 AE 2F B0 BB F4 51 AE 23 70 18' + 'E7 52 DB 95 10 AF E1 9C 67 A6 DA 15 F8 D0 73 29 8E C7 AB 03 DC 99 9E 1E 14 45 91 AA 70 94 B5 5D' + '2D F3 DE F0 B1 A0 7F F0 04 A9 ED CE 8E FA AE 06 FF BB 61 F9 64 68 EB 6E 9C FF 7D 87 00 59 DF F1' + '76 71 D9 C6 1D 4C 2D 5C EA 3F 18 50 90 FA 4B A0 CE 25 DA 6B 1A BA 5F 94 11 1A BA 57 87 34 48 D0' + 'D2 9A 05 A9 C6 8B A6 12 34 5E D0 32 B2 62 00 89 B2 82 9E 64 B9 40 27 B3 7C C0 A8 F0 39 2E 07 70' + 'B5 F4 09 96 19 D8 55 FA 80 B0 A6 F0 38 97 05 58 86 C3 A8 E3 AE 87 C3 1C 9C A7 13 38 EA 3A F1 47' + '90 DD 81 C2 08 CA 2A 03 EA 88 32 40 27 2A C6 DF A0 26 B1 06 99 AA 9C 32 A0 9E 55 06 68 D2 0D 6F' + 'C5 D2 54 E5 54 3D 2D AF 58 A4 1D 55 2C 68 59 05 60 30 59 95 06 5A 4E 56 0C 2A 9B AC A0 45 38 43' + 'D0 3E C2 D9 C2 E3 C2 17 58 41 E0 29 56 08 58 5F F6 8D C2 E7 59 19 E0 8B AC 28 F0 18 87 51 D7 5F' + 'F1 1C 9C A7 93 39 DF BA F1 33 75 0A E7 9B A9 A6 06 0A AF 69 41 24 46 57 51 4D 40 35 E0 F1 E0 69' + 'EA 0D DF 07 68 94 93 AA EB E6 F7 87 62 41 F3 C9 8A 16 FE 94 95 B3 E6 90 41 97 09 47 09 5F E6 D4' + '80 2F 71 2A C0 57 38 65 E0 4E F9 5F E5 D4 80 0D 39 82 7A AE DB E3 9C A5 A7 95 D8 81 A7 AF B1 01' + 'D0 39 4C 04 9E 66 C3 C0 A2 D2 27 84 67 D8 01 F0 75 36 0C DC 24 FB 74 CE BD 7E FC ED D7 AB AC 4B' + 'A6 BA 8D DD 78 75 82 9D 7B FA 17 AF D2 FF 5E 79 33 95 E4 8B 39 43 0D 7A 35 2B 50 A8 D1 B3 81 E2' + '85 A2 36 A1 2A AB 27 D0 FC AC 63 7D 17 FE 97 AC 7C 9E 97 15 69 7F CB 0A DA 99 93 00 7D 83 45 00' + 'BE C9 C9 03 6B C8 FE 16 27 0B 3C CB C9 03 F7 C9 3E 51 F8 A0 30 AF B0 0A 9B 6E E0 66 F9 1C 07 E7' + 'E9 6C 8E BA 41 7C 46 73 03 85 71 CD 09 14 C6 53 55 F9 50 CF 2B 9F 47 91 AC 08 2F C8 69 78 FA 3F' + '59 91 56 48 56 D0 CD 1C 09 68 43 E1 DB 9C 19 F0 1D CE 0C D8 57 F6 B9 C2 93 C2 77 39 43 E0 7B 9C' + '31 B0 98 EC 93 6F 62 FF 34 71 9F 9D FC 7A DD 22 A4 FE BF 6B 9F 29 07 D4 6F 72 F8 FF AE 7D B6 1C' + '50 BF CB E1 FF BB F6 B9 72 40 DD 25 0A EB 7C D1 6E B8 5C 39 E5 A6 FE 76 CE C9 79 FA 82 AC BC 33' + 'CB 0A 7A 17 F7 4C D3 F8 F1 33 8F 55 CC 54 35 14 06 F5 A2 92 41 5F 52 8C AF F4 4B 72 F0 9E A9 70' + '3E FB 88 A2 BC F3 F8 AE CF D3 BB 44 91 96 A2 00 D0 FD AC 10 E8 07 AC 1C 30 9D 95 03 BE CF 8A 03' + 'CF B1 E2 C0 49 8A 5B 25 4C 12 26 0B 5F E6 48 9A B9 49 A5 B2 75 4F AF F2 86 D3 2C 7E C3 B9 9B 63' + '6F 16 3F 7C 0E 73 EE 99 6A 7E E0 C3 EB 60 A0 30 C6 5A 6A 10 EA 15 75 03 7A 37 E7 D3 CC 4D AD B6' + '02 40 EB 88 22 6D BE 02 38 61 8E 12 F4 A0 30 83 B3 03 AE 91 CE 27 8C 71 B6 C0 6E D2 1F B2 1A C0' + 'F3 AC 0E 70 8A EC 0B D8 74 73 F7 84 5F 97 1D 7A 5A 4F 14 CB FD 2A C7 E9 E9 6B A2 98 64 7D 05 80' + '36 10 C5 92 9E 56 00 68 43 59 51 AF 85 EA 02 F4 8C 02 40 AF F0 71 C8 D3 93 AC 51 F3 78 C5 5E 61' + '35 33 D5 D1 C0 87 D9 FF A0 24 A8 45 6A 15 B4 91 FA 02 7D 5D 1D 80 DE 2E 2B 4A 79 8F 62 41 17 8B' + 'A2 B1 C6 0A 00 1D C3 6A 80 7E C4 6A 02 3F 66 F5 80 95 65 CF 21 BC C0 EA 01 2F B2 9A C0 3F 6F 62' + '74 FE 9D 7F 1A 6E 1E 50 89 99 EA AF 40 75 C7 21 17 44 42 FD 2F 50 3D 70 9E 04 91 50 D7 F9 29 A6' + '57 D7 F8 29 A6 A7 F7 B0 2A 2D DC 32 E0 B5 F8 86 CF F7 EA 44 E0 C3 BC 9F 0B 7C 7C 0B 1B 28 CC F3' + '0D 96 C7 AB 3B AE FB B6 41 8F 28 DF 3F 87 2F 50 86 57 8B 02 85 EA 2D 0C 14 5A 6B A2 26 A0 DE 54' + 'C3 A0 4B D5 9A BF F6 97 28 C3 AB A6 CA 80 3A AB 0C D0 7B 15 E3 AF 9F 65 CA F7 EA 99 C0 87 1E DF' + '52 12 1B BE EE CB 04 FA 23 77 85 A7 CD D4 01 E8 DB 8A C5 0D 6D A9 62 31 83 E6 0A 00 6D 21 8A 76' + 'EF 55 00 E8 FD 5C 6A D0 2A C2 9C C2 F6 C2 4F B9 05 80 9F 71 0B 00 3F E1 56 01 EE 96 FF 12 B7 10' + '70 19 9B 6C E9 D6 6E 05 67 D4 32 FE 3E 77 4D A0 30 F7 95 81 C2 BF 2F 72 B6 2D E3 AB F5 0E 67 20' + '1F C7 EA E9 72 65 F8 37 BE BF F3 E6 DD 32 BE 5A 35 12 ED BE C0 8D 7F EF 57 83 7E C1 DE 55 83 50' + 'AD D4 20 E8 03 CA F0 9F 84 3C 18 28 3E A3 28 DF BF 51 7E 4F F9 50 AD 95 0F 7A 40 31 7E 89 96 6B' + 'DE 78 BD AF 70 BC DA 28 9C 37 59 51 AC 40 3B 51 A4 7D CE B2 71 82 2C 23 DF 4E 09 57 08 C7 09 F7' + '08 BF 62 F9 81 5F B0 FC FC 0C 95 CB 02 3C C6 E1 B7 8A D7 FA 79 0E 2D 53 AD 0F 14 22 37 04 91 50' + '1B 03 1F 06 76 26 50 18 5B 7B 0E D3 AB 73 9C 92 A7 0F 2B DF 17 7A 9D 32 FC 75 72 28 50 C8 EF A0' + '7C A8 0F 94 0F DA 51 56 54 30 5D 56 D0 FB 58 BE 56 EE B9 FC 7E D1 14 3C 45 A8 3D 5F B6 4D 81 42' + 'EB 3F 71 F7 7B B5 42 19 A0 9D D4 3A 68 86 5A 07 5D A9 00 BC 62 B2 E2 F2 F8 59 2D 80 76 56 1A 7A' + '79 40 B1 A0 5D 64 45 6F 0F CA 0A DA 91 4B 01 3A 5E F8 1D 97 04 F8 2D 97 02 98 5B F6 67 84 5F 73' + '89 F9 59 2F 97 0C B8 52 F6 6A C2 F3 1C 51 6B FF A9 3F 3B F4 F4 21 96 B9 75 FC 53 96 B5 81 C2 AB' + '9B C2 40 3F 54 32 68 9A AC 18 78 77 51 8C F6 23 05 4C C2 9B 18 76 08 FA 3D 07 04 FC 81 03 07 0E' + '93 7D B1 F0 32 07 0A BC C2 09 01 FF E6 B5 F6 DF F7 A4 E5 F8 DD 53 1B 77 A2 2F E1 51 ED E9 52 1E' + 'E0 9E CE E0 77 4F 6D DC 77 4F 3F B1 31 D0 1F D9 29 70 09 3B 01 3E 21 4C 10 AE 62 81 DB BA 71 F6' + 'E7 E8 3D FD 99 59 A0 DF 5D C3 50 80 DF 03 B3 F0 7D 30 5B 05 EE E3 96 68 17 DF B0 3D 98 E8 D5 C7' + '9C B6 A7 7B 15 E3 37 65 4F C5 40 5D 50 0C E8 45 51 7E FA A8 00 D0 D5 1C 53 3B B7 29 D7 88 62 53' + '3E C2 B5 68 17 5F 8B 2D 6A DD AB FD 81 C2 BF BD D5 14 D4 43 CA 07 BD A4 BE 40 7F E1 0E F4 74 AD' + '02 B0 21 3E 51 00 4A 7F 55 01 A0 0F 2B 00 B3 EE A3 76 F9 B1 B3 28 5E EB 14 80 D7 E5 6B B8 B3 B6' + '73 4B 81 73 F8 CA 35 3F 28 AF EC 7A A6 0F C5 59 7F DD 4F C6 AB 50 E0 43 51 36 04 3E A8 8D 81 42' + '69 86 5D CF 6C 13 D5 19 1E 28 14 68 53 10 89 89 7D CA 87 EF 4C 35 22 88 84 0A 07 FD F1 73 B1 C0' + '87 2A 6C 0E 5A C1 EC 3F 0B 5A E1 95 1B CC 08 5B E7 A7 60 B6 50 FF 04 0A F5 19 15 B4 09 15 B9 FE' + '5F DF B5 6B 99 3D F0 7D CC B5 FF 46 66 09 22 F1 EF E8 A0 15 FC FB 6B D0 C3 69 BC EB 08 F2 A0 AE' + '06 EA 0C D6 37 88 84 FA 23 F0 BD 8E 3B 58 E0 83 FA 2B F0 BD 87 E7 AB C0 07 F5 77 30 4E A8 1F 02' + '5F 06 2E AB 20 0F 6A F9 4D BF 1B A0 EE BF E9 37 11 E8 8A 9B 7E 13 81 DE 77 D3 EF 11 D0 0A BC 88' + '3D 9D C5 CB B5 9D BB 5C 6F E3 E5 C8 AD 25 1C 2D FC 8D 67 01 30 BB F4 2E E1 72 E1 EF 3C 4B 58 1B' + '5E 98 C0 AB BC 70 81 B7 D2 3F 01 6F 63 84 03 89 13 13 AD A4 B0 0B 2E E8 C4 C9 38 F9 80 09 C0 51' + 'BC D0 67 A3 5F 5E E8 C0 11 F4 03 47 D2 0F 1C 44 FF 9C 44 1B 4C 3F 70 00 FD C0 81 F4 03 BB D3 3F' + '17 47 01 FD C0 6E F4 03 D3 E8 07 F6 A6 FF 6E 5C 42 F4 03 7B D2 0F EC 45 3F 70 28 71 7E A2 0D A1' + '1D 38 9C 71 C0 61 CC 03 F6 A5 7F 01 AE 3B FA 81 FD E9 07 F6 A3 1F 38 8B 78 0F DE 7D D2 0E 9C C1' + '38 E0 4C E6 01 A7 D1 BF 38 D1 A6 D3 0F 9C 42 3F 70 2A FD C0 BB 68 5F 8A 7A 31 0E 38 97 76 E0 1C' + 'C6 01 17 D0 7E 2F 9E 48 19 07 BC 9B 76 E0 7C C6 01 97 13 97 E1 31 8C 76 E0 62 E2 0A 1C BB B4 03' + '17 51 AF C4 73 35 35 F0 5E E2 03 38 BC 69 07 AE A4 5E 8D 3D 43 0D BC 8F B8 01 DB 89 76 60 09 AE' + 'DB 76 F4 2B 1C CF 71 EC C0 73 0A C7 05 1C C3 78 E0 58 C6 03 27 12 9F 4C B4 09 B4 03 27 33 1E 38' + '89 F1 C0 D5 D4 BB 70 D7 A5 1F F8 20 E3 81 AB E8 07 66 10 9F C1 6D 9B 71 C0 0F 18 07 4C 67 1C F0' + '21 E2 3E 9C CF B4 03 1F 66 1C 70 2D F3 80 9B E9 3F 80 33 89 7E E0 23 F4 03 B7 D0 0F 5C 4F FF 21' + '1C 9E F4 03 37 D2 0F DC 40 3F 70 2B ED 27 12 AD 38 E7 0B DC C6 78 60 7F E9 47 E9 3F 99 68 DB 69' + '07 3E C6 3C E0 E3 6C 07 F8 0C F1 54 A2 3D CD 38 E0 6E C6 01 F7 30 0E F8 32 AF C2 97 DC 55 F8 14' + '5D A0 4F 32 14 B8 93 21 C0 5D 6C 02 F8 19 ED AF E1 91 91 71 C0 8F A8 71 E4 7C 4C 0D BC 74 0D 17' + 'FF 19 77 15 CF E4 05 ED E9 79 46 81 7E C8 28 E0 05 6A 1C 38 17 A9 81 5F 50 BF 81 07 49 6A E0 27' + 'D4 67 71 6C 53 03 6F 10 DF C2 DB 33 DA 81 FF 72 34 C0 9B 1C 1D F0 1B 22 8E A5 6F 69 07 7E C5 38' + 'E0 D7 CC 03 1E C0 A8 12 CE B9 09 7E C0 B9 7A BA 9F 63 F5 74 2F 13 40 F7 31 01 F8 04 13 32 9C 6B' + '07 A3 3C 7D 91 B9 9E DE 96 1D B4 52 76 6B 94 DD 6A 92 26 3B 5A 8B 34 D5 D1 B3 A4 67 B2 DB A9 EC' + 'F6 96 E8 F9 EC D6 3E 27 7F CA 29 A7 35 CE 69 6D 44 7B E6 B4 0E A2 BD 72 DA 5A D2 35 39 ED 7C 4E' + '7B 93 F4 74 4E 3B 95 D3 DE 12 85 F5 2C E9 19 67 6D 93 8B FF D7 66 2E EB 99 CB 5E 24 7D 21 97 65' + 'E4 B2 B3 B9 2C 62 A7 73 D9 CB 4E BD 49 87 57 67 44 61 7D 5D 34 96 CB DA E5 66 23 B9 AD 71 6E EB' + '20 DA 2B B7 B5 27 6D ED AC 1F 93 7E 94 DB DE CC 6D 97 72 A3 69 D0 77 9D BA 28 07 D4 27 A2 9F E6' + 'B6 D4 3C 58 F5 8E 79 2C 25 8F 5D 24 DD 9D C7 36 E6 B1 4B A2 DB F3 D8 21 D2 B7 F3 D8 C1 3C 96 2B' + 'AF 85 C2 39 F3 DA CC BC 16 49 3A 98 D7 26 E7 B5 05 79 6D 36 D5 A1 B8 AA 90 84 A6 CB 27 59 F5 24' + 'BB 9E 64 A1 6C 17 93 6C 02 FF B7 7A 8B DA E0 A8 D5 AC 69 A1 24 D0 ED FF 5A 28 17 70 50 8A 85 E8' + '7A 8C 3A 14 B5 14 FA 81 13 99 12 76 29 83 19 02 BA 83 21 C0 5A 0C 01 4E 62 48 C4 85 D4 A5 09 F4' + '29 86 00 87 30 05 B8 93 3A 4B D4 EA D1 0F 9C CC 94 04 97 52 9F 26 D0 5D 0C 01 0E 65 0A 70 0A 43' + '12 5D 48 53 86 80 1E 60 08 70 18 43 80 53 19 92 D5 85 0C A7 09 B4 19 43 81 07 19 0A 3C 44 CC 16' + 'B5 E6 B4 03 A7 31 25 BB 4B 39 42 17 E8 08 A6 02 5B 32 04 F8 2C ED 39 A2 D6 8A 1A 38 9D 29 39 5D' + 'CA DD A2 13 A2 36 92 59 A0 AD 19 05 3C CA 2C E0 0C 86 E4 72 D1 77 A5 58 16 52 44 C3 31 2D 6A C7' + '18 03 43 1B E6 00 47 B1 0D 60 5B EA DC 51 3B 4E 3F 70 5E 8A 25 64 CD E3 DA 38 1A 35 2C CA E8 A8' + 'CD 64 BB DE 76 82 61 A0 ED 98 06 1C CD 66 80 B3 18 92 D7 85 9C 64 08 E8 18 BA 80 ED 19 0A 9C CD' + '90 24 17 D2 81 26 D0 B1 0C 01 3E C7 14 E0 1C 86 44 5D 48 47 86 80 8E 63 08 F0 79 86 00 E7 32 24' + '9F 0B 39 45 13 E8 78 86 00 3B 31 05 38 9C 58 00 C5 25 16 8C 5A 13 62 D1 A8 ED 67 3C 70 02 F5 AD' + 'D8 08 C4 E2 58 6D 62 09 2C 29 B1 54 D4 0E 33 AE 74 D4 5A 50 03 A7 11 CB 60 31 88 65 51 66 62 45' + '94 85 78 1B E6 4E AC 82 09 12 AB 62 16 C4 6A 18 2A B1 3A 4A 4A AC 81 35 21 A6 60 25 89 75 A2 36' + '9F D8 24 6A 0B 88 AD A3 B6 90 D8 21 6A 8B 89 BD A2 B6 84 D8 3B 6A 4B 89 7D A2 F6 28 C7 35 08 5B' + '90 1A D8 99 88 3A BC 4C 3B B0 0B F5 90 A8 BD 42 0D EC 4A 3D 34 6A AF 52 03 BB 51 0F 8B DA 6B D4' + 'C0 34 EA E1 51 3B 4D 0D EC 4E 3D 22 6A 67 A8 81 6F 12 47 46 AD 07 ED C0 B3 D4 A3 A2 D6 93 1A F8' + '16 35 B6 47 2F 6A E0 DB D4 63 A2 D6 9B 1A F8 0E F5 D8 A8 F5 A1 06 DE 49 1C 17 B5 77 69 07 F6 A5' + '1E 1F B5 73 D4 C0 0F 88 D8 B0 FD 68 07 A6 53 4F 8C 5A 7F 6A 60 06 F5 A4 A8 0D A0 06 C6 A8 27 47' + '6D 20 35 F0 3C F5 14 1C 27 D4 C0 C1 C4 A9 51 FB 98 76 E0 10 6A 5C 0A 17 A8 81 43 A9 A7 47 ED 22' + '35 F0 5E EA C5 51 5B 46 5C 12 B5 E5 C4 65 51 BB 8F B8 3A 6A F7 13 D7 44 6D 05 71 6D D4 56 12 B7' + '46 ED 01 E2 F6 A8 3D CE 76 9E 8E 5A 2A 35 B0 36 71 4F D4 9E A0 1D 58 87 FA 99 A8 3D 49 0D 7C 9A' + 'B8 3F 6A 0D 68 07 36 24 1E 88 DA 6E DA 81 8D A8 0F 46 6D 0F 35 F0 19 E2 A1 A8 DD 4E 3B 70 2F F5' + 'E1 A8 35 A6 06 EE A3 3E 12 B5 3B A8 81 23 89 67 70 A9 13 5F C7 B5 4A 7C 0B 17 26 F1 1D 5C 7D C4' + '0F 70 89 11 CF E3 3A 22 7E 84 63 97 78 09 67 2B F1 D3 A8 2D 22 5E 8D DA 3D C4 5F A3 96 58 0C 87' + '7B 42 31 AB 5D CC B2 91 66 75 34 07 69 76 47 73 91 E6 74 34 0F 69 6E 47 F3 91 46 1D 6D 48 DA C0' + 'D1 DB 49 1B 39 DA 84 B4 B1 A3 4D 49 EF 70 B4 39 69 33 47 5B F1 87 95 C3 C5 AD 3B B1 50 71 EB 41' + '2C 5C DC 8E 11 6F 2D 6E 7D 88 C5 8B 5B 3F 62 F9 E2 F6 14 71 6E 71 7B 9A B8 A4 B8 45 4B E1 CE 95' + '54 CA 52 F8 D7 69 F2 97 B2 9A C4 02 A5 AC 37 FF 6A 0D B0 57 29 CB 92 94 02 7F FC 55 AB 14 6E 6A' + '99 2A 95 FF 75 9D A7 75 E9 A8 5D CA FC AB 0E 1D 9E 7E C3 3F 60 B3 AB 94 6D 2A 8D 51 AF 2A 6D F5' + '22 F6 3D 97 05 F4 32 71 75 69 DB 4C D7 1A E7 BA 42 13 E8 0F C4 87 4A DB 5E BA D6 3A D7 DB A4 EF' + '39 FA 2E E9 39 47 DF 21 4D 77 F4 15 FE 60 7D B8 8C 15 14 5E 88 79 5C 2E DD 59 98 A5 0C 52 22 65' + '98 B2 8B A6 AC 65 AC B6 F0 A5 98 C7 89 D2 D7 A4 B3 33 25 9B 4B C9 45 9A D3 D1 26 FC BD A0 68 19' + 'BB 9F 7F A8 26 5F 19 9B CB 3F 96 0A 2C C7 90 B2 2E A4 02 69 79 9F 58 19 B5 AC 52 C6 32 5F D5 CA' + 'A0 64 99 AA 2A 22 A5 92 E9 A8 5E C6 FC AB 06 1D 9E 36 65 6B 8D 5C 6B 2D 48 9B 3B DA 9A B4 A5 A3' + '6D 49 DB 38 3A 9E B4 A3 A3 43 48 07 3B 3A 89 74 98 A3 93 49 87 3B 3A 8D 74 8A A3 D3 49 A7 3A 3A' + '8B 74 86 A3 B3 49 67 3A BA 80 74 8E A3 0B 49 E7 3A FA 19 E9 3C 47 3F 27 BD CB D1 C5 A4 8B 1C 5D' + '42 7A 8F A3 CB 48 97 3A BA 9C F4 5E 47 BF 20 5D ED E8 97 A4 6B 1C DD 43 FA 98 A3 CF 90 EE 74 74' + '2F E9 2E 47 F7 91 EE 76 F4 32 E9 41 47 AF 90 1E 72 F4 07 D2 C3 8E FE 48 7A C4 D1 EF DC 53 53 79' + 'FB 91 F8 68 79 FB 89 78 B6 BC 0D E4 6E 5D 72 9B 0D 22 2E BD CD 26 56 E3 DF 16 AA 66 5D 79 41 84' + '92 6D 98 7B 20 4B B6 28 2F 14 E0 60 D7 4E B2 E5 A3 06 DE 41 CC 96 6C 4D 88 D9 93 ED 76 62 8E 64' + '6B 4C CC 99 6C 43 DC 43 47 B2 35 A5 06 36 23 E6 4E B6 A1 EE 61 23 D9 9A 53 E7 49 B6 16 C4 BC C9' + 'D6 90 98 94 6C 8D 88 D1 64 AB 93 CC 3B 7A B2 55 BE 1A 8A 24 15 48 E6 7F 4F 58 10 AD FD EA 55 F6' + '4E 54 CD A4 56 38 D5 5A EA 52 37 AA E6 52 CB FB 52 B5 94 4A 1B 42 D5 46 AA D7 70 AA 26 52 55 47' + '52 B5 90 3A 3E 89 AA 95 D4 F9 19 54 F5 DD A1 91 6C FD DD A1 91 6C 0D A8 61 1F 40 0D 2C 4C 5D 28' + 'D9 6E 21 16 4E B6 B5 C9 7C 3E 4F B6 8D C9 D6 81 B4 BD A3 9D 48 3B 3A DA 85 B4 B3 A3 DD 48 BB 3A' + 'DA 9D 34 CD D1 9E A4 3D 1C ED 4D DA CB D1 3B 49 FB 38 DA 8F B4 AF A3 03 48 FB 3B 3A 88 74 A0 A3' + '43 48 07 3B 3A 9C 74 98 A3 23 49 47 38 3A 9A 74 94 A3 93 48 27 3A 3A 59 74 53 B2 4D 25 9D E2 AC' + 'D3 44 61 9D 41 3A DD 59 67 8A C2 3A 9B 74 96 B3 CE 11 85 D5 7E 0D 85 F3 CC 4D E6 FC E7 D1 3A D7' + '05 DC 25 8A 80 6D A0 39 96 25 DB 7D C9 B6 95 FB 03 DE 6D 44 B8 B6 32 EA 11 3F 68 9A B6 27 F3 4F' + '74 27 E4 79 2C D9 DE 75 B9 D7 93 ED 75 EC 15 FE FD 5C D8 AE 24 5B 46 B2 21 28 AC A0 DF 92 ED 43' + '17 07 1E E1 1F 74 7D CC A5 20 EE 3D 3E 3B 42 4D 66 B3 C0 51 C4 C7 93 2D 0B 33 77 24 DB 59 97 BC' + 'CF 75 9D C0 CC 1D CE F0 52 B2 4D 61 24 D4 FB 6C 01 38 9A FA 89 64 FB 9D 63 7D D2 25 24 32 01 74' + '97 CB 99 CA 00 A8 73 4C 00 8E A1 7E 2A D9 B2 F2 8F D1 EE C4 66 73 FD F8 99 20 39 1B 27 B3 D3 19' + '76 BB 7F A7 31 1E 86 0F 98 0F 1C 4B 8D A6 B3 B3 97 A7 5D 17 68 22 87 14 12 3E 4B B6 74 C6 42 4D' + '77 8F 26 C9 96 87 8D EE 76 ED FF E8 32 F2 06 06 A8 4F 92 6D 0F 87 EF 0D 39 D9 14 28 26 77 39 D9' + '72 29 F2 FB 64 7B C5 8D 31 B7 0C 3F 3A 37 FA 9B C1 4E 60 C8 60 A7 C0 24 4E EC 19 D7 94 FF D7 37' + '1B 65 9E 37 9C 75 79 F9 53 2D 9B 0C 57 E2 A1 2F B8 7F E1 DC CB F1 78 5B 3E 25 7E 1D EF B0 A0 3A' + 'F8 31 BE 42 DF BB 49 17 0A CC 9F C7 0B 8A 86 0B 73 49 BD F9 E7 F8 1C 0A F0 57 88 BD 6D A6 7B 2A' + '4B B6 18 47 0F 2C C2 56 FE DB EC EB AE 44 B7 70 10 FF 35 EF E7 00 BD A1 A8 52 D0 D9 49 67 D8 E1' + '5A 2E A6 94 1F DD 60 DE 4E B6 59 EC 0A 86 F3 EC 0A 78 90 4D 1C 70 19 B7 B2 E6 07 5C 20 16 F3 43' + '06 40 CD 76 4F 84 C9 76 98 81 87 5C 60 88 97 13 28 5E FF F2 C2 39 E4 06 58 9C E9 87 DC 08 DE 4C' + 'B6 12 EC F8 90 6B EC 82 DB FE 1F B1 3D 18 E6 B8 27 C9 64 7B 96 ED 1D 71 ED 95 64 EC 11 37 64 3F' + '83 52 2C D7 91 F8 6E F7 DB 69 AE 7B C2 4C B6 8F D9 0E 30 FC 6B 28 C4 98 63 6C E7 A8 6B A7 34 D3' + '8E BA 15 CA BC 70 2E 30 1C B6 79 4C 07 9E 60 F8 71 7F FD D3 04 7A 91 21 C0 E7 E8 F2 C5 2B C3 B9' + '9C 8C 0F A0 6C A0 30 CF 4B 0C 87 BA 9B E9 C0 53 4C 7B DE A5 CD A7 09 F4 13 86 00 CB 71 62 99 DB' + '09 5D BC C8 58 6F F8 94 31 A0 0B 98 03 7C 99 AE 97 9C 6B 21 4D A0 9F 31 04 38 91 1A 9B E6 35 86' + 'BC EA 42 16 D1 04 FA 39 43 80 E5 39 C4 D3 CE 85 49 E6 E7 02 79 75 86 39 9E DE C3 1C D0 2F 98 03' + 'AC C0 9C D7 E3 7B FF 0D 06 7A 55 91 3B D3 6F B9 2F 19 0B BA 98 B9 C0 4A 74 61 79 DF 49 B6 AF E8' + '02 5D 42 17 F0 6B 6A 5C 55 4B DD 0D 3E D9 BE A1 7E 2B D9 EE A5 06 7E 4B 8D 1D B8 8C 1A 78 1B BB' + '7F 27 7E 35 7C 47 2F D4 72 7A 81 D5 B8 96 EF C6 4B F7 83 3F 30 39 44 6F AB C2 ED 9E 79 FE 66 AE' + '4D 55 16 3C D3 8C BA BC AF 14 18 2A B3 BF 77 DD 2E 83 E3 3E F6 03 F5 3D FB 05 D6 A4 F7 5C BC 18' + '1F 30 CD AB EA EC E9 5C FC 04 3F 1E BF A2 6B B0 27 6F F6 7B 36 59 0D 6C 72 D7 45 BA 1A 80 BA CC' + '1E 40 EF 67 8F C0 5A 6C 30 C3 B5 FD 8A 5B AD A7 5C 7E 8C 19 DE 7C 5E 14 C9 29 0A DE FE 9F C3 0F' + '11 A9 EC 1D E6 C7 E3 67 4C 6D F6 9E E1 82 50 89 15 EC 0A EA 0A BB 06 36 62 F8 87 F1 62 62 B3 7D' + 'C4 1E BC A1 2E 33 FD 1D 0A 3B B6 9E 22 37 B9 03 12 A3 6D 10 18 FC 21 DF 30 D5 B2 CA 70 3D 7E 6B' + 'F3 97 DF C7 6A 14 86 3A 5C BD 0F 5D 69 5E 88 DF EE EA AB A3 2B AE FE 2B 39 44 A8 1F 38 44 60 63' + 'F6 73 21 5E 7F CC E8 22 5B F3 86 DB D9 9A 3F 45 76 C4 57 BA 09 87 71 21 3E 2E 4F 7C 6D 2E 29 11' + '86 3B B8 5B 2F B8 88 A6 EC FD 42 7C 2C CD 02 05 DF 03 1C 0B D4 8F 1C 0B B0 39 C7 F2 49 FC 3C C2' + 'D1 D9 82 E1 DE 80 E4 96 52 AF B8 27 80 56 52 57 5C 70 6B 0E F5 13 D7 2A 8A F2 AD 23 0F B2 79 D8' + '7E 62 F3 C0 36 6C FE D3 78 DB 08 68 C7 45 FE D4 9D 5B 99 3B 1E CD B5 E5 E8 BD F9 67 A6 82 AE 62' + '53 C0 5F A8 71 28 AE A6 06 76 60 B7 9F C7 EF 72 FE D2 6D CF 81 65 DA 3A B2 D3 FF DE 92 D6 30 15' + '86 AB 6C 0A F8 2B F1 8B 64 7B 88 76 E0 38 E2 97 78 5A 64 E2 57 FF 79 38 E8 CC 76 BF 8A 0F 72 2D' + 'C3 A0 7E 63 3A 70 3C 35 EE 92 5D 18 F5 8D BB 66 30 96 87 69 85 FA 9D 51 C0 09 D4 A8 CE 3A E2 77' + 'C9 F6 07 ED C0 3F 89 D8 C3 EB 69 07 76 65 E7 97 E3 1B 1F DD 75 63 4D 2E BB 7D FE 17 63 41 37 30' + '16 98 C6 D8 2B C9 BA EA 30 BA EE 2C CA 15 47 33 E2 1B EB 6F 26 01 37 32 09 D8 83 ED FD E0 6E 30' + '3D B9 0A 3F C4 F7 D7 81 F8 73 C9 3F CC 80 79 13 33 80 9B 89 58 B7 FF D1 0E FC 8B DB ED 67 17 DD' + '8B 73 CE BC BF 5F 63 00 D4 16 26 00 FF 66 E0 2F 7E 7D E9 02 FD 87 A6 AB CE 74 83 26 D0 FF D1 F4' + 'AB 33 8D 60 22 E8 4D BA 80 8F 50 63 44 C3 89 D7 F0 B4 4C C4 E4 6E 32 E5 86 4B 59 E0 3E CD EE 64' + 'B7 F1 E6 08 B4 1A FC B4 BB 93 AD A9 89 37 57 C0 2D C4 50 27 5B EA 3E 9F EE 64 6B A9 F1 5E 66 91' + 'FB 2C B8 93 55 66 1E 70 1D ED 39 3A D9 0E DA 81 4F BA 4F 7D 3B D9 06 DA 81 9B 89 45 3A 59 88 ED' + '57 EA 64 4F D0 5F AD 93 55 63 3E 70 3D FD C0 30 FD 75 3A 59 84 78 47 27 DB 44 7B 9F 4E 96 85 1A' + 'B8 8C 79 FD 3B 59 02 F5 92 4E F6 10 FD 78 37 95 48 0D 2C C0 F6 80 0B 19 07 5C 4C 5C DB C9 B2 D2' + 'FF 68 27 BB 85 FE 1D 9D 2C 1B F5 89 4E B6 8D F9 C0 7F F9 BF 1F 7E D5 C9 56 74 B7 67 98 12 EA 6C' + 'DB DD 87 B9 9D ED 11 62 E5 AE 96 DD 0D A9 AB E5 20 0E EF 6A F7 D2 3E B6 AB E5 A4 06 2E A1 1E DF' + 'D5 72 51 2F EA 6A 25 D8 D5 CA AE 96 9B 7A 5D 57 7B 8C FE 8D 5D 2D 0F F5 EE AE 96 97 F8 59 57 4B' + '22 FE D1 D5 A2 AE F4 DD AC 14 F3 8A 77 B3 5B 89 1D BB 59 7D E2 94 6E 96 8F FE CD DD 6C 03 DB 39' + 'DC CD F2 53 FF D3 CD 0A 10 0B A6 59 41 62 D1 34 2B 44 AC 97 66 BB 18 D7 30 CD 96 13 9B A6 59 3D' + 'BE 3F 05 16 AE E1 B1 3E 75 8B 34 6B 40 6C 99 66 FB 18 D7 3D CD 6E A1 BF 5F 9A 15 21 8E 4E B3 AD' + 'B4 4F 4A B3 A2 6E 5E 69 56 8C F8 6C 9A DD 4A 7C 3D CD F2 71 7C 6F A5 59 71 EA 2F D3 AC 2B 74 D6' + '9F D3 AC 3A ED BF A5 D9 4E E6 03 6B 51 67 EB 6E 6B A9 73 77 B7 F2 D4 F5 BB 5B 0B EA CE 3D AC 01' + 'F5 B3 3D AC 04 DB 39 DF D3 EE 71 87 6B 4F 7B 98 4B 04 7C 90 BA 64 2F 2B 49 3F 70 2B ED C9 BD AC' + '14 F5 95 DE 56 8E F9 BF F4 B6 D2 D4 E1 3E 56 86 98 A3 8F 95 75 F5 E9 63 05 E9 2F DA C7 F6 B3 9D' + '5B FB D8 5D BC 92 2B F6 B1 A1 63 AD 1C 43 40 0B 33 E4 B6 3E F6 08 9B 06 96 A7 7D 6A 1F DB CC 14' + '60 05 EA 2E 7D 2D CA B8 5E 7D 6D 37 ED 23 FA 5A 45 DA 17 F4 B5 A7 A9 D7 F7 B5 4A D4 7F F7 B5 DB' + '88 79 FB 59 65 62 99 7E 56 C5 2D 4D 3F AB 4A 9C D0 CF AA 11 27 F7 B3 EA C4 0B FD AD 06 F1 EB FE' + '56 95 ED 7F D3 DF 9E 72 A7 5F 7F 4B A6 FD 6A 7F AB 49 BC D9 DF 52 88 53 06 D8 5C F7 7F 5E 0C B0' + 'A4 21 96 4A D3 9C 01 D6 92 29 F3 06 58 2D EA F9 03 AC 36 F1 F7 01 56 C7 A5 0E B0 BA C4 9C 03 AD' + '1E 31 FF 40 AB EF A6 34 D0 1A 10 07 0F B4 86 6E CA 03 AD B8 BB 90 06 5A 17 AE E6 FA 81 D6 88 F6' + '57 06 DA ED C4 6C 43 AC B1 BB 50 87 D8 1D C4 F6 43 2C 89 F1 C0 9A C4 B4 21 56 91 F8 F0 10 AB 41' + 'CC 3A D4 2A 11 7B 0C B5 26 8C AF 31 DC 9A 12 6B 0D B7 66 C4 7B 87 5B 2B 8E 1B D8 9C 7A FD 70 2B' + 'C6 F8 8D C3 AD 05 F5 8E E1 56 92 7A FF 70 6B 49 7D 1C F1 EE EA 19 6E AB 98 F7 F5 70 6B ED 4A 37' + 'DC EE 66 49 F2 8C B0 93 E3 AC 08 53 4A 8D B0 79 34 55 1B C1 6B BB 0D A3 7E 19 61 F7 31 2B DB 48' + '6B EB 66 33 D2 EA BA BD 39 D2 EA B8 E3 6C A4 AD 71 C7 DB 48 5B 49 AC 34 D2 DA B9 63 6B A4 CD E7' + '2D A3 F2 28 CB 3B D0 8A 76 B6 C6 B3 6D B5 3B 1C 46 59 7B 06 94 1A 6B 1D 88 43 C6 DA E3 B4 63 67' + '75 A4 9E 3D D6 3A 11 0F 8D B5 CE C4 B3 63 6D 5B 75 E0 DB 63 AD 0B 75 FA 58 EB EA 76 C0 58 EB E6' + '76 CC 38 4B 23 16 18 67 DD 5D 99 C6 D9 0A B6 07 DC E6 EE 7B E3 AC 36 07 BA 60 82 55 20 16 98 68' + '3D DC 21 34 C9 EE 77 87 D2 24 2B 4A 7B E9 C9 D6 93 F6 CA 53 AC 97 5B AE 29 D6 9B D8 70 8A F5 71' + '87 D9 14 BB 93 D8 7A 8A F5 75 E7 EB 14 EB 47 EC 3B C5 1E 66 3B B3 A7 58 7F EA 3D 53 6C 00 71 F1' + '54 1B 48 5C 3E D5 06 11 2F 4E B3 C1 C4 6F A6 D9 10 E2 2D D3 AD 0C FB 2D 39 DD 86 BA 8B 74 BA 0D' + '73 85 9B 6E C3 89 C9 D3 6D 23 AF AC 94 E9 56 8F 71 A9 D3 6D 13 FB A9 3B DD 46 D0 7F FF 74 1B 49' + '5C 33 DD 46 11 67 CC B0 D1 C4 BB 66 D8 18 E2 DE 19 36 96 F8 C2 0C DB C3 BC 2F 67 D8 38 EA 9F 66' + 'D8 78 57 BF 99 36 81 F8 C5 4C 9B 48 FC 6D A6 4D 22 36 98 6D 0F 31 1E EB B5 DE DD 3F 66 5B 0A FB' + '5F 38 DB 26 D3 7F 6C B6 4D 21 9E 9A 6D 1B DD D3 E5 6C 9B 4A 3D 6D 8E A5 32 6E CE 1C 9B E6 D6 6D' + '8E 4D 77 87 EE 1C 6B CD B8 07 E7 DA 0C 77 B9 CC B3 99 EE 8A 9F 67 A5 19 DF EC 2E 9B E5 EA 3D DF' + '66 13 BB CE B7 39 C4 FB E6 DB 5C E2 F3 F3 6D 1E 31 B4 C0 EE 22 E6 5A 60 77 13 F3 2D B0 F9 C4 D4' + '05 B6 C0 5D BE 0B 6C A1 AB F7 02 5B E4 0E D7 85 76 0F F1 F2 42 5B EC E6 B7 D0 96 10 AF 2F B4 A5' + 'AE 9D 45 76 2F B1 D8 22 5B E6 EA BF C8 96 BB 93 66 91 DD E7 4E 8C 45 76 3F 71 D6 22 5B 41 EC B8' + 'D4 56 BA 7D B3 D4 1E 20 36 59 66 0F 12 3B 2C B3 55 C4 A1 CB 6C 35 F1 EE E5 B6 C6 AD CF 72 7B 88' + '78 6E B9 15 E2 3C BF 5C 6E 6B DD 4D EB 3E 7B 98 58 77 85 AD 23 B6 5A 61 EB 89 3D 56 D8 06 D7 DF' + '0A DB 48 7C 04 7E D6 6D FB 0A 2B CB FC 5D 2B 6C 2F F5 99 15 B6 89 FE 61 2B 6D 33 71 D2 4A 4B A6' + '1F B8 C5 5D 37 2B ED 11 77 D3 7C C0 B6 12 DF 7C C0 B6 B9 9B E1 83 F6 28 71 FF 83 B6 9D 78 E4 41' + 'AB C2 BC 76 AB 6C 0B DB 1D BD CA 1E A3 7D F5 2A 7B 9C D8 76 B5 35 74 37 D5 D5 B6 83 FA F4 6A 7B' + '82 F8 D6 6A 7B 80 F1 EF AF B6 27 A9 81 4F 11 67 3E 6C 3B DD C9 FE B0 ED 22 DE BA CE 9E 76 37 BF' + '75 B6 DB 1D 43 EB 6C 0F F1 BB 75 F6 8C 5B E7 F5 B6 97 38 60 BD ED 73 E7 C0 7A DB EF 6E A2 EB ED' + '80 DB 3F EB ED 20 F1 C7 F5 76 C8 AD DF 7A 3B EC F6 C1 06 7B D4 7D 99 BF C1 8E 50 EF DC 60 CF BA' + 'FD BC C1 8E 12 3F DD 60 C7 DC 43 C4 46 3B 4E DC B8 D1 4E B8 EB 72 A3 9D 74 F1 9B EC 39 E2 87 9B' + 'EC 79 17 BF C9 4E 11 CB 6F B6 17 DC 71 BB D9 5E 24 A6 6C B6 97 88 8D 36 DB CB C4 3B 37 DB 2B EE' + 'D8 DC 62 AF 12 A7 6F B5 D7 DC BE DB 6A A7 89 4F 6C B5 33 C4 93 5B ED 75 77 FC 6F B5 37 88 6F 6F' + 'B5 37 5D 9D B6 DA 59 77 3D 6C B5 B7 88 37 B6 DA DB C4 3C DB EC 1D 77 7B D9 66 EF BA 73 71 9B BD' + 'E7 CE 9D 6D F6 3E B1 DD 36 3B 47 EC B6 CD 3E 20 AE DC 66 E9 C4 2D DB EC 37 9E 8B DB B6 59 86 7B' + '5E DB 66 FD F8 07 F7 2B 3E 65 93 F8 7F 1B 4C 7C CA FA 53 D7 DD 6D 03 89 DD 76 DB A6 A4 50 D8 36' + '26 85 4E 24 85 B6 90 6E 76 74 37 E9 13 8E 56 8F 82 D6 8C 86 2A 46 43 35 48 53 1C 6D 9F 1F B4 75' + 'FE 50 E3 FC A1 0E A2 BD F2 87 9E 2B 00 7A BC 40 68 7F 81 D0 49 D1 13 05 42 A7 44 9F 87 2A 08 7A' + 'AC 60 68 5F C1 D0 49 D2 E3 8E D6 2B 02 5A BB 48 28 B9 48 E8 FF 00 75 E8 A3 2C' +} diff --git a/3rdParty/JCL/source/common/JclUnitConv.pas b/3rdParty/JCL/source/common/JclUnitConv.pas new file mode 100644 index 00000000..a987f6bb --- /dev/null +++ b/3rdParty/JCL/source/common/JclUnitConv.pas @@ -0,0 +1,1007 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclUnitConv.pas. } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. } +{ Portions created by Marcel van Brakel are Copyright Marcel van Brakel. All rights reserved. } +{ } +{ Contributor(s): } +{ Marcel van Brakel } +{ ESB Consultancy } +{ Manlio Laschena } +{ Allan Lyons } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ Scott Price (scottprice) } +{ } +{**************************************************************************************************} +{ } +{ Contains routines to perform conversion between various units such as length coordinate, } +{ temperature, angle, mass and pressure conversions. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclUnitConv; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclBase; + +const + { Temperature constants } + + CelsiusFreezingPoint = 0.0; + FahrenheitFreezingPoint = 32.0; + KelvinFreezingPoint = 273.15; + CelsiusBoilingPoint = 100.0 + CelsiusFreezingPoint; + FahrenheitBoilingPoint = 180.0 + FahrenheitFreezingPoint; + KelvinBoilingPoint = 100.0 + KelvinFreezingPoint; + CelsiusAbsoluteZero = -273.15; + FahrenheitAbsoluteZero = -459.67; + KelvinAbsoluteZero = 0.0; + + { Newly added for Rankine and Reaumur Support by scottprice } + RankineAbsoluteZero = 0.0; + RankineAtFahrenheitZero = 459.67; + RankineFreezingPoint = 491.67; + RankineBoilingPoint = 180 + RankineFreezingPoint; + ReaumurAbsoluteZero = -218.52; + ReaumurFreezingPoint = 0.0; + ReaumurBoilingPoint = 80.0; + + + { Mathematical constants } + + DegPerCycle: Float = 360.0; + DegPerGrad: Float = 0.9; + DegPerRad: Float = 57.295779513082320876798154814105; + GradPerCycle: Float = 400.0; + GradPerDeg: Float = 1.1111111111111111111111111111111; + GradPerRad: Float = 63.661977236758134307553505349006; + RadPerCycle: Float = 6.283185307179586476925286766559; + RadPerDeg: Float = 0.017453292519943295769236907684886; + RadPerGrad: Float = 0.015707963267948966192313216916398; + CyclePerDeg: Float = 0.0027777777777777777777777777777778; + CyclePerGrad: Float = 0.0025; + CyclePerRad: Float = 0.15915494309189533576888376337251; + ArcMinutesPerDeg = 60.0; + ArcSecondsPerArcMinute = 60.0; + ArcSecondsPerDeg = ArcSecondsPerArcMinute * ArcMinutesPerDeg; + DegPerArcMinute = 1 / ArcMinutesPerDeg; + DegPerArcSecond = 1 / ArcSecondsPerDeg; + + +type + { Exception classes } + EUnitConversionError = class(EJclError); + + ETemperatureConversionError = class(EUnitConversionError); + + { Temperature type enumeration used for the general routine allowing for + a more dynamic specification of the source or target temperature types } + TTemperatureType = (ttCelsius, ttFahrenheit, ttKelvin, ttRankine, ttReaumur); + + +function HowAOneLinerCanBiteYou(const Step, Max: Longint): Longint; +function MakePercentage(const Step, Max: Longint): Longint; + +{ New Temperature routines } +{ Old temperature routines removed and archived incase required again - scottprice } + +function CelsiusToFahrenheit(const Temperature: Float): Float; +function CelsiusToKelvin(const Temperature: Float): Float; +function CelsiusToRankine(const Temperature: Float): Float; +function CelsiusToReaumur(const Temperature: Float): Float; +function FahrenheitToCelsius(const Temperature: Float): Float; +function FahrenheitToKelvin(const Temperature: Float): Float; +function FahrenheitToRankine(const Temperature: Float): Float; +function FahrenheitToReaumur(const Temperature: Float): Float; +function KelvinToCelsius(const Temperature: Float): Float; +function KelvinToFahrenheit(const Temperature: Float): Float; +function KelvinToRankine(const Temperature: Float): Float; +function KelvinToReaumur(const Temperature: Float): Float; +function RankineToCelsius(const Temperature: Float): Float; +function RankineToFahrenheit(const Temperature: Float): Float; +function RankineToKelvin(const Temperature: Float): Float; +function RankineToReaumur(const Temperature: Float): Float; +function ReaumurToCelsius(const Temperature: Float): Float; +function ReaumurToFahrenheit(const Temperature: Float): Float; +function ReaumurToKelvin(const Temperature: Float): Float; +function ReaumurToRankine(const Temperature: Float): Float; +function ConvertTemperature(const FromType, ToType: TTemperatureType; const Temperature: Float): Float; +function CelsiusTo(ToType: TTemperatureType; const Temperature: Float): Float; +function FahrenheitTo(ToType: TTemperatureType; const Temperature: Float): Float; +function KelvinTo(ToType: TTemperatureType; const Temperature: Float): Float; +function RankineTo(ToType: TTemperatureType; const Temperature: Float): Float; +function ReaumurTo(ToType: TTemperatureType; const Temperature: Float): Float; + +{ Angle conversion } + +function CycleToDeg(const Cycles: Float): Float; +function CycleToGrad(const Cycles: Float): Float; +function CycleToRad(const Cycles: Float): Float; +function DegToCycle(const Degrees: Float): Float; +function DegToGrad(const Degrees: Float): Float; +function DegToRad(const Degrees: Float): Float; +function GradToCycle(const Grads: Float): Float; +function GradToDeg(const Grads: Float): Float; +function GradToRad(const Grads: Float): Float; +function RadToCycle(const Radians: Float): Float; +function RadToDeg(const Radians: Float): Float; +function RadToGrad(const Radians: Float): Float; +function DmsToDeg(const D, M: Integer; const S: Float): Float; +function DmsToRad(const D, M: Integer; const S: Float): Float; +procedure DegToDms(const Degrees: Float; out D, M: Integer; out S: Float); +function DegToDmsStr(const Degrees: Float; const SecondPrecision: Cardinal = 3): string; + +{ Coordinate conversion } + +procedure CartesianToPolar(const X, Y: Float; out R, Phi: Float); +procedure PolarToCartesian(const R, Phi: Float; out X, Y: Float); +procedure CartesianToCylinder(const X, Y, Z: Float; out R, Phi, Zeta: Float); +procedure CartesianToSpheric(const X, Y, Z: Float; out Rho, Phi, Theta: Float); +procedure CylinderToCartesian(const R, Phi, Zeta: Float; out X, Y, Z: Float); +procedure SphericToCartesian(const Rho, Theta, Phi: Float; out X, Y, Z: Float); + +{ Length conversion } + +function CmToInch(const Cm: Float): Float; +function InchToCm(const Inch: Float): Float; +function FeetToMetre(const Feet: Float): Float; +function MetreToFeet(const Metre: Float): Float; +function YardToMetre(const Yard: Float): Float; +function MetreToYard(const Metre: Float): Float; +function NmToKm(const Nm: Float): Float; +function KmToNm(const Km: Float): Float; +function KmToSm(const Km: Float): Float; +function SmToKm(const Sm: Float): Float; + +{ Volume conversion } + +function LitreToGalUs(const Litre: Float): Float; +function GalUsToLitre(const GalUs: Float): Float; +function GalUsToGalCan(const GalUs: Float): Float; +function GalCanToGalUs(const GalCan: Float): Float; +function GalUsToGalUk(const GalUs: Float): Float; +function GalUkToGalUs(const GalUk: Float): Float; +function LitreToGalCan(const Litre: Float): Float; +function GalCanToLitre(const GalCan: Float): Float; +function LitreToGalUk(const Litre: Float): Float; +function GalUkToLitre(const GalUk: Float): Float; + +{ Mass conversion } + +function KgToLb(const Kg: Float): Float; +function LbToKg(const Lb: Float): Float; +function KgToOz(const Kg: Float): Float; +function OzToKg(const Oz: Float): Float; +function CwtUsToKg(const Cwt: Float): Float; +function CwtUkToKg(const Cwt: Float): Float; +function KaratToKg(const Karat: Float): Float; +function KgToCwtUs(const Kg: Float): Float; +function KgToCwtUk(const Kg: Float): Float; +function KgToKarat(const Kg: Float): Float; +function KgToSton(const Kg: Float): Float; +function KgToLton(const Kg: Float): Float; +function StonToKg(const STon: Float): Float; +function LtonToKg(const Lton: Float): Float; +function QrUsToKg(const Qr: Float): Float; +function QrUkToKg(const Qr: Float): Float; +function KgToQrUs(const Kg: Float): Float; +function KgToQrUk(const Kg: Float): Float; + +{ Pressure conversion } + +function PascalToBar(const Pa: Float): Float; +function PascalToAt(const Pa: Float): Float; +function PascalToTorr(const Pa: Float): Float; +function BarToPascal(const Bar: Float): Float; +function AtToPascal(const At: Float): Float; +function TorrToPascal(const Torr: Float): Float; + +{ Other conversions } + +function KnotToMs(const Knot: Float): Float; +function HpElectricToWatt(const HpE: Float): Float; +function HpMetricToWatt(const HpM: Float): Float; +function MsToKnot(const Ms: Float): Float; +function WattToHpElectric(const W: Float): Float; +function WattToHpMetric(const W: Float): Float; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + JclMath, JclResources; + +function HowAOneLinerCanBiteYou(const Step, Max: Longint): Longint; +begin + Result := MakePercentage(Step, Max); +end; + +function MakePercentage(const Step, Max: Longint): Longint; +begin + Assert(Max <> 0); + Result := Round((Step * 100.0) / Max); +end; + +//=== Temperature conversion ================================================= + +procedure TemperatureBelowAbsoluteError; +begin + raise ETemperatureConversionError.CreateRes(@RsConvTempBelowAbsoluteZero); +end; + +function CelsiusToFahrenheit(const Temperature: Float): Float; +begin + if Temperature < CelsiusAbsoluteZero then + TemperatureBelowAbsoluteError; + + Result := (((FahrenheitBoilingPoint-FahrenheitFreezingPoint) / + CelsiusBoilingPoint) * Temperature) + FahrenheitFreezingPoint; + + // °F = °C × 1.8 + 32 + // Alternative: Result := Temperature * 1.8 + 32; +end; + +function CelsiusToKelvin(const Temperature: Float): Float; +begin + if Temperature < CelsiusAbsoluteZero then + TemperatureBelowAbsoluteError; + + // K = °C + 273.15 + Result := Temperature + KelvinFreezingPoint; +end; + +function CelsiusToRankine(const Temperature: Float): Float; +begin + if Temperature < CelsiusAbsoluteZero then + TemperatureBelowAbsoluteError; + + // °R = (°C × 1.8) + 32 + 459.67 + if Temperature = CelsiusAbsoluteZero then + begin + Result := RankineAbsoluteZero; + end else + begin + Result := RankineFreezingPoint - FahrenheitFreezingPoint + + CelsiusToFahrenheit(Temperature); + end; +end; + +function CelsiusToReaumur(const Temperature: Float): Float; +begin + if Temperature < CelsiusAbsoluteZero then + TemperatureBelowAbsoluteError; + + // °R = °C × 0.8 + Result := Temperature * 0.8; +end; + +function FahrenheitToCelsius(const Temperature: Float): Float; +begin + if Temperature < FahrenheitAbsoluteZero then + TemperatureBelowAbsoluteError; + + // °C = (°F - 32) / 1.8 + Result := (CelsiusBoilingPoint / + (FahrenheitBoilingPoint-FahrenheitFreezingPoint)) * + (Temperature - FahrenheitFreezingPoint); +end; + +function FahrenheitToKelvin(const Temperature: Float): Float; +begin + if Temperature < FahrenheitAbsoluteZero then + TemperatureBelowAbsoluteError; + + // K = (°F + 459.67) / 1.8 + Result := FahrenheitToCelsius(Temperature) + KelvinFreezingPoint; +end; + +function FahrenheitToRankine(const Temperature: Float): Float; +begin + if Temperature < FahrenheitAbsoluteZero then + TemperatureBelowAbsoluteError; + + // °Ra = °F + 459.67 + Result := Temperature + RankineAtFahrenheitZero; +end; + +function FahrenheitToReaumur(const Temperature: Float): Float; +begin + if Temperature < FahrenheitAbsoluteZero then + TemperatureBelowAbsoluteError; + + // °R = (°F - 32) / 2.25 + Result := (Temperature - FahrenheitFreezingPoint) / 2.25; +end; + +function KelvinToCelsius(const Temperature: Float): Float; +begin + if Temperature < KelvinAbsoluteZero then + TemperatureBelowAbsoluteError; + + // °C = K - 273.15 + Result := Temperature - KelvinFreezingPoint; +end; + +function KelvinToFahrenheit(const Temperature: Float): Float; +begin + if Temperature < KelvinAbsoluteZero then + TemperatureBelowAbsoluteError; + + // °F = K × 1.8 - 459.67 + Result := FahrenheitToCelsius(Temperature - KelvinFreezingPoint); +end; + +function KelvinToRankine(const Temperature: Float): Float; +begin + if Temperature < KelvinAbsoluteZero then + TemperatureBelowAbsoluteError; + + // °Ra = K × 1.8 + Result := Temperature * 1.8; +end; + +function KelvinToReaumur(const Temperature: Float): Float; +begin + if Temperature < KelvinAbsoluteZero then + TemperatureBelowAbsoluteError; + + // °R = (K - 273.15) × 0.8 + Result := (Temperature - KelvinFreezingPoint) * 0.8; +end; + +function RankineToCelsius(const Temperature: Float): Float; +begin + if Temperature < RankineAbsoluteZero then + TemperatureBelowAbsoluteError; + + // °C = (°R - 32 - 459.67) / 1.8 + Result := (Temperature - RankineFreezingPoint) / 1.8; +end; + +function RankineToFahrenheit(const Temperature: Float): Float; +begin + if Temperature < RankineAbsoluteZero then + TemperatureBelowAbsoluteError; + + // °F = °R - 459.67 + Result := Temperature - RankineAtFahrenheitZero; +end; + +function RankineToKelvin(const Temperature: Float): Float; +begin + if Temperature < RankineAbsoluteZero then + TemperatureBelowAbsoluteError; + + // K = °R / 1.8 + Result := Temperature / 1.8; +end; + +function RankineToReaumur(const Temperature: Float): Float; +begin + if Temperature < RankineAbsoluteZero then + TemperatureBelowAbsoluteError; + + // °R = (°Ra - 32 - 459.67) / 2.25 + Result := (Temperature - RankineFreezingPoint) / 2.25; +end; + +function ReaumurToCelsius(const Temperature: Float): Float; +begin + if Temperature < ReaumurAbsoluteZero then + TemperatureBelowAbsoluteError; + + // °C = °R × 1.25 + Result := Temperature * 1.25; +end; + +function ReaumurToFahrenheit(const Temperature: Float): Float; +begin + if Temperature < ReaumurAbsoluteZero then + TemperatureBelowAbsoluteError; + + // °F = °R × 2.25 + 32 + Result := (Temperature * 2.25) + FahrenheitFreezingPoint; +end; + +function ReaumurToKelvin(const Temperature: Float): Float; +begin + if Temperature < ReaumurAbsoluteZero then + TemperatureBelowAbsoluteError; + + // K = °R × 1.25 + 273.15 + Result := (Temperature * 1.25) + KelvinFreezingPoint; +end; + +function ReaumurToRankine(const Temperature: Float): Float; +begin + if Temperature < ReaumurAbsoluteZero then + TemperatureBelowAbsoluteError; + + // °Ra = °R × 2.25 + 32 + 459.67 + Result := (Temperature * 2.25) + RankineFreezingPoint; +end; + +function ConvertTemperature(const FromType, ToType: TTemperatureType; const Temperature: Float): Float; +const + cToType = 'ToType'; + cFromType = 'FromType'; +begin + case FromType of + { All conversions from Celcius to other formats are listed here } + ttCelsius: + begin + case ToType of + ttFahrenheit: + Result := CelsiusToFahrenheit(Temperature); + ttKelvin: + Result := CelsiusToKelvin(Temperature); + ttRankine: + Result := CelsiusToRankine(Temperature); + ttReaumur: + Result := CelsiusToReaumur(Temperature); + else + raise EInvalidOp.CreateResFmt(@RsTempConvTypeError, [cToType]); + end; + end; + { All conversions from Fahrenheit to other formats are listed here } + ttFahrenheit: + begin + case ToType of + ttCelsius: + Result := FahrenheitToCelsius(Temperature); + ttKelvin: + Result := FahrenheitToKelvin(Temperature); + ttRankine: + Result := FahrenheitToRankine(Temperature); + ttReaumur: + Result := FahrenheitToReaumur(Temperature); + else + raise EInvalidOp.CreateResFmt(@RsTempConvTypeError, [cToType]); + end; + end; + { All conversions from Kelvin to other formats are listed here } + ttKelvin: + begin + case ToType of + ttCelsius: + Result := KelvinToCelsius(Temperature); + ttFahrenheit: + Result := KelvinToFahrenheit(Temperature); + ttRankine: + Result := KelvinToRankine(Temperature); + ttReaumur: + Result := KelvinToReaumur(Temperature); + else + raise EInvalidOp.CreateResFmt(@RsTempConvTypeError, [cToType]); + end; + end; + { All conversions from Kelvin to other formats are listed here } + ttRankine: + begin + case ToType of + ttCelsius: + Result := RankineToCelsius(Temperature); + ttFahrenheit: + Result := RankineToFahrenheit(Temperature); + ttKelvin: + Result := RankineToKelvin(Temperature); + ttReaumur: + Result := RankineToReaumur(Temperature); + else + raise EInvalidOp.CreateResFmt(@RsTempConvTypeError, [cToType]); + end; + end; + { All conversions from Reaumur to other formats are listed here } + ttReaumur: + begin + case ToType of + ttCelsius: + Result := ReaumurToCelsius(Temperature); + ttFahrenheit: + Result := ReaumurToFahrenheit(Temperature); + ttKelvin: + Result := ReaumurToKelvin(Temperature); + ttRankine: + Result := ReaumurToRankine(Temperature); + else + raise EInvalidOp.CreateResFmt(@RsTempConvTypeError, [cToType]); + end; + end; + else + raise EInvalidOp.CreateResFmt(@RsTempConvTypeError, [cFromType]); + end; +end; + +function CelsiusTo(ToType: TTemperatureType; const Temperature: Float): Float; +begin + Result := ConvertTemperature(ttCelsius, ToType, Temperature); +end; + +function FahrenheitTo(ToType: TTemperatureType; const Temperature: Float): Float; +begin + Result := ConvertTemperature(ttFahrenheit, ToType, Temperature); +end; + +function KelvinTo(ToType: TTemperatureType; const Temperature: Float): Float; +begin + Result := ConvertTemperature(ttKelvin, ToType, Temperature); +end; + +function RankineTo(ToType: TTemperatureType; const Temperature: Float): Float; +begin + Result := ConvertTemperature(ttRankine, ToType, Temperature); +end; + +function ReaumurTo(ToType: TTemperatureType; const Temperature: Float): Float; +begin + Result := ConvertTemperature(ttReaumur, ToType, Temperature); +end; + +//=== Angle conversion ======================================================= + +function CycleToDeg(const Cycles: Float): Float; +begin + Result := Cycles * DegPerCycle; +end; + +function CycleToGrad(const Cycles: Float): Float; +begin + Result := Cycles * GradPerCycle; +end; + +function CycleToRad(const Cycles: Float): Float; +begin + Result := Cycles * RadPerCycle; +end; + +function DegToGrad(const Degrees: Float): Float; +begin + Result := Degrees * GradPerDeg; +end; + +function DegToCycle(const Degrees: Float): Float; +begin + Result := Degrees * CyclePerDeg; +end; + +function DegToRad(const Degrees: Float): Float; +begin + Result := Degrees * RadPerDeg; +end; + +function GradToCycle(const Grads: Float): Float; +begin + Result := Grads * CyclePerGrad; +end; + +function GradToDeg(const Grads: Float): Float; +begin + Result := Grads * DegPerGrad; +end; + +function GradToRad(const Grads: Float): Float; +begin + Result := Grads * RadPerGrad; +end; + +function RadToCycle(const Radians: Float): Float; +begin + Result := Radians * CyclePerRad; +end; + +function RadToDeg(const Radians: Float): Float; +begin + Result := Radians * DegPerRad; +end; + +function RadToGrad(const Radians: Float): Float; +begin + Result := Radians * GradPerRad; +end; + +function DmsToDeg(const D, M: Integer; const S: Float): Float; +begin + DomainCheck((M < 0) or (M > 60) or (S < 0.0) or (S > 60.0)); + Result := Abs(D) + M * DegPerArcMinute + S * DegPerArcSecond; + if D < 0 then + Result := -Result; +end; + +function DmsToRad(const D, M: Integer; const S: Float): Float; +begin + Result := DegToRad(DmsToDeg(D, M, S)); +end; + +procedure DegToDms(const Degrees: Float; out D, M: Integer; out S: Float); +var + DD, MM: Float; +begin + DD := Abs(Degrees); + MM := Frac(DD) * ArcMinutesPerDeg; + D := Trunc(DD); + M := Trunc(MM); + S := Frac(MM) * ArcSecondsPerArcMinute; + if Degrees < 0 then + D := -D; +end; + +function DegToDmsStr(const Degrees: Float; const SecondPrecision: Cardinal = 3): string; +var + D, M: Integer; + S: Float; +begin + DegToDMS(Degrees, D, M, S); + Result := Format('%d° %d'' %.*f"', [D, M, SecondPrecision, S]); +end; + +//=== Coordinate conversion ================================================== + +procedure CartesianToCylinder(const X, Y, Z: Float; out R, Phi, Zeta: Float); +begin + Zeta := Z; + CartesianToPolar(X, Y, R, Phi); +end; + +procedure CartesianToPolar(const X, Y: Float; out R, Phi: Float); +begin + R := Sqrt(Sqr(X) + Sqr(Y)); + Phi := ArcTan2(Y, X); + if Phi < 0 then + Phi := Phi + TwoPi; +end; + +procedure CartesianToSpheric(const X, Y, Z: Float; out Rho, Phi, Theta: Float); +begin + Rho := Sqrt(X*X + Y*Y + Z*Z); + Phi := ArcTan2(Y, X); + if Phi < 0 then + Phi := Phi + TwoPi; + Theta := 0; + if Rho > 0 then + Theta := ArcCos(Z/Rho); +end; + +procedure CylinderToCartesian(const R, Phi, Zeta: Float; out X, Y, Z: Float); +var + Sine, CoSine: Float; +begin + SinCos(Phi, Sine, Cosine); + X := R * CoSine; + Y := R * Sine; + Z := Zeta; +end; + +procedure PolarToCartesian(const R, Phi: Float; out X, Y: Float); +var + Sine, CoSine: Float; +begin + SinCos(Phi, Sine, CoSine); + X := R * CoSine; + Y := R * Sine; +end; + +procedure SphericToCartesian(const Rho, Theta, Phi: Float; out X, Y, Z: Float); +var + SineTheta, CoSineTheta: Float; + SinePhi, CoSinePhi: Float; +begin + SinCos(Theta, SineTheta, CoSineTheta); + SinCos(Phi, SinePhi, CoSinePhi); + X := Rho * SineTheta * CoSinePhi; + Y := Rho * SineTheta * SinePhi; + Z := Rho * CoSineTheta; +end; + +//=== Length conversion ====================================================== + +function CmToInch(const Cm: Float): Float; +begin + Result := Cm / 2.54; +end; + +function InchToCm(const Inch: Float): Float; +begin + Result := Inch * 2.54; +end; + +function FeetToMetre(const Feet: Float): Float; +begin + Result := Feet * 0.3048; +end; + +function MetreToFeet(const Metre: Float): Float; +begin + Result := Metre / 0.3048; +end; + +function YardToMetre(const Yard: Float): Float; +begin + Result := Yard * 0.9144; +end; + +function MetreToYard(const Metre: Float): Float; +begin + Result := Metre / 0.9144; +end; + +function NmToKm(const Nm: Float): Float; +begin + Result := Nm * 1.852; +end; + +function KmToNm(const Km: Float): Float; +begin + Result := Km / 1.852; +end; + +function KmToSm(const Km: Float): Float; +begin + Result := Km / 1.609344; +end; + +function SmToKm(const Sm: Float): Float; +begin + Result := Sm * 1.609344; +end; + +//=== Volume conversion ====================================================== + +function LitreToGalUs(const Litre: Float): Float; +begin + Result := Litre / 3.785411784; +end; + +function GalUsToLitre(const GalUs: Float): Float; +begin + Result := GalUs * 3.785411784; +end; + +function GalUsToGalCan(const GalUs: Float): Float; +begin + Result := GalUs / 1.2009499255; +end; + +function GalCanToGalUs(const GalCan: Float): Float; +begin + Result := GalCan * 1.2009499255; +end; + +function GalUsToGalUk(const GalUs: Float): Float; +begin + Result := GalUs / 1.20095045385; +end; + +function GalUkToGalUs(const GalUk: Float): Float; +begin + Result := GalUk * 1.20095045385; +end; + +function LitreToGalCan(const Litre: Float): Float; +begin + Result := Litre / 4.54609; +end; + +function GalCanToLitre(const GalCan: Float): Float; +begin + Result := GalCan * 4.54609; +end; + +function LitreToGalUk(const Litre: Float): Float; +begin + Result := Litre / 4.54609; +end; + +function GalUkToLitre(const GalUk: Float): Float; +begin + Result := GalUk * 4.54609; +end; + +//=== Mass conversion ======================================================== + +function KgToLb(const Kg: Float): Float; +begin + Result := Kg / 0.45359237; +end; + +function LbToKg(const Lb: Float): Float; +begin + Result := Lb * 0.45359237; +end; + +function KgToOz(const Kg: Float): Float; +begin + Result := Kg * 35.2739619496; +end; + +function OzToKg(const Oz: Float): Float; +begin + Result := Oz / 35.2739619496; +end; + +function QrUsToKg(const Qr: Float) : Float; +begin + Result := Qr * 11.34; +end; + +function QrUkToKg(const Qr: Float) : Float; +begin + Result := Qr * 12.7; +end; + +function KgToQrUs(const Kg: Float) : Float; +begin + Result := Kg / 11.34; +end; + +function KgToQrUk(const Kg: Float) : Float; +begin + Result := Kg / 12.7; +end; + +function CwtUsToKg(const Cwt: Float) : Float; +begin + Result := Cwt * 45.35924; +end; + +function CwtUkToKg(const Cwt: Float) : Float; +begin + Result := Cwt * 50.80235; +end; + +function KgToCwtUs(const Kg: Float) : Float; +begin + Result := Kg / 45.35924; +end; + +function KgToCwtUk(const Kg: Float) : Float; +begin + Result := Kg / 50.80235; +end; + +function LtonToKg(const Lton: Float) : Float; +begin + Result := Lton * 1016.047; +end; + +function StonToKg(const Ston: Float) : Float; +begin + Result := Ston * 907.1847; +end; + +function KgToLton(const Kg: Float) : Float; +begin + Result := Kg / 1016.047; +end; + +function KgToSton(const Kg: Float) : Float; +begin + Result := Kg / 907.1847; +end; + +function KgToKarat(const Kg: Float) : Float; +begin + Result := Kg / 0.0002; +end; + +function KaratToKg(const Karat: Float) : Float; +begin + Result := Karat * 0.0002; +end; + + +//=== Pressure conversion ==================================================== + +function PascalToBar(const Pa: Float): Float; +begin + Result := Pa / 100000.0; +end; + +function PascalToAt(const Pa: Float): Float; +begin + Result := Pa / (9.80665 * 10000.0); +end; + +function PascalToTorr(const Pa: Float): Float; +begin + Result := Pa / 133.3224; +end; + +function BarToPascal(const Bar: Float): Float; +begin + Result := Bar * 100000.0; +end; + +function AtToPascal(const At: Float): Float; +begin + Result := At * (9.80665 * 10000.0); +end; + +function TorrToPascal(const Torr: Float): Float; +begin + Result := Torr * 133.3224; +end; + +//=== Other conversion ======================================================= + +function KnotToMs(const Knot: Float): Float; +begin + Result := Knot * 0.514444444444; +end; + +function HpElectricToWatt(const HpE: Float): Float; +begin + Result := HpE * 746.0; +end; + +function HpMetricToWatt(const HpM: Float): Float; +begin + Result := HpM * 735.4988; +end; + +function MsToKnot(const Ms: Float): Float; +begin + Result := Ms / 0.514444444444; +end; + +function WattToHpElectric(const W: Float): Float; +begin + Result := W / 746.0; +end; + +function WattToHpMetric(const W: Float): Float; +begin + Result := W / 735.4988; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclUnitVersioning.pas b/3rdParty/JCL/source/common/JclUnitVersioning.pas new file mode 100644 index 00000000..f0f9d49b --- /dev/null +++ b/3rdParty/JCL/source/common/JclUnitVersioning.pas @@ -0,0 +1,744 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclUnitVersioning.pas. } +{ } +{ The Initial Developer of the Original Code is Andreas Hausladen. } +{ Portions created by Andreas Hausladen are Copyright (C) Andreas Hausladen. All rights reserved. } +{ } +{ Contributor(s): } +{ Andreas Hausladen (ahuser) } +{ } +{**************************************************************************************************} +{ } +{ A unit version information system. It collects information from prepared units by each module. } +{ It also works with units in DLLs. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclUnitVersioning; + +{$I jcl.inc} + +interface + +uses + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + {$IFDEF HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Winapi.Windows, + {$ENDIF MSWINDOWS} + System.SysUtils, System.Contnrs; + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + SysUtils, Contnrs; + {$ENDIF ~HAS_UNITSCOPE} + +type + PUnitVersionInfo = ^TUnitVersionInfo; + TUnitVersionInfo = record + RCSfile: PChar; // $'RCSfile$ + Revision: PChar; // $'Revision$ + Date: PChar; // $'Date$ in UTC (GMT) + LogPath: PChar; // logical file path + Extra: PChar; // user defined string + Data: Pointer; // user data + end; + + TUnitVersion = class(TObject) + private + FInfo: PUnitVersionInfo; + public + constructor Create(AInfo: PUnitVersionInfo); + function RCSfile: string; + function Revision: string; + function Date: string; + function Extra: string; + function LogPath: string; + function Data: Pointer; + function DateTime: TDateTime; + function Summary: string; + end; + + TUnitVersioningModule = class(TObject) + private + FInstance: THandle; + FItems: TObjectList; + + function GetItems(Index: Integer): TUnitVersion; + function GetCount: Integer; + + procedure Add(Info: PUnitVersionInfo); + function IndexOfInfo(Info: PUnitVersionInfo): Integer; + public + constructor Create(AInstance: THandle); + destructor Destroy; override; + + function IndexOf(const RCSfile: string; const LogPath: string = '*'): Integer; + function FindUnit(const RCSfile: string; const LogPath: string = '*'): TUnitVersion; + + property Instance: THandle read FInstance; + property Count: Integer read GetCount; + property Items[Index: Integer]: TUnitVersion read GetItems; default; + end; + + TCustomUnitVersioningProvider = class(TObject) + public + constructor Create; virtual; + procedure LoadModuleUnitVersioningInfo(Instance: THandle); virtual; + procedure ReleaseModuleUnitVersioningInfo(Instance: THandle); virtual; + end; + + TUnitVersioningProviderClass = class of TCustomUnitVersioningProvider; + + TUnitVersioning = class(TObject) + private + FModules: TObjectList; + FProviders: TObjectList; + + function GetItem(Index: Integer): TUnitVersion; + function GetCount: Integer; + function GetModuleCount: Integer; + function GetModule(Index: Integer): TUnitVersioningModule; + + procedure UnregisterModule(Module: TUnitVersioningModule); overload; + procedure ValidateModules; + // These two methods must be virtual because they can be invoked by a DLL. + // Static linking would mean that the DLL's TUnitVersioning methods handle + // the call which leads to an access violation. + procedure Add(Instance: THandle; Info: PUnitVersionInfo); virtual; + procedure UnregisterModule(Instance: THandle); overload; virtual; + public + constructor Create; + destructor Destroy; override; + + procedure RegisterProvider(AProviderClass: TUnitVersioningProviderClass); + procedure LoadModuleUnitVersioningInfo(Instance: THandle); + + function IndexOf(const RCSfile: string; const LogPath: string = '*'): Integer; + function FindUnit(const RCSfile: string; const LogPath: string = '*'): TUnitVersion; + + // units by modules + property ModuleCount: Integer read GetModuleCount; + property Modules[Index: Integer]: TUnitVersioningModule read GetModule; + + // all units + property Count: Integer read GetCount; + property Items[Index: Integer]: TUnitVersion read GetItem; default; + end; + +procedure RegisterUnitVersion(Instance: THandle; const Info: TUnitVersionInfo); +procedure UnregisterUnitVersion(Instance: THandle); + +function GetUnitVersioning: TUnitVersioning; + +procedure ExportUnitVersioningToFile(iFileName : string); + +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); + +implementation + +uses + // make TObjectList functions inlined + {$IFDEF HAS_UNITSCOPE} + System.Types, // inlining of TObjectList.Remove + System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Classes, + {$ENDIF ~HAS_UNITSCOPE} + JclSysUtils, JclSynch; + +// Delphi 5 does not know this function //(usc) D6/7 Per does have StartsWith +// a fast version of Pos(SubStr, S) = 1 +function StartsWith(const SubStr, S: string): Boolean; +var + I, Len: Integer; +begin + Result := False; + Len := Length(SubStr); + if Len <= Length(S) then + begin + for I := 1 to Len do + if S[I] <> SubStr[I] then + Exit; + Result := True; + end; +end; + +function CompareFilenames(const Fn1, Fn2: string): Integer; +begin + {$IFDEF MSWINDOWS} + Result := CompareText(Fn1, Fn2); + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + Result := CompareStr(Fn1, Fn2); + {$ENDIF UNIX} +end; + +//=== { TUnitVersion } ======================================================= + +constructor TUnitVersion.Create(AInfo: PUnitVersionInfo); +begin + inherited Create; + FInfo := AInfo; +end; + +function TUnitVersion.RCSfile: string; +var + I, P: Integer; +begin + Result := Trim(FInfo.RCSfile); + // the + is to have CVS not touch the string + if StartsWith('$' + 'RCSfile: ', Result) then // a CVS command + begin + Delete(Result, 1, 10); + Delete(Result, Length(Result) - 1, 2); + for I := Length(Result) downto 1 do + if Result[I] = ',' then + begin + Delete(Result, I, MaxInt); + Break; + end; + end; + // the + is to have SVN not touch the string + if StartsWith('$' + 'URL: ', Result) then // a SVN command + begin + Delete(Result, 1, 6); + Delete(Result, Length(Result) - 1, 2); + { TODO -oUSc : Is there any need for a function that returns the URL? } + P := Pos('/', Result); + while P > 0 do + begin + Delete(Result, 1, P); + P := Pos('/', Result); + end; + end; +end; + +function TUnitVersion.Revision: string; +begin + Result := Trim(FInfo.Revision); + if StartsWith('$' + 'Revision: ', Result) then // a CVS command + Result := Copy(Result, 12, Length(Result) - 11 - 2); +end; + +function TUnitVersion.Date: string; +begin + Result := Trim(FInfo.Date); + if StartsWith('$' + 'Date: ', Result) then // a CVS command + begin + Delete(Result, 1, 7); + Delete(Result, Length(Result) - 1, 2); + end; +end; + +function TUnitVersion.Data: Pointer; +begin + Result := FInfo.Data; +end; + +function TUnitVersion.Extra: string; +begin + Result := Trim(FInfo.Extra); +end; + +function TUnitVersion.LogPath: string; +begin + Result := Trim(FInfo.LogPath); +end; + +function TUnitVersion.DateTime: TDateTime; +var + Ps: Integer; + S: string; + Error: Integer; + Year, Month, Day, Hour, Minute, Second: Word; + TimeSep: Char; +begin + Result := 0; + S := Date; + + // date: yyyy/mm/dd | yyyy-mm-dd | mm/dd/yyyy | mm-dd-yyyy | dd.mm.yyyy + Ps := Pos('/', S); + if Ps = 0 then + Ps := Pos('-', S); + if Ps <> 0 then + begin + if Ps = 5 then + begin + // yyyy/mm/dd | yyyy-mm-dd + Val(Copy(S, 1, 4), Year, Error); + Val(Copy(S, 6, 2), Month, Error); + Val(Copy(S, 9, 2), Day, Error); + end + else + begin + // mm/dd/yyyy | mm-dd-yyyy + Val(Copy(S, 1, 2), Month, Error); + Val(Copy(S, 4, 2), Day, Error); + Val(Copy(S, 7, 4), Year, Error); + end; + end + else + begin + Ps := Pos('.', S); + if Ps <> 0 then + begin + // dd.mm.yyyy + Val(Copy(S, 1, 2), Day, Error); + Val(Copy(S, 4, 2), Month, Error); + Val(Copy(S, 7, 4), Year, Error); + end + else + Exit; + end; + + // time: hh:mm:ss | hh/mm/ss + Ps := Pos(' ', S); + S := Trim(Copy(S, Ps + 1, MaxInt)); + + Ps := Pos(':', S); + if Ps <> 0 then + TimeSep := ':' + else + begin + Ps := Pos('/', S); + TimeSep := '/'; + end; + Val(Copy(S, 1, Ps - 1), Hour, Error); + Delete(S, 1, Ps); + Ps := Pos(TimeSep, S); + Val(Copy(S, 1, Ps - 1), Minute, Error); + Delete(S, 1, Ps); + Ps := Pos(TimeSep, S); + if Ps = 0 then + Ps := Length(S) + 1; + Val(Copy(S, 1, Ps - 1), Second, Error); + + Result := EncodeDate(Year, Month, Day) + EncodeTime(Hour, Minute, Second, 0); +end; + +function TUnitVersion.Summary: string; +begin + Result := LogPath + #9 + RCSFile + #9 + Revision + #9 + Date; + if Extra <> '' then + Result := Result + #9 + Extra; +end; + +//=== { TUnitVersioningModule } ============================================== + +constructor TUnitVersioningModule.Create(AInstance: THandle); +begin + inherited Create; + FInstance := AInstance; + FItems := TObjectList.Create; +end; + +destructor TUnitVersioningModule.Destroy; +begin + FItems.Free; + inherited Destroy; +end; + +function TUnitVersioningModule.GetCount: Integer; +begin + Result := FItems.Count; +end; + +function TUnitVersioningModule.GetItems(Index: Integer): TUnitVersion; +begin + Result := TUnitVersion(FItems[Index]); +end; + +procedure TUnitVersioningModule.Add(Info: PUnitVersionInfo); +begin + FItems.Add(TUnitVersion.Create(Info)); +end; + +function TUnitVersioningModule.IndexOfInfo(Info: PUnitVersionInfo): Integer; +begin + for Result := 0 to FItems.Count - 1 do + if Items[Result].FInfo = Info then + Exit; + Result := -1; +end; + +function TUnitVersioningModule.FindUnit(const RCSfile: string; const LogPath: string): TUnitVersion; +var + Index: Integer; +begin + Index := IndexOf(RCSfile, LogPath); + if Index <> -1 then + Result := Items[Index] + else + Result := nil; +end; + +function TUnitVersioningModule.IndexOf(const RCSfile: string; const LogPath: string): Integer; +var + Item: TUnitVersion; +begin + for Result := 0 to FItems.Count - 1 do + begin + Item := Items[Result]; + if CompareFilenames(Item.RCSfile, RCSfile) = 0 then + if LogPath = '*' then + Exit + else + if CompareFilenames(LogPath, Trim(Item.LogPath)) = 0 then + Exit; + end; + Result := -1; +end; + +//=== { TCustomUnitVersioningProvider } ====================================== + +constructor TCustomUnitVersioningProvider.Create; +begin + inherited Create; +end; + +procedure TCustomUnitVersioningProvider.LoadModuleUnitVersioningInfo(Instance: THandle); +begin +// +end; + +procedure TCustomUnitVersioningProvider.ReleaseModuleUnitVersioningInfo(Instance: THandle); +begin +// +end; + +//=== { TUnitVersioning } ==================================================== + +constructor TUnitVersioning.Create; +begin + inherited Create; + FModules := TObjectList.Create; + FProviders := TObjectList.Create; +end; + +destructor TUnitVersioning.Destroy; +begin + FProviders.Free; + FModules.Free; + inherited Destroy; +end; + +procedure TUnitVersioning.Add(Instance: THandle; Info: PUnitVersionInfo); +var + I: Integer; + Module: TUnitVersioningModule; +begin + for I := 0 to FModules.Count - 1 do + begin + Module := Modules[I]; + if Module.Instance = Instance then + begin + if Module.IndexOfInfo(Info) = -1 then + Module.Add(Info); + Exit; + end; + end; + // create a new module entry + Module := TUnitVersioningModule.Create(Instance); + FModules.Add(Module); + Module.Add(Info); +end; + +procedure TUnitVersioning.UnregisterModule(Instance: THandle); +var + I: Integer; +begin + for I := FModules.Count - 1 downto 0 do + if Modules[I].Instance = Instance then + begin + FModules.Delete(I); + Break; + end; + for I := 0 to FProviders.Count -1 do + TCustomUnitVersioningProvider(FProviders[I]).ReleaseModuleUnitVersioningInfo(Instance); +end; + +procedure TUnitVersioning.UnregisterModule(Module: TUnitVersioningModule); +begin + FModules.Remove(Module); +end; + +function TUnitVersioning.GetCount: Integer; +var + I: Integer; +begin + Result := 0; + ValidateModules; + for I := 0 to FModules.Count - 1 do + Inc(Result, Modules[I].Count); +end; + +function TUnitVersioning.GetItem(Index: Integer): TUnitVersion; +var + Cnt, I: Integer; + Module: TUnitVersioningModule; +begin + Result := nil; + ValidateModules; + Cnt := 0; + for I := 0 to FModules.Count - 1 do + begin + Module := Modules[I]; + if Index < Cnt + Module.Count then + begin + Result := Module.Items[Index - Cnt]; + Break; + end; + Inc(Cnt, Module.Count); + end; +end; + +function TUnitVersioning.GetModuleCount: Integer; +begin + ValidateModules; + Result := FModules.Count; +end; + +function TUnitVersioning.GetModule(Index: Integer): TUnitVersioningModule; +begin + Result := TUnitVersioningModule(FModules[Index]); +end; + +{$UNDEF FPCUNIX} // Temporary, will move to .inc's in time. +{$IFDEF FPC} + {$IFDEF UNIX} + {$DEFIN FPCUNIX} +{$ENDIF} +{$ENDIF} + +procedure TUnitVersioning.ValidateModules; +var + I: Integer; + {$IFNDEF FPCUNIX} + Buffer: string; + {$ENDIF ~FPCUNIX} + Module: TUnitVersioningModule; +begin + {$IFNDEF FPCUNIX} + SetLength(Buffer, 1024); + {$ENDIF ~FPCUNIX} + for I := FModules.Count - 1 downto 0 do + begin + Module := Modules[I]; + {$IFDEF FPCUNIX} + if dlsym(Pointer(Module.Instance), '_init') = nil then + {$ELSE ~FPCUNIX} + if GetModuleFileName(Module.Instance, PChar(Buffer), 1024) = 0 then + {$ENDIF ~FPCUNIX} + // This module is no more in memory but has not unregistered itself so + // unregister it here. + UnregisterModule(Module); + end; +end; + +function TUnitVersioning.FindUnit(const RCSfile: string; const LogPath: string): TUnitVersion; +var + I: Integer; +begin + for I := 0 to FModules.Count - 1 do + begin + Result := Modules[I].FindUnit(RCSfile, LogPath); + if Result <> nil then + Exit; + end; + Result := nil; +end; + +function TUnitVersioning.IndexOf(const RCSfile: string; const LogPath: string): Integer; +var + I, Cnt, Index: Integer; + Module: TUnitVersioningModule; +begin + Result := -1; + Cnt := 0; + for I := 0 to FModules.Count - 1 do + begin + Module := Modules[I]; + Index := Module.IndexOf(RCSfile, LogPath); + if Index <> -1 then + begin + Result := Cnt + Index; + Break; + end; + Inc(Cnt, Module.Count); + end; +end; + +procedure TUnitVersioning.RegisterProvider(AProviderClass: TUnitVersioningProviderClass); +var + I, Idx: Integer; +begin + Idx := -1; + for I := 0 to FProviders.Count - 1 do + if TObject(FProviders[I]).ClassType = AProviderClass then + begin + Idx := I; + Break; + end; + if Idx = -1 then + FProviders.Add(AProviderClass.Create); +end; + +procedure TUnitVersioning.LoadModuleUnitVersioningInfo(Instance: THandle); +var + I: Integer; +begin + for I := 0 to FProviders.Count - 1 do + TCustomUnitVersioningProvider(FProviders[I]).LoadModuleUnitVersioningInfo(Instance); +end; + +type + PUnitVersioning = ^TUnitVersioning; + +var + UnitVersioningOwner: Boolean = False; + GlobalUnitVersioning: TUnitVersioning = nil; + UnitVersioningNPA: PUnitVersioning = nil; + UnitVersioningMutex: TJclMutex; + UnitVersioningFinalized: Boolean = False; + +function GetUnitVersioning: TUnitVersioning; +begin + if UnitVersioningFinalized then + begin + Result := nil; + Exit; + end; + + if UnitVersioningMutex = nil then + UnitVersioningMutex := TJclMutex.Create(nil, False, 'MutexNPA_UnitVersioning_' + IntToStr(GetCurrentProcessId)); + + if GlobalUnitVersioning = nil then + begin + UnitVersioningMutex.WaitFor(INFINITE); + try + if UnitVersioningNPA = nil then + SharedGetMem(UnitVersioningNPA, 'ShmNPA_UnitVersioning_' + IntToStr(GetCurrentProcessId), SizeOf(TUnitVersioning)); + if UnitVersioningNPA <> nil then + begin + GlobalUnitVersioning := UnitVersioningNPA^; + if GlobalUnitVersioning = nil then + begin + GlobalUnitVersioning := TUnitVersioning.Create; + UnitVersioningNPA^ := GlobalUnitVersioning; + UnitVersioningOwner := True; + end; + end + else + begin + GlobalUnitVersioning := TUnitVersioning.Create; + UnitVersioningOwner := True; + end; + finally + UnitVersioningMutex.Release; + end; + end + else + if UnitVersioningNPA <> nil then + begin + UnitVersioningMutex.WaitFor(INFINITE); + try + GlobalUnitVersioning := UnitVersioningNPA^; // update (maybe the owner has destroyed the instance) + finally + UnitVersioningMutex.Release; + end; + end; + Result := GlobalUnitVersioning; +end; + +procedure FinalizeUnitVersioning; +begin + UnitVersioningFinalized := True; + try + if UnitVersioningNPA <> nil then + SharedCloseMem(UnitVersioningNPA); + if (GlobalUnitVersioning <> nil) and UnitVersioningOwner then + FreeAndNil(GlobalUnitVersioning) + else + GlobalUnitVersioning := nil; + except + // ignore - should never happen + end; + FreeAndNil(UnitVersioningMutex); +end; + +procedure RegisterUnitVersion(Instance: THandle; const Info: TUnitVersionInfo); +var + UnitVersioning: TUnitVersioning; +begin + UnitVersioning := GetUnitVersioning; + if Assigned(UnitVersioning) then + UnitVersioning.Add(Instance, @Info); +end; + +procedure UnregisterUnitVersion(Instance: THandle); +var + UnitVersioning: TUnitVersioning; +begin + UnitVersioning := GetUnitVersioning; + if Assigned(UnitVersioning) then + UnitVersioning.UnregisterModule(Instance); +end; + +procedure ExportUnitVersioningToFile(iFileName : string); +var + I: Integer; + sl: TStringList; +begin + sl := TStringList.Create; + try + for I := 0 to GetUnitVersioning.Count - 1 do + sl.Add(GetUnitVersioning.Items[I].Summary); + sl.Sort; + sl.SaveToFile(iFileName); + finally + sl.Free; + end; +end; + +initialization +{$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); +{$ENDIF UNITVERSIONING} + +finalization +{$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + FinalizeUnitVersioning; + +end. + diff --git a/3rdParty/JCL/source/common/JclUnitVersioningProviders.pas b/3rdParty/JCL/source/common/JclUnitVersioningProviders.pas new file mode 100644 index 00000000..640d4a12 --- /dev/null +++ b/3rdParty/JCL/source/common/JclUnitVersioningProviders.pas @@ -0,0 +1,440 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclUnitVersioningProviders.pas. } +{ } +{ The Initial Developer of the Original Code is Uwe Schuster. } +{ Portions created by Uwe Schuster are Copyright (C) Uwe Schuster. All rights reserved. } +{ } +{ Contributor(s): } +{ Uwe Schuster (uschuster) } +{ } +{**************************************************************************************************} +{ } +{ Contains a TCustomUnitVersioningProvider implementation } +{ } +{ Unit owner: Uwe Schuster } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclUnitVersioningProviders; + +{$I jcl.inc} + +interface + +uses + {$IFDEF HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Winapi.Windows, + JclPeImage, + {$ENDIF MSWINDOWS} + System.SysUtils, System.Classes, System.Contnrs, + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Windows, + JclPeImage, + {$ENDIF MSWINDOWS} + SysUtils, Classes, Contnrs, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF LINUX} + Types, + {$ENDIF LINUX} + JclUnitVersioning; + +type + { TODO : store compressed? } + TJclUnitVersioningList = class(TObject) + private + FItems: TList; + function GetCount: Integer; + function GetItems(AIndex: Integer): PUnitVersionInfo; + public + constructor Create; + destructor Destroy; override; + procedure Add(Info: TUnitVersionInfo); + procedure Clear; + function Load(AModule: HMODULE): Boolean; + function LoadFromStream(AStream: TStream): Boolean; + function LoadFromDefaultResource(AModule: HMODULE): Boolean; + {$IFDEF MSWINDOWS} + function LoadFromDefaultSection(AModule: HMODULE): Boolean; + {$ENDIF MSWINDOWS} + procedure SaveToFile(AFileName: string); + procedure SaveToStream(AStream: TStream); + property Count: Integer read GetCount; + property Items[AIndex: Integer]: PUnitVersionInfo read GetItems; default; + end; + + TJclUnitVersioningProviderModule = class(TObject) + private + FInfoList: TJclUnitVersioningList; + FInstance: THandle; + public + constructor Create(Instance: THandle); + destructor Destroy; override; + property InfoList: TJclUnitVersioningList read FInfoList; + property Instance: THandle read FInstance; + end; + + TJclDefaultUnitVersioningProvider = class(TCustomUnitVersioningProvider) + private + FModules: TObjectList; + function IndexOfInstance(Instance: THandle): Integer; + public + constructor Create; override; + destructor Destroy; override; + procedure LoadModuleUnitVersioningInfo(Instance: THandle); override; + procedure ReleaseModuleUnitVersioningInfo(Instance: THandle); override; + end; + +{$IFDEF MSWINDOWS} +function InsertUnitVersioningSection(const ExecutableFileName: TFileName; + AUnitList: TJclUnitVersioningList): Boolean; +{$ENDIF MSWINDOWS} + +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); + +implementation + +const + JclUnitVersioningDataResName = 'JCLUV'; + +function NewUnitVersionInfo: PUnitVersionInfo; +begin + New(Result); + FillChar(Result^ , SizeOf(Result^), 0); +end; + +procedure DisposeUnitVersionInfo(var Value: PUnitVersionInfo); +begin + StrDispose(Value^.RCSfile); + StrDispose(Value^.Revision); + StrDispose(Value^.Date); + StrDispose(Value^.LogPath); + StrDispose(Value^.Extra); + Dispose(Value); +end; + +function CopyUnitVersionInfo(Src: PUnitVersionInfo): PUnitVersionInfo; +begin + New(Result); + Result^.RCSfile := StrNew(Src^.RCSfile); + Result^.Revision := StrNew(Src^.Revision); + Result^.Date := StrNew(Src^.Date); + Result^.LogPath := StrNew(Src^.LogPath); + Result^.Extra := StrNew(Src^.Extra); + Result^.Data := Src^.Data; +end; + +type + TJclUnitVersioningHeader = record + UnitCount: Integer; + end; + +//=== { TJclUnitVersioningList } ============================================= + +constructor TJclUnitVersioningList.Create; +begin + inherited Create; + FItems := TList.Create; +end; + +destructor TJclUnitVersioningList.Destroy; +begin + Clear; + FItems.Free; + inherited Destroy; +end; + +procedure TJclUnitVersioningList.Add(Info: TUnitVersionInfo); +begin + FItems.Add(CopyUnitVersionInfo(@Info)); +end; + +procedure TJclUnitVersioningList.Clear; +var + I: Integer; + Item: PUnitVersionInfo; +begin + for I := FItems.Count - 1 downto 0 do + begin + Item := PUnitVersionInfo(FItems[I]); + DisposeUnitVersionInfo(Item); + end; + FItems.Clear; +end; + +function TJclUnitVersioningList.GetCount: Integer; +begin + Result := FItems.Count; +end; + +function TJclUnitVersioningList.GetItems(AIndex: Integer): PUnitVersionInfo; +begin + Result := FItems[AIndex]; +end; + +procedure WriteStringToStream(AStream: TStream; const AString: string); +var + StringLength: Integer; +begin + if Assigned(AStream) then + begin + StringLength := Length(AString); + AStream.Write(StringLength, SizeOf(StringLength)); + if StringLength > 0 then + AStream.Write(PChar(AString)^, StringLength); + end; +end; + +function ReadStringFromStream(AStream: TStream; var AString: PChar): Boolean; +var + StringLength: Integer; +begin + Result := False; + AString := ''; + if Assigned(AStream) then + begin + if AStream.Size - AStream.Position >= SizeOf(StringLength) then + begin + StringLength := 0; + AStream.Read(StringLength, SizeOf(StringLength)); + if StringLength <= AStream.Size - AStream.Position then + begin + if StringLength > 0 then + begin + AString := StrAlloc(StringLength); + Result := AStream.Read(AString^, StringLength) = StringLength; + end + else + Result := True; + end; + end; + end; +end; + +function ReadUnitVersionInfo(AStream: TStream; out AVersionInfo: PUnitVersionInfo): Boolean; +begin + AVersionInfo := NewUnitVersionInfo; + Result := True; + Result := Result and ReadStringFromStream(AStream, AVersionInfo^.RCSfile); + Result := Result and ReadStringFromStream(AStream, AVersionInfo^.Revision); + Result := Result and ReadStringFromStream(AStream, AVersionInfo^.Date); + Result := Result and ReadStringFromStream(AStream, AVersionInfo^.LogPath); + Result := Result and ReadStringFromStream(AStream, AVersionInfo^.Extra); + AVersionInfo^.Data := nil; +end; + +function TJclUnitVersioningList.Load(AModule: HMODULE): Boolean; +begin + Result := LoadFromDefaultResource(AModule); + {$IFDEF MSWINDOWS} + if not Result then + Result := LoadFromDefaultSection(AModule); + {$ENDIF MSWINDOWS} +end; + +function TJclUnitVersioningList.LoadFromDefaultResource(AModule: HMODULE): Boolean; +var + ResourceStream: TResourceStream; +begin + Result := False; + if FindResource(AModule, JclUnitVersioningDataResName, RT_RCDATA) <> 0 then + begin + ResourceStream := TResourceStream.Create(AModule, JclUnitVersioningDataResName, RT_RCDATA); + try + Result := LoadFromStream(ResourceStream); + finally + ResourceStream.Free; + end; + end; +end; + +{$IFDEF MSWINDOWS} +function TJclUnitVersioningList.LoadFromDefaultSection(AModule: HMODULE): Boolean; +var + PeSectionStream: TJclPeSectionStream; +begin + Result := False; + if PeMapImgFindSectionFromModule(Pointer(AModule), JclUnitVersioningDataResName) <> nil then + begin + PeSectionStream := TJclPeSectionStream.Create(AModule, JclUnitVersioningDataResName); + try + Result := LoadFromStream(PeSectionStream); + finally + PeSectionStream.Free; + end; + end; +end; +{$ENDIF MSWINDOWS} + +function TJclUnitVersioningList.LoadFromStream(AStream: TStream): Boolean; +var + Header: TJclUnitVersioningHeader; + UnitsToRead: Integer; + LastReadOkay: Boolean; + UnitVersionInfoPtr: PUnitVersionInfo; +begin + Result := False; + if Assigned(AStream) then + begin + Clear; + Header.UnitCount := 0; + AStream.Read(Header, SizeOf(Header)); + UnitsToRead := Header.UnitCount; + LastReadOkay := True; + while (UnitsToRead > 0) and LastReadOkay do + begin + LastReadOkay := ReadUnitVersionInfo(AStream, UnitVersionInfoPtr); + if LastReadOkay then + FItems.Add(UnitVersionInfoPtr); + Dec(UnitsToRead); + end; + Result := (UnitsToRead = 0) and LastReadOkay; + end; +end; + +procedure TJclUnitVersioningList.SaveToFile(AFileName: string); +var + FileStream: TFileStream; +begin + FileStream := TFileStream.Create(AFileName, fmCreate); + try + SaveToStream(FileStream); + finally + FileStream.Free; + end; +end; + +procedure TJclUnitVersioningList.SaveToStream(AStream: TStream); +var + UnitVersioningHeader: TJclUnitVersioningHeader; + I: Integer; +begin + UnitVersioningHeader.UnitCount := Count; + AStream.Write(UnitVersioningHeader, SizeOf(UnitVersioningHeader)); + for I := 0 to Pred(Count) do + with Items[I]^ do + begin + WriteStringToStream(AStream, RCSfile); + WriteStringToStream(AStream, Revision); + WriteStringToStream(AStream, Date); + WriteStringToStream(AStream, LogPath); + WriteStringToStream(AStream, Extra); + end; +end; + +//=== { TJclUnitVersioningProviderModule } =================================== + +{$IFDEF MSWINDOWS} +function InsertUnitVersioningSection(const ExecutableFileName: TFileName; + AUnitList: TJclUnitVersioningList): Boolean; +var + SectionStream: TMemoryStream; +begin + SectionStream := TMemoryStream.Create; + try + Result := Assigned(AUnitList); + if Result then + begin + AUnitList.SaveToStream(SectionStream); + Result := PeInsertSection(ExecutableFileName, SectionStream, + JclUnitVersioningDataResName); + end; + finally + SectionStream.Free; + end; +end; +{$ENDIF MSWINDOWS} + +constructor TJclUnitVersioningProviderModule.Create(Instance: THandle); +var + I: Integer; +begin + inherited Create; + FInstance := Instance; + FInfoList := TJclUnitVersioningList.Create; + if FInfoList.Load(Instance) then + for I := 0 to FInfoList.Count -1 do + RegisterUnitVersion(Instance, FInfoList[I]^); +end; + +destructor TJclUnitVersioningProviderModule.Destroy; +begin + FInfoList.Free; + inherited Destroy; +end; + +//=== { TJclDefaultUnitVersioningProvider } ================================== + +constructor TJclDefaultUnitVersioningProvider.Create; +begin + inherited Create; + FModules := TObjectList.Create; +end; + +destructor TJclDefaultUnitVersioningProvider.Destroy; +begin + FModules.Free; + inherited Destroy; +end; + +function TJclDefaultUnitVersioningProvider.IndexOfInstance(Instance: THandle): Integer; +var + I: Integer; +begin + Result := -1; + for I := 0 to FModules.Count - 1 do + if TJclUnitVersioningProviderModule(FModules[I]).Instance = Instance then + begin + Result := I; + Break; + end; +end; + +procedure TJclDefaultUnitVersioningProvider.LoadModuleUnitVersioningInfo(Instance: THandle); +begin + if IndexOfInstance(Instance) < 0 then + FModules.Add(TJclUnitVersioningProviderModule.Create(Instance)); +end; + +procedure TJclDefaultUnitVersioningProvider.ReleaseModuleUnitVersioningInfo(Instance: THandle); +var + Idx: Integer; +begin + Idx := IndexOfInstance(Instance); + if Idx <> -1 then + FModules.Delete(Idx); +end; + +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); + +end. diff --git a/3rdParty/JCL/source/common/JclUsesUtils.pas b/3rdParty/JCL/source/common/JclUsesUtils.pas new file mode 100644 index 00000000..685d5f74 --- /dev/null +++ b/3rdParty/JCL/source/common/JclUsesUtils.pas @@ -0,0 +1,944 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclParseUses.pas. } +{ } +{ The Initial Developer of the Original Code is TOndrej (tondrej att t-online dott de). } +{ Portions created by TOndrej are Copyright (C) of TOndrej. } +{ } +{ Contributors: } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclUsesUtils; + +{$I jcl.inc} + +interface + +uses + {$IFDEF HAS_UNITSCOPE} + System.Classes, System.SysUtils, Winapi.Windows, + {$ELSE ~HAS_UNITSCOPE} + Classes, SysUtils, Windows, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclBase; + +type + EUsesListError = class(EJclError); + + TUsesList = class + private + FText: string; + function GetCount: Integer; + function GetItems(Index: Integer): string; + public + constructor Create(const AText: PChar); + function Add(const UnitName: string): Integer; + function IndexOf(const UnitName: string): Integer; + procedure Insert(Index: Integer; const UnitName: string); + procedure Remove(Index: Integer); + property Text: string read FText; + property Count: Integer read GetCount; + property Items[Index: Integer]: string read GetItems; default; + end; + + TCustomGoal = class + public + constructor Create(Text: PChar); virtual; abstract; + end; + + TProgramGoal = class(TCustomGoal) + private + FTextAfterUses: string; + FTextBeforeUses: string; + FUsesList: TUsesList; + public + constructor Create(Text: PChar); override; + destructor Destroy; override; + property TextAfterUses: string read FTextAfterUses; + property TextBeforeUses: string read FTextBeforeUses; + property UsesList: TUsesList read FUsesList; + end; + + TLibraryGoal = class(TCustomGoal) + private + FTextAfterUses: string; + FTextBeforeUses: string; + FUsesList: TUsesList; + public + constructor Create(Text: PChar); override; + destructor Destroy; override; + property TextAfterUses: string read FTextAfterUses; + property TextBeforeUses: string read FTextBeforeUses; + property UsesList: TUsesList read FUsesList; + end; + + TUnitGoal = class(TCustomGoal) + private + FTextAfterImpl: string; + FTextAfterIntf: string; + FTextBeforeIntf: string; + FUsesImpl: TUsesList; + FUsesIntf: TUsesList; + public + constructor Create(Text: PChar); override; + destructor Destroy; override; + property TextAfterImpl: string read FTextAfterImpl; + property TextAfterIntf: string read FTextAfterIntf; + property TextBeforeIntf: string read FTextBeforeIntf; + property UsesImpl: TUsesList read FUsesImpl; + property UsesIntf: TUsesList read FUsesIntf; + end; + +function CreateGoal(Text: PChar): TCustomGoal; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.RtlConsts, + {$IFDEF HAS_UNIT_CHARACTER} + System.Character, + {$ENDIF HAS_UNIT_CHARACTER} + {$ELSE ~HAS_UNITSCOPE} + RtlConsts, + {$IFDEF HAS_UNIT_CHARACTER} + Character, + {$ENDIF HAS_UNIT_CHARACTER} + {$ENDIF ~HAS_UNITSCOPE} + JclStrings, + JclDevToolsResources; + +const + SLibrary = 'library'; + SProgram = 'program'; + SUnit = 'unit'; + SUses = 'uses'; + +function CharIsNotWhiteSpace(const C: Char): Boolean; +begin + Result := not CharIsWhiteSpace(C); +end; + +function PeekIdentifier(var P:PChar):boolean;forward; + +function PeekKeyword(var P: PChar; Keyword: PChar): Boolean; forward; +function ReadIdentifier(var P: PChar): string; forward; +procedure SkipCommentsAndBlanks(var P: PChar); forward; + +function CheckIdentifier(var P: PChar): Boolean; +begin + Result := CharIsAlpha(P^) or (P^ = '_'); + if Result then + begin + Inc(P); + while CharIsValidIdentifierLetter(P^) or (P^ = '.') do + Inc(P); + end; +end; + +function CheckKeyword(var P: PChar; Keyword: PChar): Boolean; +var + KeywordLen: Integer; +begin + KeywordLen := StrLen(Keyword); + Result := StrLIComp(P, Keyword, KeywordLen) = 0; + if Result then + Inc(P, KeywordLen); +end; + +function CreateGoal(Text: PChar): TCustomGoal; +var + P: PChar; +begin + Result := nil; + P := Text; + + SkipCommentsAndBlanks(P); + if PeekKeyword(P, SProgram) then + Result := TProgramGoal.Create(Text) + else + if PeekKeyword(P, SLibrary) then + Result := TLibraryGoal.Create(Text) + else + if PeekKeyword(P, SUnit) then + Result := TUnitGoal.Create(Text); +end; + +function PeekKeyword(var P: PChar; Keyword: PChar): Boolean; +var + KeywordLen: Integer; +begin + KeywordLen := StrLen(Keyword); + Result := StrLIComp(P, KeyWord, KeywordLen) = 0; +end; + +//---------------------------------------------------------------------------- + +function PeekIdentifier(var P: PChar):boolean; +var Q:PChar; +begin + Q := P; + Result := CheckIdentifier(P); + P := Q; +end; + + +function ReadIdentifier(var P: PChar): string; +var + PStart: PChar; +begin + Result := ''; + + if CharIsAlpha(P^) then + begin + PStart := P; + + Inc(P); + while CharIsValidIdentifierLetter(P^) or (P^ = '.') do + Inc(P); + + SetString(Result, PStart, P - PStart); + end; +end; + +procedure SkipComments(var P: PChar); +var + Test: PChar; +begin + if P^ = '{' then + begin + Test := StrScan(P, '}'); + if Test <> nil then + P := Test + 1; + end + else + if StrLComp(P, '(*', 2) = 0 then + begin + Test := StrPos(P, '*)'); + if Test <> nil then + P := Test + 2; + end + else + if StrLComp(P, '//', 2) = 0 then + begin + Test := StrPos(P, #13#10); + if Test <> nil then + P := Test + 2; + end; +end; + +procedure SkipCommentsAndBlanks(var P: PChar); +var + Test: PChar; +begin + repeat + Test := P; + StrSkipChars(P, CharIsWhiteSpace); + SkipComments(P); + until Test = P; +end; + +//=== { TUsesList } ========================================================== + +constructor TUsesList.Create(const AText: PChar); +var + P, PStart: PChar; +begin + inherited Create; + FText := ''; + if AText = nil then + Exit; + + PStart := PChar(AText); + P := PStart; + if CheckKeyword(P, SUses) then + begin + while P^ <> #0 do + begin + SkipCommentsAndBlanks(P); + if not CheckIdentifier(P) then + raise EUsesListError.CreateRes(@RsEInvalidUses); + SkipCommentsAndBlanks(P); + + if PeekKeyword(P, 'in') then + begin + Inc(P, 2); + SkipCommentsAndBlanks(P); + if P^ <> '''' then + raise EUsesListError.CreateRes(@RsEInvalidUses); + Inc(P); + + while (P^ <> #0) and (P^ <> '''') do + Inc(P); + if P^ <> '''' then + raise EUsesListError.CreateRes(@RsEInvalidUses); + Inc(P); + SkipCommentsAndBlanks(P); + end; + + case P^ of + ',': + Inc(P); + ';': + begin + Inc(P); + Break; + end; + else + if not PeekIdentifier(P) then + raise EUsesListError.CreateRes(@RsEInvalidUses); + end; + end; + + SetString(FText, PStart, P - PStart); + end; +end; + +function TUsesList.GetCount: Integer; +var + P: PChar; +begin + Result := 0; + + if FText = '' then + Exit; + + P := PChar(FText); + // an empty uses clause consisting of only blanks and comments + // (resulting from removal of the last unit) is valid too + SkipCommentsAndBlanks(P); + if P^ = #0 then + Exit; + + if not CheckKeyword(P, SUses) then + raise EUsesListError.CreateRes(@RsEInvalidUses); + + while P^ <> #0 do + begin + SkipCommentsAndBlanks(P); + if not CheckIdentifier(P) then + raise EUsesListError.CreateRes(@RsEInvalidUses); + Inc(Result); + SkipCommentsAndBlanks(P); + + if PeekKeyword(P, 'in') then + begin + Inc(P, 2); + SkipCommentsAndBlanks(P); + if P^ <> '''' then + raise EUsesListError.CreateRes(@RsEInvalidUses); + Inc(P); + + while (P^ <> #0) and (P^ <> '''') do + Inc(P); + if P^ <> '''' then + raise EUsesListError.CreateRes(@RsEInvalidUses); + Inc(P); + SkipCommentsAndBlanks(P); + end; + + case P^ of + ',': + Inc(P); + ';': + Break; + else + if not PeekIdentifier(P) then + raise EUsesListError.CreateRes(@RsEInvalidUses); + end; + end; +end; + +function TUsesList.GetItems(Index: Integer): string; +var + P, PIdentifier: PChar; + I: Integer; +begin + Result := ''; + + if (Index < 0) or (Index > Count - 1) then + raise EUsesListError.CreateResFmt(@SListIndexError, [Index]); + + P := PChar(FText); + if not CheckKeyword(P, SUses) then + raise EUsesListError.CreateRes(@RsEInvalidUses); + I := -1; + while P^ <> #0 do + begin + SkipCommentsAndBlanks(P); + PIdentifier := P; + if not CheckIdentifier(P) then + raise EUsesListError.CreateRes(@RsEInvalidUses); + + Inc(I); + if I = Index then + begin + while CharIsValidIdentifierLetter(PIdentifier^) or (P^ = '.') do + begin + Result := Result + PIdentifier^; + Inc(PIdentifier); + end; + Exit; + end; + SkipCommentsAndBlanks(P); + + if PeekKeyword(P, 'in') then + begin + Inc(P, 2); + SkipCommentsAndBlanks(P); + if P^ <> '''' then + raise EUsesListError.CreateRes(@RsEInvalidUses); + Inc(P); + + while (P^ <> #0) and (P^ <> '''') do + Inc(P); + if P^ <> '''' then + raise EUsesListError.CreateRes(@RsEInvalidUses); + Inc(P); + SkipCommentsAndBlanks(P); + end; + + case P^ of + ',': + Inc(P); + ';': + Break; + else + if not PeekIdentifier(P) then + raise EUsesListError.CreateRes(@RsEInvalidUses); + end; + end; +end; + +function TUsesList.Add(const UnitName: string): Integer; +var + I: Integer; + P: PChar; +begin + Result := -1; + + I := IndexOf(UnitName); + if I <> -1 then + raise EUsesListError.CreateResFmt(@RsEDuplicateUnit, [UnitName]); + + if FText = '' then + begin + FText := Format('%s'#13#10' %s;'#13#10#13#10, [SUses, UnitName]); + try + Result := IndexOf(UnitName); + except + FText := ''; + raise; + end; + end + else + begin + P := PChar(FText); + if not CheckKeyword(P, SUses) then + raise EUsesListError.CreateRes(@RsEInvalidUses); + + while P^ <> #0 do + begin + SkipCommentsAndBlanks(P); + if not CheckIdentifier(P) then + raise EUsesListError.CreateRes(@RsEInvalidUses); + + SkipCommentsAndBlanks(P); + + if PeekKeyword(P, 'in') then + begin + Inc(P, 2); + SkipCommentsAndBlanks(P); + if P^ <> '''' then + raise EUsesListError.CreateRes(@RsEInvalidUses); + Inc(P); + + while (P^ <> #0) and (P^ <> '''') do + Inc(P); + if P^ <> '''' then + raise EUsesListError.CreateRes(@RsEInvalidUses); + Inc(P); + SkipCommentsAndBlanks(P); + end; + + case P^ of + ',': + Inc(P); + ';': + begin + System.Insert(Format(', %s', [UnitName]), FText, P - PChar(FText) + 1); + Result := IndexOf(UnitName); + Break; + end; + else + raise EUsesListError.CreateRes(@RsEInvalidUses); + end; + end; + end; +end; + +function TUsesList.IndexOf(const UnitName: string): Integer; +var + P, PIdentifier: PChar; + Identifier: string; + I: Integer; +begin + Result := -1; + + if FText = '' then + Exit; + + P := PChar(FText); + if not CheckKeyword(P, SUses) then + raise EUsesListError.CreateRes(@RsEInvalidUses); + + I := -1; + while P^ <> #0 do + begin + SkipCommentsAndBlanks(P); + PIdentifier := P; + if not CheckIdentifier(P) then + raise EUsesListError.CreateRes(@RsEInvalidUses); + SetString(Identifier, PIdentifier, P - PIdentifier); + + Inc(I); + if AnsiCompareText(UnitName, Identifier) = 0 then + begin + Result := I; + Exit; + end; + SkipCommentsAndBlanks(P); + + if PeekKeyword(P, 'in') then + begin + Inc(P, 2); + SkipCommentsAndBlanks(P); + if P^ <> '''' then + raise EUsesListError.CreateRes(@RsEInvalidUses); + Inc(P); + + while (P^ <> #0) and (P^ <> '''') do + Inc(P); + if P^ <> '''' then + raise EUsesListError.CreateRes(@RsEInvalidUses); + Inc(P); + SkipCommentsAndBlanks(P); + end; + + case P^ of + ',': + Inc(P); + ';': + Break; + else + raise EUsesListError.CreateRes(@RsEInvalidUses); + end; + end; +end; + +procedure TUsesList.Insert(Index: Integer; const UnitName: string); +var + I: Integer; + P: PChar; +begin + if (Index < 0) or (Index > Count - 1) then + raise EUsesListError.CreateResFmt(@SListIndexError, [Index]); + I := IndexOf(UnitName); + if I <> -1 then + raise EUsesListError.CreateResFmt(@RsEDuplicateUnit, [UnitName]); + + if FText = '' then + begin + FText := Format('%s'#13#10' %s;'#13#10#13#10, [SUses, UnitName]); + try + if Index <> IndexOf(UnitName) then + Exit; + except + FText := ''; + raise; + end; + end + else + begin + P := PChar(FText); + if not CheckKeyword(P, SUses) then + raise EUsesListError.CreateRes(@RsEInvalidUses); + + I := -1; + while P^ <> #0 do + begin + SkipCommentsAndBlanks(P); + Inc(I); + if I = Index then + begin + System.Insert(Format('%s, ', [UnitName]), FText, P - PChar(FText) + 1); + Exit; + end; + + if not CheckIdentifier(P) then + raise EUsesListError.CreateRes(@RsEInvalidUses); + SkipCommentsAndBlanks(P); + + if PeekKeyword(P, 'in') then + begin + Inc(P, 2); + SkipCommentsAndBlanks(P); + if P^ <> '''' then + raise EUsesListError.CreateRes(@RsEInvalidUses); + Inc(P); + + while (P^ <> #0) and (P^ <> '''') do + Inc(P); + if P^ <> '''' then + raise EUsesListError.CreateRes(@RsEInvalidUses); + Inc(P); + SkipCommentsAndBlanks(P); + end; + + case P^ of + ',': + Inc(P); + else + raise EUsesListError.CreateRes(@RsEInvalidUses); + end; + end; + end; +end; + +procedure TUsesList.Remove(Index: Integer); +var + Count, I, DelPos: Integer; + P, PIdentifier: PChar; +begin + Count := GetCount; + if (Index < 0) or (Index > Count - 1) then + raise EUsesListError.CreateResFmt(@SListIndexError, [Index]); + + P := PChar(FText); + if not CheckKeyword(P, SUses) then + raise EUsesListError.CreateRes(@RsEInvalidUses); + + if (Count = 1) and (Index = 0) then + begin + Delete(FText, 1, Length(SUses)); + P := PChar(FText); + end; + + I := -1; + while P^ <> #0 do + begin + SkipCommentsAndBlanks(P); + Inc(I); + + if I = Index then + begin + // remove unit + PIdentifier := P; + if not CheckIdentifier(P) then + raise EUsesListError.CreateRes(@RsEInvalidUses); + DelPos := PIdentifier - PChar(FText) + 1; + Delete(FText, DelPos, P - PIdentifier); + // skip comments and blanks + P := PChar(FText) + DelPos - 1; + PIdentifier := P; + SkipCommentsAndBlanks(P); + // check in syntax + if PeekKeyword(P, 'in') then + begin + Inc(P, 2); + SkipCommentsAndBlanks(P); + if P^ <> '''' then + raise EUsesListError.CreateRes(@RsEInvalidUses); + Inc(P); + + while (P^ <> #0) and (P^ <> '''') do + Inc(P); + if P^ <> '''' then + raise EUsesListError.CreateRes(@RsEInvalidUses); + Inc(P); + SkipCommentsAndBlanks(P); + DelPos := PIdentifier - PChar(FText) + 1; + Delete(FText, DelPos, P - PIdentifier); + P := PChar(FText) + DelPos - 1; + end; + + // remove separator + case P^ of + ',', ';': + begin + DelPos := P - PChar(FText) + 1; + Delete(FText, DelPos, 1); + end; + else + raise EUsesListError.CreateRes(@RsEInvalidUses); + end; + // remove trailing spaces, if any + PIdentifier := PChar(FText) + DelPos - 1; + P := PIdentifier; + StrSkipChars(P, CharIsWhiteSpace); + DelPos := PIdentifier - PChar(FText) + 1; + Delete(FText, DelPos, P - PIdentifier); + // skip further comments and blanks + P := PChar(FText) + DelPos - 1; + SkipCommentsAndBlanks(P); + Exit; + end; + if not CheckIdentifier(P) then + raise EUsesListError.CreateRes(@RsEInvalidUses); + + SkipCommentsAndBlanks(P); + if PeekKeyword(P, 'in') then + begin + Inc(P, 2); + SkipCommentsAndBlanks(P); + if P^ <> '''' then + raise EUsesListError.CreateRes(@RsEInvalidUses); + Inc(P); + + while (P^ <> #0) and (P^ <> '''') do + Inc(P); + if P^ <> '''' then + raise EUsesListError.CreateRes(@RsEInvalidUses); + Inc(P); + SkipCommentsAndBlanks(P); + end; + + case P^ of + ',', ';': + begin + // make sure semicolon is the last separator in case the last unit is going to be removed + if (Index = Count - 1) and (I = Index - 1) then + P^ := ';'; + Inc(P); + end; + else + raise EUsesListError.CreateRes(@RsEInvalidUses); + end; + end; +end; + +//=== { TProgramGoal } ======================================================= + +constructor TProgramGoal.Create(Text: PChar); +var + P, PStart: PChar; +begin + FTextBeforeUses := ''; + FTextAfterUses := ''; + + PStart := Text; + P := PStart; + + // check 'program' label + SkipCommentsAndBlanks(P); + if not CheckKeyword(P, SProgram) then + raise EUsesListError.CreateRes(@RsEInvalidProgram); + SkipCommentsAndBlanks(P); + if not CheckIdentifier(P) then + raise EUsesListError.CreateRes(@RsEInvalidProgram); + SkipCommentsAndBlanks(P); + if P^ <> ';' then + raise EUsesListError.CreateRes(@RsEInvalidProgram); + Inc(P); + SkipCommentsAndBlanks(P); + + // remember text before uses + SetString(FTextBeforeUses, PStart, P - PStart); + + if PeekKeyword(P, SUses) then + begin + FUsesList := TUsesList.Create(P); + PStart := P + Length(FUsesList.Text); + end + else // empty uses list + begin + FUsesList := TUsesList.Create(nil); + PStart := P; + end; + // remember text after uses + P := StrEnd(PStart); + SetString(FTextAfterUses, PStart, P - PStart); +end; + +destructor TProgramGoal.Destroy; +begin + FUsesList.Free; + inherited Destroy; +end; + +//=== { TLibraryGoal } ======================================================= + +constructor TLibraryGoal.Create(Text: PChar); +var + P, PStart: PChar; +begin + FTextBeforeUses := ''; + FTextAfterUses := ''; + + PStart := Text; + P := PStart; + + // check 'library' label + SkipCommentsAndBlanks(P); + if not CheckKeyword(P, SLibrary) then + raise EUsesListError.CreateRes(@RsEInvalidLibrary); + SkipCommentsAndBlanks(P); + if not CheckIdentifier(P) then + raise EUsesListError.CreateRes(@RsEInvalidLibrary); + SkipCommentsAndBlanks(P); + if P^ <> ';' then + raise EUsesListError.CreateRes(@RsEInvalidLibrary); + Inc(P); + SkipCommentsAndBlanks(P); + + // remember text before uses + SetString(FTextBeforeUses, PStart, P - PStart); + + if PeekKeyword(P, SUses) then + begin + FUsesList := TUsesList.Create(P); + PStart := P + Length(FUsesList.Text); + end + else // empty uses list + begin + FUsesList := TUsesList.Create(nil); + PStart := P; + end; + // remember text after uses + P := StrEnd(PStart); + SetString(FTextAfterUses, PStart, P - PStart); +end; + +destructor TLibraryGoal.Destroy; +begin + FUsesList.Free; + inherited Destroy; +end; + +//=== { TUnitGoal } ========================================================== + +constructor TUnitGoal.Create(Text: PChar); +var + P, PStart: PChar; +begin + FTextBeforeIntf := ''; + FTextAfterIntf := ''; + FTextAfterImpl := ''; + + PStart := Text; + P := PStart; + + // check 'unit' label + SkipCommentsAndBlanks(P); + while (P^ <> #0) and not PeekKeyword(P, 'unit') do + begin + StrSkipChars(P, CharIsNotWhiteSpace); + SkipCommentsAndBlanks(P); + end; + if not CheckKeyword(P, SUnit) then + raise EUsesListError.CreateRes(@RsEInvalidUnit); + SkipCommentsAndBlanks(P); + if not CheckIdentifier(P) then + raise EUsesListError.CreateRes(@RsEInvalidUnit); + SkipCommentsAndBlanks(P); + if P^ <> ';' then + raise EUsesListError.CreateRes(@RsEInvalidUnit); + Inc(P); + // check 'interface' label +// SkipCommentsAndBlanks(P); + while (P^ <> #0) and not PeekKeyword(P, 'interface') do + begin + StrSkipChars(P, CharIsNotWhiteSpace); + SkipCommentsAndBlanks(P); + end; + if not CheckKeyword(P, 'interface') then + raise EUsesListError.CreateRes(@RsEInvalidUnit); + SkipCommentsAndBlanks(P); + + // remember text before interface uses + SetString(FTextBeforeIntf, PStart, P - PStart); + if PeekKeyword(P, SUses) then + begin + FUsesIntf := TUsesList.Create(P); + PStart := P + Length(FUsesIntf.Text); + end + else + begin + FUsesIntf := TUsesList.Create(nil); + PStart := P; + end; + // locate implementation + while (P^ <> #0) and not PeekKeyword(P, 'implementation') do + begin + StrSkipChars(P, CharIsNotWhiteSpace); + SkipCommentsAndBlanks(P); + end; + if not CheckKeyword(P, 'implementation') then + raise EUsesListError.CreateRes(@RsEInvalidUnit); + SkipCommentsAndBlanks(P); + + // remember text after interface uses + SetString(FTextAfterIntf, PStart, P - PStart); + if PeekKeyword(P, SUses) then + begin + FUsesImpl := TUsesList.Create(P); + PStart := P + Length(FUsesImpl.Text); + end + else + begin + FUsesImpl := TUsesList.Create(nil); + PStart := P; + end; + // remember text after implementation uses + P := StrEnd(PStart); + SetString(FTextAfterImpl, PStart, P - PStart); +end; + +destructor TUnitGoal.Destroy; +begin + FUsesIntf.Free; + FUsesImpl.Free; + inherited Destroy; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclValidation.pas b/3rdParty/JCL/source/common/JclValidation.pas new file mode 100644 index 00000000..49b01cce --- /dev/null +++ b/3rdParty/JCL/source/common/JclValidation.pas @@ -0,0 +1,193 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclValidation.pas } +{ } +{ The Initial Developer of the Original Code is Ivo Bauer. } +{ Portions created by Ivo Bauer are Copyright Ivo Bauer. All rights reserved. } +{ } +{ Contributor(s): } +{ } +{**************************************************************************************************} +{ } +{ This unit contains ISBN validation routines } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclValidation; + +{$I jcl.inc} + +interface + +{$IFDEF UNITVERSIONING} +uses + JclUnitVersioning; +{$ENDIF UNITVERSIONING} + +// ISBN: International Standard Book Number +function IsValidISBN(const ISBN: string): Boolean; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + JclBase, + JclSysUtils; + +{ TODO -cDoc : Donator: Ivo Bauer } +function IsValidISBN(const ISBN: string): Boolean; +// +// References: +// =========== +// [1] http://isbn-international.org/en/userman/chapter4.html +// +type + TISBNPart = (ipGroupID, ipPublisherID, ipTitleID, ipCheckDigit); + TISBNPartSizes = array [TISBNPart] of Integer; +const + ISBNSize = 13; + +function CharIsISBNSpecialDigit(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +begin + case C of + 'x', 'X': + Result := True; + else + Result := False; + end; +end; + +function CharIsISBNSeparator(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +begin + case C of + #32, '-': + Result := True; + else + Result := False; + end; +end; + +function CharIsISBNCharacter(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +begin + case C of + '0'..'9', + 'x', 'X', + #32, '-': + Result := True; + else + Result := False; + end; +end; + +var + CurPtr, EndPtr: Integer; + Accumulator, Counter: Integer; + Part: TISBNPart; + PartSizes: TISBNPartSizes; + + function IsPartSizeValid(APart: TISBNPart): Boolean; + const + MaxPartSizes: TISBNPartSizes = (5, 7, 6, 1); + begin + Result := PartSizes[APart] <= MaxPartSizes[APart]; + end; + +begin + Result := False; + // At first, check the overall string length. + if Length(ISBN) <> ISBNSize then + Exit; + + CurPtr := 1; + EndPtr := ISBNSize - 1; + Accumulator := 0; + Counter := 10; + Part := ipGroupID; + ResetMemory(PartSizes[Low(PartSizes)], SizeOf(PartSizes)); + + while CurPtr <= EndPtr do + begin + if CharIsISBNCharacter(ISBN[CurPtr]) then + begin + if CharIsISBNSeparator(ISBN[CurPtr]) then + begin + // Switch to the next ISBN part, but take care of two conditions: + // 1. Do not let Part go beyond its upper bound (ipCheckDigit). + // 2. Verify if the current ISBN part does not exceed its size limit. + if (Part < High(Part)) and IsPartSizeValid(Part) then + Inc(Part) + else + Exit; + end + else // CurPtr^ in [ISBNDigits, ISBNSpecialDigits] + begin + // Is it the last character of the string? + if (CurPtr = EndPtr) then + begin + // Check the following conditions: + // 1. Make sure current ISBN Part equals to ipCheckDigit. + // 2. Verify if the check digit does not exceed its size limit. + if (Part <> High(Part)) and not IsPartSizeValid(Part) then + Exit; + end + else + // Special check digit is allowed to occur only at the end of ISBN. + if CharIsISBNSpecialDigit(ISBN[CurPtr]) then + Exit; + + // Increment the size of the current ISBN part. + Inc(PartSizes[Part]); + + // Increment the accumulator by current ISBN digit multiplied by a weight. + // To get more detailed information, please refer to the web site [1]. + if (CurPtr = EndPtr) and CharIsISBNSpecialDigit(ISBN[CurPtr]) then + Inc(Accumulator, 10 * Counter) + else + Inc(Accumulator, (Ord(ISBN[CurPtr]) - Ord('0')) * Counter); + Dec(Counter); + end; + Inc(CurPtr); + end + else + Exit; + end; + // Accumulator content must be divisible by 11 without a remainder. + Result := (Accumulator mod 11) = 0; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/JclVectors.pas b/3rdParty/JCL/source/common/JclVectors.pas new file mode 100644 index 00000000..1062bdf5 --- /dev/null +++ b/3rdParty/JCL/source/common/JclVectors.pas @@ -0,0 +1,12002 @@ +{**************************************************************************************************} +{ WARNING: JEDI preprocessor generated unit. Do not edit. } +{**************************************************************************************************} + +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is Vector.pas. } +{ } +{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } +{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } +{ All rights reserved. } +{ } +{ Contributors: } +{ Daniele Teti (dade2004) } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclVectors; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Classes, + {$ENDIF ~HAS_UNITSCOPE} + JclAlgorithms, JclBase, JclAbstractContainers, JclContainerIntf, JclSynch; + + +type + TItrStart = (isFirst, isLast); + TJclIntfVector = class(TJclIntfAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclIntfContainer, IJclIntfFlatContainer, IJclIntfEqualityComparer, + IJclIntfCollection, IJclIntfList, IJclIntfArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FItems: TDynIInterfaceArray; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: IInterface; + public + constructor Create(ACapacity: Integer); overload; + constructor Create(const ACollection: IJclIntfCollection); overload; + destructor Destroy; override; + property Items: TDynIInterfaceArray read FItems; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclIntfCollection } + function Add(const AInterface: IInterface): Boolean; + function AddAll(const ACollection: IJclIntfCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclIntfCollection): Boolean; + function Contains(const AInterface: IInterface): Boolean; + function ContainsAll(const ACollection: IJclIntfCollection): Boolean; + function Extract(const AInterface: IInterface): Boolean; + function ExtractAll(const ACollection: IJclIntfCollection): Boolean; + function First: IJclIntfIterator; + function IsEmpty: Boolean; + function Last: IJclIntfIterator; + function Remove(const AInterface: IInterface): Boolean; + function RemoveAll(const ACollection: IJclIntfCollection): Boolean; + function RetainAll(const ACollection: IJclIntfCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIntfIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclIntfList } + function Delete(Index: Integer): IInterface; + function ExtractIndex(Index: Integer): IInterface; + function GetObject(Index: Integer): IInterface; + function IndexOf(const AInterface: IInterface): Integer; + function Insert(Index: Integer; const AInterface: IInterface): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclIntfCollection): Boolean; + function LastIndexOf(const AInterface: IInterface): Integer; + procedure SetObject(Index: Integer; const AInterface: IInterface); + function SubList(First, Count: Integer): IJclIntfList; + end; + + TJclIntfVectorIterator = class(TJclAbstractIterator, IJclIntfIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclIntfVector; + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + public + constructor Create(AOwnList: TJclIntfVector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclIntfIterator } + function Add(const AInterface: IInterface): Boolean; + procedure Extract; + function GetObject: IInterface; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AInterface: IInterface): Boolean; + function IteratorEquals(const AIterator: IJclIntfIterator): Boolean; + function Next: IInterface; + function NextIndex: Integer; + function Previous: IInterface; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetObject(const AInterface: IInterface); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: IInterface read GetObject; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclAnsiStrVector = class(TJclAnsiStrAbstractCollection, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclAnsiStrContainer, IJclAnsiStrFlatContainer, IJclAnsiStrEqualityComparer, IJclStrBaseContainer, + IJclAnsiStrCollection, IJclAnsiStrList, IJclAnsiStrArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FItems: TDynAnsiStringArray; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: AnsiString; + public + constructor Create(ACapacity: Integer); overload; + constructor Create(const ACollection: IJclAnsiStrCollection); overload; + destructor Destroy; override; + property Items: TDynAnsiStringArray read FItems; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclAnsiStrCollection } + function Add(const AString: AnsiString): Boolean; override; + function AddAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + procedure Clear; override; + function CollectionEquals(const ACollection: IJclAnsiStrCollection): Boolean; override; + function Contains(const AString: AnsiString): Boolean; override; + function ContainsAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + function Extract(const AString: AnsiString): Boolean; override; + function ExtractAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + function First: IJclAnsiStrIterator; override; + function IsEmpty: Boolean; override; + function Last: IJclAnsiStrIterator; override; + function Remove(const AString: AnsiString): Boolean; override; + function RemoveAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + function RetainAll(const ACollection: IJclAnsiStrCollection): Boolean; override; + function Size: Integer; override; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclAnsiStrIterator; override; + {$ENDIF SUPPORTS_FOR_IN} + { IJclAnsiStrList } + function Delete(Index: Integer): AnsiString; + function ExtractIndex(Index: Integer): AnsiString; + function GetString(Index: Integer): AnsiString; + function IndexOf(const AString: AnsiString): Integer; + function Insert(Index: Integer; const AString: AnsiString): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclAnsiStrCollection): Boolean; + function LastIndexOf(const AString: AnsiString): Integer; + procedure SetString(Index: Integer; const AString: AnsiString); + function SubList(First, Count: Integer): IJclAnsiStrList; + end; + + TJclAnsiStrVectorIterator = class(TJclAbstractIterator, IJclAnsiStrIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclAnsiStrVector; + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + public + constructor Create(AOwnList: TJclAnsiStrVector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclAnsiStrIterator } + function Add(const AString: AnsiString): Boolean; + procedure Extract; + function GetString: AnsiString; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AString: AnsiString): Boolean; + function IteratorEquals(const AIterator: IJclAnsiStrIterator): Boolean; + function Next: AnsiString; + function NextIndex: Integer; + function Previous: AnsiString; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetString(const AString: AnsiString); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: AnsiString read GetString; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclWideStrVector = class(TJclWideStrAbstractCollection, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclWideStrContainer, IJclWideStrFlatContainer, IJclWideStrEqualityComparer, IJclStrBaseContainer, + IJclWideStrCollection, IJclWideStrList, IJclWideStrArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FItems: TDynWideStringArray; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: WideString; + public + constructor Create(ACapacity: Integer); overload; + constructor Create(const ACollection: IJclWideStrCollection); overload; + destructor Destroy; override; + property Items: TDynWideStringArray read FItems; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclWideStrCollection } + function Add(const AString: WideString): Boolean; override; + function AddAll(const ACollection: IJclWideStrCollection): Boolean; override; + procedure Clear; override; + function CollectionEquals(const ACollection: IJclWideStrCollection): Boolean; override; + function Contains(const AString: WideString): Boolean; override; + function ContainsAll(const ACollection: IJclWideStrCollection): Boolean; override; + function Extract(const AString: WideString): Boolean; override; + function ExtractAll(const ACollection: IJclWideStrCollection): Boolean; override; + function First: IJclWideStrIterator; override; + function IsEmpty: Boolean; override; + function Last: IJclWideStrIterator; override; + function Remove(const AString: WideString): Boolean; override; + function RemoveAll(const ACollection: IJclWideStrCollection): Boolean; override; + function RetainAll(const ACollection: IJclWideStrCollection): Boolean; override; + function Size: Integer; override; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclWideStrIterator; override; + {$ENDIF SUPPORTS_FOR_IN} + { IJclWideStrList } + function Delete(Index: Integer): WideString; + function ExtractIndex(Index: Integer): WideString; + function GetString(Index: Integer): WideString; + function IndexOf(const AString: WideString): Integer; + function Insert(Index: Integer; const AString: WideString): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclWideStrCollection): Boolean; + function LastIndexOf(const AString: WideString): Integer; + procedure SetString(Index: Integer; const AString: WideString); + function SubList(First, Count: Integer): IJclWideStrList; + end; + + TJclWideStrVectorIterator = class(TJclAbstractIterator, IJclWideStrIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclWideStrVector; + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + public + constructor Create(AOwnList: TJclWideStrVector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclWideStrIterator } + function Add(const AString: WideString): Boolean; + procedure Extract; + function GetString: WideString; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AString: WideString): Boolean; + function IteratorEquals(const AIterator: IJclWideStrIterator): Boolean; + function Next: WideString; + function NextIndex: Integer; + function Previous: WideString; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetString(const AString: WideString); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: WideString read GetString; + {$ENDIF SUPPORTS_FOR_IN} + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclUnicodeStrVector = class(TJclUnicodeStrAbstractCollection, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclUnicodeStrContainer, IJclUnicodeStrFlatContainer, IJclUnicodeStrEqualityComparer, IJclStrBaseContainer, + IJclUnicodeStrCollection, IJclUnicodeStrList, IJclUnicodeStrArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FItems: TDynUnicodeStringArray; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: UnicodeString; + public + constructor Create(ACapacity: Integer); overload; + constructor Create(const ACollection: IJclUnicodeStrCollection); overload; + destructor Destroy; override; + property Items: TDynUnicodeStringArray read FItems; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclUnicodeStrCollection } + function Add(const AString: UnicodeString): Boolean; override; + function AddAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + procedure Clear; override; + function CollectionEquals(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function Contains(const AString: UnicodeString): Boolean; override; + function ContainsAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function Extract(const AString: UnicodeString): Boolean; override; + function ExtractAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function First: IJclUnicodeStrIterator; override; + function IsEmpty: Boolean; override; + function Last: IJclUnicodeStrIterator; override; + function Remove(const AString: UnicodeString): Boolean; override; + function RemoveAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function RetainAll(const ACollection: IJclUnicodeStrCollection): Boolean; override; + function Size: Integer; override; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclUnicodeStrIterator; override; + {$ENDIF SUPPORTS_FOR_IN} + { IJclUnicodeStrList } + function Delete(Index: Integer): UnicodeString; + function ExtractIndex(Index: Integer): UnicodeString; + function GetString(Index: Integer): UnicodeString; + function IndexOf(const AString: UnicodeString): Integer; + function Insert(Index: Integer; const AString: UnicodeString): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclUnicodeStrCollection): Boolean; + function LastIndexOf(const AString: UnicodeString): Integer; + procedure SetString(Index: Integer; const AString: UnicodeString); + function SubList(First, Count: Integer): IJclUnicodeStrList; + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF SUPPORTS_UNICODE_STRING} + TJclUnicodeStrVectorIterator = class(TJclAbstractIterator, IJclUnicodeStrIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclUnicodeStrVector; + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + public + constructor Create(AOwnList: TJclUnicodeStrVector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclUnicodeStrIterator } + function Add(const AString: UnicodeString): Boolean; + procedure Extract; + function GetString: UnicodeString; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AString: UnicodeString): Boolean; + function IteratorEquals(const AIterator: IJclUnicodeStrIterator): Boolean; + function Next: UnicodeString; + function NextIndex: Integer; + function Previous: UnicodeString; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetString(const AString: UnicodeString); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: UnicodeString read GetString; + {$ENDIF SUPPORTS_FOR_IN} + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + TJclStrVector = TJclAnsiStrVector; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TJclStrVector = TJclWideStrVector; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TJclStrVector = TJclUnicodeStrVector; + {$ENDIF CONTAINER_UNICODESTR} + + {$IFDEF CONTAINER_ANSISTR} + TJclStrVectorIterator = TJclAnsiStrVectorIterator; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + TJclStrVectorIterator = TJclWideStrVectorIterator; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + TJclStrVectorIterator = TJclUnicodeStrVectorIterator; + {$ENDIF CONTAINER_UNICODESTR} + + TJclSingleVector = class(TJclSingleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclSingleContainer, IJclSingleFlatContainer, IJclSingleEqualityComparer, + IJclSingleCollection, IJclSingleList, IJclSingleArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FItems: TDynSingleArray; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: Single; + public + constructor Create(ACapacity: Integer); overload; + constructor Create(const ACollection: IJclSingleCollection); overload; + destructor Destroy; override; + property Items: TDynSingleArray read FItems; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclSingleCollection } + function Add(const AValue: Single): Boolean; + function AddAll(const ACollection: IJclSingleCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclSingleCollection): Boolean; + function Contains(const AValue: Single): Boolean; + function ContainsAll(const ACollection: IJclSingleCollection): Boolean; + function Extract(const AValue: Single): Boolean; + function ExtractAll(const ACollection: IJclSingleCollection): Boolean; + function First: IJclSingleIterator; + function IsEmpty: Boolean; + function Last: IJclSingleIterator; + function Remove(const AValue: Single): Boolean; + function RemoveAll(const ACollection: IJclSingleCollection): Boolean; + function RetainAll(const ACollection: IJclSingleCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclSingleIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclSingleList } + function Delete(Index: Integer): Single; + function ExtractIndex(Index: Integer): Single; + function GetValue(Index: Integer): Single; + function IndexOf(const AValue: Single): Integer; + function Insert(Index: Integer; const AValue: Single): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclSingleCollection): Boolean; + function LastIndexOf(const AValue: Single): Integer; + procedure SetValue(Index: Integer; const AValue: Single); + function SubList(First, Count: Integer): IJclSingleList; + end; + + TJclSingleVectorIterator = class(TJclAbstractIterator, IJclSingleIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclSingleVector; + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + public + constructor Create(AOwnList: TJclSingleVector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclSingleIterator } + function Add(const AValue: Single): Boolean; + procedure Extract; + function GetValue: Single; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AValue: Single): Boolean; + function IteratorEquals(const AIterator: IJclSingleIterator): Boolean; + function Next: Single; + function NextIndex: Integer; + function Previous: Single; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(const AValue: Single); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Single read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclDoubleVector = class(TJclDoubleAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclDoubleContainer, IJclDoubleFlatContainer, IJclDoubleEqualityComparer, + IJclDoubleCollection, IJclDoubleList, IJclDoubleArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FItems: TDynDoubleArray; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: Double; + public + constructor Create(ACapacity: Integer); overload; + constructor Create(const ACollection: IJclDoubleCollection); overload; + destructor Destroy; override; + property Items: TDynDoubleArray read FItems; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclDoubleCollection } + function Add(const AValue: Double): Boolean; + function AddAll(const ACollection: IJclDoubleCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclDoubleCollection): Boolean; + function Contains(const AValue: Double): Boolean; + function ContainsAll(const ACollection: IJclDoubleCollection): Boolean; + function Extract(const AValue: Double): Boolean; + function ExtractAll(const ACollection: IJclDoubleCollection): Boolean; + function First: IJclDoubleIterator; + function IsEmpty: Boolean; + function Last: IJclDoubleIterator; + function Remove(const AValue: Double): Boolean; + function RemoveAll(const ACollection: IJclDoubleCollection): Boolean; + function RetainAll(const ACollection: IJclDoubleCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclDoubleIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclDoubleList } + function Delete(Index: Integer): Double; + function ExtractIndex(Index: Integer): Double; + function GetValue(Index: Integer): Double; + function IndexOf(const AValue: Double): Integer; + function Insert(Index: Integer; const AValue: Double): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclDoubleCollection): Boolean; + function LastIndexOf(const AValue: Double): Integer; + procedure SetValue(Index: Integer; const AValue: Double); + function SubList(First, Count: Integer): IJclDoubleList; + end; + + TJclDoubleVectorIterator = class(TJclAbstractIterator, IJclDoubleIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclDoubleVector; + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + public + constructor Create(AOwnList: TJclDoubleVector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclDoubleIterator } + function Add(const AValue: Double): Boolean; + procedure Extract; + function GetValue: Double; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AValue: Double): Boolean; + function IteratorEquals(const AIterator: IJclDoubleIterator): Boolean; + function Next: Double; + function NextIndex: Integer; + function Previous: Double; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(const AValue: Double); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Double read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclExtendedVector = class(TJclExtendedAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclExtendedContainer, IJclExtendedFlatContainer, IJclExtendedEqualityComparer, + IJclExtendedCollection, IJclExtendedList, IJclExtendedArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FItems: TDynExtendedArray; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: Extended; + public + constructor Create(ACapacity: Integer); overload; + constructor Create(const ACollection: IJclExtendedCollection); overload; + destructor Destroy; override; + property Items: TDynExtendedArray read FItems; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclExtendedCollection } + function Add(const AValue: Extended): Boolean; + function AddAll(const ACollection: IJclExtendedCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclExtendedCollection): Boolean; + function Contains(const AValue: Extended): Boolean; + function ContainsAll(const ACollection: IJclExtendedCollection): Boolean; + function Extract(const AValue: Extended): Boolean; + function ExtractAll(const ACollection: IJclExtendedCollection): Boolean; + function First: IJclExtendedIterator; + function IsEmpty: Boolean; + function Last: IJclExtendedIterator; + function Remove(const AValue: Extended): Boolean; + function RemoveAll(const ACollection: IJclExtendedCollection): Boolean; + function RetainAll(const ACollection: IJclExtendedCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclExtendedIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclExtendedList } + function Delete(Index: Integer): Extended; + function ExtractIndex(Index: Integer): Extended; + function GetValue(Index: Integer): Extended; + function IndexOf(const AValue: Extended): Integer; + function Insert(Index: Integer; const AValue: Extended): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclExtendedCollection): Boolean; + function LastIndexOf(const AValue: Extended): Integer; + procedure SetValue(Index: Integer; const AValue: Extended); + function SubList(First, Count: Integer): IJclExtendedList; + end; + + TJclExtendedVectorIterator = class(TJclAbstractIterator, IJclExtendedIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclExtendedVector; + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + public + constructor Create(AOwnList: TJclExtendedVector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclExtendedIterator } + function Add(const AValue: Extended): Boolean; + procedure Extract; + function GetValue: Extended; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AValue: Extended): Boolean; + function IteratorEquals(const AIterator: IJclExtendedIterator): Boolean; + function Next: Extended; + function NextIndex: Integer; + function Previous: Extended; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(const AValue: Extended); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Extended read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + {$IFDEF MATH_SINGLE_PRECISION} + TJclFloatVector = TJclSingleVector; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TJclFloatVector = TJclDoubleVector; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TJclFloatVector = TJclExtendedVector; + {$ENDIF MATH_EXTENDED_PRECISION} + + {$IFDEF MATH_SINGLE_PRECISION} + TJclFloatVectorIterator = TJclSingleVectorIterator; + {$ENDIF MATH_SINGLE_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + TJclFloatVectorIterator = TJclDoubleVectorIterator; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_EXTENDED_PRECISION} + TJclFloatVectorIterator = TJclExtendedVectorIterator; + {$ENDIF MATH_EXTENDED_PRECISION} + + TJclIntegerVector = class(TJclIntegerAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclIntegerContainer, IJclIntegerFlatContainer, IJclIntegerEqualityComparer, + IJclIntegerCollection, IJclIntegerList, IJclIntegerArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FItems: TDynIntegerArray; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: Integer; + public + constructor Create(ACapacity: Integer); overload; + constructor Create(const ACollection: IJclIntegerCollection); overload; + destructor Destroy; override; + property Items: TDynIntegerArray read FItems; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclIntegerCollection } + function Add(AValue: Integer): Boolean; + function AddAll(const ACollection: IJclIntegerCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclIntegerCollection): Boolean; + function Contains(AValue: Integer): Boolean; + function ContainsAll(const ACollection: IJclIntegerCollection): Boolean; + function Extract(AValue: Integer): Boolean; + function ExtractAll(const ACollection: IJclIntegerCollection): Boolean; + function First: IJclIntegerIterator; + function IsEmpty: Boolean; + function Last: IJclIntegerIterator; + function Remove(AValue: Integer): Boolean; + function RemoveAll(const ACollection: IJclIntegerCollection): Boolean; + function RetainAll(const ACollection: IJclIntegerCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIntegerIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclIntegerList } + function Delete(Index: Integer): Integer; + function ExtractIndex(Index: Integer): Integer; + function GetValue(Index: Integer): Integer; + function IndexOf(AValue: Integer): Integer; + function Insert(Index: Integer; AValue: Integer): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclIntegerCollection): Boolean; + function LastIndexOf(AValue: Integer): Integer; + procedure SetValue(Index: Integer; AValue: Integer); + function SubList(First, Count: Integer): IJclIntegerList; + end; + + TJclIntegerVectorIterator = class(TJclAbstractIterator, IJclIntegerIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclIntegerVector; + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + public + constructor Create(AOwnList: TJclIntegerVector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclIntegerIterator } + function Add(AValue: Integer): Boolean; + procedure Extract; + function GetValue: Integer; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(AValue: Integer): Boolean; + function IteratorEquals(const AIterator: IJclIntegerIterator): Boolean; + function Next: Integer; + function NextIndex: Integer; + function Previous: Integer; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(AValue: Integer); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Integer read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclCardinalVector = class(TJclCardinalAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclCardinalContainer, IJclCardinalFlatContainer, IJclCardinalEqualityComparer, + IJclCardinalCollection, IJclCardinalList, IJclCardinalArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FItems: TDynCardinalArray; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: Cardinal; + public + constructor Create(ACapacity: Integer); overload; + constructor Create(const ACollection: IJclCardinalCollection); overload; + destructor Destroy; override; + property Items: TDynCardinalArray read FItems; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclCardinalCollection } + function Add(AValue: Cardinal): Boolean; + function AddAll(const ACollection: IJclCardinalCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclCardinalCollection): Boolean; + function Contains(AValue: Cardinal): Boolean; + function ContainsAll(const ACollection: IJclCardinalCollection): Boolean; + function Extract(AValue: Cardinal): Boolean; + function ExtractAll(const ACollection: IJclCardinalCollection): Boolean; + function First: IJclCardinalIterator; + function IsEmpty: Boolean; + function Last: IJclCardinalIterator; + function Remove(AValue: Cardinal): Boolean; + function RemoveAll(const ACollection: IJclCardinalCollection): Boolean; + function RetainAll(const ACollection: IJclCardinalCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclCardinalIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclCardinalList } + function Delete(Index: Integer): Cardinal; + function ExtractIndex(Index: Integer): Cardinal; + function GetValue(Index: Integer): Cardinal; + function IndexOf(AValue: Cardinal): Integer; + function Insert(Index: Integer; AValue: Cardinal): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclCardinalCollection): Boolean; + function LastIndexOf(AValue: Cardinal): Integer; + procedure SetValue(Index: Integer; AValue: Cardinal); + function SubList(First, Count: Integer): IJclCardinalList; + end; + + TJclCardinalVectorIterator = class(TJclAbstractIterator, IJclCardinalIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclCardinalVector; + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + public + constructor Create(AOwnList: TJclCardinalVector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclCardinalIterator } + function Add(AValue: Cardinal): Boolean; + procedure Extract; + function GetValue: Cardinal; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(AValue: Cardinal): Boolean; + function IteratorEquals(const AIterator: IJclCardinalIterator): Boolean; + function Next: Cardinal; + function NextIndex: Integer; + function Previous: Cardinal; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(AValue: Cardinal); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Cardinal read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclInt64Vector = class(TJclInt64AbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclInt64Container, IJclInt64FlatContainer, IJclInt64EqualityComparer, + IJclInt64Collection, IJclInt64List, IJclInt64Array) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FItems: TDynInt64Array; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: Int64; + public + constructor Create(ACapacity: Integer); overload; + constructor Create(const ACollection: IJclInt64Collection); overload; + destructor Destroy; override; + property Items: TDynInt64Array read FItems; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclInt64Collection } + function Add(const AValue: Int64): Boolean; + function AddAll(const ACollection: IJclInt64Collection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclInt64Collection): Boolean; + function Contains(const AValue: Int64): Boolean; + function ContainsAll(const ACollection: IJclInt64Collection): Boolean; + function Extract(const AValue: Int64): Boolean; + function ExtractAll(const ACollection: IJclInt64Collection): Boolean; + function First: IJclInt64Iterator; + function IsEmpty: Boolean; + function Last: IJclInt64Iterator; + function Remove(const AValue: Int64): Boolean; + function RemoveAll(const ACollection: IJclInt64Collection): Boolean; + function RetainAll(const ACollection: IJclInt64Collection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclInt64Iterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclInt64List } + function Delete(Index: Integer): Int64; + function ExtractIndex(Index: Integer): Int64; + function GetValue(Index: Integer): Int64; + function IndexOf(const AValue: Int64): Integer; + function Insert(Index: Integer; const AValue: Int64): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclInt64Collection): Boolean; + function LastIndexOf(const AValue: Int64): Integer; + procedure SetValue(Index: Integer; const AValue: Int64); + function SubList(First, Count: Integer): IJclInt64List; + end; + + TJclInt64VectorIterator = class(TJclAbstractIterator, IJclInt64Iterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclInt64Vector; + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + public + constructor Create(AOwnList: TJclInt64Vector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclInt64Iterator } + function Add(const AValue: Int64): Boolean; + procedure Extract; + function GetValue: Int64; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AValue: Int64): Boolean; + function IteratorEquals(const AIterator: IJclInt64Iterator): Boolean; + function Next: Int64; + function NextIndex: Integer; + function Previous: Int64; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetValue(const AValue: Int64); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Int64 read GetValue; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclPtrVector = class(TJclPtrAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclPtrContainer, IJclPtrFlatContainer, IJclPtrEqualityComparer, + IJclPtrCollection, IJclPtrList, IJclPtrArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FItems: TDynPointerArray; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: Pointer; + public + constructor Create(ACapacity: Integer); overload; + constructor Create(const ACollection: IJclPtrCollection); overload; + destructor Destroy; override; + property Items: TDynPointerArray read FItems; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclPtrCollection } + function Add(APtr: Pointer): Boolean; + function AddAll(const ACollection: IJclPtrCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclPtrCollection): Boolean; + function Contains(APtr: Pointer): Boolean; + function ContainsAll(const ACollection: IJclPtrCollection): Boolean; + function Extract(APtr: Pointer): Boolean; + function ExtractAll(const ACollection: IJclPtrCollection): Boolean; + function First: IJclPtrIterator; + function IsEmpty: Boolean; + function Last: IJclPtrIterator; + function Remove(APtr: Pointer): Boolean; + function RemoveAll(const ACollection: IJclPtrCollection): Boolean; + function RetainAll(const ACollection: IJclPtrCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclPtrIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclPtrList } + function Delete(Index: Integer): Pointer; + function ExtractIndex(Index: Integer): Pointer; + function GetPointer(Index: Integer): Pointer; + function IndexOf(APtr: Pointer): Integer; + function Insert(Index: Integer; APtr: Pointer): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclPtrCollection): Boolean; + function LastIndexOf(APtr: Pointer): Integer; + procedure SetPointer(Index: Integer; APtr: Pointer); + function SubList(First, Count: Integer): IJclPtrList; + end; + + TJclPtrVectorIterator = class(TJclAbstractIterator, IJclPtrIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclPtrVector; + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + public + constructor Create(AOwnList: TJclPtrVector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclPtrIterator } + function Add(APtr: Pointer): Boolean; + procedure Extract; + function GetPointer: Pointer; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(APtr: Pointer): Boolean; + function IteratorEquals(const AIterator: IJclPtrIterator): Boolean; + function Next: Pointer; + function NextIndex: Integer; + function Previous: Pointer; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetPointer(APtr: Pointer); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: Pointer read GetPointer; + {$ENDIF SUPPORTS_FOR_IN} + end; + + TJclVector = class(TJclAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclContainer, IJclFlatContainer, IJclEqualityComparer, IJclObjectOwner, + IJclCollection, IJclList, IJclArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + private + FItems: TDynObjectArray; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: TObject; + public + constructor Create(ACapacity: Integer; AOwnsObjects: Boolean); overload; + constructor Create(const ACollection: IJclCollection; AOwnsObjects: Boolean); overload; + destructor Destroy; override; + property Items: TDynObjectArray read FItems; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclCollection } + function Add(AObject: TObject): Boolean; + function AddAll(const ACollection: IJclCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclCollection): Boolean; + function Contains(AObject: TObject): Boolean; + function ContainsAll(const ACollection: IJclCollection): Boolean; + function Extract(AObject: TObject): Boolean; + function ExtractAll(const ACollection: IJclCollection): Boolean; + function First: IJclIterator; + function IsEmpty: Boolean; + function Last: IJclIterator; + function Remove(AObject: TObject): Boolean; + function RemoveAll(const ACollection: IJclCollection): Boolean; + function RetainAll(const ACollection: IJclCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclList } + function Delete(Index: Integer): TObject; + function ExtractIndex(Index: Integer): TObject; + function GetObject(Index: Integer): TObject; + function IndexOf(AObject: TObject): Integer; + function Insert(Index: Integer; AObject: TObject): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclCollection): Boolean; + function LastIndexOf(AObject: TObject): Integer; + procedure SetObject(Index: Integer; AObject: TObject); + function SubList(First, Count: Integer): IJclList; + end; + + TJclVectorIterator = class(TJclAbstractIterator, IJclIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclVector; + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + public + constructor Create(AOwnList: TJclVector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclIterator } + function Add(AObject: TObject): Boolean; + procedure Extract; + function GetObject: TObject; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(AObject: TObject): Boolean; + function IteratorEquals(const AIterator: IJclIterator): Boolean; + function Next: TObject; + function NextIndex: Integer; + function Previous: TObject; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetObject(AObject: TObject); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: TObject read GetObject; + {$ENDIF SUPPORTS_FOR_IN} + end; + + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + + TJclVectorIterator = class; + + TJclVector = class(TJclAbstractContainer, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + IJclContainer, IJclFlatContainer, IJclEqualityComparer, IJclItemOwner, + IJclCollection, IJclList, IJclArray) + protected + type + TDynArray = array of T; + TVectorIterator = TJclVectorIterator; + procedure MoveArray(var List: TDynArray; FromIndex, ToIndex, Count: SizeInt); + private + FItems: TDynArray; + protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: T; + public + constructor Create(ACapacity: Integer; AOwnsItems: Boolean); overload; + constructor Create(const ACollection: IJclCollection; AOwnsItems: Boolean); overload; + destructor Destroy; override; + property Items: TDynArray read FItems; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { IJclCollection } + function Add(const AItem: T): Boolean; + function AddAll(const ACollection: IJclCollection): Boolean; + procedure Clear; + function CollectionEquals(const ACollection: IJclCollection): Boolean; + function Contains(const AItem: T): Boolean; + function ContainsAll(const ACollection: IJclCollection): Boolean; + function Extract(const AItem: T): Boolean; + function ExtractAll(const ACollection: IJclCollection): Boolean; + function First: IJclIterator; + function IsEmpty: Boolean; + function Last: IJclIterator; + function Remove(const AItem: T): Boolean; + function RemoveAll(const ACollection: IJclCollection): Boolean; + function RetainAll(const ACollection: IJclCollection): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: IJclIterator; + {$ENDIF SUPPORTS_FOR_IN} + { IJclList } + function Delete(Index: Integer): T; + function ExtractIndex(Index: Integer): T; + function GetItem(Index: Integer): T; + function IndexOf(const AItem: T): Integer; + function Insert(Index: Integer; const AItem: T): Boolean; + function InsertAll(Index: Integer; const ACollection: IJclCollection): Boolean; + function LastIndexOf(const AItem: T): Integer; + procedure SetItem(Index: Integer; const AItem: T); + function SubList(First, Count: Integer): IJclList; + end; + + TJclVectorIterator = class(TJclAbstractIterator, IJclIterator, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) + private + FCursor: Integer; + FStart: TItrStart; + FOwnList: TJclVector; + protected + function CreateEmptyIterator: TJclAbstractIterator; override; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + public + constructor Create(AOwnList: TJclVector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { IJclIterator } + function Add(const AItem: T): Boolean; + procedure Extract; + function GetItem: T; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(const AItem: T): Boolean; + function IteratorEquals(const AIterator: IJclIterator): Boolean; + function Next: T; + function NextIndex: Integer; + function Previous: T; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SetItem(const AItem: T); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: T read GetItem; + {$ENDIF SUPPORTS_FOR_IN} + end; + + // E = External helper to compare items for equality (GetHashCode is not used) + TJclVectorE = class(TJclVector, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, + IJclCollection, IJclList, IJclArray, IJclItemOwner) + private + FEqualityComparer: IJclEqualityComparer; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AEqualityComparer: IJclEqualityComparer; ACapacity: Integer; AOwnsItems: Boolean); + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + property EqualityComparer: IJclEqualityComparer read FEqualityComparer write FEqualityComparer; + end; + + // F = Function to compare items for equality + TJclVectorF = class(TJclVector, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, + IJclCollection, IJclList, IJclArray, IJclItemOwner) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AEqualityCompare: TEqualityCompare; ACapacity: Integer; AOwnsItems: Boolean); + end; + + // I = Items can compare themselves to an other for equality + TJclVectorI> = class(TJclVector, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, + IJclCollection, IJclList, IJclArray, IJclItemOwner) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +{$IFDEF BCB} +{$IFDEF WIN64} + {$HPPEMIT '#ifdef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #undef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #define JclVectors_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT '#endif'} + + {$HPPEMIT END '#ifdef JclVectors_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #define MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #undef JclVectors_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END '#endif'} +{$ENDIF WIN64} +{$ENDIF BCB} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +//=== { TJclIntfVector } ====================================================== + +constructor TJclIntfVector.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +constructor TJclIntfVector.Create(const ACollection: IJclIntfCollection); +begin + inherited Create(); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclIntfVector.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclIntfVector.Add(const AInterface: IInterface): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AInterface, nil); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(AInterface, FItems[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FItems[FSize] := AInterface; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfVector.AddAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfVector.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclIntfVector; + ACollection: IJclIntfCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntfVector then + begin + ADest := TJclIntfVector(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclIntfCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclIntfVector.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeObject(FItems[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfVector.CollectionEquals(const ACollection: IJclIntfCollection): Boolean; +var + I: Integer; + It: IJclIntfIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FItems[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfVector.Contains(const AInterface: IInterface): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], AInterface) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfVector.ContainsAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfVector.Delete(Index: Integer): IInterface; +var + Extracted: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreeObject(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfVector.Extract(const AInterface: IInterface): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], AInterface) then + begin + if I < (FSize - 1) then + MoveArray(FItems, I + 1, I, FSize - 1 - I) + else + FItems[I] := nil; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfVector.ExtractAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfVector.ExtractIndex(Index: Integer): IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FItems[Index]; + if Index < (FSize - 1) then + MoveArray(FItems, Index + 1, Index, FSize - 1 - Index) + else + FItems[Index] := nil; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfVector.First: IJclIntfIterator; +begin + Result := TJclIntfVectorIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclIntfVector.GetEnumerator: IJclIntfIterator; +begin + Result := TJclIntfVectorIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclIntfVector.GetObject(Index: Integer): IInterface; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if (Index >= 0) or (Index < FSize) then + Result := FItems[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfVector.IndexOf(const AInterface: IInterface): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], AInterface) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfVector.Insert(Index: Integer; const AInterface: IInterface): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AInterface, nil); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AInterface, FItems[I]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FItems, Index, Index + 1, FSize - Index); + FItems[Index] := AInterface; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfVector.InsertAll(Index: Integer; const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfVector.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntfVector.Last: IJclIntfIterator; +begin + Result := TJclIntfVectorIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclIntfVector.LastIndexOf(const AInterface: IInterface): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], AInterface) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfVector.RaiseOutOfBoundsError: IInterface; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclIntfVector.Remove(const AInterface: IInterface): Boolean; +var + Extracted: IInterface; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AInterface); + if Result then + begin + Extracted := AInterface; + FreeObject(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfVector.RemoveAll(const ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfVector.RetainAll(const ACollection: IJclIntfCollection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FItems[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfVector.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FItems, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntfVector.SetObject(Index: Integer; const AInterface: IInterface); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AInterface, nil); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AInterface, FItems[I]) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreeObject(FItems[Index]); + FItems[Index] := AInterface; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfVector.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfVector.SubList(First, Count: Integer): IJclIntfList; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclIntfList; + for I := First to Last do + Result.Add(FItems[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntfVector.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntfVector.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclIntfVectorIterator } =========================================================== + +constructor TJclIntfVectorIterator.Create(AOwnList: TJclIntfVector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclIntfVectorIterator.Add(const AInterface: IInterface): Boolean; +begin + Result := FOwnList.Add(AInterface); +end; + +procedure TJclIntfVectorIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclIntfVectorIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclIntfVectorIterator then + begin + ADest := TJclIntfVectorIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclIntfVectorIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclIntfVectorIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclIntfVectorIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclIntfVectorIterator.GetObject: IInterface; +begin + CheckValid; + Result := FOwnList.GetObject(FCursor); +end; + +function TJclIntfVectorIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclIntfVectorIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclIntfVectorIterator.Insert(const AInterface: IInterface): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, AInterface); +end; + +function TJclIntfVectorIterator.IteratorEquals(const AIterator: IJclIntfIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclIntfVectorIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclIntfVectorIterator then + begin + ItrObj := TJclIntfVectorIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclIntfVectorIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclIntfVectorIterator.Next: IInterface; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetObject(FCursor); +end; + +function TJclIntfVectorIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclIntfVectorIterator.Previous: IInterface; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetObject(FCursor); +end; + +function TJclIntfVectorIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclIntfVectorIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclIntfVectorIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclIntfVectorIterator.SetObject(const AInterface: IInterface); +begin + CheckValid; + FOwnList.SetObject(FCursor, AInterface); +end; + +//=== { TJclAnsiStrVector } ====================================================== + +constructor TJclAnsiStrVector.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +constructor TJclAnsiStrVector.Create(const ACollection: IJclAnsiStrCollection); +begin + inherited Create(); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclAnsiStrVector.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclAnsiStrVector.Add(const AString: AnsiString): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AString, ''); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(AString, FItems[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FItems[FSize] := AString; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrVector.AddAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrVector.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclAnsiStrVector; + ACollection: IJclAnsiStrCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclAnsiStrVector then + begin + ADest := TJclAnsiStrVector(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclAnsiStrCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclAnsiStrVector.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeString(FItems[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrVector.CollectionEquals(const ACollection: IJclAnsiStrCollection): Boolean; +var + I: Integer; + It: IJclAnsiStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FItems[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrVector.Contains(const AString: AnsiString): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], AString) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrVector.ContainsAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrVector.Delete(Index: Integer): AnsiString; +var + Extracted: AnsiString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreeString(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrVector.Extract(const AString: AnsiString): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], AString) then + begin + if I < (FSize - 1) then + MoveArray(FItems, I + 1, I, FSize - 1 - I) + else + FItems[I] := ''; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrVector.ExtractAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrVector.ExtractIndex(Index: Integer): AnsiString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FItems[Index]; + if Index < (FSize - 1) then + MoveArray(FItems, Index + 1, Index, FSize - 1 - Index) + else + FItems[Index] := ''; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrVector.First: IJclAnsiStrIterator; +begin + Result := TJclAnsiStrVectorIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclAnsiStrVector.GetEnumerator: IJclAnsiStrIterator; +begin + Result := TJclAnsiStrVectorIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclAnsiStrVector.GetString(Index: Integer): AnsiString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if (Index >= 0) or (Index < FSize) then + Result := FItems[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrVector.IndexOf(const AString: AnsiString): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], AString) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrVector.Insert(Index: Integer; const AString: AnsiString): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AString, ''); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AString, FItems[I]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FItems, Index, Index + 1, FSize - Index); + FItems[Index] := AString; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrVector.InsertAll(Index: Integer; const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrVector.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclAnsiStrVector.Last: IJclAnsiStrIterator; +begin + Result := TJclAnsiStrVectorIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclAnsiStrVector.LastIndexOf(const AString: AnsiString): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], AString) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrVector.RaiseOutOfBoundsError: AnsiString; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclAnsiStrVector.Remove(const AString: AnsiString): Boolean; +var + Extracted: AnsiString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AString); + if Result then + begin + Extracted := AString; + FreeString(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrVector.RemoveAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + It: IJclAnsiStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrVector.RetainAll(const ACollection: IJclAnsiStrCollection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FItems[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrVector.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FItems, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclAnsiStrVector.SetString(Index: Integer; const AString: AnsiString); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AString, ''); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AString, FItems[I]) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreeString(FItems[Index]); + FItems[Index] := AString; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrVector.Size: Integer; +begin + Result := FSize; +end; + +function TJclAnsiStrVector.SubList(First, Count: Integer): IJclAnsiStrList; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclAnsiStrList; + for I := First to Last do + Result.Add(FItems[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclAnsiStrVector.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclAnsiStrVector.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclAnsiStrVectorIterator } =========================================================== + +constructor TJclAnsiStrVectorIterator.Create(AOwnList: TJclAnsiStrVector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclAnsiStrVectorIterator.Add(const AString: AnsiString): Boolean; +begin + Result := FOwnList.Add(AString); +end; + +procedure TJclAnsiStrVectorIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclAnsiStrVectorIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclAnsiStrVectorIterator then + begin + ADest := TJclAnsiStrVectorIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclAnsiStrVectorIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclAnsiStrVectorIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclAnsiStrVectorIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclAnsiStrVectorIterator.GetString: AnsiString; +begin + CheckValid; + Result := FOwnList.GetString(FCursor); +end; + +function TJclAnsiStrVectorIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclAnsiStrVectorIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclAnsiStrVectorIterator.Insert(const AString: AnsiString): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, AString); +end; + +function TJclAnsiStrVectorIterator.IteratorEquals(const AIterator: IJclAnsiStrIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclAnsiStrVectorIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclAnsiStrVectorIterator then + begin + ItrObj := TJclAnsiStrVectorIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclAnsiStrVectorIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclAnsiStrVectorIterator.Next: AnsiString; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetString(FCursor); +end; + +function TJclAnsiStrVectorIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclAnsiStrVectorIterator.Previous: AnsiString; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetString(FCursor); +end; + +function TJclAnsiStrVectorIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclAnsiStrVectorIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclAnsiStrVectorIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclAnsiStrVectorIterator.SetString(const AString: AnsiString); +begin + CheckValid; + FOwnList.SetString(FCursor, AString); +end; + +//=== { TJclWideStrVector } ====================================================== + +constructor TJclWideStrVector.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +constructor TJclWideStrVector.Create(const ACollection: IJclWideStrCollection); +begin + inherited Create(); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclWideStrVector.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclWideStrVector.Add(const AString: WideString): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AString, ''); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(AString, FItems[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FItems[FSize] := AString; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrVector.AddAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrVector.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclWideStrVector; + ACollection: IJclWideStrCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclWideStrVector then + begin + ADest := TJclWideStrVector(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclWideStrCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclWideStrVector.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeString(FItems[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrVector.CollectionEquals(const ACollection: IJclWideStrCollection): Boolean; +var + I: Integer; + It: IJclWideStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FItems[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrVector.Contains(const AString: WideString): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], AString) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrVector.ContainsAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrVector.Delete(Index: Integer): WideString; +var + Extracted: WideString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreeString(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrVector.Extract(const AString: WideString): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], AString) then + begin + if I < (FSize - 1) then + MoveArray(FItems, I + 1, I, FSize - 1 - I) + else + FItems[I] := ''; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrVector.ExtractAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrVector.ExtractIndex(Index: Integer): WideString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FItems[Index]; + if Index < (FSize - 1) then + MoveArray(FItems, Index + 1, Index, FSize - 1 - Index) + else + FItems[Index] := ''; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrVector.First: IJclWideStrIterator; +begin + Result := TJclWideStrVectorIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclWideStrVector.GetEnumerator: IJclWideStrIterator; +begin + Result := TJclWideStrVectorIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclWideStrVector.GetString(Index: Integer): WideString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if (Index >= 0) or (Index < FSize) then + Result := FItems[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrVector.IndexOf(const AString: WideString): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], AString) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrVector.Insert(Index: Integer; const AString: WideString): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AString, ''); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AString, FItems[I]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FItems, Index, Index + 1, FSize - Index); + FItems[Index] := AString; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrVector.InsertAll(Index: Integer; const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrVector.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclWideStrVector.Last: IJclWideStrIterator; +begin + Result := TJclWideStrVectorIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclWideStrVector.LastIndexOf(const AString: WideString): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], AString) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrVector.RaiseOutOfBoundsError: WideString; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclWideStrVector.Remove(const AString: WideString): Boolean; +var + Extracted: WideString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AString); + if Result then + begin + Extracted := AString; + FreeString(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrVector.RemoveAll(const ACollection: IJclWideStrCollection): Boolean; +var + It: IJclWideStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrVector.RetainAll(const ACollection: IJclWideStrCollection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FItems[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrVector.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FItems, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclWideStrVector.SetString(Index: Integer; const AString: WideString); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AString, ''); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AString, FItems[I]) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreeString(FItems[Index]); + FItems[Index] := AString; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrVector.Size: Integer; +begin + Result := FSize; +end; + +function TJclWideStrVector.SubList(First, Count: Integer): IJclWideStrList; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclWideStrList; + for I := First to Last do + Result.Add(FItems[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclWideStrVector.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclWideStrVector.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclWideStrVectorIterator } =========================================================== + +constructor TJclWideStrVectorIterator.Create(AOwnList: TJclWideStrVector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclWideStrVectorIterator.Add(const AString: WideString): Boolean; +begin + Result := FOwnList.Add(AString); +end; + +procedure TJclWideStrVectorIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclWideStrVectorIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclWideStrVectorIterator then + begin + ADest := TJclWideStrVectorIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclWideStrVectorIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclWideStrVectorIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclWideStrVectorIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclWideStrVectorIterator.GetString: WideString; +begin + CheckValid; + Result := FOwnList.GetString(FCursor); +end; + +function TJclWideStrVectorIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclWideStrVectorIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclWideStrVectorIterator.Insert(const AString: WideString): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, AString); +end; + +function TJclWideStrVectorIterator.IteratorEquals(const AIterator: IJclWideStrIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclWideStrVectorIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclWideStrVectorIterator then + begin + ItrObj := TJclWideStrVectorIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclWideStrVectorIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclWideStrVectorIterator.Next: WideString; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetString(FCursor); +end; + +function TJclWideStrVectorIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclWideStrVectorIterator.Previous: WideString; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetString(FCursor); +end; + +function TJclWideStrVectorIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclWideStrVectorIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclWideStrVectorIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclWideStrVectorIterator.SetString(const AString: WideString); +begin + CheckValid; + FOwnList.SetString(FCursor, AString); +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrVector } ====================================================== + +constructor TJclUnicodeStrVector.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +constructor TJclUnicodeStrVector.Create(const ACollection: IJclUnicodeStrCollection); +begin + inherited Create(); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclUnicodeStrVector.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclUnicodeStrVector.Add(const AString: UnicodeString): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AString, ''); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(AString, FItems[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FItems[FSize] := AString; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrVector.AddAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrVector.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclUnicodeStrVector; + ACollection: IJclUnicodeStrCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclUnicodeStrVector then + begin + ADest := TJclUnicodeStrVector(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclUnicodeStrCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclUnicodeStrVector.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeString(FItems[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrVector.CollectionEquals(const ACollection: IJclUnicodeStrCollection): Boolean; +var + I: Integer; + It: IJclUnicodeStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FItems[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrVector.Contains(const AString: UnicodeString): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], AString) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrVector.ContainsAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrVector.Delete(Index: Integer): UnicodeString; +var + Extracted: UnicodeString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreeString(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrVector.Extract(const AString: UnicodeString): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], AString) then + begin + if I < (FSize - 1) then + MoveArray(FItems, I + 1, I, FSize - 1 - I) + else + FItems[I] := ''; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrVector.ExtractAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrVector.ExtractIndex(Index: Integer): UnicodeString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FItems[Index]; + if Index < (FSize - 1) then + MoveArray(FItems, Index + 1, Index, FSize - 1 - Index) + else + FItems[Index] := ''; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrVector.First: IJclUnicodeStrIterator; +begin + Result := TJclUnicodeStrVectorIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclUnicodeStrVector.GetEnumerator: IJclUnicodeStrIterator; +begin + Result := TJclUnicodeStrVectorIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclUnicodeStrVector.GetString(Index: Integer): UnicodeString; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := ''; + if (Index >= 0) or (Index < FSize) then + Result := FItems[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrVector.IndexOf(const AString: UnicodeString): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], AString) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrVector.Insert(Index: Integer; const AString: UnicodeString): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AString, ''); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AString, FItems[I]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FItems, Index, Index + 1, FSize - Index); + FItems[Index] := AString; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrVector.InsertAll(Index: Integer; const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrVector.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclUnicodeStrVector.Last: IJclUnicodeStrIterator; +begin + Result := TJclUnicodeStrVectorIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclUnicodeStrVector.LastIndexOf(const AString: UnicodeString): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], AString) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrVector.RaiseOutOfBoundsError: UnicodeString; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclUnicodeStrVector.Remove(const AString: UnicodeString): Boolean; +var + Extracted: UnicodeString; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AString); + if Result then + begin + Extracted := AString; + FreeString(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrVector.RemoveAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + It: IJclUnicodeStrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrVector.RetainAll(const ACollection: IJclUnicodeStrCollection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FItems[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrVector.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FItems, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclUnicodeStrVector.SetString(Index: Integer; const AString: UnicodeString); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AString, ''); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AString, FItems[I]) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreeString(FItems[Index]); + FItems[Index] := AString; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrVector.Size: Integer; +begin + Result := FSize; +end; + +function TJclUnicodeStrVector.SubList(First, Count: Integer): IJclUnicodeStrList; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclUnicodeStrList; + for I := First to Last do + Result.Add(FItems[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclUnicodeStrVector.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclUnicodeStrVector.Create(FSize); + AssignPropertiesTo(Result); +end; + +{$ENDIF SUPPORTS_UNICODE_STRING} + +{$IFDEF SUPPORTS_UNICODE_STRING} +//=== { TJclUnicodeStrVectorIterator } =========================================================== + +constructor TJclUnicodeStrVectorIterator.Create(AOwnList: TJclUnicodeStrVector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclUnicodeStrVectorIterator.Add(const AString: UnicodeString): Boolean; +begin + Result := FOwnList.Add(AString); +end; + +procedure TJclUnicodeStrVectorIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclUnicodeStrVectorIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclUnicodeStrVectorIterator then + begin + ADest := TJclUnicodeStrVectorIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclUnicodeStrVectorIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclUnicodeStrVectorIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclUnicodeStrVectorIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclUnicodeStrVectorIterator.GetString: UnicodeString; +begin + CheckValid; + Result := FOwnList.GetString(FCursor); +end; + +function TJclUnicodeStrVectorIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclUnicodeStrVectorIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclUnicodeStrVectorIterator.Insert(const AString: UnicodeString): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, AString); +end; + +function TJclUnicodeStrVectorIterator.IteratorEquals(const AIterator: IJclUnicodeStrIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclUnicodeStrVectorIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclUnicodeStrVectorIterator then + begin + ItrObj := TJclUnicodeStrVectorIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclUnicodeStrVectorIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclUnicodeStrVectorIterator.Next: UnicodeString; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetString(FCursor); +end; + +function TJclUnicodeStrVectorIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclUnicodeStrVectorIterator.Previous: UnicodeString; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetString(FCursor); +end; + +function TJclUnicodeStrVectorIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclUnicodeStrVectorIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclUnicodeStrVectorIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclUnicodeStrVectorIterator.SetString(const AString: UnicodeString); +begin + CheckValid; + FOwnList.SetString(FCursor, AString); +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +//=== { TJclSingleVector } ====================================================== + +constructor TJclSingleVector.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +constructor TJclSingleVector.Create(const ACollection: IJclSingleCollection); +begin + inherited Create(); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclSingleVector.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclSingleVector.Add(const AValue: Single): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(AValue, FItems[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FItems[FSize] := AValue; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleVector.AddAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleVector.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclSingleVector; + ACollection: IJclSingleCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclSingleVector then + begin + ADest := TJclSingleVector(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclSingleCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclSingleVector.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeSingle(FItems[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleVector.CollectionEquals(const ACollection: IJclSingleCollection): Boolean; +var + I: Integer; + It: IJclSingleIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FItems[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleVector.Contains(const AValue: Single): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], AValue) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleVector.ContainsAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleVector.Delete(Index: Integer): Single; +var + Extracted: Single; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreeSingle(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleVector.Extract(const AValue: Single): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], AValue) then + begin + if I < (FSize - 1) then + MoveArray(FItems, I + 1, I, FSize - 1 - I) + else + FItems[I] := 0.0; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleVector.ExtractAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleVector.ExtractIndex(Index: Integer): Single; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FItems[Index]; + if Index < (FSize - 1) then + MoveArray(FItems, Index + 1, Index, FSize - 1 - Index) + else + FItems[Index] := 0.0; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleVector.First: IJclSingleIterator; +begin + Result := TJclSingleVectorIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclSingleVector.GetEnumerator: IJclSingleIterator; +begin + Result := TJclSingleVectorIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclSingleVector.GetValue(Index: Integer): Single; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if (Index >= 0) or (Index < FSize) then + Result := FItems[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleVector.IndexOf(const AValue: Single): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], AValue) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleVector.Insert(Index: Integer; const AValue: Single): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AValue, FItems[I]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FItems, Index, Index + 1, FSize - Index); + FItems[Index] := AValue; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleVector.InsertAll(Index: Integer; const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleVector.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclSingleVector.Last: IJclSingleIterator; +begin + Result := TJclSingleVectorIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclSingleVector.LastIndexOf(const AValue: Single): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], AValue) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleVector.RaiseOutOfBoundsError: Single; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclSingleVector.Remove(const AValue: Single): Boolean; +var + Extracted: Single; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeSingle(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleVector.RemoveAll(const ACollection: IJclSingleCollection): Boolean; +var + It: IJclSingleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleVector.RetainAll(const ACollection: IJclSingleCollection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FItems[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleVector.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FItems, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclSingleVector.SetValue(Index: Integer; const AValue: Single); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AValue, FItems[I]) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreeSingle(FItems[Index]); + FItems[Index] := AValue; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleVector.Size: Integer; +begin + Result := FSize; +end; + +function TJclSingleVector.SubList(First, Count: Integer): IJclSingleList; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclSingleList; + for I := First to Last do + Result.Add(FItems[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclSingleVector.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclSingleVector.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclSingleVectorIterator } =========================================================== + +constructor TJclSingleVectorIterator.Create(AOwnList: TJclSingleVector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclSingleVectorIterator.Add(const AValue: Single): Boolean; +begin + Result := FOwnList.Add(AValue); +end; + +procedure TJclSingleVectorIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclSingleVectorIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclSingleVectorIterator then + begin + ADest := TJclSingleVectorIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclSingleVectorIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclSingleVectorIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclSingleVectorIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclSingleVectorIterator.GetValue: Single; +begin + CheckValid; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclSingleVectorIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclSingleVectorIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclSingleVectorIterator.Insert(const AValue: Single): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, AValue); +end; + +function TJclSingleVectorIterator.IteratorEquals(const AIterator: IJclSingleIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclSingleVectorIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclSingleVectorIterator then + begin + ItrObj := TJclSingleVectorIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclSingleVectorIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclSingleVectorIterator.Next: Single; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclSingleVectorIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclSingleVectorIterator.Previous: Single; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclSingleVectorIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclSingleVectorIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclSingleVectorIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclSingleVectorIterator.SetValue(const AValue: Single); +begin + CheckValid; + FOwnList.SetValue(FCursor, AValue); +end; + +//=== { TJclDoubleVector } ====================================================== + +constructor TJclDoubleVector.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +constructor TJclDoubleVector.Create(const ACollection: IJclDoubleCollection); +begin + inherited Create(); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclDoubleVector.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclDoubleVector.Add(const AValue: Double): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(AValue, FItems[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FItems[FSize] := AValue; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleVector.AddAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleVector.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclDoubleVector; + ACollection: IJclDoubleCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclDoubleVector then + begin + ADest := TJclDoubleVector(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclDoubleCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclDoubleVector.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeDouble(FItems[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleVector.CollectionEquals(const ACollection: IJclDoubleCollection): Boolean; +var + I: Integer; + It: IJclDoubleIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FItems[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleVector.Contains(const AValue: Double): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], AValue) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleVector.ContainsAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleVector.Delete(Index: Integer): Double; +var + Extracted: Double; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreeDouble(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleVector.Extract(const AValue: Double): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], AValue) then + begin + if I < (FSize - 1) then + MoveArray(FItems, I + 1, I, FSize - 1 - I) + else + FItems[I] := 0.0; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleVector.ExtractAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleVector.ExtractIndex(Index: Integer): Double; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FItems[Index]; + if Index < (FSize - 1) then + MoveArray(FItems, Index + 1, Index, FSize - 1 - Index) + else + FItems[Index] := 0.0; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleVector.First: IJclDoubleIterator; +begin + Result := TJclDoubleVectorIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclDoubleVector.GetEnumerator: IJclDoubleIterator; +begin + Result := TJclDoubleVectorIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclDoubleVector.GetValue(Index: Integer): Double; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if (Index >= 0) or (Index < FSize) then + Result := FItems[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleVector.IndexOf(const AValue: Double): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], AValue) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleVector.Insert(Index: Integer; const AValue: Double): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AValue, FItems[I]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FItems, Index, Index + 1, FSize - Index); + FItems[Index] := AValue; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleVector.InsertAll(Index: Integer; const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleVector.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclDoubleVector.Last: IJclDoubleIterator; +begin + Result := TJclDoubleVectorIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclDoubleVector.LastIndexOf(const AValue: Double): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], AValue) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleVector.RaiseOutOfBoundsError: Double; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclDoubleVector.Remove(const AValue: Double): Boolean; +var + Extracted: Double; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeDouble(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleVector.RemoveAll(const ACollection: IJclDoubleCollection): Boolean; +var + It: IJclDoubleIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleVector.RetainAll(const ACollection: IJclDoubleCollection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FItems[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleVector.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FItems, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclDoubleVector.SetValue(Index: Integer; const AValue: Double); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AValue, FItems[I]) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreeDouble(FItems[Index]); + FItems[Index] := AValue; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleVector.Size: Integer; +begin + Result := FSize; +end; + +function TJclDoubleVector.SubList(First, Count: Integer): IJclDoubleList; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclDoubleList; + for I := First to Last do + Result.Add(FItems[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclDoubleVector.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclDoubleVector.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclDoubleVectorIterator } =========================================================== + +constructor TJclDoubleVectorIterator.Create(AOwnList: TJclDoubleVector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclDoubleVectorIterator.Add(const AValue: Double): Boolean; +begin + Result := FOwnList.Add(AValue); +end; + +procedure TJclDoubleVectorIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclDoubleVectorIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclDoubleVectorIterator then + begin + ADest := TJclDoubleVectorIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclDoubleVectorIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclDoubleVectorIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclDoubleVectorIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclDoubleVectorIterator.GetValue: Double; +begin + CheckValid; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclDoubleVectorIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclDoubleVectorIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclDoubleVectorIterator.Insert(const AValue: Double): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, AValue); +end; + +function TJclDoubleVectorIterator.IteratorEquals(const AIterator: IJclDoubleIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclDoubleVectorIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclDoubleVectorIterator then + begin + ItrObj := TJclDoubleVectorIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclDoubleVectorIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclDoubleVectorIterator.Next: Double; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclDoubleVectorIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclDoubleVectorIterator.Previous: Double; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclDoubleVectorIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclDoubleVectorIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclDoubleVectorIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclDoubleVectorIterator.SetValue(const AValue: Double); +begin + CheckValid; + FOwnList.SetValue(FCursor, AValue); +end; + +//=== { TJclExtendedVector } ====================================================== + +constructor TJclExtendedVector.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +constructor TJclExtendedVector.Create(const ACollection: IJclExtendedCollection); +begin + inherited Create(); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclExtendedVector.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclExtendedVector.Add(const AValue: Extended): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(AValue, FItems[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FItems[FSize] := AValue; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedVector.AddAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedVector.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclExtendedVector; + ACollection: IJclExtendedCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclExtendedVector then + begin + ADest := TJclExtendedVector(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclExtendedCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclExtendedVector.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeExtended(FItems[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedVector.CollectionEquals(const ACollection: IJclExtendedCollection): Boolean; +var + I: Integer; + It: IJclExtendedIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FItems[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedVector.Contains(const AValue: Extended): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], AValue) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedVector.ContainsAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedVector.Delete(Index: Integer): Extended; +var + Extracted: Extended; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreeExtended(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedVector.Extract(const AValue: Extended): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], AValue) then + begin + if I < (FSize - 1) then + MoveArray(FItems, I + 1, I, FSize - 1 - I) + else + FItems[I] := 0.0; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedVector.ExtractAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedVector.ExtractIndex(Index: Integer): Extended; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FItems[Index]; + if Index < (FSize - 1) then + MoveArray(FItems, Index + 1, Index, FSize - 1 - Index) + else + FItems[Index] := 0.0; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedVector.First: IJclExtendedIterator; +begin + Result := TJclExtendedVectorIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclExtendedVector.GetEnumerator: IJclExtendedIterator; +begin + Result := TJclExtendedVectorIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclExtendedVector.GetValue(Index: Integer): Extended; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0.0; + if (Index >= 0) or (Index < FSize) then + Result := FItems[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedVector.IndexOf(const AValue: Extended): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], AValue) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedVector.Insert(Index: Integer; const AValue: Extended): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AValue, FItems[I]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FItems, Index, Index + 1, FSize - Index); + FItems[Index] := AValue; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedVector.InsertAll(Index: Integer; const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedVector.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclExtendedVector.Last: IJclExtendedIterator; +begin + Result := TJclExtendedVectorIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclExtendedVector.LastIndexOf(const AValue: Extended): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], AValue) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedVector.RaiseOutOfBoundsError: Extended; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclExtendedVector.Remove(const AValue: Extended): Boolean; +var + Extracted: Extended; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeExtended(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedVector.RemoveAll(const ACollection: IJclExtendedCollection): Boolean; +var + It: IJclExtendedIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedVector.RetainAll(const ACollection: IJclExtendedCollection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FItems[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedVector.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FItems, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclExtendedVector.SetValue(Index: Integer; const AValue: Extended); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AValue, 0.0); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AValue, FItems[I]) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreeExtended(FItems[Index]); + FItems[Index] := AValue; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedVector.Size: Integer; +begin + Result := FSize; +end; + +function TJclExtendedVector.SubList(First, Count: Integer): IJclExtendedList; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclExtendedList; + for I := First to Last do + Result.Add(FItems[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclExtendedVector.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclExtendedVector.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclExtendedVectorIterator } =========================================================== + +constructor TJclExtendedVectorIterator.Create(AOwnList: TJclExtendedVector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclExtendedVectorIterator.Add(const AValue: Extended): Boolean; +begin + Result := FOwnList.Add(AValue); +end; + +procedure TJclExtendedVectorIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclExtendedVectorIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclExtendedVectorIterator then + begin + ADest := TJclExtendedVectorIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclExtendedVectorIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclExtendedVectorIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclExtendedVectorIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclExtendedVectorIterator.GetValue: Extended; +begin + CheckValid; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclExtendedVectorIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclExtendedVectorIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclExtendedVectorIterator.Insert(const AValue: Extended): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, AValue); +end; + +function TJclExtendedVectorIterator.IteratorEquals(const AIterator: IJclExtendedIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclExtendedVectorIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclExtendedVectorIterator then + begin + ItrObj := TJclExtendedVectorIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclExtendedVectorIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclExtendedVectorIterator.Next: Extended; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclExtendedVectorIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclExtendedVectorIterator.Previous: Extended; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclExtendedVectorIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclExtendedVectorIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclExtendedVectorIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclExtendedVectorIterator.SetValue(const AValue: Extended); +begin + CheckValid; + FOwnList.SetValue(FCursor, AValue); +end; + +//=== { TJclIntegerVector } ====================================================== + +constructor TJclIntegerVector.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +constructor TJclIntegerVector.Create(const ACollection: IJclIntegerCollection); +begin + inherited Create(); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclIntegerVector.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclIntegerVector.Add(AValue: Integer): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(AValue, FItems[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FItems[FSize] := AValue; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerVector.AddAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerVector.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclIntegerVector; + ACollection: IJclIntegerCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclIntegerVector then + begin + ADest := TJclIntegerVector(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclIntegerCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclIntegerVector.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeInteger(FItems[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerVector.CollectionEquals(const ACollection: IJclIntegerCollection): Boolean; +var + I: Integer; + It: IJclIntegerIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FItems[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerVector.Contains(AValue: Integer): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], AValue) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerVector.ContainsAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerVector.Delete(Index: Integer): Integer; +var + Extracted: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreeInteger(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerVector.Extract(AValue: Integer): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], AValue) then + begin + if I < (FSize - 1) then + MoveArray(FItems, I + 1, I, FSize - 1 - I) + else + FItems[I] := 0; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerVector.ExtractAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerVector.ExtractIndex(Index: Integer): Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FItems[Index]; + if Index < (FSize - 1) then + MoveArray(FItems, Index + 1, Index, FSize - 1 - Index) + else + FItems[Index] := 0; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerVector.First: IJclIntegerIterator; +begin + Result := TJclIntegerVectorIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclIntegerVector.GetEnumerator: IJclIntegerIterator; +begin + Result := TJclIntegerVectorIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclIntegerVector.GetValue(Index: Integer): Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if (Index >= 0) or (Index < FSize) then + Result := FItems[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerVector.IndexOf(AValue: Integer): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], AValue) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerVector.Insert(Index: Integer; AValue: Integer): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AValue, FItems[I]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FItems, Index, Index + 1, FSize - Index); + FItems[Index] := AValue; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerVector.InsertAll(Index: Integer; const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerVector.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntegerVector.Last: IJclIntegerIterator; +begin + Result := TJclIntegerVectorIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclIntegerVector.LastIndexOf(AValue: Integer): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], AValue) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerVector.RaiseOutOfBoundsError: Integer; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclIntegerVector.Remove(AValue: Integer): Boolean; +var + Extracted: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeInteger(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerVector.RemoveAll(const ACollection: IJclIntegerCollection): Boolean; +var + It: IJclIntegerIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerVector.RetainAll(const ACollection: IJclIntegerCollection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FItems[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerVector.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FItems, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclIntegerVector.SetValue(Index: Integer; AValue: Integer); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AValue, FItems[I]) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreeInteger(FItems[Index]); + FItems[Index] := AValue; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerVector.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntegerVector.SubList(First, Count: Integer): IJclIntegerList; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclIntegerList; + for I := First to Last do + Result.Add(FItems[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclIntegerVector.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclIntegerVector.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclIntegerVectorIterator } =========================================================== + +constructor TJclIntegerVectorIterator.Create(AOwnList: TJclIntegerVector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclIntegerVectorIterator.Add(AValue: Integer): Boolean; +begin + Result := FOwnList.Add(AValue); +end; + +procedure TJclIntegerVectorIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclIntegerVectorIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclIntegerVectorIterator then + begin + ADest := TJclIntegerVectorIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclIntegerVectorIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclIntegerVectorIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclIntegerVectorIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclIntegerVectorIterator.GetValue: Integer; +begin + CheckValid; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclIntegerVectorIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclIntegerVectorIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclIntegerVectorIterator.Insert(AValue: Integer): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, AValue); +end; + +function TJclIntegerVectorIterator.IteratorEquals(const AIterator: IJclIntegerIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclIntegerVectorIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclIntegerVectorIterator then + begin + ItrObj := TJclIntegerVectorIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclIntegerVectorIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclIntegerVectorIterator.Next: Integer; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclIntegerVectorIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclIntegerVectorIterator.Previous: Integer; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclIntegerVectorIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclIntegerVectorIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclIntegerVectorIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclIntegerVectorIterator.SetValue(AValue: Integer); +begin + CheckValid; + FOwnList.SetValue(FCursor, AValue); +end; + +//=== { TJclCardinalVector } ====================================================== + +constructor TJclCardinalVector.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +constructor TJclCardinalVector.Create(const ACollection: IJclCardinalCollection); +begin + inherited Create(); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclCardinalVector.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclCardinalVector.Add(AValue: Cardinal): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(AValue, FItems[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FItems[FSize] := AValue; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalVector.AddAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalVector.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclCardinalVector; + ACollection: IJclCardinalCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclCardinalVector then + begin + ADest := TJclCardinalVector(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclCardinalCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclCardinalVector.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeCardinal(FItems[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalVector.CollectionEquals(const ACollection: IJclCardinalCollection): Boolean; +var + I: Integer; + It: IJclCardinalIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FItems[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalVector.Contains(AValue: Cardinal): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], AValue) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalVector.ContainsAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalVector.Delete(Index: Integer): Cardinal; +var + Extracted: Cardinal; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreeCardinal(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalVector.Extract(AValue: Cardinal): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], AValue) then + begin + if I < (FSize - 1) then + MoveArray(FItems, I + 1, I, FSize - 1 - I) + else + FItems[I] := 0; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalVector.ExtractAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalVector.ExtractIndex(Index: Integer): Cardinal; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FItems[Index]; + if Index < (FSize - 1) then + MoveArray(FItems, Index + 1, Index, FSize - 1 - Index) + else + FItems[Index] := 0; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalVector.First: IJclCardinalIterator; +begin + Result := TJclCardinalVectorIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclCardinalVector.GetEnumerator: IJclCardinalIterator; +begin + Result := TJclCardinalVectorIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclCardinalVector.GetValue(Index: Integer): Cardinal; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if (Index >= 0) or (Index < FSize) then + Result := FItems[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalVector.IndexOf(AValue: Cardinal): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], AValue) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalVector.Insert(Index: Integer; AValue: Cardinal): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AValue, FItems[I]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FItems, Index, Index + 1, FSize - Index); + FItems[Index] := AValue; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalVector.InsertAll(Index: Integer; const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalVector.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclCardinalVector.Last: IJclCardinalIterator; +begin + Result := TJclCardinalVectorIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclCardinalVector.LastIndexOf(AValue: Cardinal): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], AValue) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalVector.RaiseOutOfBoundsError: Cardinal; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclCardinalVector.Remove(AValue: Cardinal): Boolean; +var + Extracted: Cardinal; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeCardinal(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalVector.RemoveAll(const ACollection: IJclCardinalCollection): Boolean; +var + It: IJclCardinalIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalVector.RetainAll(const ACollection: IJclCardinalCollection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FItems[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalVector.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FItems, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclCardinalVector.SetValue(Index: Integer; AValue: Cardinal); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AValue, FItems[I]) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreeCardinal(FItems[Index]); + FItems[Index] := AValue; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalVector.Size: Integer; +begin + Result := FSize; +end; + +function TJclCardinalVector.SubList(First, Count: Integer): IJclCardinalList; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclCardinalList; + for I := First to Last do + Result.Add(FItems[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclCardinalVector.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclCardinalVector.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclCardinalVectorIterator } =========================================================== + +constructor TJclCardinalVectorIterator.Create(AOwnList: TJclCardinalVector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclCardinalVectorIterator.Add(AValue: Cardinal): Boolean; +begin + Result := FOwnList.Add(AValue); +end; + +procedure TJclCardinalVectorIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclCardinalVectorIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclCardinalVectorIterator then + begin + ADest := TJclCardinalVectorIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclCardinalVectorIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclCardinalVectorIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclCardinalVectorIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclCardinalVectorIterator.GetValue: Cardinal; +begin + CheckValid; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclCardinalVectorIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclCardinalVectorIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclCardinalVectorIterator.Insert(AValue: Cardinal): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, AValue); +end; + +function TJclCardinalVectorIterator.IteratorEquals(const AIterator: IJclCardinalIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclCardinalVectorIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclCardinalVectorIterator then + begin + ItrObj := TJclCardinalVectorIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclCardinalVectorIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclCardinalVectorIterator.Next: Cardinal; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclCardinalVectorIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclCardinalVectorIterator.Previous: Cardinal; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclCardinalVectorIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclCardinalVectorIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclCardinalVectorIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclCardinalVectorIterator.SetValue(AValue: Cardinal); +begin + CheckValid; + FOwnList.SetValue(FCursor, AValue); +end; + +//=== { TJclInt64Vector } ====================================================== + +constructor TJclInt64Vector.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +constructor TJclInt64Vector.Create(const ACollection: IJclInt64Collection); +begin + inherited Create(); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclInt64Vector.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclInt64Vector.Add(const AValue: Int64): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(AValue, FItems[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FItems[FSize] := AValue; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Vector.AddAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64Vector.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclInt64Vector; + ACollection: IJclInt64Collection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclInt64Vector then + begin + ADest := TJclInt64Vector(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclInt64Collection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclInt64Vector.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeInt64(FItems[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Vector.CollectionEquals(const ACollection: IJclInt64Collection): Boolean; +var + I: Integer; + It: IJclInt64Iterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FItems[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Vector.Contains(const AValue: Int64): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], AValue) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Vector.ContainsAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Vector.Delete(Index: Integer): Int64; +var + Extracted: Int64; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreeInt64(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Vector.Extract(const AValue: Int64): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], AValue) then + begin + if I < (FSize - 1) then + MoveArray(FItems, I + 1, I, FSize - 1 - I) + else + FItems[I] := 0; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Vector.ExtractAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Vector.ExtractIndex(Index: Integer): Int64; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FItems[Index]; + if Index < (FSize - 1) then + MoveArray(FItems, Index + 1, Index, FSize - 1 - Index) + else + FItems[Index] := 0; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Vector.First: IJclInt64Iterator; +begin + Result := TJclInt64VectorIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclInt64Vector.GetEnumerator: IJclInt64Iterator; +begin + Result := TJclInt64VectorIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclInt64Vector.GetValue(Index: Integer): Int64; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := 0; + if (Index >= 0) or (Index < FSize) then + Result := FItems[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Vector.IndexOf(const AValue: Int64): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], AValue) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Vector.Insert(Index: Integer; const AValue: Int64): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AValue, FItems[I]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FItems, Index, Index + 1, FSize - Index); + FItems[Index] := AValue; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Vector.InsertAll(Index: Integer; const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Vector.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclInt64Vector.Last: IJclInt64Iterator; +begin + Result := TJclInt64VectorIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclInt64Vector.LastIndexOf(const AValue: Int64): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], AValue) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Vector.RaiseOutOfBoundsError: Int64; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclInt64Vector.Remove(const AValue: Int64): Boolean; +var + Extracted: Int64; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AValue); + if Result then + begin + Extracted := AValue; + FreeInt64(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Vector.RemoveAll(const ACollection: IJclInt64Collection): Boolean; +var + It: IJclInt64Iterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Vector.RetainAll(const ACollection: IJclInt64Collection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FItems[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64Vector.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FItems, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclInt64Vector.SetValue(Index: Integer; const AValue: Int64); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AValue, 0); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AValue, FItems[I]) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreeInt64(FItems[Index]); + FItems[Index] := AValue; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Vector.Size: Integer; +begin + Result := FSize; +end; + +function TJclInt64Vector.SubList(First, Count: Integer): IJclInt64List; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclInt64List; + for I := First to Last do + Result.Add(FItems[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclInt64Vector.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclInt64Vector.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclInt64VectorIterator } =========================================================== + +constructor TJclInt64VectorIterator.Create(AOwnList: TJclInt64Vector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclInt64VectorIterator.Add(const AValue: Int64): Boolean; +begin + Result := FOwnList.Add(AValue); +end; + +procedure TJclInt64VectorIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclInt64VectorIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclInt64VectorIterator then + begin + ADest := TJclInt64VectorIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclInt64VectorIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclInt64VectorIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclInt64VectorIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclInt64VectorIterator.GetValue: Int64; +begin + CheckValid; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclInt64VectorIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclInt64VectorIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclInt64VectorIterator.Insert(const AValue: Int64): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, AValue); +end; + +function TJclInt64VectorIterator.IteratorEquals(const AIterator: IJclInt64Iterator): Boolean; +var + Obj: TObject; + ItrObj: TJclInt64VectorIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclInt64VectorIterator then + begin + ItrObj := TJclInt64VectorIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclInt64VectorIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclInt64VectorIterator.Next: Int64; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclInt64VectorIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclInt64VectorIterator.Previous: Int64; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetValue(FCursor); +end; + +function TJclInt64VectorIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclInt64VectorIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclInt64VectorIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclInt64VectorIterator.SetValue(const AValue: Int64); +begin + CheckValid; + FOwnList.SetValue(FCursor, AValue); +end; + +//=== { TJclPtrVector } ====================================================== + +constructor TJclPtrVector.Create(ACapacity: Integer); +begin + inherited Create(); + SetCapacity(ACapacity); +end; + +constructor TJclPtrVector.Create(const ACollection: IJclPtrCollection); +begin + inherited Create(); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclPtrVector.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclPtrVector.Add(APtr: Pointer): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(APtr, nil); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(APtr, FItems[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FItems[FSize] := APtr; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrVector.AddAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrVector.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclPtrVector; + ACollection: IJclPtrCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclPtrVector then + begin + ADest := TJclPtrVector(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclPtrCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclPtrVector.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreePointer(FItems[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrVector.CollectionEquals(const ACollection: IJclPtrCollection): Boolean; +var + I: Integer; + It: IJclPtrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FItems[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrVector.Contains(APtr: Pointer): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], APtr) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrVector.ContainsAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrVector.Delete(Index: Integer): Pointer; +var + Extracted: Pointer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreePointer(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrVector.Extract(APtr: Pointer): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], APtr) then + begin + if I < (FSize - 1) then + MoveArray(FItems, I + 1, I, FSize - 1 - I) + else + FItems[I] := nil; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrVector.ExtractAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrVector.ExtractIndex(Index: Integer): Pointer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FItems[Index]; + if Index < (FSize - 1) then + MoveArray(FItems, Index + 1, Index, FSize - 1 - Index) + else + FItems[Index] := nil; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrVector.First: IJclPtrIterator; +begin + Result := TJclPtrVectorIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclPtrVector.GetEnumerator: IJclPtrIterator; +begin + Result := TJclPtrVectorIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclPtrVector.GetPointer(Index: Integer): Pointer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if (Index >= 0) or (Index < FSize) then + Result := FItems[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrVector.IndexOf(APtr: Pointer): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], APtr) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrVector.Insert(Index: Integer; APtr: Pointer): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(APtr, nil); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(APtr, FItems[I]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FItems, Index, Index + 1, FSize - Index); + FItems[Index] := APtr; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrVector.InsertAll(Index: Integer; const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrVector.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclPtrVector.Last: IJclPtrIterator; +begin + Result := TJclPtrVectorIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclPtrVector.LastIndexOf(APtr: Pointer): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], APtr) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrVector.RaiseOutOfBoundsError: Pointer; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclPtrVector.Remove(APtr: Pointer): Boolean; +var + Extracted: Pointer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(APtr); + if Result then + begin + Extracted := APtr; + FreePointer(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrVector.RemoveAll(const ACollection: IJclPtrCollection): Boolean; +var + It: IJclPtrIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrVector.RetainAll(const ACollection: IJclPtrCollection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FItems[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrVector.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FItems, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclPtrVector.SetPointer(Index: Integer; APtr: Pointer); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(APtr, nil); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(APtr, FItems[I]) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreePointer(FItems[Index]); + FItems[Index] := APtr; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrVector.Size: Integer; +begin + Result := FSize; +end; + +function TJclPtrVector.SubList(First, Count: Integer): IJclPtrList; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclPtrList; + for I := First to Last do + Result.Add(FItems[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclPtrVector.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclPtrVector.Create(FSize); + AssignPropertiesTo(Result); +end; + +//=== { TJclPtrVectorIterator } =========================================================== + +constructor TJclPtrVectorIterator.Create(AOwnList: TJclPtrVector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclPtrVectorIterator.Add(APtr: Pointer): Boolean; +begin + Result := FOwnList.Add(APtr); +end; + +procedure TJclPtrVectorIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclPtrVectorIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclPtrVectorIterator then + begin + ADest := TJclPtrVectorIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclPtrVectorIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclPtrVectorIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclPtrVectorIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclPtrVectorIterator.GetPointer: Pointer; +begin + CheckValid; + Result := FOwnList.GetPointer(FCursor); +end; + +function TJclPtrVectorIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclPtrVectorIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclPtrVectorIterator.Insert(APtr: Pointer): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, APtr); +end; + +function TJclPtrVectorIterator.IteratorEquals(const AIterator: IJclPtrIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclPtrVectorIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclPtrVectorIterator then + begin + ItrObj := TJclPtrVectorIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclPtrVectorIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclPtrVectorIterator.Next: Pointer; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetPointer(FCursor); +end; + +function TJclPtrVectorIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclPtrVectorIterator.Previous: Pointer; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetPointer(FCursor); +end; + +function TJclPtrVectorIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclPtrVectorIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclPtrVectorIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclPtrVectorIterator.SetPointer(APtr: Pointer); +begin + CheckValid; + FOwnList.SetPointer(FCursor, APtr); +end; + +//=== { TJclVector } ====================================================== + +constructor TJclVector.Create(ACapacity: Integer; AOwnsObjects: Boolean); +begin + inherited Create(AOwnsObjects); + SetCapacity(ACapacity); +end; + +constructor TJclVector.Create(const ACollection: IJclCollection; AOwnsObjects: Boolean); +begin + inherited Create(AOwnsObjects); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclVector.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclVector.Add(AObject: TObject): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AObject, nil); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(AObject, FItems[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FItems[FSize] := AObject; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.AddAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclVector.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclVector; + ACollection: IJclCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclVector then + begin + ADest := TJclVector(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclVector.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeObject(FItems[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.CollectionEquals(const ACollection: IJclCollection): Boolean; +var + I: Integer; + It: IJclIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FItems[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.Contains(AObject: TObject): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], AObject) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.ContainsAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.Delete(Index: Integer): TObject; +var + Extracted: TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreeObject(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.Extract(AObject: TObject): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], AObject) then + begin + if I < (FSize - 1) then + MoveArray(FItems, I + 1, I, FSize - 1 - I) + else + FItems[I] := nil; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.ExtractAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.ExtractIndex(Index: Integer): TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FItems[Index]; + if Index < (FSize - 1) then + MoveArray(FItems, Index + 1, Index, FSize - 1 - Index) + else + FItems[Index] := nil; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.First: IJclIterator; +begin + Result := TJclVectorIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclVector.GetEnumerator: IJclIterator; +begin + Result := TJclVectorIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclVector.GetObject(Index: Integer): TObject; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := nil; + if (Index >= 0) or (Index < FSize) then + Result := FItems[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.IndexOf(AObject: TObject): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], AObject) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.Insert(Index: Integer; AObject: TObject): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AObject, nil); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AObject, FItems[I]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FItems, Index, Index + 1, FSize - Index); + FItems[Index] := AObject; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.InsertAll(Index: Integer; const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclVector.Last: IJclIterator; +begin + Result := TJclVectorIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclVector.LastIndexOf(AObject: TObject): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], AObject) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.RaiseOutOfBoundsError: TObject; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclVector.Remove(AObject: TObject): Boolean; +var + Extracted: TObject; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AObject); + if Result then + begin + Extracted := AObject; + FreeObject(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.RemoveAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.RetainAll(const ACollection: IJclCollection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FItems[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclVector.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FItems, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclVector.SetObject(Index: Integer; AObject: TObject); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AObject, nil); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AObject, FItems[I]) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreeObject(FItems[Index]); + FItems[Index] := AObject; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.Size: Integer; +begin + Result := FSize; +end; + +function TJclVector.SubList(First, Count: Integer): IJclList; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclList; + for I := First to Last do + Result.Add(FItems[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclVector.Create(FSize, False); + AssignPropertiesTo(Result); +end; + +//=== { TJclVectorIterator } =========================================================== + +constructor TJclVectorIterator.Create(AOwnList: TJclVector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclVectorIterator.Add(AObject: TObject): Boolean; +begin + Result := FOwnList.Add(AObject); +end; + +procedure TJclVectorIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclVectorIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclVectorIterator then + begin + ADest := TJclVectorIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclVectorIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclVectorIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclVectorIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclVectorIterator.GetObject: TObject; +begin + CheckValid; + Result := FOwnList.GetObject(FCursor); +end; + +function TJclVectorIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclVectorIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclVectorIterator.Insert(AObject: TObject): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, AObject); +end; + +function TJclVectorIterator.IteratorEquals(const AIterator: IJclIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclVectorIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclVectorIterator then + begin + ItrObj := TJclVectorIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclVectorIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclVectorIterator.Next: TObject; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetObject(FCursor); +end; + +function TJclVectorIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclVectorIterator.Previous: TObject; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetObject(FCursor); +end; + +function TJclVectorIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclVectorIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclVectorIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclVectorIterator.SetObject(AObject: TObject); +begin + CheckValid; + FOwnList.SetObject(FCursor, AObject); +end; + + +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +//=== { TJclVector } ====================================================== + +constructor TJclVector.Create(ACapacity: Integer; AOwnsItems: Boolean); +begin + inherited Create(AOwnsItems); + SetCapacity(ACapacity); +end; + +constructor TJclVector.Create(const ACollection: IJclCollection; AOwnsItems: Boolean); +begin + inherited Create(AOwnsItems); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclVector.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function TJclVector.Add(const AItem: T): Boolean; +var + Index: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AItem, Default(T)); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(AItem, FItems[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FItems[FSize] := AItem; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.AddAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclVector.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclVector; + ACollection: IJclCollection; +begin + inherited AssignDataTo(Dest); + if Dest is TJclVector then + begin + ADest := TJclVector(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), IJclCollection, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure TJclVector.Clear; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeItem(FItems[I]); + FSize := 0; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.CollectionEquals(const ACollection: IJclCollection): Boolean; +var + I: Integer; + It: IJclIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FItems[I], It.Next) then + Exit; + Result := True; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.Contains(const AItem: T): Boolean; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], AItem) then + begin + Result := True; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.ContainsAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.Delete(Index: Integer): T; +var + Extracted: T; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Extracted := ExtractIndex(Index); + Result := FreeItem(Extracted); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.Extract(const AItem: T): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], AItem) then + begin + if I < (FSize - 1) then + MoveArray(FItems, I + 1, I, FSize - 1 - I) + else + FItems[I] := Default(T); + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.ExtractAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.ExtractIndex(Index: Integer): T; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index >= 0) and (Index < FSize) then + begin + Result := FItems[Index]; + if Index < (FSize - 1) then + MoveArray(FItems, Index + 1, Index, FSize - 1 - Index) + else + FItems[Index] := Default(T); + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.First: IJclIterator; +begin + Result := TVectorIterator.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclVector.GetEnumerator: IJclIterator; +begin + Result := TVectorIterator.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclVector.GetItem(Index: Integer): T; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := Default(T); + if (Index >= 0) or (Index < FSize) then + Result := FItems[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.IndexOf(const AItem: T): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], AItem) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.Insert(Index: Integer; const AItem: T): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := FAllowDefaultElements or not ItemsEqual(AItem, Default(T)); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AItem, FItems[I]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MoveArray(FItems, Index, Index + 1, FSize - Index); + FItems[Index] := AItem; + Inc(FSize); + end; + end; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.InsertAll(Index: Integer; const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclVector.Last: IJclIterator; +begin + Result := TVectorIterator.Create(Self, FSize - 1, False, isLast); +end; + +function TJclVector.LastIndexOf(const AItem: T): Integer; +var + I: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], AItem) then + begin + Result := I; + Break; + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.RaiseOutOfBoundsError: T; +begin + raise EJclOutOfBoundsError.Create; +end; + +function TJclVector.Remove(const AItem: T): Boolean; +var + Extracted: T; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := Extract(AItem); + if Result then + begin + Extracted := AItem; + FreeItem(Extracted); + end; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.RemoveAll(const ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.RetainAll(const ACollection: IJclCollection): Boolean; +var + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FItems[I]) then + Delete(I); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclVector.SetCapacity(Value: Integer); +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if Value >= FSize then + begin + SetLength(FItems, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclVector.SetItem(Index: Integer; const AItem: T); +var + ReplaceItem: Boolean; + I: Integer; +begin + if ReadOnly then + raise EJclReadOnlyError.Create; + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginWrite; + try + {$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(AItem, Default(T)); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(AItem, FItems[I]) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + FreeItem(FItems[Index]); + FItems[Index] := AItem; + end; + end; + if not ReplaceItem then + Delete(Index); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndWrite; + end; + {$ENDIF THREADSAFE} +end; + +function TJclVector.Size: Integer; +begin + Result := FSize; +end; + +function TJclVector.SubList(First, Count: Integer): IJclList; +var + I: Integer; + Last: Integer; +begin + {$IFDEF THREADSAFE} + if FThreadSafe then + SyncReaderWriter.BeginRead; + try + {$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as IJclList; + for I := First to Last do + Result.Add(FItems[I]); + {$IFDEF THREADSAFE} + finally + if FThreadSafe then + SyncReaderWriter.EndRead; + end; + {$ENDIF THREADSAFE} +end; + +procedure TJclVector.MoveArray(var List: TDynArray; FromIndex, ToIndex, Count: SizeInt); +var + I: SizeInt; +begin + if FromIndex < ToIndex then + begin + for I := Count - 1 downto 0 do + List[ToIndex + I] := List[FromIndex + I]; + + if (ToIndex - FromIndex) < Count then + // overlapped source and target + for I := 0 to ToIndex - FromIndex - 1 do + List[FromIndex + I] := Default(T) + else + // independent + for I := 0 to Count - 1 do + List[FromIndex + I] := Default(T); + end + else + begin + for I := 0 to Count - 1 do + List[ToIndex + I] := List[FromIndex + I]; + + if (FromIndex - ToIndex) < Count then + // overlapped source and target + for I := Count - FromIndex + ToIndex to Count - 1 do + List[FromIndex + I] := Default(T) + else + // independent + for I := 0 to Count - 1 do + List[FromIndex + I] := Default(T); + end; +end; + +//=== { TJclVectorIterator } =========================================================== + +constructor TJclVectorIterator.Create(AOwnList: TJclVector; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function TJclVectorIterator.Add(const AItem: T): Boolean; +begin + Result := FOwnList.Add(AItem); +end; + +procedure TJclVectorIterator.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: TJclVectorIterator; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclVectorIterator then + begin + ADest := TJclVectorIterator(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function TJclVectorIterator.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := TJclVectorIterator.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure TJclVectorIterator.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function TJclVectorIterator.GetItem: T; +begin + CheckValid; + Result := FOwnList.GetItem(FCursor); +end; + +function TJclVectorIterator.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function TJclVectorIterator.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function TJclVectorIterator.Insert(const AItem: T): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, AItem); +end; + +function TJclVectorIterator.IteratorEquals(const AIterator: IJclIterator): Boolean; +var + Obj: TObject; + ItrObj: TJclVectorIterator; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is TJclVectorIterator then + begin + ItrObj := TJclVectorIterator(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function TJclVectorIterator.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function TJclVectorIterator.Next: T; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GetItem(FCursor); +end; + +function TJclVectorIterator.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function TJclVectorIterator.Previous: T; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GetItem(FCursor); +end; + +function TJclVectorIterator.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure TJclVectorIterator.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure TJclVectorIterator.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure TJclVectorIterator.SetItem(const AItem: T); +begin + CheckValid; + FOwnList.SetItem(FCursor, AItem); +end; + +//=== { TJclVectorE } ===================================================== + +constructor TJclVectorE.Create(const AEqualityComparer: IJclEqualityComparer; ACapacity: Integer; + AOwnsItems: Boolean); +begin + inherited Create(ACapacity, AOwnsItems); + FEqualityComparer := AEqualityComparer; +end; + +procedure TJclVectorE.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclVectorE then + TJclVectorE(Dest).FEqualityComparer := FEqualityComparer; +end; + +function TJclVectorE.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclVectorE.Create(EqualityComparer, FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclVectorE.ItemsEqual(const A, B: T): Boolean; +begin + if EqualityComparer <> nil then + Result := EqualityComparer.ItemsEqual(A, B) + else + Result := inherited ItemsEqual(A, B); +end; + +//=== { TJclVectorF } ===================================================== + +constructor TJclVectorF.Create(const AEqualityCompare: TEqualityCompare; ACapacity: Integer; + AOwnsItems: Boolean); +begin + inherited Create(ACapacity, AOwnsItems); + SetEqualityCompare(AEqualityCompare); +end; + +function TJclVectorF.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclVectorF.Create(EqualityCompare, FSize, False); + AssignPropertiesTo(Result); +end; + +//=== { TJclVectorI } ===================================================== + +function TJclVectorI.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclVectorI.Create(FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclVectorI.ItemsEqual(const A, B: T): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + Result := A.Equals(B); +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/JclWideStrings.pas b/3rdParty/JCL/source/common/JclWideStrings.pas index f31e9976..89b95774 100644 --- a/3rdParty/JCL/source/common/JclWideStrings.pas +++ b/3rdParty/JCL/source/common/JclWideStrings.pas @@ -1,2318 +1,2318 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is WStrUtils.PAS, released on 2004-01-25. } -{ } -{ The Initial Developers of the Original Code are: } -{ - Andreas Hausladen } -{ - Mike Lischke (WideQuotedStr & WideExtractQuotedStr from Unicode.pas) } -{ Portions created by Andreas Hausladen are Copyright (C) of Andreas Hausladen. } -{ All rights reserved. } -{ Portions created by Mike Lischke are Copyright (C) of Mike Lischke. All rights reserved. } -{ } -{ Contributor(s): } -{ Robert Marquardt (marquardt) } -{ Robert Rossmair (rrossmair) } -{ ZENsan } -{ Florent Ouchet (outchy) } -{ Kiriakos Vlahos } -{ } -{**************************************************************************************************} -{ } -{ This is a lightweight Unicode unit. For more features use JclUnicode. } -{ } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -unit JclWideStrings; - -{$I jcl.inc} - -interface - -uses - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - {$IFDEF HAS_UNITSCOPE} - System.Classes, System.SysUtils, - {$ELSE ~HAS_UNITSCOPE} - Classes, SysUtils, - {$ENDIF ~HAS_UNITSCOPE} - JclBase; - -// Exceptions -type - EJclWideStringError = class(EJclError); - -const - // definitions of often used characters: - // Note: Use them only for tests of a certain character not to determine character - // classes (like white spaces) as in Unicode are often many code points defined - // being in a certain class. Hence your best option is to use the various - // UnicodeIs* functions. - WideNull = WideChar(#0); - WideTabulator = WideChar(#9); - WideSpace = WideChar(#32); - - // logical line breaks - WideLF = WideChar(#10); - WideLineFeed = WideChar(#10); - WideVerticalTab = WideChar(#11); - WideFormFeed = WideChar(#12); - WideCR = WideChar(#13); - WideCarriageReturn = WideChar(#13); - WideCRLF = WideString(#13#10); - WideLineSeparator = WideChar($2028); - WideParagraphSeparator = WideChar($2029); - - {$IFDEF MSWINDOWS} - WideLineBreak = WideCRLF; - {$ENDIF MSWINDOWS} - {$IFDEF UNIX} - WideLineBreak = WideLineFeed; - {$ENDIF UNIX} - - BOM_LSB_FIRST = WideChar($FEFF); - BOM_MSB_FIRST = WideChar($FFFE); - -type - {$IFDEF SUPPORTS_UNICODE} - TJclWideStrings = {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Classes.TStrings; - TJclWideStringList = {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Classes.TStringList; - {$ELSE ~SUPPORTS_UNICODE} - - TWideFileOptionsType = - ( - foAnsiFile, // loads/writes an ANSI file - foUnicodeLB // reads/writes BOM_LSB_FIRST/BOM_MSB_FIRST - ); - TWideFileOptions = set of TWideFileOptionsType; - - TSearchFlag = ( - sfCaseSensitive, // match letter case - sfIgnoreNonSpacing, // ignore non-spacing characters in search - sfSpaceCompress, // handle several consecutive white spaces as one white space - // (this applies to the pattern as well as the search text) - sfWholeWordOnly // match only text at end/start and/or surrounded by white spaces - ); - TSearchFlags = set of TSearchFlag; - - TJclWideStrings = class; - TJclWideStringList = class; - - TJclWideStringListSortCompare = function(List: TJclWideStringList; Index1, Index2: Integer): Integer; - - TJclWideStrings = class(TPersistent) - private - FDelimiter: WideChar; - FQuoteChar: WideChar; - FNameValueSeparator: WideChar; - FLineSeparator: WideString; - FUpdateCount: Integer; - function GetCommaText: WideString; - function GetDelimitedText: WideString; - function GetName(Index: Integer): WideString; - function GetValue(const Name: WideString): WideString; - procedure ReadData(Reader: TReader); - procedure SetCommaText(const Value: WideString); - procedure SetDelimitedText(const Value: WideString); - procedure SetValue(const Name, Value: WideString); - procedure WriteData(Writer: TWriter); - function GetValueFromIndex(Index: Integer): WideString; - procedure SetValueFromIndex(Index: Integer; const Value: WideString); - protected - procedure DefineProperties(Filer: TFiler); override; - function ExtractName(const S: WideString): WideString; - function GetP(Index: Integer): PWideString; virtual; abstract; - function Get(Index: Integer): WideString; - function GetCapacity: Integer; virtual; - function GetCount: Integer; virtual; abstract; - function GetObject(Index: Integer): TObject; virtual; - function GetTextStr: WideString; virtual; - procedure Put(Index: Integer; const S: WideString); virtual; abstract; - procedure PutObject(Index: Integer; AObject: TObject); virtual; abstract; - procedure SetCapacity(NewCapacity: Integer); virtual; - procedure SetTextStr(const Value: WideString); virtual; - procedure SetUpdateState(Updating: Boolean); virtual; - property UpdateCount: Integer read FUpdateCount; - function CompareStrings(const S1, S2: WideString): Integer; virtual; - procedure AssignTo(Dest: TPersistent); override; - public - constructor Create; - function Add(const S: WideString): Integer; virtual; - function AddObject(const S: WideString; AObject: TObject): Integer; virtual; - procedure Append(const S: WideString); - procedure AddStrings(Strings: TJclWideStrings); overload; virtual; - procedure AddStrings(Strings: TStrings); overload; virtual; - procedure Assign(Source: TPersistent); override; - function CreateAnsiStringList: TStrings; - procedure AddStringsTo(Dest: TStrings); virtual; - procedure BeginUpdate; - procedure Clear; virtual; abstract; - procedure Delete(Index: Integer); virtual; abstract; - procedure EndUpdate; - function Equals(Strings: TJclWideStrings): Boolean; {$IFDEF RTL200_UP}reintroduce; {$ENDIF RTL200_UP}overload; - function Equals(Strings: TStrings): Boolean; {$IFDEF RTL200_UP}reintroduce; {$ENDIF RTL200_UP}overload; - procedure Exchange(Index1, Index2: Integer); virtual; - function GetText: PWideChar; virtual; - function IndexOf(const S: WideString): Integer; virtual; - function IndexOfName(const Name: WideString): Integer; virtual; - function IndexOfObject(AObject: TObject): Integer; virtual; - procedure Insert(Index: Integer; const S: WideString); virtual; - procedure InsertObject(Index: Integer; const S: WideString; - AObject: TObject); virtual; - procedure LoadFromFile(const FileName: TFileName; - WideFileOptions: TWideFileOptions = []); virtual; - procedure LoadFromStream(Stream: TStream; - WideFileOptions: TWideFileOptions = []); virtual; - procedure Move(CurIndex, NewIndex: Integer); virtual; - procedure SaveToFile(const FileName: TFileName; - WideFileOptions: TWideFileOptions = []); virtual; - procedure SaveToStream(Stream: TStream; - WideFileOptions: TWideFileOptions = []); virtual; - procedure SetText(Text: PWideChar); virtual; - function GetDelimitedTextEx(ADelimiter, AQuoteChar: WideChar): WideString; - procedure SetDelimitedTextEx(ADelimiter, AQuoteChar: WideChar; const Value: WideString); - property Capacity: Integer read GetCapacity write SetCapacity; - property CommaText: WideString read GetCommaText write SetCommaText; - property Count: Integer read GetCount; - property Delimiter: WideChar read FDelimiter write FDelimiter; - property DelimitedText: WideString read GetDelimitedText write SetDelimitedText; - property Names[Index: Integer]: WideString read GetName; - property Objects[Index: Integer]: TObject read GetObject write PutObject; - property QuoteChar: WideChar read FQuoteChar write FQuoteChar; - property Values[const Name: WideString]: WideString read GetValue write SetValue; - property ValueFromIndex[Index: Integer]: WideString read GetValueFromIndex write SetValueFromIndex; - property NameValueSeparator: WideChar read FNameValueSeparator write FNameValueSeparator; - property LineSeparator: WideString read FLineSeparator write FLineSeparator; - property PStrings[Index: Integer]: PWideString read GetP; - property Strings[Index: Integer]: WideString read Get write Put; default; - property Text: WideString read GetTextStr write SetTextStr; - end; - - // do not replace by JclUnicode.TWideStringList (speed and size issue) - PWStringItem = ^TWStringItem; - TWStringItem = record - FString: WideString; - FObject: TObject; - end; - - TJclWideStringList = class(TJclWideStrings) - private - FList: TList; - FSorted: Boolean; - FDuplicates: TDuplicates; - FCaseSensitive: Boolean; - FOnChange: TNotifyEvent; - FOnChanging: TNotifyEvent; - procedure SetSorted(Value: Boolean); - procedure SetCaseSensitive(const Value: Boolean); - protected - function GetItem(Index: Integer): PWStringItem; - procedure Changed; virtual; - procedure Changing; virtual; - function GetP(Index: Integer): PWideString; override; - function GetCapacity: Integer; override; - function GetCount: Integer; override; - function GetObject(Index: Integer): TObject; override; - procedure Put(Index: Integer; const Value: WideString); override; - procedure PutObject(Index: Integer; AObject: TObject); override; - procedure SetCapacity(NewCapacity: Integer); override; - procedure SetUpdateState(Updating: Boolean); override; - function CompareStrings(const S1, S2: WideString): Integer; override; - public - constructor Create; - destructor Destroy; override; - function AddObject(const S: WideString; AObject: TObject): Integer; override; - procedure Clear; override; - procedure Delete(Index: Integer); override; - procedure Exchange(Index1, Index2: Integer); override; - function Find(const S: WideString; var Index: Integer): Boolean; virtual; - // Find() also works with unsorted lists - function IndexOf(const S: WideString): Integer; override; - procedure InsertObject(Index: Integer; const S: WideString; - AObject: TObject); override; - procedure Sort; virtual; - procedure CustomSort(Compare: TJclWideStringListSortCompare); virtual; - property Duplicates: TDuplicates read FDuplicates write FDuplicates; - property Sorted: Boolean read FSorted write SetSorted; - property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive; - property OnChange: TNotifyEvent read FOnChange write FOnChange; - property OnChanging: TNotifyEvent read FOnChanging write FOnChanging; - end; - {$ENDIF ~SUPPORTS_UNICODE} - - TWideStringList = TJclWideStringList; - TWideStrings = TJclWideStrings; - - TJclUnicodeStringList = TJclWideStringList; - TJclUnicodeStrings = TJclWideStrings; - - // OF deprecated? - TWStringList = TJclWideStringList; - TWStrings = TJclWideStrings; - -// WideChar functions -function CharToWideChar(Ch: AnsiChar): WideChar; -function WideCharToChar(Ch: WideChar): AnsiChar; - -// PWideChar functions -procedure MoveWideChar(const Source; var Dest; Count: SizeInt); - -function StrLenW(const Str: PWideChar): SizeInt; -function StrEndW(const Str: PWideChar): PWideChar; -function StrMoveW(Dest: PWideChar; const Source: PWideChar; Count: SizeInt): PWideChar; -function StrCopyW(Dest: PWideChar; const Source: PWideChar): PWideChar; -function StrECopyW(Dest: PWideChar; const Source: PWideChar): PWideChar; -function StrLCopyW(Dest: PWideChar; const Source: PWideChar; MaxLen: SizeInt): PWideChar; -function StrPCopyWW(Dest: PWideChar; const Source: WideString): PWideChar; -function StrPCopyW(Dest: PWideChar; const Source: AnsiString): PWideChar; -function StrPLCopyWW(Dest: PWideChar; const Source: WideString; MaxLen: SizeInt): PWideChar; -function StrPLCopyW(Dest: PWideChar; const Source: AnsiString; MaxLen: SizeInt): PWideChar; -function StrCatW(Dest: PWideChar; const Source: PWideChar): PWideChar; -function StrLCatW(Dest: PWideChar; const Source: PWideChar; MaxLen: SizeInt): PWideChar; -function StrCompW(const Str1, Str2: PWideChar): SizeInt; -function StrICompW(const Str1, Str2: PWideChar): SizeInt; -function StrLCompW(const Str1, Str2: PWideChar; MaxLen: SizeInt): SizeInt; -function StrLICompW(const Str1, Str2: PWideChar; MaxLen: SizeInt): SizeInt; -function StrLICompW2(const Str1, Str2: PWideChar; MaxLen: SizeInt): SizeInt; -function StrNScanW(const Str1, Str2: PWideChar): SizeInt; -function StrRNScanW(const Str1, Str2: PWideChar): SizeInt; -function StrScanW(const Str: PWideChar; Ch: WideChar): PWideChar; overload; -function StrScanW(Str: PWideChar; Chr: WideChar; StrLen: SizeInt): PWideChar; overload; -function StrRScanW(const Str: PWideChar; Chr: WideChar): PWideChar; -function StrPosW(const Str, SubStr: PWideChar): PWideChar; -function StrAllocW(WideSize: SizeInt): PWideChar; -function StrBufSizeW(const Str: PWideChar): SizeInt; -function StrNewW(const Str: PWideChar): PWideChar; overload; -function StrNewW(const Str: WideString): PWideChar; overload; -procedure StrDisposeW(Str: PWideChar); -procedure StrDisposeAndNilW(var Str: PWideChar); -procedure StrSwapByteOrder(Str: PWideChar); - -// WideString functions -function WidePos(const SubStr, S: WideString): SizeInt; -function WideQuotedStr(const S: WideString; Quote: WideChar): WideString; -function WideExtractQuotedStr(var Src: PWideChar; Quote: WideChar): WideString; -function WideCompareText(const S1, S2: WideString): SizeInt; -function WideCompareStr(const S1, S2: WideString): SizeInt; -function WideUpperCase(const S: WideString): WideString; -function WideLowerCase(const S: WideString): WideString; -function TrimW(const S: WideString): WideString; -function TrimLeftW(const S: WideString): WideString; -function TrimRightW(const S: WideString): WideString; -function WideReverse(const AText: Widestring): Widestring; -procedure WideReverseInPlace(var S: WideString); - -function TrimLeftLengthW(const S: WideString): SizeInt; -function TrimRightLengthW(const S: WideString): SizeInt; - -{$IFNDEF FPC} -function WideStartsText(const SubStr, S: WideString): Boolean; -function WideStartsStr(const SubStr, S: WideString): Boolean; -{$ENDIF ~FPC} - -// MultiSz Routines -type - PWideMultiSz = PWideChar; - -function StringsToMultiSz(var Dest: PWideMultiSz; const Source: TJclWideStrings): PWideMultiSz; -procedure MultiSzToStrings(const Dest: TJclWideStrings; const Source: PWideMultiSz); -function MultiSzLength(const Source: PWideMultiSz): SizeInt; -procedure AllocateMultiSz(var Dest: PWideMultiSz; Len: SizeInt); -procedure FreeMultiSz(var Dest: PWideMultiSz); -function MultiSzDup(const Source: PWideMultiSz): PWideMultiSz; - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\common'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -uses - {$IFDEF HAS_UNITSCOPE} - {$IFDEF HAS_UNIT_RTLCONSTS} - System.RTLConsts, - {$ENDIF HAS_UNIT_RTLCONSTS} - {$IFDEF MSWINDOWS} - Winapi.Windows, - {$ENDIF MSWINDOWS} - System.Math, - {$ELSE ~HAS_UNITSCOPE} - {$IFDEF HAS_UNIT_RTLCONSTS} - RTLConsts, - {$ENDIF HAS_UNIT_RTLCONSTS} - {$IFDEF MSWINDOWS} - Windows, - {$ENDIF MSWINDOWS} - Math, - {$ENDIF ~HAS_UNITSCOPE} - JclUnicode, - JclResources; - -procedure SwapWordByteOrder(P: PWideChar; Len: SizeInt); -begin - while Len > 0 do - begin - Dec(Len); - P^ := WideChar((Word(P^) shr 8) or (Word(P^) shl 8)); - Inc(P); - end; -end; - -//=== WideChar functions ===================================================== - -function CharToWideChar(Ch: AnsiChar): WideChar; -var - WS: WideString; -begin - WS := WideChar(Ch); - Result := WS[1]; -end; - -function WideCharToChar(Ch: WideChar): AnsiChar; -var - S: WideString; -begin - S := Ch; - Result := AnsiChar(S[1]); -end; - -//=== PWideChar functions ==================================================== - -procedure MoveWideChar(const Source; var Dest; Count: SizeInt); -begin - Move(Source, Dest, Count * SizeOf(WideChar)); -end; - -function StrAllocW(WideSize: SizeInt): PWideChar; -begin - WideSize := SizeOf(WideChar) * WideSize + SizeOf(SizeInt); - Result := AllocMem(WideSize); - SizeInt(Pointer(Result)^) := WideSize; - Inc(Result, SizeOf(SizeInt) div SizeOf(WideChar)); -end; - -function StrNewW(const Str: PWideChar): PWideChar; -// Duplicates the given string (if not nil) and returns the address of the new string. -var - Size: SizeInt; -begin - if Str = nil then - Result := nil - else - begin - Size := StrLenW(Str) + 1; - Result := StrMoveW(StrAllocW(Size), Str, Size); - end; -end; - -function StrNewW(const Str: WideString): PWideChar; -begin - Result := StrNewW(PWideChar(Str)); -end; - -procedure StrDisposeW(Str: PWideChar); -// releases a string allocated with StrNewW or StrAllocW -begin - if Str <> nil then - begin - Dec(Str, SizeOf(SizeInt) div SizeOf(WideChar)); - FreeMem(Str); - end; -end; - -procedure StrDisposeAndNilW(var Str: PWideChar); -var - Buff: PWideChar; -begin - Buff := Str; - Str := nil; - StrDisposeW(Buff); -end; - -const - // data used to bring UTF-16 coded strings into correct UTF-32 order for correct comparation - UTF16Fixup: array [0..31] of Word = ( - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - $2000, $F800, $F800, $F800, $F800 - ); - -function StrCompW(const Str1, Str2: PWideChar): SizeInt; -// Binary comparation of Str1 and Str2 with surrogate fix-up. -// Returns < 0 if Str1 is smaller in binary order than Str2, = 0 if both strings are -// equal and > 0 if Str1 is larger than Str2. -// -// This code is based on an idea of Markus W. Scherer (IBM). -// Note: The surrogate fix-up is necessary because some single value code points have -// larger values than surrogates which are in UTF-32 actually larger. -var - C1, C2: Word; - Run1, Run2: PWideChar; -begin - Run1 := Str1; - Run2 := Str2; - repeat - C1 := Word(Run1^); - C1 := Word(C1 or UTF16Fixup[C1 shr 11]); - C2 := Word(Run2^); - C2 := Word(C2 or UTF16Fixup[C2 shr 11]); - - // now C1 and C2 are in UTF-32-compatible order - Result := SizeInt(C1) - SizeInt(C2); - if(Result <> 0) or (C1 = 0) or (C2 = 0) then - Break; - Inc(Run1); - Inc(Run2); - until False; - - // If the strings have different lengths but the comparation returned equity so far - // then adjust the result so that the longer string is marked as the larger one. - if Result = 0 then - Result := (Run1 - Str1) - (Run2 - Str2); -end; - -function StrLCompW(const Str1, Str2: PWideChar; MaxLen: SizeInt): SizeInt; -// compares strings up to MaxLen code points -// see also StrCompW -var - S1, S2: PWideChar; - C1, C2: Word; -begin - if MaxLen > 0 then - begin - S1 := Str1; - S2 := Str2; - repeat - C1 := Word(S1^); - C1 := Word(C1 or UTF16Fixup[C1 shr 11]); - C2 := Word(S2^); - C2 := Word(C2 or UTF16Fixup[C2 shr 11]); - - // now C1 and C2 are in UTF-32-compatible order - { TODO : surrogates take up 2 words and are counted twice here, count them only once } - Result := SizeInt(C1) - SizeInt(C2); - Dec(MaxLen); - if(Result <> 0) or (C1 = 0) or (C2 = 0) or (MaxLen = 0) then - Break; - Inc(S1); - Inc(S2); - until False; - end - else - Result := 0; -end; - -function StrICompW(const Str1, Str2: PWideChar): SizeInt; -// Compares Str1 to Str2 without case sensitivity. -// See also comments in StrCompW, but keep in mind that case folding might result in -// one-to-many mappings which must be considered here. -{$IFDEF UNICODE_RTL_DATABASE} -begin - Result := AnsiStrIComp(Str1, Str2) -end; -{$ELSE ~UNICODE_RTL_DATABASE} -var - C1, C2: Word; - S1, S2: PWideChar; - Run1, Run2: PWideChar; - Folded1, Folded2: WideString; -begin - // Because of size changes of the string when doing case folding - // it is unavoidable to convert both strings completely in advance. - S1 := Str1; - S2 := Str2; - Folded1 := ''; - while S1^ <> #0 do - begin - Folded1 := Folded1 + WideCaseFolding(S1^); - Inc(S1); - end; - - Folded2 := ''; - while S2^ <> #0 do - begin - Folded2 := Folded2 + WideCaseFolding(S2^); - Inc(S2); - end; - - Run1 := PWideChar(Folded1); - Run2 := PWideChar(Folded2); - repeat - C1 := Word(Run1^); - C1 := Word(C1 or UTF16Fixup[C1 shr 11]); - C2 := Word(Run2^); - C2 := Word(C2 or UTF16Fixup[C2 shr 11]); - - // now C1 and C2 are in UTF-32-compatible order - Result := SizeInt(C1) - SizeInt(C2); - if(Result <> 0) or (C1 = 0) or (C2 = 0) then - Break; - Inc(Run1); - Inc(Run2); - until False; - - // If the strings have different lengths but the comparation returned equity so far - // then adjust the result so that the longer string is marked as the larger one. - if Result = 0 then - Result := (Run1 - PWideChar(Folded1)) - (Run2 - PWideChar(Folded2)); -end; -{$ENDIF ~UNICODE_RTL_DATABASE} - -function StrLICompW(const Str1, Str2: PWideChar; MaxLen: SizeInt): SizeInt; -// compares strings up to MaxLen code points -// see also StrICompW -{$IFDEF UNICODE_RTL_DATABASE} -begin - Result := AnsiStrIComp(Str1, Str2) -end; -{$ELSE UNICODE_RTL_DATABASE} -var - S1, S2: PWideChar; - C1, C2: Word; - Run1, Run2: PWideChar; - Folded1, Folded2: WideString; -begin - if MaxLen > 0 then - begin - // Because of size changes of the string when doing case folding - // it is unavoidable to convert both strings completely in advance. - S1 := Str1; - S2 := Str2; - Folded1 := ''; - while S1^ <> #0 do - begin - Folded1 := Folded1 + WideCaseFolding(S1^); - Inc(S1); - end; - - Folded2 := ''; - while S2^ <> #0 do - begin - Folded2 := Folded2 + WideCaseFolding(S2^); - Inc(S2); - end; - - Run1 := PWideChar(Folded1); - Run2 := PWideChar(Folded2); - - repeat - C1 := Word(Run1^); - C1 := Word(C1 or UTF16Fixup[C1 shr 11]); - C2 := Word(Run2^); - C2 := Word(C2 or UTF16Fixup[C2 shr 11]); - - // now C1 and C2 are in UTF-32-compatible order - { TODO : surrogates take up 2 words and are counted twice here, count them only once } - Result := SizeInt(C1) - SizeInt(C2); - Dec(MaxLen); - if(Result <> 0) or (C1 = 0) or (C2 = 0) or (MaxLen = 0) then - Break; - Inc(Run1); - Inc(Run2); - until False; - end - else - Result := 0; -end; -{$ENDIF UNICODE_RTL_DATABASE} - -function StrLICompW2(const Str1, Str2: PWideChar; MaxLen: SizeInt): SizeInt; -var - P1, P2: WideString; -begin - // faster than the JclUnicode.StrLICompW function - SetString(P1, Str1, Min(MaxLen, StrLenW(Str1))); - SetString(P2, Str2, Min(MaxLen, StrLenW(Str2))); - Result := WideCompareText(P1, P2); -end; - -function StrPosW(const Str, SubStr: PWideChar): PWideChar; -var - P: PWideChar; - I: SizeInt; -begin - Result := nil; - if (Str = nil) or (SubStr = nil) or (Str^ = #0) or (SubStr^ = #0) then - Exit; - Result := Str; - while Result^ <> #0 do - begin - if Result^ <> SubStr^ then - Inc(Result) - else - begin - P := Result + 1; - I := 1; - while (P^ <> #0) and (P^ = SubStr[I]) do - begin - Inc(I); - Inc(P); - end; - if SubStr[I] = #0 then - Exit - else - Inc(Result); - end; - end; - Result := nil; -end; - -function StrLenW(const Str: PWideChar): SizeInt; -begin - Result := 0; - if Str <> nil then - while Str[Result] <> #0 do - Inc(Result); -end; - -function StrScanW(const Str: PWideChar; Ch: WideChar): PWideChar; -begin - Result := Str; - if Result <> nil then - begin - while (Result^ <> #0) and (Result^ <> Ch) do - Inc(Result); - if (Result^ = #0) and (Ch <> #0) then - Result := nil; - end; -end; - -function StrEndW(const Str: PWideChar): PWideChar; -begin - Result := Str; - if Result <> nil then - while Result^ <> #0 do - Inc(Result); -end; - -function StrCopyW(Dest: PWideChar; const Source: PWideChar): PWideChar; -var - Src: PWideChar; -begin - Result := Dest; - if Dest <> nil then - begin - Src := Source; - if Src <> nil then - while Src^ <> #0 do - begin - Dest^ := Src^; - Inc(Src); - Inc(Dest); - end; - Dest^ := #0; - end; -end; - -function StrECopyW(Dest: PWideChar; const Source: PWideChar): PWideChar; -var - Src: PWideChar; -begin - if Dest <> nil then - begin - Src := Source; - if Src <> nil then - while Src^ <> #0 do - begin - Dest^ := Src^; - Inc(Src); - Inc(Dest); - end; - Dest^ := #0; - end; - Result := Dest; -end; - -function StrLCopyW(Dest: PWideChar; const Source: PWideChar; MaxLen: SizeInt): PWideChar; -var - Src: PWideChar; -begin - Result := Dest; - if (Dest <> nil) and (MaxLen > 0) then - begin - Src := Source; - if Src <> nil then - while (MaxLen > 0) and (Src^ <> #0) do - begin - Dest^ := Src^; - Inc(Src); - Inc(Dest); - Dec(MaxLen); - end; - Dest^ := #0; - end; -end; - -function StrCatW(Dest: PWideChar; const Source: PWideChar): PWideChar; -begin - Result := Dest; - StrCopyW(StrEndW(Dest), Source); -end; - -function StrLCatW(Dest: PWideChar; const Source: PWideChar; MaxLen: SizeInt): PWideChar; -begin - Result := Dest; - StrLCopyW(StrEndW(Dest), Source, MaxLen); -end; - -function StrMoveW(Dest: PWideChar; const Source: PWideChar; Count: SizeInt): PWideChar; -begin - Result := Dest; - if Count > 0 then - Move(Source^, Dest^, Count * SizeOf(WideChar)); -end; - -function StrPCopyWW(Dest: PWideChar; const Source: WideString): PWideChar; -begin - Result := StrLCopyW(Dest, PWideChar(Source), Length(Source)); -end; - -function StrPLCopyWW(Dest: PWideChar; const Source: WideString; MaxLen: SizeInt): PWideChar; -begin - Result := StrLCopyW(Dest, PWideChar(Source), MaxLen); -end; - -function StrRScanW(const Str: PWideChar; Chr: WideChar): PWideChar; -var - P: PWideChar; -begin - Result := nil; - if Str <> nil then - begin - P := Str; - repeat - if P^ = Chr then - Result := P; - Inc(P); - until P^ = #0; - end; -end; - -// (rom) following functions copied from JclUnicode.pas - -// exchanges in each character of the given string the low order and high order -// byte to go from LSB to MSB and vice versa. -// EAX/RAX contains address of string -// stop at the first #0 character - -procedure StrSwapByteOrder(Str: PWideChar); -asm - {$IFDEF CPU32} - // --> EAX Str - PUSH ESI - PUSH EDI - MOV ESI, EAX - MOV EDI, ESI - XOR EAX, EAX // clear high order byte to be able to use 32bit operand below -@@1: - LODSW - OR EAX, EAX - JZ @@2 - XCHG AL, AH - STOSW - JMP @@1 -@@2: - POP EDI - POP ESI - {$ENDIF CPU32} - {$IFDEF CPU64} - // --> RCX Str - XOR RAX, RAX // clear high order byte to be able to use 64bit operand below -@@1: - MOV AX, WORD PTR [RCX] - OR RAX, RAX - JZ @@2 - XCHG AL, AH - MOV WORD PTR [RCX], AX - ADD ECX, 2 - JMP @@1 -@@2: - {$ENDIF CPU64} -end; - -function StrNScanW(const Str1, Str2: PWideChar): SizeInt; -// Determines where (in Str1) the first time one of the characters of Str2 appear. -// The result is the length of a string part of Str1 where none of the characters of -// Str2 do appear (not counting the trailing #0 and starting with position 0 in Str1). -var - Run: PWideChar; -begin - Result := -1; - if (Str1 <> nil) and (Str2 <> nil) then - begin - Run := Str1; - while Run^ <> #0 do - begin - if StrScanW(Str2, Run^) <> nil then - Break; - Inc(Run); - end; - Result := Run - Str1; - end; -end; - -function StrRNScanW(const Str1, Str2: PWideChar): SizeInt; -// This function does the same as StrRNScanW but uses Str1 in reverse order. This -// means Str1 points to the last character of a string, is traversed reversely -// and terminates with a starting #0. This is useful for parsing strings stored -// in reversed macro buffers etc. -var - Run: PWideChar; -begin - Result := -1; - if (Str1 <> nil) and (Str2 <> nil) then - begin - Run := Str1; - while Run^ <> #0 do - begin - if StrScanW(Str2, Run^) <> nil then - Break; - Dec(Run); - end; - Result := Str1 - Run; - end; -end; - -// Returns a pointer to first occurrence of a specified character in a string -// or nil if not found. -// Note: this is just a binary search for the specified character and there's no -// check for a terminating null. Instead at most StrLen characters are -// searched. This makes this function extremly fast. -// -function StrScanW(Str: PWideChar; Chr: WideChar; StrLen: SizeInt): PWideChar; -begin - Result := Str; - while StrLen > 0 do - begin - if Result^ = Chr then - Exit; - Inc(Result); - Dec(StrLen); - end; - Result := nil; -end; - -function StrBufSizeW(const Str: PWideChar): SizeInt; -// Returns max number of wide characters that can be stored in a buffer -// allocated by StrAllocW. -var - P: PWideChar; -begin - if Str <> nil then - begin - P := Str; - Dec(P, SizeOf(SizeInt) div SizeOf(WideChar)); - Result := (PSizeInt(P)^ - SizeOf(SizeInt)) div SizeOf(WideChar); - end - else - Result := 0; -end; - -function StrPCopyW(Dest: PWideChar; const Source: AnsiString): PWideChar; -// copies a Pascal-style string to a null-terminated wide string -begin - Result := StrPLCopyW(Dest, Source, SizeInt(Length(Source))); - Result[Length(Source)] := WideNull; -end; - -function StrPLCopyW(Dest: PWideChar; const Source: AnsiString; MaxLen: SizeInt): PWideChar; -// copies characters from a Pascal-style string into a null-terminated wide string -var - P: PAnsiChar; -begin - P := PAnsiChar(Pointer(Source)); - while MaxLen > 0 do - begin - Dest^ := WideChar(Ord(P^)); - Inc(P); - Inc(Dest); - Dec(MaxLen); - end; - Result := Dest; -end; - -//=== WideString functions =================================================== - -function WidePos(const SubStr, S: WideString): SizeInt; -var - P: PWideChar; -begin - P := StrPosW(PWideChar(S), PWideChar(SubStr)); - if P <> nil then - Result := P - PWideChar(S) + 1 - else - Result := 0; -end; - -// original code by Mike Lischke (extracted from JclUnicode.pas) - -function WideQuotedStr(const S: WideString; Quote: WideChar): WideString; -var - P, Src, - Dest: PWideChar; - AddCount: SizeInt; -begin - AddCount := 0; - P := StrScanW(PWideChar(S), Quote); - while P <> nil do - begin - Inc(P); - Inc(AddCount); - P := StrScanW(P, Quote); - end; - - if AddCount = 0 then - Result := Quote + S + Quote - else - begin - SetLength(Result, Length(S) + AddCount + 2); - Dest := PWideChar(Result); - Dest^ := Quote; - Inc(Dest); - Src := PWideChar(S); - P := StrScanW(Src, Quote); - repeat - Inc(P); - MoveWideChar(Src^, Dest^, P - Src); - Inc(Dest, P - Src); - Dest^ := Quote; - Inc(Dest); - Src := P; - P := StrScanW(Src, Quote); - until P = nil; - P := StrEndW(Src); - MoveWideChar(Src^, Dest^, P - Src); - Inc(Dest, P - Src); - Dest^ := Quote; - end; -end; - -// original code by Mike Lischke (extracted from JclUnicode.pas) - -function WideExtractQuotedStr(var Src: PWideChar; Quote: WideChar): WideString; -var - P, Dest: PWideChar; - DropCount: SizeInt; -begin - Result := ''; - if (Src = nil) or (Src^ <> Quote) then - Exit; - - Inc(Src); - DropCount := 1; - P := Src; - Src := StrScanW(Src, Quote); - while Src <> nil do // count adjacent pairs of quote chars - begin - Inc(Src); - if Src^ <> Quote then - Break; - Inc(Src); - Inc(DropCount); - Src := StrScanW(Src, Quote); - end; - - if Src = nil then - Src := StrEndW(P); - if (Src - P) <= 1 then - Exit; - - if DropCount = 1 then - SetString(Result, P, Src - P - 1) - else - begin - SetLength(Result, Src - P - DropCount); - Dest := PWideChar(Result); - Src := StrScanW(P, Quote); - while Src <> nil do - begin - Inc(Src); - if Src^ <> Quote then - Break; - MoveWideChar(P^, Dest^, Src - P); - Inc(Dest, Src - P); - Inc(Src); - P := Src; - Src := StrScanW(Src, Quote); - end; - if Src = nil then - Src := StrEndW(P); - MoveWideChar(P^, Dest^, Src - P - 1); - end; -end; - - -function TrimW(const S: WideString): WideString; -// available from Delphi 7 up -{$IFDEF RTL150_UP} -begin - Result := Trim(S); -end; -{$ELSE ~RTL150_UP} -var - I, L: SizeInt; -begin - L := Length(S); - I := 1; - while (I <= L) and (S[I] <= ' ') do - Inc(I); - if I > L then - Result := '' - else - begin - while S[L] <= ' ' do - Dec(L); - Result := Copy(S, I, L - I + 1); - end; -end; -{$ENDIF ~RTL150_UP} - -function TrimLeftW(const S: WideString): WideString; -// available from Delphi 7 up -{$IFDEF RTL150_UP} -begin - Result := TrimLeft(S); -end; -{$ELSE ~RTL150_UP} -var - I, L: SizeInt; -begin - L := Length(S); - I := 1; - while (I <= L) and (S[I] <= ' ') do - Inc(I); - Result := Copy(S, I, Maxint); -end; -{$ENDIF ~RTL150_UP} - -function TrimRightW(const S: WideString): WideString; -// available from Delphi 7 up -{$IFDEF RTL150_UP} -begin - Result := TrimRight(S); -end; -{$ELSE ~RTL150_UP} -var - I: SizeInt; -begin - I := Length(S); - while (I > 0) and (S[I] <= ' ') do - Dec(I); - Result := Copy(S, 1, I); -end; -{$ENDIF ~RTL150_UP} - -function WideReverse(const AText: Widestring): Widestring; -begin - Result := AText; - WideReverseInPlace(Result); -end; - -procedure WideReverseInPlace(var S: WideString); -var - P1, P2: PWideChar; - C: WideChar; -begin - UniqueString(S); - P1 := PWideChar(S); - P2 := PWideChar(S) + Length(S) - 1; - while P1 < P2 do - begin - C := P1^; - P1^ := P2^; - P2^ := C; - Inc(P1); - Dec(P2); - end; -end; - -function WideCompareText(const S1, S2: WideString): SizeInt; -begin - {$IFDEF MSWINDOWS} - if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then - Result := AnsiCompareText(string(S1), string(S2)) - else - Result := CompareStringW(LOCALE_USER_DEFAULT, NORM_IGNORECASE, - PWideChar(S1), Length(S1), PWideChar(S2), Length(S2)) - 2; - {$ELSE ~MSWINDOWS} - { TODO : Don't cheat here } - Result := CompareText(S1, S2); - {$ENDIF MSWINDOWS} -end; - -function WideCompareStr(const S1, S2: WideString): SizeInt; -begin - {$IFDEF MSWINDOWS} - if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then - Result := AnsiCompareStr(string(S1), string(S2)) - else - Result := CompareStringW(LOCALE_USER_DEFAULT, 0, - PWideChar(S1), Length(S1), PWideChar(S2), Length(S2)) - 2; - {$ELSE ~MSWINDOWS} - {$IFDEF FPC} - Result := SysUtils.WideCompareStr(S1, S2); - {$ELSE ~FPC} - { TODO : Don't cheat here } - Result := CompareString(S1, S2); - {$ENDIF ~FPC} - {$ENDIF ~MSWINDOWS} -end; - -function WideUpperCase(const S: WideString): WideString; -begin - Result := S; - if Result <> '' then - {$IFDEF MSWINDOWS} - CharUpperBuffW(Pointer(Result), Length(Result)); - {$ELSE ~MSWINDOWS} - { TODO : Don't cheat here } - Result := UpperCase(Result); - {$ENDIF ~MSWINDOWS} -end; - -function WideLowerCase(const S: WideString): WideString; -begin - Result := S; - if Result <> '' then - {$IFDEF MSWINDOWS} - CharLowerBuffW(Pointer(Result), Length(Result)); - {$ELSE ~MSWINDOWS} - { TODO : Don't cheat here } - Result := LowerCase(Result); - {$ENDIF ~MSWINDOWS} -end; - -function TrimLeftLengthW(const S: WideString): SizeInt; -var - Len: SizeInt; -begin - Len := Length(S); - Result := 1; - while (Result <= Len) and (S[Result] <= #32) do - Inc(Result); - Result := Len - Result + 1; -end; - -function TrimRightLengthW(const S: WideString): SizeInt; -begin - Result := Length(S); - while (Result > 0) and (S[Result] <= #32) do - Dec(Result); -end; - -{$IFNDEF FPC} - -function WideStartsText(const SubStr, S: WideString): Boolean; -var - Len: SizeInt; -begin - Len := Length(SubStr); - Result := (Len <= Length(S)) and (StrLICompW(PWideChar(SubStr), PWideChar(S), Len) = 0); -end; - -function WideStartsStr(const SubStr, S: WideString): Boolean; -var - Len: SizeInt; -begin - Len := Length(SubStr); - Result := (Len <= Length(S)) and (StrLCompW(PWideChar(SubStr), PWideChar(S), Len) = 0); -end; - -{$ENDIF ~FPC} - -{$IFNDEF SUPPORTS_UNICODE} -//=== { TJclWideStrings } ========================================================== - -constructor TJclWideStrings.Create; -begin - inherited Create; - // FLineSeparator := WideChar($2028); - {$IFDEF MSWINDOWS} - FLineSeparator := WideChar(13) + '' + WideChar(10); // compiler wants it this way - {$ENDIF MSWINDOWS} - {$IFDEF UNIX} - FLineSeparator := WideChar(10); - {$ENDIF UNIX} - FNameValueSeparator := '='; - FDelimiter := ','; - FQuoteChar := '"'; -end; - -function TJclWideStrings.Add(const S: WideString): Integer; -begin - Result := AddObject(S, nil); -end; - -function TJclWideStrings.AddObject(const S: WideString; AObject: TObject): Integer; -begin - Result := Count; - InsertObject(Result, S, AObject); -end; - -procedure TJclWideStrings.AddStrings(Strings: TJclWideStrings); -var - I: Integer; -begin - for I := 0 to Strings.Count - 1 do - AddObject(Strings.GetP(I)^, Strings.Objects[I]); -end; - -procedure TJclWideStrings.AddStrings(Strings: TStrings); -var - I: Integer; -begin - for I := 0 to Strings.Count - 1 do - AddObject(Strings.Strings[I], Strings.Objects[I]); -end; - -procedure TJclWideStrings.AddStringsTo(Dest: TStrings); -var - I: Integer; -begin - for I := 0 to Count - 1 do - Dest.AddObject(GetP(I)^, Objects[I]); -end; - -procedure TJclWideStrings.Append(const S: WideString); -begin - Add(S); -end; - -procedure TJclWideStrings.Assign(Source: TPersistent); -begin - if Source is TJclWideStrings then - begin - BeginUpdate; - try - Clear; - FDelimiter := TJclWideStrings(Source).FDelimiter; - FNameValueSeparator := TJclWideStrings(Source).FNameValueSeparator; - FQuoteChar := TJclWideStrings(Source).FQuoteChar; - AddStrings(TJclWideStrings(Source)); - finally - EndUpdate; - end; - end - else - if Source is TStrings then - begin - BeginUpdate; - try - Clear; - {$IFDEF RTL190_UP} - FNameValueSeparator := TStrings(Source).NameValueSeparator; - FQuoteChar := TStrings(Source).QuoteChar; - FDelimiter := TStrings(Source).Delimiter; - {$ELSE ~RTL190_UP} - {$IFDEF RTL150_UP} - FNameValueSeparator := CharToWideChar(TStrings(Source).NameValueSeparator); - {$ENDIF RTL150_UP} - FQuoteChar := CharToWideChar(TStrings(Source).QuoteChar); - FDelimiter := CharToWideChar(TStrings(Source).Delimiter); - {$ENDIF ~RTL190_UP} - AddStrings(TStrings(Source)); - finally - EndUpdate; - end; - end - else - inherited Assign(Source); -end; - -procedure TJclWideStrings.AssignTo(Dest: TPersistent); -var - I: Integer; -begin - if Dest is TStrings then - begin - TStrings(Dest).BeginUpdate; - try - TStrings(Dest).Clear; - {$IFDEF RTL190_UP} - TStrings(Dest).NameValueSeparator := NameValueSeparator; - TStrings(Dest).QuoteChar := QuoteChar; - TStrings(Dest).Delimiter := Delimiter; - {$ELSE ~RTL190_UP} - {$IFDEF RTL150_UP} - TStrings(Dest).NameValueSeparator := WideCharToChar(NameValueSeparator); - {$ENDIF RTL150_UP} - TStrings(Dest).QuoteChar := WideCharToChar(QuoteChar); - TStrings(Dest).Delimiter := WideCharToChar(Delimiter); - {$ENDIF ~RTL190_UP} - for I := 0 to Count - 1 do - TStrings(Dest).AddObject(GetP(I)^, Objects[I]); - finally - TStrings(Dest).EndUpdate; - end; - end - else - inherited AssignTo(Dest); -end; - -procedure TJclWideStrings.BeginUpdate; -begin - if FUpdateCount = 0 then - SetUpdateState(True); - Inc(FUpdateCount); -end; - -function TJclWideStrings.CompareStrings(const S1, S2: WideString): Integer; -begin - Result := WideCompareText(S1, S2); -end; - -function TJclWideStrings.CreateAnsiStringList: TStrings; -var - I: Integer; -begin - Result := TStringList.Create; - try - Result.BeginUpdate; - for I := 0 to Count - 1 do - Result.AddObject(GetP(I)^, Objects[I]); - Result.EndUpdate; - except - Result.Free; - raise; - end; -end; - -procedure TJclWideStrings.DefineProperties(Filer: TFiler); - - function DoWrite: Boolean; - begin - if Filer.Ancestor <> nil then - begin - Result := True; - if Filer.Ancestor is TJclWideStrings then - Result := not Equals(TJclWideStrings(Filer.Ancestor)) - end - else - Result := Count > 0; - end; - -begin - Filer.DefineProperty('Strings', ReadData, WriteData, DoWrite); -end; - -procedure TJclWideStrings.EndUpdate; -begin - Dec(FUpdateCount); - if FUpdateCount = 0 then - SetUpdateState(False); -end; - -function TJclWideStrings.Equals(Strings: TStrings): Boolean; -var - I: Integer; -begin - Result := False; - if Strings.Count = Count then - begin - for I := 0 to Count - 1 do - if Strings[I] <> PStrings[I]^ then - Exit; - Result := True; - end; -end; - -function TJclWideStrings.Equals(Strings: TJclWideStrings): Boolean; -var - I: Integer; -begin - Result := False; - if Strings.Count = Count then - begin - for I := 0 to Count - 1 do - if Strings[I] <> PStrings[I]^ then - Exit; - Result := True; - end; -end; - -procedure TJclWideStrings.Exchange(Index1, Index2: Integer); -var - TempObject: TObject; - TempString: WideString; -begin - BeginUpdate; - try - TempString := PStrings[Index1]^; - TempObject := Objects[Index1]; - PStrings[Index1]^ := PStrings[Index2]^; - Objects[Index1] := Objects[Index2]; - PStrings[Index2]^ := TempString; - Objects[Index2] := TempObject; - finally - EndUpdate; - end; -end; - -function TJclWideStrings.ExtractName(const S: WideString): WideString; -var - Index: Integer; -begin - Result := S; - Index := WidePos(NameValueSeparator, Result); - if Index <> 0 then - SetLength(Result, Index - 1) - else - SetLength(Result, 0); -end; - -function TJclWideStrings.Get(Index: Integer): WideString; -begin - Result := GetP(Index)^; -end; - -function TJclWideStrings.GetCapacity: Integer; -begin - Result := Count; -end; - -function TJclWideStrings.GetCommaText: WideString; -begin - Result := GetDelimitedTextEx(',', '"'); -end; - -function TJclWideStrings.GetDelimitedText: WideString; -begin - Result := GetDelimitedTextEx(FDelimiter, FQuoteChar); -end; - -function TJclWideStrings.GetDelimitedTextEx(ADelimiter, AQuoteChar: WideChar): WideString; -var - S: WideString; - P: PWideChar; - I, Num: Integer; -begin - Num := GetCount; - if (Num = 1) and (GetP(0)^ = '') then - Result := AQuoteChar + '' + AQuoteChar // Compiler wants it this way - else - begin - Result := ''; - for I := 0 to Count - 1 do - begin - S := GetP(I)^; - P := PWideChar(S); - while True do - begin - case P[0] of - WideChar(0)..WideChar(32): - Inc(P); - else - if (P[0] = AQuoteChar) or (P[0] = ADelimiter) then - Inc(P) - else - Break; - end; - end; - if P[0] <> WideChar(0) then - S := WideQuotedStr(S, AQuoteChar); - Result := Result + S + ADelimiter; - end; - System.Delete(Result, Length(Result), 1); - end; -end; - -function TJclWideStrings.GetName(Index: Integer): WideString; -var - I: Integer; -begin - Result := GetP(Index)^; - I := WidePos(FNameValueSeparator, Result); - if I > 0 then - SetLength(Result, I - 1); -end; - -function TJclWideStrings.GetObject(Index: Integer): TObject; -begin - Result := nil; -end; - -function TJclWideStrings.GetText: PWideChar; -begin - Result := StrNewW(GetTextStr); -end; - -function TJclWideStrings.GetTextStr: WideString; -var - I: Integer; - Len, LL: Integer; - P: PWideChar; - W: PWideString; -begin - Len := 0; - LL := Length(LineSeparator); - for I := 0 to Count - 1 do - Inc(Len, Length(GetP(I)^) + LL); - SetLength(Result, Len); - P := PWideChar(Result); - for I := 0 to Count - 1 do - begin - W := GetP(I); - Len := Length(W^); - if Len > 0 then - begin - MoveWideChar(W^[1], P[0], Len); - Inc(P, Len); - end; - if LL > 0 then - begin - MoveWideChar(FLineSeparator[1], P[0], LL); - Inc(P, LL); - end; - end; -end; - -function TJclWideStrings.GetValue(const Name: WideString): WideString; -var - Idx: Integer; -begin - Idx := IndexOfName(Name); - if Idx >= 0 then - Result := GetValueFromIndex(Idx) - else - Result := ''; -end; - -function TJclWideStrings.GetValueFromIndex(Index: Integer): WideString; -var - I: Integer; -begin - Result := GetP(Index)^; - I := WidePos(FNameValueSeparator, Result); - if I > 0 then - System.Delete(Result, 1, I) - else - Result := ''; -end; - -function TJclWideStrings.IndexOf(const S: WideString): Integer; -begin - for Result := 0 to Count - 1 do - if CompareStrings(GetP(Result)^, S) = 0 then - Exit; - Result := -1; -end; - -function TJclWideStrings.IndexOfName(const Name: WideString): Integer; -begin - for Result := 0 to Count - 1 do - if CompareStrings(Names[Result], Name) = 0 then - Exit; - Result := -1; -end; - -function TJclWideStrings.IndexOfObject(AObject: TObject): Integer; -begin - for Result := 0 to Count - 1 do - if Objects[Result] = AObject then - Exit; - Result := -1; -end; - -procedure TJclWideStrings.Insert(Index: Integer; const S: WideString); -begin - InsertObject(Index, S, nil); -end; - -procedure TJclWideStrings.InsertObject(Index: Integer; const S: WideString; AObject: TObject); -begin -end; - -procedure TJclWideStrings.LoadFromFile(const FileName: TFileName; - WideFileOptions: TWideFileOptions = []); -var - Stream: TFileStream; -begin - Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); - try - LoadFromStream(Stream, WideFileOptions); - finally - Stream.Free; - end; -end; - -procedure TJclWideStrings.LoadFromStream(Stream: TStream; - WideFileOptions: TWideFileOptions = []); -var - AnsiS: AnsiString; - WideS: WideString; - WC: WideChar; -begin - BeginUpdate; - try - Clear; - WC := #0; - Stream.Read(WC, SizeOf(WC)); - if (foAnsiFile in WideFileOptions) and (Hi(Word(WC)) <> 0) and (WC <> BOM_LSB_FIRST) and (WC <> BOM_MSB_FIRST) then - begin - Stream.Seek(-SizeOf(WC), soFromCurrent); - SetLength(AnsiS, (Stream.Size - Stream.Position) div SizeOf(AnsiChar)); - Stream.Read(AnsiS[1], Length(AnsiS) * SizeOf(AnsiChar)); - SetTextStr(WideString(AnsiS)); // explicit Unicode conversion - end - else - begin - if (WC <> BOM_LSB_FIRST) and (WC <> BOM_MSB_FIRST) then - Stream.Seek(-SizeOf(WC), soFromCurrent); - SetLength(WideS, (Stream.Size - Stream.Position + 1) div SizeOf(WideChar)); - Stream.Read(WideS[1], Length(WideS) * SizeOf(WideChar)); - if WC = BOM_MSB_FIRST then - SwapWordByteOrder(PWideChar(WideS), Length(WideS)); - SetTextStr(WideS); - end; - finally - EndUpdate; - end; -end; - -procedure TJclWideStrings.Move(CurIndex, NewIndex: Integer); -var - TempObject: TObject; - TempString: WideString; -begin - if CurIndex <> NewIndex then - begin - BeginUpdate; - try - TempString := GetP(CurIndex)^; - TempObject := GetObject(CurIndex); - Delete(CurIndex); - InsertObject(NewIndex, TempString, TempObject); - finally - EndUpdate; - end; - end; -end; - -procedure TJclWideStrings.ReadData(Reader: TReader); -begin - BeginUpdate; - try - Clear; - Reader.ReadListBegin; - while not Reader.EndOfList do - if Reader.NextValue in [vaLString, vaString] then - Add(Reader.ReadString) - else - Add(Reader.ReadWideString); - Reader.ReadListEnd; - finally - EndUpdate; - end; -end; - -procedure TJclWideStrings.SaveToFile(const FileName: TFileName; WideFileOptions: TWideFileOptions = []); -var - Stream: TFileStream; -begin - Stream := TFileStream.Create(FileName, fmCreate); - try - SaveToStream(Stream, WideFileOptions); - finally - Stream.Free; - end; -end; - -procedure TJclWideStrings.SaveToStream(Stream: TStream; WideFileOptions: TWideFileOptions = []); -var - AnsiS: AnsiString; - WideS: WideString; - WC: WideChar; -begin - if foAnsiFile in WideFileOptions then - begin - AnsiS := AnsiString(GetTextStr); // explicit Unicode conversion - Stream.Write(AnsiS[1], Length(AnsiS) * SizeOf(AnsiChar)); - end - else - begin - if foUnicodeLB in WideFileOptions then - begin - WC := BOM_LSB_FIRST; - Stream.Write(WC, SizeOf(WC)); - end; - WideS := GetTextStr; - Stream.Write(WideS[1], Length(WideS) * SizeOf(WideChar)); - end; -end; - -procedure TJclWideStrings.SetCapacity(NewCapacity: Integer); -begin -end; - -procedure TJclWideStrings.SetCommaText(const Value: WideString); -begin - SetDelimitedTextEx(',', '"', Value); -end; - -procedure TJclWideStrings.SetDelimitedText(const Value: WideString); -begin - SetDelimitedTextEx(Delimiter, QuoteChar, Value); -end; - -procedure TJclWideStrings.SetDelimitedTextEx(ADelimiter, AQuoteChar: WideChar; - const Value: WideString); -var - P, P1: PWideChar; - S: WideString; - - procedure IgnoreWhiteSpace(var P: PWideChar); - begin - while True do - case P^ of - WideChar(1)..WideChar(32): - Inc(P); - else - Break; - end; - end; - -begin - BeginUpdate; - try - Clear; - P := PWideChar(Value); - IgnoreWhiteSpace(P); - while P[0] <> WideChar(0) do - begin - if P[0] = AQuoteChar then - S := WideExtractQuotedStr(P, AQuoteChar) - else - begin - P1 := P; - while (P[0] > WideChar(32)) and (P[0] <> ADelimiter) do - Inc(P); - SetString(S, P1, P - P1); - end; - Add(S); - - IgnoreWhiteSpace(P); - if P[0] = ADelimiter then - begin - Inc(P); - IgnoreWhiteSpace(P); - end; - end; - finally - EndUpdate; - end; -end; - -procedure TJclWideStrings.SetText(Text: PWideChar); -begin - SetTextStr(Text); -end; - -procedure TJclWideStrings.SetTextStr(const Value: WideString); -var - P, Start: PWideChar; - S: WideString; - Len: Integer; -begin - BeginUpdate; - try - Clear; - if Value <> '' then - begin - P := PWideChar(Value); - if P <> nil then - begin - while P[0] <> WideChar(0) do - begin - Start := P; - while True do - begin - case P[0] of - WideChar(0), WideChar(10), WideChar(13): - Break; - end; - Inc(P); - end; - Len := P - Start; - if Len > 0 then - begin - SetString(S, Start, Len); - AddObject(S, nil); // consumes most time - end - else - AddObject('', nil); - if P[0] = WideChar(13) then - Inc(P); - if P[0] = WideChar(10) then - Inc(P); - end; - end; - end; - finally - EndUpdate; - end; -end; - -procedure TJclWideStrings.SetUpdateState(Updating: Boolean); -begin -end; - -procedure TJclWideStrings.SetValue(const Name, Value: WideString); -var - Idx: Integer; -begin - Idx := IndexOfName(Name); - if Idx >= 0 then - SetValueFromIndex(Idx, Value) - else - if Value <> '' then - Add(Name + NameValueSeparator + Value); -end; - -procedure TJclWideStrings.SetValueFromIndex(Index: Integer; const Value: WideString); -var - S: WideString; - I: Integer; -begin - if Value = '' then - Delete(Index) - else - begin - if Index < 0 then - Index := Add(''); - S := GetP(Index)^; - I := WidePos(NameValueSeparator, S); - if I > 0 then - System.Delete(S, I, MaxInt); - S := S + NameValueSeparator + Value; - Put(Index, S); - end; -end; - -procedure TJclWideStrings.WriteData(Writer: TWriter); -var - I: Integer; -begin - Writer.WriteListBegin; - for I := 0 to Count - 1 do - Writer.WriteWideString(GetP(I)^); - Writer.WriteListEnd; -end; - -//=== { TJclWideStringList } ======================================================= - -constructor TJclWideStringList.Create; -begin - inherited Create; - FList := TList.Create; -end; - -destructor TJclWideStringList.Destroy; -begin - FOnChange := nil; - FOnChanging := nil; - Inc(FUpdateCount); // do not call unnecessary functions - Clear; - FList.Free; - inherited Destroy; -end; - -function TJclWideStringList.AddObject(const S: WideString; AObject: TObject): Integer; -begin - if not Sorted then - Result := Count - else - if Find(S, Result) then - case Duplicates of - dupIgnore: - Exit; - dupError: - raise EListError.CreateRes(@SDuplicateString); - end; - InsertObject(Result, S, AObject); -end; - -procedure TJclWideStringList.Changed; -begin - if Assigned(FOnChange) then - FOnChange(Self); -end; - -procedure TJclWideStringList.Changing; -begin - if Assigned(FOnChanging) then - FOnChanging(Self); -end; - -procedure TJclWideStringList.Clear; -var - I: Integer; - Item: PWStringItem; -begin - if FUpdateCount = 0 then - Changing; - for I := 0 to Count - 1 do - begin - Item := PWStringItem(FList[I]); - Item.FString := ''; - FreeMem(Item); - end; - FList.Clear; - if FUpdateCount = 0 then - Changed; -end; - -function TJclWideStringList.CompareStrings(const S1, S2: WideString): Integer; -begin - if CaseSensitive then - Result := WideCompareStr(S1, S2) - else - Result := WideCompareText(S1, S2); -end; - -threadvar - CustomSortList: TJclWideStringList; - CustomSortCompare: TJclWideStringListSortCompare; - -function WStringListCustomSort(Item1, Item2: Pointer): Integer; -begin - Result := CustomSortCompare(CustomSortList, - CustomSortList.FList.IndexOf(Item1), - CustomSortList.FList.IndexOf(Item2)); -end; - -procedure TJclWideStringList.CustomSort(Compare: TJclWideStringListSortCompare); -var - TempList: TJclWideStringList; - TempCompare: TJclWideStringListSortCompare; -begin - TempList := CustomSortList; - TempCompare := CustomSortCompare; - CustomSortList := Self; - CustomSortCompare := Compare; - try - Changing; - FList.Sort(WStringListCustomSort); - Changed; - finally - CustomSortList := TempList; - CustomSortCompare := TempCompare; - end; -end; - -procedure TJclWideStringList.Delete(Index: Integer); -var - Item: PWStringItem; -begin - if FUpdateCount = 0 then - Changing; - Item := PWStringItem(FList[Index]); - FList.Delete(Index); - Item.FString := ''; - FreeMem(Item); - if FUpdateCount = 0 then - Changed; -end; - -procedure TJclWideStringList.Exchange(Index1, Index2: Integer); -begin - if FUpdateCount = 0 then - Changing; - FList.Exchange(Index1, Index2); - if FUpdateCount = 0 then - Changed; -end; - -function TJclWideStringList.Find(const S: WideString; var Index: Integer): Boolean; -var - L, H, I, C: Integer; -begin - Result := False; - if Sorted then - begin - L := 0; - H := Count - 1; - while L <= H do - begin - I := (L + H) shr 1; - C := CompareStrings(GetItem(I).FString, S); - if C < 0 then - L := I + 1 - else - begin - H := I - 1; - if C = 0 then - begin - Result := True; - if Duplicates <> dupAccept then - L := I; - end; - end; - end; - Index := L; - end - else - begin - Index := IndexOf(S); - Result := Index <> -1; - end; -end; - -function TJclWideStringList.GetCapacity: Integer; -begin - Result := FList.Capacity; -end; - -function TJclWideStringList.GetCount: Integer; -begin - Result := FList.Count; -end; - -function TJclWideStringList.GetItem(Index: Integer): PWStringItem; -begin - Result := FList[Index]; -end; - -function TJclWideStringList.GetObject(Index: Integer): TObject; -begin - Result := GetItem(Index).FObject; -end; - -function TJclWideStringList.GetP(Index: Integer): PWideString; -begin - Result := Addr(GetItem(Index).FString); -end; - -function TJclWideStringList.IndexOf(const S: WideString): Integer; -begin - if Sorted then - begin - Result := -1; - if not Find(S, Result) then - Result := -1; - end - else - begin - for Result := 0 to Count - 1 do - if CompareStrings(GetItem(Result).FString, S) = 0 then - Exit; - Result := -1; - end; -end; - -procedure TJclWideStringList.InsertObject(Index: Integer; const S: WideString; - AObject: TObject); -var - P: PWStringItem; -begin - if FUpdateCount = 0 then - Changing; - FList.Insert(Index, nil); // error check - P := AllocMem(SizeOf(TWStringItem)); - FList[Index] := P; - - Put(Index, S); - if AObject <> nil then - PutObject(Index, AObject); - if FUpdateCount = 0 then - Changed; -end; - -procedure TJclWideStringList.Put(Index: Integer; const Value: WideString); -begin - if FUpdateCount = 0 then - Changing; - GetItem(Index).FString := Value; - if FUpdateCount = 0 then - Changed; -end; - -procedure TJclWideStringList.PutObject(Index: Integer; AObject: TObject); -begin - if FUpdateCount = 0 then - Changing; - GetItem(Index).FObject := AObject; - if FUpdateCount = 0 then - Changed; -end; - -procedure TJclWideStringList.SetCapacity(NewCapacity: Integer); -begin - FList.Capacity := NewCapacity; -end; - -procedure TJclWideStringList.SetCaseSensitive(const Value: Boolean); -begin - if Value <> FCaseSensitive then - begin - FCaseSensitive := Value; - if Sorted then - begin - Sorted := False; - Sorted := True; // re-sort - end; - end; -end; - -procedure TJclWideStringList.SetSorted(Value: Boolean); -begin - if Value <> FSorted then - begin - FSorted := Value; - if FSorted then - begin - FSorted := False; - Sort; - FSorted := True; - end; - end; -end; - -procedure TJclWideStringList.SetUpdateState(Updating: Boolean); -begin - if Updating then - Changing - else - Changed; -end; - -function DefaultSort(List: TJclWideStringList; Index1, Index2: Integer): Integer; -begin - Result := List.CompareStrings(List.GetItem(Index1).FString, List.GetItem(Index2).FString); -end; - -procedure TJclWideStringList.Sort; -begin - if not Sorted then - CustomSort(DefaultSort); -end; - -{$ENDIF ~SUPPORTS_UNICODE} - -function StringsToMultiSz(var Dest: PWideMultiSz; const Source: TJclWideStrings): PWideMultiSz; -var - I, TotalLength: Integer; - P: PWideMultiSz; -begin - Assert(Source <> nil); - TotalLength := 1; - for I := 0 to Source.Count - 1 do - if Source[I] = '' then - raise EJclWideStringError.CreateRes(@RsInvalidEmptyStringItem) - else - Inc(TotalLength, StrLenW(PWideChar(Source[I])) + 1); - AllocateMultiSz(Dest, TotalLength); - P := Dest; - for I := 0 to Source.Count - 1 do - begin - P := StrECopyW(P, PWideChar(Source[I])); - Inc(P); - end; - P^:= #0; - Result := Dest; -end; - -procedure MultiSzToStrings(const Dest: TJclWideStrings; const Source: PWideMultiSz); -var - P: PWideMultiSz; -begin - Assert(Dest <> nil); - Dest.BeginUpdate; - try - Dest.Clear; - if Source <> nil then - begin - P := Source; - while P^ <> #0 do - begin - Dest.Add(P); - P := StrEndW(P); - Inc(P); - end; - end; - finally - Dest.EndUpdate; - end; -end; - -function MultiSzLength(const Source: PWideMultiSz): SizeInt; -var - P: PWideMultiSz; -begin - Result := 0; - if Source <> nil then - begin - P := Source; - repeat - Inc(Result, StrLenW(P) + 1); - P := StrEndW(P); - Inc(P); - until P^ = #0; - Inc(Result); - end; -end; - -procedure AllocateMultiSz(var Dest: PWideMultiSz; Len: SizeInt); -begin - if Len > 0 then - GetMem(Dest, Len * SizeOf(WideChar)) - else - Dest := nil; -end; - -procedure FreeMultiSz(var Dest: PWideMultiSz); -begin - if Dest <> nil then - FreeMem(Dest); - Dest := nil; -end; - -function MultiSzDup(const Source: PWideMultiSz): PWideMultiSz; -var - Len: Integer; -begin - if Source <> nil then - begin - Len := MultiSzLength(Source); - Result := nil; - AllocateMultiSz(Result, Len); - Move(Source^, Result^, Len * SizeOf(WideChar)); - end - else - Result := nil; -end; - -{$IFDEF UNITVERSIONING} -initialization - RegisterUnitVersion(HInstance, UnitVersioning); - -finalization - UnregisterUnitVersion(HInstance); -{$ENDIF UNITVERSIONING} - -end. +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is WStrUtils.PAS, released on 2004-01-25. } +{ } +{ The Initial Developers of the Original Code are: } +{ - Andreas Hausladen } +{ - Mike Lischke (WideQuotedStr & WideExtractQuotedStr from Unicode.pas) } +{ Portions created by Andreas Hausladen are Copyright (C) of Andreas Hausladen. } +{ All rights reserved. } +{ Portions created by Mike Lischke are Copyright (C) of Mike Lischke. All rights reserved. } +{ } +{ Contributor(s): } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ ZENsan } +{ Florent Ouchet (outchy) } +{ Kiriakos Vlahos } +{ } +{**************************************************************************************************} +{ } +{ This is a lightweight Unicode unit. For more features use JclUnicode. } +{ } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclWideStrings; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.Classes, System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + Classes, SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclBase; + +// Exceptions +type + EJclWideStringError = class(EJclError); + +const + // definitions of often used characters: + // Note: Use them only for tests of a certain character not to determine character + // classes (like white spaces) as in Unicode are often many code points defined + // being in a certain class. Hence your best option is to use the various + // UnicodeIs* functions. + WideNull = WideChar(#0); + WideTabulator = WideChar(#9); + WideSpace = WideChar(#32); + + // logical line breaks + WideLF = WideChar(#10); + WideLineFeed = WideChar(#10); + WideVerticalTab = WideChar(#11); + WideFormFeed = WideChar(#12); + WideCR = WideChar(#13); + WideCarriageReturn = WideChar(#13); + WideCRLF = WideString(#13#10); + WideLineSeparator = WideChar($2028); + WideParagraphSeparator = WideChar($2029); + + {$IFDEF MSWINDOWS} + WideLineBreak = WideCRLF; + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + WideLineBreak = WideLineFeed; + {$ENDIF UNIX} + + BOM_LSB_FIRST = WideChar($FEFF); + BOM_MSB_FIRST = WideChar($FFFE); + +type + {$IFDEF SUPPORTS_UNICODE} + TJclWideStrings = {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Classes.TStrings; + TJclWideStringList = {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Classes.TStringList; + {$ELSE ~SUPPORTS_UNICODE} + + TWideFileOptionsType = + ( + foAnsiFile, // loads/writes an ANSI file + foUnicodeLB // reads/writes BOM_LSB_FIRST/BOM_MSB_FIRST + ); + TWideFileOptions = set of TWideFileOptionsType; + + TSearchFlag = ( + sfCaseSensitive, // match letter case + sfIgnoreNonSpacing, // ignore non-spacing characters in search + sfSpaceCompress, // handle several consecutive white spaces as one white space + // (this applies to the pattern as well as the search text) + sfWholeWordOnly // match only text at end/start and/or surrounded by white spaces + ); + TSearchFlags = set of TSearchFlag; + + TJclWideStrings = class; + TJclWideStringList = class; + + TJclWideStringListSortCompare = function(List: TJclWideStringList; Index1, Index2: Integer): Integer; + + TJclWideStrings = class(TPersistent) + private + FDelimiter: WideChar; + FQuoteChar: WideChar; + FNameValueSeparator: WideChar; + FLineSeparator: WideString; + FUpdateCount: Integer; + function GetCommaText: WideString; + function GetDelimitedText: WideString; + function GetName(Index: Integer): WideString; + function GetValue(const Name: WideString): WideString; + procedure ReadData(Reader: TReader); + procedure SetCommaText(const Value: WideString); + procedure SetDelimitedText(const Value: WideString); + procedure SetValue(const Name, Value: WideString); + procedure WriteData(Writer: TWriter); + function GetValueFromIndex(Index: Integer): WideString; + procedure SetValueFromIndex(Index: Integer; const Value: WideString); + protected + procedure DefineProperties(Filer: TFiler); override; + function ExtractName(const S: WideString): WideString; + function GetP(Index: Integer): PWideString; virtual; abstract; + function Get(Index: Integer): WideString; + function GetCapacity: Integer; virtual; + function GetCount: Integer; virtual; abstract; + function GetObject(Index: Integer): TObject; virtual; + function GetTextStr: WideString; virtual; + procedure Put(Index: Integer; const S: WideString); virtual; abstract; + procedure PutObject(Index: Integer; AObject: TObject); virtual; abstract; + procedure SetCapacity(NewCapacity: Integer); virtual; + procedure SetTextStr(const Value: WideString); virtual; + procedure SetUpdateState(Updating: Boolean); virtual; + property UpdateCount: Integer read FUpdateCount; + function CompareStrings(const S1, S2: WideString): Integer; virtual; + procedure AssignTo(Dest: TPersistent); override; + public + constructor Create; + function Add(const S: WideString): Integer; virtual; + function AddObject(const S: WideString; AObject: TObject): Integer; virtual; + procedure Append(const S: WideString); + procedure AddStrings(Strings: TJclWideStrings); overload; virtual; + procedure AddStrings(Strings: TStrings); overload; virtual; + procedure Assign(Source: TPersistent); override; + function CreateAnsiStringList: TStrings; + procedure AddStringsTo(Dest: TStrings); virtual; + procedure BeginUpdate; + procedure Clear; virtual; abstract; + procedure Delete(Index: Integer); virtual; abstract; + procedure EndUpdate; + function Equals(Strings: TJclWideStrings): Boolean; {$IFDEF RTL200_UP}reintroduce; {$ENDIF RTL200_UP}overload; + function Equals(Strings: TStrings): Boolean; {$IFDEF RTL200_UP}reintroduce; {$ENDIF RTL200_UP}overload; + procedure Exchange(Index1, Index2: Integer); virtual; + function GetText: PWideChar; virtual; + function IndexOf(const S: WideString): Integer; virtual; + function IndexOfName(const Name: WideString): Integer; virtual; + function IndexOfObject(AObject: TObject): Integer; virtual; + procedure Insert(Index: Integer; const S: WideString); virtual; + procedure InsertObject(Index: Integer; const S: WideString; + AObject: TObject); virtual; + procedure LoadFromFile(const FileName: TFileName; + WideFileOptions: TWideFileOptions = []); virtual; + procedure LoadFromStream(Stream: TStream; + WideFileOptions: TWideFileOptions = []); virtual; + procedure Move(CurIndex, NewIndex: Integer); virtual; + procedure SaveToFile(const FileName: TFileName; + WideFileOptions: TWideFileOptions = []); virtual; + procedure SaveToStream(Stream: TStream; + WideFileOptions: TWideFileOptions = []); virtual; + procedure SetText(Text: PWideChar); virtual; + function GetDelimitedTextEx(ADelimiter, AQuoteChar: WideChar): WideString; + procedure SetDelimitedTextEx(ADelimiter, AQuoteChar: WideChar; const Value: WideString); + property Capacity: Integer read GetCapacity write SetCapacity; + property CommaText: WideString read GetCommaText write SetCommaText; + property Count: Integer read GetCount; + property Delimiter: WideChar read FDelimiter write FDelimiter; + property DelimitedText: WideString read GetDelimitedText write SetDelimitedText; + property Names[Index: Integer]: WideString read GetName; + property Objects[Index: Integer]: TObject read GetObject write PutObject; + property QuoteChar: WideChar read FQuoteChar write FQuoteChar; + property Values[const Name: WideString]: WideString read GetValue write SetValue; + property ValueFromIndex[Index: Integer]: WideString read GetValueFromIndex write SetValueFromIndex; + property NameValueSeparator: WideChar read FNameValueSeparator write FNameValueSeparator; + property LineSeparator: WideString read FLineSeparator write FLineSeparator; + property PStrings[Index: Integer]: PWideString read GetP; + property Strings[Index: Integer]: WideString read Get write Put; default; + property Text: WideString read GetTextStr write SetTextStr; + end; + + // do not replace by JclUnicode.TWideStringList (speed and size issue) + PWStringItem = ^TWStringItem; + TWStringItem = record + FString: WideString; + FObject: TObject; + end; + + TJclWideStringList = class(TJclWideStrings) + private + FList: TList; + FSorted: Boolean; + FDuplicates: TDuplicates; + FCaseSensitive: Boolean; + FOnChange: TNotifyEvent; + FOnChanging: TNotifyEvent; + procedure SetSorted(Value: Boolean); + procedure SetCaseSensitive(const Value: Boolean); + protected + function GetItem(Index: Integer): PWStringItem; + procedure Changed; virtual; + procedure Changing; virtual; + function GetP(Index: Integer): PWideString; override; + function GetCapacity: Integer; override; + function GetCount: Integer; override; + function GetObject(Index: Integer): TObject; override; + procedure Put(Index: Integer; const Value: WideString); override; + procedure PutObject(Index: Integer; AObject: TObject); override; + procedure SetCapacity(NewCapacity: Integer); override; + procedure SetUpdateState(Updating: Boolean); override; + function CompareStrings(const S1, S2: WideString): Integer; override; + public + constructor Create; + destructor Destroy; override; + function AddObject(const S: WideString; AObject: TObject): Integer; override; + procedure Clear; override; + procedure Delete(Index: Integer); override; + procedure Exchange(Index1, Index2: Integer); override; + function Find(const S: WideString; var Index: Integer): Boolean; virtual; + // Find() also works with unsorted lists + function IndexOf(const S: WideString): Integer; override; + procedure InsertObject(Index: Integer; const S: WideString; + AObject: TObject); override; + procedure Sort; virtual; + procedure CustomSort(Compare: TJclWideStringListSortCompare); virtual; + property Duplicates: TDuplicates read FDuplicates write FDuplicates; + property Sorted: Boolean read FSorted write SetSorted; + property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property OnChanging: TNotifyEvent read FOnChanging write FOnChanging; + end; + {$ENDIF ~SUPPORTS_UNICODE} + + TWideStringList = TJclWideStringList; + TWideStrings = TJclWideStrings; + + TJclUnicodeStringList = TJclWideStringList; + TJclUnicodeStrings = TJclWideStrings; + + // OF deprecated? + TWStringList = TJclWideStringList; + TWStrings = TJclWideStrings; + +// WideChar functions +function CharToWideChar(Ch: AnsiChar): WideChar; +function WideCharToChar(Ch: WideChar): AnsiChar; + +// PWideChar functions +procedure MoveWideChar(const Source; var Dest; Count: SizeInt); + +function StrLenW(const Str: PWideChar): SizeInt; +function StrEndW(const Str: PWideChar): PWideChar; +function StrMoveW(Dest: PWideChar; const Source: PWideChar; Count: SizeInt): PWideChar; +function StrCopyW(Dest: PWideChar; const Source: PWideChar): PWideChar; +function StrECopyW(Dest: PWideChar; const Source: PWideChar): PWideChar; +function StrLCopyW(Dest: PWideChar; const Source: PWideChar; MaxLen: SizeInt): PWideChar; +function StrPCopyWW(Dest: PWideChar; const Source: WideString): PWideChar; +function StrPCopyW(Dest: PWideChar; const Source: AnsiString): PWideChar; +function StrPLCopyWW(Dest: PWideChar; const Source: WideString; MaxLen: SizeInt): PWideChar; +function StrPLCopyW(Dest: PWideChar; const Source: AnsiString; MaxLen: SizeInt): PWideChar; +function StrCatW(Dest: PWideChar; const Source: PWideChar): PWideChar; +function StrLCatW(Dest: PWideChar; const Source: PWideChar; MaxLen: SizeInt): PWideChar; +function StrCompW(const Str1, Str2: PWideChar): SizeInt; +function StrICompW(const Str1, Str2: PWideChar): SizeInt; +function StrLCompW(const Str1, Str2: PWideChar; MaxLen: SizeInt): SizeInt; +function StrLICompW(const Str1, Str2: PWideChar; MaxLen: SizeInt): SizeInt; +function StrLICompW2(const Str1, Str2: PWideChar; MaxLen: SizeInt): SizeInt; +function StrNScanW(const Str1, Str2: PWideChar): SizeInt; +function StrRNScanW(const Str1, Str2: PWideChar): SizeInt; +function StrScanW(const Str: PWideChar; Ch: WideChar): PWideChar; overload; +function StrScanW(Str: PWideChar; Chr: WideChar; StrLen: SizeInt): PWideChar; overload; +function StrRScanW(const Str: PWideChar; Chr: WideChar): PWideChar; +function StrPosW(const Str, SubStr: PWideChar): PWideChar; +function StrAllocW(WideSize: SizeInt): PWideChar; +function StrBufSizeW(const Str: PWideChar): SizeInt; +function StrNewW(const Str: PWideChar): PWideChar; overload; +function StrNewW(const Str: WideString): PWideChar; overload; +procedure StrDisposeW(Str: PWideChar); +procedure StrDisposeAndNilW(var Str: PWideChar); +procedure StrSwapByteOrder(Str: PWideChar); + +// WideString functions +function WidePos(const SubStr, S: WideString): SizeInt; +function WideQuotedStr(const S: WideString; Quote: WideChar): WideString; +function WideExtractQuotedStr(var Src: PWideChar; Quote: WideChar): WideString; +function WideCompareText(const S1, S2: WideString): SizeInt; +function WideCompareStr(const S1, S2: WideString): SizeInt; +function WideUpperCase(const S: WideString): WideString; +function WideLowerCase(const S: WideString): WideString; +function TrimW(const S: WideString): WideString; +function TrimLeftW(const S: WideString): WideString; +function TrimRightW(const S: WideString): WideString; +function WideReverse(const AText: Widestring): Widestring; +procedure WideReverseInPlace(var S: WideString); + +function TrimLeftLengthW(const S: WideString): SizeInt; +function TrimRightLengthW(const S: WideString): SizeInt; + +{$IFNDEF FPC} +function WideStartsText(const SubStr, S: WideString): Boolean; +function WideStartsStr(const SubStr, S: WideString): Boolean; +{$ENDIF ~FPC} + +// MultiSz Routines +type + PWideMultiSz = PWideChar; + +function StringsToMultiSz(var Dest: PWideMultiSz; const Source: TJclWideStrings): PWideMultiSz; +procedure MultiSzToStrings(const Dest: TJclWideStrings; const Source: PWideMultiSz); +function MultiSzLength(const Source: PWideMultiSz): SizeInt; +procedure AllocateMultiSz(var Dest: PWideMultiSz; Len: SizeInt); +procedure FreeMultiSz(var Dest: PWideMultiSz); +function MultiSzDup(const Source: PWideMultiSz): PWideMultiSz; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + {$IFDEF HAS_UNIT_RTLCONSTS} + System.RTLConsts, + {$ENDIF HAS_UNIT_RTLCONSTS} + {$IFDEF MSWINDOWS} + Winapi.Windows, + {$ENDIF MSWINDOWS} + System.Math, + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF HAS_UNIT_RTLCONSTS} + RTLConsts, + {$ENDIF HAS_UNIT_RTLCONSTS} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + Math, + {$ENDIF ~HAS_UNITSCOPE} + JclUnicode, + JclResources; + +procedure SwapWordByteOrder(P: PWideChar; Len: SizeInt); +begin + while Len > 0 do + begin + Dec(Len); + P^ := WideChar((Word(P^) shr 8) or (Word(P^) shl 8)); + Inc(P); + end; +end; + +//=== WideChar functions ===================================================== + +function CharToWideChar(Ch: AnsiChar): WideChar; +var + WS: WideString; +begin + WS := WideChar(Ch); + Result := WS[1]; +end; + +function WideCharToChar(Ch: WideChar): AnsiChar; +var + S: WideString; +begin + S := Ch; + Result := AnsiChar(S[1]); +end; + +//=== PWideChar functions ==================================================== + +procedure MoveWideChar(const Source; var Dest; Count: SizeInt); +begin + Move(Source, Dest, Count * SizeOf(WideChar)); +end; + +function StrAllocW(WideSize: SizeInt): PWideChar; +begin + WideSize := SizeOf(WideChar) * WideSize + SizeOf(SizeInt); + Result := AllocMem(WideSize); + SizeInt(Pointer(Result)^) := WideSize; + Inc(Result, SizeOf(SizeInt) div SizeOf(WideChar)); +end; + +function StrNewW(const Str: PWideChar): PWideChar; +// Duplicates the given string (if not nil) and returns the address of the new string. +var + Size: SizeInt; +begin + if Str = nil then + Result := nil + else + begin + Size := StrLenW(Str) + 1; + Result := StrMoveW(StrAllocW(Size), Str, Size); + end; +end; + +function StrNewW(const Str: WideString): PWideChar; +begin + Result := StrNewW(PWideChar(Str)); +end; + +procedure StrDisposeW(Str: PWideChar); +// releases a string allocated with StrNewW or StrAllocW +begin + if Str <> nil then + begin + Dec(Str, SizeOf(SizeInt) div SizeOf(WideChar)); + FreeMem(Str); + end; +end; + +procedure StrDisposeAndNilW(var Str: PWideChar); +var + Buff: PWideChar; +begin + Buff := Str; + Str := nil; + StrDisposeW(Buff); +end; + +const + // data used to bring UTF-16 coded strings into correct UTF-32 order for correct comparation + UTF16Fixup: array [0..31] of Word = ( + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + $2000, $F800, $F800, $F800, $F800 + ); + +function StrCompW(const Str1, Str2: PWideChar): SizeInt; +// Binary comparation of Str1 and Str2 with surrogate fix-up. +// Returns < 0 if Str1 is smaller in binary order than Str2, = 0 if both strings are +// equal and > 0 if Str1 is larger than Str2. +// +// This code is based on an idea of Markus W. Scherer (IBM). +// Note: The surrogate fix-up is necessary because some single value code points have +// larger values than surrogates which are in UTF-32 actually larger. +var + C1, C2: Word; + Run1, Run2: PWideChar; +begin + Run1 := Str1; + Run2 := Str2; + repeat + C1 := Word(Run1^); + C1 := Word(C1 or UTF16Fixup[C1 shr 11]); + C2 := Word(Run2^); + C2 := Word(C2 or UTF16Fixup[C2 shr 11]); + + // now C1 and C2 are in UTF-32-compatible order + Result := SizeInt(C1) - SizeInt(C2); + if(Result <> 0) or (C1 = 0) or (C2 = 0) then + Break; + Inc(Run1); + Inc(Run2); + until False; + + // If the strings have different lengths but the comparation returned equity so far + // then adjust the result so that the longer string is marked as the larger one. + if Result = 0 then + Result := (Run1 - Str1) - (Run2 - Str2); +end; + +function StrLCompW(const Str1, Str2: PWideChar; MaxLen: SizeInt): SizeInt; +// compares strings up to MaxLen code points +// see also StrCompW +var + S1, S2: PWideChar; + C1, C2: Word; +begin + if MaxLen > 0 then + begin + S1 := Str1; + S2 := Str2; + repeat + C1 := Word(S1^); + C1 := Word(C1 or UTF16Fixup[C1 shr 11]); + C2 := Word(S2^); + C2 := Word(C2 or UTF16Fixup[C2 shr 11]); + + // now C1 and C2 are in UTF-32-compatible order + { TODO : surrogates take up 2 words and are counted twice here, count them only once } + Result := SizeInt(C1) - SizeInt(C2); + Dec(MaxLen); + if(Result <> 0) or (C1 = 0) or (C2 = 0) or (MaxLen = 0) then + Break; + Inc(S1); + Inc(S2); + until False; + end + else + Result := 0; +end; + +function StrICompW(const Str1, Str2: PWideChar): SizeInt; +// Compares Str1 to Str2 without case sensitivity. +// See also comments in StrCompW, but keep in mind that case folding might result in +// one-to-many mappings which must be considered here. +{$IFDEF UNICODE_RTL_DATABASE} +begin + Result := AnsiStrIComp(Str1, Str2) +end; +{$ELSE ~UNICODE_RTL_DATABASE} +var + C1, C2: Word; + S1, S2: PWideChar; + Run1, Run2: PWideChar; + Folded1, Folded2: WideString; +begin + // Because of size changes of the string when doing case folding + // it is unavoidable to convert both strings completely in advance. + S1 := Str1; + S2 := Str2; + Folded1 := ''; + while S1^ <> #0 do + begin + Folded1 := Folded1 + WideCaseFolding(S1^); + Inc(S1); + end; + + Folded2 := ''; + while S2^ <> #0 do + begin + Folded2 := Folded2 + WideCaseFolding(S2^); + Inc(S2); + end; + + Run1 := PWideChar(Folded1); + Run2 := PWideChar(Folded2); + repeat + C1 := Word(Run1^); + C1 := Word(C1 or UTF16Fixup[C1 shr 11]); + C2 := Word(Run2^); + C2 := Word(C2 or UTF16Fixup[C2 shr 11]); + + // now C1 and C2 are in UTF-32-compatible order + Result := SizeInt(C1) - SizeInt(C2); + if(Result <> 0) or (C1 = 0) or (C2 = 0) then + Break; + Inc(Run1); + Inc(Run2); + until False; + + // If the strings have different lengths but the comparation returned equity so far + // then adjust the result so that the longer string is marked as the larger one. + if Result = 0 then + Result := (Run1 - PWideChar(Folded1)) - (Run2 - PWideChar(Folded2)); +end; +{$ENDIF ~UNICODE_RTL_DATABASE} + +function StrLICompW(const Str1, Str2: PWideChar; MaxLen: SizeInt): SizeInt; +// compares strings up to MaxLen code points +// see also StrICompW +{$IFDEF UNICODE_RTL_DATABASE} +begin + Result := AnsiStrIComp(Str1, Str2) +end; +{$ELSE UNICODE_RTL_DATABASE} +var + S1, S2: PWideChar; + C1, C2: Word; + Run1, Run2: PWideChar; + Folded1, Folded2: WideString; +begin + if MaxLen > 0 then + begin + // Because of size changes of the string when doing case folding + // it is unavoidable to convert both strings completely in advance. + S1 := Str1; + S2 := Str2; + Folded1 := ''; + while S1^ <> #0 do + begin + Folded1 := Folded1 + WideCaseFolding(S1^); + Inc(S1); + end; + + Folded2 := ''; + while S2^ <> #0 do + begin + Folded2 := Folded2 + WideCaseFolding(S2^); + Inc(S2); + end; + + Run1 := PWideChar(Folded1); + Run2 := PWideChar(Folded2); + + repeat + C1 := Word(Run1^); + C1 := Word(C1 or UTF16Fixup[C1 shr 11]); + C2 := Word(Run2^); + C2 := Word(C2 or UTF16Fixup[C2 shr 11]); + + // now C1 and C2 are in UTF-32-compatible order + { TODO : surrogates take up 2 words and are counted twice here, count them only once } + Result := SizeInt(C1) - SizeInt(C2); + Dec(MaxLen); + if(Result <> 0) or (C1 = 0) or (C2 = 0) or (MaxLen = 0) then + Break; + Inc(Run1); + Inc(Run2); + until False; + end + else + Result := 0; +end; +{$ENDIF UNICODE_RTL_DATABASE} + +function StrLICompW2(const Str1, Str2: PWideChar; MaxLen: SizeInt): SizeInt; +var + P1, P2: WideString; +begin + // faster than the JclUnicode.StrLICompW function + SetString(P1, Str1, Min(MaxLen, StrLenW(Str1))); + SetString(P2, Str2, Min(MaxLen, StrLenW(Str2))); + Result := WideCompareText(P1, P2); +end; + +function StrPosW(const Str, SubStr: PWideChar): PWideChar; +var + P: PWideChar; + I: SizeInt; +begin + Result := nil; + if (Str = nil) or (SubStr = nil) or (Str^ = #0) or (SubStr^ = #0) then + Exit; + Result := Str; + while Result^ <> #0 do + begin + if Result^ <> SubStr^ then + Inc(Result) + else + begin + P := Result + 1; + I := 1; + while (P^ <> #0) and (P^ = SubStr[I]) do + begin + Inc(I); + Inc(P); + end; + if SubStr[I] = #0 then + Exit + else + Inc(Result); + end; + end; + Result := nil; +end; + +function StrLenW(const Str: PWideChar): SizeInt; +begin + Result := 0; + if Str <> nil then + while Str[Result] <> #0 do + Inc(Result); +end; + +function StrScanW(const Str: PWideChar; Ch: WideChar): PWideChar; +begin + Result := Str; + if Result <> nil then + begin + while (Result^ <> #0) and (Result^ <> Ch) do + Inc(Result); + if (Result^ = #0) and (Ch <> #0) then + Result := nil; + end; +end; + +function StrEndW(const Str: PWideChar): PWideChar; +begin + Result := Str; + if Result <> nil then + while Result^ <> #0 do + Inc(Result); +end; + +function StrCopyW(Dest: PWideChar; const Source: PWideChar): PWideChar; +var + Src: PWideChar; +begin + Result := Dest; + if Dest <> nil then + begin + Src := Source; + if Src <> nil then + while Src^ <> #0 do + begin + Dest^ := Src^; + Inc(Src); + Inc(Dest); + end; + Dest^ := #0; + end; +end; + +function StrECopyW(Dest: PWideChar; const Source: PWideChar): PWideChar; +var + Src: PWideChar; +begin + if Dest <> nil then + begin + Src := Source; + if Src <> nil then + while Src^ <> #0 do + begin + Dest^ := Src^; + Inc(Src); + Inc(Dest); + end; + Dest^ := #0; + end; + Result := Dest; +end; + +function StrLCopyW(Dest: PWideChar; const Source: PWideChar; MaxLen: SizeInt): PWideChar; +var + Src: PWideChar; +begin + Result := Dest; + if (Dest <> nil) and (MaxLen > 0) then + begin + Src := Source; + if Src <> nil then + while (MaxLen > 0) and (Src^ <> #0) do + begin + Dest^ := Src^; + Inc(Src); + Inc(Dest); + Dec(MaxLen); + end; + Dest^ := #0; + end; +end; + +function StrCatW(Dest: PWideChar; const Source: PWideChar): PWideChar; +begin + Result := Dest; + StrCopyW(StrEndW(Dest), Source); +end; + +function StrLCatW(Dest: PWideChar; const Source: PWideChar; MaxLen: SizeInt): PWideChar; +begin + Result := Dest; + StrLCopyW(StrEndW(Dest), Source, MaxLen); +end; + +function StrMoveW(Dest: PWideChar; const Source: PWideChar; Count: SizeInt): PWideChar; +begin + Result := Dest; + if Count > 0 then + Move(Source^, Dest^, Count * SizeOf(WideChar)); +end; + +function StrPCopyWW(Dest: PWideChar; const Source: WideString): PWideChar; +begin + Result := StrLCopyW(Dest, PWideChar(Source), Length(Source)); +end; + +function StrPLCopyWW(Dest: PWideChar; const Source: WideString; MaxLen: SizeInt): PWideChar; +begin + Result := StrLCopyW(Dest, PWideChar(Source), MaxLen); +end; + +function StrRScanW(const Str: PWideChar; Chr: WideChar): PWideChar; +var + P: PWideChar; +begin + Result := nil; + if Str <> nil then + begin + P := Str; + repeat + if P^ = Chr then + Result := P; + Inc(P); + until P^ = #0; + end; +end; + +// (rom) following functions copied from JclUnicode.pas + +// exchanges in each character of the given string the low order and high order +// byte to go from LSB to MSB and vice versa. +// EAX/RAX contains address of string +// stop at the first #0 character + +procedure StrSwapByteOrder(Str: PWideChar); +asm + {$IFDEF CPU32} + // --> EAX Str + PUSH ESI + PUSH EDI + MOV ESI, EAX + MOV EDI, ESI + XOR EAX, EAX // clear high order byte to be able to use 32bit operand below +@@1: + LODSW + OR EAX, EAX + JZ @@2 + XCHG AL, AH + STOSW + JMP @@1 +@@2: + POP EDI + POP ESI + {$ENDIF CPU32} + {$IFDEF CPU64} + // --> RCX Str + XOR RAX, RAX // clear high order byte to be able to use 64bit operand below +@@1: + MOV AX, WORD PTR [RCX] + OR RAX, RAX + JZ @@2 + XCHG AL, AH + MOV WORD PTR [RCX], AX + ADD ECX, 2 + JMP @@1 +@@2: + {$ENDIF CPU64} +end; + +function StrNScanW(const Str1, Str2: PWideChar): SizeInt; +// Determines where (in Str1) the first time one of the characters of Str2 appear. +// The result is the length of a string part of Str1 where none of the characters of +// Str2 do appear (not counting the trailing #0 and starting with position 0 in Str1). +var + Run: PWideChar; +begin + Result := -1; + if (Str1 <> nil) and (Str2 <> nil) then + begin + Run := Str1; + while Run^ <> #0 do + begin + if StrScanW(Str2, Run^) <> nil then + Break; + Inc(Run); + end; + Result := Run - Str1; + end; +end; + +function StrRNScanW(const Str1, Str2: PWideChar): SizeInt; +// This function does the same as StrRNScanW but uses Str1 in reverse order. This +// means Str1 points to the last character of a string, is traversed reversely +// and terminates with a starting #0. This is useful for parsing strings stored +// in reversed macro buffers etc. +var + Run: PWideChar; +begin + Result := -1; + if (Str1 <> nil) and (Str2 <> nil) then + begin + Run := Str1; + while Run^ <> #0 do + begin + if StrScanW(Str2, Run^) <> nil then + Break; + Dec(Run); + end; + Result := Str1 - Run; + end; +end; + +// Returns a pointer to first occurrence of a specified character in a string +// or nil if not found. +// Note: this is just a binary search for the specified character and there's no +// check for a terminating null. Instead at most StrLen characters are +// searched. This makes this function extremly fast. +// +function StrScanW(Str: PWideChar; Chr: WideChar; StrLen: SizeInt): PWideChar; +begin + Result := Str; + while StrLen > 0 do + begin + if Result^ = Chr then + Exit; + Inc(Result); + Dec(StrLen); + end; + Result := nil; +end; + +function StrBufSizeW(const Str: PWideChar): SizeInt; +// Returns max number of wide characters that can be stored in a buffer +// allocated by StrAllocW. +var + P: PWideChar; +begin + if Str <> nil then + begin + P := Str; + Dec(P, SizeOf(SizeInt) div SizeOf(WideChar)); + Result := (PSizeInt(P)^ - SizeOf(SizeInt)) div SizeOf(WideChar); + end + else + Result := 0; +end; + +function StrPCopyW(Dest: PWideChar; const Source: AnsiString): PWideChar; +// copies a Pascal-style string to a null-terminated wide string +begin + Result := StrPLCopyW(Dest, Source, SizeInt(Length(Source))); + Result[Length(Source)] := WideNull; +end; + +function StrPLCopyW(Dest: PWideChar; const Source: AnsiString; MaxLen: SizeInt): PWideChar; +// copies characters from a Pascal-style string into a null-terminated wide string +var + P: PAnsiChar; +begin + P := PAnsiChar(Pointer(Source)); + while MaxLen > 0 do + begin + Dest^ := WideChar(Ord(P^)); + Inc(P); + Inc(Dest); + Dec(MaxLen); + end; + Result := Dest; +end; + +//=== WideString functions =================================================== + +function WidePos(const SubStr, S: WideString): SizeInt; +var + P: PWideChar; +begin + P := StrPosW(PWideChar(S), PWideChar(SubStr)); + if P <> nil then + Result := P - PWideChar(S) + 1 + else + Result := 0; +end; + +// original code by Mike Lischke (extracted from JclUnicode.pas) + +function WideQuotedStr(const S: WideString; Quote: WideChar): WideString; +var + P, Src, + Dest: PWideChar; + AddCount: SizeInt; +begin + AddCount := 0; + P := StrScanW(PWideChar(S), Quote); + while P <> nil do + begin + Inc(P); + Inc(AddCount); + P := StrScanW(P, Quote); + end; + + if AddCount = 0 then + Result := Quote + S + Quote + else + begin + SetLength(Result, Length(S) + AddCount + 2); + Dest := PWideChar(Result); + Dest^ := Quote; + Inc(Dest); + Src := PWideChar(S); + P := StrScanW(Src, Quote); + repeat + Inc(P); + MoveWideChar(Src^, Dest^, P - Src); + Inc(Dest, P - Src); + Dest^ := Quote; + Inc(Dest); + Src := P; + P := StrScanW(Src, Quote); + until P = nil; + P := StrEndW(Src); + MoveWideChar(Src^, Dest^, P - Src); + Inc(Dest, P - Src); + Dest^ := Quote; + end; +end; + +// original code by Mike Lischke (extracted from JclUnicode.pas) + +function WideExtractQuotedStr(var Src: PWideChar; Quote: WideChar): WideString; +var + P, Dest: PWideChar; + DropCount: SizeInt; +begin + Result := ''; + if (Src = nil) or (Src^ <> Quote) then + Exit; + + Inc(Src); + DropCount := 1; + P := Src; + Src := StrScanW(Src, Quote); + while Src <> nil do // count adjacent pairs of quote chars + begin + Inc(Src); + if Src^ <> Quote then + Break; + Inc(Src); + Inc(DropCount); + Src := StrScanW(Src, Quote); + end; + + if Src = nil then + Src := StrEndW(P); + if (Src - P) <= 1 then + Exit; + + if DropCount = 1 then + SetString(Result, P, Src - P - 1) + else + begin + SetLength(Result, Src - P - DropCount); + Dest := PWideChar(Result); + Src := StrScanW(P, Quote); + while Src <> nil do + begin + Inc(Src); + if Src^ <> Quote then + Break; + MoveWideChar(P^, Dest^, Src - P); + Inc(Dest, Src - P); + Inc(Src); + P := Src; + Src := StrScanW(Src, Quote); + end; + if Src = nil then + Src := StrEndW(P); + MoveWideChar(P^, Dest^, Src - P - 1); + end; +end; + + +function TrimW(const S: WideString): WideString; +// available from Delphi 7 up +{$IFDEF RTL150_UP} +begin + Result := Trim(S); +end; +{$ELSE ~RTL150_UP} +var + I, L: SizeInt; +begin + L := Length(S); + I := 1; + while (I <= L) and (S[I] <= ' ') do + Inc(I); + if I > L then + Result := '' + else + begin + while S[L] <= ' ' do + Dec(L); + Result := Copy(S, I, L - I + 1); + end; +end; +{$ENDIF ~RTL150_UP} + +function TrimLeftW(const S: WideString): WideString; +// available from Delphi 7 up +{$IFDEF RTL150_UP} +begin + Result := TrimLeft(S); +end; +{$ELSE ~RTL150_UP} +var + I, L: SizeInt; +begin + L := Length(S); + I := 1; + while (I <= L) and (S[I] <= ' ') do + Inc(I); + Result := Copy(S, I, Maxint); +end; +{$ENDIF ~RTL150_UP} + +function TrimRightW(const S: WideString): WideString; +// available from Delphi 7 up +{$IFDEF RTL150_UP} +begin + Result := TrimRight(S); +end; +{$ELSE ~RTL150_UP} +var + I: SizeInt; +begin + I := Length(S); + while (I > 0) and (S[I] <= ' ') do + Dec(I); + Result := Copy(S, 1, I); +end; +{$ENDIF ~RTL150_UP} + +function WideReverse(const AText: Widestring): Widestring; +begin + Result := AText; + WideReverseInPlace(Result); +end; + +procedure WideReverseInPlace(var S: WideString); +var + P1, P2: PWideChar; + C: WideChar; +begin + UniqueString(S); + P1 := PWideChar(S); + P2 := PWideChar(S) + Length(S) - 1; + while P1 < P2 do + begin + C := P1^; + P1^ := P2^; + P2^ := C; + Inc(P1); + Dec(P2); + end; +end; + +function WideCompareText(const S1, S2: WideString): SizeInt; +begin + {$IFDEF MSWINDOWS} + if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then + Result := AnsiCompareText(string(S1), string(S2)) + else + Result := CompareStringW(LOCALE_USER_DEFAULT, NORM_IGNORECASE, + PWideChar(S1), Length(S1), PWideChar(S2), Length(S2)) - 2; + {$ELSE ~MSWINDOWS} + { TODO : Don't cheat here } + Result := CompareText(S1, S2); + {$ENDIF MSWINDOWS} +end; + +function WideCompareStr(const S1, S2: WideString): SizeInt; +begin + {$IFDEF MSWINDOWS} + if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then + Result := AnsiCompareStr(string(S1), string(S2)) + else + Result := CompareStringW(LOCALE_USER_DEFAULT, 0, + PWideChar(S1), Length(S1), PWideChar(S2), Length(S2)) - 2; + {$ELSE ~MSWINDOWS} + {$IFDEF FPC} + Result := SysUtils.WideCompareStr(S1, S2); + {$ELSE ~FPC} + { TODO : Don't cheat here } + Result := CompareString(S1, S2); + {$ENDIF ~FPC} + {$ENDIF ~MSWINDOWS} +end; + +function WideUpperCase(const S: WideString): WideString; +begin + Result := S; + if Result <> '' then + {$IFDEF MSWINDOWS} + CharUpperBuffW(Pointer(Result), Length(Result)); + {$ELSE ~MSWINDOWS} + { TODO : Don't cheat here } + Result := UpperCase(Result); + {$ENDIF ~MSWINDOWS} +end; + +function WideLowerCase(const S: WideString): WideString; +begin + Result := S; + if Result <> '' then + {$IFDEF MSWINDOWS} + CharLowerBuffW(Pointer(Result), Length(Result)); + {$ELSE ~MSWINDOWS} + { TODO : Don't cheat here } + Result := LowerCase(Result); + {$ENDIF ~MSWINDOWS} +end; + +function TrimLeftLengthW(const S: WideString): SizeInt; +var + Len: SizeInt; +begin + Len := Length(S); + Result := 1; + while (Result <= Len) and (S[Result] <= #32) do + Inc(Result); + Result := Len - Result + 1; +end; + +function TrimRightLengthW(const S: WideString): SizeInt; +begin + Result := Length(S); + while (Result > 0) and (S[Result] <= #32) do + Dec(Result); +end; + +{$IFNDEF FPC} + +function WideStartsText(const SubStr, S: WideString): Boolean; +var + Len: SizeInt; +begin + Len := Length(SubStr); + Result := (Len <= Length(S)) and (StrLICompW(PWideChar(SubStr), PWideChar(S), Len) = 0); +end; + +function WideStartsStr(const SubStr, S: WideString): Boolean; +var + Len: SizeInt; +begin + Len := Length(SubStr); + Result := (Len <= Length(S)) and (StrLCompW(PWideChar(SubStr), PWideChar(S), Len) = 0); +end; + +{$ENDIF ~FPC} + +{$IFNDEF SUPPORTS_UNICODE} +//=== { TJclWideStrings } ========================================================== + +constructor TJclWideStrings.Create; +begin + inherited Create; + // FLineSeparator := WideChar($2028); + {$IFDEF MSWINDOWS} + FLineSeparator := WideChar(13) + '' + WideChar(10); // compiler wants it this way + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + FLineSeparator := WideChar(10); + {$ENDIF UNIX} + FNameValueSeparator := '='; + FDelimiter := ','; + FQuoteChar := '"'; +end; + +function TJclWideStrings.Add(const S: WideString): Integer; +begin + Result := AddObject(S, nil); +end; + +function TJclWideStrings.AddObject(const S: WideString; AObject: TObject): Integer; +begin + Result := Count; + InsertObject(Result, S, AObject); +end; + +procedure TJclWideStrings.AddStrings(Strings: TJclWideStrings); +var + I: Integer; +begin + for I := 0 to Strings.Count - 1 do + AddObject(Strings.GetP(I)^, Strings.Objects[I]); +end; + +procedure TJclWideStrings.AddStrings(Strings: TStrings); +var + I: Integer; +begin + for I := 0 to Strings.Count - 1 do + AddObject(Strings.Strings[I], Strings.Objects[I]); +end; + +procedure TJclWideStrings.AddStringsTo(Dest: TStrings); +var + I: Integer; +begin + for I := 0 to Count - 1 do + Dest.AddObject(GetP(I)^, Objects[I]); +end; + +procedure TJclWideStrings.Append(const S: WideString); +begin + Add(S); +end; + +procedure TJclWideStrings.Assign(Source: TPersistent); +begin + if Source is TJclWideStrings then + begin + BeginUpdate; + try + Clear; + FDelimiter := TJclWideStrings(Source).FDelimiter; + FNameValueSeparator := TJclWideStrings(Source).FNameValueSeparator; + FQuoteChar := TJclWideStrings(Source).FQuoteChar; + AddStrings(TJclWideStrings(Source)); + finally + EndUpdate; + end; + end + else + if Source is TStrings then + begin + BeginUpdate; + try + Clear; + {$IFDEF RTL190_UP} + FNameValueSeparator := TStrings(Source).NameValueSeparator; + FQuoteChar := TStrings(Source).QuoteChar; + FDelimiter := TStrings(Source).Delimiter; + {$ELSE ~RTL190_UP} + {$IFDEF RTL150_UP} + FNameValueSeparator := CharToWideChar(TStrings(Source).NameValueSeparator); + {$ENDIF RTL150_UP} + FQuoteChar := CharToWideChar(TStrings(Source).QuoteChar); + FDelimiter := CharToWideChar(TStrings(Source).Delimiter); + {$ENDIF ~RTL190_UP} + AddStrings(TStrings(Source)); + finally + EndUpdate; + end; + end + else + inherited Assign(Source); +end; + +procedure TJclWideStrings.AssignTo(Dest: TPersistent); +var + I: Integer; +begin + if Dest is TStrings then + begin + TStrings(Dest).BeginUpdate; + try + TStrings(Dest).Clear; + {$IFDEF RTL190_UP} + TStrings(Dest).NameValueSeparator := NameValueSeparator; + TStrings(Dest).QuoteChar := QuoteChar; + TStrings(Dest).Delimiter := Delimiter; + {$ELSE ~RTL190_UP} + {$IFDEF RTL150_UP} + TStrings(Dest).NameValueSeparator := WideCharToChar(NameValueSeparator); + {$ENDIF RTL150_UP} + TStrings(Dest).QuoteChar := WideCharToChar(QuoteChar); + TStrings(Dest).Delimiter := WideCharToChar(Delimiter); + {$ENDIF ~RTL190_UP} + for I := 0 to Count - 1 do + TStrings(Dest).AddObject(GetP(I)^, Objects[I]); + finally + TStrings(Dest).EndUpdate; + end; + end + else + inherited AssignTo(Dest); +end; + +procedure TJclWideStrings.BeginUpdate; +begin + if FUpdateCount = 0 then + SetUpdateState(True); + Inc(FUpdateCount); +end; + +function TJclWideStrings.CompareStrings(const S1, S2: WideString): Integer; +begin + Result := WideCompareText(S1, S2); +end; + +function TJclWideStrings.CreateAnsiStringList: TStrings; +var + I: Integer; +begin + Result := TStringList.Create; + try + Result.BeginUpdate; + for I := 0 to Count - 1 do + Result.AddObject(GetP(I)^, Objects[I]); + Result.EndUpdate; + except + Result.Free; + raise; + end; +end; + +procedure TJclWideStrings.DefineProperties(Filer: TFiler); + + function DoWrite: Boolean; + begin + if Filer.Ancestor <> nil then + begin + Result := True; + if Filer.Ancestor is TJclWideStrings then + Result := not Equals(TJclWideStrings(Filer.Ancestor)) + end + else + Result := Count > 0; + end; + +begin + Filer.DefineProperty('Strings', ReadData, WriteData, DoWrite); +end; + +procedure TJclWideStrings.EndUpdate; +begin + Dec(FUpdateCount); + if FUpdateCount = 0 then + SetUpdateState(False); +end; + +function TJclWideStrings.Equals(Strings: TStrings): Boolean; +var + I: Integer; +begin + Result := False; + if Strings.Count = Count then + begin + for I := 0 to Count - 1 do + if Strings[I] <> PStrings[I]^ then + Exit; + Result := True; + end; +end; + +function TJclWideStrings.Equals(Strings: TJclWideStrings): Boolean; +var + I: Integer; +begin + Result := False; + if Strings.Count = Count then + begin + for I := 0 to Count - 1 do + if Strings[I] <> PStrings[I]^ then + Exit; + Result := True; + end; +end; + +procedure TJclWideStrings.Exchange(Index1, Index2: Integer); +var + TempObject: TObject; + TempString: WideString; +begin + BeginUpdate; + try + TempString := PStrings[Index1]^; + TempObject := Objects[Index1]; + PStrings[Index1]^ := PStrings[Index2]^; + Objects[Index1] := Objects[Index2]; + PStrings[Index2]^ := TempString; + Objects[Index2] := TempObject; + finally + EndUpdate; + end; +end; + +function TJclWideStrings.ExtractName(const S: WideString): WideString; +var + Index: Integer; +begin + Result := S; + Index := WidePos(NameValueSeparator, Result); + if Index <> 0 then + SetLength(Result, Index - 1) + else + SetLength(Result, 0); +end; + +function TJclWideStrings.Get(Index: Integer): WideString; +begin + Result := GetP(Index)^; +end; + +function TJclWideStrings.GetCapacity: Integer; +begin + Result := Count; +end; + +function TJclWideStrings.GetCommaText: WideString; +begin + Result := GetDelimitedTextEx(',', '"'); +end; + +function TJclWideStrings.GetDelimitedText: WideString; +begin + Result := GetDelimitedTextEx(FDelimiter, FQuoteChar); +end; + +function TJclWideStrings.GetDelimitedTextEx(ADelimiter, AQuoteChar: WideChar): WideString; +var + S: WideString; + P: PWideChar; + I, Num: Integer; +begin + Num := GetCount; + if (Num = 1) and (GetP(0)^ = '') then + Result := AQuoteChar + '' + AQuoteChar // Compiler wants it this way + else + begin + Result := ''; + for I := 0 to Count - 1 do + begin + S := GetP(I)^; + P := PWideChar(S); + while True do + begin + case P[0] of + WideChar(0)..WideChar(32): + Inc(P); + else + if (P[0] = AQuoteChar) or (P[0] = ADelimiter) then + Inc(P) + else + Break; + end; + end; + if P[0] <> WideChar(0) then + S := WideQuotedStr(S, AQuoteChar); + Result := Result + S + ADelimiter; + end; + System.Delete(Result, Length(Result), 1); + end; +end; + +function TJclWideStrings.GetName(Index: Integer): WideString; +var + I: Integer; +begin + Result := GetP(Index)^; + I := WidePos(FNameValueSeparator, Result); + if I > 0 then + SetLength(Result, I - 1); +end; + +function TJclWideStrings.GetObject(Index: Integer): TObject; +begin + Result := nil; +end; + +function TJclWideStrings.GetText: PWideChar; +begin + Result := StrNewW(GetTextStr); +end; + +function TJclWideStrings.GetTextStr: WideString; +var + I: Integer; + Len, LL: Integer; + P: PWideChar; + W: PWideString; +begin + Len := 0; + LL := Length(LineSeparator); + for I := 0 to Count - 1 do + Inc(Len, Length(GetP(I)^) + LL); + SetLength(Result, Len); + P := PWideChar(Result); + for I := 0 to Count - 1 do + begin + W := GetP(I); + Len := Length(W^); + if Len > 0 then + begin + MoveWideChar(W^[1], P[0], Len); + Inc(P, Len); + end; + if LL > 0 then + begin + MoveWideChar(FLineSeparator[1], P[0], LL); + Inc(P, LL); + end; + end; +end; + +function TJclWideStrings.GetValue(const Name: WideString): WideString; +var + Idx: Integer; +begin + Idx := IndexOfName(Name); + if Idx >= 0 then + Result := GetValueFromIndex(Idx) + else + Result := ''; +end; + +function TJclWideStrings.GetValueFromIndex(Index: Integer): WideString; +var + I: Integer; +begin + Result := GetP(Index)^; + I := WidePos(FNameValueSeparator, Result); + if I > 0 then + System.Delete(Result, 1, I) + else + Result := ''; +end; + +function TJclWideStrings.IndexOf(const S: WideString): Integer; +begin + for Result := 0 to Count - 1 do + if CompareStrings(GetP(Result)^, S) = 0 then + Exit; + Result := -1; +end; + +function TJclWideStrings.IndexOfName(const Name: WideString): Integer; +begin + for Result := 0 to Count - 1 do + if CompareStrings(Names[Result], Name) = 0 then + Exit; + Result := -1; +end; + +function TJclWideStrings.IndexOfObject(AObject: TObject): Integer; +begin + for Result := 0 to Count - 1 do + if Objects[Result] = AObject then + Exit; + Result := -1; +end; + +procedure TJclWideStrings.Insert(Index: Integer; const S: WideString); +begin + InsertObject(Index, S, nil); +end; + +procedure TJclWideStrings.InsertObject(Index: Integer; const S: WideString; AObject: TObject); +begin +end; + +procedure TJclWideStrings.LoadFromFile(const FileName: TFileName; + WideFileOptions: TWideFileOptions = []); +var + Stream: TFileStream; +begin + Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); + try + LoadFromStream(Stream, WideFileOptions); + finally + Stream.Free; + end; +end; + +procedure TJclWideStrings.LoadFromStream(Stream: TStream; + WideFileOptions: TWideFileOptions = []); +var + AnsiS: AnsiString; + WideS: WideString; + WC: WideChar; +begin + BeginUpdate; + try + Clear; + WC := #0; + Stream.Read(WC, SizeOf(WC)); + if (foAnsiFile in WideFileOptions) and (Hi(Word(WC)) <> 0) and (WC <> BOM_LSB_FIRST) and (WC <> BOM_MSB_FIRST) then + begin + Stream.Seek(-SizeOf(WC), soFromCurrent); + SetLength(AnsiS, (Stream.Size - Stream.Position) div SizeOf(AnsiChar)); + Stream.Read(AnsiS[1], Length(AnsiS) * SizeOf(AnsiChar)); + SetTextStr(WideString(AnsiS)); // explicit Unicode conversion + end + else + begin + if (WC <> BOM_LSB_FIRST) and (WC <> BOM_MSB_FIRST) then + Stream.Seek(-SizeOf(WC), soFromCurrent); + SetLength(WideS, (Stream.Size - Stream.Position + 1) div SizeOf(WideChar)); + Stream.Read(WideS[1], Length(WideS) * SizeOf(WideChar)); + if WC = BOM_MSB_FIRST then + SwapWordByteOrder(PWideChar(WideS), Length(WideS)); + SetTextStr(WideS); + end; + finally + EndUpdate; + end; +end; + +procedure TJclWideStrings.Move(CurIndex, NewIndex: Integer); +var + TempObject: TObject; + TempString: WideString; +begin + if CurIndex <> NewIndex then + begin + BeginUpdate; + try + TempString := GetP(CurIndex)^; + TempObject := GetObject(CurIndex); + Delete(CurIndex); + InsertObject(NewIndex, TempString, TempObject); + finally + EndUpdate; + end; + end; +end; + +procedure TJclWideStrings.ReadData(Reader: TReader); +begin + BeginUpdate; + try + Clear; + Reader.ReadListBegin; + while not Reader.EndOfList do + if Reader.NextValue in [vaLString, vaString] then + Add(Reader.ReadString) + else + Add(Reader.ReadWideString); + Reader.ReadListEnd; + finally + EndUpdate; + end; +end; + +procedure TJclWideStrings.SaveToFile(const FileName: TFileName; WideFileOptions: TWideFileOptions = []); +var + Stream: TFileStream; +begin + Stream := TFileStream.Create(FileName, fmCreate); + try + SaveToStream(Stream, WideFileOptions); + finally + Stream.Free; + end; +end; + +procedure TJclWideStrings.SaveToStream(Stream: TStream; WideFileOptions: TWideFileOptions = []); +var + AnsiS: AnsiString; + WideS: WideString; + WC: WideChar; +begin + if foAnsiFile in WideFileOptions then + begin + AnsiS := AnsiString(GetTextStr); // explicit Unicode conversion + Stream.Write(AnsiS[1], Length(AnsiS) * SizeOf(AnsiChar)); + end + else + begin + if foUnicodeLB in WideFileOptions then + begin + WC := BOM_LSB_FIRST; + Stream.Write(WC, SizeOf(WC)); + end; + WideS := GetTextStr; + Stream.Write(WideS[1], Length(WideS) * SizeOf(WideChar)); + end; +end; + +procedure TJclWideStrings.SetCapacity(NewCapacity: Integer); +begin +end; + +procedure TJclWideStrings.SetCommaText(const Value: WideString); +begin + SetDelimitedTextEx(',', '"', Value); +end; + +procedure TJclWideStrings.SetDelimitedText(const Value: WideString); +begin + SetDelimitedTextEx(Delimiter, QuoteChar, Value); +end; + +procedure TJclWideStrings.SetDelimitedTextEx(ADelimiter, AQuoteChar: WideChar; + const Value: WideString); +var + P, P1: PWideChar; + S: WideString; + + procedure IgnoreWhiteSpace(var P: PWideChar); + begin + while True do + case P^ of + WideChar(1)..WideChar(32): + Inc(P); + else + Break; + end; + end; + +begin + BeginUpdate; + try + Clear; + P := PWideChar(Value); + IgnoreWhiteSpace(P); + while P[0] <> WideChar(0) do + begin + if P[0] = AQuoteChar then + S := WideExtractQuotedStr(P, AQuoteChar) + else + begin + P1 := P; + while (P[0] > WideChar(32)) and (P[0] <> ADelimiter) do + Inc(P); + SetString(S, P1, P - P1); + end; + Add(S); + + IgnoreWhiteSpace(P); + if P[0] = ADelimiter then + begin + Inc(P); + IgnoreWhiteSpace(P); + end; + end; + finally + EndUpdate; + end; +end; + +procedure TJclWideStrings.SetText(Text: PWideChar); +begin + SetTextStr(Text); +end; + +procedure TJclWideStrings.SetTextStr(const Value: WideString); +var + P, Start: PWideChar; + S: WideString; + Len: Integer; +begin + BeginUpdate; + try + Clear; + if Value <> '' then + begin + P := PWideChar(Value); + if P <> nil then + begin + while P[0] <> WideChar(0) do + begin + Start := P; + while True do + begin + case P[0] of + WideChar(0), WideChar(10), WideChar(13): + Break; + end; + Inc(P); + end; + Len := P - Start; + if Len > 0 then + begin + SetString(S, Start, Len); + AddObject(S, nil); // consumes most time + end + else + AddObject('', nil); + if P[0] = WideChar(13) then + Inc(P); + if P[0] = WideChar(10) then + Inc(P); + end; + end; + end; + finally + EndUpdate; + end; +end; + +procedure TJclWideStrings.SetUpdateState(Updating: Boolean); +begin +end; + +procedure TJclWideStrings.SetValue(const Name, Value: WideString); +var + Idx: Integer; +begin + Idx := IndexOfName(Name); + if Idx >= 0 then + SetValueFromIndex(Idx, Value) + else + if Value <> '' then + Add(Name + NameValueSeparator + Value); +end; + +procedure TJclWideStrings.SetValueFromIndex(Index: Integer; const Value: WideString); +var + S: WideString; + I: Integer; +begin + if Value = '' then + Delete(Index) + else + begin + if Index < 0 then + Index := Add(''); + S := GetP(Index)^; + I := WidePos(NameValueSeparator, S); + if I > 0 then + System.Delete(S, I, MaxInt); + S := S + NameValueSeparator + Value; + Put(Index, S); + end; +end; + +procedure TJclWideStrings.WriteData(Writer: TWriter); +var + I: Integer; +begin + Writer.WriteListBegin; + for I := 0 to Count - 1 do + Writer.WriteWideString(GetP(I)^); + Writer.WriteListEnd; +end; + +//=== { TJclWideStringList } ======================================================= + +constructor TJclWideStringList.Create; +begin + inherited Create; + FList := TList.Create; +end; + +destructor TJclWideStringList.Destroy; +begin + FOnChange := nil; + FOnChanging := nil; + Inc(FUpdateCount); // do not call unnecessary functions + Clear; + FList.Free; + inherited Destroy; +end; + +function TJclWideStringList.AddObject(const S: WideString; AObject: TObject): Integer; +begin + if not Sorted then + Result := Count + else + if Find(S, Result) then + case Duplicates of + dupIgnore: + Exit; + dupError: + raise EListError.CreateRes(@SDuplicateString); + end; + InsertObject(Result, S, AObject); +end; + +procedure TJclWideStringList.Changed; +begin + if Assigned(FOnChange) then + FOnChange(Self); +end; + +procedure TJclWideStringList.Changing; +begin + if Assigned(FOnChanging) then + FOnChanging(Self); +end; + +procedure TJclWideStringList.Clear; +var + I: Integer; + Item: PWStringItem; +begin + if FUpdateCount = 0 then + Changing; + for I := 0 to Count - 1 do + begin + Item := PWStringItem(FList[I]); + Item.FString := ''; + FreeMem(Item); + end; + FList.Clear; + if FUpdateCount = 0 then + Changed; +end; + +function TJclWideStringList.CompareStrings(const S1, S2: WideString): Integer; +begin + if CaseSensitive then + Result := WideCompareStr(S1, S2) + else + Result := WideCompareText(S1, S2); +end; + +threadvar + CustomSortList: TJclWideStringList; + CustomSortCompare: TJclWideStringListSortCompare; + +function WStringListCustomSort(Item1, Item2: Pointer): Integer; +begin + Result := CustomSortCompare(CustomSortList, + CustomSortList.FList.IndexOf(Item1), + CustomSortList.FList.IndexOf(Item2)); +end; + +procedure TJclWideStringList.CustomSort(Compare: TJclWideStringListSortCompare); +var + TempList: TJclWideStringList; + TempCompare: TJclWideStringListSortCompare; +begin + TempList := CustomSortList; + TempCompare := CustomSortCompare; + CustomSortList := Self; + CustomSortCompare := Compare; + try + Changing; + FList.Sort(WStringListCustomSort); + Changed; + finally + CustomSortList := TempList; + CustomSortCompare := TempCompare; + end; +end; + +procedure TJclWideStringList.Delete(Index: Integer); +var + Item: PWStringItem; +begin + if FUpdateCount = 0 then + Changing; + Item := PWStringItem(FList[Index]); + FList.Delete(Index); + Item.FString := ''; + FreeMem(Item); + if FUpdateCount = 0 then + Changed; +end; + +procedure TJclWideStringList.Exchange(Index1, Index2: Integer); +begin + if FUpdateCount = 0 then + Changing; + FList.Exchange(Index1, Index2); + if FUpdateCount = 0 then + Changed; +end; + +function TJclWideStringList.Find(const S: WideString; var Index: Integer): Boolean; +var + L, H, I, C: Integer; +begin + Result := False; + if Sorted then + begin + L := 0; + H := Count - 1; + while L <= H do + begin + I := (L + H) shr 1; + C := CompareStrings(GetItem(I).FString, S); + if C < 0 then + L := I + 1 + else + begin + H := I - 1; + if C = 0 then + begin + Result := True; + if Duplicates <> dupAccept then + L := I; + end; + end; + end; + Index := L; + end + else + begin + Index := IndexOf(S); + Result := Index <> -1; + end; +end; + +function TJclWideStringList.GetCapacity: Integer; +begin + Result := FList.Capacity; +end; + +function TJclWideStringList.GetCount: Integer; +begin + Result := FList.Count; +end; + +function TJclWideStringList.GetItem(Index: Integer): PWStringItem; +begin + Result := FList[Index]; +end; + +function TJclWideStringList.GetObject(Index: Integer): TObject; +begin + Result := GetItem(Index).FObject; +end; + +function TJclWideStringList.GetP(Index: Integer): PWideString; +begin + Result := Addr(GetItem(Index).FString); +end; + +function TJclWideStringList.IndexOf(const S: WideString): Integer; +begin + if Sorted then + begin + Result := -1; + if not Find(S, Result) then + Result := -1; + end + else + begin + for Result := 0 to Count - 1 do + if CompareStrings(GetItem(Result).FString, S) = 0 then + Exit; + Result := -1; + end; +end; + +procedure TJclWideStringList.InsertObject(Index: Integer; const S: WideString; + AObject: TObject); +var + P: PWStringItem; +begin + if FUpdateCount = 0 then + Changing; + FList.Insert(Index, nil); // error check + P := AllocMem(SizeOf(TWStringItem)); + FList[Index] := P; + + Put(Index, S); + if AObject <> nil then + PutObject(Index, AObject); + if FUpdateCount = 0 then + Changed; +end; + +procedure TJclWideStringList.Put(Index: Integer; const Value: WideString); +begin + if FUpdateCount = 0 then + Changing; + GetItem(Index).FString := Value; + if FUpdateCount = 0 then + Changed; +end; + +procedure TJclWideStringList.PutObject(Index: Integer; AObject: TObject); +begin + if FUpdateCount = 0 then + Changing; + GetItem(Index).FObject := AObject; + if FUpdateCount = 0 then + Changed; +end; + +procedure TJclWideStringList.SetCapacity(NewCapacity: Integer); +begin + FList.Capacity := NewCapacity; +end; + +procedure TJclWideStringList.SetCaseSensitive(const Value: Boolean); +begin + if Value <> FCaseSensitive then + begin + FCaseSensitive := Value; + if Sorted then + begin + Sorted := False; + Sorted := True; // re-sort + end; + end; +end; + +procedure TJclWideStringList.SetSorted(Value: Boolean); +begin + if Value <> FSorted then + begin + FSorted := Value; + if FSorted then + begin + FSorted := False; + Sort; + FSorted := True; + end; + end; +end; + +procedure TJclWideStringList.SetUpdateState(Updating: Boolean); +begin + if Updating then + Changing + else + Changed; +end; + +function DefaultSort(List: TJclWideStringList; Index1, Index2: Integer): Integer; +begin + Result := List.CompareStrings(List.GetItem(Index1).FString, List.GetItem(Index2).FString); +end; + +procedure TJclWideStringList.Sort; +begin + if not Sorted then + CustomSort(DefaultSort); +end; + +{$ENDIF ~SUPPORTS_UNICODE} + +function StringsToMultiSz(var Dest: PWideMultiSz; const Source: TJclWideStrings): PWideMultiSz; +var + I, TotalLength: Integer; + P: PWideMultiSz; +begin + Assert(Source <> nil); + TotalLength := 1; + for I := 0 to Source.Count - 1 do + if Source[I] = '' then + raise EJclWideStringError.CreateRes(@RsInvalidEmptyStringItem) + else + Inc(TotalLength, StrLenW(PWideChar(Source[I])) + 1); + AllocateMultiSz(Dest, TotalLength); + P := Dest; + for I := 0 to Source.Count - 1 do + begin + P := StrECopyW(P, PWideChar(Source[I])); + Inc(P); + end; + P^:= #0; + Result := Dest; +end; + +procedure MultiSzToStrings(const Dest: TJclWideStrings; const Source: PWideMultiSz); +var + P: PWideMultiSz; +begin + Assert(Dest <> nil); + Dest.BeginUpdate; + try + Dest.Clear; + if Source <> nil then + begin + P := Source; + while P^ <> #0 do + begin + Dest.Add(P); + P := StrEndW(P); + Inc(P); + end; + end; + finally + Dest.EndUpdate; + end; +end; + +function MultiSzLength(const Source: PWideMultiSz): SizeInt; +var + P: PWideMultiSz; +begin + Result := 0; + if Source <> nil then + begin + P := Source; + repeat + Inc(Result, StrLenW(P) + 1); + P := StrEndW(P); + Inc(P); + until P^ = #0; + Inc(Result); + end; +end; + +procedure AllocateMultiSz(var Dest: PWideMultiSz; Len: SizeInt); +begin + if Len > 0 then + GetMem(Dest, Len * SizeOf(WideChar)) + else + Dest := nil; +end; + +procedure FreeMultiSz(var Dest: PWideMultiSz); +begin + if Dest <> nil then + FreeMem(Dest); + Dest := nil; +end; + +function MultiSzDup(const Source: PWideMultiSz): PWideMultiSz; +var + Len: Integer; +begin + if Source <> nil then + begin + Len := MultiSzLength(Source); + Result := nil; + AllocateMultiSz(Result, Len); + Move(Source^, Result^, Len * SizeOf(WideChar)); + end + else + Result := nil; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/bzip2.pas b/3rdParty/JCL/source/common/bzip2.pas new file mode 100644 index 00000000..cc2870e9 --- /dev/null +++ b/3rdParty/JCL/source/common/bzip2.pas @@ -0,0 +1,524 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is bzip2.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet. } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. } +{ Portions created by Julian Seward are Copyright (C) 1996-2006 Julian Seward } +{ } +{ Contributor(s): } +{ } +{ The latest release of BZIP2 is available from http://www.bzip.org/ } +{ } +{**************************************************************************************************} +{ } +{ Header conversion of bzlib.h } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit bzip2; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclBase, + JclSysUtils; + +//DOM-IGNORE-BEGIN + +{ +/*-------------------------------------------------------------*/ +/*--- Public header file for the library. ---*/ +/*--- bzlib.h ---*/ +/*-------------------------------------------------------------*/ + +/* ------------------------------------------------------------------ + This file is part of bzip2/libbzip2, a program and library for + lossless, block-sorting data compression. + + bzip2/libbzip2 version 1.0.4 of 20 December 2006 + Copyright (C) 1996-2006 Julian Seward + + Please read the WARNING, DISCLAIMER and PATENTS sections in the + README file. + + This program is released under the terms of the license contained + in the file LICENSE. + ------------------------------------------------------------------ */ +} + +const + BZ_RUN = 0; + BZ_FLUSH = 1; + BZ_FINISH = 2; + + BZ_OK = 0; + BZ_RUN_OK = 1; + BZ_FLUSH_OK = 2; + BZ_FINISH_OK = 3; + BZ_STREAM_END = 4; + BZ_SEQUENCE_ERROR = -1; + BZ_PARAM_ERROR = -2; + BZ_MEM_ERROR = -3; + BZ_DATA_ERROR = -4; + BZ_DATA_ERROR_MAGIC = -5; + BZ_IO_ERROR = -6; + BZ_UNEXPECTED_EOF = -7; + BZ_OUTBUFF_FULL = -8; + BZ_CONFIG_ERROR = -9; + +type + bz_stream = record + next_in: PByte; + avail_in: Cardinal; + total_in_lo32: Cardinal; + total_in_hi32: Cardinal; + + next_out: PByte; + avail_out: Cardinal; + total_out_lo32: Cardinal; + total_out_hi32: Cardinal; + + state: Pointer; + + bzalloc: function (opaque: Pointer; n, m: Integer): Pointer; cdecl; // returns n*m bytes + bzfree: procedure (opaque, p: Pointer); cdecl; // free p + opaque: Pointer; + end; + +{$IFNDEF BZIP2_LINKONREQUEST} +//-- Core (low-level) library functions -- + +function BZ2_bzCompressInit(var strm: bz_stream; + blockSize100k, verbosity, workFactor: Integer): Integer; + {$IFDEF BZIP2_EXPORT_STDCALL}stdcall;{$ENDIF BZIP2_EXPORT_STDCALL} + {$IFDEF BZIP2_EXPORT_CDECL}cdecl;{$ENDIF BZIP2_EXPORT_CDECL} + +function BZ2_bzCompress(var strm: bz_stream; action: Integer): Integer; + {$IFDEF BZIP2_EXPORT_STDCALL}stdcall;{$ENDIF BZIP2_EXPORT_STDCALL} + {$IFDEF BZIP2_EXPORT_CDECL}cdecl;{$ENDIF BZIP2_EXPORT_CDECL} + +function BZ2_bzCompressEnd(var strm: bz_stream): Integer; + {$IFDEF BZIP2_EXPORT_STDCALL}stdcall;{$ENDIF BZIP2_EXPORT_STDCALL} + {$IFDEF BZIP2_EXPORT_CDECL}cdecl;{$ENDIF BZIP2_EXPORT_CDECL} + +function BZ2_bzDecompressInit(var strm: bz_stream; + verbosity, small: Integer): Integer; + {$IFDEF BZIP2_EXPORT_STDCALL}stdcall;{$ENDIF BZIP2_EXPORT_STDCALL} + {$IFDEF BZIP2_EXPORT_CDECL}cdecl;{$ENDIF BZIP2_EXPORT_CDECL} + +function BZ2_bzDecompress(var strm: bz_stream): Integer; + {$IFDEF BZIP2_EXPORT_STDCALL}stdcall;{$ENDIF BZIP2_EXPORT_STDCALL} + {$IFDEF BZIP2_EXPORT_CDECL}cdecl;{$ENDIF BZIP2_EXPORT_CDECL} + +function BZ2_bzDecompressEnd(var strm: bz_stream): Integer; + {$IFDEF BZIP2_EXPORT_STDCALL}stdcall;{$ENDIF BZIP2_EXPORT_STDCALL} + {$IFDEF BZIP2_EXPORT_CDECL}cdecl;{$ENDIF BZIP2_EXPORT_CDECL} + +//-- High(er) level library functions -- + +type + BZFILE = Pointer; + +// TODO: no stdio for static link (problems while linking stdin/stdout/stderr) + +{#ifndef BZ_NO_STDIO +#define BZ_MAX_UNUSED 5000 + +typedef void BZFILE; + +BZ_EXTERN BZFILE* BZ_API(BZ2_bzReadOpen) ( + int* bzerror, + FILE* f, + int verbosity, + int small, + void* unused, + int nUnused + ); + +BZ_EXTERN void BZ_API(BZ2_bzReadClose) ( + int* bzerror, + BZFILE* b + ); + +BZ_EXTERN void BZ_API(BZ2_bzReadGetUnused) ( + int* bzerror, + BZFILE* b, + void** unused, + int* nUnused + ); + +BZ_EXTERN int BZ_API(BZ2_bzRead) ( + int* bzerror, + BZFILE* b, + void* buf, + int len + ); + +BZ_EXTERN BZFILE* BZ_API(BZ2_bzWriteOpen) ( + int* bzerror, + FILE* f, + int blockSize100k, + int verbosity, + int workFactor + ); + +BZ_EXTERN void BZ_API(BZ2_bzWrite) ( + int* bzerror, + BZFILE* b, + void* buf, + int len + ); + +BZ_EXTERN void BZ_API(BZ2_bzWriteClose) ( + int* bzerror, + BZFILE* b, + int abandon, + unsigned int* nbytes_in, + unsigned int* nbytes_out + ); + +BZ_EXTERN void BZ_API(BZ2_bzWriteClose64) ( + int* bzerror, + BZFILE* b, + int abandon, + unsigned int* nbytes_in_lo32, + unsigned int* nbytes_in_hi32, + unsigned int* nbytes_out_lo32, + unsigned int* nbytes_out_hi32 + ); +#endif} + + +//- Utility functions -- + +function BZ2_bzBuffToBuffCompress(dest: PByte; destLen: PCardinal; source: PByte; + sourceLen: Cardinal; blockSize100k, verbosity, workFactor: Integer): Integer; + {$IFDEF BZIP2_EXPORT_STDCALL}stdcall;{$ENDIF BZIP2_EXPORT_STDCALL} + {$IFDEF BZIP2_EXPORT_CDECL}cdecl;{$ENDIF BZIP2_EXPORT_CDECL} + +function BZ2_bzBuffToBuffDecompress(dest: PByte; destLen: PCardinal; source: PByte; + sourceLen: Cardinal; small, verbosity: Integer): Integer; + {$IFDEF BZIP2_EXPORT_STDCALL}stdcall;{$ENDIF BZIP2_EXPORT_STDCALL} + {$IFDEF BZIP2_EXPORT_CDECL}cdecl;{$ENDIF BZIP2_EXPORT_CDECL} + +{ +/*-- + Code contributed by Yoshioka Tsuneo (tsuneo@rr.iij4u.or.jp) + to support better zlib compatibility. + This code is not _officially_ part of libbzip2 (yet); + I haven't tested it, documented it, or considered the + threading-safeness of it. + If this code breaks, please contact both Yoshioka and me. +--*/ +} + +function BZ2_bzlibVersion: PAnsiChar; + {$IFDEF BZIP2_EXPORT_STDCALL}stdcall;{$ENDIF BZIP2_EXPORT_STDCALL} + {$IFDEF BZIP2_EXPORT_CDECL}cdecl;{$ENDIF BZIP2_EXPORT_CDECL} + +// no STDIO (see above) +{ +function BZ2_bzopen(path, mode: PChar): BZFILE; + +function BZ2_bzdopen(fd: Integer; mode: PChar): BZFILE; + +function BZ2_bzread(b: BZFILE; buf: Pointer; len: Integer): Integer; + +function BZ2_bzwrite(b: BZFILE; buf: Pointer; len: Integer): Integer; + +function BZ2_bzflush(b: BZFILE): Integer; + +procedure BZ2_bzclose(b: BZFILE); + +function BZ2_bzerror(b: BZFILE; errnum: PInteger): PChar; +} + +{$ELSE BZIP2_LINKONREQUEST} +type + BZ2_bzCompressInit_func = function(var strm: bz_stream; + blockSize100k, verbosity, workFactor: Integer): Integer; + {$IFDEF BZIP2_EXPORT_STDCALL}stdcall;{$ENDIF BZIP2_EXPORT_STDCALL} + {$IFDEF BZIP2_EXPORT_CDECL}cdecl;{$ENDIF BZIP2_EXPORT_CDECL} + BZ2_bzCompress_func = function(var strm: bz_stream; + action: Integer): Integer; + {$IFDEF BZIP2_EXPORT_STDCALL}stdcall;{$ENDIF BZIP2_EXPORT_STDCALL} + {$IFDEF BZIP2_EXPORT_CDECL}cdecl;{$ENDIF BZIP2_EXPORT_CDECL} + BZ2_bzCompressEnd_func = function(var strm: bz_stream): Integer; + {$IFDEF BZIP2_EXPORT_STDCALL}stdcall;{$ENDIF BZIP2_EXPORT_STDCALL} + {$IFDEF BZIP2_EXPORT_CDECL}cdecl;{$ENDIF BZIP2_EXPORT_CDECL} + BZ2_bzDecompressInit_func = function(var strm: bz_stream; + verbosity, small: Integer): Integer; + {$IFDEF BZIP2_EXPORT_STDCALL}stdcall;{$ENDIF BZIP2_EXPORT_STDCALL} + {$IFDEF BZIP2_EXPORT_CDECL}cdecl;{$ENDIF BZIP2_EXPORT_CDECL} + BZ2_bzDecompress_func = function(var strm: bz_stream): Integer; + {$IFDEF BZIP2_EXPORT_STDCALL}stdcall;{$ENDIF BZIP2_EXPORT_STDCALL} + {$IFDEF BZIP2_EXPORT_CDECL}cdecl;{$ENDIF BZIP2_EXPORT_CDECL} + BZ2_bzDecompressEnd_func = function(var strm: bz_stream): Integer; + {$IFDEF BZIP2_EXPORT_STDCALL}stdcall;{$ENDIF BZIP2_EXPORT_STDCALL} + {$IFDEF BZIP2_EXPORT_CDECL}cdecl;{$ENDIF BZIP2_EXPORT_CDECL} + BZ2_bzBuffToBuffCompress_func = function(dest: PByte; destLen: PCardinal; + source: PByte; sourceLen: Cardinal; + blockSize100k, verbosity, workFactor: Integer): Integer; + {$IFDEF BZIP2_EXPORT_STDCALL}stdcall;{$ENDIF BZIP2_EXPORT_STDCALL} + {$IFDEF BZIP2_EXPORT_CDECL}cdecl;{$ENDIF BZIP2_EXPORT_CDECL} + BZ2_bzBuffToBuffDecompress_func = function(dest: PByte; destLen: PCardinal; + source: PByte; sourceLen: Cardinal; small, verbosity: Integer): Integer; + {$IFDEF BZIP2_EXPORT_STDCALL}stdcall;{$ENDIF BZIP2_EXPORT_STDCALL} + {$IFDEF BZIP2_EXPORT_CDECL}cdecl;{$ENDIF BZIP2_EXPORT_CDECL} + BZ2_bzlibVersion_func = function: PAnsiChar; + {$IFDEF BZIP2_EXPORT_STDCALL}stdcall;{$ENDIF BZIP2_EXPORT_STDCALL} + {$IFDEF BZIP2_EXPORT_CDECL}cdecl;{$ENDIF BZIP2_EXPORT_CDECL} + +var + BZ2_bzCompressInit: BZ2_bzCompressInit_func = nil; + BZ2_bzCompress: BZ2_bzCompress_func = nil; + BZ2_bzCompressEnd: BZ2_bzCompressEnd_func = nil; + BZ2_bzDecompressInit: BZ2_bzDecompressInit_func = nil; + BZ2_bzDecompress: BZ2_bzDecompress_func = nil; + BZ2_bzDecompressEnd: BZ2_bzDecompressEnd_func = nil; + BZ2_bzBuffToBuffCompress: BZ2_bzBuffToBuffCompress_func = nil; + BZ2_bzBuffToBuffDecompress: BZ2_bzBuffToBuffDecompress_func = nil; + BZ2_bzlibVersion: BZ2_bzlibVersion_func = nil; +{$ENDIF BZIP2_LINKONREQUEST} + +var + bz2_internal_error_event: procedure(errcode: Integer) of object = nil; + +//DOM-IGNORE-END + +const + {$IFDEF MSWINDOWS} + BZip2DefaultLibraryName = 'bzip2.dll'; // from http://gnuwin32.sourceforge.net/ + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + BZip2DefaultLibraryName = 'libbz2.so.1'; + {$ENDIF UNIX} + BZip2CompressInitDefaultExportName = 'BZ2_bzCompressInit'; + BZip2CompressDefaultExportName = 'BZ2_bzCompress'; + BZip2CompressEndDefaultExportName = 'BZ2_bzCompressEnd'; + BZip2DecompressInitDefaultExportName = 'BZ2_bzDecompressInit'; + BZip2DecompressDefaultExportName = 'BZ2_bzDecompress'; + BZip2DecompressEndDefaultExportName = 'BZ2_bzDecompressEnd'; + BZip2BuffToBuffCompressDefaultExportName = 'BZ2_bzBuffToBuffCompress'; + BZip2BuffToBuffDecompressDefaultExportName = 'BZ2_bzBuffToBuffDecompress'; + BZip2LibVersionDefaultExportName = 'BZ2_bzlibVersion'; + +{$IFDEF BZIP2_LINKONREQUEST} +var + BZip2LibraryName: string = BZip2DefaultLibraryName; + BZip2CompressInitExportName: string = BZip2CompressInitDefaultExportName; + BZip2CompressExportName: string = BZip2CompressDefaultExportName; + BZip2CompressEndExportName: string = BZip2CompressEndDefaultExportName; + BZip2DecompressInitExportName: string = BZip2DecompressInitDefaultExportName; + BZip2DecompressExportName: string = BZip2DecompressDefaultExportName; + BZip2DecompressEndExportName: string = BZip2DecompressEndDefaultExportName; + BZip2BuffToBuffCompressExportName: string = BZip2BuffToBuffCompressDefaultExportName; + BZip2BuffToBuffDecompressExportName: string = BZip2BuffToBuffDecompressDefaultExportName; + BZip2LibVersionExportName: string = BZip2LibVersionDefaultExportName; + BZip2LibraryHandle: TModuleHandle = INVALID_MODULEHANDLE_VALUE; +{$ENDIF BZIP2_LINKONREQUEST} + +function LoadBZip2: Boolean; +function IsBZip2Loaded: Boolean; +procedure UnloadBZip2; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + {$IFDEF BZIP2_LINKONREQUEST} + {$IFDEF MSWINDOWS} + Winapi.Windows, + {$ENDIF MSWINDOWS} + {$ENDIF BZIP2_LINKONREQUEST} + System.Types, + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF BZIP2_LINKONREQUEST} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + {$ENDIF BZIP2_LINKONREQUEST} + Types, + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +{$IFDEF BZIP2_STATICLINK} +function BZ2_bzCompressInit; external; +function BZ2_bzCompress; external; +function BZ2_bzCompressEnd; external; +function BZ2_bzDecompressInit; external; +function BZ2_bzDecompress; external; +function BZ2_bzDecompressEnd; external; +function BZ2_bzBuffToBuffCompress; external; +function BZ2_bzBuffToBuffDecompress; external; +function BZ2_bzlibVersion; external; +// workaround to make the compiler aware of _BZ2_indexIntoF +// an external must be declared for this function in order to make the compiler considering +// the corresponding PUBDEF in bzlib.obj +// source: CodeGear QA team +{$IFDEF CPU32} +function _BZ2_indexIntoF: Pointer; + {$IFDEF BZIP2_EXPORT_STDCALL}stdcall;{$ENDIF BZIP2_EXPORT_STDCALL} + {$IFDEF BZIP2_EXPORT_CDECL}cdecl;{$ENDIF BZIP2_EXPORT_CDECL} external; +{$ENDIF CPU32} +{$IFDEF CPU64} +function BZ2_indexIntoF: Pointer; external; +{$ENDIF CPU64} + +{$IFDEF CPU32} +{$LINK ..\windows\obj\bzip2\win32\bzlib.obj} +{$LINK ..\windows\obj\bzip2\win32\randtable.obj} +{$LINK ..\windows\obj\bzip2\win32\crctable.obj} +{$LINK ..\windows\obj\bzip2\win32\compress.obj} +{$LINK ..\windows\obj\bzip2\win32\decompress.obj} +{$LINK ..\windows\obj\bzip2\win32\huffman.obj} +{$LINK ..\windows\obj\bzip2\win32\blocksort.obj} +{$ENDIF CPU32} +{$IFDEF CPU64} +{$LINK ..\windows\obj\bzip2\win64\bzlib.obj} +{$LINK ..\windows\obj\bzip2\win64\randtable.obj} +{$LINK ..\windows\obj\bzip2\win64\crctable.obj} +{$LINK ..\windows\obj\bzip2\win64\compress.obj} +{$LINK ..\windows\obj\bzip2\win64\decompress.obj} +{$LINK ..\windows\obj\bzip2\win64\huffman.obj} +{$LINK ..\windows\obj\bzip2\win64\blocksort.obj} +{$ENDIF CPU64} + +{$IFDEF CPU32} +function _malloc(size: Longint): Pointer; cdecl; +{$ENDIF CPU32} +{$IFDEF CPU64} +function malloc(size: SizeInt): Pointer; +{$ENDIF CPU64} +begin + GetMem(Result, Size); +end; + +{$IFDEF CPU32} +procedure _free(pBlock: Pointer); cdecl; +{$ENDIF CPU32} +{$IFDEF CPU64} +procedure free(pBlock: Pointer); +{$ENDIF CPU64} +begin + FreeMem(pBlock); +end; + +{$IFDEF CPU32} +procedure _bz_internal_error(errcode: Integer); cdecl; +{$ENDIF CPU32} +{$IFDEF CPU64} +procedure bz_internal_error(errcode: Integer); +{$ENDIF CPU64} +begin + if Assigned(bz2_internal_error_event) then + bz2_internal_error_event(errcode); +end; + +{$ENDIF BZIP2_STATICLINK} + +{$IFDEF BZIP2_LINKDLL} +function BZ2_bzCompressInit; external BZip2DefaultLibraryName name BZip2CompressInitDefaultExportName; +function BZ2_bzCompress; external BZip2DefaultLibraryName name BZip2CompressDefaultExportName; +function BZ2_bzCompressEnd; external BZip2DefaultLibraryName name BZip2CompressEndDefaultExportName; +function BZ2_bzDecompressInit; external BZip2DefaultLibraryName name BZip2DecompressInitDefaultExportName; +function BZ2_bzDecompress; external BZip2DefaultLibraryName name BZip2DecompressDefaultExportName; +function BZ2_bzDecompressEnd; external BZip2DefaultLibraryName name BZip2DecompressEndDefaultExportName; +function BZ2_bzBuffToBuffCompress; external BZip2DefaultLibraryName name BZip2BuffToBuffCompressDefaultExportName; +function BZ2_bzBuffToBuffDecompress; external BZip2DefaultLibraryName name BZip2BuffToBuffDecompressDefaultExportName; +function BZ2_bzlibVersion; external BZip2DefaultLibraryName name BZip2LibVersionDefaultExportName; +{$ENDIF BZIP2_LINKDLL} + +function LoadBZip2: Boolean; +{$IFDEF BZIP2_LINKONREQUEST} +begin + Result := BZip2LibraryHandle <> INVALID_MODULEHANDLE_VALUE; + if Result then + Exit; + + Result := JclSysUtils.LoadModule(BZip2LibraryHandle, BZip2LibraryName); + if Result then + begin + @BZ2_bzCompressInit := GetModuleSymbol(BZip2LibraryHandle, BZip2CompressInitExportName); + @BZ2_bzCompress := GetModuleSymbol(BZip2LibraryHandle, BZip2CompressExportName); + @BZ2_bzCompressEnd := GetModuleSymbol(BZip2LibraryHandle, BZip2CompressEndExportName); + @BZ2_bzDecompressInit := GetModuleSymbol(BZip2LibraryHandle, BZip2DecompressInitExportName); + @BZ2_bzDecompress := GetModuleSymbol(BZip2LibraryHandle, BZip2DecompressExportName); + @BZ2_bzDecompressEnd := GetModuleSymbol(BZip2LibraryHandle, BZip2DecompressEndExportName); + @BZ2_bzBuffToBuffCompress := GetModuleSymbol(BZip2LibraryHandle, BZip2BuffToBuffCompressExportName); + @BZ2_bzBuffToBuffDecompress := GetModuleSymbol(BZip2LibraryHandle, BZip2BuffToBuffDecompressExportName); + @BZ2_bzlibVersion := GetModuleSymbol(BZip2LibraryHandle, BZip2LibVersionExportName); + end; +end; +{$ELSE ~BZIP2_LINKONREQUEST} +begin + Result := True; +end; +{$ENDIF ~BZIP2_LINKONREQUEST} + +function IsBZip2Loaded: Boolean; +begin + {$IFDEF BZIP2_LINKONREQUEST} + Result := BZip2LibraryHandle <> INVALID_MODULEHANDLE_VALUE; + {$ELSE ~BZIP2_LINKONREQUEST} + Result := True; + {$ENDIF ~BZIP2_LINKONREQUEST} +end; + +procedure UnloadBZip2; +begin + {$IFDEF BZIP2_LINKONREQUEST} + JclSysUtils.UnloadModule(BZip2LibraryHandle); + {$ENDIF BZIP2_LINKONREQUEST} +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/common/dirinfo.txt b/3rdParty/JCL/source/common/dirinfo.txt new file mode 100644 index 00000000..f3b0ae3f --- /dev/null +++ b/3rdParty/JCL/source/common/dirinfo.txt @@ -0,0 +1 @@ +This is the directory where cross platform code resides. \ No newline at end of file diff --git a/3rdParty/JCL/source/common/pcre.pas b/3rdParty/JCL/source/common/pcre.pas index ea2e9dfc..730964ce 100644 --- a/3rdParty/JCL/source/common/pcre.pas +++ b/3rdParty/JCL/source/common/pcre.pas @@ -1,2869 +1,2868 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is JclPRCE.pas. } -{ } -{ The Initial Developer of the Original Code is Peter Thornqvist. } -{ Portions created by Peter Thornqvist are Copyright (C) of Peter Thornqvist. All rights reserved. } -{ Portions created by University of Cambridge are } -{ Copyright (C) 1997-2001 by University of Cambridge. } -{ } -{ Contributor(s): } -{ Robert Rossmair (rrossmair) } -{ Mario R. Carro } -{ Florent Ouchet (outchy) } -{ } -{ The latest release of PCRE is always available from } -{ ftp://ftp.csx.cam.ac.uk/pub/software/programming/pcre/pcre-xxx.tar.gz } -{ } -{**************************************************************************************************} -{ } -{ Header conversion of pcre.h } -{ } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -unit pcre; - -{$I jcl.inc} - -interface - -uses - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - JclBase, - JclSysUtils; - -//DOM-IGNORE-BEGIN - -{$IFNDEF PCRE_RTL} - -(************************************************* -* Perl-Compatible Regular Expressions * -*************************************************) - -{$IFDEF SUPPORTS_WEAKPACKAGEUNIT} - {$IFDEF UNITVERSIONING} - {$WEAKPACKAGEUNIT OFF} - {$ELSE ~UNITVERSIONING} - // d6 and d7 consider initialized variables to be initialization parts which goes against the "weakpackageunit" requirement - {$IF Defined(PCRE_LINKONREQUEST) and not Defined(COMPILER8_UP)} - {$WEAKPACKAGEUNIT OFF} - {$ELSE} - {$WEAKPACKAGEUNIT ON} - {$IFEND} - {$ENDIF ~UNITVERSIONING} -{$ENDIF SUPPORTS_WEAKPACKAGEUNIT} - -// (p3) this is the switch to change between static and dynamic linking. -// It is set to dynamic by default. To disable simply insert a '.' before the '$' -// -// NOTE: if you enable static linking of DLL, this means that the pcre.dll *must* -// be in the users path or an AV will occur at startup - -(*$HPPEMIT '#include "pcre.h"'*) - -const - MAX_PATTERN_LENGTH = $10003; - {$EXTERNALSYM MAX_PATTERN_LENGTH} - MAX_QUANTIFY_REPEAT = $10000; - {$EXTERNALSYM MAX_QUANTIFY_REPEAT} - MAX_CAPTURE_COUNT = $FFFF; - {$EXTERNALSYM MAX_CAPTURE_COUNT} - MAX_NESTING_DEPTH = 200; - {$EXTERNALSYM MAX_NESTING_DEPTH} - -const - (* Options *) - PCRE_CASELESS = $00000001; - {$EXTERNALSYM PCRE_CASELESS} - PCRE_MULTILINE = $00000002; - {$EXTERNALSYM PCRE_MULTILINE} - PCRE_DOTALL = $00000004; - {$EXTERNALSYM PCRE_DOTALL} - PCRE_EXTENDED = $00000008; - {$EXTERNALSYM PCRE_EXTENDED} - PCRE_ANCHORED = $00000010; - {$EXTERNALSYM PCRE_ANCHORED} - PCRE_DOLLAR_ENDONLY = $00000020; - {$EXTERNALSYM PCRE_DOLLAR_ENDONLY} - PCRE_EXTRA = $00000040; - {$EXTERNALSYM PCRE_EXTRA} - PCRE_NOTBOL = $00000080; - {$EXTERNALSYM PCRE_NOTBOL} - PCRE_NOTEOL = $00000100; - {$EXTERNALSYM PCRE_NOTEOL} - PCRE_UNGREEDY = $00000200; - {$EXTERNALSYM PCRE_UNGREEDY} - PCRE_NOTEMPTY = $00000400; - {$EXTERNALSYM PCRE_NOTEMPTY} - PCRE_UTF8 = $00000800; - {$EXTERNALSYM PCRE_UTF8} - PCRE_UTF16 = $00000800; - {$EXTERNALSYM PCRE_UTF16} - PCRE_NO_AUTO_CAPTURE = $00001000; - {$EXTERNALSYM PCRE_NO_AUTO_CAPTURE} - PCRE_NO_UTF8_CHECK = $00002000; - {$EXTERNALSYM PCRE_NO_UTF8_CHECK} - PCRE_NO_UTF16_CHECK = $00002000; - {$EXTERNALSYM PCRE_NO_UTF16_CHECK} - PCRE_AUTO_CALLOUT = $00004000; - {$EXTERNALSYM PCRE_AUTO_CALLOUT} - PCRE_PARTIAL_SOFT = $00008000; - {$EXTERNALSYM PCRE_PARTIAL_SOFT} - PCRE_PARTIAL = PCRE_PARTIAL_SOFT; // Backwards compatible synonym - {$EXTERNALSYM PCRE_PARTIAL} - PCRE_DFA_SHORTEST = $00010000; - {$EXTERNALSYM PCRE_DFA_SHORTEST} - PCRE_DFA_RESTART = $00020000; - {$EXTERNALSYM PCRE_DFA_RESTART} - PCRE_FIRSTLINE = $00040000; - {$EXTERNALSYM PCRE_FIRSTLINE} - PCRE_DUPNAMES = $00080000; - {$EXTERNALSYM PCRE_DUPNAMES} - PCRE_NEWLINE_CR = $00100000; - {$EXTERNALSYM PCRE_NEWLINE_CR} - PCRE_NEWLINE_LF = $00200000; - {$EXTERNALSYM PCRE_NEWLINE_LF} - PCRE_NEWLINE_CRLF = $00300000; - {$EXTERNALSYM PCRE_NEWLINE_CRLF} - PCRE_NEWLINE_ANY = $00400000; - {$EXTERNALSYM PCRE_NEWLINE_ANY} - PCRE_NEWLINE_ANYCRLF = $00500000; - {$EXTERNALSYM PCRE_NEWLINE_ANYCRLF} - PCRE_BSR_ANYCRLF = $00800000; - {$EXTERNALSYM PCRE_BSR_ANYCRLF} - PCRE_BSR_UNICODE = $01000000; - {$EXTERNALSYM PCRE_BSR_UNICODE} - PCRE_JAVASCRIPT_COMPAT = $02000000; - {$EXTERNALSYM PCRE_JAVASCRIPT_COMPAT} - PCRE_NO_START_OPTIMIZE = $04000000; - {$EXTERNALSYM PCRE_NO_START_OPTIMIZE} - PCRE_NO_START_OPTIMISE = $04000000; - {$EXTERNALSYM PCRE_NO_START_OPTIMISE} - PCRE_PARTIAL_HARD = $08000000; - {$EXTERNALSYM PCRE_PARTIAL_HARD} - PCRE_NOTEMPTY_ATSTART = $10000000; - {$EXTERNALSYM PCRE_NOTEMPTY_ATSTART} - PCRE_UCP = $20000000; - {$EXTERNALSYM PCRE_UCP} - - (* Exec-time and get-time error codes *) - - PCRE_ERROR_NOMATCH = -1; - {$EXTERNALSYM PCRE_ERROR_NOMATCH} - PCRE_ERROR_NULL = -2; - {$EXTERNALSYM PCRE_ERROR_NULL} - PCRE_ERROR_BADOPTION = -3; - {$EXTERNALSYM PCRE_ERROR_BADOPTION} - PCRE_ERROR_BADMAGIC = -4; - {$EXTERNALSYM PCRE_ERROR_BADMAGIC} - PCRE_ERROR_UNKNOWN_NODE = -5; - {$EXTERNALSYM PCRE_ERROR_UNKNOWN_NODE} - PCRE_ERROR_NOMEMORY = -6; - {$EXTERNALSYM PCRE_ERROR_NOMEMORY} - PCRE_ERROR_NOSUBSTRING = -7; - {$EXTERNALSYM PCRE_ERROR_NOSUBSTRING} - PCRE_ERROR_MATCHLIMIT = -8; - {$EXTERNALSYM PCRE_ERROR_MATCHLIMIT} - PCRE_ERROR_CALLOUT = -9; (* Never used by PCRE itself *) - {$EXTERNALSYM PCRE_ERROR_CALLOUT} - PCRE_ERROR_BADUTF8 = -10; - {$EXTERNALSYM PCRE_ERROR_BADUTF8} - PCRE_ERROR_BADUTF16 = -10; - {$EXTERNALSYM PCRE_ERROR_BADUTF16} - PCRE_ERROR_BADUTF8_OFFSET = -11; - {$EXTERNALSYM PCRE_ERROR_BADUTF8_OFFSET} - PCRE_ERROR_BADUTF16_OFFSET = -11; - {$EXTERNALSYM PCRE_ERROR_BADUTF16_OFFSET} - PCRE_ERROR_PARTIAL = -12; - {$EXTERNALSYM PCRE_ERROR_PARTIAL} - PCRE_ERROR_BADPARTIAL = -13; - {$EXTERNALSYM PCRE_ERROR_BADPARTIAL} - PCRE_ERROR_INTERNAL = -14; - {$EXTERNALSYM PCRE_ERROR_INTERNAL} - PCRE_ERROR_BADCOUNT = -15; - {$EXTERNALSYM PCRE_ERROR_BADCOUNT} - PCRE_ERROR_DFA_UITEM = -16; - {$EXTERNALSYM PCRE_ERROR_DFA_UITEM} - PCRE_ERROR_DFA_UCOND = -17; - {$EXTERNALSYM PCRE_ERROR_DFA_UCOND} - PCRE_ERROR_DFA_UMLIMIT = -18; - {$EXTERNALSYM PCRE_ERROR_DFA_UMLIMIT} - PCRE_ERROR_DFA_WSSIZE = -19; - {$EXTERNALSYM PCRE_ERROR_DFA_WSSIZE} - PCRE_ERROR_DFA_RECURSE = -20; - {$EXTERNALSYM PCRE_ERROR_DFA_RECURSE} - PCRE_ERROR_RECURSIONLIMIT = -21; - {$EXTERNALSYM PCRE_ERROR_RECURSIONLIMIT} - PCRE_ERROR_NULLWSLIMIT = -22; (* No longer actually used *) - {$EXTERNALSYM PCRE_ERROR_NULLWSLIMIT} - PCRE_ERROR_BADNEWLINE = -23; - {$EXTERNALSYM PCRE_ERROR_BADNEWLINE} - PCRE_ERROR_BADOFFSET = -24; - {$EXTERNALSYM PCRE_ERROR_BADOFFSET} - PCRE_ERROR_SHORTUTF8 = -25; - {$EXTERNALSYM PCRE_ERROR_SHORTUTF8} - PCRE_ERROR_SHORTUTF16 = -25; - {$EXTERNALSYM PCRE_ERROR_SHORTUTF16} - PCRE_ERROR_RECURSELOOP = -26; - {$EXTERNALSYM PCRE_ERROR_RECURSELOOP} - PCRE_ERROR_JITSTACKLIMIT = -27; - {$EXTERNALSYM PCRE_ERROR_JITSTACKLIMIT} - PCRE_ERROR_BADMODE = -28; - {$EXTERNALSYM PCRE_ERROR_BADMODE} - PCRE_ERROR_BADENDIANNESS = -29; - {$EXTERNALSYM PCRE_ERROR_BADENDIANNESS} - PCRE_ERROR_DFA_BADRESTART = -30; - {$EXTERNALSYM PCRE_ERROR_DFA_BADRESTART} - - (* Specific error codes for UTF-8 validity checks *) - - PCRE_UTF8_ERR0 = 0; - PCRE_UTF8_ERR1 = 1; - PCRE_UTF8_ERR2 = 2; - PCRE_UTF8_ERR3 = 3; - PCRE_UTF8_ERR4 = 4; - PCRE_UTF8_ERR5 = 5; - PCRE_UTF8_ERR6 = 6; - PCRE_UTF8_ERR7 = 7; - PCRE_UTF8_ERR8 = 8; - PCRE_UTF8_ERR9 = 9; - PCRE_UTF8_ERR10 = 10; - PCRE_UTF8_ERR11 = 11; - PCRE_UTF8_ERR12 = 12; - PCRE_UTF8_ERR13 = 13; - PCRE_UTF8_ERR14 = 14; - PCRE_UTF8_ERR15 = 15; - PCRE_UTF8_ERR16 = 16; - PCRE_UTF8_ERR17 = 17; - PCRE_UTF8_ERR18 = 18; - PCRE_UTF8_ERR19 = 19; - PCRE_UTF8_ERR20 = 20; - PCRE_UTF8_ERR21 = 21; - - (* Specific error codes for UTF-16 validity checks *) - - PCRE_UTF16_ERR0 = 0; - PCRE_UTF16_ERR1 = 1; - PCRE_UTF16_ERR2 = 2; - PCRE_UTF16_ERR3 = 3; - PCRE_UTF16_ERR4 = 4; - - (* Request types for pcre_fullinfo() *) - - PCRE_INFO_OPTIONS = 0; - {$EXTERNALSYM PCRE_INFO_OPTIONS} - PCRE_INFO_SIZE = 1; - {$EXTERNALSYM PCRE_INFO_SIZE} - PCRE_INFO_CAPTURECOUNT = 2; - {$EXTERNALSYM PCRE_INFO_CAPTURECOUNT} - PCRE_INFO_BACKREFMAX = 3; - {$EXTERNALSYM PCRE_INFO_BACKREFMAX} - PCRE_INFO_FIRSTCHAR = 4; - {$EXTERNALSYM PCRE_INFO_FIRSTCHAR} - PCRE_INFO_FIRSTTABLE = 5; - {$EXTERNALSYM PCRE_INFO_FIRSTTABLE} - PCRE_INFO_LASTLITERAL = 6; - {$EXTERNALSYM PCRE_INFO_LASTLITERAL} - PCRE_INFO_NAMEENTRYSIZE = 7; - {$EXTERNALSYM PCRE_INFO_NAMEENTRYSIZE} - PCRE_INFO_NAMECOUNT = 8; - {$EXTERNALSYM PCRE_INFO_NAMECOUNT} - PCRE_INFO_NAMETABLE = 9; - {$EXTERNALSYM PCRE_INFO_NAMETABLE} - PCRE_INFO_STUDYSIZE = 10; - {$EXTERNALSYM PCRE_INFO_STUDYSIZE} - PCRE_INFO_DEFAULT_TABLES = 11; - {$EXTERNALSYM PCRE_INFO_DEFAULT_TABLES} - PCRE_INFO_OKPARTIAL = 12; - {$EXTERNALSYM PCRE_INFO_OKPARTIAL} - PCRE_INFO_JCHANGED = 13; - {$EXTERNALSYM PCRE_INFO_JCHANGED} - PCRE_INFO_HASCRORLF = 14; - {$EXTERNALSYM PCRE_INFO_HASCRORLF} - PCRE_INFO_MINLENGTH = 15; - {$EXTERNALSYM PCRE_INFO_MINLENGTH} - PCRE_INFO_JIT = 16; - {$EXTERNALSYM PCRE_INFO_JIT} - PCRE_INFO_JITSIZE = 17; - {$EXTERNALSYM PCRE_INFO_JITSIZE} - PCRE_INFO_MAXLOOKBEHIND = 18; - {$EXTERNALSYM PCRE_INFO_MAXLOOKBEHIND} - - (* Request types for pcre_config() *) - PCRE_CONFIG_UTF8 = 0; - {$EXTERNALSYM PCRE_CONFIG_UTF8} - PCRE_CONFIG_NEWLINE = 1; - {$EXTERNALSYM PCRE_CONFIG_NEWLINE} - PCRE_CONFIG_LINK_SIZE = 2; - {$EXTERNALSYM PCRE_CONFIG_LINK_SIZE} - PCRE_CONFIG_POSIX_MALLOC_THRESHOLD = 3; - {$EXTERNALSYM PCRE_CONFIG_POSIX_MALLOC_THRESHOLD} - PCRE_CONFIG_MATCH_LIMIT = 4; - {$EXTERNALSYM PCRE_CONFIG_MATCH_LIMIT} - PCRE_CONFIG_STACKRECURSE = 5; - {$EXTERNALSYM PCRE_CONFIG_STACKRECURSE} - PCRE_CONFIG_UNICODE_PROPERTIES = 6; - {$EXTERNALSYM PCRE_CONFIG_UNICODE_PROPERTIES} - PCRE_CONFIG_MATCH_LIMIT_RECURSION = 7; - {$EXTERNALSYM PCRE_CONFIG_MATCH_LIMIT_RECURSION} - PCRE_CONFIG_BSR = 8; - {$EXTERNALSYM PCRE_CONFIG_BSR} - PCRE_CONFIG_JIT = 9; - {$EXTERNALSYM PCRE_CONFIG_JIT} - PCRE_CONFIG_UTF16 = 10; - {$EXTERNALSYM PCRE_CONFIG_UTF16} - PCRE_CONFIG_JITTARGET = 11; - {$EXTERNALSYM PCRE_CONFIG_JITTARGET} - - (* Request types for pcre_study() *) - - PCRE_STUDY_JIT_COMPILE = $0001; - PCRE_STUDY_JIT_PARTIAL_SOFT_COMPILE = $0002; - PCRE_STUDY_JIT_PARTIAL_HARD_COMPILE = $0004; - - (* Bit flags for the pcre_extra structure *) - - PCRE_EXTRA_STUDY_DATA = $0001; - {$EXTERNALSYM PCRE_EXTRA_STUDY_DATA} - PCRE_EXTRA_MATCH_LIMIT = $0002; - {$EXTERNALSYM PCRE_EXTRA_MATCH_LIMIT} - PCRE_EXTRA_CALLOUT_DATA = $0004; - {$EXTERNALSYM PCRE_EXTRA_CALLOUT_DATA} - PCRE_EXTRA_TABLES = $0008; - {$EXTERNALSYM PCRE_EXTRA_TABLES} - PCRE_EXTRA_MATCH_LIMIT_RECURSION = $0010; - {$EXTERNALSYM PCRE_EXTRA_MATCH_LIMIT_RECURSION} - PCRE_EXTRA_MARK = $0020; - {$EXTERNALSYM PCRE_EXTRA_MARK} - PCRE_EXTRA_EXECUTABLE_JIT = $0040; - {$EXTERNALSYM PCRE_EXTRA_EXECUTABLE_JIT} - -type - {$IFDEF PCRE_8} - real_pcre = packed record - {magic_number: Longword; - size: Integer; - tables: PAnsiChar; - options: Longword; - top_bracket: Word; - top_backref: word; - first_char: PAnsiChar; - req_char: PAnsiChar; - code: array [0..0] of AnsiChar;} - end; - TPCRE = real_pcre; - PPCRE = ^TPCRE; - {$ENDIF PCRE_8} - - {$IFDEF PCRE_16} - real_pcre16 = packed record - end; - TPCRE16 = real_pcre16; - PPCRE16 = ^TPCRE16; - {$ENDIF PCRE_16} - - {$IFDEF PCRE_8} - real_pcre_jit_stack = packed record - end; - TPCREJITStack = real_pcre_jit_stack; - PPCREJITStack = ^TPCREJITStack; - {$ENDIF PCRE_8} - - {$IFDEF PCRE_16} - real_pcre16_jit_stack = packed record - end; - TPCRE16JITStack = real_pcre16_jit_stack; - PPCRE16JITStack = ^TPCRE16JITStack; - {$ENDIF PCRE_16} - - {$IFDEF PCRE_8} - real_pcre_extra = packed record - flags: Cardinal; (* Bits for which fields are set *) - study_data: Pointer; (* Opaque data from pcre_study() *) - match_limit: Cardinal; (* Maximum number of calls to match() *) - callout_data: Pointer; (* Data passed back in callouts *) - tables: PAnsiChar; (* Pointer to character tables *) - match_limit_recursion: Cardinal; (* Max recursive calls to match() *) - mark: PPAnsiChar; (* For passing back a mark pointer *) - executable_jit: Pointer; (* Contains a pointer to a compiled jit code *) - end; - TPCREExtra = real_pcre_extra; - PPCREExtra = ^TPCREExtra; - {$ENDIF PCRE_8} - - {$IFDEF PCRE_16} - real_pcre16_extra = packed record - flags: Cardinal; (* Bits for which fields are set *) - study_data: Pointer; (* Opaque data from pcre_study() *) - match_limit: Cardinal; (* Maximum number of calls to match() *) - callout_data: Pointer; (* Data passed back in callouts *) - tables: PAnsiChar; (* Pointer to character tables *) - match_limit_recursion: Cardinal; (* Max recursive calls to match() *) - mark: PPWideChar; (* For passing back a mark pointer *) - executable_jit: Pointer; (* Contains a pointer to a compiled jit code *) - end; - TPCRE16Extra = real_pcre16_extra; - PPCRE16Extra = ^TPCRE16Extra; - {$ENDIF PCRE_16} - - {$IFDEF PCRE_8} - pcre_callout_block = packed record - version: Integer; (* Identifies version of block *) - (* ------------------------ Version 0 ------------------------------- *) - callout_number: Integer; (* Number compiled into pattern *) - offset_vector: PInteger; (* The offset vector *) - subject: PAnsiChar; (* The subject being matched *) - subject_length: Integer; (* The length of the subject *) - start_match: Integer; (* Offset to start of this match attempt *) - current_position: Integer; (* Where we currently are in the subject *) - capture_top: Integer; (* Max current capture *) - capture_last: Integer; (* Most recently closed capture *) - callout_data: Pointer; (* Data passed in with the call *) - (* ------------------- Added for Version 1 -------------------------- *) - pattern_position: Integer; (* Offset to next item in the pattern *) - next_item_length: Integer; (* Length of next item in the pattern *) - (* ------------------- Added for Version 2 -------------------------- *) - Mark: PCardinal; (* Pointer to current mark or NULL *) - (* ------------------------------------------------------------------ *) - end; - {$ENDIF PCRE_8} - - {$IFDEF PCRE_16} - pcre16_callout_block = packed record - version: Integer; (* Identifies version of block *) - (* ------------------------ Version 0 ------------------------------- *) - callout_number: Integer; (* Number compiled into pattern *) - offset_vector: PInteger; (* The offset vector *) - subject: PWideChar; (* The subject being matched *) - subject_length: Integer; (* The length of the subject *) - start_match: Integer; (* Offset to start of this match attempt *) - current_position: Integer; (* Where we currently are in the subject *) - capture_top: Integer; (* Max current capture *) - capture_last: Integer; (* Most recently closed capture *) - callout_data: Pointer; (* Data passed in with the call *) - (* ------------------- Added for Version 1 -------------------------- *) - pattern_position: Integer; (* Offset to next item in the pattern *) - next_item_length: Integer; (* Length of next item in the pattern *) - (* ------------------- Added for Version 2 -------------------------- *) - Mark: PCardinal; (* Pointer to current mark or NULL *) - (* ------------------------------------------------------------------ *) - end; - {$ENDIF PCRE_16} - - {$IFDEF PCRE_8} - pcre_malloc_callback = function(Size: SizeInt): Pointer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_malloc_callback} - pcre_free_callback = procedure(P: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_free_callback} - pcre_stack_malloc_callback = function(Size: SizeInt): Pointer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_stack_malloc_callback} - pcre_stack_free_callback = procedure(P: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_stack_free_callback} - pcre_callout_callback = function(var callout_block: pcre_callout_block): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_callout_callback} - pcre_jit_callback = function (P: Pointer): PPCREJITStack; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_jit_callback} - {$ENDIF PCRE_8} - - {$IFDEF PCRE_16} - pcre16_malloc_callback = function(Size: SizeInt): Pointer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_malloc_callback} - pcre16_free_callback = procedure(P: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_free_callback} - pcre16_stack_malloc_callback = function(Size: SizeInt): Pointer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_stack_malloc_callback} - pcre16_stack_free_callback = procedure(P: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_stack_free_callback} - pcre16_callout_callback = function(var callout_block: pcre16_callout_block): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_callout_callback} - pcre16_jit_callback = function (P: Pointer): PPCRE16JITStack; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_jit_callback} - {$ENDIF PCRE_16} - -var - {$IFDEF PCRE_8} - // renamed from "pcre_X" to "pcre_X_func" to allow functions with name "pcre_X" to be - // declared in implementation when static linked - pcre_malloc_func: ^pcre_malloc_callback = nil; - {$EXTERNALSYM pcre_malloc_func} - pcre_free_func: ^pcre_free_callback = nil; - {$EXTERNALSYM pcre_free_func} - pcre_stack_malloc_func: ^pcre_stack_malloc_callback = nil; - {$EXTERNALSYM pcre_stack_malloc_func} - pcre_stack_free_func: ^pcre_stack_free_callback = nil; - {$EXTERNALSYM pcre_stack_free_func} - pcre_callout_func: ^pcre_callout_callback = nil; - {$EXTERNALSYM pcre_callout_func} - {$ENDIF PCRE_8} - - {$IFDEF PCRE_16} - pcre16_malloc_func: ^pcre16_malloc_callback = nil; - {$EXTERNALSYM pcre16_malloc_func} - pcre16_free_func: ^pcre16_free_callback = nil; - {$EXTERNALSYM pcre16_free_func} - pcre16_stack_malloc_func: ^pcre16_stack_malloc_callback = nil; - {$EXTERNALSYM pcre16_stack_malloc_func} - pcre16_stack_free_func: ^pcre16_stack_free_callback = nil; - {$EXTERNALSYM pcre16_stack_free_func} - pcre16_callout_func: ^pcre16_callout_callback = nil; - {$EXTERNALSYM pcre16_callout_func} - {$ENDIF PCRE_16} - -{$IFDEF PCRE_8} - -procedure SetPCREMallocCallback(const Value: pcre_malloc_callback); -{$EXTERNALSYM SetPCREMallocCallback} -function GetPCREMallocCallback: pcre_malloc_callback; -{$EXTERNALSYM GetPCREMallocCallback} -function CallPCREMalloc(Size: SizeInt): Pointer; -{$EXTERNALSYM CallPCREMalloc} - -procedure SetPCREFreeCallback(const Value: pcre_free_callback); -{$EXTERNALSYM SetPCREFreeCallback} -function GetPCREFreeCallback: pcre_free_callback; -{$EXTERNALSYM GetPCREFreeCallback} -procedure CallPCREFree(P: Pointer); -{$EXTERNALSYM CallPCREFree} - -procedure SetPCREStackMallocCallback(const Value: pcre_stack_malloc_callback); -{$EXTERNALSYM SetPCREStackMallocCallback} -function GetPCREStackMallocCallback: pcre_stack_malloc_callback; -{$EXTERNALSYM GetPCREStackMallocCallback} -function CallPCREStackMalloc(Size: SizeInt): Pointer; -{$EXTERNALSYM CallPCREStackMalloc} - -procedure SetPCREStackFreeCallback(const Value: pcre_stack_free_callback); -{$EXTERNALSYM SetPCREStackFreeCallback} -function GetPCREStackFreeCallback: pcre_stack_free_callback; -{$EXTERNALSYM GetPCREStackFreeCallback} -procedure CallPCREStackFree(P: Pointer); -{$EXTERNALSYM CallPCREStackFree} - -procedure SetPCRECalloutCallback(const Value: pcre_callout_callback); -{$EXTERNALSYM SetPCRECalloutCallback} -function GetPCRECalloutCallback: pcre_callout_callback; -{$EXTERNALSYM GetPCRECalloutCallback} -function CallPCRECallout(var callout_block: pcre_callout_block): Integer; -{$EXTERNALSYM CallPCRECallout} - -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} - -procedure SetPCRE16MallocCallback(const Value: pcre16_malloc_callback); -{$EXTERNALSYM SetPCRE16MallocCallback} -function GetPCRE16MallocCallback: pcre16_malloc_callback; -{$EXTERNALSYM GetPCRE16MallocCallback} -function CallPCRE16Malloc(Size: SizeInt): Pointer; -{$EXTERNALSYM CallPCRE16Malloc} - -procedure SetPCRE16FreeCallback(const Value: pcre16_free_callback); -{$EXTERNALSYM SetPCRE16FreeCallback} -function GetPCRE16FreeCallback: pcre16_free_callback; -{$EXTERNALSYM GetPCRE16FreeCallback} -procedure CallPCRE16Free(P: Pointer); -{$EXTERNALSYM CallPCRE16Free} - -procedure SetPCRE16StackMallocCallback(const Value: pcre16_stack_malloc_callback); -{$EXTERNALSYM SetPCRE16StackMallocCallback} -function GetPCRE16StackMallocCallback: pcre16_stack_malloc_callback; -{$EXTERNALSYM GetPCRE16StackMallocCallback} -function CallPCRE16StackMalloc(Size: SizeInt): Pointer; -{$EXTERNALSYM CallPCRE16StackMalloc} - -procedure SetPCRE16StackFreeCallback(const Value: pcre16_stack_free_callback); -{$EXTERNALSYM SetPCRE16StackFreeCallback} -function GetPCRE16StackFreeCallback: pcre16_stack_free_callback; -{$EXTERNALSYM GetPCRE16StackFreeCallback} -procedure CallPCRE16StackFree(P: Pointer); -{$EXTERNALSYM CallPCRE16StackFree} - -procedure SetPCRE16CalloutCallback(const Value: pcre16_callout_callback); -{$EXTERNALSYM SetPCRE16CalloutCallback} -function GetPCRE16CalloutCallback: pcre16_callout_callback; -{$EXTERNALSYM GetPCRE16CalloutCallback} -function CallPCRE16Callout(var callout_block: pcre16_callout_block): Integer; -{$EXTERNALSYM CallPCRE16Callout} - -{$ENDIF PCRE_16} - -type - TPCRELibNotLoadedHandler = procedure; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - PPPWideChar = ^PPWideChar; - -var - // Value to initialize function pointers below with, in case LoadPCRE fails - // or UnloadPCRE is called. Typically the handler will raise an exception. - LibNotLoadedHandler: TPCRELibNotLoadedHandler = nil; - -(* Functions *) - -{$IFNDEF PCRE_LINKONREQUEST} -// static link and static dll import -{$IFDEF PCRE_8} -function pcre_compile(const pattern: PAnsiChar; options: Integer; - const errptr: PPAnsiChar; erroffset: PInteger; const tableptr: PAnsiChar): PPCRE; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre_compile} -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -function pcre16_compile(const pattern: PWideChar; options: Integer; - const errptr: PPAnsiChar; erroffset: PInteger; const tableptr: PAnsiChar): PPCRE16; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre16_compile} -{$ENDIF PCRE_16} -{$IFDEF PCRE_8} -function pcre_compile2(const pattern: PAnsiChar; options: Integer; - const errorcodeptr: PInteger; const errorptr: PPAnsiChar; erroroffset: PInteger; - const tables: PAnsiChar): PPCRE; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre_compile2} -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -function pcre16_compile2(const pattern: PWideChar; options: Integer; - const errorcodeptr: PInteger; const errorptr: PPAnsiChar; erroroffset: PInteger; - const tables: PAnsiChar): PPCRE16; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre16_compile2} -{$ENDIF PCRE_16} -{$IFDEF PCRE_8} -function pcre_config(what: Integer; where: Pointer): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre_config} -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -function pcre16_config(what: Integer; where: Pointer): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre16_config} -{$ENDIF PCRE_16} -{$IFDEF PCRE_8} -function pcre_copy_named_substring(const code: PPCRE; const subject: PAnsiChar; - ovector: PInteger; stringcount: Integer; const stringname: PAnsiChar; - buffer: PAnsiChar; size: Integer): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre_copy_named_substring} -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -function pcre16_copy_named_substring(const code: PPCRE16; const subject: PWideChar; - ovector: PInteger; stringcount: Integer; const stringname: PWideChar; - buffer: PWideChar; size: Integer): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre16_copy_named_substring} -{$ENDIF PCRE_16} -{$IFDEF PCRE_8} -function pcre_copy_substring(const subject: PAnsiChar; ovector: PInteger; - stringcount, stringnumber: Integer; buffer: PAnsiChar; buffersize: Integer): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre_copy_substring} -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -function pcre16_copy_substring(const subject: PWideChar; ovector: PInteger; - stringcount, stringnumber: Integer; buffer: PWideChar; buffersize: Integer): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre16_copy_substring} -{$ENDIF PCRE_16} -{$IFDEF PCRE_8} -function pcre_dfa_exec(const argument_re: PPCRE; const extra_data: PPCREExtra; - const subject: PAnsiChar; length: Integer; start_offset: Integer; - options: Integer; offsets: PInteger; offsetcount: Integer; workspace: PInteger; - wscount: Integer): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre_dfa_exec} -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -function pcre16_dfa_exec(const argument_re: PPCRE16; const extra_data: PPCRE16Extra; - const subject: PWideChar; length: Integer; start_offset: Integer; - options: Integer; offsets: PInteger; offsetcount: Integer; workspace: PInteger; - wscount: Integer): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre16_dfa_exec} -{$ENDIF PCRE_16} -{$IFDEF PCRE_8} -function pcre_exec(const code: PPCRE; const extra: PPCREExtra; const subject: PAnsiChar; - length, startoffset, options: Integer; ovector: PInteger; ovecsize: Integer): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre_exec} -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -function pcre16_exec(const code: PPCRE16; const extra: PPCRE16Extra; const subject: PWideChar; - length, startoffset, options: Integer; ovector: PInteger; ovecsize: Integer): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre16_exec} -{$ENDIF PCRE_16} -{$IFDEF PCRE_8} -procedure pcre_free_substring(stringptr: PAnsiChar); - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre_free_substring} -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -procedure pcre16_free_substring(stringptr: PWideChar); - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre16_free_substring} -{$ENDIF PCRE_16} -{$IFDEF PCRE_8} -procedure pcre_free_substring_list(stringlistptr: PPAnsiChar); - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre_free_substring_list} -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -procedure pcre16_free_substring_list(stringlistptr: PPWideChar); - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre16_free_substring_list} -{$ENDIF PCRE_16} -{$IFDEF PCRE_8} -function pcre_fullinfo(const code: PPCRE; const extra: PPCREExtra; - what: Integer; where: Pointer): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre_fullinfo} -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -function pcre16_fullinfo(const code: PPCRE16; const extra: PPCRE16Extra; - what: Integer; where: Pointer): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre16_fullinfo} -{$ENDIF PCRE_16} -{$IFDEF PCRE_8} -function pcre_get_named_substring(const code: PPCRE; const subject: PAnsiChar; - ovector: PInteger; stringcount: Integer; const stringname: PAnsiChar; - const stringptr: PPAnsiChar): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre_get_named_substring} -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -function pcre16_get_named_substring(const code: PPCRE16; const subject: PWideChar; - ovector: PInteger; stringcount: Integer; const stringname: PWideChar; - const stringptr: PPWideChar): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre16_get_named_substring} -{$ENDIF PCRE_16} -{$IFDEF PCRE_8} -function pcre_get_stringnumber(const code: PPCRE; const stringname: PAnsiChar): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre_get_stringnumber} -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -function pcre16_get_stringnumber(const code: PPCRE16; const stringname: PWideChar): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre16_get_stringnumber} -{$ENDIF PCRE_16} -{$IFDEF PCRE_8} -function pcre_get_stringtable_entries(const code: PPCRE; const stringname: PAnsiChar; - firstptr: PPAnsiChar; lastptr: PPAnsiChar): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre_get_stringtable_entries} -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -function pcre16_get_stringtable_entries(const code: PPCRE16; const stringname: PWideChar; - firstptr: PPWideChar; lastptr: PPWideChar): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre16_get_stringtable_entries} -{$ENDIF PCRE_16} -{$IFDEF PCRE_8} -function pcre_get_substring(const subject: PAnsiChar; ovector: PInteger; - stringcount, stringnumber: Integer; const stringptr: PPAnsiChar): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre_get_substring} -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -function pcre16_get_substring(const subject: PWideChar; ovector: PInteger; - stringcount, stringnumber: Integer; const stringptr: PPWideChar): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre16_get_substring} -{$ENDIF PCRE_16} -{$IFDEF PCRE_8} -function pcre_get_substring_list(const subject: PAnsiChar; ovector: PInteger; - stringcount: Integer; listptr: PPPAnsiChar): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre_get_substring_list} -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -function pcre16_get_substring_list(const subject: PWideChar; ovector: PInteger; - stringcount: Integer; listptr: PPPWideChar): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre16_get_substring_list} -{$ENDIF PCRE_16} -{$IFDEF PCRE_8} -function pcre_maketables: PAnsiChar; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre_maketables} -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -function pcre16_maketables: PAnsiChar; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre16_maketables} -{$ENDIF PCRE_16} -{$IFDEF PCRE_8} -function pcre_refcount(argument_re: PPCRE; adjust: Integer): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre_refcount} -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -function pcre16_refcount(argument_re: PPCRE16; adjust: Integer): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre16_refcount} -{$ENDIF PCRE_16} -{$IFDEF PCRE_8} -function pcre_study(const code: PPCRE; options: Integer; const errptr: PPAnsiChar): PPCREExtra; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre_study} -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -function pcre16_study(const code: PPCRE16; options: Integer; const errptr: PPAnsiChar): PPCRE16Extra; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre16_study} -{$ENDIF PCRE_16} -{$IFDEF PCRE_8} -procedure pcre_free_study(const extra: PPCREExtra); - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre_free_study} -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -procedure pcre16_free_study(const extra: PPCRE16Extra); - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre16_free_study} -{$ENDIF PCRE_16} -{$IFDEF PCRE_8} -function pcre_version: PAnsiChar; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre_version} -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -function pcre16_version: PAnsiChar; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre16_version} -{$ENDIF PCRE_16} -{$IFDEF PCRE_8} -function pcre_jit_stack_alloc(startsize, maxsize: Integer): PPCREJITStack; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre_jit_stack_alloc} -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -function pcre16_jit_stack_alloc(startsize, maxsize: Integer): PPCRE16JITStack; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre16_jit_stack_alloc} -{$ENDIF PCRE_16} -{$IFDEF PCRE_8} -procedure pcre_jit_stack_free(stack: PPCREJITStack); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre_jit_stack_free} -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -procedure pcre16_jit_stack_free(stack: PPCRE16JITStack); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre16_jit_stack_free} -{$ENDIF PCRE_16} -{$IFDEF PCRE_8} -procedure pcre_assign_jit_stack(extra: PPCREExtra; callback: pcre_jit_callback; userdata: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre_assign_jit_stack} -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -procedure pcre16_assign_jit_stack(extra: PPCRE16Extra; callback: pcre16_jit_callback; userdata: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -{$EXTERNALSYM pcre16_assign_jit_stack} -{$ENDIF PCRE_16} - -{$ELSE PCRE_LINKONREQUEST} - -// dynamic dll import -type - {$IFDEF PCRE_8} - pcre_compile_func = function(const pattern: PAnsiChar; options: Integer; - const errptr: PPAnsiChar; erroffset: PInteger; const tableptr: PAnsiChar): PPCRE; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_compile_func} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_compile_func = function(const pattern: PWideChar; options: Integer; - const errptr: PPAnsiChar; erroffset: PInteger; const tableptr: PAnsiChar): PPCRE16; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_compile_func} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_compile2_func = function(const pattern: PAnsiChar; options: Integer; - const errorcodeptr: PInteger; const errorptr: PPAnsiChar; erroroffset: PInteger; - const tables: PAnsiChar): PPCRE; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_compile2_func} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_compile2_func = function(const pattern: PWideChar; options: Integer; - const errorcodeptr: PInteger; const errorptr: PPAnsiChar; erroroffset: PInteger; - const tables: PAnsiChar): PPCRE16; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_compile2_func} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_config_func = function(what: Integer; where: Pointer): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_config_func} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_config_func = function(what: Integer; where: Pointer): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_config_func} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_copy_named_substring_func = function(const code: PPCRE; const subject: PAnsiChar; - ovector: PInteger; stringcount: Integer; const stringname: PAnsiChar; - buffer: PAnsiChar; size: Integer): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_copy_named_substring_func} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_copy_named_substring_func = function(const code: PPCRE16; const subject: PWideChar; - ovector: PInteger; stringcount: Integer; const stringname: PWideChar; - buffer: PWideChar; size: Integer): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_copy_named_substring_func} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_copy_substring_func = function(const subject: PAnsiChar; ovector: PInteger; - stringcount, stringnumber: Integer; buffer: PAnsiChar; buffersize: Integer): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_copy_substring_func} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_copy_substring_func = function(const subject: PWideChar; ovector: PInteger; - stringcount, stringnumber: Integer; buffer: PWideChar; buffersize: Integer): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_copy_substring_func} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_dfa_exec_func = function(const argument_re: PPCRE; const extra_data: PPCREExtra; - const subject: PAnsiChar; length: Integer; start_offset: Integer; - options: Integer; offsets: PInteger; offsetcount: Integer; workspace: PInteger; - wscount: Integer): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_dfa_exec_func} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_dfa_exec_func = function(const argument_re: PPCRE16; const extra_data: PPCRE16Extra; - const subject: PWideChar; length: Integer; start_offset: Integer; - options: Integer; offsets: PInteger; offsetcount: Integer; workspace: PInteger; - wscount: Integer): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_dfa_exec_func} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_exec_func = function(const code: PPCRE; const extra: PPCREExtra; const subject: PAnsiChar; - length, startoffset, options: Integer; ovector: PInteger; ovecsize: Integer): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_exec_func} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_exec_func = function(const code: PPCRE16; const extra: PPCRE16Extra; const subject: PWideChar; - length, startoffset, options: Integer; ovector: PInteger; ovecsize: Integer): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_exec_func} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_free_substring_func = procedure(stringptr: PAnsiChar); - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_free_substring_func} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_free_substring_func = procedure(stringptr: PWideChar); - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_free_substring_func} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_free_substring_list_func = procedure(stringptr: PPAnsiChar); - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_free_substring_list_func} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_free_substring_list_func = procedure(stringptr: PPWideChar); - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_free_substring_list_func} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_fullinfo_func = function(const code: PPCRE; const extra: PPCREExtra; - what: Integer; where: Pointer): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_fullinfo_func} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_fullinfo_func = function(const code: PPCRE16; const extra: PPCRE16Extra; - what: Integer; where: Pointer): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_fullinfo_func} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_get_named_substring_func = function(const code: PPCRE; const subject: PAnsiChar; - ovector: PInteger; stringcount: Integer; const stringname: PAnsiChar; - const stringptr: PPAnsiChar): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_get_named_substring_func} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_get_named_substring_func = function(const code: PPCRE16; const subject: PWideChar; - ovector: PInteger; stringcount: Integer; const stringname: PWideChar; - const stringptr: PPWideChar): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_get_named_substring_func} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_get_stringnumber_func = function(const code: PPCRE; - const stringname: PAnsiChar): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_get_stringnumber_func} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_get_stringnumber_func = function(const code: PPCRE16; - const stringname: PWideChar): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_get_stringnumber_func} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_get_stringtable_entries_func = function(const code: PPCRE; const stringname: PAnsiChar; - firstptr: PPAnsiChar; lastptr: PPAnsiChar): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_get_stringtable_entries_func} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_get_stringtable_entries_func = function(const code: PPCRE16; const stringname: PWideChar; - firstptr: PPWideChar; lastptr: PPWideChar): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_get_stringtable_entries_func} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_get_substring_func = function(const subject: PAnsiChar; ovector: PInteger; - stringcount, stringnumber: Integer; const stringptr: PPAnsiChar): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_get_substring_func} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_get_substring_func = function(const subject: PWideChar; ovector: PInteger; - stringcount, stringnumber: Integer; const stringptr: PPWideChar): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_get_substring_func} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_get_substring_list_func = function(const subject: PAnsiChar; ovector: PInteger; - stringcount: Integer; listptr: PPPAnsiChar): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_get_substring_list_func} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_get_substring_list_func = function(const subject: PWideChar; ovector: PInteger; - stringcount: Integer; listptr: PPPWideChar): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_get_substring_list_func} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_maketables_func = function: PAnsiChar; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_maketables_func} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_maketables_func = function: PAnsiChar; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_maketables_func} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_refcount_func = function(argument_re: PPCRE; adjust: Integer): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_refcount_func} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_refcount_func = function(argument_re: PPCRE16; adjust: Integer): Integer; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_refcount_func} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_study_func = function(const code: PPCRE; options: Integer; const errptr: PPAnsiChar): PPCREExtra; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_study_func} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_study_func = function(const code: PPCRE16; options: Integer; const errptr: PPAnsiChar): PPCRE16Extra; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_study_func} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_free_study_func = procedure (const extra: PPCREExtra); - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_free_study_func} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_free_study_func = procedure (const extra: PPCRE16Extra); - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_free_study_func} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_version_func = function: PAnsiChar; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_version_func} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_version_func = function: PAnsiChar; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_version_func} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_jit_stack_alloc_func = function (startsize, maxsize: Integer): PPCREJITStack; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_jit_stack_alloc_func} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_jit_stack_alloc_func = function (startsize, maxsize: Integer): PPCRE16JITStack; - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_jit_stack_alloc_func} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_jit_stack_free_func = procedure (stack: PPCREJITStack); - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_jit_stack_free_func} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_jit_stack_free_func = procedure (stack: PPCRE16JITStack); - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_jit_stack_free_func} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_assign_jit_stack_func = procedure (extra: PPCREExtra; callback: pcre_jit_callback; userdata: Pointer); - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre_assign_jit_stack_func} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_assign_jit_stack_func = procedure (extra: PPCRE16Extra; callback: pcre16_jit_callback; userdata: Pointer); - {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} - {$EXTERNALSYM pcre16_assign_jit_stack_func} - {$ENDIF PCRE_16} - -var - {$IFDEF PCRE_8} - pcre_compile: pcre_compile_func = nil; - {$EXTERNALSYM pcre_compile} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_compile: pcre16_compile_func = nil; - {$EXTERNALSYM pcre16_compile} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_compile2: pcre_compile2_func = nil; - {$EXTERNALSYM pcre_compile2} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_compile2: pcre16_compile2_func = nil; - {$EXTERNALSYM pcre16_compile2} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_config: pcre_config_func = nil; - {$EXTERNALSYM pcre_config} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_config: pcre16_config_func = nil; - {$EXTERNALSYM pcre16_config} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_copy_named_substring: pcre_copy_named_substring_func = nil; - {$EXTERNALSYM pcre_copy_named_substring} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_copy_named_substring: pcre16_copy_named_substring_func = nil; - {$EXTERNALSYM pcre16_copy_named_substring} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_copy_substring: pcre_copy_substring_func = nil; - {$EXTERNALSYM pcre_copy_substring} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_copy_substring: pcre16_copy_substring_func = nil; - {$EXTERNALSYM pcre16_copy_substring} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_dfa_exec: pcre_dfa_exec_func = nil; - {$EXTERNALSYM pcre_dfa_exec} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_dfa_exec: pcre16_dfa_exec_func = nil; - {$EXTERNALSYM pcre16_dfa_exec} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_exec: pcre_exec_func = nil; - {$EXTERNALSYM pcre_exec} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_exec: pcre16_exec_func = nil; - {$EXTERNALSYM pcre16_exec} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_free_substring: pcre_free_substring_func = nil; - {$EXTERNALSYM pcre_free_substring} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_free_substring: pcre16_free_substring_func = nil; - {$EXTERNALSYM pcre16_free_substring} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_free_substring_list: pcre_free_substring_list_func = nil; - {$EXTERNALSYM pcre_free_substring_list} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_free_substring_list: pcre16_free_substring_list_func = nil; - {$EXTERNALSYM pcre16_free_substring_list} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_fullinfo: pcre_fullinfo_func = nil; - {$EXTERNALSYM pcre_fullinfo} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_fullinfo: pcre16_fullinfo_func = nil; - {$EXTERNALSYM pcre16_fullinfo} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_get_named_substring: pcre_get_named_substring_func = nil; - {$EXTERNALSYM pcre_get_named_substring} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_get_named_substring: pcre16_get_named_substring_func = nil; - {$EXTERNALSYM pcre16_get_named_substring} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_get_stringnumber: pcre_get_stringnumber_func = nil; - {$EXTERNALSYM pcre_get_stringnumber} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_get_stringnumber: pcre16_get_stringnumber_func = nil; - {$EXTERNALSYM pcre16_get_stringnumber} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_get_stringtable_entries: pcre_get_stringtable_entries_func = nil; - {$EXTERNALSYM pcre_get_stringtable_entries} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_get_stringtable_entries: pcre16_get_stringtable_entries_func = nil; - {$EXTERNALSYM pcre16_get_stringtable_entries} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_get_substring: pcre_get_substring_func = nil; - {$EXTERNALSYM pcre_get_substring} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_get_substring: pcre16_get_substring_func = nil; - {$EXTERNALSYM pcre16_get_substring} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_get_substring_list: pcre_get_substring_list_func = nil; - {$EXTERNALSYM pcre_get_substring_list} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_get_substring_list: pcre16_get_substring_list_func = nil; - {$EXTERNALSYM pcre16_get_substring_list} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_maketables: pcre_maketables_func = nil; - {$EXTERNALSYM pcre_maketables} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_maketables: pcre16_maketables_func = nil; - {$EXTERNALSYM pcre16_maketables} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_refcount: pcre_refcount_func = nil; - {$EXTERNALSYM pcre_refcount} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_refcount: pcre16_refcount_func = nil; - {$EXTERNALSYM pcre16_refcount} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_study: pcre_study_func = nil; - {$EXTERNALSYM pcre_study} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_study: pcre16_study_func = nil; - {$EXTERNALSYM pcre16_study} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_free_study: pcre_free_study_func = nil; - {$EXTERNALSYM pcre_free_study} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_free_study: pcre16_free_study_func = nil; - {$EXTERNALSYM pcre16_free_study} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_version: pcre_version_func = nil; - {$EXTERNALSYM pcre_version} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_version: pcre16_version_func = nil; - {$EXTERNALSYM pcre16_version} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_jit_stack_alloc: pcre_jit_stack_alloc_func = nil; - {$EXTERNALSYM pcre_jit_stack_alloc} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_jit_stack_alloc: pcre16_jit_stack_alloc_func = nil; - {$EXTERNALSYM pcre16_jit_stack_alloc} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_jit_stack_free: pcre_jit_stack_free_func = nil; - {$EXTERNALSYM pcre_jit_stack_free} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_jit_stack_free: pcre16_jit_stack_free_func = nil; - {$EXTERNALSYM pcre16_jit_stack_free} - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - pcre_assign_jit_stack: pcre_assign_jit_stack_func = nil; - {$EXTERNALSYM pcre_assign_jit_stack} - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_assign_jit_stack: pcre16_assign_jit_stack_func = nil; - {$EXTERNALSYM pcre16_assign_jit_stack} - {$ENDIF PCRE_16} - -{$ENDIF PCRE_LINKONREQUEST} - -{$ENDIF ~PCRE_RTL} -//DOM-IGNORE-END - -const - {$IFDEF MSWINDOWS} - PCREDefaultLibraryName = 'pcre3.dll'; - {$ENDIF MSWINDOWS} - {$IFDEF UNIX} - PCREDefaultLibraryName = 'libpcre.so.0'; - {$ENDIF UNIX} - {$IFDEF PCRE_8} - PCRECompileDefaultExportName = 'pcre_compile'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16CompileDefaultExportName = 'pcre16_compile'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCRECompile2DefaultExportName = 'pcre_compile2'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16Compile2DefaultExportName = 'pcre16_compile2'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREConfigDefaultExportName = 'pcre_config'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16ConfigDefaultExportName = 'pcre16_config'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCRECopyNamedSubstringDefaultExportName = 'pcre_copy_named_substring'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16CopyNamedSubstringDefaultExportName = 'pcre16_copy_named_substring'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCRECopySubStringDefaultExportName = 'pcre_copy_substring'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16CopySubStringDefaultExportName = 'pcre16_copy_substring'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREDfaExecDefaultExportName = 'pcre_dfa_exec'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16DfaExecDefaultExportName = 'pcre16_dfa_exec'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREExecDefaultExportName = 'pcre_exec'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16ExecDefaultExportName = 'pcre16_exec'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREFreeSubStringDefaultExportName = 'pcre_free_substring'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16FreeSubStringDefaultExportName = 'pcre16_free_substring'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREFreeSubStringListDefaultExportName = 'pcre_free_substring_list'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16FreeSubStringListDefaultExportName = 'pcre16_free_substring_list'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREFullInfoDefaultExportName = 'pcre_fullinfo'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16FullInfoDefaultExportName = 'pcre16_fullinfo'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREGetNamedSubstringDefaultExportName = 'pcre_get_named_substring'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16GetNamedSubstringDefaultExportName = 'pcre16_get_named_substring'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREGetStringNumberDefaultExportName = 'pcre_get_stringnumber'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16GetStringNumberDefaultExportName = 'pcre16_get_stringnumber'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREGetStringTableEntriesDefaultExportName = 'pcre_get_stringtable_entries'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16GetStringTableEntriesDefaultExportName = 'pcre16_get_stringtable_entries'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREGetSubStringDefaultExportName = 'pcre_get_substring'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16GetSubStringDefaultExportName = 'pcre16_get_substring'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREGetSubStringListDefaultExportName = 'pcre_get_substring_list'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16GetSubStringListDefaultExportName = 'pcre16_get_substring_list'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREMakeTablesDefaultExportName = 'pcre_maketables'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16MakeTablesDefaultExportName = 'pcre16_maketables'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCRERefCountDefaultExportName = 'pcre_refcount'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16RefCountDefaultExportName = 'pcre16_refcount'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREStudyDefaultExportName = 'pcre_study'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16StudyDefaultExportName = 'pcre16_study'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREFreeStudyDefaultExportName = 'pcre_free_study'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16FreeStudyDefaultExportName = 'pcre16_free_study'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREVersionDefaultExportName = 'pcre_version'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16VersionDefaultExportName = 'pcre16_version'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREJITStackAllocDefaultExportName = 'pcre_jit_stack_alloc'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16JITStackAllocDefaultExportName = 'pcre16_jit_stack_alloc'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREJITStackFreeDefaultExportName = 'pcre_jit_stack_free'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16JITStackFreeDefaultExportName = 'pcre16_jit_stack_free'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREAssignJITStackDefaultExportName = 'pcre_assign_jit_stack'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16AssignJITStackDefaultExportName = 'pcre16_assign_jit_stack'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREMallocDefaultExportName = 'pcre_malloc'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16MallocDefaultExportName = 'pcre16_malloc'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREFreeDefaultExportName = 'pcre_free'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16FreeDefaultExportName = 'pcre16_free'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREStackMallocDefaultExportName = 'pcre_stack_malloc'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16StackMallocDefaultExportName = 'pcre16_stack_malloc'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREStackFreeDefaultExportName = 'pcre_stack_free'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16StackFreeDefaultExportName = 'pcre16_stack_free'; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCRECalloutDefaultExportName = 'pcre_callout'; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16CalloutDefaultExportName = 'pcre16_callout'; - {$ENDIF PCRE_16} - -{$IFDEF PCRE_LINKONREQUEST} -var - PCRELibraryName: string = PCREDefaultLibraryName; - - {$IFDEF PCRE_8} - PCRECompileExportName: string = PCRECompileDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16CompileExportName: string = PCRE16CompileDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCRECompile2ExportName: string = PCRECompile2DefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16Compile2ExportName: string = PCRE16Compile2DefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREConfigExportName: string = PCREConfigDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16ConfigExportName: string = PCRE16ConfigDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCRECopyNamedSubstringExportName: string = PCRECopyNamedSubstringDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16CopyNamedSubstringExportName: string = PCRE16CopyNamedSubstringDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCRECopySubStringExportName: string = PCRECopySubStringDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16CopySubStringExportName: string = PCRE16CopySubStringDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREDfaExecExportName: string = PCREDfaExecDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16DfaExecExportName: string = PCRE16DfaExecDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREExecExportName: string = PCREExecDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16ExecExportName: string = PCRE16ExecDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREFreeSubStringExportName: string = PCREFreeSubStringDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16FreeSubStringExportName: string = PCRE16FreeSubStringDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREFreeSubStringListExportName: string = PCREFreeSubStringListDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16FreeSubStringListExportName: string = PCRE16FreeSubStringListDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREFullInfoExportName: string = PCREFullInfoDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16FullInfoExportName: string = PCRE16FullInfoDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREGetNamedSubstringExportName: string = PCREGetNamedSubstringDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16GetNamedSubstringExportName: string = PCRE16GetNamedSubstringDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREGetStringNumberExportName: string = PCREGetStringNumberDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16GetStringNumberExportName: string = PCRE16GetStringNumberDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREGetStringTableEntriesExportName: string = PCREGetStringTableEntriesDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16GetStringTableEntriesExportName: string = PCRE16GetStringTableEntriesDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREGetSubStringExportName: string = PCREGetSubStringDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16GetSubStringExportName: string = PCRE16GetSubStringDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREGetSubStringListExportName: string = PCREGetSubStringListDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16GetSubStringListExportName: string = PCRE16GetSubStringListDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREMakeTablesExportName: string = PCREMakeTablesDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16MakeTablesExportName: string = PCRE16MakeTablesDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCRERefCountExportName: string = PCRERefCountDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16RefCountExportName: string = PCRE16RefCountDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREStudyExportName: string = PCREStudyDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16StudyExportName: string = PCRE16StudyDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREFreeStudyExportName: string = PCREFreeStudyDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16FreeStudyExportName: string = PCRE16FreeStudyDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREVersionExportName: string = PCREVersionDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16VersionExportName: string = PCRE16VersionDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREJITStackAllocExportName: string = PCREJITStackAllocDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16JITStackAllocExportName: string = PCRE16JITStackAllocDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREJITStackFreeExportName: string = PCREJITStackFreeDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16JITStackFreeExportName: string = PCRE16JITStackFreeDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREAssignJITStackExportName: string = PCREAssignJITStackDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16AssignJITStackExportName: string = PCRE16AssignJITStackDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREMallocExportName: string = PCREMallocDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16MallocExportName: string = PCRE16MallocDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREFreeExportName: string = PCREFreeDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16FreeExportName: string = PCRE16FreeDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREStackMallocExportName: string = PCREStackMallocDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16StackMallocExportName: string = PCRE16StackMallocDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCREStackFreeExportName: string = PCREStackFreeDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16StackFreeExportName: string = PCRE16StackFreeDefaultExportName; - {$ENDIF PCRE_16} - {$IFDEF PCRE_8} - PCRECalloutExportName: string = PCRECalloutDefaultExportName; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - PCRE16CalloutExportName: string = PCRE16CalloutDefaultExportName; - {$ENDIF PCRE_16} -{$ENDIF PCRE_LINKONREQUEST} - -var - PCRELib: TModuleHandle = INVALID_MODULEHANDLE_VALUE; - -function IsPCRELoaded: Boolean; -function LoadPCRE: Boolean; -procedure UnloadPCRE; - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\common'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -uses - {$IFDEF HAS_UNIT_LIBC} - Libc, - {$ENDIF HAS_UNIT_LIBC} - {$IFDEF HAS_UNITSCOPE} - {$IFDEF MSWINDOWS} - Winapi.Windows, - {$ENDIF MSWINDOWS} - System.Types, System.SysUtils; - {$ELSE ~HAS_UNITSCOPE} - {$IFDEF MSWINDOWS} - Windows, - {$ENDIF MSWINDOWS} - Types, SysUtils; - {$ENDIF ~HAS_UNITSCOPE} - -{$IFNDEF PCRE_RTL} -{$IFDEF PCRE_STATICLINK} - -{$IFDEF PCRE_8} -// make the linker happy with PCRE 8.00 -procedure _pcre_find_bracket; external; -// make the linker happy with PCRE 8.21 -procedure _pcre_jit_compile; external; -procedure _pcre_jit_free; external; -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} -// make the linker happy with PCRE 8.30 -procedure _pcre16_find_bracket; external; -procedure _pcre16_jit_compile; external; -procedure _pcre16_jit_free; external; -{$ENDIF PCRE_16} - -{$IFDEF CPU32} - -{$IFDEF PCRE_8} - -{$LINK ..\windows\obj\pcre\win32\pcre_compile.obj} -{$LINK ..\windows\obj\pcre\win32\pcre_config.obj} -{$LINK ..\windows\obj\pcre\win32\pcre_dfa_exec.obj} -{$LINK ..\windows\obj\pcre\win32\pcre_exec.obj} -{$LINK ..\windows\obj\pcre\win32\pcre_fullinfo.obj} -{$LINK ..\windows\obj\pcre\win32\pcre_get.obj} -{$LINK ..\windows\obj\pcre\win32\pcre_jit_compile.obj} -{$LINK ..\windows\obj\pcre\win32\pcre_maketables.obj} -{$LINK ..\windows\obj\pcre\win32\pcre_newline.obj} -{$LINK ..\windows\obj\pcre\win32\pcre_ord2utf8.obj} -{$LINK ..\windows\obj\pcre\win32\pcre_refcount.obj} -{$LINK ..\windows\obj\pcre\win32\pcre_study.obj} -{$LINK ..\windows\obj\pcre\win32\pcre_tables.obj} -{$LINK ..\windows\obj\pcre\win32\pcre_ucd.obj} -{$LINK ..\windows\obj\pcre\win32\pcre_valid_utf8.obj} -{$LINK ..\windows\obj\pcre\win32\pcre_version.obj} -{$LINK ..\windows\obj\pcre\win32\pcre_xclass.obj} -{$LINK ..\windows\obj\pcre\win32\pcre_chartables.obj} - -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} - -{$LINK ..\windows\obj\pcre\win32\pcre16_compile.obj} -{$LINK ..\windows\obj\pcre\win32\pcre16_config.obj} -{$LINK ..\windows\obj\pcre\win32\pcre16_dfa_exec.obj} -{$LINK ..\windows\obj\pcre\win32\pcre16_exec.obj} -{$LINK ..\windows\obj\pcre\win32\pcre16_fullinfo.obj} -{$LINK ..\windows\obj\pcre\win32\pcre16_get.obj} -{$LINK ..\windows\obj\pcre\win32\pcre16_jit_compile.obj} -{$LINK ..\windows\obj\pcre\win32\pcre16_maketables.obj} -{$LINK ..\windows\obj\pcre\win32\pcre16_newline.obj} -{$LINK ..\windows\obj\pcre\win32\pcre16_ord2utf16.obj} -{$LINK ..\windows\obj\pcre\win32\pcre16_refcount.obj} -{$LINK ..\windows\obj\pcre\win32\pcre16_study.obj} -{$LINK ..\windows\obj\pcre\win32\pcre16_tables.obj} -{$LINK ..\windows\obj\pcre\win32\pcre16_ucd.obj} -{$LINK ..\windows\obj\pcre\win32\pcre16_valid_utf16.obj} -{$LINK ..\windows\obj\pcre\win32\pcre16_version.obj} -{$LINK ..\windows\obj\pcre\win32\pcre16_xclass.obj} -{$LINK ..\windows\obj\pcre\win32\pcre16_chartables.obj} -{$LINK ..\windows\obj\pcre\win32\pcre16_string_utils.obj} -{$ENDIF PCRE_16} - -{$ENDIF CPU32} -{$IFDEF CPU64} - -{$IFDEF PCRE_8} - -{$LINK ..\windows\obj\pcre\win64\pcre_compile.obj} -{$LINK ..\windows\obj\pcre\win64\pcre_config.obj} -{$LINK ..\windows\obj\pcre\win64\pcre_dfa_exec.obj} -{$LINK ..\windows\obj\pcre\win64\pcre_exec.obj} -{$LINK ..\windows\obj\pcre\win64\pcre_fullinfo.obj} -{$LINK ..\windows\obj\pcre\win64\pcre_get.obj} -{$LINK ..\windows\obj\pcre\win64\pcre_jit_compile.obj} -{$LINK ..\windows\obj\pcre\win64\pcre_maketables.obj} -{$LINK ..\windows\obj\pcre\win64\pcre_newline.obj} -{$LINK ..\windows\obj\pcre\win64\pcre_ord2utf8.obj} -{$LINK ..\windows\obj\pcre\win64\pcre_refcount.obj} -{$LINK ..\windows\obj\pcre\win64\pcre_study.obj} -{$LINK ..\windows\obj\pcre\win64\pcre_tables.obj} -{$LINK ..\windows\obj\pcre\win64\pcre_ucd.obj} -{$LINK ..\windows\obj\pcre\win64\pcre_valid_utf8.obj} -{$LINK ..\windows\obj\pcre\win64\pcre_version.obj} -{$LINK ..\windows\obj\pcre\win64\pcre_xclass.obj} -{$LINK ..\windows\obj\pcre\win64\pcre_chartables.obj} - -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} - -{$LINK ..\windows\obj\pcre\win64\pcre16_compile.obj} -{$LINK ..\windows\obj\pcre\win64\pcre16_config.obj} -{$LINK ..\windows\obj\pcre\win64\pcre16_dfa_exec.obj} -{$LINK ..\windows\obj\pcre\win64\pcre16_exec.obj} -{$LINK ..\windows\obj\pcre\win64\pcre16_fullinfo.obj} -{$LINK ..\windows\obj\pcre\win64\pcre16_get.obj} -{$LINK ..\windows\obj\pcre\win64\pcre16_jit_compile.obj} -{$LINK ..\windows\obj\pcre\win64\pcre16_maketables.obj} -{$LINK ..\windows\obj\pcre\win64\pcre16_newline.obj} -{$LINK ..\windows\obj\pcre\win64\pcre16_ord2utf16.obj} -{$LINK ..\windows\obj\pcre\win64\pcre16_refcount.obj} -{$LINK ..\windows\obj\pcre\win64\pcre16_study.obj} -{$LINK ..\windows\obj\pcre\win64\pcre16_tables.obj} -{$LINK ..\windows\obj\pcre\win64\pcre16_ucd.obj} -{$LINK ..\windows\obj\pcre\win64\pcre16_valid_utf16.obj} -{$LINK ..\windows\obj\pcre\win64\pcre16_version.obj} -{$LINK ..\windows\obj\pcre\win64\pcre16_xclass.obj} -{$LINK ..\windows\obj\pcre\win64\pcre16_chartables.obj} -{$LINK ..\windows\obj\pcre\win64\pcre16_string_utils.obj} - -{$ENDIF PCRE_16} - -{$ENDIF CPU64} - -// user's defined callbacks -var - {$IFDEF PCRE_8} - pcre_malloc_user: pcre_malloc_callback; - pcre_free_user: pcre_free_callback; - pcre_stack_malloc_user: pcre_stack_malloc_callback; - pcre_stack_free_user: pcre_stack_free_callback; - pcre_callout_user: pcre_callout_callback; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_malloc_user: pcre16_malloc_callback; - pcre16_free_user: pcre16_free_callback; - pcre16_stack_malloc_user: pcre16_stack_malloc_callback; - pcre16_stack_free_user: pcre16_stack_free_callback; - pcre16_callout_user: pcre16_callout_callback; - {$ENDIF PCRE_16} - -{$IFDEF PCRE_8} -function pcre_compile; external; -function pcre_compile2; external; -function pcre_config; external; -function pcre_copy_named_substring; external; -function pcre_copy_substring; external; -function pcre_dfa_exec; external; -function pcre_exec; external; -procedure pcre_free_substring; external; -procedure pcre_free_substring_list; external; -function pcre_fullinfo; external; -function pcre_get_named_substring; external; -function pcre_get_stringnumber; external; -function pcre_get_stringtable_entries; external; -function pcre_get_substring; external; -function pcre_get_substring_list; external; -function pcre_maketables; external; -function pcre_refcount; external; -function pcre_study; external; -procedure pcre_free_study; external; -function pcre_version; external; -function pcre_jit_stack_alloc; external; -procedure pcre_jit_stack_free; external; -procedure pcre_assign_jit_stack; external; -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -function pcre16_compile; external; -function pcre16_compile2; external; -function pcre16_config; external; -function pcre16_copy_named_substring; external; -function pcre16_copy_substring; external; -function pcre16_dfa_exec; external; -function pcre16_exec; external; -procedure pcre16_free_substring; external; -procedure pcre16_free_substring_list; external; -function pcre16_fullinfo; external; -function pcre16_get_named_substring; external; -function pcre16_get_stringnumber; external; -function pcre16_get_stringtable_entries; external; -function pcre16_get_substring; external; -function pcre16_get_substring_list; external; -function pcre16_maketables; external; -function pcre16_refcount; external; -function pcre16_study; external; -procedure pcre16_free_study; external; -function pcre16_version; external; -function pcre16_jit_stack_alloc; external; -procedure pcre16_jit_stack_free; external; -procedure pcre16_assign_jit_stack; external; -{$ENDIF PCRE_16} - -type - size_t = Longint; - -const - szMSVCRT = 'MSVCRT.DLL'; - -function malloc(size: size_t): Pointer; cdecl; external szMSVCRT name 'malloc'; - -{$IFDEF CPU32} -function _memcpy(dest, src: Pointer; count: size_t): Pointer; cdecl; external szMSVCRT name 'memcpy'; -function _memmove(dest, src: Pointer; count: size_t): Pointer; cdecl; external szMSVCRT name 'memmove'; -function _memset(dest: Pointer; val: Integer; count: size_t): Pointer; cdecl; external szMSVCRT name 'memset'; -function _strncmp(s1: PAnsiChar; s2: PAnsiChar; n: size_t): Integer; cdecl; external szMSVCRT name 'strncmp'; -function _memcmp(s1: Pointer; s2: Pointer; n: size_t): Integer; cdecl; external szMSVCRT name 'memcmp'; -function _strlen(s: PAnsiChar): size_t; cdecl; external szMSVCRT name 'strlen'; -function __ltolower(__ch: Integer): Integer; cdecl; external szMSVCRT name 'tolower'; -function __ltoupper(__ch: Integer): Integer; cdecl; external szMSVCRT name 'toupper'; -function _isalnum(__ch: Integer): Integer; cdecl; external szMSVCRT name 'isalnum'; -function _isalpha(__ch: Integer): Integer; cdecl; external szMSVCRT name 'isalpha'; -function _iscntrl(__ch: Integer): Integer; cdecl; external szMSVCRT name 'iscntrl'; -function _isdigit(__ch: Integer): Integer; cdecl; external szMSVCRT name 'isdigit'; -function _isgraph(__ch: Integer): Integer; cdecl; external szMSVCRT name 'isgraph'; -function _islower(__ch: Integer): Integer; cdecl; external szMSVCRT name 'islower'; -function _isprint(__ch: Integer): Integer; cdecl; external szMSVCRT name 'isprint'; -function _ispunct(__ch: Integer): Integer; cdecl; external szMSVCRT name 'ispunct'; -function _isspace(__ch: Integer): Integer; cdecl; external szMSVCRT name 'isspace'; -function _isupper(__ch: Integer): Integer; cdecl; external szMSVCRT name 'isupper'; -function _isxdigit(__ch: Integer): Integer; cdecl; external szMSVCRT name 'isxdigit'; -function _strchr(__s: PAnsiChar; __c: Integer): PAnsiChar; cdecl; external szMSVCRT name 'strchr'; - -function ___alloca_helper(size: size_t): Pointer; cdecl; -begin - Result := malloc(size); -end; - -procedure __llmul; -asm - JMP System.__llmul -end; -{$ENDIF CPU32} -{$IFDEF CPU64} -function memcpy(dest, src: Pointer; count: size_t): Pointer; external szMSVCRT name 'memcpy'; -function memmove(dest, src: Pointer; count: size_t): Pointer; external szMSVCRT name 'memmove'; -function memset(dest: Pointer; val: Integer; count: size_t): Pointer; external szMSVCRT name 'memset'; -function strncmp(s1: PAnsiChar; s2: PAnsiChar; n: size_t): Integer; external szMSVCRT name 'strncmp'; -function strcmp(s1: PAnsiChar; s2: PAnsiChar; n: size_t): Integer; external szMSVCRT name 'strcmp'; -function memcmp(s1: Pointer; s2: Pointer; n: size_t): Integer; external szMSVCRT name 'memcmp'; -function strlen(s: PAnsiChar): size_t; external szMSVCRT name 'strlen'; -function tolower(__ch: Integer): Integer; external szMSVCRT name 'tolower'; -function toupper(__ch: Integer): Integer; external szMSVCRT name 'toupper'; -function isalnum(__ch: Integer): Integer; external szMSVCRT name 'isalnum'; -function isalpha(__ch: Integer): Integer; external szMSVCRT name 'isalpha'; -function iscntrl(__ch: Integer): Integer; external szMSVCRT name 'iscntrl'; -function isdigit(__ch: Integer): Integer; external szMSVCRT name 'isdigit'; -function isgraph(__ch: Integer): Integer; external szMSVCRT name 'isgraph'; -function islower(__ch: Integer): Integer; external szMSVCRT name 'islower'; -function isprint(__ch: Integer): Integer; external szMSVCRT name 'isprint'; -function ispunct(__ch: Integer): Integer; external szMSVCRT name 'ispunct'; -function isspace(__ch: Integer): Integer; external szMSVCRT name 'isspace'; -function isupper(__ch: Integer): Integer; external szMSVCRT name 'isupper'; -function isxdigit(__ch: Integer): Integer; external szMSVCRT name 'isxdigit'; -function strchr(__s: PAnsiChar; __c: Integer): PAnsiChar; external szMSVCRT name 'strchr'; - -function __chkstk(size: size_t): Pointer; -begin - Result := malloc(size); -end; -{$ENDIF CPU64} - -{$IFDEF PCRE_8} -function pcre_malloc_jcl(Size: SizeInt): Pointer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -begin - if Assigned(pcre_malloc_user) then - Result := pcre_malloc_user(Size) - else - Result := malloc(Size); -end; -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} -function pcre16_malloc_jcl(Size: SizeInt): Pointer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -begin - if Assigned(pcre16_malloc_user) then - Result := pcre16_malloc_user(Size) - else - Result := malloc(Size); -end; -{$ENDIF PCRE_16} - -{$IFDEF PCRE_8} -function pcre_stack_malloc_jcl(Size: SizeInt): Pointer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -begin - if Assigned(pcre_stack_malloc_user) then - Result := pcre_stack_malloc_user(Size) - else - Result := malloc(Size); -end; -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} -function pcre16_stack_malloc_jcl(Size: SizeInt): Pointer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -begin - if Assigned(pcre16_stack_malloc_user) then - Result := pcre16_stack_malloc_user(Size) - else - Result := malloc(Size); -end; -{$ENDIF PCRE_16} - -function _malloc(size: size_t): Pointer; -begin - Result := malloc(size); -end; - -procedure free(pBlock: Pointer); cdecl; external szMSVCRT name 'free'; - -{$IFDEF PCRE_8} -procedure pcre_free_jcl(P: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -begin - if Assigned(pcre_free_user) then - pcre_free_user(P) - else - free(P); -end; -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} -procedure pcre16_free_jcl(P: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -begin - if Assigned(pcre16_free_user) then - pcre16_free_user(P) - else - free(P); -end; -{$ENDIF PCRE_16} - -{$IFDEF PCRE_8} -procedure pcre_stack_free_jcl(P: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -begin - if Assigned(pcre_stack_free_user) then - pcre_stack_free_user(P) - else - free(P); -end; -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} -procedure pcre16_stack_free_jcl(P: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -begin - if Assigned(pcre16_stack_free_user) then - pcre16_stack_free_user(P) - else - free(P); -end; -{$ENDIF PCRE_16} - -procedure _free(pBlock: Pointer); -begin - free(pBlock); -end; - -{$IFDEF PCRE_8} -function pcre_callout_jcl(var callout_block: pcre_callout_block): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -begin - if Assigned(pcre_callout_user) then - Result := pcre_callout_user(callout_block) - else - Result := 0; -end; -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} -function pcre16_callout_jcl(var callout_block: pcre16_callout_block): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} -begin - if Assigned(pcre16_callout_user) then - Result := pcre16_callout_user(callout_block) - else - Result := 0; -end; -{$ENDIF PCRE_16} - -{$IFDEF CPU32} -const - {$IFDEF PCRE_8} - _pcre_malloc: pcre_malloc_callback = pcre_malloc_jcl; - _pcre_free: pcre_free_callback = pcre_free_jcl; - _pcre_stack_malloc: pcre_stack_malloc_callback = pcre_stack_malloc_jcl; - _pcre_stack_free: pcre_stack_free_callback = pcre_stack_free_jcl; - _pcre_callout: pcre_callout_callback = pcre_callout_jcl; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - _pcre16_malloc: pcre16_malloc_callback = pcre16_malloc_jcl; - _pcre16_free: pcre16_free_callback = pcre16_free_jcl; - _pcre16_stack_malloc: pcre16_stack_malloc_callback = pcre16_stack_malloc_jcl; - _pcre16_stack_free: pcre16_stack_free_callback = pcre16_stack_free_jcl; - _pcre16_callout: pcre16_callout_callback = pcre16_callout_jcl; - {$ENDIF PCRE_16} -{$ENDIF CPU32} -{$IFDEF CPU64} -const - {$IFDEF PCRE_8} - pcre_malloc: pcre_malloc_callback = pcre_malloc_jcl; - pcre_free: pcre_free_callback = pcre_free_jcl; - pcre_stack_malloc: pcre_stack_malloc_callback = pcre_stack_malloc_jcl; - pcre_stack_free: pcre_stack_free_callback = pcre_stack_free_jcl; - pcre_callout: pcre_callout_callback = pcre_callout_jcl; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_malloc: pcre16_malloc_callback = pcre16_malloc_jcl; - pcre16_free: pcre16_free_callback = pcre16_free_jcl; - pcre16_stack_malloc: pcre16_stack_malloc_callback = pcre16_stack_malloc_jcl; - pcre16_stack_free: pcre16_stack_free_callback = pcre16_stack_free_jcl; - pcre16_callout: pcre16_callout_callback = pcre16_callout_jcl; - {$ENDIF PCRE_16} -{$ENDIF CPU64} - -{$ENDIF PCRE_STATICLINK} - -{$IFDEF PCRE_8} -procedure SetPCREMallocCallback(const Value: pcre_malloc_callback); -begin - {$IFDEF PCRE_STATICLINK} - pcre_malloc_user := Value; - {$ELSE ~PCRE_STATICLINK} - if not Assigned(pcre_malloc_func) then - LoadPCRE; - - if Assigned(pcre_malloc_func) then - pcre_malloc_func^ := Value - else if Assigned(LibNotLoadedHandler) then - LibNotLoadedHandler; - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} -procedure SetPCRE16MallocCallback(const Value: pcre16_malloc_callback); -begin - {$IFDEF PCRE_STATICLINK} - pcre16_malloc_user := Value; - {$ELSE ~PCRE_STATICLINK} - if not Assigned(pcre16_malloc_func) then - LoadPCRE; - - if Assigned(pcre16_malloc_func) then - pcre16_malloc_func^ := Value - else if Assigned(LibNotLoadedHandler) then - LibNotLoadedHandler; - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_16} - -{$IFDEF PCRE_8} -function GetPCREMallocCallback: pcre_malloc_callback; -begin - {$IFDEF PCRE_STATICLINK} - Result := pcre_malloc_user; - {$ELSE ~PCRE_STATICLINK} - if not Assigned(pcre_malloc_func) then - LoadPCRE; - - if not Assigned(pcre_malloc_func) then - begin - Result := nil; - if Assigned(LibNotLoadedHandler) then - LibNotLoadedHandler; - end - else - Result := pcre_malloc_func^; - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} -function GetPCRE16MallocCallback: pcre16_malloc_callback; -begin - {$IFDEF PCRE_STATICLINK} - Result := pcre16_malloc_user; - {$ELSE ~PCRE_STATICLINK} - if not Assigned(pcre16_malloc_func) then - LoadPCRE; - - if not Assigned(pcre16_malloc_func) then - begin - Result := nil; - if Assigned(LibNotLoadedHandler) then - LibNotLoadedHandler; - end - else - Result := pcre16_malloc_func^; - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_16} - -{$IFDEF PCRE_8} -function CallPCREMalloc(Size: SizeInt): Pointer; -begin - {$IFDEF PCRE_STATICLINK} - Result := pcre_malloc_jcl(Size); - {$ELSE ~PCRE_STATICLINK} - Result := pcre_malloc_func^(Size); - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} -function CallPCRE16Malloc(Size: SizeInt): Pointer; -begin - {$IFDEF PCRE_STATICLINK} - Result := pcre16_malloc_jcl(Size); - {$ELSE ~PCRE_STATICLINK} - Result := pcre16_malloc_func^(Size); - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_16} - -{$IFDEF PCRE_8} -procedure SetPCREFreeCallback(const Value: pcre_free_callback); -begin - {$IFDEF PCRE_STATICLINK} - pcre_free_user := Value; - {$ELSE ~PCRE_STATICLINK} - if not Assigned(pcre_free_func) then - LoadPCRE; - - if Assigned(pcre_free_func) then - pcre_free_func^ := Value - else if Assigned(LibNotLoadedHandler) then - LibNotLoadedHandler; - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} -procedure SetPCRE16FreeCallback(const Value: pcre16_free_callback); -begin - {$IFDEF PCRE_STATICLINK} - pcre16_free_user := Value; - {$ELSE ~PCRE_STATICLINK} - if not Assigned(pcre16_free_func) then - LoadPCRE; - - if Assigned(pcre16_free_func) then - pcre16_free_func^ := Value - else if Assigned(LibNotLoadedHandler) then - LibNotLoadedHandler; - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_16} - -{$IFDEF PCRE_8} -function GetPCREFreeCallback: pcre_free_callback; -begin - {$IFDEF PCRE_STATICLINK} - Result := pcre_free_user; - {$ELSE ~PCRE_STATICLINK} - if not Assigned(pcre_free_func) then - LoadPCRE; - - if not Assigned(pcre_free_func) then - begin - Result := nil; - if Assigned(LibNotLoadedHandler) then - LibNotLoadedHandler; - end - else - Result := pcre_free_func^ - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} -function GetPCRE16FreeCallback: pcre16_free_callback; -begin - {$IFDEF PCRE_STATICLINK} - Result := pcre16_free_user; - {$ELSE ~PCRE_STATICLINK} - if not Assigned(pcre16_free_func) then - LoadPCRE; - - if not Assigned(pcre16_free_func) then - begin - Result := nil; - if Assigned(LibNotLoadedHandler) then - LibNotLoadedHandler; - end - else - Result := pcre16_free_func^ - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_16} - -{$IFDEF PCRE_8} -procedure CallPCREFree(P: Pointer); -begin - {$IFDEF PCRE_STATICLINK} - pcre_free_jcl(P); - {$ELSE ~PCRE_STATICLINK} - pcre_free_func^(P); - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} -procedure CallPCRE16Free(P: Pointer); -begin - {$IFDEF PCRE_STATICLINK} - pcre16_free_jcl(P); - {$ELSE ~PCRE_STATICLINK} - pcre16_free_func^(P); - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_16} - -{$IFDEF PCRE_8} -procedure SetPCREStackMallocCallback(const Value: pcre_stack_malloc_callback); -begin - {$IFDEF PCRE_STATICLINK} - pcre_stack_malloc_user := Value; - {$ELSE ~PCRE_STATICLINK} - if not Assigned(pcre_stack_malloc_func) then - LoadPCRE; - - if Assigned(pcre_stack_malloc_func) then - pcre_stack_malloc_func^ := Value - else if Assigned(LibNotLoadedHandler) then - LibNotLoadedHandler; - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} -procedure SetPCRE16StackMallocCallback(const Value: pcre16_stack_malloc_callback); -begin - {$IFDEF PCRE_STATICLINK} - pcre16_stack_malloc_user := Value; - {$ELSE ~PCRE_STATICLINK} - if not Assigned(pcre16_stack_malloc_func) then - LoadPCRE; - - if Assigned(pcre16_stack_malloc_func) then - pcre16_stack_malloc_func^ := Value - else if Assigned(LibNotLoadedHandler) then - LibNotLoadedHandler; - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_16} - -{$IFDEF PCRE_8} -function GetPCREStackMallocCallback: pcre_stack_malloc_callback; -begin - {$IFDEF PCRE_STATICLINK} - Result := pcre_stack_malloc_user; - {$ELSE ~PCRE_STATICLINK} - if not Assigned(pcre_stack_malloc_func) then - LoadPCRE; - - if not Assigned(pcre_stack_malloc_func) then - begin - Result := nil; - if Assigned(LibNotLoadedHandler) then - LibNotLoadedHandler; - end - else - Result := pcre_stack_malloc_func^; - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} -function GetPCRE16StackMallocCallback: pcre16_stack_malloc_callback; -begin - {$IFDEF PCRE_STATICLINK} - Result := pcre16_stack_malloc_user; - {$ELSE ~PCRE_STATICLINK} - if not Assigned(pcre16_stack_malloc_func) then - LoadPCRE; - - if not Assigned(pcre16_stack_malloc_func) then - begin - Result := nil; - if Assigned(LibNotLoadedHandler) then - LibNotLoadedHandler; - end - else - Result := pcre16_stack_malloc_func^; - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_16} - -{$IFDEF PCRE_8} -function CallPCREStackMalloc(Size: SizeInt): Pointer; -begin - {$IFDEF PCRE_STATICLINK} - Result := pcre_stack_malloc_jcl(Size); - {$ELSE ~PCRE_STATICLINK} - Result := pcre_stack_malloc_func^(Size); - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} -function CallPCRE16StackMalloc(Size: SizeInt): Pointer; -begin - {$IFDEF PCRE_STATICLINK} - Result := pcre16_stack_malloc_jcl(Size); - {$ELSE ~PCRE_STATICLINK} - Result := pcre16_stack_malloc_func^(Size); - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_16} - -{$IFDEF PCRE_8} -procedure SetPCREStackFreeCallback(const Value: pcre_stack_free_callback); -begin - {$IFDEF PCRE_STATICLINK} - pcre_stack_free_user := Value; - {$ELSE ~PCRE_STATICLINK} - if not Assigned(pcre_stack_free_func) then - LoadPCRE; - - if Assigned(pcre_stack_free_func) then - pcre_stack_free_func^ := Value - else if Assigned(LibNotLoadedHandler) then - LibNotLoadedHandler; - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} -procedure SetPCRE16StackFreeCallback(const Value: pcre16_stack_free_callback); -begin - {$IFDEF PCRE_STATICLINK} - pcre16_stack_free_user := Value; - {$ELSE ~PCRE_STATICLINK} - if not Assigned(pcre16_stack_free_func) then - LoadPCRE; - - if Assigned(pcre16_stack_free_func) then - pcre16_stack_free_func^ := Value - else if Assigned(LibNotLoadedHandler) then - LibNotLoadedHandler; - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_16} - -{$IFDEF PCRE_8} -function GetPCREStackFreeCallback: pcre_stack_free_callback; -begin - {$IFDEF PCRE_STATICLINK} - Result := pcre_stack_free_user; - {$ELSE ~PCRE_STATICLINK} - if not Assigned(pcre_stack_free_func) then - LoadPCRE; - - if not Assigned(pcre_stack_free_func) then - begin - Result := nil; - if Assigned(LibNotLoadedHandler) then - LibNotLoadedHandler; - end - else - Result := pcre_stack_free_func^; - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} -function GetPCRE16StackFreeCallback: pcre16_stack_free_callback; -begin - {$IFDEF PCRE_STATICLINK} - Result := pcre16_stack_free_user; - {$ELSE ~PCRE_STATICLINK} - if not Assigned(pcre16_stack_free_func) then - LoadPCRE; - - if not Assigned(pcre16_stack_free_func) then - begin - Result := nil; - if Assigned(LibNotLoadedHandler) then - LibNotLoadedHandler; - end - else - Result := pcre16_stack_free_func^; - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_16} - -{$IFDEF PCRE_8} -procedure CallPCREStackFree(P: Pointer); -begin - {$IFDEF PCRE_STATICLINK} - pcre_stack_free_jcl(P); - {$ELSE ~PCRE_STATICLINK} - pcre_stack_free_func^(P); - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} -procedure CallPCRE16StackFree(P: Pointer); -begin - {$IFDEF PCRE_STATICLINK} - pcre16_stack_free_jcl(P); - {$ELSE ~PCRE_STATICLINK} - pcre16_stack_free_func^(P); - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_16} - -{$IFDEF PCRE_8} -procedure SetPCRECalloutCallback(const Value: pcre_callout_callback); -begin - {$IFDEF PCRE_STATICLINK} - pcre_callout_user := Value; - {$ELSE ~PCRE_STATICLINK} - if not Assigned(pcre_callout_func) then - LoadPCRE; - - if Assigned(pcre_callout_func) then - pcre_callout_func^ := Value - else if Assigned(LibNotLoadedHandler) then - LibNotLoadedHandler; - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} -procedure SetPCRE16CalloutCallback(const Value: pcre16_callout_callback); -begin - {$IFDEF PCRE_STATICLINK} - pcre16_callout_user := Value; - {$ELSE ~PCRE_STATICLINK} - if not Assigned(pcre16_callout_func) then - LoadPCRE; - - if Assigned(pcre16_callout_func) then - pcre16_callout_func^ := Value - else if Assigned(LibNotLoadedHandler) then - LibNotLoadedHandler; - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_16} - -{$IFDEF PCRE_8} -function GetPCRECalloutCallback: pcre_callout_callback; -begin - {$IFDEF PCRE_STATICLINK} - Result := pcre_callout_user; - {$ELSE ~PCRE_STATICLINK} - if not Assigned(pcre_callout_func) then - LoadPCRE; - - if not Assigned(pcre_callout_func) then - begin - Result := nil; - if Assigned(LibNotLoadedHandler) then - LibNotLoadedHandler; - end - else - Result := pcre_callout_func^; - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} -function GetPCRE16CalloutCallback: pcre16_callout_callback; -begin - {$IFDEF PCRE_STATICLINK} - Result := pcre16_callout_user; - {$ELSE ~PCRE_STATICLINK} - if not Assigned(pcre16_callout_func) then - LoadPCRE; - - if not Assigned(pcre16_callout_func) then - begin - Result := nil; - if Assigned(LibNotLoadedHandler) then - LibNotLoadedHandler; - end - else - Result := pcre16_callout_func^; - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_16} - -{$IFDEF PCRE_8} -function CallPCRECallout(var callout_block: pcre_callout_block): Integer; -begin - {$IFDEF PCRE_STATICLINK} - Result := pcre_callout_jcl(callout_block); - {$ELSE ~PCRE_STATICLINK} - Result := pcre_callout_func^(callout_block); - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_8} - -{$IFDEF PCRE_16} -function CallPCRE16Callout(var callout_block: pcre16_callout_block): Integer; -begin - {$IFDEF PCRE_STATICLINK} - Result := pcre16_callout_jcl(callout_block); - {$ELSE ~PCRE_STATICLINK} - Result := pcre16_callout_func^(callout_block); - {$ENDIF ~PCRE_STATICLINK} -end; -{$ENDIF PCRE_16} - -{$IFNDEF PCRE_STATICLINK} -procedure InitPCREFuncPtrs(const Value: Pointer); -begin - {$IFDEF PCRE_LINKONREQUEST} - {$IFDEF PCRE_8} - @pcre_compile := Value; - @pcre_compile2 := Value; - @pcre_config := Value; - @pcre_copy_named_substring := Value; - @pcre_copy_substring := Value; - @pcre_dfa_exec := Value; - @pcre_exec := Value; - @pcre_free_substring := Value; - @pcre_free_substring_list := Value; - @pcre_fullinfo := Value; - @pcre_get_named_substring := Value; - @pcre_get_stringnumber := Value; - @pcre_get_stringtable_entries := Value; - @pcre_get_substring := Value; - @pcre_get_substring_list := Value; - @pcre_maketables := Value; - @pcre_refcount := Value; - @pcre_study := Value; - @pcre_free_study := Value; - @pcre_version := Value; - @pcre_jit_stack_alloc := Value; - @pcre_jit_stack_free := Value; - @pcre_assign_jit_stack := Value; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - @pcre16_compile := Value; - @pcre16_compile2 := Value; - @pcre16_config := Value; - @pcre16_copy_named_substring := Value; - @pcre16_copy_substring := Value; - @pcre16_dfa_exec := Value; - @pcre16_exec := Value; - @pcre16_free_substring := Value; - @pcre16_free_substring_list := Value; - @pcre16_fullinfo := Value; - @pcre16_get_named_substring := Value; - @pcre16_get_stringnumber := Value; - @pcre16_get_stringtable_entries := Value; - @pcre16_get_substring := Value; - @pcre16_get_substring_list := Value; - @pcre16_maketables := Value; - @pcre16_refcount := Value; - @pcre16_study := Value; - @pcre16_free_study := Value; - @pcre16_version := Value; - @pcre16_jit_stack_alloc := Value; - @pcre16_jit_stack_free := Value; - @pcre16_assign_jit_stack := Value; - {$ENDIF PCRE_16} - {$ENDIF PCRE_LINKONREQUEST} - {$IFDEF PCRE_8} - pcre_malloc_func := nil; - pcre_free_func := nil; - pcre_stack_malloc_func := nil; - pcre_stack_free_func := nil; - pcre_callout_func := nil; - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_malloc_func := nil; - pcre16_free_func := nil; - pcre16_stack_malloc_func := nil; - pcre16_stack_free_func := nil; - pcre16_callout_func := nil; - {$ENDIF PCRE_16} -end; -{$ENDIF ~PCRE_STATICLINK} -{$ENDIF ~PCRE_RTL} - -function IsPCRELoaded: Boolean; -begin - {$IFDEF PCRE_RTL} - Result := True; - {$ELSE ~PCRE_RTL} - {$IFDEF PCRE_STATICLINK} - Result := True; - {$ELSE ~PCRE_STATICLINK} - Result := PCRELib <> INVALID_MODULEHANDLE_VALUE; - {$ENDIF ~PCRE_STATICLINK} - {$ENDIF ~PCRE_RTL} -end; - -function LoadPCRE: Boolean; -{$IFDEF PCRE_RTL} -begin - Result := True; -end; -{$ELSE ~PCRE_RTL} -{$IFDEF PCRE_STATICLINK} -begin - Result := True; -end; -{$ELSE ~PCRE_STATICLINK} -begin - Result := PCRELib <> INVALID_MODULEHANDLE_VALUE; - if Result then - Exit; - - {$IFDEF PCRE_LINKONREQUEST} - Result := JclSysUtils.LoadModule(PCRELib, PCRELibraryName); - {$ELSE ~PCRE_LINKONREQUEST} - Result := JclSysUtils.LoadModule(PCRELib, PCREDefaultLibraryName); - {$ENDIF ~PCRE_LINKONREQUEST} - if Result then - begin - {$IFDEF PCRE_LINKONREQUEST} - {$IFDEF PCRE_8} - @pcre_compile := GetModuleSymbol(PCRELib, PCRECompileExportName); - @pcre_compile2 := GetModuleSymbol(PCRELib, PCRECompile2ExportName); - @pcre_config := GetModuleSymbol(PCRELib, PCREConfigExportName); - @pcre_copy_named_substring := GetModuleSymbol(PCRELib, PCRECopyNamedSubstringExportName); - @pcre_copy_substring := GetModuleSymbol(PCRELib, PCRECopySubStringExportName); - @pcre_dfa_exec := GetModuleSymbol(PCRELib, PCREDfaExecExportName); - @pcre_exec := GetModuleSymbol(PCRELib, PCREExecExportName); - @pcre_free_substring := GetModuleSymbol(PCRELib, PCREFreeSubStringExportName); - @pcre_free_substring_list := GetModuleSymbol(PCRELib, PCREFreeSubStringListExportName); - @pcre_fullinfo := GetModuleSymbol(PCRELib, PCREFullInfoExportName); - @pcre_get_named_substring := GetModuleSymbol(PCRELib, PCREGetNamedSubstringExportName); - @pcre_get_stringnumber := GetModuleSymbol(PCRELib, PCREGetStringNumberExportName); - @pcre_get_stringtable_entries := GetModuleSymbol(PCRELib, PCREGetStringTableEntriesExportName); - @pcre_get_substring := GetModuleSymbol(PCRELib, PCREGetSubStringExportName); - @pcre_get_substring_list := GetModuleSymbol(PCRELib, PCREGetSubStringListExportName); - @pcre_maketables := GetModuleSymbol(PCRELib, PCREMakeTablesExportName); - @pcre_refcount := GetModuleSymbol(PCRELib, PCRERefCountExportName); - @pcre_study := GetModuleSymbol(PCRELib, PCREStudyExportName); - @pcre_free_study := GetModuleSymbol(PCRELib, PCREFreeStudyExportName); - @pcre_version := GetModuleSymbol(PCRELib, PCREVersionExportName); - @pcre_jit_stack_alloc := GetModuleSymbol(PCRELib, PCREJITStackAllocExportName); - @pcre_jit_stack_free := GetModuleSymbol(PCRELib, PCREJITStackFreeExportName); - @pcre_assign_jit_stack := GetModuleSymbol(PCRELib, PCREAssignJITStackExportName); - pcre_malloc_func := GetModuleSymbol(PCRELib, PCREMallocExportName); - pcre_free_func := GetModuleSymbol(PCRELib, PCREFreeExportName); - pcre_stack_malloc_func := GetModuleSymbol(PCRELib, PCREStackMallocExportName); - pcre_stack_free_func := GetModuleSymbol(PCRELib, PCREStackFreeExportName); - pcre_callout_func := GetModuleSymbol(PCRELib, PCRECalloutExportName); - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - @pcre16_compile := GetModuleSymbol(PCRELib, PCRE16CompileExportName); - @pcre16_compile2 := GetModuleSymbol(PCRELib, PCRE16Compile2ExportName); - @pcre16_config := GetModuleSymbol(PCRELib, PCRE16ConfigExportName); - @pcre16_copy_named_substring := GetModuleSymbol(PCRELib, PCRE16CopyNamedSubstringExportName); - @pcre16_copy_substring := GetModuleSymbol(PCRELib, PCRE16CopySubStringExportName); - @pcre16_dfa_exec := GetModuleSymbol(PCRELib, PCRE16DfaExecExportName); - @pcre16_exec := GetModuleSymbol(PCRELib, PCRE16ExecExportName); - @pcre16_free_substring := GetModuleSymbol(PCRELib, PCRE16FreeSubStringExportName); - @pcre16_free_substring_list := GetModuleSymbol(PCRELib, PCRE16FreeSubStringListExportName); - @pcre16_fullinfo := GetModuleSymbol(PCRELib, PCRE16FullInfoExportName); - @pcre16_get_named_substring := GetModuleSymbol(PCRELib, PCRE16GetNamedSubstringExportName); - @pcre16_get_stringnumber := GetModuleSymbol(PCRELib, PCRE16GetStringNumberExportName); - @pcre16_get_stringtable_entries := GetModuleSymbol(PCRELib, PCRE16GetStringTableEntriesExportName); - @pcre16_get_substring := GetModuleSymbol(PCRELib, PCRE16GetSubStringExportName); - @pcre16_get_substring_list := GetModuleSymbol(PCRELib, PCRE16GetSubStringListExportName); - @pcre16_maketables := GetModuleSymbol(PCRELib, PCRE16MakeTablesExportName); - @pcre16_refcount := GetModuleSymbol(PCRELib, PCRE16RefCountExportName); - @pcre16_study := GetModuleSymbol(PCRELib, PCRE16StudyExportName); - @pcre16_free_study := GetModuleSymbol(PCRELib, PCRE16FreeStudyExportName); - @pcre16_version := GetModuleSymbol(PCRELib, PCRE16VersionExportName); - @pcre16_jit_stack_alloc := GetModuleSymbol(PCRELib, PCRE16JITStackAllocExportName); - @pcre16_jit_stack_free := GetModuleSymbol(PCRELib, PCRE16JITStackFreeExportName); - @pcre16_assign_jit_stack := GetModuleSymbol(PCRELib, PCRE16AssignJITStackExportName); - pcre16_malloc_func := GetModuleSymbol(PCRELib, PCRE16MallocExportName); - pcre16_free_func := GetModuleSymbol(PCRELib, PCRE16FreeExportName); - pcre16_stack_malloc_func := GetModuleSymbol(PCRELib, PCRE16StackMallocExportName); - pcre16_stack_free_func := GetModuleSymbol(PCRELib, PCRE16StackFreeExportName); - pcre16_callout_func := GetModuleSymbol(PCRELib, PCRE16CalloutExportName); - {$ENDIF PCRE_16} - {$ELSE ~PCRE_LINKONREQUEST} - {$IFDEF PCRE_8} - pcre_malloc_func := GetModuleSymbol(PCRELib, PCREMallocDefaultExportName); - pcre_free_func := GetModuleSymbol(PCRELib, PCREFreeDefaultExportName); - pcre_stack_malloc_func := GetModuleSymbol(PCRELib, PCREStackMallocDefaultExportName); - pcre_stack_free_func := GetModuleSymbol(PCRELib, PCREStackFreeDefaultExportName); - pcre_callout_func := GetModuleSymbol(PCRELib, PCRECalloutDefaultExportName); - {$ENDIF PCRE_8} - {$IFDEF PCRE_16} - pcre16_malloc_func := GetModuleSymbol(PCRELib, PCRE16MallocDefaultExportName); - pcre16_free_func := GetModuleSymbol(PCRELib, PCRE16FreeDefaultExportName); - pcre16_stack_malloc_func := GetModuleSymbol(PCRELib, PCRE16StackMallocDefaultExportName); - pcre16_stack_free_func := GetModuleSymbol(PCRELib, PCRE16StackFreeDefaultExportName); - pcre16_callout_func := GetModuleSymbol(PCRELib, PCRE16CalloutDefaultExportName); - {$ENDIF PCRE_16} - {$ENDIF ~PCRE_LINKONREQUEST} - end - else - InitPCREFuncPtrs(@LibNotLoadedHandler); -end; -{$ENDIF ~PCRE_STATICLINK} -{$ENDIF ~PCRE_RTL} - -procedure UnloadPCRE; -begin - {$IFNDEF PCRE_RTL} - {$IFNDEF PCRE_STATICLINK} - InitPCREFuncPtrs(@LibNotLoadedHandler); - JclSysUtils.UnloadModule(PCRELib); - {$ENDIF ~PCRE_STATICLINK} - {$ENDIF ~PCRE_RTL} -end; - -{$IFDEF PCRE_LINKDLL} -{$IFDEF PCRE_8} -function pcre_compile; external PCREDefaultLibraryName name PCRECompileDefaultExportName; -function pcre_compile2; external PCREDefaultLibraryName name PCRECompile2DefaultExportName; -function pcre_config; external PCREDefaultLibraryName name PCREConfigDefaultExportName; -function pcre_copy_named_substring; external PCREDefaultLibraryName name PCRECopyNamedSubStringDefaultExportName; -function pcre_copy_substring; external PCREDefaultLibraryName name PCRECopySubStringDefaultExportName; -function pcre_dfa_exec; external PCREDefaultLibraryName name PCREDfaExecDefaultExportName; -function pcre_exec; external PCREDefaultLibraryName name PCREExecDefaultExportName; -procedure pcre_free_substring; external PCREDefaultLibraryName name PCREFreeSubStringDefaultExportName; -procedure pcre_free_substring_list; external PCREDefaultLibraryName name PCREFreeSubStringListDefaultExportName; -function pcre_fullinfo; external PCREDefaultLibraryName name PCREFullInfoDefaultExportName; -function pcre_get_named_substring; external PCREDefaultLibraryName name PCREGetNamedSubStringDefaultExportName; -function pcre_get_stringnumber; external PCREDefaultLibraryName name PCREGetStringNumberDefaultExportName; -function pcre_get_stringtable_entries; external PCREDefaultLibraryName name PCREGetStringTableEntriesDefaultExportName; -function pcre_get_substring; external PCREDefaultLibraryName name PCREGetSubStringDefaultExportName; -function pcre_get_substring_list; external PCREDefaultLibraryName name PCREGetSubStringListDefaultExportName; -function pcre_maketables; external PCREDefaultLibraryName name PCREMakeTablesDefaultExportName; -function pcre_refcount; external PCREDefaultLibraryName name PCRERefCountDefaultExportName; -function pcre_study; external PCREDefaultLibraryName name PCREStudyDefaultExportName; -procedure pcre_free_study; external PCREDefaultLibraryName name PCREFreeStudyDefaultExportName; -function pcre_version; external PCREDefaultLibraryName name PCREVersionDefaultExportName; -function pcre_jit_stack_alloc; external PCREDefaultLibraryName name PCREJITStackAllocDefaultExportName; -procedure pcre_jit_stack_free; external PCREDefaultLibraryName name PCREJITStackFreeDefaultExportName; -procedure pcre_assign_jit_stack; external PCREDefaultLibraryName name PCREAssignJITStackDefaultExportName; -{$ENDIF PCRE_8} -{$IFDEF PCRE_16} -function pcre16_compile; external PCREDefaultLibraryName name PCRE16CompileDefaultExportName; -function pcre16_compile2; external PCREDefaultLibraryName name PCRE16Compile2DefaultExportName; -function pcre16_config; external PCREDefaultLibraryName name PCRE16ConfigDefaultExportName; -function pcre16_copy_named_substring; external PCREDefaultLibraryName name PCRE16CopyNamedSubStringDefaultExportName; -function pcre16_copy_substring; external PCREDefaultLibraryName name PCRE16CopySubStringDefaultExportName; -function pcre16_dfa_exec; external PCREDefaultLibraryName name PCRE16DfaExecDefaultExportName; -function pcre16_exec; external PCREDefaultLibraryName name PCRE16ExecDefaultExportName; -procedure pcre16_free_substring; external PCREDefaultLibraryName name PCRE16FreeSubStringDefaultExportName; -procedure pcre16_free_substring_list; external PCREDefaultLibraryName name PCRE16FreeSubStringListDefaultExportName; -function pcre16_fullinfo; external PCREDefaultLibraryName name PCRE16FullInfoDefaultExportName; -function pcre16_get_named_substring; external PCREDefaultLibraryName name PCRE16GetNamedSubStringDefaultExportName; -function pcre16_get_stringnumber; external PCREDefaultLibraryName name PCRE16GetStringNumberDefaultExportName; -function pcre16_get_stringtable_entries; external PCREDefaultLibraryName name PCRE16GetStringTableEntriesDefaultExportName; -function pcre16_get_substring; external PCREDefaultLibraryName name PCRE16GetSubStringDefaultExportName; -function pcre16_get_substring_list; external PCREDefaultLibraryName name PCRE16GetSubStringListDefaultExportName; -function pcre16_maketables; external PCREDefaultLibraryName name PCRE16MakeTablesDefaultExportName; -function pcre16_refcount; external PCREDefaultLibraryName name PCRE16RefCountDefaultExportName; -function pcre16_study; external PCREDefaultLibraryName name PCRE16StudyDefaultExportName; -procedure pcre16_free_study; external PCREDefaultLibraryName name PCRE16FreeStudyDefaultExportName; -function pcre16_version; external PCREDefaultLibraryName name PCRE16VersionDefaultExportName; -function pcre16_jit_stack_alloc; external PCREDefaultLibraryName name PCRE16JITStackAllocDefaultExportName; -procedure pcre16_jit_stack_free; external PCREDefaultLibraryName name PCRE16JITStackFreeDefaultExportName; -procedure pcre16_assign_jit_stack; external PCREDefaultLibraryName name PCRE16AssignJITStackDefaultExportName; -{$ENDIF PCRE_16} -{$ENDIF PCRE_LINKDLL} - -{$IFDEF UNITVERSIONING} -initialization - RegisterUnitVersion(HInstance, UnitVersioning); - -finalization - UnregisterUnitVersion(HInstance); -{$ENDIF UNITVERSIONING} - -end. - +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclPRCE.pas. } +{ } +{ The Initial Developer of the Original Code is Peter Thornqvist. } +{ Portions created by Peter Thornqvist are Copyright (C) of Peter Thornqvist. All rights reserved. } +{ Portions created by University of Cambridge are } +{ Copyright (C) 1997-2001 by University of Cambridge. } +{ } +{ Contributor(s): } +{ Robert Rossmair (rrossmair) } +{ Mario R. Carro } +{ Florent Ouchet (outchy) } +{ } +{ The latest release of PCRE is always available from } +{ ftp://ftp.csx.cam.ac.uk/pub/software/programming/pcre/pcre-xxx.tar.gz } +{ } +{**************************************************************************************************} +{ } +{ Header conversion of pcre.h } +{ } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit pcre; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclBase, + JclSysUtils; + +//DOM-IGNORE-BEGIN + +{$IFNDEF PCRE_RTL} + +(************************************************* +* Perl-Compatible Regular Expressions * +*************************************************) + +{$IFDEF SUPPORTS_WEAKPACKAGEUNIT} + // External PCRE can be linked into the final exe/package by one of the three mutually exclusive options: + // PCRE_STATICLINK --> embed the precompiled .OBJ files found in the windows\obj folder + // PCRE_LINKDLL --> static dll import, the DLL must be present when the application starts up + // PCRE_LINKONREQUEST --> dynamic dll import, load the DLL only when asked to do so + // + // PCRE_LINKDLL requires WEAKPACKAGEUNIT to be active for packages to be usable properly but this is not + // compatible with UNITVERSIONING because the latter needs an initialization section. + // In that case we raise a fatal error. + {$IFDEF PCRE_LINKDLL} + {$IFDEF UNITVERSIONING} + {$MESSAGE FATAL 'UNITVERSIONING cannot be active if PCRE_LINKDLL is requested'} + {$ELSE ~UNITVERSIONING} + {$WEAKPACKAGEUNIT ON} + {$ENDIF ~UNITVERSIONING} + {$ENDIF PCRE_LINKDLL} +{$ENDIF SUPPORTS_WEAKPACKAGEUNIT} + +(*$HPPEMIT '#include "pcre.h"'*) + +const + MAX_PATTERN_LENGTH = $10003; + {$EXTERNALSYM MAX_PATTERN_LENGTH} + MAX_QUANTIFY_REPEAT = $10000; + {$EXTERNALSYM MAX_QUANTIFY_REPEAT} + MAX_CAPTURE_COUNT = $FFFF; + {$EXTERNALSYM MAX_CAPTURE_COUNT} + MAX_NESTING_DEPTH = 200; + {$EXTERNALSYM MAX_NESTING_DEPTH} + +const + (* Options *) + PCRE_CASELESS = $00000001; + {$EXTERNALSYM PCRE_CASELESS} + PCRE_MULTILINE = $00000002; + {$EXTERNALSYM PCRE_MULTILINE} + PCRE_DOTALL = $00000004; + {$EXTERNALSYM PCRE_DOTALL} + PCRE_EXTENDED = $00000008; + {$EXTERNALSYM PCRE_EXTENDED} + PCRE_ANCHORED = $00000010; + {$EXTERNALSYM PCRE_ANCHORED} + PCRE_DOLLAR_ENDONLY = $00000020; + {$EXTERNALSYM PCRE_DOLLAR_ENDONLY} + PCRE_EXTRA = $00000040; + {$EXTERNALSYM PCRE_EXTRA} + PCRE_NOTBOL = $00000080; + {$EXTERNALSYM PCRE_NOTBOL} + PCRE_NOTEOL = $00000100; + {$EXTERNALSYM PCRE_NOTEOL} + PCRE_UNGREEDY = $00000200; + {$EXTERNALSYM PCRE_UNGREEDY} + PCRE_NOTEMPTY = $00000400; + {$EXTERNALSYM PCRE_NOTEMPTY} + PCRE_UTF8 = $00000800; + {$EXTERNALSYM PCRE_UTF8} + PCRE_UTF16 = $00000800; + {$EXTERNALSYM PCRE_UTF16} + PCRE_NO_AUTO_CAPTURE = $00001000; + {$EXTERNALSYM PCRE_NO_AUTO_CAPTURE} + PCRE_NO_UTF8_CHECK = $00002000; + {$EXTERNALSYM PCRE_NO_UTF8_CHECK} + PCRE_NO_UTF16_CHECK = $00002000; + {$EXTERNALSYM PCRE_NO_UTF16_CHECK} + PCRE_AUTO_CALLOUT = $00004000; + {$EXTERNALSYM PCRE_AUTO_CALLOUT} + PCRE_PARTIAL_SOFT = $00008000; + {$EXTERNALSYM PCRE_PARTIAL_SOFT} + PCRE_PARTIAL = PCRE_PARTIAL_SOFT; // Backwards compatible synonym + {$EXTERNALSYM PCRE_PARTIAL} + PCRE_DFA_SHORTEST = $00010000; + {$EXTERNALSYM PCRE_DFA_SHORTEST} + PCRE_DFA_RESTART = $00020000; + {$EXTERNALSYM PCRE_DFA_RESTART} + PCRE_FIRSTLINE = $00040000; + {$EXTERNALSYM PCRE_FIRSTLINE} + PCRE_DUPNAMES = $00080000; + {$EXTERNALSYM PCRE_DUPNAMES} + PCRE_NEWLINE_CR = $00100000; + {$EXTERNALSYM PCRE_NEWLINE_CR} + PCRE_NEWLINE_LF = $00200000; + {$EXTERNALSYM PCRE_NEWLINE_LF} + PCRE_NEWLINE_CRLF = $00300000; + {$EXTERNALSYM PCRE_NEWLINE_CRLF} + PCRE_NEWLINE_ANY = $00400000; + {$EXTERNALSYM PCRE_NEWLINE_ANY} + PCRE_NEWLINE_ANYCRLF = $00500000; + {$EXTERNALSYM PCRE_NEWLINE_ANYCRLF} + PCRE_BSR_ANYCRLF = $00800000; + {$EXTERNALSYM PCRE_BSR_ANYCRLF} + PCRE_BSR_UNICODE = $01000000; + {$EXTERNALSYM PCRE_BSR_UNICODE} + PCRE_JAVASCRIPT_COMPAT = $02000000; + {$EXTERNALSYM PCRE_JAVASCRIPT_COMPAT} + PCRE_NO_START_OPTIMIZE = $04000000; + {$EXTERNALSYM PCRE_NO_START_OPTIMIZE} + PCRE_NO_START_OPTIMISE = $04000000; + {$EXTERNALSYM PCRE_NO_START_OPTIMISE} + PCRE_PARTIAL_HARD = $08000000; + {$EXTERNALSYM PCRE_PARTIAL_HARD} + PCRE_NOTEMPTY_ATSTART = $10000000; + {$EXTERNALSYM PCRE_NOTEMPTY_ATSTART} + PCRE_UCP = $20000000; + {$EXTERNALSYM PCRE_UCP} + + (* Exec-time and get-time error codes *) + + PCRE_ERROR_NOMATCH = -1; + {$EXTERNALSYM PCRE_ERROR_NOMATCH} + PCRE_ERROR_NULL = -2; + {$EXTERNALSYM PCRE_ERROR_NULL} + PCRE_ERROR_BADOPTION = -3; + {$EXTERNALSYM PCRE_ERROR_BADOPTION} + PCRE_ERROR_BADMAGIC = -4; + {$EXTERNALSYM PCRE_ERROR_BADMAGIC} + PCRE_ERROR_UNKNOWN_NODE = -5; + {$EXTERNALSYM PCRE_ERROR_UNKNOWN_NODE} + PCRE_ERROR_NOMEMORY = -6; + {$EXTERNALSYM PCRE_ERROR_NOMEMORY} + PCRE_ERROR_NOSUBSTRING = -7; + {$EXTERNALSYM PCRE_ERROR_NOSUBSTRING} + PCRE_ERROR_MATCHLIMIT = -8; + {$EXTERNALSYM PCRE_ERROR_MATCHLIMIT} + PCRE_ERROR_CALLOUT = -9; (* Never used by PCRE itself *) + {$EXTERNALSYM PCRE_ERROR_CALLOUT} + PCRE_ERROR_BADUTF8 = -10; + {$EXTERNALSYM PCRE_ERROR_BADUTF8} + PCRE_ERROR_BADUTF16 = -10; + {$EXTERNALSYM PCRE_ERROR_BADUTF16} + PCRE_ERROR_BADUTF8_OFFSET = -11; + {$EXTERNALSYM PCRE_ERROR_BADUTF8_OFFSET} + PCRE_ERROR_BADUTF16_OFFSET = -11; + {$EXTERNALSYM PCRE_ERROR_BADUTF16_OFFSET} + PCRE_ERROR_PARTIAL = -12; + {$EXTERNALSYM PCRE_ERROR_PARTIAL} + PCRE_ERROR_BADPARTIAL = -13; + {$EXTERNALSYM PCRE_ERROR_BADPARTIAL} + PCRE_ERROR_INTERNAL = -14; + {$EXTERNALSYM PCRE_ERROR_INTERNAL} + PCRE_ERROR_BADCOUNT = -15; + {$EXTERNALSYM PCRE_ERROR_BADCOUNT} + PCRE_ERROR_DFA_UITEM = -16; + {$EXTERNALSYM PCRE_ERROR_DFA_UITEM} + PCRE_ERROR_DFA_UCOND = -17; + {$EXTERNALSYM PCRE_ERROR_DFA_UCOND} + PCRE_ERROR_DFA_UMLIMIT = -18; + {$EXTERNALSYM PCRE_ERROR_DFA_UMLIMIT} + PCRE_ERROR_DFA_WSSIZE = -19; + {$EXTERNALSYM PCRE_ERROR_DFA_WSSIZE} + PCRE_ERROR_DFA_RECURSE = -20; + {$EXTERNALSYM PCRE_ERROR_DFA_RECURSE} + PCRE_ERROR_RECURSIONLIMIT = -21; + {$EXTERNALSYM PCRE_ERROR_RECURSIONLIMIT} + PCRE_ERROR_NULLWSLIMIT = -22; (* No longer actually used *) + {$EXTERNALSYM PCRE_ERROR_NULLWSLIMIT} + PCRE_ERROR_BADNEWLINE = -23; + {$EXTERNALSYM PCRE_ERROR_BADNEWLINE} + PCRE_ERROR_BADOFFSET = -24; + {$EXTERNALSYM PCRE_ERROR_BADOFFSET} + PCRE_ERROR_SHORTUTF8 = -25; + {$EXTERNALSYM PCRE_ERROR_SHORTUTF8} + PCRE_ERROR_SHORTUTF16 = -25; + {$EXTERNALSYM PCRE_ERROR_SHORTUTF16} + PCRE_ERROR_RECURSELOOP = -26; + {$EXTERNALSYM PCRE_ERROR_RECURSELOOP} + PCRE_ERROR_JITSTACKLIMIT = -27; + {$EXTERNALSYM PCRE_ERROR_JITSTACKLIMIT} + PCRE_ERROR_BADMODE = -28; + {$EXTERNALSYM PCRE_ERROR_BADMODE} + PCRE_ERROR_BADENDIANNESS = -29; + {$EXTERNALSYM PCRE_ERROR_BADENDIANNESS} + PCRE_ERROR_DFA_BADRESTART = -30; + {$EXTERNALSYM PCRE_ERROR_DFA_BADRESTART} + + (* Specific error codes for UTF-8 validity checks *) + + PCRE_UTF8_ERR0 = 0; + PCRE_UTF8_ERR1 = 1; + PCRE_UTF8_ERR2 = 2; + PCRE_UTF8_ERR3 = 3; + PCRE_UTF8_ERR4 = 4; + PCRE_UTF8_ERR5 = 5; + PCRE_UTF8_ERR6 = 6; + PCRE_UTF8_ERR7 = 7; + PCRE_UTF8_ERR8 = 8; + PCRE_UTF8_ERR9 = 9; + PCRE_UTF8_ERR10 = 10; + PCRE_UTF8_ERR11 = 11; + PCRE_UTF8_ERR12 = 12; + PCRE_UTF8_ERR13 = 13; + PCRE_UTF8_ERR14 = 14; + PCRE_UTF8_ERR15 = 15; + PCRE_UTF8_ERR16 = 16; + PCRE_UTF8_ERR17 = 17; + PCRE_UTF8_ERR18 = 18; + PCRE_UTF8_ERR19 = 19; + PCRE_UTF8_ERR20 = 20; + PCRE_UTF8_ERR21 = 21; + + (* Specific error codes for UTF-16 validity checks *) + + PCRE_UTF16_ERR0 = 0; + PCRE_UTF16_ERR1 = 1; + PCRE_UTF16_ERR2 = 2; + PCRE_UTF16_ERR3 = 3; + PCRE_UTF16_ERR4 = 4; + + (* Request types for pcre_fullinfo() *) + + PCRE_INFO_OPTIONS = 0; + {$EXTERNALSYM PCRE_INFO_OPTIONS} + PCRE_INFO_SIZE = 1; + {$EXTERNALSYM PCRE_INFO_SIZE} + PCRE_INFO_CAPTURECOUNT = 2; + {$EXTERNALSYM PCRE_INFO_CAPTURECOUNT} + PCRE_INFO_BACKREFMAX = 3; + {$EXTERNALSYM PCRE_INFO_BACKREFMAX} + PCRE_INFO_FIRSTCHAR = 4; + {$EXTERNALSYM PCRE_INFO_FIRSTCHAR} + PCRE_INFO_FIRSTTABLE = 5; + {$EXTERNALSYM PCRE_INFO_FIRSTTABLE} + PCRE_INFO_LASTLITERAL = 6; + {$EXTERNALSYM PCRE_INFO_LASTLITERAL} + PCRE_INFO_NAMEENTRYSIZE = 7; + {$EXTERNALSYM PCRE_INFO_NAMEENTRYSIZE} + PCRE_INFO_NAMECOUNT = 8; + {$EXTERNALSYM PCRE_INFO_NAMECOUNT} + PCRE_INFO_NAMETABLE = 9; + {$EXTERNALSYM PCRE_INFO_NAMETABLE} + PCRE_INFO_STUDYSIZE = 10; + {$EXTERNALSYM PCRE_INFO_STUDYSIZE} + PCRE_INFO_DEFAULT_TABLES = 11; + {$EXTERNALSYM PCRE_INFO_DEFAULT_TABLES} + PCRE_INFO_OKPARTIAL = 12; + {$EXTERNALSYM PCRE_INFO_OKPARTIAL} + PCRE_INFO_JCHANGED = 13; + {$EXTERNALSYM PCRE_INFO_JCHANGED} + PCRE_INFO_HASCRORLF = 14; + {$EXTERNALSYM PCRE_INFO_HASCRORLF} + PCRE_INFO_MINLENGTH = 15; + {$EXTERNALSYM PCRE_INFO_MINLENGTH} + PCRE_INFO_JIT = 16; + {$EXTERNALSYM PCRE_INFO_JIT} + PCRE_INFO_JITSIZE = 17; + {$EXTERNALSYM PCRE_INFO_JITSIZE} + PCRE_INFO_MAXLOOKBEHIND = 18; + {$EXTERNALSYM PCRE_INFO_MAXLOOKBEHIND} + + (* Request types for pcre_config() *) + PCRE_CONFIG_UTF8 = 0; + {$EXTERNALSYM PCRE_CONFIG_UTF8} + PCRE_CONFIG_NEWLINE = 1; + {$EXTERNALSYM PCRE_CONFIG_NEWLINE} + PCRE_CONFIG_LINK_SIZE = 2; + {$EXTERNALSYM PCRE_CONFIG_LINK_SIZE} + PCRE_CONFIG_POSIX_MALLOC_THRESHOLD = 3; + {$EXTERNALSYM PCRE_CONFIG_POSIX_MALLOC_THRESHOLD} + PCRE_CONFIG_MATCH_LIMIT = 4; + {$EXTERNALSYM PCRE_CONFIG_MATCH_LIMIT} + PCRE_CONFIG_STACKRECURSE = 5; + {$EXTERNALSYM PCRE_CONFIG_STACKRECURSE} + PCRE_CONFIG_UNICODE_PROPERTIES = 6; + {$EXTERNALSYM PCRE_CONFIG_UNICODE_PROPERTIES} + PCRE_CONFIG_MATCH_LIMIT_RECURSION = 7; + {$EXTERNALSYM PCRE_CONFIG_MATCH_LIMIT_RECURSION} + PCRE_CONFIG_BSR = 8; + {$EXTERNALSYM PCRE_CONFIG_BSR} + PCRE_CONFIG_JIT = 9; + {$EXTERNALSYM PCRE_CONFIG_JIT} + PCRE_CONFIG_UTF16 = 10; + {$EXTERNALSYM PCRE_CONFIG_UTF16} + PCRE_CONFIG_JITTARGET = 11; + {$EXTERNALSYM PCRE_CONFIG_JITTARGET} + + (* Request types for pcre_study() *) + + PCRE_STUDY_JIT_COMPILE = $0001; + PCRE_STUDY_JIT_PARTIAL_SOFT_COMPILE = $0002; + PCRE_STUDY_JIT_PARTIAL_HARD_COMPILE = $0004; + + (* Bit flags for the pcre_extra structure *) + + PCRE_EXTRA_STUDY_DATA = $0001; + {$EXTERNALSYM PCRE_EXTRA_STUDY_DATA} + PCRE_EXTRA_MATCH_LIMIT = $0002; + {$EXTERNALSYM PCRE_EXTRA_MATCH_LIMIT} + PCRE_EXTRA_CALLOUT_DATA = $0004; + {$EXTERNALSYM PCRE_EXTRA_CALLOUT_DATA} + PCRE_EXTRA_TABLES = $0008; + {$EXTERNALSYM PCRE_EXTRA_TABLES} + PCRE_EXTRA_MATCH_LIMIT_RECURSION = $0010; + {$EXTERNALSYM PCRE_EXTRA_MATCH_LIMIT_RECURSION} + PCRE_EXTRA_MARK = $0020; + {$EXTERNALSYM PCRE_EXTRA_MARK} + PCRE_EXTRA_EXECUTABLE_JIT = $0040; + {$EXTERNALSYM PCRE_EXTRA_EXECUTABLE_JIT} + +type + {$IFDEF PCRE_8} + real_pcre = packed record + {magic_number: Longword; + size: Integer; + tables: PAnsiChar; + options: Longword; + top_bracket: Word; + top_backref: word; + first_char: PAnsiChar; + req_char: PAnsiChar; + code: array [0..0] of AnsiChar;} + end; + TPCRE = real_pcre; + PPCRE = ^TPCRE; + {$ENDIF PCRE_8} + + {$IFDEF PCRE_16} + real_pcre16 = packed record + end; + TPCRE16 = real_pcre16; + PPCRE16 = ^TPCRE16; + {$ENDIF PCRE_16} + + {$IFDEF PCRE_8} + real_pcre_jit_stack = packed record + end; + TPCREJITStack = real_pcre_jit_stack; + PPCREJITStack = ^TPCREJITStack; + {$ENDIF PCRE_8} + + {$IFDEF PCRE_16} + real_pcre16_jit_stack = packed record + end; + TPCRE16JITStack = real_pcre16_jit_stack; + PPCRE16JITStack = ^TPCRE16JITStack; + {$ENDIF PCRE_16} + + {$IFDEF PCRE_8} + real_pcre_extra = packed record + flags: Cardinal; (* Bits for which fields are set *) + study_data: Pointer; (* Opaque data from pcre_study() *) + match_limit: Cardinal; (* Maximum number of calls to match() *) + callout_data: Pointer; (* Data passed back in callouts *) + tables: PAnsiChar; (* Pointer to character tables *) + match_limit_recursion: Cardinal; (* Max recursive calls to match() *) + mark: PPAnsiChar; (* For passing back a mark pointer *) + executable_jit: Pointer; (* Contains a pointer to a compiled jit code *) + end; + TPCREExtra = real_pcre_extra; + PPCREExtra = ^TPCREExtra; + {$ENDIF PCRE_8} + + {$IFDEF PCRE_16} + real_pcre16_extra = packed record + flags: Cardinal; (* Bits for which fields are set *) + study_data: Pointer; (* Opaque data from pcre_study() *) + match_limit: Cardinal; (* Maximum number of calls to match() *) + callout_data: Pointer; (* Data passed back in callouts *) + tables: PAnsiChar; (* Pointer to character tables *) + match_limit_recursion: Cardinal; (* Max recursive calls to match() *) + mark: PPWideChar; (* For passing back a mark pointer *) + executable_jit: Pointer; (* Contains a pointer to a compiled jit code *) + end; + TPCRE16Extra = real_pcre16_extra; + PPCRE16Extra = ^TPCRE16Extra; + {$ENDIF PCRE_16} + + {$IFDEF PCRE_8} + pcre_callout_block = packed record + version: Integer; (* Identifies version of block *) + (* ------------------------ Version 0 ------------------------------- *) + callout_number: Integer; (* Number compiled into pattern *) + offset_vector: PInteger; (* The offset vector *) + subject: PAnsiChar; (* The subject being matched *) + subject_length: Integer; (* The length of the subject *) + start_match: Integer; (* Offset to start of this match attempt *) + current_position: Integer; (* Where we currently are in the subject *) + capture_top: Integer; (* Max current capture *) + capture_last: Integer; (* Most recently closed capture *) + callout_data: Pointer; (* Data passed in with the call *) + (* ------------------- Added for Version 1 -------------------------- *) + pattern_position: Integer; (* Offset to next item in the pattern *) + next_item_length: Integer; (* Length of next item in the pattern *) + (* ------------------- Added for Version 2 -------------------------- *) + Mark: PCardinal; (* Pointer to current mark or NULL *) + (* ------------------------------------------------------------------ *) + end; + {$ENDIF PCRE_8} + + {$IFDEF PCRE_16} + pcre16_callout_block = packed record + version: Integer; (* Identifies version of block *) + (* ------------------------ Version 0 ------------------------------- *) + callout_number: Integer; (* Number compiled into pattern *) + offset_vector: PInteger; (* The offset vector *) + subject: PWideChar; (* The subject being matched *) + subject_length: Integer; (* The length of the subject *) + start_match: Integer; (* Offset to start of this match attempt *) + current_position: Integer; (* Where we currently are in the subject *) + capture_top: Integer; (* Max current capture *) + capture_last: Integer; (* Most recently closed capture *) + callout_data: Pointer; (* Data passed in with the call *) + (* ------------------- Added for Version 1 -------------------------- *) + pattern_position: Integer; (* Offset to next item in the pattern *) + next_item_length: Integer; (* Length of next item in the pattern *) + (* ------------------- Added for Version 2 -------------------------- *) + Mark: PCardinal; (* Pointer to current mark or NULL *) + (* ------------------------------------------------------------------ *) + end; + {$ENDIF PCRE_16} + + {$IFDEF PCRE_8} + pcre_malloc_callback = function(Size: SizeInt): Pointer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_malloc_callback} + pcre_free_callback = procedure(P: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_free_callback} + pcre_stack_malloc_callback = function(Size: SizeInt): Pointer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_stack_malloc_callback} + pcre_stack_free_callback = procedure(P: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_stack_free_callback} + pcre_callout_callback = function(var callout_block: pcre_callout_block): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_callout_callback} + pcre_jit_callback = function (P: Pointer): PPCREJITStack; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_jit_callback} + {$ENDIF PCRE_8} + + {$IFDEF PCRE_16} + pcre16_malloc_callback = function(Size: SizeInt): Pointer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_malloc_callback} + pcre16_free_callback = procedure(P: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_free_callback} + pcre16_stack_malloc_callback = function(Size: SizeInt): Pointer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_stack_malloc_callback} + pcre16_stack_free_callback = procedure(P: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_stack_free_callback} + pcre16_callout_callback = function(var callout_block: pcre16_callout_block): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_callout_callback} + pcre16_jit_callback = function (P: Pointer): PPCRE16JITStack; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_jit_callback} + {$ENDIF PCRE_16} + +var + {$IFDEF PCRE_8} + // renamed from "pcre_X" to "pcre_X_func" to allow functions with name "pcre_X" to be + // declared in implementation when static linked + pcre_malloc_func: ^pcre_malloc_callback = nil; + {$EXTERNALSYM pcre_malloc_func} + pcre_free_func: ^pcre_free_callback = nil; + {$EXTERNALSYM pcre_free_func} + pcre_stack_malloc_func: ^pcre_stack_malloc_callback = nil; + {$EXTERNALSYM pcre_stack_malloc_func} + pcre_stack_free_func: ^pcre_stack_free_callback = nil; + {$EXTERNALSYM pcre_stack_free_func} + pcre_callout_func: ^pcre_callout_callback = nil; + {$EXTERNALSYM pcre_callout_func} + {$ENDIF PCRE_8} + + {$IFDEF PCRE_16} + pcre16_malloc_func: ^pcre16_malloc_callback = nil; + {$EXTERNALSYM pcre16_malloc_func} + pcre16_free_func: ^pcre16_free_callback = nil; + {$EXTERNALSYM pcre16_free_func} + pcre16_stack_malloc_func: ^pcre16_stack_malloc_callback = nil; + {$EXTERNALSYM pcre16_stack_malloc_func} + pcre16_stack_free_func: ^pcre16_stack_free_callback = nil; + {$EXTERNALSYM pcre16_stack_free_func} + pcre16_callout_func: ^pcre16_callout_callback = nil; + {$EXTERNALSYM pcre16_callout_func} + {$ENDIF PCRE_16} + +{$IFDEF PCRE_8} + +procedure SetPCREMallocCallback(const Value: pcre_malloc_callback); +{$EXTERNALSYM SetPCREMallocCallback} +function GetPCREMallocCallback: pcre_malloc_callback; +{$EXTERNALSYM GetPCREMallocCallback} +function CallPCREMalloc(Size: SizeInt): Pointer; +{$EXTERNALSYM CallPCREMalloc} + +procedure SetPCREFreeCallback(const Value: pcre_free_callback); +{$EXTERNALSYM SetPCREFreeCallback} +function GetPCREFreeCallback: pcre_free_callback; +{$EXTERNALSYM GetPCREFreeCallback} +procedure CallPCREFree(P: Pointer); +{$EXTERNALSYM CallPCREFree} + +procedure SetPCREStackMallocCallback(const Value: pcre_stack_malloc_callback); +{$EXTERNALSYM SetPCREStackMallocCallback} +function GetPCREStackMallocCallback: pcre_stack_malloc_callback; +{$EXTERNALSYM GetPCREStackMallocCallback} +function CallPCREStackMalloc(Size: SizeInt): Pointer; +{$EXTERNALSYM CallPCREStackMalloc} + +procedure SetPCREStackFreeCallback(const Value: pcre_stack_free_callback); +{$EXTERNALSYM SetPCREStackFreeCallback} +function GetPCREStackFreeCallback: pcre_stack_free_callback; +{$EXTERNALSYM GetPCREStackFreeCallback} +procedure CallPCREStackFree(P: Pointer); +{$EXTERNALSYM CallPCREStackFree} + +procedure SetPCRECalloutCallback(const Value: pcre_callout_callback); +{$EXTERNALSYM SetPCRECalloutCallback} +function GetPCRECalloutCallback: pcre_callout_callback; +{$EXTERNALSYM GetPCRECalloutCallback} +function CallPCRECallout(var callout_block: pcre_callout_block): Integer; +{$EXTERNALSYM CallPCRECallout} + +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} + +procedure SetPCRE16MallocCallback(const Value: pcre16_malloc_callback); +{$EXTERNALSYM SetPCRE16MallocCallback} +function GetPCRE16MallocCallback: pcre16_malloc_callback; +{$EXTERNALSYM GetPCRE16MallocCallback} +function CallPCRE16Malloc(Size: SizeInt): Pointer; +{$EXTERNALSYM CallPCRE16Malloc} + +procedure SetPCRE16FreeCallback(const Value: pcre16_free_callback); +{$EXTERNALSYM SetPCRE16FreeCallback} +function GetPCRE16FreeCallback: pcre16_free_callback; +{$EXTERNALSYM GetPCRE16FreeCallback} +procedure CallPCRE16Free(P: Pointer); +{$EXTERNALSYM CallPCRE16Free} + +procedure SetPCRE16StackMallocCallback(const Value: pcre16_stack_malloc_callback); +{$EXTERNALSYM SetPCRE16StackMallocCallback} +function GetPCRE16StackMallocCallback: pcre16_stack_malloc_callback; +{$EXTERNALSYM GetPCRE16StackMallocCallback} +function CallPCRE16StackMalloc(Size: SizeInt): Pointer; +{$EXTERNALSYM CallPCRE16StackMalloc} + +procedure SetPCRE16StackFreeCallback(const Value: pcre16_stack_free_callback); +{$EXTERNALSYM SetPCRE16StackFreeCallback} +function GetPCRE16StackFreeCallback: pcre16_stack_free_callback; +{$EXTERNALSYM GetPCRE16StackFreeCallback} +procedure CallPCRE16StackFree(P: Pointer); +{$EXTERNALSYM CallPCRE16StackFree} + +procedure SetPCRE16CalloutCallback(const Value: pcre16_callout_callback); +{$EXTERNALSYM SetPCRE16CalloutCallback} +function GetPCRE16CalloutCallback: pcre16_callout_callback; +{$EXTERNALSYM GetPCRE16CalloutCallback} +function CallPCRE16Callout(var callout_block: pcre16_callout_block): Integer; +{$EXTERNALSYM CallPCRE16Callout} + +{$ENDIF PCRE_16} + +type + TPCRELibNotLoadedHandler = procedure; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + PPPWideChar = ^PPWideChar; + +var + // Value to initialize function pointers below with, in case LoadPCRE fails + // or UnloadPCRE is called. Typically the handler will raise an exception. + LibNotLoadedHandler: TPCRELibNotLoadedHandler = nil; + +(* Functions *) + +{$IFNDEF PCRE_LINKONREQUEST} +// static link and static dll import +{$IFDEF PCRE_8} +function pcre_compile(const pattern: PAnsiChar; options: Integer; + const errptr: PPAnsiChar; erroffset: PInteger; const tableptr: PAnsiChar): PPCRE; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre_compile} +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +function pcre16_compile(const pattern: PWideChar; options: Integer; + const errptr: PPAnsiChar; erroffset: PInteger; const tableptr: PAnsiChar): PPCRE16; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre16_compile} +{$ENDIF PCRE_16} +{$IFDEF PCRE_8} +function pcre_compile2(const pattern: PAnsiChar; options: Integer; + const errorcodeptr: PInteger; const errorptr: PPAnsiChar; erroroffset: PInteger; + const tables: PAnsiChar): PPCRE; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre_compile2} +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +function pcre16_compile2(const pattern: PWideChar; options: Integer; + const errorcodeptr: PInteger; const errorptr: PPAnsiChar; erroroffset: PInteger; + const tables: PAnsiChar): PPCRE16; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre16_compile2} +{$ENDIF PCRE_16} +{$IFDEF PCRE_8} +function pcre_config(what: Integer; where: Pointer): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre_config} +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +function pcre16_config(what: Integer; where: Pointer): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre16_config} +{$ENDIF PCRE_16} +{$IFDEF PCRE_8} +function pcre_copy_named_substring(const code: PPCRE; const subject: PAnsiChar; + ovector: PInteger; stringcount: Integer; const stringname: PAnsiChar; + buffer: PAnsiChar; size: Integer): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre_copy_named_substring} +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +function pcre16_copy_named_substring(const code: PPCRE16; const subject: PWideChar; + ovector: PInteger; stringcount: Integer; const stringname: PWideChar; + buffer: PWideChar; size: Integer): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre16_copy_named_substring} +{$ENDIF PCRE_16} +{$IFDEF PCRE_8} +function pcre_copy_substring(const subject: PAnsiChar; ovector: PInteger; + stringcount, stringnumber: Integer; buffer: PAnsiChar; buffersize: Integer): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre_copy_substring} +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +function pcre16_copy_substring(const subject: PWideChar; ovector: PInteger; + stringcount, stringnumber: Integer; buffer: PWideChar; buffersize: Integer): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre16_copy_substring} +{$ENDIF PCRE_16} +{$IFDEF PCRE_8} +function pcre_dfa_exec(const argument_re: PPCRE; const extra_data: PPCREExtra; + const subject: PAnsiChar; length: Integer; start_offset: Integer; + options: Integer; offsets: PInteger; offsetcount: Integer; workspace: PInteger; + wscount: Integer): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre_dfa_exec} +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +function pcre16_dfa_exec(const argument_re: PPCRE16; const extra_data: PPCRE16Extra; + const subject: PWideChar; length: Integer; start_offset: Integer; + options: Integer; offsets: PInteger; offsetcount: Integer; workspace: PInteger; + wscount: Integer): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre16_dfa_exec} +{$ENDIF PCRE_16} +{$IFDEF PCRE_8} +function pcre_exec(const code: PPCRE; const extra: PPCREExtra; const subject: PAnsiChar; + length, startoffset, options: Integer; ovector: PInteger; ovecsize: Integer): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre_exec} +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +function pcre16_exec(const code: PPCRE16; const extra: PPCRE16Extra; const subject: PWideChar; + length, startoffset, options: Integer; ovector: PInteger; ovecsize: Integer): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre16_exec} +{$ENDIF PCRE_16} +{$IFDEF PCRE_8} +procedure pcre_free_substring(stringptr: PAnsiChar); + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre_free_substring} +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +procedure pcre16_free_substring(stringptr: PWideChar); + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre16_free_substring} +{$ENDIF PCRE_16} +{$IFDEF PCRE_8} +procedure pcre_free_substring_list(stringlistptr: PPAnsiChar); + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre_free_substring_list} +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +procedure pcre16_free_substring_list(stringlistptr: PPWideChar); + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre16_free_substring_list} +{$ENDIF PCRE_16} +{$IFDEF PCRE_8} +function pcre_fullinfo(const code: PPCRE; const extra: PPCREExtra; + what: Integer; where: Pointer): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre_fullinfo} +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +function pcre16_fullinfo(const code: PPCRE16; const extra: PPCRE16Extra; + what: Integer; where: Pointer): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre16_fullinfo} +{$ENDIF PCRE_16} +{$IFDEF PCRE_8} +function pcre_get_named_substring(const code: PPCRE; const subject: PAnsiChar; + ovector: PInteger; stringcount: Integer; const stringname: PAnsiChar; + const stringptr: PPAnsiChar): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre_get_named_substring} +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +function pcre16_get_named_substring(const code: PPCRE16; const subject: PWideChar; + ovector: PInteger; stringcount: Integer; const stringname: PWideChar; + const stringptr: PPWideChar): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre16_get_named_substring} +{$ENDIF PCRE_16} +{$IFDEF PCRE_8} +function pcre_get_stringnumber(const code: PPCRE; const stringname: PAnsiChar): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre_get_stringnumber} +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +function pcre16_get_stringnumber(const code: PPCRE16; const stringname: PWideChar): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre16_get_stringnumber} +{$ENDIF PCRE_16} +{$IFDEF PCRE_8} +function pcre_get_stringtable_entries(const code: PPCRE; const stringname: PAnsiChar; + firstptr: PPAnsiChar; lastptr: PPAnsiChar): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre_get_stringtable_entries} +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +function pcre16_get_stringtable_entries(const code: PPCRE16; const stringname: PWideChar; + firstptr: PPWideChar; lastptr: PPWideChar): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre16_get_stringtable_entries} +{$ENDIF PCRE_16} +{$IFDEF PCRE_8} +function pcre_get_substring(const subject: PAnsiChar; ovector: PInteger; + stringcount, stringnumber: Integer; const stringptr: PPAnsiChar): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre_get_substring} +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +function pcre16_get_substring(const subject: PWideChar; ovector: PInteger; + stringcount, stringnumber: Integer; const stringptr: PPWideChar): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre16_get_substring} +{$ENDIF PCRE_16} +{$IFDEF PCRE_8} +function pcre_get_substring_list(const subject: PAnsiChar; ovector: PInteger; + stringcount: Integer; listptr: PPPAnsiChar): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre_get_substring_list} +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +function pcre16_get_substring_list(const subject: PWideChar; ovector: PInteger; + stringcount: Integer; listptr: PPPWideChar): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre16_get_substring_list} +{$ENDIF PCRE_16} +{$IFDEF PCRE_8} +function pcre_maketables: PAnsiChar; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre_maketables} +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +function pcre16_maketables: PAnsiChar; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre16_maketables} +{$ENDIF PCRE_16} +{$IFDEF PCRE_8} +function pcre_refcount(argument_re: PPCRE; adjust: Integer): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre_refcount} +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +function pcre16_refcount(argument_re: PPCRE16; adjust: Integer): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre16_refcount} +{$ENDIF PCRE_16} +{$IFDEF PCRE_8} +function pcre_study(const code: PPCRE; options: Integer; const errptr: PPAnsiChar): PPCREExtra; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre_study} +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +function pcre16_study(const code: PPCRE16; options: Integer; const errptr: PPAnsiChar): PPCRE16Extra; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre16_study} +{$ENDIF PCRE_16} +{$IFDEF PCRE_8} +procedure pcre_free_study(const extra: PPCREExtra); + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre_free_study} +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +procedure pcre16_free_study(const extra: PPCRE16Extra); + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre16_free_study} +{$ENDIF PCRE_16} +{$IFDEF PCRE_8} +function pcre_version: PAnsiChar; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre_version} +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +function pcre16_version: PAnsiChar; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre16_version} +{$ENDIF PCRE_16} +{$IFDEF PCRE_8} +function pcre_jit_stack_alloc(startsize, maxsize: Integer): PPCREJITStack; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre_jit_stack_alloc} +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +function pcre16_jit_stack_alloc(startsize, maxsize: Integer): PPCRE16JITStack; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre16_jit_stack_alloc} +{$ENDIF PCRE_16} +{$IFDEF PCRE_8} +procedure pcre_jit_stack_free(stack: PPCREJITStack); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre_jit_stack_free} +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +procedure pcre16_jit_stack_free(stack: PPCRE16JITStack); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre16_jit_stack_free} +{$ENDIF PCRE_16} +{$IFDEF PCRE_8} +procedure pcre_assign_jit_stack(extra: PPCREExtra; callback: pcre_jit_callback; userdata: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre_assign_jit_stack} +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +procedure pcre16_assign_jit_stack(extra: PPCRE16Extra; callback: pcre16_jit_callback; userdata: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +{$EXTERNALSYM pcre16_assign_jit_stack} +{$ENDIF PCRE_16} + +{$ELSE PCRE_LINKONREQUEST} + +// dynamic dll import +type + {$IFDEF PCRE_8} + pcre_compile_func = function(const pattern: PAnsiChar; options: Integer; + const errptr: PPAnsiChar; erroffset: PInteger; const tableptr: PAnsiChar): PPCRE; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_compile_func} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_compile_func = function(const pattern: PWideChar; options: Integer; + const errptr: PPAnsiChar; erroffset: PInteger; const tableptr: PAnsiChar): PPCRE16; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_compile_func} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_compile2_func = function(const pattern: PAnsiChar; options: Integer; + const errorcodeptr: PInteger; const errorptr: PPAnsiChar; erroroffset: PInteger; + const tables: PAnsiChar): PPCRE; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_compile2_func} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_compile2_func = function(const pattern: PWideChar; options: Integer; + const errorcodeptr: PInteger; const errorptr: PPAnsiChar; erroroffset: PInteger; + const tables: PAnsiChar): PPCRE16; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_compile2_func} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_config_func = function(what: Integer; where: Pointer): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_config_func} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_config_func = function(what: Integer; where: Pointer): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_config_func} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_copy_named_substring_func = function(const code: PPCRE; const subject: PAnsiChar; + ovector: PInteger; stringcount: Integer; const stringname: PAnsiChar; + buffer: PAnsiChar; size: Integer): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_copy_named_substring_func} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_copy_named_substring_func = function(const code: PPCRE16; const subject: PWideChar; + ovector: PInteger; stringcount: Integer; const stringname: PWideChar; + buffer: PWideChar; size: Integer): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_copy_named_substring_func} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_copy_substring_func = function(const subject: PAnsiChar; ovector: PInteger; + stringcount, stringnumber: Integer; buffer: PAnsiChar; buffersize: Integer): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_copy_substring_func} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_copy_substring_func = function(const subject: PWideChar; ovector: PInteger; + stringcount, stringnumber: Integer; buffer: PWideChar; buffersize: Integer): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_copy_substring_func} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_dfa_exec_func = function(const argument_re: PPCRE; const extra_data: PPCREExtra; + const subject: PAnsiChar; length: Integer; start_offset: Integer; + options: Integer; offsets: PInteger; offsetcount: Integer; workspace: PInteger; + wscount: Integer): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_dfa_exec_func} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_dfa_exec_func = function(const argument_re: PPCRE16; const extra_data: PPCRE16Extra; + const subject: PWideChar; length: Integer; start_offset: Integer; + options: Integer; offsets: PInteger; offsetcount: Integer; workspace: PInteger; + wscount: Integer): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_dfa_exec_func} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_exec_func = function(const code: PPCRE; const extra: PPCREExtra; const subject: PAnsiChar; + length, startoffset, options: Integer; ovector: PInteger; ovecsize: Integer): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_exec_func} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_exec_func = function(const code: PPCRE16; const extra: PPCRE16Extra; const subject: PWideChar; + length, startoffset, options: Integer; ovector: PInteger; ovecsize: Integer): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_exec_func} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_free_substring_func = procedure(stringptr: PAnsiChar); + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_free_substring_func} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_free_substring_func = procedure(stringptr: PWideChar); + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_free_substring_func} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_free_substring_list_func = procedure(stringptr: PPAnsiChar); + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_free_substring_list_func} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_free_substring_list_func = procedure(stringptr: PPWideChar); + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_free_substring_list_func} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_fullinfo_func = function(const code: PPCRE; const extra: PPCREExtra; + what: Integer; where: Pointer): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_fullinfo_func} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_fullinfo_func = function(const code: PPCRE16; const extra: PPCRE16Extra; + what: Integer; where: Pointer): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_fullinfo_func} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_get_named_substring_func = function(const code: PPCRE; const subject: PAnsiChar; + ovector: PInteger; stringcount: Integer; const stringname: PAnsiChar; + const stringptr: PPAnsiChar): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_get_named_substring_func} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_get_named_substring_func = function(const code: PPCRE16; const subject: PWideChar; + ovector: PInteger; stringcount: Integer; const stringname: PWideChar; + const stringptr: PPWideChar): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_get_named_substring_func} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_get_stringnumber_func = function(const code: PPCRE; + const stringname: PAnsiChar): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_get_stringnumber_func} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_get_stringnumber_func = function(const code: PPCRE16; + const stringname: PWideChar): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_get_stringnumber_func} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_get_stringtable_entries_func = function(const code: PPCRE; const stringname: PAnsiChar; + firstptr: PPAnsiChar; lastptr: PPAnsiChar): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_get_stringtable_entries_func} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_get_stringtable_entries_func = function(const code: PPCRE16; const stringname: PWideChar; + firstptr: PPWideChar; lastptr: PPWideChar): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_get_stringtable_entries_func} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_get_substring_func = function(const subject: PAnsiChar; ovector: PInteger; + stringcount, stringnumber: Integer; const stringptr: PPAnsiChar): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_get_substring_func} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_get_substring_func = function(const subject: PWideChar; ovector: PInteger; + stringcount, stringnumber: Integer; const stringptr: PPWideChar): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_get_substring_func} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_get_substring_list_func = function(const subject: PAnsiChar; ovector: PInteger; + stringcount: Integer; listptr: PPPAnsiChar): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_get_substring_list_func} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_get_substring_list_func = function(const subject: PWideChar; ovector: PInteger; + stringcount: Integer; listptr: PPPWideChar): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_get_substring_list_func} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_maketables_func = function: PAnsiChar; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_maketables_func} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_maketables_func = function: PAnsiChar; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_maketables_func} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_refcount_func = function(argument_re: PPCRE; adjust: Integer): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_refcount_func} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_refcount_func = function(argument_re: PPCRE16; adjust: Integer): Integer; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_refcount_func} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_study_func = function(const code: PPCRE; options: Integer; const errptr: PPAnsiChar): PPCREExtra; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_study_func} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_study_func = function(const code: PPCRE16; options: Integer; const errptr: PPAnsiChar): PPCRE16Extra; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_study_func} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_free_study_func = procedure (const extra: PPCREExtra); + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_free_study_func} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_free_study_func = procedure (const extra: PPCRE16Extra); + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_free_study_func} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_version_func = function: PAnsiChar; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_version_func} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_version_func = function: PAnsiChar; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_version_func} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_jit_stack_alloc_func = function (startsize, maxsize: Integer): PPCREJITStack; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_jit_stack_alloc_func} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_jit_stack_alloc_func = function (startsize, maxsize: Integer): PPCRE16JITStack; + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_jit_stack_alloc_func} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_jit_stack_free_func = procedure (stack: PPCREJITStack); + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_jit_stack_free_func} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_jit_stack_free_func = procedure (stack: PPCRE16JITStack); + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_jit_stack_free_func} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_assign_jit_stack_func = procedure (extra: PPCREExtra; callback: pcre_jit_callback; userdata: Pointer); + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre_assign_jit_stack_func} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_assign_jit_stack_func = procedure (extra: PPCRE16Extra; callback: pcre16_jit_callback; userdata: Pointer); + {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} + {$EXTERNALSYM pcre16_assign_jit_stack_func} + {$ENDIF PCRE_16} + +var + {$IFDEF PCRE_8} + pcre_compile: pcre_compile_func = nil; + {$EXTERNALSYM pcre_compile} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_compile: pcre16_compile_func = nil; + {$EXTERNALSYM pcre16_compile} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_compile2: pcre_compile2_func = nil; + {$EXTERNALSYM pcre_compile2} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_compile2: pcre16_compile2_func = nil; + {$EXTERNALSYM pcre16_compile2} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_config: pcre_config_func = nil; + {$EXTERNALSYM pcre_config} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_config: pcre16_config_func = nil; + {$EXTERNALSYM pcre16_config} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_copy_named_substring: pcre_copy_named_substring_func = nil; + {$EXTERNALSYM pcre_copy_named_substring} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_copy_named_substring: pcre16_copy_named_substring_func = nil; + {$EXTERNALSYM pcre16_copy_named_substring} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_copy_substring: pcre_copy_substring_func = nil; + {$EXTERNALSYM pcre_copy_substring} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_copy_substring: pcre16_copy_substring_func = nil; + {$EXTERNALSYM pcre16_copy_substring} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_dfa_exec: pcre_dfa_exec_func = nil; + {$EXTERNALSYM pcre_dfa_exec} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_dfa_exec: pcre16_dfa_exec_func = nil; + {$EXTERNALSYM pcre16_dfa_exec} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_exec: pcre_exec_func = nil; + {$EXTERNALSYM pcre_exec} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_exec: pcre16_exec_func = nil; + {$EXTERNALSYM pcre16_exec} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_free_substring: pcre_free_substring_func = nil; + {$EXTERNALSYM pcre_free_substring} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_free_substring: pcre16_free_substring_func = nil; + {$EXTERNALSYM pcre16_free_substring} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_free_substring_list: pcre_free_substring_list_func = nil; + {$EXTERNALSYM pcre_free_substring_list} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_free_substring_list: pcre16_free_substring_list_func = nil; + {$EXTERNALSYM pcre16_free_substring_list} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_fullinfo: pcre_fullinfo_func = nil; + {$EXTERNALSYM pcre_fullinfo} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_fullinfo: pcre16_fullinfo_func = nil; + {$EXTERNALSYM pcre16_fullinfo} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_get_named_substring: pcre_get_named_substring_func = nil; + {$EXTERNALSYM pcre_get_named_substring} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_get_named_substring: pcre16_get_named_substring_func = nil; + {$EXTERNALSYM pcre16_get_named_substring} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_get_stringnumber: pcre_get_stringnumber_func = nil; + {$EXTERNALSYM pcre_get_stringnumber} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_get_stringnumber: pcre16_get_stringnumber_func = nil; + {$EXTERNALSYM pcre16_get_stringnumber} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_get_stringtable_entries: pcre_get_stringtable_entries_func = nil; + {$EXTERNALSYM pcre_get_stringtable_entries} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_get_stringtable_entries: pcre16_get_stringtable_entries_func = nil; + {$EXTERNALSYM pcre16_get_stringtable_entries} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_get_substring: pcre_get_substring_func = nil; + {$EXTERNALSYM pcre_get_substring} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_get_substring: pcre16_get_substring_func = nil; + {$EXTERNALSYM pcre16_get_substring} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_get_substring_list: pcre_get_substring_list_func = nil; + {$EXTERNALSYM pcre_get_substring_list} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_get_substring_list: pcre16_get_substring_list_func = nil; + {$EXTERNALSYM pcre16_get_substring_list} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_maketables: pcre_maketables_func = nil; + {$EXTERNALSYM pcre_maketables} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_maketables: pcre16_maketables_func = nil; + {$EXTERNALSYM pcre16_maketables} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_refcount: pcre_refcount_func = nil; + {$EXTERNALSYM pcre_refcount} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_refcount: pcre16_refcount_func = nil; + {$EXTERNALSYM pcre16_refcount} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_study: pcre_study_func = nil; + {$EXTERNALSYM pcre_study} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_study: pcre16_study_func = nil; + {$EXTERNALSYM pcre16_study} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_free_study: pcre_free_study_func = nil; + {$EXTERNALSYM pcre_free_study} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_free_study: pcre16_free_study_func = nil; + {$EXTERNALSYM pcre16_free_study} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_version: pcre_version_func = nil; + {$EXTERNALSYM pcre_version} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_version: pcre16_version_func = nil; + {$EXTERNALSYM pcre16_version} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_jit_stack_alloc: pcre_jit_stack_alloc_func = nil; + {$EXTERNALSYM pcre_jit_stack_alloc} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_jit_stack_alloc: pcre16_jit_stack_alloc_func = nil; + {$EXTERNALSYM pcre16_jit_stack_alloc} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_jit_stack_free: pcre_jit_stack_free_func = nil; + {$EXTERNALSYM pcre_jit_stack_free} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_jit_stack_free: pcre16_jit_stack_free_func = nil; + {$EXTERNALSYM pcre16_jit_stack_free} + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + pcre_assign_jit_stack: pcre_assign_jit_stack_func = nil; + {$EXTERNALSYM pcre_assign_jit_stack} + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_assign_jit_stack: pcre16_assign_jit_stack_func = nil; + {$EXTERNALSYM pcre16_assign_jit_stack} + {$ENDIF PCRE_16} + +{$ENDIF PCRE_LINKONREQUEST} + +{$ENDIF ~PCRE_RTL} +//DOM-IGNORE-END + +const + {$IFDEF MSWINDOWS} + PCREDefaultLibraryName = 'pcre3.dll'; + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + PCREDefaultLibraryName = 'libpcre.so.0'; + {$ENDIF UNIX} + {$IFDEF PCRE_8} + PCRECompileDefaultExportName = 'pcre_compile'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16CompileDefaultExportName = 'pcre16_compile'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCRECompile2DefaultExportName = 'pcre_compile2'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16Compile2DefaultExportName = 'pcre16_compile2'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREConfigDefaultExportName = 'pcre_config'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16ConfigDefaultExportName = 'pcre16_config'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCRECopyNamedSubstringDefaultExportName = 'pcre_copy_named_substring'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16CopyNamedSubstringDefaultExportName = 'pcre16_copy_named_substring'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCRECopySubStringDefaultExportName = 'pcre_copy_substring'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16CopySubStringDefaultExportName = 'pcre16_copy_substring'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREDfaExecDefaultExportName = 'pcre_dfa_exec'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16DfaExecDefaultExportName = 'pcre16_dfa_exec'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREExecDefaultExportName = 'pcre_exec'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16ExecDefaultExportName = 'pcre16_exec'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREFreeSubStringDefaultExportName = 'pcre_free_substring'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16FreeSubStringDefaultExportName = 'pcre16_free_substring'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREFreeSubStringListDefaultExportName = 'pcre_free_substring_list'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16FreeSubStringListDefaultExportName = 'pcre16_free_substring_list'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREFullInfoDefaultExportName = 'pcre_fullinfo'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16FullInfoDefaultExportName = 'pcre16_fullinfo'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREGetNamedSubstringDefaultExportName = 'pcre_get_named_substring'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16GetNamedSubstringDefaultExportName = 'pcre16_get_named_substring'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREGetStringNumberDefaultExportName = 'pcre_get_stringnumber'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16GetStringNumberDefaultExportName = 'pcre16_get_stringnumber'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREGetStringTableEntriesDefaultExportName = 'pcre_get_stringtable_entries'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16GetStringTableEntriesDefaultExportName = 'pcre16_get_stringtable_entries'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREGetSubStringDefaultExportName = 'pcre_get_substring'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16GetSubStringDefaultExportName = 'pcre16_get_substring'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREGetSubStringListDefaultExportName = 'pcre_get_substring_list'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16GetSubStringListDefaultExportName = 'pcre16_get_substring_list'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREMakeTablesDefaultExportName = 'pcre_maketables'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16MakeTablesDefaultExportName = 'pcre16_maketables'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCRERefCountDefaultExportName = 'pcre_refcount'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16RefCountDefaultExportName = 'pcre16_refcount'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREStudyDefaultExportName = 'pcre_study'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16StudyDefaultExportName = 'pcre16_study'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREFreeStudyDefaultExportName = 'pcre_free_study'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16FreeStudyDefaultExportName = 'pcre16_free_study'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREVersionDefaultExportName = 'pcre_version'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16VersionDefaultExportName = 'pcre16_version'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREJITStackAllocDefaultExportName = 'pcre_jit_stack_alloc'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16JITStackAllocDefaultExportName = 'pcre16_jit_stack_alloc'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREJITStackFreeDefaultExportName = 'pcre_jit_stack_free'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16JITStackFreeDefaultExportName = 'pcre16_jit_stack_free'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREAssignJITStackDefaultExportName = 'pcre_assign_jit_stack'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16AssignJITStackDefaultExportName = 'pcre16_assign_jit_stack'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREMallocDefaultExportName = 'pcre_malloc'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16MallocDefaultExportName = 'pcre16_malloc'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREFreeDefaultExportName = 'pcre_free'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16FreeDefaultExportName = 'pcre16_free'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREStackMallocDefaultExportName = 'pcre_stack_malloc'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16StackMallocDefaultExportName = 'pcre16_stack_malloc'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREStackFreeDefaultExportName = 'pcre_stack_free'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16StackFreeDefaultExportName = 'pcre16_stack_free'; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCRECalloutDefaultExportName = 'pcre_callout'; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16CalloutDefaultExportName = 'pcre16_callout'; + {$ENDIF PCRE_16} + +{$IFDEF PCRE_LINKONREQUEST} +var + PCRELibraryName: string = PCREDefaultLibraryName; + + {$IFDEF PCRE_8} + PCRECompileExportName: string = PCRECompileDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16CompileExportName: string = PCRE16CompileDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCRECompile2ExportName: string = PCRECompile2DefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16Compile2ExportName: string = PCRE16Compile2DefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREConfigExportName: string = PCREConfigDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16ConfigExportName: string = PCRE16ConfigDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCRECopyNamedSubstringExportName: string = PCRECopyNamedSubstringDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16CopyNamedSubstringExportName: string = PCRE16CopyNamedSubstringDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCRECopySubStringExportName: string = PCRECopySubStringDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16CopySubStringExportName: string = PCRE16CopySubStringDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREDfaExecExportName: string = PCREDfaExecDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16DfaExecExportName: string = PCRE16DfaExecDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREExecExportName: string = PCREExecDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16ExecExportName: string = PCRE16ExecDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREFreeSubStringExportName: string = PCREFreeSubStringDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16FreeSubStringExportName: string = PCRE16FreeSubStringDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREFreeSubStringListExportName: string = PCREFreeSubStringListDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16FreeSubStringListExportName: string = PCRE16FreeSubStringListDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREFullInfoExportName: string = PCREFullInfoDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16FullInfoExportName: string = PCRE16FullInfoDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREGetNamedSubstringExportName: string = PCREGetNamedSubstringDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16GetNamedSubstringExportName: string = PCRE16GetNamedSubstringDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREGetStringNumberExportName: string = PCREGetStringNumberDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16GetStringNumberExportName: string = PCRE16GetStringNumberDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREGetStringTableEntriesExportName: string = PCREGetStringTableEntriesDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16GetStringTableEntriesExportName: string = PCRE16GetStringTableEntriesDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREGetSubStringExportName: string = PCREGetSubStringDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16GetSubStringExportName: string = PCRE16GetSubStringDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREGetSubStringListExportName: string = PCREGetSubStringListDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16GetSubStringListExportName: string = PCRE16GetSubStringListDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREMakeTablesExportName: string = PCREMakeTablesDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16MakeTablesExportName: string = PCRE16MakeTablesDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCRERefCountExportName: string = PCRERefCountDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16RefCountExportName: string = PCRE16RefCountDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREStudyExportName: string = PCREStudyDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16StudyExportName: string = PCRE16StudyDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREFreeStudyExportName: string = PCREFreeStudyDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16FreeStudyExportName: string = PCRE16FreeStudyDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREVersionExportName: string = PCREVersionDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16VersionExportName: string = PCRE16VersionDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREJITStackAllocExportName: string = PCREJITStackAllocDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16JITStackAllocExportName: string = PCRE16JITStackAllocDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREJITStackFreeExportName: string = PCREJITStackFreeDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16JITStackFreeExportName: string = PCRE16JITStackFreeDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREAssignJITStackExportName: string = PCREAssignJITStackDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16AssignJITStackExportName: string = PCRE16AssignJITStackDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREMallocExportName: string = PCREMallocDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16MallocExportName: string = PCRE16MallocDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREFreeExportName: string = PCREFreeDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16FreeExportName: string = PCRE16FreeDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREStackMallocExportName: string = PCREStackMallocDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16StackMallocExportName: string = PCRE16StackMallocDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCREStackFreeExportName: string = PCREStackFreeDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16StackFreeExportName: string = PCRE16StackFreeDefaultExportName; + {$ENDIF PCRE_16} + {$IFDEF PCRE_8} + PCRECalloutExportName: string = PCRECalloutDefaultExportName; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + PCRE16CalloutExportName: string = PCRE16CalloutDefaultExportName; + {$ENDIF PCRE_16} +{$ENDIF PCRE_LINKONREQUEST} + +var + PCRELib: TModuleHandle = INVALID_MODULEHANDLE_VALUE; + +function IsPCRELoaded: Boolean; +function LoadPCRE: Boolean; +procedure UnloadPCRE; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + {$IFDEF HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Winapi.Windows, + {$ENDIF MSWINDOWS} + System.Types, System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + Types, SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +{$IFNDEF PCRE_RTL} +{$IFDEF PCRE_STATICLINK} + +{$IFDEF PCRE_8} +// make the linker happy with PCRE 8.00 +procedure _pcre_find_bracket; external; +// make the linker happy with PCRE 8.21 +procedure _pcre_jit_compile; external; +procedure _pcre_jit_free; external; +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} +// make the linker happy with PCRE 8.30 +procedure _pcre16_find_bracket; external; +procedure _pcre16_jit_compile; external; +procedure _pcre16_jit_free; external; +{$ENDIF PCRE_16} + +{$IFDEF CPU32} + +{$IFDEF PCRE_8} + +{$LINK ..\windows\obj\pcre\win32\pcre_compile.obj} +{$LINK ..\windows\obj\pcre\win32\pcre_config.obj} +{$LINK ..\windows\obj\pcre\win32\pcre_dfa_exec.obj} +{$LINK ..\windows\obj\pcre\win32\pcre_exec.obj} +{$LINK ..\windows\obj\pcre\win32\pcre_fullinfo.obj} +{$LINK ..\windows\obj\pcre\win32\pcre_get.obj} +{$LINK ..\windows\obj\pcre\win32\pcre_jit_compile.obj} +{$LINK ..\windows\obj\pcre\win32\pcre_maketables.obj} +{$LINK ..\windows\obj\pcre\win32\pcre_newline.obj} +{$LINK ..\windows\obj\pcre\win32\pcre_ord2utf8.obj} +{$LINK ..\windows\obj\pcre\win32\pcre_refcount.obj} +{$LINK ..\windows\obj\pcre\win32\pcre_study.obj} +{$LINK ..\windows\obj\pcre\win32\pcre_tables.obj} +{$LINK ..\windows\obj\pcre\win32\pcre_ucd.obj} +{$LINK ..\windows\obj\pcre\win32\pcre_valid_utf8.obj} +{$LINK ..\windows\obj\pcre\win32\pcre_version.obj} +{$LINK ..\windows\obj\pcre\win32\pcre_xclass.obj} +{$LINK ..\windows\obj\pcre\win32\pcre_chartables.obj} + +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} + +{$LINK ..\windows\obj\pcre\win32\pcre16_compile.obj} +{$LINK ..\windows\obj\pcre\win32\pcre16_config.obj} +{$LINK ..\windows\obj\pcre\win32\pcre16_dfa_exec.obj} +{$LINK ..\windows\obj\pcre\win32\pcre16_exec.obj} +{$LINK ..\windows\obj\pcre\win32\pcre16_fullinfo.obj} +{$LINK ..\windows\obj\pcre\win32\pcre16_get.obj} +{$LINK ..\windows\obj\pcre\win32\pcre16_jit_compile.obj} +{$LINK ..\windows\obj\pcre\win32\pcre16_maketables.obj} +{$LINK ..\windows\obj\pcre\win32\pcre16_newline.obj} +{$LINK ..\windows\obj\pcre\win32\pcre16_ord2utf16.obj} +{$LINK ..\windows\obj\pcre\win32\pcre16_refcount.obj} +{$LINK ..\windows\obj\pcre\win32\pcre16_study.obj} +{$LINK ..\windows\obj\pcre\win32\pcre16_tables.obj} +{$LINK ..\windows\obj\pcre\win32\pcre16_ucd.obj} +{$LINK ..\windows\obj\pcre\win32\pcre16_valid_utf16.obj} +{$LINK ..\windows\obj\pcre\win32\pcre16_version.obj} +{$LINK ..\windows\obj\pcre\win32\pcre16_xclass.obj} +{$LINK ..\windows\obj\pcre\win32\pcre16_chartables.obj} +{$LINK ..\windows\obj\pcre\win32\pcre16_string_utils.obj} +{$ENDIF PCRE_16} + +{$ENDIF CPU32} +{$IFDEF CPU64} + +{$IFDEF PCRE_8} + +{$LINK ..\windows\obj\pcre\win64\pcre_compile.obj} +{$LINK ..\windows\obj\pcre\win64\pcre_config.obj} +{$LINK ..\windows\obj\pcre\win64\pcre_dfa_exec.obj} +{$LINK ..\windows\obj\pcre\win64\pcre_exec.obj} +{$LINK ..\windows\obj\pcre\win64\pcre_fullinfo.obj} +{$LINK ..\windows\obj\pcre\win64\pcre_get.obj} +{$LINK ..\windows\obj\pcre\win64\pcre_jit_compile.obj} +{$LINK ..\windows\obj\pcre\win64\pcre_maketables.obj} +{$LINK ..\windows\obj\pcre\win64\pcre_newline.obj} +{$LINK ..\windows\obj\pcre\win64\pcre_ord2utf8.obj} +{$LINK ..\windows\obj\pcre\win64\pcre_refcount.obj} +{$LINK ..\windows\obj\pcre\win64\pcre_study.obj} +{$LINK ..\windows\obj\pcre\win64\pcre_tables.obj} +{$LINK ..\windows\obj\pcre\win64\pcre_ucd.obj} +{$LINK ..\windows\obj\pcre\win64\pcre_valid_utf8.obj} +{$LINK ..\windows\obj\pcre\win64\pcre_version.obj} +{$LINK ..\windows\obj\pcre\win64\pcre_xclass.obj} +{$LINK ..\windows\obj\pcre\win64\pcre_chartables.obj} + +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} + +{$LINK ..\windows\obj\pcre\win64\pcre16_compile.obj} +{$LINK ..\windows\obj\pcre\win64\pcre16_config.obj} +{$LINK ..\windows\obj\pcre\win64\pcre16_dfa_exec.obj} +{$LINK ..\windows\obj\pcre\win64\pcre16_exec.obj} +{$LINK ..\windows\obj\pcre\win64\pcre16_fullinfo.obj} +{$LINK ..\windows\obj\pcre\win64\pcre16_get.obj} +{$LINK ..\windows\obj\pcre\win64\pcre16_jit_compile.obj} +{$LINK ..\windows\obj\pcre\win64\pcre16_maketables.obj} +{$LINK ..\windows\obj\pcre\win64\pcre16_newline.obj} +{$LINK ..\windows\obj\pcre\win64\pcre16_ord2utf16.obj} +{$LINK ..\windows\obj\pcre\win64\pcre16_refcount.obj} +{$LINK ..\windows\obj\pcre\win64\pcre16_study.obj} +{$LINK ..\windows\obj\pcre\win64\pcre16_tables.obj} +{$LINK ..\windows\obj\pcre\win64\pcre16_ucd.obj} +{$LINK ..\windows\obj\pcre\win64\pcre16_valid_utf16.obj} +{$LINK ..\windows\obj\pcre\win64\pcre16_version.obj} +{$LINK ..\windows\obj\pcre\win64\pcre16_xclass.obj} +{$LINK ..\windows\obj\pcre\win64\pcre16_chartables.obj} +{$LINK ..\windows\obj\pcre\win64\pcre16_string_utils.obj} + +{$ENDIF PCRE_16} + +{$ENDIF CPU64} + +// user's defined callbacks +var + {$IFDEF PCRE_8} + pcre_malloc_user: pcre_malloc_callback; + pcre_free_user: pcre_free_callback; + pcre_stack_malloc_user: pcre_stack_malloc_callback; + pcre_stack_free_user: pcre_stack_free_callback; + pcre_callout_user: pcre_callout_callback; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_malloc_user: pcre16_malloc_callback; + pcre16_free_user: pcre16_free_callback; + pcre16_stack_malloc_user: pcre16_stack_malloc_callback; + pcre16_stack_free_user: pcre16_stack_free_callback; + pcre16_callout_user: pcre16_callout_callback; + {$ENDIF PCRE_16} + +{$IFDEF PCRE_8} +function pcre_compile; external; +function pcre_compile2; external; +function pcre_config; external; +function pcre_copy_named_substring; external; +function pcre_copy_substring; external; +function pcre_dfa_exec; external; +function pcre_exec; external; +procedure pcre_free_substring; external; +procedure pcre_free_substring_list; external; +function pcre_fullinfo; external; +function pcre_get_named_substring; external; +function pcre_get_stringnumber; external; +function pcre_get_stringtable_entries; external; +function pcre_get_substring; external; +function pcre_get_substring_list; external; +function pcre_maketables; external; +function pcre_refcount; external; +function pcre_study; external; +procedure pcre_free_study; external; +function pcre_version; external; +function pcre_jit_stack_alloc; external; +procedure pcre_jit_stack_free; external; +procedure pcre_assign_jit_stack; external; +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +function pcre16_compile; external; +function pcre16_compile2; external; +function pcre16_config; external; +function pcre16_copy_named_substring; external; +function pcre16_copy_substring; external; +function pcre16_dfa_exec; external; +function pcre16_exec; external; +procedure pcre16_free_substring; external; +procedure pcre16_free_substring_list; external; +function pcre16_fullinfo; external; +function pcre16_get_named_substring; external; +function pcre16_get_stringnumber; external; +function pcre16_get_stringtable_entries; external; +function pcre16_get_substring; external; +function pcre16_get_substring_list; external; +function pcre16_maketables; external; +function pcre16_refcount; external; +function pcre16_study; external; +procedure pcre16_free_study; external; +function pcre16_version; external; +function pcre16_jit_stack_alloc; external; +procedure pcre16_jit_stack_free; external; +procedure pcre16_assign_jit_stack; external; +{$ENDIF PCRE_16} + +type + size_t = Longint; + +const + szMSVCRT = 'MSVCRT.DLL'; + +function malloc(size: size_t): Pointer; cdecl; external szMSVCRT name 'malloc'; + +{$IFDEF CPU32} +function _memcpy(dest, src: Pointer; count: size_t): Pointer; cdecl; external szMSVCRT name 'memcpy'; +function _memmove(dest, src: Pointer; count: size_t): Pointer; cdecl; external szMSVCRT name 'memmove'; +function _memset(dest: Pointer; val: Integer; count: size_t): Pointer; cdecl; external szMSVCRT name 'memset'; +function _strncmp(s1: PAnsiChar; s2: PAnsiChar; n: size_t): Integer; cdecl; external szMSVCRT name 'strncmp'; +function _memcmp(s1: Pointer; s2: Pointer; n: size_t): Integer; cdecl; external szMSVCRT name 'memcmp'; +function _strlen(s: PAnsiChar): size_t; cdecl; external szMSVCRT name 'strlen'; +function __ltolower(__ch: Integer): Integer; cdecl; external szMSVCRT name 'tolower'; +function __ltoupper(__ch: Integer): Integer; cdecl; external szMSVCRT name 'toupper'; +function _isalnum(__ch: Integer): Integer; cdecl; external szMSVCRT name 'isalnum'; +function _isalpha(__ch: Integer): Integer; cdecl; external szMSVCRT name 'isalpha'; +function _iscntrl(__ch: Integer): Integer; cdecl; external szMSVCRT name 'iscntrl'; +function _isdigit(__ch: Integer): Integer; cdecl; external szMSVCRT name 'isdigit'; +function _isgraph(__ch: Integer): Integer; cdecl; external szMSVCRT name 'isgraph'; +function _islower(__ch: Integer): Integer; cdecl; external szMSVCRT name 'islower'; +function _isprint(__ch: Integer): Integer; cdecl; external szMSVCRT name 'isprint'; +function _ispunct(__ch: Integer): Integer; cdecl; external szMSVCRT name 'ispunct'; +function _isspace(__ch: Integer): Integer; cdecl; external szMSVCRT name 'isspace'; +function _isupper(__ch: Integer): Integer; cdecl; external szMSVCRT name 'isupper'; +function _isxdigit(__ch: Integer): Integer; cdecl; external szMSVCRT name 'isxdigit'; +function _strchr(__s: PAnsiChar; __c: Integer): PAnsiChar; cdecl; external szMSVCRT name 'strchr'; + +function ___alloca_helper(size: size_t): Pointer; cdecl; +begin + Result := malloc(size); +end; + +procedure __llmul; +asm + JMP System.__llmul +end; +{$ENDIF CPU32} +{$IFDEF CPU64} +function memcpy(dest, src: Pointer; count: size_t): Pointer; external szMSVCRT name 'memcpy'; +function memmove(dest, src: Pointer; count: size_t): Pointer; external szMSVCRT name 'memmove'; +function memset(dest: Pointer; val: Integer; count: size_t): Pointer; external szMSVCRT name 'memset'; +function strncmp(s1: PAnsiChar; s2: PAnsiChar; n: size_t): Integer; external szMSVCRT name 'strncmp'; +function strcmp(s1: PAnsiChar; s2: PAnsiChar; n: size_t): Integer; external szMSVCRT name 'strcmp'; +function memcmp(s1: Pointer; s2: Pointer; n: size_t): Integer; external szMSVCRT name 'memcmp'; +function strlen(s: PAnsiChar): size_t; external szMSVCRT name 'strlen'; +function tolower(__ch: Integer): Integer; external szMSVCRT name 'tolower'; +function toupper(__ch: Integer): Integer; external szMSVCRT name 'toupper'; +function isalnum(__ch: Integer): Integer; external szMSVCRT name 'isalnum'; +function isalpha(__ch: Integer): Integer; external szMSVCRT name 'isalpha'; +function iscntrl(__ch: Integer): Integer; external szMSVCRT name 'iscntrl'; +function isdigit(__ch: Integer): Integer; external szMSVCRT name 'isdigit'; +function isgraph(__ch: Integer): Integer; external szMSVCRT name 'isgraph'; +function islower(__ch: Integer): Integer; external szMSVCRT name 'islower'; +function isprint(__ch: Integer): Integer; external szMSVCRT name 'isprint'; +function ispunct(__ch: Integer): Integer; external szMSVCRT name 'ispunct'; +function isspace(__ch: Integer): Integer; external szMSVCRT name 'isspace'; +function isupper(__ch: Integer): Integer; external szMSVCRT name 'isupper'; +function isxdigit(__ch: Integer): Integer; external szMSVCRT name 'isxdigit'; +function strchr(__s: PAnsiChar; __c: Integer): PAnsiChar; external szMSVCRT name 'strchr'; + +function __chkstk(size: size_t): Pointer; +begin + Result := malloc(size); +end; +{$ENDIF CPU64} + +{$IFDEF PCRE_8} +function pcre_malloc_jcl(Size: SizeInt): Pointer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +begin + if Assigned(pcre_malloc_user) then + Result := pcre_malloc_user(Size) + else + Result := malloc(Size); +end; +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} +function pcre16_malloc_jcl(Size: SizeInt): Pointer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +begin + if Assigned(pcre16_malloc_user) then + Result := pcre16_malloc_user(Size) + else + Result := malloc(Size); +end; +{$ENDIF PCRE_16} + +{$IFDEF PCRE_8} +function pcre_stack_malloc_jcl(Size: SizeInt): Pointer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +begin + if Assigned(pcre_stack_malloc_user) then + Result := pcre_stack_malloc_user(Size) + else + Result := malloc(Size); +end; +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} +function pcre16_stack_malloc_jcl(Size: SizeInt): Pointer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +begin + if Assigned(pcre16_stack_malloc_user) then + Result := pcre16_stack_malloc_user(Size) + else + Result := malloc(Size); +end; +{$ENDIF PCRE_16} + +function _malloc(size: size_t): Pointer; +begin + Result := malloc(size); +end; + +procedure free(pBlock: Pointer); cdecl; external szMSVCRT name 'free'; + +{$IFDEF PCRE_8} +procedure pcre_free_jcl(P: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +begin + if Assigned(pcre_free_user) then + pcre_free_user(P) + else + free(P); +end; +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} +procedure pcre16_free_jcl(P: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +begin + if Assigned(pcre16_free_user) then + pcre16_free_user(P) + else + free(P); +end; +{$ENDIF PCRE_16} + +{$IFDEF PCRE_8} +procedure pcre_stack_free_jcl(P: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +begin + if Assigned(pcre_stack_free_user) then + pcre_stack_free_user(P) + else + free(P); +end; +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} +procedure pcre16_stack_free_jcl(P: Pointer); {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +begin + if Assigned(pcre16_stack_free_user) then + pcre16_stack_free_user(P) + else + free(P); +end; +{$ENDIF PCRE_16} + +procedure _free(pBlock: Pointer); +begin + free(pBlock); +end; + +{$IFDEF PCRE_8} +function pcre_callout_jcl(var callout_block: pcre_callout_block): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +begin + if Assigned(pcre_callout_user) then + Result := pcre_callout_user(callout_block) + else + Result := 0; +end; +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} +function pcre16_callout_jcl(var callout_block: pcre16_callout_block): Integer; {$IFDEF PCRE_EXPORT_CDECL} cdecl; {$ENDIF PCRE_EXPORT_CDECL} +begin + if Assigned(pcre16_callout_user) then + Result := pcre16_callout_user(callout_block) + else + Result := 0; +end; +{$ENDIF PCRE_16} + +{$IFDEF CPU32} +const + {$IFDEF PCRE_8} + _pcre_malloc: pcre_malloc_callback = pcre_malloc_jcl; + _pcre_free: pcre_free_callback = pcre_free_jcl; + _pcre_stack_malloc: pcre_stack_malloc_callback = pcre_stack_malloc_jcl; + _pcre_stack_free: pcre_stack_free_callback = pcre_stack_free_jcl; + _pcre_callout: pcre_callout_callback = pcre_callout_jcl; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + _pcre16_malloc: pcre16_malloc_callback = pcre16_malloc_jcl; + _pcre16_free: pcre16_free_callback = pcre16_free_jcl; + _pcre16_stack_malloc: pcre16_stack_malloc_callback = pcre16_stack_malloc_jcl; + _pcre16_stack_free: pcre16_stack_free_callback = pcre16_stack_free_jcl; + _pcre16_callout: pcre16_callout_callback = pcre16_callout_jcl; + {$ENDIF PCRE_16} +{$ENDIF CPU32} +{$IFDEF CPU64} +const + {$IFDEF PCRE_8} + pcre_malloc: pcre_malloc_callback = pcre_malloc_jcl; + pcre_free: pcre_free_callback = pcre_free_jcl; + pcre_stack_malloc: pcre_stack_malloc_callback = pcre_stack_malloc_jcl; + pcre_stack_free: pcre_stack_free_callback = pcre_stack_free_jcl; + pcre_callout: pcre_callout_callback = pcre_callout_jcl; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_malloc: pcre16_malloc_callback = pcre16_malloc_jcl; + pcre16_free: pcre16_free_callback = pcre16_free_jcl; + pcre16_stack_malloc: pcre16_stack_malloc_callback = pcre16_stack_malloc_jcl; + pcre16_stack_free: pcre16_stack_free_callback = pcre16_stack_free_jcl; + pcre16_callout: pcre16_callout_callback = pcre16_callout_jcl; + {$ENDIF PCRE_16} +{$ENDIF CPU64} + +{$ENDIF PCRE_STATICLINK} + +{$IFDEF PCRE_8} +procedure SetPCREMallocCallback(const Value: pcre_malloc_callback); +begin + {$IFDEF PCRE_STATICLINK} + pcre_malloc_user := Value; + {$ELSE ~PCRE_STATICLINK} + if not Assigned(pcre_malloc_func) then + LoadPCRE; + + if Assigned(pcre_malloc_func) then + pcre_malloc_func^ := Value + else if Assigned(LibNotLoadedHandler) then + LibNotLoadedHandler; + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} +procedure SetPCRE16MallocCallback(const Value: pcre16_malloc_callback); +begin + {$IFDEF PCRE_STATICLINK} + pcre16_malloc_user := Value; + {$ELSE ~PCRE_STATICLINK} + if not Assigned(pcre16_malloc_func) then + LoadPCRE; + + if Assigned(pcre16_malloc_func) then + pcre16_malloc_func^ := Value + else if Assigned(LibNotLoadedHandler) then + LibNotLoadedHandler; + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_16} + +{$IFDEF PCRE_8} +function GetPCREMallocCallback: pcre_malloc_callback; +begin + {$IFDEF PCRE_STATICLINK} + Result := pcre_malloc_user; + {$ELSE ~PCRE_STATICLINK} + if not Assigned(pcre_malloc_func) then + LoadPCRE; + + if not Assigned(pcre_malloc_func) then + begin + Result := nil; + if Assigned(LibNotLoadedHandler) then + LibNotLoadedHandler; + end + else + Result := pcre_malloc_func^; + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} +function GetPCRE16MallocCallback: pcre16_malloc_callback; +begin + {$IFDEF PCRE_STATICLINK} + Result := pcre16_malloc_user; + {$ELSE ~PCRE_STATICLINK} + if not Assigned(pcre16_malloc_func) then + LoadPCRE; + + if not Assigned(pcre16_malloc_func) then + begin + Result := nil; + if Assigned(LibNotLoadedHandler) then + LibNotLoadedHandler; + end + else + Result := pcre16_malloc_func^; + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_16} + +{$IFDEF PCRE_8} +function CallPCREMalloc(Size: SizeInt): Pointer; +begin + {$IFDEF PCRE_STATICLINK} + Result := pcre_malloc_jcl(Size); + {$ELSE ~PCRE_STATICLINK} + Result := pcre_malloc_func^(Size); + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} +function CallPCRE16Malloc(Size: SizeInt): Pointer; +begin + {$IFDEF PCRE_STATICLINK} + Result := pcre16_malloc_jcl(Size); + {$ELSE ~PCRE_STATICLINK} + Result := pcre16_malloc_func^(Size); + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_16} + +{$IFDEF PCRE_8} +procedure SetPCREFreeCallback(const Value: pcre_free_callback); +begin + {$IFDEF PCRE_STATICLINK} + pcre_free_user := Value; + {$ELSE ~PCRE_STATICLINK} + if not Assigned(pcre_free_func) then + LoadPCRE; + + if Assigned(pcre_free_func) then + pcre_free_func^ := Value + else if Assigned(LibNotLoadedHandler) then + LibNotLoadedHandler; + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} +procedure SetPCRE16FreeCallback(const Value: pcre16_free_callback); +begin + {$IFDEF PCRE_STATICLINK} + pcre16_free_user := Value; + {$ELSE ~PCRE_STATICLINK} + if not Assigned(pcre16_free_func) then + LoadPCRE; + + if Assigned(pcre16_free_func) then + pcre16_free_func^ := Value + else if Assigned(LibNotLoadedHandler) then + LibNotLoadedHandler; + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_16} + +{$IFDEF PCRE_8} +function GetPCREFreeCallback: pcre_free_callback; +begin + {$IFDEF PCRE_STATICLINK} + Result := pcre_free_user; + {$ELSE ~PCRE_STATICLINK} + if not Assigned(pcre_free_func) then + LoadPCRE; + + if not Assigned(pcre_free_func) then + begin + Result := nil; + if Assigned(LibNotLoadedHandler) then + LibNotLoadedHandler; + end + else + Result := pcre_free_func^ + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} +function GetPCRE16FreeCallback: pcre16_free_callback; +begin + {$IFDEF PCRE_STATICLINK} + Result := pcre16_free_user; + {$ELSE ~PCRE_STATICLINK} + if not Assigned(pcre16_free_func) then + LoadPCRE; + + if not Assigned(pcre16_free_func) then + begin + Result := nil; + if Assigned(LibNotLoadedHandler) then + LibNotLoadedHandler; + end + else + Result := pcre16_free_func^ + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_16} + +{$IFDEF PCRE_8} +procedure CallPCREFree(P: Pointer); +begin + {$IFDEF PCRE_STATICLINK} + pcre_free_jcl(P); + {$ELSE ~PCRE_STATICLINK} + pcre_free_func^(P); + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} +procedure CallPCRE16Free(P: Pointer); +begin + {$IFDEF PCRE_STATICLINK} + pcre16_free_jcl(P); + {$ELSE ~PCRE_STATICLINK} + pcre16_free_func^(P); + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_16} + +{$IFDEF PCRE_8} +procedure SetPCREStackMallocCallback(const Value: pcre_stack_malloc_callback); +begin + {$IFDEF PCRE_STATICLINK} + pcre_stack_malloc_user := Value; + {$ELSE ~PCRE_STATICLINK} + if not Assigned(pcre_stack_malloc_func) then + LoadPCRE; + + if Assigned(pcre_stack_malloc_func) then + pcre_stack_malloc_func^ := Value + else if Assigned(LibNotLoadedHandler) then + LibNotLoadedHandler; + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} +procedure SetPCRE16StackMallocCallback(const Value: pcre16_stack_malloc_callback); +begin + {$IFDEF PCRE_STATICLINK} + pcre16_stack_malloc_user := Value; + {$ELSE ~PCRE_STATICLINK} + if not Assigned(pcre16_stack_malloc_func) then + LoadPCRE; + + if Assigned(pcre16_stack_malloc_func) then + pcre16_stack_malloc_func^ := Value + else if Assigned(LibNotLoadedHandler) then + LibNotLoadedHandler; + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_16} + +{$IFDEF PCRE_8} +function GetPCREStackMallocCallback: pcre_stack_malloc_callback; +begin + {$IFDEF PCRE_STATICLINK} + Result := pcre_stack_malloc_user; + {$ELSE ~PCRE_STATICLINK} + if not Assigned(pcre_stack_malloc_func) then + LoadPCRE; + + if not Assigned(pcre_stack_malloc_func) then + begin + Result := nil; + if Assigned(LibNotLoadedHandler) then + LibNotLoadedHandler; + end + else + Result := pcre_stack_malloc_func^; + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} +function GetPCRE16StackMallocCallback: pcre16_stack_malloc_callback; +begin + {$IFDEF PCRE_STATICLINK} + Result := pcre16_stack_malloc_user; + {$ELSE ~PCRE_STATICLINK} + if not Assigned(pcre16_stack_malloc_func) then + LoadPCRE; + + if not Assigned(pcre16_stack_malloc_func) then + begin + Result := nil; + if Assigned(LibNotLoadedHandler) then + LibNotLoadedHandler; + end + else + Result := pcre16_stack_malloc_func^; + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_16} + +{$IFDEF PCRE_8} +function CallPCREStackMalloc(Size: SizeInt): Pointer; +begin + {$IFDEF PCRE_STATICLINK} + Result := pcre_stack_malloc_jcl(Size); + {$ELSE ~PCRE_STATICLINK} + Result := pcre_stack_malloc_func^(Size); + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} +function CallPCRE16StackMalloc(Size: SizeInt): Pointer; +begin + {$IFDEF PCRE_STATICLINK} + Result := pcre16_stack_malloc_jcl(Size); + {$ELSE ~PCRE_STATICLINK} + Result := pcre16_stack_malloc_func^(Size); + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_16} + +{$IFDEF PCRE_8} +procedure SetPCREStackFreeCallback(const Value: pcre_stack_free_callback); +begin + {$IFDEF PCRE_STATICLINK} + pcre_stack_free_user := Value; + {$ELSE ~PCRE_STATICLINK} + if not Assigned(pcre_stack_free_func) then + LoadPCRE; + + if Assigned(pcre_stack_free_func) then + pcre_stack_free_func^ := Value + else if Assigned(LibNotLoadedHandler) then + LibNotLoadedHandler; + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} +procedure SetPCRE16StackFreeCallback(const Value: pcre16_stack_free_callback); +begin + {$IFDEF PCRE_STATICLINK} + pcre16_stack_free_user := Value; + {$ELSE ~PCRE_STATICLINK} + if not Assigned(pcre16_stack_free_func) then + LoadPCRE; + + if Assigned(pcre16_stack_free_func) then + pcre16_stack_free_func^ := Value + else if Assigned(LibNotLoadedHandler) then + LibNotLoadedHandler; + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_16} + +{$IFDEF PCRE_8} +function GetPCREStackFreeCallback: pcre_stack_free_callback; +begin + {$IFDEF PCRE_STATICLINK} + Result := pcre_stack_free_user; + {$ELSE ~PCRE_STATICLINK} + if not Assigned(pcre_stack_free_func) then + LoadPCRE; + + if not Assigned(pcre_stack_free_func) then + begin + Result := nil; + if Assigned(LibNotLoadedHandler) then + LibNotLoadedHandler; + end + else + Result := pcre_stack_free_func^; + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} +function GetPCRE16StackFreeCallback: pcre16_stack_free_callback; +begin + {$IFDEF PCRE_STATICLINK} + Result := pcre16_stack_free_user; + {$ELSE ~PCRE_STATICLINK} + if not Assigned(pcre16_stack_free_func) then + LoadPCRE; + + if not Assigned(pcre16_stack_free_func) then + begin + Result := nil; + if Assigned(LibNotLoadedHandler) then + LibNotLoadedHandler; + end + else + Result := pcre16_stack_free_func^; + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_16} + +{$IFDEF PCRE_8} +procedure CallPCREStackFree(P: Pointer); +begin + {$IFDEF PCRE_STATICLINK} + pcre_stack_free_jcl(P); + {$ELSE ~PCRE_STATICLINK} + pcre_stack_free_func^(P); + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} +procedure CallPCRE16StackFree(P: Pointer); +begin + {$IFDEF PCRE_STATICLINK} + pcre16_stack_free_jcl(P); + {$ELSE ~PCRE_STATICLINK} + pcre16_stack_free_func^(P); + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_16} + +{$IFDEF PCRE_8} +procedure SetPCRECalloutCallback(const Value: pcre_callout_callback); +begin + {$IFDEF PCRE_STATICLINK} + pcre_callout_user := Value; + {$ELSE ~PCRE_STATICLINK} + if not Assigned(pcre_callout_func) then + LoadPCRE; + + if Assigned(pcre_callout_func) then + pcre_callout_func^ := Value + else if Assigned(LibNotLoadedHandler) then + LibNotLoadedHandler; + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} +procedure SetPCRE16CalloutCallback(const Value: pcre16_callout_callback); +begin + {$IFDEF PCRE_STATICLINK} + pcre16_callout_user := Value; + {$ELSE ~PCRE_STATICLINK} + if not Assigned(pcre16_callout_func) then + LoadPCRE; + + if Assigned(pcre16_callout_func) then + pcre16_callout_func^ := Value + else if Assigned(LibNotLoadedHandler) then + LibNotLoadedHandler; + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_16} + +{$IFDEF PCRE_8} +function GetPCRECalloutCallback: pcre_callout_callback; +begin + {$IFDEF PCRE_STATICLINK} + Result := pcre_callout_user; + {$ELSE ~PCRE_STATICLINK} + if not Assigned(pcre_callout_func) then + LoadPCRE; + + if not Assigned(pcre_callout_func) then + begin + Result := nil; + if Assigned(LibNotLoadedHandler) then + LibNotLoadedHandler; + end + else + Result := pcre_callout_func^; + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} +function GetPCRE16CalloutCallback: pcre16_callout_callback; +begin + {$IFDEF PCRE_STATICLINK} + Result := pcre16_callout_user; + {$ELSE ~PCRE_STATICLINK} + if not Assigned(pcre16_callout_func) then + LoadPCRE; + + if not Assigned(pcre16_callout_func) then + begin + Result := nil; + if Assigned(LibNotLoadedHandler) then + LibNotLoadedHandler; + end + else + Result := pcre16_callout_func^; + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_16} + +{$IFDEF PCRE_8} +function CallPCRECallout(var callout_block: pcre_callout_block): Integer; +begin + {$IFDEF PCRE_STATICLINK} + Result := pcre_callout_jcl(callout_block); + {$ELSE ~PCRE_STATICLINK} + Result := pcre_callout_func^(callout_block); + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_8} + +{$IFDEF PCRE_16} +function CallPCRE16Callout(var callout_block: pcre16_callout_block): Integer; +begin + {$IFDEF PCRE_STATICLINK} + Result := pcre16_callout_jcl(callout_block); + {$ELSE ~PCRE_STATICLINK} + Result := pcre16_callout_func^(callout_block); + {$ENDIF ~PCRE_STATICLINK} +end; +{$ENDIF PCRE_16} + +{$IFNDEF PCRE_STATICLINK} +procedure InitPCREFuncPtrs(const Value: Pointer); +begin + {$IFDEF PCRE_LINKONREQUEST} + {$IFDEF PCRE_8} + @pcre_compile := Value; + @pcre_compile2 := Value; + @pcre_config := Value; + @pcre_copy_named_substring := Value; + @pcre_copy_substring := Value; + @pcre_dfa_exec := Value; + @pcre_exec := Value; + @pcre_free_substring := Value; + @pcre_free_substring_list := Value; + @pcre_fullinfo := Value; + @pcre_get_named_substring := Value; + @pcre_get_stringnumber := Value; + @pcre_get_stringtable_entries := Value; + @pcre_get_substring := Value; + @pcre_get_substring_list := Value; + @pcre_maketables := Value; + @pcre_refcount := Value; + @pcre_study := Value; + @pcre_free_study := Value; + @pcre_version := Value; + @pcre_jit_stack_alloc := Value; + @pcre_jit_stack_free := Value; + @pcre_assign_jit_stack := Value; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + @pcre16_compile := Value; + @pcre16_compile2 := Value; + @pcre16_config := Value; + @pcre16_copy_named_substring := Value; + @pcre16_copy_substring := Value; + @pcre16_dfa_exec := Value; + @pcre16_exec := Value; + @pcre16_free_substring := Value; + @pcre16_free_substring_list := Value; + @pcre16_fullinfo := Value; + @pcre16_get_named_substring := Value; + @pcre16_get_stringnumber := Value; + @pcre16_get_stringtable_entries := Value; + @pcre16_get_substring := Value; + @pcre16_get_substring_list := Value; + @pcre16_maketables := Value; + @pcre16_refcount := Value; + @pcre16_study := Value; + @pcre16_free_study := Value; + @pcre16_version := Value; + @pcre16_jit_stack_alloc := Value; + @pcre16_jit_stack_free := Value; + @pcre16_assign_jit_stack := Value; + {$ENDIF PCRE_16} + {$ENDIF PCRE_LINKONREQUEST} + {$IFDEF PCRE_8} + pcre_malloc_func := nil; + pcre_free_func := nil; + pcre_stack_malloc_func := nil; + pcre_stack_free_func := nil; + pcre_callout_func := nil; + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_malloc_func := nil; + pcre16_free_func := nil; + pcre16_stack_malloc_func := nil; + pcre16_stack_free_func := nil; + pcre16_callout_func := nil; + {$ENDIF PCRE_16} +end; +{$ENDIF ~PCRE_STATICLINK} +{$ENDIF ~PCRE_RTL} + +function IsPCRELoaded: Boolean; +begin + {$IFDEF PCRE_RTL} + Result := True; + {$ELSE ~PCRE_RTL} + {$IFDEF PCRE_STATICLINK} + Result := True; + {$ELSE ~PCRE_STATICLINK} + Result := PCRELib <> INVALID_MODULEHANDLE_VALUE; + {$ENDIF ~PCRE_STATICLINK} + {$ENDIF ~PCRE_RTL} +end; + +function LoadPCRE: Boolean; +{$IFDEF PCRE_RTL} +begin + Result := True; +end; +{$ELSE ~PCRE_RTL} +{$IFDEF PCRE_STATICLINK} +begin + Result := True; +end; +{$ELSE ~PCRE_STATICLINK} +begin + Result := PCRELib <> INVALID_MODULEHANDLE_VALUE; + if Result then + Exit; + + {$IFDEF PCRE_LINKONREQUEST} + Result := JclSysUtils.LoadModule(PCRELib, PCRELibraryName); + {$ELSE ~PCRE_LINKONREQUEST} + Result := JclSysUtils.LoadModule(PCRELib, PCREDefaultLibraryName); + {$ENDIF ~PCRE_LINKONREQUEST} + if Result then + begin + {$IFDEF PCRE_LINKONREQUEST} + {$IFDEF PCRE_8} + @pcre_compile := GetModuleSymbol(PCRELib, PCRECompileExportName); + @pcre_compile2 := GetModuleSymbol(PCRELib, PCRECompile2ExportName); + @pcre_config := GetModuleSymbol(PCRELib, PCREConfigExportName); + @pcre_copy_named_substring := GetModuleSymbol(PCRELib, PCRECopyNamedSubstringExportName); + @pcre_copy_substring := GetModuleSymbol(PCRELib, PCRECopySubStringExportName); + @pcre_dfa_exec := GetModuleSymbol(PCRELib, PCREDfaExecExportName); + @pcre_exec := GetModuleSymbol(PCRELib, PCREExecExportName); + @pcre_free_substring := GetModuleSymbol(PCRELib, PCREFreeSubStringExportName); + @pcre_free_substring_list := GetModuleSymbol(PCRELib, PCREFreeSubStringListExportName); + @pcre_fullinfo := GetModuleSymbol(PCRELib, PCREFullInfoExportName); + @pcre_get_named_substring := GetModuleSymbol(PCRELib, PCREGetNamedSubstringExportName); + @pcre_get_stringnumber := GetModuleSymbol(PCRELib, PCREGetStringNumberExportName); + @pcre_get_stringtable_entries := GetModuleSymbol(PCRELib, PCREGetStringTableEntriesExportName); + @pcre_get_substring := GetModuleSymbol(PCRELib, PCREGetSubStringExportName); + @pcre_get_substring_list := GetModuleSymbol(PCRELib, PCREGetSubStringListExportName); + @pcre_maketables := GetModuleSymbol(PCRELib, PCREMakeTablesExportName); + @pcre_refcount := GetModuleSymbol(PCRELib, PCRERefCountExportName); + @pcre_study := GetModuleSymbol(PCRELib, PCREStudyExportName); + @pcre_free_study := GetModuleSymbol(PCRELib, PCREFreeStudyExportName); + @pcre_version := GetModuleSymbol(PCRELib, PCREVersionExportName); + @pcre_jit_stack_alloc := GetModuleSymbol(PCRELib, PCREJITStackAllocExportName); + @pcre_jit_stack_free := GetModuleSymbol(PCRELib, PCREJITStackFreeExportName); + @pcre_assign_jit_stack := GetModuleSymbol(PCRELib, PCREAssignJITStackExportName); + pcre_malloc_func := GetModuleSymbol(PCRELib, PCREMallocExportName); + pcre_free_func := GetModuleSymbol(PCRELib, PCREFreeExportName); + pcre_stack_malloc_func := GetModuleSymbol(PCRELib, PCREStackMallocExportName); + pcre_stack_free_func := GetModuleSymbol(PCRELib, PCREStackFreeExportName); + pcre_callout_func := GetModuleSymbol(PCRELib, PCRECalloutExportName); + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + @pcre16_compile := GetModuleSymbol(PCRELib, PCRE16CompileExportName); + @pcre16_compile2 := GetModuleSymbol(PCRELib, PCRE16Compile2ExportName); + @pcre16_config := GetModuleSymbol(PCRELib, PCRE16ConfigExportName); + @pcre16_copy_named_substring := GetModuleSymbol(PCRELib, PCRE16CopyNamedSubstringExportName); + @pcre16_copy_substring := GetModuleSymbol(PCRELib, PCRE16CopySubStringExportName); + @pcre16_dfa_exec := GetModuleSymbol(PCRELib, PCRE16DfaExecExportName); + @pcre16_exec := GetModuleSymbol(PCRELib, PCRE16ExecExportName); + @pcre16_free_substring := GetModuleSymbol(PCRELib, PCRE16FreeSubStringExportName); + @pcre16_free_substring_list := GetModuleSymbol(PCRELib, PCRE16FreeSubStringListExportName); + @pcre16_fullinfo := GetModuleSymbol(PCRELib, PCRE16FullInfoExportName); + @pcre16_get_named_substring := GetModuleSymbol(PCRELib, PCRE16GetNamedSubstringExportName); + @pcre16_get_stringnumber := GetModuleSymbol(PCRELib, PCRE16GetStringNumberExportName); + @pcre16_get_stringtable_entries := GetModuleSymbol(PCRELib, PCRE16GetStringTableEntriesExportName); + @pcre16_get_substring := GetModuleSymbol(PCRELib, PCRE16GetSubStringExportName); + @pcre16_get_substring_list := GetModuleSymbol(PCRELib, PCRE16GetSubStringListExportName); + @pcre16_maketables := GetModuleSymbol(PCRELib, PCRE16MakeTablesExportName); + @pcre16_refcount := GetModuleSymbol(PCRELib, PCRE16RefCountExportName); + @pcre16_study := GetModuleSymbol(PCRELib, PCRE16StudyExportName); + @pcre16_free_study := GetModuleSymbol(PCRELib, PCRE16FreeStudyExportName); + @pcre16_version := GetModuleSymbol(PCRELib, PCRE16VersionExportName); + @pcre16_jit_stack_alloc := GetModuleSymbol(PCRELib, PCRE16JITStackAllocExportName); + @pcre16_jit_stack_free := GetModuleSymbol(PCRELib, PCRE16JITStackFreeExportName); + @pcre16_assign_jit_stack := GetModuleSymbol(PCRELib, PCRE16AssignJITStackExportName); + pcre16_malloc_func := GetModuleSymbol(PCRELib, PCRE16MallocExportName); + pcre16_free_func := GetModuleSymbol(PCRELib, PCRE16FreeExportName); + pcre16_stack_malloc_func := GetModuleSymbol(PCRELib, PCRE16StackMallocExportName); + pcre16_stack_free_func := GetModuleSymbol(PCRELib, PCRE16StackFreeExportName); + pcre16_callout_func := GetModuleSymbol(PCRELib, PCRE16CalloutExportName); + {$ENDIF PCRE_16} + {$ELSE ~PCRE_LINKONREQUEST} + {$IFDEF PCRE_8} + pcre_malloc_func := GetModuleSymbol(PCRELib, PCREMallocDefaultExportName); + pcre_free_func := GetModuleSymbol(PCRELib, PCREFreeDefaultExportName); + pcre_stack_malloc_func := GetModuleSymbol(PCRELib, PCREStackMallocDefaultExportName); + pcre_stack_free_func := GetModuleSymbol(PCRELib, PCREStackFreeDefaultExportName); + pcre_callout_func := GetModuleSymbol(PCRELib, PCRECalloutDefaultExportName); + {$ENDIF PCRE_8} + {$IFDEF PCRE_16} + pcre16_malloc_func := GetModuleSymbol(PCRELib, PCRE16MallocDefaultExportName); + pcre16_free_func := GetModuleSymbol(PCRELib, PCRE16FreeDefaultExportName); + pcre16_stack_malloc_func := GetModuleSymbol(PCRELib, PCRE16StackMallocDefaultExportName); + pcre16_stack_free_func := GetModuleSymbol(PCRELib, PCRE16StackFreeDefaultExportName); + pcre16_callout_func := GetModuleSymbol(PCRELib, PCRE16CalloutDefaultExportName); + {$ENDIF PCRE_16} + {$ENDIF ~PCRE_LINKONREQUEST} + end + else + InitPCREFuncPtrs(@LibNotLoadedHandler); +end; +{$ENDIF ~PCRE_STATICLINK} +{$ENDIF ~PCRE_RTL} + +procedure UnloadPCRE; +begin + {$IFNDEF PCRE_RTL} + {$IFNDEF PCRE_STATICLINK} + InitPCREFuncPtrs(@LibNotLoadedHandler); + JclSysUtils.UnloadModule(PCRELib); + {$ENDIF ~PCRE_STATICLINK} + {$ENDIF ~PCRE_RTL} +end; + +{$IFDEF PCRE_LINKDLL} +{$IFDEF PCRE_8} +function pcre_compile; external PCREDefaultLibraryName name PCRECompileDefaultExportName; +function pcre_compile2; external PCREDefaultLibraryName name PCRECompile2DefaultExportName; +function pcre_config; external PCREDefaultLibraryName name PCREConfigDefaultExportName; +function pcre_copy_named_substring; external PCREDefaultLibraryName name PCRECopyNamedSubStringDefaultExportName; +function pcre_copy_substring; external PCREDefaultLibraryName name PCRECopySubStringDefaultExportName; +function pcre_dfa_exec; external PCREDefaultLibraryName name PCREDfaExecDefaultExportName; +function pcre_exec; external PCREDefaultLibraryName name PCREExecDefaultExportName; +procedure pcre_free_substring; external PCREDefaultLibraryName name PCREFreeSubStringDefaultExportName; +procedure pcre_free_substring_list; external PCREDefaultLibraryName name PCREFreeSubStringListDefaultExportName; +function pcre_fullinfo; external PCREDefaultLibraryName name PCREFullInfoDefaultExportName; +function pcre_get_named_substring; external PCREDefaultLibraryName name PCREGetNamedSubStringDefaultExportName; +function pcre_get_stringnumber; external PCREDefaultLibraryName name PCREGetStringNumberDefaultExportName; +function pcre_get_stringtable_entries; external PCREDefaultLibraryName name PCREGetStringTableEntriesDefaultExportName; +function pcre_get_substring; external PCREDefaultLibraryName name PCREGetSubStringDefaultExportName; +function pcre_get_substring_list; external PCREDefaultLibraryName name PCREGetSubStringListDefaultExportName; +function pcre_maketables; external PCREDefaultLibraryName name PCREMakeTablesDefaultExportName; +function pcre_refcount; external PCREDefaultLibraryName name PCRERefCountDefaultExportName; +function pcre_study; external PCREDefaultLibraryName name PCREStudyDefaultExportName; +procedure pcre_free_study; external PCREDefaultLibraryName name PCREFreeStudyDefaultExportName; +function pcre_version; external PCREDefaultLibraryName name PCREVersionDefaultExportName; +function pcre_jit_stack_alloc; external PCREDefaultLibraryName name PCREJITStackAllocDefaultExportName; +procedure pcre_jit_stack_free; external PCREDefaultLibraryName name PCREJITStackFreeDefaultExportName; +procedure pcre_assign_jit_stack; external PCREDefaultLibraryName name PCREAssignJITStackDefaultExportName; +{$ENDIF PCRE_8} +{$IFDEF PCRE_16} +function pcre16_compile; external PCREDefaultLibraryName name PCRE16CompileDefaultExportName; +function pcre16_compile2; external PCREDefaultLibraryName name PCRE16Compile2DefaultExportName; +function pcre16_config; external PCREDefaultLibraryName name PCRE16ConfigDefaultExportName; +function pcre16_copy_named_substring; external PCREDefaultLibraryName name PCRE16CopyNamedSubStringDefaultExportName; +function pcre16_copy_substring; external PCREDefaultLibraryName name PCRE16CopySubStringDefaultExportName; +function pcre16_dfa_exec; external PCREDefaultLibraryName name PCRE16DfaExecDefaultExportName; +function pcre16_exec; external PCREDefaultLibraryName name PCRE16ExecDefaultExportName; +procedure pcre16_free_substring; external PCREDefaultLibraryName name PCRE16FreeSubStringDefaultExportName; +procedure pcre16_free_substring_list; external PCREDefaultLibraryName name PCRE16FreeSubStringListDefaultExportName; +function pcre16_fullinfo; external PCREDefaultLibraryName name PCRE16FullInfoDefaultExportName; +function pcre16_get_named_substring; external PCREDefaultLibraryName name PCRE16GetNamedSubStringDefaultExportName; +function pcre16_get_stringnumber; external PCREDefaultLibraryName name PCRE16GetStringNumberDefaultExportName; +function pcre16_get_stringtable_entries; external PCREDefaultLibraryName name PCRE16GetStringTableEntriesDefaultExportName; +function pcre16_get_substring; external PCREDefaultLibraryName name PCRE16GetSubStringDefaultExportName; +function pcre16_get_substring_list; external PCREDefaultLibraryName name PCRE16GetSubStringListDefaultExportName; +function pcre16_maketables; external PCREDefaultLibraryName name PCRE16MakeTablesDefaultExportName; +function pcre16_refcount; external PCREDefaultLibraryName name PCRE16RefCountDefaultExportName; +function pcre16_study; external PCREDefaultLibraryName name PCRE16StudyDefaultExportName; +procedure pcre16_free_study; external PCREDefaultLibraryName name PCRE16FreeStudyDefaultExportName; +function pcre16_version; external PCREDefaultLibraryName name PCRE16VersionDefaultExportName; +function pcre16_jit_stack_alloc; external PCREDefaultLibraryName name PCRE16JITStackAllocDefaultExportName; +procedure pcre16_jit_stack_free; external PCREDefaultLibraryName name PCRE16JITStackFreeDefaultExportName; +procedure pcre16_assign_jit_stack; external PCREDefaultLibraryName name PCRE16AssignJITStackDefaultExportName; +{$ENDIF PCRE_16} +{$ENDIF PCRE_LINKDLL} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/common/zconf.h b/3rdParty/JCL/source/common/zconf.h new file mode 100644 index 00000000..02ce56c4 --- /dev/null +++ b/3rdParty/JCL/source/common/zconf.h @@ -0,0 +1,428 @@ +/* zconf.h -- configuration of the zlib compression library + * Copyright (C) 1995-2010 Jean-loup Gailly. + * For conditions of distribution and use, see copyright notice in zlib.h + */ + +/* @(#) $Id$ */ + +#ifndef ZCONF_H +#define ZCONF_H + +/* + * If you *really* need a unique prefix for all types and library functions, + * compile with -DZ_PREFIX. The "standard" zlib should be compiled without it. + * Even better than compiling with -DZ_PREFIX would be to use configure to set + * this permanently in zconf.h using "./configure --zprefix". + */ +#ifdef Z_PREFIX /* may be set to #if 1 by ./configure */ + +/* all linked symbols */ +# define _dist_code z__dist_code +# define _length_code z__length_code +# define _tr_align z__tr_align +# define _tr_flush_block z__tr_flush_block +# define _tr_init z__tr_init +# define _tr_stored_block z__tr_stored_block +# define _tr_tally z__tr_tally +# define adler32 z_adler32 +# define adler32_combine z_adler32_combine +# define adler32_combine64 z_adler32_combine64 +# define compress z_compress +# define compress2 z_compress2 +# define compressBound z_compressBound +# define crc32 z_crc32 +# define crc32_combine z_crc32_combine +# define crc32_combine64 z_crc32_combine64 +# define deflate z_deflate +# define deflateBound z_deflateBound +# define deflateCopy z_deflateCopy +# define deflateEnd z_deflateEnd +# define deflateInit2_ z_deflateInit2_ +# define deflateInit_ z_deflateInit_ +# define deflateParams z_deflateParams +# define deflatePrime z_deflatePrime +# define deflateReset z_deflateReset +# define deflateSetDictionary z_deflateSetDictionary +# define deflateSetHeader z_deflateSetHeader +# define deflateTune z_deflateTune +# define deflate_copyright z_deflate_copyright +# define get_crc_table z_get_crc_table +# define gz_error z_gz_error +# define gz_intmax z_gz_intmax +# define gz_strwinerror z_gz_strwinerror +# define gzbuffer z_gzbuffer +# define gzclearerr z_gzclearerr +# define gzclose z_gzclose +# define gzclose_r z_gzclose_r +# define gzclose_w z_gzclose_w +# define gzdirect z_gzdirect +# define gzdopen z_gzdopen +# define gzeof z_gzeof +# define gzerror z_gzerror +# define gzflush z_gzflush +# define gzgetc z_gzgetc +# define gzgets z_gzgets +# define gzoffset z_gzoffset +# define gzoffset64 z_gzoffset64 +# define gzopen z_gzopen +# define gzopen64 z_gzopen64 +# define gzprintf z_gzprintf +# define gzputc z_gzputc +# define gzputs z_gzputs +# define gzread z_gzread +# define gzrewind z_gzrewind +# define gzseek z_gzseek +# define gzseek64 z_gzseek64 +# define gzsetparams z_gzsetparams +# define gztell z_gztell +# define gztell64 z_gztell64 +# define gzungetc z_gzungetc +# define gzwrite z_gzwrite +# define inflate z_inflate +# define inflateBack z_inflateBack +# define inflateBackEnd z_inflateBackEnd +# define inflateBackInit_ z_inflateBackInit_ +# define inflateCopy z_inflateCopy +# define inflateEnd z_inflateEnd +# define inflateGetHeader z_inflateGetHeader +# define inflateInit2_ z_inflateInit2_ +# define inflateInit_ z_inflateInit_ +# define inflateMark z_inflateMark +# define inflatePrime z_inflatePrime +# define inflateReset z_inflateReset +# define inflateReset2 z_inflateReset2 +# define inflateSetDictionary z_inflateSetDictionary +# define inflateSync z_inflateSync +# define inflateSyncPoint z_inflateSyncPoint +# define inflateUndermine z_inflateUndermine +# define inflate_copyright z_inflate_copyright +# define inflate_fast z_inflate_fast +# define inflate_table z_inflate_table +# define uncompress z_uncompress +# define zError z_zError +# define zcalloc z_zcalloc +# define zcfree z_zcfree +# define zlibCompileFlags z_zlibCompileFlags +# define zlibVersion z_zlibVersion + +/* all zlib typedefs in zlib.h and zconf.h */ +# define Byte z_Byte +# define Bytef z_Bytef +# define alloc_func z_alloc_func +# define charf z_charf +# define free_func z_free_func +# define gzFile z_gzFile +# define gz_header z_gz_header +# define gz_headerp z_gz_headerp +# define in_func z_in_func +# define intf z_intf +# define out_func z_out_func +# define uInt z_uInt +# define uIntf z_uIntf +# define uLong z_uLong +# define uLongf z_uLongf +# define voidp z_voidp +# define voidpc z_voidpc +# define voidpf z_voidpf + +/* all zlib structs in zlib.h and zconf.h */ +# define gz_header_s z_gz_header_s +# define internal_state z_internal_state + +#endif + +#if defined(__MSDOS__) && !defined(MSDOS) +# define MSDOS +#endif +#if (defined(OS_2) || defined(__OS2__)) && !defined(OS2) +# define OS2 +#endif +#if defined(_WINDOWS) && !defined(WINDOWS) +# define WINDOWS +#endif +#if defined(_WIN32) || defined(_WIN32_WCE) || defined(__WIN32__) +# ifndef WIN32 +# define WIN32 +# endif +#endif +#if (defined(MSDOS) || defined(OS2) || defined(WINDOWS)) && !defined(WIN32) +# if !defined(__GNUC__) && !defined(__FLAT__) && !defined(__386__) +# ifndef SYS16BIT +# define SYS16BIT +# endif +# endif +#endif + +/* + * Compile with -DMAXSEG_64K if the alloc function cannot allocate more + * than 64k bytes at a time (needed on systems with 16-bit int). + */ +#ifdef SYS16BIT +# define MAXSEG_64K +#endif +#ifdef MSDOS +# define UNALIGNED_OK +#endif + +#ifdef __STDC_VERSION__ +# ifndef STDC +# define STDC +# endif +# if __STDC_VERSION__ >= 199901L +# ifndef STDC99 +# define STDC99 +# endif +# endif +#endif +#if !defined(STDC) && (defined(__STDC__) || defined(__cplusplus)) +# define STDC +#endif +#if !defined(STDC) && (defined(__GNUC__) || defined(__BORLANDC__)) +# define STDC +#endif +#if !defined(STDC) && (defined(MSDOS) || defined(WINDOWS) || defined(WIN32)) +# define STDC +#endif +#if !defined(STDC) && (defined(OS2) || defined(__HOS_AIX__)) +# define STDC +#endif + +#if defined(__OS400__) && !defined(STDC) /* iSeries (formerly AS/400). */ +# define STDC +#endif + +#ifndef STDC +# ifndef const /* cannot use !defined(STDC) && !defined(const) on Mac */ +# define const /* note: need a more gentle solution here */ +# endif +#endif + +/* Some Mac compilers merge all .h files incorrectly: */ +#if defined(__MWERKS__)||defined(applec)||defined(THINK_C)||defined(__SC__) +# define NO_DUMMY_DECL +#endif + +/* Maximum value for memLevel in deflateInit2 */ +#ifndef MAX_MEM_LEVEL +# ifdef MAXSEG_64K +# define MAX_MEM_LEVEL 8 +# else +# define MAX_MEM_LEVEL 9 +# endif +#endif + +/* Maximum value for windowBits in deflateInit2 and inflateInit2. + * WARNING: reducing MAX_WBITS makes minigzip unable to extract .gz files + * created by gzip. (Files created by minigzip can still be extracted by + * gzip.) + */ +#ifndef MAX_WBITS +# define MAX_WBITS 15 /* 32K LZ77 window */ +#endif + +/* The memory requirements for deflate are (in bytes): + (1 << (windowBits+2)) + (1 << (memLevel+9)) + that is: 128K for windowBits=15 + 128K for memLevel = 8 (default values) + plus a few kilobytes for small objects. For example, if you want to reduce + the default memory requirements from 256K to 128K, compile with + make CFLAGS="-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7" + Of course this will generally degrade compression (there's no free lunch). + + The memory requirements for inflate are (in bytes) 1 << windowBits + that is, 32K for windowBits=15 (default value) plus a few kilobytes + for small objects. +*/ + + /* Type declarations */ + +#ifndef OF /* function prototypes */ +# ifdef STDC +# define OF(args) args +# else +# define OF(args) () +# endif +#endif + +/* The following definitions for FAR are needed only for MSDOS mixed + * model programming (small or medium model with some far allocations). + * This was tested only with MSC; for other MSDOS compilers you may have + * to define NO_MEMCPY in zutil.h. If you don't need the mixed model, + * just define FAR to be empty. + */ +#ifdef SYS16BIT +# if defined(M_I86SM) || defined(M_I86MM) + /* MSC small or medium model */ +# define SMALL_MEDIUM +# ifdef _MSC_VER +# define FAR _far +# else +# define FAR far +# endif +# endif +# if (defined(__SMALL__) || defined(__MEDIUM__)) + /* Turbo C small or medium model */ +# define SMALL_MEDIUM +# ifdef __BORLANDC__ +# define FAR _far +# else +# define FAR far +# endif +# endif +#endif + +#if defined(WINDOWS) || defined(WIN32) + /* If building or using zlib as a DLL, define ZLIB_DLL. + * This is not mandatory, but it offers a little performance increase. + */ +# ifdef ZLIB_DLL +# if defined(WIN32) && (!defined(__BORLANDC__) || (__BORLANDC__ >= 0x500)) +# ifdef ZLIB_INTERNAL +# define ZEXTERN extern __declspec(dllexport) +# else +# define ZEXTERN extern __declspec(dllimport) +# endif +# endif +# endif /* ZLIB_DLL */ + /* If building or using zlib with the WINAPI/WINAPIV calling convention, + * define ZLIB_WINAPI. + * Caution: the standard ZLIB1.DLL is NOT compiled using ZLIB_WINAPI. + */ +# ifdef ZLIB_WINAPI +# ifdef FAR +# undef FAR +# endif +# include + /* No need for _export, use ZLIB.DEF instead. */ + /* For complete Windows compatibility, use WINAPI, not __stdcall. */ +# define ZEXPORT WINAPI +# ifdef WIN32 +# define ZEXPORTVA WINAPIV +# else +# define ZEXPORTVA FAR CDECL +# endif +# endif +#endif + +#if defined (__BEOS__) +# ifdef ZLIB_DLL +# ifdef ZLIB_INTERNAL +# define ZEXPORT __declspec(dllexport) +# define ZEXPORTVA __declspec(dllexport) +# else +# define ZEXPORT __declspec(dllimport) +# define ZEXPORTVA __declspec(dllimport) +# endif +# endif +#endif + +#ifndef ZEXTERN +# define ZEXTERN extern +#endif +#ifndef ZEXPORT +# define ZEXPORT +#endif +#ifndef ZEXPORTVA +# define ZEXPORTVA +#endif + +#ifndef FAR +# define FAR +#endif + +#if !defined(__MACTYPES__) +typedef unsigned char Byte; /* 8 bits */ +#endif +typedef unsigned int uInt; /* 16 bits or more */ +typedef unsigned long uLong; /* 32 bits or more */ + +#ifdef SMALL_MEDIUM + /* Borland C/C++ and some old MSC versions ignore FAR inside typedef */ +# define Bytef Byte FAR +#else + typedef Byte FAR Bytef; +#endif +typedef char FAR charf; +typedef int FAR intf; +typedef uInt FAR uIntf; +typedef uLong FAR uLongf; + +#ifdef STDC + typedef void const *voidpc; + typedef void FAR *voidpf; + typedef void *voidp; +#else + typedef Byte const *voidpc; + typedef Byte FAR *voidpf; + typedef Byte *voidp; +#endif + +#ifdef HAVE_UNISTD_H /* may be set to #if 1 by ./configure */ +# define Z_HAVE_UNISTD_H +#endif + +#ifdef STDC +# include /* for off_t */ +#endif + +/* a little trick to accommodate both "#define _LARGEFILE64_SOURCE" and + * "#define _LARGEFILE64_SOURCE 1" as requesting 64-bit operations, (even + * though the former does not conform to the LFS document), but considering + * both "#undef _LARGEFILE64_SOURCE" and "#define _LARGEFILE64_SOURCE 0" as + * equivalently requesting no 64-bit operations + */ +#if -_LARGEFILE64_SOURCE - -1 == 1 +# undef _LARGEFILE64_SOURCE +#endif + +#if defined(Z_HAVE_UNISTD_H) || defined(_LARGEFILE64_SOURCE) +# include /* for SEEK_* and off_t */ +# ifdef VMS +# include /* for off_t */ +# endif +# ifndef z_off_t +# define z_off_t off_t +# endif +#endif + +#ifndef SEEK_SET +# define SEEK_SET 0 /* Seek from beginning of file. */ +# define SEEK_CUR 1 /* Seek from current position. */ +# define SEEK_END 2 /* Set file pointer to EOF plus "offset" */ +#endif + +#ifndef z_off_t +# define z_off_t long +#endif + +#if defined(_LARGEFILE64_SOURCE) && _LFS64_LARGEFILE-0 +# define z_off64_t off64_t +#else +# define z_off64_t z_off_t +#endif + +#if defined(__OS400__) +# define NO_vsnprintf +#endif + +#if defined(__MVS__) +# define NO_vsnprintf +#endif + +/* MVS linker does not support external names larger than 8 bytes */ +#if defined(__MVS__) + #pragma map(deflateInit_,"DEIN") + #pragma map(deflateInit2_,"DEIN2") + #pragma map(deflateEnd,"DEEND") + #pragma map(deflateBound,"DEBND") + #pragma map(inflateInit_,"ININ") + #pragma map(inflateInit2_,"ININ2") + #pragma map(inflateEnd,"INEND") + #pragma map(inflateSync,"INSY") + #pragma map(inflateSetDictionary,"INSEDI") + #pragma map(compressBound,"CMBND") + #pragma map(inflate_table,"INTABL") + #pragma map(inflate_fast,"INFA") + #pragma map(inflate_copyright,"INCOPY") +#endif + +#endif /* ZCONF_H */ diff --git a/3rdParty/JCL/source/common/zlib.h b/3rdParty/JCL/source/common/zlib.h new file mode 100644 index 00000000..bfbba83e --- /dev/null +++ b/3rdParty/JCL/source/common/zlib.h @@ -0,0 +1,1613 @@ +/* zlib.h -- interface of the 'zlib' general purpose compression library + version 1.2.5, April 19th, 2010 + + Copyright (C) 1995-2010 Jean-loup Gailly and Mark Adler + + This software is provided 'as-is', without any express or implied + warranty. In no event will the authors be held liable for any damages + arising from the use of this software. + + Permission is granted to anyone to use this software for any purpose, + including commercial applications, and to alter it and redistribute it + freely, subject to the following restrictions: + + 1. The origin of this software must not be misrepresented; you must not + claim that you wrote the original software. If you use this software + in a product, an acknowledgment in the product documentation would be + appreciated but is not required. + 2. Altered source versions must be plainly marked as such, and must not be + misrepresented as being the original software. + 3. This notice may not be removed or altered from any source distribution. + + Jean-loup Gailly Mark Adler + jloup@gzip.org madler@alumni.caltech.edu + + + The data format used by the zlib library is described by RFCs (Request for + Comments) 1950 to 1952 in the files http://www.ietf.org/rfc/rfc1950.txt + (zlib format), rfc1951.txt (deflate format) and rfc1952.txt (gzip format). +*/ + +#ifndef ZLIB_H +#define ZLIB_H + +#include "zconf.h" + +#ifdef __cplusplus +extern "C" { +#endif + +#define ZLIB_VERSION "1.2.5" +#define ZLIB_VERNUM 0x1250 +#define ZLIB_VER_MAJOR 1 +#define ZLIB_VER_MINOR 2 +#define ZLIB_VER_REVISION 5 +#define ZLIB_VER_SUBREVISION 0 + +/* + The 'zlib' compression library provides in-memory compression and + decompression functions, including integrity checks of the uncompressed data. + This version of the library supports only one compression method (deflation) + but other algorithms will be added later and will have the same stream + interface. + + Compression can be done in a single step if the buffers are large enough, + or can be done by repeated calls of the compression function. In the latter + case, the application must provide more input and/or consume the output + (providing more output space) before each call. + + The compressed data format used by default by the in-memory functions is + the zlib format, which is a zlib wrapper documented in RFC 1950, wrapped + around a deflate stream, which is itself documented in RFC 1951. + + The library also supports reading and writing files in gzip (.gz) format + with an interface similar to that of stdio using the functions that start + with "gz". The gzip format is different from the zlib format. gzip is a + gzip wrapper, documented in RFC 1952, wrapped around a deflate stream. + + This library can optionally read and write gzip streams in memory as well. + + The zlib format was designed to be compact and fast for use in memory + and on communications channels. The gzip format was designed for single- + file compression on file systems, has a larger header than zlib to maintain + directory information, and uses a different, slower check method than zlib. + + The library does not install any signal handler. The decoder checks + the consistency of the compressed data, so the library should never crash + even in case of corrupted input. +*/ + +typedef voidpf (*alloc_func) OF((voidpf opaque, uInt items, uInt size)); +typedef void (*free_func) OF((voidpf opaque, voidpf address)); + +struct internal_state; + +typedef struct z_stream_s { + Bytef *next_in; /* next input byte */ + uInt avail_in; /* number of bytes available at next_in */ + uLong total_in; /* total nb of input bytes read so far */ + + Bytef *next_out; /* next output byte should be put there */ + uInt avail_out; /* remaining free space at next_out */ + uLong total_out; /* total nb of bytes output so far */ + + char *msg; /* last error message, NULL if no error */ + struct internal_state FAR *state; /* not visible by applications */ + + alloc_func zalloc; /* used to allocate the internal state */ + free_func zfree; /* used to free the internal state */ + voidpf opaque; /* private data object passed to zalloc and zfree */ + + int data_type; /* best guess about the data type: binary or text */ + uLong adler; /* adler32 value of the uncompressed data */ + uLong reserved; /* reserved for future use */ +} z_stream; + +typedef z_stream FAR *z_streamp; + +/* + gzip header information passed to and from zlib routines. See RFC 1952 + for more details on the meanings of these fields. +*/ +typedef struct gz_header_s { + int text; /* true if compressed data believed to be text */ + uLong time; /* modification time */ + int xflags; /* extra flags (not used when writing a gzip file) */ + int os; /* operating system */ + Bytef *extra; /* pointer to extra field or Z_NULL if none */ + uInt extra_len; /* extra field length (valid if extra != Z_NULL) */ + uInt extra_max; /* space at extra (only when reading header) */ + Bytef *name; /* pointer to zero-terminated file name or Z_NULL */ + uInt name_max; /* space at name (only when reading header) */ + Bytef *comment; /* pointer to zero-terminated comment or Z_NULL */ + uInt comm_max; /* space at comment (only when reading header) */ + int hcrc; /* true if there was or will be a header crc */ + int done; /* true when done reading gzip header (not used + when writing a gzip file) */ +} gz_header; + +typedef gz_header FAR *gz_headerp; + +/* + The application must update next_in and avail_in when avail_in has dropped + to zero. It must update next_out and avail_out when avail_out has dropped + to zero. The application must initialize zalloc, zfree and opaque before + calling the init function. All other fields are set by the compression + library and must not be updated by the application. + + The opaque value provided by the application will be passed as the first + parameter for calls of zalloc and zfree. This can be useful for custom + memory management. The compression library attaches no meaning to the + opaque value. + + zalloc must return Z_NULL if there is not enough memory for the object. + If zlib is used in a multi-threaded application, zalloc and zfree must be + thread safe. + + On 16-bit systems, the functions zalloc and zfree must be able to allocate + exactly 65536 bytes, but will not be required to allocate more than this if + the symbol MAXSEG_64K is defined (see zconf.h). WARNING: On MSDOS, pointers + returned by zalloc for objects of exactly 65536 bytes *must* have their + offset normalized to zero. The default allocation function provided by this + library ensures this (see zutil.c). To reduce memory requirements and avoid + any allocation of 64K objects, at the expense of compression ratio, compile + the library with -DMAX_WBITS=14 (see zconf.h). + + The fields total_in and total_out can be used for statistics or progress + reports. After compression, total_in holds the total size of the + uncompressed data and may be saved for use in the decompressor (particularly + if the decompressor wants to decompress everything in a single step). +*/ + + /* constants */ + +#define Z_NO_FLUSH 0 +#define Z_PARTIAL_FLUSH 1 +#define Z_SYNC_FLUSH 2 +#define Z_FULL_FLUSH 3 +#define Z_FINISH 4 +#define Z_BLOCK 5 +#define Z_TREES 6 +/* Allowed flush values; see deflate() and inflate() below for details */ + +#define Z_OK 0 +#define Z_STREAM_END 1 +#define Z_NEED_DICT 2 +#define Z_ERRNO (-1) +#define Z_STREAM_ERROR (-2) +#define Z_DATA_ERROR (-3) +#define Z_MEM_ERROR (-4) +#define Z_BUF_ERROR (-5) +#define Z_VERSION_ERROR (-6) +/* Return codes for the compression/decompression functions. Negative values + * are errors, positive values are used for special but normal events. + */ + +#define Z_NO_COMPRESSION 0 +#define Z_BEST_SPEED 1 +#define Z_BEST_COMPRESSION 9 +#define Z_DEFAULT_COMPRESSION (-1) +/* compression levels */ + +#define Z_FILTERED 1 +#define Z_HUFFMAN_ONLY 2 +#define Z_RLE 3 +#define Z_FIXED 4 +#define Z_DEFAULT_STRATEGY 0 +/* compression strategy; see deflateInit2() below for details */ + +#define Z_BINARY 0 +#define Z_TEXT 1 +#define Z_ASCII Z_TEXT /* for compatibility with 1.2.2 and earlier */ +#define Z_UNKNOWN 2 +/* Possible values of the data_type field (though see inflate()) */ + +#define Z_DEFLATED 8 +/* The deflate compression method (the only one supported in this version) */ + +#define Z_NULL 0 /* for initializing zalloc, zfree, opaque */ + +#define zlib_version zlibVersion() +/* for compatibility with versions < 1.0.2 */ + + + /* basic functions */ + +ZEXTERN const char * ZEXPORT zlibVersion OF((void)); +/* The application can compare zlibVersion and ZLIB_VERSION for consistency. + If the first character differs, the library code actually used is not + compatible with the zlib.h header file used by the application. This check + is automatically made by deflateInit and inflateInit. + */ + +/* +ZEXTERN int ZEXPORT deflateInit OF((z_streamp strm, int level)); + + Initializes the internal stream state for compression. The fields + zalloc, zfree and opaque must be initialized before by the caller. If + zalloc and zfree are set to Z_NULL, deflateInit updates them to use default + allocation functions. + + The compression level must be Z_DEFAULT_COMPRESSION, or between 0 and 9: + 1 gives best speed, 9 gives best compression, 0 gives no compression at all + (the input data is simply copied a block at a time). Z_DEFAULT_COMPRESSION + requests a default compromise between speed and compression (currently + equivalent to level 6). + + deflateInit returns Z_OK if success, Z_MEM_ERROR if there was not enough + memory, Z_STREAM_ERROR if level is not a valid compression level, or + Z_VERSION_ERROR if the zlib library version (zlib_version) is incompatible + with the version assumed by the caller (ZLIB_VERSION). msg is set to null + if there is no error message. deflateInit does not perform any compression: + this will be done by deflate(). +*/ + + +ZEXTERN int ZEXPORT deflate OF((z_streamp strm, int flush)); +/* + deflate compresses as much data as possible, and stops when the input + buffer becomes empty or the output buffer becomes full. It may introduce + some output latency (reading input without producing any output) except when + forced to flush. + + The detailed semantics are as follows. deflate performs one or both of the + following actions: + + - Compress more input starting at next_in and update next_in and avail_in + accordingly. If not all input can be processed (because there is not + enough room in the output buffer), next_in and avail_in are updated and + processing will resume at this point for the next call of deflate(). + + - Provide more output starting at next_out and update next_out and avail_out + accordingly. This action is forced if the parameter flush is non zero. + Forcing flush frequently degrades the compression ratio, so this parameter + should be set only when necessary (in interactive applications). Some + output may be provided even if flush is not set. + + Before the call of deflate(), the application should ensure that at least + one of the actions is possible, by providing more input and/or consuming more + output, and updating avail_in or avail_out accordingly; avail_out should + never be zero before the call. The application can consume the compressed + output when it wants, for example when the output buffer is full (avail_out + == 0), or after each call of deflate(). If deflate returns Z_OK and with + zero avail_out, it must be called again after making room in the output + buffer because there might be more output pending. + + Normally the parameter flush is set to Z_NO_FLUSH, which allows deflate to + decide how much data to accumulate before producing output, in order to + maximize compression. + + If the parameter flush is set to Z_SYNC_FLUSH, all pending output is + flushed to the output buffer and the output is aligned on a byte boundary, so + that the decompressor can get all input data available so far. (In + particular avail_in is zero after the call if enough output space has been + provided before the call.) Flushing may degrade compression for some + compression algorithms and so it should be used only when necessary. This + completes the current deflate block and follows it with an empty stored block + that is three bits plus filler bits to the next byte, followed by four bytes + (00 00 ff ff). + + If flush is set to Z_PARTIAL_FLUSH, all pending output is flushed to the + output buffer, but the output is not aligned to a byte boundary. All of the + input data so far will be available to the decompressor, as for Z_SYNC_FLUSH. + This completes the current deflate block and follows it with an empty fixed + codes block that is 10 bits long. This assures that enough bytes are output + in order for the decompressor to finish the block before the empty fixed code + block. + + If flush is set to Z_BLOCK, a deflate block is completed and emitted, as + for Z_SYNC_FLUSH, but the output is not aligned on a byte boundary, and up to + seven bits of the current block are held to be written as the next byte after + the next deflate block is completed. In this case, the decompressor may not + be provided enough bits at this point in order to complete decompression of + the data provided so far to the compressor. It may need to wait for the next + block to be emitted. This is for advanced applications that need to control + the emission of deflate blocks. + + If flush is set to Z_FULL_FLUSH, all output is flushed as with + Z_SYNC_FLUSH, and the compression state is reset so that decompression can + restart from this point if previous compressed data has been damaged or if + random access is desired. Using Z_FULL_FLUSH too often can seriously degrade + compression. + + If deflate returns with avail_out == 0, this function must be called again + with the same value of the flush parameter and more output space (updated + avail_out), until the flush is complete (deflate returns with non-zero + avail_out). In the case of a Z_FULL_FLUSH or Z_SYNC_FLUSH, make sure that + avail_out is greater than six to avoid repeated flush markers due to + avail_out == 0 on return. + + If the parameter flush is set to Z_FINISH, pending input is processed, + pending output is flushed and deflate returns with Z_STREAM_END if there was + enough output space; if deflate returns with Z_OK, this function must be + called again with Z_FINISH and more output space (updated avail_out) but no + more input data, until it returns with Z_STREAM_END or an error. After + deflate has returned Z_STREAM_END, the only possible operations on the stream + are deflateReset or deflateEnd. + + Z_FINISH can be used immediately after deflateInit if all the compression + is to be done in a single step. In this case, avail_out must be at least the + value returned by deflateBound (see below). If deflate does not return + Z_STREAM_END, then it must be called again as described above. + + deflate() sets strm->adler to the adler32 checksum of all input read + so far (that is, total_in bytes). + + deflate() may update strm->data_type if it can make a good guess about + the input data type (Z_BINARY or Z_TEXT). In doubt, the data is considered + binary. This field is only for information purposes and does not affect the + compression algorithm in any manner. + + deflate() returns Z_OK if some progress has been made (more input + processed or more output produced), Z_STREAM_END if all input has been + consumed and all output has been produced (only when flush is set to + Z_FINISH), Z_STREAM_ERROR if the stream state was inconsistent (for example + if next_in or next_out was Z_NULL), Z_BUF_ERROR if no progress is possible + (for example avail_in or avail_out was zero). Note that Z_BUF_ERROR is not + fatal, and deflate() can be called again with more input and more output + space to continue compressing. +*/ + + +ZEXTERN int ZEXPORT deflateEnd OF((z_streamp strm)); +/* + All dynamically allocated data structures for this stream are freed. + This function discards any unprocessed input and does not flush any pending + output. + + deflateEnd returns Z_OK if success, Z_STREAM_ERROR if the + stream state was inconsistent, Z_DATA_ERROR if the stream was freed + prematurely (some input or output was discarded). In the error case, msg + may be set but then points to a static string (which must not be + deallocated). +*/ + + +/* +ZEXTERN int ZEXPORT inflateInit OF((z_streamp strm)); + + Initializes the internal stream state for decompression. The fields + next_in, avail_in, zalloc, zfree and opaque must be initialized before by + the caller. If next_in is not Z_NULL and avail_in is large enough (the + exact value depends on the compression method), inflateInit determines the + compression method from the zlib header and allocates all data structures + accordingly; otherwise the allocation will be deferred to the first call of + inflate. If zalloc and zfree are set to Z_NULL, inflateInit updates them to + use default allocation functions. + + inflateInit returns Z_OK if success, Z_MEM_ERROR if there was not enough + memory, Z_VERSION_ERROR if the zlib library version is incompatible with the + version assumed by the caller, or Z_STREAM_ERROR if the parameters are + invalid, such as a null pointer to the structure. msg is set to null if + there is no error message. inflateInit does not perform any decompression + apart from possibly reading the zlib header if present: actual decompression + will be done by inflate(). (So next_in and avail_in may be modified, but + next_out and avail_out are unused and unchanged.) The current implementation + of inflateInit() does not process any header information -- that is deferred + until inflate() is called. +*/ + + +ZEXTERN int ZEXPORT inflate OF((z_streamp strm, int flush)); +/* + inflate decompresses as much data as possible, and stops when the input + buffer becomes empty or the output buffer becomes full. It may introduce + some output latency (reading input without producing any output) except when + forced to flush. + + The detailed semantics are as follows. inflate performs one or both of the + following actions: + + - Decompress more input starting at next_in and update next_in and avail_in + accordingly. If not all input can be processed (because there is not + enough room in the output buffer), next_in is updated and processing will + resume at this point for the next call of inflate(). + + - Provide more output starting at next_out and update next_out and avail_out + accordingly. inflate() provides as much output as possible, until there is + no more input data or no more space in the output buffer (see below about + the flush parameter). + + Before the call of inflate(), the application should ensure that at least + one of the actions is possible, by providing more input and/or consuming more + output, and updating the next_* and avail_* values accordingly. The + application can consume the uncompressed output when it wants, for example + when the output buffer is full (avail_out == 0), or after each call of + inflate(). If inflate returns Z_OK and with zero avail_out, it must be + called again after making room in the output buffer because there might be + more output pending. + + The flush parameter of inflate() can be Z_NO_FLUSH, Z_SYNC_FLUSH, Z_FINISH, + Z_BLOCK, or Z_TREES. Z_SYNC_FLUSH requests that inflate() flush as much + output as possible to the output buffer. Z_BLOCK requests that inflate() + stop if and when it gets to the next deflate block boundary. When decoding + the zlib or gzip format, this will cause inflate() to return immediately + after the header and before the first block. When doing a raw inflate, + inflate() will go ahead and process the first block, and will return when it + gets to the end of that block, or when it runs out of data. + + The Z_BLOCK option assists in appending to or combining deflate streams. + Also to assist in this, on return inflate() will set strm->data_type to the + number of unused bits in the last byte taken from strm->next_in, plus 64 if + inflate() is currently decoding the last block in the deflate stream, plus + 128 if inflate() returned immediately after decoding an end-of-block code or + decoding the complete header up to just before the first byte of the deflate + stream. The end-of-block will not be indicated until all of the uncompressed + data from that block has been written to strm->next_out. The number of + unused bits may in general be greater than seven, except when bit 7 of + data_type is set, in which case the number of unused bits will be less than + eight. data_type is set as noted here every time inflate() returns for all + flush options, and so can be used to determine the amount of currently + consumed input in bits. + + The Z_TREES option behaves as Z_BLOCK does, but it also returns when the + end of each deflate block header is reached, before any actual data in that + block is decoded. This allows the caller to determine the length of the + deflate block header for later use in random access within a deflate block. + 256 is added to the value of strm->data_type when inflate() returns + immediately after reaching the end of the deflate block header. + + inflate() should normally be called until it returns Z_STREAM_END or an + error. However if all decompression is to be performed in a single step (a + single call of inflate), the parameter flush should be set to Z_FINISH. In + this case all pending input is processed and all pending output is flushed; + avail_out must be large enough to hold all the uncompressed data. (The size + of the uncompressed data may have been saved by the compressor for this + purpose.) The next operation on this stream must be inflateEnd to deallocate + the decompression state. The use of Z_FINISH is never required, but can be + used to inform inflate that a faster approach may be used for the single + inflate() call. + + In this implementation, inflate() always flushes as much output as + possible to the output buffer, and always uses the faster approach on the + first call. So the only effect of the flush parameter in this implementation + is on the return value of inflate(), as noted below, or when it returns early + because Z_BLOCK or Z_TREES is used. + + If a preset dictionary is needed after this call (see inflateSetDictionary + below), inflate sets strm->adler to the adler32 checksum of the dictionary + chosen by the compressor and returns Z_NEED_DICT; otherwise it sets + strm->adler to the adler32 checksum of all output produced so far (that is, + total_out bytes) and returns Z_OK, Z_STREAM_END or an error code as described + below. At the end of the stream, inflate() checks that its computed adler32 + checksum is equal to that saved by the compressor and returns Z_STREAM_END + only if the checksum is correct. + + inflate() can decompress and check either zlib-wrapped or gzip-wrapped + deflate data. The header type is detected automatically, if requested when + initializing with inflateInit2(). Any information contained in the gzip + header is not retained, so applications that need that information should + instead use raw inflate, see inflateInit2() below, or inflateBack() and + perform their own processing of the gzip header and trailer. + + inflate() returns Z_OK if some progress has been made (more input processed + or more output produced), Z_STREAM_END if the end of the compressed data has + been reached and all uncompressed output has been produced, Z_NEED_DICT if a + preset dictionary is needed at this point, Z_DATA_ERROR if the input data was + corrupted (input stream not conforming to the zlib format or incorrect check + value), Z_STREAM_ERROR if the stream structure was inconsistent (for example + next_in or next_out was Z_NULL), Z_MEM_ERROR if there was not enough memory, + Z_BUF_ERROR if no progress is possible or if there was not enough room in the + output buffer when Z_FINISH is used. Note that Z_BUF_ERROR is not fatal, and + inflate() can be called again with more input and more output space to + continue decompressing. If Z_DATA_ERROR is returned, the application may + then call inflateSync() to look for a good compression block if a partial + recovery of the data is desired. +*/ + + +ZEXTERN int ZEXPORT inflateEnd OF((z_streamp strm)); +/* + All dynamically allocated data structures for this stream are freed. + This function discards any unprocessed input and does not flush any pending + output. + + inflateEnd returns Z_OK if success, Z_STREAM_ERROR if the stream state + was inconsistent. In the error case, msg may be set but then points to a + static string (which must not be deallocated). +*/ + + + /* Advanced functions */ + +/* + The following functions are needed only in some special applications. +*/ + +/* +ZEXTERN int ZEXPORT deflateInit2 OF((z_streamp strm, + int level, + int method, + int windowBits, + int memLevel, + int strategy)); + + This is another version of deflateInit with more compression options. The + fields next_in, zalloc, zfree and opaque must be initialized before by the + caller. + + The method parameter is the compression method. It must be Z_DEFLATED in + this version of the library. + + The windowBits parameter is the base two logarithm of the window size + (the size of the history buffer). It should be in the range 8..15 for this + version of the library. Larger values of this parameter result in better + compression at the expense of memory usage. The default value is 15 if + deflateInit is used instead. + + windowBits can also be -8..-15 for raw deflate. In this case, -windowBits + determines the window size. deflate() will then generate raw deflate data + with no zlib header or trailer, and will not compute an adler32 check value. + + windowBits can also be greater than 15 for optional gzip encoding. Add + 16 to windowBits to write a simple gzip header and trailer around the + compressed data instead of a zlib wrapper. The gzip header will have no + file name, no extra data, no comment, no modification time (set to zero), no + header crc, and the operating system will be set to 255 (unknown). If a + gzip stream is being written, strm->adler is a crc32 instead of an adler32. + + The memLevel parameter specifies how much memory should be allocated + for the internal compression state. memLevel=1 uses minimum memory but is + slow and reduces compression ratio; memLevel=9 uses maximum memory for + optimal speed. The default value is 8. See zconf.h for total memory usage + as a function of windowBits and memLevel. + + The strategy parameter is used to tune the compression algorithm. Use the + value Z_DEFAULT_STRATEGY for normal data, Z_FILTERED for data produced by a + filter (or predictor), Z_HUFFMAN_ONLY to force Huffman encoding only (no + string match), or Z_RLE to limit match distances to one (run-length + encoding). Filtered data consists mostly of small values with a somewhat + random distribution. In this case, the compression algorithm is tuned to + compress them better. The effect of Z_FILTERED is to force more Huffman + coding and less string matching; it is somewhat intermediate between + Z_DEFAULT_STRATEGY and Z_HUFFMAN_ONLY. Z_RLE is designed to be almost as + fast as Z_HUFFMAN_ONLY, but give better compression for PNG image data. The + strategy parameter only affects the compression ratio but not the + correctness of the compressed output even if it is not set appropriately. + Z_FIXED prevents the use of dynamic Huffman codes, allowing for a simpler + decoder for special applications. + + deflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough + memory, Z_STREAM_ERROR if any parameter is invalid (such as an invalid + method), or Z_VERSION_ERROR if the zlib library version (zlib_version) is + incompatible with the version assumed by the caller (ZLIB_VERSION). msg is + set to null if there is no error message. deflateInit2 does not perform any + compression: this will be done by deflate(). +*/ + +ZEXTERN int ZEXPORT deflateSetDictionary OF((z_streamp strm, + const Bytef *dictionary, + uInt dictLength)); +/* + Initializes the compression dictionary from the given byte sequence + without producing any compressed output. This function must be called + immediately after deflateInit, deflateInit2 or deflateReset, before any call + of deflate. The compressor and decompressor must use exactly the same + dictionary (see inflateSetDictionary). + + The dictionary should consist of strings (byte sequences) that are likely + to be encountered later in the data to be compressed, with the most commonly + used strings preferably put towards the end of the dictionary. Using a + dictionary is most useful when the data to be compressed is short and can be + predicted with good accuracy; the data can then be compressed better than + with the default empty dictionary. + + Depending on the size of the compression data structures selected by + deflateInit or deflateInit2, a part of the dictionary may in effect be + discarded, for example if the dictionary is larger than the window size + provided in deflateInit or deflateInit2. Thus the strings most likely to be + useful should be put at the end of the dictionary, not at the front. In + addition, the current implementation of deflate will use at most the window + size minus 262 bytes of the provided dictionary. + + Upon return of this function, strm->adler is set to the adler32 value + of the dictionary; the decompressor may later use this value to determine + which dictionary has been used by the compressor. (The adler32 value + applies to the whole dictionary even if only a subset of the dictionary is + actually used by the compressor.) If a raw deflate was requested, then the + adler32 value is not computed and strm->adler is not set. + + deflateSetDictionary returns Z_OK if success, or Z_STREAM_ERROR if a + parameter is invalid (e.g. dictionary being Z_NULL) or the stream state is + inconsistent (for example if deflate has already been called for this stream + or if the compression method is bsort). deflateSetDictionary does not + perform any compression: this will be done by deflate(). +*/ + +ZEXTERN int ZEXPORT deflateCopy OF((z_streamp dest, + z_streamp source)); +/* + Sets the destination stream as a complete copy of the source stream. + + This function can be useful when several compression strategies will be + tried, for example when there are several ways of pre-processing the input + data with a filter. The streams that will be discarded should then be freed + by calling deflateEnd. Note that deflateCopy duplicates the internal + compression state which can be quite large, so this strategy is slow and can + consume lots of memory. + + deflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not + enough memory, Z_STREAM_ERROR if the source stream state was inconsistent + (such as zalloc being Z_NULL). msg is left unchanged in both source and + destination. +*/ + +ZEXTERN int ZEXPORT deflateReset OF((z_streamp strm)); +/* + This function is equivalent to deflateEnd followed by deflateInit, + but does not free and reallocate all the internal compression state. The + stream will keep the same compression level and any other attributes that + may have been set by deflateInit2. + + deflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source + stream state was inconsistent (such as zalloc or state being Z_NULL). +*/ + +ZEXTERN int ZEXPORT deflateParams OF((z_streamp strm, + int level, + int strategy)); +/* + Dynamically update the compression level and compression strategy. The + interpretation of level and strategy is as in deflateInit2. This can be + used to switch between compression and straight copy of the input data, or + to switch to a different kind of input data requiring a different strategy. + If the compression level is changed, the input available so far is + compressed with the old level (and may be flushed); the new level will take + effect only at the next call of deflate(). + + Before the call of deflateParams, the stream state must be set as for + a call of deflate(), since the currently available input may have to be + compressed and flushed. In particular, strm->avail_out must be non-zero. + + deflateParams returns Z_OK if success, Z_STREAM_ERROR if the source + stream state was inconsistent or if a parameter was invalid, Z_BUF_ERROR if + strm->avail_out was zero. +*/ + +ZEXTERN int ZEXPORT deflateTune OF((z_streamp strm, + int good_length, + int max_lazy, + int nice_length, + int max_chain)); +/* + Fine tune deflate's internal compression parameters. This should only be + used by someone who understands the algorithm used by zlib's deflate for + searching for the best matching string, and even then only by the most + fanatic optimizer trying to squeeze out the last compressed bit for their + specific input data. Read the deflate.c source code for the meaning of the + max_lazy, good_length, nice_length, and max_chain parameters. + + deflateTune() can be called after deflateInit() or deflateInit2(), and + returns Z_OK on success, or Z_STREAM_ERROR for an invalid deflate stream. + */ + +ZEXTERN uLong ZEXPORT deflateBound OF((z_streamp strm, + uLong sourceLen)); +/* + deflateBound() returns an upper bound on the compressed size after + deflation of sourceLen bytes. It must be called after deflateInit() or + deflateInit2(), and after deflateSetHeader(), if used. This would be used + to allocate an output buffer for deflation in a single pass, and so would be + called before deflate(). +*/ + +ZEXTERN int ZEXPORT deflatePrime OF((z_streamp strm, + int bits, + int value)); +/* + deflatePrime() inserts bits in the deflate output stream. The intent + is that this function is used to start off the deflate output with the bits + leftover from a previous deflate stream when appending to it. As such, this + function can only be used for raw deflate, and must be used before the first + deflate() call after a deflateInit2() or deflateReset(). bits must be less + than or equal to 16, and that many of the least significant bits of value + will be inserted in the output. + + deflatePrime returns Z_OK if success, or Z_STREAM_ERROR if the source + stream state was inconsistent. +*/ + +ZEXTERN int ZEXPORT deflateSetHeader OF((z_streamp strm, + gz_headerp head)); +/* + deflateSetHeader() provides gzip header information for when a gzip + stream is requested by deflateInit2(). deflateSetHeader() may be called + after deflateInit2() or deflateReset() and before the first call of + deflate(). The text, time, os, extra field, name, and comment information + in the provided gz_header structure are written to the gzip header (xflag is + ignored -- the extra flags are set according to the compression level). The + caller must assure that, if not Z_NULL, name and comment are terminated with + a zero byte, and that if extra is not Z_NULL, that extra_len bytes are + available there. If hcrc is true, a gzip header crc is included. Note that + the current versions of the command-line version of gzip (up through version + 1.3.x) do not support header crc's, and will report that it is a "multi-part + gzip file" and give up. + + If deflateSetHeader is not used, the default gzip header has text false, + the time set to zero, and os set to 255, with no extra, name, or comment + fields. The gzip header is returned to the default state by deflateReset(). + + deflateSetHeader returns Z_OK if success, or Z_STREAM_ERROR if the source + stream state was inconsistent. +*/ + +/* +ZEXTERN int ZEXPORT inflateInit2 OF((z_streamp strm, + int windowBits)); + + This is another version of inflateInit with an extra parameter. The + fields next_in, avail_in, zalloc, zfree and opaque must be initialized + before by the caller. + + The windowBits parameter is the base two logarithm of the maximum window + size (the size of the history buffer). It should be in the range 8..15 for + this version of the library. The default value is 15 if inflateInit is used + instead. windowBits must be greater than or equal to the windowBits value + provided to deflateInit2() while compressing, or it must be equal to 15 if + deflateInit2() was not used. If a compressed stream with a larger window + size is given as input, inflate() will return with the error code + Z_DATA_ERROR instead of trying to allocate a larger window. + + windowBits can also be zero to request that inflate use the window size in + the zlib header of the compressed stream. + + windowBits can also be -8..-15 for raw inflate. In this case, -windowBits + determines the window size. inflate() will then process raw deflate data, + not looking for a zlib or gzip header, not generating a check value, and not + looking for any check values for comparison at the end of the stream. This + is for use with other formats that use the deflate compressed data format + such as zip. Those formats provide their own check values. If a custom + format is developed using the raw deflate format for compressed data, it is + recommended that a check value such as an adler32 or a crc32 be applied to + the uncompressed data as is done in the zlib, gzip, and zip formats. For + most applications, the zlib format should be used as is. Note that comments + above on the use in deflateInit2() applies to the magnitude of windowBits. + + windowBits can also be greater than 15 for optional gzip decoding. Add + 32 to windowBits to enable zlib and gzip decoding with automatic header + detection, or add 16 to decode only the gzip format (the zlib format will + return a Z_DATA_ERROR). If a gzip stream is being decoded, strm->adler is a + crc32 instead of an adler32. + + inflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough + memory, Z_VERSION_ERROR if the zlib library version is incompatible with the + version assumed by the caller, or Z_STREAM_ERROR if the parameters are + invalid, such as a null pointer to the structure. msg is set to null if + there is no error message. inflateInit2 does not perform any decompression + apart from possibly reading the zlib header if present: actual decompression + will be done by inflate(). (So next_in and avail_in may be modified, but + next_out and avail_out are unused and unchanged.) The current implementation + of inflateInit2() does not process any header information -- that is + deferred until inflate() is called. +*/ + +ZEXTERN int ZEXPORT inflateSetDictionary OF((z_streamp strm, + const Bytef *dictionary, + uInt dictLength)); +/* + Initializes the decompression dictionary from the given uncompressed byte + sequence. This function must be called immediately after a call of inflate, + if that call returned Z_NEED_DICT. The dictionary chosen by the compressor + can be determined from the adler32 value returned by that call of inflate. + The compressor and decompressor must use exactly the same dictionary (see + deflateSetDictionary). For raw inflate, this function can be called + immediately after inflateInit2() or inflateReset() and before any call of + inflate() to set the dictionary. The application must insure that the + dictionary that was used for compression is provided. + + inflateSetDictionary returns Z_OK if success, Z_STREAM_ERROR if a + parameter is invalid (e.g. dictionary being Z_NULL) or the stream state is + inconsistent, Z_DATA_ERROR if the given dictionary doesn't match the + expected one (incorrect adler32 value). inflateSetDictionary does not + perform any decompression: this will be done by subsequent calls of + inflate(). +*/ + +ZEXTERN int ZEXPORT inflateSync OF((z_streamp strm)); +/* + Skips invalid compressed data until a full flush point (see above the + description of deflate with Z_FULL_FLUSH) can be found, or until all + available input is skipped. No output is provided. + + inflateSync returns Z_OK if a full flush point has been found, Z_BUF_ERROR + if no more input was provided, Z_DATA_ERROR if no flush point has been + found, or Z_STREAM_ERROR if the stream structure was inconsistent. In the + success case, the application may save the current current value of total_in + which indicates where valid compressed data was found. In the error case, + the application may repeatedly call inflateSync, providing more input each + time, until success or end of the input data. +*/ + +ZEXTERN int ZEXPORT inflateCopy OF((z_streamp dest, + z_streamp source)); +/* + Sets the destination stream as a complete copy of the source stream. + + This function can be useful when randomly accessing a large stream. The + first pass through the stream can periodically record the inflate state, + allowing restarting inflate at those points when randomly accessing the + stream. + + inflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not + enough memory, Z_STREAM_ERROR if the source stream state was inconsistent + (such as zalloc being Z_NULL). msg is left unchanged in both source and + destination. +*/ + +ZEXTERN int ZEXPORT inflateReset OF((z_streamp strm)); +/* + This function is equivalent to inflateEnd followed by inflateInit, + but does not free and reallocate all the internal decompression state. The + stream will keep attributes that may have been set by inflateInit2. + + inflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source + stream state was inconsistent (such as zalloc or state being Z_NULL). +*/ + +ZEXTERN int ZEXPORT inflateReset2 OF((z_streamp strm, + int windowBits)); +/* + This function is the same as inflateReset, but it also permits changing + the wrap and window size requests. The windowBits parameter is interpreted + the same as it is for inflateInit2. + + inflateReset2 returns Z_OK if success, or Z_STREAM_ERROR if the source + stream state was inconsistent (such as zalloc or state being Z_NULL), or if + the windowBits parameter is invalid. +*/ + +ZEXTERN int ZEXPORT inflatePrime OF((z_streamp strm, + int bits, + int value)); +/* + This function inserts bits in the inflate input stream. The intent is + that this function is used to start inflating at a bit position in the + middle of a byte. The provided bits will be used before any bytes are used + from next_in. This function should only be used with raw inflate, and + should be used before the first inflate() call after inflateInit2() or + inflateReset(). bits must be less than or equal to 16, and that many of the + least significant bits of value will be inserted in the input. + + If bits is negative, then the input stream bit buffer is emptied. Then + inflatePrime() can be called again to put bits in the buffer. This is used + to clear out bits leftover after feeding inflate a block description prior + to feeding inflate codes. + + inflatePrime returns Z_OK if success, or Z_STREAM_ERROR if the source + stream state was inconsistent. +*/ + +ZEXTERN long ZEXPORT inflateMark OF((z_streamp strm)); +/* + This function returns two values, one in the lower 16 bits of the return + value, and the other in the remaining upper bits, obtained by shifting the + return value down 16 bits. If the upper value is -1 and the lower value is + zero, then inflate() is currently decoding information outside of a block. + If the upper value is -1 and the lower value is non-zero, then inflate is in + the middle of a stored block, with the lower value equaling the number of + bytes from the input remaining to copy. If the upper value is not -1, then + it is the number of bits back from the current bit position in the input of + the code (literal or length/distance pair) currently being processed. In + that case the lower value is the number of bytes already emitted for that + code. + + A code is being processed if inflate is waiting for more input to complete + decoding of the code, or if it has completed decoding but is waiting for + more output space to write the literal or match data. + + inflateMark() is used to mark locations in the input data for random + access, which may be at bit positions, and to note those cases where the + output of a code may span boundaries of random access blocks. The current + location in the input stream can be determined from avail_in and data_type + as noted in the description for the Z_BLOCK flush parameter for inflate. + + inflateMark returns the value noted above or -1 << 16 if the provided + source stream state was inconsistent. +*/ + +ZEXTERN int ZEXPORT inflateGetHeader OF((z_streamp strm, + gz_headerp head)); +/* + inflateGetHeader() requests that gzip header information be stored in the + provided gz_header structure. inflateGetHeader() may be called after + inflateInit2() or inflateReset(), and before the first call of inflate(). + As inflate() processes the gzip stream, head->done is zero until the header + is completed, at which time head->done is set to one. If a zlib stream is + being decoded, then head->done is set to -1 to indicate that there will be + no gzip header information forthcoming. Note that Z_BLOCK or Z_TREES can be + used to force inflate() to return immediately after header processing is + complete and before any actual data is decompressed. + + The text, time, xflags, and os fields are filled in with the gzip header + contents. hcrc is set to true if there is a header CRC. (The header CRC + was valid if done is set to one.) If extra is not Z_NULL, then extra_max + contains the maximum number of bytes to write to extra. Once done is true, + extra_len contains the actual extra field length, and extra contains the + extra field, or that field truncated if extra_max is less than extra_len. + If name is not Z_NULL, then up to name_max characters are written there, + terminated with a zero unless the length is greater than name_max. If + comment is not Z_NULL, then up to comm_max characters are written there, + terminated with a zero unless the length is greater than comm_max. When any + of extra, name, or comment are not Z_NULL and the respective field is not + present in the header, then that field is set to Z_NULL to signal its + absence. This allows the use of deflateSetHeader() with the returned + structure to duplicate the header. However if those fields are set to + allocated memory, then the application will need to save those pointers + elsewhere so that they can be eventually freed. + + If inflateGetHeader is not used, then the header information is simply + discarded. The header is always checked for validity, including the header + CRC if present. inflateReset() will reset the process to discard the header + information. The application would need to call inflateGetHeader() again to + retrieve the header from the next gzip stream. + + inflateGetHeader returns Z_OK if success, or Z_STREAM_ERROR if the source + stream state was inconsistent. +*/ + +/* +ZEXTERN int ZEXPORT inflateBackInit OF((z_streamp strm, int windowBits, + unsigned char FAR *window)); + + Initialize the internal stream state for decompression using inflateBack() + calls. The fields zalloc, zfree and opaque in strm must be initialized + before the call. If zalloc and zfree are Z_NULL, then the default library- + derived memory allocation routines are used. windowBits is the base two + logarithm of the window size, in the range 8..15. window is a caller + supplied buffer of that size. Except for special applications where it is + assured that deflate was used with small window sizes, windowBits must be 15 + and a 32K byte window must be supplied to be able to decompress general + deflate streams. + + See inflateBack() for the usage of these routines. + + inflateBackInit will return Z_OK on success, Z_STREAM_ERROR if any of + the paramaters are invalid, Z_MEM_ERROR if the internal state could not be + allocated, or Z_VERSION_ERROR if the version of the library does not match + the version of the header file. +*/ + +typedef unsigned (*in_func) OF((void FAR *, unsigned char FAR * FAR *)); +typedef int (*out_func) OF((void FAR *, unsigned char FAR *, unsigned)); + +ZEXTERN int ZEXPORT inflateBack OF((z_streamp strm, + in_func in, void FAR *in_desc, + out_func out, void FAR *out_desc)); +/* + inflateBack() does a raw inflate with a single call using a call-back + interface for input and output. This is more efficient than inflate() for + file i/o applications in that it avoids copying between the output and the + sliding window by simply making the window itself the output buffer. This + function trusts the application to not change the output buffer passed by + the output function, at least until inflateBack() returns. + + inflateBackInit() must be called first to allocate the internal state + and to initialize the state with the user-provided window buffer. + inflateBack() may then be used multiple times to inflate a complete, raw + deflate stream with each call. inflateBackEnd() is then called to free the + allocated state. + + A raw deflate stream is one with no zlib or gzip header or trailer. + This routine would normally be used in a utility that reads zip or gzip + files and writes out uncompressed files. The utility would decode the + header and process the trailer on its own, hence this routine expects only + the raw deflate stream to decompress. This is different from the normal + behavior of inflate(), which expects either a zlib or gzip header and + trailer around the deflate stream. + + inflateBack() uses two subroutines supplied by the caller that are then + called by inflateBack() for input and output. inflateBack() calls those + routines until it reads a complete deflate stream and writes out all of the + uncompressed data, or until it encounters an error. The function's + parameters and return types are defined above in the in_func and out_func + typedefs. inflateBack() will call in(in_desc, &buf) which should return the + number of bytes of provided input, and a pointer to that input in buf. If + there is no input available, in() must return zero--buf is ignored in that + case--and inflateBack() will return a buffer error. inflateBack() will call + out(out_desc, buf, len) to write the uncompressed data buf[0..len-1]. out() + should return zero on success, or non-zero on failure. If out() returns + non-zero, inflateBack() will return with an error. Neither in() nor out() + are permitted to change the contents of the window provided to + inflateBackInit(), which is also the buffer that out() uses to write from. + The length written by out() will be at most the window size. Any non-zero + amount of input may be provided by in(). + + For convenience, inflateBack() can be provided input on the first call by + setting strm->next_in and strm->avail_in. If that input is exhausted, then + in() will be called. Therefore strm->next_in must be initialized before + calling inflateBack(). If strm->next_in is Z_NULL, then in() will be called + immediately for input. If strm->next_in is not Z_NULL, then strm->avail_in + must also be initialized, and then if strm->avail_in is not zero, input will + initially be taken from strm->next_in[0 .. strm->avail_in - 1]. + + The in_desc and out_desc parameters of inflateBack() is passed as the + first parameter of in() and out() respectively when they are called. These + descriptors can be optionally used to pass any information that the caller- + supplied in() and out() functions need to do their job. + + On return, inflateBack() will set strm->next_in and strm->avail_in to + pass back any unused input that was provided by the last in() call. The + return values of inflateBack() can be Z_STREAM_END on success, Z_BUF_ERROR + if in() or out() returned an error, Z_DATA_ERROR if there was a format error + in the deflate stream (in which case strm->msg is set to indicate the nature + of the error), or Z_STREAM_ERROR if the stream was not properly initialized. + In the case of Z_BUF_ERROR, an input or output error can be distinguished + using strm->next_in which will be Z_NULL only if in() returned an error. If + strm->next_in is not Z_NULL, then the Z_BUF_ERROR was due to out() returning + non-zero. (in() will always be called before out(), so strm->next_in is + assured to be defined if out() returns non-zero.) Note that inflateBack() + cannot return Z_OK. +*/ + +ZEXTERN int ZEXPORT inflateBackEnd OF((z_streamp strm)); +/* + All memory allocated by inflateBackInit() is freed. + + inflateBackEnd() returns Z_OK on success, or Z_STREAM_ERROR if the stream + state was inconsistent. +*/ + +ZEXTERN uLong ZEXPORT zlibCompileFlags OF((void)); +/* Return flags indicating compile-time options. + + Type sizes, two bits each, 00 = 16 bits, 01 = 32, 10 = 64, 11 = other: + 1.0: size of uInt + 3.2: size of uLong + 5.4: size of voidpf (pointer) + 7.6: size of z_off_t + + Compiler, assembler, and debug options: + 8: DEBUG + 9: ASMV or ASMINF -- use ASM code + 10: ZLIB_WINAPI -- exported functions use the WINAPI calling convention + 11: 0 (reserved) + + One-time table building (smaller code, but not thread-safe if true): + 12: BUILDFIXED -- build static block decoding tables when needed + 13: DYNAMIC_CRC_TABLE -- build CRC calculation tables when needed + 14,15: 0 (reserved) + + Library content (indicates missing functionality): + 16: NO_GZCOMPRESS -- gz* functions cannot compress (to avoid linking + deflate code when not needed) + 17: NO_GZIP -- deflate can't write gzip streams, and inflate can't detect + and decode gzip streams (to avoid linking crc code) + 18-19: 0 (reserved) + + Operation variations (changes in library functionality): + 20: PKZIP_BUG_WORKAROUND -- slightly more permissive inflate + 21: FASTEST -- deflate algorithm with only one, lowest compression level + 22,23: 0 (reserved) + + The sprintf variant used by gzprintf (zero is best): + 24: 0 = vs*, 1 = s* -- 1 means limited to 20 arguments after the format + 25: 0 = *nprintf, 1 = *printf -- 1 means gzprintf() not secure! + 26: 0 = returns value, 1 = void -- 1 means inferred string length returned + + Remainder: + 27-31: 0 (reserved) + */ + + + /* utility functions */ + +/* + The following utility functions are implemented on top of the basic + stream-oriented functions. To simplify the interface, some default options + are assumed (compression level and memory usage, standard memory allocation + functions). The source code of these utility functions can be modified if + you need special options. +*/ + +ZEXTERN int ZEXPORT compress OF((Bytef *dest, uLongf *destLen, + const Bytef *source, uLong sourceLen)); +/* + Compresses the source buffer into the destination buffer. sourceLen is + the byte length of the source buffer. Upon entry, destLen is the total size + of the destination buffer, which must be at least the value returned by + compressBound(sourceLen). Upon exit, destLen is the actual size of the + compressed buffer. + + compress returns Z_OK if success, Z_MEM_ERROR if there was not + enough memory, Z_BUF_ERROR if there was not enough room in the output + buffer. +*/ + +ZEXTERN int ZEXPORT compress2 OF((Bytef *dest, uLongf *destLen, + const Bytef *source, uLong sourceLen, + int level)); +/* + Compresses the source buffer into the destination buffer. The level + parameter has the same meaning as in deflateInit. sourceLen is the byte + length of the source buffer. Upon entry, destLen is the total size of the + destination buffer, which must be at least the value returned by + compressBound(sourceLen). Upon exit, destLen is the actual size of the + compressed buffer. + + compress2 returns Z_OK if success, Z_MEM_ERROR if there was not enough + memory, Z_BUF_ERROR if there was not enough room in the output buffer, + Z_STREAM_ERROR if the level parameter is invalid. +*/ + +ZEXTERN uLong ZEXPORT compressBound OF((uLong sourceLen)); +/* + compressBound() returns an upper bound on the compressed size after + compress() or compress2() on sourceLen bytes. It would be used before a + compress() or compress2() call to allocate the destination buffer. +*/ + +ZEXTERN int ZEXPORT uncompress OF((Bytef *dest, uLongf *destLen, + const Bytef *source, uLong sourceLen)); +/* + Decompresses the source buffer into the destination buffer. sourceLen is + the byte length of the source buffer. Upon entry, destLen is the total size + of the destination buffer, which must be large enough to hold the entire + uncompressed data. (The size of the uncompressed data must have been saved + previously by the compressor and transmitted to the decompressor by some + mechanism outside the scope of this compression library.) Upon exit, destLen + is the actual size of the uncompressed buffer. + + uncompress returns Z_OK if success, Z_MEM_ERROR if there was not + enough memory, Z_BUF_ERROR if there was not enough room in the output + buffer, or Z_DATA_ERROR if the input data was corrupted or incomplete. +*/ + + + /* gzip file access functions */ + +/* + This library supports reading and writing files in gzip (.gz) format with + an interface similar to that of stdio, using the functions that start with + "gz". The gzip format is different from the zlib format. gzip is a gzip + wrapper, documented in RFC 1952, wrapped around a deflate stream. +*/ + +typedef voidp gzFile; /* opaque gzip file descriptor */ + +/* +ZEXTERN gzFile ZEXPORT gzopen OF((const char *path, const char *mode)); + + Opens a gzip (.gz) file for reading or writing. The mode parameter is as + in fopen ("rb" or "wb") but can also include a compression level ("wb9") or + a strategy: 'f' for filtered data as in "wb6f", 'h' for Huffman-only + compression as in "wb1h", 'R' for run-length encoding as in "wb1R", or 'F' + for fixed code compression as in "wb9F". (See the description of + deflateInit2 for more information about the strategy parameter.) Also "a" + can be used instead of "w" to request that the gzip stream that will be + written be appended to the file. "+" will result in an error, since reading + and writing to the same gzip file is not supported. + + gzopen can be used to read a file which is not in gzip format; in this + case gzread will directly read from the file without decompression. + + gzopen returns NULL if the file could not be opened, if there was + insufficient memory to allocate the gzFile state, or if an invalid mode was + specified (an 'r', 'w', or 'a' was not provided, or '+' was provided). + errno can be checked to determine if the reason gzopen failed was that the + file could not be opened. +*/ + +ZEXTERN gzFile ZEXPORT gzdopen OF((int fd, const char *mode)); +/* + gzdopen associates a gzFile with the file descriptor fd. File descriptors + are obtained from calls like open, dup, creat, pipe or fileno (if the file + has been previously opened with fopen). The mode parameter is as in gzopen. + + The next call of gzclose on the returned gzFile will also close the file + descriptor fd, just like fclose(fdopen(fd, mode)) closes the file descriptor + fd. If you want to keep fd open, use fd = dup(fd_keep); gz = gzdopen(fd, + mode);. The duplicated descriptor should be saved to avoid a leak, since + gzdopen does not close fd if it fails. + + gzdopen returns NULL if there was insufficient memory to allocate the + gzFile state, if an invalid mode was specified (an 'r', 'w', or 'a' was not + provided, or '+' was provided), or if fd is -1. The file descriptor is not + used until the next gz* read, write, seek, or close operation, so gzdopen + will not detect if fd is invalid (unless fd is -1). +*/ + +ZEXTERN int ZEXPORT gzbuffer OF((gzFile file, unsigned size)); +/* + Set the internal buffer size used by this library's functions. The + default buffer size is 8192 bytes. This function must be called after + gzopen() or gzdopen(), and before any other calls that read or write the + file. The buffer memory allocation is always deferred to the first read or + write. Two buffers are allocated, either both of the specified size when + writing, or one of the specified size and the other twice that size when + reading. A larger buffer size of, for example, 64K or 128K bytes will + noticeably increase the speed of decompression (reading). + + The new buffer size also affects the maximum length for gzprintf(). + + gzbuffer() returns 0 on success, or -1 on failure, such as being called + too late. +*/ + +ZEXTERN int ZEXPORT gzsetparams OF((gzFile file, int level, int strategy)); +/* + Dynamically update the compression level or strategy. See the description + of deflateInit2 for the meaning of these parameters. + + gzsetparams returns Z_OK if success, or Z_STREAM_ERROR if the file was not + opened for writing. +*/ + +ZEXTERN int ZEXPORT gzread OF((gzFile file, voidp buf, unsigned len)); +/* + Reads the given number of uncompressed bytes from the compressed file. If + the input file was not in gzip format, gzread copies the given number of + bytes into the buffer. + + After reaching the end of a gzip stream in the input, gzread will continue + to read, looking for another gzip stream, or failing that, reading the rest + of the input file directly without decompression. The entire input file + will be read if gzread is called until it returns less than the requested + len. + + gzread returns the number of uncompressed bytes actually read, less than + len for end of file, or -1 for error. +*/ + +ZEXTERN int ZEXPORT gzwrite OF((gzFile file, + voidpc buf, unsigned len)); +/* + Writes the given number of uncompressed bytes into the compressed file. + gzwrite returns the number of uncompressed bytes written or 0 in case of + error. +*/ + +ZEXTERN int ZEXPORTVA gzprintf OF((gzFile file, const char *format, ...)); +/* + Converts, formats, and writes the arguments to the compressed file under + control of the format string, as in fprintf. gzprintf returns the number of + uncompressed bytes actually written, or 0 in case of error. The number of + uncompressed bytes written is limited to 8191, or one less than the buffer + size given to gzbuffer(). The caller should assure that this limit is not + exceeded. If it is exceeded, then gzprintf() will return an error (0) with + nothing written. In this case, there may also be a buffer overflow with + unpredictable consequences, which is possible only if zlib was compiled with + the insecure functions sprintf() or vsprintf() because the secure snprintf() + or vsnprintf() functions were not available. This can be determined using + zlibCompileFlags(). +*/ + +ZEXTERN int ZEXPORT gzputs OF((gzFile file, const char *s)); +/* + Writes the given null-terminated string to the compressed file, excluding + the terminating null character. + + gzputs returns the number of characters written, or -1 in case of error. +*/ + +ZEXTERN char * ZEXPORT gzgets OF((gzFile file, char *buf, int len)); +/* + Reads bytes from the compressed file until len-1 characters are read, or a + newline character is read and transferred to buf, or an end-of-file + condition is encountered. If any characters are read or if len == 1, the + string is terminated with a null character. If no characters are read due + to an end-of-file or len < 1, then the buffer is left untouched. + + gzgets returns buf which is a null-terminated string, or it returns NULL + for end-of-file or in case of error. If there was an error, the contents at + buf are indeterminate. +*/ + +ZEXTERN int ZEXPORT gzputc OF((gzFile file, int c)); +/* + Writes c, converted to an unsigned char, into the compressed file. gzputc + returns the value that was written, or -1 in case of error. +*/ + +ZEXTERN int ZEXPORT gzgetc OF((gzFile file)); +/* + Reads one byte from the compressed file. gzgetc returns this byte or -1 + in case of end of file or error. +*/ + +ZEXTERN int ZEXPORT gzungetc OF((int c, gzFile file)); +/* + Push one character back onto the stream to be read as the first character + on the next read. At least one character of push-back is allowed. + gzungetc() returns the character pushed, or -1 on failure. gzungetc() will + fail if c is -1, and may fail if a character has been pushed but not read + yet. If gzungetc is used immediately after gzopen or gzdopen, at least the + output buffer size of pushed characters is allowed. (See gzbuffer above.) + The pushed character will be discarded if the stream is repositioned with + gzseek() or gzrewind(). +*/ + +ZEXTERN int ZEXPORT gzflush OF((gzFile file, int flush)); +/* + Flushes all pending output into the compressed file. The parameter flush + is as in the deflate() function. The return value is the zlib error number + (see function gzerror below). gzflush is only permitted when writing. + + If the flush parameter is Z_FINISH, the remaining data is written and the + gzip stream is completed in the output. If gzwrite() is called again, a new + gzip stream will be started in the output. gzread() is able to read such + concatented gzip streams. + + gzflush should be called only when strictly necessary because it will + degrade compression if called too often. +*/ + +/* +ZEXTERN z_off_t ZEXPORT gzseek OF((gzFile file, + z_off_t offset, int whence)); + + Sets the starting position for the next gzread or gzwrite on the given + compressed file. The offset represents a number of bytes in the + uncompressed data stream. The whence parameter is defined as in lseek(2); + the value SEEK_END is not supported. + + If the file is opened for reading, this function is emulated but can be + extremely slow. If the file is opened for writing, only forward seeks are + supported; gzseek then compresses a sequence of zeroes up to the new + starting position. + + gzseek returns the resulting offset location as measured in bytes from + the beginning of the uncompressed stream, or -1 in case of error, in + particular if the file is opened for writing and the new starting position + would be before the current position. +*/ + +ZEXTERN int ZEXPORT gzrewind OF((gzFile file)); +/* + Rewinds the given file. This function is supported only for reading. + + gzrewind(file) is equivalent to (int)gzseek(file, 0L, SEEK_SET) +*/ + +/* +ZEXTERN z_off_t ZEXPORT gztell OF((gzFile file)); + + Returns the starting position for the next gzread or gzwrite on the given + compressed file. This position represents a number of bytes in the + uncompressed data stream, and is zero when starting, even if appending or + reading a gzip stream from the middle of a file using gzdopen(). + + gztell(file) is equivalent to gzseek(file, 0L, SEEK_CUR) +*/ + +/* +ZEXTERN z_off_t ZEXPORT gzoffset OF((gzFile file)); + + Returns the current offset in the file being read or written. This offset + includes the count of bytes that precede the gzip stream, for example when + appending or when using gzdopen() for reading. When reading, the offset + does not include as yet unused buffered input. This information can be used + for a progress indicator. On error, gzoffset() returns -1. +*/ + +ZEXTERN int ZEXPORT gzeof OF((gzFile file)); +/* + Returns true (1) if the end-of-file indicator has been set while reading, + false (0) otherwise. Note that the end-of-file indicator is set only if the + read tried to go past the end of the input, but came up short. Therefore, + just like feof(), gzeof() may return false even if there is no more data to + read, in the event that the last read request was for the exact number of + bytes remaining in the input file. This will happen if the input file size + is an exact multiple of the buffer size. + + If gzeof() returns true, then the read functions will return no more data, + unless the end-of-file indicator is reset by gzclearerr() and the input file + has grown since the previous end of file was detected. +*/ + +ZEXTERN int ZEXPORT gzdirect OF((gzFile file)); +/* + Returns true (1) if file is being copied directly while reading, or false + (0) if file is a gzip stream being decompressed. This state can change from + false to true while reading the input file if the end of a gzip stream is + reached, but is followed by data that is not another gzip stream. + + If the input file is empty, gzdirect() will return true, since the input + does not contain a gzip stream. + + If gzdirect() is used immediately after gzopen() or gzdopen() it will + cause buffers to be allocated to allow reading the file to determine if it + is a gzip file. Therefore if gzbuffer() is used, it should be called before + gzdirect(). +*/ + +ZEXTERN int ZEXPORT gzclose OF((gzFile file)); +/* + Flushes all pending output if necessary, closes the compressed file and + deallocates the (de)compression state. Note that once file is closed, you + cannot call gzerror with file, since its structures have been deallocated. + gzclose must not be called more than once on the same file, just as free + must not be called more than once on the same allocation. + + gzclose will return Z_STREAM_ERROR if file is not valid, Z_ERRNO on a + file operation error, or Z_OK on success. +*/ + +ZEXTERN int ZEXPORT gzclose_r OF((gzFile file)); +ZEXTERN int ZEXPORT gzclose_w OF((gzFile file)); +/* + Same as gzclose(), but gzclose_r() is only for use when reading, and + gzclose_w() is only for use when writing or appending. The advantage to + using these instead of gzclose() is that they avoid linking in zlib + compression or decompression code that is not used when only reading or only + writing respectively. If gzclose() is used, then both compression and + decompression code will be included the application when linking to a static + zlib library. +*/ + +ZEXTERN const char * ZEXPORT gzerror OF((gzFile file, int *errnum)); +/* + Returns the error message for the last error which occurred on the given + compressed file. errnum is set to zlib error number. If an error occurred + in the file system and not in the compression library, errnum is set to + Z_ERRNO and the application may consult errno to get the exact error code. + + The application must not modify the returned string. Future calls to + this function may invalidate the previously returned string. If file is + closed, then the string previously returned by gzerror will no longer be + available. + + gzerror() should be used to distinguish errors from end-of-file for those + functions above that do not distinguish those cases in their return values. +*/ + +ZEXTERN void ZEXPORT gzclearerr OF((gzFile file)); +/* + Clears the error and end-of-file flags for file. This is analogous to the + clearerr() function in stdio. This is useful for continuing to read a gzip + file that is being written concurrently. +*/ + + + /* checksum functions */ + +/* + These functions are not related to compression but are exported + anyway because they might be useful in applications using the compression + library. +*/ + +ZEXTERN uLong ZEXPORT adler32 OF((uLong adler, const Bytef *buf, uInt len)); +/* + Update a running Adler-32 checksum with the bytes buf[0..len-1] and + return the updated checksum. If buf is Z_NULL, this function returns the + required initial value for the checksum. + + An Adler-32 checksum is almost as reliable as a CRC32 but can be computed + much faster. + + Usage example: + + uLong adler = adler32(0L, Z_NULL, 0); + + while (read_buffer(buffer, length) != EOF) { + adler = adler32(adler, buffer, length); + } + if (adler != original_adler) error(); +*/ + +/* +ZEXTERN uLong ZEXPORT adler32_combine OF((uLong adler1, uLong adler2, + z_off_t len2)); + + Combine two Adler-32 checksums into one. For two sequences of bytes, seq1 + and seq2 with lengths len1 and len2, Adler-32 checksums were calculated for + each, adler1 and adler2. adler32_combine() returns the Adler-32 checksum of + seq1 and seq2 concatenated, requiring only adler1, adler2, and len2. +*/ + +ZEXTERN uLong ZEXPORT crc32 OF((uLong crc, const Bytef *buf, uInt len)); +/* + Update a running CRC-32 with the bytes buf[0..len-1] and return the + updated CRC-32. If buf is Z_NULL, this function returns the required + initial value for the for the crc. Pre- and post-conditioning (one's + complement) is performed within this function so it shouldn't be done by the + application. + + Usage example: + + uLong crc = crc32(0L, Z_NULL, 0); + + while (read_buffer(buffer, length) != EOF) { + crc = crc32(crc, buffer, length); + } + if (crc != original_crc) error(); +*/ + +/* +ZEXTERN uLong ZEXPORT crc32_combine OF((uLong crc1, uLong crc2, z_off_t len2)); + + Combine two CRC-32 check values into one. For two sequences of bytes, + seq1 and seq2 with lengths len1 and len2, CRC-32 check values were + calculated for each, crc1 and crc2. crc32_combine() returns the CRC-32 + check value of seq1 and seq2 concatenated, requiring only crc1, crc2, and + len2. +*/ + + + /* various hacks, don't look :) */ + +/* deflateInit and inflateInit are macros to allow checking the zlib version + * and the compiler's view of z_stream: + */ +ZEXTERN int ZEXPORT deflateInit_ OF((z_streamp strm, int level, + const char *version, int stream_size)); +ZEXTERN int ZEXPORT inflateInit_ OF((z_streamp strm, + const char *version, int stream_size)); +ZEXTERN int ZEXPORT deflateInit2_ OF((z_streamp strm, int level, int method, + int windowBits, int memLevel, + int strategy, const char *version, + int stream_size)); +ZEXTERN int ZEXPORT inflateInit2_ OF((z_streamp strm, int windowBits, + const char *version, int stream_size)); +ZEXTERN int ZEXPORT inflateBackInit_ OF((z_streamp strm, int windowBits, + unsigned char FAR *window, + const char *version, + int stream_size)); +#define deflateInit(strm, level) \ + deflateInit_((strm), (level), ZLIB_VERSION, sizeof(z_stream)) +#define inflateInit(strm) \ + inflateInit_((strm), ZLIB_VERSION, sizeof(z_stream)) +#define deflateInit2(strm, level, method, windowBits, memLevel, strategy) \ + deflateInit2_((strm),(level),(method),(windowBits),(memLevel),\ + (strategy), ZLIB_VERSION, sizeof(z_stream)) +#define inflateInit2(strm, windowBits) \ + inflateInit2_((strm), (windowBits), ZLIB_VERSION, sizeof(z_stream)) +#define inflateBackInit(strm, windowBits, window) \ + inflateBackInit_((strm), (windowBits), (window), \ + ZLIB_VERSION, sizeof(z_stream)) + +/* provide 64-bit offset functions if _LARGEFILE64_SOURCE defined, and/or + * change the regular functions to 64 bits if _FILE_OFFSET_BITS is 64 (if + * both are true, the application gets the *64 functions, and the regular + * functions are changed to 64 bits) -- in case these are set on systems + * without large file support, _LFS64_LARGEFILE must also be true + */ +#if defined(_LARGEFILE64_SOURCE) && _LFS64_LARGEFILE-0 + ZEXTERN gzFile ZEXPORT gzopen64 OF((const char *, const char *)); + ZEXTERN z_off64_t ZEXPORT gzseek64 OF((gzFile, z_off64_t, int)); + ZEXTERN z_off64_t ZEXPORT gztell64 OF((gzFile)); + ZEXTERN z_off64_t ZEXPORT gzoffset64 OF((gzFile)); + ZEXTERN uLong ZEXPORT adler32_combine64 OF((uLong, uLong, z_off64_t)); + ZEXTERN uLong ZEXPORT crc32_combine64 OF((uLong, uLong, z_off64_t)); +#endif + +#if !defined(ZLIB_INTERNAL) && _FILE_OFFSET_BITS-0 == 64 && _LFS64_LARGEFILE-0 +# define gzopen gzopen64 +# define gzseek gzseek64 +# define gztell gztell64 +# define gzoffset gzoffset64 +# define adler32_combine adler32_combine64 +# define crc32_combine crc32_combine64 +# ifdef _LARGEFILE64_SOURCE + ZEXTERN gzFile ZEXPORT gzopen64 OF((const char *, const char *)); + ZEXTERN z_off_t ZEXPORT gzseek64 OF((gzFile, z_off_t, int)); + ZEXTERN z_off_t ZEXPORT gztell64 OF((gzFile)); + ZEXTERN z_off_t ZEXPORT gzoffset64 OF((gzFile)); + ZEXTERN uLong ZEXPORT adler32_combine64 OF((uLong, uLong, z_off_t)); + ZEXTERN uLong ZEXPORT crc32_combine64 OF((uLong, uLong, z_off_t)); +# endif +#else + ZEXTERN gzFile ZEXPORT gzopen OF((const char *, const char *)); + ZEXTERN z_off_t ZEXPORT gzseek OF((gzFile, z_off_t, int)); + ZEXTERN z_off_t ZEXPORT gztell OF((gzFile)); + ZEXTERN z_off_t ZEXPORT gzoffset OF((gzFile)); + ZEXTERN uLong ZEXPORT adler32_combine OF((uLong, uLong, z_off_t)); + ZEXTERN uLong ZEXPORT crc32_combine OF((uLong, uLong, z_off_t)); +#endif + +/* hack for buggy compilers */ +#if !defined(ZUTIL_H) && !defined(NO_DUMMY_DECL) + struct internal_state {int dummy;}; +#endif + +/* undocumented functions */ +ZEXTERN const char * ZEXPORT zError OF((int)); +ZEXTERN int ZEXPORT inflateSyncPoint OF((z_streamp)); +ZEXTERN const uLongf * ZEXPORT get_crc_table OF((void)); +ZEXTERN int ZEXPORT inflateUndermine OF((z_streamp, int)); + +#ifdef __cplusplus +} +#endif + +#endif /* ZLIB_H */ diff --git a/3rdParty/JCL/source/common/zlibh.pas b/3rdParty/JCL/source/common/zlibh.pas new file mode 100644 index 00000000..2032b98d --- /dev/null +++ b/3rdParty/JCL/source/common/zlibh.pas @@ -0,0 +1,2509 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ zlib.h -- interface of the 'zlib' general purpose compression library } +{ version 1.2.1, November 17th, 2003 } +{ } +{ Copyright (C) 1995-2003 Jean-loup Gailly and Mark Adler } +{ } +{ This software is provided 'as-is', without any express or implied warranty. In no event will } +{ the authors be held liable for any damages arising from the use of this software. } +{ } +{ Permission is granted to anyone to use this software for any purpose, including commercial } +{ applications, and to alter it and redistribute it freely, subject to the following restrictions: } +{ } +{ 1. The origin of this software must not be misrepresented; you must not claim that you wrote the } +{ original software. If you use this software in a product, an acknowledgment in the product } +{ documentation would be appreciated but is not required. } +{ 2. Altered source versions must be plainly marked as such, and must not be misrepresented as } +{ being the original software. } +{ 3. This notice may not be removed or altered from any source distribution. } +{ } +{ Jean-loup Gailly Mark Adler } +{ jloup@gzip.org madler@alumni.caltech.edu } +{ } +{ The data format used by the zlib library is described by RFCs (Request for } +{ Comments) 1950 to 1952 in the files http://www.ietf.org/rfc/rfc1950.txt } +{ (zlib format), rfc1951.txt (deflate format) and rfc1952.txt (gzip format). } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit zlibh; + +{$I jcl.inc} + +{$IFDEF ZLIB_LINKDLL} +{$HPPEMIT '#define ZLIB_DLL'} +{$ELSE ~ZLIB_LINKDLL} +{$HPPEMIT '#define ZEXPORT __fastcall'} +{$ENDIF ~ZLIB_LINKDLL} + +{$IFDEF ZEXPORT_CDECL} +{$HPPEMIT '#define ZEXPORT __cdecl'} +{$ENDIF ZEXPORT_CDECL} + +{$HPPEMIT '#define ZEXPORTVA __cdecl'} + +{$HPPEMIT '#define __MACTYPES__'} +{$IFDEF COMPILER10_UP} +{$IFDEF RTL310_UP} +{$HPPEMIT '#include '} +{$ELSE ~RTL310_UP} +{$HPPEMIT '#include '} +{$ENDIF ~RTL310_UP} +{$ELSE ~COMPILER10_UP} +{$HPPEMIT '#include '} +{$ENDIF ~COMPILER10_UP} + +interface + +uses + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclBase, + JclSysUtils; + +//DOM-IGNORE-BEGIN + +{$IFNDEF ZLIB_RTL} + +{$IFNDEF FPC} +type + {$IFDEF UNIX} + uLong = LongWord; + {$EXTERNALSYM uLong} + uInt = Cardinal; + {$EXTERNALSYM uInt} + {$ENDIF UNIX} + uShort = Word; + {$EXTERNALSYM uShort} + size_t = Longint; + {$EXTERNALSYM size_t} +{$ENDIF ~FPC} + +//----------------------------------------------------------------------------- +// START of the contents of the converted ZCONF.H +//----------------------------------------------------------------------------- +{* zconf.h -- configuration of the zlib compression library + * Copyright (C) 1995-2003 Jean-loup Gailly. + * For conditions of distribution and use, see copyright notice in zlib.h + + * If you *really* need a unique prefix for all types and library functions, + * compile with -DZ_PREFIX. The "standard" zlib should be compiled without it. + *} + +type + {$EXTERNALSYM Bytef} + Bytef = Byte; + {$EXTERNALSYM PBytef} + PBytef = ^Bytef; + {$EXTERNALSYM UnsignedInt} + UnsignedInt = LongWord; + {$EXTERNALSYM uLongf} + uLongf = ULONG; + {$EXTERNALSYM PuLongf} + PuLongf = ^uLongf; + +{* Maximum value for windowBits in deflateInit2 and inflateInit2. + * WARNING: reducing MAX_WBITS makes minigzip unable to extract .gz files + * created by gzip. (Files created by minigzip can still be extracted by + * gzip.) + *} + +const + {$EXTERNALSYM MAX_WBITS} + MAX_WBITS = 15; // 32K LZ77 window + +{* The memory requirements for deflate are (in bytes): + (1 << (windowBits+2)) + (1 << (memLevel+9)) + that is: 128K for windowBits=15 + 128K for memLevel = 8 (default values) + plus a few kilobytes for small objects. For example, if you want to reduce + the default memory requirements from 256K to 128K, compile with + make CFLAGS="-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7" + Of course this will generally degrade compression (there's no free lunch). + + The memory requirements for inflate are (in bytes) 1 << windowBits + that is, 32K for windowBits=15 (default value) plus a few kilobytes + for small objects. +*} + + {* Type declarations *} + +{* The following definitions for FAR are needed only for MSDOS mixed + * model programming (small or medium model with some far allocations). + * This was tested only with MSC; for other MSDOS compilers you may have + * to define NO_MEMCPY in zutil.h. If you don't need the mixed model, + * just define FAR to be empty. + *} + +{* If building or using zlib with the WINAPI/WINAPIV calling convention, + * define ZLIB_WINAPI. + * Caution: the standard ZLIB1.DLL is NOT compiled using ZLIB_WINAPI. + *} + +{ $HPPEMIT '#define ZEXPORT __stdcall'} // OS: CHECKTHIS +{ $HPPEMIT '#define ZEXPORTVA __cdecl'} // OS: CHECKTHIS + +// type +// uInt = UINT; --> already defined in Windows.pas /* 16 bits or more +// uLong = ULONG; --> already defined in Windows.pas /* 32 bits or more + +type + {$EXTERNALSYM voidpc} + voidpc = Pointer; + {$EXTERNALSYM voidpf} + voidpf = Pointer; + {$EXTERNALSYM voidp} + voidp = Pointer; + {$EXTERNALSYM z_off_t} + z_off_t = LongInt; + +const + {$EXTERNALSYM SEEK_SET} + SEEK_SET = 0; // Seek from beginning of file. + {$EXTERNALSYM SEEK_CUR} + SEEK_CUR = 1; // Seek from current position. + {$EXTERNALSYM SEEK_END} + SEEK_END = 2; // Set file pointer to EOF plus "offset" + +//----------------------------------------------------------------------------- +// END of the contents of the converted ZCONF.H +//----------------------------------------------------------------------------- + +const + {$EXTERNALSYM ZLIB_VERSION} + ZLIB_VERSION = '1.2.7'; + {$EXTERNALSYM ZLIB_VERNUM} + ZLIB_VERNUM = $1250; + {$EXTERNALSYM ZLIB_VER_MAJOR} + ZLIB_VER_MAJOR = 1; + {$EXTERNALSYM ZLIB_VER_MINOR} + ZLIB_VER_MINOR = 2; + {$EXTERNALSYM ZLIB_VER_REVISION} + ZLIB_VER_REVISION = 7; + {$EXTERNALSYM ZLIB_VER_SUBREVISION} + ZLIB_VER_SUBREVISION = 0; + +{* + The 'zlib' compression library provides in-memory compression and + decompression functions, including integrity checks of the uncompressed + data. This version of the library supports only one compression method + (deflation) but other algorithms will be added later and will have the same + stream interface. + + Compression can be done in a single step if the buffers are large + enough (for example if an input file is mmap'ed), or can be done by + repeated calls of the compression function. In the latter case, the + application must provide more input and/or consume the output + (providing more output space) before each call. + + The compressed data format used by the in-memory functions is the zlib + format, which is a zlib wrapper documented in RFC 1950, wrapped around a + deflate stream, which is itself documented in RFC 1951. + + The library also supports reading and writing files in gzip (.gz) format + with an interface similar to that of stdio using the functions that start + with "gz". The gzip format is different from the zlib format. gzip is a + gzip wrapper, documented in RFC 1952, wrapped around a deflate stream. + + The zlib format was designed to be compact and fast for use in memory + and on communications channels. The gzip format was designed for single- + file compression on file systems, has a larger header than zlib to maintain + directory information, and uses a different, slower check method than zlib. + + This library does not provide any functions to write gzip files in memory. + However such functions could be easily written using zlib's deflate function, + the documentation in the gzip RFC, and the examples in gzio.c. + + The library does not install any signal handler. The decoder checks + the consistency of the compressed data, so the library should never + crash even in case of corrupted input. +*} + +type + {$EXTERNALSYM alloc_func} + alloc_func = function(opaque:voidpf; items:uInt; size:uInt):voidpf; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + {$EXTERNALSYM free_func} + free_func = procedure(opaque:voidpf; address:voidpf); + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + {$EXTERNALSYM TFNAllocFunc} + TFNAllocFunc = alloc_func; + {$EXTERNALSYM TFNFreeFunc} + TFNFreeFunc = free_func; + +type + {$EXTERNALSYM internal_state} + internal_state = packed record end; + {$EXTERNALSYM TInternalState} + TInternalState = internal_state; // backward compatibility + {$EXTERNALSYM PInternalState} + PInternalState = ^internal_state; // backward compatibility + +type + {$EXTERNALSYM z_stream_s} + z_stream_s = record + next_in: PBytef; // next input byte + avail_in: uInt; // number of bytes available at next_in + total_in: uLong; // total nb of input bytes read so far + + next_out: PBytef; // next output byte should be put there + avail_out:uInt; // remaining free space at next_out + total_out:uLong; // total nb of bytes output so far + + msg: PAnsiChar; // last error message, NULL if no error + state:PInternalState; // not visible by applications + + zalloc: TFNAllocFunc;// used to allocate the internal state + zfree: TFNFreeFunc; // used to free the internal state + opaque: voidpf; // private data object passed to zalloc and zfree + + data_type: Integer; // best guess about the data type: ascii or binary + adler: uLong; // adler32 value of the uncompressed data + reserved: uLong; // reserved for future use + end; + {$IFDEF COMPILER10_UP} + (*$HPPEMIT 'namespace Zlibh {'*) + (*$HPPEMIT 'typedef Zlib::TZStreamRec z_stream_s;'*) + (*$HPPEMIT '}'*) + {$ENDIF COMPILER10_UP} + + {$EXTERNALSYM z_stream} + z_stream = z_stream_s; + {$EXTERNALSYM z_streamp} + z_streamp = ^z_stream_s; + + {$EXTERNALSYM TZStreamRec} + TZStreamRec = z_stream_s; + {$EXTERNALSYM PZStreamRec} + PZStreamRec = ^z_stream_s; + +{* + The application must update next_in and avail_in when avail_in has + dropped to zero. It must update next_out and avail_out when avail_out + has dropped to zero. The application must initialize zalloc, zfree and + opaque before calling the init function. All other fields are set by the + compression library and must not be updated by the application. + + The opaque value provided by the application will be passed as the first + parameter for calls of zalloc and zfree. This can be useful for custom + memory management. The compression library attaches no meaning to the + opaque value. + + zalloc must return Z_NULL if there is not enough memory for the object. + If zlib is used in a multi-threaded application, zalloc and zfree must be + thread safe. + + On 16-bit systems, the functions zalloc and zfree must be able to allocate + exactly 65536 bytes, but will not be required to allocate more than this + if the symbol MAXSEG_64K is defined (see zconf.h). WARNING: On MSDOS, + pointers returned by zalloc for objects of exactly 65536 bytes *must* + have their offset normalized to zero. The default allocation function + provided by this library ensures this (see zutil.c). To reduce memory + requirements and avoid any allocation of 64K objects, at the expense of + compression ratio, compile the library with -DMAX_WBITS=14 (see zconf.h). + + The fields total_in and total_out can be used for statistics or + progress reports. After compression, total_in holds the total size of + the uncompressed data and may be saved for use in the decompressor + (particularly if the decompressor wants to decompress everything in + a single step). +*} + + {* constants *} + +const + {$EXTERNALSYM Z_NO_FLUSH} + Z_NO_FLUSH = 0; + {$EXTERNALSYM Z_PARTIAL_FLUSH} + Z_PARTIAL_FLUSH = 1; // will be removed, use Z_SYNC_FLUSH instead + {$EXTERNALSYM Z_SYNC_FLUSH} + Z_SYNC_FLUSH = 2; + {$EXTERNALSYM Z_FULL_FLUSH} + Z_FULL_FLUSH = 3; + {$EXTERNALSYM Z_FINISH} + Z_FINISH = 4; + {$EXTERNALSYM Z_BLOCK} + Z_BLOCK = 5; + {$EXTERNALSYM Z_TREES} + Z_TREES = 6; + +{* Allowed flush values; see deflate() and inflate() below for details *} + + {$EXTERNALSYM Z_OK} + Z_OK = 0; + {$EXTERNALSYM Z_STREAM_END} + Z_STREAM_END = 1; + {$EXTERNALSYM Z_NEED_DICT} + Z_NEED_DICT = 2; + {$EXTERNALSYM Z_ERRNO} + Z_ERRNO = -1; + {$EXTERNALSYM Z_STREAM_ERROR} + Z_STREAM_ERROR = -2; + {$EXTERNALSYM Z_DATA_ERROR} + Z_DATA_ERROR = -3; + {$EXTERNALSYM Z_MEM_ERROR} + Z_MEM_ERROR = -4; + {$EXTERNALSYM Z_BUF_ERROR} + Z_BUF_ERROR = -5; + {$EXTERNALSYM Z_VERSION_ERROR} + Z_VERSION_ERROR = -6; +{* Return codes for the compression/decompression functions. Negative + * values are errors, positive values are used for special but normal events. + *} + + {$EXTERNALSYM Z_NO_COMPRESSION} + Z_NO_COMPRESSION = 0; + {$EXTERNALSYM Z_BEST_SPEED} + Z_BEST_SPEED = 1; + {$EXTERNALSYM Z_BEST_COMPRESSION} + Z_BEST_COMPRESSION = 9; + {$EXTERNALSYM Z_DEFAULT_COMPRESSION} + Z_DEFAULT_COMPRESSION = -1; + +{* compression levels *} + + {$EXTERNALSYM Z_FILTERED} + Z_FILTERED = 1; + {$EXTERNALSYM Z_HUFFMAN_ONLY} + Z_HUFFMAN_ONLY = 2; + {$EXTERNALSYM Z_RLE} + Z_RLE = 3; + {$EXTERNALSYM Z_FIXED} + Z_FIXED = 4; + {$EXTERNALSYM Z_DEFAULT_STRATEGY} + Z_DEFAULT_STRATEGY = 0; +{* compression strategy; see deflateInit2() below for details *} + + {$EXTERNALSYM Z_BINARY} + Z_BINARY = 0; + {$EXTERNALSYM Z_TEXT} + Z_TEXT = 1; + {$EXTERNALSYM Z_ASCII} + Z_ASCII = Z_TEXT; + {$EXTERNALSYM Z_UNKNOWN} + Z_UNKNOWN = 2; +{* Possible values of the data_type field (though see inflate()) *} + + {$EXTERNALSYM Z_DEFLATED} + Z_DEFLATED = 8; +{* The deflate compression method (the only one supported in this version) *} + + {$EXTERNALSYM Z_NULL} + Z_NULL = 0; {* for initializing zalloc, zfree, opaque *} + + {* basic functions *} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TzlibVersion} + TzlibVersion = function (): PAnsiChar; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM zlibVersion} + zlibVersion: TzlibVersion = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM zlibVersion} +function zlibVersion(): PAnsiChar; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{* The application can compare zlibVersion and ZLIB_VERSION for consistency. + If the first character differs, the library code actually used is + not compatible with the zlib.h header file used by the application. + This check is automatically made by deflateInit and inflateInit. + *} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TdeflateInit_} + TdeflateInit_ = function (var strm:z_stream; + level: Integer; + {const} version: PAnsiChar; + stream_size: Integer): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM deflateInit_} + deflateInit_: TdeflateInit_ = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM deflateInit_} +function deflateInit_(var strm:z_stream; + level: Integer; + {const} version: PAnsiChar; + stream_size: Integer): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM deflateInit} +function deflateInit(var strm: TZStreamRec; level: Integer): Integer; // macro +{* + Initializes the internal stream state for compression. The fields + zalloc, zfree and opaque must be initialized before by the caller. + If zalloc and zfree are set to Z_NULL, deflateInit updates them to + use default allocation functions. + + The compression level must be Z_DEFAULT_COMPRESSION, or between 0 and 9: + 1 gives best speed, 9 gives best compression, 0 gives no compression at + all (the input data is simply copied a block at a time). + Z_DEFAULT_COMPRESSION requests a default compromise between speed and + compression (currently equivalent to level 6). + + deflateInit returns Z_OK if success, Z_MEM_ERROR if there was not + enough memory, Z_STREAM_ERROR if level is not a valid compression level, + Z_VERSION_ERROR if the zlib library version (zlib_version) is incompatible + with the version assumed by the caller (ZLIB_VERSION). + msg is set to null if there is no error message. deflateInit does not + perform any compression: this will be done by deflate(). +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM Tdeflate} + Tdeflate = function (var strm: TZStreamRec; flush: Integer): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM deflate} + deflate: Tdeflate = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM deflate} +function deflate(var strm: TZStreamRec; flush: Integer): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{* + deflate compresses as much data as possible, and stops when the input + buffer becomes empty or the output buffer becomes full. It may introduce some + output latency (reading input without producing any output) except when + forced to flush. + + The detailed semantics are as follows. deflate performs one or both of the + following actions: + + - Compress more input starting at next_in and update next_in and avail_in + accordingly. If not all input can be processed (because there is not + enough room in the output buffer), next_in and avail_in are updated and + processing will resume at this point for the next call of deflate(). + + - Provide more output starting at next_out and update next_out and avail_out + accordingly. This action is forced if the parameter flush is non zero. + Forcing flush frequently degrades the compression ratio, so this parameter + should be set only when necessary (in interactive applications). + Some output may be provided even if flush is not set. + + Before the call of deflate(), the application should ensure that at least + one of the actions is possible, by providing more input and/or consuming + more output, and updating avail_in or avail_out accordingly; avail_out + should never be zero before the call. The application can consume the + compressed output when it wants, for example when the output buffer is full + (avail_out == 0), or after each call of deflate(). If deflate returns Z_OK + and with zero avail_out, it must be called again after making room in the + output buffer because there might be more output pending. + + If the parameter flush is set to Z_SYNC_FLUSH, all pending output is + flushed to the output buffer and the output is aligned on a byte boundary, so + that the decompressor can get all input data available so far. (In particular + avail_in is zero after the call if enough output space has been provided + before the call.) Flushing may degrade compression for some compression + algorithms and so it should be used only when necessary. + + If flush is set to Z_FULL_FLUSH, all output is flushed as with + Z_SYNC_FLUSH, and the compression state is reset so that decompression can + restart from this point if previous compressed data has been damaged or if + random access is desired. Using Z_FULL_FLUSH too often can seriously degrade + the compression. + + If deflate returns with avail_out == 0, this function must be called again + with the same value of the flush parameter and more output space (updated + avail_out), until the flush is complete (deflate returns with non-zero + avail_out). In the case of a Z_FULL_FLUSH or Z_SYNC_FLUSH, make sure that + avail_out is greater than six to avoid repeated flush markers due to + avail_out == 0 on return. + + If the parameter flush is set to Z_FINISH, pending input is processed, + pending output is flushed and deflate returns with Z_STREAM_END if there + was enough output space; if deflate returns with Z_OK, this function must be + called again with Z_FINISH and more output space (updated avail_out) but no + more input data, until it returns with Z_STREAM_END or an error. After + deflate has returned Z_STREAM_END, the only possible operations on the + stream are deflateReset or deflateEnd. + + Z_FINISH can be used immediately after deflateInit if all the compression + is to be done in a single step. In this case, avail_out must be at least + the value returned by deflateBound (see below). If deflate does not return + Z_STREAM_END, then it must be called again as described above. + + deflate() sets strm->adler to the adler32 checksum of all input read + so far (that is, total_in bytes). + + deflate() may update data_type if it can make a good guess about + the input data type (Z_ASCII or Z_BINARY). In doubt, the data is considered + binary. This field is only for information purposes and does not affect + the compression algorithm in any manner. + + deflate() returns Z_OK if some progress has been made (more input + processed or more output produced), Z_STREAM_END if all input has been + consumed and all output has been produced (only when flush is set to + Z_FINISH), Z_STREAM_ERROR if the stream state was inconsistent (for example + if next_in or next_out was NULL), Z_BUF_ERROR if no progress is possible + (for example avail_in or avail_out was zero). Note that Z_BUF_ERROR is not + fatal, and deflate() can be called again with more input and more output + space to continue compressing. +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TdeflateEnd} + TdeflateEnd = function (var strm: TZStreamRec): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM deflateEnd} + deflateEnd: TdeflateEnd = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM deflateEnd} +function deflateEnd(var strm: TZStreamRec): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{* + All dynamically allocated data structures for this stream are freed. + This function discards any unprocessed input and does not flush any + pending output. + + deflateEnd returns Z_OK if success, Z_STREAM_ERROR if the + stream state was inconsistent, Z_DATA_ERROR if the stream was freed + prematurely (some input or output was discarded). In the error case, + msg may be set but then points to a static string (which must not be + deallocated). +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TinflateInit_} + TinflateInit_ = function (var strm:z_stream; + {const} version: PAnsiChar; + stream_size: Integer): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM inflateInit_} + inflateInit_: TinflateInit_ = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM inflateInit_} +function inflateInit_(var strm:z_stream; + {const} version: PAnsiChar; + stream_size: Integer): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM inflateInit} +function inflateInit(var strm: TZStreamRec): Integer; // macro +{* + + Initializes the internal stream state for decompression. The fields + next_in, avail_in, zalloc, zfree and opaque must be initialized before by + the caller. If next_in is not Z_NULL and avail_in is large enough (the exact + value depends on the compression method), inflateInit determines the + compression method from the zlib header and allocates all data structures + accordingly; otherwise the allocation will be deferred to the first call of + inflate. If zalloc and zfree are set to Z_NULL, inflateInit updates them to + use default allocation functions. + + inflateInit returns Z_OK if success, Z_MEM_ERROR if there was not enough + memory, Z_VERSION_ERROR if the zlib library version is incompatible with the + version assumed by the caller. msg is set to null if there is no error + message. inflateInit does not perform any decompression apart from reading + the zlib header if present: this will be done by inflate(). (So next_in and + avail_in may be modified, but next_out and avail_out are unchanged.) +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM Tinflate} + Tinflate = function (var strm: TZStreamRec; flush: Integer): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM inflate} + inflate: Tinflate = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM inflate} +function inflate(var strm: TZStreamRec; flush: Integer): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{* + inflate decompresses as much data as possible, and stops when the input + buffer becomes empty or the output buffer becomes full. It may introduce + some output latency (reading input without producing any output) except when + forced to flush. + + The detailed semantics are as follows. inflate performs one or both of the + following actions: + + - Decompress more input starting at next_in and update next_in and avail_in + accordingly. If not all input can be processed (because there is not + enough room in the output buffer), next_in is updated and processing + will resume at this point for the next call of inflate(). + + - Provide more output starting at next_out and update next_out and avail_out + accordingly. inflate() provides as much output as possible, until there + is no more input data or no more space in the output buffer (see below + about the flush parameter). + + Before the call of inflate(), the application should ensure that at least + one of the actions is possible, by providing more input and/or consuming + more output, and updating the next_* and avail_* values accordingly. + The application can consume the uncompressed output when it wants, for + example when the output buffer is full (avail_out == 0), or after each + call of inflate(). If inflate returns Z_OK and with zero avail_out, it + must be called again after making room in the output buffer because there + might be more output pending. + + The flush parameter of inflate() can be Z_NO_FLUSH, Z_SYNC_FLUSH, + Z_FINISH, or Z_BLOCK. Z_SYNC_FLUSH requests that inflate() flush as much + output as possible to the output buffer. Z_BLOCK requests that inflate() stop + if and when it get to the next deflate block boundary. When decoding the zlib + or gzip format, this will cause inflate() to return immediately after the + header and before the first block. When doing a raw inflate, inflate() will + go ahead and process the first block, and will return when it gets to the end + of that block, or when it runs out of data. + + The Z_BLOCK option assists in appending to or combining deflate streams. + Also to assist in this, on return inflate() will set strm->data_type to the + number of unused bits in the last byte taken from strm->next_in, plus 64 + if inflate() is currently decoding the last block in the deflate stream, + plus 128 if inflate() returned immediately after decoding an end-of-block + code or decoding the complete header up to just before the first byte of the + deflate stream. The end-of-block will not be indicated until all of the + uncompressed data from that block has been written to strm->next_out. The + number of unused bits may in general be greater than seven, except when + bit 7 of data_type is set, in which case the number of unused bits will be + less than eight. + + inflate() should normally be called until it returns Z_STREAM_END or an + error. However if all decompression is to be performed in a single step + (a single call of inflate), the parameter flush should be set to + Z_FINISH. In this case all pending input is processed and all pending + output is flushed; avail_out must be large enough to hold all the + uncompressed data. (The size of the uncompressed data may have been saved + by the compressor for this purpose.) The next operation on this stream must + be inflateEnd to deallocate the decompression state. The use of Z_FINISH + is never required, but can be used to inform inflate that a faster approach + may be used for the single inflate() call. + + In this implementation, inflate() always flushes as much output as + possible to the output buffer, and always uses the faster approach on the + first call. So the only effect of the flush parameter in this implementation + is on the return value of inflate(), as noted below, or when it returns early + because Z_BLOCK is used. + + If a preset dictionary is needed after this call (see inflateSetDictionary + below), inflate sets strm-adler to the adler32 checksum of the dictionary + chosen by the compressor and returns Z_NEED_DICT; otherwise it sets + strm->adler to the adler32 checksum of all output produced so far (that is, + total_out bytes) and returns Z_OK, Z_STREAM_END or an error code as described + below. At the end of the stream, inflate() checks that its computed adler32 + checksum is equal to that saved by the compressor and returns Z_STREAM_END + only if the checksum is correct. + + inflate() will decompress and check either zlib-wrapped or gzip-wrapped + deflate data. The header type is detected automatically. Any information + contained in the gzip header is not retained, so applications that need that + information should instead use raw inflate, see inflateInit2() below, or + inflateBack() and perform their own processing of the gzip header and + trailer. + + inflate() returns Z_OK if some progress has been made (more input processed + or more output produced), Z_STREAM_END if the end of the compressed data has + been reached and all uncompressed output has been produced, Z_NEED_DICT if a + preset dictionary is needed at this point, Z_DATA_ERROR if the input data was + corrupted (input stream not conforming to the zlib format or incorrect check + value), Z_STREAM_ERROR if the stream structure was inconsistent (for example + if next_in or next_out was NULL), Z_MEM_ERROR if there was not enough memory, + Z_BUF_ERROR if no progress is possible or if there was not enough room in the + output buffer when Z_FINISH is used. Note that Z_BUF_ERROR is not fatal, and + inflate() can be called again with more input and more output space to + continue decompressing. If Z_DATA_ERROR is returned, the application may then + call inflateSync() to look for a good compression block if a partial recovery + of the data is desired. +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TinflateEnd} + TinflateEnd = function (var strm: TZStreamRec): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM inflateEnd} + inflateEnd: TinflateEnd = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM inflateEnd} +function inflateEnd(var strm: TZStreamRec): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{* + All dynamically allocated data structures for this stream are freed. + This function discards any unprocessed input and does not flush any + pending output. + + inflateEnd returns Z_OK if success, Z_STREAM_ERROR if the stream state + was inconsistent. In the error case, msg may be set but then points to a + static string (which must not be deallocated). +*} + + {* Advanced functions *} + +{* + The following functions are needed only in some special applications. +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TdeflateInit2_} + TdeflateInit2_ = function (var strm:z_stream; + level: Integer; + method: Integer; + windowBits: Integer; + memLevel: Integer; + strategy: Integer; + {const} version: PAnsiChar; + stream_size: Integer): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM deflateInit2_} + deflateInit2_: TdeflateInit2_ = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM deflateInit2_} +function deflateInit2_(var strm:z_stream; + level: Integer; + method: Integer; + windowBits: Integer; + memLevel: Integer; + strategy: Integer; + {const} version: PAnsiChar; + stream_size: Integer): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM deflateInit2} +function deflateInit2(var strm: TZStreamRec; + level: Integer; + method: Integer; + windowBits: Integer; + memLevel: Integer; + strategy: Integer): Integer; // macro +{* + This is another version of deflateInit with more compression options. The + fields next_in, zalloc, zfree and opaque must be initialized before by + the caller. + + The method parameter is the compression method. It must be Z_DEFLATED in + this version of the library. + + The windowBits parameter is the base two logarithm of the window size + (the size of the history buffer). It should be in the range 8..15 for this + version of the library. Larger values of this parameter result in better + compression at the expense of memory usage. The default value is 15 if + deflateInit is used instead. + + windowBits can also be -8..-15 for raw deflate. In this case, -windowBits + determines the window size. deflate() will then generate raw deflate data + with no zlib header or trailer, and will not compute an adler32 check value. + + windowBits can also be greater than 15 for optional gzip encoding. Add + 16 to windowBits to write a simple gzip header and trailer around the + compressed data instead of a zlib wrapper. The gzip header will have no + file name, no extra data, no comment, no modification time (set to zero), + no header crc, and the operating system will be set to 255 (unknown). + + The memLevel parameter specifies how much memory should be allocated + for the internal compression state. memLevel=1 uses minimum memory but + is slow and reduces compression ratio; memLevel=9 uses maximum memory + for optimal speed. The default value is 8. See zconf.h for total memory + usage as a function of windowBits and memLevel. + + The strategy parameter is used to tune the compression algorithm. Use the + value Z_DEFAULT_STRATEGY for normal data, Z_FILTERED for data produced by a + filter (or predictor), Z_HUFFMAN_ONLY to force Huffman encoding only (no + string match), or Z_RLE to limit match distances to one (run-length + encoding). Filtered data consists mostly of small values with a somewhat + random distribution. In this case, the compression algorithm is tuned to + compress them better. The effect of Z_FILTERED is to force more Huffman + coding and less string matching; it is somewhat intermediate between + Z_DEFAULT and Z_HUFFMAN_ONLY. Z_RLE is designed to be almost as fast as + Z_HUFFMAN_ONLY, but give better compression for PNG image data. The strategy + parameter only affects the compression ratio but not the correctness of the + compressed output even if it is not set appropriately. + + deflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough + memory, Z_STREAM_ERROR if a parameter is invalid (such as an invalid + method). msg is set to null if there is no error message. deflateInit2 does + not perform any compression: this will be done by deflate(). +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TdeflateSetDictionary} + TdeflateSetDictionary = function(var strm: TZStreamRec; + {const} dictionary: PBytef; + dictLength:uInt): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM deflateSetDictionary} + deflateSetDictionary: TdeflateSetDictionary = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM deflateSetDictionary} +function deflateSetDictionary(var strm: TZStreamRec; + {const} dictionary: PBytef; + dictLength:uInt): Integer; +{$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{* + Initializes the compression dictionary from the given byte sequence + without producing any compressed output. This function must be called + immediately after deflateInit, deflateInit2 or deflateReset, before any + call of deflate. The compressor and decompressor must use exactly the same + dictionary (see inflateSetDictionary). + + The dictionary should consist of strings (byte sequences) that are likely + to be encountered later in the data to be compressed, with the most commonly + used strings preferably put towards the end of the dictionary. Using a + dictionary is most useful when the data to be compressed is short and can be + predicted with good accuracy; the data can then be compressed better than + with the default empty dictionary. + + Depending on the size of the compression data structures selected by + deflateInit or deflateInit2, a part of the dictionary may in effect be + discarded, for example if the dictionary is larger than the window size in + deflate or deflate2. Thus the strings most likely to be useful should be + put at the end of the dictionary, not at the front. + + Upon return of this function, strm->adler is set to the adler32 value + of the dictionary; the decompressor may later use this value to determine + which dictionary has been used by the compressor. (The adler32 value + applies to the whole dictionary even if only a subset of the dictionary is + actually used by the compressor.) If a raw deflate was requested, then the + adler32 value is not computed and strm->adler is not set. + + deflateSetDictionary returns Z_OK if success, or Z_STREAM_ERROR if a + parameter is invalid (such as NULL dictionary) or the stream state is + inconsistent (for example if deflate has already been called for this stream + or if the compression method is bsort). deflateSetDictionary does not + perform any compression: this will be done by deflate(). +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TdeflateCopy} + TdeflateCopy = function (var dest: TZStreamRec; + var source: TZStreamRec): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM deflateCopy} + deflateCopy: TdeflateCopy = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM deflateCopy} +function deflateCopy(var dest: TZStreamRec; + var source: TZStreamRec): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} +{* + Sets the destination stream as a complete copy of the source stream. + + This function can be useful when several compression strategies will be + tried, for example when there are several ways of pre-processing the input + data with a filter. The streams that will be discarded should then be freed + by calling deflateEnd. Note that deflateCopy duplicates the internal + compression state which can be quite large, so this strategy is slow and + can consume lots of memory. + + deflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not + enough memory, Z_STREAM_ERROR if the source stream state was inconsistent + (such as zalloc being NULL). msg is left unchanged in both source and + destination. +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TdeflateReset} + TdeflateReset = function (var strm: TZStreamRec): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM deflateReset} + deflateReset: TdeflateReset = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM deflateReset} +function deflateReset(var strm: TZStreamRec): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{* + This function is equivalent to deflateEnd followed by deflateInit, + but does not free and reallocate all the internal compression state. + The stream will keep the same compression level and any other attributes + that may have been set by deflateInit2. + + deflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source + stream state was inconsistent (such as zalloc or state being NULL). +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TdeflateParams} + TdeflateParams = function (var strm: TZStreamRec; + level: Integer; + strategy: Integer): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM deflateParams} + deflateParams: TdeflateParams = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM deflateParams} +function deflateParams(var strm: TZStreamRec; + level: Integer; + strategy: Integer): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{* + Dynamically update the compression level and compression strategy. The + interpretation of level and strategy is as in deflateInit2. This can be + used to switch between compression and straight copy of the input data, or + to switch to a different kind of input data requiring a different + strategy. If the compression level is changed, the input available so far + is compressed with the old level (and may be flushed); the new level will + take effect only at the next call of deflate(). + + Before the call of deflateParams, the stream state must be set as for + a call of deflate(), since the currently available input may have to + be compressed and flushed. In particular, strm->avail_out must be non-zero. + + deflateParams returns Z_OK if success, Z_STREAM_ERROR if the source + stream state was inconsistent or if a parameter was invalid, Z_BUF_ERROR + if strm->avail_out was zero. +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TdeflateBound} + TdeflateBound = function (var strm: TZStreamRec; + sourceLen:uLong):uLong; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM deflateBound} + deflateBound: TdeflateBound = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM deflateBound} +function deflateBound(var strm: TZStreamRec; + sourceLen:uLong):uLong; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{* + deflateBound() returns an upper bound on the compressed size after + deflation of sourceLen bytes. It must be called after deflateInit() + or deflateInit2(). This would be used to allocate an output buffer + for deflation in a single pass, and so would be called before deflate(). +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TdeflatePending} + TdeflatePending = function (var strm: TZStreamRec; + pending: PCardinal; + bits: PInteger): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM deflatePending} + deflatePending: TdeflatePending = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM deflatePending} +function deflatePending(var strm: TZStreamRec; + pending: PCardinal; + bits: PInteger): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +(* + deflatePending() returns the number of bytes and bits of output that have + been generated, but not yet provided in the available output. The bytes not + provided would be due to the available output space having being consumed. + The number of bits of output not provided are between 0 and 7, where they + await more bits to join them in order to fill out a full byte. If pending + or bits are Z_NULL, then those values are not set. + + deflatePending returns Z_OK if success, or Z_STREAM_ERROR if the source + stream state was inconsistent. +*) + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TdeflatePrime} + TdeflatePrime = function (var strm: TZStreamRec; + bits: Integer; + value: Integer): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM deflatePrime} + deflatePrime: TdeflatePrime = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM deflatePrime} +function deflatePrime(var strm: TZStreamRec; + bits: Integer; + value: Integer): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{* + deflatePrime() inserts bits in the deflate output stream. The intent + is that this function is used to start off the deflate output with the + bits leftover from a previous deflate stream when appending to it. As such, + this function can only be used for raw deflate, and must be used before the + first deflate() call after a deflateInit2() or deflateReset(). bits must be + less than or equal to 16, and that many of the least significant bits of + value will be inserted in the output. + + deflatePrime returns Z_OK if success, or Z_STREAM_ERROR if the source + stream state was inconsistent. +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TinflateInit2_} + TinflateInit2_ = function (var strm:z_stream; + windowBits: Integer; + {const} version: PAnsiChar; + stream_size: Integer): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM inflateInit2_} + inflateInit2_: TinflateInit2_ = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM inflateInit2_} +function inflateInit2_(var strm:z_stream; + windowBits: Integer; + {const} version: PAnsiChar; + stream_size: Integer): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM inflateInit2} +function inflateInit2(var strm: TZStreamRec; + windowBits: Integer): Integer; // macro +{* + This is another version of inflateInit with an extra parameter. The + fields next_in, avail_in, zalloc, zfree and opaque must be initialized + before by the caller. + + The windowBits parameter is the base two logarithm of the maximum window + size (the size of the history buffer). It should be in the range 8..15 for + this version of the library. The default value is 15 if inflateInit is used + instead. windowBits must be greater than or equal to the windowBits value + provided to deflateInit2() while compressing, or it must be equal to 15 if + deflateInit2() was not used. If a compressed stream with a larger window + size is given as input, inflate() will return with the error code + Z_DATA_ERROR instead of trying to allocate a larger window. + + windowBits can also be -8..-15 for raw inflate. In this case, -windowBits + determines the window size. inflate() will then process raw deflate data, + not looking for a zlib or gzip header, not generating a check value, and not + looking for any check values for comparison at the end of the stream. This + is for use with other formats that use the deflate compressed data format + such as zip. Those formats provide their own check values. If a custom + format is developed using the raw deflate format for compressed data, it is + recommended that a check value such as an adler32 or a crc32 be applied to + the uncompressed data as is done in the zlib, gzip, and zip formats. For + most applications, the zlib format should be used as is. Note that comments + above on the use in deflateInit2() applies to the magnitude of windowBits. + + windowBits can also be greater than 15 for optional gzip decoding. Add + 32 to windowBits to enable zlib and gzip decoding with automatic header + detection, or add 16 to decode only the gzip format (the zlib format will + return a Z_DATA_ERROR). + + inflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough + memory, Z_STREAM_ERROR if a parameter is invalid (such as a negative + memLevel). msg is set to null if there is no error message. inflateInit2 + does not perform any decompression apart from reading the zlib header if + present: this will be done by inflate(). (So next_in and avail_in may be + modified, but next_out and avail_out are unchanged.) +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TinflateSetDictionary} + TinflateSetDictionary = function (var strm: TZStreamRec; + {const} dictionary: PBytef; + dictLength:uInt): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM inflateSetDictionary} + inflateSetDictionary: TinflateSetDictionary = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM inflateSetDictionary} +function inflateSetDictionary(var strm: TZStreamRec; + {const} dictionary: PBytef; + dictLength:uInt): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{* + Initializes the decompression dictionary from the given uncompressed byte + sequence. This function must be called immediately after a call of inflate + if this call returned Z_NEED_DICT. The dictionary chosen by the compressor + can be determined from the adler32 value returned by this call of + inflate. The compressor and decompressor must use exactly the same + dictionary (see deflateSetDictionary). + + inflateSetDictionary returns Z_OK if success, Z_STREAM_ERROR if a + parameter is invalid (such as NULL dictionary) or the stream state is + inconsistent, Z_DATA_ERROR if the given dictionary doesn't match the + expected one (incorrect adler32 value). inflateSetDictionary does not + perform any decompression: this will be done by subsequent calls of + inflate(). +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TinflateSync} + TinflateSync = function (var strm: TZStreamRec): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM inflateSync} + inflateSync: TinflateSync = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM inflateSync} +function inflateSync(var strm: TZStreamRec): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{* + Skips invalid compressed data until a full flush point (see above the + description of deflate with Z_FULL_FLUSH) can be found, or until all + available input is skipped. No output is provided. + + inflateSync returns Z_OK if a full flush point has been found, Z_BUF_ERROR + if no more input was provided, Z_DATA_ERROR if no flush point has been found, + or Z_STREAM_ERROR if the stream structure was inconsistent. In the success + case, the application may save the current current value of total_in which + indicates where valid compressed data was found. In the error case, the + application may repeatedly call inflateSync, providing more input each time, + until success or end of the input data. +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TinflateCopy} + TinflateCopy = function (var dest: TZStreamRec; + var source: TZStreamRec): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM inflateCopy} + inflateCopy: TinflateCopy = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM inflateCopy} +function inflateCopy(var dest: TZStreamRec; + var source: TZStreamRec): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{* + Sets the destination stream as a complete copy of the source stream. + + This function can be useful when randomly accessing a large stream. The + first pass through the stream can periodically record the inflate state, + allowing restarting inflate at those points when randomly accessing the + stream. + + inflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not + enough memory, Z_STREAM_ERROR if the source stream state was inconsistent + (such as zalloc being NULL). msg is left unchanged in both source and + destination. +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TinflateReset} + TinflateReset = function (var strm: TZStreamRec): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM inflateReset} + inflateReset: TinflateReset = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM inflateReset} +function inflateReset(var strm: TZStreamRec): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{* + This function is equivalent to inflateEnd followed by inflateInit, + but does not free and reallocate all the internal decompression state. + The stream will keep attributes that may have been set by inflateInit2. + + inflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source + stream state was inconsistent (such as zalloc or state being NULL). +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TinflateBackInit_} + TinflateBackInit_ = function (var strm:z_stream; + windowBits: Integer; + window: PByte; + {const} version: PAnsiChar; + stream_size: Integer): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM inflateBackInit_} + inflateBackInit_: TinflateBackInit_ = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM inflateBackInit_} +function inflateBackInit_(var strm:z_stream; + windowBits: Integer; + window: PByte; + {const} version: PAnsiChar; + stream_size: Integer): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM inflateBackInit} +function inflateBackInit(var strm: TZStreamRec; + windowBits: Integer; + window: PByte): Integer; // macro +{* + Initialize the internal stream state for decompression using inflateBack() + calls. The fields zalloc, zfree and opaque in strm must be initialized + before the call. If zalloc and zfree are Z_NULL, then the default library- + derived memory allocation routines are used. windowBits is the base two + logarithm of the window size, in the range 8..15. window is a caller + supplied buffer of that size. Except for special applications where it is + assured that deflate was used with small window sizes, windowBits must be 15 + and a 32K byte window must be supplied to be able to decompress general + deflate streams. + + See inflateBack() for the usage of these routines. + + inflateBackInit will return Z_OK on success, Z_STREAM_ERROR if any of + the paramaters are invalid, Z_MEM_ERROR if the internal state could not + be allocated, or Z_VERSION_ERROR if the version of the library does not + match the version of the header file. +*} + +type + {$EXTERNALSYM in_func} + in_func = function(p1: Pointer; p2: PByte):UnsignedInt; + {$EXTERNALSYM out_func} + out_func = function (p1: Pointer; p2: PByte; p3:UnsignedInt): Longint; + {$EXTERNALSYM TFNInFunc} + TFNInFunc = in_func; + {$EXTERNALSYM TFNOutFunc} + TFNOutFunc = out_func; + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TinflateBack} + TinflateBack = function (var strm: TZStreamRec; + input:TFNInFunc; + in_desc: Pointer; + ouput:TFNOutFunc; + out_desc: Pointer): Integer; // OS: CHECKTHIS - should the parameter names + // be the same as in PHs translation? They + // are wrong there, but in/out are reserved + // words in Delphi + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM inflateBack} + inflateBack: TinflateBack = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM inflateBack} +function inflateBack(var strm: TZStreamRec; + input:TFNInFunc; + in_desc: Pointer; + ouput:TFNOutFunc; + out_desc: Pointer): Integer; // OS: CHECKTHIS - should the parameter names + // be the same as in PHs translation? They + // are wrong there, but in/out are reserved + // words in Delphi + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{* + inflateBack() does a raw inflate with a single call using a call-back + interface for input and output. This is more efficient than inflate() for + file i/o applications in that it avoids copying between the output and the + sliding window by simply making the window itself the output buffer. This + function trusts the application to not change the output buffer passed by + the output function, at least until inflateBack() returns. + + inflateBackInit() must be called first to allocate the internal state + and to initialize the state with the user-provided window buffer. + inflateBack() may then be used multiple times to inflate a complete, raw + deflate stream with each call. inflateBackEnd() is then called to free + the allocated state. + + A raw deflate stream is one with no zlib or gzip header or trailer. + This routine would normally be used in a utility that reads zip or gzip + files and writes out uncompressed files. The utility would decode the + header and process the trailer on its own, hence this routine expects + only the raw deflate stream to decompress. This is different from the + normal behavior of inflate(), which expects either a zlib or gzip header and + trailer around the deflate stream. + + inflateBack() uses two subroutines supplied by the caller that are then + called by inflateBack() for input and output. inflateBack() calls those + routines until it reads a complete deflate stream and writes out all of the + uncompressed data, or until it encounters an error. The function's + parameters and return types are defined above in the in_func and out_func + typedefs. inflateBack() will call in(in_desc, &buf) which should return the + number of bytes of provided input, and a pointer to that input in buf. If + there is no input available, in() must return zero--buf is ignored in that + case--and inflateBack() will return a buffer error. inflateBack() will call + out(out_desc, buf, len) to write the uncompressed data buf[0..len-1]. out() + should return zero on success, or non-zero on failure. If out() returns + non-zero, inflateBack() will return with an error. Neither in() nor out() + are permitted to change the contents of the window provided to + inflateBackInit(), which is also the buffer that out() uses to write from. + The length written by out() will be at most the window size. Any non-zero + amount of input may be provided by in(). + + For convenience, inflateBack() can be provided input on the first call by + setting strm->next_in and strm->avail_in. If that input is exhausted, then + in() will be called. Therefore strm->next_in must be initialized before + calling inflateBack(). If strm->next_in is Z_NULL, then in() will be called + immediately for input. If strm->next_in is not Z_NULL, then strm->avail_in + must also be initialized, and then if strm->avail_in is not zero, input will + initially be taken from strm->next_in[0 .. strm->avail_in - 1]. + + The in_desc and out_desc parameters of inflateBack() is passed as the + first parameter of in() and out() respectively when they are called. These + descriptors can be optionally used to pass any information that the caller- + supplied in() and out() functions need to do their job. + + On return, inflateBack() will set strm->next_in and strm->avail_in to + pass back any unused input that was provided by the last in() call. The + return values of inflateBack() can be Z_STREAM_END on success, Z_BUF_ERROR + if in() or out() returned an error, Z_DATA_ERROR if there was a format + error in the deflate stream (in which case strm->msg is set to indicate the + nature of the error), or Z_STREAM_ERROR if the stream was not properly + initialized. In the case of Z_BUF_ERROR, an input or output error can be + distinguished using strm->next_in which will be Z_NULL only if in() returned + an error. If strm->next is not Z_NULL, then the Z_BUF_ERROR was due to + out() returning non-zero. (in() will always be called before out(), so + strm->next_in is assured to be defined if out() returns non-zero.) Note + that inflateBack() cannot return Z_OK. +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TinflateBackEnd} + TinflateBackEnd = function (var strm: TZStreamRec): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM inflateBackEnd} + inflateBackEnd: TinflateBackEnd = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM inflateBackEnd} +function inflateBackEnd(var strm: TZStreamRec): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{* + All memory allocated by inflateBackInit() is freed. + + inflateBackEnd() returns Z_OK on success, or Z_STREAM_ERROR if the stream + state was inconsistent. +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TzlibCompileFlags} + TzlibCompileFlags = function ():uLong; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM zlibCompileFlags} + zlibCompileFlags: TzlibCompileFlags = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM zlibCompileFlags} +function zlibCompileFlags():uLong; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{* Return flags indicating compile-time options. + + Type sizes, two bits each, 00 = 16 bits, 01 = 32, 10 = 64, 11 = other: + 1.0: size of uInt + 3.2: size of uLong + 5.4: size of voidpf (pointer) + 7.6: size of z_off_t + + Compiler, assembler, and debug options: + 8: DEBUG + 9: ASMV or ASMINF -- use ASM code + 10: ZLIB_WINAPI -- exported functions use the WINAPI calling convention + 11: 0 (reserved) + + One-time table building (smaller code, but not thread-safe if true): + 12: BUILDFIXED -- build static block decoding tables when needed + 13: DYNAMIC_CRC_TABLE -- build CRC calculation tables when needed + 14,15: 0 (reserved) + + Library content (indicates missing functionality): + 16: NO_GZCOMPRESS -- gz* functions cannot compress (to avoid linking + deflate code when not needed) + 17: NO_GZIP -- deflate can't write gzip streams, and inflate can't detect + and decode gzip streams (to avoid linking crc code) + 18-19: 0 (reserved) + + Operation variations (changes in library functionality): + 20: PKZIP_BUG_WORKAROUND -- slightly more permissive inflate + 21: FASTEST -- deflate algorithm with only one, lowest compression level + 22,23: 0 (reserved) + + The sprintf variant used by gzprintf (zero is best): + 24: 0 = vs*, 1 = s* -- 1 means limited to 20 arguments after the format + 25: 0 = *nprintf, 1 = *printf -- 1 means gzprintf() not secure! + 26: 0 = returns value, 1 = void -- 1 means inferred string length returned + + Remainder: + 27-31: 0 (reserved) + *} + + + {* utility functions *} + +{* + The following utility functions are implemented on top of the + basic stream-oriented functions. To simplify the interface, some + default options are assumed (compression level and memory usage, + standard memory allocation functions). The source code of these + utility functions can easily be modified if you need special options. +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM Tcompress} + Tcompress = function (dest: PBytef; + var destLen:uLongf; + {const} source: PBytef; + sourceLen:uLong): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM compress} + compress: Tcompress = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM compress} +function compress(dest: PBytef; + var destLen:uLongf; + {const} source: PBytef; + sourceLen:uLong): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{* + Compresses the source buffer into the destination buffer. sourceLen is + the byte length of the source buffer. Upon entry, destLen is the total + size of the destination buffer, which must be at least the value returned + by compressBound(sourceLen). Upon exit, destLen is the actual size of the + compressed buffer. + This function can be used to compress a whole file at once if the + input file is mmap'ed. + compress returns Z_OK if success, Z_MEM_ERROR if there was not + enough memory, Z_BUF_ERROR if there was not enough room in the output + buffer. +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM Tcompress2} + Tcompress2 = function (dest: PBytef; + var destLen:uLongf; + {const} source: PBytef; + sourceLen:uLong; + level: Integer): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM compress2} + compress2: Tcompress2 = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM compress2} +function compress2(dest: PBytef; + var destLen:uLongf; + {const} source: PBytef; + sourceLen:uLong; + level: Integer): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{* + Compresses the source buffer into the destination buffer. The level + parameter has the same meaning as in deflateInit. sourceLen is the byte + length of the source buffer. Upon entry, destLen is the total size of the + destination buffer, which must be at least the value returned by + compressBound(sourceLen). Upon exit, destLen is the actual size of the + compressed buffer. + + compress2 returns Z_OK if success, Z_MEM_ERROR if there was not enough + memory, Z_BUF_ERROR if there was not enough room in the output buffer, + Z_STREAM_ERROR if the level parameter is invalid. +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TcompressBound} + TcompressBound = function (sourceLen:uLong):uLong; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM compressBound} + compressBound: TcompressBound = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM compressBound} +function compressBound(sourceLen:uLong):uLong; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{* + compressBound() returns an upper bound on the compressed size after + compress() or compress2() on sourceLen bytes. It would be used before + a compress() or compress2() call to allocate the destination buffer. +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM Tuncompress} + Tuncompress = function (dest: PBytef; + var destLen:uLongf; + {const} source: PBytef; + sourceLen:uLong): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM uncompress} + uncompress: Tuncompress = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM uncompress} +function uncompress(dest: PBytef; + var destLen:uLongf; + {const} source: PBytef; + sourceLen:uLong): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{* + Decompresses the source buffer into the destination buffer. sourceLen is + the byte length of the source buffer. Upon entry, destLen is the total + size of the destination buffer, which must be large enough to hold the + entire uncompressed data. (The size of the uncompressed data must have + been saved previously by the compressor and transmitted to the decompressor + by some mechanism outside the scope of this compression library.) + Upon exit, destLen is the actual size of the compressed buffer. + This function can be used to decompress a whole file at once if the + input file is mmap'ed. + + uncompress returns Z_OK if success, Z_MEM_ERROR if there was not + enough memory, Z_BUF_ERROR if there was not enough room in the output + buffer, or Z_DATA_ERROR if the input data was corrupted or incomplete. +*} + +(* +type + gzFile = voidp; + +function gzopen(path: PAnsiChar; mode: PAnsiChar):gzFile; +{* + Opens a gzip (.gz) file for reading or writing. The mode parameter + is as in fopen ("rb" or "wb") but can also include a compression level + ("wb9") or a strategy: 'f' for filtered data as in "wb6f", 'h' for + Huffman only compression as in "wb1h", or 'R' for run-length encoding + as in "wb1R". (See the description of deflateInit2 for more information + about the strategy parameter.) + + gzopen can be used to read a file which is not in gzip format; in this + case gzread will directly read from the file without decompression. + + gzopen returns NULL if the file could not be opened or if there was + insufficient memory to allocate the (de)compression state; errno + can be checked to distinguish the two cases (if errno is zero, the + zlib error is Z_MEM_ERROR). *} + +function gzdopen(fd: Integer; mode: PAnsiChar):gzFile; +{* + gzdopen() associates a gzFile with the file descriptor fd. File + descriptors are obtained from calls like open, dup, creat, pipe or + fileno (in the file has been previously opened with fopen). + The mode parameter is as in gzopen. + The next call of gzclose on the returned gzFile will also close the + file descriptor fd, just like fclose(fdopen(fd), mode) closes the file + descriptor fd. If you want to keep fd open, use gzdopen(dup(fd), mode). + gzdopen returns NULL if there was insufficient memory to allocate + the (de)compression state. +*} + +function gzsetparams(file_:gzFile; level: Integer; strategy: Integer): Integer; +{* + Dynamically update the compression level or strategy. See the description + of deflateInit2 for the meaning of these parameters. + gzsetparams returns Z_OK if success, or Z_STREAM_ERROR if the file was not + opened for writing. +*} + +function gzread(file_:gzFile; buf:voidp; len:UnsignedInt): Integer; +{* + Reads the given number of uncompressed bytes from the compressed file. + If the input file was not in gzip format, gzread copies the given number + of bytes into the buffer. + gzread returns the number of uncompressed bytes actually read (0 for + end of file, -1 for error). *} + +function gzwrite(file_:gzFile; + buf:voidpc; + len:UnsignedInt): Integer; +{* + Writes the given number of uncompressed bytes into the compressed file. + gzwrite returns the number of uncompressed bytes actually written + (0 in case of error). +*} + +// function gzprintf(file_:gzFile; format: PAnsiChar, ...): Integer; +// No ellipsis in Delphi +{* + Converts, formats, and writes the args to the compressed file under + control of the format string, as in fprintf. gzprintf returns the number of + uncompressed bytes actually written (0 in case of error). The number of + uncompressed bytes written is limited to 4095. The caller should assure that + this limit is not exceeded. If it is exceeded, then gzprintf() will return + return an error (0) with nothing written. In this case, there may also be a + buffer overflow with unpredictable consequences, which is possible only if + zlib was compiled with the insecure functions sprintf() or vsprintf() + because the secure snprintf() or vsnprintf() functions were not available. +*} + +function gzputs(file_:gzFile; s: PAnsiChar): Integer; +(* + Writes the given null-terminated string to the compressed file, excluding + the terminating null character. + gzputs returns the number of characters written, or -1 in case of error. +*} + +function gzgets(file_:gzFile; buf: PAnsiChar; len: Integer): PAnsiChar; +{* + Reads bytes from the compressed file until len-1 characters are read, or + a newline character is read and transferred to buf, or an end-of-file + condition is encountered. The string is then terminated with a null + character. + gzgets returns buf, or Z_NULL in case of error. +*} + +function gzputc(file_:gzFile; c: Integer): Integer; +{* + Writes c, converted to an unsigned char, into the compressed file. + gzputc returns the value that was written, or -1 in case of error. +*} + +function gzgetc(file_:gzFile): Integer; +{* + Reads one byte from the compressed file. gzgetc returns this byte + or -1 in case of end of file or error. +*} + +function gzungetc(c: Integer; file_:gzFile): Integer; +{* + Push one character back onto the stream to be read again later. + Only one character of push-back is allowed. gzungetc() returns the + character pushed, or -1 on failure. gzungetc() will fail if a + character has been pushed but not read yet, or if c is -1. The pushed + character will be discarded if the stream is repositioned with gzseek() + or gzrewind(). +*} + +function gzflush(file_:gzFile; flush: Integer): Integer; +{* + Flushes all pending output into the compressed file. The parameter + flush is as in the deflate() function. The return value is the zlib + error number (see function gzerror below). gzflush returns Z_OK if + the flush parameter is Z_FINISH and all output could be flushed. + gzflush should be called only when strictly necessary because it can + degrade compression. +*} + +function gzseek(file_:gzFile; + offset:z_off_t; + whence: Integer):z_off_t; +{* + Sets the starting position for the next gzread or gzwrite on the + given compressed file. The offset represents a number of bytes in the + uncompressed data stream. The whence parameter is defined as in lseek(2); + the value SEEK_END is not supported. + If the file is opened for reading, this function is emulated but can be + extremely slow. If the file is opened for writing, only forward seeks are + supported; gzseek then compresses a sequence of zeroes up to the new + starting position. + + gzseek returns the resulting offset location as measured in bytes from + the beginning of the uncompressed stream, or -1 in case of error, in + particular if the file is opened for writing and the new starting position + would be before the current position. +*} + +function gzrewind(file_:gzFile): Integer; +{* + Rewinds the given file. This function is supported only for reading. + + gzrewind(file) is equivalent to (int)gzseek(file, 0L, SEEK_SET) +*} + +function gztell(file_:gzFile):z_off_t; +{* + Returns the starting position for the next gzread or gzwrite on the + given compressed file. This position represents a number of bytes in the + uncompressed data stream. + + gztell(file) is equivalent to gzseek(file, 0L, SEEK_CUR) +*} + +function gzeof(file_:gzFile): Integer; +{* + Returns 1 when EOF has previously been detected reading the given + input stream, otherwise zero. +*} + +function gzclose(file_:gzFile): Integer; +{* + Flushes all pending output if necessary, closes the compressed file + and deallocates all the (de)compression state. The return value is the zlib + error number (see function gzerror below). +*} + +function gzerror(file_:gzFile; var errnum: Integer): PAnsiChar; +{* + Returns the error message for the last error which occurred on the + given compressed file. errnum is set to zlib error number. If an + error occurred in the file system and not in the compression library, + errnum is set to Z_ERRNO and the application may consult errno + to get the exact error code. +*} + +procedure gzclearerr(file_:gzFile); +{* + Clears the error and end-of-file flags for file. This is analogous to the + clearerr() function in stdio. This is useful for continuing to read a gzip + file that is being written concurrently. +*} +*) + {* checksum functions *} + +{* + These functions are not related to compression but are exported + anyway because they might be useful in applications using the + compression library. +*} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM Tadler32} + Tadler32 = function (adler:uLong; {const} buf: PBytef; len:uInt):uLong; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM adler32} + adler32: Tadler32 = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM adler32} +function adler32(adler:uLong; {const} buf: PBytef; len:uInt):uLong; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +(* + Update a running Adler-32 checksum with the bytes buf[0..len-1] and + return the updated checksum. If buf is NULL, this function returns + the required initial value for the checksum. + An Adler-32 checksum is almost as reliable as a CRC32 but can be computed + much faster. Usage example: + + uLong adler = adler32(0L, Z_NULL, 0); + + while (read_buffer(buffer, length) != EOF) { + adler = adler32(adler, buffer, length); + } + if (adler != original_adler) error(); +*) + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM tcrc32} + tcrc32 = function (crc:uLong; {const} buf: PBytef; len:uInt):uLong; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM crc32} + crc32: tcrc32 = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM crc32} +function crc32 (crc:uLong; {const} buf: PBytef; len:uInt):uLong; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +(* + Update a running crc with the bytes buf[0..len-1] and return the updated + crc. If buf is NULL, this function returns the required initial value + for the crc. Pre- and post-conditioning (one's complement) is performed + within this function so it shouldn't be done by the application. + Usage example: + + uLong crc = crc32(0L, Z_NULL, 0); + + while (read_buffer(buffer, length) != EOF) { + crc = crc32(crc, buffer, length); + } + if (crc != original_crc) error(); +*) + + {* various hacks, don't look :) *) + +{* deflateInit and inflateInit are macros to allow checking the zlib version + * and the compiler's view of z_stream: + *} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TzError} + TzError = function (err: Integer): PAnsiChar; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM zError} + zError: TzError = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM zError} +function zError(err: Integer): PAnsiChar; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM TinflateSyncPoint} + TinflateSyncPoint = function (var z: TZStreamRec): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM inflateSyncPoint} + inflateSyncPoint: TinflateSyncPoint = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM inflateSyncPoint} +function inflateSyncPoint(var z: TZStreamRec): Integer; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +{$IFDEF ZLIB_LINKONREQUEST} + +type + {$EXTERNALSYM Tget_crc_table} + Tget_crc_table = function ():PuLongf; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} +var + {$EXTERNALSYM get_crc_table} + get_crc_table: Tget_crc_table = nil; + +{$ELSE ~ZLIB_LINKONREQUEST} + +{$EXTERNALSYM get_crc_table} +function get_crc_table():PuLongf; + {$IFDEF ZLIB_EXPORT_CDECL} cdecl; {$ENDIF ZLIB_EXPORT_CDECL} + +{$ENDIF ~ZLIB_LINKONREQUEST} + +//----------------------------------------------------------------------------- +// from zutil.h +//----------------------------------------------------------------------------- + +const + DEF_WBITS = MAX_WBITS; + {$EXTERNALSYM DEF_WBITS} + +// default windowBits for decompression. MAX_WBITS is for compression only + + DEF_MEM_LEVEL = 8; + {$EXTERNALSYM DEF_MEM_LEVEL} + +//DOM-IGNORE-END +{$ENDIF ~ZLIB_RTL} + +const + {$IFDEF MSWINDOWS} + ZLibDefaultLibraryName = 'zlib1.dll'; + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + ZLibDefaultLibraryName = 'libz.so'; + {$ENDIF UNIX} + ZLibzlibVersionDefaultExportName = 'zlibVersion'; + ZLibdeflateInit_DefaultExportName = 'deflateInit_'; + ZLibdeflateDefaultExportName = 'deflate'; + ZLibdeflateEndDefaultExportName = 'deflateEnd'; + ZLibinflateInit_DefaultExportName = 'inflateInit_'; + ZLibinflateDefaultExportName = 'inflate'; + ZLibinflateEndDefaultExportName = 'inflateEnd'; + ZLibdeflateInit2_DefaultExportName = 'deflateInit2_'; + ZLibdeflateSetDictionaryDefaultExportName = 'deflateSetDictionary'; + ZLibdeflateCopyDefaultExportName = 'deflateCopy'; + ZLibdeflateResetDefaultExportName = 'deflateReset'; + ZLibdeflateParamsDefaultExportName = 'deflateParams'; + ZLibdeflateBoundDefaultExportName = 'deflateBound'; + ZLibdeflatePendingDefaultExportName = 'deflatePending'; + ZLibdeflatePrimeDefaultExportName = 'deflatePrime'; + ZLibinflateInit2_DefaultExportName = 'inflateInit2_'; + ZLibinflateSetDictionaryDefaultExportName = 'inflateSetDictionary'; + ZLibinflateSyncDefaultExportName = 'inflateSync'; + ZLibinflateCopyDefaultExportName = 'inflateCopy'; + ZLibinflateResetDefaultExportName = 'inflateReset'; + ZLibinflateBackInit_DefaultExportName = 'inflateBackInit_'; + ZLibinflateBackDefaultExportName = 'inflateBack'; + ZLibinflateBackEndDefaultExportName = 'inflateBackEnd'; + ZLibzlibCompileFlagsDefaultExportName = 'zlibCompileFlags'; + ZLibcompressDefaultExportName = 'compress'; + ZLibcompress2DefaultExportName = 'compress2'; + ZLibcompressBoundDefaultExportName = 'compressBound'; + ZLibuncompressDefaultExportName = 'uncompress'; + ZLibadler32DefaultExportName = 'adler32'; + ZLibcrc32DefaultExportName = 'crc32'; + ZLibzErrorDefaultExportName = 'zError'; + ZLibinflateSyncPointDefaultExportName = 'inflateSyncPoint'; + ZLibget_crc_tableDefaultExportName = 'get_crc_table'; +{$IFDEF ZLIB_LINKONREQUEST} +var + ZLibLibraryName: string = ZLibDefaultLibraryName; + ZLibzlibVersionExportName: string = ZLibzlibVersionDefaultExportName; + ZLibdeflateInit_ExportName: string = ZLibdeflateInit_DefaultExportName; + ZLibdeflateExportName: string = ZLibdeflateDefaultExportName; + ZLibdeflateEndExportName: string = ZLibdeflateEndDefaultExportName; + ZLibinflateInit_ExportName: string = ZLibinflateInit_DefaultExportName; + ZLibinflateExportName: string = ZLibinflateDefaultExportName; + ZLibinflateEndExportName: string = ZLibinflateEndDefaultExportName; + ZLibdeflateInit2_ExportName: string = ZLibdeflateInit2_DefaultExportName; + ZLibdeflateSetDictionaryExportName: string = ZLibdeflateSetDictionaryDefaultExportName; + ZLibdeflateCopyExportName: string = ZLibdeflateCopyDefaultExportName; + ZLibdeflateResetExportName: string = ZLibdeflateResetDefaultExportName; + ZLibdeflateParamsExportName: string = ZLibdeflateParamsDefaultExportName; + ZLibdeflateBoundExportName: string = ZLibdeflateBoundDefaultExportName; + ZLibdeflatePendingExportName: string = ZLibdeflatePendingDefaultExportName; + ZLibdeflatePrimeExportName: string = ZLibdeflatePrimeDefaultExportName; + ZLibinflateInit2_ExportName: string = ZLibinflateInit2_DefaultExportName; + ZLibinflateSetDictionaryExportName: string = ZLibinflateSetDictionaryDefaultExportName; + ZLibinflateSyncExportName: string = ZLibinflateSyncDefaultExportName; + ZLibinflateCopyExportName: string = ZLibinflateCopyDefaultExportName; + ZLibinflateResetExportName: string = ZLibinflateResetDefaultExportName; + ZLibinflateBackInit_ExportName: string = ZLibinflateBackInit_DefaultExportName; + ZLibinflateBackExportName: string = ZLibinflateBackDefaultExportName; + ZLibinflateBackEndExportName: string = ZLibinflateBackEndDefaultExportName; + ZLibzlibCompileFlagsExportName: string = ZLibzlibCompileFlagsDefaultExportName; + ZLibcompressExportName: string = ZLibcompressDefaultExportName; + ZLibcompress2ExportName: string = ZLibcompress2DefaultExportName; + ZLibcompressBoundExportName: string = ZLibcompressBoundDefaultExportName; + ZLibuncompressExportName: string = ZLibuncompressDefaultExportName; + ZLibadler32ExportName: string = ZLibadler32DefaultExportName; + ZLibcrc32ExportName: string = ZLibcrc32DefaultExportName; + ZLibzErrorExportName: string = ZLibzErrorDefaultExportName; + ZLibinflateSyncPointExportName: string = ZLibinflateSyncPointDefaultExportName; + ZLibget_crc_tableExportName: string = ZLibget_crc_tableDefaultExportName; +{$ENDIF ZLIB_LINKONREQUEST} + +var + ZLibModuleHandle: TModuleHandle = INVALID_MODULEHANDLE_VALUE; + +function IsZLibLoaded: Boolean; +function LoadZLib: Boolean; +procedure UnloadZLib; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +{$IFNDEF ZLIB_RTL} + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +//----------------------------------------------------------------------------- +// +// These are macros in the C version, just passing down the ZLIB version and +// the size of TZStreamRec (alias z_stream) +// +//----------------------------------------------------------------------------- + +function deflateInit(var strm: TZStreamRec; level: Integer): Integer; +begin + Result := deflateInit_(strm, level, ZLIB_VERSION, sizeof(TZStreamRec)); +end; + +function inflateInit(var strm: TZStreamRec): Integer; +begin + Result := inflateInit_(strm, ZLIB_VERSION, sizeof(TZStreamRec)); +end; + +function deflateInit2(var strm: TZStreamRec; level: Integer; method: Integer; windowBits: Integer; memLevel: Integer; strategy: Integer): Integer; +begin + Result := deflateInit2_(strm, level, method, windowBits, memLevel, strategy, ZLIB_VERSION, sizeof(TZStreamRec)); +end; + +function inflateInit2(var strm: TZStreamRec; windowBits: Integer): Integer; +begin + Result := inflateInit2_(strm, windowBits, ZLIB_VERSION, sizeof(TZStreamRec)); +end; + +function inflateBackInit(var strm: TZStreamRec; windowBits: Integer; window: PByte): Integer; +begin + Result := inflateBackInit_(strm, windowBits, window, ZLIB_VERSION, sizeof(TZStreamRec)); +end; + +{$IFDEF ZLIB_STATICLINK} + +{$IFDEF CPU32} +{$LINK ..\windows\obj\zlib\win32\adler32.obj} // OS: CHECKTHIS - Unix version may need forward slashes? +{$LINK ..\windows\obj\zlib\win32\compress.obj} +{$LINK ..\windows\obj\zlib\win32\crc32.obj} +{$LINK ..\windows\obj\zlib\win32\deflate.obj} +{$LINK ..\windows\obj\zlib\win32\infback.obj} +{$LINK ..\windows\obj\zlib\win32\inffast.obj} +{$LINK ..\windows\obj\zlib\win32\inflate.obj} +{$LINK ..\windows\obj\zlib\win32\inftrees.obj} +{$LINK ..\windows\obj\zlib\win32\trees.obj} +{$LINK ..\windows\obj\zlib\win32\uncompr.obj} +{$LINK ..\windows\obj\zlib\win32\zutil.obj} +{$ENDIF CPU32} +{$IFDEF CPU64} +{$LINK ..\windows\obj\zlib\win64\adler32.obj} +{$LINK ..\windows\obj\zlib\win64\compress.obj} +{$LINK ..\windows\obj\zlib\win64\crc32.obj} +{$LINK ..\windows\obj\zlib\win64\deflate.obj} +{$LINK ..\windows\obj\zlib\win64\infback.obj} +{$LINK ..\windows\obj\zlib\win64\inffast.obj} +{$LINK ..\windows\obj\zlib\win64\inflate.obj} +{$LINK ..\windows\obj\zlib\win64\inftrees.obj} +{$LINK ..\windows\obj\zlib\win64\trees.obj} +{$LINK ..\windows\obj\zlib\win64\uncompr.obj} +{$LINK ..\windows\obj\zlib\win64\zutil.obj} +{$ENDIF CPU64} + +// Core functions +function zlibVersion; external; +function deflateInit_; external; // wrapped by deflateInit() +function deflate; external; +function deflateEnd; external; +function inflateInit_; external; // wrapped by inflateInit() +function inflate; external; +function inflateEnd; external; +function deflateInit2_; external; // wrapped by deflateInit2() +function deflateSetDictionary; external; +function deflateCopy; external; +function deflateReset; external; +function deflateParams; external; +function deflateBound; external; +function deflatePending; external; +function deflatePrime; external; +function inflateInit2_; external; // wrapped by inflateInit2() +function inflateSetDictionary; external; +function inflateSync; external; +function inflateCopy; external; +function inflateReset; external; +function inflateBackInit_; external; +function inflateBack; external; +function inflateBackEnd; external; +function zlibCompileFlags; external; +function compress; external; +function compress2; external; +function compressBound; external; +function uncompress; external; +// Checksums +function adler32; external; +function crc32; external; +function zError; external; +function inflateSyncPoint; external; +function get_crc_table; external; + +{$IFDEF LINKTO_MSVCRT_DLL} + +{ Win32 implementation specific!!! Imports from MSVCRT.DLL + Checked availability for Windows 95B and Windows 2000 SP4 + + _memcpy -> MSVCRT:memcpy + _memset -> MSVCRT:memset + _malloc -> MSVCRT:malloc + _strlen -> MSVCRT:strlen + ___errno -> MSVCRT:_errno + _fopen -> MSVCRT:fopen + _fdopen -> MSVCRT:_fdopen + _fprintf -> MSVCRT:fprintf + _ftell -> MSVCRT:ftell + _sprintf -> MSVCRT:sprintf + _fwrite -> MSVCRT:fwrite + _fread -> MSVCRT:fread + _free -> MSVCRT:free + _fclose -> MSVCRT:fclose + _vsnprintf -> MSVCRT:_vsnprintf + _fflush -> MSVCRT:fflush + _fseek -> MSVCRT:fseek + _fputc -> MSVCRT:fputc + _strcat -> MSVCRT:strcat + _clearerr -> MSVCRT:clearerr +} + +{* Just as a hint. Since these functions are already bound at the time the OBJ + * file was created, it's only important that they be of CDECL calling convention. + * Actually it's not even important wether the parameters or the number of + * parameters is correct (especially important for variable-parameter functions). + * Only the symbol names and the calling convention are important here as long + * as only the OBJ use these functions + * + * This is just a "dirty" trick to get these "missing" imports linked + *} + +const + szMSVCRT = 'MSVCRT.DLL'; + +function _memcpy(dest, src: Pointer; count: size_t): Pointer; cdecl; external szMSVCRT name 'memcpy'; +function _memset(dest: Pointer; val: Integer; count: size_t): Pointer; cdecl; external szMSVCRT name 'memset'; +function _malloc(size: size_t): Pointer; cdecl; external szMSVCRT name 'malloc'; +procedure _free(pBlock: Pointer); cdecl; external szMSVCRT name 'free'; +function ___errno(): Integer; cdecl; external szMSVCRT name '_errno'; +function _fopen(filename: PAnsiChar; mode: PAnsiChar): Pointer; cdecl; external szMSVCRT name 'fopen'; +function _fdopen(handle: Integer; mode: PAnsiChar): Pointer; cdecl; external szMSVCRT name '_fdopen'; +function _fprintf(stream: Pointer; format: PAnsiChar {, ...}): Integer; cdecl; external szMSVCRT name 'fprintf'; +function _ftell(stream: Pointer): Longint; cdecl; external szMSVCRT name 'ftell'; +function _sprintf(buffer: PAnsiChar; format: PAnsiChar {, ...}): Integer; cdecl; external szMSVCRT name 'sprintf'; +function _fwrite(buffer: Pointer; size: size_t; count: size_t; stream: Pointer): size_t; cdecl; external szMSVCRT name 'fwrite'; +function _fread(buffer: Pointer; size: size_t; count: size_t; stream: Pointer): size_t; cdecl; external szMSVCRT name 'fread'; +function _fclose(stream: Pointer): Integer; cdecl; external szMSVCRT name 'fclose'; +function _vsnprintf(buffer: PAnsiChar; count: size_t; format: PAnsiChar; argptr:array of const): Integer; cdecl; external szMSVCRT name '_vsnprintf'; +function _fflush(stream: Pointer): Integer; cdecl; external szMSVCRT name 'fflush'; +function _fseek(stream: Pointer; offset: Longint; origin: Integer): Integer; cdecl; external szMSVCRT name 'fseek'; +function _fputc(c: Integer; stream: Pointer): Integer; cdecl; external szMSVCRT name 'fputc'; +function _strcat(strDestination: PAnsiChar; strSource: PAnsiChar): PAnsiChar; cdecl; external szMSVCRT name 'strcat'; +function _strlen(str: PAnsiChar): size_t; cdecl; external szMSVCRT name 'strlen'; +procedure _clearerr(stream: Pointer); cdecl; external szMSVCRT name 'clearerr'; + +{$ELSE ~LINK_TO_MSVCRT} + +{$IFDEF CPU32} +function _memcpy(dest, src: Pointer; count: size_t): Pointer; cdecl; +{$ENDIF CPU32} +{$IFDEF CPU64} +function memcpy(dest, src: Pointer; count: size_t): Pointer; +{$ENDIF CPU64} +begin + Move(src^, dest^, count); + Result := dest; +end; + +{$IFDEF CPU32} +function _memset(dest: Pointer; val: Integer; count: size_t): Pointer; cdecl; +{$ENDIF CPU32} +{$IFDEF CPU64} +function memset(dest: Pointer; val: Integer; count: size_t): Pointer; +{$ENDIF CPU64} +begin + FillChar(dest^, count, val); + Result := dest; +end; + +{$IFDEF CPU32} +function _malloc(size: size_t): Pointer; cdecl; +{$ENDIF CPU32} +{$IFDEF CPU64} +function malloc(size: size_t): Pointer; +{$ENDIF CPU64} +begin + GetMem(Result, size); +end; + +{$IFDEF CPU32} +procedure _free(pBlock: Pointer); cdecl; +{$ENDIF CPU32} +{$IFDEF CPU64} +procedure free(pBlock: Pointer); +{$ENDIF CPU64} +begin + FreeMem(pBlock); +end; + +{$ENDIF ~LINK_TO_MSVCRT} + +{$IFDEF CPU32} +procedure __llmod; cdecl; +asm + jmp System.@_llmod; +end; +{$ENDIF CPU32} + +{$ENDIF ZLIB_STATICLINK} +{$ENDIF ~ZLIB_RTL} + +function IsZLibLoaded: Boolean; +begin + {$IFDEF ZLIB_LINKONREQUEST} + Result := ZLibModuleHandle <> INVALID_MODULEHANDLE_VALUE; + {$ELSE ~ZLIB_LINKONREQUEST} + Result := True; + {$ENDIF ~ZLIB_LINKONREQUEST} +end; + +function LoadZLib: Boolean; +{$IFDEF ZLIB_LINKONREQUEST} +begin + Result := ZLibModuleHandle <> INVALID_MODULEHANDLE_VALUE; + if Result then + Exit; + + Result := JclSysUtils.LoadModule(ZLibModuleHandle, ZLibLibraryName); + if Result then + begin + @zlibVersion := GetModuleSymbol(ZLibModuleHandle, ZLIBzlibVersionExportName); + @deflateInit_ := GetModuleSymbol(ZLibModuleHandle, ZLIBdeflateInit_ExportName); + @deflate := GetModuleSymbol(ZLibModuleHandle, ZLIBdeflateExportName); + @deflateEnd := GetModuleSymbol(ZLibModuleHandle, ZLIBdeflateEndExportName); + @inflateInit_ := GetModuleSymbol(ZLibModuleHandle, ZLIBinflateInit_ExportName); + @inflate := GetModuleSymbol(ZLibModuleHandle, ZLIBinflateExportName); + @inflateEnd := GetModuleSymbol(ZLibModuleHandle, ZLIBinflateEndExportName); + @deflateInit2_ := GetModuleSymbol(ZLibModuleHandle, ZLIBdeflateInit2_ExportName); + @deflateSetDictionary := GetModuleSymbol(ZLibModuleHandle, ZLIBdeflateSetDictionaryExportName); + @deflateCopy := GetModuleSymbol(ZLibModuleHandle, ZLIBdeflateCopyExportName); + @deflateReset := GetModuleSymbol(ZLibModuleHandle, ZLIBdeflateResetExportName); + @deflateParams := GetModuleSymbol(ZLibModuleHandle, ZLIBdeflateParamsExportName); + @deflateBound := GetModuleSymbol(ZLibModuleHandle, ZLIBdeflateBoundExportName); + @deflatePending := GetModuleSymbol(ZLibModuleHandle, ZLIBdeflatePendingExportName); + @deflatePrime := GetModuleSymbol(ZLibModuleHandle, ZLIBdeflatePrimeExportName); + @inflateInit2_ := GetModuleSymbol(ZLibModuleHandle, ZLIBinflateInit2_ExportName); + @inflateSetDictionary := GetModuleSymbol(ZLibModuleHandle, ZLIBinflateSetDictionaryExportName); + @inflateSync := GetModuleSymbol(ZLibModuleHandle, ZLIBinflateSyncExportName); + @inflateCopy := GetModuleSymbol(ZLibModuleHandle, ZLIBinflateCopyExportName); + @inflateReset := GetModuleSymbol(ZLibModuleHandle, ZLIBinflateResetExportName); + @inflateBackInit_ := GetModuleSymbol(ZLibModuleHandle, ZLIBinflateBackInit_ExportName); + @inflateBack := GetModuleSymbol(ZLibModuleHandle, ZLIBinflateBackExportName); + @inflateBackEnd := GetModuleSymbol(ZLibModuleHandle, ZLIBinflateBackEndExportName); + @zlibCompileFlags := GetModuleSymbol(ZLibModuleHandle, ZLIBzlibCompileFlagsExportName); + @compress := GetModuleSymbol(ZLibModuleHandle, ZLIBcompressExportName); + @compress2 := GetModuleSymbol(ZLibModuleHandle, ZLIBcompress2ExportName); + @compressBound := GetModuleSymbol(ZLibModuleHandle, ZLIBcompressBoundExportName); + @uncompress := GetModuleSymbol(ZLibModuleHandle, ZLIBuncompressExportName); + @adler32 := GetModuleSymbol(ZLibModuleHandle, ZLIBadler32ExportName); + @crc32 := GetModuleSymbol(ZLibModuleHandle, ZLIBcrc32ExportName); + @zError := GetModuleSymbol(ZLibModuleHandle, ZLIBzErrorExportName); + @inflateSyncPoint := GetModuleSymbol(ZLibModuleHandle, ZLIBinflateSyncPointExportName); + @get_crc_table := GetModuleSymbol(ZLibModuleHandle, ZLIBget_crc_tableExportName); + end; +end; +{$ELSE ~ZLIB_LINKONREQUEST} +begin + Result := True; +end; +{$ENDIF ~ZLIB_LINKONREQUEST} + +procedure UnloadZLib; +begin + {$IFDEF ZLIB_LINKONREQUEST} + JclSysUtils.UnloadModule(ZLibModuleHandle); + {$ENDIF ZLIB_LINKONREQUEST} +end; + +{$IFNDEF ZLIB_RTL} +{$IFDEF ZLIB_LINKDLL} +// Core functions +function zlibVersion; external ZLibDefaultLibraryName name ZLibzlibVersionDefaultExportName; +function deflateInit_; external ZLibDefaultLibraryName name ZLibdeflateInit_DefaultExportName; +function deflate; external ZLibDefaultLibraryName name ZLibdeflateDefaultExportName; +function deflateEnd; external ZLibDefaultLibraryName name ZLibdeflateEndDefaultExportName; +function inflateInit_; external ZLibDefaultLibraryName name ZLibinflateInit_DefaultExportName; +function inflate; external ZLibDefaultLibraryName name ZLibinflateDefaultExportName; +function inflateEnd; external ZLibDefaultLibraryName name ZLibinflateEndDefaultExportName; +function deflateInit2_; external ZLibDefaultLibraryName name ZLibdeflateInit2_DefaultExportName; +function deflateSetDictionary; external ZLibDefaultLibraryName name ZLibdeflateSetDictionaryDefaultExportName; +function deflateCopy; external ZLibDefaultLibraryName name ZLibdeflateCopyDefaultExportName; +function deflateReset; external ZLibDefaultLibraryName name ZLibdeflateResetDefaultExportName; +function deflateParams; external ZLibDefaultLibraryName name ZLibdeflateParamsDefaultExportName; +function deflateBound; external ZLibDefaultLibraryName name ZLibdeflateBoundDefaultExportName; +function deflatePending; external ZLibDefaultLibraryName name ZLibdeflatePendingDefaultExportName; +function deflatePrime; external ZLibDefaultLibraryName name ZLibdeflatePrimeDefaultExportName; +function inflateInit2_; external ZLibDefaultLibraryName name ZLibinflateInit2_DefaultExportName; +function inflateSetDictionary; external ZLibDefaultLibraryName name ZLibinflateSetDictionaryDefaultExportName; +function inflateSync; external ZLibDefaultLibraryName name ZLibinflateSyncDefaultExportName; +function inflateCopy; external ZLibDefaultLibraryName name ZLibinflateCopyDefaultExportName; +function inflateReset; external ZLibDefaultLibraryName name ZLibinflateResetDefaultExportName; + +function inflateBackInit_; external ZLibDefaultLibraryName name ZLibinflateBackInit_DefaultExportName; +function inflateBack; external ZLibDefaultLibraryName name ZLibinflateBackDefaultExportName; +function inflateBackEnd; external ZLibDefaultLibraryName name ZLibinflateBackEndDefaultExportName; +function zlibCompileFlags; external ZLibDefaultLibraryName name ZLibzlibCompileFlagsDefaultExportName; +function compress; external ZLibDefaultLibraryName name ZLibcompressDefaultExportName; +function compress2; external ZLibDefaultLibraryName name ZLibcompress2DefaultExportName; +function compressBound; external ZLibDefaultLibraryName name ZLibcompressBoundDefaultExportName; +function uncompress; external ZLibDefaultLibraryName name ZLibuncompressDefaultExportName; + +// Checksums +function adler32; external ZLibDefaultLibraryName name ZLibadler32DefaultExportName; +function crc32; external ZLibDefaultLibraryName name ZLibcrc32DefaultExportName; + +function zError; external ZLibDefaultLibraryName name ZLibzErrorDefaultExportName; +function inflateSyncPoint; external ZLibDefaultLibraryName name ZLibinflateSyncPointDefaultExportName; +function get_crc_table; external ZLibDefaultLibraryName name ZLibget_crc_tableDefaultExportName; +{$ENDIF ZLIB_LINKDLL} + +{$ENDIF ~ZLIB_RTL} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/include/crossplatform.inc b/3rdParty/JCL/source/include/crossplatform.inc index 9bb5a1de..89c9a3b7 100644 --- a/3rdParty/JCL/source/include/crossplatform.inc +++ b/3rdParty/JCL/source/include/crossplatform.inc @@ -1,35 +1,35 @@ -{**************************************************************************************************} -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License");} -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is: crossplatform.inc, released on 2004-05-16. } -{ } -{ You may retrieve the latest version of this file at the JCL home page, } -{ located at https://github.com/project-jedi/jcl } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -// This inc file depends on jedi.inc which has to -// be included first (usually indirectly through -// the inclusion of jcl.inc). - -// Suppress platform warnings which are irrelevant -// because the including unit inherently has to handle -// platform specifics already. - -{$IFDEF SUPPORTS_PLATFORM_WARNINGS} - {$WARN UNIT_PLATFORM OFF} - {$WARN SYMBOL_PLATFORM OFF} +{**************************************************************************************************} +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License");} +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is: crossplatform.inc, released on 2004-05-16. } +{ } +{ You may retrieve the latest version of this file at the JCL home page, } +{ located at https://github.com/project-jedi/jcl } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +// This inc file depends on jedi.inc which has to +// be included first (usually indirectly through +// the inclusion of jcl.inc). + +// Suppress platform warnings which are irrelevant +// because the including unit inherently has to handle +// platform specifics already. + +{$IFDEF SUPPORTS_PLATFORM_WARNINGS} + {$WARN UNIT_PLATFORM OFF} + {$WARN SYMBOL_PLATFORM OFF} {$ENDIF SUPPORTS_PLATFORM_WARNINGS} \ No newline at end of file diff --git a/3rdParty/JCL/source/include/jcl.inc b/3rdParty/JCL/source/include/jcl.inc index b23ecd20..afd4c249 100644 --- a/3rdParty/JCL/source/include/jcl.inc +++ b/3rdParty/JCL/source/include/jcl.inc @@ -443,6 +443,24 @@ ALERT_jedi_inc_incompatible {$ENDIF MSWINDOWS} {$ENDIF BDS23} {----------------------------} + {$IFDEF BDS37} + {$IFDEF MSWINDOWS} + {$IFDEF CPUX86} + // This file should be located in directory jcl/source/include + // It is automatically created by the JCL installer + // For manual installations, copy and adjust jcl/source/include/jcl.template.inc + {$I jcld37win32.inc} + {$ENDIF CPUX86} + {$IFDEF CPUX64} + // This file should be located in directory jcl/source/include + // It is automatically created by the JCL installer + // For manual installations, copy and adjust jcl/source/include/jcl.template.inc + {$I jcld37win64.inc} + {$ENDIF CPUX64} + {$DEFINE JCL_CONFIGURED} + {$ENDIF MSWINDOWS} + {$ENDIF BDS37} + {----------------------------} {$IFDEF FPC} // This file should be located in directory jcl/source/include // It is automatically created by the JCL installer diff --git a/3rdParty/JCL/source/include/jcl.template.inc b/3rdParty/JCL/source/include/jcl.template.inc index aa6ea3bc..053ad96c 100644 --- a/3rdParty/JCL/source/include/jcl.template.inc +++ b/3rdParty/JCL/source/include/jcl.template.inc @@ -1,141 +1,141 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is jcl.inc } -{ } -{ The Initial Developer of the Original Code is Marcel van Brakel. } -{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. } -{ } -{ Contributors: } -{ Marcel van Brakel } -{ Matthias Thoma (mthoma) } -{ Petr Vones } -{ Robert Marquardt (marquardt) } -{ Robert Rossmair (rrossmair) } -{ Florent Ouchet (outchy) } -{ } -{**************************************************************************************************} -{ } -{ This include file defines various JCL specific defines. } -{ The more generic JCL defines are defined in jcl.inc and the generic defines in the jedi.inc file } -{ which is shared with the JEDI VCL. } -{ } -{**************************************************************************************************} -{ } -{ This file is filled by the JCL installer, all the changes made in its content will be lost the } -{ next time the JCL is installed. } -{ } -{**************************************************************************************************} - -// $Id$ - -// Math precision selection, mutually exclusive -// FPC does not support EXTENDED when targetting x86_64, MATH_DOUBLE_PRECISION is the default in this situation -{.$DEFINE MATH_EXTENDED_PRECISION} // default -{.$DEFINE MATH_DOUBLE_PRECISION} -{.$DEFINE MATH_SINGLE_PRECISION} - - -// Math functions takes care of infinites and NaN -{.$DEFINE MATH_EXT_EXTREMEVALUES} - - -// JclHookExcept support for hooking exceptions from DLLs -{.$DEFINE HOOK_DLL_EXCEPTIONS} - - -//Threadsafe directive -{.$DEFINE THREADSAFE} - - -// To exclude obsolete code from compilation, remove the point from the line below -{.$DEFINE DROP_OBSOLETE_CODE} - - -//Support for JclUnitVersioning.pas, not supported by Delphi 2005 (automatically disabled afterward) -{.$DEFINE UNITVERSIONING} - - -// debug sources -// defining these symbols will the debug source to be automatically registered -{.$DEFINE DEBUG_NO_BINARY} -{.$DEFINE DEBUG_NO_TD32} // automatically defined for FPC -{.$DEFINE DEBUG_NO_MAP} -{.$DEFINE DEBUG_NO_EXPORTS} -{.$DEFINE DEBUG_NO_SYMBOLS} - - -// PCRE options, mutually exclusive -// IMPORTANT: The static link works only for Delphi 2005 and newer -// (an internal error is raised on other compilers) -// Only one of the following defines can be defined at a time -// static link: PCRE_STATICLINK -// static dll import: PCRE_LINKDLL -// dynamic dll import: PCRE_LINKONREQUEST -// RTL's RegularExpressionsAPI: PCRE_RTL - -{.$DEFINE PCRE_STATICLINK} -{.$DEFINE PCRE_LINKDLL} -{.$DEFINE PCRE_LINKONREQUEST} // default -{.$DEFINE PCRE_RTL} // DXE and newer - -// ANSI/UTF8 PCRE -{$DEFINE PCRE_8} -// UCS2/UTF16 enabled PCRE -{$DEFINE PCRE_16} // only valid when PCRE_STATICLINK is enabled, the RTL does not support it and the DLL found over the internet are completly outdated. - -// use PCRE16 when available rather than good old PCRE8 -{$DEFINE PCRE_PREFER_16} - -// BZIP2 options, mutually exclusive - -{.$DEFINE BZIP2_STATICLINK} // default -{.$DEFINE BZIP2_LINKDLL} -{.$DEFINE BZIP2_LINKONREQUEST} - - -// ZLIB options, mutually exclusive - -{.$DEFINE ZLIB_STATICLINK} // default -{.$DEFINE ZLIB_LINKDLL} -{.$DEFINE ZLIB_LINKONREQUEST} -{.$DEFINE ZLIB_RTL} // DXE2 and newer only - - -// Unicode options -// use RTL Character Database rather than JCL one, less accurate but reduce executable size -{.$DEFINE UNICODE_RTL_DATABASE} - -// insert a replacement character if sequence is corrupted rather than raising an exception -{.$DEFINE UNICODE_SILENT_FAILURE} - -// defines resource compression (uncompressed, compressed with ZLib, compressed with BZip2), mutually exclusive -{.$DEFINE UNICODE_RAW_DATA} // default -{.$DEFINE UNICODE_ZLIB_DATA} -{.$DEFINE UNICODE_BZIP2_DATA} - - -// container options -// define mapping of TJclStr* containers to TJclAnsiStr* or TJclWideStr* (mutually exclusive) -{.$DEFINE CONTAINER_ANSISTR} // default for D2007 and older -{.$DEFINE CONTAINER_WIDESTR} -{.$DEFINE CONTAINER_UNICODESTR} // default for D2009 and newer, not supported for Delphi 2007 and older -{.$DEFINE CONTAINER_NOSTR} - - -// 7Zip options, mutually exclusive -// IMPORTANT: The static link is not supported yet - -{.$DEFINE 7ZIP_STATICLINK} // not supported yet -{.$DEFINE 7ZIP_LINKDLL} -{.$DEFINE 7ZIP_LINKONREQUEST} // default - +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is jcl.inc } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. } +{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. } +{ } +{ Contributors: } +{ Marcel van Brakel } +{ Matthias Thoma (mthoma) } +{ Petr Vones } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ This include file defines various JCL specific defines. } +{ The more generic JCL defines are defined in jcl.inc and the generic defines in the jedi.inc file } +{ which is shared with the JEDI VCL. } +{ } +{**************************************************************************************************} +{ } +{ This file is filled by the JCL installer, all the changes made in its content will be lost the } +{ next time the JCL is installed. } +{ } +{**************************************************************************************************} + +// $Id$ + +// Math precision selection, mutually exclusive +// FPC does not support EXTENDED when targetting x86_64, MATH_DOUBLE_PRECISION is the default in this situation +{.$DEFINE MATH_EXTENDED_PRECISION} // default +{.$DEFINE MATH_DOUBLE_PRECISION} +{.$DEFINE MATH_SINGLE_PRECISION} + + +// Math functions takes care of infinites and NaN +{.$DEFINE MATH_EXT_EXTREMEVALUES} + + +// JclHookExcept support for hooking exceptions from DLLs +{.$DEFINE HOOK_DLL_EXCEPTIONS} + + +//Threadsafe directive +{.$DEFINE THREADSAFE} + + +// To exclude obsolete code from compilation, remove the point from the line below +{.$DEFINE DROP_OBSOLETE_CODE} + + +//Support for JclUnitVersioning.pas, not supported by Delphi 2005 (automatically disabled afterward) +{.$DEFINE UNITVERSIONING} + + +// debug sources +// defining these symbols will the debug source to be automatically registered +{.$DEFINE DEBUG_NO_BINARY} +{.$DEFINE DEBUG_NO_TD32} // automatically defined for FPC +{.$DEFINE DEBUG_NO_MAP} +{.$DEFINE DEBUG_NO_EXPORTS} +{.$DEFINE DEBUG_NO_SYMBOLS} + + +// PCRE options, mutually exclusive +// IMPORTANT: The static link works only for Delphi 2005 and newer +// (an internal error is raised on other compilers) +// Only one of the following defines can be defined at a time +// static link: PCRE_STATICLINK +// static dll import: PCRE_LINKDLL +// dynamic dll import: PCRE_LINKONREQUEST +// RTL's RegularExpressionsAPI: PCRE_RTL + +{.$DEFINE PCRE_STATICLINK} +{.$DEFINE PCRE_LINKDLL} +{.$DEFINE PCRE_LINKONREQUEST} // default +{.$DEFINE PCRE_RTL} // DXE and newer + +// ANSI/UTF8 PCRE +{$DEFINE PCRE_8} +// UCS2/UTF16 enabled PCRE +{$DEFINE PCRE_16} // only valid when PCRE_STATICLINK is enabled, the RTL does not support it and the DLL found over the internet are completly outdated. + +// use PCRE16 when available rather than good old PCRE8 +{$DEFINE PCRE_PREFER_16} + +// BZIP2 options, mutually exclusive + +{.$DEFINE BZIP2_STATICLINK} // default +{.$DEFINE BZIP2_LINKDLL} +{.$DEFINE BZIP2_LINKONREQUEST} + + +// ZLIB options, mutually exclusive + +{.$DEFINE ZLIB_STATICLINK} // default +{.$DEFINE ZLIB_LINKDLL} +{.$DEFINE ZLIB_LINKONREQUEST} +{.$DEFINE ZLIB_RTL} // DXE2 and newer only + + +// Unicode options +// use RTL Character Database rather than JCL one, less accurate but reduce executable size +{.$DEFINE UNICODE_RTL_DATABASE} + +// insert a replacement character if sequence is corrupted rather than raising an exception +{.$DEFINE UNICODE_SILENT_FAILURE} + +// defines resource compression (uncompressed, compressed with ZLib, compressed with BZip2), mutually exclusive +{.$DEFINE UNICODE_RAW_DATA} // default +{.$DEFINE UNICODE_ZLIB_DATA} +{.$DEFINE UNICODE_BZIP2_DATA} + + +// container options +// define mapping of TJclStr* containers to TJclAnsiStr* or TJclWideStr* (mutually exclusive) +{.$DEFINE CONTAINER_ANSISTR} // default for D2007 and older +{.$DEFINE CONTAINER_WIDESTR} +{.$DEFINE CONTAINER_UNICODESTR} // default for D2009 and newer, not supported for Delphi 2007 and older +{.$DEFINE CONTAINER_NOSTR} + + +// 7Zip options, mutually exclusive +// IMPORTANT: The static link is not supported yet + +{.$DEFINE 7ZIP_STATICLINK} // not supported yet +{.$DEFINE 7ZIP_LINKDLL} +{.$DEFINE 7ZIP_LINKONREQUEST} // default + diff --git a/3rdParty/JCL/source/include/jcld29win32.inc b/3rdParty/JCL/source/include/jcld29win32.inc index 053ad96c..b1772654 100644 --- a/3rdParty/JCL/source/include/jcld29win32.inc +++ b/3rdParty/JCL/source/include/jcld29win32.inc @@ -40,13 +40,13 @@ // Math precision selection, mutually exclusive // FPC does not support EXTENDED when targetting x86_64, MATH_DOUBLE_PRECISION is the default in this situation -{.$DEFINE MATH_EXTENDED_PRECISION} // default +{$DEFINE MATH_EXTENDED_PRECISION} // default {.$DEFINE MATH_DOUBLE_PRECISION} {.$DEFINE MATH_SINGLE_PRECISION} // Math functions takes care of infinites and NaN -{.$DEFINE MATH_EXT_EXTREMEVALUES} +{$DEFINE MATH_EXT_EXTREMEVALUES} // JclHookExcept support for hooking exceptions from DLLs @@ -54,11 +54,11 @@ //Threadsafe directive -{.$DEFINE THREADSAFE} +{$DEFINE THREADSAFE} // To exclude obsolete code from compilation, remove the point from the line below -{.$DEFINE DROP_OBSOLETE_CODE} +{$DEFINE DROP_OBSOLETE_CODE} //Support for JclUnitVersioning.pas, not supported by Delphi 2005 (automatically disabled afterward) @@ -83,7 +83,7 @@ // dynamic dll import: PCRE_LINKONREQUEST // RTL's RegularExpressionsAPI: PCRE_RTL -{.$DEFINE PCRE_STATICLINK} +{$DEFINE PCRE_STATICLINK} {.$DEFINE PCRE_LINKDLL} {.$DEFINE PCRE_LINKONREQUEST} // default {.$DEFINE PCRE_RTL} // DXE and newer @@ -91,21 +91,21 @@ // ANSI/UTF8 PCRE {$DEFINE PCRE_8} // UCS2/UTF16 enabled PCRE -{$DEFINE PCRE_16} // only valid when PCRE_STATICLINK is enabled, the RTL does not support it and the DLL found over the internet are completly outdated. +{.$DEFINE PCRE_16} // only valid when PCRE_STATICLINK is enabled, the RTL does not support it and the DLL found over the internet are completly outdated. // use PCRE16 when available rather than good old PCRE8 -{$DEFINE PCRE_PREFER_16} +{.$DEFINE PCRE_PREFER_16} // BZIP2 options, mutually exclusive -{.$DEFINE BZIP2_STATICLINK} // default +{$DEFINE BZIP2_STATICLINK} // default {.$DEFINE BZIP2_LINKDLL} {.$DEFINE BZIP2_LINKONREQUEST} // ZLIB options, mutually exclusive -{.$DEFINE ZLIB_STATICLINK} // default +{$DEFINE ZLIB_STATICLINK} // default {.$DEFINE ZLIB_LINKDLL} {.$DEFINE ZLIB_LINKONREQUEST} {.$DEFINE ZLIB_RTL} // DXE2 and newer only @@ -116,10 +116,10 @@ {.$DEFINE UNICODE_RTL_DATABASE} // insert a replacement character if sequence is corrupted rather than raising an exception -{.$DEFINE UNICODE_SILENT_FAILURE} +{$DEFINE UNICODE_SILENT_FAILURE} // defines resource compression (uncompressed, compressed with ZLib, compressed with BZip2), mutually exclusive -{.$DEFINE UNICODE_RAW_DATA} // default +{$DEFINE UNICODE_RAW_DATA} // default {.$DEFINE UNICODE_ZLIB_DATA} {.$DEFINE UNICODE_BZIP2_DATA} @@ -128,7 +128,7 @@ // define mapping of TJclStr* containers to TJclAnsiStr* or TJclWideStr* (mutually exclusive) {.$DEFINE CONTAINER_ANSISTR} // default for D2007 and older {.$DEFINE CONTAINER_WIDESTR} -{.$DEFINE CONTAINER_UNICODESTR} // default for D2009 and newer, not supported for Delphi 2007 and older +{$DEFINE CONTAINER_UNICODESTR} // default for D2009 and newer, not supported for Delphi 2007 and older {.$DEFINE CONTAINER_NOSTR} @@ -137,5 +137,5 @@ {.$DEFINE 7ZIP_STATICLINK} // not supported yet {.$DEFINE 7ZIP_LINKDLL} -{.$DEFINE 7ZIP_LINKONREQUEST} // default +{$DEFINE 7ZIP_LINKONREQUEST} // default diff --git a/3rdParty/JCL/source/include/jcld29win64.inc b/3rdParty/JCL/source/include/jcld29win64.inc index 053ad96c..b1772654 100644 --- a/3rdParty/JCL/source/include/jcld29win64.inc +++ b/3rdParty/JCL/source/include/jcld29win64.inc @@ -40,13 +40,13 @@ // Math precision selection, mutually exclusive // FPC does not support EXTENDED when targetting x86_64, MATH_DOUBLE_PRECISION is the default in this situation -{.$DEFINE MATH_EXTENDED_PRECISION} // default +{$DEFINE MATH_EXTENDED_PRECISION} // default {.$DEFINE MATH_DOUBLE_PRECISION} {.$DEFINE MATH_SINGLE_PRECISION} // Math functions takes care of infinites and NaN -{.$DEFINE MATH_EXT_EXTREMEVALUES} +{$DEFINE MATH_EXT_EXTREMEVALUES} // JclHookExcept support for hooking exceptions from DLLs @@ -54,11 +54,11 @@ //Threadsafe directive -{.$DEFINE THREADSAFE} +{$DEFINE THREADSAFE} // To exclude obsolete code from compilation, remove the point from the line below -{.$DEFINE DROP_OBSOLETE_CODE} +{$DEFINE DROP_OBSOLETE_CODE} //Support for JclUnitVersioning.pas, not supported by Delphi 2005 (automatically disabled afterward) @@ -83,7 +83,7 @@ // dynamic dll import: PCRE_LINKONREQUEST // RTL's RegularExpressionsAPI: PCRE_RTL -{.$DEFINE PCRE_STATICLINK} +{$DEFINE PCRE_STATICLINK} {.$DEFINE PCRE_LINKDLL} {.$DEFINE PCRE_LINKONREQUEST} // default {.$DEFINE PCRE_RTL} // DXE and newer @@ -91,21 +91,21 @@ // ANSI/UTF8 PCRE {$DEFINE PCRE_8} // UCS2/UTF16 enabled PCRE -{$DEFINE PCRE_16} // only valid when PCRE_STATICLINK is enabled, the RTL does not support it and the DLL found over the internet are completly outdated. +{.$DEFINE PCRE_16} // only valid when PCRE_STATICLINK is enabled, the RTL does not support it and the DLL found over the internet are completly outdated. // use PCRE16 when available rather than good old PCRE8 -{$DEFINE PCRE_PREFER_16} +{.$DEFINE PCRE_PREFER_16} // BZIP2 options, mutually exclusive -{.$DEFINE BZIP2_STATICLINK} // default +{$DEFINE BZIP2_STATICLINK} // default {.$DEFINE BZIP2_LINKDLL} {.$DEFINE BZIP2_LINKONREQUEST} // ZLIB options, mutually exclusive -{.$DEFINE ZLIB_STATICLINK} // default +{$DEFINE ZLIB_STATICLINK} // default {.$DEFINE ZLIB_LINKDLL} {.$DEFINE ZLIB_LINKONREQUEST} {.$DEFINE ZLIB_RTL} // DXE2 and newer only @@ -116,10 +116,10 @@ {.$DEFINE UNICODE_RTL_DATABASE} // insert a replacement character if sequence is corrupted rather than raising an exception -{.$DEFINE UNICODE_SILENT_FAILURE} +{$DEFINE UNICODE_SILENT_FAILURE} // defines resource compression (uncompressed, compressed with ZLib, compressed with BZip2), mutually exclusive -{.$DEFINE UNICODE_RAW_DATA} // default +{$DEFINE UNICODE_RAW_DATA} // default {.$DEFINE UNICODE_ZLIB_DATA} {.$DEFINE UNICODE_BZIP2_DATA} @@ -128,7 +128,7 @@ // define mapping of TJclStr* containers to TJclAnsiStr* or TJclWideStr* (mutually exclusive) {.$DEFINE CONTAINER_ANSISTR} // default for D2007 and older {.$DEFINE CONTAINER_WIDESTR} -{.$DEFINE CONTAINER_UNICODESTR} // default for D2009 and newer, not supported for Delphi 2007 and older +{$DEFINE CONTAINER_UNICODESTR} // default for D2009 and newer, not supported for Delphi 2007 and older {.$DEFINE CONTAINER_NOSTR} @@ -137,5 +137,5 @@ {.$DEFINE 7ZIP_STATICLINK} // not supported yet {.$DEFINE 7ZIP_LINKDLL} -{.$DEFINE 7ZIP_LINKONREQUEST} // default +{$DEFINE 7ZIP_LINKONREQUEST} // default diff --git a/3rdParty/JCL/source/include/jcld37win32.inc b/3rdParty/JCL/source/include/jcld37win32.inc new file mode 100644 index 00000000..b1772654 --- /dev/null +++ b/3rdParty/JCL/source/include/jcld37win32.inc @@ -0,0 +1,141 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is jcl.inc } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. } +{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. } +{ } +{ Contributors: } +{ Marcel van Brakel } +{ Matthias Thoma (mthoma) } +{ Petr Vones } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ This include file defines various JCL specific defines. } +{ The more generic JCL defines are defined in jcl.inc and the generic defines in the jedi.inc file } +{ which is shared with the JEDI VCL. } +{ } +{**************************************************************************************************} +{ } +{ This file is filled by the JCL installer, all the changes made in its content will be lost the } +{ next time the JCL is installed. } +{ } +{**************************************************************************************************} + +// $Id$ + +// Math precision selection, mutually exclusive +// FPC does not support EXTENDED when targetting x86_64, MATH_DOUBLE_PRECISION is the default in this situation +{$DEFINE MATH_EXTENDED_PRECISION} // default +{.$DEFINE MATH_DOUBLE_PRECISION} +{.$DEFINE MATH_SINGLE_PRECISION} + + +// Math functions takes care of infinites and NaN +{$DEFINE MATH_EXT_EXTREMEVALUES} + + +// JclHookExcept support for hooking exceptions from DLLs +{.$DEFINE HOOK_DLL_EXCEPTIONS} + + +//Threadsafe directive +{$DEFINE THREADSAFE} + + +// To exclude obsolete code from compilation, remove the point from the line below +{$DEFINE DROP_OBSOLETE_CODE} + + +//Support for JclUnitVersioning.pas, not supported by Delphi 2005 (automatically disabled afterward) +{.$DEFINE UNITVERSIONING} + + +// debug sources +// defining these symbols will the debug source to be automatically registered +{.$DEFINE DEBUG_NO_BINARY} +{.$DEFINE DEBUG_NO_TD32} // automatically defined for FPC +{.$DEFINE DEBUG_NO_MAP} +{.$DEFINE DEBUG_NO_EXPORTS} +{.$DEFINE DEBUG_NO_SYMBOLS} + + +// PCRE options, mutually exclusive +// IMPORTANT: The static link works only for Delphi 2005 and newer +// (an internal error is raised on other compilers) +// Only one of the following defines can be defined at a time +// static link: PCRE_STATICLINK +// static dll import: PCRE_LINKDLL +// dynamic dll import: PCRE_LINKONREQUEST +// RTL's RegularExpressionsAPI: PCRE_RTL + +{$DEFINE PCRE_STATICLINK} +{.$DEFINE PCRE_LINKDLL} +{.$DEFINE PCRE_LINKONREQUEST} // default +{.$DEFINE PCRE_RTL} // DXE and newer + +// ANSI/UTF8 PCRE +{$DEFINE PCRE_8} +// UCS2/UTF16 enabled PCRE +{.$DEFINE PCRE_16} // only valid when PCRE_STATICLINK is enabled, the RTL does not support it and the DLL found over the internet are completly outdated. + +// use PCRE16 when available rather than good old PCRE8 +{.$DEFINE PCRE_PREFER_16} + +// BZIP2 options, mutually exclusive + +{$DEFINE BZIP2_STATICLINK} // default +{.$DEFINE BZIP2_LINKDLL} +{.$DEFINE BZIP2_LINKONREQUEST} + + +// ZLIB options, mutually exclusive + +{$DEFINE ZLIB_STATICLINK} // default +{.$DEFINE ZLIB_LINKDLL} +{.$DEFINE ZLIB_LINKONREQUEST} +{.$DEFINE ZLIB_RTL} // DXE2 and newer only + + +// Unicode options +// use RTL Character Database rather than JCL one, less accurate but reduce executable size +{.$DEFINE UNICODE_RTL_DATABASE} + +// insert a replacement character if sequence is corrupted rather than raising an exception +{$DEFINE UNICODE_SILENT_FAILURE} + +// defines resource compression (uncompressed, compressed with ZLib, compressed with BZip2), mutually exclusive +{$DEFINE UNICODE_RAW_DATA} // default +{.$DEFINE UNICODE_ZLIB_DATA} +{.$DEFINE UNICODE_BZIP2_DATA} + + +// container options +// define mapping of TJclStr* containers to TJclAnsiStr* or TJclWideStr* (mutually exclusive) +{.$DEFINE CONTAINER_ANSISTR} // default for D2007 and older +{.$DEFINE CONTAINER_WIDESTR} +{$DEFINE CONTAINER_UNICODESTR} // default for D2009 and newer, not supported for Delphi 2007 and older +{.$DEFINE CONTAINER_NOSTR} + + +// 7Zip options, mutually exclusive +// IMPORTANT: The static link is not supported yet + +{.$DEFINE 7ZIP_STATICLINK} // not supported yet +{.$DEFINE 7ZIP_LINKDLL} +{$DEFINE 7ZIP_LINKONREQUEST} // default + diff --git a/3rdParty/JCL/source/include/jcld37win64.inc b/3rdParty/JCL/source/include/jcld37win64.inc new file mode 100644 index 00000000..b1772654 --- /dev/null +++ b/3rdParty/JCL/source/include/jcld37win64.inc @@ -0,0 +1,141 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is jcl.inc } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. } +{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. } +{ } +{ Contributors: } +{ Marcel van Brakel } +{ Matthias Thoma (mthoma) } +{ Petr Vones } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ This include file defines various JCL specific defines. } +{ The more generic JCL defines are defined in jcl.inc and the generic defines in the jedi.inc file } +{ which is shared with the JEDI VCL. } +{ } +{**************************************************************************************************} +{ } +{ This file is filled by the JCL installer, all the changes made in its content will be lost the } +{ next time the JCL is installed. } +{ } +{**************************************************************************************************} + +// $Id$ + +// Math precision selection, mutually exclusive +// FPC does not support EXTENDED when targetting x86_64, MATH_DOUBLE_PRECISION is the default in this situation +{$DEFINE MATH_EXTENDED_PRECISION} // default +{.$DEFINE MATH_DOUBLE_PRECISION} +{.$DEFINE MATH_SINGLE_PRECISION} + + +// Math functions takes care of infinites and NaN +{$DEFINE MATH_EXT_EXTREMEVALUES} + + +// JclHookExcept support for hooking exceptions from DLLs +{.$DEFINE HOOK_DLL_EXCEPTIONS} + + +//Threadsafe directive +{$DEFINE THREADSAFE} + + +// To exclude obsolete code from compilation, remove the point from the line below +{$DEFINE DROP_OBSOLETE_CODE} + + +//Support for JclUnitVersioning.pas, not supported by Delphi 2005 (automatically disabled afterward) +{.$DEFINE UNITVERSIONING} + + +// debug sources +// defining these symbols will the debug source to be automatically registered +{.$DEFINE DEBUG_NO_BINARY} +{.$DEFINE DEBUG_NO_TD32} // automatically defined for FPC +{.$DEFINE DEBUG_NO_MAP} +{.$DEFINE DEBUG_NO_EXPORTS} +{.$DEFINE DEBUG_NO_SYMBOLS} + + +// PCRE options, mutually exclusive +// IMPORTANT: The static link works only for Delphi 2005 and newer +// (an internal error is raised on other compilers) +// Only one of the following defines can be defined at a time +// static link: PCRE_STATICLINK +// static dll import: PCRE_LINKDLL +// dynamic dll import: PCRE_LINKONREQUEST +// RTL's RegularExpressionsAPI: PCRE_RTL + +{$DEFINE PCRE_STATICLINK} +{.$DEFINE PCRE_LINKDLL} +{.$DEFINE PCRE_LINKONREQUEST} // default +{.$DEFINE PCRE_RTL} // DXE and newer + +// ANSI/UTF8 PCRE +{$DEFINE PCRE_8} +// UCS2/UTF16 enabled PCRE +{.$DEFINE PCRE_16} // only valid when PCRE_STATICLINK is enabled, the RTL does not support it and the DLL found over the internet are completly outdated. + +// use PCRE16 when available rather than good old PCRE8 +{.$DEFINE PCRE_PREFER_16} + +// BZIP2 options, mutually exclusive + +{$DEFINE BZIP2_STATICLINK} // default +{.$DEFINE BZIP2_LINKDLL} +{.$DEFINE BZIP2_LINKONREQUEST} + + +// ZLIB options, mutually exclusive + +{$DEFINE ZLIB_STATICLINK} // default +{.$DEFINE ZLIB_LINKDLL} +{.$DEFINE ZLIB_LINKONREQUEST} +{.$DEFINE ZLIB_RTL} // DXE2 and newer only + + +// Unicode options +// use RTL Character Database rather than JCL one, less accurate but reduce executable size +{.$DEFINE UNICODE_RTL_DATABASE} + +// insert a replacement character if sequence is corrupted rather than raising an exception +{$DEFINE UNICODE_SILENT_FAILURE} + +// defines resource compression (uncompressed, compressed with ZLib, compressed with BZip2), mutually exclusive +{$DEFINE UNICODE_RAW_DATA} // default +{.$DEFINE UNICODE_ZLIB_DATA} +{.$DEFINE UNICODE_BZIP2_DATA} + + +// container options +// define mapping of TJclStr* containers to TJclAnsiStr* or TJclWideStr* (mutually exclusive) +{.$DEFINE CONTAINER_ANSISTR} // default for D2007 and older +{.$DEFINE CONTAINER_WIDESTR} +{$DEFINE CONTAINER_UNICODESTR} // default for D2009 and newer, not supported for Delphi 2007 and older +{.$DEFINE CONTAINER_NOSTR} + + +// 7Zip options, mutually exclusive +// IMPORTANT: The static link is not supported yet + +{.$DEFINE 7ZIP_STATICLINK} // not supported yet +{.$DEFINE 7ZIP_LINKDLL} +{$DEFINE 7ZIP_LINKONREQUEST} // default + diff --git a/3rdParty/JCL/source/include/jedi/jedi.inc b/3rdParty/JCL/source/include/jedi/jedi.inc index 0b973f7b..74774492 100644 --- a/3rdParty/JCL/source/include/jedi/jedi.inc +++ b/3rdParty/JCL/source/include/jedi/jedi.inc @@ -1,2116 +1,2231 @@ -{$IFNDEF JEDI_INC} -{$DEFINE JEDI_INC} - -{**************************************************************************************************} -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License");} -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is: jedi.inc. } -{ The Initial Developer of the Original Code is Project JEDI http://www.delphi-jedi.org } -{ } -{ Alternatively, the contents of this file may be used under the terms of the GNU Lesser General } -{ Public License (the "LGPL License"), in which case the provisions of the LGPL License are } -{ applicable instead of those above. If you wish to allow use of your version of this file only } -{ under the terms of the LGPL License and not to allow others to use your version of this file } -{ under the MPL, indicate your decision by deleting the provisions above and replace them with } -{ the notice and other provisions required by the LGPL License. If you do not delete the } -{ provisions above, a recipient may use your version of this file under either the MPL or the } -{ LGPL License. } -{ } -{ For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html } -{ } -{**************************************************************************************************} -{ } -{ This file defines various generic compiler directives used in different libraries, e.g. in the } -{ JEDI Code Library (JCL) and JEDI Visual Component Library Library (JVCL). The directives in } -{ this file are of generic nature and consist mostly of mappings from the VERXXX directives } -{ defined by Delphi, C++Builder and FPC to friendly names such as DELPHI5 and } -{ SUPPORTS_WIDESTRING. These friendly names are subsequently used in the libraries to test for } -{ compiler versions and/or whether the compiler supports certain features (such as widestrings or } -{ 64 bit integers. The libraries provide an additional, library specific, include file. For the } -{ JCL e.g. this is jcl.inc. These files should be included in source files instead of this file } -{ (which is pulled in automatically). } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -(* - -- Development environment directives - - This file defines two directives to indicate which development environment the - library is being compiled with. Currently this can either be Delphi, Kylix, - C++Builder or FPC. - - Directive Description - ------------------------------------------------------------------------------ - DELPHI Defined if compiled with Delphi - KYLIX Defined if compiled with Kylix - DELPHICOMPILER Defined if compiled with Delphi or Kylix/Delphi - BCB Defined if compiled with C++Builder - CPPBUILDER Defined if compiled with C++Builder (alias for BCB) - BCBCOMPILER Defined if compiled with C++Builder or Kylix/C++ - DELPHILANGUAGE Defined if compiled with Delphi, Kylix or C++Builder - BORLAND Defined if compiled with Delphi, Kylix or C++Builder - FPC Defined if compiled with FPC - -- Platform Directives - - Platform directives are not all explicitly defined in this file, some are - defined by the compiler itself. They are listed here only for completeness. - - Directive Description - ------------------------------------------------------------------------------ - WIN32 Defined when target platform is 32 bit Windows - WIN64 Defined when target platform is 64 bit Windows - MSWINDOWS Defined when target platform is 32 bit Windows - LINUX Defined when target platform is Linux - UNIX Defined when target platform is Unix-like (including Linux) - CLR Defined when target platform is .NET - -- Architecture directives. These are auto-defined by FPC - CPU32 and CPU64 are mostly for generic pointer size dependant differences rather - than for a specific architecture. - - CPU386 Defined when target platform is native x86 (win32) - CPUx86_64 Defined when target platform is native x86_64 (win64) - CPU32 Defined when target is 32-bit - CPU64 Defined when target is 64-bit - CPUASM Defined when target assembler is available - -- Visual library Directives - - The following directives indicate for a visual library. In a Delphi/BCB - (Win32) application you need to define the VisualCLX symbol in the project - options, if you want to use the VisualCLX library. Alternatively you can use - the IDE expert, which is distributed with the JCL to do this automatically. - - Directive Description - ------------------------------------------------------------------------------ - VCL Defined for Delphi/BCB (Win32) exactly if VisualCLX is not defined - VisualCLX Defined for Kylix; needs to be defined for Delphi/BCB to - use JCL with VisualCLX applications. - - -- Other cross-platform related defines - - These symbols are intended to help in writing portable code. - - Directive Description - ------------------------------------------------------------------------------ - PUREPASCAL Code is machine-independent (as opposed to assembler code) - Win32API Code is specific for the Win32 API; - use instead of "{$IFNDEF CLR} {$IFDEF MSWINDOWS}" constructs - - -- Delphi Versions - - The following directives are direct mappings from the VERXXX directives to a - friendly name of the associated compiler. These directives are only defined if - the compiler is Delphi (ie DELPHI is defined). - - Directive Description - ------------------------------------------------------------------------------ - DELPHI1 Defined when compiling with Delphi 1 (Codename WASABI/MANGO) - DELPHI2 Defined when compiling with Delphi 2 (Codename POLARIS) - DELPHI3 Defined when compiling with Delphi 3 (Codename IVORY) - DELPHI4 Defined when compiling with Delphi 4 (Codename ALLEGRO) - DELPHI5 Defined when compiling with Delphi 5 (Codename ARGUS) - DELPHI6 Defined when compiling with Delphi 6 (Codename ILLIAD) - DELPHI7 Defined when compiling with Delphi 7 (Codename AURORA) - DELPHI8 Defined when compiling with Delphi 8 (Codename OCTANE) - DELPHI2005 Defined when compiling with Delphi 2005 (Codename DIAMONDBACK) - DELPHI9 Alias for DELPHI2005 - DELPHI10 Defined when compiling with Delphi 2006 (Codename DEXTER) - DELPHI2006 Alias for DELPHI10 - DELPHI11 Defined when compiling with Delphi 2007 for Win32 (Codename SPACELY) - DELPHI2007 Alias for DELPHI11 - DELPHI12 Defined when compiling with Delphi 2009 for Win32 (Codename TIBURON) - DELPHI2009 Alias for DELPHI12 - DELPHI14 Defined when compiling with Delphi 2010 for Win32 (Codename WEAVER) - DELPHI2010 Alias for DELPHI14 - DELPHI15 Defined when compiling with Delphi XE for Win32 (Codename FULCRUM) - DELPHIXE Alias for DELPHI15 - DELPHI16 Defined when compiling with Delphi XE2 for Win32 (Codename PULSAR) - DELPHIXE2 Alias for DELPHI16 - DELPHI17 Defined when compiling with Delphi XE3 for Win32 (Codename WATERDRAGON) - DELPHIXE3 Alias for DELPHI17 - DELPHI18 Defined when compiling with Delphi XE4 for Win32 (Codename QUINTESSENCE) - DELPHIXE4 Alias for DELPHI18 - DELPHI19 Defined when compiling with Delphi XE5 for Win32 (Codename ZEPHYR) - DELPHIXE5 Alias for DELPHI19 - DELPHI20 Defined when compiling with Delphi XE6 for Win32 (Codename PROTEUS) - DELPHIXE6 Alias for DELPHI20 - DELPHI21 Defined when compiling with Delphi XE7 for Win32 (Codename CARPATHIA) - DELPHIXE7 Alias for DELPHI21 - DELPHI22 Defined when compiling with Delphi XE8 for Win32 (Codename ELBRUS) - DELPHIXE8 Alias for DELPHI22 - DELPHI23 Defined when compiling with Delphi 10 for Win32 (Codename AITANA) - DELPHIX_SEATTLE Alias for DELPHI23 - DELPHI24 Defined when compiling with Delphi 10.1 for Win32 (Codename BIGBEN) - DELPHIX_BERLIN Alias for DELPHI24 - DELPHI25 Defined when compiling with Delphi 10.2 for Win32 (Codename GODZILLA) - DELPHIX_TOKYO Alias for DELPHI25 - DELPHI26 Defined when compiling with Delphi 10.3 for Win32 (Codename CARNIVAL) - DELPHIX_RIO Alias for DELPHI26 - DELPHI27 Defined when compiling with Delphi 10.4 for Win32 (Codename DENALI) - DELPHIX_SYDNEY Alias for DELPHI27 - DELPHI28 Defined when compiling with Delphi 11 for Win32 (Codename OLYMPUS) - DELPHIX_ALEXANDRIA Alias for DELPHI28 - DELPHI29 Defined when compiling with Delphi 12 for Win32 (Codename YUKON) - DELPHI_ATHENS Alias for DELPHI29 - DELPHI1_UP Defined when compiling with Delphi 1 or higher - DELPHI2_UP Defined when compiling with Delphi 2 or higher - DELPHI3_UP Defined when compiling with Delphi 3 or higher - DELPHI4_UP Defined when compiling with Delphi 4 or higher - DELPHI5_UP Defined when compiling with Delphi 5 or higher - DELPHI6_UP Defined when compiling with Delphi 6 or higher - DELPHI7_UP Defined when compiling with Delphi 7 or higher - DELPHI8_UP Defined when compiling with Delphi 8 or higher - DELPHI2005_UP Defined when compiling with Delphi 2005 or higher - DELPHI9_UP Alias for DELPHI2005_UP - DELPHI10_UP Defined when compiling with Delphi 2006 or higher - DELPHI2006_UP Alias for DELPHI10_UP - DELPHI11_UP Defined when compiling with Delphi 2007 for Win32 or higher - DELPHI2007_UP Alias for DELPHI11_UP - DELPHI12_UP Defined when compiling with Delphi 2009 for Win32 or higher - DELPHI2009_UP Alias for DELPHI12_UP - DELPHI14_UP Defined when compiling with Delphi 2010 for Win32 or higher - DELPHI2010_UP Alias for DELPHI14_UP - DELPHI15_UP Defined when compiling with Delphi XE for Win32 or higher - DELPHIXE_UP Alias for DELPHI15_UP - DELPHI16_UP Defined when compiling with Delphi XE2 for Win32 or higher - DELPHIXE2_UP Alias for DELPHI16_UP - DELPHI17_UP Defined when compiling with Delphi XE3 for Win32 or higher - DELPHIXE3_UP Alias for DELPHI17_UP - DELPHI18_UP Defined when compiling with Delphi XE4 for Win32 or higher - DELPHIXE4_UP Alias for DELPHI18_UP - DELPHI19_UP Defined when compiling with Delphi XE5 for Win32 or higher - DELPHIXE5_UP Alias for DELPHI19_UP - DELPHI20_UP Defined when compiling with Delphi XE6 for Win32 or higher - DELPHIXE6_UP Alias for DELPHI20_UP - DELPHI21_UP Defined when compiling with Delphi XE7 for Win32 or higher - DELPHIXE7_UP Alias for DELPHI21_UP - DELPHI22_UP Defined when compiling with Delphi XE8 for Win32 or higher - DELPHIXE8_UP Alias for DELPHI22_UP - DELPHI23_UP Defined when compiling with Delphi 10 for Win32 or higher - DELPHIX_SEATTLE_UP Alias for DELPHI23_UP - DELPHI24_UP Defined when compiling with Delphi 10.1 for Win32 or higher - DELPHIX_BERLIN_UP Alias for DELPHI24_UP - DELPHI25_UP Defined when compiling with Delphi 10.2 for Win32 or higher - DELPHIX_TOKYO_UP Alias for DELPHI25_UP - DELPHI26_UP Defined when compiling with Delphi 10.3 for Win32 or higher - DELPHIX_RIO_UP Alias for DELPHI26_UP - DELPHI27_UP Defined when compiling with Delphi 10.4 for Win32 or higher - DELPHIX_SYDNEY_UP Alias for DELPHI27_UP - DELPHI28_UP Defined when compiling with Delphi 11 for Win32 or higher - DELPHIX_ALEXANDRIA_UP Alias for DELPHI28_UP - DELPHI29_UP Defined when compiling with Delphi 12 for Win32 or higher - DELPHI_ATHENS_UP Alias for DELPHI29_UP - - -- Kylix Versions - - The following directives are direct mappings from the VERXXX directives to a - friendly name of the associated compiler. These directives are only defined if - the compiler is Kylix (ie KYLIX is defined). - - Directive Description - ------------------------------------------------------------------------------ - KYLIX1 Defined when compiling with Kylix 1 - KYLIX2 Defined when compiling with Kylix 2 - KYLIX3 Defined when compiling with Kylix 3 (Codename CORTEZ) - KYLIX1_UP Defined when compiling with Kylix 1 or higher - KYLIX2_UP Defined when compiling with Kylix 2 or higher - KYLIX3_UP Defined when compiling with Kylix 3 or higher - - -- Delphi Compiler Versions (Delphi / Kylix, not in BCB mode) - - Directive Description - ------------------------------------------------------------------------------ - DELPHICOMPILER1 Defined when compiling with Delphi 1 - DELPHICOMPILER2 Defined when compiling with Delphi 2 - DELPHICOMPILER3 Defined when compiling with Delphi 3 - DELPHICOMPILER4 Defined when compiling with Delphi 4 - DELPHICOMPILER5 Defined when compiling with Delphi 5 - DELPHICOMPILER6 Defined when compiling with Delphi 6 or Kylix 1, 2 or 3 - DELPHICOMPILER7 Defined when compiling with Delphi 7 - DELPHICOMPILER8 Defined when compiling with Delphi 8 - DELPHICOMPILER9 Defined when compiling with Delphi 2005 - DELPHICOMPILER10 Defined when compiling with Delphi Personality of BDS 4.0 - DELPHICOMPILER11 Defined when compiling with Delphi 2007 for Win32 - DELPHICOMPILER12 Defined when compiling with Delphi Personality of BDS 6.0 - DELPHICOMPILER14 Defined when compiling with Delphi Personality of BDS 7.0 - DELPHICOMPILER15 Defined when compiling with Delphi Personality of BDS 8.0 - DELPHICOMPILER16 Defined when compiling with Delphi Personality of BDS 9.0 - DELPHICOMPILER17 Defined when compiling with Delphi Personality of BDS 10.0 - DELPHICOMPILER18 Defined when compiling with Delphi Personality of BDS 11.0 - DELPHICOMPILER19 Defined when compiling with Delphi Personality of BDS 12.0 - DELPHICOMPILER20 Defined when compiling with Delphi Personality of BDS 14.0 - DELPHICOMPILER21 Defined when compiling with Delphi Personality of BDS 15.0 - DELPHICOMPILER22 Defined when compiling with Delphi Personality of BDS 16.0 - DELPHICOMPILER23 Defined when compiling with Delphi Personality of BDS 17.0 - DELPHICOMPILER24 Defined when compiling with Delphi Personality of BDS 18.0 - DELPHICOMPILER25 Defined when compiling with Delphi Personality of BDS 19.0 - DELPHICOMPILER26 Defined when compiling with Delphi Personality of BDS 20.0 - DELPHICOMPILER27 Defined when compiling with Delphi Personality of BDS 21.0 - DELPHICOMPILER28 Defined when compiling with Delphi Personality of BDS 22.0 - DELPHICOMPILER29 Defined when compiling with Delphi Personality of BDS 23.0 - DELPHICOMPILER1_UP Defined when compiling with Delphi 1 or higher - DELPHICOMPILER2_UP Defined when compiling with Delphi 2 or higher - DELPHICOMPILER3_UP Defined when compiling with Delphi 3 or higher - DELPHICOMPILER4_UP Defined when compiling with Delphi 4 or higher - DELPHICOMPILER5_UP Defined when compiling with Delphi 5 or higher - DELPHICOMPILER6_UP Defined when compiling with Delphi 6 or Kylix 1, 2 or 3 or higher - DELPHICOMPILER7_UP Defined when compiling with Delphi 7 or higher - DELPHICOMPILER8_UP Defined when compiling with Delphi 8 or higher - DELPHICOMPILER9_UP Defined when compiling with Delphi 2005 - DELPHICOMPILER10_UP Defined when compiling with Delphi 2006 or higher - DELPHICOMPILER11_UP Defined when compiling with Delphi 2007 for Win32 or higher - DELPHICOMPILER12_UP Defined when compiling with Delphi 2009 for Win32 or higher - DELPHICOMPILER14_UP Defined when compiling with Delphi 2010 for Win32 or higher - DELPHICOMPILER15_UP Defined when compiling with Delphi XE for Win32 or higher - DELPHICOMPILER16_UP Defined when compiling with Delphi XE2 for Win32 or higher - DELPHICOMPILER17_UP Defined when compiling with Delphi XE3 for Win32 or higher - DELPHICOMPILER18_UP Defined when compiling with Delphi XE4 for Win32 or higher - DELPHICOMPILER19_UP Defined when compiling with Delphi XE5 for Win32 or higher - DELPHICOMPILER20_UP Defined when compiling with Delphi XE6 for Win32 or higher - DELPHICOMPILER21_UP Defined when compiling with Delphi XE7 for Win32 or higher - DELPHICOMPILER22_UP Defined when compiling with Delphi XE8 for Win32 or higher - DELPHICOMPILER23_UP Defined when compiling with Delphi 10 for Win32 or higher - DELPHICOMPILER24_UP Defined when compiling with Delphi 10.1 for Win32 or higher - DELPHICOMPILER25_UP Defined when compiling with Delphi 10.2 for Win32 or higher - DELPHICOMPILER26_UP Defined when compiling with Delphi 10.3 for Win32 or higher - DELPHICOMPILER27_UP Defined when compiling with Delphi 10.4 for Win32 or higher - DELPHICOMPILER28_UP Defined when compiling with Delphi 11 for Win32 or higher - DELPHICOMPILER29_UP Defined when compiling with Delphi 12 for Win32 or higher - - -- C++Builder Versions - - The following directives are direct mappings from the VERXXX directives to a - friendly name of the associated compiler. These directives are only defined if - the compiler is C++Builder (ie BCB is defined). - - Directive Description - ------------------------------------------------------------------------------ - BCB1 Defined when compiling with C++Builder 1 - BCB3 Defined when compiling with C++Builder 3 - BCB4 Defined when compiling with C++Builder 4 - BCB5 Defined when compiling with C++Builder 5 (Codename RAMPAGE) - BCB6 Defined when compiling with C++Builder 6 (Codename RIPTIDE) - BCB10 Defined when compiling with C++Builder Personality of BDS 4.0 (also known as C++Builder 2006) (Codename DEXTER) - BCB11 Defined when compiling with C++Builder Personality of RAD Studio 2007 (also known as C++Builder 2007) (Codename COGSWELL) - BCB12 Defined when compiling with C++Builder Personality of RAD Studio 2009 (also known as C++Builder 2009) (Codename TIBURON) - BCB14 Defined when compiling with C++Builder Personality of RAD Studio 2010 (also known as C++Builder 2010) (Codename WEAVER) - BCB15 Defined when compiling with C++Builder Personality of RAD Studio XE (also known as C++Builder XE) (Codename FULCRUM) - BCB16 Defined when compiling with C++Builder Personality of RAD Studio XE2 (also known as C++Builder XE2) (Codename PULSAR) - BCB17 Defined when compiling with C++Builder Personality of RAD Studio XE3 (also known as C++Builder XE3) (Codename WATERDRAGON) - BCB18 Defined when compiling with C++Builder Personality of RAD Studio XE4 (also known as C++Builder XE4) (Codename QUINTESSENCE) - BCB19 Defined when compiling with C++Builder Personality of RAD Studio XE5 (also known as C++Builder XE5) (Codename ZEPHYR) - BCB20 Defined when compiling with C++Builder Personality of RAD Studio XE6 (also known as C++Builder XE6) (Codename PROTEUS) - BCB21 Defined when compiling with C++Builder Personality of RAD Studio XE7 (also known as C++Builder XE7) (Codename CARPATHIA) - BCB22 Defined when compiling with C++Builder Personality of RAD Studio XE8 (also known as C++Builder XE8) (Codename ELBRUS) - BCB23 Defined when compiling with C++Builder Personality of RAD Studio 10 Seattle (also known as C++Builder 10 Seattle) (Codename AITANA) - BCB24 Defined when compiling with C++Builder Personality of RAD Studio 10.1 Berlin (also known as C++Builder 10.1 Berlin) (Codename BIGBEN) - BCB25 Defined when compiling with C++Builder Personality of RAD Studio 10.2 Tokyo (also known as C++Builder 10.2 Tokyo) (Codename GODZILLA) - BCB26 Defined when compiling with C++Builder Personality of RAD Studio 10.3 Rio (also known as C++Builder 10.3 Rio) (Codename CARNIVAL) - BCB27 Defined when compiling with C++Builder Personality of RAD Studio 10.4 Sydney (also known as C++Builder 10.4 Sydney) (Codename DENALI) - BCB28 Defined when compiling with C++Builder Personality of RAD Studio 11 Alexandria (also known as C++Builder 11 Alexandria) (Codename OLYMPUS) - BCB29 Defined when compiling with C++Builder Personality of RAD Studio 12 Athens (also known as C++Builder 12 Athens) (Codename YUKON) - BCB1_UP Defined when compiling with C++Builder 1 or higher - BCB3_UP Defined when compiling with C++Builder 3 or higher - BCB4_UP Defined when compiling with C++Builder 4 or higher - BCB5_UP Defined when compiling with C++Builder 5 or higher - BCB6_UP Defined when compiling with C++Builder 6 or higher - BCB10_UP Defined when compiling with C++Builder Personality of BDS 4.0 or higher - BCB11_UP Defined when compiling with C++Builder Personality of RAD Studio 2007 or higher - BCB12_UP Defined when compiling with C++Builder Personality of RAD Studio 2009 or higher - BCB14_UP Defined when compiling with C++Builder Personality of RAD Studio 2010 or higher - BCB15_UP Defined when compiling with C++Builder Personality of RAD Studio XE or higher - BCB16_UP Defined when compiling with C++Builder Personality of RAD Studio XE2 or higher - BCB17_UP Defined when compiling with C++Builder Personality of RAD Studio XE3 or higher - BCB18_UP Defined when compiling with C++Builder Personality of RAD Studio XE4 or higher - BCB19_UP Defined when compiling with C++Builder Personality of RAD Studio XE5 or higher - BCB20_UP Defined when compiling with C++Builder Personality of RAD Studio XE6 or higher - BCB21_UP Defined when compiling with C++Builder Personality of RAD Studio XE7 or higher - BCB22_UP Defined when compiling with C++Builder Personality of RAD Studio XE8 or higher - BCB23_UP Defined when compiling with C++Builder Personality of RAD Studio 10 or higher - BCB24_UP Defined when compiling with C++Builder Personality of RAD Studio 10.1 or higher - BCB25_UP Defined when compiling with C++Builder Personality of RAD Studio 10.2 or higher - BCB26_UP Defined when compiling with C++Builder Personality of RAD Studio 10.3 or higher - BCB27_UP Defined when compiling with C++Builder Personality of RAD Studio 10.4 or higher - BCB28_UP Defined when compiling with C++Builder Personality of RAD Studio 11 or higher - BCB29_UP Defined when compiling with C++Builder Personality of RAD Studio 12 or higher - - -- RAD Studio / Borland Developer Studio Versions - - The following directives are direct mappings from the VERXXX directives to a - friendly name of the associated IDE. These directives are only defined if - the IDE is Borland Developer Studio Version 2 or above. - - Note: Borland Developer Studio 2006 is marketed as Delphi 2006 or C++Builder 2006, - but those provide only different labels for identical content. - - Directive Description - ------------------------------------------------------------------------------ - BDS Defined when compiling with BDS version of dcc32.exe (Codename SIDEWINDER) - BDS2 Defined when compiling with BDS 2.0 (Delphi 8) (Codename OCTANE) - BDS3 Defined when compiling with BDS 3.0 (Delphi 2005) (Codename DIAMONDBACK) - BDS4 Defined when compiling with BDS 4.0 (Borland Developer Studio 2006) (Codename DEXTER) - BDS5 Defined when compiling with BDS 5.0 (CodeGear RAD Studio 2007) (Codename HIGHLANDER) - BDS6 Defined when compiling with BDS 6.0 (CodeGear RAD Studio 2009) (Codename TIBURON) - BDS7 Defined when compiling with BDS 7.0 (Embarcadero RAD Studio 2010) (Codename WEAVER) - BDS8 Defined when compiling with BDS 8.0 (Embarcadero RAD Studio XE) (Codename FULCRUM) - BDS9 Defined when compiling with BDS 9.0 (Embarcadero RAD Studio XE2) (Codename PULSAR) - BDS10 Defined when compiling with BDS 10.0 (Embarcadero RAD Studio XE3) (Codename WATERDRAGON) - BDS11 Defined when compiling with BDS 11.0 (Embarcadero RAD Studio XE4) (Codename QUINTESSENCE) - BDS12 Defined when compiling with BDS 12.0 (Embarcadero RAD Studio XE5) (Codename ZEPHYR) - BDS14 Defined when compiling with BDS 14.0 (Embarcadero RAD Studio XE6) (Codename PROTEUS) - BDS15 Defined when compiling with BDS 15.0 (Embarcadero RAD Studio XE7) (Codename CARPATHIA) - BDS16 Defined when compiling with BDS 16.0 (Embarcadero RAD Studio XE8) (Codename ELBRUS) - BDS17 Defined when compiling with BDS 17.0 (Embarcadero RAD Studio 10) (Codename AITANA) - BDS18 Defined when compiling with BDS 18.0 (Embarcadero RAD Studio 10.1) (Codename BIGBEN) - BDS19 Defined when compiling with BDS 19.0 (Embarcadero RAD Studio 10.2) (Codename GODZILLA) - BDS20 Defined when compiling with BDS 20.0 (Embarcadero RAD Studio 10.3) (Codename CARNIVAL) - BDS21 Defined when compiling with BDS 21.0 (Embarcadero RAD Studio 10.4) (Codename DENALI) - BDS22 Defined when compiling with BDS 22.0 (Embarcadero RAD Studio 11) (Codename OLYMPUS) - BDS23 Defined when compiling with BDS 22.0 (Embarcadero RAD Studio 12) (Codename YUKON) - BDS2_UP Defined when compiling with BDS 2.0 or higher - BDS3_UP Defined when compiling with BDS 3.0 or higher - BDS4_UP Defined when compiling with BDS 4.0 or higher - BDS5_UP Defined when compiling with BDS 5.0 or higher - BDS6_UP Defined when compiling with BDS 6.0 or higher - BDS7_UP Defined when compiling with BDS 7.0 or higher - BDS8_UP Defined when compiling with BDS 8.0 or higher - BDS9_UP Defined when compiling with BDS 9.0 or higher - BDS10_UP Defined when compiling with BDS 10.0 or higher - BDS11_UP Defined when compiling with BDS 11.0 or higher - BDS12_UP Defined when compiling with BDS 12.0 or higher - BDS14_UP Defined when compiling with BDS 14.0 or higher - BDS15_UP Defined when compiling with BDS 15.0 or higher - BDS16_UP Defined when compiling with BDS 16.0 or higher - BDS17_UP Defined when compiling with BDS 17.0 or higher - BDS18_UP Defined when compiling with BDS 18.0 or higher - BDS19_UP Defined when compiling with BDS 19.0 or higher - BDS20_UP Defined when compiling with BDS 20.0 or higher - BDS21_UP Defined when compiling with BDS 21.0 or higher - BDS22_UP Defined when compiling with BDS 22.0 or higher - BDS23_UP Defined when compiling with BDS 23.0 or higher - -- Compiler Versions - - The following directives are direct mappings from the VERXXX directives to a - friendly name of the associated compiler. Unlike the DELPHI_X and BCB_X - directives, these directives are indepedent of the development environment. - That is, they are defined regardless of whether compilation takes place using - Delphi or C++Builder. - - Directive Description - ------------------------------------------------------------------------------ - COMPILER1 Defined when compiling with Delphi 1 - COMPILER2 Defined when compiling with Delphi 2 or C++Builder 1 - COMPILER3 Defined when compiling with Delphi 3 - COMPILER35 Defined when compiling with C++Builder 3 - COMPILER4 Defined when compiling with Delphi 4 or C++Builder 4 - COMPILER5 Defined when compiling with Delphi 5 or C++Builder 5 - COMPILER6 Defined when compiling with Delphi 6 or C++Builder 6 - COMPILER7 Defined when compiling with Delphi 7 - COMPILER8 Defined when compiling with Delphi 8 - COMPILER9 Defined when compiling with Delphi 9 - COMPILER10 Defined when compiling with Delphi or C++Builder Personalities of BDS 4.0 - COMPILER11 Defined when compiling with Delphi or C++Builder Personalities of BDS 5.0 - COMPILER12 Defined when compiling with Delphi or C++Builder Personalities of BDS 6.0 - COMPILER14 Defined when compiling with Delphi or C++Builder Personalities of BDS 7.0 - COMPILER15 Defined when compiling with Delphi or C++Builder Personalities of BDS 8.0 - COMPILER16 Defined when compiling with Delphi or C++Builder Personalities of BDS 9.0 - COMPILER17 Defined when compiling with Delphi or C++Builder Personalities of BDS 10.0 - COMPILER18 Defined when compiling with Delphi or C++Builder Personalities of BDS 11.0 - COMPILER19 Defined when compiling with Delphi or C++Builder Personalities of BDS 12.0 - COMPILER20 Defined when compiling with Delphi or C++Builder Personalities of BDS 14.0 - COMPILER21 Defined when compiling with Delphi or C++Builder Personalities of BDS 15.0 - COMPILER22 Defined when compiling with Delphi or C++Builder Personalities of BDS 16.0 - COMPILER23 Defined when compiling with Delphi or C++Builder Personalities of BDS 17.0 - COMPILER24 Defined when compiling with Delphi or C++Builder Personalities of BDS 18.0 - COMPILER25 Defined when compiling with Delphi or C++Builder Personalities of BDS 19.0 - COMPILER26 Defined when compiling with Delphi or C++Builder Personalities of BDS 20.0 - COMPILER27 Defined when compiling with Delphi or C++Builder Personalities of BDS 21.0 - COMPILER28 Defined when compiling with Delphi or C++Builder Personalities of BDS 22.0 - COMPILER29 Defined when compiling with Delphi or C++Builder Personalities of BDS 23.0 - COMPILER1_UP Defined when compiling with Delphi 1 or higher - COMPILER2_UP Defined when compiling with Delphi 2 or C++Builder 1 or higher - COMPILER3_UP Defined when compiling with Delphi 3 or higher - COMPILER35_UP Defined when compiling with C++Builder 3 or higher - COMPILER4_UP Defined when compiling with Delphi 4 or C++Builder 4 or higher - COMPILER5_UP Defined when compiling with Delphi 5 or C++Builder 5 or higher - COMPILER6_UP Defined when compiling with Delphi 6 or C++Builder 6 or higher - COMPILER7_UP Defined when compiling with Delphi 7 - COMPILER8_UP Defined when compiling with Delphi 8 - COMPILER9_UP Defined when compiling with Delphi Personalities of BDS 3.0 - COMPILER10_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 4.0 or higher - COMPILER11_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 5.0 or higher - COMPILER12_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 6.0 or higher - COMPILER14_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 7.0 or higher - COMPILER15_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 8.0 or higher - COMPILER16_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 9.0 or higher - COMPILER17_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 10.0 or higher - COMPILER18_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 11.0 or higher - COMPILER19_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 12.0 or higher - COMPILER20_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 14.0 or higher - COMPILER21_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 15.0 or higher - COMPILER22_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 16.0 or higher - COMPILER23_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 17.0 or higher - COMPILER24_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 18.0 or higher - COMPILER25_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 19.0 or higher - COMPILER26_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 20.0 or higher - COMPILER27_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 21.0 or higher - COMPILER28_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 22.0 or higher - COMPILER29_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 23.0 or higher - - -- RTL Versions - - Use e.g. following to determine the exact RTL version since version 14.0: - {$IFDEF CONDITIONALEXPRESSIONS} - {$IF Declared(RTLVersion) and (RTLVersion >= 14.2)} - // code for Delphi 6.02 or higher, Kylix 2 or higher, C++Builder 6 or higher - ... - {$IFEND} - {$ENDIF} - - Directive Description - ------------------------------------------------------------------------------ - RTL80_UP Defined when compiling with Delphi 1 or higher - RTL90_UP Defined when compiling with Delphi 2 or higher - RTL93_UP Defined when compiling with C++Builder 1 or higher - RTL100_UP Defined when compiling with Delphi 3 or higher - RTL110_UP Defined when compiling with C++Builder 3 or higher - RTL120_UP Defined when compiling with Delphi 4 or higher - RTL125_UP Defined when compiling with C++Builder 4 or higher - RTL130_UP Defined when compiling with Delphi 5 or C++Builder 5 or higher - RTL140_UP Defined when compiling with Delphi 6, Kylix 1, 2 or 3 or C++Builder 6 or higher - RTL150_UP Defined when compiling with Delphi 7 or higher - RTL160_UP Defined when compiling with Delphi 8 or higher - RTL170_UP Defined when compiling with Delphi Personalities of BDS 3.0 or higher - RTL180_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 4.0 or higher - RTL185_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 5.0 or higher - RTL190_UP Defined when compiling with Delphi.NET of BDS 5.0 or higher - RTL200_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 6.0 or higher - RTL210_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 7.0 or higher - RTL220_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 8.0 or higher - RTL230_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 9.0 or higher - RTL240_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 10.0 or higher - RTL250_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 11.0 or higher - RTL260_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 12.0 or higher - RTL270_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 14.0 or higher - RTL280_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 15.0 or higher - RTL290_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 16.0 or higher - RTL300_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 17.0 or higher - RTL310_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 18.0 or higher - RTL320_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 19.0 or higher - RTL330_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 20.0 or higher - RTL340_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 21.0 or higher - RTL350_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 22.0 or higher - RTL360_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 23.0 or higher - - -- CLR Versions - - Directive Description - ------------------------------------------------------------------------------ - CLR Defined when compiling for .NET - CLR10 Defined when compiling for .NET 1.0 (may be overriden by FORCE_CLR10) - CLR10_UP Defined when compiling for .NET 1.0 or higher - CLR11 Defined when compiling for .NET 1.1 (may be overriden by FORCE_CLR11) - CLR11_UP Defined when compiling for .NET 1.1 or higher - CLR20 Defined when compiling for .NET 2.0 (may be overriden by FORCE_CLR20) - CLR20_UP Defined when compiling for .NET 2.0 or higher - - -- Feature Directives - - The features directives are used to test if the compiler supports specific - features, such as method overloading, and adjust the sources accordingly. Use - of these directives is preferred over the use of the DELPHI and COMPILER - directives. - - Directive Description - ------------------------------------------------------------------------------ - SUPPORTS_CONSTPARAMS Compiler supports const parameters (D1+) - SUPPORTS_SINGLE Compiler supports the Single type (D1+) - SUPPORTS_DOUBLE Compiler supports the Double type (D1+) - SUPPORTS_EXTENDED Compiler supports the Extended type (D1+) - SUPPORTS_CURRENCY Compiler supports the Currency type (D2+) - SUPPORTS_THREADVAR Compiler supports threadvar declarations (D2+) - SUPPORTS_OUTPARAMS Compiler supports out parameters (D3+) - SUPPORTS_VARIANT Compiler supports variant (D2+) - SUPPORTS_WIDECHAR Compiler supports the WideChar type (D2+) - SUPPORTS_WIDESTRING Compiler supports the WideString type (D3+/BCB3+) - SUPPORTS_INTERFACE Compiler supports interfaces (D3+/BCB3+) - SUPPORTS_DISPINTERFACE Compiler supports dispatch interfaces (D3+/BCB3+) - SUPPORTS_DISPID Compiler supports dispatch ids (D3+/BCB3+/FPC) - SUPPORTS_EXTSYM Compiler supports the $EXTERNALSYM directive (D4+/BCB3+) - SUPPORTS_NODEFINE Compiler supports the $NODEFINE directive (D4+/BCB3+) - SUPPORTS_LONGWORD Compiler supports the LongWord type (unsigned 32 bit) (D4+/BCB4+) - SUPPORTS_INT64 Compiler supports the Int64 type (D4+/BCB4+) - SUPPORTS_UINT64 Compiler supports the UInt64 type (D7+) - SUPPORTS_DYNAMICARRAYS Compiler supports dynamic arrays (D4+/BCB4+) - SUPPORTS_DEFAULTPARAMS Compiler supports default parameters (D4+/BCB4+) - SUPPORTS_OVERLOAD Compiler supports overloading (D4+/BCB4+) - SUPPORTS_IMPLEMENTS Compiler supports implements (D4+/BCB4+) - SUPPORTS_DEPRECATED Compiler supports the deprecated directive (D6+/BCB6+) - SUPPORTS_PLATFORM Compiler supports the platform directive (D6+/BCB6+) - SUPPORTS_LIBRARY Compiler supports the library directive (D6+/BCB6+/FPC) - SUPPORTS_LOCAL Compiler supports the local directive (D6+/BCB6+) - SUPPORTS_SETPEFLAGS Compiler supports the SetPEFlags directive (D6+/BCB6+) - SUPPORTS_EXPERIMENTAL_WARNINGS Compiler supports the WARN SYMBOL_EXPERIMENTAL and WARN UNIT_EXPERIMENTAL directives (D6+/BCB6+) - SUPPORTS_INLINE Compiler supports the inline directive (D9+/FPC) - SUPPORTS_FOR_IN Compiler supports for in loops (D9+) - SUPPORTS_NESTED_CONSTANTS Compiler supports nested constants (D9+) - SUPPORTS_NESTED_TYPES Compiler supports nested types (D9+) - SUPPORTS_REGION Compiler supports the REGION and ENDREGION directives (D9+) - SUPPORTS_ENHANCED_RECORDS Compiler supports class [operator|function|procedure] for record types (D9.NET, D10+) - SUPPORTS_CLASS_FIELDS Compiler supports class fields (D9.NET, D10+) - SUPPORTS_CLASS_HELPERS Compiler supports class helpers (D9.NET, D10+) - SUPPORTS_CLASS_OPERATORS Compiler supports class operators (D9.NET, D10+) - SUPPORTS_CLASS_CTORDTORS Compiler supports class contructors/destructors (D14+) - SUPPORTS_STRICT Compiler supports strict keyword (D9.NET, D10+) - SUPPORTS_STATIC Compiler supports static keyword (D9.NET, D10+) - SUPPORTS_FINAL Compiler supports final keyword (D9.NET, D10+) - SUPPORTS_METHODINFO Compiler supports the METHODINFO directives (D10+) - SUPPORTS_GENERICS Compiler supports generic implementations (D11.NET, D12+) - SUPPORTS_GENERIC_TYPES Compiler supports generic implementations of types (D11.NET, D12+, FPC) - SUPPORTS_GENERIC_METHODS Compiler supports generic implementations of methods (D11.NET, D12+, FPC) - SUPPORTS_GENERIC_ROUTINES Compiler supports generic implementations of global functions/procedures (FPC) - SUPPORTS_DEPRECATED_DETAILS Compiler supports additional text for the deprecated directive (D11.NET, D12+) - ACCEPT_DEPRECATED Compiler supports or ignores the deprecated directive (D6+/BCB6+/FPC) - ACCEPT_PLATFORM Compiler supports or ignores the platform directive (D6+/BCB6+/FPC) - ACCEPT_LIBRARY Compiler supports or ignores the library directive (D6+/BCB6+) - SUPPORTS_CUSTOMVARIANTS Compiler supports custom variants (D6+/BCB6+) - SUPPORTS_VARARGS Compiler supports varargs (D6+/BCB6+) - SUPPORTS_ENUMVALUE Compiler supports assigning ordinalities to values of enums (D6+/BCB6+) - SUPPORTS_DEPRECATED_WARNINGS Compiler supports deprecated warnings (D6+/BCB6+) - SUPPORTS_LIBRARY_WARNINGS Compiler supports library warnings (D6+/BCB6+) - SUPPORTS_PLATFORM_WARNINGS Compiler supports platform warnings (D6+/BCB6+) - SUPPORTS_UNSAFE_WARNINGS Compiler supports unsafe warnings (D7+) - SUPPORTS_WEAKPACKAGEUNIT Compiler supports the WEAKPACKAGEUNIT directive (D3+) - SUPPORTS_COMPILETIME_MESSAGES Compiler supports the MESSAGE directive (D6+) - SUPPORTS_PACKAGES Compiler supports Packages (D1+) - HAS_UNIT_LIBC Unit Libc exists (Kylix, FPC on Linux/x86) - HAS_UNIT_RTLCONSTS Unit RTLConsts exists (D6+/BCB6+/FPC) - HAS_UNIT_TYPES Unit Types exists (D6+/BCB6+/FPC) - HAS_UNIT_VARIANTS Unit Variants exists (D6+/BCB6+/FPC) - HAS_UNIT_STRUTILS Unit StrUtils exists (D6+/BCB6+/FPC) - HAS_UNIT_DATEUTILS Unit DateUtils exists (D6+/BCB6+/FPC) - HAS_UNIT_CONTNRS Unit contnrs exists (D6+/BCB6+/FPC) - HAS_UNIT_HTTPPROD Unit HTTPProd exists (D9+) - HAS_UNIT_GIFIMG Unit GifImg exists (D11+) - HAS_UNIT_ANSISTRINGS Unit AnsiStrings exists (D12+) - HAS_UNIT_PNGIMAGE Unit PngImage exists (D12+) - HAS_UNIT_CHARACTER Unit Character exists (D12+) - XPLATFORM_RTL The RTL supports crossplatform function names (e.g. RaiseLastOSError) (D6+/BCB6+/FPC) - SUPPORTS_TYPED_POINTERMATH Compiler supports arithmetic operations on typed pointers (D12+) - SUPPORTS_STRINGCHECKS Compiler supports the STRINGCHECKS directive (D12+) - SUPPORTS_UNICODE string type is aliased to an unicode string (WideString or UnicodeString) (DX.NET, D12+) - SUPPORTS_UNICODE_STRING Compiler supports UnicodeString (D12+) - SUPPORTS_INT_ALIASES Types Int8, Int16, Int32, UInt8, UInt16 and UInt32 are defined in the unit System (D12+) - HAS_UNIT_RTTI Unit RTTI is available (D14+) - SUPPORTS_EXTENDED_RTTI Compiler supports the extended RTTI directive (D14+) - SUPPORTS_CAST_INTERFACE_TO_OBJ The compiler supports casts from interfaces to objects (D14+) - SUPPORTS_DELAYED_LOADING The compiler generates stubs for delaying imported function loads (D14+) - HAS_UNIT_REGULAREXPRESSIONSAPI Unit RegularExpressionsAPI is available (D15+) - HAS_UNITSCOPE Has unit scope, i.e. System.Classes instead of Classes (D16+) - HAS_UNIT_SYSTEM_UITYPES Unit System.UITypes is available (D16+) - HAS_UNIT_SYSTEM_ZIP Unit System.Zip is available (D16+) - HAS_UNIT_SYSTEM_ZLIB Unit System.ZLib is available (D16+) - HAS_UNIT_SYSTEM_ACTIONS Unit System.Actions is available (D17+) - DEPRECATED_SYSUTILS_ANSISTRINGS AnsiString functions from SysUtils are deprecated and moved to System.AnsiStrings (D18+) - HAS_PROPERTY_STYLEELEMENTS TControl has a StyleElements property (D17+) - HAS_AUTOMATIC_DB_FIELDS Database fields are automatically created/refreshed (D20+) - HAS_EARGUMENTEXCEPTION Exception class EArgumentException is available (D14+) - HAS_ENOTIMPLEMENTED Exception class ENotImplemented is available (D15+) - HAS_UNIT_VCL_THEMES Unit Vcl.Themes is available (D16+) - SUPPORTS_EXCESSPRECISION Compiler supports the EXCESSPRECISION directive (D16+) - HAS_TSTRINGS_ENCODING RTL supports TStrings.Encoding (D16+) - EXTENDED_IS_DOUBLE_ALIAS Compiler uses Double instead of Extended (64 bit D16+) - HAS_UNIT_UXTHEME Unit (Vcl.)UxTheme is available (D7+) - HAS_EXCEPTION_STACKTRACE Exception class has the StackTrace propery (D12+) - SUPPORTS_LEGACYIFEND Compiler supports the LEGACYIFEND directive (D17+) - DEPRECATED_TCHARACTER TCharacter is deprecated and replaced by a record helper on Char (D18+) - HAS_PROPERTY_OLDCREATEORDER The OldCreateOrder property is available (D5 - D27) - SUPPORTS_SCOPEDENUMS Compiler supports the SCOPEDENUMS directive and enumerations can be scoped (D12+) - - -- Compiler Settings - - The compiler settings directives indicate whether a specific compiler setting - is in effect. This facilitates changing compiler settings locally in a more - compact and readible manner. - - Directive Description - ------------------------------------------------------------------------------ - ALIGN_ON Compiling in the A+ state (no alignment) - BOOLEVAL_ON Compiling in the B+ state (complete boolean evaluation) - ASSERTIONS_ON Compiling in the C+ state (assertions on) - DEBUGINFO_ON Compiling in the D+ state (debug info generation on) - IMPORTEDDATA_ON Compiling in the G+ state (creation of imported data references) - LONGSTRINGS_ON Compiling in the H+ state (string defined as AnsiString) - IOCHECKS_ON Compiling in the I+ state (I/O checking enabled) - WRITEABLECONST_ON Compiling in the J+ state (typed constants can be modified) - LOCALSYMBOLS Compiling in the L+ state (local symbol generation) - LOCALSYMBOLS_ON Alias of LOCALSYMBOLS - TYPEINFO_ON Compiling in the M+ state (RTTI generation on) - OPTIMIZATION_ON Compiling in the O+ state (code optimization on) - OPENSTRINGS_ON Compiling in the P+ state (variable string parameters are openstrings) - OVERFLOWCHECKS_ON Compiling in the Q+ state (overflow checing on) - RANGECHECKS_ON Compiling in the R+ state (range checking on) - TYPEDADDRESS_ON Compiling in the T+ state (pointers obtained using the @ operator are typed) - SAFEDIVIDE_ON Compiling in the U+ state (save FDIV instruction through RTL emulation) - VARSTRINGCHECKS_ON Compiling in the V+ state (type checking of shortstrings) - STACKFRAMES_ON Compiling in the W+ state (generation of stack frames) - EXTENDEDSYNTAX_ON Compiling in the X+ state (Delphi extended syntax enabled) -*) - -{$DEFINE BORLAND} - -{ Set FreePascal to Delphi mode } -{$IFDEF FPC} - {$MODE DELPHI} - // Assembler mode Intel is only available for the x86 CPU family - {$IF DEFINED(CPUI8086) OR DEFINED(CPUI386) OR DEFINED(CPUX86_64)} - {$ASMMODE Intel} - {$IFEND} - {$UNDEF BORLAND} - {$DEFINE CPUASM} - // FPC defines CPU32, CPU64 and Unix automatically -{$ENDIF} - -{$IFDEF BORLAND} - {$IFDEF LINUX} - {$IFDEF VER140} // Only under Delphi 6, LINUX implies Kylix - {$DEFINE KYLIX} - {$ENDIF} - {$ENDIF LINUX} - {$IFNDEF CLR} - {$IFNDEF CPUX86} - // CPUX86 is not defined, which means it most likely is a 64 bits compiler. - // However, this is only the case if either of two other symbols are defined: - // http://docwiki.embarcadero.com/RADStudio/en/Conditional_compilation_%28Delphi%29 - {$DEFINE CPU64} - {$DEFINE DELPHI64_TEMPORARY} - {$IFNDEF CPUX64} - {$IFNDEF CPU64BITS} - {$DEFINE CPU386} // None of the two 64-bits symbols are defined, assume this is 32-bit - {$DEFINE CPU32} - {$UNDEF CPU64} - {$UNDEF DELPHI64_TEMPORARY} - {$ENDIF ~CPU64BITS} - {$ENDIF ~CPUX64} - {$ELSE ~CPUX86} - {$DEFINE CPU386} - {$DEFINE CPU32} - {$ENDIF ~CPUX86} - {$ENDIF ~CLR} -{$ENDIF BORLAND} - -{------------------------------------------------------------------------------} -{ VERXXX to COMPILERX, DELPHIX and BCBX mappings } -{------------------------------------------------------------------------------} - -{$IFDEF BORLAND} - {$IFDEF KYLIX} - {$I kylix.inc} // FPC incompatible stuff - {$ELSE ~KYLIX} - - {$DEFINE UNKNOWN_COMPILER_VERSION} - - {$IFDEF VER80} - {$DEFINE COMPILER1} - {$DEFINE DELPHI1} - {$DEFINE DELPHICOMPILER1} - {$DEFINE RTL80_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER90} - {$DEFINE COMPILER2} - {$DEFINE DELPHI2} - {$DEFINE DELPHICOMPILER2} - {$DEFINE RTL90_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER93} - {$DEFINE COMPILER2} - {$DEFINE BCB1} - {$DEFINE BCB} - {$DEFINE RTL93_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER100} - {$DEFINE COMPILER3} - {$DEFINE DELPHI3} - {$DEFINE DELPHICOMPILER3} - {$DEFINE RTL100_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER110} - {$DEFINE COMPILER35} - {$DEFINE BCB3} - {$DEFINE BCB} - {$DEFINE RTL110_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER120} - {$DEFINE COMPILER4} - {$DEFINE DELPHI4} - {$DEFINE DELPHICOMPILER4} - {$DEFINE RTL120_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER125} - {$DEFINE COMPILER4} - {$DEFINE BCB4} - {$DEFINE BCB} - {$DEFINE RTL125_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER130} - {$DEFINE COMPILER5} - {$IFDEF BCB} - {$DEFINE BCB5} - {$ELSE} - {$DEFINE DELPHI5} - {$DEFINE DELPHICOMPILER5} - {$ENDIF} - {$DEFINE RTL130_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER140} - {$DEFINE COMPILER6} - {$IFDEF BCB} - {$DEFINE BCB6} - {$ELSE} - {$DEFINE DELPHI6} - {$DEFINE DELPHICOMPILER6} - {$ENDIF} - {$DEFINE RTL140_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER150} - {$DEFINE COMPILER7} - {$DEFINE DELPHI7} - {$DEFINE DELPHICOMPILER7} - {$DEFINE RTL150_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER160} - {$DEFINE BDS2} - {$DEFINE BDS} - {$IFDEF CLR} - {$DEFINE CLR10} - {$ENDIF CLR} - {$DEFINE COMPILER8} - {$DEFINE DELPHI8} - {$DEFINE DELPHICOMPILER8} - {$DEFINE RTL160_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER170} - {$DEFINE BDS3} - {$DEFINE BDS} - {$IFDEF CLR} - {$DEFINE CLR11} - {$ENDIF CLR} - {$DEFINE COMPILER9} - {$DEFINE DELPHI9} - {$DEFINE DELPHI2005} // synonym to DELPHI9 - {$DEFINE DELPHICOMPILER9} - {$DEFINE RTL170_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER180} - {$DEFINE BDS} - {$IFDEF CLR} - {$DEFINE CLR11} - {$ENDIF CLR} - {$IFDEF VER185} - {$DEFINE BDS5} - {$DEFINE COMPILER11} - {$IFDEF BCB} - {$DEFINE BCB11} - {$ELSE} - {$DEFINE DELPHI11} - {$DEFINE DELPHI2007} // synonym to DELPHI11 - {$DEFINE DELPHICOMPILER11} - {$ENDIF} - {$DEFINE RTL185_UP} - {$ELSE ~~VER185} - {$DEFINE BDS4} - {$DEFINE COMPILER10} - {$IFDEF BCB} - {$DEFINE BCB10} - {$ELSE} - {$DEFINE DELPHI10} - {$DEFINE DELPHI2006} // synonym to DELPHI10 - {$DEFINE DELPHICOMPILER10} - {$ENDIF} - {$DEFINE RTL180_UP} - {$ENDIF ~VER185} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER190} // Delphi 2007 for .NET - {$DEFINE BDS} - {$DEFINE BDS5} - {$IFDEF CLR} - {$DEFINE CLR20} - {$ENDIF CLR} - {$DEFINE COMPILER11} - {$DEFINE DELPHI11} - {$DEFINE DELPHI2007} // synonym to DELPHI11 - {$DEFINE DELPHICOMPILER11} - {$DEFINE RTL190_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER190} - - {$IFDEF VER200} // RAD Studio 2009 - {$DEFINE BDS} - {$DEFINE BDS6} - {$IFDEF CLR} - {$DEFINE CLR20} - {$ENDIF CLR} - {$DEFINE COMPILER12} - {$IFDEF BCB} - {$DEFINE BCB12} - {$ELSE} - {$DEFINE DELPHI12} - {$DEFINE DELPHI2009} // synonym to DELPHI12 - {$DEFINE DELPHICOMPILER12} - {$ENDIF BCB} - {$IFDEF CLR} - {$DEFINE RTL190_UP} - {$ELSE} - {$DEFINE RTL200_UP} - {$ENDIF} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER200} - - {$IFDEF VER210} // RAD Studio 2010 - {$DEFINE BDS} - {$DEFINE BDS7} - {$DEFINE COMPILER14} - {$IFDEF BCB} - {$DEFINE BCB14} - {$ELSE} - {$DEFINE DELPHI14} - {$DEFINE DELPHI2010} // synonym to DELPHI14 - {$DEFINE DELPHICOMPILER14} - {$ENDIF BCB} - {$DEFINE RTL210_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER210} - - {$IFDEF VER220} // RAD Studio XE - {$DEFINE BDS} - {$DEFINE BDS8} - {$DEFINE COMPILER15} - {$IFDEF BCB} - {$DEFINE BCB15} - {$ELSE} - {$DEFINE DELPHI15} - {$DEFINE DELPHIXE} // synonym to DELPHI15 - {$DEFINE DELPHICOMPILER15} - {$ENDIF BCB} - {$DEFINE RTL220_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER220} - - {$IFDEF VER230} // RAD Studio XE2 - {$DEFINE BDS} - {$DEFINE BDS9} - {$DEFINE COMPILER16} - {$IFDEF BCB} - {$DEFINE BCB16} - {$ELSE} - {$DEFINE DELPHI16} - {$DEFINE DELPHIXE2} // synonym to DELPHI16 - {$DEFINE DELPHICOMPILER16} - {$ENDIF BCB} - {$DEFINE RTL230_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER230} - - {$IFDEF VER240} // RAD Studio XE3 - {$DEFINE BDS} - {$DEFINE BDS10} - {$DEFINE COMPILER17} - {$IFDEF BCB} - {$DEFINE BCB17} - {$ELSE} - {$DEFINE DELPHI17} - {$DEFINE DELPHIXE3} // synonym to DELPHI17 - {$DEFINE DELPHICOMPILER17} - {$ENDIF BCB} - {$DEFINE RTL240_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER240} - - {$IFDEF VER250} // RAD Studio XE4 - {$DEFINE BDS} - {$DEFINE BDS11} - {$DEFINE COMPILER18} - {$IFDEF BCB} - {$DEFINE BCB18} - {$ELSE} - {$DEFINE DELPHI18} - {$DEFINE DELPHIXE4} // synonym to DELPHI18 - {$DEFINE DELPHICOMPILER18} - {$ENDIF BCB} - {$DEFINE RTL250_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER250} - - {$IFDEF VER260} // RAD Studio XE5 - {$DEFINE BDS} - {$DEFINE BDS12} - {$DEFINE COMPILER19} - {$IFDEF BCB} - {$DEFINE BCB19} - {$ELSE} - {$DEFINE DELPHI19} - {$DEFINE DELPHIXE5} // synonym to DELPHI19 - {$DEFINE DELPHICOMPILER19} - {$ENDIF BCB} - {$DEFINE RTL260_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER260} - - {$IFDEF VER270} // RAD Studio XE6 - {$DEFINE BDS} - {$DEFINE BDS14} - {$DEFINE COMPILER20} - {$IFDEF BCB} - {$DEFINE BCB20} - {$ELSE} - {$DEFINE DELPHI20} - {$DEFINE DELPHIXE6} // synonym to DELPHI20 - {$DEFINE DELPHICOMPILER20} - {$ENDIF BCB} - {$DEFINE RTL270_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER270} - - {$IFDEF VER280} // RAD Studio XE7 - {$DEFINE BDS} - {$DEFINE BDS15} - {$DEFINE COMPILER21} - {$IFDEF BCB} - {$DEFINE BCB21} - {$ELSE} - {$DEFINE DELPHI21} - {$DEFINE DELPHIXE7} // synonym to DELPHI21 - {$DEFINE DELPHICOMPILER21} - {$ENDIF BCB} - {$DEFINE RTL280_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER280} - - {$IFDEF VER290} // RAD Studio XE8 - {$DEFINE BDS} - {$DEFINE BDS16} - {$DEFINE COMPILER22} - {$IFDEF BCB} - {$DEFINE BCB22} - {$ELSE} - {$DEFINE DELPHI22} - {$DEFINE DELPHIXE8} // synonym to DELPHI22 - {$DEFINE DELPHICOMPILER22} - {$ENDIF BCB} - {$DEFINE RTL290_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER290} - - {$IFDEF VER300} // RAD Studio 10 - {$DEFINE BDS} - {$DEFINE BDS17} - {$DEFINE COMPILER23} - {$IFDEF BCB} - {$DEFINE BCB23} - {$ELSE} - {$DEFINE DELPHI23} - {$DEFINE DELPHIX_SEATTLE} // synonym to DELPHI23 - {$DEFINE DELPHICOMPILER23} - {$ENDIF BCB} - {$DEFINE RTL300_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER300} - - {$IFDEF VER310} // RAD Studio 10.1 - {$DEFINE BDS} - {$DEFINE BDS18} - {$DEFINE COMPILER24} - {$IFDEF BCB} - {$DEFINE BCB24} - {$ELSE} - {$DEFINE DELPHI24} - {$DEFINE DELPHIX_BERLIN} // synonym to DELPHI24 - {$DEFINE DELPHICOMPILER24} - {$ENDIF BCB} - {$DEFINE RTL310_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER310} - - {$IFDEF VER320} // RAD Studio 10.2 - {$DEFINE BDS} - {$DEFINE BDS19} - {$DEFINE COMPILER25} - {$IFDEF BCB} - {$DEFINE BCB25} - {$ELSE} - {$DEFINE DELPHI25} - {$DEFINE DELPHIX_TOKYO} // synonym to DELPHI25 - {$DEFINE DELPHICOMPILER25} - {$ENDIF BCB} - {$DEFINE RTL320_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER320} - - {$IFDEF VER330} // RAD Studio 10.3 - {$DEFINE BDS} - {$DEFINE BDS20} - {$DEFINE COMPILER26} - {$IFDEF BCB} - {$DEFINE BCB26} - {$ELSE} - {$DEFINE DELPHI26} - {$DEFINE DELPHIX_RIO} // synonym to DELPHI26 - {$DEFINE DELPHICOMPILER26} - {$ENDIF BCB} - {$DEFINE RTL330_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER330} - - {$IFDEF VER340} // RAD Studio 10.4 - {$DEFINE BDS} - {$DEFINE BDS21} - {$DEFINE COMPILER27} - {$IFDEF BCB} - {$DEFINE BCB27} - {$ELSE} - {$DEFINE DELPHI27} - {$DEFINE DELPHIX_SYDNEY} // synonym to DELPHI27 - {$DEFINE DELPHICOMPILER27} - {$ENDIF BCB} - {$DEFINE RTL340_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER340} - - {$IFDEF VER350} // RAD Studio 11 - {$DEFINE BDS} - {$DEFINE BDS22} - {$DEFINE COMPILER28} - {$IFDEF BCB} - {$DEFINE BCB28} - {$ELSE} - {$DEFINE DELPHI28} - {$DEFINE DELPHIX_ALEXANDRIA} // synonym to DELPHI28 - {$DEFINE DELPHICOMPILER28} - {$ENDIF BCB} - {$DEFINE RTL350_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER350} - - {$IFDEF VER360} // RAD Studio 12 - {$DEFINE BDS} - {$DEFINE BDS23} - {$DEFINE COMPILER29} - {$IFDEF BCB} - {$DEFINE BCB29} - {$ELSE} - {$DEFINE DELPHI29} - {$DEFINE DELPHI_ATHENS} // synonym to DELPHI29 - {$DEFINE DELPHICOMPILER29} - {$ENDIF BCB} - {$DEFINE RTL360_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER360} - - {$IFDEF UNKNOWN_COMPILER_VERSION} // adjust for newer version (always use latest version) - {$DEFINE BDS} - {$DEFINE BDS23} - {$DEFINE COMPILER29} - {$IFDEF BCB} - {$DEFINE BCB29} - {$ELSE} - {$DEFINE DELPHI29} - {$DEFINE DELPHICOMPILER29} - {$ENDIF BCB} - {$DEFINE RTL360_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$ENDIF ~KYLIX} - - {$IFDEF BCB} - {$DEFINE CPPBUILDER} - {$DEFINE BCBCOMPILER} - {$ELSE ~BCB} - {$DEFINE DELPHI} - {$DEFINE DELPHICOMPILER} - {$ENDIF ~BCB} - -{$ENDIF BORLAND} - -{------------------------------------------------------------------------------} -{ DELPHIX_UP from DELPHIX mappings } -{------------------------------------------------------------------------------} - -{$IFDEF DELPHI29} {$DEFINE DELPHI29_UP} {$ENDIF} -{$IFDEF DELPHI28} {$DEFINE DELPHI28_UP} {$ENDIF} -{$IFDEF DELPHI27} {$DEFINE DELPHI27_UP} {$ENDIF} -{$IFDEF DELPHI26} {$DEFINE DELPHI26_UP} {$ENDIF} -{$IFDEF DELPHI25} {$DEFINE DELPHI25_UP} {$ENDIF} -{$IFDEF DELPHI24} {$DEFINE DELPHI24_UP} {$ENDIF} -{$IFDEF DELPHI23} {$DEFINE DELPHI23_UP} {$ENDIF} -{$IFDEF DELPHI22} {$DEFINE DELPHI22_UP} {$ENDIF} -{$IFDEF DELPHI21} {$DEFINE DELPHI21_UP} {$ENDIF} -{$IFDEF DELPHI20} {$DEFINE DELPHI20_UP} {$ENDIF} -{$IFDEF DELPHI19} {$DEFINE DELPHI19_UP} {$ENDIF} -{$IFDEF DELPHI18} {$DEFINE DELPHI18_UP} {$ENDIF} -{$IFDEF DELPHI17} {$DEFINE DELPHI17_UP} {$ENDIF} -{$IFDEF DELPHI16} {$DEFINE DELPHI16_UP} {$ENDIF} -{$IFDEF DELPHI15} {$DEFINE DELPHI15_UP} {$ENDIF} -{$IFDEF DELPHI14} {$DEFINE DELPHI14_UP} {$ENDIF} -{$IFDEF DELPHI12} {$DEFINE DELPHI12_UP} {$ENDIF} -{$IFDEF DELPHI11} {$DEFINE DELPHI11_UP} {$ENDIF} -{$IFDEF DELPHI10} {$DEFINE DELPHI10_UP} {$ENDIF} -{$IFDEF DELPHI9} {$DEFINE DELPHI9_UP} {$ENDIF} -{$IFDEF DELPHI8} {$DEFINE DELPHI8_UP} {$ENDIF} -{$IFDEF DELPHI7} {$DEFINE DELPHI7_UP} {$ENDIF} -{$IFDEF DELPHI6} {$DEFINE DELPHI6_UP} {$ENDIF} -{$IFDEF DELPHI5} {$DEFINE DELPHI5_UP} {$ENDIF} -{$IFDEF DELPHI4} {$DEFINE DELPHI4_UP} {$ENDIF} -{$IFDEF DELPHI3} {$DEFINE DELPHI3_UP} {$ENDIF} -{$IFDEF DELPHI2} {$DEFINE DELPHI2_UP} {$ENDIF} -{$IFDEF DELPHI1} {$DEFINE DELPHI1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ DELPHIX_UP from DELPHIX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF DELPHI29_UP} - {$DEFINE DELPHI_ATHENS_UP} // synonym to DELPHI29_UP - {$DEFINE DELPHI28_UP} -{$ENDIF} - -{$IFDEF DELPHI28_UP} - {$DEFINE DELPHIX_ALEXANDRIA_UP} // synonym to DELPHI28_UP - {$DEFINE DELPHI27_UP} -{$ENDIF} - -{$IFDEF DELPHI27_UP} - {$DEFINE DELPHIX_SYDNEY_UP} // synonym to DELPHI27_UP - {$DEFINE DELPHI26_UP} -{$ENDIF} - -{$IFDEF DELPHI26_UP} - {$DEFINE DELPHIX_RIO_UP} // synonym to DELPHI26_UP - {$DEFINE DELPHI25_UP} -{$ENDIF} - -{$IFDEF DELPHI25_UP} - {$DEFINE DELPHIX_TOKYO_UP} // synonym to DELPHI25_UP - {$DEFINE DELPHI24_UP} -{$ENDIF} - -{$IFDEF DELPHI24_UP} - {$DEFINE DELPHIX_BERLIN_UP} // synonym to DELPHI24_UP - {$DEFINE DELPHI23_UP} -{$ENDIF} - -{$IFDEF DELPHI23_UP} - {$DEFINE DELPHIX_SEATTLE_UP} // synonym to DELPHI23_UP - {$DEFINE DELPHI22_UP} -{$ENDIF} - -{$IFDEF DELPHI22_UP} - {$DEFINE DELPHIXE8_UP} // synonym to DELPHI22_UP - {$DEFINE DELPHI21_UP} -{$ENDIF} - -{$IFDEF DELPHI21_UP} - {$DEFINE DELPHIXE7_UP} // synonym to DELPHI21_UP - {$DEFINE DELPHI20_UP} -{$ENDIF} - -{$IFDEF DELPHI20_UP} - {$DEFINE DELPHIXE6_UP} // synonym to DELPHI20_UP - {$DEFINE DELPHI19_UP} -{$ENDIF} - -{$IFDEF DELPHI19_UP} - {$DEFINE DELPHIXE5_UP} // synonym to DELPHI19_UP - {$DEFINE DELPHI18_UP} -{$ENDIF} - -{$IFDEF DELPHI18_UP} - {$DEFINE DELPHIXE4_UP} // synonym to DELPHI18_UP - {$DEFINE DELPHI17_UP} -{$ENDIF} - -{$IFDEF DELPHI17_UP} - {$DEFINE DELPHIXE3_UP} // synonym to DELPHI17_UP - {$DEFINE DELPHI16_UP} -{$ENDIF} - -{$IFDEF DELPHI16_UP} - {$DEFINE DELPHIXE2_UP} // synonym to DELPHI16_UP - {$DEFINE DELPHI15_UP} -{$ENDIF} - -{$IFDEF DELPHI15_UP} - {$DEFINE DELPHIXE_UP} // synonym to DELPHI15_UP - {$DEFINE DELPHI14_UP} -{$ENDIF} - -{$IFDEF DELPHI14_UP} - {$DEFINE DELPHI2010_UP} // synonym to DELPHI14_UP - {$DEFINE DELPHI12_UP} -{$ENDIF} - -{$IFDEF DELPHI12_UP} - {$DEFINE DELPHI2009_UP} // synonym to DELPHI12_UP - {$DEFINE DELPHI11_UP} -{$ENDIF} - -{$IFDEF DELPHI11_UP} - {$DEFINE DELPHI2007_UP} // synonym to DELPHI11_UP - {$DEFINE DELPHI10_UP} -{$ENDIF} - -{$IFDEF DELPHI10_UP} - {$DEFINE DELPHI2006_UP} // synonym to DELPHI10_UP - {$DEFINE DELPHI9_UP} -{$ENDIF} - -{$IFDEF DELPHI9_UP} - {$DEFINE DELPHI2005_UP} // synonym to DELPHI9_UP - {$DEFINE DELPHI8_UP} -{$ENDIF} - -{$IFDEF DELPHI8_UP} {$DEFINE DELPHI7_UP} {$ENDIF} -{$IFDEF DELPHI7_UP} {$DEFINE DELPHI6_UP} {$ENDIF} -{$IFDEF DELPHI6_UP} {$DEFINE DELPHI5_UP} {$ENDIF} -{$IFDEF DELPHI5_UP} {$DEFINE DELPHI4_UP} {$ENDIF} -{$IFDEF DELPHI4_UP} {$DEFINE DELPHI3_UP} {$ENDIF} -{$IFDEF DELPHI3_UP} {$DEFINE DELPHI2_UP} {$ENDIF} -{$IFDEF DELPHI2_UP} {$DEFINE DELPHI1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ BCBX_UP from BCBX mappings } -{------------------------------------------------------------------------------} - -{$IFDEF BCB29} {$DEFINE BCB29_UP} {$ENDIF} -{$IFDEF BCB28} {$DEFINE BCB28_UP} {$ENDIF} -{$IFDEF BCB27} {$DEFINE BCB27_UP} {$ENDIF} -{$IFDEF BCB26} {$DEFINE BCB26_UP} {$ENDIF} -{$IFDEF BCB25} {$DEFINE BCB25_UP} {$ENDIF} -{$IFDEF BCB24} {$DEFINE BCB24_UP} {$ENDIF} -{$IFDEF BCB23} {$DEFINE BCB23_UP} {$ENDIF} -{$IFDEF BCB22} {$DEFINE BCB22_UP} {$ENDIF} -{$IFDEF BCB21} {$DEFINE BCB21_UP} {$ENDIF} -{$IFDEF BCB20} {$DEFINE BCB20_UP} {$ENDIF} -{$IFDEF BCB19} {$DEFINE BCB19_UP} {$ENDIF} -{$IFDEF BCB18} {$DEFINE BCB18_UP} {$ENDIF} -{$IFDEF BCB17} {$DEFINE BCB17_UP} {$ENDIF} -{$IFDEF BCB16} {$DEFINE BCB16_UP} {$ENDIF} -{$IFDEF BCB15} {$DEFINE BCB15_UP} {$ENDIF} -{$IFDEF BCB14} {$DEFINE BCB14_UP} {$ENDIF} -{$IFDEF BCB12} {$DEFINE BCB12_UP} {$ENDIF} -{$IFDEF BCB11} {$DEFINE BCB11_UP} {$ENDIF} -{$IFDEF BCB10} {$DEFINE BCB10_UP} {$ENDIF} -{$IFDEF BCB6} {$DEFINE BCB6_UP} {$ENDIF} -{$IFDEF BCB5} {$DEFINE BCB5_UP} {$ENDIF} -{$IFDEF BCB4} {$DEFINE BCB4_UP} {$ENDIF} -{$IFDEF BCB3} {$DEFINE BCB3_UP} {$ENDIF} -{$IFDEF BCB1} {$DEFINE BCB1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ BCBX_UP from BCBX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF BCB29_UP} {$DEFINE BCB28_UP} {$ENDIF} -{$IFDEF BCB28_UP} {$DEFINE BCB27_UP} {$ENDIF} -{$IFDEF BCB27_UP} {$DEFINE BCB26_UP} {$ENDIF} -{$IFDEF BCB26_UP} {$DEFINE BCB25_UP} {$ENDIF} -{$IFDEF BCB25_UP} {$DEFINE BCB24_UP} {$ENDIF} -{$IFDEF BCB24_UP} {$DEFINE BCB23_UP} {$ENDIF} -{$IFDEF BCB23_UP} {$DEFINE BCB22_UP} {$ENDIF} -{$IFDEF BCB22_UP} {$DEFINE BCB21_UP} {$ENDIF} -{$IFDEF BCB21_UP} {$DEFINE BCB20_UP} {$ENDIF} -{$IFDEF BCB20_UP} {$DEFINE BCB19_UP} {$ENDIF} -{$IFDEF BCB19_UP} {$DEFINE BCB18_UP} {$ENDIF} -{$IFDEF BCB18_UP} {$DEFINE BCB17_UP} {$ENDIF} -{$IFDEF BCB17_UP} {$DEFINE BCB16_UP} {$ENDIF} -{$IFDEF BCB16_UP} {$DEFINE BCB15_UP} {$ENDIF} -{$IFDEF BCB15_UP} {$DEFINE BCB14_UP} {$ENDIF} -{$IFDEF BCB14_UP} {$DEFINE BCB12_UP} {$ENDIF} -{$IFDEF BCB12_UP} {$DEFINE BCB11_UP} {$ENDIF} -{$IFDEF BCB11_UP} {$DEFINE BCB10_UP} {$ENDIF} -{$IFDEF BCB10_UP} {$DEFINE BCB6_UP} {$ENDIF} -{$IFDEF BCB6_UP} {$DEFINE BCB5_UP} {$ENDIF} -{$IFDEF BCB5_UP} {$DEFINE BCB4_UP} {$ENDIF} -{$IFDEF BCB4_UP} {$DEFINE BCB3_UP} {$ENDIF} -{$IFDEF BCB3_UP} {$DEFINE BCB1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ BDSX_UP from BDSX mappings } -{------------------------------------------------------------------------------} - -{$IFDEF BDS23} {$DEFINE BDS23_UP} {$ENDIF} -{$IFDEF BDS22} {$DEFINE BDS22_UP} {$ENDIF} -{$IFDEF BDS21} {$DEFINE BDS21_UP} {$ENDIF} -{$IFDEF BDS20} {$DEFINE BDS20_UP} {$ENDIF} -{$IFDEF BDS19} {$DEFINE BDS19_UP} {$ENDIF} -{$IFDEF BDS18} {$DEFINE BDS18_UP} {$ENDIF} -{$IFDEF BDS17} {$DEFINE BDS17_UP} {$ENDIF} -{$IFDEF BDS16} {$DEFINE BDS16_UP} {$ENDIF} -{$IFDEF BDS15} {$DEFINE BDS15_UP} {$ENDIF} -{$IFDEF BDS14} {$DEFINE BDS14_UP} {$ENDIF} -{$IFDEF BDS12} {$DEFINE BDS12_UP} {$ENDIF} -{$IFDEF BDS11} {$DEFINE BDS11_UP} {$ENDIF} -{$IFDEF BDS10} {$DEFINE BDS10_UP} {$ENDIF} -{$IFDEF BDS9} {$DEFINE BDS9_UP} {$ENDIF} -{$IFDEF BDS8} {$DEFINE BDS8_UP} {$ENDIF} -{$IFDEF BDS7} {$DEFINE BDS7_UP} {$ENDIF} -{$IFDEF BDS6} {$DEFINE BDS6_UP} {$ENDIF} -{$IFDEF BDS5} {$DEFINE BDS5_UP} {$ENDIF} -{$IFDEF BDS4} {$DEFINE BDS4_UP} {$ENDIF} -{$IFDEF BDS3} {$DEFINE BDS3_UP} {$ENDIF} -{$IFDEF BDS2} {$DEFINE BDS2_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ BDSX_UP from BDSX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF BDS23_UP} {$DEFINE BDS22_UP} {$ENDIF} -{$IFDEF BDS22_UP} {$DEFINE BDS21_UP} {$ENDIF} -{$IFDEF BDS21_UP} {$DEFINE BDS20_UP} {$ENDIF} -{$IFDEF BDS20_UP} {$DEFINE BDS19_UP} {$ENDIF} -{$IFDEF BDS19_UP} {$DEFINE BDS18_UP} {$ENDIF} -{$IFDEF BDS18_UP} {$DEFINE BDS17_UP} {$ENDIF} -{$IFDEF BDS17_UP} {$DEFINE BDS16_UP} {$ENDIF} -{$IFDEF BDS16_UP} {$DEFINE BDS15_UP} {$ENDIF} -{$IFDEF BDS15_UP} {$DEFINE BDS14_UP} {$ENDIF} -{$IFDEF BDS14_UP} {$DEFINE BDS12_UP} {$ENDIF} -{$IFDEF BDS12_UP} {$DEFINE BDS11_UP} {$ENDIF} -{$IFDEF BDS11_UP} {$DEFINE BDS10_UP} {$ENDIF} -{$IFDEF BDS10_UP} {$DEFINE BDS9_UP} {$ENDIF} -{$IFDEF BDS9_UP} {$DEFINE BDS8_UP} {$ENDIF} -{$IFDEF BDS8_UP} {$DEFINE BDS7_UP} {$ENDIF} -{$IFDEF BDS7_UP} {$DEFINE BDS6_UP} {$ENDIF} -{$IFDEF BDS6_UP} {$DEFINE BDS5_UP} {$ENDIF} -{$IFDEF BDS5_UP} {$DEFINE BDS4_UP} {$ENDIF} -{$IFDEF BDS4_UP} {$DEFINE BDS3_UP} {$ENDIF} -{$IFDEF BDS3_UP} {$DEFINE BDS2_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ DELPHICOMPILERX_UP from DELPHICOMPILERX mappings } -{------------------------------------------------------------------------------} - -{$IFDEF DELPHICOMPILER29} {$DEFINE DELPHICOMPILER29_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER28} {$DEFINE DELPHICOMPILER28_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER27} {$DEFINE DELPHICOMPILER27_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER26} {$DEFINE DELPHICOMPILER26_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER25} {$DEFINE DELPHICOMPILER25_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER24} {$DEFINE DELPHICOMPILER24_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER23} {$DEFINE DELPHICOMPILER23_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER22} {$DEFINE DELPHICOMPILER22_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER21} {$DEFINE DELPHICOMPILER21_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER20} {$DEFINE DELPHICOMPILER20_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER19} {$DEFINE DELPHICOMPILER19_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER18} {$DEFINE DELPHICOMPILER18_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER17} {$DEFINE DELPHICOMPILER17_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER16} {$DEFINE DELPHICOMPILER16_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER15} {$DEFINE DELPHICOMPILER15_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER14} {$DEFINE DELPHICOMPILER14_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER12} {$DEFINE DELPHICOMPILER12_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER11} {$DEFINE DELPHICOMPILER11_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER10} {$DEFINE DELPHICOMPILER10_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER9} {$DEFINE DELPHICOMPILER9_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER8} {$DEFINE DELPHICOMPILER8_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER7} {$DEFINE DELPHICOMPILER7_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER6} {$DEFINE DELPHICOMPILER6_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER5} {$DEFINE DELPHICOMPILER5_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER4} {$DEFINE DELPHICOMPILER4_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER3} {$DEFINE DELPHICOMPILER3_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER2} {$DEFINE DELPHICOMPILER2_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER1} {$DEFINE DELPHICOMPILER1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ DELPHICOMPILERX_UP from DELPHICOMPILERX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF DELPHICOMPILER29_UP} {$DEFINE DELPHICOMPILER28_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER28_UP} {$DEFINE DELPHICOMPILER27_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER27_UP} {$DEFINE DELPHICOMPILER26_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER26_UP} {$DEFINE DELPHICOMPILER25_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER25_UP} {$DEFINE DELPHICOMPILER24_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER24_UP} {$DEFINE DELPHICOMPILER23_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER23_UP} {$DEFINE DELPHICOMPILER22_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER22_UP} {$DEFINE DELPHICOMPILER21_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER21_UP} {$DEFINE DELPHICOMPILER20_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER20_UP} {$DEFINE DELPHICOMPILER19_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER19_UP} {$DEFINE DELPHICOMPILER18_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER18_UP} {$DEFINE DELPHICOMPILER17_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER17_UP} {$DEFINE DELPHICOMPILER16_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER16_UP} {$DEFINE DELPHICOMPILER15_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER15_UP} {$DEFINE DELPHICOMPILER14_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER14_UP} {$DEFINE DELPHICOMPILER12_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER12_UP} {$DEFINE DELPHICOMPILER11_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER11_UP} {$DEFINE DELPHICOMPILER10_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER10_UP} {$DEFINE DELPHICOMPILER9_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER9_UP} {$DEFINE DELPHICOMPILER8_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER8_UP} {$DEFINE DELPHICOMPILER7_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER8_UP} {$DEFINE DELPHICOMPILER7_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER7_UP} {$DEFINE DELPHICOMPILER6_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER6_UP} {$DEFINE DELPHICOMPILER5_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER5_UP} {$DEFINE DELPHICOMPILER4_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER4_UP} {$DEFINE DELPHICOMPILER3_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER3_UP} {$DEFINE DELPHICOMPILER2_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER2_UP} {$DEFINE DELPHICOMPILER1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ COMPILERX_UP from COMPILERX mappings } -{------------------------------------------------------------------------------} - -{$IFDEF COMPILER29} {$DEFINE COMPILER29_UP} {$ENDIF} -{$IFDEF COMPILER28} {$DEFINE COMPILER28_UP} {$ENDIF} -{$IFDEF COMPILER27} {$DEFINE COMPILER27_UP} {$ENDIF} -{$IFDEF COMPILER26} {$DEFINE COMPILER26_UP} {$ENDIF} -{$IFDEF COMPILER25} {$DEFINE COMPILER25_UP} {$ENDIF} -{$IFDEF COMPILER24} {$DEFINE COMPILER24_UP} {$ENDIF} -{$IFDEF COMPILER23} {$DEFINE COMPILER23_UP} {$ENDIF} -{$IFDEF COMPILER22} {$DEFINE COMPILER22_UP} {$ENDIF} -{$IFDEF COMPILER21} {$DEFINE COMPILER21_UP} {$ENDIF} -{$IFDEF COMPILER20} {$DEFINE COMPILER20_UP} {$ENDIF} -{$IFDEF COMPILER19} {$DEFINE COMPILER19_UP} {$ENDIF} -{$IFDEF COMPILER18} {$DEFINE COMPILER18_UP} {$ENDIF} -{$IFDEF COMPILER17} {$DEFINE COMPILER17_UP} {$ENDIF} -{$IFDEF COMPILER16} {$DEFINE COMPILER16_UP} {$ENDIF} -{$IFDEF COMPILER15} {$DEFINE COMPILER15_UP} {$ENDIF} -{$IFDEF COMPILER14} {$DEFINE COMPILER14_UP} {$ENDIF} -{$IFDEF COMPILER12} {$DEFINE COMPILER12_UP} {$ENDIF} -{$IFDEF COMPILER11} {$DEFINE COMPILER11_UP} {$ENDIF} -{$IFDEF COMPILER10} {$DEFINE COMPILER10_UP} {$ENDIF} -{$IFDEF COMPILER9} {$DEFINE COMPILER9_UP} {$ENDIF} -{$IFDEF COMPILER8} {$DEFINE COMPILER8_UP} {$ENDIF} -{$IFDEF COMPILER7} {$DEFINE COMPILER7_UP} {$ENDIF} -{$IFDEF COMPILER6} {$DEFINE COMPILER6_UP} {$ENDIF} -{$IFDEF COMPILER5} {$DEFINE COMPILER5_UP} {$ENDIF} -{$IFDEF COMPILER4} {$DEFINE COMPILER4_UP} {$ENDIF} -{$IFDEF COMPILER35} {$DEFINE COMPILER35_UP} {$ENDIF} -{$IFDEF COMPILER3} {$DEFINE COMPILER3_UP} {$ENDIF} -{$IFDEF COMPILER2} {$DEFINE COMPILER2_UP} {$ENDIF} -{$IFDEF COMPILER1} {$DEFINE COMPILER1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ COMPILERX_UP from COMPILERX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF COMPILER29_UP} {$DEFINE COMPILER28_UP} {$ENDIF} -{$IFDEF COMPILER28_UP} {$DEFINE COMPILER27_UP} {$ENDIF} -{$IFDEF COMPILER27_UP} {$DEFINE COMPILER26_UP} {$ENDIF} -{$IFDEF COMPILER26_UP} {$DEFINE COMPILER25_UP} {$ENDIF} -{$IFDEF COMPILER25_UP} {$DEFINE COMPILER24_UP} {$ENDIF} -{$IFDEF COMPILER24_UP} {$DEFINE COMPILER23_UP} {$ENDIF} -{$IFDEF COMPILER23_UP} {$DEFINE COMPILER22_UP} {$ENDIF} -{$IFDEF COMPILER22_UP} {$DEFINE COMPILER21_UP} {$ENDIF} -{$IFDEF COMPILER21_UP} {$DEFINE COMPILER20_UP} {$ENDIF} -{$IFDEF COMPILER20_UP} {$DEFINE COMPILER19_UP} {$ENDIF} -{$IFDEF COMPILER19_UP} {$DEFINE COMPILER18_UP} {$ENDIF} -{$IFDEF COMPILER18_UP} {$DEFINE COMPILER17_UP} {$ENDIF} -{$IFDEF COMPILER17_UP} {$DEFINE COMPILER16_UP} {$ENDIF} -{$IFDEF COMPILER16_UP} {$DEFINE COMPILER15_UP} {$ENDIF} -{$IFDEF COMPILER15_UP} {$DEFINE COMPILER14_UP} {$ENDIF} -{$IFDEF COMPILER14_UP} {$DEFINE COMPILER12_UP} {$ENDIF} -{$IFDEF COMPILER12_UP} {$DEFINE COMPILER11_UP} {$ENDIF} -{$IFDEF COMPILER11_UP} {$DEFINE COMPILER10_UP} {$ENDIF} -{$IFDEF COMPILER10_UP} {$DEFINE COMPILER9_UP} {$ENDIF} -{$IFDEF COMPILER9_UP} {$DEFINE COMPILER8_UP} {$ENDIF} -{$IFDEF COMPILER8_UP} {$DEFINE COMPILER7_UP} {$ENDIF} -{$IFDEF COMPILER7_UP} {$DEFINE COMPILER6_UP} {$ENDIF} -{$IFDEF COMPILER6_UP} {$DEFINE COMPILER5_UP} {$ENDIF} -{$IFDEF COMPILER5_UP} {$DEFINE COMPILER4_UP} {$ENDIF} -{$IFDEF COMPILER4_UP} {$DEFINE COMPILER35_UP} {$ENDIF} -{$IFDEF COMPILER35_UP} {$DEFINE COMPILER3_UP} {$ENDIF} -{$IFDEF COMPILER3_UP} {$DEFINE COMPILER2_UP} {$ENDIF} -{$IFDEF COMPILER2_UP} {$DEFINE COMPILER1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ RTLX_UP from RTLX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF RTL360_UP} {$DEFINE RTL350_UP} {$ENDIF} -{$IFDEF RTL350_UP} {$DEFINE RTL340_UP} {$ENDIF} -{$IFDEF RTL340_UP} {$DEFINE RTL330_UP} {$ENDIF} -{$IFDEF RTL330_UP} {$DEFINE RTL320_UP} {$ENDIF} -{$IFDEF RTL320_UP} {$DEFINE RTL310_UP} {$ENDIF} -{$IFDEF RTL310_UP} {$DEFINE RTL300_UP} {$ENDIF} -{$IFDEF RTL300_UP} {$DEFINE RTL290_UP} {$ENDIF} -{$IFDEF RTL290_UP} {$DEFINE RTL280_UP} {$ENDIF} -{$IFDEF RTL280_UP} {$DEFINE RTL270_UP} {$ENDIF} -{$IFDEF RTL270_UP} {$DEFINE RTL260_UP} {$ENDIF} -{$IFDEF RTL260_UP} {$DEFINE RTL250_UP} {$ENDIF} -{$IFDEF RTL250_UP} {$DEFINE RTL240_UP} {$ENDIF} -{$IFDEF RTL240_UP} {$DEFINE RTL230_UP} {$ENDIF} -{$IFDEF RTL230_UP} {$DEFINE RTL220_UP} {$ENDIF} -{$IFDEF RTL220_UP} {$DEFINE RTL210_UP} {$ENDIF} -{$IFDEF RTL210_UP} {$DEFINE RTL200_UP} {$ENDIF} -{$IFDEF RTL200_UP} {$DEFINE RTL190_UP} {$ENDIF} -{$IFDEF RTL190_UP} {$DEFINE RTL185_UP} {$ENDIF} -{$IFDEF RTL185_UP} {$DEFINE RTL180_UP} {$ENDIF} -{$IFDEF RTL180_UP} {$DEFINE RTL170_UP} {$ENDIF} -{$IFDEF RTL170_UP} {$DEFINE RTL160_UP} {$ENDIF} -{$IFDEF RTL160_UP} {$DEFINE RTL150_UP} {$ENDIF} -{$IFDEF RTL150_UP} {$DEFINE RTL145_UP} {$ENDIF} -{$IFDEF RTL145_UP} {$DEFINE RTL142_UP} {$ENDIF} -{$IFDEF RTL142_UP} {$DEFINE RTL140_UP} {$ENDIF} -{$IFDEF RTL140_UP} {$DEFINE RTL130_UP} {$ENDIF} -{$IFDEF RTL130_UP} {$DEFINE RTL125_UP} {$ENDIF} -{$IFDEF RTL125_UP} {$DEFINE RTL120_UP} {$ENDIF} -{$IFDEF RTL120_UP} {$DEFINE RTL110_UP} {$ENDIF} -{$IFDEF RTL110_UP} {$DEFINE RTL100_UP} {$ENDIF} -{$IFDEF RTL100_UP} {$DEFINE RTL93_UP} {$ENDIF} -{$IFDEF RTL93_UP} {$DEFINE RTL90_UP} {$ENDIF} -{$IFDEF RTL90_UP} {$DEFINE RTL80_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ Check for CLR overrides of default detection } -{------------------------------------------------------------------------------} - -{$IFDEF CLR} - {$IFDEF FORCE_CLR10} - {$DEFINE CLR10} - {$UNDEF CLR11} - {$UNDEF CLR20} - {$ENDIF FORCE_CLR10} - - {$IFDEF FORCE_CLR11} - {$UNDEF CLR10} - {$DEFINE CLR11} - {$UNDEF CLR20} - {$ENDIF FORCE_CLR11} - - {$IFDEF FORCE_CLR20} - {$UNDEF CLR10} - {$UNDEF CLR11} - {$DEFINE CLR20} - {$ENDIF FORCE_CLR20} -{$ENDIF CLR} - -{------------------------------------------------------------------------------} -{ CLRX from CLRX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF CLR10} {$DEFINE CLR10_UP} {$ENDIF} -{$IFDEF CLR11} {$DEFINE CLR11_UP} {$ENDIF} -{$IFDEF CLR20} {$DEFINE CLR20_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ CLRX_UP from CLRX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF CLR20_UP} {$DEFINE CLR11_UP} {$ENDIF} -{$IFDEF CLR11_UP} {$DEFINE CLR10_UP} {$ENDIF} - -{------------------------------------------------------------------------------} - -{$IFDEF DELPHICOMPILER} - {$DEFINE DELPHILANGUAGE} -{$ENDIF} - -{$IFDEF BCBCOMPILER} - {$DEFINE DELPHILANGUAGE} -{$ENDIF} - -{------------------------------------------------------------------------------} -{ KYLIXX_UP from KYLIXX mappings } -{------------------------------------------------------------------------------} - -{$IFDEF KYLIX3} {$DEFINE KYLIX3_UP} {$ENDIF} -{$IFDEF KYLIX2} {$DEFINE KYLIX2_UP} {$ENDIF} -{$IFDEF KYLIX1} {$DEFINE KYLIX1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ KYLIXX_UP from KYLIXX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF KYLIX3_UP} {$DEFINE KYLIX2_UP} {$ENDIF} -{$IFDEF KYLIX2_UP} {$DEFINE KYLIX1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ Map COMPILERX_UP to friendly feature names } -{------------------------------------------------------------------------------} - -{$IFDEF FPC} - {$IFDEF VER1_0} - Please use FPC 2.0 or higher to compile this. - {$ELSE} - { FPC_FULLVERSION is available from 2.2.4 on } - - {$DEFINE SUPPORTS_OUTPARAMS} - {$DEFINE SUPPORTS_WIDECHAR} - {$DEFINE SUPPORTS_WIDESTRING} - {$IF DEFINED(VER2_0) OR DEFINED(VER2_1)} - {$IFDEF HASINTF} - {$DEFINE SUPPORTS_INTERFACE} - {$ENDIF} - {$IFDEF HASVARIANT} - {$DEFINE SUPPORTS_VARIANT} - {$ENDIF} - {$IFDEF HASCURRENCY} - {$DEFINE SUPPORTS_CURRENCY} - {$ENDIF} - {$ELSE} - {$DEFINE SUPPORTS_INTERFACE} - {$DEFINE SUPPORTS_VARIANT} - {$DEFINE SUPPORTS_CURRENCY} - {$IFEND} - {$IFDEF FPC_HAS_TYPE_SINGLE} - {$DEFINE SUPPORTS_SINGLE} - {$ENDIF} - {$IFDEF FPC_HAS_TYPE_DOUBLE} - {$DEFINE SUPPORTS_DOUBLE} - {$ENDIF} - {$IFDEF FPC_HAS_TYPE_EXTENDED} - {$DEFINE SUPPORTS_EXTENDED} - {$ENDIF} - {$DEFINE SUPPORTS_THREADVAR} - {$DEFINE SUPPORTS_CONSTPARAMS} - {$DEFINE SUPPORTS_LONGWORD} - {$DEFINE SUPPORTS_INT64} - {$DEFINE SUPPORTS_DYNAMICARRAYS} - {$DEFINE SUPPORTS_DEFAULTPARAMS} - {$DEFINE SUPPORTS_OVERLOAD} - {$DEFINE ACCEPT_DEPRECATED} // 2.2 also gives warnings - {$DEFINE ACCEPT_PLATFORM} // 2.2 also gives warnings - {$DEFINE ACCEPT_LIBRARY} - {$DEFINE SUPPORTS_DEPRECATED} - {$DEFINE SUPPORTS_PLATFORM} - {$DEFINE SUPPORTS_LIBRARY} - {$DEFINE SUPPORTS_DEPRECATED_WARNINGS} - {$DEFINE SUPPORTS_PLATFORM_WARNINGS} - {$DEFINE SUPPORTS_EXTSYM} - {$DEFINE SUPPORTS_NODEFINE} - {$DEFINE SUPPORTS_DISPINTERFACE} - {$DEFINE SUPPORTS_IMPLEMENTS} - {$DEFINE SUPPORTS_DISPID} - {$DEFINE SUPPORTS_INLINE} - {$DEFINE SUPPORTS_STATIC} - {$DEFINE SUPPORTS_COMPILETIME_MESSAGES} - - {$DEFINE SUPPORTS_CUSTOMVARIANTS} - {$DEFINE SUPPORTS_VARARGS} - {$DEFINE SUPPORTS_ENUMVALUE} - {$IF DEFINED(LINUX) AND DEFINED(CPU386)} - {$DEFINE HAS_UNIT_LIBC} - {$IFEND} - {$DEFINE HAS_UNIT_CONTNRS} - {$DEFINE HAS_UNIT_TYPES} - {$DEFINE HAS_UNIT_VARIANTS} - {$DEFINE HAS_UNIT_STRUTILS} - {$DEFINE HAS_UNIT_DATEUTILS} - {$DEFINE HAS_UNIT_RTLCONSTS} - - {$DEFINE XPLATFORM_RTL} - - {$IF DEFINED(FPC_FULLVERSION)} - { 2.2.4 or newer } - - {$DEFINE SUPPORTS_SETPEFLAGS} - {$DEFINE SUPPORTS_STRICT} - - {$IF defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 20400)} - {$DEFINE SUPPORTS_UINT64} - {$DEFINE SUPPORTS_EXPERIMENTAL_WARNINGS} - {$DEFINE SUPPORTS_REGION} - {$DEFINE SUPPORTS_UNICODE_STRING} - {$IFEND} - - {$IF defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 20402)} - {$DEFINE SUPPORTS_FOR_IN} - {$IFEND} - - {$IF defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 20600)} - {$DEFINE SUPPORTS_LIBRARY_WARNINGS} - {$DEFINE SUPPORTS_DEPRECATED_DETAILS} - {$DEFINE SUPPORTS_NESTED_TYPES} - {$DEFINE SUPPORTS_NESTED_CONSTANTS} - {$DEFINE SUPPORTS_ENHANCED_RECORDS} // called Advanced Records in FPC - {$DEFINE SUPPORTS_CLASS_FIELDS} - {$DEFINE SUPPORTS_CLASS_HELPERS} - {$DEFINE SUPPORTS_CLASS_OPERATORS} - {$DEFINE SUPPORTS_CLASS_CTORDTORS} - {$DEFINE SUPPORTS_FINAL} - {$DEFINE SUPPORTS_CAST_INTERFACE_TO_OBJ} - - {$DEFINE HAS_ENOTIMPLEMENTED} - {$IFEND} - - {$IF defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 20602)} - {$DEFINE SUPPORTS_INT_ALIASES} - - {$DEFINE HAS_EARGUMENTEXCEPTION} - {$IFEND} - - {$IF defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 30000)} - {$DEFINE SUPPORTS_GENERICS} - {$DEFINE SUPPORTS_GENERIC_TYPES} - - {$DEFINE HAS_UNIT_CHARACTER} - {$IFEND} - - {$IF defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 30200)} - {$DEFINE SUPPORTS_GENERIC_METHODS} - {$DEFINE SUPPORTS_GENERIC_ROUTINES} - {$DEFINE SUPPORTS_WEAKPACKAGEUNIT} - - {$DEFINE HAS_UNIT_RTTI} - {$DEFINE HAS_UNIT_SYSTEM_UITYPES} - {$IFEND} - {$ELSE} - { older than 2.2.4 } - - {$IFDEF VER2_2} - {$DEFINE SUPPORTS_SETPEFLAGS} - {$DEFINE SUPPORTS_STRICT} - {$ENDIF} - {$IFEND} - {$ENDIF} -{$ENDIF FPC} - -{$IFDEF CLR} - {$DEFINE SUPPORTS_UNICODE} -{$ENDIF CLR} - -{$IFDEF BORLAND} - {$IFNDEF CLR} - // The ASSEMBLER symbol appeared with Delphi 7 - {$IFNDEF COMPILER7_UP} - {$DEFINE CPUASM} - {$ELSE} - {$IFDEF ASSEMBLER} - {$DEFINE CPUASM} - {$ENDIF ASSEMBLER} - {$ENDIF ~COMPILER7_UP} - {$ENDIF ~CLR} -{$ENDIF BORLAND} - -{$IFDEF COMPILER1_UP} - {$DEFINE SUPPORTS_CONSTPARAMS} - {$DEFINE SUPPORTS_SINGLE} - {$DEFINE SUPPORTS_DOUBLE} - {$DEFINE SUPPORTS_EXTENDED} - {$DEFINE SUPPORTS_PACKAGES} -{$ENDIF COMPILER1_UP} - -{$IFDEF COMPILER2_UP} - {$DEFINE SUPPORTS_CURRENCY} - {$DEFINE SUPPORTS_THREADVAR} - {$DEFINE SUPPORTS_VARIANT} - {$DEFINE SUPPORTS_WIDECHAR} -{$ENDIF COMPILER2_UP} - -{$IFDEF COMPILER3_UP} - {$DEFINE SUPPORTS_OUTPARAMS} - {$DEFINE SUPPORTS_WIDESTRING} - {$DEFINE SUPPORTS_INTERFACE} - {$DEFINE SUPPORTS_DISPINTERFACE} - {$DEFINE SUPPORTS_DISPID} - {$DEFINE SUPPORTS_WEAKPACKAGEUNIT} -{$ENDIF COMPILER3_UP} - -{$IFDEF COMPILER35_UP} - {$DEFINE SUPPORTS_EXTSYM} - {$DEFINE SUPPORTS_NODEFINE} -{$ENDIF COMPILER35_UP} - -{$IFDEF COMPILER4_UP} - {$DEFINE SUPPORTS_LONGWORD} - {$DEFINE SUPPORTS_INT64} - {$DEFINE SUPPORTS_DYNAMICARRAYS} - {$DEFINE SUPPORTS_DEFAULTPARAMS} - {$DEFINE SUPPORTS_OVERLOAD} - {$DEFINE SUPPORTS_IMPLEMENTS} -{$ENDIF COMPILER4_UP} - -{$IFDEF COMPILER6_UP} - {$DEFINE SUPPORTS_DEPRECATED} - {$DEFINE SUPPORTS_LIBRARY} - {$DEFINE SUPPORTS_PLATFORM} - {$DEFINE SUPPORTS_LOCAL} - {$DEFINE SUPPORTS_SETPEFLAGS} - {$DEFINE SUPPORTS_EXPERIMENTAL_WARNINGS} - {$DEFINE ACCEPT_DEPRECATED} - {$DEFINE ACCEPT_PLATFORM} - {$DEFINE ACCEPT_LIBRARY} - {$DEFINE SUPPORTS_DEPRECATED_WARNINGS} - {$DEFINE SUPPORTS_LIBRARY_WARNINGS} - {$DEFINE SUPPORTS_PLATFORM_WARNINGS} - {$DEFINE SUPPORTS_CUSTOMVARIANTS} - {$DEFINE SUPPORTS_VARARGS} - {$DEFINE SUPPORTS_ENUMVALUE} - {$DEFINE SUPPORTS_COMPILETIME_MESSAGES} -{$ENDIF COMPILER6_UP} - -{$IFDEF COMPILER7_UP} - {$DEFINE SUPPORTS_UNSAFE_WARNINGS} - {$DEFINE SUPPORTS_UINT64} -{$ENDIF COMPILER7_UP} - -{$IFDEF COMPILER9_UP} - {$DEFINE SUPPORTS_FOR_IN} - {$DEFINE SUPPORTS_INLINE} - {$DEFINE SUPPORTS_NESTED_CONSTANTS} - {$DEFINE SUPPORTS_NESTED_TYPES} - {$DEFINE SUPPORTS_REGION} - {$IFDEF CLR} - {$DEFINE SUPPORTS_ENHANCED_RECORDS} - {$DEFINE SUPPORTS_CLASS_FIELDS} - {$DEFINE SUPPORTS_CLASS_HELPERS} - {$DEFINE SUPPORTS_CLASS_OPERATORS} - {$DEFINE SUPPORTS_STRICT} - {$DEFINE SUPPORTS_STATIC} - {$DEFINE SUPPORTS_FINAL} - {$ENDIF CLR} -{$ENDIF COMPILER9_UP} - -{$IFDEF COMPILER10_UP} - {$DEFINE SUPPORTS_ENHANCED_RECORDS} - {$DEFINE SUPPORTS_CLASS_FIELDS} - {$DEFINE SUPPORTS_CLASS_HELPERS} - {$DEFINE SUPPORTS_CLASS_OPERATORS} - {$DEFINE SUPPORTS_STRICT} - {$DEFINE SUPPORTS_STATIC} - {$DEFINE SUPPORTS_FINAL} - {$DEFINE SUPPORTS_METHODINFO} -{$ENDIF COMPILER10_UP} - -{$IFDEF COMPILER11_UP} - {$IFDEF CLR} - {$DEFINE SUPPORTS_GENERICS} - {$DEFINE SUPPORTS_GENERIC_TYPES} - {$DEFINE SUPPORTS_GENERIC_METHODS} - {$DEFINE SUPPORTS_DEPRECATED_DETAILS} - {$ENDIF CLR} -{$ENDIF COMPILER11_UP} - -{$IFDEF COMPILER12_UP} - {$DEFINE SUPPORTS_GENERICS} - {$DEFINE SUPPORTS_GENERIC_TYPES} - {$DEFINE SUPPORTS_GENERIC_METHODS} - {$DEFINE SUPPORTS_DEPRECATED_DETAILS} - {$DEFINE SUPPORTS_TYPED_POINTERMATH} - {$DEFINE SUPPORTS_STRINGCHECKS} - {$DEFINE SUPPORTS_INT_ALIASES} - {$DEFINE SUPPORTS_SCOPEDENUMS} - {$IFNDEF CLR} - {$DEFINE SUPPORTS_UNICODE} - {$DEFINE SUPPORTS_UNICODE_STRING} - {$ENDIF CLR} -{$ENDIF COMPILER12_UP} - -{$IFDEF COMPILER14_UP} - {$DEFINE SUPPORTS_CLASS_CTORDTORS} - {$DEFINE SUPPORTS_EXTENDED_RTTI} - {$DEFINE HAS_UNIT_RTTI} - {$DEFINE SUPPORTS_CAST_INTERFACE_TO_OBJ} - {$DEFINE SUPPORTS_DELAYED_LOADING} -{$ENDIF COMPILER14_UP} - -{$IFDEF COMPILER16_UP} - {$DEFINE USE_64BIT_TYPES} // TODO -oOutchy : Document in Feature Directives - {$DEFINE SUPPORTS_EXCESSPRECISION} - {$IFDEF CPU64} - {$DEFINE EXTENDED_IS_DOUBLE_ALIAS} - {$ENDIF} -{$ENDIF COMPILER16_UP} - -{$IFDEF COMPILER17_UP} - {$DEFINE SUPPORTS_LEGACYIFEND} -{$ENDIF COMPILER17_UP} - -{$IFDEF RTL130_UP} - {$DEFINE HAS_UNIT_CONTNRS} - {$IFDEF COMPILER25} - {$IFDEF LINUX} - {$UNDEF HAS_UNIT_CONTNRS} - {$ENDIF LINUX} - {$ENDIF COMPILER25} - {$DEFINE HAS_PROPERTY_OLDCREATEORDER} -{$ENDIF RTL130_UP} - -{$IFDEF RTL140_UP} - {$IFDEF LINUX} - {$DEFINE HAS_UNIT_LIBC} - {$ENDIF LINUX} - {$DEFINE HAS_UNIT_RTLCONSTS} - {$DEFINE HAS_UNIT_TYPES} - {$DEFINE HAS_UNIT_VARIANTS} - {$DEFINE HAS_UNIT_STRUTILS} - {$DEFINE HAS_UNIT_DATEUTILS} - {$DEFINE XPLATFORM_RTL} -{$ENDIF RTL140_UP} - -{$IFDEF RTL150_UP} - {$DEFINE HAS_UNIT_UXTHEME} -{$ENDIF RTL150_UP} - -{$IFDEF RTL170_UP} - {$DEFINE HAS_UNIT_HTTPPROD} -{$ENDIF RTL170_UP} - -{$IFDEF RTL185_UP} - {$DEFINE HAS_UNIT_GIFIMG} -{$ENDIF RTL185_UP} - -{$IFDEF RTL200_UP} - {$DEFINE HAS_UNIT_ANSISTRINGS} - {$DEFINE HAS_UNIT_PNGIMAGE} - {$DEFINE HAS_UNIT_CHARACTER} - {$DEFINE HAS_EXCEPTION_STACKTRACE} -{$ENDIF RTL200_UP} - -{$IFDEF RTL210_UP} - {$DEFINE HAS_EARGUMENTEXCEPTION} -{$ENDIF RTL210_UP} - -{$IFDEF RTL220_UP} - {$DEFINE HAS_UNIT_REGULAREXPRESSIONSAPI} - {$DEFINE HAS_ENOTIMPLEMENTED} -{$ENDIF RTL220_UP} - -{$IFDEF RTL230_UP} - {$DEFINE HAS_UNITSCOPE} - {$DEFINE HAS_UNIT_SYSTEM_UITYPES} - {$DEFINE HAS_UNIT_VCL_THEMES} - {$DEFINE HAS_UNIT_SYSTEM_ZIP} - {$DEFINE HAS_UNIT_SYSTEM_ZLIB} - {$DEFINE HAS_TSTRINGS_ENCODING} -{$ENDIF RTL230_UP} - -{$IFDEF RTL240_UP} - {$DEFINE HAS_UNIT_SYSTEM_ACTIONS} - {$DEFINE HAS_PROPERTY_STYLEELEMENTS} -{$ENDIF RTL240_UP} - -{$IFDEF RTL250_UP} - {$DEFINE DEPRECATED_SYSUTILS_ANSISTRINGS} - {$DEFINE DEPRECATED_TCHARACTER} -{$ENDIF RTL250_UP} - -{$IFDEF RTL270_UP} - {$DEFINE HAS_AUTOMATIC_DB_FIELDS} -{$ENDIF RTL270_UP} - -{$IFDEF RTL320_UP} - {$UNDEF HAS_UNIT_LIBC} -{$ENDIF RTL320_UP} - -{$IFDEF RTL350_UP} - {$UNDEF HAS_PROPERTY_OLDCREATEORDER} -{$ENDIF} - -{------------------------------------------------------------------------------} -{ Cross-platform related defines } -{------------------------------------------------------------------------------} - -{$IFNDEF CPUASM} - {$DEFINE PUREPASCAL} -{$ENDIF ~CPUASM} - -{$IFDEF WIN32} - {$DEFINE MSWINDOWS} // predefined for D6+/BCB6+ - {$DEFINE Win32API} -{$ENDIF} - -{$IFDEF DELPHILANGUAGE} - {$IFDEF LINUX} - {$DEFINE UNIX} - {$ENDIF} - - {$IFNDEF CONSOLE} - {$IFDEF LINUX} - {$DEFINE VisualCLX} - {$ENDIF} - {$IFNDEF VisualCLX} - {$DEFINE VCL} - {$ENDIF} - {$ENDIF ~CONSOLE} -{$ENDIF DELPHILANGUAGE} - -{------------------------------------------------------------------------------} -{ Compiler settings } -{------------------------------------------------------------------------------} - -{$IFOPT A+} {$DEFINE ALIGN_ON} {$ENDIF} -{$IFOPT B+} {$DEFINE BOOLEVAL_ON} {$ENDIF} -{$IFDEF COMPILER2_UP} - {$IFOPT C+} {$DEFINE ASSERTIONS_ON} {$ENDIF} -{$ENDIF} -{$IFOPT D+} {$DEFINE DEBUGINFO_ON} {$ENDIF} -{$IFOPT G+} {$DEFINE IMPORTEDDATA_ON} {$ENDIF} -{$IFDEF COMPILER2_UP} - {$IFOPT H+} {$DEFINE LONGSTRINGS_ON} {$ENDIF} -{$ENDIF} - -// Hints -{$IFOPT I+} {$DEFINE IOCHECKS_ON} {$ENDIF} -{$IFDEF COMPILER2_UP} - {$IFOPT J+} {$DEFINE WRITEABLECONST_ON} {$ENDIF} -{$ENDIF} -{$IFOPT L+} {$DEFINE LOCALSYMBOLS} {$DEFINE LOCALSYMBOLS_ON} {$ENDIF} -{$IFOPT M+} {$DEFINE TYPEINFO_ON} {$ENDIF} -{$IFOPT O+} {$DEFINE OPTIMIZATION_ON} {$ENDIF} -{$IFOPT P+} {$DEFINE OPENSTRINGS_ON} {$ENDIF} -{$IFOPT Q+} {$DEFINE OVERFLOWCHECKS_ON} {$ENDIF} -{$IFOPT R+} {$DEFINE RANGECHECKS_ON} {$ENDIF} - -// Real compatibility -{$IFOPT T+} {$DEFINE TYPEDADDRESS_ON} {$ENDIF} -{$IFOPT U+} {$DEFINE SAFEDIVIDE_ON} {$ENDIF} -{$IFOPT V+} {$DEFINE VARSTRINGCHECKS_ON} {$ENDIF} -{$IFOPT W+} {$DEFINE STACKFRAMES_ON} {$ENDIF} - -// Warnings -{$IFOPT X+} {$DEFINE EXTENDEDSYNTAX_ON} {$ENDIF} - -// for Delphi/BCB trial versions remove the point from the line below -{.$UNDEF SUPPORTS_WEAKPACKAGEUNIT} - -{$ENDIF ~JEDI_INC} +{$IFNDEF JEDI_INC} +{$DEFINE JEDI_INC} + +{**************************************************************************************************} +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License");} +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is: jedi.inc. } +{ The Initial Developer of the Original Code is Project JEDI http://www.delphi-jedi.org } +{ } +{ Alternatively, the contents of this file may be used under the terms of the GNU Lesser General } +{ Public License (the "LGPL License"), in which case the provisions of the LGPL License are } +{ applicable instead of those above. If you wish to allow use of your version of this file only } +{ under the terms of the LGPL License and not to allow others to use your version of this file } +{ under the MPL, indicate your decision by deleting the provisions above and replace them with } +{ the notice and other provisions required by the LGPL License. If you do not delete the } +{ provisions above, a recipient may use your version of this file under either the MPL or the } +{ LGPL License. } +{ } +{ For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html } +{ } +{**************************************************************************************************} +{ } +{ This file defines various generic compiler directives used in different libraries, e.g. in the } +{ JEDI Code Library (JCL) and JEDI Visual Component Library Library (JVCL). The directives in } +{ this file are of generic nature and consist mostly of mappings from the VERXXX directives } +{ defined by Delphi, C++Builder and FPC to friendly names such as DELPHI5 and } +{ SUPPORTS_WIDESTRING. These friendly names are subsequently used in the libraries to test for } +{ compiler versions and/or whether the compiler supports certain features (such as widestrings or } +{ 64 bit integers. The libraries provide an additional, library specific, include file. For the } +{ JCL e.g. this is jcl.inc. These files should be included in source files instead of this file } +{ (which is pulled in automatically). } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +(* + +- Development environment directives + + This file defines two directives to indicate which development environment the + library is being compiled with. Currently this can either be Delphi, Kylix, + C++Builder or FPC. + + Directive Description + ------------------------------------------------------------------------------ + DELPHI Defined if compiled with Delphi + KYLIX Defined if compiled with Kylix + DELPHICOMPILER Defined if compiled with Delphi or Kylix/Delphi + BCB Defined if compiled with C++Builder + CPPBUILDER Defined if compiled with C++Builder (alias for BCB) + BCBCOMPILER Defined if compiled with C++Builder or Kylix/C++ + DELPHILANGUAGE Defined if compiled with Delphi, Kylix or C++Builder + BORLAND Defined if compiled with Delphi, Kylix or C++Builder + FPC Defined if compiled with FPC + OXYGENE Defined if compiled with Oxygene + +- Platform Directives + + Platform directives are not all explicitly defined in this file, some are + defined by the compiler itself. They are listed here only for completeness. + + Directive Description + ------------------------------------------------------------------------------ + WIN32 Defined when target platform is 32 bit Windows + WIN64 Defined when target platform is 64 bit Windows + MSWINDOWS Defined when target platform is 32 bit Windows + LINUX Defined when target platform is Linux + UNIX Defined when target platform is Unix-like (including Linux) + CLR Defined when target platform is .NET + +- Architecture directives. These are auto-defined by FPC + CPU32 and CPU64 are mostly for generic pointer size dependant differences rather + than for a specific architecture. + + CPU386 Defined when target platform is native x86 (win32) + CPUx86_64 Defined when target platform is native x86_64 (win64) + CPU32 Defined when target is 32-bit + CPU64 Defined when target is 64-bit + CPUASM Defined when target assembler is available + +- Visual library Directives + + The following directives indicate for a visual library. In a Delphi/BCB + (Win32) application you need to define the VisualCLX symbol in the project + options, if you want to use the VisualCLX library. Alternatively you can use + the IDE expert, which is distributed with the JCL to do this automatically. + + Directive Description + ------------------------------------------------------------------------------ + VCL Defined for Delphi/BCB (Win32) exactly if VisualCLX is not defined + VisualCLX Defined for Kylix; needs to be defined for Delphi/BCB to + use JCL with VisualCLX applications. + + +- Other cross-platform related defines + + These symbols are intended to help in writing portable code. + + Directive Description + ------------------------------------------------------------------------------ + PUREPASCAL Code is machine-independent (as opposed to assembler code) + Win32API Code is specific for the Win32 API; + use instead of "{$IFNDEF CLR} {$IFDEF MSWINDOWS}" constructs + + +- Delphi Versions + + The following directives are direct mappings from the VERXXX directives to a + friendly name of the associated compiler. These directives are only defined if + the compiler is Delphi (ie DELPHI is defined). + + Directive Description + ------------------------------------------------------------------------------ + DELPHI1 Defined when compiling with Delphi 1 (Codename WASABI/MANGO) + DELPHI2 Defined when compiling with Delphi 2 (Codename POLARIS) + DELPHI3 Defined when compiling with Delphi 3 (Codename IVORY) + DELPHI4 Defined when compiling with Delphi 4 (Codename ALLEGRO) + DELPHI5 Defined when compiling with Delphi 5 (Codename ARGUS) + DELPHI6 Defined when compiling with Delphi 6 (Codename ILLIAD) + DELPHI7 Defined when compiling with Delphi 7 (Codename AURORA) + DELPHI8 Defined when compiling with Delphi 8 (Codename OCTANE) + DELPHI2005 Defined when compiling with Delphi 2005 (Codename DIAMONDBACK) + DELPHI9 Alias for DELPHI2005 + DELPHI10 Defined when compiling with Delphi 2006 (Codename DEXTER) + DELPHI2006 Alias for DELPHI10 + DELPHI11 Defined when compiling with Delphi 2007 for Win32 (Codename SPACELY) + DELPHI2007 Alias for DELPHI11 + DELPHI12 Defined when compiling with Delphi 2009 for Win32 (Codename TIBURON) + DELPHI2009 Alias for DELPHI12 + DELPHI14 Defined when compiling with Delphi 2010 for Win32 (Codename WEAVER) + DELPHI2010 Alias for DELPHI14 + DELPHI15 Defined when compiling with Delphi XE for Win32 (Codename FULCRUM) + DELPHIXE Alias for DELPHI15 + DELPHI16 Defined when compiling with Delphi XE2 for Win32 (Codename PULSAR) + DELPHIXE2 Alias for DELPHI16 + DELPHI17 Defined when compiling with Delphi XE3 for Win32 (Codename WATERDRAGON) + DELPHIXE3 Alias for DELPHI17 + DELPHI18 Defined when compiling with Delphi XE4 for Win32 (Codename QUINTESSENCE) + DELPHIXE4 Alias for DELPHI18 + DELPHI19 Defined when compiling with Delphi XE5 for Win32 (Codename ZEPHYR) + DELPHIXE5 Alias for DELPHI19 + DELPHI20 Defined when compiling with Delphi XE6 for Win32 (Codename PROTEUS) + DELPHIXE6 Alias for DELPHI20 + DELPHI21 Defined when compiling with Delphi XE7 for Win32 (Codename CARPATHIA) + DELPHIXE7 Alias for DELPHI21 + DELPHI22 Defined when compiling with Delphi XE8 for Win32 (Codename ELBRUS) + DELPHIXE8 Alias for DELPHI22 + DELPHI23 Defined when compiling with Delphi 10 for Win32 (Codename AITANA) + DELPHIX_SEATTLE Alias for DELPHI23 + DELPHI24 Defined when compiling with Delphi 10.1 for Win32 (Codename BIGBEN) + DELPHIX_BERLIN Alias for DELPHI24 + DELPHI25 Defined when compiling with Delphi 10.2 for Win32 (Codename GODZILLA) + DELPHIX_TOKYO Alias for DELPHI25 + DELPHI26 Defined when compiling with Delphi 10.3 for Win32 (Codename CARNIVAL) + DELPHIX_RIO Alias for DELPHI26 + DELPHI27 Defined when compiling with Delphi 10.4 for Win32 (Codename DENALI) + DELPHIX_SYDNEY Alias for DELPHI27 + DELPHI28 Defined when compiling with Delphi 11 for Win32 (Codename OLYMPUS) + DELPHIX_ALEXANDRIA Alias for DELPHI28 + DELPHI29 Defined when compiling with Delphi 12 for Win32 (Codename YUKON) + DELPHI_ATHENS Alias for DELPHI29 + DELPHI37 Defined when compiling with Delphi 13 for Win32 (Codename GANYMEDE) + DELPHI_FLORENCE Alias for DELPHI37 + DELPHI1_UP Defined when compiling with Delphi 1 or higher + DELPHI2_UP Defined when compiling with Delphi 2 or higher + DELPHI3_UP Defined when compiling with Delphi 3 or higher + DELPHI4_UP Defined when compiling with Delphi 4 or higher + DELPHI5_UP Defined when compiling with Delphi 5 or higher + DELPHI6_UP Defined when compiling with Delphi 6 or higher + DELPHI7_UP Defined when compiling with Delphi 7 or higher + DELPHI8_UP Defined when compiling with Delphi 8 or higher + DELPHI2005_UP Defined when compiling with Delphi 2005 or higher + DELPHI9_UP Alias for DELPHI2005_UP + DELPHI10_UP Defined when compiling with Delphi 2006 or higher + DELPHI2006_UP Alias for DELPHI10_UP + DELPHI11_UP Defined when compiling with Delphi 2007 for Win32 or higher + DELPHI2007_UP Alias for DELPHI11_UP + DELPHI12_UP Defined when compiling with Delphi 2009 for Win32 or higher + DELPHI2009_UP Alias for DELPHI12_UP + DELPHI14_UP Defined when compiling with Delphi 2010 for Win32 or higher + DELPHI2010_UP Alias for DELPHI14_UP + DELPHI15_UP Defined when compiling with Delphi XE for Win32 or higher + DELPHIXE_UP Alias for DELPHI15_UP + DELPHI16_UP Defined when compiling with Delphi XE2 for Win32 or higher + DELPHIXE2_UP Alias for DELPHI16_UP + DELPHI17_UP Defined when compiling with Delphi XE3 for Win32 or higher + DELPHIXE3_UP Alias for DELPHI17_UP + DELPHI18_UP Defined when compiling with Delphi XE4 for Win32 or higher + DELPHIXE4_UP Alias for DELPHI18_UP + DELPHI19_UP Defined when compiling with Delphi XE5 for Win32 or higher + DELPHIXE5_UP Alias for DELPHI19_UP + DELPHI20_UP Defined when compiling with Delphi XE6 for Win32 or higher + DELPHIXE6_UP Alias for DELPHI20_UP + DELPHI21_UP Defined when compiling with Delphi XE7 for Win32 or higher + DELPHIXE7_UP Alias for DELPHI21_UP + DELPHI22_UP Defined when compiling with Delphi XE8 for Win32 or higher + DELPHIXE8_UP Alias for DELPHI22_UP + DELPHI23_UP Defined when compiling with Delphi 10 for Win32 or higher + DELPHIX_SEATTLE_UP Alias for DELPHI23_UP + DELPHI24_UP Defined when compiling with Delphi 10.1 for Win32 or higher + DELPHIX_BERLIN_UP Alias for DELPHI24_UP + DELPHI25_UP Defined when compiling with Delphi 10.2 for Win32 or higher + DELPHIX_TOKYO_UP Alias for DELPHI25_UP + DELPHI26_UP Defined when compiling with Delphi 10.3 for Win32 or higher + DELPHIX_RIO_UP Alias for DELPHI26_UP + DELPHI27_UP Defined when compiling with Delphi 10.4 for Win32 or higher + DELPHIX_SYDNEY_UP Alias for DELPHI27_UP + DELPHI28_UP Defined when compiling with Delphi 11 for Win32 or higher + DELPHIX_ALEXANDRIA_UP Alias for DELPHI28_UP + DELPHI29_UP Defined when compiling with Delphi 12 for Win32 or higher + DELPHI_ATHENS_UP Alias for DELPHI29_UP + DELPHI37_UP Defined when compiling with Delphi 13 for Win32 or higher + DELPHI_FLORENCE_UP Alias for DELPHI37_UP + + +- Kylix Versions + + The following directives are direct mappings from the VERXXX directives to a + friendly name of the associated compiler. These directives are only defined if + the compiler is Kylix (ie KYLIX is defined). + + Directive Description + ------------------------------------------------------------------------------ + KYLIX1 Defined when compiling with Kylix 1 + KYLIX2 Defined when compiling with Kylix 2 + KYLIX3 Defined when compiling with Kylix 3 (Codename CORTEZ) + KYLIX1_UP Defined when compiling with Kylix 1 or higher + KYLIX2_UP Defined when compiling with Kylix 2 or higher + KYLIX3_UP Defined when compiling with Kylix 3 or higher + + +- Delphi Compiler Versions (Delphi / Kylix, not in BCB mode) + + Directive Description + ------------------------------------------------------------------------------ + DELPHICOMPILER1 Defined when compiling with Delphi 1 + DELPHICOMPILER2 Defined when compiling with Delphi 2 + DELPHICOMPILER3 Defined when compiling with Delphi 3 + DELPHICOMPILER4 Defined when compiling with Delphi 4 + DELPHICOMPILER5 Defined when compiling with Delphi 5 + DELPHICOMPILER6 Defined when compiling with Delphi 6 or Kylix 1, 2 or 3 + DELPHICOMPILER7 Defined when compiling with Delphi 7 + DELPHICOMPILER8 Defined when compiling with Delphi 8 + DELPHICOMPILER9 Defined when compiling with Delphi 2005 + DELPHICOMPILER10 Defined when compiling with Delphi Personality of BDS 4.0 + DELPHICOMPILER11 Defined when compiling with Delphi 2007 for Win32 + DELPHICOMPILER12 Defined when compiling with Delphi Personality of BDS 6.0 + DELPHICOMPILER14 Defined when compiling with Delphi Personality of BDS 7.0 + DELPHICOMPILER15 Defined when compiling with Delphi Personality of BDS 8.0 + DELPHICOMPILER16 Defined when compiling with Delphi Personality of BDS 9.0 + DELPHICOMPILER17 Defined when compiling with Delphi Personality of BDS 10.0 + DELPHICOMPILER18 Defined when compiling with Delphi Personality of BDS 11.0 + DELPHICOMPILER19 Defined when compiling with Delphi Personality of BDS 12.0 + DELPHICOMPILER20 Defined when compiling with Delphi Personality of BDS 14.0 + DELPHICOMPILER21 Defined when compiling with Delphi Personality of BDS 15.0 + DELPHICOMPILER22 Defined when compiling with Delphi Personality of BDS 16.0 + DELPHICOMPILER23 Defined when compiling with Delphi Personality of BDS 17.0 + DELPHICOMPILER24 Defined when compiling with Delphi Personality of BDS 18.0 + DELPHICOMPILER25 Defined when compiling with Delphi Personality of BDS 19.0 + DELPHICOMPILER26 Defined when compiling with Delphi Personality of BDS 20.0 + DELPHICOMPILER27 Defined when compiling with Delphi Personality of BDS 21.0 + DELPHICOMPILER28 Defined when compiling with Delphi Personality of BDS 22.0 + DELPHICOMPILER29 Defined when compiling with Delphi Personality of BDS 23.0 + DELPHICOMPILER37 Defined when compiling with Delphi Personality of BDS 37.0 + DELPHICOMPILER1_UP Defined when compiling with Delphi 1 or higher + DELPHICOMPILER2_UP Defined when compiling with Delphi 2 or higher + DELPHICOMPILER3_UP Defined when compiling with Delphi 3 or higher + DELPHICOMPILER4_UP Defined when compiling with Delphi 4 or higher + DELPHICOMPILER5_UP Defined when compiling with Delphi 5 or higher + DELPHICOMPILER6_UP Defined when compiling with Delphi 6 or Kylix 1, 2 or 3 or higher + DELPHICOMPILER7_UP Defined when compiling with Delphi 7 or higher + DELPHICOMPILER8_UP Defined when compiling with Delphi 8 or higher + DELPHICOMPILER9_UP Defined when compiling with Delphi 2005 + DELPHICOMPILER10_UP Defined when compiling with Delphi 2006 or higher + DELPHICOMPILER11_UP Defined when compiling with Delphi 2007 for Win32 or higher + DELPHICOMPILER12_UP Defined when compiling with Delphi 2009 for Win32 or higher + DELPHICOMPILER14_UP Defined when compiling with Delphi 2010 for Win32 or higher + DELPHICOMPILER15_UP Defined when compiling with Delphi XE for Win32 or higher + DELPHICOMPILER16_UP Defined when compiling with Delphi XE2 for Win32 or higher + DELPHICOMPILER17_UP Defined when compiling with Delphi XE3 for Win32 or higher + DELPHICOMPILER18_UP Defined when compiling with Delphi XE4 for Win32 or higher + DELPHICOMPILER19_UP Defined when compiling with Delphi XE5 for Win32 or higher + DELPHICOMPILER20_UP Defined when compiling with Delphi XE6 for Win32 or higher + DELPHICOMPILER21_UP Defined when compiling with Delphi XE7 for Win32 or higher + DELPHICOMPILER22_UP Defined when compiling with Delphi XE8 for Win32 or higher + DELPHICOMPILER23_UP Defined when compiling with Delphi 10 for Win32 or higher + DELPHICOMPILER24_UP Defined when compiling with Delphi 10.1 for Win32 or higher + DELPHICOMPILER25_UP Defined when compiling with Delphi 10.2 for Win32 or higher + DELPHICOMPILER26_UP Defined when compiling with Delphi 10.3 for Win32 or higher + DELPHICOMPILER27_UP Defined when compiling with Delphi 10.4 for Win32 or higher + DELPHICOMPILER28_UP Defined when compiling with Delphi 11 for Win32 or higher + DELPHICOMPILER29_UP Defined when compiling with Delphi 12 for Win32 or higher + DELPHICOMPILER37_UP Defined when compiling with Delphi 13 for Win32 or higher + + +- C++Builder Versions + + The following directives are direct mappings from the VERXXX directives to a + friendly name of the associated compiler. These directives are only defined if + the compiler is C++Builder (ie BCB is defined). + + Directive Description + ------------------------------------------------------------------------------ + BCB1 Defined when compiling with C++Builder 1 + BCB3 Defined when compiling with C++Builder 3 + BCB4 Defined when compiling with C++Builder 4 + BCB5 Defined when compiling with C++Builder 5 (Codename RAMPAGE) + BCB6 Defined when compiling with C++Builder 6 (Codename RIPTIDE) + BCB10 Defined when compiling with C++Builder Personality of BDS 4.0 (also known as C++Builder 2006) (Codename DEXTER) + BCB11 Defined when compiling with C++Builder Personality of RAD Studio 2007 (also known as C++Builder 2007) (Codename COGSWELL) + BCB12 Defined when compiling with C++Builder Personality of RAD Studio 2009 (also known as C++Builder 2009) (Codename TIBURON) + BCB14 Defined when compiling with C++Builder Personality of RAD Studio 2010 (also known as C++Builder 2010) (Codename WEAVER) + BCB15 Defined when compiling with C++Builder Personality of RAD Studio XE (also known as C++Builder XE) (Codename FULCRUM) + BCB16 Defined when compiling with C++Builder Personality of RAD Studio XE2 (also known as C++Builder XE2) (Codename PULSAR) + BCB17 Defined when compiling with C++Builder Personality of RAD Studio XE3 (also known as C++Builder XE3) (Codename WATERDRAGON) + BCB18 Defined when compiling with C++Builder Personality of RAD Studio XE4 (also known as C++Builder XE4) (Codename QUINTESSENCE) + BCB19 Defined when compiling with C++Builder Personality of RAD Studio XE5 (also known as C++Builder XE5) (Codename ZEPHYR) + BCB20 Defined when compiling with C++Builder Personality of RAD Studio XE6 (also known as C++Builder XE6) (Codename PROTEUS) + BCB21 Defined when compiling with C++Builder Personality of RAD Studio XE7 (also known as C++Builder XE7) (Codename CARPATHIA) + BCB22 Defined when compiling with C++Builder Personality of RAD Studio XE8 (also known as C++Builder XE8) (Codename ELBRUS) + BCB23 Defined when compiling with C++Builder Personality of RAD Studio 10 Seattle (also known as C++Builder 10 Seattle) (Codename AITANA) + BCB24 Defined when compiling with C++Builder Personality of RAD Studio 10.1 Berlin (also known as C++Builder 10.1 Berlin) (Codename BIGBEN) + BCB25 Defined when compiling with C++Builder Personality of RAD Studio 10.2 Tokyo (also known as C++Builder 10.2 Tokyo) (Codename GODZILLA) + BCB26 Defined when compiling with C++Builder Personality of RAD Studio 10.3 Rio (also known as C++Builder 10.3 Rio) (Codename CARNIVAL) + BCB27 Defined when compiling with C++Builder Personality of RAD Studio 10.4 Sydney (also known as C++Builder 10.4 Sydney) (Codename DENALI) + BCB28 Defined when compiling with C++Builder Personality of RAD Studio 11 Alexandria (also known as C++Builder 11 Alexandria) (Codename OLYMPUS) + BCB29 Defined when compiling with C++Builder Personality of RAD Studio 12 Athens (also known as C++Builder 12 Athens) (Codename YUKON) + BCB37 Defined when compiling with C++Builder Personality of RAD Studio 13 Florence (also known as C++Builder 13 Florence) (Codename GANYMEDE) + BCB1_UP Defined when compiling with C++Builder 1 or higher + BCB3_UP Defined when compiling with C++Builder 3 or higher + BCB4_UP Defined when compiling with C++Builder 4 or higher + BCB5_UP Defined when compiling with C++Builder 5 or higher + BCB6_UP Defined when compiling with C++Builder 6 or higher + BCB10_UP Defined when compiling with C++Builder Personality of BDS 4.0 or higher + BCB11_UP Defined when compiling with C++Builder Personality of RAD Studio 2007 or higher + BCB12_UP Defined when compiling with C++Builder Personality of RAD Studio 2009 or higher + BCB14_UP Defined when compiling with C++Builder Personality of RAD Studio 2010 or higher + BCB15_UP Defined when compiling with C++Builder Personality of RAD Studio XE or higher + BCB16_UP Defined when compiling with C++Builder Personality of RAD Studio XE2 or higher + BCB17_UP Defined when compiling with C++Builder Personality of RAD Studio XE3 or higher + BCB18_UP Defined when compiling with C++Builder Personality of RAD Studio XE4 or higher + BCB19_UP Defined when compiling with C++Builder Personality of RAD Studio XE5 or higher + BCB20_UP Defined when compiling with C++Builder Personality of RAD Studio XE6 or higher + BCB21_UP Defined when compiling with C++Builder Personality of RAD Studio XE7 or higher + BCB22_UP Defined when compiling with C++Builder Personality of RAD Studio XE8 or higher + BCB23_UP Defined when compiling with C++Builder Personality of RAD Studio 10 or higher + BCB24_UP Defined when compiling with C++Builder Personality of RAD Studio 10.1 or higher + BCB25_UP Defined when compiling with C++Builder Personality of RAD Studio 10.2 or higher + BCB26_UP Defined when compiling with C++Builder Personality of RAD Studio 10.3 or higher + BCB27_UP Defined when compiling with C++Builder Personality of RAD Studio 10.4 or higher + BCB28_UP Defined when compiling with C++Builder Personality of RAD Studio 11 or higher + BCB29_UP Defined when compiling with C++Builder Personality of RAD Studio 12 or higher + BCB37_UP Defined when compiling with C++Builder Personality of RAD Studio 13 or higher + + +- RAD Studio / Borland Developer Studio Versions + + The following directives are direct mappings from the VERXXX directives to a + friendly name of the associated IDE. These directives are only defined if + the IDE is Borland Developer Studio Version 2 or above. + + Note: Borland Developer Studio 2006 is marketed as Delphi 2006 or C++Builder 2006, + but those provide only different labels for identical content. + + Directive Description + ------------------------------------------------------------------------------ + BDS Defined when compiling with BDS version of dcc32.exe (Codename SIDEWINDER) + BDS2 Defined when compiling with BDS 2.0 (Delphi 8) (Codename OCTANE) + BDS3 Defined when compiling with BDS 3.0 (Delphi 2005) (Codename DIAMONDBACK) + BDS4 Defined when compiling with BDS 4.0 (Borland Developer Studio 2006) (Codename DEXTER) + BDS5 Defined when compiling with BDS 5.0 (CodeGear RAD Studio 2007) (Codename HIGHLANDER) + BDS6 Defined when compiling with BDS 6.0 (CodeGear RAD Studio 2009) (Codename TIBURON) + BDS7 Defined when compiling with BDS 7.0 (Embarcadero RAD Studio 2010) (Codename WEAVER) + BDS8 Defined when compiling with BDS 8.0 (Embarcadero RAD Studio XE) (Codename FULCRUM) + BDS9 Defined when compiling with BDS 9.0 (Embarcadero RAD Studio XE2) (Codename PULSAR) + BDS10 Defined when compiling with BDS 10.0 (Embarcadero RAD Studio XE3) (Codename WATERDRAGON) + BDS11 Defined when compiling with BDS 11.0 (Embarcadero RAD Studio XE4) (Codename QUINTESSENCE) + BDS12 Defined when compiling with BDS 12.0 (Embarcadero RAD Studio XE5) (Codename ZEPHYR) + BDS14 Defined when compiling with BDS 14.0 (Embarcadero RAD Studio XE6) (Codename PROTEUS) + BDS15 Defined when compiling with BDS 15.0 (Embarcadero RAD Studio XE7) (Codename CARPATHIA) + BDS16 Defined when compiling with BDS 16.0 (Embarcadero RAD Studio XE8) (Codename ELBRUS) + BDS17 Defined when compiling with BDS 17.0 (Embarcadero RAD Studio 10) (Codename AITANA) + BDS18 Defined when compiling with BDS 18.0 (Embarcadero RAD Studio 10.1) (Codename BIGBEN) + BDS19 Defined when compiling with BDS 19.0 (Embarcadero RAD Studio 10.2) (Codename GODZILLA) + BDS20 Defined when compiling with BDS 20.0 (Embarcadero RAD Studio 10.3) (Codename CARNIVAL) + BDS21 Defined when compiling with BDS 21.0 (Embarcadero RAD Studio 10.4) (Codename DENALI) + BDS22 Defined when compiling with BDS 22.0 (Embarcadero RAD Studio 11) (Codename OLYMPUS) + BDS23 Defined when compiling with BDS 23.0 (Embarcadero RAD Studio 12) (Codename YUKON) + BDS37 Defined when compiling with BDS 37.0 (Embarcadero RAD Studio 13) (Codename GANYMEDE) + BDS2_UP Defined when compiling with BDS 2.0 or higher + BDS3_UP Defined when compiling with BDS 3.0 or higher + BDS4_UP Defined when compiling with BDS 4.0 or higher + BDS5_UP Defined when compiling with BDS 5.0 or higher + BDS6_UP Defined when compiling with BDS 6.0 or higher + BDS7_UP Defined when compiling with BDS 7.0 or higher + BDS8_UP Defined when compiling with BDS 8.0 or higher + BDS9_UP Defined when compiling with BDS 9.0 or higher + BDS10_UP Defined when compiling with BDS 10.0 or higher + BDS11_UP Defined when compiling with BDS 11.0 or higher + BDS12_UP Defined when compiling with BDS 12.0 or higher + BDS14_UP Defined when compiling with BDS 14.0 or higher + BDS15_UP Defined when compiling with BDS 15.0 or higher + BDS16_UP Defined when compiling with BDS 16.0 or higher + BDS17_UP Defined when compiling with BDS 17.0 or higher + BDS18_UP Defined when compiling with BDS 18.0 or higher + BDS19_UP Defined when compiling with BDS 19.0 or higher + BDS20_UP Defined when compiling with BDS 20.0 or higher + BDS21_UP Defined when compiling with BDS 21.0 or higher + BDS22_UP Defined when compiling with BDS 22.0 or higher + BDS23_UP Defined when compiling with BDS 23.0 or higher + BDS37_UP Defined when compiling with BDS 37.0 or higher + +- Compiler Versions + + The following directives are direct mappings from the VERXXX directives to a + friendly name of the associated compiler. Unlike the DELPHI_X and BCB_X + directives, these directives are indepedent of the development environment. + That is, they are defined regardless of whether compilation takes place using + Delphi or C++Builder. + + Directive Description + ------------------------------------------------------------------------------ + COMPILER1 Defined when compiling with Delphi 1 + COMPILER2 Defined when compiling with Delphi 2 or C++Builder 1 + COMPILER3 Defined when compiling with Delphi 3 + COMPILER35 Defined when compiling with C++Builder 3 + COMPILER4 Defined when compiling with Delphi 4 or C++Builder 4 + COMPILER5 Defined when compiling with Delphi 5 or C++Builder 5 + COMPILER6 Defined when compiling with Delphi 6 or C++Builder 6 + COMPILER7 Defined when compiling with Delphi 7 + COMPILER8 Defined when compiling with Delphi 8 + COMPILER9 Defined when compiling with Delphi 9 + COMPILER10 Defined when compiling with Delphi or C++Builder Personalities of BDS 4.0 + COMPILER11 Defined when compiling with Delphi or C++Builder Personalities of BDS 5.0 + COMPILER12 Defined when compiling with Delphi or C++Builder Personalities of BDS 6.0 + COMPILER14 Defined when compiling with Delphi or C++Builder Personalities of BDS 7.0 + COMPILER15 Defined when compiling with Delphi or C++Builder Personalities of BDS 8.0 + COMPILER16 Defined when compiling with Delphi or C++Builder Personalities of BDS 9.0 + COMPILER17 Defined when compiling with Delphi or C++Builder Personalities of BDS 10.0 + COMPILER18 Defined when compiling with Delphi or C++Builder Personalities of BDS 11.0 + COMPILER19 Defined when compiling with Delphi or C++Builder Personalities of BDS 12.0 + COMPILER20 Defined when compiling with Delphi or C++Builder Personalities of BDS 14.0 + COMPILER21 Defined when compiling with Delphi or C++Builder Personalities of BDS 15.0 + COMPILER22 Defined when compiling with Delphi or C++Builder Personalities of BDS 16.0 + COMPILER23 Defined when compiling with Delphi or C++Builder Personalities of BDS 17.0 + COMPILER24 Defined when compiling with Delphi or C++Builder Personalities of BDS 18.0 + COMPILER25 Defined when compiling with Delphi or C++Builder Personalities of BDS 19.0 + COMPILER26 Defined when compiling with Delphi or C++Builder Personalities of BDS 20.0 + COMPILER27 Defined when compiling with Delphi or C++Builder Personalities of BDS 21.0 + COMPILER28 Defined when compiling with Delphi or C++Builder Personalities of BDS 22.0 + COMPILER29 Defined when compiling with Delphi or C++Builder Personalities of BDS 23.0 + COMPILER37 Defined when compiling with Delphi or C++Builder Personalities of BDS 37.0 + COMPILER1_UP Defined when compiling with Delphi 1 or higher + COMPILER2_UP Defined when compiling with Delphi 2 or C++Builder 1 or higher + COMPILER3_UP Defined when compiling with Delphi 3 or higher + COMPILER35_UP Defined when compiling with C++Builder 3 or higher + COMPILER4_UP Defined when compiling with Delphi 4 or C++Builder 4 or higher + COMPILER5_UP Defined when compiling with Delphi 5 or C++Builder 5 or higher + COMPILER6_UP Defined when compiling with Delphi 6 or C++Builder 6 or higher + COMPILER7_UP Defined when compiling with Delphi 7 + COMPILER8_UP Defined when compiling with Delphi 8 + COMPILER9_UP Defined when compiling with Delphi Personalities of BDS 3.0 + COMPILER10_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 4.0 or higher + COMPILER11_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 5.0 or higher + COMPILER12_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 6.0 or higher + COMPILER14_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 7.0 or higher + COMPILER15_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 8.0 or higher + COMPILER16_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 9.0 or higher + COMPILER17_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 10.0 or higher + COMPILER18_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 11.0 or higher + COMPILER19_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 12.0 or higher + COMPILER20_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 14.0 or higher + COMPILER21_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 15.0 or higher + COMPILER22_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 16.0 or higher + COMPILER23_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 17.0 or higher + COMPILER24_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 18.0 or higher + COMPILER25_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 19.0 or higher + COMPILER26_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 20.0 or higher + COMPILER27_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 21.0 or higher + COMPILER28_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 22.0 or higher + COMPILER29_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 23.0 or higher + COMPILER37_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 37.0 or higher + + +- RTL Versions + + Use e.g. following to determine the exact RTL version since version 14.0: + {$IFDEF CONDITIONALEXPRESSIONS} + {$IF Declared(RTLVersion) and (RTLVersion >= 14.2)} + // code for Delphi 6.02 or higher, Kylix 2 or higher, C++Builder 6 or higher + ... + {$IFEND} + {$ENDIF} + + Directive Description + ------------------------------------------------------------------------------ + RTL80_UP Defined when compiling with Delphi 1 or higher + RTL90_UP Defined when compiling with Delphi 2 or higher + RTL93_UP Defined when compiling with C++Builder 1 or higher + RTL100_UP Defined when compiling with Delphi 3 or higher + RTL110_UP Defined when compiling with C++Builder 3 or higher + RTL120_UP Defined when compiling with Delphi 4 or higher + RTL125_UP Defined when compiling with C++Builder 4 or higher + RTL130_UP Defined when compiling with Delphi 5 or C++Builder 5 or higher + RTL140_UP Defined when compiling with Delphi 6, Kylix 1, 2 or 3 or C++Builder 6 or higher + RTL150_UP Defined when compiling with Delphi 7 or higher + RTL160_UP Defined when compiling with Delphi 8 or higher + RTL170_UP Defined when compiling with Delphi Personalities of BDS 3.0 or higher + RTL180_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 4.0 or higher + RTL185_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 5.0 or higher + RTL190_UP Defined when compiling with Delphi.NET of BDS 5.0 or higher + RTL200_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 6.0 or higher + RTL210_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 7.0 or higher + RTL220_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 8.0 or higher + RTL230_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 9.0 or higher + RTL240_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 10.0 or higher + RTL250_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 11.0 or higher + RTL260_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 12.0 or higher + RTL270_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 14.0 or higher + RTL280_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 15.0 or higher + RTL290_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 16.0 or higher + RTL300_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 17.0 or higher + RTL310_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 18.0 or higher + RTL320_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 19.0 or higher + RTL330_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 20.0 or higher + RTL340_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 21.0 or higher + RTL350_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 22.0 or higher + RTL360_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 23.0 or higher + RTL370_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 37.0 or higher + + +- CLR Versions + + Directive Description + ------------------------------------------------------------------------------ + CLR Defined when compiling for .NET + CLR10 Defined when compiling for .NET 1.0 (may be overriden by FORCE_CLR10) + CLR10_UP Defined when compiling for .NET 1.0 or higher + CLR11 Defined when compiling for .NET 1.1 (may be overriden by FORCE_CLR11) + CLR11_UP Defined when compiling for .NET 1.1 or higher + CLR20 Defined when compiling for .NET 2.0 (may be overriden by FORCE_CLR20) + CLR20_UP Defined when compiling for .NET 2.0 or higher + + +- Feature Directives + + The features directives are used to test if the compiler supports specific + features, such as method overloading, and adjust the sources accordingly. Use + of these directives is preferred over the use of the DELPHI and COMPILER + directives. + + Directive Description + ------------------------------------------------------------------------------ + SUPPORTS_CONSTPARAMS Compiler supports const parameters (D1+) + SUPPORTS_SINGLE Compiler supports the Single type (D1+) + SUPPORTS_DOUBLE Compiler supports the Double type (D1+) + SUPPORTS_EXTENDED Compiler supports the Extended type (D1+) + SUPPORTS_CURRENCY Compiler supports the Currency type (D2+) + SUPPORTS_THREADVAR Compiler supports threadvar declarations (D2+) + SUPPORTS_OUTPARAMS Compiler supports out parameters (D3+) + SUPPORTS_VARIANT Compiler supports variant (D2+) + SUPPORTS_WIDECHAR Compiler supports the WideChar type (D2+) + SUPPORTS_WIDESTRING Compiler supports the WideString type (D3+/BCB3+) + SUPPORTS_INTERFACE Compiler supports interfaces (D3+/BCB3+) + SUPPORTS_DISPINTERFACE Compiler supports dispatch interfaces (D3+/BCB3+) + SUPPORTS_DISPID Compiler supports dispatch ids (D3+/BCB3+/FPC) + SUPPORTS_EXTSYM Compiler supports the $EXTERNALSYM directive (D4+/BCB3+) + SUPPORTS_NODEFINE Compiler supports the $NODEFINE directive (D4+/BCB3+) + SUPPORTS_LONGWORD Compiler supports the LongWord type (unsigned 32 bit) (D4+/BCB4+) + SUPPORTS_INT64 Compiler supports the Int64 type (D4+/BCB4+) + SUPPORTS_UINT64 Compiler supports the UInt64 type (D7+) + SUPPORTS_DYNAMICARRAYS Compiler supports dynamic arrays (D4+/BCB4+) + SUPPORTS_DEFAULTPARAMS Compiler supports default parameters (D4+/BCB4+) + SUPPORTS_OVERLOAD Compiler supports overloading (D4+/BCB4+) + SUPPORTS_IMPLEMENTS Compiler supports implements (D4+/BCB4+) + SUPPORTS_DEPRECATED Compiler supports the deprecated directive (D6+/BCB6+) + SUPPORTS_PLATFORM Compiler supports the platform directive (D6+/BCB6+) + SUPPORTS_LIBRARY Compiler supports the library directive (D6+/BCB6+/FPC) + SUPPORTS_LOCAL Compiler supports the local directive (D6+/BCB6+) + SUPPORTS_SETPEFLAGS Compiler supports the SetPEFlags directive (D6+/BCB6+) + SUPPORTS_EXPERIMENTAL_WARNINGS Compiler supports the WARN SYMBOL_EXPERIMENTAL and WARN UNIT_EXPERIMENTAL directives (D6+/BCB6+) + SUPPORTS_INLINE Compiler supports the inline directive (D9+/FPC) + SUPPORTS_FOR_IN Compiler supports for in loops (D9+) + SUPPORTS_NESTED_CONSTANTS Compiler supports nested constants (D9+) + SUPPORTS_NESTED_TYPES Compiler supports nested types (D9+) + SUPPORTS_REGION Compiler supports the REGION and ENDREGION directives (D9+) + SUPPORTS_ENHANCED_RECORDS Compiler supports class [operator|function|procedure] for record types (D9.NET, D10+) + SUPPORTS_CLASS_FIELDS Compiler supports class fields (D9.NET, D10+) + SUPPORTS_CLASS_HELPERS Compiler supports class helpers (D9.NET, D10+) + SUPPORTS_CLASS_OPERATORS Compiler supports class operators (D9.NET, D10+) + SUPPORTS_CLASS_CTORDTORS Compiler supports class contructors/destructors (D14+) + SUPPORTS_STRICT Compiler supports strict keyword (D9.NET, D10+) + SUPPORTS_STATIC Compiler supports static keyword (D9.NET, D10+) + SUPPORTS_FINAL Compiler supports final keyword (D9.NET, D10+) + SUPPORTS_METHODINFO Compiler supports the METHODINFO directives (D10+) + SUPPORTS_GENERICS Compiler supports generic implementations (D11.NET, D12+) + SUPPORTS_GENERIC_TYPES Compiler supports generic implementations of types (D11.NET, D12+, FPC) + SUPPORTS_GENERIC_METHODS Compiler supports generic implementations of methods (D11.NET, D12+, FPC) + SUPPORTS_GENERIC_ROUTINES Compiler supports generic implementations of global functions/procedures (FPC) + SUPPORTS_DEPRECATED_DETAILS Compiler supports additional text for the deprecated directive (D11.NET, D12+) + ACCEPT_DEPRECATED Compiler supports or ignores the deprecated directive (D6+/BCB6+/FPC) + ACCEPT_PLATFORM Compiler supports or ignores the platform directive (D6+/BCB6+/FPC) + ACCEPT_LIBRARY Compiler supports or ignores the library directive (D6+/BCB6+) + SUPPORTS_CUSTOMVARIANTS Compiler supports custom variants (D6+/BCB6+) + SUPPORTS_VARARGS Compiler supports varargs (D6+/BCB6+) + SUPPORTS_ENUMVALUE Compiler supports assigning ordinalities to values of enums (D6+/BCB6+) + SUPPORTS_DEPRECATED_WARNINGS Compiler supports deprecated warnings (D6+/BCB6+) + SUPPORTS_LIBRARY_WARNINGS Compiler supports library warnings (D6+/BCB6+) + SUPPORTS_PLATFORM_WARNINGS Compiler supports platform warnings (D6+/BCB6+) + SUPPORTS_UNSAFE_WARNINGS Compiler supports unsafe warnings (D7+) + SUPPORTS_WEAKPACKAGEUNIT Compiler supports the WEAKPACKAGEUNIT directive (D3+) + SUPPORTS_COMPILETIME_MESSAGES Compiler supports the MESSAGE directive (D6+) + SUPPORTS_PACKAGES Compiler supports Packages (D1+) + HAS_UNIT_LIBC Unit Libc exists (Kylix, FPC on Linux/x86) + HAS_UNIT_RTLCONSTS Unit RTLConsts exists (D6+/BCB6+/FPC) + HAS_UNIT_TYPES Unit Types exists (D6+/BCB6+/FPC) + HAS_UNIT_VARIANTS Unit Variants exists (D6+/BCB6+/FPC) + HAS_UNIT_STRUTILS Unit StrUtils exists (D6+/BCB6+/FPC) + HAS_UNIT_DATEUTILS Unit DateUtils exists (D6+/BCB6+/FPC) + HAS_UNIT_CONTNRS Unit contnrs exists (D6+/BCB6+/FPC) + HAS_UNIT_HTTPPROD Unit HTTPProd exists (D9+) + HAS_UNIT_GIFIMG Unit GifImg exists (D11+) + HAS_UNIT_ANSISTRINGS Unit AnsiStrings exists (D12+) + HAS_UNIT_PNGIMAGE Unit PngImage exists (D12+) + HAS_UNIT_CHARACTER Unit Character exists (D12+) + XPLATFORM_RTL The RTL supports crossplatform function names (e.g. RaiseLastOSError) (D6+/BCB6+/FPC) + SUPPORTS_TYPED_POINTERMATH Compiler supports arithmetic operations on typed pointers (D12+) + SUPPORTS_STRINGCHECKS Compiler supports the STRINGCHECKS directive (D12+) + SUPPORTS_UNICODE string type is aliased to an unicode string (WideString or UnicodeString) (DX.NET, D12+) + SUPPORTS_UNICODE_STRING Compiler supports UnicodeString (D12+) + SUPPORTS_INT_ALIASES Types Int8, Int16, Int32, UInt8, UInt16 and UInt32 are defined in the unit System (D12+) + HAS_UNIT_RTTI Unit RTTI is available (D14+) + SUPPORTS_EXTENDED_RTTI Compiler supports the extended RTTI directive (D14+) + SUPPORTS_CAST_INTERFACE_TO_OBJ The compiler supports casts from interfaces to objects (D14+) + SUPPORTS_DELAYED_LOADING The compiler generates stubs for delaying imported function loads (D14+) + HAS_UNIT_REGULAREXPRESSIONSAPI Unit RegularExpressionsAPI is available (D15+) + HAS_UNITSCOPE Has unit scope, i.e. System.Classes instead of Classes (D16+) + HAS_UNIT_SYSTEM_UITYPES Unit System.UITypes is available (D16+) + HAS_UNIT_SYSTEM_ZIP Unit System.Zip is available (D16+) + HAS_UNIT_SYSTEM_ZLIB Unit System.ZLib is available (D16+) + HAS_UNIT_SYSTEM_ACTIONS Unit System.Actions is available (D17+) + DEPRECATED_SYSUTILS_ANSISTRINGS AnsiString functions from SysUtils are deprecated and moved to System.AnsiStrings (D18+) + HAS_PROPERTY_STYLEELEMENTS TControl has a StyleElements property (D17+) + HAS_AUTOMATIC_DB_FIELDS Database fields are automatically created/refreshed (D20+) + HAS_EARGUMENTEXCEPTION Exception class EArgumentException is available (D14+) + HAS_ENOTIMPLEMENTED Exception class ENotImplemented is available (D15+) + HAS_UNIT_VCL_THEMES Unit Vcl.Themes is available (D16+) + SUPPORTS_EXCESSPRECISION Compiler supports the EXCESSPRECISION directive (D16+) + HAS_TSTRINGS_ENCODING RTL supports TStrings.Encoding (D16+) + EXTENDED_IS_DOUBLE_ALIAS Compiler uses Double instead of Extended (64 bit D16+) + HAS_UNIT_UXTHEME Unit (Vcl.)UxTheme is available (D7+) + HAS_EXCEPTION_STACKTRACE Exception class has the StackTrace propery (D12+) + SUPPORTS_LEGACYIFEND Compiler supports the LEGACYIFEND directive (D17+) + DEPRECATED_TCHARACTER TCharacter is deprecated and replaced by a record helper on Char (D18+) + HAS_PROPERTY_OLDCREATEORDER The OldCreateOrder property is available (D5 - D27) + SUPPORTS_SCOPEDENUMS Compiler supports the SCOPEDENUMS directive and enumerations can be scoped (D12+) + + +- Compiler Settings + + The compiler settings directives indicate whether a specific compiler setting + is in effect. This facilitates changing compiler settings locally in a more + compact and readible manner. + + Directive Description + ------------------------------------------------------------------------------ + ALIGN_ON Compiling in the A+ state (no alignment) + BOOLEVAL_ON Compiling in the B+ state (complete boolean evaluation) + ASSERTIONS_ON Compiling in the C+ state (assertions on) + DEBUGINFO_ON Compiling in the D+ state (debug info generation on) + IMPORTEDDATA_ON Compiling in the G+ state (creation of imported data references) + LONGSTRINGS_ON Compiling in the H+ state (string defined as AnsiString) + IOCHECKS_ON Compiling in the I+ state (I/O checking enabled) + WRITEABLECONST_ON Compiling in the J+ state (typed constants can be modified) + LOCALSYMBOLS Compiling in the L+ state (local symbol generation) + LOCALSYMBOLS_ON Alias of LOCALSYMBOLS + TYPEINFO_ON Compiling in the M+ state (RTTI generation on) + OPTIMIZATION_ON Compiling in the O+ state (code optimization on) + OPENSTRINGS_ON Compiling in the P+ state (variable string parameters are openstrings) + OVERFLOWCHECKS_ON Compiling in the Q+ state (overflow checing on) + RANGECHECKS_ON Compiling in the R+ state (range checking on) + TYPEDADDRESS_ON Compiling in the T+ state (pointers obtained using the @ operator are typed) + SAFEDIVIDE_ON Compiling in the U+ state (save FDIV instruction through RTL emulation) + VARSTRINGCHECKS_ON Compiling in the V+ state (type checking of shortstrings) + STACKFRAMES_ON Compiling in the W+ state (generation of stack frames) + EXTENDEDSYNTAX_ON Compiling in the X+ state (Delphi extended syntax enabled) +*) + +{$DEFINE BORLAND} + +{ Set FreePascal to Delphi mode } +{$IFDEF FPC} + {$MODE DELPHI} + // Assembler mode Intel is only available for the x86 CPU family + {$IF DEFINED(CPUI8086) OR DEFINED(CPUI386) OR DEFINED(CPUX86_64)} + {$ASMMODE Intel} + {$IFEND} + {$UNDEF BORLAND} + {$DEFINE CPUASM} + // FPC defines CPU32, CPU64 and Unix automatically +{$ENDIF} + +{$IFDEF ELEMENTS} + // Oxygene's assembly syntax is very different; Delphi/FPC asm blocks will not compile. + // PurePascal code sections should be used instead. + {$UNDEF CPUASM} + {$DEFINE PUREPASCAL} + + {$UNDEF BORLAND} +{$ENDIF} + +{$IFDEF BORLAND} + {$IFDEF LINUX} + {$IFDEF VER140} // Only under Delphi 6, LINUX implies Kylix + {$DEFINE KYLIX} + {$ENDIF} + {$ENDIF LINUX} + {$IFNDEF CLR} + {$IFNDEF CPUX86} + // CPUX86 is not defined, which means it most likely is a 64 bits compiler. + // However, this is only the case if either of two other symbols are defined: + // http://docwiki.embarcadero.com/RADStudio/en/Conditional_compilation_%28Delphi%29 + {$DEFINE CPU64} + {$DEFINE DELPHI64_TEMPORARY} + {$IFNDEF CPUX64} + {$IFNDEF CPU64BITS} + {$DEFINE CPU386} // None of the two 64-bits symbols are defined, assume this is 32-bit + {$DEFINE CPU32} + {$UNDEF CPU64} + {$UNDEF DELPHI64_TEMPORARY} + {$ENDIF ~CPU64BITS} + {$ENDIF ~CPUX64} + {$ELSE ~CPUX86} + {$DEFINE CPU386} + {$DEFINE CPU32} + {$ENDIF ~CPUX86} + {$ENDIF ~CLR} +{$ENDIF BORLAND} + +{------------------------------------------------------------------------------} +{ VERXXX to COMPILERX, DELPHIX and BCBX mappings } +{------------------------------------------------------------------------------} + +{$IFDEF BORLAND} + {$IFDEF KYLIX} + {$I kylix.inc} // FPC incompatible stuff + {$ELSE ~KYLIX} + + {$DEFINE UNKNOWN_COMPILER_VERSION} + + {$IFDEF VER80} + {$DEFINE COMPILER1} + {$DEFINE DELPHI1} + {$DEFINE DELPHICOMPILER1} + {$DEFINE RTL80_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF} + + {$IFDEF VER90} + {$DEFINE COMPILER2} + {$DEFINE DELPHI2} + {$DEFINE DELPHICOMPILER2} + {$DEFINE RTL90_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF} + + {$IFDEF VER93} + {$DEFINE COMPILER2} + {$DEFINE BCB1} + {$DEFINE BCB} + {$DEFINE RTL93_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF} + + {$IFDEF VER100} + {$DEFINE COMPILER3} + {$DEFINE DELPHI3} + {$DEFINE DELPHICOMPILER3} + {$DEFINE RTL100_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF} + + {$IFDEF VER110} + {$DEFINE COMPILER35} + {$DEFINE BCB3} + {$DEFINE BCB} + {$DEFINE RTL110_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF} + + {$IFDEF VER120} + {$DEFINE COMPILER4} + {$DEFINE DELPHI4} + {$DEFINE DELPHICOMPILER4} + {$DEFINE RTL120_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF} + + {$IFDEF VER125} + {$DEFINE COMPILER4} + {$DEFINE BCB4} + {$DEFINE BCB} + {$DEFINE RTL125_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF} + + {$IFDEF VER130} + {$DEFINE COMPILER5} + {$IFDEF BCB} + {$DEFINE BCB5} + {$ELSE} + {$DEFINE DELPHI5} + {$DEFINE DELPHICOMPILER5} + {$ENDIF} + {$DEFINE RTL130_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF} + + {$IFDEF VER140} + {$DEFINE COMPILER6} + {$IFDEF BCB} + {$DEFINE BCB6} + {$ELSE} + {$DEFINE DELPHI6} + {$DEFINE DELPHICOMPILER6} + {$ENDIF} + {$DEFINE RTL140_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF} + + {$IFDEF VER150} + {$DEFINE COMPILER7} + {$DEFINE DELPHI7} + {$DEFINE DELPHICOMPILER7} + {$DEFINE RTL150_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF} + + {$IFDEF VER160} + {$DEFINE BDS2} + {$DEFINE BDS} + {$IFDEF CLR} + {$DEFINE CLR10} + {$ENDIF CLR} + {$DEFINE COMPILER8} + {$DEFINE DELPHI8} + {$DEFINE DELPHICOMPILER8} + {$DEFINE RTL160_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF} + + {$IFDEF VER170} + {$DEFINE BDS3} + {$DEFINE BDS} + {$IFDEF CLR} + {$DEFINE CLR11} + {$ENDIF CLR} + {$DEFINE COMPILER9} + {$DEFINE DELPHI9} + {$DEFINE DELPHI2005} // synonym to DELPHI9 + {$DEFINE DELPHICOMPILER9} + {$DEFINE RTL170_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF} + + {$IFDEF VER180} + {$DEFINE BDS} + {$IFDEF CLR} + {$DEFINE CLR11} + {$ENDIF CLR} + {$IFDEF VER185} + {$DEFINE BDS5} + {$DEFINE COMPILER11} + {$IFDEF BCB} + {$DEFINE BCB11} + {$ELSE} + {$DEFINE DELPHI11} + {$DEFINE DELPHI2007} // synonym to DELPHI11 + {$DEFINE DELPHICOMPILER11} + {$ENDIF} + {$DEFINE RTL185_UP} + {$ELSE ~~VER185} + {$DEFINE BDS4} + {$DEFINE COMPILER10} + {$IFDEF BCB} + {$DEFINE BCB10} + {$ELSE} + {$DEFINE DELPHI10} + {$DEFINE DELPHI2006} // synonym to DELPHI10 + {$DEFINE DELPHICOMPILER10} + {$ENDIF} + {$DEFINE RTL180_UP} + {$ENDIF ~VER185} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF} + + {$IFDEF VER190} // Delphi 2007 for .NET + {$DEFINE BDS} + {$DEFINE BDS5} + {$IFDEF CLR} + {$DEFINE CLR20} + {$ENDIF CLR} + {$DEFINE COMPILER11} + {$DEFINE DELPHI11} + {$DEFINE DELPHI2007} // synonym to DELPHI11 + {$DEFINE DELPHICOMPILER11} + {$DEFINE RTL190_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER190} + + {$IFDEF VER200} // RAD Studio 2009 + {$DEFINE BDS} + {$DEFINE BDS6} + {$IFDEF CLR} + {$DEFINE CLR20} + {$ENDIF CLR} + {$DEFINE COMPILER12} + {$IFDEF BCB} + {$DEFINE BCB12} + {$ELSE} + {$DEFINE DELPHI12} + {$DEFINE DELPHI2009} // synonym to DELPHI12 + {$DEFINE DELPHICOMPILER12} + {$ENDIF BCB} + {$IFDEF CLR} + {$DEFINE RTL190_UP} + {$ELSE} + {$DEFINE RTL200_UP} + {$ENDIF} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER200} + + {$IFDEF VER210} // RAD Studio 2010 + {$DEFINE BDS} + {$DEFINE BDS7} + {$DEFINE COMPILER14} + {$IFDEF BCB} + {$DEFINE BCB14} + {$ELSE} + {$DEFINE DELPHI14} + {$DEFINE DELPHI2010} // synonym to DELPHI14 + {$DEFINE DELPHICOMPILER14} + {$ENDIF BCB} + {$DEFINE RTL210_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER210} + + {$IFDEF VER220} // RAD Studio XE + {$DEFINE BDS} + {$DEFINE BDS8} + {$DEFINE COMPILER15} + {$IFDEF BCB} + {$DEFINE BCB15} + {$ELSE} + {$DEFINE DELPHI15} + {$DEFINE DELPHIXE} // synonym to DELPHI15 + {$DEFINE DELPHICOMPILER15} + {$ENDIF BCB} + {$DEFINE RTL220_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER220} + + {$IFDEF VER230} // RAD Studio XE2 + {$DEFINE BDS} + {$DEFINE BDS9} + {$DEFINE COMPILER16} + {$IFDEF BCB} + {$DEFINE BCB16} + {$ELSE} + {$DEFINE DELPHI16} + {$DEFINE DELPHIXE2} // synonym to DELPHI16 + {$DEFINE DELPHICOMPILER16} + {$ENDIF BCB} + {$DEFINE RTL230_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER230} + + {$IFDEF VER240} // RAD Studio XE3 + {$DEFINE BDS} + {$DEFINE BDS10} + {$DEFINE COMPILER17} + {$IFDEF BCB} + {$DEFINE BCB17} + {$ELSE} + {$DEFINE DELPHI17} + {$DEFINE DELPHIXE3} // synonym to DELPHI17 + {$DEFINE DELPHICOMPILER17} + {$ENDIF BCB} + {$DEFINE RTL240_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER240} + + {$IFDEF VER250} // RAD Studio XE4 + {$DEFINE BDS} + {$DEFINE BDS11} + {$DEFINE COMPILER18} + {$IFDEF BCB} + {$DEFINE BCB18} + {$ELSE} + {$DEFINE DELPHI18} + {$DEFINE DELPHIXE4} // synonym to DELPHI18 + {$DEFINE DELPHICOMPILER18} + {$ENDIF BCB} + {$DEFINE RTL250_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER250} + + {$IFDEF VER260} // RAD Studio XE5 + {$DEFINE BDS} + {$DEFINE BDS12} + {$DEFINE COMPILER19} + {$IFDEF BCB} + {$DEFINE BCB19} + {$ELSE} + {$DEFINE DELPHI19} + {$DEFINE DELPHIXE5} // synonym to DELPHI19 + {$DEFINE DELPHICOMPILER19} + {$ENDIF BCB} + {$DEFINE RTL260_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER260} + + {$IFDEF VER270} // RAD Studio XE6 + {$DEFINE BDS} + {$DEFINE BDS14} + {$DEFINE COMPILER20} + {$IFDEF BCB} + {$DEFINE BCB20} + {$ELSE} + {$DEFINE DELPHI20} + {$DEFINE DELPHIXE6} // synonym to DELPHI20 + {$DEFINE DELPHICOMPILER20} + {$ENDIF BCB} + {$DEFINE RTL270_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER270} + + {$IFDEF VER280} // RAD Studio XE7 + {$DEFINE BDS} + {$DEFINE BDS15} + {$DEFINE COMPILER21} + {$IFDEF BCB} + {$DEFINE BCB21} + {$ELSE} + {$DEFINE DELPHI21} + {$DEFINE DELPHIXE7} // synonym to DELPHI21 + {$DEFINE DELPHICOMPILER21} + {$ENDIF BCB} + {$DEFINE RTL280_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER280} + + {$IFDEF VER290} // RAD Studio XE8 + {$DEFINE BDS} + {$DEFINE BDS16} + {$DEFINE COMPILER22} + {$IFDEF BCB} + {$DEFINE BCB22} + {$ELSE} + {$DEFINE DELPHI22} + {$DEFINE DELPHIXE8} // synonym to DELPHI22 + {$DEFINE DELPHICOMPILER22} + {$ENDIF BCB} + {$DEFINE RTL290_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER290} + + {$IFDEF VER300} // RAD Studio 10 + {$DEFINE BDS} + {$DEFINE BDS17} + {$DEFINE COMPILER23} + {$IFDEF BCB} + {$DEFINE BCB23} + {$ELSE} + {$DEFINE DELPHI23} + {$DEFINE DELPHIX_SEATTLE} // synonym to DELPHI23 + {$DEFINE DELPHICOMPILER23} + {$ENDIF BCB} + {$DEFINE RTL300_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER300} + + {$IFDEF VER310} // RAD Studio 10.1 + {$DEFINE BDS} + {$DEFINE BDS18} + {$DEFINE COMPILER24} + {$IFDEF BCB} + {$DEFINE BCB24} + {$ELSE} + {$DEFINE DELPHI24} + {$DEFINE DELPHIX_BERLIN} // synonym to DELPHI24 + {$DEFINE DELPHICOMPILER24} + {$ENDIF BCB} + {$DEFINE RTL310_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER310} + + {$IFDEF VER320} // RAD Studio 10.2 + {$DEFINE BDS} + {$DEFINE BDS19} + {$DEFINE COMPILER25} + {$IFDEF BCB} + {$DEFINE BCB25} + {$ELSE} + {$DEFINE DELPHI25} + {$DEFINE DELPHIX_TOKYO} // synonym to DELPHI25 + {$DEFINE DELPHICOMPILER25} + {$ENDIF BCB} + {$DEFINE RTL320_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER320} + + {$IFDEF VER330} // RAD Studio 10.3 + {$DEFINE BDS} + {$DEFINE BDS20} + {$DEFINE COMPILER26} + {$IFDEF BCB} + {$DEFINE BCB26} + {$ELSE} + {$DEFINE DELPHI26} + {$DEFINE DELPHIX_RIO} // synonym to DELPHI26 + {$DEFINE DELPHICOMPILER26} + {$ENDIF BCB} + {$DEFINE RTL330_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER330} + + {$IFDEF VER340} // RAD Studio 10.4 + {$DEFINE BDS} + {$DEFINE BDS21} + {$DEFINE COMPILER27} + {$IFDEF BCB} + {$DEFINE BCB27} + {$ELSE} + {$DEFINE DELPHI27} + {$DEFINE DELPHIX_SYDNEY} // synonym to DELPHI27 + {$DEFINE DELPHICOMPILER27} + {$ENDIF BCB} + {$DEFINE RTL340_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER340} + + {$IFDEF VER350} // RAD Studio 11 + {$DEFINE BDS} + {$DEFINE BDS22} + {$DEFINE COMPILER28} + {$IFDEF BCB} + {$DEFINE BCB28} + {$ELSE} + {$DEFINE DELPHI28} + {$DEFINE DELPHIX_ALEXANDRIA} // synonym to DELPHI28 + {$DEFINE DELPHICOMPILER28} + {$ENDIF BCB} + {$DEFINE RTL350_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER350} + + {$IFDEF VER360} // RAD Studio 12 + {$DEFINE BDS} + {$DEFINE BDS23} + {$DEFINE COMPILER29} + {$IFDEF BCB} + {$DEFINE BCB29} + {$ELSE} + {$DEFINE DELPHI29} + {$DEFINE DELPHI_ATHENS} // synonym to DELPHI29 + {$DEFINE DELPHICOMPILER29} + {$ENDIF BCB} + {$DEFINE RTL360_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER360} + + {$IFDEF VER370} // RAD Studio 13 + {$DEFINE BDS} + {$DEFINE BDS37} + {$DEFINE COMPILER37} + {$IFDEF BCB} + {$DEFINE BCB37} + {$ELSE} + {$DEFINE DELPHI37} + {$DEFINE DELPHI_FLORENCE} // synonym to DELPHI37 + {$DEFINE DELPHICOMPILER37} + {$ENDIF BCB} + {$DEFINE RTL370_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER370} + + {$IFDEF UNKNOWN_COMPILER_VERSION} // adjust for newer version (always use latest version) + {$DEFINE BDS} + {$DEFINE BDS37} + {$DEFINE COMPILER37} + {$IFDEF BCB} + {$DEFINE BCB37} + {$ELSE} + {$DEFINE DELPHI37} + {$DEFINE DELPHI_FLORENCE} // synonym to DELPHI37 + {$DEFINE DELPHICOMPILER37} + {$ENDIF BCB} + {$DEFINE RTL370_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF} + + {$ENDIF ~KYLIX} + + {$IFDEF BCB} + {$DEFINE CPPBUILDER} + {$DEFINE BCBCOMPILER} + {$ELSE ~BCB} + {$DEFINE DELPHI} + {$DEFINE DELPHICOMPILER} + {$ENDIF ~BCB} + +{$ENDIF BORLAND} + +{------------------------------------------------------------------------------} +{ Oxygene support } +{ Since largely a superset of Delphi, define macros expecting Delphi } +{------------------------------------------------------------------------------} +{$IFDEF ELEMENTS} + // CLR and NETSTANDARD or NETCORE are auto-defined + // LINUX is defined for both Linux AND Android + // https://docs.elementscompiler.com/Compiler/ConditionalDefines/ + + {$IFDEF CLR} + // See https://docs.elementscompiler.com/Compiler/ConditionalDefines/ for + // macros defining various .Net related tech, eg Classic / Standard / Mono / .Net Core + {$DEFINE CLR20} + {$ENDIF} + + // I386, X86_64, and ARM64 are auto-defined + {$IFDEF I386} + {$DEFINE CPU386} + {$DEFINE CPU32} + {$ENDIF} + {$IFDEF X86_64} + {$DEFINE CPU64} + {$DEFINE CPU64BITS} + {$DEFINE CPUX64} + {$ENDIF} + {$IFDEF ARM64} + {$DEFINE CPU64} + {$DEFINE CPU64BITS} + {$DEFINE CPUARM64} + {$ENDIF} + + // Platform compatibility mappings + // Elements auto-defines: WINDOWS, LINUX, DARWIN (Island); MACOS, IOS, etc (Cocoa) + {$IFDEF WINDOWS} + {$IFNDEF MSWINDOWS} + {$DEFINE MSWINDOWS} + {$ENDIF} + {$IFDEF CPU64} + {$DEFINE WIN64} + {$ELSE} + {$DEFINE WIN32} + {$ENDIF} + {$ENDIF} + + // Add defines for current Delphi, since most code will wrap against specific Delphi version + // Regard Oxygene as a superset (minor differences for legacy language features) + // Note: OXYGENE is auto-defined by the compiler + + {$DEFINE BDS} + {$DEFINE DELPHI} + {$DEFINE DELPHICOMPILER} + + {$UNDEF UNKNOWN_COMPILER_VERSION} + + {$DEFINE BDS37} + {$DEFINE COMPILER37} + {$DEFINE DELPHI37} + {$DEFINE DELPHI_FLORENCE} // synonym to DELPHI37 + {$DEFINE DELPHICOMPILER37} +{$ENDIF} + +{------------------------------------------------------------------------------} +{ DELPHIX_UP from DELPHIX mappings } +{------------------------------------------------------------------------------} + +{$IFDEF DELPHI37} {$DEFINE DELPHI37_UP} {$ENDIF} +{$IFDEF DELPHI29} {$DEFINE DELPHI29_UP} {$ENDIF} +{$IFDEF DELPHI28} {$DEFINE DELPHI28_UP} {$ENDIF} +{$IFDEF DELPHI27} {$DEFINE DELPHI27_UP} {$ENDIF} +{$IFDEF DELPHI26} {$DEFINE DELPHI26_UP} {$ENDIF} +{$IFDEF DELPHI25} {$DEFINE DELPHI25_UP} {$ENDIF} +{$IFDEF DELPHI24} {$DEFINE DELPHI24_UP} {$ENDIF} +{$IFDEF DELPHI23} {$DEFINE DELPHI23_UP} {$ENDIF} +{$IFDEF DELPHI22} {$DEFINE DELPHI22_UP} {$ENDIF} +{$IFDEF DELPHI21} {$DEFINE DELPHI21_UP} {$ENDIF} +{$IFDEF DELPHI20} {$DEFINE DELPHI20_UP} {$ENDIF} +{$IFDEF DELPHI19} {$DEFINE DELPHI19_UP} {$ENDIF} +{$IFDEF DELPHI18} {$DEFINE DELPHI18_UP} {$ENDIF} +{$IFDEF DELPHI17} {$DEFINE DELPHI17_UP} {$ENDIF} +{$IFDEF DELPHI16} {$DEFINE DELPHI16_UP} {$ENDIF} +{$IFDEF DELPHI15} {$DEFINE DELPHI15_UP} {$ENDIF} +{$IFDEF DELPHI14} {$DEFINE DELPHI14_UP} {$ENDIF} +{$IFDEF DELPHI12} {$DEFINE DELPHI12_UP} {$ENDIF} +{$IFDEF DELPHI11} {$DEFINE DELPHI11_UP} {$ENDIF} +{$IFDEF DELPHI10} {$DEFINE DELPHI10_UP} {$ENDIF} +{$IFDEF DELPHI9} {$DEFINE DELPHI9_UP} {$ENDIF} +{$IFDEF DELPHI8} {$DEFINE DELPHI8_UP} {$ENDIF} +{$IFDEF DELPHI7} {$DEFINE DELPHI7_UP} {$ENDIF} +{$IFDEF DELPHI6} {$DEFINE DELPHI6_UP} {$ENDIF} +{$IFDEF DELPHI5} {$DEFINE DELPHI5_UP} {$ENDIF} +{$IFDEF DELPHI4} {$DEFINE DELPHI4_UP} {$ENDIF} +{$IFDEF DELPHI3} {$DEFINE DELPHI3_UP} {$ENDIF} +{$IFDEF DELPHI2} {$DEFINE DELPHI2_UP} {$ENDIF} +{$IFDEF DELPHI1} {$DEFINE DELPHI1_UP} {$ENDIF} + +{------------------------------------------------------------------------------} +{ DELPHIX_UP from DELPHIX_UP mappings } +{------------------------------------------------------------------------------} + +{$IFDEF DELPHI37_UP} + {$DEFINE DELPHI_FLORENCE_UP} // synonym to DELPHI37_UP + {$DEFINE DELPHI29_UP} +{$ENDIF} + +{$IFDEF DELPHI29_UP} + {$DEFINE DELPHI_ATHENS_UP} // synonym to DELPHI29_UP + {$DEFINE DELPHI28_UP} +{$ENDIF} + +{$IFDEF DELPHI28_UP} + {$DEFINE DELPHIX_ALEXANDRIA_UP} // synonym to DELPHI28_UP + {$DEFINE DELPHI27_UP} +{$ENDIF} + +{$IFDEF DELPHI27_UP} + {$DEFINE DELPHIX_SYDNEY_UP} // synonym to DELPHI27_UP + {$DEFINE DELPHI26_UP} +{$ENDIF} + +{$IFDEF DELPHI26_UP} + {$DEFINE DELPHIX_RIO_UP} // synonym to DELPHI26_UP + {$DEFINE DELPHI25_UP} +{$ENDIF} + +{$IFDEF DELPHI25_UP} + {$DEFINE DELPHIX_TOKYO_UP} // synonym to DELPHI25_UP + {$DEFINE DELPHI24_UP} +{$ENDIF} + +{$IFDEF DELPHI24_UP} + {$DEFINE DELPHIX_BERLIN_UP} // synonym to DELPHI24_UP + {$DEFINE DELPHI23_UP} +{$ENDIF} + +{$IFDEF DELPHI23_UP} + {$DEFINE DELPHIX_SEATTLE_UP} // synonym to DELPHI23_UP + {$DEFINE DELPHI22_UP} +{$ENDIF} + +{$IFDEF DELPHI22_UP} + {$DEFINE DELPHIXE8_UP} // synonym to DELPHI22_UP + {$DEFINE DELPHI21_UP} +{$ENDIF} + +{$IFDEF DELPHI21_UP} + {$DEFINE DELPHIXE7_UP} // synonym to DELPHI21_UP + {$DEFINE DELPHI20_UP} +{$ENDIF} + +{$IFDEF DELPHI20_UP} + {$DEFINE DELPHIXE6_UP} // synonym to DELPHI20_UP + {$DEFINE DELPHI19_UP} +{$ENDIF} + +{$IFDEF DELPHI19_UP} + {$DEFINE DELPHIXE5_UP} // synonym to DELPHI19_UP + {$DEFINE DELPHI18_UP} +{$ENDIF} + +{$IFDEF DELPHI18_UP} + {$DEFINE DELPHIXE4_UP} // synonym to DELPHI18_UP + {$DEFINE DELPHI17_UP} +{$ENDIF} + +{$IFDEF DELPHI17_UP} + {$DEFINE DELPHIXE3_UP} // synonym to DELPHI17_UP + {$DEFINE DELPHI16_UP} +{$ENDIF} + +{$IFDEF DELPHI16_UP} + {$DEFINE DELPHIXE2_UP} // synonym to DELPHI16_UP + {$DEFINE DELPHI15_UP} +{$ENDIF} + +{$IFDEF DELPHI15_UP} + {$DEFINE DELPHIXE_UP} // synonym to DELPHI15_UP + {$DEFINE DELPHI14_UP} +{$ENDIF} + +{$IFDEF DELPHI14_UP} + {$DEFINE DELPHI2010_UP} // synonym to DELPHI14_UP + {$DEFINE DELPHI12_UP} +{$ENDIF} + +{$IFDEF DELPHI12_UP} + {$DEFINE DELPHI2009_UP} // synonym to DELPHI12_UP + {$DEFINE DELPHI11_UP} +{$ENDIF} + +{$IFDEF DELPHI11_UP} + {$DEFINE DELPHI2007_UP} // synonym to DELPHI11_UP + {$DEFINE DELPHI10_UP} +{$ENDIF} + +{$IFDEF DELPHI10_UP} + {$DEFINE DELPHI2006_UP} // synonym to DELPHI10_UP + {$DEFINE DELPHI9_UP} +{$ENDIF} + +{$IFDEF DELPHI9_UP} + {$DEFINE DELPHI2005_UP} // synonym to DELPHI9_UP + {$DEFINE DELPHI8_UP} +{$ENDIF} + +{$IFDEF DELPHI8_UP} {$DEFINE DELPHI7_UP} {$ENDIF} +{$IFDEF DELPHI7_UP} {$DEFINE DELPHI6_UP} {$ENDIF} +{$IFDEF DELPHI6_UP} {$DEFINE DELPHI5_UP} {$ENDIF} +{$IFDEF DELPHI5_UP} {$DEFINE DELPHI4_UP} {$ENDIF} +{$IFDEF DELPHI4_UP} {$DEFINE DELPHI3_UP} {$ENDIF} +{$IFDEF DELPHI3_UP} {$DEFINE DELPHI2_UP} {$ENDIF} +{$IFDEF DELPHI2_UP} {$DEFINE DELPHI1_UP} {$ENDIF} + +{------------------------------------------------------------------------------} +{ BCBX_UP from BCBX mappings } +{------------------------------------------------------------------------------} + +{$IFDEF BCB37} {$DEFINE BCB37_UP} {$ENDIF} +{$IFDEF BCB29} {$DEFINE BCB29_UP} {$ENDIF} +{$IFDEF BCB28} {$DEFINE BCB28_UP} {$ENDIF} +{$IFDEF BCB27} {$DEFINE BCB27_UP} {$ENDIF} +{$IFDEF BCB26} {$DEFINE BCB26_UP} {$ENDIF} +{$IFDEF BCB25} {$DEFINE BCB25_UP} {$ENDIF} +{$IFDEF BCB24} {$DEFINE BCB24_UP} {$ENDIF} +{$IFDEF BCB23} {$DEFINE BCB23_UP} {$ENDIF} +{$IFDEF BCB22} {$DEFINE BCB22_UP} {$ENDIF} +{$IFDEF BCB21} {$DEFINE BCB21_UP} {$ENDIF} +{$IFDEF BCB20} {$DEFINE BCB20_UP} {$ENDIF} +{$IFDEF BCB19} {$DEFINE BCB19_UP} {$ENDIF} +{$IFDEF BCB18} {$DEFINE BCB18_UP} {$ENDIF} +{$IFDEF BCB17} {$DEFINE BCB17_UP} {$ENDIF} +{$IFDEF BCB16} {$DEFINE BCB16_UP} {$ENDIF} +{$IFDEF BCB15} {$DEFINE BCB15_UP} {$ENDIF} +{$IFDEF BCB14} {$DEFINE BCB14_UP} {$ENDIF} +{$IFDEF BCB12} {$DEFINE BCB12_UP} {$ENDIF} +{$IFDEF BCB11} {$DEFINE BCB11_UP} {$ENDIF} +{$IFDEF BCB10} {$DEFINE BCB10_UP} {$ENDIF} +{$IFDEF BCB6} {$DEFINE BCB6_UP} {$ENDIF} +{$IFDEF BCB5} {$DEFINE BCB5_UP} {$ENDIF} +{$IFDEF BCB4} {$DEFINE BCB4_UP} {$ENDIF} +{$IFDEF BCB3} {$DEFINE BCB3_UP} {$ENDIF} +{$IFDEF BCB1} {$DEFINE BCB1_UP} {$ENDIF} + +{------------------------------------------------------------------------------} +{ BCBX_UP from BCBX_UP mappings } +{------------------------------------------------------------------------------} + +{$IFDEF BCB37_UP} {$DEFINE BCB29_UP} {$ENDIF} +{$IFDEF BCB29_UP} {$DEFINE BCB28_UP} {$ENDIF} +{$IFDEF BCB28_UP} {$DEFINE BCB27_UP} {$ENDIF} +{$IFDEF BCB27_UP} {$DEFINE BCB26_UP} {$ENDIF} +{$IFDEF BCB26_UP} {$DEFINE BCB25_UP} {$ENDIF} +{$IFDEF BCB25_UP} {$DEFINE BCB24_UP} {$ENDIF} +{$IFDEF BCB24_UP} {$DEFINE BCB23_UP} {$ENDIF} +{$IFDEF BCB23_UP} {$DEFINE BCB22_UP} {$ENDIF} +{$IFDEF BCB22_UP} {$DEFINE BCB21_UP} {$ENDIF} +{$IFDEF BCB21_UP} {$DEFINE BCB20_UP} {$ENDIF} +{$IFDEF BCB20_UP} {$DEFINE BCB19_UP} {$ENDIF} +{$IFDEF BCB19_UP} {$DEFINE BCB18_UP} {$ENDIF} +{$IFDEF BCB18_UP} {$DEFINE BCB17_UP} {$ENDIF} +{$IFDEF BCB17_UP} {$DEFINE BCB16_UP} {$ENDIF} +{$IFDEF BCB16_UP} {$DEFINE BCB15_UP} {$ENDIF} +{$IFDEF BCB15_UP} {$DEFINE BCB14_UP} {$ENDIF} +{$IFDEF BCB14_UP} {$DEFINE BCB12_UP} {$ENDIF} +{$IFDEF BCB12_UP} {$DEFINE BCB11_UP} {$ENDIF} +{$IFDEF BCB11_UP} {$DEFINE BCB10_UP} {$ENDIF} +{$IFDEF BCB10_UP} {$DEFINE BCB6_UP} {$ENDIF} +{$IFDEF BCB6_UP} {$DEFINE BCB5_UP} {$ENDIF} +{$IFDEF BCB5_UP} {$DEFINE BCB4_UP} {$ENDIF} +{$IFDEF BCB4_UP} {$DEFINE BCB3_UP} {$ENDIF} +{$IFDEF BCB3_UP} {$DEFINE BCB1_UP} {$ENDIF} + +{------------------------------------------------------------------------------} +{ BDSX_UP from BDSX mappings } +{------------------------------------------------------------------------------} + +{$IFDEF BDS37} {$DEFINE BDS37_UP} {$ENDIF} +{$IFDEF BDS23} {$DEFINE BDS23_UP} {$ENDIF} +{$IFDEF BDS22} {$DEFINE BDS22_UP} {$ENDIF} +{$IFDEF BDS21} {$DEFINE BDS21_UP} {$ENDIF} +{$IFDEF BDS20} {$DEFINE BDS20_UP} {$ENDIF} +{$IFDEF BDS19} {$DEFINE BDS19_UP} {$ENDIF} +{$IFDEF BDS18} {$DEFINE BDS18_UP} {$ENDIF} +{$IFDEF BDS17} {$DEFINE BDS17_UP} {$ENDIF} +{$IFDEF BDS16} {$DEFINE BDS16_UP} {$ENDIF} +{$IFDEF BDS15} {$DEFINE BDS15_UP} {$ENDIF} +{$IFDEF BDS14} {$DEFINE BDS14_UP} {$ENDIF} +{$IFDEF BDS12} {$DEFINE BDS12_UP} {$ENDIF} +{$IFDEF BDS11} {$DEFINE BDS11_UP} {$ENDIF} +{$IFDEF BDS10} {$DEFINE BDS10_UP} {$ENDIF} +{$IFDEF BDS9} {$DEFINE BDS9_UP} {$ENDIF} +{$IFDEF BDS8} {$DEFINE BDS8_UP} {$ENDIF} +{$IFDEF BDS7} {$DEFINE BDS7_UP} {$ENDIF} +{$IFDEF BDS6} {$DEFINE BDS6_UP} {$ENDIF} +{$IFDEF BDS5} {$DEFINE BDS5_UP} {$ENDIF} +{$IFDEF BDS4} {$DEFINE BDS4_UP} {$ENDIF} +{$IFDEF BDS3} {$DEFINE BDS3_UP} {$ENDIF} +{$IFDEF BDS2} {$DEFINE BDS2_UP} {$ENDIF} + +{------------------------------------------------------------------------------} +{ BDSX_UP from BDSX_UP mappings } +{------------------------------------------------------------------------------} + +{$IFDEF BDS37_UP} {$DEFINE BDS23_UP} {$ENDIF} +{$IFDEF BDS23_UP} {$DEFINE BDS22_UP} {$ENDIF} +{$IFDEF BDS22_UP} {$DEFINE BDS21_UP} {$ENDIF} +{$IFDEF BDS21_UP} {$DEFINE BDS20_UP} {$ENDIF} +{$IFDEF BDS20_UP} {$DEFINE BDS19_UP} {$ENDIF} +{$IFDEF BDS19_UP} {$DEFINE BDS18_UP} {$ENDIF} +{$IFDEF BDS18_UP} {$DEFINE BDS17_UP} {$ENDIF} +{$IFDEF BDS17_UP} {$DEFINE BDS16_UP} {$ENDIF} +{$IFDEF BDS16_UP} {$DEFINE BDS15_UP} {$ENDIF} +{$IFDEF BDS15_UP} {$DEFINE BDS14_UP} {$ENDIF} +{$IFDEF BDS14_UP} {$DEFINE BDS12_UP} {$ENDIF} +{$IFDEF BDS12_UP} {$DEFINE BDS11_UP} {$ENDIF} +{$IFDEF BDS11_UP} {$DEFINE BDS10_UP} {$ENDIF} +{$IFDEF BDS10_UP} {$DEFINE BDS9_UP} {$ENDIF} +{$IFDEF BDS9_UP} {$DEFINE BDS8_UP} {$ENDIF} +{$IFDEF BDS8_UP} {$DEFINE BDS7_UP} {$ENDIF} +{$IFDEF BDS7_UP} {$DEFINE BDS6_UP} {$ENDIF} +{$IFDEF BDS6_UP} {$DEFINE BDS5_UP} {$ENDIF} +{$IFDEF BDS5_UP} {$DEFINE BDS4_UP} {$ENDIF} +{$IFDEF BDS4_UP} {$DEFINE BDS3_UP} {$ENDIF} +{$IFDEF BDS3_UP} {$DEFINE BDS2_UP} {$ENDIF} + +{------------------------------------------------------------------------------} +{ DELPHICOMPILERX_UP from DELPHICOMPILERX mappings } +{------------------------------------------------------------------------------} + +{$IFDEF DELPHICOMPILER37} {$DEFINE DELPHICOMPILER37_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER29} {$DEFINE DELPHICOMPILER29_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER28} {$DEFINE DELPHICOMPILER28_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER27} {$DEFINE DELPHICOMPILER27_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER26} {$DEFINE DELPHICOMPILER26_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER25} {$DEFINE DELPHICOMPILER25_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER24} {$DEFINE DELPHICOMPILER24_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER23} {$DEFINE DELPHICOMPILER23_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER22} {$DEFINE DELPHICOMPILER22_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER21} {$DEFINE DELPHICOMPILER21_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER20} {$DEFINE DELPHICOMPILER20_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER19} {$DEFINE DELPHICOMPILER19_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER18} {$DEFINE DELPHICOMPILER18_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER17} {$DEFINE DELPHICOMPILER17_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER16} {$DEFINE DELPHICOMPILER16_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER15} {$DEFINE DELPHICOMPILER15_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER14} {$DEFINE DELPHICOMPILER14_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER12} {$DEFINE DELPHICOMPILER12_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER11} {$DEFINE DELPHICOMPILER11_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER10} {$DEFINE DELPHICOMPILER10_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER9} {$DEFINE DELPHICOMPILER9_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER8} {$DEFINE DELPHICOMPILER8_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER7} {$DEFINE DELPHICOMPILER7_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER6} {$DEFINE DELPHICOMPILER6_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER5} {$DEFINE DELPHICOMPILER5_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER4} {$DEFINE DELPHICOMPILER4_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER3} {$DEFINE DELPHICOMPILER3_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER2} {$DEFINE DELPHICOMPILER2_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER1} {$DEFINE DELPHICOMPILER1_UP} {$ENDIF} + +{------------------------------------------------------------------------------} +{ DELPHICOMPILERX_UP from DELPHICOMPILERX_UP mappings } +{------------------------------------------------------------------------------} + +{$IFDEF DELPHICOMPILER37_UP} {$DEFINE DELPHICOMPILER29_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER29_UP} {$DEFINE DELPHICOMPILER28_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER28_UP} {$DEFINE DELPHICOMPILER27_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER27_UP} {$DEFINE DELPHICOMPILER26_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER26_UP} {$DEFINE DELPHICOMPILER25_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER25_UP} {$DEFINE DELPHICOMPILER24_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER24_UP} {$DEFINE DELPHICOMPILER23_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER23_UP} {$DEFINE DELPHICOMPILER22_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER22_UP} {$DEFINE DELPHICOMPILER21_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER21_UP} {$DEFINE DELPHICOMPILER20_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER20_UP} {$DEFINE DELPHICOMPILER19_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER19_UP} {$DEFINE DELPHICOMPILER18_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER18_UP} {$DEFINE DELPHICOMPILER17_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER17_UP} {$DEFINE DELPHICOMPILER16_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER16_UP} {$DEFINE DELPHICOMPILER15_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER15_UP} {$DEFINE DELPHICOMPILER14_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER14_UP} {$DEFINE DELPHICOMPILER12_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER12_UP} {$DEFINE DELPHICOMPILER11_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER11_UP} {$DEFINE DELPHICOMPILER10_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER10_UP} {$DEFINE DELPHICOMPILER9_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER9_UP} {$DEFINE DELPHICOMPILER8_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER8_UP} {$DEFINE DELPHICOMPILER7_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER8_UP} {$DEFINE DELPHICOMPILER7_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER7_UP} {$DEFINE DELPHICOMPILER6_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER6_UP} {$DEFINE DELPHICOMPILER5_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER5_UP} {$DEFINE DELPHICOMPILER4_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER4_UP} {$DEFINE DELPHICOMPILER3_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER3_UP} {$DEFINE DELPHICOMPILER2_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER2_UP} {$DEFINE DELPHICOMPILER1_UP} {$ENDIF} + +{------------------------------------------------------------------------------} +{ COMPILERX_UP from COMPILERX mappings } +{------------------------------------------------------------------------------} + +{$IFDEF COMPILER37} {$DEFINE COMPILER37_UP} {$ENDIF} +{$IFDEF COMPILER29} {$DEFINE COMPILER29_UP} {$ENDIF} +{$IFDEF COMPILER28} {$DEFINE COMPILER28_UP} {$ENDIF} +{$IFDEF COMPILER27} {$DEFINE COMPILER27_UP} {$ENDIF} +{$IFDEF COMPILER26} {$DEFINE COMPILER26_UP} {$ENDIF} +{$IFDEF COMPILER25} {$DEFINE COMPILER25_UP} {$ENDIF} +{$IFDEF COMPILER24} {$DEFINE COMPILER24_UP} {$ENDIF} +{$IFDEF COMPILER23} {$DEFINE COMPILER23_UP} {$ENDIF} +{$IFDEF COMPILER22} {$DEFINE COMPILER22_UP} {$ENDIF} +{$IFDEF COMPILER21} {$DEFINE COMPILER21_UP} {$ENDIF} +{$IFDEF COMPILER20} {$DEFINE COMPILER20_UP} {$ENDIF} +{$IFDEF COMPILER19} {$DEFINE COMPILER19_UP} {$ENDIF} +{$IFDEF COMPILER18} {$DEFINE COMPILER18_UP} {$ENDIF} +{$IFDEF COMPILER17} {$DEFINE COMPILER17_UP} {$ENDIF} +{$IFDEF COMPILER16} {$DEFINE COMPILER16_UP} {$ENDIF} +{$IFDEF COMPILER15} {$DEFINE COMPILER15_UP} {$ENDIF} +{$IFDEF COMPILER14} {$DEFINE COMPILER14_UP} {$ENDIF} +{$IFDEF COMPILER12} {$DEFINE COMPILER12_UP} {$ENDIF} +{$IFDEF COMPILER11} {$DEFINE COMPILER11_UP} {$ENDIF} +{$IFDEF COMPILER10} {$DEFINE COMPILER10_UP} {$ENDIF} +{$IFDEF COMPILER9} {$DEFINE COMPILER9_UP} {$ENDIF} +{$IFDEF COMPILER8} {$DEFINE COMPILER8_UP} {$ENDIF} +{$IFDEF COMPILER7} {$DEFINE COMPILER7_UP} {$ENDIF} +{$IFDEF COMPILER6} {$DEFINE COMPILER6_UP} {$ENDIF} +{$IFDEF COMPILER5} {$DEFINE COMPILER5_UP} {$ENDIF} +{$IFDEF COMPILER4} {$DEFINE COMPILER4_UP} {$ENDIF} +{$IFDEF COMPILER35} {$DEFINE COMPILER35_UP} {$ENDIF} +{$IFDEF COMPILER3} {$DEFINE COMPILER3_UP} {$ENDIF} +{$IFDEF COMPILER2} {$DEFINE COMPILER2_UP} {$ENDIF} +{$IFDEF COMPILER1} {$DEFINE COMPILER1_UP} {$ENDIF} + +{------------------------------------------------------------------------------} +{ COMPILERX_UP from COMPILERX_UP mappings } +{------------------------------------------------------------------------------} + +{$IFDEF COMPILER37_UP} {$DEFINE COMPILER29_UP} {$ENDIF} +{$IFDEF COMPILER29_UP} {$DEFINE COMPILER28_UP} {$ENDIF} +{$IFDEF COMPILER28_UP} {$DEFINE COMPILER27_UP} {$ENDIF} +{$IFDEF COMPILER27_UP} {$DEFINE COMPILER26_UP} {$ENDIF} +{$IFDEF COMPILER26_UP} {$DEFINE COMPILER25_UP} {$ENDIF} +{$IFDEF COMPILER25_UP} {$DEFINE COMPILER24_UP} {$ENDIF} +{$IFDEF COMPILER24_UP} {$DEFINE COMPILER23_UP} {$ENDIF} +{$IFDEF COMPILER23_UP} {$DEFINE COMPILER22_UP} {$ENDIF} +{$IFDEF COMPILER22_UP} {$DEFINE COMPILER21_UP} {$ENDIF} +{$IFDEF COMPILER21_UP} {$DEFINE COMPILER20_UP} {$ENDIF} +{$IFDEF COMPILER20_UP} {$DEFINE COMPILER19_UP} {$ENDIF} +{$IFDEF COMPILER19_UP} {$DEFINE COMPILER18_UP} {$ENDIF} +{$IFDEF COMPILER18_UP} {$DEFINE COMPILER17_UP} {$ENDIF} +{$IFDEF COMPILER17_UP} {$DEFINE COMPILER16_UP} {$ENDIF} +{$IFDEF COMPILER16_UP} {$DEFINE COMPILER15_UP} {$ENDIF} +{$IFDEF COMPILER15_UP} {$DEFINE COMPILER14_UP} {$ENDIF} +{$IFDEF COMPILER14_UP} {$DEFINE COMPILER12_UP} {$ENDIF} +{$IFDEF COMPILER12_UP} {$DEFINE COMPILER11_UP} {$ENDIF} +{$IFDEF COMPILER11_UP} {$DEFINE COMPILER10_UP} {$ENDIF} +{$IFDEF COMPILER10_UP} {$DEFINE COMPILER9_UP} {$ENDIF} +{$IFDEF COMPILER9_UP} {$DEFINE COMPILER8_UP} {$ENDIF} +{$IFDEF COMPILER8_UP} {$DEFINE COMPILER7_UP} {$ENDIF} +{$IFDEF COMPILER7_UP} {$DEFINE COMPILER6_UP} {$ENDIF} +{$IFDEF COMPILER6_UP} {$DEFINE COMPILER5_UP} {$ENDIF} +{$IFDEF COMPILER5_UP} {$DEFINE COMPILER4_UP} {$ENDIF} +{$IFDEF COMPILER4_UP} {$DEFINE COMPILER35_UP} {$ENDIF} +{$IFDEF COMPILER35_UP} {$DEFINE COMPILER3_UP} {$ENDIF} +{$IFDEF COMPILER3_UP} {$DEFINE COMPILER2_UP} {$ENDIF} +{$IFDEF COMPILER2_UP} {$DEFINE COMPILER1_UP} {$ENDIF} + +{------------------------------------------------------------------------------} +{ RTLX_UP from RTLX_UP mappings } +{------------------------------------------------------------------------------} + +{$IFDEF RTL370_UP} {$DEFINE RTL360_UP} {$ENDIF} +{$IFDEF RTL360_UP} {$DEFINE RTL350_UP} {$ENDIF} +{$IFDEF RTL350_UP} {$DEFINE RTL340_UP} {$ENDIF} +{$IFDEF RTL340_UP} {$DEFINE RTL330_UP} {$ENDIF} +{$IFDEF RTL330_UP} {$DEFINE RTL320_UP} {$ENDIF} +{$IFDEF RTL320_UP} {$DEFINE RTL310_UP} {$ENDIF} +{$IFDEF RTL310_UP} {$DEFINE RTL300_UP} {$ENDIF} +{$IFDEF RTL300_UP} {$DEFINE RTL290_UP} {$ENDIF} +{$IFDEF RTL290_UP} {$DEFINE RTL280_UP} {$ENDIF} +{$IFDEF RTL280_UP} {$DEFINE RTL270_UP} {$ENDIF} +{$IFDEF RTL270_UP} {$DEFINE RTL260_UP} {$ENDIF} +{$IFDEF RTL260_UP} {$DEFINE RTL250_UP} {$ENDIF} +{$IFDEF RTL250_UP} {$DEFINE RTL240_UP} {$ENDIF} +{$IFDEF RTL240_UP} {$DEFINE RTL230_UP} {$ENDIF} +{$IFDEF RTL230_UP} {$DEFINE RTL220_UP} {$ENDIF} +{$IFDEF RTL220_UP} {$DEFINE RTL210_UP} {$ENDIF} +{$IFDEF RTL210_UP} {$DEFINE RTL200_UP} {$ENDIF} +{$IFDEF RTL200_UP} {$DEFINE RTL190_UP} {$ENDIF} +{$IFDEF RTL190_UP} {$DEFINE RTL185_UP} {$ENDIF} +{$IFDEF RTL185_UP} {$DEFINE RTL180_UP} {$ENDIF} +{$IFDEF RTL180_UP} {$DEFINE RTL170_UP} {$ENDIF} +{$IFDEF RTL170_UP} {$DEFINE RTL160_UP} {$ENDIF} +{$IFDEF RTL160_UP} {$DEFINE RTL150_UP} {$ENDIF} +{$IFDEF RTL150_UP} {$DEFINE RTL145_UP} {$ENDIF} +{$IFDEF RTL145_UP} {$DEFINE RTL142_UP} {$ENDIF} +{$IFDEF RTL142_UP} {$DEFINE RTL140_UP} {$ENDIF} +{$IFDEF RTL140_UP} {$DEFINE RTL130_UP} {$ENDIF} +{$IFDEF RTL130_UP} {$DEFINE RTL125_UP} {$ENDIF} +{$IFDEF RTL125_UP} {$DEFINE RTL120_UP} {$ENDIF} +{$IFDEF RTL120_UP} {$DEFINE RTL110_UP} {$ENDIF} +{$IFDEF RTL110_UP} {$DEFINE RTL100_UP} {$ENDIF} +{$IFDEF RTL100_UP} {$DEFINE RTL93_UP} {$ENDIF} +{$IFDEF RTL93_UP} {$DEFINE RTL90_UP} {$ENDIF} +{$IFDEF RTL90_UP} {$DEFINE RTL80_UP} {$ENDIF} + +{------------------------------------------------------------------------------} +{ Check for CLR overrides of default detection } +{------------------------------------------------------------------------------} + +{$IFDEF CLR} + {$IFDEF FORCE_CLR10} + {$DEFINE CLR10} + {$UNDEF CLR11} + {$UNDEF CLR20} + {$ENDIF FORCE_CLR10} + + {$IFDEF FORCE_CLR11} + {$UNDEF CLR10} + {$DEFINE CLR11} + {$UNDEF CLR20} + {$ENDIF FORCE_CLR11} + + {$IFDEF FORCE_CLR20} + {$UNDEF CLR10} + {$UNDEF CLR11} + {$DEFINE CLR20} + {$ENDIF FORCE_CLR20} +{$ENDIF CLR} + +{------------------------------------------------------------------------------} +{ CLRX from CLRX_UP mappings } +{------------------------------------------------------------------------------} + +{$IFDEF CLR10} {$DEFINE CLR10_UP} {$ENDIF} +{$IFDEF CLR11} {$DEFINE CLR11_UP} {$ENDIF} +{$IFDEF CLR20} {$DEFINE CLR20_UP} {$ENDIF} + +{------------------------------------------------------------------------------} +{ CLRX_UP from CLRX_UP mappings } +{------------------------------------------------------------------------------} + +{$IFDEF CLR20_UP} {$DEFINE CLR11_UP} {$ENDIF} +{$IFDEF CLR11_UP} {$DEFINE CLR10_UP} {$ENDIF} + +{------------------------------------------------------------------------------} + +{$IFDEF DELPHICOMPILER} + {$DEFINE DELPHILANGUAGE} +{$ENDIF} + +{$IFDEF BCBCOMPILER} + {$DEFINE DELPHILANGUAGE} +{$ENDIF} + +{------------------------------------------------------------------------------} +{ KYLIXX_UP from KYLIXX mappings } +{------------------------------------------------------------------------------} + +{$IFDEF KYLIX3} {$DEFINE KYLIX3_UP} {$ENDIF} +{$IFDEF KYLIX2} {$DEFINE KYLIX2_UP} {$ENDIF} +{$IFDEF KYLIX1} {$DEFINE KYLIX1_UP} {$ENDIF} + +{------------------------------------------------------------------------------} +{ KYLIXX_UP from KYLIXX_UP mappings } +{------------------------------------------------------------------------------} + +{$IFDEF KYLIX3_UP} {$DEFINE KYLIX2_UP} {$ENDIF} +{$IFDEF KYLIX2_UP} {$DEFINE KYLIX1_UP} {$ENDIF} + +{------------------------------------------------------------------------------} +{ Map COMPILERX_UP to friendly feature names } +{------------------------------------------------------------------------------} + +{$IFDEF FPC} + {$IFDEF VER1_0} + Please use FPC 2.0 or higher to compile this. + {$ELSE} + { FPC_FULLVERSION is available from 2.2.4 on } + + {$DEFINE SUPPORTS_OUTPARAMS} + {$DEFINE SUPPORTS_WIDECHAR} + {$DEFINE SUPPORTS_WIDESTRING} + {$IF DEFINED(VER2_0) OR DEFINED(VER2_1)} + {$IFDEF HASINTF} + {$DEFINE SUPPORTS_INTERFACE} + {$ENDIF} + {$IFDEF HASVARIANT} + {$DEFINE SUPPORTS_VARIANT} + {$ENDIF} + {$IFDEF HASCURRENCY} + {$DEFINE SUPPORTS_CURRENCY} + {$ENDIF} + {$ELSE} + {$DEFINE SUPPORTS_INTERFACE} + {$DEFINE SUPPORTS_VARIANT} + {$DEFINE SUPPORTS_CURRENCY} + {$IFEND} + {$IFDEF FPC_HAS_TYPE_SINGLE} + {$DEFINE SUPPORTS_SINGLE} + {$ENDIF} + {$IFDEF FPC_HAS_TYPE_DOUBLE} + {$DEFINE SUPPORTS_DOUBLE} + {$ENDIF} + {$IFDEF FPC_HAS_TYPE_EXTENDED} + {$DEFINE SUPPORTS_EXTENDED} + {$ENDIF} + {$DEFINE SUPPORTS_THREADVAR} + {$DEFINE SUPPORTS_CONSTPARAMS} + {$DEFINE SUPPORTS_LONGWORD} + {$DEFINE SUPPORTS_INT64} + {$DEFINE SUPPORTS_DYNAMICARRAYS} + {$DEFINE SUPPORTS_DEFAULTPARAMS} + {$DEFINE SUPPORTS_OVERLOAD} + {$DEFINE ACCEPT_DEPRECATED} // 2.2 also gives warnings + {$DEFINE ACCEPT_PLATFORM} // 2.2 also gives warnings + {$DEFINE ACCEPT_LIBRARY} + {$DEFINE SUPPORTS_DEPRECATED} + {$DEFINE SUPPORTS_PLATFORM} + {$DEFINE SUPPORTS_LIBRARY} + {$DEFINE SUPPORTS_DEPRECATED_WARNINGS} + {$DEFINE SUPPORTS_PLATFORM_WARNINGS} + {$DEFINE SUPPORTS_EXTSYM} + {$DEFINE SUPPORTS_NODEFINE} + {$DEFINE SUPPORTS_DISPINTERFACE} + {$DEFINE SUPPORTS_IMPLEMENTS} + {$DEFINE SUPPORTS_DISPID} + {$DEFINE SUPPORTS_INLINE} + {$DEFINE SUPPORTS_STATIC} + {$DEFINE SUPPORTS_COMPILETIME_MESSAGES} + + {$DEFINE SUPPORTS_CUSTOMVARIANTS} + {$DEFINE SUPPORTS_VARARGS} + {$DEFINE SUPPORTS_ENUMVALUE} + {$IF DEFINED(LINUX) AND DEFINED(CPU386)} + {$DEFINE HAS_UNIT_LIBC} + {$IFEND} + {$DEFINE HAS_UNIT_CONTNRS} + {$DEFINE HAS_UNIT_TYPES} + {$DEFINE HAS_UNIT_VARIANTS} + {$DEFINE HAS_UNIT_STRUTILS} + {$DEFINE HAS_UNIT_DATEUTILS} + {$DEFINE HAS_UNIT_RTLCONSTS} + + {$DEFINE XPLATFORM_RTL} + + {$IF DEFINED(FPC_FULLVERSION)} + { 2.2.4 or newer } + + {$DEFINE SUPPORTS_SETPEFLAGS} + {$DEFINE SUPPORTS_STRICT} + + {$IF defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 20400)} + {$DEFINE SUPPORTS_UINT64} + {$DEFINE SUPPORTS_EXPERIMENTAL_WARNINGS} + {$DEFINE SUPPORTS_REGION} + {$DEFINE SUPPORTS_UNICODE_STRING} + {$IFEND} + + {$IF defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 20402)} + {$DEFINE SUPPORTS_FOR_IN} + {$IFEND} + + {$IF defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 20600)} + {$DEFINE SUPPORTS_LIBRARY_WARNINGS} + {$DEFINE SUPPORTS_DEPRECATED_DETAILS} + {$DEFINE SUPPORTS_NESTED_TYPES} + {$DEFINE SUPPORTS_NESTED_CONSTANTS} + {$DEFINE SUPPORTS_ENHANCED_RECORDS} // called Advanced Records in FPC + {$DEFINE SUPPORTS_CLASS_FIELDS} + {$DEFINE SUPPORTS_CLASS_HELPERS} + {$DEFINE SUPPORTS_CLASS_OPERATORS} + {$DEFINE SUPPORTS_CLASS_CTORDTORS} + {$DEFINE SUPPORTS_FINAL} + {$DEFINE SUPPORTS_CAST_INTERFACE_TO_OBJ} + + {$DEFINE HAS_ENOTIMPLEMENTED} + {$IFEND} + + {$IF defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 20602)} + {$DEFINE SUPPORTS_INT_ALIASES} + + {$DEFINE HAS_EARGUMENTEXCEPTION} + {$IFEND} + + {$IF defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 30000)} + {$DEFINE SUPPORTS_GENERICS} + {$DEFINE SUPPORTS_GENERIC_TYPES} + + {$DEFINE HAS_UNIT_CHARACTER} + {$IFEND} + + {$IF defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 30200)} + {$DEFINE SUPPORTS_GENERIC_METHODS} + {$DEFINE SUPPORTS_GENERIC_ROUTINES} + {$DEFINE SUPPORTS_WEAKPACKAGEUNIT} + + {$DEFINE HAS_UNIT_RTTI} + {$DEFINE HAS_UNIT_SYSTEM_UITYPES} + {$IFEND} + {$ELSE} + { older than 2.2.4 } + + {$IFDEF VER2_2} + {$DEFINE SUPPORTS_SETPEFLAGS} + {$DEFINE SUPPORTS_STRICT} + {$ENDIF} + {$IFEND} + {$ENDIF} +{$ENDIF FPC} + +{$IFDEF CLR} + {$DEFINE SUPPORTS_UNICODE} +{$ENDIF CLR} + +{$IFDEF BORLAND} + {$IFNDEF CLR} + // The ASSEMBLER symbol appeared with Delphi 7 + {$IFNDEF COMPILER7_UP} + {$DEFINE CPUASM} + {$ELSE} + {$IFDEF ASSEMBLER} + {$DEFINE CPUASM} + {$ENDIF ASSEMBLER} + {$ENDIF ~COMPILER7_UP} + {$ENDIF ~CLR} +{$ENDIF BORLAND} + +{$IFDEF COMPILER1_UP} + {$DEFINE SUPPORTS_CONSTPARAMS} + {$DEFINE SUPPORTS_SINGLE} + {$DEFINE SUPPORTS_DOUBLE} + {$DEFINE SUPPORTS_EXTENDED} + {$DEFINE SUPPORTS_PACKAGES} +{$ENDIF COMPILER1_UP} + +{$IFDEF COMPILER2_UP} + {$DEFINE SUPPORTS_CURRENCY} + {$DEFINE SUPPORTS_THREADVAR} + {$DEFINE SUPPORTS_VARIANT} + {$DEFINE SUPPORTS_WIDECHAR} +{$ENDIF COMPILER2_UP} + +{$IFDEF COMPILER3_UP} + {$DEFINE SUPPORTS_OUTPARAMS} + {$DEFINE SUPPORTS_WIDESTRING} + {$DEFINE SUPPORTS_INTERFACE} + {$DEFINE SUPPORTS_DISPINTERFACE} + {$DEFINE SUPPORTS_DISPID} + {$DEFINE SUPPORTS_WEAKPACKAGEUNIT} +{$ENDIF COMPILER3_UP} + +{$IFDEF COMPILER35_UP} + {$DEFINE SUPPORTS_EXTSYM} + {$DEFINE SUPPORTS_NODEFINE} +{$ENDIF COMPILER35_UP} + +{$IFDEF COMPILER4_UP} + {$DEFINE SUPPORTS_LONGWORD} + {$DEFINE SUPPORTS_INT64} + {$DEFINE SUPPORTS_DYNAMICARRAYS} + {$DEFINE SUPPORTS_DEFAULTPARAMS} + {$DEFINE SUPPORTS_OVERLOAD} + {$DEFINE SUPPORTS_IMPLEMENTS} +{$ENDIF COMPILER4_UP} + +{$IFDEF COMPILER6_UP} + {$DEFINE SUPPORTS_DEPRECATED} + {$DEFINE SUPPORTS_LIBRARY} + {$DEFINE SUPPORTS_PLATFORM} + {$DEFINE SUPPORTS_LOCAL} + {$DEFINE SUPPORTS_SETPEFLAGS} + {$DEFINE SUPPORTS_EXPERIMENTAL_WARNINGS} + {$DEFINE ACCEPT_DEPRECATED} + {$DEFINE ACCEPT_PLATFORM} + {$DEFINE ACCEPT_LIBRARY} + {$DEFINE SUPPORTS_DEPRECATED_WARNINGS} + {$DEFINE SUPPORTS_LIBRARY_WARNINGS} + {$DEFINE SUPPORTS_PLATFORM_WARNINGS} + {$DEFINE SUPPORTS_CUSTOMVARIANTS} + {$DEFINE SUPPORTS_VARARGS} + {$DEFINE SUPPORTS_ENUMVALUE} + {$DEFINE SUPPORTS_COMPILETIME_MESSAGES} +{$ENDIF COMPILER6_UP} + +{$IFDEF COMPILER7_UP} + {$DEFINE SUPPORTS_UNSAFE_WARNINGS} + {$DEFINE SUPPORTS_UINT64} +{$ENDIF COMPILER7_UP} + +{$IFDEF COMPILER9_UP} + {$DEFINE SUPPORTS_FOR_IN} + {$DEFINE SUPPORTS_INLINE} + {$DEFINE SUPPORTS_NESTED_CONSTANTS} + {$DEFINE SUPPORTS_NESTED_TYPES} + {$DEFINE SUPPORTS_REGION} + {$IFDEF CLR} + {$DEFINE SUPPORTS_ENHANCED_RECORDS} + {$DEFINE SUPPORTS_CLASS_FIELDS} + {$DEFINE SUPPORTS_CLASS_HELPERS} + {$DEFINE SUPPORTS_CLASS_OPERATORS} + {$DEFINE SUPPORTS_STRICT} + {$DEFINE SUPPORTS_STATIC} + {$DEFINE SUPPORTS_FINAL} + {$ENDIF CLR} +{$ENDIF COMPILER9_UP} + +{$IFDEF COMPILER10_UP} + {$DEFINE SUPPORTS_ENHANCED_RECORDS} + {$DEFINE SUPPORTS_CLASS_FIELDS} + {$DEFINE SUPPORTS_CLASS_HELPERS} + {$DEFINE SUPPORTS_CLASS_OPERATORS} + {$DEFINE SUPPORTS_STRICT} + {$DEFINE SUPPORTS_STATIC} + {$DEFINE SUPPORTS_FINAL} + {$DEFINE SUPPORTS_METHODINFO} +{$ENDIF COMPILER10_UP} + +{$IFDEF COMPILER11_UP} + {$IFDEF CLR} + {$DEFINE SUPPORTS_GENERICS} + {$DEFINE SUPPORTS_GENERIC_TYPES} + {$DEFINE SUPPORTS_GENERIC_METHODS} + {$DEFINE SUPPORTS_DEPRECATED_DETAILS} + {$ENDIF CLR} +{$ENDIF COMPILER11_UP} + +{$IFDEF COMPILER12_UP} + {$DEFINE SUPPORTS_GENERICS} + {$DEFINE SUPPORTS_GENERIC_TYPES} + {$DEFINE SUPPORTS_GENERIC_METHODS} + {$DEFINE SUPPORTS_DEPRECATED_DETAILS} + {$DEFINE SUPPORTS_TYPED_POINTERMATH} + {$DEFINE SUPPORTS_STRINGCHECKS} + {$DEFINE SUPPORTS_INT_ALIASES} + {$DEFINE SUPPORTS_SCOPEDENUMS} + {$IFNDEF CLR} + {$DEFINE SUPPORTS_UNICODE} + {$DEFINE SUPPORTS_UNICODE_STRING} + {$ENDIF CLR} +{$ENDIF COMPILER12_UP} + +{$IFDEF COMPILER14_UP} + {$DEFINE SUPPORTS_CLASS_CTORDTORS} + {$DEFINE SUPPORTS_EXTENDED_RTTI} + {$DEFINE HAS_UNIT_RTTI} + {$DEFINE SUPPORTS_CAST_INTERFACE_TO_OBJ} + {$DEFINE SUPPORTS_DELAYED_LOADING} +{$ENDIF COMPILER14_UP} + +{$IFDEF COMPILER16_UP} + {$DEFINE USE_64BIT_TYPES} // TODO -oOutchy : Document in Feature Directives + {$DEFINE SUPPORTS_EXCESSPRECISION} + {$IFDEF CPU64} + {$DEFINE EXTENDED_IS_DOUBLE_ALIAS} + {$ENDIF} +{$ENDIF COMPILER16_UP} + +{$IFDEF COMPILER17_UP} + {$DEFINE SUPPORTS_LEGACYIFEND} +{$ENDIF COMPILER17_UP} + +{$IFDEF RTL130_UP} + {$DEFINE HAS_UNIT_CONTNRS} + {$IFDEF COMPILER25} + {$IFDEF LINUX} + {$UNDEF HAS_UNIT_CONTNRS} + {$ENDIF LINUX} + {$ENDIF COMPILER25} + {$DEFINE HAS_PROPERTY_OLDCREATEORDER} +{$ENDIF RTL130_UP} + +{$IFDEF RTL140_UP} + {$IFDEF LINUX} + {$DEFINE HAS_UNIT_LIBC} + {$ENDIF LINUX} + {$DEFINE HAS_UNIT_RTLCONSTS} + {$DEFINE HAS_UNIT_TYPES} + {$DEFINE HAS_UNIT_VARIANTS} + {$DEFINE HAS_UNIT_STRUTILS} + {$DEFINE HAS_UNIT_DATEUTILS} + {$DEFINE XPLATFORM_RTL} +{$ENDIF RTL140_UP} + +{$IFDEF RTL150_UP} + {$DEFINE HAS_UNIT_UXTHEME} +{$ENDIF RTL150_UP} + +{$IFDEF RTL170_UP} + {$DEFINE HAS_UNIT_HTTPPROD} +{$ENDIF RTL170_UP} + +{$IFDEF RTL185_UP} + {$DEFINE HAS_UNIT_GIFIMG} +{$ENDIF RTL185_UP} + +{$IFDEF RTL200_UP} + {$DEFINE HAS_UNIT_ANSISTRINGS} + {$DEFINE HAS_UNIT_PNGIMAGE} + {$DEFINE HAS_UNIT_CHARACTER} + {$DEFINE HAS_EXCEPTION_STACKTRACE} +{$ENDIF RTL200_UP} + +{$IFDEF RTL210_UP} + {$DEFINE HAS_EARGUMENTEXCEPTION} +{$ENDIF RTL210_UP} + +{$IFDEF RTL220_UP} + {$DEFINE HAS_UNIT_REGULAREXPRESSIONSAPI} + {$DEFINE HAS_ENOTIMPLEMENTED} +{$ENDIF RTL220_UP} + +{$IFDEF RTL230_UP} + {$DEFINE HAS_UNITSCOPE} + {$DEFINE HAS_UNIT_SYSTEM_UITYPES} + {$DEFINE HAS_UNIT_VCL_THEMES} + {$DEFINE HAS_UNIT_SYSTEM_ZIP} + {$DEFINE HAS_UNIT_SYSTEM_ZLIB} + {$DEFINE HAS_TSTRINGS_ENCODING} +{$ENDIF RTL230_UP} + +{$IFDEF RTL240_UP} + {$DEFINE HAS_UNIT_SYSTEM_ACTIONS} + {$DEFINE HAS_PROPERTY_STYLEELEMENTS} +{$ENDIF RTL240_UP} + +{$IFDEF RTL250_UP} + {$DEFINE DEPRECATED_SYSUTILS_ANSISTRINGS} + {$DEFINE DEPRECATED_TCHARACTER} +{$ENDIF RTL250_UP} + +{$IFDEF RTL270_UP} + {$DEFINE HAS_AUTOMATIC_DB_FIELDS} +{$ENDIF RTL270_UP} + +{$IFDEF RTL320_UP} + {$UNDEF HAS_UNIT_LIBC} +{$ENDIF RTL320_UP} + +{$IFDEF RTL350_UP} + {$UNDEF HAS_PROPERTY_OLDCREATEORDER} +{$ENDIF} + +{------------------------------------------------------------------------------} +{ Cross-platform related defines } +{------------------------------------------------------------------------------} + +{$IFNDEF CPUASM} + {$DEFINE PUREPASCAL} +{$ENDIF ~CPUASM} + +{$IFDEF WIN32} + {$DEFINE MSWINDOWS} // predefined for D6+/BCB6+ + {$DEFINE Win32API} +{$ENDIF} + +{$IFDEF DELPHILANGUAGE} + {$IFDEF LINUX} + {$DEFINE UNIX} + {$ENDIF} + + {$IFNDEF CONSOLE} + {$IFDEF LINUX} + {$DEFINE VisualCLX} + {$ENDIF} + {$IFNDEF VisualCLX} + {$DEFINE VCL} + {$ENDIF} + {$ENDIF ~CONSOLE} +{$ENDIF DELPHILANGUAGE} + +{------------------------------------------------------------------------------} +{ Compiler settings } +{------------------------------------------------------------------------------} + +{$IFOPT A+} {$DEFINE ALIGN_ON} {$ENDIF} +{$IFOPT B+} {$DEFINE BOOLEVAL_ON} {$ENDIF} +{$IFDEF COMPILER2_UP} + {$IFOPT C+} {$DEFINE ASSERTIONS_ON} {$ENDIF} +{$ENDIF} +{$IFOPT D+} {$DEFINE DEBUGINFO_ON} {$ENDIF} +{$IFOPT G+} {$DEFINE IMPORTEDDATA_ON} {$ENDIF} +{$IFDEF COMPILER2_UP} + {$IFOPT H+} {$DEFINE LONGSTRINGS_ON} {$ENDIF} +{$ENDIF} + +// Hints +{$IFOPT I+} {$DEFINE IOCHECKS_ON} {$ENDIF} +{$IFDEF COMPILER2_UP} + {$IFOPT J+} {$DEFINE WRITEABLECONST_ON} {$ENDIF} +{$ENDIF} +{$IFOPT L+} {$DEFINE LOCALSYMBOLS} {$DEFINE LOCALSYMBOLS_ON} {$ENDIF} +{$IFOPT M+} {$DEFINE TYPEINFO_ON} {$ENDIF} +{$IFOPT O+} {$DEFINE OPTIMIZATION_ON} {$ENDIF} +{$IFOPT P+} {$DEFINE OPENSTRINGS_ON} {$ENDIF} +{$IFOPT Q+} {$DEFINE OVERFLOWCHECKS_ON} {$ENDIF} +{$IFOPT R+} {$DEFINE RANGECHECKS_ON} {$ENDIF} + +// Real compatibility +{$IFOPT T+} {$DEFINE TYPEDADDRESS_ON} {$ENDIF} +{$IFOPT U+} {$DEFINE SAFEDIVIDE_ON} {$ENDIF} +{$IFOPT V+} {$DEFINE VARSTRINGCHECKS_ON} {$ENDIF} +{$IFOPT W+} {$DEFINE STACKFRAMES_ON} {$ENDIF} + +// Warnings +{$IFOPT X+} {$DEFINE EXTENDEDSYNTAX_ON} {$ENDIF} + +// for Delphi/BCB trial versions remove the point from the line below +{.$UNDEF SUPPORTS_WEAKPACKAGEUNIT} + +{$ENDIF ~JEDI_INC} diff --git a/3rdParty/JCL/source/include/jedi/kylix.inc b/3rdParty/JCL/source/include/jedi/kylix.inc index 55f095e1..2ea06d70 100644 --- a/3rdParty/JCL/source/include/jedi/kylix.inc +++ b/3rdParty/JCL/source/include/jedi/kylix.inc @@ -1,30 +1,30 @@ -// -// This is FPC-incompatible code and was excluded from jedi.inc for this reason -// -// Kylix 3/C++ for some reason evaluates CompilerVersion comparisons to False, -// if the constant to compare with is a floating point value - weird. -// The "+" sign prevents Kylix/Delphi from issueing a warning about comparing -// signed and unsigned values. -// - {$IF not Declared(CompilerVersion)} - {$DEFINE KYLIX1} - {$DEFINE COMPILER6} - {$DEFINE DELPHICOMPILER6} - {$DEFINE RTL140_UP} - {$ELSEIF Declared(CompilerVersion) and (CompilerVersion > +14)} - {$DEFINE KYLIX2} - {$DEFINE COMPILER6} - {$DEFINE DELPHICOMPILER6} - {$DEFINE RTL142_UP} - {$ELSEIF Declared(CompilerVersion) and (CompilerVersion < +15)} - {$DEFINE KYLIX3} - {$DEFINE COMPILER6} - {$IFNDEF BCB} - {$DEFINE DELPHICOMPILER6} - {$ENDIF} - {$DEFINE RTL145_UP} - {$ELSE} - Add new Kylix version - {$IFEND} - - +// +// This is FPC-incompatible code and was excluded from jedi.inc for this reason +// +// Kylix 3/C++ for some reason evaluates CompilerVersion comparisons to False, +// if the constant to compare with is a floating point value - weird. +// The "+" sign prevents Kylix/Delphi from issueing a warning about comparing +// signed and unsigned values. +// + {$IF not Declared(CompilerVersion)} + {$DEFINE KYLIX1} + {$DEFINE COMPILER6} + {$DEFINE DELPHICOMPILER6} + {$DEFINE RTL140_UP} + {$ELSEIF Declared(CompilerVersion) and (CompilerVersion > +14)} + {$DEFINE KYLIX2} + {$DEFINE COMPILER6} + {$DEFINE DELPHICOMPILER6} + {$DEFINE RTL142_UP} + {$ELSEIF Declared(CompilerVersion) and (CompilerVersion < +15)} + {$DEFINE KYLIX3} + {$DEFINE COMPILER6} + {$IFNDEF BCB} + {$DEFINE DELPHICOMPILER6} + {$ENDIF} + {$DEFINE RTL145_UP} + {$ELSE} + Add new Kylix version + {$IFEND} + + diff --git a/3rdParty/JCL/source/include/unixonly.inc b/3rdParty/JCL/source/include/unixonly.inc index 08a13bfa..1e56043e 100644 --- a/3rdParty/JCL/source/include/unixonly.inc +++ b/3rdParty/JCL/source/include/unixonly.inc @@ -1,51 +1,51 @@ -{$IFNDEF UNIXONLY_INC} -{$DEFINE UNIXONLY_INC} - -{**************************************************************************************************} -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License");} -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is: unixonly.inc, released on 2004-06-21. } -{ } -{ You may retrieve the latest version of this file at the JCL home page, } -{ located at https://github.com/project-jedi/jcl } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -{$IFNDEF JEDI_INC} -ALERT_jedi_inc_missing -// This inc file depends on jedi.inc which has to -// be included first (usually indirectly through -// the inclusion of jcl.inc). -{$ENDIF ~JEDI_INC} - -// Suppress platform warnings which are irrelevant -// because the including unit can only be compiled -// for Unix platforms anyway. - -{$WARN UNIT_PLATFORM OFF} -{$WARN SYMBOL_PLATFORM OFF} - -// Cause a compilation error for non-Unix platforms. - -{$IFNDEF UNIX} - {$IFDEF SUPPORTS_COMPILETIME_MESSAGES} - {$MESSAGE FATAL 'This unit is only supported on Unix!'} - {$ELSE} - 'This unit is only supported on Unix!' - {$ENDIF SUPPORTS_COMPILETIME_MESSAGES} -{$ENDIF ~UNIX} - -{$ENDIF ~UNIXONLY_INC} +{$IFNDEF UNIXONLY_INC} +{$DEFINE UNIXONLY_INC} + +{**************************************************************************************************} +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License");} +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is: unixonly.inc, released on 2004-06-21. } +{ } +{ You may retrieve the latest version of this file at the JCL home page, } +{ located at https://github.com/project-jedi/jcl } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +{$IFNDEF JEDI_INC} +ALERT_jedi_inc_missing +// This inc file depends on jedi.inc which has to +// be included first (usually indirectly through +// the inclusion of jcl.inc). +{$ENDIF ~JEDI_INC} + +// Suppress platform warnings which are irrelevant +// because the including unit can only be compiled +// for Unix platforms anyway. + +{$WARN UNIT_PLATFORM OFF} +{$WARN SYMBOL_PLATFORM OFF} + +// Cause a compilation error for non-Unix platforms. + +{$IFNDEF UNIX} + {$IFDEF SUPPORTS_COMPILETIME_MESSAGES} + {$MESSAGE FATAL 'This unit is only supported on Unix!'} + {$ELSE} + 'This unit is only supported on Unix!' + {$ENDIF SUPPORTS_COMPILETIME_MESSAGES} +{$ENDIF ~UNIX} + +{$ENDIF ~UNIXONLY_INC} diff --git a/3rdParty/JCL/source/include/windowsonly.inc b/3rdParty/JCL/source/include/windowsonly.inc index 7879f7dd..486b685f 100644 --- a/3rdParty/JCL/source/include/windowsonly.inc +++ b/3rdParty/JCL/source/include/windowsonly.inc @@ -1,54 +1,54 @@ -{$IFNDEF WINDOWSONLY_INC} -{$DEFINE WINDOWSONLY_INC} - -{**************************************************************************************************} -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License");} -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is: windowsonly.inc, released on 2002-07-04. } -{ } -{ You may retrieve the latest version of this file at the JCL home page, } -{ located at https://github.com/project-jedi/jcl } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -{$IFNDEF JEDI_INC} -ALERT_jedi_inc_missing -// This inc file depends on jedi.inc which has to -// be included first (usually indirectly through -// the inclusion of jcl.inc). -{$ENDIF ~JEDI_INC} - -// Suppress platform warnings which are irrelevant -// because the including unit can only be compiled -// for the Windows platform anyway. - -{$IFDEF SUPPORTS_PLATFORM_WARNINGS} - {$WARN UNIT_PLATFORM OFF} - {$WARN SYMBOL_PLATFORM OFF} -{$ENDIF SUPPORTS_PLATFORM_WARNINGS} - -// Cause a compilation error for any platform except Windows. - -{$IFNDEF MSWINDOWS} - {$IFDEF SUPPORTS_COMPILETIME_MESSAGES} - {$MESSAGE FATAL 'This unit is only supported on Windows!'} - {$ELSE} - 'This unit is only supported on Windows!' - {$ENDIF SUPPORTS_COMPILETIME_MESSAGES} -{$ENDIF ~MSWINDOWS} - -{$ENDIF ~WINDOWSONLY_INC} - +{$IFNDEF WINDOWSONLY_INC} +{$DEFINE WINDOWSONLY_INC} + +{**************************************************************************************************} +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License");} +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is: windowsonly.inc, released on 2002-07-04. } +{ } +{ You may retrieve the latest version of this file at the JCL home page, } +{ located at https://github.com/project-jedi/jcl } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +{$IFNDEF JEDI_INC} +ALERT_jedi_inc_missing +// This inc file depends on jedi.inc which has to +// be included first (usually indirectly through +// the inclusion of jcl.inc). +{$ENDIF ~JEDI_INC} + +// Suppress platform warnings which are irrelevant +// because the including unit can only be compiled +// for the Windows platform anyway. + +{$IFDEF SUPPORTS_PLATFORM_WARNINGS} + {$WARN UNIT_PLATFORM OFF} + {$WARN SYMBOL_PLATFORM OFF} +{$ENDIF SUPPORTS_PLATFORM_WARNINGS} + +// Cause a compilation error for any platform except Windows. + +{$IFNDEF MSWINDOWS} + {$IFDEF SUPPORTS_COMPILETIME_MESSAGES} + {$MESSAGE FATAL 'This unit is only supported on Windows!'} + {$ELSE} + 'This unit is only supported on Windows!' + {$ENDIF SUPPORTS_COMPILETIME_MESSAGES} +{$ENDIF ~MSWINDOWS} + +{$ENDIF ~WINDOWSONLY_INC} + diff --git a/3rdParty/JCL/source/prototypes/Hardlinks.pas b/3rdParty/JCL/source/prototypes/Hardlinks.pas new file mode 100644 index 00000000..5a92cd51 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/Hardlinks.pas @@ -0,0 +1,925 @@ +{$IFDEF JCL} +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Initial Developer of the Original Code is Oliver Schneider (Assarbad att gmx dott info). } +{ Portions created by Oliver Schneider are Copyright (C) 1995 - 2004 Oliver Schneider. } +{ All rights reserved. } +{ } +{ Obtained through: } +{ Joint Endeavour of Delphi Innovators (Project JEDI) } +{ } +{ You may retrieve the latest version of the original file at the Original Developer's homepage, } +{ located at [http://assarbad.net]. Note that the original file can be used with an arbitrary OSI- } +{ approved license as long as you follow the additional terms given in the original file. } +{ Additionally a C/C++ (MS VC++) version is available under the same terms. } +{ } +{ Contributor(s): } +{ Oliver Schneider (assarbad) } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ } +{**************************************************************************************************} +{ } +{ Windows NT 4.0 compatible implementation of the CreateHardLink() API introduced in Windows } +{ 2000. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} +{$ELSE ~JCL} +(****************************************************************************** + ****************************************************************************** + *** *** + *** Hardlinks. Implementation of the CreateHardLink() API introduced in *** + *** Windows 2000 - BUT ALSO COMPATIBLE with Windows NT 4.0! *** + *** This implementation should be fully compatible with the Windows 2000 *** + *** implementation (including last error and so on). *** + *** *** + *** Version [1.13a] {Last mod 2005-03-06} *** + *** *** + ****************************************************************************** + ****************************************************************************** + + _\\|//_ + (` * * ') + ______________________________ooO_(_)_Ooo_____________________________________ + ****************************************************************************** + ****************************************************************************** + *** *** + *** Copyright (c) 1995 - 2005 by -=Assarbad=- *** + *** Portions Copyright (c) 2004 by Robert Marquardt *** + *** Portions Copyright (c) 2004 by Robert Rossmair *** + *** *** + *** CONTACT TO THE AUTHOR(S): *** + *** ____________________________________ *** + *** | | *** + *** | -=Assarbad=- aka Oliver | *** + *** |____________________________________| *** + *** | | *** + *** | Assarbad @ gmx.info|.net|.com|.de | *** + *** | ICQ: 281645 | *** + *** | AIM: nixlosheute | *** + *** | nixahnungnicht | *** + *** | MSN: Assarbad@ePost.de | *** + *** | YIM: sherlock_holmes_and_dr_watson | *** + *** |____________________________________| *** + *** ___ *** + *** / | || || *** + *** / _ | ________ ___ ____||__ ___ __|| *** + *** / /_\ | / __/ __// |/ _/| \ / | / | *** + *** / ___ |__\\__\\ / /\ || | | /\ \/ /\ |/ /\ | DOT NET *** + *** /_/ \_/___/___/ /_____\|_| |____/_____\\__/\| *** + *** ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ *** + *** [http://assarbad.net | http://assarbad.org] *** + *** *** + *** Notes: *** + *** - my first name is Oliver, you may well use this in your e-mails *** + *** - for questions and/or proposals drop me a mail or instant message *** + *** *** + ***~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*** + *** May the source be with you, stranger ... ;) *** + *** Snizhok, eto ne tolko fruktovij kefir, snizhok, eto stil zhizni. *** + *** Vsekh Privet iz Germanii *** + *** *** + *** Greets from -=Assarbad=- fly to YOU =) *** + *** Special greets fly 2 Nico, Casper, SA, Pizza, Navarion, Eugen, Zhenja, *** + *** Xandros, Melkij, Strelok etc pp. *** + *** *** + *** Thanks to: *** + *** W.A. Mozart, Vivaldi, Beethoven, Poeta Magica, Kurtzweyl, Manowar, *** + *** Blind Guardian, Weltenbrand, In Extremo, Wolfsheim, Carl Orff, Zemfira *** + *** ... most of my work was done with their music in the background ;) *** + *** *** + ****************************************************************************** + ****************************************************************************** + + LEGAL STUFF: + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + NOTE: This source is OSI-licensed. You may choose between any of the licenses + approved by the OSI (Open Source Initiative) as long as the licensing + of this module will not force a whole project under the chosen license. + This basically means that the virulent character of a license (e.g. GPL) + must no be misused to force a project to use the license you chose for + this module! + OSI-approved licenses can be found at this website: + http://www.opensource.org/licenses/ + + You have the choice to make this module compatible with your own open + source or commercial or whatever project by choosing the right license. + + However, I recommend using either of the following licenses: + - the BSD-License (as seen below) + - the LGPL [ http://www.opensource.org/licenses/lgpl-license.php ] + - the MPL [ http://www.opensource.org/licenses/mozilla1.1.php ] + + !ATTENTION!: if this unit comes bundled with the files of the project + JEDI the project license (currently MPL) is mandatory!!! + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + Copyright (c) 1995-2005, -=Assarbad=- ["copyright holder(s)"] + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + 1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + 2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + 3. The name(s) of the copyright holder(s) may not be used to endorse or + promote products derived from this software without specific prior written + permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE + DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY + DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES + (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; + LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON + ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS + SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + .oooO Oooo. + ____________________________( )_____( )___________________________________ + \ ( ) / + \_) (_/ + + ******************************************************************************) +{$ENDIF ~JCL} + +unit Hardlinks; + +{$IFDEF JCL} +{$I jcl.inc} +{$I windowsonly.inc} + +// ALL enabled by default for Project JEDI +{$DEFINE STDCALL} // Make functions STDCALL always +{$DEFINE RTDL} // Use runtime dynamic linking +{$DEFINE PREFERAPI} // Prefer the "real" Windows API on systems on which it exists + // If this is defined STDCALL is automatically needed and defined! +{$ENDIF JCL} + +{$ALIGN ON} +{$MINENUMSIZE 4} + +interface + +{$IFDEF JCL} +//DOM-IGNORE-BEGIN +{$ENDIF JCL} + +(* + All possible combinations of the above DEFINEs have been tested and work fine. + + # | A B C + ---|--------- + 1 | 0 0 0 A = STDCALL + 2 | 0 0 X B = RTDL + 3 | X 0 0 C = PREFERAPI + 4 | X 0 X + 5 | X X 0 + 6 | X X X +*) +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows; + {$ELSE ~HAS_UNITSCOPE} + Windows; + {$ENDIF ~HAS_UNITSCOPE} + +{$IFDEF PREFERAPI} + {$DEFINE STDCALL // For the windows API we _require_ STDCALL calling convention } +{$ENDIF PREFERAPI} + +{$EXTERNALSYM CreateHardLinkW} +{$EXTERNALSYM CreateHardLinkA} + +{$IFNDEF PREFERAPI} +// We prefer the homegrown version - use the static version +function CreateHardLinkW(szLinkName, szLinkTarget: PWideChar; lpSecurityAttributes: PSecurityAttributes): BOOL; + {$IFDEF STDCALL} stdcall; {$ENDIF} // Makes the actual call STDCALL +function CreateHardLinkA(szLinkName, szLinkTarget: PAnsiChar; lpSecurityAttributes: PSecurityAttributes): BOOL; + {$IFDEF STDCALL} stdcall; {$ENDIF} // Makes the actual call STDCALL +{$ELSE PREFERAPI} +// Well, we did not decide yet ;) - bind to either address, depending on whether +// the API could be found. +type + TFNCreateHardLinkW = function(szLinkName, szLinkTarget: PWideChar; lpSecurityAttributes: PSecurityAttributes): BOOL; {$IFDEF STDCALL} stdcall; {$ENDIF} + TFNCreateHardLinkA = function(szLinkName, szLinkTarget: PAnsiChar; lpSecurityAttributes: PSecurityAttributes): BOOL; {$IFDEF STDCALL} stdcall; {$ENDIF} +var + CreateHardLinkW: TFNCreateHardLinkW = nil; + CreateHardLinkA: TFNCreateHardLinkA = nil; +{$ENDIF PREFERAPI} + +{$IFDEF RTDL} +var + hNtDll: THandle = 0; // For runtime dynamic linking + bRtdlFunctionsLoaded: Boolean = False; // To show wether the RTDL functions had been loaded +{$ENDIF RTDL} + +{$IFDEF JCL} +//DOM-IGNORE-END +{$ENDIF JCL} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +const + szNtDll = 'NTDLL.DLL'; // Import native APIs from this DLL + szKernel32 = 'KERNEL32.DLL'; +{$IFDEF PREFERAPI} + szCreateHardLinkA = 'CreateHardLinkA'; + szCreateHardLinkW = 'CreateHardLinkW'; +{$ENDIF PREFERAPI} + +(****************************************************************************** + + Note, I only include function prototypes and constants here which are needed! + For other prototypes or constants check out the related books of + - Gary Nebbett + - Sven B. Schreiber + - Rajeev Nagar + + Note, one my homepage I have also some Native APIs listed in Delphi translated + form. Not all of them might be translated correctly with respect to the fact + whether or not they are pointer and whether or not the alignment of variables + or types is always correct. This might be reviewed by me somewhen in future. + + ******************************************************************************) + +// ================================================================= +// Type definitions +// ================================================================= +type + NTSTATUS = Longint; + +type + UNICODE_STRING = record + Length: WORD; + MaximumLength: WORD; + Buffer: PWideChar; + end; + PUNICODE_STRING = ^UNICODE_STRING; + +// type + // ANSI_STRING = record + // Length: WORD; + // MaximumLength: WORD; + // Buffer: PAnsiChar; + // end; + // PANSI_STRING = ^ANSI_STRING; + +type + OBJECT_ATTRIBUTES = record + Length: ULONG; + RootDirectory: THandle; + ObjectName: PUNICODE_STRING; + Attributes: ULONG; + SecurityDescriptor: Pointer; // Points to type SECURITY_DESCRIPTOR + SecurityQualityOfService: Pointer; // Points to type SECURITY_QUALITY_OF_SERVICE + end; + // POBJECT_ATTRIBUTES = ^OBJECT_ATTRIBUTES; + +type + IO_STATUS_BLOCK = record + case integer of + 0: + (Status: NTSTATUS); + 1: + (Pointer: Pointer; + Information: ULONG); // 'Information' does not belong to the union! + end; + // PIO_STATUS_BLOCK = ^IO_STATUS_BLOCK; + +type + _FILE_LINK_RENAME_INFORMATION = record // File Information Classes 10 and 11 + ReplaceIfExists: BOOL; + RootDirectory: THandle; + FileNameLength: ULONG; + FileName: array[0..0] of WideChar; + end; + FILE_LINK_INFORMATION = _FILE_LINK_RENAME_INFORMATION; + PFILE_LINK_INFORMATION = ^FILE_LINK_INFORMATION; + // FILE_RENAME_INFORMATION = _FILE_LINK_RENAME_INFORMATION; + // PFILE_RENAME_INFORMATION = ^FILE_RENAME_INFORMATION; + +// ================================================================= +// Constants +// ================================================================= +const + FileLinkInformation = 11; + FILE_SYNCHRONOUS_IO_NONALERT = $00000020; // All operations on the file are + // performed synchronously. Waits + // in the system to synchronize I/O + // queuing and completion are not + // subject to alerts. This flag + // also causes the I/O system to + // maintain the file position context. + // If this flag is set, the + // DesiredAccess SYNCHRONIZE flag also + // must be set. + FILE_OPEN_FOR_BACKUP_INTENT = $00004000; // The file is being opened for backup + // intent, hence, the system should + // check for certain access rights + // and grant the caller the appropriate + // accesses to the file before checking + // the input DesiredAccess against the + // file's security descriptor. + FILE_OPEN_REPARSE_POINT = $00200000; + DELETE = $00010000; + SYNCHRONIZE = $00100000; + STATUS_SUCCESS = NTSTATUS(0); + OBJ_CASE_INSENSITIVE = $00000040; + SYMBOLIC_LINK_QUERY = $00000001; + + // Should be defined, but isn't + HEAP_ZERO_MEMORY = $00000008; + + // Related constant(s) for RtlDetermineDosPathNameType_U() + // INVALID_PATH = 0; + UNC_PATH = 1; + // ABSOLUTE_DRIVE_PATH = 2; + // RELATIVE_DRIVE_PATH = 3; + // ABSOLUTE_PATH = 4; + // RELATIVE_PATH = 5; + // DEVICE_PATH = 6; + // UNC_DOT_PATH = 7; + +// ================================================================= +// Function prototypes +// ================================================================= + +{$IFNDEF RTDL} +function RtlCreateUnicodeStringFromAsciiz(var destination: UNICODE_STRING; + source: PAnsiChar): Boolean; stdcall; external szNtDll; + +function ZwClose(Handle: THandle): NTSTATUS; stdcall; external szNtDll; + +function ZwSetInformationFile(FileHandle: THandle; var IoStatusBlock: IO_STATUS_BLOCK; + FileInformation: Pointer; FileInformationLength: ULONG; + FileInformationClass: DWORD): NTSTATUS; stdcall; external szNtDll; + +function RtlPrefixUnicodeString(const usPrefix: UNICODE_STRING; + const usContainingString: UNICODE_STRING; + ignore_case: Boolean): Boolean; stdcall; external szNtDll; + +function ZwOpenSymbolicLinkObject(var LinkHandle: THandle; DesiredAccess: DWORD; + const ObjectAttributes: OBJECT_ATTRIBUTES): NTSTATUS; stdcall; external szNtDll; + +function ZwQuerySymbolicLinkObject(LinkHandle: THandle; + var LinkTarget: UNICODE_STRING; ReturnedLength: PULONG): NTSTATUS; stdcall; external szNtDll; + +function ZwOpenFile(var FileHandle: THandle; DesiredAccess: DWORD; + const ObjectAttributes: OBJECT_ATTRIBUTES; var IoStatusBlock: IO_STATUS_BLOCK; + ShareAccess: ULONG; OpenOptions: ULONG): NTSTATUS; stdcall; external szNtDll; + +function GetProcessHeap: Pointer; stdcall; external szKernel32; + +function RtlAllocateHeap(HeapHandle: Pointer; + Flags, Size: ULONG): Pointer; stdcall; external szNtDll; + +function RtlFreeHeap(HeapHandle: Pointer; Flags: ULONG; + MemoryPointer: Pointer): Boolean; stdcall; external szNtDll; + +function RtlDosPathNameToNtPathName_U(DosName: PWideChar; + var NtName: UNICODE_STRING; DosFilePath: PPWideChar; + NtFilePath: PUNICODE_STRING): Boolean; stdcall; external szNtDll; + +function RtlInitUnicodeString(var DestinationString: UNICODE_STRING; + const SourceString: PWideChar): NTSTATUS; stdcall; external szNtDll; + +function RtlDetermineDosPathNameType_U(wcsPathNameType: PWideChar): DWORD; stdcall; external szNtDll; + +function RtlNtStatusToDosError(status: NTSTATUS): ULONG; stdcall; external szNtDll; + +{$ELSE RTDL} + +type + TRtlCreateUnicodeStringFromAsciiz = function(var destination: UNICODE_STRING; + source: PAnsiChar): Boolean; stdcall; + + TZwClose = function(Handle: THandle): NTSTATUS; stdcall; + + TZwSetInformationFile = function(FileHandle: THandle; + var IoStatusBlock: IO_STATUS_BLOCK; FileInformation: Pointer; + FileInformationLength: ULONG; FileInformationClass: DWORD): NTSTATUS; stdcall; + + TRtlPrefixUnicodeString = function(const usPrefix: UNICODE_STRING; + const usContainingString: UNICODE_STRING; ignore_case: Boolean): Boolean; stdcall; + + TZwOpenSymbolicLinkObject = function(var LinkHandle: THandle; + DesiredAccess: DWORD; const ObjectAttributes: OBJECT_ATTRIBUTES): NTSTATUS; stdcall; + + TZwQuerySymbolicLinkObject = function(LinkHandle: THandle; + var LinkTarget: UNICODE_STRING; ReturnedLength: PULONG): NTSTATUS; stdcall; + + TZwOpenFile = function(var FileHandle: THandle; DesiredAccess: DWORD; + const ObjectAttributes: OBJECT_ATTRIBUTES; var IoStatusBlock: IO_STATUS_BLOCK; + ShareAccess: ULONG; OpenOptions: ULONG): NTSTATUS; stdcall; + + TGetProcessHeap = function: Pointer; stdcall; + + TRtlAllocateHeap = function(HeapHandle: Pointer; Flags, Size: ULONG): Pointer; stdcall; + + TRtlFreeHeap = function(HeapHandle: Pointer; Flags: ULONG; + MemoryPointer: Pointer): Boolean; stdcall; + + TRtlDosPathNameToNtPathName_U = function(DosName: PWideChar; + var NtName: UNICODE_STRING; DosFilePath: PPWideChar; + NtFilePath: PUNICODE_STRING): Boolean; stdcall; + + TRtlInitUnicodeString = function(var DestinationString: UNICODE_STRING; + const SourceString: PWideChar): NTSTATUS; stdcall; + + TRtlDetermineDosPathNameType_U = function(wcsPathNameType: PWideChar): DWORD; stdcall; + + TRtlNtStatusToDosError = function(status: NTSTATUS): ULONG; stdcall; + +// Declare all the _global_ function pointers for RTDL +var + RtlCreateUnicodeStringFromAsciiz: TRtlCreateUnicodeStringFromAsciiz = nil; + ZwClose: TZwClose = nil; + ZwSetInformationFile: TZwSetInformationFile = nil; + RtlPrefixUnicodeString: TRtlPrefixUnicodeString = nil; + ZwOpenSymbolicLinkObject: TZwOpenSymbolicLinkObject = nil; + ZwQuerySymbolicLinkObject: TZwQuerySymbolicLinkObject = nil; + ZwOpenFile: TZwOpenFile = nil; + GetProcessHeap: TGetProcessHeap = nil; + RtlAllocateHeap: TRtlAllocateHeap = nil; + RtlFreeHeap: TRtlFreeHeap = nil; + RtlDosPathNameToNtPathName_U: TRtlDosPathNameToNtPathName_U = nil; + RtlInitUnicodeString: TRtlInitUnicodeString = nil; + RtlDetermineDosPathNameType_U: TRtlDetermineDosPathNameType_U = nil; + RtlNtStatusToDosError: TRtlNtStatusToDosError = nil; +{$ENDIF RTDL} + +(****************************************************************************** + + Syntax: + ------- + C-Prototype! (if STDCALL enabled) + + BOOL WINAPI CreateHardLink( + LPCTSTR lpFileName, + LPCTSTR lpExistingFileName, + LPSECURITY_ATTRIBUTES lpSecurityAttributes // Reserved; Must be NULL! + + Compatibility: + -------------- + The function can only work on file systems that support hardlinks through the + underlying FS driver layer. Currently this only includes NTFS on the NT + platform (as far as I know). + The function works fine on Windows NT4/2000/XP and is considered to work on + future Operating System versions derived from NT (including Windows 2003). + + Remarks: + -------- + This function tries to resemble the original CreateHardLinkW() call from + Windows 2000/XP/2003 Kernel32.DLL as close as possible. This is why many + functions used are NT Native API, whereas one could use Delphi or Win32 API + functions (e.g. memory management). BUT I included much more SEH code and + omitted extra code to free buffers and close handles. This all is done during + the FINALLY block (so there are no memory leaks anyway ;). + + Note, that neither Microsoft's code nor mine ignore the Security Descriptor + from the SECURITY_ATTRIBUTES structure. In both cases the security descriptor + is passed on to ZwOpenFile()! + + The limit of 1023 hardlinks to one file is probably related to the system or + NTFS respectively. At least I saw no special hint, why there would be such a + limit - the original CreateHardLink() does not check the number of links! + Thus I consider the limit being the same for the original and my rewrite. + + For the ANSI version of this function see below ... + + Remarks from the Platform SDK: + ------------------------------- + Any directory entry for a file, whether created with CreateFile or + CreateHardLink, is a hard link to the associated file. Additional hard links, + created with the CreateHardLink function, allow you to have multiple directory + entries for a file, that is, multiple hard links to the same file. These may + be different names in the same directory, or they may be the same (or + different) names in different directories. However, all hard links to a file + must be on the same volume. + Because hard links are just directory entries for a file, whenever an + application modifies a file through any hard link, all applications using any + other hard link to the file see the changes. Also, all of the directory + entries are updated if the file changes. For example, if the file's size + changes, all of the hard links to the file will show the new size. + The security descriptor belongs to the file to which the hard link points. + The link itself, being merely a directory entry, has no security descriptor. + Thus, if you change the security descriptor of any hard link, you're actually + changing the underlying file's security descriptor. All hard links that point + to the file will thus allow the newly specified access. There is no way to + give a file different security descriptors on a per-hard-link basis. + This function does not modify the security descriptor of the file to be linked + to, even if security descriptor information is passed in the + lpSecurityAttributes parameter. + Use DeleteFile to delete hard links. You can delete them in any order + regardless of the order in which they were created. + Flags, attributes, access, and sharing as specified in CreateFile operate on + a per-file basis. That is, if you open a file with no sharing allowed, another + application cannot share the file by creating a new hard link to the file. + + CreateHardLink does not work over the network redirector. + + Note that when you create a hard link on NTFS, the file attribute information + in the directory entry is refreshed only when the file is opened or when + GetFileInformationByHandle is called with the handle of the file of interest. + + ******************************************************************************) +function +{$IFNDEF PREFERAPI} + CreateHardLinkW // This name is directly published if PREFERAPI is not defined +{$ELSE PREFERAPI} + MyCreateHardLinkW // ... otherwise this one +{$ENDIF PREFERAPI} + (szLinkName, szLinkTarget: PWideChar; lpSecurityAttributes: PSecurityAttributes): BOOL; +const +// Mask for any DOS style drive path in object manager notation + wcsC_NtName: PWideChar = '\??\C:'; +// Prefix of a mapped path's symbolic link + wcsLanMan: PWideChar = '\Device\LanmanRedirector\'; +// Size required to hold a number of wide characters to compare drive notation + cbC_NtName = $10; // 16 bytes +// Access mask to use for opening - just two bits + dwDesiredAccessHL = DELETE or SYNCHRONIZE; +// OpenOptions for opening of the link target +// The flag FILE_OPEN_REPARSE_POINT has been found by comparison. Probably it carries +// some information wether the file is on the same volume?! + dwOpenOptionsHL = FILE_SYNCHRONOUS_IO_NONALERT or FILE_OPEN_FOR_BACKUP_INTENT or FILE_OPEN_REPARSE_POINT; +// ShareAccess flags + dwShareAccessHL = FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE; +var + usNtName_LinkName, usNtName_LinkTarget: UNICODE_STRING; + usCheckDrive, usSymLinkDrive, usLanMan: UNICODE_STRING; + wcsNtName_LinkTarget, wcsFilePart_LinkTarget: PWideChar; + oaMisc: OBJECT_ATTRIBUTES; + IOStats: IO_STATUS_BLOCK; + hHeap: Pointer; + NeededSize: DWORD; + Status: NTSTATUS; + hLinkTarget, hDrive: THandle; + lpFileLinkInfo: PFILE_LINK_INFORMATION; +begin + Result := False; +{$IFDEF RTDL} + if not bRtdlFunctionsLoaded then + Exit; +{$ENDIF RTDL} + // Get process' heap + hHeap := GetProcessHeap; + {------------------------------------------------------------- + Preliminary parameter checks which do Exit with error code set + --------------------------------------------------------------} + // If any is not assigned ... + if (szLinkName = nil) or (szLinkTarget = nil) then + begin + SetLastError(ERROR_INVALID_PARAMETER); + Exit; + end; + // Determine DOS path type for both link name and target + if (RtlDetermineDosPathNameType_U(szLinkName) = UNC_PATH) or + (RtlDetermineDosPathNameType_U(szLinkTarget) = UNC_PATH) then + begin + SetLastError(ERROR_INVALID_NAME); + Exit; + end; + // Convert the link target into a UNICODE_STRING + usNtName_LinkTarget.Length := 0; + if not RtlDosPathNameToNtPathName_U(szLinkTarget, usNtName_LinkTarget, nil, nil) then + begin + SetLastError(ERROR_PATH_NOT_FOUND); + Exit; + end; + {------------------------ + Actual main functionality + -------------------------} + // Initialise the length members + RtlInitUnicodeString(usNtName_LinkTarget, usNtName_LinkTarget.Buffer); + // Get needed buffer size (in TCHARs) + NeededSize := GetFullPathNameW(szLinkTarget, 0, nil, PWideChar(nil^)); + if NeededSize <> 0 then + begin + // Calculate needed size (in TCHARs) + NeededSize := NeededSize + 1; // times SizeOf(WideChar) + // Freed in FINALLY + wcsNtName_LinkTarget := RtlAllocateHeap(hHeap, HEAP_ZERO_MEMORY, NeededSize * SizeOf(WideChar)); + // If successfully allocated buffer ... + if wcsNtName_LinkTarget <> nil then + try + {---------------------------------------------------- + Preparation of the checking for mapped network drives + -----------------------------------------------------} + // Get the full unicode path name + wcsFilePart_LinkTarget := nil; + if GetFullPathNameW(szLinkTarget, NeededSize, wcsNtName_LinkTarget, wcsFilePart_LinkTarget) <> 0 then + begin + // Allocate memory to check the drive object + usCheckDrive.Buffer := RtlAllocateHeap(hHeap, HEAP_ZERO_MEMORY, cbC_NtName); + // On success ... + if usCheckDrive.Buffer <> nil then + try + // Copy to buffer and set length members + lstrcpynW(usCheckDrive.Buffer, wcsC_NtName, lstrlenW(wcsC_NtName) + 1); + RtlInitUnicodeString(usCheckDrive, usCheckDrive.Buffer); + // Replace drive letter by the drive letter we want + usCheckDrive.Buffer[4] := wcsNtName_LinkTarget[0]; + // Init OBJECT_ATTRIBUTES + oaMisc.Length := SizeOf(oaMisc); + oaMisc.RootDirectory := 0; + oaMisc.ObjectName := @usCheckDrive; + oaMisc.Attributes := OBJ_CASE_INSENSITIVE; + oaMisc.SecurityDescriptor := nil; + oaMisc.SecurityQualityOfService := nil; + {-------------------------------------------- + Checking for (illegal!) mapped network drives + ---------------------------------------------} + // Open symbolic link object + hDrive := 0; + if ZwOpenSymbolicLinkObject(hDrive, SYMBOLIC_LINK_QUERY, oaMisc) = STATUS_SUCCESS then + try + usSymLinkDrive.Buffer := RtlAllocateHeap(hHeap, HEAP_ZERO_MEMORY, MAX_PATH * SizeOf(WideChar)); + if usSymLinkDrive.Buffer <> nil then + try + // Query the path the symbolic link points to ... + ZwQuerySymbolicLinkObject(hDrive, usSymLinkDrive, nil); + // Initialise the length members + usLanMan.Length := 0; + RtlInitUnicodeString(usLanMan, wcsLanMan); + // The path must not be a mapped drive ... check this! + if not RtlPrefixUnicodeString(usLanMan, usSymLinkDrive, True) then + begin + // Initialise OBJECT_ATTRIBUTES + oaMisc.Length := SizeOf(oaMisc); + oaMisc.RootDirectory := 0; + oaMisc.ObjectName := @usNtName_LinkTarget; + oaMisc.Attributes := OBJ_CASE_INSENSITIVE; + // Set security descriptor in OBJECT_ATTRIBUTES if they were given + if lpSecurityAttributes <> nil then + oaMisc.SecurityDescriptor := lpSecurityAttributes^.lpSecurityDescriptor + else + oaMisc.SecurityDescriptor := nil; + oaMisc.SecurityQualityOfService := nil; + {---------------------- + Opening the target file + -----------------------} + IOStats.Status := 0; + hLinkTarget := 0; + Status := ZwOpenFile(hLinkTarget, dwDesiredAccessHL, oaMisc, + IOStats, dwShareAccessHL, dwOpenOptionsHL); + if Status = STATUS_SUCCESS then + try + // Wow ... target opened ... let's try to + usNtName_LinkName.Length := 0; + if RtlDosPathNameToNtPathName_U(szLinkName, usNtName_LinkName, nil, nil) then + try + // Initialise the length members + RtlInitUnicodeString(usNtName_LinkName, usNtName_LinkName.Buffer); + // Now almost everything is done to create a link! + NeededSize := usNtName_LinkName.Length + + SizeOf(FILE_LINK_INFORMATION) + SizeOf(WideChar); + lpFileLinkInfo := RtlAllocateHeap(hHeap, HEAP_ZERO_MEMORY, NeededSize); + if lpFileLinkInfo <> nil then + try + lpFileLinkInfo^.ReplaceIfExists := False; + lpFileLinkInfo^.RootDirectory := 0; + lpFileLinkInfo^.FileNameLength := usNtName_LinkName.Length; + lstrcpynW(lpFileLinkInfo.FileName, usNtName_LinkName.Buffer, + usNtName_LinkName.Length); + {---------------------------------------------------- + Final creation of the link - "center" of the function + -----------------------------------------------------} + // Hard-link the file as intended + Status := ZwSetInformationFile(hLinkTarget, IOStats, + lpFileLinkInfo, NeededSize, FileLinkInformation); + // On success return TRUE + Result := Status >= 0; + finally + // Free the buffer + RtlFreeHeap(hHeap, 0, lpFileLinkInfo); + // Set last error code + SetLastError(RtlNtStatusToDosError(Status)); + end + else // if lpFileLinkInfo <> nil then + SetLastError(ERROR_NOT_ENOUGH_MEMORY); + finally + RtlFreeHeap(hHeap, 0, usNtName_LinkName.Buffer); + end + else // if RtlDosPathNameToNtPathName_U(szLinkName, usNtName_LinkName... + SetLastError(ERROR_INVALID_NAME); + finally + ZwClose(hLinkTarget); + end + else // if Status = STATUS_SUCCESS then + SetLastError(RtlNtStatusToDosError(Status)); + end + else // if not RtlPrefixUnicodeString(usLanMan, usSymLinkDrive, True) then + SetLastError(ERROR_INVALID_NAME); + finally + RtlFreeHeap(hHeap, 0, usSymLinkDrive.Buffer); + end + else // if usSymLinkDrive.Buffer <> nil then + SetLastError(ERROR_NOT_ENOUGH_MEMORY); + finally + ZwClose(hDrive); + end; + finally + RtlFreeHeap(hHeap, 0, usCheckDrive.Buffer); + end + else // if usCheckDrive.Buffer <> nil then + SetLastError(ERROR_NOT_ENOUGH_MEMORY); + end + else // if GetFullPathNameW(szLinkTarget, NeededSize, wcsNtName_LinkTarget... + SetLastError(ERROR_INVALID_NAME); + finally + RtlFreeHeap(hHeap, 0, wcsNtName_LinkTarget); + end + else // if wcsNtName_LinkTarget <> nil then + SetLastError(ERROR_NOT_ENOUGH_MEMORY); + end + else // if NeededSize <> 0 then + SetLastError(ERROR_INVALID_NAME); + // Finally free the buffer + RtlFreeHeap(hHeap, 0, usNtName_LinkTarget.Buffer); +end; + +(****************************************************************************** + Hint: + ----- + For all closer information see the CreateHardLinkW function above. + + Specific to the ANSI-version: + ----------------------------- + The ANSI-Version can be used as if it was used on Windows 2000. This holds + for all supported systems for now. + + ******************************************************************************) + +function +{$IFNDEF PREFERAPI} + CreateHardLinkA // This name is directly published if PREFERAPI is not defined +{$ELSE PREFERAPI} + MyCreateHardLinkA // ... otherwise this one +{$ENDIF PREFERAPI} + (szLinkName, szLinkTarget: PAnsiChar; lpSecurityAttributes: PSecurityAttributes): BOOL; +var + usLinkName: UNICODE_STRING; + usLinkTarget: UNICODE_STRING; + hHeap: Pointer; +begin + Result := False; +{$IFDEF RTDL} + if not bRtdlFunctionsLoaded then + Exit; +{$ENDIF RTDL} + // Get the process' heap + hHeap := GetProcessHeap; + // Create and allocate a UNICODE_STRING from the zero-terminated parameters + usLinkName.Length := 0; + if RtlCreateUnicodeStringFromAsciiz(usLinkName, szLinkName) then + try + usLinkTarget.Length := 0; + if RtlCreateUnicodeStringFromAsciiz(usLinkTarget, szLinkTarget) then + try + // Call the Unicode version + Result := CreateHardLinkW(usLinkName.Buffer, usLinkTarget.Buffer, lpSecurityAttributes); + finally + // free the allocated buffer + RtlFreeHeap(hHeap, 0, usLinkTarget.Buffer); + end; + finally + // free the allocate buffer + RtlFreeHeap(hHeap, 0, usLinkName.Buffer); + end; +end; + +{$IFDEF RTDL} +const +// Names of the functions to import + szRtlCreateUnicodeStringFromAsciiz = 'RtlCreateUnicodeStringFromAsciiz'; + szZwClose = 'ZwClose'; + szZwSetInformationFile = 'ZwSetInformationFile'; + szRtlPrefixUnicodeString = 'RtlPrefixUnicodeString'; + szZwOpenSymbolicLinkObject = 'ZwOpenSymbolicLinkObject'; + szZwQuerySymbolicLinkObject = 'ZwQuerySymbolicLinkObject'; + szZwOpenFile = 'ZwOpenFile'; + szGetProcessHeap = 'GetProcessHeap'; + szRtlAllocateHeap = 'RtlAllocateHeap'; + szRtlFreeHeap = 'RtlFreeHeap'; + szRtlDosPathNameToNtPathName_U = 'RtlDosPathNameToNtPathName_U'; + szRtlInitUnicodeString = 'RtlInitUnicodeString'; + szRtlDetermineDosPathNameType_U = 'RtlDetermineDosPathNameType_U'; + szRtlNtStatusToDosError = 'RtlNtStatusToDosError'; +{$ENDIF RTDL} + +var + hKernel32: THandle = 0; + +initialization + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + + // GetModuleHandle because this DLL is loaded into any Win32 subsystem process anyway + // implicitly. And Delphi cannot create applications for other subsystems without + // major changes in SysInit und System units. + hKernel32 := GetModuleHandle(kernel32); + {$IFDEF PREFERAPI} + // If we prefer the real Windows APIs try to get their addresses + @CreateHardLinkA := GetProcAddress(hKernel32, szCreateHardLinkA); + @CreateHardLinkW := GetProcAddress(hKernel32, szCreateHardLinkW); + // If they could not be retrieved resort to our home-grown version + if not (Assigned(@CreateHardLinkA) and Assigned(@CreateHardLinkW)) then + begin + {$ENDIF PREFERAPI} + + {$IFDEF RTDL} + // GetModuleHandle because this DLL is loaded into any Win32 subsystem process anyway + // implicitly. And Delphi cannot create applications for other subsystems without + // major changes in SysInit und System units. + hNtDll := GetModuleHandle(szNtDll); + if hNtDll <> 0 then + begin + // Get all the function addresses + @RtlCreateUnicodeStringFromAsciiz := GetProcAddress(hNtDll, szRtlCreateUnicodeStringFromAsciiz); + @ZwClose := GetProcAddress(hNtDll, szZwClose); + @ZwSetInformationFile := GetProcAddress(hNtDll, szZwSetInformationFile); + @RtlPrefixUnicodeString := GetProcAddress(hNtDll, szRtlPrefixUnicodeString); + @ZwOpenSymbolicLinkObject := GetProcAddress(hNtDll, szZwOpenSymbolicLinkObject); + @ZwQuerySymbolicLinkObject := GetProcAddress(hNtDll, szZwQuerySymbolicLinkObject); + @ZwOpenFile := GetProcAddress(hNtDll, szZwOpenFile); + @GetProcessHeap := GetProcAddress(hKernel32, szGetProcessHeap); + @RtlAllocateHeap := GetProcAddress(hNtDll, szRtlAllocateHeap); + @RtlFreeHeap := GetProcAddress(hNtDll, szRtlFreeHeap); + @RtlDosPathNameToNtPathName_U := GetProcAddress(hNtDll, szRtlDosPathNameToNtPathName_U); + @RtlInitUnicodeString := GetProcAddress(hNtDll, szRtlInitUnicodeString); + @RtlDetermineDosPathNameType_U := GetProcAddress(hNtDll, szRtlDetermineDosPathNameType_U); + @RtlNtStatusToDosError := GetProcAddress(hNtDll, szRtlNtStatusToDosError); + // Check whether we could retrieve all of them + bRtdlFunctionsLoaded := // Update the "loaded" status + Assigned(@RtlCreateUnicodeStringFromAsciiz) and + Assigned(@ZwClose) and + Assigned(@ZwSetInformationFile) and + Assigned(@RtlPrefixUnicodeString) and + Assigned(@ZwOpenSymbolicLinkObject) and + Assigned(@ZwQuerySymbolicLinkObject) and + Assigned(@ZwOpenFile) and + Assigned(@GetProcessHeap) and + Assigned(@RtlAllocateHeap) and + Assigned(@RtlFreeHeap) and + Assigned(@RtlDosPathNameToNtPathName_U) and + Assigned(@RtlInitUnicodeString) and + Assigned(@RtlDetermineDosPathNameType_U) and + Assigned(@RtlNtStatusToDosError); + end; + {$ENDIF RTDL} + + {$IFDEF PREFERAPI} + @CreateHardLinkA := @MyCreateHardLinkA; + @CreateHardLinkW := @MyCreateHardLinkW; + end; // if not (Assigned(@CreateHardLinkA) and Assigned(@CreateHardLinkW)) then ... + {$ENDIF PREFERAPI} + + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +{$IFNDEF JCL} +//-------------------------------------------------------------------------------------------------- +{$ENDIF ~JCL} + +end. + diff --git a/3rdParty/JCL/source/prototypes/JclAlgorithms.pas b/3rdParty/JCL/source/prototypes/JclAlgorithms.pas new file mode 100644 index 00000000..96e34479 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/JclAlgorithms.pas @@ -0,0 +1,1060 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is Algorithms.pas. } +{ } +{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } +{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } +{ All rights reserved. } +{ } +{ Contributors: } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclAlgorithms; + +{$I jcl.inc} + +{$I containers\JclAlgorithms.int} +{$I containers\JclAlgorithms.imp} +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclBase, JclContainerIntf; + +// Compare functions +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT +{$JPPEXPANDMACRO SIMPLECOMPAREINT(,,)} +*) +{$JPPEXPANDMACRO SIMPLECOMPAREINT(IntegerCompare,,TObject)} + +function AnsiStrSimpleCompareI(const Obj1, Obj2: AnsiString): Integer; +function WideStrSimpleCompareI(const Obj1, Obj2: WideString): Integer; +{$IFDEF SUPPORTS_UNICODE_STRING} +function UnicodeStrSimpleCompareI(const Obj1, Obj2: UnicodeString): Integer; +{$ENDIF SUPPORTS_UNICODE_STRING} +function StrSimpleCompareI(const Obj1, Obj2: string): Integer; + +// Compare functions for equality +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT +{$JPPEXPANDMACRO SIMPLEEQUALITYCOMPAREINT(,,)} +*) +function AnsiStrSimpleEqualityCompareI(const Obj1, Obj2: AnsiString): Boolean; +function WideStrSimpleEqualityCompareI(const Obj1, Obj2: WideString): Boolean; +{$IFDEF SUPPORTS_UNICODE_STRING} +function UnicodeStrSimpleEqualityCompareI(const Obj1, Obj2: UnicodeString): Boolean; +{$ENDIF SUPPORTS_UNICODE_STRING} +function StrSimpleEqualityCompareI(const Obj1, Obj2: string): Boolean; + +// Hash conversion functions +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT +{$JPPEXPANDMACRO SIMPLEHASHCONVERTINT(,,,)} +*) +function AnsiStrSimpleHashConvertI(const AString: AnsiString): Integer; +function AnsiStrSimpleHashConvertU(const AString: AnsiString): Integer; +function AnsiStrSimpleHashConvertUI(const AString: AnsiString): Integer; +function WideStrSimpleHashConvertI(const AString: WideString): Integer; +{$IFDEF SUPPORTS_UNICODE_STRING} +function UnicodeStrSimpleHashConvertI(const AString: UnicodeString): Integer; +{$ENDIF SUPPORTS_UNICODE_STRING} +function StrSimpleHashConvertI(const AString: string): Integer; + +type + // Hash Function + // Result must be in 0..Range-1 + TJclHashToRangeFunction = function(Key, Range: Integer): Integer; + +function JclSimpleHashToRange(Key, Range: Integer): Integer; + +// move array algorithms +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO MOVEARRAYINT(,, overload;)} +*) +{$JPPEXPANDMACRO MOVEARRAYINT(MoveArray,TDynSizeIntArray, overload;)} +{$IFNDEF FPC} +{$JPPEXPANDMACRO MOVEARRAYINT(MoveArray,TDynStringArray, overload;)} +{$JPPEXPANDMACRO MOVEARRAYINT(MoveArray,TDynFloatArray, overload;)} +{$ENDIF ~FPC} + +// Iterate algorithms +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO ITERATEINT(,,, overload;)} +*) + +// Apply algorithms +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO APPLYINT(,,, overload;)} +*) + +// Find algorithms +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO FINDINT(,,,,,, overload;)} +{$JPPEXPANDMACRO FINDEQINT(,,,,,, overload;)} +*) + +// CountObject algorithms +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO COUNTOBJECTINT(,,,,,, overload;)} +{$JPPEXPANDMACRO COUNTOBJECTEQINT(,,,,,, overload;)} +*) + +// Copy algorithms +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO COPYINT(,, overload;)} +*) + +// Generate algorithms +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO GENERATEINT(,,,,, overload;)} +*) + +// Fill algorithms +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO FILLINT(,,,,, overload;)} +*) + +// Reverse algorithms +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO REVERSEINT(,, overload;)} +*) + +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO QUICKSORTINT(,,,,, overload;)} +*) + +var + IntfSortProc: TIntfSortProc = QuickSort; + AnsiStrSortProc: TAnsiStrSortProc = QuickSort; + WideStrSortProc: TWideStrSortProc = QuickSort; + {$IFDEF SUPPORTS_UNICODE_STRING} + UnicodeStrSortProc: TUnicodeStrSortProc = QuickSort; + {$ENDIF SUPPORTS_UNICODE_STRING} + SingleSortProc: TSingleSortProc = QuickSort; + DoubleSortProc: TDoubleSortProc = QuickSort; + ExtendedSortProc: TExtendedSortProc = QuickSort; + IntegerSortProc: TIntegerSortProc = QuickSort; + CardinalSortProc: TCardinalSortProc = QuickSort; + Int64SortProc: TInt64SortProc = QuickSort; + PtrSortProc: TPtrSortProc = QuickSort; + SortProc: TSortProc = QuickSort; + +// Sort algorithms +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO SORTINT(,,First,Last,, overload;)} +*) + +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +type + // cannot implement generic global functions + TJclAlgorithms = class + private + //FSortProc: TSortProc; + public + class {$JPPEXPANDMACRO ITERATEINT(Iterate,IJclIterator,TIterateProcedure,)} + class {$JPPEXPANDMACRO APPLYINT(Apply,IJclIterator,TApplyFunction,)} + class {$JPPEXPANDMACRO FINDINT(Find,IJclIterator,const ,AItem,TCompare,T, overload;)} + class {$JPPEXPANDMACRO FINDEQINT(Find,IJclIterator,const ,AItem,TEqualityCompare,T, overload;)} + class {$JPPEXPANDMACRO COUNTOBJECTINT(CountObject,IJclIterator,const ,AItem,TCompare,T, overload;)} + class {$JPPEXPANDMACRO COUNTOBJECTEQINT(CountObject,IJclIterator,const ,AItem,TEqualityCompare,T, overload;)} + class {$JPPEXPANDMACRO COPYINT(Copy,IJclIterator,)} + class {$JPPEXPANDMACRO GENERATEINT(Generate,IJclList,const ,AItem,T,)} + class {$JPPEXPANDMACRO FILLINT(Fill,IJclIterator,const ,AItem,T,)} + class {$JPPEXPANDMACRO REVERSEINT(Reverse,IJclIterator,)} + class {$JPPEXPANDMACRO SORTINT(QuickSort,IJclList,L,R,TCompare,)} + class {$JPPEXPANDMACRO SORTINT(Sort,IJclList,First,Last,TCompare,)} + //class property SortProc: TSortProc read FSortProc write FSortProc; + end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +const + // table of byte permutations without inner loop + BytePermTable: array [Byte] of Byte = + ( 22, 133, 0, 244, 194, 193, 4, 164, 69, 211, 166, 235, 75, 110, 9, 140, + 125, 84, 64, 209, 57, 47, 197, 76, 237, 48, 189, 87, 221, 254, 20, 132, + 25, 162, 203, 225, 186, 165, 72, 228, 61, 208, 158, 185, 114, 173, 1, 66, + 202, 46, 198, 214, 27, 161, 178, 238, 8, 68, 97, 17, 199, 210, 96, 196, + 85, 240, 233, 71, 232, 142, 148, 70, 184, 152, 90, 206, 139, 182, 34, 101, + 104, 12, 143, 227, 24, 247, 175, 150, 39, 31, 36, 123, 62, 119, 236, 28, + 117, 100, 230, 223, 30, 154, 18, 153, 127, 192, 176, 19, 174, 134, 2, 216, + 218, 91, 45, 7, 128, 138, 126, 40, 16, 54, 207, 181, 11, 137, 60, 191, + 51, 231, 121, 213, 86, 111, 141, 172, 98, 226, 179, 249, 136, 58, 88, 93, + 201, 195, 118, 144, 146, 113, 212, 32, 21, 131, 177, 33, 151, 130, 205, 171, + 92, 251, 168, 29, 156, 124, 224, 200, 3, 187, 105, 52, 239, 147, 82, 94, + 26, 102, 243, 242, 145, 163, 49, 135, 43, 78, 112, 83, 63, 35, 170, 167, + 250, 159, 73, 37, 6, 79, 106, 215, 129, 74, 109, 42, 41, 120, 23, 160, + 107, 180, 103, 77, 53, 169, 89, 149, 44, 38, 81, 246, 188, 67, 15, 80, + 155, 99, 95, 5, 229, 108, 13, 255, 59, 241, 252, 245, 222, 248, 115, 55, + 217, 56, 65, 219, 204, 190, 10, 50, 253, 183, 234, 116, 122, 220, 14, 157); + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + {$IFDEF COMPILER11_UP} + Winapi.Windows, + {$ENDIF COMPILER11_UP} + {$IFDEF HAS_UNIT_ANSISTRINGS} + System.AnsiStrings, + {$ENDIF HAS_UNIT_ANSISTRINGS} + {$IFDEF UNICODE_RTL_DATABASE} + System.Character, + {$ENDIF UNICODE_RTL_DATABASE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF COMPILER11_UP} + Windows, + {$ENDIF COMPILER11_UP} + {$IFDEF HAS_UNIT_ANSISTRINGS} + AnsiStrings, + {$ENDIF HAS_UNIT_ANSISTRINGS} + {$IFDEF UNICODE_RTL_DATABASE} + Character, + {$ENDIF UNICODE_RTL_DATABASE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclAnsiStrings, JclStringConversions, JclUnicode; + +function IntfSimpleCompare(const Obj1, Obj2: IInterface): Integer; +begin + if SizeInt(Obj1) < SizeInt(Obj2) then + Result := -1 + else + if SizeInt(Obj1) > SizeInt(Obj2) then + Result := 1 + else + Result := 0; +end; + +// default is case-sensitive +function AnsiStrSimpleCompare(const Obj1, Obj2: AnsiString): Integer; +begin + Result := CompareStr(Obj1, Obj2); +end; + +// case-insensitive +function AnsiStrSimpleCompareI(const Obj1, Obj2: AnsiString): Integer; +begin + Result := CompareText(Obj1, Obj2); +end; + +// default is case-sensitive +function WideStrSimpleCompare(const Obj1, Obj2: WideString): Integer; +begin + Result := WideCompareStr(Obj1, Obj2); +end; + +// case-insensitive +function WideStrSimpleCompareI(const Obj1, Obj2: WideString): Integer; +begin + Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.WideCompareText(Obj1, Obj2); +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +// default is case-sensitive +function UnicodeStrSimpleCompare(const Obj1, Obj2: UnicodeString): Integer; +begin + Result := CompareStr(Obj1, Obj2); +end; + +// case-insensitive +function UnicodeStrSimpleCompareI(const Obj1, Obj2: UnicodeString): Integer; +begin + Result := CompareText(Obj1, Obj2); +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +function StrSimpleCompare(const Obj1, Obj2: string): Integer; +begin + case SizeOf(Obj1[1]) of + SizeOf(AnsiChar): + Result := CompareStr(Obj1, Obj2); + SizeOf(WideChar): + {$IFDEF SUPPORTS_UNICODE} + Result := CompareStr(Obj1, Obj2); + {$ELSE ~SUPPORTS_UNICODE} + Result := WideCompareStr(Obj1, Obj2); + {$ENDIF ~SUPPORTS_UNICODE} + else + raise EJclOperationNotSupportedError.Create; + end; +end; + +function StrSimpleCompareI(const Obj1, Obj2: string): Integer; +begin + case SizeOf(Obj1[1]) of + SizeOf(AnsiChar): + Result := CompareText(Obj1, Obj2); + SizeOf(WideChar): + {$IFDEF SUPPORTS_UNICODE} + Result := CompareText(Obj1, Obj2); + {$ELSE ~SUPPORTS_UNICODE} + {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.WideCompareText(Obj1, Obj2); + {$ENDIF ~SUPPORTS_UNICODE} + else + raise EJclOperationNotSupportedError.Create; + end; +end; + +function SingleSimpleCompare(const Obj1, Obj2: Single): Integer; +begin + if Obj1 < Obj2 then + Result := -1 + else + if Obj1 > Obj2 then + Result := 1 + else + Result := 0; +end; + +function DoubleSimpleCompare(const Obj1, Obj2: Double): Integer; +begin + if Obj1 < Obj2 then + Result := -1 + else + if Obj1 > Obj2 then + Result := 1 + else + Result := 0; +end; + +function ExtendedSimpleCompare(const Obj1, Obj2: Extended): Integer; +begin + if Obj1 < Obj2 then + Result := -1 + else + if Obj1 > Obj2 then + Result := 1 + else + Result := 0; +end; + +function FloatSimpleCompare(const Obj1, Obj2: Float): Integer; +begin + if Obj1 < Obj2 then + Result := -1 + else + if Obj1 > Obj2 then + Result := 1 + else + Result := 0; +end; + +function IntegerSimpleCompare(Obj1, Obj2: Integer): Integer; +begin + if Obj1 < Obj2 then + Result := -1 + else + if Obj1 > Obj2 then + Result := 1 + else + Result := 0; +end; + +function CardinalSimpleCompare(Obj1, Obj2: Cardinal): Integer; +begin + if Obj1 < Obj2 then + Result := -1 + else + if Obj1 > Obj2 then + Result := 1 + else + Result := 0; +end; + +function Int64SimpleCompare(const Obj1, Obj2: Int64): Integer; +begin + if Obj1 < Obj2 then + Result := -1 + else + if Obj1 > Obj2 then + Result := 1 + else + Result := 0; +end; + +function PtrSimpleCompare(Obj1, Obj2: Pointer): Integer; +begin + if SizeInt(Obj1) < SizeInt(Obj2) then + Result := -1 + else + if SizeInt(Obj1) > SizeInt(Obj2) then + Result := 1 + else + Result := 0; +end; + +function SimpleCompare(Obj1, Obj2: TObject): Integer; +begin + if SizeInt(Obj1) < SizeInt(Obj2) then + Result := -1 + else + if SizeInt(Obj1) > SizeInt(Obj2) then + Result := 1 + else + Result := 0; +end; + +function IntegerCompare(Obj1, Obj2: TObject): Integer; +begin + if SizeInt(Obj1) < SizeInt(Obj2) then + Result := -1 + else + if SizeInt(Obj1) > SizeInt(Obj2) then + Result := 1 + else + Result := 0; +end; + +function IntfSimpleEqualityCompare(const Obj1, Obj2: IInterface): Boolean; +begin + Result := SizeInt(Obj1) = SizeInt(Obj2); +end; + +// default is case-sensitive +function AnsiStrSimpleEqualityCompare(const Obj1, Obj2: AnsiString): Boolean; +begin + Result := CompareStr(Obj1, Obj2) = 0; +end; + +// case-insensitive +function AnsiStrSimpleEqualityCompareI(const Obj1, Obj2: AnsiString): Boolean; +begin + Result := CompareText(Obj1, Obj2) = 0; +end; + +// default is case-sensitive +function WideStrSimpleEqualityCompare(const Obj1, Obj2: WideString): Boolean; +begin + Result := WideCompareStr(Obj1, Obj2) = 0; +end; + +// case-insensitive +function WideStrSimpleEqualityCompareI(const Obj1, Obj2: WideString): Boolean; +begin + Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.WideCompareText(Obj1, Obj2) = 0; +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +// default is case-sensitive +function UnicodeStrSimpleEqualityCompare(const Obj1, Obj2: UnicodeString): Boolean; +begin + Result := CompareStr(Obj1, Obj2) = 0; +end; + +// case-insensitive +function UnicodeStrSimpleEqualityCompareI(const Obj1, Obj2: UnicodeString): Boolean; +begin + Result := CompareText(Obj1, Obj2) = 0; +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +function StrSimpleEqualityCompare(const Obj1, Obj2: string): Boolean; +begin + case SizeOf(Obj1[1]) of + SizeOf(AnsiChar): + Result := CompareStr(Obj1, Obj2) = 0; + SizeOf(WideChar): + Result := WideCompareStr(Obj1, Obj2) = 0; + else + raise EJclOperationNotSupportedError.Create; + end; +end; + +function StrSimpleEqualityCompareI(const Obj1, Obj2: string): Boolean; +begin + case SizeOf(Obj1[1]) of + SizeOf(AnsiChar): + Result := CompareText(Obj1, Obj2) = 0; + SizeOf(WideChar): + Result := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.WideCompareText(Obj1, Obj2) = 0; + else + raise EJclOperationNotSupportedError.Create; + end; +end; + +function SingleSimpleEqualityCompare(const Obj1, Obj2: Single): Boolean; +begin + Result := Obj1 = Obj2; +end; + +function DoubleSimpleEqualityCompare(const Obj1, Obj2: Double): Boolean; +begin + Result := Obj1 = Obj2; +end; + +function ExtendedSimpleEqualityCompare(const Obj1, Obj2: Extended): Boolean; +begin + Result := Obj1 = Obj2; +end; + +function FloatSimpleEqualityCompare(const Obj1, Obj2: Float): Boolean; +begin + Result := Obj1 = Obj2; +end; + +function IntegerSimpleEqualityCompare(Obj1, Obj2: Integer): Boolean; +begin + Result := Obj1 = Obj2; +end; + +function CardinalSimpleEqualityCompare(Obj1, Obj2: Cardinal): Boolean; +begin + Result := Obj1 = Obj2; +end; + +function Int64SimpleEqualityCompare(const Obj1, Obj2: Int64): Boolean; +begin + Result := Obj1 = Obj2; +end; + +function PtrSimpleEqualityCompare(Obj1, Obj2: Pointer): Boolean; +begin + Result := SizeInt(Obj1) = SizeInt(Obj2); +end; + +function SimpleEqualityCompare(Obj1, Obj2: TObject): Boolean; +begin + Result := SizeInt(Obj1) = SizeInt(Obj2); +end; + +function IntfSimpleHashConvert(const AInterface: IInterface): Integer; +begin + {$IFDEF CPU32} + Result := SizeInt(AInterface) and MaxInt; + {$ELSE ~CPU32} + Result := (SizeInt(AInterface) xor (SizeInt(AInterface) shr 32)) and MaxInt; + {$ENDIF ~CPU32} +end; + +// from "Fast Hashing of Variable-Length Text Strings", Peter K. Pearson, 1990 +// http://portal.acm.org/citation.cfm?id=78978 +type + TIntegerHash = packed record + case Byte of + 0: (H1, H2, H3, H4: Byte); + 1: (H: Integer); + 2: (C: UCS4); + end; + +// default is case-sensitive and ISO-encoded +function AnsiStrSimpleHashConvert(const AString: AnsiString): Integer; +var + I: Integer; + C: Byte; + IntegerHash: TIntegerHash; +begin + IntegerHash.H1 := 0; + IntegerHash.H2 := 1; + IntegerHash.H3 := 2; + IntegerHash.H4 := 3; + for I := 1 to Length(AString) do + begin + C := Ord(AString[I]); + IntegerHash.H1 := BytePermTable[IntegerHash.H1 xor C]; + IntegerHash.H2 := BytePermTable[IntegerHash.H2 xor C]; + IntegerHash.H3 := BytePermTable[IntegerHash.H3 xor C]; + IntegerHash.H4 := BytePermTable[IntegerHash.H4 xor C]; + end; + Result := IntegerHash.H and MaxInt; +end; + +// case-insensitive and ISO-encoded +function AnsiStrSimpleHashConvertI(const AString: AnsiString): Integer; +var + I: Integer; + C: Byte; + IntegerHash: TIntegerHash; +begin + IntegerHash.H1 := 0; + IntegerHash.H2 := 1; + IntegerHash.H3 := 2; + IntegerHash.H4 := 3; + for I := 1 to Length(AString) do + begin + C := Ord(JclAnsiStrings.CharUpper(AString[I])); + IntegerHash.H1 := BytePermTable[IntegerHash.H1 xor C]; + IntegerHash.H2 := BytePermTable[IntegerHash.H2 xor C]; + IntegerHash.H3 := BytePermTable[IntegerHash.H3 xor C]; + IntegerHash.H4 := BytePermTable[IntegerHash.H4 xor C]; + end; + Result := IntegerHash.H and MaxInt; +end; + +// case-sensitive and UTF8-encoded +function AnsiStrSimpleHashConvertU(const AString: AnsiString): Integer; +var + I: SizeInt; + C, IntegerHash: TIntegerHash; +begin + IntegerHash.H1 := 0; + IntegerHash.H2 := 1; + IntegerHash.H3 := 2; + IntegerHash.H4 := 3; + I := 1; + while I < Length(AString) do + begin + C.C := UTF8GetNextChar(AString, I); + if I = -1 then + raise EJclUnexpectedEOSequenceError.Create; + IntegerHash.H1 := BytePermTable[IntegerHash.H1 xor C.H1]; + IntegerHash.H2 := BytePermTable[IntegerHash.H2 xor C.H2]; + IntegerHash.H3 := BytePermTable[IntegerHash.H3 xor C.H3]; + IntegerHash.H4 := BytePermTable[IntegerHash.H4 xor C.H4]; + end; + Result := IntegerHash.H and MaxInt; +end; + +// case-insensitive and UTF8-encoded +function AnsiStrSimpleHashConvertUI(const AString: AnsiString): Integer; +var + I: SizeInt; + J: Integer; + C, IntegerHash: TIntegerHash; + CA: TUCS4Array; +begin + IntegerHash.H1 := 0; + IntegerHash.H2 := 1; + IntegerHash.H3 := 2; + IntegerHash.H4 := 3; + I := 1; + {$IFDEF UNICODE_RTL_DATABASE} + SetLength(CA, 1); + {$ELSE ~UNICODE_RTL_DATABASE} + SetLength(CA, 0); + {$ENDIF ~UNICODE_RTL_DATABASE} + while I < Length(AString) do + begin + C.C := UTF8GetNextChar(AString, I); + {$IFDEF UNICODE_RTL_DATABASE} + CA[0] := Ord(TCharacter.ToLower(Chr(C.C))); + {$ELSE ~UNICODE_RTL_DATABASE} + CA := UnicodeCaseFold(C.C); + {$ENDIF ~UNICODE_RTL_DATABASE} + for J := Low(CA) to High(CA) do + begin + C.C := CA[J]; + if I = -1 then + raise EJclUnexpectedEOSequenceError.Create; + IntegerHash.H1 := BytePermTable[IntegerHash.H1 xor C.H1]; + IntegerHash.H2 := BytePermTable[IntegerHash.H2 xor C.H2]; + IntegerHash.H3 := BytePermTable[IntegerHash.H3 xor C.H3]; + IntegerHash.H4 := BytePermTable[IntegerHash.H4 xor C.H4]; + end; + end; + Result := IntegerHash.H and MaxInt; +end; + +// default is case-sensitive +function WideStrSimpleHashConvert(const AString: WideString): Integer; +var + I: SizeInt; + C, IntegerHash: TIntegerHash; +begin + IntegerHash.H1 := 0; + IntegerHash.H2 := 1; + IntegerHash.H3 := 2; + IntegerHash.H4 := 3; + I := 1; + while I < Length(AString) do + begin + C.C := UTF16GetNextChar(AString, I); + if I = -1 then + raise EJclUnexpectedEOSequenceError.Create; + IntegerHash.H1 := BytePermTable[IntegerHash.H1 xor C.H1]; + IntegerHash.H2 := BytePermTable[IntegerHash.H2 xor C.H2]; + IntegerHash.H3 := BytePermTable[IntegerHash.H3 xor C.H3]; + IntegerHash.H4 := BytePermTable[IntegerHash.H4 xor C.H4]; + end; + Result := IntegerHash.H and MaxInt; +end; + +// case-insensitive +function WideStrSimpleHashConvertI(const AString: WideString): Integer; +var + I: SizeInt; + J: Integer; + C, IntegerHash: TIntegerHash; + CA: TUCS4Array; +begin + IntegerHash.H1 := 0; + IntegerHash.H2 := 1; + IntegerHash.H3 := 2; + IntegerHash.H4 := 3; + {$IFDEF UNICODE_RTL_DATABASE} + SetLength(CA, 1); + {$ELSE ~UNICODE_RTL_DATABASE} + SetLength(CA, 0); + {$ENDIF ~UNICODE_RTL_DATABASE} + I := 1; + while I < Length(AString) do + begin + C.C := UTF16GetNextChar(AString, I); + {$IFDEF UNICODE_RTL_DATABASE} + CA[0] := Ord(TCharacter.ToLower(Chr(C.C))); + {$ELSE ~UNICODE_RTL_DATABASE} + CA := UnicodeCaseFold(C.C); + {$ENDIF ~UNICODE_RTL_DATABASE} + for J := Low(CA) to High(CA) do + begin + C.C := CA[J]; + if I = -1 then + raise EJclUnexpectedEOSequenceError.Create; + IntegerHash.H1 := BytePermTable[IntegerHash.H1 xor C.H1]; + IntegerHash.H2 := BytePermTable[IntegerHash.H2 xor C.H2]; + IntegerHash.H3 := BytePermTable[IntegerHash.H3 xor C.H3]; + IntegerHash.H4 := BytePermTable[IntegerHash.H4 xor C.H4]; + end; + end; + Result := IntegerHash.H and MaxInt; +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +// default is case-sensitive +function UnicodeStrSimpleHashConvert(const AString: UnicodeString): Integer; +var + I: SizeInt; + C, IntegerHash: TIntegerHash; +begin + IntegerHash.H1 := 0; + IntegerHash.H2 := 1; + IntegerHash.H3 := 2; + IntegerHash.H4 := 3; + I := 1; + while I < Length(AString) do + begin + C.C := UTF16GetNextChar(AString, I); + if I = -1 then + raise EJclUnexpectedEOSequenceError.Create; + IntegerHash.H1 := BytePermTable[IntegerHash.H1 xor C.H1]; + IntegerHash.H2 := BytePermTable[IntegerHash.H2 xor C.H2]; + IntegerHash.H3 := BytePermTable[IntegerHash.H3 xor C.H3]; + IntegerHash.H4 := BytePermTable[IntegerHash.H4 xor C.H4]; + end; + Result := IntegerHash.H and MaxInt; +end; + +// case-insensitive +function UnicodeStrSimpleHashConvertI(const AString: UnicodeString): Integer; +var + I: SizeInt; + J: Integer; + C, IntegerHash: TIntegerHash; + CA: TUCS4Array; +begin + IntegerHash.H1 := 0; + IntegerHash.H2 := 1; + IntegerHash.H3 := 2; + IntegerHash.H4 := 3; + {$IFDEF UNICODE_RTL_DATABASE} + SetLength(CA, 1); + {$ELSE ~UNICODE_RTL_DATABASE} + SetLength(CA, 0); + {$ENDIF ~UNICODE_RTL_DATABASE} + I := 1; + while I < Length(AString) do + begin + C.C := UTF16GetNextChar(AString, I); + {$IFDEF UNICODE_RTL_DATABASE} + CA[0] := Ord(TCharacter.ToLower(Chr(C.C))); + {$ELSE ~UNICODE_RTL_DATABASE} + CA := UnicodeCaseFold(C.C); + {$ENDIF ~UNICODE_RTL_DATABASE} + for J := Low(CA) to High(CA) do + begin + C.C := CA[J]; + if I = -1 then + raise EJclUnexpectedEOSequenceError.Create; + IntegerHash.H1 := BytePermTable[IntegerHash.H1 xor C.H1]; + IntegerHash.H2 := BytePermTable[IntegerHash.H2 xor C.H2]; + IntegerHash.H3 := BytePermTable[IntegerHash.H3 xor C.H3]; + IntegerHash.H4 := BytePermTable[IntegerHash.H4 xor C.H4]; + end; + end; + Result := IntegerHash.H and MaxInt; +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +function StrSimpleHashConvert(const AString: string): Integer; +begin + {$IFDEF SUPPORTS_UNICODE} + {$IFDEF SUPPORTS_UNICODE_STRING} + Result := UnicodeStrSimpleHashConvert(AString); + {$ELSE ~SUPPORTS_UNICODE_STRING} + Result := WideStrSimpleHashConvert(AString); + {$ENDIF ~SUPPORTS_UNICODE_STRING} + {$ELSE ~SUPPORTS_UNICODE} + Result := AnsiStrSimpleHashConvert(AString); + {$ENDIF ~SUPPORTS_UNICODE} +end; + +function StrSimpleHashConvertI(const AString: string): Integer; +begin + {$IFDEF SUPPORTS_UNICODE} + {$IFDEF SUPPORTS_UNICODE_STRING} + Result := UnicodeStrSimpleHashConvertI(AString); + {$ELSE ~SUPPORTS_UNICODE_STRING} + Result := WideStrSimpleHashConvertI(AString); + {$ENDIF ~SUPPORTS_UNICODE_STRING} + {$ELSE ~SUPPORTS_UNICODE} + Result := AnsiStrSimpleHashConvertI(AString); + {$ENDIF ~SUPPORTS_UNICODE} +end; + +function SingleSimpleHashConvert(const AValue: Single): Integer; +const + A = 0.6180339887; // (sqrt(5) - 1) / 2 +begin + Result := Round(MaxInt * Frac(AValue * A)); +end; + +function DoubleSimpleHashConvert(const AValue: Double): Integer; +const + A = 0.6180339887; // (sqrt(5) - 1) / 2 +begin + Result := Round(MaxInt * Frac(AValue * A)); +end; + +function ExtendedSimpleHashConvert(const AValue: Extended): Integer; +const + A = 0.6180339887; // (sqrt(5) - 1) / 2 +begin + Result := Round(MaxInt * Frac(AValue * A)); +end; + +function FloatSimpleHashConvert(const AValue: Float): Integer; +const + A = 0.6180339887; // (sqrt(5) - 1) / 2 +begin + Result := Round(MaxInt * Frac(AValue * A)); +end; + +function IntegerSimpleHashConvert(AValue: Integer): Integer; +begin + Result := AValue and MaxInt; +end; + +function CardinalSimpleHashConvert(AValue: Cardinal): Integer; +begin + Result := AValue and MaxInt; +end; + +function Int64SimpleHashConvert(const AValue: Int64): Integer; +begin + Result := (AValue xor (AValue shr 32)) and MaxInt; +end; + +function PtrSimpleHashConvert(APtr: Pointer): Integer; +begin + Result := SizeInt(APtr) and MaxInt; +end; + +function SimpleHashConvert(AObject: TObject): Integer; +begin + Result := SizeInt(AObject) and MaxInt; +end; + +function JclSimpleHashToRange(Key, Range: Integer): Integer; +// return a value between 0 and (Range-1) based on integer-hash Key +const + A = 0.6180339887; // (sqrt(5) - 1) / 2 +begin + Result := Trunc(Range * (Frac(Abs(Key * A)))); +end; + +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO MOVEARRAYIMP(,,,, overload;)} + +*) +{$JPPUNDEF GENERIC}{$JPPUNDEF REFCOUNTED}{$JPPDEFINE ZEROINIT}{$JPPEXPANDMACRO MOVEARRAYIMP(MoveArray,TDynSizeIntArray,,, overload;)} + +{$IFNDEF FPC} +{$JPPUNDEF GENERIC}{$JPPDEFINE REFCOUNTED}{$JPPUNDEF ZEROINIT}{$JPPEXPANDMACRO MOVEARRAYIMP(MoveArray,TDynStringArray,,, overload;)} + +{$JPPUNDEF GENERIC}{$JPPUNDEF REFCOUNTED}{$JPPDEFINE ZEROINIT}{$JPPEXPANDMACRO MOVEARRAYIMP(MoveArray,TDynFloatArray,,, overload;)} +{$ENDIF ~FPC} + +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO ITERATEIMP(,,)} + +*) +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO APPLYIMP(,,,)} + +*) +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO FINDIMP(,,,,,)} + +{$JPPEXPANDMACRO FINDEQIMP(,,,,,)} + +*) +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO COUNTOBJECTIMP(,,,,,)} + +{$JPPEXPANDMACRO COUNTOBJECTEQIMP(,,,,,)} + +*) +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO COPYIMP(,,)} + +*) +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO GENERATEIMP(,,,,)} + +*) +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO FILLIMP(,,,,,)} + +*) +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO REVERSEIMP(,,,,)} + +*) +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO QUICKSORTIMP(,,,,,,,)} + +*) +procedure Sort(const AList: IJclIntfList; First, Last: Integer; AComparator: TIntfCompare); +begin + IntfSortProc(AList, First, Last, AComparator); +end; + +procedure Sort(const AList: IJclAnsiStrList; First, Last: Integer; AComparator: TAnsiStrCompare); +begin + AnsiStrSortProc(AList, First, Last, AComparator); +end; + +procedure Sort(const AList: IJclWideStrList; First, Last: Integer; AComparator: TWideStrCompare); +begin + WideStrSortProc(AList, First, Last, AComparator); +end; + +{$IFDEF SUPPORTS_UNICODE_STRING} +procedure Sort(const AList: IJclUnicodeStrList; First, Last: Integer; AComparator: TUnicodeStrCompare); +begin + UnicodeStrSortProc(AList, First, Last, AComparator); +end; +{$ENDIF SUPPORTS_UNICODE_STRING} + +procedure Sort(const AList: IJclSingleList; First, Last: Integer; AComparator: TSingleCompare); +begin + SingleSortProc(AList, First, Last, AComparator); +end; + +procedure Sort(const AList: IJclDoubleList; First, Last: Integer; AComparator: TDoubleCompare); +begin + DoubleSortProc(AList, First, Last, AComparator); +end; + +procedure Sort(const AList: IJclExtendedList; First, Last: Integer; AComparator: TExtendedCompare); +begin + ExtendedSortProc(AList, First, Last, AComparator); +end; + +procedure Sort(const AList: IJclIntegerList; First, Last: Integer; AComparator: TIntegerCompare); +begin + IntegerSortProc(AList, First, Last, AComparator); +end; + +procedure Sort(const AList: IJclCardinalList; First, Last: Integer; AComparator: TCardinalCompare); +begin + CardinalSortProc(AList, First, Last, AComparator); +end; + +procedure Sort(const AList: IJclInt64List; First, Last: Integer; AComparator: TInt64Compare); +begin + Int64SortProc(AList, First, Last, AComparator); +end; + +procedure Sort(const AList: IJclPtrList; First, Last: Integer; AComparator: TPtrCompare); +begin + PtrSortProc(AList, First, Last, AComparator); +end; + +procedure Sort(const AList: IJclList; First, Last: Integer; AComparator: TCompare); +begin + SortProc(AList, First, Last, AComparator); +end; + +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +class {$JPPEXPANDMACRO ITERATEIMP(TJclAlgorithms.Iterate,IJclIterator,TIterateProcedure)} + +class {$JPPEXPANDMACRO APPLYIMP(TJclAlgorithms.Apply,IJclIterator,TApplyFunction,SetItem)} + +class {$JPPEXPANDMACRO FINDIMP(TJclAlgorithms.Find,IJclIterator,const ,AItem,TCompare,T)} + +class {$JPPEXPANDMACRO FINDEQIMP(TJclAlgorithms.Find,IJclIterator,const ,AItem,TEqualityCompare,T)} + +class {$JPPEXPANDMACRO COUNTOBJECTIMP(TJclAlgorithms.CountObject,IJclIterator,const ,AItem,TCompare,T)} + +class {$JPPEXPANDMACRO COUNTOBJECTEQIMP(TJclAlgorithms.CountObject,IJclIterator,const ,AItem,TEqualityCompare,T)} + +class {$JPPEXPANDMACRO COPYIMP(TJclAlgorithms.Copy,IJclIterator,SetItem)} + +class {$JPPEXPANDMACRO GENERATEIMP(TJclAlgorithms.Generate,IJclList,const ,AItem,T)} + +class {$JPPEXPANDMACRO FILLIMP(TJclAlgorithms.Fill,IJclIterator,const ,AItem,T,SetItem)} + +class {$JPPEXPANDMACRO REVERSEIMP(TJclAlgorithms.Reverse,IJclIterator,T,GetItem,SetItem)} + +class {$JPPEXPANDMACRO QUICKSORTIMP(TJclAlgorithms.QuickSort,IJclList,L,R,TCompare,T,GetItem,SetItem)} + +class procedure TJclAlgorithms.Sort(const AList: IJclList; First, Last: Integer; + AComparator: TCompare); +begin + TJclAlgorithms.QuickSort(AList, First, Last, AComparator); +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. \ No newline at end of file diff --git a/3rdParty/JCL/source/prototypes/JclArrayLists.pas b/3rdParty/JCL/source/prototypes/JclArrayLists.pas new file mode 100644 index 00000000..6f8ce42c --- /dev/null +++ b/3rdParty/JCL/source/prototypes/JclArrayLists.pas @@ -0,0 +1,262 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is ArrayList.pas. } +{ } +{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } +{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } +{ All rights reserved. } +{ } +{ Contributors: } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclArrayLists; + +{$I jcl.inc} + +interface + +uses + {$IFDEF HAS_UNITSCOPE} + System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Classes, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclAlgorithms, + JclBase, JclAbstractContainers, JclContainerIntf, JclSynch; +{$I containers\JclContainerCommon.imp} +{$I containers\JclArrayLists.int} +{$I containers\JclArrayLists.imp} +{$I containers\JclAlgorithms.int} +{$I containers\JclAlgorithms.imp} +type + TItrStart = (isFirst, isLast); + +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO JCLARRAYLISTINT(,,,,,,,,,,,,,,,,,,)} + + {$JPPEXPANDMACRO JCLARRAYLISTITRINT(,,,,,,,)} + +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + + TJclArrayIterator = class; + + (*$JPPEXPANDMACRO JCLARRAYLISTINT(TJclArrayList,TJclAbstractContainer,IJclContainer,IJclFlatContainer,IJclCollection,IJclList,IJclArray,IJclIterator,TDynArray,IJclEqualityComparer, IJclItemOwner\,, +protected + type + TDynArray = array of T; + TArrayIterator = TJclArrayIterator; + {$JPPDEFINE GENERIC}{$JPPEXPANDMACRO MOVEARRAYINT(MoveArray,TDynArray,)},,; AOwnsItems: Boolean,const ,AItem,T,GetItem,SetItem)*) + + {$JPPEXPANDMACRO JCLARRAYLISTITRINT(TJclArrayIterator,IJclIterator,TJclArrayList,const ,AItem,T,GetItem,SetItem)} + + // E = External helper to compare items for equality + // GetHashCode is not used + TJclArrayListE = class(TJclArrayList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, IJclItemOwner, IJclEqualityComparer, + IJclCollection, IJclList, IJclArray) + private + FEqualityComparer: IJclEqualityComparer; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AEqualityComparer: IJclEqualityComparer; ACapacity: Integer; AOwnsItems: Boolean); overload; + constructor Create(const AEqualityComparer: IJclEqualityComparer; const ACollection: IJclCollection; AOwnsItems: Boolean); overload; + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + property EqualityComparer: IJclEqualityComparer read FEqualityComparer write FEqualityComparer; + end; + + // F = Function to compare items for equality + TJclArrayListF = class(TJclArrayList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, IJclItemOwner, IJclEqualityComparer, + IJclCollection, IJclList, IJclArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AEqualityCompare: TEqualityCompare; ACapacity: Integer; AOwnsItems: Boolean); overload; + constructor Create(const AEqualityCompare: TEqualityCompare; const ACollection: IJclCollection; AOwnsItems: Boolean); overload; + end; + + // I = Items can compare themselves to others + TJclArrayListI> = class(TJclArrayList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, IJclItemOwner, IJclEqualityComparer, + IJclCollection, IJclList, IJclArray) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +{$IFDEF BCB} +{$IFDEF WIN64} + {$HPPEMIT '#ifdef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #undef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #define JclArrayLists_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT '#endif'} + + {$HPPEMIT END '#ifdef JclArrayLists_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #define MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #undef JclArrayLists_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END '#endif'} +{$ENDIF WIN64} +{$ENDIF BCB} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF SUPPORTNAMESPACES} + System.SysUtils; + {$ELSE} + SysUtils; + {$ENDIF} + +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO JCLARRAYLISTIMP(,,,,,,,,,,,,,,)} + +{$JPPEXPANDMACRO JCLARRAYLISTITRIMP(,,,,,,,)} + +*) +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +{$JPPEXPANDMACRO JCLARRAYLISTIMP(TJclArrayList,; AOwnsItems: Boolean,AOwnsItems,IJclCollection,IJclIterator,TArrayIterator,IJclList,MoveArray,const ,AItem,GetItem,SetItem,FreeItem,T,Default(T))} + +{$JPPDEFINE GENERIC}{$JPPEXPANDMACRO MOVEARRAYIMP(MoveArray,TDynArray,Default(T),TJclArrayList.,)} + +{$JPPEXPANDMACRO JCLARRAYLISTITRIMP(TJclArrayIterator,IJclIterator,TJclArrayList,const ,AItem,T,GetItem,SetItem)} + +//=== { TJclArrayListE } ================================================== + +constructor TJclArrayListE.Create(const AEqualityComparer: IJclEqualityComparer; ACapacity: Integer; + AOwnsItems: Boolean); +begin + inherited Create(ACapacity, AOwnsItems); + FEqualityComparer := AEqualityComparer; +end; + +constructor TJclArrayListE.Create(const AEqualityComparer: IJclEqualityComparer; + const ACollection: IJclCollection; AOwnsItems: Boolean); +begin + inherited Create(ACollection, AOwnsItems); + FEqualityComparer := AEqualityComparer; +end; + +procedure TJclArrayListE.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclArrayListE then + TJclArrayListE(Dest).FEqualityComparer := FEqualityComparer; +end; + +function TJclArrayListE.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclArrayListE.Create(EqualityComparer, FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclArrayListE.ItemsEqual(const A, B: T): Boolean; +begin + if EqualityComparer <> nil then + Result := EqualityComparer.ItemsEqual(A, B) + else + Result := inherited ItemsEqual(A, B); +end; + +//=== { TJclArrayListF } ================================================== + +constructor TJclArrayListF.Create(const AEqualityCompare: TEqualityCompare; + ACapacity: Integer; AOwnsItems: Boolean); +begin + inherited Create(ACapacity, AOwnsItems); + SetEqualityCompare(AEqualityCompare); +end; + +constructor TJclArrayListF.Create(const AEqualityCompare: TEqualityCompare; const ACollection: IJclCollection; + AOwnsItems: Boolean); +begin + inherited Create(ACollection, AOwnsItems); + SetEqualityCompare(AEqualityCompare); +end; + +function TJclArrayListF.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclArrayListF.Create(EqualityCompare, FSize, False); + AssignPropertiesTo(Result); +end; + +//=== { TJclArrayListI } ================================================== + +function TJclArrayListI.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclArrayListI.Create(FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclArrayListI.ItemsEqual(const A, B: T): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + Result := A.Equals(B); +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/prototypes/JclArraySets.pas b/3rdParty/JCL/source/prototypes/JclArraySets.pas new file mode 100644 index 00000000..a27be55e --- /dev/null +++ b/3rdParty/JCL/source/prototypes/JclArraySets.pas @@ -0,0 +1,260 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is ArraySet.pas. } +{ } +{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } +{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } +{ All rights reserved. } +{ } +{ Contributors: } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclArraySets; + +{$I jcl.inc} + +interface + +uses + {$IFDEF HAS_UNITSCOPE} + System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Classes, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF SUPPORTS_GENERICS} + JclAlgorithms, + {$ENDIF SUPPORTS_GENERICS} + JclBase, JclAbstractContainers, JclContainerIntf, JclArrayLists, JclSynch; +{$I containers\JclContainerCommon.imp} +{$I containers\JclArraySets.int} +{$I containers\JclArraySets.imp} +type +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO JCLARRAYSETINT(,,,,,,,,,,,,,,,)} + +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + + (*$JPPEXPANDMACRO JCLARRAYSETINT(TJclArraySet,TJclArrayList,IJclContainer,IJclFlatContainer,IJclCollection,IJclList,IJclArray,IJclSet,IJclEqualityComparer,IJclComparer, IJclItemOwner\,,,,const ,AItem,T)*) + + // E = External helper to compare items + TJclArraySetE = class(TJclArraySet, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, IJclItemOwner, IJclEqualityComparer, IJclComparer, + IJclCollection, IJclList, IJclArray, IJclSet) + private + FComparer: IJclComparer; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AComparer: IJclComparer; ACapacity: Integer; AOwnsItems: Boolean); overload; + constructor Create(const AComparer: IJclComparer; const ACollection: IJclCollection; AOwnsItems: Boolean); overload; + { IJclEqualityComparer } + function ItemsCompare(const A, B: T): Integer; override; + { IJclComparer } + function ItemsEqual(const A, B: T): Boolean; override; + property Comparer: IJclComparer read FComparer write FComparer; + end; + + // F = Function to compare items + TJclArraySetF = class(TJclArraySet, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, IJclItemOwner, IJclEqualityComparer, IJclComparer, + IJclCollection, IJclList, IJclArray, IJclSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const ACompare: TCompare; ACapacity: Integer; AOwnsItems: Boolean); overload; + constructor Create(const ACompare: TCompare; const ACollection: IJclCollection; AOwnsItems: Boolean); overload; + end; + + // I = Items can compare themselves to others + TJclArraySetI> = class(TJclArraySet, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, IJclItemOwner, IJclEqualityComparer, IJclComparer, + IJclCollection, IJclList, IJclArray, IJclSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + { IJclEqualityComparer } + function ItemsCompare(const A, B: T): Integer; override; + { IJclComparer } + function ItemsEqual(const A, B: T): Boolean; override; + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +{$IFDEF BCB} +{$IFDEF WIN64} + {$HPPEMIT '#ifdef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #undef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #define JclArraySets_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT '#endif'} + + {$HPPEMIT END '#ifdef JclArraySets_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #define MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #undef JclArraySets_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END '#endif'} +{$ENDIF WIN64} +{$ENDIF BCB} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO JCLARRAYSETIMP(,,,,,,,)} + +*) +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +{$JPPEXPANDMACRO JCLARRAYSETIMP(TJclArraySet,IJclCollection,IJclIterator,const ,AItem,T,Default(T),GetItem)} + +//=== { TJclArraySetE } =================================================== + +constructor TJclArraySetE.Create(const AComparer: IJclComparer; ACapacity: Integer; AOwnsItems: Boolean); +begin + inherited Create(ACapacity, AOwnsItems); + FComparer := AComparer; +end; + +constructor TJclArraySetE.Create(const AComparer: IJclComparer; const ACollection: IJclCollection; + AOwnsItems: Boolean); +begin + inherited Create(ACollection, AOwnsItems); + FComparer := AComparer; +end; + +procedure TJclArraySetE.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclArraySetE then + TJclArraySetE(Dest).FComparer := Comparer; +end; + +function TJclArraySetE.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclArraySetE.Create(Comparer, Size, False); + AssignPropertiesTo(Result); +end; + +function TJclArraySetE.ItemsCompare(const A, B: T): Integer; +begin + if Comparer <> nil then + Result := Comparer.Compare(A, B) + else + Result := inherited ItemsCompare(A, B); +end; + +function TJclArraySetE.ItemsEqual(const A, B: T): Boolean; +begin + if Comparer <> nil then + Result := Comparer.Compare(A, B) = 0 + else + Result := inherited ItemsEqual(A, B); +end; + +//=== { TJclArraySetF } =================================================== + +constructor TJclArraySetF.Create(const ACompare: TCompare; ACapacity: Integer; AOwnsItems: Boolean); +begin + inherited Create(ACapacity, AOwnsItems); + SetCompare(ACompare); +end; + +constructor TJclArraySetF.Create(const ACompare: TCompare; const ACollection: IJclCollection; + AOwnsItems: Boolean); +begin + inherited Create(ACollection, AOwnsItems); + SetCompare(ACompare); +end; + +function TJclArraySetF.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclArraySetF.Create(Compare, Size, False); + AssignPropertiesTo(Result); +end; + +//=== { TJclArraySetI } =================================================== + +function TJclArraySetI.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclArraySetI.Create(Size, False); + AssignPropertiesTo(Result); +end; + +function TJclArraySetI.ItemsCompare(const A, B: T): Integer; +begin + if Assigned(FCompare) then + Result := FCompare(A, B) + else + Result := A.CompareTo(B); +end; + +function TJclArraySetI.ItemsEqual(const A, B: T): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + Result := A.CompareTo(B) = 0; +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/prototypes/JclBinaryTrees.pas b/3rdParty/JCL/source/prototypes/JclBinaryTrees.pas new file mode 100644 index 00000000..78c510b4 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/JclBinaryTrees.pas @@ -0,0 +1,267 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is BinaryTree.pas. } +{ } +{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } +{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } +{ All rights reserved. } +{ } +{ Contributors: } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclBinaryTrees; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Classes, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclAbstractContainers, JclAlgorithms, JclContainerIntf, JclSynch; +{$I containers\JclContainerCommon.imp} +{$I containers\JclBinaryTrees.imp} +{$I containers\JclBinaryTrees.int} +type + TItrStart = (isFirst, isLast, isRoot); + +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO JCLBINARYTREETYPESINT(,)} + + {$JPPEXPANDMACRO JCLBINARYTREEINT(,,,,,,,,,,,,,,,,,,)} + + {$JPPEXPANDMACRO JCLBINARYTREEITRINT(,,,,,,,,,,,,,,)} + +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + + (*$JPPEXPANDMACRO JCLBINARYTREETYPESINT(TJclBinaryNode,T)*) + + TJclBinaryTreeIterator = class; + TJclPreOrderBinaryTreeIterator = class; + TJclInOrderBinaryTreeIterator = class; + TJclPostOrderBinaryTreeIterator = class; + + (*$JPPEXPANDMACRO JCLBINARYTREEINT(TBinaryNode,TJclBinaryTree,TJclAbstractContainer,IJclContainer,IJclFlatContainer,IJclCollection,IJclTree,IJclIterator,IJclTreeIterator,IJclEqualityComparer,IJclComparer,IJclItemOwner\,, +protected + type + TBinaryNode = TJclBinaryNode; + TPreOrderBinaryTreeIterator = TJclPreOrderBinaryTreeIterator; + TInOrderBinaryTreeIterator = TJclInOrderBinaryTreeIterator; + TPostOrderBinaryTreeIterator = TJclPostOrderBinaryTreeIterator;,,AOwnsItems: Boolean,,const ,AItem,T)*) + + {$JPPEXPANDMACRO JCLBINARYTREEITRINT(TJclBinaryTreeIterator,TJclPreOrderBinaryTreeIterator,TJclInOrderBinaryTreeIterator,TJclPostOrderBinaryTreeIterator,IJclIterator,IJclTreeIterator,IJclBinaryTreeIterator,TJclBinaryTree,IJclEqualityComparer,TJclBinaryNode,const ,AItem,T,GetItem,SetItem)} + + // E = External helper to compare items + TJclBinaryTreeE = class(TJclBinaryTree, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclContainer, IJclItemOwner, IJclEqualityComparer, IJclComparer, + IJclCollection, IJclTree) + private + FComparer: IJclComparer; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AComparer: IJclComparer; AOwnsItems: Boolean); + { IJclComparer } + function ItemsCompare(const A, B: T): Integer; override; + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + property Comparer: IJclComparer read FComparer write FComparer; + end; + + // F = Function to compare items + TJclBinaryTreeF = class(TJclBinaryTree, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclContainer, IJclItemOwner, IJclEqualityComparer, IJclComparer, + IJclCollection, IJclTree) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(ACompare: TCompare; AOwnsItems: Boolean); + end; + + // I = Items can compare themselves to an other + TJclBinaryTreeI> = class(TJclBinaryTree, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclContainer, IJclItemOwner, IJclEqualityComparer, IJclComparer, + IJclCollection, IJclTree) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + { IJclComparer } + function ItemsCompare(const A, B: T): Integer; override; + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +{$IFDEF BCB} +{$IFDEF WIN64} + {$HPPEMIT '#ifdef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #undef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #define JclBinaryTrees_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT '#endif'} + + {$HPPEMIT END '#ifdef JclBinaryTrees_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #define MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #undef JclBinaryTrees_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END '#endif'} +{$ENDIF WIN64} +{$ENDIF BCB} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO JCLBINARYTREEIMP(,,,,,,,,,,,,,,,,)} + +{$JPPEXPANDMACRO JCLBINARYTREEITRIMP(,,,,,,,,,,,,,,)} + +*) + +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +(*$JPPEXPANDMACRO JCLBINARYTREEIMP(TJclBinaryTree,TJclBinaryNode,TPreOrderBinaryTreeIterator,TInOrderBinaryTreeIterator,TPostOrderBinaryTreeIterator,IJclCollection,IJclIterator,IJclTreeIterator,,,AOwnsItems: Boolean,AOwnsItems,const ,AItem,T,Default(T),FreeItem)*) + +{$JPPEXPANDMACRO JCLBINARYTREEITRIMP(TJclBinaryTreeIterator,TJclPreOrderBinaryTreeIterator,TJclInOrderBinaryTreeIterator,TJclPostOrderBinaryTreeIterator,IJclIterator,TJclBinaryTree,IJclEqualityComparer,TJclBinaryNode,const ,AItem,T,Default(T),GetItem,SetItem,FreeItem)} + +//=== { TJclBinaryTreeE } ================================================= + +constructor TJclBinaryTreeE.Create(const AComparer: IJclComparer; AOwnsItems: Boolean); +begin + inherited Create(AOwnsItems); + FComparer := AComparer; +end; + +procedure TJclBinaryTreeE.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclBinaryTreeE then + TJclBinaryTreeE(Dest).FComparer := FComparer; +end; + +function TJclBinaryTreeE.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclBinaryTreeE.Create(Comparer, False); + AssignPropertiesTo(Result); +end; + +function TJclBinaryTreeE.ItemsCompare(const A, B: T): Integer; +begin + if Comparer <> nil then + Result := Comparer.Compare(A, B) + else + Result := inherited ItemsCompare(A, B); +end; + +function TJclBinaryTreeE.ItemsEqual(const A, B: T): Boolean; +begin + if Comparer <> nil then + Result := Comparer.Compare(A, B) = 0 + else + Result := inherited ItemsEqual(A, B); +end; + +//=== { TJclBinaryTreeF } ================================================= + +constructor TJclBinaryTreeF.Create(ACompare: TCompare; AOwnsItems: Boolean); +begin + inherited Create(AOwnsItems); + SetCompare(ACompare); +end; + +function TJclBinaryTreeF.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclBinaryTreeF.Create(Compare, False); + AssignPropertiesTo(Result); +end; + +//=== { TJclBinaryTreeI } ================================================= + +function TJclBinaryTreeI.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclBinaryTreeI.Create(False); + AssignPropertiesTo(Result); +end; + +function TJclBinaryTreeI.ItemsCompare(const A, B: T): Integer; +begin + if Assigned(FCompare) then + Result := FCompare(A, B) + else + Result := A.CompareTo(B); +end; + +function TJclBinaryTreeI.ItemsEqual(const A, B: T): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + Result := A.CompareTo(B) = 0; +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/prototypes/JclContainerIntf.pas b/3rdParty/JCL/source/prototypes/JclContainerIntf.pas new file mode 100644 index 00000000..39f40803 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/JclContainerIntf.pas @@ -0,0 +1,792 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is DCL_intf.pas. } +{ } +{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } +{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } +{ All rights reserved. } +{ } +{ Contributors: } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclContainerIntf; + +{$I jcl.inc} +{$I containers\JclContainerIntf.int} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Classes, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, + JclAnsiStrings, + JclWideStrings; + +{$IFDEF BCB6} +{$DEFINE BUGGY_DEFAULT_INDEXED_PROP} +{$ENDIF BCB6} +{$IFDEF BCB10} +{$DEFINE BUGGY_DEFAULT_INDEXED_PROP} +{$ENDIF BCB10} +{$IFDEF BCB11} +{$DEFINE BUGGY_DEFAULT_INDEXED_PROP} +{$ENDIF BCB11} + +const + DefaultContainerCapacity = 16; + +type + // function pointer types + + // iterate functions Type -> (void) +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO ITERPROCEDURE(,,,)} +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + {$JPPEXPANDMACRO ITERPROCEDURE(TIterateProcedure,const ,AItem,T)} + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + // apply functions Type -> Type +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO APPLYFUNCTION(,,,)} +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + {$JPPEXPANDMACRO APPLYFUNCTION(TApplyFunction,const ,AItem,T)} + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + // comparison functions Type -> Type -> Integer +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO COMPAREFUNCTION(,,)} +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + {$JPPEXPANDMACRO COMPAREFUNCTION(TCompare,const ,T)} + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + // comparison for equality functions Type -> Type -> Boolean +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO EQUALITYCOMPAREFUNCTION(,,)} +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + {$JPPEXPANDMACRO EQUALITYCOMPAREFUNCTION(TEqualityCompare,const ,T)} + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + // hash functions Type -> Integer +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO HASHFUNCTION(,,,)} +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + {$JPPEXPANDMACRO HASHFUNCTION(THashConvert,const ,AItem,T)} + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + IJclLockable = interface + ['{524AD65E-AE1B-4BC6-91C8-8181F0198BA9}'] + procedure ReadLock; + procedure ReadUnlock; + procedure WriteLock; + procedure WriteUnlock; + end; + + IJclAbstractIterator = interface{$IFDEF THREADSAFE}(IJclLockable){$ENDIF THREADSAFE} + ['{1064D0B4-D9FC-475D-88BE-520490013B46}'] + procedure Assign(const Source: IJclAbstractIterator); + procedure AssignTo(const Dest: IJclAbstractIterator); + function GetIteratorReference: TObject; + end; + + IJclBaseContainer = interface{$IFDEF THREADSAFE}(IJclLockable){$ENDIF THREADSAFE} + ['{C517175A-028E-486A-BF27-5EF7FC3101D9}'] + procedure Assign(const Source: IJclBaseContainer); + procedure AssignTo(const Dest: IJclBaseContainer); + function GetAllowDefaultElements: Boolean; + function GetContainerReference: TObject; + function GetDuplicates: TDuplicates; + function GetReadOnly: Boolean; + function GetRemoveSingleElement: Boolean; + function GetReturnDefaultElements: Boolean; + function GetThreadSafe: Boolean; + procedure SetAllowDefaultElements(Value: Boolean); + procedure SetDuplicates(Value: TDuplicates); + procedure SetReadOnly(Value: Boolean); + procedure SetRemoveSingleElement(Value: Boolean); + procedure SetReturnDefaultElements(Value: Boolean); + procedure SetThreadSafe(Value: Boolean); + property AllowDefaultElements: Boolean read GetAllowDefaultElements write SetAllowDefaultElements; + property Duplicates: TDuplicates read GetDuplicates write SetDuplicates; + property ReadOnly: Boolean read GetReadOnly write SetReadOnly; + property RemoveSingleElement: Boolean read GetRemoveSingleElement write SetRemoveSingleElement; + property ReturnDefaultElements: Boolean read GetReturnDefaultElements write SetReturnDefaultElements; + property ThreadSafe: Boolean read GetThreadSafe write SetThreadSafe; + end; + + (*$JPPEXPANDMACRO CONTAINER(IJclIntfContainer,{44F10075-9702-4DCA-9731-D8990F234A74})*) + + (*$JPPEXPANDMACRO FLATCONTAINER(IJclIntfFlatContainer,{15116007-6BB8-4D9D-8249-C2F49D4AB3EA},IJclIntfContainer)*) + + IJclStrBaseContainer = interface(IJclBaseContainer) + ['{9753E1D7-F093-4D5C-8B32-40403F6F700E}'] + function GetCaseSensitive: Boolean; + procedure SetCaseSensitive(Value: Boolean); + property CaseSensitive: Boolean read GetCaseSensitive write SetCaseSensitive; + end; + + TJclAnsiStrEncoding = (seISO, seUTF8); + + IJclAnsiStrContainer = interface(IJclStrBaseContainer) + ['{F8239357-B96F-46F1-A48E-B5DF25B5F1FA}'] + function GetEncoding: TJclAnsiStrEncoding; + procedure SetEncoding(Value: TJclAnsiStrEncoding); + property Encoding: TJclAnsiStrEncoding read GetEncoding write SetEncoding; + end; + + IJclAnsiStrFlatContainer = interface(IJclAnsiStrContainer) + ['{8A45A4D4-6317-4CDF-8314-C3E5CC6899F4}'] + procedure LoadFromStrings(Strings: TJclAnsiStrings); + procedure SaveToStrings(Strings: TJclAnsiStrings); + procedure AppendToStrings(Strings: TJclAnsiStrings); + procedure AppendFromStrings(Strings: TJclAnsiStrings); + function GetAsStrings: TJclAnsiStrings; + function GetAsDelimited(const Separator: AnsiString = AnsiLineBreak): AnsiString; + procedure AppendDelimited(const AString: AnsiString; const Separator: AnsiString = AnsiLineBreak); + procedure LoadDelimited(const AString: AnsiString; const Separator: AnsiString = AnsiLineBreak); + end; + + TJclWideStrEncoding = (seUTF16); + + IJclWideStrContainer = interface(IJclStrBaseContainer) + ['{875E1AC4-CA22-46BC-8999-048E5B9BF11D}'] + function GetEncoding: TJclWideStrEncoding; + procedure SetEncoding(Value: TJclWideStrEncoding); + property Encoding: TJclWideStrEncoding read GetEncoding write SetEncoding; + end; + + IJclWideStrFlatContainer = interface(IJclWideStrContainer) + ['{5B001B93-CA1C-47A8-98B8-451CCB444930}'] + procedure LoadFromStrings(Strings: TJclWideStrings); + procedure SaveToStrings(Strings: TJclWideStrings); + procedure AppendToStrings(Strings: TJclWideStrings); + procedure AppendFromStrings(Strings: TJclWideStrings); + function GetAsStrings: TJclWideStrings; + function GetAsDelimited(const Separator: WideString = WideLineBreak): WideString; + procedure AppendDelimited(const AString: WideString; const Separator: WideString = WideLineBreak); + procedure LoadDelimited(const AString: WideString; const Separator: WideString = WideLineBreak); + end; + + {$IFDEF SUPPORTS_UNICODE_STRING} + IJclUnicodeStrContainer = interface(IJclStrBaseContainer) + ['{619BA29F-5E05-464D-B472-1C8453DBC707}'] + end; + + IJclUnicodeStrFlatContainer = interface(IJclUnicodeStrContainer) + ['{3343D73E-4ADC-458E-8289-A4B83D1479D1}'] + procedure LoadFromStrings(Strings: TJclUnicodeStrings); + procedure SaveToStrings(Strings: TJclUnicodeStrings); + procedure AppendToStrings(Strings: TJclUnicodeStrings); + procedure AppendFromStrings(Strings: TJclUnicodeStrings); + function GetAsStrings: TJclUnicodeStrings; + function GetAsDelimited(const Separator: UnicodeString = WideLineBreak): UnicodeString; + procedure AppendDelimited(const AString: UnicodeString; const Separator: UnicodeString = WideLineBreak); + procedure LoadDelimited(const AString: UnicodeString; const Separator: UnicodeString = WideLineBreak); + end; + {$ENDIF SUPPORTS_UNICODE_STRING} + + {$IFDEF CONTAINER_ANSISTR} + IJclStrContainer = IJclAnsiStrContainer; + IJclStrFlatContainer = IJclAnsiStrFlatContainer; + {$ENDIF CONTAINER_ANSISTR} + {$IFDEF CONTAINER_WIDESTR} + IJclStrContainer = IJclWideStrContainer; + IJclStrFlatContainer = IJclWideStrFlatContainer; + {$ENDIF CONTAINER_WIDESTR} + {$IFDEF CONTAINER_UNICODESTR} + IJclStrContainer = IJclUnicodeStrContainer; + IJclStrFlatContainer = IJclUnicodeStrFlatContainer; + {$ENDIF CONTAINER_UNICODESTR} + + IJclSingleContainer = interface(IJclBaseContainer) + ['{22BE88BD-87D1-4B4D-9FAB-F1B6D555C6A9}'] + function GetPrecision: Single; + procedure SetPrecision(const Value: Single); + property Precision: Single read GetPrecision write SetPrecision; + end; + + (*$JPPEXPANDMACRO FLATCONTAINER(IJclSingleFlatContainer,{F16955E8-94D2-4201-809B-CC2EA39B5FDD},IJclSingleContainer)*) + + IJclDoubleContainer = interface(IJclBaseContainer) + ['{372B9354-DF6D-4CAA-A5A9-C50E1FEE5525}'] + function GetPrecision: Double; + procedure SetPrecision(const Value: Double); + property Precision: Double read GetPrecision write SetPrecision; + end; + + (*$JPPEXPANDMACRO FLATCONTAINER(IJclDoubleFlatContainer,{2F0252CE-7471-45CA-8C8D-FD3925507C00},IJclDoubleContainer)*) + + IJclExtendedContainer = interface(IJclBaseContainer) + ['{431A6482-FD5C-45A7-BE53-339A3CF75AC9}'] + function GetPrecision: Extended; + procedure SetPrecision(const Value: Extended); + property Precision: Extended read GetPrecision write SetPrecision; + end; + + (*$JPPEXPANDMACRO FLATCONTAINER(IJclExtendedFlatContainer,{1D3F48A2-001E-48F7-8A54-B9F4CE837523},IJclExtendedContainer)*) + + {$IFDEF MATH_EXTENDED_PRECISION} + IJclFloatContainer = IJclExtendedContainer; + IJclFloatFlatContainer = IJclExtendedFlatContainer; + {$ENDIF MATH_EXTENDED_PRECISION} + {$IFDEF MATH_DOUBLE_PRECISION} + IJclFloatContainer = IJclDoubleContainer; + IJclFloatFlatContainer = IJclDoubleFlatContainer; + {$ENDIF MATH_DOUBLE_PRECISION} + {$IFDEF MATH_SINGLE_PRECISION} + IJclFloatContainer = IJclSingleContainer; + IJclFloatFlatContainer = IJclSingleFlatContainer; + {$ENDIF MATH_SINGLE_PRECISION} + + (*$JPPEXPANDMACRO CONTAINER(IJclIntegerContainer,{3BAF5447-9835-43A4-9FF3-E5EA7D43A7D1})*) + + (*$JPPEXPANDMACRO FLATCONTAINER(IJclIntegerFlatContainer,{EF4EFCD9-60CB-4525-9D20-18E55291F7CF},IJclIntegerContainer)*) + + (*$JPPEXPANDMACRO CONTAINER(IJclCardinalContainer,{01DF05CF-62E9-46B3-8BC1-2830EEF43644})*) + + (*$JPPEXPANDMACRO FLATCONTAINER(IJclCardinalFlatContainer,{79E48B80-3215-47D0-A1B5-D74C495AC9D1},IJclCardinalContainer)*) + + (*$JPPEXPANDMACRO CONTAINER(IJclInt64Container,{B560B2B6-F8C7-45F0-A5E5-920AA61C1540})*) + + (*$JPPEXPANDMACRO FLATCONTAINER(IJclInt64FlatContainer,{E740B9EF-7342-4CEF-B7FB-96C5267F5738},IJclInt64Container)*) + + (*$JPPEXPANDMACRO CONTAINER(IJclPtrContainer,{E8DD2A85-1E12-4605-B517-7E3121C5624F})*) + + (*$JPPEXPANDMACRO FLATCONTAINER(IJclPtrFlatContainer,{43C41789-DE71-4DA5-B4AC-3F53EB9459CD},IJclPtrContainer)*) + + (*$JPPEXPANDMACRO CONTAINER(IJclContainer,{A9EBED03-4993-426A-8449-30D98DC2AC90})*) + + (*$JPPEXPANDMACRO FLATCONTAINER(IJclFlatContainer,{0A070B6F-54A1-4B3D-A4E4-CFFAE2C7C57B},IJclContainer)*) + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + (*$JPPEXPANDMACRO CONTAINER(IJclContainer,{19599A90-F392-430D-878D-A73E096C04AF})*) + + (*$JPPEXPANDMACRO FLATCONTAINER(IJclFlatContainer,{F562ECFB-98DC-4A82-A806-ED978B9D1667},IJclContainer)*) + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO EQUALITYCOMPARER(,,,,)} + +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + (*$JPPEXPANDMACRO EQUALITYCOMPARER(IJclEqualityComparer,{4AF79AD6-D9F4-424B-BEAA-68857F9222B4},TEqualityCompare,const ,T)*) + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO COMPARER(,,,,)} + +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + (*$JPPEXPANDMACRO COMPARER(IJclComparer,{830AFC8C-AA06-46F5-AABD-8EB46B2A9986},TCompare,const ,T)*) + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO HASHCONVERTER(,,,,,)} + +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + (*$JPPEXPANDMACRO HASHCONVERTER(IJclHashConverter,{300AEA0E-7433-4C3E-99A6-E533212ACF42},THashConvert,const ,AItem,T)*) + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + IJclIntfCloneable = interface + ['{BCF77740-FB60-4306-9BD1-448AADE5FF4E}'] + function IntfClone: IInterface; + end; + + IJclCloneable = interface + ['{D224AE70-2C93-4998-9479-1D513D75F2B2}'] + function ObjectClone: TObject; + end; + + TJclAutoPackStrategy = (apsDisabled, apsAgressive, apsProportional, apsIncremental); + + // parameter signification depends on strategy + // - Disabled = unused (arrays are never packed) + // - Agressive = unused (arrays are always packed) + // - Proportional = ratio of empty slots before the array is packed + // number of empty slots is computed by this formula: Capacity div Parameter + // - Incremental = amount of empty slots before the array is packed + + IJclPackable = interface + ['{03802D2B-E0AB-4300-A777-0B8A2BD993DF}'] + function CalcGrowCapacity(ACapacity, ASize: Integer): Integer; + function GetAutoPackParameter: Integer; + function GetAutoPackStrategy: TJclAutoPackStrategy; + function GetCapacity: Integer; + procedure Pack; // reduce used memory by eliminating empty storage area (force) + procedure SetAutoPackParameter(Value: Integer); + procedure SetAutoPackStrategy(Value: TJclAutoPackStrategy); + procedure SetCapacity(Value: Integer); + property AutoPackParameter: Integer read GetAutoPackParameter write SetAutoPackParameter; + property AutoPackStrategy: TJclAutoPackStrategy read GetAutoPackStrategy write SetAutoPackStrategy; + property Capacity: Integer read GetCapacity write SetCapacity; + end; + + TJclAutoGrowStrategy = (agsDisabled, agsAgressive, agsProportional, agsIncremental); + + // parameter signification depends on strategy + // - Disabled = unused (arrays never grow) + // - Agressive = unused (arrays always grow by 1 element) + // - Proportional = ratio of empty slots to add to the array + // number of empty slots is computed by this formula: Capacity div Parameter + // - Incremental = amount of empty slots to add to the array + + IJclGrowable = interface(IJclPackable) + ['{C71E8586-5688-444C-9BDD-9969D988123B}'] + function CalcPackCapacity(ACapacity, ASize: Integer): Integer; + function GetAutoGrowParameter: Integer; + function GetAutoGrowStrategy: TJclAutoGrowStrategy; + procedure Grow; + procedure SetAutoGrowParameter(Value: Integer); + procedure SetAutoGrowStrategy(Value: TJclAutoGrowStrategy); + property AutoGrowParameter: Integer read GetAutoGrowParameter write SetAutoGrowParameter; + property AutoGrowStrategy: TJclAutoGrowStrategy read GetAutoGrowStrategy write SetAutoGrowStrategy; + end; + +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO RELEASEEVENT(,,)} + + {$JPPEXPANDMACRO OWNER(,,,,,,,,)} + +*) + + IJclKeyOwner = interface + ['{8BE209E6-2F85-44FD-B0CD-A8363C95349A}'] + function FreeKey(var Key: TObject): TObject; + function GetOwnsKeys: Boolean; + property OwnsKeys: Boolean read GetOwnsKeys; + end; + + IJclValueOwner = interface + ['{3BCD98CE-7056-416A-A9E7-AE3AB2A62E54}'] + function FreeValue(var Value: TObject): TObject; + function GetOwnsValues: Boolean; + property OwnsValues: Boolean read GetOwnsValues; + end; + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + + {$JPPEXPANDMACRO RELEASEEVENT(TFreeItemEvent,AItem,T)} + + (*$JPPEXPANDMACRO OWNER(IJclItemOwner,IInterface,{0CC220C1-E705-4B21-9F53-4AD340952165},FreeItem,OnFreeItem,TFreeItemEvent,AItem,T, + + function GetOwnsItems: Boolean; + property OwnsItems: Boolean read GetOwnsItems;)*) + + IJclPairOwner = interface + ['{321C1FF7-AA2E-4229-966A-7EC6417EA16D}'] + function FreeKey(var Key: TKey): TKey; + function FreeValue(var Value: TValue): TValue; + function GetOwnsKeys: Boolean; + function GetOwnsValues: Boolean; + property OwnsKeys: Boolean read GetOwnsKeys; + property OwnsValues: Boolean read GetOwnsValues; + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO ITERATOR(,,,,,,,)} + +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + (*$JPPEXPANDMACRO ITERATOR(IJclIterator,IJclAbstractIterator,{6E8547A4-5B5D-4831-8AE3-9C6D04071B11},const ,AItem,T,GetItem,SetItem)*) + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO TREEITERATOR(,,,,,)} + +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + (*$JPPEXPANDMACRO TREEITERATOR(IJclTreeIterator,IJclIterator,{29A06DA4-D93A-40A5-8581-0FE85BC8384B},const ,AItem,T)*) + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO BINTREEITERATOR(,,,)} + +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + (*$JPPEXPANDMACRO BINTREEITERATOR(IJclBinaryTreeIterator,IJclTreeIterator,{0CF5B0FC-C644-458C-BF48-2E093DAFEC26},T)*) + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO COLLECTION(,,,,,,)} + +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + (*$JPPEXPANDMACRO COLLECTION(IJclCollection,IJclBaseContainer,{67EE8AF3-19B0-4DCA-A730-3C9B261B8EC5},const ,AItem,T,IJclIterator)*) + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO LIST(,,,,,,,,)} + +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + (*$JPPEXPANDMACRO LIST(IJclList,IJclCollection,{3B4BE3D7-8FF7-4163-91DF-3F73AE6935E7},const ,AItem,T,GetItem,SetItem,Items)*) + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + // Pointer functions for sort algorithms +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO SORTPROC(,,)} +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + {$JPPEXPANDMACRO SORTPROC(TSortProc,IJclList,TCompare)} + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO ARRAY(,,,,,,,,)} + +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + (*$JPPEXPANDMACRO ARRAY(IJclArray,IJclList,{38810C13-E35E-428A-B84F-D25FB994BE8E},const ,AItem,T,GetItem,SetItem,Items)*) + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO SET(,,)} + +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + (*$JPPEXPANDMACRO SET(IJclSet,IJclCollection,{0B7CDB90-8588-4260-A54C-D87101C669EA})*) + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + TJclTraverseOrder = (toPreOrder, toOrder, toPostOrder); + +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO TREE(,,,)} + +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + (*$JPPEXPANDMACRO TREE(IJclTree,IJclCollection,{3F963AB5-5A75-41F9-A21B-7E7FB541A459},IJclTreeIterator)*) + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +(*$JPPLOOP ALLMAPINDEX ALLMAPCOUNT + {$JPPEXPANDMACRO MAP(,,,,,,,,)} + +*) + + (*IJclMultiIntfIntfMap = interface(IJclIntfIntfMap) + ['{497775A5-D3F1-49FC-A641-15CC9E77F3D0}'] + function GetValues(const Key: IInterface): IJclIntfIterator; + function Count(const Key: IInterface): Integer; + end;*) + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + IHashable = interface + function GetHashCode: Integer; + end; + + (*$JPPEXPANDMACRO MAP(IJclMap,IJclBaseContainer,{22624C43-4828-4A1E-BDD4-4A7FE59AE135},const ,TKey,IJclSet,const ,TValue,IJclCollection)*) + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO QUEUE(,,,,,)} + +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + (*$JPPEXPANDMACRO QUEUE(IJclQueue,IJclBaseContainer,{16AB909F-2194-46CF-BD89-B4207AC0CAB8},const ,AItem,T)*) + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +(*$JPPLOOP ALLMAPINDEX ALLMAPCOUNT + {$JPPEXPANDMACRO SORTEDMAP(,,,,)} + +*) + + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + (*$JPPEXPANDMACRO SORTEDMAP(IJclSortedMap,IJclMap,{C62B75C4-891B-442E-A5D6-9954E75A5C0C},const ,TKey)*) + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO SORTEDSET(,,,,)} + +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + (*$JPPEXPANDMACRO SORTEDSET(IJclSortedSet,IJclSet,{30F836E3-2FB1-427E-A499-DFAE201633C8},const ,T)*) + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO STACK(,,,,,)} + +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + (*$JPPEXPANDMACRO STACK(IJclStack,IJclBaseContainer,{2F08EAC9-270D-496E-BE10-5E975918A5F2},const ,AItem,T)*) + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + + // Exceptions + EJclContainerError = class(EJclError); + + EJclOutOfBoundsError = class(EJclContainerError) + public + // RsEOutOfBounds + constructor Create; + end; + + EJclNoSuchElementError = class(EJclContainerError) + public + // RsEValueNotFound + constructor Create(const Value: string); + end; + + EJclDuplicateElementError = class(EJclContainerError) + public + // RsEDuplicateElement + constructor Create; + end; + + EJclIllegalArgumentError = class(EJclContainerError) + end; + + EJclNoCollectionError = class(EJclIllegalArgumentError) + public + // RsENoCollection + constructor Create; + end; + + EJclIllegalQueueCapacityError = class(EJclIllegalArgumentError) + public + // RsEIllegalQueueCapacity + constructor Create; + end; + + EJclOperationNotSupportedError = class(EJclContainerError) + public + // RsEOperationNotSupported + constructor Create; + end; + + EJclNoEqualityComparerError = class(EJclContainerError) + public + // RsENoEqualityComparer + constructor Create; + end; + + EJclNoComparerError = class(EJclContainerError) + public + // RsENoComparer + constructor Create; + end; + + EJclNoHashConverterError = class(EJclContainerError) + public + // RsENoHashConverter + constructor Create; + end; + + EJclIllegalStateOperationError = class(EJclContainerError) + public + // RsEIllegalStateOperation + constructor Create; + end; + + EJclAssignError = class(EJclContainerError) + public + // RsEAssignError + constructor Create; + end; + + EJclReadOnlyError = class(EJclContainerError) + public + // RsEReadOnlyError + constructor Create; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclResources; + +//=== { EJclOutOfBoundsError } =============================================== + +constructor EJclOutOfBoundsError.Create; +begin + inherited CreateRes(@RsEOutOfBounds); +end; + +//=== { EJclNoSuchElementError } ============================================= + +constructor EJclNoSuchElementError.Create(const Value: string); +begin + inherited CreateResFmt(@RsEValueNotFound, [Value]); +end; + +//=== { EJclDuplicateElementError } ========================================== + +constructor EJclDuplicateElementError.Create; +begin + inherited CreateRes(@RsEDuplicateElement); +end; + +//=== { EJclIllegalQueueCapacityError } ====================================== + +constructor EJclIllegalQueueCapacityError.Create; +begin + inherited CreateRes(@RsEIllegalQueueCapacity); +end; + +//=== { EJclNoCollectionError } ============================================== + +constructor EJclNoCollectionError.Create; +begin + inherited CreateRes(@RsENoCollection); +end; + +//=== { EJclOperationNotSupportedError } ===================================== + +constructor EJclOperationNotSupportedError.Create; +begin + inherited CreateRes(@RsEOperationNotSupported); +end; + +//=== { EJclIllegalStateOperationError } ===================================== + +constructor EJclIllegalStateOperationError.Create; +begin + inherited CreateRes(@RsEIllegalStateOperation); +end; + +//=== { EJclNoComparerError } ================================================ + +constructor EJclNoComparerError.Create; +begin + inherited CreateRes(@RsENoComparer); +end; + +//=== { EJclNoEqualityComparerError } ======================================== + +constructor EJclNoEqualityComparerError.Create; +begin + inherited CreateRes(@RsENoEqualityComparer); +end; + +//=== { EJclNoHashConverterError } =========================================== + +constructor EJclNoHashConverterError.Create; +begin + inherited CreateRes(@RsENoHashConverter); +end; + +//=== { EJclAssignError } ==================================================== + +constructor EJclAssignError.Create; +begin + inherited CreateRes(@RsEAssignError); +end; + +//=== { EJclReadOnlyError } ================================================== + +constructor EJclReadOnlyError.Create; +begin + inherited CreateRes(@RsEReadOnlyError); +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/prototypes/JclGraphUtils.pas b/3rdParty/JCL/source/prototypes/JclGraphUtils.pas new file mode 100644 index 00000000..c517888a --- /dev/null +++ b/3rdParty/JCL/source/prototypes/JclGraphUtils.pas @@ -0,0 +1,2577 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclGraphUtils.pas. } +{ } +{ The Initial Developers of the Original Code are Pelle F. S. Liljendal and Marcel van Brakel. } +{ Portions created by these individuals are Copyright (C) of these individuals. } +{ All Rights Reserved. } +{ } +{ Contributors: } +{ Jack N.A. Bakker } +{ Mike Lischke } +{ Robert Marquardt (marquardt) } +{ Alexander Radchenko } +{ Robert Rossmair (rrossmair) } +{ Olivier Sannier (obones) } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclGraphUtils; + +interface + +{$I jcl.inc} + +uses + {$IFDEF HAS_UNITSCOPE} + System.Types, Winapi.Windows, System.SysUtils, Vcl.Graphics, + {$ELSE ~HAS_UNITSCOPE} + Types, Windows, SysUtils, Graphics, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclBase; + +type + PColor32 = ^TColor32; + TColor32 = type Longword; + PColor32Array = ^TColor32Array; + TColor32Array = array [0..MaxInt div SizeOf(TColor32) - 1] of TColor32; + PPalette32 = ^TPalette32; + TPalette32 = array [Byte] of TColor32; + TArrayOfColor32 = array of TColor32; + + { Blending Function Prototypes } + TCombineReg = function(X, Y, W: TColor32): TColor32; + TCombineMem = procedure(F: TColor32; var B: TColor32; W: TColor32); + TBlendReg = function(F, B: TColor32): TColor32; + TBlendMem = procedure(F: TColor32; var B: TColor32); + TBlendRegEx = function(F, B, M: TColor32): TColor32; + TBlendMemEx = procedure(F: TColor32; var B: TColor32; M: TColor32); + TBlendLine = procedure(Src, Dst: PColor32; Count: Integer); + TBlendLineEx = procedure(Src, Dst: PColor32; Count: Integer; M: TColor32); + + { Auxiliary structure to support TColor manipulation } + TColorRec = packed record + case Integer of + 0: (Value: Longint); + 1: (Red, Green, Blue: Byte); + 2: (R, G, B, Flag: Byte); + {$IFDEF MSWINDOWS} + 3: (Index: Word); // GetSysColor, PaletteIndex + {$ENDIF MSWINDOWS} + end; + + TColorVector = record + case Integer of + 0: (Coord: array [0..2] of Single); + 1: (R, G, B: Single); + 2: (H, L, S: Single); + end; + + THLSValue = 0..240; + THLSVector = record + Hue: THLSValue; + Luminance: THLSValue; + Saturation: THLSValue; + end; + + {$IFDEF VCL} + TPointArray = array of TPoint; + PPointArray = ^TPointArray; + {$ENDIF VCL} + + { position codes for clipping algorithm } + TClipCode = (ccLeft, ccRight, ccAbove, ccBelow); + TClipCodes = set of TClipCode; + PClipCodes = ^TClipCodes; + +const + { Some predefined color constants } + clBlack32 = TColor32($FF000000); + clDimGray32 = TColor32($FF3F3F3F); + clGray32 = TColor32($FF7F7F7F); + clLightGray32 = TColor32($FFBFBFBF); + clWhite32 = TColor32($FFFFFFFF); + clMaroon32 = TColor32($FF7F0000); + clGreen32 = TColor32($FF007F00); + clOlive32 = TColor32($FF7F7F00); + clNavy32 = TColor32($FF00007F); + clPurple32 = TColor32($FF7F007F); + clTeal32 = TColor32($FF007F7F); + clRed32 = TColor32($FFFF0000); + clLime32 = TColor32($FF00FF00); + clYellow32 = TColor32($FFFFFF00); + clBlue32 = TColor32($FF0000FF); + clFuchsia32 = TColor32($FFFF00FF); + clAqua32 = TColor32($FF00FFFF); + + { Some semi-transparent color constants } + clTrWhite32 = TColor32($7FFFFFFF); + clTrBlack32 = TColor32($7F000000); + clTrRed32 = TColor32($7FFF0000); + clTrGreen32 = TColor32($7F00FF00); + clTrBlue32 = TColor32($7F0000FF); + +procedure EMMS; + +// Dialog Functions +{$IFDEF MSWINDOWS} +function DialogUnitsToPixelsX(const DialogUnits: Word): Word; +function DialogUnitsToPixelsY(const DialogUnits: Word): Word; +function PixelsToDialogUnitsX(const PixelUnits: Word): Word; +function PixelsToDialogUnitsY(const PixelUnits: Word): Word; +{$ENDIF MSWINDOWS} + +// Points +function NullPoint: TPoint; + +function PointAssign(const X, Y: Integer): TPoint; +procedure PointCopy(var Dest: TPoint; const Source: TPoint); +function PointEqual(const P1, P2: TPoint): Boolean; +function PointIsNull(const P: TPoint): Boolean; +procedure PointMove(var P: TPoint; const DeltaX, DeltaY: Integer); + +// Rectangles +function NullRect: TRect; + +function RectAssign(const Left, Top, Right, Bottom: Integer): TRect; +function RectAssignPoints(const TopLeft, BottomRight: TPoint): TRect; +function RectBounds(const Left, Top, Width, Height: Integer): TRect; +function RectCenter(const R: TRect): TPoint; +procedure RectCopy(var Dest: TRect; const Source: TRect); +procedure RectFitToScreen(var R: TRect); { TODO -cHelp : Doc } +procedure RectGrow(var R: TRect; const Delta: Integer); +procedure RectGrowX(var R: TRect; const Delta: Integer); +procedure RectGrowY(var R: TRect; const Delta: Integer); +function RectEqual(const R1, R2: TRect): Boolean; +function RectHeight(const R: TRect): Integer; +function RectIncludesPoint(const R: TRect; const Pt: TPoint): Boolean; +function RectIncludesRect(const R1, R2: TRect): Boolean; +function RectIntersection(const R1, R2: TRect): TRect; +function RectIntersectRect(const R1, R2: TRect): Boolean; +function RectIsEmpty(const R: TRect): Boolean; +function RectIsNull(const R: TRect): Boolean; +function RectIsSquare(const R: TRect): Boolean; +function RectIsValid(const R: TRect): Boolean; +procedure RectMove(var R: TRect; const DeltaX, DeltaY: Integer); +procedure RectMoveTo(var R: TRect; const X, Y: Integer); +procedure RectNormalize(var R: TRect); +function RectsAreValid(R: array of TRect): Boolean; +function RectUnion(const R1, R2: TRect): TRect; +function RectWidth(const R: TRect): Integer; + +// Clipping +function ClipCodes(const X, Y, MinX, MinY, MaxX, MaxY: Float): TClipCodes; overload; +function ClipCodes(const X, Y: Float; const ClipRect: TRect): TClipCodes; overload; +function ClipLine(var X1, Y1, X2, Y2: Integer; const ClipRect: TRect): Boolean; overload; +function ClipLine(var X1, Y1, X2, Y2: Float; const MinX, MinY, MaxX, MaxY: Float; + Codes: PClipCodes = nil): Boolean; overload; +procedure DrawPolyLine(const Canvas: TCanvas; var Points: TPointArray; const ClipRect: TRect); + +// Color +type + EColorConversionError = class(EJclError); + +procedure GetRGBValue(const Color: TColor; out Red, Green, Blue: Byte); +function SetRGBValue(const Red, Green, Blue: Byte): TColor; +function GetColorBlue(const Color: TColor): Byte; +function GetColorFlag(const Color: TColor): Byte; +function GetColorGreen(const Color: TColor): Byte; +function GetColorRed(const Color: TColor): Byte; +function SetColorBlue(const Color: TColor; const Blue: Byte): TColor; +function SetColorFlag(const Color: TColor; const Flag: Byte): TColor; +function SetColorGreen(const Color: TColor; const Green: Byte): TColor; +function SetColorRed(const Color: TColor; const Red: Byte): TColor; + +function BrightColor(const Color: TColor; const Pct: Single): TColor; +function BrightColorChannel(const Channel: Byte; const Pct: Single): Byte; +function DarkColor(const Color: TColor; const Pct: Single): TColor; +function DarkColorChannel(const Channel: Byte; const Pct: Single): Byte; + +procedure CIED65ToCIED50(var X, Y, Z: Extended); +procedure CMYKToBGR(const Source, Target: Pointer; const BitsPerSample: Byte; Count: Cardinal); overload; +procedure CMYKToBGR(const C, M, Y, K, Target: Pointer; const BitsPerSample: Byte; Count: Cardinal); overload; +procedure CIELABToBGR(const Source, Target: Pointer; const Count: Cardinal); overload; +procedure CIELABToBGR(LSource, aSource, bSource: PByte; const Target: Pointer; const Count: Cardinal); overload; +procedure RGBToBGR(const Source, Target: Pointer; const BitsPerSample: Byte; Count: Cardinal); overload; +procedure RGBToBGR(const R, G, B, Target: Pointer; const BitsPerSample: Byte; Count: Cardinal); overload; +procedure RGBAToBGRA(const Source, Target: Pointer; const BitsPerSample: Byte; Count: Cardinal); + +procedure WinColorToOpenGLColor(const Color: TColor; out Red, Green, Blue: Float); +function OpenGLColorToWinColor(const Red, Green, Blue: Float): TColor; + +function Color32(WinColor: TColor): TColor32; overload; +function Color32(const R, G, B: Byte; const A: Byte = $FF): TColor32; overload; +function Color32(const Index: Byte; const Palette: TPalette32): TColor32; overload; +function Gray32(const Intensity: Byte; const Alpha: Byte = $FF): TColor32; +function WinColor(const Color32: TColor32): TColor; + +function RedComponent(const Color32: TColor32): Integer; +function GreenComponent(const Color32: TColor32): Integer; +function BlueComponent(const Color32: TColor32): Integer; +function AlphaComponent(const Color32: TColor32): Integer; + +function Intensity(const R, G, B: Single): Single; overload; +function Intensity(const Color32: TColor32): Integer; overload; + +function SetAlpha(const Color32: TColor32; NewAlpha: Integer): TColor32; + +procedure HLSToRGB(const H, L, S: Single; out R, G, B: Single); overload; +function HLSToRGB(const HLS: TColorVector): TColorVector; overload; +function HLSToRGB(const Hue, Luminance, Saturation: THLSValue): TColorRef; overload; +procedure RGBToHLS(const R, G, B: Single; out H, L, S: Single); overload; +function RGBToHLS(const RGB: TColorVector): TColorVector; overload; +function RGBToHLS(const RGBColor: TColorRef): THLSVector; overload; + +// obsolete; use corresponding HLS aliases instead +//procedure HSLToRGB(const H, S, L: Single; out R, G, B: Single); overload; +//procedure RGBToHSL(const R, G, B: Single; out H, S, L: Single); overload; + +// keep HSL identifier to avoid ambiguity with HLS overload +function HSLToRGB(const H, S, L: Single): TColor32; overload; +procedure RGBToHSL(const RGB: TColor32; out H, S, L: Single); overload; + +{$IFDEF VCL} +function SetBitmapColors(Bmp: TBitmap; const Colors: array of TColor; StartIndex: Integer): Integer; +{$ENDIF VCL} + +// Misc +function ColorToHTML(const Color: TColor): string; + +// Petr Vones +{$IFDEF VCL} +function DottedLineTo(const Canvas: TCanvas; const X, Y: Integer): Boolean; overload; +{$ENDIF VCL} +{$IFDEF MSWINDOWS} +function ShortenString(const DC: HDC; const S: WideString; const Width: Integer; const RTL: Boolean; + EllipsisWidth: Integer = 0): WideString; +{$ENDIF MSWINDOWS} + +var + { Blending Function Variables } + CombineReg: TCombineReg; + CombineMem: TCombineMem; + + BlendReg: TBlendReg; + BlendMem: TBlendMem; + + BlendRegEx: TBlendRegEx; + BlendMemEx: TBlendMemEx; + + BlendLine: TBlendLine; + BlendLineEx: TBlendLineEx; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\vcl'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.Classes, Vcl.Consts, System.Math, + {$ELSE ~HAS_UNITSCOPE} + Classes, Math, + {$IFDEF FPC} + RTLConsts, + {$ELSE ~FPC} + Consts, + {$ENDIF ~FPC} + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF HAS_UNIT_SYSTEM_UITYPES} + System.UITypes, + {$ENDIF HAS_UNIT_SYSTEM_UITYPES} + JclVclResources, JclSysInfo, JclLogic; + +type + // resampling support types + TRGBInt = record + R: Integer; + G: Integer; + B: Integer; + end; + + PRGBWord = ^TRGBWord; + TRGBWord = record + R: Word; + G: Word; + B: Word; + end; + + PRGBAWord = ^TRGBAWord; + TRGBAWord = record + R: Word; + G: Word; + B: Word; + A: Word; + end; + + PBGR = ^TBGR; + TBGR = packed record + B: Byte; + G: Byte; + R: Byte; + end; + + PBGRA = ^TBGRA; + TBGRA = packed record + B: Byte; + G: Byte; + R: Byte; + A: Byte; + end; + + PRGB = ^TRGB; + TRGB = packed record + R: Byte; + G: Byte; + B: Byte; + end; + + PRGBA = ^TRGBA; + TRGBA = packed record + R: Byte; + G: Byte; + B: Byte; + A: Byte; + end; + +const + { Component masks } + _R = TColor32($00FF0000); + _G = TColor32($0000FF00); + _B = TColor32($000000FF); + _RGB = TColor32($00FFFFFF); + Bias = $00800080; + +var + MMX_ACTIVE: Boolean; + +{$IFDEF VCL} + +procedure OutOfResources; +begin + raise EOutOfResources.CreateRes(@SOutOfResources); +end; + +procedure GDIError; +var + ErrorCode: Integer; + Buf: array [0..255] of Char; +begin + ErrorCode := GetLastError; + if (ErrorCode <> 0) and (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, + ErrorCode, LOCALE_USER_DEFAULT, Buf, Length(Buf), nil) <> 0) then + raise EOutOfResources.Create(Buf) + else + OutOfResources; +end; + +function GDICheck(Value: Integer): Integer; +begin + if Value = 0 then GDIError; + Result := Value; +end; + +{$ENDIF VCL} + +//=== Internal LowLevel ====================================================== + +function ColorSwap(WinColor: TColor): TColor32; +// this function swaps R and B bytes in ABGR and writes $FF into A component +begin + Result := $FF000000 or // A component + TColor32((WinColor and $0000FF) shl 16) or // R component + TColor32( WinColor and $00FF00) or // G component + TColor32((WinColor and $FF0000) shr 16); // B component +end; + +//=== Blending routines ====================================================== + +function _CombineReg(X, Y, W: TColor32): TColor32; +begin + // combine RGBA channels of colors X and Y with the weight of X given in W + // Result Z = W * X + (1 - W) * Y (all channels are combined, including alpha) + + if W = 0 then + Result := Y //May be if W <= 0 ??? + else + if W = $FF then Result := X //May be if W >= $FF ??? Or if W > $FF ??? + else + begin + Result := + (((((X shr 8 {00Xa00Xg}) and $00FF00FF {00X100X2}) * W {P1**P2**}) + + Bias) and $FF00FF00 {P100P200}) {Pa00Pg00} or + (((((X {00Xr00Xb} and $00FF00FF {00X100X2}) * W {P1**P2**}) + Bias) and + $FF00FF00 {P100P200}) shr 8 {00Pr00Pb}) {PaPrPgPb}; + + W := W xor $FF; // W := 1 - W; + //W := $100 - W; // May be so ??? + + Result := Result {PaPrPgPb} + ( + (((((Y shr 8 {00Ya00Yg}) and $00FF00FF {00X100X2}) * W {P1**P2**}) + + Bias) and $FF00FF00 {P100P200}) {Qa00Qg00} or + (((((Y {00Yr00Yb} and $00FF00FF {00X100X2}) * W {P1**P2**}) + Bias) and + $FF00FF00 {P100P200}) shr 8 {00Qr00Qb}) {QaQrQgQb} + ) {ZaZrZgZb}; + end; +end; + +procedure _CombineMem(F: TColor32; var B: TColor32; W: TColor32); +begin + B := _CombineReg(F, B, W); +end; + +function _BlendReg(F, B: TColor32): TColor32; +begin + Result := _CombineReg(F, B, F shr 24); +end; + +procedure _BlendMem(F: TColor32; var B: TColor32); +begin + B := _CombineReg(F, B, F shr 24); +end; + +function _BlendRegEx(F, B, M: TColor32): TColor32; +begin + Result := _CombineReg(F, B, ((F shr 24) * M) shr 8); +end; + +procedure _BlendMemEx(F: TColor32; var B: TColor32; M: TColor32); +begin + B := _CombineReg(F, B, ((F shr 24) * M) shr 8); +end; + + +{$IFDEF DELPHI64_TEMPORARY} +procedure _BlendLine(Src, Dst: PColor32; Count: Integer); +begin + System.Error(rePlatformNotImplemented); +end; +{$ELSE ~DELPHI64_TEMPORARY} +procedure _BlendLine(Src, Dst: PColor32; Count: Integer); assembler; +asm + {$IFDEF CPU32} + // EAX <- Src + // EDX <- Dst + // ECX <- Count + + // test the counter for zero or negativity + TEST ECX, ECX + JS @4 + + PUSH EBX + PUSH ESI + PUSH EDI + + MOV ESI, EAX // ESI <- Src + MOV EDI, EDX // EDI <- Dst + + // loop start +@1: MOV EAX, [ESI] + TEST EAX, $FF000000 + JZ @3 // complete transparency, proceed to next point + + PUSH ECX // store counter + + // Get weight W = Fa * M + MOV ECX, EAX // ECX <- Fa Fr Fg Fb + SHR ECX, 24 // ECX <- 00 00 00 Fa + + // Test Fa = 255 ? + CMP ECX, $FF + JZ @2 + + // P = W * F + MOV EBX, EAX // EBX <- Fa Fr Fg Fb + AND EAX, $00FF00FF // EAX <- 00 Fr 00 Fb + AND EBX, $FF00FF00 // EBX <- Fa 00 Fg 00 + IMUL EAX, ECX // EAX <- Pr ** Pb ** + SHR EBX, 8 // EBX <- 00 Fa 00 Fg + IMUL EBX, ECX // EBX <- Pa ** Pg ** + ADD EAX, Bias + AND EAX, $FF00FF00 // EAX <- Pr 00 Pb 00 + SHR EAX, 8 // EAX <- 00 Pr ** Pb + ADD EBX, Bias + AND EBX, $FF00FF00 // EBX <- Pa 00 Pg 00 + OR EAX, EBX // EAX <- Pa Pr Pg Pb + + // W = 1 - W; Q = W * B + MOV EDX, [EDI] + XOR ECX, $000000FF // ECX <- 1 - ECX + MOV EBX, EDX // EBX <- Ba Br Bg Bb + AND EDX, $00FF00FF // ESI <- 00 Br 00 Bb + AND EBX, $FF00FF00 // EBX <- Ba 00 Bg 00 + IMUL EDX, ECX // ESI <- Qr ** Qb ** + SHR EBX, 8 // EBX <- 00 Ba 00 Bg + IMUL EBX, ECX // EBX <- Qa ** Qg ** + ADD EDX, Bias + AND EDX, $FF00FF00 // ESI <- Qr 00 Qb 00 + SHR EDX, 8 // ESI <- 00 Qr ** Qb + ADD EBX, Bias + AND EBX, $FF00FF00 // EBX <- Qa 00 Qg 00 + OR EBX, EDX // EBX <- Qa Qr Qg Qb + + // Z = P + Q (assuming no overflow at each byte) + ADD EAX, EBX // EAX <- Za Zr Zg Zb +@2: MOV [EDI], EAX + + POP ECX // restore counter + +@3: ADD ESI, 4 + ADD EDI, 4 + + // loop end + DEC ECX + JNZ @1 + + POP EDI + POP ESI + POP EBX + +@4: RET + {$ENDIF CPU32} + {$IFDEF CPU64} + TODO + {$ENDIF CPU64} +end; +{$ENDIF ~DELPHI64_TEMPORARY} + +procedure _BlendLineEx(Src, Dst: PColor32; Count: Integer; M: TColor32); +begin + while Count > 0 do + begin + _BlendMemEx(Src^, Dst^, M); + Inc(Src); + Inc(Dst); + Dec(Count); + end; +end; + +{ MMX versions } + +var + AlphaTable: Pointer; + bias_ptr: Pointer; + alpha_ptr: Pointer; + +procedure GenAlphaTable; +var + I: Integer; + L: Longword; + P: ^Longword; +begin + GetMem(AlphaTable, 257 * 8); + if (TJclAddr(AlphaTable) mod 8) <> 0 then + alpha_ptr := Pointer((TJclAddr(AlphaTable) + 8) and (not TJclAddr(7))) + else + alpha_ptr := AlphaTable; + P := alpha_ptr; + for I := 0 to 255 do + begin + L := I + I shl 16; + P^ := L; + Inc(P); + P^ := L; + Inc(P); + end; + bias_ptr := Pointer(TJclAddr(alpha_ptr) + $80 * 8); +end; + +procedure FreeAlphaTable; +begin + FreeMem(AlphaTable); + AlphaTable := nil; +end; + +procedure EMMS; +{$IFNDEF DELPHI64_TEMPORARY} +begin + if MMX_ACTIVE then +{$ENDIF ~DELPHI64_TEMPORARY} + asm + db $0F, $77 // EMMS + end; +{$IFNDEF DELPHI64_TEMPORARY} +end; +{$ENDIF ~DELPHI64_TEMPORARY} + +function M_CombineReg(X, Y, W: TColor32): TColor32; assembler; +asm + {$IFDEF CPU32} + // EAX - Color X + // EDX - Color Y + // ECX - Weight of X [0..255] + // Result := W * (X - Y) + Y + + db $0F, $EF, $C0 // PXOR MM0, MM0 + db $0F, $6E, $C8 // MOVD MM1, EAX + SHL ECX, 3 + db $0F, $6E, $D2 // MOVD MM2, EDX + db $0F, $60, $C8 // PUNPCKLBW MM1, MM0 + db $0F, $60, $D0 // PUNPCKLBW MM2, MM0 + ADD ECX, alpha_ptr + db $0F, $F9, $CA // PSUBW MM1, MM2 + db $0F, $D5, $09 // PMULLW MM1, [ECX] + db $0F, $71, $F2,$08 // PSLLW MM2, 8 + MOV ECX, bias_ptr + db $0F, $FD, $11 // PADDW MM2, [ECX] + db $0F, $FD, $CA // PADDW MM1, MM2 + db $0F, $71, $D1, $08 // PSRLW MM1, 8 + db $0F, $67, $C8 // PACKUSWB MM1, MM0 + db $0F, $7E, $C8 // MOVD EAX, MM1 + {$ENDIF CPU32} + {$IFDEF CPU64} + PXOR MM0, MM0 + MOVD MM1, EAX + SHL RCX, 3 + MOVD MM2, EDX + PUNPCKLBW MM1, MM0 + PUNPCKLBW MM2, MM0 + ADD RCX, alpha_ptr + PSUBW MM1, MM2 + PMULLW MM1, [RCX] + PSLLW MM2, 8 + MOV RCX, bias_ptr + PADDW MM2, [RCX] + PADDW MM1, MM2 + PSRLW MM1, 8 + PACKUSWB MM1, MM0 + MOVD EAX, MM1 + {$ENDIF CPU64} +end; + +procedure M_CombineMem(F: TColor32; var B: TColor32; W: TColor32); +begin + B := M_CombineReg(F, B, W); +end; + +function M_BlendReg(F, B: TColor32): TColor32; assembler; +asm + {$IFDEF CPU32} + // blend foreground color (F) to a background color (B), + // using alpha channel value of F + // EAX <- F + // EDX <- B + // Result := Fa * (Frgb - Brgb) + Brgb + db $0F, $EF, $DB // PXOR MM3, MM3 + db $0F, $6E, $C0 // MOVD MM0, EAX + db $0F, $6E, $D2 // MOVD MM2, EDX + db $0F, $60, $C3 // PUNPCKLBW MM0, MM3 + MOV ECX, bias_ptr + db $0F, $60, $D3 // PUNPCKLBW MM2, MM3 + db $0F, $6F, $C8 // MOVQ MM1, MM0 + db $0F, $69, $C9 // PUNPCKHWD MM1, MM1 + db $0F, $F9, $C2 // PSUBW MM0, MM2 + db $0F, $6A, $C9 // PUNPCKHDQ MM1, MM1 + db $0F, $71, $F2, $08 // PSLLW MM2, 8 + db $0F, $D5, $C1 // PMULLW MM0, MM1 + db $0F, $FD, $11 // PADDW MM2, [ECX] + db $0F, $FD, $D0 // PADDW MM2, MM0 + db $0F, $71, $D2, $08 // PSRLW MM2, 8 + db $0F, $67, $D3 // PACKUSWB MM2, MM3 + db $0F, $7E, $D0 // MOVD EAX, MM2 + {$ENDIF CPU32} + {$IFDEF CPU64} + PXOR MM3, MM3 + MOVD MM0, EAX + MOVD MM2, EDX + PUNPCKLBW MM0, MM3 + MOV RCX, bias_ptr + PUNPCKLBW MM2, MM3 + MOVQ MM1, MM0 + PUNPCKHWD MM1, MM1 + PSUBW MM0, MM2 + PUNPCKHDQ MM1, MM1 + PSLLW MM2, 8 + PMULLW MM0, MM1 + PADDW MM2, [RCX] + PADDW MM2, MM0 + PSRLW MM2, 8 + PACKUSWB MM2, MM3 + MOVD EAX, MM2 + {$ENDIF CPU64} +end; + +procedure M_BlendMem(F: TColor32; var B: TColor32); +begin + B := M_BlendReg(F, B); +end; + +function M_BlendRegEx(F, B, M: TColor32): TColor32; assembler; +asm + {$IFDEF CPU32} + // blend foreground color (F) to a background color (B), + // using alpha channel value of F + // EAX <- F + // EDX <- B + // ECX <- M + // Result := M * Fa * (Frgb - Brgb) + Brgb + PUSH EBX + MOV EBX, EAX + SHR EBX, 24 + IMUL ECX, EBX + SHR ECX, 8 + JZ @1 + + db $0F, $EF, $C0 // PXOR MM0, MM0 + db $0F, $6E, $C8 // MOVD MM1, EAX + SHL ECX, 3 + db $0F, $6E, $D2 // MOVD MM2, EDX + db $0F, $60, $C8 // PUNPCKLBW MM1, MM0 + db $0F, $60, $D0 // PUNPCKLBW MM2, MM0 + ADD ECX, alpha_ptr + db $0F, $F9, $CA // PSUBW MM1, MM2 + db $0F, $D5, $09 // PMULLW MM1, [ECX] + db $0F, $71, $F2, $08 // PSLLW MM2, 8 + MOV ECX, bias_ptr + db $0F, $FD, $11 // PADDW MM2, [ECX] + db $0F, $FD, $CA // PADDW MM1, MM2 + db $0F, $71, $D1, $08 // PSRLW MM1, 8 + db $0F, $67, $C8 // PACKUSWB MM1, MM0 + db $0F, $7E, $C8 // MOVD EAX, MM1 + +@1: MOV EAX, EDX + POP EBX + {$ENDIF CPU32} + {$IFDEF CPU64} + PUSH RBX + MOV RBX, RAX + SHR RBX, 24 + IMUL RCX, RBX + SHR RCX, 8 + JZ @1 + + PXOR MM0, MM0 + MOVD MM1, EAX + SHL RCX, 3 + MOVD MM2, EDX + PUNPCKLBW MM1, MM0 + PUNPCKLBW MM2, MM0 + ADD RCX, alpha_ptr + PSUBW MM1, MM2 + PMULLW MM1, [RCX] + PSLLW MM2, 8 + MOV RCX, bias_ptr + PADDW MM2, [RCX] + PADDW MM1, MM2 + PSRLW MM1, 8 + PACKUSWB MM1, MM0 + MOVD EAX, MM1 + +@1: MOV RAX, RDX + POP RBX + {$ENDIF CPU64} +end; + +procedure M_BlendMemEx(F: TColor32; var B: TColor32; M: TColor32); +begin + B := M_BlendRegEx(F, B, M); +end; + +{$IFDEF DELPHI64_TEMPORARY} +procedure M_BlendLine(Src, Dst: PColor32; Count: Integer); +begin + System.Error(rePlatformNotImplemented); +end; +{$ELSE ~DELPHI64_TEMPORARY} +procedure M_BlendLine(Src, Dst: PColor32; Count: Integer); assembler; +asm + {$IFDEF CPU32} + // EAX <- Src + // EDX <- Dst + // ECX <- Count + + // test the counter for zero or negativity + TEST ECX, ECX + JS @4 + + PUSH ESI + PUSH EDI + + MOV ESI, EAX // ESI <- Src + MOV EDI, EDX // EDI <- Dst + + // loop start +@1: MOV EAX, [ESI] + TEST EAX, $FF000000 + JZ @3 // complete transparency, proceed to next point + CMP EAX, $FF000000 + JNC @2 // opaque pixel, copy without blending + + // blend + db $0F, $EF, $DB // PXOR MM3, MM3 + db $0F, $6E, $C0 // MOVD MM0, EAX + db $0F, $6E, $17 // MOVD MM2, [EDI] + db $0F, $60, $C3 // PUNPCKLBW MM0, MM3 + MOV EAX, bias_ptr + db $0F, $60, $D3 // PUNPCKLBW MM2, MM3 + db $0F, $6F, $C8 // MOVQ MM1, MM0 + db $0F, $69, $C9 // PUNPCKHWD MM1, MM1 + db $0F, $F9, $C2 // PSUBW MM0, MM2 + db $0F, $6A, $C9 // PUNPCKHDQ MM1, MM1 + db $0F, $71, $F2, $08 // PSLLW MM2, 8 + db $0F, $D5, $C1 // PMULLW MM0, MM1 + db $0F, $FD, $10 // PADDW MM2, [EAX] + db $0F, $FD, $D0 // PADDW MM2, MM0 + db $0F, $71, $D2, $08 // PSRLW MM2, 8 + db $0F, $67, $D3 // PACKUSWB MM2, MM3 + db $0F, $7E, $D0 // MOVD EAX, MM2 + +@2: MOV [EDI], EAX + +@3: ADD ESI, 4 + ADD EDI, 4 + + // loop end + DEC ECX + JNZ @1 + + POP EDI + POP ESI + +@4: RET + {$ENDIF CPU32} + {$IFDEF CPU64} + TODO + {$ENDIF CPU64} +end; +{$ENDIF ~DELPHI64_TEMPORARY} + +{$IFDEF DELPHI64_TEMPORARY} +procedure M_BlendLineEx(Src, Dst: PColor32; Count: Integer; M: TColor32); +begin + System.Error(rePlatformNotImplemented); +end; +{$ELSE ~DELPHI64_TEMPORARY} +procedure M_BlendLineEx(Src, Dst: PColor32; Count: Integer; M: TColor32); assembler; +asm + {$IFDEF CPU32} + // EAX <- Src + // EDX <- Dst + // ECX <- Count + + // test the counter for zero or negativity + TEST ECX, ECX + JS @4 + + PUSH ESI + PUSH EDI + PUSH EBX + + MOV ESI, EAX // ESI <- Src + MOV EDI, EDX // EDI <- Dst + MOV EDX, M // EDX <- Master Alpha + + // loop start +@1: MOV EAX, [ESI] + TEST EAX, $FF000000 + JZ @3 // complete transparency, proceed to next point + MOV EBX, EAX + SHR EBX, 24 + IMUL EBX, EDX + SHR EBX, 8 + JZ @3 // complete transparency, proceed to next point + + // blend + db $0F, $EF, $C0 // PXOR MM0, MM0 + db $0F, $6E, $C8 // MOVD MM1, EAX + SHL EBX, 3 + db $0F, $6E, $17 // MOVD MM2, [EDI] + db $0F, $60, $C8 // PUNPCKLBW MM1, MM0 + db $0F, $60, $D0 // PUNPCKLBW MM2, MM0 + ADD EBX, alpha_ptr + db $0F, $F9, $CA // PSUBW MM1, MM2 + db $0F, $D5, $0B // PMULLW MM1, [EBX] + db $0F, $71, $F2, $08 // PSLLW MM2, 8 + MOV EBX, bias_ptr + db $0F, $FD, $13 // PADDW MM2, [EBX] + db $0F, $FD, $CA // PADDW MM1, MM2 + db $0F, $71, $D1, $08 // PSRLW MM1, 8 + db $0F, $67, $C8 // PACKUSWB MM1, MM0 + db $0F, $7E, $C8 // MOVD EAX, MM1 + +@2: MOV [EDI], EAX + +@3: ADD ESI, 4 + ADD EDI, 4 + + // loop end + DEC ECX + JNZ @1 + + POP EBX + POP EDI + POP ESI +@4: + {$ENDIF CPU32} + {$IFDEF CPU64} + TODO + {$ENDIF CPU64} +end; +{$ENDIF ~DELPHI64_TEMPORARY} + +{ MMX Detection and linking } + +procedure SetupFunctions; +var + CpuInfo: TCpuInfo; +begin + //WIMDC + CpuInfo := CPUID; + MMX_ACTIVE := (CpuInfo.Features and MMX_FLAG) = MMX_FLAG; + if MMX_ACTIVE then + begin + // link MMX functions + CombineReg := M_CombineReg; + CombineMem := M_CombineMem; + BlendReg := M_BlendReg; + BlendMem := M_BlendMem; + BlendRegEx := M_BlendRegEx; + BlendMemEx := M_BlendMemEx; + BlendLine := M_BlendLine; + BlendLineEx := M_BlendLineEx; + end + else + begin + // link non-MMX functions + CombineReg := _CombineReg; + CombineMem := _CombineMem; + BlendReg := _BlendReg; + BlendMem := _BlendMem; + BlendRegEx := _BlendRegEx; + BlendMemEx := _BlendMemEx; + BlendLine := _BlendLine; + BlendLineEx := _BlendLineEx; + end; +end; + +//=== Dialog functions ======================================================= + +{$IFDEF MSWINDOWS} +function DialogUnitsToPixelsX(const DialogUnits: Word): Word; +begin + Result := (DialogUnits * LoWord(GetDialogBaseUnits)) div 4; +end; + +function DialogUnitsToPixelsY(const DialogUnits: Word): Word; +begin + Result := (DialogUnits * HiWord(GetDialogBaseUnits)) div 8; +end; + +function PixelsToDialogUnitsX(const PixelUnits: Word): Word; +begin + Result := PixelUnits * 4 div LoWord(GetDialogBaseUnits); +end; + +function PixelsToDialogUnitsY(const PixelUnits: Word): Word; +begin + Result := PixelUnits * 8 div HiWord(GetDialogBaseUnits); +end; +{$ENDIF MSWINDOWS} + +//=== Points ================================================================= + +function NullPoint: TPoint; +begin + Result.X := 0; + Result.Y := 0; +end; + +function PointAssign(const X, Y: Integer): TPoint; +begin + Result.X := X; + Result.Y := Y; +end; + +procedure PointCopy(var Dest: TPoint; const Source: TPoint); +begin + Dest.X := Source.X; + Dest.Y := Source.Y; +end; + +function PointEqual(const P1, P2: TPoint): Boolean; +begin + Result := (P1.X = P2.X) and (P1.Y = P2.Y); +end; + +function PointIsNull(const P: TPoint): Boolean; +begin + Result := (P.X = 0) and (P.Y = 0); +end; + +procedure PointMove(var P: TPoint; const DeltaX, DeltaY: Integer); +begin + P.X := P.X + DeltaX; + P.Y := P.Y + DeltaY; +end; + +//=== Rectangles ============================================================= + +function NullRect: TRect; +begin + with Result do + begin + Top := 0; + Left := 0; + Bottom := 0; + Right := 0; + end; +end; + +function RectAssign(const Left, Top, Right, Bottom: Integer): TRect; +begin + Result.Left := Left; + Result.Top := Top; + Result.Right := Right; + Result.Bottom := Bottom; +end; + +function RectAssignPoints(const TopLeft, BottomRight: TPoint): TRect; +begin + Result.TopLeft := TopLeft; + Result.BottomRight := BottomRight; +end; + +function RectBounds(const Left, Top, Width, Height: Integer): TRect; +begin + Result := RectAssign(Left, Top, Left + Width, Top + Height); +end; + +function RectCenter(const R: TRect): TPoint; +begin + Result.X := R.Left + (RectWidth(R) div 2); + Result.Y := R.Top + (RectHeight(R) div 2); +end; + +procedure RectCopy(var Dest: TRect; const Source: TRect); +begin + Dest := Source; +end; + +procedure RectFitToScreen(var R: TRect); +var + X, Y: Integer; + Delta: Integer; +begin + {$IFDEF MSWINDOWS} + X := GetSystemMetrics(SM_CXSCREEN); + Y := GetSystemMetrics(SM_CYSCREEN); + {$ELSE ~MSWINDOWS} + TODO: find a solution for other systems + {$ENDIF ~MSWINDOWS} + with R do + begin + if Right > X then + begin + Delta := Right - Left; + Right := X; + Left := Right - Delta; + end; + if Left < 0 then + begin + Delta := Right - Left; + Left := 0; + Right := Left + Delta; + end; + if Bottom > Y then + begin + Delta := Bottom - Top; + Bottom := Y; + Top := Bottom - Delta; + end; + if Top < 0 then + begin + Delta := Bottom - Top; + Top := 0; + Bottom := Top + Delta; + end; + end; +end; + +procedure RectGrow(var R: TRect; const Delta: Integer); +begin + with R do + begin + Dec(Left, Delta); + Dec(Top, Delta); + Inc(Right, Delta); + Inc(Bottom, Delta); + end; +end; + +procedure RectGrowX(var R: TRect; const Delta: Integer); +begin + with R do + begin + Dec(Left, Delta); + Inc(Right, Delta); + end; +end; + +procedure RectGrowY(var R: TRect; const Delta: Integer); +begin + with R do + begin + Dec(Top, Delta); + Inc(Bottom, Delta); + end; +end; + +function RectEqual(const R1, R2: TRect): Boolean; +begin + Result := (R1.Left = R2.Left) and (R1.Top = R2.Top) and + (R1.Right = R2.Right) and (R1.Bottom = R2.Bottom); +end; + +function RectHeight(const R: TRect): Integer; +begin + Result := Abs(R.Bottom - R.Top); +end; + +function RectIncludesPoint(const R: TRect; const Pt: TPoint): Boolean; +begin + Result := (Pt.X > R.Left) and (Pt.X < R.Right) and + (Pt.Y > R.Top) and (Pt.Y < R.Bottom); +end; + +function RectIncludesRect(const R1, R2: TRect): Boolean; +begin + Result := (R1.Left >= R2.Left) and (R1.Top >= R2.Top) and + (R1.Right <= R2.Right) and (R1.Bottom <= R2.Bottom); +end; + +function RectIntersection(const R1, R2: TRect): TRect; +begin + with Result do + begin + Left := JclLogic.Max(R1.Left, R2.Left); + Top := JclLogic.Max(R1.Top, R2.Top); + Right := JclLogic.Min(R1.Right, R2.Right); + Bottom := JclLogic.Min(R1.Bottom, R2.Bottom); + end; + if not RectIsValid(Result) then + Result := NullRect; +end; + +function RectIntersectRect(const R1, R2: TRect): Boolean; +begin + Result := not RectIsNull(RectIntersection(R1, R2)); +end; + +function RectIsEmpty(const R: TRect): Boolean; +begin + Result := (R.Right = R.Left) and (R.Bottom = R.Top); +end; + +function RectIsNull(const R: TRect): Boolean; +begin + with R do + Result := (Left = 0) and (Right = 0) and (Top = 0) and (Bottom = 0); +end; + +function RectIsSquare(const R: TRect): Boolean; +begin + Result := (RectHeight(R) = RectWidth(R)); +end; + +function RectIsValid(const R: TRect): Boolean; +begin + with R do + Result := (Left <= Right) and (Top <= Bottom); +end; + +procedure RectMove(var R: TRect; const DeltaX, DeltaY: Integer); +begin + with R do + begin + Inc(Left, DeltaX); + Inc(Right, DeltaX); + Inc(Top, DeltaY); + Inc(Bottom, DeltaY); + end; +end; + +procedure RectMoveTo(var R: TRect; const X, Y: Integer); +begin + with R do + begin + Right := (Right - Left) + X; + Bottom := (Bottom - Top) + Y; + Left := X; + Top := Y; + end; +end; + +procedure RectNormalize(var R: TRect); +var + Temp: Integer; +begin + if R.Left > R.Right then + begin + Temp := R.Left; + R.Left := R.Right; + R.Right := Temp; + end; + if R.Top > R.Bottom then + begin + Temp := R.Top; + R.Top := R.Bottom; + R.Bottom := Temp; + end; +end; + +function RectsAreValid(R: array of TRect): Boolean; +var + I: Integer; +begin + if Length(R) = 0 then + begin + Result := False; + Exit; + end; + for I := Low(R) to High(R) do + begin + with R[I] do + Result := (Left <= Right) and (Top <= Bottom); + if not Result then + Exit; + end; + Result := True; +end; + +function RectUnion(const R1, R2: TRect): TRect; +begin + with Result do + begin + Left := JclLogic.Min(R1.Left, R2.Left); + Top := JclLogic.Min(R1.Top, R2.Top); + Right := JclLogic.Max(R1.Right, R2.Right); + Bottom := JclLogic.Max(R1.Bottom, R2.Bottom); + end; + if not RectIsValid(Result) then + Result := NullRect; +end; + +function RectWidth(const R: TRect): Integer; +begin + Result := Abs(R.Right - R.Left); +end; + +//=== Color ================================================================== + +const + MaxBytePercent = High(Byte) * 0.01; + +procedure GetRGBValue(const Color: TColor; out Red, Green, Blue: Byte); +var + Temp: TColorRec; +begin + Temp.Value := ColorToRGB(Color); + Red := Temp.R; + Green := Temp.G; + Blue := Temp.B; +end; + +function SetRGBValue(const Red, Green, Blue: Byte): TColor; +begin + TColorRec(Result).Red := Red; + TColorRec(Result).Green := Green; + TColorRec(Result).Blue := Blue; + TColorRec(Result).Flag := 0; +end; + +function SetColorFlag(const Color: TColor; const Flag: Byte): TColor; +begin + Result := Color; + TColorRec(Result).Flag := Flag; +end; + +function GetColorFlag(const Color: TColor): Byte; +begin + Result := TColorRec(Color).Flag; +end; + +function SetColorRed(const Color: TColor; const Red: Byte): TColor; +begin + Result := ColorToRGB(Color); + TColorRec(Result).Red := Red; +end; + +function GetColorRed(const Color: TColor): Byte; +var + Temp: TColorRec; +begin + Temp.Value := ColorToRGB(Color); + Result := Temp.Red; +end; + +function SetColorGreen(const Color: TColor; const Green: Byte): TColor; +begin + Result := ColorToRGB(Color); + TColorRec(Result).Green := Green; +end; + +function GetColorGreen(const Color: TColor): Byte; +var + Temp: TColorRec; +begin + Temp.Value := ColorToRGB(Color); + Result := Temp.Green; +end; + +function SetColorBlue(const Color: TColor; const Blue: Byte): TColor; +begin + Result := ColorToRGB(Color); + TColorRec(Result).Blue := Blue; +end; + +function GetColorBlue(const Color: TColor): Byte; +var + Temp: TColorRec; +begin + Temp.Value := ColorToRGB(Color); + Result := Temp.Blue; +end; + +function BrightColor(const Color: TColor; const Pct: Single): TColor; +var + Temp: TColorRec; +begin + Temp.Value := ColorToRGB(Color); + Temp.R := BrightColorChannel(Temp.R, Pct); + Temp.G := BrightColorChannel(Temp.G, Pct); + Temp.B := BrightColorChannel(Temp.B, Pct); + Result := Temp.Value; +end; + +function BrightColorChannel(const Channel: Byte; const Pct: Single): Byte; +var + Temp: Integer; +begin + if Pct < 0 then + Result := DarkColorChannel(Channel, -Pct) + else + begin + Temp := Round(Channel + Pct * MaxBytePercent); + if Temp > High(Result) then + Result := High(Result) + else + Result := Temp; + end; +end; + +function DarkColor(const Color: TColor; const Pct: Single): TColor; +var + Temp: TColorRec; +begin + Temp.Value := ColorToRGB(Color); + Temp.R := DarkColorChannel(Temp.R, Pct); + Temp.G := DarkColorChannel(Temp.G, Pct); + Temp.B := DarkColorChannel(Temp.B, Pct); + Result := Temp.Value; +end; + +function DarkColorChannel(const Channel: Byte; const Pct: Single): Byte; +var + Temp: Integer; +begin + if Pct < 0 then + Result := BrightColorChannel(Channel, -Pct) + else + begin + Temp := Round(Channel - Pct * MaxBytePercent); + if Temp < Low(Result) then + Result := Low(Result) + else + Result := Temp; + end; +end; + +// Converts values of the XYZ color space using the D65 white point to D50 white point. +// The values were taken from www.srgb.com/hpsrgbprof/sld005.htm + +procedure CIED65ToCIED50(var X, Y, Z: Extended); +var + Xn, Yn, Zn: Extended; +begin + Xn := 1.0479 * X + 0.0299 * Y - 0.0502 * Z; + Yn := 0.0296 * X + 0.9904 * Y - 0.0171 * Z; + Zn := -0.0092 * X + 0.0151 * Y + 0.7519 * Z; + X := Xn; + Y := Yn; + Z := Zn; +end; + +// converts each color component from a 16bits per sample to 8 bit used in Windows DIBs +// Count is the number of entries in Source and Target + +procedure Gray16(const Source, Target: Pointer; Count: Cardinal); +var + SourceRun: PWord; + TargetRun: PByte; +begin + SourceRun := Source; + TargetRun := Target; + while Count > 0 do + begin + TargetRun^ := SourceRun^ shr 8; + Inc(SourceRun); + Inc(TargetRun); + Dec(Count); + end; +end; + +type + PCMYK = ^TCMYK; + TCMYK = packed record + C: Byte; + M: Byte; + Y: Byte; + K: Byte; + end; + + PCMYK16 = ^TCMYK16; + TCMYK16 = packed record + C: Word; + M: Word; + Y: Word; + K: Word; + end; + +// converts a stream of Count CMYK values to BGR +// BitsPerSample : 8 or 16 +// CMYK is C,M,Y,K 4 byte record or 4 word record +// Target is always 3 byte record B, R, G + +procedure CMYKToBGR(const Source, Target: Pointer; const BitsPerSample: Byte; Count: Cardinal); overload; +var + R, G, B, K: Integer; + I: Integer; + SourcePtr: PCMYK; + SourcePtr16: PCMYK16; + TargetPtr: PByte; +begin + case BitsPerSample of + 8: + begin + SourcePtr := Source; + TargetPtr := Target; + Count := Count div 4; + for I := 0 to Count - 1 do + begin + K := SourcePtr.K; + R := 255 - (SourcePtr.C - MulDiv(SourcePtr.C, K, 255) + K); + G := 255 - (SourcePtr.M - MulDiv(SourcePtr.M, K, 255) + K); + B := 255 - (SourcePtr.Y - MulDiv(SourcePtr.Y, K, 255) + K); + TargetPtr^ := Max(0, Min(255, Byte(B))); + Inc(TargetPtr); + TargetPtr^ := Max(0, Min(255, Byte(G))); + Inc(TargetPtr); + TargetPtr^ := Max(0, Min(255, Byte(R))); + Inc(TargetPtr); + Inc(SourcePtr); + end; + end; + 16: + begin + SourcePtr16 := Source; + TargetPtr := Target; + Count := Count div 4; + for I := 0 to Count - 1 do + begin + K := SourcePtr16.K; + R := 255 - (SourcePtr16.C - MulDiv(SourcePtr16.C, K, 65535) + K) shr 8; + G := 255 - (SourcePtr16.M - MulDiv(SourcePtr16.M, K, 65535) + K) shr 8; + B := 255 - (SourcePtr16.Y - MulDiv(SourcePtr16.Y, K, 65535) + K) shr 8; + TargetPtr^ := Max(0, Min(255, Byte(B))); + Inc(TargetPtr); + TargetPtr^ := Max(0, Min(255, Byte(G))); + Inc(TargetPtr); + TargetPtr^ := Max(0, Min(255, Byte(R))); + Inc(TargetPtr); + Inc(SourcePtr16); + end; + end; + else + raise EColorConversionError.CreateResFmt(@RsBitsPerSampleNotSupported, [BitsPerSample]); + end; +end; + +// converts a stream of Count CMYK values to BGR + +procedure CMYKToBGR(const C, M, Y, K, Target: Pointer; const BitsPerSample: Byte; Count: Cardinal); overload; +var + R, G, B: Integer; + C8, M8, Y8, K8: PByte; + C16, M16, Y16, K16: PWord; + I: Integer; + TargetPtr: PByte; +begin + case BitsPerSample of + 8: + begin + C8 := C; + M8 := M; + Y8 := Y; + K8 := K; + TargetPtr := Target; + Count := Count div 4; + for I := 0 to Count - 1 do + begin + R := 255 - (C8^ - MulDiv(C8^, K8^, 255) + K8^); + G := 255 - (M8^ - MulDiv(M8^, K8^, 255) + K8^); + B := 255 - (Y8^ - MulDiv(Y8^, K8^, 255) + K8^); + TargetPtr^ := Max(0, Min(255, Byte(B))); + Inc(TargetPtr); + TargetPtr^ := Max(0, Min(255, Byte(G))); + Inc(TargetPtr); + TargetPtr^ := Max(0, Min(255, Byte(R))); + Inc(TargetPtr); + Inc(C8); + Inc(M8); + Inc(Y8); + Inc(K8); + end; + end; + 16: + begin + C16 := C; + M16 := M; + Y16 := Y; + K16 := K; + TargetPtr := Target; + Count := Count div 4; + for I := 0 to Count - 1 do + begin + R := 255 - (C16^ - MulDiv(C16^, K16^, 65535) + K16^) shr 8; + G := 255 - (M16^ - MulDiv(M16^, K16^, 65535) + K16^) shr 8; + B := 255 - (Y16^ - MulDiv(Y16^, K16^, 65535) + K16^) shr 8; + TargetPtr^ := Max(0, Min(255, Byte(B))); + Inc(TargetPtr); + TargetPtr^ := Max(0, Min(255, Byte(G))); + Inc(TargetPtr); + TargetPtr^ := Max(0, Min(255, Byte(R))); + Inc(TargetPtr); + Inc(C16); + Inc(M16); + Inc(Y16); + Inc(K16); + end; + end; + else + raise EColorConversionError.CreateResFmt(@RsBitsPerSampleNotSupported, [BitsPerSample]); + end; +end; + +// conversion of the CIE L*a*b color space to RGB using a two way approach assuming a D65 white point, +// first a conversion to CIE XYZ is performed and then from there to RGB + +procedure CIELABToBGR(const Source, Target: Pointer; const Count: Cardinal); overload; +var + FinalR, + FinalG, + FinalB: Integer; + L, a, b, + X, Y, Z, // color values in float format + T, YYn3: Double; // intermediate results + SourcePtr, + TargetPtr: PByte; + PixelCount: Cardinal; +begin + SourcePtr := Source; + TargetPtr := Target; + PixelCount := Count div 3; + + while PixelCount > 0 do + begin + // L should be in the range of 0..100 but at least Photoshop stores the luminance + // in the range of 0..255 + L := SourcePtr^ / 2.55; + Inc(SourcePtr); + a := Shortint(SourcePtr^); + Inc(SourcePtr); + b := Shortint(SourcePtr^); + Inc(SourcePtr); + + // CIE L*a*b can be calculated from CIE XYZ by: + // L = 116 * ((Y / Yn)^1/3) - 16 if (Y / Yn) > 0.008856 + // L = 903.3 * Y / Yn if (Y / Yn) <= 0.008856 + // a = 500 * (f(X / Xn) - f(Y / Yn)) + // b = 200 * (f(Y / Yn) - f(Z / Zn)) + // where f(t) = t^(1/3) with (Y / Yn) > 0.008856 + // f(t) = 7.787 * t + 16 / 116 with (Y / Yn) <= 0.008856 + // + // by reordering the above equations we can calculate CIE L*a*b -> XYZ as follows: + // L is in the range 0..100 and a as well as b in -127..127 + YYn3 := (L + 16) / 116; // this corresponds to (Y/Yn)^1/3 + if L < 7.9996 then + begin + Y := L / 903.3; + X := a / 3893.5 + Y; + Z := Y - b / 1557.4; + end + else + begin + T := YYn3 + a / 500; + X := T * T * T; + Y := YYn3 * YYn3 * YYn3; + T := YYn3 - b / 200; + Z := T * T * T; + end; + + // once we have CIE XYZ it is easy (yet quite expensive) to calculate RGB values from this + FinalR := Round(255.0 * ( 2.998 * X - 1.458 * Y - 0.541 * Z)); + FinalG := Round(255.0 * (-0.952 * X + 1.893 * Y + 0.059 * Z)); + FinalB := Round(255.0 * ( 0.099 * X - 0.198 * Y + 1.099 * Z)); + + TargetPtr^ := Max(0, Min(255, Byte(FinalB))); + Inc(TargetPtr); + TargetPtr^ := Max(0, Min(255, Byte(FinalG))); + Inc(TargetPtr); + TargetPtr^ := Max(0, Min(255, Byte(FinalR))); + Inc(TargetPtr); + + Dec(PixelCount); + end; +end; + +// conversion of the CIE L*a*b color space to RGB using a two way approach assuming a D65 white point, +// first a conversion to CIE XYZ is performed and then from there to RGB +// The BitsPerSample are not used so why leave it here. + +procedure CIELABToBGR(LSource, aSource, bSource: PByte; const Target: Pointer; const Count: Cardinal); overload; +var + FinalR, + FinalG, + FinalB: Integer; + L, a, b, + X, Y, Z, // color values in float format + T, YYn3: Double; // intermediate results + TargetPtr: PByte; + PixelCount: Cardinal; +begin + TargetPtr := Target; + PixelCount := Count div 3; + + while PixelCount > 0 do + begin + // L should be in the range of 0..100 but at least Photoshop stores the luminance + // in the range of 0..256 + L := LSource^ / 2.55; + Inc(LSource); + a := Shortint(aSource^); + Inc(aSource); + b := Shortint(bSource^); + Inc(bSource); + + // CIE L*a*b can be calculated from CIE XYZ by: + // L = 116 * ((Y / Yn)^1/3) - 16 if (Y / Yn) > 0.008856 + // L = 903.3 * Y / Yn if (Y / Yn) <= 0.008856 + // a = 500 * (f(X / Xn) - f(Y / Yn)) + // b = 200 * (f(Y / Yn) - f(Z / Zn)) + // where f(t) = t^(1/3) with (Y / Yn) > 0.008856 + // f(t) = 7.787 * t + 16 / 116 with (Y / Yn) <= 0.008856 + // + // by reordering the above equations we can calculate CIE L*a*b -> XYZ as follows: + // L is in the range 0..100 and a as well as b in -127..127 + YYn3 := (L + 16) / 116; // this corresponds to (Y/Yn)^1/3 + if L < 7.9996 then + begin + Y := L / 903.3; + X := a / 3893.5 + Y; + Z := Y - b / 1557.4; + end + else + begin + T := YYn3 + a / 500; + X := T * T * T; + Y := YYn3 * YYn3 * YYn3; + T := YYn3 - b / 200; + Z := T * T * T; + end; + + // once we have CIE XYZ it is easy (yet quite expensive) to calculate RGB values from this + FinalR := Round(255.0 * ( 2.998 * X - 1.458 * Y - 0.541 * Z)); + FinalG := Round(255.0 * (-0.952 * X + 1.893 * Y + 0.059 * Z)); + FinalB := Round(255.0 * ( 0.099 * X - 0.198 * Y + 1.099 * Z)); + + TargetPtr^ := Max(0, Min(255, Byte(FinalB))); + Inc(TargetPtr); + TargetPtr^ := Max(0, Min(255, Byte(FinalG))); + Inc(TargetPtr); + TargetPtr^ := Max(0, Min(255, Byte(FinalR))); + Inc(TargetPtr); + + Dec(PixelCount); + end; +end; + +// reorders a stream of "Count" RGB values to BGR, additionally an eventual sample size adjustment is done + +procedure RGBToBGR(const Source, Target: Pointer; const BitsPerSample: Byte; Count: Cardinal); overload; +var + SourceRun16: PRGBWord; + SourceRun8: PRGB; + TargetRun: PBGR; +begin + Count := Count div 3; + // usually only 8 bit samples are used but Photoshop allows for 16 bit samples + case BitsPerSample of + 8: + begin + SourceRun8 := Source; + TargetRun := Target; + while Count > 0 do + begin + TargetRun.R := SourceRun8.R; + TargetRun.G := SourceRun8.G; + TargetRun.B := SourceRun8.B; + Inc(SourceRun8); + Inc(TargetRun); + Dec(Count); + end; + end; + 16: + begin + SourceRun16 := Source; + TargetRun := Target; + while Count > 0 do + begin + TargetRun.R := SourceRun16.R shr 8; + TargetRun.G := SourceRun16.G shr 8; + TargetRun.B := SourceRun16.B shr 8; + Inc(SourceRun16); + Inc(TargetRun); + Dec(Count); + end; + end; + else + raise EColorConversionError.CreateResFmt(@RsBitsPerSampleNotSupported, [BitsPerSample]); + end; +end; + +// reorders a stream of "Count" RGB values to BGR, additionally an eventual sample size adjustment is done + +procedure RGBToBGR(const R, G, B, Target: Pointer; const BitsPerSample: Byte; Count: Cardinal); overload; +var + R8, G8, B8: PByte; + R16, G16, B16: PWord; + TargetRun: PByte; +begin + Count := Count div 3; + // usually only 8 bits samples are used but Photoshop allows 16 bits samples too + case BitsPerSample of + 8: + begin + R8 := R; + G8 := G; + B8 := B; + TargetRun := Target; + while Count > 0 do + begin + TargetRun^ := B8^; + Inc(B8); + Inc(TargetRun); + TargetRun^ := G8^; + Inc(G8); + Inc(TargetRun); + TargetRun^ := R8^; + Inc(R8); + Inc(TargetRun); + Dec(Count); + end; + end; + 16: + begin + R16 := R; + G16 := G; + B16 := B; + TargetRun := Target; + while Count > 0 do + begin + TargetRun^ := B16^ shr 8; + Inc(B16); + Inc(TargetRun); + TargetRun^ := G16^ shr 8; + Inc(G16); + Inc(TargetRun); + TargetRun^ := R16^ shr 8; + Inc(R16); + Inc(TargetRun); + Dec(Count); + end; + end; + else + raise EColorConversionError.CreateResFmt(@RsBitsPerSampleNotSupported, [BitsPerSample]); + end; +end; + +// reorders a stream of "Count" RGBA values to BGRA, additionally an eventual sample +// size adjustment is done + +procedure RGBAToBGRA(const Source, Target: Pointer; const BitsPerSample: Byte; Count: Cardinal); +var + SourceRun16: PRGBAWord; + SourceRun8: PRGBA; + TargetRun: PBGRA; +begin + Count := Count div 4; + // usually only 8 bit samples are used but Photoshop allows for 16 bit samples + case BitsPerSample of + 8: + begin + SourceRun8 := Source; + TargetRun := Target; + while Count > 0 do + begin + TargetRun.R := SourceRun8.R; + TargetRun.G := SourceRun8.G; + TargetRun.B := SourceRun8.B; + TargetRun.A := SourceRun8.A; + Inc(SourceRun8); + Inc(TargetRun); + Dec(Count); + end; + end; + 16: + begin + SourceRun16 := Source; + TargetRun := Target; + while Count > 0 do + begin + TargetRun.R := SourceRun16.B shr 8; + TargetRun.G := SourceRun16.G shr 8; + TargetRun.B := SourceRun16.R shr 8; + TargetRun.A := SourceRun16.A shr 8; + Inc(SourceRun16); + Inc(TargetRun); + Dec(Count); + end; + end; + else + raise EColorConversionError.CreateResFmt(@RsBitsPerSampleNotSupported, [BitsPerSample]); + end; +end; + +procedure WinColorToOpenGLColor(const Color: TColor; out Red, Green, Blue: Float); +var + Temp: TColorRec; +begin + Temp.Value := ColorToRGB(Color); + Red := (Temp.R / High(Temp.R)); + Green := (Temp.G / High(Temp.G)); + Blue := (Temp.B / High(Temp.B)); +end; + +function OpenGLColorToWinColor(const Red, Green, Blue: Float): TColor; +var + Temp: TColorRec; +begin + Temp.R := Round(Red * High(Temp.R)); + Temp.G := Round(Green * High(Temp.G)); + Temp.B := Round(Blue * High(Temp.B)); + Temp.Flag := 0; + Result := Temp.Value; +end; + +function Color32(WinColor: TColor): TColor32; overload; +begin + WinColor := ColorToRGB(WinColor); + Result := ColorSwap(WinColor); +end; + +function Color32(const R, G, B: Byte; const A: Byte): TColor32; overload; +begin + Result := A shl 24 + R shl 16 + G shl 8 + B; +end; + +function Color32(const Index: Byte; const Palette: TPalette32): TColor32; overload; +begin + Result := Palette[Index]; +end; + +function Gray32(const Intensity: Byte; const Alpha: Byte): TColor32; +begin + Result := TColor32(Alpha) shl 24 + TColor32(Intensity) shl 16 + + TColor32(Intensity) shl 8 + TColor32(Intensity); +end; + +function WinColor(const Color32: TColor32): TColor; +begin + // the alpha channel byte is set to zero + Result := (Color32 and _R shr 16) or (Color32 and _G) or + (Color32 and _B shl 16); +end; + +function RedComponent(const Color32: TColor32): Integer; +begin + Result := Color32 and _R shr 16; +end; + +function GreenComponent(const Color32: TColor32): Integer; +begin + Result := Color32 and _G shr 8; +end; + +function BlueComponent(const Color32: TColor32): Integer; +begin + Result := Color32 and _B; +end; + +function AlphaComponent(const Color32: TColor32): Integer; +begin + Result := Color32 shr 24; +end; + +function Intensity(const R, G, B: Single): Single; +const + RFactor = 61 / 256; + GFactor = 174 / 256; + BFactor = 21 / 256; +begin + Result := RFactor * R + GFactor * G + BFactor * B; +end; + +// input: RGB components +// output: (R * 61 + G * 174 + B * 21) div 256 + +function Intensity(const Color32: TColor32): Integer; +begin + Result := (Color32 and _B) * 21 // Blue + + ((Color32 and _G) shr 8) * 174 // Green + + ((Color32 and _R) shr 16) * 61; // Red + Result := Result shr 8; +end; + +function SetAlpha(const Color32: TColor32; NewAlpha: Integer): TColor32; +begin + Result := (Color32 and _RGB) or (TColor32(NewAlpha) shl 24); +end; + +procedure HLSToRGB(const H, L, S: Single; out R, G, B: Single); +var + M1, M2: Single; + + function HueToColorValue(Hue: Single): Single; + begin + Hue := Hue - Floor(Hue); + + if 6 * Hue < 1 then + Result := M1 + (M2 - M1) * Hue * 6 + else + if 2 * Hue < 1 then + Result := M2 + else + if 3 * Hue < 2 then + Result := M1 + (M2 - M1) * (2 / 3 - Hue) * 6 + else + Result := M1; + end; + +begin + if S = 0 then + begin + R := L; + G := R; + B := R; + end + else + begin + if L <= 0.5 then + M2 := L * (1 + S) + else + M2 := L + S - L * S; + M1 := 2 * L - M2; + R := HueToColorValue(H + 1 / 3); + G := HueToColorValue(H); + B := HueToColorValue(H - 1 / 3) + end; +end; + +function HSLToRGB(const H, S, L: Single): TColor32; +var + R, G, B: Single; +begin + HLSToRGB(H, L, S, R, G, B); + Result := Color32(Round(R * 255), Round(G * 255), Round(B * 255), 255); +end; + +function HLSToRGB(const HLS: TColorVector): TColorVector; +begin + HLSToRGB(HLS.H, HLS.L, HLS.S, Result.R, Result.G, Result.B); +end; + +procedure RGBToHLS(const R, G, B: Single; out H, L, S: Single); +var + D, Cmax, Cmin: Single; +begin + Cmax := Max(R, Max(G, B)); + Cmin := Min(R, Min(G, B)); + L := (Cmax + Cmin) / 2; + + if Cmax = Cmin then + begin + H := 0; + S := 0 + end + else + begin + D := Cmax - Cmin; + if L < 0.5 then + S := D / (Cmax + Cmin) + else + S := D / (2 - Cmax - Cmin); + if R = Cmax then + H := (G - B) / D + else + if G = Cmax then + H := 2 + (B - R) / D + else + H := 4 + (R - G) / D; + H := H / 6; + if H < 0 then + H := H + 1; + end; +end; + +procedure RGBToHSL(const RGB: TColor32; out H, S, L: Single); +begin + RGBToHLS(RedComponent(RGB) / 255, GreenComponent(RGB) / 255, BlueComponent(RGB) / 255, H, L, S); +end; + +function RGBToHLS(const RGB: TColorVector): TColorVector; +begin + RGBToHLS(RGB.R, RGB.G, RGB.B, Result.H, Result.L, Result.S); +end; + +{ Translated C-code from Microsoft Knowledge Base +------------------------------------------- +Converting Colors Between RGB and HLS (HBS) +Article ID: Q29240 +Creation Date: 26-APR-1988 +Revision Date: 02-NOV-1995 +The information in this article applies to: + +Microsoft Windows Software Development Kit (SDK) for Windows versions 3.1 and 3.0 +Microsoft Win32 Application Programming Interface (API) included with: + + - Microsoft Windows NT versions 3.5 and 3.51 + - Microsoft Windows 95 version 4.0 +SUMMARY + + +The code fragment below converts colors between RGB (Red, Green, Blue) and HLS/HBS (Hue, Lightness, Saturation/Hue, Brightness, Saturation). + + +MORE INFORMATION + + +/* Color Conversion Routines -- + +RGBToHLS() takes a DWORD RGB value, translates it to HLS, and stores the results in the global vars H, L, and S. HLSToRGB takes the current values of H, L, and S and returns the equivalent value in an RGB DWORD. + +A point of reference for the algorithms is Foley and Van Dam, "Fundamentals of Interactive Computer Graphics," Pages 618-19. Their algorithm is in floating point. CHART implements a less general (hardwired ranges) integral algorithm. +There are potential round-off errors throughout this sample. ((0.5 + x)/y) without floating point is phrased ((x + (y/2))/y), yielding a very small round-off error. This makes many of the following divisions look strange. */ } + +const + HLSMAX = High(THLSValue); // H,L, and S vary over 0-HLSMAX + RGBMAX = 255; // R,G, and B vary over 0-RGBMAX + // HLSMAX BEST IF DIVISIBLE BY 6 + // RGBMAX, HLSMAX must each fit in a byte. + +// Hue is undefined if Saturation is 0 (grey-scale). +// This value determines where the Hue value is initially set for achromatic colors. + UNDEFINED = HLSMAX * 2 div 3; + +type + TInternalRGB = packed record + R: Byte; + G: Byte; + B: Byte; + I: Byte; + end; + +function RGB(R, G, B: Byte): TColor; +begin + TInternalRGB(Result).R := R; + TInternalRGB(Result).G := G; + TInternalRGB(Result).B := B; + TInternalRGB(Result).I := 0; +end; + +function RGBToHLS(const RGBColor: TColorRef): THLSVector; +var + R, G, B: Integer; // input RGB values + H, L, S: Integer; + Cmax, Cmin: Byte; // max and min RGB values + Rdelta,Gdelta,Bdelta: Integer; // intermediate value: % of spread from max +begin + // get R, G, and B out of DWORD + R := TInternalRGB(RGBColor).R; + G := TInternalRGB(RGBColor).G; + B := TInternalRGB(RGBColor).B; + + // calculate lightness + Cmax := R; + if G > Cmax then + Cmax := G; + if B > Cmax then + Cmax := B; + + Cmin := R; + if G < Cmin then + Cmin := G; + if B < Cmin then + Cmin := B; + + L := (((Cmax + Cmin) * HLSMAX) + RGBMAX) div (2 * RGBMAX); + + if (Cmax = Cmin) then // r=g=b --> achromatic case + begin + S := 0; // saturation + H := UNDEFINED; // hue + end + else + begin // chromatic case + // saturation + if L <= (HLSMAX div 2) then + S := (((Cmax - Cmin) * HLSMAX) + ((Cmax + Cmin) div 2)) div (Cmax + Cmin) + else + S := (((Cmax - Cmin) * HLSMAX) + ((2 * RGBMAX - Cmax - Cmin) div 2)) div (2 * RGBMAX - Cmax - Cmin); + + // hue + Rdelta := (((Cmax - R) * (HLSMAX div 6)) + ((Cmax - Cmin) div 2)) div (Cmax - Cmin); + Gdelta := (((Cmax - G) * (HLSMAX div 6)) + ((Cmax - Cmin) div 2)) div (Cmax - Cmin); + Bdelta := (((Cmax - B) * (HLSMAX div 6)) + ((Cmax - Cmin) div 2)) div (Cmax - Cmin); + + if R = Cmax then + H := Bdelta - Gdelta + else + if G = Cmax then + H := (HLSMAX div 3) + Rdelta - Bdelta + else // B = Cmax + H := ((2 * HLSMAX) div 3) + Gdelta - Rdelta; + + H := H mod HLSMAX; + if H < 0 then + Inc(H, HLSMAX); + end; + Result.Hue := H; + Result.Luminance := L; + Result.Saturation := S; +end; + +function HueToRGB(M1, M2, Hue: Integer): Integer; +// utility routine for HLSToRGB +begin + Hue := Hue mod HLSMAX; + // range check: note values passed add div subtract thirds of range + if Hue < 0 then + Inc(Hue, HLSMAX); + + // return r,g, or b value from this tridrant + if Hue < (HLSMAX div 6) then + Result := (M1 + (((M2 - M1) * Hue + (HLSMAX div 12)) div (HLSMAX div 6))) + else + if Hue < (HLSMAX div 2) then + Result := M2 + else + if Hue < ((HLSMAX * 2) div 3) then + Result := (M1 + (((M2 - M1) * (((HLSMAX * 2) div 3) - Hue) + (HLSMAX div 12)) div (HLSMAX div 6))) + else + Result := M1; +end; + +function HLSToRGB(const Hue, Luminance, Saturation: THLSValue): TColorRef; +var + R, G, B: Integer; // RGB component values + Magic1, Magic2: Integer; // calculated magic numbers (really!) +begin + if Saturation = 0 then // achromatic case + begin + R :=(Luminance * RGBMAX) div HLSMAX; + G := R; + B := R; + if Hue <> UNDEFINED then + begin + // ERROR + end + end else + begin // chromatic case + // set up magic numbers + if (Luminance <= (HLSMAX div 2)) then + Magic2 := (Luminance * (HLSMAX + Saturation) + (HLSMAX div 2)) div HLSMAX + else + Magic2 := Luminance + Saturation - ((Luminance * Saturation) + (HLSMAX div 2)) div HLSMAX; + Magic1 := 2 * Luminance - Magic2; + // get RGB, change units from HLSMAX to RGBMAX + R := (HueToRGB(Magic1, Magic2, Hue + (HLSMAX div 3)) * RGBMAX + (HLSMAX div 2)) div HLSMAX; + G := (HueToRGB(Magic1, Magic2, Hue) * RGBMAX + (HLSMAX div 2)) div HLSMAX; + B := (HueToRGB(Magic1, Magic2, Hue - (HLSMAX div 3)) * RGBMAX + (HLSMAX div 2)) div HLSMAX; + end; + Result := RGB(R, G, B); +end; + +{$IFDEF VCL} +function SetBitmapColors(Bmp: TBitmap; const Colors: array of TColor; StartIndex: Integer): Integer; +type + TRGBQuadArray = array [Byte] of TRGBQuad; + PRGBQuadArray = ^TRGBQuadArray; +var + I, RGB: Integer; + ColorTable: PRGBQuadArray; + Count: Integer; +begin + Count := High(Colors)-Low(Colors)+1; + GetMem(ColorTable, Count * SizeOf(TRGBQuad)); + try + for I := 0 to Count-1 do + with ColorTable^[I] do + begin + RGB := ColorToRGB(Colors[I]); + rgbBlue := GetBValue(RGB); + rgbGreen := GetGValue(RGB); + rgbRed := GetRValue(RGB); + rgbReserved := 0; + end; + Bmp.HandleType := bmDIB; + Result := GDICheck(SetDIBColorTable(Bmp.Canvas.Handle, StartIndex, Count, ColorTable^)); + finally + FreeMem(ColorTable); + end; +end; +{$ENDIF VCL} + +//=== Misc =================================================================== + +function ColorToHTML(const Color: TColor): string; +var + Temp: TColorRec; +begin + Temp.Value := ColorToRGB(Color); + Result := Format('#%.2x%.2x%.2x', [Temp.R, Temp.G, Temp.B]); +end; + +{$IFDEF VCL} +function DottedLineTo(const Canvas: TCanvas; const X, Y: Integer): Boolean; +const + DotBits: array [0..7] of Word = ($AA, $55, $AA, $55, $AA, $55, $AA, $55); +var + Bitmap: HBitmap; + Brush: HBrush; + SaveTextColor, SaveBkColor: TColorRef; + LastPos: TPoint; + R: TRect; + DC: HDC; +begin + DC := Canvas.Handle; + GetCurrentPositionEx(DC, @LastPos); + Result := False; + if LastPos.X = X then + R := RectAssign(LastPos.X, LastPos.Y, LastPos.X + 1, Y) + else + if LastPos.Y = Y then + R := RectAssign(LastPos.X, LastPos.Y, X, LastPos.Y + 1) + else + Exit; + Bitmap := CreateBitmap(8, 8, 1, 1, @DotBits); + Brush := CreatePatternBrush(Bitmap); + SaveTextColor := SetTextColor(DC, ColorToRGB(Canvas.Pen.Color)); + SaveBkColor := SetBkColor(DC, ColorToRGB(Canvas.Brush.Color)); + FillRect(DC, R, Brush); + MoveToEx(DC, X, Y, nil); + SetBkColor(DC, SaveBkColor); + SetTextColor(DC, SaveTextColor); + DeleteObject(Brush); + DeleteObject(Bitmap); + Result := True; +end; +{$ENDIF VCL} + +{$IFDEF MSWINDOWS} +// Adjusts the given string S so that it fits into the given width. EllipsisWidth gives the width of +// the three points to be added to the shorted string. If this value is 0 then it will be determined implicitely. +// For higher speed (and multiple entries to be shorted) specify this value explicitely. +// RTL determines if right-to-left reading is active, which is needed to put the ellipsisis on the correct side. +// Note: It is assumed that the string really needs shortage. Check this in advance. + +function ShortenString(const DC: HDC; const S: WideString; const Width: Integer; const RTL: Boolean; + EllipsisWidth: Integer): WideString; +var + Size: TSize; + Len: Integer; + L, H, N, W: Integer; +begin + Len := Length(S); + if (Len = 0) or (Width <= 0) then + Result := '' + else + begin + // Determine width of triple point using the current DC settings (if not already done). + if EllipsisWidth = 0 then + begin + GetTextExtentPoint32W(DC, '...', 3, Size); + EllipsisWidth := Size.cx; + end; + + if Width <= EllipsisWidth then + Result := '' + else + begin + // Do a binary search for the optimal string length which fits into the given width. + L := 0; + H := Len; + N := 0; + while L <= H do + begin + N := (L + H) shr 1; + GetTextExtentPoint32W(DC, PWideChar(S), N, Size); + W := Size.cx + EllipsisWidth; + if W < Width then + L := N + 1 + else + begin + H := N - 1; + if W = Width then + L := N; + end; + end; + + // Windows 2000+ automatically switches the order in the string. For every other system we have to take care. + if IsWin2K or not RTL then + Result := Copy(S, 1, N - 1) + '...' + else + Result := '...' + Copy(S, 1, N - 1); + end; + end; +end; +{$ENDIF MSWINDOWS} + +//=== Clipping =============================================================== + +function ClipCodes(const X, Y, MinX, MinY, MaxX, MaxY: Float): TClipCodes; +begin + Result := []; + if X > MaxX then + Include(Result, ccRight) + else + if X < MinX then + Include(Result, ccLeft); + if Y < MinY then + Include(Result, ccAbove) + else + if Y > MaxY then + Include(Result, ccBelow); +end; + +function ClipCodes(const X, Y: Float; const ClipRect: TRect): TClipCodes; +begin + Result := ClipCodes(X, Y, ClipRect.Left, ClipRect.Top, ClipRect.Right, ClipRect.Bottom); +end; + +function ClipLine(var X1, Y1, X2, Y2: Integer; const ClipRect: TRect): Boolean; +var + FX1, FY1, FX2, FY2: Float; +begin + FX1 := X1; + FY1 := Y1; + FX2 := X2; + FY2 := Y2; + Result := ClipLine(FX1, FY1, FX2, FY2, + ClipRect.Left, ClipRect.Top, ClipRect.Right, ClipRect.Bottom, nil); + if Result then + begin + X1 := Round(FX1); + Y1 := Round(FY1); + X2 := Round(FX2); + Y2 := Round(FY2); + end; +end; + +function ClipLine(var X1, Y1, X2, Y2: Float; const MinX, MinY, MaxX, MaxY: Float; + Codes: PClipCodes): Boolean; +var + Done: Boolean; + Codes_, Codes1, Codes2: TClipCodes; + X, Y: Float; + + function ClipCodes(X, Y: Float): TClipCodes; + begin + Result := []; + if X > MaxX then + Include(Result, ccRight) + else + if X < MinX then + Include(Result, ccLeft); + if Y < MinY then + Include(Result, ccAbove) + else + if Y > MaxY then + Include(Result, ccBelow); + end; + +begin + Result := False; + Done := False; + Codes2 := ClipCodes(X2, Y2); + if Codes <> nil then + begin + Codes1 := Codes^; + Codes^ := Codes2; + end + else + Codes1 := ClipCodes(X1, Y1); + repeat + if (Codes1 = []) and (Codes2 = []) then + begin + Result := True; + Done := True; + end + else + if (Codes1 * Codes2) <> [] then + Done := True + else + begin + if Codes1 <> [] then + Codes_ := Codes1 + else + Codes_ := Codes2; + X := 0; + Y := 0; + if ccLeft in Codes_ then + begin + Y := Y1 + (Y2 - Y1) * (MinX - X1) / (X2 - X1); + X := MinX; + end + else + if ccRight in Codes_ then + begin + Y := Y1 + (Y2 - Y1) * (MaxX - X1) / (X2 - X1); + X := MaxX; + end + else + if ccAbove in Codes_ then + begin + X := X1 + (X2 - X1) * (MinY - Y1) / (Y2 - Y1); + Y := MinY; + end + else + if ccBelow in Codes_ then + begin + X := X1 + (X2 - X1) * (MaxY - Y1) / (Y2 - Y1); + Y := MaxY; + end; + if Codes_ = Codes1 then + begin + X1 := X; + Y1 := Y; + Codes1 := ClipCodes(X1, Y1); + end + else + begin + X2 := X; + Y2 := Y; + Codes2 := ClipCodes(X2, Y2); + end; + end; + until Done; +end; + +procedure DrawPolyLine(const Canvas: TCanvas; var Points: TPointArray; const ClipRect: TRect); +var + I: Integer; + X, Y: Integer; + X1, Y1, X2, Y2: Float; + ClipX1, ClipY1, ClipX2, ClipY2: Float; + Codes1, Codes2: TClipCodes; +begin + if not RectIsValid(ClipRect) then + Exit; + + with Points[0] do + begin + X1 := X; + Y1 := Y; + Canvas.MoveTo(X, Y); + end; + + ClipX1 := ClipRect.Left; + ClipY1 := ClipRect.Top; + ClipX2 := ClipRect.Right; + ClipY2 := ClipRect.Bottom; + + Codes2 := ClipCodes(X1, Y1, ClipX1, ClipY1, ClipX2, ClipY2); + for I := 1 to High(Points) do + begin + with Points[I] do + begin + X2 := X; + Y2 := Y; + end; + Codes1 := Codes2; + if ClipLine(X1, Y1, X2, Y2, ClipX1, ClipY1, ClipX2, ClipY2, @Codes2) then + begin + if Codes1 <> [] then + Canvas.MoveTo(Round(X1), Round(Y1)); + X := Round(X2); + Y := Round(Y2); + Canvas.LineTo(X, Y); + {$IFDEF VCL} + if Codes2 <> [] then + // Draw end point if necessary + Canvas.LineTo(X + 1, Y); + {$ENDIF VCL} + end; + with Points[I] do + begin + X1 := X; + Y1 := Y; + end; + end; +end; + +initialization + SetupFunctions; + if MMX_ACTIVE then + GenAlphaTable; + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + if MMX_ACTIVE then + FreeAlphaTable; + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/prototypes/JclGraphics.pas b/3rdParty/JCL/source/prototypes/JclGraphics.pas new file mode 100644 index 00000000..8e0a1a99 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/JclGraphics.pas @@ -0,0 +1,5814 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclGraphics.pas. } +{ } +{ The resampling algorithms and methods used in this library were adapted by Anders Melander from } +{ the article "General Filtered Image Rescaling" by Dale Schumacher which appeared in the book } +{ Graphics Gems III, published by Academic Press, Inc. Additional improvements were done by David } +{ Ullrich and Josha Beukema. } +{ } +{ (C)opyright 1997-1999 Anders Melander } +{ } +{ The Initial Developers of the Original Code are Alex Denissov, Wim De Cleen, Anders Melander } +{ and Mike Lischke. Portions created by these individuals are Copyright (C) of these individuals. } +{ All Rights Reserved. } +{ } +{ Contributors: } +{ Alexander Radchenko } +{ Charlie Calvert } +{ Marcel van Brakel } +{ Marcin Wieczorek } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Dejoy Den (dejoy) } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclGraphics; + +{$I jcl.inc} + +interface + +uses + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, System.Classes, System.SysUtils, Vcl.Graphics, Vcl.Controls, Vcl.Forms, + {$ELSE ~HAS_UNITSCOPE} + Windows, Classes, SysUtils, Graphics, Controls, Forms, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclGraphUtils, JclBase; + +type + EJclGraphicsError = class(EJclError); + + TDynDynIntegerArrayArray = array of TDynIntegerArray; + TDynPointArray = array of TPoint; + TDynDynPointArrayArray = array of TDynPointArray; + TPointF = record + X: Single; + Y: Single; + end; + TDynPointArrayF = array of TPointF; + + { TJclBitmap32 draw mode } + TDrawMode = (dmOpaque, dmBlend); + + { stretch filter } + TStretchFilter = (sfNearest, sfLinear, sfSpline); + + TConversionKind = (ckRed, ckGreen, ckBlue, ckAlpha, ckUniformRGB, ckWeightedRGB); + + { resampling support types } + TResamplingFilter = + (rfBox, rfTriangle, rfHermite, rfBell, rfSpline, rfLanczos3, rfMitchell); + + { Matrix declaration for transformation } + // modify Jan 28, 2001 for use under BCB5 + // the compiler show error 245 "language feature ist not available" + // we must take a record and under this we can use the static array + // Note: the sourcecode modify general from M[] to M.A[] !!!!! + // TMatrix3d = array [0..2, 0..2] of Extended; // 3x3 double precision + + TMatrix3d = record + A: array [0..2, 0..2] of Extended; + end; + + TDynDynPointArrayArrayF = array of TDynPointArrayF; + + TScanLine = array of Integer; + TScanLines = array of TScanLine; + + TLUT8 = array [Byte] of Byte; + TGamma = array [Byte] of Byte; + TColorChannel = (ccRed, ccGreen, ccBlue, ccAlpha); + + TGradientDirection = (gdVertical, gdHorizontal); + + TPolyFillMode = (fmAlternate, fmWinding); + TJclRegionCombineOperator = (coAnd, coDiff, coOr, coXor); + TJclRegionBitmapMode = (rmInclude, rmExclude); + TJclRegionKind = (rkNull, rkSimple, rkComplex, rkError); + +// modify Jan 28, 2001 for use under BCB5 +// the compiler show error 245 "language feature ist not available" +// wie must take a record and under this we can use the static array +// Note: for init the array we used initialisation at the end of this unit +// +// const +// IdentityMatrix: TMatrix3d = ( +// (1, 0, 0), +// (0, 1, 0), +// (0, 0, 1)); + +var + IdentityMatrix: TMatrix3d; + +// Classes +type + {$IFDEF VCL} + TJclDesktopCanvas = class(TCanvas) + private + FDesktop: HDC; + public + constructor Create; + destructor Destroy; override; + end; + + TJclRegion = class; + + TJclRegionInfo = class(TObject) + private + FData: Pointer; + FDataSize: Integer; + function GetBox: TRect; + protected + function GetCount: Integer; + function GetRect(index: Integer): TRect; + public + constructor Create(Region: TJclRegion); + destructor Destroy; override; + property Box: TRect read GetBox; + property Rectangles[Index: Integer]: TRect read GetRect; + property Count: Integer read GetCount; + end; + + TJclRegion = class(TObject) + private + FHandle: HRGN; + FBoxRect: TRect; + FRegionType: Integer; + FOwnsHandle: Boolean; + procedure CheckHandle; + protected + function GetHandle: HRGN; + function GetBox: TRect; + function GetRegionType: TJclRegionKind; + public + constructor Create(RegionHandle: HRGN; OwnsHandle: Boolean = True); + constructor CreateElliptic(const ARect: TRect); overload; + constructor CreateElliptic(const Top, Left, Bottom, Right: Integer); overload; + constructor CreatePoly(const Points: TDynPointArray; Count: Integer; FillMode: TPolyFillMode); + constructor CreatePolyPolygon(const Points: TDynPointArray; const Vertex: TDynIntegerArray; + Count: Integer; FillMode: TPolyFillMode); + constructor CreateRect(const ARect: TRect; DummyForBCB: Boolean = False); overload; + constructor CreateRect(const Top, Left, Bottom, Right: Integer; DummyForBCB: Byte = 0); overload; + constructor CreateRoundRect(const ARect: TRect; CornerWidth, CornerHeight: Integer); overload; + constructor CreateRoundRect(const Top, Left, Bottom, Right, CornerWidth, CornerHeight: Integer); overload; + constructor CreateBitmap(Bitmap: TBitmap; RegionColor: TColor; RegionBitmapMode: TJclRegionBitmapMode); + constructor CreatePath(Canvas: TCanvas); + constructor CreateRegionInfo(RegionInfo: TJclRegionInfo); + constructor CreateMapWindow(InitialRegion: TJclRegion; hWndFrom, hWndTo: THandle); overload; + constructor CreateMapWindow(InitialRegion: TJclRegion; ControlFrom, ControlTo: TWinControl); overload; + destructor Destroy; override; + procedure Clip(Canvas: TCanvas); + procedure Combine(DestRegion, SrcRegion: TJclRegion; CombineOp: TJclRegionCombineOperator); overload; + procedure Combine(SrcRegion: TJclRegion; CombineOp: TJclRegionCombineOperator); overload; + function Copy: TJclRegion; + function Equals(CompareRegion: TJclRegion): Boolean; {$IFDEF RTL200_UP} reintroduce; {$ENDIF RTL200_UP} + procedure Fill(Canvas: TCanvas); + procedure FillGradient(Canvas: TCanvas; ColorCount: Integer; StartColor, EndColor: TColor; ADirection: TGradientDirection); + procedure Frame(Canvas: TCanvas; FrameWidth, FrameHeight: Integer); + procedure Invert(Canvas: TCanvas); + procedure Offset(X, Y: Integer); + procedure Paint(Canvas: TCanvas); + function PointIn(X, Y: Integer): Boolean; overload; + function PointIn(const Point: TPoint): Boolean; overload; + function RectIn(const ARect: TRect): Boolean; overload; + function RectIn(Top, Left, Bottom, Right: Integer): Boolean; overload; + procedure SetWindow(Window: THandle; Redraw: Boolean); + function GetRegionInfo: TJclRegionInfo; + property Box: TRect read GetBox; + property Handle: HRGN read GetHandle; + property RegionType: TJclRegionKind read GetRegionType; + end; + {$ENDIF VCL} + + {$IFDEF Bitmap32} + { TJclThreadPersistent } + { TJclThreadPersistent is an ancestor for TJclBitmap32 object. In addition to + TPersistent methods, it provides thread-safe locking and change notification } + TJclThreadPersistent = class(TPersistent) + private + {$IFDEF VCL} + FLock: TRTLCriticalSection; + {$ELSE VCL} + FLock: TCriticalSection; + {$ENDIF VCL} + FLockCount: Integer; + FUpdateCount: Integer; + FOnChanging: TNotifyEvent; + FOnChange: TNotifyEvent; + protected + property LockCount: Integer read FLockCount; + property UpdateCount: Integer read FUpdateCount; + public + constructor Create; virtual; + destructor Destroy; override; + procedure Changing; virtual; + procedure Changed; virtual; + procedure BeginUpdate; + procedure EndUpdate; + procedure Lock; + procedure Unlock; + property OnChanging: TNotifyEvent read FOnChanging write FOnChanging; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + end; + + { TJclCustomMap } + { An ancestor for bitmaps and similar 2D distributions which have width and + height properties } + TJclCustomMap = class(TJclThreadPersistent) + private + FHeight: Integer; + FWidth: Integer; + procedure SetHeight(NewHeight: Integer); + procedure SetWidth(NewWidth: Integer); + public + procedure Delete; virtual; + function Empty: Boolean; virtual; + procedure SetSize(Source: TPersistent); overload; + procedure SetSize(NewWidth, NewHeight: Integer); overload; virtual; + property Height: Integer read FHeight write SetHeight; + property Width: Integer read FWidth write SetWidth; + end; + + { TJclBitmap32 } + { The TJclBitmap32 class is responsible for storage of a bitmap, as well as for drawing in it } + TJclBitmap32 = class(TJclCustomMap) + private + FBitmapInfo: TBitmapInfo; + FBits: PColor32Array; + FDrawMode: TDrawMode; + FFont: TFont; + FHandle: HBITMAP; + FHDC: HDC; + FMasterAlpha: Byte; + FOuterColor: TColor32; // the value returned when accessing outer areas + FPenColor: TColor32; + FStippleCounter: Single; + FStipplePattern: TArrayOfColor32; + FStippleStep: Single; + FStretchFilter: TStretchFilter; + FResetAlphaOnAssign: Boolean; + function GetPixel(X, Y: Integer): TColor32; + function GetPixelS(X, Y: Integer): TColor32; + function GetPixelPtr(X, Y: Integer): PColor32; + function GetScanLine(Y: Integer): PColor32Array; + procedure SetDrawMode(Value: TDrawMode); + procedure SetFont(Value: TFont); + procedure SetMasterAlpha(Value: Byte); + procedure SetPixel(X, Y: Integer; Value: TColor32); + procedure SetPixelS(X, Y: Integer; Value: TColor32); + procedure SetStippleStep(Value: Single); + procedure SetStretchFilter(Value: TStretchFilter); + protected + FontHandle: HFont; + RasterX: Integer; + RasterY: Integer; + RasterXF: Single; + RasterYF: Single; + procedure AssignTo(Dst: TPersistent); override; + function ClipLine(var X0, Y0, X1, Y1: Integer): Boolean; + class function ClipLineF(var X0, Y0, X1, Y1: Single; MinX, MaxX, MinY, MaxY: Single): Boolean; + procedure FontChanged(Sender: TObject); + procedure SET_T256(X, Y: Integer; C: TColor32); + procedure SET_TS256(X, Y: Integer; C: TColor32); + procedure ReadData(Stream: TStream); virtual; + procedure WriteData(Stream: TStream); virtual; + procedure DefineProperties(Filer: TFiler); override; + property StippleCounter: Single read FStippleCounter; + public + constructor Create; override; + destructor Destroy; override; + + procedure Assign(Source: TPersistent); override; + procedure SetSize(NewWidth, NewHeight: Integer); override; + function Empty: Boolean; override; + procedure Clear; overload; + procedure Clear(FillColor: TColor32); overload; + procedure Delete; override; + + procedure LoadFromStream(Stream: TStream); + procedure SaveToStream(Stream: TStream); + procedure LoadFromFile(const FileName: string); + procedure SaveToFile(const FileName: string); + + procedure ResetAlpha; + + procedure Draw(DstX, DstY: Integer; Src: TJclBitmap32); overload; + procedure Draw(DstRect, SrcRect: TRect; Src: TJclBitmap32); overload; + procedure Draw(DstRect, SrcRect: TRect; hSrc: HDC); overload; + + procedure DrawTo(Dst: TJclBitmap32); overload; + procedure DrawTo(Dst: TJclBitmap32; DstX, DstY: Integer); overload; + procedure DrawTo(Dst: TJclBitmap32; DstRect: TRect); overload; + procedure DrawTo(Dst: TJclBitmap32; DstRect, SrcRect: TRect); overload; + procedure DrawTo(hDst: HDC; DstX, DstY: Integer); overload; + procedure DrawTo(hDst: HDC; DstRect, SrcRect: TRect); overload; + + function GetPixelB(X, Y: Integer): TColor32; + procedure SetPixelT(X, Y: Integer; Value: TColor32); overload; + procedure SetPixelT(var Ptr: PColor32; Value: TColor32); overload; + procedure SetPixelTS(X, Y: Integer; Value: TColor32); + procedure SetPixelF(X, Y: Single; Value: TColor32); + procedure SetPixelFS(X, Y: Single; Value: TColor32); + + procedure SetStipple(NewStipple: TArrayOfColor32); overload; + procedure SetStipple(NewStipple: array of TColor32); overload; + procedure ResetStippleCounter; + function GetStippleColor: TColor32; + + procedure DrawHorzLine(X1, Y, X2: Integer; Value: TColor32); + procedure DrawHorzLineS(X1, Y, X2: Integer; Value: TColor32); + procedure DrawHorzLineT(X1, Y, X2: Integer; Value: TColor32); + procedure DrawHorzLineTS(X1, Y, X2: Integer; Value: TColor32); + procedure DrawHorzLineTSP(X1, Y, X2: Integer); + + procedure DrawVertLine(X, Y1, Y2: Integer; Value: TColor32); + procedure DrawVertLineS(X, Y1, Y2: Integer; Value: TColor32); + procedure DrawVertLineT(X, Y1, Y2: Integer; Value: TColor32); + procedure DrawVertLineTS(X, Y1, Y2: Integer; Value: TColor32); + procedure DrawVertLineTSP(X, Y1, Y2: Integer); + + procedure DrawLine(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean = False); + procedure DrawLineS(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean = False); + procedure DrawLineT(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean = False); + procedure DrawLineTS(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean = False); + procedure DrawLineA(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean = False); + procedure DrawLineAS(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean = False); + procedure DrawLineF(X1, Y1, X2, Y2: Single; Value: TColor32; L: Boolean = False); + procedure DrawLineFS(X1, Y1, X2, Y2: Single; Value: TColor32; L: Boolean = False); + procedure DrawLineFP(X1, Y1, X2, Y2: Single; L: Boolean = False); + procedure DrawLineFSP(X1, Y1, X2, Y2: Single; L: Boolean = False); + + procedure MoveTo(X, Y: Integer); + procedure LineToS(X, Y: Integer); + procedure LineToTS(X, Y: Integer); + procedure LineToAS(X, Y: Integer); + procedure MoveToF(X, Y: Single); + procedure LineToFS(X, Y: Single); + + procedure FillRect(X1, Y1, X2, Y2: Integer; Value: TColor32); + procedure FillRectS(X1, Y1, X2, Y2: Integer; Value: TColor32); + procedure FillRectT(X1, Y1, X2, Y2: Integer; Value: TColor32); + procedure FillRectTS(X1, Y1, X2, Y2: Integer; Value: TColor32); + + procedure FrameRectS(X1, Y1, X2, Y2: Integer; Value: TColor32); + procedure FrameRectTS(X1, Y1, X2, Y2: Integer; Value: TColor32); overload; + procedure FrameRectTSP(X1, Y1, X2, Y2: Integer); overload; + procedure RaiseRectTS(X1, Y1, X2, Y2: Integer; Contrast: Integer); + + procedure UpdateFont; + procedure TextOut(X, Y: Integer; const Text: string); overload; + procedure TextOut(X, Y: Integer; const ClipRect: TRect; const Text: string); overload; + procedure TextOut(ClipRect: TRect; const Flags: Cardinal; const Text: string); overload; + function TextExtent(const Text: string): TSize; + function TextHeight(const Text: string): Integer; + function TextWidth(const Text: string): Integer; + procedure RenderText(X, Y: Integer; const Text: string; AALevel: Integer; Color: TColor32); + + property BitmapHandle: HBITMAP read FHandle; + property BitmapInfo: TBitmapInfo read FBitmapInfo; + property Bits: PColor32Array read FBits; + property Font: TFont read FFont write SetFont; + property Handle: HDC read FHDC; + property PenColor: TColor32 read FPenColor write FPenColor; + property Pixel[X, Y: Integer]: TColor32 read GetPixel write SetPixel; default; + property PixelS[X, Y: Integer]: TColor32 read GetPixelS write SetPixelS; + property PixelPtr[X, Y: Integer]: PColor32 read GetPixelPtr; + property ScanLine[Y: Integer]: PColor32Array read GetScanLine; + property StippleStep: Single read FStippleStep write SetStippleStep; + published + property DrawMode: TDrawMode read FDrawMode write SetDrawMode default dmOpaque; + property MasterAlpha: Byte read FMasterAlpha write SetMasterAlpha default $FF; + property OuterColor: TColor32 read FOuterColor write FOuterColor default 0; + property StretchFilter: TStretchFilter read FStretchFilter write SetStretchFilter default sfNearest; + property ResetAlphaOnAssign: Boolean read FResetAlphaOnAssign write FResetAlphaOnAssign default true; + property OnChanging; + property OnChange; + end; + + TJclByteMap = class(TJclCustomMap) + private + FBytes: TDynByteArray; + FHeight: Integer; + FWidth: Integer; + function GetValue(X, Y: Integer): Byte; + function GetValPtr(X, Y: Integer): PByte; + procedure SetValue(X, Y: Integer; Value: Byte); + protected + procedure AssignTo(Dst: TPersistent); override; + public + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + function Empty: Boolean; override; + procedure Clear(FillValue: Byte); + procedure ReadFrom(Source: TJclBitmap32; Conversion: TConversionKind); + procedure SetSize(NewWidth, NewHeight: Integer); override; + procedure WriteTo(Dest: TJclBitmap32; Conversion: TConversionKind); overload; + procedure WriteTo(Dest: TJclBitmap32; const Palette: TPalette32); overload; + property Bytes: TDynByteArray read FBytes; + property ValPtr[X, Y: Integer]: PByte read GetValPtr; + property Value[X, Y: Integer]: Byte read GetValue write SetValue; default; + end; + {$ENDIF Bitmap32} + + TJclTransformation = class(TObject) + public + function GetTransformedBounds(const Src: TRect): TRect; virtual; abstract; + procedure PrepareTransform; virtual; abstract; + procedure Transform(DstX, DstY: Integer; out SrcX, SrcY: Integer); virtual; abstract; + procedure Transform256(DstX, DstY: Integer; out SrcX256, SrcY256: Integer); virtual; abstract; + end; + + TJclLinearTransformation = class(TJclTransformation) + private + FMatrix: TMatrix3d; + protected + A: Integer; + B: Integer; + C: Integer; + D: Integer; + E: Integer; + F: Integer; + public + constructor Create; virtual; + function GetTransformedBounds(const Src: TRect): TRect; override; + procedure PrepareTransform; override; + procedure Transform(DstX, DstY: Integer; out SrcX, SrcY: Integer); override; + procedure Transform256(DstX, DstY: Integer; out SrcX256, SrcY256: Integer); override; + procedure Clear; + procedure Rotate(Cx, Cy, Alpha: Extended); // degrees + procedure Skew(Fx, Fy: Extended); + procedure Scale(Sx, Sy: Extended); + procedure Translate(Dx, Dy: Extended); + property Matrix: TMatrix3d read FMatrix write FMatrix; + end; + +// Bitmap Functions +procedure Stretch(NewWidth, NewHeight: Cardinal; Filter: TResamplingFilter; + Radius: Single; Source: TGraphic; Target: TBitmap); overload; +procedure Stretch(NewWidth, NewHeight: Cardinal; Filter: TResamplingFilter; + Radius: Single; Bitmap: TBitmap); overload; + +{$IFDEF MSWINDOWS} +procedure DrawBitmap(DC: HDC; Bitmap: HBITMAP; X, Y, Width, Height: Integer); + +function ExtractIconCount(const FileName: string): Integer; +function BitmapToIcon(Bitmap: HBITMAP; cx, cy: Integer): HICON; overload; +function BitmapToIcon(Bitmap, Mask: HBITMAP; cx, cy: Integer): HICON; overload; +function IconToBitmap(Icon: HICON): HBITMAP; +{$ENDIF MSWINDOWS} + +{$IFDEF VCL} +procedure BitmapToJPeg(const FileName: string); +procedure JPegToBitmap(const FileName: string); + +{$IFDEF HAS_UNIT_GIFIMG} +procedure BitmapToGif(const FileName: string); +procedure GifToBitmap(const FileName: string); +{$ENDIF HAS_UNIT_GIFIMG} + +{$IFDEF HAS_UNIT_PNGIMAGE} +procedure BitmapToPng(const FileName: string); +procedure PngToBitmap(const FileName: string); +{$ENDIF HAS_UNIT_PNGIMAGE} + +procedure SaveIconToFile(Icon: HICON; const FileName: string); +procedure WriteIcon(Stream: TStream; ColorBitmap, MaskBitmap: HBITMAP; + WriteLength: Boolean = False); overload; +procedure WriteIcon(Stream: TStream; Icon: HICON; WriteLength: Boolean = False); overload; +procedure GetIconFromBitmap(Icon: TIcon; Bitmap: TBitmap); + +function GetAntialiasedBitmap(const Bitmap: TBitmap): TBitmap; +{$ENDIF VCL} + +{$IFDEF Bitmap32} +procedure BlockTransfer(Dst: TJclBitmap32; DstX: Integer; DstY: Integer; Src: TJclBitmap32; + SrcRect: TRect; CombineOp: TDrawMode); + +procedure StretchTransfer(Dst: TJclBitmap32; DstRect: TRect; Src: TJclBitmap32; SrcRect: TRect; + StretchFilter: TStretchFilter; CombineOp: TDrawMode); + +procedure Transform(Dst, Src: TJclBitmap32; SrcRect: TRect; Transformation: TJclTransformation); +procedure SetBorderTransparent(ABitmap: TJclBitmap32; ARect: TRect); +{$ENDIF Bitmap32} + +{$IFDEF MSWINDOWS} +function FillGradient(DC: HDC; ARect: TRect; ColorCount: Integer; + StartColor, EndColor: TColor; ADirection: TGradientDirection): Boolean; overload; +{$ENDIF MSWINDOWS} + +{$IFDEF VCL} +function CreateRegionFromBitmap(Bitmap: TBitmap; RegionColor: TColor; + RegionBitmapMode: TJclRegionBitmapMode; UseAlphaChannel: Boolean = False): HRGN; +procedure ScreenShot(bm: TBitmap; Left, Top, Width, Height: Integer; Window: THandle = HWND_DESKTOP); overload; +procedure ScreenShot(bm: TBitmap; IncludeTaskBar: Boolean = True); overload; +procedure ScreenShot(bm: TBitmap; FormToPrint: TCustomForm); overload; +function MapWindowRect(hWndFrom, hWndTo: THandle; ARect: TRect):TRect; +{$ENDIF VCL} + +{$IFDEF Bitmap32} +// PolyLines and Polygons +procedure PolyLineTS(Bitmap: TJclBitmap32; const Points: TDynPointArray; Color: TColor32); +procedure PolyLineAS(Bitmap: TJclBitmap32; const Points: TDynPointArray; Color: TColor32); +procedure PolyLineFS(Bitmap: TJclBitmap32; const Points: TDynPointArrayF; Color: TColor32); + +procedure PolygonTS(Bitmap: TJclBitmap32; const Points: TDynPointArray; Color: TColor32); +procedure PolygonAS(Bitmap: TJclBitmap32; const Points: TDynPointArray; Color: TColor32); +procedure PolygonFS(Bitmap: TJclBitmap32; const Points: TDynPointArrayF; Color: TColor32); + +procedure PolyPolygonTS(Bitmap: TJclBitmap32; const Points: TDynDynPointArrayArray; + Color: TColor32); +procedure PolyPolygonAS(Bitmap: TJclBitmap32; const Points: TDynDynPointArrayArray; + Color: TColor32); +procedure PolyPolygonFS(Bitmap: TJclBitmap32; const Points: TDynDynPointArrayArrayF; + Color: TColor32); + +// Filters +procedure AlphaToGrayscale(Dst, Src: TJclBitmap32); +procedure IntensityToAlpha(Dst, Src: TJclBitmap32); +procedure Invert(Dst, Src: TJclBitmap32); +procedure InvertRGB(Dst, Src: TJclBitmap32); +procedure ColorToGrayscale(Dst, Src: TJclBitmap32); +procedure ApplyLUT(Dst, Src: TJclBitmap32; const LUT: TLUT8); +procedure SetGamma(Gamma: Single = 0.7); +{$ENDIF Bitmap32} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\vcl'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.Math, + Winapi.CommCtrl, Winapi.ShellApi, + {$IFDEF HAS_UNIT_GIFIMG} + Vcl.Imaging.GifImg, + {$ENDIF HAS_UNIT_GIFIMG} + {$IFDEF HAS_UNIT_PNGIMAGE} + Vcl.Imaging.PngImage, + {$ENDIF HAS_UNIT_PNGIMAGE} + Vcl.ClipBrd, Vcl.Imaging.JPeg, System.TypInfo, + {$ELSE ~HAS_UNITSCOPE} + Math, + CommCtrl, ShellApi, + {$IFDEF HAS_UNIT_GIFIMG} + GifImg, + {$ENDIF HAS_UNIT_GIFIMG} + {$IFDEF HAS_UNIT_PNGIMAGE} + PngImage, + {$ENDIF HAS_UNIT_PNGIMAGE} + ClipBrd, JPeg, TypInfo, + {$ENDIF ~HAS_UNITSCOPE} + JclVclResources, + JclSysUtils, + JclLogic; + +type + PBGRAInt = ^TBGRAInt; + TBGRAInt = record + R: Integer; + G: Integer; + B: Integer; + A: Integer; + end; + + PBGRA = ^TBGRA; + TBGRA = packed record + B: Byte; + G: Byte; + R: Byte; + A: Byte; + end; + + TBitmapFilterFunction = function(Value: Single): Single; + + PContributor = ^TContributor; + TContributor = record + Weight: Integer; // Pixel Weight + Pixel: Integer; // Source Pixel + end; + + TContributors = array of TContributor; + + // list of source pixels contributing to a destination pixel + PContributorEntry = ^TContributorEntry; + TContributorEntry = record + N: Integer; + Contributors: TContributors; + end; + + TContributorList = array of TContributorEntry; + TJclGraphicAccess = class(TGraphic); + +const + DefaultFilterRadius: array [TResamplingFilter] of Single = + (0.5, 1.0, 1.0, 1.5, 2.0, 3.0, 2.0); + _RGB: TColor32 = $00FFFFFF; + +var + { Gamma bias for line/pixel antialiasing/shape correction } + GAMMA_TABLE: TGamma; + +type + TBGRAIntArray = array of TBGRAInt; + +//=== Helper functions ======================================================= + +function IntToByte(Value: Integer): Byte; {$IFDEF SUPPORTS_INLINE} inline;{$ENDIF} +begin + Result := 255; + if Value >= 0 then + begin + if Value <= 255 then + Result := Value; + end + else + Result := 0; +end; + +{$IFDEF Bitmap32} +procedure CheckBitmaps(Dst, Src: TJclBitmap32); +begin + if (Dst = nil) or Dst.Empty then + raise EJclGraphicsError.CreateRes(@RsDestinationBitmapEmpty); + if (Src = nil) or Src.Empty then + raise EJclGraphicsError.CreateRes(@RsSourceBitmapEmpty); +end; + +function CheckSrcRect(Src: TJclBitmap32; const SrcRect: TRect): Boolean; +begin + Result := False; + if IsRectEmpty(SrcRect) then + Exit; + if (SrcRect.Left < 0) or (SrcRect.Right > Src.Width) or + (SrcRect.Top < 0) or (SrcRect.Bottom > Src.Height) then + raise EJclGraphicsError.CreateRes(@RsSourceBitmapInvalid); + Result := True; +end; +{$ENDIF Bitmap32} + +//=== Internal low level routines ============================================ + +procedure FillLongword(var X; Count: Integer; Value: Longword); +var + P: PLongword; +begin + P := @X; + while Count > 0 do + begin + P^ := Value; + Inc(P); + Dec(Count); + end; +end; + +function Clamp(Value: Integer): TColor32; +begin + if Value < 0 then + Result := 0 + else + if Value > 255 then + Result := 255 + else + Result := Value; +end; + +procedure TestSwap(var A, B: Integer); +var + X: Integer; +begin + X := A; // optimization + if X > B then + begin + A := B; + B := X; + end; +end; + +function TestClip(var A, B: Integer; Size: Integer): Boolean; +begin + TestSwap(A, B); // now A = min(A,B) and B = max(A, B) + if A < 0 then + A := 0; + if B >= Size then + B := Size - 1; + Result := B >= A; +end; + +function Constrain(Value, Lo, Hi: Integer): Integer; +begin + if Value <= Lo then + Result := Lo + else + if Value >= Hi then + Result := Hi + else + Result := Value; +end; + +// Filter functions for stretching of TBitmaps +// f(t) = 2|t|^3 - 3|t|^2 + 1, -1 <= t <= 1 + +function BitmapHermiteFilter(Value: Single): Single; +begin + if Value < 0.0 then + Value := -Value; + if Value < 1 then + Result := (2 * Value - 3) * Sqr(Value) + 1 + else + Result := 0; +end; + +// This filter is also known as 'nearest neighbour' Filter. + +function BitmapBoxFilter(Value: Single): Single; +begin + if (Value > -0.5) and (Value <= 0.5) then + Result := 1.0 + else + Result := 0.0; +end; + +// aka 'linear' or 'bilinear' filter + +function BitmapTriangleFilter(Value: Single): Single; +begin + if Value < 0.0 then + Value := -Value; + if Value < 1.0 then + Result := 1.0 - Value + else + Result := 0.0; +end; + +function BitmapBellFilter(Value: Single): Single; +begin + if Value < 0.0 then + Value := -Value; + if Value < 0.5 then + Result := 0.75 - Sqr(Value) + else + if Value < 1.5 then + begin + Value := Value - 1.5; + Result := 0.5 * Sqr(Value); + end + else + Result := 0.0; +end; + +// B-spline filter + +function BitmapSplineFilter(Value: Single): Single; +var + Temp: Single; +begin + if Value < 0.0 then + Value := -Value; + if Value < 1.0 then + begin + Temp := Sqr(Value); + Result := 0.5 * Temp * Value - Temp + 2.0 / 3.0; + end + else + if Value < 2.0 then + begin + Value := 2.0 - Value; + Result := Sqr(Value) * Value / 6.0; + end + else + Result := 0.0; +end; + +function BitmapLanczos3Filter(Value: Single): Single; +const + OneThird = 1.0 / 3.0; + + function SinC(Value: Single): Single; + begin + if Value <> 0.0 then + begin + Value := Value * Pi; + Result := System.Sin(Value) / Value; + end + else + Result := 1.0; + end; + +begin + if Value < 0.0 then + Value := -Value; + if Value < 3.0 then + Result := SinC(Value) * SinC(Value * OneThird) + else + Result := 0.0; +end; + +function BitmapMitchellFilter(Value: Single): Single; +const + B = 1.0 / 3.0; + C = 1.0 / 3.0; + OneSixth = 1.0 / 6.0; +var + Temp: Single; +begin + if Value < 0.0 then + Value := -Value; + Temp := Sqr(Value); + if Value < 1.0 then + begin + Value := (((12.0 - 9.0 * B - 6.0 * C) * (Value * Temp)) + + ((-18.0 + 12.0 * B + 6.0 * C) * Temp) + + (6.0 - 2.0 * B)); + Result := Value * OneSixth; + end + else + if Value < 2.0 then + begin + Value := (((-B - 6.0 * C) * (Value * Temp)) + + ((6.0 * B + 30.0 * C) * Temp) + + ((-12.0 * B - 48.0 * C) * Value) + + (8.0 * B + 24.0 * C)); + Result := Value * OneSixth; + end + else + Result := 0.0; +end; + +const + FilterList: array [TResamplingFilter] of TBitmapFilterFunction = + ( + BitmapBoxFilter, + BitmapTriangleFilter, + BitmapHermiteFilter, + BitmapBellFilter, + BitmapSplineFilter, + BitmapLanczos3Filter, + BitmapMitchellFilter + ); + +procedure FillLineCacheHorz(N: Integer; Line: Pointer; const ACurrentLine: TBGRAIntArray); +var + Run: PBGRA; + Data: PBGRAInt; +begin + Run := Line; + Data := @ACurrentLine[0]; + Dec(N); + while N >= 0 do + begin + Data.B := Run.B; + Data.G := Run.G; + Data.R := Run.R; + Data.A := Run.A; + Inc(Run); + Inc(Data); + Dec(N); + end; +end; + +procedure FillLineCacheVert(N, Delta: Integer; Line: Pointer; const ACurrentLine: TBGRAIntArray); +var + Run: PBGRA; + Data: PBGRAInt; +begin + Run := Line; + Data := @ACurrentLine[0]; + Dec(N); + while N >= 0 do + begin + Data.B := Run.B; + Data.G := Run.G; + Data.R := Run.R; + Data.A := Run.A; + Inc(PByte(Run), Delta); + Inc(Data); + Dec(N); + end; +end; + +function ApplyContributors(Contributor: PContributorEntry; const ACurrentLine: TBGRAIntArray): TBGRA; +var + J: Integer; + RGB: TBGRAInt; + Total, Weight: Integer; + Contr: PContributor; + Data: PBGRAInt; +begin + Total := 0; + RGB.B := Total; // trick compiler into generating better code + RGB.G := Total; + RGB.R := Total; + RGB.A := Total; + Contr := @Contributor.Contributors[0]; + for J := 0 to Contributor.N - 1 do + begin + Weight := Contr.Weight; + Inc(Total, Weight); + Data := @ACurrentLine[Contr.Pixel]; + Inc(RGB.R, Data.R * Weight); + Inc(RGB.G, Data.G * Weight); + Inc(RGB.B, Data.B * Weight); + Inc(RGB.A, Data.A * Weight); + Inc(Contr); + end; + + if Total <> 0 then + begin + Result.B := IntToByte(RGB.B div Total); + Result.G := IntToByte(RGB.G div Total); + Result.R := IntToByte(RGB.R div Total); + Result.A := IntToByte(RGB.A div Total); + end + else + begin + Result.B := IntToByte(RGB.B shr 8); + Result.G := IntToByte(RGB.G shr 8); + Result.R := IntToByte(RGB.R shr 8); + Result.A := IntToByte(RGB.A shr 8); + end; +end; + +// This is the actual scaling routine. Target must be allocated already with +// sufficient size. Source must contain valid data, Radius must not be 0 and +// Filter must not be nil. + +procedure DoStretch(Filter: TBitmapFilterFunction; Radius: Single; Source, Target: TBitmap); +var + ScaleX, ScaleY: Single; // Zoom scale factors + I, J, K, N: Integer; // Loop variables + Center: Single; // Filter calculation variables + Width: Single; + Weight: Integer; // Filter calculation variables + Left, Right: Integer; // Filter calculation variables + Work: TBitmap; + ContributorList: TContributorList; + SourceLine, DestLine: PBGRA; + DestPixel: PBGRA; + Delta, DestDelta: Integer; + SourceHeight, SourceWidth: Integer; + TargetHeight, TargetWidth: Integer; + CurrentLine: TBGRAIntArray; +begin + // shortcut variables + SourceHeight := Source.Height; + SourceWidth := Source.Width; + TargetHeight := Target.Height; + TargetWidth := Target.Width; + // create intermediate image to hold horizontal zoom + Work := TBitmap.Create; + try + Work.PixelFormat := pf32bit; + Work.Height := SourceHeight; + Work.Width := TargetWidth; + if SourceWidth = 1 then + ScaleX := TargetWidth / SourceWidth + else + ScaleX := (TargetWidth - 1) / (SourceWidth - 1); + if SourceHeight = 1 then + ScaleY := TargetHeight / SourceHeight + else + ScaleY := (TargetHeight - 1) / (SourceHeight - 1); + + // pre-calculate filter contributions for a row + SetLength(ContributorList, TargetWidth); + // horizontal sub-sampling + if ScaleX < 1 then + begin + // scales from bigger to smaller Width + Width := Radius / ScaleX; + for I := 0 to TargetWidth - 1 do + begin + ContributorList[I].N := 0; + Center := I / ScaleX; + Left := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Math.Floor(Center - Width); + Right := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Math.Ceil(Center + Width); + SetLength(ContributorList[I].Contributors, Right - Left + 1); + for J := Left to Right do + begin + Weight := Round(Filter((Center - J) * ScaleX) * ScaleX * 256); + if Weight <> 0 then + begin + if J < 0 then + N := -J + else + if J >= SourceWidth then + N := SourceWidth - J + SourceWidth - 1 + else + N := J; + K := ContributorList[I].N; + Inc(ContributorList[I].N); + ContributorList[I].Contributors[K].Pixel := N; + ContributorList[I].Contributors[K].Weight := Weight; + end; + end; + end; + end + else + begin + // horizontal super-sampling + // scales from smaller to bigger Width + for I := 0 to TargetWidth - 1 do + begin + ContributorList[I].N := 0; + Center := I / ScaleX; + Left := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Math.Floor(Center - Radius); + Right := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Math.Ceil(Center + Radius); + SetLength(ContributorList[I].Contributors, Right - Left + 1); + for J := Left to Right do + begin + Weight := Round(Filter(Center - J) * 256); + if Weight <> 0 then + begin + if J < 0 then + N := -J + else + if J >= SourceWidth then + N := SourceWidth - J + SourceWidth - 1 + else + N := J; + K := ContributorList[I].N; + Inc(ContributorList[I].N); + ContributorList[I].Contributors[K].Pixel := N; + ContributorList[I].Contributors[K].Weight := Weight; + end; + end; + end; + end; + + if SourceWidth > SourceHeight then + SetLength(CurrentLine, SourceWidth) + else + SetLength(CurrentLine, SourceHeight); + + // now apply filter to sample horizontally from Src to Work + for K := 0 to SourceHeight - 1 do + begin + SourceLine := Source.ScanLine[K]; + FillLineCacheHorz(SourceWidth, SourceLine, CurrentLine); + DestPixel := Work.ScanLine[K]; + for I := 0 to TargetWidth - 1 do + begin + DestPixel^ := ApplyContributors(@ContributorList[I], CurrentLine); + // move on to next column + Inc(DestPixel); + end; + end; + + // free the memory allocated for horizontal filter weights, since we need + // the structure again + for I := 0 to TargetWidth - 1 do + ContributorList[I].Contributors := nil; + ContributorList := nil; + + // pre-calculate filter contributions for a column + SetLength(ContributorList, TargetHeight); + // vertical sub-sampling + if ScaleY < 1 then + begin + // scales from bigger to smaller height + Width := Radius / ScaleY; + for I := 0 to TargetHeight - 1 do + begin + ContributorList[I].N := 0; + Center := I / ScaleY; + Left := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Math.Floor(Center - Width); + Right := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Math.Ceil(Center + Width); + SetLength(ContributorList[I].Contributors, Right - Left + 1); + for J := Left to Right do + begin + Weight := Round(Filter((Center - J) * ScaleY) * ScaleY * 256); + if Weight <> 0 then + begin + if J < 0 then + N := -J + else + if J >= SourceHeight then + N := SourceHeight - J + SourceHeight - 1 + else + N := J; + K := ContributorList[I].N; + Inc(ContributorList[I].N); + ContributorList[I].Contributors[K].Pixel := N; + ContributorList[I].Contributors[K].Weight := Weight; + end; + end; + end; + end + else + begin + // vertical super-sampling + // scales from smaller to bigger height + for I := 0 to TargetHeight - 1 do + begin + ContributorList[I].N := 0; + Center := I / ScaleY; + Left := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Math.Floor(Center - Radius); + Right := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Math.Ceil(Center + Radius); + SetLength(ContributorList[I].Contributors, Right - Left + 1); + for J := Left to Right do + begin + Weight := Round(Filter(Center - J) * 256); + if Weight <> 0 then + begin + if J < 0 then + N := -J + else + if J >= SourceHeight then + N := SourceHeight - J + SourceHeight - 1 + else + N := J; + K := ContributorList[I].N; + Inc(ContributorList[I].N); + ContributorList[I].Contributors[K].Pixel := N; + ContributorList[I].Contributors[K].Weight := Weight; + end; + end; + end; + end; + + // apply filter to sample vertically from Work to Target + SourceLine := Work.ScanLine[0]; + Delta := PAnsiChar(Work.ScanLine[1]) - PAnsiChar(SourceLine); // don't use TJclAddr here because of IntOverflow + DestLine := Target.ScanLine[0]; + DestDelta := PAnsiChar(Target.ScanLine[1]) - PAnsiChar(DestLine); // don't use TJclAddr here because of IntOverflow + for K := 0 to TargetWidth - 1 do + begin + DestPixel := Pointer(DestLine); + FillLineCacheVert(SourceHeight, Delta, SourceLine, CurrentLine); + for I := 0 to TargetHeight - 1 do + begin + DestPixel^ := ApplyContributors(@ContributorList[I], CurrentLine); + // move on to next row + Inc(INT_PTR(DestPixel), DestDelta); + end; + Inc(SourceLine); + Inc(DestLine); + end; + + // free the memory allocated for vertical filter weights + for I := 0 to TargetHeight - 1 do + ContributorList[I].Contributors := nil; + // this one is done automatically on exit, but is here for completeness + ContributorList := nil; + + finally + Work.Free; + Target.Modified := True; + end; +end; + +// Filter functions for TJclBitmap32 +type + TPointRec = record + Pos: Integer; + Weight: Integer; + end; + TCluster = array of TPointRec; + TMappingTable = array of TCluster; + TFilterFunc = function(Value: Extended): Extended; + +function NearestFilter(Value: Extended): Extended; +begin + if (Value > -0.5) and (Value <= 0.5) then + Result := 1 + else + Result := 0; +end; + +function LinearFilter(Value: Extended): Extended; +begin + if Value < -1 then + Result := 0 + else + if Value < 0 then + Result := 1 + Value + else + if Value < 1 then + Result := 1 - Value + else + Result := 0; +end; + +function SplineFilter(Value: Extended): Extended; +var + tt: Extended; +begin + Value := Abs(Value); + if Value < 1 then + begin + tt := Sqr(Value); + Result := 0.5 * tt * Value - tt + 2 / 3; + end + else + if Value < 2 then + begin + Value := 2 - Value; + Result := 1 / 6 * Sqr(Value) * Value; + end + else + Result := 0; +end; + +function BuildMappingTable(DstWidth, SrcFrom, SrcWidth: Integer; + StretchFilter: TStretchFilter): TMappingTable; +const + FILTERS: array [TStretchFilter] of TFilterFunc = + (NearestFilter, LinearFilter, SplineFilter); +var + Filter: TFilterFunc; + FilterWidth: Extended; + Scale, OldScale: Extended; + Center: Extended; + Bias: Extended; + Left, Right: Integer; + I, J, K: Integer; + Weight: Integer; +begin + if SrcWidth = 0 then + begin + Result := nil; + Exit; + end; + Filter := FILTERS[StretchFilter]; + if StretchFilter in [sfNearest, sfLinear] then + FilterWidth := 1 + else + FilterWidth := 1.5; + SetLength(Result, DstWidth); + Scale := (DstWidth - 1) / (SrcWidth - 1); + + if Scale < 1 then + begin + OldScale := Scale; + Scale := 1 / Scale; + FilterWidth := FilterWidth * Scale; + for I := 0 to DstWidth - 1 do + begin + Center := I * Scale; + Left := Floor(Center - FilterWidth); + Right := Ceil(Center + FilterWidth); + Bias := 0; + for J := Left to Right do + begin + Weight := Round(255 * Filter((Center - J) * OldScale) * OldScale); + if Weight <> 0 then + begin + Bias := Bias + Weight / 255; + K := Length(Result[I]); + SetLength(Result[I], K + 1); + Result[I][K].Pos := Constrain(J + SrcFrom, 0, SrcWidth - 1); + Result[I][K].Weight := Weight; + end; + end; + if (Bias > 0) and (Bias <> 1) then + begin + Bias := 1 / Bias; + for K := 0 to High(Result[I]) do + Result[I][K].Weight := Round(Result[I][K].Weight * Bias); + end; + end; + end + else + begin + FilterWidth := 1 / FilterWidth; + Scale := 1 / Scale; + for I := 0 to DstWidth - 1 do + begin + Center := I * Scale; + Left := Floor(Center - FilterWidth); + Right := Ceil(Center + FilterWidth); + for J := Left to Right do + begin + Weight := Round(255 * Filter(Center - J)); + if Weight <> 0 then + begin + K := Length(Result[I]); + SetLength(Result[I], K + 1); + Result[I][K].Pos := Constrain(J + SrcFrom, 0, SrcWidth - 1); + Result[I][K].Weight := Weight; + end; + end; + end; + end; +end; + +// Bitmap Functions +// Scales the source graphic to the given size (NewWidth, NewHeight) and stores the Result in Target. +// Filter describes the filter function to be applied and Radius the size of the filter area. +// Is Radius = 0 then the recommended filter area will be used (see DefaultFilterRadius). + +procedure Stretch(NewWidth, NewHeight: Cardinal; Filter: TResamplingFilter; + Radius: Single; Source: TGraphic; Target: TBitmap); +var + Temp: TBitmap; + OriginalPixelFormat: TPixelFormat; +begin + if Source.Empty then + Exit; // do nothing + + if Radius = 0 then + Radius := DefaultFilterRadius[Filter]; + + Temp := TBitmap.Create; + try + // To allow Source = Target, the following assignment needs to be done initially + Temp.Assign(Source); + Temp.PixelFormat := pf32bit; + OriginalPixelFormat := Target.PixelFormat; //Save format + + Target.FreeImage; + Target.PixelFormat := pf32bit; + Target.Width := NewWidth; + Target.Height := NewHeight; + + {$IFDEF VCL}if not Target.Empty then{$ENDIF VCL} + DoStretch(FilterList[Filter], Radius, Temp, Target); + + Target.PixelFormat := OriginalPixelFormat; //Restore original PixelFormat + finally + Temp.Free; + end; +end; + +procedure Stretch(NewWidth, NewHeight: Cardinal; Filter: TResamplingFilter; + Radius: Single; Bitmap: TBitmap); +begin + Stretch(NewWidth, NewHeight, Filter, Radius, Bitmap, Bitmap); +end; + +{$IFDEF Bitmap32} +procedure StretchNearest(Dst: TJclBitmap32; DstRect: TRect; + Src: TJclBitmap32; SrcRect: TRect; CombineOp: TDrawMode); +var + SrcW, SrcH, DstW, DstH: Integer; + MapX, MapY: array of Integer; + DstX, DstY: Integer; + R: TRect; + I, J, Y: Integer; + P: PColor32; + MstrAlpha: TColor32; +begin + // check source and destination + CheckBitmaps(Dst, Src); + if not CheckSrcRect(Src, SrcRect) then + Exit; + if IsRectEmpty(DstRect) then + Exit; + IntersectRect(R, DstRect, Rect(0, 0, Dst.Width, Dst.Height)); + if IsRectEmpty(R) then + Exit; + if (CombineOp = dmBlend) and (Src.MasterAlpha = 0) then + Exit; + + SrcW := SrcRect.Right - SrcRect.Left; + SrcH := SrcRect.Bottom - SrcRect.Top; + DstW := DstRect.Right - DstRect.Left; + DstH := DstRect.Bottom - DstRect.Top; + DstX := DstRect.Left; + DstY := DstRect.Top; + + // check if we actually have to stretch anything + if (SrcW = DstW) and (SrcH = DstH) then + begin + BlockTransfer(Dst, DstX, DstY, Src, SrcRect, CombineOp); + Exit; + end; + + // build X coord mapping table + SetLength(MapX, DstW); + SetLength(MapY, DstH); + + try + for I := 0 to DstW - 1 do + MapX[I] := I * (SrcW) div (DstW) + SrcRect.Left; + + // build Y coord mapping table + for J := 0 to DstH - 1 do + MapY[J] := J * (SrcH) div (DstH) + SrcRect.Top; + + // transfer pixels + case CombineOp of + dmOpaque: + for J := R.Top to R.Bottom - 1 do + begin + Y := MapY[J - DstY]; + P := Dst.PixelPtr[R.Left, J]; + for I := R.Left to R.Right - 1 do + begin + P^ := Src[MapX[I - DstX], Y]; + Inc(P); + end; + end; + dmBlend: + begin + MstrAlpha := Src.MasterAlpha; + if MstrAlpha = 255 then + for J := R.Top to R.Bottom - 1 do + begin + Y := MapY[J - DstY]; + P := Dst.PixelPtr[R.Left, J]; + for I := R.Left to R.Right - 1 do + begin + BlendMem(Src[MapX[I - DstX], Y], P^); + Inc(P); + end; + end + else // Master Alpha is in [1..254] range + for J := R.Top to R.Bottom - 1 do + begin + Y := MapY[J - DstY]; + P := Dst.PixelPtr[R.Left, J]; + for I := R.Left to R.Right - 1 do + begin + BlendMemEx(Src[MapX[I - DstX], Y], P^, MstrAlpha); + Inc(P); + end; + end; + end; + end; + finally + EMMS; + MapX := nil; + MapY := nil; + end; +end; + +procedure BlockTransfer(Dst: TJclBitmap32; DstX: Integer; DstY: Integer; Src: TJclBitmap32; + SrcRect: TRect; CombineOp: TDrawMode); +var + SrcX, SrcY: Integer; + S, D: TRect; + J, N: Integer; + Ps, Pd: PColor32; + MstrAlpha: TColor32; +begin + CheckBitmaps(Src, Dst); + if CombineOp = dmOpaque then + begin + BitBlt(Dst.Handle, DstX, DstY, SrcRect.Right - SrcRect.Left, + SrcRect.Bottom - SrcRect.Top, Src.Handle, SrcRect.Left, SrcRect.Top, + SRCCOPY); + Exit; + end; + + if Src.MasterAlpha = 0 then + Exit; + + // clip the rectangles with bitmap boundaries + SrcX := SrcRect.Left; + SrcY := SrcRect.Top; + IntersectRect(S, SrcRect, Rect(0, 0, Src.Width, Src.Height)); + OffsetRect(S, DstX - SrcX, DstY - SrcY); + IntersectRect(D, S, Rect(0, 0, Dst.Width, Dst.Height)); + if IsRectEmpty(D) then + Exit; + + MstrAlpha := Src.MasterAlpha; + N := D.Right - D.Left; + + try + if MstrAlpha = 255 then + for J := D.Top to D.Bottom - 1 do + begin + Ps := Src.PixelPtr[D.Left + SrcX - DstX, J + SrcY - DstY]; + Pd := Dst.PixelPtr[D.Left, J]; + BlendLine(Ps, Pd, N); + end + else + for J := D.Top to D.Bottom - 1 do + begin + Ps := Src.PixelPtr[D.Left + SrcX - DstX, J + SrcY - DstY]; + Pd := Dst.PixelPtr[D.Left, J]; + BlendLineEx(Ps, Pd, N, MstrAlpha); + end; + finally + EMMS; + end; +end; + +procedure StretchTransfer(Dst: TJclBitmap32; DstRect: TRect; Src: TJclBitmap32; SrcRect: TRect; + StretchFilter: TStretchFilter; CombineOp: TDrawMode); +var + SrcW, SrcH, DstW, DstH: Integer; + MapX, MapY: TMappingTable; + DstX, DstY: Integer; + R: TRect; + I, J, X, Y: Integer; + P: PColor32; + ClusterX, ClusterY: TCluster; + C, Wt, Cr, Cg, Cb, Ca: Integer; + MstrAlpha: TColor32; +begin + // make compiler happy + MapX := nil; + MapY := nil; + ClusterX := nil; + ClusterY := nil; + + if StretchFilter = sfNearest then + begin + StretchNearest(Dst, DstRect, Src, SrcRect, CombineOp); + Exit; + end; + + // check source and destination + CheckBitmaps(Dst, Src); + if not CheckSrcRect(Src, SrcRect) then + Exit; + if IsRectEmpty(DstRect) then + Exit; + IntersectRect(R, DstRect, Rect(0, 0, Dst.Width, Dst.Height)); + if IsRectEmpty(R) then + Exit; + if (CombineOp = dmBlend) and (Src.MasterAlpha = 0) then + Exit; + + SrcW := SrcRect.Right - SrcRect.Left; + SrcH := SrcRect.Bottom - SrcRect.Top; + DstW := DstRect.Right - DstRect.Left; + DstH := DstRect.Bottom - DstRect.Top; + DstX := DstRect.Left; + DstY := DstRect.Top; + MstrAlpha := Src.MasterAlpha; + + // check if we actually have to stretch anything + if (SrcW = DstW) and (SrcH = DstH) then + begin + BlockTransfer(Dst, DstX, DstY, Src, SrcRect, CombineOp); + Exit; + end; + + // mapping tables + MapX := BuildMappingTable(DstW, SrcRect.Left, SrcW, StretchFilter); + MapY := BuildMappingTable(DstH, SrcRect.Top, SrcH, StretchFilter); + try + ClusterX := nil; + ClusterY := nil; + if (MapX = nil) or (MapY = nil) then + Exit; + + // transfer pixels + for J := R.Top to R.Bottom - 1 do + begin + ClusterY := MapY[J - DstY]; + P := Dst.PixelPtr[R.Left, J]; + for I := R.Left to R.Right - 1 do + begin + ClusterX := MapX[I - DstX]; + + // reset color accumulators + Ca := 0; + Cr := 0; + Cg := 0; + Cb := 0; + + // now iterate through each cluster + for Y := 0 to High(ClusterY) do + for X := 0 to High(ClusterX) do + begin + C := Src[ClusterX[X].Pos, ClusterY[Y].Pos]; + Wt := ClusterX[X].Weight * ClusterY[Y].Weight; + Inc(Ca, C shr 24 * Wt); + Inc(Cr, (C and $00FF0000) shr 16 * Wt); + Inc(Cg, (C and $0000FF00) shr 8 * Wt); + Inc(Cb, (C and $000000FF) * Wt); + end; + Ca := Ca and $00FF0000; + Cr := Cr and $00FF0000; + Cg := Cg and $00FF0000; + Cb := Cb and $00FF0000; + C := (Ca shl 8) or Cr or (Cg shr 8) or (Cb shr 16); + + // combine it with the background + case CombineOp of + dmOpaque: + P^ := C; + dmBlend: + BlendMemEx(C, P^, MstrAlpha); + end; + Inc(P); + end; + end; + finally + EMMS; + MapX := nil; + MapY := nil; + end; +end; +{$ENDIF Bitmap32} + +{$IFDEF MSWINDOWS} +procedure DrawBitmap(DC: HDC; Bitmap: HBITMAP; X, Y, Width, Height: Integer); +var + MemDC: HDC; + OldBitmap: HBITMAP; +begin + MemDC := CreateCompatibleDC(DC); + OldBitmap := SelectObject(MemDC, Bitmap); + BitBlt(DC, X, Y, Width, Height, MemDC, 0, 0, SRCCOPY); + SelectObject(MemDC, OldBitmap); + DeleteObject(MemDC); +end; +{$ENDIF MSWINDOWS} + +{$IFDEF VCL} +{ TODO : remove VCL-dependency by replacing pf24bit by pf32bit } + +function GetAntialiasedBitmap(const Bitmap: TBitmap): TBitmap; +var + Antialias: TBitmap; + X, Y: Integer; + Line1, Line2, Line: PJclByteArray; +begin + Assert(Bitmap <> nil); + if Bitmap.PixelFormat <> pf24bit then + Bitmap.PixelFormat := pf24bit; + Antialias := TBitmap.Create; + with Bitmap do + begin + Antialias.PixelFormat := pf24bit; + Antialias.Width := Width div 2; + Antialias.Height := Height div 2; + for Y := 0 to Antialias.Height - 1 do + begin + Line1 := ScanLine[Y * 2]; + Line2 := ScanLine[Y * 2 + 1]; + Line := Antialias.ScanLine[Y]; + for X := 0 to Antialias.Width - 1 do + begin + Line[X * 3] := (Integer(Line1[X * 6]) + Integer(Line2[X * 6]) + + Integer(Line1[X * 6 + 3]) + Integer(Line2[X * 6 + 3])) div 4; + Line[X * 3 + 1] := (Integer(Line1[X * 6 + 1]) + Integer(Line2[X * 6 + 1]) + + Integer(Line1[X * 6 + 3 + 1]) + Integer(Line2[X * 6 + 3 + 1])) div 4; + Line[X * 3 + 2] := (Integer(Line1[X * 6 + 2]) + Integer(Line2[X * 6 + 2]) + + Integer(Line1[X * 6 + 3 + 2]) + Integer(Line2[X * 6 + 3 + 2])) div 4; + end; + end; + end; + Result := Antialias; +end; + +procedure ImgToBitmap(const FileName: string; GraphicClass: TGraphicClass); +var + Bitmap: TBitmap; + Img: TGraphic; +begin + Bitmap := nil; + Img := nil; + try + Img := GraphicClass.Create; + Img.LoadFromFile(FileName); + Bitmap := TBitmap.Create; + Bitmap.Assign(Img); + Bitmap.SaveToFile(ChangeFileExt(FileName, LoadResString(@RsBitmapExtension))); + finally + Bitmap.Free; + Img.Free; + end; +end; + +procedure BitmapToImg(const FileName, FileExtension: string; GraphicClass: TGraphicClass); +var + Bitmap: TBitmap; + Img: TGraphic; +begin + Bitmap := nil; + Img := nil; + try + Bitmap := TBitmap.Create; + Bitmap.LoadFromFile(FileName); + Img := GraphicClass.Create; + Img.Assign(Bitmap); + Img.SaveToFile(ChangeFileExt(FileName, FileExtension)); + finally + Bitmap.Free; + Img.Free; + end; +end; + +procedure JPegToBitmap(const FileName: string); +begin + ImgToBitmap(FileName, TJPegImage); +end; + +procedure BitmapToJPeg(const FileName: string); +begin + BitmapToImg(FileName, LoadResString(@RsJpegExtension), TJPEGImage); +end; + +{$IFDEF HAS_UNIT_GIFIMG} +procedure GifToBitmap(const FileName: string); +begin + ImgToBitmap(FileName, TGifImage); +end; + +procedure BitmapToGif(const FileName: string); +begin + BitmapToImg(FileName, LoadResString(@RsGifExtension), TGifImage); +end; +{$ENDIF HAS_UNIT_GIFIMG} + +{$IFDEF HAS_UNIT_PNGIMAGE} +procedure PngToBitmap(const FileName: string); +begin + ImgToBitmap(FileName, TPngImage); +end; + +procedure BitmapToPng(const FileName: string); +begin + BitmapToImg(FileName, LoadResString(@RsPngExtension), TPngImage); +end; +{$ENDIF HAS_UNIT_PNGIMAGE} +{$ENDIF VCL} + +{$IFDEF MSWINDOWS} +function ExtractIconCount(const FileName: string): Integer; +begin + Result := ExtractIcon(HInstance, PChar(FileName), $FFFFFFFF); +end; + +function BitmapToIcon(Bitmap: HBITMAP; cx, cy: Integer): HICON; +var + ImgList: HIMAGELIST; + I: Integer; +begin + ImgList := ImageList_Create(cx, cy, ILC_COLOR, 1, 1); + try + I := ImageList_Add(ImgList, Bitmap, 0); + Result := ImageList_GetIcon(ImgList, I, ILD_NORMAL); + finally + ImageList_Destroy(ImgList); + end; +end; + +function BitmapToIcon(Bitmap, Mask: HBITMAP; cx, cy: Integer): HICON; +var + ImgList: HIMAGELIST; + I: Integer; +begin + ImgList := ImageList_Create(cx, cy, ILC_COLOR, 1, 1); + try + I := ImageList_Add(ImgList, Bitmap, Mask); + Result := ImageList_GetIcon(ImgList, I, ILD_TRANSPARENT); + finally + ImageList_Destroy(ImgList); + end; +end; + +function IconToBitmap(Icon: HICON): HBITMAP; +var + IconInfo: TIconInfo; +begin + Result := 0; + if GetIconInfo(Icon, IconInfo) then + begin + DeleteObject(IconInfo.hbmMask); + Result := IconInfo.hbmColor; + end; +end; +{$ENDIF MSWINDOWS} + +{$IFDEF VCL} +procedure GetIconFromBitmap(Icon: TIcon; Bitmap: TBitmap); +var + IconInfo: TIconInfo; +begin + with TBitmap.Create do + try + Assign(Bitmap); + if not Transparent then + TransparentColor := clNone; + IconInfo.fIcon := True; + IconInfo.hbmMask := MaskHandle; + IconInfo.hbmColor := Handle; + Icon.Handle := CreateIconIndirect(IconInfo); + finally + Free; + end; +end; + +const + rc3_Icon = 1; + +type + PCursorOrIcon = ^TCursorOrIcon; + TCursorOrIcon = packed record + Reserved: Word; + wType: Word; + Count: Word; + end; + + PIconRec = ^TIconRec; + TIconRec = packed record + Width: Byte; + Height: Byte; + Colors: Word; + Reserved1: Word; + Reserved2: Word; + DIBSize: Longint; + DIBOffset: Longint; + end; + +procedure WriteIcon(Stream: TStream; ColorBitmap, MaskBitmap: HBITMAP; WriteLength: Boolean = False); +var + MonoInfoSize, ColorInfoSize: DWORD; + MonoBitsSize, ColorBitsSize: DWORD; + MonoInfo, MonoBits, ColorInfo, ColorBits: Pointer; + CI: TCursorOrIcon; + List: TIconRec; + Length: Longint; +begin + ResetMemory(CI, SizeOf(CI)); + ResetMemory(List, SizeOf(List)); + GetDIBSizes(MaskBitmap, MonoInfoSize, MonoBitsSize); + GetDIBSizes(ColorBitmap, ColorInfoSize, ColorBitsSize); + MonoInfo := nil; + MonoBits := nil; + ColorInfo := nil; + ColorBits := nil; + try + MonoInfo := AllocMem(MonoInfoSize); + MonoBits := AllocMem(MonoBitsSize); + ColorInfo := AllocMem(ColorInfoSize); + ColorBits := AllocMem(ColorBitsSize); + GetDIB(MaskBitmap, 0, MonoInfo^, MonoBits^); + GetDIB(ColorBitmap, 0, ColorInfo^, ColorBits^); + if WriteLength then + begin + Length := SizeOf(CI) + SizeOf(List) + ColorInfoSize + + ColorBitsSize + MonoBitsSize; + Stream.Write(Length, SizeOf(Length)); + end; + with CI do + begin + CI.wType := RC3_ICON; + CI.Count := 1; + end; + Stream.Write(CI, SizeOf(CI)); + with List, PBitmapInfoHeader(ColorInfo)^ do + begin + Width := biWidth; + Height := biHeight; + Colors := biPlanes * biBitCount; + DIBSize := ColorInfoSize + ColorBitsSize + MonoBitsSize; + DIBOffset := SizeOf(CI) + SizeOf(List); + end; + Stream.Write(List, SizeOf(List)); + with PBitmapInfoHeader(ColorInfo)^ do + Inc(biHeight, biHeight); { color height includes mono bits } + Stream.Write(ColorInfo^, ColorInfoSize); + Stream.Write(ColorBits^, ColorBitsSize); + Stream.Write(MonoBits^, MonoBitsSize); + finally + FreeMem(ColorInfo, ColorInfoSize); + FreeMem(ColorBits, ColorBitsSize); + FreeMem(MonoInfo, MonoInfoSize); + FreeMem(MonoBits, MonoBitsSize); + end; +end; + +// WriteIcon depends on unit Graphics by use of GetDIBSizes and GetDIB + +procedure WriteIcon(Stream: TStream; Icon: HICON; WriteLength: Boolean = False); +var + IconInfo: TIconInfo; +begin + if GetIconInfo(Icon, IconInfo) then + try + WriteIcon(Stream, IconInfo.hbmColor, IconInfo.hbmMask, WriteLength); + finally + DeleteObject(IconInfo.hbmColor); + DeleteObject(IconInfo.hbmMask); + end + else + RaiseLastOSError; +end; + +procedure SaveIconToFile(Icon: HICON; const FileName: string); +var + Stream: TFileStream; +begin + Stream := TFileStream.Create(FileName, fmCreate); + try + WriteIcon(Stream, Icon, False); + finally + Stream.Free; + end; +end; +{$ENDIF VCL} + +{$IFDEF Bitmap32} +procedure Transform(Dst, Src: TJclBitmap32; SrcRect: TRect; + Transformation: TJclTransformation); +var + SrcBlend: Boolean; + C, SrcAlpha: TColor32; + R, DstRect: TRect; + Pixels: PColor32Array; + I, J, X, Y: Integer; + + function GET_S256(X, Y: Integer; out C: TColor32): Boolean; + var + flrx, flry, celx, cely: Longword; + C1, C2, C3, C4: TColor32; + P: PColor32; + begin + flrx := X and $FF; + flry := Y and $FF; + + X := Sar(X,8); + Y := Sar(Y,8); + + celx := flrx xor 255; + cely := flry xor 255; + + if (X >= SrcRect.Left) and (X < SrcRect.Right - 1) and + (Y >= SrcRect.Top) and (Y < SrcRect.Bottom - 1) then + begin + // everything is ok take the four values and interpolate them + P := Src.PixelPtr[X, Y]; + C1 := P^; + Inc(P); + C2 := P^; + Inc(P, Src.Width); + C4 := P^; + Dec(P); + C3 := P^; + C := CombineReg(CombineReg(C1, C2, celx), CombineReg(C3, C4, celx), cely); + Result := True; + end + else + begin + // (X,Y) coordinate is out of the SrcRect, do not interpolate + C := 0; // just write something to disable compiler warnings + Result := False; + end; + end; +begin + SrcBlend := (Src.DrawMode = dmBlend); + SrcAlpha := Src.MasterAlpha; // store it into a local variable + + // clip SrcRect + R := SrcRect; + IntersectRect(SrcRect, R, Rect(0, 0, Src.Width, Src.Height)); + if IsRectEmpty(SrcRect) then + Exit; + + // clip DstRect + R := Transformation.GetTransformedBounds(SrcRect); + IntersectRect(DstRect, R, Rect(0, 0, Dst.Width, Dst.Height)); + if IsRectEmpty(DstRect) then + Exit; + + try + if Src.StretchFilter <> sfNearest then + for J := DstRect.Top to DstRect.Bottom - 1 do + begin + Pixels := Dst.ScanLine[J]; + for I := DstRect.Left to DstRect.Right - 1 do + begin + Transformation.Transform256(I, J, X, Y); + if GET_S256(X, Y, C) then + if SrcBlend then + BlendMemEx(C, Pixels[I], SrcAlpha) + else + Pixels[I] := C; + end; + end + else // nearest filter + for J := DstRect.Top to DstRect.Bottom - 1 do + begin + Pixels := Dst.ScanLine[J]; + for I := DstRect.Left to DstRect.Right - 1 do + begin + Transformation.Transform(I, J, X, Y); + if (X >= SrcRect.Left) and (X < SrcRect.Right) and + (Y >= SrcRect.Top) and (Y < SrcRect.Bottom) then + begin + if SrcBlend then + BlendMemEx(Src.Pixel[X, Y], Pixels[I], SrcAlpha) + else + Pixels[I] := Src.Pixel[X, Y]; + end; + end; + end; + finally + EMMS; + end; + Dst.Changed; +end; + +procedure SetBorderTransparent(ABitmap: TJclBitmap32; ARect: TRect); +var + I: Integer; +begin + if TestClip(ARect.Left, ARect.Right, ABitmap.Width) and + TestClip(ARect.Top, ARect.Bottom, ABitmap.Height) then + begin + ABitmap.Changing; + + for I := ARect.Left to ARect.Right do + ABitmap[I, ARect.Top] := ABitmap[I, ARect.Top] and $00FFFFFF; + + for I := ARect.Left to ARect.Right do + ABitmap[I, ARect.Bottom] := ABitmap[I, ARect.Bottom] and $00FFFFFF; + + if ARect.Bottom > ARect.Top + 1 then + for I := ARect.Top + 1 to ARect.Bottom - 1 do + begin + ABitmap[ARect.Left, I] := ABitmap[ARect.Left, I] and $00FFFFFF; + ABitmap[ARect.Right, I] := ABitmap[ARect.Right, I] and $00FFFFFF; + end; + + ABitmap.Changed; + end; +end; +{$ENDIF Bitmap32} + +{$IFDEF VCL} +function CreateRegionFromBitmap(Bitmap: TBitmap; RegionColor: TColor; + RegionBitmapMode: TJclRegionBitmapMode; UseAlphaChannel: Boolean): HRGN; +var + LBitmap: TBitmap; + X, Y, Width: Integer; + StartX: Integer; + Region: HRGN; + P: PBGRA; + Mask: TColor; +begin + Result := 0; + + if Bitmap = nil then + EJclGraphicsError.CreateRes(@RsNoBitmapForRegion); + + if (Bitmap.Width = 0) or (Bitmap.Height = 0) then + Exit; + + if UseAlphaChannel then + begin + Mask := TColor($FF000000); + // A region can represent only full transparent alpha values + RegionColor := 0; + end + else + begin + Mask := TColor($00FFFFFF); + RegionColor := ColorToRGB(RegionColor); + end; + + LBitmap := TBitmap.Create; + try + LBitmap.Assign(Bitmap); + LBitmap.PixelFormat := pf32bit; + + Width := LBitmap.Width; + for Y := 0 to LBitmap.Height - 1 do + begin + P := LBitmap.ScanLine[Y]; + X := 0; + while X < Width do + begin + if RegionBitmapMode = rmExclude then + begin + while (TColor(P^) and Mask) = RegionColor do + begin + Inc(X); + Inc(P); + if X = Width then + Break; + end; + end + else + begin + while (TColor(P^) and Mask) <> RegionColor do + begin + Inc(X); + Inc(P); + if X = Width then + Break; + end; + end; + + if X = Width then + Break; + + StartX := X; + if RegionBitmapMode = rmExclude then + begin + while (X < Width) and ((TColor(P^) and Mask) <> RegionColor) do + begin + Inc(X); + Inc(P); + end; + end + else + begin + while (X < Width) and ((TColor(P^) and Mask) = RegionColor) do + begin + Inc(X); + Inc(P); + end; + end; + + Region := CreateRectRgn(StartX, Y, X, Y + 1); + if Result = 0 then + Result := Region + else + begin + if Region <> 0 then + begin + CombineRgn(Result, Result, Region, RGN_OR); + DeleteObject(Region); + end; + end; + end; + end; + finally + LBitmap.Free; + end; +end; + +procedure ScreenShot(bm: TBitmap; Left, Top, Width, Height: Integer; Window: THandle); overload; +var + WinDC: HDC; + Pal: TMaxLogPalette; +begin + bm.Width := Width; + bm.Height := Height; + + // Get the HDC of the window... + WinDC := GetDC(Window); + if WinDC = 0 then + raise EJclGraphicsError.CreateRes(@RsNoDeviceContextForWindow); + try + // Palette-device? + if (GetDeviceCaps(WinDC, RASTERCAPS) and RC_PALETTE) = RC_PALETTE then + begin + ResetMemory(Pal, SizeOf(TMaxLogPalette)); // fill the structure with zeros + Pal.palVersion := $300; // fill in the palette version + + // grab the system palette entries... + Pal.palNumEntries := GetSystemPaletteEntries(WinDC, 0, 256, Pal.palPalEntry); + if Pal.PalNumEntries <> 0 then + bm.Palette := CreatePalette(PLogPalette(@Pal)^); + end; + + // copy from the screen to our bitmap... + BitBlt(bm.Canvas.Handle, 0, 0, Width, Height, WinDC, Left, Top, SRCCOPY); + finally + ReleaseDC(Window, WinDC); // finally, relase the DC of the window + end; +end; + +procedure ScreenShot(bm: TBitmap; IncludeTaskBar: Boolean = True); overload; +var + R: TRect; +begin + if IncludeTaskBar then + begin + R.Left := 0; + R.Top := 0; + R.Right := GetSystemMetrics(SM_CXSCREEN); + R.Bottom := GetSystemMetrics(SM_CYSCREEN); + end + else + SystemParametersInfo(SPI_GETWORKAREA, 0, @R, 0); + ScreenShot(bm, R.Left, R.Top, R.Right, R.Bottom, HWND_DESKTOP); +end; + +procedure ScreenShot(bm: TBitmap; FormToPrint: TCustomForm); overload; +begin + //Prints the entire forms area. + if FormToPrint <> nil then + ScreenShot(bm, FormToPrint.Left, FormToPrint.Top, FormToPrint.Width, FormToPrint.Height, FormToPrint.Handle) + else + raise EJclGraphicsError.CreateResFmt(@RSInvalidFormOrComponent, ['form']) +end; + +function MapWindowRect(hWndFrom, hWndTo: THandle; ARect:TRect):TRect; +begin + MapWindowPoints(hWndFrom, hWndTo, ARect, 2); + Result := ARect; +end; +{$ENDIF VCL} + +{$IFDEF MSWINDOWS} +function FillGradient(DC: HDC; ARect: TRect; ColorCount: Integer; + StartColor, EndColor: TColor; ADirection: TGradientDirection): Boolean; +var + StartRGB: array [0..2] of Byte; + RGBKoef: array [0..2] of Double; + Brush: HBRUSH; + AreaWidth, AreaHeight, I: Integer; + ColorRect: TRect; + RectOffset: Double; +begin + RectOffset := 0; + Result := False; + if ColorCount < 1 then + Exit; + StartColor := ColorToRGB(StartColor); + EndColor := ColorToRGB(EndColor); + StartRGB[0] := GetRValue(StartColor); + StartRGB[1] := GetGValue(StartColor); + StartRGB[2] := GetBValue(StartColor); + RGBKoef[0] := (GetRValue(EndColor) - StartRGB[0]) / ColorCount; + RGBKoef[1] := (GetGValue(EndColor) - StartRGB[1]) / ColorCount; + RGBKoef[2] := (GetBValue(EndColor) - StartRGB[2]) / ColorCount; + AreaWidth := ARect.Right - ARect.Left; + AreaHeight := ARect.Bottom - ARect.Top; + case ADirection of + gdHorizontal: + RectOffset := AreaWidth / ColorCount; + gdVertical: + RectOffset := AreaHeight / ColorCount; + end; + for I := 0 to ColorCount - 1 do + begin + Brush := CreateSolidBrush(RGB( + StartRGB[0] + Round((I + 1) * RGBKoef[0]), + StartRGB[1] + Round((I + 1) * RGBKoef[1]), + StartRGB[2] + Round((I + 1) * RGBKoef[2]))); + case ADirection of + gdHorizontal: + SetRect(ColorRect, Round(RectOffset * I), 0, Round(RectOffset * (I + 1)), AreaHeight); + gdVertical: + SetRect(ColorRect, 0, Round(RectOffset * I), AreaWidth, Round(RectOffset * (I + 1))); + end; + OffsetRect(ColorRect, ARect.Left, ARect.Top); + FillRect(DC, ColorRect, Brush); + DeleteObject(Brush); + end; + Result := True; +end; +{$ENDIF MSWINDOWS} + +{$IFDEF VCL} +//=== { TJclDesktopCanvas } ================================================== + +constructor TJclDesktopCanvas.Create; +begin + inherited Create; + FDesktop := GetDC(HWND_DESKTOP); + Handle := FDesktop; +end; + +destructor TJclDesktopCanvas.Destroy; +begin + Handle := 0; + ReleaseDC(HWND_DESKTOP, FDesktop); + inherited Destroy; +end; + +//=== { TJclRegionInfo } ===================================================== + +constructor TJclRegionInfo.Create(Region: TJclRegion); +begin + inherited Create; + if Region = nil then + raise EJclGraphicsError.CreateRes(@RsInvalidRegion); + FData := nil; + FDataSize := GetRegionData(Region.Handle, 0, nil); + GetMem(FData, FDataSize); + GetRegionData(Region.Handle, FDataSize, FData); +end; + +destructor TJclRegionInfo.Destroy; +begin + if FData <> nil then + FreeMem(FData); + inherited Destroy; +end; + +function TJclRegionInfo.GetBox: TRect; +begin + Result := RectAssign(TRgnData(FData^).rdh.rcBound.Left, TRgnData(FData^).rdh.rcBound.Top, + TRgnData(FData^).rdh.rcBound.Right, TRgnData(FData^).rdh.rcBound.Bottom); +end; + +function TJclRegionInfo.GetCount: Integer; +begin + Result := TRgnData(FData^).rdh.nCount; +end; + +function TJclRegionInfo.GetRect(Index: Integer): TRect; +var + RectP: PRect; +begin + if (Index < 0) or (DWORD(Index) >= TRgnData(FData^).rdh.nCount) then + raise EJclGraphicsError.CreateRes(@RsRegionDataOutOfBound); + RectP := PRect(PAnsiChar(@TRgnData(FData^).Buffer) + (SizeOf(TRect)*Index)); + Result := RectAssign(RectP^.Left, RectP.Top, RectP^.Right, RectP^.Bottom); +end; + +//=== { TJclRegion } ========================================================= + +constructor TJclRegion.Create(RegionHandle: HRGN; OwnsHandle: Boolean = True); +begin + inherited Create; + FHandle := RegionHandle; + FOwnsHandle := OwnsHandle; + CheckHandle; + GetBox; +end; + +constructor TJclRegion.CreateBitmap(Bitmap: TBitmap; RegionColor: TColor; + RegionBitmapMode: TJclRegionBitmapMode); +begin + Create(CreateRegionFromBitmap(Bitmap, RegionColor, RegionBitmapMode), True); +end; + +constructor TJclRegion.CreateElliptic(const ARect: TRect); +begin + Create(CreateEllipticRgnIndirect(ARect), True); +end; + +constructor TJclRegion.CreateElliptic(const Top, Left, Bottom, Right: Integer); +begin + Create(CreateEllipticRgn(Top, Left, Bottom, Right), True); +end; + +constructor TJclRegion.CreatePoly(const Points: TDynPointArray; Count: Integer; + FillMode: TPolyFillMode); +begin + case FillMode of + fmAlternate: + Create(CreatePolygonRgn(Points[0], Count, ALTERNATE), True); + fmWinding: + Create(CreatePolygonRgn(Points[0], Count, WINDING), True); + end; +end; + +constructor TJclRegion.CreatePolyPolygon(const Points: TDynPointArray; + const Vertex: TDynIntegerArray; Count: Integer; FillMode: TPolyFillMode); +begin + case FillMode of + fmAlternate: + Create(CreatePolyPolygonRgn(Points[0], Vertex[0], Count, ALTERNATE), True); + fmWinding: + Create(CreatePolyPolygonRgn(Points[0], Vertex[0], Count, WINDING), True); + end; +end; + +constructor TJclRegion.CreateRect(const ARect: TRect; DummyForBCB: Boolean = False); +begin + Create(CreateRectRgnIndirect(ARect), True); +end; + +constructor TJclRegion.CreateRect(const Top, Left, Bottom, Right: Integer; DummyForBCB: Byte = 0); +begin + Create(CreateRectRgn(Top, Left, Bottom, Right), True); +end; + +constructor TJclRegion.CreateRoundRect(const ARect: TRect; CornerWidth, + CornerHeight: Integer); +begin + Create(CreateRoundRectRgn(ARect.Top, ARect.Left, ARect.Bottom, ARect.Right, + CornerWidth, CornerHeight), True); +end; + +constructor TJclRegion.CreateRoundRect(const Top, Left, Bottom, Right, CornerWidth, + CornerHeight: Integer); +begin + Create(CreateRoundRectRgn(Top, Left, Bottom, Right, CornerWidth, CornerHeight), True); +end; + +constructor TJclRegion.CreatePath(Canvas: TCanvas); +begin + Create(PathToRegion(Canvas.Handle), True); +end; + +constructor TJclRegion.CreateRegionInfo(RegionInfo: TJclRegionInfo); +begin + if RegionInfo = nil then + raise EJclGraphicsError.CreateRes(@RsInvalidRegionInfo); + Create(ExtCreateRegion(nil,RegionInfo.FDataSize,TRgnData(RegionInfo.FData^)), True); +end; + +constructor TJclRegion.CreateMapWindow(InitialRegion: TJclRegion; hWndFrom, hWndTo: THandle); +var + RectRegion: HRGN; + CurrentRegionInfo : TJclRegionInfo; + SimpleRect: TRect; + Index:integer; +begin + Create(CreateRectRgn(0, 0, 0, 0), True); + if (hWndFrom <> 0) or (hWndTo <> 0 ) then + begin + CurrentRegionInfo := InitialRegion.GetRegionInfo; + try + for Index := 0 to CurrentRegionInfo.Count-1 do + begin + SimpleRect := CurrentRegionInfo.Rectangles[Index]; + SimpleRect := MapWindowRect(hWndFrom,hWndTo,SimpleRect); + RectRegion := CreateRectRgnIndirect(SimpleRect); + if RectRegion <> 0 then + begin + CombineRgn(Handle, Handle, RectRegion, RGN_OR); + DeleteObject(RectRegion); + end; + end; + finally + CurrentRegionInfo.Free; + GetBox; + end; + end; +end; + +constructor TJclRegion.CreateMapWindow(InitialRegion: TJclRegion; + ControlFrom, ControlTo: TWinControl); +begin + CreateMapWindow(InitialRegion,ControlFrom.Handle,ControlTo.Handle); +end; + +destructor TJclRegion.Destroy; +begin + if FOwnsHandle and (FHandle <> 0) then + DeleteObject(FHandle); + inherited Destroy; +end; + +procedure TJclRegion.CheckHandle; +begin + if FHandle = 0 then + begin + if FOwnsHandle then + raise EJclGraphicsError.CreateRes(@RsRegionCouldNotCreated) + else + raise EJclGraphicsError.CreateRes(@RsInvalidHandleForRegion); + end; +end; + +procedure TJclRegion.Combine(DestRegion, SrcRegion: TJclRegion; + CombineOp: TJclRegionCombineOperator); +begin + case CombineOp of + coAnd: + FRegionType := CombineRgn(DestRegion.Handle, SrcRegion.Handle, FHandle, RGN_AND); + coOr: + FRegionType := CombineRgn(DestRegion.Handle, SrcRegion.Handle, FHandle, RGN_OR); + coDiff: + FRegionType := CombineRgn(DestRegion.Handle, SrcRegion.Handle, FHandle, RGN_DIFF); + coXor: + FRegionType := CombineRgn(DestRegion.Handle, SrcRegion.Handle, FHandle, RGN_XOR); + end; +end; + +procedure TJclRegion.Combine(SrcRegion: TJclRegion; CombineOp: TJclRegionCombineOperator); +begin + case CombineOp of + coAnd: + FRegionType := CombineRgn(FHandle, SrcRegion.Handle, FHandle, RGN_AND); + coOr: + FRegionType := CombineRgn(FHandle, SrcRegion.Handle, FHandle, RGN_OR); + coDiff: + FRegionType := CombineRgn(FHandle, SrcRegion.Handle, FHandle, RGN_DIFF); + coXor: + FRegionType := CombineRgn(FHandle, SrcRegion.Handle, FHandle, RGN_XOR); + end; +end; + +procedure TJclRegion.Clip(Canvas: TCanvas); +begin + FRegionType := SelectClipRgn(Canvas.Handle, FHandle); +end; + +function TJclRegion.Equals(CompareRegion: TJclRegion): Boolean; +begin + Result := EqualRgn(CompareRegion.Handle, FHandle); +end; + +function TJclRegion.GetHandle: HRGN; +begin + Result := FHandle; +end; + +procedure TJclRegion.Fill(Canvas: TCanvas); +begin + FillRgn(Canvas.Handle, FHandle, Canvas.Brush.Handle); +end; + +procedure TJclRegion.FillGradient(Canvas: TCanvas; ColorCount: Integer; + StartColor, EndColor: TColor; ADirection: TGradientDirection); +var + DC: integer; +begin + DC := SaveDC(Canvas.Handle); + try + SelectClipRgn(Canvas.Handle,FHandle); + {$IFDEF VCL}JclGraphics.{$ENDIF}FillGradient(Canvas.Handle, Box, ColorCount, StartColor, EndColor, ADirection); + finally + RestoreDC(Canvas.Handle, DC); + end; +end; + +procedure TJclRegion.Frame(Canvas: TCanvas; FrameWidth, FrameHeight: Integer); +begin + FrameRgn(Canvas.Handle, FHandle, Canvas.Brush.Handle, FrameWidth, FrameHeight); +end; + +function TJclRegion.GetBox: TRect; +begin + FRegionType := GetRgnBox(FHandle, FBoxRect); + Result := FBoxRect; +end; + +function TJclRegion.GetRegionType: TJclRegionKind; +begin + case FRegionType of + NULLREGION: + Result := rkNull; + SIMPLEREGION: + Result := rkSimple; + COMPLEXREGION: + Result := rkComplex; + else + Result := rkError; + end; +end; + +procedure TJclRegion.Invert(Canvas: TCanvas); +begin + InvertRgn(Canvas.Handle, FHandle); +end; + +procedure TJclRegion.Offset(X, Y: Integer); +begin + FRegionType := OffsetRgn(FHandle, X, Y); +end; + +procedure TJclRegion.Paint(Canvas: TCanvas); +begin + PaintRgn(Canvas.Handle, FHandle); +end; + +function TJclRegion.PointIn(X, Y: Integer): Boolean; +begin + Result := PtInRegion(FHandle, X, Y); +end; + +function TJclRegion.PointIn(const Point: TPoint): Boolean; +begin + Result := PtInRegion(FHandle, Point.X, Point.Y); +end; + +function TJclRegion.RectIn(const ARect: TRect): Boolean; +begin + Result := RectInRegion(FHandle, ARect); +end; + +function TJclRegion.RectIn(Top, Left, Bottom, Right: Integer): Boolean; +begin + Result := RectInRegion(FHandle, RectAssign(Left, Top, Right, Bottom)); +end; + +{ Documentation Info (from MSDN): After a successful call to SetWindowRgn, the system owns + the region specified by the region handle hRgn. The system does + not make a copy of the region. Thus, you should not make any + further function calls with this region handle. In particular, + do not delete this region handle. The system deletes the region + handle when it no longer needed. } + +procedure TJclRegion.SetWindow(Window: THandle; Redraw: Boolean); +begin + if SetWindowRgn(Window, FHandle, Redraw) <> 0 then + FOwnsHandle := False; // Make sure that we do not release the Handle. If we didn't own it before + // please take care that the owner doesn't release it. +end; + +function TJclRegion.Copy: TJclRegion; +begin + Result := TJclRegion.CreateRect(0, 0, 0, 0, 0); // (rom) call correct overloaded constructor for BCB + CombineRgn(Result.Handle, FHandle, 0, RGN_COPY); + Result.GetBox; +end; + +function TJclRegion.GetRegionInfo: TJclRegionInfo; +begin + Result := TJclRegionInfo.Create(Self); +end; +{$ENDIF VCL} + +{$IFDEF Bitmap32} +//=== { TJclThreadPersistent } =============================================== + +constructor TJclThreadPersistent.Create; +begin + inherited Create; + {$IFDEF VCL} + InitializeCriticalSection(FLock); + {$ELSE ~VCL} + FLock := TCriticalSection.Create; + {$ENDIF ~VCL} +end; + +destructor TJclThreadPersistent.Destroy; +begin + {$IFDEF VCL} + DeleteCriticalSection(FLock); + {$ELSE ~VCL} + FLock.Free; + {$ENDIF ~VCL} + inherited Destroy; +end; + +procedure TJclThreadPersistent.BeginUpdate; +begin + Inc(FUpdateCount); +end; + +procedure TJclThreadPersistent.Changing; +begin + if (FUpdateCount = 0) and Assigned(FOnChanging) then + FOnChanging(Self); +end; + +procedure TJclThreadPersistent.Changed; +begin + if (FUpdateCount = 0) and Assigned(FOnChange) then + FOnChange(Self); +end; + +procedure TJclThreadPersistent.EndUpdate; +begin + Assert(FUpdateCount > 0, LoadResString(@RsAssertUnpairedEndUpdate)); + Dec(FUpdateCount); +end; + +procedure TJclThreadPersistent.Lock; +begin + InterlockedIncrement(FLockCount); + {$IFDEF VCL} + EnterCriticalSection(FLock); + {$ELSE ~VCL} + FLock.Enter; + {$ENDIF ~VCL} +end; + +procedure TJclThreadPersistent.Unlock; +begin + {$IFDEF VCL} + LeaveCriticalSection(FLock); + {$ELSE ~VCL} + FLock.Leave; + {$ENDIF ~VCL} + InterlockedDecrement(FLockCount); +end; + +//=== { TJclCustomMap } ====================================================== + +procedure TJclCustomMap.Delete; +begin + SetSize(0, 0); +end; + +function TJclCustomMap.Empty: Boolean; +begin + Result := (Width = 0) or (Height = 0); +end; + +procedure TJclCustomMap.SetHeight(NewHeight: Integer); +begin + SetSize(Width, NewHeight); +end; + +procedure TJclCustomMap.SetSize(NewWidth, NewHeight: Integer); +begin + FWidth := NewWidth; + FHeight := NewHeight; +end; + +procedure TJclCustomMap.SetSize(Source: TPersistent); +var + WidthInfo, HeightInfo: PPropInfo; +begin + if Source is TJclCustomMap then + SetSize(TJclCustomMap(Source).Width, TJclCustomMap(Source).Height) + else + if Source is TGraphic then + SetSize(TGraphic(Source).Width, TGraphic(Source).Height) + else + if Source = nil then + SetSize(0, 0) + else + begin + WidthInfo := GetPropInfo(Source, 'Width', [tkInteger]); + HeightInfo := GetPropInfo(Source, 'Height', [tkInteger]); + if Assigned(WidthInfo) and Assigned(HeightInfo) then + SetSize(GetOrdProp(Source, WidthInfo), GetOrdProp(Source, HeightInfo)) + else + raise EJclGraphicsError.CreateResFmt(@RsMapSizeFmt,[Source.ClassName]); + end; +end; + +procedure TJclCustomMap.SetWidth(NewWidth: Integer); +begin + SetSize(NewWidth, Height); +end; + +//=== { TJclBitmap32 } ======================================================= + +constructor TJclBitmap32.Create; +begin + inherited Create; + + FResetAlphaOnAssign := True; + + ResetMemory(FBitmapInfo, SizeOf(TBitmapInfo)); + with FBitmapInfo.bmiHeader do + begin + biSize := SizeOf(TBitmapInfoHeader); + biPlanes := 1; + biBitCount := 32; + biCompression := BI_RGB; + end; + FOuterColor := $00000000; // by default as full transparency black + FFont := TFont.Create; + FFont.OnChange := FontChanged; + {$IFDEF VCL} + FFont.OwnerCriticalSection := @FLock; + {$ENDIF VCL} + FMasterAlpha := $FF; + FPenColor := clWhite32; + FStippleStep := 1; +end; + +destructor TJclBitmap32.Destroy; +begin + Lock; + try + FFont.Free; + SetSize(0, 0); + finally + Unlock; + end; + inherited Destroy; +end; + +procedure TJclBitmap32.SetSize(NewWidth, NewHeight: Integer); +begin + if NewWidth <= 0 then + NewWidth := 0; + if NewHeight <= 0 then + NewHeight := 0; + if (NewWidth = Width) and (NewHeight = Height) then + Exit; + + Changing; + + try + if FHDC <> 0 then + DeleteDC(FHDC); + if FHandle <> 0 then + DeleteObject(FHandle); + FBits := nil; + FWidth := 0; + FHeight := 0; + if (NewWidth > 0) and (NewHeight > 0) then + begin + with FBitmapInfo.bmiHeader do + begin + biWidth := NewWidth; + biHeight := -NewHeight; + end; + FHandle := CreateDIBSection(0, FBitmapInfo, DIB_RGB_COLORS, Pointer(FBits), 0, 0); + if FBits = nil then + raise EJclGraphicsError.CreateRes(@RsDibHandleAllocation); + + FHDC := CreateCompatibleDC(0); + if FHDC = 0 then + begin + DeleteObject(FHandle); + FHandle := 0; + FBits := nil; + raise EJclGraphicsError.CreateRes(@RsCreateCompatibleDc); + end; + + if SelectObject(FHDC, FHandle) = 0 then + begin + DeleteDC(FHDC); + DeleteObject(FHandle); + FHDC := 0; + FHandle := 0; + FBits := nil; + raise EJclGraphicsError.CreateRes(@RsSelectObjectInDc); + end; + + FWidth := NewWidth; + FHeight := NewHeight; + end; + + finally + Changed; + end; +end; + +function TJclBitmap32.Empty: Boolean; +begin + Result := (FHandle = 0); +end; + +procedure TJclBitmap32.Clear; +begin + Clear(clBlack32); +end; + +procedure TJclBitmap32.Clear(FillColor: TColor32); +begin + if Empty then + Exit; + Changing; + FillLongword(Bits[0], Width * Height, FillColor); + Changed; +end; + +procedure TJclBitmap32.Delete; +begin + Changing; + SetSize(0, 0); + Changed; +end; + +procedure TJclBitmap32.Assign(Source: TPersistent); +var + Canvas: TCanvas; + Picture: TPicture; + + procedure AssignFromBitmap(SrcBmp: TBitmap); + begin + SetSize(SrcBmp.Width, SrcBmp.Height); + if Empty then + Exit; + BitBlt(Handle, 0, 0, Width, Height, SrcBmp.Canvas.Handle, 0, 0, SRCCOPY); + if ResetAlphaOnAssign then + ResetAlpha; + end; + +begin + Changing; + BeginUpdate; + try + if Source = nil then + begin + SetSize(0, 0); + Exit; + end + else + if Source is TJclBitmap32 then + begin + SetSize(TJclBitmap32(Source).Width, TJclBitmap32(Source).Height); + Move(TJclBitmap32(Source).Bits[0], Bits[0], Width * Height * 4); + Exit; + end + else + if Source is TBitmap then + begin + AssignFromBitmap(TBitmap(Source)); + Exit; + end + else + if Source is TPicture then + begin + with TPicture(Source) do + begin + if TPicture(Source).Graphic is TBitmap then + AssignFromBitmap(TBitmap(TPicture(Source).Graphic)) + else + begin + // icons, metafiles etc... + SetSize(TPicture(Source).Graphic.Width, TPicture(Source).Graphic.Height); + if Empty then + Exit; + Canvas := TCanvas.Create; + try + Canvas.Handle := Self.Handle; + TJclGraphicAccess(Graphic).Draw(Canvas, Rect(0, 0, Width, Height)); + if ResetAlphaOnAssign then + ResetAlpha; + finally + Canvas.Free; + end; + end; + end; + Exit; + end + else + if Source is TClipboard then + begin + Picture := TPicture.Create; + try + Picture.Assign(TClipboard(Source)); + SetSize(Picture.Width, Picture.Height); + if Empty then + Exit; + Canvas := TCanvas.Create; + try + Canvas.Handle := Self.Handle; + TJclGraphicAccess(Picture.Graphic).Draw(Canvas, Rect(0, 0, Width, Height)); + if ResetAlphaOnAssign then + ResetAlpha; + finally + Canvas.Free; + end; + finally + Picture.Free; + end; + Exit; + end + else + inherited Assign(Source); // default handler + finally; + EndUpdate; + Changed; + end; +end; + +procedure TJclBitmap32.AssignTo(Dst: TPersistent); +var + Bmp: TBitmap; +begin + if Dst is TPicture then + begin + Bmp := TPicture(Dst).Bitmap; + Bmp.HandleType := bmDIB; + Bmp.PixelFormat := pf32bit; + Bmp.Width := Width; + Bmp.Height := Height; + DrawTo(Bmp.Canvas.Handle, 0, 0); + end + else + if Dst is TBitmap then + begin + Bmp := TBitmap(Dst); + Bmp.HandleType := bmDIB; + Bmp.PixelFormat := pf32bit; + Bmp.Width := Width; + Bmp.Height := Height; + DrawTo(Bmp.Canvas.Handle, 0, 0); + end + else + if Dst is TClipboard then + begin + Bmp := TBitmap.Create; + try + Bmp.HandleType := bmDIB; + Bmp.PixelFormat := pf32bit; + Bmp.Width := Width; + Bmp.Height := Height; + DrawTo(Bmp.Canvas.Handle, 0, 0); + TClipboard(Dst).Assign(Bmp); + finally + Bmp.Free; + end; + end + else + inherited AssignTo(Dst); +end; + +procedure TJclBitmap32.SetPixel(X, Y: Integer; Value: TColor32); +begin + Bits[X + Y * Width] := Value; +end; + +procedure TJclBitmap32.SetPixelS(X, Y: Integer; Value: TColor32); +begin + if (X >= 0) and (X < Width) and (Y >= 0) and (Y < Height) then + Bits[X + Y * Width] := Value; +end; + +function TJclBitmap32.GetScanLine(Y: Integer): PColor32Array; +begin + Result := @Bits[Y * FWidth]; +end; + +function TJclBitmap32.GetPixel(X, Y: Integer): TColor32; +begin + Result := Bits[X + Y * Width]; +end; + +function TJclBitmap32.GetPixelS(X, Y: Integer): TColor32; +begin + if (X >= 0) and (X < Width) and (Y >= 0) and (Y < Height) then + Result := Bits[X + Y * Width] + else + Result := OuterColor; +end; + +function TJclBitmap32.GetPixelPtr(X, Y: Integer): PColor32; +begin + Result := @Bits[X + Y * Width]; +end; + +procedure TJclBitmap32.Draw(DstX, DstY: Integer; Src: TJclBitmap32); +begin + Changing; + if Src <> nil then + Src.DrawTo(Self, DstX, DstY); + Changed; +end; + +procedure TJclBitmap32.Draw(DstRect, SrcRect: TRect; Src: TJclBitmap32); +begin + Changing; + if Src <> nil then + Src.DrawTo(Self, DstRect, SrcRect); + Changed; +end; + +procedure TJclBitmap32.Draw(DstRect, SrcRect: TRect; hSrc: HDC); +begin + if Empty then + Exit; + Changing; + StretchBlt(Handle, DstRect.Left, DstRect.Top, DstRect.Right - DstRect.Left, + DstRect.Bottom - DstRect.Top, hSrc, SrcRect.Left, SrcRect.Top, + SrcRect.Right - SrcRect.Left, SrcRect.Bottom - SrcRect.Top, SRCCOPY); + Changed; +end; + +procedure TJclBitmap32.DrawTo(Dst: TJclBitmap32); +begin + if Empty or Dst.Empty then + Exit; + Dst.Changing; + BlockTransfer(Dst, 0, 0, Self, Rect(0, 0, Width, Height), DrawMode); + Dst.Changed; +end; + +procedure TJclBitmap32.DrawTo(Dst: TJclBitmap32; DstX, DstY: Integer); +begin + if Empty or Dst.Empty then + Exit; + Dst.Changing; + BlockTransfer(Dst, DstX, DstY, Self, Rect(0, 0, Width, Height), DrawMode); + Dst.Changed; +end; + +procedure TJclBitmap32.DrawTo(Dst: TJclBitmap32; DstRect: TRect); +begin + if Empty or Dst.Empty then + Exit; + Dst.Changing; + StretchTransfer(Dst, DstRect, Self, Rect(0, 0, Width, Height), StretchFilter, DrawMode); + Dst.Changed; +end; + +procedure TJclBitmap32.DrawTo(Dst: TJclBitmap32; DstRect, SrcRect: TRect); +begin + if Empty or Dst.Empty then + Exit; + Dst.Changing; + StretchTransfer(Dst, DstRect, Self, SrcRect, StretchFilter, DrawMode); + Dst.Changed; +end; + +procedure TJclBitmap32.DrawTo(hDst: HDC; DstX, DstY: Integer); +begin + if Empty then + Exit; + BitBlt(hDst, DstX, DstY, Width, Height, Handle, 0, 0, SRCCOPY); +end; + +procedure TJclBitmap32.DrawTo(hDst: HDC; DstRect, SrcRect: TRect); +begin + if Empty then + Exit; + StretchDIBits(hDst, + DstRect.Left, DstRect.Top, DstRect.Right - DstRect.Left, DstRect.Bottom - DstRect.Top, + SrcRect.Left, SrcRect.Top, SrcRect.Right - SrcRect.Left, SrcRect.Bottom - SrcRect.Top, + Bits, FBitmapInfo, DIB_RGB_COLORS, SRCCOPY); +end; + +procedure TJclBitmap32.ResetAlpha; +var + I: Integer; + P: PByte; +begin + Changing; + P := Pointer(FBits); + Inc(P, 3); + for I := 0 to Width * Height - 1 do + begin + P^ := $FF; + Inc(P, 4) + end; + Changed; +end; + +function TJclBitmap32.GetPixelB(X, Y: Integer): TColor32; +begin + // this function should never be used on empty bitmaps !!! + if X < 0 then + X := 0 + else + if X >= Width then + X := Width - 1; + if Y < 0 then + Y := 0 + else + if Y >= Height then + Y := Height - 1; + Result := Bits[X + Y * Width]; +end; + +procedure TJclBitmap32.SetPixelT(X, Y: Integer; Value: TColor32); +begin + BlendMem(Value, Bits[X + Y * Width]); + EMMS; +end; + +procedure TJclBitmap32.SetPixelT(var Ptr: PColor32; Value: TColor32); +begin + BlendMem(Value, Ptr^); + EMMS; + Inc(Ptr); +end; + +procedure TJclBitmap32.SetPixelTS(X, Y: Integer; Value: TColor32); +begin + if (X >= 0) and (X < Width) and (Y >= 0) and (Y < Width) then + begin + BlendMem(Value, Bits[X + Y * Width]); + EMMS; + end; +end; + +procedure TJclBitmap32.SET_T256(X, Y: Integer; C: TColor32); +var + flrx, flry, celx, cely: Longword; + P: PColor32; + A: TColor32; +begin + A := C shr 24; // opacity + + flrx := X and $FF; + flry := Y and $FF; + + X := Sar(X,8); + Y := Sar(Y,8); + + celx := A * GAMMA_TABLE[flrx xor 255]; + cely := GAMMA_TABLE[flry xor 255]; + flrx := A * GAMMA_TABLE[flrx]; + flry := GAMMA_TABLE[flry]; + + P := @FBits[X + Y * FWidth]; + + CombineMem(C, P^, celx * cely shr 16); + Inc(P); + CombineMem(C, P^, flrx * cely shr 16); + Inc(P, FWidth); + CombineMem(C, P^, flrx * flry shr 16); + Dec(P); + CombineMem(C, P^, celx * flry shr 16); +end; + +procedure TJclBitmap32.SET_TS256(X, Y: Integer; C: TColor32); +var + flrx, flry, celx, cely: Longword; + P: PColor32; + A: TColor32; +begin + if (X < -256) or (Y < -256) then + Exit; + + flrx := X and $FF; + flry := Y and $FF; + + X := Sar(X,8); + Y := Sar(Y,8); + + if (X >= FWidth) or (Y >= FHeight) then + Exit; + + A := C shr 24; // opacity + + celx := A * GAMMA_TABLE[flrx xor 255]; + cely := GAMMA_TABLE[flry xor 255]; + flrx := A * GAMMA_TABLE[flrx]; + flry := GAMMA_TABLE[flry]; + + P := @FBits[X + Y * FWidth]; + + if (X >= 0) and (Y >= 0) and (X < FWidth - 1) and (Height < FHeight - 1) then + begin + CombineMem(C, P^, celx * cely shr 16); + Inc(P); + CombineMem(C, P^, flrx * cely shr 16); + Inc(P, FWidth); + CombineMem(C, P^, flrx * flry shr 16); + Dec(P); + CombineMem(C, P^, celx * flry shr 16); + end + else + begin + if (X >= 0) and (Y >= 0) then + CombineMem(C, P^, celx * cely shr 16); + Inc(P); + if (X < FWidth - 1) and (Y >= 0) then + CombineMem(C, P^, flrx * cely shr 16); + Inc(P, FWidth); + if (X < FWidth - 1) and (Y < FHeight - 1) then + CombineMem(C, P^, flrx * flry shr 16); + Dec(P); + if (X >= 0) and (Y < FHeight - 1) then + CombineMem(C, P^, celx * flry shr 16); + end; +end; + +procedure TJclBitmap32.SetPixelF(X, Y: Single; Value: TColor32); +begin + SET_T256(Round(X * 256), Round(Y * 256), Value); + EMMS; +end; + +procedure TJclBitmap32.SetPixelFS(X, Y: Single; Value: TColor32); +begin + SET_TS256(Round(X * 256), Round(Y * 256), Value); + EMMS; +end; + +procedure TJclBitmap32.SetStipple(NewStipple: TArrayOfColor32); +begin + FStippleCounter := 0; + FStipplePattern := Copy(NewStipple, 0, Length(NewStipple)); +end; + +procedure TJclBitmap32.SetStipple(NewStipple: array of TColor32); +var + L: Integer; +begin + FStippleCounter := 0; + L := High(NewStipple) - Low(NewStipple) + 1; + SetLength(FStipplePattern, L); + Move(NewStipple[Low(NewStipple)], FStipplePattern[0], L * SizeOf(TColor32)); +end; + +function TJclBitmap32.GetStippleColor: TColor32; +var + L: Integer; + NextIndex, PrevIndex: Integer; + PrevWeight: Integer; +begin + L := Length(FStipplePattern); + if L = 0 then + begin + // no pattern defined, just return something and exit + Result := clBlack32; + Exit; + end; + while FStippleCounter >= L do + FStippleCounter := FStippleCounter - L; + while FStippleCounter < 0 do + FStippleCounter := FStippleCounter + L; + PrevIndex := Round(FStippleCounter - 0.5); + PrevWeight := 255 - Round(255 * (FStippleCounter - PrevIndex)); + if PrevIndex < 0 then + FStippleCounter := L - 1; + NextIndex := PrevIndex + 1; + if NextIndex >= L then + NextIndex := 0; + if PrevWeight = 255 then + Result := FStipplePattern[PrevIndex] + else + begin + Result := CombineReg( + FStipplePattern[PrevIndex], + FStipplePattern[NextIndex], + PrevWeight); + EMMS; + end; + FStippleCounter := FStippleCounter + FStippleStep; +end; + +procedure TJclBitmap32.SetStippleStep(Value: Single); +begin + FStippleStep := Value; +end; + +procedure TJclBitmap32.ResetStippleCounter; +begin + FStippleCounter := 0; +end; + +procedure TJclBitmap32.DrawHorzLine(X1, Y, X2: Integer; Value: TColor32); +begin + FillLongword(Bits[X1 + Y * Width], X2 - X1 + 1, Value); +end; + +procedure TJclBitmap32.DrawHorzLineS(X1, Y, X2: Integer; Value: TColor32); +begin + if (Y >= 0) and (Y < Height) and TestClip(X1, X2, Width) then + DrawHorzLine(X1, Y, X2, Value); +end; + +procedure TJclBitmap32.DrawHorzLineT(X1, Y, X2: Integer; Value: TColor32); +var + I: Integer; + P: PColor32; +begin + if X2 < X1 then + Exit; + P := PixelPtr[X1, Y]; + for I := X1 to X2 do + begin + BlendMem(Value, P^); + Inc(P); + end; + EMMS; +end; + +procedure TJclBitmap32.DrawHorzLineTS(X1, Y, X2: Integer; Value: TColor32); +begin + if (Y >= 0) and (Y < Height) and TestClip(X1, X2, Width) then + DrawHorzLineT(X1, Y, X2, Value); +end; + +procedure TJclBitmap32.DrawHorzLineTSP(X1, Y, X2: Integer); +var + I: Integer; +begin + if Empty then + Exit; + if (Y >= 0) and (Y < Height) then + begin + if ((X1 < 0) and (X2 < 0)) or ((X1 >= Width) and (X2 >= Width)) then + Exit; + if X1 < 0 then + X1 := 0 + else + if X1 >= Width then + X1 := Width - 1; + if X2 < 0 then + X2 := 0 + else + if X2 >= Width then + X2 := Width - 1; + + if X2 >= X1 then + for I := X1 to X2 do + SetPixelT(I, Y, GetStippleColor) + else + for I := X2 downto X1 do + SetPixelT(I, Y, GetStippleColor); + end; +end; + +procedure TJclBitmap32.DrawVertLine(X, Y1, Y2: Integer; Value: TColor32); +var + I: Integer; + P: PColor32; +begin + if Y2 < Y1 then + Exit; + P := PixelPtr[X, Y1]; + for I := 0 to Y2 - Y1 do + begin + P^ := Value; + Inc(P, Width); + end; +end; + +procedure TJclBitmap32.DrawVertLineS(X, Y1, Y2: Integer; Value: TColor32); +begin + if (X >= 0) and (X < Width) and TestClip(Y1, Y2, Height) then + DrawVertLine(X, Y1, Y2, Value); +end; + +procedure TJclBitmap32.DrawVertLineT(X, Y1, Y2: Integer; Value: TColor32); +var + I: Integer; + P: PColor32; +begin + P := PixelPtr[X, Y1]; + for I := Y1 to Y2 do + begin + BlendMem(Value, P^); + Inc(P, Width); + end; + EMMS; +end; + +procedure TJclBitmap32.DrawVertLineTS(X, Y1, Y2: Integer; Value: TColor32); +begin + if (X >= 0) and (X < Width) and TestClip(Y1, Y2, Height) then + DrawVertLineT(X, Y1, Y2, Value); +end; + +procedure TJclBitmap32.DrawVertLineTSP(X, Y1, Y2: Integer); +var + I: Integer; +begin + if Empty then + Exit; + if (X >= 0) and (X < Width) then + begin + if ((Y1 < 0) and (Y2 < 0)) or ((Y1 >= Height) and (Y2 >= Height)) then + Exit; + if Y1 < 0 then + Y1 := 0 + else + if Y1 >= Height then + Y1 := Height - 1; + if Y2 < 0 then + Y2 := 0 + else + if Y2 >= Height then + Y2 := Height - 1; + + if Y2 >= Y1 then + for I := Y1 to Y2 do + SetPixelT(X, I, GetStippleColor) + else + for I := Y2 downto Y1 do + SetPixelT(X, I, GetStippleColor); + end; +end; + +procedure TJclBitmap32.DrawLine(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean); +var + Dy, Dx, Sy, Sx, I, Delta: Integer; + P: PColor32; +begin + Changing; + + try + Dx := X2 - X1; + Dy := Y2 - Y1; + + if Dx > 0 then + Sx := 1 + else + if Dx < 0 then + begin + Dx := -Dx; + Sx := -1; + end + else // Dx = 0 + begin + if Dy > 0 then + DrawVertLine(X1, Y1, Y2 - 1, Value) + else + if Dy < 0 then + DrawVertLine(X1, Y2, Y1 - 1, Value); + if L then + Pixel[X2, Y2] := Value; + Exit; + end; + + if Dy > 0 then + Sy := 1 + else + if Dy < 0 then + begin + Dy := -Dy; + Sy := -1; + end + else // Dy = 0 + begin + if Dx > 0 then + DrawHorzLine(X1, Y1, X2 - 1, Value) + else + DrawHorzLine(X2, Y1, X1 - 1, Value); + if L then + Pixel[X2, Y2] := Value; + Exit; + end; + + P := PixelPtr[X1, Y1]; + Sy := Sy * Width; + + if Dx > Dy then + begin + Delta := Dx shr 1; + for I := 0 to Dx - 1 do + begin + P^ := Value; + Inc(P, Sx); + Delta := Delta + Dy; + if Delta > Dx then + begin + Inc(P, Sy); + Delta := Delta - Dx; + end; + end; + end + else // Dx < Dy + begin + Delta := Dy shr 1; + for I := 0 to Dy - 1 do + begin + P^ := Value; + Inc(P, Sy); + Delta := Delta + Dx; + if Delta > Dy then + begin + Inc(P, Sx); + Delta := Delta - Dy; + end; + end; + end; + if L then + P^ := Value; + finally + Changed; + end; +end; + +function TJclBitmap32.ClipLine(var X0, Y0, X1, Y1: Integer): Boolean; +type + TEdge = (Left, Right, Top, Bottom); + TOutCode = set of TEdge; +var + Accept, AllDone: Boolean; + OutCode0, OutCode1, OutCodeOut: TOutCode; + X, Y: Integer; + + procedure CompOutCode(X, Y: Integer; var Code: TOutCode); + begin + Code := []; + if X < 0 then + Code := Code + [Left]; + if X >= Width then + Code := Code + [Right]; + if Y < 0 then + Code := Code + [Top]; + if Y >= Height then + Code := Code + [Bottom]; + end; + +begin + Accept := False; + AllDone := False; + CompOutCode(X0, Y0, OutCode0); + CompOutCode(X1, Y1, OutCode1); + repeat + if (OutCode0 = []) and (OutCode1 = []) then // trivial accept and exit + begin + Accept := True; + AllDone := True; + end + else + if (OutCode0 * OutCode1) <> [] then + AllDone := True // trivial reject + else // calculate intersections + begin + if OutCode0 <> [] then + OutCodeOut := OutCode0 + else + OutCodeOut := OutCode1; + X := 0; + Y := 0; + if Left in OutCodeOut then + Y := Y0 + (Y1 - Y0) * (-X0) div (X1 - X0) + else + if Right in OutCodeOut then + begin + Y := Y0 + (Y1 - Y0) * (Width - 1 - X0) div (X1 - X0); + X := Width - 1; + end + else + if Top in OutCodeOut then + X := X0 + (X1 - X0) * (-Y0) div (Y1 - Y0) + else + if Bottom in OutCodeOut then + begin + X := X0 + (X1 - X0) * (Height - 1 - Y0) div (Y1 - Y0); + Y := Height - 1; + end; + if OutCodeOut = OutCode0 then + begin + X0 := X; + Y0 := Y; + CompOutCode(X0, Y0, OutCode0); + end + else + begin + X1 := X; + Y1 := Y; + CompOutCode(X1, Y1, OutCode1); + end; + end; + until AllDone; + Result := Accept; +end; + +class function TJclBitmap32.ClipLineF(var X0, Y0, X1, Y1: Single; + MinX, MaxX, MinY, MaxY: Single): Boolean; +type + TEdge = (Left, Right, Top, Bottom); + TOutCode = set of TEdge; +var + Accept, AllDone: Boolean; + OutCode0, OutCode1, OutCodeOut: TOutCode; + X, Y: Single; + + procedure CompOutCode(X, Y: Single; var Code: TOutCode); + begin + Code := []; + if X < MinX then + Code := Code + [Left]; + if X > MaxX then + Code := Code + [Right]; + if Y < MinY then + Code := Code + [Top]; + if Y > MaxY then + Code := Code + [Bottom]; + end; + +begin + Accept := False; + AllDone := False; + CompOutCode(X0, Y0, OutCode0); + CompOutCode(X1, Y1, OutCode1); + repeat + if (OutCode0 = []) and (OutCode1 = []) then // trivial accept and exit + begin + Accept := True; + AllDone := True; + end + else + if (OutCode0 * OutCode1) <> [] then + AllDone := True // trivial reject + else // calculate intersections + begin + if OutCode0 <> [] then + OutCodeOut := OutCode0 + else + OutCodeOut := OutCode1; + X := 0; + Y := 0; + if Left in OutCodeOut then + begin + Y := Y0 + (Y1 - Y0) * (MinX - X0) / (X1 - X0); + X := MinX; + end + else + if Right in OutCodeOut then + begin + Y := Y0 + (Y1 - Y0) * (MaxX - X0) / (X1 - X0); + X := MaxX - 1; + end + else + if Top in OutCodeOut then + begin + X := X0 + (X1 - X0) * (MinY - Y0) / (Y1 - Y0); + Y := MinY; + end + else + if Bottom in OutCodeOut then + begin + X := X0 + (X1 - X0) * (MaxY - Y0) / (Y1 - Y0); + Y := MaxY; + end; + if OutCodeOut = OutCode0 then + begin + X0 := X; + Y0 := Y; + CompOutCode(X0, Y0, OutCode0); + end + else + begin + X1 := X; + Y1 := Y; + CompOutCode(X1, Y1, OutCode1); + end; + end; + until AllDone; + Result := Accept; +end; + +procedure TJclBitmap32.DrawLineS(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean); +begin + if ClipLine(X1, Y1, X2, Y2) then + DrawLine(X1, Y1, X2, Y2, Value, L); +end; + +procedure TJclBitmap32.DrawLineT(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean); +var + Dy, Dx, Sy, Sx, I, Delta: Integer; + P: PColor32; +begin + Changing; + try + Dx := X2 - X1; + Dy := Y2 - Y1; + + if Dx > 0 then + Sx := 1 + else + if Dx < 0 then + begin + Dx := -Dx; + Sx := -1; + end + else // Dx = 0 + begin + if Dy > 0 then + DrawVertLineT(X1, Y1, Y2 - 1, Value) + else + if Dy < 0 then + DrawVertLineT(X1, Y2, Y1 - 1, Value); + if L then + SetPixelT(X2, Y2, Value); + Exit; + end; + + if Dy > 0 then + Sy := 1 + else + if Dy < 0 then + begin + Dy := -Dy; + Sy := -1; + end + else // Dy = 0 + begin + if Dx > 0 then + DrawHorzLineT(X1, Y1, X2 - 1, Value) + else + DrawHorzLineT(X2, Y1, X1 - 1, Value); + if L then + SetPixelT(X2, Y2, Value); + Exit; + end; + + P := PixelPtr[X1, Y1]; + Sy := Sy * Width; + + try + if Dx > Dy then + begin + Delta := Dx shr 1; + for I := 0 to Dx - 1 do + begin + BlendMem(Value, P^); + Inc(P, Sx); + Delta := Delta + Dy; + if Delta > Dx then + begin + Inc(P, Sy); + Delta := Delta - Dx; + end; + end; + end + else // Dx < Dy + begin + Delta := Dy shr 1; + for I := 0 to Dy - 1 do + begin + BlendMem(Value, P^); + Inc(P, Sy); + Delta := Delta + Dx; + if Delta > Dy then + begin + Inc(P, Sx); + Delta := Delta - Dy; + end; + end; + end; + if L then + BlendMem(Value, P^); + finally + EMMS; + end; + finally + Changed; + end; +end; + +procedure TJclBitmap32.DrawLineTS(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean); +begin + if ClipLine(X1, Y1, X2, Y2) then + DrawLineT(X1, Y1, X2, Y2, Value, L); +end; + +procedure TJclBitmap32.DrawLineF(X1, Y1, X2, Y2: Single; Value: TColor32; L: Boolean); +var + N, I: Integer; + px, py, ex, ey, nx, ny, hyp: Integer; + A: TColor32; +begin + Changing; + try + px := Round(x1 * 65536); + py := Round(y1 * 65536); + ex := Round(x2 * 65536); + ey := Round(y2 * 65536); + nx := ex - px; + ny := ey - py; + hyp := Round(Hypot(nx, ny)); + if L then + Inc(hyp, 65536); + if hyp < 256 then + Exit; + N := hyp shr 16; + if N > 0 then + begin + nx := Round(nx / hyp * 65536); + ny := Round(ny / hyp * 65536); + for I := 0 to N - 1 do + begin + SET_T256(px shr 8, py shr 8, Value); + px := px + nx; + py := py + ny; + end; + end; + A := Value shr 24; + hyp := hyp - N shl 16; + A := A * Longword(hyp) shl 8 and $FF000000; + SET_T256((px + ex - nx) shr 9, (py + ey - ny) shr 9, Value and _RGB + A); + finally + EMMS; + Changed; + end; +end; + +procedure TJclBitmap32.DrawLineFS(X1, Y1, X2, Y2: Single; Value: TColor32; L: Boolean); +var + N, I: Integer; + px, py, ex, ey, nx, ny, hyp: Integer; + A: TColor32; +begin + if ClipLineF(X1, Y1, X2, Y2, 0, FWidth, 0, FHeight) then + if (X1 < FWidth - 1) and (X2 < FWidth - 1) and + (Y1 < FHeight - 1) and (Y2 < FHeight - 1) then + DrawLineF(X1, Y1, X2, Y2, Value, False) + else // check every pixel + begin + Changing; + try + px := Round(x1 * 65536); + py := Round(y1 * 65536); + ex := Round(x2 * 65536); + ey := Round(y2 * 65536); + nx := ex - px; + ny := ey - py; + hyp := Round(Hypot(nx, ny)); + if L then + Inc(Hyp, 65536); + if hyp < 256 then + Exit; + N := hyp shr 16; + if N > 0 then + begin + nx := Round(nx / hyp * 65536); + ny := Round(ny / hyp * 65536); + for I := 0 to N - 1 do + begin + SET_TS256(px div 256, py div 256, Value); + px := px + nx; + py := py + ny; + end; + end; + A := Value shr 24; + hyp := hyp - N shl 16; + A := A * Longword(hyp) shl 8 and $FF000000; + SET_TS256(Sar(px + ex - nx,9), Sar(py + ey - ny,9), Value and _RGB + A); + finally + EMMS; + Changed; + end; + end; +end; + +procedure TJclBitmap32.DrawLineFP(X1, Y1, X2, Y2: Single; L: Boolean); +var + N, I: Integer; + px, py, ex, ey, nx, ny, hyp: Integer; + A, C: TColor32; +begin + Changing; + try + px := Round(x1 * 65536); + py := Round(y1 * 65536); + ex := Round(x2 * 65536); + ey := Round(y2 * 65536); + nx := ex - px; + ny := ey - py; + hyp := Round(Hypot(nx, ny)); + if L then + Inc(hyp, 65536); + if hyp < 256 then + Exit; + N := hyp shr 16; + if N > 0 then + begin + nx := Round(nx / hyp * 65536); + ny := Round(ny / hyp * 65536); + for I := 0 to N - 1 do + begin + C := GetStippleColor; + SET_T256(px shr 8, py shr 8, C); + EMMS; + px := px + nx; + py := py + ny; + end; + end; + C := GetStippleColor; + A := C shr 24; + hyp := hyp - N shl 16; + A := A * Longword(hyp) shl 8 and $FF000000; + SET_T256((px + ex - nx) shr 9, (py + ey - ny) shr 9, C and _RGB + A); + EMMS; + finally + Changed; + end; +end; + +procedure TJclBitmap32.DrawLineFSP(X1, Y1, X2, Y2: Single; L: Boolean); +var + N, I: Integer; + px, py, ex, ey, nx, ny, hyp: Integer; + A, C: TColor32; +begin + if ClipLineF(X1, Y1, X2, Y2, 0, FWidth, 0, FHeight) then + if (X1 < FWidth - 1) and (X2 < FWidth - 1) and + (Y1 < FHeight - 1) and (Y2 < FHeight - 1) then + DrawLineFP(X1, Y1, X2, Y2, False) + else // check every pixel + begin + Changing; + try + px := Round(x1 * 65536); + py := Round(y1 * 65536); + ex := Round(x2 * 65536); + ey := Round(y2 * 65536); + nx := ex - px; + ny := ey - py; + hyp := Round(Hypot(nx, ny)); + if L then + Inc(hyp, 65536); + if hyp < 256 then + Exit; + N := hyp shr 16; + if N > 0 then + begin + nx := Round(nx / hyp * 65536); + ny := Round(ny / hyp * 65536); + for I := 0 to N - 1 do + begin + C := GetStippleColor; + SET_TS256(px div 256, py div 256, C); + EMMS; + px := px + nx; + py := py + ny; + end; + end; + C := GetStippleColor; + A := C shr 24; + hyp := hyp - N shl 16; + A := A * Longword(hyp) shl 8 and $FF000000; + SET_TS256(Sar(px + ex - nx,9), Sar(py + ey - ny,9), C and _RGB + A); + EMMS; + finally + Changed; + end; + end; +end; + +procedure TJclBitmap32.DrawLineA(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean); +var + Dx, Dy, Sx, Sy, D: Integer; + EC, EA: Word; + CI: Byte; + P: PColor32; +begin + if (X1 = X2) or (Y1 = Y2) then + begin + DrawLineT(X1, Y1, X2, Y2, Value, L); + Exit; + end; + + Dx := X2 - X1; + Dy := Y2 - Y1; + + if Dx > 0 then + Sx := 1 + else + begin + Sx := -1; + Dx := -Dx; + end; + + if Dy > 0 then + Sy := 1 + else + begin + Sy := -1; + Dy := -Dy; + end; + + Changing; + try + EC := 0; + BlendMem(Value, Bits[X1 + Y1 * Width]); + + if Dy > Dx then + begin + EA := Dx shl 16 div Dy; + if not L then + Dec(Dy); + while Dy > 0 do + begin + Dec(Dy); + D := EC; + Inc(EC, EA); + if EC <= D then + Inc(X1, Sx); + Inc(Y1, Sy); + CI := EC shr 8; + P := @Bits[X1 + Y1 * Width]; + BlendMemEx(Value, P^, GAMMA_TABLE[CI xor 255]); + Inc(P, Sx); + BlendMemEx(Value, P^, GAMMA_TABLE[CI]); + end; + end + else // DY <= DX + begin + EA := Dy shl 16 div Dx; + if not L then + Dec(Dx); + while Dx > 0 do + begin + Dec(Dx); + D := EC; + Inc(EC, EA); + if EC <= D then + Inc(Y1, Sy); + Inc(X1, Sx); + CI := EC shr 8; + P := @Bits[X1 + Y1 * Width]; + BlendMemEx(Value, P^, GAMMA_TABLE[CI xor 255]); + if Sy = 1 then + Inc(P, Width) + else + Dec(P, Width); + BlendMemEx(Value, P^, GAMMA_TABLE[CI]); + end; + end; + finally + EMMS; + Changed; + end; +end; + +procedure TJclBitmap32.DrawLineAS(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean); +begin + if ClipLine(X1, Y1, X2, Y2) then + DrawLineA(X1, Y1, X2, Y2, Value, L); +end; + +procedure TJclBitmap32.MoveTo(X, Y: Integer); +begin + RasterX := X; + RasterY := Y; +end; + +procedure TJclBitmap32.LineToS(X, Y: Integer); +begin + DrawLineS(RasterX, RasterY, X, Y, PenColor, False); + RasterX := X; + RasterY := Y; +end; + +procedure TJclBitmap32.LineToTS(X, Y: Integer); +begin + DrawLineTS(RasterX, RasterY, X, Y, PenColor, False); + RasterX := X; + RasterY := Y; +end; + +procedure TJclBitmap32.LineToAS(X, Y: Integer); +begin + DrawLineAS(RasterX, RasterY, X, Y, PenColor, False); + RasterX := X; + RasterY := Y; +end; + +procedure TJclBitmap32.MoveToF(X, Y: Single); +begin + RasterXF := X; + RasterYF := Y; +end; + +procedure TJclBitmap32.LineToFS(X, Y: Single); +begin + DrawLineFS(RasterXF, RasterYF, X, Y, PenColor, False); + RasterXF := X; + RasterYF := Y; +end; + +procedure TJclBitmap32.FillRect(X1, Y1, X2, Y2: Integer; Value: TColor32); +var + J: Integer; + P: PColor32Array; +begin + Changing; + for J := Y1 to Y2 do + begin + P := Pointer(GetScanLine(J)); + FillLongword(P[X1], X2 - X1 + 1, Value); + end; + Changed; +end; + +procedure TJclBitmap32.FillRectS(X1, Y1, X2, Y2: Integer; Value: TColor32); +begin + if TestClip(X1, X2, Width) and TestClip(Y1, Y2, Height) then + FillRect(X1, Y1, X2, Y2, Value); +end; + +procedure TJclBitmap32.FillRectT(X1, Y1, X2, Y2: Integer; Value: TColor32); +var + I, J: Integer; + P: PColor32; + A: Integer; +begin + A := Value shr 24; + if A = $FF then + FillRect(X1, Y1, X2, Y2, Value) + else + begin + Changing; + try + for J := Y1 to Y2 do + begin + P := GetPixelPtr(X1, J); + for I := X1 to X2 do + begin + CombineMem(Value, P^, A); + Inc(P); + end; + end; + finally + EMMS; + Changed; + end; + end; +end; + +procedure TJclBitmap32.FillRectTS(X1, Y1, X2, Y2: Integer; Value: TColor32); +begin + if TestClip(X1, X2, Width) and TestClip(Y1, Y2, Height) then + FillRectT(X1, Y1, X2, Y2, Value); +end; + +procedure TJclBitmap32.FrameRectS(X1, Y1, X2, Y2: Integer; Value: TColor32); +begin + Changing; + TestSwap(X1, X2); + TestSwap(Y1, Y2); + DrawHorzLineS(X1, Y1, X2, Value); + if Y2 > Y1 then + DrawHorzLineS(X1, Y2, X2, Value); + if Y2 > Y1 + 1 then + begin + DrawVertLineS(X1, Y1 + 1, Y2 - 1, Value); + if X2 > X1 then + DrawVertLineS(X2, Y1 + 1, Y2 - 1, Value); + end; + Changed; +end; + +procedure TJclBitmap32.FrameRectTS(X1, Y1, X2, Y2: Integer; Value: TColor32); +begin + Changing; + TestSwap(X1, X2); + TestSwap(Y1, Y2); + DrawHorzLineTS(X1, Y1, X2, Value); + if Y2 > Y1 then + DrawHorzLineTS(X1, Y2, X2, Value); + if Y2 > Y1 + 1 then + begin + DrawVertLineTS(X1, Y1 + 1, Y2 - 1, Value); + if X2 > X1 then + DrawVertLineTS(X2, Y1 + 1, Y2 - 1, Value); + end; + Changed; +end; + +procedure TJclBitmap32.FrameRectTSP(X1, Y1, X2, Y2: Integer); +begin + Changing; + TestSwap(X1, X2); + TestSwap(Y1, Y2); + DrawHorzLineTSP(X1, Y1, X2); + if Y2 > Y1 + 1 then + begin + DrawVertLineTSP(X2, Y1 + 1, Y2 - 1); + if X2 > X1 then + DrawVertLineTSP(X1, Y1 + 1, Y2 - 1); + end; + if Y2 > Y1 then + DrawHorzLineTSP(X1, Y2, X2); + Changed; +end; + +procedure TJclBitmap32.RaiseRectTS(X1, Y1, X2, Y2: Integer; Contrast: Integer); +var + C1, C2: TColor32; +begin + Changing; + try + if Contrast > 0 then + begin + C1 := clWhite32; + C2 := clBlack32; + end + else + if Contrast < 0 then + begin + C1 := clBlack32; + C2 := clWhite32; + Contrast := -Contrast; + end + else + Exit; + Contrast := Clamp(Contrast * 255 div 100); + C1 := SetAlpha(C1, Contrast); + C2 := SetAlpha(C2, Contrast); + TestSwap(X1, X2); + TestSwap(Y1, Y2); + DrawHorzLineTS(X1, Y1, X2 - 1, C1); + DrawHorzLineTS(X1 + 1, Y2, X2, C2); + DrawVertLineTS(X1, Y1, Y2 - 1, C1); + DrawVertLineTS(X2, Y1 + 1, Y2, C2); + finally + Changed; + end; +end; + +procedure TJclBitmap32.LoadFromStream(Stream: TStream); +var + B: TBitmap; +begin + Changing; + B := TBitmap.Create; + try + B.LoadFromStream(Stream); + Assign(B); + finally + B.Free; + Changed; + end; +end; + +procedure TJclBitmap32.SaveToStream(Stream: TStream); +var + B: TBitmap; +begin + B := TBitmap.Create; + try + AssignTo(B); + B.SaveToStream(Stream); + finally + B.Free; + end; +end; + +procedure TJclBitmap32.DefineProperties(Filer: TFiler); + + function DoWrite: Boolean; + begin + if Filer.Ancestor <> nil then + Result := not (Filer.Ancestor is TGraphic) + else + Result := not Empty; + end; + +begin + Filer.DefineBinaryProperty('Data', ReadData, WriteData, DoWrite); +end; + +procedure TJclBitmap32.ReadData(Stream: TStream); +var + w, h: Integer; +begin + Changing; + try + Stream.ReadBuffer(w, 4); + Stream.ReadBuffer(h, 4); + SetSize(w, h); + Stream.ReadBuffer(FBits[0], FWidth * FHeight * 4); + finally + Changed; + end; +end; + +procedure TJclBitmap32.WriteData(Stream: TStream); +begin + Stream.WriteBuffer(FWidth, 4); + Stream.WriteBuffer(FHeight, 4); + Stream.WriteBuffer(FBits[0], FWidth * FHeight * 4); +end; + +procedure TJclBitmap32.LoadFromFile(const FileName: string); +var + P: TPicture; +begin + P := TPicture.Create; + try + P.LoadFromFile(FileName); + Assign(P); + finally + P.Free; + end; +end; + +procedure TJclBitmap32.SaveToFile(const FileName: string); +var + B: TBitmap; +begin + B := TBitmap.Create; + try + AssignTo(B); + B.SaveToFile(FileName); + finally + B.Free; + end; +end; + +procedure TJclBitmap32.SetFont(Value: TFont); +begin + FFont.Assign(Value); + FontChanged(Self); +end; + +procedure TJclBitmap32.FontChanged(Sender: TObject); +begin + if FontHandle > 0 then + begin + SelectObject(Handle, GetStockObject(SYSTEM_FONT)); + FontHandle := 0; + end; +end; + +procedure TJclBitmap32.UpdateFont; +begin + if FontHandle = 0 then + begin + SelectObject(Handle, Font.Handle); + SetTextColor(Handle, ColorToRGB(Font.Color)); + SetBkMode(Handle, {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.TRANSPARENT); + end; +end; + +procedure TJclBitmap32.SetDrawMode(Value: TDrawMode); +begin + if FDrawMode <> Value then + begin + Changing; + FDrawMode := Value; + Changed; + end; +end; + +procedure TJclBitmap32.SetMasterAlpha(Value: Byte); +begin + if FMasterAlpha <> Value then + begin + Changing; + FMasterAlpha := Value; + Changed; + end; +end; + +procedure TJclBitmap32.SetStretchFilter(Value: TStretchFilter); +begin + if FStretchFilter <> Value then + begin + Changing; + FStretchFilter := Value; + Changed; + end; +end; + +function TJclBitmap32.TextExtent(const Text: string): TSize; +begin + UpdateFont; + Result.cX := 0; + Result.cY := 0; + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetTextExtentPoint32(Handle, PChar(Text), Length(Text), Result); +end; + +procedure TJclBitmap32.TextOut(X, Y: Integer; const Text: string); +begin + Changing; + UpdateFont; + ExtTextOut(Handle, X, Y, 0, nil, PChar(Text), Length(Text), nil); + Changed; +end; + +procedure TJclBitmap32.TextOut(X, Y: Integer; const ClipRect: TRect; + const Text: string); +begin + Changing; + UpdateFont; + ExtTextOut(Handle, X, Y, ETO_CLIPPED, @ClipRect, PChar(Text), Length(Text), nil); + Changed; +end; + +procedure TJclBitmap32.TextOut(ClipRect: TRect; const Flags: Cardinal; + const Text: string); +begin + Changing; + UpdateFont; + DrawText(Handle, PChar(Text), Length(Text), ClipRect, Flags); + Changed; +end; + +function TJclBitmap32.TextHeight(const Text: string): Integer; +begin + Result := TextExtent(Text).cY; +end; + +function TJclBitmap32.TextWidth(const Text: string): Integer; +begin + Result := TextExtent(Text).cX; +end; + +procedure TJclBitmap32.RenderText(X, Y: Integer; const Text: string; AALevel: Integer; Color: TColor32); +var + B, B2: TJclBitmap32; + Sz: TSize; + C: TColor32; + I: Integer; + P: PColor32; +begin + AALevel := Constrain(AALevel, 0, 4); + B := TJclBitmap32.Create; + try + if AALevel = 0 then + begin + Sz := TextExtent(Text + ' '); + B.SetSize(Sz.cX, Sz.cY); + B.Font := Font; + B.Clear(0); + B.Font.Color := clWhite; + B.TextOut(0, 0, Text); + end + else + begin + B2 := TJclBitmap32.Create; + try + B2.SetSize(1, 1); // just need some DC here + B2.Font := Font; + B2.Font.Size := Font.Size shl AALevel; + Sz := B2.TextExtent(Text + ' '); + Sz.cx := (Sz.cx shr AALevel + 1) shl AALevel; + B2.SetSize(Sz.cx, Sz.cy); + B2.Clear(0); + B2.Font.Color := clWhite; + B2.TextOut(0, 0, Text); + B2.StretchFilter := sfLinear; + B.SetSize(Sz.cx shr AALevel, Sz.cy shr AALevel); + B.Draw(Rect(0, 0, B.Width, B.Height), Rect(0, 0, B2.Width, B2.Height), B2); + finally + B2.Free; + end; + end; + + // convert intensity and color to alpha + B.MasterAlpha := Color shr 24; + Color := Color and $00FFFFFF; + P := @B.Bits[0]; + for I := 0 to B.Width * B.Height - 1 do + begin + C := P^; + if C <> 0 then + begin + C := P^ shl 24; // transfer blue channel to alpha + C := C + Color; + P^ := C; + end; + Inc(P); + end; + B.DrawMode := dmBlend; + + B.DrawTo(Self, X, Y); + finally + B.Free; + end; +end; + +//=== { TJclByteMap } ======================================================== + +destructor TJclByteMap.Destroy; +begin + FBytes := nil; + inherited Destroy; +end; + +procedure TJclByteMap.Assign(Source: TPersistent); +begin + Changing; + BeginUpdate; + try + if Source is TJclByteMap then + begin + FWidth := TJclByteMap(Source).Width; + FHeight := TJclByteMap(Source).Height; + FBytes := Copy(TJclByteMap(Source).Bytes, 0, FWidth * FHeight); + end + else + if Source is TJclBitmap32 then + ReadFrom(TJclBitmap32(Source), ckWeightedRGB) + else + inherited Assign(Source); + finally + EndUpdate; + Changed; + end; +end; + +procedure TJclByteMap.AssignTo(Dst: TPersistent); +begin + if Dst is TJclBitmap32 then + WriteTo(TJclBitmap32(Dst), ckUniformRGB) + else + inherited AssignTo(Dst); +end; + +procedure TJclByteMap.Clear(FillValue: Byte); +begin + Changing; + FillChar(Bytes[0], Width * Height, FillValue); + Changed; +end; + +function TJclByteMap.Empty: Boolean; +begin + Result := Bytes = nil; +end; + +function TJclByteMap.GetValPtr(X, Y: Integer): PByte; +begin + Result := @Bytes[X + Y * Width]; +end; + +function TJclByteMap.GetValue(X, Y: Integer): Byte; +begin + Result := Bytes[X + Y * Width]; +end; + +procedure TJclByteMap.ReadFrom(Source: TJclBitmap32; Conversion: TConversionKind); +var + W, H, I, N: Integer; + SrcC: PColor32; + SrcB, DstB: PByte; + Value: TColor32; +begin + Changing; + BeginUpdate; + try + SetSize(Source.Width, Source.Height); + if Empty then + Exit; + + W := Source.Width; + H := Source.Height; + N := W * H - 1; + SrcC := Source.PixelPtr[0, 0]; + SrcB := Pointer(SrcC); + DstB := @Bytes[0]; + case Conversion of + ckRed: + begin + Inc(SrcB, 2); + for I := 0 to N do + begin + DstB^ := SrcB^; + Inc(DstB); + Inc(SrcB, 4); + end; + end; + ckGreen: + begin + Inc(SrcB, 1); + for I := 0 to N do + begin + DstB^ := SrcB^; + Inc(DstB); + Inc(SrcB, 4); + end; + end; + ckBlue: + begin + for I := 0 to N do + begin + DstB^ := SrcB^; + Inc(DstB); + Inc(SrcB, 4); + end; + end; + ckAlpha: + begin + Inc(SrcB, 3); + for I := 0 to N do + begin + DstB^ := SrcB^; + Inc(DstB); + Inc(SrcB, 4); + end; + end; + ckUniformRGB: + begin + for I := 0 to N do + begin + Value := SrcC^; + Value := (Value and $00FF0000) shr 16 + (Value and $0000FF00) shr 8 + + (Value and $000000FF); + Value := Value div 3; + DstB^ := Value; + Inc(DstB); + Inc(SrcC); + end; + end; + ckWeightedRGB: + begin + for I := 0 to N do + begin + DstB^ := Intensity(SrcC^); + Inc(DstB); + Inc(SrcC); + end; + end; + end; + finally + EndUpdate; + Changed; + end; +end; + +procedure TJclByteMap.SetValue(X, Y: Integer; Value: Byte); +begin + Bytes[X + Y * Width] := Value; +end; + +procedure TJclByteMap.SetSize(NewWidth, NewHeight: Integer); +begin + Changing; + inherited SetSize(NewWidth, NewHeight); + SetLength(FBytes, Width * Height); + Changed; +end; + +procedure TJclByteMap.WriteTo(Dest: TJclBitmap32; Conversion: TConversionKind); +var + W, H, I, N: Integer; + DstC: PColor32; + DstB, SrcB: PByte; +begin + Dest.Changing; + Dest.BeginUpdate; + try + Dest.SetSize(Width, Height); + if Empty then + Exit; + + W := Width; + H := Height; + N := W * H - 1; + DstC := Dest.PixelPtr[0, 0]; + DstB := Pointer(DstC); + SrcB := @Bytes[0]; + case Conversion of + ckRed: + begin + Inc(DstB, 2); + for I := 0 to N do + begin + DstB^ := SrcB^; + Inc(DstB, 4); + Inc(SrcB); + end; + end; + ckGreen: + begin + Inc(DstB, 1); + for I := 0 to N do + begin + DstB^ := SrcB^; + Inc(DstB, 4); + Inc(SrcB); + end; + end; + ckBlue: + begin + for I := 0 to N do + begin + DstB^ := SrcB^; + Inc(DstB, 4); + Inc(SrcB); + end; + end; + ckAlpha: + begin + Inc(DstB, 3); + for I := 0 to N do + begin + DstB^ := SrcB^; + Inc(DstB, 4); + Inc(SrcB); + end; + end; + ckUniformRGB, ckWeightedRGB: + begin + for I := 0 to N do + begin + DstC^ := Gray32(SrcB^, $FF); + Inc(DstC); + Inc(SrcB); + end; + end; + end; + finally + Dest.EndUpdate; + Dest.Changed; + end; +end; + +procedure TJclByteMap.WriteTo(Dest: TJclBitmap32; const Palette: TPalette32); +var + W, H, I, N: Integer; + DstC: PColor32; + SrcB: PByte; +begin + Dest.Changing; + Dest.BeginUpdate; + try + Dest.SetSize(Width, Height); + if Empty then + Exit; + + W := Width; + H := Height; + N := W * H - 1; + DstC := Dest.PixelPtr[0, 0]; + SrcB := @Bytes[0]; + + for I := 0 to N do + begin + DstC^ := Palette[SrcB^]; + Inc(DstC); + Inc(SrcB); + end; + finally + Dest.EndUpdate; + Dest.Changed; + end; +end; +{$ENDIF Bitmap32} + +//=== Matrices =============================================================== + +{ TODO -oWIMDC -cReplace : Insert JclMatrix support } +function _DET(a1, a2, b1, b2: Extended): Extended; overload; +begin + Result := a1 * b2 - a2 * b1; +end; + +function _DET(a1, a2, a3, b1, b2, b3, c1, c2, c3: Extended): Extended; overload; +begin + Result := + a1 * (b2 * c3 - b3 * c2) - + b1 * (a2 * c3 - a3 * c2) + + c1 * (a2 * b3 - a3 * b2); +end; + +procedure Adjoint(var M: TMatrix3d); +var + a1, a2, a3: Extended; + b1, b2, b3: Extended; + c1, c2, c3: Extended; +begin + a1 := M.A[0, 0]; + a2 := M.A[0, 1]; + a3 := M.A[0, 2]; + + b1 := M.A[1, 0]; + b2 := M.A[1, 1]; + b3 := M.A[1, 2]; + + c1 := M.A[2, 0]; + c2 := M.A[2, 1]; + c3 := M.A[2, 2]; + + M.A[0, 0]:= _DET(b2, b3, c2, c3); + M.A[0, 1]:= -_DET(a2, a3, c2, c3); + M.A[0, 2]:= _DET(a2, a3, b2, b3); + + M.A[1, 0]:= -_DET(b1, b3, c1, c3); + M.A[1, 1]:= _DET(a1, a3, c1, c3); + M.A[1, 2]:= -_DET(a1, a3, b1, b3); + + M.A[2, 0]:= _DET(b1, b2, c1, c2); + M.A[2, 1]:= -_DET(a1, a2, c1, c2); + M.A[2, 2]:= _DET(a1, a2, b1, b2); +end; + +function Determinant(const M: TMatrix3d): Extended; +begin + Result := _DET( + M.A[0, 0], M.A[1, 0], M.A[2, 0], + M.A[0, 1], M.A[1, 1], M.A[2, 1], + M.A[0, 2], M.A[1, 2], M.A[2, 2]); +end; + +procedure Scale(var M: TMatrix3d; Factor: Extended); +var + I, J: Integer; +begin + for I := 0 to 2 do + for J := 0 to 2 do + M.A[I, J] := M.A[I, J] * Factor; +end; + +procedure InvertMatrix(var M: TMatrix3d); +var + Det: Extended; +begin + Det := Determinant(M); + if Abs(Det) < 1E-5 then + M := IdentityMatrix + else + begin + Adjoint(M); + Scale(M, 1 / Det); + end; +end; + +function Mult(const M1, M2: TMatrix3d): TMatrix3d; +var + I, J: Integer; +begin + for I := 0 to 2 do + for J := 0 to 2 do + Result.A[I, J] := + M1.A[0, J] * M2.A[I, 0] + + M1.A[1, J] * M2.A[I, 1] + + M1.A[2, J] * M2.A[I, 2]; +end; + +type + TVector3d = array [0..2] of Extended; + TVector3i = array [0..2] of Integer; + +function VectorTransform(const M: TMatrix3d; const V: TVector3d): TVector3d; +begin + Result[0] := M.A[0, 0] * V[0] + M.A[1, 0] * V[1] + M.A[2, 0] * V[2]; + Result[1] := M.A[0, 1] * V[0] + M.A[1, 1] * V[1] + M.A[2, 1] * V[2]; + Result[2] := M.A[0, 2] * V[0] + M.A[1, 2] * V[1] + M.A[2, 2] * V[2]; +end; + +//=== { TJclLinearTransformation } =========================================== + +constructor TJclLinearTransformation.Create; +begin + inherited Create; + Clear; +end; + +procedure TJclLinearTransformation.Clear; +begin + FMatrix := IdentityMatrix; +end; + +function TJclLinearTransformation.GetTransformedBounds(const Src: TRect): TRect; +var + V1, V2, V3, V4: TVector3d; +begin + V1[0] := Src.Left; + V1[1] := Src.Top; + V1[2] := 1; + + V2[0] := Src.Right - 1; + V2[1] := V1[1]; + V2[2] := 1; + + V3[0] := V1[0]; + V3[1] := Src.Bottom - 1; + V3[2] := 1; + + V4[0] := V2[0]; + V4[1] := V3[1]; + V4[2] := 1; + + V1 := VectorTransform(Matrix, V1); + V2 := VectorTransform(Matrix, V2); + V3 := VectorTransform(Matrix, V3); + V4 := VectorTransform(Matrix, V4); + + Result.Left := Round(Min(Min(V1[0], V2[0]), Min(V3[0], V4[0])) - 0.5); + Result.Right := Round(Max(Max(V1[0], V2[0]), Max(V3[0], V4[0])) + 0.5); + Result.Top := Round(Min(Min(V1[1], V2[1]), Min(V3[1], V4[1])) - 0.5); + Result.Bottom := Round(Max(Max(V1[1], V2[1]), Max(V3[1], V4[1])) + 0.5); +end; + +procedure TJclLinearTransformation.PrepareTransform; +var + M: TMatrix3d; +begin + M := Matrix; + InvertMatrix(M); + + // calculate a fixed point (4096) factors + A := Round(M.A[0, 0] * 4096); + B := Round(M.A[1, 0] * 4096); + C := Round(M.A[2, 0] * 4096); + D := Round(M.A[0, 1] * 4096); + E := Round(M.A[1, 1] * 4096); + F := Round(M.A[2, 1] * 4096); +end; + +procedure TJclLinearTransformation.Rotate(Cx, Cy, Alpha: Extended); +var + S, C: Extended; + M: TMatrix3d; +begin + if (Cx <> 0) and (Cy <> 0) then + Translate(-Cx, -Cy); + SinCos(DegToRad(Alpha), S, C); + M := IdentityMatrix; + M.A[0, 0] := C; + M.A[1, 0] := S; + M.A[0, 1] := -S; + M.A[1, 1] := C; + FMatrix := Mult(M, FMatrix); + if (Cx <> 0) and (Cy <> 0) then + Translate(Cx, Cy); +end; + +procedure TJclLinearTransformation.Scale(Sx, Sy: Extended); +var + M: TMatrix3d; +begin + M := IdentityMatrix; + M.A[0, 0] := Sx; + M.A[1, 1] := Sy; + FMatrix := Mult(M, FMatrix); +end; + +procedure TJclLinearTransformation.Skew(Fx, Fy: Extended); +var + M: TMatrix3d; +begin + M := IdentityMatrix; + M.A[1, 0] := Fx; + M.A[0, 1] := Fy; + FMatrix := Mult(M, FMatrix); +end; + +procedure TJclLinearTransformation.Transform(DstX, DstY: Integer; + out SrcX, SrcY: Integer); +begin + SrcX := Sar(DstX * A + DstY * B + C, 12); + SrcY := Sar(DstX * D + DstY * E + F, 12); +end; + +procedure TJclLinearTransformation.Transform256(DstX, DstY: Integer; + out SrcX256, SrcY256: Integer); +begin + SrcX256 := Sar(DstX * A + DstY * B + C, 4); + SrcY256 := Sar(DstX * D + DstY * E + F, 4); +end; + +procedure TJclLinearTransformation.Translate(Dx, Dy: Extended); +var + M: TMatrix3d; +begin + M := IdentityMatrix; + M.A[2, 0] := Dx; + M.A[2, 1] := Dy; + FMatrix := Mult(M, FMatrix); +end; + +//=== PolyLines and Polygons ================================================= + +{$IFDEF Bitmap32} +procedure PolylineTS(Bitmap: TJclBitmap32; const Points: TDynPointArray; + Color: TColor32); +var + I, L: Integer; + DoAlpha: Boolean; +begin + DoAlpha := Color and $FF000000 <> $FF000000; + L := Length(Points); + if L < 2 then + Exit; + + Bitmap.Changing; + Bitmap.BeginUpdate; + with Points[L - 1] do + Bitmap.MoveTo(X, Y); + Bitmap.PenColor := Color; + if DoAlpha then + for I := 0 to L - 1 do + with Points[I] do + Bitmap.LineToTS(X, Y) + else + for I := 0 to L - 1 do + with Points[I] do + Bitmap.LineToS(X, Y); + Bitmap.EndUpdate; + Bitmap.Changed; +end; + +procedure PolyLineAS(Bitmap: TJclBitmap32; const Points: TDynPointArray; + Color: TColor32); +var + I, L: Integer; +begin + L := Length(Points); + if L < 2 then + Exit; + Bitmap.Changing; + Bitmap.BeginUpdate; + with Points[L - 1] do + Bitmap.MoveTo(X, Y); + Bitmap.PenColor := Color; + for I := 0 to L - 1 do + with Points[I] do + Bitmap.LineToAS(X, Y); + Bitmap.EndUpdate; + Bitmap.Changed; +end; + +procedure PolylineFS(Bitmap: TJclBitmap32; const Points: TDynPointArrayF; + Color: TColor32); +var + I, L: Integer; +begin + L := Length(Points); + if L < 2 then + Exit; + Bitmap.Changing; + Bitmap.BeginUpdate; + with Points[L - 1] do + Bitmap.MoveToF(X, Y); + Bitmap.PenColor := Color; + for I := 0 to L - 1 do + with Points[I] do + Bitmap.LineToFS(X, Y); + Bitmap.EndUpdate; + Bitmap.Changed; +end; +{$ENDIF Bitmap32} + +procedure QSortLine(const ALine: TScanLine; L, R: Integer); +var + I, J, P: Integer; +begin + repeat + I := L; + J := R; + P := ALine[(L + R) shr 1]; + repeat + while ALine[I] < P do + Inc(I); + while ALine[J] > P do + Dec(J); + if I <= J then + begin + SwapOrd(ALine[I], ALine[J]); + Inc(I); + Dec(J); + end; + until I > J; + if L < J then + QSortLine(ALine, L, J); + L := I; + until I >= R; +end; + +procedure SortLine(const ALine: TScanLine); +var + L: Integer; +begin + L := Length(ALine); + Assert(not Odd(L)); + if L = 2 then + TestSwap(ALine[0], ALine[1]) + else + if L > 2 then + QSortLine(ALine, 0, L - 1); +end; + +procedure SortLines(const ScanLines: TScanLines); +var + I: Integer; +begin + for I := 0 to High(ScanLines) do + SortLine(ScanLines[I]); +end; + +procedure AddPolygon(const Points: TDynPointArray; BaseY: Integer; + MaxX, MaxY: Integer; var ScanLines: TScanLines; SubSampleX: Boolean); +var + I, X1, Y1, X2, Y2: Integer; + Direction, PrevDirection: Integer; // up = 1 or down = -1 + + procedure AddEdgePoint(X, Y: Integer); + var + L: Integer; + begin + if (Y < 0) or (Y > MaxY) then + Exit; + X := Constrain(X, 0, MaxX); + L := Length(ScanLines[Y - BaseY]); + SetLength(ScanLines[Y - BaseY], L + 1); + ScanLines[Y - BaseY][L] := X; + end; + + procedure DrawEdge(X1, Y1, X2, Y2: Integer); + var + X, Y, I: Integer; + Dx, Dy, Sx, Sy: Integer; + Delta: Integer; + begin + // this function 'renders' a line into the edge (ScanLines) buffer + if Y2 = Y1 then + Exit; + + Dx := X2 - X1; + Dy := Y2 - Y1; + + if Dy > 0 then + Sy := 1 + else + begin + Sy := -1; + Dy := -Dy; + end; + if Dx > 0 then + Sx := 1 + else + begin + Sx := -1; + Dx := -Dx; + end; + Delta := (Dx mod Dy) shr 1; + X := X1; + Y := Y1; + for I := 0 to Dy - 1 do + begin + AddEdgePoint(X, Y); + Inc(Y, Sy); + Inc(Delta, Dx); + while Delta > Dy do + begin + Inc(X, Sx); + Dec(Delta, Dy); + end; + end; + end; + +begin + X1 := Points[0].X; + Y1 := Points[0].Y; + if SubSampleX then + X1 := X1 shl 8; + + // find the last Y different from Y1 and assign it to Y0 + PrevDirection := 0; + for I := High(Points) downto 1 do + begin + if Points[I].Y > Y1 then + PrevDirection := -1 + else + if Points[I].Y < Y1 then + PrevDirection := 1 + else + Continue; + Break; + end; + Assert(PrevDirection <> 0); + + for I := 1 to High(Points) do + begin + X2 := Points[I].X; + Y2 := Points[I].Y; + if SubSampleX then + X2 := X2 shl 8; + if Y1 <> Y2 then + begin + DrawEdge(X1, Y1, X2, Y2); + if Y2 > Y1 then + Direction := 1 // up + else + Direction := -1; // down + if Direction <> PrevDirection then + begin + AddEdgePoint(X1, Y1); + PrevDirection := Direction; + end; + end; + X1 := X2; + Y1 := Y2; + end; + X2 := Points[0].X; + Y2 := Points[0].Y; + if SubSampleX then + X2 := X2 shl 8; + if Y1 <> Y2 then + begin + DrawEdge(X1, Y1, X2, Y2); + if Y2 > Y1 then + Direction := 1 + else + Direction := -1; + if Direction <> PrevDirection then + AddEdgePoint(X1, Y1); + end; +end; +{$IFDEF Bitmap32} + +procedure FillLines(Bitmap: TJclBitmap32; BaseY: Integer; + const ScanLines: TScanLines; Color: TColor32); +var + I, J, L: Integer; + Left, Right: Integer; + DoAlpha: Boolean; +begin + DoAlpha := Color and $FF000000 <> $FF000000; + for J := 0 to High(ScanLines) do + begin + L := Length(ScanLines[J]); // assuming length is even + I := 0; + while I < L do + begin + Left := ScanLines[J][I]; + Inc(I); + Right := ScanLines[J][I]; + if Right > Left then + begin + if (Left and $FF) < $80 then + Left := Left shr 8 + else + Left := Left shr 8 + 1; + if (Right and $FF) < $80 then + Right := Right shr 8 + else + Right := Right shr 8 + 1; + if DoAlpha then + Bitmap.DrawHorzLineT(Left, BaseY + J, Right, Color) + else + Bitmap.DrawHorzLine(Left, BaseY + J, Right, Color); + end; + Inc(I); + end; + end; +end; + +procedure FillLines2(Bitmap: TJclBitmap32; BaseY: Integer; + const ScanLines: TScanLines; Color: TColor32); +var + I, J, L, N: Integer; + MinY, MaxY, Y, Top, Bottom: Integer; + MinX, MaxX, X, Dx: Integer; + Left, Right: Integer; + Buffer: array of Integer; + P: PColor32; + DoAlpha: Boolean; +begin + DoAlpha := Color and $FF000000 <> $FF000000; + // find the range of Y screen coordinates + MinY := BaseY shr 4; + MaxY := (BaseY + Length(ScanLines) + 15) shr 4; + + Y := MinY; + while Y < MaxY do + begin + Top := Y shl 4 - BaseY; + Bottom := Top + 15; + if Top < 0 then + Top := 0; + if Bottom > High(ScanLines) then + Bottom := High(ScanLines); + + // find left and right edges of the screen scanline + MinX := 1000000; + MaxX := -1000000; + for J := Top to Bottom do + begin + L := High(ScanLines[J]); + Left := ScanLines[J][0] shr 4; + Right := (ScanLines[J][L] + 15) shr 4; + if Left < MinX then + MinX := Left; + if Right > MaxX then + MaxX := Right; + end; + + // allocate the buffer for a screen scanline + SetLength(Buffer, MaxX - MinX + 2); + FillLongword(Buffer[0], Length(Buffer), 0); + + // and fill it + for J := Top to Bottom do + begin + I := 0; + L := Length(ScanLines[J]); + while I < L do + begin + // Left edge + X := ScanLines[J][I]; + Dx := X and $0F; + X := X shr 4 - MinX; + Inc(Buffer[X], Dx xor $0F); + Inc(Buffer[X + 1], Dx); + Inc(I); + + // Right edge + X := ScanLines[J][I]; + Dx := X and $0F; + X := X shr 4 - MinX; + Dec(Buffer[X], Dx xor $0F); + Dec(Buffer[X + 1], Dx); + Inc(I); + end; + end; + + // integrate the buffer + N := 0; + for I := 0 to High(Buffer) do + begin + Inc(N, Buffer[I]); + Buffer[I] := N * 273 shr 8; // some bias + end; + + // draw it to the screen + P := Bitmap.PixelPtr[MinX, Y]; + try + if DoAlpha then + for I := 0 to High(Buffer) do + begin + BlendMemEx(Color, P^, Buffer[I]); + Inc(P); + end + else + for I := 0 to High(Buffer) do + begin + N := Buffer[I]; + if N = 255 then + P^ := Color + else + BlendMemEx(Color, P^, Buffer[I]); + Inc(P); + end; + finally + EMMS; + end; + + Inc(Y); + end; +end; + +procedure GetMinMax(const Points: TDynPointArray; out MinY, MaxY: Integer); +var + I, Y: Integer; +begin + MinY := 100000; + MaxY := -100000; + for I := 0 to High(Points) do + begin + Y := Points[I].Y; + if Y < MinY then + MinY := Y; + if Y > MaxY then + MaxY := Y; + end; +end; + +procedure PolygonTS(Bitmap: TJclBitmap32; const Points: TDynPointArray; Color: TColor32); +var + L, MinY, MaxY: Integer; + ScanLines: TScanLines; +begin + L := Length(Points); + if L < 3 then + Exit; + GetMinMax(Points, MinY, MaxY); + MinY := Constrain(MinY, 0, Bitmap.Height); + MaxY := Constrain(MaxY, 0, Bitmap.Height); + if MinY >= MaxY then + Exit; + SetLength(ScanLines, MaxY - MinY + 1); + AddPolygon(Points, MinY, Bitmap.Width shl 8 - 1, Bitmap.Height - 1, + ScanLines, True); + SortLines(ScanLines); + Bitmap.Changing; + Bitmap.BeginUpdate; + try + FillLines(Bitmap, MinY, ScanLines, Color); + finally + Bitmap.EndUpdate; + Bitmap.Changed; + end; +end; + +procedure PolygonAS(Bitmap: TJclBitmap32; const Points: TDynPointArray; Color: TColor32); +var + L, I, MinY, MaxY: Integer; + ScanLines: TScanLines; + PP: TDynPointArray; +begin + L := Length(Points); + if L < 3 then + Exit; + SetLength(PP, L); + for I := 0 to L - 1 do + begin + PP[I].X := Points[I].X shl 4 + 7; + PP[I].Y := Points[I].Y shl 4 + 7; + end; + GetMinMax(PP, MinY, MaxY); + MinY := Constrain(MinY, 0, Bitmap.Height shl 4 - 1); + MaxY := Constrain(MaxY, 0, Bitmap.Height shl 4 - 1); + if MinY >= MaxY then + Exit; + SetLength(ScanLines, MaxY - MinY + 1); + AddPolygon(PP, MinY, Bitmap.Width shl 4 - 1, Bitmap.Height shl 4 - 1, + ScanLines, False); + SortLines(ScanLines); + Bitmap.Changing; + Bitmap.BeginUpdate; + try + FillLines2(Bitmap, MinY, ScanLines, Color); + finally + Bitmap.EndUpdate; + Bitmap.Changed; + end; +end; + +procedure PolygonFS(Bitmap: TJclBitmap32; const Points: TDynPointArrayF; Color: TColor32); +var + L, I, MinY, MaxY: Integer; + ScanLines: TScanLines; + PP: TDynPointArray; +begin + L := Length(Points); + if L < 3 then + Exit; + SetLength(PP, L); + for I := 0 to L - 1 do + begin + PP[I].X := Round(Points[I].X * 16) + 7; + PP[I].Y := Round(Points[I].Y * 16) + 7; + end; + GetMinMax(PP, MinY, MaxY); + MinY := Constrain(MinY, 0, Bitmap.Height shl 4 - 1); + MaxY := Constrain(MaxY, 0, Bitmap.Height shl 4 - 1); + if MinY >= MaxY then + Exit; + SetLength(ScanLines, MaxY - MinY + 1); + AddPolygon(PP, MinY, Bitmap.Width shl 4 - 1, Bitmap.Height shl 4 - 1, + ScanLines, False); + SortLines(ScanLines); + Bitmap.Changing; + Bitmap.BeginUpdate; + try + FillLines2(Bitmap, MinY, ScanLines, Color); + finally + Bitmap.EndUpdate; + Bitmap.Changed; + end; +end; + +procedure PolyPolygonTS(Bitmap: TJclBitmap32; const Points: TDynDynPointArrayArray; + Color: TColor32); +var + N, L, min, max, MinY, MaxY: Integer; + ScanLines: TScanLines; +begin + MinY := 100000; + MaxY := -100000; + for N := 0 to High(Points) do + begin + L := Length(Points[N]); + if L < 3 then + Exit; + GetMinMax(Points[N], min, max); + if min < MinY then + MinY := min; + if max > MaxY then + MaxY := max; + end; + MinY := Constrain(MinY, 0, Bitmap.Height - 1); + MaxY := Constrain(MaxY, 0, Bitmap.Height - 1); + if MinY >= MaxY then + Exit; + SetLength(ScanLines, MaxY - MinY + 1); + + for N := 0 to High(Points) do + AddPolygon(Points[N], MinY, Bitmap.Width shl 8 - 1 , Bitmap.Height - 1, + ScanLines, True); + + SortLines(ScanLines); + + Bitmap.Changing; + FillLines(Bitmap, MinY, ScanLines, Color); + Bitmap.Changed; +end; + +procedure PolyPolygonAS(Bitmap: TJclBitmap32; const Points: TDynDynPointArrayArray; + Color: TColor32); +var + N, L, I, min, max, MinY, MaxY: Integer; + ScanLines: TScanLines; + PPP: TDynDynPointArrayArray; +begin + MinY := 100000; + MaxY := -100000; + SetLength(PPP, Length(Points)); + for N := 0 to High(Points) do + begin + L := Length(Points); + SetLength(PPP[N], Length(Points[N])); + for I := 0 to L - 1 do + begin + PPP[N][I].X := Points[N][I].X shl 4 + 7; + PPP[N][I].Y := Points[N][I].Y shl 4 + 7; + end; + if L < 3 then + Continue; + GetMinMax(PPP[N], min, max); + if min < MinY then + MinY := min; + if max > MaxY then + MaxY := max; + end; + MinY := Constrain(MinY, 0, Bitmap.Height shl 4 - 1); + MaxY := Constrain(MaxY, 0, Bitmap.Height shl 4 - 1); + if MinY >= MaxY then + Exit; + SetLength(ScanLines, MaxY - MinY + 1); + + for N := 0 to High(PPP) do + begin + AddPolygon(PPP[N], MinY, Bitmap.Width shl 4 - 1, Bitmap.Height shl 4 - 1, + ScanLines, False); + end; + + SortLines(ScanLines); + + Bitmap.Changing; + FillLines2(Bitmap, MinY, ScanLines, Color); + Bitmap.Changed; +end; + +procedure PolyPolygonFS(Bitmap: TJclBitmap32; const Points: TDynDynPointArrayArrayF; + Color: TColor32); +var + N, L, I, min, max, MinY, MaxY: Integer; + ScanLines: TScanLines; + PPP: TDynDynPointArrayArray; +begin + MinY := 100000; + MaxY := -100000; + SetLength(PPP, Length(Points)); + for N := 0 to High(Points) do + begin + L := Length(Points); + SetLength(PPP[N], Length(Points[N])); + for I := 0 to L - 1 do + begin + PPP[N][I].X := Round(Points[N][I].X * 16) + 7; + PPP[N][I].Y := Round(Points[N][I].Y * 16) + 7; + end; + if L < 3 then + Continue; + GetMinMax(PPP[N], min, max); + if min < MinY then + MinY := min; + if max > MaxY then + MaxY := max; + end; + MinY := Constrain(MinY, 0, Bitmap.Height shl 4 - 1); + MaxY := Constrain(MaxY, 0, Bitmap.Height shl 4 - 1); + if MinY >= MaxY then + Exit; + SetLength(ScanLines, MaxY - MinY + 1); + + for N := 0 to High(PPP) do + AddPolygon(PPP[N], MinY, Bitmap.Width shl 4 - 1, Bitmap.Height shl 4 - 1, + ScanLines, False); + + SortLines(ScanLines); + + Bitmap.Changing; + FillLines2(Bitmap, MinY, ScanLines, Color); + Bitmap.Changed; +end; + +//=== Filters ================================================================ + +procedure CheckParams(Dst, Src: TJclBitmap32); +begin + if Src = nil then + raise EJclGraphicsError.CreateRes(@RsSourceBitmapEmpty); + if Dst = nil then + raise EJclGraphicsError.CreateRes(@RsDestinationBitmapEmpty); + Dst.SetSize(Src.Width, Src.Height); // Should this go? See #0001513. It is currently of no use. +end; + +procedure AlphaToGrayscale(Dst, Src: TJclBitmap32); +var + I: Integer; + D, S: PColor32; +begin + CheckParams(Dst, Src); + Dst.Changing; + Dst.SetSize(Src.Width, Src.Height); + D := @Dst.Bits[0]; + S := @Src.Bits[0]; + for I := 0 to Src.Width * Src.Height - 1 do + begin + D^ := Gray32(AlphaComponent(S^), $FF); + Inc(S); + Inc(D); + end; + Dst.Changed; +end; + +procedure IntensityToAlpha(Dst, Src: TJclBitmap32); +var + I: Integer; + D, S: PColor32; +begin + CheckParams(Dst, Src); + Dst.Changing; + Dst.SetSize(Src.Width, Src.Height); + D := @Dst.Bits[0]; + S := @Src.Bits[0]; + for I := 0 to Src.Width * Src.Height - 1 do + begin + D^ := SetAlpha(D^, Intensity(S^)); + Inc(S); + Inc(D); + end; + Dst.Changed; +end; + +procedure Invert(Dst, Src: TJclBitmap32); +var + I: Integer; + D, S: PColor32; +begin + CheckParams(Dst, Src); + Dst.Changing; + Dst.SetSize(Src.Width, Src.Height); + D := @Dst.Bits[0]; + S := @Src.Bits[0]; + for I := 0 to Src.Width * Src.Height - 1 do + begin + D^ := S^ xor $FFFFFFFF; + Inc(S); + Inc(D); + end; + Dst.Changed; +end; + +procedure InvertRGB(Dst, Src: TJclBitmap32); +var + I: Integer; + D, S: PColor32; +begin + CheckParams(Dst, Src); + Dst.Changing; + Dst.SetSize(Src.Width, Src.Height); + D := @Dst.Bits[0]; + S := @Src.Bits[0]; + for I := 0 to Src.Width * Src.Height - 1 do + begin + D^ := S^ xor $00FFFFFF; + Inc(S); + Inc(D); + end; + Dst.Changed; +end; + +procedure ColorToGrayscale(Dst, Src: TJclBitmap32); +var + I: Integer; + D, S: PColor32; +begin + CheckParams(Dst, Src); + Dst.Changing; + Dst.SetSize(Src.Width, Src.Height); + D := @Dst.Bits[0]; + S := @Src.Bits[0]; + for I := 0 to Src.Width * Src.Height - 1 do + begin + D^ := Gray32(Intensity(S^), $FF); + Inc(S); + Inc(D); + end; + Dst.Changed; +end; + +procedure ApplyLUT(Dst, Src: TJclBitmap32; const LUT: TLUT8); +var + I: Integer; + D, S: PColor32; + r, g, b: TColor32; + C: TColor32; +begin + CheckParams(Dst, Src); + + Dst.Changing; + Dst.SetSize(Src.Width, Src.Height); + D := @Dst.Bits[0]; + S := @Src.Bits[0]; + + for I := 0 to Src.Width * Src.Height - 1 do + begin + C := S^; + r := C and $00FF0000; + g := C and $0000FF00; + r := r shr 16; + b := C and $000000FF; + g := g shr 8; + r := LUT[r]; + g := LUT[g]; + b := LUT[b]; + D^ := $FF000000 or r shl 16 or g shl 8 or b; + Inc(S); + Inc(D); + end; + Dst.Changed; +end; +{$ENDIF Bitmap32} + +// Gamma table support for opacities +procedure SetGamma(Gamma: Single); +var + I: Integer; +begin + for I := Low(GAMMA_TABLE) to High(GAMMA_TABLE) do + GAMMA_TABLE[I] := Round(255 * Power(I / 255, Gamma)); +end; + +// modify Jan 28, 2001 for use under BCB5 +// the compiler show error 245 "language feature ist not available" +// we must take a record and under this we can use the static array + +procedure SetIdentityMatrix; +begin + IdentityMatrix.A[0, 0] := 1.0; + IdentityMatrix.A[0, 1] := 0.0; + IdentityMatrix.A[0, 2] := 0.0; + IdentityMatrix.A[1, 0] := 0.0; + IdentityMatrix.A[1, 1] := 1.0; + IdentityMatrix.A[1, 2] := 0.0; + IdentityMatrix.A[2, 0] := 0.0; + IdentityMatrix.A[2, 1] := 0.0; + IdentityMatrix.A[2, 2] := 1.0; +end; + +initialization + SetIdentityMatrix; + SetGamma(0.7); +{$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/prototypes/JclHashMaps.pas b/3rdParty/JCL/source/prototypes/JclHashMaps.pas new file mode 100644 index 00000000..1f5c0d07 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/JclHashMaps.pas @@ -0,0 +1,481 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is HashMap.pas. } +{ } +{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } +{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } +{ All rights reserved. } +{ } +{ Contributors: } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclHashMaps; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Classes, + {$ENDIF ~HAS_UNITSCOPE} + JclAlgorithms, + JclBase, JclSynch, + JclContainerIntf, JclAbstractContainers, JclArrayLists, JclArraySets; +{$I containers\JclContainerCommon.imp} +{$I containers\JclHashMaps.imp} +{$I containers\JclHashMaps.int} +{$I containers\JclAlgorithms.int} +{$I containers\JclAlgorithms.imp} +type +(*$JPPLOOP ALLMAPINDEX ALLMAPCOUNT + {$JPPEXPANDMACRO JCLHASHMAPTYPESINT(,,,,)} + + {$JPPEXPANDMACRO JCLHASHMAPINT(,,,,,,,,,,,,,,)} + +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + + TJclHashEntry = record + Key: TKey; + Value: TValue; + end; + + TJclBucket = class + public + type + THashEntryArray = array of TJclHashEntry; + public + Size: Integer; + Entries: THashEntryArray; + {$JPPUNDEF GENERIC}{$JPPDEFINE REFCOUNTED}{$JPPEXPANDMACRO MOVEARRAYINT(MoveArray,THashEntryArray,)} + end; + + (*$JPPEXPANDMACRO JCLHASHMAPINT(TBucket,TJclHashMap,TJclAbstractContainerBase,IJclMap,IJclSet,IJclCollection,IJclCollection, IJclPairOwner\,, +protected + type + TBucket = TJclBucket; +private + FOwnsKeys: Boolean; + FOwnsValues: Boolean; +protected + function Hash(const AKey: TKey): Integer; virtual; abstract; + function KeysEqual(const A\, B: TKey): Boolean; virtual; abstract; + function ValuesEqual(const A\, B: TValue): Boolean; virtual; abstract; + function CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; virtual; abstract; + function CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; virtual; abstract; + function CreateEmptyKeyList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; virtual; abstract; +public + { IJclPairOwner } + function FreeKey(var Key: TKey): TKey; + function FreeValue(var Value: TValue): TValue; + function GetOwnsKeys: Boolean; + function GetOwnsValues: Boolean; + property OwnsKeys: Boolean read FOwnsKeys; + property OwnsValues: Boolean read FOwnsValues;,; AOwnsKeys: Boolean,; AOwnsValues: Boolean,const ,TKey,const ,TValue)*) + + // E = external helper to compare and hash items + // KeyComparer is used only when getting KeySet + // GetHashCode and Equals methods of KeyEqualityComparer are used + // GetHashCode of ValueEqualityComparer is not used + TJclHashMapE = class(TJclHashMap, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, IJclMap, IJclPairOwner) + protected + type + TArrayList = TJclArrayListE; + TArraySet = TJclArraySetE; + TArrayKeyList = TJclArrayListE; + private + FKeyEqualityComparer: IJclEqualityComparer; + FKeyHashConverter: IJclHashConverter; + FKeyComparer: IJclComparer; + FValueEqualityComparer: IJclEqualityComparer; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function Hash(const AKey: TKey): Integer; override; + function KeysEqual(const A, B: TKey): Boolean; override; + function ValuesEqual(const A, B: TValue): Boolean; override; + function CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; override; + function CreateEmptyKeyList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; override; + public + constructor Create(const AKeyEqualityComparer: IJclEqualityComparer; + const AKeyHashConverter: IJclHashConverter; const AValueEqualityComparer: IJclEqualityComparer; + const AKeyComparer: IJclComparer; ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean); + + property KeyEqualityComparer: IJclEqualityComparer read FKeyEqualityComparer write FKeyEqualityComparer; + property KeyHashConverter: IJclHashConverter read FKeyHashConverter write FKeyHashConverter; + property KeyComparer: IJclComparer read FKeyComparer write FKeyComparer; + property ValueEqualityComparer: IJclEqualityComparer read FValueEqualityComparer write FValueEqualityComparer; + end; + + // F = Functions to compare and hash items + // KeyComparer is used only when getting KeySet + TJclHashMapF = class(TJclHashMap, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, IJclMap, IJclPairOwner) + protected + type + TArrayList = TJclArrayListF; + TArraySet = TJclArraySetF; + TArrayKeyList = TJclArrayListF; + private + FKeyEqualityCompare: TEqualityCompare; + FKeyHash: THashConvert; + FKeyCompare: TCompare; + FValueEqualityCompare: TEqualityCompare; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function Hash(const AKey: TKey): Integer; override; + function KeysEqual(const A, B: TKey): Boolean; override; + function ValuesEqual(const A, B: TValue): Boolean; override; + function CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; override; + function CreateEmptyKeyList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; override; + public + constructor Create(AKeyEqualityCompare: TEqualityCompare; AKeyHash: THashConvert; + AValueEqualityCompare: TEqualityCompare; AKeyCompare: TCompare; + ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean); + + property KeyEqualityCompare: TEqualityCompare read FKeyEqualityCompare write FKeyEqualityCompare; + property KeyCompare: TCompare read FKeyCompare write FKeyCompare; + property KeyHash: THashConvert read FKeyHash write FKeyHash; + property ValueEqualityCompare: TEqualityCompare read FValueEqualityCompare write FValueEqualityCompare; + end; + + // I = items can compare themselves to an other, items can create hash value from themselves + TJclHashMapI, IEquatable, IHashable; TValue: IEquatable> = class(TJclHashMap, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, + IJclMap, IJclPairOwner) + protected + type + TArrayList = TJclArrayListI; + TArraySet = TJclArraySetI; + TArrayKeyList = TJclArrayListI; + protected + function Hash(const AKey: TKey): Integer; override; + function KeysEqual(const A, B: TKey): Boolean; override; + function ValuesEqual(const A, B: TValue): Boolean; override; + function CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; override; + function CreateEmptyKeyList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; override; + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +{$IFDEF BCB} +{$IFDEF WIN64} + {$HPPEMIT '#ifdef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #undef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #define JclHashMaps_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT '#endif'} + + {$HPPEMIT END '#ifdef JclHashMaps_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #define MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #undef JclHashMaps_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END '#endif'} +{$ENDIF WIN64} +{$ENDIF BCB} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclResources; + +(*$JPPLOOP TRUEMAPINDEX TRUEMAPCOUNT +{$JPPEXPANDMACRO JCLHASHMAPTYPESIMP(,,,)} + +{$JPPEXPANDMACRO JCLHASHMAPIMP(,,,,,,,,,,,,,,,,,,)} + +*) +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +//=== { TJclBucket } ========================================== + +{$JPPUNDEF GENERIC}{$JPPDEFINE REFCOUNTED}{$JPPEXPANDMACRO MOVEARRAYIMP(MoveArray,THashEntryArray,,TJclBucket.,)} + +{$JPPEXPANDMACRO JCLHASHMAPIMP(TJclHashMap,TBucket,IJclMap,IJclSet,IJclCollection,IJclIterator,IJclCollection,; AOwnsKeys: Boolean,; AOwnsValues: Boolean, + + FOwnsKeys := AOwnsKeys; + FOwnsValues := AOwnsValues;,const ,TKey,Default(TKey),const ,TValue,Default(TValue),CreateEmptyArraySet(FSize, False),CreateEmptyKeyList(FSize, False),CreateEmptyArrayList(FSize, False))} + +function TJclHashMap.FreeKey(var Key: TKey): TKey; +begin + if FOwnsKeys then + begin + Result := Default(TKey); + FreeAndNilIfObject(Key); + end + else + begin + Result := Key; + Key := Default(TKey); + end; +end; + +function TJclHashMap.FreeValue(var Value: TValue): TValue; +begin + if FOwnsValues then + begin + Result := Default(TValue); + FreeAndNilIfObject(Value); + end + else + begin + Result := Value; + Value := Default(TValue); + end; +end; + +function TJclHashMap.GetOwnsKeys: Boolean; +begin + Result := FOwnsKeys; +end; + +function TJclHashMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +//=== { TJclHashMapE } ========================================= + +constructor TJclHashMapE.Create(const AKeyEqualityComparer: IJclEqualityComparer; + const AKeyHashConverter: IJclHashConverter; const AValueEqualityComparer: IJclEqualityComparer; + const AKeyComparer: IJclComparer; ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean); +begin + inherited Create(ACapacity, AOwnsKeys, AOwnsValues); + FKeyEqualityComparer := AKeyEqualityComparer; + FKeyHashConverter := AKeyHashConverter; + FValueEqualityComparer := AValueEqualityComparer; + FKeyComparer := AKeyComparer; +end; + +procedure TJclHashMapE.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclHashMapE; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclHashMapE then + begin + ADest := TJclHashMapE(Dest); + ADest.FKeyEqualityComparer := FKeyEqualityComparer; + ADest.FKeyHashConverter := FKeyHashConverter; + ADest.FValueEqualityComparer := FValueEqualityComparer; + ADest.FKeyComparer := FKeyComparer; + end; +end; + +function TJclHashMapE.CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; +begin + Result := TArrayList.Create(ValueEqualityComparer, ACapacity, AOwnsObjects); +end; + +function TJclHashMapE.CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; +begin + Result := TArraySet.Create(KeyComparer, ACapacity, AOwnsObjects); +end; + +function TJclHashMapE.CreateEmptyKeyList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; +begin + Result := TArrayKeyList.Create(KeyEqualityComparer, ACapacity, AOwnsObjects); +end; + +function TJclHashMapE.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclHashMapE.Create(KeyEqualityComparer, KeyHashConverter, ValueEqualityComparer, + KeyComparer, FCapacity, False, False); + AssignPropertiesTo(Result); +end; + +function TJclHashMapE.Hash(const AKey: TKey): Integer; +begin + if KeyEqualityComparer = nil then + raise EJclNoHashConverterError.Create; + Result := KeyHashConverter.Hash(AKey); +end; + +function TJclHashMapE.KeysEqual(const A, B: TKey): Boolean; +begin + if KeyEqualityComparer = nil then + raise EJclNoEqualityComparerError.Create; + Result := KeyEqualityComparer.ItemsEqual(A, B); +end; + +function TJclHashMapE.ValuesEqual(const A, B: TValue): Boolean; +begin + if ValueEqualityComparer = nil then + raise EJclNoEqualityComparerError.Create; + Result := ValueEqualityComparer.ItemsEqual(A, B); +end; + +//=== { TJclHashMapF } ========================================= + +constructor TJclHashMapF.Create(AKeyEqualityCompare: TEqualityCompare; + AKeyHash: THashConvert; AValueEqualityCompare: TEqualityCompare; AKeyCompare: TCompare; + ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean); +begin + inherited Create(ACapacity, AOwnsKeys, AOwnsValues); + FKeyEqualityCompare := AKeyEqualityCompare; + FKeyHash := AKeyHash; + FValueEqualityCompare := AValueEqualityCompare; + FKeyCompare := AKeyCompare; +end; + +procedure TJclHashMapF.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclHashMapF; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclHashMapF then + begin + ADest := TJclHashMapF(Dest); + ADest.FKeyEqualityCompare := FKeyEqualityCompare; + ADest.FKeyHash := FKeyHash; + ADest.FValueEqualityCompare := FValueEqualityCompare; + ADest.FKeyCompare := FKeyCompare; + end; +end; + +function TJclHashMapF.CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; +begin + Result := TArrayList.Create(ValueEqualityCompare, ACapacity, AOwnsObjects); +end; + +function TJclHashMapF.CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; +begin + Result := TArraySet.Create(KeyCompare, ACapacity, AOwnsObjects); +end; + +function TJclHashMapF.CreateEmptyKeyList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; +begin + Result := TArrayKeyList.Create(KeyEqualityCompare, ACapacity, AOwnsObjects); +end; + +function TJclHashMapF.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclHashMapF.Create(KeyEqualityCompare, KeyHash, ValueEqualityCompare, KeyCompare, FCapacity, + False, False); + AssignPropertiesTo(Result); +end; + +function TJclHashMapF.Hash(const AKey: TKey): Integer; +begin + if not Assigned(KeyHash) then + raise EJclNoHashConverterError.Create; + Result := KeyHash(AKey); +end; + +function TJclHashMapF.KeysEqual(const A, B: TKey): Boolean; +begin + if not Assigned(KeyEqualityCompare) then + raise EJclNoEqualityComparerError.Create; + Result := KeyEqualityCompare(A, B); +end; + +function TJclHashMapF.ValuesEqual(const A, B: TValue): Boolean; +begin + if not Assigned(ValueEqualityCompare) then + raise EJclNoEqualityComparerError.Create; + Result := ValueEqualityCompare(A, B); +end; + +//=== { TJclHashMapI } ========================================= + +function TJclHashMapI.CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; +begin + Result := TArrayList.Create(ACapacity, AOwnsObjects); +end; + +function TJclHashMapI.CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; +begin + Result := TArraySet.Create(ACapacity, AOwnsObjects); +end; + +function TJclHashMapI.CreateEmptyKeyList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; +begin + Result := TArrayKeyList.Create(ACapacity, AOwnsObjects); +end; + +function TJclHashMapI.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclHashMapI.Create(FCapacity, False, False); + AssignPropertiesTo(Result); +end; + +function TJclHashMapI.Hash(const AKey: TKey): Integer; +begin + Result := AKey.GetHashCode; +end; + +function TJclHashMapI.KeysEqual(const A, B: TKey): Boolean; +begin + Result := A.Equals(B); +end; + +function TJclHashMapI.ValuesEqual(const A, B: TValue): Boolean; +begin + Result := A.Equals(B); +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/prototypes/JclHashSets.pas b/3rdParty/JCL/source/prototypes/JclHashSets.pas new file mode 100644 index 00000000..eb45ddde --- /dev/null +++ b/3rdParty/JCL/source/prototypes/JclHashSets.pas @@ -0,0 +1,275 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is HashSet.pas. } +{ } +{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } +{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } +{ All rights reserved. } +{ } +{ Contributors: } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclHashSets; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, System.Classes, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, Classes, + {$ENDIF ~HAS_UNITSCOPE} + JclAlgorithms, + JclBase, JclAbstractContainers, JclContainerIntf, JclSynch; +{$I containers\JclContainerCommon.imp} +{$I containers\JclHashSets.imp} +{$I containers\JclHashSets.int} +{$I containers\JclAlgorithms.int} +{$I containers\JclAlgorithms.imp} +type + TItrStart = (isFirst, isLast); + +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO JCLHASHSETTYPEINT(,)} + + {$JPPEXPANDMACRO JCLHASHSETINT(,,,,,,,,,,,,,,,,)} + + {$JPPEXPANDMACRO JCLHASHSETITRINT(,,,,,,,)} + +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + + TJclHashSetBucket = class + public + type + TDynArray = array of T; + public + Size: Integer; + Entries: TDynArray; + {$JPPDEFINE GENERIC}{$JPPEXPANDMACRO MOVEARRAYINT(MoveArray,TDynArray,)} + end; + + {$JPPEXPANDMACRO JCLHASHSETINT(TJclHashSet,TJclAbstractContainer,IJclContainer,IJclFlatContainer,TJclHashSetBucket,IJclCollection,IJclSet,IJclIterator,IJclEqualityComparer,IJclHashConverter, IJclItemOwner\,,,,const ,AItem,T,; AOwnsItems: Boolean)} + + {$JPPEXPANDMACRO JCLHASHSETITRINT(TJclHashSetIterator,IJclIterator,TJclHashSet,const ,AItem,T,GetItem,SetItem)} + + // E = External helper to compare items for equality + TJclHashSetE = class(TJclHashSet, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, + IJclEqualityComparer, IJclHashConverter, IJclItemOwner, IJclCollection, IJclSet) + private + FEqualityComparer: IJclEqualityComparer; + FHashConverter: IJclHashConverter; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AEqualityComparer: IJclEqualityComparer; const AHashConverter: IJclHashConverter; + ACapacity: Integer; AOwnsItems: Boolean); overload; + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + property EqualityComparer: IJclEqualityComparer read FEqualityComparer write FEqualityComparer; + { IJclHashConverter } + function Hash(const AItem: T): Integer; override; + property HashConverter: IJclHashConverter read FHashConverter write FHashConverter; + end; + + // F = Function to compare items for equality + TJclHashSetF = class(TJclHashSet, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, + IJclEqualityComparer, IJclHashConverter, IJclItemOwner, + IJclCollection, IJclSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AEqualityCompare: TEqualityCompare; const AHashConvert: THashConvert; + ACapacity: Integer; AOwnsItems: Boolean); overload; + end; + + // I = Items can compare themselves to others + TJclHashSetI, IHashable> = class(TJclHashSet, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, + IJclEqualityComparer, IJclHashConverter, IJclItemOwner, + IJclCollection, IJclSet) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + { IJclHashConverter } + function Hash(const AItem: T): Integer; override; + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +{$IFDEF BCB} +{$IFDEF WIN64} + {$HPPEMIT '#ifdef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #undef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #define JclHashSets_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT '#endif'} + + {$HPPEMIT END '#ifdef JclHashSets_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #define MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #undef JclHashSets_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END '#endif'} +{$ENDIF WIN64} +{$ENDIF BCB} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO JCLHASHSETIMP(,,,,,,,,,,,,)} + +{$JPPEXPANDMACRO JCLHASHSETITRIMP(,,,,,,,,,)} +*) +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +//=== { TJclHashSetBucket } ================================================= + +{$JPPDEFINE GENERIC}{$JPPEXPANDMACRO MOVEARRAYIMP(MoveArray,TDynArray,Default(T),TJclHashSetBucket.,)} + +{$JPPEXPANDMACRO JCLHASHSETIMP(TJclHashSet,TJclHashSetBucket,; AOwnsItems: Boolean,AOwnsItems,IJclCollection,TJclHashSetIterator,IJclIterator,Bucket.MoveArray,const ,AItem,T,Default(T),FreeItem)} + +{$JPPEXPANDMACRO JCLHASHSETITRIMP(TJclHashSetIterator,TJclHashSet,TJclHashSetBucket,IJclIterator,const ,AItem,T,Default(T),GetItem,SetItem)} + +//=== { TJclHashSetE } ==================================================== + +constructor TJclHashSetE.Create(const AEqualityComparer: IJclEqualityComparer; + const AHashConverter: IJclHashConverter; ACapacity: Integer; AOwnsItems: Boolean); +begin + inherited Create(ACapacity, AOwnsItems); + FEqualityComparer := AEqualityComparer; + FHashConverter := AHashConverter; +end; + +procedure TJclHashSetE.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclHashSetE; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclHashSetE then + begin + ADest := TJclHashSetE(Dest); + ADest.FEqualityComparer := FEqualityComparer; + ADest.FHashConverter := FHashConverter; + end; +end; + +function TJclHashSetE.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclHashSetE.Create(EqualityComparer, HashConverter, FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclHashSetE.ItemsEqual(const A, B: T): Boolean; +begin + if EqualityComparer <> nil then + Result := EqualityComparer.ItemsEqual(A, B) + else + Result := inherited ItemsEqual(A, B); +end; + +function TJclHashSetE.Hash(const AItem: T): Integer; +begin + if HashConverter <> nil then + Result := HashConverter.Hash(AItem) + else + Result := inherited Hash(AItem); +end; + +//=== { TJclHashSetF } ==================================================== + +constructor TJclHashSetF.Create(const AEqualityCompare: TEqualityCompare; + const AHashConvert: THashConvert; ACapacity: Integer; AOwnsItems: Boolean); +begin + inherited Create(ACapacity, AOwnsItems); + SetEqualityCompare(AEqualityCompare); + SetHashConvert(AHashConvert); +end; + +function TJclHashSetF.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclHashSetF.Create(EqualityCompare, HashConvert, FSize, False); + AssignPropertiesTo(Result); +end; + +//=== { TJclHashSetI } ==================================================== + +function TJclHashSetI.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclHashSetI.Create(FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclHashSetI.ItemsEqual(const A, B: T): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + Result := A.Equals(B); +end; + +function TJclHashSetI.Hash(const AItem: T): Integer; +begin + if Assigned(FHashConvert) then + Result := FHashConvert(AItem) + else + Result := AItem.GetHashCode; +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/prototypes/JclLinkedLists.pas b/3rdParty/JCL/source/prototypes/JclLinkedLists.pas new file mode 100644 index 00000000..75bcad65 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/JclLinkedLists.pas @@ -0,0 +1,249 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is LinkedList.pas. } +{ } +{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } +{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } +{ All rights reserved. } +{ } +{ Contributors: } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclLinkedLists; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF SUPPORTS_GENERICS} + JclAlgorithms, + {$ENDIF SUPPORTS_GENERICS} + {$IFDEF HAS_UNITSCOPE} + System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Classes, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclAbstractContainers, JclContainerIntf, JclSynch; +{$I containers\JclContainerCommon.imp} +{$I containers\JclLinkedLists.imp} +{$I containers\JclLinkedLists.int} +type + TItrStart = (isFirst, isLast); + +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO JCLLINKEDLISTTYPESINT(,)} + + {$JPPEXPANDMACRO JCLLINKEDLISTINT(,,,,,,,,,,,,,,,,,)} + + {$JPPEXPANDMACRO JCLLINKEDLISTITRINT(,,,,,,,,,,)} + +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + + (*$JPPEXPANDMACRO JCLLINKEDLISTTYPESINT(TJclLinkedListItem,T)*) + + TJclLinkedListIterator = class; + + (*$JPPEXPANDMACRO JCLLINKEDLISTINT(TLinkedListItem,TJclLinkedList,TJclAbstractContainer,IJclContainer,IJclFlatContainer,IJclCollection,IJclList,IJclIterator,IJclEqualityComparer,IJclItemOwner\,, +protected + type + TLinkedListItem = TJclLinkedListItem; + TLinkedListIterator = TJclLinkedListIterator;,,; AOwnsItems: Boolean,const ,AItem,T,GetItem,SetItem)*) + + (*$JPPEXPANDMACRO JCLLINKEDLISTITRINT(TJclLinkedListIterator,IJclIterator,TJclLinkedList,IJclEqualityComparer,TJclLinkedList.TLinkedListItem,const ,AItem,T,Default(T),GetItem,SetItem)*) + + // E = External helper to compare items + // GetHashCode is never called + TJclLinkedListE = class(TJclLinkedList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclContainer, IJclCollection, IJclList, IJclEqualityComparer, + IJclItemOwner) + private + FEqualityComparer: IJclEqualityComparer; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AEqualityComparer: IJclEqualityComparer; const ACollection: IJclCollection; + AOwnsItems: Boolean); + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + property EqualityComparer: IJclEqualityComparer read FEqualityComparer write FEqualityComparer; + end; + + // F = Function to compare items for equality + TJclLinkedListF = class(TJclLinkedList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclContainer, IJclCollection, IJclList, IJclEqualityComparer, + IJclItemOwner) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AEqualityCompare: TEqualityCompare; const ACollection: IJclCollection; + AOwnsItems: Boolean); + end; + + // I = Items can compare themselves to an other + TJclLinkedListI> = class(TJclLinkedList, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclContainer, IJclCollection, IJclList, IJclEqualityComparer, + IJclItemOwner) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +{$IFDEF BCB} +{$IFDEF WIN64} + {$HPPEMIT '#ifdef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #undef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #define JclLinkedLists_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT '#endif'} + + {$HPPEMIT END '#ifdef JclLinkedLists_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #define MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #undef JclLinkedLists_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END '#endif'} +{$ENDIF WIN64} +{$ENDIF BCB} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO JCLLINKEDLISTIMP(,,,,,,,,,,,,,,)} + +{$JPPEXPANDMACRO JCLLINKEDLISTITRIMP(,,,,,,,,,,,)} + +*) +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +{$JPPEXPANDMACRO JCLLINKEDLISTIMP(TJclLinkedList,TLinkedListItem,IJclCollection,IJclList,IJclIterator,TLinkedListIterator,; AOwnsItems: Boolean,AOwnsItems,const ,AItem,T,Default(T),GetItem,SetItem,FreeItem)} + +(*$JPPEXPANDMACRO JCLLINKEDLISTITRIMP(TJclLinkedListIterator,IJclIterator,TJclLinkedList,IJclEqualityComparer,TJclLinkedList.TLinkedListItem,const ,AItem,T,Default(T),GetItem,SetItem,(FownList as IJclItemOwner).FreeItem(FCursor.Value);)*) + +//=== { TJclLinkedListE } ================================================= + +constructor TJclLinkedListE.Create(const AEqualityComparer: IJclEqualityComparer; + const ACollection: IJclCollection; AOwnsItems: Boolean); +begin + inherited Create(ACollection, AOwnsItems); + FEqualityComparer := AEqualityComparer; +end; + +procedure TJclLinkedListE.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclLinkedListE then + TJclLinkedListE(Dest).FEqualityComparer := FEqualityComparer; +end; + +function TJclLinkedListE.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclLinkedListE.Create(EqualityComparer, nil, False); + AssignPropertiesTo(Result); +end; + +function TJclLinkedListE.ItemsEqual(const A, B: T): Boolean; +begin + if EqualityComparer <> nil then + Result := EqualityComparer.ItemsEqual(A, B) + else + Result := inherited ItemsEqual(A, B); +end; + +//=== { TJclLinkedListF } ================================================= + +constructor TJclLinkedListF.Create(const AEqualityCompare: TEqualityCompare; + const ACollection: IJclCollection; AOwnsItems: Boolean); +begin + inherited Create(ACollection, AOwnsItems); + SetEqualityCompare(AEqualityCompare); +end; + +function TJclLinkedListF.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclLinkedListF.Create(EqualityCompare, nil, False); + AssignPropertiesTo(Result); +end; + +//=== { TJclLinkedListI } ================================================= + +function TJclLinkedListI.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclLinkedListI.Create(nil, False); + AssignPropertiesTo(Result); +end; + +function TJclLinkedListI.ItemsEqual(const A, B: T): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + Result := A.Equals(B); +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/prototypes/JclQueues.pas b/3rdParty/JCL/source/prototypes/JclQueues.pas new file mode 100644 index 00000000..c7d63e13 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/JclQueues.pas @@ -0,0 +1,223 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is Queue.pas. } +{ } +{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } +{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } +{ All rights reserved. } +{ } +{ Contributors: } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclQueues; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclAlgorithms, + JclBase, JclAbstractContainers, JclContainerIntf, JclSynch; +{$I containers\JclContainerCommon.imp} +{$I containers\JclQueues.imp} +{$I containers\JclQueues.int} +{$I containers\JclAlgorithms.int} +{$I containers\JclAlgorithms.imp} +type +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO JCLQUEUEINT(,,,,,,,,,,,)} + +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + + (*$JPPEXPANDMACRO JCLQUEUEINT(TJclQueue,IJclContainer,IJclQueue,TJclAbstractContainer,TDynArray,IJclEqualityComparer, IJclItemOwner\,, +protected + type + TDynArray = array of T; + {$JPPDEFINE GENERIC}{$JPPEXPANDMACRO MOVEARRAYINT(MoveArray,TDynArray,)},; AOwnsItems: Boolean,const ,AItem,T)*) + + // E = external helper to compare items for equality (GetHashCode is not used) + TJclQueueE = class(TJclQueue, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, IJclQueue, IJclItemOwner) + private + FEqualityComparer: IEqualityComparer; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AEqualityComparer: IEqualityComparer; ACapacity: Integer; AOwnsItems: Boolean); + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + property EqualityComparer: IEqualityComparer read FEqualityComparer write FEqualityComparer; + end; + + // F = function to compare items for equality + TJclQueueF = class(TJclQueue, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, IJclQueue, IJclItemOwner) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(AEqualityCompare: TEqualityCompare; ACapacity: Integer; AOwnsItems: Boolean); + end; + + // I = items can compare themselves to an other + TJclQueueI> = class(TJclQueue, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, IJclQueue, IJclItemOwner) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +{$IFDEF BCB} +{$IFDEF WIN64} + {$HPPEMIT '#ifdef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #undef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #define JclQueues_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT '#endif'} + + {$HPPEMIT END '#ifdef JclQueues_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #define MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #undef JclQueues_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END '#endif'} +{$ENDIF WIN64} +{$ENDIF BCB} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO JCLQUEUEIMP(,,,,,,,,)} + +*) +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +(*$JPPEXPANDMACRO JCLQUEUEIMP(TJclQueue,; AOwnsItems: Boolean,AOwnsItems,MoveArray,const ,AItem,T,Default(T),FreeItem)*) + +{$JPPDEFINE GENERIC}{$JPPEXPANDMACRO MOVEARRAYIMP(MoveArray,TDynArray,Default(T),TJclQueue.,)} + +//=== { TJclQueueE } ====================================================== + +constructor TJclQueueE.Create(const AEqualityComparer: IEqualityComparer; + ACapacity: Integer; AOwnsItems: Boolean); +begin + inherited Create(ACapacity, AOwnsItems); + FEqualityComparer := AEqualityComparer; +end; + +procedure TJclQueueE.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclQueueE then + TJclQueueE(Dest).FEqualityComparer := FEqualityComparer; +end; + +function TJclQueueE.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclQueueE.Create(EqualityComparer, Size + 1, False); + AssignPropertiesTo(Result); +end; + +function TJclQueueE.ItemsEqual(const A, B: T): Boolean; +begin + if EqualityComparer <> nil then + Result := EqualityComparer.Equals(A, B) + else + Result := inherited ItemsEqual(A, B); +end; + +//=== { TJclQueueF } ====================================================== + +constructor TJclQueueF.Create(AEqualityCompare: TEqualityCompare; + ACapacity: Integer; AOwnsItems: Boolean); +begin + inherited Create(ACapacity, AOwnsItems); + SetEqualityCompare(AEqualityCompare); +end; + +function TJclQueueF.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclQueueF.Create(EqualityCompare, Size + 1, False); + AssignPropertiesTo(Result); +end; + +//=== { TJclQueueI } ====================================================== + +function TJclQueueI.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclQueueI.Create(Size + 1, False); + AssignPropertiesTo(Result); +end; + +function TJclQueueI.ItemsEqual(const A, B: T): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + Result := A.Equals(B); +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/prototypes/JclSortedMaps.pas b/3rdParty/JCL/source/prototypes/JclSortedMaps.pas new file mode 100644 index 00000000..ba6136f9 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/JclSortedMaps.pas @@ -0,0 +1,411 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclSortedMaps.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet. Portions created by } +{ Florent Ouchet are Copyright (C) Florent Ouchet = record + Key: TKey; + Value: TValue; + end; + + (*$JPPEXPANDMACRO JCLSORTEDMAPINT(TSortedEntry,TSortedEntryArray,TJclSortedMap,TJclAbstractContainerBase,IJclMap,IJclSortedMap,IJclSet,IJclCollection, IJclPairOwner\,, + +protected + type + TSortedEntry = TJclSortedEntry; + TSortedEntryArray = array of TSortedEntry; +private + FOwnsKeys: Boolean; + FOwnsValues: Boolean; +protected + function KeysCompare(const A\, B: TKey): Integer; virtual; abstract; + function ValuesCompare(const A\, B: TValue): Integer; virtual; abstract; + function CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; virtual; abstract; + function CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; virtual; abstract; +public + { IJclPairOwner } + function FreeKey(var Key: TKey): TKey; + function FreeValue(var Value: TValue): TValue; + function GetOwnsKeys: Boolean; + function GetOwnsValues: Boolean; + property OwnsKeys: Boolean read FOwnsKeys; + property OwnsValues: Boolean read FOwnsValues;,; AOwnsKeys: Boolean,; AOwnsValues: Boolean,const ,TKey,const ,TValue)*) + + // E = external helper to compare items + TJclSortedMapE = class(TJclSortedMap, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, IJclMap, IJclSortedMap, IJclPairOwner) + protected + type + TArrayList = TJclArrayListE; + TArraySet = TJclArraySetE; + private + FKeyComparer: IJclComparer; + FValueComparer: IJclComparer; + FValueEqualityComparer: IJclEqualityComparer; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function KeysCompare(const A, B: TKey): Integer; override; + function ValuesCompare(const A, B: TValue): Integer; override; + function CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; override; + public + constructor Create(const AKeyComparer: IJclComparer; const AValueComparer: IJclComparer; + const AValueEqualityComparer: IJclEqualityComparer; ACapacity: Integer; AOwnsValues: Boolean; + AOwnsKeys: Boolean); + + property KeyComparer: IJclComparer read FKeyComparer write FKeyComparer; + property ValueComparer: IJclComparer read FValueComparer write FValueComparer; + property ValueEqualityComparer: IJclEqualityComparer read FValueEqualityComparer write FValueEqualityComparer; + end; + + // F = Functions to compare items + TJclSortedMapF = class(TJclSortedMap, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, IJclMap, IJclSortedMap, IJclPairOwner) + protected + type + TArrayList = TJclArrayListF; + TArraySet = TJclArraySetF; + private + FKeyCompare: TCompare; + FValueCompare: TCompare; + FValueEqualityCompare: TEqualityCompare; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function KeysCompare(const A, B: TKey): Integer; override; + function ValuesCompare(const A, B: TValue): Integer; override; + function CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; override; + public + constructor Create(AKeyCompare: TCompare; AValueCompare: TCompare; + AValueEqualityCompare: TEqualityCompare; ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean); + + property KeyCompare: TCompare read FKeyCompare write FKeyCompare; + property ValueCompare: TCompare read FValueCompare write FValueCompare; + property ValueEqualityCompare: TEqualityCompare read FValueEqualityCompare write FValueEqualityCompare; + end; + + // I = items can compare themselves to an other + TJclSortedMapI; TValue: IComparable, IEquatable> = class(TJclSortedMap, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, + IJclMap, IJclSortedMap, IJclPairOwner) + protected + type + TArrayList = TJclArrayListI; + TArraySet = TJclArraySetI; + protected + function KeysCompare(const A, B: TKey): Integer; override; + function ValuesCompare(const A, B: TValue): Integer; override; + function CreateEmptyArrayList(ACapacity: Integer; AOwnsObjects: Boolean): IJclCollection; override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + function CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; override; + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +{$IFDEF BCB} +{$IFDEF WIN64} + {$HPPEMIT '#ifdef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #undef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #define JclSortedMaps_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT '#endif'} + + {$HPPEMIT END '#ifdef JclSortedMaps_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #define MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #undef JclSortedMaps_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END '#endif'} +{$ENDIF WIN64} +{$ENDIF BCB} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +(*$JPPLOOP TRUEMAPINDEX TRUEMAPCOUNT +{$JPPEXPANDMACRO JCLSORTEDMAPIMP(,,,,,,,,,,,,,,,,,,)} + +*) + +{$IFDEF SUPPORTS_GENERICS}{$JPPDEFINE KEYGENERIC}{$JPPDEFINE VALUEGENERIC}{$JPPUNDEF KEYREFCOUNTED}{$JPPUNDEF VALUEREFCOUNTED}{$JPPUNDEF KEYZEROINIT}{$JPPUNDEF VALUEZEROINIT} +//DOM-IGNORE-BEGIN + +(*$JPPEXPANDMACRO JCLSORTEDMAPIMP(TSortedEntry,TSortedEntryArray,TJclSortedMap,IJclMap,IJclSortedMap,IJclSet,IJclIterator,IJclCollection,; AOwnsKeys: Boolean,; AOwnsValues: Boolean, + + FOwnsKeys := AOwnsKeys; + FOwnsValues := AOwnsValues;,const ,TKey,Default(TKey),const ,TValue,Default(TValue),CreateEmptyArraySet(FSize, False),CreateEmptyArrayList(FSize, False))*) + +function TJclSortedMap.FreeKey(var Key: TKey): TKey; +begin + if FOwnsKeys then + begin + Result := Default(TKey); + FreeAndNilIfObject(Key); + end + else + begin + Result := Key; + Key := Default(TKey); + end; +end; + +function TJclSortedMap.FreeValue(var Value: TValue): TValue; +begin + if FOwnsValues then + begin + Result := Default(TValue); + FreeAndNilIfObject(Value); + end + else + begin + Result := Value; + Value := Default(TValue); + end; +end; + +function TJclSortedMap.GetOWnsKeys: Boolean; +begin + Result := FOwnsKeys; +end; + +function TJclSortedMap.GetOwnsValues: Boolean; +begin + Result := FOwnsValues; +end; + +//=== { TJclSortedMapE } ======================================= + +constructor TJclSortedMapE.Create(const AKeyComparer: IJclComparer; + const AValueComparer: IJclComparer; const AValueEqualityComparer: IJclEqualityComparer; ACapacity: Integer; + AOwnsValues: Boolean; AOwnsKeys: Boolean); +begin + inherited Create(ACapacity, AOwnsValues, AOwnsKeys); + FKeyComparer := AKeyComparer; + FValueComparer := AValueComparer; + FValueEqualityComparer := AValueEqualityComparer; +end; + +procedure TJclSortedMapE.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclSortedMapE; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclSortedMapE then + begin + ADest := TJclSortedMapE(Dest); + ADest.FKeyComparer := FKeyComparer; + ADest.FValueComparer := FValueComparer; + end; +end; + +function TJclSortedMapE.CreateEmptyArrayList(ACapacity: Integer; + AOwnsObjects: Boolean): IJclCollection; +begin + if FValueEqualityComparer = nil then + raise EJclNoEqualityComparerError.Create; + Result := TArrayList.Create(FValueEqualityComparer, ACapacity, AOwnsObjects); +end; + +function TJclSortedMapE.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclSortedMapE.Create(FKeyComparer, FValueComparer, FValueEqualityComparer, FCapacity, + FOwnsValues, FOwnsKeys); + AssignPropertiesTo(Result); +end; + +function TJclSortedMapE.CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; +begin + Result := TArraySet.Create(FKeyComparer, FCapacity, AOwnsObjects); +end; + +function TJclSortedMapE.KeysCompare(const A, B: TKey): Integer; +begin + if KeyComparer = nil then + raise EJclNoComparerError.Create; + Result := KeyComparer.Compare(A, B); +end; + +function TJclSortedMapE.ValuesCompare(const A, B: TValue): Integer; +begin + if ValueComparer = nil then + raise EJclNoComparerError.Create; + Result := ValueComparer.Compare(A, B); +end; + +//=== { TJclSortedMapF } ======================================= + +constructor TJclSortedMapF.Create(AKeyCompare: TCompare; AValueCompare: TCompare; + AValueEqualityCompare: TEqualityCompare; ACapacity: Integer; AOwnsValues: Boolean; AOwnsKeys: Boolean); +begin + inherited Create(ACapacity, AOwnsValues, AOwnsKeys); + FKeyCompare := AKeyCompare; + FValueCompare := AValueCompare; + FValueEqualityCompare := AValueEqualityCompare; +end; + +procedure TJclSortedMapF.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +var + ADest: TJclSortedMapF; +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclSortedMapF then + begin + ADest := TJclSortedMapF(Dest); + ADest.FKeyCompare := FKeyCompare; + ADest.FValueCompare := FValueCompare; + end; +end; + +function TJclSortedMapF.CreateEmptyArrayList(ACapacity: Integer; + AOwnsObjects: Boolean): IJclCollection; +begin + if not Assigned(FValueEqualityCompare) then + raise EJclNoEqualityComparerError.Create; + Result := TArrayList.Create(FValueEqualityCompare, ACapacity, AOwnsObjects); +end; + +function TJclSortedMapF.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclSortedMapF.Create(FKeyCompare, FValueCompare, FValueEqualityCompare, FCapacity, + FOwnsValues, FOwnsKeys); + AssignPropertiesTo(Result); +end; + +function TJclSortedMapF.CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; +begin + Result := TArraySet.Create(FKeyCompare, FCapacity, AOwnsObjects); +end; + +function TJclSortedMapF.KeysCompare(const A, B: TKey): Integer; +begin + if not Assigned(KeyCompare) then + raise EJclNoComparerError.Create; + Result := KeyCompare(A, B); +end; + +function TJclSortedMapF.ValuesCompare(const A, B: TValue): Integer; +begin + if not Assigned(ValueCompare) then + raise EJclNoComparerError.Create; + Result := ValueCompare(A, B); +end; + +//=== { TJclSortedMapI } ======================================= + +function TJclSortedMapI.CreateEmptyArrayList(ACapacity: Integer; + AOwnsObjects: Boolean): IJclCollection; +begin + Result := TArrayList.Create(ACapacity, AOwnsObjects); +end; + +function TJclSortedMapI.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclSortedMapI.Create(FCapacity, FOwnsValues, FOwnsKeys); + AssignPropertiesTo(Result); +end; + +function TJclSortedMapI.CreateEmptyArraySet(ACapacity: Integer; AOwnsObjects: Boolean): IJclSet; +begin + Result := TArraySet.Create(FCapacity, AOwnsObjects); +end; + +function TJclSortedMapI.KeysCompare(const A, B: TKey): Integer; +begin + Result := A.CompareTo(B); +end; + +function TJclSortedMapI.ValuesCompare(const A, B: TValue): Integer; +begin + Result := A.CompareTo(B); +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/prototypes/JclStacks.pas b/3rdParty/JCL/source/prototypes/JclStacks.pas new file mode 100644 index 00000000..23768b57 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/JclStacks.pas @@ -0,0 +1,226 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is Stack.pas. } +{ } +{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } +{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } +{ All rights reserved. } +{ } +{ Contributors: } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclStacks; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + {$IFDEF SUPPORTS_GENERICS} + System.Generics.Collections, + JclAlgorithms, + {$ENDIF SUPPORTS_GENERICS} + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF SUPPORTS_GENERICS} + Generics.Collections, + JclAlgorithms, + {$ENDIF SUPPORTS_GENERICS} + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclAbstractContainers, JclContainerIntf, JclSynch; +{$I containers\JclContainerCommon.imp} +{$I containers\JclStacks.imp} +{$I containers\JclStacks.int} +type +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO JCLSTACKINT(,,,,,,,,,,,)} + +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + + (*$JPPEXPANDMACRO JCLSTACKINT(TJclStack,IJclContainer,IJclStack,TJclAbstractContainer,TDynArray,IJclEqualityComparer, IJclItemOwner\,, +protected + type + TDynArray = array of T;,; AOwnsItems: Boolean,const ,AItem,T)*) + + // E = external helper to compare items for equality + TJclStackE = class(TJclStack, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, + IJclStack, IJclItemOwner) + private + FEqualityComparer: IEqualityComparer; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AEqualityComparer: IEqualityComparer; ACapacity: Integer; AOwnsItems: Boolean); + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + property EqualityComparer: IEqualityComparer read FEqualityComparer write FEqualityComparer; + end; + + // F = Function to compare items for equality + TJclStackF = class(TJclStack, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, + IJclStack, IJclItemOwner) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(AEqualityCompare: TEqualityCompare; ACapacity: Integer; AOwnsItems: Boolean); + end; + + // I = items can compare themselves to an other for equality + TJclStackI> = class(TJclStack, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, + IJclStack, IJclItemOwner) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +{$IFDEF BCB} +{$IFDEF WIN64} + {$HPPEMIT '#ifdef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #undef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #define JclStacks_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT '#endif'} + + {$HPPEMIT END '#ifdef JclStacks_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #define MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #undef JclStacks_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END '#endif'} +{$ENDIF WIN64} +{$ENDIF BCB} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + SysUtils; + +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO JCLSTACKIMP(,,,,,,,)} + +*) +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +(*$JPPEXPANDMACRO JCLSTACKIMP(TJclStack,; AOwnsItems: Boolean,AOwnsItems,const ,AItem,T,Default(T),FreeItem)*) + +//=== { TJclStackE } ====================================================== + +constructor TJclStackE.Create(const AEqualityComparer: IEqualityComparer; ACapacity: Integer; + AOwnsItems: Boolean); +begin + inherited Create(ACapacity, AOwnsItems); + FEqualityComparer := AEqualityComparer; +end; + +procedure TJclStackE.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclStackE then + TJclStackE(Dest).FEqualityComparer := FEqualityComparer; +end; + +function TJclStackE.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclStackE.Create(FEqualityComparer, FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclStackE.ItemsEqual(const A, B: T): Boolean; +begin + if EqualityComparer <> nil then + Result := EqualityComparer.Equals(A, B) + else + Result := inherited ItemsEqual(A, B); +end; + +//=== { TJclStackF } ====================================================== + +constructor TJclStackF.Create(AEqualityCompare: TEqualityCompare; ACapacity: Integer; AOwnsItems: Boolean); +begin + inherited Create(ACapacity, AOwnsItems); + SetEqualityCompare(AEqualityCompare); +end; + +function TJclStackF.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclStackF.Create(FEqualityCompare, FSize + 1, False); + AssignPropertiesTo(Result); +end; + +//=== { TJclStackI } ====================================================== + +function TJclStackI.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclStackI.Create(FSize + 1, False); + AssignPropertiesTo(Result); +end; + +function TJclStackI.ItemsEqual(const A, B: T): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + Result := A.Equals(B); +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/prototypes/JclTrees.pas b/3rdParty/JCL/source/prototypes/JclTrees.pas new file mode 100644 index 00000000..d1fe1f96 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/JclTrees.pas @@ -0,0 +1,245 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclTrees.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet. Portions created by } +{ Florent Ouchet are Copyright (C) Florent Ouchet ,IJclEqualityComparer,const ,AItem,T)} + + TJclPreOrderTreeIterator = class; + TJclPostOrderTreeIterator = class; + + {$JPPEXPANDMACRO JCLTREEINT(TTreeNode,TJclTree,TJclAbstractContainer,IJclContainer,IJclFlatContainer,IJclEqualityComparer,IJclCollection,IJclTree,IJclIterator,IJclTreeIterator, IJclItemOwner\,, +protected + type + TTreeNode = TJclTreeNode; + TPreOrderTreeIterator = TJclPreOrderTreeIterator; + TPostOrderTreeIterator = TJclPostOrderTreeIterator;,,AOwnsItems: Boolean,const ,AItem,T,Default(T))} + + {$JPPEXPANDMACRO JCLTREEITRINT(TJclTreeIterator,TJclPreOrderTreeIterator,TJclPostOrderTreeIterator,TJclTree.TTreeNode,TJclTree,IJclIterator,IJclTreeIterator,IJclEqualityComparer,const ,AItem,T,Default(T),GetItem,SetItem)} + + // E = External helper to compare items for equality + TJclTreeE = class(TJclTree, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclContainer, IJclItemOwner, IJclEqualityComparer, + IJclCollection, IJclTree) + private + FEqualityComparer: IJclEqualityComparer; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AEqualityComparer: IJclEqualityComparer; AOwnsItems: Boolean); + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + property EqualityComparer: IJclEqualityComparer read FEqualityComparer write FEqualityComparer; + end; + + // F = Function to compare items for equality + TJclTreeF = class(TJclTree, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclContainer, IJclItemOwner, IJclEqualityComparer, + IJclCollection, IJclTree) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(ACompare: TCompare; AOwnsItems: Boolean); + end; + + // I = Items can compare themselves to an other for equality + TJclTreeI> = class(TJclTree, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, IJclContainer, IJclItemOwner, IJclEqualityComparer, + IJclCollection, IJclTree) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +{$IFDEF BCB} +{$IFDEF WIN64} + {$HPPEMIT '#ifdef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #undef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #define JclTrees_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT '#endif'} + + {$HPPEMIT END '#ifdef JclTrees_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #define MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #undef JclTrees_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END '#endif'} +{$ENDIF WIN64} +{$ENDIF BCB} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO JCLTREETYPESIMP(,,,,)} + +{$JPPEXPANDMACRO JCLTREEIMP(,,,,,,,,,,,,,,)} + +{$JPPEXPANDMACRO JCLTREEITRIMP(,,,,,,,,,,,,,,)} + +*) +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +{$JPPEXPANDMACRO JCLTREETYPESIMP(TJclTreeNode,IJclEqualityComparer,const ,AItem,T)} + +{$JPPEXPANDMACRO JCLTREEIMP(TTreeNode,TJclTree,TPreOrderTreeIterator,TPostOrderTreeIterator,IJclCollection,IJclIterator,IJclTreeIterator,IJclEqualityComparer,AOwnsItems: Boolean,AOwnsItems,const ,AItem,T,Default(T),FreeItem)} + +{$JPPEXPANDMACRO JCLTREEITRIMP(TJclTreeIterator,TJclPreOrderTreeIterator,TJclPostOrderTreeIterator,TJclTreeNode,TJclTree,IJclIterator,IJclTreeIterator,IJclEqualityComparer,const ,AItem,T,Default(T),GetItem,SetItem,FreeItem)} + +//=== { TJclTreeE } ======================================================= + +constructor TJclTreeE.Create(const AEqualityComparer: IJclEqualityComparer; AOwnsItems: Boolean); +begin + inherited Create(AOwnsItems); + FEqualityComparer := AEqualityComparer; +end; + +procedure TJclTreeE.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclTreeE then + TJclTreeE(Dest).FEqualityComparer := FEqualityComparer; +end; + +function TJclTreeE.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclTreeE.Create(EqualityComparer, False); + AssignPropertiesTo(Result); +end; + +function TJclTreeE.ItemsEqual(const A, B: T): Boolean; +begin + if EqualityComparer <> nil then + Result := EqualityComparer.ItemsEqual(A, B) + else + Result := inherited ItemsEqual(A, B); +end; + +//=== { TJclTreeF } ======================================================= + +constructor TJclTreeF.Create(ACompare: TCompare; AOwnsItems: Boolean); +begin + inherited Create(AOwnsItems); + SetCompare(ACompare); +end; + +function TJclTreeF.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclTreeF.Create(Compare, False); + AssignPropertiesTo(Result); +end; + +//=== { TJclTreeI } ======================================================= + +function TJclTreeI.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclTreeI.Create(False); + AssignPropertiesTo(Result); +end; + +function TJclTreeI.ItemsEqual(const A, B: T): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + Result := A.Equals(B); +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/prototypes/JclVectors.pas b/3rdParty/JCL/source/prototypes/JclVectors.pas new file mode 100644 index 00000000..3e72fa2b --- /dev/null +++ b/3rdParty/JCL/source/prototypes/JclVectors.pas @@ -0,0 +1,246 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is Vector.pas. } +{ } +{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by } +{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com) } +{ All rights reserved. } +{ } +{ Contributors: } +{ Daniele Teti (dade2004) } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclVectors; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Classes, + {$ENDIF ~HAS_UNITSCOPE} + JclAlgorithms, JclBase, JclAbstractContainers, JclContainerIntf, JclSynch; +{$I containers\JclContainerCommon.imp} +{$I containers\JclVectors.imp} +{$I containers\JclVectors.int} +{$I containers\JclAlgorithms.int} +{$I containers\JclAlgorithms.imp} +type + TItrStart = (isFirst, isLast); +(*$JPPLOOP ALLTYPEINDEX ALLTYPECOUNT + {$JPPEXPANDMACRO JCLVECTORINT(,,,,,,,,,,,,,,,,,,)} + + {$JPPEXPANDMACRO JCLVECTORITRINT(,,,,,,,)} + +*) + {$IFDEF SUPPORTS_GENERICS} + //DOM-IGNORE-BEGIN + + TJclVectorIterator = class; + + (*$JPPEXPANDMACRO JCLVECTORINT(TJclVector,TJclAbstractContainer,IJclContainer,IJclFlatContainer,IJclCollection,IJclList,IJclArray,IJclIterator,IJclEqualityComparer, IJclItemOwner\,, +protected + type + TDynArray = array of T; + TVectorIterator = TJclVectorIterator; + {$JPPDEFINE GENERIC}{$JPPEXPANDMACRO MOVEARRAYINT(MoveArray,TDynArray,)},,; AOwnsItems: Boolean,const ,AItem,T,TDynArray,GetItem,SetItem)*) + + (*$JPPEXPANDMACRO JCLVECTORITRINT(TJclVectorIterator,IJclIterator,TJclVector,const ,AItem,T,GetItem,SetItem)*) + + // E = External helper to compare items for equality (GetHashCode is not used) + TJclVectorE = class(TJclVector, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, + IJclCollection, IJclList, IJclArray, IJclItemOwner) + private + FEqualityComparer: IJclEqualityComparer; + protected + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AEqualityComparer: IJclEqualityComparer; ACapacity: Integer; AOwnsItems: Boolean); + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + property EqualityComparer: IJclEqualityComparer read FEqualityComparer write FEqualityComparer; + end; + + // F = Function to compare items for equality + TJclVectorF = class(TJclVector, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, + IJclCollection, IJclList, IJclArray, IJclItemOwner) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + constructor Create(const AEqualityCompare: TEqualityCompare; ACapacity: Integer; AOwnsItems: Boolean); + end; + + // I = Items can compare themselves to an other for equality + TJclVectorI> = class(TJclVector, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, IJclContainer, + IJclCollection, IJclList, IJclArray, IJclItemOwner) + protected + function CreateEmptyContainer: TJclAbstractContainerBase; override; + public + { IJclEqualityComparer } + function ItemsEqual(const A, B: T): Boolean; override; + end; + + //DOM-IGNORE-END + {$ENDIF SUPPORTS_GENERICS} + +{$IFDEF BCB} +{$IFDEF WIN64} + {$HPPEMIT '#ifdef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #undef MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT ' #define JclVectors_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT '#endif'} + + {$HPPEMIT END '#ifdef JclVectors_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #define MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END ' #undef JclVectors_MANAGED_INTERFACE_OPERATORS'} + {$HPPEMIT END '#endif'} +{$ENDIF WIN64} +{$ENDIF BCB} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\common'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +(*$JPPLOOP TRUETYPEINDEX TRUETYPECOUNT +{$JPPEXPANDMACRO JCLVECTORIMP(,,,,,,,,,,,,,,)} + +{$JPPEXPANDMACRO JCLVECTORITRIMP(,,,,,,,)} + +*) +{$IFDEF SUPPORTS_GENERICS} +//DOM-IGNORE-BEGIN + +(*$JPPEXPANDMACRO JCLVECTORIMP(TJclVector,IJclCollection,IJclList,IJclIterator,TVectorIterator,; AOwnsItems: Boolean,AOwnsItems,MoveArray,const ,AItem,T,Default(T),GetItem,SetItem,FreeItem)*) + +{$JPPDEFINE GENERIC}{$JPPEXPANDMACRO MOVEARRAYIMP(MoveArray,TDynArray,Default(T),TJclVector.,)} + +(*$JPPEXPANDMACRO JCLVECTORITRIMP(TJclVectorIterator,IJclIterator,TJclVector,const ,AItem,T,GetItem,SetItem)*) + +//=== { TJclVectorE } ===================================================== + +constructor TJclVectorE.Create(const AEqualityComparer: IJclEqualityComparer; ACapacity: Integer; + AOwnsItems: Boolean); +begin + inherited Create(ACapacity, AOwnsItems); + FEqualityComparer := AEqualityComparer; +end; + +procedure TJclVectorE.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesTo(Dest); + if Dest is TJclVectorE then + TJclVectorE(Dest).FEqualityComparer := FEqualityComparer; +end; + +function TJclVectorE.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclVectorE.Create(EqualityComparer, FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclVectorE.ItemsEqual(const A, B: T): Boolean; +begin + if EqualityComparer <> nil then + Result := EqualityComparer.ItemsEqual(A, B) + else + Result := inherited ItemsEqual(A, B); +end; + +//=== { TJclVectorF } ===================================================== + +constructor TJclVectorF.Create(const AEqualityCompare: TEqualityCompare; ACapacity: Integer; + AOwnsItems: Boolean); +begin + inherited Create(ACapacity, AOwnsItems); + SetEqualityCompare(AEqualityCompare); +end; + +function TJclVectorF.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclVectorF.Create(EqualityCompare, FSize, False); + AssignPropertiesTo(Result); +end; + +//=== { TJclVectorI } ===================================================== + +function TJclVectorI.CreateEmptyContainer: TJclAbstractContainerBase; +begin + Result := TJclVectorI.Create(FSize, False); + AssignPropertiesTo(Result); +end; + +function TJclVectorI.ItemsEqual(const A, B: T): Boolean; +begin + if Assigned(FEqualityCompare) then + Result := FEqualityCompare(A, B) + else + if Assigned(FCompare) then + Result := FCompare(A, B) = 0 + else + Result := A.Equals(B); +end; + +//DOM-IGNORE-END +{$ENDIF SUPPORTS_GENERICS} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/prototypes/JclWin32.pas b/3rdParty/JCL/source/prototypes/JclWin32.pas new file mode 100644 index 00000000..506092a2 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/JclWin32.pas @@ -0,0 +1,325 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ Portions of this code are translated from DelayImp.h. } +{ The Initial Developer of DelayImp.h is Inprise Corporation. Portions created by Inprise } +{ Corporation are Copyright (C) 1999, 2000 by Inprise Corporation. All Rights Reserved. } +{ } +{ The Original Code is JclWin32.pas. } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. Portions created by Marcel van } +{ Brakel are Copyright (C) Marcel van Brakel. All Rights Reserved. } +{ } +{ Contributors: } +{ Marcel van Brakel } +{ Peter Friese } +{ Andreas Hausladen (ahuser) } +{ Flier Lu (flier) } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Olivier Sannier (obones) } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ This unit defines various Win32 API declarations which are either missing or incorrect in one or } +{ more of the supported Delphi versions. This unit is not intended for regular code, only API } +{ declarations. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclWin32; + +{$I jcl.inc} +{$I windowsonly.inc} + +{$MINENUMSIZE 4} +{$ALIGN ON} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, System.SysUtils, + {$IFNDEF FPC} + Winapi.AccCtrl, Winapi.ActiveX, + {$ENDIF ~FPC} + {$ELSE ~HAS_UNITSCOPE} + Windows, SysUtils, + {$IFNDEF FPC} + AccCtrl, + {$ENDIF ~FPC} + ActiveX, + {$ENDIF ~HAS_UNITSCOPE} + JclBase; + +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +//{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$IFNDEF COMPILER14_UP} +{$HPPEMIT '#include '} +{$ENDIF ~COMPILER14_UP} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT ''} +{$IFDEF RTL230_UP} +{$HPPEMIT '// To avoid ambiguity between IMAGE_LOAD_CONFIG_DIRECTORY32 and Winapi::Windows::IMAGE_LOAD_CONFIG_DIRECTORY32'} +{$HPPEMIT '#define IMAGE_LOAD_CONFIG_DIRECTORY32 ::IMAGE_LOAD_CONFIG_DIRECTORY32'} +{$HPPEMIT ''} +{$HPPEMIT '// To avoid ambiguity between IMAGE_LOAD_CONFIG_DIRECTORY64 and Winapi::Windows::IMAGE_LOAD_CONFIG_DIRECTORY64'} +{$HPPEMIT '#define IMAGE_LOAD_CONFIG_DIRECTORY64 ::IMAGE_LOAD_CONFIG_DIRECTORY64'} +{$HPPEMIT ''} +{$ENDIF RTL230_UP} + +// EJclWin32Error +{$IFDEF MSWINDOWS} +type + EJclWin32Error = class(EJclError) + private + FLastError: DWORD; + FLastErrorMsg: string; + public + constructor Create(const Msg: string); + constructor CreateFmt(const Msg: string; const Args: array of const); + constructor CreateRes(Ident: Integer); overload; + constructor CreateRes(ResStringRec: PResStringRec); overload; + property LastError: DWORD read FLastError; + property LastErrorMsg: string read FLastErrorMsg; + end; +{$ENDIF MSWINDOWS} + +//DOM-IGNORE-BEGIN + +{$I win32api\WinDef.int} +{$I win32api\WinNT.int} +{$I win32api\WinBase.int} +{$I win32api\AclApi.int} +{$I win32api\ImageHlp.int} +{$I win32api\IoAPI.int} +{$I win32api\LmErr.int} +{$I win32api\LmCons.int} +{$I win32api\LmAccess.int} +{$I win32api\LmApiBuf.int} +{$I win32api\Lmwksta.int} +{$I win32api\Nb30.int} +{$I win32api\RasDlg.int} +{$I win32api\Reason.int} +{$I win32api\ShlObj.int} +{$I win32api\ShlWApi.int} +{$I win32api\WinError.int} +{$I win32api\WinIoctl.int} +{$I win32api\WinNLS.int} +{$I win32api\WinUser.int} +{$I win32api\PowrProf.int} +{$I win32api\DelayImp.int} +{$I win32api\MsiDefs.int} +{$I win32api\ShlGuid.int} +{$I win32api\imgguids.int} +{$I win32api\ObjBase.int} +{$I win32api\PropIdl.int} +{$I win32api\NtSecApi.int} +{$I win32api\TlHelp32.int} +{$I win32api\Winternl.int} + +//DOM-IGNORE-END + +{$IFDEF MSWINDOWS} + +const + RtdlSetNamedSecurityInfoW: function(pObjectName: LPWSTR; ObjectType: SE_OBJECT_TYPE; + SecurityInfo: SECURITY_INFORMATION; psidOwner, psidGroup: PSID; + pDacl, pSacl: PACL): DWORD stdcall = SetNamedSecurityInfoW; + + RtdlSetWaitableTimer: function(hTimer: THandle; var lpDueTime: TLargeInteger; + lPeriod: Longint; pfnCompletionRoutine: TFNTimerAPCRoutine; + lpArgToCompletionRoutine: Pointer; fResume: BOOL): BOOL stdcall = SetWaitableTimer; + + RtdlNetUserAdd: function(servername: LPCWSTR; level: DWORD; + buf: PByte; parm_err: PDWord): NET_API_STATUS stdcall = NetUserAdd; + + RtdlNetUserDel: function(servername: LPCWSTR; + username: LPCWSTR): NET_API_STATUS stdcall = NetUserDel; + + RtdlNetGroupAdd: function(servername: LPCWSTR; level: DWORD; buf: PByte; + parm_err: PDWord): NET_API_STATUS stdcall = NetGroupAdd; + + RtdlNetGroupEnum: function(servername: LPCWSTR; level: DWORD; + out bufptr: PByte; prefmaxlen: DWORD; out entriesread, totalentries: DWORD; + resume_handle: PDWORD_PTR): NET_API_STATUS stdcall = NetGroupEnum; + + RtdlNetGroupDel: function(servername: LPCWSTR; + groupname: LPCWSTR): NET_API_STATUS stdcall = NetGroupDel; + + RtdlNetLocalGroupAdd: function(servername: LPCWSTR; level: DWORD; + buf: PByte; parm_err: PDWord): NET_API_STATUS stdcall = NetLocalGroupAdd; + + RtdlNetLocalGroupEnum: function(servername: LPCWSTR; level: DWORD; + out bufptr: PByte; prefmaxlen: DWORD; out entriesread, totalentries: DWORD; + resumehandle: PDWORD_PTR): NET_API_STATUS stdcall = NetLocalGroupEnum; + + RtdlNetLocalGroupDel: function(servername: LPCWSTR; + groupname: LPCWSTR): NET_API_STATUS stdcall = NetLocalGroupDel; + + RtdlNetLocalGroupAddMembers: function(servername: LPCWSTR; groupname: LPCWSTR; + level: DWORD; buf: PByte; + totalentries: DWORD): NET_API_STATUS stdcall = NetLocalGroupAddMembers; + + RtdlNetApiBufferFree: function(Buffer: Pointer): NET_API_STATUS stdcall = NetApiBufferFree; + + RtdlGetCalendarInfoA: function(Locale: LCID; Calendar: CALID; CalType: CALTYPE; + lpCalData: PAnsiChar; cchData: Integer; + lpValue: PDWORD): Integer stdcall = GetCalendarInfoA; + + RtdlGetCalendarInfoW: function(Locale: LCID; Calendar: CALID; CalType: CALTYPE; + lpCalData: PWideChar; cchData: Integer; + lpValue: PDWORD): Integer stdcall = GetCalendarInfoW; + + RtdlEnumCalendarInfoExW: function(lpCalInfoEnumProc: TCalInfoEnumProcExW; + Locale: LCID; Calendar: CALID; CalType: CALTYPE): BOOL stdcall = EnumCalendarInfoExW; + + RtdlGetVolumeNameForVolumeMountPointW: function(lpszVolumeMountPoint: LPCWSTR; + lpszVolumeName: LPWSTR; cchBufferLength: DWORD): BOOL stdcall = GetVolumeNameForVolumeMountPointW; + + RtdlSetVolumeMountPointW: function(lpszVolumeMountPoint: LPCWSTR; + lpszVolumeName: LPCWSTR): BOOL stdcall = SetVolumeMountPointW; + + RtdlDeleteVolumeMountPointW: function(lpszVolumeMountPoint: LPCWSTR): BOOL + stdcall = DeleteVolumeMountPointW; + + RtdlNetBios: function(P: PNCB): UCHAR stdcall = NetBios; + +{$ENDIF MSWINDOWS} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows' + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + JclResources; + +procedure GetProcedureAddress(var P: Pointer; const ModuleName, ProcName: string); +var + ModuleHandle: HMODULE; +begin + if not Assigned(P) then + begin + ModuleHandle := GetModuleHandle(PChar(ModuleName)); + if ModuleHandle = 0 then + begin + ModuleHandle := SafeLoadLibrary(PChar(ModuleName)); + if ModuleHandle = 0 then + raise EJclError.CreateResFmt(@RsELibraryNotFound, [ModuleName]); + end; + P := GetProcAddress(ModuleHandle, PChar(ProcName)); + if not Assigned(P) then + raise EJclError.CreateResFmt(@RsEFunctionNotFound, [ModuleName, ProcName]); + end; +end; + +//== { EJclWin32Error } ====================================================== + +{$IFDEF MSWINDOWS} + +constructor EJclWin32Error.Create(const Msg: string); +begin + FLastError := GetLastError; + FLastErrorMsg := SysErrorMessage(FLastError); + inherited CreateResFmt(@RsWin32Error, [FLastErrorMsg, FLastError, NativeLineBreak, Msg]); +end; + +constructor EJclWin32Error.CreateFmt(const Msg: string; const Args: array of const); +begin + FLastError := GetLastError; + FLastErrorMsg := SysErrorMessage(FLastError); + inherited CreateResFmt(@RsWin32Error, [FLastErrorMsg, FLastError, NativeLineBreak, Format(Msg, Args)]); +end; + +constructor EJclWin32Error.CreateRes(Ident: Integer); +begin + FLastError := GetLastError; + FLastErrorMsg := SysErrorMessage(FLastError); + inherited CreateResFmt(@RsWin32Error, [FLastErrorMsg, FLastError, NativeLineBreak, LoadStr(Ident)]); +end; + +constructor EJclWin32Error.CreateRes(ResStringRec: PResStringRec); +begin + FLastError := GetLastError; + FLastErrorMsg := SysErrorMessage(FLastError); + inherited CreateResFmt(@RsWin32Error, [FLastErrorMsg, FLastError, NativeLineBreak, LoadResString(ResStringRec)]); +end; + +{$ENDIF MSWINDOWS} + +{$I win32api\AclApi.imp} +{$I win32api\ImageHlp.imp} +{$I win32api\IoAPI.imp} +{$I win32api\LmAccess.imp} +{$I win32api\LmApiBuf.imp} +{$I win32api\Lmwksta.imp} +{$I win32api\Nb30.imp} +{$I win32api\WinBase.imp} +{$I win32api\WinNLS.imp} +{$I win32api\WinUser.imp} +{$I win32api\WinNT.imp} +{$I win32api\PowrProf.imp} +{$I win32api\ObjBase.imp} +{$I win32api\PropIdl.imp} +{$I win32api\NtSecApi.imp} +{$I win32api\TlHelp32.imp} +{$I win32api\Winternl.imp} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + + + diff --git a/3rdParty/JCL/source/prototypes/Makefile.mak b/3rdParty/JCL/source/prototypes/Makefile.mak new file mode 100644 index 00000000..50b81aa5 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/Makefile.mak @@ -0,0 +1,122 @@ +# +# Generates platform dependent units from common code base +# +# $Id$ +# + +jpp = ..\..\devtools\jpp.exe +jppContainers = ..\..\devtools\jppContainers.exe +touch = $(MAKEDIR)\touch.exe + +Options = -c -dJCL -dSUPPORTS_DEFAULTPARAMS -dSUPPORTS_INT64 +# CommonOptions = $(Options) -f..\common\\ +VclOptions = $(Options) -dVCL -dMSWINDOWS -uUnix -dBitmap32 -f..\vcl\\ +WinOptions = $(Options) -dMSWINDOWS -uUNIX -uHAS_UNIT_LIBC -f..\windows\\ +Win32Options = $(Options) -uHAS_UNIT_LIBC -f..\windows\\ +ContainerOptions = $(Options) -m -ijcl.inc -f..\Common\\ +UnixOptions = $(Options) -uMSWINDOWS -dUNIX -f..\unix\\ + +release: VCL Windows ContainersProt Containers + +VCL: ..\vcl\JclGraphics.pas \ + ..\vcl\JclGraphUtils.pas + +Windows: ..\windows\JclWin32.pas \ + ..\windows\Hardlinks.pas + +ContainersProt: JclAlgorithms.pas \ + JclArrayLists.pas \ + JclArraySets.pas \ + JclBinaryTrees.pas \ + JclContainerIntf.pas \ + JclHashMaps.pas \ + JclHashSets.pas \ + JclLinkedLists.pas \ + JclQueues.pas \ + JclSortedMaps.pas \ + JclStacks.pas \ + JclTrees.pas \ + JclVectors.pas + +Containers: ..\Common\JclAlgorithms.pas \ + ..\Common\JclArrayLists.pas \ + ..\Common\JclArraySets.pas \ + ..\Common\JclBinaryTrees.pas \ + ..\Common\JclContainerIntf.pas \ + ..\Common\JclHashMaps.pas \ + ..\Common\JclHashSets.pas \ + ..\Common\JclLinkedLists.pas \ + ..\Common\JclQueues.pas \ + ..\Common\JclSortedMaps.pas \ + ..\Common\JclStacks.pas \ + ..\Common\JclTrees.pas \ + ..\Common\JclVectors.pas + +..\windows\JclWin32.pas: \ + JclWin32.pas + $(jpp) -ijcl.inc -iwindowsonly.inc $(WinOptions) $? + +JclAlgorithms.pas: \ + containers\JclAlgorithms.int containers\JclAlgorithms.imp + $(touch) $@ + +JclArrayLists.pas: \ + containers\JclArrayLists.imp containers\JclArrayLists.int containers\JclContainerCommon.imp containers\JclAlgorithms.int containers\JclAlgorithms.imp + $(touch) $@ + +JclArraySets.pas: \ + containers\JclArraySets.imp containers\JclArraySets.int containers\JclContainerCommon.imp + $(touch) $@ + +JclBinaryTrees.pas: \ + containers\JclBinaryTrees.imp containers\JclBinaryTrees.int containers\JclContainerCommon.imp + $(touch) $@ + +JclContainerIntf.pas: \ + containers\JclContainerIntf.int + $(touch) $@ + +JclHashMaps.pas: \ + containers\JclHashMaps.imp containers\JclHashMaps.int containers\JclContainerCommon.imp containers\JclAlgorithms.int containers\JclAlgorithms.imp + $(touch) $@ + +JclHashSets.pas: \ + containers\JclHashSets.imp containers\JclHashSets.int containers\JclContainerCommon.imp containers\JclAlgorithms.int containers\JclAlgorithms.imp + $(touch) $@ + +JclLinkedLists.pas: \ + containers\JclLinkedLists.imp containers\JclLinkedLists.int containers\JclContainerCommon.imp + $(touch) $@ + +JclQueues.pas: \ + containers\JclQueues.imp containers\JclQueues.int containers\JclContainerCommon.imp containers\JclAlgorithms.int containers\JclAlgorithms.imp + $(touch) $@ + +JclSortedMaps.pas: \ + containers\JclSortedMaps.imp containers\JclSortedMaps.int containers\JclContainerCommon.imp containers\JclAlgorithms.int containers\JclAlgorithms.imp + $(touch) $@ + +JclStacks.pas: \ + containers\JclStacks.imp containers\JclStacks.int containers\JclContainerCommon.imp + $(touch) $@ + +JclTrees.pas: \ + containers\JclTrees.imp containers\JclTrees.int containers\JclContainerCommon.imp + $(touch) $@ + +JclVectors.pas: \ + containers\JclVectors.imp containers\JclVectors.int containers\JclContainerCommon.imp containers\JclAlgorithms.int containers\JclAlgorithms.imp + $(touch) $@ + +{.}.pas{..\common}.pas: + $(jppContainers) $(ContainerOptions) $< + +{.}.pas{..\windows}.pas: + $(jpp) $(WinOptions) $< + +{.}.pas{..\unix}.pas: + $(jpp) $(UnixOptions) $< + +{.}.pas{..\vcl}.pas: + $(jpp) $(VclOptions) $< + diff --git a/3rdParty/JCL/source/prototypes/containers/JclAlgorithms.imp b/3rdParty/JCL/source/prototypes/containers/JclAlgorithms.imp new file mode 100644 index 00000000..fcfbac1e --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclAlgorithms.imp @@ -0,0 +1,303 @@ +(*$JPPDEFINEMACRO MOVEARRAYIMP(MOVEARRAYPROCEDURENAME, DYNARRAYTYPENAME, DEFAULTVALUE, PREFIX, OVERLOAD) +{$IFDEF GENERIC} +procedure PREFIXMOVEARRAYPROCEDURENAME(var List: DYNARRAYTYPENAME; FromIndex, ToIndex, Count: SizeInt);OVERLOAD +var + I: SizeInt; +begin + if FromIndex < ToIndex then + begin + for I := Count - 1 downto 0 do + List[ToIndex + I] := List[FromIndex + I]; + + if (ToIndex - FromIndex) < Count then + // overlapped source and target + for I := 0 to ToIndex - FromIndex - 1 do + List[FromIndex + I] := DEFAULTVALUE + else + // independant + for I := 0 to Count - 1 do + List[FromIndex + I] := DEFAULTVALUE; + end + else + begin + for I := 0 to Count - 1 do + List[ToIndex + I] := List[FromIndex + I]; + + if (FromIndex - ToIndex) < Count then + // overlapped source and target + for I := Count - FromIndex + ToIndex to Count - 1 do + List[FromIndex + I] := DEFAULTVALUE + else + // independant + for I := 0 to Count - 1 do + List[FromIndex + I] := DEFAULTVALUE; + end; +end; +{$ELSE ~GENERIC} +{$IFDEF REFCOUNTED} +procedure PREFIXFinalizeArrayBeforeMove(var List: DYNARRAYTYPENAME; FromIndex, ToIndex, Count: SizeInt);OVERLOAD +begin + Assert(Count > 0); + if FromIndex < ToIndex then + begin + if Count > (ToIndex - FromIndex) then + Finalize(List[FromIndex + Count], ToIndex - FromIndex) + else + Finalize(List[ToIndex], Count); + end + else + if FromIndex > ToIndex then + begin + if Count > (FromIndex - ToIndex) then + Count := FromIndex - ToIndex; + Finalize(List[ToIndex], Count) + end; +end; + +procedure PREFIXInitializeArray(var List: DYNARRAYTYPENAME; FromIndex, Count: SizeInt);OVERLOAD +begin + {$IFDEF FPC} + while Count > 0 do + begin + Initialize(List[FromIndex]); + Inc(FromIndex); + Dec(Count); + end; + {$ELSE ~FPC} + Initialize(List[FromIndex], Count); + {$ENDIF ~FPC} +end; + +procedure PREFIXInitializeArrayAfterMove(var List: DYNARRAYTYPENAME; FromIndex, ToIndex, Count: SizeInt);OVERLOAD +begin + { Keep reference counting working } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + InitializeArray(List, FromIndex, Count); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + InitializeArray(List, ToIndex + Count, FromIndex - ToIndex) + else + InitializeArray(List, FromIndex, Count); + end; +end; +{$ELSE ~REFCOUNTED} +{$IFDEF ZEROINIT} +procedure PREFIXInitializeArrayAfterMove(var List: DYNARRAYTYPENAME; FromIndex, ToIndex, Count: SizeInt);OVERLOAD +begin + { Clean array } + if FromIndex < ToIndex then + begin + if (ToIndex - FromIndex) < Count then + Count := ToIndex - FromIndex; + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end + else + if FromIndex > ToIndex then + begin + if (FromIndex - ToIndex) < Count then + FillChar(List[ToIndex + Count], (FromIndex - ToIndex) * SizeOf(List[0]), 0) + else + FillChar(List[FromIndex], Count * SizeOf(List[0]), 0); + end; +end; + +{$ENDIF ZEROINIT} +{$ENDIF ~REFCOUNTED} +procedure PREFIXMOVEARRAYPROCEDURENAME(var List: DYNARRAYTYPENAME; FromIndex, ToIndex, Count: SizeInt);OVERLOAD +begin + if Count > 0 then + begin +{$IFDEF REFCOUNTED} FinalizeArrayBeforeMove(List, FromIndex, ToIndex, Count);{$ENDIF REFCOUNTED} + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); +{$IFDEF REFCOUNTED} InitializeArrayAfterMove(List, FromIndex, ToIndex, Count); +{$ELSE ~REFCOUNTED}{$IFDEF ZEROINIT} InitializeArrayAfterMove(List, FromIndex, ToIndex, Count);{$ENDIF ZEROINIT}{$ENDIF ~REFCOUNTED} + end; +end;{$ENDIF ~GENERIC}*) +(*$JPPDEFINEMACRO ITERATEIMP(ITERATEPROCEDURENAME, ITRINTERFACENAME, ITERATEPROCEDURETYPENAME) +procedure ITERATEPROCEDURENAME(const First: ITRINTERFACENAME; Count: Integer; F: ITERATEPROCEDURETYPENAME); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + F(First.Next) + else + Break; +end;*) +(*$JPPDEFINEMACRO APPLYIMP(APPLYPROCEDURENAME, ITRINTERFACENAME, APPLYFUNCTIONTYPENAME, SETTERPROCEDURENAME) +procedure APPLYPROCEDURENAME(const First: ITRINTERFACENAME; Count: Integer; F: APPLYFUNCTIONTYPENAME); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + First.SETTERPROCEDURENAME(F(First.Next)) + else + Break; +end;*) +(*$JPPDEFINEMACRO FINDIMP(FINDFUNCTIONNAME, ITRINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, COMPAREFUNCTIONTYPENAME, TYPENAME) +function FINDFUNCTIONNAME(const First: ITRINTERFACENAME; Count: Integer; + CONSTKEYWORDPARAMETERNAME: TYPENAME; AComparator: COMPAREFUNCTIONTYPENAME): ITRINTERFACENAME; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AComparator(First.Next, PARAMETERNAME) = 0 then + begin + Result := First; + Break; + end; + end + else + Break; +end;*) +(*$JPPDEFINEMACRO FINDEQIMP(FINDFUNCTIONNAME, ITRINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, EQUALITYCOMPAREFUNCTIONTYPENAME, TYPENAME) +function FINDFUNCTIONNAME(const First: ITRINTERFACENAME; Count: Integer; + CONSTKEYWORDPARAMETERNAME: TYPENAME; AEqualityComparator: EQUALITYCOMPAREFUNCTIONTYPENAME): ITRINTERFACENAME; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AEqualityComparator(First.Next, PARAMETERNAME) then + begin + Result := First; + Break; + end; + end + else + Break; +end;*) +(*$JPPDEFINEMACRO COUNTOBJECTIMP(COUNTOBJECTFUNCTIONNAME, ITRINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, COMPAREFUNCTIONTYPENAME, TYPENAME) +function COUNTOBJECTFUNCTIONNAME(const First: ITRINTERFACENAME; Count: Integer; + CONSTKEYWORDPARAMETERNAME: TYPENAME; AComparator: COMPAREFUNCTIONTYPENAME): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AComparator(First.Next, PARAMETERNAME) = 0)) + else + Break; +end;*) +(*$JPPDEFINEMACRO COUNTOBJECTEQIMP(COUNTOBJECTFUNCTIONNAME, ITRINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, EQUALITYCOMPAREFUNCTIONTYPENAME, TYPENAME) +function COUNTOBJECTFUNCTIONNAME(const First: ITRINTERFACENAME; Count: Integer; + CONSTKEYWORDPARAMETERNAME: TYPENAME; AEqualityComparator: EQUALITYCOMPAREFUNCTIONTYPENAME): Integer; +var + I: Integer; +begin + Result := 0; + for I := Count - 1 downto 0 do + if First.HasNext then + Inc(Result, Ord(AEqualityComparator(First.Next, PARAMETERNAME))) + else + Break; +end;*) +(*$JPPDEFINEMACRO COPYIMP(COPYPROCEDURENAME, ITRINTERFACENAME, SETTERPROCEDURENAME) +procedure COPYPROCEDURENAME(const First: ITRINTERFACENAME; Count: Integer; + const Output: ITRINTERFACENAME); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if Output.HasNext and First.HasNext then + begin + Output.Next; + Output.SETTERPROCEDURENAME(First.Next); + end + else + Break; +end;*) +(*$JPPDEFINEMACRO GENERATEIMP(GENERATEPROCEDURENAME, LISTINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME) +procedure GENERATEPROCEDURENAME(const List: LISTINTERFACENAME; Count: Integer; + CONSTKEYWORDPARAMETERNAME: TYPENAME); +var + I: Integer; +begin + List.Clear; + for I := 0 to Count - 1 do + List.Add(PARAMETERNAME); +end;*) +(*$JPPDEFINEMACRO FILLIMP(FILLPROCEDURENAME, ITRINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, SETTERPROCEDURENAME) +procedure FILLPROCEDURENAME(const First: ITRINTERFACENAME; Count: Integer; + CONSTKEYWORDPARAMETERNAME: TYPENAME); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + begin + First.Next; + First.SETTERPROCEDURENAME(PARAMETERNAME); + end + else + Break; +end;*) +(*$JPPDEFINEMACRO REVERSEIMP(REVERSEPROCEDURENAME, ITRINTERFACENAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) +procedure REVERSEPROCEDURENAME(const First, Last: ITRINTERFACENAME); +var + Obj: TYPENAME; +begin + if not First.HasNext then + Exit; + if not Last.HasPrevious then + Exit; + while First.NextIndex < Last.PreviousIndex do + begin + Obj := First.Next; + Last.Previous; + First.SETTERPROCEDURENAME(Last.GETTERFUNCTIONNAME); + Last.SETTERPROCEDURENAME(Obj); + end; +end;*) +(*$JPPDEFINEMACRO QUICKSORTIMP(QUICKSORTPROCEDURENAME, LISTINTERFACENAME, LEFT, RIGHT, COMPAREFUNCTIONTYPENAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) +procedure QUICKSORTPROCEDURENAME(const AList: LISTINTERFACENAME; LEFT, RIGHT: Integer; + AComparator: COMPAREFUNCTIONTYPENAME); +var + I, J, P: Integer; + Obj: TYPENAME; +begin + repeat + I := L; + J := R; + P := (LEFT + RIGHT) shr 1; + repeat + Obj := AList.GETTERFUNCTIONNAME(P); + while AComparator(AList.GETTERFUNCTIONNAME(I), Obj) < 0 do + Inc(I); + while AComparator(AList.GETTERFUNCTIONNAME(J), Obj) > 0 do + Dec(J); + if I <= J then + begin + if I <> J then + begin + Obj := AList.GETTERFUNCTIONNAME(I); + AList.SETTERPROCEDURENAME(I, AList.GETTERFUNCTIONNAME(J)); + AList.SETTERPROCEDURENAME(J, Obj); + end; + if P = I then + P := J + else + if P = J then + P := I; + Inc(I); + Dec(J); + end; + until I > J; + if LEFT < J then + QUICKSORTPROCEDURENAME(AList, LEFT, J, AComparator); + L := I; + until I >= RIGHT; +end;*) \ No newline at end of file diff --git a/3rdParty/JCL/source/prototypes/containers/JclAlgorithms.int b/3rdParty/JCL/source/prototypes/containers/JclAlgorithms.int new file mode 100644 index 00000000..e307bece --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclAlgorithms.int @@ -0,0 +1,53 @@ +(*$JPPDEFINEMACRO MOVEARRAYINT(MOVEARRAYPROCEDURENAME, DYNARRAYTYPENAME, OVERLOAD) +{$IFDEF GENERIC} +procedure MOVEARRAYPROCEDURENAME(var List: DYNARRAYTYPENAME; FromIndex, ToIndex, Count: SizeInt);OVERLOAD +{$ELSE ~GENERIC} +{$IFDEF REFCOUNTED} +procedure FinalizeArrayBeforeMove(var List: DYNARRAYTYPENAME; FromIndex, ToIndex, Count: SizeInt);OVERLOAD + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure InitializeArray(var List: DYNARRAYTYPENAME; FromIndex, Count: SizeInt);OVERLOAD + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +procedure InitializeArrayAfterMove(var List: DYNARRAYTYPENAME; FromIndex, ToIndex, Count: SizeInt);OVERLOAD + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +{$ELSE ~REFCOUNTED} +{$IFDEF ZEROINIT} +procedure InitializeArrayAfterMove(var List: DYNARRAYTYPENAME; FromIndex, ToIndex, Count: SizeInt);OVERLOAD + {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF} +{$ENDIF ZEROINIT} +{$ENDIF ~REFCOUNTED} +procedure MOVEARRAYPROCEDURENAME(var List: DYNARRAYTYPENAME; FromIndex, ToIndex, Count: SizeInt);OVERLOAD{$ENDIF ~GENERIC}*) +(*$JPPDEFINEMACRO ITERATEINT(ITERATEPROCEDURENAME, ITRINTERFACENAME, ITERATEPROCEDURETYPENAME, OVERLOAD) +procedure ITERATEPROCEDURENAME(const First: ITRINTERFACENAME; Count: Integer; F: ITERATEPROCEDURETYPENAME);OVERLOAD*) +(*$JPPDEFINEMACRO APPLYINT(APPLYPROCEDURENAME, ITRINTERFACENAME, APPLYFUNCTIONTYPENAME, OVERLOAD) +procedure APPLYPROCEDURENAME(const First: ITRINTERFACENAME; Count: Integer; F: APPLYFUNCTIONTYPENAME);OVERLOAD*) +(*$JPPDEFINEMACRO SIMPLECOMPAREINT(SIMPLECOMPAREFUNCTIONNAME, CONSTKEYWORD, TYPENAME) +function SIMPLECOMPAREFUNCTIONNAME(CONSTKEYWORDObj1, Obj2: TYPENAME): Integer;*) +(*$JPPDEFINEMACRO SIMPLEEQUALITYCOMPAREINT(SIMPLEEQUALITYCOMPAREFUNCTIONNAME, CONSTKEYWORD, TYPENAME) +function SIMPLEEQUALITYCOMPAREFUNCTIONNAME(CONSTKEYWORDObj1, Obj2: TYPENAME): Boolean;*) +(*$JPPDEFINEMACRO SIMPLEHASHCONVERTINT(SIMPLEHASHCONVERTFUNCTIONNAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME) +function SIMPLEHASHCONVERTFUNCTIONNAME(CONSTKEYWORDPARAMETERNAME: TYPENAME): Integer;*) +(*$JPPDEFINEMACRO FINDINT(FINDFUNCTIONNAME, ITRINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, COMPAREFUNCTIONTYPENAME, TYPENAME, OVERLOAD) +function FINDFUNCTIONNAME(const First: ITRINTERFACENAME; Count: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME; + AComparator: COMPAREFUNCTIONTYPENAME): ITRINTERFACENAME;OVERLOAD*) +(*$JPPDEFINEMACRO FINDEQINT(FINDFUNCTIONNAME,ITRINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, EQUALITYCOMPAREFUNCTIONTYPENAME, TYPENAME, OVERLOAD) +function FINDFUNCTIONNAME(const First: ITRINTERFACENAME; Count: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME; + AEqualityComparator: EQUALITYCOMPAREFUNCTIONTYPENAME): ITRINTERFACENAME;OVERLOAD*) +(*$JPPDEFINEMACRO COUNTOBJECTINT(COUNTOBJECTFUNCTIONNAME, ITRINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, COMPAREFUNCTIONTYPENAME, TYPENAME, OVERLOAD) +function COUNTOBJECTFUNCTIONNAME(const First: ITRINTERFACENAME; Count: Integer; + CONSTKEYWORDPARAMETERNAME: TYPENAME; AComparator: COMPAREFUNCTIONTYPENAME): Integer;OVERLOAD*) +(*$JPPDEFINEMACRO COUNTOBJECTEQINT(COUNTOBJECTFUNCTIONNAME, ITRINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, EQUALITYCOMPAREFUNCTIONTYPENAME, TYPENAME, OVERLOAD) +function COUNTOBJECTFUNCTIONNAME(const First: ITRINTERFACENAME; Count: Integer; + CONSTKEYWORDPARAMETERNAME: TYPENAME; AEqualityComparator: EQUALITYCOMPAREFUNCTIONTYPENAME): Integer;OVERLOAD*) +(*$JPPDEFINEMACRO COPYINT(COPYPROCEDURENAME, ITRINTERFACENAME, OVERLOAD) +procedure COPYPROCEDURENAME(const First: ITRINTERFACENAME; Count: Integer; + const Output: ITRINTERFACENAME);OVERLOAD*) +(*$JPPDEFINEMACRO GENERATEINT(GENERATEPROCEDURENAME, LISTINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, OVERLOAD) +procedure GENERATEPROCEDURENAME(const List: LISTINTERFACENAME; Count: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME);OVERLOAD*) +(*$JPPDEFINEMACRO FILLINT(FILLPROCEDURENAME, ITRINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, OVERLOAD) +procedure FILLPROCEDURENAME(const First: ITRINTERFACENAME; Count: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME);OVERLOAD*) +(*$JPPDEFINEMACRO REVERSEINT(REVERSEPROCEDURENAME, ITRINTERFACENAME, OVERLOAD) +procedure REVERSEPROCEDURENAME(const First, Last: ITRINTERFACENAME);OVERLOAD*) +(*$JPPDEFINEMACRO SORTINT(SORTPROCEDURENAME, LISTINTERFACENAME, LEFT, RIGHT, COMPAREFUNCTIONTYPENAME, OVERLOAD) +procedure SORTPROCEDURENAME(const AList: LISTINTERFACENAME; LEFT, RIGHT: Integer; AComparator: COMPAREFUNCTIONTYPENAME);OVERLOAD*) +(*$JPPDEFINEMACRO QUICKSORTINT(QUICKSORTPROCEDURENAME, LISTINTERFACENAME, LEFT, RIGHT, COMPAREFUNCTIONTYPENAME, OVERLOAD) +procedure QUICKSORTPROCEDURENAME(const AList: LISTINTERFACENAME; LEFT, RIGHT: Integer; AComparator: COMPAREFUNCTIONTYPENAME);OVERLOAD*) \ No newline at end of file diff --git a/3rdParty/JCL/source/prototypes/containers/JclArrayLists.imp b/3rdParty/JCL/source/prototypes/containers/JclArrayLists.imp new file mode 100644 index 00000000..001e5798 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclArrayLists.imp @@ -0,0 +1,602 @@ +(*$JPPDEFINEMACRO JCLARRAYLISTITRIMP(SELFCLASSNAME, ITRINTERFACENAME, LISTCLASSNAME, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) +//=== { SELFCLASSNAME } =============================================================== + +constructor SELFCLASSNAME.Create(AOwnList: LISTCLASSNAME; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function SELFCLASSNAME.Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +begin + Result := FOwnList.Add(PARAMETERNAME); +end; + +procedure SELFCLASSNAME.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: SELFCLASSNAME; +begin + inherited AssignPropertiesTo(Dest); + if Dest is SELFCLASSNAME then + begin + ADest := SELFCLASSNAME(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function SELFCLASSNAME.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := SELFCLASSNAME.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure SELFCLASSNAME.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function SELFCLASSNAME.GETTERFUNCTIONNAME: TYPENAME; +begin + CheckValid; + Result := FOwnList.GETTERFUNCTIONNAME(FCursor); +end; + +function SELFCLASSNAME.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function SELFCLASSNAME.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function SELFCLASSNAME.Insert(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, PARAMETERNAME); +end; + +function SELFCLASSNAME.IteratorEquals(const AIterator: ITRINTERFACENAME): Boolean; +var + Obj: TObject; + ItrObj: SELFCLASSNAME; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is SELFCLASSNAME then + begin + ItrObj := SELFCLASSNAME(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function SELFCLASSNAME.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function SELFCLASSNAME.Next: TYPENAME; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GETTERFUNCTIONNAME(FCursor); +end; + +function SELFCLASSNAME.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function SELFCLASSNAME.Previous: TYPENAME; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GETTERFUNCTIONNAME(FCursor); +end; + +function SELFCLASSNAME.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure SELFCLASSNAME.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure SELFCLASSNAME.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure SELFCLASSNAME.SETTERPROCEDURENAME(CONSTKEYWORDPARAMETERNAME: TYPENAME); +begin + CheckValid; + FOwnList.SETTERPROCEDURENAME(FCursor, PARAMETERNAME); +end;*) +(*$JPPDEFINEMACRO JCLARRAYLISTIMP(SELFCLASSNAME, + OWNERSHIPDECLARATION, OWNERSHIPPARAMETERNAME, COLLECTIONINTERFACENAME, ITRINTERFACENAME, ITRCLASSNAME, LISTINTERFACENAME, MOVEARRAYPROCEDURENAME, + CONSTKEYWORD, PARAMETERNAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME, RELEASERFUNCTIONNAME, TYPENAME, DEFAULTVALUE) +//=== { SELFCLASSNAME } ====================================================== + +constructor SELFCLASSNAME.Create(ACapacity: IntegerOWNERSHIPDECLARATION); +begin + inherited Create(OWNERSHIPPARAMETERNAME); + SetCapacity(ACapacity); +end; + +constructor SELFCLASSNAME.Create(const ACollection: COLLECTIONINTERFACENAMEOWNERSHIPDECLARATION); +begin + inherited Create(OWNERSHIPPARAMETERNAME); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor SELFCLASSNAME.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function SELFCLASSNAME.Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + Index: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := FAllowDefaultElements or not ItemsEqual(PARAMETERNAME, DEFAULTVALUE); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(PARAMETERNAME, FElementData[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElementData[FSize] := PARAMETERNAME; + Inc(FSize); + end; + end; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.AddAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: ITRINTERFACENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: SELFCLASSNAME; + ACollection: COLLECTIONINTERFACENAME; +begin + inherited AssignDataTo(Dest); + if Dest is SELFCLASSNAME then + begin + ADest := SELFCLASSNAME(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), COLLECTIONINTERFACENAME, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure SELFCLASSNAME.Clear; +var + I: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + for I := 0 to FSize - 1 do + RELEASERFUNCTIONNAME(FElementData[I]); + FSize := 0; + AutoPack; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.CollectionEquals(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + I: Integer; + It: ITRINTERFACENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FElementData[I], It.Next) then + Exit; + Result := True; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Contains(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + I: Integer; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], PARAMETERNAME) then + begin + Result := True; + Break; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.ContainsAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: ITRINTERFACENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Delete(Index: Integer): TYPENAME; +var + Extracted: TYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Extracted := ExtractIndex(Index); + Result := RELEASERFUNCTIONNAME(Extracted); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Extract(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + I: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], PARAMETERNAME) then + begin + if I < (FSize - 1) then + MOVEARRAYPROCEDURENAME(FElementData, I + 1, I, FSize - 1 - I) + else + FElementData[I] := DEFAULTVALUE; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.ExtractAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: ITRINTERFACENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.ExtractIndex(Index: Integer): TYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + if (Index >= 0) and (Index < FSize) then + begin + Result := FElementData[Index]; + if Index < (FSize - 1) then + MOVEARRAYPROCEDURENAME(FElementData, Index + 1, Index, FSize - 1 - Index) + else + FElementData[Index] := DEFAULTVALUE; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.First: ITRINTERFACENAME; +begin + Result := ITRCLASSNAME.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function SELFCLASSNAME.GetEnumerator: ITRINTERFACENAME; +begin + Result := ITRCLASSNAME.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function SELFCLASSNAME.GETTERFUNCTIONNAME(Index: Integer): TYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := DEFAULTVALUE; + if (Index >= 0) and (Index < FSize) then + Result := FElementData[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.IndexOf(CONSTKEYWORDPARAMETERNAME: TYPENAME): Integer; +var + I: Integer; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], PARAMETERNAME) then + begin + Result := I; + Break; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Insert(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + I: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := FAllowDefaultElements or not ItemsEqual(PARAMETERNAME, DEFAULTVALUE); + + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(PARAMETERNAME, FElementData[I]) then + begin + Result := CheckDuplicate; + Break; + end; + + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MOVEARRAYPROCEDURENAME(FElementData, Index, Index + 1, FSize - Index); + FElementData[Index] := PARAMETERNAME; + Inc(FSize); + end; + end; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.InsertAll(Index: Integer; const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: ITRINTERFACENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function SELFCLASSNAME.Last: ITRINTERFACENAME; +begin + Result := ITRCLASSNAME.Create(Self, FSize - 1, False, isLast); +end; + +function SELFCLASSNAME.LastIndexOf(CONSTKEYWORDPARAMETERNAME: TYPENAME): Integer; +var + I: Integer; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FElementData[I], PARAMETERNAME) then + begin + Result := I; + Break; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.RaiseOutOfBoundsError: TYPENAME; +begin + raise EJclOutOfBoundsError.Create; +end; + +function SELFCLASSNAME.Remove(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + Extracted: TYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := Extract(PARAMETERNAME); + if Result then + begin + Extracted := PARAMETERNAME; + RELEASERFUNCTIONNAME(Extracted); + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.RemoveAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: ITRINTERFACENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.RetainAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + I: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FElementData[I]) then + Delete(I); + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.SetCapacity(Value: Integer); +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + if Value >= FSize then + begin + SetLength(FElementData, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.SETTERPROCEDURENAME(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME); +var + ReplaceItem: Boolean; + I: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(PARAMETERNAME, DEFAULTVALUE); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(FElementData[I], PARAMETERNAME) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + RELEASERFUNCTIONNAME(FElementData[Index]); + FElementData[Index] := PARAMETERNAME; + end; + end; + if not ReplaceItem then + Delete(Index); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Size: Integer; +begin + Result := FSize; +end; + +function SELFCLASSNAME.SubList(First, Count: Integer): LISTINTERFACENAME; +var + I: Integer; + Last: Integer; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as LISTINTERFACENAME; + for I := First to Last do + Result.Add(FElementData[I]); + {$JPPEXPANDMACRO UNLOCK} +end;*) diff --git a/3rdParty/JCL/source/prototypes/containers/JclArrayLists.int b/3rdParty/JCL/source/prototypes/containers/JclArrayLists.int new file mode 100644 index 00000000..e6df1aec --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclArrayLists.int @@ -0,0 +1,82 @@ +(*$JPPDEFINEMACRO JCLARRAYLISTINT(SELFCLASSNAME, ANCESTORCLASSNAME, + BASECONTAINERINTERFACENAME, FLATCONTAINERINTERFACENAME, COLLECTIONINTERFACENAME, LISTINTERFACENAME, ARRAYINTERFACENAME, ITRINTERFACENAME, + DYNARRAYTYPE, EQUALITYCOMPARERINTERFACENAME, INTERFACEADDITIONAL, SECTIONADDITIONAL, COLLECTIONFLAGS, OWNERSHIPDECLARATION, CONSTKEYWORD, PARAMETERNAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) +SELFCLASSNAME = class(ANCESTORCLASSNAME, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, EQUALITYCOMPARERINTERFACENAME, BASECONTAINERINTERFACENAME, FLATCONTAINERINTERFACENAME,INTERFACEADDITIONAL + COLLECTIONINTERFACENAME, LISTINTERFACENAME, ARRAYINTERFACENAME)SECTIONADDITIONAL +private + FElementData: DYNARRAYTYPE; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: TYPENAME; +protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; +public + constructor Create(ACapacity: IntegerOWNERSHIPDECLARATION); overload; + constructor Create(const ACollection: COLLECTIONINTERFACENAMEOWNERSHIPDECLARATION); overload; + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { COLLECTIONINTERFACENAME } + function Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean;COLLECTIONFLAGS + function AddAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + procedure Clear;COLLECTIONFLAGS + function Contains(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean;COLLECTIONFLAGS + function ContainsAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function CollectionEquals(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function Extract(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean;COLLECTIONFLAGS + function ExtractAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function First: ITRINTERFACENAME;COLLECTIONFLAGS + function IsEmpty: Boolean;COLLECTIONFLAGS + function Last: ITRINTERFACENAME;COLLECTIONFLAGS + function Remove(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean;COLLECTIONFLAGS + function RemoveAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function RetainAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function Size: Integer;COLLECTIONFLAGS + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: ITRINTERFACENAME;COLLECTIONFLAGS + {$ENDIF SUPPORTS_FOR_IN} + { LISTINTERFACENAME } + function Delete(Index: Integer): TYPENAME; + function ExtractIndex(Index: Integer): TYPENAME; + function GETTERFUNCTIONNAME(Index: Integer): TYPENAME; + function IndexOf(CONSTKEYWORDPARAMETERNAME: TYPENAME): Integer; + function Insert(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function InsertAll(Index: Integer; const ACollection: COLLECTIONINTERFACENAME): Boolean; + function LastIndexOf(CONSTKEYWORDPARAMETERNAME: TYPENAME): Integer; + procedure SETTERPROCEDURENAME(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME); + function SubList(First, Count: Integer): LISTINTERFACENAME; +end;*) +(*$JPPDEFINEMACRO JCLARRAYLISTITRINT(SELFCLASSNAME, ITRINTERFACENAME, LISTCLASSNAME, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) +SELFCLASSNAME = class(TJclAbstractIterator, ITRINTERFACENAME, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) +private + FCursor: Integer; + FStart: TItrStart; + FOwnList: LISTCLASSNAME; +protected + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; +public + constructor Create(AOwnList: LISTCLASSNAME; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { ITRINTERFACENAME } + function Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + procedure Extract; + function GETTERFUNCTIONNAME: TYPENAME; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function IteratorEquals(const AIterator: ITRINTERFACENAME): Boolean; + function Next: TYPENAME; + function NextIndex: Integer; + function Previous: TYPENAME; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SETTERPROCEDURENAME(CONSTKEYWORDPARAMETERNAME: TYPENAME); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: TYPENAME read GETTERFUNCTIONNAME; + {$ENDIF SUPPORTS_FOR_IN} +end;*) diff --git a/3rdParty/JCL/source/prototypes/containers/JclArraySets.imp b/3rdParty/JCL/source/prototypes/containers/JclArraySets.imp new file mode 100644 index 00000000..332d7a43 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclArraySets.imp @@ -0,0 +1,96 @@ +(*$JPPDEFINEMACRO JCLARRAYSETIMP(SELFCLASSNAME, COLLECTIONINTERFACENAME, ITRINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, GETTERFUNCTIONNAME) +//=== { SELFCLASSNAME } ==================================================== + +function SELFCLASSNAME.Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + Idx: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := FAllowDefaultElements or not ItemsEqual(PARAMETERNAME, DEFAULTVALUE); + if Result then + begin + Idx := BinarySearch(PARAMETERNAME); + if Idx >= 0 then + Result := not ItemsEqual(GETTERFUNCTIONNAME(Idx), PARAMETERNAME) or CheckDuplicate + else + Result := True; + if Result then + Result := inherited Insert(Idx + 1, PARAMETERNAME); + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.AddAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: ITRINTERFACENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.BinarySearch(CONSTKEYWORDPARAMETERNAME: TYPENAME): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + LoPos := 0; + HiPos := Size - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := ItemsCompare(GETTERFUNCTIONNAME(CompPos), PARAMETERNAME); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Contains(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + Idx: Integer; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Idx := BinarySearch(PARAMETERNAME); + if Idx >= 0 then + Result := ItemsEqual(GETTERFUNCTIONNAME(Idx), PARAMETERNAME) + else + Result := False; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Insert(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure SELFCLASSNAME.Intersect(const ACollection: COLLECTIONINTERFACENAME); +begin + RetainAll(ACollection); +end; + +procedure SELFCLASSNAME.Subtract(const ACollection: COLLECTIONINTERFACENAME); +begin + RemoveAll(ACollection); +end; + +procedure SELFCLASSNAME.Union(const ACollection: COLLECTIONINTERFACENAME); +begin + AddAll(ACollection); +end;*) \ No newline at end of file diff --git a/3rdParty/JCL/source/prototypes/containers/JclArraySets.int b/3rdParty/JCL/source/prototypes/containers/JclArraySets.int new file mode 100644 index 00000000..11018171 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclArraySets.int @@ -0,0 +1,23 @@ +(*$JPPDEFINEMACRO JCLARRAYSETINT(SELFCLASSNAME, ANCESTORCLASSNAME, + BASECONTAINERINTERFACENAME, FLATCONTAINERINTERFACENAME, + COLLECTIONINTERFACENAME, LISTINTERFACENAME, ARRAYINTERFACENAME, SETINTERFACENAME, + EQUALITYCOMPARERINTERFACENAME, COMPARERINTERFACENAME, INTERFACEADDITIONAL, + SECTIONADDITIONAL, COLLECTIONFLAGS, CONSTKEYWORD, PARAMETERNAME, TYPENAME) +SELFCLASSNAME = class(ANCESTORCLASSNAME, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + BASECONTAINERINTERFACENAME, FLATCONTAINERINTERFACENAME, EQUALITYCOMPARERINTERFACENAME, COMPARERINTERFACENAME,INTERFACEADDITIONAL + COLLECTIONINTERFACENAME, LISTINTERFACENAME, ARRAYINTERFACENAME, SETINTERFACENAME)SECTIONADDITIONAL +private + function BinarySearch(CONSTKEYWORDPARAMETERNAME: TYPENAME): Integer; +public + { COLLECTIONINTERFACENAME } + function Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean;COLLECTIONFLAGS + function AddAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function Contains(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean;COLLECTIONFLAGS + { LISTINTERFACENAME } + function Insert(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + { SETINTERFACENAME } + procedure Intersect(const ACollection: COLLECTIONINTERFACENAME); + procedure Subtract(const ACollection: COLLECTIONINTERFACENAME); + procedure Union(const ACollection: COLLECTIONINTERFACENAME); +end;*) diff --git a/3rdParty/JCL/source/prototypes/containers/JclBinaryTrees.imp b/3rdParty/JCL/source/prototypes/containers/JclBinaryTrees.imp new file mode 100644 index 00000000..55376d36 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclBinaryTrees.imp @@ -0,0 +1,1194 @@ +(*$JPPDEFINEMACRO JCLBINARYTREEITRIMP(BASEITRCLASSNAME, PREORDERITRCLASSNAME, INORDERITRCLASSNAME, POSTORDERITRCLASSNAME, + STDITRINTERFACENAME, TREECLASSNAME, EQUALITYCOMPARERINTERFACENAME, + NODETYPENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, GETTERFUNCTIONNAME, SETTERPROCEDURENAME, RELEASERFUNCTIONNAME) +//=== { BASEITRCLASSNAME } =========================================================== + +constructor BASEITRCLASSNAME.Create(const AOwnTree: TREECLASSNAME; ACursor: NODETYPENAME; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FStart := AStart; + FOwnTree := AOwnTree; + FEqualityComparer := AOwnTree as EQUALITYCOMPARERINTERFACENAME; +end; + +function BASEITRCLASSNAME.Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +begin + Result := FOwnTree.Add(PARAMETERNAME); +end; + +function BASEITRCLASSNAME.AddChild(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure BASEITRCLASSNAME.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: BASEITRCLASSNAME; +begin + inherited AssignPropertiesTo(Dest); + if Dest is BASEITRCLASSNAME then + begin + ADest := BASEITRCLASSNAME(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function BASEITRCLASSNAME.ChildrenCount: Integer; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + Result := 0; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + Inc(Result); + if FCursor.Right <> nil then + Inc(Result); + end; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +procedure BASEITRCLASSNAME.DeleteChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure BASEITRCLASSNAME.DeleteChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure BASEITRCLASSNAME.Extract; +var + OldCursor: NODETYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Extract(OldCursor.Value); + end; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +procedure BASEITRCLASSNAME.ExtractChild(Index: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure BASEITRCLASSNAME.ExtractChildren; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function BASEITRCLASSNAME.GetChild(Index: Integer): TYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + Result := DEFAULTVALUE; + if (FCursor <> nil) and (Index = 0) and (FCursor.Left <> nil) then + FCursor := FCursor.Left + else + if (FCursor <> nil) and (Index = 0) then + FCursor := FCursor.Right + else + if (FCursor <> nil) and (Index = 1) then + FCursor := FCursor.Right + else + FCursor := nil; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.GETTERFUNCTIONNAME: TYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + CheckValid; + Result := DEFAULTVALUE; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.HasChild(Index: Integer): Boolean; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + if (FCursor <> nil) and (Index = 0) then + Result := (FCursor.Left <> nil) or (FCursor.Right <> nil) + else + if (FCursor <> nil) and (Index = 1) then + Result := (FCursor.Left <> nil) and (FCursor.Right <> nil) + else + Result := False; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.HasLeft: Boolean; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + Result := (FCursor <> nil) and (FCursor.Left <> nil); + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.HasNext: Boolean; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.HasParent: Boolean; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.HasPrevious: Boolean; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.HasRight: Boolean; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + Result := (FCursor <> nil) and (FCursor.Right <> nil); + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.IndexOfChild(CONSTKEYWORDPARAMETERNAME: TYPENAME): Integer; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + Result := -1; + if FCursor <> nil then + begin + if FCursor.Left <> nil then + begin + if FEqualityComparer.ItemsEqual(FCursor.Left.Value, PARAMETERNAME) then + Result := 0 + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, PARAMETERNAME) then + Result := 1; + end + else + if (FCursor.Right <> nil) and FEqualityComparer.ItemsEqual(FCursor.Right.Value, PARAMETERNAME) then + Result := 0; + end; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.Insert(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function BASEITRCLASSNAME.InsertChild(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function BASEITRCLASSNAME.IteratorEquals(const AIterator: STDITRINTERFACENAME): Boolean; +var + Obj: TObject; + ItrObj: BASEITRCLASSNAME; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is BASEITRCLASSNAME then + begin + ItrObj := BASEITRCLASSNAME(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +function BASEITRCLASSNAME.Left: TYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + Result := DEFAULTVALUE; + if FCursor <> nil then + FCursor := FCursor.Left; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function BASEITRCLASSNAME.MoveNext: Boolean; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function BASEITRCLASSNAME.Next: TYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := DEFAULTVALUE; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function BASEITRCLASSNAME.Parent: TYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + Result := DEFAULTVALUE; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.Previous: TYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := DEFAULTVALUE; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure BASEITRCLASSNAME.Remove; +var + OldCursor: NODETYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + CheckValid; + Valid := False; + OldCursor := FCursor; + if OldCursor <> nil then + begin + repeat + FCursor := GetNextCursor; + until (FCursor = nil) or FOwnTree.RemoveSingleElement + or (not FEqualityComparer.ItemsEqual(OldCursor.Value, FCursor.Value)); + FOwnTree.Remove(OldCursor.Value); + end; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +procedure BASEITRCLASSNAME.Reset; +var + NewCursor: NODETYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.Right: TYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + Result := DEFAULTVALUE; + if FCursor <> nil then + FCursor := FCursor.Right; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +procedure BASEITRCLASSNAME.SetChild(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure BASEITRCLASSNAME.SETTERPROCEDURENAME(CONSTKEYWORDPARAMETERNAME: TYPENAME); +begin + raise EJclOperationNotSupportedError.Create; +end; + +//=== { PREORDERITRCLASSNAME } =================================================== + +function PREORDERITRCLASSNAME.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := PREORDERITRCLASSNAME.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function PREORDERITRCLASSNAME.GetNextCursor: NODETYPENAME; +var + LastRet: NODETYPENAME; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.Left <> nil then + Result := Result.Left + else + if Result.Right <> nil then + Result := Result.Right + else + begin + Result := Result.Parent; + while (Result <> nil) and ((Result.Right = nil) or (Result.Right = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Right; + end; +end; + +function PREORDERITRCLASSNAME.GetPreviousCursor: NODETYPENAME; +var + LastRet: NODETYPENAME; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Left <> LastRet) and (Result.Left <> nil) then + // come from Right + begin + Result := Result.Left; + while (Result.Left <> nil) or (Result.Right <> nil) do // both childs + begin + if Result.Right <> nil then // right child first + Result := Result.Right + else + Result := Result.Left; + end; + end; +end; + +//=== { INORDERITRCLASSNAME } ==================================================== + +function INORDERITRCLASSNAME.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := INORDERITRCLASSNAME.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function INORDERITRCLASSNAME.GetNextCursor: NODETYPENAME; +var + LastRet: NODETYPENAME; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + begin + Result := Result.Right; + while (Result.Left <> nil) do + Result := Result.Left; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right = LastRet) do + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +function INORDERITRCLASSNAME.GetPreviousCursor: NODETYPENAME; +var + LastRet: NODETYPENAME; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Left <> nil then + begin + Result := Result.Left; + while Result.Right <> nil do + Result := Result.Right; + end + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.Right <> LastRet) do // Come from Left + begin + LastRet := Result; + Result := Result.Parent; + end; + end; +end; + +//=== { POSTORDERITRCLASSNAME } ================================================== + +function POSTORDERITRCLASSNAME.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := POSTORDERITRCLASSNAME.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function POSTORDERITRCLASSNAME.GetNextCursor: NODETYPENAME; +var + LastRet: NODETYPENAME; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.Right <> nil) and (Result.Right <> LastRet) then + begin + Result := Result.Right; + while (Result.Left <> nil) or (Result.Right <> nil) do + begin + if Result.Left <> nil then + Result := Result.Left + else + Result := Result.Right; + end; + end; +end; + +function POSTORDERITRCLASSNAME.GetPreviousCursor: NODETYPENAME; +var + LastRet: NODETYPENAME; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.Right <> nil then + Result := Result.Right + else + if Result.Left <> nil then + Result := Result.Left + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and ((Result.Left = nil) or (Result.Left = LastRet)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := Result.Left; + end; +end;*) +(*$JPPDEFINEMACRO JCLBINARYTREEIMP(SELFCLASSNAME, NODETYPENAME, PREORDERITRCLASSNAME, INORDERITRCLASSNAME, POSTORDERITRCLASSNAME, + COLLECTIONINTERFACENAME, STDITRINTERFACENAME, TREEITRINTERFACENAME, + CONSTRUCTORDECLARATIONS, CONSTRUCTORASSIGNMENTS, OWNERSHIPDECLARATION, OWNERSHIPPARAMETERNAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, RELEASERFUNCTIONNAME) +//=== { SELFCLASSNAME } ================================================= + +constructor SELFCLASSNAME.Create(CONSTRUCTORDECLARATIONSOWNERSHIPDECLARATION); +begin + inherited Create(OWNERSHIPPARAMETERNAME); + FTraverseOrder := toOrder; + FMaxDepth := 0; + FAutoPackParameter := 2;CONSTRUCTORASSIGNMENTS +end; + +destructor SELFCLASSNAME.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function SELFCLASSNAME.Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + NewNode, Current, Save: NODETYPENAME; + Comp, Depth: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + // Insert into right place + if FAllowDefaultElements or not ItemsEqual(PARAMETERNAME, DEFAULTVALUE) then + begin + Save := nil; + Current := FRoot; + Comp := 1; + Depth := 0; + while Current <> nil do + begin + Inc(Depth); + Save := Current; + Comp := ItemsCompare(PARAMETERNAME, Current.Value); + if Comp < 0 then + Current := Current.Left + else + if Comp > 0 then + Current := Current.Right + else + if CheckDuplicate then + Current := Current.Left // arbitrary decision + else + Break; + end; + if (Comp <> 0) or CheckDuplicate then + begin + NewNode := NODETYPENAME.Create; + NewNode.Value := PARAMETERNAME; + NewNode.Parent := Save; + if Save = nil then + FRoot := NewNode + else + if ItemsCompare(NewNode.Value, Save.Value) <= 0 then + Save.Left := NewNode + else + Save.Right := NewNode; + Inc(FSize); + Inc(Depth); + if Depth > FMaxDepth then + FMaxDepth := Depth; + Result := True; + AutoPack; + end + else + Result := False; + end + else + Result := False; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.AddAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: STDITRINTERFACENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: SELFCLASSNAME; + ACollection: COLLECTIONINTERFACENAME; +begin + inherited AssignDataTo(Dest); + if Dest is SELFCLASSNAME then + begin + ADest := SELFCLASSNAME(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), COLLECTIONINTERFACENAME, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure SELFCLASSNAME.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is SELFCLASSNAME then + SELFCLASSNAME(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure SELFCLASSNAME.AutoPack; +begin + case FAutoPackStrategy of + //apsDisabled: ; + apsAgressive: + if (FMaxDepth > 1) and (((1 shl (FMaxDepth - 1)) - 1) > FSize) then + Pack; + // apsIncremental: ; + apsProportional: + if (FMaxDepth > FAutoPackParameter) and (((1 shl (FMaxDepth - FAutoPackParameter)) - 1) > FSize) then + Pack; + end; +end; + +function SELFCLASSNAME.BuildTree(const LeafArray: array of NODETYPENAME; Left, Right: Integer; Parent: NODETYPENAME; + Offset: Integer): NODETYPENAME; +var + Middle: Integer; +begin + Middle := (Left + Right + Offset) shr 1; + Result := LeafArray[Middle]; + Result.Parent := Parent; + if Middle > Left then + Result.Left := BuildTree(LeafArray, Left, Middle - 1, Result, 0) + else + Result.Left := nil; + if Middle < Right then + Result.Right := BuildTree(LeafArray, Middle + 1, Right, Result, 1) + else + Result.Right := nil; +end; + +procedure SELFCLASSNAME.Clear; +var + Current, Parent: NODETYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + // postorder + Current := FRoot; + if Current = nil then + Exit; + // find first in post-order + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + // for all items in the tree in post-order + repeat + Parent := Current.Parent; + // remove reference + if Parent <> nil then + begin + if Parent.Left = Current then + Parent.Left := nil + else + if Parent.Right = Current then + Parent.Right := nil; + end; + + // free item + RELEASERFUNCTIONNAME(Current.Value); + Current.Free; + + // find next item + Current := Parent; + if (Current <> nil) and (Current.Right <> nil) then + begin + Current := Current.Right; + while (Current.Left <> nil) or (Current.Right <> nil) do + begin + if Current.Left <> nil then + Current := Current.Left + else + Current := Current.Right; + end; + end; + until Current = nil; + FRoot := nil; + FSize := 0; + FMaxDepth := 0; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.CloneNode(Node, Parent: NODETYPENAME): NODETYPENAME; +begin + Result := NODETYPENAME.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + if Node.Left <> nil then + Result.Left := CloneNode(Node.Left, Result); // recursive call + if Node.Right <> nil then + Result.Right := CloneNode(Node.Right, Result); // recursive call +end; + +function SELFCLASSNAME.CollectionEquals(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It, ItSelf: STDITRINTERFACENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Contains(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + Comp: Integer; + Current: NODETYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + Current := FRoot; + while Current <> nil do + begin + Comp := ItemsCompare(Current.Value, PARAMETERNAME); + if Comp = 0 then + begin + Result := True; + Break; + end + else + if Comp > 0 then + Current := Current.Left + else + Current := Current.Right; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.ContainsAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: STDITRINTERFACENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Extract(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + Current, Successor: NODETYPENAME; + Comp: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + // locate PARAMETERNAME in the tree + Current := FRoot; + repeat + while Current <> nil do + begin + Comp := ItemsCompare(PARAMETERNAME, Current.Value); + if Comp = 0 then + Break + else + if Comp < 0 then + Current := Current.Left + else + Current := Current.Right; + end; + if Current = nil then + Break; + Result := True; + // Remove Current from tree + if (Current.Left = nil) and (Current.Right <> nil) then + begin + // remove references to Current + Current.Right.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Right + else + Current.Parent.Right := Current.Right; + end + else + // fix root + FRoot := Current.Right; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right = nil) then + begin + // remove references to Current + Current.Left.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Current.Left + else + Current.Parent.Right := Current.Left; + end + else + // fix root + FRoot := Current.Left; + Successor := Current.Parent; + if Successor = nil then + Successor := FRoot; + end + else + if (Current.Left <> nil) and (Current.Right <> nil) then + begin + // find the successor in tree + Successor := Current.Right; + while Successor.Left <> nil do + Successor := Successor.Left; + + if Successor <> Current.Right then + begin + // remove references to successor + Successor.Parent.Left := Successor.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor.Parent; + Successor.Right := Current.Right; + if Successor.Right <> nil then + Successor.Right.Parent := Successor; + end; + + // insert successor in new position + Successor.Left := Current.Left; + if Current.Left <> nil then + Current.Left.Parent := Successor; + Successor.Parent := Current.Parent; + if Current.Parent <> nil then + begin + if Current.Parent.Left = Current then + Current.Parent.Left := Successor + else + Current.Parent.Right := Successor; + end + else + // fix root + FRoot := Successor; + Successor := Current.Parent; + if Successor <> nil then + Successor := FRoot; + end + else + begin + // (Current.Left = nil) and (Current.Right = nil) + Successor := Current.Parent; + if Successor <> nil then + begin + // remove references from parent + if Successor.Left = Current then + Successor.Left := nil + else + Successor.Right := nil; + end + else + FRoot := nil; + end; + Current.Value := DEFAULTVALUE; + Current.Free; + Dec(FSize); + Current := Successor; + until FRemoveSingleElement or (Current = nil); + AutoPack; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.ExtractAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: STDITRINTERFACENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.First: STDITRINTERFACENAME; +var + Start: NODETYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := PREORDERITRCLASSNAME.Create(Self, Start, False, isFirst); + toOrder: + begin + if Start <> nil then + while Start.Left <> nil do + Start := Start.Left; + Result := INORDERITRCLASSNAME.Create(Self, Start, False, isFirst); + end; + toPostOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Left <> nil then + Start := Start.Left + else + Start := Start.Right; + end; + Result := POSTORDERITRCLASSNAME.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function SELFCLASSNAME.GetEnumerator: STDITRINTERFACENAME; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function SELFCLASSNAME.GetRoot: TREEITRINTERFACENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + case GetTraverseOrder of + toPreOrder: + Result := PREORDERITRCLASSNAME.Create(Self, FRoot, False, isRoot); + toOrder: + Result := INORDERITRCLASSNAME.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := POSTORDERITRCLASSNAME.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function SELFCLASSNAME.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function SELFCLASSNAME.Last: STDITRINTERFACENAME; +var + Start: NODETYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while (Start.Left <> nil) or (Start.Right <> nil) do + begin + if Start.Right <> nil then + Start := Start.Right + else + Start := Start.Left; + end; + Result := PREORDERITRCLASSNAME.Create(Self, Start, False, isLast); + end; + toOrder: + begin + if Start <> nil then + while Start.Right <> nil do + Start := Start.Right; + Result := INORDERITRCLASSNAME.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := POSTORDERITRCLASSNAME.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.Pack; +var + LeafArray: array of NODETYPENAME; + ANode, BNode: NODETYPENAME; + Index: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + SetLength(Leafarray, FSize); + try + // in order enumeration of nodes + ANode := FRoot; + if ANode <> nil then + begin + // find first node + while ANode.Left <> nil do + ANode := ANode.Left; + + Index := 0; + while ANode <> nil do + begin + LeafArray[Index] := ANode; + Inc(Index); + if ANode.Right <> nil then + begin + ANode := ANode.Right; + while (ANode.Left <> nil) do + ANode := ANode.Left; + end + else + begin + BNode := ANode; + ANode := ANode.Parent; + while (ANode <> nil) and (ANode.Right = BNode) do + begin + BNode := ANode; + ANode := ANode.Parent; + end; + end; + end; + + Index := FSize shr 1; + FRoot := LeafArray[Index]; + FRoot.Parent := nil; + if Index > 0 then + FRoot.Left := BuildTree(LeafArray, 0, Index - 1, FRoot, 0) + else + FRoot.Left := nil; + if Index < (FSize - 1) then + FRoot.Right := BuildTree(LeafArray, Index + 1, FSize - 1, FRoot, 1) + else + FRoot.Right := nil; + end; + finally + SetLength(LeafArray, 0); + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Remove(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + Extracted: TYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := Extract(PARAMETERNAME); + if Result then + begin + Extracted := PARAMETERNAME; + RELEASERFUNCTIONNAME(Extracted); + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.RemoveAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: STDITRINTERFACENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.RetainAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: STDITRINTERFACENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure SELFCLASSNAME.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function SELFCLASSNAME.Size: Integer; +begin + Result := FSize; +end;*) \ No newline at end of file diff --git a/3rdParty/JCL/source/prototypes/containers/JclBinaryTrees.int b/3rdParty/JCL/source/prototypes/containers/JclBinaryTrees.int new file mode 100644 index 00000000..303cfd4b --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclBinaryTrees.int @@ -0,0 +1,138 @@ +(*$JPPDEFINEMACRO JCLBINARYTREETYPESINT(NODETYPENAME, TYPENAME) +NODETYPENAME = class +public + Value: TYPENAME; + Left: NODETYPENAME; + Right: NODETYPENAME; + Parent: NODETYPENAME; +end;*) +(*$JPPDEFINEMACRO JCLBINARYTREEINT(NODETYPENAME, SELFCLASSNAME, ANCESTORCLASSNAME, + BASECONTAINERINTERFACENAME, FLATCONTAINERINTERFACENAME, + COLLECTIONINTERFACENAME, TREEINTERFACENAME, STDITRINTERFACENAME, TREEITRINTERFACENAME, + EQUALITYCOMPARERINTERFACENAME, COMPARERINTERFACENAME, INTERFACEADDITIONAL, + SECTIONADDITIONAL, CONSTRUCTORDECLARATIONS, OWNERSHIPDECLARATION, COLLECTIONFLAGS, + CONSTKEYWORD, PARAMETERNAME, TYPENAME) +SELFCLASSNAME = class(ANCESTORCLASSNAME, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclBaseContainer, + EQUALITYCOMPARERINTERFACENAME, COMPARERINTERFACENAME, BASECONTAINERINTERFACENAME, FLATCONTAINERINTERFACENAME,INTERFACEADDITIONAL + COLLECTIONINTERFACENAME, TREEINTERFACENAME)SECTIONADDITIONAL +private + FMaxDepth: Integer; + FRoot: NODETYPENAME; + FTraverseOrder: TJclTraverseOrder; + function BuildTree(const LeafArray: array of NODETYPENAME; Left, Right: Integer; Parent: NODETYPENAME; + Offset: Integer): NODETYPENAME; + function CloneNode(Node, Parent: NODETYPENAME): NODETYPENAME; +protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; + procedure AutoPack; override; +public + constructor Create(CONSTRUCTORDECLARATIONSOWNERSHIPDECLARATION); + destructor Destroy; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { COLLECTIONINTERFACENAME } + function Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean;COLLECTIONFLAGS + function AddAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + procedure Clear;COLLECTIONFLAGS + function Contains(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean;COLLECTIONFLAGS + function ContainsAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function CollectionEquals(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function Extract(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean;COLLECTIONFLAGS + function ExtractAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function First: STDITRINTERFACENAME;COLLECTIONFLAGS + function IsEmpty: Boolean;COLLECTIONFLAGS + function Last: STDITRINTERFACENAME;COLLECTIONFLAGS + function Remove(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean;COLLECTIONFLAGS + function RemoveAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function RetainAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function Size: Integer;COLLECTIONFLAGS + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: STDITRINTERFACENAME;COLLECTIONFLAGS + {$ENDIF SUPPORTS_FOR_IN} + { TREEINTERFACENAME } + function GetRoot: TREEITRINTERFACENAME; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: TREEITRINTERFACENAME read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; +end;*) +(*$JPPDEFINEMACRO JCLBINARYTREEITRINT(BASEITRCLASSNAME, PREORDERITRCLASSNAME, INORDERITRCLASSNAME, POSTORDERITRCLASSNAME, + STDITRINTERFACENAME, STDTREEITRINTERFACENAME, BINTREEITRINTERFACENAME, TREECLASSNAME, EQUALITYCOMPARERINTERFACENAME, + NODETYPENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) +BASEITRCLASSNAME = class(TJclAbstractIterator, STDITRINTERFACENAME, STDTREEITRINTERFACENAME, BINTREEITRINTERFACENAME) +protected + FCursor: NODETYPENAME; + FStart: TItrStart; + FOwnTree: TREECLASSNAME; + FEqualityComparer: EQUALITYCOMPARERINTERFACENAME; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function GetNextCursor: NODETYPENAME; virtual; abstract; + function GetPreviousCursor: NODETYPENAME; virtual; abstract; +public + constructor Create(const AOwnTree: TREECLASSNAME; ACursor: NODETYPENAME; AValid: Boolean; AStart: TItrStart); + { STDITRINTERFACENAME } + function Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + procedure Extract; + function GETTERFUNCTIONNAME: TYPENAME; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function IteratorEquals(const AIterator: STDITRINTERFACENAME): Boolean; + function Next: TYPENAME; + function NextIndex: Integer; + function Previous: TYPENAME; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SETTERPROCEDURENAME(CONSTKEYWORDPARAMETERNAME: TYPENAME); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: TYPENAME read GETTERFUNCTIONNAME; + {$ENDIF SUPPORTS_FOR_IN} + { STDTREEITRINTERFACENAME } + function AddChild(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): TYPENAME; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(CONSTKEYWORDPARAMETERNAME: TYPENAME): Integer; + function InsertChild(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function Parent: TYPENAME; + procedure SetChild(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME); + { BINTREEITRINTERFACENAME } + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: TYPENAME; + function Right: TYPENAME; +end; + +PREORDERITRCLASSNAME = class(BASEITRCLASSNAME, STDITRINTERFACENAME, STDTREEITRINTERFACENAME, BINTREEITRINTERFACENAME, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) +protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: NODETYPENAME; override; + function GetPreviousCursor: NODETYPENAME; override; +end; + +INORDERITRCLASSNAME = class(BASEITRCLASSNAME, STDITRINTERFACENAME, STDTREEITRINTERFACENAME, BINTREEITRINTERFACENAME, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) +protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: NODETYPENAME; override; + function GetPreviousCursor: NODETYPENAME; override; +end; + +POSTORDERITRCLASSNAME = class(BASEITRCLASSNAME, STDITRINTERFACENAME, STDTREEITRINTERFACENAME, BINTREEITRINTERFACENAME, + {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} IJclIntfCloneable, IJclCloneable) +protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: NODETYPENAME; override; + function GetPreviousCursor: NODETYPENAME; override; +end;*) diff --git a/3rdParty/JCL/source/prototypes/containers/JclContainerCommon.imp b/3rdParty/JCL/source/prototypes/containers/JclContainerCommon.imp new file mode 100644 index 00000000..f2cc1d93 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclContainerCommon.imp @@ -0,0 +1,60 @@ +(*$JPPDEFINEMACRO LOCK +{$IFDEF WRITE} +if ReadOnly then + raise EJclReadOnlyError.Create; +{$IFDEF THREADSAFE} +if FThreadSafe then + SyncReaderWriter.BeginWrite; +try +{$ENDIF THREADSAFE} +{$ELSE ~WRITE} +{$IFDEF THREADSAFE} +if FThreadSafe then + SyncReaderWriter.BeginRead; +try +{$ENDIF THREADSAFE} +{$ENDIF ~WRITE}*) +(*$JPPDEFINEMACRO UNLOCK +{$IFDEF WRITE} +{$IFDEF THREADSAFE} +finally + if FThreadSafe then + SyncReaderWriter.EndWrite; +end; +{$ENDIF THREADSAFE} +{$ELSE ~WRITE} +{$IFDEF THREADSAFE} +finally + if FThreadSafe then + SyncReaderWriter.EndRead; +end; +{$ENDIF THREADSAFE} +{$ENDIF ~WRITE}*) +(*$JPPDEFINEMACRO DELEGATELOCK(CONTAINERNAME) +{$IFDEF WRITE} +if CONTAINERNAME.ReadOnly then + raise EJclReadOnlyError.Create; +{$IFDEF THREADSAFE} +CONTAINERNAME.WriteLock; +try +{$ENDIF THREADSAFE} +{$ELSE ~WRITE} +{$IFDEF THREADSAFE} +CONTAINERNAME.ReadLock; +try +{$ENDIF THREADSAFE} +{$ENDIF ~WRITE}*) +(*$JPPDEFINEMACRO DELEGATEUNLOCK(CONTAINERNAME) +{$IFDEF WRITE} +{$IFDEF THREADSAFE} +finally + CONTAINERNAME.WriteUnlock; +end; +{$ENDIF THREADSAFE} +{$ELSE ~WRITE} +{$IFDEF THREADSAFE} +finally + CONTAINERNAME.ReadUnlock; +end; +{$ENDIF THREADSAFE} +{$ENDIF ~WRITE}*) \ No newline at end of file diff --git a/3rdParty/JCL/source/prototypes/containers/JclContainerIntf.int b/3rdParty/JCL/source/prototypes/containers/JclContainerIntf.int new file mode 100644 index 00000000..aa219a0e --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclContainerIntf.int @@ -0,0 +1,225 @@ +(*$JPPDEFINEMACRO ITERPROCEDURE(ITERATEPROCEDURETYPENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME) +ITERATEPROCEDURETYPENAME = procedure(CONSTKEYWORDPARAMETERNAME: TYPENAME);*) +(*$JPPDEFINEMACRO APPLYFUNCTION(APPLYFUNCTIONTYPENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME) +APPLYFUNCTIONTYPENAME = function(CONSTKEYWORDPARAMETERNAME: TYPENAME): TYPENAME;*) +(*$JPPDEFINEMACRO COMPAREFUNCTION(COMPAREFUNCTIONTYPENAME, CONSTKEYWORD, TYPENAME) +COMPAREFUNCTIONTYPENAME = function(CONSTKEYWORDObj1, Obj2: TYPENAME): Integer;*) +(*$JPPDEFINEMACRO EQUALITYCOMPAREFUNCTION(EQUALITYCOMPAREFUNCTIONTYPENAME, CONSTKEYWORD, TYPENAME) +EQUALITYCOMPAREFUNCTIONTYPENAME = function(CONSTKEYWORDObj1, Obj2: TYPENAME): Boolean;*) +(*$JPPDEFINEMACRO HASHFUNCTION(HASHCONVERTFUNCTIONTYPENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME) +HASHCONVERTFUNCTIONTYPENAME = function(CONSTKEYWORDPARAMETERNAME: TYPENAME): Integer;*) +(*$JPPDEFINEMACRO SORTPROC(SORTPROCEDURETYPENAME, LISTINTERFACENAME, COMPAREFUNCTIONTYPENAME) +SORTPROCEDURETYPENAME = procedure(const AList: LISTINTERFACENAME; L, R: Integer; AComparator: COMPAREFUNCTIONTYPENAME);*) +(*$JPPDEFINEMACRO CONTAINER(INTERFACENAME, GUID) +INTERFACENAME = interface(IJclBaseContainer) + ['GUID'] +end; +*) +(*$JPPDEFINEMACRO FLATCONTAINER(INTERFACENAME, GUID, ANCESTORNAME) +INTERFACENAME = interface(ANCESTORNAME) + ['GUID'] +end; +*) +(*$JPPDEFINEMACRO EQUALITYCOMPARER(INTERFACENAME, GUID, EQUALITYCOMPAREFUNCTIONTYPENAME, CONSTKEYWORD, TYPENAME) +INTERFACENAME = interface + ['GUID'] + function GetEqualityCompare: EQUALITYCOMPAREFUNCTIONTYPENAME; + procedure SetEqualityCompare(Value: EQUALITYCOMPAREFUNCTIONTYPENAME); + function ItemsEqual(CONSTKEYWORDA, B: TYPENAME): Boolean; + property EqualityCompare: EQUALITYCOMPAREFUNCTIONTYPENAME read GetEqualityCompare write SetEqualityCompare; +end; +*) +(*$JPPDEFINEMACRO COMPARER(INTERFACENAME, GUID, COMPAREFUNCTIONTYPENAME, CONSTKEYWORD, TYPENAME) +INTERFACENAME = interface + ['GUID'] + function GetCompare: COMPAREFUNCTIONTYPENAME; + procedure SetCompare(Value: COMPAREFUNCTIONTYPENAME); + function ItemsCompare(CONSTKEYWORDA, B: TYPENAME): Integer; + property Compare: COMPAREFUNCTIONTYPENAME read GetCompare write SetCompare; +end;*) +(*$JPPDEFINEMACRO HASHCONVERTER(INTERFACENAME, GUID, HASHCONVERTFUNCTIONTYPENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME) +INTERFACENAME = interface + ['GUID'] + function GetHashConvert: HASHCONVERTFUNCTIONTYPENAME; + procedure SetHashConvert(Value: HASHCONVERTFUNCTIONTYPENAME); + function Hash(CONSTKEYWORDPARAMETERNAME: TYPENAME): Integer; + property HashConvert: HASHCONVERTFUNCTIONTYPENAME read GetHashConvert write SetHashConvert; +end; +*) +(*$JPPDEFINEMACRO RELEASEEVENT(EVENTTYPENAME, PARAMETERNAME, TYPENAME) +EVENTTYPENAME = function (var PARAMETERNAME: TYPENAME): TYPENAME of object; +*) +(*$JPPDEFINEMACRO OWNER(INTERFACENAME, ANCESTORNAME, GUID, RELEASERFUNCTIONNAME, RELEASEEVENTNAME, RELEASEEVENTTYPENAME, PARAMETERNAME, TYPENAME, OWNERADDITIONAL) +INTERFACENAME = interface(ANCESTORNAME) + ['GUID'] + function GetRELEASEEVENTNAME: RELEASEEVENTTYPENAME; + function RELEASERFUNCTIONNAME(var PARAMETERNAME: TYPENAME): TYPENAME; + procedure SetRELEASEEVENTNAME(Value: RELEASEEVENTTYPENAME); + property RELEASEEVENTNAME: RELEASEEVENTTYPENAME read GetRELEASEEVENTNAME write SetRELEASEEVENTNAME;OWNERADDITIONAL +end; +*) +(*$JPPDEFINEMACRO ITERATOR(INTERFACENAME, ANCESTORNAME, GUID, CONSTKEYWORD, PARAMETERNAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) +INTERFACENAME = interface(ANCESTORNAME) + ['GUID'] + function Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + procedure Extract; + function GETTERFUNCTIONNAME: TYPENAME; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function IteratorEquals(const AIterator: INTERFACENAME): Boolean; + function Next: TYPENAME; + function NextIndex: Integer; + function Previous: TYPENAME; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SETTERPROCEDURENAME(CONSTKEYWORDPARAMETERNAME: TYPENAME); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: TYPENAME read GETTERFUNCTIONNAME; + {$ENDIF SUPPORTS_FOR_IN} +end;*) +(*$JPPDEFINEMACRO TREEITERATOR(INTERFACENAME, ANCESTORNAME, GUID, CONSTKEYWORD, PARAMETERNAME, TYPENAME) +INTERFACENAME = interface(ANCESTORNAME) + ['GUID'] + function AddChild(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): TYPENAME; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(CONSTKEYWORDPARAMETERNAME: TYPENAME): Integer; + function InsertChild(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function Parent: TYPENAME; + procedure SetChild(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME); + property Children[Index: Integer]: TYPENAME read GetChild write SetChild; +end;*) +(*$JPPDEFINEMACRO BINTREEITERATOR(INTERFACENAME, ANCESTORNAME, GUID, TYPENAME) +INTERFACENAME = interface(ANCESTORNAME) + ['GUID'] + function HasLeft: Boolean; + function HasRight: Boolean; + function Left: TYPENAME; + function Right: TYPENAME; +end;*) +(*$JPPDEFINEMACRO COLLECTION(INTERFACENAME, ANCESTORNAME, GUID, CONSTKEYWORD, PARAMETERNAME, TYPENAME, ITRNAME) +INTERFACENAME = interface(ANCESTORNAME) + ['GUID'] + function Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function AddAll(const ACollection: INTERFACENAME): Boolean; + procedure Clear; + function Contains(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function ContainsAll(const ACollection: INTERFACENAME): Boolean; + function CollectionEquals(const ACollection: INTERFACENAME): Boolean; + function Extract(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function ExtractAll(const ACollection: INTERFACENAME): Boolean; + function First: ITRNAME; + function IsEmpty: Boolean; + function Last: ITRNAME; + function Remove(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function RemoveAll(const ACollection: INTERFACENAME): Boolean; + function RetainAll(const ACollection: INTERFACENAME): Boolean; + function Size: Integer; + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: ITRNAME; + {$ENDIF SUPPORTS_FOR_IN} +end;*) +(*$JPPDEFINEMACRO LIST(INTERFACENAME, ANCESTORNAME, GUID, CONSTKEYWORD, PARAMETERNAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME, ARRAYPROPERTYNAME) +INTERFACENAME = interface(ANCESTORNAME) + ['GUID'] + function Delete(Index: Integer): TYPENAME; + function ExtractIndex(Index: Integer): TYPENAME; + function GETTERFUNCTIONNAME(Index: Integer): TYPENAME; + function IndexOf(CONSTKEYWORDPARAMETERNAME: TYPENAME): Integer; + function Insert(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function InsertAll(Index: Integer; const ACollection: ANCESTORNAME): Boolean; + function LastIndexOf(CONSTKEYWORDPARAMETERNAME: TYPENAME): Integer; + procedure SETTERPROCEDURENAME(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME); + function SubList(First, Count: Integer): INTERFACENAME; + property ARRAYPROPERTYNAME[Key: Integer]: TYPENAME read GETTERFUNCTIONNAME write SETTERPROCEDURENAME; default; +end;*) +(*$JPPDEFINEMACRO ARRAY(INTERFACENAME, ANCESTORNAME, GUID, CONSTKEYWORD, PARAMETERNAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME, ARRAYPROPERTYNAME) +INTERFACENAME = interface(ANCESTORNAME) + ['GUID'] + function GETTERFUNCTIONNAME(Index: Integer): TYPENAME; + procedure SETTERPROCEDURENAME(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME); + property ARRAYPROPERTYNAME[Index: Integer]: TYPENAME read GETTERFUNCTIONNAME write SETTERPROCEDURENAME; default; +end;*) +(*$JPPDEFINEMACRO SET(INTERFACENAME, ANCESTORNAME, GUID) +INTERFACENAME = interface(ANCESTORNAME) + ['GUID'] + procedure Intersect(const ACollection: ANCESTORNAME); + procedure Subtract(const ACollection: ANCESTORNAME); + procedure Union(const ACollection: ANCESTORNAME); +end;*) +(*$JPPDEFINEMACRO TREE(INTERFACENAME, ANCESTORNAME, GUID, ITRNAME) +INTERFACENAME = interface(ANCESTORNAME) + ['GUID'] + function GetRoot: ITRNAME; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: ITRNAME read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; +end;*) +(*$JPPDEFINEMACRO MAP(INTERFACENAME, ANCESTORNAME, GUID, KEYCONSTKEYWORD, KEYTYPENAME, KEYSETNAME, VALUECONSTKEYWORD, VALUETYPENAME, VALUECOLLECTIONNAME) +INTERFACENAME = interface(ANCESTORNAME) + ['GUID'] + procedure Clear; + function ContainsKey(KEYCONSTKEYWORDKey: KEYTYPENAME): Boolean; + function ContainsValue(VALUECONSTKEYWORDValue: VALUETYPENAME): Boolean; + function Extract(KEYCONSTKEYWORDKey: KEYTYPENAME): VALUETYPENAME; + function GetValue(KEYCONSTKEYWORDKey: KEYTYPENAME): VALUETYPENAME; + function IsEmpty: Boolean; + function KeyOfValue(VALUECONSTKEYWORDValue: VALUETYPENAME): KEYTYPENAME; + function KeySet: KEYSETNAME; + function MapEquals(const AMap: INTERFACENAME): Boolean; + procedure PutAll(const AMap: INTERFACENAME); + procedure PutValue(KEYCONSTKEYWORDKey: KEYTYPENAME; VALUECONSTKEYWORDValue: VALUETYPENAME); + function Remove(KEYCONSTKEYWORDKey: KEYTYPENAME): VALUETYPENAME; + function Size: Integer; + function Values: VALUECOLLECTIONNAME; + property Items[KEYCONSTKEYWORDKey: KEYTYPENAME]: VALUETYPENAME read GetValue write PutValue; + {$IFNDEF BUGGY_DEFAULT_INDEXED_PROP} default; {$ENDIF ~BUGGY_DEFAULT_INDEXED_PROP} +end;*) +(*$JPPDEFINEMACRO QUEUE(INTERFACENAME, ANCESTORNAME, GUID, CONSTKEYWORD, PARAMETERNAME, TYPENAME) +INTERFACENAME = interface(ANCESTORNAME) + ['GUID'] + procedure Clear; + function Contains(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function Dequeue: TYPENAME; + function Empty: Boolean; + function Enqueue(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function Peek: TYPENAME; + function Size: Integer; +end;*) +(*$JPPDEFINEMACRO SORTEDMAP(INTERFACENAME, ANCESTORNAME, GUID, KEYCONSTKEYWORD, KEYTYPENAME) +INTERFACENAME = interface(ANCESTORNAME) + ['GUID'] + function FirstKey: KEYTYPENAME; + function HeadMap(KEYCONSTKEYWORDToKey: KEYTYPENAME): INTERFACENAME; + function LastKey: KEYTYPENAME; + function SubMap(KEYCONSTKEYWORDFromKey, ToKey: KEYTYPENAME): INTERFACENAME; + function TailMap(KEYCONSTKEYWORDFromKey: KEYTYPENAME): INTERFACENAME; +end;*) +(*$JPPDEFINEMACRO SORTEDSET(INTERFACENAME, ANCESTORNAME, GUID, CONSTKEYWORD, TYPENAME) +INTERFACENAME = interface(ANCESTORNAME) + ['GUID'] + function HeadSet(CONSTKEYWORDFinish: TYPENAME): INTERFACENAME; + function SubSet(CONSTKEYWORDStart, Finish: TYPENAME): INTERFACENAME; + function TailSet(CONSTKEYWORDStart: TYPENAME): INTERFACENAME; +end;*) +(*$JPPDEFINEMACRO STACK(INTERFACENAME, ANCESTORNAME, GUID, CONSTKEYWORD, PARAMETERNAME, TYPENAME) +INTERFACENAME = interface(ANCESTORNAME) + ['GUID'] + procedure Clear; + function Contains(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function Empty: Boolean; + function Peek: TYPENAME; + function Pop: TYPENAME; + function Push(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function Size: Integer; +end;*) diff --git a/3rdParty/JCL/source/prototypes/containers/JclHashMaps.imp b/3rdParty/JCL/source/prototypes/containers/JclHashMaps.imp new file mode 100644 index 00000000..a322a438 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclHashMaps.imp @@ -0,0 +1,402 @@ +(*$JPPDEFINEMACRO JCLHASHMAPTYPESIMP(ENTRYARRAYTYPENAME, BUCKETTYPENAME, KEYDEFAULT, VALUEDEFAULT) +//=== { BUCKETTYPENAME } ========================================== + +{$JPPUNDEF GENERIC}{$JPPUNDEF REFCOUNTED}{$IFDEF KEYREFCOUNTED}{$JPPDEFINE REFCOUNTED}{$ENDIF}{$IFDEF VALUEREFCOUNTED}{$JPPDEFINE REFCOUNTED}{$ENDIF}{$IFDEF KEYZEROINIT}{$JPPDEFINE ZEROINIT}{$ENDIF}{$IFDEF VALUEZEROINIT}{$JPPDEFINE ZEROINIT}{$ENDIF}{$JPPEXPANDMACRO MOVEARRAYIMP(MoveArray,ENTRYARRAYTYPENAME,,BUCKETTYPENAME.,)} + +*) +(*$JPPDEFINEMACRO JCLHASHMAPIMP(SELFCLASSNAME, BUCKETTYPENAME, + MAPINTERFACENAME, KEYSETINTERFACENAME, KEYCOLLECTIONINTERFACENAME, KEYITRINTERFACENAME, VALUECOLLECTIONINTERFACENAME, + KEYOWNERSHIPDECLARATION, VALUEOWNERSHIPDECLARATION, OWNERSHIPASSIGNMENTS, + KEYCONSTKEYWORD, KEYTYPENAME, KEYDEFAULT, VALUECONSTKEYWORD, VALUETYPENAME, VALUEDEFAULT, + CREATEKEYSET,CREATEKEYCOLLECTION,CREATEVALUECOLLECTION) +//=== { SELFCLASSNAME } ========================================== + +constructor SELFCLASSNAME.Create(ACapacity: IntegerVALUEOWNERSHIPDECLARATIONKEYOWNERSHIPDECLARATION); +begin + inherited Create;OWNERSHIPASSIGNMENTS + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor SELFCLASSNAME.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure SELFCLASSNAME.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: BUCKETTYPENAME; + ADest: SELFCLASSNAME; + AMap: MAPINTERFACENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + inherited AssignDataTo(Dest); + if Dest is SELFCLASSNAME then + begin + ADest := SELFCLASSNAME(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := BUCKETTYPENAME.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + begin + NewBucket.Entries[J].Key := SelfBucket.Entries[J].Key; + NewBucket.Entries[J].Value := SelfBucket.Entries[J].Value; + end; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), MAPINTERFACENAME, AMap) then + begin + AMap.Clear; + AMap.PutAll(Self); + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is SELFCLASSNAME then + SELFCLASSNAME(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure SELFCLASSNAME.Clear; +var + I, J: Integer; + Bucket: BUCKETTYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + begin + FreeKey(Bucket.Entries[J].Key); + FreeValue(Bucket.Entries[J].Value); + end; + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.ContainsKey(KEYCONSTKEYWORDKey: KEYTYPENAME): Boolean; +var + I: Integer; + Bucket: BUCKETTYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := True; + Break; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.ContainsValue(VALUECONSTKEYWORDValue: VALUETYPENAME): Boolean; +var + I, J: Integer; + Bucket: BUCKETTYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := True; + Break; + end; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Extract(KEYCONSTKEYWORDKey: KEYTYPENAME): VALUETYPENAME; +var + Bucket: BUCKETTYPENAME; + I, NewCapacity: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := VALUEDEFAULT; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Bucket.Entries[I].Value := VALUEDEFAULT; + FreeKey(Bucket.Entries[I].Key); + if I < Length(Bucket.Entries) - 1 then + Bucket.MoveArray(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.GetValue(KEYCONSTKEYWORDKey: KEYTYPENAME): VALUETYPENAME; +var + I: Integer; + Bucket: BUCKETTYPENAME; + Found: Boolean; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Found := False; + Result := VALUEDEFAULT; + Bucket := FBuckets[FHashToRangeFunction(Hash(Key), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + Result := Bucket.Entries[I].Value; + Found := True; + Break; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function SELFCLASSNAME.KeyOfValue(VALUECONSTKEYWORDValue: VALUETYPENAME): KEYTYPENAME; +var + I, J: Integer; + Bucket: BUCKETTYPENAME; + Found: Boolean; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Found := False; + Result := KEYDEFAULT; + for J := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[J]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ValuesEqual(Bucket.Entries[I].Value, Value) then + begin + Result := Bucket.Entries[I].Key; + Found := True; + Break; + end; + end; + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.KeySet: KEYSETINTERFACENAME; +var + I, J: Integer; + Bucket: BUCKETTYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := CREATEKEYSET; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Keys: KEYCOLLECTIONINTERFACENAME; +var + I, J: Integer; + Bucket: BUCKETTYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := CREATEKEYCOLLECTION; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Key); + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.MapEquals(const AMap: MAPINTERFACENAME): Boolean; +var + I, J: Integer; + Bucket: BUCKETTYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if AMap.ContainsKey(Bucket.Entries[J].Key) then + begin + if not ValuesEqual(AMap.GetValue(Bucket.Entries[J].Key), Bucket.Entries[J].Value) then + Exit; + end + else + Exit; + end; + Result := True; + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.Pack; +var + I: Integer; + Bucket: BUCKETTYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.PutAll(const AMap: MAPINTERFACENAME); +var + It: KEYITRINTERFACENAME; + Key: KEYTYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.PutValue(KEYCONSTKEYWORDKey: KEYTYPENAME; VALUECONSTKEYWORDValue: VALUETYPENAME); +var + Index: Integer; + Bucket: BUCKETTYPENAME; + I: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + if FAllowDefaultElements or (not KeysEqual(Key, KEYDEFAULT) and not ValuesEqual(Value, VALUEDEFAULT)) then + begin + Index := FHashToRangeFunction(Hash(Key), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if KeysEqual(Bucket.Entries[I].Key, Key) then + begin + FreeValue(Bucket.Entries[I].Value); + Bucket.Entries[I].Value := Value; + Exit; + end; + end + else + begin + Bucket := BUCKETTYPENAME.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size].Key := Key; + Bucket.Entries[Bucket.Size].Value := Value; + Inc(Bucket.Size); + Inc(FSize); + end; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Remove(KEYCONSTKEYWORDKey: KEYTYPENAME): VALUETYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := Extract(Key); + Result := FreeValue(Result); + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.SetCapacity(Value: Integer); +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Size: Integer; +begin + Result := FSize; +end; + +function SELFCLASSNAME.Values: VALUECOLLECTIONINTERFACENAME; +var + I, J: Integer; + Bucket: BUCKETTYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := CREATEVALUECOLLECTION; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + Result.Add(Bucket.Entries[J].Value); + end; + {$JPPEXPANDMACRO UNLOCK} +end;*) diff --git a/3rdParty/JCL/source/prototypes/containers/JclHashMaps.int b/3rdParty/JCL/source/prototypes/containers/JclHashMaps.int new file mode 100644 index 00000000..16c9800c --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclHashMaps.int @@ -0,0 +1,50 @@ +(*$JPPDEFINEMACRO JCLHASHMAPTYPESINT(ENTRYTYPENAME, ENTRYARRAYTYPENAME, BUCKETTYPENAME, KEYTYPENAME, VALUETYPENAME) +ENTRYTYPENAME = record + Key: KEYTYPENAME; + Value: VALUETYPENAME; +end; + +ENTRYARRAYTYPENAME = array of ENTRYTYPENAME; + +BUCKETTYPENAME = class +public + Size: Integer; + Entries: ENTRYARRAYTYPENAME; + {$JPPUNDEF GENERIC}{$JPPUNDEF REFCOUNTED}{$IFDEF KEYREFCOUNTED}{$JPPDEFINE REFCOUNTED}{$ENDIF}{$IFDEF VALUEREFCOUNTED}{$JPPDEFINE REFCOUNTED}{$ENDIF}{$IFDEF KEYZEROINIT}{$JPPDEFINE ZEROINIT}{$ENDIF}{$IFDEF VALUEZEROINIT}{$JPPDEFINE ZEROINIT}{$ENDIF}{$JPPEXPANDMACRO MOVEARRAYINT(MoveArray,ENTRYARRAYTYPENAME,)} +end;*) +(*$JPPDEFINEMACRO JCLHASHMAPINT(BUCKETTYPENAME, SELFCLASSNAME, ANCESTORNAME, MAPINTERFACENAME, KEYSETINTERFACENAME, KEYCOLLECTIONINTERFACENAME, VALUECOLLECTIONINTERFACENAME, + INTERFACEADDITIONAL, SECTIONADDITIONAL, KEYOWNERSHIPDECLARATION, VALUEOWNERSHIPDECLARATION, + KEYCONSTKEYWORD, KEYTYPENAME, VALUECONSTKEYWORD, VALUETYPENAME) +SELFCLASSNAME = class(ANCESTORNAME, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer,INTERFACEADDITIONAL + MAPINTERFACENAME)SECTIONADDITIONAL +private + FBuckets: array of BUCKETTYPENAME; + FHashToRangeFunction: TJclHashToRangeFunction; +protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; +public + constructor Create(ACapacity: IntegerVALUEOWNERSHIPDECLARATIONKEYOWNERSHIPDECLARATION); + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { MAPINTERFACENAME } + procedure Clear; + function ContainsKey(KEYCONSTKEYWORDKey: KEYTYPENAME): Boolean; + function ContainsValue(VALUECONSTKEYWORDValue: VALUETYPENAME): Boolean; + function Extract(KEYCONSTKEYWORDKey: KEYTYPENAME): VALUETYPENAME; + function GetValue(KEYCONSTKEYWORDKey: KEYTYPENAME): VALUETYPENAME; + function IsEmpty: Boolean; + function KeyOfValue(VALUECONSTKEYWORDValue: VALUETYPENAME): KEYTYPENAME; + function KeySet: KEYSETINTERFACENAME; + function Keys: KEYCOLLECTIONINTERFACENAME; + function MapEquals(const AMap: MAPINTERFACENAME): Boolean; + procedure PutAll(const AMap: MAPINTERFACENAME); + procedure PutValue(KEYCONSTKEYWORDKey: KEYTYPENAME; VALUECONSTKEYWORDValue: VALUETYPENAME); + function Remove(KEYCONSTKEYWORDKey: KEYTYPENAME): VALUETYPENAME; + function Size: Integer; + function Values: VALUECOLLECTIONINTERFACENAME; +end;*) diff --git a/3rdParty/JCL/source/prototypes/containers/JclHashSets.imp b/3rdParty/JCL/source/prototypes/containers/JclHashSets.imp new file mode 100644 index 00000000..ce1123fc --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclHashSets.imp @@ -0,0 +1,815 @@ +(*$JPPDEFINEMACRO JCLHASHSETIMP(SELFCLASSNAME, BUCKETTYPENAME, OWNERSHIPDECLARATION, OWNERSHIPPARAMETERNAME, + COLLECTIONINTERFACENAME, ITRCLASSNAME, ITRINTERFACENAME, MOVEARRAYPROCEDURENAME, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, RELEASERFUNCTIONNAME) +//=== { SELFCLASSNAME } ==================================================== + +constructor SELFCLASSNAME.Create(ACapacity: IntegerOWNERSHIPDECLARATION); +begin + inherited Create(OWNERSHIPPARAMETERNAME); + SetCapacity(ACapacity); + FHashToRangeFunction := JclSimpleHashToRange; +end; + +destructor SELFCLASSNAME.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function SELFCLASSNAME.Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + Index: Integer; + Bucket: BUCKETTYPENAME; + I: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if FAllowDefaultElements or (not ItemsEqual(PARAMETERNAME, DEFAULTVALUE)) then + begin + Index := FHashToRangeFunction(Hash(PARAMETERNAME), FCapacity); + Bucket := FBuckets[Index]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], PARAMETERNAME) then + Exit; + end + else + begin + Bucket := BUCKETTYPENAME.Create; + SetLength(Bucket.Entries, 1); + FBuckets[Index] := Bucket; + end; + + if Bucket.Size = Length(Bucket.Entries) then + SetLength(Bucket.Entries, CalcGrowCapacity(Bucket.Size, Bucket.Size)); + + if Bucket.Size < Length(Bucket.Entries) then + begin + Bucket.Entries[Bucket.Size] := PARAMETERNAME; + Inc(Bucket.Size); + Inc(FSize); + Result := True; + end; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.AddAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: ITRINTERFACENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.AssignDataTo(Dest: TJclAbstractContainerBase); +var + I, J: Integer; + SelfBucket, NewBucket: BUCKETTYPENAME; + ADest: SELFCLASSNAME; + ACollection: COLLECTIONINTERFACENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + inherited AssignDataTo(Dest); + if Dest is SELFCLASSNAME then + begin + ADest := SELFCLASSNAME(Dest); + ADest.Clear; + for I := 0 to FCapacity - 1 do + begin + SelfBucket := FBuckets[I]; + if SelfBucket <> nil then + begin + NewBucket := BUCKETTYPENAME.Create; + SetLength(NewBucket.Entries, SelfBucket.Size); + for J := 0 to SelfBucket.Size - 1 do + NewBucket.Entries[J] := SelfBucket.Entries[J]; + NewBucket.Size := SelfBucket.Size; + ADest.FBuckets[I] := NewBucket; + end; + end; + end + else + if Supports(IInterface(Dest), COLLECTIONINTERFACENAME, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is SELFCLASSNAME then + SELFCLASSNAME(Dest).FHashToRangeFunction := FHashToRangeFunction; +end; + +procedure SELFCLASSNAME.Clear; +var + I, J: Integer; + Bucket: BUCKETTYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := 0 to Bucket.Size - 1 do + RELEASERFUNCTIONNAME(Bucket.Entries[J]); + FreeAndNil(FBuckets[I]); + end; + end; + FSize := 0; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.CollectionEquals(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + I, J: Integer; + It: ITRINTERFACENAME; + Bucket: BUCKETTYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + for J := 0 to Bucket.Size - 1 do + if not ItemsEqual(Bucket.Entries[J], It.Next) then + Exit; + end; + Result := True; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Contains(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + I: Integer; + Bucket: BUCKETTYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(PARAMETERNAME), FCapacity)]; + if Bucket <> nil then + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], PARAMETERNAME) then + begin + Result := True; + Break; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.ContainsAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: ITRINTERFACENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Extract(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + Bucket: BUCKETTYPENAME; + I, NewCapacity: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + Bucket := FBuckets[FHashToRangeFunction(Hash(PARAMETERNAME), FCapacity)]; + if Bucket <> nil then + begin + for I := 0 to Bucket.Size - 1 do + if ItemsEqual(Bucket.Entries[I], PARAMETERNAME) then + begin + Result := True; + Bucket.Entries[I] := DEFAULTVALUE; + if I < Length(Bucket.Entries) - 1 then + MOVEARRAYPROCEDURENAME(Bucket.Entries, I + 1, I, Bucket.Size - I - 1); + Dec(Bucket.Size); + Dec(FSize); + Break; + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.ExtractAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: ITRINTERFACENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.First: ITRINTERFACENAME; +var + ABucketIndex, AItemIndex: Integer; + ABucket: BUCKETTYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + ABucketIndex := 0; + ABucket := nil; + while ABucketIndex < FCapacity do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := 0 + else + AItemIndex := -1; + Result := ITRCLASSNAME.Create(Self, ABucketIndex, AItemIndex, False, isFirst); + {$JPPEXPANDMACRO UNLOCK} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function SELFCLASSNAME.GetEnumerator: ITRINTERFACENAME; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +procedure SELFCLASSNAME.Intersect(const ACollection: COLLECTIONINTERFACENAME); +begin + RetainAll(ACollection); +end; + +function SELFCLASSNAME.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function SELFCLASSNAME.Last: ITRINTERFACENAME; +var + ABucketIndex, AItemIndex: Integer; + ABucket: BUCKETTYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + ABucketIndex := FCapacity - 1; + ABucket := nil; + while ABucketIndex >= 0 do + begin + ABucket := FBuckets[ABucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(ABucketIndex); + end; + if ABucket <> nil then + AItemIndex := ABucket.Size - 1 + else + AItemIndex := -1; + Result := ITRCLASSNAME.Create(Self, ABucketIndex, AItemIndex, False, isLast); + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.Pack; +var + I: Integer; + Bucket: BUCKETTYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + if Bucket.Size > 0 then + SetLength(Bucket.Entries, Bucket.Size) + else + FreeAndNil(FBuckets[I]); + end; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Remove(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + Extracted: TYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := Extract(PARAMETERNAME); + if Result then + begin + Extracted := PARAMETERNAME; + RELEASERFUNCTIONNAME(Extracted); + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.RemoveAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: ITRINTERFACENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.RetainAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + I, J, NewCapacity: Integer; + Bucket: BUCKETTYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := 0 to FCapacity - 1 do + begin + Bucket := FBuckets[I]; + if Bucket <> nil then + begin + for J := Bucket.Size - 1 downto 0 do + if not ACollection.Contains(Bucket.Entries[I]) then + begin + Bucket.Entries[J] := RELEASERFUNCTIONNAME(Bucket.Entries[J]); + if J < Length(Bucket.Entries) - 1 then + MOVEARRAYPROCEDURENAME(Bucket.Entries, J + 1, J, Bucket.Size - J - 1); + Dec(Bucket.Size); + Dec(FSize); + end; + + NewCapacity := CalcPackCapacity(Length(Bucket.Entries), Bucket.Size); + if NewCapacity < Length(Bucket.Entries) then + SetLength(Bucket.Entries, NewCapacity); + end; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.SetCapacity(Value: Integer); +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + if FSize = 0 then + begin + SetLength(FBuckets, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Size: Integer; +begin + Result := FSize; +end; + +procedure SELFCLASSNAME.Subtract(const ACollection: COLLECTIONINTERFACENAME); +begin + RemoveAll(ACollection); +end; + +procedure SELFCLASSNAME.Union(const ACollection: COLLECTIONINTERFACENAME); +begin + AddAll(ACollection); +end; +*) +(*$JPPDEFINEMACRO JCLHASHSETITRIMP(SELFCLASSNAME, HASHSETCLASSNAME, BUCKETTYPENAME, ITRINTERFACENAME, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) +//=== { SELFCLASSNAME } ============================================ + +constructor SELFCLASSNAME.Create(AOwnHashSet: HASHSETCLASSNAME; + ABucketIndex, AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnHashSet := AOwnHashSet; + FBucketIndex := ABucketIndex; + FItemIndex := AItemIndex; + FStart := AStart; +end; + +function SELFCLASSNAME.Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +begin + Result := FOwnHashSet.Add(PARAMETERNAME); +end; + +procedure SELFCLASSNAME.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: SELFCLASSNAME; +begin + inherited AssignPropertiesTo(Dest); + if Dest is SELFCLASSNAME then + begin + ADest := SELFCLASSNAME(Dest); + ADest.FBucketIndex := FBucketIndex; + ADest.FItemIndex := FItemIndex; + ADest.FOwnHashSet := FOwnHashSet; + ADest.FStart := FStart; + end; +end; + +function SELFCLASSNAME.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := SELFCLASSNAME.Create(FOwnHashSet, FBucketIndex, FItemIndex, Valid, FStart); +end; + +procedure SELFCLASSNAME.Extract; +var + PARAMETERNAME: TYPENAME; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.WriteLock; + try + {$ENDIF THREADSAFE} + CheckValid; + PARAMETERNAME := GETTERFUNCTIONNAME; + Valid := False; + FOwnHashSet.Extract(PARAMETERNAME); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function SELFCLASSNAME.GETTERFUNCTIONNAME: TYPENAME; +var + ABucket: BUCKETTYPENAME; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + CheckValid; + Result := DEFAULTVALUE; + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function SELFCLASSNAME.HasNext: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: BUCKETTYPENAME; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex < (ABucket.Size - 1)) or + ((not SkipCurrent) and (AItemIndex < ABucket.Size)) then + Exit; + end; + AItemIndex := 0; + Inc(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function SELFCLASSNAME.HasPrevious: Boolean; +var + ABucketIndex, AItemIndex: Integer; + ABucket: BUCKETTYPENAME; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Result := True; + ABucketIndex := FBucketIndex; + AItemIndex := FItemIndex; + SkipCurrent := Valid; + while ABucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[ABucketIndex]; + if ABucket <> nil then + begin + if (AItemIndex > 0) or + ((not SkipCurrent) and (AItemIndex >= 0)) then + Exit; + end; + AItemIndex := MaxInt; + Dec(ABucketIndex); + SkipCurrent := False; + end; + Result := False; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function SELFCLASSNAME.Insert(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +begin + raise EJclOperationNotSupportedError.Create; +end; + +function SELFCLASSNAME.IteratorEquals(const AIterator: ITRINTERFACENAME): Boolean; +var + Obj: TObject; + ItrObj: SELFCLASSNAME; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is SELFCLASSNAME then + begin + ItrObj := SELFCLASSNAME(Obj); + Result := (FOwnHashSet = ItrObj.FOwnHashSet) and (FBucketIndex = ItrObj.FBucketIndex) and (FItemIndex = ItrObj.FItemIndex) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function SELFCLASSNAME.MoveNext: Boolean; +var + ABucket: BUCKETTYPENAME; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity); + if Result then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + Result := (ABucket <> nil) and (FItemIndex < ABucket.Size); + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function SELFCLASSNAME.Next: TYPENAME; +var + ABucket: BUCKETTYPENAME; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex < ABucket.Size) then + Break; + if FItemIndex < (ABucket.Size - 1) then + begin + Inc(FItemIndex); + Break; + end; + end; + FItemIndex := 0; + Inc(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := DEFAULTVALUE; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function SELFCLASSNAME.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function SELFCLASSNAME.Previous: TYPENAME; +var + ABucket: BUCKETTYPENAME; + SkipCurrent: Boolean; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + if Valid then + begin + SkipCurrent := True; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (FItemIndex < 0) then + FItemIndex := ABucket.Size - 1; + if ABucket <> nil then + begin + if (not SkipCurrent) and (FItemIndex >= 0) and (FItemIndex < ABucket.Size) then + Break; + if (FItemIndex > 0) and (FItemIndex < ABucket.Size) then + begin + Dec(FItemIndex); + Break; + end; + end; + FItemIndex := -1; + Dec(FBucketIndex); + SkipCurrent := False; + end; + end + else + Valid := True; + + Result := DEFAULTVALUE; + if (FBucketIndex >= 0) and (FItemIndex >= 0) and + (FBucketIndex < FOwnHashSet.FCapacity) then + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and + (FItemIndex < ABucket.Size) then + Result := ABucket.Entries[FItemIndex] + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + end + else + if not FOwnHashSet.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +function SELFCLASSNAME.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure SELFCLASSNAME.Remove; +begin + +end; + +procedure SELFCLASSNAME.Reset; +var + ABucket: BUCKETTYPENAME; +begin + {$IFDEF THREADSAFE} + FOwnHashSet.ReadLock; + try + {$ENDIF THREADSAFE} + Valid := False; + case FStart of + isFirst: + begin + FBucketIndex := 0; + ABucket := nil; + while FBucketIndex < FOwnHashSet.FCapacity do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Inc(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := 0 + else + FItemIndex := -1; + end; + isLast: + begin + FBucketIndex := FOwnHashSet.FCapacity - 1; + ABucket := nil; + while FBucketIndex >= 0 do + begin + ABucket := FOwnHashSet.FBuckets[FBucketIndex]; + if (ABucket <> nil) and (ABucket.Size > 0) then + Break; + Dec(FBucketIndex); + end; + if ABucket <> nil then + FItemIndex := ABucket.Size - 1 + else + FItemIndex := -1; + end; + end; + {$IFDEF THREADSAFE} + finally + FOwnHashSet.ReadUnlock; + end; + {$ENDIF THREADSAFE} +end; + +procedure SELFCLASSNAME.SETTERPROCEDURENAME(CONSTKEYWORDPARAMETERNAME: TYPENAME); +begin + raise EJclOperationNotSupportedError.Create; +end; +*) diff --git a/3rdParty/JCL/source/prototypes/containers/JclHashSets.int b/3rdParty/JCL/source/prototypes/containers/JclHashSets.int new file mode 100644 index 00000000..dea33d35 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclHashSets.int @@ -0,0 +1,85 @@ +(*$JPPDEFINEMACRO JCLHASHSETTYPEINT(BUCKETTYPENAME, DYNARRAYTYPENAME) +BUCKETTYPENAME = class +public + Size: Integer; + Entries: DYNARRAYTYPENAME; +end; +*) +(*$JPPDEFINEMACRO JCLHASHSETINT(SELFCLASSNAME, ANCESTORCLASSNAME, + BASECONTAINERINTERFACENAME, FLATCONTAINERINTERFACENAME, BUCKETTYPENAME, + COLLECTIONINTERFACENAME, SETINTERFACENAME, ITRINTERFACENAME, + EQUALITYCOMPARERINTERFACENAME, HASHCONVERTERINTERFACENAME, INTERFACEADDITIONAL, + SECTIONADDITIONAL, COLLECTIONFLAGS, CONSTKEYWORD, PARAMETERNAME, TYPENAME, OWNERSHIPDECLARATION) +SELFCLASSNAME = class(ANCESTORCLASSNAME, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + BASECONTAINERINTERFACENAME, FLATCONTAINERINTERFACENAME, EQUALITYCOMPARERINTERFACENAME, HASHCONVERTERINTERFACENAME,INTERFACEADDITIONAL + COLLECTIONINTERFACENAME, SETINTERFACENAME)SECTIONADDITIONAL +private + FBuckets: array of BUCKETTYPENAME; + FHashToRangeFunction: TJclHashToRangeFunction; +protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; +public + constructor Create(ACapacity: IntegerOWNERSHIPDECLARATION); overload; + destructor Destroy; override; + property HashToRangeFunction: TJclHashToRangeFunction read FHashToRangeFunction write FHashToRangeFunction; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { COLLECTIONINTERFACENAME } + function Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean;COLLECTIONFLAGS + function AddAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + procedure Clear;COLLECTIONFLAGS + function CollectionEquals(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function Contains(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean;COLLECTIONFLAGS + function ContainsAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function Extract(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean;COLLECTIONFLAGS + function ExtractAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function First: ITRINTERFACENAME;COLLECTIONFLAGS + function IsEmpty: Boolean;COLLECTIONFLAGS + function Last: ITRINTERFACENAME;COLLECTIONFLAGS + function Remove(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean;COLLECTIONFLAGS + function RemoveAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function RetainAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function Size: Integer;COLLECTIONFLAGS + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: ITRINTERFACENAME;COLLECTIONFLAGS + {$ENDIF SUPPORTS_FOR_IN} + { SETINTERFACENAME } + procedure Intersect(const ACollection: COLLECTIONINTERFACENAME); + procedure Subtract(const ACollection: COLLECTIONINTERFACENAME); + procedure Union(const ACollection: COLLECTIONINTERFACENAME); +end;*) +(*$JPPDEFINEMACRO JCLHASHSETITRINT(SELFCLASSNAME, ITRINTERFACENAME, HASHSETCLASSNAME, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) +SELFCLASSNAME = class(TJclAbstractIterator, ITRINTERFACENAME) +protected + FBucketIndex: Integer; + FItemIndex: Integer; + FStart: TItrStart; + FOwnHashSet: HASHSETCLASSNAME; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; +public + constructor Create(AOwnHashSet: HASHSETCLASSNAME; ABucketIndex: Integer; AItemIndex: Integer; AValid: Boolean; AStart: TItrStart); + { ITRINTERFACENAME } + function Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + procedure Extract; + function GETTERFUNCTIONNAME: TYPENAME; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function IteratorEquals(const AIterator: ITRINTERFACENAME): Boolean; + function Next: TYPENAME; + function NextIndex: Integer; + function Previous: TYPENAME; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SETTERPROCEDURENAME(CONSTKEYWORDPARAMETERNAME: TYPENAME); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: TYPENAME read GETTERFUNCTIONNAME; + {$ENDIF SUPPORTS_FOR_IN} +end;*) diff --git a/3rdParty/JCL/source/prototypes/containers/JclLinkedLists.imp b/3rdParty/JCL/source/prototypes/containers/JclLinkedLists.imp new file mode 100644 index 00000000..4f22197f --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclLinkedLists.imp @@ -0,0 +1,968 @@ +(*$JPPDEFINEMACRO JCLLINKEDLISTITRIMP(SELFCLASSNAME, ITRINTERFACENAME, LISTCLASSNAME, EQUALITYCOMPARERINTERFACENAME, + ITEMCLASSNAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, GETTERFUNCTIONNAME, SETTERPROCEDURENAME, RELEASERCALL) +//=== { SELFCLASSNAME } ============================================================ + +constructor SELFCLASSNAME.Create(AOwnList: LISTCLASSNAME; ACursor: ITEMCLASSNAME; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnList := AOwnList; + FStart := AStart; + FEqualityComparer := AOwnList as EQUALITYCOMPARERINTERFACENAME; +end; + +function SELFCLASSNAME.Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +begin + Result := FOwnList.Add(PARAMETERNAME); +end; + +procedure SELFCLASSNAME.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: SELFCLASSNAME; +begin + inherited AssignPropertiesTo(Dest); + if Dest is SELFCLASSNAME then + begin + ADest := SELFCLASSNAME(Dest); + ADest.FCursor := FCursor; + ADest.FOwnList := FOwnList; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function SELFCLASSNAME.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := SELFCLASSNAME.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure SELFCLASSNAME.Extract; +var + OldCursor: ITEMCLASSNAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnList)} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnList)} +end; + +function SELFCLASSNAME.GETTERFUNCTIONNAME: TYPENAME; +begin + CheckValid; + Result := DEFAULTVALUE; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnList.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); +end; + +function SELFCLASSNAME.HasNext: Boolean; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnList)} + if Valid then + Result := (FCursor <> nil) and (FCursor.Next <> nil) + else + Result := FCursor <> nil; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnList)} +end; + +function SELFCLASSNAME.HasPrevious: Boolean; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnList)} + if Valid then + Result := (FCursor <> nil) and (FCursor.Previous <> nil) + else + Result := FCursor <> nil; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnList)} +end; + +function SELFCLASSNAME.Insert(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + NewCursor: ITEMCLASSNAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnList)} + CheckValid; + Result := FCursor <> nil; + if Result then + begin + Result := FOwnList.AllowDefaultElements or not FEqualityComparer.ItemsEqual(PARAMETERNAME, DEFAULTVALUE); + if Result then + begin + case FOwnList.Duplicates of + dupIgnore: + Result := not FOwnList.Contains(PARAMETERNAME); + dupAccept: + Result := True; + dupError: + begin + Result := FOwnList.Contains(PARAMETERNAME); + if not Result then + raise EJclDuplicateElementError.Create; + end; + end; + if Result then + begin + NewCursor := ITEMCLASSNAME.Create; + NewCursor.Value := PARAMETERNAME; + NewCursor.Next := FCursor; + NewCursor.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := NewCursor; + FCursor.Previous := NewCursor; + FCursor := NewCursor; + end; + end; + end; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnList)} +end; + +function SELFCLASSNAME.IteratorEquals(const AIterator: ITRINTERFACENAME): Boolean; +var + Obj: TObject; + ItrObj: SELFCLASSNAME; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is SELFCLASSNAME then + begin + ItrObj := SELFCLASSNAME(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function SELFCLASSNAME.MoveNext: Boolean; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnList)} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + Result := FCursor <> nil; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnList)} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function SELFCLASSNAME.Next: TYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnList)} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Next + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := DEFAULTVALUE; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnList)} +end; + +function SELFCLASSNAME.NextIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +function SELFCLASSNAME.Previous: TYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnList)} + if Valid and (FCursor <> nil) then + FCursor := FCursor.Previous + else + Valid := True; + if FCursor <> nil then + Result := FCursor.Value + else + Result := DEFAULTVALUE; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnList)} +end; + +function SELFCLASSNAME.PreviousIndex: Integer; +begin + // No Index + raise EJclOperationNotSupportedError.Create; +end; + +procedure SELFCLASSNAME.Remove; +var + OldCursor: ITEMCLASSNAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnList)} + CheckValid; + Valid := False; + if FCursor <> nil then + begin + RELEASERCALL + if FCursor.Next <> nil then + FCursor.Next.Previous := FCursor.Previous; + if FCursor.Previous <> nil then + FCursor.Previous.Next := FCursor.Next; + OldCursor := FCursor; + FCursor := FCursor.Next; + OldCursor.Free; + end; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnList)} +end; + +procedure SELFCLASSNAME.Reset; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnList)} + Valid := False; + case FStart of + isFirst: + begin + while (FCursor <> nil) and (FCursor.Previous <> nil) do + FCursor := FCursor.Previous; + end; + isLast: + begin + while (FCursor <> nil) and (FCursor.Next <> nil) do + FCursor := FCursor.Next; + end; + end; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnList)} +end; + +procedure SELFCLASSNAME.SETTERPROCEDURENAME(CONSTKEYWORDPARAMETERNAME: TYPENAME); +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnList)} + CheckValid; + RELEASERCALL + FCursor.Value := PARAMETERNAME; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnList)} +end;*) +(*$JPPDEFINEMACRO JCLLINKEDLISTIMP(SELFCLASSNAME, ITEMCLASSNAME, COLLECTIONINTERFACENAME, LISTINTERFACENAME, ITRINTERFACENAME, ITRCLASSNAME, + OWNERSHIPDECLARATION, OWNERSHIPPARAMETERNAME, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, GETTERFUNCTIONNAME, SETTERPROCEDURENAME, RELEASERFUNCTIONNAME) +//=== { SELFCLASSNAME } ================================================== + +constructor SELFCLASSNAME.Create(const ACollection: COLLECTIONINTERFACENAMEOWNERSHIPDECLARATION); +begin + inherited Create(OWNERSHIPPARAMETERNAME); + FStart := nil; + FEnd := nil; + if ACollection <> nil then + AddAll(ACollection); +end; + +destructor SELFCLASSNAME.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function SELFCLASSNAME.Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + NewItem: ITEMCLASSNAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := FAllowDefaultElements or not ItemsEqual(PARAMETERNAME, DEFAULTVALUE); + if Result then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(PARAMETERNAME, NewItem.Value) then + begin + Result := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if Result then + begin + NewItem := ITEMCLASSNAME.Create; + NewItem.Value := PARAMETERNAME; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.AddAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: ITRINTERFACENAME; + Item: TYPENAME; + AddItem: Boolean; + NewItem: ITEMCLASSNAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, DEFAULTVALUE); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + NewItem := FStart; + while NewItem <> nil do + begin + if ItemsEqual(Item, NewItem.Value) then + begin + AddItem := CheckDuplicate; + Break; + end; + NewItem := NewItem.Next; + end; + end; + if AddItem then + begin + NewItem := ITEMCLASSNAME.Create; + NewItem.Value := Item; + if FStart <> nil then + begin + NewItem.Next := nil; + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + end + else + begin + FStart := NewItem; + FEnd := NewItem; + end; + Inc(FSize); + end; + end; + Result := AddItem and Result; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ACollection: COLLECTIONINTERFACENAME; +begin + inherited AssignDataTo(Dest); + if Supports(IInterface(Dest), COLLECTIONINTERFACENAME, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure SELFCLASSNAME.Clear; +var + Old, Current: ITEMCLASSNAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Current := FStart; + while Current <> nil do + begin + RELEASERFUNCTIONNAME(Current.Value); + Old := Current; + Current := Current.Next; + Old.Free; + end; + FSize := 0; + + //Daniele Teti 27/12/2004 + FStart := nil; + FEnd := nil; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.CollectionEquals(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It, ItSelf: ITRINTERFACENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext and It.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Contains(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + Current: ITEMCLASSNAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, PARAMETERNAME) then + begin + Result := True; + Break; + end; + Current := Current.Next; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.ContainsAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: ITRINTERFACENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Delete(Index: Integer): TYPENAME; +var + Current: ITEMCLASSNAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := DEFAULTVALUE; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := RELEASERFUNCTIONNAME(Current.Value); + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Extract(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + Current: ITEMCLASSNAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(Current.Value, PARAMETERNAME) then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Current.Value := DEFAULTVALUE; + Current.Free; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + Current := Current.Next; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.ExtractAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: ITRINTERFACENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.ExtractIndex(Index: Integer): TYPENAME; +var + Current: ITEMCLASSNAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := DEFAULTVALUE; + if (Index >= 0) and (Index < FSize) then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + if Current.Previous <> nil then + Current.Previous.Next := Current.Next + else + FStart := Current.Next; + if Current.Next <> nil then + Current.Next.Previous := Current.Previous + else + FEnd := Current.Previous; + Result := Current.Value; + Current.Free; + Dec(FSize); + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end + else + raise EJclOutOfBoundsError.Create; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.First: ITRINTERFACENAME; +begin + Result := ITRCLASSNAME.Create(Self, FStart, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function SELFCLASSNAME.GetEnumerator: ITRINTERFACENAME; +begin + Result := ITRCLASSNAME.Create(Self, FStart, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function SELFCLASSNAME.GETTERFUNCTIONNAME(Index: Integer): TYPENAME; +var + Current: ITEMCLASSNAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := DEFAULTVALUE; + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + Result := Current.Value + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.IndexOf(CONSTKEYWORDPARAMETERNAME: TYPENAME): Integer; +var + Current: ITEMCLASSNAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Current := FStart; + Result := 0; + while (Current <> nil) and not ItemsEqual(Current.Value, PARAMETERNAME) do + begin + Inc(Result); + Current := Current.Next; + end; + if Current = nil then + Result := -1; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Insert(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + Current, NewItem: ITEMCLASSNAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := FAllowDefaultElements or not ItemsEqual(PARAMETERNAME, DEFAULTVALUE); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(PARAMETERNAME, Current.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if Result then + begin + NewItem := ITEMCLASSNAME.Create; + NewItem.Value := PARAMETERNAME; + if Index = 0 then + begin + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end + else + if Index = FSize then + begin + NewItem.Previous := FEnd; + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + end; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.InsertAll(Index: Integer; const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: ITRINTERFACENAME; + Current, NewItem, Test: ITEMCLASSNAME; + AddItem: Boolean; + Item: TYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + if Index = 0 then + begin + It := ACollection.Last; + while It.HasPrevious do + begin + Item := It.Previous; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, DEFAULTVALUE); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := ITEMCLASSNAME.Create; + NewItem.Value := Item; + NewItem.Next := FStart; + if FStart <> nil then + FStart.Previous := NewItem; + FStart := NewItem; + if FSize = 0 then + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + if Index = Size then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, DEFAULTVALUE); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := ITEMCLASSNAME.Create; + NewItem.Value := Item; + NewItem.Previous := FEnd; + if FEnd <> nil then + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end + else + begin + Current := FStart; + while (Current <> nil) and (Index > 0) do + begin + Current := Current.Next; + Dec(Index); + end; + if Current <> nil then + begin + It := ACollection.First; + while It.HasNext do + begin + Item := It.Next; + AddItem := FAllowDefaultElements or not ItemsEqual(Item, DEFAULTVALUE); + if AddItem then + begin + if FDuplicates <> dupAccept then + begin + Test := FStart; + while Test <> nil do + begin + if ItemsEqual(Item, Test.Value) then + begin + Result := CheckDuplicate; + Break; + end; + Test := Test.Next; + end; + end; + if AddItem then + begin + NewItem := ITEMCLASSNAME.Create; + NewItem.Value := Item; + NewItem.Next := Current; + NewItem.Previous := Current.Previous; + if Current.Previous <> nil then + Current.Previous.Next := NewItem; + Current.Previous := NewItem; + Inc(FSize); + end; + end; + Result := Result and AddItem; + end; + end; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function SELFCLASSNAME.Last: ITRINTERFACENAME; +begin + Result := ITRCLASSNAME.Create(Self, FEnd, False, isLast); +end; + +function SELFCLASSNAME.LastIndexOf(CONSTKEYWORDPARAMETERNAME: TYPENAME): Integer; +var + Current: ITEMCLASSNAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := -1; + if FEnd <> nil then + begin + Current := FEnd; + Result := FSize - 1; + while (Current <> nil) and not ItemsEqual(Current.Value, PARAMETERNAME) do + begin + Dec(Result); + Current := Current.Previous; + end; + if Current = nil then + Result := -1; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Remove(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + Extracted: TYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := Extract(PARAMETERNAME); + if Result then + begin + Extracted := PARAMETERNAME; + RELEASERFUNCTIONNAME(Extracted); + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.RemoveAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: ITRINTERFACENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.RetainAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: ITRINTERFACENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.SETTERPROCEDURENAME(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME); +var + Current: ITEMCLASSNAME; + ReplaceItem: Boolean; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + ReplaceItem := FAllowDefaultElements or not ItemsEqual(PARAMETERNAME, DEFAULTVALUE); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + begin + Current := FStart; + while Current <> nil do + begin + if ItemsEqual(PARAMETERNAME, Current.Value) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + Current := Current.Next; + end; + end; + if ReplaceItem then + begin + Current := FStart; + while Current <> nil do + begin + if Index = 0 then + begin + RELEASERFUNCTIONNAME(Current.Value); + Current.Value := PARAMETERNAME; + Break; + end; + Dec(Index); + Current := Current.Next; + end; + end; + end; + if not ReplaceItem then + Delete(Index); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Size: Integer; +begin + Result := FSize; +end; + +function SELFCLASSNAME.SubList(First, Count: Integer): LISTINTERFACENAME; +var + Current: ITEMCLASSNAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := CreateEmptyContainer as LISTINTERFACENAME; + Current := FStart; + while (Current <> nil) and (First > 0) do + begin + Dec(First); + Current := Current.Next; + end; + while (Current <> nil) and (Count > 0) do + begin + Result.Add(Current.Value); + Dec(Count); + Current := Current.Next; + end; + {$JPPEXPANDMACRO UNLOCK} +end;*) diff --git a/3rdParty/JCL/source/prototypes/containers/JclLinkedLists.int b/3rdParty/JCL/source/prototypes/containers/JclLinkedLists.int new file mode 100644 index 00000000..62a129f1 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclLinkedLists.int @@ -0,0 +1,88 @@ +(*$JPPDEFINEMACRO JCLLINKEDLISTTYPESINT(ITEMCLASSNAME, TYPENAME) +ITEMCLASSNAME = class +public + Value: TYPENAME; + Next: ITEMCLASSNAME; + Previous: ITEMCLASSNAME; +end;*) +(*$JPPDEFINEMACRO JCLLINKEDLISTINT(ITEMCLASSNAME, SELFCLASSNAME, ANCESTORCLASSNAME, + BASECONTAINERINTERFACENAME, FLATCONTAINERINTERFACENAME, COLLECTIONINTERFACENAME, + LISTINTERFACENAME, ITRINTERFACENAME, EQUALITYCOMPARERINTERFACENAME, INTERFACEADDITIONAL, + SECTIONADDITIONAL, COLLECTIONFLAGS, OWNERSHIPDECLARATION, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) +SELFCLASSNAME = class(ANCESTORCLASSNAME, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclBaseContainer, BASECONTAINERINTERFACENAME, + FLATCONTAINERINTERFACENAME, EQUALITYCOMPARERINTERFACENAME,INTERFACEADDITIONAL + COLLECTIONINTERFACENAME, LISTINTERFACENAME)SECTIONADDITIONAL +private + FStart: ITEMCLASSNAME; + FEnd: ITEMCLASSNAME; +protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; +public + constructor Create(const ACollection: COLLECTIONINTERFACENAMEOWNERSHIPDECLARATION); + destructor Destroy; override; + { COLLECTIONINTERFACENAME } + function Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean;COLLECTIONFLAGS + function AddAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + procedure Clear;COLLECTIONFLAGS + function CollectionEquals(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function Contains(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean;COLLECTIONFLAGS + function ContainsAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function Extract(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean;COLLECTIONFLAGS + function ExtractAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function First: ITRINTERFACENAME;COLLECTIONFLAGS + function IsEmpty: Boolean;COLLECTIONFLAGS + function Last: ITRINTERFACENAME;COLLECTIONFLAGS + function Remove(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean;COLLECTIONFLAGS + function RemoveAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function RetainAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function Size: Integer;COLLECTIONFLAGS + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: ITRINTERFACENAME;COLLECTIONFLAGS + {$ENDIF SUPPORTS_FOR_IN} + { LISTINTERFACENAME } + function Delete(Index: Integer): TYPENAME; + function ExtractIndex(Index: Integer): TYPENAME; + function GETTERFUNCTIONNAME(Index: Integer): TYPENAME; + function IndexOf(CONSTKEYWORDPARAMETERNAME: TYPENAME): Integer; + function Insert(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function InsertAll(Index: Integer; const ACollection: COLLECTIONINTERFACENAME): Boolean; + function LastIndexOf(CONSTKEYWORDPARAMETERNAME: TYPENAME): Integer; + procedure SETTERPROCEDURENAME(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME); + function SubList(First, Count: Integer): LISTINTERFACENAME; +end;*) +(*$JPPDEFINEMACRO JCLLINKEDLISTITRINT(SELFCLASSNAME, ITRINTERFACENAME, LISTCLASSNAME, EQUALITYCOMPARERINTERFACENAME, + ITEMCLASSNAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) +SELFCLASSNAME = class(TJclAbstractIterator, ITRINTERFACENAME, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) +private + FCursor: ITEMCLASSNAME; + FStart: TItrStart; + FOwnList: LISTCLASSNAME; + FEqualityComparer: EQUALITYCOMPARERINTERFACENAME; +public + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function CreateEmptyIterator: TJclAbstractIterator; override; +public + constructor Create(AOwnList: LISTCLASSNAME; ACursor: ITEMCLASSNAME; AValid: Boolean; AStart: TItrStart); + { ITRINTERFACENAME } + function Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + procedure Extract; + function GETTERFUNCTIONNAME: TYPENAME; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function IteratorEquals(const AIterator: ITRINTERFACENAME): Boolean; + function Next: TYPENAME; + function NextIndex: Integer; + function Previous: TYPENAME; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SETTERPROCEDURENAME(CONSTKEYWORDPARAMETERNAME: TYPENAME); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: TYPENAME read GETTERFUNCTIONNAME; + {$ENDIF SUPPORTS_FOR_IN} +end;*) diff --git a/3rdParty/JCL/source/prototypes/containers/JclQueues.imp b/3rdParty/JCL/source/prototypes/containers/JclQueues.imp new file mode 100644 index 00000000..8a5e330c --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclQueues.imp @@ -0,0 +1,204 @@ +(*$JPPDEFINEMACRO JCLQUEUEIMP(SELFCLASSNAME, + OWNERSHIPDECLARATION, OWNERSHIPPARAMETERNAME, MOVEARRAYPROCEDURENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, RELEASERFUNCTIONNAME) +//=== { SELFCLASSNAME } ======================================================= + +constructor SELFCLASSNAME.Create(ACapacity: IntegerOWNERSHIPDECLARATION); +begin + inherited Create(OWNERSHIPPARAMETERNAME); + FHead := 0; + FTail := 0; + SetCapacity(ACapacity); +end; + +destructor SELFCLASSNAME.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure SELFCLASSNAME.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: SELFCLASSNAME; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is SELFCLASSNAME then + begin + ADest := SELFCLASSNAME(Dest); + ADest.Clear; + ADest.SetCapacity(Size + 1); + I := FHead; + while I <> FTail do + begin + ADest.Enqueue(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + end; +end; + +procedure SELFCLASSNAME.AutoGrow; +begin + SetCapacity(CalcGrowCapacity(FCapacity, Size + 1)); +end; + +procedure SELFCLASSNAME.AutoPack; +begin + SetCapacity(CalcPackCapacity(FCapacity, Size + 1)); +end; + +procedure SELFCLASSNAME.Clear; +var + I: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + I := FHead; + while I <> FTail do + begin + RELEASERFUNCTIONNAME(FElements[I]); + Inc(I); + if I = FCapacity then + I := 0; + end; + FHead := 0; + FTail := 0; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Contains(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + I: Integer; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + I := FHead; + while I <> FTail do + begin + if ItemsEqual(FElements[I], PARAMETERNAME) then + begin + Result := True; + Break; + end; + Inc(I); + if I = FCapacity then + I := 0; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Dequeue: TYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := DEFAULTVALUE; + if FTail <> FHead then + begin + Result := FElements[FHead]; + FElements[FHead] := DEFAULTVALUE; + Inc(FHead); + if FHead = FCapacity then + FHead := 0; + AutoPack; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Empty: Boolean; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := FTail = FHead; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Enqueue(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + if (FTail = (FHead - 1)) or (FTail = (FHead + FCapacity - 1)) then + AutoGrow; + Result := (FTail <> (FHead - 1)) and (FTail <> (FHead + FCapacity - 1)); + if Result then + begin + FElements[FTail] := PARAMETERNAME; + Inc(FTail); + if FTail = FCapacity then + FTail := 0; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.Grow; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + SetCapacity(Size + 1); + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.Pack; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + SetCapacity(Size + 1); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Peek: TYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := DEFAULTVALUE; + if FTail <> FHead then + Result := FElements[FHead] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.SetCapacity(Value: Integer); +var + NewHead: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + if Value < 1 then + raise EJclIllegalQueueCapacityError.Create; + if Value <= Size then + raise EJclOutOfBoundsError.Create; + + if FHead > FTail then // looped + begin + NewHead := FHead + Value - FCapacity; + if Value > FCapacity then + // growing + SetLength(FElements, Value); + MOVEARRAYPROCEDURENAME(FElements, FHead, NewHead, FCapacity - FHead); + if FCapacity > Value then + // packing + SetLength(FElements, Value); + FHead := NewHead; + end + else + begin + // unlooped + if Value < FCapacity then + begin + MOVEARRAYPROCEDURENAME(FElements, FHead, 0, FTail - FHead); + Dec(FTail, FHead); + FHead := 0; + end; + SetLength(FElements, Value); + end; + inherited SetCapacity(Value); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Size: Integer; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + if FHead > FTail then + Result := FCapacity - FHead + FTail // looped + else + Result := FTail - FHead; + {$JPPEXPANDMACRO UNLOCK} +end;*) diff --git a/3rdParty/JCL/source/prototypes/containers/JclQueues.int b/3rdParty/JCL/source/prototypes/containers/JclQueues.int new file mode 100644 index 00000000..198a6d98 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclQueues.int @@ -0,0 +1,31 @@ +(*$JPPDEFINEMACRO JCLQUEUEINT(SELFCLASSNAME, BASECONTAINERINTERFACENAME, QUEUEINTERFACENAME, ANCESTORCLASSNAME, DYNARRAYTYPENAME, +EQUALITYCOMPARERINTERFACENAME, INTERFACEADDITIONAL, SECTIONADDITIONAL, OWNERSHIPDECLARATION, CONSTKEYWORD, PARAMETERNAME, TYPENAME) +SELFCLASSNAME = class(ANCESTORCLASSNAME, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + BASECONTAINERINTERFACENAME, EQUALITYCOMPARERINTERFACENAME,INTERFACEADDITIONAL + QUEUEINTERFACENAME)SECTIONADDITIONAL +private + FElements: DYNARRAYTYPENAME; + FHead: Integer; + FTail: Integer; +protected + procedure AutoGrow; override; + procedure AutoPack; override; + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; +public + constructor Create(ACapacity: IntegerOWNERSHIPDECLARATION); + destructor Destroy; override; + { IJclGrowable } + procedure Grow; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { QUEUEINTERFACENAME } + procedure Clear; + function Contains(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function Dequeue: TYPENAME; + function Empty: Boolean; + function Enqueue(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function Peek: TYPENAME; + function Size: Integer; +end;*) diff --git a/3rdParty/JCL/source/prototypes/containers/JclSortedMaps.imp b/3rdParty/JCL/source/prototypes/containers/JclSortedMaps.imp new file mode 100644 index 00000000..bfa298f4 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclSortedMaps.imp @@ -0,0 +1,386 @@ +(*$JPPDEFINEMACRO JCLSORTEDMAPIMP(ENTRYTYPENAME, ENTRYARRAYTYPENAME, SELFCLASSNAME, + STDMAPINTERFACENAME, SORTEDMAPINTERFACENAME, KEYSETINTERFACENAME, KEYITRINTERFACENAME, VALUECOLLECTIONINTERFACENAME, + KEYOWNERSHIPDECLARATION, VALUEOWNERSHIPDECLARATION, OWNERSHIPASSIGNMENTS, + KEYCONSTKEYWORD, KEYTYPENAME, KEYDEFAULT, VALUECONSTKEYWORD, VALUETYPENAME, VALUEDEFAULT, + CREATEKEYSET, CREATEVALUECOLLECTION) +//=== { SELFCLASSNAME } ============================================== + +constructor SELFCLASSNAME.Create(ACapacity: IntegerVALUEOWNERSHIPDECLARATIONKEYOWNERSHIPDECLARATION); +begin + inherited Create();OWNERSHIPASSIGNMENTS + SetCapacity(ACapacity); +end; + +destructor SELFCLASSNAME.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure SELFCLASSNAME.AssignDataTo(Dest: TJclAbstractContainerBase); +var + MyDest: SELFCLASSNAME; + Index: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is SELFCLASSNAME then + begin + MyDest := SELFCLASSNAME(Dest); + MyDest.Clear; + MyDest.SetCapacity(FSize); + for Index := 0 to FSize - 1 do + MyDest.FEntries[Index] := FEntries[Index]; + MyDest.FSize := FSize; + end; +end; + +function SELFCLASSNAME.BinarySearch(KEYCONSTKEYWORDKey: KEYTYPENAME): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + LoPos := 0; + HiPos := FSize - 1; + CompPos := (HiPos + LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := KeysCompare(FEntries[CompPos].Key, Key); + if Comp < 0 then + LoPos := CompPos + 1 + else + if Comp > 0 then + HiPos := CompPos - 1 + else + begin + HiPos := CompPos; + LoPos := CompPos + 1; + end; + CompPos := (HiPos + LoPos) div 2; + end; + Result := HiPos; + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.Clear; +var + Index: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + for Index := 0 to FSize - 1 do + begin + FreeKey(FEntries[Index].Key); + FreeValue(FEntries[Index].Value); + end; + FSize := 0; + AutoPack; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.ContainsKey(KEYCONSTKEYWORDKey: KEYTYPENAME): Boolean; +var + Index: Integer; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Index := BinarySearch(Key); + Result := (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.ContainsValue(VALUECONSTKEYWORDValue: VALUETYPENAME): Boolean; +var + Index: Integer; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := True; + Break; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.FirstKey: KEYTYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := KEYDEFAULT; + if FSize > 0 then + Result := FEntries[0].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Extract(KEYCONSTKEYWORDKey: KEYTYPENAME): VALUETYPENAME; +var + Index: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Index := BinarySearch(Key); + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + Result := FEntries[Index].Value; + FEntries[Index].Value := VALUEDEFAULT; + FreeKey(FEntries[Index].Key); + if Index < (FSize - 1) then + MoveArray(FEntries, Index + 1, Index, FSize - Index - 1); + Dec(FSize); + AutoPack; + end + else + Result := VALUEDEFAULT; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.GetValue(KEYCONSTKEYWORDKey: KEYTYPENAME): VALUETYPENAME; +var + Index: Integer; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Index := BinarySearch(Key); + Result := VALUEDEFAULT; + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + Result := FEntries[Index].Value + else if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.HeadMap(KEYCONSTKEYWORDToKey: KEYTYPENAME): SORTEDMAPINTERFACENAME; +var + ToIndex: Integer; + NewMap: SELFCLASSNAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + NewMap := CreateEmptyContainer as SELFCLASSNAME; + ToIndex := BinarySearch(ToKey); + if ToIndex >= 0 then + begin + NewMap.SetCapacity(ToIndex + 1); + NewMap.FSize := ToIndex + 1; + while ToIndex >= 0 do + begin + NewMap.FEntries[ToIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.IsEmpty: Boolean; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := FSize = 0; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.KeyOfValue(VALUECONSTKEYWORDValue: VALUETYPENAME): KEYTYPENAME; +var + Index: Integer; + Found: Boolean; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Found := False; + Result := KEYDEFAULT; + for Index := 0 to FSize - 1 do + if ValuesCompare(FEntries[Index].Value, Value) = 0 then + begin + Result := FEntries[Index].Key; + Found := True; + Break; + end; + + if (not Found) and (not FReturnDefaultElements) then + raise EJclNoSuchElementError.Create(''); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.KeySet: KEYSETINTERFACENAME; +var + Index: Integer; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := CREATEKEYSET; + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Key); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.LastKey: KEYTYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := KEYDEFAULT; + if FSize > 0 then + Result := FEntries[FSize - 1].Key + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.MapEquals(const AMap: STDMAPINTERFACENAME): Boolean; +var + Index: Integer; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if AMap = nil then + Exit; + if FSize <> AMap.Size then + Exit; + for Index := 0 to FSize - 1 do + begin + if AMap.ContainsKey(FEntries[Index].Key) then + begin + if ValuesCompare(AMap.GetValue(FEntries[Index].Key), FEntries[Index].Value) <> 0 then + Exit; + end + else + Exit; + end; + Result := True; + {$JPPEXPANDMACRO UNLOCK} +end; + +{$JPPUNDEF GENERIC}{$IFDEF KEYGENERIC}{$JPPDEFINE GENERIC}{$ENDIF}{$IFDEF VALUEGENERIC}{$JPPDEFINE GENERIC}{$ENDIF}{$JPPUNDEF REFCOUNTED}{$IFDEF KEYREFCOUNTED}{$JPPDEFINE REFCOUNTED}{$ENDIF}{$IFDEF VALUEREFCOUNTED}{$JPPDEFINE REFCOUNTED}{$ENDIF}{$JPPUNDEF ZEROINIT}{$IFDEF KEYZEROINIT}{$JPPDEFINE ZEROINIT}{$ENDIF}{$IFDEF VALUEZEROINIT}{$JPPDEFINE ZEROINIT}{$ENDIF}{$JPPEXPANDMACRO MOVEARRAYIMP[MoveArray|ENTRYARRAYTYPENAME|Default(ENTRYTYPENAME)|SELFCLASSNAME.|]} + +procedure SELFCLASSNAME.PutAll(const AMap: STDMAPINTERFACENAME); +var + It: KEYITRINTERFACENAME; + Key: KEYTYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + if AMap = nil then + Exit; + It := AMap.KeySet.First; + while It.HasNext do + begin + Key := It.Next; + PutValue(Key, AMap.GetValue(Key)); + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.PutValue(KEYCONSTKEYWORDKey: KEYTYPENAME; VALUECONSTKEYWORDValue: VALUETYPENAME); +var + Index: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + if FAllowDefaultElements or ((KeysCompare(Key, KEYDEFAULT) <> 0) and (ValuesCompare(Value, VALUEDEFAULT) <> 0)) then + begin + Index := BinarySearch(Key); + + if (Index >= 0) and (KeysCompare(FEntries[Index].Key, Key) = 0) then + begin + FreeValue(FEntries[Index].Value); + FEntries[Index].Value := Value; + end + else + begin + if FSize = FCapacity then + AutoGrow; + if FSize < FCapacity then + begin + Inc(Index); + if (Index < FSize) and (KeysCompare(FEntries[Index].Key, Key) <> 0) then + MoveArray(FEntries, Index, Index + 1, FSize - Index); + FEntries[Index].Key := Key; + FEntries[Index].Value := Value; + Inc(FSize); + end; + end; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Remove(KEYCONSTKEYWORDKey: KEYTYPENAME): VALUETYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := Extract(Key); + Result := FreeValue(Result); + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.SetCapacity(Value: Integer); +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + if FSize <= Value then + begin + SetLength(FEntries, Value); + inherited SetCapacity(Value); + end + else + raise EJclOperationNotSupportedError.Create; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Size: Integer; +begin + Result := FSize; +end; + +function SELFCLASSNAME.SubMap(KEYCONSTKEYWORDFromKey, ToKey: KEYTYPENAME): SORTEDMAPINTERFACENAME; +var + FromIndex, ToIndex: Integer; + NewMap: SELFCLASSNAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + NewMap := CreateEmptyContainer as SELFCLASSNAME; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + ToIndex := BinarySearch(ToKey); + if (FromIndex >= 0) and (FromIndex <= ToIndex) then + begin + NewMap.SetCapacity(ToIndex - FromIndex + 1); + NewMap.FSize := ToIndex - FromIndex + 1; + while ToIndex >= FromIndex do + begin + NewMap.FEntries[ToIndex - FromIndex] := FEntries[ToIndex]; + Dec(ToIndex); + end; + end; + Result := NewMap; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.TailMap(KEYCONSTKEYWORDFromKey: KEYTYPENAME): SORTEDMAPINTERFACENAME; +var + FromIndex, Index: Integer; + NewMap: SELFCLASSNAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + NewMap := CreateEmptyContainer as SELFCLASSNAME; + FromIndex := BinarySearch(FromKey); + if (FromIndex = -1) or (KeysCompare(FEntries[FromIndex].Key, FromKey) < 0) then + Inc(FromIndex); + if (FromIndex >= 0) and (FromIndex < FSize) then + begin + NewMap.SetCapacity(FSize - FromIndex); + NewMap.FSize := FSize - FromIndex; + Index := FromIndex; + while Index < FSize do + begin + NewMap.FEntries[Index - FromIndex] := FEntries[Index]; + Inc(Index); + end; + end; + Result := NewMap; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Values: VALUECOLLECTIONINTERFACENAME; +var + Index: Integer; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := CREATEVALUECOLLECTION; + for Index := 0 to FSize - 1 do + Result.Add(FEntries[Index].Value); + {$JPPEXPANDMACRO UNLOCK} +end;*) \ No newline at end of file diff --git a/3rdParty/JCL/source/prototypes/containers/JclSortedMaps.int b/3rdParty/JCL/source/prototypes/containers/JclSortedMaps.int new file mode 100644 index 00000000..4cfbf3d3 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclSortedMaps.int @@ -0,0 +1,47 @@ +(*$JPPDEFINEMACRO JCLSORTEDMAPTYPESINT(ENTRYTYPENAME, ENTRYARRAYTYPENAME, KEYTYPENAME, VALUETYPENAME) +ENTRYTYPENAME = record + Key: KEYTYPENAME; + Value: VALUETYPENAME; +end; + +ENTRYARRAYTYPENAME = array of ENTRYTYPENAME;*) +(*$JPPDEFINEMACRO JCLSORTEDMAPINT(ENTRYTYPENAME, ENTRYARRAYTYPENAME, + SELFCLASSNAME, ANCESTORNAME, STDMAPINTERFACENAME, SORTEDMAPINTERFACENAME, KEYSETINTERFACENAME, VALUECOLLECTIONINTERFACENAME, + INTERFACEADDITIONAL, SECTIONADDITIONAL, KEYOWNERSHIPDECLARATION, VALUEOWNERSHIPDECLARATION, + KEYCONSTKEYWORD, KEYTYPENAME, VALUECONSTKEYWORD, VALUETYPENAME) +SELFCLASSNAME = class(ANCESTORNAME, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclGrowable, IJclPackable, IJclBaseContainer,INTERFACEADDITIONAL + STDMAPINTERFACENAME, SORTEDMAPINTERFACENAME)SECTIONADDITIONAL +private + FEntries: ENTRYARRAYTYPENAME; + function BinarySearch(KEYCONSTKEYWORDKey: KEYTYPENAME): Integer; +protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + {$JPPUNDEF GENERIC}{$IFDEF KEYGENERIC}{$JPPDEFINE GENERIC}{$ENDIF}{$IFDEF VALUEGENERIC}{$JPPDEFINE GENERIC}{$ENDIF}{$JPPUNDEF REFCOUNTED}{$IFDEF KEYREFCOUNTED}{$JPPDEFINE REFCOUNTED}{$ENDIF}{$IFDEF VALUEREFCOUNTED}{$JPPDEFINE REFCOUNTED}{$ENDIF}{$JPPUNDEF ZEROINIT}{$IFDEF KEYZEROINIT}{$JPPDEFINE ZEROINIT}{$ENDIF}{$IFDEF VALUEZEROINIT}{$JPPDEFINE ZEROINIT}{$ENDIF}{$JPPEXPANDMACRO MOVEARRAYINT(MoveArray,ENTRYARRAYTYPENAME,)} +public + constructor Create(ACapacity: IntegerVALUEOWNERSHIPDECLARATIONKEYOWNERSHIPDECLARATION); + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { STDMAPINTERFACENAME } + procedure Clear; + function ContainsKey(KEYCONSTKEYWORDKey: KEYTYPENAME): Boolean; + function ContainsValue(VALUECONSTKEYWORDValue: VALUETYPENAME): Boolean; + function Extract(KEYCONSTKEYWORDKey: KEYTYPENAME): VALUETYPENAME; + function GetValue(KEYCONSTKEYWORDKey: KEYTYPENAME): VALUETYPENAME; + function IsEmpty: Boolean; + function KeyOfValue(VALUECONSTKEYWORDValue: VALUETYPENAME): KEYTYPENAME; + function KeySet: KEYSETINTERFACENAME; + function MapEquals(const AMap: STDMAPINTERFACENAME): Boolean; + procedure PutAll(const AMap: STDMAPINTERFACENAME); + procedure PutValue(KEYCONSTKEYWORDKey: KEYTYPENAME; VALUECONSTKEYWORDValue: VALUETYPENAME); + function Remove(KEYCONSTKEYWORDKey: KEYTYPENAME): VALUETYPENAME; + function Size: Integer; + function Values: VALUECOLLECTIONINTERFACENAME; + { SORTEDMAPINTERFACENAME } + function FirstKey: KEYTYPENAME; + function HeadMap(KEYCONSTKEYWORDToKey: KEYTYPENAME): SORTEDMAPINTERFACENAME; + function LastKey: KEYTYPENAME; + function SubMap(KEYCONSTKEYWORDFromKey, ToKey: KEYTYPENAME): SORTEDMAPINTERFACENAME; + function TailMap(KEYCONSTKEYWORDFromKey: KEYTYPENAME): SORTEDMAPINTERFACENAME; +end;*) diff --git a/3rdParty/JCL/source/prototypes/containers/JclStacks.imp b/3rdParty/JCL/source/prototypes/containers/JclStacks.imp new file mode 100644 index 00000000..54afdb53 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclStacks.imp @@ -0,0 +1,122 @@ +(*$JPPDEFINEMACRO JCLSTACKIMP(SELFCLASSNAME, + OWNERSHIPDECLARATION, OWNERSHIPPARAMETERNAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, RELEASERFUNCTIONNAME) +//=== { SELFCLASSNAME } ======================================================= + +constructor SELFCLASSNAME.Create(ACapacity: IntegerOWNERSHIPDECLARATION); +begin + inherited Create(OWNERSHIPPARAMETERNAME); + SetCapacity(ACapacity); +end; + +destructor SELFCLASSNAME.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +procedure SELFCLASSNAME.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: SELFCLASSNAME; + I: Integer; +begin + inherited AssignDataTo(Dest); + if Dest is SELFCLASSNAME then + begin + ADest := SELFCLASSNAME(Dest); + ADest.Clear; + ADest.SetCapacity(FSize + 1); + for I := 0 to FSize - 1 do + ADest.FElements[I] := FElements[I]; + ADest.FSize := FSize; + end; +end; + +procedure SELFCLASSNAME.Clear; +var + I: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + for I := 0 to FSize - 1 do + RELEASERFUNCTIONNAME(FElements[I]); + FSize := 0; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Contains(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + I: Integer; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FElements[I], PARAMETERNAME) then + begin + Result := True; + Break; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Empty: Boolean; +begin + Result := FSize = 0; +end; + +function SELFCLASSNAME.Peek: TYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := DEFAULTVALUE; + if FSize > 0 then + Result := FElements[FSize - 1] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Pop: TYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := DEFAULTVALUE; + if FSize > 0 then + begin + Dec(FSize); + Result := FElements[FSize]; + FElements[FSize] := DEFAULTVALUE; + end + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + AutoPack; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Push(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FElements[FSize] := PARAMETERNAME; + Inc(FSize); + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.SetCapacity(Value: Integer); +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + if Value < FSize then + raise EJclOutOfBoundsError.Create; + SetLength(FElements, Value); + inherited SetCapacity(Value); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Size: Integer; +begin + Result := FSize; +end;*) \ No newline at end of file diff --git a/3rdParty/JCL/source/prototypes/containers/JclStacks.int b/3rdParty/JCL/source/prototypes/containers/JclStacks.int new file mode 100644 index 00000000..38927117 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclStacks.int @@ -0,0 +1,25 @@ +(*$JPPDEFINEMACRO JCLSTACKINT(SELFCLASSNAME, BASECONTAINERINTERFACENAME, STACKINTERFACENAME, ANCESTORCLASSNAME, DYNARRAYTYPENAME, + EQUALITYCOMPARERINTERFACENAME, INTERFACEADDITIONAL, + SECTIONADDITIONAL, OWNERSHIPDECLARATION, CONSTKEYWORD, PARAMETERNAME, TYPENAME) +SELFCLASSNAME = class(ANCESTORCLASSNAME, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + BASECONTAINERINTERFACENAME, EQUALITYCOMPARERINTERFACENAME,INTERFACEADDITIONAL + STACKINTERFACENAME)SECTIONADDITIONAL +private + FElements: DYNARRAYTYPENAME; +protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; +public + constructor Create(ACapacity: IntegerOWNERSHIPDECLARATION); + destructor Destroy; override; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { STACKINTERFACENAME } + procedure Clear; + function Contains(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function Empty: Boolean; + function Peek: TYPENAME; + function Pop: TYPENAME; + function Push(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function Size: Integer; +end;*) diff --git a/3rdParty/JCL/source/prototypes/containers/JclTrees.imp b/3rdParty/JCL/source/prototypes/containers/JclTrees.imp new file mode 100644 index 00000000..9f4abfe0 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclTrees.imp @@ -0,0 +1,1058 @@ +(*$JPPDEFINEMACRO JCLTREEITRIMP(BASEITRCLASSNAME, PREORDERITRCLASSNAME, POSTORDERITRCLASSNAME, NODETYPENAME, TREECLASSNAME, + STDITRINTERFACENAME, TREEITRINTERFACENAME, EQUALITYCOMPARERINTERFACENAME, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, GETTERFUNCTIONNAME, SETTERPROCEDURENAME, RELEASERFUNCTIONNAME) +//=== { BASEITRCLASSNAME } =========================================================== + +constructor BASEITRCLASSNAME.Create(OwnTree: TREECLASSNAME; ACursor: NODETYPENAME; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FCursor := ACursor; + FOwnTree := OwnTree; + FStart := AStart; + FEqualityComparer := OwnTree as EQUALITYCOMPARERINTERFACENAME; +end; + +function BASEITRCLASSNAME.Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + ParentNode, NewNode: NODETYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + // add sibling or, if FCursor is root node, behave like TREECLASSNAME.Add + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(PARAMETERNAME, DEFAULTVALUE)) + and ((not FOwnTree.Contains(PARAMETERNAME)) or FOwnTree.CheckDuplicate); + + if Result then + begin + ParentNode := FCursor.Parent; + if ParentNode = nil then + ParentNode := FCursor; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := NODETYPENAME.Create; + NewNode.Value := PARAMETERNAME; + NewNode.Parent := ParentNode; + ParentNode.Children[ParentNode.ChildrenCount] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.AddChild(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + NewNode: NODETYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(PARAMETERNAME, DEFAULTVALUE)) + and ((not FOwnTree.Contains(PARAMETERNAME)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := NODETYPENAME.Create; + NewNode.Value := PARAMETERNAME; + NewNode.Parent := FCursor; + FCursor.Children[FCursor.ChildrenCount] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +procedure BASEITRCLASSNAME.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: BASEITRCLASSNAME; +begin + inherited AssignPropertiesTo(Dest); + if Dest is BASEITRCLASSNAME then + begin + ADest := BASEITRCLASSNAME(Dest); + ADest.FCursor := FCursor; + ADest.FOwnTree := FOwnTree; + ADest.FEqualityComparer := FEqualityComparer; + ADest.FStart := FStart; + end; +end; + +function BASEITRCLASSNAME.ChildrenCount: Integer; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + if FCursor <> nil then + Result := FCursor.ChildrenCount + else + Result := 0; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +procedure BASEITRCLASSNAME.DeleteChild(Index: Integer); +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.RemoveNode(NODETYPENAME(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +procedure BASEITRCLASSNAME.DeleteChildren; +var + Index: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.RemoveNode(NODETYPENAME(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.RemoveNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +procedure BASEITRCLASSNAME.Extract; +var + OldCursor: NODETYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.ExtractNode(OldCursor); + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +procedure BASEITRCLASSNAME.ExtractChild(Index: Integer); +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + {$IFDEF BCB} + FOwnTree.ExtractNode(NODETYPENAME(FCursor.Children[Index])) + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]) + {$ENDIF ~BCB} + else + raise EJclOutOfBoundsError.Create; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +procedure BASEITRCLASSNAME.ExtractChildren; +var + Index: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + if FCursor <> nil then + begin + for Index := FCursor.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + FOwnTree.ExtractNode(NODETYPENAME(FCursor.Children[Index])); + {$ELSE ~BCB} + FOwnTree.ExtractNode(FCursor.Children[Index]); + {$ENDIF ~BCB} + SetLength(FCursor.Children, 0); + FCursor.ChildrenCount := 0; + end; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.GetChild(Index: Integer): TYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + Result := DEFAULTVALUE; + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + FCursor := NODETYPENAME(FCursor.Children[Index]); + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.GETTERFUNCTIONNAME: TYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + CheckValid; + Result := DEFAULTVALUE; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.HasChild(Index: Integer): Boolean; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + Result := (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount); + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.HasNext: Boolean; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + if Valid then + Result := GetNextCursor <> nil + else + Result := FCursor <> nil; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.HasParent: Boolean; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + Result := (FCursor <> nil) and (FCursor.Parent <> nil); + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.HasPrevious: Boolean; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + if Valid then + Result := GetPreviousCursor <> nil + else + Result := FCursor <> nil; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.IndexOfChild(CONSTKEYWORDPARAMETERNAME: TYPENAME): Integer; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + if FCursor <> nil then + Result := FCursor.IndexOfValue(PARAMETERNAME, FEqualityComparer) + else + Result := -1; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.Insert(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + ParentNode, NewNode: NODETYPENAME; + Index, I: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + // insert sibling or, if FCursor is root node, behave like TREECLASSNAME.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(PARAMETERNAME, DEFAULTVALUE)) + and ((not FOwnTree.Contains(PARAMETERNAME)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.Parent <> nil then + begin + ParentNode := FCursor.Parent; + Index := 0; + while (Index < ParentNode.ChildrenCount) and (ParentNode.Children[Index] <> FCursor) do + Inc(Index); + end + else + begin + ParentNode := FCursor; + Index := 0; + end; + + if ParentNode.ChildrenCount = Length(ParentNode.Children) then + SetLength(ParentNode.Children, FOwnTree.CalcGrowCapacity(Length(ParentNode.Children), ParentNode.ChildrenCount)); + if ParentNode.ChildrenCount < Length(ParentNode.Children) then + begin + NewNode := NODETYPENAME.Create; + NewNode.Value := PARAMETERNAME; + NewNode.Parent := ParentNode; + for I := ParentNode.ChildrenCount - 1 downto Index do + ParentNode.Children[I + 1] := ParentNode.Children[I]; + ParentNode.Children[Index] := NewNode; + Inc(ParentNode.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.InsertChild(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + NewNode: NODETYPENAME; + I: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + // insert sibling or, if FCursor is root node, behave like TREECLASSNAME.Insert + Result := (FCursor <> nil) and (FOwnTree.AllowDefaultElements or not FEqualityComparer.ItemsEqual(PARAMETERNAME, DEFAULTVALUE)) + and ((not FOwnTree.Contains(PARAMETERNAME)) or FOwnTree.CheckDuplicate); + + if Result then + begin + if FCursor.ChildrenCount = Length(FCursor.Children) then + SetLength(FCursor.Children, FOwnTree.CalcGrowCapacity(Length(FCursor.Children), FCursor.ChildrenCount)); + if FCursor.ChildrenCount < Length(FCursor.Children) then + begin + NewNode := NODETYPENAME.Create; + NewNode.Value := PARAMETERNAME; + NewNode.Parent := FCursor; + for I := FCursor.ChildrenCount - 1 downto Index do + FCursor.Children[I + 1] := FCursor.Children[I]; + FCursor.Children[Index] := NewNode; + Inc(FCursor.ChildrenCount); + Inc(FOwnTree.FSize); + end; + end; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.IteratorEquals(const AIterator: STDITRINTERFACENAME): Boolean; +var + Obj: TObject; + ItrObj: BASEITRCLASSNAME; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is BASEITRCLASSNAME then + begin + ItrObj := BASEITRCLASSNAME(Obj); + Result := (FOwnTree = ItrObj.FOwnTree) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function BASEITRCLASSNAME.MoveNext: Boolean; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := FCursor <> nil; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; +{$ENDIF SUPPORTS_FOR_IN} + +function BASEITRCLASSNAME.Next: TYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + if Valid then + FCursor := GetNextCursor + else + Valid := True; + Result := DEFAULTVALUE; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.NextIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +function BASEITRCLASSNAME.Parent: TYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + Result := DEFAULTVALUE; + if FCursor <> nil then + FCursor := FCursor.Parent; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.Previous: TYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + if Valid then + FCursor := GetPreviousCursor + else + Valid := True; + Result := DEFAULTVALUE; + if FCursor <> nil then + Result := FCursor.Value + else + if not FOwnTree.ReturnDefaultElements then + raise EJclNoSuchElementError.Create(''); + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +function BASEITRCLASSNAME.PreviousIndex: Integer; +begin + // No index + raise EJclOperationNotSupportedError.Create; +end; + +procedure BASEITRCLASSNAME.Remove; +var + OldCursor: NODETYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + CheckValid; + Valid := False; + OldCursor := FCursor; + FCursor := GetNextSibling; + if OldCursor <> nil then + FOwnTree.RemoveNode(OldCursor); + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +procedure BASEITRCLASSNAME.Reset; +var + NewCursor: NODETYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + Valid := False; + case FStart of + isFirst: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetPreviousCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isLast: + begin + NewCursor := FCursor; + while NewCursor <> nil do + begin + NewCursor := GetNextCursor; + if NewCursor <> nil then + FCursor := NewCursor; + end; + end; + isRoot: + begin + while (FCursor <> nil) and (FCursor.Parent <> nil) do + FCursor := FCursor.Parent; + end; + end; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +procedure BASEITRCLASSNAME.SetChild(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME); +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + if (FCursor <> nil) and (Index >= 0) and (Index < FCursor.ChildrenCount) then + NODETYPENAME(FCursor.Children[Index]).Value := PARAMETERNAME + else + raise EJclOutOfBoundsError.Create; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +procedure BASEITRCLASSNAME.SETTERPROCEDURENAME(CONSTKEYWORDPARAMETERNAME: TYPENAME); +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO DELEGATELOCK(FOwnTree)} + CheckValid; + if FCursor <> nil then + begin + FOwnTree.RELEASERFUNCTIONNAME(FCursor.Value); + FCursor.Value := PARAMETERNAME; + end; + {$JPPEXPANDMACRO DELEGATEUNLOCK(FOwnTree)} +end; + +//=== { PREORDERITRCLASSNAME } =================================================== + +function PREORDERITRCLASSNAME.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := PREORDERITRCLASSNAME.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function PREORDERITRCLASSNAME.GetNextCursor: NODETYPENAME; +var + LastRet: NODETYPENAME; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + if Result.ChildrenCount > 0 then + Result := NODETYPENAME(Result.Children[0]) + else + begin + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := NODETYPENAME(Result.Children[Result.IndexOfChild(LastRet) + 1]); + end; +end; + +function PREORDERITRCLASSNAME.GetNextSibling: NODETYPENAME; +var + LastRet: NODETYPENAME; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = (Result.ChildrenCount - 1)) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root = return successor + Result := NODETYPENAME(Result.Children[Result.IndexOfChild(LastRet) + 1]); +end; + +function PREORDERITRCLASSNAME.GetPreviousCursor: NODETYPENAME; +var + LastRet: NODETYPENAME; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) > 0) then + // come from Right + begin + Result := NODETYPENAME(Result.Children[Result.IndexOfChild(LastRet) - 1]); + while (Result.ChildrenCount > 0) do // descend down the tree + Result := NODETYPENAME(Result.Children[Result.ChildrenCount - 1]); + end; +end; + +//=== { POSTORDERITRCLASSNAME } ================================================== + +function POSTORDERITRCLASSNAME.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := POSTORDERITRCLASSNAME.Create(FOwnTree, FCursor, Valid, FStart); +end; + +function POSTORDERITRCLASSNAME.GetNextCursor: NODETYPENAME; +var + LastRet: NODETYPENAME; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := NODETYPENAME(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := NODETYPENAME(Result.Children[0]); + end; +end; + +function POSTORDERITRCLASSNAME.GetNextSibling: NODETYPENAME; +var + LastRet: NODETYPENAME; +begin + Result := FCursor; + if Result = nil then + Exit; + LastRet := Result; + Result := Result.Parent; + + if (Result <> nil) and (Result.IndexOfChild(LastRet) <> (Result.ChildrenCount - 1)) then + begin + Result := NODETYPENAME(Result.Children[Result.IndexOfChild(LastRet) + 1]); + while Result.ChildrenCount > 0 do + Result := NODETYPENAME(Result.Children[0]); + end; +end; + +function POSTORDERITRCLASSNAME.GetPreviousCursor: NODETYPENAME; +var + LastRet: NODETYPENAME; +begin + Result := FCursor; + if Result = nil then + Exit; + if Result.ChildrenCount > 0 then + Result := NODETYPENAME(Result.Children[Result.ChildrenCount - 1]) + else + begin + LastRet := Result; + Result := Result.Parent; + while (Result <> nil) and (Result.IndexOfChild(LastRet) = 0) do + begin + LastRet := Result; + Result := Result.Parent; + end; + if Result <> nil then // not root + Result := NODETYPENAME(Result.Children[Result.IndexOfChild(LastRet) - 1]); + end; +end;*) +(*$JPPDEFINEMACRO JCLTREETYPESIMP(NODETYPENAME, EQUALITYCOMPARERINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME) +//=== { NODETYPENAME } ======================================================= + +function NODETYPENAME.IndexOfChild(AChild: NODETYPENAME): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if Children[Result] = AChild then + Exit; + Result := -1; +end; + +function NODETYPENAME.IndexOfValue(CONSTKEYWORDPARAMETERNAME: TYPENAME; + const AEqualityComparer: EQUALITYCOMPARERINTERFACENAME): Integer; +begin + for Result := 0 to ChildrenCount - 1 do + if AEqualityComparer.ItemsEqual(NODETYPENAME(Children[Result]).Value, PARAMETERNAME) then + Exit; + Result := -1; +end;*) +(*$JPPDEFINEMACRO JCLTREEIMP(NODETYPENAME, SELFCLASSNAME, PREORDERITRCLASSNAME, POSTORDERITRCLASSNAME, + COLLECTIONINTERFACENAME, STDITRINTERFACENAME, TREEITRINTERFACENAME, + EQUALITYCOMPARERINTERFACENAME, OWNERSHIPDECLARATION, OWNERSHIPPARAMETERNAME, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, RELEASERFUNCTIONNAME) +//=== { SELFCLASSNAME } ======================================================= + +constructor SELFCLASSNAME.Create(OWNERSHIPDECLARATION); +begin + inherited Create(OWNERSHIPPARAMETERNAME); + FTraverseOrder := toPreOrder; +end; + +destructor SELFCLASSNAME.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function SELFCLASSNAME.Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + NewNode: NODETYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := AllowDefaultElements or not ItemsEqual(PARAMETERNAME, DEFAULTVALUE); + + if Result then + begin + if FRoot <> nil then + begin + Result := (not Contains(PARAMETERNAME)) or CheckDuplicate; + if Result then + begin + if FRoot.ChildrenCount = Length(FRoot.Children) then + SetLength(FRoot.Children, CalcGrowCapacity(Length(FRoot.Children), FRoot.ChildrenCount)); + if FRoot.ChildrenCount < Length(FRoot.Children) then + begin + NewNode := NODETYPENAME.Create; + NewNode.Value := PARAMETERNAME; + NewNode.Parent := FRoot; + FRoot.Children[FRoot.ChildrenCount] := NewNode; + Inc(FRoot.ChildrenCount); + Inc(FSize); + end + else + Result := False; + end; + end + else + begin + FRoot := NODETYPENAME.Create; + FRoot.Value := PARAMETERNAME; + Inc(FSize); + end; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.AddAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: STDITRINTERFACENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: SELFCLASSNAME; + ACollection: COLLECTIONINTERFACENAME; +begin + inherited AssignDataTo(Dest); + if Dest is SELFCLASSNAME then + begin + ADest := SELFCLASSNAME(Dest); + ADest.Clear; + ADest.FSize := FSize; + if FRoot <> nil then + ADest.FRoot := CloneNode(FRoot, nil); + end + else + if Supports(IInterface(Dest), COLLECTIONINTERFACENAME, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure SELFCLASSNAME.AssignPropertiesTo(Dest: TJclAbstractContainerBase); +begin + inherited AssignPropertiesto(Dest); + if Dest is SELFCLASSNAME then + SELFCLASSNAME(Dest).FTraverseOrder := FTraverseOrder; +end; + +procedure SELFCLASSNAME.Clear; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + if FRoot <> nil then + RemoveNode(FRoot); + FSize := 0; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.CloneNode(Node, Parent: NODETYPENAME): NODETYPENAME; +var + Index: Integer; +begin + Result := NODETYPENAME.Create; + Result.Value := Node.Value; + Result.Parent := Parent; + SetLength(Result.Children, Node.ChildrenCount); + Result.ChildrenCount := Node.ChildrenCount; + for Index := 0 to Node.ChildrenCount - 1 do + Result.Children[Index] := CloneNode(NODETYPENAME(Node.Children[Index]), Result); // recursive call +end; + +function SELFCLASSNAME.CollectionEquals(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It, ItSelf: STDITRINTERFACENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + Result := True; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if not ItemsEqual(ItSelf.Next, It.Next) then + begin + Result := False; + Break; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Contains(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + if FRoot <> nil then + Result := NodeContains(FRoot, PARAMETERNAME) + else + Result := False; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.ContainsAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: STDITRINTERFACENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Extract(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + It: STDITRINTERFACENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := FRoot <> nil; + if Result then + begin + It := First; + while It.HasNext do + if ItemsEqual(It.Next, PARAMETERNAME) then + begin + It.Extract; + if RemoveSingleElement then + Break; + end; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.ExtractAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: STDITRINTERFACENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.ExtractNode(var ANode: NODETYPENAME); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: NODETYPENAME; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + ExtractNode(NODETYPENAME(ANode.Children[Index])); + {$ELSE ~BCB} + ExtractNode(ANode.Children[Index]); + {$ENDIF ~BCB} + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function SELFCLASSNAME.First: STDITRINTERFACENAME; +var + Start: NODETYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Start := FRoot; + case GetTraverseOrder of + toPreOrder: + Result := PREORDERITRCLASSNAME.Create(Self, Start, False, isFirst); + toPostOrder: + begin + if Start <> nil then + while (Start.ChildrenCount > 0) do + Start := NODETYPENAME(Start.Children[0]); + Result := POSTORDERITRCLASSNAME.Create(Self, Start, False, isFirst); + end; + else + Result := nil; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +{$IFDEF SUPPORTS_FOR_IN} +function SELFCLASSNAME.GetEnumerator: STDITRINTERFACENAME; +begin + Result := First; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function SELFCLASSNAME.GetRoot: TREEITRINTERFACENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + case GetTraverseOrder of + toPreOrder: + Result := PREORDERITRCLASSNAME.Create(Self, FRoot, False, isRoot); + toPostOrder: + Result := POSTORDERITRCLASSNAME.Create(Self, FRoot, False, isRoot); + else + Result := nil; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function SELFCLASSNAME.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function SELFCLASSNAME.Last: STDITRINTERFACENAME; +var + Start: NODETYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while Start.ChildrenCount > 0 do + Start := NODETYPENAME(Start.Children[Start.ChildrenCount - 1]); + Result := PREORDERITRCLASSNAME.Create(Self, Start, False, isLast); + end; + toPostOrder: + Result := POSTORDERITRCLASSNAME.Create(Self, Start, False, isLast); + else + Result := nil; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.NodeContains(ANode: NODETYPENAME; CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + Index: Integer; +begin + Result := ItemsEqual(ANode.Value, PARAMETERNAME); + if not Result then + for Index := 0 to ANode.ChildrenCount - 1 do + begin + Result := NodeContains(NODETYPENAME(ANode.Children[Index]), PARAMETERNAME); + if Result then + Break; + end; +end; + +procedure SELFCLASSNAME.Pack; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + if FRoot <> nil then + PackNode(FRoot); + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.PackNode(ANode: NODETYPENAME); +var + Index: Integer; +begin + SetLength(ANode.Children, ANode.ChildrenCount); + for Index := 0 to ANode.ChildrenCount - 1 do + PackNode(NODETYPENAME(ANode.Children[Index])); +end; + +function SELFCLASSNAME.Remove(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + Extracted: TYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := Extract(PARAMETERNAME); + if Result then + begin + Extracted := PARAMETERNAME; + RELEASERFUNCTIONNAME(Extracted); + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.RemoveAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: STDITRINTERFACENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.RemoveNode(var ANode: NODETYPENAME); +var + Index, ChildIndex, NewCapacity: Integer; + Parent: NODETYPENAME; +begin + for Index := ANode.ChildrenCount - 1 downto 0 do + {$IFDEF BCB} + RemoveNode(NODETYPENAME(ANode.Children[Index])); + {$ELSE ~BCB} + RemoveNode(ANode.Children[Index]); + {$ENDIF ~BCB} + RELEASERFUNCTIONNAME(ANode.Value); + Parent := ANode.Parent; + if Parent <> nil then + begin + ChildIndex := Parent.IndexOfChild(ANode); + for Index := ChildIndex + 1 to Parent.ChildrenCount - 1 do + Parent.Children[Index - 1] := Parent.Children[Index]; + Dec(Parent.ChildrenCount); + NewCapacity := CalcPackCapacity(Length(Parent.Children), Parent.ChildrenCount); + if NewCapacity < Length(Parent.Children) then + SetLength(Parent.Children, NewCapacity); + FreeAndNil(ANode); + end + else + begin + FreeAndNil(ANode); + FRoot := nil; + end; + Dec(FSize); +end; + +function SELFCLASSNAME.RetainAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: STDITRINTERFACENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.SetCapacity(Value: Integer); +begin + raise EJclOperationNotSupportedError.Create; +end; + +procedure SELFCLASSNAME.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function SELFCLASSNAME.Size: Integer; +begin + Result := FSize; +end;*) diff --git a/3rdParty/JCL/source/prototypes/containers/JclTrees.int b/3rdParty/JCL/source/prototypes/containers/JclTrees.int new file mode 100644 index 00000000..76712e72 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclTrees.int @@ -0,0 +1,133 @@ +(*$JPPDEFINEMACRO JCLTREETYPESINT(NODETYPENAME, EQUALITYCOMPARERINTERFACENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME) +NODETYPENAME = class +public + Value: TYPENAME; + {$IFDEF BCB} + Children: TDynObjectArray; + {$ELSE ~BCB} + Children: array of NODETYPENAME; + {$ENDIF ~BCB} + ChildrenCount: Integer; + Parent: NODETYPENAME; + function IndexOfChild(AChild: NODETYPENAME): Integer; + function IndexOfValue(CONSTKEYWORDPARAMETERNAME: TYPENAME; const AEqualityComparer: EQUALITYCOMPARERINTERFACENAME): Integer; +end;*) +(*$JPPDEFINEMACRO JCLTREEINT(NODETYPENAME, SELFCLASSNAME, ANCESTORCLASSNAME, BASECONTAINERINTERFACENAME, FLATCONTAINERINTERFACENAME, + EQUALITYCOMPARERINTERFACENAME, COLLECTIONINTERFACENAME, TREEINTERFACENAME, STDITRINTERFACENAME, TREEITRINTERFACENAME, + INTERFACEADDITIONAL, SECTIONADDITIONAL, COLLECTIONFLAGS, OWNERSHIPDECLARATION, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE) +SELFCLASSNAME = class(ANCESTORCLASSNAME, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + BASECONTAINERINTERFACENAME, FLATCONTAINERINTERFACENAME, EQUALITYCOMPARERINTERFACENAME,INTERFACEADDITIONAL + COLLECTIONINTERFACENAME, TREEINTERFACENAME)SECTIONADDITIONAL +private + FRoot: NODETYPENAME; + FTraverseOrder: TJclTraverseOrder; +protected + procedure ExtractNode(var ANode: NODETYPENAME); + procedure RemoveNode(var ANode: NODETYPENAME); + function CloneNode(Node, Parent: NODETYPENAME): NODETYPENAME; + function NodeContains(ANode: NODETYPENAME; CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + procedure PackNode(ANode: NODETYPENAME); + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + procedure AssignPropertiesTo(Dest: TJclAbstractContainerBase); override; +public + constructor Create(OWNERSHIPDECLARATION); + destructor Destroy; override; + { IJclPackable } + procedure Pack; override; + procedure SetCapacity(Value: Integer); override; + { COLLECTIONINTERFACENAME } + function Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean;COLLECTIONFLAGS + function AddAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + procedure Clear;COLLECTIONFLAGS + function CollectionEquals(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function Contains(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean;COLLECTIONFLAGS + function ContainsAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function Extract(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean;COLLECTIONFLAGS + function ExtractAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function First: STDITRINTERFACENAME;COLLECTIONFLAGS + function IsEmpty: Boolean;COLLECTIONFLAGS + function Last: STDITRINTERFACENAME;COLLECTIONFLAGS + function Remove(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean;COLLECTIONFLAGS + function RemoveAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function RetainAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function Size: Integer;COLLECTIONFLAGS + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: STDITRINTERFACENAME;COLLECTIONFLAGS + {$ENDIF SUPPORTS_FOR_IN} + { TREEINTERFACENAME } + function GetRoot: TREEITRINTERFACENAME; + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property Root: TREEITRINTERFACENAME read GetRoot; + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; +end;*) +(*$JPPDEFINEMACRO JCLTREEITRINT(BASEITRCLASSNAME, PREORDERITRCLASSNAME, POSTORDERITRCLASSNAME, NODETYPENAME, TREECLASSNAME, + STDITRINTERFACENAME, TREEITRINTERFACENAME, EQUALITYCOMPARERINTERFACENAME, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) +BASEITRCLASSNAME = class(TJclAbstractIterator, STDITRINTERFACENAME, TREEITRINTERFACENAME) +protected + FCursor: NODETYPENAME; + FStart: TItrStart; + FOwnTree: TREECLASSNAME; + FEqualityComparer: EQUALITYCOMPARERINTERFACENAME; // keep a reference of tree interface + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; + function GetNextCursor: NODETYPENAME; virtual; abstract; + // return next node on the same level + function GetNextSibling: NODETYPENAME; virtual; abstract; + function GetPreviousCursor: NODETYPENAME; virtual; abstract; +public + constructor Create(OwnTree: TREECLASSNAME; ACursor: NODETYPENAME; AValid: Boolean; AStart: TItrStart); + { STDITRINTERFACENAME } + function Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + procedure Extract; + function GETTERFUNCTIONNAME: TYPENAME; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function IteratorEquals(const AIterator: STDITRINTERFACENAME): Boolean; + function Next: TYPENAME; + function NextIndex: Integer; + function Previous: TYPENAME; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SETTERPROCEDURENAME(CONSTKEYWORDPARAMETERNAME: TYPENAME); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: TYPENAME read GETTERFUNCTIONNAME; + {$ENDIF SUPPORTS_FOR_IN} + { TREEITRINTERFACENAME } + function AddChild(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function ChildrenCount: Integer; + procedure DeleteChild(Index: Integer); + procedure DeleteChildren; + procedure ExtractChild(Index: Integer); + procedure ExtractChildren; + function GetChild(Index: Integer): TYPENAME; + function HasChild(Index: Integer): Boolean; + function HasParent: Boolean; + function IndexOfChild(CONSTKEYWORDPARAMETERNAME: TYPENAME): Integer; + function InsertChild(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function Parent: TYPENAME; + procedure SetChild(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME); +end; + +PREORDERITRCLASSNAME = class(BASEITRCLASSNAME, STDITRINTERFACENAME, TREEITRINTERFACENAME, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) +protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: NODETYPENAME; override; + function GetNextSibling: NODETYPENAME; override; + function GetPreviousCursor: NODETYPENAME; override; +end; + +POSTORDERITRCLASSNAME = class(BASEITRCLASSNAME, STDITRINTERFACENAME, TREEITRINTERFACENAME, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) +protected + function CreateEmptyIterator: TJclAbstractIterator; override; + function GetNextCursor: NODETYPENAME; override; + function GetNextSibling: NODETYPENAME; override; + function GetPreviousCursor: NODETYPENAME; override; +end;*) diff --git a/3rdParty/JCL/source/prototypes/containers/JclVectors.imp b/3rdParty/JCL/source/prototypes/containers/JclVectors.imp new file mode 100644 index 00000000..d6001778 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclVectors.imp @@ -0,0 +1,597 @@ +(*$JPPDEFINEMACRO JCLVECTORITRIMP(SELFCLASSNAME, ITRINTERFACENAME, LISTCLASSNAME, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) +//=== { SELFCLASSNAME } =========================================================== + +constructor SELFCLASSNAME.Create(AOwnList: LISTCLASSNAME; ACursor: Integer; AValid: Boolean; AStart: TItrStart); +begin + inherited Create(AValid); + FOwnList := AOwnList; + FStart := AStart; + FCursor := ACursor; +end; + +function SELFCLASSNAME.Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +begin + Result := FOwnList.Add(PARAMETERNAME); +end; + +procedure SELFCLASSNAME.AssignPropertiesTo(Dest: TJclAbstractIterator); +var + ADest: SELFCLASSNAME; +begin + inherited AssignPropertiesTo(Dest); + if Dest is SELFCLASSNAME then + begin + ADest := SELFCLASSNAME(Dest); + ADest.FOwnList := FOwnList; + ADest.FCursor := FCursor; + ADest.FStart := FStart; + end; +end; + +function SELFCLASSNAME.CreateEmptyIterator: TJclAbstractIterator; +begin + Result := SELFCLASSNAME.Create(FOwnList, FCursor, Valid, FStart); +end; + +procedure SELFCLASSNAME.Extract; +begin + CheckValid; + Valid := False; + FOwnList.ExtractIndex(FCursor); +end; + +function SELFCLASSNAME.GETTERFUNCTIONNAME: TYPENAME; +begin + CheckValid; + Result := FOwnList.GETTERFUNCTIONNAME(FCursor); +end; + +function SELFCLASSNAME.HasNext: Boolean; +begin + if Valid then + Result := FCursor < (FOwnList.Size - 1) + else + Result := FCursor < FOwnList.Size; +end; + +function SELFCLASSNAME.HasPrevious: Boolean; +begin + if Valid then + Result := FCursor > 0 + else + Result := FCursor >= 0; +end; + +function SELFCLASSNAME.Insert(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +begin + CheckValid; + Result := FOwnList.Insert(FCursor, PARAMETERNAME); +end; + +function SELFCLASSNAME.IteratorEquals(const AIterator: ITRINTERFACENAME): Boolean; +var + Obj: TObject; + ItrObj: SELFCLASSNAME; +begin + Result := False; + if AIterator = nil then + Exit; + Obj := AIterator.GetIteratorReference; + if Obj is SELFCLASSNAME then + begin + ItrObj := SELFCLASSNAME(Obj); + Result := (FOwnList = ItrObj.FOwnList) and (FCursor = ItrObj.FCursor) and (Valid = ItrObj.Valid); + end; +end; + +{$IFDEF SUPPORTS_FOR_IN} +function SELFCLASSNAME.MoveNext: Boolean; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FCursor < FOwnList.Size; +end; +{$ENDIF SUPPORTS_FOR_IN} + +function SELFCLASSNAME.Next: TYPENAME; +begin + if Valid then + Inc(FCursor) + else + Valid := True; + Result := FOwnList.GETTERFUNCTIONNAME(FCursor); +end; + +function SELFCLASSNAME.NextIndex: Integer; +begin + if Valid then + Result := FCursor + 1 + else + Result := FCursor; +end; + +function SELFCLASSNAME.Previous: TYPENAME; +begin + if Valid then + Dec(FCursor) + else + Valid := True; + Result := FOwnList.GETTERFUNCTIONNAME(FCursor); +end; + +function SELFCLASSNAME.PreviousIndex: Integer; +begin + if Valid then + Result := FCursor - 1 + else + Result := FCursor; +end; + +procedure SELFCLASSNAME.Remove; +begin + CheckValid; + Valid := False; + FOwnList.Delete(FCursor); +end; + +procedure SELFCLASSNAME.Reset; +begin + Valid := False; + case FStart of + isFirst: + FCursor := 0; + isLast: + FCursor := FOwnList.Size - 1; + end; +end; + +procedure SELFCLASSNAME.SETTERPROCEDURENAME(CONSTKEYWORDPARAMETERNAME: TYPENAME); +begin + CheckValid; + FOwnList.SETTERPROCEDURENAME(FCursor, PARAMETERNAME); +end;*) +(*$JPPDEFINEMACRO JCLVECTORIMP(SELFCLASSNAME, COLLECTIONINTERFACENAME, LISTINTERFACENAME, ITRINTERFACENAME, ITRCLASSNAME, + OWNERSHIPDECLARATION, OWNERSHIPPARAMETERNAME, MOVEARRAYPROCEDURENAME, CONSTKEYWORD, PARAMETERNAME, TYPENAME, DEFAULTVALUE, + GETTERFUNCTIONNAME, SETTERPROCEDURENAME, RELEASERFUNCTIONNAME) +//=== { SELFCLASSNAME } ====================================================== + +constructor SELFCLASSNAME.Create(ACapacity: IntegerOWNERSHIPDECLARATION); +begin + inherited Create(OWNERSHIPPARAMETERNAME); + SetCapacity(ACapacity); +end; + +constructor SELFCLASSNAME.Create(const ACollection: COLLECTIONINTERFACENAMEOWNERSHIPDECLARATION); +begin + inherited Create(OWNERSHIPPARAMETERNAME); + if ACollection = nil then + raise EJclNoCollectionError.Create; + SetCapacity(ACollection.Size); + AddAll(ACollection); +end; + +destructor SELFCLASSNAME.Destroy; +begin + FReadOnly := False; + Clear; + inherited Destroy; +end; + +function SELFCLASSNAME.Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + Index: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := FAllowDefaultElements or not ItemsEqual(PARAMETERNAME, DEFAULTVALUE); + if Result then + begin + if FDuplicates <> dupAccept then + for Index := 0 to FSize - 1 do + if ItemsEqual(PARAMETERNAME, FItems[Index]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + FItems[FSize] := PARAMETERNAME; + Inc(FSize); + end; + end; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.AddAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: ITRINTERFACENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.AssignDataTo(Dest: TJclAbstractContainerBase); +var + ADest: SELFCLASSNAME; + ACollection: COLLECTIONINTERFACENAME; +begin + inherited AssignDataTo(Dest); + if Dest is SELFCLASSNAME then + begin + ADest := SELFCLASSNAME(Dest); + ADest.Clear; + ADest.AddAll(Self); + end + else + if Supports(IInterface(Dest), COLLECTIONINTERFACENAME, ACollection) then + begin + ACollection.Clear; + ACollection.AddAll(Self); + end; +end; + +procedure SELFCLASSNAME.Clear; +var + I: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + for I := 0 to FSize - 1 do + RELEASERFUNCTIONNAME(FItems[I]); + FSize := 0; + AutoPack; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.CollectionEquals(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + I: Integer; + It: ITRINTERFACENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FSize - 1 do + if not ItemsEqual(FItems[I], It.Next) then + Exit; + Result := True; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Contains(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + I: Integer; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], PARAMETERNAME) then + begin + Result := True; + Break; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.ContainsAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: ITRINTERFACENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Delete(Index: Integer): TYPENAME; +var + Extracted: TYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Extracted := ExtractIndex(Index); + Result := RELEASERFUNCTIONNAME(Extracted); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Extract(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + I: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], PARAMETERNAME) then + begin + if I < (FSize - 1) then + MOVEARRAYPROCEDURENAME(FItems, I + 1, I, FSize - 1 - I) + else + FItems[I] := DEFAULTVALUE; + Dec(FSize); + Result := True; + if FRemoveSingleElement then + Break; + end; + AutoPack; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.ExtractAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: ITRINTERFACENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Extract(It.Next) and Result; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.ExtractIndex(Index: Integer): TYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + if (Index >= 0) and (Index < FSize) then + begin + Result := FItems[Index]; + if Index < (FSize - 1) then + MOVEARRAYPROCEDURENAME(FItems, Index + 1, Index, FSize - 1 - Index) + else + FItems[Index] := DEFAULTVALUE; + Dec(FSize); + AutoPack; + end + else + Result := RaiseOutOfBoundsError; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.First: ITRINTERFACENAME; +begin + Result := ITRCLASSNAME.Create(Self, 0, False, isFirst); +end; + +{$IFDEF SUPPORTS_FOR_IN} +function SELFCLASSNAME.GetEnumerator: ITRINTERFACENAME; +begin + Result := ITRCLASSNAME.Create(Self, 0, False, isFirst); +end; +{$ENDIF SUPPORTS_FOR_IN} + +function SELFCLASSNAME.GETTERFUNCTIONNAME(Index: Integer): TYPENAME; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := DEFAULTVALUE; + if (Index >= 0) or (Index < FSize) then + Result := FItems[Index] + else + if not FReturnDefaultElements then + raise EJclNoSuchElementError.Create(IntToStr(Index)); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.IndexOf(CONSTKEYWORDPARAMETERNAME: TYPENAME): Integer; +var + I: Integer; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := -1; + for I := 0 to FSize - 1 do + if ItemsEqual(FItems[I], PARAMETERNAME) then + begin + Result := I; + Break; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Insert(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + I: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := FAllowDefaultElements or not ItemsEqual(PARAMETERNAME, DEFAULTVALUE); + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if Result then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(PARAMETERNAME, FItems[I]) then + begin + Result := CheckDuplicate; + Break; + end; + if Result then + begin + if FSize = FCapacity then + AutoGrow; + Result := FSize < FCapacity; + if Result then + begin + if Index < FSize then + MOVEARRAYPROCEDURENAME(FItems, Index, Index + 1, FSize - Index); + FItems[Index] := PARAMETERNAME; + Inc(FSize); + end; + end; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.InsertAll(Index: Integer; const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: ITRINTERFACENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if (Index < 0) or (Index > FSize) then + raise EJclOutOfBoundsError.Create; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.Last; + while It.HasPrevious do + Result := Insert(Index, It.Previous) and Result; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function SELFCLASSNAME.Last: ITRINTERFACENAME; +begin + Result := ITRCLASSNAME.Create(Self, FSize - 1, False, isLast); +end; + +function SELFCLASSNAME.LastIndexOf(CONSTKEYWORDPARAMETERNAME: TYPENAME): Integer; +var + I: Integer; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Result := -1; + for I := FSize - 1 downto 0 do + if ItemsEqual(FItems[I], PARAMETERNAME) then + begin + Result := I; + Break; + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.RaiseOutOfBoundsError: TYPENAME; +begin + raise EJclOutOfBoundsError.Create; +end; + +function SELFCLASSNAME.Remove(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; +var + Extracted: TYPENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := Extract(PARAMETERNAME); + if Result then + begin + Extracted := PARAMETERNAME; + RELEASERFUNCTIONNAME(Extracted); + end; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.RemoveAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + It: ITRINTERFACENAME; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + Result := True; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.RetainAll(const ACollection: COLLECTIONINTERFACENAME): Boolean; +var + I: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + Result := False; + if ACollection = nil then + Exit; + Result := True; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FItems[I]) then + Delete(I); + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.SetCapacity(Value: Integer); +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + if Value >= FSize then + begin + SetLength(FItems, Value); + inherited SetCapacity(Value); + end + else + raise EJclOutOfBoundsError.Create; + {$JPPEXPANDMACRO UNLOCK} +end; + +procedure SELFCLASSNAME.SETTERPROCEDURENAME(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME); +var + ReplaceItem: Boolean; + I: Integer; +begin + {$JPPDEFINE WRITE}{$JPPEXPANDMACRO LOCK} + if (Index < 0) or (Index >= FSize) then + raise EJclOutOfBoundsError.Create; + ReplaceItem := FAllowDefaultElements or not ItemsEqual(PARAMETERNAME, DEFAULTVALUE); + if ReplaceItem then + begin + if FDuplicates <> dupAccept then + for I := 0 to FSize - 1 do + if ItemsEqual(PARAMETERNAME, FItems[I]) then + begin + ReplaceItem := CheckDuplicate; + Break; + end; + if ReplaceItem then + begin + RELEASERFUNCTIONNAME(FItems[Index]); + FItems[Index] := PARAMETERNAME; + end; + end; + if not ReplaceItem then + Delete(Index); + {$JPPEXPANDMACRO UNLOCK} +end; + +function SELFCLASSNAME.Size: Integer; +begin + Result := FSize; +end; + +function SELFCLASSNAME.SubList(First, Count: Integer): LISTINTERFACENAME; +var + I: Integer; + Last: Integer; +begin + {$JPPUNDEF WRITE}{$JPPEXPANDMACRO LOCK} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := CreateEmptyContainer as LISTINTERFACENAME; + for I := First to Last do + Result.Add(FItems[I]); + {$JPPEXPANDMACRO UNLOCK} +end;*) diff --git a/3rdParty/JCL/source/prototypes/containers/JclVectors.int b/3rdParty/JCL/source/prototypes/containers/JclVectors.int new file mode 100644 index 00000000..a6e624ee --- /dev/null +++ b/3rdParty/JCL/source/prototypes/containers/JclVectors.int @@ -0,0 +1,87 @@ +(*$JPPDEFINEMACRO JCLVECTORINT(SELFCLASSNAME, ANCESTORCLASSNAME, + BASECONTAINERINTERFACENAME, FLATCONTAINERINTERFACENAME, + COLLECTIONINTERFACENAME, LISTINTERFACENAME, ARRAYINTERFACENAME, ITRINTERFACENAME, + EQUALITYCOMPARERINTERFACENAME, INTERFACEADDITIONAL, + SECTIONADDITIONAL, COLLECTIONFLAGS, OWNERSHIPDECLARATION, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, DYNARRAYTYPE, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) +SELFCLASSNAME = class(ANCESTORCLASSNAME, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable, IJclPackable, IJclGrowable, IJclBaseContainer, + BASECONTAINERINTERFACENAME, FLATCONTAINERINTERFACENAME, EQUALITYCOMPARERINTERFACENAME,INTERFACEADDITIONAL + COLLECTIONINTERFACENAME, LISTINTERFACENAME, ARRAYINTERFACENAME)SECTIONADDITIONAL +private + FItems: DYNARRAYTYPE; +protected + procedure AssignDataTo(Dest: TJclAbstractContainerBase); override; + // fix ambiguous warnings when compiled on Delphi.net and earlier versions of Delphi.win32 + // complaining about possible unaffected result. + function RaiseOutOfBoundsError: TYPENAME; +public + constructor Create(ACapacity: IntegerOWNERSHIPDECLARATION); overload; + constructor Create(const ACollection: COLLECTIONINTERFACENAMEOWNERSHIPDECLARATION); overload; + destructor Destroy; override; + property Items: DYNARRAYTYPE read FItems; + { IJclPackable } + procedure SetCapacity(Value: Integer); override; + { COLLECTIONINTERFACENAME } + function Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean;COLLECTIONFLAGS + function AddAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + procedure Clear;COLLECTIONFLAGS + function CollectionEquals(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function Contains(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean;COLLECTIONFLAGS + function ContainsAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function Extract(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; COLLECTIONFLAGS + function ExtractAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function First: ITRINTERFACENAME;COLLECTIONFLAGS + function IsEmpty: Boolean;COLLECTIONFLAGS + function Last: ITRINTERFACENAME;COLLECTIONFLAGS + function Remove(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; COLLECTIONFLAGS + function RemoveAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function RetainAll(const ACollection: COLLECTIONINTERFACENAME): Boolean;COLLECTIONFLAGS + function Size: Integer;COLLECTIONFLAGS + {$IFDEF SUPPORTS_FOR_IN} + function GetEnumerator: ITRINTERFACENAME;COLLECTIONFLAGS + {$ENDIF SUPPORTS_FOR_IN} + { LISTINTERFACENAME } + function Delete(Index: Integer): TYPENAME; + function ExtractIndex(Index: Integer): TYPENAME; + function GETTERFUNCTIONNAME(Index: Integer): TYPENAME; + function IndexOf(CONSTKEYWORDPARAMETERNAME: TYPENAME): Integer; + function Insert(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function InsertAll(Index: Integer; const ACollection: COLLECTIONINTERFACENAME): Boolean; + function LastIndexOf(CONSTKEYWORDPARAMETERNAME: TYPENAME): Integer; + procedure SETTERPROCEDURENAME(Index: Integer; CONSTKEYWORDPARAMETERNAME: TYPENAME); + function SubList(First, Count: Integer): LISTINTERFACENAME; +end;*) +(*$JPPDEFINEMACRO JCLVECTORITRINT(SELFCLASSNAME, ITRINTERFACENAME, LISTCLASSNAME, + CONSTKEYWORD, PARAMETERNAME, TYPENAME, GETTERFUNCTIONNAME, SETTERPROCEDURENAME) +SELFCLASSNAME = class(TJclAbstractIterator, ITRINTERFACENAME, {$IFDEF THREADSAFE} IJclLockable, {$ENDIF THREADSAFE} + IJclIntfCloneable, IJclCloneable) +private + FCursor: Integer; + FStart: TItrStart; + FOwnList: LISTCLASSNAME; +protected + function CreateEmptyIterator: TJclAbstractIterator; override; + procedure AssignPropertiesTo(Dest: TJclAbstractIterator); override; +public + constructor Create(AOwnList: LISTCLASSNAME; ACursor: Integer; AValid: Boolean; AStart: TItrStart); + { ITRINTERFACENAME } + function Add(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + procedure Extract; + function GETTERFUNCTIONNAME: TYPENAME; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Insert(CONSTKEYWORDPARAMETERNAME: TYPENAME): Boolean; + function IteratorEquals(const AIterator: ITRINTERFACENAME): Boolean; + function Next: TYPENAME; + function NextIndex: Integer; + function Previous: TYPENAME; + function PreviousIndex: Integer; + procedure Remove; + procedure Reset; + procedure SETTERPROCEDURENAME(CONSTKEYWORDPARAMETERNAME: TYPENAME); + {$IFDEF SUPPORTS_FOR_IN} + function MoveNext: Boolean; + property Current: TYPENAME read GETTERFUNCTIONNAME; + {$ENDIF SUPPORTS_FOR_IN} +end;*) diff --git a/3rdParty/JCL/source/prototypes/supplement/create_JCL_Hardlinks.pas.cmd b/3rdParty/JCL/source/prototypes/supplement/create_JCL_Hardlinks.pas.cmd new file mode 100644 index 00000000..fa224e8f --- /dev/null +++ b/3rdParty/JCL/source/prototypes/supplement/create_JCL_Hardlinks.pas.cmd @@ -0,0 +1,13 @@ +@echo off +echo Continue by pressing ^ to overwrite the old JCL version of +echo this unit with a freshly created one (from prototype). +echo To cancel this operation press ^ or close this window! +echo. +echo. +pause +rem Remove the nonJCL parts +set tempname=.\Temp_Hardlinks.pas +simple_pp.pl ..\Hardlinks.pas JCL > "%tempname%" +simple_pp.pl %tempname% !PROTOTYPE > "..\..\windows\Hardlinks.pas" +del /f "%tempname%" + diff --git a/3rdParty/JCL/source/prototypes/supplement/create_nonJCL_Hardlinks.pas.cmd b/3rdParty/JCL/source/prototypes/supplement/create_nonJCL_Hardlinks.pas.cmd new file mode 100644 index 00000000..7ea66a03 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/supplement/create_nonJCL_Hardlinks.pas.cmd @@ -0,0 +1,4 @@ +@echo off +rem Remove the JCL parts +simple_pp.pl ..\Hardlinks.pas !JCL > "Hardlinks.pas" + diff --git a/3rdParty/JCL/source/prototypes/supplement/simple_pp.pl b/3rdParty/JCL/source/prototypes/supplement/simple_pp.pl new file mode 100644 index 00000000..432d0431 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/supplement/simple_pp.pl @@ -0,0 +1,60 @@ +#!/usr/bin/perl +############################################################################## +## +## Simple perl script to filter only a single DEFINE symbol from the input +## file. +## +############################################################################## +my ($param1, $param2) = @ARGV; + +if ((-z $param1) || ($param2 eq '')) +{ + print ; + exit; +} +my $positive = 1; +# Open and read and close the file +open(FILE, $param1) or die; +$x = join('', ); +close(FILE); +# Check wether the symbol is negated or not +if ($param2 =~ /^!(.+)$/i) +{ + $param2 = $1; + $positive = 0; +} +# According to the commandline evaluate the symbol +if ($positive != 0) +{ + # Replace all IFDEF ELSE ENDIF statements + $x =~ s/\{\$IFDEF[\t\s]+$param2\}[\t\s\n]*(.+?)\{\$ELSE[\t\s]+[~]{0,1}$param2\}[\t\s\n]*(.+?)\{\$ENDIF[\t\s]+[~]{0,1}$param2\}[\t\s\n]*/$1/gism; + $x =~ s/\{\$IFNDEF[\t\s]+$param2\}[\t\s\n]*(.+?)\{\$ELSE[\t\s]+[~]{0,1}$param2\}[\t\s\n]*(.+?)\{\$ENDIF[\t\s]+[~]{0,1}$param2\}[\t\s\n]*/$2/gism; + # Replace all IFDEF ENDIF statements + $x =~ s/\{\$IFDEF[\t\s]+$param2\}[\t\s\n]*(.+?)\{\$ENDIF[\t\s]+[~]{0,1}$param2\}[\t\s\n]*/$1/gism; + $x =~ s/\{\$IFNDEF[\t\s]+$param2\}[\t\s\n]*(.+?)\{\$ENDIF[\t\s]+[~]{0,1}$param2\}[\t\s\n]*//gism; +} +else # If the symbol was negated at the commandline +{ + # Replace all IFDEF ELSE ENDIF statements + $x =~ s/\{\$IFDEF[\t\s]+$param2\}[\t\s\n]*(.+?)\{\$ELSE[\t\s]+[~]{0,1}$param2\}[\t\s\n]*(.+?)\{\$ENDIF[\t\s]+[~]{0,1}$param2\}[\t\s\n]*/$2/gism; + $x =~ s/\{\$IFNDEF[\t\s]+$param2\}[\t\s\n]*(.+?)\{\$ELSE[\t\s]+[~]{0,1}$param2\}[\t\s\n]*(.+?)\{\$ENDIF[\t\s]+[~]{0,1}$param2\}[\t\s\n]*/$1/gism; + # Replace all IFDEF ENDIF statements + $x =~ s/\{\$IFDEF[\t\s]+$param2\}[\t\s\n]*(.+?)\{\$ENDIF[\t\s]+[~]{0,1}$param2\}[\t\s\n]*//gism; + $x =~ s/\{\$IFNDEF[\t\s]+$param2\}[\t\s\n]*(.+?)\{\$ENDIF[\t\s]+[~]{0,1}$param2\}[\t\s\n]*/$1/gism; +} +# Output to STDOUT +print "$x"; +__END__ +Syntax: + + simple_pp.pl [!] + +Output is printed to STDOUT. If you want to treat multiple symbols simply run +the script multiple times. + +The exclamation mark in front of the symbol can be used to undefine the +respective symbol - otherwise it will be defined. + +Any DEFINE or UNDEF directives concerning the given symbol inside the input +file will be ignored. Only commandline is taken. + diff --git a/3rdParty/JCL/source/prototypes/win32api/AclApi.imp b/3rdParty/JCL/source/prototypes/win32api/AclApi.imp new file mode 100644 index 00000000..dfae89c7 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/AclApi.imp @@ -0,0 +1,22 @@ +{$IFDEF MSWINDOWS} + +const + aclapilib = 'advapi32.dll'; + +type + TSetNamedSecurityInfoW = function (pObjectName: LPWSTR; ObjectType: SE_OBJECT_TYPE; + SecurityInfo: SECURITY_INFORMATION; psidOwner, psidGroup: PSID; + pDacl, pSacl: PACL): DWORD; stdcall; + +var + _SetNamedSecurityInfoW: TSetNamedSecurityInfoW = nil; + +function SetNamedSecurityInfoW(pObjectName: LPWSTR; ObjectType: SE_OBJECT_TYPE; + SecurityInfo: SECURITY_INFORMATION; psidOwner, psidGroup: PSID; + pDacl, pSacl: PACL): DWORD; +begin + GetProcedureAddress(Pointer(@_SetNamedSecurityInfoW), aclapilib, 'SetNamedSecurityInfoW'); + Result := _SetNamedSecurityInfoW(pObjectName, ObjectType, SecurityInfo, psidOwner, psidGroup, pDacl, pSacl); +end; + +{$ENDIF MSWINDOWS} diff --git a/3rdParty/JCL/source/prototypes/win32api/AclApi.int b/3rdParty/JCL/source/prototypes/win32api/AclApi.int new file mode 100644 index 00000000..b1135fb0 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/AclApi.int @@ -0,0 +1,10 @@ +// From JwaAclApi + +// line 185 + +{$IFDEF MSWINDOWS} +function SetNamedSecurityInfoW(pObjectName: LPWSTR; ObjectType: SE_OBJECT_TYPE; + SecurityInfo: SECURITY_INFORMATION; psidOwner, psidGroup: PSID; + pDacl, pSacl: PACL): DWORD; stdcall; +{$EXTERNALSYM SetNamedSecurityInfoW} +{$ENDIF MSWINDOWS} \ No newline at end of file diff --git a/3rdParty/JCL/source/prototypes/win32api/DelayImp.int b/3rdParty/JCL/source/prototypes/win32api/DelayImp.int new file mode 100644 index 00000000..735ddeef --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/DelayImp.int @@ -0,0 +1,47 @@ +type + // Microsoft version (64 bit SDK) + {$EXTERNALSYM RVA} + RVA = DWORD; + + // 64-bit PE + {$EXTERNALSYM ImgDelayDescrV2} + ImgDelayDescrV2 = packed record + grAttrs: DWORD; // attributes + rvaDLLName: RVA; // RVA to dll name + rvaHmod: RVA; // RVA of module handle + rvaIAT: RVA; // RVA of the IAT + rvaINT: RVA; // RVA of the INT + rvaBoundIAT: RVA; // RVA of the optional bound IAT + rvaUnloadIAT: RVA; // RVA of optional copy of original IAT + dwTimeStamp: DWORD; // 0 if not bound, + // O.W. date/time stamp of DLL bound to (Old BIND) + end; + {$EXTERNALSYM TImgDelayDescrV2} + TImgDelayDescrV2 = ImgDelayDescrV2; + {$EXTERNALSYM PImgDelayDescrV2} + PImgDelayDescrV2 = ^ImgDelayDescrV2; + + {$EXTERNALSYM PHMODULE} + PHMODULE = ^HMODULE; + + // 32-bit PE + {$EXTERNALSYM ImgDelayDescrV1} + ImgDelayDescrV1 = packed record + grAttrs: DWORD; // attributes + szName: LPCSTR; // pointer to dll name + phmod: PHMODULE; // address of module handle + pIAT: PImageThunkData32; // address of the IAT + pINT: PImageThunkData32; // address of the INT + pBoundIAT: PImageThunkData32; // address of the optional bound IAT + pUnloadIAT: PImageThunkData32; // address of optional copy of original IAT + dwTimeStamp: DWORD; // 0 if not bound, + // O.W. date/time stamp of DLL bound to (Old BIND) + end; + {$EXTERNALSYM TImgDelayDescrV1} + TImgDelayDescrV1 = ImgDelayDescrV1; + {$EXTERNALSYM PImgDelayDescrV1} + PImgDelayDescrV1 = ^ImgDelayDescrV1; + + //{$EXTERNALSYM PImgDelayDescr} + //PImgDelayDescr = ImgDelayDescr; + //TImgDelayDescr = ImgDelayDescr; diff --git a/3rdParty/JCL/source/prototypes/win32api/ImageHlp.imp b/3rdParty/JCL/source/prototypes/win32api/ImageHlp.imp new file mode 100644 index 00000000..6dfc19a9 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/ImageHlp.imp @@ -0,0 +1,149 @@ +{$IFDEF MSWINDOWS} + +const + ImageHlpLib = 'imagehlp.dll'; + +type + TReBaseImage = function (CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; + fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; + var OldImageSize: TJclAddr32; var OldImageBase: TJclAddr; + var NewImageSize: TJclAddr32; var NewImageBase: TJclAddr; TimeStamp: ULONG): BOOL; stdcall; + +var + _ReBaseImage: TReBaseImage = nil; + +function ReBaseImage(CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; + fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; + var OldImageSize: TJclAddr32; var OldImageBase: TJclAddr; + var NewImageSize: TJclAddr32; var NewImageBase: TJclAddr; TimeStamp: ULONG): BOOL; +begin + GetProcedureAddress(Pointer(@_ReBaseImage), ImageHlpLib, 'ReBaseImage'); + Result := _ReBaseImage(CurrentImageName, SymbolPath, fReBase, fRebaseSysfileOk, fGoingDown, CheckImageSize, OldImageSize, OldImageBase, NewImageSize, NewImageBase, TimeStamp); +end; + +type + TReBaseImage64 = function (CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; + fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; + var OldImageSize: TJclAddr32; var OldImageBase: TJclAddr64; + var NewImageSize: TJclAddr32; var NewImageBase: TJclAddr64; TimeStamp: ULONG): BOOL; stdcall; + +var + _ReBaseImage64: TReBaseImage64 = nil; + +function ReBaseImage64(CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; + fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; + var OldImageSize: TJclAddr32; var OldImageBase: TJclAddr64; + var NewImageSize: TJclAddr32; var NewImageBase: TJclAddr64; TimeStamp: ULONG): BOOL; +begin + GetProcedureAddress(Pointer(@_ReBaseImage64), ImageHlpLib, 'ReBaseImage64'); + Result := _ReBaseImage64(CurrentImageName, SymbolPath, fReBase, fRebaseSysfileOk, fGoingDown, CheckImageSize, OldImageSize, OldImageBase, NewImageSize, NewImageBase, TimeStamp); +end; + +type + TCheckSumMappedFile = function (BaseAddress: Pointer; FileLength: DWORD; + out HeaderSum, CheckSum: DWORD): PImageNtHeaders; stdcall; + +var + _CheckSumMappedFile: TCheckSumMappedFile = nil; + +function CheckSumMappedFile(BaseAddress: Pointer; FileLength: DWORD; + out HeaderSum, CheckSum: DWORD): PImageNtHeaders; +begin + GetProcedureAddress(Pointer(@_CheckSumMappedFile), ImageHlpLib, 'CheckSumMappedFile'); + Result := _CheckSumMappedFile(BaseAddress, FileLength, HeaderSum, CheckSum); +end; + +type + TGetImageUnusedHeaderBytes = function (const LoadedImage: LOADED_IMAGE; + var SizeUnusedHeaderBytes: DWORD): DWORD; stdcall; + +var + _GetImageUnusedHeaderBytes: TGetImageUnusedHeaderBytes = nil; + +function GetImageUnusedHeaderBytes(const LoadedImage: LOADED_IMAGE; + var SizeUnusedHeaderBytes: DWORD): DWORD; +begin + GetProcedureAddress(Pointer(@_GetImageUnusedHeaderBytes), ImageHlpLib, 'GetImageUnusedHeaderBytes'); + Result := _GetImageUnusedHeaderBytes(LoadedImage, SizeUnusedHeaderBytes); +end; + +type + TMapAndLoad = function (ImageName, DllPath: PAnsiChar; var LoadedImage: LOADED_IMAGE; + DotDll: BOOL; ReadOnly: BOOL): BOOL; stdcall; + +var + _MapAndLoad: TMapAndLoad = nil; + +function MapAndLoad(ImageName, DllPath: PAnsiChar; var LoadedImage: LOADED_IMAGE; + DotDll: BOOL; ReadOnly: BOOL): BOOL; +begin + GetProcedureAddress(Pointer(@_MapAndLoad), ImageHlpLib, 'MapAndLoad'); + Result := _MapAndLoad(ImageName, DllPath, LoadedImage, DotDll, ReadOnly); +end; + +type + TUnMapAndLoad = function (const LoadedImage: LOADED_IMAGE): BOOL; stdcall; + +var + _UnMapAndLoad: TUnMapAndLoad = nil; + +function UnMapAndLoad(const LoadedImage: LOADED_IMAGE): BOOL; +begin + GetProcedureAddress(Pointer(@_UnMapAndLoad), ImageHlpLib, 'UnMapAndLoad'); + Result := _UnMapAndLoad(LoadedImage); +end; + +type + TTouchFileTimes = function (const FileHandle: THandle; const pSystemTime: TSystemTime): BOOL; stdcall; + +var + _TouchFileTimes: TTouchFileTimes = nil; + +function TouchFileTimes(const FileHandle: THandle; const pSystemTime: TSystemTime): BOOL; +begin + GetProcedureAddress(Pointer(@_TouchFileTimes), ImageHlpLib, 'TouchFileTimes'); + Result := _TouchFileTimes(FileHandle, pSystemTime); +end; + +type + TImageDirectoryEntryToData = function (Base: Pointer; MappedAsImage: ByteBool; + DirectoryEntry: USHORT; var Size: ULONG): Pointer; stdcall; + +var + _ImageDirectoryEntryToData: TImageDirectoryEntryToData = nil; + +function ImageDirectoryEntryToData(Base: Pointer; MappedAsImage: ByteBool; + DirectoryEntry: USHORT; var Size: ULONG): Pointer; +begin + GetProcedureAddress(Pointer(@_ImageDirectoryEntryToData), ImageHlpLib, 'ImageDirectoryEntryToData'); + Result := _ImageDirectoryEntryToData(Base, MappedAsImage, DirectoryEntry, Size); +end; + +type + TImageRvaToSection = function (NtHeaders: PImageNtHeaders; Base: Pointer; Rva: ULONG): PImageSectionHeader; stdcall; + +var + _ImageRvaToSection: TImageRvaToSection = nil; + +function ImageRvaToSection(NtHeaders: PImageNtHeaders; Base: Pointer; Rva: ULONG): PImageSectionHeader; +begin + GetProcedureAddress(Pointer(@_ImageRvaToSection), ImageHlpLib, 'ImageRvaToSection'); + Result := _ImageRvaToSection(NtHeaders, Base, Rva); +end; + +type + TImageRvaToVa = function (NtHeaders: PImageNtHeaders; Base: Pointer; Rva: ULONG; + LastRvaSection: PPImageSectionHeader): Pointer; stdcall; + +var + _ImageRvaToVa: TImageRvaToVa = nil; + +function ImageRvaToVa(NtHeaders: PImageNtHeaders; Base: Pointer; Rva: ULONG; + LastRvaSection: PPImageSectionHeader): Pointer; +begin + GetProcedureAddress(Pointer(@_ImageRvaToVa), ImageHlpLib, 'ImageRvaToVa'); + Result := _ImageRvaToVa(NtHeaders, Base, Rva, LastRvaSection); +end; + +{$ENDIF MSWINDOWS} + diff --git a/3rdParty/JCL/source/prototypes/win32api/ImageHlp.int b/3rdParty/JCL/source/prototypes/win32api/ImageHlp.int new file mode 100644 index 00000000..533ec417 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/ImageHlp.int @@ -0,0 +1,412 @@ + +const + IMAGE_SEPARATION = (64*1024); + {$EXTERNALSYM IMAGE_SEPARATION} + +type + PLOADED_IMAGE = ^LOADED_IMAGE; + {$EXTERNALSYM PLOADED_IMAGE} + _LOADED_IMAGE = record + ModuleName: PAnsiChar; + hFile: THandle; + MappedAddress: PUCHAR; + FileHeader: PImageNtHeaders; + LastRvaSection: PImageSectionHeader; + NumberOfSections: ULONG; + Sections: PImageSectionHeader; + Characteristics: ULONG; + fSystemImage: ByteBool; + fDOSImage: ByteBool; + Links: LIST_ENTRY; + SizeOfImage: ULONG; + end; + {$EXTERNALSYM _LOADED_IMAGE} + LOADED_IMAGE = _LOADED_IMAGE; + {$EXTERNALSYM LOADED_IMAGE} + TLoadedImage = LOADED_IMAGE; + PLoadedImage = PLOADED_IMAGE; + + PIMAGE_SYMBOL = ^IMAGE_SYMBOL; + {$EXTERNALSYM PIMAGE_SYMBOL} + _IMAGE_SYMBOL = packed record // MUST pack to obtain the right size + Name: array [0..7] of AnsiChar; + Value: ULONG; + SectionNumber: USHORT; + _Type: USHORT; + StorageClass: BYTE; + NumberOfAuxSymbols: BYTE; + end; + {$EXTERNALSYM _IMAGE_SYMBOL} + IMAGE_SYMBOL = _IMAGE_SYMBOL; + {$EXTERNALSYM IMAGE_SYMBOL} + TImageSymbol = IMAGE_SYMBOL; + PImageSymbol = PIMAGE_SYMBOL; + +// line 152 + +{$IFDEF MSWINDOWS} + +function ReBaseImage(CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; + fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; + var OldImageSize: TJclAddr32; var OldImageBase: TJclAddr; + var NewImageSize: TJclAddr32; var NewImageBase: TJclAddr; TimeStamp: ULONG): BOOL; stdcall; +{$EXTERNALSYM ReBaseImage} + +function ReBaseImage64(CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; + fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; + var OldImageSize: TJclAddr32; var OldImageBase: TJclAddr64; + var NewImageSize: TJclAddr32; var NewImageBase: TJclAddr64; TimeStamp: ULONG): BOOL; stdcall; +{$EXTERNALSYM ReBaseImage64} + +// line 199 + +// +// Define checksum function prototypes. +// + +function CheckSumMappedFile(BaseAddress: Pointer; FileLength: DWORD; + out HeaderSum, CheckSum: DWORD): PImageNtHeaders; stdcall; +{$EXTERNALSYM CheckSumMappedFile} + +// line 227 + +function GetImageUnusedHeaderBytes(const LoadedImage: LOADED_IMAGE; + var SizeUnusedHeaderBytes: DWORD): DWORD; stdcall; +{$EXTERNALSYM GetImageUnusedHeaderBytes} + +// line 285 + +function MapAndLoad(ImageName, DllPath: PAnsiChar; var LoadedImage: LOADED_IMAGE; + DotDll: BOOL; ReadOnly: BOOL): BOOL; stdcall; +{$EXTERNALSYM MapAndLoad} + +function UnMapAndLoad(const LoadedImage: LOADED_IMAGE): BOOL; stdcall; +{$EXTERNALSYM UnMapAndLoad} + +function TouchFileTimes(const FileHandle: THandle; const pSystemTime: TSystemTime): BOOL; stdcall; +{$EXTERNALSYM TouchFileTimes} + +// line 347 + +function ImageDirectoryEntryToData(Base: Pointer; MappedAsImage: ByteBool; + DirectoryEntry: USHORT; var Size: ULONG): Pointer; stdcall; +{$EXTERNALSYM ImageDirectoryEntryToData} + +function ImageRvaToSection(NtHeaders: PImageNtHeaders; Base: Pointer; Rva: ULONG): PImageSectionHeader; stdcall; +{$EXTERNALSYM ImageRvaToSection} + +function ImageRvaToVa(NtHeaders: PImageNtHeaders; Base: Pointer; Rva: ULONG; + LastRvaSection: PPImageSectionHeader): Pointer; stdcall; +{$EXTERNALSYM ImageRvaToVa} + +{$ENDIF MSWINDOWS} + +// line 461 + +// +// UnDecorateSymbolName Flags +// + +const + UNDNAME_COMPLETE = ($0000); // Enable full undecoration + {$EXTERNALSYM UNDNAME_COMPLETE} + UNDNAME_NO_LEADING_UNDERSCORES = ($0001); // Remove leading underscores from MS extended keywords + {$EXTERNALSYM UNDNAME_NO_LEADING_UNDERSCORES} + UNDNAME_NO_MS_KEYWORDS = ($0002); // Disable expansion of MS extended keywords + {$EXTERNALSYM UNDNAME_NO_MS_KEYWORDS} + UNDNAME_NO_FUNCTION_RETURNS = ($0004); // Disable expansion of return type for primary declaration + {$EXTERNALSYM UNDNAME_NO_FUNCTION_RETURNS} + UNDNAME_NO_ALLOCATION_MODEL = ($0008); // Disable expansion of the declaration model + {$EXTERNALSYM UNDNAME_NO_ALLOCATION_MODEL} + UNDNAME_NO_ALLOCATION_LANGUAGE = ($0010); // Disable expansion of the declaration language specifier + {$EXTERNALSYM UNDNAME_NO_ALLOCATION_LANGUAGE} + UNDNAME_NO_MS_THISTYPE = ($0020); // NYI Disable expansion of MS keywords on the 'this' type for primary declaration + {$EXTERNALSYM UNDNAME_NO_MS_THISTYPE} + UNDNAME_NO_CV_THISTYPE = ($0040); // NYI Disable expansion of CV modifiers on the 'this' type for primary declaration + {$EXTERNALSYM UNDNAME_NO_CV_THISTYPE} + UNDNAME_NO_THISTYPE = ($0060); // Disable all modifiers on the 'this' type + {$EXTERNALSYM UNDNAME_NO_THISTYPE} + UNDNAME_NO_ACCESS_SPECIFIERS = ($0080); // Disable expansion of access specifiers for members + {$EXTERNALSYM UNDNAME_NO_ACCESS_SPECIFIERS} + UNDNAME_NO_THROW_SIGNATURES = ($0100); // Disable expansion of 'throw-signatures' for functions and pointers to functions + {$EXTERNALSYM UNDNAME_NO_THROW_SIGNATURES} + UNDNAME_NO_MEMBER_TYPE = ($0200); // Disable expansion of 'static' or 'virtual'ness of members + {$EXTERNALSYM UNDNAME_NO_MEMBER_TYPE} + UNDNAME_NO_RETURN_UDT_MODEL = ($0400); // Disable expansion of MS model for UDT returns + {$EXTERNALSYM UNDNAME_NO_RETURN_UDT_MODEL} + UNDNAME_32_BIT_DECODE = ($0800); // Undecorate 32-bit decorated names + {$EXTERNALSYM UNDNAME_32_BIT_DECODE} + UNDNAME_NAME_ONLY = ($1000); // Crack only the name for primary declaration; + {$EXTERNALSYM UNDNAME_NAME_ONLY} + // return just [scope::]name. Does expand template params + UNDNAME_NO_ARGUMENTS = ($2000); // Don't undecorate arguments to function + {$EXTERNALSYM UNDNAME_NO_ARGUMENTS} + UNDNAME_NO_SPECIAL_SYMS = ($4000); // Don't undecorate special names (v-table, vcall, vector xxx, metatype, etc) + {$EXTERNALSYM UNDNAME_NO_SPECIAL_SYMS} + +// line 1342 + +type + {$EXTERNALSYM SYM_TYPE} + SYM_TYPE = ( + SymNone, + SymCoff, + SymCv, + SymPdb, + SymExport, + SymDeferred, + SymSym { .sym file } + ); + TSymType = SYM_TYPE; + + { symbol data structure } + {$EXTERNALSYM PImagehlpSymbolA} + PImagehlpSymbolA = ^TImagehlpSymbolA; + {$EXTERNALSYM _IMAGEHLP_SYMBOLA} + _IMAGEHLP_SYMBOLA = packed record + SizeOfStruct: DWORD; { set to sizeof(IMAGEHLP_SYMBOL) } + Address: DWORD; { virtual address including dll base address } + Size: DWORD; { estimated size of symbol, can be zero } + Flags: DWORD; { info about the symbols, see the SYMF defines } + MaxNameLength: DWORD; { maximum size of symbol name in 'Name' } + Name: packed array[0..0] of AnsiChar; { symbol name (null terminated string) } + end; + {$EXTERNALSYM IMAGEHLP_SYMBOLA} + IMAGEHLP_SYMBOLA = _IMAGEHLP_SYMBOLA; + {$EXTERNALSYM TImagehlpSymbolA} + TImagehlpSymbolA = _IMAGEHLP_SYMBOLA; + + { symbol data structure } + {$EXTERNALSYM PImagehlpSymbolA64} + PImagehlpSymbolA64 = ^TImagehlpSymbolA64; + {$EXTERNALSYM _IMAGEHLP_SYMBOLA64} + _IMAGEHLP_SYMBOLA64 = packed record + SizeOfStruct: DWORD; { set to sizeof(IMAGEHLP_SYMBOL) } + Address: TJclAddr64; { virtual address including dll base address } + Size: DWORD; { estimated size of symbol, can be zero } + Flags: DWORD; { info about the symbols, see the SYMF defines } + MaxNameLength: DWORD; { maximum size of symbol name in 'Name' } + Name: packed array[0..0] of AnsiChar; { symbol name (null terminated string) } + end; + {$EXTERNALSYM IMAGEHLP_SYMBOLA64} + IMAGEHLP_SYMBOLA64 = _IMAGEHLP_SYMBOLA64; + {$EXTERNALSYM TImagehlpSymbolA64} + TImagehlpSymbolA64 = _IMAGEHLP_SYMBOLA64; + + { symbol data structure } + {$EXTERNALSYM PImagehlpSymbolW} + PImagehlpSymbolW = ^TImagehlpSymbolW; + {$EXTERNALSYM _IMAGEHLP_SYMBOLW} + _IMAGEHLP_SYMBOLW = packed record + SizeOfStruct: DWORD; { set to sizeof(IMAGEHLP_SYMBOL) } + Address: DWORD; { virtual address including dll base address } + Size: DWORD; { estimated size of symbol, can be zero } + Flags: DWORD; { info about the symbols, see the SYMF defines } + MaxNameLength: DWORD; { maximum size of symbol name in 'Name' } + Name: packed array[0..0] of WideChar; { symbol name (null terminated string) } + end; + {$EXTERNALSYM IMAGEHLP_SYMBOLW} + IMAGEHLP_SYMBOLW = _IMAGEHLP_SYMBOLW; + {$EXTERNALSYM TImagehlpSymbolW} + TImagehlpSymbolW = _IMAGEHLP_SYMBOLW; + + { symbol data structure } + {$EXTERNALSYM PImagehlpSymbolW64} + PImagehlpSymbolW64 = ^TImagehlpSymbolW64; + {$EXTERNALSYM _IMAGEHLP_SYMBOLW64} + _IMAGEHLP_SYMBOLW64 = packed record + SizeOfStruct: DWORD; { set to sizeof(IMAGEHLP_SYMBOL) } + Address: TJclAddr64; { virtual address including dll base address } + Size: DWORD; { estimated size of symbol, can be zero } + Flags: DWORD; { info about the symbols, see the SYMF defines } + MaxNameLength: DWORD; { maximum size of symbol name in 'Name' } + Name: packed array[0..0] of WideChar; { symbol name (null terminated string) } + end; + {$EXTERNALSYM IMAGEHLP_SYMBOLW64} + IMAGEHLP_SYMBOLW64 = _IMAGEHLP_SYMBOLW64; + {$EXTERNALSYM TImagehlpSymbolW64} + TImagehlpSymbolW64 = _IMAGEHLP_SYMBOLW64; + + { module data structure } + {$EXTERNALSYM PImagehlpModuleA} + PImagehlpModuleA = ^TImagehlpModuleA; + {$EXTERNALSYM _IMAGEHLP_MODULEA} + _IMAGEHLP_MODULEA = record + SizeOfStruct: DWORD; { set to sizeof(IMAGEHLP_MODULE) } + BaseOfImage: DWORD; { base load address of module } + ImageSize: DWORD; { virtual size of the loaded module } + TimeDateStamp: DWORD; { date/time stamp from pe header } + CheckSum: DWORD; { checksum from the pe header } + NumSyms: DWORD; { number of symbols in the symbol table } + SymType: TSymType; { type of symbols loaded } + ModuleName: packed array[0..31] of AnsiChar; { module name } + ImageName: packed array[0..255] of AnsiChar; { image name } + LoadedImageName: packed array[0..255] of AnsiChar; { symbol file name } + end; + {$EXTERNALSYM IMAGEHLP_MODULEA} + IMAGEHLP_MODULEA = _IMAGEHLP_MODULEA; + {$EXTERNALSYM TImagehlpModuleA} + TImagehlpModuleA = _IMAGEHLP_MODULEA; + + { module data structure } + {$EXTERNALSYM PImagehlpModuleA64} + PImagehlpModuleA64 = ^TImagehlpModuleA64; + {$EXTERNALSYM _IMAGEHLP_MODULEA64} + _IMAGEHLP_MODULEA64 = record + SizeOfStruct: DWORD; { set to sizeof(IMAGEHLP_MODULE) } + BaseOfImage: TJclAddr64; { base load address of module } + ImageSize: DWORD; { virtual size of the loaded module } + TimeDateStamp: DWORD; { date/time stamp from pe header } + CheckSum: DWORD; { checksum from the pe header } + NumSyms: DWORD; { number of symbols in the symbol table } + SymType: TSymType; { type of symbols loaded } + ModuleName: packed array[0..31] of AnsiChar; { module name } + ImageName: packed array[0..255] of AnsiChar; { image name } + LoadedImageName: packed array[0..255] of AnsiChar; { symbol file name } + end; + {$EXTERNALSYM IMAGEHLP_MODULEA64} + IMAGEHLP_MODULEA64 = _IMAGEHLP_MODULEA64; + {$EXTERNALSYM TImagehlpModuleA64} + TImagehlpModuleA64 = _IMAGEHLP_MODULEA64; + + { module data structure } + {$EXTERNALSYM PImagehlpModuleW} + PImagehlpModuleW = ^TImagehlpModuleW; + {$EXTERNALSYM _IMAGEHLP_MODULEW} + _IMAGEHLP_MODULEW = record + SizeOfStruct: DWORD; { set to sizeof(IMAGEHLP_MODULE) } + BaseOfImage: DWORD; { base load address of module } + ImageSize: DWORD; { virtual size of the loaded module } + TimeDateStamp: DWORD; { date/time stamp from pe header } + CheckSum: DWORD; { checksum from the pe header } + NumSyms: DWORD; { number of symbols in the symbol table } + SymType: TSymType; { type of symbols loaded } + ModuleName: packed array[0..31] of WideChar; { module name } + ImageName: packed array[0..255] of WideChar; { image name } + LoadedImageName: packed array[0..255] of WideChar; { symbol file name } + end; + {$EXTERNALSYM IMAGEHLP_MODULEW} + IMAGEHLP_MODULEW = _IMAGEHLP_MODULEW; + {$EXTERNALSYM TImagehlpModuleW} + TImagehlpModuleW = _IMAGEHLP_MODULEW; + + { module data structure } + {$EXTERNALSYM PImagehlpModuleW64} + PImagehlpModuleW64 = ^TImagehlpModuleW64; + {$EXTERNALSYM _IMAGEHLP_MODULEW64} + _IMAGEHLP_MODULEW64 = record + SizeOfStruct: DWORD; { set to sizeof(IMAGEHLP_MODULE) } + BaseOfImage: TJclAddr64; { base load address of module } + ImageSize: DWORD; { virtual size of the loaded module } + TimeDateStamp: DWORD; { date/time stamp from pe header } + CheckSum: DWORD; { checksum from the pe header } + NumSyms: DWORD; { number of symbols in the symbol table } + SymType: TSymType; { type of symbols loaded } + ModuleName: packed array[0..31] of WideChar; { module name } + ImageName: packed array[0..255] of WideChar; { image name } + LoadedImageName: packed array[0..255] of WideChar; { symbol file name } + end; + {$EXTERNALSYM IMAGEHLP_MODULEW64} + IMAGEHLP_MODULEW64 = _IMAGEHLP_MODULEW64; + {$EXTERNALSYM TImagehlpModuleW64} + TImagehlpModuleW64 = _IMAGEHLP_MODULEW64; + + _IMAGEHLP_LINEA = packed record + SizeOfStruct: DWORD; // set to sizeof(IMAGEHLP_LINE) + Key: Pointer; // internal + LineNumber: DWORD; // line number in file + FileName: PAnsiChar; // full filename + Address: DWORD; // first instruction of line + end; + IMAGEHLP_LINEA = _IMAGEHLP_LINEA; + PIMAGEHLP_LINEA = ^_IMAGEHLP_LINEA; + TImageHlpLineA = _IMAGEHLP_LINEA; + PImageHlpLineA = PIMAGEHLP_LINEA; + + _IMAGEHLP_LINEA64 = packed record + SizeOfStruct: DWORD; // set to sizeof(IMAGEHLP_LINE) + Key: Pointer; // internal + LineNumber: DWORD; // line number in file + FileName: PAnsiChar; // full filename + Address: TJclAddr64; // first instruction of line + end; + IMAGEHLP_LINEA64 = _IMAGEHLP_LINEA64; + PIMAGEHLP_LINEA64 = ^_IMAGEHLP_LINEA64; + TImageHlpLineA64 = _IMAGEHLP_LINEA64; + PImageHlpLineA64 = PIMAGEHLP_LINEA64; + + _IMAGEHLP_LINEW = packed record + SizeOfStruct: DWORD; // set to sizeof(IMAGEHLP_LINE) + Key: Pointer; // internal + LineNumber: DWORD; // line number in file + FileName: PWideChar; // full filename + Address: DWORD; // first instruction of line + end; + IMAGEHLP_LINEW = _IMAGEHLP_LINEW; + PIMAGEHLP_LINEW = ^_IMAGEHLP_LINEW; + TImageHlpLineW = _IMAGEHLP_LINEW; + PImageHlpLineW = PIMAGEHLP_LINEW; + + _IMAGEHLP_LINEW64 = packed record + SizeOfStruct: DWORD; // set to sizeof(IMAGEHLP_LINE) + Key: Pointer; // internal + LineNumber: DWORD; // line number in file + FileName: PWideChar; // full filename + Address: TJclAddr64; // first instruction of line + end; + IMAGEHLP_LINEW64 = _IMAGEHLP_LINEW64; + PIMAGEHLP_LINEW64 = ^_IMAGEHLP_LINEW64; + TImageHlpLineW64 = _IMAGEHLP_LINEW64; + PImageHlpLineW64 = PIMAGEHLP_LINEW64; + +// line 1475 + +// +// options that are set/returned by SymSetOptions() & SymGetOptions() +// these are used as a mask +// + +const + SYMOPT_CASE_INSENSITIVE = $00000001; + {$EXTERNALSYM SYMOPT_CASE_INSENSITIVE} + SYMOPT_UNDNAME = $00000002; + {$EXTERNALSYM SYMOPT_UNDNAME} + SYMOPT_DEFERRED_LOADS = $00000004; + {$EXTERNALSYM SYMOPT_DEFERRED_LOADS} + SYMOPT_NO_CPP = $00000008; + {$EXTERNALSYM SYMOPT_NO_CPP} + SYMOPT_LOAD_LINES = $00000010; + {$EXTERNALSYM SYMOPT_LOAD_LINES} + SYMOPT_OMAP_FIND_NEAREST = $00000020; + {$EXTERNALSYM SYMOPT_OMAP_FIND_NEAREST} + SYMOPT_LOAD_ANYTHING = $00000040; + {$EXTERNALSYM SYMOPT_LOAD_ANYTHING} + SYMOPT_IGNORE_CVREC = $00000080; + {$EXTERNALSYM SYMOPT_IGNORE_CVREC} + SYMOPT_NO_UNQUALIFIED_LOADS = $00000100; + {$EXTERNALSYM SYMOPT_NO_UNQUALIFIED_LOADS} + SYMOPT_FAIL_CRITICAL_ERRORS = $00000200; + {$EXTERNALSYM SYMOPT_FAIL_CRITICAL_ERRORS} + SYMOPT_EXACT_SYMBOLS = $00000400; + {$EXTERNALSYM SYMOPT_EXACT_SYMBOLS} + SYMOPT_ALLOW_ABSOLUTE_SYMBOLS = $00000800; + {$EXTERNALSYM SYMOPT_ALLOW_ABSOLUTE_SYMBOLS} + SYMOPT_IGNORE_NT_SYMPATH = $00001000; + {$EXTERNALSYM SYMOPT_IGNORE_NT_SYMPATH} + SYMOPT_INCLUDE_32BIT_MODULES = $00002000; + {$EXTERNALSYM SYMOPT_INCLUDE_32BIT_MODULES} + SYMOPT_PUBLICS_ONLY = $00004000; + {$EXTERNALSYM SYMOPT_PUBLICS_ONLY} + SYMOPT_NO_PUBLICS = $00008000; + {$EXTERNALSYM SYMOPT_NO_PUBLICS} + SYMOPT_AUTO_PUBLICS = $00010000; + {$EXTERNALSYM SYMOPT_AUTO_PUBLICS} + SYMOPT_NO_IMAGE_SEARCH = $00020000; + {$EXTERNALSYM SYMOPT_NO_IMAGE_SEARCH} + SYMOPT_SECURE = $00040000; + {$EXTERNALSYM SYMOPT_SECURE} + SYMOPT_NO_PROMPTS = $00080000; + {$EXTERNALSYM SYMOPT_NO_PROMPTS} + + SYMOPT_DEBUG = $80000000; + {$EXTERNALSYM SYMOPT_DEBUG} diff --git a/3rdParty/JCL/source/prototypes/win32api/ImgGuids.int b/3rdParty/JCL/source/prototypes/win32api/ImgGuids.int new file mode 100644 index 00000000..65619e25 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/ImgGuids.int @@ -0,0 +1,9 @@ +// imgguids.h line 75 + +// Property sets +const + FMTID_ImageInformation: TGUID = '{e5836cbe-5eef-4f1d-acde-ae4c43b608ce}'; + {$EXTERNALSYM FMTID_ImageInformation} + FMTID_JpegAppHeaders: TGUID = '{1c4afdcd-6177-43cf-abc7-5f51af39ee85}'; + {$EXTERNALSYM FMTID_JpegAppHeaders} + diff --git a/3rdParty/JCL/source/prototypes/win32api/IoAPI.imp b/3rdParty/JCL/source/prototypes/win32api/IoAPI.imp new file mode 100644 index 00000000..56415a91 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/IoAPI.imp @@ -0,0 +1,14 @@ +{$IFDEF MSWINDOWS} + +type + TCancelIo = function (hFile: THandle): BOOL; stdcall; +var + _CancelIo: TCancelIo = nil; + +function CancelIo(hFile: THandle): BOOL; +begin + GetProcedureAddress(Pointer(@_CancelIo), kernel32, 'CancelIo'); + Result := _CancelIo(hFile); +end; + +{$ENDIF MSWINDOWS} \ No newline at end of file diff --git a/3rdParty/JCL/source/prototypes/win32api/IoAPI.int b/3rdParty/JCL/source/prototypes/win32api/IoAPI.int new file mode 100644 index 00000000..52b7a3ad --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/IoAPI.int @@ -0,0 +1,8 @@ +// IoAPI.h + +{$IFDEF MSWINDOWS} + +function CancelIo(hFile: THandle): BOOL; stdcall; +{$EXTERNALSYM CancelIo} + +{$ENDIF MSWINDOWS} diff --git a/3rdParty/JCL/source/prototypes/win32api/LmAccess.imp b/3rdParty/JCL/source/prototypes/win32api/LmAccess.imp new file mode 100644 index 00000000..adc88c4e --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/LmAccess.imp @@ -0,0 +1,378 @@ +{$IFDEF MSWINDOWS} + +type + TNetUserAdd = function (servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; +var + _NetUserAdd: TNetUserAdd = nil; + +function NetUserAdd(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetUserAdd), netapi32, 'NetUserAdd'); + Result := _NetUserAdd(servername, level, buf, parm_err); +end; + +type + TNetUserEnum = function (servername: LPCWSTR; level, filter: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries, resume_handle: LPDWORD): NET_API_STATUS; stdcall; + +var + _NetUserEnum: TNetUserEnum = nil; + +function NetUserEnum(servername: LPCWSTR; level, filter: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries, resume_handle: LPDWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetUserEnum), netapi32, 'NetUserEnum'); + Result := _NetUserEnum(servername, level, filter, bufptr, prefmaxlen, entriesread, totalentries, resume_handle); +end; + +type + TNetUserGetInfo = function (servername, username: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; stdcall; + +var + _NetUserGetInfo: TNetUserGetInfo = nil; + +function NetUserGetInfo(servername, username: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetUserGetInfo), netapi32, 'NetUserGetInfo'); + Result := _NetUserGetInfo(servername, username, level, bufptr); +end; + +type + TNetUserSetInfo = function (servername, username: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; + +var + _NetUserSetInfo: TNetUserSetInfo = nil; + +function NetUserSetInfo(servername, username: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetUserSetInfo), netapi32, 'NetUserSetInfo'); + Result := _NetUserSetInfo(servername, username, level, buf, parm_err); +end; + +type + TNetUserDel = function (servername: LPCWSTR; username: LPCWSTR): NET_API_STATUS; stdcall; + +var + _NetUserDel: TNetUserDel = nil; + +function NetUserDel(servername: LPCWSTR; username: LPCWSTR): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetUserDel), netapi32, 'NetUserDel'); + Result := _NetUserDel(servername, username); +end; + +type + TNetUserGetGroups = function (servername, username: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD): NET_API_STATUS; stdcall; + +var + _NetUserGetGroups: TNetUserGetGroups = nil; + +function NetUserGetGroups(servername, username: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetUserGetGroups), netapi32, 'NetUserGetGroups'); + Result := _NetUserGetGroups(servername, username, level, bufptr, prefmaxlen, entriesread, totalentries); +end; + +type + TNetUserSetGroups = function (servername, username: LPCWSTR; level: DWORD; buf: PByte; num_entries: DWORD): NET_API_STATUS; stdcall; + +var + _NetUserSetGroups: TNetUserSetGroups = nil; + +function NetUserSetGroups(servername, username: LPCWSTR; level: DWORD; buf: PByte; num_entries: DWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetUserSetGroups), netapi32, 'NetUserSetGroups'); + Result := _NetUserSetGroups(servername, username, level, buf, num_entries); +end; + +type + TNetUserGetLocalGroups = function (servername, username: LPCWSTR; level, flags: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD): NET_API_STATUS; stdcall; + +var + _NetUserGetLocalGroups: TNetUserGetLocalGroups = nil; + +function NetUserGetLocalGroups(servername, username: LPCWSTR; level, flags: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetUserGetLocalGroups), netapi32, 'NetUserGetLocalGroups'); + Result := _NetUserGetLocalGroups(servername, username, level, flags, bufptr, prefmaxlen, entriesread, totalentries); +end; + +type + TNetUserModalsGet = function (servername: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; stdcall; + +var + _NetUserModalsGet: TNetUserModalsGet = nil; + +function NetUserModalsGet(servername: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetUserModalsGet), netapi32, 'NetUserModalsGet'); + Result := _NetUserModalsGet(servername, level, bufptr); +end; + +type + TNetUserModalsSet = function (servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; + +var + _NetUserModalsSet: TNetUserModalsSet = nil; + +function NetUserModalsSet(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetUserModalsSet), netapi32, 'NetUserModalsSet'); + Result := _NetUserModalsSet(servername, level, buf, parm_err); +end; + +type + TNetUserChangePassword = function (domainname, username, oldpassword, newpassword: LPCWSTR): NET_API_STATUS; stdcall; + +var + _NetUserChangePassword: TNetUserChangePassword = nil; + +function NetUserChangePassword(domainname, username, oldpassword, newpassword: LPCWSTR): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetUserChangePassword), netapi32, 'NetUserChangePassword'); + Result := _NetUserChangePassword(domainname, username, oldpassword, newpassword); +end; + +type + TNetGroupAdd = function (servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; + +var + _NetGroupAdd: TNetGroupAdd = nil; + +function NetGroupAdd(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetGroupAdd), netapi32, 'NetGroupAdd'); + Result := _NetGroupAdd(servername, level, buf, parm_err); +end; + +type + TNetGroupAddUser = function (servername, GroupName, username: LPCWSTR): NET_API_STATUS; stdcall; + +var + _NetGroupAddUser: TNetGroupAddUser = nil; + +function NetGroupAddUser(servername, GroupName, username: LPCWSTR): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetGroupAddUser), netapi32, 'NetGroupAddUser'); + Result := _NetGroupAddUser(servername, GroupName, username); +end; + +type + TNetGroupEnum = function (servername: LPCWSTR; level: DWORD; out bufptr: PByte; + prefmaxlen: DWORD; out entriesread, totalentries: DWORD; resume_handle: PDWORD_PTR): NET_API_STATUS; stdcall; + +var + _NetGroupEnum: TNetGroupEnum = nil; + +function NetGroupEnum(servername: LPCWSTR; level: DWORD; out bufptr: PByte; + prefmaxlen: DWORD; out entriesread, totalentries: DWORD; resume_handle: PDWORD_PTR): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetGroupEnum), netapi32, 'NetGroupEnum'); + Result := _NetGroupEnum(servername, level, bufptr, prefmaxlen, entriesread, totalentries, resume_handle); +end; + +type + TNetGroupGetInfo = function (servername, groupname: LPCWSTR; level: DWORD; bufptr: PByte): NET_API_STATUS; stdcall; + +var + _NetGroupGetInfo: TNetGroupGetInfo = nil; + +function NetGroupGetInfo(servername, groupname: LPCWSTR; level: DWORD; bufptr: PByte): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetGroupGetInfo), netapi32, 'NetGroupGetInfo'); + Result := _NetGroupGetInfo(servername, groupname, level, bufptr); +end; + +type + TNetGroupSetInfo = function (servername, groupname: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; + +var + _NetGroupSetInfo: TNetGroupSetInfo = nil; + +function NetGroupSetInfo(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetGroupSetInfo), netapi32, 'NetGroupSetInfo'); + Result := _NetGroupSetInfo(servername, groupname, level, buf, parm_err); +end; + +type + TNetGroupDel = function (servername: LPCWSTR; groupname: LPCWSTR): NET_API_STATUS; stdcall; + +var + _NetGroupDel: TNetGroupDel = nil; + +function NetGroupDel(servername: LPCWSTR; groupname: LPCWSTR): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetGroupDel), netapi32, 'NetGroupDel'); + Result := _NetGroupDel(servername, groupname); +end; + +type + TNetGroupDelUser = function (servername: LPCWSTR; GroupName: LPCWSTR; Username: LPCWSTR): NET_API_STATUS; stdcall; + +var + _NetGroupDelUser: TNetGroupDelUser = nil; + +function NetGroupDelUser(servername: LPCWSTR; GroupName: LPCWSTR; Username: LPCWSTR): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetGroupDelUser), netapi32, 'NetGroupDelUser'); + Result := _NetGroupDelUser(servername, GroupName, Username); +end; + +type + TNetGroupGetUsers = function (servername, groupname: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD; ResumeHandle: PDWORD_PTR): NET_API_STATUS; stdcall; + +var + _NetGroupGetUsers: TNetGroupGetUsers = nil; + +function NetGroupGetUsers(servername, groupname: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD; ResumeHandle: PDWORD_PTR): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetGroupGetUsers), netapi32, 'NetGroupGetUsers'); + Result := _NetGroupGetUsers(servername, groupname, level, bufptr, prefmaxlen, entriesread, totalentries, ResumeHandle); +end; + +type + TNetGroupSetUsers = function (servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; stdcall; + +var + _NetGroupSetUsers: TNetGroupSetUsers = nil; + +function NetGroupSetUsers(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetGroupSetUsers), netapi32, 'NetGroupSetUsers'); + Result := _NetGroupSetUsers(servername, groupname, level, buf, totalentries); +end; + +type + TNetLocalGroupAdd = function (servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; + +var + _NetLocalGroupAdd: TNetLocalGroupAdd = nil; + +function NetLocalGroupAdd(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetLocalGroupAdd), netapi32, 'NetLocalGroupAdd'); + Result := _NetLocalGroupAdd(servername, level, buf, parm_err); +end; + +type + TNetLocalGroupAddMember = function (servername, groupname: LPCWSTR; membersid: PSID): NET_API_STATUS; stdcall; + +var + _NetLocalGroupAddMember: TNetLocalGroupAddMember = nil; + +function NetLocalGroupAddMember(servername, groupname: LPCWSTR; membersid: PSID): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetLocalGroupAddMember), netapi32, 'NetLocalGroupAddMember'); + Result := _NetLocalGroupAddMember(servername, groupname, membersid); +end; + +type + TNetLocalGroupEnum = function (servername: LPCWSTR; level: DWORD; out bufptr: PByte; + prefmaxlen: DWORD; out entriesread, totalentries: DWORD; resumehandle: PDWORD_PTR): NET_API_STATUS; stdcall; + +var + _NetLocalGroupEnum: TNetLocalGroupEnum = nil; + +function NetLocalGroupEnum(servername: LPCWSTR; level: DWORD; out bufptr: PByte; + prefmaxlen: DWORD; out entriesread, totalentries: DWORD; resumehandle: PDWORD_PTR): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetLocalGroupEnum), netapi32, 'NetLocalGroupEnum'); + Result := _NetLocalGroupEnum(servername, level, bufptr, prefmaxlen, entriesread, totalentries, resumehandle); +end; + +type + TNetLocalGroupGetInfo = function (servername, groupname: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; stdcall; + +var + _NetLocalGroupGetInfo: TNetLocalGroupGetInfo = nil; + +function NetLocalGroupGetInfo(servername, groupname: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetLocalGroupGetInfo), netapi32, 'NetLocalGroupGetInfo'); + Result := _NetLocalGroupGetInfo(servername, groupname, level, bufptr); +end; + +type + TNetLocalGroupSetInfo = function (servername, groupname: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; + +var + _NetLocalGroupSetInfo: TNetLocalGroupSetInfo = nil; + +function NetLocalGroupSetInfo(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetLocalGroupSetInfo), netapi32, 'NetLocalGroupSetInfo'); + Result := _NetLocalGroupSetInfo(servername, groupname, level, buf, parm_err); +end; + +type + TNetLocalGroupDel = function (servername: LPCWSTR; groupname: LPCWSTR): NET_API_STATUS; stdcall; + +var + _NetLocalGroupDel: TNetLocalGroupDel = nil; + +function NetLocalGroupDel(servername: LPCWSTR; groupname: LPCWSTR): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetLocalGroupDel), netapi32, 'NetLocalGroupDel'); + Result := _NetLocalGroupDel(servername, groupname); +end; + +type + TNetLocalGroupDelMember = function (servername: LPCWSTR; groupname: LPCWSTR; membersid: PSID): NET_API_STATUS; stdcall; + +var + _NetLocalGroupDelMember: TNetLocalGroupDelMember = nil; + +function NetLocalGroupDelMember(servername: LPCWSTR; groupname: LPCWSTR; membersid: PSID): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetLocalGroupDelMember), netapi32, 'NetLocalGroupDelMember'); + Result := _NetLocalGroupDelMember(servername, groupname, membersid); +end; + +type + TNetLocalGroupGetMembers = function (servername, localgroupname: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD; resumehandle: PDWORD_PTR): NET_API_STATUS; stdcall; + +var + _NetLocalGroupGetMembers: TNetLocalGroupGetMembers = nil; + +function NetLocalGroupGetMembers(servername, localgroupname: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD; resumehandle: PDWORD_PTR): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetLocalGroupGetMembers), netapi32, 'NetLocalGroupGetMembers'); + Result := _NetLocalGroupGetMembers(servername, localgroupname, level, bufptr, prefmaxlen, entriesread, totalentries, resumehandle); +end; + +type + TNetLocalGroupSetMembers = function (servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; stdcall; + +var + _NetLocalGroupSetMembers: TNetLocalGroupSetMembers = nil; + +function NetLocalGroupSetMembers(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetLocalGroupSetMembers), netapi32, 'NetLocalGroupSetMembers'); + Result := _NetLocalGroupSetMembers(servername, groupname, level, buf, totalentries); +end; + +type + TNetLocalGroupAddMembers = function (servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; stdcall; + +var + _NetLocalGroupAddMembers: TNetLocalGroupAddMembers = nil; + +function NetLocalGroupAddMembers(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetLocalGroupAddMembers), netapi32, 'NetLocalGroupAddMembers'); + Result := _NetLocalGroupAddMembers(servername, groupname, level, buf, totalentries); +end; + +type + TNetLocalGroupDelMembers = function (servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; stdcall; + +var + _NetLocalGroupDelMembers: TNetLocalGroupDelMembers = nil; + +function NetLocalGroupDelMembers(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetLocalGroupDelMembers), netapi32, 'NetLocalGroupDelMembers'); + Result := _NetLocalGroupDelMembers(servername, groupname, level, buf, totalentries); +end; + +{$ENDIF MSWINDOWS} diff --git a/3rdParty/JCL/source/prototypes/win32api/LmAccess.int b/3rdParty/JCL/source/prototypes/win32api/LmAccess.int new file mode 100644 index 00000000..cf8c19df --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/LmAccess.int @@ -0,0 +1,470 @@ +// line 59 + +// +// Function Prototypes - User +// + +{$IFDEF MSWINDOWS} + +function NetUserAdd(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetUserAdd} + +function NetUserEnum(servername: LPCWSTR; level, filter: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries, resume_handle: LPDWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetUserEnum} + +function NetUserGetInfo(servername, username: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetUserGetInfo} + +function NetUserSetInfo(servername, username: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetUserSetInfo} + +function NetUserDel(servername: LPCWSTR; username: LPCWSTR): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetUserDel} + +function NetUserGetGroups(servername, username: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetUserGetGroups} + +function NetUserSetGroups(servername, username: LPCWSTR; level: DWORD; buf: PByte; num_entries: DWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetUserSetGroups} + +function NetUserGetLocalGroups(servername, username: LPCWSTR; level, flags: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetUserGetLocalGroups} + +function NetUserModalsGet(servername: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetUserModalsGet} + +function NetUserModalsSet(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetUserModalsSet} + +function NetUserChangePassword(domainname, username, oldpassword, newpassword: LPCWSTR): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetUserChangePassword} + +{$ENDIF MSWINDOWS} + +// +// Data Structures - User +// + +type + {$IFNDEF FPC} + LPUSER_INFO_0 = ^USER_INFO_0; + {$EXTERNALSYM LPUSER_INFO_0} + PUSER_INFO_0 = ^USER_INFO_0; + {$EXTERNALSYM PUSER_INFO_0} + _USER_INFO_0 = record + usri0_name: LPWSTR; + end; + {$EXTERNALSYM _USER_INFO_0} + USER_INFO_0 = _USER_INFO_0; + {$EXTERNALSYM USER_INFO_0} + TUserInfo0 = USER_INFO_0; + PUserInfo0 = PUSER_INFO_0; + {$ENDIF ~FPC} + + LPUSER_INFO_1 = ^USER_INFO_1; + {$EXTERNALSYM LPUSER_INFO_1} + PUSER_INFO_1 = ^USER_INFO_1; + {$EXTERNALSYM PUSER_INFO_1} + _USER_INFO_1 = record + usri1_name: LPWSTR; + usri1_password: LPWSTR; + usri1_password_age: DWORD; + usri1_priv: DWORD; + usri1_home_dir: LPWSTR; + usri1_comment: LPWSTR; + usri1_flags: DWORD; + usri1_script_path: LPWSTR; + end; + {$EXTERNALSYM _USER_INFO_1} + USER_INFO_1 = _USER_INFO_1; + {$EXTERNALSYM USER_INFO_1} + TUserInfo1 = USER_INFO_1; + PUserInfo1 = PUSER_INFO_1; + + {$IFNDEF FPC} + LPUSER_INFO_2 = ^USER_INFO_2; + {$EXTERNALSYM LPUSER_INFO_2} + PUSER_INFO_2 = ^USER_INFO_2; + {$EXTERNALSYM PUSER_INFO_2} + _USER_INFO_2 = record + usri2_name: LPWSTR; + usri2_password: LPWSTR; + usri2_password_age: DWORD; + usri2_priv: DWORD; + usri2_home_dir: LPWSTR; + usri2_comment: LPWSTR; + usri2_flags: DWORD; + usri2_script_path: LPWSTR; + usri2_auth_flags: DWORD; + usri2_full_name: LPWSTR; + usri2_usr_comment: LPWSTR; + usri2_parms: LPWSTR; + usri2_workstations: LPWSTR; + usri2_last_logon: DWORD; + usri2_last_logoff: DWORD; + usri2_acct_expires: DWORD; + usri2_max_storage: DWORD; + usri2_units_per_week: DWORD; + usri2_logon_hours: PBYTE; + usri2_bad_pw_count: DWORD; + usri2_num_logons: DWORD; + usri2_logon_server: LPWSTR; + usri2_country_code: DWORD; + usri2_code_page: DWORD; + end; + {$EXTERNALSYM _USER_INFO_2} + USER_INFO_2 = _USER_INFO_2; + {$EXTERNALSYM USER_INFO_2} + TUserInfo2 = USER_INFO_2; + PUserInfo2 = puser_info_2; + {$ENDIF ~FPC} + +// line 799 + +// +// Special Values and Constants - User +// + +// +// Bit masks for field usriX_flags of USER_INFO_X (X = 0/1). +// + +const + UF_SCRIPT = $0001; + {$EXTERNALSYM UF_SCRIPT} + UF_ACCOUNTDISABLE = $0002; + {$EXTERNALSYM UF_ACCOUNTDISABLE} + UF_HOMEDIR_REQUIRED = $0008; + {$EXTERNALSYM UF_HOMEDIR_REQUIRED} + UF_LOCKOUT = $0010; + {$EXTERNALSYM UF_LOCKOUT} + UF_PASSWD_NOTREQD = $0020; + {$EXTERNALSYM UF_PASSWD_NOTREQD} + UF_PASSWD_CANT_CHANGE = $0040; + {$EXTERNALSYM UF_PASSWD_CANT_CHANGE} + UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED = $0080; + {$EXTERNALSYM UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED} + +// +// Account type bits as part of usri_flags. +// + + UF_TEMP_DUPLICATE_ACCOUNT = $0100; + {$EXTERNALSYM UF_TEMP_DUPLICATE_ACCOUNT} + UF_NORMAL_ACCOUNT = $0200; + {$EXTERNALSYM UF_NORMAL_ACCOUNT} + UF_INTERDOMAIN_TRUST_ACCOUNT = $0800; + {$EXTERNALSYM UF_INTERDOMAIN_TRUST_ACCOUNT} + UF_WORKSTATION_TRUST_ACCOUNT = $1000; + {$EXTERNALSYM UF_WORKSTATION_TRUST_ACCOUNT} + UF_SERVER_TRUST_ACCOUNT = $2000; + {$EXTERNALSYM UF_SERVER_TRUST_ACCOUNT} + + UF_MACHINE_ACCOUNT_MASK = UF_INTERDOMAIN_TRUST_ACCOUNT or UF_WORKSTATION_TRUST_ACCOUNT or UF_SERVER_TRUST_ACCOUNT; + {$EXTERNALSYM UF_MACHINE_ACCOUNT_MASK} + + UF_ACCOUNT_TYPE_MASK = UF_TEMP_DUPLICATE_ACCOUNT or UF_NORMAL_ACCOUNT or + UF_INTERDOMAIN_TRUST_ACCOUNT or UF_WORKSTATION_TRUST_ACCOUNT or UF_SERVER_TRUST_ACCOUNT; + {$EXTERNALSYM UF_ACCOUNT_TYPE_MASK} + + UF_DONT_EXPIRE_PASSWD = $10000; + {$EXTERNALSYM UF_DONT_EXPIRE_PASSWD} + UF_MNS_LOGON_ACCOUNT = $20000; + {$EXTERNALSYM UF_MNS_LOGON_ACCOUNT} + UF_SMARTCARD_REQUIRED = $40000; + {$EXTERNALSYM UF_SMARTCARD_REQUIRED} + UF_TRUSTED_FOR_DELEGATION = $80000; + {$EXTERNALSYM UF_TRUSTED_FOR_DELEGATION} + UF_NOT_DELEGATED = $100000; + {$EXTERNALSYM UF_NOT_DELEGATED} + UF_USE_DES_KEY_ONLY = $200000; + {$EXTERNALSYM UF_USE_DES_KEY_ONLY} + UF_DONT_REQUIRE_PREAUTH = $400000; + {$EXTERNALSYM UF_DONT_REQUIRE_PREAUTH} + UF_PASSWORD_EXPIRED = DWORD($800000); + {$EXTERNALSYM UF_PASSWORD_EXPIRED} + UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION = $1000000; + {$EXTERNALSYM UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION} + + + UF_SETTABLE_BITS = + UF_SCRIPT or + UF_ACCOUNTDISABLE or + UF_LOCKOUT or + UF_HOMEDIR_REQUIRED or + UF_PASSWD_NOTREQD or + UF_PASSWD_CANT_CHANGE or + UF_ACCOUNT_TYPE_MASK or + UF_DONT_EXPIRE_PASSWD or + UF_MNS_LOGON_ACCOUNT or + UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED or + UF_SMARTCARD_REQUIRED or + UF_TRUSTED_FOR_DELEGATION or + UF_NOT_DELEGATED or + UF_USE_DES_KEY_ONLY or + UF_DONT_REQUIRE_PREAUTH or + UF_PASSWORD_EXPIRED or + UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION; + {$EXTERNALSYM UF_SETTABLE_BITS} + +// line 1056 + +// +// For SetInfo call (parmnum 0) when password change not required +// + + NULL_USERSETINFO_PASSWD = ' '; + {$EXTERNALSYM NULL_USERSETINFO_PASSWD} + + TIMEQ_FOREVER = ULONG(-1); + {$EXTERNALSYM TIMEQ_FOREVER} + USER_MAXSTORAGE_UNLIMITED = ULONG(-1); + {$EXTERNALSYM USER_MAXSTORAGE_UNLIMITED} + USER_NO_LOGOFF = ULONG(-1); + {$EXTERNALSYM USER_NO_LOGOFF} + UNITS_PER_DAY = 24; + {$EXTERNALSYM UNITS_PER_DAY} + UNITS_PER_WEEK = UNITS_PER_DAY * 7; + {$EXTERNALSYM UNITS_PER_WEEK} + +// +// Privilege levels (USER_INFO_X field usriX_priv (X = 0/1)). +// + + USER_PRIV_MASK = $3; + {$EXTERNALSYM USER_PRIV_MASK} + USER_PRIV_GUEST = 0; + {$EXTERNALSYM USER_PRIV_GUEST} + USER_PRIV_USER = 1; + {$EXTERNALSYM USER_PRIV_USER} + USER_PRIV_ADMIN = 2; + {$EXTERNALSYM USER_PRIV_ADMIN} + +// line 1177 + +// +// Group Class +// + +// +// Function Prototypes +// + +{$IFDEF MSWINDOWS} + +function NetGroupAdd(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetGroupAdd} + +function NetGroupAddUser(servername, GroupName, username: LPCWSTR): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetGroupAddUser} + +function NetGroupEnum(servername: LPCWSTR; level: DWORD; out bufptr: PByte; + prefmaxlen: DWORD; out entriesread, totalentries: DWORD; resume_handle: PDWORD_PTR): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetGroupEnum} + +function NetGroupGetInfo(servername, groupname: LPCWSTR; level: DWORD; bufptr: PByte): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetGroupGetInfo} + +function NetGroupSetInfo(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetGroupSetInfo} + +function NetGroupDel(servername: LPCWSTR; groupname: LPCWSTR): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetGroupDel} + +function NetGroupDelUser(servername: LPCWSTR; GroupName: LPCWSTR; Username: LPCWSTR): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetGroupDelUser} + +function NetGroupGetUsers(servername, groupname: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD; ResumeHandle: PDWORD_PTR): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetGroupGetUsers} + +function NetGroupSetUsers(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetGroupSetUsers} + +{$ENDIF MSWINDOWS} + +// +// Data Structures - Group +// + +type + LPGROUP_INFO_0 = ^GROUP_INFO_0; + {$EXTERNALSYM LPGROUP_INFO_0} + PGROUP_INFO_0 = ^GROUP_INFO_0; + {$EXTERNALSYM PGROUP_INFO_0} + _GROUP_INFO_0 = record + grpi0_name: LPWSTR; + end; + {$EXTERNALSYM _GROUP_INFO_0} + GROUP_INFO_0 = _GROUP_INFO_0; + {$EXTERNALSYM GROUP_INFO_0} + TGroupInfo0 = GROUP_INFO_0; + PGroupInfo0 = PGROUP_INFO_0; + + LPGROUP_INFO_1 = ^GROUP_INFO_1; + {$EXTERNALSYM LPGROUP_INFO_1} + PGROUP_INFO_1 = ^GROUP_INFO_1; + {$EXTERNALSYM PGROUP_INFO_1} + _GROUP_INFO_1 = record + grpi1_name: LPWSTR; + grpi1_comment: LPWSTR; + end; + {$EXTERNALSYM _GROUP_INFO_1} + GROUP_INFO_1 = _GROUP_INFO_1; + {$EXTERNALSYM GROUP_INFO_1} + TGroupInfo1 = GROUP_INFO_1; + PGroupInfo1 = PGROUP_INFO_1; + +// line 1380 + +// +// LocalGroup Class +// + +// +// Function Prototypes +// + +{$IFDEF MSWINDOWS} + +function NetLocalGroupAdd(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetLocalGroupAdd} + +function NetLocalGroupAddMember(servername, groupname: LPCWSTR; membersid: PSID): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetLocalGroupAddMember} + +function NetLocalGroupEnum(servername: LPCWSTR; level: DWORD; out bufptr: PByte; + prefmaxlen: DWORD; out entriesread, totalentries: DWORD; resumehandle: PDWORD_PTR): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetLocalGroupEnum} + +function NetLocalGroupGetInfo(servername, groupname: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetLocalGroupGetInfo} + +function NetLocalGroupSetInfo(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetLocalGroupSetInfo} + +function NetLocalGroupDel(servername: LPCWSTR; groupname: LPCWSTR): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetLocalGroupDel} + +function NetLocalGroupDelMember(servername: LPCWSTR; groupname: LPCWSTR; membersid: PSID): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetLocalGroupDelMember} + +function NetLocalGroupGetMembers(servername, localgroupname: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD; resumehandle: PDWORD_PTR): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetLocalGroupGetMembers} + +function NetLocalGroupSetMembers(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetLocalGroupSetMembers} + +function NetLocalGroupAddMembers(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetLocalGroupAddMembers} + +function NetLocalGroupDelMembers(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetLocalGroupDelMembers} + +{$ENDIF MSWINDOWS} + +// +// Data Structures - LocalGroup +// + +type + {$IFNDEF FPC} + LPLOCALGROUP_INFO_0 = ^LOCALGROUP_INFO_0; + {$EXTERNALSYM LPLOCALGROUP_INFO_0} + PLOCALGROUP_INFO_0 = ^LOCALGROUP_INFO_0; + {$EXTERNALSYM PLOCALGROUP_INFO_0} + _LOCALGROUP_INFO_0 = record + lgrpi0_name: LPWSTR; + end; + {$EXTERNALSYM _LOCALGROUP_INFO_0} + LOCALGROUP_INFO_0 = _LOCALGROUP_INFO_0; + {$EXTERNALSYM LOCALGROUP_INFO_0} + TLocalGroupInfo0 = LOCALGROUP_INFO_0; + PLocalGroupInfo0 = PLOCALGROUP_INFO_0; + {$ENDIF ~FPC} + + LPLOCALGROUP_INFO_1 = ^LOCALGROUP_INFO_1; + {$EXTERNALSYM LPLOCALGROUP_INFO_1} + PLOCALGROUP_INFO_1 = ^LOCALGROUP_INFO_1; + {$EXTERNALSYM PLOCALGROUP_INFO_1} + _LOCALGROUP_INFO_1 = record + lgrpi1_name: LPWSTR; + lgrpi1_comment: LPWSTR; + end; + {$EXTERNALSYM _LOCALGROUP_INFO_1} + LOCALGROUP_INFO_1 = _LOCALGROUP_INFO_1; + {$EXTERNALSYM LOCALGROUP_INFO_1} + TLocalGroupInfo1 = LOCALGROUP_INFO_1; + PLocalGroupInfo1 = PLOCALGROUP_INFO_1; + + LPLOCALGROUP_INFO_1002 = ^LOCALGROUP_INFO_1002; + {$EXTERNALSYM LPLOCALGROUP_INFO_1002} + PLOCALGROUP_INFO_1002 = ^LOCALGROUP_INFO_1002; + {$EXTERNALSYM PLOCALGROUP_INFO_1002} + _LOCALGROUP_INFO_1002 = record + lgrpi1002_comment: LPWSTR; + end; + {$EXTERNALSYM _LOCALGROUP_INFO_1002} + LOCALGROUP_INFO_1002 = _LOCALGROUP_INFO_1002; + {$EXTERNALSYM LOCALGROUP_INFO_1002} + TLocalGroupInfo1002 = LOCALGROUP_INFO_1002; + PLocalGroupInfo1002 = PLOCALGROUP_INFO_1002; + + {$IFNDEF FPC} + LPLOCALGROUP_MEMBERS_INFO_0 = ^LOCALGROUP_MEMBERS_INFO_0; + {$EXTERNALSYM LPLOCALGROUP_MEMBERS_INFO_0} + PLOCALGROUP_MEMBERS_INFO_0 = ^LOCALGROUP_MEMBERS_INFO_0; + {$EXTERNALSYM PLOCALGROUP_MEMBERS_INFO_0} + _LOCALGROUP_MEMBERS_INFO_0 = record + lgrmi0_sid: PSID; + end; + {$EXTERNALSYM _LOCALGROUP_MEMBERS_INFO_0} + LOCALGROUP_MEMBERS_INFO_0 = _LOCALGROUP_MEMBERS_INFO_0; + {$EXTERNALSYM LOCALGROUP_MEMBERS_INFO_0} + TLocalGroupMembersInfo0 = LOCALGROUP_MEMBERS_INFO_0; + PLocalGroupMembersInfo0 = PLOCALGROUP_MEMBERS_INFO_0; + {$ENDIF ~FPC} + + LPLOCALGROUP_MEMBERS_INFO_1 = ^LOCALGROUP_MEMBERS_INFO_1; + {$EXTERNALSYM LPLOCALGROUP_MEMBERS_INFO_1} + PLOCALGROUP_MEMBERS_INFO_1 = ^LOCALGROUP_MEMBERS_INFO_1; + {$EXTERNALSYM PLOCALGROUP_MEMBERS_INFO_1} + _LOCALGROUP_MEMBERS_INFO_1 = record + lgrmi1_sid: PSID; + lgrmi1_sidusage: SID_NAME_USE; + lgrmi1_name: LPWSTR; + end; + {$EXTERNALSYM _LOCALGROUP_MEMBERS_INFO_1} + LOCALGROUP_MEMBERS_INFO_1 = _LOCALGROUP_MEMBERS_INFO_1; + {$EXTERNALSYM LOCALGROUP_MEMBERS_INFO_1} + TLocalGroupMembersInfo1 = LOCALGROUP_MEMBERS_INFO_1; + PLocalGroupMembersInfo1 = PLOCALGROUP_MEMBERS_INFO_1; + + LPLOCALGROUP_MEMBERS_INFO_2 = ^LOCALGROUP_MEMBERS_INFO_2; + {$EXTERNALSYM LPLOCALGROUP_MEMBERS_INFO_2} + PLOCALGROUP_MEMBERS_INFO_2 = ^LOCALGROUP_MEMBERS_INFO_2; + {$EXTERNALSYM PLOCALGROUP_MEMBERS_INFO_2} + _LOCALGROUP_MEMBERS_INFO_2 = record + lgrmi2_sid: PSID; + lgrmi2_sidusage: SID_NAME_USE; + lgrmi2_domainandname: LPWSTR; + end; + {$EXTERNALSYM _LOCALGROUP_MEMBERS_INFO_2} + LOCALGROUP_MEMBERS_INFO_2 = _LOCALGROUP_MEMBERS_INFO_2; + {$EXTERNALSYM LOCALGROUP_MEMBERS_INFO_2} + TLocalGroupMembersInfo2 = LOCALGROUP_MEMBERS_INFO_2; + PLocalGroupMembersInfo2 = PLOCALGROUP_MEMBERS_INFO_2; + + {$IFNDEF FPC} + LPLOCALGROUP_MEMBERS_INFO_3 = ^LOCALGROUP_MEMBERS_INFO_3; + {$EXTERNALSYM LPLOCALGROUP_MEMBERS_INFO_3} + PLOCALGROUP_MEMBERS_INFO_3 = ^LOCALGROUP_MEMBERS_INFO_3; + {$EXTERNALSYM PLOCALGROUP_MEMBERS_INFO_3} + _LOCALGROUP_MEMBERS_INFO_3 = record + lgrmi3_domainandname: LPWSTR; + end; + {$EXTERNALSYM _LOCALGROUP_MEMBERS_INFO_3} + LOCALGROUP_MEMBERS_INFO_3 = _LOCALGROUP_MEMBERS_INFO_3; + {$EXTERNALSYM LOCALGROUP_MEMBERS_INFO_3} + TLocalGroupMembersInfo3 = LOCALGROUP_MEMBERS_INFO_3; + PLocalGroupMembersInfo3 = PLOCALGROUP_MEMBERS_INFO_3; + {$ENDIF ~FPC} diff --git a/3rdParty/JCL/source/prototypes/win32api/LmApiBuf.imp b/3rdParty/JCL/source/prototypes/win32api/LmApiBuf.imp new file mode 100644 index 00000000..32160c7b --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/LmApiBuf.imp @@ -0,0 +1,15 @@ +{$IFDEF MSWINDOWS} + +type + TNetApiBufferFree = function (Buffer: Pointer): NET_API_STATUS; stdcall; + +var + _NetApiBufferFree: TNetApiBufferFree = nil; + +function NetApiBufferFree(Buffer: Pointer): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetApiBufferFree), netapi32, 'NetApiBufferFree'); + Result := _NetApiBufferFree(Buffer); +end; + +{$ENDIF MSWINDOWS} diff --git a/3rdParty/JCL/source/prototypes/win32api/LmApiBuf.int b/3rdParty/JCL/source/prototypes/win32api/LmApiBuf.int new file mode 100644 index 00000000..39861e45 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/LmApiBuf.int @@ -0,0 +1,4 @@ +{$IFDEF MSWINDOWS} +function NetApiBufferFree(Buffer: Pointer): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetApiBufferFree} +{$ENDIF MSWINDOWS} diff --git a/3rdParty/JCL/source/prototypes/win32api/LmCons.int b/3rdParty/JCL/source/prototypes/win32api/LmCons.int new file mode 100644 index 00000000..daa7119f --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/LmCons.int @@ -0,0 +1,278 @@ +// JwaLmCons, complete +// LAN Manager common definitions + +const + NetApi32 = 'netapi32.dll'; + +// +// NOTE: Lengths of strings are given as the maximum lengths of the +// string in characters (not bytes). This does not include space for the +// terminating 0-characters. When allocating space for such an item, +// use the form: +// +// TCHAR username[UNLEN+1]; +// +// Definitions of the form LN20_* define those values in effect for +// LanMan 2.0. +// + +// +// String Lengths for various LanMan names +// + +const + CNLEN = 15; // Computer name length + {$EXTERNALSYM CNLEN} + LM20_CNLEN = 15; // LM 2.0 Computer name length + {$EXTERNALSYM LM20_CNLEN} + DNLEN = CNLEN; // Maximum domain name length + {$EXTERNALSYM DNLEN} + LM20_DNLEN = LM20_CNLEN; // LM 2.0 Maximum domain name length + {$EXTERNALSYM LM20_DNLEN} + +//#if (CNLEN != DNLEN) +//#error CNLEN and DNLEN are not equal +//#endif + + UNCLEN = (CNLEN+2); // UNC computer name length + {$EXTERNALSYM UNCLEN} + LM20_UNCLEN = (LM20_CNLEN+2); // LM 2.0 UNC computer name length + {$EXTERNALSYM LM20_UNCLEN} + + NNLEN = 80; // Net name length (share name) + {$EXTERNALSYM NNLEN} + LM20_NNLEN = 12; // LM 2.0 Net name length + {$EXTERNALSYM LM20_NNLEN} + + RMLEN = (UNCLEN+1+NNLEN); // Max remote name length + {$EXTERNALSYM RMLEN} + LM20_RMLEN = (LM20_UNCLEN+1+LM20_NNLEN); // LM 2.0 Max remote name length + {$EXTERNALSYM LM20_RMLEN} + + SNLEN = 80; // Service name length + {$EXTERNALSYM SNLEN} + LM20_SNLEN = 15; // LM 2.0 Service name length + {$EXTERNALSYM LM20_SNLEN} + STXTLEN = 256; // Service text length + {$EXTERNALSYM STXTLEN} + LM20_STXTLEN = 63; // LM 2.0 Service text length + {$EXTERNALSYM LM20_STXTLEN} + + PATHLEN = 256; // Max. path (not including drive name) + {$EXTERNALSYM PATHLEN} + LM20_PATHLEN = 256; // LM 2.0 Max. path + {$EXTERNALSYM LM20_PATHLEN} + + DEVLEN = 80; // Device name length + {$EXTERNALSYM DEVLEN} + LM20_DEVLEN = 8; // LM 2.0 Device name length + {$EXTERNALSYM LM20_DEVLEN} + + EVLEN = 16; // Event name length + {$EXTERNALSYM EVLEN} + +// +// User, Group and Password lengths +// + + UNLEN = 256; // Maximum user name length + {$EXTERNALSYM UNLEN} + LM20_UNLEN = 20; // LM 2.0 Maximum user name length + {$EXTERNALSYM LM20_UNLEN} + + GNLEN = UNLEN; // Group name + {$EXTERNALSYM GNLEN} + LM20_GNLEN = LM20_UNLEN; // LM 2.0 Group name + {$EXTERNALSYM LM20_GNLEN} + + PWLEN = 256; // Maximum password length + {$EXTERNALSYM PWLEN} + LM20_PWLEN = 14; // LM 2.0 Maximum password length + {$EXTERNALSYM LM20_PWLEN} + + SHPWLEN = 8; // Share password length (bytes) + {$EXTERNALSYM SHPWLEN} + + CLTYPE_LEN = 12; // Length of client type string + {$EXTERNALSYM CLTYPE_LEN} + + MAXCOMMENTSZ = 256; // Multipurpose comment length + {$EXTERNALSYM MAXCOMMENTSZ} + LM20_MAXCOMMENTSZ = 48; // LM 2.0 Multipurpose comment length + {$EXTERNALSYM LM20_MAXCOMMENTSZ} + + QNLEN = NNLEN; // Queue name maximum length + {$EXTERNALSYM QNLEN} + LM20_QNLEN = LM20_NNLEN; // LM 2.0 Queue name maximum length + {$EXTERNALSYM LM20_QNLEN} + +//#if (QNLEN != NNLEN) +//# error QNLEN and NNLEN are not equal +//#endif + +// +// The ALERTSZ and MAXDEVENTRIES defines have not yet been NT'ized. +// Whoever ports these components should change these values appropriately. +// + + ALERTSZ = 128; // size of alert string in server + {$EXTERNALSYM ALERTSZ} + MAXDEVENTRIES = (SizeOf(Integer)*8); // Max number of device entries + {$EXTERNALSYM MAXDEVENTRIES} + + // + // We use int bitmap to represent + // + + NETBIOS_NAME_LEN = 16; // NetBIOS net name (bytes) + {$EXTERNALSYM NETBIOS_NAME_LEN} + +// +// Value to be used with APIs which have a "preferred maximum length" +// parameter. This value indicates that the API should just allocate +// "as much as it takes." +// + + MAX_PREFERRED_LENGTH = DWORD(-1); + {$EXTERNALSYM MAX_PREFERRED_LENGTH} + +// +// Constants used with encryption +// + + CRYPT_KEY_LEN = 7; + {$EXTERNALSYM CRYPT_KEY_LEN} + CRYPT_TXT_LEN = 8; + {$EXTERNALSYM CRYPT_TXT_LEN} + ENCRYPTED_PWLEN = 16; + {$EXTERNALSYM ENCRYPTED_PWLEN} + SESSION_PWLEN = 24; + {$EXTERNALSYM SESSION_PWLEN} + SESSION_CRYPT_KLEN = 21; + {$EXTERNALSYM SESSION_CRYPT_KLEN} + +// +// Value to be used with SetInfo calls to allow setting of all +// settable parameters (parmnum zero option) +// + + PARMNUM_ALL = 0; + {$EXTERNALSYM PARMNUM_ALL} + + PARM_ERROR_UNKNOWN = DWORD(-1); + {$EXTERNALSYM PARM_ERROR_UNKNOWN} + PARM_ERROR_NONE = 0; + {$EXTERNALSYM PARM_ERROR_NONE} + PARMNUM_BASE_INFOLEVEL = 1000; + {$EXTERNALSYM PARMNUM_BASE_INFOLEVEL} + +// +// Only the UNICODE version of the LM APIs are available on NT. +// Non-UNICODE version on other platforms +// + +//#if defined( _WIN32_WINNT ) || defined( WINNT ) || defined( FORCE_UNICODE ) + +{$IFDEF _WIN32_WINNT} +{$DEFINE LM_USE_UNICODE} +{$ENDIF} + +{$IFDEF FORCE_UNICODE} +{$DEFINE LM_USE_UNICODE} +{$ENDIF} + +{$IFDEF LM_USE_UNICODE} + +type + LMSTR = LPWSTR; + {$EXTERNALSYM LMSTR} + LMCSTR = LPCWSTR; + {$EXTERNALSYM LMCSTR} + PLMSTR = ^LMSTR; + {$NODEFINE PLMSTR} + +{$ELSE ~LM_USE_UNICODE} + +type + LMSTR = LPSTR; + {$EXTERNALSYM LMSTR} + LMCSTR = LPCSTR; + {$EXTERNALSYM LMCSTR} + +{$ENDIF ~LM_USE_UNICODE} + +// +// Message File Names +// + +const + MESSAGE_FILENAME = 'NETMSG'; + {$EXTERNALSYM MESSAGE_FILENAME} + OS2MSG_FILENAME = 'BASE'; + {$EXTERNALSYM OS2MSG_FILENAME} + HELP_MSG_FILENAME = 'NETH'; + {$EXTERNALSYM HELP_MSG_FILENAME} + +// ** INTERNAL_ONLY ** + +// The backup message file named here is a duplicate of net.msg. It +// is not shipped with the product, but is used at buildtime to +// msgbind certain messages to netapi.dll and some of the services. +// This allows for OEMs to modify the message text in net.msg and +// have those changes show up. Only in case there is an error in +// retrieving the messages from net.msg do we then get the bound +// messages out of bak.msg (really out of the message segment). + + BACKUP_MSG_FILENAME = 'BAK.MSG'; + {$EXTERNALSYM BACKUP_MSG_FILENAME} + +// ** END_INTERNAL ** + +// +// Keywords used in Function Prototypes +// + +type + NET_API_STATUS = DWORD; + {$EXTERNALSYM NET_API_STATUS} + TNetApiStatus = NET_API_STATUS; + +// +// The platform ID indicates the levels to use for platform-specific +// information. +// + +const + PLATFORM_ID_DOS = 300; + {$EXTERNALSYM PLATFORM_ID_DOS} + PLATFORM_ID_OS2 = 400; + {$EXTERNALSYM PLATFORM_ID_OS2} + PLATFORM_ID_NT = 500; + {$EXTERNALSYM PLATFORM_ID_NT} + PLATFORM_ID_OSF = 600; + {$EXTERNALSYM PLATFORM_ID_OSF} + PLATFORM_ID_VMS = 700; + {$EXTERNALSYM PLATFORM_ID_VMS} + +// +// There message numbers assigned to different LANMAN components +// are as defined below. +// +// lmerr.h: 2100 - 2999 NERR_BASE +// alertmsg.h: 3000 - 3049 ALERT_BASE +// lmsvc.h: 3050 - 3099 SERVICE_BASE +// lmerrlog.h: 3100 - 3299 ERRLOG_BASE +// msgtext.h: 3300 - 3499 MTXT_BASE +// apperr.h: 3500 - 3999 APPERR_BASE +// apperrfs.h: 4000 - 4299 APPERRFS_BASE +// apperr2.h: 4300 - 5299 APPERR2_BASE +// ncberr.h: 5300 - 5499 NRCERR_BASE +// alertmsg.h: 5500 - 5599 ALERT2_BASE +// lmsvc.h: 5600 - 5699 SERVICE2_BASE +// lmerrlog.h 5700 - 5899 ERRLOG2_BASE +// + + MIN_LANMAN_MESSAGE_ID = NERR_BASE; + {$EXTERNALSYM MIN_LANMAN_MESSAGE_ID} + MAX_LANMAN_MESSAGE_ID = 5899; + {$EXTERNALSYM MAX_LANMAN_MESSAGE_ID} diff --git a/3rdParty/JCL/source/prototypes/win32api/LmErr.int b/3rdParty/JCL/source/prototypes/win32api/LmErr.int new file mode 100644 index 00000000..35704ab3 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/LmErr.int @@ -0,0 +1,891 @@ + +const + NERR_Success = 0; // Success + {$EXTERNALSYM NERR_Success} + +// ERROR_ equates can be intermixed with NERR_ equates. + +// NERR_BASE is the base of error codes from network utilities, +// chosen to avoid conflict with system and redirector error codes. +// 2100 is a value that has been assigned to us by system. + + NERR_BASE = 2100; + {$EXTERNALSYM NERR_BASE} + + +//*INTERNAL_ONLY* + +{**********WARNING ***************** + *See the comment in lmcons.h for * + *info on the allocation of errors * + ***********************************} + +{**********WARNING ***************** + *The range 2750-2799 has been * + *allocated to the IBM LAN Server * + ***********************************} + +{**********WARNING ***************** + *The range 2900-2999 has been * + *reserved for Microsoft OEMs * + ***********************************} + +// UNUSED BASE+0 +// UNUSED BASE+1 + NERR_NetNotStarted = (NERR_BASE+2); // The workstation driver is not installed. + {$EXTERNALSYM NERR_NetNotStarted} + NERR_UnknownServer = (NERR_BASE+3); // The server could not be located. + {$EXTERNALSYM NERR_UnknownServer} + NERR_ShareMem = (NERR_BASE+4); // An internal error occurred. The network cannot access a shared memory segment. + {$EXTERNALSYM NERR_ShareMem} + + NERR_NoNetworkResource = (NERR_BASE+5); // A network resource shortage occurred . + {$EXTERNALSYM NERR_NoNetworkResource} + NERR_RemoteOnly = (NERR_BASE+6); // This operation is not supported on workstations. + {$EXTERNALSYM NERR_RemoteOnly} + NERR_DevNotRedirected = (NERR_BASE+7); // The device is not connected. + {$EXTERNALSYM NERR_DevNotRedirected} +// NERR_BASE+8 is used for ERROR_CONNECTED_OTHER_PASSWORD +// NERR_BASE+9 is used for ERROR_CONNECTED_OTHER_PASSWORD_DEFAULT +// UNUSED BASE+10 +// UNUSED BASE+11 +// UNUSED BASE+12 +// UNUSED BASE+13 + NERR_ServerNotStarted = (NERR_BASE+14); // The Server service is not started. + {$EXTERNALSYM NERR_ServerNotStarted} + NERR_ItemNotFound = (NERR_BASE+15); // The queue is empty. + {$EXTERNALSYM NERR_ItemNotFound} + NERR_UnknownDevDir = (NERR_BASE+16); // The device or directory does not exist. + {$EXTERNALSYM NERR_UnknownDevDir} + NERR_RedirectedPath = (NERR_BASE+17); // The operation is invalid on a redirected resource. + {$EXTERNALSYM NERR_RedirectedPath} + NERR_DuplicateShare = (NERR_BASE+18); // The name has already been shared. + {$EXTERNALSYM NERR_DuplicateShare} + NERR_NoRoom = (NERR_BASE+19); // The server is currently out of the requested resource. + {$EXTERNALSYM NERR_NoRoom} +// UNUSED BASE+20 + NERR_TooManyItems = (NERR_BASE+21); // Requested addition of items exceeds the maximum allowed. + {$EXTERNALSYM NERR_TooManyItems} + NERR_InvalidMaxUsers = (NERR_BASE+22); // The Peer service supports only two simultaneous users. + {$EXTERNALSYM NERR_InvalidMaxUsers} + NERR_BufTooSmall = (NERR_BASE+23); // The API return buffer is too small. + {$EXTERNALSYM NERR_BufTooSmall} +// UNUSED BASE+24 +// UNUSED BASE+25 +// UNUSED BASE+26 + NERR_RemoteErr = (NERR_BASE+27); // A remote API error occurred. + {$EXTERNALSYM NERR_RemoteErr} +// UNUSED BASE+28 +// UNUSED BASE+29 +// UNUSED BASE+30 + NERR_LanmanIniError = (NERR_BASE+31); // An error occurred when opening or reading the configuration file. + {$EXTERNALSYM NERR_LanmanIniError} +// UNUSED BASE+32 +// UNUSED BASE+33 +// UNUSED BASE+34 +// UNUSED BASE+35 + NERR_NetworkError = (NERR_BASE+36); // A general network error occurred. + {$EXTERNALSYM NERR_NetworkError} + NERR_WkstaInconsistentState = (NERR_BASE+37); + {$EXTERNALSYM NERR_WkstaInconsistentState} + // The Workstation service is in an inconsistent state. Restart the computer before restarting the Workstation service. + NERR_WkstaNotStarted = (NERR_BASE+38); // The Workstation service has not been started. + {$EXTERNALSYM NERR_WkstaNotStarted} + NERR_BrowserNotStarted = (NERR_BASE+39); // The requested information is not available. + {$EXTERNALSYM NERR_BrowserNotStarted} + NERR_InternalError = (NERR_BASE+40); // An internal Windows 2000 error occurred. + {$EXTERNALSYM NERR_InternalError} + NERR_BadTransactConfig = (NERR_BASE+41); // The server is not configured for transactions. + {$EXTERNALSYM NERR_BadTransactConfig} + NERR_InvalidAPI = (NERR_BASE+42); // The requested API is not supported on the remote server. + {$EXTERNALSYM NERR_InvalidAPI} + NERR_BadEventName = (NERR_BASE+43); // The event name is invalid. + {$EXTERNALSYM NERR_BadEventName} + NERR_DupNameReboot = (NERR_BASE+44); // The computer name already exists on the network. Change it and restart the computer. + {$EXTERNALSYM NERR_DupNameReboot} + +// +// Config API related +// Error codes from BASE+45 to BASE+49 + + +// UNUSED BASE+45 + NERR_CfgCompNotFound = (NERR_BASE+46); // The specified component could not be found in the configuration information. + {$EXTERNALSYM NERR_CfgCompNotFound} + NERR_CfgParamNotFound = (NERR_BASE+47); // The specified parameter could not be found in the configuration information. + {$EXTERNALSYM NERR_CfgParamNotFound} + NERR_LineTooLong = (NERR_BASE+49); // A line in the configuration file is too long. + {$EXTERNALSYM NERR_LineTooLong} + +// +// Spooler API related +// Error codes from BASE+50 to BASE+79 + + + NERR_QNotFound = (NERR_BASE+50); // The printer does not exist. + {$EXTERNALSYM NERR_QNotFound} + NERR_JobNotFound = (NERR_BASE+51); // The print job does not exist. + {$EXTERNALSYM NERR_JobNotFound} + NERR_DestNotFound = (NERR_BASE+52); // The printer destination cannot be found. + {$EXTERNALSYM NERR_DestNotFound} + NERR_DestExists = (NERR_BASE+53); // The printer destination already exists. + {$EXTERNALSYM NERR_DestExists} + NERR_QExists = (NERR_BASE+54); // The printer queue already exists. + {$EXTERNALSYM NERR_QExists} + NERR_QNoRoom = (NERR_BASE+55); // No more printers can be added. + {$EXTERNALSYM NERR_QNoRoom} + NERR_JobNoRoom = (NERR_BASE+56); // No more print jobs can be added. + {$EXTERNALSYM NERR_JobNoRoom} + NERR_DestNoRoom = (NERR_BASE+57); // No more printer destinations can be added. + {$EXTERNALSYM NERR_DestNoRoom} + NERR_DestIdle = (NERR_BASE+58); // This printer destination is idle and cannot accept control operations. + {$EXTERNALSYM NERR_DestIdle} + NERR_DestInvalidOp = (NERR_BASE+59); // This printer destination request contains an invalid control function. + {$EXTERNALSYM NERR_DestInvalidOp} + NERR_ProcNoRespond = (NERR_BASE+60); // The print processor is not responding. + {$EXTERNALSYM NERR_ProcNoRespond} + NERR_SpoolerNotLoaded = (NERR_BASE+61); // The spooler is not running. + {$EXTERNALSYM NERR_SpoolerNotLoaded} + NERR_DestInvalidState = (NERR_BASE+62); // This operation cannot be performed on the print destination in its current state. + {$EXTERNALSYM NERR_DestInvalidState} + NERR_QInvalidState = (NERR_BASE+63); // This operation cannot be performed on the printer queue in its current state. + {$EXTERNALSYM NERR_QInvalidState} + NERR_JobInvalidState = (NERR_BASE+64); // This operation cannot be performed on the print job in its current state. + {$EXTERNALSYM NERR_JobInvalidState} + NERR_SpoolNoMemory = (NERR_BASE+65); // A spooler memory allocation failure occurred. + {$EXTERNALSYM NERR_SpoolNoMemory} + NERR_DriverNotFound = (NERR_BASE+66); // The device driver does not exist. + {$EXTERNALSYM NERR_DriverNotFound} + NERR_DataTypeInvalid = (NERR_BASE+67); // The data type is not supported by the print processor. + {$EXTERNALSYM NERR_DataTypeInvalid} + NERR_ProcNotFound = (NERR_BASE+68); // The print processor is not installed. + {$EXTERNALSYM NERR_ProcNotFound} + +// +// Service API related +// Error codes from BASE+80 to BASE+99 + + + NERR_ServiceTableLocked = (NERR_BASE+80); // The service database is locked. + {$EXTERNALSYM NERR_ServiceTableLocked} + NERR_ServiceTableFull = (NERR_BASE+81); // The service table is full. + {$EXTERNALSYM NERR_ServiceTableFull} + NERR_ServiceInstalled = (NERR_BASE+82); // The requested service has already been started. + {$EXTERNALSYM NERR_ServiceInstalled} + NERR_ServiceEntryLocked = (NERR_BASE+83); // The service does not respond to control actions. + {$EXTERNALSYM NERR_ServiceEntryLocked} + NERR_ServiceNotInstalled = (NERR_BASE+84); // The service has not been started. + {$EXTERNALSYM NERR_ServiceNotInstalled} + NERR_BadServiceName = (NERR_BASE+85); // The service name is invalid. + {$EXTERNALSYM NERR_BadServiceName} + NERR_ServiceCtlTimeout = (NERR_BASE+86); // The service is not responding to the control function. + {$EXTERNALSYM NERR_ServiceCtlTimeout} + NERR_ServiceCtlBusy = (NERR_BASE+87); // The service control is busy. + {$EXTERNALSYM NERR_ServiceCtlBusy} + NERR_BadServiceProgName = (NERR_BASE+88); // The configuration file contains an invalid service program name. + {$EXTERNALSYM NERR_BadServiceProgName} + NERR_ServiceNotCtrl = (NERR_BASE+89); // The service could not be controlled in its present state. + {$EXTERNALSYM NERR_ServiceNotCtrl} + NERR_ServiceKillProc = (NERR_BASE+90); // The service ended abnormally. + {$EXTERNALSYM NERR_ServiceKillProc} + NERR_ServiceCtlNotValid = (NERR_BASE+91); // The requested pause,continue, or stop is not valid for this service. + {$EXTERNALSYM NERR_ServiceCtlNotValid} + NERR_NotInDispatchTbl = (NERR_BASE+92); // The service control dispatcher could not find the service name in the dispatch table. + {$EXTERNALSYM NERR_NotInDispatchTbl} + NERR_BadControlRecv = (NERR_BASE+93); // The service control dispatcher pipe read failed. + {$EXTERNALSYM NERR_BadControlRecv} + NERR_ServiceNotStarting = (NERR_BASE+94); // A thread for the new service could not be created. + {$EXTERNALSYM NERR_ServiceNotStarting} + +// +// Wksta and Logon API related +// Error codes from BASE+100 to BASE+118 + + + NERR_AlreadyLoggedOn = (NERR_BASE+100); // This workstation is already logged on to the local-area network. + {$EXTERNALSYM NERR_AlreadyLoggedOn} + NERR_NotLoggedOn = (NERR_BASE+101); // The workstation is not logged on to the local-area network. + {$EXTERNALSYM NERR_NotLoggedOn} + NERR_BadUsername = (NERR_BASE+102); // The user name or group name parameter is invalid. + {$EXTERNALSYM NERR_BadUsername} + NERR_BadPassword = (NERR_BASE+103); // The password parameter is invalid. + {$EXTERNALSYM NERR_BadPassword} + NERR_UnableToAddName_W = (NERR_BASE+104); // @W The logon processor did not add the message alias. + {$EXTERNALSYM NERR_UnableToAddName_W} + NERR_UnableToAddName_F = (NERR_BASE+105); // The logon processor did not add the message alias. + {$EXTERNALSYM NERR_UnableToAddName_F} + NERR_UnableToDelName_W = (NERR_BASE+106); // @W The logoff processor did not delete the message alias. + {$EXTERNALSYM NERR_UnableToDelName_W} + NERR_UnableToDelName_F = (NERR_BASE+107); // The logoff processor did not delete the message alias. + {$EXTERNALSYM NERR_UnableToDelName_F} +// UNUSED BASE+108 + NERR_LogonsPaused = (NERR_BASE+109); // Network logons are paused. + {$EXTERNALSYM NERR_LogonsPaused} + NERR_LogonServerConflict = (NERR_BASE+110); // A centralized logon-server conflict occurred. + {$EXTERNALSYM NERR_LogonServerConflict} + NERR_LogonNoUserPath = (NERR_BASE+111); // The server is configured without a valid user path. + {$EXTERNALSYM NERR_LogonNoUserPath} + NERR_LogonScriptError = (NERR_BASE+112); // An error occurred while loading or running the logon script. + {$EXTERNALSYM NERR_LogonScriptError} +// UNUSED BASE+113 + NERR_StandaloneLogon = (NERR_BASE+114); // The logon server was not specified. Your computer will be logged on as STANDALONE. + {$EXTERNALSYM NERR_StandaloneLogon} + NERR_LogonServerNotFound = (NERR_BASE+115); // The logon server could not be found. + {$EXTERNALSYM NERR_LogonServerNotFound} + NERR_LogonDomainExists = (NERR_BASE+116); // There is already a logon domain for this computer. + {$EXTERNALSYM NERR_LogonDomainExists} + NERR_NonValidatedLogon = (NERR_BASE+117); // The logon server could not validate the logon. + {$EXTERNALSYM NERR_NonValidatedLogon} + +// +// ACF API related (access, user, group) +// Error codes from BASE+119 to BASE+149 + + + NERR_ACFNotFound = (NERR_BASE+119); // The security database could not be found. + {$EXTERNALSYM NERR_ACFNotFound} + NERR_GroupNotFound = (NERR_BASE+120); // The group name could not be found. + {$EXTERNALSYM NERR_GroupNotFound} + NERR_UserNotFound = (NERR_BASE+121); // The user name could not be found. + {$EXTERNALSYM NERR_UserNotFound} + NERR_ResourceNotFound = (NERR_BASE+122); // The resource name could not be found. + {$EXTERNALSYM NERR_ResourceNotFound} + NERR_GroupExists = (NERR_BASE+123); // The group already exists. + {$EXTERNALSYM NERR_GroupExists} + NERR_UserExists = (NERR_BASE+124); // The account already exists. + {$EXTERNALSYM NERR_UserExists} + NERR_ResourceExists = (NERR_BASE+125); // The resource permission list already exists. + {$EXTERNALSYM NERR_ResourceExists} + NERR_NotPrimary = (NERR_BASE+126); // This operation is only allowed on the primary domain controller of the domain. + {$EXTERNALSYM NERR_NotPrimary} + NERR_ACFNotLoaded = (NERR_BASE+127); // The security database has not been started. + {$EXTERNALSYM NERR_ACFNotLoaded} + NERR_ACFNoRoom = (NERR_BASE+128); // There are too many names in the user accounts database. + {$EXTERNALSYM NERR_ACFNoRoom} + NERR_ACFFileIOFail = (NERR_BASE+129); // A disk I/O failure occurred. + {$EXTERNALSYM NERR_ACFFileIOFail} + NERR_ACFTooManyLists = (NERR_BASE+130); // The limit of 64 entries per resource was exceeded. + {$EXTERNALSYM NERR_ACFTooManyLists} + NERR_UserLogon = (NERR_BASE+131); // Deleting a user with a session is not allowed. + {$EXTERNALSYM NERR_UserLogon} + NERR_ACFNoParent = (NERR_BASE+132); // The parent directory could not be located. + {$EXTERNALSYM NERR_ACFNoParent} + NERR_CanNotGrowSegment = (NERR_BASE+133); // Unable to add to the security database session cache segment. + {$EXTERNALSYM NERR_CanNotGrowSegment} + NERR_SpeGroupOp = (NERR_BASE+134); // This operation is not allowed on this special group. + {$EXTERNALSYM NERR_SpeGroupOp} + NERR_NotInCache = (NERR_BASE+135); // This user is not cached in user accounts database session cache. + {$EXTERNALSYM NERR_NotInCache} + NERR_UserInGroup = (NERR_BASE+136); // The user already belongs to this group. + {$EXTERNALSYM NERR_UserInGroup} + NERR_UserNotInGroup = (NERR_BASE+137); // The user does not belong to this group. + {$EXTERNALSYM NERR_UserNotInGroup} + NERR_AccountUndefined = (NERR_BASE+138); // This user account is undefined. + {$EXTERNALSYM NERR_AccountUndefined} + NERR_AccountExpired = (NERR_BASE+139); // This user account has expired. + {$EXTERNALSYM NERR_AccountExpired} + NERR_InvalidWorkstation = (NERR_BASE+140); // The user is not allowed to log on from this workstation. + {$EXTERNALSYM NERR_InvalidWorkstation} + NERR_InvalidLogonHours = (NERR_BASE+141); // The user is not allowed to log on at this time. + {$EXTERNALSYM NERR_InvalidLogonHours} + NERR_PasswordExpired = (NERR_BASE+142); // The password of this user has expired. + {$EXTERNALSYM NERR_PasswordExpired} + NERR_PasswordCantChange = (NERR_BASE+143); // The password of this user cannot change. + {$EXTERNALSYM NERR_PasswordCantChange} + NERR_PasswordHistConflict = (NERR_BASE+144); // This password cannot be used now. + {$EXTERNALSYM NERR_PasswordHistConflict} + NERR_PasswordTooShort = (NERR_BASE+145); // The password does not meet the password policy requirements. Check the minimum password length, password complexity and password history requirements. + {$EXTERNALSYM NERR_PasswordTooShort} + NERR_PasswordTooRecent = (NERR_BASE+146); // The password of this user is too recent to change. + {$EXTERNALSYM NERR_PasswordTooRecent} + NERR_InvalidDatabase = (NERR_BASE+147); // The security database is corrupted. + {$EXTERNALSYM NERR_InvalidDatabase} + NERR_DatabaseUpToDate = (NERR_BASE+148); // No updates are necessary to this replicant network/local security database. + {$EXTERNALSYM NERR_DatabaseUpToDate} + NERR_SyncRequired = (NERR_BASE+149); // This replicant database is outdated; synchronization is required. + {$EXTERNALSYM NERR_SyncRequired} + +// +// Use API related +// Error codes from BASE+150 to BASE+169 + + + NERR_UseNotFound = (NERR_BASE+150); // The network connection could not be found. + {$EXTERNALSYM NERR_UseNotFound} + NERR_BadAsgType = (NERR_BASE+151); // This asg_type is invalid. + {$EXTERNALSYM NERR_BadAsgType} + NERR_DeviceIsShared = (NERR_BASE+152); // This device is currently being shared. + {$EXTERNALSYM NERR_DeviceIsShared} + +// +// Message Server related +// Error codes BASE+170 to BASE+209 + + + NERR_NoComputerName = (NERR_BASE+170); // The computer name could not be added as a message alias. The name may already exist on the network. + {$EXTERNALSYM NERR_NoComputerName} + NERR_MsgAlreadyStarted = (NERR_BASE+171); // The Messenger service is already started. + {$EXTERNALSYM NERR_MsgAlreadyStarted} + NERR_MsgInitFailed = (NERR_BASE+172); // The Messenger service failed to start. + {$EXTERNALSYM NERR_MsgInitFailed} + NERR_NameNotFound = (NERR_BASE+173); // The message alias could not be found on the network. + {$EXTERNALSYM NERR_NameNotFound} + NERR_AlreadyForwarded = (NERR_BASE+174); // This message alias has already been forwarded. + {$EXTERNALSYM NERR_AlreadyForwarded} + NERR_AddForwarded = (NERR_BASE+175); // This message alias has been added but is still forwarded. + {$EXTERNALSYM NERR_AddForwarded} + NERR_AlreadyExists = (NERR_BASE+176); // This message alias already exists locally. + {$EXTERNALSYM NERR_AlreadyExists} + NERR_TooManyNames = (NERR_BASE+177); // The maximum number of added message aliases has been exceeded. + {$EXTERNALSYM NERR_TooManyNames} + NERR_DelComputerName = (NERR_BASE+178); // The computer name could not be deleted. + {$EXTERNALSYM NERR_DelComputerName} + NERR_LocalForward = (NERR_BASE+179); // Messages cannot be forwarded back to the same workstation. + {$EXTERNALSYM NERR_LocalForward} + NERR_GrpMsgProcessor = (NERR_BASE+180); // An error occurred in the domain message processor. + {$EXTERNALSYM NERR_GrpMsgProcessor} + NERR_PausedRemote = (NERR_BASE+181); // The message was sent, but the recipient has paused the Messenger service. + {$EXTERNALSYM NERR_PausedRemote} + NERR_BadReceive = (NERR_BASE+182); // The message was sent but not received. + {$EXTERNALSYM NERR_BadReceive} + NERR_NameInUse = (NERR_BASE+183); // The message alias is currently in use. Try again later. + {$EXTERNALSYM NERR_NameInUse} + NERR_MsgNotStarted = (NERR_BASE+184); // The Messenger service has not been started. + {$EXTERNALSYM NERR_MsgNotStarted} + NERR_NotLocalName = (NERR_BASE+185); // The name is not on the local computer. + {$EXTERNALSYM NERR_NotLocalName} + NERR_NoForwardName = (NERR_BASE+186); // The forwarded message alias could not be found on the network. + {$EXTERNALSYM NERR_NoForwardName} + NERR_RemoteFull = (NERR_BASE+187); // The message alias table on the remote station is full. + {$EXTERNALSYM NERR_RemoteFull} + NERR_NameNotForwarded = (NERR_BASE+188); // Messages for this alias are not currently being forwarded. + {$EXTERNALSYM NERR_NameNotForwarded} + NERR_TruncatedBroadcast = (NERR_BASE+189); // The broadcast message was truncated. + {$EXTERNALSYM NERR_TruncatedBroadcast} + NERR_InvalidDevice = (NERR_BASE+194); // This is an invalid device name. + {$EXTERNALSYM NERR_InvalidDevice} + NERR_WriteFault = (NERR_BASE+195); // A write fault occurred. + {$EXTERNALSYM NERR_WriteFault} +// UNUSED BASE+196 + NERR_DuplicateName = (NERR_BASE+197); // A duplicate message alias exists on the network. + {$EXTERNALSYM NERR_DuplicateName} + NERR_DeleteLater = (NERR_BASE+198); // @W This message alias will be deleted later. + {$EXTERNALSYM NERR_DeleteLater} + NERR_IncompleteDel = (NERR_BASE+199); // The message alias was not successfully deleted from all networks. + {$EXTERNALSYM NERR_IncompleteDel} + NERR_MultipleNets = (NERR_BASE+200); // This operation is not supported on computers with multiple networks. + {$EXTERNALSYM NERR_MultipleNets} + +// +// Server API related +// Error codes BASE+210 to BASE+229 + + + NERR_NetNameNotFound = (NERR_BASE+210); // This shared resource does not exist. + {$EXTERNALSYM NERR_NetNameNotFound} + NERR_DeviceNotShared = (NERR_BASE+211); // This device is not shared. + {$EXTERNALSYM NERR_DeviceNotShared} + NERR_ClientNameNotFound = (NERR_BASE+212); // A session does not exist with that computer name. + {$EXTERNALSYM NERR_ClientNameNotFound} + NERR_FileIdNotFound = (NERR_BASE+214); // There is not an open file with that identification number. + {$EXTERNALSYM NERR_FileIdNotFound} + NERR_ExecFailure = (NERR_BASE+215); // A failure occurred when executing a remote administration command. + {$EXTERNALSYM NERR_ExecFailure} + NERR_TmpFile = (NERR_BASE+216); // A failure occurred when opening a remote temporary file. + {$EXTERNALSYM NERR_TmpFile} + NERR_TooMuchData = (NERR_BASE+217); // The data returned from a remote administration command has been truncated to 64K. + {$EXTERNALSYM NERR_TooMuchData} + NERR_DeviceShareConflict = (NERR_BASE+218); // This device cannot be shared as both a spooled and a non-spooled resource. + {$EXTERNALSYM NERR_DeviceShareConflict} + NERR_BrowserTableIncomplete = (NERR_BASE+219); // The information in the list of servers may be incorrect. + {$EXTERNALSYM NERR_BrowserTableIncomplete} + NERR_NotLocalDomain = (NERR_BASE+220); // The computer is not active in this domain. + {$EXTERNALSYM NERR_NotLocalDomain} + NERR_IsDfsShare = (NERR_BASE+221); // The share must be removed from the Distributed File System before it can be deleted. + {$EXTERNALSYM NERR_IsDfsShare} + +// +// CharDev API related +// Error codes BASE+230 to BASE+249 + + +// UNUSED BASE+230 + NERR_DevInvalidOpCode = (NERR_BASE+231); // The operation is invalid for this device. + {$EXTERNALSYM NERR_DevInvalidOpCode} + NERR_DevNotFound = (NERR_BASE+232); // This device cannot be shared. + {$EXTERNALSYM NERR_DevNotFound} + NERR_DevNotOpen = (NERR_BASE+233); // This device was not open. + {$EXTERNALSYM NERR_DevNotOpen} + NERR_BadQueueDevString = (NERR_BASE+234); // This device name list is invalid. + {$EXTERNALSYM NERR_BadQueueDevString} + NERR_BadQueuePriority = (NERR_BASE+235); // The queue priority is invalid. + {$EXTERNALSYM NERR_BadQueuePriority} + NERR_NoCommDevs = (NERR_BASE+237); // There are no shared communication devices. + {$EXTERNALSYM NERR_NoCommDevs} + NERR_QueueNotFound = (NERR_BASE+238); // The queue you specified does not exist. + {$EXTERNALSYM NERR_QueueNotFound} + NERR_BadDevString = (NERR_BASE+240); // This list of devices is invalid. + {$EXTERNALSYM NERR_BadDevString} + NERR_BadDev = (NERR_BASE+241); // The requested device is invalid. + {$EXTERNALSYM NERR_BadDev} + NERR_InUseBySpooler = (NERR_BASE+242); // This device is already in use by the spooler. + {$EXTERNALSYM NERR_InUseBySpooler} + NERR_CommDevInUse = (NERR_BASE+243); // This device is already in use as a communication device. + {$EXTERNALSYM NERR_CommDevInUse} + +// +// NetICanonicalize and NetIType and NetIMakeLMFileName +// NetIListCanon and NetINameCheck +// Error codes BASE+250 to BASE+269 + + + NERR_InvalidComputer = (NERR_BASE+251); // This computer name is invalid. + {$EXTERNALSYM NERR_InvalidComputer} +// UNUSED BASE+252 +// UNUSED BASE+253 + NERR_MaxLenExceeded = (NERR_BASE+254); // The string and prefix specified are too long. + {$EXTERNALSYM NERR_MaxLenExceeded} +// UNUSED BASE+255 + NERR_BadComponent = (NERR_BASE+256); // This path component is invalid. + {$EXTERNALSYM NERR_BadComponent} + NERR_CantType = (NERR_BASE+257); // Could not determine the type of input. + {$EXTERNALSYM NERR_CantType} +// UNUSED BASE+258 +// UNUSED BASE+259 + NERR_TooManyEntries = (NERR_BASE+262); // The buffer for types is not big enough. + {$EXTERNALSYM NERR_TooManyEntries} + +// +// NetProfile +// Error codes BASE+270 to BASE+276 + + + NERR_ProfileFileTooBig = (NERR_BASE+270); // Profile files cannot exceed 64K. + {$EXTERNALSYM NERR_ProfileFileTooBig} + NERR_ProfileOffset = (NERR_BASE+271); // The start offset is out of range. + {$EXTERNALSYM NERR_ProfileOffset} + NERR_ProfileCleanup = (NERR_BASE+272); // The system cannot delete current connections to network resources. + {$EXTERNALSYM NERR_ProfileCleanup} + NERR_ProfileUnknownCmd = (NERR_BASE+273); // The system was unable to parse the command line in this file. + {$EXTERNALSYM NERR_ProfileUnknownCmd} + NERR_ProfileLoadErr = (NERR_BASE+274); // An error occurred while loading the profile file. + {$EXTERNALSYM NERR_ProfileLoadErr} + NERR_ProfileSaveErr = (NERR_BASE+275); // @W Errors occurred while saving the profile file. The profile was partially saved. + {$EXTERNALSYM NERR_ProfileSaveErr} + + +// +// NetAudit and NetErrorLog +// Error codes BASE+277 to BASE+279 + + + NERR_LogOverflow = (NERR_BASE+277); // Log file %1 is full. + {$EXTERNALSYM NERR_LogOverflow} + NERR_LogFileChanged = (NERR_BASE+278); // This log file has changed between reads. + {$EXTERNALSYM NERR_LogFileChanged} + NERR_LogFileCorrupt = (NERR_BASE+279); // Log file %1 is corrupt. + {$EXTERNALSYM NERR_LogFileCorrupt} + + +// +// NetRemote +// Error codes BASE+280 to BASE+299 + + NERR_SourceIsDir = (NERR_BASE+280); // The source path cannot be a directory. + {$EXTERNALSYM NERR_SourceIsDir} + NERR_BadSource = (NERR_BASE+281); // The source path is illegal. + {$EXTERNALSYM NERR_BadSource} + NERR_BadDest = (NERR_BASE+282); // The destination path is illegal. + {$EXTERNALSYM NERR_BadDest} + NERR_DifferentServers = (NERR_BASE+283); // The source and destination paths are on different servers. + {$EXTERNALSYM NERR_DifferentServers} +// UNUSED BASE+284 + NERR_RunSrvPaused = (NERR_BASE+285); // The Run server you requested is paused. + {$EXTERNALSYM NERR_RunSrvPaused} +// UNUSED BASE+286 +// UNUSED BASE+287 +// UNUSED BASE+288 + NERR_ErrCommRunSrv = (NERR_BASE+289); // An error occurred when communicating with a Run server. + {$EXTERNALSYM NERR_ErrCommRunSrv} +// UNUSED BASE+290 + NERR_ErrorExecingGhost = (NERR_BASE+291); // An error occurred when starting a background process. + {$EXTERNALSYM NERR_ErrorExecingGhost} + NERR_ShareNotFound = (NERR_BASE+292); // The shared resource you are connected to could not be found. + {$EXTERNALSYM NERR_ShareNotFound} +// UNUSED BASE+293 +// UNUSED BASE+294 + + +// +// NetWksta.sys (redir) returned error codes. +// +// NERR_BASE + (300-329) + + + NERR_InvalidLana = (NERR_BASE+300); // The LAN adapter number is invalid. + {$EXTERNALSYM NERR_InvalidLana} + NERR_OpenFiles = (NERR_BASE+301); // There are open files on the connection. + {$EXTERNALSYM NERR_OpenFiles} + NERR_ActiveConns = (NERR_BASE+302); // Active connections still exist. + {$EXTERNALSYM NERR_ActiveConns} + NERR_BadPasswordCore = (NERR_BASE+303); // This share name or password is invalid. + {$EXTERNALSYM NERR_BadPasswordCore} + NERR_DevInUse = (NERR_BASE+304); // The device is being accessed by an active process. + {$EXTERNALSYM NERR_DevInUse} + NERR_LocalDrive = (NERR_BASE+305); // The drive letter is in use locally. + {$EXTERNALSYM NERR_LocalDrive} + +// +// Alert error codes. +// +// NERR_BASE + (330-339) + + NERR_AlertExists = (NERR_BASE+330); // The specified client is already registered for the specified event. + {$EXTERNALSYM NERR_AlertExists} + NERR_TooManyAlerts = (NERR_BASE+331); // The alert table is full. + {$EXTERNALSYM NERR_TooManyAlerts} + NERR_NoSuchAlert = (NERR_BASE+332); // An invalid or nonexistent alert name was raised. + {$EXTERNALSYM NERR_NoSuchAlert} + NERR_BadRecipient = (NERR_BASE+333); // The alert recipient is invalid. + {$EXTERNALSYM NERR_BadRecipient} + NERR_AcctLimitExceeded = (NERR_BASE+334); // A user's session with this server has been deleted + {$EXTERNALSYM NERR_AcctLimitExceeded} + // because the user's logon hours are no longer valid. + +// +// Additional Error and Audit log codes. +// +// NERR_BASE +(340-343) + + NERR_InvalidLogSeek = (NERR_BASE+340); // The log file does not contain the requested record number. + {$EXTERNALSYM NERR_InvalidLogSeek} +// UNUSED BASE+341 +// UNUSED BASE+342 +// UNUSED BASE+343 + +// +// Additional UAS and NETLOGON codes +// +// NERR_BASE +(350-359) + + NERR_BadUasConfig = (NERR_BASE+350); // The user accounts database is not configured correctly. + {$EXTERNALSYM NERR_BadUasConfig} + NERR_InvalidUASOp = (NERR_BASE+351); // This operation is not permitted when the Netlogon service is running. + {$EXTERNALSYM NERR_InvalidUASOp} + NERR_LastAdmin = (NERR_BASE+352); // This operation is not allowed on the last administrative account. + {$EXTERNALSYM NERR_LastAdmin} + NERR_DCNotFound = (NERR_BASE+353); // Could not find domain controller for this domain. + {$EXTERNALSYM NERR_DCNotFound} + NERR_LogonTrackingError = (NERR_BASE+354); // Could not set logon information for this user. + {$EXTERNALSYM NERR_LogonTrackingError} + NERR_NetlogonNotStarted = (NERR_BASE+355); // The Netlogon service has not been started. + {$EXTERNALSYM NERR_NetlogonNotStarted} + NERR_CanNotGrowUASFile = (NERR_BASE+356); // Unable to add to the user accounts database. + {$EXTERNALSYM NERR_CanNotGrowUASFile} + NERR_TimeDiffAtDC = (NERR_BASE+357); // This server's clock is not synchronized with the primary domain controller's clock. + {$EXTERNALSYM NERR_TimeDiffAtDC} + NERR_PasswordMismatch = (NERR_BASE+358); // A password mismatch has been detected. + {$EXTERNALSYM NERR_PasswordMismatch} + + +// +// Server Integration error codes. +// +// NERR_BASE +(360-369) + + NERR_NoSuchServer = (NERR_BASE+360); // The server identification does not specify a valid server. + {$EXTERNALSYM NERR_NoSuchServer} + NERR_NoSuchSession = (NERR_BASE+361); // The session identification does not specify a valid session. + {$EXTERNALSYM NERR_NoSuchSession} + NERR_NoSuchConnection = (NERR_BASE+362); // The connection identification does not specify a valid connection. + {$EXTERNALSYM NERR_NoSuchConnection} + NERR_TooManyServers = (NERR_BASE+363); // There is no space for another entry in the table of available servers. + {$EXTERNALSYM NERR_TooManyServers} + NERR_TooManySessions = (NERR_BASE+364); // The server has reached the maximum number of sessions it supports. + {$EXTERNALSYM NERR_TooManySessions} + NERR_TooManyConnections = (NERR_BASE+365); // The server has reached the maximum number of connections it supports. + {$EXTERNALSYM NERR_TooManyConnections} + NERR_TooManyFiles = (NERR_BASE+366); // The server cannot open more files because it has reached its maximum number. + {$EXTERNALSYM NERR_TooManyFiles} + NERR_NoAlternateServers = (NERR_BASE+367); // There are no alternate servers registered on this server. + {$EXTERNALSYM NERR_NoAlternateServers} +// UNUSED BASE+368 +// UNUSED BASE+369 + + NERR_TryDownLevel = (NERR_BASE+370); // Try down-level (remote admin protocol) version of API instead. + {$EXTERNALSYM NERR_TryDownLevel} + +// +// UPS error codes. +// +// NERR_BASE + (380-384) + + NERR_UPSDriverNotStarted = (NERR_BASE+380); // The UPS driver could not be accessed by the UPS service. + {$EXTERNALSYM NERR_UPSDriverNotStarted} + NERR_UPSInvalidConfig = (NERR_BASE+381); // The UPS service is not configured correctly. + {$EXTERNALSYM NERR_UPSInvalidConfig} + NERR_UPSInvalidCommPort = (NERR_BASE+382); // The UPS service could not access the specified Comm Port. + {$EXTERNALSYM NERR_UPSInvalidCommPort} + NERR_UPSSignalAsserted = (NERR_BASE+383); // The UPS indicated a line fail or low battery situation. Service not started. + {$EXTERNALSYM NERR_UPSSignalAsserted} + NERR_UPSShutdownFailed = (NERR_BASE+384); // The UPS service failed to perform a system shut down. + {$EXTERNALSYM NERR_UPSShutdownFailed} + +// +// Remoteboot error codes. +// +// NERR_BASE + (400-419) +// Error codes 400 - 405 are used by RPLBOOT.SYS. +// Error codes 403, 407 - 416 are used by RPLLOADR.COM, +// Error code 417 is the alerter message of REMOTEBOOT (RPLSERVR.EXE). +// Error code 418 is for when REMOTEBOOT can't start +// Error code 419 is for a disallowed 2nd rpl connection +// + + NERR_BadDosRetCode = (NERR_BASE+400); // The program below returned an MS-DOS error code: + {$EXTERNALSYM NERR_BadDosRetCode} + NERR_ProgNeedsExtraMem = (NERR_BASE+401); // The program below needs more memory: + {$EXTERNALSYM NERR_ProgNeedsExtraMem} + NERR_BadDosFunction = (NERR_BASE+402); // The program below called an unsupported MS-DOS function: + {$EXTERNALSYM NERR_BadDosFunction} + NERR_RemoteBootFailed = (NERR_BASE+403); // The workstation failed to boot. + {$EXTERNALSYM NERR_RemoteBootFailed} + NERR_BadFileCheckSum = (NERR_BASE+404); // The file below is corrupt. + {$EXTERNALSYM NERR_BadFileCheckSum} + NERR_NoRplBootSystem = (NERR_BASE+405); // No loader is specified in the boot-block definition file. + {$EXTERNALSYM NERR_NoRplBootSystem} + NERR_RplLoadrNetBiosErr = (NERR_BASE+406); // NetBIOS returned an error: The NCB and SMB are dumped above. + {$EXTERNALSYM NERR_RplLoadrNetBiosErr} + NERR_RplLoadrDiskErr = (NERR_BASE+407); // A disk I/O error occurred. + {$EXTERNALSYM NERR_RplLoadrDiskErr} + NERR_ImageParamErr = (NERR_BASE+408); // Image parameter substitution failed. + {$EXTERNALSYM NERR_ImageParamErr} + NERR_TooManyImageParams = (NERR_BASE+409); // Too many image parameters cross disk sector boundaries. + {$EXTERNALSYM NERR_TooManyImageParams} + NERR_NonDosFloppyUsed = (NERR_BASE+410); // The image was not generated from an MS-DOS diskette formatted with /S. + {$EXTERNALSYM NERR_NonDosFloppyUsed} + NERR_RplBootRestart = (NERR_BASE+411); // Remote boot will be restarted later. + {$EXTERNALSYM NERR_RplBootRestart} + NERR_RplSrvrCallFailed = (NERR_BASE+412); // The call to the Remoteboot server failed. + {$EXTERNALSYM NERR_RplSrvrCallFailed} + NERR_CantConnectRplSrvr = (NERR_BASE+413); // Cannot connect to the Remoteboot server. + {$EXTERNALSYM NERR_CantConnectRplSrvr} + NERR_CantOpenImageFile = (NERR_BASE+414); // Cannot open image file on the Remoteboot server. + {$EXTERNALSYM NERR_CantOpenImageFile} + NERR_CallingRplSrvr = (NERR_BASE+415); // Connecting to the Remoteboot server... + {$EXTERNALSYM NERR_CallingRplSrvr} + NERR_StartingRplBoot = (NERR_BASE+416); // Connecting to the Remoteboot server... + {$EXTERNALSYM NERR_StartingRplBoot} + NERR_RplBootServiceTerm = (NERR_BASE+417); // Remote boot service was stopped; check the error log for the cause of the problem. + {$EXTERNALSYM NERR_RplBootServiceTerm} + NERR_RplBootStartFailed = (NERR_BASE+418); // Remote boot startup failed; check the error log for the cause of the problem. + {$EXTERNALSYM NERR_RplBootStartFailed} + NERR_RPL_CONNECTED = (NERR_BASE+419); // A second connection to a Remoteboot resource is not allowed. + {$EXTERNALSYM NERR_RPL_CONNECTED} + +// +// FTADMIN API error codes +// +// NERR_BASE + (425-434) +// +// (Currently not used in NT) +// + + +// +// Browser service API error codes +// +// NERR_BASE + (450-475) +// + + NERR_BrowserConfiguredToNotRun = (NERR_BASE+450); // The browser service was configured with MaintainServerList=No. + {$EXTERNALSYM NERR_BrowserConfiguredToNotRun} + +// +// Additional Remoteboot error codes. +// +// NERR_BASE + (510-550) + + NERR_RplNoAdaptersStarted = (NERR_BASE+510); // Service failed to start since none of the network adapters started with this service. + {$EXTERNALSYM NERR_RplNoAdaptersStarted} + NERR_RplBadRegistry = (NERR_BASE+511); // Service failed to start due to bad startup information in the registry. + {$EXTERNALSYM NERR_RplBadRegistry} + NERR_RplBadDatabase = (NERR_BASE+512); // Service failed to start because its database is absent or corrupt. + {$EXTERNALSYM NERR_RplBadDatabase} + NERR_RplRplfilesShare = (NERR_BASE+513); // Service failed to start because RPLFILES share is absent. + {$EXTERNALSYM NERR_RplRplfilesShare} + NERR_RplNotRplServer = (NERR_BASE+514); // Service failed to start because RPLUSER group is absent. + {$EXTERNALSYM NERR_RplNotRplServer} + NERR_RplCannotEnum = (NERR_BASE+515); // Cannot enumerate service records. + {$EXTERNALSYM NERR_RplCannotEnum} + NERR_RplWkstaInfoCorrupted = (NERR_BASE+516); // Workstation record information has been corrupted. + {$EXTERNALSYM NERR_RplWkstaInfoCorrupted} + NERR_RplWkstaNotFound = (NERR_BASE+517); // Workstation record was not found. + {$EXTERNALSYM NERR_RplWkstaNotFound} + NERR_RplWkstaNameUnavailable = (NERR_BASE+518); // Workstation name is in use by some other workstation. + {$EXTERNALSYM NERR_RplWkstaNameUnavailable} + NERR_RplProfileInfoCorrupted = (NERR_BASE+519); // Profile record information has been corrupted. + {$EXTERNALSYM NERR_RplProfileInfoCorrupted} + NERR_RplProfileNotFound = (NERR_BASE+520); // Profile record was not found. + {$EXTERNALSYM NERR_RplProfileNotFound} + NERR_RplProfileNameUnavailable = (NERR_BASE+521); // Profile name is in use by some other profile. + {$EXTERNALSYM NERR_RplProfileNameUnavailable} + NERR_RplProfileNotEmpty = (NERR_BASE+522); // There are workstations using this profile. + {$EXTERNALSYM NERR_RplProfileNotEmpty} + NERR_RplConfigInfoCorrupted = (NERR_BASE+523); // Configuration record information has been corrupted. + {$EXTERNALSYM NERR_RplConfigInfoCorrupted} + NERR_RplConfigNotFound = (NERR_BASE+524); // Configuration record was not found. + {$EXTERNALSYM NERR_RplConfigNotFound} + NERR_RplAdapterInfoCorrupted = (NERR_BASE+525); // Adapter id record information has been corrupted. + {$EXTERNALSYM NERR_RplAdapterInfoCorrupted} + NERR_RplInternal = (NERR_BASE+526); // An internal service error has occurred. + {$EXTERNALSYM NERR_RplInternal} + NERR_RplVendorInfoCorrupted = (NERR_BASE+527); // Vendor id record information has been corrupted. + {$EXTERNALSYM NERR_RplVendorInfoCorrupted} + NERR_RplBootInfoCorrupted = (NERR_BASE+528); // Boot block record information has been corrupted. + {$EXTERNALSYM NERR_RplBootInfoCorrupted} + NERR_RplWkstaNeedsUserAcct = (NERR_BASE+529); // The user account for this workstation record is missing. + {$EXTERNALSYM NERR_RplWkstaNeedsUserAcct} + NERR_RplNeedsRPLUSERAcct = (NERR_BASE+530); // The RPLUSER local group could not be found. + {$EXTERNALSYM NERR_RplNeedsRPLUSERAcct} + NERR_RplBootNotFound = (NERR_BASE+531); // Boot block record was not found. + {$EXTERNALSYM NERR_RplBootNotFound} + NERR_RplIncompatibleProfile = (NERR_BASE+532); // Chosen profile is incompatible with this workstation. + {$EXTERNALSYM NERR_RplIncompatibleProfile} + NERR_RplAdapterNameUnavailable = (NERR_BASE+533); // Chosen network adapter id is in use by some other workstation. + {$EXTERNALSYM NERR_RplAdapterNameUnavailable} + NERR_RplConfigNotEmpty = (NERR_BASE+534); // There are profiles using this configuration. + {$EXTERNALSYM NERR_RplConfigNotEmpty} + NERR_RplBootInUse = (NERR_BASE+535); // There are workstations, profiles or configurations using this boot block. + {$EXTERNALSYM NERR_RplBootInUse} + NERR_RplBackupDatabase = (NERR_BASE+536); // Service failed to backup Remoteboot database. + {$EXTERNALSYM NERR_RplBackupDatabase} + NERR_RplAdapterNotFound = (NERR_BASE+537); // Adapter record was not found. + {$EXTERNALSYM NERR_RplAdapterNotFound} + NERR_RplVendorNotFound = (NERR_BASE+538); // Vendor record was not found. + {$EXTERNALSYM NERR_RplVendorNotFound} + NERR_RplVendorNameUnavailable = (NERR_BASE+539); // Vendor name is in use by some other vendor record. + {$EXTERNALSYM NERR_RplVendorNameUnavailable} + NERR_RplBootNameUnavailable = (NERR_BASE+540); // (boot name, vendor id) is in use by some other boot block record. + {$EXTERNALSYM NERR_RplBootNameUnavailable} + NERR_RplConfigNameUnavailable = (NERR_BASE+541); // Configuration name is in use by some other configuration. + {$EXTERNALSYM NERR_RplConfigNameUnavailable} + +//*INTERNAL_ONLY* + +// +// Dfs API error codes. +// +// NERR_BASE + (560-590) + + + NERR_DfsInternalCorruption = (NERR_BASE+560); // The internal database maintained by the DFS service is corrupt + {$EXTERNALSYM NERR_DfsInternalCorruption} + NERR_DfsVolumeDataCorrupt = (NERR_BASE+561); // One of the records in the internal DFS database is corrupt + {$EXTERNALSYM NERR_DfsVolumeDataCorrupt} + NERR_DfsNoSuchVolume = (NERR_BASE+562); // There is no DFS name whose entry path matches the input Entry Path + {$EXTERNALSYM NERR_DfsNoSuchVolume} + NERR_DfsVolumeAlreadyExists = (NERR_BASE+563); // A root or link with the given name already exists + {$EXTERNALSYM NERR_DfsVolumeAlreadyExists} + NERR_DfsAlreadyShared = (NERR_BASE+564); // The server share specified is already shared in the DFS + {$EXTERNALSYM NERR_DfsAlreadyShared} + NERR_DfsNoSuchShare = (NERR_BASE+565); // The indicated server share does not support the indicated DFS namespace + {$EXTERNALSYM NERR_DfsNoSuchShare} + NERR_DfsNotALeafVolume = (NERR_BASE+566); // The operation is not valid on this portion of the namespace + {$EXTERNALSYM NERR_DfsNotALeafVolume} + NERR_DfsLeafVolume = (NERR_BASE+567); // The operation is not valid on this portion of the namespace + {$EXTERNALSYM NERR_DfsLeafVolume} + NERR_DfsVolumeHasMultipleServers = (NERR_BASE+568); // The operation is ambiguous because the link has multiple servers + {$EXTERNALSYM NERR_DfsVolumeHasMultipleServers} + NERR_DfsCantCreateJunctionPoint = (NERR_BASE+569); // Unable to create a link + {$EXTERNALSYM NERR_DfsCantCreateJunctionPoint} + NERR_DfsServerNotDfsAware = (NERR_BASE+570); // The server is not DFS Aware + {$EXTERNALSYM NERR_DfsServerNotDfsAware} + NERR_DfsBadRenamePath = (NERR_BASE+571); // The specified rename target path is invalid + {$EXTERNALSYM NERR_DfsBadRenamePath} + NERR_DfsVolumeIsOffline = (NERR_BASE+572); // The specified DFS link is offline + {$EXTERNALSYM NERR_DfsVolumeIsOffline} + NERR_DfsNoSuchServer = (NERR_BASE+573); // The specified server is not a server for this link + {$EXTERNALSYM NERR_DfsNoSuchServer} + NERR_DfsCyclicalName = (NERR_BASE+574); // A cycle in the DFS name was detected + {$EXTERNALSYM NERR_DfsCyclicalName} + NERR_DfsNotSupportedInServerDfs = (NERR_BASE+575); // The operation is not supported on a server-based DFS + {$EXTERNALSYM NERR_DfsNotSupportedInServerDfs} + NERR_DfsDuplicateService = (NERR_BASE+576); // This link is already supported by the specified server-share + {$EXTERNALSYM NERR_DfsDuplicateService} + NERR_DfsCantRemoveLastServerShare = (NERR_BASE+577); // Can't remove the last server-share supporting this root or link + {$EXTERNALSYM NERR_DfsCantRemoveLastServerShare} + NERR_DfsVolumeIsInterDfs = (NERR_BASE+578); // The operation is not supported for an Inter-DFS link + {$EXTERNALSYM NERR_DfsVolumeIsInterDfs} + NERR_DfsInconsistent = (NERR_BASE+579); // The internal state of the DFS Service has become inconsistent + {$EXTERNALSYM NERR_DfsInconsistent} + NERR_DfsServerUpgraded = (NERR_BASE+580); // The DFS Service has been installed on the specified server + {$EXTERNALSYM NERR_DfsServerUpgraded} + NERR_DfsDataIsIdentical = (NERR_BASE+581); // The DFS data being reconciled is identical + {$EXTERNALSYM NERR_DfsDataIsIdentical} + NERR_DfsCantRemoveDfsRoot = (NERR_BASE+582); // The DFS root cannot be deleted - Uninstall DFS if required + {$EXTERNALSYM NERR_DfsCantRemoveDfsRoot} + NERR_DfsChildOrParentInDfs = (NERR_BASE+583); // A child or parent directory of the share is already in a DFS + {$EXTERNALSYM NERR_DfsChildOrParentInDfs} + NERR_DfsInternalError = (NERR_BASE+590); // DFS internal error + {$EXTERNALSYM NERR_DfsInternalError} + +// +// Net setup error codes. +// +// NERR_BASE + (591-600) + + NERR_SetupAlreadyJoined = (NERR_BASE+591); // This machine is already joined to a domain. + {$EXTERNALSYM NERR_SetupAlreadyJoined} + NERR_SetupNotJoined = (NERR_BASE+592); // This machine is not currently joined to a domain. + {$EXTERNALSYM NERR_SetupNotJoined} + NERR_SetupDomainController = (NERR_BASE+593); // This machine is a domain controller and cannot be unjoined from a domain. + {$EXTERNALSYM NERR_SetupDomainController} + NERR_DefaultJoinRequired = (NERR_BASE+594); // The destination domain controller does not support creating machine accounts in OUs. + {$EXTERNALSYM NERR_DefaultJoinRequired} + NERR_InvalidWorkgroupName = (NERR_BASE+595); // The specified workgroup name is invalid. + {$EXTERNALSYM NERR_InvalidWorkgroupName} + NERR_NameUsesIncompatibleCodePage = (NERR_BASE+596); // The specified computer name is incompatible with the default language used on the domain controller. + {$EXTERNALSYM NERR_NameUsesIncompatibleCodePage} + NERR_ComputerAccountNotFound = (NERR_BASE+597); // The specified computer account could not be found. + {$EXTERNALSYM NERR_ComputerAccountNotFound} + NERR_PersonalSku = (NERR_BASE+598); // This version of Windows cannot be joined to a domain. + {$EXTERNALSYM NERR_PersonalSku} + +// +// Some Password and account error results +// +// NERR_BASE + (601 - 608) +// + + NERR_PasswordMustChange = (NERR_BASE + 601); // Password must change at next logon + {$EXTERNALSYM NERR_PasswordMustChange} + NERR_AccountLockedOut = (NERR_BASE + 602); // Account is locked out + {$EXTERNALSYM NERR_AccountLockedOut} + NERR_PasswordTooLong = (NERR_BASE + 603); // Password is too long + {$EXTERNALSYM NERR_PasswordTooLong} + NERR_PasswordNotComplexEnough = (NERR_BASE + 604); // Password doesn't meet the complexity policy + {$EXTERNALSYM NERR_PasswordNotComplexEnough} + NERR_PasswordFilterError = (NERR_BASE + 605); // Password doesn't meet the requirements of the filter dll's + {$EXTERNALSYM NERR_PasswordFilterError} + +//**********WARNING **************** +//The range 2750-2799 has been * +//allocated to the IBM LAN Server * +//********************************* + +//**********WARNING **************** +//The range 2900-2999 has been * +//reserved for Microsoft OEMs * +//********************************* + +//*END_INTERNAL* + + MAX_NERR = (NERR_BASE+899); // This is the last error in NERR range. + {$EXTERNALSYM MAX_NERR} + +// +// end of list +// +// WARNING: Do not exceed MAX_NERR; values above this are used by +// other error code ranges (errlog.h, service.h, apperr.h). diff --git a/3rdParty/JCL/source/prototypes/win32api/Lmwksta.imp b/3rdParty/JCL/source/prototypes/win32api/Lmwksta.imp new file mode 100644 index 00000000..e789946e --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/Lmwksta.imp @@ -0,0 +1,15 @@ +{$IFDEF MSWINDOWS} + +type + TNetWkstaGetInfo = function (servername: PWideChar; level: DWORD; out bufptr: PByte): NET_API_STATUS; stdcall; + +var + _NetWkstaGetInfo: TNetWkstaGetInfo = nil; + +function NetWkstaGetInfo(servername: PWideChar; level: DWORD; out bufptr: PByte): NET_API_STATUS; stdcall; +begin + GetProcedureAddress(Pointer(@_NetWkstaGetInfo), netapi32, 'NetWkstaGetInfo'); + Result := _NetWkstaGetInfo(servername, level, bufptr); +end; + +{$ENDIF MSWINDOWS} diff --git a/3rdParty/JCL/source/prototypes/win32api/Lmwksta.int b/3rdParty/JCL/source/prototypes/win32api/Lmwksta.int new file mode 100644 index 00000000..a838cf67 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/Lmwksta.int @@ -0,0 +1,20 @@ +{$IFDEF MSWINDOWS} +type + _WKSTA_INFO_100 = record + wki100_platform_id: DWORD; + wki100_computername: LMSTR; + wki100_langroup: LMSTR; + wki100_ver_major: DWORD; + wki100_ver_minor: DWORD; + end; + {$EXTERNALSYM _WKSTA_INFO_100} + WKSTA_INFO_100 = _WKSTA_INFO_100; + {$EXTERNALSYM WKSTA_INFO_100} + PWKSTA_INFO_100 = ^_WKSTA_INFO_100; + {$EXTERNALSYM PWKSTA_INFO_100} + LPWKSTA_INFO_100 = ^_WKSTA_INFO_100; + {$EXTERNALSYM LPWKSTA_INFO_100} + +function NetWkstaGetInfo(servername: PWideChar; level: DWORD; out bufptr: PByte): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetWkstaGetInfo} +{$ENDIF MSWINDOWS} diff --git a/3rdParty/JCL/source/prototypes/win32api/MsiDefs.int b/3rdParty/JCL/source/prototypes/win32api/MsiDefs.int new file mode 100644 index 00000000..e24e16cd --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/MsiDefs.int @@ -0,0 +1,12 @@ +// msidefs.h line 349 + +// PIDs given specific meanings for Installer + +const + PID_MSIVERSION = $0000000E; // integer, Installer version number (major*100+minor) + {$EXTERNALSYM PID_MSIVERSION} + PID_MSISOURCE = $0000000F; // integer, type of file image, short/long, media/tree + {$EXTERNALSYM PID_MSISOURCE} + PID_MSIRESTRICT = $00000010; // integer, transform restrictions + {$EXTERNALSYM PID_MSIRESTRICT} + diff --git a/3rdParty/JCL/source/prototypes/win32api/Nb30.imp b/3rdParty/JCL/source/prototypes/win32api/Nb30.imp new file mode 100644 index 00000000..5d8d590b --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/Nb30.imp @@ -0,0 +1,14 @@ +{$IFDEF MSWINDOWS} + +type + TNetbios = function (pncb: PNCB): UCHAR; stdcall; +var + _Netbios: TNetbios = nil; + +function Netbios(pncb: PNCB): UCHAR; +begin + GetProcedureAddress(Pointer(@_Netbios), 'netapi32.dll', 'Netbios'); + Result := _Netbios(pncb); +end; + +{$ENDIF MSWINDOWS} diff --git a/3rdParty/JCL/source/prototypes/win32api/Nb30.int b/3rdParty/JCL/source/prototypes/win32api/Nb30.int new file mode 100644 index 00000000..2f3e3b87 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/Nb30.int @@ -0,0 +1,436 @@ +(**************************************************************** + * * + * Data structure templates * + * * + ****************************************************************) + +const + NCBNAMSZ = 16; // absolute length of a net name + {$EXTERNALSYM NCBNAMSZ} + MAX_LANA = 254; // lana's in range 0 to MAX_LANA inclusive + {$EXTERNALSYM MAX_LANA} + +// +// Network Control Block +// + +type + {$IFNDEF FPC} + PNCB = ^NCB; + {$ENDIF ~FPC} + + TNcbPost = procedure (P: PNCB); stdcall; + + {$IFNDEF FPC} + _NCB = record + ncb_command: UCHAR; // command code + ncb_retcode: UCHAR; // return code + ncb_lsn: UCHAR; // local session number + ncb_num: UCHAR; // number of our network name + ncb_buffer: PUCHAR; // address of message buffer + ncb_length: Word; // size of message buffer + ncb_callname: array [0..NCBNAMSZ - 1] of UCHAR; // blank-padded name of remote + ncb_name: array [0..NCBNAMSZ - 1] of UCHAR; // our blank-padded netname + ncb_rto: UCHAR; // rcv timeout/retry count + ncb_sto: UCHAR; // send timeout/sys timeout + ncb_post: TNcbPost; // POST routine address + ncb_lana_num: UCHAR; // lana (adapter) number + ncb_cmd_cplt: UCHAR; // 0xff => commmand pending + {$IFDEF _WIN64} + ncb_reserve: array [0..17] of UCHAR; // reserved, used by BIOS + {$ELSE ~_WIN64} + ncb_reserve: array [0..9] of UCHAR; // reserved, used by BIOS + {$ENDIF ~_WIN64} + ncb_event: THandle; // HANDLE to Win32 event which + // will be set to the signalled + // state when an ASYNCH command + // completes + end; + {$EXTERNALSYM _NCB} + NCB = _NCB; + {$EXTERNALSYM NCB} + TNcb = NCB; + {$ENDIF ~FPC} + +// +// Structure returned to the NCB command NCBASTAT is ADAPTER_STATUS followed +// by an array of NAME_BUFFER structures. +// +{$IFNDEF FPC} +type + _ADAPTER_STATUS = record + adapter_address: array [0..5] of UCHAR; + rev_major: UCHAR; + reserved0: UCHAR; + adapter_type: UCHAR; + rev_minor: UCHAR; + duration: WORD; + frmr_recv: WORD; + frmr_xmit: WORD; + iframe_recv_err: WORD; + xmit_aborts: WORD; + xmit_success: DWORD; + recv_success: DWORD; + iframe_xmit_err: WORD; + recv_buff_unavail: WORD; + t1_timeouts: WORD; + ti_timeouts: WORD; + reserved1: DWORD; + free_ncbs: WORD; + max_cfg_ncbs: WORD; + max_ncbs: WORD; + xmit_buf_unavail: WORD; + max_dgram_size: WORD; + pending_sess: WORD; + max_cfg_sess: WORD; + max_sess: WORD; + max_sess_pkt_size: WORD; + name_count: WORD; + end; + {$EXTERNALSYM _ADAPTER_STATUS} + ADAPTER_STATUS = _ADAPTER_STATUS; + {$EXTERNALSYM ADAPTER_STATUS} + PADAPTER_STATUS = ^ADAPTER_STATUS; + {$EXTERNALSYM PADAPTER_STATUS} + TAdapterStatus = ADAPTER_STATUS; + PAdapterStatus = PADAPTER_STATUS; + + _NAME_BUFFER = record + name: array [0..NCBNAMSZ - 1] of UCHAR; + name_num: UCHAR; + name_flags: UCHAR; + end; + {$EXTERNALSYM _NAME_BUFFER} + NAME_BUFFER = _NAME_BUFFER; + {$EXTERNALSYM NAME_BUFFER} + PNAME_BUFFER = ^NAME_BUFFER; + {$EXTERNALSYM PNAME_BUFFER} + TNameBuffer = NAME_BUFFER; + PNameBuffer = PNAME_BUFFER; +{$ENDIF ~FPC} + +// values for name_flags bits. + +const + NAME_FLAGS_MASK = $87; + {$EXTERNALSYM NAME_FLAGS_MASK} + + GROUP_NAME = $80; + {$EXTERNALSYM GROUP_NAME} + UNIQUE_NAME = $00; + {$EXTERNALSYM UNIQUE_NAME} + + REGISTERING = $00; + {$EXTERNALSYM REGISTERING} + REGISTERED = $04; + {$EXTERNALSYM REGISTERED} + DEREGISTERED = $05; + {$EXTERNALSYM DEREGISTERED} + DUPLICATE = $06; + {$EXTERNALSYM DUPLICATE} + DUPLICATE_DEREG = $07; + {$EXTERNALSYM DUPLICATE_DEREG} + +// +// Structure returned to the NCB command NCBSSTAT is SESSION_HEADER followed +// by an array of SESSION_BUFFER structures. If the NCB_NAME starts with an +// asterisk then an array of these structures is returned containing the +// status for all names. +// + +{$IFNDEF FPC} +type + _SESSION_HEADER = record + sess_name: UCHAR; + num_sess: UCHAR; + rcv_dg_outstanding: UCHAR; + rcv_any_outstanding: UCHAR; + end; + {$EXTERNALSYM _SESSION_HEADER} + SESSION_HEADER = _SESSION_HEADER; + {$EXTERNALSYM SESSION_HEADER} + PSESSION_HEADER = ^SESSION_HEADER; + {$EXTERNALSYM PSESSION_HEADER} + TSessionHeader = SESSION_HEADER; + PSessionHeader = PSESSION_HEADER; + + _SESSION_BUFFER = record + lsn: UCHAR; + state: UCHAR; + local_name: array [0..NCBNAMSZ - 1] of UCHAR; + remote_name: array [0..NCBNAMSZ - 1] of UCHAR; + rcvs_outstanding: UCHAR; + sends_outstanding: UCHAR; + end; + {$EXTERNALSYM _SESSION_BUFFER} + SESSION_BUFFER = _SESSION_BUFFER; + {$EXTERNALSYM SESSION_BUFFER} + PSESSION_BUFFER = ^SESSION_BUFFER; + {$EXTERNALSYM PSESSION_BUFFER} + TSessionBuffer = SESSION_BUFFER; + PSessionBuffer = PSESSION_BUFFER; +{$ENDIF ~FPC} + +// Values for state + +const + LISTEN_OUTSTANDING = $01; + {$EXTERNALSYM LISTEN_OUTSTANDING} + CALL_PENDING = $02; + {$EXTERNALSYM CALL_PENDING} + SESSION_ESTABLISHED = $03; + {$EXTERNALSYM SESSION_ESTABLISHED} + HANGUP_PENDING = $04; + {$EXTERNALSYM HANGUP_PENDING} + HANGUP_COMPLETE = $05; + {$EXTERNALSYM HANGUP_COMPLETE} + SESSION_ABORTED = $06; + {$EXTERNALSYM SESSION_ABORTED} + +// +// Structure returned to the NCB command NCBENUM. +// +// On a system containing lana's 0, 2 and 3, a structure with +// length =3, lana[0]=0, lana[1]=2 and lana[2]=3 will be returned. +// + +{$IFNDEF FPC} +type + _LANA_ENUM = record + length: UCHAR; // Number of valid entries in lana[] + lana: array [0..MAX_LANA] of UCHAR; + end; + {$EXTERNALSYM _LANA_ENUM} + LANA_ENUM = _LANA_ENUM; + {$EXTERNALSYM LANA_ENUM} + PLANA_ENUM = ^LANA_ENUM; + {$EXTERNALSYM PLANA_ENUM} + TLanaEnum = LANA_ENUM; + PLanaEnum = PLANA_ENUM; +{$ENDIF ~FPC} + +// +// Structure returned to the NCB command NCBFINDNAME is FIND_NAME_HEADER followed +// by an array of FIND_NAME_BUFFER structures. +// + +{$IFNDEF FPC} +type + _FIND_NAME_HEADER = record + node_count: WORD; + reserved: UCHAR; + unique_group: UCHAR; + end; + {$EXTERNALSYM _FIND_NAME_HEADER} + FIND_NAME_HEADER = _FIND_NAME_HEADER; + {$EXTERNALSYM FIND_NAME_HEADER} + PFIND_NAME_HEADER = ^FIND_NAME_HEADER; + {$EXTERNALSYM PFIND_NAME_HEADER} + TFindNameHeader = FIND_NAME_HEADER; + PFindNameHeader = PFIND_NAME_HEADER; + + _FIND_NAME_BUFFER = record + length: UCHAR; + access_control: UCHAR; + frame_control: UCHAR; + destination_addr: array [0..5] of UCHAR; + source_addr: array [0..5] of UCHAR; + routing_info: array [0..17] of UCHAR; + end; + {$EXTERNALSYM _FIND_NAME_BUFFER} + FIND_NAME_BUFFER = _FIND_NAME_BUFFER; + {$EXTERNALSYM FIND_NAME_BUFFER} + PFIND_NAME_BUFFER = ^FIND_NAME_BUFFER; + {$EXTERNALSYM PFIND_NAME_BUFFER} + TFindNameBuffer = FIND_NAME_BUFFER; + PFindNameBuffer = PFIND_NAME_BUFFER; + +// +// Structure provided with NCBACTION. The purpose of NCBACTION is to provide +// transport specific extensions to netbios. +// + + _ACTION_HEADER = record + transport_id: ULONG; + action_code: USHORT; + reserved: USHORT; + end; + {$EXTERNALSYM _ACTION_HEADER} + ACTION_HEADER = _ACTION_HEADER; + {$EXTERNALSYM ACTION_HEADER} + PACTION_HEADER = ^ACTION_HEADER; + {$EXTERNALSYM PACTION_HEADER} + TActionHeader = ACTION_HEADER; + PActionHeader = PACTION_HEADER; +{$ENDIF ~FPC} + +// Values for transport_id + +const + ALL_TRANSPORTS = 'M'#0#0#0; + {$EXTERNALSYM ALL_TRANSPORTS} + MS_NBF = 'MNBF'; + {$EXTERNALSYM MS_NBF} + +(**************************************************************** + * * + * Special values and constants * + * * + ****************************************************************) + +// +// NCB Command codes +// + +const + NCBCALL = $10; // NCB CALL + {$EXTERNALSYM NCBCALL} + NCBLISTEN = $11; // NCB LISTEN + {$EXTERNALSYM NCBLISTEN} + NCBHANGUP = $12; // NCB HANG UP + {$EXTERNALSYM NCBHANGUP} + NCBSEND = $14; // NCB SEND + {$EXTERNALSYM NCBSEND} + NCBRECV = $15; // NCB RECEIVE + {$EXTERNALSYM NCBRECV} + NCBRECVANY = $16; // NCB RECEIVE ANY + {$EXTERNALSYM NCBRECVANY} + NCBCHAINSEND = $17; // NCB CHAIN SEND + {$EXTERNALSYM NCBCHAINSEND} + NCBDGSEND = $20; // NCB SEND DATAGRAM + {$EXTERNALSYM NCBDGSEND} + NCBDGRECV = $21; // NCB RECEIVE DATAGRAM + {$EXTERNALSYM NCBDGRECV} + NCBDGSENDBC = $22; // NCB SEND BROADCAST DATAGRAM + {$EXTERNALSYM NCBDGSENDBC} + NCBDGRECVBC = $23; // NCB RECEIVE BROADCAST DATAGRAM + {$EXTERNALSYM NCBDGRECVBC} + NCBADDNAME = $30; // NCB ADD NAME + {$EXTERNALSYM NCBADDNAME} + NCBDELNAME = $31; // NCB DELETE NAME + {$EXTERNALSYM NCBDELNAME} + NCBRESET = $32; // NCB RESET + {$EXTERNALSYM NCBRESET} + NCBASTAT = $33; // NCB ADAPTER STATUS + {$EXTERNALSYM NCBASTAT} + NCBSSTAT = $34; // NCB SESSION STATUS + {$EXTERNALSYM NCBSSTAT} + NCBCANCEL = $35; // NCB CANCEL + {$EXTERNALSYM NCBCANCEL} + NCBADDGRNAME = $36; // NCB ADD GROUP NAME + {$EXTERNALSYM NCBADDGRNAME} + NCBENUM = $37; // NCB ENUMERATE LANA NUMBERS + {$EXTERNALSYM NCBENUM} + NCBUNLINK = $70; // NCB UNLINK + {$EXTERNALSYM NCBUNLINK} + NCBSENDNA = $71; // NCB SEND NO ACK + {$EXTERNALSYM NCBSENDNA} + NCBCHAINSENDNA = $72; // NCB CHAIN SEND NO ACK + {$EXTERNALSYM NCBCHAINSENDNA} + NCBLANSTALERT = $73; // NCB LAN STATUS ALERT + {$EXTERNALSYM NCBLANSTALERT} + NCBACTION = $77; // NCB ACTION + {$EXTERNALSYM NCBACTION} + NCBFINDNAME = $78; // NCB FIND NAME + {$EXTERNALSYM NCBFINDNAME} + NCBTRACE = $79; // NCB TRACE + {$EXTERNALSYM NCBTRACE} + + ASYNCH = $80; // high bit set == asynchronous + {$EXTERNALSYM ASYNCH} + +// +// NCB Return codes +// + + NRC_GOODRET = $00; // good return also returned when ASYNCH request accepted + {$EXTERNALSYM NRC_GOODRET} + NRC_BUFLEN = $01; // illegal buffer length + {$EXTERNALSYM NRC_BUFLEN} + NRC_ILLCMD = $03; // illegal command + {$EXTERNALSYM NRC_ILLCMD} + NRC_CMDTMO = $05; // command timed out + {$EXTERNALSYM NRC_CMDTMO} + NRC_INCOMP = $06; // message incomplete, issue another command + {$EXTERNALSYM NRC_INCOMP} + NRC_BADDR = $07; // illegal buffer address + {$EXTERNALSYM NRC_BADDR} + NRC_SNUMOUT = $08; // session number out of range + {$EXTERNALSYM NRC_SNUMOUT} + NRC_NORES = $09; // no resource available + {$EXTERNALSYM NRC_NORES} + NRC_SCLOSED = $0a; // session closed + {$EXTERNALSYM NRC_SCLOSED} + NRC_CMDCAN = $0b; // command cancelled + {$EXTERNALSYM NRC_CMDCAN} + NRC_DUPNAME = $0d; // duplicate name + {$EXTERNALSYM NRC_DUPNAME} + NRC_NAMTFUL = $0e; // name table full + {$EXTERNALSYM NRC_NAMTFUL} + NRC_ACTSES = $0f; // no deletions, name has active sessions + {$EXTERNALSYM NRC_ACTSES} + NRC_LOCTFUL = $11; // local session table full + {$EXTERNALSYM NRC_LOCTFUL} + NRC_REMTFUL = $12; // remote session table full + {$EXTERNALSYM NRC_REMTFUL} + NRC_ILLNN = $13; // illegal name number + {$EXTERNALSYM NRC_ILLNN} + NRC_NOCALL = $14; // no callname + {$EXTERNALSYM NRC_NOCALL} + NRC_NOWILD = $15; // cannot put * in NCB_NAME + {$EXTERNALSYM NRC_NOWILD} + NRC_INUSE = $16; // name in use on remote adapter + {$EXTERNALSYM NRC_INUSE} + NRC_NAMERR = $17; // name deleted + {$EXTERNALSYM NRC_NAMERR} + NRC_SABORT = $18; // session ended abnormally + {$EXTERNALSYM NRC_SABORT} + NRC_NAMCONF = $19; // name conflict detected + {$EXTERNALSYM NRC_NAMCONF} + NRC_IFBUSY = $21; // interface busy, IRET before retrying + {$EXTERNALSYM NRC_IFBUSY} + NRC_TOOMANY = $22; // too many commands outstanding, retry later + {$EXTERNALSYM NRC_TOOMANY} + NRC_BRIDGE = $23; // ncb_lana_num field invalid + {$EXTERNALSYM NRC_BRIDGE} + NRC_CANOCCR = $24; // command completed while cancel occurring + {$EXTERNALSYM NRC_CANOCCR} + NRC_CANCEL = $26; // command not valid to cancel + {$EXTERNALSYM NRC_CANCEL} + NRC_DUPENV = $30; // name defined by anther local process + {$EXTERNALSYM NRC_DUPENV} + NRC_ENVNOTDEF = $34; // environment undefined. RESET required + {$EXTERNALSYM NRC_ENVNOTDEF} + NRC_OSRESNOTAV = $35; // required OS resources exhausted + {$EXTERNALSYM NRC_OSRESNOTAV} + NRC_MAXAPPS = $36; // max number of applications exceeded + {$EXTERNALSYM NRC_MAXAPPS} + NRC_NOSAPS = $37; // no saps available for netbios + {$EXTERNALSYM NRC_NOSAPS} + NRC_NORESOURCES = $38; // requested resources are not available + {$EXTERNALSYM NRC_NORESOURCES} + NRC_INVADDRESS = $39; // invalid ncb address or length > segment + {$EXTERNALSYM NRC_INVADDRESS} + NRC_INVDDID = $3B; // invalid NCB DDID + {$EXTERNALSYM NRC_INVDDID} + NRC_LOCKFAIL = $3C; // lock of user area failed + {$EXTERNALSYM NRC_LOCKFAIL} + NRC_OPENERR = $3f; // NETBIOS not loaded + {$EXTERNALSYM NRC_OPENERR} + NRC_SYSTEM = $40; // system error + {$EXTERNALSYM NRC_SYSTEM} + + NRC_PENDING = $ff; // asynchronous command is not yet finished + {$EXTERNALSYM NRC_PENDING} + +(**************************************************************** + * * + * main user entry point for NetBIOS 3.0 * + * * + * Usage: result = Netbios( pncb ); * + ****************************************************************) + +{$IFDEF MSWINDOWS} +function Netbios(pncb: PNCB): UCHAR; stdcall; +{$EXTERNALSYM Netbios} +{$ENDIF MSWINDOWS} diff --git a/3rdParty/JCL/source/prototypes/win32api/NtSecApi.imp b/3rdParty/JCL/source/prototypes/win32api/NtSecApi.imp new file mode 100644 index 00000000..bd86251d --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/NtSecApi.imp @@ -0,0 +1,77 @@ +type + TLsaOpenPolicy = function (SystemName: PLSA_UNICODE_STRING; + var ObjectAttributes: LSA_OBJECT_ATTRIBUTES; DesiredAccess: ACCESS_MASK; + var PolicyHandle: LSA_HANDLE): NTSTATUS; stdcall; + +var + _LsaOpenPolicy: TLsaOpenPolicy = nil; + +function LsaOpenPolicy(SystemName: PLSA_UNICODE_STRING; + var ObjectAttributes: LSA_OBJECT_ATTRIBUTES; DesiredAccess: ACCESS_MASK; + var PolicyHandle: LSA_HANDLE): NTSTATUS; +begin + GetProcedureAddress(Pointer(@_LsaOpenPolicy), advapi32, 'LsaOpenPolicy'); + Result := _LsaOpenPolicy(SystemName, ObjectAttributes, DesiredAccess, PolicyHandle); +end; + +type + TLsaQueryInformationPolicy = function (PolicyHandle: LSA_HANDLE; + InformationClass: POLICY_INFORMATION_CLASS; var Buffer: Pointer): NTSTATUS; stdcall; + +var + _LsaQueryInformationPolicy: TLsaQueryInformationPolicy = nil; + +function LsaQueryInformationPolicy(PolicyHandle: LSA_HANDLE; + InformationClass: POLICY_INFORMATION_CLASS; var Buffer: Pointer): NTSTATUS; +begin + GetProcedureAddress(Pointer(@_LsaQueryInformationPolicy), advapi32, 'LsaQueryInformationPolicy'); + Result := _LsaQueryInformationPolicy(PolicyHandle, InformationClass, Buffer); +end; + +type + TLsaFreeMemory = function (Buffer: Pointer): NTSTATUS; stdcall; + +var + _LsaFreeMemory: TLsaFreeMemory = nil; + +function LsaFreeMemory(Buffer: Pointer): NTSTATUS; +begin + GetProcedureAddress(Pointer(@_LsaFreeMemory), advapi32, 'LsaFreeMemory'); + Result := _LsaFreeMemory(Buffer); +end; + +type + TLsaFreeReturnBuffer = function (Buffer: Pointer): NTSTATUS; stdcall; + +var + _LsaFreeReturnBuffer: TLsaFreeReturnBuffer = nil; + +function LsaFreeReturnBuffer(Buffer: Pointer): NTSTATUS; +begin + GetProcedureAddress(Pointer(@_LsaFreeReturnBuffer), advapi32, 'LsaFreeReturnBuffer'); + Result := _LsaFreeReturnBuffer(Buffer); +end; + +type + TLsaClose = function (ObjectHandle: LSA_HANDLE): NTSTATUS; stdcall; + +var + _LsaClose: TLsaClose = nil; + +function LsaClose(ObjectHandle: LSA_HANDLE): NTSTATUS; +begin + GetProcedureAddress(Pointer(@_LsaClose), advapi32, 'LsaClose'); + Result := _LsaClose(ObjectHandle); +end; + +type + TLsaNtStatusToWinError = function (Status: NTSTATUS): ULONG; stdcall; + +var + _LsaNtStatusToWinError: TLsaNtStatusToWinError = nil; + +function LsaNtStatusToWinError(Status: NTSTATUS): ULONG; +begin + GetProcedureAddress(Pointer(@_LsaNtStatusToWinError), advapi32, 'LsaNtStatusToWinError'); + Result := _LsaNtStatusToWinError(Status); +end; diff --git a/3rdParty/JCL/source/prototypes/win32api/NtSecApi.int b/3rdParty/JCL/source/prototypes/win32api/NtSecApi.int new file mode 100644 index 00000000..270b9e72 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/NtSecApi.int @@ -0,0 +1,172 @@ +// NtSecApi.h line 566 +type + PLSA_UNICODE_STRING = ^LSA_UNICODE_STRING; + _LSA_UNICODE_STRING = record + Length: USHORT; + MaximumLength: USHORT; + Buffer: {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.LPWSTR; + end; + LSA_UNICODE_STRING = _LSA_UNICODE_STRING; + TLsaUnicodeString = LSA_UNICODE_STRING; + PLsaUnicodeString = PLSA_UNICODE_STRING; + + PLSA_STRING = ^LSA_STRING; + _LSA_STRING = record + Length: USHORT; + MaximumLength: USHORT; + Buffer: PANSICHAR; + end; + LSA_STRING = _LSA_STRING; + TLsaString = LSA_STRING; + PLsaString = PLSA_STRING; + + PLSA_OBJECT_ATTRIBUTES = ^LSA_OBJECT_ATTRIBUTES; + _LSA_OBJECT_ATTRIBUTES = record + Length: ULONG; + RootDirectory: {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.THandle; + ObjectName: PLSA_UNICODE_STRING; + Attributes: ULONG; + SecurityDescriptor: Pointer; // Points to type SECURITY_DESCRIPTOR + SecurityQualityOfService: Pointer; // Points to type SECURITY_QUALITY_OF_SERVICE + end; + LSA_OBJECT_ATTRIBUTES = _LSA_OBJECT_ATTRIBUTES; + TLsaObjectAttributes = _LSA_OBJECT_ATTRIBUTES; + PLsaObjectAttributes = PLSA_OBJECT_ATTRIBUTES; + +// NtSecApi.h line 680 + +//////////////////////////////////////////////////////////////////////////// +// // +// Local Security Policy Administration API datatypes and defines // +// // +//////////////////////////////////////////////////////////////////////////// + +// +// Access types for the Policy object +// + +const + POLICY_VIEW_LOCAL_INFORMATION = $00000001; + {$EXTERNALSYM POLICY_VIEW_LOCAL_INFORMATION} + POLICY_VIEW_AUDIT_INFORMATION = $00000002; + {$EXTERNALSYM POLICY_VIEW_AUDIT_INFORMATION} + POLICY_GET_PRIVATE_INFORMATION = $00000004; + {$EXTERNALSYM POLICY_GET_PRIVATE_INFORMATION} + POLICY_TRUST_ADMIN = $00000008; + {$EXTERNALSYM POLICY_TRUST_ADMIN} + POLICY_CREATE_ACCOUNT = $00000010; + {$EXTERNALSYM POLICY_CREATE_ACCOUNT} + POLICY_CREATE_SECRET = $00000020; + {$EXTERNALSYM POLICY_CREATE_SECRET} + POLICY_CREATE_PRIVILEGE = $00000040; + {$EXTERNALSYM POLICY_CREATE_PRIVILEGE} + POLICY_SET_DEFAULT_QUOTA_LIMITS = $00000080; + {$EXTERNALSYM POLICY_SET_DEFAULT_QUOTA_LIMITS} + POLICY_SET_AUDIT_REQUIREMENTS = $00000100; + {$EXTERNALSYM POLICY_SET_AUDIT_REQUIREMENTS} + POLICY_AUDIT_LOG_ADMIN = $00000200; + {$EXTERNALSYM POLICY_AUDIT_LOG_ADMIN} + POLICY_SERVER_ADMIN = $00000400; + {$EXTERNALSYM POLICY_SERVER_ADMIN} + POLICY_LOOKUP_NAMES = $00000800; + {$EXTERNALSYM POLICY_LOOKUP_NAMES} + POLICY_NOTIFICATION = $00001000; + {$EXTERNALSYM POLICY_NOTIFICATION} + + POLICY_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED or + POLICY_VIEW_LOCAL_INFORMATION or + POLICY_VIEW_AUDIT_INFORMATION or + POLICY_GET_PRIVATE_INFORMATION or + POLICY_TRUST_ADMIN or + POLICY_CREATE_ACCOUNT or + POLICY_CREATE_SECRET or + POLICY_CREATE_PRIVILEGE or + POLICY_SET_DEFAULT_QUOTA_LIMITS or + POLICY_SET_AUDIT_REQUIREMENTS or + POLICY_AUDIT_LOG_ADMIN or + POLICY_SERVER_ADMIN or + POLICY_LOOKUP_NAMES); + {$EXTERNALSYM POLICY_ALL_ACCESS} + + POLICY_READ = (STANDARD_RIGHTS_READ or + POLICY_VIEW_AUDIT_INFORMATION or + POLICY_GET_PRIVATE_INFORMATION); + {$EXTERNALSYM POLICY_READ} + + POLICY_WRITE = (STANDARD_RIGHTS_WRITE or + POLICY_TRUST_ADMIN or + POLICY_CREATE_ACCOUNT or + POLICY_CREATE_SECRET or + POLICY_CREATE_PRIVILEGE or + POLICY_SET_DEFAULT_QUOTA_LIMITS or + POLICY_SET_AUDIT_REQUIREMENTS or + POLICY_AUDIT_LOG_ADMIN or + POLICY_SERVER_ADMIN); + {$EXTERNALSYM POLICY_WRITE} + + POLICY_EXECUTE = (STANDARD_RIGHTS_EXECUTE or + POLICY_VIEW_LOCAL_INFORMATION or + POLICY_LOOKUP_NAMES); + {$EXTERNALSYM POLICY_EXECUTE} + +// NtSecApi.h line 914 +type + _POLICY_INFORMATION_CLASS = ( + picFill0, + PolicyAuditLogInformation, + PolicyAuditEventsInformation, + PolicyPrimaryDomainInformation, + PolicyPdAccountInformation, + PolicyAccountDomainInformation, + PolicyLsaServerRoleInformation, + PolicyReplicaSourceInformation, + PolicyDefaultQuotaInformation, + PolicyModificationInformation, + PolicyAuditFullSetInformation, + PolicyAuditFullQueryInformation, + PolicyDnsDomainInformation, + PolicyDnsDomainInformationInt); + {$EXTERNALSYM _POLICY_INFORMATION_CLASS} + POLICY_INFORMATION_CLASS = _POLICY_INFORMATION_CLASS; + {$EXTERNALSYM POLICY_INFORMATION_CLASS} + PPOLICY_INFORMATION_CLASS = ^POLICY_INFORMATION_CLASS; + {$EXTERNALSYM PPOLICY_INFORMATION_CLASS} + TPolicyInformationClass = POLICY_INFORMATION_CLASS; + {$EXTERNALSYM TPolicyInformationClass} + PPolicyInformationClass = PPOLICY_INFORMATION_CLASS; + {$EXTERNALSYM PPolicyInformationClass} + +// NtSecApi.h line 1031 +// +// The following structure corresponds to the PolicyAccountDomainInformation +// information class. +// +type + PPOLICY_ACCOUNT_DOMAIN_INFO = ^POLICY_ACCOUNT_DOMAIN_INFO; + _POLICY_ACCOUNT_DOMAIN_INFO = record + DomainName: LSA_UNICODE_STRING; + DomainSid: {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.PSID; + end; + POLICY_ACCOUNT_DOMAIN_INFO = _POLICY_ACCOUNT_DOMAIN_INFO; + TPolicyAccountDomainInfo = POLICY_ACCOUNT_DOMAIN_INFO; + PPolicyAccountDomainInfo = PPOLICY_ACCOUNT_DOMAIN_INFO; + +// NtSecApi.h line 1298 +type + LSA_HANDLE = Pointer; + PLSA_HANDLE = ^LSA_HANDLE; + TLsaHandle = LSA_HANDLE; + +// NtSecApi.h line 1714 +type + NTSTATUS = DWORD; + +function LsaOpenPolicy(SystemName: PLSA_UNICODE_STRING; + var ObjectAttributes: LSA_OBJECT_ATTRIBUTES; DesiredAccess: ACCESS_MASK; + var PolicyHandle: LSA_HANDLE): NTSTATUS; stdcall; +function LsaQueryInformationPolicy(PolicyHandle: LSA_HANDLE; + InformationClass: POLICY_INFORMATION_CLASS; var Buffer: Pointer): NTSTATUS; stdcall; +function LsaFreeMemory(Buffer: Pointer): NTSTATUS; stdcall; +function LsaFreeReturnBuffer(Buffer: Pointer): NTSTATUS; stdcall; +function LsaClose(ObjectHandle: LSA_HANDLE): NTSTATUS; stdcall; +function LsaNtStatusToWinError(Status: NTSTATUS): ULONG; stdcall; diff --git a/3rdParty/JCL/source/prototypes/win32api/ObjBase.imp b/3rdParty/JCL/source/prototypes/win32api/ObjBase.imp new file mode 100644 index 00000000..c5702c5a --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/ObjBase.imp @@ -0,0 +1,38 @@ +{$IFDEF MSWINDOWS} + +const + Ole32Lib = 'ole32.dll'; + +type + TStgCreateStorageEx = function (const pwcsName: PWideChar; grfMode: DWORD; + stgfmt: DWORD; grfAttrs: DWORD; pStgOptions: PSTGOPTIONS; reserved2: Pointer; + riid: PGUID; out stgOpen: IInterface): HResult; stdcall; + +var + _StgCreateStorageEx: TStgCreateStorageEx = nil; + +function StgCreateStorageEx(const pwcsName: PWideChar; grfMode: DWORD; + stgfmt: DWORD; grfAttrs: DWORD; pStgOptions: PSTGOPTIONS; reserved2: Pointer; + riid: PGUID; out stgOpen: IInterface): HResult; +begin + GetProcedureAddress(Pointer(@_StgCreateStorageEx), Ole32Lib, 'StgCreateStorageEx'); + Result := _StgCreateStorageEx(pwcsName, grfMode, stgfmt, grfAttrs, pStgOptions, reserved2, riid, stgOpen); +end; + +type + TStgOpenStorageEx = function (const pwcsName: PWideChar; grfMode: DWORD; + stgfmt: DWORD; grfAttrs: DWORD; pStgOptions: PSTGOPTIONS; reserved2: Pointer; + riid: PGUID; out stgOpen: IInterface): HResult; stdcall; + +var + _StgOpenStorageEx: TStgOpenStorageEx = nil; + +function StgOpenStorageEx(const pwcsName: PWideChar; grfMode: DWORD; + stgfmt: DWORD; grfAttrs: DWORD; pStgOptions: PSTGOPTIONS; reserved2: Pointer; + riid: PGUID; out stgOpen: IInterface): HResult; +begin + GetProcedureAddress(Pointer(@_StgOpenStorageEx), Ole32Lib, 'StgOpenStorageEx'); + Result := _StgOpenStorageEx(pwcsName, grfMode, stgfmt, grfAttrs, pStgOptions, reserved2, riid, stgOpen); +end; + +{$ENDIF MSWINDOWS} diff --git a/3rdParty/JCL/source/prototypes/win32api/ObjBase.int b/3rdParty/JCL/source/prototypes/win32api/ObjBase.int new file mode 100644 index 00000000..1221808b --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/ObjBase.int @@ -0,0 +1,44 @@ +{$IFDEF MSWINDOWS} + +// objbase.h line 390 +const + STGFMT_STORAGE = 0; + {$EXTERNALSYM STGFMT_STORAGE} + STGFMT_NATIVE = 1; + {$EXTERNALSYM STGFMT_NATIVE} + STGFMT_FILE = 3; + {$EXTERNALSYM STGFMT_FILE} + STGFMT_ANY = 4; + {$EXTERNALSYM STGFMT_ANY} + STGFMT_DOCFILE = 5; + {$EXTERNALSYM STGFMT_DOCFILE} +// This is a legacy define to allow old component to builds + STGFMT_DOCUMENT = 0; + {$EXTERNALSYM STGFMT_DOCUMENT} + +// objbase.h line 913 + +type + tagSTGOPTIONS = record + usVersion: Word; // Versions 1 and 2 supported + reserved: Word; // must be 0 for padding + ulSectorSize: Cardinal; // docfile header sector size (512) + pwcsTemplateFile: PWideChar; // version 2 or above + end; + {$EXTERNALSYM tagSTGOPTIONS} + STGOPTIONS = tagSTGOPTIONS; + {$EXTERNALSYM STGOPTIONS} + PSTGOPTIONS = ^STGOPTIONS; + {$EXTERNALSYM PSTGOPTIONS} + +function StgCreateStorageEx(const pwcsName: PWideChar; grfMode: DWORD; + stgfmt: DWORD; grfAttrs: DWORD; pStgOptions: PSTGOPTIONS; reserved2: Pointer; + riid: PGUID; out stgOpen: IInterface): HResult; stdcall; +{$EXTERNALSYM StgCreateStorageEx} + +function StgOpenStorageEx(const pwcsName: PWideChar; grfMode: DWORD; + stgfmt: DWORD; grfAttrs: DWORD; pStgOptions: PSTGOPTIONS; reserved2: Pointer; + riid: PGUID; out stgOpen: IInterface): HResult; stdcall; +{$EXTERNALSYM StgOpenStorageEx} + +{$ENDIF MSWINDOWS} diff --git a/3rdParty/JCL/source/prototypes/win32api/PropIdl.imp b/3rdParty/JCL/source/prototypes/win32api/PropIdl.imp new file mode 100644 index 00000000..27dfb188 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/PropIdl.imp @@ -0,0 +1,12 @@ +type + TPropVariantClear = function (var Prop: TPropVariant): HResult; stdcall; + +var + _PropVariantClear: TPropVariantClear = nil; + +function PropVariantClear(var Prop: TPropVariant): HResult; +begin + GetProcedureAddress(Pointer(@_PropVariantClear), Ole32Lib, 'PropVariantClear'); + Result := _PropVariantClear(Prop); +end; + diff --git a/3rdParty/JCL/source/prototypes/win32api/PropIdl.int b/3rdParty/JCL/source/prototypes/win32api/PropIdl.int new file mode 100644 index 00000000..80afcfa3 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/PropIdl.int @@ -0,0 +1,138 @@ +// propidl.h line 386 + +// Reserved global Property IDs +const + PID_DICTIONARY = $00000000; // integer count + array of entries + {$EXTERNALSYM PID_DICTIONARY} + PID_CODEPAGE = $00000001; // short integer + {$EXTERNALSYM PID_CODEPAGE} + PID_FIRST_USABLE = $00000002; + {$EXTERNALSYM PID_FIRST_USABLE} + PID_FIRST_NAME_DEFAULT = $00000FFF; + {$EXTERNALSYM PID_FIRST_NAME_DEFAULT} + PID_LOCALE = $80000000; + {$EXTERNALSYM PID_LOCALE} + PID_MODIFY_TIME = $80000001; + {$EXTERNALSYM PID_MODIFY_TIME} + PID_SECURITY = $80000002; + {$EXTERNALSYM PID_SECURITY} + PID_BEHAVIOR = $80000003; + {$EXTERNALSYM PID_BEHAVIOR} + PID_ILLEGAL = $FFFFFFFF; + {$EXTERNALSYM PID_ILLEGAL} + +// Range which is read-only to downlevel implementations + +const + PID_MIN_READONLY = $80000000; + {$EXTERNALSYM PID_MIN_READONLY} + PID_MAX_READONLY = $BFFFFFFF; + {$EXTERNALSYM PID_MAX_READONLY} + +// Property IDs for the DiscardableInformation Property Set + +const + PIDDI_THUMBNAIL = $00000002; // VT_BLOB + {$EXTERNALSYM PIDDI_THUMBNAIL} + +// Property IDs for the SummaryInformation Property Set + +const + PIDSI_TITLE = $00000002; // VT_LPSTR + {$EXTERNALSYM PIDSI_TITLE} + PIDSI_SUBJECT = $00000003; // VT_LPSTR + {$EXTERNALSYM PIDSI_SUBJECT} + PIDSI_AUTHOR = $00000004; // VT_LPSTR + {$EXTERNALSYM PIDSI_AUTHOR} + PIDSI_KEYWORDS = $00000005; // VT_LPSTR + {$EXTERNALSYM PIDSI_KEYWORDS} + PIDSI_COMMENTS = $00000006; // VT_LPSTR + {$EXTERNALSYM PIDSI_COMMENTS} + PIDSI_TEMPLATE = $00000007; // VT_LPSTR + {$EXTERNALSYM PIDSI_TEMPLATE} + PIDSI_LASTAUTHOR = $00000008; // VT_LPSTR + {$EXTERNALSYM PIDSI_LASTAUTHOR} + PIDSI_REVNUMBER = $00000009; // VT_LPSTR + {$EXTERNALSYM PIDSI_REVNUMBER} + PIDSI_EDITTIME = $0000000A; // VT_FILETIME (UTC) + {$EXTERNALSYM PIDSI_EDITTIME} + PIDSI_LASTPRINTED = $0000000B; // VT_FILETIME (UTC) + {$EXTERNALSYM PIDSI_LASTPRINTED} + PIDSI_CREATE_DTM = $0000000C; // VT_FILETIME (UTC) + {$EXTERNALSYM PIDSI_CREATE_DTM} + PIDSI_LASTSAVE_DTM = $0000000D; // VT_FILETIME (UTC) + {$EXTERNALSYM PIDSI_LASTSAVE_DTM} + PIDSI_PAGECOUNT = $0000000E; // VT_I4 + {$EXTERNALSYM PIDSI_PAGECOUNT} + PIDSI_WORDCOUNT = $0000000F; // VT_I4 + {$EXTERNALSYM PIDSI_WORDCOUNT} + PIDSI_CHARCOUNT = $00000010; // VT_I4 + {$EXTERNALSYM PIDSI_CHARCOUNT} + PIDSI_THUMBNAIL = $00000011; // VT_CF + {$EXTERNALSYM PIDSI_THUMBNAIL} + PIDSI_APPNAME = $00000012; // VT_LPSTR + {$EXTERNALSYM PIDSI_APPNAME} + PIDSI_DOC_SECURITY = $00000013; // VT_I4 + {$EXTERNALSYM PIDSI_DOC_SECURITY} + +// Property IDs for the DocSummaryInformation Property Set + +const + PIDDSI_CATEGORY = $00000002; // VT_LPSTR + {$EXTERNALSYM PIDDSI_CATEGORY} + PIDDSI_PRESFORMAT = $00000003; // VT_LPSTR + {$EXTERNALSYM PIDDSI_PRESFORMAT} + PIDDSI_BYTECOUNT = $00000004; // VT_I4 + {$EXTERNALSYM PIDDSI_BYTECOUNT} + PIDDSI_LINECOUNT = $00000005; // VT_I4 + {$EXTERNALSYM PIDDSI_LINECOUNT} + PIDDSI_PARCOUNT = $00000006; // VT_I4 + {$EXTERNALSYM PIDDSI_PARCOUNT} + PIDDSI_SLIDECOUNT = $00000007; // VT_I4 + {$EXTERNALSYM PIDDSI_SLIDECOUNT} + PIDDSI_NOTECOUNT = $00000008; // VT_I4 + {$EXTERNALSYM PIDDSI_NOTECOUNT} + PIDDSI_HIDDENCOUNT = $00000009; // VT_I4 + {$EXTERNALSYM PIDDSI_HIDDENCOUNT} + PIDDSI_MMCLIPCOUNT = $0000000A; // VT_I4 + {$EXTERNALSYM PIDDSI_MMCLIPCOUNT} + PIDDSI_SCALE = $0000000B; // VT_BOOL + {$EXTERNALSYM PIDDSI_SCALE} + PIDDSI_HEADINGPAIR = $0000000C; // VT_VARIANT | VT_VECTOR + {$EXTERNALSYM PIDDSI_HEADINGPAIR} + PIDDSI_DOCPARTS = $0000000D; // VT_LPSTR | VT_VECTOR + {$EXTERNALSYM PIDDSI_DOCPARTS} + PIDDSI_MANAGER = $0000000E; // VT_LPSTR + {$EXTERNALSYM PIDDSI_MANAGER} + PIDDSI_COMPANY = $0000000F; // VT_LPSTR + {$EXTERNALSYM PIDDSI_COMPANY} + PIDDSI_LINKSDIRTY = $00000010; // VT_BOOL + {$EXTERNALSYM PIDDSI_LINKSDIRTY} + +// FMTID_MediaFileSummaryInfo - Property IDs + +const + PIDMSI_EDITOR = $00000002; // VT_LPWSTR + {$EXTERNALSYM PIDMSI_EDITOR} + PIDMSI_SUPPLIER = $00000003; // VT_LPWSTR + {$EXTERNALSYM PIDMSI_SUPPLIER} + PIDMSI_SOURCE = $00000004; // VT_LPWSTR + {$EXTERNALSYM PIDMSI_SOURCE} + PIDMSI_SEQUENCE_NO = $00000005; // VT_LPWSTR + {$EXTERNALSYM PIDMSI_SEQUENCE_NO} + PIDMSI_PROJECT = $00000006; // VT_LPWSTR + {$EXTERNALSYM PIDMSI_PROJECT} + PIDMSI_STATUS = $00000007; // VT_UI4 + {$EXTERNALSYM PIDMSI_STATUS} + PIDMSI_OWNER = $00000008; // VT_LPWSTR + {$EXTERNALSYM PIDMSI_OWNER} + PIDMSI_RATING = $00000009; // VT_LPWSTR + {$EXTERNALSYM PIDMSI_RATING} + PIDMSI_PRODUCTION = $0000000A; // VT_FILETIME (UTC) + {$EXTERNALSYM PIDMSI_PRODUCTION} + PIDMSI_COPYRIGHT = $0000000B; // VT_LPWSTR + {$EXTERNALSYM PIDMSI_COPYRIGHT} + +function PropVariantClear(var Prop: TPropVariant): HResult; stdcall; +{$EXTERNALSYM PropVariantClear} + diff --git a/3rdParty/JCL/source/prototypes/win32api/RasDlg.int b/3rdParty/JCL/source/prototypes/win32api/RasDlg.int new file mode 100644 index 00000000..26d145b6 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/RasDlg.int @@ -0,0 +1,18 @@ +type + PRasDialDlg = ^TRasDialDlg; + tagRASDIALDLG = packed record + dwSize: DWORD; + hwndOwner: HWND; + dwFlags: DWORD; + xDlg: Longint; + yDlg: Longint; + dwSubEntry: DWORD; + dwError: DWORD; + reserved: Longword; + reserved2: Longword; + end; + {$EXTERNALSYM tagRASDIALDLG} + RASDIALDLG = tagRASDIALDLG; + {$EXTERNALSYM RASDIALDLG} + TRasDialDlg = tagRASDIALDLG; + diff --git a/3rdParty/JCL/source/prototypes/win32api/Reason.int b/3rdParty/JCL/source/prototypes/win32api/Reason.int new file mode 100644 index 00000000..c1e980db --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/Reason.int @@ -0,0 +1,125 @@ +// Reason flags + +// Flags used by the various UIs. + +const + SHTDN_REASON_FLAG_COMMENT_REQUIRED = $01000000; + {$EXTERNALSYM SHTDN_REASON_FLAG_COMMENT_REQUIRED} + SHTDN_REASON_FLAG_DIRTY_PROBLEM_ID_REQUIRED = $02000000; + {$EXTERNALSYM SHTDN_REASON_FLAG_DIRTY_PROBLEM_ID_REQUIRED} + SHTDN_REASON_FLAG_CLEAN_UI = $04000000; + {$EXTERNALSYM SHTDN_REASON_FLAG_CLEAN_UI} + SHTDN_REASON_FLAG_DIRTY_UI = $08000000; + {$EXTERNALSYM SHTDN_REASON_FLAG_DIRTY_UI} + +// Flags that end up in the event log code. + + SHTDN_REASON_FLAG_USER_DEFINED = $40000000; + {$EXTERNALSYM SHTDN_REASON_FLAG_USER_DEFINED} + SHTDN_REASON_FLAG_PLANNED = DWORD($80000000); + {$EXTERNALSYM SHTDN_REASON_FLAG_PLANNED} + +// Microsoft major reasons. + + SHTDN_REASON_MAJOR_OTHER = $00000000; + {$EXTERNALSYM SHTDN_REASON_MAJOR_OTHER} + SHTDN_REASON_MAJOR_NONE = $00000000; + {$EXTERNALSYM SHTDN_REASON_MAJOR_NONE} + SHTDN_REASON_MAJOR_HARDWARE = $00010000; + {$EXTERNALSYM SHTDN_REASON_MAJOR_HARDWARE} + SHTDN_REASON_MAJOR_OPERATINGSYSTEM = $00020000; + {$EXTERNALSYM SHTDN_REASON_MAJOR_OPERATINGSYSTEM} + SHTDN_REASON_MAJOR_SOFTWARE = $00030000; + {$EXTERNALSYM SHTDN_REASON_MAJOR_SOFTWARE} + SHTDN_REASON_MAJOR_APPLICATION = $00040000; + {$EXTERNALSYM SHTDN_REASON_MAJOR_APPLICATION} + SHTDN_REASON_MAJOR_SYSTEM = $00050000; + {$EXTERNALSYM SHTDN_REASON_MAJOR_SYSTEM} + SHTDN_REASON_MAJOR_POWER = $00060000; + {$EXTERNALSYM SHTDN_REASON_MAJOR_POWER} + SHTDN_REASON_MAJOR_LEGACY_API = $00070000; + {$EXTERNALSYM SHTDN_REASON_MAJOR_LEGACY_API} + +// Microsoft minor reasons. + + SHTDN_REASON_MINOR_OTHER = $00000000; + {$EXTERNALSYM SHTDN_REASON_MINOR_OTHER} + SHTDN_REASON_MINOR_NONE = $000000ff; + {$EXTERNALSYM SHTDN_REASON_MINOR_NONE} + SHTDN_REASON_MINOR_MAINTENANCE = $00000001; + {$EXTERNALSYM SHTDN_REASON_MINOR_MAINTENANCE} + SHTDN_REASON_MINOR_INSTALLATION = $00000002; + {$EXTERNALSYM SHTDN_REASON_MINOR_INSTALLATION} + SHTDN_REASON_MINOR_UPGRADE = $00000003; + {$EXTERNALSYM SHTDN_REASON_MINOR_UPGRADE} + SHTDN_REASON_MINOR_RECONFIG = $00000004; + {$EXTERNALSYM SHTDN_REASON_MINOR_RECONFIG} + SHTDN_REASON_MINOR_HUNG = $00000005; + {$EXTERNALSYM SHTDN_REASON_MINOR_HUNG} + SHTDN_REASON_MINOR_UNSTABLE = $00000006; + {$EXTERNALSYM SHTDN_REASON_MINOR_UNSTABLE} + SHTDN_REASON_MINOR_DISK = $00000007; + {$EXTERNALSYM SHTDN_REASON_MINOR_DISK} + SHTDN_REASON_MINOR_PROCESSOR = $00000008; + {$EXTERNALSYM SHTDN_REASON_MINOR_PROCESSOR} + SHTDN_REASON_MINOR_NETWORKCARD = $00000009; + {$EXTERNALSYM SHTDN_REASON_MINOR_NETWORKCARD} + SHTDN_REASON_MINOR_POWER_SUPPLY = $0000000a; + {$EXTERNALSYM SHTDN_REASON_MINOR_POWER_SUPPLY} + SHTDN_REASON_MINOR_CORDUNPLUGGED = $0000000b; + {$EXTERNALSYM SHTDN_REASON_MINOR_CORDUNPLUGGED} + SHTDN_REASON_MINOR_ENVIRONMENT = $0000000c; + {$EXTERNALSYM SHTDN_REASON_MINOR_ENVIRONMENT} + SHTDN_REASON_MINOR_HARDWARE_DRIVER = $0000000d; + {$EXTERNALSYM SHTDN_REASON_MINOR_HARDWARE_DRIVER} + SHTDN_REASON_MINOR_OTHERDRIVER = $0000000e; + {$EXTERNALSYM SHTDN_REASON_MINOR_OTHERDRIVER} + SHTDN_REASON_MINOR_BLUESCREEN = $0000000F; + {$EXTERNALSYM SHTDN_REASON_MINOR_BLUESCREEN} + SHTDN_REASON_MINOR_SERVICEPACK = $00000010; + {$EXTERNALSYM SHTDN_REASON_MINOR_SERVICEPACK} + SHTDN_REASON_MINOR_HOTFIX = $00000011; + {$EXTERNALSYM SHTDN_REASON_MINOR_HOTFIX} + SHTDN_REASON_MINOR_SECURITYFIX = $00000012; + {$EXTERNALSYM SHTDN_REASON_MINOR_SECURITYFIX} + SHTDN_REASON_MINOR_SECURITY = $00000013; + {$EXTERNALSYM SHTDN_REASON_MINOR_SECURITY} + SHTDN_REASON_MINOR_NETWORK_CONNECTIVITY = $00000014; + {$EXTERNALSYM SHTDN_REASON_MINOR_NETWORK_CONNECTIVITY} + SHTDN_REASON_MINOR_WMI = $00000015; + {$EXTERNALSYM SHTDN_REASON_MINOR_WMI} + SHTDN_REASON_MINOR_SERVICEPACK_UNINSTALL = $00000016; + {$EXTERNALSYM SHTDN_REASON_MINOR_SERVICEPACK_UNINSTALL} + SHTDN_REASON_MINOR_HOTFIX_UNINSTALL = $00000017; + {$EXTERNALSYM SHTDN_REASON_MINOR_HOTFIX_UNINSTALL} + SHTDN_REASON_MINOR_SECURITYFIX_UNINSTALL = $00000018; + {$EXTERNALSYM SHTDN_REASON_MINOR_SECURITYFIX_UNINSTALL} + SHTDN_REASON_MINOR_MMC = $00000019; + {$EXTERNALSYM SHTDN_REASON_MINOR_MMC} + SHTDN_REASON_MINOR_TERMSRV = $00000020; + {$EXTERNALSYM SHTDN_REASON_MINOR_TERMSRV} + SHTDN_REASON_MINOR_DC_PROMOTION = $00000021; + {$EXTERNALSYM SHTDN_REASON_MINOR_DC_PROMOTION} + SHTDN_REASON_MINOR_DC_DEMOTION = $00000022; + {$EXTERNALSYM SHTDN_REASON_MINOR_DC_DEMOTION} + + SHTDN_REASON_UNKNOWN = SHTDN_REASON_MINOR_NONE; + {$EXTERNALSYM SHTDN_REASON_UNKNOWN} + SHTDN_REASON_LEGACY_API = (SHTDN_REASON_MAJOR_LEGACY_API or SHTDN_REASON_FLAG_PLANNED); + {$EXTERNALSYM SHTDN_REASON_LEGACY_API} + +// This mask cuts out UI flags. + + SHTDN_REASON_VALID_BIT_MASK = DWORD($c0ffffff); + {$EXTERNALSYM SHTDN_REASON_VALID_BIT_MASK} + +// Convenience flags. + + PCLEANUI = (SHTDN_REASON_FLAG_PLANNED or SHTDN_REASON_FLAG_CLEAN_UI); + {$EXTERNALSYM PCLEANUI} + UCLEANUI = (SHTDN_REASON_FLAG_CLEAN_UI); + {$EXTERNALSYM UCLEANUI} + PDIRTYUI = (SHTDN_REASON_FLAG_PLANNED or SHTDN_REASON_FLAG_DIRTY_UI); + {$EXTERNALSYM PDIRTYUI} + UDIRTYUI = (SHTDN_REASON_FLAG_DIRTY_UI); + {$EXTERNALSYM UDIRTYUI} diff --git a/3rdParty/JCL/source/prototypes/win32api/ShlGuid.int b/3rdParty/JCL/source/prototypes/win32api/ShlGuid.int new file mode 100644 index 00000000..c0950cdd --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/ShlGuid.int @@ -0,0 +1,192 @@ +// shlguid.h line 404 + +const + FMTID_ShellDetails: TGUID = '{28636aa6-953d-11d2-b5d6-00c04fd918d0}'; + {$EXTERNALSYM FMTID_ShellDetails} + + PID_FINDDATA = 0; + {$EXTERNALSYM PID_FINDDATA} + PID_NETRESOURCE = 1; + {$EXTERNALSYM PID_NETRESOURCE} + PID_DESCRIPTIONID = 2; + {$EXTERNALSYM PID_DESCRIPTIONID} + PID_WHICHFOLDER = 3; + {$EXTERNALSYM PID_WHICHFOLDER} + PID_NETWORKLOCATION = 4; + {$EXTERNALSYM PID_NETWORKLOCATION} + PID_COMPUTERNAME = 5; + {$EXTERNALSYM PID_COMPUTERNAME} + +// PSGUID_STORAGE comes from ntquery.h +const + FMTID_Storage: TGUID = '{b725f130-47ef-101a-a5f1-02608c9eebac}'; + {$EXTERNALSYM FMTID_Storage} + +// Image properties +const + FMTID_ImageProperties: TGUID = '{14b81da1-0135-4d31-96d9-6cbfc9671a99}'; + {$EXTERNALSYM FMTID_ImageProperties} + +// The GUIDs used to identify shell item attributes (columns). See IShellFolder2::GetDetailsEx implementations... + +const + FMTID_Displaced: TGUID = '{9B174B33-40FF-11d2-A27E-00C04FC30871}'; + {$EXTERNALSYM FMTID_Displaced} + PID_DISPLACED_FROM = 2; + {$EXTERNALSYM PID_DISPLACED_FROM} + PID_DISPLACED_DATE = 3; + {$EXTERNALSYM PID_DISPLACED_DATE} + +const + FMTID_Briefcase: TGUID = '{328D8B21-7729-4bfc-954C-902B329D56B0}'; + {$EXTERNALSYM FMTID_Briefcase} + PID_SYNC_COPY_IN = 2; + {$EXTERNALSYM PID_SYNC_COPY_IN} + +const + FMTID_Misc: TGUID = '{9B174B34-40FF-11d2-A27E-00C04FC30871}'; + {$EXTERNALSYM FMTID_Misc} + PID_MISC_STATUS = 2; + {$EXTERNALSYM PID_MISC_STATUS} + PID_MISC_ACCESSCOUNT = 3; + {$EXTERNALSYM PID_MISC_ACCESSCOUNT} + PID_MISC_OWNER = 4; + {$EXTERNALSYM PID_MISC_OWNER} + PID_HTMLINFOTIPFILE = 5; + {$EXTERNALSYM PID_HTMLINFOTIPFILE} + PID_MISC_PICS = 6; + {$EXTERNALSYM PID_MISC_PICS} + +const + FMTID_WebView: TGUID = '{F2275480-F782-4291-BD94-F13693513AEC}'; + {$EXTERNALSYM FMTID_WebView} + PID_DISPLAY_PROPERTIES = 0; + {$EXTERNALSYM PID_DISPLAY_PROPERTIES} + PID_INTROTEXT = 1; + {$EXTERNALSYM PID_INTROTEXT} + +const + FMTID_MUSIC: TGUID = '{56A3372E-CE9C-11d2-9F0E-006097C686F6}'; + {$EXTERNALSYM FMTID_MUSIC} + PIDSI_ARTIST = 2; + {$EXTERNALSYM PIDSI_ARTIST} + PIDSI_SONGTITLE = 3; + {$EXTERNALSYM PIDSI_SONGTITLE} + PIDSI_ALBUM = 4; + {$EXTERNALSYM PIDSI_ALBUM} + PIDSI_YEAR = 5; + {$EXTERNALSYM PIDSI_YEAR} + PIDSI_COMMENT = 6; + {$EXTERNALSYM PIDSI_COMMENT} + PIDSI_TRACK = 7; + {$EXTERNALSYM PIDSI_TRACK} + PIDSI_GENRE = 11; + {$EXTERNALSYM PIDSI_GENRE} + PIDSI_LYRICS = 12; + {$EXTERNALSYM PIDSI_LYRICS} + +const + FMTID_DRM: TGUID = '{AEAC19E4-89AE-4508-B9B7-BB867ABEE2ED}'; + {$EXTERNALSYM FMTID_DRM} + PIDDRSI_PROTECTED = 2; + {$EXTERNALSYM PIDDRSI_PROTECTED} + PIDDRSI_DESCRIPTION = 3; + {$EXTERNALSYM PIDDRSI_DESCRIPTION} + PIDDRSI_PLAYCOUNT = 4; + {$EXTERNALSYM PIDDRSI_PLAYCOUNT} + PIDDRSI_PLAYSTARTS = 5; + {$EXTERNALSYM PIDDRSI_PLAYSTARTS} + PIDDRSI_PLAYEXPIRES = 6; + {$EXTERNALSYM PIDDRSI_PLAYEXPIRES} + +// FMTID_VideoSummaryInformation property identifiers +const + FMTID_Video: TGUID = '{64440491-4c8b-11d1-8b70-080036b11a03}'; + {$EXTERNALSYM FMTID_Video} + PIDVSI_STREAM_NAME = $00000002; // "StreamName", VT_LPWSTR + {$EXTERNALSYM PIDVSI_STREAM_NAME} + PIDVSI_FRAME_WIDTH = $00000003; // "FrameWidth", VT_UI4 + {$EXTERNALSYM PIDVSI_FRAME_WIDTH} + PIDVSI_FRAME_HEIGHT = $00000004; // "FrameHeight", VT_UI4 + {$EXTERNALSYM PIDVSI_FRAME_HEIGHT} + PIDVSI_TIMELENGTH = $00000007; // "TimeLength", VT_UI4, milliseconds + {$EXTERNALSYM PIDVSI_TIMELENGTH} + PIDVSI_FRAME_COUNT = $00000005; // "FrameCount". VT_UI4 + {$EXTERNALSYM PIDVSI_FRAME_COUNT} + PIDVSI_FRAME_RATE = $00000006; // "FrameRate", VT_UI4, frames/millisecond + {$EXTERNALSYM PIDVSI_FRAME_RATE} + PIDVSI_DATA_RATE = $00000008; // "DataRate", VT_UI4, bytes/second + {$EXTERNALSYM PIDVSI_DATA_RATE} + PIDVSI_SAMPLE_SIZE = $00000009; // "SampleSize", VT_UI4 + {$EXTERNALSYM PIDVSI_SAMPLE_SIZE} + PIDVSI_COMPRESSION = $0000000A; // "Compression", VT_LPWSTR + {$EXTERNALSYM PIDVSI_COMPRESSION} + PIDVSI_STREAM_NUMBER = $0000000B; // "StreamNumber", VT_UI2 + {$EXTERNALSYM PIDVSI_STREAM_NUMBER} + +// FMTID_AudioSummaryInformation property identifiers +const + FMTID_Audio: TGUID = '{64440490-4c8b-11d1-8b70-080036b11a03}'; + {$EXTERNALSYM FMTID_Audio} + PIDASI_FORMAT = $00000002; // VT_BSTR + {$EXTERNALSYM PIDASI_FORMAT} + PIDASI_TIMELENGTH = $00000003; // VT_UI4, milliseconds + {$EXTERNALSYM PIDASI_TIMELENGTH} + PIDASI_AVG_DATA_RATE = $00000004; // VT_UI4, Hz + {$EXTERNALSYM PIDASI_AVG_DATA_RATE} + PIDASI_SAMPLE_RATE = $00000005; // VT_UI4, bits + {$EXTERNALSYM PIDASI_SAMPLE_RATE} + PIDASI_SAMPLE_SIZE = $00000006; // VT_UI4, bits + {$EXTERNALSYM PIDASI_SAMPLE_SIZE} + PIDASI_CHANNEL_COUNT = $00000007; // VT_UI4 + {$EXTERNALSYM PIDASI_CHANNEL_COUNT} + PIDASI_STREAM_NUMBER = $00000008; // VT_UI2 + {$EXTERNALSYM PIDASI_STREAM_NUMBER} + PIDASI_STREAM_NAME = $00000009; // VT_LPWSTR + {$EXTERNALSYM PIDASI_STREAM_NAME} + PIDASI_COMPRESSION = $0000000A; // VT_LPWSTR + {$EXTERNALSYM PIDASI_COMPRESSION} + +const + FMTID_ControlPanel: TGUID = '{305CA226-D286-468e-B848-2B2E8E697B74}'; + {$EXTERNALSYM FMTID_ControlPanel} + PID_CONTROLPANEL_CATEGORY = 2; + {$EXTERNALSYM PID_CONTROLPANEL_CATEGORY} + +const + FMTID_Volume: TGUID = '{9B174B35-40FF-11d2-A27E-00C04FC30871}'; + {$EXTERNALSYM FMTID_Volume} + PID_VOLUME_FREE = 2; + {$EXTERNALSYM PID_VOLUME_FREE} + PID_VOLUME_CAPACITY = 3; + {$EXTERNALSYM PID_VOLUME_CAPACITY} + PID_VOLUME_FILESYSTEM = 4; + {$EXTERNALSYM PID_VOLUME_FILESYSTEM} + +const + FMTID_Share: TGUID = '{D8C3986F-813B-449c-845D-87B95D674ADE}'; + {$EXTERNALSYM FMTID_Share} + PID_SHARE_CSC_STATUS = 2; + {$EXTERNALSYM PID_SHARE_CSC_STATUS} + +const + FMTID_Link: TGUID = '{B9B4B3FC-2B51-4a42-B5D8-324146AFCF25}'; + {$EXTERNALSYM FMTID_Link} + PID_LINK_TARGET = 2; + {$EXTERNALSYM PID_LINK_TARGET} + +const + FMTID_Query: TGUID = '{49691c90-7e17-101a-a91c-08002b2ecda9}'; + {$EXTERNALSYM FMTID_Query} + PID_QUERY_RANK = 2; + {$EXTERNALSYM PID_QUERY_RANK} + +const + FMTID_SummaryInformation: TGUID = '{f29f85e0-4ff9-1068-ab91-08002b27b3d9}'; + {$EXTERNALSYM FMTID_SummaryInformation} + FMTID_DocumentSummaryInformation: TGUID = '{d5cdd502-2e9c-101b-9397-08002b2cf9ae}'; + {$EXTERNALSYM FMTID_DocumentSummaryInformation} + FMTID_MediaFileSummaryInformation: TGUID = '{64440492-4c8b-11d1-8b70-080036b11a03}'; + {$EXTERNALSYM FMTID_MediaFileSummaryInformation} + FMTID_ImageSummaryInformation: TGUID = '{6444048f-4c8b-11d1-8b70-080036b11a03}'; + {$EXTERNALSYM FMTID_ImageSummaryInformation} diff --git a/3rdParty/JCL/source/prototypes/win32api/ShlObj.int b/3rdParty/JCL/source/prototypes/win32api/ShlObj.int new file mode 100644 index 00000000..03334e56 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/ShlObj.int @@ -0,0 +1,174 @@ + +const + CSIDL_LOCAL_APPDATA = $001C; { \Local Settings\Application Data (non roaming) } + CSIDL_COMMON_APPDATA = $0023; { All Users\Application Data } + CSIDL_WINDOWS = $0024; { GetWindowsDirectory() } + CSIDL_SYSTEM = $0025; { GetSystemDirectory() } + CSIDL_PROGRAM_FILES = $0026; { C:\Program Files } + CSIDL_MYPICTURES = $0027; { C:\Program Files\My Pictures } + CSIDL_PROFILE = $0028; { USERPROFILE } + CSIDL_PROGRAM_FILESX86 = $002A; { C:\Program Files (x86)\My Pictures } + CSIDL_PROGRAM_FILES_COMMON = $002B; { C:\Program Files\Common } + CSIDL_COMMON_TEMPLATES = $002D; { All Users\Templates } + CSIDL_COMMON_DOCUMENTS = $002E; { All Users\Documents } + CSIDL_COMMON_ADMINTOOLS = $002F; { All Users\Start Menu\Programs\Administrative Tools } + CSIDL_ADMINTOOLS = $0030; { \Start Menu\Programs\Administrative Tools } + CSIDL_CONNECTIONS = $0031; { Network and Dial-up Connections } + CSIDL_COMMON_MUSIC = $0035; { All Users\My Music } + CSIDL_COMMON_PICTURES = $0036; { All Users\My Pictures } + CSIDL_COMMON_VIDEO = $0037; { All Users\My Video } + CSIDL_RESOURCES = $0038; { Resource Direcotry } + CSIDL_RESOURCES_LOCALIZED = $0039; { Localized Resource Direcotry } + CSIDL_COMMON_OEM_LINKS = $003A; { Links to All Users OEM specific apps } + CSIDL_CDBURN_AREA = $003B; { USERPROFILE\Local Settings\Application Data\Microsoft\CD Burning } + CSIDL_COMPUTERSNEARME = $003D; { Computers Near Me (computered from Workgroup membership) } + + {$EXTERNALSYM CSIDL_LOCAL_APPDATA} + {$EXTERNALSYM CSIDL_COMMON_APPDATA} + {$EXTERNALSYM CSIDL_WINDOWS} + {$EXTERNALSYM CSIDL_SYSTEM} + {$EXTERNALSYM CSIDL_PROGRAM_FILES} + {$EXTERNALSYM CSIDL_MYPICTURES} + {$EXTERNALSYM CSIDL_PROFILE} + {$EXTERNALSYM CSIDL_PROGRAM_FILES_COMMON} + {$EXTERNALSYM CSIDL_COMMON_TEMPLATES} + {$EXTERNALSYM CSIDL_COMMON_DOCUMENTS} + {$EXTERNALSYM CSIDL_COMMON_ADMINTOOLS} + {$EXTERNALSYM CSIDL_ADMINTOOLS} + {$EXTERNALSYM CSIDL_CONNECTIONS} + {$EXTERNALSYM CSIDL_COMMON_MUSIC} + {$EXTERNALSYM CSIDL_COMMON_PICTURES} + {$EXTERNALSYM CSIDL_COMMON_VIDEO} + {$EXTERNALSYM CSIDL_RESOURCES} + {$EXTERNALSYM CSIDL_RESOURCES_LOCALIZED} + {$EXTERNALSYM CSIDL_COMMON_OEM_LINKS} + {$EXTERNALSYM CSIDL_CDBURN_AREA} + {$EXTERNALSYM CSIDL_COMPUTERSNEARME} + +type + ITaskbarList = interface(IUnknown) + ['{56FDF342-FD6D-11D0-958A-006097C9A090}'] + function HrInit: HRESULT; stdcall; + function AddTab(hwnd: HWND): HRESULT; stdcall; + function DeleteTab(hwnd: HWND): HRESULT; stdcall; + function ActivateTab(hwnd: HWND): HRESULT; stdcall; + function SetActiveAlt(hwnd: HWND): HRESULT; stdcall; + end; + {$EXTERNALSYM ITaskbarList} + + ITaskbarList2 = interface(ITaskbarList) + ['{602D4995-B13A-429B-A66E-1935E44F4317}'] + function MarkFullscreenWindow(hwnd: HWND; fFullscreen: BOOL): HRESULT; stdcall; + end; + {$EXTERNALSYM ITaskbarList2} + +type + THUMBBUTTON = record + dwMask: DWORD; + iId: UINT; + iBitmap: UINT; + hIcon: HICON; + szTip: packed array[0..259] of WCHAR; + dwFlags: DWORD; + end; + {$EXTERNALSYM THUMBBUTTON} + tagTHUMBBUTTON = THUMBBUTTON; + {$EXTERNALSYM tagTHUMBBUTTON} + TThumbButton = THUMBBUTTON; + {$EXTERNALSYM TThumbButton} + PThumbButton = ^TThumbButton; + {$EXTERNALSYM PThumbButton} + +// for ThumbButtons.dwFlags +const + THBF_ENABLED = $0000; + {$EXTERNALSYM THBF_ENABLED} + THBF_DISABLED = $0001; + {$EXTERNALSYM THBF_DISABLED} + THBF_DISMISSONCLICK = $0002; + {$EXTERNALSYM THBF_DISMISSONCLICK} + THBF_NOBACKGROUND = $0004; + {$EXTERNALSYM THBF_NOBACKGROUND} + THBF_HIDDEN = $0008; + {$EXTERNALSYM THBF_HIDDEN} + THBF_NONINTERACTIVE = $0010; + {$EXTERNALSYM THBF_NONINTERACTIVE} + +// for ThumbButton.dwMask +const + THB_BITMAP = $0001; + {$EXTERNALSYM THB_BITMAP} + THB_ICON = $0002; + {$EXTERNALSYM THB_ICON} + THB_TOOLTIP = $0004; + {$EXTERNALSYM THB_TOOLTIP} + THB_FLAGS = $0008; + {$EXTERNALSYM THB_FLAGS} + +// wParam for WM_COMMAND message (lParam = Button ID) +const + THBN_CLICKED = $1800; + {$EXTERNALSYM THBN_CLICKED} + +// for ITaskBarList3.SetProgressState +const + TBPF_NOPROGRESS = 0; + {$EXTERNALSYM TBPF_NOPROGRESS} + TBPF_INDETERMINATE = $1; + {$EXTERNALSYM TBPF_INDETERMINATE} + TBPF_NORMAL = $2; + {$EXTERNALSYM TBPF_NORMAL} + TBPF_ERROR = $4; + {$EXTERNALSYM TBPF_ERROR} + TBPF_PAUSED = $8; + {$EXTERNALSYM TBPF_PAUSED} + +type + ITaskbarList3 = interface(ITaskbarList2) + ['{EA1AFB91-9E28-4B86-90E9-9E9F8A5EEFAF}'] + function SetProgressValue(hwnd: HWND; ullCompleted: ULONGLONG; + ullTotal: ULONGLONG): HRESULT; stdcall; + function SetProgressState(hwnd: HWND; tbpFlags: Integer): HRESULT; stdcall; + function RegisterTab(hwndTab: HWND; hwndMDI: HWND): HRESULT; stdcall; + function UnregisterTab(hwndTab: HWND): HRESULT; stdcall; + function SetTabOrder(hwndTab: HWND; hwndInsertBefore: HWND): HRESULT; stdcall; + function SetTabActive(hwndTab: HWND; hwndMDI: HWND; + tbatFlags: Integer): HRESULT; stdcall; + function ThumbBarAddButtons(hwnd: HWND; cButtons: UINT; + pButton: PThumbButton): HRESULT; stdcall; + function ThumbBarUpdateButtons(hwnd: HWND; cButtons: UINT; + pButton: PThumbButton): HRESULT; stdcall; + function ThumbBarSetImageList(hwnd: HWND; himl: THandle): HRESULT; stdcall; + function SetOverlayIcon(hwnd: HWND; hIcon: HICON; + pszDescription: LPCWSTR): HRESULT; stdcall; + function SetThumbnailTooltip(hwnd: HWND; pszTip: LPCWSTR): HRESULT; stdcall; + function SetThumbnailClip(hwnd: HWND; var prcClip: TRect): HRESULT; stdcall; + end; + {$EXTERNALSYM ITaskbarList3} + +type + STPFLAG = Integer; + {$EXTERNALSYM STPFLAG} +const + STPF_NONE = 0; + {$EXTERNALSYM STPF_NONE} + STPF_USEAPPTHUMBNAILALWAYS = $1; + {$EXTERNALSYM STPF_USEAPPTHUMBNAILALWAYS} + STPF_USEAPPTHUMBNAILWHENACTIVE = $2; + {$EXTERNALSYM STPF_USEAPPTHUMBNAILWHENACTIVE} + STPF_USEAPPPEEKALWAYS = $4; + {$EXTERNALSYM STPF_USEAPPPEEKALWAYS} + STPF_USEAPPPEEKWHENACTIVE = $8; + {$EXTERNALSYM STPF_USEAPPPEEKWHENACTIVE} + +type + ITaskbarList4 = interface(ITaskbarList3) + ['{C43DC798-95D1-4BEA-9030-BB99E2983A1A}'] + function SetTabProperties(hwndTab: HWND; stpFlags: STPFLAG): HRESULT; stdcall; + end; + {$EXTERNALSYM ITaskbarList4} + +const + CLSID_TaskbarList: TGUID = '{56FDF344-FD6D-11d0-958A-006097C9A090}'; + {$EXTERNALSYM CLSID_TaskbarList} + diff --git a/3rdParty/JCL/source/prototypes/win32api/ShlWApi.int b/3rdParty/JCL/source/prototypes/win32api/ShlWApi.int new file mode 100644 index 00000000..d2f715e7 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/ShlWApi.int @@ -0,0 +1,22 @@ +{ TODO BCB-compatibility} + +const + DLLVER_PLATFORM_WINDOWS = $00000001; + {$EXTERNALSYM DLLVER_PLATFORM_WINDOWS} + DLLVER_PLATFORM_NT = $00000002; + {$EXTERNALSYM DLLVER_PLATFORM_NT} + +type + PDllVersionInfo = ^TDllVersionInfo; + _DLLVERSIONINFO = packed record + cbSize: DWORD; + dwMajorVersion: DWORD; + dwMinorVersion: DWORD; + dwBuildNumber: DWORD; + dwPlatformId: DWORD; + end; + {$EXTERNALSYM _DLLVERSIONINFO} + TDllVersionInfo = _DLLVERSIONINFO; + DLLVERSIONINFO = _DLLVERSIONINFO; + {$EXTERNALSYM DLLVERSIONINFO} + diff --git a/3rdParty/JCL/source/prototypes/win32api/TlHelp32.imp b/3rdParty/JCL/source/prototypes/win32api/TlHelp32.imp new file mode 100644 index 00000000..c114efa1 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/TlHelp32.imp @@ -0,0 +1,39 @@ +{$IFDEF MSWINDOWS} + +type + TCreateToolhelp32Snapshot = function (dwFlags, th32ProcessID: DWORD): THandle; stdcall; + +var + _CreateToolhelp32Snapshot: TCreateToolhelp32Snapshot = nil; + +function CreateToolhelp32Snapshot(dwFlags, th32ProcessID: DWORD): THandle; +begin + GetProcedureAddress(Pointer(@_CreateToolhelp32Snapshot), kernel32, 'CreateToolhelp32Snapshot'); + Result := _CreateToolhelp32Snapshot(dwFlags, th32ProcessID); +end; + +type + TThread32First = function (hSnapshot: THandle; var lpte: THREADENTRY32): BOOL; stdcall; + +var + _Thread32First: TThread32First = nil; + +function Thread32First(hSnapshot: THandle; var lpte: THREADENTRY32): BOOL; +begin + GetProcedureAddress(Pointer(@_Thread32First), kernel32, 'Thread32First'); + Result := _Thread32First(hSnapshot, lpte); +end; + +type + TThread32Next = function (hSnapshot: THandle; var lpte: THREADENTRY32): BOOL; stdcall; + +var + _Thread32Next: TThread32Next = nil; + +function Thread32Next(hSnapshot: THandle; var lpte: THREADENTRY32): BOOL; +begin + GetProcedureAddress(Pointer(@_Thread32Next), kernel32, 'Thread32Next'); + Result := _Thread32Next(hSnapshot, lpte); +end; + +{$ENDIF MSWINDOWS} diff --git a/3rdParty/JCL/source/prototypes/win32api/TlHelp32.int b/3rdParty/JCL/source/prototypes/win32api/TlHelp32.int new file mode 100644 index 00000000..74d7d466 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/TlHelp32.int @@ -0,0 +1,71 @@ +{$IFDEF MSWINDOWS} + +// Snapshot function + +function CreateToolhelp32Snapshot(dwFlags, th32ProcessID: DWORD): THandle; stdcall; +{$EXTERNALSYM CreateToolhelp32Snapshot} + +// +// The th32ProcessID argument is only used if TH32CS_SNAPHEAPLIST or +// TH32CS_SNAPMODULE is specified. th32ProcessID == 0 means the current +// process. +// +// NOTE that all of the snapshots are global except for the heap and module +// lists which are process specific. To enumerate the heap or module +// state for all WIN32 processes call with TH32CS_SNAPALL and the +// current process. Then for each process in the TH32CS_SNAPPROCESS +// list that isn't the current process, do a call with just +// TH32CS_SNAPHEAPLIST and/or TH32CS_SNAPMODULE. +// +// dwFlags +// + +const + TH32CS_SNAPHEAPLIST = $00000001; + {$EXTERNALSYM TH32CS_SNAPHEAPLIST} + TH32CS_SNAPPROCESS = $00000002; + {$EXTERNALSYM TH32CS_SNAPPROCESS} + TH32CS_SNAPTHREAD = $00000004; + {$EXTERNALSYM TH32CS_SNAPTHREAD} + TH32CS_SNAPMODULE = $00000008; + {$EXTERNALSYM TH32CS_SNAPMODULE} + TH32CS_SNAPMODULE32 = $00000010; + {$EXTERNALSYM TH32CS_SNAPMODULE32} + TH32CS_SNAPALL = TH32CS_SNAPHEAPLIST or TH32CS_SNAPPROCESS or + TH32CS_SNAPTHREAD or TH32CS_SNAPMODULE; + {$EXTERNALSYM TH32CS_SNAPALL} + TH32CS_INHERIT = $80000000; + {$EXTERNALSYM TH32CS_INHERIT} + +// +// Use CloseHandle to destroy the snapshot +// + +// Thread walking + +type + PTHREADENTRY32 = ^THREADENTRY32; + {$EXTERNALSYM PTHREADENTRY32} + tagTHREADENTRY32 = record + dwSize: DWORD; + cntUsage: DWORD; + th32ThreadID: DWORD; // this thread + th32OwnerProcessID: DWORD; // Process this thread is associated with + tpBasePri: Longint; + tpDeltaPri: Longint; + dwFlags: DWORD; + end; + {$EXTERNALSYM tagTHREADENTRY32} + THREADENTRY32 = tagTHREADENTRY32; + {$EXTERNALSYM THREADENTRY32} + LPTHREADENTRY32 = ^THREADENTRY32; + {$EXTERNALSYM LPTHREADENTRY32} + TThreadEntry32 = THREADENTRY32; + {$EXTERNALSYM TThreadEntry32} + +function Thread32First(hSnapshot: THandle; var lpte: THREADENTRY32): BOOL; stdcall; +{$EXTERNALSYM Thread32First} +function Thread32Next(hSnapshot: THandle; var lpte: THREADENTRY32): BOOL; stdcall; +{$EXTERNALSYM Thread32Next} + +{$ENDIF MSWINDOWS} diff --git a/3rdParty/JCL/source/prototypes/win32api/WinBase.imp b/3rdParty/JCL/source/prototypes/win32api/WinBase.imp new file mode 100644 index 00000000..0accafb3 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/WinBase.imp @@ -0,0 +1,309 @@ +{$IFDEF MSWINDOWS} + +type + TGlobalMemoryStatusEx = function (out lpBuffer: TMemoryStatusEx): BOOL; stdcall; + +var + _GlobalMemoryStatusEx: TGlobalMemoryStatusEx = nil; + +function GlobalMemoryStatusEx(out lpBuffer: TMemoryStatusEx): BOOL; stdcall; +begin + GetProcedureAddress(Pointer(@_GlobalMemoryStatusEx), kernel32, 'GlobalMemoryStatusEx'); + Result := _GlobalMemoryStatusEx(lpBuffer); +end; + +type + TBackupSeek = function (hFile: THandle; dwLowBytesToSeek, dwHighBytesToSeek: DWORD; + out lpdwLowByteSeeked, lpdwHighByteSeeked: DWORD; + var lpContext: Pointer): BOOL; stdcall; + +var + _BackupSeek: TBackupSeek = nil; + +function BackupSeek(hFile: THandle; dwLowBytesToSeek, dwHighBytesToSeek: DWORD; + out lpdwLowByteSeeked, lpdwHighByteSeeked: DWORD; + var lpContext: Pointer): BOOL; +begin + GetProcedureAddress(Pointer(@_BackupSeek), kernel32, 'BackupSeek'); + Result := _BackupSeek(hFile, dwLowBytesToSeek, dwHighBytesToSeek, lpdwLowByteSeeked, lpdwHighByteSeeked, lpContext); +end; + +type + TAdjustTokenPrivileges = function (TokenHandle: THandle; DisableAllPrivileges: BOOL; + const NewState: TTokenPrivileges; BufferLength: DWORD; + PreviousState: PTokenPrivileges; + ReturnLength: PDWORD + ): BOOL; stdcall; + +var + _AdjustTokenPrivileges: TAdjustTokenPrivileges = nil; + +function AdjustTokenPrivileges(TokenHandle: THandle; DisableAllPrivileges: BOOL; + const NewState: TTokenPrivileges; BufferLength: DWORD; + PreviousState: PTokenPrivileges; + ReturnLength: PDWORD + ): BOOL; +begin + GetProcedureAddress(Pointer(@_AdjustTokenPrivileges), advapi32, 'AdjustTokenPrivileges'); + Result := _AdjustTokenPrivileges(TokenHandle, DisableAllPrivileges, NewState, BufferLength, PreviousState, ReturnLength); +end; + +function CreateMutex(lpMutexAttributes: PSecurityAttributes; bInitialOwner: DWORD; lpName: PChar): THandle; stdcall; + external kernel32 name 'CreateMutex' + AWSuffix; + +function GetVersionEx(var lpVersionInformation: TOSVersionInfoEx): BOOL; stdcall; + external kernel32 name 'GetVersionEx' + AWSuffix; +function GetVersionEx(lpVersionInformation: POSVersionInfoEx): BOOL; stdcall; + external kernel32 name 'GetVersionEx' + AWSuffix; + +type + TSetWaitableTimer = function (hTimer: THandle; var lpDueTime: TLargeInteger; + lPeriod: Longint; pfnCompletionRoutine: TFNTimerAPCRoutine; + lpArgToCompletionRoutine: Pointer; fResume: BOOL): BOOL; stdcall; + +var + _SetWaitableTimer: TSetWaitableTimer = nil; + +function SetWaitableTimer(hTimer: THandle; var lpDueTime: TLargeInteger; + lPeriod: Longint; pfnCompletionRoutine: TFNTimerAPCRoutine; + lpArgToCompletionRoutine: Pointer; fResume: BOOL): BOOL; +begin + GetProcedureAddress(Pointer(@_SetWaitableTimer), kernel32, 'SetWaitableTimer'); + Result := _SetWaitableTimer(hTimer, lpDueTime, lPeriod, pfnCompletionRoutine, lpArgToCompletionRoutine, fResume); +end; + +type + TSetFileSecurityA = function (lpFileName: LPCSTR; SecurityInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; stdcall; +var + _SetFileSecurityA: TSetFileSecurityA = nil; + +function SetFileSecurityA(lpFileName: LPCSTR; SecurityInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; +begin + GetProcedureAddress(Pointer(@_SetFileSecurityA), advapi32, 'SetFileSecurityA'); + Result := _SetFileSecurityA(lpFileName, SecurityInformation, pSecurityDescriptor); +end; + +type + TSetFileSecurityW = function (lpFileName: LPCWSTR; SecurityInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; stdcall; + +var + _SetFileSecurityW: TSetFileSecurityW = nil; + +function SetFileSecurityW(lpFileName: LPCWSTR; SecurityInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; +begin + GetProcedureAddress(Pointer(@_SetFileSecurityW), advapi32, 'SetFileSecurityW'); + Result := _SetFileSecurityW(lpFileName, SecurityInformation, pSecurityDescriptor); +end; + +type + TSetFileSecurity = function (lpFileName: LPCTSTR; SecurityInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; stdcall; + +var + _SetFileSecurity: TSetFileSecurity = nil; + +function SetFileSecurity(lpFileName: LPCTSTR; SecurityInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; +begin + GetProcedureAddress(Pointer(@_SetFileSecurity), advapi32, 'SetFileSecurity' + AWSuffix); + Result := _SetFileSecurity(lpFileName, SecurityInformation, pSecurityDescriptor); +end; + +type + TGetFileSecurityA = function (lpFileName: LPCSTR; RequestedInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; + var lpnLengthNeeded: DWORD): BOOL; stdcall; + +var + _GetFileSecurityA: TGetFileSecurityA = nil; + +function GetFileSecurityA(lpFileName: LPCSTR; RequestedInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; + var lpnLengthNeeded: DWORD): BOOL; +begin + GetProcedureAddress(Pointer(@_GetFileSecurityA), advapi32, 'GetFileSecurityA'); + Result := _GetFileSecurityA(lpFileName, RequestedInformation, pSecurityDescriptor, nLength, lpnLengthNeeded); +end; + +type + TGetFileSecurityW = function (lpFileName: LPCWSTR; RequestedInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; + var lpnLengthNeeded: DWORD): BOOL; stdcall; + +var + _GetFileSecurityW: TGetFileSecurityW = nil; + +function GetFileSecurityW(lpFileName: LPCWSTR; RequestedInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; + var lpnLengthNeeded: DWORD): BOOL; +begin + GetProcedureAddress(Pointer(@_GetFileSecurityW), advapi32, 'GetFileSecurityW'); + Result := _GetFileSecurityW(lpFileName, RequestedInformation, pSecurityDescriptor, nLength, lpnLengthNeeded); +end; + +type + TGetFileSecurity = function (lpFileName: LPCTSTR; RequestedInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; + var lpnLengthNeeded: DWORD): BOOL; stdcall; + +var + _GetFileSecurity: TGetFileSecurity = nil; + +function GetFileSecurity(lpFileName: LPCTSTR; RequestedInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; + var lpnLengthNeeded: DWORD): BOOL; +begin + GetProcedureAddress(Pointer(@_GetFileSecurity), advapi32, 'GetFileSecurity' + AWSuffix); + Result := _GetFileSecurity(lpFileName, RequestedInformation, pSecurityDescriptor, nLength, lpnLengthNeeded); +end; + +type + TSetVolumeMountPointW = function (lpszVolumeMountPoint, lpszVolumeName: LPCWSTR): BOOL; stdcall; + +var + _SetVolumeMountPointW: TSetVolumeMountPointW = nil; + +function SetVolumeMountPointW(lpszVolumeMountPoint, lpszVolumeName: LPCWSTR): BOOL; +begin + GetProcedureAddress(Pointer(@_SetVolumeMountPointW), kernel32, 'SetVolumeMountPointW'); + Result := _SetVolumeMountPointW(lpszVolumeMountPoint, lpszVolumeName); +end; + +type + TDeleteVolumeMountPointW = function (lpszVolumeMountPoint: LPCWSTR): BOOL; stdcall; + +var + _DeleteVolumeMountPointW: TDeleteVolumeMountPointW = nil; + +function DeleteVolumeMountPointW(lpszVolumeMountPoint: LPCWSTR): BOOL; +begin + GetProcedureAddress(Pointer(@_DeleteVolumeMountPointW), kernel32, 'DeleteVolumeMountPointW'); + Result := _DeleteVolumeMountPointW(lpszVolumeMountPoint); +end; + +type + TGetVolumeNameForVolumeMountPointW = function (lpszVolumeMountPoint: LPCWSTR; + lpszVolumeName: LPWSTR; cchBufferLength: DWORD): BOOL; stdcall; + +var + _GetVolumeNameForVolMountPointW: TGetVolumeNameForVolumeMountPointW = nil; + +function GetVolumeNameForVolumeMountPointW(lpszVolumeMountPoint: LPCWSTR; + lpszVolumeName: LPWSTR; cchBufferLength: DWORD): BOOL; +begin + GetProcedureAddress(Pointer(@_GetVolumeNameForVolMountPointW), kernel32, 'GetVolumeNameForVolumeMountPointW'); + Result := _GetVolumeNameForVolMountPointW(lpszVolumeMountPoint, lpszVolumeName, cchBufferLength); +end; + +type + TCopyExtendedContext = function (Destination: PCONTEXT_EX; ContextFlags: DWORD; Source: PCONTEXT_EX): BOOL; stdcall; + +var + _CopyExtendedContext: TCopyExtendedContext = nil; + +function CopyExtendedContext(Destination: PCONTEXT_EX; ContextFlags: DWORD; Source: PCONTEXT_EX): BOOL; +begin + GetProcedureAddress(Pointer(@_CopyExtendedContext), kernel32, 'CopyExtendedContext'); + Result := _CopyExtendedContext(Destination, ContextFlags, Source); +end; + +type + TInitializeExtendedContext = function (Context: Pointer; ContextFlags: DWORD; out ContextEx: PCONTEXT_EX): BOOL; stdcall; + +var + _InitializeExtendedContext: TInitializeExtendedContext = nil; + +function InitializeExtendedContext(Context: Pointer; ContextFlags: DWORD; out ContextEx: PCONTEXT_EX): BOOL; +begin + GetProcedureAddress(Pointer(@_InitializeExtendedContext), kernel32, 'InitializeExtendedContext'); + Result := _InitializeExtendedContext(Context, ContextFlags, ContextEx); +end; + +type + TGetEnabledExtendedFeatures = function (const FeatureMask: Int64): Int64; stdcall; +var + _GetEnabledExtendedFeatures: TGetEnabledExtendedFeatures = nil; + +function GetEnabledExtendedFeatures(const FeatureMask: Int64): Int64; +begin + GetProcedureAddress(Pointer(@_GetEnabledExtendedFeatures), kernel32, 'GetEnabledExtendedFeatures'); + Result := _GetEnabledExtendedFeatures(FeatureMask); +end; + +type + TGetExtendedContextLength = function (ContextFlags: DWORD; ContextLength: PDWORD): BOOL; stdcall; + +var + _GetExtendedContextLength: TGetExtendedContextLength = nil; + +function GetExtendedContextLength(ContextFlags: DWORD; ContextLength: PDWORD): BOOL; +begin + GetProcedureAddress(Pointer(@_GetExtendedContextLength), kernel32, 'GetExtendedContextLength'); + Result := _GetExtendedContextLength(ContextFlags, ContextLength); +end; + +type + TGetExtendedFeaturesMask = function (ContextEx: PCONTEXT_EX): Int64; stdcall; + +var + _GetExtendedFeaturesMask: TGetExtendedFeaturesMask = nil; + +function GetExtendedFeaturesMask(ContextEx: PCONTEXT_EX): Int64; +begin + GetProcedureAddress(Pointer(@_GetExtendedFeaturesMask), kernel32, 'GetExtendedFeaturesMask'); + Result := _GetExtendedFeaturesMask(ContextEx); +end; + +type + TLocateExtendedFeature = function (ContextEx: PCONTEXT_EX; FeatureId: DWORD; Length: PDWORD): Pointer; stdcall; + +var + _LocateExtendedFeature: TLocateExtendedFeature = nil; + +function LocateExtendedFeature(ContextEx: PCONTEXT_EX; FeatureId: DWORD; Length: PDWORD): Pointer; +begin + GetProcedureAddress(Pointer(@_LocateExtendedFeature), kernel32, 'LocateExtendedFeature'); + Result := _LocateExtendedFeature(ContextEx, FeatureId, Length); +end; + +type + TLocateLegacyContext = function (ContextEx: PCONTEXT_EX; Length: PDWORD): PCONTEXT; stdcall; + +var + _LocateLegacyContext: TLocateLegacyContext = nil; + +function LocateLegacyContext(ContextEx: PCONTEXT_EX; Length: PDWORD): PCONTEXT; +begin + GetProcedureAddress(Pointer(@_LocateLegacyContext), kernel32, 'LocateLegacyContext'); + Result := _LocateLegacyContext(ContextEx, Length); +end; + +type + TSetExtendedFeaturesMask = procedure (ContextEx: PCONTEXT_EX; const FeatureMask: Int64); stdcall; + +var + _SetExtendedFeaturesMask: TSetExtendedFeaturesMask = nil; + +procedure SetExtendedFeaturesMask(ContextEx: PCONTEXT_EX; const FeatureMask: Int64); +begin + GetProcedureAddress(Pointer(@_SetExtendedFeaturesMask), kernel32, 'SetExtendedFeaturesMask'); + _SetExtendedFeaturesMask(ContextEx, FeatureMask); +end; + +type + TProcessIdToSessionId = function (dwProcessId: DWORD; out dwSessionId: DWORD): BOOL; stdcall; + +var + _ProcessIdToSessionId: TProcessIdToSessionId = nil; + +function ProcessIdToSessionId(dwProcessId: DWORD; out dwSessionId: DWORD): BOOL; +begin + GetProcedureAddress(Pointer(@_ProcessIdToSessionId), kernel32, 'ProcessIdToSessionId'); + Result := _ProcessIdToSessionId(dwProcessId, dwSessionId); +end; + +{$ENDIF MSWINDOWS} diff --git a/3rdParty/JCL/source/prototypes/win32api/WinBase.int b/3rdParty/JCL/source/prototypes/win32api/WinBase.int new file mode 100644 index 00000000..f5c281d5 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/WinBase.int @@ -0,0 +1,185 @@ +// line 160 + +// +// File creation flags must start at the high end since they +// are combined with the attributes +// + +const + FILE_FLAG_WRITE_THROUGH = DWORD($80000000); + {$EXTERNALSYM FILE_FLAG_WRITE_THROUGH} + FILE_FLAG_OVERLAPPED = $40000000; + {$EXTERNALSYM FILE_FLAG_OVERLAPPED} + FILE_FLAG_NO_BUFFERING = $20000000; + {$EXTERNALSYM FILE_FLAG_NO_BUFFERING} + FILE_FLAG_RANDOM_ACCESS = $10000000; + {$EXTERNALSYM FILE_FLAG_RANDOM_ACCESS} + FILE_FLAG_SEQUENTIAL_SCAN = $08000000; + {$EXTERNALSYM FILE_FLAG_SEQUENTIAL_SCAN} + FILE_FLAG_DELETE_ON_CLOSE = $04000000; + {$EXTERNALSYM FILE_FLAG_DELETE_ON_CLOSE} + FILE_FLAG_BACKUP_SEMANTICS = $02000000; + {$EXTERNALSYM FILE_FLAG_BACKUP_SEMANTICS} + FILE_FLAG_POSIX_SEMANTICS = $01000000; + {$EXTERNALSYM FILE_FLAG_POSIX_SEMANTICS} + FILE_FLAG_OPEN_REPARSE_POINT = $00200000; + {$EXTERNALSYM FILE_FLAG_OPEN_REPARSE_POINT} + FILE_FLAG_OPEN_NO_RECALL = $00100000; + {$EXTERNALSYM FILE_FLAG_OPEN_NO_RECALL} + FILE_FLAG_FIRST_PIPE_INSTANCE = $00080000; + {$EXTERNALSYM FILE_FLAG_FIRST_PIPE_INSTANCE} + +// line 2727 +type + _MEMORYSTATUSEX = packed record + dwLength: DWORD; + dwMemoryLoad: DWORD; + ullTotalPhys: Int64; + ullAvailPhys: Int64; + ullTotalPageFile: Int64; + ullAvailPageFile: Int64; + ullTotalVirtual: Int64; + ullAvailVirtual: Int64; + ullAvailExtendedVirtual: Int64; + end; + {$EXTERNALSYM _MEMORYSTATUSEX} + + MEMORYSTATUSEX = _MEMORYSTATUSEX; + {$EXTERNALSYM MEMORYSTATUSEX} + LPMEMORYSTATUSEX = ^_MEMORYSTATUSEX; + {$EXTERNALSYM LPMEMORYSTATUSEX} + + TMemoryStatusEx = _MEMORYSTATUSEX; + +function GlobalMemoryStatusEx(out lpBuffer: TMemoryStatusEx): BOOL; stdcall; + +// line 3189 + +{$IFDEF MSWINDOWS} + +function BackupSeek(hFile: THandle; dwLowBytesToSeek, dwHighBytesToSeek: DWORD; + out lpdwLowByteSeeked, lpdwHighByteSeeked: DWORD; + var lpContext: Pointer): BOOL; stdcall; +{$EXTERNALSYM BackupSeek} + +// line 5454 + +function AdjustTokenPrivileges(TokenHandle: THandle; DisableAllPrivileges: BOOL; + const NewState: TTokenPrivileges; BufferLength: DWORD; + PreviousState: PTokenPrivileges; + ReturnLength: PDWORD + ): BOOL; stdcall; +{$EXTERNALSYM AdjustTokenPrivileges} + +{ +From: Ray Lischner +Subject: CreateMutex bug +Date: 1999/12/10 +Message-ID: #1/1 +Content-Transfer-Encoding: 7bit +Organization: Tempest Software, Inc., Corvallis, Oregon +Content-Type: text/plain; charset=us-ascii +Mime-Version: 1.0 +Newsgroups: borland.public.delphi.winapi + + +Windows NT 4 has a bug in CreateMutex. The second argument is documented +to be a BOOL, but in truth, the CreateMutex interprets 1 as True and all +other values as False. (Do I detect an "if (bInitialOwner == TRUE)" in +the implementation of CreateMutex?) + +The problem is that Delphi declares CreateMutex according to the +documentation, so bInitialOwner is declared as LongBool. Delphi maps +True values to $FFFFFFFF, which should work, but doesn't in this case. + +My workaround is to declare CreateMutex with a LongInt as the second +argument, and pass the value 1 for True. + +I have not had this problem on Windows 98. +-- +Ray Lischner, author of Delphi in a Nutshell (coming later this year) +http://www.bardware.com and http://www.tempest-sw.com +} +function CreateMutex(lpMutexAttributes: PSecurityAttributes; bInitialOwner: DWORD; lpName: PChar): THandle; stdcall; +{$EXTERNALSYM CreateMutex} + +// alternative conversion for WinNT 4.0 SP6 and later (OSVersionInfoEx instead of OSVersionInfo) +{$EXTERNALSYM GetVersionEx} +function GetVersionEx(var lpVersionInformation: TOSVersionInfoEx): BOOL; stdcall; overload; +{$EXTERNALSYM GetVersionEx} +function GetVersionEx(lpVersionInformation: POSVERSIONINFOEX): BOOL; stdcall; overload; + {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} + +// line 3585 + +function SetWaitableTimer(hTimer: THandle; var lpDueTime: TLargeInteger; + lPeriod: Longint; pfnCompletionRoutine: TFNTimerAPCRoutine; + lpArgToCompletionRoutine: Pointer; fResume: BOOL): BOOL; stdcall; + {$EXTERNALSYM SetWaitableTimer} + +// WinBase.h line 8839 + +function SetFileSecurityA(lpFileName: LPCSTR; SecurityInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; stdcall; +{$EXTERNALSYM SetFileSecurityA} +function SetFileSecurityW(lpFileName: LPCWSTR; SecurityInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; stdcall; +{$EXTERNALSYM SetFileSecurityW} +function SetFileSecurity(lpFileName: LPCTSTR; SecurityInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; stdcall; +{$EXTERNALSYM SetFileSecurity} + +function GetFileSecurityA(lpFileName: LPCSTR; RequestedInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; + var lpnLengthNeeded: DWORD): BOOL; stdcall; +{$EXTERNALSYM GetFileSecurityA} +function GetFileSecurityW(lpFileName: LPCWSTR; RequestedInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; + var lpnLengthNeeded: DWORD): BOOL; stdcall; +{$EXTERNALSYM GetFileSecurityW} +function GetFileSecurity(lpFileName: LPCTSTR; RequestedInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; + var lpnLengthNeeded: DWORD): BOOL; stdcall; +{$EXTERNALSYM GetFileSecurity} + +// WinBase.h line 10251 + +function SetVolumeMountPointW(lpszVolumeMountPoint, lpszVolumeName: LPCWSTR): BOOL; stdcall; +{$EXTERNALSYM SetVolumeMountPointW} + +function DeleteVolumeMountPointW(lpszVolumeMountPoint: LPCWSTR): BOOL; stdcall; +{$EXTERNALSYM DeleteVolumeMountPointW} + +function GetVolumeNameForVolumeMountPointW(lpszVolumeMountPoint: LPCWSTR; + lpszVolumeName: LPWSTR; cchBufferLength: DWORD): BOOL; stdcall; +{$EXTERNALSYM GetVolumeNameForVolumeMountPointW} + +// new Windows 7 debugging API +function CopyExtendedContext(Destination: PCONTEXT_EX; ContextFlags: DWORD; Source: PCONTEXT_EX): BOOL; stdcall; +{$EXTERNALSYM CopyExtendedContext} + +function InitializeExtendedContext(Context: Pointer; ContextFlags: DWORD; out ContextEx: PCONTEXT_EX): BOOL; stdcall; +{$EXTERNALSYM InitializeExtendedContext} + +function GetEnabledExtendedFeatures(const FeatureMask: Int64): Int64; stdcall; +{$EXTERNALSYM GetEnabledExtendedFeatures} + +function GetExtendedContextLength(ContextFlags: DWORD; ContextLength: PDWORD): BOOL; stdcall; +{$EXTERNALSYM GetExtendedContextLength} + +function GetExtendedFeaturesMask(ContextEx: PCONTEXT_EX): Int64; stdcall; +{$EXTERNALSYM GetExtendedFeaturesMask} + +function LocateExtendedFeature(ContextEx: PCONTEXT_EX; FeatureId: DWORD; Length: PDWORD): Pointer; stdcall; +{$EXTERNALSYM LocateExtendedFeature} + +function LocateLegacyContext(ContextEx: PCONTEXT_EX; Length: PDWORD): PCONTEXT; stdcall; +{$EXTERNALSYM LocateLegacyContext} + +procedure SetExtendedFeaturesMask(ContextEx: PCONTEXT_EX; const FeatureMask: Int64); stdcall; +{$EXTERNALSYM SetExtendedFeaturesMask} + +function ProcessIdToSessionId(dwProcessId: DWORD; out dwSessionId: DWORD): BOOL; stdcall; +{$EXTERNALSYM ProcessIdToSessionId} + +{$ENDIF MSWINDOWS} diff --git a/3rdParty/JCL/source/prototypes/win32api/WinDef.int b/3rdParty/JCL/source/prototypes/win32api/WinDef.int new file mode 100644 index 00000000..6d348722 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/WinDef.int @@ -0,0 +1,11 @@ +{$IFNDEF FPC} + +// +// Unsigned Basics +// + +type + USHORT = Word; + {$EXTERNALSYM USHORT} + +{$ENDIF ~FPC} \ No newline at end of file diff --git a/3rdParty/JCL/source/prototypes/win32api/WinError.int b/3rdParty/JCL/source/prototypes/win32api/WinError.int new file mode 100644 index 00000000..6d48ad6e --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/WinError.int @@ -0,0 +1,228 @@ +// JwaWinError +// line 22146 + +const + +// +// Task Scheduler errors +// +// +// MessageId: SCHED_S_TASK_READY +// +// MessageText: +// +// The task is ready to run at its next scheduled time. +// + SCHED_S_TASK_READY = HRESULT($00041300); + {$EXTERNALSYM SCHED_S_TASK_READY} + +// +// MessageId: SCHED_S_TASK_RUNNING +// +// MessageText: +// +// The task is currently running. +// + SCHED_S_TASK_RUNNING = HRESULT($00041301); + {$EXTERNALSYM SCHED_S_TASK_RUNNING} + +// +// MessageId: SCHED_S_TASK_DISABLED +// +// MessageText: +// +// The task will not run at the scheduled times because it has been disabled. +// + SCHED_S_TASK_DISABLED = HRESULT($00041302); + {$EXTERNALSYM SCHED_S_TASK_DISABLED} + +// +// MessageId: SCHED_S_TASK_HAS_NOT_RUN +// +// MessageText: +// +// The task has not yet run. +// + SCHED_S_TASK_HAS_NOT_RUN = HRESULT($00041303); + {$EXTERNALSYM SCHED_S_TASK_HAS_NOT_RUN} + +// +// MessageId: SCHED_S_TASK_NO_MORE_RUNS +// +// MessageText: +// +// There are no more runs scheduled for this task. +// + SCHED_S_TASK_NO_MORE_RUNS = HRESULT($00041304); + {$EXTERNALSYM SCHED_S_TASK_NO_MORE_RUNS} + +// +// MessageId: SCHED_S_TASK_NOT_SCHEDULED +// +// MessageText: +// +// One or more of the properties that are needed to run this task on a schedule have not been set. +// + SCHED_S_TASK_NOT_SCHEDULED = HRESULT($00041305); + {$EXTERNALSYM SCHED_S_TASK_NOT_SCHEDULED} + +// +// MessageId: SCHED_S_TASK_TERMINATED +// +// MessageText: +// +// The last run of the task was terminated by the user. +// + SCHED_S_TASK_TERMINATED = HRESULT($00041306); + {$EXTERNALSYM SCHED_S_TASK_TERMINATED} + +// +// MessageId: SCHED_S_TASK_NO_VALID_TRIGGERS +// +// MessageText: +// +// Either the task has no triggers or the existing triggers are disabled or not set. +// + SCHED_S_TASK_NO_VALID_TRIGGERS = HRESULT($00041307); + {$EXTERNALSYM SCHED_S_TASK_NO_VALID_TRIGGERS} + +// +// MessageId: SCHED_S_EVENT_TRIGGER +// +// MessageText: +// +// Event triggers don't have set run times. +// + SCHED_S_EVENT_TRIGGER = HRESULT($00041308); + {$EXTERNALSYM SCHED_S_EVENT_TRIGGER} + +// +// MessageId: SCHED_E_TRIGGER_NOT_FOUND +// +// MessageText: +// +// Trigger not found. +// + SCHED_E_TRIGGER_NOT_FOUND = HRESULT($80041309); + {$EXTERNALSYM SCHED_E_TRIGGER_NOT_FOUND} + +// +// MessageId: SCHED_E_TASK_NOT_READY +// +// MessageText: +// +// One or more of the properties that are needed to run this task have not been set. +// + SCHED_E_TASK_NOT_READY = HRESULT($8004130A); + {$EXTERNALSYM SCHED_E_TASK_NOT_READY} + +// +// MessageId: SCHED_E_TASK_NOT_RUNNING +// +// MessageText: +// +// There is no running instance of the task to terminate. +// + SCHED_E_TASK_NOT_RUNNING = HRESULT($8004130B); + {$EXTERNALSYM SCHED_E_TASK_NOT_RUNNING} + +// +// MessageId: SCHED_E_SERVICE_NOT_INSTALLED +// +// MessageText: +// +// The Task Scheduler Service is not installed on this computer. +// + SCHED_E_SERVICE_NOT_INSTALLED = HRESULT($8004130C); + {$EXTERNALSYM SCHED_E_SERVICE_NOT_INSTALLED} + +// +// MessageId: SCHED_E_CANNOT_OPEN_TASK +// +// MessageText: +// +// The task object could not be opened. +// + SCHED_E_CANNOT_OPEN_TASK = HRESULT($8004130D); + {$EXTERNALSYM SCHED_E_CANNOT_OPEN_TASK} + +// +// MessageId: SCHED_E_INVALID_TASK +// +// MessageText: +// +// The object is either an invalid task object or is not a task object. +// + SCHED_E_INVALID_TASK = HRESULT($8004130E); + {$EXTERNALSYM SCHED_E_INVALID_TASK} + +// +// MessageId: SCHED_E_ACCOUNT_INFORMATION_NOT_SET +// +// MessageText: +// +// No account information could be found in the Task Scheduler security database for the task indicated. +// + SCHED_E_ACCOUNT_INFORMATION_NOT_SET = HRESULT($8004130F); + {$EXTERNALSYM SCHED_E_ACCOUNT_INFORMATION_NOT_SET} + +// +// MessageId: SCHED_E_ACCOUNT_NAME_NOT_FOUND +// +// MessageText: +// +// Unable to establish existence of the account specified. +// + SCHED_E_ACCOUNT_NAME_NOT_FOUND = HRESULT($80041310); + {$EXTERNALSYM SCHED_E_ACCOUNT_NAME_NOT_FOUND} + +// +// MessageId: SCHED_E_ACCOUNT_DBASE_CORRUPT +// +// MessageText: +// +// Corruption was detected in the Task Scheduler security database; the database has been reset. +// + SCHED_E_ACCOUNT_DBASE_CORRUPT = HRESULT($80041311); + {$EXTERNALSYM SCHED_E_ACCOUNT_DBASE_CORRUPT} + +// +// MessageId: SCHED_E_NO_SECURITY_SERVICES +// +// MessageText: +// +// Task Scheduler security services are available only on Windows NT. +// + SCHED_E_NO_SECURITY_SERVICES = HRESULT($80041312); + {$EXTERNALSYM SCHED_E_NO_SECURITY_SERVICES} + +// +// MessageId: SCHED_E_UNKNOWN_OBJECT_VERSION +// +// MessageText: +// +// The task object version is either unsupported or invalid. +// + SCHED_E_UNKNOWN_OBJECT_VERSION = HRESULT($80041313); + {$EXTERNALSYM SCHED_E_UNKNOWN_OBJECT_VERSION} + +// +// MessageId: SCHED_E_UNSUPPORTED_ACCOUNT_OPTION +// +// MessageText: +// +// The task has been configured with an unsupported combination of account settings and run time options. +// + SCHED_E_UNSUPPORTED_ACCOUNT_OPTION = HRESULT($80041314); + {$EXTERNALSYM SCHED_E_UNSUPPORTED_ACCOUNT_OPTION} + +// +// MessageId: SCHED_E_SERVICE_NOT_RUNNING +// +// MessageText: +// +// The Task Scheduler Service is not running. +// + SCHED_E_SERVICE_NOT_RUNNING = HRESULT($80041315); + {$EXTERNALSYM SCHED_E_SERVICE_NOT_RUNNING} + diff --git a/3rdParty/JCL/source/prototypes/win32api/WinIoctl.int b/3rdParty/JCL/source/prototypes/win32api/WinIoctl.int new file mode 100644 index 00000000..35d06f5c --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/WinIoctl.int @@ -0,0 +1,601 @@ +// line 151 + +// +// Define the various device type values. Note that values used by Microsoft +// Corporation are in the range 0-32767, and 32768-65535 are reserved for use +// by customers. +// + +type + DEVICE_TYPE = DWORD; + {$EXTERNALSYM DEVICE_TYPE} + +const + FILE_DEVICE_BEEP = $00000001; + {$EXTERNALSYM FILE_DEVICE_BEEP} + FILE_DEVICE_CD_ROM = $00000002; + {$EXTERNALSYM FILE_DEVICE_CD_ROM} + FILE_DEVICE_CD_ROM_FILE_SYSTEM = $00000003; + {$EXTERNALSYM FILE_DEVICE_CD_ROM_FILE_SYSTEM} + FILE_DEVICE_CONTROLLER = $00000004; + {$EXTERNALSYM FILE_DEVICE_CONTROLLER} + FILE_DEVICE_DATALINK = $00000005; + {$EXTERNALSYM FILE_DEVICE_DATALINK} + FILE_DEVICE_DFS = $00000006; + {$EXTERNALSYM FILE_DEVICE_DFS} + FILE_DEVICE_DISK = $00000007; + {$EXTERNALSYM FILE_DEVICE_DISK} + FILE_DEVICE_DISK_FILE_SYSTEM = $00000008; + {$EXTERNALSYM FILE_DEVICE_DISK_FILE_SYSTEM} + FILE_DEVICE_FILE_SYSTEM = $00000009; + {$EXTERNALSYM FILE_DEVICE_FILE_SYSTEM} + FILE_DEVICE_INPORT_PORT = $0000000a; + {$EXTERNALSYM FILE_DEVICE_INPORT_PORT} + FILE_DEVICE_KEYBOARD = $0000000b; + {$EXTERNALSYM FILE_DEVICE_KEYBOARD} + FILE_DEVICE_MAILSLOT = $0000000c; + {$EXTERNALSYM FILE_DEVICE_MAILSLOT} + FILE_DEVICE_MIDI_IN = $0000000d; + {$EXTERNALSYM FILE_DEVICE_MIDI_IN} + FILE_DEVICE_MIDI_OUT = $0000000e; + {$EXTERNALSYM FILE_DEVICE_MIDI_OUT} + FILE_DEVICE_MOUSE = $0000000f; + {$EXTERNALSYM FILE_DEVICE_MOUSE} + FILE_DEVICE_MULTI_UNC_PROVIDER = $00000010; + {$EXTERNALSYM FILE_DEVICE_MULTI_UNC_PROVIDER} + FILE_DEVICE_NAMED_PIPE = $00000011; + {$EXTERNALSYM FILE_DEVICE_NAMED_PIPE} + FILE_DEVICE_NETWORK = $00000012; + {$EXTERNALSYM FILE_DEVICE_NETWORK} + FILE_DEVICE_NETWORK_BROWSER = $00000013; + {$EXTERNALSYM FILE_DEVICE_NETWORK_BROWSER} + FILE_DEVICE_NETWORK_FILE_SYSTEM = $00000014; + {$EXTERNALSYM FILE_DEVICE_NETWORK_FILE_SYSTEM} + FILE_DEVICE_NULL = $00000015; + {$EXTERNALSYM FILE_DEVICE_NULL} + FILE_DEVICE_PARALLEL_PORT = $00000016; + {$EXTERNALSYM FILE_DEVICE_PARALLEL_PORT} + FILE_DEVICE_PHYSICAL_NETCARD = $00000017; + {$EXTERNALSYM FILE_DEVICE_PHYSICAL_NETCARD} + FILE_DEVICE_PRINTER = $00000018; + {$EXTERNALSYM FILE_DEVICE_PRINTER} + FILE_DEVICE_SCANNER = $00000019; + {$EXTERNALSYM FILE_DEVICE_SCANNER} + FILE_DEVICE_SERIAL_MOUSE_PORT = $0000001a; + {$EXTERNALSYM FILE_DEVICE_SERIAL_MOUSE_PORT} + FILE_DEVICE_SERIAL_PORT = $0000001b; + {$EXTERNALSYM FILE_DEVICE_SERIAL_PORT} + FILE_DEVICE_SCREEN = $0000001c; + {$EXTERNALSYM FILE_DEVICE_SCREEN} + FILE_DEVICE_SOUND = $0000001d; + {$EXTERNALSYM FILE_DEVICE_SOUND} + FILE_DEVICE_STREAMS = $0000001e; + {$EXTERNALSYM FILE_DEVICE_STREAMS} + FILE_DEVICE_TAPE = $0000001f; + {$EXTERNALSYM FILE_DEVICE_TAPE} + FILE_DEVICE_TAPE_FILE_SYSTEM = $00000020; + {$EXTERNALSYM FILE_DEVICE_TAPE_FILE_SYSTEM} + FILE_DEVICE_TRANSPORT = $00000021; + {$EXTERNALSYM FILE_DEVICE_TRANSPORT} + FILE_DEVICE_UNKNOWN = $00000022; + {$EXTERNALSYM FILE_DEVICE_UNKNOWN} + FILE_DEVICE_VIDEO = $00000023; + {$EXTERNALSYM FILE_DEVICE_VIDEO} + FILE_DEVICE_VIRTUAL_DISK = $00000024; + {$EXTERNALSYM FILE_DEVICE_VIRTUAL_DISK} + FILE_DEVICE_WAVE_IN = $00000025; + {$EXTERNALSYM FILE_DEVICE_WAVE_IN} + FILE_DEVICE_WAVE_OUT = $00000026; + {$EXTERNALSYM FILE_DEVICE_WAVE_OUT} + FILE_DEVICE_8042_PORT = $00000027; + {$EXTERNALSYM FILE_DEVICE_8042_PORT} + FILE_DEVICE_NETWORK_REDIRECTOR = $00000028; + {$EXTERNALSYM FILE_DEVICE_NETWORK_REDIRECTOR} + FILE_DEVICE_BATTERY = $00000029; + {$EXTERNALSYM FILE_DEVICE_BATTERY} + FILE_DEVICE_BUS_EXTENDER = $0000002a; + {$EXTERNALSYM FILE_DEVICE_BUS_EXTENDER} + FILE_DEVICE_MODEM = $0000002b; + {$EXTERNALSYM FILE_DEVICE_MODEM} + FILE_DEVICE_VDM = $0000002c; + {$EXTERNALSYM FILE_DEVICE_VDM} + FILE_DEVICE_MASS_STORAGE = $0000002d; + {$EXTERNALSYM FILE_DEVICE_MASS_STORAGE} + FILE_DEVICE_SMB = $0000002e; + {$EXTERNALSYM FILE_DEVICE_SMB} + FILE_DEVICE_KS = $0000002f; + {$EXTERNALSYM FILE_DEVICE_KS} + FILE_DEVICE_CHANGER = $00000030; + {$EXTERNALSYM FILE_DEVICE_CHANGER} + FILE_DEVICE_SMARTCARD = $00000031; + {$EXTERNALSYM FILE_DEVICE_SMARTCARD} + FILE_DEVICE_ACPI = $00000032; + {$EXTERNALSYM FILE_DEVICE_ACPI} + FILE_DEVICE_DVD = $00000033; + {$EXTERNALSYM FILE_DEVICE_DVD} + FILE_DEVICE_FULLSCREEN_VIDEO = $00000034; + {$EXTERNALSYM FILE_DEVICE_FULLSCREEN_VIDEO} + FILE_DEVICE_DFS_FILE_SYSTEM = $00000035; + {$EXTERNALSYM FILE_DEVICE_DFS_FILE_SYSTEM} + FILE_DEVICE_DFS_VOLUME = $00000036; + {$EXTERNALSYM FILE_DEVICE_DFS_VOLUME} + FILE_DEVICE_SERENUM = $00000037; + {$EXTERNALSYM FILE_DEVICE_SERENUM} + FILE_DEVICE_TERMSRV = $00000038; + {$EXTERNALSYM FILE_DEVICE_TERMSRV} + FILE_DEVICE_KSEC = $00000039; + {$EXTERNALSYM FILE_DEVICE_KSEC} + FILE_DEVICE_FIPS = $0000003A; + {$EXTERNALSYM FILE_DEVICE_FIPS} + FILE_DEVICE_INFINIBAND = $0000003B; + {$EXTERNALSYM FILE_DEVICE_INFINIBAND} + +// line 297 + +// +// Define the method codes for how buffers are passed for I/O and FS controls +// + +const + METHOD_BUFFERED = 0; + {$EXTERNALSYM METHOD_BUFFERED} + METHOD_IN_DIRECT = 1; + {$EXTERNALSYM METHOD_IN_DIRECT} + METHOD_OUT_DIRECT = 2; + {$EXTERNALSYM METHOD_OUT_DIRECT} + METHOD_NEITHER = 3; + {$EXTERNALSYM METHOD_NEITHER} + +// +// Define some easier to comprehend aliases: +// METHOD_DIRECT_TO_HARDWARE (writes, aka METHOD_IN_DIRECT) +// METHOD_DIRECT_FROM_HARDWARE (reads, aka METHOD_OUT_DIRECT) +// + + METHOD_DIRECT_TO_HARDWARE = METHOD_IN_DIRECT; + {$EXTERNALSYM METHOD_DIRECT_TO_HARDWARE} + METHOD_DIRECT_FROM_HARDWARE = METHOD_OUT_DIRECT; + {$EXTERNALSYM METHOD_DIRECT_FROM_HARDWARE} + +// +// Define the access check value for any access +// +// +// The FILE_READ_ACCESS and FILE_WRITE_ACCESS constants are also defined in +// ntioapi.h as FILE_READ_DATA and FILE_WRITE_DATA. The values for these +// constants *MUST* always be in sync. +// +// +// FILE_SPECIAL_ACCESS is checked by the NT I/O system the same as FILE_ANY_ACCESS. +// The file systems, however, may add additional access checks for I/O and FS controls +// that use this value. +// + +const + FILE_ANY_ACCESS = 0; + {$EXTERNALSYM FILE_ANY_ACCESS} + FILE_SPECIAL_ACCESS = FILE_ANY_ACCESS; + {$EXTERNALSYM FILE_SPECIAL_ACCESS} + FILE_READ_ACCESS = $0001; // file & pipe + {$EXTERNALSYM FILE_READ_ACCESS} + FILE_WRITE_ACCESS = $0002; // file & pipe + {$EXTERNALSYM FILE_WRITE_ACCESS} + +// line 3425 + +// +// The following is a list of the native file system fsctls followed by +// additional network file system fsctls. Some values have been +// decommissioned. +// + +const + + FSCTL_REQUEST_OPLOCK_LEVEL_1 = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (0 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_REQUEST_OPLOCK_LEVEL_1} + + FSCTL_REQUEST_OPLOCK_LEVEL_2 = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (1 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_REQUEST_OPLOCK_LEVEL_2} + + FSCTL_REQUEST_BATCH_OPLOCK = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (2 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_REQUEST_BATCH_OPLOCK} + + FSCTL_OPLOCK_BREAK_ACKNOWLEDGE = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (3 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_OPLOCK_BREAK_ACKNOWLEDGE} + + FSCTL_OPBATCH_ACK_CLOSE_PENDING = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (4 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_OPBATCH_ACK_CLOSE_PENDING} + + FSCTL_OPLOCK_BREAK_NOTIFY = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (5 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_OPLOCK_BREAK_NOTIFY} + + FSCTL_LOCK_VOLUME = ((FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or (6 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_LOCK_VOLUME} + + FSCTL_UNLOCK_VOLUME = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (7 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_UNLOCK_VOLUME} + + FSCTL_DISMOUNT_VOLUME = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (8 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_DISMOUNT_VOLUME} + +// decommissioned fsctl value 9 + + FSCTL_IS_VOLUME_MOUNTED = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (10 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_IS_VOLUME_MOUNTED} + + FSCTL_IS_PATHNAME_VALID = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (11 shl 2) or METHOD_BUFFERED); // PATHNAME_BUFFER, + {$EXTERNALSYM FSCTL_IS_PATHNAME_VALID} + + FSCTL_MARK_VOLUME_DIRTY = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (12 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_MARK_VOLUME_DIRTY} + +// decommissioned fsctl value 13 + + FSCTL_QUERY_RETRIEVAL_POINTERS = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (14 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_QUERY_RETRIEVAL_POINTERS} + + FSCTL_GET_COMPRESSION = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (15 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_GET_COMPRESSION} + + FSCTL_SET_COMPRESSION = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or ((FILE_READ_DATA or FILE_WRITE_DATA) shl 14) or + (16 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_SET_COMPRESSION} + +// decommissioned fsctl value 17 +// decommissioned fsctl value 18 + + FSCTL_MARK_AS_SYSTEM_HIVE = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (19 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_MARK_AS_SYSTEM_HIVE} + + FSCTL_OPLOCK_BREAK_ACK_NO_2 = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (20 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_OPLOCK_BREAK_ACK_NO_2} + + FSCTL_INVALIDATE_VOLUMES = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (21 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_INVALIDATE_VOLUMES} + + FSCTL_QUERY_FAT_BPB = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (22 shl 2) or METHOD_BUFFERED); // FSCTL_QUERY_FAT_BPB_BUFFER + {$EXTERNALSYM FSCTL_QUERY_FAT_BPB} + + FSCTL_REQUEST_FILTER_OPLOCK = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (23 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_REQUEST_FILTER_OPLOCK} + + FSCTL_FILESYSTEM_GET_STATISTICS = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (24 shl 2) or METHOD_BUFFERED); // FILESYSTEM_STATISTICS + {$EXTERNALSYM FSCTL_FILESYSTEM_GET_STATISTICS} + + FSCTL_GET_NTFS_VOLUME_DATA = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (25 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_GET_NTFS_VOLUME_DATA} + + FSCTL_GET_NTFS_FILE_RECORD = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (26 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_GET_NTFS_FILE_RECORD} + + FSCTL_GET_VOLUME_BITMAP = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (27 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_GET_VOLUME_BITMAP} + + FSCTL_GET_RETRIEVAL_POINTERS = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (28 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_GET_RETRIEVAL_POINTERS} + + FSCTL_MOVE_FILE = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or + (29 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_MOVE_FILE} + + FSCTL_IS_VOLUME_DIRTY = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (30 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_IS_VOLUME_DIRTY} + +// decomissioned fsctl value 31 +(* FSCTL_GET_HFS_INFORMATION = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (31 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_GET_HFS_INFORMATION} +*) + + FSCTL_ALLOW_EXTENDED_DASD_IO = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (32 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_ALLOW_EXTENDED_DASD_IO} + +// decommissioned fsctl value 33 +// decommissioned fsctl value 34 + +(* + FSCTL_READ_PROPERTY_DATA = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (33 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_READ_PROPERTY_DATA} + + FSCTL_WRITE_PROPERTY_DATA = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (34 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_WRITE_PROPERTY_DATA} +*) + + FSCTL_FIND_FILES_BY_SID = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (35 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_FIND_FILES_BY_SID} + +// decommissioned fsctl value 36 +// decommissioned fsctl value 37 + +(* FSCTL_DUMP_PROPERTY_DATA = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (37 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_DUMP_PROPERTY_DATA} +*) + + FSCTL_SET_OBJECT_ID = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or + (38 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_SET_OBJECT_ID} + + FSCTL_GET_OBJECT_ID = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (39 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_GET_OBJECT_ID} + + FSCTL_DELETE_OBJECT_ID = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or + (40 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_DELETE_OBJECT_ID} + + FSCTL_SET_REPARSE_POINT = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or + (41 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_SET_REPARSE_POINT} + + FSCTL_GET_REPARSE_POINT = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (42 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_GET_REPARSE_POINT} + + FSCTL_DELETE_REPARSE_POINT = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or + (43 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_DELETE_REPARSE_POINT} + + FSCTL_ENUM_USN_DATA = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (44 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_ENUM_USN_DATA} + + FSCTL_SECURITY_ID_CHECK = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_READ_DATA shl 14) or + (45 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_SECURITY_ID_CHECK} + + FSCTL_READ_USN_JOURNAL = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (46 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_READ_USN_JOURNAL} + + FSCTL_SET_OBJECT_ID_EXTENDED = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or + (47 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_SET_OBJECT_ID_EXTENDED} + + FSCTL_CREATE_OR_GET_OBJECT_ID = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (48 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_CREATE_OR_GET_OBJECT_ID} + + FSCTL_SET_SPARSE = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or + (49 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_SET_SPARSE} + + FSCTL_SET_ZERO_DATA = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_WRITE_DATA shl 14) or + (50 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_SET_ZERO_DATA} + + FSCTL_QUERY_ALLOCATED_RANGES = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_READ_DATA shl 14) or + (51 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_QUERY_ALLOCATED_RANGES} + +// decommissioned fsctl value 52 +(* + FSCTL_ENABLE_UPGRADE = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_WRITE_DATA shl 14) or + (52 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_ENABLE_UPGRADE} +*) + + FSCTL_SET_ENCRYPTION = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (53 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_SET_ENCRYPTION} + + FSCTL_ENCRYPTION_FSCTL_IO = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (54 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_ENCRYPTION_FSCTL_IO} + + FSCTL_WRITE_RAW_ENCRYPTED = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or + (55 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_WRITE_RAW_ENCRYPTED} + + FSCTL_READ_RAW_ENCRYPTED = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or + (56 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_READ_RAW_ENCRYPTED} + + FSCTL_CREATE_USN_JOURNAL = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (57 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_CREATE_USN_JOURNAL} + + FSCTL_READ_FILE_USN_DATA = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (58 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_READ_FILE_USN_DATA} + + FSCTL_WRITE_USN_CLOSE_RECORD = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (59 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_WRITE_USN_CLOSE_RECORD} + + FSCTL_EXTEND_VOLUME = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (60 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_EXTEND_VOLUME} + + FSCTL_QUERY_USN_JOURNAL = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (61 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_QUERY_USN_JOURNAL} + + FSCTL_DELETE_USN_JOURNAL = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (62 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_DELETE_USN_JOURNAL} + + FSCTL_MARK_HANDLE = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (63 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_MARK_HANDLE} + + FSCTL_SIS_COPYFILE = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (64 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_SIS_COPYFILE} + + FSCTL_SIS_LINK_FILES = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or ((FILE_READ_DATA or FILE_WRITE_DATA) shl 14) or + (65 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_SIS_LINK_FILES} + + FSCTL_HSM_MSG = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or ((FILE_READ_DATA or FILE_WRITE_DATA) shl 14) or + (66 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_HSM_MSG} + +// decommissioned fsctl value 67 +(* + FSCTL_NSS_CONTROL = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_WRITE_DATA shl 14) or + (67 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_NSS_CONTROL} +*) + + FSCTL_HSM_DATA = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or ((FILE_READ_DATA or FILE_WRITE_DATA) shl 14) or + (68 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_HSM_DATA} + + FSCTL_RECALL_FILE = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (69 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_RECALL_FILE} + +// decommissioned fsctl value 70 +(* + FSCTL_NSS_RCONTROL = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_READ_DATA shl 14) or + (70 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_NSS_RCONTROL} +*) + + FSCTL_READ_FROM_PLEX = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_READ_DATA shl 14) or + (71 shl 2) or METHOD_OUT_DIRECT); + {$EXTERNALSYM FSCTL_READ_FROM_PLEX} + + FSCTL_FILE_PREFETCH = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or + (72 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_FILE_PREFETCH} + +// line 4553 + +// +// Structure for FSCTL_SET_ZERO_DATA +// + +type + + PFILE_ZERO_DATA_INFORMATION = ^FILE_ZERO_DATA_INFORMATION; + {$EXTERNALSYM PFILE_ZERO_DATA_INFORMATION} + _FILE_ZERO_DATA_INFORMATION = record + FileOffset: LARGE_INTEGER; + BeyondFinalZero: LARGE_INTEGER; + end; + {$EXTERNALSYM _FILE_ZERO_DATA_INFORMATION} + FILE_ZERO_DATA_INFORMATION = _FILE_ZERO_DATA_INFORMATION; + {$EXTERNALSYM FILE_ZERO_DATA_INFORMATION} + TFileZeroDataInformation = FILE_ZERO_DATA_INFORMATION; + PFileZeroDataInformation = PFILE_ZERO_DATA_INFORMATION; + +// +// Structure for FSCTL_QUERY_ALLOCATED_RANGES +// + +// +// Querying the allocated ranges requires an output buffer to store the +// allocated ranges and an input buffer to specify the range to query. +// The input buffer contains a single entry, the output buffer is an +// array of the following structure. +// + + PFILE_ALLOCATED_RANGE_BUFFER = ^FILE_ALLOCATED_RANGE_BUFFER; + {$EXTERNALSYM PFILE_ALLOCATED_RANGE_BUFFER} + _FILE_ALLOCATED_RANGE_BUFFER = record + FileOffset: LARGE_INTEGER; + Length: LARGE_INTEGER; + end; + {$EXTERNALSYM _FILE_ALLOCATED_RANGE_BUFFER} + FILE_ALLOCATED_RANGE_BUFFER = _FILE_ALLOCATED_RANGE_BUFFER; + {$EXTERNALSYM FILE_ALLOCATED_RANGE_BUFFER} + TFileAllocatedRangeBuffer = FILE_ALLOCATED_RANGE_BUFFER; + PFileAllocatedRangeBuffer = PFILE_ALLOCATED_RANGE_BUFFER; + diff --git a/3rdParty/JCL/source/prototypes/win32api/WinNLS.imp b/3rdParty/JCL/source/prototypes/win32api/WinNLS.imp new file mode 100644 index 00000000..2d50216f --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/WinNLS.imp @@ -0,0 +1,45 @@ +{$IFDEF MSWINDOWS} + +type + TGetCalendarInfoA = function (Locale: LCID; Calendar: CALID; CalType: CALTYPE; + lpCalData: LPSTR; cchData: Integer; lpValue: LPDWORD): Integer; stdcall; + +var + _GetCalendarInfoA: TGetCalendarInfoA = nil; + +function GetCalendarInfoA(Locale: LCID; Calendar: CALID; CalType: CALTYPE; + lpCalData: LPSTR; cchData: Integer; lpValue: LPDWORD): Integer; +begin + GetProcedureAddress(Pointer(@_GetCalendarInfoA), kernel32, 'GetCalendarInfoA'); + Result := _GetCalendarInfoA(Locale, Calendar, CalType, lpCalData, cchData, lpValue); +end; + +type + TGetCalendarInfoW = function (Locale: LCID; Calendar: CALID; CalType: CALTYPE; + lpCalData: LPWSTR; cchData: Integer; lpValue: LPDWORD): Integer; stdcall; + +var + _GetCalendarInfoW: TGetCalendarInfoW = nil; + +function GetCalendarInfoW(Locale: LCID; Calendar: CALID; CalType: CALTYPE; + lpCalData: LPWSTR; cchData: Integer; lpValue: LPDWORD): Integer; +begin + GetProcedureAddress(Pointer(@_GetCalendarInfoW), kernel32, 'GetCalendarInfoW'); + Result := _GetCalendarInfoW(Locale, Calendar, CalType, lpCalData, cchData, lpValue); +end; + +type + TEnumCalendarInfoExW = function (lpCalInfoEnumProcEx: CALINFO_ENUMPROCEXW; + Locale: LCID; Calendar: CALID; CalType: CALTYPE): BOOL; stdcall; + +var + _EnumCalendarInfoExW: TEnumCalendarInfoExW = nil; + +function EnumCalendarInfoExW(lpCalInfoEnumProcEx: CALINFO_ENUMPROCEXW; + Locale: LCID; Calendar: CALID; CalType: CALTYPE): BOOL; +begin + GetProcedureAddress(Pointer(@_EnumCalendarInfoExW), kernel32, 'EnumCalendarInfoExW'); + Result := _EnumCalendarInfoExW(lpCalInfoEnumProcEx, Locale, Calendar, CalType); +end; + +{$ENDIF MSWINDOWS} diff --git a/3rdParty/JCL/source/prototypes/win32api/WinNLS.int b/3rdParty/JCL/source/prototypes/win32api/WinNLS.int new file mode 100644 index 00000000..1117b349 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/WinNLS.int @@ -0,0 +1,137 @@ +// line 340 + +// +// Code Page Default Values. +// + +const + CP_ACP = 0; // default to ANSI code page + {$EXTERNALSYM CP_ACP} + CP_OEMCP = 1; // default to OEM code page + {$EXTERNALSYM CP_OEMCP} + CP_MACCP = 2; // default to MAC code page + {$EXTERNALSYM CP_MACCP} + CP_THREAD_ACP = 3; // current thread's ANSI code page + {$EXTERNALSYM CP_THREAD_ACP} + CP_SYMBOL = 42; // SYMBOL translations + {$EXTERNALSYM CP_SYMBOL} + + CP_UTF7 = 65000; // UTF-7 translation + {$EXTERNALSYM CP_UTF7} + CP_UTF8 = 65001; // UTF-8 translation + {$EXTERNALSYM CP_UTF8} + +// line 597 + +const + +// +// The following LCTypes may be used in combination with any other LCTypes. +// +// LOCALE_NOUSEROVERRIDE is also used in GetTimeFormat and +// GetDateFormat. +// +// LOCALE_USE_CP_ACP is used in many of the A (Ansi) apis that need +// to do string translation. +// +// LOCALE_RETURN_NUMBER will return the result from GetLocaleInfo as a +// number instead of a string. This flag is only valid for the LCTypes +// beginning with LOCALE_I. +// + + LOCALE_NOUSEROVERRIDE = DWORD($80000000); // do not use user overrides + {$EXTERNALSYM LOCALE_NOUSEROVERRIDE} + LOCALE_USE_CP_ACP = $40000000; // use the system ACP + {$EXTERNALSYM LOCALE_USE_CP_ACP} + + LOCALE_RETURN_NUMBER = $20000000; // return number instead of string + {$EXTERNALSYM LOCALE_RETURN_NUMBER} + +// line 841 + +const + LOCALE_IDEFAULTEBCDICCODEPAGE = $00001012; // default ebcdic code page + {$EXTERNALSYM LOCALE_IDEFAULTEBCDICCODEPAGE} + LOCALE_IPAPERSIZE = $0000100A; // 1 = letter, 5 = legal, 8 = a3, 9 = a4 + {$EXTERNALSYM LOCALE_IPAPERSIZE} + LOCALE_SENGCURRNAME = $00001007; // english name of currency + {$EXTERNALSYM LOCALE_SENGCURRNAME} + LOCALE_SNATIVECURRNAME = $00001008; // native name of currency + {$EXTERNALSYM LOCALE_SNATIVECURRNAME} + LOCALE_SYEARMONTH = $00001006; // year month format string + {$EXTERNALSYM LOCALE_SYEARMONTH} + LOCALE_SSORTNAME = $00001013; // sort name + {$EXTERNALSYM LOCALE_SSORTNAME} + LOCALE_IDIGITSUBSTITUTION = $00001014; // 0 = context, 1 = none, 2 = national + {$EXTERNALSYM LOCALE_IDIGITSUBSTITUTION} + +// line 880 + + DATE_YEARMONTH = $00000008; // use year month picture + {$EXTERNALSYM DATE_YEARMONTH} + DATE_LTRREADING = $00000010; // add marks for left to right reading order layout + {$EXTERNALSYM DATE_LTRREADING} + DATE_RTLREADING = $00000020; // add marks for right to left reading order layout + {$EXTERNALSYM DATE_RTLREADING} + +// +// Calendar Types. +// +// These types are used for the EnumCalendarInfo and GetCalendarInfo +// NLS API routines. +// Some of these types are also used for the SetCalendarInfo NLS API +// routine. +// + +// +// The following CalTypes may be used in combination with any other CalTypes. +// +// CAL_NOUSEROVERRIDE +// +// CAL_USE_CP_ACP is used in the A (Ansi) apis that need to do string +// translation. +// +// CAL_RETURN_NUMBER will return the result from GetCalendarInfo as a +// number instead of a string. This flag is only valid for the CalTypes +// beginning with CAL_I. +// + + CAL_NOUSEROVERRIDE = LOCALE_NOUSEROVERRIDE; // do not use user overrides + {$EXTERNALSYM CAL_NOUSEROVERRIDE} + CAL_USE_CP_ACP = LOCALE_USE_CP_ACP; // use the system ACP + {$EXTERNALSYM CAL_USE_CP_ACP} + CAL_RETURN_NUMBER = LOCALE_RETURN_NUMBER; // return number instead of string + {$EXTERNALSYM CAL_RETURN_NUMBER} + +// line 1014 + + CAL_SYEARMONTH = $0000002f; // year month format string + {$EXTERNALSYM CAL_SYEARMONTH} + CAL_ITWODIGITYEARMAX = $00000030; // two digit year max + {$EXTERNALSYM CAL_ITWODIGITYEARMAX} + +// line 1424 + +type + CALINFO_ENUMPROCEXW = function (lpCalendarInfoString: LPWSTR; Calendar: CALID): BOOL; stdcall; + {$EXTERNALSYM CALINFO_ENUMPROCEXW} + TCalInfoEnumProcExW = CALINFO_ENUMPROCEXW; + +// line 1635 + +{$IFDEF MSWINDOWS} + +function GetCalendarInfoA(Locale: LCID; Calendar: CALID; CalType: CALTYPE; + lpCalData: LPSTR; cchData: Integer; lpValue: LPDWORD): Integer; stdcall; +{$EXTERNALSYM GetCalendarInfoA} +function GetCalendarInfoW(Locale: LCID; Calendar: CALID; CalType: CALTYPE; + lpCalData: LPWSTR; cchData: Integer; lpValue: LPDWORD): Integer; stdcall; +{$EXTERNALSYM GetCalendarInfoW} + +// line 1754 + +function EnumCalendarInfoExW(lpCalInfoEnumProcEx: CALINFO_ENUMPROCEXW; + Locale: LCID; Calendar: CALID; CalType: CALTYPE): BOOL; stdcall; +{$EXTERNALSYM EnumCalendarInfoExW} + +{$ENDIF MSWINDOWS} diff --git a/3rdParty/JCL/source/prototypes/win32api/WinNT.imp b/3rdParty/JCL/source/prototypes/win32api/WinNT.imp new file mode 100644 index 00000000..d28509fb --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/WinNT.imp @@ -0,0 +1,115 @@ +// line 9078 + +function MAKELANGID(PrimaryLang, SubLang: USHORT): WORD; +begin + Result := (SubLang shl 10) or PrimaryLang; +end; + +function PRIMARYLANGID(LangId: WORD): WORD; +begin + Result := LangId and $03FF; +end; + +function SUBLANGID(LangId: WORD): WORD; +begin + Result := LangId shr 10; +end; + +function MAKELCID(LangId, SortId: WORD): DWORD; +begin + Result := (DWORD(SortId) shl 16) or DWORD(LangId); +end; + +function MAKESORTLCID(LangId, SortId, SortVersion: WORD): DWORD; +begin + Result := MAKELCID(LangId, SortId) or (SortVersion shl 20); +end; + +function LANGIDFROMLCID(LocaleId: LCID): WORD; +begin + Result := WORD(LocaleId); +end; + +function SORTIDFROMLCID(LocaleId: LCID): WORD; +begin + Result := WORD((DWORD(LocaleId) shr 16) and $000F); +end; + +function SORTVERSIONFROMLCID(LocaleId: LCID): WORD; +begin + Result := WORD((DWORD(LocaleId) shr 20) and $000F); +end; + +type + TCaptureStackBackTrace = function(FramesToSkip, FramesToCapture: DWORD; + BackTrace: Pointer; out BackTraceHash: DWORD): Word; stdcall; + +var + _CaptureStackBackTrace: TCaptureStackBackTrace = nil; + +function CaptureStackBackTrace(FramesToSkip, FramesToCapture: DWORD; + BackTrace: Pointer; out BackTraceHash: DWORD): Word; stdcall; +begin + GetProcedureAddress(Pointer(@_CaptureStackBackTrace), kernel32, 'RtlCaptureStackBackTrace'); + Result := _CaptureStackBackTrace(FramesToSkip, FramesToCapture, BackTrace, BackTraceHash); +end; + +// line 9149 + +function IsReparseTagMicrosoft(Tag: ULONG): Boolean; +begin + Result := (Tag and ULONG($80000000)) <> 0; +end; + +function IsReparseTagHighLatency(Tag: ULONG): Boolean; +begin + Result := (Tag and ULONG($40000000)) <> 0; +end; + +function IsReparseTagNameSurrogate(Tag: ULONG): Boolean; +begin + Result := (Tag and ULONG($20000000)) <> 0; +end; + +// IMAGE_FIRST_SECTION by Nico Bendlin - supplied by Markus Fuchs + +function IMAGE_FIRST_SECTION(NtHeader: PImageNtHeaders): PImageSectionHeader; +var + OptionalHeaderAddr: PByte; +begin + OptionalHeaderAddr := @NtHeader^.OptionalHeader; + Inc(OptionalHeaderAddr, NtHeader^.FileHeader.SizeOfOptionalHeader); + Result := PImageSectionHeader(OptionalHeaderAddr); +end; + +// line 9204 + +function IMAGE_ORDINAL64(Ordinal: ULONGLONG): ULONGLONG; +begin + Result := (Ordinal and $FFFF); +end; + +function IMAGE_ORDINAL32(Ordinal: DWORD): DWORD; +begin + Result := (Ordinal and $0000FFFF); +end; + +function IMAGE_ORDINAL(Ordinal: DWORD): DWORD; +begin + Result := (Ordinal and $0000FFFF); +end; + +function IMAGE_SNAP_BY_ORDINAL64(Ordinal: ULONGLONG): Boolean; +begin + Result := ((Ordinal and IMAGE_ORDINAL_FLAG64) <> 0); +end; + +function IMAGE_SNAP_BY_ORDINAL32(Ordinal: DWORD): Boolean; +begin + Result := ((Ordinal and IMAGE_ORDINAL_FLAG32) <> 0); +end; + +function IMAGE_SNAP_BY_ORDINAL(Ordinal: DWORD): Boolean; +begin + Result := ((Ordinal and IMAGE_ORDINAL_FLAG32) <> 0); +end; diff --git a/3rdParty/JCL/source/prototypes/win32api/WinNT.int b/3rdParty/JCL/source/prototypes/win32api/WinNT.int new file mode 100644 index 00000000..4f0fadf8 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/WinNT.int @@ -0,0 +1,2823 @@ +//================================================================================================== +// presumable from any older WinNT.h or from WinIfs.h +//================================================================================================== + +//-------------------------------------------------------------------------------------------------- +// NTFS Reparse Points +//-------------------------------------------------------------------------------------------------- + +// The reparse structure is used by layered drivers to store data in a +// reparse point. The constraints on reparse tags are defined below. +// This version of the reparse data buffer is only for Microsoft tags. + +(*$HPPEMIT 'typedef struct _REPARSE_DATA_BUFFER {'*) +(*$HPPEMIT ''*) +(*$HPPEMIT ' DWORD ReparseTag;'*) +(*$HPPEMIT ' WORD ReparseDataLength;'*) +(*$HPPEMIT ' WORD Reserved;'*) +(*$HPPEMIT ''*) +(*$HPPEMIT ' union {'*) +(*$HPPEMIT ''*) +(*$HPPEMIT ' struct {'*) +(*$HPPEMIT ' WORD SubstituteNameOffset;'*) +(*$HPPEMIT ' WORD SubstituteNameLength;'*) +(*$HPPEMIT ' WORD PrintNameOffset;'*) +(*$HPPEMIT ' WORD PrintNameLength;'*) +(*$HPPEMIT ' ULONG Flags;'*) +(*$HPPEMIT ' WCHAR PathBuffer[1];'*) +(*$HPPEMIT ' } SymbolicLinkReparseBuffer;'*) +(*$HPPEMIT ''*) +(*$HPPEMIT ' struct {'*) +(*$HPPEMIT ' WORD SubstituteNameOffset;'*) +(*$HPPEMIT ' WORD SubstituteNameLength;'*) +(*$HPPEMIT ' WORD PrintNameOffset;'*) +(*$HPPEMIT ' WORD PrintNameLength;'*) +(*$HPPEMIT ' WCHAR PathBuffer[1];'*) +(*$HPPEMIT ' } MountPointReparseBuffer;'*) +(*$HPPEMIT ''*) +(*$HPPEMIT ' struct {'*) +(*$HPPEMIT ' UCHAR DataBuffer[1];'*) +(*$HPPEMIT ' } GenericReparseBuffer;'*) +(*$HPPEMIT ' };'*) +(*$HPPEMIT ''*) +(*$HPPEMIT '} REPARSE_DATA_BUFFER, *PREPARSE_DATA_BUFFER;'*) +(*$HPPEMIT ''*) +(*$HPPEMIT '#ifndef REPARSE_DATA_BUFFER_HEADER_SIZE'*) +(*$HPPEMIT '#define REPARSE_DATA_BUFFER_HEADER_SIZE 8'*) +(*$HPPEMIT '#endif'*) +(*$HPPEMIT ''*) +(*$HPPEMIT 'typedef struct _REPARSE_POINT_INFORMATION {'*) +(*$HPPEMIT ' WORD ReparseDataLength;'*) +(*$HPPEMIT ' WORD UnparsedNameLength;'*) +(*$HPPEMIT '} REPARSE_POINT_INFORMATION, *PREPARSE_POINT_INFORMATION;'*) +(*$HPPEMIT ''*) +(*$HPPEMIT '#ifndef IO_REPARSE_TAG_VALID_VALUES'*) +(*$HPPEMIT '#define IO_REPARSE_TAG_VALID_VALUES 0x0E000FFFF'*) +(*$HPPEMIT '#endif'*) +(*$HPPEMIT ''*) + +type + {$EXTERNALSYM _REPARSE_DATA_BUFFER} + _REPARSE_DATA_BUFFER = record + ReparseTag: DWORD; + ReparseDataLength: Word; + Reserved: Word; + case Integer of + 0: ( + SymbolicLinkReparseBuffer: record + SubstituteNameOffset: Word; + SubstituteNameLength: Word; + PrintNameOffset: Word; + PrintNameLength: Word; + Flags: ULONG; + PathBuffer: array [0..0] of WCHAR; + end); + 1: ( + MountPointReparseBuffer: record + SubstituteNameOffset: Word; + SubstituteNameLength: Word; + PrintNameOffset: Word; + PrintNameLength: Word; + PathBuffer: array [0..0] of WCHAR; + end); + 2: ( + GenericReparseBuffer: record + DataBuffer: array [0..0] of Byte; + end); + end; + {$EXTERNALSYM REPARSE_DATA_BUFFER} + REPARSE_DATA_BUFFER = _REPARSE_DATA_BUFFER; + {$EXTERNALSYM PREPARSE_DATA_BUFFER} + PREPARSE_DATA_BUFFER = ^_REPARSE_DATA_BUFFER; + TReparseDataBuffer = _REPARSE_DATA_BUFFER; + PReparseDataBuffer = PREPARSE_DATA_BUFFER; + +const + {$EXTERNALSYM REPARSE_DATA_BUFFER_HEADER_SIZE} + REPARSE_DATA_BUFFER_HEADER_SIZE = 8; + +type + {$EXTERNALSYM _REPARSE_POINT_INFORMATION} + _REPARSE_POINT_INFORMATION = record + ReparseDataLength: Word; + UnparsedNameLength: Word; + end; + {$EXTERNALSYM REPARSE_POINT_INFORMATION} + REPARSE_POINT_INFORMATION = _REPARSE_POINT_INFORMATION; + {$EXTERNALSYM PREPARSE_POINT_INFORMATION} + PREPARSE_POINT_INFORMATION = ^_REPARSE_POINT_INFORMATION; + TReparsePointInformation = _REPARSE_POINT_INFORMATION; + PReparsePointInformation = PREPARSE_POINT_INFORMATION; + +const + {$EXTERNALSYM IO_REPARSE_TAG_VALID_VALUES} + IO_REPARSE_TAG_VALID_VALUES = DWORD($E000FFFF); + +//================================================================================================== + +// from JwaWinNT.pas (few declarations from JwaWinType) + +const + MAXLONGLONG = $7fffffffffffffff; + {$EXTERNALSYM MAXLONGLONG} + +{$IFNDEF FPC} +type + ULONGLONG = Int64; + {$EXTERNALSYM ULONGLONG} + PLONGLONG = ^LONGLONG; + {$EXTERNALSYM PLONGLONG} + PULONGLONG = ^ULONGLONG; + {$EXTERNALSYM PULONGLONG} +{$ENDIF ~FPC} + +const + ANYSIZE_ARRAY = 1; + {$EXTERNALSYM ANYSIZE_ARRAY} + + MAX_NATURAL_ALIGNMENT = SizeOf(ULONG); + {$EXTERNALSYM MAX_NATURAL_ALIGNMENT} + +// line 72 + +const + VER_SERVER_NT = DWORD($80000000); + {$EXTERNALSYM VER_SERVER_NT} + VER_WORKSTATION_NT = $40000000; + {$EXTERNALSYM VER_WORKSTATION_NT} + VER_SUITE_SMALLBUSINESS = $00000001; + {$EXTERNALSYM VER_SUITE_SMALLBUSINESS} + VER_SUITE_ENTERPRISE = $00000002; + {$EXTERNALSYM VER_SUITE_ENTERPRISE} + VER_SUITE_BACKOFFICE = $00000004; + {$EXTERNALSYM VER_SUITE_BACKOFFICE} + VER_SUITE_COMMUNICATIONS = $00000008; + {$EXTERNALSYM VER_SUITE_COMMUNICATIONS} + VER_SUITE_TERMINAL = $00000010; + {$EXTERNALSYM VER_SUITE_TERMINAL} + VER_SUITE_SMALLBUSINESS_RESTRICTED = $00000020; + {$EXTERNALSYM VER_SUITE_SMALLBUSINESS_RESTRICTED} + VER_SUITE_EMBEDDEDNT = $00000040; + {$EXTERNALSYM VER_SUITE_EMBEDDEDNT} + VER_SUITE_DATACENTER = $00000080; + {$EXTERNALSYM VER_SUITE_DATACENTER} + VER_SUITE_SINGLEUSERTS = $00000100; + {$EXTERNALSYM VER_SUITE_SINGLEUSERTS} + VER_SUITE_PERSONAL = $00000200; + {$EXTERNALSYM VER_SUITE_PERSONAL} + VER_SUITE_BLADE = $00000400; + {$EXTERNALSYM VER_SUITE_BLADE} + VER_SUITE_EMBEDDED_RESTRICTED = $00000800; + {$EXTERNALSYM VER_SUITE_EMBEDDED_RESTRICTED} + VER_SUITE_SECURITY_APPLIANCE = $00001000; + {$EXTERNALSYM VER_SUITE_SECURITY_APPLIANCE} + VER_SUITE_STORAGE_SERVER = $00002000; + {$EXTERNALSYM VER_SUITE_STORAGE_SERVER} + VER_SUITE_COMPUTE_SERVER = $00004000; + {$EXTERNALSYM VER_SUITE_COMPUTE_SERVER} + +// line 515 + +// +// A language ID is a 16 bit value which is the combination of a +// primary language ID and a secondary language ID. The bits are +// allocated as follows: +// +// +-----------------------+-------------------------+ +// | Sublanguage ID | Primary Language ID | +// +-----------------------+-------------------------+ +// 15 10 9 0 bit +// +// +// Language ID creation/extraction macros: +// +// MAKELANGID - construct language id from a primary language id and +// a sublanguage id. +// PRIMARYLANGID - extract primary language id from a language id. +// SUBLANGID - extract sublanguage id from a language id. +// + +function MAKELANGID(PrimaryLang, SubLang: USHORT): WORD; +{$EXTERNALSYM MAKELANGID} +function PRIMARYLANGID(LangId: WORD): WORD; +{$EXTERNALSYM PRIMARYLANGID} +function SUBLANGID(LangId: WORD): WORD; +{$EXTERNALSYM SUBLANGID} + +// +// A locale ID is a 32 bit value which is the combination of a +// language ID, a sort ID, and a reserved area. The bits are +// allocated as follows: +// +// +-------------+---------+-------------------------+ +// | Reserved | Sort ID | Language ID | +// +-------------+---------+-------------------------+ +// 31 20 19 16 15 0 bit +// +// +// Locale ID creation/extraction macros: +// +// MAKELCID - construct the locale id from a language id and a sort id. +// MAKESORTLCID - construct the locale id from a language id, sort id, and sort version. +// LANGIDFROMLCID - extract the language id from a locale id. +// SORTIDFROMLCID - extract the sort id from a locale id. +// SORTVERSIONFROMLCID - extract the sort version from a locale id. +// + +const + NLS_VALID_LOCALE_MASK = $000fffff; + {$EXTERNALSYM NLS_VALID_LOCALE_MASK} + +function MAKELCID(LangId, SortId: WORD): DWORD; +{$EXTERNALSYM MAKELCID} +function MAKESORTLCID(LangId, SortId, SortVersion: WORD): DWORD; +{$EXTERNALSYM MAKESORTLCID} +function LANGIDFROMLCID(LocaleId: LCID): WORD; +{$EXTERNALSYM LANGIDFROMLCID} +function SORTIDFROMLCID(LocaleId: LCID): WORD; +{$EXTERNALSYM SORTIDFROMLCID} +function SORTVERSIONFROMLCID(LocaleId: LCID): WORD; +{$EXTERNALSYM SORTVERSIONFROMLCID} + +// line 1154 + +//////////////////////////////////////////////////////////////////////// +// // +// Security Id (SID) // +// // +//////////////////////////////////////////////////////////////////////// +// +// +// Pictorially the structure of an SID is as follows: +// +// 1 1 1 1 1 1 +// 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 +// +---------------------------------------------------------------+ +// | SubAuthorityCount |Reserved1 (SBZ)| Revision | +// +---------------------------------------------------------------+ +// | IdentifierAuthority[0] | +// +---------------------------------------------------------------+ +// | IdentifierAuthority[1] | +// +---------------------------------------------------------------+ +// | IdentifierAuthority[2] | +// +---------------------------------------------------------------+ +// | | +// +- - - - - - - - SubAuthority[] - - - - - - - - -+ +// | | +// +---------------------------------------------------------------+ +// +// + +{$IFNDEF FPC} +type + _SID_IDENTIFIER_AUTHORITY = record + Value: array [0..5] of Byte; + end; + {$EXTERNALSYM _SID_IDENTIFIER_AUTHORITY} + SID_IDENTIFIER_AUTHORITY = _SID_IDENTIFIER_AUTHORITY; + {$EXTERNALSYM SID_IDENTIFIER_AUTHORITY} + PSID_IDENTIFIER_AUTHORITY = ^_SID_IDENTIFIER_AUTHORITY; + {$EXTERNALSYM PSID_IDENTIFIER_AUTHORITY} + + // PSid = ^SID; + _SID = record + Revision: Byte; + SubAuthorityCount: Byte; + IdentifierAuthority: SID_IDENTIFIER_AUTHORITY; + SubAuthority: array [0..ANYSIZE_ARRAY - 1] of DWORD; + end; + {$EXTERNALSYM _SID} + SID = _SID; + {$EXTERNALSYM SID} + PPSID = ^PSID; + {$NODEFINE PPSID} + TSid = SID; +{$ENDIF ~FPC} + +const + SID_REVISION = (1); // Current revision level + {$EXTERNALSYM SID_REVISION} + SID_MAX_SUB_AUTHORITIES = (15); + {$EXTERNALSYM SID_MAX_SUB_AUTHORITIES} + SID_RECOMMENDED_SUB_AUTHORITIES = (1); // Will change to around 6 in a future release. + {$EXTERNALSYM SID_RECOMMENDED_SUB_AUTHORITIES} + + SECURITY_MAX_SID_SIZE = SizeOf(SID) - SizeOf(DWORD) + (SID_MAX_SUB_AUTHORITIES * SizeOf(DWORD)); + {$EXTERNALSYM SECURITY_MAX_SID_SIZE} + +{$IFNDEF FPC} + SidTypeUser = 1; + {$EXTERNALSYM SidTypeUser} + SidTypeGroup = 2; + {$EXTERNALSYM SidTypeGroup} + SidTypeDomain = 3; + {$EXTERNALSYM SidTypeDomain} + SidTypeAlias = 4; + {$EXTERNALSYM SidTypeAlias} + SidTypeWellKnownGroup = 5; + {$EXTERNALSYM SidTypeWellKnownGroup} + SidTypeDeletedAccount = 6; + {$EXTERNALSYM SidTypeDeletedAccount} + SidTypeInvalid = 7; + {$EXTERNALSYM SidTypeInvalid} + SidTypeUnknown = 8; + {$EXTERNALSYM SidTypeUnknown} + SidTypeComputer = 9; + {$EXTERNALSYM SidTypeComputer} + +type + _SID_NAME_USE = DWORD; + {$EXTERNALSYM _SID_NAME_USE} +// SID_NAME_USE = _SID_NAME_USE; +// {$EXTERNALSYM SID_NAME_USE} + PSID_NAME_USE = ^SID_NAME_USE; + {$EXTERNALSYM PSID_NAME_USE} + TSidNameUse = SID_NAME_USE; + PSidNameUSe = PSID_NAME_USE; + + PSID_AND_ATTRIBUTES = ^SID_AND_ATTRIBUTES; + {$EXTERNALSYM PSID_AND_ATTRIBUTES} + _SID_AND_ATTRIBUTES = record + Sid: PSID; + Attributes: DWORD; + end; + {$EXTERNALSYM _SID_AND_ATTRIBUTES} + SID_AND_ATTRIBUTES = _SID_AND_ATTRIBUTES; + {$EXTERNALSYM SID_AND_ATTRIBUTES} + TSidAndAttributes = SID_AND_ATTRIBUTES; + PSidAndAttributes = PSID_AND_ATTRIBUTES; + + SID_AND_ATTRIBUTES_ARRAY = array [0..ANYSIZE_ARRAY - 1] of SID_AND_ATTRIBUTES; + {$EXTERNALSYM SID_AND_ATTRIBUTES_ARRAY} + PSID_AND_ATTRIBUTES_ARRAY = ^SID_AND_ATTRIBUTES_ARRAY; + {$EXTERNALSYM PSID_AND_ATTRIBUTES_ARRAY} + PSidAndAttributesArray = ^TSidAndAttributesArray; + TSidAndAttributesArray = SID_AND_ATTRIBUTES_ARRAY; +{$ENDIF ~FPC} + +///////////////////////////////////////////////////////////////////////////// +// // +// Universal well-known SIDs // +// // +// Null SID S-1-0-0 // +// World S-1-1-0 // +// Local S-1-2-0 // +// Creator Owner ID S-1-3-0 // +// Creator Group ID S-1-3-1 // +// Creator Owner Server ID S-1-3-2 // +// Creator Group Server ID S-1-3-3 // +// // +// (Non-unique IDs) S-1-4 // +// // +///////////////////////////////////////////////////////////////////////////// + +const + SECURITY_NULL_SID_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 0)); + {$EXTERNALSYM SECURITY_NULL_SID_AUTHORITY} + SECURITY_WORLD_SID_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 1)); + {$EXTERNALSYM SECURITY_WORLD_SID_AUTHORITY} + SECURITY_LOCAL_SID_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 2)); + {$EXTERNALSYM SECURITY_LOCAL_SID_AUTHORITY} + SECURITY_CREATOR_SID_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 3)); + {$EXTERNALSYM SECURITY_CREATOR_SID_AUTHORITY} + SECURITY_NON_UNIQUE_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 4)); + {$EXTERNALSYM SECURITY_NON_UNIQUE_AUTHORITY} + SECURITY_RESOURCE_MANAGER_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 9)); + {$EXTERNALSYM SECURITY_RESOURCE_MANAGER_AUTHORITY} + + SECURITY_NULL_RID = ($00000000); + {$EXTERNALSYM SECURITY_NULL_RID} + SECURITY_WORLD_RID = ($00000000); + {$EXTERNALSYM SECURITY_WORLD_RID} + SECURITY_LOCAL_RID = ($00000000); + {$EXTERNALSYM SECURITY_LOCAL_RID} + + SECURITY_CREATOR_OWNER_RID = ($00000000); + {$EXTERNALSYM SECURITY_CREATOR_OWNER_RID} + SECURITY_CREATOR_GROUP_RID = ($00000001); + {$EXTERNALSYM SECURITY_CREATOR_GROUP_RID} + + SECURITY_CREATOR_OWNER_SERVER_RID = ($00000002); + {$EXTERNALSYM SECURITY_CREATOR_OWNER_SERVER_RID} + SECURITY_CREATOR_GROUP_SERVER_RID = ($00000003); + {$EXTERNALSYM SECURITY_CREATOR_GROUP_SERVER_RID} + +///////////////////////////////////////////////////////////////////////////// +// // +// NT well-known SIDs // +// // +// NT Authority S-1-5 // +// Dialup S-1-5-1 // +// // +// Network S-1-5-2 // +// Batch S-1-5-3 // +// Interactive S-1-5-4 // +// (Logon IDs) S-1-5-5-X-Y // +// Service S-1-5-6 // +// AnonymousLogon S-1-5-7 (aka null logon session) // +// Proxy S-1-5-8 // +// Enterprise DC (EDC) S-1-5-9 (aka domain controller account) // +// Self S-1-5-10 (self RID) // +// Authenticated User S-1-5-11 (Authenticated user somewhere) // +// Restricted Code S-1-5-12 (Running restricted code) // +// Terminal Server S-1-5-13 (Running on Terminal Server) // +// Remote Logon S-1-5-14 (Remote Interactive Logon) // +// This Organization S-1-5-15 // +// // +// Local System S-1-5-18 // +// Local Service S-1-5-19 // +// Network Service S-1-5-20 // +// // +// (NT non-unique IDs) S-1-5-0x15-... (NT Domain Sids) // +// // +// (Built-in domain) S-1-5-0x20 // +// // +// (Security Package IDs) S-1-5-0x40 // +// NTLM Authentication S-1-5-0x40-10 // +// SChannel Authentication S-1-5-0x40-14 // +// Digest Authentication S-1-5-0x40-21 // +// // +// Other Organization S-1-5-1000 (>=1000 can not be filtered) // +// // +// // +// NOTE: the relative identifier values (RIDs) determine which security // +// boundaries the SID is allowed to cross. Before adding new RIDs, // +// a determination needs to be made regarding which range they should // +// be added to in order to ensure proper "SID filtering" // +// // +///////////////////////////////////////////////////////////////////////////// + +const + SECURITY_NT_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5)); + {$EXTERNALSYM SECURITY_NT_AUTHORITY} + + SECURITY_DIALUP_RID = ($00000001); + {$EXTERNALSYM SECURITY_DIALUP_RID} + SECURITY_NETWORK_RID = ($00000002); + {$EXTERNALSYM SECURITY_NETWORK_RID} + SECURITY_BATCH_RID = ($00000003); + {$EXTERNALSYM SECURITY_BATCH_RID} + SECURITY_INTERACTIVE_RID = ($00000004); + {$EXTERNALSYM SECURITY_INTERACTIVE_RID} + SECURITY_LOGON_IDS_RID = ($00000005); + {$EXTERNALSYM SECURITY_LOGON_IDS_RID} + SECURITY_LOGON_IDS_RID_COUNT = (3); + {$EXTERNALSYM SECURITY_LOGON_IDS_RID_COUNT} + SECURITY_SERVICE_RID = ($00000006); + {$EXTERNALSYM SECURITY_SERVICE_RID} + SECURITY_ANONYMOUS_LOGON_RID = ($00000007); + {$EXTERNALSYM SECURITY_ANONYMOUS_LOGON_RID} + SECURITY_PROXY_RID = ($00000008); + {$EXTERNALSYM SECURITY_PROXY_RID} + SECURITY_ENTERPRISE_CONTROLLERS_RID = ($00000009); + {$EXTERNALSYM SECURITY_ENTERPRISE_CONTROLLERS_RID} + SECURITY_SERVER_LOGON_RID = SECURITY_ENTERPRISE_CONTROLLERS_RID; + {$EXTERNALSYM SECURITY_SERVER_LOGON_RID} + SECURITY_PRINCIPAL_SELF_RID = ($0000000A); + {$EXTERNALSYM SECURITY_PRINCIPAL_SELF_RID} + SECURITY_AUTHENTICATED_USER_RID = ($0000000B); + {$EXTERNALSYM SECURITY_AUTHENTICATED_USER_RID} + SECURITY_RESTRICTED_CODE_RID = ($0000000C); + {$EXTERNALSYM SECURITY_RESTRICTED_CODE_RID} + SECURITY_TERMINAL_SERVER_RID = ($0000000D); + {$EXTERNALSYM SECURITY_TERMINAL_SERVER_RID} + SECURITY_REMOTE_LOGON_RID = ($0000000E); + {$EXTERNALSYM SECURITY_REMOTE_LOGON_RID} + SECURITY_THIS_ORGANIZATION_RID = ($0000000F); + {$EXTERNALSYM SECURITY_THIS_ORGANIZATION_RID} + + SECURITY_LOCAL_SYSTEM_RID = ($00000012); + {$EXTERNALSYM SECURITY_LOCAL_SYSTEM_RID} + SECURITY_LOCAL_SERVICE_RID = ($00000013); + {$EXTERNALSYM SECURITY_LOCAL_SERVICE_RID} + SECURITY_NETWORK_SERVICE_RID = ($00000014); + {$EXTERNALSYM SECURITY_NETWORK_SERVICE_RID} + + SECURITY_NT_NON_UNIQUE = ($00000015); + {$EXTERNALSYM SECURITY_NT_NON_UNIQUE} + SECURITY_NT_NON_UNIQUE_SUB_AUTH_COUNT = (3); + {$EXTERNALSYM SECURITY_NT_NON_UNIQUE_SUB_AUTH_COUNT} + + SECURITY_BUILTIN_DOMAIN_RID = ($00000020); + {$EXTERNALSYM SECURITY_BUILTIN_DOMAIN_RID} + + SECURITY_PACKAGE_BASE_RID = ($00000040); + {$EXTERNALSYM SECURITY_PACKAGE_BASE_RID} + SECURITY_PACKAGE_RID_COUNT = (2); + {$EXTERNALSYM SECURITY_PACKAGE_RID_COUNT} + SECURITY_PACKAGE_NTLM_RID = ($0000000A); + {$EXTERNALSYM SECURITY_PACKAGE_NTLM_RID} + SECURITY_PACKAGE_SCHANNEL_RID = ($0000000E); + {$EXTERNALSYM SECURITY_PACKAGE_SCHANNEL_RID} + SECURITY_PACKAGE_DIGEST_RID = ($00000015); + {$EXTERNALSYM SECURITY_PACKAGE_DIGEST_RID} + + SECURITY_MAX_ALWAYS_FILTERED = ($000003E7); + {$EXTERNALSYM SECURITY_MAX_ALWAYS_FILTERED} + SECURITY_MIN_NEVER_FILTERED = ($000003E8); + {$EXTERNALSYM SECURITY_MIN_NEVER_FILTERED} + + SECURITY_OTHER_ORGANIZATION_RID = ($000003E8); + {$EXTERNALSYM SECURITY_OTHER_ORGANIZATION_RID} + +///////////////////////////////////////////////////////////////////////////// +// // +// well-known domain relative sub-authority values (RIDs)... // +// // +///////////////////////////////////////////////////////////////////////////// + +// Well-known users ... + + FOREST_USER_RID_MAX = ($000001F3); + {$EXTERNALSYM FOREST_USER_RID_MAX} + + DOMAIN_USER_RID_ADMIN = ($000001F4); + {$EXTERNALSYM DOMAIN_USER_RID_ADMIN} + DOMAIN_USER_RID_GUEST = ($000001F5); + {$EXTERNALSYM DOMAIN_USER_RID_GUEST} + DOMAIN_USER_RID_KRBTGT = ($000001F6); + {$EXTERNALSYM DOMAIN_USER_RID_KRBTGT} + + DOMAIN_USER_RID_MAX = ($000003E7); + {$EXTERNALSYM DOMAIN_USER_RID_MAX} + +// well-known groups ... + + DOMAIN_GROUP_RID_ADMINS = ($00000200); + {$EXTERNALSYM DOMAIN_GROUP_RID_ADMINS} + DOMAIN_GROUP_RID_USERS = ($00000201); + {$EXTERNALSYM DOMAIN_GROUP_RID_USERS} + DOMAIN_GROUP_RID_GUESTS = ($00000202); + {$EXTERNALSYM DOMAIN_GROUP_RID_GUESTS} + DOMAIN_GROUP_RID_COMPUTERS = ($00000203); + {$EXTERNALSYM DOMAIN_GROUP_RID_COMPUTERS} + DOMAIN_GROUP_RID_CONTROLLERS = ($00000204); + {$EXTERNALSYM DOMAIN_GROUP_RID_CONTROLLERS} + DOMAIN_GROUP_RID_CERT_ADMINS = ($00000205); + {$EXTERNALSYM DOMAIN_GROUP_RID_CERT_ADMINS} + DOMAIN_GROUP_RID_SCHEMA_ADMINS = ($00000206); + {$EXTERNALSYM DOMAIN_GROUP_RID_SCHEMA_ADMINS} + DOMAIN_GROUP_RID_ENTERPRISE_ADMINS = ($00000207); + {$EXTERNALSYM DOMAIN_GROUP_RID_ENTERPRISE_ADMINS} + DOMAIN_GROUP_RID_POLICY_ADMINS = ($00000208); + {$EXTERNALSYM DOMAIN_GROUP_RID_POLICY_ADMINS} + +// well-known aliases ... + + DOMAIN_ALIAS_RID_ADMINS = ($00000220); + {$EXTERNALSYM DOMAIN_ALIAS_RID_ADMINS} + DOMAIN_ALIAS_RID_USERS = ($00000221); + {$EXTERNALSYM DOMAIN_ALIAS_RID_USERS} + DOMAIN_ALIAS_RID_GUESTS = ($00000222); + {$EXTERNALSYM DOMAIN_ALIAS_RID_GUESTS} + DOMAIN_ALIAS_RID_POWER_USERS = ($00000223); + {$EXTERNALSYM DOMAIN_ALIAS_RID_POWER_USERS} + + DOMAIN_ALIAS_RID_ACCOUNT_OPS = ($00000224); + {$EXTERNALSYM DOMAIN_ALIAS_RID_ACCOUNT_OPS} + DOMAIN_ALIAS_RID_SYSTEM_OPS = ($00000225); + {$EXTERNALSYM DOMAIN_ALIAS_RID_SYSTEM_OPS} + DOMAIN_ALIAS_RID_PRINT_OPS = ($00000226); + {$EXTERNALSYM DOMAIN_ALIAS_RID_PRINT_OPS} + DOMAIN_ALIAS_RID_BACKUP_OPS = ($00000227); + {$EXTERNALSYM DOMAIN_ALIAS_RID_BACKUP_OPS} + + DOMAIN_ALIAS_RID_REPLICATOR = ($00000228); + {$EXTERNALSYM DOMAIN_ALIAS_RID_REPLICATOR} + DOMAIN_ALIAS_RID_RAS_SERVERS = ($00000229); + {$EXTERNALSYM DOMAIN_ALIAS_RID_RAS_SERVERS} + DOMAIN_ALIAS_RID_PREW2KCOMPACCESS = ($0000022A); + {$EXTERNALSYM DOMAIN_ALIAS_RID_PREW2KCOMPACCESS} + DOMAIN_ALIAS_RID_REMOTE_DESKTOP_USERS = ($0000022B); + {$EXTERNALSYM DOMAIN_ALIAS_RID_REMOTE_DESKTOP_USERS} + DOMAIN_ALIAS_RID_NETWORK_CONFIGURATION_OPS = ($0000022C); + {$EXTERNALSYM DOMAIN_ALIAS_RID_NETWORK_CONFIGURATION_OPS} + DOMAIN_ALIAS_RID_INCOMING_FOREST_TRUST_BUILDERS = ($0000022D); + {$EXTERNALSYM DOMAIN_ALIAS_RID_INCOMING_FOREST_TRUST_BUILDERS} + + DOMAIN_ALIAS_RID_MONITORING_USERS = ($0000022E); + {$EXTERNALSYM DOMAIN_ALIAS_RID_MONITORING_USERS} + DOMAIN_ALIAS_RID_LOGGING_USERS = ($0000022F); + {$EXTERNALSYM DOMAIN_ALIAS_RID_LOGGING_USERS} + DOMAIN_ALIAS_RID_AUTHORIZATIONACCESS = ($00000230); + {$EXTERNALSYM DOMAIN_ALIAS_RID_AUTHORIZATIONACCESS} + DOMAIN_ALIAS_RID_TS_LICENSE_SERVERS = ($00000231); + {$EXTERNALSYM DOMAIN_ALIAS_RID_TS_LICENSE_SERVERS} + +// line 2495 + +//////////////////////////////////////////////////////////////////////// +// // +// NT Defined Privileges // +// // +//////////////////////////////////////////////////////////////////////// + +const + SE_CREATE_TOKEN_NAME = 'SeCreateTokenPrivilege'; + {$EXTERNALSYM SE_CREATE_TOKEN_NAME} + SE_ASSIGNPRIMARYTOKEN_NAME = 'SeAssignPrimaryTokenPrivilege'; + {$EXTERNALSYM SE_ASSIGNPRIMARYTOKEN_NAME} + SE_LOCK_MEMORY_NAME = 'SeLockMemoryPrivilege'; + {$EXTERNALSYM SE_LOCK_MEMORY_NAME} + SE_INCREASE_QUOTA_NAME = 'SeIncreaseQuotaPrivilege'; + {$EXTERNALSYM SE_INCREASE_QUOTA_NAME} + SE_UNSOLICITED_INPUT_NAME = 'SeUnsolicitedInputPrivilege'; + {$EXTERNALSYM SE_UNSOLICITED_INPUT_NAME} + SE_MACHINE_ACCOUNT_NAME = 'SeMachineAccountPrivilege'; + {$EXTERNALSYM SE_MACHINE_ACCOUNT_NAME} + SE_TCB_NAME = 'SeTcbPrivilege'; + {$EXTERNALSYM SE_TCB_NAME} + SE_SECURITY_NAME = 'SeSecurityPrivilege'; + {$EXTERNALSYM SE_SECURITY_NAME} + SE_TAKE_OWNERSHIP_NAME = 'SeTakeOwnershipPrivilege'; + {$EXTERNALSYM SE_TAKE_OWNERSHIP_NAME} + SE_LOAD_DRIVER_NAME = 'SeLoadDriverPrivilege'; + {$EXTERNALSYM SE_LOAD_DRIVER_NAME} + SE_SYSTEM_PROFILE_NAME = 'SeSystemProfilePrivilege'; + {$EXTERNALSYM SE_SYSTEM_PROFILE_NAME} + SE_SYSTEMTIME_NAME = 'SeSystemtimePrivilege'; + {$EXTERNALSYM SE_SYSTEMTIME_NAME} + SE_PROF_SINGLE_PROCESS_NAME = 'SeProfileSingleProcessPrivilege'; + {$EXTERNALSYM SE_PROF_SINGLE_PROCESS_NAME} + SE_INC_BASE_PRIORITY_NAME = 'SeIncreaseBasePriorityPrivilege'; + {$EXTERNALSYM SE_INC_BASE_PRIORITY_NAME} + SE_CREATE_PAGEFILE_NAME = 'SeCreatePagefilePrivilege'; + {$EXTERNALSYM SE_CREATE_PAGEFILE_NAME} + SE_CREATE_PERMANENT_NAME = 'SeCreatePermanentPrivilege'; + {$EXTERNALSYM SE_CREATE_PERMANENT_NAME} + SE_BACKUP_NAME = 'SeBackupPrivilege'; + {$EXTERNALSYM SE_BACKUP_NAME} + SE_RESTORE_NAME = 'SeRestorePrivilege'; + {$EXTERNALSYM SE_RESTORE_NAME} + SE_SHUTDOWN_NAME = 'SeShutdownPrivilege'; + {$EXTERNALSYM SE_SHUTDOWN_NAME} + SE_DEBUG_NAME = 'SeDebugPrivilege'; + {$EXTERNALSYM SE_DEBUG_NAME} + SE_AUDIT_NAME = 'SeAuditPrivilege'; + {$EXTERNALSYM SE_AUDIT_NAME} + SE_SYSTEM_ENVIRONMENT_NAME = 'SeSystemEnvironmentPrivilege'; + {$EXTERNALSYM SE_SYSTEM_ENVIRONMENT_NAME} + SE_CHANGE_NOTIFY_NAME = 'SeChangeNotifyPrivilege'; + {$EXTERNALSYM SE_CHANGE_NOTIFY_NAME} + SE_REMOTE_SHUTDOWN_NAME = 'SeRemoteShutdownPrivilege'; + {$EXTERNALSYM SE_REMOTE_SHUTDOWN_NAME} + SE_UNDOCK_NAME = 'SeUndockPrivilege'; + {$EXTERNALSYM SE_UNDOCK_NAME} + SE_SYNC_AGENT_NAME = 'SeSyncAgentPrivilege'; + {$EXTERNALSYM SE_SYNC_AGENT_NAME} + SE_ENABLE_DELEGATION_NAME = 'SeEnableDelegationPrivilege'; + {$EXTERNALSYM SE_ENABLE_DELEGATION_NAME} + SE_MANAGE_VOLUME_NAME = 'SeManageVolumePrivilege'; + {$EXTERNALSYM SE_MANAGE_VOLUME_NAME} + SE_IMPERSONATE_NAME = 'SeImpersonatePrivilege'; + {$EXTERNALSYM SE_IMPERSONATE_NAME} + SE_CREATE_GLOBAL_NAME = 'SeCreateGlobalPrivilege'; + {$EXTERNALSYM SE_CREATE_GLOBAL_NAME} + +// +// Thread Information Block (TIB) +// + +type + NT_TIB32 = packed record + ExceptionList: DWORD; + StackBase: DWORD; + StackLimit: DWORD; + SubSystemTib: DWORD; + case Integer of + 0 : ( + FiberData: DWORD; + ArbitraryUserPointer: DWORD; + Self: DWORD; + ); + 1 : ( + Version: DWORD; + ); + end; + {$EXTERNALSYM NT_TIB32} + PNT_TIB32 = ^NT_TIB32; + {$EXTERNALSYM PNT_TIB32} + + NT_TIB64 = packed record + ExceptionList: TJclAddr64; + StackBase: TJclAddr64; + StackLimit: TJclAddr64; + SubSystemTib: TJclAddr64; + case Integer of + 0 : ( + FiberData: TJclAddr64; + ArbitraryUserPointer: TJclAddr64; + Self: TJclAddr64; + ); + 1 : ( + Version: DWORD; + ); + end; + {$EXTERNALSYM NT_TIB64} + PNT_TIB64 = ^NT_TIB64; + {$EXTERNALSYM PNT_TIB64} + +// line 2686 + +// +// Token information class structures +// + +{$IFNDEF FPC} +type + PTOKEN_USER = ^TOKEN_USER; + {$EXTERNALSYM PTOKEN_USER} + _TOKEN_USER = record + User: SID_AND_ATTRIBUTES; + end; + {$EXTERNALSYM _TOKEN_USER} + TOKEN_USER = _TOKEN_USER; + {$EXTERNALSYM TOKEN_USER} + TTokenUser = TOKEN_USER; + PTokenUser = PTOKEN_USER; +{$ENDIF ~FPC} + +function CaptureStackBackTrace(FramesToSkip, FramesToCapture: DWORD; + BackTrace: Pointer; out BackTraceHash: DWORD): Word; stdcall; +{$EXTERNALSYM CaptureStackBackTrace} + +// line 3858 + +// +// Define access rights to files and directories +// + +// +// The FILE_READ_DATA and FILE_WRITE_DATA constants are also defined in +// devioctl.h as FILE_READ_ACCESS and FILE_WRITE_ACCESS. The values for these +// constants *MUST* always be in sync. +// The values are redefined in devioctl.h because they must be available to +// both DOS and NT. +// + +const + FILE_READ_DATA = ($0001); // file & pipe + {$EXTERNALSYM FILE_READ_DATA} + FILE_LIST_DIRECTORY = ($0001); // directory + {$EXTERNALSYM FILE_LIST_DIRECTORY} + + FILE_WRITE_DATA = ($0002); // file & pipe + {$EXTERNALSYM FILE_WRITE_DATA} + FILE_ADD_FILE = ($0002); // directory + {$EXTERNALSYM FILE_ADD_FILE} + + FILE_APPEND_DATA = ($0004); // file + {$EXTERNALSYM FILE_APPEND_DATA} + FILE_ADD_SUBDIRECTORY = ($0004); // directory + {$EXTERNALSYM FILE_ADD_SUBDIRECTORY} + FILE_CREATE_PIPE_INSTANCE = ($0004); // named pipe + {$EXTERNALSYM FILE_CREATE_PIPE_INSTANCE} + + FILE_READ_EA = ($0008); // file & directory + {$EXTERNALSYM FILE_READ_EA} + + FILE_WRITE_EA = ($0010); // file & directory + {$EXTERNALSYM FILE_WRITE_EA} + + FILE_EXECUTE = ($0020); // file + {$EXTERNALSYM FILE_EXECUTE} + FILE_TRAVERSE = ($0020); // directory + {$EXTERNALSYM FILE_TRAVERSE} + + FILE_DELETE_CHILD = ($0040); // directory + {$EXTERNALSYM FILE_DELETE_CHILD} + + FILE_READ_ATTRIBUTES = ($0080); // all + {$EXTERNALSYM FILE_READ_ATTRIBUTES} + + FILE_WRITE_ATTRIBUTES = ($0100); // all + {$EXTERNALSYM FILE_WRITE_ATTRIBUTES} + + FILE_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or $1FF); + {$EXTERNALSYM FILE_ALL_ACCESS} + + FILE_GENERIC_READ = (STANDARD_RIGHTS_READ or FILE_READ_DATA or + FILE_READ_ATTRIBUTES or FILE_READ_EA or SYNCHRONIZE); + {$EXTERNALSYM FILE_GENERIC_READ} + + FILE_GENERIC_WRITE = (STANDARD_RIGHTS_WRITE or FILE_WRITE_DATA or + FILE_WRITE_ATTRIBUTES or FILE_WRITE_EA or FILE_APPEND_DATA or SYNCHRONIZE); + {$EXTERNALSYM FILE_GENERIC_WRITE} + + FILE_GENERIC_EXECUTE = (STANDARD_RIGHTS_EXECUTE or FILE_READ_ATTRIBUTES or + FILE_EXECUTE or SYNCHRONIZE); + {$EXTERNALSYM FILE_GENERIC_EXECUTE} + + FILE_SHARE_READ = $00000001; + {$EXTERNALSYM FILE_SHARE_READ} + FILE_SHARE_WRITE = $00000002; + {$EXTERNALSYM FILE_SHARE_WRITE} + FILE_SHARE_DELETE = $00000004; + {$EXTERNALSYM FILE_SHARE_DELETE} + FILE_ATTRIBUTE_READONLY = $00000001; + {$EXTERNALSYM FILE_ATTRIBUTE_READONLY} + FILE_ATTRIBUTE_HIDDEN = $00000002; + {$EXTERNALSYM FILE_ATTRIBUTE_HIDDEN} + FILE_ATTRIBUTE_SYSTEM = $00000004; + {$EXTERNALSYM FILE_ATTRIBUTE_SYSTEM} + FILE_ATTRIBUTE_DIRECTORY = $00000010; + {$EXTERNALSYM FILE_ATTRIBUTE_DIRECTORY} + FILE_ATTRIBUTE_ARCHIVE = $00000020; + {$EXTERNALSYM FILE_ATTRIBUTE_ARCHIVE} + FILE_ATTRIBUTE_DEVICE = $00000040; + {$EXTERNALSYM FILE_ATTRIBUTE_DEVICE} + FILE_ATTRIBUTE_NORMAL = $00000080; + {$EXTERNALSYM FILE_ATTRIBUTE_NORMAL} + FILE_ATTRIBUTE_TEMPORARY = $00000100; + {$EXTERNALSYM FILE_ATTRIBUTE_TEMPORARY} + FILE_ATTRIBUTE_SPARSE_FILE = $00000200; + {$EXTERNALSYM FILE_ATTRIBUTE_SPARSE_FILE} + FILE_ATTRIBUTE_REPARSE_POINT = $00000400; + {$EXTERNALSYM FILE_ATTRIBUTE_REPARSE_POINT} + FILE_ATTRIBUTE_COMPRESSED = $00000800; + {$EXTERNALSYM FILE_ATTRIBUTE_COMPRESSED} + FILE_ATTRIBUTE_OFFLINE = $00001000; + {$EXTERNALSYM FILE_ATTRIBUTE_OFFLINE} + FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = $00002000; + {$EXTERNALSYM FILE_ATTRIBUTE_NOT_CONTENT_INDEXED} + FILE_ATTRIBUTE_ENCRYPTED = $00004000; + {$EXTERNALSYM FILE_ATTRIBUTE_ENCRYPTED} + FILE_NOTIFY_CHANGE_FILE_NAME = $00000001; + {$EXTERNALSYM FILE_NOTIFY_CHANGE_FILE_NAME} + FILE_NOTIFY_CHANGE_DIR_NAME = $00000002; + {$EXTERNALSYM FILE_NOTIFY_CHANGE_DIR_NAME} + FILE_NOTIFY_CHANGE_ATTRIBUTES = $00000004; + {$EXTERNALSYM FILE_NOTIFY_CHANGE_ATTRIBUTES} + FILE_NOTIFY_CHANGE_SIZE = $00000008; + {$EXTERNALSYM FILE_NOTIFY_CHANGE_SIZE} + FILE_NOTIFY_CHANGE_LAST_WRITE = $00000010; + {$EXTERNALSYM FILE_NOTIFY_CHANGE_LAST_WRITE} + FILE_NOTIFY_CHANGE_LAST_ACCESS = $00000020; + {$EXTERNALSYM FILE_NOTIFY_CHANGE_LAST_ACCESS} + FILE_NOTIFY_CHANGE_CREATION = $00000040; + {$EXTERNALSYM FILE_NOTIFY_CHANGE_CREATION} + FILE_NOTIFY_CHANGE_SECURITY = $00000100; + {$EXTERNALSYM FILE_NOTIFY_CHANGE_SECURITY} + FILE_ACTION_ADDED = $00000001; + {$EXTERNALSYM FILE_ACTION_ADDED} + FILE_ACTION_REMOVED = $00000002; + {$EXTERNALSYM FILE_ACTION_REMOVED} + FILE_ACTION_MODIFIED = $00000003; + {$EXTERNALSYM FILE_ACTION_MODIFIED} + FILE_ACTION_RENAMED_OLD_NAME = $00000004; + {$EXTERNALSYM FILE_ACTION_RENAMED_OLD_NAME} + FILE_ACTION_RENAMED_NEW_NAME = $00000005; + {$EXTERNALSYM FILE_ACTION_RENAMED_NEW_NAME} + MAILSLOT_NO_MESSAGE = DWORD(-1); + {$EXTERNALSYM MAILSLOT_NO_MESSAGE} + MAILSLOT_WAIT_FOREVER = DWORD(-1); + {$EXTERNALSYM MAILSLOT_WAIT_FOREVER} + FILE_CASE_SENSITIVE_SEARCH = $00000001; + {$EXTERNALSYM FILE_CASE_SENSITIVE_SEARCH} + FILE_CASE_PRESERVED_NAMES = $00000002; + {$EXTERNALSYM FILE_CASE_PRESERVED_NAMES} + FILE_UNICODE_ON_DISK = $00000004; + {$EXTERNALSYM FILE_UNICODE_ON_DISK} + FILE_PERSISTENT_ACLS = $00000008; + {$EXTERNALSYM FILE_PERSISTENT_ACLS} + FILE_FILE_COMPRESSION = $00000010; + {$EXTERNALSYM FILE_FILE_COMPRESSION} + FILE_VOLUME_QUOTAS = $00000020; + {$EXTERNALSYM FILE_VOLUME_QUOTAS} + FILE_SUPPORTS_SPARSE_FILES = $00000040; + {$EXTERNALSYM FILE_SUPPORTS_SPARSE_FILES} + FILE_SUPPORTS_REPARSE_POINTS = $00000080; + {$EXTERNALSYM FILE_SUPPORTS_REPARSE_POINTS} + FILE_SUPPORTS_REMOTE_STORAGE = $00000100; + {$EXTERNALSYM FILE_SUPPORTS_REMOTE_STORAGE} + FILE_VOLUME_IS_COMPRESSED = $00008000; + {$EXTERNALSYM FILE_VOLUME_IS_COMPRESSED} + FILE_SUPPORTS_OBJECT_IDS = $00010000; + {$EXTERNALSYM FILE_SUPPORTS_OBJECT_IDS} + FILE_SUPPORTS_ENCRYPTION = $00020000; + {$EXTERNALSYM FILE_SUPPORTS_ENCRYPTION} + FILE_NAMED_STREAMS = $00040000; + {$EXTERNALSYM FILE_NAMED_STREAMS} + FILE_READ_ONLY_VOLUME = $00080000; + {$EXTERNALSYM FILE_READ_ONLY_VOLUME} + +// line 4052 + +// +// The reparse GUID structure is used by all 3rd party layered drivers to +// store data in a reparse point. For non-Microsoft tags, The GUID field +// cannot be GUID_NULL. +// The constraints on reparse tags are defined below. +// Microsoft tags can also be used with this format of the reparse point buffer. +// + +type + TGenericReparseBuffer = record + DataBuffer: array [0..0] of BYTE; + end; + + PREPARSE_GUID_DATA_BUFFER = ^REPARSE_GUID_DATA_BUFFER; + {$EXTERNALSYM PREPARSE_GUID_DATA_BUFFER} + _REPARSE_GUID_DATA_BUFFER = record + ReparseTag: DWORD; + ReparseDataLength: WORD; + Reserved: WORD; + ReparseGuid: TGUID; + GenericReparseBuffer: TGenericReparseBuffer; + end; + {$EXTERNALSYM _REPARSE_GUID_DATA_BUFFER} + REPARSE_GUID_DATA_BUFFER = _REPARSE_GUID_DATA_BUFFER; + {$EXTERNALSYM REPARSE_GUID_DATA_BUFFER} + TReparseGuidDataBuffer = REPARSE_GUID_DATA_BUFFER; + PReparseGuidDataBuffer = PREPARSE_GUID_DATA_BUFFER; + +const + REPARSE_GUID_DATA_BUFFER_HEADER_SIZE = 24; + {$EXTERNALSYM REPARSE_GUID_DATA_BUFFER_HEADER_SIZE} +// +// Maximum allowed size of the reparse data. +// + +const + MAXIMUM_REPARSE_DATA_BUFFER_SIZE = 16 * 1024; + {$EXTERNALSYM MAXIMUM_REPARSE_DATA_BUFFER_SIZE} + +// +// Predefined reparse tags. +// These tags need to avoid conflicting with IO_REMOUNT defined in ntos\inc\io.h +// + + IO_REPARSE_TAG_RESERVED_ZERO = (0); + {$EXTERNALSYM IO_REPARSE_TAG_RESERVED_ZERO} + IO_REPARSE_TAG_RESERVED_ONE = (1); + {$EXTERNALSYM IO_REPARSE_TAG_RESERVED_ONE} + +// +// The value of the following constant needs to satisfy the following conditions: +// (1) Be at least as large as the largest of the reserved tags. +// (2) Be strictly smaller than all the tags in use. +// + + IO_REPARSE_TAG_RESERVED_RANGE = IO_REPARSE_TAG_RESERVED_ONE; + {$EXTERNALSYM IO_REPARSE_TAG_RESERVED_RANGE} + +// +// The reparse tags are a DWORD. The 32 bits are laid out as follows: +// +// 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 +// 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 +// +-+-+-+-+-----------------------+-------------------------------+ +// |M|R|N|R| Reserved bits | Reparse Tag Value | +// +-+-+-+-+-----------------------+-------------------------------+ +// +// M is the Microsoft bit. When set to 1, it denotes a tag owned by Microsoft. +// All ISVs must use a tag with a 0 in this position. +// Note: If a Microsoft tag is used by non-Microsoft software, the +// behavior is not defined. +// +// R is reserved. Must be zero for non-Microsoft tags. +// +// N is name surrogate. When set to 1, the file represents another named +// entity in the system. +// +// The M and N bits are OR-able. +// The following macros check for the M and N bit values: +// + +// +// Macro to determine whether a reparse point tag corresponds to a tag +// owned by Microsoft. +// + +function IsReparseTagMicrosoft(Tag: ULONG): Boolean; +{$EXTERNALSYM IsReparseTagMicrosoft} + +// +// Macro to determine whether a reparse point tag corresponds to a file +// that is to be displayed with the slow icon overlay. +// + +function IsReparseTagHighLatency(Tag: ULONG): Boolean; +{$EXTERNALSYM IsReparseTagHighLatency} + +// +// Macro to determine whether a reparse point tag is a name surrogate +// + +function IsReparseTagNameSurrogate(Tag: ULONG): Boolean; +{$EXTERNALSYM IsReparseTagNameSurrogate} + +const + IO_REPARSE_TAG_MOUNT_POINT = DWORD($A0000003); + {$EXTERNALSYM IO_REPARSE_TAG_MOUNT_POINT} + IO_REPARSE_TAG_HSM = DWORD($C0000004); + {$EXTERNALSYM IO_REPARSE_TAG_HSM} + IO_REPARSE_TAG_DRIVER_EXTENDER = DWORD($80000005); + {$EXTERNALSYM IO_REPARSE_TAG_DRIVER_EXTENDER} + IO_REPARSE_TAG_HSM2 = DWORD($80000006); + {$EXTERNALSYM IO_REPARSE_TAG_HSM2} + IO_REPARSE_TAG_SIS = DWORD($80000007); + {$EXTERNALSYM IO_REPARSE_TAG_SIS} + IO_REPARSE_TAG_DFS = DWORD($8000000A); + {$EXTERNALSYM IO_REPARSE_TAG_DFS} + IO_REPARSE_TAG_FILTER_MANAGER = DWORD($8000000B); + {$EXTERNALSYM IO_REPARSE_TAG_FILTER_MANAGER} + IO_REPARSE_TAG_SYMLINK = DWORD($A000000C); + {$EXTERNALSYM IO_REPARSE_TAG_SYMLINK} + IO_REPARSE_TAG_DFSR = DWORD($80000012); + {$EXTERNALSYM IO_REPARSE_TAG_DFSR} + IO_REPARSE_TAG_NFS = DWORD($80000014); + {$EXTERNALSYM IO_REPARSE_TAG_NFS} + + IO_COMPLETION_MODIFY_STATE = $0002; + {$EXTERNALSYM IO_COMPLETION_MODIFY_STATE} + IO_COMPLETION_ALL_ACCESS = DWORD(STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or $3); + {$EXTERNALSYM IO_COMPLETION_ALL_ACCESS} + + DUPLICATE_CLOSE_SOURCE = $00000001; + {$EXTERNALSYM DUPLICATE_CLOSE_SOURCE} + DUPLICATE_SAME_ACCESS = $00000002; + {$EXTERNALSYM DUPLICATE_SAME_ACCESS} + +// line 4763 + +// +// File header format. +// + +{$IFNDEF FPC} +type + PIMAGE_FILE_HEADER = ^IMAGE_FILE_HEADER; + {$EXTERNALSYM PIMAGE_FILE_HEADER} + _IMAGE_FILE_HEADER = record + Machine: WORD; + NumberOfSections: WORD; + TimeDateStamp: DWORD; + PointerToSymbolTable: DWORD; + NumberOfSymbols: DWORD; + SizeOfOptionalHeader: WORD; + Characteristics: WORD; + end; + {$EXTERNALSYM _IMAGE_FILE_HEADER} + IMAGE_FILE_HEADER = _IMAGE_FILE_HEADER; + {$EXTERNALSYM IMAGE_FILE_HEADER} + TImageFileHeader = IMAGE_FILE_HEADER; + PImageFileHeader = PIMAGE_FILE_HEADER; +{$ENDIF ~FPC} + +const + IMAGE_SIZEOF_FILE_HEADER = 20; + {$EXTERNALSYM IMAGE_SIZEOF_FILE_HEADER} + + IMAGE_FILE_RELOCS_STRIPPED = $0001; // Relocation info stripped from file. + {$EXTERNALSYM IMAGE_FILE_RELOCS_STRIPPED} + IMAGE_FILE_EXECUTABLE_IMAGE = $0002; // File is executable (i.e. no unresolved externel references). + {$EXTERNALSYM IMAGE_FILE_EXECUTABLE_IMAGE} + IMAGE_FILE_LINE_NUMS_STRIPPED = $0004; // Line nunbers stripped from file. + {$EXTERNALSYM IMAGE_FILE_LINE_NUMS_STRIPPED} + IMAGE_FILE_LOCAL_SYMS_STRIPPED = $0008; // Local symbols stripped from file. + {$EXTERNALSYM IMAGE_FILE_LOCAL_SYMS_STRIPPED} + IMAGE_FILE_AGGRESIVE_WS_TRIM = $0010; // Agressively trim working set + {$EXTERNALSYM IMAGE_FILE_AGGRESIVE_WS_TRIM} + IMAGE_FILE_LARGE_ADDRESS_AWARE = $0020; // App can handle >2gb addresses + {$EXTERNALSYM IMAGE_FILE_LARGE_ADDRESS_AWARE} + IMAGE_FILE_BYTES_REVERSED_LO = $0080; // Bytes of machine word are reversed. + {$EXTERNALSYM IMAGE_FILE_BYTES_REVERSED_LO} + IMAGE_FILE_32BIT_MACHINE = $0100; // 32 bit word machine. + {$EXTERNALSYM IMAGE_FILE_32BIT_MACHINE} + IMAGE_FILE_DEBUG_STRIPPED = $0200; // Debugging info stripped from file in .DBG file + {$EXTERNALSYM IMAGE_FILE_DEBUG_STRIPPED} + IMAGE_FILE_REMOVABLE_RUN_FROM_SWAP = $0400; // If Image is on removable media, copy and run from the swap file. + {$EXTERNALSYM IMAGE_FILE_REMOVABLE_RUN_FROM_SWAP} + IMAGE_FILE_NET_RUN_FROM_SWAP = $0800; // If Image is on Net, copy and run from the swap file. + {$EXTERNALSYM IMAGE_FILE_NET_RUN_FROM_SWAP} + IMAGE_FILE_SYSTEM = $1000; // System File. + {$EXTERNALSYM IMAGE_FILE_SYSTEM} + IMAGE_FILE_DLL = $2000; // File is a DLL. + {$EXTERNALSYM IMAGE_FILE_DLL} + IMAGE_FILE_UP_SYSTEM_ONLY = $4000; // File should only be run on a UP machine + {$EXTERNALSYM IMAGE_FILE_UP_SYSTEM_ONLY} + IMAGE_FILE_BYTES_REVERSED_HI = $8000; // Bytes of machine word are reversed. + {$EXTERNALSYM IMAGE_FILE_BYTES_REVERSED_HI} + + IMAGE_FILE_MACHINE_UNKNOWN = 0; + {$EXTERNALSYM IMAGE_FILE_MACHINE_UNKNOWN} + IMAGE_FILE_MACHINE_I386 = $014c; // Intel 386. + {$EXTERNALSYM IMAGE_FILE_MACHINE_I386} + IMAGE_FILE_MACHINE_R3000 = $0162; // MIPS little-endian, 0x160 big-endian + {$EXTERNALSYM IMAGE_FILE_MACHINE_R3000} + IMAGE_FILE_MACHINE_R4000 = $0166; // MIPS little-endian + {$EXTERNALSYM IMAGE_FILE_MACHINE_R4000} + IMAGE_FILE_MACHINE_R10000 = $0168; // MIPS little-endian + {$EXTERNALSYM IMAGE_FILE_MACHINE_R10000} + IMAGE_FILE_MACHINE_WCEMIPSV2 = $0169; // MIPS little-endian WCE v2 + {$EXTERNALSYM IMAGE_FILE_MACHINE_WCEMIPSV2} + IMAGE_FILE_MACHINE_ALPHA = $0184; // Alpha_AXP + {$EXTERNALSYM IMAGE_FILE_MACHINE_ALPHA} + IMAGE_FILE_MACHINE_SH3 = $01a2; // SH3 little-endian + {$EXTERNALSYM IMAGE_FILE_MACHINE_SH3} + IMAGE_FILE_MACHINE_SH3DSP = $01a3; + {$EXTERNALSYM IMAGE_FILE_MACHINE_SH3DSP} + IMAGE_FILE_MACHINE_SH3E = $01a4; // SH3E little-endian + {$EXTERNALSYM IMAGE_FILE_MACHINE_SH3E} + IMAGE_FILE_MACHINE_SH4 = $01a6; // SH4 little-endian + {$EXTERNALSYM IMAGE_FILE_MACHINE_SH4} + IMAGE_FILE_MACHINE_SH5 = $01a8; // SH5 + {$EXTERNALSYM IMAGE_FILE_MACHINE_SH5} + IMAGE_FILE_MACHINE_ARM = $01c0; // ARM Little-Endian + {$EXTERNALSYM IMAGE_FILE_MACHINE_ARM} + IMAGE_FILE_MACHINE_THUMB = $01c2; + {$EXTERNALSYM IMAGE_FILE_MACHINE_THUMB} + IMAGE_FILE_MACHINE_AM33 = $01d3; + {$EXTERNALSYM IMAGE_FILE_MACHINE_AM33} + IMAGE_FILE_MACHINE_POWERPC = $01F0; // IBM PowerPC Little-Endian + {$EXTERNALSYM IMAGE_FILE_MACHINE_POWERPC} + IMAGE_FILE_MACHINE_POWERPCFP = $01f1; + {$EXTERNALSYM IMAGE_FILE_MACHINE_POWERPCFP} + IMAGE_FILE_MACHINE_IA64 = $0200; // Intel 64 + {$EXTERNALSYM IMAGE_FILE_MACHINE_IA64} + IMAGE_FILE_MACHINE_MIPS16 = $0266; // MIPS + {$EXTERNALSYM IMAGE_FILE_MACHINE_MIPS16} + IMAGE_FILE_MACHINE_ALPHA64 = $0284; // ALPHA64 + {$EXTERNALSYM IMAGE_FILE_MACHINE_ALPHA64} + IMAGE_FILE_MACHINE_MIPSFPU = $0366; // MIPS + {$EXTERNALSYM IMAGE_FILE_MACHINE_MIPSFPU} + IMAGE_FILE_MACHINE_MIPSFPU16 = $0466; // MIPS + {$EXTERNALSYM IMAGE_FILE_MACHINE_MIPSFPU16} + IMAGE_FILE_MACHINE_AXP64 = IMAGE_FILE_MACHINE_ALPHA64; + {$EXTERNALSYM IMAGE_FILE_MACHINE_AXP64} + IMAGE_FILE_MACHINE_TRICORE = $0520; // Infineon + {$EXTERNALSYM IMAGE_FILE_MACHINE_TRICORE} + IMAGE_FILE_MACHINE_CEF = $0CEF; + {$EXTERNALSYM IMAGE_FILE_MACHINE_CEF} + IMAGE_FILE_MACHINE_EBC = $0EBC; // EFI Byte Code + {$EXTERNALSYM IMAGE_FILE_MACHINE_EBC} + IMAGE_FILE_MACHINE_AMD64 = $8664; // AMD64 (K8) + {$EXTERNALSYM IMAGE_FILE_MACHINE_AMD64} + IMAGE_FILE_MACHINE_M32R = $9041; // M32R little-endian + {$EXTERNALSYM IMAGE_FILE_MACHINE_M32R} + IMAGE_FILE_MACHINE_CEE = $C0EE; + {$EXTERNALSYM IMAGE_FILE_MACHINE_CEE} + +// +// Directory format. +// + +const + IMAGE_NUMBEROF_DIRECTORY_ENTRIES = 16; + {$EXTERNALSYM IMAGE_NUMBEROF_DIRECTORY_ENTRIES} + +// +// Optional header format. +// + +{$IFNDEF FPC} +type + PIMAGE_OPTIONAL_HEADER32 = ^IMAGE_OPTIONAL_HEADER32; + {$EXTERNALSYM PIMAGE_OPTIONAL_HEADER32} + + IMAGE_OPTIONAL_HEADER32 = _IMAGE_OPTIONAL_HEADER; + {$EXTERNALSYM IMAGE_OPTIONAL_HEADER32} + TImageOptionalHeader32 = IMAGE_OPTIONAL_HEADER32; + PImageOptionalHeader32 = PIMAGE_OPTIONAL_HEADER32; + + PIMAGE_ROM_OPTIONAL_HEADER = ^IMAGE_ROM_OPTIONAL_HEADER; + {$EXTERNALSYM PIMAGE_ROM_OPTIONAL_HEADER} + _IMAGE_ROM_OPTIONAL_HEADER = record + Magic: Word; + MajorLinkerVersion: Byte; + MinorLinkerVersion: Byte; + SizeOfCode: DWORD; + SizeOfInitializedData: DWORD; + SizeOfUninitializedData: DWORD; + AddressOfEntryPoint: DWORD; + BaseOfCode: DWORD; + BaseOfData: DWORD; + BaseOfBss: DWORD; + GprMask: DWORD; + CprMask: array [0..3] of DWORD; + GpValue: DWORD; + end; + {$EXTERNALSYM _IMAGE_ROM_OPTIONAL_HEADER} + IMAGE_ROM_OPTIONAL_HEADER = _IMAGE_ROM_OPTIONAL_HEADER; + {$EXTERNALSYM IMAGE_ROM_OPTIONAL_HEADER} + TImageRomOptionalHeader = IMAGE_ROM_OPTIONAL_HEADER; + PImageRomOptionalHeader = PIMAGE_ROM_OPTIONAL_HEADER; + + PIMAGE_OPTIONAL_HEADER64 = ^IMAGE_OPTIONAL_HEADER64; + {$EXTERNALSYM PIMAGE_OPTIONAL_HEADER64} + _IMAGE_OPTIONAL_HEADER64 = record + Magic: Word; + MajorLinkerVersion: Byte; + MinorLinkerVersion: Byte; + SizeOfCode: DWORD; + SizeOfInitializedData: DWORD; + SizeOfUninitializedData: DWORD; + AddressOfEntryPoint: DWORD; + BaseOfCode: DWORD; + ImageBase: Int64; + SectionAlignment: DWORD; + FileAlignment: DWORD; + MajorOperatingSystemVersion: Word; + MinorOperatingSystemVersion: Word; + MajorImageVersion: Word; + MinorImageVersion: Word; + MajorSubsystemVersion: Word; + MinorSubsystemVersion: Word; + Win32VersionValue: DWORD; + SizeOfImage: DWORD; + SizeOfHeaders: DWORD; + CheckSum: DWORD; + Subsystem: Word; + DllCharacteristics: Word; + SizeOfStackReserve: Int64; + SizeOfStackCommit: Int64; + SizeOfHeapReserve: Int64; + SizeOfHeapCommit: Int64; + LoaderFlags: DWORD; + NumberOfRvaAndSizes: DWORD; + DataDirectory: array [0..IMAGE_NUMBEROF_DIRECTORY_ENTRIES - 1] of IMAGE_DATA_DIRECTORY; + end; + {$EXTERNALSYM _IMAGE_OPTIONAL_HEADER64} + IMAGE_OPTIONAL_HEADER64 = _IMAGE_OPTIONAL_HEADER64; + {$EXTERNALSYM IMAGE_OPTIONAL_HEADER64} + TImageOptionalHeader64 = IMAGE_OPTIONAL_HEADER64; + PImageOptionalHeader64 = PIMAGE_OPTIONAL_HEADER64; +{$ENDIF ~FPC} + +const + IMAGE_SIZEOF_ROM_OPTIONAL_HEADER = 56; + {$EXTERNALSYM IMAGE_SIZEOF_ROM_OPTIONAL_HEADER} + IMAGE_SIZEOF_STD_OPTIONAL_HEADER = 28; + {$EXTERNALSYM IMAGE_SIZEOF_STD_OPTIONAL_HEADER} + IMAGE_SIZEOF_NT_OPTIONAL32_HEADER = 224; + {$EXTERNALSYM IMAGE_SIZEOF_NT_OPTIONAL32_HEADER} + IMAGE_SIZEOF_NT_OPTIONAL64_HEADER = 240; + {$EXTERNALSYM IMAGE_SIZEOF_NT_OPTIONAL64_HEADER} + + IMAGE_NT_OPTIONAL_HDR32_MAGIC = $10b; + {$EXTERNALSYM IMAGE_NT_OPTIONAL_HDR32_MAGIC} + IMAGE_NT_OPTIONAL_HDR64_MAGIC = $20b; + {$EXTERNALSYM IMAGE_NT_OPTIONAL_HDR64_MAGIC} + IMAGE_ROM_OPTIONAL_HDR_MAGIC = $107; + {$EXTERNALSYM IMAGE_ROM_OPTIONAL_HDR_MAGIC} + +(* +type + IMAGE_OPTIONAL_HEADER = IMAGE_OPTIONAL_HEADER32; + {$EXTERNALSYM IMAGE_OPTIONAL_HEADER} + PIMAGE_OPTIONAL_HEADER = PIMAGE_OPTIONAL_HEADER32; + {$EXTERNALSYM PIMAGE_OPTIONAL_HEADER} +*) + +const + IMAGE_SIZEOF_NT_OPTIONAL_HEADER = IMAGE_SIZEOF_NT_OPTIONAL32_HEADER; + {$EXTERNALSYM IMAGE_SIZEOF_NT_OPTIONAL_HEADER} + IMAGE_NT_OPTIONAL_HDR_MAGIC = IMAGE_NT_OPTIONAL_HDR32_MAGIC; + {$EXTERNALSYM IMAGE_NT_OPTIONAL_HDR_MAGIC} + +{$IFNDEF FPC} +type + PIMAGE_NT_HEADERS64 = ^IMAGE_NT_HEADERS64; + {$EXTERNALSYM PIMAGE_NT_HEADERS64} + _IMAGE_NT_HEADERS64 = record + Signature: DWORD; + FileHeader: IMAGE_FILE_HEADER; + OptionalHeader: IMAGE_OPTIONAL_HEADER64; + end; + {$EXTERNALSYM _IMAGE_NT_HEADERS64} + IMAGE_NT_HEADERS64 = _IMAGE_NT_HEADERS64; + {$EXTERNALSYM IMAGE_NT_HEADERS64} + TImageNtHeaders64 = IMAGE_NT_HEADERS64; + PImageNtHeaders64 = PIMAGE_NT_HEADERS64; + + PIMAGE_NT_HEADERS32 = ^IMAGE_NT_HEADERS32; + {$EXTERNALSYM PIMAGE_NT_HEADERS32} + _IMAGE_NT_HEADERS = record + Signature: DWORD; + FileHeader: IMAGE_FILE_HEADER; + OptionalHeader: IMAGE_OPTIONAL_HEADER32; + end; + {$EXTERNALSYM _IMAGE_NT_HEADERS} + IMAGE_NT_HEADERS32 = _IMAGE_NT_HEADERS; + {$EXTERNALSYM IMAGE_NT_HEADERS32} + TImageNtHeaders32 = IMAGE_NT_HEADERS32; + PImageNtHeaders32 = PIMAGE_NT_HEADERS32; +{$ENDIF ~FPC} + +// Subsystem Values + +const + IMAGE_SUBSYSTEM_UNKNOWN = 0; // Unknown subsystem. + {$EXTERNALSYM IMAGE_SUBSYSTEM_UNKNOWN} + IMAGE_SUBSYSTEM_NATIVE = 1; // Image doesn't require a subsystem. + {$EXTERNALSYM IMAGE_SUBSYSTEM_NATIVE} + IMAGE_SUBSYSTEM_WINDOWS_GUI = 2; // Image runs in the Windows GUI subsystem. + {$EXTERNALSYM IMAGE_SUBSYSTEM_WINDOWS_GUI} + IMAGE_SUBSYSTEM_WINDOWS_CUI = 3; // Image runs in the Windows character subsystem. + {$EXTERNALSYM IMAGE_SUBSYSTEM_WINDOWS_CUI} + IMAGE_SUBSYSTEM_OS2_CUI = 5; // image runs in the OS/2 character subsystem. + {$EXTERNALSYM IMAGE_SUBSYSTEM_OS2_CUI} + IMAGE_SUBSYSTEM_POSIX_CUI = 7; // image runs in the Posix character subsystem. + {$EXTERNALSYM IMAGE_SUBSYSTEM_POSIX_CUI} + IMAGE_SUBSYSTEM_NATIVE_WINDOWS = 8; // image is a native Win9x driver. + {$EXTERNALSYM IMAGE_SUBSYSTEM_NATIVE_WINDOWS} + IMAGE_SUBSYSTEM_WINDOWS_CE_GUI = 9; // Image runs in the Windows CE subsystem. + {$EXTERNALSYM IMAGE_SUBSYSTEM_WINDOWS_CE_GUI} + IMAGE_SUBSYSTEM_EFI_APPLICATION = 10; + {$EXTERNALSYM IMAGE_SUBSYSTEM_EFI_APPLICATION} + IMAGE_SUBSYSTEM_EFI_BOOT_SERVICE_DRIVER = 11; + {$EXTERNALSYM IMAGE_SUBSYSTEM_EFI_BOOT_SERVICE_DRIVER} + IMAGE_SUBSYSTEM_EFI_RUNTIME_DRIVER = 12; + {$EXTERNALSYM IMAGE_SUBSYSTEM_EFI_RUNTIME_DRIVER} + IMAGE_SUBSYSTEM_EFI_ROM = 13; + {$EXTERNALSYM IMAGE_SUBSYSTEM_EFI_ROM} + IMAGE_SUBSYSTEM_XBOX = 14; + {$EXTERNALSYM IMAGE_SUBSYSTEM_XBOX} + +// DllCharacteristics Entries + +// IMAGE_LIBRARY_PROCESS_INIT 0x0001 // Reserved. +// IMAGE_LIBRARY_PROCESS_TERM 0x0002 // Reserved. +// IMAGE_LIBRARY_THREAD_INIT 0x0004 // Reserved. +// IMAGE_LIBRARY_THREAD_TERM 0x0008 // Reserved. + IMAGE_DLLCHARACTERISTICS_NO_ISOLATION = $0200; // Image understands isolation and doesn't want it + {$EXTERNALSYM IMAGE_DLLCHARACTERISTICS_NO_ISOLATION} + IMAGE_DLLCHARACTERISTICS_NO_SEH = $0400; // Image does not use SEH. No SE handler may reside in this image + {$EXTERNALSYM IMAGE_DLLCHARACTERISTICS_NO_SEH} + IMAGE_DLLCHARACTERISTICS_NO_BIND = $0800; // Do not bind this image. + {$EXTERNALSYM IMAGE_DLLCHARACTERISTICS_NO_BIND} + +// 0x1000 // Reserved. + + IMAGE_DLLCHARACTERISTICS_WDM_DRIVER = $2000; // Driver uses WDM model + {$EXTERNALSYM IMAGE_DLLCHARACTERISTICS_WDM_DRIVER} + +// 0x4000 // Reserved. + + IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE = $8000; + {$EXTERNALSYM IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE} + +// Directory Entries + + IMAGE_DIRECTORY_ENTRY_EXPORT = 0; // Export Directory + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_EXPORT} + IMAGE_DIRECTORY_ENTRY_IMPORT = 1; // Import Directory + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_IMPORT} + IMAGE_DIRECTORY_ENTRY_RESOURCE = 2; // Resource Directory + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_RESOURCE} + IMAGE_DIRECTORY_ENTRY_EXCEPTION = 3; // Exception Directory + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_EXCEPTION} + IMAGE_DIRECTORY_ENTRY_SECURITY = 4; // Security Directory + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_SECURITY} + IMAGE_DIRECTORY_ENTRY_BASERELOC = 5; // Base Relocation Table + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_BASERELOC} + IMAGE_DIRECTORY_ENTRY_DEBUG = 6; // Debug Directory + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_DEBUG} + +// IMAGE_DIRECTORY_ENTRY_COPYRIGHT 7 // (X86 usage) + + IMAGE_DIRECTORY_ENTRY_ARCHITECTURE = 7; // Architecture Specific Data + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_ARCHITECTURE} + IMAGE_DIRECTORY_ENTRY_GLOBALPTR = 8; // RVA of GP + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_GLOBALPTR} + IMAGE_DIRECTORY_ENTRY_TLS = 9; // TLS Directory + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_TLS} + IMAGE_DIRECTORY_ENTRY_LOAD_CONFIG = 10; // Load Configuration Directory + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_LOAD_CONFIG} + IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT = 11; // Bound Import Directory in headers + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT} + IMAGE_DIRECTORY_ENTRY_IAT = 12; // Import Address Table + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_IAT} + IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT = 13; // Delay Load Import Descriptors + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT} + IMAGE_DIRECTORY_ENTRY_COM_DESCRIPTOR = 14; // COM Runtime descriptor + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_COM_DESCRIPTOR} + +// +// Non-COFF Object file header +// + +type + PAnonObjectHeader = ^ANON_OBJECT_HEADER; + ANON_OBJECT_HEADER = record + Sig1: Word; // Must be IMAGE_FILE_MACHINE_UNKNOWN + Sig2: Word; // Must be 0xffff + Version: Word; // >= 1 (implies the CLSID field is present) + Machine: Word; + TimeDateStamp: DWORD; + ClassID: TCLSID; // Used to invoke CoCreateInstance + SizeOfData: DWORD; // Size of data that follows the header + end; + {$EXTERNALSYM ANON_OBJECT_HEADER} + TAnonObjectHeader = ANON_OBJECT_HEADER; + +// +// Section header format. +// + +const + IMAGE_SIZEOF_SHORT_NAME = 8; + {$EXTERNALSYM IMAGE_SIZEOF_SHORT_NAME} + +type + PPImageSectionHeader = ^PImageSectionHeader; + +// IMAGE_FIRST_SECTION doesn't need 32/64 versions since the file header is the same either way. + +function IMAGE_FIRST_SECTION(NtHeader: PImageNtHeaders): PImageSectionHeader; +{$EXTERNALSYM IMAGE_FIRST_SECTION} + +const + IMAGE_SIZEOF_SECTION_HEADER = 40; + {$EXTERNALSYM IMAGE_SIZEOF_SECTION_HEADER} + +// +// Section characteristics. +// +// IMAGE_SCN_TYPE_REG 0x00000000 // Reserved. +// IMAGE_SCN_TYPE_DSECT 0x00000001 // Reserved. +// IMAGE_SCN_TYPE_NOLOAD 0x00000002 // Reserved. +// IMAGE_SCN_TYPE_GROUP 0x00000004 // Reserved. + + IMAGE_SCN_TYPE_NO_PAD = $00000008; // Reserved. + {$EXTERNALSYM IMAGE_SCN_TYPE_NO_PAD} + +// IMAGE_SCN_TYPE_COPY 0x00000010 // Reserved. + + IMAGE_SCN_CNT_CODE = $00000020; // Section contains code. + {$EXTERNALSYM IMAGE_SCN_CNT_CODE} + IMAGE_SCN_CNT_INITIALIZED_DATA = $00000040; // Section contains initialized data. + {$EXTERNALSYM IMAGE_SCN_CNT_INITIALIZED_DATA} + IMAGE_SCN_CNT_UNINITIALIZED_DATA = $00000080; // Section contains uninitialized data. + {$EXTERNALSYM IMAGE_SCN_CNT_UNINITIALIZED_DATA} + + IMAGE_SCN_LNK_OTHER = $00000100; // Reserved. + {$EXTERNALSYM IMAGE_SCN_LNK_OTHER} + IMAGE_SCN_LNK_INFO = $00000200; // Section contains comments or some other type of information. + {$EXTERNALSYM IMAGE_SCN_LNK_INFO} + +// IMAGE_SCN_TYPE_OVER 0x00000400 // Reserved. + + IMAGE_SCN_LNK_REMOVE = $00000800; // Section contents will not become part of image. + {$EXTERNALSYM IMAGE_SCN_LNK_REMOVE} + IMAGE_SCN_LNK_COMDAT = $00001000; // Section contents comdat. + {$EXTERNALSYM IMAGE_SCN_LNK_COMDAT} + +// 0x00002000 // Reserved. +// IMAGE_SCN_MEM_PROTECTED - Obsolete 0x00004000 + + IMAGE_SCN_NO_DEFER_SPEC_EXC = $00004000; // Reset speculative exceptions handling bits in the TLB entries for this section. + {$EXTERNALSYM IMAGE_SCN_NO_DEFER_SPEC_EXC} + IMAGE_SCN_GPREL = $00008000; // Section content can be accessed relative to GP + {$EXTERNALSYM IMAGE_SCN_GPREL} + IMAGE_SCN_MEM_FARDATA = $00008000; + {$EXTERNALSYM IMAGE_SCN_MEM_FARDATA} + +// IMAGE_SCN_MEM_SYSHEAP - Obsolete 0x00010000 + + IMAGE_SCN_MEM_PURGEABLE = $00020000; + {$EXTERNALSYM IMAGE_SCN_MEM_PURGEABLE} + IMAGE_SCN_MEM_16BIT = $00020000; + {$EXTERNALSYM IMAGE_SCN_MEM_16BIT} + IMAGE_SCN_MEM_LOCKED = $00040000; + {$EXTERNALSYM IMAGE_SCN_MEM_LOCKED} + IMAGE_SCN_MEM_PRELOAD = $00080000; + {$EXTERNALSYM IMAGE_SCN_MEM_PRELOAD} + + IMAGE_SCN_ALIGN_1BYTES = $00100000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_1BYTES} + IMAGE_SCN_ALIGN_2BYTES = $00200000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_2BYTES} + IMAGE_SCN_ALIGN_4BYTES = $00300000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_4BYTES} + IMAGE_SCN_ALIGN_8BYTES = $00400000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_8BYTES} + IMAGE_SCN_ALIGN_16BYTES = $00500000; // Default alignment if no others are specified. + {$EXTERNALSYM IMAGE_SCN_ALIGN_16BYTES} + IMAGE_SCN_ALIGN_32BYTES = $00600000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_32BYTES} + IMAGE_SCN_ALIGN_64BYTES = $00700000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_64BYTES} + IMAGE_SCN_ALIGN_128BYTES = $00800000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_128BYTES} + IMAGE_SCN_ALIGN_256BYTES = $00900000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_256BYTES} + IMAGE_SCN_ALIGN_512BYTES = $00A00000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_512BYTES} + IMAGE_SCN_ALIGN_1024BYTES = $00B00000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_1024BYTES} + IMAGE_SCN_ALIGN_2048BYTES = $00C00000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_2048BYTES} + IMAGE_SCN_ALIGN_4096BYTES = $00D00000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_4096BYTES} + IMAGE_SCN_ALIGN_8192BYTES = $00E00000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_8192BYTES} + +// Unused 0x00F00000 + + IMAGE_SCN_ALIGN_MASK = $00F00000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_MASK} + + IMAGE_SCN_LNK_NRELOC_OVFL = $01000000; // Section contains extended relocations. + {$EXTERNALSYM IMAGE_SCN_LNK_NRELOC_OVFL} + IMAGE_SCN_MEM_DISCARDABLE = $02000000; // Section can be discarded. + {$EXTERNALSYM IMAGE_SCN_MEM_DISCARDABLE} + IMAGE_SCN_MEM_NOT_CACHED = $04000000; // Section is not cachable. + {$EXTERNALSYM IMAGE_SCN_MEM_NOT_CACHED} + IMAGE_SCN_MEM_NOT_PAGED = $08000000; // Section is not pageable. + {$EXTERNALSYM IMAGE_SCN_MEM_NOT_PAGED} + IMAGE_SCN_MEM_SHARED = $10000000; // Section is shareable. + {$EXTERNALSYM IMAGE_SCN_MEM_SHARED} + IMAGE_SCN_MEM_EXECUTE = $20000000; // Section is executable. + {$EXTERNALSYM IMAGE_SCN_MEM_EXECUTE} + IMAGE_SCN_MEM_READ = $40000000; // Section is readable. + {$EXTERNALSYM IMAGE_SCN_MEM_READ} + IMAGE_SCN_MEM_WRITE = DWORD($80000000); // Section is writeable. + {$EXTERNALSYM IMAGE_SCN_MEM_WRITE} + +// line 6232 + +// +// Line number format. +// + +type + TImgLineNoType = record + case Integer of + 0: (SymbolTableIndex: DWORD); // Symbol table index of function name if Linenumber is 0. + 1: (VirtualAddress: DWORD); // Virtual address of line number. + end; + + PIMAGE_LINENUMBER = ^IMAGE_LINENUMBER; + {$EXTERNALSYM PIMAGE_LINENUMBER} + _IMAGE_LINENUMBER = record + Type_: TImgLineNoType; + Linenumber: WORD; // Line number. + end; + {$EXTERNALSYM _IMAGE_LINENUMBER} + IMAGE_LINENUMBER = _IMAGE_LINENUMBER; + {$EXTERNALSYM IMAGE_LINENUMBER} + TImageLineNumber = IMAGE_LINENUMBER; + PImageLineNumber = PIMAGE_LINENUMBER; + +const + IMAGE_SIZEOF_LINENUMBER = 6; + {$EXTERNALSYM IMAGE_SIZEOF_LINENUMBER} + +// #include "poppack.h" // Back to 4 byte packing + +// +// Based relocation format. +// + +type + PIMAGE_BASE_RELOCATION = ^IMAGE_BASE_RELOCATION; + {$EXTERNALSYM PIMAGE_BASE_RELOCATION} + _IMAGE_BASE_RELOCATION = record + VirtualAddress: DWORD; + SizeOfBlock: DWORD; + // WORD TypeOffset[1]; + end; + {$EXTERNALSYM _IMAGE_BASE_RELOCATION} + IMAGE_BASE_RELOCATION = _IMAGE_BASE_RELOCATION; + {$EXTERNALSYM IMAGE_BASE_RELOCATION} + TImageBaseRelocation = IMAGE_BASE_RELOCATION; + PImageBaseRelocation = PIMAGE_BASE_RELOCATION; + +const + IMAGE_SIZEOF_BASE_RELOCATION = 8; + {$EXTERNALSYM IMAGE_SIZEOF_BASE_RELOCATION} + +// +// Based relocation types. +// + + IMAGE_REL_BASED_ABSOLUTE = 0; + {$EXTERNALSYM IMAGE_REL_BASED_ABSOLUTE} + IMAGE_REL_BASED_HIGH = 1; + {$EXTERNALSYM IMAGE_REL_BASED_HIGH} + IMAGE_REL_BASED_LOW = 2; + {$EXTERNALSYM IMAGE_REL_BASED_LOW} + IMAGE_REL_BASED_HIGHLOW = 3; + {$EXTERNALSYM IMAGE_REL_BASED_HIGHLOW} + IMAGE_REL_BASED_HIGHADJ = 4; + {$EXTERNALSYM IMAGE_REL_BASED_HIGHADJ} + IMAGE_REL_BASED_MIPS_JMPADDR = 5; + {$EXTERNALSYM IMAGE_REL_BASED_MIPS_JMPADDR} + + IMAGE_REL_BASED_MIPS_JMPADDR16 = 9; + {$EXTERNALSYM IMAGE_REL_BASED_MIPS_JMPADDR16} + IMAGE_REL_BASED_IA64_IMM64 = 9; + {$EXTERNALSYM IMAGE_REL_BASED_IA64_IMM64} + IMAGE_REL_BASED_DIR64 = 10; + {$EXTERNALSYM IMAGE_REL_BASED_DIR64} + +// +// Archive format. +// + + IMAGE_ARCHIVE_START_SIZE = 8; + {$EXTERNALSYM IMAGE_ARCHIVE_START_SIZE} + IMAGE_ARCHIVE_START = '!'#10; + {$EXTERNALSYM IMAGE_ARCHIVE_START} + IMAGE_ARCHIVE_END = '`'#10; + {$EXTERNALSYM IMAGE_ARCHIVE_END} + IMAGE_ARCHIVE_PAD = #10; + {$EXTERNALSYM IMAGE_ARCHIVE_PAD} + IMAGE_ARCHIVE_LINKER_MEMBER = '/ '; + {$EXTERNALSYM IMAGE_ARCHIVE_LINKER_MEMBER} + IMAGE_ARCHIVE_LONGNAMES_MEMBER = '// '; + {$EXTERNALSYM IMAGE_ARCHIVE_LONGNAMES_MEMBER} + +type + PIMAGE_ARCHIVE_MEMBER_HEADER = ^IMAGE_ARCHIVE_MEMBER_HEADER; + {$EXTERNALSYM PIMAGE_ARCHIVE_MEMBER_HEADER} + _IMAGE_ARCHIVE_MEMBER_HEADER = record + Name: array [0..15] of Byte; // File member name - `/' terminated. + Date: array [0..11] of Byte; // File member date - decimal. + UserID: array [0..5] of Byte; // File member user id - decimal. + GroupID: array [0..5] of Byte; // File member group id - decimal. + Mode: array [0..7] of Byte; // File member mode - octal. + Size: array [0..9] of Byte; // File member size - decimal. + EndHeader: array [0..1] of Byte; // String to end header. + end; + {$EXTERNALSYM _IMAGE_ARCHIVE_MEMBER_HEADER} + IMAGE_ARCHIVE_MEMBER_HEADER = _IMAGE_ARCHIVE_MEMBER_HEADER; + {$EXTERNALSYM IMAGE_ARCHIVE_MEMBER_HEADER} + TImageArchiveMemberHeader = IMAGE_ARCHIVE_MEMBER_HEADER; + PImageArchiveMemberHeader = PIMAGE_ARCHIVE_MEMBER_HEADER; + +const + IMAGE_SIZEOF_ARCHIVE_MEMBER_HDR = 60; + {$EXTERNALSYM IMAGE_SIZEOF_ARCHIVE_MEMBER_HDR} + +// line 6346 + +// +// DLL support. +// + +// +// Export Format +// + +type + PIMAGE_EXPORT_DIRECTORY = ^IMAGE_EXPORT_DIRECTORY; + {$EXTERNALSYM PIMAGE_EXPORT_DIRECTORY} + _IMAGE_EXPORT_DIRECTORY = record + Characteristics: DWORD; + TimeDateStamp: DWORD; + MajorVersion: Word; + MinorVersion: Word; + Name: DWORD; + Base: DWORD; + NumberOfFunctions: DWORD; + NumberOfNames: DWORD; + AddressOfFunctions: DWORD; // RVA from base of image + AddressOfNames: DWORD; // RVA from base of image + AddressOfNameOrdinals: DWORD; // RVA from base of image + end; + {$EXTERNALSYM _IMAGE_EXPORT_DIRECTORY} + IMAGE_EXPORT_DIRECTORY = _IMAGE_EXPORT_DIRECTORY; + {$EXTERNALSYM IMAGE_EXPORT_DIRECTORY} + TImageExportDirectory = IMAGE_EXPORT_DIRECTORY; + PImageExportDirectory = PIMAGE_EXPORT_DIRECTORY; + +// +// Import Format +// + + PIMAGE_IMPORT_BY_NAME = ^IMAGE_IMPORT_BY_NAME; + {$EXTERNALSYM PIMAGE_IMPORT_BY_NAME} + _IMAGE_IMPORT_BY_NAME = record + Hint: Word; + Name: array [0..0] of AnsiChar; + end; + {$EXTERNALSYM _IMAGE_IMPORT_BY_NAME} + IMAGE_IMPORT_BY_NAME = _IMAGE_IMPORT_BY_NAME; + {$EXTERNALSYM IMAGE_IMPORT_BY_NAME} + TImageImportByName = IMAGE_IMPORT_BY_NAME; + PImageImportByName = PIMAGE_IMPORT_BY_NAME; + +// #include "pshpack8.h" // Use align 8 for the 64-bit IAT. + + PIMAGE_THUNK_DATA64 = ^IMAGE_THUNK_DATA64; + {$EXTERNALSYM PIMAGE_THUNK_DATA64} + _IMAGE_THUNK_DATA64 = record + case Integer of + 0: (ForwarderString: ULONGLONG); // PBYTE + 1: (Function_: ULONGLONG); // PDWORD + 2: (Ordinal: ULONGLONG); + 3: (AddressOfData: ULONGLONG); // PIMAGE_IMPORT_BY_NAME + end; + {$EXTERNALSYM _IMAGE_THUNK_DATA64} + IMAGE_THUNK_DATA64 = _IMAGE_THUNK_DATA64; + {$EXTERNALSYM IMAGE_THUNK_DATA64} + TImageThunkData64 = IMAGE_THUNK_DATA64; + PImageThunkData64 = PIMAGE_THUNK_DATA64; + +// #include "poppack.h" // Back to 4 byte packing + + PIMAGE_THUNK_DATA32 = ^IMAGE_THUNK_DATA32; + {$EXTERNALSYM PIMAGE_THUNK_DATA32} + _IMAGE_THUNK_DATA32 = record + case Integer of + 0: (ForwarderString: DWORD); // PBYTE + 1: (Function_: DWORD); // PDWORD + 2: (Ordinal: DWORD); + 3: (AddressOfData: DWORD); // PIMAGE_IMPORT_BY_NAME + end; + {$EXTERNALSYM _IMAGE_THUNK_DATA32} + IMAGE_THUNK_DATA32 = _IMAGE_THUNK_DATA32; + {$EXTERNALSYM IMAGE_THUNK_DATA32} + TImageThunkData32 = IMAGE_THUNK_DATA32; + PImageThunkData32 = PIMAGE_THUNK_DATA32; + +const + IMAGE_ORDINAL_FLAG64 = ULONGLONG($8000000000000000); + {$EXTERNALSYM IMAGE_ORDINAL_FLAG64} + IMAGE_ORDINAL_FLAG32 = DWORD($80000000); + {$EXTERNALSYM IMAGE_ORDINAL_FLAG32} + +function IMAGE_ORDINAL64(Ordinal: ULONGLONG): ULONGLONG; +{$EXTERNALSYM IMAGE_ORDINAL64} +function IMAGE_ORDINAL32(Ordinal: DWORD): DWORD; +{$EXTERNALSYM IMAGE_ORDINAL32} +function IMAGE_SNAP_BY_ORDINAL64(Ordinal: ULONGLONG): Boolean; +{$EXTERNALSYM IMAGE_SNAP_BY_ORDINAL64} +function IMAGE_SNAP_BY_ORDINAL32(Ordinal: DWORD): Boolean; +{$EXTERNALSYM IMAGE_SNAP_BY_ORDINAL32} + +// +// Thread Local Storage +// + +type + PIMAGE_TLS_CALLBACK = procedure (DllHandle: Pointer; Reason: DWORD; Reserved: Pointer); stdcall; + {$EXTERNALSYM PIMAGE_TLS_CALLBACK} + TImageTlsCallback = PIMAGE_TLS_CALLBACK; + + PIMAGE_TLS_DIRECTORY64 = ^IMAGE_TLS_DIRECTORY64; + {$EXTERNALSYM PIMAGE_TLS_DIRECTORY64} + _IMAGE_TLS_DIRECTORY64 = record + StartAddressOfRawData: ULONGLONG; + EndAddressOfRawData: ULONGLONG; + AddressOfIndex: ULONGLONG; // PDWORD + AddressOfCallBacks: ULONGLONG; // PIMAGE_TLS_CALLBACK *; + SizeOfZeroFill: DWORD; + Characteristics: DWORD; + end; + {$EXTERNALSYM _IMAGE_TLS_DIRECTORY64} + IMAGE_TLS_DIRECTORY64 = _IMAGE_TLS_DIRECTORY64; + {$EXTERNALSYM IMAGE_TLS_DIRECTORY64} + TImageTlsDirectory64 = IMAGE_TLS_DIRECTORY64; + {$EXTERNALSYM TImageTlsDirectory64} + PImageTlsDirectory64 = PIMAGE_TLS_DIRECTORY64; + {$EXTERNALSYM PImageTlsDirectory64} + + PIMAGE_TLS_DIRECTORY32 = ^IMAGE_TLS_DIRECTORY32; + {$EXTERNALSYM PIMAGE_TLS_DIRECTORY32} + _IMAGE_TLS_DIRECTORY32 = record + StartAddressOfRawData: DWORD; + EndAddressOfRawData: DWORD; + AddressOfIndex: DWORD; // PDWORD + AddressOfCallBacks: DWORD; // PIMAGE_TLS_CALLBACK * + SizeOfZeroFill: DWORD; + Characteristics: DWORD; + end; + {$EXTERNALSYM _IMAGE_TLS_DIRECTORY32} + IMAGE_TLS_DIRECTORY32 = _IMAGE_TLS_DIRECTORY32; + {$EXTERNALSYM IMAGE_TLS_DIRECTORY32} + TImageTlsDirectory32 = IMAGE_TLS_DIRECTORY32; + {$EXTERNALSYM TImageTlsDirectory32} + PImageTlsDirectory32 = PIMAGE_TLS_DIRECTORY32; + {$EXTERNALSYM PImageTlsDirectory32} + +const + IMAGE_ORDINAL_FLAG = IMAGE_ORDINAL_FLAG32; + {$EXTERNALSYM IMAGE_ORDINAL_FLAG} + +function IMAGE_ORDINAL(Ordinal: DWORD): DWORD; +{$EXTERNALSYM IMAGE_ORDINAL} + +type + IMAGE_THUNK_DATA = IMAGE_THUNK_DATA32; + {$EXTERNALSYM IMAGE_THUNK_DATA} + PIMAGE_THUNK_DATA = PIMAGE_THUNK_DATA32; + {$EXTERNALSYM PIMAGE_THUNK_DATA} + TImageThunkData = TImageThunkData32; + PImageThunkData = PImageThunkData32; + +function IMAGE_SNAP_BY_ORDINAL(Ordinal: DWORD): Boolean; +{$EXTERNALSYM IMAGE_SNAP_BY_ORDINAL} + +type + IMAGE_TLS_DIRECTORY = IMAGE_TLS_DIRECTORY32; + {$EXTERNALSYM IMAGE_TLS_DIRECTORY} + PIMAGE_TLS_DIRECTORY = PIMAGE_TLS_DIRECTORY32; + {$EXTERNALSYM PIMAGE_TLS_DIRECTORY} + TImageTlsDirectory = TImageTlsDirectory32; + {$EXTERNALSYM TImageTlsDirectory} + PImageTlsDirectory = PImageTlsDirectory32; + {$EXTERNALSYM PImageTlsDirectory} + + TIIDUnion = record + case Integer of + 0: (Characteristics: DWORD); // 0 for terminating null import descriptor + 1: (OriginalFirstThunk: DWORD); // RVA to original unbound IAT (PIMAGE_THUNK_DATA) + end; + + PIMAGE_IMPORT_DESCRIPTOR = ^IMAGE_IMPORT_DESCRIPTOR; + {$EXTERNALSYM PIMAGE_IMPORT_DESCRIPTOR} + _IMAGE_IMPORT_DESCRIPTOR = record + Union: TIIDUnion; + TimeDateStamp: DWORD; // 0 if not bound, + // -1 if bound, and real date\time stamp + // in IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT (new BIND) + // O.W. date/time stamp of DLL bound to (Old BIND) + + ForwarderChain: DWORD; // -1 if no forwarders + Name: DWORD; + FirstThunk: DWORD; // RVA to IAT (if bound this IAT has actual addresses) + end; + {$EXTERNALSYM _IMAGE_IMPORT_DESCRIPTOR} + IMAGE_IMPORT_DESCRIPTOR = _IMAGE_IMPORT_DESCRIPTOR; + {$EXTERNALSYM IMAGE_IMPORT_DESCRIPTOR} + TImageImportDescriptor = IMAGE_IMPORT_DESCRIPTOR; + PImageImportDescriptor = PIMAGE_IMPORT_DESCRIPTOR; + +// +// New format import descriptors pointed to by DataDirectory[ IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT ] +// + +type + PIMAGE_BOUND_IMPORT_DESCRIPTOR = ^IMAGE_BOUND_IMPORT_DESCRIPTOR; + {$EXTERNALSYM PIMAGE_BOUND_IMPORT_DESCRIPTOR} + _IMAGE_BOUND_IMPORT_DESCRIPTOR = record + TimeDateStamp: DWORD; + OffsetModuleName: Word; + NumberOfModuleForwarderRefs: Word; + // Array of zero or more IMAGE_BOUND_FORWARDER_REF follows + end; + {$EXTERNALSYM _IMAGE_BOUND_IMPORT_DESCRIPTOR} + IMAGE_BOUND_IMPORT_DESCRIPTOR = _IMAGE_BOUND_IMPORT_DESCRIPTOR; + {$EXTERNALSYM IMAGE_BOUND_IMPORT_DESCRIPTOR} + TImageBoundImportDescriptor = IMAGE_BOUND_IMPORT_DESCRIPTOR; + PImageBoundImportDescriptor = PIMAGE_BOUND_IMPORT_DESCRIPTOR; + + PIMAGE_BOUND_FORWARDER_REF = ^IMAGE_BOUND_FORWARDER_REF; + {$EXTERNALSYM PIMAGE_BOUND_FORWARDER_REF} + _IMAGE_BOUND_FORWARDER_REF = record + TimeDateStamp: DWORD; + OffsetModuleName: Word; + Reserved: Word; + end; + {$EXTERNALSYM _IMAGE_BOUND_FORWARDER_REF} + IMAGE_BOUND_FORWARDER_REF = _IMAGE_BOUND_FORWARDER_REF; + {$EXTERNALSYM IMAGE_BOUND_FORWARDER_REF} + TImageBoundForwarderRef = IMAGE_BOUND_FORWARDER_REF; + PImageBoundForwarderRef = PIMAGE_BOUND_FORWARDER_REF; + +// +// Resource Format. +// + +// +// Resource directory consists of two counts, following by a variable length +// array of directory entries. The first count is the number of entries at +// beginning of the array that have actual names associated with each entry. +// The entries are in ascending order, case insensitive strings. The second +// count is the number of entries that immediately follow the named entries. +// This second count identifies the number of entries that have 16-bit integer +// Ids as their name. These entries are also sorted in ascending order. +// +// This structure allows fast lookup by either name or number, but for any +// given resource entry only one form of lookup is supported, not both. +// This is consistant with the syntax of the .RC file and the .RES file. +// + + PIMAGE_RESOURCE_DIRECTORY = ^IMAGE_RESOURCE_DIRECTORY; + {$EXTERNALSYM PIMAGE_RESOURCE_DIRECTORY} + _IMAGE_RESOURCE_DIRECTORY = record + Characteristics: DWORD; + TimeDateStamp: DWORD; + MajorVersion: Word; + MinorVersion: Word; + NumberOfNamedEntries: Word; + NumberOfIdEntries: Word; + // IMAGE_RESOURCE_DIRECTORY_ENTRY DirectoryEntries[]; + end; + {$EXTERNALSYM _IMAGE_RESOURCE_DIRECTORY} + IMAGE_RESOURCE_DIRECTORY = _IMAGE_RESOURCE_DIRECTORY; + {$EXTERNALSYM IMAGE_RESOURCE_DIRECTORY} + TImageResourceDirectory = IMAGE_RESOURCE_DIRECTORY; + PImageResourceDirectory = PIMAGE_RESOURCE_DIRECTORY; + +const + IMAGE_RESOURCE_NAME_IS_STRING = DWORD($80000000); + {$EXTERNALSYM IMAGE_RESOURCE_NAME_IS_STRING} + IMAGE_RESOURCE_DATA_IS_DIRECTORY = DWORD($80000000); + {$EXTERNALSYM IMAGE_RESOURCE_DATA_IS_DIRECTORY} + +// +// Each directory contains the 32-bit Name of the entry and an offset, +// relative to the beginning of the resource directory of the data associated +// with this directory entry. If the name of the entry is an actual text +// string instead of an integer Id, then the high order bit of the name field +// is set to one and the low order 31-bits are an offset, relative to the +// beginning of the resource directory of the string, which is of type +// IMAGE_RESOURCE_DIRECTORY_STRING. Otherwise the high bit is clear and the +// low-order 16-bits are the integer Id that identify this resource directory +// entry. If the directory entry is yet another resource directory (i.e. a +// subdirectory), then the high order bit of the offset field will be +// set to indicate this. Otherwise the high bit is clear and the offset +// field points to a resource data entry. +// + +type + PIMAGE_RESOURCE_DIRECTORY_ENTRY = ^IMAGE_RESOURCE_DIRECTORY_ENTRY; + {$EXTERNALSYM PIMAGE_RESOURCE_DIRECTORY_ENTRY} + _IMAGE_RESOURCE_DIRECTORY_ENTRY = record + case Integer of + 0: ( + // DWORD NameOffset:31; + // DWORD NameIsString:1; + NameOffset: DWORD; + OffsetToData: DWORD + ); + 1: ( + Name: DWORD; + // DWORD OffsetToDirectory:31; + // DWORD DataIsDirectory:1; + OffsetToDirectory: DWORD; + ); + 2: ( + Id: WORD; + ); + end; + {$EXTERNALSYM _IMAGE_RESOURCE_DIRECTORY_ENTRY} + IMAGE_RESOURCE_DIRECTORY_ENTRY = _IMAGE_RESOURCE_DIRECTORY_ENTRY; + {$EXTERNALSYM IMAGE_RESOURCE_DIRECTORY_ENTRY} + TImageResourceDirectoryEntry = IMAGE_RESOURCE_DIRECTORY_ENTRY; + PImageResourceDirectoryEntry = PIMAGE_RESOURCE_DIRECTORY_ENTRY; + +// +// For resource directory entries that have actual string names, the Name +// field of the directory entry points to an object of the following type. +// All of these string objects are stored together after the last resource +// directory entry and before the first resource data object. This minimizes +// the impact of these variable length objects on the alignment of the fixed +// size directory entry objects. +// + +type + PIMAGE_RESOURCE_DIRECTORY_STRING = ^IMAGE_RESOURCE_DIRECTORY_STRING; + {$EXTERNALSYM PIMAGE_RESOURCE_DIRECTORY_STRING} + _IMAGE_RESOURCE_DIRECTORY_STRING = record + Length: Word; + NameString: array [0..0] of AnsiCHAR; + end; + {$EXTERNALSYM _IMAGE_RESOURCE_DIRECTORY_STRING} + IMAGE_RESOURCE_DIRECTORY_STRING = _IMAGE_RESOURCE_DIRECTORY_STRING; + {$EXTERNALSYM IMAGE_RESOURCE_DIRECTORY_STRING} + TImageResourceDirectoryString = IMAGE_RESOURCE_DIRECTORY_STRING; + PImageResourceDirectoryString = PIMAGE_RESOURCE_DIRECTORY_STRING; + + PIMAGE_RESOURCE_DIR_STRING_U = ^IMAGE_RESOURCE_DIR_STRING_U; + {$EXTERNALSYM PIMAGE_RESOURCE_DIR_STRING_U} + _IMAGE_RESOURCE_DIR_STRING_U = record + Length: Word; + NameString: array [0..0] of WCHAR; + end; + {$EXTERNALSYM _IMAGE_RESOURCE_DIR_STRING_U} + IMAGE_RESOURCE_DIR_STRING_U = _IMAGE_RESOURCE_DIR_STRING_U; + {$EXTERNALSYM IMAGE_RESOURCE_DIR_STRING_U} + TImageResourceDirStringU = IMAGE_RESOURCE_DIR_STRING_U; + PImageResourceDirStringU = PIMAGE_RESOURCE_DIR_STRING_U; + +// +// Each resource data entry describes a leaf node in the resource directory +// tree. It contains an offset, relative to the beginning of the resource +// directory of the data for the resource, a size field that gives the number +// of bytes of data at that offset, a CodePage that should be used when +// decoding code point values within the resource data. Typically for new +// applications the code page would be the unicode code page. +// + + PIMAGE_RESOURCE_DATA_ENTRY = ^IMAGE_RESOURCE_DATA_ENTRY; + {$EXTERNALSYM PIMAGE_RESOURCE_DATA_ENTRY} + _IMAGE_RESOURCE_DATA_ENTRY = record + OffsetToData: DWORD; + Size: DWORD; + CodePage: DWORD; + Reserved: DWORD; + end; + {$EXTERNALSYM _IMAGE_RESOURCE_DATA_ENTRY} + IMAGE_RESOURCE_DATA_ENTRY = _IMAGE_RESOURCE_DATA_ENTRY; + {$EXTERNALSYM IMAGE_RESOURCE_DATA_ENTRY} + TImageResourceDataEntry = IMAGE_RESOURCE_DATA_ENTRY; + PImageResourceDataEntry = PIMAGE_RESOURCE_DATA_ENTRY; + +// +// Load Configuration Directory Entry +// + +{$IFNDEF FPC} +type + PIMAGE_LOAD_CONFIG_DIRECTORY32 = ^IMAGE_LOAD_CONFIG_DIRECTORY32; + {$EXTERNALSYM PIMAGE_LOAD_CONFIG_DIRECTORY32} + IMAGE_LOAD_CONFIG_DIRECTORY32 = record + Size: DWORD; + TimeDateStamp: DWORD; + MajorVersion: WORD; + MinorVersion: WORD; + GlobalFlagsClear: DWORD; + GlobalFlagsSet: DWORD; + CriticalSectionDefaultTimeout: DWORD; + DeCommitFreeBlockThreshold: DWORD; + DeCommitTotalFreeThreshold: DWORD; + LockPrefixTable: DWORD; // VA + MaximumAllocationSize: DWORD; + VirtualMemoryThreshold: DWORD; + ProcessHeapFlags: DWORD; + ProcessAffinityMask: DWORD; + CSDVersion: WORD; + Reserved1: WORD; + EditList: DWORD; // VA + SecurityCookie: DWORD; // VA + SEHandlerTable: DWORD; // VA + SEHandlerCount: DWORD; + end; + {$EXTERNALSYM IMAGE_LOAD_CONFIG_DIRECTORY32} + TImageLoadConfigDirectory32 = IMAGE_LOAD_CONFIG_DIRECTORY32; + PImageLoadConfigDirectory32 = PIMAGE_LOAD_CONFIG_DIRECTORY32; + + PIMAGE_LOAD_CONFIG_DIRECTORY64 = ^IMAGE_LOAD_CONFIG_DIRECTORY64; + {$EXTERNALSYM PIMAGE_LOAD_CONFIG_DIRECTORY64} + IMAGE_LOAD_CONFIG_DIRECTORY64 = record + Size: DWORD; + TimeDateStamp: DWORD; + MajorVersion: WORD; + MinorVersion: WORD; + GlobalFlagsClear: DWORD; + GlobalFlagsSet: DWORD; + CriticalSectionDefaultTimeout: DWORD; + DeCommitFreeBlockThreshold: ULONGLONG; + DeCommitTotalFreeThreshold: ULONGLONG; + LockPrefixTable: ULONGLONG; // VA + MaximumAllocationSize: ULONGLONG; + VirtualMemoryThreshold: ULONGLONG; + ProcessAffinityMask: ULONGLONG; + ProcessHeapFlags: DWORD; + CSDVersion: WORD; + Reserved1: WORD; + EditList: ULONGLONG; // VA + SecurityCookie: ULONGLONG; // VA + SEHandlerTable: ULONGLONG; // VA + SEHandlerCount: ULONGLONG; + end; + {$EXTERNALSYM IMAGE_LOAD_CONFIG_DIRECTORY64} + TImageLoadConfigDirectory64 = IMAGE_LOAD_CONFIG_DIRECTORY64; + PImageLoadConfigDirectory64 = PIMAGE_LOAD_CONFIG_DIRECTORY64; + + IMAGE_LOAD_CONFIG_DIRECTORY = IMAGE_LOAD_CONFIG_DIRECTORY32; + {$EXTERNALSYM IMAGE_LOAD_CONFIG_DIRECTORY} + PIMAGE_LOAD_CONFIG_DIRECTORY = PIMAGE_LOAD_CONFIG_DIRECTORY32; + {$EXTERNALSYM PIMAGE_LOAD_CONFIG_DIRECTORY} + TImageLoadConfigDirectory = TImageLoadConfigDirectory32; + PImageLoadConfigDirectory = PImageLoadConfigDirectory32; +{$ENDIF ~FPC} + +// line 6802 + +// +// Debug Format +// +(* +type + PIMAGE_DEBUG_DIRECTORY = ^IMAGE_DEBUG_DIRECTORY; + {$EXTERNALSYM PIMAGE_DEBUG_DIRECTORY} + _IMAGE_DEBUG_DIRECTORY = record + Characteristics: DWORD; + TimeDateStamp: DWORD; + MajorVersion: Word; + MinorVersion: Word; + Type_: DWORD; + SizeOfData: DWORD; + AddressOfRawData: DWORD; + PointerToRawData: DWORD; + end; + {$EXTERNALSYM _IMAGE_DEBUG_DIRECTORY} + IMAGE_DEBUG_DIRECTORY = _IMAGE_DEBUG_DIRECTORY; + {$EXTERNALSYM IMAGE_DEBUG_DIRECTORY} + TImageDebugDirectory = IMAGE_DEBUG_DIRECTORY; + PImageDebugDirectory = PIMAGE_DEBUG_DIRECTORY; + +const + IMAGE_DEBUG_TYPE_UNKNOWN = 0; + {$EXTERNALSYM IMAGE_DEBUG_TYPE_UNKNOWN} + IMAGE_DEBUG_TYPE_COFF = 1; + {$EXTERNALSYM IMAGE_DEBUG_TYPE_COFF} + IMAGE_DEBUG_TYPE_CODEVIEW = 2; + {$EXTERNALSYM IMAGE_DEBUG_TYPE_CODEVIEW} + IMAGE_DEBUG_TYPE_FPO = 3; + {$EXTERNALSYM IMAGE_DEBUG_TYPE_FPO} + IMAGE_DEBUG_TYPE_MISC = 4; + {$EXTERNALSYM IMAGE_DEBUG_TYPE_MISC} + IMAGE_DEBUG_TYPE_EXCEPTION = 5; + {$EXTERNALSYM IMAGE_DEBUG_TYPE_EXCEPTION} + IMAGE_DEBUG_TYPE_FIXUP = 6; + {$EXTERNALSYM IMAGE_DEBUG_TYPE_FIXUP} + IMAGE_DEBUG_TYPE_OMAP_TO_SRC = 7; + {$EXTERNALSYM IMAGE_DEBUG_TYPE_OMAP_TO_SRC} + IMAGE_DEBUG_TYPE_OMAP_FROM_SRC = 8; + {$EXTERNALSYM IMAGE_DEBUG_TYPE_OMAP_FROM_SRC} + IMAGE_DEBUG_TYPE_BORLAND = 9; + {$EXTERNALSYM IMAGE_DEBUG_TYPE_BORLAND} + IMAGE_DEBUG_TYPE_RESERVED10 = 10; + {$EXTERNALSYM IMAGE_DEBUG_TYPE_RESERVED10} + IMAGE_DEBUG_TYPE_CLSID = 11; + {$EXTERNALSYM IMAGE_DEBUG_TYPE_CLSID} +*) + +{$IFNDEF FPC} +type + PIMAGE_COFF_SYMBOLS_HEADER = ^IMAGE_COFF_SYMBOLS_HEADER; + {$EXTERNALSYM PIMAGE_COFF_SYMBOLS_HEADER} + _IMAGE_COFF_SYMBOLS_HEADER = record + NumberOfSymbols: DWORD; + LvaToFirstSymbol: DWORD; + NumberOfLinenumbers: DWORD; + LvaToFirstLinenumber: DWORD; + RvaToFirstByteOfCode: DWORD; + RvaToLastByteOfCode: DWORD; + RvaToFirstByteOfData: DWORD; + RvaToLastByteOfData: DWORD; + end; + {$EXTERNALSYM _IMAGE_COFF_SYMBOLS_HEADER} + IMAGE_COFF_SYMBOLS_HEADER = _IMAGE_COFF_SYMBOLS_HEADER; + {$EXTERNALSYM IMAGE_COFF_SYMBOLS_HEADER} + TImageCoffSymbolsHeader = IMAGE_COFF_SYMBOLS_HEADER; + PImageCoffSymbolsHeader = PIMAGE_COFF_SYMBOLS_HEADER; +{$ENDIF ~FPC} + +const + FRAME_FPO = 0; + {$EXTERNALSYM FRAME_FPO} + FRAME_TRAP = 1; + {$EXTERNALSYM FRAME_TRAP} + FRAME_TSS = 2; + {$EXTERNALSYM FRAME_TSS} + FRAME_NONFPO = 3; + {$EXTERNALSYM FRAME_NONFPO} + + FPOFLAGS_PROLOG = $00FF; // # bytes in prolog + FPOFLAGS_REGS = $0700; // # regs saved + FPOFLAGS_HAS_SEH = $0800; // TRUE if SEH in func + FPOFLAGS_USE_BP = $1000; // TRUE if EBP has been allocated + FPOFLAGS_RESERVED = $2000; // reserved for future use + FPOFLAGS_FRAME = $C000; // frame type + +{$IFNDEF FPC} +type + PFPO_DATA = ^FPO_DATA; + {$EXTERNALSYM PFPO_DATA} + _FPO_DATA = record + ulOffStart: DWORD; // offset 1st byte of function code + cbProcSize: DWORD; // # bytes in function + cdwLocals: DWORD; // # bytes in locals/4 + cdwParams: WORD; // # bytes in params/4 + Flags: WORD; + end; + {$EXTERNALSYM _FPO_DATA} + FPO_DATA = _FPO_DATA; + {$EXTERNALSYM FPO_DATA} + TFpoData = FPO_DATA; + PFpoData = PFPO_DATA; +{$ENDIF ~FPC} + +const + SIZEOF_RFPO_DATA = 16; + {$EXTERNALSYM SIZEOF_RFPO_DATA} + + IMAGE_DEBUG_MISC_EXENAME = 1; + {$EXTERNALSYM IMAGE_DEBUG_MISC_EXENAME} + +type + PIMAGE_DEBUG_MISC = ^IMAGE_DEBUG_MISC; + {$EXTERNALSYM PIMAGE_DEBUG_MISC} + _IMAGE_DEBUG_MISC = record + DataType: DWORD; // type of misc data, see defines + Length: DWORD; // total length of record, rounded to four byte multiple. + Unicode: ByteBool; // TRUE if data is unicode string + Reserved: array [0..2] of Byte; + Data: array [0..0] of Byte; // Actual data + end; + {$EXTERNALSYM _IMAGE_DEBUG_MISC} + IMAGE_DEBUG_MISC = _IMAGE_DEBUG_MISC; + {$EXTERNALSYM IMAGE_DEBUG_MISC} + TImageDebugMisc = IMAGE_DEBUG_MISC; + PImageDebugMisc = PIMAGE_DEBUG_MISC; + +// +// Function table extracted from MIPS/ALPHA/IA64 images. Does not contain +// information needed only for runtime support. Just those fields for +// each entry needed by a debugger. +// + +{$IFNDEF FPC} + PIMAGE_FUNCTION_ENTRY = ^IMAGE_FUNCTION_ENTRY; + {$EXTERNALSYM PIMAGE_FUNCTION_ENTRY} + _IMAGE_FUNCTION_ENTRY = record + StartingAddress: DWORD; + EndingAddress: DWORD; + EndOfPrologue: DWORD; + end; + {$EXTERNALSYM _IMAGE_FUNCTION_ENTRY} + IMAGE_FUNCTION_ENTRY = _IMAGE_FUNCTION_ENTRY; + {$EXTERNALSYM IMAGE_FUNCTION_ENTRY} + TImageFunctionEntry = IMAGE_FUNCTION_ENTRY; + PImageFunctionEntry = PIMAGE_FUNCTION_ENTRY; + + PIMAGE_FUNCTION_ENTRY64 = ^IMAGE_FUNCTION_ENTRY64; + {$EXTERNALSYM PIMAGE_FUNCTION_ENTRY64} + _IMAGE_FUNCTION_ENTRY64 = record + StartingAddress: ULONGLONG; + EndingAddress: ULONGLONG; + case Integer of + 0: (EndOfPrologue: ULONGLONG); + 1: (UnwindInfoAddress: ULONGLONG); + end; + {$EXTERNALSYM _IMAGE_FUNCTION_ENTRY64} + IMAGE_FUNCTION_ENTRY64 = _IMAGE_FUNCTION_ENTRY64; + {$EXTERNALSYM IMAGE_FUNCTION_ENTRY64} + TImageFunctionEntry64 = IMAGE_FUNCTION_ENTRY64; + PImageFunctionEntry64 = PIMAGE_FUNCTION_ENTRY64; + +{$ENDIF ~FPC} + +// +// Debugging information can be stripped from an image file and placed +// in a separate .DBG file, whose file name part is the same as the +// image file name part (e.g. symbols for CMD.EXE could be stripped +// and placed in CMD.DBG). This is indicated by the IMAGE_FILE_DEBUG_STRIPPED +// flag in the Characteristics field of the file header. The beginning of +// the .DBG file contains the following structure which captures certain +// information from the image file. This allows a debug to proceed even if +// the original image file is not accessable. This header is followed by +// zero of more IMAGE_SECTION_HEADER structures, followed by zero or more +// IMAGE_DEBUG_DIRECTORY structures. The latter structures and those in +// the image file contain file offsets relative to the beginning of the +// .DBG file. +// +// If symbols have been stripped from an image, the IMAGE_DEBUG_MISC structure +// is left in the image file, but not mapped. This allows a debugger to +// compute the name of the .DBG file, from the name of the image in the +// IMAGE_DEBUG_MISC structure. +// + + PIMAGE_SEPARATE_DEBUG_HEADER = ^IMAGE_SEPARATE_DEBUG_HEADER; + {$EXTERNALSYM PIMAGE_SEPARATE_DEBUG_HEADER} + _IMAGE_SEPARATE_DEBUG_HEADER = record + Signature: Word; + Flags: Word; + Machine: Word; + Characteristics: Word; + TimeDateStamp: DWORD; + CheckSum: DWORD; + ImageBase: DWORD; + SizeOfImage: DWORD; + NumberOfSections: DWORD; + ExportedNamesSize: DWORD; + DebugDirectorySize: DWORD; + SectionAlignment: DWORD; + Reserved: array [0..1] of DWORD; + end; + {$EXTERNALSYM _IMAGE_SEPARATE_DEBUG_HEADER} + IMAGE_SEPARATE_DEBUG_HEADER = _IMAGE_SEPARATE_DEBUG_HEADER; + {$EXTERNALSYM IMAGE_SEPARATE_DEBUG_HEADER} + TImageSeparateDebugHeader = IMAGE_SEPARATE_DEBUG_HEADER; + PImageSeparateDebugHeader = PIMAGE_SEPARATE_DEBUG_HEADER; + + _NON_PAGED_DEBUG_INFO = record + Signature: WORD; + Flags: WORD; + Size: DWORD; + Machine: WORD; + Characteristics: WORD; + TimeDateStamp: DWORD; + CheckSum: DWORD; + SizeOfImage: DWORD; + ImageBase: ULONGLONG; + //DebugDirectorySize + //IMAGE_DEBUG_DIRECTORY + end; + {$EXTERNALSYM _NON_PAGED_DEBUG_INFO} + NON_PAGED_DEBUG_INFO = _NON_PAGED_DEBUG_INFO; + {$EXTERNALSYM NON_PAGED_DEBUG_INFO} + PNON_PAGED_DEBUG_INFO = ^NON_PAGED_DEBUG_INFO; + {$EXTERNALSYM PNON_PAGED_DEBUG_INFO} + +const + IMAGE_SEPARATE_DEBUG_SIGNATURE = $4944; + {$EXTERNALSYM IMAGE_SEPARATE_DEBUG_SIGNATURE} + NON_PAGED_DEBUG_SIGNATURE = $494E; + {$EXTERNALSYM NON_PAGED_DEBUG_SIGNATURE} + + IMAGE_SEPARATE_DEBUG_FLAGS_MASK = $8000; + {$EXTERNALSYM IMAGE_SEPARATE_DEBUG_FLAGS_MASK} + IMAGE_SEPARATE_DEBUG_MISMATCH = $8000; // when DBG was updated, the old checksum didn't match. + {$EXTERNALSYM IMAGE_SEPARATE_DEBUG_MISMATCH} + +// +// The .arch section is made up of headers, each describing an amask position/value +// pointing to an array of IMAGE_ARCHITECTURE_ENTRY's. Each "array" (both the header +// and entry arrays) are terminiated by a quadword of 0xffffffffL. +// +// NOTE: There may be quadwords of 0 sprinkled around and must be skipped. +// + +const + IAHMASK_VALUE = $00000001; // 1 -> code section depends on mask bit + // 0 -> new instruction depends on mask bit + IAHMASK_MBZ7 = $000000FE; // MBZ + IAHMASK_SHIFT = $0000FF00; // Amask bit in question for this fixup + IAHMASK_MBZ16 = DWORD($FFFF0000); // MBZ + +type + PIMAGE_ARCHITECTURE_HEADER = ^IMAGE_ARCHITECTURE_HEADER; + {$EXTERNALSYM PIMAGE_ARCHITECTURE_HEADER} + _ImageArchitectureHeader = record + Mask: DWORD; + FirstEntryRVA: DWORD; // RVA into .arch section to array of ARCHITECTURE_ENTRY's + end; + {$EXTERNALSYM _ImageArchitectureHeader} + IMAGE_ARCHITECTURE_HEADER = _ImageArchitectureHeader; + {$EXTERNALSYM IMAGE_ARCHITECTURE_HEADER} + TImageArchitectureHeader = IMAGE_ARCHITECTURE_HEADER; + PImageArchitectureHeader = PIMAGE_ARCHITECTURE_HEADER; + + PIMAGE_ARCHITECTURE_ENTRY = ^IMAGE_ARCHITECTURE_ENTRY; + {$EXTERNALSYM PIMAGE_ARCHITECTURE_ENTRY} + _ImageArchitectureEntry = record + FixupInstRVA: DWORD; // RVA of instruction to fixup + NewInst: DWORD; // fixup instruction (see alphaops.h) + end; + {$EXTERNALSYM _ImageArchitectureEntry} + IMAGE_ARCHITECTURE_ENTRY = _ImageArchitectureEntry; + {$EXTERNALSYM IMAGE_ARCHITECTURE_ENTRY} + TImageArchitectureEntry = IMAGE_ARCHITECTURE_ENTRY; + PImageArchitectureEntry = PIMAGE_ARCHITECTURE_ENTRY; + +// #include "poppack.h" // Back to the initial value + +// The following structure defines the new import object. Note the values of the first two fields, +// which must be set as stated in order to differentiate old and new import members. +// Following this structure, the linker emits two null-terminated strings used to recreate the +// import at the time of use. The first string is the import's name, the second is the dll's name. + +const + IMPORT_OBJECT_HDR_SIG2 = $ffff; + {$EXTERNALSYM IMPORT_OBJECT_HDR_SIG2} + +const + IOHFLAGS_TYPE = $0003; // IMPORT_TYPE + IAHFLAGS_NAMETYPE = $001C; // IMPORT_NAME_TYPE + IAHFLAGS_RESERVED = $FFE0; // Reserved. Must be zero. + +type + PImportObjectHeader = ^IMPORT_OBJECT_HEADER; + IMPORT_OBJECT_HEADER = record + Sig1: WORD; // Must be IMAGE_FILE_MACHINE_UNKNOWN + Sig2: WORD; // Must be IMPORT_OBJECT_HDR_SIG2. + Version: WORD; + Machine: WORD; + TimeDateStamp: DWORD; // Time/date stamp + SizeOfData: DWORD; // particularly useful for incremental links + OrdinalOrHint: record + case Integer of + 0: (Ordinal: WORD); // if grf & IMPORT_OBJECT_ORDINAL + 1: (Flags: DWORD); + end; + Flags: WORD; + //WORD Type : 2; // IMPORT_TYPE + //WORD NameType : 3; // IMPORT_NAME_TYPE + //WORD Reserved : 11; // Reserved. Must be zero. + end; + {$EXTERNALSYM IMPORT_OBJECT_HEADER} + TImportObjectHeader = IMPORT_OBJECT_HEADER; + + IMPORT_OBJECT_TYPE = (IMPORT_OBJECT_CODE, IMPORT_OBJECT_DATA, IMPORT_OBJECT_CONST); + {$EXTERNALSYM IMPORT_OBJECT_TYPE} + TImportObjectType = IMPORT_OBJECT_TYPE; + + IMPORT_OBJECT_NAME_TYPE = ( + IMPORT_OBJECT_ORDINAL, // Import by ordinal + IMPORT_OBJECT_NAME, // Import name == public symbol name. + IMPORT_OBJECT_NAME_NO_PREFIX, // Import name == public symbol name skipping leading ?, @, or optionally _. + IMPORT_OBJECT_NAME_UNDECORATE); // Import name == public symbol name skipping leading ?, @, or optionally _ + // and truncating at first @ + {$EXTERNALSYM IMPORT_OBJECT_NAME_TYPE} + TImportObjectNameType = IMPORT_OBJECT_NAME_TYPE; + + ReplacesCorHdrNumericDefines = DWORD; + {$EXTERNALSYM ReplacesCorHdrNumericDefines} + +const + +// COM+ Header entry point flags. + + COMIMAGE_FLAGS_ILONLY = $00000001; + {$EXTERNALSYM COMIMAGE_FLAGS_ILONLY} + COMIMAGE_FLAGS_32BITREQUIRED = $00000002; + {$EXTERNALSYM COMIMAGE_FLAGS_32BITREQUIRED} + COMIMAGE_FLAGS_IL_LIBRARY = $00000004; + {$EXTERNALSYM COMIMAGE_FLAGS_IL_LIBRARY} + COMIMAGE_FLAGS_STRONGNAMESIGNED = $00000008; + {$EXTERNALSYM COMIMAGE_FLAGS_STRONGNAMESIGNED} + COMIMAGE_FLAGS_TRACKDEBUGDATA = $00010000; + {$EXTERNALSYM COMIMAGE_FLAGS_TRACKDEBUGDATA} + +// Version flags for image. + + COR_VERSION_MAJOR_V2 = 2; + {$EXTERNALSYM COR_VERSION_MAJOR_V2} + COR_VERSION_MAJOR = COR_VERSION_MAJOR_V2; + {$EXTERNALSYM COR_VERSION_MAJOR} + COR_VERSION_MINOR = 0; + {$EXTERNALSYM COR_VERSION_MINOR} + COR_DELETED_NAME_LENGTH = 8; + {$EXTERNALSYM COR_DELETED_NAME_LENGTH} + COR_VTABLEGAP_NAME_LENGTH = 8; + {$EXTERNALSYM COR_VTABLEGAP_NAME_LENGTH} + +// Maximum size of a NativeType descriptor. + + NATIVE_TYPE_MAX_CB = 1; + {$EXTERNALSYM NATIVE_TYPE_MAX_CB} + COR_ILMETHOD_SECT_SMALL_MAX_DATASIZE= $FF; + {$EXTERNALSYM COR_ILMETHOD_SECT_SMALL_MAX_DATASIZE} + +// #defines for the MIH FLAGS + + IMAGE_COR_MIH_METHODRVA = $01; + {$EXTERNALSYM IMAGE_COR_MIH_METHODRVA} + IMAGE_COR_MIH_EHRVA = $02; + {$EXTERNALSYM IMAGE_COR_MIH_EHRVA} + IMAGE_COR_MIH_BASICBLOCK = $08; + {$EXTERNALSYM IMAGE_COR_MIH_BASICBLOCK} + +// V-table constants + + COR_VTABLE_32BIT = $01; // V-table slots are 32-bits in size. + {$EXTERNALSYM COR_VTABLE_32BIT} + COR_VTABLE_64BIT = $02; // V-table slots are 64-bits in size. + {$EXTERNALSYM COR_VTABLE_64BIT} + COR_VTABLE_FROM_UNMANAGED = $04; // If set, transition from unmanaged. + {$EXTERNALSYM COR_VTABLE_FROM_UNMANAGED} + COR_VTABLE_CALL_MOST_DERIVED = $10; // Call most derived method described by + {$EXTERNALSYM COR_VTABLE_CALL_MOST_DERIVED} + +// EATJ constants + + IMAGE_COR_EATJ_THUNK_SIZE = 32; // Size of a jump thunk reserved range. + {$EXTERNALSYM IMAGE_COR_EATJ_THUNK_SIZE} + +// Max name lengths +// Change to unlimited name lengths. + + MAX_CLASS_NAME = 1024; + {$EXTERNALSYM MAX_CLASS_NAME} + MAX_PACKAGE_NAME = 1024; + {$EXTERNALSYM MAX_PACKAGE_NAME} + +// COM+ 2.0 header structure. + +type + IMAGE_COR20_HEADER = record + + // Header versioning + + cb: DWORD; + MajorRuntimeVersion: WORD; + MinorRuntimeVersion: WORD; + + // Symbol table and startup information + + MetaData: IMAGE_DATA_DIRECTORY; + Flags: DWORD; + EntryPointToken: DWORD; + + // Binding information + + Resources: IMAGE_DATA_DIRECTORY; + StrongNameSignature: IMAGE_DATA_DIRECTORY; + + // Regular fixup and binding information + + CodeManagerTable: IMAGE_DATA_DIRECTORY; + VTableFixups: IMAGE_DATA_DIRECTORY; + ExportAddressTableJumps: IMAGE_DATA_DIRECTORY; + + // Precompiled image info (internal use only - set to zero) + + ManagedNativeHeader: IMAGE_DATA_DIRECTORY; + end; + PIMAGE_COR20_HEADER = ^IMAGE_COR20_HEADER; + TImageCor20Header = IMAGE_COR20_HEADER; + PImageCor20Header = PIMAGE_COR20_HEADER; + +// line 7351 + +const + COMPRESSION_FORMAT_NONE = ($0000); + {$EXTERNALSYM COMPRESSION_FORMAT_NONE} + COMPRESSION_FORMAT_DEFAULT = ($0001); + {$EXTERNALSYM COMPRESSION_FORMAT_DEFAULT} + COMPRESSION_FORMAT_LZNT1 = ($0002); + {$EXTERNALSYM COMPRESSION_FORMAT_LZNT1} + COMPRESSION_ENGINE_STANDARD = ($0000); + {$EXTERNALSYM COMPRESSION_ENGINE_STANDARD} + COMPRESSION_ENGINE_MAXIMUM = ($0100); + {$EXTERNALSYM COMPRESSION_ENGINE_MAXIMUM} + COMPRESSION_ENGINE_HIBER = ($0200); + {$EXTERNALSYM COMPRESSION_ENGINE_HIBER} + +// line 7462 + +type + POSVERSIONINFOEXA = ^OSVERSIONINFOEXA; + {$EXTERNALSYM POSVERSIONINFOEXA} + _OSVERSIONINFOEXA = record + dwOSVersionInfoSize: DWORD; + dwMajorVersion: DWORD; + dwMinorVersion: DWORD; + dwBuildNumber: DWORD; + dwPlatformId: DWORD; + szCSDVersion: array [0..127] of ANSICHAR; // Maintenance string for PSS usage + wServicePackMajor: WORD; + wServicePackMinor: WORD; + wSuiteMask: WORD; + wProductType: BYTE; + wReserved: BYTE; + end; + {$EXTERNALSYM _OSVERSIONINFOEXA} + OSVERSIONINFOEXA = _OSVERSIONINFOEXA; + {$EXTERNALSYM OSVERSIONINFOEXA} + LPOSVERSIONINFOEXA = ^OSVERSIONINFOEXA; + {$EXTERNALSYM LPOSVERSIONINFOEXA} + TOSVersionInfoExA = _OSVERSIONINFOEXA; + + POSVERSIONINFOEXW = ^OSVERSIONINFOEXW; + {$EXTERNALSYM POSVERSIONINFOEXW} + _OSVERSIONINFOEXW = record + dwOSVersionInfoSize: DWORD; + dwMajorVersion: DWORD; + dwMinorVersion: DWORD; + dwBuildNumber: DWORD; + dwPlatformId: DWORD; + szCSDVersion: array [0..127] of WCHAR; // Maintenance string for PSS usage + wServicePackMajor: WORD; + wServicePackMinor: WORD; + wSuiteMask: WORD; + wProductType: BYTE; + wReserved: BYTE; + end; + {$EXTERNALSYM _OSVERSIONINFOEXW} + OSVERSIONINFOEXW = _OSVERSIONINFOEXW; + {$EXTERNALSYM OSVERSIONINFOEXW} + LPOSVERSIONINFOEXW = ^OSVERSIONINFOEXW; + {$EXTERNALSYM LPOSVERSIONINFOEXW} + RTL_OSVERSIONINFOEXW = _OSVERSIONINFOEXW; + {$EXTERNALSYM RTL_OSVERSIONINFOEXW} + PRTL_OSVERSIONINFOEXW = ^RTL_OSVERSIONINFOEXW; + {$EXTERNALSYM PRTL_OSVERSIONINFOEXW} + TOSVersionInfoExW = _OSVERSIONINFOEXW; + +{$IFDEF SUPPORTS_UNICODE} + + OSVERSIONINFOEX = OSVERSIONINFOEXW; + {$EXTERNALSYM OSVERSIONINFOEX} + POSVERSIONINFOEX = POSVERSIONINFOEXW; + {$EXTERNALSYM POSVERSIONINFOEX} + LPOSVERSIONINFOEX = LPOSVERSIONINFOEXW; + {$EXTERNALSYM LPOSVERSIONINFOEX} + TOSVersionInfoEx = TOSVersionInfoExW; + +{$ELSE ~SUPPORTS_UNICODE} + + OSVERSIONINFOEX = OSVERSIONINFOEXA; + {$EXTERNALSYM OSVERSIONINFOEX} + POSVERSIONINFOEX = POSVERSIONINFOEXA; + {$EXTERNALSYM POSVERSIONINFOEX} + LPOSVERSIONINFOEX = LPOSVERSIONINFOEXA; + {$EXTERNALSYM LPOSVERSIONINFOEX} + TOSVersionInfoEx = TOSVersionInfoExA; + +{$ENDIF ~SUPPORTS_UNICODE} + +// +// RtlVerifyVersionInfo() conditions +// + +const + VER_EQUAL = 1; + {$EXTERNALSYM VER_EQUAL} + VER_GREATER = 2; + {$EXTERNALSYM VER_GREATER} + VER_GREATER_EQUAL = 3; + {$EXTERNALSYM VER_GREATER_EQUAL} + VER_LESS = 4; + {$EXTERNALSYM VER_LESS} + VER_LESS_EQUAL = 5; + {$EXTERNALSYM VER_LESS_EQUAL} + VER_AND = 6; + {$EXTERNALSYM VER_AND} + VER_OR = 7; + {$EXTERNALSYM VER_OR} + + VER_CONDITION_MASK = 7; + {$EXTERNALSYM VER_CONDITION_MASK} + VER_NUM_BITS_PER_CONDITION_MASK = 3; + {$EXTERNALSYM VER_NUM_BITS_PER_CONDITION_MASK} + +// +// RtlVerifyVersionInfo() type mask bits +// + + VER_MINORVERSION = $0000001; + {$EXTERNALSYM VER_MINORVERSION} + VER_MAJORVERSION = $0000002; + {$EXTERNALSYM VER_MAJORVERSION} + VER_BUILDNUMBER = $0000004; + {$EXTERNALSYM VER_BUILDNUMBER} + VER_PLATFORMID = $0000008; + {$EXTERNALSYM VER_PLATFORMID} + VER_SERVICEPACKMINOR = $0000010; + {$EXTERNALSYM VER_SERVICEPACKMINOR} + VER_SERVICEPACKMAJOR = $0000020; + {$EXTERNALSYM VER_SERVICEPACKMAJOR} + VER_SUITENAME = $0000040; + {$EXTERNALSYM VER_SUITENAME} + VER_PRODUCT_TYPE = $0000080; + {$EXTERNALSYM VER_PRODUCT_TYPE} + +// +// RtlVerifyVersionInfo() os product type values +// + + VER_NT_WORKSTATION = $0000001; + {$EXTERNALSYM VER_NT_WORKSTATION} + VER_NT_DOMAIN_CONTROLLER = $0000002; + {$EXTERNALSYM VER_NT_DOMAIN_CONTROLLER} + VER_NT_SERVER = $0000003; + {$EXTERNALSYM VER_NT_SERVER} + +// +// dwPlatformId defines: +// + + VER_PLATFORM_WIN32s = 0; + {$EXTERNALSYM VER_PLATFORM_WIN32s} + VER_PLATFORM_WIN32_WINDOWS = 1; + {$EXTERNALSYM VER_PLATFORM_WIN32_WINDOWS} + VER_PLATFORM_WIN32_NT = 2; + {$EXTERNALSYM VER_PLATFORM_WIN32_NT} + +const +// +// +// Predefined Value Types. +// + + REG_NONE = ( 0 ); // No value type + {$EXTERNALSYM REG_NONE} + REG_SZ = ( 1 ); // Unicode nul terminated string + {$EXTERNALSYM REG_SZ} + REG_EXPAND_SZ = ( 2 ); // Unicode nul terminated string + {$EXTERNALSYM REG_EXPAND_SZ} + // (with environment variable references) + REG_BINARY = ( 3 ); // Free form binary + {$EXTERNALSYM REG_BINARY} + REG_DWORD = ( 4 ); // 32-bit number + {$EXTERNALSYM REG_DWORD} + REG_DWORD_LITTLE_ENDIAN = ( 4 ); // 32-bit number (same as REG_DWORD) + {$EXTERNALSYM REG_DWORD_LITTLE_ENDIAN} + REG_DWORD_BIG_ENDIAN = ( 5 ); // 32-bit number + {$EXTERNALSYM REG_DWORD_BIG_ENDIAN} + REG_LINK = ( 6 ); // Symbolic Link (unicode) + {$EXTERNALSYM REG_LINK} + REG_MULTI_SZ = ( 7 ); // Multiple Unicode strings + {$EXTERNALSYM REG_MULTI_SZ} + REG_RESOURCE_LIST = ( 8 ); // Resource list in the resource map + {$EXTERNALSYM REG_RESOURCE_LIST} + REG_FULL_RESOURCE_DESCRIPTOR = ( 9 ); // Resource list in the hardware description + {$EXTERNALSYM REG_FULL_RESOURCE_DESCRIPTOR} + REG_RESOURCE_REQUIREMENTS_LIST = ( 10 ); + {$EXTERNALSYM REG_RESOURCE_REQUIREMENTS_LIST} + REG_QWORD = ( 11 ); // 64-bit number + {$EXTERNALSYM REG_QWORD} + REG_QWORD_LITTLE_ENDIAN = ( 11 ); // 64-bit number (same as REG_QWORD) + {$EXTERNALSYM REG_QWORD_LITTLE_ENDIAN} + + // Windows 7 debugging types + +type + _CONTEXT_CHUNK = packed record + Offset: Integer; + Length: DWORD; + end; + {$EXTERNALSYM _CONTEXT_CHUNK} + CONTEXT_CHUNK = _CONTEXT_CHUNK; + {$EXTERNALSYM CONTEXT_CHUNK} + PCONTEXT_CHUNK = ^_CONTEXT_CHUNK; + {$EXTERNALSYM PCONTEXT_CHUNK} + +type + _CONTEXT_EX = packed record + // + // The total length of the structure starting from the chunk with + // the smallest offset. N.B. that the offset may be negative. + // + All: CONTEXT_CHUNK; + + // + // Wrapper for the traditional CONTEXT structure. N.B. the size of + // the chunk may be less than sizeof(CONTEXT) is some cases (when + // CONTEXT_EXTENDED_REGISTERS is not set on x86 for instance). + // + + Legacy: CONTEXT_CHUNK; + + // + // CONTEXT_XSTATE: Extended processor state chunk. The state is + // stored in the same format XSAVE operation strores it with + // exception of the first 512 bytes, i.e. staring from + // XSAVE_AREA_HEADER. The lower two bits corresponding FP and + // SSE state must be zero. + // + + XState: CONTEXT_CHUNK; + end; + {$EXTERNALSYM _CONTEXT_EX} + CONTEXT_EX = _CONTEXT_EX; + {$EXTERNALSYM CONTEXT_EX} + PCONTEXT_EX = ^_CONTEXT_EX; + {$EXTERNALSYM PCONTEXT_EX} + +// +// Known extended CPU state feature IDs +// + +const + XSTATE_LEGACY_FLOATING_POINT = 0; + {$EXTERNALSYM XSTATE_LEGACY_FLOATING_POINT} + XSTATE_LEGACY_SSE = 1; + {$EXTERNALSYM XSTATE_LEGACY_SSE} + XSTATE_GSSE = 2; + {$EXTERNALSYM XSTATE_GSSE} + + XSTATE_MASK_LEGACY_FLOATING_POINT = Int64(1) shl XSTATE_LEGACY_FLOATING_POINT; + {$EXTERNALSYM XSTATE_MASK_LEGACY_FLOATING_POINT} + XSTATE_MASK_LEGACY_SSE = Int64(1) shl XSTATE_LEGACY_SSE; + {$EXTERNALSYM XSTATE_MASK_LEGACY_SSE} + XSTATE_MASK_LEGACY = XSTATE_MASK_LEGACY_FLOATING_POINT or XSTATE_MASK_LEGACY_SSE; + {$EXTERNALSYM XSTATE_MASK_LEGACY} + XSTATE_MASK_GSSE = Int64(1) shl XSTATE_GSSE; + {$EXTERNALSYM XSTATE_MASK_GSSE} + + MAXIMUM_XSTATE_FEATURES = 64; + {$EXTERNALSYM MAXIMUM_XSTATE_FEATURES} + +// +// The following flags control the contents of the CONTEXT structure. +// +const + CONTEXT_i386 = $00010000; // this assumes that i386 and + {$EXTERNALSYM CONTEXT_i386} + CONTEXT_i486 = $00010000; // i486 have identical context records + {$EXTERNALSYM CONTEXT_i486} + + CONTEXT_CONTROL = CONTEXT_i386 or $00000001; // SS:SP, CS:IP, FLAGS, BP + {$EXTERNALSYM CONTEXT_CONTROL} + CONTEXT_INTEGER = CONTEXT_i386 or $00000002; // AX, BX, CX, DX, SI, DI + {$EXTERNALSYM CONTEXT_INTEGER} + CONTEXT_SEGMENTS = CONTEXT_i386 or $00000004; // DS, ES, FS, GS + {$EXTERNALSYM CONTEXT_SEGMENTS} + CONTEXT_FLOATING_POINT = CONTEXT_i386 or $00000008; // 387 state + {$EXTERNALSYM CONTEXT_FLOATING_POINT} + CONTEXT_DEBUG_REGISTERS = CONTEXT_i386 or $00000010; // DB 0-3,6,7 + {$EXTERNALSYM CONTEXT_DEBUG_REGISTERS} + CONTEXT_EXTENDED_REGISTERS = CONTEXT_i386 or $00000020; // cpu specific extensions + {$EXTERNALSYM CONTEXT_EXTENDED_REGISTERS} + + CONTEXT_FULL = CONTEXT_CONTROL or CONTEXT_INTEGER or CONTEXT_SEGMENTS; + {$EXTERNALSYM CONTEXT_FULL} + + CONTEXT_ALL = CONTEXT_CONTROL or CONTEXT_INTEGER or CONTEXT_SEGMENTS or CONTEXT_FLOATING_POINT or + CONTEXT_DEBUG_REGISTERS or CONTEXT_EXTENDED_REGISTERS; + {$EXTERNALSYM CONTEXT_ALL} + + CONTEXT_XSTATE = CONTEXT_i386 or $00000040; + {$EXTERNALSYM CONTEXT_XSTATE} diff --git a/3rdParty/JCL/source/prototypes/win32api/WinUser.imp b/3rdParty/JCL/source/prototypes/win32api/WinUser.imp new file mode 100644 index 00000000..3b94fe8d --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/WinUser.imp @@ -0,0 +1,24 @@ +type + TGetWindowLongPtr = function (hWnd: HWND; nIndex: Integer): TJclAddr; stdcall; + +var + _GetWindowLongPtr: TGetWindowLongPtr = nil; + +function GetWindowLongPtr(hWnd: HWND; nIndex: Integer): TJclAddr; +begin + GetProcedureAddress(Pointer(@_GetWindowLongPtr), user32, 'GetWindowLong' + AWSuffix); + Result := _GetWindowLongPtr(hWnd, nIndex); +end; + +type + TSetWindowLongPtr = function (hWnd: HWND; nIndex: Integer; dwNewLong: TJclAddr): Longint; stdcall; + +var + _SetWindowLongPtr: TSetWindowLongPtr = nil; + +function SetWindowLongPtr(hWnd: HWND; nIndex: Integer; dwNewLong: TJclAddr): Longint; +begin + GetProcedureAddress(Pointer(@_SetWindowLongPtr), user32, 'SetWindowLong' + AWSuffix); + Result := _SetWindowLongPtr(hWnd, nIndex, dwNewLong); +end; + diff --git a/3rdParty/JCL/source/prototypes/win32api/WinUser.int b/3rdParty/JCL/source/prototypes/win32api/WinUser.int new file mode 100644 index 00000000..86b11e09 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/WinUser.int @@ -0,0 +1,103 @@ +{$IFNDEF FPC} +type + MAKEINTRESOURCEA = LPSTR; + {$EXTERNALSYM MAKEINTRESOURCEA} + MAKEINTRESOURCEW = LPWSTR; + {$EXTERNALSYM MAKEINTRESOURCEW} +{$IFDEF SUPPORTS_UNICODE} + MAKEINTRESOURCE = MAKEINTRESOURCEW; + {$EXTERNALSYM MAKEINTRESOURCE} +{$ELSE ~SUPPORTS_UNICODE} + MAKEINTRESOURCE = MAKEINTRESOURCEA; + {$EXTERNALSYM MAKEINTRESOURCE} +{$ENDIF ~SUPPORTS_UNICODE} +{$ENDIF ~FPC} + +// +// Predefined Resource Types +// + +const + RT_CURSOR = MAKEINTRESOURCE(1); + {$EXTERNALSYM RT_CURSOR} + RT_BITMAP = MAKEINTRESOURCE(2); + {$EXTERNALSYM RT_BITMAP} + RT_ICON = MAKEINTRESOURCE(3); + {$EXTERNALSYM RT_ICON} + RT_MENU = MAKEINTRESOURCE(4); + {$EXTERNALSYM RT_MENU} + RT_DIALOG = MAKEINTRESOURCE(5); + {$EXTERNALSYM RT_DIALOG} + RT_STRING = MAKEINTRESOURCE(6); + {$EXTERNALSYM RT_STRING} + RT_FONTDIR = MAKEINTRESOURCE(7); + {$EXTERNALSYM RT_FONTDIR} + RT_FONT = MAKEINTRESOURCE(8); + {$EXTERNALSYM RT_FONT} + RT_ACCELERATOR = MAKEINTRESOURCE(9); + {$EXTERNALSYM RT_ACCELERATOR} + RT_RCDATA = MAKEINTRESOURCE(10); + {$EXTERNALSYM RT_RCDATA} + RT_MESSAGETABLE = MAKEINTRESOURCE(11); + {$EXTERNALSYM RT_MESSAGETABLE} + + DIFFERENCE = 11; + {$EXTERNALSYM DIFFERENCE} + + RT_GROUP_CURSOR = MAKEINTRESOURCE(ULONG_PTR(RT_CURSOR) + DIFFERENCE); + {$EXTERNALSYM RT_GROUP_CURSOR} + RT_GROUP_ICON = MAKEINTRESOURCE(ULONG_PTR(RT_ICON) + DIFFERENCE); + {$EXTERNALSYM RT_GROUP_ICON} + RT_VERSION = MAKEINTRESOURCE(16); + {$EXTERNALSYM RT_VERSION} + RT_DLGINCLUDE = MAKEINTRESOURCE(17); + {$EXTERNALSYM RT_DLGINCLUDE} + RT_PLUGPLAY = MAKEINTRESOURCE(19); + {$EXTERNALSYM RT_PLUGPLAY} + RT_VXD = MAKEINTRESOURCE(20); + {$EXTERNALSYM RT_VXD} + RT_ANICURSOR = MAKEINTRESOURCE(21); + {$EXTERNALSYM RT_ANICURSOR} + RT_ANIICON = MAKEINTRESOURCE(22); + {$EXTERNALSYM RT_ANIICON} + RT_HTML = MAKEINTRESOURCE(23); + {$EXTERNALSYM RT_HTML} + RT_MANIFEST = MAKEINTRESOURCE(24); + CREATEPROCESS_MANIFEST_RESOURCE_ID = MAKEINTRESOURCE(1); + {$EXTERNALSYM CREATEPROCESS_MANIFEST_RESOURCE_ID} + ISOLATIONAWARE_MANIFEST_RESOURCE_ID = MAKEINTRESOURCE(2); + {$EXTERNALSYM ISOLATIONAWARE_MANIFEST_RESOURCE_ID} + ISOLATIONAWARE_NOSTATICIMPORT_MANIFEST_RESOURCE_ID = MAKEINTRESOURCE(3); + {$EXTERNALSYM ISOLATIONAWARE_NOSTATICIMPORT_MANIFEST_RESOURCE_ID} + MINIMUM_RESERVED_MANIFEST_RESOURCE_ID = MAKEINTRESOURCE(1{inclusive}); + {$EXTERNALSYM MINIMUM_RESERVED_MANIFEST_RESOURCE_ID} + MAXIMUM_RESERVED_MANIFEST_RESOURCE_ID = MAKEINTRESOURCE(16{inclusive}); + {$EXTERNALSYM MAXIMUM_RESERVED_MANIFEST_RESOURCE_ID} + +// line 1451 + + KLF_SETFORPROCESS = $00000100; + {$EXTERNALSYM KLF_SETFORPROCESS} + KLF_SHIFTLOCK = $00010000; + {$EXTERNALSYM KLF_SHIFTLOCK} + KLF_RESET = $40000000; + {$EXTERNALSYM KLF_RESET} + +// 64 compatible version of GetWindowLong and SetWindowLong + +const + GWLP_WNDPROC = -4; + {$EXTERNALSYM GWLP_WNDPROC} + GWLP_HINSTANCE = -6; + {$EXTERNALSYM GWLP_HINSTANCE} + GWLP_HWNDPARENT = -8; + {$EXTERNALSYM GWLP_HWNDPARENT} + GWLP_USERDATA = -21; + {$EXTERNALSYM GWLP_USERDATA} + GWLP_ID = -12; + {$EXTERNALSYM GWLP_ID} + +{$EXTERNALSYM GetWindowLongPtr} +function GetWindowLongPtr(hWnd: HWND; nIndex: Integer): TJclAddr; stdcall; +{$EXTERNALSYM SetWindowLongPtr} +function SetWindowLongPtr(hWnd: HWND; nIndex: Integer; dwNewLong: TJclAddr): Longint; stdcall; diff --git a/3rdParty/JCL/source/prototypes/win32api/Winternl.imp b/3rdParty/JCL/source/prototypes/win32api/Winternl.imp new file mode 100644 index 00000000..b885b428 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/Winternl.imp @@ -0,0 +1,19 @@ +{$IFDEF MSWINDOWS} +const + ntdll = 'ntdll.dll'; + +type + TNtQueryInformationThread = function (ThreadHandle: THandle; ThreadInformationClass: THREAD_INFORMATION_CLASS; + ThreadInformation: Pointer; ThreadInformationLength: ULONG; ReturnLength: PULONG): NTSTATUS; stdcall; + +var + _NtQueryInformationThread: TNtQueryInformationThread = nil; + +function NtQueryInformationThread(ThreadHandle: THandle; ThreadInformationClass: THREAD_INFORMATION_CLASS; + ThreadInformation: Pointer; ThreadInformationLength: ULONG; ReturnLength: PULONG): NTSTATUS; +begin + GetProcedureAddress(Pointer(@_NtQueryInformationThread), ntdll, 'NtQueryInformationThread'); + Result := _NtQueryInformationThread(ThreadHandle, ThreadInformationClass, ThreadInformation, ThreadInformationLength, ReturnLength); +end; + +{$ENDIF MSWINDOWS} diff --git a/3rdParty/JCL/source/prototypes/win32api/Winternl.int b/3rdParty/JCL/source/prototypes/win32api/Winternl.int new file mode 100644 index 00000000..f08ca5da --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/Winternl.int @@ -0,0 +1,84 @@ +{$IFDEF MSWINDOWS} + +type + _THREAD_INFORMATION_CLASS = type Cardinal; + {$EXTERNALSYM _THREAD_INFORMATION_CLASS} + THREAD_INFORMATION_CLASS = _THREAD_INFORMATION_CLASS; + {$EXTERNALSYM THREAD_INFORMATION_CLASS} + PTHREAD_INFORMATION_CLASS = ^_THREAD_INFORMATION_CLASS; + {$EXTERNALSYM PTHREAD_INFORMATION_CLASS} + +const + ThreadBasicInformation = 0; + {$EXTERNALSYM ThreadBasicInformation} + ThreadTimes = 1; + {$EXTERNALSYM ThreadTimes} + ThreadPriority = 2; + {$EXTERNALSYM ThreadPriority} + ThreadBasePriority = 3; + {$EXTERNALSYM ThreadBasePriority} + ThreadAffinityMask = 4; + {$EXTERNALSYM ThreadAffinityMask} + ThreadImpersonationToken = 5; + {$EXTERNALSYM ThreadImpersonationToken} + ThreadDescriptorTableEntry = 6; + {$EXTERNALSYM ThreadDescriptorTableEntry} + ThreadEnableAlignmentFaultFixup = 7; + {$EXTERNALSYM ThreadEnableAlignmentFaultFixup} + ThreadEventPair = 8; + {$EXTERNALSYM ThreadEventPair} + ThreadQuerySetWin32StartAddress = 9; + {$EXTERNALSYM ThreadQuerySetWin32StartAddress} + ThreadZeroTlsCell = 10; + {$EXTERNALSYM ThreadZeroTlsCell} + ThreadPerformanceCount = 11; + {$EXTERNALSYM ThreadPerformanceCount} + ThreadAmILastThread = 12; + {$EXTERNALSYM ThreadAmILastThread} + ThreadIdealProcessor = 13; + {$EXTERNALSYM ThreadIdealProcessor} + ThreadPriorityBoost = 14; + {$EXTERNALSYM ThreadPriorityBoost} + ThreadSetTlsArrayAddress = 15; + {$EXTERNALSYM ThreadSetTlsArrayAddress} + ThreadIsIoPending = 16; + {$EXTERNALSYM ThreadIsIoPending} + ThreadHideFromDebugger = 17; + {$EXTERNALSYM ThreadHideFromDebugger} + +type + _CLIENT_ID = record + UniqueProcess: THandle; + UniqueThread: THandle; + end; + {$EXTERNALSYM _CLIENT_ID} + CLIENT_ID = _CLIENT_ID; + {$EXTERNALSYM CLIENT_ID} + PCLIENT_ID = ^CLIENT_ID; + {$EXTERNALSYM PCLIENT_ID} + + KAFFINITY = ULONG; + {$EXTERNALSYM KAFFINITY} + + KPRIORITY = LongInt; + {$EXTERNALSYM KPRIORITY} + + _THREAD_BASIC_INFORMATION = record + ExitStatus: NTSTATUS; + TebBaseAddress: Pointer; + ClientId: CLIENT_ID; + AffinityMask: KAFFINITY; + Priority: KPRIORITY; + BasePriority: KPRIORITY; + end; + {$EXTERNALSYM _THREAD_BASIC_INFORMATION} + THREAD_BASIC_INFORMATION = _THREAD_BASIC_INFORMATION; + {$EXTERNALSYM THREAD_BASIC_INFORMATION} + PTHREAD_BASIC_INFORMATION = ^_THREAD_BASIC_INFORMATION; + {$EXTERNALSYM PTHREAD_BASIC_INFORMATION} + +function NtQueryInformationThread(ThreadHandle: THandle; ThreadInformationClass: THREAD_INFORMATION_CLASS; + ThreadInformation: Pointer; ThreadInformationLength: ULONG; ReturnLength: PULONG): NTSTATUS; stdcall; +{$EXTERNALSYM NtQueryInformationThread} + +{$ENDIF MSWINDOWS} diff --git a/3rdParty/JCL/source/prototypes/win32api/dirinfo.txt b/3rdParty/JCL/source/prototypes/win32api/dirinfo.txt new file mode 100644 index 00000000..7801a5a2 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/dirinfo.txt @@ -0,0 +1,12 @@ +This is the directory where include files for JclWin32.pas reside. + +Each file is named after the Platform SDK header file from which it originates. + +*.int files shall be included in the interface section. +*.imp files shall be included in the implementation section. + +line numbers at present refer to the Jwa* units [*] from which the +code has been ripped off, not to the original header file. + + +* Marcel van Brakel's Win32 API Header translations. \ No newline at end of file diff --git a/3rdParty/JCL/source/prototypes/win32api/powrprof.imp b/3rdParty/JCL/source/prototypes/win32api/powrprof.imp new file mode 100644 index 00000000..08d75dc4 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/powrprof.imp @@ -0,0 +1,50 @@ +const + PowrprofLib = 'PowrProf.dll'; + +type + TIsPwrSuspendAllowed = function : BOOL; stdcall; + +var + _IsPwrSuspendAllowed: TIsPwrSuspendAllowed = nil; + +function IsPwrSuspendAllowed: BOOL; +begin + GetProcedureAddress(Pointer(@_IsPwrSuspendAllowed), PowrprofLib, 'IsPwrSuspendAllowed'); + Result := _IsPwrSuspendAllowed; +end; + +type + TIsPwrHibernateAllowed = function : BOOL; stdcall; + +var + _IsPwrHibernateAllowed: TIsPwrHibernateAllowed = nil; + +function IsPwrHibernateAllowed: BOOL; +begin + GetProcedureAddress(Pointer(@_IsPwrHibernateAllowed), PowrprofLib, 'IsPwrHibernateAllowed'); + Result := _IsPwrHibernateAllowed; +end; + +type + TIsPwrShutdownAllowed = function : BOOL; stdcall; + +var + _IsPwrShutdownAllowed: TIsPwrShutdownAllowed = nil; + +function IsPwrShutdownAllowed: BOOL; +begin + GetProcedureAddress(Pointer(@_IsPwrShutdownAllowed), PowrprofLib, 'IsPwrShutdownAllowed'); + Result := _IsPwrShutdownAllowed; +end; + +type + TSetSuspendState = function (Hibernate, ForceCritical, DisableWakeEvent: BOOL): BOOL; stdcall; + +var + _SetSuspendState: TSetSuspendState = nil; + +function SetSuspendState(Hibernate, ForceCritical, DisableWakeEvent: BOOL): BOOL; +begin + GetProcedureAddress(Pointer(@_SetSuspendState), PowrprofLib, 'SetSuspendState'); + Result := _SetSuspendState(Hibernate, ForceCritical, DisableWakeEvent); +end; diff --git a/3rdParty/JCL/source/prototypes/win32api/powrprof.int b/3rdParty/JCL/source/prototypes/win32api/powrprof.int new file mode 100644 index 00000000..92461cf3 --- /dev/null +++ b/3rdParty/JCL/source/prototypes/win32api/powrprof.int @@ -0,0 +1,4 @@ +function IsPwrSuspendAllowed: BOOL; stdcall; +function IsPwrHibernateAllowed: BOOL; stdcall; +function IsPwrShutdownAllowed: BOOL; stdcall; +function SetSuspendState(Hibernate, ForceCritical, DisableWakeEvent: BOOL): BOOL; stdcall; diff --git a/3rdParty/JCL/source/unix/dirinfo.txt b/3rdParty/JCL/source/unix/dirinfo.txt new file mode 100644 index 00000000..6f6d1ea8 --- /dev/null +++ b/3rdParty/JCL/source/unix/dirinfo.txt @@ -0,0 +1 @@ +This is the directory where Unix-specific units reside. \ No newline at end of file diff --git a/3rdParty/JCL/source/vcl/JclFont.pas b/3rdParty/JCL/source/vcl/JclFont.pas new file mode 100644 index 00000000..efe18c37 --- /dev/null +++ b/3rdParty/JCL/source/vcl/JclFont.pas @@ -0,0 +1,116 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclFont.pas. } +{ } +{ The Initial Developer of the Original Code is Jean-Fabien Connault. } +{ Portions created by these individuals are Copyright (C) of these individuals. } +{ All Rights Reserved. } +{ } +{**************************************************************************************************} +{ } +{ This unit contains function to initialize TFont objects from standard font styles. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclFont; + +{$I jcl.inc} + +interface + +type + TFontType = (ftAuto, ftCaption, ftContent); + +procedure SetObjectFontToSystemFont(const AObject: TObject; const FontType: TFontType = ftAuto); + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + WinApi.Windows, System.SysUtils, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.Graphics, System.TypInfo, + {$ELSE ~HAS_UNITSCOPE} + Windows, SysUtils, StdCtrls, ComCtrls, Graphics, TypInfo, + {$ENDIF ~HAS_UNITSCOPE} + JclSysUtils, JclSysInfo; + +procedure SetCaptionFont(const AObjectFont: TFont); +begin + if JclCheckWinVersion(6, 0) then // WinVista or newer + begin + AObjectFont.Name := 'Segoe UI'; + AObjectFont.Size := 9; + end + else if JclCheckWinVersion(5, 0) then // Win2k or newer + begin + AObjectFont.Name := 'Tahoma'; + AObjectFont.Size := 8; + end + else // Win95..WinME/NT4 + begin + AObjectFont.Name := 'MS Sans Serif'; + AObjectFont.Size := 8; + end; +end; + +procedure SetContentFont(const AObjectFont: TFont); +begin + if JclCheckWinVersion(6, 0) then // WinVista or newer + begin + AObjectFont.Name := 'Calibri'; + AObjectFont.Size := 9; + end + else if JclCheckWinVersion(5, 0) then // Win2k or newer + begin + AObjectFont.Name := 'Verdana'; + AObjectFont.Size := 8; + end + else // Win95..WinME/NT4 + begin + AObjectFont.Name := 'MS Sans Serif'; + AObjectFont.Size := 8; + end; +end; + +procedure SetObjectFontToSystemFont(const AObject: TObject; const FontType: TFontType); +var + AObjectFont: TFont; + AFontType: TFontType; +begin + if AObject.ClassType = TFont then + AObjectFont := TFont(AObject) + else + AObjectFont := TFont(GetObjectProp(AObject, 'Font', TFont)); + + if FontType = ftAuto then + begin + if (AObject.ClassType = TMemo) {$IFDEF BORLAND}or (AObject.ClassType = TRichEdit){$ENDIF} then + AFontType := ftContent + else + AFontType := ftCaption; + end + else + AFontType := FontType; + + if AFontType = ftCaption then + SetCaptionFont(AObjectFont) + else if AFontType = ftContent then + SetContentFont(AObjectFont); +end; + +end. diff --git a/3rdParty/JCL/source/vcl/JclGraphUtils.pas b/3rdParty/JCL/source/vcl/JclGraphUtils.pas new file mode 100644 index 00000000..efd0e746 --- /dev/null +++ b/3rdParty/JCL/source/vcl/JclGraphUtils.pas @@ -0,0 +1,2710 @@ +{**************************************************************************************************} +{ WARNING: JEDI preprocessor generated unit. Do not edit. } +{**************************************************************************************************} + +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclGraphUtils.pas. } +{ } +{ The Initial Developers of the Original Code are Pelle F. S. Liljendal and Marcel van Brakel. } +{ Portions created by these individuals are Copyright (C) of these individuals. } +{ All Rights Reserved. } +{ } +{ Contributors: } +{ Jack N.A. Bakker } +{ Mike Lischke } +{ Robert Marquardt (marquardt) } +{ Alexander Radchenko } +{ Robert Rossmair (rrossmair) } +{ Olivier Sannier (obones) } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclGraphUtils; + +interface + +{$I jcl.inc} + +uses + {$IFDEF HAS_UNITSCOPE} + System.Types, Winapi.Windows, System.SysUtils, Vcl.Graphics, + {$ELSE ~HAS_UNITSCOPE} + Types, Windows, SysUtils, Graphics, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclBase; + +type + PColor32 = ^TColor32; + TColor32 = type Longword; + PColor32Array = ^TColor32Array; + TColor32Array = array [0..MaxInt div SizeOf(TColor32) - 1] of TColor32; + PPalette32 = ^TPalette32; + TPalette32 = array [Byte] of TColor32; + TArrayOfColor32 = array of TColor32; + + { Blending Function Prototypes } + TCombineReg = function(X, Y, W: TColor32): TColor32; + TCombineMem = procedure(F: TColor32; var B: TColor32; W: TColor32); + TBlendReg = function(F, B: TColor32): TColor32; + TBlendMem = procedure(F: TColor32; var B: TColor32); + TBlendRegEx = function(F, B, M: TColor32): TColor32; + TBlendMemEx = procedure(F: TColor32; var B: TColor32; M: TColor32); + TBlendLine = procedure(Src, Dst: PColor32; Count: Integer); + TBlendLineEx = procedure(Src, Dst: PColor32; Count: Integer; M: TColor32); + + { Auxiliary structure to support TColor manipulation } + TColorRec = packed record + case Integer of + 0: (Value: Longint); + 1: (Red, Green, Blue: Byte); + 2: (R, G, B, Flag: Byte); + 3: (Index: Word); // GetSysColor, PaletteIndex + end; + + TColorVector = record + case Integer of + 0: (Coord: array [0..2] of Single); + 1: (R, G, B: Single); + 2: (H, L, S: Single); + end; + + THLSValue = 0..240; + THLSVector = record + Hue: THLSValue; + Luminance: THLSValue; + Saturation: THLSValue; + end; + + TPointArray = array of TPoint; + PPointArray = ^TPointArray; + + { position codes for clipping algorithm } + TClipCode = (ccLeft, ccRight, ccAbove, ccBelow); + TClipCodes = set of TClipCode; + PClipCodes = ^TClipCodes; + +const + { Some predefined color constants } + clBlack32 = TColor32($FF000000); + clDimGray32 = TColor32($FF3F3F3F); + clGray32 = TColor32($FF7F7F7F); + clLightGray32 = TColor32($FFBFBFBF); + clWhite32 = TColor32($FFFFFFFF); + clMaroon32 = TColor32($FF7F0000); + clGreen32 = TColor32($FF007F00); + clOlive32 = TColor32($FF7F7F00); + clNavy32 = TColor32($FF00007F); + clPurple32 = TColor32($FF7F007F); + clTeal32 = TColor32($FF007F7F); + clRed32 = TColor32($FFFF0000); + clLime32 = TColor32($FF00FF00); + clYellow32 = TColor32($FFFFFF00); + clBlue32 = TColor32($FF0000FF); + clFuchsia32 = TColor32($FFFF00FF); + clAqua32 = TColor32($FF00FFFF); + + { Some semi-transparent color constants } + clTrWhite32 = TColor32($7FFFFFFF); + clTrBlack32 = TColor32($7F000000); + clTrRed32 = TColor32($7FFF0000); + clTrGreen32 = TColor32($7F00FF00); + clTrBlue32 = TColor32($7F0000FF); + +// Dialog Functions +function DialogUnitsToPixelsX(const DialogUnits: Word): Word; +function DialogUnitsToPixelsY(const DialogUnits: Word): Word; +function PixelsToDialogUnitsX(const PixelUnits: Word): Word; +function PixelsToDialogUnitsY(const PixelUnits: Word): Word; + +// Points +function NullPoint: TPoint; + +function PointAssign(const X, Y: Integer): TPoint; +procedure PointCopy(var Dest: TPoint; const Source: TPoint); +function PointEqual(const P1, P2: TPoint): Boolean; +function PointIsNull(const P: TPoint): Boolean; +procedure PointMove(var P: TPoint; const DeltaX, DeltaY: Integer); + +// Rectangles +function NullRect: TRect; + +function RectAssign(const Left, Top, Right, Bottom: Integer): TRect; +function RectAssignPoints(const TopLeft, BottomRight: TPoint): TRect; +function RectBounds(const Left, Top, Width, Height: Integer): TRect; +function RectCenter(const R: TRect): TPoint; +procedure RectCopy(var Dest: TRect; const Source: TRect); +procedure RectFitToScreen(var R: TRect); { TODO -cHelp : Doc } +procedure RectGrow(var R: TRect; const Delta: Integer); +procedure RectGrowX(var R: TRect; const Delta: Integer); +procedure RectGrowY(var R: TRect; const Delta: Integer); +function RectEqual(const R1, R2: TRect): Boolean; +function RectHeight(const R: TRect): Integer; +function RectIncludesPoint(const R: TRect; const Pt: TPoint): Boolean; +function RectIncludesRect(const R1, R2: TRect): Boolean; +function RectIntersection(const R1, R2: TRect): TRect; +function RectIntersectRect(const R1, R2: TRect): Boolean; +function RectIsEmpty(const R: TRect): Boolean; +function RectIsNull(const R: TRect): Boolean; +function RectIsSquare(const R: TRect): Boolean; +function RectIsValid(const R: TRect): Boolean; +procedure RectMove(var R: TRect; const DeltaX, DeltaY: Integer); +procedure RectMoveTo(var R: TRect; const X, Y: Integer); +procedure RectNormalize(var R: TRect); +function RectsAreValid(R: array of TRect): Boolean; +function RectUnion(const R1, R2: TRect): TRect; +function RectWidth(const R: TRect): Integer; + +// Clipping +function ClipCodes(const X, Y, MinX, MinY, MaxX, MaxY: Float): TClipCodes; overload; +function ClipCodes(const X, Y: Float; const ClipRect: TRect): TClipCodes; overload; +function ClipLine(var X1, Y1, X2, Y2: Integer; const ClipRect: TRect): Boolean; overload; +function ClipLine(var X1, Y1, X2, Y2: Float; const MinX, MinY, MaxX, MaxY: Float; + Codes: PClipCodes = nil): Boolean; overload; +procedure DrawPolyLine(const Canvas: TCanvas; var Points: TPointArray; const ClipRect: TRect); + +// Color +type + EColorConversionError = class(EJclError); + +procedure GetRGBValue(const Color: TColor; out Red, Green, Blue: Byte); +function SetRGBValue(const Red, Green, Blue: Byte): TColor; +function GetColorBlue(const Color: TColor): Byte; +function GetColorFlag(const Color: TColor): Byte; +function GetColorGreen(const Color: TColor): Byte; +function GetColorRed(const Color: TColor): Byte; +function SetColorBlue(const Color: TColor; const Blue: Byte): TColor; +function SetColorFlag(const Color: TColor; const Flag: Byte): TColor; +function SetColorGreen(const Color: TColor; const Green: Byte): TColor; +function SetColorRed(const Color: TColor; const Red: Byte): TColor; + +function BrightColor(const Color: TColor; const Pct: Single): TColor; +function BrightColorChannel(const Channel: Byte; const Pct: Single): Byte; +function DarkColor(const Color: TColor; const Pct: Single): TColor; +function DarkColorChannel(const Channel: Byte; const Pct: Single): Byte; + +procedure CIED65ToCIED50(var X, Y, Z: Extended); +procedure CMYKToBGR(const Source, Target: Pointer; const BitsPerSample: Byte; Count: Cardinal); overload; +procedure CMYKToBGR(const C, M, Y, K, Target: Pointer; const BitsPerSample: Byte; Count: Cardinal); overload; +procedure CIELABToBGR(const Source, Target: Pointer; const Count: Cardinal); overload; +procedure CIELABToBGR(LSource, aSource, bSource: PByte; const Target: Pointer; const Count: Cardinal); overload; +procedure RGBToBGR(const Source, Target: Pointer; const BitsPerSample: Byte; Count: Cardinal); overload; +procedure RGBToBGR(const R, G, B, Target: Pointer; const BitsPerSample: Byte; Count: Cardinal); overload; +procedure RGBAToBGRA(const Source, Target: Pointer; const BitsPerSample: Byte; Count: Cardinal); + +procedure WinColorToOpenGLColor(const Color: TColor; out Red, Green, Blue: Float); +function OpenGLColorToWinColor(const Red, Green, Blue: Float): TColor; + +function Color32(WinColor: TColor): TColor32; overload; +function Color32(const R, G, B: Byte; const A: Byte = $FF): TColor32; overload; +function Color32(const Index: Byte; const Palette: TPalette32): TColor32; overload; +function Gray32(const Intensity: Byte; const Alpha: Byte = $FF): TColor32; +function WinColor(const Color32: TColor32): TColor; + +function RedComponent(const Color32: TColor32): Integer; +function GreenComponent(const Color32: TColor32): Integer; +function BlueComponent(const Color32: TColor32): Integer; +function AlphaComponent(const Color32: TColor32): Integer; + +function Intensity(const R, G, B: Single): Single; overload; +function Intensity(const Color32: TColor32): Integer; overload; + +function SetAlpha(const Color32: TColor32; NewAlpha: Integer): TColor32; + +procedure HLSToRGB(const H, L, S: Single; out R, G, B: Single); overload; +function HLSToRGB(const HLS: TColorVector): TColorVector; overload; +function HLSToRGB(const Hue, Luminance, Saturation: THLSValue): TColorRef; overload; +procedure RGBToHLS(const R, G, B: Single; out H, L, S: Single); overload; +function RGBToHLS(const RGB: TColorVector): TColorVector; overload; +function RGBToHLS(const RGBColor: TColorRef): THLSVector; overload; + +// obsolete; use corresponding HLS aliases instead +//procedure HSLToRGB(const H, S, L: Single; out R, G, B: Single); overload; +//procedure RGBToHSL(const R, G, B: Single; out H, S, L: Single); overload; + +// keep HSL identifier to avoid ambiguity with HLS overload +function HSLToRGB(const H, S, L: Single): TColor32; overload; +procedure RGBToHSL(const RGB: TColor32; out H, S, L: Single); overload; + +function SetBitmapColors(Bmp: TBitmap; const Colors: array of TColor; StartIndex: Integer): Integer; + +// Misc +function ColorToHTML(const Color: TColor): string; + +// Petr Vones +function DottedLineTo(const Canvas: TCanvas; const X, Y: Integer): Boolean; overload; +function ShortenString(const DC: HDC; const S: WideString; const Width: Integer; const RTL: Boolean; + EllipsisWidth: Integer = 0): WideString; + +var + { Blending Function Variables } + CombineReg: TCombineReg; + CombineMem: TCombineMem; + + BlendReg: TBlendReg; + BlendMem: TBlendMem; + + BlendRegEx: TBlendRegEx; + BlendMemEx: TBlendMemEx; + + BlendLine: TBlendLine; + BlendLineEx: TBlendLineEx; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\vcl'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.Classes, Vcl.Consts, System.Math, + {$ELSE ~HAS_UNITSCOPE} + Classes, Math, + {$IFDEF FPC} + RTLConsts, + {$ELSE ~FPC} + Consts, + {$ENDIF ~FPC} + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF HAS_UNIT_SYSTEM_UITYPES} + System.UITypes, + {$ENDIF HAS_UNIT_SYSTEM_UITYPES} + JclVclResources, JclSysInfo, JclLogic; + +type + // resampling support types + TRGBInt = record + R: Integer; + G: Integer; + B: Integer; + end; + + PRGBWord = ^TRGBWord; + TRGBWord = record + R: Word; + G: Word; + B: Word; + end; + + PRGBAWord = ^TRGBAWord; + TRGBAWord = record + R: Word; + G: Word; + B: Word; + A: Word; + end; + + PBGR = ^TBGR; + TBGR = packed record + B: Byte; + G: Byte; + R: Byte; + end; + + PBGRA = ^TBGRA; + TBGRA = packed record + B: Byte; + G: Byte; + R: Byte; + A: Byte; + end; + + PRGB = ^TRGB; + TRGB = packed record + R: Byte; + G: Byte; + B: Byte; + end; + + PRGBA = ^TRGBA; + TRGBA = packed record + R: Byte; + G: Byte; + B: Byte; + A: Byte; + end; + +const + { Component masks } + _R = TColor32($00FF0000); + _G = TColor32($0000FF00); + _B = TColor32($000000FF); + _RGB = TColor32($00FFFFFF); + Bias = $00800080; + +var + SSE2_ACTIVE: Boolean; + + +procedure OutOfResources; +begin + raise EOutOfResources.CreateRes(@SOutOfResources); +end; + +procedure GDIError; +var + ErrorCode: Integer; + Buf: array [0..255] of Char; +begin + ErrorCode := GetLastError; + if (ErrorCode <> 0) and (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, + ErrorCode, LOCALE_USER_DEFAULT, Buf, Length(Buf), nil) <> 0) then + raise EOutOfResources.Create(Buf) + else + OutOfResources; +end; + +function GDICheck(Value: Integer): Integer; +begin + if Value = 0 then GDIError; + Result := Value; +end; + + +//=== Internal LowLevel ====================================================== + +function ColorSwap(WinColor: TColor): TColor32; +// this function swaps R and B bytes in ABGR and writes $FF into A component +begin + Result := $FF000000 or // A component + TColor32((WinColor and $0000FF) shl 16) or // R component + TColor32( WinColor and $00FF00) or // G component + TColor32((WinColor and $FF0000) shr 16); // B component +end; + +//=== Blending routines ====================================================== + +function _CombineReg(X, Y, W: TColor32): TColor32; +begin + // combine RGBA channels of colors X and Y with the weight of X given in W + // Result Z = W * X + (1 - W) * Y (all channels are combined, including alpha) + + if W = 0 then + Result := Y //May be if W <= 0 ??? + else + if W = $FF then Result := X //May be if W >= $FF ??? Or if W > $FF ??? + else + begin + Result := + (((((X shr 8 {00Xa00Xg}) and $00FF00FF {00X100X2}) * W {P1**P2**}) + + Bias) and $FF00FF00 {P100P200}) {Pa00Pg00} or + (((((X {00Xr00Xb} and $00FF00FF {00X100X2}) * W {P1**P2**}) + Bias) and + $FF00FF00 {P100P200}) shr 8 {00Pr00Pb}) {PaPrPgPb}; + + W := W xor $FF; // W := 1 - W; + //W := $100 - W; // May be so ??? + + Result := Result {PaPrPgPb} + ( + (((((Y shr 8 {00Ya00Yg}) and $00FF00FF {00X100X2}) * W {P1**P2**}) + + Bias) and $FF00FF00 {P100P200}) {Qa00Qg00} or + (((((Y {00Yr00Yb} and $00FF00FF {00X100X2}) * W {P1**P2**}) + Bias) and + $FF00FF00 {P100P200}) shr 8 {00Qr00Qb}) {QaQrQgQb} + ) {ZaZrZgZb}; + end; +end; + +procedure _CombineMem(F: TColor32; var B: TColor32; W: TColor32); +begin + B := _CombineReg(F, B, W); +end; + +function _BlendReg(F, B: TColor32): TColor32; +begin + Result := _CombineReg(F, B, F shr 24); +end; + +procedure _BlendMem(F: TColor32; var B: TColor32); +begin + B := _CombineReg(F, B, F shr 24); +end; + +function _BlendRegEx(F, B, M: TColor32): TColor32; +begin + Result := _CombineReg(F, B, ((F shr 24) * M) shr 8); +end; + +procedure _BlendMemEx(F: TColor32; var B: TColor32; M: TColor32); +begin + B := _CombineReg(F, B, ((F shr 24) * M) shr 8); +end; + + +procedure _BlendLine(Src, Dst: PColor32; Count: Integer); assembler; +asm + {$IFDEF CPU32} + // EAX <- Src + // EDX <- Dst + // ECX <- Count + + // test the counter for zero or negativity + TEST ECX, ECX + JS @4 + + PUSH EBX + PUSH ESI + PUSH EDI + + MOV ESI, EAX // ESI <- Src + MOV EDI, EDX // EDI <- Dst + + // loop start +@1: MOV EAX, [ESI] + TEST EAX, $FF000000 + JZ @3 // complete transparency, proceed to next point + + PUSH ECX // store counter + + // Get weight W = Fa * M + MOV ECX, EAX // ECX <- Fa Fr Fg Fb + SHR ECX, 24 // ECX <- 00 00 00 Fa + + // Test Fa = 255 ? + CMP ECX, $FF + JZ @2 + + // P = W * F + MOV EBX, EAX // EBX <- Fa Fr Fg Fb + AND EAX, $00FF00FF // EAX <- 00 Fr 00 Fb + AND EBX, $FF00FF00 // EBX <- Fa 00 Fg 00 + IMUL EAX, ECX // EAX <- Pr ** Pb ** + SHR EBX, 8 // EBX <- 00 Fa 00 Fg + IMUL EBX, ECX // EBX <- Pa ** Pg ** + ADD EAX, Bias + AND EAX, $FF00FF00 // EAX <- Pr 00 Pb 00 + SHR EAX, 8 // EAX <- 00 Pr ** Pb + ADD EBX, Bias + AND EBX, $FF00FF00 // EBX <- Pa 00 Pg 00 + OR EAX, EBX // EAX <- Pa Pr Pg Pb + + // W = 1 - W; Q = W * B + MOV EDX, [EDI] + XOR ECX, $000000FF // ECX <- 1 - ECX + MOV EBX, EDX // EBX <- Ba Br Bg Bb + AND EDX, $00FF00FF // ESI <- 00 Br 00 Bb + AND EBX, $FF00FF00 // EBX <- Ba 00 Bg 00 + IMUL EDX, ECX // ESI <- Qr ** Qb ** + SHR EBX, 8 // EBX <- 00 Ba 00 Bg + IMUL EBX, ECX // EBX <- Qa ** Qg ** + ADD EDX, Bias + AND EDX, $FF00FF00 // ESI <- Qr 00 Qb 00 + SHR EDX, 8 // ESI <- 00 Qr ** Qb + ADD EBX, Bias + AND EBX, $FF00FF00 // EBX <- Qa 00 Qg 00 + OR EBX, EDX // EBX <- Qa Qr Qg Qb + + // Z = P + Q (assuming no overflow at each byte) + ADD EAX, EBX // EAX <- Za Zr Zg Zb +@2: MOV [EDI], EAX + + POP ECX // restore counter + +@3: ADD ESI, 4 + ADD EDI, 4 + + // loop end + DEC ECX + JNZ @1 + + POP EDI + POP ESI + POP EBX + +@4: RET + {$ENDIF CPU32} + {$IFDEF CPU64} + // RCX <- Src EAX + // RDX <- Dst EDX + // R8 <- Count ECX + + // R9 = EBX + // R10 = ESI + // R11 = EDI + + // test the counter for zero or negativity + TEST R8, R8 + JS @4 + + MOV R10, RCX // ESI <- Src + MOV R11, RDX // EDI <- Dst + + // loop start +@1: MOV EAX, DWORD PTR [R10] + TEST EAX, $FF000000 + JZ @3 // complete transparency, proceed to next point + + // Get weight W = Fa * M + MOV RCX, RAX // ECX <- Fa Fr Fg Fb + SHR RCX, 24 // ECX <- 00 00 00 Fa + + // Test Fa = 255 ? + CMP RCX, $FF + JZ @2 + + // P = W * F + MOV R9 , RAX // R9 <- Fa Fr Fg Fb + AND EAX, $00FF00FF // EAX <- 00 Fr 00 Fb + AND R9 , $FF00FF00 // EBX <- Fa 00 Fg 00 + IMUL RAX, RCX // EAX <- Pr ** Pb ** + SHR R9 , 8 // EBX <- 00 Fa 00 Fg + IMUL R9 , RCX // EBX <- Pa ** Pg ** + ADD RAX, Bias + AND RAX, $FF00FF00 // EAX <- Pr 00 Pb 00 + SHR RAX, 8 // EAX <- 00 Pr ** Pb + ADD R9 , Bias + AND R9 , $FF00FF00 // E8 <- Pa 00 Pg 00 + OR RAX, R9 // EAX <- Pa Pr Pg Pb + + // W = 1 - W; Q = W * B + MOV EDX, DWORD PTR [R11] + XOR RCX, $000000FF // ECX <- 1 - ECX + MOV R9 , RDX // EBX <- Ba Br Bg Bb + AND RDX, $00FF00FF // ESI <- 00 Br 00 Bb + AND R9 , $FF00FF00 // EBX <- Ba 00 Bg 00 + IMUL RDX, RCX // ESI <- Qr ** Qb ** + SHR R9 , 8 // EBX <- 00 Ba 00 Bg + IMUL R9 , RCX // EBX <- Qa ** Qg ** + ADD RDX, Bias + AND RDX, $FF00FF00 // ESI <- Qr 00 Qb 00 + SHR RDX, 8 // ESI <- 00 Qr ** Qb + ADD R9 , Bias + AND R9 , $FF00FF00 // EBX <- Qa 00 Qg 00 + OR R9 , RDX // EBX <- Qa Qr Qg Qb + + // Z = P + Q (assuming no overflow at each byte) + ADD RAX, R9 // EAX <- Za Zr Zg Zb +@2: MOV DWORD PTR [EDI], EAX + +@3: ADD R10, 4 + ADD R11, 4 + + // loop end + DEC R8 + JNZ @1 + + +@4: RET + {$ENDIF CPU64} +end; + +procedure _BlendLineEx(Src, Dst: PColor32; Count: Integer; M: TColor32); +begin + while Count > 0 do + begin + _BlendMemEx(Src^, Dst^, M); + Inc(Src); + Inc(Dst); + Dec(Count); + end; +end; + +{ SSE2 versions } + +var + AlphaTable: Pointer; + bias_ptr: Pointer; + alpha_ptr: Pointer; + +procedure GenAlphaTable; +var + I: Integer; + L: Longword; + P: ^Longword; +begin + GetMem(AlphaTable, 257 * 8); + if (TJclAddr(AlphaTable) mod 8) <> 0 then + alpha_ptr := Pointer((TJclAddr(AlphaTable) + 8) and (not TJclAddr(7))) + else + alpha_ptr := AlphaTable; + P := alpha_ptr; + for I := 0 to 255 do + begin + L := I + I shl 16; + P^ := L; + Inc(P); + P^ := L; + Inc(P); + end; + bias_ptr := Pointer(TJclAddr(alpha_ptr) + $80 * 8); +end; + +procedure FreeAlphaTable; +begin + FreeMem(AlphaTable); + AlphaTable := nil; +end; + +function SSE2_CombineReg(X, Y, W: TColor32): TColor32; assembler; +asm + // Result := W * (X - Y) + Y + {$IFDEF CPU32} + // EAX - Color X + // EDX - Color Y + // ECX - Weight of X [0..255] + + PXOR XMM0, XMM0 + MOVD XMM1, EAX + SHL ECX, 3 + MOVD XMM2, EDX + PUNPCKLBW XMM1, XMM0 + PUNPCKLBW XMM2, XMM0 + ADD ECX, alpha_ptr + PSUBW XMM1, XMM2 + PMULLW XMM1, [ECX] + PSLLW XMM2, 8 + MOV ECX, bias_ptr + PADDW XMM2, [ECX] + PADDW XMM1, XMM2 + PSRLW XMM1, 8 + PACKUSWB XMM1, XMM0 + MOVD EAX, XMM1 + {$ENDIF CPU32} + {$IFDEF CPU64} + // RCX - Color X + // RDX - Color Y + // R8 - Weight of X [0..255] + + PXOR XMM0, XMM0 + MOVD XMM1, ECX + SHL R8, 3 + MOVD XMM2, EDX + PUNPCKLBW XMM1, XMM0 + PUNPCKLBW XMM2, XMM0 + ADD R8, alpha_ptr + PSUBW XMM1, XMM2 + PMULLW XMM1, [R8] + PSLLW XMM2, 8 + MOV R8, bias_ptr + PADDW XMM2, [R8] + PADDW XMM1, XMM2 + PSRLW XMM1, 8 + PACKUSWB XMM1, XMM0 + MOVD EAX, XMM1 + {$ENDIF CPU64} +end; + +procedure SSE2_CombineMem(F: TColor32; var B: TColor32; W: TColor32); +begin + B := SSE2_CombineReg(F, B, W); +end; + +function SSE2_BlendReg(F, B: TColor32): TColor32; assembler; +asm + // blend foreground color (F) to a background color (B), + // using alpha channel value of F + // Result := Fa * (Frgb - Brgb) + Brgb + {$IFDEF CPU32} + // EAX <- F + // EDX <- B + PXOR XMM3, XMM3 + MOVD XMM0, EAX + MOVD XMM2, EDX + PUNPCKLBW XMM0, XMM3 + MOV ECX, bias_ptr + PUNPCKLBW XMM2, XMM3 + MOVQ XMM1, XMM0 + //PUNPCKHWD MM1, MM1 // MMX + PUNPCKLWD XMM1, XMM1 + PUNPCKHQDQ XMM1, XMM1 + PSUBW XMM0, XMM2 + //PUNPCKHDQ MM1, MM1 // MMX + PUNPCKLWD XMM1, XMM1 + PUNPCKHQDQ XMM1, XMM1 + PSLLW XMM2, 8 + PMULLW XMM0, XMM1 + PADDW XMM2, [ECX] + PADDW XMM2, XMM0 + PSRLW XMM2, 8 + PACKUSWB XMM2, XMM3 + MOVD EAX, XMM2 + {$ENDIF CPU32} + {$IFDEF CPU64} + // RCX <- F + // RDX <- B + PXOR XMM3, XMM3 + MOVD XMM0, ECX + MOVD XMM2, EDX + PUNPCKLBW XMM0, XMM3 + MOV R8, bias_ptr + PUNPCKLBW XMM2, XMM3 + MOVQ XMM1, XMM0 + //PUNPCKHWD MM1, MM1 // MMX + PUNPCKLWD XMM1, XMM1 + PUNPCKHQDQ XMM1, XMM1 + PSUBW XMM0, XMM2 + //PUNPCKHDQ MM1, MM1 // MMX + PUNPCKLWD XMM1, XMM1 + PUNPCKHQDQ XMM1, XMM1 + PSLLW XMM2, 8 + PMULLW XMM0, XMM1 + PADDW XMM2, [R8] + PADDW XMM2, XMM0 + PSRLW XMM2, 8 + PACKUSWB XMM2, XMM3 + MOVD EAX, XMM2 + {$ENDIF CPU64} +end; + +procedure SSE2_BlendMem(F: TColor32; var B: TColor32); +begin + B := SSE2_BlendReg(F, B); +end; + +function SSE2_BlendRegEx(F, B, M: TColor32): TColor32; assembler; +asm + // blend foreground color (F) to a background color (B), + // using alpha channel value of F + // Result := M * Fa * (Frgb - Brgb) + Brgb + {$IFDEF CPU32} + // EAX <- F + // EDX <- B + // ECX <- M + PUSH EBX + MOV EBX, EAX + SHR EBX, 24 + IMUL ECX, EBX + SHR ECX, 8 + JZ @1 + + PXOR XMM0, XMM0 + MOVD XMM1, EAX + SHL ECX, 3 + MOVD XMM2, EDX + PUNPCKLBW XMM1, XMM0 + PUNPCKLBW XMM2, XMM0 + ADD ECX, alpha_ptr + PSUBW XMM1, XMM2 + PMULLW XMM1, [ECX] + PSLLW XMM2, 8 + MOV ECX, bias_ptr + PADDW XMM2, [ECX] + PADDW XMM1, XMM2 + PSRLW XMM1, 8 + PACKUSWB XMM1, XMM0 + MOVD EAX, XMM1 + + POP EBX + RET +@1: MOV EAX, EDX + POP EBX + {$ENDIF CPU32} + {$IFDEF CPU64} + // RCX <- F + // EDX <- B + // R8 <- M + MOV R9, RCX + SHR R9, 24 + IMUL R8, R9 + SHR R8, 8 + JZ @1 + + PXOR XMM0, XMM0 + MOVD XMM1, ECX + SHL R8, 3 + MOVD XMM2, EDX + PUNPCKLBW XMM1, XMM0 + PUNPCKLBW XMM2, XMM0 + ADD R8, alpha_ptr + PSUBW XMM1, XMM2 + PMULLW XMM1, [R8] + PSLLW XMM2, 8 + MOV R8, bias_ptr + PADDW XMM2, [R8] + PADDW XMM1, XMM2 + PSRLW XMM1, 8 + PACKUSWB XMM1, XMM0 + MOVD EAX, XMM1 + RET + +@1: MOV RAX, RDX + {$ENDIF CPU64} +end; + +procedure SSE2_BlendMemEx(F: TColor32; var B: TColor32; M: TColor32); +begin + B := SSE2_BlendRegEx(F, B, M); +end; + +procedure SSE2_BlendLine(Src, Dst: PColor32; Count: Integer); assembler; +asm + {$IFDEF CPU32} + // EAX <- Src + // EDX <- Dst + // ECX <- Count + + // test the counter for zero or negativity + TEST ECX, ECX + JS @4 + + PUSH ESI + PUSH EDI + + MOV ESI, EAX // ESI <- Src + MOV EDI, EDX // EDI <- Dst + + // loop start +@1: MOV EAX, [ESI] + TEST EAX, $FF000000 + JZ @3 // complete transparency, proceed to next point + CMP EAX, $FF000000 + JNC @2 // opaque pixel, copy without blending + + // blend + PXOR XMM3, XMM3 + MOVD XMM0, EAX + MOVD XMM2, [EDI] + PUNPCKLBW XMM0, XMM3 + MOV EAX, bias_ptr + PUNPCKLBW XMM2, XMM3 + MOVQ XMM1, XMM0 + //PUNPCKHWD MM1, MM1 // MMX + PUNPCKLWD XMM1, XMM1 + PUNPCKHQDQ XMM1, XMM1 + PSUBW XMM0, XMM2 + //PUNPCKHDQ MM1, MM1 // MMX + PUNPCKLWD XMM1, XMM1 + PUNPCKHQDQ XMM1, XMM1 + PSLLW XMM2, 8 + PMULLW XMM0, XMM1 + PADDW XMM2, [EAX] + PADDW XMM2, XMM0 + PSRLW XMM2, 8 + PACKUSWB XMM2, XMM3 + MOVD EAX, XMM2 + +@2: MOV [EDI], EAX + +@3: ADD ESI, 4 + ADD EDI, 4 + + // loop end + DEC ECX + JNZ @1 + + POP EDI + POP ESI + +@4: RET + {$ENDIF CPU32} + {$IFDEF CPU64} + // RCX <- Src + // RDX <- Dst + // R8 <- Count + + // test the counter for zero or negativity + TEST R8, R8 + JS @4 + + MOV R10, RCX // R10 <- Src + MOV R11, RDX // R11 <- Dst + + // loop start +@1: MOV EAX, DWORD PTR [R10] + TEST EAX, $FF000000 + JZ @3 // complete transparency, proceed to next point + CMP EAX, $FF000000 + JNC @2 // opaque pixel, copy without blending + + // blend + PXOR XMM3, XMM3 + MOVD XMM0, ECX + MOVD XMM2, [R11] + PUNPCKLBW XMM0, XMM3 + MOV RAX, bias_ptr + PUNPCKLBW XMM2, XMM3 + MOVQ XMM1, XMM0 + //PUNPCKHWD XMM1, XMM1 // MMX + PUNPCKLWD XMM1, XMM1 + PUNPCKHQDQ XMM1, XMM1 + PSUBW XMM0, XMM2 + //PUNPCKHDQ MM1, MM1 // MMX + PUNPCKLWD XMM1, XMM1 + PUNPCKHQDQ XMM1, XMM1 + PSLLW XMM2, 8 + PMULLW XMM0, XMM1 + PADDW XMM2, [RAX] + PADDW XMM2, XMM0 + PSRLW XMM2, 8 + PACKUSWB XMM2, XMM3 + MOVD EAX, XMM2 + +@2: MOV DWORD PTR [R11], EAX + +@3: ADD R10, 4 + ADD R11, 4 + + // loop end + DEC R8 + JNZ @1 + +@4: RET + {$ENDIF CPU64} +end; + +procedure SSE2_BlendLineEx(Src, Dst: PColor32; Count: Integer; M: TColor32); assembler; +asm + {$IFDEF CPU32} + // EAX <- Src + // EDX <- Dst + // ECX <- Count + + // test the counter for zero or negativity + TEST ECX, ECX + JS @4 + + PUSH ESI + PUSH EDI + PUSH EBX + + MOV ESI, EAX // ESI <- Src + MOV EDI, EDX // EDI <- Dst + MOV EDX, M // EDX <- Master Alpha + + // loop start +@1: MOV EAX, [ESI] + TEST EAX, $FF000000 + JZ @3 // complete transparency, proceed to next point + MOV EBX, EAX + SHR EBX, 24 + IMUL EBX, EDX + SHR EBX, 8 + JZ @3 // complete transparency, proceed to next point + + // blend + PXOR XMM0, XMM0 + MOVD XMM1, EAX + SHL EBX, 3 + MOVD XMM2, [EDI] + PUNPCKLBW XMM1, XMM0 + PUNPCKLBW XMM2, XMM0 + ADD EBX, alpha_ptr + PSUBW XMM1, XMM2 + PMULLW XMM1, [EBX] + PSLLW XMM2, 8 + MOV EBX, bias_ptr + PADDW XMM2, [EBX] + PADDW XMM1, XMM2 + PSRLW XMM1, 8 + PACKUSWB XMM1, XMM0 + MOVD EAX, XMM1 + +@2: MOV [EDI], EAX + +@3: ADD ESI, 4 + ADD EDI, 4 + + // loop end + DEC ECX + JNZ @1 + + POP EBX + POP EDI + POP ESI +@4: + {$ENDIF CPU32} + {$IFDEF CPU64} + // RCX <- Src + // RDX <- Dst + // R8 <- Count + // R9 <- M + + // test the counter for zero or negativity + TEST R8, R8 + JS @4 + + MOV R10, RCX // R10 <- Src + MOV R11, RDX // R11 <- Dst + MOV RDX, R9 // RDX <- Master Alpha + + // loop start +@1: MOV EAX, DWORD PTR [R10] + TEST EAX, $FF000000 + JZ @3 // complete transparency, proceed to next point + MOV R9, RAX + SHR R9, 24 + IMUL R9, RDX + SHR R9, 8 + JZ @3 // complete transparency, proceed to next point + + // blend + PXOR XMM0, XMM0 + MOVD XMM1, EAX + SHL R9, 3 + MOVD XMM2, [RDI] + PUNPCKLBW XMM1, XMM0 + PUNPCKLBW XMM2, XMM0 + ADD RBX, alpha_ptr + PSUBW XMM1, XMM2 + PMULLW XMM1, [R9] + PSLLW XMM2, 8 + MOV R9, bias_ptr + PADDW XMM2, [R9] + PADDW XMM1, XMM2 + PSRLW XMM1, 8 + PACKUSWB XMM1, XMM0 + MOVD EAX, XMM1 + +@2: MOV DWORD PTR [R11], EAX + +@3: ADD R10, 4 + ADD R11, 4 + + // loop end + DEC R8 + JNZ @1 +@4: + {$ENDIF CPU64} +end; + +{ MMX Detection and linking } + +procedure SetupFunctions; +var + CpuInfo: TCpuInfo; +begin + //WIMDC + CpuInfo := CPUID; + SSE2_ACTIVE := (CpuInfo.Features and SSE2_FLAG) = SSE2_FLAG; + if SSE2_ACTIVE then + begin + // link SSE2 functions + CombineReg := SSE2_CombineReg; + CombineMem := SSE2_CombineMem; + BlendReg := SSE2_BlendReg; + BlendMem := SSE2_BlendMem; + BlendRegEx := SSE2_BlendRegEx; + BlendMemEx := SSE2_BlendMemEx; + BlendLine := SSE2_BlendLine; + BlendLineEx := SSE2_BlendLineEx; + end + else + begin + // link non-SSE2 functions + CombineReg := _CombineReg; + CombineMem := _CombineMem; + BlendReg := _BlendReg; + BlendMem := _BlendMem; + BlendRegEx := _BlendRegEx; + BlendMemEx := _BlendMemEx; + BlendLine := _BlendLine; + BlendLineEx := _BlendLineEx; + end; +end; + +//=== Dialog functions ======================================================= + +function DialogUnitsToPixelsX(const DialogUnits: Word): Word; +begin + Result := (DialogUnits * LoWord(GetDialogBaseUnits)) div 4; +end; + +function DialogUnitsToPixelsY(const DialogUnits: Word): Word; +begin + Result := (DialogUnits * HiWord(GetDialogBaseUnits)) div 8; +end; + +function PixelsToDialogUnitsX(const PixelUnits: Word): Word; +begin + Result := PixelUnits * 4 div LoWord(GetDialogBaseUnits); +end; + +function PixelsToDialogUnitsY(const PixelUnits: Word): Word; +begin + Result := PixelUnits * 8 div HiWord(GetDialogBaseUnits); +end; + +//=== Points ================================================================= + +function NullPoint: TPoint; +begin + Result.X := 0; + Result.Y := 0; +end; + +function PointAssign(const X, Y: Integer): TPoint; +begin + Result.X := X; + Result.Y := Y; +end; + +procedure PointCopy(var Dest: TPoint; const Source: TPoint); +begin + Dest.X := Source.X; + Dest.Y := Source.Y; +end; + +function PointEqual(const P1, P2: TPoint): Boolean; +begin + Result := (P1.X = P2.X) and (P1.Y = P2.Y); +end; + +function PointIsNull(const P: TPoint): Boolean; +begin + Result := (P.X = 0) and (P.Y = 0); +end; + +procedure PointMove(var P: TPoint; const DeltaX, DeltaY: Integer); +begin + P.X := P.X + DeltaX; + P.Y := P.Y + DeltaY; +end; + +//=== Rectangles ============================================================= + +function NullRect: TRect; +begin + with Result do + begin + Top := 0; + Left := 0; + Bottom := 0; + Right := 0; + end; +end; + +function RectAssign(const Left, Top, Right, Bottom: Integer): TRect; +begin + Result.Left := Left; + Result.Top := Top; + Result.Right := Right; + Result.Bottom := Bottom; +end; + +function RectAssignPoints(const TopLeft, BottomRight: TPoint): TRect; +begin + Result.TopLeft := TopLeft; + Result.BottomRight := BottomRight; +end; + +function RectBounds(const Left, Top, Width, Height: Integer): TRect; +begin + Result := RectAssign(Left, Top, Left + Width, Top + Height); +end; + +function RectCenter(const R: TRect): TPoint; +begin + Result.X := R.Left + (RectWidth(R) div 2); + Result.Y := R.Top + (RectHeight(R) div 2); +end; + +procedure RectCopy(var Dest: TRect; const Source: TRect); +begin + Dest := Source; +end; + +procedure RectFitToScreen(var R: TRect); +var + X, Y: Integer; + Delta: Integer; +begin + X := GetSystemMetrics(SM_CXSCREEN); + Y := GetSystemMetrics(SM_CYSCREEN); + + with R do + begin + if Right > X then + begin + Delta := Right - Left; + Right := X; + Left := Right - Delta; + end; + if Left < 0 then + begin + Delta := Right - Left; + Left := 0; + Right := Left + Delta; + end; + if Bottom > Y then + begin + Delta := Bottom - Top; + Bottom := Y; + Top := Bottom - Delta; + end; + if Top < 0 then + begin + Delta := Bottom - Top; + Top := 0; + Bottom := Top + Delta; + end; + end; +end; + +procedure RectGrow(var R: TRect; const Delta: Integer); +begin + with R do + begin + Dec(Left, Delta); + Dec(Top, Delta); + Inc(Right, Delta); + Inc(Bottom, Delta); + end; +end; + +procedure RectGrowX(var R: TRect; const Delta: Integer); +begin + with R do + begin + Dec(Left, Delta); + Inc(Right, Delta); + end; +end; + +procedure RectGrowY(var R: TRect; const Delta: Integer); +begin + with R do + begin + Dec(Top, Delta); + Inc(Bottom, Delta); + end; +end; + +function RectEqual(const R1, R2: TRect): Boolean; +begin + Result := (R1.Left = R2.Left) and (R1.Top = R2.Top) and + (R1.Right = R2.Right) and (R1.Bottom = R2.Bottom); +end; + +function RectHeight(const R: TRect): Integer; +begin + Result := Abs(R.Bottom - R.Top); +end; + +function RectIncludesPoint(const R: TRect; const Pt: TPoint): Boolean; +begin + Result := (Pt.X > R.Left) and (Pt.X < R.Right) and + (Pt.Y > R.Top) and (Pt.Y < R.Bottom); +end; + +function RectIncludesRect(const R1, R2: TRect): Boolean; +begin + Result := (R1.Left >= R2.Left) and (R1.Top >= R2.Top) and + (R1.Right <= R2.Right) and (R1.Bottom <= R2.Bottom); +end; + +function RectIntersection(const R1, R2: TRect): TRect; +begin + with Result do + begin + Left := JclLogic.Max(R1.Left, R2.Left); + Top := JclLogic.Max(R1.Top, R2.Top); + Right := JclLogic.Min(R1.Right, R2.Right); + Bottom := JclLogic.Min(R1.Bottom, R2.Bottom); + end; + if not RectIsValid(Result) then + Result := NullRect; +end; + +function RectIntersectRect(const R1, R2: TRect): Boolean; +begin + Result := not RectIsNull(RectIntersection(R1, R2)); +end; + +function RectIsEmpty(const R: TRect): Boolean; +begin + Result := (R.Right = R.Left) and (R.Bottom = R.Top); +end; + +function RectIsNull(const R: TRect): Boolean; +begin + with R do + Result := (Left = 0) and (Right = 0) and (Top = 0) and (Bottom = 0); +end; + +function RectIsSquare(const R: TRect): Boolean; +begin + Result := (RectHeight(R) = RectWidth(R)); +end; + +function RectIsValid(const R: TRect): Boolean; +begin + with R do + Result := (Left <= Right) and (Top <= Bottom); +end; + +procedure RectMove(var R: TRect; const DeltaX, DeltaY: Integer); +begin + with R do + begin + Inc(Left, DeltaX); + Inc(Right, DeltaX); + Inc(Top, DeltaY); + Inc(Bottom, DeltaY); + end; +end; + +procedure RectMoveTo(var R: TRect; const X, Y: Integer); +begin + with R do + begin + Right := (Right - Left) + X; + Bottom := (Bottom - Top) + Y; + Left := X; + Top := Y; + end; +end; + +procedure RectNormalize(var R: TRect); +var + Temp: Integer; +begin + if R.Left > R.Right then + begin + Temp := R.Left; + R.Left := R.Right; + R.Right := Temp; + end; + if R.Top > R.Bottom then + begin + Temp := R.Top; + R.Top := R.Bottom; + R.Bottom := Temp; + end; +end; + +function RectsAreValid(R: array of TRect): Boolean; +var + I: Integer; +begin + if Length(R) = 0 then + begin + Result := False; + Exit; + end; + for I := Low(R) to High(R) do + begin + with R[I] do + Result := (Left <= Right) and (Top <= Bottom); + if not Result then + Exit; + end; + Result := True; +end; + +function RectUnion(const R1, R2: TRect): TRect; +begin + with Result do + begin + Left := JclLogic.Min(R1.Left, R2.Left); + Top := JclLogic.Min(R1.Top, R2.Top); + Right := JclLogic.Max(R1.Right, R2.Right); + Bottom := JclLogic.Max(R1.Bottom, R2.Bottom); + end; + if not RectIsValid(Result) then + Result := NullRect; +end; + +function RectWidth(const R: TRect): Integer; +begin + Result := Abs(R.Right - R.Left); +end; + +//=== Color ================================================================== + +const + MaxBytePercent = High(Byte) * 0.01; + +procedure GetRGBValue(const Color: TColor; out Red, Green, Blue: Byte); +var + Temp: TColorRec; +begin + Temp.Value := ColorToRGB(Color); + Red := Temp.R; + Green := Temp.G; + Blue := Temp.B; +end; + +function SetRGBValue(const Red, Green, Blue: Byte): TColor; +begin + TColorRec(Result).Red := Red; + TColorRec(Result).Green := Green; + TColorRec(Result).Blue := Blue; + TColorRec(Result).Flag := 0; +end; + +function SetColorFlag(const Color: TColor; const Flag: Byte): TColor; +begin + Result := Color; + TColorRec(Result).Flag := Flag; +end; + +function GetColorFlag(const Color: TColor): Byte; +begin + Result := TColorRec(Color).Flag; +end; + +function SetColorRed(const Color: TColor; const Red: Byte): TColor; +begin + Result := ColorToRGB(Color); + TColorRec(Result).Red := Red; +end; + +function GetColorRed(const Color: TColor): Byte; +var + Temp: TColorRec; +begin + Temp.Value := ColorToRGB(Color); + Result := Temp.Red; +end; + +function SetColorGreen(const Color: TColor; const Green: Byte): TColor; +begin + Result := ColorToRGB(Color); + TColorRec(Result).Green := Green; +end; + +function GetColorGreen(const Color: TColor): Byte; +var + Temp: TColorRec; +begin + Temp.Value := ColorToRGB(Color); + Result := Temp.Green; +end; + +function SetColorBlue(const Color: TColor; const Blue: Byte): TColor; +begin + Result := ColorToRGB(Color); + TColorRec(Result).Blue := Blue; +end; + +function GetColorBlue(const Color: TColor): Byte; +var + Temp: TColorRec; +begin + Temp.Value := ColorToRGB(Color); + Result := Temp.Blue; +end; + +function BrightColor(const Color: TColor; const Pct: Single): TColor; +var + Temp: TColorRec; +begin + Temp.Value := ColorToRGB(Color); + Temp.R := BrightColorChannel(Temp.R, Pct); + Temp.G := BrightColorChannel(Temp.G, Pct); + Temp.B := BrightColorChannel(Temp.B, Pct); + Result := Temp.Value; +end; + +function BrightColorChannel(const Channel: Byte; const Pct: Single): Byte; +var + Temp: Integer; +begin + if Pct < 0 then + Result := DarkColorChannel(Channel, -Pct) + else + begin + Temp := Round(Channel + Pct * MaxBytePercent); + if Temp > High(Result) then + Result := High(Result) + else + Result := Temp; + end; +end; + +function DarkColor(const Color: TColor; const Pct: Single): TColor; +var + Temp: TColorRec; +begin + Temp.Value := ColorToRGB(Color); + Temp.R := DarkColorChannel(Temp.R, Pct); + Temp.G := DarkColorChannel(Temp.G, Pct); + Temp.B := DarkColorChannel(Temp.B, Pct); + Result := Temp.Value; +end; + +function DarkColorChannel(const Channel: Byte; const Pct: Single): Byte; +var + Temp: Integer; +begin + if Pct < 0 then + Result := BrightColorChannel(Channel, -Pct) + else + begin + Temp := Round(Channel - Pct * MaxBytePercent); + if Temp < Low(Result) then + Result := Low(Result) + else + Result := Temp; + end; +end; + +// Converts values of the XYZ color space using the D65 white point to D50 white point. +// The values were taken from www.srgb.com/hpsrgbprof/sld005.htm + +procedure CIED65ToCIED50(var X, Y, Z: Extended); +var + Xn, Yn, Zn: Extended; +begin + Xn := 1.0479 * X + 0.0299 * Y - 0.0502 * Z; + Yn := 0.0296 * X + 0.9904 * Y - 0.0171 * Z; + Zn := -0.0092 * X + 0.0151 * Y + 0.7519 * Z; + X := Xn; + Y := Yn; + Z := Zn; +end; + +// converts each color component from a 16bits per sample to 8 bit used in Windows DIBs +// Count is the number of entries in Source and Target + +procedure Gray16(const Source, Target: Pointer; Count: Cardinal); +var + SourceRun: PWord; + TargetRun: PByte; +begin + SourceRun := Source; + TargetRun := Target; + while Count > 0 do + begin + TargetRun^ := SourceRun^ shr 8; + Inc(SourceRun); + Inc(TargetRun); + Dec(Count); + end; +end; + +type + PCMYK = ^TCMYK; + TCMYK = packed record + C: Byte; + M: Byte; + Y: Byte; + K: Byte; + end; + + PCMYK16 = ^TCMYK16; + TCMYK16 = packed record + C: Word; + M: Word; + Y: Word; + K: Word; + end; + +// converts a stream of Count CMYK values to BGR +// BitsPerSample : 8 or 16 +// CMYK is C,M,Y,K 4 byte record or 4 word record +// Target is always 3 byte record B, R, G + +procedure CMYKToBGR(const Source, Target: Pointer; const BitsPerSample: Byte; Count: Cardinal); overload; +var + R, G, B, K: Integer; + I: Integer; + SourcePtr: PCMYK; + SourcePtr16: PCMYK16; + TargetPtr: PByte; +begin + case BitsPerSample of + 8: + begin + SourcePtr := Source; + TargetPtr := Target; + Count := Count div 4; + for I := 0 to Count - 1 do + begin + K := SourcePtr.K; + R := 255 - (SourcePtr.C - MulDiv(SourcePtr.C, K, 255) + K); + G := 255 - (SourcePtr.M - MulDiv(SourcePtr.M, K, 255) + K); + B := 255 - (SourcePtr.Y - MulDiv(SourcePtr.Y, K, 255) + K); + TargetPtr^ := JclLogic.Max(0, JclLogic.Min(255, Byte(B))); + Inc(TargetPtr); + TargetPtr^ := JclLogic.Max(0, JclLogic.Min(255, Byte(G))); + Inc(TargetPtr); + TargetPtr^ := JclLogic.Max(0, JclLogic.Min(255, Byte(R))); + Inc(TargetPtr); + Inc(SourcePtr); + end; + end; + 16: + begin + SourcePtr16 := Source; + TargetPtr := Target; + Count := Count div 4; + for I := 0 to Count - 1 do + begin + K := SourcePtr16.K; + R := 255 - (SourcePtr16.C - MulDiv(SourcePtr16.C, K, 65535) + K) shr 8; + G := 255 - (SourcePtr16.M - MulDiv(SourcePtr16.M, K, 65535) + K) shr 8; + B := 255 - (SourcePtr16.Y - MulDiv(SourcePtr16.Y, K, 65535) + K) shr 8; + TargetPtr^ := JclLogic.Max(0, JclLogic.Min(255, Byte(B))); + Inc(TargetPtr); + TargetPtr^ := JclLogic.Max(0, JclLogic.Min(255, Byte(G))); + Inc(TargetPtr); + TargetPtr^ := JclLogic.Max(0, JclLogic.Min(255, Byte(R))); + Inc(TargetPtr); + Inc(SourcePtr16); + end; + end; + else + raise EColorConversionError.CreateResFmt(@RsBitsPerSampleNotSupported, [BitsPerSample]); + end; +end; + +// converts a stream of Count CMYK values to BGR + +procedure CMYKToBGR(const C, M, Y, K, Target: Pointer; const BitsPerSample: Byte; Count: Cardinal); overload; +var + R, G, B: Integer; + C8, M8, Y8, K8: PByte; + C16, M16, Y16, K16: PWord; + I: Integer; + TargetPtr: PByte; +begin + case BitsPerSample of + 8: + begin + C8 := C; + M8 := M; + Y8 := Y; + K8 := K; + TargetPtr := Target; + Count := Count div 4; + for I := 0 to Count - 1 do + begin + R := 255 - (C8^ - MulDiv(C8^, K8^, 255) + K8^); + G := 255 - (M8^ - MulDiv(M8^, K8^, 255) + K8^); + B := 255 - (Y8^ - MulDiv(Y8^, K8^, 255) + K8^); + TargetPtr^ := JclLogic.Max(0, JclLogic.Min(255, Byte(B))); + Inc(TargetPtr); + TargetPtr^ := JclLogic.Max(0, JclLogic.Min(255, Byte(G))); + Inc(TargetPtr); + TargetPtr^ := JclLogic.Max(0, JclLogic.Min(255, Byte(R))); + Inc(TargetPtr); + Inc(C8); + Inc(M8); + Inc(Y8); + Inc(K8); + end; + end; + 16: + begin + C16 := C; + M16 := M; + Y16 := Y; + K16 := K; + TargetPtr := Target; + Count := Count div 4; + for I := 0 to Count - 1 do + begin + R := 255 - (C16^ - MulDiv(C16^, K16^, 65535) + K16^) shr 8; + G := 255 - (M16^ - MulDiv(M16^, K16^, 65535) + K16^) shr 8; + B := 255 - (Y16^ - MulDiv(Y16^, K16^, 65535) + K16^) shr 8; + TargetPtr^ := JclLogic.Max(0, JclLogic.Min(255, Byte(B))); + Inc(TargetPtr); + TargetPtr^ := JclLogic.Max(0, JclLogic.Min(255, Byte(G))); + Inc(TargetPtr); + TargetPtr^ := JclLogic.Max(0, JclLogic.Min(255, Byte(R))); + Inc(TargetPtr); + Inc(C16); + Inc(M16); + Inc(Y16); + Inc(K16); + end; + end; + else + raise EColorConversionError.CreateResFmt(@RsBitsPerSampleNotSupported, [BitsPerSample]); + end; +end; + +// conversion of the CIE L*a*b color space to RGB using a two way approach assuming a D65 white point, +// first a conversion to CIE XYZ is performed and then from there to RGB + +procedure CIELABToBGR(const Source, Target: Pointer; const Count: Cardinal); overload; +var + FinalR, + FinalG, + FinalB: Integer; + L, a, b, + X, Y, Z, // color values in float format + T, YYn3: Double; // intermediate results + SourcePtr, + TargetPtr: PByte; + PixelCount: Cardinal; +begin + SourcePtr := Source; + TargetPtr := Target; + PixelCount := Count div 3; + + while PixelCount > 0 do + begin + // L should be in the range of 0..100 but at least Photoshop stores the luminance + // in the range of 0..255 + L := SourcePtr^ / 2.55; + Inc(SourcePtr); + a := Shortint(SourcePtr^); + Inc(SourcePtr); + b := Shortint(SourcePtr^); + Inc(SourcePtr); + + // CIE L*a*b can be calculated from CIE XYZ by: + // L = 116 * ((Y / Yn)^1/3) - 16 if (Y / Yn) > 0.008856 + // L = 903.3 * Y / Yn if (Y / Yn) <= 0.008856 + // a = 500 * (f(X / Xn) - f(Y / Yn)) + // b = 200 * (f(Y / Yn) - f(Z / Zn)) + // where f(t) = t^(1/3) with (Y / Yn) > 0.008856 + // f(t) = 7.787 * t + 16 / 116 with (Y / Yn) <= 0.008856 + // + // by reordering the above equations we can calculate CIE L*a*b -> XYZ as follows: + // L is in the range 0..100 and a as well as b in -127..127 + YYn3 := (L + 16) / 116; // this corresponds to (Y/Yn)^1/3 + if L < 7.9996 then + begin + Y := L / 903.3; + X := a / 3893.5 + Y; + Z := Y - b / 1557.4; + end + else + begin + T := YYn3 + a / 500; + X := T * T * T; + Y := YYn3 * YYn3 * YYn3; + T := YYn3 - b / 200; + Z := T * T * T; + end; + + // once we have CIE XYZ it is easy (yet quite expensive) to calculate RGB values from this + FinalR := Round(255.0 * ( 2.998 * X - 1.458 * Y - 0.541 * Z)); + FinalG := Round(255.0 * (-0.952 * X + 1.893 * Y + 0.059 * Z)); + FinalB := Round(255.0 * ( 0.099 * X - 0.198 * Y + 1.099 * Z)); + + TargetPtr^ := JclLogic.Max(0, JclLogic.Min(255, Byte(FinalB))); + Inc(TargetPtr); + TargetPtr^ := JclLogic.Max(0, JclLogic.Min(255, Byte(FinalG))); + Inc(TargetPtr); + TargetPtr^ := JclLogic.Max(0, JclLogic.Min(255, Byte(FinalR))); + Inc(TargetPtr); + + Dec(PixelCount); + end; +end; + +// conversion of the CIE L*a*b color space to RGB using a two way approach assuming a D65 white point, +// first a conversion to CIE XYZ is performed and then from there to RGB +// The BitsPerSample are not used so why leave it here. + +procedure CIELABToBGR(LSource, aSource, bSource: PByte; const Target: Pointer; const Count: Cardinal); overload; +var + FinalR, + FinalG, + FinalB: Integer; + L, a, b, + X, Y, Z, // color values in float format + T, YYn3: Double; // intermediate results + TargetPtr: PByte; + PixelCount: Cardinal; +begin + TargetPtr := Target; + PixelCount := Count div 3; + + while PixelCount > 0 do + begin + // L should be in the range of 0..100 but at least Photoshop stores the luminance + // in the range of 0..256 + L := LSource^ / 2.55; + Inc(LSource); + a := Shortint(aSource^); + Inc(aSource); + b := Shortint(bSource^); + Inc(bSource); + + // CIE L*a*b can be calculated from CIE XYZ by: + // L = 116 * ((Y / Yn)^1/3) - 16 if (Y / Yn) > 0.008856 + // L = 903.3 * Y / Yn if (Y / Yn) <= 0.008856 + // a = 500 * (f(X / Xn) - f(Y / Yn)) + // b = 200 * (f(Y / Yn) - f(Z / Zn)) + // where f(t) = t^(1/3) with (Y / Yn) > 0.008856 + // f(t) = 7.787 * t + 16 / 116 with (Y / Yn) <= 0.008856 + // + // by reordering the above equations we can calculate CIE L*a*b -> XYZ as follows: + // L is in the range 0..100 and a as well as b in -127..127 + YYn3 := (L + 16) / 116; // this corresponds to (Y/Yn)^1/3 + if L < 7.9996 then + begin + Y := L / 903.3; + X := a / 3893.5 + Y; + Z := Y - b / 1557.4; + end + else + begin + T := YYn3 + a / 500; + X := T * T * T; + Y := YYn3 * YYn3 * YYn3; + T := YYn3 - b / 200; + Z := T * T * T; + end; + + // once we have CIE XYZ it is easy (yet quite expensive) to calculate RGB values from this + FinalR := Round(255.0 * ( 2.998 * X - 1.458 * Y - 0.541 * Z)); + FinalG := Round(255.0 * (-0.952 * X + 1.893 * Y + 0.059 * Z)); + FinalB := Round(255.0 * ( 0.099 * X - 0.198 * Y + 1.099 * Z)); + + TargetPtr^ := JclLogic.Max(0, JclLogic.Min(255, Byte(FinalB))); + Inc(TargetPtr); + TargetPtr^ := JclLogic.Max(0, JclLogic.Min(255, Byte(FinalG))); + Inc(TargetPtr); + TargetPtr^ := JclLogic.Max(0, JclLogic.Min(255, Byte(FinalR))); + Inc(TargetPtr); + + Dec(PixelCount); + end; +end; + +// reorders a stream of "Count" RGB values to BGR, additionally an eventual sample size adjustment is done + +procedure RGBToBGR(const Source, Target: Pointer; const BitsPerSample: Byte; Count: Cardinal); overload; +var + SourceRun16: PRGBWord; + SourceRun8: PRGB; + TargetRun: PBGR; +begin + Count := Count div 3; + // usually only 8 bit samples are used but Photoshop allows for 16 bit samples + case BitsPerSample of + 8: + begin + SourceRun8 := Source; + TargetRun := Target; + while Count > 0 do + begin + TargetRun.R := SourceRun8.R; + TargetRun.G := SourceRun8.G; + TargetRun.B := SourceRun8.B; + Inc(SourceRun8); + Inc(TargetRun); + Dec(Count); + end; + end; + 16: + begin + SourceRun16 := Source; + TargetRun := Target; + while Count > 0 do + begin + TargetRun.R := SourceRun16.R shr 8; + TargetRun.G := SourceRun16.G shr 8; + TargetRun.B := SourceRun16.B shr 8; + Inc(SourceRun16); + Inc(TargetRun); + Dec(Count); + end; + end; + else + raise EColorConversionError.CreateResFmt(@RsBitsPerSampleNotSupported, [BitsPerSample]); + end; +end; + +// reorders a stream of "Count" RGB values to BGR, additionally an eventual sample size adjustment is done + +procedure RGBToBGR(const R, G, B, Target: Pointer; const BitsPerSample: Byte; Count: Cardinal); overload; +var + R8, G8, B8: PByte; + R16, G16, B16: PWord; + TargetRun: PByte; +begin + Count := Count div 3; + // usually only 8 bits samples are used but Photoshop allows 16 bits samples too + case BitsPerSample of + 8: + begin + R8 := R; + G8 := G; + B8 := B; + TargetRun := Target; + while Count > 0 do + begin + TargetRun^ := B8^; + Inc(B8); + Inc(TargetRun); + TargetRun^ := G8^; + Inc(G8); + Inc(TargetRun); + TargetRun^ := R8^; + Inc(R8); + Inc(TargetRun); + Dec(Count); + end; + end; + 16: + begin + R16 := R; + G16 := G; + B16 := B; + TargetRun := Target; + while Count > 0 do + begin + TargetRun^ := B16^ shr 8; + Inc(B16); + Inc(TargetRun); + TargetRun^ := G16^ shr 8; + Inc(G16); + Inc(TargetRun); + TargetRun^ := R16^ shr 8; + Inc(R16); + Inc(TargetRun); + Dec(Count); + end; + end; + else + raise EColorConversionError.CreateResFmt(@RsBitsPerSampleNotSupported, [BitsPerSample]); + end; +end; + +// reorders a stream of "Count" RGBA values to BGRA, additionally an eventual sample +// size adjustment is done + +procedure RGBAToBGRA(const Source, Target: Pointer; const BitsPerSample: Byte; Count: Cardinal); +var + SourceRun16: PRGBAWord; + SourceRun8: PRGBA; + TargetRun: PBGRA; +begin + Count := Count div 4; + // usually only 8 bit samples are used but Photoshop allows for 16 bit samples + case BitsPerSample of + 8: + begin + SourceRun8 := Source; + TargetRun := Target; + while Count > 0 do + begin + TargetRun.R := SourceRun8.R; + TargetRun.G := SourceRun8.G; + TargetRun.B := SourceRun8.B; + TargetRun.A := SourceRun8.A; + Inc(SourceRun8); + Inc(TargetRun); + Dec(Count); + end; + end; + 16: + begin + SourceRun16 := Source; + TargetRun := Target; + while Count > 0 do + begin + TargetRun.R := SourceRun16.B shr 8; + TargetRun.G := SourceRun16.G shr 8; + TargetRun.B := SourceRun16.R shr 8; + TargetRun.A := SourceRun16.A shr 8; + Inc(SourceRun16); + Inc(TargetRun); + Dec(Count); + end; + end; + else + raise EColorConversionError.CreateResFmt(@RsBitsPerSampleNotSupported, [BitsPerSample]); + end; +end; + +procedure WinColorToOpenGLColor(const Color: TColor; out Red, Green, Blue: Float); +var + Temp: TColorRec; +begin + Temp.Value := ColorToRGB(Color); + Red := (Temp.R / High(Temp.R)); + Green := (Temp.G / High(Temp.G)); + Blue := (Temp.B / High(Temp.B)); +end; + +function OpenGLColorToWinColor(const Red, Green, Blue: Float): TColor; +var + Temp: TColorRec; +begin + Temp.R := Round(Red * High(Temp.R)); + Temp.G := Round(Green * High(Temp.G)); + Temp.B := Round(Blue * High(Temp.B)); + Temp.Flag := 0; + Result := Temp.Value; +end; + +function Color32(WinColor: TColor): TColor32; overload; +begin + WinColor := ColorToRGB(WinColor); + Result := ColorSwap(WinColor); +end; + +function Color32(const R, G, B: Byte; const A: Byte): TColor32; overload; +begin + Result := A shl 24 + R shl 16 + G shl 8 + B; +end; + +function Color32(const Index: Byte; const Palette: TPalette32): TColor32; overload; +begin + Result := Palette[Index]; +end; + +function Gray32(const Intensity: Byte; const Alpha: Byte): TColor32; +begin + Result := TColor32(Alpha) shl 24 + TColor32(Intensity) shl 16 + + TColor32(Intensity) shl 8 + TColor32(Intensity); +end; + +function WinColor(const Color32: TColor32): TColor; +begin + // the alpha channel byte is set to zero + Result := (Color32 and _R shr 16) or (Color32 and _G) or + (Color32 and _B shl 16); +end; + +function RedComponent(const Color32: TColor32): Integer; +begin + Result := Color32 and _R shr 16; +end; + +function GreenComponent(const Color32: TColor32): Integer; +begin + Result := Color32 and _G shr 8; +end; + +function BlueComponent(const Color32: TColor32): Integer; +begin + Result := Color32 and _B; +end; + +function AlphaComponent(const Color32: TColor32): Integer; +begin + Result := Color32 shr 24; +end; + +function Intensity(const R, G, B: Single): Single; +const + RFactor = 61 / 256; + GFactor = 174 / 256; + BFactor = 21 / 256; +begin + Result := RFactor * R + GFactor * G + BFactor * B; +end; + +// input: RGB components +// output: (R * 61 + G * 174 + B * 21) div 256 + +function Intensity(const Color32: TColor32): Integer; +begin + Result := (Color32 and _B) * 21 // Blue + + ((Color32 and _G) shr 8) * 174 // Green + + ((Color32 and _R) shr 16) * 61; // Red + Result := Result shr 8; +end; + +function SetAlpha(const Color32: TColor32; NewAlpha: Integer): TColor32; +begin + Result := (Color32 and _RGB) or (TColor32(NewAlpha) shl 24); +end; + +procedure HLSToRGB(const H, L, S: Single; out R, G, B: Single); +var + M1, M2: Single; + + function HueToColorValue(Hue: Single): Single; + begin + Hue := Hue - Floor(Hue); + + if 6 * Hue < 1 then + Result := M1 + (M2 - M1) * Hue * 6 + else + if 2 * Hue < 1 then + Result := M2 + else + if 3 * Hue < 2 then + Result := M1 + (M2 - M1) * (2 / 3 - Hue) * 6 + else + Result := M1; + end; + +begin + if S = 0 then + begin + R := L; + G := R; + B := R; + end + else + begin + if L <= 0.5 then + M2 := L * (1 + S) + else + M2 := L + S - L * S; + M1 := 2 * L - M2; + R := HueToColorValue(H + 1 / 3); + G := HueToColorValue(H); + B := HueToColorValue(H - 1 / 3) + end; +end; + +function HSLToRGB(const H, S, L: Single): TColor32; +var + R, G, B: Single; +begin + HLSToRGB(H, L, S, R, G, B); + Result := Color32(Round(R * 255), Round(G * 255), Round(B * 255), 255); +end; + +function HLSToRGB(const HLS: TColorVector): TColorVector; +begin + HLSToRGB(HLS.H, HLS.L, HLS.S, Result.R, Result.G, Result.B); +end; + +procedure RGBToHLS(const R, G, B: Single; out H, L, S: Single); +var + D, Cmax, Cmin: Single; +begin + Cmax := Max(R, Max(G, B)); + Cmin := Min(R, Min(G, B)); + L := (Cmax + Cmin) / 2; + + if Cmax = Cmin then + begin + H := 0; + S := 0 + end + else + begin + D := Cmax - Cmin; + if L < 0.5 then + S := D / (Cmax + Cmin) + else + S := D / (2 - Cmax - Cmin); + if R = Cmax then + H := (G - B) / D + else + if G = Cmax then + H := 2 + (B - R) / D + else + H := 4 + (R - G) / D; + H := H / 6; + if H < 0 then + H := H + 1; + end; +end; + +procedure RGBToHSL(const RGB: TColor32; out H, S, L: Single); +begin + RGBToHLS(RedComponent(RGB) / 255, GreenComponent(RGB) / 255, BlueComponent(RGB) / 255, H, L, S); +end; + +function RGBToHLS(const RGB: TColorVector): TColorVector; +begin + RGBToHLS(RGB.R, RGB.G, RGB.B, Result.H, Result.L, Result.S); +end; + +{ Translated C-code from Microsoft Knowledge Base +------------------------------------------- +Converting Colors Between RGB and HLS (HBS) +Article ID: Q29240 +Creation Date: 26-APR-1988 +Revision Date: 02-NOV-1995 +The information in this article applies to: + +Microsoft Windows Software Development Kit (SDK) for Windows versions 3.1 and 3.0 +Microsoft Win32 Application Programming Interface (API) included with: + + - Microsoft Windows NT versions 3.5 and 3.51 + - Microsoft Windows 95 version 4.0 +SUMMARY + + +The code fragment below converts colors between RGB (Red, Green, Blue) and HLS/HBS (Hue, Lightness, Saturation/Hue, Brightness, Saturation). + + +MORE INFORMATION + + +/* Color Conversion Routines -- + +RGBToHLS() takes a DWORD RGB value, translates it to HLS, and stores the results in the global vars H, L, and S. HLSToRGB takes the current values of H, L, and S and returns the equivalent value in an RGB DWORD. + +A point of reference for the algorithms is Foley and Van Dam, "Fundamentals of Interactive Computer Graphics," Pages 618-19. Their algorithm is in floating point. CHART implements a less general (hardwired ranges) integral algorithm. +There are potential round-off errors throughout this sample. ((0.5 + x)/y) without floating point is phrased ((x + (y/2))/y), yielding a very small round-off error. This makes many of the following divisions look strange. */ } + +const + HLSMAX = High(THLSValue); // H,L, and S vary over 0-HLSMAX + RGBMAX = 255; // R,G, and B vary over 0-RGBMAX + // HLSMAX BEST IF DIVISIBLE BY 6 + // RGBMAX, HLSMAX must each fit in a byte. + +// Hue is undefined if Saturation is 0 (grey-scale). +// This value determines where the Hue value is initially set for achromatic colors. + UNDEFINED = HLSMAX * 2 div 3; + +type + TInternalRGB = packed record + R: Byte; + G: Byte; + B: Byte; + I: Byte; + end; + +function RGB(R, G, B: Byte): TColor; +begin + TInternalRGB(Result).R := R; + TInternalRGB(Result).G := G; + TInternalRGB(Result).B := B; + TInternalRGB(Result).I := 0; +end; + +function RGBToHLS(const RGBColor: TColorRef): THLSVector; +var + R, G, B: Integer; // input RGB values + H, L, S: Integer; + Cmax, Cmin: Byte; // max and min RGB values + Rdelta,Gdelta,Bdelta: Integer; // intermediate value: % of spread from max +begin + // get R, G, and B out of DWORD + R := TInternalRGB(RGBColor).R; + G := TInternalRGB(RGBColor).G; + B := TInternalRGB(RGBColor).B; + + // calculate lightness + Cmax := R; + if G > Cmax then + Cmax := G; + if B > Cmax then + Cmax := B; + + Cmin := R; + if G < Cmin then + Cmin := G; + if B < Cmin then + Cmin := B; + + L := (((Cmax + Cmin) * HLSMAX) + RGBMAX) div (2 * RGBMAX); + + if (Cmax = Cmin) then // r=g=b --> achromatic case + begin + S := 0; // saturation + H := UNDEFINED; // hue + end + else + begin // chromatic case + // saturation + if L <= (HLSMAX div 2) then + S := (((Cmax - Cmin) * HLSMAX) + ((Cmax + Cmin) div 2)) div (Cmax + Cmin) + else + S := (((Cmax - Cmin) * HLSMAX) + ((2 * RGBMAX - Cmax - Cmin) div 2)) div (2 * RGBMAX - Cmax - Cmin); + + // hue + Rdelta := (((Cmax - R) * (HLSMAX div 6)) + ((Cmax - Cmin) div 2)) div (Cmax - Cmin); + Gdelta := (((Cmax - G) * (HLSMAX div 6)) + ((Cmax - Cmin) div 2)) div (Cmax - Cmin); + Bdelta := (((Cmax - B) * (HLSMAX div 6)) + ((Cmax - Cmin) div 2)) div (Cmax - Cmin); + + if R = Cmax then + H := Bdelta - Gdelta + else + if G = Cmax then + H := (HLSMAX div 3) + Rdelta - Bdelta + else // B = Cmax + H := ((2 * HLSMAX) div 3) + Gdelta - Rdelta; + + H := H mod HLSMAX; + if H < 0 then + Inc(H, HLSMAX); + end; + Result.Hue := H; + Result.Luminance := L; + Result.Saturation := S; +end; + +function HueToRGB(M1, M2, Hue: Integer): Integer; +// utility routine for HLSToRGB +begin + Hue := Hue mod HLSMAX; + // range check: note values passed add div subtract thirds of range + if Hue < 0 then + Inc(Hue, HLSMAX); + + // return r,g, or b value from this tridrant + if Hue < (HLSMAX div 6) then + Result := (M1 + (((M2 - M1) * Hue + (HLSMAX div 12)) div (HLSMAX div 6))) + else + if Hue < (HLSMAX div 2) then + Result := M2 + else + if Hue < ((HLSMAX * 2) div 3) then + Result := (M1 + (((M2 - M1) * (((HLSMAX * 2) div 3) - Hue) + (HLSMAX div 12)) div (HLSMAX div 6))) + else + Result := M1; +end; + +function HLSToRGB(const Hue, Luminance, Saturation: THLSValue): TColorRef; +var + R, G, B: Integer; // RGB component values + Magic1, Magic2: Integer; // calculated magic numbers (really!) +begin + if Saturation = 0 then // achromatic case + begin + R :=(Luminance * RGBMAX) div HLSMAX; + G := R; + B := R; + if Hue <> UNDEFINED then + begin + // ERROR + end + end else + begin // chromatic case + // set up magic numbers + if (Luminance <= (HLSMAX div 2)) then + Magic2 := (Luminance * (HLSMAX + Saturation) + (HLSMAX div 2)) div HLSMAX + else + Magic2 := Luminance + Saturation - ((Luminance * Saturation) + (HLSMAX div 2)) div HLSMAX; + Magic1 := 2 * Luminance - Magic2; + // get RGB, change units from HLSMAX to RGBMAX + R := (HueToRGB(Magic1, Magic2, Hue + (HLSMAX div 3)) * RGBMAX + (HLSMAX div 2)) div HLSMAX; + G := (HueToRGB(Magic1, Magic2, Hue) * RGBMAX + (HLSMAX div 2)) div HLSMAX; + B := (HueToRGB(Magic1, Magic2, Hue - (HLSMAX div 3)) * RGBMAX + (HLSMAX div 2)) div HLSMAX; + end; + Result := RGB(R, G, B); +end; + +function SetBitmapColors(Bmp: TBitmap; const Colors: array of TColor; StartIndex: Integer): Integer; +type + TRGBQuadArray = array [Byte] of TRGBQuad; + PRGBQuadArray = ^TRGBQuadArray; +var + I, RGB: Integer; + ColorTable: PRGBQuadArray; + Count: Integer; +begin + Count := High(Colors)-Low(Colors)+1; + GetMem(ColorTable, Count * SizeOf(TRGBQuad)); + try + for I := 0 to Count-1 do + with ColorTable^[I] do + begin + RGB := ColorToRGB(Colors[I]); + rgbBlue := GetBValue(RGB); + rgbGreen := GetGValue(RGB); + rgbRed := GetRValue(RGB); + rgbReserved := 0; + end; + Bmp.HandleType := bmDIB; + Result := GDICheck(SetDIBColorTable(Bmp.Canvas.Handle, StartIndex, Count, ColorTable^)); + finally + FreeMem(ColorTable); + end; +end; + +//=== Misc =================================================================== + +function ColorToHTML(const Color: TColor): string; +var + Temp: TColorRec; +begin + Temp.Value := ColorToRGB(Color); + Result := Format('#%.2x%.2x%.2x', [Temp.R, Temp.G, Temp.B]); +end; + +function DottedLineTo(const Canvas: TCanvas; const X, Y: Integer): Boolean; +const + DotBits: array [0..7] of Word = ($AA, $55, $AA, $55, $AA, $55, $AA, $55); +var + Bitmap: HBitmap; + Brush: HBrush; + SaveTextColor, SaveBkColor: TColorRef; + LastPos: TPoint; + R: TRect; + DC: HDC; +begin + DC := Canvas.Handle; + GetCurrentPositionEx(DC, @LastPos); + Result := False; + if LastPos.X = X then + R := RectAssign(LastPos.X, LastPos.Y, LastPos.X + 1, Y) + else + if LastPos.Y = Y then + R := RectAssign(LastPos.X, LastPos.Y, X, LastPos.Y + 1) + else + Exit; + Bitmap := CreateBitmap(8, 8, 1, 1, @DotBits); + Brush := CreatePatternBrush(Bitmap); + SaveTextColor := SetTextColor(DC, ColorToRGB(Canvas.Pen.Color)); + SaveBkColor := SetBkColor(DC, ColorToRGB(Canvas.Brush.Color)); + FillRect(DC, R, Brush); + MoveToEx(DC, X, Y, nil); + SetBkColor(DC, SaveBkColor); + SetTextColor(DC, SaveTextColor); + DeleteObject(Brush); + DeleteObject(Bitmap); + Result := True; +end; + +// Adjusts the given string S so that it fits into the given width. EllipsisWidth gives the width of +// the three points to be added to the shorted string. If this value is 0 then it will be determined implicitely. +// For higher speed (and multiple entries to be shorted) specify this value explicitely. +// RTL determines if right-to-left reading is active, which is needed to put the ellipsisis on the correct side. +// Note: It is assumed that the string really needs shortage. Check this in advance. + +function ShortenString(const DC: HDC; const S: WideString; const Width: Integer; const RTL: Boolean; + EllipsisWidth: Integer): WideString; +var + Size: TSize; + Len: Integer; + L, H, N, W: Integer; +begin + Len := Length(S); + if (Len = 0) or (Width <= 0) then + Result := '' + else + begin + // Determine width of triple point using the current DC settings (if not already done). + if EllipsisWidth = 0 then + begin + GetTextExtentPoint32W(DC, '...', 3, Size); + EllipsisWidth := Size.cx; + end; + + if Width <= EllipsisWidth then + Result := '' + else + begin + // Do a binary search for the optimal string length which fits into the given width. + L := 0; + H := Len; + N := 0; + while L <= H do + begin + N := (L + H) shr 1; + GetTextExtentPoint32W(DC, PWideChar(S), N, Size); + W := Size.cx + EllipsisWidth; + if W < Width then + L := N + 1 + else + begin + H := N - 1; + if W = Width then + L := N; + end; + end; + + // Windows 2000+ automatically switches the order in the string. For every other system we have to take care. + if IsWin2K or not RTL then + Result := Copy(S, 1, N - 1) + '...' + else + Result := '...' + Copy(S, 1, N - 1); + end; + end; +end; + +//=== Clipping =============================================================== + +function ClipCodes(const X, Y, MinX, MinY, MaxX, MaxY: Float): TClipCodes; +begin + Result := []; + if X > MaxX then + Include(Result, ccRight) + else + if X < MinX then + Include(Result, ccLeft); + if Y < MinY then + Include(Result, ccAbove) + else + if Y > MaxY then + Include(Result, ccBelow); +end; + +function ClipCodes(const X, Y: Float; const ClipRect: TRect): TClipCodes; +begin + Result := ClipCodes(X, Y, ClipRect.Left, ClipRect.Top, ClipRect.Right, ClipRect.Bottom); +end; + +function ClipLine(var X1, Y1, X2, Y2: Integer; const ClipRect: TRect): Boolean; +var + FX1, FY1, FX2, FY2: Float; +begin + FX1 := X1; + FY1 := Y1; + FX2 := X2; + FY2 := Y2; + Result := ClipLine(FX1, FY1, FX2, FY2, + ClipRect.Left, ClipRect.Top, ClipRect.Right, ClipRect.Bottom, nil); + if Result then + begin + X1 := Round(FX1); + Y1 := Round(FY1); + X2 := Round(FX2); + Y2 := Round(FY2); + end; +end; + +function ClipLine(var X1, Y1, X2, Y2: Float; const MinX, MinY, MaxX, MaxY: Float; + Codes: PClipCodes): Boolean; +var + Done: Boolean; + Codes_, Codes1, Codes2: TClipCodes; + X, Y: Float; + + function ClipCodes(X, Y: Float): TClipCodes; + begin + Result := []; + if X > MaxX then + Include(Result, ccRight) + else + if X < MinX then + Include(Result, ccLeft); + if Y < MinY then + Include(Result, ccAbove) + else + if Y > MaxY then + Include(Result, ccBelow); + end; + +begin + Result := False; + Done := False; + Codes2 := ClipCodes(X2, Y2); + if Codes <> nil then + begin + Codes1 := Codes^; + Codes^ := Codes2; + end + else + Codes1 := ClipCodes(X1, Y1); + repeat + if (Codes1 = []) and (Codes2 = []) then + begin + Result := True; + Done := True; + end + else + if (Codes1 * Codes2) <> [] then + Done := True + else + begin + if Codes1 <> [] then + Codes_ := Codes1 + else + Codes_ := Codes2; + X := 0; + Y := 0; + if ccLeft in Codes_ then + begin + Y := Y1 + (Y2 - Y1) * (MinX - X1) / (X2 - X1); + X := MinX; + end + else + if ccRight in Codes_ then + begin + Y := Y1 + (Y2 - Y1) * (MaxX - X1) / (X2 - X1); + X := MaxX; + end + else + if ccAbove in Codes_ then + begin + X := X1 + (X2 - X1) * (MinY - Y1) / (Y2 - Y1); + Y := MinY; + end + else + if ccBelow in Codes_ then + begin + X := X1 + (X2 - X1) * (MaxY - Y1) / (Y2 - Y1); + Y := MaxY; + end; + if Codes_ = Codes1 then + begin + X1 := X; + Y1 := Y; + Codes1 := ClipCodes(X1, Y1); + end + else + begin + X2 := X; + Y2 := Y; + Codes2 := ClipCodes(X2, Y2); + end; + end; + until Done; +end; + +procedure DrawPolyLine(const Canvas: TCanvas; var Points: TPointArray; const ClipRect: TRect); +var + I: Integer; + X, Y: Integer; + X1, Y1, X2, Y2: Float; + ClipX1, ClipY1, ClipX2, ClipY2: Float; + Codes1, Codes2: TClipCodes; +begin + if not RectIsValid(ClipRect) then + Exit; + + with Points[0] do + begin + X1 := X; + Y1 := Y; + Canvas.MoveTo(X, Y); + end; + + ClipX1 := ClipRect.Left; + ClipY1 := ClipRect.Top; + ClipX2 := ClipRect.Right; + ClipY2 := ClipRect.Bottom; + + Codes2 := ClipCodes(X1, Y1, ClipX1, ClipY1, ClipX2, ClipY2); + for I := 1 to High(Points) do + begin + with Points[I] do + begin + X2 := X; + Y2 := Y; + end; + Codes1 := Codes2; + if ClipLine(X1, Y1, X2, Y2, ClipX1, ClipY1, ClipX2, ClipY2, @Codes2) then + begin + if Codes1 <> [] then + Canvas.MoveTo(Round(X1), Round(Y1)); + X := Round(X2); + Y := Round(Y2); + Canvas.LineTo(X, Y); + if Codes2 <> [] then + // Draw end point if necessary + Canvas.LineTo(X + 1, Y); + end; + with Points[I] do + begin + X1 := X; + Y1 := Y; + end; + end; +end; + +initialization + SetupFunctions; + if SSE2_ACTIVE then + GenAlphaTable; + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + if SSE2_ACTIVE then + FreeAlphaTable; + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/vcl/JclGraphics.pas b/3rdParty/JCL/source/vcl/JclGraphics.pas new file mode 100644 index 00000000..ade74a83 --- /dev/null +++ b/3rdParty/JCL/source/vcl/JclGraphics.pas @@ -0,0 +1,5713 @@ +{**************************************************************************************************} +{ WARNING: JEDI preprocessor generated unit. Do not edit. } +{**************************************************************************************************} + +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclGraphics.pas. } +{ } +{ The resampling algorithms and methods used in this library were adapted by Anders Melander from } +{ the article "General Filtered Image Rescaling" by Dale Schumacher which appeared in the book } +{ Graphics Gems III, published by Academic Press, Inc. Additional improvements were done by David } +{ Ullrich and Josha Beukema. } +{ } +{ (C)opyright 1997-1999 Anders Melander } +{ } +{ The Initial Developers of the Original Code are Alex Denissov, Wim De Cleen, Anders Melander } +{ and Mike Lischke. Portions created by these individuals are Copyright (C) of these individuals. } +{ All Rights Reserved. } +{ } +{ Contributors: } +{ Alexander Radchenko } +{ Charlie Calvert } +{ Marcel van Brakel } +{ Marcin Wieczorek } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Dejoy Den (dejoy) } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclGraphics; + +{$I jcl.inc} + +interface + +uses + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, System.Classes, System.SysUtils, Vcl.Graphics, Vcl.Controls, Vcl.Forms, + {$ELSE ~HAS_UNITSCOPE} + Windows, Classes, SysUtils, Graphics, Controls, Forms, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclGraphUtils, JclBase; + +type + EJclGraphicsError = class(EJclError); + + TDynDynIntegerArrayArray = array of TDynIntegerArray; + TDynPointArray = array of TPoint; + TDynDynPointArrayArray = array of TDynPointArray; + TPointF = record + X: Single; + Y: Single; + end; + TDynPointArrayF = array of TPointF; + + { TJclBitmap32 draw mode } + TDrawMode = (dmOpaque, dmBlend); + + { stretch filter } + TStretchFilter = (sfNearest, sfLinear, sfSpline); + + TConversionKind = (ckRed, ckGreen, ckBlue, ckAlpha, ckUniformRGB, ckWeightedRGB); + + { resampling support types } + TResamplingFilter = + (rfBox, rfTriangle, rfHermite, rfBell, rfSpline, rfLanczos3, rfMitchell); + + { Matrix declaration for transformation } + // modify Jan 28, 2001 for use under BCB5 + // the compiler show error 245 "language feature ist not available" + // we must take a record and under this we can use the static array + // Note: the sourcecode modify general from M[] to M.A[] !!!!! + // TMatrix3d = array [0..2, 0..2] of Extended; // 3x3 double precision + + TMatrix3d = record + A: array [0..2, 0..2] of Extended; + end; + + TDynDynPointArrayArrayF = array of TDynPointArrayF; + + TScanLine = array of Integer; + TScanLines = array of TScanLine; + + TLUT8 = array [Byte] of Byte; + TGamma = array [Byte] of Byte; + TColorChannel = (ccRed, ccGreen, ccBlue, ccAlpha); + + TGradientDirection = (gdVertical, gdHorizontal); + + TPolyFillMode = (fmAlternate, fmWinding); + TJclRegionCombineOperator = (coAnd, coDiff, coOr, coXor); + TJclRegionBitmapMode = (rmInclude, rmExclude); + TJclRegionKind = (rkNull, rkSimple, rkComplex, rkError); + +// modify Jan 28, 2001 for use under BCB5 +// the compiler show error 245 "language feature ist not available" +// wie must take a record and under this we can use the static array +// Note: for init the array we used initialisation at the end of this unit +// +// const +// IdentityMatrix: TMatrix3d = ( +// (1, 0, 0), +// (0, 1, 0), +// (0, 0, 1)); + +var + IdentityMatrix: TMatrix3d; + +// Classes +type + TJclDesktopCanvas = class(TCanvas) + private + FDesktop: HDC; + public + constructor Create; + destructor Destroy; override; + end; + + TJclRegion = class; + + TJclRegionInfo = class(TObject) + private + FData: Pointer; + FDataSize: Integer; + function GetBox: TRect; + protected + function GetCount: Integer; + function GetRect(index: Integer): TRect; + public + constructor Create(Region: TJclRegion); + destructor Destroy; override; + property Box: TRect read GetBox; + property Rectangles[Index: Integer]: TRect read GetRect; + property Count: Integer read GetCount; + end; + + TJclRegion = class(TObject) + private + FHandle: HRGN; + FBoxRect: TRect; + FRegionType: Integer; + FOwnsHandle: Boolean; + procedure CheckHandle; + protected + function GetHandle: HRGN; + function GetBox: TRect; + function GetRegionType: TJclRegionKind; + public + constructor Create(RegionHandle: HRGN; OwnsHandle: Boolean = True); + constructor CreateElliptic(const ARect: TRect); overload; + constructor CreateElliptic(const Top, Left, Bottom, Right: Integer); overload; + constructor CreatePoly(const Points: TDynPointArray; Count: Integer; FillMode: TPolyFillMode); + constructor CreatePolyPolygon(const Points: TDynPointArray; const Vertex: TDynIntegerArray; + Count: Integer; FillMode: TPolyFillMode); + constructor CreateRect(const ARect: TRect; DummyForBCB: Boolean = False); overload; + constructor CreateRect(const Top, Left, Bottom, Right: Integer; DummyForBCB: Byte = 0); overload; + constructor CreateRoundRect(const ARect: TRect; CornerWidth, CornerHeight: Integer); overload; + constructor CreateRoundRect(const Top, Left, Bottom, Right, CornerWidth, CornerHeight: Integer); overload; + constructor CreateBitmap(Bitmap: TBitmap; RegionColor: TColor; RegionBitmapMode: TJclRegionBitmapMode); + constructor CreatePath(Canvas: TCanvas); + constructor CreateRegionInfo(RegionInfo: TJclRegionInfo); + constructor CreateMapWindow(InitialRegion: TJclRegion; hWndFrom, hWndTo: THandle); overload; + constructor CreateMapWindow(InitialRegion: TJclRegion; ControlFrom, ControlTo: TWinControl); overload; + destructor Destroy; override; + procedure Clip(Canvas: TCanvas); + procedure Combine(DestRegion, SrcRegion: TJclRegion; CombineOp: TJclRegionCombineOperator); overload; + procedure Combine(SrcRegion: TJclRegion; CombineOp: TJclRegionCombineOperator); overload; + function Copy: TJclRegion; + function Equals(CompareRegion: TJclRegion): Boolean; {$IFDEF RTL200_UP} reintroduce; {$ENDIF RTL200_UP} + procedure Fill(Canvas: TCanvas); + procedure FillGradient(Canvas: TCanvas; ColorCount: Integer; StartColor, EndColor: TColor; ADirection: TGradientDirection); + procedure Frame(Canvas: TCanvas; FrameWidth, FrameHeight: Integer); + procedure Invert(Canvas: TCanvas); + procedure Offset(X, Y: Integer); + procedure Paint(Canvas: TCanvas); + function PointIn(X, Y: Integer): Boolean; overload; + function PointIn(const Point: TPoint): Boolean; overload; + function RectIn(const ARect: TRect): Boolean; overload; + function RectIn(Top, Left, Bottom, Right: Integer): Boolean; overload; + procedure SetWindow(Window: THandle; Redraw: Boolean); + function GetRegionInfo: TJclRegionInfo; + property Box: TRect read GetBox; + property Handle: HRGN read GetHandle; + property RegionType: TJclRegionKind read GetRegionType; + end; + + { TJclThreadPersistent } + { TJclThreadPersistent is an ancestor for TJclBitmap32 object. In addition to + TPersistent methods, it provides thread-safe locking and change notification } + TJclThreadPersistent = class(TPersistent) + private + FLock: TRTLCriticalSection; + + FLockCount: Integer; + FUpdateCount: Integer; + FOnChanging: TNotifyEvent; + FOnChange: TNotifyEvent; + protected + property LockCount: Integer read FLockCount; + property UpdateCount: Integer read FUpdateCount; + public + constructor Create; virtual; + destructor Destroy; override; + procedure Changing; virtual; + procedure Changed; virtual; + procedure BeginUpdate; + procedure EndUpdate; + procedure Lock; + procedure Unlock; + property OnChanging: TNotifyEvent read FOnChanging write FOnChanging; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + end; + + { TJclCustomMap } + { An ancestor for bitmaps and similar 2D distributions which have width and + height properties } + TJclCustomMap = class(TJclThreadPersistent) + private + FHeight: Integer; + FWidth: Integer; + procedure SetHeight(NewHeight: Integer); + procedure SetWidth(NewWidth: Integer); + public + procedure Delete; virtual; + function Empty: Boolean; virtual; + procedure SetSize(Source: TPersistent); overload; + procedure SetSize(NewWidth, NewHeight: Integer); overload; virtual; + property Height: Integer read FHeight write SetHeight; + property Width: Integer read FWidth write SetWidth; + end; + + { TJclBitmap32 } + { The TJclBitmap32 class is responsible for storage of a bitmap, as well as for drawing in it } + TJclBitmap32 = class(TJclCustomMap) + private + FBitmapInfo: TBitmapInfo; + FBits: PColor32Array; + FDrawMode: TDrawMode; + FFont: TFont; + FHandle: HBITMAP; + FHDC: HDC; + FMasterAlpha: Byte; + FOuterColor: TColor32; // the value returned when accessing outer areas + FPenColor: TColor32; + FStippleCounter: Single; + FStipplePattern: TArrayOfColor32; + FStippleStep: Single; + FStretchFilter: TStretchFilter; + FResetAlphaOnAssign: Boolean; + function GetPixel(X, Y: Integer): TColor32; + function GetPixelS(X, Y: Integer): TColor32; + function GetPixelPtr(X, Y: Integer): PColor32; + function GetScanLine(Y: Integer): PColor32Array; + procedure SetDrawMode(Value: TDrawMode); + procedure SetFont(Value: TFont); + procedure SetMasterAlpha(Value: Byte); + procedure SetPixel(X, Y: Integer; Value: TColor32); + procedure SetPixelS(X, Y: Integer; Value: TColor32); + procedure SetStippleStep(Value: Single); + procedure SetStretchFilter(Value: TStretchFilter); + protected + FontHandle: HFont; + RasterX: Integer; + RasterY: Integer; + RasterXF: Single; + RasterYF: Single; + procedure AssignTo(Dst: TPersistent); override; + function ClipLine(var X0, Y0, X1, Y1: Integer): Boolean; + class function ClipLineF(var X0, Y0, X1, Y1: Single; MinX, MaxX, MinY, MaxY: Single): Boolean; + procedure FontChanged(Sender: TObject); + procedure SET_T256(X, Y: Integer; C: TColor32); + procedure SET_TS256(X, Y: Integer; C: TColor32); + procedure ReadData(Stream: TStream); virtual; + procedure WriteData(Stream: TStream); virtual; + procedure DefineProperties(Filer: TFiler); override; + property StippleCounter: Single read FStippleCounter; + public + constructor Create; override; + destructor Destroy; override; + + procedure Assign(Source: TPersistent); override; + procedure SetSize(NewWidth, NewHeight: Integer); override; + function Empty: Boolean; override; + procedure Clear; overload; + procedure Clear(FillColor: TColor32); overload; + procedure Delete; override; + + procedure LoadFromStream(Stream: TStream); + procedure SaveToStream(Stream: TStream); + procedure LoadFromFile(const FileName: string); + procedure SaveToFile(const FileName: string); + + procedure ResetAlpha; + + procedure Draw(DstX, DstY: Integer; Src: TJclBitmap32); overload; + procedure Draw(DstRect, SrcRect: TRect; Src: TJclBitmap32); overload; + procedure Draw(DstRect, SrcRect: TRect; hSrc: HDC); overload; + + procedure DrawTo(Dst: TJclBitmap32); overload; + procedure DrawTo(Dst: TJclBitmap32; DstX, DstY: Integer); overload; + procedure DrawTo(Dst: TJclBitmap32; DstRect: TRect); overload; + procedure DrawTo(Dst: TJclBitmap32; DstRect, SrcRect: TRect); overload; + procedure DrawTo(hDst: HDC; DstX, DstY: Integer); overload; + procedure DrawTo(hDst: HDC; DstRect, SrcRect: TRect); overload; + + function GetPixelB(X, Y: Integer): TColor32; + procedure SetPixelT(X, Y: Integer; Value: TColor32); overload; + procedure SetPixelT(var Ptr: PColor32; Value: TColor32); overload; + procedure SetPixelTS(X, Y: Integer; Value: TColor32); + procedure SetPixelF(X, Y: Single; Value: TColor32); + procedure SetPixelFS(X, Y: Single; Value: TColor32); + + procedure SetStipple(NewStipple: TArrayOfColor32); overload; + procedure SetStipple(NewStipple: array of TColor32); overload; + procedure ResetStippleCounter; + function GetStippleColor: TColor32; + + procedure DrawHorzLine(X1, Y, X2: Integer; Value: TColor32); + procedure DrawHorzLineS(X1, Y, X2: Integer; Value: TColor32); + procedure DrawHorzLineT(X1, Y, X2: Integer; Value: TColor32); + procedure DrawHorzLineTS(X1, Y, X2: Integer; Value: TColor32); + procedure DrawHorzLineTSP(X1, Y, X2: Integer); + + procedure DrawVertLine(X, Y1, Y2: Integer; Value: TColor32); + procedure DrawVertLineS(X, Y1, Y2: Integer; Value: TColor32); + procedure DrawVertLineT(X, Y1, Y2: Integer; Value: TColor32); + procedure DrawVertLineTS(X, Y1, Y2: Integer; Value: TColor32); + procedure DrawVertLineTSP(X, Y1, Y2: Integer); + + procedure DrawLine(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean = False); + procedure DrawLineS(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean = False); + procedure DrawLineT(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean = False); + procedure DrawLineTS(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean = False); + procedure DrawLineA(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean = False); + procedure DrawLineAS(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean = False); + procedure DrawLineF(X1, Y1, X2, Y2: Single; Value: TColor32; L: Boolean = False); + procedure DrawLineFS(X1, Y1, X2, Y2: Single; Value: TColor32; L: Boolean = False); + procedure DrawLineFP(X1, Y1, X2, Y2: Single; L: Boolean = False); + procedure DrawLineFSP(X1, Y1, X2, Y2: Single; L: Boolean = False); + + procedure MoveTo(X, Y: Integer); + procedure LineToS(X, Y: Integer); + procedure LineToTS(X, Y: Integer); + procedure LineToAS(X, Y: Integer); + procedure MoveToF(X, Y: Single); + procedure LineToFS(X, Y: Single); + + procedure FillRect(X1, Y1, X2, Y2: Integer; Value: TColor32); + procedure FillRectS(X1, Y1, X2, Y2: Integer; Value: TColor32); + procedure FillRectT(X1, Y1, X2, Y2: Integer; Value: TColor32); + procedure FillRectTS(X1, Y1, X2, Y2: Integer; Value: TColor32); + + procedure FrameRectS(X1, Y1, X2, Y2: Integer; Value: TColor32); + procedure FrameRectTS(X1, Y1, X2, Y2: Integer; Value: TColor32); overload; + procedure FrameRectTSP(X1, Y1, X2, Y2: Integer); overload; + procedure RaiseRectTS(X1, Y1, X2, Y2: Integer; Contrast: Integer); + + procedure UpdateFont; + procedure TextOut(X, Y: Integer; const Text: string); overload; + procedure TextOut(X, Y: Integer; const ClipRect: TRect; const Text: string); overload; + procedure TextOut(ClipRect: TRect; const Flags: Cardinal; const Text: string); overload; + function TextExtent(const Text: string): TSize; + function TextHeight(const Text: string): Integer; + function TextWidth(const Text: string): Integer; + procedure RenderText(X, Y: Integer; const Text: string; AALevel: Integer; Color: TColor32); + + property BitmapHandle: HBITMAP read FHandle; + property BitmapInfo: TBitmapInfo read FBitmapInfo; + property Bits: PColor32Array read FBits; + property Font: TFont read FFont write SetFont; + property Handle: HDC read FHDC; + property PenColor: TColor32 read FPenColor write FPenColor; + property Pixel[X, Y: Integer]: TColor32 read GetPixel write SetPixel; default; + property PixelS[X, Y: Integer]: TColor32 read GetPixelS write SetPixelS; + property PixelPtr[X, Y: Integer]: PColor32 read GetPixelPtr; + property ScanLine[Y: Integer]: PColor32Array read GetScanLine; + property StippleStep: Single read FStippleStep write SetStippleStep; + published + property DrawMode: TDrawMode read FDrawMode write SetDrawMode default dmOpaque; + property MasterAlpha: Byte read FMasterAlpha write SetMasterAlpha default $FF; + property OuterColor: TColor32 read FOuterColor write FOuterColor default 0; + property StretchFilter: TStretchFilter read FStretchFilter write SetStretchFilter default sfNearest; + property ResetAlphaOnAssign: Boolean read FResetAlphaOnAssign write FResetAlphaOnAssign default true; + property OnChanging; + property OnChange; + end; + + TJclByteMap = class(TJclCustomMap) + private + FBytes: TDynByteArray; + FHeight: Integer; + FWidth: Integer; + function GetValue(X, Y: Integer): Byte; + function GetValPtr(X, Y: Integer): PByte; + procedure SetValue(X, Y: Integer; Value: Byte); + protected + procedure AssignTo(Dst: TPersistent); override; + public + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + function Empty: Boolean; override; + procedure Clear(FillValue: Byte); + procedure ReadFrom(Source: TJclBitmap32; Conversion: TConversionKind); + procedure SetSize(NewWidth, NewHeight: Integer); override; + procedure WriteTo(Dest: TJclBitmap32; Conversion: TConversionKind); overload; + procedure WriteTo(Dest: TJclBitmap32; const Palette: TPalette32); overload; + property Bytes: TDynByteArray read FBytes; + property ValPtr[X, Y: Integer]: PByte read GetValPtr; + property Value[X, Y: Integer]: Byte read GetValue write SetValue; default; + end; + + TJclTransformation = class(TObject) + public + function GetTransformedBounds(const Src: TRect): TRect; virtual; abstract; + procedure PrepareTransform; virtual; abstract; + procedure Transform(DstX, DstY: Integer; out SrcX, SrcY: Integer); virtual; abstract; + procedure Transform256(DstX, DstY: Integer; out SrcX256, SrcY256: Integer); virtual; abstract; + end; + + TJclLinearTransformation = class(TJclTransformation) + private + FMatrix: TMatrix3d; + protected + A: Integer; + B: Integer; + C: Integer; + D: Integer; + E: Integer; + F: Integer; + public + constructor Create; virtual; + function GetTransformedBounds(const Src: TRect): TRect; override; + procedure PrepareTransform; override; + procedure Transform(DstX, DstY: Integer; out SrcX, SrcY: Integer); override; + procedure Transform256(DstX, DstY: Integer; out SrcX256, SrcY256: Integer); override; + procedure Clear; + procedure Rotate(Cx, Cy, Alpha: Extended); // degrees + procedure Skew(Fx, Fy: Extended); + procedure Scale(Sx, Sy: Extended); + procedure Translate(Dx, Dy: Extended); + property Matrix: TMatrix3d read FMatrix write FMatrix; + end; + +// Bitmap Functions +procedure Stretch(NewWidth, NewHeight: Cardinal; Filter: TResamplingFilter; + Radius: Single; Source: TGraphic; Target: TBitmap); overload; +procedure Stretch(NewWidth, NewHeight: Cardinal; Filter: TResamplingFilter; + Radius: Single; Bitmap: TBitmap); overload; + +procedure DrawBitmap(DC: HDC; Bitmap: HBITMAP; X, Y, Width, Height: Integer); + +function ExtractIconCount(const FileName: string): Integer; +function BitmapToIcon(Bitmap: HBITMAP; cx, cy: Integer): HICON; overload; +function BitmapToIcon(Bitmap, Mask: HBITMAP; cx, cy: Integer): HICON; overload; +function IconToBitmap(Icon: HICON): HBITMAP; + +procedure BitmapToJPeg(const FileName: string); +procedure JPegToBitmap(const FileName: string); + +{$IFDEF HAS_UNIT_GIFIMG} +procedure BitmapToGif(const FileName: string); +procedure GifToBitmap(const FileName: string); +{$ENDIF HAS_UNIT_GIFIMG} + +{$IFDEF HAS_UNIT_PNGIMAGE} +procedure BitmapToPng(const FileName: string); +procedure PngToBitmap(const FileName: string); +{$ENDIF HAS_UNIT_PNGIMAGE} + +procedure SaveIconToFile(Icon: HICON; const FileName: string); +procedure WriteIcon(Stream: TStream; ColorBitmap, MaskBitmap: HBITMAP; + WriteLength: Boolean = False); overload; +procedure WriteIcon(Stream: TStream; Icon: HICON; WriteLength: Boolean = False); overload; +procedure GetIconFromBitmap(Icon: TIcon; Bitmap: TBitmap); + +function GetAntialiasedBitmap(const Bitmap: TBitmap): TBitmap; + +procedure BlockTransfer(Dst: TJclBitmap32; DstX: Integer; DstY: Integer; Src: TJclBitmap32; + SrcRect: TRect; CombineOp: TDrawMode); + +procedure StretchTransfer(Dst: TJclBitmap32; DstRect: TRect; Src: TJclBitmap32; SrcRect: TRect; + StretchFilter: TStretchFilter; CombineOp: TDrawMode); + +procedure Transform(Dst, Src: TJclBitmap32; SrcRect: TRect; Transformation: TJclTransformation); +procedure SetBorderTransparent(ABitmap: TJclBitmap32; ARect: TRect); + +function FillGradient(DC: HDC; ARect: TRect; ColorCount: Integer; + StartColor, EndColor: TColor; ADirection: TGradientDirection): Boolean; overload; + +function CreateRegionFromBitmap(Bitmap: TBitmap; RegionColor: TColor; + RegionBitmapMode: TJclRegionBitmapMode; UseAlphaChannel: Boolean = False): HRGN; +procedure ScreenShot(bm: TBitmap; Left, Top, Width, Height: Integer; Window: THandle = HWND_DESKTOP); overload; +procedure ScreenShot(bm: TBitmap; IncludeTaskBar: Boolean = True); overload; +procedure ScreenShot(bm: TBitmap; FormToPrint: TCustomForm); overload; +function MapWindowRect(hWndFrom, hWndTo: THandle; ARect: TRect):TRect; + +// PolyLines and Polygons +procedure PolyLineTS(Bitmap: TJclBitmap32; const Points: TDynPointArray; Color: TColor32); +procedure PolyLineAS(Bitmap: TJclBitmap32; const Points: TDynPointArray; Color: TColor32); +procedure PolyLineFS(Bitmap: TJclBitmap32; const Points: TDynPointArrayF; Color: TColor32); + +procedure PolygonTS(Bitmap: TJclBitmap32; const Points: TDynPointArray; Color: TColor32); +procedure PolygonAS(Bitmap: TJclBitmap32; const Points: TDynPointArray; Color: TColor32); +procedure PolygonFS(Bitmap: TJclBitmap32; const Points: TDynPointArrayF; Color: TColor32); + +procedure PolyPolygonTS(Bitmap: TJclBitmap32; const Points: TDynDynPointArrayArray; + Color: TColor32); +procedure PolyPolygonAS(Bitmap: TJclBitmap32; const Points: TDynDynPointArrayArray; + Color: TColor32); +procedure PolyPolygonFS(Bitmap: TJclBitmap32; const Points: TDynDynPointArrayArrayF; + Color: TColor32); + +// Filters +procedure AlphaToGrayscale(Dst, Src: TJclBitmap32); +procedure IntensityToAlpha(Dst, Src: TJclBitmap32); +procedure Invert(Dst, Src: TJclBitmap32); +procedure InvertRGB(Dst, Src: TJclBitmap32); +procedure ColorToGrayscale(Dst, Src: TJclBitmap32); +procedure ApplyLUT(Dst, Src: TJclBitmap32; const LUT: TLUT8); +procedure SetGamma(Gamma: Single = 0.7); + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\vcl'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.Math, + Winapi.CommCtrl, Winapi.ShellApi, + {$IFDEF HAS_UNIT_GIFIMG} + Vcl.Imaging.GifImg, + {$ENDIF HAS_UNIT_GIFIMG} + {$IFDEF HAS_UNIT_PNGIMAGE} + Vcl.Imaging.PngImage, + {$ENDIF HAS_UNIT_PNGIMAGE} + Vcl.ClipBrd, Vcl.Imaging.JPeg, System.TypInfo, + {$ELSE ~HAS_UNITSCOPE} + Math, + CommCtrl, ShellApi, + {$IFDEF HAS_UNIT_GIFIMG} + GifImg, + {$ENDIF HAS_UNIT_GIFIMG} + {$IFDEF HAS_UNIT_PNGIMAGE} + PngImage, + {$ENDIF HAS_UNIT_PNGIMAGE} + ClipBrd, JPeg, TypInfo, + {$ENDIF ~HAS_UNITSCOPE} + JclVclResources, + JclSysUtils, + JclLogic; + +type + PBGRAInt = ^TBGRAInt; + TBGRAInt = record + R: Integer; + G: Integer; + B: Integer; + A: Integer; + end; + + PBGRA = ^TBGRA; + TBGRA = packed record + B: Byte; + G: Byte; + R: Byte; + A: Byte; + end; + + TBitmapFilterFunction = function(Value: Single): Single; + + PContributor = ^TContributor; + TContributor = record + Weight: Integer; // Pixel Weight + Pixel: Integer; // Source Pixel + end; + + TContributors = array of TContributor; + + // list of source pixels contributing to a destination pixel + PContributorEntry = ^TContributorEntry; + TContributorEntry = record + N: Integer; + Contributors: TContributors; + end; + + TContributorList = array of TContributorEntry; + TJclGraphicAccess = class(TGraphic); + +const + DefaultFilterRadius: array [TResamplingFilter] of Single = + (0.5, 1.0, 1.0, 1.5, 2.0, 3.0, 2.0); + _RGB: TColor32 = $00FFFFFF; + +var + { Gamma bias for line/pixel antialiasing/shape correction } + GAMMA_TABLE: TGamma; + +type + TBGRAIntArray = array of TBGRAInt; + +//=== Helper functions ======================================================= + +function IntToByte(Value: Integer): Byte; {$IFDEF SUPPORTS_INLINE} inline;{$ENDIF} +begin + Result := 255; + if Value >= 0 then + begin + if Value <= 255 then + Result := Value; + end + else + Result := 0; +end; + +procedure CheckBitmaps(Dst, Src: TJclBitmap32); +begin + if (Dst = nil) or Dst.Empty then + raise EJclGraphicsError.CreateRes(@RsDestinationBitmapEmpty); + if (Src = nil) or Src.Empty then + raise EJclGraphicsError.CreateRes(@RsSourceBitmapEmpty); +end; + +function CheckSrcRect(Src: TJclBitmap32; const SrcRect: TRect): Boolean; +begin + Result := False; + if IsRectEmpty(SrcRect) then + Exit; + if (SrcRect.Left < 0) or (SrcRect.Right > Src.Width) or + (SrcRect.Top < 0) or (SrcRect.Bottom > Src.Height) then + raise EJclGraphicsError.CreateRes(@RsSourceBitmapInvalid); + Result := True; +end; + +//=== Internal low level routines ============================================ + +procedure FillLongword(var X; Count: Integer; Value: Longword); +var + P: PLongword; +begin + P := @X; + while Count > 0 do + begin + P^ := Value; + Inc(P); + Dec(Count); + end; +end; + +function Clamp(Value: Integer): TColor32; +begin + if Value < 0 then + Result := 0 + else + if Value > 255 then + Result := 255 + else + Result := Value; +end; + +procedure TestSwap(var A, B: Integer); +var + X: Integer; +begin + X := A; // optimization + if X > B then + begin + A := B; + B := X; + end; +end; + +function TestClip(var A, B: Integer; Size: Integer): Boolean; +begin + TestSwap(A, B); // now A = min(A,B) and B = max(A, B) + if A < 0 then + A := 0; + if B >= Size then + B := Size - 1; + Result := B >= A; +end; + +function Constrain(Value, Lo, Hi: Integer): Integer; +begin + if Value <= Lo then + Result := Lo + else + if Value >= Hi then + Result := Hi + else + Result := Value; +end; + +// Filter functions for stretching of TBitmaps +// f(t) = 2|t|^3 - 3|t|^2 + 1, -1 <= t <= 1 + +function BitmapHermiteFilter(Value: Single): Single; +begin + if Value < 0.0 then + Value := -Value; + if Value < 1 then + Result := (2 * Value - 3) * Sqr(Value) + 1 + else + Result := 0; +end; + +// This filter is also known as 'nearest neighbour' Filter. + +function BitmapBoxFilter(Value: Single): Single; +begin + if (Value > -0.5) and (Value <= 0.5) then + Result := 1.0 + else + Result := 0.0; +end; + +// aka 'linear' or 'bilinear' filter + +function BitmapTriangleFilter(Value: Single): Single; +begin + if Value < 0.0 then + Value := -Value; + if Value < 1.0 then + Result := 1.0 - Value + else + Result := 0.0; +end; + +function BitmapBellFilter(Value: Single): Single; +begin + if Value < 0.0 then + Value := -Value; + if Value < 0.5 then + Result := 0.75 - Sqr(Value) + else + if Value < 1.5 then + begin + Value := Value - 1.5; + Result := 0.5 * Sqr(Value); + end + else + Result := 0.0; +end; + +// B-spline filter + +function BitmapSplineFilter(Value: Single): Single; +var + Temp: Single; +begin + if Value < 0.0 then + Value := -Value; + if Value < 1.0 then + begin + Temp := Sqr(Value); + Result := 0.5 * Temp * Value - Temp + 2.0 / 3.0; + end + else + if Value < 2.0 then + begin + Value := 2.0 - Value; + Result := Sqr(Value) * Value / 6.0; + end + else + Result := 0.0; +end; + +function BitmapLanczos3Filter(Value: Single): Single; +const + OneThird = 1.0 / 3.0; + + function SinC(Value: Single): Single; + begin + if Value <> 0.0 then + begin + Value := Value * Pi; + Result := System.Sin(Value) / Value; + end + else + Result := 1.0; + end; + +begin + if Value < 0.0 then + Value := -Value; + if Value < 3.0 then + Result := SinC(Value) * SinC(Value * OneThird) + else + Result := 0.0; +end; + +function BitmapMitchellFilter(Value: Single): Single; +const + B = 1.0 / 3.0; + C = 1.0 / 3.0; + OneSixth = 1.0 / 6.0; +var + Temp: Single; +begin + if Value < 0.0 then + Value := -Value; + Temp := Sqr(Value); + if Value < 1.0 then + begin + Value := (((12.0 - 9.0 * B - 6.0 * C) * (Value * Temp)) + + ((-18.0 + 12.0 * B + 6.0 * C) * Temp) + + (6.0 - 2.0 * B)); + Result := Value * OneSixth; + end + else + if Value < 2.0 then + begin + Value := (((-B - 6.0 * C) * (Value * Temp)) + + ((6.0 * B + 30.0 * C) * Temp) + + ((-12.0 * B - 48.0 * C) * Value) + + (8.0 * B + 24.0 * C)); + Result := Value * OneSixth; + end + else + Result := 0.0; +end; + +const + FilterList: array [TResamplingFilter] of TBitmapFilterFunction = + ( + BitmapBoxFilter, + BitmapTriangleFilter, + BitmapHermiteFilter, + BitmapBellFilter, + BitmapSplineFilter, + BitmapLanczos3Filter, + BitmapMitchellFilter + ); + +procedure FillLineCacheHorz(N: Integer; Line: Pointer; const ACurrentLine: TBGRAIntArray); +var + Run: PBGRA; + Data: PBGRAInt; +begin + Run := Line; + Data := @ACurrentLine[0]; + Dec(N); + while N >= 0 do + begin + Data.B := Run.B; + Data.G := Run.G; + Data.R := Run.R; + Data.A := Run.A; + Inc(Run); + Inc(Data); + Dec(N); + end; +end; + +procedure FillLineCacheVert(N, Delta: Integer; Line: Pointer; const ACurrentLine: TBGRAIntArray); +var + Run: PBGRA; + Data: PBGRAInt; +begin + Run := Line; + Data := @ACurrentLine[0]; + Dec(N); + while N >= 0 do + begin + Data.B := Run.B; + Data.G := Run.G; + Data.R := Run.R; + Data.A := Run.A; + Inc(PByte(Run), Delta); + Inc(Data); + Dec(N); + end; +end; + +function ApplyContributors(Contributor: PContributorEntry; const ACurrentLine: TBGRAIntArray): TBGRA; +var + J: Integer; + RGB: TBGRAInt; + Total, Weight: Integer; + Contr: PContributor; + Data: PBGRAInt; +begin + Total := 0; + RGB.R := Total; // trick compiler into generating better code + RGB.G := Total; + RGB.B := Total; + RGB.A := Total; + Contr := @Contributor.Contributors[0]; + for J := 0 to Contributor.N - 1 do + begin + Weight := Contr.Weight; + Inc(Total, Weight); + Data := @ACurrentLine[Contr.Pixel]; + Inc(RGB.R, Data.R * Weight); + Inc(RGB.G, Data.G * Weight); + Inc(RGB.B, Data.B * Weight); + Inc(RGB.A, Data.A * Weight); + Inc(Contr); + end; + + if Total <> 0 then + begin + Result.B := IntToByte(RGB.B div Total); + Result.G := IntToByte(RGB.G div Total); + Result.R := IntToByte(RGB.R div Total); + Result.A := IntToByte(RGB.A div Total); + end + else + begin + Result.B := IntToByte(RGB.B shr 8); + Result.G := IntToByte(RGB.G shr 8); + Result.R := IntToByte(RGB.R shr 8); + Result.A := IntToByte(RGB.A shr 8); + end; +end; + +// This is the actual scaling routine. Target must be allocated already with +// sufficient size. Source must contain valid data, Radius must not be 0 and +// Filter must not be nil. + +procedure DoStretch(Filter: TBitmapFilterFunction; Radius: Single; Source, Target: TBitmap); +var + ScaleX, ScaleY: Single; // Zoom scale factors + I, J, K, N: Integer; // Loop variables + Center: Single; // Filter calculation variables + Width: Single; + Weight: Integer; // Filter calculation variables + Left, Right: Integer; // Filter calculation variables + Work: TBitmap; + ContributorList: TContributorList; + SourceLine, DestLine: PBGRA; + DestPixel: PBGRA; + Delta, DestDelta: Integer; + SourceHeight, SourceWidth: Integer; + TargetHeight, TargetWidth: Integer; + CurrentLine: TBGRAIntArray; +begin + // shortcut variables + SourceHeight := Source.Height; + SourceWidth := Source.Width; + TargetHeight := Target.Height; + TargetWidth := Target.Width; + // create intermediate image to hold horizontal zoom + Work := TBitmap.Create; + try + Work.PixelFormat := pf32bit; + Work.Height := SourceHeight; + Work.Width := TargetWidth; + if SourceWidth = 1 then + ScaleX := TargetWidth / SourceWidth + else + ScaleX := (TargetWidth - 1) / (SourceWidth - 1); + if SourceHeight = 1 then + ScaleY := TargetHeight / SourceHeight + else + ScaleY := (TargetHeight - 1) / (SourceHeight - 1); + + // pre-calculate filter contributions for a row + SetLength(ContributorList, TargetWidth); + // horizontal sub-sampling + if ScaleX < 1 then + begin + // scales from bigger to smaller Width + Width := Radius / ScaleX; + for I := 0 to TargetWidth - 1 do + begin + ContributorList[I].N := 0; + Center := I / ScaleX; + Left := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Math.Floor(Center - Width); + Right := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Math.Ceil(Center + Width); + SetLength(ContributorList[I].Contributors, Right - Left + 1); + for J := Left to Right do + begin + Weight := Round(Filter((Center - J) * ScaleX) * ScaleX * 256); + if Weight <> 0 then + begin + if J < 0 then + N := -J + else + if J >= SourceWidth then + N := SourceWidth - J + SourceWidth - 1 + else + N := J; + K := ContributorList[I].N; + Inc(ContributorList[I].N); + ContributorList[I].Contributors[K].Pixel := N; + ContributorList[I].Contributors[K].Weight := Weight; + end; + end; + end; + end + else + begin + // horizontal super-sampling + // scales from smaller to bigger Width + for I := 0 to TargetWidth - 1 do + begin + ContributorList[I].N := 0; + Center := I / ScaleX; + Left := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Math.Floor(Center - Radius); + Right := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Math.Ceil(Center + Radius); + SetLength(ContributorList[I].Contributors, Right - Left + 1); + for J := Left to Right do + begin + Weight := Round(Filter(Center - J) * 256); + if Weight <> 0 then + begin + if J < 0 then + N := -J + else + if J >= SourceWidth then + N := SourceWidth - J + SourceWidth - 1 + else + N := J; + K := ContributorList[I].N; + Inc(ContributorList[I].N); + ContributorList[I].Contributors[K].Pixel := N; + ContributorList[I].Contributors[K].Weight := Weight; + end; + end; + end; + end; + + if SourceWidth > SourceHeight then + SetLength(CurrentLine, SourceWidth) + else + SetLength(CurrentLine, SourceHeight); + + // now apply filter to sample horizontally from Src to Work + for K := 0 to SourceHeight - 1 do + begin + SourceLine := Source.ScanLine[K]; + FillLineCacheHorz(SourceWidth, SourceLine, CurrentLine); + DestPixel := Work.ScanLine[K]; + for I := 0 to TargetWidth - 1 do + begin + DestPixel^ := ApplyContributors(@ContributorList[I], CurrentLine); + // move on to next column + Inc(DestPixel); + end; + end; + + // free the memory allocated for horizontal filter weights, since we need + // the structure again + for I := 0 to TargetWidth - 1 do + ContributorList[I].Contributors := nil; + ContributorList := nil; + + // pre-calculate filter contributions for a column + SetLength(ContributorList, TargetHeight); + // vertical sub-sampling + if ScaleY < 1 then + begin + // scales from bigger to smaller height + Width := Radius / ScaleY; + for I := 0 to TargetHeight - 1 do + begin + ContributorList[I].N := 0; + Center := I / ScaleY; + Left := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Math.Floor(Center - Width); + Right := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Math.Ceil(Center + Width); + SetLength(ContributorList[I].Contributors, Right - Left + 1); + for J := Left to Right do + begin + Weight := Round(Filter((Center - J) * ScaleY) * ScaleY * 256); + if Weight <> 0 then + begin + if J < 0 then + N := -J + else + if J >= SourceHeight then + N := SourceHeight - J + SourceHeight - 1 + else + N := J; + K := ContributorList[I].N; + Inc(ContributorList[I].N); + ContributorList[I].Contributors[K].Pixel := N; + ContributorList[I].Contributors[K].Weight := Weight; + end; + end; + end; + end + else + begin + // vertical super-sampling + // scales from smaller to bigger height + for I := 0 to TargetHeight - 1 do + begin + ContributorList[I].N := 0; + Center := I / ScaleY; + Left := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Math.Floor(Center - Radius); + Right := {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}Math.Ceil(Center + Radius); + SetLength(ContributorList[I].Contributors, Right - Left + 1); + for J := Left to Right do + begin + Weight := Round(Filter(Center - J) * 256); + if Weight <> 0 then + begin + if J < 0 then + N := -J + else + if J >= SourceHeight then + N := SourceHeight - J + SourceHeight - 1 + else + N := J; + K := ContributorList[I].N; + Inc(ContributorList[I].N); + ContributorList[I].Contributors[K].Pixel := N; + ContributorList[I].Contributors[K].Weight := Weight; + end; + end; + end; + end; + + // apply filter to sample vertically from Work to Target + SourceLine := Work.ScanLine[0]; + Delta := PAnsiChar(Work.ScanLine[1]) - PAnsiChar(SourceLine); // don't use TJclAddr here because of IntOverflow + DestLine := Target.ScanLine[0]; + DestDelta := PAnsiChar(Target.ScanLine[1]) - PAnsiChar(DestLine); // don't use TJclAddr here because of IntOverflow + for K := 0 to TargetWidth - 1 do + begin + DestPixel := Pointer(DestLine); + FillLineCacheVert(SourceHeight, Delta, SourceLine, CurrentLine); + for I := 0 to TargetHeight - 1 do + begin + DestPixel^ := ApplyContributors(@ContributorList[I], CurrentLine); + // move on to next row + Inc(INT_PTR(DestPixel), DestDelta); + end; + Inc(SourceLine); + Inc(DestLine); + end; + + // free the memory allocated for vertical filter weights + for I := 0 to TargetHeight - 1 do + ContributorList[I].Contributors := nil; + // this one is done automatically on exit, but is here for completeness + ContributorList := nil; + + finally + Work.Free; + Target.Modified := True; + end; +end; + +// Filter functions for TJclBitmap32 +type + TPointRec = record + Pos: Integer; + Weight: Integer; + end; + TCluster = array of TPointRec; + TMappingTable = array of TCluster; + TFilterFunc = function(Value: Extended): Extended; + +function NearestFilter(Value: Extended): Extended; +begin + if (Value > -0.5) and (Value <= 0.5) then + Result := 1 + else + Result := 0; +end; + +function LinearFilter(Value: Extended): Extended; +begin + if Value < -1 then + Result := 0 + else + if Value < 0 then + Result := 1 + Value + else + if Value < 1 then + Result := 1 - Value + else + Result := 0; +end; + +function SplineFilter(Value: Extended): Extended; +var + tt: Extended; +begin + Value := Abs(Value); + if Value < 1 then + begin + tt := Sqr(Value); + Result := 0.5 * tt * Value - tt + 2 / 3; + end + else + if Value < 2 then + begin + Value := 2 - Value; + Result := 1 / 6 * Sqr(Value) * Value; + end + else + Result := 0; +end; + +function BuildMappingTable(DstWidth, SrcFrom, SrcWidth: Integer; + StretchFilter: TStretchFilter): TMappingTable; +const + FILTERS: array [TStretchFilter] of TFilterFunc = + (NearestFilter, LinearFilter, SplineFilter); +var + Filter: TFilterFunc; + FilterWidth: Extended; + Scale, OldScale: Extended; + Center: Extended; + Bias: Extended; + Left, Right: Integer; + I, J, K: Integer; + Weight: Integer; +begin + if SrcWidth = 0 then + begin + Result := nil; + Exit; + end; + Filter := FILTERS[StretchFilter]; + if StretchFilter in [sfNearest, sfLinear] then + FilterWidth := 1 + else + FilterWidth := 1.5; + SetLength(Result, DstWidth); + Scale := (DstWidth - 1) / (SrcWidth - 1); + + if Scale < 1 then + begin + OldScale := Scale; + Scale := 1 / Scale; + FilterWidth := FilterWidth * Scale; + for I := 0 to DstWidth - 1 do + begin + Center := I * Scale; + Left := Floor(Center - FilterWidth); + Right := Ceil(Center + FilterWidth); + Bias := 0; + for J := Left to Right do + begin + Weight := Round(255 * Filter((Center - J) * OldScale) * OldScale); + if Weight <> 0 then + begin + Bias := Bias + Weight / 255; + K := Length(Result[I]); + SetLength(Result[I], K + 1); + Result[I][K].Pos := Constrain(J + SrcFrom, 0, SrcWidth - 1); + Result[I][K].Weight := Weight; + end; + end; + if (Bias > 0) and (Bias <> 1) then + begin + Bias := 1 / Bias; + for K := 0 to High(Result[I]) do + Result[I][K].Weight := Round(Result[I][K].Weight * Bias); + end; + end; + end + else + begin + FilterWidth := 1 / FilterWidth; + Scale := 1 / Scale; + for I := 0 to DstWidth - 1 do + begin + Center := I * Scale; + Left := Floor(Center - FilterWidth); + Right := Ceil(Center + FilterWidth); + for J := Left to Right do + begin + Weight := Round(255 * Filter(Center - J)); + if Weight <> 0 then + begin + K := Length(Result[I]); + SetLength(Result[I], K + 1); + Result[I][K].Pos := Constrain(J + SrcFrom, 0, SrcWidth - 1); + Result[I][K].Weight := Weight; + end; + end; + end; + end; +end; + +// Bitmap Functions +// Scales the source graphic to the given size (NewWidth, NewHeight) and stores the Result in Target. +// Filter describes the filter function to be applied and Radius the size of the filter area. +// Is Radius = 0 then the recommended filter area will be used (see DefaultFilterRadius). + +procedure Stretch(NewWidth, NewHeight: Cardinal; Filter: TResamplingFilter; + Radius: Single; Source: TGraphic; Target: TBitmap); +var + Temp: TBitmap; + OriginalPixelFormat: TPixelFormat; +begin + if Source.Empty then + Exit; // do nothing + + if Radius = 0 then + Radius := DefaultFilterRadius[Filter]; + + Temp := TBitmap.Create; + try + // To allow Source = Target, the following assignment needs to be done initially + Temp.Assign(Source); + Temp.PixelFormat := pf32bit; + OriginalPixelFormat := Target.PixelFormat; //Save format + + Target.FreeImage; + Target.PixelFormat := pf32bit; + Target.Width := NewWidth; + Target.Height := NewHeight; + + if not Target.Empty then + DoStretch(FilterList[Filter], Radius, Temp, Target); + + Target.PixelFormat := OriginalPixelFormat; //Restore original PixelFormat + finally + Temp.Free; + end; +end; + +procedure Stretch(NewWidth, NewHeight: Cardinal; Filter: TResamplingFilter; + Radius: Single; Bitmap: TBitmap); +begin + Stretch(NewWidth, NewHeight, Filter, Radius, Bitmap, Bitmap); +end; + +procedure StretchNearest(Dst: TJclBitmap32; DstRect: TRect; + Src: TJclBitmap32; SrcRect: TRect; CombineOp: TDrawMode); +var + SrcW, SrcH, DstW, DstH: Integer; + MapX, MapY: array of Integer; + DstX, DstY: Integer; + R: TRect; + I, J, Y: Integer; + P: PColor32; + MstrAlpha: TColor32; +begin + // check source and destination + CheckBitmaps(Dst, Src); + if not CheckSrcRect(Src, SrcRect) then + Exit; + if IsRectEmpty(DstRect) then + Exit; + IntersectRect(R, DstRect, Rect(0, 0, Dst.Width, Dst.Height)); + if IsRectEmpty(R) then + Exit; + if (CombineOp = dmBlend) and (Src.MasterAlpha = 0) then + Exit; + + SrcW := SrcRect.Right - SrcRect.Left; + SrcH := SrcRect.Bottom - SrcRect.Top; + DstW := DstRect.Right - DstRect.Left; + DstH := DstRect.Bottom - DstRect.Top; + DstX := DstRect.Left; + DstY := DstRect.Top; + + // check if we actually have to stretch anything + if (SrcW = DstW) and (SrcH = DstH) then + begin + BlockTransfer(Dst, DstX, DstY, Src, SrcRect, CombineOp); + Exit; + end; + + // build X coord mapping table + SetLength(MapX, DstW); + SetLength(MapY, DstH); + + for I := 0 to DstW - 1 do + MapX[I] := I * (SrcW) div (DstW) + SrcRect.Left; + + // build Y coord mapping table + for J := 0 to DstH - 1 do + MapY[J] := J * (SrcH) div (DstH) + SrcRect.Top; + + // transfer pixels + case CombineOp of + dmOpaque: + for J := R.Top to R.Bottom - 1 do + begin + Y := MapY[J - DstY]; + P := Dst.PixelPtr[R.Left, J]; + for I := R.Left to R.Right - 1 do + begin + P^ := Src[MapX[I - DstX], Y]; + Inc(P); + end; + end; + dmBlend: + begin + MstrAlpha := Src.MasterAlpha; + if MstrAlpha = 255 then + for J := R.Top to R.Bottom - 1 do + begin + Y := MapY[J - DstY]; + P := Dst.PixelPtr[R.Left, J]; + for I := R.Left to R.Right - 1 do + begin + BlendMem(Src[MapX[I - DstX], Y], P^); + Inc(P); + end; + end + else // Master Alpha is in [1..254] range + for J := R.Top to R.Bottom - 1 do + begin + Y := MapY[J - DstY]; + P := Dst.PixelPtr[R.Left, J]; + for I := R.Left to R.Right - 1 do + begin + BlendMemEx(Src[MapX[I - DstX], Y], P^, MstrAlpha); + Inc(P); + end; + end; + end; + end; +end; + +procedure BlockTransfer(Dst: TJclBitmap32; DstX: Integer; DstY: Integer; Src: TJclBitmap32; + SrcRect: TRect; CombineOp: TDrawMode); +var + SrcX, SrcY: Integer; + S, D: TRect; + J, N: Integer; + Ps, Pd: PColor32; + MstrAlpha: TColor32; +begin + CheckBitmaps(Src, Dst); + if CombineOp = dmOpaque then + begin + BitBlt(Dst.Handle, DstX, DstY, SrcRect.Right - SrcRect.Left, + SrcRect.Bottom - SrcRect.Top, Src.Handle, SrcRect.Left, SrcRect.Top, + SRCCOPY); + Exit; + end; + + if Src.MasterAlpha = 0 then + Exit; + + // clip the rectangles with bitmap boundaries + SrcX := SrcRect.Left; + SrcY := SrcRect.Top; + IntersectRect(S, SrcRect, Rect(0, 0, Src.Width, Src.Height)); + OffsetRect(S, DstX - SrcX, DstY - SrcY); + IntersectRect(D, S, Rect(0, 0, Dst.Width, Dst.Height)); + if IsRectEmpty(D) then + Exit; + + MstrAlpha := Src.MasterAlpha; + N := D.Right - D.Left; + + if MstrAlpha = 255 then + for J := D.Top to D.Bottom - 1 do + begin + Ps := Src.PixelPtr[D.Left + SrcX - DstX, J + SrcY - DstY]; + Pd := Dst.PixelPtr[D.Left, J]; + BlendLine(Ps, Pd, N); + end + else + for J := D.Top to D.Bottom - 1 do + begin + Ps := Src.PixelPtr[D.Left + SrcX - DstX, J + SrcY - DstY]; + Pd := Dst.PixelPtr[D.Left, J]; + BlendLineEx(Ps, Pd, N, MstrAlpha); + end; +end; + +procedure StretchTransfer(Dst: TJclBitmap32; DstRect: TRect; Src: TJclBitmap32; SrcRect: TRect; + StretchFilter: TStretchFilter; CombineOp: TDrawMode); +var + SrcW, SrcH, DstW, DstH: Integer; + MapX, MapY: TMappingTable; + DstX, DstY: Integer; + R: TRect; + I, J, X, Y: Integer; + P: PColor32; + ClusterX, ClusterY: TCluster; + C, Wt, Cr, Cg, Cb, Ca: Integer; + MstrAlpha: TColor32; +begin + // make compiler happy + MapX := nil; + MapY := nil; + ClusterX := nil; + ClusterY := nil; + + if StretchFilter = sfNearest then + begin + StretchNearest(Dst, DstRect, Src, SrcRect, CombineOp); + Exit; + end; + + // check source and destination + CheckBitmaps(Dst, Src); + if not CheckSrcRect(Src, SrcRect) then + Exit; + if IsRectEmpty(DstRect) then + Exit; + IntersectRect(R, DstRect, Rect(0, 0, Dst.Width, Dst.Height)); + if IsRectEmpty(R) then + Exit; + if (CombineOp = dmBlend) and (Src.MasterAlpha = 0) then + Exit; + + SrcW := SrcRect.Right - SrcRect.Left; + SrcH := SrcRect.Bottom - SrcRect.Top; + DstW := DstRect.Right - DstRect.Left; + DstH := DstRect.Bottom - DstRect.Top; + DstX := DstRect.Left; + DstY := DstRect.Top; + MstrAlpha := Src.MasterAlpha; + + // check if we actually have to stretch anything + if (SrcW = DstW) and (SrcH = DstH) then + begin + BlockTransfer(Dst, DstX, DstY, Src, SrcRect, CombineOp); + Exit; + end; + + // mapping tables + MapX := BuildMappingTable(DstW, SrcRect.Left, SrcW, StretchFilter); + MapY := BuildMappingTable(DstH, SrcRect.Top, SrcH, StretchFilter); + ClusterX := nil; + ClusterY := nil; + if (MapX = nil) or (MapY = nil) then + Exit; + + // transfer pixels + for J := R.Top to R.Bottom - 1 do + begin + ClusterY := MapY[J - DstY]; + P := Dst.PixelPtr[R.Left, J]; + for I := R.Left to R.Right - 1 do + begin + ClusterX := MapX[I - DstX]; + + // reset color accumulators + Ca := 0; + Cr := 0; + Cg := 0; + Cb := 0; + + // now iterate through each cluster + for Y := 0 to High(ClusterY) do + for X := 0 to High(ClusterX) do + begin + C := Src[ClusterX[X].Pos, ClusterY[Y].Pos]; + Wt := ClusterX[X].Weight * ClusterY[Y].Weight; + Inc(Ca, C shr 24 * Wt); + Inc(Cr, (C and $00FF0000) shr 16 * Wt); + Inc(Cg, (C and $0000FF00) shr 8 * Wt); + Inc(Cb, (C and $000000FF) * Wt); + end; + Ca := Ca and $00FF0000; + Cr := Cr and $00FF0000; + Cg := Cg and $00FF0000; + Cb := Cb and $00FF0000; + C := (Ca shl 8) or Cr or (Cg shr 8) or (Cb shr 16); + + // combine it with the background + case CombineOp of + dmOpaque: + P^ := C; + dmBlend: + BlendMemEx(C, P^, MstrAlpha); + end; + Inc(P); + end; + end; +end; + +procedure DrawBitmap(DC: HDC; Bitmap: HBITMAP; X, Y, Width, Height: Integer); +var + MemDC: HDC; + OldBitmap: HBITMAP; +begin + MemDC := CreateCompatibleDC(DC); + OldBitmap := SelectObject(MemDC, Bitmap); + BitBlt(DC, X, Y, Width, Height, MemDC, 0, 0, SRCCOPY); + SelectObject(MemDC, OldBitmap); + DeleteObject(MemDC); +end; + +{ TODO : remove VCL-dependency by replacing pf24bit by pf32bit } + +function GetAntialiasedBitmap(const Bitmap: TBitmap): TBitmap; +var + Antialias: TBitmap; + X, Y: Integer; + Line1, Line2, Line: PJclByteArray; +begin + Assert(Bitmap <> nil); + if Bitmap.PixelFormat <> pf24bit then + Bitmap.PixelFormat := pf24bit; + Antialias := TBitmap.Create; + with Bitmap do + begin + Antialias.PixelFormat := pf24bit; + Antialias.Width := Width div 2; + Antialias.Height := Height div 2; + for Y := 0 to Antialias.Height - 1 do + begin + Line1 := ScanLine[Y * 2]; + Line2 := ScanLine[Y * 2 + 1]; + Line := Antialias.ScanLine[Y]; + for X := 0 to Antialias.Width - 1 do + begin + Line[X * 3] := (Integer(Line1[X * 6]) + Integer(Line2[X * 6]) + + Integer(Line1[X * 6 + 3]) + Integer(Line2[X * 6 + 3])) div 4; + Line[X * 3 + 1] := (Integer(Line1[X * 6 + 1]) + Integer(Line2[X * 6 + 1]) + + Integer(Line1[X * 6 + 3 + 1]) + Integer(Line2[X * 6 + 3 + 1])) div 4; + Line[X * 3 + 2] := (Integer(Line1[X * 6 + 2]) + Integer(Line2[X * 6 + 2]) + + Integer(Line1[X * 6 + 3 + 2]) + Integer(Line2[X * 6 + 3 + 2])) div 4; + end; + end; + end; + Result := Antialias; +end; + +procedure ImgToBitmap(const FileName: string; GraphicClass: TGraphicClass); +var + Bitmap: TBitmap; + Img: TGraphic; +begin + Bitmap := nil; + Img := nil; + try + Img := GraphicClass.Create; + Img.LoadFromFile(FileName); + Bitmap := TBitmap.Create; + Bitmap.Assign(Img); + Bitmap.SaveToFile(ChangeFileExt(FileName, LoadResString(@RsBitmapExtension))); + finally + Bitmap.Free; + Img.Free; + end; +end; + +procedure BitmapToImg(const FileName, FileExtension: string; GraphicClass: TGraphicClass); +var + Bitmap: TBitmap; + Img: TGraphic; +begin + Bitmap := nil; + Img := nil; + try + Bitmap := TBitmap.Create; + Bitmap.LoadFromFile(FileName); + Img := GraphicClass.Create; + Img.Assign(Bitmap); + Img.SaveToFile(ChangeFileExt(FileName, FileExtension)); + finally + Bitmap.Free; + Img.Free; + end; +end; + +procedure JPegToBitmap(const FileName: string); +begin + ImgToBitmap(FileName, TJPegImage); +end; + +procedure BitmapToJPeg(const FileName: string); +begin + BitmapToImg(FileName, LoadResString(@RsJpegExtension), TJPEGImage); +end; + +{$IFDEF HAS_UNIT_GIFIMG} +procedure GifToBitmap(const FileName: string); +begin + ImgToBitmap(FileName, TGifImage); +end; + +procedure BitmapToGif(const FileName: string); +begin + BitmapToImg(FileName, LoadResString(@RsGifExtension), TGifImage); +end; +{$ENDIF HAS_UNIT_GIFIMG} + +{$IFDEF HAS_UNIT_PNGIMAGE} +procedure PngToBitmap(const FileName: string); +begin + ImgToBitmap(FileName, TPngImage); +end; + +procedure BitmapToPng(const FileName: string); +begin + BitmapToImg(FileName, LoadResString(@RsPngExtension), TPngImage); +end; +{$ENDIF HAS_UNIT_PNGIMAGE} + +function ExtractIconCount(const FileName: string): Integer; +begin + Result := ExtractIcon(HInstance, PChar(FileName), $FFFFFFFF); +end; + +function BitmapToIcon(Bitmap: HBITMAP; cx, cy: Integer): HICON; +var + ImgList: HIMAGELIST; + I: Integer; +begin + ImgList := ImageList_Create(cx, cy, ILC_COLOR, 1, 1); + try + I := ImageList_Add(ImgList, Bitmap, 0); + Result := ImageList_GetIcon(ImgList, I, ILD_NORMAL); + finally + ImageList_Destroy(ImgList); + end; +end; + +function BitmapToIcon(Bitmap, Mask: HBITMAP; cx, cy: Integer): HICON; +var + ImgList: HIMAGELIST; + I: Integer; +begin + ImgList := ImageList_Create(cx, cy, ILC_COLOR, 1, 1); + try + I := ImageList_Add(ImgList, Bitmap, Mask); + Result := ImageList_GetIcon(ImgList, I, ILD_TRANSPARENT); + finally + ImageList_Destroy(ImgList); + end; +end; + +function IconToBitmap(Icon: HICON): HBITMAP; +var + IconInfo: TIconInfo; +begin + Result := 0; + if GetIconInfo(Icon, IconInfo) then + begin + DeleteObject(IconInfo.hbmMask); + Result := IconInfo.hbmColor; + end; +end; + +procedure GetIconFromBitmap(Icon: TIcon; Bitmap: TBitmap); +var + IconInfo: TIconInfo; +begin + with TBitmap.Create do + try + Assign(Bitmap); + if not Transparent then + TransparentColor := clNone; + IconInfo.fIcon := True; + IconInfo.hbmMask := MaskHandle; + IconInfo.hbmColor := Handle; + Icon.Handle := CreateIconIndirect(IconInfo); + finally + Free; + end; +end; + +const + rc3_Icon = 1; + +type + PCursorOrIcon = ^TCursorOrIcon; + TCursorOrIcon = packed record + Reserved: Word; + wType: Word; + Count: Word; + end; + + PIconRec = ^TIconRec; + TIconRec = packed record + Width: Byte; + Height: Byte; + Colors: Word; + Reserved1: Word; + Reserved2: Word; + DIBSize: Longint; + DIBOffset: Longint; + end; + +procedure WriteIcon(Stream: TStream; ColorBitmap, MaskBitmap: HBITMAP; WriteLength: Boolean = False); +var + MonoInfoSize, ColorInfoSize: DWORD; + MonoBitsSize, ColorBitsSize: DWORD; + MonoInfo, MonoBits, ColorInfo, ColorBits: Pointer; + CI: TCursorOrIcon; + List: TIconRec; + Length: Longint; +begin + ResetMemory(CI, SizeOf(CI)); + ResetMemory(List, SizeOf(List)); + GetDIBSizes(MaskBitmap, MonoInfoSize, MonoBitsSize); + GetDIBSizes(ColorBitmap, ColorInfoSize, ColorBitsSize); + MonoInfo := nil; + MonoBits := nil; + ColorInfo := nil; + ColorBits := nil; + try + MonoInfo := AllocMem(MonoInfoSize); + MonoBits := AllocMem(MonoBitsSize); + ColorInfo := AllocMem(ColorInfoSize); + ColorBits := AllocMem(ColorBitsSize); + GetDIB(MaskBitmap, 0, MonoInfo^, MonoBits^); + GetDIB(ColorBitmap, 0, ColorInfo^, ColorBits^); + if WriteLength then + begin + Length := SizeOf(CI) + SizeOf(List) + ColorInfoSize + + ColorBitsSize + MonoBitsSize; + Stream.Write(Length, SizeOf(Length)); + end; + with CI do + begin + CI.wType := RC3_ICON; + CI.Count := 1; + end; + Stream.Write(CI, SizeOf(CI)); + with List, PBitmapInfoHeader(ColorInfo)^ do + begin + Width := biWidth; + Height := biHeight; + Colors := biPlanes * biBitCount; + DIBSize := ColorInfoSize + ColorBitsSize + MonoBitsSize; + DIBOffset := SizeOf(CI) + SizeOf(List); + end; + Stream.Write(List, SizeOf(List)); + with PBitmapInfoHeader(ColorInfo)^ do + Inc(biHeight, biHeight); { color height includes mono bits } + Stream.Write(ColorInfo^, ColorInfoSize); + Stream.Write(ColorBits^, ColorBitsSize); + Stream.Write(MonoBits^, MonoBitsSize); + finally + FreeMem(ColorInfo, ColorInfoSize); + FreeMem(ColorBits, ColorBitsSize); + FreeMem(MonoInfo, MonoInfoSize); + FreeMem(MonoBits, MonoBitsSize); + end; +end; + +// WriteIcon depends on unit Graphics by use of GetDIBSizes and GetDIB + +procedure WriteIcon(Stream: TStream; Icon: HICON; WriteLength: Boolean = False); +var + IconInfo: TIconInfo; +begin + if GetIconInfo(Icon, IconInfo) then + try + WriteIcon(Stream, IconInfo.hbmColor, IconInfo.hbmMask, WriteLength); + finally + DeleteObject(IconInfo.hbmColor); + DeleteObject(IconInfo.hbmMask); + end + else + RaiseLastOSError; +end; + +procedure SaveIconToFile(Icon: HICON; const FileName: string); +var + Stream: TFileStream; +begin + Stream := TFileStream.Create(FileName, fmCreate); + try + WriteIcon(Stream, Icon, False); + finally + Stream.Free; + end; +end; + +procedure Transform(Dst, Src: TJclBitmap32; SrcRect: TRect; + Transformation: TJclTransformation); +var + SrcBlend: Boolean; + C, SrcAlpha: TColor32; + R, DstRect: TRect; + Pixels: PColor32Array; + I, J, X, Y: Integer; + + function GET_S256(X, Y: Integer; out C: TColor32): Boolean; + var + flrx, flry, celx, cely: Longword; + C1, C2, C3, C4: TColor32; + P: PColor32; + begin + flrx := X and $FF; + flry := Y and $FF; + + X := Sar(X,8); + Y := Sar(Y,8); + + celx := flrx xor 255; + cely := flry xor 255; + + if (X >= SrcRect.Left) and (X < SrcRect.Right - 1) and + (Y >= SrcRect.Top) and (Y < SrcRect.Bottom - 1) then + begin + // everything is ok take the four values and interpolate them + P := Src.PixelPtr[X, Y]; + C1 := P^; + Inc(P); + C2 := P^; + Inc(P, Src.Width); + C4 := P^; + Dec(P); + C3 := P^; + C := CombineReg(CombineReg(C1, C2, celx), CombineReg(C3, C4, celx), cely); + Result := True; + end + else + begin + // (X,Y) coordinate is out of the SrcRect, do not interpolate + C := 0; // just write something to disable compiler warnings + Result := False; + end; + end; +begin + SrcBlend := (Src.DrawMode = dmBlend); + SrcAlpha := Src.MasterAlpha; // store it into a local variable + + // clip SrcRect + R := SrcRect; + IntersectRect(SrcRect, R, Rect(0, 0, Src.Width, Src.Height)); + if IsRectEmpty(SrcRect) then + Exit; + + // clip DstRect + R := Transformation.GetTransformedBounds(SrcRect); + IntersectRect(DstRect, R, Rect(0, 0, Dst.Width, Dst.Height)); + if IsRectEmpty(DstRect) then + Exit; + + if Src.StretchFilter <> sfNearest then + for J := DstRect.Top to DstRect.Bottom - 1 do + begin + Pixels := Dst.ScanLine[J]; + for I := DstRect.Left to DstRect.Right - 1 do + begin + Transformation.Transform256(I, J, X, Y); + if GET_S256(X, Y, C) then + if SrcBlend then + BlendMemEx(C, Pixels[I], SrcAlpha) + else + Pixels[I] := C; + end; + end + else // nearest filter + for J := DstRect.Top to DstRect.Bottom - 1 do + begin + Pixels := Dst.ScanLine[J]; + for I := DstRect.Left to DstRect.Right - 1 do + begin + Transformation.Transform(I, J, X, Y); + if (X >= SrcRect.Left) and (X < SrcRect.Right) and + (Y >= SrcRect.Top) and (Y < SrcRect.Bottom) then + begin + if SrcBlend then + BlendMemEx(Src.Pixel[X, Y], Pixels[I], SrcAlpha) + else + Pixels[I] := Src.Pixel[X, Y]; + end; + end; + end; + Dst.Changed; +end; + +procedure SetBorderTransparent(ABitmap: TJclBitmap32; ARect: TRect); +var + I: Integer; +begin + if TestClip(ARect.Left, ARect.Right, ABitmap.Width) and + TestClip(ARect.Top, ARect.Bottom, ABitmap.Height) then + begin + ABitmap.Changing; + + for I := ARect.Left to ARect.Right do + ABitmap[I, ARect.Top] := ABitmap[I, ARect.Top] and $00FFFFFF; + + for I := ARect.Left to ARect.Right do + ABitmap[I, ARect.Bottom] := ABitmap[I, ARect.Bottom] and $00FFFFFF; + + if ARect.Bottom > ARect.Top + 1 then + for I := ARect.Top + 1 to ARect.Bottom - 1 do + begin + ABitmap[ARect.Left, I] := ABitmap[ARect.Left, I] and $00FFFFFF; + ABitmap[ARect.Right, I] := ABitmap[ARect.Right, I] and $00FFFFFF; + end; + + ABitmap.Changed; + end; +end; + +function CreateRegionFromBitmap(Bitmap: TBitmap; RegionColor: TColor; + RegionBitmapMode: TJclRegionBitmapMode; UseAlphaChannel: Boolean): HRGN; +var + LBitmap: TBitmap; + X, Y, Width: Integer; + StartX: Integer; + Region: HRGN; + P: PBGRA; + Mask: TColor; +begin + Result := 0; + + if Bitmap = nil then + EJclGraphicsError.CreateRes(@RsNoBitmapForRegion); + + if (Bitmap.Width = 0) or (Bitmap.Height = 0) then + Exit; + + if UseAlphaChannel then + begin + Mask := TColor($FF000000); + // A region can represent only full transparent alpha values + RegionColor := 0; + end + else + begin + Mask := TColor($00FFFFFF); + RegionColor := ColorToRGB(RegionColor); + end; + + LBitmap := TBitmap.Create; + try + LBitmap.Assign(Bitmap); + LBitmap.PixelFormat := pf32bit; + + Width := LBitmap.Width; + for Y := 0 to LBitmap.Height - 1 do + begin + P := LBitmap.ScanLine[Y]; + X := 0; + while X < Width do + begin + if RegionBitmapMode = rmExclude then + begin + while (TColor(P^) and Mask) = RegionColor do + begin + Inc(X); + Inc(P); + if X = Width then + Break; + end; + end + else + begin + while (TColor(P^) and Mask) <> RegionColor do + begin + Inc(X); + Inc(P); + if X = Width then + Break; + end; + end; + + if X = Width then + Break; + + StartX := X; + if RegionBitmapMode = rmExclude then + begin + while (X < Width) and ((TColor(P^) and Mask) <> RegionColor) do + begin + Inc(X); + Inc(P); + end; + end + else + begin + while (X < Width) and ((TColor(P^) and Mask) = RegionColor) do + begin + Inc(X); + Inc(P); + end; + end; + + Region := CreateRectRgn(StartX, Y, X, Y + 1); + if Result = 0 then + Result := Region + else + begin + if Region <> 0 then + begin + CombineRgn(Result, Result, Region, RGN_OR); + DeleteObject(Region); + end; + end; + end; + end; + finally + LBitmap.Free; + end; +end; + +procedure ScreenShot(bm: TBitmap; Left, Top, Width, Height: Integer; Window: THandle); overload; +var + WinDC: HDC; + Pal: TMaxLogPalette; +begin + bm.Width := Width; + bm.Height := Height; + + // Get the HDC of the window... + WinDC := GetDC(Window); + if WinDC = 0 then + raise EJclGraphicsError.CreateRes(@RsNoDeviceContextForWindow); + try + // Palette-device? + if (GetDeviceCaps(WinDC, RASTERCAPS) and RC_PALETTE) = RC_PALETTE then + begin + ResetMemory(Pal, SizeOf(TMaxLogPalette)); // fill the structure with zeros + Pal.palVersion := $300; // fill in the palette version + + // grab the system palette entries... + Pal.palNumEntries := GetSystemPaletteEntries(WinDC, 0, 256, Pal.palPalEntry); + if Pal.PalNumEntries <> 0 then + bm.Palette := CreatePalette(PLogPalette(@Pal)^); + end; + + // copy from the screen to our bitmap... + BitBlt(bm.Canvas.Handle, 0, 0, Width, Height, WinDC, Left, Top, SRCCOPY); + finally + ReleaseDC(Window, WinDC); // finally, relase the DC of the window + end; +end; + +procedure ScreenShot(bm: TBitmap; IncludeTaskBar: Boolean = True); overload; +var + R: TRect; +begin + if IncludeTaskBar then + begin + R.Left := 0; + R.Top := 0; + R.Right := GetSystemMetrics(SM_CXSCREEN); + R.Bottom := GetSystemMetrics(SM_CYSCREEN); + end + else + SystemParametersInfo(SPI_GETWORKAREA, 0, @R, 0); + ScreenShot(bm, R.Left, R.Top, R.Right, R.Bottom, HWND_DESKTOP); +end; + +procedure ScreenShot(bm: TBitmap; FormToPrint: TCustomForm); overload; +begin + //Prints the entire forms area. + if FormToPrint <> nil then + ScreenShot(bm, FormToPrint.Left, FormToPrint.Top, FormToPrint.Width, FormToPrint.Height, FormToPrint.Handle) + else + raise EJclGraphicsError.CreateResFmt(@RSInvalidFormOrComponent, ['form']) +end; + +function MapWindowRect(hWndFrom, hWndTo: THandle; ARect:TRect):TRect; +begin + MapWindowPoints(hWndFrom, hWndTo, ARect, 2); + Result := ARect; +end; + +function FillGradient(DC: HDC; ARect: TRect; ColorCount: Integer; + StartColor, EndColor: TColor; ADirection: TGradientDirection): Boolean; +var + StartRGB: array [0..2] of Byte; + RGBKoef: array [0..2] of Double; + Brush: HBRUSH; + AreaWidth, AreaHeight, I: Integer; + ColorRect: TRect; + RectOffset: Double; +begin + RectOffset := 0; + Result := False; + if ColorCount < 1 then + Exit; + StartColor := ColorToRGB(StartColor); + EndColor := ColorToRGB(EndColor); + StartRGB[0] := GetRValue(StartColor); + StartRGB[1] := GetGValue(StartColor); + StartRGB[2] := GetBValue(StartColor); + RGBKoef[0] := (GetRValue(EndColor) - StartRGB[0]) / ColorCount; + RGBKoef[1] := (GetGValue(EndColor) - StartRGB[1]) / ColorCount; + RGBKoef[2] := (GetBValue(EndColor) - StartRGB[2]) / ColorCount; + AreaWidth := ARect.Right - ARect.Left; + AreaHeight := ARect.Bottom - ARect.Top; + case ADirection of + gdHorizontal: + RectOffset := AreaWidth / ColorCount; + gdVertical: + RectOffset := AreaHeight / ColorCount; + end; + for I := 0 to ColorCount - 1 do + begin + Brush := CreateSolidBrush(RGB( + StartRGB[0] + Round((I + 1) * RGBKoef[0]), + StartRGB[1] + Round((I + 1) * RGBKoef[1]), + StartRGB[2] + Round((I + 1) * RGBKoef[2]))); + case ADirection of + gdHorizontal: + SetRect(ColorRect, Round(RectOffset * I), 0, Round(RectOffset * (I + 1)), AreaHeight); + gdVertical: + SetRect(ColorRect, 0, Round(RectOffset * I), AreaWidth, Round(RectOffset * (I + 1))); + end; + OffsetRect(ColorRect, ARect.Left, ARect.Top); + FillRect(DC, ColorRect, Brush); + DeleteObject(Brush); + end; + Result := True; +end; + +//=== { TJclDesktopCanvas } ================================================== + +constructor TJclDesktopCanvas.Create; +begin + inherited Create; + FDesktop := GetDC(HWND_DESKTOP); + Handle := FDesktop; +end; + +destructor TJclDesktopCanvas.Destroy; +begin + Handle := 0; + ReleaseDC(HWND_DESKTOP, FDesktop); + inherited Destroy; +end; + +//=== { TJclRegionInfo } ===================================================== + +constructor TJclRegionInfo.Create(Region: TJclRegion); +begin + inherited Create; + if Region = nil then + raise EJclGraphicsError.CreateRes(@RsInvalidRegion); + FData := nil; + FDataSize := GetRegionData(Region.Handle, 0, nil); + GetMem(FData, FDataSize); + GetRegionData(Region.Handle, FDataSize, FData); +end; + +destructor TJclRegionInfo.Destroy; +begin + if FData <> nil then + FreeMem(FData); + inherited Destroy; +end; + +function TJclRegionInfo.GetBox: TRect; +begin + Result := RectAssign(TRgnData(FData^).rdh.rcBound.Left, TRgnData(FData^).rdh.rcBound.Top, + TRgnData(FData^).rdh.rcBound.Right, TRgnData(FData^).rdh.rcBound.Bottom); +end; + +function TJclRegionInfo.GetCount: Integer; +begin + Result := TRgnData(FData^).rdh.nCount; +end; + +function TJclRegionInfo.GetRect(Index: Integer): TRect; +var + RectP: PRect; +begin + if (Index < 0) or (DWORD(Index) >= TRgnData(FData^).rdh.nCount) then + raise EJclGraphicsError.CreateRes(@RsRegionDataOutOfBound); + RectP := PRect(PAnsiChar(@TRgnData(FData^).Buffer) + (SizeOf(TRect)*Index)); + Result := RectAssign(RectP^.Left, RectP.Top, RectP^.Right, RectP^.Bottom); +end; + +//=== { TJclRegion } ========================================================= + +constructor TJclRegion.Create(RegionHandle: HRGN; OwnsHandle: Boolean = True); +begin + inherited Create; + FHandle := RegionHandle; + FOwnsHandle := OwnsHandle; + CheckHandle; + GetBox; +end; + +constructor TJclRegion.CreateBitmap(Bitmap: TBitmap; RegionColor: TColor; + RegionBitmapMode: TJclRegionBitmapMode); +begin + Create(CreateRegionFromBitmap(Bitmap, RegionColor, RegionBitmapMode), True); +end; + +constructor TJclRegion.CreateElliptic(const ARect: TRect); +begin + Create(CreateEllipticRgnIndirect(ARect), True); +end; + +constructor TJclRegion.CreateElliptic(const Top, Left, Bottom, Right: Integer); +begin + Create(CreateEllipticRgn(Top, Left, Bottom, Right), True); +end; + +constructor TJclRegion.CreatePoly(const Points: TDynPointArray; Count: Integer; + FillMode: TPolyFillMode); +begin + case FillMode of + fmAlternate: + Create(CreatePolygonRgn(Points[0], Count, ALTERNATE), True); + fmWinding: + Create(CreatePolygonRgn(Points[0], Count, WINDING), True); + end; +end; + +constructor TJclRegion.CreatePolyPolygon(const Points: TDynPointArray; + const Vertex: TDynIntegerArray; Count: Integer; FillMode: TPolyFillMode); +begin + case FillMode of + fmAlternate: + Create(CreatePolyPolygonRgn(Points[0], Vertex[0], Count, ALTERNATE), True); + fmWinding: + Create(CreatePolyPolygonRgn(Points[0], Vertex[0], Count, WINDING), True); + end; +end; + +constructor TJclRegion.CreateRect(const ARect: TRect; DummyForBCB: Boolean = False); +begin + Create(CreateRectRgnIndirect(ARect), True); +end; + +constructor TJclRegion.CreateRect(const Top, Left, Bottom, Right: Integer; DummyForBCB: Byte = 0); +begin + Create(CreateRectRgn(Top, Left, Bottom, Right), True); +end; + +constructor TJclRegion.CreateRoundRect(const ARect: TRect; CornerWidth, + CornerHeight: Integer); +begin + Create(CreateRoundRectRgn(ARect.Top, ARect.Left, ARect.Bottom, ARect.Right, + CornerWidth, CornerHeight), True); +end; + +constructor TJclRegion.CreateRoundRect(const Top, Left, Bottom, Right, CornerWidth, + CornerHeight: Integer); +begin + Create(CreateRoundRectRgn(Top, Left, Bottom, Right, CornerWidth, CornerHeight), True); +end; + +constructor TJclRegion.CreatePath(Canvas: TCanvas); +begin + Create(PathToRegion(Canvas.Handle), True); +end; + +constructor TJclRegion.CreateRegionInfo(RegionInfo: TJclRegionInfo); +begin + if RegionInfo = nil then + raise EJclGraphicsError.CreateRes(@RsInvalidRegionInfo); + Create(ExtCreateRegion(nil,RegionInfo.FDataSize,TRgnData(RegionInfo.FData^)), True); +end; + +constructor TJclRegion.CreateMapWindow(InitialRegion: TJclRegion; hWndFrom, hWndTo: THandle); +var + RectRegion: HRGN; + CurrentRegionInfo : TJclRegionInfo; + SimpleRect: TRect; + Index:integer; +begin + Create(CreateRectRgn(0, 0, 0, 0), True); + if (hWndFrom <> 0) or (hWndTo <> 0 ) then + begin + CurrentRegionInfo := InitialRegion.GetRegionInfo; + try + for Index := 0 to CurrentRegionInfo.Count-1 do + begin + SimpleRect := CurrentRegionInfo.Rectangles[Index]; + SimpleRect := MapWindowRect(hWndFrom,hWndTo,SimpleRect); + RectRegion := CreateRectRgnIndirect(SimpleRect); + if RectRegion <> 0 then + begin + CombineRgn(Handle, Handle, RectRegion, RGN_OR); + DeleteObject(RectRegion); + end; + end; + finally + CurrentRegionInfo.Free; + GetBox; + end; + end; +end; + +constructor TJclRegion.CreateMapWindow(InitialRegion: TJclRegion; + ControlFrom, ControlTo: TWinControl); +begin + CreateMapWindow(InitialRegion,ControlFrom.Handle,ControlTo.Handle); +end; + +destructor TJclRegion.Destroy; +begin + if FOwnsHandle and (FHandle <> 0) then + DeleteObject(FHandle); + inherited Destroy; +end; + +procedure TJclRegion.CheckHandle; +begin + if FHandle = 0 then + begin + if FOwnsHandle then + raise EJclGraphicsError.CreateRes(@RsRegionCouldNotCreated) + else + raise EJclGraphicsError.CreateRes(@RsInvalidHandleForRegion); + end; +end; + +procedure TJclRegion.Combine(DestRegion, SrcRegion: TJclRegion; + CombineOp: TJclRegionCombineOperator); +begin + case CombineOp of + coAnd: + FRegionType := CombineRgn(DestRegion.Handle, SrcRegion.Handle, FHandle, RGN_AND); + coOr: + FRegionType := CombineRgn(DestRegion.Handle, SrcRegion.Handle, FHandle, RGN_OR); + coDiff: + FRegionType := CombineRgn(DestRegion.Handle, SrcRegion.Handle, FHandle, RGN_DIFF); + coXor: + FRegionType := CombineRgn(DestRegion.Handle, SrcRegion.Handle, FHandle, RGN_XOR); + end; +end; + +procedure TJclRegion.Combine(SrcRegion: TJclRegion; CombineOp: TJclRegionCombineOperator); +begin + case CombineOp of + coAnd: + FRegionType := CombineRgn(FHandle, SrcRegion.Handle, FHandle, RGN_AND); + coOr: + FRegionType := CombineRgn(FHandle, SrcRegion.Handle, FHandle, RGN_OR); + coDiff: + FRegionType := CombineRgn(FHandle, SrcRegion.Handle, FHandle, RGN_DIFF); + coXor: + FRegionType := CombineRgn(FHandle, SrcRegion.Handle, FHandle, RGN_XOR); + end; +end; + +procedure TJclRegion.Clip(Canvas: TCanvas); +begin + FRegionType := SelectClipRgn(Canvas.Handle, FHandle); +end; + +function TJclRegion.Equals(CompareRegion: TJclRegion): Boolean; +begin + Result := EqualRgn(CompareRegion.Handle, FHandle); +end; + +function TJclRegion.GetHandle: HRGN; +begin + Result := FHandle; +end; + +procedure TJclRegion.Fill(Canvas: TCanvas); +begin + FillRgn(Canvas.Handle, FHandle, Canvas.Brush.Handle); +end; + +procedure TJclRegion.FillGradient(Canvas: TCanvas; ColorCount: Integer; + StartColor, EndColor: TColor; ADirection: TGradientDirection); +var + DC: integer; +begin + DC := SaveDC(Canvas.Handle); + try + SelectClipRgn(Canvas.Handle,FHandle); + JclGraphics.FillGradient(Canvas.Handle, Box, ColorCount, StartColor, EndColor, ADirection); + finally + RestoreDC(Canvas.Handle, DC); + end; +end; + +procedure TJclRegion.Frame(Canvas: TCanvas; FrameWidth, FrameHeight: Integer); +begin + FrameRgn(Canvas.Handle, FHandle, Canvas.Brush.Handle, FrameWidth, FrameHeight); +end; + +function TJclRegion.GetBox: TRect; +begin + FRegionType := GetRgnBox(FHandle, FBoxRect); + Result := FBoxRect; +end; + +function TJclRegion.GetRegionType: TJclRegionKind; +begin + case FRegionType of + NULLREGION: + Result := rkNull; + SIMPLEREGION: + Result := rkSimple; + COMPLEXREGION: + Result := rkComplex; + else + Result := rkError; + end; +end; + +procedure TJclRegion.Invert(Canvas: TCanvas); +begin + InvertRgn(Canvas.Handle, FHandle); +end; + +procedure TJclRegion.Offset(X, Y: Integer); +begin + FRegionType := OffsetRgn(FHandle, X, Y); +end; + +procedure TJclRegion.Paint(Canvas: TCanvas); +begin + PaintRgn(Canvas.Handle, FHandle); +end; + +function TJclRegion.PointIn(X, Y: Integer): Boolean; +begin + Result := PtInRegion(FHandle, X, Y); +end; + +function TJclRegion.PointIn(const Point: TPoint): Boolean; +begin + Result := PtInRegion(FHandle, Point.X, Point.Y); +end; + +function TJclRegion.RectIn(const ARect: TRect): Boolean; +begin + Result := RectInRegion(FHandle, ARect); +end; + +function TJclRegion.RectIn(Top, Left, Bottom, Right: Integer): Boolean; +begin + Result := RectInRegion(FHandle, RectAssign(Left, Top, Right, Bottom)); +end; + +{ Documentation Info (from MSDN): After a successful call to SetWindowRgn, the system owns + the region specified by the region handle hRgn. The system does + not make a copy of the region. Thus, you should not make any + further function calls with this region handle. In particular, + do not delete this region handle. The system deletes the region + handle when it no longer needed. } + +procedure TJclRegion.SetWindow(Window: THandle; Redraw: Boolean); +begin + if SetWindowRgn(Window, FHandle, Redraw) <> 0 then + FOwnsHandle := False; // Make sure that we do not release the Handle. If we didn't own it before + // please take care that the owner doesn't release it. +end; + +function TJclRegion.Copy: TJclRegion; +begin + Result := TJclRegion.CreateRect(0, 0, 0, 0, 0); // (rom) call correct overloaded constructor for BCB + CombineRgn(Result.Handle, FHandle, 0, RGN_COPY); + Result.GetBox; +end; + +function TJclRegion.GetRegionInfo: TJclRegionInfo; +begin + Result := TJclRegionInfo.Create(Self); +end; + +//=== { TJclThreadPersistent } =============================================== + +constructor TJclThreadPersistent.Create; +begin + inherited Create; + InitializeCriticalSection(FLock); + +end; + +destructor TJclThreadPersistent.Destroy; +begin + DeleteCriticalSection(FLock); + + inherited Destroy; +end; + +procedure TJclThreadPersistent.BeginUpdate; +begin + Inc(FUpdateCount); +end; + +procedure TJclThreadPersistent.Changing; +begin + if (FUpdateCount = 0) and Assigned(FOnChanging) then + FOnChanging(Self); +end; + +procedure TJclThreadPersistent.Changed; +begin + if (FUpdateCount = 0) and Assigned(FOnChange) then + FOnChange(Self); +end; + +procedure TJclThreadPersistent.EndUpdate; +begin + Assert(FUpdateCount > 0, LoadResString(@RsAssertUnpairedEndUpdate)); + Dec(FUpdateCount); +end; + +procedure TJclThreadPersistent.Lock; +begin + InterlockedIncrement(FLockCount); + EnterCriticalSection(FLock); + +end; + +procedure TJclThreadPersistent.Unlock; +begin + LeaveCriticalSection(FLock); + + InterlockedDecrement(FLockCount); +end; + +//=== { TJclCustomMap } ====================================================== + +procedure TJclCustomMap.Delete; +begin + SetSize(0, 0); +end; + +function TJclCustomMap.Empty: Boolean; +begin + Result := (Width = 0) or (Height = 0); +end; + +procedure TJclCustomMap.SetHeight(NewHeight: Integer); +begin + SetSize(Width, NewHeight); +end; + +procedure TJclCustomMap.SetSize(NewWidth, NewHeight: Integer); +begin + FWidth := NewWidth; + FHeight := NewHeight; +end; + +procedure TJclCustomMap.SetSize(Source: TPersistent); +var + WidthInfo, HeightInfo: PPropInfo; +begin + if Source is TJclCustomMap then + SetSize(TJclCustomMap(Source).Width, TJclCustomMap(Source).Height) + else + if Source is TGraphic then + SetSize(TGraphic(Source).Width, TGraphic(Source).Height) + else + if Source = nil then + SetSize(0, 0) + else + begin + WidthInfo := GetPropInfo(Source, 'Width', [tkInteger]); + HeightInfo := GetPropInfo(Source, 'Height', [tkInteger]); + if Assigned(WidthInfo) and Assigned(HeightInfo) then + SetSize(GetOrdProp(Source, WidthInfo), GetOrdProp(Source, HeightInfo)) + else + raise EJclGraphicsError.CreateResFmt(@RsMapSizeFmt,[Source.ClassName]); + end; +end; + +procedure TJclCustomMap.SetWidth(NewWidth: Integer); +begin + SetSize(NewWidth, Height); +end; + +//=== { TJclBitmap32 } ======================================================= + +constructor TJclBitmap32.Create; +begin + inherited Create; + + FResetAlphaOnAssign := True; + + ResetMemory(FBitmapInfo, SizeOf(TBitmapInfo)); + with FBitmapInfo.bmiHeader do + begin + biSize := SizeOf(TBitmapInfoHeader); + biPlanes := 1; + biBitCount := 32; + biCompression := BI_RGB; + end; + FOuterColor := $00000000; // by default as full transparency black + FFont := TFont.Create; + FFont.OnChange := FontChanged; + FFont.OwnerCriticalSection := @FLock; + FMasterAlpha := $FF; + FPenColor := clWhite32; + FStippleStep := 1; +end; + +destructor TJclBitmap32.Destroy; +begin + Lock; + try + FFont.Free; + SetSize(0, 0); + finally + Unlock; + end; + inherited Destroy; +end; + +procedure TJclBitmap32.SetSize(NewWidth, NewHeight: Integer); +begin + if NewWidth <= 0 then + NewWidth := 0; + if NewHeight <= 0 then + NewHeight := 0; + if (NewWidth = Width) and (NewHeight = Height) then + Exit; + + Changing; + + try + if FHDC <> 0 then + DeleteDC(FHDC); + if FHandle <> 0 then + DeleteObject(FHandle); + FBits := nil; + FWidth := 0; + FHeight := 0; + if (NewWidth > 0) and (NewHeight > 0) then + begin + with FBitmapInfo.bmiHeader do + begin + biWidth := NewWidth; + biHeight := -NewHeight; + end; + FHandle := CreateDIBSection(0, FBitmapInfo, DIB_RGB_COLORS, Pointer(FBits), 0, 0); + if FBits = nil then + raise EJclGraphicsError.CreateRes(@RsDibHandleAllocation); + + FHDC := CreateCompatibleDC(0); + if FHDC = 0 then + begin + DeleteObject(FHandle); + FHandle := 0; + FBits := nil; + raise EJclGraphicsError.CreateRes(@RsCreateCompatibleDc); + end; + + if SelectObject(FHDC, FHandle) = 0 then + begin + DeleteDC(FHDC); + DeleteObject(FHandle); + FHDC := 0; + FHandle := 0; + FBits := nil; + raise EJclGraphicsError.CreateRes(@RsSelectObjectInDc); + end; + + FWidth := NewWidth; + FHeight := NewHeight; + end; + + finally + Changed; + end; +end; + +function TJclBitmap32.Empty: Boolean; +begin + Result := (FHandle = 0); +end; + +procedure TJclBitmap32.Clear; +begin + Clear(clBlack32); +end; + +procedure TJclBitmap32.Clear(FillColor: TColor32); +begin + if Empty then + Exit; + Changing; + FillLongword(Bits[0], Width * Height, FillColor); + Changed; +end; + +procedure TJclBitmap32.Delete; +begin + Changing; + SetSize(0, 0); + Changed; +end; + +procedure TJclBitmap32.Assign(Source: TPersistent); +var + Canvas: TCanvas; + Picture: TPicture; + + procedure AssignFromBitmap(SrcBmp: TBitmap); + begin + SetSize(SrcBmp.Width, SrcBmp.Height); + if Empty then + Exit; + BitBlt(Handle, 0, 0, Width, Height, SrcBmp.Canvas.Handle, 0, 0, SRCCOPY); + if ResetAlphaOnAssign then + ResetAlpha; + end; + +begin + Changing; + BeginUpdate; + try + if Source = nil then + begin + SetSize(0, 0); + Exit; + end + else + if Source is TJclBitmap32 then + begin + SetSize(TJclBitmap32(Source).Width, TJclBitmap32(Source).Height); + Move(TJclBitmap32(Source).Bits[0], Bits[0], Width * Height * 4); + Exit; + end + else + if Source is TBitmap then + begin + AssignFromBitmap(TBitmap(Source)); + Exit; + end + else + if Source is TPicture then + begin + with TPicture(Source) do + begin + if TPicture(Source).Graphic is TBitmap then + AssignFromBitmap(TBitmap(TPicture(Source).Graphic)) + else + begin + // icons, metafiles etc... + SetSize(TPicture(Source).Graphic.Width, TPicture(Source).Graphic.Height); + if Empty then + Exit; + Canvas := TCanvas.Create; + try + Canvas.Handle := Self.Handle; + TJclGraphicAccess(Graphic).Draw(Canvas, Rect(0, 0, Width, Height)); + if ResetAlphaOnAssign then + ResetAlpha; + finally + Canvas.Free; + end; + end; + end; + Exit; + end + else + if Source is TClipboard then + begin + Picture := TPicture.Create; + try + Picture.Assign(TClipboard(Source)); + SetSize(Picture.Width, Picture.Height); + if Empty then + Exit; + Canvas := TCanvas.Create; + try + Canvas.Handle := Self.Handle; + TJclGraphicAccess(Picture.Graphic).Draw(Canvas, Rect(0, 0, Width, Height)); + if ResetAlphaOnAssign then + ResetAlpha; + finally + Canvas.Free; + end; + finally + Picture.Free; + end; + Exit; + end + else + inherited Assign(Source); // default handler + finally; + EndUpdate; + Changed; + end; +end; + +procedure TJclBitmap32.AssignTo(Dst: TPersistent); +var + Bmp: TBitmap; +begin + if Dst is TPicture then + begin + Bmp := TPicture(Dst).Bitmap; + Bmp.HandleType := bmDIB; + Bmp.PixelFormat := pf32bit; + Bmp.Width := Width; + Bmp.Height := Height; + DrawTo(Bmp.Canvas.Handle, 0, 0); + end + else + if Dst is TBitmap then + begin + Bmp := TBitmap(Dst); + Bmp.HandleType := bmDIB; + Bmp.PixelFormat := pf32bit; + Bmp.Width := Width; + Bmp.Height := Height; + DrawTo(Bmp.Canvas.Handle, 0, 0); + end + else + if Dst is TClipboard then + begin + Bmp := TBitmap.Create; + try + Bmp.HandleType := bmDIB; + Bmp.PixelFormat := pf32bit; + Bmp.Width := Width; + Bmp.Height := Height; + DrawTo(Bmp.Canvas.Handle, 0, 0); + TClipboard(Dst).Assign(Bmp); + finally + Bmp.Free; + end; + end + else + inherited AssignTo(Dst); +end; + +procedure TJclBitmap32.SetPixel(X, Y: Integer; Value: TColor32); +begin + Bits[X + Y * Width] := Value; +end; + +procedure TJclBitmap32.SetPixelS(X, Y: Integer; Value: TColor32); +begin + if (X >= 0) and (X < Width) and (Y >= 0) and (Y < Height) then + Bits[X + Y * Width] := Value; +end; + +function TJclBitmap32.GetScanLine(Y: Integer): PColor32Array; +begin + Result := @Bits[Y * FWidth]; +end; + +function TJclBitmap32.GetPixel(X, Y: Integer): TColor32; +begin + Result := Bits[X + Y * Width]; +end; + +function TJclBitmap32.GetPixelS(X, Y: Integer): TColor32; +begin + if (X >= 0) and (X < Width) and (Y >= 0) and (Y < Height) then + Result := Bits[X + Y * Width] + else + Result := OuterColor; +end; + +function TJclBitmap32.GetPixelPtr(X, Y: Integer): PColor32; +begin + Result := @Bits[X + Y * Width]; +end; + +procedure TJclBitmap32.Draw(DstX, DstY: Integer; Src: TJclBitmap32); +begin + Changing; + if Src <> nil then + Src.DrawTo(Self, DstX, DstY); + Changed; +end; + +procedure TJclBitmap32.Draw(DstRect, SrcRect: TRect; Src: TJclBitmap32); +begin + Changing; + if Src <> nil then + Src.DrawTo(Self, DstRect, SrcRect); + Changed; +end; + +procedure TJclBitmap32.Draw(DstRect, SrcRect: TRect; hSrc: HDC); +begin + if Empty then + Exit; + Changing; + StretchBlt(Handle, DstRect.Left, DstRect.Top, DstRect.Right - DstRect.Left, + DstRect.Bottom - DstRect.Top, hSrc, SrcRect.Left, SrcRect.Top, + SrcRect.Right - SrcRect.Left, SrcRect.Bottom - SrcRect.Top, SRCCOPY); + Changed; +end; + +procedure TJclBitmap32.DrawTo(Dst: TJclBitmap32); +begin + if Empty or Dst.Empty then + Exit; + Dst.Changing; + BlockTransfer(Dst, 0, 0, Self, Rect(0, 0, Width, Height), DrawMode); + Dst.Changed; +end; + +procedure TJclBitmap32.DrawTo(Dst: TJclBitmap32; DstX, DstY: Integer); +begin + if Empty or Dst.Empty then + Exit; + Dst.Changing; + BlockTransfer(Dst, DstX, DstY, Self, Rect(0, 0, Width, Height), DrawMode); + Dst.Changed; +end; + +procedure TJclBitmap32.DrawTo(Dst: TJclBitmap32; DstRect: TRect); +begin + if Empty or Dst.Empty then + Exit; + Dst.Changing; + StretchTransfer(Dst, DstRect, Self, Rect(0, 0, Width, Height), StretchFilter, DrawMode); + Dst.Changed; +end; + +procedure TJclBitmap32.DrawTo(Dst: TJclBitmap32; DstRect, SrcRect: TRect); +begin + if Empty or Dst.Empty then + Exit; + Dst.Changing; + StretchTransfer(Dst, DstRect, Self, SrcRect, StretchFilter, DrawMode); + Dst.Changed; +end; + +procedure TJclBitmap32.DrawTo(hDst: HDC; DstX, DstY: Integer); +begin + if Empty then + Exit; + BitBlt(hDst, DstX, DstY, Width, Height, Handle, 0, 0, SRCCOPY); +end; + +procedure TJclBitmap32.DrawTo(hDst: HDC; DstRect, SrcRect: TRect); +begin + if Empty then + Exit; + StretchDIBits(hDst, + DstRect.Left, DstRect.Top, DstRect.Right - DstRect.Left, DstRect.Bottom - DstRect.Top, + SrcRect.Left, SrcRect.Top, SrcRect.Right - SrcRect.Left, SrcRect.Bottom - SrcRect.Top, + Bits, FBitmapInfo, DIB_RGB_COLORS, SRCCOPY); +end; + +procedure TJclBitmap32.ResetAlpha; +var + I: Integer; + P: PByte; +begin + Changing; + P := Pointer(FBits); + Inc(P, 3); + for I := 0 to Width * Height - 1 do + begin + P^ := $FF; + Inc(P, 4) + end; + Changed; +end; + +function TJclBitmap32.GetPixelB(X, Y: Integer): TColor32; +begin + // this function should never be used on empty bitmaps !!! + if X < 0 then + X := 0 + else + if X >= Width then + X := Width - 1; + if Y < 0 then + Y := 0 + else + if Y >= Height then + Y := Height - 1; + Result := Bits[X + Y * Width]; +end; + +procedure TJclBitmap32.SetPixelT(X, Y: Integer; Value: TColor32); +begin + BlendMem(Value, Bits[X + Y * Width]); +end; + +procedure TJclBitmap32.SetPixelT(var Ptr: PColor32; Value: TColor32); +begin + BlendMem(Value, Ptr^); + Inc(Ptr); +end; + +procedure TJclBitmap32.SetPixelTS(X, Y: Integer; Value: TColor32); +begin + if (X >= 0) and (X < Width) and (Y >= 0) and (Y < Width) then + BlendMem(Value, Bits[X + Y * Width]); +end; + +procedure TJclBitmap32.SET_T256(X, Y: Integer; C: TColor32); +var + flrx, flry, celx, cely: Longword; + P: PColor32; + A: TColor32; +begin + A := C shr 24; // opacity + + flrx := X and $FF; + flry := Y and $FF; + + X := Sar(X,8); + Y := Sar(Y,8); + + celx := A * GAMMA_TABLE[flrx xor 255]; + cely := GAMMA_TABLE[flry xor 255]; + flrx := A * GAMMA_TABLE[flrx]; + flry := GAMMA_TABLE[flry]; + + P := @FBits[X + Y * FWidth]; + + CombineMem(C, P^, celx * cely shr 16); + Inc(P); + CombineMem(C, P^, flrx * cely shr 16); + Inc(P, FWidth); + CombineMem(C, P^, flrx * flry shr 16); + Dec(P); + CombineMem(C, P^, celx * flry shr 16); +end; + +procedure TJclBitmap32.SET_TS256(X, Y: Integer; C: TColor32); +var + flrx, flry, celx, cely: Longword; + P: PColor32; + A: TColor32; +begin + if (X < -256) or (Y < -256) then + Exit; + + flrx := X and $FF; + flry := Y and $FF; + + X := Sar(X,8); + Y := Sar(Y,8); + + if (X >= FWidth) or (Y >= FHeight) then + Exit; + + A := C shr 24; // opacity + + celx := A * GAMMA_TABLE[flrx xor 255]; + cely := GAMMA_TABLE[flry xor 255]; + flrx := A * GAMMA_TABLE[flrx]; + flry := GAMMA_TABLE[flry]; + + P := @FBits[X + Y * FWidth]; + + if (X >= 0) and (Y >= 0) and (X < FWidth - 1) and (Height < FHeight - 1) then + begin + CombineMem(C, P^, celx * cely shr 16); + Inc(P); + CombineMem(C, P^, flrx * cely shr 16); + Inc(P, FWidth); + CombineMem(C, P^, flrx * flry shr 16); + Dec(P); + CombineMem(C, P^, celx * flry shr 16); + end + else + begin + if (X >= 0) and (Y >= 0) then + CombineMem(C, P^, celx * cely shr 16); + Inc(P); + if (X < FWidth - 1) and (Y >= 0) then + CombineMem(C, P^, flrx * cely shr 16); + Inc(P, FWidth); + if (X < FWidth - 1) and (Y < FHeight - 1) then + CombineMem(C, P^, flrx * flry shr 16); + Dec(P); + if (X >= 0) and (Y < FHeight - 1) then + CombineMem(C, P^, celx * flry shr 16); + end; +end; + +procedure TJclBitmap32.SetPixelF(X, Y: Single; Value: TColor32); +begin + SET_T256(Round(X * 256), Round(Y * 256), Value); +end; + +procedure TJclBitmap32.SetPixelFS(X, Y: Single; Value: TColor32); +begin + SET_TS256(Round(X * 256), Round(Y * 256), Value); +end; + +procedure TJclBitmap32.SetStipple(NewStipple: TArrayOfColor32); +begin + FStippleCounter := 0; + FStipplePattern := Copy(NewStipple, 0, Length(NewStipple)); +end; + +procedure TJclBitmap32.SetStipple(NewStipple: array of TColor32); +var + L: Integer; +begin + FStippleCounter := 0; + L := High(NewStipple) - Low(NewStipple) + 1; + SetLength(FStipplePattern, L); + Move(NewStipple[Low(NewStipple)], FStipplePattern[0], L * SizeOf(TColor32)); +end; + +function TJclBitmap32.GetStippleColor: TColor32; +var + L: Integer; + NextIndex, PrevIndex: Integer; + PrevWeight: Integer; +begin + L := Length(FStipplePattern); + if L = 0 then + begin + // no pattern defined, just return something and exit + Result := clBlack32; + Exit; + end; + while FStippleCounter >= L do + FStippleCounter := FStippleCounter - L; + while FStippleCounter < 0 do + FStippleCounter := FStippleCounter + L; + PrevIndex := Round(FStippleCounter - 0.5); + PrevWeight := 255 - Round(255 * (FStippleCounter - PrevIndex)); + if PrevIndex < 0 then + FStippleCounter := L - 1; + NextIndex := PrevIndex + 1; + if NextIndex >= L then + NextIndex := 0; + if PrevWeight = 255 then + Result := FStipplePattern[PrevIndex] + else + begin + Result := CombineReg( + FStipplePattern[PrevIndex], + FStipplePattern[NextIndex], + PrevWeight); + end; + FStippleCounter := FStippleCounter + FStippleStep; +end; + +procedure TJclBitmap32.SetStippleStep(Value: Single); +begin + FStippleStep := Value; +end; + +procedure TJclBitmap32.ResetStippleCounter; +begin + FStippleCounter := 0; +end; + +procedure TJclBitmap32.DrawHorzLine(X1, Y, X2: Integer; Value: TColor32); +begin + FillLongword(Bits[X1 + Y * Width], X2 - X1 + 1, Value); +end; + +procedure TJclBitmap32.DrawHorzLineS(X1, Y, X2: Integer; Value: TColor32); +begin + if (Y >= 0) and (Y < Height) and TestClip(X1, X2, Width) then + DrawHorzLine(X1, Y, X2, Value); +end; + +procedure TJclBitmap32.DrawHorzLineT(X1, Y, X2: Integer; Value: TColor32); +var + I: Integer; + P: PColor32; +begin + if X2 < X1 then + Exit; + P := PixelPtr[X1, Y]; + for I := X1 to X2 do + begin + BlendMem(Value, P^); + Inc(P); + end; +end; + +procedure TJclBitmap32.DrawHorzLineTS(X1, Y, X2: Integer; Value: TColor32); +begin + if (Y >= 0) and (Y < Height) and TestClip(X1, X2, Width) then + DrawHorzLineT(X1, Y, X2, Value); +end; + +procedure TJclBitmap32.DrawHorzLineTSP(X1, Y, X2: Integer); +var + I: Integer; +begin + if Empty then + Exit; + if (Y >= 0) and (Y < Height) then + begin + if ((X1 < 0) and (X2 < 0)) or ((X1 >= Width) and (X2 >= Width)) then + Exit; + if X1 < 0 then + X1 := 0 + else + if X1 >= Width then + X1 := Width - 1; + if X2 < 0 then + X2 := 0 + else + if X2 >= Width then + X2 := Width - 1; + + if X2 >= X1 then + for I := X1 to X2 do + SetPixelT(I, Y, GetStippleColor) + else + for I := X2 downto X1 do + SetPixelT(I, Y, GetStippleColor); + end; +end; + +procedure TJclBitmap32.DrawVertLine(X, Y1, Y2: Integer; Value: TColor32); +var + I: Integer; + P: PColor32; +begin + if Y2 < Y1 then + Exit; + P := PixelPtr[X, Y1]; + for I := 0 to Y2 - Y1 do + begin + P^ := Value; + Inc(P, Width); + end; +end; + +procedure TJclBitmap32.DrawVertLineS(X, Y1, Y2: Integer; Value: TColor32); +begin + if (X >= 0) and (X < Width) and TestClip(Y1, Y2, Height) then + DrawVertLine(X, Y1, Y2, Value); +end; + +procedure TJclBitmap32.DrawVertLineT(X, Y1, Y2: Integer; Value: TColor32); +var + I: Integer; + P: PColor32; +begin + P := PixelPtr[X, Y1]; + for I := Y1 to Y2 do + begin + BlendMem(Value, P^); + Inc(P, Width); + end; +end; + +procedure TJclBitmap32.DrawVertLineTS(X, Y1, Y2: Integer; Value: TColor32); +begin + if (X >= 0) and (X < Width) and TestClip(Y1, Y2, Height) then + DrawVertLineT(X, Y1, Y2, Value); +end; + +procedure TJclBitmap32.DrawVertLineTSP(X, Y1, Y2: Integer); +var + I: Integer; +begin + if Empty then + Exit; + if (X >= 0) and (X < Width) then + begin + if ((Y1 < 0) and (Y2 < 0)) or ((Y1 >= Height) and (Y2 >= Height)) then + Exit; + if Y1 < 0 then + Y1 := 0 + else + if Y1 >= Height then + Y1 := Height - 1; + if Y2 < 0 then + Y2 := 0 + else + if Y2 >= Height then + Y2 := Height - 1; + + if Y2 >= Y1 then + for I := Y1 to Y2 do + SetPixelT(X, I, GetStippleColor) + else + for I := Y2 downto Y1 do + SetPixelT(X, I, GetStippleColor); + end; +end; + +procedure TJclBitmap32.DrawLine(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean); +var + Dy, Dx, Sy, Sx, I, Delta: Integer; + P: PColor32; +begin + Changing; + + try + Dx := X2 - X1; + Dy := Y2 - Y1; + + if Dx > 0 then + Sx := 1 + else + if Dx < 0 then + begin + Dx := -Dx; + Sx := -1; + end + else // Dx = 0 + begin + if Dy > 0 then + DrawVertLine(X1, Y1, Y2 - 1, Value) + else + if Dy < 0 then + DrawVertLine(X1, Y2, Y1 - 1, Value); + if L then + Pixel[X2, Y2] := Value; + Exit; + end; + + if Dy > 0 then + Sy := 1 + else + if Dy < 0 then + begin + Dy := -Dy; + Sy := -1; + end + else // Dy = 0 + begin + if Dx > 0 then + DrawHorzLine(X1, Y1, X2 - 1, Value) + else + DrawHorzLine(X2, Y1, X1 - 1, Value); + if L then + Pixel[X2, Y2] := Value; + Exit; + end; + + P := PixelPtr[X1, Y1]; + Sy := Sy * Width; + + if Dx > Dy then + begin + Delta := Dx shr 1; + for I := 0 to Dx - 1 do + begin + P^ := Value; + Inc(P, Sx); + Delta := Delta + Dy; + if Delta > Dx then + begin + Inc(P, Sy); + Delta := Delta - Dx; + end; + end; + end + else // Dx < Dy + begin + Delta := Dy shr 1; + for I := 0 to Dy - 1 do + begin + P^ := Value; + Inc(P, Sy); + Delta := Delta + Dx; + if Delta > Dy then + begin + Inc(P, Sx); + Delta := Delta - Dy; + end; + end; + end; + if L then + P^ := Value; + finally + Changed; + end; +end; + +function TJclBitmap32.ClipLine(var X0, Y0, X1, Y1: Integer): Boolean; +type + TEdge = (Left, Right, Top, Bottom); + TOutCode = set of TEdge; +var + Accept, AllDone: Boolean; + OutCode0, OutCode1, OutCodeOut: TOutCode; + X, Y: Integer; + + procedure CompOutCode(X, Y: Integer; var Code: TOutCode); + begin + Code := []; + if X < 0 then + Code := Code + [Left]; + if X >= Width then + Code := Code + [Right]; + if Y < 0 then + Code := Code + [Top]; + if Y >= Height then + Code := Code + [Bottom]; + end; + +begin + Accept := False; + AllDone := False; + CompOutCode(X0, Y0, OutCode0); + CompOutCode(X1, Y1, OutCode1); + repeat + if (OutCode0 = []) and (OutCode1 = []) then // trivial accept and exit + begin + Accept := True; + AllDone := True; + end + else + if (OutCode0 * OutCode1) <> [] then + AllDone := True // trivial reject + else // calculate intersections + begin + if OutCode0 <> [] then + OutCodeOut := OutCode0 + else + OutCodeOut := OutCode1; + X := 0; + Y := 0; + if Left in OutCodeOut then + Y := Y0 + (Y1 - Y0) * (-X0) div (X1 - X0) + else + if Right in OutCodeOut then + begin + Y := Y0 + (Y1 - Y0) * (Width - 1 - X0) div (X1 - X0); + X := Width - 1; + end + else + if Top in OutCodeOut then + X := X0 + (X1 - X0) * (-Y0) div (Y1 - Y0) + else + if Bottom in OutCodeOut then + begin + X := X0 + (X1 - X0) * (Height - 1 - Y0) div (Y1 - Y0); + Y := Height - 1; + end; + if OutCodeOut = OutCode0 then + begin + X0 := X; + Y0 := Y; + CompOutCode(X0, Y0, OutCode0); + end + else + begin + X1 := X; + Y1 := Y; + CompOutCode(X1, Y1, OutCode1); + end; + end; + until AllDone; + Result := Accept; +end; + +class function TJclBitmap32.ClipLineF(var X0, Y0, X1, Y1: Single; + MinX, MaxX, MinY, MaxY: Single): Boolean; +type + TEdge = (Left, Right, Top, Bottom); + TOutCode = set of TEdge; +var + Accept, AllDone: Boolean; + OutCode0, OutCode1, OutCodeOut: TOutCode; + X, Y: Single; + + procedure CompOutCode(X, Y: Single; var Code: TOutCode); + begin + Code := []; + if X < MinX then + Code := Code + [Left]; + if X > MaxX then + Code := Code + [Right]; + if Y < MinY then + Code := Code + [Top]; + if Y > MaxY then + Code := Code + [Bottom]; + end; + +begin + Accept := False; + AllDone := False; + CompOutCode(X0, Y0, OutCode0); + CompOutCode(X1, Y1, OutCode1); + repeat + if (OutCode0 = []) and (OutCode1 = []) then // trivial accept and exit + begin + Accept := True; + AllDone := True; + end + else + if (OutCode0 * OutCode1) <> [] then + AllDone := True // trivial reject + else // calculate intersections + begin + if OutCode0 <> [] then + OutCodeOut := OutCode0 + else + OutCodeOut := OutCode1; + X := 0; + Y := 0; + if Left in OutCodeOut then + begin + Y := Y0 + (Y1 - Y0) * (MinX - X0) / (X1 - X0); + X := MinX; + end + else + if Right in OutCodeOut then + begin + Y := Y0 + (Y1 - Y0) * (MaxX - X0) / (X1 - X0); + X := MaxX - 1; + end + else + if Top in OutCodeOut then + begin + X := X0 + (X1 - X0) * (MinY - Y0) / (Y1 - Y0); + Y := MinY; + end + else + if Bottom in OutCodeOut then + begin + X := X0 + (X1 - X0) * (MaxY - Y0) / (Y1 - Y0); + Y := MaxY; + end; + if OutCodeOut = OutCode0 then + begin + X0 := X; + Y0 := Y; + CompOutCode(X0, Y0, OutCode0); + end + else + begin + X1 := X; + Y1 := Y; + CompOutCode(X1, Y1, OutCode1); + end; + end; + until AllDone; + Result := Accept; +end; + +procedure TJclBitmap32.DrawLineS(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean); +begin + if ClipLine(X1, Y1, X2, Y2) then + DrawLine(X1, Y1, X2, Y2, Value, L); +end; + +procedure TJclBitmap32.DrawLineT(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean); +var + Dy, Dx, Sy, Sx, I, Delta: Integer; + P: PColor32; +begin + Changing; + try + Dx := X2 - X1; + Dy := Y2 - Y1; + + if Dx > 0 then + Sx := 1 + else + if Dx < 0 then + begin + Dx := -Dx; + Sx := -1; + end + else // Dx = 0 + begin + if Dy > 0 then + DrawVertLineT(X1, Y1, Y2 - 1, Value) + else + if Dy < 0 then + DrawVertLineT(X1, Y2, Y1 - 1, Value); + if L then + SetPixelT(X2, Y2, Value); + Exit; + end; + + if Dy > 0 then + Sy := 1 + else + if Dy < 0 then + begin + Dy := -Dy; + Sy := -1; + end + else // Dy = 0 + begin + if Dx > 0 then + DrawHorzLineT(X1, Y1, X2 - 1, Value) + else + DrawHorzLineT(X2, Y1, X1 - 1, Value); + if L then + SetPixelT(X2, Y2, Value); + Exit; + end; + + P := PixelPtr[X1, Y1]; + Sy := Sy * Width; + + if Dx > Dy then + begin + Delta := Dx shr 1; + for I := 0 to Dx - 1 do + begin + BlendMem(Value, P^); + Inc(P, Sx); + Delta := Delta + Dy; + if Delta > Dx then + begin + Inc(P, Sy); + Delta := Delta - Dx; + end; + end; + end + else // Dx < Dy + begin + Delta := Dy shr 1; + for I := 0 to Dy - 1 do + begin + BlendMem(Value, P^); + Inc(P, Sy); + Delta := Delta + Dx; + if Delta > Dy then + begin + Inc(P, Sx); + Delta := Delta - Dy; + end; + end; + end; + if L then + BlendMem(Value, P^); + finally + Changed; + end; +end; + +procedure TJclBitmap32.DrawLineTS(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean); +begin + if ClipLine(X1, Y1, X2, Y2) then + DrawLineT(X1, Y1, X2, Y2, Value, L); +end; + +procedure TJclBitmap32.DrawLineF(X1, Y1, X2, Y2: Single; Value: TColor32; L: Boolean); +var + N, I: Integer; + px, py, ex, ey, nx, ny, hyp: Integer; + A: TColor32; +begin + Changing; + try + px := Round(x1 * 65536); + py := Round(y1 * 65536); + ex := Round(x2 * 65536); + ey := Round(y2 * 65536); + nx := ex - px; + ny := ey - py; + hyp := Round(Hypot(nx, ny)); + if L then + Inc(hyp, 65536); + if hyp < 256 then + Exit; + N := hyp shr 16; + if N > 0 then + begin + nx := Round(nx / hyp * 65536); + ny := Round(ny / hyp * 65536); + for I := 0 to N - 1 do + begin + SET_T256(px shr 8, py shr 8, Value); + px := px + nx; + py := py + ny; + end; + end; + A := Value shr 24; + hyp := hyp - N shl 16; + A := A * Longword(hyp) shl 8 and $FF000000; + SET_T256((px + ex - nx) shr 9, (py + ey - ny) shr 9, Value and _RGB + A); + finally + Changed; + end; +end; + +procedure TJclBitmap32.DrawLineFS(X1, Y1, X2, Y2: Single; Value: TColor32; L: Boolean); +var + N, I: Integer; + px, py, ex, ey, nx, ny, hyp: Integer; + A: TColor32; +begin + if ClipLineF(X1, Y1, X2, Y2, 0, FWidth, 0, FHeight) then + if (X1 < FWidth - 1) and (X2 < FWidth - 1) and + (Y1 < FHeight - 1) and (Y2 < FHeight - 1) then + DrawLineF(X1, Y1, X2, Y2, Value, False) + else // check every pixel + begin + Changing; + try + px := Round(x1 * 65536); + py := Round(y1 * 65536); + ex := Round(x2 * 65536); + ey := Round(y2 * 65536); + nx := ex - px; + ny := ey - py; + hyp := Round(Hypot(nx, ny)); + if L then + Inc(Hyp, 65536); + if hyp < 256 then + Exit; + N := hyp shr 16; + if N > 0 then + begin + nx := Round(nx / hyp * 65536); + ny := Round(ny / hyp * 65536); + for I := 0 to N - 1 do + begin + SET_TS256(px div 256, py div 256, Value); + px := px + nx; + py := py + ny; + end; + end; + A := Value shr 24; + hyp := hyp - N shl 16; + A := A * Longword(hyp) shl 8 and $FF000000; + SET_TS256(Sar(px + ex - nx,9), Sar(py + ey - ny,9), Value and _RGB + A); + finally + Changed; + end; + end; +end; + +procedure TJclBitmap32.DrawLineFP(X1, Y1, X2, Y2: Single; L: Boolean); +var + N, I: Integer; + px, py, ex, ey, nx, ny, hyp: Integer; + A, C: TColor32; +begin + Changing; + try + px := Round(x1 * 65536); + py := Round(y1 * 65536); + ex := Round(x2 * 65536); + ey := Round(y2 * 65536); + nx := ex - px; + ny := ey - py; + hyp := Round(Hypot(nx, ny)); + if L then + Inc(hyp, 65536); + if hyp < 256 then + Exit; + N := hyp shr 16; + if N > 0 then + begin + nx := Round(nx / hyp * 65536); + ny := Round(ny / hyp * 65536); + for I := 0 to N - 1 do + begin + C := GetStippleColor; + SET_T256(px shr 8, py shr 8, C); + px := px + nx; + py := py + ny; + end; + end; + C := GetStippleColor; + A := C shr 24; + hyp := hyp - N shl 16; + A := A * Longword(hyp) shl 8 and $FF000000; + SET_T256((px + ex - nx) shr 9, (py + ey - ny) shr 9, C and _RGB + A); + finally + Changed; + end; +end; + +procedure TJclBitmap32.DrawLineFSP(X1, Y1, X2, Y2: Single; L: Boolean); +var + N, I: Integer; + px, py, ex, ey, nx, ny, hyp: Integer; + A, C: TColor32; +begin + if ClipLineF(X1, Y1, X2, Y2, 0, FWidth, 0, FHeight) then + if (X1 < FWidth - 1) and (X2 < FWidth - 1) and + (Y1 < FHeight - 1) and (Y2 < FHeight - 1) then + DrawLineFP(X1, Y1, X2, Y2, False) + else // check every pixel + begin + Changing; + try + px := Round(x1 * 65536); + py := Round(y1 * 65536); + ex := Round(x2 * 65536); + ey := Round(y2 * 65536); + nx := ex - px; + ny := ey - py; + hyp := Round(Hypot(nx, ny)); + if L then + Inc(hyp, 65536); + if hyp < 256 then + Exit; + N := hyp shr 16; + if N > 0 then + begin + nx := Round(nx / hyp * 65536); + ny := Round(ny / hyp * 65536); + for I := 0 to N - 1 do + begin + C := GetStippleColor; + SET_TS256(px div 256, py div 256, C); + px := px + nx; + py := py + ny; + end; + end; + C := GetStippleColor; + A := C shr 24; + hyp := hyp - N shl 16; + A := A * Longword(hyp) shl 8 and $FF000000; + SET_TS256(Sar(px + ex - nx,9), Sar(py + ey - ny,9), C and _RGB + A); + finally + Changed; + end; + end; +end; + +procedure TJclBitmap32.DrawLineA(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean); +var + Dx, Dy, Sx, Sy, D: Integer; + EC, EA: Word; + CI: Byte; + P: PColor32; +begin + if (X1 = X2) or (Y1 = Y2) then + begin + DrawLineT(X1, Y1, X2, Y2, Value, L); + Exit; + end; + + Dx := X2 - X1; + Dy := Y2 - Y1; + + if Dx > 0 then + Sx := 1 + else + begin + Sx := -1; + Dx := -Dx; + end; + + if Dy > 0 then + Sy := 1 + else + begin + Sy := -1; + Dy := -Dy; + end; + + Changing; + try + EC := 0; + BlendMem(Value, Bits[X1 + Y1 * Width]); + + if Dy > Dx then + begin + EA := Dx shl 16 div Dy; + if not L then + Dec(Dy); + while Dy > 0 do + begin + Dec(Dy); + D := EC; + Inc(EC, EA); + if EC <= D then + Inc(X1, Sx); + Inc(Y1, Sy); + CI := EC shr 8; + P := @Bits[X1 + Y1 * Width]; + BlendMemEx(Value, P^, GAMMA_TABLE[CI xor 255]); + Inc(P, Sx); + BlendMemEx(Value, P^, GAMMA_TABLE[CI]); + end; + end + else // DY <= DX + begin + EA := Dy shl 16 div Dx; + if not L then + Dec(Dx); + while Dx > 0 do + begin + Dec(Dx); + D := EC; + Inc(EC, EA); + if EC <= D then + Inc(Y1, Sy); + Inc(X1, Sx); + CI := EC shr 8; + P := @Bits[X1 + Y1 * Width]; + BlendMemEx(Value, P^, GAMMA_TABLE[CI xor 255]); + if Sy = 1 then + Inc(P, Width) + else + Dec(P, Width); + BlendMemEx(Value, P^, GAMMA_TABLE[CI]); + end; + end; + finally + Changed; + end; +end; + +procedure TJclBitmap32.DrawLineAS(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean); +begin + if ClipLine(X1, Y1, X2, Y2) then + DrawLineA(X1, Y1, X2, Y2, Value, L); +end; + +procedure TJclBitmap32.MoveTo(X, Y: Integer); +begin + RasterX := X; + RasterY := Y; +end; + +procedure TJclBitmap32.LineToS(X, Y: Integer); +begin + DrawLineS(RasterX, RasterY, X, Y, PenColor, False); + RasterX := X; + RasterY := Y; +end; + +procedure TJclBitmap32.LineToTS(X, Y: Integer); +begin + DrawLineTS(RasterX, RasterY, X, Y, PenColor, False); + RasterX := X; + RasterY := Y; +end; + +procedure TJclBitmap32.LineToAS(X, Y: Integer); +begin + DrawLineAS(RasterX, RasterY, X, Y, PenColor, False); + RasterX := X; + RasterY := Y; +end; + +procedure TJclBitmap32.MoveToF(X, Y: Single); +begin + RasterXF := X; + RasterYF := Y; +end; + +procedure TJclBitmap32.LineToFS(X, Y: Single); +begin + DrawLineFS(RasterXF, RasterYF, X, Y, PenColor, False); + RasterXF := X; + RasterYF := Y; +end; + +procedure TJclBitmap32.FillRect(X1, Y1, X2, Y2: Integer; Value: TColor32); +var + J: Integer; + P: PColor32Array; +begin + Changing; + for J := Y1 to Y2 do + begin + P := Pointer(GetScanLine(J)); + FillLongword(P[X1], X2 - X1 + 1, Value); + end; + Changed; +end; + +procedure TJclBitmap32.FillRectS(X1, Y1, X2, Y2: Integer; Value: TColor32); +begin + if TestClip(X1, X2, Width) and TestClip(Y1, Y2, Height) then + FillRect(X1, Y1, X2, Y2, Value); +end; + +procedure TJclBitmap32.FillRectT(X1, Y1, X2, Y2: Integer; Value: TColor32); +var + I, J: Integer; + P: PColor32; + A: Integer; +begin + A := Value shr 24; + if A = $FF then + FillRect(X1, Y1, X2, Y2, Value) + else + begin + Changing; + try + for J := Y1 to Y2 do + begin + P := GetPixelPtr(X1, J); + for I := X1 to X2 do + begin + CombineMem(Value, P^, A); + Inc(P); + end; + end; + finally + Changed; + end; + end; +end; + +procedure TJclBitmap32.FillRectTS(X1, Y1, X2, Y2: Integer; Value: TColor32); +begin + if TestClip(X1, X2, Width) and TestClip(Y1, Y2, Height) then + FillRectT(X1, Y1, X2, Y2, Value); +end; + +procedure TJclBitmap32.FrameRectS(X1, Y1, X2, Y2: Integer; Value: TColor32); +begin + Changing; + TestSwap(X1, X2); + TestSwap(Y1, Y2); + DrawHorzLineS(X1, Y1, X2, Value); + if Y2 > Y1 then + DrawHorzLineS(X1, Y2, X2, Value); + if Y2 > Y1 + 1 then + begin + DrawVertLineS(X1, Y1 + 1, Y2 - 1, Value); + if X2 > X1 then + DrawVertLineS(X2, Y1 + 1, Y2 - 1, Value); + end; + Changed; +end; + +procedure TJclBitmap32.FrameRectTS(X1, Y1, X2, Y2: Integer; Value: TColor32); +begin + Changing; + TestSwap(X1, X2); + TestSwap(Y1, Y2); + DrawHorzLineTS(X1, Y1, X2, Value); + if Y2 > Y1 then + DrawHorzLineTS(X1, Y2, X2, Value); + if Y2 > Y1 + 1 then + begin + DrawVertLineTS(X1, Y1 + 1, Y2 - 1, Value); + if X2 > X1 then + DrawVertLineTS(X2, Y1 + 1, Y2 - 1, Value); + end; + Changed; +end; + +procedure TJclBitmap32.FrameRectTSP(X1, Y1, X2, Y2: Integer); +begin + Changing; + TestSwap(X1, X2); + TestSwap(Y1, Y2); + DrawHorzLineTSP(X1, Y1, X2); + if Y2 > Y1 + 1 then + begin + DrawVertLineTSP(X2, Y1 + 1, Y2 - 1); + if X2 > X1 then + DrawVertLineTSP(X1, Y1 + 1, Y2 - 1); + end; + if Y2 > Y1 then + DrawHorzLineTSP(X1, Y2, X2); + Changed; +end; + +procedure TJclBitmap32.RaiseRectTS(X1, Y1, X2, Y2: Integer; Contrast: Integer); +var + C1, C2: TColor32; +begin + Changing; + try + if Contrast > 0 then + begin + C1 := clWhite32; + C2 := clBlack32; + end + else + if Contrast < 0 then + begin + C1 := clBlack32; + C2 := clWhite32; + Contrast := -Contrast; + end + else + Exit; + Contrast := Clamp(Contrast * 255 div 100); + C1 := SetAlpha(C1, Contrast); + C2 := SetAlpha(C2, Contrast); + TestSwap(X1, X2); + TestSwap(Y1, Y2); + DrawHorzLineTS(X1, Y1, X2 - 1, C1); + DrawHorzLineTS(X1 + 1, Y2, X2, C2); + DrawVertLineTS(X1, Y1, Y2 - 1, C1); + DrawVertLineTS(X2, Y1 + 1, Y2, C2); + finally + Changed; + end; +end; + +procedure TJclBitmap32.LoadFromStream(Stream: TStream); +var + B: TBitmap; +begin + Changing; + B := TBitmap.Create; + try + B.LoadFromStream(Stream); + Assign(B); + finally + B.Free; + Changed; + end; +end; + +procedure TJclBitmap32.SaveToStream(Stream: TStream); +var + B: TBitmap; +begin + B := TBitmap.Create; + try + AssignTo(B); + B.SaveToStream(Stream); + finally + B.Free; + end; +end; + +procedure TJclBitmap32.DefineProperties(Filer: TFiler); + + function DoWrite: Boolean; + begin + if Filer.Ancestor <> nil then + Result := not (Filer.Ancestor is TGraphic) + else + Result := not Empty; + end; + +begin + Filer.DefineBinaryProperty('Data', ReadData, WriteData, DoWrite); +end; + +procedure TJclBitmap32.ReadData(Stream: TStream); +var + w, h: Integer; +begin + Changing; + try + Stream.ReadBuffer(w, 4); + Stream.ReadBuffer(h, 4); + SetSize(w, h); + Stream.ReadBuffer(FBits[0], FWidth * FHeight * 4); + finally + Changed; + end; +end; + +procedure TJclBitmap32.WriteData(Stream: TStream); +begin + Stream.WriteBuffer(FWidth, 4); + Stream.WriteBuffer(FHeight, 4); + Stream.WriteBuffer(FBits[0], FWidth * FHeight * 4); +end; + +procedure TJclBitmap32.LoadFromFile(const FileName: string); +var + P: TPicture; +begin + P := TPicture.Create; + try + P.LoadFromFile(FileName); + Assign(P); + finally + P.Free; + end; +end; + +procedure TJclBitmap32.SaveToFile(const FileName: string); +var + B: TBitmap; +begin + B := TBitmap.Create; + try + AssignTo(B); + B.SaveToFile(FileName); + finally + B.Free; + end; +end; + +procedure TJclBitmap32.SetFont(Value: TFont); +begin + FFont.Assign(Value); + FontChanged(Self); +end; + +procedure TJclBitmap32.FontChanged(Sender: TObject); +begin + if FontHandle > 0 then + begin + SelectObject(Handle, GetStockObject(SYSTEM_FONT)); + FontHandle := 0; + end; +end; + +procedure TJclBitmap32.UpdateFont; +begin + if FontHandle = 0 then + begin + SelectObject(Handle, Font.Handle); + SetTextColor(Handle, ColorToRGB(Font.Color)); + SetBkMode(Handle, {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.TRANSPARENT); + end; +end; + +procedure TJclBitmap32.SetDrawMode(Value: TDrawMode); +begin + if FDrawMode <> Value then + begin + Changing; + FDrawMode := Value; + Changed; + end; +end; + +procedure TJclBitmap32.SetMasterAlpha(Value: Byte); +begin + if FMasterAlpha <> Value then + begin + Changing; + FMasterAlpha := Value; + Changed; + end; +end; + +procedure TJclBitmap32.SetStretchFilter(Value: TStretchFilter); +begin + if FStretchFilter <> Value then + begin + Changing; + FStretchFilter := Value; + Changed; + end; +end; + +function TJclBitmap32.TextExtent(const Text: string): TSize; +begin + UpdateFont; + Result.cX := 0; + Result.cY := 0; + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetTextExtentPoint32(Handle, PChar(Text), Length(Text), Result); +end; + +procedure TJclBitmap32.TextOut(X, Y: Integer; const Text: string); +begin + Changing; + UpdateFont; + ExtTextOut(Handle, X, Y, 0, nil, PChar(Text), Length(Text), nil); + Changed; +end; + +procedure TJclBitmap32.TextOut(X, Y: Integer; const ClipRect: TRect; + const Text: string); +begin + Changing; + UpdateFont; + ExtTextOut(Handle, X, Y, ETO_CLIPPED, @ClipRect, PChar(Text), Length(Text), nil); + Changed; +end; + +procedure TJclBitmap32.TextOut(ClipRect: TRect; const Flags: Cardinal; + const Text: string); +begin + Changing; + UpdateFont; + DrawText(Handle, PChar(Text), Length(Text), ClipRect, Flags); + Changed; +end; + +function TJclBitmap32.TextHeight(const Text: string): Integer; +begin + Result := TextExtent(Text).cY; +end; + +function TJclBitmap32.TextWidth(const Text: string): Integer; +begin + Result := TextExtent(Text).cX; +end; + +procedure TJclBitmap32.RenderText(X, Y: Integer; const Text: string; AALevel: Integer; Color: TColor32); +var + B, B2: TJclBitmap32; + Sz: TSize; + C: TColor32; + I: Integer; + P: PColor32; +begin + AALevel := Constrain(AALevel, 0, 4); + B := TJclBitmap32.Create; + try + if AALevel = 0 then + begin + Sz := TextExtent(Text + ' '); + B.SetSize(Sz.cX, Sz.cY); + B.Font := Font; + B.Clear(0); + B.Font.Color := clWhite; + B.TextOut(0, 0, Text); + end + else + begin + B2 := TJclBitmap32.Create; + try + B2.SetSize(1, 1); // just need some DC here + B2.Font := Font; + B2.Font.Size := Font.Size shl AALevel; + Sz := B2.TextExtent(Text + ' '); + Sz.cx := (Sz.cx shr AALevel + 1) shl AALevel; + B2.SetSize(Sz.cx, Sz.cy); + B2.Clear(0); + B2.Font.Color := clWhite; + B2.TextOut(0, 0, Text); + B2.StretchFilter := sfLinear; + B.SetSize(Sz.cx shr AALevel, Sz.cy shr AALevel); + B.Draw(Rect(0, 0, B.Width, B.Height), Rect(0, 0, B2.Width, B2.Height), B2); + finally + B2.Free; + end; + end; + + // convert intensity and color to alpha + B.MasterAlpha := Color shr 24; + Color := Color and $00FFFFFF; + P := @B.Bits[0]; + for I := 0 to B.Width * B.Height - 1 do + begin + C := P^; + if C <> 0 then + begin + C := P^ shl 24; // transfer blue channel to alpha + C := C + Color; + P^ := C; + end; + Inc(P); + end; + B.DrawMode := dmBlend; + + B.DrawTo(Self, X, Y); + finally + B.Free; + end; +end; + +//=== { TJclByteMap } ======================================================== + +destructor TJclByteMap.Destroy; +begin + FBytes := nil; + inherited Destroy; +end; + +procedure TJclByteMap.Assign(Source: TPersistent); +begin + Changing; + BeginUpdate; + try + if Source is TJclByteMap then + begin + FWidth := TJclByteMap(Source).Width; + FHeight := TJclByteMap(Source).Height; + FBytes := Copy(TJclByteMap(Source).Bytes, 0, FWidth * FHeight); + end + else + if Source is TJclBitmap32 then + ReadFrom(TJclBitmap32(Source), ckWeightedRGB) + else + inherited Assign(Source); + finally + EndUpdate; + Changed; + end; +end; + +procedure TJclByteMap.AssignTo(Dst: TPersistent); +begin + if Dst is TJclBitmap32 then + WriteTo(TJclBitmap32(Dst), ckUniformRGB) + else + inherited AssignTo(Dst); +end; + +procedure TJclByteMap.Clear(FillValue: Byte); +begin + Changing; + FillChar(Bytes[0], Width * Height, FillValue); + Changed; +end; + +function TJclByteMap.Empty: Boolean; +begin + Result := Bytes = nil; +end; + +function TJclByteMap.GetValPtr(X, Y: Integer): PByte; +begin + Result := @Bytes[X + Y * Width]; +end; + +function TJclByteMap.GetValue(X, Y: Integer): Byte; +begin + Result := Bytes[X + Y * Width]; +end; + +procedure TJclByteMap.ReadFrom(Source: TJclBitmap32; Conversion: TConversionKind); +var + W, H, I, N: Integer; + SrcC: PColor32; + SrcB, DstB: PByte; + Value: TColor32; +begin + Changing; + BeginUpdate; + try + SetSize(Source.Width, Source.Height); + if Empty then + Exit; + + W := Source.Width; + H := Source.Height; + N := W * H - 1; + SrcC := Source.PixelPtr[0, 0]; + SrcB := Pointer(SrcC); + DstB := @Bytes[0]; + case Conversion of + ckRed: + begin + Inc(SrcB, 2); + for I := 0 to N do + begin + DstB^ := SrcB^; + Inc(DstB); + Inc(SrcB, 4); + end; + end; + ckGreen: + begin + Inc(SrcB, 1); + for I := 0 to N do + begin + DstB^ := SrcB^; + Inc(DstB); + Inc(SrcB, 4); + end; + end; + ckBlue: + begin + for I := 0 to N do + begin + DstB^ := SrcB^; + Inc(DstB); + Inc(SrcB, 4); + end; + end; + ckAlpha: + begin + Inc(SrcB, 3); + for I := 0 to N do + begin + DstB^ := SrcB^; + Inc(DstB); + Inc(SrcB, 4); + end; + end; + ckUniformRGB: + begin + for I := 0 to N do + begin + Value := SrcC^; + Value := (Value and $00FF0000) shr 16 + (Value and $0000FF00) shr 8 + + (Value and $000000FF); + Value := Value div 3; + DstB^ := Value; + Inc(DstB); + Inc(SrcC); + end; + end; + ckWeightedRGB: + begin + for I := 0 to N do + begin + DstB^ := Intensity(SrcC^); + Inc(DstB); + Inc(SrcC); + end; + end; + end; + finally + EndUpdate; + Changed; + end; +end; + +procedure TJclByteMap.SetValue(X, Y: Integer; Value: Byte); +begin + Bytes[X + Y * Width] := Value; +end; + +procedure TJclByteMap.SetSize(NewWidth, NewHeight: Integer); +begin + Changing; + inherited SetSize(NewWidth, NewHeight); + SetLength(FBytes, Width * Height); + Changed; +end; + +procedure TJclByteMap.WriteTo(Dest: TJclBitmap32; Conversion: TConversionKind); +var + W, H, I, N: Integer; + DstC: PColor32; + DstB, SrcB: PByte; +begin + Dest.Changing; + Dest.BeginUpdate; + try + Dest.SetSize(Width, Height); + if Empty then + Exit; + + W := Width; + H := Height; + N := W * H - 1; + DstC := Dest.PixelPtr[0, 0]; + DstB := Pointer(DstC); + SrcB := @Bytes[0]; + case Conversion of + ckRed: + begin + Inc(DstB, 2); + for I := 0 to N do + begin + DstB^ := SrcB^; + Inc(DstB, 4); + Inc(SrcB); + end; + end; + ckGreen: + begin + Inc(DstB, 1); + for I := 0 to N do + begin + DstB^ := SrcB^; + Inc(DstB, 4); + Inc(SrcB); + end; + end; + ckBlue: + begin + for I := 0 to N do + begin + DstB^ := SrcB^; + Inc(DstB, 4); + Inc(SrcB); + end; + end; + ckAlpha: + begin + Inc(DstB, 3); + for I := 0 to N do + begin + DstB^ := SrcB^; + Inc(DstB, 4); + Inc(SrcB); + end; + end; + ckUniformRGB, ckWeightedRGB: + begin + for I := 0 to N do + begin + DstC^ := Gray32(SrcB^, $FF); + Inc(DstC); + Inc(SrcB); + end; + end; + end; + finally + Dest.EndUpdate; + Dest.Changed; + end; +end; + +procedure TJclByteMap.WriteTo(Dest: TJclBitmap32; const Palette: TPalette32); +var + W, H, I, N: Integer; + DstC: PColor32; + SrcB: PByte; +begin + Dest.Changing; + Dest.BeginUpdate; + try + Dest.SetSize(Width, Height); + if Empty then + Exit; + + W := Width; + H := Height; + N := W * H - 1; + DstC := Dest.PixelPtr[0, 0]; + SrcB := @Bytes[0]; + + for I := 0 to N do + begin + DstC^ := Palette[SrcB^]; + Inc(DstC); + Inc(SrcB); + end; + finally + Dest.EndUpdate; + Dest.Changed; + end; +end; + +//=== Matrices =============================================================== + +{ TODO -oWIMDC -cReplace : Insert JclMatrix support } +function _DET(a1, a2, b1, b2: Extended): Extended; overload; +begin + Result := a1 * b2 - a2 * b1; +end; + +function _DET(a1, a2, a3, b1, b2, b3, c1, c2, c3: Extended): Extended; overload; +begin + Result := + a1 * (b2 * c3 - b3 * c2) - + b1 * (a2 * c3 - a3 * c2) + + c1 * (a2 * b3 - a3 * b2); +end; + +procedure Adjoint(var M: TMatrix3d); +var + a1, a2, a3: Extended; + b1, b2, b3: Extended; + c1, c2, c3: Extended; +begin + a1 := M.A[0, 0]; + a2 := M.A[0, 1]; + a3 := M.A[0, 2]; + + b1 := M.A[1, 0]; + b2 := M.A[1, 1]; + b3 := M.A[1, 2]; + + c1 := M.A[2, 0]; + c2 := M.A[2, 1]; + c3 := M.A[2, 2]; + + M.A[0, 0]:= _DET(b2, b3, c2, c3); + M.A[0, 1]:= -_DET(a2, a3, c2, c3); + M.A[0, 2]:= _DET(a2, a3, b2, b3); + + M.A[1, 0]:= -_DET(b1, b3, c1, c3); + M.A[1, 1]:= _DET(a1, a3, c1, c3); + M.A[1, 2]:= -_DET(a1, a3, b1, b3); + + M.A[2, 0]:= _DET(b1, b2, c1, c2); + M.A[2, 1]:= -_DET(a1, a2, c1, c2); + M.A[2, 2]:= _DET(a1, a2, b1, b2); +end; + +function Determinant(const M: TMatrix3d): Extended; +begin + Result := _DET( + M.A[0, 0], M.A[1, 0], M.A[2, 0], + M.A[0, 1], M.A[1, 1], M.A[2, 1], + M.A[0, 2], M.A[1, 2], M.A[2, 2]); +end; + +procedure Scale(var M: TMatrix3d; Factor: Extended); +var + I, J: Integer; +begin + for I := 0 to 2 do + for J := 0 to 2 do + M.A[I, J] := M.A[I, J] * Factor; +end; + +procedure InvertMatrix(var M: TMatrix3d); +var + Det: Extended; +begin + Det := Determinant(M); + if Abs(Det) < 1E-5 then + M := IdentityMatrix + else + begin + Adjoint(M); + Scale(M, 1 / Det); + end; +end; + +function Mult(const M1, M2: TMatrix3d): TMatrix3d; +var + I, J: Integer; +begin + for I := 0 to 2 do + for J := 0 to 2 do + Result.A[I, J] := + M1.A[0, J] * M2.A[I, 0] + + M1.A[1, J] * M2.A[I, 1] + + M1.A[2, J] * M2.A[I, 2]; +end; + +type + TVector3d = array [0..2] of Extended; + TVector3i = array [0..2] of Integer; + +function VectorTransform(const M: TMatrix3d; const V: TVector3d): TVector3d; +begin + Result[0] := M.A[0, 0] * V[0] + M.A[1, 0] * V[1] + M.A[2, 0] * V[2]; + Result[1] := M.A[0, 1] * V[0] + M.A[1, 1] * V[1] + M.A[2, 1] * V[2]; + Result[2] := M.A[0, 2] * V[0] + M.A[1, 2] * V[1] + M.A[2, 2] * V[2]; +end; + +//=== { TJclLinearTransformation } =========================================== + +constructor TJclLinearTransformation.Create; +begin + inherited Create; + Clear; +end; + +procedure TJclLinearTransformation.Clear; +begin + FMatrix := IdentityMatrix; +end; + +function TJclLinearTransformation.GetTransformedBounds(const Src: TRect): TRect; +var + V1, V2, V3, V4: TVector3d; +begin + V1[0] := Src.Left; + V1[1] := Src.Top; + V1[2] := 1; + + V2[0] := Src.Right - 1; + V2[1] := V1[1]; + V2[2] := 1; + + V3[0] := V1[0]; + V3[1] := Src.Bottom - 1; + V3[2] := 1; + + V4[0] := V2[0]; + V4[1] := V3[1]; + V4[2] := 1; + + V1 := VectorTransform(Matrix, V1); + V2 := VectorTransform(Matrix, V2); + V3 := VectorTransform(Matrix, V3); + V4 := VectorTransform(Matrix, V4); + + Result.Left := Round(Min(Min(V1[0], V2[0]), Min(V3[0], V4[0])) - 0.5); + Result.Right := Round(Max(Max(V1[0], V2[0]), Max(V3[0], V4[0])) + 0.5); + Result.Top := Round(Min(Min(V1[1], V2[1]), Min(V3[1], V4[1])) - 0.5); + Result.Bottom := Round(Max(Max(V1[1], V2[1]), Max(V3[1], V4[1])) + 0.5); +end; + +procedure TJclLinearTransformation.PrepareTransform; +var + M: TMatrix3d; +begin + M := Matrix; + InvertMatrix(M); + + // calculate a fixed point (4096) factors + A := Round(M.A[0, 0] * 4096); + B := Round(M.A[1, 0] * 4096); + C := Round(M.A[2, 0] * 4096); + D := Round(M.A[0, 1] * 4096); + E := Round(M.A[1, 1] * 4096); + F := Round(M.A[2, 1] * 4096); +end; + +procedure TJclLinearTransformation.Rotate(Cx, Cy, Alpha: Extended); +var + S, C: Extended; + M: TMatrix3d; +begin + if (Cx <> 0) and (Cy <> 0) then + Translate(-Cx, -Cy); + SinCos(DegToRad(Alpha), S, C); + M := IdentityMatrix; + M.A[0, 0] := C; + M.A[1, 0] := S; + M.A[0, 1] := -S; + M.A[1, 1] := C; + FMatrix := Mult(M, FMatrix); + if (Cx <> 0) and (Cy <> 0) then + Translate(Cx, Cy); +end; + +procedure TJclLinearTransformation.Scale(Sx, Sy: Extended); +var + M: TMatrix3d; +begin + M := IdentityMatrix; + M.A[0, 0] := Sx; + M.A[1, 1] := Sy; + FMatrix := Mult(M, FMatrix); +end; + +procedure TJclLinearTransformation.Skew(Fx, Fy: Extended); +var + M: TMatrix3d; +begin + M := IdentityMatrix; + M.A[1, 0] := Fx; + M.A[0, 1] := Fy; + FMatrix := Mult(M, FMatrix); +end; + +procedure TJclLinearTransformation.Transform(DstX, DstY: Integer; + out SrcX, SrcY: Integer); +begin + SrcX := Sar(DstX * A + DstY * B + C, 12); + SrcY := Sar(DstX * D + DstY * E + F, 12); +end; + +procedure TJclLinearTransformation.Transform256(DstX, DstY: Integer; + out SrcX256, SrcY256: Integer); +begin + SrcX256 := Sar(DstX * A + DstY * B + C, 4); + SrcY256 := Sar(DstX * D + DstY * E + F, 4); +end; + +procedure TJclLinearTransformation.Translate(Dx, Dy: Extended); +var + M: TMatrix3d; +begin + M := IdentityMatrix; + M.A[2, 0] := Dx; + M.A[2, 1] := Dy; + FMatrix := Mult(M, FMatrix); +end; + +//=== PolyLines and Polygons ================================================= + +procedure PolylineTS(Bitmap: TJclBitmap32; const Points: TDynPointArray; + Color: TColor32); +var + I, L: Integer; + DoAlpha: Boolean; +begin + DoAlpha := Color and $FF000000 <> $FF000000; + L := Length(Points); + if L < 2 then + Exit; + + Bitmap.Changing; + Bitmap.BeginUpdate; + with Points[L - 1] do + Bitmap.MoveTo(X, Y); + Bitmap.PenColor := Color; + if DoAlpha then + for I := 0 to L - 1 do + with Points[I] do + Bitmap.LineToTS(X, Y) + else + for I := 0 to L - 1 do + with Points[I] do + Bitmap.LineToS(X, Y); + Bitmap.EndUpdate; + Bitmap.Changed; +end; + +procedure PolyLineAS(Bitmap: TJclBitmap32; const Points: TDynPointArray; + Color: TColor32); +var + I, L: Integer; +begin + L := Length(Points); + if L < 2 then + Exit; + Bitmap.Changing; + Bitmap.BeginUpdate; + with Points[L - 1] do + Bitmap.MoveTo(X, Y); + Bitmap.PenColor := Color; + for I := 0 to L - 1 do + with Points[I] do + Bitmap.LineToAS(X, Y); + Bitmap.EndUpdate; + Bitmap.Changed; +end; + +procedure PolylineFS(Bitmap: TJclBitmap32; const Points: TDynPointArrayF; + Color: TColor32); +var + I, L: Integer; +begin + L := Length(Points); + if L < 2 then + Exit; + Bitmap.Changing; + Bitmap.BeginUpdate; + with Points[L - 1] do + Bitmap.MoveToF(X, Y); + Bitmap.PenColor := Color; + for I := 0 to L - 1 do + with Points[I] do + Bitmap.LineToFS(X, Y); + Bitmap.EndUpdate; + Bitmap.Changed; +end; + +procedure QSortLine(const ALine: TScanLine; L, R: Integer); +var + I, J, P: Integer; +begin + repeat + I := L; + J := R; + P := ALine[(L + R) shr 1]; + repeat + while ALine[I] < P do + Inc(I); + while ALine[J] > P do + Dec(J); + if I <= J then + begin + SwapOrd(ALine[I], ALine[J]); + Inc(I); + Dec(J); + end; + until I > J; + if L < J then + QSortLine(ALine, L, J); + L := I; + until I >= R; +end; + +procedure SortLine(const ALine: TScanLine); +var + L: Integer; +begin + L := Length(ALine); + Assert(not Odd(L)); + if L = 2 then + TestSwap(ALine[0], ALine[1]) + else + if L > 2 then + QSortLine(ALine, 0, L - 1); +end; + +procedure SortLines(const ScanLines: TScanLines); +var + I: Integer; +begin + for I := 0 to High(ScanLines) do + SortLine(ScanLines[I]); +end; + +procedure AddPolygon(const Points: TDynPointArray; BaseY: Integer; + MaxX, MaxY: Integer; var ScanLines: TScanLines; SubSampleX: Boolean); +var + I, X1, Y1, X2, Y2: Integer; + Direction, PrevDirection: Integer; // up = 1 or down = -1 + + procedure AddEdgePoint(X, Y: Integer); + var + L: Integer; + begin + if (Y < 0) or (Y > MaxY) then + Exit; + X := Constrain(X, 0, MaxX); + L := Length(ScanLines[Y - BaseY]); + SetLength(ScanLines[Y - BaseY], L + 1); + ScanLines[Y - BaseY][L] := X; + end; + + procedure DrawEdge(X1, Y1, X2, Y2: Integer); + var + X, Y, I: Integer; + Dx, Dy, Sx, Sy: Integer; + Delta: Integer; + begin + // this function 'renders' a line into the edge (ScanLines) buffer + if Y2 = Y1 then + Exit; + + Dx := X2 - X1; + Dy := Y2 - Y1; + + if Dy > 0 then + Sy := 1 + else + begin + Sy := -1; + Dy := -Dy; + end; + if Dx > 0 then + Sx := 1 + else + begin + Sx := -1; + Dx := -Dx; + end; + Delta := (Dx mod Dy) shr 1; + X := X1; + Y := Y1; + for I := 0 to Dy - 1 do + begin + AddEdgePoint(X, Y); + Inc(Y, Sy); + Inc(Delta, Dx); + while Delta > Dy do + begin + Inc(X, Sx); + Dec(Delta, Dy); + end; + end; + end; + +begin + X1 := Points[0].X; + Y1 := Points[0].Y; + if SubSampleX then + X1 := X1 shl 8; + + // find the last Y different from Y1 and assign it to Y0 + PrevDirection := 0; + for I := High(Points) downto 1 do + begin + if Points[I].Y > Y1 then + PrevDirection := -1 + else + if Points[I].Y < Y1 then + PrevDirection := 1 + else + Continue; + Break; + end; + Assert(PrevDirection <> 0); + + for I := 1 to High(Points) do + begin + X2 := Points[I].X; + Y2 := Points[I].Y; + if SubSampleX then + X2 := X2 shl 8; + if Y1 <> Y2 then + begin + DrawEdge(X1, Y1, X2, Y2); + if Y2 > Y1 then + Direction := 1 // up + else + Direction := -1; // down + if Direction <> PrevDirection then + begin + AddEdgePoint(X1, Y1); + PrevDirection := Direction; + end; + end; + X1 := X2; + Y1 := Y2; + end; + X2 := Points[0].X; + Y2 := Points[0].Y; + if SubSampleX then + X2 := X2 shl 8; + if Y1 <> Y2 then + begin + DrawEdge(X1, Y1, X2, Y2); + if Y2 > Y1 then + Direction := 1 + else + Direction := -1; + if Direction <> PrevDirection then + AddEdgePoint(X1, Y1); + end; +end; + +procedure FillLines(Bitmap: TJclBitmap32; BaseY: Integer; + const ScanLines: TScanLines; Color: TColor32); +var + I, J, L: Integer; + Left, Right: Integer; + DoAlpha: Boolean; +begin + DoAlpha := Color and $FF000000 <> $FF000000; + for J := 0 to High(ScanLines) do + begin + L := Length(ScanLines[J]); // assuming length is even + I := 0; + while I < L do + begin + Left := ScanLines[J][I]; + Inc(I); + Right := ScanLines[J][I]; + if Right > Left then + begin + if (Left and $FF) < $80 then + Left := Left shr 8 + else + Left := Left shr 8 + 1; + if (Right and $FF) < $80 then + Right := Right shr 8 + else + Right := Right shr 8 + 1; + if DoAlpha then + Bitmap.DrawHorzLineT(Left, BaseY + J, Right, Color) + else + Bitmap.DrawHorzLine(Left, BaseY + J, Right, Color); + end; + Inc(I); + end; + end; +end; + +procedure FillLines2(Bitmap: TJclBitmap32; BaseY: Integer; + const ScanLines: TScanLines; Color: TColor32); +var + I, J, L, N: Integer; + MinY, MaxY, Y, Top, Bottom: Integer; + MinX, MaxX, X, Dx: Integer; + Left, Right: Integer; + Buffer: array of Integer; + P: PColor32; + DoAlpha: Boolean; +begin + DoAlpha := Color and $FF000000 <> $FF000000; + // find the range of Y screen coordinates + MinY := BaseY shr 4; + MaxY := (BaseY + Length(ScanLines) + 15) shr 4; + + Y := MinY; + while Y < MaxY do + begin + Top := Y shl 4 - BaseY; + Bottom := Top + 15; + if Top < 0 then + Top := 0; + if Bottom > High(ScanLines) then + Bottom := High(ScanLines); + + // find left and right edges of the screen scanline + MinX := 1000000; + MaxX := -1000000; + for J := Top to Bottom do + begin + L := High(ScanLines[J]); + Left := ScanLines[J][0] shr 4; + Right := (ScanLines[J][L] + 15) shr 4; + if Left < MinX then + MinX := Left; + if Right > MaxX then + MaxX := Right; + end; + + // allocate the buffer for a screen scanline + SetLength(Buffer, MaxX - MinX + 2); + FillLongword(Buffer[0], Length(Buffer), 0); + + // and fill it + for J := Top to Bottom do + begin + I := 0; + L := Length(ScanLines[J]); + while I < L do + begin + // Left edge + X := ScanLines[J][I]; + Dx := X and $0F; + X := X shr 4 - MinX; + Inc(Buffer[X], Dx xor $0F); + Inc(Buffer[X + 1], Dx); + Inc(I); + + // Right edge + X := ScanLines[J][I]; + Dx := X and $0F; + X := X shr 4 - MinX; + Dec(Buffer[X], Dx xor $0F); + Dec(Buffer[X + 1], Dx); + Inc(I); + end; + end; + + // integrate the buffer + N := 0; + for I := 0 to High(Buffer) do + begin + Inc(N, Buffer[I]); + Buffer[I] := N * 273 shr 8; // some bias + end; + + // draw it to the screen + P := Bitmap.PixelPtr[MinX, Y]; + if DoAlpha then + for I := 0 to High(Buffer) do + begin + BlendMemEx(Color, P^, Buffer[I]); + Inc(P); + end + else + for I := 0 to High(Buffer) do + begin + N := Buffer[I]; + if N = 255 then + P^ := Color + else + BlendMemEx(Color, P^, Buffer[I]); + Inc(P); + end; + + Inc(Y); + end; +end; + +procedure GetMinMax(const Points: TDynPointArray; out MinY, MaxY: Integer); +var + I, Y: Integer; +begin + MinY := 100000; + MaxY := -100000; + for I := 0 to High(Points) do + begin + Y := Points[I].Y; + if Y < MinY then + MinY := Y; + if Y > MaxY then + MaxY := Y; + end; +end; + +procedure PolygonTS(Bitmap: TJclBitmap32; const Points: TDynPointArray; Color: TColor32); +var + L, MinY, MaxY: Integer; + ScanLines: TScanLines; +begin + L := Length(Points); + if L < 3 then + Exit; + GetMinMax(Points, MinY, MaxY); + MinY := Constrain(MinY, 0, Bitmap.Height); + MaxY := Constrain(MaxY, 0, Bitmap.Height); + if MinY >= MaxY then + Exit; + SetLength(ScanLines, MaxY - MinY + 1); + AddPolygon(Points, MinY, Bitmap.Width shl 8 - 1, Bitmap.Height - 1, + ScanLines, True); + SortLines(ScanLines); + Bitmap.Changing; + Bitmap.BeginUpdate; + try + FillLines(Bitmap, MinY, ScanLines, Color); + finally + Bitmap.EndUpdate; + Bitmap.Changed; + end; +end; + +procedure PolygonAS(Bitmap: TJclBitmap32; const Points: TDynPointArray; Color: TColor32); +var + L, I, MinY, MaxY: Integer; + ScanLines: TScanLines; + PP: TDynPointArray; +begin + L := Length(Points); + if L < 3 then + Exit; + SetLength(PP, L); + for I := 0 to L - 1 do + begin + PP[I].X := Points[I].X shl 4 + 7; + PP[I].Y := Points[I].Y shl 4 + 7; + end; + GetMinMax(PP, MinY, MaxY); + MinY := Constrain(MinY, 0, Bitmap.Height shl 4 - 1); + MaxY := Constrain(MaxY, 0, Bitmap.Height shl 4 - 1); + if MinY >= MaxY then + Exit; + SetLength(ScanLines, MaxY - MinY + 1); + AddPolygon(PP, MinY, Bitmap.Width shl 4 - 1, Bitmap.Height shl 4 - 1, + ScanLines, False); + SortLines(ScanLines); + Bitmap.Changing; + Bitmap.BeginUpdate; + try + FillLines2(Bitmap, MinY, ScanLines, Color); + finally + Bitmap.EndUpdate; + Bitmap.Changed; + end; +end; + +procedure PolygonFS(Bitmap: TJclBitmap32; const Points: TDynPointArrayF; Color: TColor32); +var + L, I, MinY, MaxY: Integer; + ScanLines: TScanLines; + PP: TDynPointArray; +begin + L := Length(Points); + if L < 3 then + Exit; + SetLength(PP, L); + for I := 0 to L - 1 do + begin + PP[I].X := Round(Points[I].X * 16) + 7; + PP[I].Y := Round(Points[I].Y * 16) + 7; + end; + GetMinMax(PP, MinY, MaxY); + MinY := Constrain(MinY, 0, Bitmap.Height shl 4 - 1); + MaxY := Constrain(MaxY, 0, Bitmap.Height shl 4 - 1); + if MinY >= MaxY then + Exit; + SetLength(ScanLines, MaxY - MinY + 1); + AddPolygon(PP, MinY, Bitmap.Width shl 4 - 1, Bitmap.Height shl 4 - 1, + ScanLines, False); + SortLines(ScanLines); + Bitmap.Changing; + Bitmap.BeginUpdate; + try + FillLines2(Bitmap, MinY, ScanLines, Color); + finally + Bitmap.EndUpdate; + Bitmap.Changed; + end; +end; + +procedure PolyPolygonTS(Bitmap: TJclBitmap32; const Points: TDynDynPointArrayArray; + Color: TColor32); +var + N, L, min, max, MinY, MaxY: Integer; + ScanLines: TScanLines; +begin + MinY := 100000; + MaxY := -100000; + for N := 0 to High(Points) do + begin + L := Length(Points[N]); + if L < 3 then + Exit; + GetMinMax(Points[N], min, max); + if min < MinY then + MinY := min; + if max > MaxY then + MaxY := max; + end; + MinY := Constrain(MinY, 0, Bitmap.Height - 1); + MaxY := Constrain(MaxY, 0, Bitmap.Height - 1); + if MinY >= MaxY then + Exit; + SetLength(ScanLines, MaxY - MinY + 1); + + for N := 0 to High(Points) do + AddPolygon(Points[N], MinY, Bitmap.Width shl 8 - 1 , Bitmap.Height - 1, + ScanLines, True); + + SortLines(ScanLines); + + Bitmap.Changing; + FillLines(Bitmap, MinY, ScanLines, Color); + Bitmap.Changed; +end; + +procedure PolyPolygonAS(Bitmap: TJclBitmap32; const Points: TDynDynPointArrayArray; + Color: TColor32); +var + N, L, I, min, max, MinY, MaxY: Integer; + ScanLines: TScanLines; + PPP: TDynDynPointArrayArray; +begin + MinY := 100000; + MaxY := -100000; + SetLength(PPP, Length(Points)); + for N := 0 to High(Points) do + begin + L := Length(Points); + SetLength(PPP[N], Length(Points[N])); + for I := 0 to L - 1 do + begin + PPP[N][I].X := Points[N][I].X shl 4 + 7; + PPP[N][I].Y := Points[N][I].Y shl 4 + 7; + end; + if L < 3 then + Continue; + GetMinMax(PPP[N], min, max); + if min < MinY then + MinY := min; + if max > MaxY then + MaxY := max; + end; + MinY := Constrain(MinY, 0, Bitmap.Height shl 4 - 1); + MaxY := Constrain(MaxY, 0, Bitmap.Height shl 4 - 1); + if MinY >= MaxY then + Exit; + SetLength(ScanLines, MaxY - MinY + 1); + + for N := 0 to High(PPP) do + begin + AddPolygon(PPP[N], MinY, Bitmap.Width shl 4 - 1, Bitmap.Height shl 4 - 1, + ScanLines, False); + end; + + SortLines(ScanLines); + + Bitmap.Changing; + FillLines2(Bitmap, MinY, ScanLines, Color); + Bitmap.Changed; +end; + +procedure PolyPolygonFS(Bitmap: TJclBitmap32; const Points: TDynDynPointArrayArrayF; + Color: TColor32); +var + N, L, I, min, max, MinY, MaxY: Integer; + ScanLines: TScanLines; + PPP: TDynDynPointArrayArray; +begin + MinY := 100000; + MaxY := -100000; + SetLength(PPP, Length(Points)); + for N := 0 to High(Points) do + begin + L := Length(Points); + SetLength(PPP[N], Length(Points[N])); + for I := 0 to L - 1 do + begin + PPP[N][I].X := Round(Points[N][I].X * 16) + 7; + PPP[N][I].Y := Round(Points[N][I].Y * 16) + 7; + end; + if L < 3 then + Continue; + GetMinMax(PPP[N], min, max); + if min < MinY then + MinY := min; + if max > MaxY then + MaxY := max; + end; + MinY := Constrain(MinY, 0, Bitmap.Height shl 4 - 1); + MaxY := Constrain(MaxY, 0, Bitmap.Height shl 4 - 1); + if MinY >= MaxY then + Exit; + SetLength(ScanLines, MaxY - MinY + 1); + + for N := 0 to High(PPP) do + AddPolygon(PPP[N], MinY, Bitmap.Width shl 4 - 1, Bitmap.Height shl 4 - 1, + ScanLines, False); + + SortLines(ScanLines); + + Bitmap.Changing; + FillLines2(Bitmap, MinY, ScanLines, Color); + Bitmap.Changed; +end; + +//=== Filters ================================================================ + +procedure CheckParams(Dst, Src: TJclBitmap32); +begin + if Src = nil then + raise EJclGraphicsError.CreateRes(@RsSourceBitmapEmpty); + if Dst = nil then + raise EJclGraphicsError.CreateRes(@RsDestinationBitmapEmpty); + Dst.SetSize(Src.Width, Src.Height); // Should this go? See #0001513. It is currently of no use. +end; + +procedure AlphaToGrayscale(Dst, Src: TJclBitmap32); +var + I: Integer; + D, S: PColor32; +begin + CheckParams(Dst, Src); + Dst.Changing; + Dst.SetSize(Src.Width, Src.Height); + D := @Dst.Bits[0]; + S := @Src.Bits[0]; + for I := 0 to Src.Width * Src.Height - 1 do + begin + D^ := Gray32(AlphaComponent(S^), $FF); + Inc(S); + Inc(D); + end; + Dst.Changed; +end; + +procedure IntensityToAlpha(Dst, Src: TJclBitmap32); +var + I: Integer; + D, S: PColor32; +begin + CheckParams(Dst, Src); + Dst.Changing; + Dst.SetSize(Src.Width, Src.Height); + D := @Dst.Bits[0]; + S := @Src.Bits[0]; + for I := 0 to Src.Width * Src.Height - 1 do + begin + D^ := SetAlpha(D^, Intensity(S^)); + Inc(S); + Inc(D); + end; + Dst.Changed; +end; + +procedure Invert(Dst, Src: TJclBitmap32); +var + I: Integer; + D, S: PColor32; +begin + CheckParams(Dst, Src); + Dst.Changing; + Dst.SetSize(Src.Width, Src.Height); + D := @Dst.Bits[0]; + S := @Src.Bits[0]; + for I := 0 to Src.Width * Src.Height - 1 do + begin + D^ := S^ xor $FFFFFFFF; + Inc(S); + Inc(D); + end; + Dst.Changed; +end; + +procedure InvertRGB(Dst, Src: TJclBitmap32); +var + I: Integer; + D, S: PColor32; +begin + CheckParams(Dst, Src); + Dst.Changing; + Dst.SetSize(Src.Width, Src.Height); + D := @Dst.Bits[0]; + S := @Src.Bits[0]; + for I := 0 to Src.Width * Src.Height - 1 do + begin + D^ := S^ xor $00FFFFFF; + Inc(S); + Inc(D); + end; + Dst.Changed; +end; + +procedure ColorToGrayscale(Dst, Src: TJclBitmap32); +var + I: Integer; + D, S: PColor32; +begin + CheckParams(Dst, Src); + Dst.Changing; + Dst.SetSize(Src.Width, Src.Height); + D := @Dst.Bits[0]; + S := @Src.Bits[0]; + for I := 0 to Src.Width * Src.Height - 1 do + begin + D^ := Gray32(Intensity(S^), $FF); + Inc(S); + Inc(D); + end; + Dst.Changed; +end; + +procedure ApplyLUT(Dst, Src: TJclBitmap32; const LUT: TLUT8); +var + I: Integer; + D, S: PColor32; + r, g, b: TColor32; + C: TColor32; +begin + CheckParams(Dst, Src); + + Dst.Changing; + Dst.SetSize(Src.Width, Src.Height); + D := @Dst.Bits[0]; + S := @Src.Bits[0]; + + for I := 0 to Src.Width * Src.Height - 1 do + begin + C := S^; + r := C and $00FF0000; + g := C and $0000FF00; + r := r shr 16; + b := C and $000000FF; + g := g shr 8; + r := LUT[r]; + g := LUT[g]; + b := LUT[b]; + D^ := $FF000000 or r shl 16 or g shl 8 or b; + Inc(S); + Inc(D); + end; + Dst.Changed; +end; + +// Gamma table support for opacities +procedure SetGamma(Gamma: Single); +var + I: Integer; +begin + for I := Low(GAMMA_TABLE) to High(GAMMA_TABLE) do + GAMMA_TABLE[I] := Round(255 * Power(I / 255, Gamma)); +end; + +// modify Jan 28, 2001 for use under BCB5 +// the compiler show error 245 "language feature ist not available" +// we must take a record and under this we can use the static array + +procedure SetIdentityMatrix; +begin + IdentityMatrix.A[0, 0] := 1.0; + IdentityMatrix.A[0, 1] := 0.0; + IdentityMatrix.A[0, 2] := 0.0; + IdentityMatrix.A[1, 0] := 0.0; + IdentityMatrix.A[1, 1] := 1.0; + IdentityMatrix.A[1, 2] := 0.0; + IdentityMatrix.A[2, 0] := 0.0; + IdentityMatrix.A[2, 1] := 0.0; + IdentityMatrix.A[2, 2] := 1.0; +end; + +initialization + SetIdentityMatrix; + SetGamma(0.7); +{$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/vcl/JclOpenDialog.rc b/3rdParty/JCL/source/vcl/JclOpenDialog.rc new file mode 100644 index 00000000..c9bef507 --- /dev/null +++ b/3rdParty/JCL/source/vcl/JclOpenDialog.rc @@ -0,0 +1,5 @@ +JCLOPENDLGHOOK DIALOG 0, 0, 340, 20 +STYLE WS_CHILD | WS_VISIBLE | WS_CLIPSIBLINGS | DS_CONTROL +FONT 8, "Courier New" +BEGIN +END diff --git a/3rdParty/JCL/source/vcl/JclOpenDialog.res b/3rdParty/JCL/source/vcl/JclOpenDialog.res new file mode 100644 index 0000000000000000000000000000000000000000..205c8d6d80482e717709336d52e4718679632fc9 GIT binary patch literal 144 zcmZQzU|>)H;{X347|28cMnIko5dZ(r%HYM|%;3Y|&k(@i%HYS~0%W^0cmVnS4Bl`( s1_C@RFpdKYLkNt`z!1VH0_AW3&B)3P96R8Op)301QzO9RL6T literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/vcl/JclOpenDialogFavorites.pas b/3rdParty/JCL/source/vcl/JclOpenDialogFavorites.pas new file mode 100644 index 00000000..e586b574 --- /dev/null +++ b/3rdParty/JCL/source/vcl/JclOpenDialogFavorites.pas @@ -0,0 +1,581 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is OpenDlgFavAdapter.pas. } +{ } +{ The Initial Developer of the Original Code is Petr Vones. } +{ Portions created by Petr Vones are Copyright (C) Petr Vones. All rights reserved. } +{ } +{ Contributor(s): } +{ Salvatore Besso } +{ Florent Ouchet (move to JCL runtime) } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclOpenDialogFavorites; + +interface + +{$I jcl.inc} + +uses + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, Winapi.Messages, Winapi.ShlObj, System.Classes, System.SysUtils, Vcl.Controls, Vcl.StdCtrls, Vcl.ExtCtrls, + {$ELSE ~HAS_UNITSCOPE} + Windows, Messages, ShlObj, Classes, SysUtils, Controls, StdCtrls, ExtCtrls, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclPeImage, JclWin32, + JclOpenDialogHooks; + +// old-style open dialogs are supported by all versions of Delphi +{$DEFINE OLDSTYLE} + +// new-style file dialogs are supported by Delphi 2007 and newer +// it is disabled in D2007, because the D2006 RTL does not support it at all +{$IFDEF RTL200_UP} +{$DEFINE NEWSTYLE} +{$ENDIF RTL200_UP} + +type + {$NODEFINE TJclOpenDialogFavoritesHook} // IFileDialogCustomize is badly emitted + TJclOpenDialogFavoritesHook = class (TJclOpenDialogHook{$IFDEF NEWSTYLE}, IFileDialogControlEvents, IFileDialogEvents, IInterface{$ENDIF}) + private + FFavoriteFolders: TStrings; + FTextAdd: string; + FTextDelete: string; + FTextVirtual: string; + {$IFDEF OLDSTYLE} + private + FFavoriteComboBox: TComboBox; + FFavoriteStaticText: TStaticText; + FFavoritePanel: TPanel; + procedure FavoriteComboBoxClick(Sender: TObject); + protected + procedure DialogAdjustControlPos; override; + procedure DialogFolderChange; override; + procedure DialogShow; override; + procedure DialogClose; override; + {$ENDIF OLDSTYLE} + {$IFDEF NEWSTYLE} + private + FComboboxCount: Integer; + FComboboxListItem, + FComboboxAddItem, + FComboboxDeleteItem, + FComboboxVirtualItem: Boolean; + FTextList: string; + procedure FileDialogCleanCombobox(const AFileDialogCustomize: IFileDialogCustomize); + procedure FileDialogFillCombobox(const AFileDialogCustomize: IFileDialogCustomize; ListItem, AddItem, DeleteItem, VirtualItem: Boolean); + protected + procedure FileDialogCreate(const AFileDialog: IFileDialog); override; + public + { IInterface } + function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; + function _AddRef: Integer; stdcall; + function _Release: Integer; stdcall; + public + { IFileDialogEvents } + function OnFileOk(const pfd: IFileDialog): HResult; stdcall; + function OnFolderChanging(const pfd: IFileDialog; + const psiFolder: IShellItem): HResult; stdcall; + function OnFolderChange(const pfd: IFileDialog): HResult; stdcall; + function OnSelectionChange(const pfd: IFileDialog): HResult; stdcall; + function OnShareViolation(const pfd: IFileDialog; const psi: IShellItem; + out pResponse: DWORD): HResult; stdcall; + function OnTypeChange(const pfd: IFileDialog): HResult; stdcall; + function OnOverwrite(const pfd: IFileDialog; const psi: IShellItem; + out pResponse: DWORD): HResult; stdcall; + public + { IFileDialogControlEvents } + function OnItemSelected(const pfdc: IFileDialogCustomize; dwIDCtl: DWORD; + dwIDItem: DWORD): HResult; stdcall; + function OnButtonClicked(const pfdc: IFileDialogCustomize; + dwIDCtl: DWORD): HResult; stdcall; + function OnCheckButtonToggled(const pfdc: IFileDialogCustomize; + dwIDCtl: DWORD; bChecked: BOOL): HResult; stdcall; + function OnControlActivating(const pfdc: IFileDialogCustomize; + dwIDCtl: DWORD): HResult; stdcall; + {$ENDIF NEWSTYLE} + public + constructor Create; override; + destructor Destroy; override; + procedure LoadFavorites(const FileName: string); + property FavoriteFolders: TStrings read FFavoriteFolders; + end; + +{$NODEFINE InitializeOpenDialogFavorites} +function InitializeOpenDialogFavorites: TJclOpenDialogFavoritesHook; +{$NODEFINE FinalizeOpenDialogFavorites} +procedure FinalizeOpenDialogFavorites; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\vcl'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + Winapi.CommDlg, Winapi.Dlgs, + {$ELSE ~HAS_UNITSCOPE} + CommDlg, Dlgs, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclFileUtils, JclStrings, JclSysInfo, JclSysUtils, JclVclResources; + +{$IFDEF NEWSTYLE} +const + CTRLID_COMBOBOX = $2346; + ITEMID_LIST = $FFFF; + ITEMID_ADD = $FFFE; + ITEMID_DELETE = $FFFD; + ITEMID_VIRTUAL = $FFFC; +{$ENDIF NEWSTYLE} + +function InitializeOpenDialogFavorites: TJclOpenDialogFavoritesHook; +begin + Result := InitializeOpenDialogHook(TJclOpenDialogFavoritesHook) as TJclOpenDialogFavoritesHook; +end; + +procedure FinalizeOpenDialogFavorites; +begin + FinalizeOpenDialogHook; +end; + +//=== { TJclOpenDialogFavoritesHook } ======================================== + +constructor TJclOpenDialogFavoritesHook.Create; +begin + inherited Create; + FFavoriteFolders := TStringList.Create; + + {$IFDEF OLDSTYLE} + FFavoritePanel := TPanel.Create(nil); + FFavoritePanel.Name := 'FavoritePanel'; + FFavoritePanel.BevelOuter := bvNone; + FFavoritePanel.Caption := ''; + FFavoritePanel.FullRepaint := False; + + FFavoriteComboBox := TComboBox.Create(nil); + FFavoriteComboBox.Parent := FFavoritePanel; + FFavoriteComboBox.Align := alClient; + FFavoriteComboBox.Style := csDropDownList; + FFavoriteComboBox.Sorted := True; + FFavoriteComboBox.OnClick := FavoriteComboBoxClick; + + FFavoriteStaticText := TStaticText.Create(nil); + FFavoriteStaticText.SetBounds(6, 18, FFavoriteStaticText.Width, FFavoriteStaticText.Height); + FFavoriteStaticText.Caption := LoadResString(@RsOpenDialogFavorites); + FFavoriteStaticText.AutoSize := True; + FFavoriteStaticText.FocusControl := FFavoriteComboBox; + {$ENDIF OLDSTYLE} + + FTextAdd := LoadResString(@RsOpenDialogAdd); + FTextDelete := LoadResString(@RsOpenDialogDelete); + FTextVirtual := LoadResString(@RsOpenDialogVirtual); + + {$IFDEF NEWSTYLE} + FTextList := LoadResString(@RsOpenDialogList); + {$ENDIF NEWSTYLE} +end; + +destructor TJclOpenDialogFavoritesHook.Destroy; +begin + {$IFDEF OLDSTYLE} + FreeAndNil(FFavoriteComboBox); + FreeAndNil(FFavoritePanel); + FreeAndNil(FFavoriteStaticText); + {$ENDIF OLDSTYLE} + FreeAndNil(FFavoriteFolders); + inherited Destroy; +end; + +{$IFDEF OLDSTYLE} +procedure TJclOpenDialogFavoritesHook.DialogAdjustControlPos; +var + FileTypeStaticTextRect, FileTypeEditRect, // ID = 1136 1089 + FileNameStaticTextRect, FileNameEditRect: TRect; // ID = 1148 1090 + + procedure GetDlgItemRect(ItemID: Integer; var R: TRect); + begin + GetWindowRect(GetDlgItem(FParentWnd, ItemID), R); + MapWindowPoints(0, FParentWnd, R, 2); + end; + +begin + inherited DialogAdjustControlPos; + + GetDlgItemRect(stc2, FileTypeStaticTextRect); + GetDlgItemRect(cmb1, FileTypeEditRect); + GetDlgItemRect(stc3, FileNameStaticTextRect); + GetDlgItemRect(cmb13, FileNameEditRect); + + FFavoriteStaticText.Left := FileTypeStaticTextRect.Left; + FFavoriteStaticText.Top := 2 * FileTypeStaticTextRect.Top - FileNameStaticTextRect.Top; + + FFavoritePanel.Left := FileNameEditRect.Left; + FFavoritePanel.Top := 2 * FileTypeEditRect.Top - FileNameEditRect.Top; + FFavoritePanel.Width := FileTypeEditRect.Right - FileTypeEditRect.Left; +end; + +procedure TJclOpenDialogFavoritesHook.DialogClose; +begin + inherited DialogClose; + if not IsOpenPictureDialog then + begin + FFavoriteComboBox.Items.Delete(0); + FavoriteFolders.Assign(FFavoriteComboBox.Items); + end; + FFavoritePanel.ParentWindow := 0; + FFavoriteStaticText.ParentWindow := 0; + FParentWnd := 0; +end; + +procedure TJclOpenDialogFavoritesHook.DialogFolderChange; +var + Path: string; +begin + inherited DialogFolderChange; + Path := CurrentFolder; + FFavoriteComboBox.ItemIndex := FFavoriteComboBox.Items.IndexOf(Path); + if FFavoriteComboBox.ItemIndex = -1 then + begin + if Path <> '' then + FFavoriteComboBox.Items[0] := FTextAdd + else + FFavoriteComboBox.Items[0] := FTextVirtual; + FFavoriteComboBox.ItemIndex := 0; + end + else + FFavoriteComboBox.Items[0] := FTextDelete; + FFavoriteComboBox.Invalidate; +end; + +procedure TJclOpenDialogFavoritesHook.DialogShow; +begin + inherited DialogShow; + if not IsOpenPictureDialog then + begin + FFavoritePanel.ParentWindow := FHandle; + FFavoriteStaticText.ParentWindow := FHandle; + FFavoriteComboBox.Items.Assign(FavoriteFolders); + FFavoriteComboBox.Items.Insert(0, FTextAdd); + end; +end; + +procedure TJclOpenDialogFavoritesHook.FavoriteComboBoxClick(Sender: TObject); +var + I: Integer; + Path: string; +begin + if FFavoriteComboBox.ItemIndex = 0 then + begin + Path := CurrentFolder; + I := FFavoriteComboBox.Items.IndexOf(Path); + if I > 0 then + begin + // delete current folder + if MessageBox(FHandle, + PChar(Format(LoadResString(@RsOpenDialogDelConfirm), [Path])), + PChar(LoadResString(@RsOpenDialogConfirmation)), + MB_YESNO or MB_ICONQUESTION or MB_DEFBUTTON2) = ID_YES then + begin + FFavoriteComboBox.Items.Delete(I); + FFavoriteComboBox.Items[0] := FTextAdd; + FFavoriteComboBox.ItemIndex := 0; + end; + end + else + if Path <> '' then + begin + // add current folder + FFavoriteComboBox.ItemIndex := FFavoriteComboBox.Items.Add(Path); + FFavoriteComboBox.Items[0] := FTextDelete; + end; + FFavoriteComboBox.Invalidate; + end + else + if FFavoriteComboBox.ItemIndex > 0 then + // switch to selected folder + CurrentFolder := FFavoriteComboBox.Items[FFavoriteComboBox.ItemIndex]; +end; +{$ENDIF OLDSTYLE} + +{$IFDEF NEWSTYLE} +procedure TJclOpenDialogFavoritesHook.FileDialogCreate( + const AFileDialog: IFileDialog); +var + FileDialogCustomize: IFileDialogCustomize; + Unused: Cardinal; +begin + inherited FileDialogCreate(AFileDialog); + FComboboxListItem := False; + FComboboxAddItem := False; + FComboboxDeleteItem := False; + FComboboxVirtualItem := False; + FComboboxCount := 0; + + FileDialogCustomize := AFileDialog as IFileDialogCustomize; + //CheckOSError(FileDialogCustomize.StartVisualGroup(CTRLID_GROUP, PWideChar(WideString(LoadResString(@RsOpenDialogFavorites))))); + CheckOSError(FileDialogCustomize.AddComboBox(CTRLID_COMBOBOX)); + //CheckOSError(FileDialogCustomize.EndVisualGroup); + CheckOSError(FileDialogCustomize.MakeProminent(CTRLID_COMBOBOX)); + CheckOSError(AFileDialog.Advise(Self, Unused)); +end; + +procedure TJclOpenDialogFavoritesHook.FileDialogCleanCombobox( + const AFileDialogCustomize: IFileDialogCustomize); +var + I: Integer; +begin + if FComboboxListItem then + CheckOSError(AFileDialogCustomize.RemoveControlItem(CTRLID_COMBOBOX, ITEMID_LIST)); + FComboboxListItem := False; + if FComboboxAddItem then + CheckOSError(AFileDialogCustomize.RemoveControlItem(CTRLID_COMBOBOX, ITEMID_ADD)); + FComboboxAddItem := False; + if FComboboxDeleteItem then + CheckOSError(AFileDialogCustomize.RemoveControlItem(CTRLID_COMBOBOX, ITEMID_DELETE)); + FComboboxDeleteItem := False; + if FComboboxVirtualItem then + CheckOSError(AFileDialogCustomize.RemoveControlItem(CTRLID_COMBOBOX, ITEMID_VIRTUAL)); + FComboboxVirtualItem := False; + for I := 0 to FComboboxCount - 1 do + CheckOSError(AFileDialogCustomize.RemoveControlItem(CTRLID_COMBOBOX, I)); + FComboboxCount := 0; +end; + +procedure TJclOpenDialogFavoritesHook.FileDialogFillCombobox( + const AFileDialogCustomize: IFileDialogCustomize; ListItem, AddItem, DeleteItem, VirtualItem: Boolean); +var + I: Integer; +begin + if ListItem then + CheckOSError(AFileDialogCustomize.AddControlItem(CTRLID_COMBOBOX, ITEMID_LIST, PWideChar(WideString(FTextList)))); + FComboboxListItem := ListItem; + if AddItem then + CheckOSError(AFileDialogCustomize.AddControlItem(CTRLID_COMBOBOX, ITEMID_ADD, PWideChar(WideString(FTextAdd)))); + FComboboxAddItem := AddItem; + if DeleteItem then + CheckOSError(AFileDialogCustomize.AddControlItem(CTRLID_COMBOBOX, ITEMID_DELETE, PWideChar(WideString(FTextDelete)))); + FComboboxDeleteItem := DeleteItem; + if VirtualItem then + CheckOSError(AFileDialogCustomize.AddControlItem(CTRLID_COMBOBOX, ITEMID_VIRTUAL, PWideChar(WideString(FTextVirtual)))); + FComboboxVirtualItem := VirtualItem; + FComboboxCount := FFavoriteFolders.Count; + for I := 0 to FComboboxCount - 1 do + CheckOSError(AFileDialogCustomize.AddControlItem(CTRLID_COMBOBOX, I, PWideChar(WideString(FFavoriteFolders.Strings[I])))); +end; +{$ENDIF NEWSTYLE} + +procedure TJclOpenDialogFavoritesHook.LoadFavorites(const FileName: string); +begin + if FileExists(FileName) then + FavoriteFolders.LoadFromFile(FileName) + else + FavoriteFolders.Clear; +end; + +{$IFDEF NEWSTYLE} +function TJclOpenDialogFavoritesHook.OnButtonClicked( + const pfdc: IFileDialogCustomize; dwIDCtl: DWORD): HResult; +begin + Result := S_OK; +end; + +function TJclOpenDialogFavoritesHook.OnCheckButtonToggled( + const pfdc: IFileDialogCustomize; dwIDCtl: DWORD; bChecked: BOOL): HResult; +begin + Result := S_OK; +end; + +function TJclOpenDialogFavoritesHook.OnControlActivating( + const pfdc: IFileDialogCustomize; dwIDCtl: DWORD): HResult; +begin + Result := S_OK; +end; + +function TJclOpenDialogFavoritesHook.OnFileOk(const pfd: IFileDialog): HResult; +begin + Result := S_OK; +end; + +function TJclOpenDialogFavoritesHook.OnFolderChange( + const pfd: IFileDialog): HResult; +var + pfdc: IFileDialogCustomize; + ppsi: IShellItem; + Path: PWideChar; + ItemIndex: Integer; +begin + Result := S_OK; + pfdc := pfd as IFileDialogCustomize; + CheckOSError(pfd.GetFolder(ppsi)); + if not Succeeded(ppsi.GetDisplayName(SIGDN_FILESYSPATH, Path)) then + Path := nil; + ItemIndex := FFavoriteFolders.IndexOf(Path); + if ItemIndex = -1 then + begin + if Path <> '' then + begin + FileDialogCleanCombobox(pfdc); + FileDialogFillCombobox(pfdc, True, True, False, False); + CheckOSError(pfdc.SetSelectedControlItem(CTRLID_COMBOBOX, ITEMID_LIST)); + end + else + begin + FileDialogCleanCombobox(pfdc); + FileDialogFillCombobox(pfdc, False, False, False, True); + CheckOSError(pfdc.SetSelectedControlItem(CTRLID_COMBOBOX, ITEMID_VIRTUAL)); + end; + end + else + begin + FileDialogCleanCombobox(pfdc); + FileDialogFillCombobox(pfdc, False, False, True, False); + CheckOSError(pfdc.SetSelectedControlItem(CTRLID_COMBOBOX, ItemIndex)); + end; +end; + +function TJclOpenDialogFavoritesHook.OnFolderChanging(const pfd: IFileDialog; + const psiFolder: IShellItem): HResult; +begin + Result := S_OK; +end; + +function TJclOpenDialogFavoritesHook.OnItemSelected( + const pfdc: IFileDialogCustomize; dwIDCtl, dwIDItem: DWORD): HResult; +var + I: Integer; + pfd: IFileDialog; + ppsi: IShellItem; + Path: PWideChar; +begin + Result := S_OK; + if dwIDCtl = CTRLID_COMBOBOX then + begin + pfd := pfdc as IFileDialog; + CheckOSError(pfd.GetFolder(ppsi)); + if not Succeeded(ppsi.GetDisplayName(SIGDN_FILESYSPATH, Path)) then + Path := nil; + if dwIDItem = ITEMID_DELETE then + begin + I := FFavoriteFolders.IndexOf(Path); + if I >= 0 then + begin + // delete current folder + if MessageBox(0, + PChar(Format(LoadResString(@RsOpenDialogDelConfirm), [Path])), + PChar(LoadResString(@RsOpenDialogConfirmation)), + MB_YESNO or MB_ICONQUESTION or MB_DEFBUTTON2) = ID_YES then + begin + FFavoriteFolders.Delete(I); + FileDialogCleanCombobox(pfdc); + FileDialogFillCombobox(pfdc, True, True, False, False); + CheckOSError(pfdc.SetSelectedControlItem(CTRLID_COMBOBOX, ITEMID_LIST)); + end; + end; + end + else + if dwIDItem = ITEMID_ADD then + begin + if Path <> '' then + begin + // add current folder + I := FFavoriteFolders.Add(Path); + FileDialogCleanCombobox(pfdc); + FileDialogFillCombobox(pfdc, False, False, True, False); + CheckOSError(pfdc.SetSelectedControlItem(CTRLID_COMBOBOX, I)); + end; + end + else + //if dwIDItem >= 0 then + begin + // switch to selected folder + CheckOSError(SHCreateItemFromParsingName(PWideChar(WideString(FFavoriteFolders.Strings[dwIDItem])), nil, IShellItem, ppsi)); + CheckOSError(pfd.SetFolder(ppsi)); + FileDialogCleanCombobox(pfdc); + FileDialogFillCombobox(pfdc, False, False, True, False); + CheckOSError(pfdc.SetSelectedControlItem(CTRLID_COMBOBOX, dwIDItem)); + end; + end; +end; + +function TJclOpenDialogFavoritesHook.OnOverwrite(const pfd: IFileDialog; + const psi: IShellItem; out pResponse: DWORD): HResult; +begin + Result := S_OK; +end; + +function TJclOpenDialogFavoritesHook.OnSelectionChange( + const pfd: IFileDialog): HResult; +begin + Result := S_OK; +end; + +function TJclOpenDialogFavoritesHook.OnShareViolation(const pfd: IFileDialog; + const psi: IShellItem; out pResponse: DWORD): HResult; +begin + Result := S_OK; +end; + +function TJclOpenDialogFavoritesHook.OnTypeChange( + const pfd: IFileDialog): HResult; +begin + Result := S_OK; +end; + +function TJclOpenDialogFavoritesHook.QueryInterface(const IID: TGUID; + out Obj): HResult; +begin + if GetInterface(IID, Obj) then + Result := 0 + else + Result := E_NOINTERFACE; +end; + +function TJclOpenDialogFavoritesHook._AddRef: Integer; +begin + Result := -1; +end; + +function TJclOpenDialogFavoritesHook._Release: Integer; +begin + Result := -1; +end; +{$ENDIF NEWSTYLE} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/vcl/JclOpenDialogHooks.pas b/3rdParty/JCL/source/vcl/JclOpenDialogHooks.pas new file mode 100644 index 00000000..4e4b04e0 --- /dev/null +++ b/3rdParty/JCL/source/vcl/JclOpenDialogHooks.pas @@ -0,0 +1,603 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is OpenDlgFavAdapter.pas. } +{ } +{ The Initial Developer of the Original Code is Petr Vones. } +{ Portions created by Petr Vones are Copyright (C) Petr Vones. All rights reserved. } +{ } +{ Contributor(s): } +{ Salvatore Besso } +{ Florent Ouchet (move to JCL runtime) } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclOpenDialogHooks; + +interface + +{$I jcl.inc} +{$I windowsonly.inc} + +uses + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, Winapi.Messages, Winapi.ShlObj, System.Classes, System.SysUtils, + Vcl.Controls, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Dialogs, Vcl.Forms, + {$ELSE ~HAS_UNITSCOPE} + Windows, Messages, ShlObj, Classes, SysUtils, Controls, StdCtrls, ExtCtrls, + Dialogs, Forms, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclBase, JclPeImage, JclWin32; + +// old-style open dialogs are supported by all versions of Delphi +{$DEFINE OLDSTYLE} + +// new-style file dialogs are supported by Delphi 2007 and newer +// it is disabled in D2007, because the D2006 RTL does not support it at all +{$IFDEF RTL200_UP} +{$DEFINE NEWSTYLE} +{$ENDIF RTL200_UP} + +type + EJclOpenDialogHookError = class(EJclError); + + {$IFDEF NEWSTYLE} + TJclFileOpenDialogHook = class (TFileOpenDialog) + strict protected + function CreateFileDialog: IFileDialog; override; + public + class procedure InstallHook(out OldHandler: Pointer); + class procedure UninstallHook(OldHandler: Pointer); + end; + + TJclFileSaveDialogHook = class (TFileSaveDialog) + strict protected + function CreateFileDialog: IFileDialog; override; + public + class procedure InstallHook(out OldHandler: Pointer); + class procedure UninstallHook(OldHandler: Pointer); + end; + {$ENDIF NEWSTYLE} + + TJclOpenDialogHook = class (TObject) + {$IFDEF OLDSTYLE} + private + FDisableHelpButton: Boolean; + FDisablePlacesBar: Boolean; + FHooks: TJclPeMapImgHooks; + FIsOpenPictureDialog: Boolean; + FParentWndInstance: Pointer; + FOldParentWndInstance: Pointer; + FPictureDialogLastFolder: string; + FWndInstance: Pointer; + FOldWndInstance: Pointer; + FOnClose: TNotifyEvent; + FOnShow: TNotifyEvent; + function GetCurrentFolder: string; + function GetFileNameEditWnd: HWND; + procedure SetCurrentFolder(const Value: string); + protected + FHandle: HWND; + FParentWnd: HWND; + procedure DialogAdjustControlPos; virtual; + procedure DialogFolderChange; virtual; + procedure DialogShow; virtual; + procedure DialogClose; virtual; + procedure DoClose; + procedure DoShow; + procedure ParentWndProc(var Message: TMessage); virtual; + procedure WndProc(var Message: TMessage); virtual; + property FileNameEditWnd: HWND read GetFileNameEditWnd; + public + property CurrentFolder: string read GetCurrentFolder write SetCurrentFolder; + property DisableHelpButton: Boolean read FDisableHelpButton write FDisableHelpButton; + property DisablePlacesBar: Boolean read FDisablePlacesBar write FDisablePlacesBar; + property IsOpenPictureDialog: Boolean read FIsOpenPictureDialog; + property PictureDialogLastFolder: string read FPictureDialogLastFolder write FPictureDialogLastFolder; + property OnClose: TNotifyEvent read FOnClose write FOnClose; + property OnShow: TNotifyEvent read FOnShow write FOnShow; + {$ENDIF OLDSTYLE} + {$IFDEF NEWSTYLE} + private + FOldFileOpenCreateFileDialog: Pointer; + FOldFileSaveCreateFileDialog: Pointer; + protected + procedure FileDialogCreate(const AFileDialog: IFileDialog); virtual; + {$ENDIF NEWSTYLE} + public + constructor Create; virtual; + destructor Destroy; override; + procedure HookDialogs; + procedure UnhookDialogs; + end; + + TJclOpenDialogHookClass = class of TJclOpenDialogHook; + +function InitializeOpenDialogHook(OpenDialogHookClass: TJclOpenDialogHookClass): TJclOpenDialogHook; +procedure FinalizeOpenDialogHook; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\vcl'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + Winapi.CommDlg, Winapi.Dlgs, + {$ELSE ~HAS_UNITSCOPE} + CommDlg, Dlgs, + {$ENDIF ~HAS_UNITSCOPE} + JclFileUtils, JclStrings, JclSysInfo, JclSysUtils, + JclVclResources; + +{$R JclOpenDialog.res} + +var + GlobalOpenDialogHook: TJclOpenDialogHook; + +{$IFDEF OLDSTYLE} +const + OpenDialogTemplateName = 'JCLOPENDLGHOOK'; + OpenPictureDialogTemplateName = 'DLGTEMPLATE'; + +type + TGetOpenFileName = function (var OpenFile: TOpenFilename): Bool; stdcall; + +var + OldGetOpenFileName: TGetOpenFileName; + OldGetSaveFileName: TGetOpenFileName; + OldExplorerHook: function(Wnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): {$IFDEF RTL230_UP}UINT_PTR{$ELSE}UINT{$ENDIF RTL230_UP}; stdcall; + +function NewExplorerHook(Wnd: HWnd; Msg: UINT; WParam: WPARAM; LParam: LPARAM): {$IFDEF RTL230_UP}UINT_PTR{$ELSE}UINT{$ENDIF RTL230_UP}; stdcall; +begin + Result := OldExplorerHook(Wnd, Msg, WParam, LParam); + if (Msg = WM_INITDIALOG) and Assigned(GlobalOpenDialogHook) then + begin + GlobalOpenDialogHook.FHandle := Wnd; + GlobalOpenDialogHook.FOldWndInstance := Pointer(SetWindowLongPtr(Wnd, GWLP_WNDPROC, LONG_PTR(GlobalOpenDialogHook.FWndInstance))); + CallWindowProc(GlobalOpenDialogHook.FWndInstance, Wnd, Msg, WParam, LParam); + end; +end; + +procedure InitOpenFileStruct(var OpenFile: TOpenFilename); +var + InitDir: string; +begin + with OpenFile do + if Flags and OFN_EXPLORER <> 0 then + begin + if Assigned(GlobalOpenDialogHook) then + GlobalOpenDialogHook.FIsOpenPictureDialog := False; + if Flags and OFN_ENABLETEMPLATE = 0 then + begin + OldExplorerHook := lpfnHook; + lpfnHook := NewExplorerHook; + lpTemplateName := OpenDialogTemplateName; + hInstance := FindResourceHInstance(FindClassHInstance(GlobalOpenDialogHook.ClassType)); + Flags := Flags or OFN_ENABLETEMPLATE; + if Assigned(GlobalOpenDialogHook) then + begin + if GlobalOpenDialogHook.DisableHelpButton then + Flags := Flags and (not OFN_SHOWHELP); + if GlobalOpenDialogHook.DisablePlacesBar and (lStructSize = SizeOf(TOpenFilename)) then + FlagsEx := FlagsEx or OFN_EX_NOPLACESBAR; + end; + end + else + if (StrIComp(lpTemplateName, OpenPictureDialogTemplateName) = 0) and Assigned(GlobalOpenDialogHook) then + begin + GlobalOpenDialogHook.FIsOpenPictureDialog := True; + OldExplorerHook := lpfnHook; + lpfnHook := NewExplorerHook; + InitDir := GlobalOpenDialogHook.PictureDialogLastFolder; + if DirectoryExists(InitDir) then + lpstrInitialDir := PChar(GlobalOpenDialogHook.PictureDialogLastFolder) + else + GlobalOpenDialogHook.PictureDialogLastFolder := ''; + end; + end; +end; + +function NewGetOpenFileName(var OpenFile: TOpenFilename): Bool; stdcall; +begin + InitOpenFileStruct(OpenFile); + Result := OldGetOpenFileName(OpenFile); +end; + +function NewGetSaveFileName(var OpenFile: TOpenFilename): Bool; stdcall; +begin + InitOpenFileStruct(OpenFile); + Result := OldGetSaveFileName(OpenFile); +end; +{$ENDIF OLDSTYLE} + +function InitializeOpenDialogHook(OpenDialogHookClass: TJclOpenDialogHookClass): TJclOpenDialogHook; +begin + if Assigned(GlobalOpenDialogHook) then + begin + if GlobalOpenDialogHook.ClassType <> OpenDialogHookClass then + raise EJclOpenDialogHookError.CreateResFmt(@RsEOpenDialogHookExists, [GlobalOpenDialogHook.ClassName]); + end + else + GlobalOpenDialogHook := OpenDialogHookClass.Create; + Result := GlobalOpenDialogHook; +end; + +procedure FinalizeOpenDialogHook; +begin + FreeAndNil(GlobalOpenDialogHook); +end; + +//=== { TJclFileOpenDialogHook } ============================================= + +{$IFDEF NEWSTYLE} +function TJclFileOpenDialogHook.CreateFileDialog: IFileDialog; +begin + Result := inherited CreateFileDialog; + GlobalOpenDialogHook.FileDialogCreate(Result); +end; + +class procedure TJclFileOpenDialogHook.InstallHook(out OldHandler: Pointer); + + function GetActualAddr(Proc: Pointer): Pointer; + type + {$IFDEF CPUX64} + PAbsoluteIndirectJmp64 = ^TAbsoluteIndirectJmp64; + TAbsoluteIndirectJmp64 = packed record + OpCode: Word; //$FF25(Jmp, FF /4) + Rel: Integer; + end; + {$ELSE} + PAbsoluteIndirectJmp32 = ^TAbsoluteIndirectJmp32; + TAbsoluteIndirectJmp32 = packed record + OpCode: Word; //$FF25(Jmp, FF /4) + Addr: ^Pointer; + end; + {$ENDIF CPUX64} + begin + Result := Proc; + if Result <> nil then + begin + {$IFDEF CPUX64} + if PAbsoluteIndirectJmp64(Result).OpCode = $25FF then + Result := PPointer(PByte(@PAbsoluteIndirectJmp64(Result).OpCode) + + SizeOf(TAbsoluteIndirectJmp64) + PAbsoluteIndirectJmp64(Result).Rel)^; + {$ELSE} + if (Win32Platform = VER_PLATFORM_WIN32_NT) then + if PAbsoluteIndirectJmp32(Result).OpCode = $25FF then + Result := PAbsoluteIndirectJmp32(Result).Addr^; + {$ENDIF CPUX64} + end; + end; + +var + I: Integer; + P: Pointer; +begin + P := GetActualAddr(@TFileOpenDialog.CreateFileDialog); + for I := 0 to GetVirtualMethodCount(TFileOpenDialog) - 1 do + begin + OldHandler := GetActualAddr(GetVirtualMethod(TFileOpenDialog, I)); + if OldHandler = P then + begin + SetVirtualMethod(TFileOpenDialog, I, @TJclFileOpenDialogHook.CreateFileDialog); + Exit; + end; + end; + OldHandler := nil; +end; + +class procedure TJclFileOpenDialogHook.UninstallHook(OldHandler: Pointer); +var + I: Integer; +begin + for I := 0 to GetVirtualMethodCount(TFileOpenDialog) - 1 do + if GetVirtualMethod(TFileOpenDialog, I) = @TJclFileOpenDialogHook.CreateFileDialog then + begin + SetVirtualMethod(TFileOpenDialog, I, OldHandler); + Break; + end; +end; +{$ENDIF NEWSTYLE} + +//=== { TJclFileSaveDialogHook } ============================================= + +{$IFDEF NEWSTYLE} +function TJclFileSaveDialogHook.CreateFileDialog: IFileDialog; +begin + Result := inherited CreateFileDialog; + GlobalOpenDialogHook.FileDialogCreate(Result); +end; + +class procedure TJclFileSaveDialogHook.InstallHook(out OldHandler: Pointer); +var + I: Integer; +begin + for I := 0 to GetVirtualMethodCount(TFileSaveDialog) - 1 do + begin + OldHandler := GetVirtualMethod(TFileSaveDialog, I); + if OldHandler = @TFileSaveDialog.CreateFileDialog then + begin + SetVirtualMethod(TFileSaveDialog, I, @TJclFileSaveDialogHook.CreateFileDialog); + Exit; + end; + end; + OldHandler := nil; +end; + +class procedure TJclFileSaveDialogHook.UninstallHook(OldHandler: Pointer); +var + I: Integer; +begin + for I := 0 to GetVirtualMethodCount(TFileSaveDialog) - 1 do + if GetVirtualMethod(TFileSaveDialog, I) = @TJclFileSaveDialogHook.CreateFileDialog then + begin + SetVirtualMethod(TFileSaveDialog, I, OldHandler); + Break; + end; +end; +{$ENDIF NEWSTYLE} + +//=== { TJclOpenDialogHook } ================================================= + +constructor TJclOpenDialogHook.Create; +begin + inherited Create; + {$IFDEF OLDSTYLE} + FHooks := TJclPeMapImgHooks.Create; + FParentWndInstance := MakeObjectInstance(ParentWndProc); + FWndInstance := MakeObjectInstance(WndProc); + {$ENDIF OLDSTYLE} +end; + +destructor TJclOpenDialogHook.Destroy; +begin + UnhookDialogs; + {$IFDEF OLDSTYLE} + FreeObjectInstance(FParentWndInstance); + FreeObjectInstance(FWndInstance); + FreeAndNil(FHooks); + {$ENDIF OLDSTYLE} + inherited Destroy; +end; + +{$IFDEF OLDSTYLE} +procedure TJclOpenDialogHook.DialogAdjustControlPos; +begin + // override to customize +end; + +procedure TJclOpenDialogHook.DialogClose; +begin + // override to customize +end; + +procedure TJclOpenDialogHook.DialogFolderChange; +begin + // override to customize +end; + +procedure TJclOpenDialogHook.DialogShow; +begin + // override to customize + FParentWnd := GetParent(FHandle); + if JclCheckWinVersion(5, 0) then // Win2k or newer + FOldParentWndInstance := Pointer(SetWindowLongPtr(FParentWnd, GWLP_WNDPROC, LONG_PTR(FParentWndInstance))); + DoShow; +end; + +procedure TJclOpenDialogHook.DoClose; +begin + if Assigned(FOnClose) then + FOnClose(Self); +end; + +procedure TJclOpenDialogHook.DoShow; +begin + if Assigned(FOnShow) then + FOnShow(Self); +end; +{$ENDIF OLDSTYLE} + +{$IFDEF NEWSTYLE} +procedure TJclOpenDialogHook.FileDialogCreate(const AFileDialog: IFileDialog); +begin + // override to customize +end; +{$ENDIF NEWSTYLE} + +{$IFDEF OLDSTYLE} +function TJclOpenDialogHook.GetCurrentFolder: string; +var + Path: array [0..MAX_PATH] of Char; +begin + SetString(Result, Path, SendMessage(FParentWnd, CDM_GETFOLDERPATH, Length(Path), LPARAM(@Path))); + StrResetLength(Result); +end; + +function TJclOpenDialogHook.GetFileNameEditWnd: HWND; +begin + Result := GetDlgItem(FParentWnd, edt1); + if Result = 0 then + Result := GetDlgItem(FParentWnd, cmb13); +end; +{$ENDIF OLDSTYLE} + +procedure TJclOpenDialogHook.HookDialogs; +{$IFDEF OLDSTYLE} + procedure HookImportsForModule(ModuleBase: Pointer); + const + comdlg32 = 'comdlg32.dll'; + begin + if ModuleBase <> nil then + begin + {$IFDEF UNICODE} + FHooks.HookImport(ModuleBase, comdlg32, 'GetOpenFileNameW', @NewGetOpenFileName, @OldGetOpenFileName); + FHooks.HookImport(ModuleBase, comdlg32, 'GetSaveFileNameW', @NewGetSaveFileName, @OldGetSaveFileName); + {$ELSE} + FHooks.HookImport(ModuleBase, comdlg32, 'GetOpenFileNameA', @NewGetOpenFileName, @OldGetOpenFileName); + FHooks.HookImport(ModuleBase, comdlg32, 'GetSaveFileNameA', @NewGetSaveFileName, @OldGetSaveFileName); + {$ENDIF UNICODE} + end; + end; +var + Pe: TJclPeImage; + I: Integer; + HookedModule: LongWord; +{$ENDIF OLDSTYLE} +begin + try + {$IFDEF OLDSTYLE} + { TODO : Hook all loaded modules } + Pe := TJclPeImage.Create(True); + try + HookedModule := FindClassHInstance(ClassType); + Pe.AttachLoadedModule(HookedModule); + if Pe.StatusOK then + begin + HookImportsForModule(Pointer(HookedModule)); + for I := 0 to Pe.ImportList.UniqueLibItemCount - 1 do + HookImportsForModule(Pointer(GetModuleHandle(PChar(Pe.ImportList.UniqueLibItems[I].FileName)))); + end; + finally + Pe.Free; + end; + {$ENDIF OLDSTYLE} + {$IFDEF NEWSTYLE} + TJclFileOpenDialogHook.InstallHook(FOldFileOpenCreateFileDialog); + TJclFileSaveDialogHook.InstallHook(FOldFileSaveCreateFileDialog); + {$ENDIF NEWSTYLE} + except + Application.HandleException(Self); + end; +end; + +{$IFDEF OLDSTYLE} +procedure TJclOpenDialogHook.ParentWndProc(var Message: TMessage); +begin + with Message do + begin + Result := CallWindowProc(FOldParentWndInstance, FParentWnd, Msg, WParam, LParam); + if Msg = WM_SIZE then + DialogAdjustControlPos; + end; +end; + +procedure TJclOpenDialogHook.SetCurrentFolder(const Value: string); +var + LastFocus: HWND; + FileNameBuffer: string; +begin + if (FParentWnd <> 0) and DirectoryExists(Value) then + begin + LastFocus := GetFocus; + FileNameBuffer := GetWindowCaption(FileNameEditWnd); + SendMessage(FParentWnd, CDM_SETCONTROLTEXT, edt1, LPARAM(PChar(Value))); + SendMessage(GetDlgItem(FParentWnd, 1), BM_CLICK, 0, 0); + SendMessage(FParentWnd, CDM_SETCONTROLTEXT, edt1, LPARAM(PChar(FileNameBuffer))); + SetFocus(LastFocus); + end; +end; +{$ENDIF OLDSTYLE} + +procedure TJclOpenDialogHook.UnhookDialogs; +{$IFDEF OLDSTYLE} +var + I: Integer; +{$ENDIF OLDSTYLE} +begin + {$IFDEF OLDSTYLE} + I := 0; + while I < FHooks.Count do + if not FHooks[I].Unhook then + Inc(I); + {$ENDIF OLDSTYLE} + {$IFDEF NEWSTYLE} + TJclFileOpenDialogHook.UninstallHook(FOldFileOpenCreateFileDialog); + TJclFileSaveDialogHook.UninstallHook(FOldFileSaveCreateFileDialog); + {$ENDIF NEWSTYLE} +end; + +{$IFDEF OLDSTYLE} +procedure TJclOpenDialogHook.WndProc(var Message: TMessage); + + procedure Default; + begin + with Message do + Result := CallWindowProc(FOldWndInstance, FHandle, Msg, WParam, LParam); + end; + +begin + if FHandle <> 0 then + begin + case Message.Msg of + WM_NOTIFY: + begin + case (POFNotify(Message.LParam)^.hdr.code) of + CDN_INITDONE: + begin + DialogShow; + DialogAdjustControlPos; + end; + CDN_FOLDERCHANGE: + if not IsOpenPictureDialog then + DialogFolderChange; + CDN_FILEOK: + if IsOpenPictureDialog then + FPictureDialogLastFolder := CurrentFolder; + end; + Default; + end; + WM_NCDESTROY: + begin + Default; + FHandle := 0; + end; + WM_DESTROY: + begin + DialogClose; + DoClose; + end; + else + Default; + end; + end; +end; +{$ENDIF OLDSTYLE} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/vcl/JclPrint.pas b/3rdParty/JCL/source/vcl/JclPrint.pas new file mode 100644 index 00000000..743bbf55 --- /dev/null +++ b/3rdParty/JCL/source/vcl/JclPrint.pas @@ -0,0 +1,1644 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclPrint.pas. } +{ } +{ The Initial Developers of the Original Code are unknown. } +{ Portions created by these individuals are Copyright (C) of these individuals. } +{ All rights reserved. } +{ } +{ The Initial Developer of the function DPSetDefaultPrinter is Microsoft. Portions created by } +{ Microsoft are Copyright (C) 2004 Microsoft Corporation. All Rights Reserved. } +{ } +{ Contributors: } +{ Marcel van Brakel } +{ Matthias Thoma (mthoma) } +{ Karl Ivar Hansen } +{ Martin Cakrt } +{ Jared Davison } +{ } +{**************************************************************************************************} +{ } +{ This unit contains print-related classes and functions. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclPrint; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, System.Classes, Vcl.StdCtrls, Vcl.Printers, System.SysUtils, System.IniFiles, + {$ELSE ~HAS_UNITSCOPE} + Windows, Classes, StdCtrls, Printers, SysUtils, IniFiles, + {$ENDIF ~HAS_UNITSCOPE} + JclBase; + +const + CCHBinName = 24; + CCHPaperName = 64; + CBinMax = 256; + CPaperNames = 256; + +type + PWordArray = ^TWordArray; + TWordArray = array [0..255] of Word; + +type + EJclPrinterError = class(EJclError); + + TJclPrintSet = class(TObject) + private + FDevice: string; + FDriver: string; + FPort: string; + FHandle: THandle; + FPrinter: Integer; + FBinArray: PWordArray; + FNumBins: DWord; + FPaperArray: PWordArray; + FNumPapers: DWord; + FDpiX: Integer; + FiDpiY: Integer; + procedure CheckPrinter; + procedure SetBinArray; + procedure SetPaperArray; + function DefaultPaperName(const PaperID: Word): string; + function GetDevModePrinterDriverVersion: Word; + function GetDevModePrinterDriver: string; + function GetDevModePrinterDriverExtra: TDynByteArray; + function LockDeviceMode: PDeviceMode; + procedure SetDeviceMode(Creating: Boolean); + procedure SetPrinterName(const Value: string); + procedure UnlockDeviceMode; + protected + procedure SetOrientation(Orientation: Integer); + function GetOrientation: Integer; + procedure SetPaperSize(Size: Integer); + function GetPaperSize: Integer; + procedure SetPaperLength(Length: Integer); + function GetPaperLength: Integer; + procedure SetPaperWidth(Width: Integer); + function GetPaperWidth: Integer; + procedure SetScale(Scale: Integer); + function GetScale: Integer; + procedure SetCopies(Copies: Integer); + function GetCopies: Integer; + procedure SetBin(Bin: Integer); + function GetBin: Integer; + procedure SetPrintQuality(Quality: Integer); + function GetPrintQuality: Integer; + procedure SetColor(Color: Integer); + function GetColor: Integer; + procedure SetDuplex(Duplex: Integer); + function GetDuplex: Integer; + procedure SetYResolution(YRes: Integer); + function GetYResolution: Integer; + procedure SetTrueTypeOption(Option: Integer); + function GetTrueTypeOption: Integer; + function GetPrinterName: string; + function GetPrinterPort: string; + function GetPrinterDriver: string; + procedure SetBinFromList(BinNum: Word); + function GetBinIndex: Word; + procedure SetPaperFromList(PaperNum: Word); + function GetPaperIndex: Word; + function ReadFromCustomIni(const PrIniFile: TCustomIniFile; const Section: string): Boolean; + procedure SaveToCustomIni(const PrIniFile: TCustomIniFile; const Section: string); + procedure SetPort(Port: string); + procedure DevModePrinterDriverExtraReinstate(const ExtraData: TDynByteArray; + const ExtraDataDriverName: string; const ExtraDataDriverVersion: Word); + public + constructor Create; virtual; + destructor Destroy; override; + // use the other implementations + //function GetBinSourceList: TStringList; overload; + //function GetPaperList: TStringList; overload; + procedure GetBinSourceList(List: TStrings); overload; + procedure GetPaperList(List: TStrings); overload; + procedure UpdateDeviceMode(const ADeviceMode: PDeviceMode); + procedure SaveToDefaults; + procedure SavePrinterAsDefault; + procedure ResetPrinterDialogs; + function XInchToDot(const Inches: Double): Integer; + function YInchToDot(const Inches: Double): Integer; + function XCmToDot(const Cm: Double): Integer; + function YCmToDot(const Cm: Double): Integer; + function CpiToDot(const Cpi, Chars: Double): Integer; + function LpiToDot(const Lpi, Lines: Double): Integer; + procedure TextOutInch(const X, Y: Double; const Text: string); + procedure TextOutCm(const X, Y: Double; const Text: string); + procedure TextOutCpiLpi(const Cpi, Chars, Lpi, Lines: Double; const Text: string); + procedure CustomPageSetup(const Width, Height: Double); + procedure DevModePrinterDriverExtraClear; + procedure SaveToIniFile(const IniFileName, Section: string); virtual; + function ReadFromIniFile(const IniFileName, Section: string): Boolean; virtual; + property Orientation: Integer read GetOrientation write SetOrientation; + property PaperSize: Integer read GetPaperSize write SetPaperSize; + property PaperLength: Integer read GetPaperLength write SetPaperLength; + property PaperWidth: Integer read GetPaperWidth write SetPaperWidth; + property Scale: Integer read GetScale write SetScale; + property Copies: Integer read GetCopies write SetCopies; + property DefaultSource: Integer read GetBin write SetBin; + property PrintQuality: Integer read GetPrintQuality write SetPrintQuality; + property Color: Integer read GetColor write SetColor; + property Duplex: Integer read GetDuplex write SetDuplex; + property YResolution: Integer read GetYResolution write SetYResolution; + property TrueTypeOption: Integer read GetTrueTypeOption write SetTrueTypeOption; + property PrinterName: string read GetPrinterName write SetPrinterName; + property PrinterPort: string read GetPrinterPort write SetPort; + property PrinterDriver: string read GetPrinterDriver; + property BinIndex: Word read GetBinIndex write SetBinFromList; + property DevModePrinterDriverVersion: Word read GetDevModePrinterDriverVersion; + property DevModePrinterDriver: string read GetDevModePrinterDriver; + property DevModePrinterDriverExtra: TDynByteArray read + GetDevModePrinterDriverExtra; + property PaperIndex: Word read GetPaperIndex write SetPaperFromList; + property DpiX: Integer read FDpiX write FDpiX; + property DpiY: Integer read FiDpiY write FiDpiY; + end; + + TPrinterData = {$IFDEF SUPPORTS_UNICODE_STRING}RawByteString{$ELSE}AnsiString{$ENDIF}; + +procedure DirectPrint(const Printer: string; const Data: TPrinterData; + const DocumentName: string = ''); +procedure SetPrinterPixelsPerInch; +function GetPrinterResolution: TPoint; +function CharFitsWithinDots(const Text: string; const Dots: Integer): Integer; +//procedure PrintTextRotation(X, Y: Integer; Rotation: Word; Text: string); +procedure PrintMemo(const Memo: TMemo; const Rect: TRect); + +function GetDefaultPrinterName: string; +function DPGetDefaultPrinter(out PrinterName: string): Boolean; +function DPSetDefaultPrinter(const PrinterName: string): Boolean; + +procedure GetPrinterDetails(APrinter: TPrinter; var ADevice, ADriver, APort: string; var ADeviceMode: THandle); + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\vcl'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + Vcl.Graphics, Winapi.Messages, Winapi.WinSpool, + {$ELSE ~HAS_UNITSCOPE} + Graphics, Messages, WinSpool, + {$ENDIF ~HAS_UNITSCOPE} + JclSysInfo, JclVclResources; + +const + PrintIniPrinterName = 'PrinterName'; + PrintIniPrinterPort = 'PrinterPort'; + PrintIniOrientation = 'Orientation'; + PrintIniPaperSize = 'PaperSize'; + PrintIniPaperLength = 'PaperLength'; + PrintIniPaperWidth = 'PaperWidth'; + PrintIniScale = 'Scale'; + PrintIniCopies = 'Copies'; + PrintIniDefaultSource = 'DefaultSource'; + PrintIniPrintQuality = 'PrintQuality'; + PrintIniColor = 'Color'; + PrintIniDuplex = 'Duplex'; + PrintIniYResolution = 'YResolution'; + PrintIniTTOption = 'TTOption'; + + PrintDriverExtraSize = 'DriverExtraSize'; + PrintDriverExtraData = 'DriverExtraData'; + PrintDriverVersion = 'DriverVersion'; + PrintDriverName = 'DriverName'; + + cWindows: PChar = 'windows'; + cDevice = 'device'; + cPrintSpool = 'winspool.drv'; + +// Misc. functions +procedure DirectPrint(const Printer: string; const Data: TPrinterData; const DocumentName: string); +const + cRaw = 'RAW'; +type + TDoc_Info_1 = record + DocName: PChar; + OutputFile: PChar; + Datatype: PChar; + end; +var + PrinterHandle: THandle; + DocInfo: TDoc_Info_1; + BytesWritten: Cardinal; + Count: Cardinal; + Defaults: TPrinterDefaults; +begin + // Defaults added for network printers. Supposedly the last member is ignored + // by Windows 9x but is necessary for Windows NT. Code was copied from a msg + // by Alberto Toledo to the C++ Builder techlist and fwd by Theo Bebekis. + Defaults.pDatatype := cRaw; + Defaults.pDevMode := nil; + Defaults.DesiredAccess := PRINTER_ACCESS_USE; + Count := Length(Data); + if not OpenPrinter(PChar(Printer), PrinterHandle, @Defaults) then + raise EJclPrinterError.CreateRes(@RsInvalidPrinter); + // Fill in the structure with info about this "document" + if DocumentName = '' then + DocInfo.DocName := PChar(LoadResString(@RsSpoolerDocName)) + else + DocInfo.DocName := PChar(DocumentName); + DocInfo.OutputFile := nil; + DocInfo.Datatype := cRaw; + try + // Inform the spooler the document is beginning + if StartDocPrinter(PrinterHandle, 1, @DocInfo) = 0 then + EJclPrinterError.CreateRes(@RsNAStartDocument); + try + // Start a page + if not StartPagePrinter(PrinterHandle) then + EJclPrinterError.CreateRes(@RsNAStartPage); + try + // Send the data to the printer + if not WritePrinter(PrinterHandle, PAnsiChar(Data), Count * SizeOf(AnsiChar), BytesWritten) then + EJclPrinterError.CreateRes(@RsNASendData); + finally + // End the page + if not EndPagePrinter(PrinterHandle) then + EJclPrinterError.CreateRes(@RsNAEndPage); + end; + finally + // Inform the spooler that the document is ending + if not EndDocPrinter(PrinterHandle) then + EJclPrinterError.CreateRes(@RsNAEndDocument); + end; + finally + // Tidy up the printer handle + ClosePrinter(PrinterHandle); + end; + // Check to see if correct number of bytes written + if BytesWritten <> Count * SizeOf(AnsiChar) then + EJclPrinterError.CreateRes(@RsNATransmission); +end; + +procedure SetPrinterPixelsPerInch; +var + FontSize: Integer; +begin + FontSize := Printer.Canvas.Font.Size; + Printer.Canvas.Font.PixelsPerInch := GetDeviceCaps(Printer.Handle, LogPixelsY); + Printer.Canvas.Font.Size := FontSize; +end; + +function GetPrinterResolution: TPoint; +begin + Result.X := GetDeviceCaps(Printer.Handle, LogPixelsX); + Result.Y := GetDeviceCaps(Printer.Handle, LogPixelsY); +end; + +function CharFitsWithinDots(const Text: string; const Dots: Integer): Integer; +begin + Result := Length(Text); + while (Result > 0) and (Printer.Canvas.TextWidth(Copy(Text, 1, Result)) > Dots) do + Dec(Result); +end; + +//WIMDC: The function CanvasTextOutRotation contains a bug in DxGraphics so no need to +// implement it right now here +(* +procedure PrintTextRotation(X, Y: Integer; Rotation: Word; Text: string); +begin + CanvasTextOutRotation(Printer.Canvas, X, Y, Rotation, Text); +end; +*) + +//WIMDC took the function from DXGraphics and replaced some lines to work with the TStrings class +// of the memo. + +procedure CanvasMemoOut(Canvas: TCanvas; Memo: TMemo; Rect: TRect); +var + MemoText: PChar; +begin + MemoText := Memo.Lines.GetText; + if MemoText <> nil then + try + DrawText(Canvas.Handle, MemoText, StrLen(MemoText), Rect, + DT_LEFT or DT_EXPANDTABS or DT_WORDBREAK); + finally + StrDispose(MemoText); + end; +end; + +procedure PrintMemo(const Memo: TMemo; const Rect: TRect); +begin + CanvasMemoOut(Printer.Canvas, Memo, Rect); +end; + +function GetDefaultPrinterName: string; +begin + DPGetDefaultPrinter(Result); +end; + +{ TODO -cHelp : DPGetDefaultPrinter, Author: Microsoft } +// DPGetDefaultPrinter +// Parameters: +// PrinterName: Return the printer name. +// Returns: True for success, False for failure. + +// Source of the original code: Microsoft Knowledge Base Article - 246772 +// http://support.microsoft.com/default.aspx?scid=kb;en-us;246772 +function DPGetDefaultPrinter(out PrinterName: string): Boolean; +const + BUFSIZE = 8192; +type + TGetDefaultPrinter = function(Buffer: PChar; var Size: DWORD): BOOL; stdcall; +var + Needed, Returned: DWORD; + PI2: PPrinterInfo2; + WinVer: TWindowsVersion; + hWinSpool: HMODULE; + GetDefPrint: TGetDefaultPrinter; + Size: DWORD; +begin + Result := False; + PrinterName := ''; + WinVer := GetWindowsVersion; + // Windows 9x uses EnumPrinters + if WinVer in [wvWin95, wvWin95OSR2, wvWin98, wvWin98SE, wvWinME] then + begin + SetLastError(0); + Result := EnumPrinters(PRINTER_ENUM_DEFAULT, nil, 2, nil, 0, Needed, Returned); + if not Result and ((GetLastError <> ERROR_INSUFFICIENT_BUFFER) or (Needed = 0)) then + Exit; + GetMem(PI2, Needed); + try + Result := EnumPrinters(PRINTER_ENUM_DEFAULT, nil, 2, PI2, Needed, Needed, Returned); + if Result then + PrinterName := PI2^.pPrinterName; + finally + FreeMem(PI2); + end; + end + else + // Win NT uses WIN.INI (registry) + if WinVer in [wvWinNT31, wvWinNT35, wvWinNT351, wvWinNT4] then + begin + SetLength(PrinterName, BUFSIZE); + Result := GetProfileString(cWindows, cDevice, ',,,', PChar(PrinterName), BUFSIZE) > 0; + if Result then + PrinterName := Copy(PrinterName, 1, Pos(',', PrinterName) - 1) + else + PrinterName := ''; + end + else + // >= Win 2000 uses GetDefaultPrinter + begin + hWinSpool := SafeLoadLibrary(cPrintSpool); + if hWinSpool <> 0 then + try + {$IFDEF UNICODE} + @GetDefPrint := GetProcAddress(hWinSpool, 'GetDefaultPrinterW'); + {$ELSE} + @GetDefPrint := GetProcAddress(hWinSpool, 'GetDefaultPrinterA'); + {$ENDIF UNICODE} + if not Assigned(GetDefPrint) then + Exit; + Size := BUFSIZE; + SetLength(PrinterName, Size); + Result := GetDefPrint(PChar(PrinterName), Size); + if Result then + SetLength(PrinterName, StrLen(PChar(PrinterName))) + else + PrinterName := ''; + finally + FreeLibrary(hWinSpool); + end; + end; +end; + +{ TODO -cHelp : DPSetDefaultPrinter, Author: Microsoft } +// DPSetDefaultPrinter +// Parameters: +// PrinterName: Valid name of existing printer to make default. +// Returns: True for success, False for failure. + +// Source of the original code: Microsoft Knowledge Base Article - 246772 +// http://support.microsoft.com/default.aspx?scid=kb;en-us;246772 +function DPSetDefaultPrinter(const PrinterName: string): Boolean; +type + TSetDefaultPrinter = function(APrinterName: PChar): BOOL; stdcall; +var + Needed: DWORD; + PI2: PPrinterInfo2; + WinVer: TWindowsVersion; + hPrinter: THandle; + hWinSpool: HMODULE; + SetDefPrint: TSetDefaultPrinter; + PrinterStr: string; +begin + Result := False; + if PrinterName = '' then + Exit; + WinVer := GetWindowsVersion; + if WinVer in [wvWin95, wvWin95OSR2, wvWin98, wvWin98SE, wvWinME] then + begin + Result := OpenPrinter(PChar(PrinterName), hPrinter, nil); + if Result and (hPrinter <> 0) then + try + SetLastError(0); + Result := GetPrinter(hPrinter, 2, nil, 0, @Needed); + if not Result and ((GetLastError <> ERROR_INSUFFICIENT_BUFFER) or (Needed = 0)) then + Exit; + GetMem(PI2, Needed); + try + Result := GetPrinter(hPrinter, 2, PI2, Needed, @Needed); + if Result then + begin + PI2^.Attributes := PI2^.Attributes or PRINTER_ATTRIBUTE_DEFAULT; + Result := SetPrinter(hPrinter, 2, PI2, 0); + if Result then + SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, 0, + LPARAM(cWindows), SMTO_NORMAL, 1000, {$IFDEF RTL230_UP}@{$ENDIF}Needed); + end; + finally + FreeMem(PI2); + end; + finally + ClosePrinter(hPrinter); + end; + end + else + // Win NT uses WIN.INI (registry) + if WinVer in [wvWinNT31, wvWinNT35, wvWinNT351, wvWinNT4] then + begin + Result := OpenPrinter(PChar(PrinterName), hPrinter, nil); + if Result and (hPrinter <> 0) then + try + SetLastError(0); + Result := GetPrinter(hPrinter, 2, nil, 0, @Needed); + if not Result and ((GetLastError <> ERROR_INSUFFICIENT_BUFFER) or (Needed = 0)) then + Exit; + GetMem(PI2, Needed); + try + Result := GetPrinter(hPrinter, 2, PI2, Needed, @Needed); + if Result and (PI2^.pDriverName <> nil) and (PI2^.pPortName <> nil) then + begin + PrinterStr := PrinterName + ',' + PI2^.pDriverName + ',' + PI2^.pPortName; + Result := WriteProfileString(cWindows, cDevice, PChar(PrinterStr)); + if Result then + SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0, + SMTO_NORMAL, 1000, {$IFDEF RTL230_UP}@{$ENDIF}Needed); + end; + finally + FreeMem(PI2); + end; + finally + ClosePrinter(hPrinter); + end; + end + else + // >= Win 2000 uses SetDefaultPrinter + begin + hWinSpool := SafeLoadLibrary(cPrintSpool); + if hWinSpool <> 0 then + try + {$IFDEF UNICODE} + @SetDefPrint := GetProcAddress(hWinSpool, 'SetDefaultPrinterW'); + {$ELSE} + @SetDefPrint := GetProcAddress(hWinSpool, 'SetDefaultPrinterA'); + {$ENDIF UNICODE} + if Assigned(SetDefPrint) then + Result := SetDefPrint(PChar(PrinterName)); + finally + FreeLibrary(hWinSpool); + end; + end; +end; + +procedure GetPrinterDetails(APrinter: TPrinter; var ADevice, ADriver, APort: string; var ADeviceMode: THandle); +{$IFDEF RTL360_UP} +begin + APrinter.GetPrinter(ADevice, ADriver, APort, ADeviceMode); +end; +{$ELSE} +var + DeviceBuffer: array [0..255] of Char; + DriverBuffer: array [0..255] of Char; + PortBuffer: array [0..255] of Char; +begin + APrinter.GetPrinter(DeviceBuffer, DriverBuffer, PortBuffer, ADeviceMode); + + ADevice := DeviceBuffer; + ADriver := DriverBuffer; + APort := PortBuffer; +end; +{$ENDIF ~RTL360_UP} + + +// TJclPrintSet +constructor TJclPrintSet.Create; +begin + inherited Create; + FBinArray := nil; + FPaperArray := nil; + FPrinter := -99; { TODO : why -99 } + FHandle := 0; +end; + +destructor TJclPrintSet.Destroy; +begin + if FBinArray <> nil then + FreeMem(FBinArray, FNumBins * SizeOf(Word)); + if FPaperArray <> nil then + FreeMem(FPaperArray, FNumPapers * SizeOf(Word)); + inherited Destroy; +end; + +procedure TJclPrintSet.CheckPrinter; +var + NewHandle: THandle; + PrinterChanged: Boolean; + LastDevice, LastDriver, LastPort: string; +begin + LastDevice := FDevice; + LastDriver := FDriver; + LastPort := FPort; + + GetPrinterDetails(Printer, FDevice, FDriver, FPort, NewHandle); + PrinterChanged := (FHandle <> NewHandle) or (LastDevice <> FDevice) + or (LastDriver <> FDriver) or (LastPort <> FPort) or (FPrinter <> Printer.PrinterIndex); + FHandle := NewHandle; + FPrinter := Printer.PrinterIndex; + Printer.SetPrinter(PChar(FDevice), PChar(FDriver), PChar(FPort), FHandle); + if PrinterChanged then + SetDeviceMode(False); +end; + +procedure TJclPrintSet.SetBinArray; +var + NumBinsRec: DWord; + ADeviceMode: PDeviceMode; +begin + if FBinArray <> nil then + FreeMem(FBinArray, FNumBins * SizeOf(Word)); + FBinArray := nil; + ADeviceMode := LockDeviceMode; + try + FNumBins := DeviceCapabilities(PChar(FDevice), PChar(FPort), DC_Bins, nil, ADeviceMode); + if FNumBins > 0 then + begin + GetMem(FBinArray, FNumBins * SizeOf(Word)); + NumBinsRec := DeviceCapabilities(PChar(FDevice), PChar(FPort), DC_Bins, + PChar(FBinArray), ADeviceMode); + if NumBinsRec <> FNumBins then + raise EJclPrinterError.CreateRes(@RsRetrievingSource); + end; + finally + UnlockDeviceMode; + end; +end; + +procedure TJclPrintSet.SetPaperArray; +var + NumPapersRec: DWord; + ADeviceMode: PDeviceMode; +begin + if FPaperArray <> nil then + FreeMem(FPaperArray, FNumPapers * SizeOf(Word)); + ADeviceMode := LockDeviceMode; + try + FNumPapers := DeviceCapabilities(PChar(FDevice), PChar(FPort), DC_Papers, nil, ADeviceMode); + if FNumPapers > 0 then + begin + GetMem(FPaperArray, FNumPapers * SizeOf(Word)); + NumPapersRec := DeviceCapabilities(PChar(FDevice), PChar(FPort), DC_Papers, + PChar(FPaperArray), ADeviceMode); + if NumPapersRec <> FNumPapers then + raise EJclPrinterError.CreateRes(@RsRetrievingPaperSource); + end + else + FPaperArray := nil; + finally + UnlockDeviceMode; + end; +end; + +{ TODO : complete this list } +// Since Win32 the strings are stored in the printer driver, no chance to get +// a list from Windows +function TJclPrintSet.DefaultPaperName(const PaperID: Word): string; +begin + case PaperID of + dmpaper_Letter: + Result := LoadResString(@RsPSLetter); + dmpaper_LetterSmall: + Result := LoadResString(@RsPSLetter); + dmpaper_Tabloid: + Result := LoadResString(@RsPSTabloid); + dmpaper_Ledger: + Result := LoadResString(@RsPSLedger); + dmpaper_Legal: + Result := LoadResString(@RsPSLegal); + dmpaper_Statement: + Result := LoadResString(@RsPSStatement); + dmpaper_Executive: + Result := LoadResString(@RsPSExecutive); + dmpaper_A3: + Result := LoadResString(@RsPSA3); + dmpaper_A4: + Result := LoadResString(@RsPSA4); + dmpaper_A4Small: + Result := LoadResString(@RsPSA4); + dmpaper_A5: + Result := LoadResString(@RsPSA5); + dmpaper_B4: + Result := LoadResString(@RsPSB4); + dmpaper_B5: + Result := LoadResString(@RsPSB5); + dmpaper_Folio: + Result := LoadResString(@RsPSFolio); + dmpaper_Quarto: + Result := LoadResString(@RsPSQuarto); + dmpaper_10X14: + Result := LoadResString(@RsPS10x14); + dmpaper_11X17: + Result := LoadResString(@RsPS11x17); + dmpaper_Note: + Result := LoadResString(@RsPSNote); + dmpaper_Env_9: + Result := LoadResString(@RsPSEnv9); + dmpaper_Env_10: + Result := LoadResString(@RsPSEnv10); + dmpaper_Env_11: + Result := LoadResString(@RsPSEnv11); + dmpaper_Env_12: + Result := LoadResString(@RsPSEnv12); + dmpaper_Env_14: + Result := LoadResString(@RsPSEnv14); + dmpaper_CSheet: + Result := LoadResString(@RsPSCSheet); + dmpaper_DSheet: + Result := LoadResString(@RsPSDSheet); + dmpaper_ESheet: + Result := LoadResString(@RsPSESheet); + dmpaper_User: + Result := LoadResString(@RsPSUser); + else + Result := LoadResString(@RsPSUnknown); + end; +end; + +procedure TJclPrintSet.GetBinSourceList(List: TStrings); +type + TBinName = array [0..CCHBinName - 1] of Char; + TBinArray = array [1..cBinMax] of TBinName; + PBinArray = ^TBinArray; +var + NumBinsRec: DWord; + BinArray: PBinArray; + BinStr: string; + Idx: Integer; + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + BinArray := nil; + if FNumBins = 0 then + Exit; + List.BeginUpdate; + try + GetMem(BinArray, FNumBins * SizeOf(TBinName)); + List.Clear; + ADeviceMode := LockDeviceMode; + try + NumBinsRec := DeviceCapabilities(PChar(FDevice), PChar(FPort), DC_BinNames, + PChar(BinArray), ADeviceMode); + finally + UnlockDeviceMode; + end; + if NumBinsRec <> FNumBins then + raise EJclPrinterError.CreateRes(@RsRetrievingSource); + for Idx := 1 to NumBinsRec do + begin + BinStr := StrPas(BinArray^[Idx]); + List.Add(BinStr); + end; + finally + List.EndUpdate; + if BinArray <> nil then + FreeMem(BinArray, FNumBins * SizeOf(TBinName)); + end; +end; + +procedure TJclPrintSet.GetPaperList(List: TStrings); +type + TPaperName = array [0..CCHPaperName - 1] of Char; + TPaperArray = array [1..cPaperNames] of TPaperName; + PPaperArray = ^TPaperArray; +var + NumPaperRec: DWord; + PaperArray: PPaperArray; + PaperStr: string; + Idx: Integer; + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + PaperArray := nil; + if FNumPapers = 0 then + Exit; + List.BeginUpdate; + List.Clear; + try + GetMem(PaperArray, FNumPapers * SizeOf(TPaperName)); + ADeviceMode := LockDeviceMode; + try + NumPaperRec := DeviceCapabilities(PChar(FDevice), PChar(FPort), DC_PaperNames, + PChar(PaperArray), ADeviceMode); + finally + UnlockDeviceMode; + end; + if NumPaperRec <> FNumPapers then + begin + for Idx := 1 to FNumPapers do + begin + PaperStr := DefaultPaperName(FPaperArray^[Idx - 1]); + List.Add(PaperStr); + end; + end + else + begin + for Idx := 1 to NumPaperRec do + begin + PaperStr := StrPas(PaperArray^[Idx]); + List.Add(PaperStr); + end; + end; + finally + List.EndUpdate; + if PaperArray <> nil then + FreeMem(PaperArray, FNumPapers * SizeOf(TPaperName)); + end; +end; + +procedure TJclPrintSet.SetDeviceMode(Creating: Boolean); +var + Res: TPoint; + ADeviceMode: PDeviceMode; + NewHandle: THandle; +begin + GetPrinterDetails(Printer, FDevice, FDriver, FPort, NewHandle); + if NewHandle = 0 then + begin + Printer.PrinterIndex := Printer.PrinterIndex; + GetPrinterDetails(Printer, FDevice, FDriver, FPort, NewHandle); + end; + FHandle := NewHandle; + if FHandle <> 0 then + begin + ADeviceMode := GlobalLock(FHandle); + + FPrinter := Printer.PrinterIndex; + UpdateDeviceMode(ADeviceMode); + //FDeviceMode^.dmFields := 0; + SetBinArray; + SetPaperArray; + end + else + begin + if not Creating then + raise EJclPrinterError.CreateRes(@RsDeviceMode); + FPrinter := -99; + end; + Res := GetPrinterResolution; + dpiX := Res.X; + dpiY := Res.Y; + if FHandle <> 0 then + GlobalUnLock(FHandle); +end; + +procedure TJclPrintSet.UpdateDeviceMode(const ADeviceMode: PDeviceMode); +var + DrvHandle: THandle; + ExtDevCode: Integer; +begin + // ONLY CALL when ADeviceMode is locked by caller!!! + + //CheckPrinter; + if OpenPrinter(PChar(FDevice), DrvHandle, nil) then + try + ADeviceMode^.dmFields := dm_Orientation or dm_PaperSize or + dm_PaperLength or dm_PaperWidth or + dm_Scale or dm_Copies or + dm_DefaultSource or dm_PrintQuality or + dm_Color or dm_Duplex or + dm_YResolution or dm_TTOption; + ExtDevCode := DocumentProperties(0, DrvHandle, PChar(FDevice), + ADeviceMode^, ADeviceMode^, + DM_IN_BUFFER or DM_OUT_BUFFER); + if ExtDevCode <> IDOK then + raise EJclPrinterError.CreateRes(@RsUpdatingPrinter); + finally + ClosePrinter(DrvHandle); + end; +end; + +procedure TJclPrintSet.SaveToDefaults; +var + DrvHandle: THandle; + ExtDevCode: Integer; + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + OpenPrinter(PChar(FDevice), DrvHandle, nil); + ADeviceMode := LockDeviceMode; + try + ExtDevCode := DocumentProperties(0, DrvHandle, PChar(FDevice), + ADeviceMode^, ADeviceMode^, DM_IN_BUFFER or DM_UPDATE); + finally + UnlockDeviceMode; + end; + if ExtDevCode <> IDOK then + raise EJclPrinterError.CreateRes(@RsUpdatingPrinter) + else + SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0); + ClosePrinter(DrvHandle); +end; + +procedure TJclPrintSet.SavePrinterAsDefault; +begin + CheckPrinter; + DPSetDefaultPrinter(FDevice); +end; + +procedure TJclPrintSet.ResetPrinterDialogs; +begin + GetPrinterDetails(Printer, FDevice, FDriver, FPort, FHandle); + Printer.SetPrinter(PChar(FDevice), PChar(FDriver), PChar(FPort), FHandle); + SetDeviceMode(False); +end; + +function TJclPrintSet.XInchToDot(const Inches: Double): Integer; +begin + Result := Trunc(DpiX * Inches); +end; + +function TJclPrintSet.YInchToDot(const Inches: Double): Integer; +begin + Result := Trunc(DpiY * Inches); +end; + +function TJclPrintSet.XCmToDot(const Cm: Double): Integer; +begin + Result := Trunc(DpiX * (Cm * 2.54)); +end; + +function TJclPrintSet.YCmToDot(const Cm: Double): Integer; +begin + Result := Trunc(DpiY * (Cm * 2.54)); +end; + +function TJclPrintSet.CpiToDot(const Cpi, Chars: Double): Integer; +begin + Result := Trunc((DpiX * Chars) / Cpi); +end; + +function TJclPrintSet.LpiToDot(const Lpi, Lines: Double): Integer; +begin + Result := Trunc((DpiY * Lpi) / Lines); +end; + +procedure TJclPrintSet.TextOutInch(const X, Y: Double; const Text: string); +begin + Printer.Canvas.TextOut(XInchToDot(X), YInchToDot(Y), Text); +end; + +procedure TJclPrintSet.TextOutCm(const X, Y: Double; const Text: string); +begin + Printer.Canvas.TextOut(XCmToDot(X), YCmToDot(Y), Text); +end; + +procedure TJclPrintSet.TextOutCpiLpi(const Cpi, Chars, Lpi, Lines: Double; const Text: string); +begin + Printer.Canvas.TextOut(CpiToDot(Cpi, Chars), LpiToDot(Lpi, Lines), Text); +end; + +procedure TJclPrintSet.CustomPageSetup(const Width, Height: Double); +begin + PaperSize := dmPaper_User; + PaperLength := Trunc(254 * Height); + YResolution := Trunc(DpiY * Height); + PaperWidth := Trunc(254 * Width); +end; + +procedure TJclPrintSet.DevModePrinterDriverExtraClear; +var + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + ADeviceMode^.dmDriverExtra := 0; + finally + UnlockDeviceMode; + end; +end; + +procedure TJclPrintSet.DevModePrinterDriverExtraReinstate(const ExtraData: TDynByteArray; + const ExtraDataDriverName: string; const ExtraDataDriverVersion: Word); +var + Src, Dest: PDeviceMode; + ADeviceModeDriverExtra: PByte; + NewHandle: THandle; +begin + CheckPrinter; + { http://support.microsoft.com/kb/167345 + Using a DEVMODE structure to modify printer settings is more difficult than just changing the fields of the structure. Specifically, a valid DEVMODE structure for a device contains private data that can only be modified by the DocumentProperties() function. + This article explains how to modify the contents of a DEVMODE structure with the DocumentProperties() function.} + + if FHandle <> 0 then + begin + Src := GlobalLock(FHandle); + try + if not ((Src^.dmDeviceName = ExtraDataDriverName) and (Src^.dmDriverVersion = ExtraDataDriverVersion)) then + exit; + //raise Exception.Create('TJclPrintSet.DevModePrinterDriverExtraReinstate - Driver Private data does not match selected printer'); + + NewHandle := GlobalAlloc(GHND, sizeof(DEVMODE) + Length(ExtraData)); + if NewHandle <> 0 then + try + Dest := GlobalLock(NewHandle); + + if (Src <> nil) and (Dest <> nil) then + begin + Move(Src^, Dest^, Src^.dmSize); + Dest^.dmDriverExtra := 0; + + Dest^.dmDriverExtra := Length(ExtraData); + + + ADeviceModeDriverExtra := PByte(Dest); + Inc(ADeviceModeDriverExtra, Dest^.dmSize); + Move(ExtraData[0], ADeviceModeDriverExtra^, dest^.dmDriverExtra); + end + else + raise Exception.Create('TJclPrintSet.DevModePrinterDriverExtraReinstate - GlobalLock failed'); + finally + GlobalUnlock(NewHandle); + end; + + Printer.SetPrinter(PChar(FDevice), PChar(FDriver), PChar(FPort), NewHandle); + FHandle := NewHandle; + SetDeviceMode(False); + finally + GlobalUnlock(FHandle); + end; + end + else + raise Exception.Create('TJclPrintSet.DevModePrinterDriverExtraReinstate invalid handle'); +end; + +procedure TJclPrintSet.SaveToIniFile(const IniFileName, Section: string); +var + PrIniFile: TMemIniFile; +begin + PrIniFile := TMemIniFile.Create(IniFileName); // use TMemIniFile as TIniFile truncats longs values + try + SaveToCustomIni(PrIniFile, Section); + PrIniFile.UpdateFile; + finally + PrIniFile.Free; + end; +end; + +function TJclPrintSet.ReadFromIniFile(const IniFileName, Section: string): Boolean; +var + PrIniFile: TMemIniFile; +begin + PrIniFile := TMemIniFile.Create(IniFileName); // use TMemIniFile as TIniFile truncats longs values + try + Result := ReadFromCustomIni(PrIniFile, Section); + finally + PrIniFile.Free; + end; +end; + +procedure TJclPrintSet.SetOrientation(Orientation: Integer); +var + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + ADeviceMode^.dmOrientation := Orientation; + Printer.Orientation := TPrinterOrientation(Orientation - 1); + ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_ORIENTATION; + finally + UnlockDeviceMode; + end; +end; + +function TJclPrintSet.GetOrientation: Integer; +var + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + Result := ADeviceMode^.dmOrientation; + finally + UnlockDeviceMode; + end; +end; + +procedure TJclPrintSet.SetPaperSize(Size: Integer); +var + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + ADeviceMode^.dmPaperSize := Size; + ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_PAPERSIZE; + finally + UnlockDeviceMode; + end; +end; + +function TJclPrintSet.GetPaperSize: Integer; +var + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + Result := ADeviceMode^.dmPaperSize; + finally + UnlockDeviceMode; + end; +end; + +procedure TJclPrintSet.SetPaperLength(Length: Integer); +var + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + ADeviceMode^.dmPaperLength := Length; + ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_PAPERLENGTH; + finally + UnlockDeviceMode; + end; +end; + +function TJclPrintSet.GetPaperLength: Integer; +var + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + Result := ADeviceMode^.dmPaperLength; + finally + UnlockDeviceMode; + end; +end; + +procedure TJclPrintSet.SetPaperWidth(Width: Integer); +var + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + ADeviceMode^.dmPaperWidth := Width; + ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_PAPERWIDTH; + finally + UnlockDeviceMode; + end; +end; + +function TJclPrintSet.GetPaperWidth: Integer; +var + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + Result := ADeviceMode^.dmPaperWidth; + finally + UnlockDeviceMode; + end; +end; + +procedure TJclPrintSet.SetScale(Scale: Integer); +var + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + ADeviceMode^.dmScale := Scale; + ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_SCALE; + finally + UnlockDeviceMode; + end; +end; + +function TJclPrintSet.GetScale: Integer; +var + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + Result := ADeviceMode^.dmScale; + finally + UnlockDeviceMode; + end; +end; + +procedure TJclPrintSet.SetCopies(Copies: Integer); +var + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + ADeviceMode^.dmCopies := Copies; + ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_COPIES; + finally + UnlockDeviceMode; + end; +end; + +function TJclPrintSet.GetCopies: Integer; +var + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + Result := ADeviceMode^.dmCopies; + finally + UnlockDeviceMode; + end; +end; + +procedure TJclPrintSet.SetBin(Bin: Integer); +var + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + ADeviceMode^.dmDefaultSource := Bin; + ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_DEFAULTSOURCE; + finally + UnlockDeviceMode; + end; +end; + +function TJclPrintSet.GetBin: Integer; +var + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + Result := ADeviceMode^.dmDefaultSource; + finally + UnlockDeviceMode; + end; +end; + +procedure TJclPrintSet.SetPrintQuality(Quality: Integer); +var + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + ADeviceMode^.dmPrintQuality := Quality; + ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_PRINTQUALITY; + finally + UnlockDeviceMode; + end; +end; + +function TJclPrintSet.GetPrintQuality: Integer; +var + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + Result := ADeviceMode^.dmPrintQuality; + finally + UnlockDeviceMode; + end; +end; + +procedure TJclPrintSet.SetColor(Color: Integer); +var + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + ADeviceMode^.dmColor := Color; + ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_COLOR; + finally + UnlockDeviceMode; + end; +end; + +function TJclPrintSet.GetColor: Integer; +var + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + Result := ADeviceMode^.dmColor; + finally + UnlockDeviceMode; + end; +end; + +procedure TJclPrintSet.SetDuplex(Duplex: Integer); +var + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + ADeviceMode^.dmDuplex := Duplex; + ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_DUPLEX; + finally + UnlockDeviceMode; + end; +end; + +function TJclPrintSet.GetDuplex: Integer; +var + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + Result := ADeviceMode^.dmDuplex; + finally + UnlockDeviceMode; + end; +end; + +procedure TJclPrintSet.SetYResolution(YRes: Integer); +var + PrintDevMode: PDeviceModeA; + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + PrintDevMode := @ADeviceMode^; + PrintDevMode^.dmYResolution := YRes; + ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_YRESOLUTION; + finally + UnlockDeviceMode; + end; +end; + +function TJclPrintSet.GetYResolution: Integer; +var + PrintDevMode: PDeviceModeA; + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + PrintDevMode := @ADeviceMode^; + Result := PrintDevMode^.dmYResolution; + finally + UnlockDeviceMode; + end; +end; + +procedure TJclPrintSet.SetTrueTypeOption(Option: Integer); +var + PrintDevMode: PDeviceModeA; + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + PrintDevMode := @ADeviceMode^; + PrintDevMode^.dmTTOption := Option; + ADeviceMode^.dmFields := ADeviceMode^.dmFields or DM_TTOPTION; + finally + UnlockDeviceMode; + end; +end; + +function TJclPrintSet.GetTrueTypeOption: Integer; +var + PrintDevMode: PDeviceModeA; + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + PrintDevMode := @ADeviceMode^; + Result := PrintDevMode^.dmTTOption; + finally + UnlockDeviceMode; + end; +end; + +function TJclPrintSet.GetPrinterName: string; +begin + CheckPrinter; + Result := FDevice; +end; + +function TJclPrintSet.GetPrinterPort: string; +begin + CheckPrinter; + Result := FPort; +end; + +function TJclPrintSet.GetPrinterDriver: string; +begin + CheckPrinter; + Result := FDriver; +end; + +procedure TJclPrintSet.SetBinFromList(BinNum: Word); +begin + CheckPrinter; + if FNumBins = 0 then + Exit; + if BinNum > FNumBins then + raise EJclPrinterError.CreateRes(@RsIndexOutOfRange) + else + DefaultSource := FBinArray^[BinNum]; +end; + +function TJclPrintSet.GetBinIndex: Word; +var + Idx: Word; + ADeviceMode: PDeviceMode; +begin + Result := 0; + ADeviceMode := LockDeviceMode; + try + for Idx := 0 to FNumBins do + begin + if FBinArray^[Idx] = Word(ADeviceMode^.dmDefaultSource) then + begin + Result := Idx; + Break; + end; + end; + finally + UnlockDeviceMode; + end; +end; + +function TJclPrintSet.GetDevModePrinterDriverVersion: Word; +var + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + Result := ADeviceMode^.dmDriverVersion; + finally + UnlockDeviceMode; + end; +end; + +function TJclPrintSet.GetDevModePrinterDriver: string; +var + ADeviceMode: PDeviceMode; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + Result := ADeviceMode^.dmDeviceName; + finally + UnlockDeviceMode; + end; +end; + +function TJclPrintSet.GetDevModePrinterDriverExtra: TDynByteArray; +var + ADeviceMode: PDeviceMode; + ADeviceModeDriverExtra: PByte; +begin + CheckPrinter; + ADeviceMode := LockDeviceMode; + try + ADeviceModeDriverExtra := PByte(ADeviceMode); + Inc(ADeviceModeDriverExtra, ADeviceMode^.dmSize); + SetLength(Result, ADeviceMode^.dmDriverExtra); + Move(ADeviceModeDriverExtra^, Result[0], ADeviceMode^.dmDriverExtra); + finally + UnlockDeviceMode; + end; +end; + +procedure TJclPrintSet.SetPaperFromList(PaperNum: Word); +begin + CheckPrinter; + if FNumPapers = 0 then + Exit; + if PaperNum > FNumPapers then + raise EJclPrinterError.CreateRes(@RsIndexOutOfRangePaper) + else + PaperSize := FPaperArray^[PaperNum]; +end; + +procedure TJclPrintSet.SetPort(Port: string); +begin + CheckPrinter; + FPort := Port; + Printer.SetPrinter(PChar(FDevice), PChar(FDriver), PChar(FPort), FHandle); +end; + +function TJclPrintSet.GetPaperIndex: Word; +var + Idx: Word; + ADeviceMode: PDeviceMode; +begin + Result := 0; + ADeviceMode := LockDeviceMode; + try + for Idx := 0 to FNumPapers do + begin + if FPaperArray^[Idx] = Word(ADeviceMode^.dmPaperSize) then + begin + Result := Idx; + Break; + end; + end; + finally + UnlockDeviceMode; + end; +end; + +function TJclPrintSet.LockDeviceMode: PDeviceMode; +begin + if FHandle <> 0 then + begin + Result := GlobalLock(FHandle); + if not assigned(Result) then + RaiseLastOSError; + end + else + raise Exception.Create('TJclPrintSet.LockDeviceMode invalid FHandle'); +end; + +function TJclPrintSet.ReadFromCustomIni(const PrIniFile: TCustomIniFile; const Section: string): Boolean; +var + privData: TMemoryStream; + privDataExtra: TDynByteArray; + privDataExtraSize: Integer; + DevModeDriverName: string; + DevModeDriverVersion: Word; +begin + PrinterName := PrIniFile.ReadString(Section, PrintIniPrinterName, PrinterName); + PrinterPort := PrIniFile.ReadString(Section, PrintIniPrinterPort, PrinterPort); + Orientation := PrIniFile.ReadInteger(Section, PrintIniOrientation, Orientation); + PaperSize := PrIniFile.ReadInteger(Section, PrintIniPaperSize, PaperSize); + PaperLength := PrIniFile.ReadInteger(Section, PrintIniPaperLength, PaperLength); + PaperWidth := PrIniFile.ReadInteger(Section, PrintIniPaperWidth, PaperWidth); + Scale := PrIniFile.ReadInteger(Section, PrintIniScale, Scale); + Copies := PrIniFile.ReadInteger(Section, PrintIniCopies, Copies); + DefaultSource := PrIniFile.ReadInteger(Section, PrintIniDefaultSource, DefaultSource); + PrintQuality := PrIniFile.ReadInteger(Section, PrintIniPrintQuality, PrintQuality); + Color := PrIniFile.ReadInteger(Section, PrintIniColor, Color); + Duplex := PrIniFile.ReadInteger(Section, PrintIniDuplex, Duplex); + YResolution := PrIniFile.ReadInteger(Section, PrintIniYResolution, YResolution); + TrueTypeOption := PrIniFile.ReadInteger(Section, PrintIniTTOption, TrueTypeOption); + + DevModeDriverName := PrIniFile.ReadString(Section, PrintDriverName, ''); + DevModeDriverVersion := Word(PrIniFile.ReadInteger(Section, PrintDriverVersion, 0)); + if (DevModePrinterDriver = DevModeDriverName) and + (DevModePrinterDriverVersion = DevModeDriverVersion) then + begin + privData := TMemoryStream.Create; + try + + PrIniFile.ReadBinaryStream(Section, PrintDriverExtraData, privData); + privDataExtraSize := PrIniFile.ReadInteger(Section, PrintDriverExtraSize, 0); + if (privData.Size = privDataExtraSize) then + begin + SetLength(privDataExtra, privDataExtraSize); + privdata.Read(privDataExtra[0], privDataExtraSize); + + DevModePrinterDriverExtraReinstate(privDataExtra, DevModeDriverName, DevModeDriverVersion); + end; + finally + privData.Free; + end; + end; + Result := True; +end; + +procedure TJclPrintSet.SaveToCustomIni(const PrIniFile: TCustomIniFile; const Section: string); +var + CurrentName: string; + + privData: TMemoryStream; + privDataExtra: TDynByteArray; +begin + PrIniFile.EraseSection(Section); + + CurrentName := Printer.Printers[Printer.PrinterIndex]; + PrIniFile.WriteString(Section, PrintIniPrinterName, CurrentName); + PrIniFile.WriteString(Section, PrintIniPrinterPort, PrinterPort); + PrIniFile.WriteInteger(Section, PrintIniOrientation, Orientation); + PrIniFile.WriteInteger(Section, PrintIniPaperSize, PaperSize); + PrIniFile.WriteInteger(Section, PrintIniPaperLength, PaperLength); + PrIniFile.WriteInteger(Section, PrintIniPaperWidth, PaperWidth); + PrIniFile.WriteInteger(Section, PrintIniScale, Scale); + PrIniFile.WriteInteger(Section, PrintIniCopies, Copies); + PrIniFile.WriteInteger(Section, PrintIniDefaultSource, DefaultSource); + PrIniFile.WriteInteger(Section, PrintIniPrintQuality, PrintQuality); + PrIniFile.WriteInteger(Section, PrintIniColor, Color); + PrIniFile.WriteInteger(Section, PrintIniDuplex, Duplex); + PrIniFile.WriteInteger(Section, PrintIniYResolution, YResolution); + PrIniFile.WriteInteger(Section, PrintIniTTOption, TrueTypeOption); + + PrIniFile.WriteString(Section, PrintDriverName, DevModePrinterDriver); + PrIniFile.WriteInteger(Section, PrintDriverVersion, DevModePrinterDriverVersion); + PrIniFile.WriteInteger(Section, PrintDriverExtraSize, Length(DevModePrinterDriverExtra)); + + privDataExtra := DevModePrinterDriverExtra; + + privData := TMemoryStream.Create; + try + privdata.Write(privDataExtra[0], Length(privDataExtra)); + privData.Position := 0; + PrIniFile.WriteBinaryStream(Section, PrintDriverExtraData, privData); + finally + privData.Free; + end; +end; + +procedure TJclPrintSet.SetPrinterName(const Value: string); +var + NewIndex: Integer; +begin + if PrinterName <> Value then + begin + NewIndex := Printer.Printers.IndexOf(Value); + if NewIndex <> -1 then + begin + Printer.PrinterIndex := NewIndex; + end; + end; + CheckPrinter; +end; + +procedure TJclPrintSet.UnlockDeviceMode; +begin + if FHandle <> 0 then + GlobalUnLock(FHandle); +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/vcl/JclVclResources.pas b/3rdParty/JCL/source/vcl/JclVclResources.pas new file mode 100644 index 00000000..8f4600bd --- /dev/null +++ b/3rdParty/JCL/source/vcl/JclVclResources.pas @@ -0,0 +1,226 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclResources.pas. } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. } +{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. All rights reserved. } +{ } +{ Contributors: } +{ Alexei Koudinov } +{ Barry Kelly } +{ Flier Lu (flier) } +{ Florent Ouchet (outchy) } +{ Jean-Fabien Connault (cycocrew) } +{ Marcel Bestebroer } +{ Marcel van Brakel } +{ Matthias Thoma (mthoma) } +{ Peter Friese } +{ Petr Vones (pvones) } +{ Raymond Alexander (rayspostbox3) } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Scott Price (scottprice) } +{ Uwe Schuster (uschuster) } +{ } +{**************************************************************************************************} +{ } +{ Unit which provides a central place for all resource strings used in the JCL VCL } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclVclResources; + +{$I jcl.inc} + +interface + +{$IFDEF UNITVERSIONING} +uses + JclUnitVersioning; +{$ENDIF UNITVERSIONING} + +//=== JclGraphics ============================================================ +resourcestring + RsAssertUnpairedEndUpdate = 'Unpaired BeginUpdate EndUpdate'; + RsCreateCompatibleDc = 'Could not create compatible DC'; + RsDestinationBitmapEmpty = 'Destination bitmap is empty'; + RsDibHandleAllocation = 'Could not allocate handle for DIB'; + RsMapSizeFmt = 'Could not set size on class "%s"'; + RsSelectObjectInDc = 'Could not select object in DC'; + RsSourceBitmapEmpty = 'Source bitmap is empty'; + RsSourceBitmapInvalid = 'Source bitmap is invalid'; + RsNoBitmapForRegion = 'No bitmap for region'; + RsNoDeviceContextForWindow = 'Cannot get device context of the window'; + RsInvalidRegion = 'Invalid Region defined for RegionInfo'; + RsRegionDataOutOfBound = 'Out of bound index on RegionData'; + RsRegionCouldNotCreated = 'Region could not be created'; + RsInvalidHandleForRegion = 'Invalid handle for region'; + RsInvalidRegionInfo = 'Invalid RegionInfo'; + RsInvalidControlType = '%s is not descended from TWinControl'; + RsInvalidFormOrComponent = 'A %s with a nil reference has been passed to the method'; + + RsBitmapExtension = '.bmp'; + RsJpegExtension = '.jpg'; + RsGifExtension = '.gif'; + RsPngExtension = '.png'; + +//=== JclGraphUtils ========================================================== +resourcestring + RsBitsPerSampleNotSupported = '%d bits per sample not supported in color space conversion'; + +//=== JclOpenDialogFavorites.pas ============================================= +resourcestring + RsOpenDialogList = ' --> Favorites'; + RsOpenDialogAdd = ' --> Add to this list'; + RsOpenDialogDelete = ' --> Delete from this list'; + RsOpenDialogVirtual = ' --> Virtual directories cannot be added to the favorites'; + RsOpenDialogFavorites = '&Favorites:'; + RsOpenDialogConfirmation = 'Confirmation'; + RsOpenDialogDelConfirm = 'Are you sure to delete "%s" from favorite folders?'; + +//=== JclOpenDialogHooks.pas ================================================= +resourcestring + RsEOpenDialogHookExists = 'An open dialog hook is already installed (existing ClassName = %s)'; + +//=== JclPrint =============================================================== +resourcestring + RsSpoolerDocName = 'My Document'; + + RsInvalidPrinter = 'Invalid printer'; + RsNAStartDocument = 'Unable to "Start document"'; + RsNASendData = 'Unable to send data to printer'; + RsNAStartPage = 'Unable to "Start page"'; + RsNAEndPage = 'Unable to "End page"'; + RsNAEndDocument = 'Unable to "End document"'; + RsNATransmission = 'Not all chars have been sent correctly to printer'; + RsDeviceMode = 'Error retrieving DeviceMode'; + RsUpdatingPrinter = 'Error updating printer driver'; + RsIndexOutOfRange = 'Index out of range setting bin'; + RsRetrievingSource = 'Error retrieving Bin Source Info'; + RsRetrievingPaperSource = 'Error retrieving Paper Source Info'; + RsIndexOutOfRangePaper = 'Index out of range setting paper'; + + // Paper Styles (PS) + RsPSLetter = 'Letter 8 1/2 x 11 in'; + RsPSLetterSmall = 'Letter Small 8 1/2 x 11 in'; + RsPSTabloid = 'Tabloid 11 x 17 in'; + RsPSLedger = 'Ledger 17 x 11 in'; + RsPSLegal = 'Legal 8 1/2 x 14 in'; + RsPSStatement = 'Statement 5 1/2 x 8 1/2 in'; + RsPSExecutive = 'Executive 7 1/2 x 10 in'; + RsPSA3 = 'A3 297 x 420 mm'; + RsPSA4 = 'A4 210 x 297 mm'; + RsPSA4Small = 'A4 Small 210 x 297 mm'; + RsPSA5 = 'A5 148 x 210 mm'; + RsPSB4 = 'B4 250 x 354'; + RsPSB5 = 'B5 182 x 257 mm'; + RsPSFolio = 'Folio 8 1/2 x 13 in'; + RsPSQuarto = 'Quarto 215 x 275 mm'; + RsPS10X14 = '10 x 14 in'; + RsPS11X17 = '11 x 17 in'; + RsPSNote = 'Note 8 1/2 x 11 in'; + RsPSEnv9 = 'Envelope #9 3 7/8 x 8 7/8 in'; + RsPSEnv10 = 'Envelope #10 4 1/8 x 9 1/2 in'; + RsPSEnv11 = 'Envelope #11 4 1/2 x 10 3/8 in'; + RsPSEnv12 = 'Envelope #12 4 \276 x 11 in'; + RsPSEnv14 = 'Envelope #14 5 x 11 1/2 in'; + RsPSCSheet = 'C size sheet'; + RsPSDSheet = 'D size sheet'; + RsPSESheet = 'E size sheet'; + RsPSUser = 'User Defined Size'; + RsPSUnknown = 'Unknown Paper Size'; + +//=== JclVersionControl ====================================================== +resourcestring + RsVersionCtrlAddCaption = '&Add'; // vcaAdd + RsVersionCtrlAddSandboxCaption = 'Add ...'; // vcaAddSandbox + RsVersionCtrlBlameCaption = '&Blame'; // vcaBlame + RsVersionCtrlBranchCaption = 'Branc&h'; // vcaBranch + RsVersionCtrlBranchSandboxCaption = 'Branch ...'; // vcaBranchSandbox + RsVersionCtrlCheckOutSandboxCaption = 'C&heck out ...'; // vcaCreateSandbox + RsVersionCtrlCommitCaption = 'Co&mmit'; // vcaCommit + RsVersionCtrlCommitSandboxCaption = 'Commit ...'; // vcaCommitSandbox + RsVersionCtrlContextMenuCaption = 'Co&ntext Menu (right-click)'; // vcaContextMenu + RsVersionCtrlDiffCaption = '&Diff'; // vcaDiff + RsVersionCtrlExploreCaption = 'E&xplore'; // vcaExplore + RsVersionCtrlExploreSandboxCaption = 'E&xplore ...'; // vcaExploreSandbox + RsVersionCtrlGraphCaption = 'Revision Gr&aph'; // vcaGraph + RsVersionCtrlLogCaption = '&Log'; // vcaLog + RsVersionCtrlLogSandboxCaption = 'Log ...'; // vcaLogSandbox + RsVersionCtrlLockCaption = 'Loc&k'; // vcaLock + RsVersionCtrlLockSandboxCaption = 'Lock ...'; // vcaLockSandbox + RsVersionCtrlMergeCaption = '&Merge'; // vcaMerge + RsVersionCtrlMergeSandboxCaption = 'Merge ...'; // vcaMergeSandbox + RsVersionCtrlPropertiesCaption = 'Pr&operties'; // vcaProperties + RsVersionCtrlPropertiesSandboxCaption = 'Properties ...'; // vcaPropertiesSandbox + RsVersionCtrlRenameCaption = '&Rename'; // vcaRename + RsVersionCtrlRenameSandboxCaption = '&Rename Sandbox'; // vcaRenameSandbox + RsVersionCtrlRepoBrowserCaption = 'Repositor&y Browser'; // vcaRepoBrowser + RsVersionCtrlRevertCaption = '&Revert'; // vcaRevert + RsVersionCtrlRevertSandboxCaption = 'Revert ...'; // vcaRevertSandbox + RsVersionCtrlStatusCaption = 'S&tatus'; // vcaStatus + RsVersionCtrlStatusSandboxCaption = 'Status ...'; // vcaStatusSandbox + RsVersionCtrlTagCaption = 'Ta&g'; // vcaTag + RsVersionCtrlTagSandboxCaption = 'Tag ...'; // vcaTagSandBox + RsVersionCtrlUpdateCaption = 'U&pdate'; // vcaUpdate + RsVersionCtrlUpdateSandboxCaption = 'Update ...'; // vcaUpdateSandbox + RsVersionCtrlUpdateToCaption = 'Update &to '; // vcaUpdateTo + RsVersionCtrlUpdateSandboxToCaption = 'Update to ...'; // vcaUpdateSandboxTo + RsVersionCtrlUnlockCaption = '&Unlock'; // vcaUnlock + RsVersionCtrlUnlockSandboxCaption = 'Unlock ...'; // vcaUnlockSandbox + +//=== JclVersionCtrlCVSImpl ================================================== +resourcestring + RsVersionCtrlCVSName = 'cvs'; + RsEEmptyFileName = 'Error: empty file name'; + RSENoTortoiseCVS = 'TortoiseCVS is not detected on the system'; + +//=== JclVersionCtrlSVNImpl ================================================== +resourcestring + RsVersionCtrlSVNName = 'subversion'; + RSENoTortoiseSVN = 'TortoiseSVN is not detected on the system'; + + //=== JclVersionCtrlGITImpl ================================================== +resourcestring + RsVersionCtrlGITName = 'git'; + RSENoTortoiseGIT = 'TortoiseGIT is not detected on the system'; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\vcl'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/vcl/JclVersionControl.pas b/3rdParty/JCL/source/vcl/JclVersionControl.pas new file mode 100644 index 00000000..7efb38cb --- /dev/null +++ b/3rdParty/JCL/source/vcl/JclVersionControl.pas @@ -0,0 +1,863 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is VersionControlImpl.pas } +{ } +{ The Initial Developer of the Original Code is Elahn Ientile. } +{ Portions created by Elahn Ientile are Copyright (C) of Elahn Ientile. } +{ } +{ Contributors: } +{ Florent Ouchet (outchy) } +{ Jens Fudickar (jfudickar) } +{ Sandeep Chandra } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclVersionControl; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclBase, + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, System.Classes, System.Contnrs, Vcl.Graphics, Vcl.Controls, Vcl.ActnList, Vcl.ImgList; + {$ELSE ~HAS_UNITSCOPE} + SysUtils, Classes, Contnrs, Graphics, Controls, ActnList, ImgList; + {$ENDIF ~HAS_UNITSCOPE} + +type + EJclVersionControlError = class(EJclError); + +type + TJclVersionControlActionType = ( + vcaAdd, // add current file + vcaAddSandbox, // add file in the sandbox + vcaBlame, // detailed authors of the current file + vcaBranch, // branch current file + vcaBranchSandbox, // branch files of the sandbox + vcaCheckOutSandbox, // checkout a new sandbox + vcaCommit, // commit the current file + vcaCommitSandbox, // commit files of the sandbox + vcaContextMenu, // explorer context menu of the file + vcaDiff, // diff current file + vcaExplore, // explore folder containing current file + vcaExploreSandbox, // explore sandbox + vcaGraph, // modification graph of the current file + vcaLog, // log of the current file + vcaLogSandbox, // log of files in the sandbox + vcaLock, // lock current file + vcaLockSandbox, // lock files of the sandbox + vcaMerge, // merge current file + vcaMergeSandbox, // merge files of the sandbox + vcaProperties, // properties of the file + vcaPropertiesSandbox, // properties of the sandbox + vcaRename, // rename current file + vcaRenameSandbox, // (renaming current sandbox) will not work inside Delphi + // because the IDE owns handles to project directories + vcaRepoBrowser, // repository browser + vcaRevert, // revert changes in the current file + vcaRevertSandbox, // revert changes in all files of the sandbox + vcaStatus, // status of current file + vcaStatusSandbox, // status of the sandbox + vcaTag, // tag the current file + vcaTagSandBox, // tag the current sandbox + vcaUpdate, // update current file + vcaUpdateSandbox, // update sandbox + vcaUpdateTo, // update current file to... + vcaUpdateSandboxTo, // update sandbox to... + vcaUnlock, // unlock current file + vcaUnlockSandbox // unlock sandbox + ); + + TJclVersionControlActionTypes = set of TJclVersionControlActionType; + + TJclVersionControlActionInfo = record + Sandbox: Boolean; + SaveFile: Boolean; + AllPlugins: Boolean; + Caption: PResStringRec; + ActionName: string; + end; + +type + TJclVersionControlPlugin = class (TObject) + protected + // get supported actions by the plugin + function GetSupportedActionTypes: TJclVersionControlActionTypes; virtual; + // get actions for the current file + function GetFileActions(const FileName: TFileName): TJclVersionControlActionTypes; virtual; + // get actions for the current sandbox (sandbox can be not yet initialized) + function GetSandboxActions(const SdBxName: TFileName): TJclVersionControlActionTypes; virtual; + // true if the plugin is supported (third-party tools present) + function GetEnabled: Boolean; virtual; + // friendly name of the plugin + function GetName: string; virtual; + public + constructor Create; virtual; + destructor Destroy; override; + // returns sandbox names + // returns true and initialized sandbox names if presents + // returns false and all parent directories names if no sandbox is present + function GetSandboxNames(const FileName: TFileName; SdBxNames: TStrings): Boolean; virtual; + // execute the action of a file or on a sandbox + function ExecuteAction(const FileName: TFileName; const Action: TJclVersionControlActionType): Boolean; virtual; + property SupportedActionTypes: TJclVersionControlActionTypes read GetSupportedActionTypes; + property FileActions[const FileName: TFileName]: TJclVersionControlActionTypes read GetFileActions; + property SandboxActions[const SdBxName: TFileName]: TJclVersionControlActionTypes read GetSandboxActions; + property Enabled: Boolean read GetEnabled; + property Name: string read GetName; + end; + + TJclVersionControlPluginClass = class of TJclVersionControlPlugin; + + TJclVersionControlCache = class (TObject) + private + FActions: TJclVersionControlActionTypes; + FCacheStartTime: TDateTime; + FCacheValidityLength: Float; + FFileName: TFileName; + FPlugin: TJclVersionControlPlugin; + FSandboxList: TList; + FSupported: Boolean; + FValidityLengthInt: Float; + function GetSandBox(Index: Integer): TFileName; + function GetSandboxAction(Index: Integer): TJclVersionControlActionTypes; + function GetSandboxCount: Integer; + function GetValidityTime: tDateTime; + procedure SetCacheValidityLength(const Value: Float); + protected + property CacheStartTime: TDateTime read FCacheStartTime; + public + constructor Create(APlugin: TJclVersionControlPlugin; const AFileName: TFileName); + destructor Destroy; override; + function GetValid(const ATime: TDateTime): Boolean; + property Actions: TJclVersionControlActionTypes read FActions; + property CacheValidityLength: Float read FCacheValidityLength write SetCacheValidityLength; + property FileName: TFileName read FFileName; + property Plugin: TJclVersionControlPlugin read FPlugin; + property SandBoxActions[Index: Integer]: TJclVersionControlActionTypes read GetSandboxAction; + property SandBoxCount: Integer read GetSandboxCount; + property SandBoxes[Index: Integer]: TFileName read GetSandBox; + property Supported: Boolean read FSupported; + property ValidityTime: tDateTime read GetValidityTime; + end; + + TJclVersionControlSystemPlugin = class (TJclVersionControlPlugin) + protected + function GetSupportedActionTypes: TJclVersionControlActionTypes; override; + function GetFileActions(const FileName: TFileName): TJclVersionControlActionTypes; override; + function GetSandboxActions(const SdBxName: TFileName): TJclVersionControlActionTypes; override; + function GetEnabled: Boolean; override; + function GetName: string; override; + public + function GetSandboxNames(const FileName: TFileName; SdBxNames: TStrings): Boolean; override; + function ExecuteAction(const FileName: TFileName; const Action: TJclVersionControlActionType): Boolean; override; + end; + + TJclVersionControlPluginList = class (TObject) + private + FCacheValidityLength: Float; + FFileCache: TList; + FPluginList: TObjectList; + procedure ClearFileCache; + function GetPlugin(Index: Integer): TJclVersionControlPlugin; + procedure SetCacheValidityLength(const Value: Float); + public + constructor Create; + destructor Destroy; override; + function Count: Integer; + function GetFileCache(const FileName: TFileName; const Plugin: TJclVersionControlPlugin): TJclVersionControlCache; + //1 Returns the number of enabled plugin classes, which implicit shows if there is any versioncontrol system installed + function NumberOfEnabledPlugins: Integer; + procedure RegisterPluginClass(const APluginClass: TJclVersionControlPluginClass); + procedure UnregisterPluginClass(const APluginClass: TJclVersionControlPluginClass); + property CacheValidityLength: Float read FCacheValidityLength write SetCacheValidityLength; + property Plugins[Index: Integer]: TJclVersionControlPlugin read GetPlugin; + end; + + TJclVersionControlActionsCache = class (TObject) + private + FSandbox: string; + FActionTypes: TJclVersionControlActionTypes; + public + constructor Create(ASandbox: string; AActionTypes: TJclVersionControlActionTypes); + property Sandbox: string read FSandbox; + property ActionTypes: TJclVersionControlActionTypes read FActionTypes; + end; + +function VersionControlPluginList: TJclVersionControlPluginList; +procedure RegisterVersionControlPluginClass(const APluginClass: TJclVersionControlPluginClass); +procedure UnRegisterVersionControlPluginClass(const APluginClass: TJclVersionControlPluginClass); +function VersionControlActionInfo(ActionType : TJclVersionControlActionType): TJclVersionControlActionInfo; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\vcl'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, Vcl.Forms, System.TypInfo, + {$ELSE ~HAS_UNITSCOPE} + Windows, Forms, TypInfo, + {$ENDIF ~HAS_UNITSCOPE} + JclVclResources, JclFileUtils, JclRegistry, JclShell, JclStrings; + +//=== JclVersionControl.pas =================================================== +const + // vcaAdd + JclVersionCtrlAddActionName = 'JclVersionCtrlAddCommand'; + // vcaAddSandbox + JclVersionCtrlAddSandboxActionName = 'JclVersionCtrlAddSandboxCommand'; + // vcaBlame + JclVersionCtrlBlameActionName = 'JclVersionCtrlBlameCommand'; + // vcaBranch + JclVersionCtrlBranchActionName = 'JclVersionCtrlBranchCommand'; + // vcaBranchSandbox + JclVersionCtrlBranchSandboxActionName = 'JclVersionCtrlBranchSandboxCommand'; + // vcaCheckoutSandbox + JclVersionCtrlCheckoutSandboxActionName = 'JclVersionCtrlCheckOutSandboxCommand'; + // vcaCommit + JclVersionCtrlCommitActionName = 'JclVersionCtrlCommitCommand'; + // vcaCommitSandbox + JclVersionCtrlCommitSandboxActionName = 'JclVersionCtrlCommitSandboxCommand'; + // vcaContextMenu + JclVersionCtrlContextMenuActionName = 'JclVersionCtrlContextMenuCommand'; + // vcaDiff + JclVersionCtrlDiffActionName = 'JclVersionCtrlDiffCommand'; + // vcaExplore + JclVersionCtrlExploreActionName = 'JclVersionCtrlExploreCommand'; + // vcaExploreSandbox + JclVersionCtrlExploreSandboxActionName = 'JclVersionCtrlExploreSandboxCommand'; + // vcaGraph + JclVersionCtrlGraphActionName = 'JclVersionCtrlGraphCommand'; + // vcaLog + JclVersionCtrlLogActionName = 'JclVersionCtrlLogCommand'; + // vcaLogSandbox + JclVersionCtrlLogSandboxActionName = 'JclVersionCtrlLogSandboxCommand'; + // vcaLock + JclVersionCtrlLockActionName = 'JclVersionCtrlLockCommand'; + // vcaLockSandbox + JclVersionCtrlLockSandboxActionName = 'JclVersionCtrlLockSandboxCommand'; + // vcaMerge + JclVersionCtrlMergeActionName = 'JclVersionCtrlMergeCommand'; + // vcaMergeSandbox + JclVersionCtrlMergeSandboxActionName = 'JclVersionCtrlMergeSandboxCommand'; + // vcaProperties + JclVersionCtrlPropertiesActionName = 'JclVersionCtrlPropertiesCommand'; + // vcaPropertiesSandbox + JclVersionCtrlPropertiesSandboxActionName = 'JclVersionCtrlPropertiesSandboxCommand'; + // vcaRename + JclVersionCtrlRenameActionName = 'JclVersionCtrlRenameCommand'; + // vcaRenameSandBox + JclVersionCtrlRenameSandboxActionName = 'JclVersionCtrlRenameSandboxCommand'; + // vcaRepoBrowser + JclVersionCtrlRepoBrowserActionName = 'JclVersionCtrlRepoBrowserCommand'; + // vcaRevert + JclVersionCtrlRevertActionName = 'JclVersionCtrlRevertCommand'; + // vcaRevertSandbox + JclVersionCtrlRevertSandboxActionName = 'JclVersionCtrlRevertSandboxCommand'; + // vcaStatus + JclVersionCtrlStatusActionName = 'JclVersionCtrlStatusCommand'; + // vcaStatusSandbox + JclVersionCtrlStatusSandboxActionName = 'JclVersionCtrlStatusSandboxCommand'; + // vcaTag + JclVersionCtrlTagActionName = 'JclVersionCtrlTagCommand'; + // vcaTagSandBox + JclVersionCtrlTagSandboxActionName = 'JclVersionCtrlTagSandboxCommand'; + // vcaUpdate + JclVersionCtrlUpdateActionName = 'JclVersionCtrlUpdateCommand'; + // vcaUpdateSandbox + JclVersionCtrlUpdateSandboxActionName = 'JclVersionCtrlUpdateSandboxCommand'; + // vcaUpdateTo + JclVersionCtrlUpdateToActionName = 'JclVersionCtrlUpdateToCommand'; + // vcaUpdateSandboxTo + JclVersionCtrlUpdateSandboxToActionName = 'JclVersionCtrlUpdateSandboxToCommand'; + // vcaUnlock + JclVersionCtrlUnlockActionName = 'JclVersionCtrlUnlockCommand'; + // vcaUnlockSandbox + JclVersionCtrlUnlockSandboxActionName = 'JclVersionCtrlUnlockSandboxCommand'; + + JclVersionCtrlActOnTopSandboxName = 'ActOnTopSandbox'; + JclVersionCtrlMenuOrganizationName = 'MenuOrganization'; + JclVersionCtrlSaveConfirmationName = 'SaveConfirmation'; + JclVersionCtrlDisableActionsName = 'DisableActions'; + JclVersionCtrlHideActionsName = 'HideActions'; + JclVersionCtrlIconTypeName = 'IconType'; + JclVersionCtrlIconTypeNoIconValue = 'noicon'; + JclVersionCtrlIconTypeJclIconValue = 'jclicons'; + +{$G+} + +const + VersionControlActionInfos: array [TJclVersionControlActionType] of TJclVersionControlActionInfo = + ( (SandBox: False; // vcaAdd + SaveFile: True; + AllPlugins: False; + Caption: @RsVersionCtrlAddCaption; + ActionName: JclVersionCtrlAddActionName), + (SandBox: True; // vcaAddSandbox + SaveFile: True; + AllPlugins: False; + Caption: @RsVersionCtrlAddSandboxCaption; + ActionName: JclVersionCtrlAddSandboxActionName), + (SandBox: False; // vcaBlame + SaveFile: True; + AllPlugins: False; + Caption: @RsVersionCtrlBlameCaption; + ActionName: JclVersionCtrlBlameActionName), + (SandBox: False; // vcaBranch + SaveFile: True; + AllPlugins: False; + Caption: @RsVersionCtrlBranchCaption; + ActionName: JclVersionCtrlBranchActionName), + (SandBox: True; // vcaBranchSandbox + SaveFile: True; + AllPlugins: False; + Caption: @RsVersionCtrlBranchSandboxCaption; + ActionName: JclVersionCtrlBranchSandboxActionName), + (SandBox: True; // vcaCheckOutSandbox + SaveFile: True; + AllPlugins: True; + Caption: @RsVersionCtrlCheckOutSandboxCaption; + ActionName: JclVersionCtrlCheckOutSandboxActionName), + (SandBox: False; // vcaCommit + SaveFile: True; + AllPlugins: False; + Caption: @RsVersionCtrlCommitCaption; + ActionName: JclVersionCtrlCommitActionName), + (SandBox: True; // vcaCommitSandbox + SaveFile: True; + AllPlugins: False; + Caption: @RsVersionCtrlCommitSandboxCaption; + ActionName: JclVersionCtrlCommitSandboxActionName), + (SandBox: False; // vcaContextMenu + SaveFile: False; + AllPlugins: True; + Caption: @RsVersionCtrlContextMenuCaption; + ActionName: JclVersionCtrlContextMenuActionName), + (SandBox: False; // vcaDiff + SaveFile: True; + AllPlugins: False; + Caption: @RsVersionCtrlDiffCaption; + ActionName: JclVersionCtrlDiffActionName), + (SandBox: False; // vcaExplore + SaveFile: False; + AllPlugins: True; + Caption: @RsVersionCtrlExploreCaption; + ActionName: JclVersionCtrlExploreActionName), + (SandBox: True; // vcaExploreSandbox + SaveFile: False; + AllPlugins: True; + Caption: @RsVersionCtrlExploreSandboxCaption; + ActionName: JclVersionCtrlExploreSandboxActionName), + (SandBox: False; // vcaGraph + SaveFile: False; + AllPlugins: False; + Caption: @RsVersionCtrlGraphCaption; + ActionName: JclVersionCtrlGraphActionName), + (SandBox: False; // vcaLog + SaveFile: False; + AllPlugins: False; + Caption: @RsVersionCtrlLogCaption; + ActionName: JclVersionCtrlLogActionName), + (SandBox: True; // vcaLogSandbox + SaveFile: False; + AllPlugins: False; + Caption: @RsVersionCtrlLogSandboxCaption; + ActionName: JclVersionCtrlLogSandboxActionName), + (SandBox: False; // vcaLock + SaveFile: True; + AllPlugins: False; + Caption: @RsVersionCtrlLockCaption; + ActionName: JclVersionCtrlLockActionName), + (SandBox: True; // vcaLockSandbox + SaveFile: True; + AllPlugins: False; + Caption: @RsVersionCtrlLockSandboxCaption; + ActionName: JclVersionCtrlLockSandboxActionName), + (SandBox: False; // vcaMerge + SaveFile: True; + AllPlugins: False; + Caption: @RsVersionCtrlMergeCaption; + ActionName: JclVersionCtrlMergeActionName), + (SandBox: True; // vcaMergeSandbox + SaveFile: True; + AllPlugins: False; + Caption: @RsVersionCtrlMergeSandboxCaption; + ActionName: JclVersionCtrlMergeSandboxActionName), + (SandBox: False; // vcaProperties + SaveFile: True; + AllPlugins: True; + Caption: @RsVersionCtrlPropertiesCaption; + ActionName: JclVersionCtrlPropertiesActionName), + (SandBox: True; // vcaPropertiesSandbox + SaveFile: True; + AllPlugins: True; + Caption: @RsVersionCtrlPropertiesSandboxCaption; + ActionName: JclVersionCtrlPropertiesSandboxActionName), + (SandBox: False; // vcaRename + SaveFile: True; + AllPlugins: False; + Caption: @RsVersionCtrlRenameCaption; + ActionName: JclVersionCtrlRenameActionName), + (SandBox: True; // vcaRenameSandbox + SaveFile: True; + AllPlugins: False; + Caption: @RsVersionCtrlRenameSandboxCaption; + ActionName: JclVersionCtrlRenameSandboxActionName), + (SandBox: False; // vcaRepoBrowser + SaveFile: False; + AllPlugins: False; + Caption: @RsVersionCtrlRepoBrowserCaption; + ActionName: JclVersionCtrlRepoBrowserActionName), + (SandBox: False; // vcaRevert + SaveFile: False; + AllPlugins: False; + Caption: @RsVersionCtrlRevertCaption; + ActionName: JclVersionCtrlRevertActionName), + (SandBox: True; // vcaRevertSandbox + SaveFile: False; + AllPlugins: False; + Caption: @RsVersionCtrlRevertSandboxCaption; + ActionName: JclVersionCtrlRevertSandboxActionName), + (SandBox: False; // vcaStatus + SaveFile: True; + AllPlugins: False; + Caption: @RsVersionCtrlStatusCaption; + ActionName: JclVersionCtrlStatusActionName), + (SandBox: True; // vcaStatusSandbox + SaveFile: True; + AllPlugins: False; + Caption: @RsVersionCtrlStatusSandboxCaption; + ActionName: JclVersionCtrlStatusSandboxActionName), + (SandBox: False; // vcaTag + SaveFile: True; + AllPlugins: False; + Caption: @RsVersionCtrlTagCaption; + ActionName: JclVersionCtrlTagActionName), + (SandBox: True; // vcaTagSandBox + SaveFile: True; + AllPlugins: False; + Caption: @RsVersionCtrlTagSandboxCaption; + ActionName: JclVersionCtrlTagSandboxActionName), + (SandBox: False; // vcaUpdate + SaveFile: True; + AllPlugins: False; + Caption: @RsVersionCtrlUpdateCaption; + ActionName: JclVersionCtrlUpdateActionName), + (SandBox: True; // vcaUpdateSandbox + SaveFile: True; + AllPlugins: False; + Caption: @RsVersionCtrlUpdateSandboxCaption; + ActionName: JclVersionCtrlUpdateSandboxActionName), + (SandBox: False; // vcaUpdateTo + SaveFile: True; + AllPlugins: False; + Caption: @RsVersionCtrlUpdateToCaption; + ActionName: JclVersionCtrlUpdateToActionName), + (SandBox: True; // vcaUpdateSandboxTo + SaveFile: True; + AllPlugins: False; + Caption: @RsVersionCtrlUpdateSandboxToCaption; + ActionName: JclVersionCtrlUpdateSandboxToActionName), + (SandBox: False; // vcaUnlock + SaveFile: True; + AllPlugins: False; + Caption: @RsVersionCtrlUnlockCaption; + ActionName: JclVersionCtrlUnlockActionName), + (SandBox: True; // vcaUnlockSandbox + SaveFile: True; + AllPlugins: False; + Caption: @RsVersionCtrlUnlockSandboxCaption; + ActionName: JclVersionCtrlUnlockSandboxActionName) + ); + +var + GlobalPluginList: TJclVersionControlPluginList = nil; + +function VersionControlPluginList: TJclVersionControlPluginList; +begin + if not Assigned(GlobalPluginList) then + GlobalPluginList := TJclVersionControlPluginList.Create; + Result:= GlobalPluginList; +end; + +procedure RegisterVersionControlPluginClass(const + APluginClass: TJclVersionControlPluginClass); +begin + VersionControlPluginList.RegisterPluginClass(APluginClass); +end; + +procedure UnRegisterVersionControlPluginClass(const APluginClass: TJclVersionControlPluginClass); +begin + VersionControlPluginList.UnregisterPluginClass(APluginClass); +end; + +function VersionControlActionInfo(ActionType : TJclVersionControlActionType): TJclVersionControlActionInfo; +begin + Result := VersionControlActionInfos[ActionType]; +end; + +//=== { TJclVersionControlPlugin } ============================================ + +constructor TJclVersionControlPlugin.Create; +begin + inherited Create; +end; + +destructor TJclVersionControlPlugin.Destroy; +begin + inherited Destroy; +end; + +function TJclVersionControlPlugin.ExecuteAction(const FileName: TFileName; const Action: TJclVersionControlActionType): + Boolean; +begin + Result := False; +end; + +function TJclVersionControlPlugin.GetEnabled: Boolean; +begin + Result := False; +end; + +function TJclVersionControlPlugin.GetFileActions( + const FileName: TFileName): TJclVersionControlActionTypes; +begin + Result := []; +end; + +function TJclVersionControlPlugin.GetSupportedActionTypes: TJclVersionControlActionTypes; +begin + Result := []; +end; + +function TJclVersionControlPlugin.GetName: string; +begin + Result := ''; +end; + +function TJclVersionControlPlugin.GetSandboxActions( + const SdBxName: TFileName): TJclVersionControlActionTypes; +begin + Result := []; +end; + +function TJclVersionControlPlugin.GetSandboxNames(const FileName: TFileName; SdBxNames: TStrings): Boolean; +var + Index: Integer; +begin + Result := False; + + SdBxNames.BeginUpdate; + try + SdBxNames.Clear; + for Index := Length(FileName) downto 1 do + if FileName[Index] = DirDelimiter then + SdBxNames.Add(Copy(FileName, 1, Index)); + finally + SdBxNames.EndUpdate; + end; +end; + +//=== TJclVersionControlCache ================================================ + +constructor TJclVersionControlCache.Create(APlugin: TJclVersionControlPlugin; const AFileName: TFileName); +var + Index: Integer; + SandboxNames: TStrings; +begin + inherited Create; + + FSandboxList := TList.Create; + FFileName := AFileName; + FPlugin := APlugin; + FCacheStartTime := Now; + CacheValidityLength := 5.0; + + FActions := APlugin.FileActions[FileName]; + + SandboxNames := TStringList.Create; + try + FSupported := APlugin.GetSandboxNames(FileName, SandboxNames); + + for Index := 0 to SandboxNames.Count - 1 do + FSandboxList.Add(TJclVersionControlActionsCache.Create(SandboxNames.Strings[Index], APlugin.SandboxActions[SandboxNames.Strings[Index]])); + finally + SandboxNames.Free; + end; +end; + +destructor TJclVersionControlCache.Destroy; +var + Index: Integer; +begin + for Index := 0 to FSandboxList.Count - 1 do + TJclVersionControlActionsCache(FSandboxList.Items[Index]).Free; + FSandboxList.Free; + + inherited Destroy; +end; + +function TJclVersionControlCache.GetSandBox(Index: Integer): TFileName; +begin + Result := TJclVersionControlActionsCache(FSandboxList.Items[Index]).Sandbox; +end; + +function TJclVersionControlCache.GetSandboxAction( + Index: Integer): TJclVersionControlActionTypes; +begin + Result := TJclVersionControlActionsCache(FSandboxList.Items[Index]).ActionTypes; +end; + +function TJclVersionControlCache.GetSandboxCount: Integer; +begin + Result := FSandboxList.Count; +end; + +function TJclVersionControlCache.GetValid(const ATime: TDateTime): Boolean; +begin + Result := (ValidityTime - ATime) > 0; +end; + +function TJclVersionControlCache.GetValidityTime: tDateTime; +begin + Result := CacheStartTime+FValidityLengthInt; +end; + +procedure TJclVersionControlCache.SetCacheValidityLength(const Value: Float); +begin + FCacheValidityLength := Value; + if FCacheValidityLength < 0 then + FCacheValidityLength := 5.0 ; + FValidityLengthInt := FCacheValidityLength / SecsPerDay; +end; + +//=== TJclVersionControlSystemPlugin ========================================= + +function TJclVersionControlSystemPlugin.ExecuteAction(const FileName: TFileName; const Action: + TJclVersionControlActionType): Boolean; +var + AppHandle: THandle; +begin + AppHandle := {$IFDEF BORLAND}Application.Handle{$ELSE}0{$ENDIF}; + + case Action of + vcaContextMenu: + Result := DisplayContextMenu(0, FileName, Mouse.CursorPos); + vcaExplore: + Result := OpenFolder(PathExtractFileDirFixed(FileName), AppHandle, True); + vcaExploreSandbox: + Result := OpenFolder(FileName, AppHandle, True); + vcaProperties, + vcaPropertiesSandbox: + Result := DisplayPropDialog(AppHandle, FileName); + else + Result := inherited ExecuteAction(FileName, Action); + end; +end; + +function TJclVersionControlSystemPlugin.GetEnabled: Boolean; +begin + Result := True; +end; + +function TJclVersionControlSystemPlugin.GetFileActions( + const FileName: TFileName): TJclVersionControlActionTypes; +begin + Result := [vcaContextMenu, vcaExplore, vcaExploreSandbox, vcaProperties, vcaPropertiesSandbox]; +end; + +function TJclVersionControlSystemPlugin.GetName: string; +begin + Result := 'System'; +end; + +function TJclVersionControlSystemPlugin.GetSandboxActions( + const SdBxName: TFileName): TJclVersionControlActionTypes; +begin + Result := [vcaExploreSandbox, vcaPropertiesSandbox]; +end; + +function TJclVersionControlSystemPlugin.GetSandboxNames(const FileName: TFileName; + SdBxNames: TStrings): Boolean; +begin + Result := inherited GetSandboxNames(FileName, SdBxNames); +end; + +function TJclVersionControlSystemPlugin.GetSupportedActionTypes: TJclVersionControlActionTypes; +begin + Result := [vcaContextMenu, vcaExplore, vcaExploreSandbox, vcaProperties, vcaPropertiesSandbox]; +end; + +constructor TJclVersionControlActionsCache.Create(ASandbox: string; AActionTypes: TJclVersionControlActionTypes); +begin + inherited Create; + FSandbox := ASandbox; + FActionTypes := AActionTypes; +end; + +constructor TJclVersionControlPluginList.Create; +begin + inherited Create; + FFileCache := TList.Create; + FPluginList := TObjectList.Create(True); + CacheValidityLength := 5; +end; + +destructor TJclVersionControlPluginList.Destroy; +begin + FreeAndNil(FPluginList); + ClearFileCache; + FreeAndNil(FFileCache); + inherited Destroy; +end; + +procedure TJclVersionControlPluginList.ClearFileCache; +var + Index: Integer; +begin + for Index := FFileCache.Count - 1 downto 0 do + TJclVersionControlCache(FFileCache.Items[Index]).Free; + FFileCache.Clear; +end; + +function TJclVersionControlPluginList.Count: Integer; +begin + Result := FPluginList.Count; +end; + +function TJclVersionControlPluginList.GetFileCache(const FileName: TFileName; const Plugin: TJclVersionControlPlugin): + TJclVersionControlCache; +var + Index: Integer; + AFileCache: TJclVersionControlCache; + ATime: TDateTime; +begin + ATime := Now; + Result := nil; + + for Index := FFileCache.Count - 1 downto 0 do + begin + AFileCache := TJclVersionControlCache(FFileCache.Items[Index]); + if not AFileCache.GetValid(ATime) then + begin + AFileCache.Free; + FFileCache.Delete(Index); + end + else + if (AFileCache.FileName = FileName) and (AFileCache.Plugin = Plugin) then + begin + Result := AFileCache; + Break; + end; + end; + if not Assigned(Result) then + begin + Result := TJclVersionControlCache.Create(Plugin, FileName); + Result.CacheValidityLength := CacheValidityLength; + FFileCache.Add(Result); + end; +end; + +function TJclVersionControlPluginList.GetPlugin(Index: Integer): + TJclVersionControlPlugin; +begin + Result := TJclVersionControlPlugin(FPluginList[Index]); +end; + +function TJclVersionControlPluginList.NumberOfEnabledPlugins: Integer; +var + i: Integer; +begin + Result := 0; + for i := 0 to FPluginList.Count - 1 do + if TJclVersionControlPlugin(FPluginList.Items[i]).Enabled and + not (TJclVersionControlPlugin(FPluginList.Items[i]) is TJclVersionControlSystemPlugin) then + Inc(Result); +end; + +procedure TJclVersionControlPluginList.RegisterPluginClass( + const APluginClass: TJclVersionControlPluginClass); +begin + FPluginList.Add(APluginClass.Create); +end; + +procedure TJclVersionControlPluginList.SetCacheValidityLength(const Value: Float); +begin + FCacheValidityLength := Value; + if FCacheValidityLength < 0 then + FCacheValidityLength := 5.0 ; +end; + +procedure TJclVersionControlPluginList.UnregisterPluginClass( + const APluginClass: TJclVersionControlPluginClass); +var + Index: Integer; + APlugin: TJclVersionControlPlugin; + AFileCache: TJclVersionControlCache; +begin + for Index := FFileCache.Count -1 downto 0 do + begin + AFileCache := TJclVersionControlCache(FFileCache.Items[Index]); + if Assigned(AFileCache.Plugin) and (AFileCache.Plugin.ClassType = APluginClass) then + begin + AFileCache.Free; + FFileCache.Delete(Index); + end; + end; + for Index := FPluginList.Count - 1 downto 0 do + begin + APlugin := TJclVersionControlPlugin(FPluginList.Items[Index]); + if APlugin.ClassType = APluginClass then + FPluginList.Delete(Index); + end; +end; + +initialization + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + + RegisterVersionControlPluginClass(TJclVersionControlSystemPlugin); + +finalization + + UnregisterVersionControlPluginClass(TJclVersionControlSystemPlugin); + FreeAndNil(GlobalPluginList); + + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/vcl/JclVersionCtrlCVSImpl.pas b/3rdParty/JCL/source/vcl/JclVersionCtrlCVSImpl.pas new file mode 100644 index 00000000..55caf6b1 --- /dev/null +++ b/3rdParty/JCL/source/vcl/JclVersionCtrlCVSImpl.pas @@ -0,0 +1,327 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclVersionCtrlCVSImpl.pas } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet. } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. } +{ } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclVersionCtrlCVSImpl; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, Winapi.Windows, System.Classes, Vcl.Graphics, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, Windows, Classes, Graphics, + {$ENDIF ~HAS_UNITSCOPE} + JclVersionControl; + +type + TJclVersionControlCVS = class (TJclVersionControlPlugin) + private + FTortoiseCVSAct: string; + protected + function GetSupportedActionTypes: TJclVersionControlActionTypes; override; + function GetFileActions(const FileName: TFileName): TJclVersionControlActionTypes; override; + function GetSandboxActions(const SdBxName: TFileName): TJclVersionControlActionTypes; override; + function GetEnabled: Boolean; override; + function GetName: string; override; + public + constructor Create; override; + function GetSandboxNames(const FileName: TFileName; SdBxNames: TStrings): Boolean; override; + function ExecuteAction(const FileName: TFileName; + const Action: TJclVersionControlActionType): Boolean; override; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\vcl'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + JclVclResources, + JclFileUtils, JclSysUtils, JclRegistry, JclStrings; + +const +// JclVersionCtrlCVSTrtseShlDLL = 'TrtseShl.dll'; + JclVersionCtrlCVSRegKeyName = 'SOFTWARE\TortoiseCVS'; + JclVersionCtrlCVSRegValueName = 'RootDir'; + JclVersionCtrlCVSTortoiseAct = 'TortoiseAct.exe'; + JclVersionCtrlCVSDirectory = 'CVS\'; + JclVersionCtrlCVSEntriesFile = 'Entries'; + + JclVersionControlCVSAddVerb = 'CVSAdd'; + JclVersionControlCVSAddRecurseVerb = 'CVSAddRecursive'; + JclVersionControlCVSAnnotateVerb = 'CVSAnnotate'; + JclVersionControlCVSBranchVerb = 'CVSBranch'; + JclVersionControlCVSCheckOutVerb = 'CVSCheckOut'; + JclVersionControlCVSCommitVerb = 'CVSCommitDialog'; + JclVersionControlCVSDiffVerb = 'CVSDiff'; + JclVersionControlCVSGraphVerb = 'CVSRevisionGraph'; + JclVersionControlCVSLogVerb = 'CVSLog'; + JclVersionControlCVSEditVerb = 'CVSEdit'; + JclVersionControlCVSListEditorsVerb = 'CVSListEditors'; + JclVersionControlCVSTagVerb = 'CVSTag'; + JclVersionControlCVSUpdateVerb = 'CVSUpdate'; + JclVersionControlCVSUpdateDialogVerb = 'CVSUpdateDialog'; + JclVersionControlCVSUnEditVerb = 'CVSUnedit'; + +//=== TJclVersionControlCVS ================================================== + +constructor TJclVersionControlCVS.Create; +begin + inherited Create; + FTortoiseCVSAct := RegReadStringDef(HKLM, JclVersionCtrlCVSRegKeyName, + JclVersionCtrlCVSRegValueName, ''); + + if FTortoiseCVSAct <> '' then + FTortoiseCVSAct := PathAddSeparator(FTortoiseCVSAct) + JclVersionCtrlCVSTortoiseAct; +end; + +function TJclVersionControlCVS.ExecuteAction(const FileName: TFileName; + const Action: TJclVersionControlActionType): Boolean; + + function CallTortoiseCVSAct(const ActionName: string): Boolean; + var + StartupInfo: TStartupInfo; + ProcessInfo: TProcessInformation; + CurrentDir, CommandLine: TFileName; + begin + ResetMemory(StartupInfo, SizeOf(TStartupInfo)); + ResetMemory(ProcessInfo, SizeOf(TProcessInformation)); + startupInfo.cb := SizeOf(TStartupInfo); + startupInfo.dwFlags := STARTF_USESHOWWINDOW; + startupInfo.wShowWindow := SW_SHOW; + + if FileName = '' then + raise EJclVersionControlError.Create(RsEEmptyFileName); + if not Enabled then + raise EJclVersionControlError.Create(RsENoTortoiseCVS); + + if FileName[Length(FileName)] = DirDelimiter then + CurrentDir := FileName + else + CurrentDir := ExtractFilePath(FileName); + + CommandLine := Format('%s %s -l "%s"', [FTortoiseCVSAct, ActionName, PathRemoveSeparator(FileName)]); + + Result := CreateProcess(nil, PChar(CommandLine), nil, + nil, False, 0, nil, PChar(CurrentDir), StartupInfo, ProcessInfo); + + if Result then + begin + CloseHandle(ProcessInfo.hProcess); + CloseHandle(ProcessInfo.hThread); + end; + Result := False; + end; +begin + case Action of + vcaAdd: + Result := CallTortoiseCVSAct(JclVersionControlCVSAddVerb); + vcaAddSandbox: + Result := CallTortoiseCVSAct(JclVersionControlCVSAddRecurseVerb); + vcaBlame: + Result := CallTortoiseCVSAct(JclVersionControlCVSAnnotateVerb); + vcaBranch, + vcaBranchSandbox: + Result := CallTortoiseCVSAct(JclVersionControlCVSBranchVerb); + vcaCheckOutSandbox: + Result := CallTortoiseCVSAct(JclVersionControlCVSCheckOutVerb); + vcaCommit, + vcaCommitSandbox: + Result := CallTortoiseCVSAct(JclVersionControlCVSCommitVerb); + vcaDiff: + Result := CallTortoiseCVSAct(JclVersionControlCVSDiffVerb); + vcaGraph: + Result := CallTortoiseCVSAct(JclVersionControlCVSGraphVerb); + vcaLog, + vcaLogSandbox: + Result := CallTortoiseCVSAct(JclVersionControlCVSLogVerb); + vcaLock, + vcaLockSandbox: + Result := CallTortoiseCVSAct(JclVersionControlCVSEditVerb); + vcaStatus, + vcaStatusSandbox: + Result := CallTortoiseCVSAct(JclVersionControlCVSListEditorsVerb); + vcaTag, + vcaTagSandBox: + Result := CallTortoiseCVSAct(JclVersionControlCVSTagVerb); + vcaUpdate, + vcaUpdateSandbox: + Result := CallTortoiseCVSAct(JclVersionControlCVSUpdateVerb); + vcaUpdateTo, + vcaUpdateSandboxTo: + Result := CallTortoiseCVSAct(JclVersionControlCVSUpdateDialogVerb); + vcaUnlock, + vcaUnlockSandbox: + Result := CallTortoiseCVSAct(JclVersionControlCVSUnEditVerb); + else + Result := inherited ExecuteAction(FileName, Action); + end; +end; + +function TJclVersionControlCVS.GetEnabled: Boolean; +begin + Result := FTortoiseCVSAct <> ''; +end; + +function TJclVersionControlCVS.GetFileActions( + const FileName: TFileName): TJclVersionControlActionTypes; +var + CvsDirectory, EntriesFileName: TFileName; + Entries: TStrings; + Index: Integer; + FileNameLine: string; + Added: Boolean; +begin + Result := inherited GetFileActions(FileName); + + CvsDirectory := PathAddSeparator(ExtractFilePath(FileName)) + JclVersionCtrlCVSDirectory; + FileNameLine := Format('/%s/', [ExtractFileName(AnsiUpperCase(FileName))]); + + if DirectoryExists(CvsDirectory) and Enabled then + begin + Entries := TStringList.Create; + try + EntriesFileName := CvsDirectory + JclVersionCtrlCVSEntriesFile; + + if FileExists(EntriesFileName) then + begin + Entries.LoadFromFile(EntriesFileName); + Added := False; + for Index := 0 to Entries.Count - 1 do + if Pos(FileNameLine, StrUpper(Entries.Strings[Index])) = 1 then + begin + Added := True; + Break; + end; + + if Added then + // TODO: check modifications + Result := Result + [vcaBlame, vcaBranch, vcaCommit, vcaDiff, vcaGraph, + vcaLog, vcaLock, vcaStatus, vcaTag, vcaUpdate, vcaUpdateTo, vcaUnlock] + else + Result := Result + [vcaAdd]; + end; + finally + Entries.Free; + end; + end; +end; + +function TJclVersionControlCVS.GetSupportedActionTypes: + TJclVersionControlActionTypes; +begin + Result := inherited GetSupportedActionTypes; + if Enabled then + Result := Result + [vcaAdd, vcaAddSandbox, vcaBlame, vcaBranch, + vcaBranchSandbox, vcaCheckOutSandbox, vcaCommit, vcaCommitSandbox, + vcaDiff, vcaGraph, vcaLog, vcaLogSandbox, vcaLock, vcaLockSandbox, + vcaStatus, vcaStatusSandbox, vcaTag, vcaTagSandBox, vcaUpdate, + vcaUpdateSandbox, vcaUpdateTo, vcaUpdateSandboxTo, vcaUnlock, vcaUnlockSandbox]; +end; + +function TJclVersionControlCVS.GetName: string; +begin + Result := LoadResString(@RsVersionCtrlCVSName); +end; + +function TJclVersionControlCVS.GetSandboxActions( + const SdBxName: TFileName): TJclVersionControlActionTypes; +var + CvsDirectory: TFileName; +begin + Result := inherited GetSandboxActions(SdBxName); + + CvsDirectory := sdBxName + JclVersionCtrlCvsDirectory; + + if Enabled then + begin + if DirectoryExists(CvsDirectory) then + Result := Result + [vcaAddSandbox, vcaBranchSandbox, vcaCommitSandbox, + vcaLogSandbox, vcaLockSandbox, vcaStatusSandbox, vcaTagSandBox, + vcaUpdateSandbox, vcaUpdateSandboxTo, vcaUnlockSandbox] + else + Result := Result + [vcaCheckOutSandbox]; + end; +end; + +function TJclVersionControlCVS.GetSandboxNames(const FileName: TFileName; + SdBxNames: TStrings): Boolean; +var + DirectoryName: TFileName; + Index: Integer; +begin + Result := True; + + SdBxNames.BeginUpdate; + try + SdBxNames.Clear; + + if Enabled then + for Index := Length(FileName) downto 1 do + if FileName[Index] = DirDelimiter then + begin + DirectoryName := Copy(FileName, 1, Index); + if DirectoryExists(DirectoryName + JclVersionCtrlCVSDirectory) then + SdBxNames.Add(DirectoryName); + end; + + if SdBxNames.Count = 0 then + Result := inherited GetSandboxNames(FileName, SdBxNames); + finally + SdBxNames.EndUpdate; + end; +end; + + +initialization + + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + RegisterVersionControlPluginClass(TJclVersionControlCVS); + +finalization + + UnregisterVersionControlPluginClass(TJclVersionControlCVS); + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/vcl/JclVersionCtrlGITImpl.pas b/3rdParty/JCL/source/vcl/JclVersionCtrlGITImpl.pas new file mode 100644 index 00000000..11d37d6b --- /dev/null +++ b/3rdParty/JCL/source/vcl/JclVersionCtrlGITImpl.pas @@ -0,0 +1,386 @@ +{ ************************************************************************************************** } +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclVersionCtrlGITImpl.pas } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet. } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. } +{ Portions created by Elahn Ientile are Copyright (C) of Elahn Ientile. } +{ } +{ } +{ ************************************************************************************************** } +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{ ************************************************************************************************** } + +unit JclVersionCtrlGITImpl; + +{$I jcl.inc} + +interface + +uses +{$IFDEF UNITVERSIONING} + JclUnitVersioning, +{$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, Winapi.Windows, System.Classes, Vcl.Graphics, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, Windows, Classes, Graphics, + {$ENDIF ~HAS_UNITSCOPE} + JclVersionControl; + +type + TJclVersionControlGIT = class(TJclVersionControlPlugin) + private + FTortoiseGITProc: string; + protected + function GetEnabled: Boolean; override; + function GetFileActions(const FileName: TFileName): TJclVersionControlActionTypes; override; + function GetGitBaseDir(const FileName: TFileName): string; + function GetName: string; override; + function GetSupportedActionTypes: TJclVersionControlActionTypes; override; + function IsGitSupportedDir(const FileDir: string): Boolean; + public + constructor Create; override; + destructor Destroy; override; + function ExecuteAction(const FileName: TFileName; const Action: TJclVersionControlActionType): Boolean; override; + function GetSandboxNames(const FileName: TFileName; SdBxNames: TStrings): Boolean; override; + end; + +{$IFDEF UNITVERSIONING} + +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; Date: '$Date$'; + LogPath: 'JCL\source\vcl'; Extra: ''; Data: nil); +{$ENDIF UNITVERSIONING} + +implementation + +uses + JclVclResources, + JclFileUtils, JclSysInfo, JclSysUtils, JclRegistry, JclStrings; + +const + JclVersionCtrlRegKeyName = 'SOFTWARE\TortoiseGIT'; + JclVersionCtrlRegValueName = 'ProcPath'; + JclVersionCtrlGITAddVerb = 'add'; + JclVersionCtrlGITBlameVerb = 'blame'; + // JclVersionCtrlGITBranchVerb = 'copy'; + JclVersionCtrlGITCheckOutVerb = 'checkout'; + JclVersionCtrlGITCommitVerb = 'commit'; + JclVersionCtrlGITDiffVerb = 'diff'; + // JclVersionCtrlGITGraphVerb = 'revisiongraph'; + JclVersionCtrlGITLogVerb = 'log'; + // JclVersionCtrlGITLockVerb = 'lock'; + JclVersionCtrlGITMergeVerb = 'merge'; + JclVersionCtrlGITRenameVerb = 'rename'; + JclVersionCtrlGITRepoBrowserVerb = 'repobrowser'; + JclVersionCtrlGITRevertVerb = 'revert'; + JclVersionCtrlGITStatusVerb = 'repostatus'; + // JclVersionCtrlGITTagVerb = 'copy'; + JclVersionCtrlGITUpdateVerb = 'sync'; + // JclVersionCtrlGITUpdateToParam = '/rev'; + // JclVersionCtrlGITUnlockVerb = 'unlock'; + JclVersionCtrlGITDirectory1 = '.git\'; + JclVersionCtrlGITIndexFile = 'index'; + JclVersionCtrlGITIgnoreFile = '.gitignore'; + JclVersionCtrlGITLinkFile = '.git'; + + JclVersionCtrlGITDirectories: array [0 .. 0] of string = (JclVersionCtrlGITDirectory1); + + // === TJclVersionControlGIT ================================================== + +constructor TJclVersionControlGIT.Create; +var + SaveAcc: TJclRegWOW64Access; +begin + inherited Create; + + if IsWindows64 then + begin + // on 64 bit machines look in the 64bit section of registy for tortoise GIT (64bit) registry stuff + SaveAcc := RegGetWOW64AccessMode; + try + RegSetWOW64AccessMode(ra64Key); + FTortoiseGITProc := RegReadStringDef(HKLM, JclVersionCtrlRegKeyName, JclVersionCtrlRegValueName, ''); + finally + RegSetWOW64AccessMode(SaveAcc); + end; + if FTortoiseGITProc = '' then + // when the 64bit Version is not found try to find the 32bit version + FTortoiseGITProc := RegReadStringDef(HKLM, JclVersionCtrlRegKeyName, JclVersionCtrlRegValueName, ''); + end + else + FTortoiseGITProc := RegReadStringDef(HKLM, JclVersionCtrlRegKeyName, JclVersionCtrlRegValueName, ''); +end; + +destructor TJclVersionControlGIT.Destroy; +begin + inherited Destroy; +end; + +function TJclVersionControlGIT.ExecuteAction(const FileName: TFileName; + const Action: TJclVersionControlActionType): Boolean; + + function CallTortoiseGITProc(const ActionName: string; const Param: string = ''): Boolean; + var + StartupInfo: TStartupInfo; + ProcessInfo: TProcessInformation; + CurrentDir, CommandLine: string; + begin + ResetMemory(StartupInfo, SizeOf(TStartupInfo)); + ResetMemory(ProcessInfo, SizeOf(TProcessInformation)); + StartupInfo.cb := SizeOf(TStartupInfo); + StartupInfo.dwFlags := STARTF_USESHOWWINDOW; + StartupInfo.wShowWindow := SW_SHOW; + + if FileName = '' then + raise EJclVersionControlError.Create(RsEEmptyFileName); + if not Enabled then + raise EJclVersionControlError.Create(RsENoTortoiseGIT); + + if FileName[Length(FileName)] = DirDelimiter then + CurrentDir := FileName + else + CurrentDir := ExtractFilePath(FileName); + CommandLine := Format('%s /command:%s /path:"%s" %s /notempfile', [FTortoiseGITProc, ActionName, FileName, Param]); + + Result := CreateProcess(nil, PChar(CommandLine), nil, nil, False, 0, nil, PChar(CurrentDir), StartupInfo, + ProcessInfo); + + if Result then + begin + CloseHandle(ProcessInfo.hProcess); + CloseHandle(ProcessInfo.hThread); + end; + end; + +begin + case Action of + vcaAdd, vcaAddSandbox: + Result := CallTortoiseGITProc(JclVersionCtrlGITAddVerb); + vcaBlame: + Result := CallTortoiseGITProc(JclVersionCtrlGITBlameVerb); + // vcaBranch, + // vcaBranchSandbox: + // Result := CallTortoiseGITProc(JclVersionCtrlGITBranchVerb); + vcaCheckOutSandbox: + Result := CallTortoiseGITProc(JclVersionCtrlGITCheckOutVerb); + vcaCommit, vcaCommitSandbox: + Result := CallTortoiseGITProc(JclVersionCtrlGITCommitVerb); + vcaDiff: + Result := CallTortoiseGITProc(JclVersionCtrlGITDiffVerb); + // vcaGraph: + // Result := CallTortoiseGITProc(JclVersionCtrlGITGraphVerb); + vcaLog, vcaLogSandbox: + Result := CallTortoiseGITProc(JclVersionCtrlGITLogVerb); + // vcaLock, + // vcaLockSandbox: + // Result := CallTortoiseGITProc(JclVersionCtrlGITLockVerb); + vcaMerge, vcaMergeSandbox: + Result := CallTortoiseGITProc(JclVersionCtrlGITMergeVerb); + vcaRename: + Result := CallTortoiseGITProc(JclVersionCtrlGITRenameVerb); + vcaRepoBrowser: + Result := CallTortoiseGITProc(JclVersionCtrlGITRepoBrowserVerb); + vcaRevert, vcaRevertSandbox: + Result := CallTortoiseGITProc(JclVersionCtrlGITRevertVerb); + vcaStatus, vcaStatusSandbox: + Result := CallTortoiseGITProc(JclVersionCtrlGITStatusVerb); + // vcaTag, + // vcaTagSandBox: + // Result := CallTortoiseGITProc(JclVersionCtrlGITTagVerb); + vcaUpdate, vcaUpdateSandbox: + Result := CallTortoiseGITProc(JclVersionCtrlGITUpdateVerb); + // vcaUpdateTo, + // vcaUpdateSandboxTo: + // Result := CallTortoiseGITProc(JclVersionCtrlGITUpdateVerb, JclVersionCtrlGITUpdateToParam); + // vcaUnlock, + // vcaUnlockSandbox: + // Result := CallTortoiseGITProc(JclVersionCtrlGITUnlockVerb); + else + Result := inherited ExecuteAction(FileName, Action); + end; +end; + +function TJclVersionControlGIT.GetEnabled: Boolean; +begin + Result := FTortoiseGITProc <> ''; +end; + +function TJclVersionControlGIT.GetFileActions(const FileName: TFileName): TJclVersionControlActionTypes; +begin + Result := inherited GetFileActions(FileName); + + if Enabled then + begin + if IsGitSupportedDir(ExtractFilePath(FileName)) then + Result := GetSupportedActionTypes; + end; +end; + +function TJclVersionControlGIT.GetGitBaseDir(const FileName: TFileName): string; +var + DirectoryName: String; + IndexFileName: Integer; + IndexDir: Integer; +begin + Result := ''; + if Enabled then + for IndexFileName := Length(FileName) downto 1 do + if FileName[IndexFileName] = DirDelimiter then + begin + DirectoryName := Copy(FileName, 1, IndexFileName); + for IndexDir := Low(JclVersionCtrlGITDirectories) to High(JclVersionCtrlGITDirectories) do + if FileExists(DirectoryName + JclVersionCtrlGITDirectories[IndexDir] + JclVersionCtrlGITIndexFile) then + begin + Result := DirectoryName; + Exit; + end; + + //Account for submodules and multiple worktree's + if FileExists(DirectoryName + JclVersionCtrlGITLinkFile) then + begin + Result := DirectoryName; + Exit; + end; + end; +end; + +function TJclVersionControlGIT.GetName: string; +begin + Result := LoadResString(@RsVersionCtrlGITName); +end; + +function TJclVersionControlGIT.GetSandboxNames(const FileName: TFileName; SdBxNames: TStrings): Boolean; +var + DirectoryName: string; + List: TStringList; + i: Integer; + Found: Boolean; + IndexDir: Integer; +begin + Result := True; + Found := False; + + SdBxNames.BeginUpdate; + try + SdBxNames.Clear; + + if Enabled then + begin + List := TStringList.Create; + try + StrIToStrings(ExtractFilePath(FileName), DirDelimiter, List, True); + for i := List.Count downto 1 do + begin + DirectoryName := StringsToStr(List, DirDelimiter, i)+DirDelimiter; + SdBxNames.Add(DirectoryName); + for IndexDir := Low(JclVersionCtrlGITDirectories) to High(JclVersionCtrlGITDirectories) do + if DirectoryExists(DirectoryName + JclVersionCtrlGITDirectories[IndexDir]) then + begin + // When the first directory is found stop searching + Found := True; + break; + end; + + if FileExists(DirectoryName + DirDelimiter + JclVersionCtrlGITLinkFile) then + begin + // When the first .git file is found stop searching + Found := True; + Break; + end; + + end; + if not Found then // if no direcory is found delete the list + SdBxNames.Clear; + finally + List.Free; + end; + end; + finally + SdBxNames.EndUpdate; + end; + + if SdBxNames.Count = 0 then + Result := inherited GetSandboxNames(FileName, SdBxNames); +end; + +function TJclVersionControlGIT.GetSupportedActionTypes: TJclVersionControlActionTypes; +begin + Result := inherited GetSupportedActionTypes; + if Enabled then + Result := Result + [vcaAdd, { vcaAddSandbox, } vcaBlame, { vcaBranch, + vcaBranchSandbox, vcaCheckOutSandbox, } vcaCommit, + { vcaCommitSandbox, } vcaDiff, + { vcaGraph, } vcaLog, { vcaLogSandbox, vcaLock, vcaLockSandbox, } vcaMerge, + { vcaMergeSandbox, } vcaRename, vcaRepoBrowser, vcaRevert, + { vcaRevertSandbox, } + vcaStatus, { vcaStatusSandbox, vcaTag, vcaTagSandBox, } vcaUpdate { , + vcaUpdateSandbox, vcaUpdateTo, vcaUpdateSandboxTo, vcaUnlock, vcaUnlockSandbox } ]; +end; + +function TJclVersionControlGIT.IsGitSupportedDir(const FileDir: string): Boolean; +var + BaseDir: String; + IgnoreList: TStringList; + IgnoreDir : String; + i: Integer; +begin + Result := False; + if Enabled then + begin + BaseDir := GetGitBaseDir(FileDir); + if (BaseDir <> '') then + begin + if FileExists(BaseDir + JclVersionCtrlGITIgnoreFile) then + begin + IgnoreList := TStringList.Create; + try + IgnoreList.LoadFromFile(BaseDir + JclVersionCtrlGITIgnoreFile); + for i := 0 to IgnoreList.Count - 1 do + if (IgnoreList[i] <> '') then + begin + IgnoreDir := PathAppend(BaseDir, StrReplaceChar(IgnoreList[i], '/', DirDelimiter)); + if PathIsEqualOrChild(FileDir, IgnoreDir) then + Exit; + end; + finally + IgnoreList.Free; + end; + end; + Result := True; + end; + end; +end; + +initialization + +{$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); +{$ENDIF UNITVERSIONING} +RegisterVersionControlPluginClass(TJclVersionControlGIT); + +finalization + +UnregisterVersionControlPluginClass(TJclVersionControlGIT); +{$IFDEF UNITVERSIONING} +UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/vcl/JclVersionCtrlSVNImpl.pas b/3rdParty/JCL/source/vcl/JclVersionCtrlSVNImpl.pas new file mode 100644 index 00000000..eb8f2b15 --- /dev/null +++ b/3rdParty/JCL/source/vcl/JclVersionCtrlSVNImpl.pas @@ -0,0 +1,683 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclVersionCtrlSVNImpl.pas } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet. } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. } +{ Portions created by Elahn Ientile are Copyright (C) of Elahn Ientile. } +{ } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclVersionCtrlSVNImpl; + +{$I jcl.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, Winapi.Windows, System.Classes, Vcl.Graphics, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, Windows, Classes, Graphics, + {$ENDIF ~HAS_UNITSCOPE} + JclVersionControl; + +type + TSvnDirVersion = (sdvNone, sdv10, sdv17); + TJclVersionControlSVN = class (TJclVersionControlPlugin) + private + FSVNStatusCmd: string; + FTortoiseSVNProc: string; + protected + function GetSupportedActionTypes: TJclVersionControlActionTypes; override; + function GetFileActions(const FileName: TFileName): TJclVersionControlActionTypes; override; + function GetSandboxActions(const SdBxName: TFileName): TJclVersionControlActionTypes; override; + function GetEnabled: Boolean; override; + function GetSVNBaseDir(const FileName: TFileName): string; + function GetName: string; override; + function SVNSupportedDirVersion(const FileDir: String): TSvnDirVersion; + public + constructor Create; override; + destructor Destroy; override; + function GetSandboxNames(const FileName: TFileName; SdBxNames: TStrings): Boolean; override; + function ExecuteAction(const FileName: TFileName; + const Action: TJclVersionControlActionType): Boolean; override; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\vcl'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + JclVclResources, + JclFileUtils, JclSysInfo, JclSysUtils, JclRegistry, JclStrings, JclSimpleXml; + +const + JclVersionCtrlRegKeyName = 'SOFTWARE\TortoiseSVN'; + JclVersionCtrlRegValueName = 'ProcPath'; + JclVersionCtrlSVNExeName = 'svn.exe'; + + JclVersionCtrlSVNAddVerb = 'add'; + JclVersionCtrlSVNBlameVerb = 'blame'; + JclVersionCtrlSVNBranchVerb = 'copy'; + JclVersionCtrlSVNCheckOutVerb = 'checkout'; + JclVersionCtrlSVNCommitVerb = 'commit'; + JclVersionCtrlSVNDiffVerb = 'diff'; + JclVersionCtrlSVNGraphVerb = 'revisiongraph'; + JclVersionCtrlSVNLogVerb = 'log'; + JclVersionCtrlSVNLockVerb = 'lock'; + JclVersionCtrlSVNMergeVerb = 'merge'; + JclVersionCtrlSVNRenameVerb = 'rename'; + JclVersionCtrlSVNRepoBrowserVerb = 'repobrowser'; + JclVersionCtrlSVNRevertVerb = 'revert'; + JclVersionCtrlSVNStatusVerb = 'repostatus'; + JclVersionCtrlSVNTagVerb = 'copy'; + JclVersionCtrlSVNUpdateVerb = 'update'; + JclVersionCtrlSVNUpdateToParam = '/rev'; + JclVersionCtrlSVNUnlockVerb = 'unlock'; + +// JclVersionCtrlSVNTortoiseDLL = 'TortoiseSVN.dll'; + JclVersionCtrlSVNDirectory1 = '.svn\'; + JclVersionCtrlSVNDirectory2 = '_svn\'; + JclVersionCtrlSVNEntryFile = 'entries'; + JclVersionCtrlSVNDbFile = 'wc.db'; + + JclVersionCtrlSVNStatusElementName = 'status'; + JclVersionCtrlSVNTargetElementName = 'target'; + JclVersionCtrlSVNEntryElementName = 'entry'; + JclVersionCtrlSVNWCStatusElementName = 'wc-status'; + //JclVersionCtrlSVNPropsPropertyName = 'props'; + JclVersionCtrlSVNItemPropertyName = 'item'; + JclVersionCtrlSVNPathPropertyName = 'path'; + JclVersionCtrlSVNUnversionedPropertyValue = 'unversioned'; + + JclVersionCtrlSVNDirectories: array [0..1] of string = + ( JclVersionCtrlSVNDirectory1, JclVersionCtrlSVNDirectory2 ); + +//=== TJclVersionControlSVN ================================================== + +constructor TJclVersionControlSVN.Create; +var + SaveAcc: TJclRegWOW64Access; +begin + inherited Create; + + if IsWindows64 then + begin + // on 64 bit machines look in the 64bit section of registy for tortoise SVN (64bit) registry stuff + SaveAcc := RegGetWOW64AccessMode; + try + RegSetWOW64AccessMode(ra64Key); + FTortoiseSVNProc := RegReadStringDef(HKLM, JclVersionCtrlRegKeyName, JclVersionCtrlRegValueName, ''); + finally + RegSetWOW64AccessMode(SaveAcc); + end; + if FTortoiseSVNProc = '' then // when the 64bit Version is not found try to find the 32bit version + FTortoiseSVNProc := RegReadStringDef(HKLM, JclVersionCtrlRegKeyName, JclVersionCtrlRegValueName, ''); + end + else + FTortoiseSVNProc := RegReadStringDef(HKLM, JclVersionCtrlRegKeyName, JclVersionCtrlRegValueName, ''); + + FSVNStatusCmd := PathAddSeparator(ExtractFilePath(FTortoiseSVNProc)) + JclVersionCtrlSVNExeName; + if FileExists(FSVNStatusCmd) then + FSVNStatusCmd := FSVNStatusCmd + ' status --xml --non-interactive --depth=empty --verbose ' + else + FSVNStatusCmd := ''; +end; + +destructor TJclVersionControlSVN.Destroy; +begin + inherited Destroy; +end; + +function TJclVersionControlSVN.ExecuteAction(const FileName: TFileName; + const Action: TJclVersionControlActionType): Boolean; + + function CallTortoiseSVNProc(const ActionName: string; + const Param: string = ''): Boolean; + var + StartupInfo: TStartupInfo; + ProcessInfo: TProcessInformation; + CurrentDir, CommandLine: string; + begin + ResetMemory(StartupInfo, SizeOf(TStartupInfo)); + ResetMemory(ProcessInfo, SizeOf(TProcessInformation)); + startupInfo.cb := SizeOf(TStartupInfo); + startupInfo.dwFlags := STARTF_USESHOWWINDOW; + startupInfo.wShowWindow := SW_SHOW; + + if FileName = '' then + raise EJclVersionControlError.Create(RsEEmptyFileName); + if not Enabled then + raise EJclVersionControlError.Create(RsENoTortoiseSVN); + + if FileName[Length(FileName)] = DirDelimiter then + CurrentDir := FileName + else + CurrentDir := ExtractFilePath(FileName); + CommandLine := Format('%s /command:%s /path:"%s" %s /notempfile', [FTortoiseSVNProc, ActionName, FileName, Param]); + + Result := CreateProcess(nil, PChar(CommandLine), nil, + nil, False, 0, nil, PChar(CurrentDir), StartupInfo, ProcessInfo); + + if Result then + begin + CloseHandle(ProcessInfo.hProcess); + CloseHandle(ProcessInfo.hThread); + end; + end; + +begin + case Action of + vcaAdd, + vcaAddSandbox: + Result := CallTortoiseSVNProc(JclVersionCtrlSVNAddVerb); + vcaBlame : + Result := CallTortoiseSVNProc(JclVersionCtrlSVNBlameVerb); + vcaBranch, + vcaBranchSandbox: + Result := CallTortoiseSVNProc(JclVersionCtrlSVNBranchVerb); + vcaCheckOutSandbox: + Result := CallTortoiseSVNProc(JclVersionCtrlSVNCheckOutVerb); + vcaCommit, + vcaCommitSandbox: + Result := CallTortoiseSVNProc(JclVersionCtrlSVNCommitVerb); + vcaDiff: + Result := CallTortoiseSVNProc(JclVersionCtrlSVNDiffVerb); + vcaGraph: + Result := CallTortoiseSVNProc(JclVersionCtrlSVNGraphVerb); + vcaLog, + vcaLogSandbox: + Result := CallTortoiseSVNProc(JclVersionCtrlSVNLogVerb); + vcaLock, + vcaLockSandbox: + Result := CallTortoiseSVNProc(JclVersionCtrlSVNLockVerb); + vcaMerge, + vcaMergeSandbox: + Result := CallTortoiseSVNProc(JclVersionCtrlSVNMergeVerb); + vcaRename: + Result := CallTortoiseSVNProc(JclVersionCtrlSVNRenameVerb); + vcaRepoBrowser: + Result := CallTortoiseSVNProc(JclVersionCtrlSVNRepoBrowserVerb); + vcaRevert, + vcaRevertSandbox: + Result := CallTortoiseSVNProc(JclVersionCtrlSVNRevertVerb); + vcaStatus, + vcaStatusSandbox: + Result := CallTortoiseSVNProc(JclVersionCtrlSVNStatusVerb); + vcaTag, + vcaTagSandBox: + Result := CallTortoiseSVNProc(JclVersionCtrlSVNTagVerb); + vcaUpdate, + vcaUpdateSandbox: + Result := CallTortoiseSVNProc(JclVersionCtrlSVNUpdateVerb); + vcaUpdateTo, + vcaUpdateSandboxTo: + Result := CallTortoiseSVNProc(JclVersionCtrlSVNUpdateVerb, JclVersionCtrlSVNUpdateToParam); + vcaUnlock, + vcaUnlockSandbox: + Result := CallTortoiseSVNProc(JclVersionCtrlSVNUnlockVerb); + else + Result := inherited ExecuteAction(FileName, Action); + end; +end; + +function TJclVersionControlSVN.GetEnabled: Boolean; +begin + Result := FTortoiseSVNProc <> ''; +end; + +function TJclVersionControlSVN.GetFileActions(const FileName: TFileName): TJclVersionControlActionTypes; + + // internal method to get file actions (not complete and not compatible with SVN 1.7 wc + function GetSVNInternalFileActions(const FileName: TFileName; var Actions: TJclVersionControlActionTypes): Boolean; + var + EntryLine: string; + EntryFileName, UpperCaseFileName, XmlFileNameValue: TFileName; + Entries: TJclAnsiMappedTextReader; + IndexDir: Integer; + begin + UpperCaseFileName := StrUpper(ExtractFileName(FileName)); + XmlFileNameValue := Format('NAME="%s"', [UpperCaseFileName]); + + for IndexDir := Low(JclVersionCtrlSVNDirectories) to High(JclVersionCtrlSVNDirectories) do + begin + Result := False; + + EntryFileName := PathAddSeparator(ExtractFilePath(FileName)) + + JclVersionCtrlSVNDirectories[IndexDir] + JclVersionCtrlSVNEntryFile; + + if FileExists(EntryFileName) then + begin + Entries := TJclAnsiMappedTextReader.Create(EntryFileName); + try + while not Entries.Eof do + begin + EntryLine := string(Entries.ReadLn); + // old SVN entries file (xml-like) + if Pos(XmlFileNameValue, StrUpper(EntryLine)) > 0 then + begin + Result := True; + // TODO: check modifications + Actions := Actions + [vcaBlame, vcaBranch, vcaCommit, vcaDiff, vcaGraph, + vcaLog, vcaLock, vcaMerge, vcaRename, vcaRevert, vcaRepoBrowser, + vcaStatus, vcaTag, vcaUpdate, vcaUpdateTo, vcaUnlock]; + FreeAndNil(Entries); + Exit; + end; + // new SVN entries file (flat-style) + if EntryLine = NativeFormFeed then + begin + EntryLine := string(Entries.ReadLn); + if StrSame(UpperCaseFileName, StrUpper(EntryLine)) then + begin + Result := True; + // TODO: check modifications + Actions := Actions + [vcaBlame, vcaBranch, vcaCommit, vcaDiff, vcaGraph, + vcaLog, vcaLock, vcaMerge, vcaRename, vcaRevert, vcaRepoBrowser, + vcaStatus, vcaTag, vcaUpdate, vcaUpdateTo, vcaUnlock]; + FreeAndNil(Entries); + Exit; + end; + end; + end; + finally + Entries.Free; + end; + Actions := Actions + [vcaAdd]; + end; + end; + end; + + // external method: rely on svn.exe to get file actions + function GetSVNExecutableFileActions(const FileName: TFileName; var Actions: TJclVersionControlActionTypes): Boolean; + var + SVNOutput, SVNError: string; + XML: TJclSimpleXML; + TargetElement, EntryElement, WcStatusElement: TJclSimpleXMLElem; + ItemProp: TJclSimpleXMLProp; + begin + Result := False; + if Execute(FSVNStatusCmd + FileName, SVNOutput, SVNError) <> 0 then + Exit; + + XML := TJclSimpleXML.Create; + try + XML.LoadFromString(SVNOutput); + XML.Options := XML.Options - [sxoAutoCreate]; + if XML.Root.Name <> JclVersionCtrlSVNStatusElementName then + Exit; + + TargetElement := XML.Root.Items.ItemNamed[JclVersionCtrlSVNTargetElementName]; + if not Assigned(TargetElement) then + Exit; + + EntryElement := TargetElement.Items.ItemNamed[JclVersionCtrlSVNEntryElementName]; + if not Assigned(EntryElement) then + Exit; + + WcStatusElement := EntryElement.Items.ItemNamed[JclVersionCtrlSVNWcStatusElementName]; + if not Assigned(WcStatusElement) then + Exit; + + ItemProp := WcStatusElement.Properties.ItemNamed[JclVersionCtrlSVNItemPropertyName]; + if not Assigned(ItemProp) then + Exit; + + Result := True; + + if ItemProp.Value = JclVersionCtrlSVNUnversionedPropertyValue then + Actions := Actions + [vcaAdd, vcaRepoBrowser, vcaStatus] + else + // TODO: check modifications + Actions := Actions + [vcaBlame, vcaBranch, vcaCommit, vcaDiff, vcaGraph, + vcaLog, vcaLock, vcaMerge, vcaRename, vcaRevert, vcaRepoBrowser, + vcaStatus, vcaTag, vcaUpdate, vcaUpdateTo, vcaUnlock]; + finally + XML.Free; + end; + end; + +var + Found: Boolean; + SupportedDirVersion: TSvnDirVersion; +begin + Result := inherited GetFileActions(FileName); + + Found := not Enabled; + + // SVN 1.7 repos: invoke SVN to query the working copy + if (not Found) and (FSVNStatusCmd <> '') then + Found := GetSVNExecutableFileActions(FileName, Result); + + // SVN 1.6 repos: direct queries on the working copy + if not Found then + begin + SupportedDirVersion := SVNSupportedDirVersion(ExtractFilePath(FileName)); + if SupportedDirVersion = sdv17 then + begin + Result := GetSupportedActionTypes; + Exit; + end + else if SupportedDirVersion = sdvNone then + Exit; + + //Found := GetSVNInternalFileActions(FileName, Result); + GetSVNInternalFileActions(FileName, Result); + end; +end; + +function TJclVersionControlSVN.GetSVNBaseDir(const FileName: TFileName): string; +var + DirectoryName: String; + IndexFileName: Integer; + IndexDir: Integer; +begin + Result := ''; + if Enabled then + for IndexFileName := Length(FileName) downto 1 do + if FileName[IndexFileName] = DirDelimiter then + begin + DirectoryName := Copy(FileName, 1, IndexFileName); + for IndexDir := Low(JclVersionCtrlSVNDirectories) to High(JclVersionCtrlSVNDirectories) do + if FileExists(DirectoryName + JclVersionCtrlSVNDirectories[IndexDir] + JclVersionCtrlSVNEntryFile) then + begin + Result := DirectoryName; + Exit; + end; + end; +end; + +function TJclVersionControlSVN.GetSupportedActionTypes: TJclVersionControlActionTypes; +begin + Result := inherited GetSupportedActionTypes; + if Enabled then + Result := Result + [vcaAdd, vcaAddSandbox, vcaBlame, vcaBranch, + vcaBranchSandbox, vcaCheckOutSandbox, vcaCommit, vcaCommitSandbox, vcaDiff, + vcaGraph, vcaLog, vcaLogSandbox, vcaLock, vcaLockSandbox, vcaMerge, + vcaMergeSandbox, vcaRename, vcaRepoBrowser, vcaRevert, vcaRevertSandbox, + vcaStatus, vcaStatusSandbox, vcaTag, vcaTagSandBox, vcaUpdate, + vcaUpdateSandbox, vcaUpdateTo, vcaUpdateSandboxTo, vcaUnlock, vcaUnlockSandbox]; +end; + +function TJclVersionControlSVN.GetName: string; +begin + Result := LoadResString(@RsVersionCtrlSVNName); +end; + +function TJclVersionControlSVN.GetSandboxActions( + const SdBxName: TFileName): TJclVersionControlActionTypes; + + function GetSVNInternalSandboxActions(const SdBxName: TFileName; out Actions: TJclVersionControlActionTypes): Boolean; + var + SvnDirectory: string; + IndexDir: Integer; + begin + Result := False; + // not in a sandbox + Actions := Actions + [vcaCheckOutSandbox]; + + for IndexDir := Low(JclVersionCtrlSVNDirectories) to High(JclVersionCtrlSVNDirectories) do + begin + SvnDirectory := sdBxName + JclVersionCtrlSVNDirectories[IndexDir]; + + if DirectoryExists(SvnDirectory) then + begin + Result := True; + Actions := Actions + [vcaAddSandbox, vcaBranchSandbox, vcaCommitSandbox, + vcaLogSandbox, vcaLockSandbox, vcaMergeSandbox, vcaRevertSandbox, + vcaStatusSandbox, vcaTagSandBox, vcaUpdateSandbox, vcaUpdateSandboxTo, + vcaUnlockSandbox] - [vcaCheckOutSandbox]; + Exit; + end; + end; + end; + + function GetSVNExecutableSandboxActions(const SdBxName: TFileName; out Actions: TJclVersionControlActionTypes): Boolean; + var + SVNOutput, SVNError: string; + XML: TJclSimpleXML; + TargetElement, EntryElement, WcStatusElement: TJclSimpleXMLElem; + ItemProp: TJclSimpleXMLProp; + begin + Result := False; + // not in a sandbox + Actions := Actions + [vcaCheckOutSandbox]; + + if Execute(FSVNStatusCmd + SdBxName, SVNOutput, SVNError) <> 0 then + Exit; + + XML := TJclSimpleXML.Create; + try + XML.LoadFromString(SVNOutput); + XML.Options := XML.Options - [sxoAutoCreate]; + if XML.Root.Name <> JclVersionCtrlSVNStatusElementName then + Exit; + + TargetElement := XML.Root.Items.ItemNamed[JclVersionCtrlSVNTargetElementName]; + if not Assigned(TargetElement) then + Exit; + + EntryElement := TargetElement.Items.ItemNamed[JclVersionCtrlSVNEntryElementName]; + if not Assigned(EntryElement) then + Exit; + + WcStatusElement := EntryElement.Items.ItemNamed[JclVersionCtrlSVNWcStatusElementName]; + if not Assigned(WcStatusElement) then + Exit; + + ItemProp := WcStatusElement.Properties.ItemNamed[JclVersionCtrlSVNItemPropertyName]; + if not Assigned(ItemProp) then + Exit; + + if ItemProp.Value <> JclVersionCtrlSVNUnversionedPropertyValue then + begin + Result := True; + Actions := Actions + [vcaAddSandbox, vcaBranchSandbox, vcaCommitSandbox, + vcaLogSandbox, vcaLockSandbox, vcaMergeSandbox, vcaRevertSandbox, + vcaStatusSandbox, vcaTagSandBox, vcaUpdateSandbox, vcaUpdateSandboxTo, + vcaUnlockSandbox] - [vcaCheckOutSandbox]; + end; + finally + XML.Free; + end; + end; + +var + Found: Boolean; +begin + Result := inherited GetSandboxActions(SdBxName); + + Found := not Enabled; + if (not Found) and (FSVNStatusCmd <> '') then + Found := GetSVNExecutableSandboxActions(SdBxName, Result); + if not Found then + // Found := GetSVNInternalSandboxActions(SdBxName, Result); + GetSVNInternalSandboxActions(SdBxName, Result); +end; + +function TJclVersionControlSVN.GetSandboxNames(const FileName: TFileName; + SdBxNames: TStrings): Boolean; + + // internal method, not complete, not compatible with SVN 1.7 + function GetSVNInternalSandboxNames(const FileName: TFileName; SdBxNames: TStrings): Boolean; + var + DirectoryName: string; + IndexDir, IndexFileName: Integer; + begin + SdBxNames.BeginUpdate; + try + SdBxNames.Clear; + + for IndexFileName := Length(FileName) downto 1 do + if FileName[IndexFileName] = DirDelimiter then + begin + DirectoryName := Copy(FileName, 1, IndexFileName); + for IndexDir := Low(JclVersionCtrlSVNDirectories) to High(JclVersionCtrlSVNDirectories) do + begin + if DirectoryExists(DirectoryName + JclVersionCtrlSVNDirectories[IndexDir]) then + SdBxNames.Add(DirectoryName); + end; + end; + finally + SdBxNames.EndUpdate; + end; + + Result := SdBxNames.Count > 0; + end; + + function GetSVNExecutableSandboxNames(const FileName: TFileName; SdBxNames: TStrings): Boolean; + var + ParentDirectories: TStrings; + Index: Integer; + SVNOutput, SVNError: string; + XML: TJclSimpleXML; + TargetElements: TJclSimpleXMLNamedElems; + TargetElement, EntryElement, WcStatusElement: TJclSimpleXMLElem; + PathProp, ItemProp: TJclSimpleXMLProp; + begin + Result := False; + + ParentDirectories := TStringList.Create; + try + for Index := Length(FileName) downto 1 do + if FileName[Index] = DirDelimiter then + ParentDirectories.Add(Copy('"' + FileName, 1, Index) + '"'); + + if Execute(FSVNStatusCmd + StringsToStr(ParentDirectories, NativeSpace, False), SVNOutput, SVNError) <> 0 then + Exit; + finally + ParentDirectories.Free; + end; + + XML := TJclSimpleXML.Create; + try + XML.LoadFromString(SVNOutput); + XML.Options := XML.Options - [sxoAutoCreate]; + if XML.Root.Name <> JclVersionCtrlSVNStatusElementName then + Exit; + + TargetElements := XML.Root.Items.NamedElems[JclVersionCtrlSVNTargetElementName]; + + SdBxNames.BeginUpdate; + try + SdBxNames.Clear; + + for Index := 0 to TargetElements.Count - 1 do + begin + TargetElement := TargetElements.Item[Index]; + if not Assigned(TargetElement) then + Continue; + + EntryElement := TargetElement.Items.ItemNamed[JclVersionCtrlSVNEntryElementName]; + if not Assigned(EntryElement) then + Continue; + + PathProp := EntryElement.Properties.ItemNamed[JclVersionCtrlSVNPathPropertyName]; + if not Assigned(PathProp) then + Continue; + + WcStatusElement := EntryElement.Items.ItemNamed[JclVersionCtrlSVNWcStatusElementName]; + if not Assigned(WcStatusElement) then + Continue; + + ItemProp := WcStatusElement.Properties.ItemNamed[JclVersionCtrlSVNItemPropertyName]; + if not Assigned(ItemProp) then + Continue; + + if ItemProp.Value <> JclVersionCtrlSVNUnversionedPropertyValue then + SdBxNames.Add(PathProp.Value); + end; + finally + SdBxNames.EndUpdate; + end; + finally + XML.Free; + end; + + Result := SdBxNames.Count > 0; + end; + +begin + Result := not Enabled; + + if (not Result) and (FSVNStatusCmd <> '') then + Result := GetSVNExecutableSandboxNames(FileName, SdBxNames); + + if not Result then + Result := GetSVNInternalSandboxNames(FileName, SdBxNames); + + if SdBxNames.Count = 0 then + Result := inherited GetSandboxNames(FileName, SdBxNames); +end; + +function TJclVersionControlSVN.SVNSupportedDirVersion(const FileDir: String): TSvnDirVersion; +var + BaseDir: String; + //IgnoreList: TStringList; + //IgnoreDir : String; + //i: Integer; + IndexDir: Integer; +begin + Result := sdvNone; + if Enabled then + begin + BaseDir := GetSVNBaseDir(FileDir); + if (BaseDir <> '') then + begin + Result := sdv10; + for IndexDir := Low(JclVersionCtrlSVNDirectories) to High(JclVersionCtrlSVNDirectories) do + if FileExists(BaseDir + JclVersionCtrlSVNDirectories[IndexDir] + JclVersionCtrlSVNDbFile) then + begin + Result := sdv17; + exit; + end + end; + end; +end; + +initialization + + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + RegisterVersionControlPluginClass(TJclVersionControlSVN); + +finalization + + UnregisterVersionControlPluginClass(TJclVersionControlSVN); + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/vcl/dirinfo.txt b/3rdParty/JCL/source/vcl/dirinfo.txt new file mode 100644 index 00000000..a4780840 --- /dev/null +++ b/3rdParty/JCL/source/vcl/dirinfo.txt @@ -0,0 +1 @@ +This is the place where VCL dependent units reside. \ No newline at end of file diff --git a/3rdParty/JCL/source/windows/Hardlinks.pas b/3rdParty/JCL/source/windows/Hardlinks.pas new file mode 100644 index 00000000..7f047ca5 --- /dev/null +++ b/3rdParty/JCL/source/windows/Hardlinks.pas @@ -0,0 +1,722 @@ +{**************************************************************************************************} +{ WARNING: JEDI preprocessor generated unit. Do not edit. } +{**************************************************************************************************} + +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Initial Developer of the Original Code is Oliver Schneider (Assarbad att gmx dott info). } +{ Portions created by Oliver Schneider are Copyright (C) 1995 - 2004 Oliver Schneider. } +{ All rights reserved. } +{ } +{ Obtained through: } +{ Joint Endeavour of Delphi Innovators (Project JEDI) } +{ } +{ You may retrieve the latest version of the original file at the Original Developer's homepage, } +{ located at [http://assarbad.net]. Note that the original file can be used with an arbitrary OSI- } +{ approved license as long as you follow the additional terms given in the original file. } +{ Additionally a C/C++ (MS VC++) version is available under the same terms. } +{ } +{ Contributor(s): } +{ Oliver Schneider (assarbad) } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ } +{**************************************************************************************************} +{ } +{ Windows NT 4.0 compatible implementation of the CreateHardLink() API introduced in Windows } +{ 2000. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + + +unit Hardlinks; + +{$I jcl.inc} +{$I windowsonly.inc} + +// ALL enabled by default for Project JEDI +{$DEFINE STDCALL} // Make functions STDCALL always +{$DEFINE RTDL} // Use runtime dynamic linking +{$DEFINE PREFERAPI} // Prefer the "real" Windows API on systems on which it exists + // If this is defined STDCALL is automatically needed and defined! + +{$ALIGN ON} +{$MINENUMSIZE 4} + +interface + +//DOM-IGNORE-BEGIN + +(* + All possible combinations of the above DEFINEs have been tested and work fine. + + # | A B C + ---|--------- + 1 | 0 0 0 A = STDCALL + 2 | 0 0 X B = RTDL + 3 | X 0 0 C = PREFERAPI + 4 | X 0 X + 5 | X X 0 + 6 | X X X +*) +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows; + {$ELSE ~HAS_UNITSCOPE} + Windows; + {$ENDIF ~HAS_UNITSCOPE} + + +{$EXTERNALSYM CreateHardLinkW} +{$EXTERNALSYM CreateHardLinkA} + + +// Well, we did not decide yet ;) - bind to either address, depending on whether +// the API could be found. +type + TFNCreateHardLinkW = function(szLinkName, szLinkTarget: PWideChar; lpSecurityAttributes: PSecurityAttributes): BOOL; stdcall; + TFNCreateHardLinkA = function(szLinkName, szLinkTarget: PAnsiChar; lpSecurityAttributes: PSecurityAttributes): BOOL; stdcall; +var + CreateHardLinkW: TFNCreateHardLinkW = nil; + CreateHardLinkA: TFNCreateHardLinkA = nil; + +var + hNtDll: THandle = 0; // For runtime dynamic linking + bRtdlFunctionsLoaded: Boolean = False; // To show wether the RTDL functions had been loaded + +//DOM-IGNORE-END + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +const + szNtDll = 'NTDLL.DLL'; // Import native APIs from this DLL + szKernel32 = 'KERNEL32.DLL'; + szCreateHardLinkA = 'CreateHardLinkA'; + szCreateHardLinkW = 'CreateHardLinkW'; + +(****************************************************************************** + + Note, I only include function prototypes and constants here which are needed! + For other prototypes or constants check out the related books of + - Gary Nebbett + - Sven B. Schreiber + - Rajeev Nagar + + Note, one my homepage I have also some Native APIs listed in Delphi translated + form. Not all of them might be translated correctly with respect to the fact + whether or not they are pointer and whether or not the alignment of variables + or types is always correct. This might be reviewed by me somewhen in future. + + ******************************************************************************) + +// ================================================================= +// Type definitions +// ================================================================= +type + NTSTATUS = Longint; + +type + UNICODE_STRING = record + Length: WORD; + MaximumLength: WORD; + Buffer: PWideChar; + end; + PUNICODE_STRING = ^UNICODE_STRING; + +// type + // ANSI_STRING = record + // Length: WORD; + // MaximumLength: WORD; + // Buffer: PAnsiChar; + // end; + // PANSI_STRING = ^ANSI_STRING; + +type + OBJECT_ATTRIBUTES = record + Length: ULONG; + RootDirectory: THandle; + ObjectName: PUNICODE_STRING; + Attributes: ULONG; + SecurityDescriptor: Pointer; // Points to type SECURITY_DESCRIPTOR + SecurityQualityOfService: Pointer; // Points to type SECURITY_QUALITY_OF_SERVICE + end; + // POBJECT_ATTRIBUTES = ^OBJECT_ATTRIBUTES; + +type + IO_STATUS_BLOCK = record + case integer of + 0: + (Status: NTSTATUS); + 1: + (Pointer: Pointer; + Information: ULONG); // 'Information' does not belong to the union! + end; + // PIO_STATUS_BLOCK = ^IO_STATUS_BLOCK; + +type + _FILE_LINK_RENAME_INFORMATION = record // File Information Classes 10 and 11 + ReplaceIfExists: BOOL; + RootDirectory: THandle; + FileNameLength: ULONG; + FileName: array[0..0] of WideChar; + end; + FILE_LINK_INFORMATION = _FILE_LINK_RENAME_INFORMATION; + PFILE_LINK_INFORMATION = ^FILE_LINK_INFORMATION; + // FILE_RENAME_INFORMATION = _FILE_LINK_RENAME_INFORMATION; + // PFILE_RENAME_INFORMATION = ^FILE_RENAME_INFORMATION; + +// ================================================================= +// Constants +// ================================================================= +const + FileLinkInformation = 11; + FILE_SYNCHRONOUS_IO_NONALERT = $00000020; // All operations on the file are + // performed synchronously. Waits + // in the system to synchronize I/O + // queuing and completion are not + // subject to alerts. This flag + // also causes the I/O system to + // maintain the file position context. + // If this flag is set, the + // DesiredAccess SYNCHRONIZE flag also + // must be set. + FILE_OPEN_FOR_BACKUP_INTENT = $00004000; // The file is being opened for backup + // intent, hence, the system should + // check for certain access rights + // and grant the caller the appropriate + // accesses to the file before checking + // the input DesiredAccess against the + // file's security descriptor. + FILE_OPEN_REPARSE_POINT = $00200000; + DELETE = $00010000; + SYNCHRONIZE = $00100000; + STATUS_SUCCESS = NTSTATUS(0); + OBJ_CASE_INSENSITIVE = $00000040; + SYMBOLIC_LINK_QUERY = $00000001; + + // Should be defined, but isn't + HEAP_ZERO_MEMORY = $00000008; + + // Related constant(s) for RtlDetermineDosPathNameType_U() + // INVALID_PATH = 0; + UNC_PATH = 1; + // ABSOLUTE_DRIVE_PATH = 2; + // RELATIVE_DRIVE_PATH = 3; + // ABSOLUTE_PATH = 4; + // RELATIVE_PATH = 5; + // DEVICE_PATH = 6; + // UNC_DOT_PATH = 7; + +// ================================================================= +// Function prototypes +// ================================================================= + + + +type + TRtlCreateUnicodeStringFromAsciiz = function(var destination: UNICODE_STRING; + source: PAnsiChar): Boolean; stdcall; + + TZwClose = function(Handle: THandle): NTSTATUS; stdcall; + + TZwSetInformationFile = function(FileHandle: THandle; + var IoStatusBlock: IO_STATUS_BLOCK; FileInformation: Pointer; + FileInformationLength: ULONG; FileInformationClass: DWORD): NTSTATUS; stdcall; + + TRtlPrefixUnicodeString = function(const usPrefix: UNICODE_STRING; + const usContainingString: UNICODE_STRING; ignore_case: Boolean): Boolean; stdcall; + + TZwOpenSymbolicLinkObject = function(var LinkHandle: THandle; + DesiredAccess: DWORD; const ObjectAttributes: OBJECT_ATTRIBUTES): NTSTATUS; stdcall; + + TZwQuerySymbolicLinkObject = function(LinkHandle: THandle; + var LinkTarget: UNICODE_STRING; ReturnedLength: PULONG): NTSTATUS; stdcall; + + TZwOpenFile = function(var FileHandle: THandle; DesiredAccess: DWORD; + const ObjectAttributes: OBJECT_ATTRIBUTES; var IoStatusBlock: IO_STATUS_BLOCK; + ShareAccess: ULONG; OpenOptions: ULONG): NTSTATUS; stdcall; + + TGetProcessHeap = function: Pointer; stdcall; + + TRtlAllocateHeap = function(HeapHandle: Pointer; Flags, Size: ULONG): Pointer; stdcall; + + TRtlFreeHeap = function(HeapHandle: Pointer; Flags: ULONG; + MemoryPointer: Pointer): Boolean; stdcall; + + TRtlDosPathNameToNtPathName_U = function(DosName: PWideChar; + var NtName: UNICODE_STRING; DosFilePath: PPWideChar; + NtFilePath: PUNICODE_STRING): Boolean; stdcall; + + TRtlInitUnicodeString = function(var DestinationString: UNICODE_STRING; + const SourceString: PWideChar): NTSTATUS; stdcall; + + TRtlDetermineDosPathNameType_U = function(wcsPathNameType: PWideChar): DWORD; stdcall; + + TRtlNtStatusToDosError = function(status: NTSTATUS): ULONG; stdcall; + +// Declare all the _global_ function pointers for RTDL +var + RtlCreateUnicodeStringFromAsciiz: TRtlCreateUnicodeStringFromAsciiz = nil; + ZwClose: TZwClose = nil; + ZwSetInformationFile: TZwSetInformationFile = nil; + RtlPrefixUnicodeString: TRtlPrefixUnicodeString = nil; + ZwOpenSymbolicLinkObject: TZwOpenSymbolicLinkObject = nil; + ZwQuerySymbolicLinkObject: TZwQuerySymbolicLinkObject = nil; + ZwOpenFile: TZwOpenFile = nil; + GetProcessHeap: TGetProcessHeap = nil; + RtlAllocateHeap: TRtlAllocateHeap = nil; + RtlFreeHeap: TRtlFreeHeap = nil; + RtlDosPathNameToNtPathName_U: TRtlDosPathNameToNtPathName_U = nil; + RtlInitUnicodeString: TRtlInitUnicodeString = nil; + RtlDetermineDosPathNameType_U: TRtlDetermineDosPathNameType_U = nil; + RtlNtStatusToDosError: TRtlNtStatusToDosError = nil; + +(****************************************************************************** + + Syntax: + ------- + C-Prototype! (if STDCALL enabled) + + BOOL WINAPI CreateHardLink( + LPCTSTR lpFileName, + LPCTSTR lpExistingFileName, + LPSECURITY_ATTRIBUTES lpSecurityAttributes // Reserved; Must be NULL! + + Compatibility: + -------------- + The function can only work on file systems that support hardlinks through the + underlying FS driver layer. Currently this only includes NTFS on the NT + platform (as far as I know). + The function works fine on Windows NT4/2000/XP and is considered to work on + future Operating System versions derived from NT (including Windows 2003). + + Remarks: + -------- + This function tries to resemble the original CreateHardLinkW() call from + Windows 2000/XP/2003 Kernel32.DLL as close as possible. This is why many + functions used are NT Native API, whereas one could use Delphi or Win32 API + functions (e.g. memory management). BUT I included much more SEH code and + omitted extra code to free buffers and close handles. This all is done during + the FINALLY block (so there are no memory leaks anyway ;). + + Note, that neither Microsoft's code nor mine ignore the Security Descriptor + from the SECURITY_ATTRIBUTES structure. In both cases the security descriptor + is passed on to ZwOpenFile()! + + The limit of 1023 hardlinks to one file is probably related to the system or + NTFS respectively. At least I saw no special hint, why there would be such a + limit - the original CreateHardLink() does not check the number of links! + Thus I consider the limit being the same for the original and my rewrite. + + For the ANSI version of this function see below ... + + Remarks from the Platform SDK: + ------------------------------- + Any directory entry for a file, whether created with CreateFile or + CreateHardLink, is a hard link to the associated file. Additional hard links, + created with the CreateHardLink function, allow you to have multiple directory + entries for a file, that is, multiple hard links to the same file. These may + be different names in the same directory, or they may be the same (or + different) names in different directories. However, all hard links to a file + must be on the same volume. + Because hard links are just directory entries for a file, whenever an + application modifies a file through any hard link, all applications using any + other hard link to the file see the changes. Also, all of the directory + entries are updated if the file changes. For example, if the file's size + changes, all of the hard links to the file will show the new size. + The security descriptor belongs to the file to which the hard link points. + The link itself, being merely a directory entry, has no security descriptor. + Thus, if you change the security descriptor of any hard link, you're actually + changing the underlying file's security descriptor. All hard links that point + to the file will thus allow the newly specified access. There is no way to + give a file different security descriptors on a per-hard-link basis. + This function does not modify the security descriptor of the file to be linked + to, even if security descriptor information is passed in the + lpSecurityAttributes parameter. + Use DeleteFile to delete hard links. You can delete them in any order + regardless of the order in which they were created. + Flags, attributes, access, and sharing as specified in CreateFile operate on + a per-file basis. That is, if you open a file with no sharing allowed, another + application cannot share the file by creating a new hard link to the file. + + CreateHardLink does not work over the network redirector. + + Note that when you create a hard link on NTFS, the file attribute information + in the directory entry is refreshed only when the file is opened or when + GetFileInformationByHandle is called with the handle of the file of interest. + + ******************************************************************************) +function + + MyCreateHardLinkW // ... otherwise this one + (szLinkName, szLinkTarget: PWideChar; lpSecurityAttributes: PSecurityAttributes): BOOL; +const +// Mask for any DOS style drive path in object manager notation + wcsC_NtName: PWideChar = '\??\C:'; +// Prefix of a mapped path's symbolic link + wcsLanMan: PWideChar = '\Device\LanmanRedirector\'; +// Size required to hold a number of wide characters to compare drive notation + cbC_NtName = $10; // 16 bytes +// Access mask to use for opening - just two bits + dwDesiredAccessHL = DELETE or SYNCHRONIZE; +// OpenOptions for opening of the link target +// The flag FILE_OPEN_REPARSE_POINT has been found by comparison. Probably it carries +// some information wether the file is on the same volume?! + dwOpenOptionsHL = FILE_SYNCHRONOUS_IO_NONALERT or FILE_OPEN_FOR_BACKUP_INTENT or FILE_OPEN_REPARSE_POINT; +// ShareAccess flags + dwShareAccessHL = FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE; +var + usNtName_LinkName, usNtName_LinkTarget: UNICODE_STRING; + usCheckDrive, usSymLinkDrive, usLanMan: UNICODE_STRING; + wcsNtName_LinkTarget, wcsFilePart_LinkTarget: PWideChar; + oaMisc: OBJECT_ATTRIBUTES; + IOStats: IO_STATUS_BLOCK; + hHeap: Pointer; + NeededSize: DWORD; + Status: NTSTATUS; + hLinkTarget, hDrive: THandle; + lpFileLinkInfo: PFILE_LINK_INFORMATION; +begin + Result := False; + if not bRtdlFunctionsLoaded then + Exit; + // Get process' heap + hHeap := GetProcessHeap; + {------------------------------------------------------------- + Preliminary parameter checks which do Exit with error code set + --------------------------------------------------------------} + // If any is not assigned ... + if (szLinkName = nil) or (szLinkTarget = nil) then + begin + SetLastError(ERROR_INVALID_PARAMETER); + Exit; + end; + // Determine DOS path type for both link name and target + if (RtlDetermineDosPathNameType_U(szLinkName) = UNC_PATH) or + (RtlDetermineDosPathNameType_U(szLinkTarget) = UNC_PATH) then + begin + SetLastError(ERROR_INVALID_NAME); + Exit; + end; + // Convert the link target into a UNICODE_STRING + usNtName_LinkTarget.Length := 0; + if not RtlDosPathNameToNtPathName_U(szLinkTarget, usNtName_LinkTarget, nil, nil) then + begin + SetLastError(ERROR_PATH_NOT_FOUND); + Exit; + end; + {------------------------ + Actual main functionality + -------------------------} + // Initialise the length members + RtlInitUnicodeString(usNtName_LinkTarget, usNtName_LinkTarget.Buffer); + // Get needed buffer size (in TCHARs) + NeededSize := GetFullPathNameW(szLinkTarget, 0, nil, PWideChar(nil^)); + if NeededSize <> 0 then + begin + // Calculate needed size (in TCHARs) + NeededSize := NeededSize + 1; // times SizeOf(WideChar) + // Freed in FINALLY + wcsNtName_LinkTarget := RtlAllocateHeap(hHeap, HEAP_ZERO_MEMORY, NeededSize * SizeOf(WideChar)); + // If successfully allocated buffer ... + if wcsNtName_LinkTarget <> nil then + try + {---------------------------------------------------- + Preparation of the checking for mapped network drives + -----------------------------------------------------} + // Get the full unicode path name + wcsFilePart_LinkTarget := nil; + if GetFullPathNameW(szLinkTarget, NeededSize, wcsNtName_LinkTarget, wcsFilePart_LinkTarget) <> 0 then + begin + // Allocate memory to check the drive object + usCheckDrive.Buffer := RtlAllocateHeap(hHeap, HEAP_ZERO_MEMORY, cbC_NtName); + // On success ... + if usCheckDrive.Buffer <> nil then + try + // Copy to buffer and set length members + lstrcpynW(usCheckDrive.Buffer, wcsC_NtName, lstrlenW(wcsC_NtName) + 1); + RtlInitUnicodeString(usCheckDrive, usCheckDrive.Buffer); + // Replace drive letter by the drive letter we want + usCheckDrive.Buffer[4] := wcsNtName_LinkTarget[0]; + // Init OBJECT_ATTRIBUTES + oaMisc.Length := SizeOf(oaMisc); + oaMisc.RootDirectory := 0; + oaMisc.ObjectName := @usCheckDrive; + oaMisc.Attributes := OBJ_CASE_INSENSITIVE; + oaMisc.SecurityDescriptor := nil; + oaMisc.SecurityQualityOfService := nil; + {-------------------------------------------- + Checking for (illegal!) mapped network drives + ---------------------------------------------} + // Open symbolic link object + hDrive := 0; + if ZwOpenSymbolicLinkObject(hDrive, SYMBOLIC_LINK_QUERY, oaMisc) = STATUS_SUCCESS then + try + usSymLinkDrive.Buffer := RtlAllocateHeap(hHeap, HEAP_ZERO_MEMORY, MAX_PATH * SizeOf(WideChar)); + if usSymLinkDrive.Buffer <> nil then + try + // Query the path the symbolic link points to ... + ZwQuerySymbolicLinkObject(hDrive, usSymLinkDrive, nil); + // Initialise the length members + usLanMan.Length := 0; + RtlInitUnicodeString(usLanMan, wcsLanMan); + // The path must not be a mapped drive ... check this! + if not RtlPrefixUnicodeString(usLanMan, usSymLinkDrive, True) then + begin + // Initialise OBJECT_ATTRIBUTES + oaMisc.Length := SizeOf(oaMisc); + oaMisc.RootDirectory := 0; + oaMisc.ObjectName := @usNtName_LinkTarget; + oaMisc.Attributes := OBJ_CASE_INSENSITIVE; + // Set security descriptor in OBJECT_ATTRIBUTES if they were given + if lpSecurityAttributes <> nil then + oaMisc.SecurityDescriptor := lpSecurityAttributes^.lpSecurityDescriptor + else + oaMisc.SecurityDescriptor := nil; + oaMisc.SecurityQualityOfService := nil; + {---------------------- + Opening the target file + -----------------------} + IOStats.Status := 0; + hLinkTarget := 0; + Status := ZwOpenFile(hLinkTarget, dwDesiredAccessHL, oaMisc, + IOStats, dwShareAccessHL, dwOpenOptionsHL); + if Status = STATUS_SUCCESS then + try + // Wow ... target opened ... let's try to + usNtName_LinkName.Length := 0; + if RtlDosPathNameToNtPathName_U(szLinkName, usNtName_LinkName, nil, nil) then + try + // Initialise the length members + RtlInitUnicodeString(usNtName_LinkName, usNtName_LinkName.Buffer); + // Now almost everything is done to create a link! + NeededSize := usNtName_LinkName.Length + + SizeOf(FILE_LINK_INFORMATION) + SizeOf(WideChar); + lpFileLinkInfo := RtlAllocateHeap(hHeap, HEAP_ZERO_MEMORY, NeededSize); + if lpFileLinkInfo <> nil then + try + lpFileLinkInfo^.ReplaceIfExists := False; + lpFileLinkInfo^.RootDirectory := 0; + lpFileLinkInfo^.FileNameLength := usNtName_LinkName.Length; + lstrcpynW(lpFileLinkInfo.FileName, usNtName_LinkName.Buffer, + usNtName_LinkName.Length); + {---------------------------------------------------- + Final creation of the link - "center" of the function + -----------------------------------------------------} + // Hard-link the file as intended + Status := ZwSetInformationFile(hLinkTarget, IOStats, + lpFileLinkInfo, NeededSize, FileLinkInformation); + // On success return TRUE + Result := Status >= 0; + finally + // Free the buffer + RtlFreeHeap(hHeap, 0, lpFileLinkInfo); + // Set last error code + SetLastError(RtlNtStatusToDosError(Status)); + end + else // if lpFileLinkInfo <> nil then + SetLastError(ERROR_NOT_ENOUGH_MEMORY); + finally + RtlFreeHeap(hHeap, 0, usNtName_LinkName.Buffer); + end + else // if RtlDosPathNameToNtPathName_U(szLinkName, usNtName_LinkName... + SetLastError(ERROR_INVALID_NAME); + finally + ZwClose(hLinkTarget); + end + else // if Status = STATUS_SUCCESS then + SetLastError(RtlNtStatusToDosError(Status)); + end + else // if not RtlPrefixUnicodeString(usLanMan, usSymLinkDrive, True) then + SetLastError(ERROR_INVALID_NAME); + finally + RtlFreeHeap(hHeap, 0, usSymLinkDrive.Buffer); + end + else // if usSymLinkDrive.Buffer <> nil then + SetLastError(ERROR_NOT_ENOUGH_MEMORY); + finally + ZwClose(hDrive); + end; + finally + RtlFreeHeap(hHeap, 0, usCheckDrive.Buffer); + end + else // if usCheckDrive.Buffer <> nil then + SetLastError(ERROR_NOT_ENOUGH_MEMORY); + end + else // if GetFullPathNameW(szLinkTarget, NeededSize, wcsNtName_LinkTarget... + SetLastError(ERROR_INVALID_NAME); + finally + RtlFreeHeap(hHeap, 0, wcsNtName_LinkTarget); + end + else // if wcsNtName_LinkTarget <> nil then + SetLastError(ERROR_NOT_ENOUGH_MEMORY); + end + else // if NeededSize <> 0 then + SetLastError(ERROR_INVALID_NAME); + // Finally free the buffer + RtlFreeHeap(hHeap, 0, usNtName_LinkTarget.Buffer); +end; + +(****************************************************************************** + Hint: + ----- + For all closer information see the CreateHardLinkW function above. + + Specific to the ANSI-version: + ----------------------------- + The ANSI-Version can be used as if it was used on Windows 2000. This holds + for all supported systems for now. + + ******************************************************************************) + +function + + MyCreateHardLinkA // ... otherwise this one + (szLinkName, szLinkTarget: PAnsiChar; lpSecurityAttributes: PSecurityAttributes): BOOL; +var + usLinkName: UNICODE_STRING; + usLinkTarget: UNICODE_STRING; + hHeap: Pointer; +begin + Result := False; + if not bRtdlFunctionsLoaded then + Exit; + // Get the process' heap + hHeap := GetProcessHeap; + // Create and allocate a UNICODE_STRING from the zero-terminated parameters + usLinkName.Length := 0; + if RtlCreateUnicodeStringFromAsciiz(usLinkName, szLinkName) then + try + usLinkTarget.Length := 0; + if RtlCreateUnicodeStringFromAsciiz(usLinkTarget, szLinkTarget) then + try + // Call the Unicode version + Result := CreateHardLinkW(usLinkName.Buffer, usLinkTarget.Buffer, lpSecurityAttributes); + finally + // free the allocated buffer + RtlFreeHeap(hHeap, 0, usLinkTarget.Buffer); + end; + finally + // free the allocate buffer + RtlFreeHeap(hHeap, 0, usLinkName.Buffer); + end; +end; + +const +// Names of the functions to import + szRtlCreateUnicodeStringFromAsciiz = 'RtlCreateUnicodeStringFromAsciiz'; + szZwClose = 'ZwClose'; + szZwSetInformationFile = 'ZwSetInformationFile'; + szRtlPrefixUnicodeString = 'RtlPrefixUnicodeString'; + szZwOpenSymbolicLinkObject = 'ZwOpenSymbolicLinkObject'; + szZwQuerySymbolicLinkObject = 'ZwQuerySymbolicLinkObject'; + szZwOpenFile = 'ZwOpenFile'; + szGetProcessHeap = 'GetProcessHeap'; + szRtlAllocateHeap = 'RtlAllocateHeap'; + szRtlFreeHeap = 'RtlFreeHeap'; + szRtlDosPathNameToNtPathName_U = 'RtlDosPathNameToNtPathName_U'; + szRtlInitUnicodeString = 'RtlInitUnicodeString'; + szRtlDetermineDosPathNameType_U = 'RtlDetermineDosPathNameType_U'; + szRtlNtStatusToDosError = 'RtlNtStatusToDosError'; + +var + hKernel32: THandle = 0; + +initialization + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + + // GetModuleHandle because this DLL is loaded into any Win32 subsystem process anyway + // implicitly. And Delphi cannot create applications for other subsystems without + // major changes in SysInit und System units. + hKernel32 := GetModuleHandle(kernel32); + // If we prefer the real Windows APIs try to get their addresses + @CreateHardLinkA := GetProcAddress(hKernel32, szCreateHardLinkA); + @CreateHardLinkW := GetProcAddress(hKernel32, szCreateHardLinkW); + // If they could not be retrieved resort to our home-grown version + if not (Assigned(@CreateHardLinkA) and Assigned(@CreateHardLinkW)) then + begin + + // GetModuleHandle because this DLL is loaded into any Win32 subsystem process anyway + // implicitly. And Delphi cannot create applications for other subsystems without + // major changes in SysInit und System units. + hNtDll := GetModuleHandle(szNtDll); + if hNtDll <> 0 then + begin + // Get all the function addresses + @RtlCreateUnicodeStringFromAsciiz := GetProcAddress(hNtDll, szRtlCreateUnicodeStringFromAsciiz); + @ZwClose := GetProcAddress(hNtDll, szZwClose); + @ZwSetInformationFile := GetProcAddress(hNtDll, szZwSetInformationFile); + @RtlPrefixUnicodeString := GetProcAddress(hNtDll, szRtlPrefixUnicodeString); + @ZwOpenSymbolicLinkObject := GetProcAddress(hNtDll, szZwOpenSymbolicLinkObject); + @ZwQuerySymbolicLinkObject := GetProcAddress(hNtDll, szZwQuerySymbolicLinkObject); + @ZwOpenFile := GetProcAddress(hNtDll, szZwOpenFile); + @GetProcessHeap := GetProcAddress(hKernel32, szGetProcessHeap); + @RtlAllocateHeap := GetProcAddress(hNtDll, szRtlAllocateHeap); + @RtlFreeHeap := GetProcAddress(hNtDll, szRtlFreeHeap); + @RtlDosPathNameToNtPathName_U := GetProcAddress(hNtDll, szRtlDosPathNameToNtPathName_U); + @RtlInitUnicodeString := GetProcAddress(hNtDll, szRtlInitUnicodeString); + @RtlDetermineDosPathNameType_U := GetProcAddress(hNtDll, szRtlDetermineDosPathNameType_U); + @RtlNtStatusToDosError := GetProcAddress(hNtDll, szRtlNtStatusToDosError); + // Check whether we could retrieve all of them + bRtdlFunctionsLoaded := // Update the "loaded" status + Assigned(@RtlCreateUnicodeStringFromAsciiz) and + Assigned(@ZwClose) and + Assigned(@ZwSetInformationFile) and + Assigned(@RtlPrefixUnicodeString) and + Assigned(@ZwOpenSymbolicLinkObject) and + Assigned(@ZwQuerySymbolicLinkObject) and + Assigned(@ZwOpenFile) and + Assigned(@GetProcessHeap) and + Assigned(@RtlAllocateHeap) and + Assigned(@RtlFreeHeap) and + Assigned(@RtlDosPathNameToNtPathName_U) and + Assigned(@RtlInitUnicodeString) and + Assigned(@RtlDetermineDosPathNameType_U) and + Assigned(@RtlNtStatusToDosError); + end; + + @CreateHardLinkA := @MyCreateHardLinkA; + @CreateHardLinkW := @MyCreateHardLinkW; + end; // if not (Assigned(@CreateHardLinkA) and Assigned(@CreateHardLinkW)) then ... + + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + + + +end. + diff --git a/3rdParty/JCL/source/windows/JclAppInst.pas b/3rdParty/JCL/source/windows/JclAppInst.pas new file mode 100644 index 00000000..33977daf --- /dev/null +++ b/3rdParty/JCL/source/windows/JclAppInst.pas @@ -0,0 +1,998 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclAppInst.pas. } +{ } +{ The Initial Developer of the Original Code is Petr Vones. Portions created by Petr Vones are } +{ Copyright (C) Petr Vones. All Rights Reserved. } +{ } +{ Contributor(s): } +{ Marcel van Brakel } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ } +{**************************************************************************************************} +{ } +{ This unit contains a class and support routines for controlling the number of concurrent } +{ instances of your application that can exist at any time. In addition there is support for } +{ simple interprocess communication between these instance including a notification mechanism. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclAppInst; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, System.Classes, Winapi.Messages, + {$ELSE ~HAS_UNITSCOPE} + Windows, Classes, Messages, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclFileUtils, JclSynch, JclWin32; + +// Message constants and types +type + TJclAppInstDataKind = Integer; + +const + AI_INSTANCECREATED = $0001; + AI_INSTANCEDESTROYED = $0002; + AI_USERMSG = $0003; + + AppInstDataKindNoData = -1; + AppInstCmdLineDataKind = 1; + +// Application instances manager class +type + TJclAppInstances = class(TObject) + private + FCPID: DWORD; + FAllMapping: TJclSwapFileMapping; + FAllMappingView: TJclFileMappingView; + FSessionMapping: TJclSwapFileMapping; + FSessionMappingView: TJclFileMappingView; + FUserMapping: TJclSwapFileMapping; + FUserMappingView: TJclFileMappingView; + FMessageID: DWORD; + FOptex: TJclOptex; + FUniqueAppID: string; + function GetAllAppWnds(Index: Integer): THandle; + function GetAllInstanceCount: Integer; + function GetAllInstanceIndex(ProcessID: DWORD): Integer; + function GetAllProcessIDs(Index: Integer): DWORD; + function GetInstanceCount(MappingView: TJclFileMappingView): Integer; + function GetInstanceIndex(MappingView: TJclFileMappingView; ProcessID: DWORD): Integer; + function GetProcessIDs(MappingView: TJclFileMappingView; Index: Integer): DWORD; + function GetSessionAppWnds(Index: Integer): THandle; + function GetSessionInstanceCount: Integer; + function GetSessionInstanceIndex(ProcessID: DWORD): Integer; + function GetSessionProcessIDs(Index: Integer): DWORD; + function GetUserAppWnds(Index: Integer): THandle; + function GetUserInstanceCount: Integer; + function GetUserInstanceIndex(ProcessID: DWORD): Integer; + function GetUserProcessIDs(Index: Integer): DWORD; + protected + procedure InitData; + procedure InitAllData; + procedure InitSessionData; + procedure InitUserData; + procedure NotifyInstances(const W, L: Longint); + procedure RemoveInstance(MappingView: TJclFileMappingView); + procedure SecurityFree(UserInfo: PTokenUser; SID: PSID; ACL: PACL; + SecurityDescriptor: PSecurityDescriptor; SecurityAttributes: PSecurityAttributes); + procedure SecurityGetAllUsers(out UserInfo: PTokenUser; out SID: PSID; out ACL: PACL; + out SecurityDescriptor: PSecurityDescriptor; out SecurityAttributes: PSecurityAttributes); + procedure SecurityGetCurrentUser(out UserInfo: PTokenUser; out SID: PSID; out ACL: PACL; + out SecurityDescriptor: PSecurityDescriptor; out SecurityAttributes: PSecurityAttributes); + procedure SecurityGetCurrentUserInfo(out UserInfo: PTokenUser); + procedure SecurityGetSecurityAttributes(OwnerSID, AccessSID: PSID; out ACL: PACL; + out SecurityDescriptor: PSecurityDescriptor; out SecurityAttributes: PSecurityAttributes); + public + constructor Create; + destructor Destroy; override; + class function BringAppWindowToFront(const Wnd: THandle): Boolean; + class function GetApplicationWnd(const ProcessID: DWORD): THandle; + class procedure KillInstance; + class function SetForegroundWindow98(const Wnd: THandle): Boolean; + function CheckInstance(MaxInstances: Word; MaxSessionInstances: Word = 0; + MaxUserInstances: Word = 0): Boolean; + procedure CheckMultipleInstances(MaxInstances: Word; MaxSessionInstances: Word = 0; + MaxUserInstances: Word = 0); + procedure CheckSingleInstance; + function SendCmdLineParams(const WindowClassName: string; const OriginatorWnd: THandle): Boolean; + function SendData(const WindowClassName: string; const DataKind: TJclAppInstDataKind; + Data: Pointer; const Size: Integer; + OriginatorWnd: THandle): Boolean; + function SendString(const WindowClassName: string; const DataKind: TJclAppInstDataKind; + const S: string; OriginatorWnd: THandle): Boolean; + function SendStrings(const WindowClassName: string; const DataKind: TJclAppInstDataKind; + const Strings: TStrings; OriginatorWnd: THandle): Boolean; + function SessionSwitchTo(Index: Integer): Boolean; + function SwitchTo(Index: Integer): Boolean; + function UserSwitchTo(Index: Integer): Boolean; + procedure UserNotify(Param: Longint); + property AppWnds[Index: Integer]: THandle read GetAllAppWnds; + property InstanceIndex[ProcessID: DWORD]: Integer read GetAllInstanceIndex; + property InstanceCount: Integer read GetAllInstanceCount; + property MessageID: DWORD read FMessageID; + property ProcessIDs[Index: Integer]: DWORD read GetAllProcessIDs; + property SessionAppWnds[Index: Integer]: THandle read GetSessionAppWnds; + property SessionInstanceIndex[ProcessID: DWORD]: Integer read GetSessionInstanceIndex; + property SessionInstanceCount: Integer read GetSessionInstanceCount; + property SessionProcessIDs[Index: Integer]: DWORD read GetSessionProcessIDs; + property UserAppWnds[Index: Integer]: THandle read GetUserAppWnds; + property UserInstanceIndex[ProcessID: DWORD]: Integer read GetUserInstanceIndex; + property UserInstanceCount: Integer read GetUserInstanceCount; + property UserProcessIDs[Index: Integer]: DWORD read GetUserProcessIDs; + end; + +function JclAppInstances: TJclAppInstances; overload; +function JclAppInstances(const UniqueAppIdGuidStr: string): TJclAppInstances; overload; + +// Interprocess communication routines +function ReadMessageCheck(var Message: TMessage; const IgnoredOriginatorWnd: THandle): TJclAppInstDataKind; +procedure ReadMessageData(const Message: TMessage; var Data: Pointer; var Size: Integer); +procedure ReadMessageString(const Message: TMessage; out S: string); +procedure ReadMessageStrings(const Message: TMessage; const Strings: TStrings); + +function SendData(const Wnd, OriginatorWnd: HWND; + const DataKind: TJclAppInstDataKind; const Data: Pointer; const Size: Integer): Boolean; +function SendStrings(const Wnd, OriginatorWnd: HWND; + const DataKind: TJclAppInstDataKind; const Strings: TStrings): Boolean; +function SendCmdLineParams(const Wnd, OriginatorWnd: HWND): Boolean; +function SendString(const Wnd, OriginatorWnd: HWND; + const DataKind: TJclAppInstDataKind; const S: string): Boolean; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclSecurity, + JclStrings; + +{$IFDEF FPC} // missing declaration from unit Messages +type + TWMCopyData = record + Msg: UINT; + From: THandle; + CopyDataStruct: PCopyDataStruct; + Result : LRESULT; + End; +{$ENDIF FPC} + +const + { strings to form a unique name for file mapping and optex objects } + JclAIPrefix = 'Jcl'; + JclAIOptex = '_Otx'; + JclAIAllMapping = '_All'; + JclAISessionMapping = '_Session_'; + JclAIUserMapping = '_User_'; + + { window message used for communication between instances } + JclAIMessage = '_Msg'; + + { maximum number of instance that may exist at any time } + JclAIMaxInstances = 256; + + { name of the application window class } + ClassNameOfTApplication = 'TApplication'; + +type + { management data to keep track of application instances. this data is shared amongst all instances + and must be appropriately protected from concurrent access at all time } + + PJclAISharedData = ^TJclAISharedData; + TJclAISharedData = packed record + MaxInst: Word; + Count: Word; + ProcessIDs: array [0..JclAIMaxInstances] of DWORD; + end; + +var + { the single global TJclAppInstance instance } + AppInstances: TJclAppInstances; + ExplicitUniqueAppId: string; + +//=== { TJclAppInstances } =================================================== + +constructor TJclAppInstances.Create; +begin + inherited Create; + FCPID := GetCurrentProcessId; + InitData; +end; + +destructor TJclAppInstances.Destroy; +begin + if FAllMapping <> nil then + RemoveInstance(FAllMappingView); + if FSessionMapping <> nil then + RemoveInstance(FSessionMappingView); + if FUserMapping <> nil then + RemoveInstance(FUserMappingView); + + NotifyInstances(AI_INSTANCEDESTROYED, Integer(FCPID)); + + FreeAndNil(FAllMapping); + FreeAndNil(FSessionMapping); + FreeAndNil(FUserMapping); + FreeAndNil(FOptex); + inherited Destroy; +end; + +class function TJclAppInstances.BringAppWindowToFront(const Wnd: THandle): Boolean; +begin + if IsIconic(Wnd) then + SendMessage(Wnd, WM_SYSCOMMAND, SC_RESTORE, 0); + Result := SetForegroundWindow98(Wnd); +end; + +function TJclAppInstances.CheckInstance(MaxInstances, MaxSessionInstances, MaxUserInstances: Word): Boolean; +var + SharedData: PJclAISharedData; + CurrentProcessId: DWORD; +begin + CurrentProcessId := GetCurrentProcessId; + FOptex.Enter; + try + // check all instances + SharedData := PJclAISharedData(FAllMappingView.Memory); + if SharedData^.MaxInst = 0 then + SharedData^.MaxInst := MaxInstances; + Result := (SharedData^.MaxInst = 0) or (SharedData^.Count < SharedData^.MaxInst); + SharedData^.ProcessIDs[SharedData^.Count] := CurrentProcessId; + Inc(SharedData^.Count); + + // check session instances + SharedData := PJclAISharedData(FSessionMappingView.Memory); + if SharedData^.MaxInst = 0 then + SharedData^.MaxInst := MaxSessionInstances; + Result := Result and ((SharedData^.MaxInst = 0) or (SharedData^.Count < SharedData^.MaxInst)); + SharedData^.ProcessIDs[SharedData^.Count] := CurrentProcessId; + Inc(SharedData^.Count); + + // check user instances + SharedData := PJclAISharedData(FUserMappingView.Memory); + if SharedData^.MaxInst = 0 then + SharedData^.MaxInst := MaxUserInstances; + Result := Result and ((SharedData^.MaxInst = 0) or (SharedData^.Count < SharedData^.MaxInst)); + SharedData^.ProcessIDs[SharedData^.Count] := CurrentProcessId; + Inc(SharedData^.Count); + finally + FOptex.Leave; + end; + if Result then + NotifyInstances(AI_INSTANCECREATED, Integer(FCPID)); +end; + +procedure TJclAppInstances.CheckMultipleInstances(MaxInstances, MaxSessionInstances, MaxUserInstances: Word); +begin + if not CheckInstance(MaxInstances, MaxSessionInstances, MaxUserInstances) then + begin + SwitchTo(0); + KillInstance; + end; +end; + +procedure TJclAppInstances.CheckSingleInstance; +begin + CheckMultipleInstances(1); +end; + +type + PTopLevelWnd = ^TTopLevelWnd; + TTopLevelWnd = record + ProcessID: DWORD; + Wnd: THandle; + end; + +function EnumApplicationWinProc(Wnd: THandle; Param: PTopLevelWnd): BOOL; stdcall; +var + PID: DWORD; + C: array [0..Length(ClassNameOfTApplication) + 1] of Char; +begin + GetWindowThreadProcessId(Wnd, @PID); + if (PID = Param^.ProcessID) and (GetClassName(Wnd, C, Length(C)) > 0) and (C = ClassNameOfTApplication) then + begin + Result := False; + Param^.Wnd := Wnd; + end + else + begin + Result := True; + end; +end; + +class function TJclAppInstances.GetApplicationWnd(const ProcessID: DWORD): THandle; +var + TopLevelWnd: TTopLevelWnd; +begin + TopLevelWnd.ProcessID := ProcessID; + TopLevelWnd.Wnd := 0; + EnumWindows(@EnumApplicationWinProc, LPARAM(@TopLevelWnd)); + Result := TopLevelWnd.Wnd; +end; + +function TJclAppInstances.GetAllAppWnds(Index: Integer): THandle; +begin + Result := GetApplicationWnd(GetAllProcessIDs(Index)); +end; + +function TJclAppInstances.GetAllInstanceCount: Integer; +begin + Result := GetInstanceCount(FAllMappingView); +end; + +function TJclAppInstances.GetAllInstanceIndex(ProcessID: DWORD): Integer; +begin + Result := GetInstanceIndex(FAllMappingView, ProcessID); +end; + +function TJclAppInstances.GetAllProcessIDs(Index: Integer): DWORD; +begin + Result := GetProcessIDs(FAllMappingView, Index); +end; + +function TJclAppInstances.GetInstanceCount(MappingView: TJclFileMappingView): Integer; +begin + FOptex.Enter; + try + Result := PJclAISharedData(MappingView.Memory)^.Count; + finally + FOptex.Leave; + end; +end; + +function TJclAppInstances.GetInstanceIndex(MappingView: TJclFileMappingView; ProcessID: DWORD): Integer; +var + I: Integer; + SharedData: PJclAISharedData; +begin + Result := -1; + FOptex.Enter; + try + SharedData := PJclAISharedData(MappingView.Memory); + for I := 0 to SharedData^.Count - 1 do + if SharedData^.ProcessIDs[I] = ProcessID then + begin + Result := I; + Break; + end; + finally + FOptex.Leave; + end; +end; + +function TJclAppInstances.GetProcessIDs(MappingView: TJclFileMappingView; Index: Integer): DWORD; +var + SharedData: PJclAISharedData; +begin + FOptex.Enter; + try + SharedData := PJclAISharedData(MappingView.Memory); + if Index >= SharedData^.Count then + Result := 0 + else + Result := SharedData^.ProcessIDs[Index]; + finally + FOptex.Leave; + end; +end; + +function TJclAppInstances.GetSessionAppWnds(Index: Integer): THandle; +begin + Result := GetApplicationWnd(GetProcessIDs(FSessionMappingView, Index)); +end; + +function TJclAppInstances.GetSessionInstanceCount: Integer; +begin + Result := GetInstanceCount(FSessionMappingView); +end; + +function TJclAppInstances.GetSessionInstanceIndex(ProcessID: DWORD): Integer; +begin + Result := GetInstanceIndex(FSessionMappingView, ProcessID); +end; + +function TJclAppInstances.GetSessionProcessIDs(Index: Integer): DWORD; +begin + Result := GetProcessIDs(FSessionMappingView, Index); +end; + +function TJclAppInstances.GetUserAppWnds(Index: Integer): THandle; +begin + Result := GetApplicationWnd(GetProcessIDs(FUserMappingView, Index)); +end; + +function TJclAppInstances.GetUserInstanceCount: Integer; +begin + Result := GetInstanceCount(FUserMappingView); +end; + +function TJclAppInstances.GetUserInstanceIndex(ProcessID: DWORD): Integer; +begin + Result := GetInstanceIndex(FUserMappingView, ProcessID); +end; + +function TJclAppInstances.GetUserProcessIDs(Index: Integer): DWORD; +begin + Result := GetProcessIDs(FUserMappingView, Index); +end; + +const + ACL_REVISION = 2; + +type + _ACE_HEADER = record + AceType: BYTE; + AceFlags: BYTE; + AceSize: WORD; + end; + ACE_HEADER = _ACE_HEADER; + PACE_HEADER = ^_ACE_HEADER; + + _ACCESS_ALLOWED_ACE = record + Header: ACE_HEADER; + Mask: ACCESS_MASK; + SidStart: DWORD; + end; + + ACCESS_ALLOWED_ACE = _ACCESS_ALLOWED_ACE; + PACCESS_ALLOWED_ACE = ^_ACCESS_ALLOWED_ACE; + +procedure TJclAppInstances.InitData; +begin + if ExplicitUniqueAppId <> '' then + FUniqueAppID := JclAIPrefix + ExplicitUniqueAppId + else + FUniqueAppID := AnsiUpperCase(JclAIPrefix + ParamStr(0)); + + CharReplace(FUniqueAppID, '\', '_'); + + FMessageID := RegisterWindowMessage(PChar(FUniqueAppID + JclAIMessage)); + + FOptex := TJclOptex.Create(FUniqueAppID + JclAIOptex, 4000); + + InitAllData; + InitSessionData; + InitUserData; +end; + +procedure TJclAppInstances.InitAllData; +var + UserInfo: PTokenUser; + ACL: PACL; + SID: PSID; + SecurityAttributes: PSecurityAttributes; + SecurityDescriptor: PSecurityDescriptor; +begin + UserInfo := nil; + ACL := nil; + SID := nil; + SecurityDescriptor := nil; + SecurityAttributes := nil; + try + SecurityGetAllUsers(UserInfo, SID, ACL, SecurityDescriptor, SecurityAttributes); + + FOptex.Enter; + try + FAllMapping := TJclSwapFileMapping.Create(FUniqueAppID + JclAIAllMapping, + PAGE_READWRITE, SizeOf(TJclAISharedData), SecurityAttributes); + FAllMappingView := FAllMapping.Views[FAllMapping.Add(FILE_MAP_ALL_ACCESS, SizeOf(TJclAISharedData), 0)]; + if not FAllMapping.Existed then + FillChar(FAllMappingView.Memory^, SizeOf(TJclAISharedData), #0); + finally + FOptex.Leave; + end; + finally + SecurityFree(UserInfo, SID, ACL, SecurityDescriptor, SecurityAttributes); + end; +end; + +procedure TJclAppInstances.InitSessionData; +var + UserInfo: PTokenUser; + ACL: PACL; + SID: PSID; + SecurityAttributes: PSecurityAttributes; + SecurityDescriptor: PSecurityDescriptor; + SessionID: DWORD; +begin + UserInfo := nil; + ACL := nil; + SID := nil; + SecurityDescriptor := nil; + SecurityAttributes := nil; + try + SecurityGetAllUsers(UserInfo, SID, ACL, SecurityDescriptor, SecurityAttributes); + + SessionID := 0; + ProcessIdToSessionId(GetCurrentProcessId, SessionID); // RESULT + FOptex.Enter; + try + FSessionMapping := TJclSwapFileMapping.Create(FUniqueAppID + JclAISessionMapping + IntToStr(SessionID), + PAGE_READWRITE, SizeOf(TJclAISharedData), SecurityAttributes); + FSessionMappingView := FSessionMapping.Views[FSessionMapping.Add(FILE_MAP_ALL_ACCESS, SizeOf(TJclAISharedData), 0)]; + if not FSessionMapping.Existed then + FillChar(FSessionMappingView.Memory^, SizeOf(TJclAISharedData), #0); + finally + FOptex.Leave; + end; + finally + SecurityFree(UserInfo, SID, ACL, SecurityDescriptor, SecurityAttributes); + end; +end; + +procedure TJclAppInstances.InitUserData; +var + UserInfo: PTokenUser; + ACL: PACL; + SID: PSID; + SecurityAttributes: PSecurityAttributes; + SecurityDescriptor: PSecurityDescriptor; + UserName, GroupName: WideString; +begin + UserInfo := nil; + ACL := nil; + SID := nil; + SecurityDescriptor := nil; + SecurityAttributes := nil; + try + SecurityGetCurrentUser(UserInfo, SID, ACL, SecurityDescriptor, SecurityAttributes); + LookupAccountBySid(UserInfo.User.Sid, UserName, GroupName); + + FOptex.Enter; + try + FUserMapping := TJclSwapFileMapping.Create(FUniqueAppID + JclAIUserMapping + UserName + '_' + GroupName, + PAGE_READWRITE, SizeOf(TJclAISharedData), SecurityAttributes); + FUserMappingView := FUserMapping.Views[FUserMapping.Add(FILE_MAP_ALL_ACCESS, SizeOf(TJclAISharedData), 0)]; + if not FUserMapping.Existed then + FillChar(FUserMappingView.Memory^, SizeOf(TJclAISharedData), #0); + finally + FOptex.Leave; + end; + finally + SecurityFree(UserInfo, SID, ACL, SecurityDescriptor, SecurityAttributes); + end; +end; + +class procedure TJclAppInstances.KillInstance; +begin + Halt(0); +end; + +function EnumNotifyWinProc(Wnd: THandle; Message: PMessage): BOOL; stdcall; +begin + SendNotifyMessage(Wnd, Message^.Msg, Message^.WParam, Message^.LParam); + Result := True; +end; + +procedure TJclAppInstances.NotifyInstances(const W, L: Integer); +var + I: Integer; + Wnd: THandle; + TID: DWORD; + Msg: TMessage; + SharedData: PJclAISharedData; +begin + FOptex.Enter; + try + SharedData := PJclAISharedData(FAllMappingView.Memory); + for I := 0 to SharedData^.Count - 1 do + begin + Wnd := GetApplicationWnd(SharedData^.ProcessIDs[I]); + TID := GetWindowThreadProcessId(Wnd, nil); + while Wnd <> 0 do + begin // Send message to TApplication queue + if PostThreadMessage(TID, FMessageID, W, L) or + (GetLastError = ERROR_INVALID_THREAD_ID) then + Break; + Sleep(1); + end; + Msg.Msg := FMessageID; + Msg.WParam := W; + Msg.LParam := L; + EnumThreadWindows(TID, @EnumNotifyWinProc, LPARAM(@Msg)); + end; + finally + FOptex.Leave; + end; +end; + +procedure TJclAppInstances.RemoveInstance(MappingView: TJclFileMappingView); +var + I: Integer; + SharedData: PJclAISharedData; +begin + FOptex.Enter; + try + SharedData := PJclAISharedData(MappingView.Memory); + for I := 0 to SharedData^.Count - 1 do + if SharedData^.ProcessIDs[I] = FCPID then + begin + SharedData^.ProcessIDs[I] := 0; + Move(SharedData^.ProcessIDs[I + 1], SharedData^.ProcessIDs[I], (SharedData^.Count - I) * SizeOf(DWORD)); + Dec(SharedData^.Count); + Break; + end; + finally + FOptex.Leave; + end; +end; + +procedure TJclAppInstances.SecurityFree(UserInfo: PTokenUser; SID: PSID; ACL: PACL; + SecurityDescriptor: PSecurityDescriptor; SecurityAttributes: PSecurityAttributes); +begin + if Assigned(UserInfo) then + FreeMem(UserInfo); + if Assigned(SID) then + FreeSID(SID); + if Assigned(ACL) then + FreeMem(ACL); + if Assigned(SecurityDescriptor) then + FreeMem(SecurityDescriptor); + if Assigned(SecurityAttributes) then + FreeMem(SecurityAttributes); +end; + +procedure TJclAppInstances.SecurityGetAllUsers(out UserInfo: PTokenUser; out SID: PSID; out ACL: PACL; + out SecurityDescriptor: PSecurityDescriptor; out SecurityAttributes: PSecurityAttributes); +var + WorldAuth: {$IFDEF HAS_UNITSCOPE}WinApi.{$ENDIF HAS_UNITSCOPE}Windows.SID_IDENTIFIER_AUTHORITY; +begin + UserInfo := nil; + ACL := nil; + SID := nil; + SecurityDescriptor := nil; + SecurityAttributes := nil; + + SecurityGetCurrentUserInfo(UserInfo); + + // Retrieve the SID of the Everyone group. + WorldAuth := JclWin32.SECURITY_WORLD_SID_AUTHORITY; + AllocateAndInitializeSid(WorldAuth, 1, SECURITY_WORLD_RID, 0, 0, 0, 0, 0, 0, 0, SID); // RESULT + + SecurityGetSecurityAttributes(UserInfo^.User.Sid, SID, ACL, SecurityDescriptor, SecurityAttributes); +end; + +procedure TJclAppInstances.SecurityGetCurrentUser(out UserInfo: PTokenUser; out SID: PSID; out ACL: PACL; + out SecurityDescriptor: PSecurityDescriptor; out SecurityAttributes: PSecurityAttributes); +begin + UserInfo := nil; + ACL := nil; + SID := nil; + SecurityDescriptor := nil; + SecurityAttributes := nil; + SecurityGetCurrentUserInfo(UserInfo); + SecurityGetSecurityAttributes(UserInfo^.User.Sid, UserInfo.User.Sid, ACL, SecurityDescriptor, SecurityAttributes); +end; + +procedure TJclAppInstances.SecurityGetCurrentUserInfo(out UserInfo: PTokenUser); +var + ProcessToken: THandle; + TokenInfoSize: DWORD; + HaveToken: Boolean; +begin + UserInfo := nil; + ProcessToken := 0; + try + HaveToken := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, ProcessToken); + if (not HaveToken) and (GetLastError = ERROR_NO_TOKEN) then + HaveToken := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, ProcessToken); + if not HaveToken then + RaiseLastOSError; + + if GetTokenInformation(ProcessToken, TokenUser, nil, 0, TokenInfoSize) or + (GetLastError <> ERROR_INSUFFICIENT_BUFFER) then + RaiseLastOSError; + UserInfo := PTokenUser(AllocMem(TokenInfoSize)); + Win32Check(GetTokenInformation(ProcessToken, TokenUser, UserInfo, TokenInfoSize, TokenInfoSize)); + finally + if ProcessToken <> 0 then + CloseHandle(ProcessToken); + end; +end; + +procedure TJclAppInstances.SecurityGetSecurityAttributes(OwnerSID, AccessSID: PSID; out ACL: PACL; + out SecurityDescriptor: PSecurityDescriptor; out SecurityAttributes: PSecurityAttributes); +var + ACLSize: SizeInt; +begin + // create the ACL + ACLSize := SizeOf(TACL) + SizeOf(ACCESS_ALLOWED_ACE) + SizeOf(DWORD) + GetLengthSid(AccessSID); + ACL := AllocMem(ACLSize); + Win32Check(InitializeAcl(ACL^, ACLSize, ACL_REVISION)); + Win32Check(AddAccessAllowedAce(ACL{$IFDEF BORLAND}^{$ENDIF}, ACL_REVISION, FILE_MAP_ALL_ACCESS, AccessSID)); + Assert(IsValidAcl(ACL{$IFNDEF RTL230_UP}^{$ENDIF})); // QC #102231 + + // create the security descriptor + SecurityDescriptor := AllocMem(SECURITY_DESCRIPTOR_MIN_LENGTH); + Win32Check(InitializeSecurityDescriptor(SecurityDescriptor, SECURITY_DESCRIPTOR_REVISION)); + Win32Check(SetSecurityDescriptorSacl(SecurityDescriptor, False, nil, True)); + Win32Check(SetSecurityDescriptorOwner(SecurityDescriptor, OwnerSID, False)); + Win32Check(SetSecurityDescriptorGroup(SecurityDescriptor, OwnerSID, False)); + Win32Check(SetSecurityDescriptorDacl(SecurityDescriptor, True, ACL, False)); + Assert(IsValidSecurityDescriptor(SecurityDescriptor)); + + // create the security attributes + SecurityAttributes := AllocMem(SizeOf(SecurityAttributes^)); + SecurityAttributes^.nLength := SizeOf(SecurityAttributes^); + SecurityAttributes^.lpSecurityDescriptor := SecurityDescriptor; + SecurityAttributes^.bInheritHandle := False; +end; + +function TJclAppInstances.SendCmdLineParams(const WindowClassName: string; const OriginatorWnd: THandle): Boolean; +var + TempList: TStringList; + I: Integer; +begin + TempList := TStringList.Create; + try + for I := 1 to ParamCount do + TempList.Add(ParamStr(I)); + Result := SendStrings(WindowClassName, AppInstCmdLineDataKind, TempList, OriginatorWnd); + finally + TempList.Free; + end; +end; + +type + PEnumWinRec = ^TEnumWinRec; + TEnumWinRec = record + WindowClassName: PChar; + OriginatorWnd: THandle; + CopyData: TCopyDataStruct; + Self: TJclAppInstances; + end; + +function EnumWinProc(Wnd: THandle; Data: PEnumWinRec): BOOL; stdcall; +var + ClassName: array [0..200] of Char; + I: Integer; + PID: DWORD; + Found: Boolean; + SharedData: PJclAISharedData; +begin + if (GetClassName(Wnd, ClassName, Length(ClassName) - 1) > 0) and + (StrComp(ClassName, Data.WindowClassName) = 0) then + begin + GetWindowThreadProcessId(Wnd, @PID); + Found := False; + Data.Self.FOptex.Enter; + try + SharedData := PJclAISharedData(Data.Self.FAllMappingView.Memory); + for I := 0 to SharedData^.Count - 1 do + if SharedData^.ProcessIDs[I] = PID then + begin + Found := True; + Break; + end; + finally + Data.Self.FOptex.Leave; + end; + if Found then + SendMessage(Wnd, WM_COPYDATA, Data.OriginatorWnd, LPARAM(@Data.CopyData)); + end; + Result := True; +end; + +function TJclAppInstances.SendData(const WindowClassName: string; + const DataKind: TJclAppInstDataKind; + Data: Pointer; const Size: Integer; + OriginatorWnd: THandle): Boolean; +var + EnumWinRec: TEnumWinRec; +begin + Assert(DataKind <> AppInstDataKindNoData); + EnumWinRec.WindowClassName := PChar(WindowClassName); + EnumWinRec.OriginatorWnd := OriginatorWnd; + EnumWinRec.CopyData.dwData := DataKind; + EnumWinRec.CopyData.cbData := Size; + EnumWinRec.CopyData.lpData := Data; + EnumWinRec.Self := Self; + Result := EnumWindows(@EnumWinProc, LPARAM(@EnumWinRec)); +end; + +function TJclAppInstances.SendString(const WindowClassName: string; + const DataKind: TJclAppInstDataKind; const S: string; + OriginatorWnd: THandle): Boolean; +begin + Result := SendData(WindowClassName, DataKind, PChar(S), Length(S) * SizeOf(Char), OriginatorWnd); +end; + +function TJclAppInstances.SendStrings(const WindowClassName: string; + const DataKind: TJclAppInstDataKind; const Strings: TStrings; + OriginatorWnd: THandle): Boolean; +begin + Result := SendString(WindowClassName, DataKind, Strings.Text, OriginatorWnd); +end; + +function TJclAppInstances.SessionSwitchTo(Index: Integer): Boolean; +begin + Result := BringAppWindowToFront(SessionAppWnds[Index]); +end; + +class function TJclAppInstances.SetForegroundWindow98(const Wnd: THandle): Boolean; +var + ForeThreadID, NewThreadID: DWORD; +begin + if GetForegroundWindow <> Wnd then + begin + ForeThreadID := GetWindowThreadProcessId(GetForegroundWindow, nil); + NewThreadID := GetWindowThreadProcessId(Wnd, nil); + if ForeThreadID <> NewThreadID then + begin + AttachThreadInput(ForeThreadID, NewThreadID, True); + Result := SetForegroundWindow(Wnd); + AttachThreadInput(ForeThreadID, NewThreadID, False); + if Result then + Result := SetForegroundWindow(Wnd); + end + else + Result := SetForegroundWindow(Wnd); + end + else + Result := True; +end; + +function TJclAppInstances.SwitchTo(Index: Integer): Boolean; +begin + Result := BringAppWindowToFront(AppWnds[Index]); +end; + +procedure TJclAppInstances.UserNotify(Param: Longint); +begin + NotifyInstances(AI_USERMSG, Param); +end; + +function TJclAppInstances.UserSwitchTo(Index: Integer): Boolean; +begin + Result := BringAppWindowToFront(UserAppWnds[Index]); +end; + +function JclAppInstances: TJclAppInstances; +begin + if AppInstances = nil then + AppInstances := TJclAppInstances.Create; + Result := AppInstances; +end; + +function JclAppInstances(const UniqueAppIdGuidStr: string): TJclAppInstances; +begin + Assert(AppInstances = nil); + ExplicitUniqueAppId := UniqueAppIdGuidStr; + Result := JclAppInstances; +end; + +// Interprocess communication routines +function ReadMessageCheck(var Message: TMessage; const IgnoredOriginatorWnd: THandle): TJclAppInstDataKind; +begin + if (Message.Msg = WM_COPYDATA) and (TWMCopyData(Message).From <> IgnoredOriginatorWnd) then + begin + Message.Result := 1; + Result := TJclAppInstDataKind(TWMCopyData(Message).CopyDataStruct^.dwData); + end + else + begin + Message.Result := 0; + Result := AppInstDataKindNoData; + end; +end; + +procedure ReadMessageData(const Message: TMessage; var Data: Pointer; var Size: Integer); +begin + if TWMCopyData(Message).Msg = WM_COPYDATA then + begin + Size := TWMCopyData(Message).CopyDataStruct^.cbData; + GetMem(Data, Size); + Move(TWMCopyData(Message).CopyDataStruct^.lpData^, Data^, Size); + end; +end; + +procedure ReadMessageString(const Message: TMessage; out S: string); +begin + if TWMCopyData(Message).Msg = WM_COPYDATA then + SetString(S, PChar(TWMCopyData(Message).CopyDataStruct^.lpData), TWMCopyData(Message).CopyDataStruct^.cbData div SizeOf(Char)); +end; + +procedure ReadMessageStrings(const Message: TMessage; const Strings: TStrings); +var + S: string; +begin + if TWMCopyData(Message).Msg = WM_COPYDATA then + begin + ReadMessageString(Message, S); + Strings.Text := S; + end; +end; + +function SendData(const Wnd, OriginatorWnd: HWND; + const DataKind: TJclAppInstDataKind; const Data: Pointer; const Size: Integer): Boolean; +var + CopyData: TCopyDataStruct; +begin + CopyData.dwData := DataKind; + CopyData.cbData := Size; + CopyData.lpData := Data; + Result := Boolean(SendMessage(Wnd, WM_COPYDATA, OriginatorWnd, LPARAM(@CopyData))); +end; + +function SendStrings(const Wnd, OriginatorWnd: HWND; + const DataKind: TJclAppInstDataKind; const Strings: TStrings): Boolean; +begin + Result := SendString(Wnd, OriginatorWnd, DataKind, Strings.Text); +end; + +function SendCmdLineParams(const Wnd, OriginatorWnd: HWND): Boolean; +var + TempList: TStringList; + I: Integer; +begin + TempList := TStringList.Create; + try + for I := 1 to ParamCount do + TempList.Add(ParamStr(I)); + Result := SendStrings(Wnd, OriginatorWnd, AppInstCmdLineDataKind, TempList); + finally + TempList.Free; + end; +end; + +function SendString(const Wnd, OriginatorWnd: HWND; + const DataKind: TJclAppInstDataKind; const S: string): Boolean; +begin + Result := SendData(Wnd, OriginatorWnd, DataKind, PChar(S), Length(S) * SizeOf(Char)); +end; + +initialization + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + FreeAndNil(AppInstances); + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/JclCIL.pas b/3rdParty/JCL/source/windows/JclCIL.pas new file mode 100644 index 00000000..4cd003b7 --- /dev/null +++ b/3rdParty/JCL/source/windows/JclCIL.pas @@ -0,0 +1,1032 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclCIL.pas. } +{ } +{ The Initial Developer of the Original Code is Flier Lu (). } +{ Portions created by Flier Lu are Copyright (C) Flier Lu. All Rights Reserved. } +{ } +{ Contributors: } +{ Flier Lu (flier) } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Olivier Sannier (obones) } +{ Petr Vones (pvones) } +{ } +{**************************************************************************************************} +{ } +{ Microsoft .Net CIL Instruction Set information support routines and classes. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclCIL; + +interface + +{$I jcl.inc} +{$I windowsonly.inc} + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Winapi.Windows, + {$ENDIF MSWINDOWS} + System.Classes, System.SysUtils, System.Contnrs, + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + Classes, SysUtils, Contnrs, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclSysUtils, JclMetadata; + +type + TJclOpCode = + (opNop, opBreak, + opLdArg_0, opLdArg_1, opLdArg_2, opLdArg_3, + opLdLoc_0, opLdLoc_1, opLdLoc_2, opLdLoc_3, + opStLoc_0, opStLoc_1, opStLoc_2, opStLoc_3, + opldArg_s, opLdArga_s, opStArg_s, + opLdLoc_s, opLdLoca_s, opStLoc_s, + opLdNull, opLdc_I4_M1, + opLdc_I4_0, opLdc_I4_1, opLdc_I4_2, opLdc_I4_3, opLdc_I4_4, + opLdc_I4_5, opLdc_I4_6, opLdc_I4_7, opLdc_I4_8, opLdc_I4_s, + opLdc_i4, opLdc_i8, opLdc_r4, opLdc_r8, + opUnused49, + opDup, opPop, opJmp, opCall, opCalli, opRet, + opBr_s, opBrFalse_s, opBrTrue_s, + opBeq_s, opBge_s, opBgt_s, opBle_s, opBlt_s, + opBne_un_s, opBge_un_s, opBgt_un_s, opBle_un_s, opBlt_un_s, + opBr, opBrFalse, opBrTrue, + opBeq, opBge, opBgt, opBle, opBlt, + opBne_un, opBge_un, opBgt_un, opBle_un, opBlt_un, + opSwitch, + opLdInd_i1, opLdInd_i2, opLdInd_u1, opLdInd_u2, + opLdInd_i4, opLdInd_u4, opLdInd_i8, opLdInd_i, + opLdInd_r4, opLdInd_r8, opLdInd_ref, opStInd_ref, + opStInd_i1, opStInd_i2, opStInd_i4, opStInd_i8, + opStInd_r4, opStInd_r8, + opAdd, opSub, opMul, opDiv, opDiv_un, opRem, opRem_un, + opAnd, opOr, opXor, opShl, opShr, opShr_un, opNeg, opNot, + opConv_i1, opConv_i2, opConv_i4, opConv_i8, + opConv_r4, opConv_r8, opConv_u4, opConv_u8, + opCallVirt, opCpObj, opLdObj, opLdStr, opNewObj, + opCastClass, opIsInst, opConv_r_un, + opUnused58, opUnused1, + opUnbox, opThrow, + opLdFld, opLdFlda, opStFld, opLdsFld, opLdsFlda, opStsFld, opStObj, + opConv_ovf_i1_un, opConv_ovf_i2_un, opConv_ovf_i4_un, opConv_ovf_i8_un, + opConv_ovf_u1_un, opConv_ovf_u2_un, opConv_ovf_u4_un, opConv_ovf_u8_un, + opConv_ovf_i_un, opConv_ovf_u_un, + opBox, opNewArr, opLdLen, + opLdElema, opLdElem_i1, opLdElem_u1, opLdElem_i2, opLdElem_u2, + opLdElem_i4, opLdElem_u4, opLdElem_i8, opLdElem_i, + opLdElem_r4, opLdElem_r8, opLdElem_ref, + opStElem_i, opStElem_i1, opStElem_i2, opStElem_i4, opStElem_i8, + opStElem_r4, opStElem_r8, opStElem_ref, + opUnused2, opUnused3, opUnused4, opUnused5, + opUnused6, opUnused7, opUnused8, opUnused9, + opUnused10, opUnused11, opUnused12, opUnused13, + opUnused14, opUnused15, opUnused16, opUnused17, + opConv_ovf_i1, opConv_ovf_u1, opConv_ovf_i2, opConv_ovf_u2, + opConv_ovf_i4, opConv_ovf_u4, opConv_ovf_i8, opConv_ovf_u8, + opUnused50, opUnused18, opUnused19, opUnused20, + opUnused21, opUnused22, opUnused23, + opRefAnyVal, opCkFinite, + opUnused24, opUnused25, + opMkRefAny, + opUnused59, opUnused60, opUnused61, opUnused62, opUnused63, + opUnused64, opUnused65, opUnused66, opUnused67, + opLdToken, + opConv_u2, opConv_u1, opConv_i, opConv_ovf_i, opConv_ovf_u, + opAdd_ovf, opAdd_ovf_un, opMul_ovf, opMul_ovf_un, opSub_ovf, opSub_ovf_un, + opEndFinally, opLeave, opLeave_s, opStInd_i, opConv_u, + opUnused26, opUnused27, opUnused28, opUnused29, opUnused30, + opUnused31, opUnused32, opUnused33, opUnused34, opUnused35, + opUnused36, opUnused37, opUnused38, opUnused39, opUnused40, + opUnused41, opUnused42, opUnused43, opUnused44, opUnused45, + opUnused46, opUnused47, opUnused48, + opPrefix7, opPrefix6, opPrefix5, opPrefix4, + opPrefix3, opPrefix2, opPrefix1, opPrefixRef, + + opArgLlist, opCeq, opCgt, opCgt_un, opClt, opClt_un, + opLdFtn, opLdVirtFtn, optUnused56, + opLdArg, opLdArga, opStArg, opLdLoc, opLdLoca, opStLoc, + opLocalLoc, opUnused57, opEndFilter, opUnaligned, opVolatile, + opTail, opInitObj, opUnused68, opCpBlk, opInitBlk, opUnused69, + opRethrow, opUnused51, opSizeOf, opRefAnyType, + opUnused52, opUnused53, opUnused54, opUnused55, opUnused70); + + TJclInstructionDumpILOption = + (doLineNo, doRawBytes, doIL, doTokenValue, doComment); + TJclInstructionDumpILOptions = set of TJclInstructionDumpILOption; + + TJclInstructionParamType = + (ptVoid, ptI1, ptI2, ptI4, ptI8, ptU1, ptU2, ptU4, ptU8, ptR4, ptR8, + ptToken, ptSOff, ptLOff, ptArray); + +const + InstructionDumpILAllOption = + [doLineNo, doRawBytes, doIL, doTokenValue, doComment]; + +type + TJclClrILGenerator = class; + + TJclInstruction = class(TObject) + private + FOpCode: TJclOpCode; + FOffset: DWORD; + FParam: Variant; + FOwner: TJclClrILGenerator; + function GetWideOpCode: Boolean; + function GetRealOpCode: Byte; + function GetName: string; + function GetFullName: string; + function GetDescription: string; + function GetParamType: TJclInstructionParamType; + function FormatLabel(Offset: Integer): string; + protected + function GetSize: DWORD; virtual; + function DumpILOption(Option: TJclInstructionDumpILOption): string; virtual; + public + constructor Create(AOwner: TJclClrILGenerator; AOpCode: TJclOpCode); + procedure Load(Stream: TStream); virtual; + procedure Save(Stream: TStream); virtual; + function DumpIL(Options: TJclInstructionDumpILOptions = [doIL]): string; + property Owner: TJclClrILGenerator read FOwner; + property OpCode: TJclOpCode read FOpCode; + property WideOpCode: Boolean read GetWideOpCode; + property RealOpCode: Byte read GetRealOpCode; + property Param: Variant read FParam write FParam; + property ParamType: TJclInstructionParamType read GetParamType; + property Name: string read GetName; + property FullName: string read GetFullName; + property Description: string read GetDescription; + property Size: DWORD read GetSize; + property Offset: DWORD read FOffset; + end; + + TJclUnaryInstruction = class(TJclInstruction); + + TJclBinaryInstruction = class(TJclInstruction); + + TJclClrILGenerator = class(TObject) + private + FMethod: TJclClrMethodBody; + FInstructions: TObjectList; + function GetInstructionCount: Integer; + function GetInstruction(const Idx: Integer): TJclInstruction; + public + constructor Create(AMethod: TJclClrMethodBody = nil); + destructor Destroy; override; + function DumpIL(Options: TJclInstructionDumpILOptions): string; + property Method: TJclClrMethodBody read FMethod; + property Instructions[const Idx: Integer]: TJclInstruction read GetInstruction; + property InstructionCount: Integer read GetInstructionCount; + end; + + EJclCliInstructionError = class(EJclError); + EJclCliInstructionStreamInvalid = class(EJclCliInstructionError); + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.Variants, + {$ELSE ~HAS_UNITSCOPE} + Variants, + {$ENDIF ~HAS_UNITSCOPE} + JclCLR, + JclPeImage, + JclStrings, JclResources; + +type + TJclOpCodeInfoType = (itName, itFullName, itDescription); + +const + STP1 = $FE; + + OpCodeInfos: array [TJclOpCode, TJclOpCodeInfoType] of PResStringRec = + ( + (@RsCILNamenop, @RsCILCmdnop, @RsCILDescrnop), + (@RsCILNamebreak, @RsCILCmdbreak, @RsCILDescrbreak), + (@RsCILNameldarg0, @RsCILCmdldarg0, @RsCILDescrldarg0), + (@RsCILNameldarg1, @RsCILCmdldarg1, @RsCILDescrldarg1), + (@RsCILNameldarg2, @RsCILCmdldarg2, @RsCILDescrldarg2), + (@RsCILNameldarg3, @RsCILCmdldarg3, @RsCILDescrldarg3), + (@RsCILNameldloc0, @RsCILCmdldloc0, @RsCILDescrldloc0), + (@RsCILNameldloc1, @RsCILCmdldloc1, @RsCILDescrldloc1), + (@RsCILNameldloc2, @RsCILCmdldloc2, @RsCILDescrldloc2), + (@RsCILNameldloc3, @RsCILCmdldloc3, @RsCILDescrldloc3), + (@RsCILNamestloc0, @RsCILCmdstloc0, @RsCILDescrstloc0), + (@RsCILNamestloc1, @RsCILCmdstloc1, @RsCILDescrstloc1), + (@RsCILNamestloc2, @RsCILCmdstloc2, @RsCILDescrstloc2), + (@RsCILNamestloc3, @RsCILCmdstloc3, @RsCILDescrstloc3), + (@RsCILNameldargs, @RsCILCmdldargs, @RsCILDescrldargs), + (@RsCILNameldargas, @RsCILCmdldargas, @RsCILDescrldargas), + (@RsCILNamestargs, @RsCILCmdstargs, @RsCILDescrstargs), + (@RsCILNameldlocs, @RsCILCmdldlocs, @RsCILDescrldlocs), + (@RsCILNameldlocas, @RsCILCmdldlocas, @RsCILDescrldlocas), + (@RsCILNamestlocs, @RsCILCmdstlocs, @RsCILDescrstlocs), + (@RsCILNameldnull, @RsCILCmdldnull, @RsCILDescrldnull), + (@RsCILNameldci4m1, @RsCILCmdldci4m1, @RsCILDescrldci4m1), + (@RsCILNameldci40, @RsCILCmdldci40, @RsCILDescrldci40), + (@RsCILNameldci41, @RsCILCmdldci41, @RsCILDescrldci41), + (@RsCILNameldci42, @RsCILCmdldci42, @RsCILDescrldci42), + (@RsCILNameldci43, @RsCILCmdldci43, @RsCILDescrldci43), + (@RsCILNameldci44, @RsCILCmdldci44, @RsCILDescrldci44), + (@RsCILNameldci45, @RsCILCmdldci45, @RsCILDescrldci45), + (@RsCILNameldci46, @RsCILCmdldci46, @RsCILDescrldci46), + (@RsCILNameldci47, @RsCILCmdldci47, @RsCILDescrldci47), + (@RsCILNameldci48, @RsCILCmdldci48, @RsCILDescrldci48), + (@RsCILNameldci4s, @RsCILCmdldci4s, @RsCILDescrldci4s), + (@RsCILNameldci4, @RsCILCmdldci4, @RsCILDescrldci4), + (@RsCILNameldci8, @RsCILCmdldci8, @RsCILDescrldci8), + (@RsCILNameldcr4, @RsCILCmdldcr4, @RsCILDescrldcr4), + (@RsCILNameldcr8, @RsCILCmdldcr8, @RsCILDescrldcr8), + (@RsCILNameunused1, @RsCILCmdunused1, @RsCILDescrunused1), + (@RsCILNamedup, @RsCILCmddup, @RsCILDescrdup), + (@RsCILNamepop, @RsCILCmdpop, @RsCILDescrpop), + (@RsCILNamejmp, @RsCILCmdjmp, @RsCILDescrjmp), + (@RsCILNamecall, @RsCILCmdcall, @RsCILDescrcall), + (@RsCILNamecalli, @RsCILCmdcalli, @RsCILDescrcalli), + (@RsCILNameret, @RsCILCmdret, @RsCILDescrret), + (@RsCILNamebrs, @RsCILCmdbrs, @RsCILDescrbrs), + (@RsCILNamebrfalses, @RsCILCmdbrfalses, @RsCILDescrbrfalses), + (@RsCILNamebrtrues, @RsCILCmdbrtrues, @RsCILDescrbrtrues), + (@RsCILNamebeqs, @RsCILCmdbeqs, @RsCILDescrbeqs), + (@RsCILNamebges, @RsCILCmdbges, @RsCILDescrbges), + (@RsCILNamebgts, @RsCILCmdbgts, @RsCILDescrbgts), + (@RsCILNamebles, @RsCILCmdbles, @RsCILDescrbles), + (@RsCILNameblts, @RsCILCmdblts, @RsCILDescrblts), + (@RsCILNamebneuns, @RsCILCmdbneuns, @RsCILDescrbneuns), + (@RsCILNamebgeuns, @RsCILCmdbgeuns, @RsCILDescrbgeuns), + (@RsCILNamebgtuns, @RsCILCmdbgtuns, @RsCILDescrbgtuns), + (@RsCILNamebleuns, @RsCILCmdbleuns, @RsCILDescrbleuns), + (@RsCILNamebltuns, @RsCILCmdbltuns, @RsCILDescrbltuns), + (@RsCILNamebr, @RsCILCmdbr, @RsCILDescrbr), + (@RsCILNamebrfalse, @RsCILCmdbrfalse, @RsCILDescrbrfalse), + (@RsCILNamebrtrue, @RsCILCmdbrtrue, @RsCILDescrbrtrue), + (@RsCILNamebeq, @RsCILCmdbeq, @RsCILDescrbeq), + (@RsCILNamebge, @RsCILCmdbge, @RsCILDescrbge), + (@RsCILNamebgt, @RsCILCmdbgt, @RsCILDescrbgt), + (@RsCILNameble, @RsCILCmdble, @RsCILDescrble), + (@RsCILNameblt, @RsCILCmdblt, @RsCILDescrblt), + (@RsCILNamebneun, @RsCILCmdbneun, @RsCILDescrbneun), + (@RsCILNamebgeun, @RsCILCmdbgeun, @RsCILDescrbgeun), + (@RsCILNamebgtun, @RsCILCmdbgtun, @RsCILDescrbgtun), + (@RsCILNamebleun, @RsCILCmdbleun, @RsCILDescrbleun), + (@RsCILNamebltun, @RsCILCmdbltun, @RsCILDescrbltun), + (@RsCILNameswitch, @RsCILCmdswitch, @RsCILDescrswitch), + (@RsCILNameldindi1, @RsCILCmdldindi1, @RsCILDescrldindi1), + (@RsCILNameldindu1, @RsCILCmdldindu1, @RsCILDescrldindu1), + (@RsCILNameldindi2, @RsCILCmdldindi2, @RsCILDescrldindi2), + (@RsCILNameldindu2, @RsCILCmdldindu2, @RsCILDescrldindu2), + (@RsCILNameldindi4, @RsCILCmdldindi4, @RsCILDescrldindi4), + (@RsCILNameldindu4, @RsCILCmdldindu4, @RsCILDescrldindu4), + (@RsCILNameldindi8, @RsCILCmdldindi8, @RsCILDescrldindi8), + (@RsCILNameldindi, @RsCILCmdldindi, @RsCILDescrldindi), + (@RsCILNameldindr4, @RsCILCmdldindr4, @RsCILDescrldindr4), + (@RsCILNameldindr8, @RsCILCmdldindr8, @RsCILDescrldindr8), + (@RsCILNameldindref, @RsCILCmdldindref, @RsCILDescrldindref), + (@RsCILNamestindref, @RsCILCmdstindref, @RsCILDescrstindref), + (@RsCILNamestindi1, @RsCILCmdstindi1, @RsCILDescrstindi1), + (@RsCILNamestindi2, @RsCILCmdstindi2, @RsCILDescrstindi2), + (@RsCILNamestindi4, @RsCILCmdstindi4, @RsCILDescrstindi4), + (@RsCILNamestindi8, @RsCILCmdstindi8, @RsCILDescrstindi8), + (@RsCILNamestindr4, @RsCILCmdstindr4, @RsCILDescrstindr4), + (@RsCILNamestindr8, @RsCILCmdstindr8, @RsCILDescrstindr8), + (@RsCILNameadd, @RsCILCmdadd, @RsCILDescradd), + (@RsCILNamesub, @RsCILCmdsub, @RsCILDescrsub), + (@RsCILNamemul, @RsCILCmdmul, @RsCILDescrmul), + (@RsCILNamediv, @RsCILCmddiv, @RsCILDescrdiv), + (@RsCILNamedivun, @RsCILCmddivun, @RsCILDescrdivun), + (@RsCILNamerem, @RsCILCmdrem, @RsCILDescrrem), + (@RsCILNameremun, @RsCILCmdremun, @RsCILDescrremun), + (@RsCILNameand, @RsCILCmdand, @RsCILDescrand), + (@RsCILNameor, @RsCILCmdor, @RsCILDescror), + (@RsCILNamexor, @RsCILCmdxor, @RsCILDescrxor), + (@RsCILNameshl, @RsCILCmdshl, @RsCILDescrshl), + (@RsCILNameshr, @RsCILCmdshr, @RsCILDescrshr), + (@RsCILNameshrun, @RsCILCmdshrun, @RsCILDescrshrun), + (@RsCILNameneg, @RsCILCmdneg, @RsCILDescrneg), + (@RsCILNamenot, @RsCILCmdnot, @RsCILDescrnot), + (@RsCILNameconvi1, @RsCILCmdconvi1, @RsCILDescrconvi1), + (@RsCILNameconvi2, @RsCILCmdconvi2, @RsCILDescrconvi2), + (@RsCILNameconvi4, @RsCILCmdconvi4, @RsCILDescrconvi4), + (@RsCILNameconvi8, @RsCILCmdconvi8, @RsCILDescrconvi8), + (@RsCILNameconvr4, @RsCILCmdconvr4, @RsCILDescrconvr4), + (@RsCILNameconvr8, @RsCILCmdconvr8, @RsCILDescrconvr8), + (@RsCILNameconvu4, @RsCILCmdconvu4, @RsCILDescrconvu4), + (@RsCILNameconvu8, @RsCILCmdconvu8, @RsCILDescrconvu8), + (@RsCILNamecallvirt, @RsCILCmdcallvirt, @RsCILDescrcallvirt), + (@RsCILNamecpobj, @RsCILCmdcpobj, @RsCILDescrcpobj), + (@RsCILNameldobj, @RsCILCmdldobj, @RsCILDescrldobj), + (@RsCILNameldstr, @RsCILCmdldstr, @RsCILDescrldstr), + (@RsCILNamenewobj, @RsCILCmdnewobj, @RsCILDescrnewobj), + (@RsCILNamecastclass, @RsCILCmdcastclass, @RsCILDescrcastclass), + (@RsCILNameisinst, @RsCILCmdisinst, @RsCILDescrisinst), + (@RsCILNameconvrun, @RsCILCmdconvrun, @RsCILDescrconvrun), + (@RsCILNameunused2, @RsCILCmdunused2, @RsCILDescrunused2), + (@RsCILNameunused3, @RsCILCmdunused3, @RsCILDescrunused3), + (@RsCILNameunbox, @RsCILCmdunbox, @RsCILDescrunbox), + (@RsCILNamethrow, @RsCILCmdthrow, @RsCILDescrthrow), + (@RsCILNameldfld, @RsCILCmdldfld, @RsCILDescrldfld), + (@RsCILNameldflda, @RsCILCmdldflda, @RsCILDescrldflda), + (@RsCILNamestfld, @RsCILCmdstfld, @RsCILDescrstfld), + (@RsCILNameldsfld, @RsCILCmdldsfld, @RsCILDescrldsfld), + (@RsCILNameldsflda, @RsCILCmdldsflda, @RsCILDescrldsflda), + (@RsCILNamestsfld, @RsCILCmdstsfld, @RsCILDescrstsfld), + (@RsCILNamestobj, @RsCILCmdstobj, @RsCILDescrstobj), + (@RsCILNameconvovfi1un, @RsCILCmdconvovfi1un, @RsCILDescrconvovfi1un), + (@RsCILNameconvovfi2un, @RsCILCmdconvovfi2un, @RsCILDescrconvovfi2un), + (@RsCILNameconvovfi4un, @RsCILCmdconvovfi4un, @RsCILDescrconvovfi4un), + (@RsCILNameconvovfi8un, @RsCILCmdconvovfi8un, @RsCILDescrconvovfi8un), + (@RsCILNameconvovfu1un, @RsCILCmdconvovfu1un, @RsCILDescrconvovfu1un), + (@RsCILNameconvovfu2un, @RsCILCmdconvovfu2un, @RsCILDescrconvovfu2un), + (@RsCILNameconvovfu4un, @RsCILCmdconvovfu4un, @RsCILDescrconvovfu4un), + (@RsCILNameconvovfu8un, @RsCILCmdconvovfu8un, @RsCILDescrconvovfu8un), + (@RsCILNameconvovfiun, @RsCILCmdconvovfiun, @RsCILDescrconvovfiun), + (@RsCILNameconvovfuun, @RsCILCmdconvovfuun, @RsCILDescrconvovfuun), + (@RsCILNamebox, @RsCILCmdbox, @RsCILDescrbox), + (@RsCILNamenewarr, @RsCILCmdnewarr, @RsCILDescrnewarr), + (@RsCILNameldlen, @RsCILCmdldlen, @RsCILDescrldlen), + (@RsCILNameldelema, @RsCILCmdldelema, @RsCILDescrldelema), + (@RsCILNameldelemi1, @RsCILCmdldelemi1, @RsCILDescrldelemi1), + (@RsCILNameldelemu1, @RsCILCmdldelemu1, @RsCILDescrldelemu1), + (@RsCILNameldelemi2, @RsCILCmdldelemi2, @RsCILDescrldelemi2), + (@RsCILNameldelemu2, @RsCILCmdldelemu2, @RsCILDescrldelemu2), + (@RsCILNameldelemi4, @RsCILCmdldelemi4, @RsCILDescrldelemi4), + (@RsCILNameldelemu4, @RsCILCmdldelemu4, @RsCILDescrldelemu4), + (@RsCILNameldelemi8, @RsCILCmdldelemi8, @RsCILDescrldelemi8), + (@RsCILNameldelemi, @RsCILCmdldelemi, @RsCILDescrldelemi), + (@RsCILNameldelemr4, @RsCILCmdldelemr4, @RsCILDescrldelemr4), + (@RsCILNameldelemr8, @RsCILCmdldelemr8, @RsCILDescrldelemr8), + (@RsCILNameldelemref, @RsCILCmdldelemref, @RsCILDescrldelemref), + (@RsCILNamestelemi, @RsCILCmdstelemi, @RsCILDescrstelemi), + (@RsCILNamestelemi1, @RsCILCmdstelemi1, @RsCILDescrstelemi1), + (@RsCILNamestelemi2, @RsCILCmdstelemi2, @RsCILDescrstelemi2), + (@RsCILNamestelemi4, @RsCILCmdstelemi4, @RsCILDescrstelemi4), + (@RsCILNamestelemi8, @RsCILCmdstelemi8, @RsCILDescrstelemi8), + (@RsCILNamestelemr4, @RsCILCmdstelemr4, @RsCILDescrstelemr4), + (@RsCILNamestelemr8, @RsCILCmdstelemr8, @RsCILDescrstelemr8), + (@RsCILNamestelemref, @RsCILCmdstelemref, @RsCILDescrstelemref), + (@RsCILNameunused4, @RsCILCmdunused4, @RsCILDescrunused4), + (@RsCILNameunused5, @RsCILCmdunused5, @RsCILDescrunused5), + (@RsCILNameunused6, @RsCILCmdunused6, @RsCILDescrunused6), + (@RsCILNameunused7, @RsCILCmdunused7, @RsCILDescrunused7), + (@RsCILNameunused8, @RsCILCmdunused8, @RsCILDescrunused8), + (@RsCILNameunused9, @RsCILCmdunused9, @RsCILDescrunused9), + (@RsCILNameunused10, @RsCILCmdunused10, @RsCILDescrunused10), + (@RsCILNameunused11, @RsCILCmdunused11, @RsCILDescrunused11), + (@RsCILNameunused12, @RsCILCmdunused12, @RsCILDescrunused12), + (@RsCILNameunused13, @RsCILCmdunused13, @RsCILDescrunused13), + (@RsCILNameunused14, @RsCILCmdunused14, @RsCILDescrunused14), + (@RsCILNameunused15, @RsCILCmdunused15, @RsCILDescrunused15), + (@RsCILNameunused16, @RsCILCmdunused16, @RsCILDescrunused16), + (@RsCILNameunused17, @RsCILCmdunused17, @RsCILDescrunused17), + (@RsCILNameunused18, @RsCILCmdunused18, @RsCILDescrunused18), + (@RsCILNameunused19, @RsCILCmdunused19, @RsCILDescrunused19), + (@RsCILNameconvovfi1, @RsCILCmdconvovfi1, @RsCILDescrconvovfi1), + (@RsCILNameconvovfu1, @RsCILCmdconvovfu1, @RsCILDescrconvovfu1), + (@RsCILNameconvovfi2, @RsCILCmdconvovfi2, @RsCILDescrconvovfi2), + (@RsCILNameconvovfu2, @RsCILCmdconvovfu2, @RsCILDescrconvovfu2), + (@RsCILNameconvovfi4, @RsCILCmdconvovfi4, @RsCILDescrconvovfi4), + (@RsCILNameconvovfu4, @RsCILCmdconvovfu4, @RsCILDescrconvovfu4), + (@RsCILNameconvovfi8, @RsCILCmdconvovfi8, @RsCILDescrconvovfi8), + (@RsCILNameconvovfu8, @RsCILCmdconvovfu8, @RsCILDescrconvovfu8), + (@RsCILNameunused20, @RsCILCmdunused20, @RsCILDescrunused20), + (@RsCILNameunused21, @RsCILCmdunused21, @RsCILDescrunused21), + (@RsCILNameunused22, @RsCILCmdunused22, @RsCILDescrunused22), + (@RsCILNameunused23, @RsCILCmdunused23, @RsCILDescrunused23), + (@RsCILNameunused24, @RsCILCmdunused24, @RsCILDescrunused24), + (@RsCILNameunused25, @RsCILCmdunused25, @RsCILDescrunused25), + (@RsCILNameunused26, @RsCILCmdunused26, @RsCILDescrunused26), + (@RsCILNamerefanyval, @RsCILCmdrefanyval, @RsCILDescrrefanyval), + (@RsCILNameckfinite, @RsCILCmdckfinite, @RsCILDescrckfinite), + (@RsCILNameunused27, @RsCILCmdunused27, @RsCILDescrunused27), + (@RsCILNameunused28, @RsCILCmdunused28, @RsCILDescrunused28), + (@RsCILNamemkrefany, @RsCILCmdmkrefany, @RsCILDescrmkrefany), + (@RsCILNameunused29, @RsCILCmdunused29, @RsCILDescrunused29), + (@RsCILNameunused30, @RsCILCmdunused30, @RsCILDescrunused30), + (@RsCILNameunused31, @RsCILCmdunused31, @RsCILDescrunused31), + (@RsCILNameunused32, @RsCILCmdunused32, @RsCILDescrunused32), + (@RsCILNameunused33, @RsCILCmdunused33, @RsCILDescrunused33), + (@RsCILNameunused34, @RsCILCmdunused34, @RsCILDescrunused34), + (@RsCILNameunused35, @RsCILCmdunused35, @RsCILDescrunused35), + (@RsCILNameunused36, @RsCILCmdunused36, @RsCILDescrunused36), + (@RsCILNameunused37, @RsCILCmdunused37, @RsCILDescrunused37), + (@RsCILNameldtoken, @RsCILCmdldtoken, @RsCILDescrldtoken), + (@RsCILNameconvu2, @RsCILCmdconvu2, @RsCILDescrconvu2), + (@RsCILNameconvu1, @RsCILCmdconvu1, @RsCILDescrconvu1), + (@RsCILNameconvi, @RsCILCmdconvi, @RsCILDescrconvi), + (@RsCILNameconvovfi, @RsCILCmdconvovfi, @RsCILDescrconvovfi), + (@RsCILNameconvovfu, @RsCILCmdconvovfu, @RsCILDescrconvovfu), + (@RsCILNameaddovf, @RsCILCmdaddovf, @RsCILDescraddovf), + (@RsCILNameaddovfun, @RsCILCmdaddovfun, @RsCILDescraddovfun), + (@RsCILNamemulovf, @RsCILCmdmulovf, @RsCILDescrmulovf), + (@RsCILNamemulovfun, @RsCILCmdmulovfun, @RsCILDescrmulovfun), + (@RsCILNamesubovf, @RsCILCmdsubovf, @RsCILDescrsubovf), + (@RsCILNamesubovfun, @RsCILCmdsubovfun, @RsCILDescrsubovfun), + (@RsCILNameendfinally, @RsCILCmdendfinally, @RsCILDescrendfinally), + (@RsCILNameleave, @RsCILCmdleave, @RsCILDescrleave), + (@RsCILNameleaves, @RsCILCmdleaves, @RsCILDescrleaves), + (@RsCILNamestindi, @RsCILCmdstindi, @RsCILDescrstindi), + (@RsCILNameconvu, @RsCILCmdconvu, @RsCILDescrconvu), + (@RsCILNameunused38, @RsCILCmdunused38, @RsCILDescrunused38), + (@RsCILNameunused39, @RsCILCmdunused39, @RsCILDescrunused39), + (@RsCILNameunused40, @RsCILCmdunused40, @RsCILDescrunused40), + (@RsCILNameunused41, @RsCILCmdunused41, @RsCILDescrunused41), + (@RsCILNameunused42, @RsCILCmdunused42, @RsCILDescrunused42), + (@RsCILNameunused43, @RsCILCmdunused43, @RsCILDescrunused43), + (@RsCILNameunused44, @RsCILCmdunused44, @RsCILDescrunused44), + (@RsCILNameunused45, @RsCILCmdunused45, @RsCILDescrunused45), + (@RsCILNameunused46, @RsCILCmdunused46, @RsCILDescrunused46), + (@RsCILNameunused47, @RsCILCmdunused47, @RsCILDescrunused47), + (@RsCILNameunused48, @RsCILCmdunused48, @RsCILDescrunused48), + (@RsCILNameunused49, @RsCILCmdunused49, @RsCILDescrunused49), + (@RsCILNameunused50, @RsCILCmdunused50, @RsCILDescrunused50), + (@RsCILNameunused51, @RsCILCmdunused51, @RsCILDescrunused51), + (@RsCILNameunused52, @RsCILCmdunused52, @RsCILDescrunused52), + (@RsCILNameunused53, @RsCILCmdunused53, @RsCILDescrunused53), + (@RsCILNameunused54, @RsCILCmdunused54, @RsCILDescrunused54), + (@RsCILNameunused55, @RsCILCmdunused55, @RsCILDescrunused55), + (@RsCILNameunused56, @RsCILCmdunused56, @RsCILDescrunused56), + (@RsCILNameunused57, @RsCILCmdunused57, @RsCILDescrunused57), + (@RsCILNameunused58, @RsCILCmdunused58, @RsCILDescrunused58), + (@RsCILNameunused59, @RsCILCmdunused59, @RsCILDescrunused59), + (@RsCILNameunused60, @RsCILCmdunused60, @RsCILDescrunused60), + (@RsCILNameprefix7, @RsCILCmdprefix7, @RsCILDescrprefix7), + (@RsCILNameprefix6, @RsCILCmdprefix6, @RsCILDescrprefix6), + (@RsCILNameprefix5, @RsCILCmdprefix5, @RsCILDescrprefix5), + (@RsCILNameprefix4, @RsCILCmdprefix4, @RsCILDescrprefix4), + (@RsCILNameprefix3, @RsCILCmdprefix3, @RsCILDescrprefix3), + (@RsCILNameprefix2, @RsCILCmdprefix2, @RsCILDescrprefix2), + (@RsCILNameprefix1, @RsCILCmdprefix1, @RsCILDescrprefix1), + (@RsCILNameprefixref, @RsCILCmdprefixref, @RsCILDescrprefixref), + + (@RsCILNamearglist, @RsCILCmdarglist, @RsCILDescrarglist), + (@RsCILNameceq, @RsCILCmdceq, @RsCILDescrceq), + (@RsCILNamecgt, @RsCILCmdcgt, @RsCILDescrcgt), + (@RsCILNamecgtun, @RsCILCmdcgtun, @RsCILDescrcgtun), + (@RsCILNameclt, @RsCILCmdclt, @RsCILDescrclt), + (@RsCILNamecltun, @RsCILCmdcltun, @RsCILDescrcltun), + (@RsCILNameldftn, @RsCILCmdldftn, @RsCILDescrldftn), + (@RsCILNameldvirtftn, @RsCILCmdldvirtftn, @RsCILDescrldvirtftn), + (@RsCILNameunused61, @RsCILCmdunused61, @RsCILDescrunused61), + (@RsCILNameldarg, @RsCILCmdldarg, @RsCILDescrldarg), + (@RsCILNameldarga, @RsCILCmdldarga, @RsCILDescrldarga), + (@RsCILNamestarg, @RsCILCmdstarg, @RsCILDescrstarg), + (@RsCILNameldloc, @RsCILCmdldloc, @RsCILDescrldloc), + (@RsCILNameldloca, @RsCILCmdldloca, @RsCILDescrldloca), + (@RsCILNamestloc, @RsCILCmdstloc, @RsCILDescrstloc), + (@RsCILNamelocalloc, @RsCILCmdlocalloc, @RsCILDescrlocalloc), + (@RsCILNameunused62, @RsCILCmdunused62, @RsCILDescrunused62), + (@RsCILNameendfilter, @RsCILCmdendfilter, @RsCILDescrendfilter), + (@RsCILNameunaligned, @RsCILCmdunaligned, @RsCILDescrunaligned), + (@RsCILNamevolatile, @RsCILCmdvolatile, @RsCILDescrvolatile), + (@RsCILNametail, @RsCILCmdtail, @RsCILDescrtail), + (@RsCILNameinitobj, @RsCILCmdinitobj, @RsCILDescrinitobj), + (@RsCILNameunused63, @RsCILCmdunused63, @RsCILDescrunused63), + (@RsCILNamecpblk, @RsCILCmdcpblk, @RsCILDescrcpblk), + (@RsCILNameinitblk, @RsCILCmdinitblk, @RsCILDescrinitblk), + (@RsCILNameunused64, @RsCILCmdunused64, @RsCILDescrunused64), + (@RsCILNamerethrow, @RsCILCmdrethrow, @RsCILDescrrethrow), + (@RsCILNameunused65, @RsCILCmdunused65, @RsCILDescrunused65), + (@RsCILNamesizeof, @RsCILCmdsizeof, @RsCILDescrsizeof), + (@RsCILNamerefanytype, @RsCILCmdrefanytype, @RsCILDescrrefanytype), + (@RsCILNameunused66, @RsCILCmdunused66, @RsCILDescrunused66), + (@RsCILNameunused67, @RsCILCmdunused67, @RsCILDescrunused67), + (@RsCILNameunused68, @RsCILCmdunused68, @RsCILDescrunused68), + (@RsCILNameunused69, @RsCILCmdunused69, @RsCILDescrunused69), + (@RsCILNameunused70, @RsCILCmdunused70, @RsCILDescrunused70) + ); + + OpCodeParamTypes: array [TJclOpCode] of TJclInstructionParamType = + (ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, {00} + ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptU1, ptU1, {08} + ptU1, ptU1, ptU1, ptU1, ptVoid, ptVoid, ptVoid, ptVoid, {10} + ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptI1, {18} + ptI4, ptI8, ptR4, ptR8, ptVoid, ptVoid, ptVoid, ptToken, {20} + ptToken, ptVoid, ptVoid, ptSOff, ptSOff, ptSOff, ptSOff, ptSOff, {28} + ptSOff, ptSOff, ptSOff, ptSOff, ptSOff, ptSOff, ptSOff, ptSOff, {30} + ptLOff, ptLOff, ptLOff, ptLOff, ptLOff, ptLOff, ptLOff, ptLOff, {38} + ptLOff, ptLOff, ptLOff, ptLOff, ptLOff, ptVoid, ptVoid, ptVoid, {40} + ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, {48} + ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, {50} + ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, {58} + ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, {60} + ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptToken, {68} + ptToken, ptToken, ptToken, ptToken, ptToken, ptToken, ptVoid, ptVoid, {70} + ptVoid, ptToken, ptVoid, ptToken, ptToken, ptToken, ptToken, ptToken, {78} + ptToken, ptToken, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, {80} + ptVoid, ptVoid, ptVoid, ptVoid, ptToken, ptToken, ptVoid, ptToken, {88} + ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, {90} + ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, {98} + ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, {A0} + ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, {A8} + ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, {B0} + ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, {B8} + ptVoid, ptVoid, ptToken, ptVoid, ptVoid, ptVoid, ptToken, ptVoid, {C0} + ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, {C8} + ptToken, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, {D0} + ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptI4, ptI1, ptVoid, {D8} + ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, {E0} + ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, {E8} + ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, {F0} + ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, {F8} + ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptVoid, ptToken, ptToken, {00} + ptVoid, ptU2, ptU2, ptU2, ptU2, ptU2, ptU2, ptVoid, {08} + ptVoid, ptVoid, ptI1, ptVoid, ptVoid, ptToken, ptVoid, ptVoid, {10} + ptVoid, ptVoid, ptVoid, ptVoid, ptToken, ptVoid, ptVoid, ptVoid, {18} + ptVoid, ptVoid, ptVoid); {20} + +//=== { TJclClrILGenerator } ================================================ + +constructor TJclClrILGenerator.Create(AMethod: TJclClrMethodBody = nil); +var + OpCode: Byte; + Stream: TMemoryStream; + Instruction: TJclInstruction; +begin + inherited Create; + FMethod := AMethod; + FInstructions := TObjectList.Create; + if Assigned(AMethod) then + begin + Stream := TMemoryStream.Create; + try + Stream.Write(Method.Code^, Method.Size); + Stream.Seek(0, soFromBeginning); + while Stream.Position < Stream.Size do + begin + OpCode := PByte(PAnsiChar(Stream.Memory) + Stream.Position)^; + if OpCode = STP1 then + begin + OpCode := PByte(PAnsiChar(Stream.Memory) + Stream.Position + 1)^; + Instruction := TJclInstruction.Create(Self, TJclOpCode(MaxByte + 1 + OpCode)); + end + else + Instruction := TJclInstruction.Create(Self, TJclOpCode(OpCode)); + if Assigned(Instruction) then + begin + FInstructions.Add(Instruction); + Instruction.Load(Stream); + end; + end; + finally + FreeAndNil(Stream); + end; + end; +end; + +destructor TJclClrILGenerator.Destroy; +begin + FreeAndNil(FInstructions); + inherited Destroy; +end; + +function TJclClrILGenerator.DumpIL(Options: TJclInstructionDumpILOptions): string; +var + I, J, Indent: Integer; + + function FlagsToName(Flags: TJclClrExceptionClauseFlags): string; + begin + if cfFinally in Flags then + Result := 'finally' + else + if cfFilter in Flags then + Result := 'filter' + else + if cfFault in Flags then + Result := 'fault' + else + Result := 'catch'; + end; + + function IndentStr: string; + begin + Result := StrRepeat(' ', Indent); + end; + +var + SL: TStrings; + EH: TJclClrExceptionHandler; +begin + Indent := 0; + SL := TStringList.Create; + try + for I := 0 to InstructionCount-1 do + begin + for J := 0 to Method.ExceptionHandlerCount - 1 do + begin + EH := Method.ExceptionHandlers[J]; + if Instructions[I].Offset = EH.TryBlock.Offset then + begin + SL.Add(IndentStr + '.try'); + SL.Add(IndentStr + '{'); + Inc(Indent); + end; + if Instructions[I].Offset = (EH.TryBlock.Offset + EH.TryBlock.Length) then + begin + Dec(Indent); + SL.Add(IndentStr + '} // end .try'); + end; + if Instructions[I].Offset = EH.HandlerBlock.Offset then + begin + SL.Add(IndentStr + FlagsToName(EH.Flags)); + SL.Add(IndentStr + '{'); + Inc(Indent); + end; + if Instructions[I].Offset = (EH.HandlerBlock.Offset + EH.HandlerBlock.Length) then + begin + Dec(Indent); + SL.Add(IndentStr + '} // end ' + FlagsToName(EH.Flags)); + end; + end; + SL.Add(IndentStr + Instructions[I].DumpIL(Options)); + end; + Result := SL.Text; + finally + SL.Free; + end; +end; + +function TJclClrILGenerator.GetInstructionCount: Integer; +begin + Result := FInstructions.Count; +end; + +function TJclClrILGenerator.GetInstruction(const Idx: Integer): TJclInstruction; +begin + Result := TJclInstruction(FInstructions[Idx]); +end; + +//=== { TJclInstruction } ==================================================== + +constructor TJclInstruction.Create(AOwner :TJclClrILGenerator; AOpCode: TJclOpCode); +begin + inherited Create; + FOwner := AOwner; + FOpCode := AOpCode; +end; + +function TJclInstruction.GetWideOpCode: Boolean; +begin + Result := Integer(OpCode) > MaxByte; +end; + +function TJclInstruction.GetRealOpCode: Byte; +begin + if WideOpCode then + Result := Integer(OpCode) mod (MaxByte + 1) + else + Result := Integer(OpCode); +end; + +function TJclInstruction.GetParamType: TJclInstructionParamType; +begin + Result := OpCodeParamTypes[OpCode]; +end; + +function TJclInstruction.GetName: string; +begin + Result := LoadResString(OpCodeInfos[OpCode, itName]); +end; + +function TJclInstruction.GetFullName: string; +begin + Result := LoadResString(OpCodeInfos[OpCode, itFullName]); +end; + +function TJclInstruction.GetDescription: string; +begin + Result := LoadResString(OpCodeInfos[OpCode, itDescription]) +end; + +function TJclInstruction.GetSize: DWORD; +const + OpCodeSize: array [Boolean] of DWORD = (1, 2); +begin + case ParamType of + ptSOff, ptI1, ptU1: + Result := SizeOf(Byte); + ptI2, ptU2: + Result := SizeOf(Word); + ptLOff, ptI4, ptToken, ptU4, ptR4: + Result := SizeOf(DWORD); + ptI8, ptU8, ptR8: + Result := SizeOf(Int64); + ptArray: + Result := (VarArrayHighBound(FParam, 1) - VarArrayLowBound(FParam, 1) + 1 + 1) * SizeOf(Integer); + else + Result := 0; + end; + Inc(Result, OpCodeSize[OpCode in [opNop..opPrefixRef]]); +end; + +procedure TJclInstruction.Load(Stream: TStream); +var + Code: Byte; + I, ArraySize: DWORD; { TODO : I, ArraySize = DWORD create a serious problem } + Value: Integer; +begin + FOffset := Stream.Position; + try + Code := 0; + Stream.Read(Code, SizeOf(Code)); + if WideOpCode then + begin + if Code <> STP1 then + raise EJclCliInstructionStreamInvalid.CreateRes(@RsInstructionStreamInvalid); + Stream.Read(Code, SizeOf(Code)); + end; + + if Code <> RealOpCode then + raise EJclCliInstructionStreamInvalid.CreateRes(@RsInstructionStreamInvalid); + + with TVarData(FParam) do + case ParamType of + ptU1: + begin + Stream.Read(VByte, SizeOf(Byte)); + VType := varByte; + end; + ptI2: + begin + Stream.Read(VSmallInt, SizeOf(SmallInt)); + VType := varSmallInt; + end; + ptLOff, ptI4: + begin + Stream.Read(VInteger, SizeOf(Integer)); + VType := varInteger; + end; + ptR4: + begin + Stream.Read(VSingle, SizeOf(Single)); + VType := varSingle; + end; + ptR8: + begin + Stream.Read(VDouble, SizeOf(Double)); + VType := varDouble; + end; + ptArray: + begin + ArraySize := 0; + Stream.Read(ArraySize, SizeOf(ArraySize)); + FParam := VarArrayCreate([0, ArraySize-1], varInteger); + for I := 0 to ArraySize-1 do { TODO : ArraySize = 0 and we have a nearly endless loop } + begin + Value := 0; + Stream.Read(Value, SizeOf(Value)); + FParam[I] := Value; + end; + end; + ptSOff, ptI1: + begin + Stream.Read(VShortInt, SizeOf(ShortInt)); + VType := varShortInt; + end; + ptU2: + begin + Stream.Read(VWord, SizeOf(Word)); + VType := varWord; + end; + ptToken, ptU4: + begin + Stream.Read(VLongWord, SizeOf(LongWord)); + VType := varLongWord; + end; + ptI8, ptU8: + begin + Stream.Read(VInt64, SizeOf(Int64)); + VType := varInt64; + end; + end; + except + Stream.Position := FOffset; + raise; + end; +end; + +procedure TJclInstruction.Save(Stream: TStream); +var + Code: Byte; + ArraySize: DWORD; + I, Value: Integer; +begin + if WideOpCode then + begin + Code := STP1; + Stream.Write(Code, SizeOf(Code)); + end; + + Code := RealOpCode;; + Stream.Write(Code, SizeOf(Code)); + + case ParamType of + ptU1: + Stream.Write(TVarData(FParam).VByte, SizeOf(Byte)); + ptI2: + Stream.Write(TVarData(FParam).VSmallInt, SizeOf(SmallInt)); + ptLOff, ptI4: + Stream.Write(TVarData(FParam).VInteger, SizeOf(Integer)); + ptR4: + Stream.Write(TVarData(FParam).VSingle, SizeOf(Single)); + ptR8: + Stream.Write(TVarData(FParam).VDouble, SizeOf(Double)); + ptSOff, ptI1: + Stream.Write(TVarData(FParam).VShortInt, SizeOf(ShortInt)); + ptU2: + Stream.Write(TVarData(FParam).VWord, SizeOf(Word)); + ptToken, ptU4: + Stream.Write(TVarData(FParam).VLongWord, SizeOf(LongWord)); + ptI8, ptU8: + Stream.Write(TVarData(FParam).VInt64, SizeOf(Int64)); + ptArray: + begin + ArraySize := VarArrayHighBound(FParam, 1) - VarArrayLowBound(FParam, 1) + 1; + Stream.Write(ArraySize, SizeOf(ArraySize)); + { TODO : VarArrayHighBound to VarArrayLowBound very likely wrong } + for I := VarArrayHighBound(FParam, 1) to VarArrayLowBound(FParam, 1) do + begin + Value := VarArrayGet(FParam, [I]); + Stream.Write(Value, SizeOf(Value)); + end; + end; + end; +end; + +function TJclInstruction.DumpIL(Options: TJclInstructionDumpILOptions): string; +var + Opt: TJclInstructionDumpILOption; +begin + if doLineNo in Options then + Result := DumpILOption(doLineNo) + ': '; + if doRawBytes in Options then + Result := Result + Format(' /* %.24s */ ', [DumpILOption(doRawBytes)]); + for Opt := doIL to doTokenValue do + Result := Result + DumpILOption(Opt) + ' '; + if (doComment in Options) and ((FullName <> '') or (Description <> '')) then + Result := Result + ' // ' + DumpILOption(doComment); +end; + +function TJclInstruction.FormatLabel(Offset: Integer): string; +begin + Result := 'IL_' + IntToHex(Offset, 4); +end; + +function TJclInstruction.DumpILOption(Option: TJclInstructionDumpILOption): string; + + function TokenToString(Token: DWORD): string; + begin + Result := '(' + IntToHex(Token shr 24, 2) + ')' + IntToHex(Token mod (1 shl 24), 6); + end; + +var + I: Integer; + Row: TJclClrTableRow; + CodeStr, ParamStr: string; +begin + case Option of + doLineNo: + Result := 'IL_' + IntToHex(Offset, 4); + doRawBytes: + begin + if WideOpCode then + CodeStr := IntToHex(STP1, 2); + + CodeStr := CodeStr + IntToHex(RealOpCode, 2); + CodeStr := CodeStr + StrRepeat(' ', 4 - Length(CodeStr)); + + case ParamType of + ptSOff, ptI1, ptU1: + ParamStr := IntToHex(TVarData(FParam).VByte, 2); + ptArray: + ParamStr := 'Array'; + ptI2, ptU2: + ParamStr := IntToHex(TVarData(FParam).VWord, 4); + ptLOff, ptI4, ptU4, ptR4: + ParamStr := IntToHex(TVarData(FParam).VLongWord, 8); + ptI8, ptU8, ptR8: + ParamStr := IntToHex(TVarData(FParam).VInt64, 16); + ptToken: + ParamStr := TokenToString(TVarData(FParam).VLongWord); + else + ParamStr := ''; + end; + ParamStr := ParamStr + StrRepeat(' ', 10 - Length(ParamStr)); + Result := CodeStr + ' | ' + ParamStr; + end; + doIL: + begin + case ParamType of + ptVoid: + ; // do nothing + ptLOff: + Result := FormatLabel(Integer(Offset) + + Integer(Size) + TVarData(Param).VInteger - 1); + ptToken: + begin + if Byte(TJclPeMetadata.TokenTable(TVarData(Param).VLongWord)) = $70 then + Result := '"' + Owner.Method.Method.Table.Stream.Metadata.UserStringAt(TJclPeMetadata.TokenIndex(TVarData(Param).VLongWord)) + '"' + else + begin + Row := Owner.Method.Method.Table.Stream.Metadata.Tokens[TVarData(Param).VLongWord]; + if Assigned(Row) then + begin + if Row is TJclClrTableTypeDefRow then + Result := TJclClrTableTypeDefRow(Row).FullName + else + if Row is TJclClrTableTypeRefRow then + Result := TJclClrTableTypeRefRow(Row).FullName + else + if Row is TJclClrTableMethodDefRow then + with TJclClrTableMethodDefRow(Row) do + Result := ParentToken.FullName + '.' + Name + else + if Row is TJclClrTableMemberRefRow then + Result := TJclClrTableMemberRefRow(Row).FullName + else + if Row is TJclClrTableFieldDefRow then + with TJclClrTableFieldDefRow(Row) do + Result := ParentToken.FullName + '.' + Name + else + Result := Row.DumpIL; + end + else + Result := ''; + end; + Result := Result + ' /* ' + IntToHex(TVarData(FParam).VLongWord, 8) + ' */'; + end; + ptSOff: + Result := FormatLabel(Integer(Offset + Size) + TVarData(Param).VShortInt - 1); + ptArray: + begin + for I := VarArrayHighBound(FParam, 1) to VarArrayLowBound(FParam, 1) do + begin + Result := Result + FormatLabel(Offset + Size + VarArrayGet(FParam, [I])); + if I <> VarArrayLowBound(FParam, 1) then + Result := Result + ', '; + end; + Result := ' (' + Result + ')'; + end; + else + Result := VarToStr(Param); + end; + Result := GetName + StrRepeat(' ', 10 - Length(GetName)) + ' ' + Result; + Result := Result + StrRepeat(' ', 20 - Length(Result)); + end; + doTokenValue: + Result := ''; // do nothing + doComment: + if FullName = '' then + Result := Description + else + if Description = '' then + Result := FullName + else + Result := FullName + ' - ' + Description; + end; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/JclCLR.pas b/3rdParty/JCL/source/windows/JclCLR.pas new file mode 100644 index 00000000..369fa807 --- /dev/null +++ b/3rdParty/JCL/source/windows/JclCLR.pas @@ -0,0 +1,1781 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclCLR.pas. } +{ } +{ The Initial Developer of the Original Code is Flier Lu (). } +{ Portions created by Flier Lu are Copyright (C) Flier Lu. All Rights Reserved. } +{ } +{ Contributors: } +{ Flier Lu (flier) } +{ Robert Marquardt (marquardt) } +{ Olivier Sannier (obones) } +{ Petr Vones (pvones) } +{ } +{**************************************************************************************************} +{ } +{ Microsoft .Net framework Clr information support routines and classes. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclCLR; + +interface + +{$I jcl.inc} +{$I windowsonly.inc} + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Winapi.Windows, + {$ENDIF MSWINDOWS} + System.Classes, System.SysUtils, System.Contnrs, + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + Classes, SysUtils, Contnrs, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclFileUtils, JclStrings, JclPeImage, JclSysUtils; + +type + _IMAGE_COR_VTABLEFIXUP = packed record + RVA: DWORD; // Offset of v-table array in image. + Count: Word; // How many entries at location. + Kind: Word; // COR_VTABLE_xxx type of entries. + end; + IMAGE_COR_VTABLEFIXUP = _IMAGE_COR_VTABLEFIXUP; + TImageCorVTableFixup = _IMAGE_COR_VTABLEFIXUP; + PImageCorVTableFixup = ^TImageCorVTableFixup; + TImageCorVTableFixupArray = array [0..MaxWord - 1] of TImageCorVTableFixup; + PImageCorVTableFixupArray = ^TImageCorVTableFixupArray; + +type + PClrStreamHeader = ^TClrStreamHeader; + TClrStreamHeader = packed record + Offset: DWORD; // Memory offset to start of this stream from start of the metadata root + Size: DWORD; // Size of this stream in bytes, shall be a multiple of 4. + // Name of the stream as null terminated variable length + // array of ASCII characters, padded with \0 characters + Name: array [0..MaxWord] of AnsiChar; + end; + + PClrTableStreamHeader = ^TClrTableStreamHeader; + TClrTableStreamHeader = packed record + Reserved: DWORD; // Reserved, always 0 + MajorVersion: Byte; // Major version of table schemata, always 1 + MinorVersion: Byte; // Minor version of table schemata, always 0 + HeapSizes: Byte; // Bit vector for heap sizes. + Reserved2: Byte; // Reserved, always 1 + Valid: Int64; // Bit vector of present tables, let n be the number of bits that are 1. + Sorted: Int64; // Bit vector of sorted tables. + // Array of n four byte unsigned integers indicating the number of rows + // for each present table. + Rows: array [0..MaxWord] of DWORD; + //Rows: array [0..n - 1] of DWORD; + //Tables: array + end; + + PClrMetadataHeader = ^TClrMetadataHeader; + TClrMetadataHeader = packed record + Signature: DWORD; // Magic signature for physical metadata : $424A5342. + MajorVersion: Word; // Major version, 1 + MinorVersion: Word; // Minor version, 0 + Reserved: DWORD; // Reserved, always 0 + Length: DWORD; // Length of version string in bytes, say m. + Version: array [0..0] of AnsiChar; + // UTF8-encoded version string of length m + // Padding to next 4 byte boundary, say x. + { + Version: array [0..((m+3) and not $3) - 1] of AnsiChar; + Flags, // Reserved, always 0 + Streams: Word; // Number of streams, say n. + // Array of n StreamHdr structures. + StreamHeaders: array [0..n - 1] of TClrStreamHeader; + } + end; + +type + TJclClrTableKind = ( + ttModule, // $00 + ttTypeRef, // $01 + ttTypeDef, // $02 + ttFieldPtr, // $03 + ttFieldDef, // $04 + ttMethodPtr, // $05 + ttMethodDef, // $06 + ttParamPtr, // $07 + ttParamDef, // $08 + ttInterfaceImpl, // $09 + ttMemberRef, // $0a + ttConstant, // $0b + ttCustomAttribute, // $0c + ttFieldMarshal, // $0d + ttDeclSecurity, // $0e + ttClassLayout, // $0f + ttFieldLayout, // $10 + ttSignature, // $11 + ttEventMap, // $12 + ttEventPtr, // $13 + ttEventDef, // $14 + ttPropertyMap, // $15 + ttPropertyPtr, // $16 + ttPropertyDef, // $17 + ttMethodSemantics, // $18 + ttMethodImpl, // $19 + ttModuleRef, // $1a + ttTypeSpec, // $1b + ttImplMap, // $1c + ttFieldRVA, // $1d + ttENCLog, // $1e + ttENCMap, // $1f + ttAssembly, // $20 + ttAssemblyProcessor, // $21 + ttAssemblyOS, // $22 + ttAssemblyRef, // $23 + ttAssemblyRefProcessor, // $24 + ttAssemblyRefOS, // $25 + ttFile, // $26 + ttExportedType, // $27 + ttManifestResource, // $28 + ttNestedClass, // $29 + ttTypeTyPar, // $2a + ttMethodTyPar); // $2b + + TJclClrToken = DWORD; + PJclClrToken = ^TJclClrToken; + +type + TJclClrHeaderEx = class; + TJclPeMetadata = class; + + TJclClrStream = class(TObject) + private + FMetadata: TJclPeMetadata; + FHeader: PClrStreamHeader; + function GetName: string; + function GetOffset: DWORD; + function GetSize: DWORD; + function GetData: Pointer; + public + constructor Create(const AMetadata: TJclPeMetadata; + AHeader: PClrStreamHeader); virtual; + property Metadata: TJclPeMetadata read FMetadata; + property Header: PClrStreamHeader read FHeader; + property Name: string read GetName; + property Offset: DWORD read GetOffset; + property Size: DWORD read GetSize; + property Data: Pointer read GetData; + end; + + TJclClrStreamClass = class of TJclClrStream; + + TJclClrStringsStream = class(TJclClrStream) + private + FStrings: TStringList; + function GetString(const Idx: Integer): WideString; + function GetOffset(const Idx: Integer): DWORD; + function GetStringCount: Integer; + public + constructor Create(const AMetadata: TJclPeMetadata; + AHeader: PClrStreamHeader); override; + destructor Destroy; override; + function At(const Offset: DWORD): WideString; + property Strings[const Idx: Integer]: WideString read GetString; default; + property Offsets[const Idx: Integer]: DWord read GetOffset; + property StringCount: Integer read GetStringCount; + end; + + TJclClrGuidStream = class(TJclClrStream) + private + FGuids: array of TGUID; + function GetGuid(const Idx: Integer): TGUID; + function GetGuidCount: Integer; + public + constructor Create(const AMetadata: TJclPeMetadata; + AHeader: PClrStreamHeader); override; + property Guids[const Idx: Integer]: TGUID read GetGuid; default; + property GuidCount: Integer read GetGuidCount; + end; + + TJclClrBlobRecord = class(TJclReferenceMemoryStream) + private + FPtr: PJclByteArray; + FOffset: DWORD; + function GetData: PJclByteArray; + public + constructor Create(const AStream: TJclClrStream; APtr: PJclByteArray); + function Dump(Indent: string): string; + property Ptr: PJclByteArray read FPtr; + property Offset: DWORD read FOffset; + property Data: PJclByteArray read GetData; + end; + + TJclClrBlobStream = class(TJclClrStream) + private + FBlobs: TObjectList; + function GetBlob(const Idx: Integer): TJclClrBlobRecord; + function GetBlobCount: Integer; + public + constructor Create(const AMetadata: TJclPeMetadata; + AHeader: PClrStreamHeader); override; + destructor Destroy; override; + function At(const Offset: DWORD): TJclClrBlobRecord; + property Blobs[const Idx: Integer]: TJclClrBlobRecord read GetBlob; default; + property BlobCount: Integer read GetBlobCount; + end; + + TJclClrUserStringStream = class(TJclClrBlobStream) + private + function BlobToString(const ABlob: TJclClrBlobRecord): WideString; + function GetString(const Idx: Integer): WideString; + function GetOffset(const Idx: Integer): DWORD; + function GetStringCount: Integer; + public + function At(const Offset: DWORD): WideString; + property Strings[const Idx: Integer]: WideString read GetString; default; + property Offsets[const Idx: Integer]: DWord read GetOffset; + property StringCount: Integer read GetStringCount; + end; + + TJclClrTableStream = class; + + TJclClrHeapKind = (hkString, hkGuid, hkBlob); + TJclClrComboIndex = (ciResolutionScope); + + ITableCanDumpIL = interface(IUnknown) + ['{C7AC787B-5DCD-411A-8674-D424A61B76D1}'] + end; + + TJclClrTable = class; + + TJclClrTableRow = class(TObject) + private + FTable: TJclClrTable; + FIndex: Integer; + function GetToken: TJclClrToken; + protected + procedure Update; virtual; + function DecodeTypeDefOrRef(const Encoded: DWORD): TJclClrTableRow; + function DecodeResolutionScope(const Encoded: DWORD): TJclClrTableRow; + public + constructor Create(const ATable: TJclClrTable); virtual; + function DumpIL: string; virtual; + property Table: TJclClrTable read FTable; + property Index: Integer read FIndex; + property Token: TJclClrToken read GetToken; + end; + + TJclClrTableRowClass = class of TJclClrTableRow; + + TJclClrTable = class(TInterfacedObject) + private + FStream: TJclClrTableStream; + FData: PAnsiChar; + FPtr: PAnsiChar; + FRows: TObjectList; + FRowCount: Integer; + FSize: DWORD; + function GetOffset: DWORD; + protected + procedure Load; virtual; + procedure SetSize(const Value: Integer); + procedure Update; virtual; + function DumpIL: string; virtual; + function GetRow(const Idx: Integer): TJclClrTableRow; + function GetRowCount: Integer; + function AddRow(const ARow: TJclClrTableRow): Integer; + function RealRowCount: Integer; + procedure Reset; + class function TableRowClass: TJclClrTableRowClass; virtual; + public + constructor Create(const AStream: TJclClrTableStream; + const Ptr: Pointer; const ARowCount: Integer); virtual; + destructor Destroy; override; + function ReadCompressedValue: DWORD; + function ReadByte: Byte; + function ReadWord: Word; + function ReadDWord: DWORD; + function ReadIndex(const HeapKind: TJclClrHeapKind): DWORD; overload; + function ReadIndex(const TableKinds: array of TJclClrTableKind): DWORD; overload; + function IsWideIndex(const HeapKind: TJclClrHeapKind): Boolean; overload; + function IsWideIndex(const TableKinds: array of TJclClrTableKind): Boolean; overload; + function GetCodedIndexTag(const CodedIndex, TagWidth: DWORD; + const WideIndex: Boolean): DWORD; + function GetCodedIndexValue(const CodedIndex, TagWidth: DWORD; + const WideIndex: Boolean): DWORD; + property Stream: TJclClrTableStream read FStream; + property Data: PAnsiChar read FData; + property Size: DWORD read FSize; + property Offset: DWORD read GetOffset; + property Rows[const Idx: Integer]: TJclClrTableRow read GetRow; default; + property RowCount: Integer read GetRowCount; + end; + + TJclClrTableClass = class of TJclClrTable; + + TJclClrTableStream = class(TJclClrStream) + private + FHeader: PClrTableStreamHeader; + FTables: array [TJclClrTableKind] of TJclClrTable; + FTableCount: Integer; + function GetVersionString: string; + function GetTable(const AKind: TJclClrTableKind): TJclClrTable; + function GetBigHeap(const AHeapKind: TJclClrHeapKind): Boolean; + public + constructor Create(const AMetadata: TJclPeMetadata; + AHeader: PClrStreamHeader); override; + destructor Destroy; override; + procedure Update; virtual; + function DumpIL: string; + function FindTable(const AKind: TJclClrTableKind; + out ATable: TJclClrTable): Boolean; + property Header: PClrTableStreamHeader read FHeader; + property VersionString: string read GetVersionString; + property BigHeap[const AHeapKind: TJclClrHeapKind]: Boolean read GetBigHeap; + property Tables[const AKind: TJclClrTableKind]: TJclClrTable read GetTable; + property TableCount: Integer read FTableCount; + end; + + TJclPeMetadata = class(TObject) + private + FImage: TJclPeImage; + FHeader: PClrMetadataHeader; + FStreams: TObjectList; + FStringStream: TJclClrStringsStream; + FGuidStream: TJclClrGuidStream; + FBlobStream: TJclClrBlobStream; + FUserStringStream: TJclClrUserStringStream; + FTableStream: TJclClrTableStream; + function GetStream(const Idx: Integer): TJclClrStream; + function GetStreamCount: Integer; + function GetString(const Idx: Integer): WideString; + function GetStringCount: Integer; + function GetGuid(const Idx: Integer): TGUID; + function GetGuidCount: Integer; + function GetBlob(const Idx: Integer): TJclClrBlobRecord; + function GetBlobCount: Integer; + function GetTable(const AKind: TJclClrTableKind): TJclClrTable; + function GetTableCount: Integer; + function GetToken(const AToken: TJclClrToken): TJclClrTableRow; + function GetVersion: string; + function GetVersionString: WideString; + function GetFlags: Word; + function UserGetString(const Idx: Integer): WideString; + function UserGetStringCount: Integer; + public + constructor Create(const AImage: TJclPeImage); + destructor Destroy; override; + function DumpIL: string; + function FindStream(const AName: string; out Stream: TJclClrStream): Boolean; overload; + function FindStream(const AClass: TJclClrStreamClass; out Stream: TJclClrStream): Boolean; overload; + function StringAt(const Offset: DWORD): WideString; + function UserStringAt(const Offset: DWORD): WideString; + function BlobAt(const Offset: DWORD): TJclClrBlobRecord; + function TokenExists(const Token: TJclClrToken): Boolean; + class function TokenTable(const Token: TJclClrToken): TJclClrTableKind; + class function TokenIndex(const Token: TJclClrToken): Integer; + class function TokenCode(const Token: TJclClrToken): Integer; + class function MakeToken(const Table: TJclClrTableKind; const Idx: Integer): TJclClrToken; + property Image: TJclPeImage read FImage; + property Header: PClrMetadataHeader read FHeader; + property Version: string read GetVersion; + property VersionString: WideString read GetVersionString; + property Flags: Word read GetFlags; + property Streams[const Idx: Integer]: TJclClrStream read GetStream; default; + property StreamCount: Integer read GetStreamCount; + property Strings[const Idx: Integer]: WideString read GetString; + property StringCount: Integer read GetStringCount; + property UserStrings[const Idx: Integer]: WideString read UserGetString; + property UserStringCount: Integer read UserGetStringCount; + property Guids[const Idx: Integer]: TGUID read GetGuid; + property GuidCount: Integer read GetGuidCount; + property Blobs[const Idx: Integer]: TJclClrBlobRecord read GetBlob; + property BlobCount: Integer read GetBlobCount; + property Tables[const AKind: TJclClrTableKind]: TJclClrTable read GetTable; + property TableCount: Integer read GetTableCount; + property Tokens[const AToken: TJclClrToken]: TJclClrTableRow read GetToken; + end; + + TJclClrResourceRecord = class(TJClreferenceMemoryStream) + private + FData: Pointer; + FOffset: DWORD; + FRVA: DWORD; + public + constructor Create(const AData: PAnsiChar; const AOffset: DWORD; const ARVA: DWORD); + property Data: Pointer read FData; + property Offset: DWORD read FOffset; + property RVA: DWORD read FRVA; + end; + + TJclClrVTableKind = (vtk32Bit, vtk64Bit, vtkFromUnmanaged, vtkCallMostDerived); + TJclClrVTableKinds = set of TJclClrVTableKind; + + TJclClrVTableFixupRecord = class(TObject) + private + FData: PImageCorVTableFixup; + function GetCount: DWORD; + function GetKinds: TJclClrVTableKinds; + function GetRVA: DWORD; + protected + class function VTableKinds(const Kinds: TJclClrVTableKinds): DWORD; overload; + class function VTableKinds(const Kinds: DWORD): TJclClrVTableKinds; overload; + public + constructor Create(AData: PImageCorVTableFixup); + property Data: PImageCorVTableFixup read FData; + property RVA: DWORD read GetRVA; // RVA of Vtable + property Count: DWORD read GetCount; // Number of entries in Vtable + property Kinds: TJclClrVTableKinds read GetKinds; // Type of the entries + end; + + TJclClrImageFlag = (cifILOnly, cif32BitRequired, cifStrongNameSinged, cifTrackDebugData); + TJclClrImageFlags = set of TJclClrImageFlag; + + TJclClrHeaderEx = class(TJclPeClrHeader) + private + FMetadata: TJclPeMetadata; + FFlags: TJclClrImageFlags; + FStrongNameSignature: TCustomMemoryStream; + FResources: TObjectList; + FVTableFixups: TObjectList; + function GetMetadata: TJclPeMetadata; + function GetStrongNameSignature: TCustomMemoryStream; + function GetEntryPointToken: TJclClrTableRow; + function GetVTableFixup(const Idx: Integer): TJclClrVTableFixupRecord; + function GetVTableFixupCount: Integer; + procedure UpdateResources; + function GetResource(const Idx: Integer): TJclClrResourceRecord; + function GetResourceCount: Integer; + public + constructor Create(const AImage: TJclPeImage); + destructor Destroy; override; + function DumpIL: string; + function HasResources: Boolean; + function HasStrongNameSignature: Boolean; + function HasVTableFixup: Boolean; + function ResourceAt(const Offset: DWORD): TJclClrResourceRecord; + class function ClrImageFlag(const Flags: DWORD): TJclClrImageFlags; overload; + class function ClrImageFlag(const Flags: TJclClrImageFlags): DWORD; overload; + property Metadata: TJclPeMetadata read GetMetadata; + property Flags: TJclClrImageFlags read FFlags; + property EntryPointToken: TJclClrTableRow read GetEntryPointToken; + property StrongNameSignature: TCustomMemoryStream read GetStrongNameSignature; + property Resources[const Idx: Integer]: TJclClrResourceRecord read GetResource; + property ResourceCount: Integer read GetResourceCount; + property VTableFixups[const Idx: Integer]: TJclClrVTableFixupRecord read GetVTableFixup; + property VTableFixupCount: Integer read GetVTableFixupCount; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.TypInfo, + {$ELSE ~HAS_UNITSCOPE} + TypInfo, + {$ENDIF ~HAS_UNITSCOPE} + JclMetadata, JclResources, JclAnsiStrings, JclStringConversions; + +const + // MetadataHeaderSignature = $424A5342; // 'BSJB' + + GUID_NULL: TGUID = '{00000000-0000-0000-0000-000000000000}'; + + ValidTableMapping: array [TJclClrTableKind] of TJclClrTableClass = ( + TJclClrTableModule, // $00 ttModule + TJclClrTableTypeRef, // $01 ttTypeRef + TJclClrTableTypeDef, // $02 ttTypeDef + TJclClrTableFieldPtr, // $03 ttFieldPtr + TJclClrTableFieldDef, // $04 ttFieldDef + TJclClrTableMethodPtr, // $05 ttMethodPtr + TJclClrTableMethodDef, // $06 ttMethodDef + TJclClrTableParamPtr, // $07 ttParamPtr + TJclClrTableParamDef, // $08 ttParamDef + TJclClrTableInterfaceImpl, // $09 ttInterfaceImpl + TJclClrTableMemberRef, // $0a ttMemberRef + TJclClrTableConstant, // $0b ttConstant + TJclClrTableCustomAttribute, // $0c ttCustomAttribute + TJclClrTableFieldMarshal, // $0d ttFieldMarshal + TJclClrTableDeclSecurity, // $0e ttDeclSecurity + TJclClrTableClassLayout, // $0f ttClassLayout + TJclClrTableFieldLayout, // $10 ttFieldLayout + TJclClrTableStandAloneSig, // $11 ttSignature + TJclClrTableEventMap, // $12 ttEventMap + TJclClrTableEventPtr, // $13 ttEventPtr + TJclClrTableEventDef, // $14 ttEventDef + TJclClrTablePropertyMap, // $15 ttPropertyMap + TJclClrTablePropertyPtr, // $16 ttPropertyPtr + TJclClrTablePropertyDef, // $17 ttPropertyDef + TJclClrTableMethodSemantics, // $18 ttMethodSemantics + TJclClrTableMethodImpl, // $19 ttMethodImpl + TJclClrTableModuleRef, // $1a ttModuleRef + TJclClrTableTypeSpec, // $1b ttTypeSpec + TJclClrTableImplMap, // $1c ttImplMap + TJclClrTableFieldRVA, // $1d ttFieldRVA + TJclClrTableENCLog, // $1e ttENCLog + TJclClrTableENCMap, // $1f ttENCMap + TJclClrTableAssembly, // $20 ttAssembly + TJclClrTableAssemblyProcessor, // $21 ttAssemblyProcessor + TJclClrTableAssemblyOS, // $22 ttAssemblyOS + TJclClrTableAssemblyRef, // $23 ttAssemblyRef + TJclClrTableAssemblyRefProcessor, // $24 ttAssemblyRefProcessor + TJclClrTableAssemblyRefOS, // $25 ttAssemblyRefOS + TJclClrTableFile, // $26 ttFile + TJclClrTableExportedType, // $27 ttExportedType + TJclClrTableManifestResource, // $28 ttManifestResource + TJclClrTableNestedClass, // $29 ttNestedClass + TJclClrTable, // $2A ttGenericPar + TJclClrTableMethodSpec); // $2B ttMethodSpec + +// CLR Header entry point flags. +const + COMIMAGE_FLAGS_ILONLY = $00000001; // Always 1 (see Section 23.1). + COMIMAGE_FLAGS_32BITREQUIRED = $00000002; + // Image may only be loaded into a 32-bit process, + // for instance if there are 32-bit vtablefixups, + // or casts from native integers to int32. + // CLI implementations that have 64 bit native integers shall refuse + // loading binaries with this flag set. + COMIMAGE_FLAGS_STRONGNAMESIGNED = $00000008; // Image has a strong name signature. + COMIMAGE_FLAGS_TRACKDEBUGDATA = $00010000; // Always 0 (see Section 23.1). + ClrImageFlagMapping: array [TJclClrImageFlag] of DWORD = + (COMIMAGE_FLAGS_ILONLY, COMIMAGE_FLAGS_32BITREQUIRED, + COMIMAGE_FLAGS_STRONGNAMESIGNED, COMIMAGE_FLAGS_TRACKDEBUGDATA); + +// V-table constants +const + COR_VTABLE_32BIT = $01; // V-table slots are 32-bits in size. + COR_VTABLE_64BIT = $02; // V-table slots are 64-bits in size. + COR_VTABLE_FROM_UNMANAGED = $04; // If set, transition from unmanaged. + COR_VTABLE_CALL_MOST_DERIVED = $10; // Call most derived method described by + + ClrVTableKindMapping: array [TJclClrVTableKind] of DWORD = + (COR_VTABLE_32BIT, COR_VTABLE_64BIT, + COR_VTABLE_FROM_UNMANAGED, COR_VTABLE_CALL_MOST_DERIVED); + +//=== { TJclClrStream } ====================================================== + +constructor TJclClrStream.Create(const AMetadata: TJclPeMetadata; + AHeader: PClrStreamHeader); +begin + inherited Create; + FMetadata := AMetadata; + FHeader := AHeader; +end; + +function TJclClrStream.GetName: string; +begin + Result := string(FHeader.Name); +end; + +function TJclClrStream.GetOffset: DWORD; +begin + Result := TJclAddr(Data) - TJclAddr(Metadata.Image.LoadedImage.MappedAddress); +end; + +function TJclClrStream.GetSize: DWORD; +begin + Result := FHeader.Size; +end; + +function TJclClrStream.GetData: Pointer; +begin + Result := Pointer(PAnsiChar(FMetadata.Header) + FHeader.Offset); +end; + +//=== { TJclClrStringsStream } =============================================== + +constructor TJclClrStringsStream.Create(const AMetadata: TJclPeMetadata; + AHeader: PClrStreamHeader); +var + pch: PAnsiChar; + off: DWORD; +begin + inherited Create(AMetadata, AHeader); + FStrings := TStringList.Create; + pch := Data; + off := 0; + while off < Size do + begin + if pch^ <> #0 then + FStrings.AddObject(string(TUTF8String(pch)), TObject(off)); + pch := pch + StrLenA(pch) + 1; + off := pch - PAnsiChar(Data); + end; +end; + +destructor TJclClrStringsStream.Destroy; +begin + FreeAndNil(FStrings); + inherited Destroy; +end; + +function TJclClrStringsStream.GetString(const Idx: Integer): WideString; +begin + Result := UTF8ToWideString(TUTF8String(FStrings.Strings[Idx])); +end; + +function TJclClrStringsStream.GetOffset(const Idx: Integer): DWORD; +begin + Result := DWORD(FStrings.Objects[Idx]); +end; + +function TJclClrStringsStream.GetStringCount: Integer; +begin + Result := FStrings.Count; +end; + +function TJclClrStringsStream.At(const Offset: DWORD): WideString; +var + Idx: Integer; +begin + Idx := FStrings.IndexOfObject(TObject(Offset)); + if Idx <> -1 then + Result := GetString(Idx) + else + Result := ''; +end; + +//=== { TJclClrGuidStream } ================================================== + +constructor TJclClrGuidStream.Create(const AMetadata: TJclPeMetadata; + AHeader: PClrStreamHeader); +var + I: Integer; + pg: PGUID; +begin + inherited Create(AMetadata, AHeader); + SetLength(FGuids, Size div SizeOf(TGuid)); + pg := Data; + for I := 0 to GetGuidCount - 1 do + begin + FGuids[I] := pg^; + Inc(pg); + end; +end; + +function TJclClrGuidStream.GetGuid(const Idx: Integer): TGUID; +begin + Assert((0 <= Idx) and (Idx < GetGuidCount)); + Result := FGuids[Idx]; +end; + +function TJclClrGuidStream.GetGuidCount: Integer; +begin + Result := Length(FGuids); +end; + +//=== { TJclClrBlobRecord } ================================================== + +constructor TJclClrBlobRecord.Create(const AStream: TJclClrStream; APtr: PJclByteArray); +var + b: Byte; + AData: Pointer; + ASize: DWORD; +begin + FPtr := APtr; + FOffset := TJclAddr(FPtr) - TJclAddr(AStream.Data); + + b := FPtr[0]; + if b = 0 then + begin + AData := @FPtr[1]; + ASize := 0; + end + else + if ((b and $C0) = $C0) and ((b and $20) = 0) then // 110bs + begin + AData := @FPtr[4]; + ASize := ((b and $1F) shl 24) or (FPtr[1] shl 16) or (FPtr[2] shl 8) or FPtr[3]; + end + else + if ((b and $80) = $80) and ((b and $40) = 0) then // 10bs + begin + AData := @FPtr[2]; + ASize := ((b and $3F) shl 8) or FPtr[1]; + end + else + begin + AData := @FPtr[1]; + ASize := b and $7F; + end; + Assert(not IsBadReadPtr(AData, ASize)); + inherited Create(AData, ASize); +end; + +function TJclClrBlobRecord.Dump(Indent: string): string; +const + BufSize = 16; +var + I, Len: Integer; + + function DumpBuf(Buf: PAnsiChar; Size: Integer; IsHead, IsTail: Boolean): string; + var + I: Integer; + HexStr, AsciiStr: string; + begin + HexStr := ''; + AsciiStr := ''; + for I := 0 to Size - 1 do + begin + HexStr := HexStr + IntToHex(Integer(Buf[I]), 2) + ' '; + if JclAnsiStrings.CharIsPrintable(Buf[I]) and ((Byte(Buf[I]) and $80) <> $80) then + AsciiStr := AsciiStr + Char(Buf[I]) + else + AsciiStr := AsciiStr + '.'; + end; + + if IsTail then + Result := HexStr + ')' + JclStrings.StrRepeat(' ', (BufSize-Size) * 3) + ' // ' + AsciiStr + else + Result := HexStr + ' ' + JclStrings.StrRepeat(' ', (BufSize-Size) * 3) + ' // ' + AsciiStr; + if IsHead then + Result := Indent + '( ' + Result + else + Result := JclStrings.StrRepeat(' ', Length(Indent) + 2) + Result; + end; + +begin + with TStringList.Create do + try + Len := (Size + BufSize - 1) div BufSize; + for I := 0 to Len - 1 do + if I = Len - 1 then + Add(DumpBuf(PAnsiChar(Memory) + I * BufSize, Size - I * BufSize, I = 0, I = Len - 1)) + else + Add(DumpBuf(PAnsiChar(Memory) + I * BufSize, BufSize, I = 0, I = Len -1)); + Result := Text; + finally + Free; + end; +end; + +function TJclClrBlobRecord.GetData: PJclByteArray; +begin + Result := PJclByteArray(PAnsiChar(Memory) + Position); +end; + +//=== { TJclClrBlobStream } ================================================== + +constructor TJclClrBlobStream.Create(const AMetadata: TJclPeMetadata; + AHeader: PClrStreamHeader); +var + ABlob: TJclClrBlobRecord; +begin + inherited Create(AMetadata, AHeader); + FBlobs := TObjectList.Create; + ABlob := TJclClrBlobRecord.Create(Self, Data); + while Assigned(ABlob) do + begin + if ABlob.Size > 0 then + FBlobs.Add(ABlob); + if (PAnsiChar(ABlob.Memory) + ABlob.Size) < (PAnsiChar(Self.Data) + Integer(Self.Size)) then + ABlob := TJclClrBlobRecord.Create(Self, Pointer(PAnsiChar(ABlob.Memory) + ABlob.Size)) + else + ABlob := nil; + end; +end; + +destructor TJclClrBlobStream.Destroy; +begin + FreeAndNil(FBlobs); + inherited Destroy; +end; + +function TJclClrBlobStream.At(const Offset: DWORD): TJclClrBlobRecord; +var + I: Integer; +begin + for I := 0 to FBlobs.Count - 1 do + begin + Result := TJclClrBlobRecord(FBlobs.Items[I]); + if Result.Offset = Offset then + Exit; + end; + Result := nil; +end; + +function TJclClrBlobStream.GetBlob(const Idx: Integer): TJclClrBlobRecord; +begin + Result := TJclClrBlobRecord(FBlobs.Items[Idx]) +end; + +function TJclClrBlobStream.GetBlobCount: Integer; +begin + Result := FBlobs.Count; +end; + +//=== { TJclClrUserStringStream } ============================================ + +function TJclClrUserStringStream.BlobToString(const ABlob: TJclClrBlobRecord): WideString; +begin + if Assigned(ABlob) then + begin + SetLength(Result, ABlob.Size div 2); + Move(PWideChar(ABlob.Memory)^, PWideChar(Result)^, ABlob.Size and not 1); + end + else + Result := ''; +end; + +function TJclClrUserStringStream.GetString(const Idx: Integer): WideString; +begin + Result := BlobToString(Blobs[Idx]); +end; + +function TJclClrUserStringStream.GetOffset(const Idx: Integer): DWORD; +begin + Result := Blobs[Idx].Offset; +end; + +function TJclClrUserStringStream.GetStringCount: Integer; +begin + Result := BlobCount; +end; + +function TJclClrUserStringStream.At(const Offset: DWORD): WideString; +begin + Result := BlobToString(inherited At(Offset)); +end; + +//=== { TJclClrTableRow } ==================================================== + +constructor TJclClrTableRow.Create(const ATable: TJclClrTable); +begin + inherited Create; + FTable := ATable; + FIndex := Table.RealRowCount; +end; + +function TJclClrTableRow.DecodeResolutionScope(const Encoded: DWORD): TJclClrTableRow; +const + ResolutionScopeEncoded: array [0..3] of TJclClrTableKind = + (ttModule, ttModuleRef, ttAssemblyRef, ttTypeRef); +begin + Result := Table.Stream.Tables[ResolutionScopeEncoded[Encoded and 3]].Rows[Encoded shr 2 - 1]; +end; + +function TJclClrTableRow.DecodeTypeDefOrRef(const Encoded: DWORD): TJclClrTableRow; +const + TypeDefOrRefEncoded: array [0..2] of TJclClrTableKind = + (ttTypeDef, ttTypeRef, ttTypeSpec); +begin + Result := Table.Stream.Tables[TypeDefOrRefEncoded[Encoded and 3]].Rows[Encoded shr 2 - 1]; +end; + +function TJclClrTableRow.DumpIL: string; +begin + Result := ''; + // (rom) needs comment why empty +end; + +function TJclClrTableRow.GetToken: TJclClrToken; + + function GetTableId: TJclClrTableKind; + begin + for Result := Low(TJclClrTableKind) to High(TJclClrTableKind) do + if ValidTableMapping[Result] = Table.ClassType then + Exit; + raise EJclError.CreateResFmt(@RsUnknownTableFmt, [LoadResString(@RsUnknownTable), ClassName]); + end; + +begin + Result := (DWORD(GetTableId) shl 24) or DWORD(Index + 1); +end; + +procedure TJclClrTableRow.Update; +begin + // do nothing, just for override +end; + +//=== { TJclClrTable } ====================================================== + +constructor TJclClrTable.Create(const AStream: TJclClrTableStream; + const Ptr: Pointer; const ARowCount: Integer); +begin + inherited Create; + FStream := AStream; + FData := Ptr; + FRows := nil; // Create on demand + FRowCount := ARowCount; + Reset; + Load; + SetSize(FPtr - FData); +end; + +destructor TJclClrTable.Destroy; +begin + FreeAndNil(FRows); + inherited Destroy; +end; + +procedure TJclClrTable.Reset; +begin + FPtr := FData; +end; + +procedure TJclClrTable.Load; +var + I: Integer; +begin + Assert(RowCount > 0); + + if TableRowClass <> TJclClrTableRow then + for I := 0 to RowCount - 1 do + AddRow(TableRowClass.Create(Self)); +end; + +procedure TJclClrTable.SetSize(const Value: Integer); +begin + FSize := Value; + Assert(not IsBadReadPtr(FData, FSize)); +end; + +function TJclClrTable.GetOffset: DWORD; +begin + Result := TJclAddr(Data) - TJclAddr(Stream.Metadata.Image.LoadedImage.MappedAddress); +end; + +function TJclClrTable.GetRow(const Idx: Integer): TJclClrTableRow; +begin + Result := TJclClrTableRow(FRows.Items[Idx]); +end; + +function TJclClrTable.GetRowCount: Integer; +begin + Result := FRowCount; +end; + +function TJclClrTable.AddRow(const ARow: TJclClrTableRow): Integer; +begin + if not Assigned(FRows) then + FRows := TObjectList.Create; + Result := FRows.Add(ARow); +end; + +function TJclClrTable.RealRowCount: Integer; +begin + if Assigned(FRows) then + Result := FRows.Count + else + Result := 0; +end; + +function TJclClrTable.ReadIndex(const HeapKind: TJclClrHeapKind): DWORD; +begin + if IsWideIndex(HeapKind) then + Result := ReadDWord + else + Result := ReadWord; +end; + +function TJclClrTable.ReadIndex(const TableKinds: array of TJclClrTableKind): DWORD; +begin + if IsWideIndex(TableKinds) then + Result := ReadDWord + else + Result := ReadWord; +end; + +function TJclClrTable.IsWideIndex(const HeapKind: TJclClrHeapKind): Boolean; +begin + Result := Stream.BigHeap[HeapKind]; +end; + +function TJclClrTable.IsWideIndex(const TableKinds: array of TJclClrTableKind): Boolean; +var + I: Integer; + ATable: TJclClrTable; +begin + Result := False; + for I := Low(TableKinds) to High(TableKinds) do + if Stream.FindTable(TableKinds[I], ATable) then + Result := Result or (ATable.RowCount > MAXWORD); +end; + +function TJclClrTable.ReadByte: Byte; +begin + Result := PByte(FPtr)^; + Inc(FPtr, SizeOf(Byte)); +end; + +function TJclClrTable.ReadWord: Word; +begin + Result := PWord(FPtr)^; + Inc(FPtr, SizeOf(Word)); +end; + +function TJclClrTable.ReadDWord: DWORD; +begin + Result := PDWORD(FPtr)^; + Inc(FPtr, SizeOf(DWORD)); +end; + +function TJclClrTable.ReadCompressedValue: DWORD; +var + I: Integer; +begin + Result := ReadByte; + if Result = 0 then + begin + Exit; + end + else + if ((Result and $C0) = $C0) and ((Result and $20) = 0) then // 110bs + begin + Result := Result and $1F; + for I := 0 to 2 do + Result := (Result shl 8) or ReadByte; + end + else + if ((Result and $80) = $80) and ((Result and $40) = 0) then // 10bs + begin + Result := ((Result and $3F) shl 8) or ReadByte; + end + else + begin + Result := Result and $7F; + end; +end; + +class function TJclClrTable.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableRow; +end; + +procedure TJclClrTable.Update; +var + I: Integer; +begin + if Assigned(FRows) then + for I := 0 to RowCount - 1 do + Rows[I].Update; +end; + +function TJclClrTable.GetCodedIndexTag(const CodedIndex, TagWidth: DWORD; + const WideIndex: Boolean): DWORD; +var + I, TagMask: DWORD; +begin + TagMask := 0; + for I := 0 to TagWidth - 1 do + TagMask := TagMask or (1 shl I); + Result := CodedIndex and TagMask; +end; + +function TJclClrTable.GetCodedIndexValue(const CodedIndex, TagWidth: DWORD; + const WideIndex: Boolean): DWORD; +const + IndexBits: array [Boolean] of DWORD = (SizeOf(WORD) * 8, SizeOf(DWORD) * 8); +var + I, ValueMask: DWORD; +begin + ValueMask := 0; + for I := TagWidth to IndexBits[WideIndex] - 1 do + ValueMask := ValueMask or (1 shl I); + Result := (CodedIndex and ValueMask) shr TagWidth; +end; + +function TJclClrTable.DumpIL: string; +var + I: Integer; +begin + Result := '// Dump ' + ClassName + NativeLineBreak; + if Supports(ClassType, ITableCanDumpIL) then + for I := 0 to FRows.Count - 1 do + Result := Result + TJclClrTableRow(FRows[I]).DumpIL; +end; + +//=== { TJclClrTableStream } ================================================= + +constructor TJclClrTableStream.Create(const AMetadata: TJclPeMetadata; + AHeader: PClrStreamHeader); + + function BitCount(const Value: Int64): Integer; + var + AKind: TJclClrTableKind; + begin + Result := 0; + for AKind := Low(TJclClrTableKind) to High(TJclClrTableKind) do + if (Value and (Int64(1) shl Integer(AKind))) <> 0 then + Inc(Result); + end; + + procedure EnumTables; + var + AKind: TJclClrTableKind; + pTable: Pointer; + begin + pTable := @Header.Rows[BitCount(Header.Valid)]; + FTableCount := 0; + for AKind := Low(TJclClrTableKind) to High(TJclClrTableKind) do + begin + if (Header.Valid and (Int64(1) shl Integer(AKind))) <> 0 then + begin + FTables[AKind] := ValidTableMapping[AKind].Create(Self, pTable, Header.Rows[FTableCount]); + pTable := Pointer(TJclAddr(pTable) + FTables[AKind].Size); + Inc(FTableCount); + end + else + FTables[AKind] := nil; + end; + end; + +begin + inherited Create(AMetadata, AHeader); + FHeader := Data; + EnumTables; +end; + +destructor TJclClrTableStream.Destroy; +begin + inherited Destroy; +end; + +function TJclClrTableStream.GetVersionString: string; +begin + Result := FormatVersionString(Header.MajorVersion, Header.MinorVersion); +end; + +function TJclClrTableStream.GetTable(const AKind: TJclClrTableKind): TJclClrTable; +begin + Result := TJclClrTable(FTables[AKind]); +end; + +function TJclClrTableStream.GetBigHeap(const AHeapKind: TJclClrHeapKind): Boolean; +const + HeapSizesMapping: array [TJclClrHeapKind] of DWORD = (1, 2, 4); +begin + Result := (Header.HeapSizes and HeapSizesMapping[AHeapKind]) <> 0; +end; + +function TJclClrTableStream.FindTable(const AKind: TJclClrTableKind; + out ATable: TJclClrTable): Boolean; +begin + ATable := FTables[AKind]; + Result := Assigned(ATable); +end; + +procedure TJclClrTableStream.Update; +var + AKind: TJclClrTableKind; +begin + for AKind := Low(TJclClrTableKind) to High(TJclClrTableKind) do + if Assigned(FTables[AKind]) then + FTables[AKind].Update; +end; + +function TJclClrTableStream.DumpIL: string; +var + AKind: TJclClrTableKind; +begin + Result := ''; + for AKind := Low(TJclClrTableKind) to High(TJclClrTableKind) do + if Assigned(FTables[AKind]) then + Result := Result + FTables[AKind].DumpIL; +end; + +//=== { TJclPeMetadata } ===================================================== + +constructor TJclPeMetadata.Create(const AImage: TJclPeImage); + + function GetStreamClass(const Name: string): TJclClrStreamClass; + begin + if CompareText(Name, '#Strings') = 0 then + Result := TJclClrStringsStream + else + if CompareText(Name, '#GUID') = 0 then + Result := TJclClrGuidStream + else + if CompareText(Name, '#Blob') = 0 then + Result := TJclClrBlobStream + else + if CompareText(Name, '#US') = 0 then + Result := TJclClrUserStringStream + else + if CompareText(Name, '#~') = 0 then + Result := TJclClrTableStream + else + Result := TJclClrStream; + end; + + procedure UpdateStreams; + type + PStreamPartitionHeader = ^TStreamPartitionHeader; + TStreamPartitionHeader = packed record + Flags, + StreamCount: Word; + StreamHeaders: array [0..0] of TClrStreamHeader; + end; + var + pStreamPart: PStreamPartitionHeader; + pStream: PClrStreamHeader; + I: Integer; + TableStream: TJclClrTableStream; + begin + pStreamPart := PStreamPartitionHeader(TJclAddr(@Header.Version[0]) + Header.Length); + pStream := @pStreamPart.StreamHeaders[0]; + for I := 0 to pStreamPart.StreamCount - 1 do + begin + FStreams.Add(GetStreamClass(string(pStream.Name)).Create(Self, pStream)); + + pStream := PClrStreamHeader(TJclAddr(@pStream.Name[0]) + + TJclAddr(DWORD_PTR((StrLenA(PAnsiChar(@pStream.Name[0]) + 1 + 3) and not $3)))); + end; + if FindStream(TJclClrTableStream, TJclClrStream(TableStream)) then + TableStream.Update; + end; + +begin + Assert(AImage.IsClr and AImage.ClrHeader.HasMetadata); + inherited Create; + FImage := AImage; + with Image.ClrHeader.Header.MetaData do + begin + Assert(Size > SizeOf(FHeader^)); + FHeader := Image.RvaToVa(VirtualAddress); + Assert(not IsBadReadPtr(FHeader, Size)); + end; + + FStreams := TObjectList.Create; + UpdateStreams; + + FindStream(TJclClrStringsStream, TJclClrStream(FStringStream)); + FindStream(TJclClrGuidStream, TJclClrStream(FGuidStream)); + FindStream(TJclClrBlobStream, TJclClrStream(FBlobStream)); + FindStream(TJclClrUserStringStream, TJclClrStream(FUserStringStream)); + FindStream(TJclClrTableStream, TJclClrStream(FTableStream)); +end; + +destructor TJclPeMetadata.Destroy; +begin + FreeAndNil(FStreams); + inherited Destroy; +end; + +function TJclPeMetadata.GetVersionString: WideString; +var + VerStr: AnsiString; +begin + SetLength(VerStr, Header.Length+1); + StrLCopyA(PAnsiChar(VerStr), @Header.Version[0], Header.Length); + SetLength(VerStr, StrLenA(PAnsiChar(VerStr))); + Result := UTF8ToWideString(VerStr) +end; + +function TJclPeMetadata.GetVersion: string; +begin + Result := FormatVersionString(Header.MajorVersion, Header.MinorVersion); +end; + +function TJclPeMetadata.GetFlags: Word; +begin + Result := PWord(PAnsiChar(@Header.Version[0]) + (Header.Length + 3) and (not 3))^; +end; + +function TJclPeMetadata.GetStream(const Idx: Integer): TJclClrStream; +begin + Result := TJclClrStream(FStreams.Items[Idx]); +end; + +function TJclPeMetadata.GetStreamCount: Integer; +begin + Result := FStreams.Count; +end; + +function TJclPeMetadata.FindStream(const AName: string; + out Stream: TJclClrStream): Boolean; +var + I: Integer; +begin + for I := 0 to GetStreamCount - 1 do + begin + Stream := Streams[I]; + if CompareText(Stream.Name, AName) = 0 then + begin + Result := True; + Exit; + end; + end; + Result := False; + Stream := nil; +end; + +function TJclPeMetadata.FindStream(const AClass: TJclClrStreamClass; + out Stream: TJclClrStream): Boolean; +var + I: Integer; +begin + for I := 0 to GetStreamCount - 1 do + begin + Stream := Streams[I]; + if Stream.ClassType = AClass then + begin + Result := True; + Exit; + end; + end; + Result := False; + Stream := nil; +end; + +function TJclPeMetadata.GetToken(const AToken: TJclClrToken): TJclClrTableRow; +begin + if AToken = 0 then + Result := nil + else + try + Result := Tables[TokenTable(AToken)].Rows[TokenIndex(AToken) - 1]; + except + Result := nil; + end; +end; + +function TJclPeMetadata.GetString(const Idx: Integer): WideString; +begin + if Assigned(FStringStream) or + FindStream(TJclClrStringsStream, TJclClrStream(FStringStream)) then + Result := FStringStream.Strings[Idx] + else + Result := ''; +end; + +function TJclPeMetadata.GetStringCount: Integer; +begin + if Assigned(FStringStream) or + FindStream(TJclClrStringsStream, TJclClrStream(FStringStream)) then + Result := FStringStream.StringCount + else + Result := 0; +end; + +function TJclPeMetadata.UserGetString(const Idx: Integer): WideString; +begin + if Assigned(FUserStringStream) or + FindStream(TJclClrUserStringStream, TJclClrStream(FUserStringStream)) then + Result := FUserStringStream.Strings[Idx - 1] + else + Result := ''; +end; + +function TJclPeMetadata.UserGetStringCount: Integer; +begin + if Assigned(FUserStringStream) or + FindStream(TJclClrUserStringStream, TJclClrStream(FUserStringStream)) then + Result := FUserStringStream.StringCount + else + Result := 0; +end; + +function TJclPeMetadata.StringAt(const Offset: DWORD): WideString; +begin + if Assigned(FStringStream) or + FindStream(TJclClrStringsStream, TJclClrStream(FStringStream)) then + Result := FStringStream.At(Offset) + else + Result := ''; +end; + +function TJclPeMetadata.UserStringAt(const Offset: DWORD): WideString; +begin + if Assigned(FUserStringStream) or + FindStream(TJclClrUserStringStream, TJclClrStream(FUserStringStream)) then + Result := TJclClrUserStringStream(FUserStringStream).At(Offset) + else + Result := ''; +end; + +function TJclPeMetadata.BlobAt(const Offset: DWORD): TJclClrBlobRecord; +begin + if Assigned(FBlobStream) or + FindStream(TJclClrBlobStream, TJclClrStream(FBlobStream)) then + Result := TJclClrBlobStream(FBlobStream).At(Offset) + else + Result := nil; +end; + +function TJclPeMetadata.GetGuid(const Idx: Integer): TGUID; +begin + if Assigned(FGuidStream) or + FindStream(TJclClrGuidStream, TJclClrStream(FGuidStream)) then + Result := FGuidStream.Guids[Idx] + else + Result := GUID_NULL; +end; + +function TJclPeMetadata.GetGuidCount: Integer; +begin + if Assigned(FGuidStream) or + FindStream(TJclClrGuidStream, TJclClrStream(FGuidStream)) then + Result := FGuidStream.GuidCount + else + Result := 0; +end; + +function TJclPeMetadata.GetBlob(const Idx: Integer): TJclClrBlobRecord; +begin + if Assigned(FBlobStream) or + FindStream(TJclClrBlobStream, TJclClrStream(FBlobStream)) then + Result := FBlobStream.Blobs[Idx] + else + Result := nil; +end; + +function TJclPeMetadata.GetBlobCount: Integer; +begin + if Assigned(FBlobStream) or + FindStream(TJclClrBlobStream, TJclClrStream(FBlobStream)) then + Result := FBlobStream.BlobCount + else + Result := 0; +end; + +function TJclPeMetadata.GetTable(const AKind: TJclClrTableKind): TJclClrTable; +begin + if Assigned(FTableStream) or + FindStream(TJclClrTableStream, TJclClrStream(FTableStream)) then + Result := FTableStream.Tables[AKind] + else + Result := nil; +end; + +function TJclPeMetadata.GetTableCount: Integer; +begin + if Assigned(FTableStream) or + FindStream(TJclClrTableStream, TJclClrStream(FTableStream)) then + Result := FTableStream.TableCount + else + Result := 0; +end; + +function TJclPeMetadata.TokenExists(const Token: TJclClrToken): Boolean; +begin + Result := TokenIndex(Token) in [1..Tables[TokenTable(Token)].RowCount]; +end; + +class function TJclPeMetadata.TokenTable(const Token: TJclClrToken): TJclClrTableKind; +begin + Result := TJclClrTableKind(Token shr 24); +end; + +class function TJclPeMetadata.TokenIndex(const Token: TJclClrToken): Integer; +begin + Result := Token and DWORD($FFFFFF); +end; + +class function TJclPeMetadata.TokenCode(const Token: TJclClrToken): Integer; +begin + Result := Token and $FF000000; +end; + +class function TJclPeMetadata.MakeToken(const Table: TJclClrTableKind; + const Idx: Integer): TJclClrToken; +begin + Result := (DWORD(Table) shl 24) and TokenIndex(Idx); +end; + +function TJclPeMetadata.DumpIL: string; +begin + with TStringList.Create do + try + case Image.Target of + taWin32: + begin + Add(Format('.imagebase 0x%.8x', [Image.OptionalHeader32.ImageBase])); + Add(Format('.subsystem 0x%.8x', [Image.OptionalHeader32.SubSystem])); + Add(Format('.file alignment %d', [Image.OptionalHeader32.FileAlignment])); + end; + taWin64: + begin + Add(Format('.imagebase 0x%.16x', [Image.OptionalHeader64.ImageBase])); + Add(Format('.subsystem 0x%.8x', [Image.OptionalHeader64.SubSystem])); + Add(Format('.file alignment %d', [Image.OptionalHeader64.FileAlignment])); + end; + //taUnknown: ; + end; + + if Assigned(FTableStream) then + begin + FTableStream.Update; + Result := Text + NativeLineBreak + FTableStream.DumpIL; + end; + finally + Free; + end; +end; + +//=== { TJclClrResourceRecord } ============================================== + +constructor TJclClrResourceRecord.Create(const AData: PAnsiChar; + const AOffset: DWORD; const ARVA: DWORD); +begin + FData := AData; + FOffset := AOffset; + FRVA := ARVA; + inherited Create(Pointer(TJclAddr(Data) + SizeOf(DWORD)), PDWORD(Data)^); +end; + +//=== { TJclClrVTableFixupRecord } =========================================== + +constructor TJclClrVTableFixupRecord.Create(AData: PImageCorVTableFixup); +begin + inherited Create; + FData := AData; +end; + +function TJclClrVTableFixupRecord.GetCount: DWORD; +begin + Result := Data.Count; +end; + +function TJclClrVTableFixupRecord.GetKinds: TJclClrVTableKinds; +begin + Result := VTableKinds(Data.Kind); +end; + +function TJclClrVTableFixupRecord.GetRVA: DWORD; +begin + Result := Data.RVA; +end; + +class function TJclClrVTableFixupRecord.VTableKinds(const Kinds: TJclClrVTableKinds): DWORD; +var + AKind: TJclClrVTableKind; +begin + Result := 0; + for AKind := Low(TJclClrVTableKind) to High(TJclClrVTableKind) do + if AKind in Kinds then + Result := Result or ClrVTableKindMapping[AKind]; +end; + +class function TJclClrVTableFixupRecord.VTableKinds(const Kinds: DWORD): TJclClrVTableKinds; +var + AKind: TJclClrVTableKind; +begin + Result := []; + for AKind := Low(TJclClrVTableKind) to High(TJclClrVTableKind) do + if (ClrVTableKindMapping[AKind] and Kinds) = ClrVTableKindMapping[AKind] then + Include(Result, AKind); +end; + +//=== { TJclClrInformation } ================================================= + +constructor TJclClrHeaderEx.Create(const AImage: TJclPeImage); + + procedure UpdateVTableFixups; + begin + // (rom) What is this? + if Header.VTableFixups.VirtualAddress = 0 then + end; + +begin + inherited Create(AImage); + FFlags := ClrImageFlag(Header.Flags); + FMetadata := nil; + FResources := nil; + FStrongNameSignature := nil; + FVTableFixups := nil; +end; + +destructor TJclClrHeaderEx.Destroy; +begin + FreeAndNil(FVTableFixups); + FreeAndNil(FStrongNameSignature); + FreeAndNil(FResources); + FreeAndNil(FMetadata); + inherited Destroy; +end; + +class function TJclClrHeaderEx.ClrImageFlag(const Flags: DWORD): TJclClrImageFlags; +var + AFlag: TJclClrImageFlag; +begin + Result := []; + for AFlag := Low(TJclClrImageFlag) to High(TJclClrImageFlag) do + if (ClrImageFlagMapping[AFlag] and Flags) = ClrImageFlagMapping[AFlag] then + Include(Result, AFlag); +end; + +class function TJclClrHeaderEx.ClrImageFlag(const Flags: TJclClrImageFlags): DWORD; +var + AFlag: TJclClrImageFlag; +begin + Result := 0; + for AFlag := Low(TJclClrImageFlag) to High(TJclClrImageFlag) do + if AFlag in Flags then + Result := Result or ClrImageFlagMapping[AFlag]; +end; + +function TJclClrHeaderEx.GetMetadata: TJclPeMetadata; +begin + if not Assigned(FMetadata) and HasMetadata then + FMetadata := TJclPeMetadata.Create(Image); + Result := FMetadata; +end; + +function TJclClrHeaderEx.HasStrongNameSignature: Boolean; +begin + with Header.StrongNameSignature do + Result := Assigned(FStrongNameSignature) or + ((Size > 0) and not IsBadReadPtr(Image.RvaToVa(VirtualAddress), Size)); +end; + +function TJclClrHeaderEx.HasVTableFixup: Boolean; +begin + with Header.VTableFixups do + Result := Assigned(FVTableFixups) or + ((Size > 0) and not IsBadReadPtr(Image.RvaToVa(VirtualAddress), Size)); +end; + +function TJclClrHeaderEx.GetStrongNameSignature: TCustomMemoryStream; +begin + if not Assigned(FStrongNameSignature) and HasStrongNameSignature then + with Header.StrongNameSignature do + FStrongNameSignature := TJClreferenceMemoryStream.Create(Image.RvaToVa(VirtualAddress), Size); + Result := FStrongNameSignature; +end; + +function TJclClrHeaderEx.HasResources: Boolean; +begin + with Header.Resources do + Result := Assigned(FResources) or + ((Size > 0) and not IsBadReadPtr(Image.RvaToVa(VirtualAddress), Size)); +end; + +procedure TJclClrHeaderEx.UpdateResources; +var + Base, Ptr, MappedBase: PAnsiChar; + ARes: TJclClrResourceRecord; +begin + FResources := TObjectList.Create; + with Header.Resources do + begin + Base := Image.RvaToVa(VirtualAddress); + Ptr := Base; + while DWORD(Ptr - Base) < Size do + begin + MappedBase := PAnsiChar(Image.LoadedImage.MappedAddress); + ARes := TJclClrResourceRecord.Create(Ptr, Ptr - Base, Ptr - MappedBase); + FResources.Add(ARes); + Ptr := PAnsiChar(ARes.Memory) + ARes.Size; + end; + end; +end; + +function TJclClrHeaderEx.GetResource( + const Idx: Integer): TJclClrResourceRecord; +begin + if not Assigned(FResources) and HasResources then + UpdateResources; + Result := TJclClrResourceRecord(FResources.Items[Idx]); +end; + +function TJclClrHeaderEx.GetResourceCount: Integer; +begin + if not Assigned(FResources) and HasResources then + UpdateResources; + if Assigned(FResources) then + Result := FResources.Count + else + Result := 0; +end; + +function TJclClrHeaderEx.GetEntryPointToken: TJclClrTableRow; +begin + Result := Metadata.Tokens[Header.EntryPointToken] +end; + +function TJclClrHeaderEx.GetVTableFixup( + const Idx: Integer): TJclClrVTableFixupRecord; +var + I: Integer; + pData: PImageCorVTableFixup; +begin + if not Assigned(FVTableFixups) and HasVTableFixup then + begin + FVTableFixups := TObjectList.Create; + with Header.VTableFixups do + begin + pData := PImageCorVTableFixup(Image.RvaToVa(VirtualAddress)); + for I := 0 to GetVTableFixupCount - 1 do + begin + FVTableFixups.Add(TJclClrVTableFixupRecord.Create(pData)); + Inc(pData); + end; + end; + end; + Result := TJclClrVTableFixupRecord(FVTableFixups.Items[Idx]); +end; + +function TJclClrHeaderEx.GetVTableFixupCount: Integer; +begin + Result := Header.VTableFixups.Size div SizeOf(TImageCorVTableFixup); +end; + +function TJclClrHeaderEx.ResourceAt(const Offset: DWORD): TJclClrResourceRecord; +var + I: Integer; +begin + if HasResources then + for I := 0 to ResourceCount - 1 do + begin + Result := Resources[I]; + if Result.Offset = Offset then + Exit; + end; + Result := nil; +end; + +function TJclClrHeaderEx.DumpIL: string; +begin + with TStringList.Create do + try + Add(LoadResString(@RsClrCopyright)); + Add(Format('.corflags 0x%.8x', [Header.Flags])); + Result := Text + NativeLineBreak + Metadata.DumpIL; + finally + Free; + end; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/JclCOM.pas b/3rdParty/JCL/source/windows/JclCOM.pas new file mode 100644 index 00000000..e2a1d88c --- /dev/null +++ b/3rdParty/JCL/source/windows/JclCOM.pas @@ -0,0 +1,686 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclCOM.pas. } +{ } +{ The Initial Developer of the Original Code is Kevin S. Gallagher. Portions created by Kevin S. } +{ Gallagher are Copyright (C) Kevin S. Gallagher. All Rights Reserved. } +{ } +{ Contributors: } +{ Marcel van Brakel } +{ Robert Marquardt (marquardt) } +{ Scott Price (scottprice) } +{ Robert Rossmair (rrossmair) } +{ Olivier Sannier (obones) } +{ Petr Vones (pvones) } +{ } +{**************************************************************************************************} +{ } +{ This unit contains Various COM (Component Object Model) utility routines. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclCOM; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, Winapi.ActiveX, System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Windows, ActiveX, Classes, + {$ENDIF ~HAS_UNITSCOPE} + JclBase; + +// Various definitions +const + { Class ID's that may be reused } + CLSID_StdComponentCategoriesMgr: TGUID = '{0002E005-0000-0000-C000-000000000046}'; + + CATID_SafeForInitializing: TGUID = '{7DD95802-9882-11CF-9FA9-00AA006C42C4}'; + CATID_SafeForScripting: TGUID = '{7DD95801-9882-11CF-9FA9-00AA006C42C4}'; + + icMAX_CATEGORY_DESC_LEN = 128; + +type + { For use with the Internet Explorer Component Categories Routines. May be Reused. } + TArrayCatID = array [0..0] of TGUID; + +// Exception classes +type + EInvalidParam = class(EJclError); + +// DCOM and MDAC Related Tests and Utility Routines +function IsDCOMInstalled: Boolean; +function IsDCOMEnabled: Boolean; +function GetDCOMVersion: string; +function GetMDACVersion: string; + +// Other Marshalling Routines to complement "CoMarshalInterThreadInterfaceInStream" +{ These routines will provide the ability to marshal an interface for a separate + process or even for access by a separate machine. However, to make things + familiar to users of the existing CoMarshal... routine, I have kept the required + parameters the same, apart from the "stm" type now being a Var rather than just + an Out - to allow a little flexibility if the developer wants the destination + to be a specific stream, otherwise it creates one into the passed variable! } + +function MarshalInterThreadInterfaceInVarArray(const iid: TIID; + unk: IUnknown; var VarArray: OleVariant): HRESULT; +function MarshalInterProcessInterfaceInStream(const iid: TIID; + unk: IUnknown; var stm: IStream): HRESULT; +function MarshalInterProcessInterfaceInVarArray(const iid: TIID; + unk: IUnknown; var VarArray: OleVariant): HRESULT; +function MarshalInterMachineInterfaceInStream(const iid: TIID; + unk: IUnknown; var stm: IStream): HRESULT; +function MarshalInterMachineInterfaceInVarArray(const iid: TIID; + unk: IUnknown; var VarArray: OleVariant): HRESULT; + +// Internet Explorer Component Categories Routines +{ These routines help with the registration of: + - Safe-Initialization & + - Safe-for-Scripting + of ActiveX controls or COM Automation Servers intended to be used in + HTML pages displayed in Internet Explorer } +{ Conversion of an example found in Microsoft Development Network document: + MSDN Home > MSDN Library > ActiveX Controls > Overviews/Tutorials + Safe Initialization and Scripting for ActiveX Controls } + +function CreateComponentCategory(const CatID: TGUID; const sDescription: string): HRESULT; +function RegisterCLSIDInCategory(const ClassID: TGUID; const CatID: TGUID): HRESULT; +function UnRegisterCLSIDInCategory(const ClassID: TGUID; const CatID: TGUID): HRESULT; + +// Stream Related Routines +{ IDE ISSUE: These need to be at the bottom of the interface definition as otherwise + the CTRL+SHIFT+ Up/Down arrows feature no-longer operates } + +function ResetIStreamToStart(Stream: IStream): Boolean; +function SizeOfIStreamContents(Stream: IStream): Largeint; + +{ Use VarIsEmpty to determine the result of the following XStreamToVariantArray routines! + VarIsEmptry will return True if VarClear was called - indicating major problem! } + +function StreamToVariantArray(Stream: TStream): OleVariant; overload; +function StreamToVariantArray(Stream: IStream): OleVariant; overload; + +procedure VariantArrayToStream(VarArray: OleVariant; var Stream: TStream); overload; +procedure VariantArrayToStream(VarArray: OleVariant; var Stream: IStream); overload; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF FPC} + Types, + {$ENDIF FPC} + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, System.Variants, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, Variants, + {$ENDIF ~HAS_UNITSCOPE} + JclFileUtils, JclRegistry, JclResources, JclSysInfo, JclWin32; + +{implementation Constants - may be reused by more than one routine } + +const + pcOLE32 = 'OLE32.dll'; + + { TODO : Utility routine here might need to be re-vamped with the + use of JclUnicode unit in mind. } + +function StringToWideString(const Str: string): WideString; +var + iLen: Integer; +begin + iLen:= Length(Str) + 1; + SetLength(Result, (iLen - 1)); + StringToWideChar(Str, PWideChar(Result), iLen); +end; + +//=== DCOM and MDAC Related Tests and Utility Routines ======================= + +function IsDCOMInstalled: Boolean; +var + OLE32: HMODULE; +begin + { DCOM is installed by default on all but Windows 95 } + Result := not (GetWindowsVersion in [wvWin95, wvWin95OSR2]); + if not Result then + begin + OLE32 := SafeLoadLibrary(pcOLE32); + if OLE32 <> 0 then + try + Result := GetProcAddress(OLE32, PChar('CoCreateInstanceEx')) <> nil; + finally + FreeLibrary(OLE32); + end; + end; +end; + +function IsDCOMEnabled: Boolean; +var + RegValue: string; +begin + RegValue := RegReadString(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\OLE', 'EnableDCOM'); + Result := (RegValue = 'y') or (RegValue = 'Y'); +end; + +function GetDCOMVersion: string; +const + DCOMVersionKey: PChar = 'CLSID\{bdc67890-4fc0-11d0-a805-00aa006d2ea4}\InstalledVersion'; +begin + { NOTE: This does not work on Windows NT/2000! For a list of DCOM versions: + http://support.microsoft.com/support/kb/articles/Q235/6/38.ASP } + Result := ''; + if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and IsDCOMEnabled then + Result := RegReadString(HKEY_CLASSES_ROOT, DCOMVersionKey, '') + else + { Possibly from DComExt.dll ‘Product Version’ } + Result := 'DCOM Version Unknown'; +end; + +{ NOTE: Checking whether MDAC is installed at all can be done by querying the + Software\Microsoft\DataAccess key for the FullInstallVer or + Fill32InstallVer values. Windows 2000 always installs MDAC 2.5 } + +function GetMDACVersion: string; +var + Key: string; + DLL: string; + Version: TJclFileVersionInfo; +begin + Result := '' ; + Key := RegReadString(HKEY_CLASSES_ROOT, 'ADODB.Connection\CLSID', ''); + DLL := RegReadString(HKEY_CLASSES_ROOT, 'CLSID\' + Key + '\InprocServer32', ''); + if VersionResourceAvailable(DLL) then + begin + Version := TJclFileVersionInfo.Create(DLL); + try + Result := Version.ProductVersion; + finally + FreeAndNil(Version); + end; + end; +end; + +// Other Marshalling Routines to complement "CoMarshalInterThreadInterfaceInStream" + +function MarshalInterThreadInterfaceInVarArray(const iid: TIID; unk: IUnknown; + var VarArray: OleVariant): HRESULT; +var + msData: TMemoryStream; + itfStream: IStream; +begin + { TODO -cTest : D4, D5, D6 (CBx ??) } + try + { Will need a stream to obtain the data initially before creating the Variant Array } + msData := TMemoryStream.Create; + + itfStream := (TStreamAdapter.Create(msData, soOwned) as IStream); + + { Probably would never get here in such a condition, but just in case } + if itfStream = nil then + begin + Result := E_OUTOFMEMORY; + Exit; + end; + + if itfStream <> nil then + begin + { Different Machine } + Result := CoMarshalInterThreadInterfaceInStream(iid, unk, itfStream); + + if Result <> S_OK then + Exit; + + VarArray := StreamToVariantArray(itfStream); + + if VarIsNull(VarArray) or VarIsEmpty(VarArray) then + Result := E_FAIL; + end + else + { TODO : Most likely out of memory, though should not reach here } + Result := E_POINTER; + except + Result := E_UNEXPECTED; + end; +end; + +function MarshalInterProcessInterfaceInStream(const iid: TIID; unk: IUnknown; + var stm: IStream): HRESULT; +var + msData: TMemoryStream; +begin + { TODO -cTest : D4 (CBx ??) } + try + { If passed a variable which doesn't contain a valid stream, create and return } + if stm = nil then + begin + msData := TMemoryStream.Create; + + stm := (TStreamAdapter.Create(msData, soOwned) as IStream); + + { Probably would never get here in such a condition, but just in case } + if stm = nil then + begin + Result := E_OUTOFMEMORY; + Exit; + end; + end + else + ResetIStreamToStart(stm); + + if stm <> nil then + { Same Machine, Different Process} + Result := CoMarshalInterface(stm, iid, unk, MSHCTX_LOCAL, nil, MSHLFLAGS_NORMAL) + else + { TODO : Most likely out of memory, though should not reach here } + Result := E_POINTER; + except + Result := E_UNEXPECTED; + end; +end; + +function MarshalInterProcessInterfaceInVarArray(const iid: TIID; + unk: IUnknown; var VarArray: OleVariant): HRESULT; +var + itfStream: IStream; +begin + { TODO -cTest : D4 (CBx ??) } + itfStream := nil; + Result := MarshalInterProcessInterfaceInStream(iid, unk, itfStream); + + if Result <> S_OK then + Exit; + + { TODO : Add compiler support for using a VCL Stream instead of an IStream here } + { Otherwise convert from IStream into Variant Array } + VarArray := StreamToVariantArray(itfStream); + + if VarIsNull(VarArray) or VarIsEmpty(VarArray) then + Result := E_FAIL; +end; + +function MarshalInterMachineInterfaceInStream(const iid: TIID; unk: IUnknown; + var stm: IStream): HRESULT; +var + msData: TMemoryStream; +begin + { TODO -cTest : D4 (CBx ??) Have no need for it myself at present. } + try + { If passed a variable which doesn't contain a valid stream, create and return } + if stm = nil then + begin + msData := TMemoryStream.Create; + + stm := (TStreamAdapter.Create(msData, soOwned) as IStream); + + { Probably would never get here in such a condition, but just in case } + if stm = nil then + begin + Result := E_OUTOFMEMORY; + Exit; + end; + end + else + ResetIStreamToStart(stm); + + if stm <> nil then + { Different Machine } + Result := CoMarshalInterface(stm, iid, unk, MSHCTX_DIFFERENTMACHINE, nil, MSHLFLAGS_NORMAL) + else + { TODO : Most likely out of memory, though should not reach here } + Result := E_POINTER; + except + Result := E_UNEXPECTED; + end; +end; + +function MarshalInterMachineInterfaceInVarArray(const iid: TIID; unk: IUnknown; + var VarArray: OleVariant): HRESULT; +var + itfStream: IStream; +begin + { TODO -cTest : D4 (CBx ??) } + itfStream := nil; + Result := MarshalInterMachineInterfaceInStream(iid, unk, itfStream); + + if Result <> S_OK then + Exit; + + { TODO : Add compiler support for using a VCL Stream instead of an IStream here } + { Otherwise convert from IStream into Variant Array } + VarArray := StreamToVariantArray(itfStream); + + if VarIsNull(VarArray) or VarIsEmpty(VarArray) then + Result := E_FAIL; +end; + +//=== Internet Explorer Component Categories Routines ======================== + +function CreateComponentCategory(const CatID: TGUID; const sDescription: string): HRESULT; +var + CatRegister: ICatRegister; + hr: HRESULT; + CatInfo: TCATEGORYINFO; + iLen: Integer; + sTemp: string; + wsTemp: WideString; +begin + { TODO -cTest : D4 (CBx ??) } + CatRegister := nil; + + hr := CoCreateInstance(CLSID_StdComponentCategoriesMgr, + nil, CLSCTX_INPROC_SERVER, ICatRegister, CatRegister); + + if Succeeded(hr) then + try + (* Make sure the: + HKCR\Component Categories\{..catid...} + key is registered *) + CatInfo.catid := CatID; + CatInfo.lcid := MAKELANGID(LANG_ENGLISH, SUBLANG_ENGLISH_US); // english + + { Make sure the provided description is not too long. + Only copy the first 127 characters if it is. } + iLen := Length(sDescription); + if iLen > icMAX_CATEGORY_DESC_LEN then + iLen := icMAX_CATEGORY_DESC_LEN; + + sTemp := Copy(sDescription, 1, iLen); + wsTemp := StringToWideString(sTemp); + + Move(Pointer(wsTemp)^, CatInfo.szDescription, (iLen * SizeOf(WideChar))); + + hr := CatRegister.RegisterCategories(1, @CatInfo); + finally + CatRegister := nil; + end; + + { Return the appropriate Result } + Result := hr; +end; + +function RegisterCLSIDInCategory(const ClassID: TGUID; const CatID: TGUID): HRESULT; +var + CatRegister: ICatRegister; + hr: HRESULT; + arCatID: TArrayCatID; +begin + { TODO -cTest : D4 (CBx ??) } + { Register your component categories information } + CatRegister := nil; + hr := CoCreateInstance(CLSID_StdComponentCategoriesMgr, + nil, CLSCTX_INPROC_SERVER, ICatRegister, CatRegister); + + if Succeeded(hr) then + try + { Register this category as being "implemented" by the class } + arCatID[0] := CatID; + hr := CatRegister.RegisterClassImplCategories(ClassID, 1, @arCatID); + finally + CatRegister := nil; + end; + + { Return the appropriate Result } + Result := hr; +end; + +function UnRegisterCLSIDInCategory(const ClassID: TGUID; const CatID: TGUID): HRESULT; +var + CatRegister: ICatRegister; + hr: HRESULT; + arCatID: TArrayCatID; +begin + { TODO -cTest : D4 (CBx ??) } + CatRegister := nil; + + hr := CoCreateInstance(CLSID_StdComponentCategoriesMgr, + nil, CLSCTX_INPROC_SERVER, ICatRegister, CatRegister); + + if Succeeded(hr) then + try + { Unregister this category as being "implemented" by the class } + arCatID[0] := CatID; + hr := CatRegister.UnRegisterClassImplCategories(ClassID, 1, @arCatID); + finally + CatRegister := nil; + end; + + { Return the appropriate Result } + Result := hr; +end; + +//=== Stream Related Routines ================================================ + +function ResetIStreamToStart(Stream: IStream): Boolean; +var + i64Pos: {$IFDEF RTL290_UP}LargeUInt{$ELSE}Largeint{$ENDIF RTL290_UP}; + hrSeek: HRESULT; +begin + { TODO -cTest : D4 (CBx ??) } + { Try to get the current stream position, and reset to start if not already there } + if Succeeded(Stream.Seek(0, STREAM_SEEK_CUR, i64Pos)) then + begin + if i64Pos = 0 then + hrSeek := S_OK + else + hrSeek := Stream.Seek(0, STREAM_SEEK_SET, i64Pos); + { Another possible option was seen as: + - Stream.Seek(0, STREAM_SEEK_SET, NULL); } + + Result := (hrSeek = S_OK); + end + else + Result := False; +end; + +function SizeOfIStreamContents(Stream: IStream): Largeint; +var + stat: TStatStg; +begin + { TODO -cTest : D4 (CBx ??) } + { If we can't determine the size of the Stream, then return -1 for Unattainable } + if Succeeded(Stream.Stat(stat, STATFLAG_NONAME)) then + Result := stat.cbSize + else + Result := -1; +end; + +function StreamToVariantArray(Stream: TStream): OleVariant; +var + pLocked: Pointer; +begin + { Use VarIsEmpty to determine the result of this method! + VarIsEmptry will return True if VarClear was called - indicating major problem! } + + { TODO -cTest : D4 (CBx ??) } + { Obviously, we must have a valid stream to perform this on } + if not Assigned(Stream) then + raise EInvalidParam.CreateRes(@RsComInvalidParam); + + if Stream.Size > 0 then + begin + Result := VarArrayCreate([0, Stream.Size - 1], varByte); + try + pLocked := VarArrayLock(Result); + try + Stream.Position := 0; + Stream.Read(pLocked^, Stream.Size); + finally + VarArrayUnlock(Result); + end; + except + { If we get an exception, clean up the Variant so as not to return incomplete data! } + VarClear(Result); + + { Alternative: Re-Raise this Exception + raise; } + end; + end + else + { Stream has no data! } + Result := Null; +end; + +function StreamToVariantArray(Stream: IStream): OleVariant; +var + pLocked: Pointer; + iSize: Largeint; + iReadCount: LongInt; +begin + { Use VarIsEmpty to determine the result of this method! + VarIsEmptry will return True if VarClear was called - indicating major problem! } + + { TODO -cTest : D4 (CBx ??) } + { Obviously, we must have a valid stream to perform this on } + if not Assigned(Stream) then + raise EInvalidParam.CreateRes(@RsComInvalidParam); + + iSize := SizeOfIStreamContents(Stream); + if iSize > 0 then + begin + if ResetIStreamToStart(Stream) then + begin + Result := VarArrayCreate([0, iSize - 1], varByte); + try + pLocked := VarArrayLock(Result); + try + Stream.Read(pLocked, iSize, @iReadCount); + + if iReadCount <> iSize then + { Error! Didn't read all content! } + raise EInOutError.CreateRes(@RsComFailedStreamRead); + finally + VarArrayUnlock(Result); + end; + except + { If we get an exception, clean up the Variant so as not to return incomplete data! } + VarClear(Result); + + { Alternative: Re-Raise this Exception + raise; } + end; + end + else + { Unable to Reset the Stream to Start! Return Null Variant } + Result := Null; + end + else + { Stream has no data! } + Result := Null; +end; + +procedure VariantArrayToStream(VarArray: OleVariant; var Stream: TStream); +var + pLocked: Pointer; +begin + { TODO -cTest : D4 (CBx ??) } + { Check if the Variant is Empty or Null } + if VarIsEmpty(VarArray) or VarIsNull(VarArray) then + raise EInvalidParam.CreateRes(@RsComInvalidParam); + + { TODO : Should we allow them to write to the Stream, not matter what position it is at? } + if Assigned(Stream) then + Stream.Position := 0 + else + Stream := TMemoryStream.Create; + + Stream.Size := VarArrayHighBound(VarArray, 1) - VarArrayLowBound(VarArray, 1) + 1; + pLocked := VarArrayLock(VarArray); + try + Stream.Write(pLocked^, Stream.Size); + finally + VarArrayUnlock(VarArray); + Stream.Position := 0; + end; +end; + +procedure VariantArrayToStream(VarArray: OleVariant; var Stream: IStream); +var + pLocked: Pointer; + bCreated: Boolean; + iSize: Largeint; + iWriteCount: LongInt; +begin + { TODO -cTest : D4 (CBx ??) } + { Check if the Variant is Empty or Null } + if VarIsEmpty(VarArray) or VarIsNull(VarArray) then + raise EInvalidParam.CreateRes(@RsComInvalidParam); + + bCreated := False; + + { TODO : Should we allow them to write to the Stream, not matter what position it is at? } + if Assigned(Stream) then + ResetIStreamToStart(Stream) + else + begin + Stream := (TStreamAdapter.Create(TMemoryStream.Create, soOwned) as IStream); + bCreated := True; + end; + + { Check to ensure creation went well, otherwise we might have run out of memory } + if Stream <> nil then + begin + iSize := VarArrayHighBound(VarArray, 1) - VarArrayLowBound(VarArray, 1) + 1; + try + Stream.SetSize(iSize); + pLocked := VarArrayLock(VarArray); + try + Stream.Write(pLocked, iSize, @iWriteCount); + + if iWriteCount <> iSize then + raise EInOutError.CreateRes(@RsComFailedStreamWrite); + finally + VarArrayUnlock(VarArray); + ResetIStreamToStart(Stream); + end; + except + if bCreated then + Stream := nil; + + raise; { Re-Raise this Exception } + end; + end; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/JclCommCtrlAdmin.manifest b/3rdParty/JCL/source/windows/JclCommCtrlAdmin.manifest new file mode 100644 index 00000000..e33eccb1 --- /dev/null +++ b/3rdParty/JCL/source/windows/JclCommCtrlAdmin.manifest @@ -0,0 +1,28 @@ + + + + + + + + + + + + + + + + diff --git a/3rdParty/JCL/source/windows/JclCommCtrlAdmin.rc b/3rdParty/JCL/source/windows/JclCommCtrlAdmin.rc new file mode 100644 index 00000000..96c8fd46 --- /dev/null +++ b/3rdParty/JCL/source/windows/JclCommCtrlAdmin.rc @@ -0,0 +1,7 @@ +/**************************************************************************************************** + + VistaElevate.rc + +****************************************************************************************************/ + +LANGUAGE 0,0 1 24 "JclCommCtrlAdmin.manifest" diff --git a/3rdParty/JCL/source/windows/JclCommCtrlAdmin.res b/3rdParty/JCL/source/windows/JclCommCtrlAdmin.res new file mode 100644 index 0000000000000000000000000000000000000000..8c2150e46b0175766b029109a84409d8f98f8f24 GIT binary patch literal 920 zcma)5O;6k~5KYxvrQUnAd_>x0Kf;Qlq-eFJ(o&E((9)~dnJiZQvGq6$`So-{J_ssE zO=Ky4Z#?tfcoIcX#ArP}wu?SrJh$(A{u9N#d*Y^}i0tgaXm$XP%GsRH;wfifr7M)( z<^0FZx5)`-7=$f^b{2A81M;&kA3tOQ5zJQCj1pMPdFAaX$~!OuCq_x{(3N2#ojDa~ z;=_zHBdjU`!_RRwO2ycaY*T;@D%1_gSg7|@@m|@*oVSP-hLDT%uN$^@1+YuC^}^R3 zJJ^`VX*`Y7#k@ba_f7($^D8g!Q~((&Pl}LmPnvoptU9M1@uu9@ zB{yg*`>O9se5-8X?lE3FW1O9=oekb;>})hA1}jT4Lhp#$S6i**cc^dNZ=gF{9)CXG zF4I|>N?Fc|aulkC-Bn^oPLD?D8_hWCT0#Dj*S$aEU6-=pD-0W3y8oPl1@F6yAS+Kd z{oGU!e=3>|D6YLaC=ENnfh0`>ef~g41C8q?96+~o(X@;)-2gdnB9(_#VU$%Eya>*Z p>@!xWm2Ac#=cUjHgYPCsmJEgd(UB!DRA + + + + + + + + + + + + + + + diff --git a/3rdParty/JCL/source/windows/JclCommCtrlAsInvoker.rc b/3rdParty/JCL/source/windows/JclCommCtrlAsInvoker.rc new file mode 100644 index 00000000..c634d4b4 --- /dev/null +++ b/3rdParty/JCL/source/windows/JclCommCtrlAsInvoker.rc @@ -0,0 +1,7 @@ +/**************************************************************************************************** + + VistaElevate.rc + +****************************************************************************************************/ + +LANGUAGE 0,0 1 24 "JclCommCtrlAsInvoker.manifest" diff --git a/3rdParty/JCL/source/windows/JclCommCtrlAsInvoker.res b/3rdParty/JCL/source/windows/JclCommCtrlAsInvoker.res new file mode 100644 index 0000000000000000000000000000000000000000..f64f1ec430200aa016cb2919d2f61fd62d17c891 GIT binary patch literal 908 zcma)5OKaRP5Z=;Tq4yqzj)ArJ;Vfye8j84LB1I^HU~T<{jL!VvQH^7EE$Tn=of_Fnk9 ziw-gtQ4-CfWVz_`j^0T?bbjsSjS3(`>8a4~vlWk9200wTQg>ND?1@v4gmtI13%pAA zWy%fO(*EAN68%y(cefaAoH5Q$H_is{Gu;jhF2(t8a z(~qWl_*>F+Kz`*_r8FD>hahnp!k2fH8faX1P=RjeqOpuI-2fRExV05|<42kqE7e*y iGm!B@XoNv*lbFUs^=Hk~_zBfC9yAlXH12-`+WZ5qg9YmV literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/JclConsole.pas b/3rdParty/JCL/source/windows/JclConsole.pas index 28d14a47..8dfa8e30 100644 --- a/3rdParty/JCL/source/windows/JclConsole.pas +++ b/3rdParty/JCL/source/windows/JclConsole.pas @@ -1,1556 +1,1556 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is JclConsole.pas. } -{ } -{ The Initial Developer of the Original Code is Flier Lu. Portions created by Flier Lu are } -{ Copyright (C) Flier Lu. All Rights Reserved. } -{ } -{ Contributors: } -{ Flier Lu (flier) } -{ Robert Marquardt (marquardt) } -{ Robert Rossmair (rrossmair) } -{ Petr Vones (pvones) } -{ } -{**************************************************************************************************} -{ } -{ This unit contains classes and routines to support windows Character-Mode Applications } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -unit JclConsole; - -{$I jcl.inc} -{$I windowsonly.inc} - -{$HPPEMIT 'namespace JclConsole'} -(*$HPPEMIT '{'*) -{$HPPEMIT '__interface IJclScreenTextAttribute;'} -(*$HPPEMIT '}'*) -{$HPPEMIT 'using namespace JclConsole;'} -{$HPPEMIT ''} - -interface - -uses - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - {$IFDEF HAS_UNITSCOPE} - Winapi.Windows, System.Classes, System.SysUtils, System.Contnrs, - {$ELSE ~HAS_UNITSCOPE} - Windows, Classes, SysUtils, Contnrs, - {$ENDIF ~HAS_UNITSCOPE} - JclBase; - -// Console -type - TJclScreenBuffer = class; - TJclInputBuffer = class; - - TJclConsole = class(TObject) - private - FScreens: TObjectList; - FActiveScreenIndex: Longword; - FInput: TJclInputBuffer; - FOnCtrlC: TNotifyEvent; - FOnCtrlBreak: TNotifyEvent; - FOnClose: TNotifyEvent; - FOnLogOff: TNotifyEvent; - FOnShutdown: TNotifyEvent; - function GetScreen(const Idx: Longword): TJclScreenBuffer; - function GetScreenCount: Longword; - function GetActiveScreen: TJclScreenBuffer; - procedure SetActiveScreen(const Value: TJclScreenBuffer); - procedure SetActiveScreenIndex(const Value: Longword); - function GetTitle: string; - procedure SetTitle(const Value: string); - function GetInputCodePage: DWORD; - function GetOutputCodePage: DWORD; - procedure SetInputCodePage(const Value: DWORD); - procedure SetOutputCodePage(const Value: DWORD); - public - constructor Create; - destructor Destroy; override; - class function Default: TJclConsole; - class procedure Shutdown; - { TODO : Add 'Attach' and other functions for WinXP/Win.Net } - class function IsConsole(const Module: HMODULE): Boolean; overload; - class function IsConsole(const FileName: TFileName): Boolean; overload; - class function MouseButtonCount: DWORD; - class procedure Alloc; - class procedure Free; - function Add(AWidth: Smallint = 0; AHeight: Smallint = 0): TJclScreenBuffer; - function Remove(const ScrBuf: TJclScreenBuffer): Longword; - procedure Delete(const Idx: Longword); - property Title: string read GetTitle write SetTitle; - property InputCodePage: DWORD read GetInputCodePage write SetInputCodePage; - property OutputCodePage: DWORD read GetOutputCodePage write SetOutputCodePage; - property Input: TJclInputBuffer read FInput; - property Screens[const Idx: Longword]: TJclScreenBuffer read GetScreen; - property ScreenCount: Longword read GetScreenCount; - property ActiveScreenIndex: Longword read FActiveScreenIndex write SetActiveScreenIndex; - property ActiveScreen: TJclScreenBuffer read GetActiveScreen write SetActiveScreen; - property OnCtrlC: TNotifyEvent read FOnCtrlC write FOnCtrlC; - property OnCtrlBreak: TNotifyEvent read FOnCtrlBreak write FOnCtrlBreak; - property OnClose: TNotifyEvent read FOnClose write FOnClose; - property OnLogOff: TNotifyEvent read FOnLogOff write FOnLogOff; - property OnShutdown: TNotifyEvent read FOnShutdown write FOnShutdown; - end; - - TJclConsoleInputMode = (imLine, imEcho, imProcessed, imWindow, imMouse); - TJclConsoleInputModes = set of TJclConsoleInputMode; - TJclConsoleOutputMode = (omProcessed, omWrapAtEol); - TJclConsoleOutputModes = set of TJclConsoleOutputMode; - - IJclScreenTextAttribute = interface; - TJclScreenFont = class; - TJclScreenCharacter = class; - TJclScreenCursor = class; - TJclScreenWindow = class; - - // Console screen buffer - TJclScreenBufferBeforeResizeEvent = procedure(Sender: TObject; const NewSize: TCoord; var CanResize: Boolean) of object; - TJclScreenBufferAfterResizeEvent = procedure(Sender: TObject) of object; - - TJclScreenBufferTextHorizontalAlign = (thaCurrent, thaLeft, thaCenter, thaRight); - TJclScreenBufferTextVerticalAlign = (tvaCurrent, tvaTop, tvaCenter, tvaBottom); - - TJclScreenBuffer = class(TObject) - private - FHandle: THandle; - FFont: TJclScreenFont; - FCursor: TJclScreenCursor; - FWindow: TJclScreenWindow; - FCharList: TObjectList; - FOnAfterResize: TJclScreenBufferAfterResizeEvent; - FOnBeforeResize: TJclScreenBufferBeforeResizeEvent; - function GetInfo: TConsoleScreenBufferInfo; - function GetSize: TCoord; - procedure SetSize(const Value: TCoord); - function GetHeight: Smallint; - function GetWidth: Smallint; - procedure SetHeight(const Value: Smallint); - procedure SetWidth(const Value: Smallint); - function GetMode: TJclConsoleOutputModes; - procedure SetMode(const Value: TJclConsoleOutputModes); - protected - procedure Init; - procedure DoResize(const NewSize: TCoord); overload; - procedure DoResize(const NewWidth, NewHeight: Smallint); overload; - property Info: TConsoleScreenBufferInfo read GetInfo; - public - constructor Create; overload; - constructor Create(const AHandle: THandle); overload; - constructor Create(const AWidth, AHeight: Smallint); overload; - destructor Destroy; override; - function Write(const Text: string; - const ATextAttribute: IJclScreenTextAttribute = nil): DWORD; overload; - function Writeln(const Text: string = ''; - const ATextAttribute: IJclScreenTextAttribute = nil): DWORD; overload; - function Write(const Text: string; const X: Smallint; const Y: Smallint; - const ATextAttribute: IJclScreenTextAttribute = nil): DWORD; overload; - function Write(const Text: string; const X: Smallint; const Y: Smallint; - pAttrs: PWORD): DWORD; overload; - function Write(const Text: string; - const HorizontalAlign: TJclScreenBufferTextHorizontalAlign; - const VerticalAlign: TJclScreenBufferTextVerticalAlign = tvaCurrent; - const ATextAttribute: IJclScreenTextAttribute = nil): DWORD; overload; - function Read(const Count: Integer): string; overload; - function Read(X: Smallint; Y: Smallint; const Count: Integer): string; overload; - function Readln: string; overload; - function Readln(X: Smallint; Y: Smallint): string; overload; - procedure Fill(const ch: Char; const ATextAttribute: IJclScreenTextAttribute = nil); - procedure Clear; - property Handle: THandle read FHandle; - property Font: TJclScreenFont read FFont; - property Cursor: TJclScreenCursor read FCursor; - property Window: TJclScreenWindow read FWindow; - property Size: TCoord read GetSize write SetSize; - property Width: Smallint read GetWidth write SetWidth; - property Height: Smallint read GetHeight write SetHeight; - property Mode: TJclConsoleOutputModes read GetMode write SetMode; - property OnBeforeResize: TJclScreenBufferBeforeResizeEvent read FOnBeforeResize write FOnBeforeResize; - property OnAfterResize: TJclScreenBufferAfterResizeEvent read FOnAfterResize write FOnAfterResize; - end; - - // Console screen text attributes - TJclScreenFontColor = (fclBlack, fclBlue, fclGreen, fclRed, fclCyan, fclMagenta, fclYellow, fclWhite); - TJclScreenBackColor = (bclBlack, bclBlue, bclGreen, bclRed, bclCyan, bclMagenta, bclYellow, bclWhite); - TJclScreenFontStyle = (fsLeadingByte, fsTrailingByte, fsGridHorizontal, fsGridLeftVertical, fsGridRightVertical, fsReverseVideo, fsUnderscore, fsSbcsDbcs); - TJclScreenFontStyles = set of TJclScreenFontStyle; - - IJclScreenTextAttribute = interface - ['{B880B1AC-9F1A-4F42-9D44-EA482B4F3510}'] - function GetTextAttribute: Word; - procedure SetTextAttribute(const Value: Word); - - property TextAttribute: Word read GetTextAttribute write SetTextAttribute; - - function GetColor: TJclScreenFontColor; - procedure SetColor(const Value: TJclScreenFontColor); - function GetBgColor: TJclScreenBackColor; - procedure SetBgColor(const Value: TJclScreenBackColor); - function GetHighlight: Boolean; - procedure SetHighlight(const Value: Boolean); - function GetBgHighlight: Boolean; - procedure SetBgHighlight(const Value: Boolean); - function GetStyle: TJclScreenFontStyles; - procedure SetStyle(const Value: TJclScreenFontStyles); - - property Color: TJclScreenFontColor read GetColor write SetColor; - property BgColor: TJclScreenBackColor read GetBgColor write SetBgColor; - property Highlight: Boolean read GetHighlight write SetHighlight; - property BgHighlight: Boolean read GetBgHighlight write SetBgHighlight; - property Style: TJclScreenFontStyles read GetStyle write SetStyle; - end; - - TJclScreenCustomTextAttribute = class(TInterfacedObject, IJclScreenTextAttribute) - public - constructor Create(const Attr: TJclScreenCustomTextAttribute = nil); overload; - - procedure Clear; - - { IJclScreenTextAttribute } - function GetTextAttribute: Word; virtual; abstract; - procedure SetTextAttribute(const Value: Word); virtual; abstract; - - property TextAttribute: Word read GetTextAttribute write SetTextAttribute; - - function GetColor: TJclScreenFontColor; - procedure SetColor(const Value: TJclScreenFontColor); - function GetBgColor: TJclScreenBackColor; - procedure SetBgColor(const Value: TJclScreenBackColor); - function GetHighlight: Boolean; - procedure SetHighlight(const Value: Boolean); - function GetBgHighlight: Boolean; - procedure SetBgHighlight(const Value: Boolean); - function GetStyle: TJclScreenFontStyles; - procedure SetStyle(const Value: TJclScreenFontStyles); - - property Color: TJclScreenFontColor read GetColor write SetColor; - property BgColor: TJclScreenBackColor read GetBgColor write SetBgColor; - property Highlight: Boolean read GetHighlight write SetHighlight; - property BgHighlight: Boolean read GetBgHighlight write SetBgHighlight; - property Style: TJclScreenFontStyles read GetStyle write SetStyle; - end; - - TJclScreenFont = class(TJclScreenCustomTextAttribute, IJclScreenTextAttribute) - private - FScreenBuffer: TJclScreenBuffer; - public - constructor Create(const AScrBuf: TJclScreenBuffer); - property ScreenBuffer: TJclScreenBuffer read FScreenBuffer; - { IJclScreenTextAttribute } - function GetTextAttribute: Word; override; - procedure SetTextAttribute(const Value: Word); override; - end; - - TJclScreenTextAttribute = class(TJclScreenCustomTextAttribute, IJclScreenTextAttribute) - private - FAttribute: Word; - public - constructor Create(const Attribute: Word); overload; - constructor Create(const AColor: TJclScreenFontColor = fclWhite; - const ABgColor: TJclScreenBackColor = bclBlack; - const AHighLight: Boolean = False; - const ABgHighLight: Boolean = False; - const AStyle: TJclScreenFontStyles = []); overload; - { IJclScreenTextAttribute } - function GetTextAttribute: Word; override; - procedure SetTextAttribute(const Value: Word); override; - end; - - TJclScreenCharacter = class(TJclScreenCustomTextAttribute, IJclScreenTextAttribute) - private - FCharInfo: TCharInfo; - function GetCharacter: Char; - procedure SetCharacter(const Value: Char); - public - constructor Create(const CharInfo: TCharInfo); - property Info: TCharInfo read FCharInfo write FCharInfo; - property Character: Char read GetCharacter write SetCharacter; - { IJclScreenTextAttribute } - function GetTextAttribute: Word; override; - procedure SetTextAttribute(const Value: Word); override; - end; - - TJclScreenCursorSize = 1..100; - - TJclScreenCursor = class(TObject) - private - FScreenBuffer: TJclScreenBuffer; - function GetInfo: TConsoleCursorInfo; - procedure SetInfo(const Value: TConsoleCursorInfo); - function GetPosition: TCoord; - procedure SetPosition(const Value: TCoord); - function GetSize: TJclScreenCursorSize; - procedure SetSize(const Value: TJclScreenCursorSize); - function GetVisible: Boolean; - procedure SetVisible(const Value: Boolean); - protected - property Info: TConsoleCursorInfo read GetInfo write SetInfo; - public - constructor Create(const AScrBuf: TJclScreenBuffer); - property ScreenBuffer: TJclScreenBuffer read FScreenBuffer; - procedure MoveTo(const DestPos: TCoord); overload; - procedure MoveTo(const x, y: Smallint); overload; - procedure MoveBy(const Delta: TCoord); overload; - procedure MoveBy(const cx, cy: Smallint); overload; - property Position: TCoord read GetPosition write SetPosition; - property Size: TJclScreenCursorSize read GetSize write SetSize; - property Visible: Boolean read GetVisible write SetVisible; - end; - - // Console screen window - TJclScreenWindow = class(TObject) - private - FScreenBuffer: TJclScreenBuffer; - function GetMaxConsoleWindowSize: TCoord; - function GetMaxWindow: TCoord; - function GetLeft: Smallint; - function GetTop: Smallint; - function GetWidth: Smallint; - function GetHeight: Smallint; - function GetPosition: TCoord; - function GetSize: TCoord; - function GetBottom: Smallint; - function GetRight: Smallint; - procedure SetLeft(const Value: Smallint); - procedure SetTop(const Value: Smallint); - procedure SetWidth(const Value: Smallint); - procedure SetHeight(const Value: Smallint); - procedure SetPosition(const Value: TCoord); - procedure SetSize(const Value: TCoord); - procedure SetBottom(const Value: Smallint); - procedure SetRight(const Value: Smallint); - procedure InternalSetPosition(const X, Y: SmallInt); - procedure InternalSetSize(const X, Y: SmallInt); - protected - procedure DoResize(const NewRect: TSmallRect; bAbsolute: Boolean = True); - public - constructor Create(const AScrBuf: TJclScreenBuffer); - procedure Scroll(const cx, cy: Smallint); - property ScreenBuffer: TJclScreenBuffer read FScreenBuffer; - property MaxConsoleWindowSize: TCoord read GetMaxConsoleWindowSize; - property MaxWindow: TCoord read GetMaxWindow; - property Position: TCoord read GetPosition write SetPosition; - property Size: TCoord read GetSize write SetSize; - property Left: Smallint read GetLeft write SetLeft; - property Right: Smallint read GetRight write SetRight; - property Top: Smallint read GetTop write SetTop; - property Bottom: Smallint read GetBottom write SetBottom; - property Width: Smallint read GetWidth write SetWidth; - property Height: Smallint read GetHeight write SetHeight; - end; - - // Console input buffer - TJclInputCtrlEvent = ( ceCtrlC, ceCtrlBreak, ceCtrlClose, ceCtrlLogOff, ceCtrlShutdown ); - - TJclInputRecordArray = array of TInputRecord; - - TJclInputBuffer = class(TObject) - private - FConsole: TJclConsole; - FHandle: THandle; - function GetMode: TJclConsoleInputModes; - procedure SetMode(const Value: TJclConsoleInputModes); - function GetEventCount: DWORD; - public - constructor Create(const AConsole: TJclConsole); - destructor Destroy; override; - procedure Clear; - procedure RaiseCtrlEvent(const AEvent: TJclInputCtrlEvent; const ProcessGroupId: DWORD = 0); - function WaitEvent(const TimeOut: DWORD = INFINITE): Boolean; - function GetEvents(var Events: TJclInputRecordArray): DWORD; overload; - function GetEvents(const Count: Integer): TJclInputRecordArray; overload; - function PeekEvents(var Events: TJclInputRecordArray): DWORD; overload; - function PeekEvents(const Count: Integer): TJclInputRecordArray; overload; - function PutEvents(const Events: TJclInputRecordArray): DWORD; overload; - function GetEvent: TInputRecord; - function PeekEvent: TInputRecord; - function PutEvent(const Event: TInputRecord): Boolean; - property Console: TJclConsole read FConsole; - property Handle: THandle read FHandle; - property Mode: TJclConsoleInputModes read GetMode write SetMode; - property EventCount: DWORD read GetEventCount; - end; - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\windows'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -uses - {$IFDEF FPC} - JwaWinNT, - {$ENDIF FPC} - {$IFDEF HAS_UNITSCOPE} - System.Math, System.TypInfo, - {$ELSE ~HAS_UNITSCOPE} - Math, TypInfo, - {$ENDIF ~HAS_UNITSCOPE} - JclFileUtils, JclResources, JclSysUtils; - -{$IFDEF FPC} -{$EXTERNALSYM CreateConsoleScreenBuffer} -const - kernel32 = 'kernel32.dll'; - -function CreateConsoleScreenBuffer(dwDesiredAccess, dwShareMode: DWORD; - lpSecurityAttributes: PSecurityAttributes; dwFlags: DWORD; lpScreenBufferData: Pointer): THandle; stdcall; - external kernel32 name 'CreateConsoleScreenBuffer'; -function SetConsoleWindowInfo(hConsoleOutput: THandle; bAbsolute: BOOL; - const lpConsoleWindow: TSmallRect): BOOL; stdcall; - external kernel32 name 'SetConsoleWindowInfo'; -{$ENDIF FPC} - -const - COMMON_LVB_LEADING_BYTE = $0100; // Leading Byte of DBCS - COMMON_LVB_TRAILING_BYTE = $0200; // Trailing Byte of DBCS - COMMON_LVB_GRID_HORIZONTAL = $0400; // DBCS: Grid attribute: top horizontal. - COMMON_LVB_GRID_LVERTICAL = $0800; // DBCS: Grid attribute: left vertical. - COMMON_LVB_GRID_RVERTICAL = $1000; // DBCS: Grid attribute: right vertical. - COMMON_LVB_REVERSE_VIDEO = $4000; // DBCS: Reverse fore/back ground attribute. - COMMON_LVB_UNDERSCORE = $8000; // DBCS: Underscore. - - COMMON_LVB_SBCSDBCS = $0300; // SBCS or DBCS flag. - -const - FontColorMask: Word = FOREGROUND_BLUE or FOREGROUND_GREEN or FOREGROUND_RED; - BackColorMask: Word = BACKGROUND_BLUE or BACKGROUND_GREEN or BACKGROUND_RED; - FontStyleMask: Word = COMMON_LVB_LEADING_BYTE or COMMON_LVB_TRAILING_BYTE or - COMMON_LVB_GRID_HORIZONTAL or COMMON_LVB_GRID_LVERTICAL or COMMON_LVB_GRID_RVERTICAL or - COMMON_LVB_REVERSE_VIDEO or COMMON_LVB_UNDERSCORE or COMMON_LVB_SBCSDBCS; - - FontColorMapping: array [TJclScreenFontColor] of Word = - (0, - FOREGROUND_BLUE, - FOREGROUND_GREEN, - FOREGROUND_RED, - FOREGROUND_BLUE or FOREGROUND_GREEN, - FOREGROUND_BLUE or FOREGROUND_RED, - FOREGROUND_GREEN or FOREGROUND_RED, - FOREGROUND_BLUE or FOREGROUND_GREEN or FOREGROUND_RED); - - BackColorMapping: array [TJclScreenBackColor] of Word = - (0, - BACKGROUND_BLUE, - BACKGROUND_GREEN, - BACKGROUND_RED, - BACKGROUND_BLUE or BACKGROUND_GREEN, - BACKGROUND_BLUE or BACKGROUND_RED, - BACKGROUND_GREEN or BACKGROUND_RED, - BACKGROUND_BLUE or BACKGROUND_GREEN or BACKGROUND_RED); - - FontStyleMapping: array [TJclScreenFontStyle] of Word = - (COMMON_LVB_LEADING_BYTE, // Leading Byte of DBCS - COMMON_LVB_TRAILING_BYTE, // Trailing Byte of DBCS - COMMON_LVB_GRID_HORIZONTAL, // DBCS: Grid attribute: top horizontal. - COMMON_LVB_GRID_LVERTICAL, // DBCS: Grid attribute: left vertical. - COMMON_LVB_GRID_RVERTICAL, // DBCS: Grid attribute: right vertical. - COMMON_LVB_REVERSE_VIDEO, // DBCS: Reverse fore/back ground attribute. - COMMON_LVB_UNDERSCORE, // DBCS: Underscore. - COMMON_LVB_SBCSDBCS); // SBCS or DBCS flag. - -const - InputModeMapping: array [TJclConsoleInputMode] of DWORD = - (ENABLE_LINE_INPUT, ENABLE_ECHO_INPUT, ENABLE_PROCESSED_INPUT, - ENABLE_WINDOW_INPUT, ENABLE_MOUSE_INPUT); - - OutputModeMapping: array [TJclConsoleOutputMode] of DWORD = - (ENABLE_PROCESSED_OUTPUT, ENABLE_WRAP_AT_EOL_OUTPUT); - -var - g_DefaultConsole: TJclConsole = nil; - -// Due to changes in Vista and onwards Windows will terminate -// console immidiately after executing CtrlHandler. We need put some wait in it. -// These subprograms may only work if main application is console and it creates its own message pump. -// On GUI one these should work always. - -function ProcessMessage(var Msg: TMsg): Boolean; -begin - Result := False; - if {$IFDEF HAS_UNITSCOPE}WinApi.{$ENDIF}Windows.PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then - begin - Result := True; - {$IFDEF HAS_UNITSCOPE}WinApi.{$ENDIF}Windows.TranslateMessage(Msg); - {$IFDEF HAS_UNITSCOPE}WinApi.{$ENDIF}Windows.DispatchMessage(Msg); - end; -end; - -procedure ProcessMessages; -var - Msg: {$IFDEF HAS_UNITSCOPE}WinApi.{$ENDIF}Windows.TMsg; -begin - while ProcessMessage(Msg) do; -end; - -procedure Wait(N: LongWord); -var - TickCount: LongWord; -begin - SleepEx(N, False); - TickCount := GetTickCount + N; - while GetTickCount < TickCount do - ProcessMessages; -end; - -function CtrlHandler(CtrlType: DWORD): BOOL; stdcall; -var - Console: TJclConsole; -begin - try - Console := TJclConsole.Default; - Result := True; - case CtrlType of - CTRL_C_EVENT: - if Assigned(Console.OnCtrlC) then - Console.OnCtrlC(Console); - CTRL_BREAK_EVENT: - if Assigned(Console.OnCtrlBreak) then - Console.OnCtrlBreak(Console); - CTRL_CLOSE_EVENT: - if Assigned(Console.OnClose) then - Console.OnClose(Console); - CTRL_LOGOFF_EVENT: - if Assigned(Console.OnLogOff) then - Console.OnLogOff(Console); - CTRL_SHUTDOWN_EVENT: - if Assigned(Console.OnShutdown) then - Console.OnShutdown(Console); - else - // (rom) disabled. Makes function result unpredictable. - //Assert(False, 'Unknown Ctrl Event'); - Result := False; - end; - except - // (rom) dubious. An exception implies that an event has been handled. - Result := False; - end; - Wait(200); -end; - -//=== { TJclConsole } ======================================================== - -constructor TJclConsole.Create; -begin - inherited Create; - FScreens := TObjectList.Create; - FInput:= TJclInputBuffer.Create(Self); - FActiveScreenIndex := FScreens.Add(TJclScreenBuffer.Create); - FOnCtrlC := nil; - FOnCtrlBreak := nil; - FOnClose := nil; - FOnLogOff := nil; - FOnShutdown := nil; - SetConsoleCtrlHandler(@CtrlHandler, True); -end; - -destructor TJclConsole.Destroy; -begin - // (rom) why as first line? - inherited Destroy; - SetConsoleCtrlHandler(@CtrlHandler, False); - FreeAndNil(FInput); - FreeAndNil(FScreens); -end; - -class procedure TJclConsole.Alloc; -begin - Win32Check(AllocConsole); -end; - -class procedure TJclConsole.Free; -begin - Win32Check(FreeConsole); -end; - -function TJclConsole.GetScreen(const Idx: Longword): TJclScreenBuffer; -begin - // (rom) maybe some checks on Idx here? - Result := TJclScreenBuffer(FScreens[Idx]); -end; - -function TJclConsole.GetScreenCount: Longword; -begin - Result := FScreens.Count; -end; - -function TJclConsole.GetActiveScreen: TJclScreenBuffer; -begin - Result := Screens[FActiveScreenIndex]; -end; - -procedure TJclConsole.SetActiveScreen(const Value: TJclScreenBuffer); -begin - SetActiveScreenIndex(FScreens.IndexOf(Value)); -end; - -procedure TJclConsole.SetActiveScreenIndex(const Value: Longword); -begin - if ActiveScreenIndex <> Value then - begin - Win32Check(SetConsoleActiveScreenBuffer(Screens[Value].Handle)); - FActiveScreenIndex := Value; - end; -end; - -class function TJclConsole.Default: TJclConsole; -begin - if not Assigned(g_DefaultConsole) then - g_DefaultConsole := TJclConsole.Create; - Result := g_DefaultConsole; -end; - -class procedure TJclConsole.Shutdown; -begin - FreeAndNil(g_DefaultConsole); -end; - -function TJclConsole.Add(AWidth, AHeight: Smallint): TJclScreenBuffer; -begin - if AWidth = 0 then - AWidth := ActiveScreen.Size.X; - if AHeight = 0 then - AHeight := ActiveScreen.Size.Y; - Result := TJclScreenBuffer(FScreens[FScreens.Add(TJclScreenBuffer.Create(AWidth, AHeight))]); -end; - -function TJclConsole.Remove(const ScrBuf: TJclScreenBuffer): Longword; -begin - Result := FScreens.IndexOf(ScrBuf); - Delete(Result); -end; - -procedure TJclConsole.Delete(const Idx: Longword); -begin - FScreens.Delete(Idx); -end; - -function TJclConsole.GetTitle: string; -var - Len: Integer; -begin - { TODO : max 64kByte instead of max 255 } - { TODO : max 64kByte instead of max 255 } - SetLength(Result, High(Byte)); - Len := GetConsoleTitle(PChar(Result), Length(Result)); - Win32Check((0 < Len) and (Len < Length(Result))); - SetLength(Result, Len); -end; - -procedure TJclConsole.SetTitle(const Value: string); -begin - Win32Check(SetConsoleTitle(PChar(Value))); -end; - -function TJclConsole.GetInputCodePage: DWORD; -begin - Result := GetConsoleCP; -end; - -procedure TJclConsole.SetInputCodePage(const Value: DWORD); -begin - { TODO -cTest : SetConsoleCP under Win9x } - Win32Check(SetConsoleCP(Value)); -end; - -function TJclConsole.GetOutputCodePage: DWORD; -begin - Result := GetConsoleOutputCP; -end; - -procedure TJclConsole.SetOutputCodePage(const Value: DWORD); -begin - { TODO -cTest : SetConsoleOutputCP under Win9x } - Win32Check(SetConsoleOutputCP(Value)); -end; - -class function TJclConsole.IsConsole(const Module: HMODULE): Boolean; -var - DosHeader: PImageDosHeader; - NtHeaders: PImageNtHeaders; -begin - Result := False; - { TODO : Documentation of this solution } - DosHeader := PImageDosHeader(Module); - if DosHeader^.e_magic = IMAGE_DOS_SIGNATURE then - begin - {$OVERFLOWCHECKS OFF} - NtHeaders := PImageNtHeaders(TJclAddr(Module) + TJclAddr({$IFDEF FPC} DosHeader^.e_lfanew {$ELSE} DosHeader^._lfanew {$ENDIF})); - {$IFDEF OVERFLOWCHECKS_ON} - {$OVERFLOWCHECKS ON} - {$ENDIF OVERFLOWCHECKS_ON} - if NtHeaders^.Signature = IMAGE_NT_SIGNATURE then - Result := NtHeaders^.OptionalHeader.Subsystem = IMAGE_SUBSYSTEM_WINDOWS_CUI; - end; -end; - -class function TJclConsole.IsConsole(const FileName: TFileName): Boolean; -begin - with TJclFileMappingStream.Create(FileName) do - try - Result := IsConsole(HMODULE(Memory)); - finally - Free; - end; -end; - -class function TJclConsole.MouseButtonCount: DWORD; -begin - Result := 0; - Win32Check(GetNumberOfConsoleMouseButtons(Result)); -end; - -//=== { TJclScreenBuffer } =================================================== - -constructor TJclScreenBuffer.Create; -begin - inherited Create; - FHandle := CreateFile('CONOUT$', GENERIC_READ or GENERIC_WRITE, - FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0); - Win32Check(FHandle <> INVALID_HANDLE_VALUE); - Init; -end; - -constructor TJclScreenBuffer.Create(const AHandle: THandle); -begin - inherited Create; - FHandle := AHandle; - Assert(FHandle <> INVALID_HANDLE_VALUE); - Init; -end; - -constructor TJclScreenBuffer.Create(const AWidth, AHeight: Smallint); -begin - inherited Create; - FHandle := CreateConsoleScreenBuffer(GENERIC_READ or GENERIC_WRITE, - FILE_SHARE_READ or FILE_SHARE_WRITE, nil, CONSOLE_TEXTMODE_BUFFER, nil); - Win32Check(FHandle <> INVALID_HANDLE_VALUE); - Init; - DoResize(AWidth, AHeight); -end; - -destructor TJclScreenBuffer.Destroy; -begin - // (rom) why as first line? - inherited Destroy; - FreeAndNil(FFont); - FreeAndNil(FCursor); - FreeAndNil(FWindow); - FreeAndNil(FCharList); - CloseHandle(FHandle); -end; - -procedure TJclScreenBuffer.Init; -begin - FCharList := TObjectList.Create; - FOnAfterResize := nil; - FOnBeforeResize := nil; - FFont := TJclScreenFont.Create(Self); - FCursor := TJclScreenCursor.Create(Self); - FWindow := TJclScreenWindow.Create(Self); -end; - -function TJclScreenBuffer.GetInfo: TConsoleScreenBufferInfo; -begin - Win32Check(GetConsoleScreenBufferInfo(FHandle, Result)); -end; - -function TJclScreenBuffer.GetSize: TCoord; -begin - Result := Info.dwSize; -end; - -procedure TJclScreenBuffer.SetSize(const Value: TCoord); -begin - DoResize(Value); -end; - -function TJclScreenBuffer.GetWidth: Smallint; -begin - Result := Size.X; -end; - -procedure TJclScreenBuffer.SetWidth(const Value: Smallint); -begin - DoResize(Value, Size.Y); -end; - -function TJclScreenBuffer.GetHeight: Smallint; -begin - Result := Size.Y; -end; - -procedure TJclScreenBuffer.SetHeight(const Value: Smallint); -begin - DoResize(Size.X, Value); -end; - -procedure TJclScreenBuffer.DoResize(const NewSize: TCoord); -var - CanResize: Boolean; -begin - if (Size.X <> NewSize.X) or (Size.Y <> NewSize.Y) then - begin - if Assigned(FOnBeforeResize) then - begin - CanResize := True; - FOnBeforeResize(Self, NewSize, CanResize); - if not CanResize then - Exit; - end; - Win32Check(SetConsoleScreenBufferSize(FHandle, NewSize)); - if Assigned(FOnAfterResize) then - FOnAfterResize(Self); - end; -end; - -procedure TJclScreenBuffer.DoResize(const NewWidth, NewHeight: Smallint); -var - NewSize: TCoord; -begin - NewSize.X := NewWidth; - NewSize.Y := NewHeight; - DoResize(NewSize); -end; - -function TJclScreenBuffer.GetMode: TJclConsoleOutputModes; -var - OutputMode: DWORD; - AMode: TJclConsoleOutputMode; -begin - Result := []; - OutputMode := 0; - Win32Check(GetConsoleMode(FHandle, OutputMode)); - for AMode := Low(TJclConsoleOutputMode) to High(TJclConsoleOutputMode) do - if (OutputMode and OutputModeMapping[AMode]) = OutputModeMapping[AMode] then - Include(Result, AMode); -end; - -procedure TJclScreenBuffer.SetMode(const Value: TJclConsoleOutputModes); -var - OutputMode: DWORD; - AMode: TJclConsoleOutputMode; -begin - OutputMode := 0; - for AMode := Low(TJclConsoleOutputMode) to High(TJclConsoleOutputMode) do - if AMode in Value then - OutputMode := OutputMode or OutputModeMapping[AMode]; - Win32Check(SetConsoleMode(FHandle, OutputMode)); -end; - -function TJclScreenBuffer.Write(const Text: string; - const ATextAttribute: IJclScreenTextAttribute): DWORD; -begin - if Assigned(ATextAttribute) then - Font.TextAttribute := ATextAttribute.TextAttribute; - Result := 0; - Win32Check(WriteConsole(Handle, PChar(Text), Length(Text), Result, nil)); -end; - -function TJclScreenBuffer.Writeln(const Text: string; - const ATextAttribute: IJclScreenTextAttribute): DWORD; -begin - Result := Write(Text, ATextAttribute); - Cursor.MoveTo(Window.Left, Cursor.Position.Y + 1); -end; - -function TJclScreenBuffer.Write(const Text: string; const X, Y: Smallint; - const ATextAttribute: IJclScreenTextAttribute): DWORD; -var - I: Integer; - Pos: TCoord; - Attrs: array of Word; -begin - if Length(Text) > 0 then - begin - if (X = -1) or (Y = -1) then - begin - Pos := Cursor.Position; - end - else - begin - Pos.X := X; - Pos.Y := Y; - end; - - if Assigned(ATextAttribute) then - begin - SetLength(Attrs, Length(Text)); - for I:=0 to Length(Text)-1 do - Attrs[I] := ATextAttribute.TextAttribute; - Result := Write(Text, X, Y, @Attrs[0]); - end - else - Win32Check(WriteConsoleOutputCharacter(Handle, PChar(Text), Length(Text), Pos, Result)); - end - else - Result := 0; -end; - -function TJclScreenBuffer.Write(const Text: string; const X, Y: Smallint; - pAttrs: PWORD): DWORD; -var - Pos: TCoord; -begin - if (X = -1) or (Y = -1) then - begin - Pos := Cursor.Position; - end - else - begin - Pos.X := X; - Pos.Y := Y; - end; - Result := 0; - if pAttrs <> nil then - Win32Check(WriteConsoleOutputAttribute(Handle, pAttrs, Length(Text), Pos, Result)); - Win32Check(WriteConsoleOutputCharacter(Handle, PChar(Text), Length(Text), Pos, Result)); -end; - -function TJclScreenBuffer.Write(const Text: string; - const HorizontalAlign: TJclScreenBufferTextHorizontalAlign; - const VerticalAlign: TJclScreenBufferTextVerticalAlign; - const ATextAttribute: IJclScreenTextAttribute): DWORD; -var - X, Y: Smallint; -begin - case HorizontalAlign of - //thaCurrent: X := Cursor.Position.X; - thaLeft: - X := Window.Left; - thaCenter: - X := Window.Left + (Window.Width - Length(Text)) div 2; - thaRight: - X := Window.Right - Length(Text) + 1; - else - X := Cursor.Position.X; - end; - case VerticalAlign of - //tvaCurrent: Y := Cursor.Position.Y; - tvaTop: - Y := Window.Top; - tvaCenter: - Y := Window.Top + Window.Height div 2; - tvaBottom: - Y := Window.Bottom; - else - Y := Cursor.Position.Y; - end; - Result := Write(Text, X, Y, ATextAttribute); -end; - -function TJclScreenBuffer.Read(const Count: Integer): string; -var - ReadCount: DWORD; -begin - SetLength(Result, Count); - ReadCount := 0; - Win32Check(ReadConsole(Handle, PChar(Result), Count, ReadCount, nil)); - SetLength(Result, Min(ReadCount, StrLen(PChar(Result)))); -end; - -function TJclScreenBuffer.Readln: string; -begin - Result := Read(Window.Right - Cursor.Position.X + 1); -end; - -function TJclScreenBuffer.Read(X, Y: Smallint; const Count: Integer): string; -var - ReadPos: TCoord; - ReadCount: DWORD; -begin - ReadPos.X := X; - ReadPos.Y := Y; - SetLength(Result, Count); - ReadCount := 0; - Win32Check(ReadConsoleOutputCharacter(Handle, PChar(Result), Count, ReadPos, ReadCount)); - SetLength(Result, Min(ReadCount, StrLen(PChar(Result)))); -end; - -function TJclScreenBuffer.Readln(X, Y: Smallint): string; -begin - Result := Read(X, Y, Window.Right - X + 1); -end; - -procedure TJclScreenBuffer.Fill(const ch: Char; const ATextAttribute: IJclScreenTextAttribute); -var - WriteCount: DWORD; -begin - Cursor.MoveTo(0, 0); - WriteCount := 0; - Win32Check(FillConsoleOutputCharacter(Handle, ch, Width * Height, Cursor.Position, WriteCount)); - if Assigned(ATextAttribute) then - Win32Check(FillConsoleOutputAttribute(Handle, ATextAttribute.TextAttribute, Width * Height, Cursor.Position, WriteCount)) - else - Win32Check(FillConsoleOutputAttribute(Handle, Font.TextAttribute, Width * Height, Cursor.Position, WriteCount)); -end; - -procedure TJclScreenBuffer.Clear; -begin - Fill(' ', TJclScreenTextAttribute.Create(fclWhite, bclBlack, False, False, [])); -end; - -//=== { TJclScreenCustomTextAttribute } ====================================== - -constructor TJclScreenCustomTextAttribute.Create(const Attr: TJclScreenCustomTextAttribute); -begin - inherited Create; - if Assigned(Attr) then - SetTextAttribute(Attr.GetTextAttribute); -end; - -function TJclScreenCustomTextAttribute.GetColor: TJclScreenFontColor; -var - TA: Word; -begin - TA := TextAttribute and FontColorMask; - for Result := High(TJclScreenFontColor) downto Low(TJclScreenFontColor) do - if (TA and FontColorMapping[Result]) = FontColorMapping[Result] then - Break; -end; - -function TJclScreenCustomTextAttribute.GetBgColor: TJclScreenBackColor; -var - TA: Word; -begin - TA := TextAttribute and BackColorMask; - for Result := High(TJclScreenBackColor) downto Low(TJclScreenBackColor) do - if (TA and BackColorMapping[Result]) = BackColorMapping[Result] then - Break; -end; - -function TJclScreenCustomTextAttribute.GetHighlight: Boolean; -begin - Result := (TextAttribute and FOREGROUND_INTENSITY) = FOREGROUND_INTENSITY; -end; - -function TJclScreenCustomTextAttribute.GetBgHighlight: Boolean; -begin - Result := (TextAttribute and BACKGROUND_INTENSITY) = BACKGROUND_INTENSITY; -end; - -procedure TJclScreenCustomTextAttribute.SetColor(const Value: TJclScreenFontColor); -begin - TextAttribute := (TextAttribute and (not FontColorMask)) or FontColorMapping[Value]; -end; - -procedure TJclScreenCustomTextAttribute.SetBgColor(const Value: TJclScreenBackColor); -begin - TextAttribute := (TextAttribute and (not BackColorMask)) or BackColorMapping[Value]; -end; - -procedure TJclScreenCustomTextAttribute.SetHighlight(const Value: Boolean); -begin - if Value then - TextAttribute := TextAttribute or FOREGROUND_INTENSITY - else - TextAttribute := TextAttribute and (not FOREGROUND_INTENSITY); -end; - -procedure TJclScreenCustomTextAttribute.SetBgHighlight(const Value: Boolean); -begin - if Value then - TextAttribute := TextAttribute or BACKGROUND_INTENSITY - else - TextAttribute := TextAttribute and (not BACKGROUND_INTENSITY); -end; - -function TJclScreenCustomTextAttribute.GetStyle: TJclScreenFontStyles; -var - ta: Word; - AStyle: TJclScreenFontStyle; -begin - Result := []; - ta := TextAttribute and FontStyleMask; - for AStyle := Low(TJclScreenFontStyle) to High(TJclScreenFontStyle) do - if (ta and FontStyleMapping[AStyle]) = FontStyleMapping[AStyle] then - Include(Result, AStyle); -end; - -procedure TJclScreenCustomTextAttribute.SetStyle(const Value: TJclScreenFontStyles); -var - ta: Word; - AStyle: TJclScreenFontStyle; -begin - ta := 0; - for AStyle := Low(TJclScreenFontStyle) to High(TJclScreenFontStyle) do - if AStyle in Value then - ta := ta or FontStyleMapping[AStyle]; - TextAttribute := (TextAttribute and (not FontStyleMask)) or ta; -end; - -procedure TJclScreenCustomTextAttribute.Clear; -begin - TextAttribute := FontColorMapping[fclWhite] or BackColorMapping[bclBlack]; -end; - -//=== { TJclScreenFont } ===================================================== - -constructor TJclScreenFont.Create(const AScrBuf: TJclScreenBuffer); -begin - inherited Create; - FScreenBuffer := AScrBuf; -end; - -function TJclScreenFont.GetTextAttribute: Word; -begin - Result := ScreenBuffer.Info.wAttributes; -end; - -procedure TJclScreenFont.SetTextAttribute(const Value: Word); -begin - Win32Check(SetConsoleTextAttribute(ScreenBuffer.Handle, Value)); -end; - -//=== { TJclScreenTextAttribute 0 ============================================ - -constructor TJclScreenTextAttribute.Create(const Attribute: Word); -begin - inherited Create; - FAttribute := Attribute; -end; - -constructor TJclScreenTextAttribute.Create(const AColor: TJclScreenFontColor; - const ABgColor: TJclScreenBackColor; const AHighLight, ABgHighLight: Boolean; - const AStyle: TJclScreenFontStyles); -begin - inherited Create; - Color := AColor; - BgColor := ABgColor; - Highlight := AHighLight; - BgHighlight := ABgHighLight; - Style := AStyle; -end; - -function TJclScreenTextAttribute.GetTextAttribute: Word; -begin - Result := FAttribute; -end; - -procedure TJclScreenTextAttribute.SetTextAttribute(const Value: Word); -begin - FAttribute := Value; -end; - -//=== { TJclScreenCharacter } ================================================ - -constructor TJclScreenCharacter.Create(const CharInfo: TCharInfo); -begin - inherited Create; - FCharInfo := CharInfo; -end; - -function TJclScreenCharacter.GetCharacter: Char; -begin - Result := Char(FCharInfo.AsciiChar); -end; - -procedure TJclScreenCharacter.SetCharacter(const Value: Char); -begin - FCharInfo.AsciiChar := AnsiChar(Value); -end; - -function TJclScreenCharacter.GetTextAttribute: Word; -begin - Result := FCharInfo.Attributes; -end; - -procedure TJclScreenCharacter.SetTextAttribute(const Value: Word); -begin - FCharInfo.Attributes := Value; -end; - -//=== { TJclScreenCursor } =================================================== - -constructor TJclScreenCursor.Create(const AScrBuf: TJclScreenBuffer); -begin - inherited Create; - FScreenBuffer := AScrBuf; -end; - -function TJclScreenCursor.GetInfo: TConsoleCursorInfo; -begin - ResetMemory(Result, SizeOf(Result)); - Win32Check(GetConsoleCursorInfo(ScreenBuffer.Handle, Result)); -end; - -procedure TJclScreenCursor.SetInfo(const Value: TConsoleCursorInfo); -begin - Win32Check(SetConsoleCursorInfo(ScreenBuffer.Handle, Value)); -end; - -function TJclScreenCursor.GetPosition: TCoord; -begin - Result := ScreenBuffer.Info.dwCursorPosition; -end; - -procedure TJclScreenCursor.SetPosition(const Value: TCoord); -begin - Win32Check(SetConsoleCursorPosition(ScreenBuffer.Handle, Value)); -end; - -function TJclScreenCursor.GetSize: TJclScreenCursorSize; -begin - Result := Info.dwSize; -end; - -procedure TJclScreenCursor.SetSize(const Value: TJclScreenCursorSize); -var - NewInfo: TConsoleCursorInfo; -begin - NewInfo := Info; - NewInfo.dwSize := Value; - Info := NewInfo; -end; - -function TJclScreenCursor.GetVisible: Boolean; -begin - Result := Info.bVisible; -end; - -procedure TJclScreenCursor.SetVisible(const Value: Boolean); -var - NewInfo: TConsoleCursorInfo; -begin - NewInfo := Info; - NewInfo.bVisible := Value; - Info := NewInfo; -end; - -procedure TJclScreenCursor.MoveTo(const DestPos: TCoord); -begin - Position := DestPos; -end; - -procedure TJclScreenCursor.MoveTo(const x, y: Smallint); -var - DestPos: TCoord; -begin - DestPos.X := x; - DestPos.Y := y; - MoveTo(DestPos); -end; - -procedure TJclScreenCursor.MoveBy(const Delta: TCoord); -var - DestPos: TCoord; -begin - DestPos := Position; - Inc(DestPos.X, Delta.X); - Inc(DestPos.Y, Delta.Y); - MoveTo(DestPos); -end; - -procedure TJclScreenCursor.MoveBy(const cx, cy: Smallint); -var - DestPos: TCoord; -begin - DestPos := Position; - Inc(DestPos.X, cx); - Inc(DestPos.Y, cy); - MoveTo(DestPos); -end; - -//=== { TJclScreenWindow } =================================================== - -constructor TJclScreenWindow.Create(const AScrBuf: TJclScreenBuffer); -begin - inherited Create; - FScreenBuffer := AScrBuf; -end; - -function TJclScreenWindow.GetMaxConsoleWindowSize: TCoord; -begin - Result := GetLargestConsoleWindowSize(ScreenBuffer.Handle); -end; - -function TJclScreenWindow.GetMaxWindow: TCoord; -begin - Result := ScreenBuffer.Info.dwMaximumWindowSize; -end; - -procedure TJclScreenWindow.InternalSetPosition(const X, Y: SmallInt); -var - NewRect: TSmallRect; -begin - if (GetLeft <> X) or (GetTop <> Y) then - begin - NewRect.Left := X; - NewRect.Top := Y; - NewRect.Right:= NewRect.Left + Width - 1; - NewRect.Bottom := NewRect.Top + Height - 1; - DoResize(NewRect); - end; -end; - -procedure TJclScreenWindow.InternalSetSize(const X, Y: SmallInt); -var - NewRect: TSmallRect; -begin - if (Width <> X) or (Height <> Y) then - begin - NewRect.Left := Left; - NewRect.Top := Top; - NewRect.Right := NewRect.Left + X - 1; - NewRect.Bottom := NewRect.Top + Y - 1; - DoResize(NewRect); - end; -end; - -function TJclScreenWindow.GetLeft: Smallint; -begin - Result := ScreenBuffer.Info.srWindow.Left; -end; - -function TJclScreenWindow.GetRight: Smallint; -begin - Result := ScreenBuffer.Info.srWindow.Right; -end; - -function TJclScreenWindow.GetTop: Smallint; -begin - Result := ScreenBuffer.Info.srWindow.Top; -end; - -function TJclScreenWindow.GetBottom: Smallint; -begin - Result := ScreenBuffer.Info.srWindow.Bottom; -end; - -function TJclScreenWindow.GetWidth: Smallint; -begin - Result := ScreenBuffer.Info.srWindow.Right - ScreenBuffer.Info.srWindow.Left + 1; -end; - -function TJclScreenWindow.GetHeight: Smallint; -begin - Result := ScreenBuffer.Info.srWindow.Bottom - ScreenBuffer.Info.srWindow.Top + 1; -end; - -procedure TJclScreenWindow.SetLeft(const Value: Smallint); -begin - InternalSetPosition(Value, Top); -end; - -procedure TJclScreenWindow.SetRight(const Value: Smallint); -begin - InternalSetSize(Value - Left + 1, Height); -end; - -procedure TJclScreenWindow.SetTop(const Value: Smallint); -begin - InternalSetPosition(Left, Value); -end; - -procedure TJclScreenWindow.SetBottom(const Value: Smallint); -begin - InternalSetSize(Width, Value - Top + 1); -end; - -procedure TJclScreenWindow.SetWidth(const Value: Smallint); -begin - InternalSetSize(Value, Height); -end; - -procedure TJclScreenWindow.SetHeight(const Value: Smallint); -begin - InternalSetSize(Width, Value); -end; - -function TJclScreenWindow.GetPosition: TCoord; -begin - Result.X := Left; - Result.Y := Top; -end; - -function TJclScreenWindow.GetSize: TCoord; -begin - Result.X := Width; - Result.Y := Height; -end; - -procedure TJclScreenWindow.SetPosition(const Value: TCoord); -begin - InternalSetPosition(Value.X, Value.Y); -end; - -procedure TJclScreenWindow.SetSize(const Value: TCoord); -begin - InternalSetSize(Value.X, Value.Y); -end; - -procedure TJclScreenWindow.DoResize(const NewRect: TSmallRect; bAbsolute: Boolean); -begin - Win32Check(SetConsoleWindowInfo(ScreenBuffer.Handle, bAbsolute, NewRect)); -end; - -procedure TJclScreenWindow.Scroll(const cx, cy: Smallint); -var - Delta: TSmallRect; -begin - Delta.Left := cx; - Delta.Top := cy; - Delta.Right := cx; - Delta.Bottom := cy; - DoResize(Delta, False); -end; - -//=== { TJclInputBuffer } ==================================================== - -constructor TJclInputBuffer.Create(const AConsole: TJclConsole); -begin - inherited Create; - FConsole := AConsole; - FHandle := CreateFile('CONIN$', GENERIC_READ or GENERIC_WRITE, - FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0); - Win32Check(INVALID_HANDLE_VALUE <> FHandle); -end; - -destructor TJclInputBuffer.Destroy; -begin - CloseHandle(FHandle); - inherited Destroy; -end; - -procedure TJclInputBuffer.Clear; -begin - Win32Check(FlushConsoleInputBuffer(Handle)); -end; - -function TJclInputBuffer.GetMode: TJclConsoleInputModes; -var - InputMode: DWORD; - AMode: TJclConsoleInputMode; -begin - Result := []; - InputMode := 0; - Win32Check(GetConsoleMode(Handle, InputMode)); - for AMode := Low(TJclConsoleInputMode) to High(TJclConsoleInputMode) do - if (InputMode and InputModeMapping[AMode]) = InputModeMapping[AMode] then - Include(Result, AMode); -end; - -procedure TJclInputBuffer.SetMode(const Value: TJclConsoleInputModes); -var - InputMode: DWORD; - AMode: TJclConsoleInputMode; -begin - InputMode := 0; - for AMode := Low(TJclConsoleInputMode) to High(TJclConsoleInputMode) do - if AMode in Value then - InputMode := InputMode or InputModeMapping[AMode]; - Win32Check(SetConsoleMode(Handle, InputMode)); -end; - -procedure TJclInputBuffer.RaiseCtrlEvent(const AEvent: TJclInputCtrlEvent; - const ProcessGroupId: DWORD); -const - CtrlEventMapping: array [TJclInputCtrlEvent] of DWORD = - (CTRL_C_EVENT, CTRL_BREAK_EVENT, CTRL_CLOSE_EVENT, CTRL_LOGOFF_EVENT, CTRL_SHUTDOWN_EVENT); -begin - if AEvent in [ceCtrlC, ceCtrlBreak] then - Win32Check(GenerateConsoleCtrlEvent(CtrlEventMapping[AEvent], ProcessGroupId)) - else - raise EJclError.CreateResFmt(@RsCannotRaiseSignal, - [GetEnumName(TypeInfo(TJclInputCtrlEvent), Integer(AEvent))]); -end; - -function TJclInputBuffer.GetEventCount: DWORD; -begin - Result := 0; - Win32Check(GetNumberOfConsoleInputEvents(Handle, Result)); -end; - -function TJclInputBuffer.WaitEvent(const TimeOut: DWORD): Boolean; -begin - Result := WaitForSingleObject(Handle, TimeOut) = WAIT_OBJECT_0; -end; - -function TJclInputBuffer.GetEvents(var Events: TJclInputRecordArray): DWORD; -begin - Result := 0; - Win32Check(ReadConsoleInput(Handle, Events[0], Length(Events), Result)); -end; - -function TJclInputBuffer.PeekEvents(var Events: TJclInputRecordArray): DWORD; -begin - if EventCount = 0 then - Result := 0 - else - Win32Check(PeekConsoleInput(Handle, Events[0], Length(Events), Result)); -end; - -function TJclInputBuffer.PutEvents(const Events: TJclInputRecordArray): DWORD; -begin - Result := 0; - Win32Check(WriteConsoleInput(Handle, Events[0], Length(Events), Result)); -end; - -function TJclInputBuffer.GetEvents(const Count: Integer): TJclInputRecordArray; -begin - SetLength(Result, Count); - SetLength(Result, GetEvents(Result)); -end; - -function TJclInputBuffer.PeekEvents(const Count: Integer): TJclInputRecordArray; -begin - SetLength(Result, Count); - SetLength(Result, PeekEvents(Result)); -end; - -function TJclInputBuffer.GetEvent: TInputRecord; -begin - Result := GetEvents(1)[0]; -end; - -function TJclInputBuffer.PeekEvent: TInputRecord; -begin - Result := PeekEvents(1)[0]; -end; - -function TJclInputBuffer.PutEvent(const Event: TInputRecord): Boolean; -var - Evts: TJclInputRecordArray; -begin - SetLength(Evts, 1); - Evts[0] := Event; - Result := PutEvents(Evts) = 1; -end; - -{$IFDEF UNITVERSIONING} -initialization - RegisterUnitVersion(HInstance, UnitVersioning); - -finalization - UnregisterUnitVersion(HInstance); -{$ENDIF UNITVERSIONING} - -end. +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclConsole.pas. } +{ } +{ The Initial Developer of the Original Code is Flier Lu. Portions created by Flier Lu are } +{ Copyright (C) Flier Lu. All Rights Reserved. } +{ } +{ Contributors: } +{ Flier Lu (flier) } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Petr Vones (pvones) } +{ } +{**************************************************************************************************} +{ } +{ This unit contains classes and routines to support windows Character-Mode Applications } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclConsole; + +{$I jcl.inc} +{$I windowsonly.inc} + +{$HPPEMIT 'namespace JclConsole'} +(*$HPPEMIT '{'*) +{$HPPEMIT '__interface IJclScreenTextAttribute;'} +(*$HPPEMIT '}'*) +{$HPPEMIT 'using namespace JclConsole;'} +{$HPPEMIT ''} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, System.Classes, System.SysUtils, System.Contnrs, + {$ELSE ~HAS_UNITSCOPE} + Windows, Classes, SysUtils, Contnrs, + {$ENDIF ~HAS_UNITSCOPE} + JclBase; + +// Console +type + TJclScreenBuffer = class; + TJclInputBuffer = class; + + TJclConsole = class(TObject) + private + FScreens: TObjectList; + FActiveScreenIndex: Longword; + FInput: TJclInputBuffer; + FOnCtrlC: TNotifyEvent; + FOnCtrlBreak: TNotifyEvent; + FOnClose: TNotifyEvent; + FOnLogOff: TNotifyEvent; + FOnShutdown: TNotifyEvent; + function GetScreen(const Idx: Longword): TJclScreenBuffer; + function GetScreenCount: Longword; + function GetActiveScreen: TJclScreenBuffer; + procedure SetActiveScreen(const Value: TJclScreenBuffer); + procedure SetActiveScreenIndex(const Value: Longword); + function GetTitle: string; + procedure SetTitle(const Value: string); + function GetInputCodePage: DWORD; + function GetOutputCodePage: DWORD; + procedure SetInputCodePage(const Value: DWORD); + procedure SetOutputCodePage(const Value: DWORD); + public + constructor Create; + destructor Destroy; override; + class function Default: TJclConsole; + class procedure Shutdown; + { TODO : Add 'Attach' and other functions for WinXP/Win.Net } + class function IsConsole(const Module: HMODULE): Boolean; overload; + class function IsConsole(const FileName: TFileName): Boolean; overload; + class function MouseButtonCount: DWORD; + class procedure Alloc; + class procedure Free; + function Add(AWidth: Smallint = 0; AHeight: Smallint = 0): TJclScreenBuffer; + function Remove(const ScrBuf: TJclScreenBuffer): Longword; + procedure Delete(const Idx: Longword); + property Title: string read GetTitle write SetTitle; + property InputCodePage: DWORD read GetInputCodePage write SetInputCodePage; + property OutputCodePage: DWORD read GetOutputCodePage write SetOutputCodePage; + property Input: TJclInputBuffer read FInput; + property Screens[const Idx: Longword]: TJclScreenBuffer read GetScreen; + property ScreenCount: Longword read GetScreenCount; + property ActiveScreenIndex: Longword read FActiveScreenIndex write SetActiveScreenIndex; + property ActiveScreen: TJclScreenBuffer read GetActiveScreen write SetActiveScreen; + property OnCtrlC: TNotifyEvent read FOnCtrlC write FOnCtrlC; + property OnCtrlBreak: TNotifyEvent read FOnCtrlBreak write FOnCtrlBreak; + property OnClose: TNotifyEvent read FOnClose write FOnClose; + property OnLogOff: TNotifyEvent read FOnLogOff write FOnLogOff; + property OnShutdown: TNotifyEvent read FOnShutdown write FOnShutdown; + end; + + TJclConsoleInputMode = (imLine, imEcho, imProcessed, imWindow, imMouse); + TJclConsoleInputModes = set of TJclConsoleInputMode; + TJclConsoleOutputMode = (omProcessed, omWrapAtEol); + TJclConsoleOutputModes = set of TJclConsoleOutputMode; + + IJclScreenTextAttribute = interface; + TJclScreenFont = class; + TJclScreenCharacter = class; + TJclScreenCursor = class; + TJclScreenWindow = class; + + // Console screen buffer + TJclScreenBufferBeforeResizeEvent = procedure(Sender: TObject; const NewSize: TCoord; var CanResize: Boolean) of object; + TJclScreenBufferAfterResizeEvent = procedure(Sender: TObject) of object; + + TJclScreenBufferTextHorizontalAlign = (thaCurrent, thaLeft, thaCenter, thaRight); + TJclScreenBufferTextVerticalAlign = (tvaCurrent, tvaTop, tvaCenter, tvaBottom); + + TJclScreenBuffer = class(TObject) + private + FHandle: THandle; + FFont: TJclScreenFont; + FCursor: TJclScreenCursor; + FWindow: TJclScreenWindow; + FCharList: TObjectList; + FOnAfterResize: TJclScreenBufferAfterResizeEvent; + FOnBeforeResize: TJclScreenBufferBeforeResizeEvent; + function GetInfo: TConsoleScreenBufferInfo; + function GetSize: TCoord; + procedure SetSize(const Value: TCoord); + function GetHeight: Smallint; + function GetWidth: Smallint; + procedure SetHeight(const Value: Smallint); + procedure SetWidth(const Value: Smallint); + function GetMode: TJclConsoleOutputModes; + procedure SetMode(const Value: TJclConsoleOutputModes); + protected + procedure Init; + procedure DoResize(const NewSize: TCoord); overload; + procedure DoResize(const NewWidth, NewHeight: Smallint); overload; + property Info: TConsoleScreenBufferInfo read GetInfo; + public + constructor Create; overload; + constructor Create(const AHandle: THandle); overload; + constructor Create(const AWidth, AHeight: Smallint); overload; + destructor Destroy; override; + function Write(const Text: string; + const ATextAttribute: IJclScreenTextAttribute = nil): DWORD; overload; + function Writeln(const Text: string = ''; + const ATextAttribute: IJclScreenTextAttribute = nil): DWORD; overload; + function Write(const Text: string; const X: Smallint; const Y: Smallint; + const ATextAttribute: IJclScreenTextAttribute = nil): DWORD; overload; + function Write(const Text: string; const X: Smallint; const Y: Smallint; + pAttrs: PWORD): DWORD; overload; + function Write(const Text: string; + const HorizontalAlign: TJclScreenBufferTextHorizontalAlign; + const VerticalAlign: TJclScreenBufferTextVerticalAlign = tvaCurrent; + const ATextAttribute: IJclScreenTextAttribute = nil): DWORD; overload; + function Read(const Count: Integer): string; overload; + function Read(X: Smallint; Y: Smallint; const Count: Integer): string; overload; + function Readln: string; overload; + function Readln(X: Smallint; Y: Smallint): string; overload; + procedure Fill(const ch: Char; const ATextAttribute: IJclScreenTextAttribute = nil); + procedure Clear; + property Handle: THandle read FHandle; + property Font: TJclScreenFont read FFont; + property Cursor: TJclScreenCursor read FCursor; + property Window: TJclScreenWindow read FWindow; + property Size: TCoord read GetSize write SetSize; + property Width: Smallint read GetWidth write SetWidth; + property Height: Smallint read GetHeight write SetHeight; + property Mode: TJclConsoleOutputModes read GetMode write SetMode; + property OnBeforeResize: TJclScreenBufferBeforeResizeEvent read FOnBeforeResize write FOnBeforeResize; + property OnAfterResize: TJclScreenBufferAfterResizeEvent read FOnAfterResize write FOnAfterResize; + end; + + // Console screen text attributes + TJclScreenFontColor = (fclBlack, fclBlue, fclGreen, fclRed, fclCyan, fclMagenta, fclYellow, fclWhite); + TJclScreenBackColor = (bclBlack, bclBlue, bclGreen, bclRed, bclCyan, bclMagenta, bclYellow, bclWhite); + TJclScreenFontStyle = (fsLeadingByte, fsTrailingByte, fsGridHorizontal, fsGridLeftVertical, fsGridRightVertical, fsReverseVideo, fsUnderscore, fsSbcsDbcs); + TJclScreenFontStyles = set of TJclScreenFontStyle; + + IJclScreenTextAttribute = interface + ['{B880B1AC-9F1A-4F42-9D44-EA482B4F3510}'] + function GetTextAttribute: Word; + procedure SetTextAttribute(const Value: Word); + + property TextAttribute: Word read GetTextAttribute write SetTextAttribute; + + function GetColor: TJclScreenFontColor; + procedure SetColor(const Value: TJclScreenFontColor); + function GetBgColor: TJclScreenBackColor; + procedure SetBgColor(const Value: TJclScreenBackColor); + function GetHighlight: Boolean; + procedure SetHighlight(const Value: Boolean); + function GetBgHighlight: Boolean; + procedure SetBgHighlight(const Value: Boolean); + function GetStyle: TJclScreenFontStyles; + procedure SetStyle(const Value: TJclScreenFontStyles); + + property Color: TJclScreenFontColor read GetColor write SetColor; + property BgColor: TJclScreenBackColor read GetBgColor write SetBgColor; + property Highlight: Boolean read GetHighlight write SetHighlight; + property BgHighlight: Boolean read GetBgHighlight write SetBgHighlight; + property Style: TJclScreenFontStyles read GetStyle write SetStyle; + end; + + TJclScreenCustomTextAttribute = class(TInterfacedObject, IJclScreenTextAttribute) + public + constructor Create(const Attr: TJclScreenCustomTextAttribute = nil); overload; + + procedure Clear; + + { IJclScreenTextAttribute } + function GetTextAttribute: Word; virtual; abstract; + procedure SetTextAttribute(const Value: Word); virtual; abstract; + + property TextAttribute: Word read GetTextAttribute write SetTextAttribute; + + function GetColor: TJclScreenFontColor; + procedure SetColor(const Value: TJclScreenFontColor); + function GetBgColor: TJclScreenBackColor; + procedure SetBgColor(const Value: TJclScreenBackColor); + function GetHighlight: Boolean; + procedure SetHighlight(const Value: Boolean); + function GetBgHighlight: Boolean; + procedure SetBgHighlight(const Value: Boolean); + function GetStyle: TJclScreenFontStyles; + procedure SetStyle(const Value: TJclScreenFontStyles); + + property Color: TJclScreenFontColor read GetColor write SetColor; + property BgColor: TJclScreenBackColor read GetBgColor write SetBgColor; + property Highlight: Boolean read GetHighlight write SetHighlight; + property BgHighlight: Boolean read GetBgHighlight write SetBgHighlight; + property Style: TJclScreenFontStyles read GetStyle write SetStyle; + end; + + TJclScreenFont = class(TJclScreenCustomTextAttribute, IJclScreenTextAttribute) + private + FScreenBuffer: TJclScreenBuffer; + public + constructor Create(const AScrBuf: TJclScreenBuffer); + property ScreenBuffer: TJclScreenBuffer read FScreenBuffer; + { IJclScreenTextAttribute } + function GetTextAttribute: Word; override; + procedure SetTextAttribute(const Value: Word); override; + end; + + TJclScreenTextAttribute = class(TJclScreenCustomTextAttribute, IJclScreenTextAttribute) + private + FAttribute: Word; + public + constructor Create(const Attribute: Word); overload; + constructor Create(const AColor: TJclScreenFontColor = fclWhite; + const ABgColor: TJclScreenBackColor = bclBlack; + const AHighLight: Boolean = False; + const ABgHighLight: Boolean = False; + const AStyle: TJclScreenFontStyles = []); overload; + { IJclScreenTextAttribute } + function GetTextAttribute: Word; override; + procedure SetTextAttribute(const Value: Word); override; + end; + + TJclScreenCharacter = class(TJclScreenCustomTextAttribute, IJclScreenTextAttribute) + private + FCharInfo: TCharInfo; + function GetCharacter: Char; + procedure SetCharacter(const Value: Char); + public + constructor Create(const CharInfo: TCharInfo); + property Info: TCharInfo read FCharInfo write FCharInfo; + property Character: Char read GetCharacter write SetCharacter; + { IJclScreenTextAttribute } + function GetTextAttribute: Word; override; + procedure SetTextAttribute(const Value: Word); override; + end; + + TJclScreenCursorSize = 1..100; + + TJclScreenCursor = class(TObject) + private + FScreenBuffer: TJclScreenBuffer; + function GetInfo: TConsoleCursorInfo; + procedure SetInfo(const Value: TConsoleCursorInfo); + function GetPosition: TCoord; + procedure SetPosition(const Value: TCoord); + function GetSize: TJclScreenCursorSize; + procedure SetSize(const Value: TJclScreenCursorSize); + function GetVisible: Boolean; + procedure SetVisible(const Value: Boolean); + protected + property Info: TConsoleCursorInfo read GetInfo write SetInfo; + public + constructor Create(const AScrBuf: TJclScreenBuffer); + property ScreenBuffer: TJclScreenBuffer read FScreenBuffer; + procedure MoveTo(const DestPos: TCoord); overload; + procedure MoveTo(const x, y: Smallint); overload; + procedure MoveBy(const Delta: TCoord); overload; + procedure MoveBy(const cx, cy: Smallint); overload; + property Position: TCoord read GetPosition write SetPosition; + property Size: TJclScreenCursorSize read GetSize write SetSize; + property Visible: Boolean read GetVisible write SetVisible; + end; + + // Console screen window + TJclScreenWindow = class(TObject) + private + FScreenBuffer: TJclScreenBuffer; + function GetMaxConsoleWindowSize: TCoord; + function GetMaxWindow: TCoord; + function GetLeft: Smallint; + function GetTop: Smallint; + function GetWidth: Smallint; + function GetHeight: Smallint; + function GetPosition: TCoord; + function GetSize: TCoord; + function GetBottom: Smallint; + function GetRight: Smallint; + procedure SetLeft(const Value: Smallint); + procedure SetTop(const Value: Smallint); + procedure SetWidth(const Value: Smallint); + procedure SetHeight(const Value: Smallint); + procedure SetPosition(const Value: TCoord); + procedure SetSize(const Value: TCoord); + procedure SetBottom(const Value: Smallint); + procedure SetRight(const Value: Smallint); + procedure InternalSetPosition(const X, Y: SmallInt); + procedure InternalSetSize(const X, Y: SmallInt); + protected + procedure DoResize(const NewRect: TSmallRect; bAbsolute: Boolean = True); + public + constructor Create(const AScrBuf: TJclScreenBuffer); + procedure Scroll(const cx, cy: Smallint); + property ScreenBuffer: TJclScreenBuffer read FScreenBuffer; + property MaxConsoleWindowSize: TCoord read GetMaxConsoleWindowSize; + property MaxWindow: TCoord read GetMaxWindow; + property Position: TCoord read GetPosition write SetPosition; + property Size: TCoord read GetSize write SetSize; + property Left: Smallint read GetLeft write SetLeft; + property Right: Smallint read GetRight write SetRight; + property Top: Smallint read GetTop write SetTop; + property Bottom: Smallint read GetBottom write SetBottom; + property Width: Smallint read GetWidth write SetWidth; + property Height: Smallint read GetHeight write SetHeight; + end; + + // Console input buffer + TJclInputCtrlEvent = ( ceCtrlC, ceCtrlBreak, ceCtrlClose, ceCtrlLogOff, ceCtrlShutdown ); + + TJclInputRecordArray = array of TInputRecord; + + TJclInputBuffer = class(TObject) + private + FConsole: TJclConsole; + FHandle: THandle; + function GetMode: TJclConsoleInputModes; + procedure SetMode(const Value: TJclConsoleInputModes); + function GetEventCount: DWORD; + public + constructor Create(const AConsole: TJclConsole); + destructor Destroy; override; + procedure Clear; + procedure RaiseCtrlEvent(const AEvent: TJclInputCtrlEvent; const ProcessGroupId: DWORD = 0); + function WaitEvent(const TimeOut: DWORD = INFINITE): Boolean; + function GetEvents(var Events: TJclInputRecordArray): DWORD; overload; + function GetEvents(const Count: Integer): TJclInputRecordArray; overload; + function PeekEvents(var Events: TJclInputRecordArray): DWORD; overload; + function PeekEvents(const Count: Integer): TJclInputRecordArray; overload; + function PutEvents(const Events: TJclInputRecordArray): DWORD; overload; + function GetEvent: TInputRecord; + function PeekEvent: TInputRecord; + function PutEvent(const Event: TInputRecord): Boolean; + property Console: TJclConsole read FConsole; + property Handle: THandle read FHandle; + property Mode: TJclConsoleInputModes read GetMode write SetMode; + property EventCount: DWORD read GetEventCount; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF FPC} + JwaWinNT, + {$ENDIF FPC} + {$IFDEF HAS_UNITSCOPE} + System.Math, System.TypInfo, + {$ELSE ~HAS_UNITSCOPE} + Math, TypInfo, + {$ENDIF ~HAS_UNITSCOPE} + JclFileUtils, JclResources, JclSysUtils; + +{$IFDEF FPC} +{$EXTERNALSYM CreateConsoleScreenBuffer} +const + kernel32 = 'kernel32.dll'; + +function CreateConsoleScreenBuffer(dwDesiredAccess, dwShareMode: DWORD; + lpSecurityAttributes: PSecurityAttributes; dwFlags: DWORD; lpScreenBufferData: Pointer): THandle; stdcall; + external kernel32 name 'CreateConsoleScreenBuffer'; +function SetConsoleWindowInfo(hConsoleOutput: THandle; bAbsolute: BOOL; + const lpConsoleWindow: TSmallRect): BOOL; stdcall; + external kernel32 name 'SetConsoleWindowInfo'; +{$ENDIF FPC} + +const + COMMON_LVB_LEADING_BYTE = $0100; // Leading Byte of DBCS + COMMON_LVB_TRAILING_BYTE = $0200; // Trailing Byte of DBCS + COMMON_LVB_GRID_HORIZONTAL = $0400; // DBCS: Grid attribute: top horizontal. + COMMON_LVB_GRID_LVERTICAL = $0800; // DBCS: Grid attribute: left vertical. + COMMON_LVB_GRID_RVERTICAL = $1000; // DBCS: Grid attribute: right vertical. + COMMON_LVB_REVERSE_VIDEO = $4000; // DBCS: Reverse fore/back ground attribute. + COMMON_LVB_UNDERSCORE = $8000; // DBCS: Underscore. + + COMMON_LVB_SBCSDBCS = $0300; // SBCS or DBCS flag. + +const + FontColorMask: Word = FOREGROUND_BLUE or FOREGROUND_GREEN or FOREGROUND_RED; + BackColorMask: Word = BACKGROUND_BLUE or BACKGROUND_GREEN or BACKGROUND_RED; + FontStyleMask: Word = COMMON_LVB_LEADING_BYTE or COMMON_LVB_TRAILING_BYTE or + COMMON_LVB_GRID_HORIZONTAL or COMMON_LVB_GRID_LVERTICAL or COMMON_LVB_GRID_RVERTICAL or + COMMON_LVB_REVERSE_VIDEO or COMMON_LVB_UNDERSCORE or COMMON_LVB_SBCSDBCS; + + FontColorMapping: array [TJclScreenFontColor] of Word = + (0, + FOREGROUND_BLUE, + FOREGROUND_GREEN, + FOREGROUND_RED, + FOREGROUND_BLUE or FOREGROUND_GREEN, + FOREGROUND_BLUE or FOREGROUND_RED, + FOREGROUND_GREEN or FOREGROUND_RED, + FOREGROUND_BLUE or FOREGROUND_GREEN or FOREGROUND_RED); + + BackColorMapping: array [TJclScreenBackColor] of Word = + (0, + BACKGROUND_BLUE, + BACKGROUND_GREEN, + BACKGROUND_RED, + BACKGROUND_BLUE or BACKGROUND_GREEN, + BACKGROUND_BLUE or BACKGROUND_RED, + BACKGROUND_GREEN or BACKGROUND_RED, + BACKGROUND_BLUE or BACKGROUND_GREEN or BACKGROUND_RED); + + FontStyleMapping: array [TJclScreenFontStyle] of Word = + (COMMON_LVB_LEADING_BYTE, // Leading Byte of DBCS + COMMON_LVB_TRAILING_BYTE, // Trailing Byte of DBCS + COMMON_LVB_GRID_HORIZONTAL, // DBCS: Grid attribute: top horizontal. + COMMON_LVB_GRID_LVERTICAL, // DBCS: Grid attribute: left vertical. + COMMON_LVB_GRID_RVERTICAL, // DBCS: Grid attribute: right vertical. + COMMON_LVB_REVERSE_VIDEO, // DBCS: Reverse fore/back ground attribute. + COMMON_LVB_UNDERSCORE, // DBCS: Underscore. + COMMON_LVB_SBCSDBCS); // SBCS or DBCS flag. + +const + InputModeMapping: array [TJclConsoleInputMode] of DWORD = + (ENABLE_LINE_INPUT, ENABLE_ECHO_INPUT, ENABLE_PROCESSED_INPUT, + ENABLE_WINDOW_INPUT, ENABLE_MOUSE_INPUT); + + OutputModeMapping: array [TJclConsoleOutputMode] of DWORD = + (ENABLE_PROCESSED_OUTPUT, ENABLE_WRAP_AT_EOL_OUTPUT); + +var + g_DefaultConsole: TJclConsole = nil; + +// Due to changes in Vista and onwards Windows will terminate +// console immidiately after executing CtrlHandler. We need put some wait in it. +// These subprograms may only work if main application is console and it creates its own message pump. +// On GUI one these should work always. + +function ProcessMessage(var Msg: TMsg): Boolean; +begin + Result := False; + if {$IFDEF HAS_UNITSCOPE}WinApi.{$ENDIF}Windows.PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then + begin + Result := True; + {$IFDEF HAS_UNITSCOPE}WinApi.{$ENDIF}Windows.TranslateMessage(Msg); + {$IFDEF HAS_UNITSCOPE}WinApi.{$ENDIF}Windows.DispatchMessage(Msg); + end; +end; + +procedure ProcessMessages; +var + Msg: {$IFDEF HAS_UNITSCOPE}WinApi.{$ENDIF}Windows.TMsg; +begin + while ProcessMessage(Msg) do; +end; + +procedure Wait(N: LongWord); +var + TickCount: LongWord; +begin + SleepEx(N, False); + TickCount := GetTickCount + N; + while GetTickCount < TickCount do + ProcessMessages; +end; + +function CtrlHandler(CtrlType: DWORD): BOOL; stdcall; +var + Console: TJclConsole; +begin + try + Console := TJclConsole.Default; + Result := True; + case CtrlType of + CTRL_C_EVENT: + if Assigned(Console.OnCtrlC) then + Console.OnCtrlC(Console); + CTRL_BREAK_EVENT: + if Assigned(Console.OnCtrlBreak) then + Console.OnCtrlBreak(Console); + CTRL_CLOSE_EVENT: + if Assigned(Console.OnClose) then + Console.OnClose(Console); + CTRL_LOGOFF_EVENT: + if Assigned(Console.OnLogOff) then + Console.OnLogOff(Console); + CTRL_SHUTDOWN_EVENT: + if Assigned(Console.OnShutdown) then + Console.OnShutdown(Console); + else + // (rom) disabled. Makes function result unpredictable. + //Assert(False, 'Unknown Ctrl Event'); + Result := False; + end; + except + // (rom) dubious. An exception implies that an event has been handled. + Result := False; + end; + Wait(200); +end; + +//=== { TJclConsole } ======================================================== + +constructor TJclConsole.Create; +begin + inherited Create; + FScreens := TObjectList.Create; + FInput:= TJclInputBuffer.Create(Self); + FActiveScreenIndex := FScreens.Add(TJclScreenBuffer.Create); + FOnCtrlC := nil; + FOnCtrlBreak := nil; + FOnClose := nil; + FOnLogOff := nil; + FOnShutdown := nil; + SetConsoleCtrlHandler(@CtrlHandler, True); +end; + +destructor TJclConsole.Destroy; +begin + // (rom) why as first line? + inherited Destroy; + SetConsoleCtrlHandler(@CtrlHandler, False); + FreeAndNil(FInput); + FreeAndNil(FScreens); +end; + +class procedure TJclConsole.Alloc; +begin + Win32Check(AllocConsole); +end; + +class procedure TJclConsole.Free; +begin + Win32Check(FreeConsole); +end; + +function TJclConsole.GetScreen(const Idx: Longword): TJclScreenBuffer; +begin + // (rom) maybe some checks on Idx here? + Result := TJclScreenBuffer(FScreens[Idx]); +end; + +function TJclConsole.GetScreenCount: Longword; +begin + Result := FScreens.Count; +end; + +function TJclConsole.GetActiveScreen: TJclScreenBuffer; +begin + Result := Screens[FActiveScreenIndex]; +end; + +procedure TJclConsole.SetActiveScreen(const Value: TJclScreenBuffer); +begin + SetActiveScreenIndex(FScreens.IndexOf(Value)); +end; + +procedure TJclConsole.SetActiveScreenIndex(const Value: Longword); +begin + if ActiveScreenIndex <> Value then + begin + Win32Check(SetConsoleActiveScreenBuffer(Screens[Value].Handle)); + FActiveScreenIndex := Value; + end; +end; + +class function TJclConsole.Default: TJclConsole; +begin + if not Assigned(g_DefaultConsole) then + g_DefaultConsole := TJclConsole.Create; + Result := g_DefaultConsole; +end; + +class procedure TJclConsole.Shutdown; +begin + FreeAndNil(g_DefaultConsole); +end; + +function TJclConsole.Add(AWidth, AHeight: Smallint): TJclScreenBuffer; +begin + if AWidth = 0 then + AWidth := ActiveScreen.Size.X; + if AHeight = 0 then + AHeight := ActiveScreen.Size.Y; + Result := TJclScreenBuffer(FScreens[FScreens.Add(TJclScreenBuffer.Create(AWidth, AHeight))]); +end; + +function TJclConsole.Remove(const ScrBuf: TJclScreenBuffer): Longword; +begin + Result := FScreens.IndexOf(ScrBuf); + Delete(Result); +end; + +procedure TJclConsole.Delete(const Idx: Longword); +begin + FScreens.Delete(Idx); +end; + +function TJclConsole.GetTitle: string; +var + Len: Integer; +begin + { TODO : max 64kByte instead of max 255 } + { TODO : max 64kByte instead of max 255 } + SetLength(Result, High(Byte)); + Len := GetConsoleTitle(PChar(Result), Length(Result)); + Win32Check((0 < Len) and (Len < Length(Result))); + SetLength(Result, Len); +end; + +procedure TJclConsole.SetTitle(const Value: string); +begin + Win32Check(SetConsoleTitle(PChar(Value))); +end; + +function TJclConsole.GetInputCodePage: DWORD; +begin + Result := GetConsoleCP; +end; + +procedure TJclConsole.SetInputCodePage(const Value: DWORD); +begin + { TODO -cTest : SetConsoleCP under Win9x } + Win32Check(SetConsoleCP(Value)); +end; + +function TJclConsole.GetOutputCodePage: DWORD; +begin + Result := GetConsoleOutputCP; +end; + +procedure TJclConsole.SetOutputCodePage(const Value: DWORD); +begin + { TODO -cTest : SetConsoleOutputCP under Win9x } + Win32Check(SetConsoleOutputCP(Value)); +end; + +class function TJclConsole.IsConsole(const Module: HMODULE): Boolean; +var + DosHeader: PImageDosHeader; + NtHeaders: PImageNtHeaders; +begin + Result := False; + { TODO : Documentation of this solution } + DosHeader := PImageDosHeader(Module); + if DosHeader^.e_magic = IMAGE_DOS_SIGNATURE then + begin + {$OVERFLOWCHECKS OFF} + NtHeaders := PImageNtHeaders(TJclAddr(Module) + TJclAddr({$IFDEF FPC} DosHeader^.e_lfanew {$ELSE} DosHeader^._lfanew {$ENDIF})); + {$IFDEF OVERFLOWCHECKS_ON} + {$OVERFLOWCHECKS ON} + {$ENDIF OVERFLOWCHECKS_ON} + if NtHeaders^.Signature = IMAGE_NT_SIGNATURE then + Result := NtHeaders^.OptionalHeader.Subsystem = IMAGE_SUBSYSTEM_WINDOWS_CUI; + end; +end; + +class function TJclConsole.IsConsole(const FileName: TFileName): Boolean; +begin + with TJclFileMappingStream.Create(FileName) do + try + Result := IsConsole(HMODULE(Memory)); + finally + Free; + end; +end; + +class function TJclConsole.MouseButtonCount: DWORD; +begin + Result := 0; + Win32Check(GetNumberOfConsoleMouseButtons(Result)); +end; + +//=== { TJclScreenBuffer } =================================================== + +constructor TJclScreenBuffer.Create; +begin + inherited Create; + FHandle := CreateFile('CONOUT$', GENERIC_READ or GENERIC_WRITE, + FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0); + Win32Check(FHandle <> INVALID_HANDLE_VALUE); + Init; +end; + +constructor TJclScreenBuffer.Create(const AHandle: THandle); +begin + inherited Create; + FHandle := AHandle; + Assert(FHandle <> INVALID_HANDLE_VALUE); + Init; +end; + +constructor TJclScreenBuffer.Create(const AWidth, AHeight: Smallint); +begin + inherited Create; + FHandle := CreateConsoleScreenBuffer(GENERIC_READ or GENERIC_WRITE, + FILE_SHARE_READ or FILE_SHARE_WRITE, nil, CONSOLE_TEXTMODE_BUFFER, nil); + Win32Check(FHandle <> INVALID_HANDLE_VALUE); + Init; + DoResize(AWidth, AHeight); +end; + +destructor TJclScreenBuffer.Destroy; +begin + // (rom) why as first line? + inherited Destroy; + FreeAndNil(FFont); + FreeAndNil(FCursor); + FreeAndNil(FWindow); + FreeAndNil(FCharList); + CloseHandle(FHandle); +end; + +procedure TJclScreenBuffer.Init; +begin + FCharList := TObjectList.Create; + FOnAfterResize := nil; + FOnBeforeResize := nil; + FFont := TJclScreenFont.Create(Self); + FCursor := TJclScreenCursor.Create(Self); + FWindow := TJclScreenWindow.Create(Self); +end; + +function TJclScreenBuffer.GetInfo: TConsoleScreenBufferInfo; +begin + Win32Check(GetConsoleScreenBufferInfo(FHandle, Result)); +end; + +function TJclScreenBuffer.GetSize: TCoord; +begin + Result := Info.dwSize; +end; + +procedure TJclScreenBuffer.SetSize(const Value: TCoord); +begin + DoResize(Value); +end; + +function TJclScreenBuffer.GetWidth: Smallint; +begin + Result := Size.X; +end; + +procedure TJclScreenBuffer.SetWidth(const Value: Smallint); +begin + DoResize(Value, Size.Y); +end; + +function TJclScreenBuffer.GetHeight: Smallint; +begin + Result := Size.Y; +end; + +procedure TJclScreenBuffer.SetHeight(const Value: Smallint); +begin + DoResize(Size.X, Value); +end; + +procedure TJclScreenBuffer.DoResize(const NewSize: TCoord); +var + CanResize: Boolean; +begin + if (Size.X <> NewSize.X) or (Size.Y <> NewSize.Y) then + begin + if Assigned(FOnBeforeResize) then + begin + CanResize := True; + FOnBeforeResize(Self, NewSize, CanResize); + if not CanResize then + Exit; + end; + Win32Check(SetConsoleScreenBufferSize(FHandle, NewSize)); + if Assigned(FOnAfterResize) then + FOnAfterResize(Self); + end; +end; + +procedure TJclScreenBuffer.DoResize(const NewWidth, NewHeight: Smallint); +var + NewSize: TCoord; +begin + NewSize.X := NewWidth; + NewSize.Y := NewHeight; + DoResize(NewSize); +end; + +function TJclScreenBuffer.GetMode: TJclConsoleOutputModes; +var + OutputMode: DWORD; + AMode: TJclConsoleOutputMode; +begin + Result := []; + OutputMode := 0; + Win32Check(GetConsoleMode(FHandle, OutputMode)); + for AMode := Low(TJclConsoleOutputMode) to High(TJclConsoleOutputMode) do + if (OutputMode and OutputModeMapping[AMode]) = OutputModeMapping[AMode] then + Include(Result, AMode); +end; + +procedure TJclScreenBuffer.SetMode(const Value: TJclConsoleOutputModes); +var + OutputMode: DWORD; + AMode: TJclConsoleOutputMode; +begin + OutputMode := 0; + for AMode := Low(TJclConsoleOutputMode) to High(TJclConsoleOutputMode) do + if AMode in Value then + OutputMode := OutputMode or OutputModeMapping[AMode]; + Win32Check(SetConsoleMode(FHandle, OutputMode)); +end; + +function TJclScreenBuffer.Write(const Text: string; + const ATextAttribute: IJclScreenTextAttribute): DWORD; +begin + if Assigned(ATextAttribute) then + Font.TextAttribute := ATextAttribute.TextAttribute; + Result := 0; + Win32Check(WriteConsole(Handle, PChar(Text), Length(Text), Result, nil)); +end; + +function TJclScreenBuffer.Writeln(const Text: string; + const ATextAttribute: IJclScreenTextAttribute): DWORD; +begin + Result := Write(Text, ATextAttribute); + Cursor.MoveTo(Window.Left, Cursor.Position.Y + 1); +end; + +function TJclScreenBuffer.Write(const Text: string; const X, Y: Smallint; + const ATextAttribute: IJclScreenTextAttribute): DWORD; +var + I: Integer; + Pos: TCoord; + Attrs: array of Word; +begin + if Length(Text) > 0 then + begin + if (X = -1) or (Y = -1) then + begin + Pos := Cursor.Position; + end + else + begin + Pos.X := X; + Pos.Y := Y; + end; + + if Assigned(ATextAttribute) then + begin + SetLength(Attrs, Length(Text)); + for I:=0 to Length(Text)-1 do + Attrs[I] := ATextAttribute.TextAttribute; + Result := Write(Text, X, Y, @Attrs[0]); + end + else + Win32Check(WriteConsoleOutputCharacter(Handle, PChar(Text), Length(Text), Pos, Result)); + end + else + Result := 0; +end; + +function TJclScreenBuffer.Write(const Text: string; const X, Y: Smallint; + pAttrs: PWORD): DWORD; +var + Pos: TCoord; +begin + if (X = -1) or (Y = -1) then + begin + Pos := Cursor.Position; + end + else + begin + Pos.X := X; + Pos.Y := Y; + end; + Result := 0; + if pAttrs <> nil then + Win32Check(WriteConsoleOutputAttribute(Handle, pAttrs, Length(Text), Pos, Result)); + Win32Check(WriteConsoleOutputCharacter(Handle, PChar(Text), Length(Text), Pos, Result)); +end; + +function TJclScreenBuffer.Write(const Text: string; + const HorizontalAlign: TJclScreenBufferTextHorizontalAlign; + const VerticalAlign: TJclScreenBufferTextVerticalAlign; + const ATextAttribute: IJclScreenTextAttribute): DWORD; +var + X, Y: Smallint; +begin + case HorizontalAlign of + //thaCurrent: X := Cursor.Position.X; + thaLeft: + X := Window.Left; + thaCenter: + X := Window.Left + (Window.Width - Length(Text)) div 2; + thaRight: + X := Window.Right - Length(Text) + 1; + else + X := Cursor.Position.X; + end; + case VerticalAlign of + //tvaCurrent: Y := Cursor.Position.Y; + tvaTop: + Y := Window.Top; + tvaCenter: + Y := Window.Top + Window.Height div 2; + tvaBottom: + Y := Window.Bottom; + else + Y := Cursor.Position.Y; + end; + Result := Write(Text, X, Y, ATextAttribute); +end; + +function TJclScreenBuffer.Read(const Count: Integer): string; +var + ReadCount: DWORD; +begin + SetLength(Result, Count); + ReadCount := 0; + Win32Check(ReadConsole(Handle, PChar(Result), Count, ReadCount, nil)); + SetLength(Result, Min(ReadCount, StrLen(PChar(Result)))); +end; + +function TJclScreenBuffer.Readln: string; +begin + Result := Read(Window.Right - Cursor.Position.X + 1); +end; + +function TJclScreenBuffer.Read(X, Y: Smallint; const Count: Integer): string; +var + ReadPos: TCoord; + ReadCount: DWORD; +begin + ReadPos.X := X; + ReadPos.Y := Y; + SetLength(Result, Count); + ReadCount := 0; + Win32Check(ReadConsoleOutputCharacter(Handle, PChar(Result), Count, ReadPos, ReadCount)); + SetLength(Result, Min(ReadCount, StrLen(PChar(Result)))); +end; + +function TJclScreenBuffer.Readln(X, Y: Smallint): string; +begin + Result := Read(X, Y, Window.Right - X + 1); +end; + +procedure TJclScreenBuffer.Fill(const ch: Char; const ATextAttribute: IJclScreenTextAttribute); +var + WriteCount: DWORD; +begin + Cursor.MoveTo(0, 0); + WriteCount := 0; + Win32Check(FillConsoleOutputCharacter(Handle, ch, Width * Height, Cursor.Position, WriteCount)); + if Assigned(ATextAttribute) then + Win32Check(FillConsoleOutputAttribute(Handle, ATextAttribute.TextAttribute, Width * Height, Cursor.Position, WriteCount)) + else + Win32Check(FillConsoleOutputAttribute(Handle, Font.TextAttribute, Width * Height, Cursor.Position, WriteCount)); +end; + +procedure TJclScreenBuffer.Clear; +begin + Fill(' ', TJclScreenTextAttribute.Create(fclWhite, bclBlack, False, False, [])); +end; + +//=== { TJclScreenCustomTextAttribute } ====================================== + +constructor TJclScreenCustomTextAttribute.Create(const Attr: TJclScreenCustomTextAttribute); +begin + inherited Create; + if Assigned(Attr) then + SetTextAttribute(Attr.GetTextAttribute); +end; + +function TJclScreenCustomTextAttribute.GetColor: TJclScreenFontColor; +var + TA: Word; +begin + TA := TextAttribute and FontColorMask; + for Result := High(TJclScreenFontColor) downto Low(TJclScreenFontColor) do + if (TA and FontColorMapping[Result]) = FontColorMapping[Result] then + Break; +end; + +function TJclScreenCustomTextAttribute.GetBgColor: TJclScreenBackColor; +var + TA: Word; +begin + TA := TextAttribute and BackColorMask; + for Result := High(TJclScreenBackColor) downto Low(TJclScreenBackColor) do + if (TA and BackColorMapping[Result]) = BackColorMapping[Result] then + Break; +end; + +function TJclScreenCustomTextAttribute.GetHighlight: Boolean; +begin + Result := (TextAttribute and FOREGROUND_INTENSITY) = FOREGROUND_INTENSITY; +end; + +function TJclScreenCustomTextAttribute.GetBgHighlight: Boolean; +begin + Result := (TextAttribute and BACKGROUND_INTENSITY) = BACKGROUND_INTENSITY; +end; + +procedure TJclScreenCustomTextAttribute.SetColor(const Value: TJclScreenFontColor); +begin + TextAttribute := (TextAttribute and (not FontColorMask)) or FontColorMapping[Value]; +end; + +procedure TJclScreenCustomTextAttribute.SetBgColor(const Value: TJclScreenBackColor); +begin + TextAttribute := (TextAttribute and (not BackColorMask)) or BackColorMapping[Value]; +end; + +procedure TJclScreenCustomTextAttribute.SetHighlight(const Value: Boolean); +begin + if Value then + TextAttribute := TextAttribute or FOREGROUND_INTENSITY + else + TextAttribute := TextAttribute and (not FOREGROUND_INTENSITY); +end; + +procedure TJclScreenCustomTextAttribute.SetBgHighlight(const Value: Boolean); +begin + if Value then + TextAttribute := TextAttribute or BACKGROUND_INTENSITY + else + TextAttribute := TextAttribute and (not BACKGROUND_INTENSITY); +end; + +function TJclScreenCustomTextAttribute.GetStyle: TJclScreenFontStyles; +var + ta: Word; + AStyle: TJclScreenFontStyle; +begin + Result := []; + ta := TextAttribute and FontStyleMask; + for AStyle := Low(TJclScreenFontStyle) to High(TJclScreenFontStyle) do + if (ta and FontStyleMapping[AStyle]) = FontStyleMapping[AStyle] then + Include(Result, AStyle); +end; + +procedure TJclScreenCustomTextAttribute.SetStyle(const Value: TJclScreenFontStyles); +var + ta: Word; + AStyle: TJclScreenFontStyle; +begin + ta := 0; + for AStyle := Low(TJclScreenFontStyle) to High(TJclScreenFontStyle) do + if AStyle in Value then + ta := ta or FontStyleMapping[AStyle]; + TextAttribute := (TextAttribute and (not FontStyleMask)) or ta; +end; + +procedure TJclScreenCustomTextAttribute.Clear; +begin + TextAttribute := FontColorMapping[fclWhite] or BackColorMapping[bclBlack]; +end; + +//=== { TJclScreenFont } ===================================================== + +constructor TJclScreenFont.Create(const AScrBuf: TJclScreenBuffer); +begin + inherited Create; + FScreenBuffer := AScrBuf; +end; + +function TJclScreenFont.GetTextAttribute: Word; +begin + Result := ScreenBuffer.Info.wAttributes; +end; + +procedure TJclScreenFont.SetTextAttribute(const Value: Word); +begin + Win32Check(SetConsoleTextAttribute(ScreenBuffer.Handle, Value)); +end; + +//=== { TJclScreenTextAttribute 0 ============================================ + +constructor TJclScreenTextAttribute.Create(const Attribute: Word); +begin + inherited Create; + FAttribute := Attribute; +end; + +constructor TJclScreenTextAttribute.Create(const AColor: TJclScreenFontColor; + const ABgColor: TJclScreenBackColor; const AHighLight, ABgHighLight: Boolean; + const AStyle: TJclScreenFontStyles); +begin + inherited Create; + Color := AColor; + BgColor := ABgColor; + Highlight := AHighLight; + BgHighlight := ABgHighLight; + Style := AStyle; +end; + +function TJclScreenTextAttribute.GetTextAttribute: Word; +begin + Result := FAttribute; +end; + +procedure TJclScreenTextAttribute.SetTextAttribute(const Value: Word); +begin + FAttribute := Value; +end; + +//=== { TJclScreenCharacter } ================================================ + +constructor TJclScreenCharacter.Create(const CharInfo: TCharInfo); +begin + inherited Create; + FCharInfo := CharInfo; +end; + +function TJclScreenCharacter.GetCharacter: Char; +begin + Result := Char(FCharInfo.AsciiChar); +end; + +procedure TJclScreenCharacter.SetCharacter(const Value: Char); +begin + FCharInfo.AsciiChar := AnsiChar(Value); +end; + +function TJclScreenCharacter.GetTextAttribute: Word; +begin + Result := FCharInfo.Attributes; +end; + +procedure TJclScreenCharacter.SetTextAttribute(const Value: Word); +begin + FCharInfo.Attributes := Value; +end; + +//=== { TJclScreenCursor } =================================================== + +constructor TJclScreenCursor.Create(const AScrBuf: TJclScreenBuffer); +begin + inherited Create; + FScreenBuffer := AScrBuf; +end; + +function TJclScreenCursor.GetInfo: TConsoleCursorInfo; +begin + ResetMemory(Result, SizeOf(Result)); + Win32Check(GetConsoleCursorInfo(ScreenBuffer.Handle, Result)); +end; + +procedure TJclScreenCursor.SetInfo(const Value: TConsoleCursorInfo); +begin + Win32Check(SetConsoleCursorInfo(ScreenBuffer.Handle, Value)); +end; + +function TJclScreenCursor.GetPosition: TCoord; +begin + Result := ScreenBuffer.Info.dwCursorPosition; +end; + +procedure TJclScreenCursor.SetPosition(const Value: TCoord); +begin + Win32Check(SetConsoleCursorPosition(ScreenBuffer.Handle, Value)); +end; + +function TJclScreenCursor.GetSize: TJclScreenCursorSize; +begin + Result := Info.dwSize; +end; + +procedure TJclScreenCursor.SetSize(const Value: TJclScreenCursorSize); +var + NewInfo: TConsoleCursorInfo; +begin + NewInfo := Info; + NewInfo.dwSize := Value; + Info := NewInfo; +end; + +function TJclScreenCursor.GetVisible: Boolean; +begin + Result := Info.bVisible; +end; + +procedure TJclScreenCursor.SetVisible(const Value: Boolean); +var + NewInfo: TConsoleCursorInfo; +begin + NewInfo := Info; + NewInfo.bVisible := Value; + Info := NewInfo; +end; + +procedure TJclScreenCursor.MoveTo(const DestPos: TCoord); +begin + Position := DestPos; +end; + +procedure TJclScreenCursor.MoveTo(const x, y: Smallint); +var + DestPos: TCoord; +begin + DestPos.X := x; + DestPos.Y := y; + MoveTo(DestPos); +end; + +procedure TJclScreenCursor.MoveBy(const Delta: TCoord); +var + DestPos: TCoord; +begin + DestPos := Position; + Inc(DestPos.X, Delta.X); + Inc(DestPos.Y, Delta.Y); + MoveTo(DestPos); +end; + +procedure TJclScreenCursor.MoveBy(const cx, cy: Smallint); +var + DestPos: TCoord; +begin + DestPos := Position; + Inc(DestPos.X, cx); + Inc(DestPos.Y, cy); + MoveTo(DestPos); +end; + +//=== { TJclScreenWindow } =================================================== + +constructor TJclScreenWindow.Create(const AScrBuf: TJclScreenBuffer); +begin + inherited Create; + FScreenBuffer := AScrBuf; +end; + +function TJclScreenWindow.GetMaxConsoleWindowSize: TCoord; +begin + Result := GetLargestConsoleWindowSize(ScreenBuffer.Handle); +end; + +function TJclScreenWindow.GetMaxWindow: TCoord; +begin + Result := ScreenBuffer.Info.dwMaximumWindowSize; +end; + +procedure TJclScreenWindow.InternalSetPosition(const X, Y: SmallInt); +var + NewRect: TSmallRect; +begin + if (GetLeft <> X) or (GetTop <> Y) then + begin + NewRect.Left := X; + NewRect.Top := Y; + NewRect.Right:= NewRect.Left + Width - 1; + NewRect.Bottom := NewRect.Top + Height - 1; + DoResize(NewRect); + end; +end; + +procedure TJclScreenWindow.InternalSetSize(const X, Y: SmallInt); +var + NewRect: TSmallRect; +begin + if (Width <> X) or (Height <> Y) then + begin + NewRect.Left := Left; + NewRect.Top := Top; + NewRect.Right := NewRect.Left + X - 1; + NewRect.Bottom := NewRect.Top + Y - 1; + DoResize(NewRect); + end; +end; + +function TJclScreenWindow.GetLeft: Smallint; +begin + Result := ScreenBuffer.Info.srWindow.Left; +end; + +function TJclScreenWindow.GetRight: Smallint; +begin + Result := ScreenBuffer.Info.srWindow.Right; +end; + +function TJclScreenWindow.GetTop: Smallint; +begin + Result := ScreenBuffer.Info.srWindow.Top; +end; + +function TJclScreenWindow.GetBottom: Smallint; +begin + Result := ScreenBuffer.Info.srWindow.Bottom; +end; + +function TJclScreenWindow.GetWidth: Smallint; +begin + Result := ScreenBuffer.Info.srWindow.Right - ScreenBuffer.Info.srWindow.Left + 1; +end; + +function TJclScreenWindow.GetHeight: Smallint; +begin + Result := ScreenBuffer.Info.srWindow.Bottom - ScreenBuffer.Info.srWindow.Top + 1; +end; + +procedure TJclScreenWindow.SetLeft(const Value: Smallint); +begin + InternalSetPosition(Value, Top); +end; + +procedure TJclScreenWindow.SetRight(const Value: Smallint); +begin + InternalSetSize(Value - Left + 1, Height); +end; + +procedure TJclScreenWindow.SetTop(const Value: Smallint); +begin + InternalSetPosition(Left, Value); +end; + +procedure TJclScreenWindow.SetBottom(const Value: Smallint); +begin + InternalSetSize(Width, Value - Top + 1); +end; + +procedure TJclScreenWindow.SetWidth(const Value: Smallint); +begin + InternalSetSize(Value, Height); +end; + +procedure TJclScreenWindow.SetHeight(const Value: Smallint); +begin + InternalSetSize(Width, Value); +end; + +function TJclScreenWindow.GetPosition: TCoord; +begin + Result.X := Left; + Result.Y := Top; +end; + +function TJclScreenWindow.GetSize: TCoord; +begin + Result.X := Width; + Result.Y := Height; +end; + +procedure TJclScreenWindow.SetPosition(const Value: TCoord); +begin + InternalSetPosition(Value.X, Value.Y); +end; + +procedure TJclScreenWindow.SetSize(const Value: TCoord); +begin + InternalSetSize(Value.X, Value.Y); +end; + +procedure TJclScreenWindow.DoResize(const NewRect: TSmallRect; bAbsolute: Boolean); +begin + Win32Check(SetConsoleWindowInfo(ScreenBuffer.Handle, bAbsolute, NewRect)); +end; + +procedure TJclScreenWindow.Scroll(const cx, cy: Smallint); +var + Delta: TSmallRect; +begin + Delta.Left := cx; + Delta.Top := cy; + Delta.Right := cx; + Delta.Bottom := cy; + DoResize(Delta, False); +end; + +//=== { TJclInputBuffer } ==================================================== + +constructor TJclInputBuffer.Create(const AConsole: TJclConsole); +begin + inherited Create; + FConsole := AConsole; + FHandle := CreateFile('CONIN$', GENERIC_READ or GENERIC_WRITE, + FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0); + Win32Check(INVALID_HANDLE_VALUE <> FHandle); +end; + +destructor TJclInputBuffer.Destroy; +begin + CloseHandle(FHandle); + inherited Destroy; +end; + +procedure TJclInputBuffer.Clear; +begin + Win32Check(FlushConsoleInputBuffer(Handle)); +end; + +function TJclInputBuffer.GetMode: TJclConsoleInputModes; +var + InputMode: DWORD; + AMode: TJclConsoleInputMode; +begin + Result := []; + InputMode := 0; + Win32Check(GetConsoleMode(Handle, InputMode)); + for AMode := Low(TJclConsoleInputMode) to High(TJclConsoleInputMode) do + if (InputMode and InputModeMapping[AMode]) = InputModeMapping[AMode] then + Include(Result, AMode); +end; + +procedure TJclInputBuffer.SetMode(const Value: TJclConsoleInputModes); +var + InputMode: DWORD; + AMode: TJclConsoleInputMode; +begin + InputMode := 0; + for AMode := Low(TJclConsoleInputMode) to High(TJclConsoleInputMode) do + if AMode in Value then + InputMode := InputMode or InputModeMapping[AMode]; + Win32Check(SetConsoleMode(Handle, InputMode)); +end; + +procedure TJclInputBuffer.RaiseCtrlEvent(const AEvent: TJclInputCtrlEvent; + const ProcessGroupId: DWORD); +const + CtrlEventMapping: array [TJclInputCtrlEvent] of DWORD = + (CTRL_C_EVENT, CTRL_BREAK_EVENT, CTRL_CLOSE_EVENT, CTRL_LOGOFF_EVENT, CTRL_SHUTDOWN_EVENT); +begin + if AEvent in [ceCtrlC, ceCtrlBreak] then + Win32Check(GenerateConsoleCtrlEvent(CtrlEventMapping[AEvent], ProcessGroupId)) + else + raise EJclError.CreateResFmt(@RsCannotRaiseSignal, + [GetEnumName(TypeInfo(TJclInputCtrlEvent), Integer(AEvent))]); +end; + +function TJclInputBuffer.GetEventCount: DWORD; +begin + Result := 0; + Win32Check(GetNumberOfConsoleInputEvents(Handle, Result)); +end; + +function TJclInputBuffer.WaitEvent(const TimeOut: DWORD): Boolean; +begin + Result := WaitForSingleObject(Handle, TimeOut) = WAIT_OBJECT_0; +end; + +function TJclInputBuffer.GetEvents(var Events: TJclInputRecordArray): DWORD; +begin + Result := 0; + Win32Check(ReadConsoleInput(Handle, Events[0], Length(Events), Result)); +end; + +function TJclInputBuffer.PeekEvents(var Events: TJclInputRecordArray): DWORD; +begin + if EventCount = 0 then + Result := 0 + else + Win32Check(PeekConsoleInput(Handle, Events[0], Length(Events), Result)); +end; + +function TJclInputBuffer.PutEvents(const Events: TJclInputRecordArray): DWORD; +begin + Result := 0; + Win32Check(WriteConsoleInput(Handle, Events[0], Length(Events), Result)); +end; + +function TJclInputBuffer.GetEvents(const Count: Integer): TJclInputRecordArray; +begin + SetLength(Result, Count); + SetLength(Result, GetEvents(Result)); +end; + +function TJclInputBuffer.PeekEvents(const Count: Integer): TJclInputRecordArray; +begin + SetLength(Result, Count); + SetLength(Result, PeekEvents(Result)); +end; + +function TJclInputBuffer.GetEvent: TInputRecord; +begin + Result := GetEvents(1)[0]; +end; + +function TJclInputBuffer.PeekEvent: TInputRecord; +begin + Result := PeekEvents(1)[0]; +end; + +function TJclInputBuffer.PutEvent(const Event: TInputRecord): Boolean; +var + Evts: TJclInputRecordArray; +begin + SetLength(Evts, 1); + Evts[0] := Event; + Result := PutEvents(Evts) = 1; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/JclCppException.pas b/3rdParty/JCL/source/windows/JclCppException.pas new file mode 100644 index 00000000..d582e137 --- /dev/null +++ b/3rdParty/JCL/source/windows/JclCppException.pas @@ -0,0 +1,777 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is SystemCppException.pas. } +{ } +{ The Initial Developer of the Original Code is Moritz Beutel. Portions created by Moritz Beutel } +{ are Copyright (C) Moritz Beutel. All Rights Reserved. } +{ } +{ Contributor(s): } +{ Moritz Beutel } +{ } +{**************************************************************************************************} +{ } +{ Routines to enable the Delphi RTL to catch, dispatch and clean up C++ exceptions and to handle } +{ exceptions derived from std::exception. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclCppException; + +interface + +{$I jcl.inc} +{$I windowsonly.inc} + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +{$IFDEF BORLAND} + +type + PJclCppStdException = type Pointer; { mapped to std::exception* via $HPPEMIT } + {$EXTERNALSYM PJclCppStdException} + + { C++ exception of any type } + EJclCppException = class(Exception) + {$IFDEF COMPILER15_UP} + private type + TInaccessibleType = class end; + TPointerType = record + type TPointer = ^T; + end; + {$ENDIF COMPILER15_UP} + private + FTypeName: AnsiString; + FExcDesc: Pointer; + FAcquired: Boolean; + + constructor CreateTypeNamed(ATypeName: PAnsiChar; ExcDesc: Pointer); overload; + function GetCppExceptionObject: Pointer; + function GetThrowLine: Integer; + function GetThrowFile: AnsiString; + protected + {$IFDEF COMPILER12_UP} // TODO: this may be supported for earlier versions of Delphi/C++Builder + procedure RaisingException(P: PExceptionRecord); override; + {$ENDIF COMPILER12_UP} + public + property CppExceptionObject: Pointer read GetCppExceptionObject; + property ThrowLine: Integer read GetThrowLine; + property ThrowFile: AnsiString read GetThrowFile; + property TypeName: AnsiString read FTypeName; + + function IsCppClass: Boolean; overload; + function AsCppClass(CppClassName: AnsiString): Pointer; overload; + + {$IFDEF COMPILER15_UP} + { These are only accessible from C++ } + {$IFNDEF WIN64} + function IsCppClass: Boolean; overload; + function AsCppClass: TPointerType.TPointer; overload; + {$ENDIF ~WIN64} + {$ENDIF COMPILER15_UP} + + destructor Destroy; override; + end; + + { C++ exception derived from std::exception } + EJclCppStdException = class(EJclCppException) + private + FExcObj: PJclCppStdException; + + constructor Create(AExcObj: PJclCppStdException; Msg: String; + ATypeName: PAnsiChar; ExcDesc: Pointer); overload; + function GetStdException: PJclCppStdException; + public + { This property returns a pointer to the wrapped exception. } + property StdException: PJclCppStdException read GetStdException; + end; + + (*$HPPEMIT '#include '*) + (*$HPPEMIT '#include '*) + (*$HPPEMIT ''*) + (*$HPPEMIT 'namespace Jclcppexception'*) + (*$HPPEMIT '{'*) + (*$HPPEMIT ''*) + (*$HPPEMIT 'typedef std::exception* PJclCppStdException;'*) + (*$HPPEMIT ''*) + (*$HPPEMIT '} /* namespace Jclcppexception */'*) + + {$IFDEF COMPILER15_UP} + {$IFNDEF WIN64} + (*$HPPEMIT END 'namespace Jclcppexception'*) + (*$HPPEMIT END '{'*) + (*$HPPEMIT END ''*) + (*$HPPEMIT END 'template '*) + (*$HPPEMIT END ' bool __fastcall EJclCppException::IsCppClass(void)'*) + (*$HPPEMIT END '{'*) + (*$HPPEMIT END ' return IsCppClass() && AsCppClass(typeid(TCppClass).name()) != 0;'*) + (*$HPPEMIT END '}'*) + (*$HPPEMIT END 'template '*) + (*$HPPEMIT END ' EJclCppException::TPointerType__1::TPointer __fastcall EJclCppException::AsCppClass(void)'*) + (*$HPPEMIT END '{'*) + (*$HPPEMIT END ' return static_cast::TPointer>(AsCppClass(typeid(TCppClass).name()));'*) + (*$HPPEMIT END '}'*) + (*$HPPEMIT END ''*) + (*$HPPEMIT END '} /* namespace Jclcppexception */'*) + {$ENDIF ~WIN64} + {$ENDIF COMPILER15_UP} + + +type + TJclCppExceptionFlags = set of (cefPrependCppClassName); + +var + JclCppExceptionFlags: TJclCppExceptionFlags = [cefPrependCppClassName]; + +procedure JclInstallCppExceptionFilter; +procedure JclUninstallCppExceptionFilter; +function JclCppExceptionFilterInstalled: Boolean; + +{$ENDIF BORLAND} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +{$IFDEF BORLAND} + +uses + {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS} + System.AnsiStrings, + {$ENDIF DEPRECATED_SYSUTILS_ANSISTRINGS} + JclResources, JclHookExcept; + + +type + TExceptObjProc = function(P: PExceptionRecord): Exception; + + PCppTypeId = ^TCppTypeId; + + TCppBaseList = packed record { Delphi equivalent of struct baseList in xx.h } + blType : PCppTypeId; // type of this base + blOffs : Cardinal; // offset of this base + blFlags : Cardinal; // flags + end; + + TCppTypeId = packed record { incomplete Delphi equivalent of struct tpid in xx.h } + tpSize : Cardinal; // size of type in bytes + tpMask : Word; // attribute bits + tpName : Word; // offset of start of the zero terminated name + // where offset is relative from tpid base + + tpcVptrOffs : Cardinal; // offset of vtable pointer + tpcFlags : Cardinal; // more flags + + { Only valid if (tpMask & TM_IS_CLASS) } + tpcBaseList : Word; // offset of non-virt base list, + // where offset is relative from tpid base + tpcVbasList : Word; // offset of virtual base list + // where offset is relative from tpid base + + tpcDlOpAddr : Pointer; // operator delete addr + tpcDlOpMask : Word; // operator delete convention + + tpcDaOpMask : Word; // operator delete[] convention + tpcDaOpAddr : Pointer; // operator delete[] addr + + { Only valid if (tpcFlags & CF_HAS_DTOR), implies also (tpMask & TM_IS_CLASS) } + tpcDtorCount : Cardinal; // dtor count - total + tpcNVdtCount : Cardinal; // dtor count - non-virtual + + tpcDtorAddr : Pointer; // destructor addr + tpcDtorMask : Word; // destructor convention + + tpcDtMembers : Word; // offset of list of destructible members + // where offset is relative from tpid base + + { ... } + + { Following is the zero terminated name, padded with zero's to + the next dword boundary. + + Optionally (if tpMask & TM_IS_CLASS), we have next: + - non-virtual base list, terminated by a null pointer + - virtual base list, terminated by a null pointer + + Optionally (if tpcFlags & CF_HAS_DTOR), we have next: + - list of destructible members, terminated by a null pointer } + end; + +const + + { Flags for TCppTypeId.tpMask } + TM_IS_STRUCT = $0001; + TM_IS_CLASS = $0002; + TM_IS_PTR = $0010; + TM_IS_REF = $0020; + TM_IS_VOIDPTR = $0040; + TM_LOCALTYPE = $0080; + TM_IS_CONST = $0100; + TM_IS_VOLATILE = $0200; + TM_IS_ARRAY = $0400; + + { Flags for TCppTypeId.tpcFlags } + CF_HAS_CTOR = $00000001; + CF_HAS_DTOR = $00000002; + CF_HAS_BASES = $00000004; + CF_HAS_VBASES = $00000008; + CF_HAS_VTABPTR = $00000010; + CF_HAS_VIRTDT = $00000020; + CF_HAS_RTTI = $00000040; + CF_DELPHICLASS = $00000080; + CF_HAS_FARVPTR = $00001000; + CF_HAS_GUID = $00002000; + + { Flags for TCppExceptDesc.xdFlags } + XDF_ISDELPHIEXCEPTION = $00000004; + XDF_RETHROWN = $00000008; + +type + PCppExceptDesc = ^TCppExceptDesc; + TCppFreeMemFP = procedure(P: PCppExceptDesc); cdecl; + + TCppExceptDesc = packed record { Delphi equivalent of struct _exceptDesc in xx.h } + xdPrevious : Pointer; // previous exception or 0 + + xdTypeID : PCppTypeId; // addr of type-id for thrown type + xdFriendList : PCppTypeId; // friend list supplied to _ThrowExcept + xdFlags : Cardinal; // flags passed to _ThrowExcept + xdSize : Cardinal; // size of thrown value + xdBase : PCppTypeId; // type-id of base type + xdMask : Word; // type-id mask + xdCflg : Word; // type-id class flags (or 0) + + xdFreeFunc : TCppFreeMemFP; // function to free memory + + xdCCaddr : Pointer; // copy-ctor addr + xdCCmask : Cardinal; // copy-ctor mask + + xdERRaddr : Pointer; // address of matching ERR (when found) + xdHtabAdr : Pointer; // address of matching handler + + xdContext : Cardinal; // context of 'catch' block + + xdThrowLine : Cardinal; // source line no. of throw statement + xdThrowFile : PAnsiChar; // source file name of throw statement + + xdArgType : PCppTypeId; // address of arg type descriptor + xdArgAddr : Pointer; // address of arg copy on stack + xdArgBuff : AnsiChar; // arg stored in buffer + xdArgCopy : AnsiChar; // arg copied to catch arg + + xdOSESP : LongWord; // esp of main OS exception handler + xdOSERR : LongWord; // addr of the OS ERR on entry to _ExceptionHandler + xdOSContext : {PContext} Pointer; // CPU Context for an OS exception + xdValue : array[0..0] of AnsiChar; // copy of thrown value + end; + + PCppBaseList = ^TCppBaseList; + +{ pre-Tiburon workaround } +{$IFNDEF COMPILER12_UP} + PByte = PAnsiChar; +{$ENDIF ~COMPILER12_UP} + + +procedure ExceptionHandled(ExcDesc: PCppExceptDesc); forward; +function CppGetBase(var Obj: Pointer; TypeDesc: PCppTypeId; + BaseName: PAnsiChar): Boolean; forward; + +{$IFDEF COMPILER15_UP} +{$IFNDEF WIN64} +function EJclCppException.AsCppClass: TPointerType.TPointer; +begin + Assert(False); + {$IFDEF COMPILER37_UP} + Result := nil; + {$ENDIF COMPILER37_UP} +end; +function EJclCppException.IsCppClass: Boolean; +begin + Assert(False); + {$IFDEF COMPILER37_UP} + Result := False; + {$ENDIF COMPILER37_UP} +end; +{$ENDIF ~WIN64} +{$ENDIF COMPILER15_UP} + +constructor EJclCppException.CreateTypeNamed(ATypeName: PAnsiChar; ExcDesc: Pointer); +begin + inherited CreateFmt(RsCppUnhandledExceptionMsg, [ATypeName]); + FTypeName := ATypeName; + FExcDesc := ExcDesc; +end; + +constructor EJclCppStdException.Create(AExcObj: PJclCppStdException; Msg: String; + ATypeName: PAnsiChar; ExcDesc: Pointer); +begin + if cefPrependCppClassName in JclCppExceptionFlags then + inherited CreateFmt('[%s] %s', [ATypeName, Msg]) + else + inherited Create(Msg); + FExcObj := AExcObj; + FTypeName := ATypeName; + FExcDesc := ExcDesc; +end; + +function EJclCppException.IsCppClass: Boolean; +var + ExcDesc: PCppExceptDesc; +begin + ExcDesc := PCppExceptDesc(FExcDesc); + Result := (ExcDesc.xdTypeID.tpMask and TM_IS_CLASS) <> 0; +end; + +{$IFDEF COMPILER12_UP} // TODO: this may be supported for earlier versions of Delphi/C++Builder +procedure EJclCppException.RaisingException(P: PExceptionRecord); +begin + FAcquired := False; { if an acquired exception is re-raised, it is handed back to the RTL } + inherited; +end; +{$ENDIF COMPILER12_UP} + +function EJclCppException.GetCppExceptionObject: Pointer; +var + ExcDesc: PCppExceptDesc; +begin + ExcDesc := PCppExceptDesc(FExcDesc); + Result := @ExcDesc.xdValue; +end; + +function EJclCppException.GetThrowFile: AnsiString; +var + ExcDesc: PCppExceptDesc; +begin + ExcDesc := PCppExceptDesc(FExcDesc); + if ExcDesc.xdThrowFile <> nil then + Result := ExcDesc.xdThrowFile + else + Result := ''; +end; + +function EJclCppException.GetThrowLine: Integer; +var + ExcDesc: PCppExceptDesc; +begin + ExcDesc := PCppExceptDesc(FExcDesc); + Result := ExcDesc.xdThrowLine; +end; + +function EJclCppException.AsCppClass(CppClassName: AnsiString): Pointer; +var + ExcDesc: PCppExceptDesc; + Obj: Pointer; +begin + ExcDesc := PCppExceptDesc(FExcDesc); + Obj := @ExcDesc.xdValue; + if CppGetBase(Obj, ExcDesc.xdTypeID, PAnsiChar(CppClassName)) then + Result := Obj + else + Result := nil; +end; + +threadvar + LastCppExcDesc: PCppExceptDesc; + +procedure FreeExcDesc(ExcDesc: PCppExceptDesc); +begin + if ExcDesc = nil then + Exit; + + { call the exception object's destructor and free the memory as it + is done in _CatchCleanup() in xx.cpp. } + ExceptionHandled(ExcDesc); + + { Free the memory taken up by the exception descriptor } + ExcDesc.xdFreeFunc(ExcDesc); +end; + +destructor EJclCppException.Destroy; +var + ExcDesc: PCppExceptDesc; +begin + ExcDesc := PCppExceptDesc(FExcDesc); + if FAcquired then + FreeExcDesc(ExcDesc) + else + { when exceptions are being re-raised, the RTL first destroys the wrapper objects created for + non-Delphi exceptions and then notifies the exception hook (by raising a cDelphiReRaise + exception). Because of this, we cannot destroy the original exception info if we cannot be + sure it won't be used again. } + LastCppExcDesc := ExcDesc; + inherited; +end; + +{ from System.pas } +const + cDelphiReRaise = $0EEDFADF; + cDelphiExcept = $0EEDFAE0; + cDelphiFinally = $0EEDFAE1; + cDelphiTerminate = $0EEDFAE2; + +type + PExceptionArguments = ^TExceptionArguments; + TExceptionArguments = record + ExceptAddr: Pointer; + ExceptObj: Exception; + end; + + TAcquireExceptionProc = procedure(Obj: Pointer); + {$IFDEF CPU32} + TRaiseExceptionProc = procedure(ExceptionCode, ExceptionFlags: LongWord; + NumberOfArguments: LongWord; Args: Pointer); stdcall; + {$ENDIF CPU32} + +var + OldAcquireExceptionProc: Pointer; + OldRaiseExceptionProc: TRaiseExceptionProc; + +procedure ExceptionAcquiredProc(Obj: Pointer); +begin + { After our exception object has been acquired, we have to take the responsibility of + cleaning up the C++ exception when the user decides to destroy our object. } + if TObject(Obj) is EJclCppException then + EJclCppException(Obj).FAcquired := True; + if Assigned(OldAcquireExceptionProc) then + TAcquireExceptionProc(OldAcquireExceptionProc)(Obj); +end; + +procedure RaiseExceptionProc(ExceptionCode, ExceptionFlags: LongWord; + NumberOfArguments: LongWord; Args: Pointer); stdcall; +begin + { We make use of the fact that the RTL calls the following notifiers immediately after destroying + the exception object. We should find the exception info in the thread-local variable defined + above. } + case ExceptionCode of + cDelphiReRaise: + ; { re-raising means that the C++ exception info will be reused; don't do anything } + cDelphiTerminate: + { the exception has been handled; now is the time to destroy the C++ exception object } + FreeExcDesc(LastCppExcDesc); + end; + LastCppExcDesc := nil; + + if Assigned(OldRaiseExceptionProc) then + OldRaiseExceptionProc(ExceptionCode, ExceptionFlags, NumberOfArguments, Args); +end; + +function EJclCppStdException.GetStdException: PJclCppStdException; +begin + Result := FExcObj; +end; + +{ This function should basically work like destThrownValue()/callDestructor() + in xx.cpp } +procedure DestroyThrownValue(Obj: Pointer; ObjType: PCppTypeId); +type + TCdeclDestructor = procedure(Obj: Pointer; Flags: Integer); cdecl; + TPascalDestructor = procedure(Flags: Integer; Obj: Pointer); pascal; + TFastcallDestructor = procedure(Obj: Pointer; Flags: Integer); + TStdcallDestructor = procedure(Obj: Pointer; Flags: Integer); stdcall; +var + Flags: Integer; + CdeclDestructor: TCdeclDestructor; + PascalDestructor: TPascalDestructor; + FastcallDestructor: TFastcallDestructor; + StdcallDestructor: TStdcallDestructor; +begin + // callDestructor(objAddr, objType, 0, dtorAddr, dtorMask, 1); + Flags := 2; + + Assert((ObjType.tpcDtorMask and $0080) = 0, 'fastthis (-po) not supported'); + + case ObjType.tpcDtorMask and $0007 of + 1: // __cdecl + begin + CdeclDestructor := TCdeclDestructor(ObjType.tpcDtorAddr); + CdeclDestructor(Obj, Flags); + end; + 2: // __pascal + begin + PascalDestructor := TPascalDestructor(ObjType.tpcDtorAddr); + PascalDestructor(Flags, Obj); + end; + 3: // __fastcall + begin + FastcallDestructor := TFastcallDestructor(ObjType.tpcDtorAddr); + FastcallDestructor(Obj, Flags); + end; + 5: // __stdcall + begin + StdcallDestructor := TStdcallDestructor(ObjType.tpcDtorAddr); + StdcallDestructor(Obj, Flags); + end; + else + Assert(False, 'Unsupported calling convention!'); + end; +end; + +{ This function should basically work like exceptionHandled() in xx.cpp } +procedure ExceptionHandled(ExcDesc: PCppExceptDesc); +var + TypeDesc: PCppTypeId; + Obj: Pointer; +begin + { Is the thrown value still present in the descriptor? } + if Ord(ExcDesc.xdArgBuff) <> 0 then + begin + + { Destroy the thrown value if necessary } + if (ExcDesc.xdCflg and CF_HAS_DTOR) <> 0 then + begin + TypeDesc := ExcDesc.xdBase; + Obj := Pointer(@ExcDesc.xdValue); + + { All delphi class objects are thrown by pointer, sort of. + However, we should not meet a Delphi class here! } + if (TypeDesc.tpcFlags and CF_DELPHICLASS) <> 0 then + Obj := Pointer((PCardinal(Obj))^); { dereference } + + { We can't do anything about the _DestructorCount variable here, but + this is a legacy feature anyway. } + + { Don't destroy it if it's a delphi class and it's being rethrown. } + if (ExcDesc.xdFlags and (XDF_ISDELPHIEXCEPTION or XDF_RETHROWN)) + <> (XDF_ISDELPHIEXCEPTION or XDF_RETHROWN) then + DestroyThrownValue(Obj, TypeDesc); + end; + + { Mark the fact that the arg is gone } + ExcDesc.xdArgBuff := AnsiChar(0); + end; + + { Did we make a copy of the argument? } + if Ord(ExcDesc.xdArgCopy) <> 0 then + begin + TypeDesc := ExcDesc.xdArgType; + + { Destroy the thrown value if necessary } + if ((TypeDesc.tpMask and TM_IS_CLASS) <> 0) + and ((TypeDesc.tpcFlags and CF_HAS_DTOR) <> 0) then + DestroyThrownValue(ExcDesc.xdArgAddr, TypeDesc); + + { Mark the fact that the arg is gone } + ExcDesc.xdArgCopy := AnsiChar(0); + end; +end; + +{ It is not easy to get the C++ type description for std::exception, + therefore we identify the base class by name. + + This function should basically work like locateBaseClass() in xxtype.cpp } +function LocateCppBaseClass(BaseList: PCppBaseList; VBase: Boolean; + BaseName: PAnsiChar; var Addr: Pointer) : Boolean; +var + Ptr: Pointer; + BaseBaseList: PCppBaseList; + BaseType: PCppTypeId; +begin + { Check for end of base list } + Result := False; + while BaseList.blType <> nil do + begin + BaseType := BaseList.blType; + + Ptr := Pointer(PByte(Addr) + BaseList.blOffs); + Inc(BaseList); + + if VBase then + Ptr := Pointer((PCardinal(Ptr))^); { dereference } + + { Is this the right base class? } + if {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrComp(PAnsiChar(PByte(BaseType) + BaseType.tpName), BaseName) = 0 then + begin + Addr := Ptr; { Match --> return the adjusted pointer to the caller } + Result := True; + Exit; + end; + + { Does this base class have any base classes? } + { Annotation: Would BaseType.tpcFlags & CF_HAS_BASES be a better match for this? } + if (BaseType.tpMask and TM_IS_CLASS) = 0 then + Continue; + + { Get the list of non-virtual bases for this base class } + BaseBaseList := PCppBaseList(PByte(BaseType) + BaseType.tpcBaseList); + + { Give up on this base if it has no non-virtual bases (Ann.: why?) } + if BaseBaseList = nil then + Continue; + + { Search the base classes of this base recursively } + if LocateCppBaseClass(BaseBaseList, False, BaseName, Ptr) then + begin + Addr := Ptr; { Match --> return the adjusted pointer to the caller } + Result := True; + Exit; + end; + end; +end; + +function CppGetBase(var Obj: Pointer; TypeDesc: PCppTypeId; + BaseName: PAnsiChar): Boolean; +var + BaseList, VBaseList: PCppBaseList; +begin + if {$IFDEF DEPRECATED_SYSUTILS_ANSISTRINGS}System.AnsiStrings.{$ENDIF}StrComp(PAnsiChar(PByte(TypeDesc) + TypeDesc.tpName), BaseName) = 0 then + { a class can be considered its own base } + Result := True + else if (TypeDesc.tpMask and TM_IS_CLASS) <> 0 then + begin + { iterate through the base classes } + BaseList := PCppBaseList(PByte(TypeDesc) + TypeDesc.tpcBaseList); + VBaseList := PCppBaseList(PByte(TypeDesc) + TypeDesc.tpcVbasList); + Result := LocateCppBaseClass(BaseList, False, BaseName, Obj) + or LocateCppBaseClass(VBaseList, False, BaseName, Obj); + end + else + Result := False; { Don't be surprised. C++ permits to throw every type. } +end; + +type + EOpenException = class(Exception); + +function CppExceptObjProc(P: PExceptionRecord): Exception; +type + { Function pointer to std::type_info::what(). + In the Dinkumware library, std::exception::what() always has the + __cdecl calling convention. } + TCppTypeInfoWhatMethod = function(This: Pointer): PAnsiChar; cdecl; +var + ExcTypeName: PAnsiChar; + ExcDesc: PCppExceptDesc; + ExcObject: Pointer; + ExcObjectVTbl: Pointer; + WhatMethod: TCppTypeInfoWhatMethod; +begin + Result := nil; + case P.ExceptionCode of + $0EEFFACE: { C++ exception } + begin + { When a C++ exception is thrown, the C++ compiler (indirectly) calls the + tossAnException function defined in xx.cpp. The Win32 exception argument + table is filled in line 1096ff as follows: + + argTable[0] = (unsigned long)(void __far *)__throwExceptionName; + argTable[1] = (unsigned long)(void __far *)throwPC; + argTable[2] = (unsigned long)(void __far *)xdp; // : PCppExceptDesc } + + ExcTypeName := PAnsiChar(P.ExceptionInformation[0]); + ExcDesc := PCppExceptDesc(P.ExceptionInformation[2]); + ExcObject := Pointer(@ExcDesc.xdValue); + + if CppGetBase(ExcObject, ExcDesc.xdTypeID, 'std::exception') then + begin + { The exception object is a std::exception subclass and implements + the virtual member function what(). } + ExcObjectVTbl := Pointer(PCardinal(ExcObject)^); + WhatMethod := TCppTypeInfoWhatMethod(PCardinal( + Cardinal(ExcObjectVTbl) + SizeOf(Pointer))^); + Result := EJclCppStdException.Create(ExcObject, String(WhatMethod(ExcObject)), + PAnsiChar(ExcTypeName), Pointer(ExcDesc)); + end + else + { The exception object has some other type. We cannot extract an + exception message with reasonable efforts. } + Result := EJclCppException.CreateTypeNamed(PAnsiChar(ExcTypeName), Pointer(ExcDesc)); + end; + end; + {$IFDEF COMPILER12_UP} + if Result <> nil then + EOpenException(Result).RaisingException(P); + {$ENDIF COMPILER12_UP} +end; + +var + HookInstalled: Boolean = False; + +procedure JclInstallCppExceptionFilter; +begin + Assert(JclHookExcept.JclExceptionsHooked, + 'Cannot install C++ exception filter: call JclHookExcept.JclHookExceptions() first!'); + if HookInstalled then + Exit; + HookInstalled := JclHookExcept.JclAddExceptFilter(@CppExceptObjProc, npFirstChain); + if HookInstalled then + begin + {$IFDEF COMPILER12_UP} // TODO: this may be supported for earlier versions of Delphi/C++Builder + OldAcquireExceptionProc := System.ExceptionAcquired; + System.ExceptionAcquired := @ExceptionAcquiredProc; + {$ENDIF COMPILER12_UP} + + OldRaiseExceptionProc := System.RaiseExceptionProc; + {$IFDEF CPU32} + System.RaiseExceptionProc := @RaiseExceptionProc; + {$ELSE} + System.RaiseExceptionProc := RaiseExceptionProc; + {$ENDIF CPU32} + end; +end; + +procedure JclUninstallCppExceptionFilter; +begin + if not HookInstalled then + Exit; + {$IFDEF COMPILER12_UP} // TODO: this may be supported for earlier versions of Delphi/C++Builder + System.ExceptionAcquired := OldAcquireExceptionProc; + {$ENDIF COMPILER12_UP} + {$IFDEF CPU32} + System.RaiseExceptionProc := @OldRaiseExceptionProc; + {$ELSE} + System.RaiseExceptionProc := OldRaiseExceptionProc; + {$ENDIF CPU32} + JclHookExcept.JclRemoveExceptFilter(@CppExceptObjProc); + HookInstalled := False; +end; + +function JclCppExceptionFilterInstalled: Boolean; +begin + Result := HookInstalled; +end; + +{$ENDIF BORLAND} + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/windows/JclDebug.pas b/3rdParty/JCL/source/windows/JclDebug.pas index 7b269db2..6fac9e97 100644 --- a/3rdParty/JCL/source/windows/JclDebug.pas +++ b/3rdParty/JCL/source/windows/JclDebug.pas @@ -99,7 +99,7 @@ TJclModuleInfoList = class(TObjectList) FDynamicBuild: Boolean; FSystemModulesOnly: Boolean; FRefCount: Integer; - function GetItems(Index: Integer): TJclModuleInfo; + function GetItems(Index: TJclListSize): TJclModuleInfo; function GetModuleFromAddress(Addr: Pointer): TJclModuleInfo; protected procedure BuildModulesList; @@ -110,7 +110,7 @@ TJclModuleInfoList = class(TObjectList) function IsSystemModuleAddress(Addr: Pointer): Boolean; function IsValidModuleAddress(Addr: Pointer): Boolean; property DynamicBuild: Boolean read FDynamicBuild; - property Items[Index: Integer]: TJclModuleInfo read GetItems; + property Items[Index: TJclListSize]: TJclModuleInfo read GetItems; property ModuleFromAddress[Addr: Pointer]: TJclModuleInfo read GetModuleFromAddress; end; @@ -495,7 +495,7 @@ TJclDebugInfoSourceClass = class of TJclDebugInfoSource; TJclDebugInfoList = class(TObjectList) private function GetItemFromModule(const Module: HMODULE): TJclDebugInfoSource; - function GetItems(Index: Integer): TJclDebugInfoSource; + function GetItems(Index: TJclListSize): TJclDebugInfoSource; protected function CreateDebugInfo(const Module: HMODULE): TJclDebugInfoSource; public @@ -508,7 +508,7 @@ TJclDebugInfoList = class(TObjectList) class procedure NeedInfoSourceClassList; function GetLocationInfo(const Addr: Pointer; out Info: TJclLocationInfo): Boolean; property ItemFromModule[const Module: HMODULE]: TJclDebugInfoSource read GetItemFromModule; - property Items[Index: Integer]: TJclDebugInfoSource read GetItems; + property Items[Index: TJclListSize]: TJclDebugInfoSource read GetItems; end; // Various source location implementations @@ -688,7 +688,7 @@ TJclStackInfoList = class(TJclStackBaseList) {$IFDEF CPU64} procedure CaptureBackTrace; {$ENDIF CPU64} - function GetItems(Index: Integer): TJclStackInfoItem; + function GetItems(Index: TJclListSize): TJclStackInfoItem; function NextStackFrame(var StackFrame: PStackFrame; var StackInfo: TStackInfo): Boolean; procedure StoreToList(const StackInfo: TStackInfo); procedure TraceStackFrames; @@ -715,7 +715,7 @@ TJclStackInfoList = class(TJclStackBaseList) IncludeAddressOffset: Boolean = False; IncludeStartProcLineOffset: Boolean = False; IncludeVAddress: Boolean = False); property DelayedTrace: Boolean read FDelayedTrace; - property Items[Index: Integer]: TJclStackInfoItem read GetItems; default; + property Items[Index: TJclListSize]: TJclStackInfoItem read GetItems; default; property IgnoreLevels: Integer read FIgnoreLevels; property Count: Integer read GetCount; property Raw: Boolean read FRaw; @@ -812,13 +812,13 @@ TJclExceptFrame = class(TObject) TJclExceptFrameList = class(TJclStackBaseList) private FIgnoreLevels: Integer; - function GetItems(Index: Integer): TJclExceptFrame; + function GetItems(Index: TJclListSize): TJclExceptFrame; protected function AddFrame(AFrame: PExcFrame): TJclExceptFrame; public constructor Create(AIgnoreLevels: Integer); procedure TraceExceptionFrames; - property Items[Index: Integer]: TJclExceptFrame read GetItems; + property Items[Index: TJclListSize]: TJclExceptFrame read GetItems; property IgnoreLevels: Integer read FIgnoreLevels write FIgnoreLevels; end; @@ -1303,7 +1303,7 @@ function TJclModuleInfoList.CreateItemForAddress(Addr: Pointer; SystemModule: Bo Add(Result); end; -function TJclModuleInfoList.GetItems(Index: Integer): TJclModuleInfo; +function TJclModuleInfoList.GetItems(Index: TJclListSize): TJclModuleInfo; begin Result := TJclModuleInfo(Get(Index)); end; @@ -3987,7 +3987,7 @@ function TJclDebugInfoList.GetItemFromModule(const Module: HMODULE): TJclDebugIn end; end; -function TJclDebugInfoList.GetItems(Index: Integer): TJclDebugInfoSource; +function TJclDebugInfoList.GetItems(Index: TJclListSize): TJclDebugInfoSource; begin Result := TJclDebugInfoSource(Get(Index)); end; @@ -5577,7 +5577,9 @@ function GetThreadTopOfStack(ThreadHandle: THandle): TJclAddr; TBI: THREAD_BASIC_INFORMATION; ReturnedLength: ULONG; begin + {$IFNDEF COMPILER37_UP} Result := 0; + {$ENDIF ~COMPILER37_UP} ReturnedLength := 0; if (NtQueryInformationThread(ThreadHandle, ThreadBasicInformation, @TBI, SizeOf(TBI), @ReturnedLength) < $80000000) and (ReturnedLength = SizeOf(TBI)) then @@ -5816,7 +5818,7 @@ procedure TJclStackInfoList.AddToStrings(Strings: TStrings; IncludeModuleName, I end; end; -function TJclStackInfoList.GetItems(Index: Integer): TJclStackInfoItem; +function TJclStackInfoList.GetItems(Index: TJclListSize): TJclStackInfoItem; begin ForceStackTracing; Result := TJclStackInfoItem(Get(Index)); @@ -6833,7 +6835,7 @@ function TJclExceptFrameList.AddFrame(AFrame: PExcFrame): TJclExceptFrame; Add(Result); end; -function TJclExceptFrameList.GetItems(Index: Integer): TJclExceptFrame; +function TJclExceptFrameList.GetItems(Index: TJclListSize): TJclExceptFrame; begin Result := TJclExceptFrame(Get(Index)); end; diff --git a/3rdParty/JCL/source/windows/JclDebugSerialization.pas b/3rdParty/JCL/source/windows/JclDebugSerialization.pas new file mode 100644 index 00000000..7f38f8cd --- /dev/null +++ b/3rdParty/JCL/source/windows/JclDebugSerialization.pas @@ -0,0 +1,765 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclDebugSerialization.pas. } +{ } +{ The Initial Developer of the Original Code is Uwe Schuster. } +{ Portions created by Uwe Schuster are Copyright (C) 2009 Uwe Schuster. All rights reserved. } +{ } +{ Contributor(s): } +{ Uwe Schuster (uschuster) } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclDebugSerialization; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, System.Classes, System.Contnrs, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, Classes, Contnrs, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclDebug; + +type + TJclCustomSimpleSerializer = class(TObject) + protected + FItems: TObjectList; + FName: string; + FValues: TStringList; + function GetCount: Integer; + function GetItems(AIndex: Integer): TJclCustomSimpleSerializer; + public + constructor Create(const AName: string); + destructor Destroy; override; + function AddChild(ASender: TObject; const AName: string): TJclCustomSimpleSerializer; + procedure Clear; + function ReadString(ASender: TObject; const AName: string): string; + procedure WriteString(ASender: TObject; const AName: string; const AValue: string); + property Count: Integer read GetCount; + property Items[AIndex: Integer]: TJclCustomSimpleSerializer read GetItems; default; + property Name: string read FName; + property Values: TStringList read FValues; + end; + + TJclSerializableLocationInfo = class(TJclLocationInfoEx) + public + procedure Deserialize(ASerializer: TJclCustomSimpleSerializer); + procedure Serialize(ASerializer: TJclCustomSimpleSerializer); + end; + + TJclSerializableLocationInfoList = class(TJclCustomLocationInfoList) + private + function GetItems(AIndex: Integer): TJclSerializableLocationInfo; + public + constructor Create; override; + function Add(Addr: Pointer): TJclSerializableLocationInfo; + procedure Deserialize(ASerializer: TJclCustomSimpleSerializer); + procedure Serialize(ASerializer: TJclCustomSimpleSerializer); + property Items[AIndex: Integer]: TJclSerializableLocationInfo read GetItems; default; + end; + + TJclSerializableThreadInfo = class(TJclCustomThreadInfo) + private + function GetStack(const AIndex: Integer): TJclSerializableLocationInfoList; + protected + function GetStackClass: TJclCustomLocationInfoListClass; override; + public + constructor Create; + destructor Destroy; override; + procedure Deserialize(ASerializer: TJclCustomSimpleSerializer); + procedure Serialize(ASerializer: TJclCustomSimpleSerializer); + property CreationStack: TJclSerializableLocationInfoList index 1 read GetStack; + property Stack: TJclSerializableLocationInfoList index 2 read GetStack; + end; + + TJclSerializableThreadInfoList = class(TPersistent) + private + FItems: TObjectList; + function GetItems(AIndex: Integer): TJclSerializableThreadInfo; + function GetCount: Integer; + public + constructor Create; + destructor Destroy; override; + function Add: TJclSerializableThreadInfo; + procedure Assign(Source: TPersistent); override; + procedure Clear; + procedure Deserialize(ASerializer: TJclCustomSimpleSerializer); + procedure Serialize(ASerializer: TJclCustomSimpleSerializer); + property Count: Integer read GetCount; + property Items[AIndex: Integer]: TJclSerializableThreadInfo read GetItems; default; + end; + + TJclSerializableException = class(TPersistent) + private + FExceptionClassName: string; + FExceptionMessage: string; + protected + procedure AssignTo(Dest: TPersistent); override; + public + procedure Clear; + procedure Deserialize(ASerializer: TJclCustomSimpleSerializer); + procedure Serialize(ASerializer: TJclCustomSimpleSerializer); + property ExceptionClassName: string read FExceptionClassName write FExceptionClassName; + property ExceptionMessage: string read FExceptionMessage write FExceptionMessage; + end; + + TJclSerializableModuleInfo = class(TPersistent) + private + FStartStr: string; + FEndStr: string; + FSystemModuleStr: string; + FModuleName: string; + FBinFileVersion: string; + FFileVersion: string; + FFileDescription: string; + protected + procedure AssignTo(Dest: TPersistent); override; + public + procedure Deserialize(ASerializer: TJclCustomSimpleSerializer); + procedure Serialize(ASerializer: TJclCustomSimpleSerializer); + property StartStr: string read FStartStr write FStartStr; + property EndStr: string read FEndStr write FEndStr; + property SystemModuleStr: string read FSystemModuleStr write FSystemModuleStr; + property ModuleName: string read FModuleName write FModuleName; + property BinFileVersion: string read FBinFileVersion write FBinFileVersion; + property FileVersion: string read FFileVersion write FFileVersion; + property FileDescription: string read FFileDescription write FFileDescription; + end; + + TJclSerializableModuleInfoList = class(TPersistent) + private + FItems: TObjectList; + function GetCount: Integer; + function GetItems(AIndex: Integer): TJclSerializableModuleInfo; + protected + procedure AssignTo(Dest: TPersistent); override; + public + constructor Create; + destructor Destroy; override; + function Add: TJclSerializableModuleInfo; + procedure Clear; + procedure Deserialize(ASerializer: TJclCustomSimpleSerializer); + procedure Serialize(ASerializer: TJclCustomSimpleSerializer); + property Count: Integer read GetCount; + property Items[AIndex: Integer]: TJclSerializableModuleInfo read GetItems; default; + end; + + TJclSerializableExceptionInfo = class(TObject) + private + FException: TJclSerializableException; + FThreadInfoList: TJclSerializableThreadInfoList; + FModules: TJclSerializableModuleInfoList; + public + constructor Create; + destructor Destroy; override; + procedure Deserialize(ASerializer: TJclCustomSimpleSerializer); + procedure Serialize(ASerializer: TJclCustomSimpleSerializer); + property ThreadInfoList: TJclSerializableThreadInfoList read FThreadInfoList; + property Exception: TJclSerializableException read FException; + property Modules: TJclSerializableModuleInfoList read FModules; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + JclDateTime; + +const + MinutesPerDay = 60 * 24; + +{ TODO -oUSc : move to JclDateTime } +function ISOFormatStrToDateTime(const AISOFormatTimeStampStr: string; ADefault: TDateTime): TDateTime; +var + Year, Month, Day, Hour, Minute, Second: Word; +begin + Result := ADefault; + { TODO -oUSc : make it more generics to accept for exam. milliseconds } + if (Length(AISOFormatTimeStampStr) = 25) or ((Length(AISOFormatTimeStampStr) = 20) and + (AISOFormatTimeStampStr[20] = 'Z')) then + begin + if (AISOFormatTimeStampStr[5] = '-') and (AISOFormatTimeStampStr[8] = '-') and + (AISOFormatTimeStampStr[11] = 'T') and (AISOFormatTimeStampStr[14] = ':') and + (AISOFormatTimeStampStr[17] = ':') then + begin + Year := StrToInt(Copy(AISOFormatTimeStampStr, 1, 4)); + Month := StrToInt(Copy(AISOFormatTimeStampStr, 6, 2)); + Day := StrToInt(Copy(AISOFormatTimeStampStr, 9, 2)); + Hour := StrToInt(Copy(AISOFormatTimeStampStr, 12, 2)); + Minute := StrToInt(Copy(AISOFormatTimeStampStr, 15, 2)); + Second := StrToInt(Copy(AISOFormatTimeStampStr, 18, 2)); + Result := EncodeDate(Year, Month, Day) + EncodeTime(Hour, Minute, Second, 0); + end; + end; +end; + +function ISOFormatStrToLocalDateTime(const AISOFormatTimeStampStr: string; ADefault: TDateTime): TDateTime; +begin + Result := ISOFormatStrToDateTime(AISOFormatTimeStampStr, ADefault); + Result := DateTimeToLocalDateTime(Result); +end; + +function DateTimeToISOFormatStr(ATimeStamp: TDateTime; ABias: Longint): string; +var + TimeZoneAsDateTime: TDateTime; + S: string; +begin + Result := FormatDateTime('yyyy-mm-dd"T"hh:nn:ss', ATimeStamp); + TimeZoneAsDateTime := ABias / MinutesPerDay; + S := FormatDateTime('hh:nn', Abs(TimeZoneAsDateTime)); + if ABias > 0 then + Result := Result + '+' + S + else + if ABias = 0 then + Result := Result + 'Z' + else + Result := Result + '-' + S; +end; + +function LocalDateTimeToISOFormatStr(ATimeStamp: TDateTime): string; +var + UTCTimeStamp, TimeZoneAsDateTime: TDateTime; +begin + UTCTimeStamp := LocalDateTimeToDateTime(ATimeStamp); + TimeZoneAsDateTime := ATimeStamp - UTCTimeStamp; + Result := DateTimeToISOFormatStr(UTCTimeStamp, Round(TimeZoneAsDateTime * MinutesPerDay)); +end; + +//=== { TJclCustomSimpleSerializer } ========================================= + +constructor TJclCustomSimpleSerializer.Create(const AName: string); +begin + inherited Create; + FItems := TObjectList.Create; + FName := AName; + FValues := TStringList.Create; +end; + +destructor TJclCustomSimpleSerializer.Destroy; +begin + FValues.Free; + FItems.Free; + inherited Destroy; +end; + +function TJclCustomSimpleSerializer.AddChild(ASender: TObject; const AName: string): TJclCustomSimpleSerializer; +begin + FItems.Add(TJclCustomSimpleSerializer.Create(AName)); + Result := TJclCustomSimpleSerializer(FItems.Last); +end; + +procedure TJclCustomSimpleSerializer.Clear; +begin + FItems.Clear; + FValues.Clear; + FName := ''; +end; + +function TJclCustomSimpleSerializer.GetCount: Integer; +begin + Result := FItems.Count; +end; + +function TJclCustomSimpleSerializer.GetItems(AIndex: Integer): TJclCustomSimpleSerializer; +begin + Result := TJclCustomSimpleSerializer(FItems[AIndex]); +end; + +function TJclCustomSimpleSerializer.ReadString(ASender: TObject; const AName: string): string; +begin + Result := FValues.Values[AName]; +end; + +procedure TJclCustomSimpleSerializer.WriteString(ASender: TObject; const AName: string; const AValue: string); +begin + FValues.Add(Format('%s=%s', [AName, AValue])); +end; + +//=== { TJclSerializableThreadInfoList } ===================================== + +constructor TJclSerializableThreadInfoList.Create; +begin + inherited Create; + FItems := TObjectList.Create; +end; + +destructor TJclSerializableThreadInfoList.Destroy; +begin + FItems.Free; + inherited Destroy; +end; + +function TJclSerializableThreadInfoList.Add: TJclSerializableThreadInfo; +begin + FItems.Add(TJclSerializableThreadInfo.Create); + Result := TJclSerializableThreadInfo(FItems.Last); +end; + +procedure TJclSerializableThreadInfoList.Assign(Source: TPersistent); +var + I: Integer; +begin + if Source is TJclThreadInfoList then + begin + Clear; + for I := 0 to TJclThreadInfoList(Source).Count - 1 do + Add.Assign(TJclThreadInfoList(Source)[I]); + end + else + inherited Assign(Source); +end; + +procedure TJclSerializableThreadInfoList.Clear; +begin + FItems.Clear; +end; + +function TJclSerializableThreadInfoList.GetCount: Integer; +begin + Result := FItems.Count; +end; + +function TJclSerializableThreadInfoList.GetItems(AIndex: Integer): TJclSerializableThreadInfo; +begin + Result := TJclSerializableThreadInfo(FItems[AIndex]); +end; + +procedure TJclSerializableThreadInfoList.Deserialize(ASerializer: TJclCustomSimpleSerializer); +var + I: Integer; +begin + Clear; + for I := 0 to ASerializer.Count - 1 do + if ASerializer[I].Name = 'ThreadInfo' then + Add.Deserialize(ASerializer[I]); +end; + +procedure TJclSerializableThreadInfoList.Serialize(ASerializer: TJclCustomSimpleSerializer); +var + I: Integer; +begin + for I := 0 to Count - 1 do + Items[I].Serialize(ASerializer.AddChild(Self, 'ThreadInfo')); +end; + +//=== { TJclSerializableLocationInfo } ======================================= + +procedure TJclSerializableLocationInfo.Deserialize(ASerializer: TJclCustomSimpleSerializer); +var + S, SOffsetFromProcName, SLineNumberOffsetFromProcedureStart: string; +begin + Values := []; + SOffsetFromProcName := ASerializer.ReadString(Self, 'OffsetFromProcName'); + if SOffsetFromProcName <> '' then + Values := Values + [lievLocationInfo]; + SLineNumberOffsetFromProcedureStart := ASerializer.ReadString(Self, 'LineNumberOffsetFromProcedureStart'); + if SLineNumberOffsetFromProcedureStart <> '' then + Values := Values + [lievProcedureStartLocationInfo]; + S := ASerializer.ReadString(Self, 'VAddress'); + VAddress := Pointer(StrToIntDef('$' + S, 0)); + ModuleName := ASerializer.ReadString(Self, 'ModuleName'); + S := ASerializer.ReadString(Self, 'Address'); + Address := Pointer(StrToIntDef('$' + S, 0)); + OffsetFromProcName := StrToIntDef('$' + SOffsetFromProcName, 0); + SourceUnitName := ASerializer.ReadString(Self, 'UnitName'); + ProcedureName := ASerializer.ReadString(Self, 'ProcedureName'); + SourceName := ASerializer.ReadString(Self, 'SourceName'); + S := ASerializer.ReadString(Self, 'LineNumber'); + LineNumber := StrToIntDef(S, -1); + S := ASerializer.ReadString(Self, 'OffsetFromLineNumber'); + OffsetFromLineNumber := StrToIntDef(S, -1); + LineNumberOffsetFromProcedureStart := StrToIntDef(SLineNumberOffsetFromProcedureStart, -1); + UnitVersionDateTime := ISOFormatStrToDateTime(ASerializer.ReadString(Self, 'UnitVersionDateTime'), 0); + UnitVersionExtra := ASerializer.ReadString(Self, 'UnitVersionExtra'); + UnitVersionLogPath := ASerializer.ReadString(Self, 'UnitVersionLogPath'); + UnitVersionRCSfile := ASerializer.ReadString(Self, 'UnitVersionRCSfile'); + UnitVersionRevision := ASerializer.ReadString(Self, 'UnitVersionRevision'); +end; + +procedure TJclSerializableLocationInfo.Serialize(ASerializer: TJclCustomSimpleSerializer); +var + S: string; +begin + S := ''; + ASerializer.WriteString(Self, 'VAddress', Format('%p', [VAddress])); + ASerializer.WriteString(Self, 'ModuleName', ModuleName); + ASerializer.WriteString(Self, 'Address', Format('%p', [Address])); + if lievLocationInfo in Values then + begin + ASerializer.WriteString(Self, 'OffsetFromProcName', Format('+ $%x', [OffsetFromProcName])); + ASerializer.WriteString(Self, 'UnitName', SourceUnitName); + ASerializer.WriteString(Self, 'ProcedureName', ProcedureName); + ASerializer.WriteString(Self, 'SourceName', SourceName); + if LineNumber > 0 then + begin + ASerializer.WriteString(Self, 'LineNumber', IntToStr(LineNumber)); + if OffsetFromLineNumber >= 0 then + S := S + Format('+ $%x', [OffsetFromLineNumber]) + else + S := S + Format('- $%x', [-OffsetFromLineNumber]); + ASerializer.WriteString(Self, 'OffsetFromLineNumber', S); + end; + if lievProcedureStartLocationInfo in Values then + ASerializer.WriteString(Self, 'LineNumberOffsetFromProcedureStart', IntToStr(LineNumberOffsetFromProcedureStart)); + end; + if lievUnitVersionInfo in Values then + begin + ASerializer.WriteString(Self, 'UnitVersionDateTime', DateTimeToISOFormatStr(UnitVersionDateTime, 0)); + ASerializer.WriteString(Self, 'UnitVersionExtra', UnitVersionExtra); + ASerializer.WriteString(Self, 'UnitVersionLogPath', UnitVersionLogPath); + ASerializer.WriteString(Self, 'UnitVersionRCSfile', UnitVersionRCSfile); + ASerializer.WriteString(Self, 'UnitVersionRevision', UnitVersionRevision); + end; +end; + +//=== { TJclSerializableLocationInfoList } =================================== + +function TJclSerializableLocationInfoList.Add(Addr: Pointer): TJclSerializableLocationInfo; +begin + Result := TJclSerializableLocationInfo(InternalAdd(Addr)); +end; + +constructor TJclSerializableLocationInfoList.Create; +begin + inherited Create; + FItemClass := TJclSerializableLocationInfo; + FOptions := []; +end; + +function TJclSerializableLocationInfoList.GetItems(AIndex: Integer): TJclSerializableLocationInfo; +begin + Result := TJclSerializableLocationInfo(FItems[AIndex]); +end; + +procedure TJclSerializableLocationInfoList.Deserialize(ASerializer: TJclCustomSimpleSerializer); +var + I: Integer; +begin + Clear; + for I := 0 to ASerializer.Count - 1 do + if ASerializer[I].Name = 'LocationInfo' then + Add(nil).Deserialize(ASerializer[I]); +end; + +procedure TJclSerializableLocationInfoList.Serialize(ASerializer: TJclCustomSimpleSerializer); +var + I: Integer; +begin + for I := 0 to Count - 1 do + Items[I].Serialize(ASerializer.AddChild(Self, 'LocationInfo')); +end; + +//=== { TJclSerializableThreadInfo } ========================================= + +constructor TJclSerializableThreadInfo.Create; +begin + inherited Create; +end; + +destructor TJclSerializableThreadInfo.Destroy; +begin + inherited Destroy; +end; + +function TJclSerializableThreadInfo.GetStack(const AIndex: Integer): TJclSerializableLocationInfoList; +begin + case AIndex of + 1: Result := TJclSerializableLocationInfoList(FCreationStack); + 2: Result := TJclSerializableLocationInfoList(FStack); + else + Result := nil; + end; +end; + +function TJclSerializableThreadInfo.GetStackClass: TJclCustomLocationInfoListClass; +begin + Result := TJclSerializableLocationInfoList; +end; + +procedure TJclSerializableThreadInfo.Deserialize(ASerializer: TJclCustomSimpleSerializer); +var + S: string; + I: Integer; +begin + Values := []; + S := ASerializer.ReadString(Self, 'ThreadID'); + ThreadID := StrToIntDef(S, 0); + if ASerializer.ReadString(Self, 'MainThread') = '1' then + Values := Values + [tioIsMainThread]; + S := ASerializer.ReadString(Self, 'Name'); + if S <> '' then + begin + Name := S; + Values := Values + [tioName]; + end; + S := ASerializer.ReadString(Self, 'CreationTime'); + if S <> '' then + begin + CreationTime := ISOFormatStrToLocalDateTime(S, 0); + if CreationTime > 0 then + Values := Values + [tioCreationTime]; + end; + S := ASerializer.ReadString(Self, 'ParentThreadID'); + if S <> '' then + begin + ParentThreadID := StrToIntDef(S, 0); + if ParentThreadID <> 0 then + Values := Values + [tioParentThreadID]; + end; + for I := 0 to ASerializer.Count - 1 do + if ASerializer[I].Name = 'Stack' then + begin + Stack.Deserialize(ASerializer[I]); + Values := Values + [tioStack]; + end + else + if ASerializer[I].Name = 'CreationStack' then + begin + CreationStack.Deserialize(ASerializer[I]); + Values := Values + [tioCreationStack]; + end; +end; + +procedure TJclSerializableThreadInfo.Serialize(ASerializer: TJclCustomSimpleSerializer); +begin + ASerializer.WriteString(Self, 'ThreadID', IntToStr(ThreadID)); + if tioIsMainThread in Values then + ASerializer.WriteString(Self, 'MainThread', '1'); + if tioName in Values then + ASerializer.WriteString(Self, 'Name', Name); + if tioCreationTime in Values then + ASerializer.WriteString(Self, 'CreationTime', LocalDateTimeToISOFormatStr(CreationTime)); + if tioParentThreadID in Values then + ASerializer.WriteString(Self, 'ParentThreadID', IntToStr(ParentThreadID)); + if tioStack in Values then + Stack.Serialize(ASerializer.AddChild(Self, 'Stack')); + if tioCreationStack in Values then + CreationStack.Serialize(ASerializer.AddChild(Self, 'CreationStack')); +end; + +//=== { TExceptionInfo } ===================================================== + +constructor TJclSerializableExceptionInfo.Create; +begin + inherited Create; + FException := TJclSerializableException.Create; + FThreadInfoList := TJclSerializableThreadInfoList.Create; + FModules := TJclSerializableModuleInfoList.Create; +end; + +destructor TJclSerializableExceptionInfo.Destroy; +begin + FModules.Free; + FException.Free; + FThreadInfoList.Free; + inherited Destroy; +end; + +procedure TJclSerializableExceptionInfo.Deserialize(ASerializer: TJclCustomSimpleSerializer); +var + I: Integer; +begin + FThreadInfoList.Clear; + FException.Clear; + FModules.Clear; + for I := 0 to ASerializer.Count - 1 do + if ASerializer[I].Name = 'ThreadInfo' then + FThreadInfoList.Deserialize(ASerializer[I]) + else + if ASerializer[I].Name = 'Exception' then + FException.Deserialize(ASerializer[I]) + else + if ASerializer[I].Name = 'Modules' then + FModules.Deserialize(ASerializer[I]); +end; + +procedure TJclSerializableExceptionInfo.Serialize(ASerializer: TJclCustomSimpleSerializer); +begin + FThreadInfoList.Serialize(ASerializer.AddChild(Self, 'ThreadInfo')); + FException.Serialize(ASerializer.AddChild(Self, 'Exception')); + FModules.Serialize(ASerializer.AddChild(Self, 'Modules')); +end; + +//=== { TException } ========================================================= + +procedure TJclSerializableException.AssignTo(Dest: TPersistent); +begin + if Dest is TJclSerializableException then + begin + TJclSerializableException(Dest).FExceptionClassName := FExceptionClassName; + TJclSerializableException(Dest).FExceptionMessage := FExceptionMessage; + end + else + inherited AssignTo(Dest); +end; + +procedure TJclSerializableException.Clear; +begin + FExceptionClassName := ''; + FExceptionMessage := ''; +end; + +procedure TJclSerializableException.Deserialize(ASerializer: TJclCustomSimpleSerializer); +begin + Clear; + FExceptionClassName := ASerializer.ReadString(Self, 'ClassName'); + FExceptionMessage := ASerializer.ReadString(Self, 'Message'); +end; + +procedure TJclSerializableException.Serialize(ASerializer: TJclCustomSimpleSerializer); +begin + ASerializer.WriteString(Self, 'ClassName', FExceptionClassName); + ASerializer.WriteString(Self, 'Message', FExceptionMessage); +end; + +//=== { TModule } ============================================================ + +procedure TJclSerializableModuleInfo.AssignTo(Dest: TPersistent); +begin + if Dest is TJclSerializableModuleInfo then + begin + TJclSerializableModuleInfo(Dest).FStartStr := FStartStr; + TJclSerializableModuleInfo(Dest).FEndStr := FEndStr; + TJclSerializableModuleInfo(Dest).FSystemModuleStr := FSystemModuleStr; + TJclSerializableModuleInfo(Dest).FModuleName := FModuleName; + TJclSerializableModuleInfo(Dest).FBinFileVersion := FBinFileVersion; + TJclSerializableModuleInfo(Dest).FFileVersion := FFileVersion; + TJclSerializableModuleInfo(Dest).FFileDescription := FFileDescription; + end + else + inherited AssignTo(Dest); +end; + +procedure TJclSerializableModuleInfo.Deserialize(ASerializer: TJclCustomSimpleSerializer); +begin + FStartStr := ASerializer.ReadString(Self, 'StartAddr'); + FEndStr := ASerializer.ReadString(Self, 'EndAddr'); + FSystemModuleStr := ASerializer.ReadString(Self, 'SystemModule'); + FModuleName := ASerializer.ReadString(Self, 'FileName'); + FBinFileVersion := ASerializer.ReadString(Self, 'BinFileVersion'); + FFileVersion := ASerializer.ReadString(Self, 'FileVersion'); + FFileDescription := ASerializer.ReadString(Self, 'FileDescription'); +end; + +procedure TJclSerializableModuleInfo.Serialize(ASerializer: TJclCustomSimpleSerializer); +begin + ASerializer.WriteString(Self, 'StartAddr', FStartStr); + ASerializer.WriteString(Self, 'EndAddr', FEndStr); + ASerializer.WriteString(Self, 'SystemModule', FSystemModuleStr); + ASerializer.WriteString(Self, 'FileName', FModuleName); + ASerializer.WriteString(Self, 'BinFileVersion', FBinFileVersion); + ASerializer.WriteString(Self, 'FileVersion', FFileVersion); + ASerializer.WriteString(Self, 'FileDescription', FFileDescription); +end; + +//=== { TModuleList } ======================================================== + +constructor TJclSerializableModuleInfoList.Create; +begin + inherited Create; + FItems := TObjectList.Create; +end; + +destructor TJclSerializableModuleInfoList.Destroy; +begin + FItems.Free; + inherited Destroy; +end; + +function TJclSerializableModuleInfoList.Add: TJclSerializableModuleInfo; +begin + FItems.Add(TJclSerializableModuleInfo.Create); + Result := TJclSerializableModuleInfo(FItems.Last); +end; + +procedure TJclSerializableModuleInfoList.AssignTo(Dest: TPersistent); +var + I: Integer; +begin + if Dest is TJclSerializableModuleInfoList then + begin + TJclSerializableModuleInfoList(Dest).Clear; + for I := 0 to Count - 1 do + TJclSerializableModuleInfoList(Dest).Add.Assign(TJclSerializableModuleInfo(FItems[I])); + end + else + inherited AssignTo(Dest); +end; + +procedure TJclSerializableModuleInfoList.Clear; +begin + FItems.Clear; +end; + +function TJclSerializableModuleInfoList.GetCount: Integer; +begin + Result := FItems.Count; +end; + +function TJclSerializableModuleInfoList.GetItems(AIndex: Integer): TJclSerializableModuleInfo; +begin + Result := TJclSerializableModuleInfo(FItems[AIndex]); +end; + +procedure TJclSerializableModuleInfoList.Deserialize(ASerializer: TJclCustomSimpleSerializer); +var + I: Integer; +begin + Clear; + for I := 0 to ASerializer.Count - 1 do + if ASerializer[I].Name = 'Module' then + Add.Deserialize(ASerializer[I]); +end; + +procedure TJclSerializableModuleInfoList.Serialize(ASerializer: TJclCustomSimpleSerializer); +var + I: Integer; +begin + for I := 0 to Count - 1 do + Items[I].Serialize(ASerializer.AddChild(Self, 'Module')); +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/JclDebugXMLDeserializer.pas b/3rdParty/JCL/source/windows/JclDebugXMLDeserializer.pas new file mode 100644 index 00000000..4a4bf391 --- /dev/null +++ b/3rdParty/JCL/source/windows/JclDebugXMLDeserializer.pas @@ -0,0 +1,102 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclDebugXMLDeserializer.pas. } +{ } +{ The Initial Developer of the Original Code is Uwe Schuster. } +{ Portions created by Uwe Schuster are Copyright (C) 2009 Uwe Schuster. All rights reserved. } +{ } +{ Contributor(s): } +{ Uwe Schuster (uschuster) } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclDebugXMLDeserializer; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclDebugSerialization, JclSimpleXml; + +type + TJclXMLDeserializer = class(TJclCustomSimpleSerializer) + public + procedure LoadFromString(const AValue: string); + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +//=== { TJclXMLDeserializer } ================================================ + +procedure TJclXMLDeserializer.LoadFromString(const AValue: string); + + procedure AddItems(ASerializer: TJclCustomSimpleSerializer; AElem: TJclSimpleXMLElem); + var + I: Integer; + begin + for I := 0 to AElem.Properties.Count - 1 do + ASerializer.Values.Add(Format('%s=%s', [AElem.Properties[I].Name, AElem.Properties[I].Value])); + for I := 0 to AElem.Items.Count - 1 do + AddItems(ASerializer.AddChild(nil, AElem.Items[I].Name), AElem.Items[I]) + end; + +var + XML: TJclSimpleXML; +begin + XML := TJclSimpleXML.Create; + try + XML.LoadFromString(AValue); + Clear; + AddItems(Self, XML.Root); + finally + XML.Free; + end; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/JclDebugXMLSerializer.pas b/3rdParty/JCL/source/windows/JclDebugXMLSerializer.pas new file mode 100644 index 00000000..d7d4ef49 --- /dev/null +++ b/3rdParty/JCL/source/windows/JclDebugXMLSerializer.pas @@ -0,0 +1,126 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclDebugXMLSerializer.pas. } +{ } +{ The Initial Developer of the Original Code is Uwe Schuster. } +{ Portions created by Uwe Schuster are Copyright (C) 2009 Uwe Schuster. All rights reserved. } +{ } +{ Contributor(s): } +{ Uwe Schuster (uschuster) } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclDebugXMLSerializer; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, System.Classes, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, Classes, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + JclDebugSerialization; + +type + TJclXMLSerializer = class(TJclCustomSimpleSerializer) + public + function SaveToString: string; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +//=== { TJclXMLSerializer } ================================================== + +function TJclXMLSerializer.SaveToString: string; + + procedure AddToStrings(ASerializer: TJclCustomSimpleSerializer; AXMLStrings: TStringList; AIdent: Integer); + var + I, P: Integer; + S, S1, S2, V: string; + begin + if AIdent = 0 then + S := '' + else + S := StringOfChar(' ', AIdent); + V := ''; + for I := 0 to ASerializer.Values.Count - 1 do + begin + S1 := ASerializer.Values[I]; + P := Pos('=', S1); + if P > 0 then + begin + S2 := S1; + Delete(S1, P, Length(S1)); + Delete(S2, 1, P); + V := V + ' '; + V := V + Format('%s="%s"', [S1, S2]); + end; + end; + if ASerializer.Count > 0 then + begin + AXMLStrings.Add(S + '<' + ASerializer.Name + V + '>'); + for I := 0 to ASerializer.Count - 1 do + AddToStrings(ASerializer[I], AXMLStrings, AIdent + 2); + AXMLStrings.Add(S + ''); + end + else + AXMLStrings.Add(S + '<' + ASerializer.Name + V + '/>'); + end; + + +var + XMLStrings: TStringList; +begin + XMLStrings := TStringList.Create; + try + AddToStrings(Self, XMLStrings, 0); + Result := XMLStrings.Text; + finally + XMLStrings.Free; + end; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/JclDotNet.pas b/3rdParty/JCL/source/windows/JclDotNet.pas new file mode 100644 index 00000000..4ea38432 --- /dev/null +++ b/3rdParty/JCL/source/windows/JclDotNet.pas @@ -0,0 +1,1415 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclDotNet.pas. } +{ } +{ The Initial Developer of the Original Code is Flier Lu (). } +{ Portions created by Flier Lu are Copyright (C) Flier Lu. All Rights Reserved. } +{ } +{ Contributors: } +{ Flier Lu (flier) } +{ Robert Marquardt (marquardt) } +{ Olivier Sannier (obones) } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ Microsoft .Net framework support routines and classes. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclDotNet; + +{**************************************************************************************************} +{ Read this before compile! } +{**************************************************************************************************} +{ 1. This unit is developed in Delphi6 with MS.Net v1.0.3705, } +{ you maybe need to modify it for your environment. } +{ 2. Delphi's TLibImp.exe would generate error *_TLB.pas files } +{ when you import mscorlib.tlb, you should modify it by hand } +{ for example, change Pointer to _Pointer... } +{ or use my modified edition of mscorlib_TLB.pas (mscor.zip) } +{**************************************************************************************************} + +interface + +{$I jcl.inc} +{$I windowsonly.inc} + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Winapi.Windows, Winapi.ActiveX, + {$ENDIF MSWINDOWS} + System.Classes, System.SysUtils, System.Contnrs, + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Windows, ActiveX, + {$ENDIF MSWINDOWS} + Classes, SysUtils, Contnrs, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclWideStrings, + mscoree_TLB, mscorlib_TLB; + +//{$HPPEMIT '#include'} + +{ TODO -cDOC : Original code: "Flier Lu" } + +type + TJclClrBase = TInterfacedObject; + +type + TJclClrHostFlavor = (hfServer, hfWorkStation); + + TJclClrHostLoaderFlag = + (hlOptSingleDomain, + hlOptMultiDomain, + hlOptMultiDomainHost, + hlSafeMode, + hlSetPreference); + TJclClrHostLoaderFlags = set of TJclClrHostLoaderFlag; + +type + EJclClrException = class(EJclError); + + TJclClrAppDomain = class; + TJclClrAppDomainSetup = class; + TJclClrAssembly = class; + + TJclClrHost = class(TJclClrBase, ICorRuntimeHost) + private + FDefaultInterface: ICorRuntimeHost; + FAppDomains: TObjectList; + procedure EnumAppDomains; + function GetAppDomain(const Idx: Integer): TJclClrAppDomain; + function GetAppDomainCount: Integer; + function GetDefaultAppDomain: _AppDomain; + function GetCurrentAppDomain: _AppDomain; + + class procedure GetClrVersionsLegacy(VersionNames: TJclWideStrings); // used for pre v4 runtime + protected + function AddAppDomain(const AppDomain: TJclClrAppDomain): Integer; + function RemoveAppDomain(const AppDomain: TJclClrAppDomain): Integer; + public + constructor Create(const ClrVer: WideString = ''; + const Flavor: TJclClrHostFlavor = hfWorkStation; + const ConcurrentGC: Boolean = True; + const LoaderFlags: TJclClrHostLoaderFlags = [hlOptSingleDomain]); + destructor Destroy; override; + procedure Start; + procedure Stop; + procedure Refresh; + function CreateDomainSetup: TJclClrAppDomainSetup; + function CreateAppDomain(const Name: WideString; + const Setup: TJclClrAppDomainSetup = nil; + const Evidence: _Evidence = nil): TJclClrAppDomain; + function FindAppDomain(const Intf: _AppDomain; var Ret: TJclClrAppDomain): Boolean; overload; + function FindAppDomain(const Name: WideString; var Ret: TJclClrAppDomain): Boolean; overload; + class function CorSystemDirectory: WideString; + class function CorVersion: WideString; + class function CorRequiredVersion: WideString; + class procedure GetClrVersions(VersionNames: TJclWideStrings); overload; + {$IFNDEF SUPPORTS_UNICODE} + class procedure GetClrVersions(VersionNames: TStrings); overload; + {$ENDIF ~SUPPORTS_UNICODE} + property AppDomains[const Idx: Integer]: TJclClrAppDomain read GetAppDomain; default; + property AppDomainCount: Integer read GetAppDomainCount; + property DefaultAppDomain: _AppDomain read GetDefaultAppDomain; + property CurrentAppDomain: _AppDomain read GetCurrentAppDomain; + { ICorRuntimeHost } + property DefaultInterface: ICorRuntimeHost read FDefaultInterface implements ICorRuntimeHost; + end; + + TJclClrAssemblyArguments = array of WideString; + + TJclClrAppDomain = class(TJclClrBase, _AppDomain) + private + FHost: TJclClrHost; + FDefaultInterface: _AppDomain; + public + constructor Create(const AHost: TJclClrHost; const AAppDomain: _AppDomain); + function Load(const AssemblyString: WideString; + const AssemblySecurity: _Evidence = nil): TJclClrAssembly; overload; + function Load(const RawAssemblyStream: TStream; + const RawSymbolStoreStream: TStream = nil; + const AssemblySecurity: _Evidence = nil): TJclClrAssembly; overload; + function Execute(const AssemblyFile: TFileName; + const AssemblySecurity: _Evidence = nil): Integer; overload; + function Execute(const AssemblyFile: TFileName; + const Arguments: TJclClrAssemblyArguments; + const AssemblySecurity: _Evidence = nil): Integer; overload; + function Execute(const AssemblyFile: TFileName; + const Arguments: TStrings; + const AssemblySecurity: _Evidence = nil): Integer; overload; + procedure Unload; + property Host: TJclClrHost read FHost; + property DefaultInterface: _AppDomain read FDefaultInterface implements _AppDomain; + end; + + TJclClrAppDomainSetup = class(TJclClrBase, IAppDomainSetup) + private + FDefaultInterface: IAppDomainSetup; + function GetApplicationBase: WideString; + function GetApplicationName: WideString; + function GetCachePath: WideString; + function GetConfigurationFile: WideString; + function GetDynamicBase: WideString; + function GetLicenseFile: WideString; + function GetPrivateBinPath: WideString; + function GetPrivateBinPathProbe: WideString; + function GetShadowCopyDirectories: WideString; + function GetShadowCopyFiles: WideString; + procedure SetApplicationBase(const Value: WideString); + procedure SetApplicationName(const Value: WideString); + procedure SetCachePath(const Value: WideString); + procedure SetConfigurationFile(const Value: WideString); + procedure SetDynamicBase(const Value: WideString); + procedure SetLicenseFile(const Value: WideString); + procedure SetPrivateBinPath(const Value: WideString); + procedure SetPrivateBinPathProbe(const Value: WideString); + procedure SetShadowCopyDirectories(const Value: WideString); + procedure SetShadowCopyFiles(const Value: WideString); + public + constructor Create(Intf: IAppDomainSetup); + + property ApplicationBase: WideString read GetApplicationBase write SetApplicationBase; + property ApplicationName: WideString read GetApplicationName write SetApplicationName; + property CachePath: WideString read GetCachePath write SetCachePath; + property ConfigurationFile: WideString read GetConfigurationFile write SetConfigurationFile; + property DynamicBase: WideString read GetDynamicBase write SetDynamicBase; + property LicenseFile: WideString read GetLicenseFile write SetLicenseFile; + property PrivateBinPath: WideString read GetPrivateBinPath write SetPrivateBinPath; + property PrivateBinPathProbe: WideString read GetPrivateBinPathProbe write SetPrivateBinPathProbe; + property ShadowCopyDirectories: WideString read GetShadowCopyDirectories write SetShadowCopyDirectories; + property ShadowCopyFiles: WideString read GetShadowCopyFiles write SetShadowCopyFiles; + { IAppDomainSetup } + property DefaultInterface: IAppDomainSetup read FDefaultInterface implements IAppDomainSetup; + end; + + TJclClrAssembly = class(TJclClrBase, _Assembly) + private + FDefaultInterface: _Assembly; + public + constructor Create(Intf: _Assembly); + + property DefaultInterface: _Assembly read FDefaultInterface implements _Assembly; + end; + +type + TJclClrField = class(TObject) + end; + + TJclClrProperty = class(TObject) + end; + + TJclClrMethod = class(TJclClrBase, _MethodInfo) + private + FDefaultInterface: _MethodInfo; + public + property DefaultInterface: _MethodInfo read FDefaultInterface implements _MethodInfo; + end; + + TJclClrObject = class(TObject) + private + function GetMethod(const Name: WideString): TJclClrMethod; + function GetField(const Name: WideString): TJclClrField; + function GetProperty(const Name: WideString): TJclClrProperty; + public + constructor Create(const AssemblyName, NamespaceName, ClassName: WideString; + const Parameters: array of const); overload; + constructor Create(const AssemblyName, NamespaceName, ClassName: WideString; + const NewInstance: Boolean = False); overload; + + property Fields[const Name: WideString]: TJclClrField read GetField; + property Properties[const Name: WideString]: TJclClrProperty read GetProperty; + property Methods[const Name: WideString]: TJclClrMethod read GetMethod; + end; + +function CompareCLRVersions(const LeftVersion, RightVersion: string): Integer; + +type + HDOMAINENUM = Pointer; + {$EXTERNALSYM HDOMAINENUM} + +const + STARTUP_CONCURRENT_GC = $1; + STARTUP_LOADER_OPTIMIZATION_MASK = $3 shl 1; + STARTUP_LOADER_OPTIMIZATION_SINGLE_DOMAIN = $1 shl 1; + STARTUP_LOADER_OPTIMIZATION_MULTI_DOMAIN = $2 shl 1; + STARTUP_LOADER_OPTIMIZATION_MULTI_DOMAIN_HOST = $3 shl 1; + STARTUP_LOADER_SAFEMODE = $10; + STARTUP_LOADER_SETPREFERENCE = $100; + + RUNTIME_INFO_UPGRADE_VERSION = $01; + RUNTIME_INFO_REQUEST_IA64 = $02; + RUNTIME_INFO_REQUEST_AMD64 = $04; + RUNTIME_INFO_REQUEST_X86 = $08; + RUNTIME_INFO_DONT_RETURN_DIRECTORY = $10; + RUNTIME_INFO_DONT_RETURN_VERSION = $20; + RUNTIME_INFO_DONT_SHOW_ERROR_DIALOG = $40; + +function GetCORSystemDirectory(pbuffer: PWideChar; const cchBuffer: DWORD; + var dwLength: DWORD): HRESULT; stdcall; +{$EXTERNALSYM GetCORSystemDirectory} +function GetCORVersion(pbuffer: PWideChar; const cchBuffer: DWORD; + var dwLength: DWORD): HRESULT; stdcall; +{$EXTERNALSYM GetCORVersion} +function GetFileVersion(szFileName, szBuffer: PWideChar; const cchBuffer: DWORD; + var dwLength: DWORD): HRESULT; stdcall; +{$EXTERNALSYM GetFileVersion} +function GetCORRequiredVersion(pbuffer: PWideChar; const cchBuffer: DWORD; + var dwLength: DWORD): HRESULT; stdcall; +{$EXTERNALSYM GetCORRequiredVersion} +function GetRequestedRuntimeInfo(pExe, pwszVersion, pConfigurationFile: PWideChar; + const startupFlags, reserved: DWORD; pDirectory: PWideChar; const dwDirectory: DWORD; + var dwDirectoryLength: DWORD; pVersion: PWideChar; const cchBuffer: DWORD; + var dwLength: DWORD): HRESULT; stdcall; +{$EXTERNALSYM GetRequestedRuntimeInfo} +function GetRequestedRuntimeVersion(pExe, pVersion: PWideChar; + const cchBuffer: DWORD; var dwLength: DWORD): HRESULT; stdcall; +{$EXTERNALSYM GetRequestedRuntimeVersion} +function CorBindToRuntimeHost(pwszVersion, pwszBuildFlavor, + pwszHostConfigFile: PWideChar; const pReserved: Pointer; + const startupFlags: DWORD; const rclsid: TCLSID; const riid: TIID; + out pv): HRESULT; stdcall; +{$EXTERNALSYM CorBindToRuntimeHost} +function CorBindToRuntimeEx(pwszVersion, pwszBuildFlavor: PWideChar; + startupFlags: DWORD; const rclsid: TCLSID; const riid: TIID; + out pv): HRESULT; stdcall; +{$EXTERNALSYM CorBindToRuntimeEx} +function CorBindToRuntimeByCfg(const pCfgStream: IStream; + const reserved, startupFlags: DWORD; const rclsid: TCLSID; + const riid: TIID; out pv): HRESULT; stdcall; +{$EXTERNALSYM CorBindToRuntimeByCfg} +function CorBindToRuntime(pwszVersion, pwszBuildFlavor: PWideChar; + const rclsid: TCLSID; const riid: TIID; out pv): HRESULT; stdcall; +{$EXTERNALSYM CorBindToRuntime} +function CorBindToCurrentRuntime(pwszFileName: PWideChar; + const rclsid: TCLSID; const riid: TIID; out pv): HRESULT; stdcall; +{$EXTERNALSYM CorBindToCurrentRuntime} +function ClrCreateManagedInstance(pTypeName: PWideChar; + const riid: TIID; out pv): HRESULT; stdcall; +{$EXTERNALSYM ClrCreateManagedInstance} +procedure CorMarkThreadInThreadPool; stdcall; +{$EXTERNALSYM CorMarkThreadInThreadPool} +function RunDll32ShimW(const hwnd: THandle; const hinst: HMODULE; + lpszCmdLine: PWideChar; const nCmdShow: Integer): HRESULT; stdcall; +{$EXTERNALSYM RunDll32ShimW} +function LoadLibraryShim(szDllName, szVersion: PWideChar; + const pvReserved: Pointer; out phModDll: HMODULE): HRESULT; stdcall; +{$EXTERNALSYM LoadLibraryShim} +function CallFunctionShim(szDllName: PWideChar; const szFunctionName: PChar; + const lpvArgument1, lpvArgument2: Pointer; szVersion: PWideChar; + const pvReserved: Pointer): HRESULT; stdcall; +{$EXTERNALSYM CallFunctionShim} +function GetRealProcAddress(const pwszProcName: PChar; + out ppv: Pointer): HRESULT; stdcall; +{$EXTERNALSYM GetRealProcAddress} +procedure CorExitProcess(const exitCode: Integer); stdcall; +{$EXTERNALSYM CorExitProcess} + +type + CLSID_RESOLUTION_FLAGS = type Byte; + {$EXTERNALSYM CLSID_RESOLUTION_FLAGS} + +const + CLSID_RESOLUTION_DEFAULT = $0; + {$EXTERNALSYM CLSID_RESOLUTION_DEFAULT} + CLSID_RESOLUTION_REGISTERED = $1; + {$EXTERNALSYM CLSID_RESOLUTION_REGISTERED} + +function GetRequestedRuntimeVersionForCLSID(rclsid: TGuid; pVersion: PWideChar; + const cchBuffer: DWORD; var dwLength: DWORD; + const dwResolutionFlags: CLSID_RESOLUTION_FLAGS): HRESULT; stdcall; +{$EXTERNALSYM GetRequestedRuntimeVersionForCLSID} + +const + mscoree_dll = 'mscoree.dll'; + +type + ICLRMetaHost = interface(IUnknown) + ['{D332DB9E-B9B3-4125-8207-A14884F53216}'] + function GetRuntime(const pwzVersion: PWideChar; + const riid: TGUID; + out assemblyNGenSetting: IUnknown): HResult; stdcall; + function GetVersionFromFile(const pwzFilePath: PWideChar; + out pwzBuffer: PWideChar; + var pcchBuffer: DWORD): HResult; stdcall; + function EnumerateInstalledRuntimes(out ppEnumerator: IEnumUnknown): HResult; stdcall; + function EnumerateLoadedRuntimes(const hndProcess: THandle; + out ppEnumerator: IEnumUnknown): HResult; stdcall; + function RequestRuntimeLoadedNotification(out pCallbackFunction: PPointer): HResult; stdcall; + function QueryLegacyV2RuntimeBinding(const riid: TGUID; + out ppUnk: PPointer): HResult; stdcall; + function ExitProcess(out iExitCode: Int32): HResult; stdcall; + end; + + + ICLRRuntimeInfo = interface(IUnknown) + ['{BD39D1D2-BA2F-486a-89B0-B4B0CB466891}'] + function GetVersionString(pwzBuffer: PWideChar; var pcchBuffer: DWORD): HRESULT; stdcall; + function GetRuntimeDirectory(pwzBuffer: PWideChar; var pcchBuffer: DWORD): HRESULT; stdcall; + function IsLoaded(hndProcess: THandle; out pbLoaded: BOOL): HRESULT; stdcall; + function LoadErrorString(iResourceID: UINT; pwzBuffer: PWideChar; var pcchBuffer: DWORD; iLocaleID: LONG): HRESULT; stdcall; + function LoadLibrary(pwzDllName: LPCWSTR; out phndModule: HMODULE): HRESULT; stdcall; + function GetProcAddress(pszProcName: LPCSTR; out ppProc: Pointer): HRESULT; stdcall; + function GetInterface(const rclsid: TGuid; const riid: TGuid; out ppUnk: IUnknown): HRESULT; stdcall; + function IsLoadable(out pbLoadable: BOOL): HRESULT; stdcall; + function SetDefaultStartupFlags(dwStartupFlags: DWORD; pwzHostConfigFile: LPCWSTR): HRESULT; stdcall; + function GetDefaultStartupFlags(out pdwStartupFlags: DWORD; pwzHostConfigFile: LPWSTR; var pcchHostConfigFile: DWORD): HRESULT; stdcall; + function BindAsLegacyV2Runtime(): HRESULT; stdcall; + function IsStarted(out pbStarted: BOOL; out pdwStartupFlags: DWORD): HRESULT; stdcall; + end; + +const + CLSID_CLRMetaHost: TGUID = '{9280188d-0e8e-4867-b30c-7fa83884e8de}'; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.Win.ComObj, + System.Variants, + System.Types, // inline of TList.Remove + {$ELSE ~HAS_UNITSCOPE} + ComObj, + Variants, + {$ENDIF ~HAS_UNITSCOPE} + JclSysUtils, + JclResources, + JclStrings; + +function CompareCLRVersions(const LeftVersion, RightVersion: string): Integer; +var + LeftMajor, RightMajor, LeftMinor, RightMinor, LeftBuild, RightBuild, DotPos: Integer; + LeftStr, RightStr, LeftNum, RightNum: string; +begin + if (Length(LeftVersion) = 0) or (LeftVersion[1] <> 'v') then + raise EJclClrException.CreateResFmt(@RsEUnknownCLRVersion, [LeftVersion]); + + if (Length(RightVersion) = 0) or (RightVersion[1] <> 'v') then + raise EJclClrException.CreateResFmt(@RsEUnknownCLRVersion, [RightVersion]); + + DotPos := Pos('.', LeftVersion); + if DotPos = 0 then + raise EJclClrException.CreateResFmt(@RsEUnknownCLRVersion, [LeftVersion]); + LeftNum := Copy(LeftVersion, 2, DotPos - 2); + LeftStr := Copy(LeftVersion, DotPos + 1, Length(LeftVersion) - DotPos); + LeftMajor := 0; + if not TryStrToInt(LeftNum, LeftMajor) then + raise EJclClrException.CreateResFmt(@RsEUnknownCLRVersion, [LeftVersion]); + + DotPos := Pos('.', RightVersion); + if DotPos = 0 then + raise EJclClrException.CreateResFmt(@RsEUnknownCLRVersion, [RightVersion]); + RightNum := Copy(RightVersion, 2, DotPos - 2); + RightStr := Copy(RightVersion, DotPos + 1, Length(RightVersion) - DotPos); + RightMajor := 0; + if not TryStrToInt(RightNum, RightMajor) then + raise EJclClrException.CreateResFmt(@RsEUnknownCLRVersion, [RightVersion]); + + Result := -1; + if LeftMajor < RightMajor then + Exit; + Result := 1; + if LeftMajor > RightMajor then + Exit; + + DotPos := Pos('.', LeftStr); + if DotPos = 0 then + raise EJclClrException.CreateResFmt(@RsEUnknownCLRVersion, [LeftVersion]); + LeftNum := Copy(LeftStr, 1, DotPos - 1); + LeftStr := Copy(LeftStr, DotPos + 1, Length(LeftStr) - DotPos); + LeftMinor := 0; + if not TryStrToInt(LeftNum, LeftMinor) then + raise EJclClrException.CreateResFmt(@RsEUnknownCLRVersion, [LeftVersion]); + + DotPos := Pos('.', RightStr); + if DotPos = 0 then + raise EJclClrException.CreateResFmt(@RsEUnknownCLRVersion, [RightVersion]); + RightNum := Copy(RightStr, 1, DotPos - 1); + RightStr := Copy(RightStr, DotPos + 1, Length(RightStr) - DotPos); + RightMinor := 0; + if not TryStrToInt(RightNum, RightMinor) then + raise EJclClrException.CreateResFmt(@RsEUnknownCLRVersion, [RightVersion]); + + Result := -1; + if LeftMinor < RightMinor then + Exit; + Result := 1; + if LeftMinor > RightMinor then + Exit; + + LeftBuild := 0; + if not TryStrToInt(LeftStr, LeftBuild) then + raise EJclClrException.CreateResFmt(@RsEUnknownCLRVersion, [LeftVersion]); + RightBuild := 0; + if not TryStrToInt(RightStr, RightBuild) then + raise EJclClrException.CreateResFmt(@RsEUnknownCLRVersion, [RightVersion]); + + if LeftBuild < RightBuild then + Result := -1 + else if LeftBuild > RightBuild then + Result := 1 + else + Result := 0; +end; + +procedure GetProcedureAddress(var P: Pointer; const ModuleName, ProcName: string); +var + ModuleHandle: HMODULE; +begin + if not Assigned(P) then + begin + ModuleHandle := GetModuleHandle(PChar(ModuleName)); + if ModuleHandle = 0 then + begin + ModuleHandle := SafeLoadLibrary(ModuleName); + if ModuleHandle = 0 then + raise EJclError.CreateResFmt(@RsELibraryNotFound, [ModuleName]); + end; + P := GetProcAddress(ModuleHandle, PChar(ProcName)); + if not Assigned(P) then + raise EJclError.CreateResFmt(@RsEFunctionNotFound, [ModuleName, ProcName]); + end; +end; + +type + TGetCORSystemDirectory = function (pbuffer: PWideChar; const cchBuffer: DWORD; + var dwLength: DWORD): HRESULT; stdcall; + +var + _GetCORSystemDirectory: TGetCORSystemDirectory = nil; + +function GetCORSystemDirectory(pbuffer: PWideChar; const cchBuffer: DWORD; var dwLength: DWORD): HRESULT; +begin + GetProcedureAddress(Pointer(@_GetCORSystemDirectory), mscoree_dll, 'GetCORSystemDirectory'); + Result := _GetCORSystemDirectory(pbuffer, cchBuffer, dwLength); +end; + +type + TGetCORVersion = function (pbuffer: PWideChar; const cchBuffer: DWORD; + var dwLength: DWORD): HRESULT; stdcall; + +var + _GetCORVersion: TGetCORVersion = nil; + +function GetCORVersion(pbuffer: PWideChar; const cchBuffer: DWORD; + var dwLength: DWORD): HRESULT; +begin + GetProcedureAddress(Pointer(@_GetCORVersion), mscoree_dll, 'GetCORVersion'); + Result := _GetCORVersion(pbuffer, cchBuffer, dwLength); +end; + +type + TGetFileVersion = function (szFileName, szBuffer: PWideChar; const cchBuffer: DWORD; + var dwLength: DWORD): HRESULT; stdcall; + +var + _GetFileVersion: TGetFileVersion = nil; + +function GetFileVersion(szFileName, szBuffer: PWideChar; const cchBuffer: DWORD; + var dwLength: DWORD): HRESULT; +begin + GetProcedureAddress(Pointer(@_GetFileVersion), mscoree_dll, 'GetFileVersion'); + Result := _GetFileVersion(szFileName, szBuffer, cchBuffer, dwLength); +end; + +type + TGetCORRequiredVersion = function (pbuffer: PWideChar; const cchBuffer: DWORD; + var dwLength: DWORD): HRESULT; stdcall; + +var + _GetCORRequiredVersion: TGetCORRequiredVersion = nil; + +function GetCORRequiredVersion(pbuffer: PWideChar; const cchBuffer: DWORD; + var dwLength: DWORD): HRESULT; +begin + GetProcedureAddress(Pointer(@_GetCORRequiredVersion), mscoree_dll, 'GetCORRequiredVersion'); + Result := _GetCORRequiredVersion(pbuffer, cchBuffer, dwLength); +end; + +type + TGetRequestedRuntimeInfo = function (pExe, pwszVersion, pConfigurationFile: PWideChar; + const startupFlags, reserved: DWORD; pDirectory: PWideChar; const dwDirectory: DWORD; + var dwDirectoryLength: DWORD; pVersion: PWideChar; const cchBuffer: DWORD; + var dwLength: DWORD): HRESULT; stdcall; + +var + _GetRequestedRuntimeInfo: TGetRequestedRuntimeInfo = nil; + +function GetRequestedRuntimeInfo(pExe, pwszVersion, pConfigurationFile: PWideChar; + const startupFlags, reserved: DWORD; pDirectory: PWideChar; const dwDirectory: DWORD; + var dwDirectoryLength: DWORD; pVersion: PWideChar; const cchBuffer: DWORD; + var dwLength: DWORD): HRESULT; +begin + GetProcedureAddress(Pointer(@_GetRequestedRuntimeInfo), mscoree_dll, 'GetRequestedRuntimeInfo'); + Result := _GetRequestedRuntimeInfo(pExe, pwszVersion, pConfigurationFile, startupFlags, reserved, pDirectory, + dwDirectory, dwDirectoryLength, pVersion, cchBuffer, dwLength); +end; + +type + TGetRequestedRuntimeVersion = function (pExe, pVersion: PWideChar; + const cchBuffer: DWORD; var dwLength: DWORD): HRESULT; stdcall; + +var + _GetRequestedRuntimeVersion: TGetRequestedRuntimeVersion = nil; + +function GetRequestedRuntimeVersion(pExe, pVersion: PWideChar; + const cchBuffer: DWORD; var dwLength: DWORD): HRESULT; +begin + GetProcedureAddress(Pointer(@_GetRequestedRuntimeVersion), mscoree_dll, 'GetRequestedRuntimeVersion'); + Result := _GetRequestedRuntimeVersion(pExe, pVersion, cchBuffer, dwLength); +end; + +type + TCorBindToRuntimeHost = function (pwszVersion, pwszBuildFlavor, + pwszHostConfigFile: PWideChar; const pReserved: Pointer; + const startupFlags: DWORD; const rclsid: TCLSID; const riid: TIID; + out pv): HRESULT; stdcall; + +var + _CorBindToRuntimeHost: TCorBindToRuntimeHost = nil; + +function CorBindToRuntimeHost(pwszVersion, pwszBuildFlavor, + pwszHostConfigFile: PWideChar; const pReserved: Pointer; + const startupFlags: DWORD; const rclsid: TCLSID; const riid: TIID; + out pv): HRESULT; +begin + GetProcedureAddress(Pointer(@_CorBindToRuntimeHost), mscoree_dll, 'CorBindToRuntimeHost'); + Result := _CorBindToRuntimeHost(pwszVersion, pwszBuildFlavor, pwszHostConfigFile, pReserved, + startupFlags, rclsid, riid, pv); +end; + +type + TCorBindToRuntimeEx = function (pwszVersion, pwszBuildFlavor: PWideChar; + startupFlags: DWORD; const rclsid: TCLSID; const riid: TIID; + out pv): HRESULT; stdcall; + +var + _CorBindToRuntimeEx: TCorBindToRuntimeEx = nil; + +function CorBindToRuntimeEx(pwszVersion, pwszBuildFlavor: PWideChar; + startupFlags: DWORD; const rclsid: TCLSID; const riid: TIID; + out pv): HRESULT; +begin + GetProcedureAddress(Pointer(@_CorBindToRuntimeEx), mscoree_dll, 'CorBindToRuntimeEx'); + Result := _CorBindToRuntimeEx(pwszVersion, pwszBuildFlavor, startupFlags, rclsid, riid, pv); +end; + +type + TCorBindToRuntimeByCfg = function (const pCfgStream: IStream; + const reserved, startupFlags: DWORD; const rclsid: TCLSID; + const riid: TIID; out pv): HRESULT; stdcall; + +var + _CorBindToRuntimeByCfg: TCorBindToRuntimeByCfg = nil; + +function CorBindToRuntimeByCfg(const pCfgStream: IStream; + const reserved, startupFlags: DWORD; const rclsid: TCLSID; + const riid: TIID; out pv): HRESULT; +begin + GetProcedureAddress(Pointer(@_CorBindToRuntimeByCfg), mscoree_dll, 'CorBindToRuntimeByCfg'); + Result := _CorBindToRuntimeByCfg(pCfgStream, reserved, startupFlags, rclsid, riid, pv); +end; + +type + TCorBindToRuntime = function (pwszVersion, pwszBuildFlavor: PWideChar; + const rclsid: TCLSID; const riid: TIID; out pv): HRESULT; stdcall; + +var + _CorBindToRuntime: TCorBindToRuntime = nil; + +function CorBindToRuntime(pwszVersion, pwszBuildFlavor: PWideChar; + const rclsid: TCLSID; const riid: TIID; out pv): HRESULT; +begin + GetProcedureAddress(Pointer(@_CorBindToRuntime), mscoree_dll, 'CorBindToRuntime'); + Result := _CorBindToRuntime(pwszVersion, pwszBuildFlavor, rclsid, riid, pv); +end; + +type + TCorBindToCurrentRuntime = function (pwszFileName: PWideChar; + const rclsid: TCLSID; const riid: TIID; out pv): HRESULT; stdcall; + +var + _CorBindToCurrentRuntime: TCorBindToCurrentRuntime = nil; + +function CorBindToCurrentRuntime(pwszFileName: PWideChar; + const rclsid: TCLSID; const riid: TIID; out pv): HRESULT; +begin + GetProcedureAddress(Pointer(@_CorBindToCurrentRuntime), mscoree_dll, 'CorBindToCurrentRuntime'); + Result := _CorBindToCurrentRunTime(pwszFileName, rclsid, riid, pv); +end; + +type + TClrCreateManagedInstance = function (pTypeName: PWideChar; + const riid: TIID; out pv): HRESULT; stdcall; + +var + _ClrCreateManagedInstance: TClrCreateManagedInstance = nil; + +function ClrCreateManagedInstance(pTypeName: PWideChar; + const riid: TIID; out pv): HRESULT; +begin + GetProcedureAddress(Pointer(@_ClrCreateManagedInstance), mscoree_dll, 'ClrCreateManagedInstance'); + Result := _ClrCreateManagedInstance(pTypeName, riid, pv); +end; + +type + TCorMarkThreadInThreadPool = procedure; stdcall; + +var + _CorMarkThreadInThreadPool: TCorMarkThreadInThreadPool = nil; + +procedure CorMarkThreadInThreadPool; +begin + GetProcedureAddress(Pointer(@_CorMarkThreadInThreadPool), mscoree_dll, 'CorMarkThreadInThreadPool'); + _CorMarkThreadInThreadPool; +end; + +type + TRunDll32ShimW = function (const hwnd: THandle; const hinst: HMODULE; + lpszCmdLine: PWideChar; const nCmdShow: Integer): HRESULT; stdcall; + +var + _RunDll32ShimW: TRunDll32ShimW = nil; + +function RunDll32ShimW(const hwnd: THandle; const hinst: HMODULE; + lpszCmdLine: PWideChar; const nCmdShow: Integer): HRESULT; +begin + GetProcedureAddress(Pointer(@_RunDll32ShimW), mscoree_dll, 'RunDll32ShimW'); + Result := _RunDll32ShimW(hwnd, hinst, lpszCmdLine, nCmdShow); +end; + +type + TLoadLibraryShim = function (szDllName, szVersion: PWideChar; + const pvReserved: Pointer; out phModDll: HMODULE): HRESULT; stdcall; + +var + _LoadLibraryShim: TLoadLibraryShim = nil; + +function LoadLibraryShim(szDllName, szVersion: PWideChar; + const pvReserved: Pointer; out phModDll: HMODULE): HRESULT; +begin + GetProcedureAddress(Pointer(@_LoadLibraryShim), mscoree_dll, 'LoadLibraryShim'); + Result := _LoadLibraryShim(szDllName, szVersion, pvReserved, phModDll); +end; + +type + TCallFunctionShim = function (szDllName: PWideChar; const szFunctionName: PChar; + const lpvArgument1, lpvArgument2: Pointer; szVersion: PWideChar; + const pvReserved: Pointer): HRESULT; stdcall; + +var + _CallFunctionShim: TCallFunctionShim = nil; + +function CallFunctionShim(szDllName: PWideChar; const szFunctionName: PChar; + const lpvArgument1, lpvArgument2: Pointer; szVersion: PWideChar; + const pvReserved: Pointer): HRESULT; +begin + GetProcedureAddress(Pointer(@_CallFunctionShim), mscoree_dll, 'CallFunctionShim'); + Result := _CallFunctionShim(szDllName, szFunctionName, lpvArgument1, lpvArgument2, szVersion, pvReserved); +end; + +type + TGetRealProcAddress = function (const pwszProcName: PChar; + out ppv: Pointer): HRESULT; stdcall; + +var + _GetRealProcAddress: TGetRealProcAddress = nil; + +function GetRealProcAddress(const pwszProcName: PChar; + out ppv: Pointer): HRESULT; +begin + GetProcedureAddress(Pointer(@_GetRealProcAddress), mscoree_dll, 'GetRealProcAddress'); + Result := _GetRealProcAddress(pwszProcName, ppv); +end; + +type + TCorExitProcess = procedure (const exitCode: Integer); stdcall; + +var + _CorExitProcess: TCorExitProcess = nil; + +procedure CorExitProcess(const exitCode: Integer); +begin + GetProcedureAddress(Pointer(@_CorExitProcess), mscoree_dll, 'CorExitProcess'); + _CorExitProcess(exitCode); +end; + +type + TGetRequestedRuntimeVersionForCLSID = function (rclsid: TGuid; pVersion: PWideChar; + const cchBuffer: DWORD; var dwLength: DWORD; + const dwResolutionFlags: CLSID_RESOLUTION_FLAGS): HRESULT; stdcall; + +var + _GetRequestedRuntimeVersionForCLSID: TGetRequestedRuntimeVersionForCLSID = nil; + +function GetRequestedRuntimeVersionForCLSID(rclsid: TGuid; pVersion: PWideChar; + const cchBuffer: DWORD; var dwLength: DWORD; + const dwResolutionFlags: CLSID_RESOLUTION_FLAGS): HRESULT; +begin + GetProcedureAddress(Pointer(@_GetRequestedRuntimeVersionForCLSID), mscoree_dll, 'GetRequestedRuntimeVersionForCLSID'); + Result := _GetRequestedRuntimeVersionForCLSID(rclsid, pVersion, cchBuffer, dwLength, dwResolutionFlags); +end; + +type + TCLRCreateInstance = function (const clsid: TGuid; const riid: TGuid; out Intf: IUnknown): HRESULT; stdcall; + +var + _CLRCreateInstance: TCLRCreateInstance = nil; + +function CLRCreateInstance(clsid: TGuid; riid: TGuid; out Intf: IUnknown): HRESULT; +begin + GetProcedureAddress(Pointer(@_CLRCreateInstance), mscoree_dll, 'CLRCreateInstance'); + if @_CLRCreateInstance = nil then + begin + Intf := nil; + Result := S_OK; + end + else + begin + Result := _CLRCreateInstance(clsid, riid, Intf); + end; +end; + +//=== { TJclClrHost } ======================================================== + +constructor TJclClrHost.Create(const ClrVer: WideString; const Flavor: TJclClrHostFlavor; + const ConcurrentGC: Boolean; const LoaderFlags: TJclClrHostLoaderFlags); +const + ClrHostFlavorNames: array [TJclClrHostFlavor] of WideString = ('srv', 'wks'); + ClrHostLoaderFlagValues: array [TJclClrHostLoaderFlag] of DWORD = + (STARTUP_LOADER_OPTIMIZATION_SINGLE_DOMAIN, + STARTUP_LOADER_OPTIMIZATION_MULTI_DOMAIN, + STARTUP_LOADER_OPTIMIZATION_MULTI_DOMAIN_HOST, + STARTUP_LOADER_SAFEMODE, + STARTUP_LOADER_SETPREFERENCE); +var + Flags: DWORD; + ALoaderFlag: TJclClrHostLoaderFlag; +begin + inherited Create; + Flags := 0; + if ConcurrentGC then + Flags := Flags or STARTUP_CONCURRENT_GC; + for ALoaderFlag := Low(TJclClrHostLoaderFlag) to High(TJclClrHostLoaderFlag) do + if ALoaderFlag in LoaderFlags then + Flags := Flags or ClrHostLoaderFlagValues[ALoaderFlag]; + OleCheck(CorBindToRuntimeEx(PWideCharOrNil(ClrVer), + PWideChar(ClrHostFlavorNames[Flavor]), Flags, + CLASS_CorRuntimeHost, IID_ICorRuntimeHost, FDefaultInterface)); +end; + +destructor TJclClrHost.Destroy; +begin + FreeAndNil(FAppDomains); + inherited Destroy; +end; + +procedure TJclClrHost.EnumAppDomains; +var + hEnum: Pointer; + Unk: IUnknown; +begin + if Assigned(FAppDomains) then + FAppDomains.Clear + else + FAppDomains := TObjectList.Create; + + OleCheck(FDefaultInterface.EnumDomains(hEnum)); + try + while FDefaultInterface.NextDomain(hEnum, Unk) <> S_FALSE do + TJclClrAppDomain.Create(Self, Unk as _AppDomain); + finally + OleCheck(FDefaultInterface.CloseEnum(hEnum)); + end; +end; + +function TJclClrHost.FindAppDomain(const Intf: _AppDomain; + var Ret: TJclClrAppDomain): Boolean; +var + I: Integer; +begin + for I := 0 to AppDomainCount-1 do + begin + Ret := AppDomains[I]; + if Ret.DefaultInterface = Intf then + begin + Result := True; + Exit; + end; + end; + Ret := nil; + Result := False; +end; + +function TJclClrHost.FindAppDomain(const Name: WideString; + var Ret: TJclClrAppDomain): Boolean; +var + I: Integer; +begin + for I := 0 to AppDomainCount-1 do + begin + Ret := AppDomains[I]; + if Ret.DefaultInterface.FriendlyName = Name then + begin + Result := True; + Exit; + end; + end; + Ret := nil; + Result := False; +end; + +function TJclClrHost.GetAppDomain(const Idx: Integer): TJclClrAppDomain; +begin + Result := TJclClrAppDomain(FAppDomains.Items[Idx]); +end; + +function TJclClrHost.GetAppDomainCount: Integer; +begin + Result := FAppDomains.Count; +end; + +function TJclClrHost.GetDefaultAppDomain: _AppDomain; +var + Unk: IUnknown; +begin + OleCheck(FDefaultInterface.GetDefaultDomain(Unk)); + Result := Unk as _AppDomain; +end; + +class procedure TJclClrHost.GetClrVersions(VersionNames: TJclWideStrings); +var + UnknownIntf: IUnknown; + MetaHost: ICLRMetaHost; + Enumerator: IEnumUnknown; + RuntimeInfo: ICLRRuntimeInfo; + + Version: WideString; + Directory: WideString; + RequiredSize: DWORD; + Err: HRESULT; +begin + // CLRCreateInstance returns S_OK and a nil interface if the entry point was not found in mscoree.dll + // very old versions of CLR return E_NOTIMPL and a nil interface + Err := CLRCreateInstance(CLSID_CLRMetaHost, ICLRMetaHost, UnknownIntf); + if Assigned(UnknownIntf) then + begin + MetaHost := UnknownIntf as ICLRMetaHost; + + OleCheck(MetaHost.EnumerateInstalledRuntimes(Enumerator)); + + while Enumerator.Next(1, UnknownIntf, nil) = S_OK do + begin + RuntimeInfo := UnknownIntf as ICLRRuntimeInfo; + + RuntimeInfo.GetVersionString(nil, RequiredSize); // don't OleCheck here, the call fails but still fills RequiredSize + SetLength(Version, RequiredSize - 1); + OleCheck(RuntimeInfo.GetVersionString(@Version[1], RequiredSize)); + + RuntimeInfo.GetRuntimeDirectory(nil, RequiredSize); + SetLength(Directory, RequiredSize - 1); + OleCheck(RuntimeInfo.GetRuntimeDirectory(@Directory[1], RequiredSize)); + + VersionNames.Values[Version] := Directory; + end; + end + else + if(Err = S_OK) or (Err = E_NOTIMPL) then + begin + GetClrVersionsLegacy(VersionNames); + end + else + OleCheck(Err); +end; + +class procedure TJclClrHost.GetClrVersionsLegacy(VersionNames: TJclWideStrings); // used for pre v4 runtime + function DirectoryExistsW(const DirectoryName: WideString): Boolean; + var + Code: DWORD; + begin + Code := GetFileAttributesW(PWideChar(DirectoryName)); + Result := (Code <> $FFFFFFFF) and ((Code and FILE_ATTRIBUTE_DIRECTORY) <> 0); + end; +const + WideDirDelimiter: WideChar = '\'; +var + SystemDirectory: WideString; + Index: Integer; + PathOk: Boolean; + FindData: TWin32FindDataW; + SearchHandle: THandle; + DirectoryBuffer, VersionBuffer: WideString; + DirectoryLength, VersionLength, OldErrorMode, RuntimeInfo: DWORD; +begin + SystemDirectory := CorSystemDirectory; + + if Pos('V1', AnsiUpperCase(CorVersion)) > 0 then + RunTimeInfo := 0 + else + RunTimeInfo := RUNTIME_INFO_DONT_SHOW_ERROR_DIALOG; + + if (SystemDirectory = '') or not DirectoryExistsW(SystemDirectory) then + Exit; + + PathOk := False; + for Index := Length(SystemDirectory) - 1 downto 1 do + if SystemDirectory[Index] = WideDirDelimiter then + begin + SetLength(SystemDirectory, Index); + PathOk := True; + Break; + end; + + if PathOk then + begin + FindData.dwFileAttributes := 0; + SearchHandle := FindFirstFileW(PWideChar(SystemDirectory + '*.*'), FindData); + if SearchHandle = INVALID_HANDLE_VALUE then + Exit; + try + repeat + if ((FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0) + and (WideString(FindData.cFileName) <> '.') and (WideString(FindData.cFileName) <> '..') then + begin + OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS); + try + VersionLength := 0; + DirectoryLength := 0; + if (GetRequestedRuntimeInfo(nil, FindData.cFileName, nil, 0, RunTimeInfo, + nil, 0, DirectoryLength, nil, 0, VersionLength) and $1FFF = ERROR_INSUFFICIENT_BUFFER) + and (DirectoryLength > 0) and (VersionLength > 0) then + begin + SetLength(DirectoryBuffer, DirectoryLength - 1); + SetLength(VersionBuffer, VersionLength - 1); + if GetRequestedRuntimeInfo(nil, FindData.cFileName, nil, 0, RUNTIME_INFO_DONT_SHOW_ERROR_DIALOG, + PWideChar(DirectoryBuffer), DirectoryLength, DirectoryLength, + PWideChar(VersionBuffer), VersionLength, VersionLength) = S_OK then + VersionNames.Values[VersionBuffer] := DirectoryBuffer + VersionBuffer; + end; + finally + SetErrorMode(OldErrorMode); + end; + end; + until not FindNextFileW(SearchHandle, FindData); + finally + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.FindClose(SearchHandle); + end; + end; +end; + +{$IFNDEF SUPPORTS_UNICODE} +class procedure TJclClrHost.GetClrVersions(VersionNames: TStrings); +var + AWideStrings: TWideStrings; + Index: Integer; +begin + AWideStrings := TWideStringList.Create; + try + GetCLRVersions(AWideStrings); + for Index := 0 to AWideStrings.Count - 1 do + VersionNames.Add(AWideStrings.Strings[Index]); + finally + AWideStrings.Free; + end; +end; +{$ENDIF ~SUPPORTS_UNICODE} + +function TJclClrHost.GetCurrentAppDomain: _AppDomain; +var + Unk: IUnknown; +begin + OleCheck(FDefaultInterface.CurrentDomain(Unk)); + Result := Unk as _AppDomain; +end; + +function TJclClrHost.AddAppDomain(const AppDomain: TJclClrAppDomain): Integer; +begin + Result := FAppDomains.Add(AppDomain); +end; + +function TJclClrHost.RemoveAppDomain(const AppDomain: TJclClrAppDomain): Integer; +begin + Result := FAppDomains.Remove(AppDomain); +end; + +class function TJclClrHost.CorSystemDirectory: WideString; +var + Len: DWORD; +begin + SetLength(Result, MAX_PATH); + Len := 0; + OleCheck(GetCORSystemDirectory(PWideChar(Result), Length(Result), Len)); + if Len > 0 then + SetLength(Result, Len - 1); +end; + +class function TJclClrHost.CorVersion: WideString; +var + Len: DWORD; +begin + SetLength(Result, 64); + Len := 0; + OleCheck(GetCORVersion(PWideChar(Result), Length(Result), Len)); + if Len > 0 then + SetLength(Result, Len - 1); +end; + +class function TJclClrHost.CorRequiredVersion: WideString; +var + Len: DWORD; +begin + SetLength(Result, 64); + Len := 0; + OleCheck(GetCORRequiredVersion(PWideChar(Result), Length(Result), Len)); + if Len > 0 then + SetLength(Result, Len - 1); +end; + +function TJclClrHost.CreateDomainSetup: TJclClrAppDomainSetup; +var + pUnk: IUnknown; +begin + OleCheck(FDefaultInterface.CreateDomainSetup(pUnk)); + Result := TJclClrAppDomainSetup.Create(pUnk as IAppDomainSetup); +end; + +function TJclClrHost.CreateAppDomain(const Name: WideString; + const Setup: TJclClrAppDomainSetup; + const Evidence: _Evidence): TJclClrAppDomain; +var + pUnk: IUnknown; +begin + OleCheck(FDefaultInterface.CreateDomainEx(PWideChar(Name), Setup as IAppDomainSetup, Evidence, pUnk)); + Result := TJclClrAppDomain.Create(Self, pUnk as _AppDomain); +end; + +procedure TJclClrHost.Start; +begin + OleCheck(DefaultInterface.Start); + Refresh; +end; + +procedure TJclClrHost.Stop; +begin + OleCheck(DefaultInterface.Stop); +end; + +procedure TJclClrHost.Refresh; +begin + EnumAppDomains; +end; + +//=== { TJclClrAppDomain } =================================================== + +constructor TJclClrAppDomain.Create(const AHost: TJclClrHost; + const AAppDomain: _AppDomain); +begin + Assert(Assigned(AHost)); + Assert(Assigned(AAppDomain)); + inherited Create; + FHost := AHost; + FDefaultInterface := AAppDomain; + FHost.AddAppDomain(Self); +end; + +function TJclClrAppDomain.Execute(const AssemblyFile: TFileName; + const Arguments: TJclClrAssemblyArguments; + const AssemblySecurity: _Evidence): Integer; +var + Args: Variant; +begin + Assert(FileExists(AssemblyFile)); + if Length(Arguments) = 0 then + Result := Execute(AssemblyFile, AssemblySecurity) + else + begin + Args := 0; + DynArrayToVariant(Args, @Arguments[0], TypeInfo(TJclClrAssemblyArguments)); + Result := DefaultInterface.ExecuteAssembly_3(AssemblyFile, AssemblySecurity, PSafeArray(TVarData(Args).VArray)); + end; +end; + +function TJclClrAppDomain.Execute(const AssemblyFile: TFileName; + const AssemblySecurity: _Evidence): Integer; +begin + Assert(FileExists(AssemblyFile)); + if Assigned(AssemblySecurity) then + Result := DefaultInterface.ExecuteAssembly(AssemblyFile, AssemblySecurity) + else + Result := DefaultInterface.ExecuteAssembly_2(AssemblyFile); +end; + +function TJclClrAppDomain.Execute(const AssemblyFile: TFileName; + const Arguments: TStrings; const AssemblySecurity: _Evidence): Integer; +var + Args: Variant; + Index: Integer; +begin + Assert(FileExists(AssemblyFile)); + if Arguments.Count = 0 then + Result := Execute(AssemblyFile, AssemblySecurity) + else + begin + Args := VarArrayCreate([0, Arguments.Count - 1], varOleStr); + for Index := 0 to Arguments.Count - 1 do + Args[Index] := WideString(Arguments.Strings[Index]); + Result := DefaultInterface.ExecuteAssembly_3(AssemblyFile, AssemblySecurity, PSafeArray(TVarData(Args).VArray)); + end; +end; + +function TJclClrAppDomain.Load(const AssemblyString: WideString; + const AssemblySecurity: _Evidence): TJclClrAssembly; +begin + if Assigned(AssemblySecurity) then + Result := TJclClrAssembly.Create(DefaultInterface.Load_7(AssemblyString, AssemblySecurity)) + else + Result := TJclClrAssembly.Create(DefaultInterface.Load_2(AssemblyString)); +end; + +function TJclClrAppDomain.Load(const RawAssemblyStream, + RawSymbolStoreStream: TStream; + const AssemblySecurity: _Evidence): TJclClrAssembly; +var + RawAssembly, RawSymbolStore: Variant; +begin + Assert(Assigned(RawAssemblyStream)); + RawAssembly := VarArrayCreate([0, RawAssemblyStream.Size-1], varByte); + try + try + RawAssemblyStream.Read(VarArrayLock(RawAssembly)^, RawAssemblyStream.Size); + finally + VarArrayUnlock(RawAssembly); + end; + + if not Assigned(RawSymbolStoreStream) then + Result := TJclClrAssembly.Create(DefaultInterface.Load_3(PSafeArray(TVarData(RawAssembly).VArray))) + else + begin + RawSymbolStore := VarArrayCreate([0, RawSymbolStoreStream.Size-1], varByte); + try + try + RawSymbolStoreStream.Read(VarArrayLock(RawSymbolStore)^, RawSymbolStoreStream.Size); + finally + VarArrayUnlock(RawSymbolStore); + end; + + if Assigned(AssemblySecurity) then + Result := TJclClrAssembly.Create(DefaultInterface.Load_5( + PSafeArray(TVarData(RawAssembly).VArray), + PSafeArray(TVarData(RawSymbolStore).VArray), + AssemblySecurity)) + else + Result := TJclClrAssembly.Create(DefaultInterface.Load_4( + PSafeArray(TVarData(RawAssembly).VArray), + PSafeArray(TVarData(RawSymbolStore).VArray))); + finally + VarClear(RawSymbolStore); + end; + end; + finally + VarClear(RawAssembly); + end; +end; + +procedure TJclClrAppDomain.Unload; +var + AppDomain: TJclClrAppDomain; +begin + OleCheck(FHost.DefaultInterface.UnloadDomain(DefaultInterface)); + AppDomain := nil; + if FHost.FindAppDomain(DefaultInterface, AppDomain) and (AppDomain = Self) then + FHost.RemoveAppDomain(Self); +end; + +//=== { TJclClrObject } ====================================================== + +constructor TJclClrObject.Create(const AssemblyName, NamespaceName, ClassName: WideString; + const Parameters: array of const); +begin + inherited Create; +end; + +constructor TJclClrObject.Create(const AssemblyName, NamespaceName, ClassName: WideString; + const NewInstance: Boolean); +begin + Create(AssemblyName, NamespaceName, ClassName, []); +end; + +function TJclClrObject.GetField(const Name: WideString): TJclClrField; +begin + // (rom) added to suppress warning until implementation + Result := nil; +end; + +function TJclClrObject.GetProperty(const Name: WideString): TJclClrProperty; +begin + // (rom) added to suppress warning until implementation + Result := nil; +end; + +function TJclClrObject.GetMethod(const Name: WideString): TJclClrMethod; +begin + // (rom) added to suppress warning until implementation + Result := nil; +end; + +//=== { TJclClrAppDomainSetup } ============================================== + +constructor TJclClrAppDomainSetup.Create(Intf: IAppDomainSetup); +begin + Assert(Assigned(Intf)); + inherited Create; + FDefaultInterface := Intf; +end; + +function TJclClrAppDomainSetup.GetApplicationBase: WideString; +begin + OleCheck(FDefaultInterface.Get_ApplicationBase(Result)); +end; + +function TJclClrAppDomainSetup.GetApplicationName: WideString; +begin + OleCheck(FDefaultInterface.Get_ApplicationName(Result)); +end; + +function TJclClrAppDomainSetup.GetCachePath: WideString; +begin + OleCheck(FDefaultInterface.Get_CachePath(Result)); +end; + +function TJclClrAppDomainSetup.GetConfigurationFile: WideString; +begin + OleCheck(FDefaultInterface.Get_ConfigurationFile(Result)); +end; + +function TJclClrAppDomainSetup.GetDynamicBase: WideString; +begin + OleCheck(FDefaultInterface.Get_DynamicBase(Result)); +end; + +function TJclClrAppDomainSetup.GetLicenseFile: WideString; +begin + OleCheck(FDefaultInterface.Get_LicenseFile(Result)); +end; + +function TJclClrAppDomainSetup.GetPrivateBinPath: WideString; +begin + OleCheck(FDefaultInterface.Get_PrivateBinPath(Result)); +end; + +function TJclClrAppDomainSetup.GetPrivateBinPathProbe: WideString; +begin + OleCheck(FDefaultInterface.Get_PrivateBinPathProbe(Result)); +end; + +function TJclClrAppDomainSetup.GetShadowCopyDirectories: WideString; +begin + OleCheck(FDefaultInterface.Get_ShadowCopyDirectories(Result)); +end; + +function TJclClrAppDomainSetup.GetShadowCopyFiles: WideString; +begin + OleCheck(FDefaultInterface.Get_ShadowCopyFiles(Result)); +end; + +procedure TJclClrAppDomainSetup.SetApplicationBase(const Value: WideString); +begin + OleCheck(FDefaultInterface.Set_ApplicationBase(Value)); +end; + +procedure TJclClrAppDomainSetup.SetApplicationName(const Value: WideString); +begin + OleCheck(FDefaultInterface.Set_ApplicationName(Value)); +end; + +procedure TJclClrAppDomainSetup.SetCachePath(const Value: WideString); +begin + OleCheck(FDefaultInterface.Set_CachePath(Value)); +end; + +procedure TJclClrAppDomainSetup.SetConfigurationFile(const Value: WideString); +begin + OleCheck(FDefaultInterface.Set_ConfigurationFile(Value)); +end; + +procedure TJclClrAppDomainSetup.SetDynamicBase(const Value: WideString); +begin + OleCheck(FDefaultInterface.Set_DynamicBase(Value)); +end; + +procedure TJclClrAppDomainSetup.SetLicenseFile(const Value: WideString); +begin + OleCheck(FDefaultInterface.Set_LicenseFile(Value)); +end; + +procedure TJclClrAppDomainSetup.SetPrivateBinPath(const Value: WideString); +begin + OleCheck(FDefaultInterface.Set_PrivateBinPath(Value)); +end; + +procedure TJclClrAppDomainSetup.SetPrivateBinPathProbe(const Value: WideString); +begin + OleCheck(FDefaultInterface.Set_PrivateBinPathProbe(Value)); +end; + +procedure TJclClrAppDomainSetup.SetShadowCopyDirectories(const Value: WideString); +begin + OleCheck(FDefaultInterface.Set_ShadowCopyDirectories(Value)); +end; + +procedure TJclClrAppDomainSetup.SetShadowCopyFiles(const Value: WideString); +begin + OleCheck(FDefaultInterface.Set_ShadowCopyFiles(Value)); +end; + +//=== { TJclClrAssembly } ==================================================== + +constructor TJclClrAssembly.Create(Intf: _Assembly); +begin + Assert(Assigned(Intf)); + inherited Create; + FDefaultInterface := Intf; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/JclHelpUtils.pas b/3rdParty/JCL/source/windows/JclHelpUtils.pas new file mode 100644 index 00000000..7bb128b8 --- /dev/null +++ b/3rdParty/JCL/source/windows/JclHelpUtils.pas @@ -0,0 +1,543 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is DelphiInstall.pas. } +{ } +{ The Initial Developer of the Original Code is Petr Vones. Portions created by Petr Vones are } +{ Copyright (C) of Petr Vones. All Rights Reserved. } +{ } +{ Contributor(s): } +{ Andreas Hausladen (ahuser) } +{ Florent Ouchet (outchy) } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) - crossplatform & BCB support } +{ Uwe Schuster (uschuster) } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclHelpUtils; + +{$I jcl.inc} +{$I crossplatform.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + MSHelpServices_TLB, + {$IFDEF HAS_UNITSCOPE} + System.Classes, System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + Classes, SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclSysUtils; + +// Various definitions +type + EJclHelpUtilsException = class(EJclError); + +type + TJclBorlandOpenHelp = class + private + FHelpPrefix: string; + FRootDirectory: string; + function GetContentFileName: string; + function GetIndexFileName: string; + function GetLinkFileName: string; + function GetGidFileName: string; + function GetProjectFileName: string; + function ReadFileName(const FormatName: string): string; + public + constructor Create(const ARootDirectory, AHelpPrefix: string); + function AddHelpFile(const HelpFileName, IndexName: string): Boolean; + function RemoveHelpFile(const HelpFileName, IndexName: string): Boolean; + property ContentFileName: string read GetContentFileName; + property GidFileName: string read GetGidFileName; + property HelpPrefix: string read FHelpPrefix; + property IndexFileName: string read GetIndexFileName; + property LinkFileName: string read GetLinkFileName; + property ProjectFileName: string read GetProjectFileName; + property RootDirectory: string read FRootDirectory; + end; + + TJclHelp2Object = (hoRegisterSession, hoRegister, hoPlugin); + TJclHelp2Objects = set of TJclHelp2Object; + + TJclHelp2Manager = class + private + FHxRegisterSession: IHxRegisterSession; + FHxRegister: IHxRegister; + FHxPlugin: IHxPlugIn; + FIdeNameSpace: WideString; + function RequireObject(HelpObjects: TJclHelp2Objects): Boolean; + function GetHxPlugin: IHxPlugin; + function GetHxRegister: IHxRegister; + function GetHxRegisterSession: IHxRegisterSession; + public + constructor Create(IDEVersionNumber: Integer); + destructor Destroy; override; + function CreateTransaction: Boolean; + function CommitTransaction: Boolean; + function RegisterNameSpace(const Name, Collection, Description: WideString): Boolean; + function UnregisterNameSpace(const Name: WideString): Boolean; + function RegisterHelpFile(const NameSpace, Identifier: WideString; + const LangId: Integer; const HxSFile, HxIFile: WideString): Boolean; + function UnregisterHelpFile(const NameSpace, Identifier: WideString; + const LangId: Integer): Boolean; + function PlugNameSpaceIn(const SourceNameSpace, + TargetNameSpace: WideString): Boolean; + function UnPlugNameSpace(const SourceNameSpace, + TargetNameSpace: WideString): Boolean; + function PlugNameSpaceInBorlandHelp(const NameSpace: WideString): Boolean; + function UnPlugNameSpaceFromBorlandHelp(const NameSpace: WideString): Boolean; + property HxRegisterSession: IHxRegisterSession read GetHxRegisterSession; + property HxRegister: IHxRegister read GetHxRegister; + property HxPlugin: IHxPlugin read GetHxPlugin; + property IdeNamespace: WideString read FIdeNameSpace; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'jcl\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, + {$ELSE ~HAS_UNITSCOPE} + Windows, + {$ENDIF ~HAS_UNITSCOPE} + JclRegistry, + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + JclFileUtils, JclDevToolsResources; + +type + TBDSVersionInfo = record + Name: PResStringRec; + VersionStr: string; + Version: Integer; + CoreIdeVersion: string; + Supported: Boolean; + end; + +const + MSHelpSystemKeyName = '\SOFTWARE\Microsoft\Windows\Help'; + + HelpContentFileName = '%s\Help\%s.ohc'; + HelpIndexFileName = '%s\Help\%s.ohi'; + HelpLinkFileName = '%s\Help\%s.ohl'; + HelpProjectFileName = '%s\Help\%s.ohp'; + HelpGidFileName = '%s\Help\%s.gid'; + +//=== { TJclBorlandOpenHelp } ================================================ + +function TJclBorlandOpenHelp.AddHelpFile(const HelpFileName, IndexName: string): Boolean; +var + CntFileName, HelpName, CntName: string; + List: TStringList; + + procedure AddToList(const FileName, Text: string); + var + I, Attr: Integer; + Found: Boolean; + begin + List.LoadFromFile(FileName); + Found := False; + for I := 0 to List.Count - 1 do + if AnsiSameText(Trim(List[I]), Text) then + begin + Found := True; + Break; + end; + if not Found then + begin + List.Add(Text); + Attr := FileGetAttr(FileName); + FileSetAttr(FileName, faArchive); + List.SaveToFile(FileName); + FileSetAttr(FileName, Attr); + end; + end; + +begin + CntFileName := ChangeFileExt(HelpFileName, '.cnt'); + Result := FileExists(HelpFileName) and FileExists(CntFileName); + if Result then + begin + HelpName := ExtractFileName(HelpFileName); + CntName := ExtractFileName(CntFileName); + RegWriteString(HKLM, MSHelpSystemKeyName, HelpName, ExtractFilePath(HelpFileName)); + RegWriteString(HKLM, MSHelpSystemKeyName, CntName, ExtractFilePath(CntFileName)); + List := TStringList.Create; + try + AddToList(ContentFileName, Format(':Include %s', [CntName])); + AddToList(LinkFileName, Format(':Link %s', [HelpName])); + AddToList(IndexFileName, Format(':Index %s=%s', [IndexName, HelpName])); + SetFileLastWrite(ProjectFileName, Now); + FileDelete(GidFileName); + finally + List.Free; + end; + end; +end; + +constructor TJclBorlandOpenHelp.Create(const ARootDirectory, + AHelpPrefix: string); +begin + inherited Create; + FHelpPrefix := AHelpPrefix; + FRootDirectory := ARootDirectory; +end; + +function TJclBorlandOpenHelp.GetContentFileName: string; +begin + Result := ReadFileName(HelpContentFileName); +end; + +function TJclBorlandOpenHelp.GetGidFileName: string; +begin + Result := ReadFileName(HelpGidFileName); +end; + +function TJclBorlandOpenHelp.GetIndexFileName: string; +begin + Result := ReadFileName(HelpIndexFileName); +end; + +function TJclBorlandOpenHelp.GetLinkFileName: string; +begin + Result := ReadFileName(HelpLinkFileName); +end; + +function TJclBorlandOpenHelp.GetProjectFileName: string; +begin + Result := ReadFileName(HelpProjectFileName); +end; + +function TJclBorlandOpenHelp.ReadFileName(const FormatName: string): string; +begin + if HelpPrefix <> '' then + Result := Format(FormatName, [RootDirectory, HelpPrefix]) + else + raise EJclHelpUtilsException.CreateRes(@RsENoOpenHelp); +end; + +function TJclBorlandOpenHelp.RemoveHelpFile(const HelpFileName, IndexName: string): Boolean; +var + CntFileName, HelpName, CntName: string; + List: TStringList; + + procedure RemoveFromList(const FileName, Text: string); + var + I, Attr: Integer; + Found: Boolean; + begin + List.LoadFromFile(FileName); + Found := False; + for I := 0 to List.Count - 1 do + if AnsiSameText(Trim(List[I]), Text) then + begin + Found := True; + List.Delete(I); + Break; + end; + if Found then + begin + Attr := FileGetAttr(FileName); + FileSetAttr(FileName, faArchive); + List.SaveToFile(FileName); + FileSetAttr(FileName, Attr); + end; + end; + +begin + CntFileName := ChangeFileExt(HelpFileName, '.cnt'); + Result := FileExists(HelpFileName) and FileExists(CntFileName); + if Result then + begin + HelpName := ExtractFileName(HelpFileName); + CntName := ExtractFileName(CntFileName); + //RegDeleteEntry(HKEY_LOCAL_MACHINE, MSHelpSystemKeyName, HelpName); + //RegDeleteEntry(HKEY_LOCAL_MACHINE, MSHelpSystemKeyName, CntName); + List := TStringList.Create; + try + RemoveFromList(ContentFileName, Format(':Include %s', [CntName])); + RemoveFromList(LinkFileName, Format(':Link %s', [HelpName])); + RemoveFromList(IndexFileName, Format(':Index %s=%s', [IndexName, HelpName])); + SetFileLastWrite(ProjectFileName, Now); + FileDelete(GidFileName); + finally + List.Free; + end; + end; +end; + +//== { TJclHelp2Manager } ==================================================== + +const + Help2BorlandNameSpace = 'Borland.BDS%d'; + Help2DefaultKeyWord = '_DEFAULT'; + +constructor TJclHelp2Manager.Create(IDEVersionNumber: Integer); +begin + inherited Create; + FHxRegisterSession := nil; + FHxRegister := nil; + FHxPlugin := nil; + if IDEVersionNumber > 0 then + begin + if (IDEVersionNumber = 12) then + FIdeNameSpace := 'embarcadero.rs_xe5' + else + if (IDEVersionNumber = 11) then + FIdeNameSpace := 'embarcadero.rs_xe4' + else + if (IDEVersionNumber = 10) then + FIdeNameSpace := 'embarcadero.rs_xe3' + else + if (IDEVersionNumber = 9) then + FIdeNameSpace := 'embarcadero.rs_xe2' + else + if (IDEVersionNumber = 8) then + FIdeNameSpace := 'embarcadero.rs_xe' + else + if (IDEVersionNumber = 7) then + FIdeNameSpace := 'embarcadero.rs2010' + else + if (IDEVersionNumber = 6) then + FIdeNameSpace := 'embarcadero.rs2009' + else + FIdeNameSpace := Format(Help2BorlandNameSpace, [IDEVersionNumber]); + end + else + FIdeNameSpace := ''; +end; + +destructor TJclHelp2Manager.Destroy; +begin + FHxRegisterSession := nil; + FHxRegister := nil; + FHxPlugin := nil; + inherited Destroy; +end; + +function TJclHelp2Manager.CommitTransaction: Boolean; +begin + Result := RequireObject([hoRegisterSession]); + if Result then + begin + try + FHxRegisterSession.CommitTransaction; + except + Result := False; + end; + end; +end; + +function TJclHelp2Manager.CreateTransaction: Boolean; +begin + Result := RequireObject([hoRegisterSession]); + if Result then + begin + try + FHxRegisterSession.CreateTransaction(''); + except + Result := False; + end; + end; +end; + +function TJclHelp2Manager.GetHxPlugin: IHxPlugin; +begin + RequireObject([hoPlugin]); + Result := FHxPlugin; +end; + +function TJclHelp2Manager.GetHxRegister: IHxRegister; +begin + RequireObject([hoRegister]); + Result := FHxRegister; +end; + +function TJclHelp2Manager.GetHxRegisterSession: IHxRegisterSession; +begin + RequireObject([hoRegisterSession]); + Result := FHxRegisterSession; +end; + +function TJclHelp2Manager.PlugNameSpaceIn(const SourceNameSpace, TargetNameSpace: WideString): Boolean; +var + Help2Default: WideString; +begin + Result := RequireObject([hoPlugin]); + if Result then + begin + try + Help2Default := Help2DefaultKeyWord; + FHxPlugin.RegisterHelpPlugIn(TargetNameSpace, Help2Default, + SourceNameSpace, Help2Default, '', 0); + except + Result := False; + end; + end; +end; + +function TJclHelp2Manager.PlugNameSpaceInBorlandHelp( + const NameSpace: WideString): Boolean; +begin + Result := (IdeNamespace <> '') and PlugNameSpaceIn(NameSpace, IdeNamespace); +end; + +function TJclHelp2Manager.RegisterHelpFile(const NameSpace, Identifier: WideString; + const LangId: Integer; const HxSFile, HxIFile: WideString): Boolean; +begin + Result := RequireObject([hoRegister]); + if Result then + begin + try + FHxRegister.RegisterHelpFileSet(NameSpace, Identifier, LangId, HxSFile, + HxIFile, '', '', 0, 0, 0, 0); + except + Result := False; + end; + end; +end; + +function TJclHelp2Manager.RegisterNameSpace(const Name, Collection, Description: WideString): Boolean; +begin + Result := RequireObject([hoRegister]); + if Result then + begin + try + FHxRegister.RegisterNamespace(Name, Collection, Description); + except + Result := False; + end; + end; +end; + +function TJclHelp2Manager.RequireObject(HelpObjects: TJclHelp2Objects): Boolean; +begin + // dependencies + if (hoRegister in HelpObjects) or (hoPlugin in HelpObjects) then + Include(HelpObjects, hoRegisterSession); + + Result := True; + + if (hoRegisterSession in HelpObjects) and not Assigned(FHxRegisterSession) then + begin + try + FHxRegisterSession := CoHxRegisterSession.Create; + except + Result := False; + end; + end; + + if Result and (hoRegister in HelpObjects) and not Assigned(FHxRegister) then + begin + try + Result := Supports(FHxRegisterSession.GetRegistrationObject(HxRegisterSession_IHxRegister), + IHxRegister, FHxRegister); + except + Result := False; + end; + end; + + if Result and (hoPlugin in HelpObjects) and not Assigned(FHxPlugin) then + begin + try + Result := Supports(FHxRegisterSession.GetRegistrationObject(HxRegisterSession_IHxPlugIn), + IHxPlugin, FHxPlugin); + except + Result := False; + end; + end; +end; + +function TJclHelp2Manager.UnPlugNameSpace(const SourceNameSpace, TargetNameSpace: WideString): Boolean; +var + Help2Default: WideString; +begin + Result := RequireObject([hoPlugin]); + if Result then + begin + try + Help2Default := Help2DefaultKeyWord; + FHxPlugin.RemoveHelpPlugIn(TargetNameSpace, Help2Default, + SourceNameSpace, Help2Default, ''); + except + Result := False; + end; + end; +end; + +function TJclHelp2Manager.UnPlugNameSpaceFromBorlandHelp(const NameSpace: WideString): Boolean; +begin + Result := (IdeNamespace <> '') and UnPlugNameSpace(NameSpace, IdeNamespace); +end; + +function TJclHelp2Manager.UnregisterHelpFile(const NameSpace, Identifier: WideString; + const LangId: Integer): Boolean; +begin + Result := RequireObject([hoRegister]); + if Result then + begin + try + FHxRegister.RemoveHelpFile(NameSpace, Identifier, LangId); + except + Result := False; + end; + end; +end; + +function TJclHelp2Manager.UnregisterNameSpace(const Name: WideString): Boolean; +begin + Result := RequireObject([hoRegister]); + if Result then + begin + try + FHxRegister.RemoveNamespace(Name); + except + Result := False; + end; + end; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/windows/JclHookExcept.pas b/3rdParty/JCL/source/windows/JclHookExcept.pas index ca911dd6..10f92486 100644 --- a/3rdParty/JCL/source/windows/JclHookExcept.pas +++ b/3rdParty/JCL/source/windows/JclHookExcept.pas @@ -1,864 +1,864 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is JclHookExcept.pas. } -{ } -{ The Initial Developer of the Original Code is Petr Vones. Portions created by Petr Vones are } -{ Copyright (C) Petr Vones. All Rights Reserved. } -{ } -{ Contributor(s): } -{ Petr Vones (pvones) } -{ Robert Marquardt (marquardt) } -{ Andreas Hausladen (ahuser) } -{ } -{**************************************************************************************************} -{ } -{ Exception hooking routines } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -unit JclHookExcept; - -interface - -{$I jcl.inc} -{$I windowsonly.inc} - -uses - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - {$IFDEF HAS_UNITSCOPE} - Winapi.Windows, System.SysUtils, System.Classes; - {$ELSE ~HAS_UNITSCOPE} - Windows, SysUtils, Classes; - {$ENDIF ~HAS_UNITSCOPE} - -type - // Exception hooking notifiers routines -{$IFDEF BORLAND} - TJclExceptFilterProc = function(ExceptRecord: PExceptionRecord): Exception; -{$ENDIF BORLAND} - TJclExceptNotifyProc = procedure(ExceptObj: TObject; ExceptAddr: Pointer; OSException: Boolean); - TJclExceptNotifyProcEx = procedure(ExceptObj: TObject; ExceptAddr: Pointer; OSException: Boolean; StackPointer: Pointer); - TJclExceptNotifyMethod = procedure(ExceptObj: TObject; ExceptAddr: Pointer; OSException: Boolean) of object; - - TJclExceptNotifyPriority = (npNormal, npFirstChain); - -{$IFDEF BORLAND} -function JclAddExceptFilter(const FilterProc: TJclExceptFilterProc; Priority: TJclExceptNotifyPriority = npNormal): Boolean; -{$ENDIF BORLAND} -function JclAddExceptNotifier(const NotifyProc: TJclExceptNotifyProc; Priority: TJclExceptNotifyPriority = npNormal): Boolean; overload; -function JclAddExceptNotifier(const NotifyProc: TJclExceptNotifyProcEx; Priority: TJclExceptNotifyPriority = npNormal): Boolean; overload; -function JclAddExceptNotifier(const NotifyMethod: TJclExceptNotifyMethod; Priority: TJclExceptNotifyPriority = npNormal): Boolean; overload; - -{$IFDEF BORLAND} -function JclRemoveExceptFilter(const FilterProc: TJclExceptFilterProc): Boolean; -{$ENDIF BORLAND} -function JclRemoveExceptNotifier(const NotifyProc: TJclExceptNotifyProc): Boolean; overload; -function JclRemoveExceptNotifier(const NotifyProc: TJclExceptNotifyProcEx): Boolean; overload; -function JclRemoveExceptNotifier(const NotifyMethod: TJclExceptNotifyMethod): Boolean; overload; - -procedure JclReplaceExceptObj(NewExceptObj: Exception); - -// Exception hooking routines -function JclHookExceptions: Boolean; -function JclUnhookExceptions: Boolean; -function JclExceptionsHooked: Boolean; - -function JclHookExceptionsInModule(Module: HMODULE): Boolean; -function JclUnhookExceptionsInModule(Module: HMODULE): Boolean; - -// Exceptions hooking in libraries -type - TJclModuleArray = array of HMODULE; - -function JclInitializeLibrariesHookExcept: Boolean; -function JclHookedExceptModulesList(out ModulesList: TJclModuleArray): Boolean; - -// Hooking routines location info helper -function JclBelongsHookedCode(Address: Pointer): Boolean; - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\windows'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -uses - JclBase, - JclPeImage, - JclSysInfo, JclSysUtils; - -type - PExceptionArguments = ^TExceptionArguments; - TExceptionArguments = record - ExceptAddr: Pointer; - ExceptObj: Exception; - end; - -{$IFDEF BORLAND} - TFilterItem = class(TObject) - private - FExceptFilterProc: TJclExceptFilterProc; - FPriority: TJclExceptNotifyPriority; - public - constructor Create(const ExceptFilterProc: TJclExceptFilterProc; APriority: TJclExceptNotifyPriority); - function DoFilterException(ExceptRecord: PExceptionRecord; out ExceptObj: Exception): Boolean; - property Priority: TJclExceptNotifyPriority read FPriority; - end; -{$ENDIF BORLAND} - - TNotifierItem = class(TObject) - private - FNotifyMethod: TJclExceptNotifyMethod; - FNotifyProc: TJclExceptNotifyProc; - FNotifyProcEx: TJclExceptNotifyProcEx; - FPriority: TJclExceptNotifyPriority; - public - constructor Create(const NotifyProc: TJclExceptNotifyProc; Priority: TJclExceptNotifyPriority); overload; - constructor Create(const NotifyProc: TJclExceptNotifyProcEx; Priority: TJclExceptNotifyPriority); overload; - constructor Create(const NotifyMethod: TJclExceptNotifyMethod; Priority: TJclExceptNotifyPriority); overload; - procedure DoNotify(ExceptObj: TObject; ExceptAddr: Pointer; OSException: Boolean; StackPointer: Pointer); - property Priority: TJclExceptNotifyPriority read FPriority; - end; - -var - ExceptionsHooked: Boolean; - Kernel32_RaiseException: procedure (dwExceptionCode, dwExceptionFlags, - nNumberOfArguments: DWORD; lpArguments: PDWORD); stdcall; - {$IFDEF BORLAND} - SysUtils_ExceptObjProc: function (P: PExceptionRecord): Exception; - {$ENDIF BORLAND} - {$IFDEF FPC} - SysUtils_ExceptProc: TExceptProc; - {$ENDIF FPC} - Notifiers: TThreadList; - {$IFDEF BORLAND} - Filters: TThreadList; - {$ENDIF BORLAND} - -{$IFDEF HOOK_DLL_EXCEPTIONS} -const - JclHookExceptDebugHookName = '__JclHookExcept'; - -type - TJclHookExceptDebugHook = procedure(Module: HMODULE; Hook: Boolean); stdcall; - - TJclHookExceptModuleList = class(TObject) - private - FModules: TThreadList; - protected - procedure HookStaticModules; - public - constructor Create; - destructor Destroy; override; - class function JclHookExceptDebugHookAddr: Pointer; - procedure HookModule(Module: HMODULE); - procedure List(out ModulesList: TJclModuleArray); - procedure UnhookModule(Module: HMODULE); - end; - -var - HookExceptModuleList: TJclHookExceptModuleList; - JclHookExceptDebugHook: Pointer; - -exports - JclHookExceptDebugHook name JclHookExceptDebugHookName; -{$ENDIF HOOK_DLL_EXCEPTIONS} - -{$STACKFRAMES OFF} - -threadvar - Recursive: Boolean; - NewResultExc: Exception; - -//=== Helper routines ======================================================== - -function RaiseExceptionAddress: Pointer; -begin - Result := GetProcAddress(GetModuleHandle(kernel32), 'RaiseException'); - Assert(Result <> nil); -end; - -procedure FreeThreadObjList(var TheList: TThreadList); -var - I: Integer; -begin - with TheList.LockList do - try - for I := 0 to Count - 1 do - TObject(Items[I]).Free; - finally - TheList.UnlockList; - end; - FreeAndNil(TheList); -end; - -//=== { TFilterItem } ======================================================== - -{$IFDEF BORLAND} -constructor TFilterItem.Create(const ExceptFilterProc: TJclExceptFilterProc; APriority: TJclExceptNotifyPriority); -begin - FExceptFilterProc := ExceptFilterProc; - FPriority := APriority; -end; - -function TFilterItem.DoFilterException(ExceptRecord: PExceptionRecord; out ExceptObj: Exception): Boolean; -begin - if Assigned(FExceptFilterProc) then - begin - ExceptObj := FExceptFilterProc(ExceptRecord); - Result := ExceptObj <> nil; - end - else - Result := False; -end; -{$ENDIF BORLAND} - -//=== { TNotifierItem } ====================================================== - -constructor TNotifierItem.Create(const NotifyProc: TJclExceptNotifyProc; Priority: TJclExceptNotifyPriority); -begin - inherited Create; - FNotifyProc := NotifyProc; - FPriority := Priority; -end; - -constructor TNotifierItem.Create(const NotifyProc: TJclExceptNotifyProcEx; Priority: TJclExceptNotifyPriority); -begin - inherited Create; - FNotifyProcEx := NotifyProc; - FPriority := Priority; -end; - -constructor TNotifierItem.Create(const NotifyMethod: TJclExceptNotifyMethod; Priority: TJclExceptNotifyPriority); -begin - inherited Create; - FNotifyMethod := NotifyMethod; - FPriority := Priority; -end; - -procedure TNotifierItem.DoNotify(ExceptObj: TObject; ExceptAddr: Pointer; - OSException: Boolean; StackPointer: Pointer); -begin - if Assigned(FNotifyProc) then - FNotifyProc(ExceptObj, ExceptAddr, OSException) - else - if Assigned(FNotifyProcEx) then - FNotifyProcEx(ExceptObj, ExceptAddr, OSException, StackPointer) - else - if Assigned(FNotifyMethod) then - FNotifyMethod(ExceptObj, ExceptAddr, OSException); -end; - -function GetFramePointer: Pointer; -asm - {$IFDEF CPU32} - MOV EAX, EBP - {$ENDIF CPU32} - {$IFDEF CPU64} - MOV RAX, RBP - {$ENDIF CPU64} -end; - -{$STACKFRAMES ON} - -{$IFDEF BORLAND} -function DoExceptFilter(ExceptRecord: PExceptionRecord): Exception; -var - Priorities: TJclExceptNotifyPriority; - I: Integer; -begin - if Recursive then - Exit; - if Assigned(Filters) then - begin - Recursive := True; - try - with Filters.LockList do - try - for Priorities := High(Priorities) downto Low(Priorities) do - for I := 0 to Count - 1 do - with TFilterItem(Items[I]) do - if Priority = Priorities then - if DoFilterException(ExceptRecord, Result) then - Exit; - finally - Filters.UnlockList; - end; - // Nobody wanted to handle the external exception. Call the default handler. - Result := SysUtils_ExceptObjProc(ExceptRecord); - finally - Recursive := False; - end; - end; -end; -{$ENDIF BORLAND} - -procedure DoExceptNotify(ExceptObj: TObject; ExceptAddr: Pointer; OSException: Boolean; StackPointer: Pointer); -var - Priorities: TJclExceptNotifyPriority; - I: Integer; -begin - if Recursive then - Exit; - if Assigned(Notifiers) then - begin - Recursive := True; - NewResultExc := nil; - try - with Notifiers.LockList do - try - if Count = 1 then - begin - with TNotifierItem(Items[0]) do - DoNotify( ExceptObj, ExceptAddr, OSException, StackPointer); - end - else - begin - for Priorities := High(Priorities) downto Low(Priorities) do - for I := 0 to Count - 1 do - with TNotifierItem(Items[I]) do - if Priority = Priorities then - DoNotify(ExceptObj, ExceptAddr, OSException, StackPointer); - end; - finally - Notifiers.UnlockList; - end; - finally - Recursive := False; - end; - end; -end; - -procedure HookedRaiseException(ExceptionCode, ExceptionFlags, NumberOfArguments: DWORD; - Arguments: PExceptionArguments); stdcall; -const - MS_VC_EXCEPTION = $406D1388; - cDelphiException = $0EEDFADE; - cNonContinuable = 1; // Delphi exceptions - cNonContinuableException = $C0000025; // C++Builder exceptions (sounds like a bug) - DelphiNumberOfArguments = 7; - CBuilderNumberOfArguments = 8; -begin - if ((ExceptionFlags = cNonContinuable) or (ExceptionFlags = cNonContinuableException)) and - (ExceptionCode = cDelphiException) and - (NumberOfArguments in [DelphiNumberOfArguments, CBuilderNumberOfArguments]) - //TODO: The difference for Win64 is bigger than 100 Byte and the comment of JVCS revision 0.3 of - // JclDebug.pas, where HookedRaiseException has been added by Petr, isn't very informative - {$IFDEF CPU32} - and (TJclAddr(Arguments) = TJclAddr(@Arguments) + SizeOf(Pointer)) - {$ENDIF CPU32} - and (ExceptionCode <> MS_VC_EXCEPTION) // ignore TThread.NameThreadForDebugging - then - begin - DoExceptNotify(Arguments.ExceptObj, Arguments.ExceptAddr, False, GetFramePointer); - end; - Kernel32_RaiseException(ExceptionCode, ExceptionFlags, NumberOfArguments, PDWORD(Arguments)); -end; - -{$IFDEF BORLAND} -function HookedExceptObjProc(P: PExceptionRecord): Exception; -const - MS_VC_EXCEPTION = $406D1388; -var - NewResultExcCache: Exception; // TLS optimization -begin - if P.ExceptionCode <> MS_VC_EXCEPTION then - begin - Result := DoExceptFilter(P); - DoExceptNotify(Result, P^.ExceptionAddress, True, GetFramePointer); - NewResultExcCache := NewResultExc; - if NewResultExcCache <> nil then - Result := NewResultExcCache; - end - else - Result := SysUtils_ExceptObjProc(P); -end; -{$ENDIF BORLAND} - -{$IFDEF FPC} -procedure HookedExceptProc(Obj : TObject; Addr : Pointer; FrameCount:Longint; Frame: PPointer); -var - NewResultExcCache: Exception; // TLS optimization -begin - DoExceptNotify(Obj, Addr, True, GetFramePointer); - NewResultExcCache := NewResultExc; - if NewResultExcCache <> nil then - SysUtils_ExceptProc(NewResultExcCache, Addr, FrameCount, Frame) - else - SysUtils_ExceptProc(Obj, Addr, FrameCount, Frame) -end; -{$ENDIF FPC} - -{$IFNDEF STACKFRAMES_ON} -{$STACKFRAMES OFF} -{$ENDIF ~STACKFRAMES_ON} - -// Do not change ordering of HookedRaiseException, HookedExceptObjProc and JclBelongsHookedCode routines - -function JclBelongsHookedCode(Address: Pointer): Boolean; -begin - Result := (TJclAddr(@HookedRaiseException) < TJclAddr(@JclBelongsHookedCode)) and - (TJclAddr(@HookedRaiseException) <= TJclAddr(Address)) and - (TJclAddr(@JclBelongsHookedCode) > TJclAddr(Address)); -end; - -{$IFDEF BORLAND} -function JclAddExceptFilter(const FilterProc: TJclExceptFilterProc; Priority: TJclExceptNotifyPriority = npNormal): Boolean; -begin - Result := Assigned(FilterProc); - if Result then - with Filters.LockList do - try - Add(TFilterItem.Create(FilterProc, Priority)); - finally - Filters.UnlockList; - end; -end; -{$ENDIF BORLAND} - -function JclAddExceptNotifier(const NotifyProc: TJclExceptNotifyProc; Priority: TJclExceptNotifyPriority): Boolean; -begin - Result := Assigned(NotifyProc); - if Result then - with Notifiers.LockList do - try - Add(TNotifierItem.Create(NotifyProc, Priority)); - finally - Notifiers.UnlockList; - end; -end; - -function JclAddExceptNotifier(const NotifyProc: TJclExceptNotifyProcEx; Priority: TJclExceptNotifyPriority): Boolean; -begin - Result := Assigned(NotifyProc); - if Result then - with Notifiers.LockList do - try - Add(TNotifierItem.Create(NotifyProc, Priority)); - finally - Notifiers.UnlockList; - end; -end; - -function JclAddExceptNotifier(const NotifyMethod: TJclExceptNotifyMethod; Priority: TJclExceptNotifyPriority): Boolean; -begin - Result := Assigned(NotifyMethod); - if Result then - with Notifiers.LockList do - try - Add(TNotifierItem.Create(NotifyMethod, Priority)); - finally - Notifiers.UnlockList; - end; -end; - -{$IFDEF BORLAND} -function JclRemoveExceptFilter(const FilterProc: TJclExceptFilterProc): Boolean; -var - O: TFilterItem; - I: Integer; -begin - Result := Assigned(FilterProc); - if Result then - with Filters.LockList do - try - for I := 0 to Count - 1 do - begin - O := TFilterItem(Items[I]); - if @O.FExceptFilterProc = @FilterProc then - begin - O.Free; - Items[I] := nil; - end; - end; - Pack; - finally - Filters.UnlockList; - end; -end; -{$ENDIF BORLAND} - -function JclRemoveExceptNotifier(const NotifyProc: TJclExceptNotifyProc): Boolean; -var - O: TNotifierItem; - I: Integer; -begin - Result := Assigned(NotifyProc); - if Result then - with Notifiers.LockList do - try - for I := 0 to Count - 1 do - begin - O := TNotifierItem(Items[I]); - if @O.FNotifyProc = @NotifyProc then - begin - O.Free; - Items[I] := nil; - end; - end; - Pack; - finally - Notifiers.UnlockList; - end; -end; - -function JclRemoveExceptNotifier(const NotifyProc: TJclExceptNotifyProcEx): Boolean; -var - O: TNotifierItem; - I: Integer; -begin - Result := Assigned(NotifyProc); - if Result then - with Notifiers.LockList do - try - for I := 0 to Count - 1 do - begin - O := TNotifierItem(Items[I]); - if @O.FNotifyProcEx = @NotifyProc then - begin - O.Free; - Items[I] := nil; - end; - end; - Pack; - finally - Notifiers.UnlockList; - end; -end; - -function JclRemoveExceptNotifier(const NotifyMethod: TJclExceptNotifyMethod): Boolean; -var - O: TNotifierItem; - I: Integer; -begin - Result := Assigned(NotifyMethod); - if Result then - with Notifiers.LockList do - try - for I := 0 to Count - 1 do - begin - O := TNotifierItem(Items[I]); - if (TMethod(O.FNotifyMethod).Code = TMethod(NotifyMethod).Code) and - (TMethod(O.FNotifyMethod).Data = TMethod(NotifyMethod).Data) then - begin - O.Free; - Items[I] := nil; - end; - end; - Pack; - finally - Notifiers.UnlockList; - end; -end; - -procedure JclReplaceExceptObj(NewExceptObj: Exception); -begin - Assert(Recursive); - NewResultExc := NewExceptObj; -end; - -{$IFDEF BORLAND} -function GetCppRtlBase: Pointer; -const - {$IFDEF COMPILER6} { Delphi/C++Builder 6 } - CppRtlVersion = 60; - {$ELSE ~COMPILER6} - {$IFDEF RTL185} { Delphi/C++Builder 2007 were aiming for - binary compatibility with BDS2006, which - complicates things a bit } - CppRtlVersion = 80; - {$ELSE ~RTL185} - { Successive RTLDLL version numbers in the remaining cases: CB2006 has cc3270mt.dll, - CB2009 (= CB2006 + 2 releases) has cc3290mt.dll, CB2010 has cc32100mt.dll etc. } - CppRtlVersion = 70 + Trunc(RtlVersion - 18.0) * 10; - {$ENDIF ~RTL185} - {$ENDIF ~COMPILER6} -begin - Result := Pointer(GetModuleHandle(PChar(Format('cc32%dmt.dll', [CppRtlVersion])))); - { 'Result = nil' means that the C++ RTL has been linked statically or is not available at all; - in this case TJclPeMapImgHooks.ReplaceImport() is a no-op. The base module is also being - hooked separately, so we're covered. } -end; - -function HasCppRtl: Boolean; -begin - Result := GetCppRtlBase <> TJclPeMapImgHooks.SystemBase; -end; -{$ENDIF BORLAND} - -function JclHookExceptions: Boolean; -var - RaiseExceptionAddressCache: Pointer; -begin - RaiseExceptionAddressCache := RaiseExceptionAddress; - { Detect C++Builder applications and C++ packages loaded into Delphi applications. - Hook the C++ RTL regardless of ExceptionsHooked so that users can call JclHookException() after - loading a C++ package which might pull in the C++ RTL DLL. } - {$IFDEF BORLAND} - if HasCppRtl then - TJclPeMapImgHooks.ReplaceImport(GetCppRtlBase, kernel32, RaiseExceptionAddressCache, @HookedRaiseException); - {$ENDIF BORLAND} - if not ExceptionsHooked then - begin - Recursive := False; - with TJclPeMapImgHooks do - Result := ReplaceImport(SystemBase, kernel32, RaiseExceptionAddressCache, @HookedRaiseException); - if Result then - begin - @Kernel32_RaiseException := RaiseExceptionAddressCache; - {$IFDEF BORLAND} - SysUtils_ExceptObjProc := System.ExceptObjProc; - System.ExceptObjProc := @HookedExceptObjProc; - {$ENDIF BORLAND} - {$IFDEF FPC} - SysUtils_ExceptProc := System.ExceptProc; - System.ExceptProc := @HookedExceptProc; - {$ENDIF FPC} - end; - ExceptionsHooked := Result; - end - else - Result := True; -end; - -function JclUnhookExceptions: Boolean; -begin - {$IFDEF BORLAND} - if HasCppRtl then - TJclPeMapImgHooks.ReplaceImport (GetCppRtlBase, kernel32, @HookedRaiseException, @Kernel32_RaiseException); - {$ENDIF BORLAND} - if ExceptionsHooked then - begin - with TJclPeMapImgHooks do - ReplaceImport(SystemBase, kernel32, @HookedRaiseException, @Kernel32_RaiseException); - {$IFDEF BORLAND} - System.ExceptObjProc := @SysUtils_ExceptObjProc; - @SysUtils_ExceptObjProc := nil; - {$ENDIF BORLAND} - {$IFDEF FPC} - System.ExceptProc := @SysUtils_ExceptProc; - @SysUtils_ExceptProc := nil; - {$ENDIF FPC} - @Kernel32_RaiseException := nil; - Result := True; - ExceptionsHooked := False; - end - else - Result := True; -end; - -function JclExceptionsHooked: Boolean; -begin - Result := ExceptionsHooked; -end; - -function JclHookExceptionsInModule(Module: HMODULE): Boolean; -begin - Result := ExceptionsHooked and - TJclPeMapImgHooks.ReplaceImport(Pointer(Module), kernel32, RaiseExceptionAddress, @HookedRaiseException); -end; - -function JclUnhookExceptionsInModule(Module: HMODULE): Boolean; -begin - Result := ExceptionsHooked and - TJclPeMapImgHooks.ReplaceImport(Pointer(Module), kernel32, @HookedRaiseException, @Kernel32_RaiseException); -end; - -{$IFDEF HOOK_DLL_EXCEPTIONS} -// Exceptions hooking in libraries - -procedure JclHookExceptDebugHookProc(Module: HMODULE; Hook: Boolean); stdcall; -begin - if Hook then - HookExceptModuleList.HookModule(Module) - else - HookExceptModuleList.UnhookModule(Module); -end; - -function CallExportedHookExceptProc(Module: HMODULE; Hook: Boolean): Boolean; -var - HookExceptProcPtr: PPointer; - HookExceptProc: TJclHookExceptDebugHook; -begin - HookExceptProcPtr := TJclHookExceptModuleList.JclHookExceptDebugHookAddr; - Result := Assigned(HookExceptProcPtr); - if Result then - begin - @HookExceptProc := HookExceptProcPtr^; - if Assigned(HookExceptProc) then - HookExceptProc(Module, True); - end; -end; -{$ENDIF HOOK_DLL_EXCEPTIONS} - -function JclInitializeLibrariesHookExcept: Boolean; -begin - {$IFDEF HOOK_DLL_EXCEPTIONS} - if IsLibrary then - Result := CallExportedHookExceptProc(SystemTObjectInstance, True) - else - begin - if not Assigned(HookExceptModuleList) then - HookExceptModuleList := TJclHookExceptModuleList.Create; - Result := True; - end; - {$ELSE HOOK_DLL_EXCEPTIONS} - Result := True; - {$ENDIF HOOK_DLL_EXCEPTIONS} -end; - -function JclHookedExceptModulesList(out ModulesList: TJclModuleArray): Boolean; -begin - {$IFDEF HOOK_DLL_EXCEPTIONS} - Result := Assigned(HookExceptModuleList); - if Result then - HookExceptModuleList.List(ModulesList); - {$ELSE HOOK_DLL_EXCEPTIONS} - Result := False; - SetLength(ModulesList, 0); - {$ENDIF HOOK_DLL_EXCEPTIONS} -end; - -{$IFDEF HOOK_DLL_EXCEPTIONS} -procedure FinalizeLibrariesHookExcept; -begin - FreeAndNil(HookExceptModuleList); - if IsLibrary then - CallExportedHookExceptProc(SystemTObjectInstance, False); -end; - -//=== { TJclHookExceptModuleList } =========================================== - -constructor TJclHookExceptModuleList.Create; -begin - inherited Create; - FModules := TThreadList.Create; - HookStaticModules; - JclHookExceptDebugHook := @JclHookExceptDebugHookProc; -end; - -destructor TJclHookExceptModuleList.Destroy; -begin - JclHookExceptDebugHook := nil; - FreeAndNil(FModules); - inherited Destroy; -end; - -procedure TJclHookExceptModuleList.HookModule(Module: HMODULE); -begin - with FModules.LockList do - try - if IndexOf(Pointer(Module)) = -1 then - begin - Add(Pointer(Module)); - JclHookExceptionsInModule(Module); - end; - finally - FModules.UnlockList; - end; -end; - -procedure TJclHookExceptModuleList.HookStaticModules; -var - ModulesList: TStringList; - I: Integer; - Module: HMODULE; -begin - ModulesList := nil; - with FModules.LockList do - try - ModulesList := TStringList.Create; - if LoadedModulesList(ModulesList, GetCurrentProcessId, True) then - for I := 0 to ModulesList.Count - 1 do - begin - Module := HMODULE(ModulesList.Objects[I]); - if GetProcAddress(Module, JclHookExceptDebugHookName) <> nil then - HookModule(Module); - end; - finally - FModules.UnlockList; - ModulesList.Free; - end; -end; - -class function TJclHookExceptModuleList.JclHookExceptDebugHookAddr: Pointer; -var - HostModule: HMODULE; -begin - HostModule := GetModuleHandle(nil); - Result := GetProcAddress(HostModule, JclHookExceptDebugHookName); -end; - -procedure TJclHookExceptModuleList.List(out ModulesList: TJclModuleArray); -var - I: Integer; -begin - with FModules.LockList do - try - SetLength(ModulesList, Count); - for I := 0 to Count - 1 do - ModulesList[I] := HMODULE(Items[I]); - finally - FModules.UnlockList; - end; -end; - -procedure TJclHookExceptModuleList.UnhookModule(Module: HMODULE); -begin - with FModules.LockList do - try - Remove(Pointer(Module)); - finally - FModules.UnlockList; - end; -end; -{$ENDIF HOOK_DLL_EXCEPTIONS} - -initialization - Notifiers := TThreadList.Create; - {$IFDEF BORLAND} - Filters := TThreadList.Create; - {$ENDIF BORLAND} - {$IFDEF UNITVERSIONING} - RegisterUnitVersion(HInstance, UnitVersioning); - {$ENDIF UNITVERSIONING} - -finalization - {$IFDEF UNITVERSIONING} - UnregisterUnitVersion(HInstance); - {$ENDIF UNITVERSIONING} - {$IFDEF HOOK_DLL_EXCEPTIONS} - FinalizeLibrariesHookExcept; - {$ENDIF HOOK_DLL_EXCEPTIONS} - FreeThreadObjList(Notifiers); - {$IFDEF BORLAND} - FreeThreadObjList(Filters); - {$ENDIF BORLAND} - -end. +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclHookExcept.pas. } +{ } +{ The Initial Developer of the Original Code is Petr Vones. Portions created by Petr Vones are } +{ Copyright (C) Petr Vones. All Rights Reserved. } +{ } +{ Contributor(s): } +{ Petr Vones (pvones) } +{ Robert Marquardt (marquardt) } +{ Andreas Hausladen (ahuser) } +{ } +{**************************************************************************************************} +{ } +{ Exception hooking routines } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclHookExcept; + +interface + +{$I jcl.inc} +{$I windowsonly.inc} + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, System.SysUtils, System.Classes; + {$ELSE ~HAS_UNITSCOPE} + Windows, SysUtils, Classes; + {$ENDIF ~HAS_UNITSCOPE} + +type + // Exception hooking notifiers routines +{$IFDEF BORLAND} + TJclExceptFilterProc = function(ExceptRecord: PExceptionRecord): Exception; +{$ENDIF BORLAND} + TJclExceptNotifyProc = procedure(ExceptObj: TObject; ExceptAddr: Pointer; OSException: Boolean); + TJclExceptNotifyProcEx = procedure(ExceptObj: TObject; ExceptAddr: Pointer; OSException: Boolean; StackPointer: Pointer); + TJclExceptNotifyMethod = procedure(ExceptObj: TObject; ExceptAddr: Pointer; OSException: Boolean) of object; + + TJclExceptNotifyPriority = (npNormal, npFirstChain); + +{$IFDEF BORLAND} +function JclAddExceptFilter(const FilterProc: TJclExceptFilterProc; Priority: TJclExceptNotifyPriority = npNormal): Boolean; +{$ENDIF BORLAND} +function JclAddExceptNotifier(const NotifyProc: TJclExceptNotifyProc; Priority: TJclExceptNotifyPriority = npNormal): Boolean; overload; +function JclAddExceptNotifier(const NotifyProc: TJclExceptNotifyProcEx; Priority: TJclExceptNotifyPriority = npNormal): Boolean; overload; +function JclAddExceptNotifier(const NotifyMethod: TJclExceptNotifyMethod; Priority: TJclExceptNotifyPriority = npNormal): Boolean; overload; + +{$IFDEF BORLAND} +function JclRemoveExceptFilter(const FilterProc: TJclExceptFilterProc): Boolean; +{$ENDIF BORLAND} +function JclRemoveExceptNotifier(const NotifyProc: TJclExceptNotifyProc): Boolean; overload; +function JclRemoveExceptNotifier(const NotifyProc: TJclExceptNotifyProcEx): Boolean; overload; +function JclRemoveExceptNotifier(const NotifyMethod: TJclExceptNotifyMethod): Boolean; overload; + +procedure JclReplaceExceptObj(NewExceptObj: Exception); + +// Exception hooking routines +function JclHookExceptions: Boolean; +function JclUnhookExceptions: Boolean; +function JclExceptionsHooked: Boolean; + +function JclHookExceptionsInModule(Module: HMODULE): Boolean; +function JclUnhookExceptionsInModule(Module: HMODULE): Boolean; + +// Exceptions hooking in libraries +type + TJclModuleArray = array of HMODULE; + +function JclInitializeLibrariesHookExcept: Boolean; +function JclHookedExceptModulesList(out ModulesList: TJclModuleArray): Boolean; + +// Hooking routines location info helper +function JclBelongsHookedCode(Address: Pointer): Boolean; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + JclBase, + JclPeImage, + JclSysInfo, JclSysUtils; + +type + PExceptionArguments = ^TExceptionArguments; + TExceptionArguments = record + ExceptAddr: Pointer; + ExceptObj: Exception; + end; + +{$IFDEF BORLAND} + TFilterItem = class(TObject) + private + FExceptFilterProc: TJclExceptFilterProc; + FPriority: TJclExceptNotifyPriority; + public + constructor Create(const ExceptFilterProc: TJclExceptFilterProc; APriority: TJclExceptNotifyPriority); + function DoFilterException(ExceptRecord: PExceptionRecord; out ExceptObj: Exception): Boolean; + property Priority: TJclExceptNotifyPriority read FPriority; + end; +{$ENDIF BORLAND} + + TNotifierItem = class(TObject) + private + FNotifyMethod: TJclExceptNotifyMethod; + FNotifyProc: TJclExceptNotifyProc; + FNotifyProcEx: TJclExceptNotifyProcEx; + FPriority: TJclExceptNotifyPriority; + public + constructor Create(const NotifyProc: TJclExceptNotifyProc; Priority: TJclExceptNotifyPriority); overload; + constructor Create(const NotifyProc: TJclExceptNotifyProcEx; Priority: TJclExceptNotifyPriority); overload; + constructor Create(const NotifyMethod: TJclExceptNotifyMethod; Priority: TJclExceptNotifyPriority); overload; + procedure DoNotify(ExceptObj: TObject; ExceptAddr: Pointer; OSException: Boolean; StackPointer: Pointer); + property Priority: TJclExceptNotifyPriority read FPriority; + end; + +var + ExceptionsHooked: Boolean; + Kernel32_RaiseException: procedure (dwExceptionCode, dwExceptionFlags, + nNumberOfArguments: DWORD; lpArguments: PDWORD); stdcall; + {$IFDEF BORLAND} + SysUtils_ExceptObjProc: function (P: PExceptionRecord): Exception; + {$ENDIF BORLAND} + {$IFDEF FPC} + SysUtils_ExceptProc: TExceptProc; + {$ENDIF FPC} + Notifiers: TThreadList; + {$IFDEF BORLAND} + Filters: TThreadList; + {$ENDIF BORLAND} + +{$IFDEF HOOK_DLL_EXCEPTIONS} +const + JclHookExceptDebugHookName = '__JclHookExcept'; + +type + TJclHookExceptDebugHook = procedure(Module: HMODULE; Hook: Boolean); stdcall; + + TJclHookExceptModuleList = class(TObject) + private + FModules: TThreadList; + protected + procedure HookStaticModules; + public + constructor Create; + destructor Destroy; override; + class function JclHookExceptDebugHookAddr: Pointer; + procedure HookModule(Module: HMODULE); + procedure List(out ModulesList: TJclModuleArray); + procedure UnhookModule(Module: HMODULE); + end; + +var + HookExceptModuleList: TJclHookExceptModuleList; + JclHookExceptDebugHook: Pointer; + +exports + JclHookExceptDebugHook name JclHookExceptDebugHookName; +{$ENDIF HOOK_DLL_EXCEPTIONS} + +{$STACKFRAMES OFF} + +threadvar + Recursive: Boolean; + NewResultExc: Exception; + +//=== Helper routines ======================================================== + +function RaiseExceptionAddress: Pointer; +begin + Result := GetProcAddress(GetModuleHandle(kernel32), 'RaiseException'); + Assert(Result <> nil); +end; + +procedure FreeThreadObjList(var TheList: TThreadList); +var + I: Integer; +begin + with TheList.LockList do + try + for I := 0 to Count - 1 do + TObject(Items[I]).Free; + finally + TheList.UnlockList; + end; + FreeAndNil(TheList); +end; + +//=== { TFilterItem } ======================================================== + +{$IFDEF BORLAND} +constructor TFilterItem.Create(const ExceptFilterProc: TJclExceptFilterProc; APriority: TJclExceptNotifyPriority); +begin + FExceptFilterProc := ExceptFilterProc; + FPriority := APriority; +end; + +function TFilterItem.DoFilterException(ExceptRecord: PExceptionRecord; out ExceptObj: Exception): Boolean; +begin + if Assigned(FExceptFilterProc) then + begin + ExceptObj := FExceptFilterProc(ExceptRecord); + Result := ExceptObj <> nil; + end + else + Result := False; +end; +{$ENDIF BORLAND} + +//=== { TNotifierItem } ====================================================== + +constructor TNotifierItem.Create(const NotifyProc: TJclExceptNotifyProc; Priority: TJclExceptNotifyPriority); +begin + inherited Create; + FNotifyProc := NotifyProc; + FPriority := Priority; +end; + +constructor TNotifierItem.Create(const NotifyProc: TJclExceptNotifyProcEx; Priority: TJclExceptNotifyPriority); +begin + inherited Create; + FNotifyProcEx := NotifyProc; + FPriority := Priority; +end; + +constructor TNotifierItem.Create(const NotifyMethod: TJclExceptNotifyMethod; Priority: TJclExceptNotifyPriority); +begin + inherited Create; + FNotifyMethod := NotifyMethod; + FPriority := Priority; +end; + +procedure TNotifierItem.DoNotify(ExceptObj: TObject; ExceptAddr: Pointer; + OSException: Boolean; StackPointer: Pointer); +begin + if Assigned(FNotifyProc) then + FNotifyProc(ExceptObj, ExceptAddr, OSException) + else + if Assigned(FNotifyProcEx) then + FNotifyProcEx(ExceptObj, ExceptAddr, OSException, StackPointer) + else + if Assigned(FNotifyMethod) then + FNotifyMethod(ExceptObj, ExceptAddr, OSException); +end; + +function GetFramePointer: Pointer; +asm + {$IFDEF CPU32} + MOV EAX, EBP + {$ENDIF CPU32} + {$IFDEF CPU64} + MOV RAX, RBP + {$ENDIF CPU64} +end; + +{$STACKFRAMES ON} + +{$IFDEF BORLAND} +function DoExceptFilter(ExceptRecord: PExceptionRecord): Exception; +var + Priorities: TJclExceptNotifyPriority; + I: Integer; +begin + if Recursive then + Exit; + if Assigned(Filters) then + begin + Recursive := True; + try + with Filters.LockList do + try + for Priorities := High(Priorities) downto Low(Priorities) do + for I := 0 to Count - 1 do + with TFilterItem(Items[I]) do + if Priority = Priorities then + if DoFilterException(ExceptRecord, Result) then + Exit; + finally + Filters.UnlockList; + end; + // Nobody wanted to handle the external exception. Call the default handler. + Result := SysUtils_ExceptObjProc(ExceptRecord); + finally + Recursive := False; + end; + end; +end; +{$ENDIF BORLAND} + +procedure DoExceptNotify(ExceptObj: TObject; ExceptAddr: Pointer; OSException: Boolean; StackPointer: Pointer); +var + Priorities: TJclExceptNotifyPriority; + I: Integer; +begin + if Recursive then + Exit; + if Assigned(Notifiers) then + begin + Recursive := True; + NewResultExc := nil; + try + with Notifiers.LockList do + try + if Count = 1 then + begin + with TNotifierItem(Items[0]) do + DoNotify( ExceptObj, ExceptAddr, OSException, StackPointer); + end + else + begin + for Priorities := High(Priorities) downto Low(Priorities) do + for I := 0 to Count - 1 do + with TNotifierItem(Items[I]) do + if Priority = Priorities then + DoNotify(ExceptObj, ExceptAddr, OSException, StackPointer); + end; + finally + Notifiers.UnlockList; + end; + finally + Recursive := False; + end; + end; +end; + +procedure HookedRaiseException(ExceptionCode, ExceptionFlags, NumberOfArguments: DWORD; + Arguments: PExceptionArguments); stdcall; +const + MS_VC_EXCEPTION = $406D1388; + cDelphiException = $0EEDFADE; + cNonContinuable = 1; // Delphi exceptions + cNonContinuableException = $C0000025; // C++Builder exceptions (sounds like a bug) + DelphiNumberOfArguments = 7; + CBuilderNumberOfArguments = 8; +begin + if ((ExceptionFlags = cNonContinuable) or (ExceptionFlags = cNonContinuableException)) and + (ExceptionCode = cDelphiException) and + (NumberOfArguments in [DelphiNumberOfArguments, CBuilderNumberOfArguments]) + //TODO: The difference for Win64 is bigger than 100 Byte and the comment of JVCS revision 0.3 of + // JclDebug.pas, where HookedRaiseException has been added by Petr, isn't very informative + {$IFDEF CPU32} + and (TJclAddr(Arguments) = TJclAddr(@Arguments) + SizeOf(Pointer)) + {$ENDIF CPU32} + and (ExceptionCode <> MS_VC_EXCEPTION) // ignore TThread.NameThreadForDebugging + then + begin + DoExceptNotify(Arguments.ExceptObj, Arguments.ExceptAddr, False, GetFramePointer); + end; + Kernel32_RaiseException(ExceptionCode, ExceptionFlags, NumberOfArguments, PDWORD(Arguments)); +end; + +{$IFDEF BORLAND} +function HookedExceptObjProc(P: PExceptionRecord): Exception; +const + MS_VC_EXCEPTION = $406D1388; +var + NewResultExcCache: Exception; // TLS optimization +begin + if P.ExceptionCode <> MS_VC_EXCEPTION then + begin + Result := DoExceptFilter(P); + DoExceptNotify(Result, P^.ExceptionAddress, True, GetFramePointer); + NewResultExcCache := NewResultExc; + if NewResultExcCache <> nil then + Result := NewResultExcCache; + end + else + Result := SysUtils_ExceptObjProc(P); +end; +{$ENDIF BORLAND} + +{$IFDEF FPC} +procedure HookedExceptProc(Obj : TObject; Addr : Pointer; FrameCount:Longint; Frame: PPointer); +var + NewResultExcCache: Exception; // TLS optimization +begin + DoExceptNotify(Obj, Addr, True, GetFramePointer); + NewResultExcCache := NewResultExc; + if NewResultExcCache <> nil then + SysUtils_ExceptProc(NewResultExcCache, Addr, FrameCount, Frame) + else + SysUtils_ExceptProc(Obj, Addr, FrameCount, Frame) +end; +{$ENDIF FPC} + +{$IFNDEF STACKFRAMES_ON} +{$STACKFRAMES OFF} +{$ENDIF ~STACKFRAMES_ON} + +// Do not change ordering of HookedRaiseException, HookedExceptObjProc and JclBelongsHookedCode routines + +function JclBelongsHookedCode(Address: Pointer): Boolean; +begin + Result := (TJclAddr(@HookedRaiseException) < TJclAddr(@JclBelongsHookedCode)) and + (TJclAddr(@HookedRaiseException) <= TJclAddr(Address)) and + (TJclAddr(@JclBelongsHookedCode) > TJclAddr(Address)); +end; + +{$IFDEF BORLAND} +function JclAddExceptFilter(const FilterProc: TJclExceptFilterProc; Priority: TJclExceptNotifyPriority = npNormal): Boolean; +begin + Result := Assigned(FilterProc); + if Result then + with Filters.LockList do + try + Add(TFilterItem.Create(FilterProc, Priority)); + finally + Filters.UnlockList; + end; +end; +{$ENDIF BORLAND} + +function JclAddExceptNotifier(const NotifyProc: TJclExceptNotifyProc; Priority: TJclExceptNotifyPriority): Boolean; +begin + Result := Assigned(NotifyProc); + if Result then + with Notifiers.LockList do + try + Add(TNotifierItem.Create(NotifyProc, Priority)); + finally + Notifiers.UnlockList; + end; +end; + +function JclAddExceptNotifier(const NotifyProc: TJclExceptNotifyProcEx; Priority: TJclExceptNotifyPriority): Boolean; +begin + Result := Assigned(NotifyProc); + if Result then + with Notifiers.LockList do + try + Add(TNotifierItem.Create(NotifyProc, Priority)); + finally + Notifiers.UnlockList; + end; +end; + +function JclAddExceptNotifier(const NotifyMethod: TJclExceptNotifyMethod; Priority: TJclExceptNotifyPriority): Boolean; +begin + Result := Assigned(NotifyMethod); + if Result then + with Notifiers.LockList do + try + Add(TNotifierItem.Create(NotifyMethod, Priority)); + finally + Notifiers.UnlockList; + end; +end; + +{$IFDEF BORLAND} +function JclRemoveExceptFilter(const FilterProc: TJclExceptFilterProc): Boolean; +var + O: TFilterItem; + I: Integer; +begin + Result := Assigned(FilterProc); + if Result then + with Filters.LockList do + try + for I := 0 to Count - 1 do + begin + O := TFilterItem(Items[I]); + if @O.FExceptFilterProc = @FilterProc then + begin + O.Free; + Items[I] := nil; + end; + end; + Pack; + finally + Filters.UnlockList; + end; +end; +{$ENDIF BORLAND} + +function JclRemoveExceptNotifier(const NotifyProc: TJclExceptNotifyProc): Boolean; +var + O: TNotifierItem; + I: Integer; +begin + Result := Assigned(NotifyProc); + if Result then + with Notifiers.LockList do + try + for I := 0 to Count - 1 do + begin + O := TNotifierItem(Items[I]); + if @O.FNotifyProc = @NotifyProc then + begin + O.Free; + Items[I] := nil; + end; + end; + Pack; + finally + Notifiers.UnlockList; + end; +end; + +function JclRemoveExceptNotifier(const NotifyProc: TJclExceptNotifyProcEx): Boolean; +var + O: TNotifierItem; + I: Integer; +begin + Result := Assigned(NotifyProc); + if Result then + with Notifiers.LockList do + try + for I := 0 to Count - 1 do + begin + O := TNotifierItem(Items[I]); + if @O.FNotifyProcEx = @NotifyProc then + begin + O.Free; + Items[I] := nil; + end; + end; + Pack; + finally + Notifiers.UnlockList; + end; +end; + +function JclRemoveExceptNotifier(const NotifyMethod: TJclExceptNotifyMethod): Boolean; +var + O: TNotifierItem; + I: Integer; +begin + Result := Assigned(NotifyMethod); + if Result then + with Notifiers.LockList do + try + for I := 0 to Count - 1 do + begin + O := TNotifierItem(Items[I]); + if (TMethod(O.FNotifyMethod).Code = TMethod(NotifyMethod).Code) and + (TMethod(O.FNotifyMethod).Data = TMethod(NotifyMethod).Data) then + begin + O.Free; + Items[I] := nil; + end; + end; + Pack; + finally + Notifiers.UnlockList; + end; +end; + +procedure JclReplaceExceptObj(NewExceptObj: Exception); +begin + Assert(Recursive); + NewResultExc := NewExceptObj; +end; + +{$IFDEF BORLAND} +function GetCppRtlBase: Pointer; +const + {$IFDEF COMPILER6} { Delphi/C++Builder 6 } + CppRtlVersion = 60; + {$ELSE ~COMPILER6} + {$IFDEF RTL185} { Delphi/C++Builder 2007 were aiming for + binary compatibility with BDS2006, which + complicates things a bit } + CppRtlVersion = 80; + {$ELSE ~RTL185} + { Successive RTLDLL version numbers in the remaining cases: CB2006 has cc3270mt.dll, + CB2009 (= CB2006 + 2 releases) has cc3290mt.dll, CB2010 has cc32100mt.dll etc. } + CppRtlVersion = 70 + Trunc(RtlVersion - 18.0) * 10; + {$ENDIF ~RTL185} + {$ENDIF ~COMPILER6} +begin + Result := Pointer(GetModuleHandle(PChar(Format('cc32%dmt.dll', [CppRtlVersion])))); + { 'Result = nil' means that the C++ RTL has been linked statically or is not available at all; + in this case TJclPeMapImgHooks.ReplaceImport() is a no-op. The base module is also being + hooked separately, so we're covered. } +end; + +function HasCppRtl: Boolean; +begin + Result := GetCppRtlBase <> TJclPeMapImgHooks.SystemBase; +end; +{$ENDIF BORLAND} + +function JclHookExceptions: Boolean; +var + RaiseExceptionAddressCache: Pointer; +begin + RaiseExceptionAddressCache := RaiseExceptionAddress; + { Detect C++Builder applications and C++ packages loaded into Delphi applications. + Hook the C++ RTL regardless of ExceptionsHooked so that users can call JclHookException() after + loading a C++ package which might pull in the C++ RTL DLL. } + {$IFDEF BORLAND} + if HasCppRtl then + TJclPeMapImgHooks.ReplaceImport(GetCppRtlBase, kernel32, RaiseExceptionAddressCache, @HookedRaiseException); + {$ENDIF BORLAND} + if not ExceptionsHooked then + begin + Recursive := False; + with TJclPeMapImgHooks do + Result := ReplaceImport(SystemBase, kernel32, RaiseExceptionAddressCache, @HookedRaiseException); + if Result then + begin + @Kernel32_RaiseException := RaiseExceptionAddressCache; + {$IFDEF BORLAND} + SysUtils_ExceptObjProc := System.ExceptObjProc; + System.ExceptObjProc := @HookedExceptObjProc; + {$ENDIF BORLAND} + {$IFDEF FPC} + SysUtils_ExceptProc := System.ExceptProc; + System.ExceptProc := @HookedExceptProc; + {$ENDIF FPC} + end; + ExceptionsHooked := Result; + end + else + Result := True; +end; + +function JclUnhookExceptions: Boolean; +begin + {$IFDEF BORLAND} + if HasCppRtl then + TJclPeMapImgHooks.ReplaceImport (GetCppRtlBase, kernel32, @HookedRaiseException, @Kernel32_RaiseException); + {$ENDIF BORLAND} + if ExceptionsHooked then + begin + with TJclPeMapImgHooks do + ReplaceImport(SystemBase, kernel32, @HookedRaiseException, @Kernel32_RaiseException); + {$IFDEF BORLAND} + System.ExceptObjProc := @SysUtils_ExceptObjProc; + @SysUtils_ExceptObjProc := nil; + {$ENDIF BORLAND} + {$IFDEF FPC} + System.ExceptProc := @SysUtils_ExceptProc; + @SysUtils_ExceptProc := nil; + {$ENDIF FPC} + @Kernel32_RaiseException := nil; + Result := True; + ExceptionsHooked := False; + end + else + Result := True; +end; + +function JclExceptionsHooked: Boolean; +begin + Result := ExceptionsHooked; +end; + +function JclHookExceptionsInModule(Module: HMODULE): Boolean; +begin + Result := ExceptionsHooked and + TJclPeMapImgHooks.ReplaceImport(Pointer(Module), kernel32, RaiseExceptionAddress, @HookedRaiseException); +end; + +function JclUnhookExceptionsInModule(Module: HMODULE): Boolean; +begin + Result := ExceptionsHooked and + TJclPeMapImgHooks.ReplaceImport(Pointer(Module), kernel32, @HookedRaiseException, @Kernel32_RaiseException); +end; + +{$IFDEF HOOK_DLL_EXCEPTIONS} +// Exceptions hooking in libraries + +procedure JclHookExceptDebugHookProc(Module: HMODULE; Hook: Boolean); stdcall; +begin + if Hook then + HookExceptModuleList.HookModule(Module) + else + HookExceptModuleList.UnhookModule(Module); +end; + +function CallExportedHookExceptProc(Module: HMODULE; Hook: Boolean): Boolean; +var + HookExceptProcPtr: PPointer; + HookExceptProc: TJclHookExceptDebugHook; +begin + HookExceptProcPtr := TJclHookExceptModuleList.JclHookExceptDebugHookAddr; + Result := Assigned(HookExceptProcPtr); + if Result then + begin + @HookExceptProc := HookExceptProcPtr^; + if Assigned(HookExceptProc) then + HookExceptProc(Module, True); + end; +end; +{$ENDIF HOOK_DLL_EXCEPTIONS} + +function JclInitializeLibrariesHookExcept: Boolean; +begin + {$IFDEF HOOK_DLL_EXCEPTIONS} + if IsLibrary then + Result := CallExportedHookExceptProc(SystemTObjectInstance, True) + else + begin + if not Assigned(HookExceptModuleList) then + HookExceptModuleList := TJclHookExceptModuleList.Create; + Result := True; + end; + {$ELSE HOOK_DLL_EXCEPTIONS} + Result := True; + {$ENDIF HOOK_DLL_EXCEPTIONS} +end; + +function JclHookedExceptModulesList(out ModulesList: TJclModuleArray): Boolean; +begin + {$IFDEF HOOK_DLL_EXCEPTIONS} + Result := Assigned(HookExceptModuleList); + if Result then + HookExceptModuleList.List(ModulesList); + {$ELSE HOOK_DLL_EXCEPTIONS} + Result := False; + SetLength(ModulesList, 0); + {$ENDIF HOOK_DLL_EXCEPTIONS} +end; + +{$IFDEF HOOK_DLL_EXCEPTIONS} +procedure FinalizeLibrariesHookExcept; +begin + FreeAndNil(HookExceptModuleList); + if IsLibrary then + CallExportedHookExceptProc(SystemTObjectInstance, False); +end; + +//=== { TJclHookExceptModuleList } =========================================== + +constructor TJclHookExceptModuleList.Create; +begin + inherited Create; + FModules := TThreadList.Create; + HookStaticModules; + JclHookExceptDebugHook := @JclHookExceptDebugHookProc; +end; + +destructor TJclHookExceptModuleList.Destroy; +begin + JclHookExceptDebugHook := nil; + FreeAndNil(FModules); + inherited Destroy; +end; + +procedure TJclHookExceptModuleList.HookModule(Module: HMODULE); +begin + with FModules.LockList do + try + if IndexOf(Pointer(Module)) = -1 then + begin + Add(Pointer(Module)); + JclHookExceptionsInModule(Module); + end; + finally + FModules.UnlockList; + end; +end; + +procedure TJclHookExceptModuleList.HookStaticModules; +var + ModulesList: TStringList; + I: Integer; + Module: HMODULE; +begin + ModulesList := nil; + with FModules.LockList do + try + ModulesList := TStringList.Create; + if LoadedModulesList(ModulesList, GetCurrentProcessId, True) then + for I := 0 to ModulesList.Count - 1 do + begin + Module := HMODULE(ModulesList.Objects[I]); + if GetProcAddress(Module, JclHookExceptDebugHookName) <> nil then + HookModule(Module); + end; + finally + FModules.UnlockList; + ModulesList.Free; + end; +end; + +class function TJclHookExceptModuleList.JclHookExceptDebugHookAddr: Pointer; +var + HostModule: HMODULE; +begin + HostModule := GetModuleHandle(nil); + Result := GetProcAddress(HostModule, JclHookExceptDebugHookName); +end; + +procedure TJclHookExceptModuleList.List(out ModulesList: TJclModuleArray); +var + I: Integer; +begin + with FModules.LockList do + try + SetLength(ModulesList, Count); + for I := 0 to Count - 1 do + ModulesList[I] := HMODULE(Items[I]); + finally + FModules.UnlockList; + end; +end; + +procedure TJclHookExceptModuleList.UnhookModule(Module: HMODULE); +begin + with FModules.LockList do + try + Remove(Pointer(Module)); + finally + FModules.UnlockList; + end; +end; +{$ENDIF HOOK_DLL_EXCEPTIONS} + +initialization + Notifiers := TThreadList.Create; + {$IFDEF BORLAND} + Filters := TThreadList.Create; + {$ENDIF BORLAND} + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + {$IFDEF HOOK_DLL_EXCEPTIONS} + FinalizeLibrariesHookExcept; + {$ENDIF HOOK_DLL_EXCEPTIONS} + FreeThreadObjList(Notifiers); + {$IFDEF BORLAND} + FreeThreadObjList(Filters); + {$ENDIF BORLAND} + +end. diff --git a/3rdParty/JCL/source/windows/JclLANMan.pas b/3rdParty/JCL/source/windows/JclLANMan.pas new file mode 100644 index 00000000..2f231b47 --- /dev/null +++ b/3rdParty/JCL/source/windows/JclLANMan.pas @@ -0,0 +1,475 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclLANMan.pas. } +{ } +{ The Initial Developer of the Original Code is Peter Friese. } +{ Portions created by Peter Friese are Copyright (C) Peter Friese. All Rights Reserved. } +{ } +{ Contributors: } +{ Peter Friese } +{ Andreas Hausladen (ahuser) } +{ Robert Marquardt (marquardt) } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ } +{**************************************************************************************************} +{ } +{ This unit contains routines and classes to handle user and group management tasks. As the name } +{ implies, it uses the LAN Manager API. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +// Comments to Win9x compatibility of the functions used in this unit + +// The following function exist at last since Win95C, but return always +// the error ERROR_CALL_NOT_IMPLEMENTED +// AllocateAndInitializeSid, LookupAccountSID, FreeSID + +unit JclLANMan; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, System.SysUtils, System.Classes; + {$ELSE ~HAS_UNITSCOPE} + Windows, SysUtils, Classes; + {$ENDIF ~HAS_UNITSCOPE} + +// User Management +type + TNetUserFlag = (ufAccountDisable, ufHomedirRequired, ufLockout, + ufPasswordNotRequired, ufPasswordCantChange, ufDontExpirePassword, + ufMNSLogonAccount); + TNetUserFlags = set of TNetUserFlag; + TNetUserInfoFlag = (uifScript, uifTempDuplicateAccount, uifNormalAccount, + uifInterdomainTrustAccount, uifWorkstationTrustAccount, uifServerTrustAccount); + TNetUserInfoFlags = set of TNetUserInfoFlag; + TNetUserPriv = (upUnknown, upGuest, upUser, upAdmin); + TNetUserAuthFlag = (afOpPrint, afOpComm, afOpServer, afOpAccounts); + TNetUserAuthFlags = set of TNetUserAuthFlag; + TNetWellKnownRID = (wkrAdmins, wkrUsers, wkrGuests, wkrPowerUsers, wkrBackupOPs, + wkrReplicator, wkrEveryone); + +function CreateAccount(const Server, Username, Fullname, Password, Description, + Homedir, Script: string; + const PasswordNeverExpires: Boolean = True): Boolean; +function CreateLocalAccount(const Username, Fullname, Password, Description, + Homedir, Script: string; + const PasswordNeverExpires: Boolean = True): Boolean; +function DeleteAccount(const Servername, Username: string): Boolean; +function DeleteLocalAccount(Username: string): Boolean; +function CreateLocalGroup(const Server, Groupname, Description: string): Boolean; +function CreateGlobalGroup(const Server, Groupname, Description: string): Boolean; +function DeleteLocalGroup(const Server, Groupname: string): Boolean; + +function GetLocalGroups(const Server: string; const Groups: TStrings): Boolean; +function GetGlobalGroups(const Server: string; const Groups: TStrings): Boolean; +function LocalGroupExists(const Group: string): Boolean; +function GlobalGroupExists(const Server, Group: string): Boolean; + +function AddAccountToLocalGroup(const Accountname, Groupname: string): Boolean; +function LookupGroupName(const Server: string; const RID: TNetWellKnownRID): string; +procedure ParseAccountName(const QualifiedName: string; out Domain, UserName: string); +function IsLocalAccount(const AccountName: string): Boolean; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + JclBase, JclStrings, JclSysUtils, JclSysInfo, JclWin32; + +function CreateAccount(const Server, Username, Fullname, Password, Description, + Homedir, Script: string; const PasswordNeverExpires: Boolean): Boolean; +var + wServer, wUsername, wFullname, + wPassword, wDescription, wHomedir, wScript: WideString; + Details: USER_INFO_2; + Err: NET_API_STATUS; + ParmErr: DWORD; +begin + wServer := Server; + wUsername := Username; + wFullname := Fullname; + wPassword := Password; + wDescription := Description; + wScript := Script; + wHomedir := Homedir; + + ResetMemory(Details, SizeOf(Details)); + with Details do + begin + usri2_name := PWideChar(wUsername); + usri2_full_name := PWideChar(wFullname); + usri2_password := PWideChar(wPassword); + usri2_comment := PWideChar(wDescription); + usri2_priv := USER_PRIV_USER; + usri2_flags := UF_SCRIPT; + if PassWordNeverExpires then + usri2_flags := usri2_flags or UF_DONT_EXPIRE_PASSWD; + usri2_script_path := PWideChar(wScript); + usri2_home_dir := PWideChar(wHomedir); + usri2_acct_expires := TIMEQ_FOREVER; + end; + + Err := RtdlNetUserAdd(PWideChar(wServer), 2, @Details, @ParmErr); + Result := (Err = NERR_SUCCESS); +end; + +function CreateLocalAccount(const Username, Fullname, Password, Description, + Homedir, Script: string; const PasswordNeverExpires: Boolean): Boolean; +begin + Result := CreateAccount('', Username, Fullname, Password, Description, Homedir, + Script, PassWordNeverExpires); +end; + +function DeleteAccount(const Servername, Username: string): Boolean; +var + wServername, wUsername: WideString; + Err: NET_API_STATUS; +begin + wServername := Servername; + wUsername := Username; + Err := RtdlNetUserDel(PWideChar(wServername), PWideChar(wUsername)); + Result := (Err = NERR_SUCCESS); +end; + +function DeleteLocalAccount(Username: string): Boolean; +begin + Result := DeleteAccount('', Username); +end; + +function CreateGlobalGroup(const Server, Groupname, Description: string): Boolean; +var + wServer, wGroupname, wDescription: WideString; + Details: GROUP_INFO_1; + Err: NET_API_STATUS; + ParmErr: DWORD; +begin + wServer := Server; + wGroupname := Groupname; + wDescription := Description; + + ResetMemory(Details, SizeOf(Details)); + Details.grpi1_name := PWideChar(wGroupName); + Details.grpi1_comment := PWideChar(wDescription); + + Err := RtdlNetGroupAdd(PWideChar(wServer), 1, @Details, @ParmErr); + Result := (Err = NERR_SUCCESS); +end; + +function CreateLocalGroup(const Server, Groupname, Description: string): Boolean; +var + wServer, wGroupname, wDescription: WideString; + Details: LOCALGROUP_INFO_1; + Err: NET_API_STATUS; + ParmErr: DWORD; +begin + wServer := Server; + wGroupname := Groupname; + wDescription := Description; + + ResetMemory(Details, SizeOf(Details)); + Details.lgrpi1_name := PWideChar(wGroupName); + Details.lgrpi1_comment := PWideChar(wDescription); + + Err := RtdlNetLocalGroupAdd(PWideChar(wServer), 1, @Details, @ParmErr); + Result := (Err = NERR_SUCCESS); +end; + +function DeleteLocalGroup(const Server, Groupname: string): Boolean; +var + wServername, wUsername: WideString; + Err: NET_API_STATUS; +begin + wServername := Server; + wUsername := Groupname; + Err := RtdlNetLocalGroupDel(PWideChar(wServername), PWideChar(wUsername)); + Result := (Err = NERR_SUCCESS); +end; + +function GetLocalGroups(const Server: string; const Groups: TStrings): Boolean; +var + Err: NET_API_STATUS; + wServername: WideString; + Buffer: PByte; + Details: PLocalGroupInfo0; + EntriesRead, TotalEntries: Cardinal; + I: Integer; +begin + wServername := Server; + Err := RtdlNetLocalGroupEnum(PWideChar(wServername), 0, Buffer, MAX_PREFERRED_LENGTH, + EntriesRead, TotalEntries, nil); + + if Err = NERR_SUCCESS then + begin + Details := PLocalGroupInfo0(Buffer); + Groups.BeginUpdate; + try + for I := 0 to EntriesRead - 1 do + begin + Groups.Add(Details^.lgrpi0_name); + Inc(Details); + end; + finally + Groups.EndUpdate; + end; + end; + + RtdlNetApiBufferFree(Buffer); + Result := (Err = NERR_SUCCESS); +end; + +function GetGlobalGroups(const Server: string; const Groups: TStrings): Boolean; +var + Err: NET_API_STATUS; + wServername: WideString; + Buffer: PByte; + Details: PGroupInfo0; + EntriesRead, TotalEntries: Cardinal; + I: Integer; +begin + wServername := Server; + Err := RtdlNetGroupEnum(PWideChar(wServername), 0, Buffer, MAX_PREFERRED_LENGTH, + EntriesRead, TotalEntries, nil); + + if Err = NERR_SUCCESS then + begin + Details := PGroupInfo0(Buffer); + // (rom) is 'None' locale independent? + if (EntriesRead <> 1) or (Details^.grpi0_name <> 'None') then + begin + Groups.BeginUpdate; + try + for I := 0 to EntriesRead - 1 do + begin + Groups.Add(Details^.grpi0_name); + Inc(Details); + end; + finally + Groups.EndUpdate; + end; + end; + end + else + RaiseLastOSError; + + RtdlNetApiBufferFree(Buffer); + Result := (Err = NERR_SUCCESS); +end; + +function LocalGroupExists(const Group: string): Boolean; +var + Groups: TStringList; +begin + Groups := TStringList.Create; + try + GetLocalGroups('', Groups); + Result := (Groups.IndexOf(Group) >= 0); + finally + Groups.Free; + end; +end; + +function GlobalGroupExists(const Server, Group: string): Boolean; +var + Groups: TStringList; +begin + Groups := TStringList.Create; + try + GetGlobalGroups(Server, Groups); + Result := (Groups.IndexOf(Group) >= 0); + finally + Groups.Free; + end; +end; + +function DeleteGlobalGroup(const Server, Groupname: string): Boolean; +var + wServername, wUsername: WideString; + Err: NET_API_STATUS; +begin + wServername := Server; + wUsername := Groupname; + Err := RtdlNetGroupDel(PWideChar(wServername), PWideChar(wUsername)); + Result := (Err = NERR_SUCCESS); +end; + +function AddAccountToLocalGroup(const Accountname, Groupname: string): Boolean; +var + Err: NET_API_STATUS; + wAccountname, wGroupname: WideString; + Details: LOCALGROUP_MEMBERS_INFO_3; +begin + wGroupname := Groupname; + wAccountname := AccountName; + + Details.lgrmi3_domainandname := PWideChar(wAccountname); + Err := RtdlNetLocalGroupAddMembers(nil, PWideChar(wGroupname), 3, @Details, 1); + Result := (Err = NERR_SUCCESS); +end; + +function RIDToDWORD(const RID: TNetWellKnownRID): DWORD; +begin + case RID of + wkrAdmins: + Result := DOMAIN_ALIAS_RID_ADMINS; + wkrUsers: + Result := DOMAIN_ALIAS_RID_USERS; + wkrGuests: + Result := DOMAIN_ALIAS_RID_GUESTS; + wkrPowerUsers: + Result := DOMAIN_ALIAS_RID_POWER_USERS; + wkrBackupOPs: + Result := DOMAIN_ALIAS_RID_BACKUP_OPS; + wkrReplicator: + Result := DOMAIN_ALIAS_RID_REPLICATOR; + else // (wkrEveryone) + Result := SECURITY_WORLD_RID; + end; +end; + +function DWORDToRID(const RID: DWORD): TNetWellKnownRID; +begin + case RID of + DOMAIN_ALIAS_RID_ADMINS: + Result := wkrAdmins; + DOMAIN_ALIAS_RID_USERS: + Result := wkrUsers; + DOMAIN_ALIAS_RID_GUESTS: + Result := wkrGuests; + DOMAIN_ALIAS_RID_POWER_USERS: + Result := wkrPowerUsers; + DOMAIN_ALIAS_RID_BACKUP_OPS: + Result := wkrBackupOPs; + DOMAIN_ALIAS_RID_REPLICATOR: + Result := wkrReplicator; + else // (SECURITY_WORLD_RID) + Result := wkrEveryone; + end; +end; + +function LookupGroupName(const Server: string; const RID: TNetWellKnownRID): string; +var + sia: {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.SID_IDENTIFIER_AUTHORITY; + rd1, rd2: DWORD; + ridCount: Integer; + sd: PSID; + AccountNameLen, DomainNameLen: DWORD; + SidNameUse: SID_NAME_USE; + AccountName, DomainName: string; +begin + Result := ''; + AccountName := ''; + DomainName := ''; + rd2 := 0; + + if RID = wkrEveryOne then + begin + sia := SECURITY_WORLD_SID_AUTHORITY; + rd1 := RIDToDWORD(RID); + ridCount := 1; + end + else + begin + sia := SECURITY_NT_AUTHORITY; + rd1 := SECURITY_BUILTIN_DOMAIN_RID; + rd2 := RIDToDWORD(RID); + ridCount := 2; + end; + sd := nil; + if AllocateAndInitializeSid(sia, ridCount, rd1, rd2, 0, 0, 0, 0, 0, 0, sd) then + try + AccountNameLen := 0; + DomainNameLen := 0; + SidNameUse := SidTypeUnknown; + if not LookupAccountSID(PChar(Server), sd, PChar(AccountName), AccountNameLen, + PChar(DomainName), DomainNameLen, SidNameUse) then + begin + SetLength(AccountName, AccountNamelen); + SetLength(DomainName, DomainNameLen); + end; + + if LookupAccountSID(PChar(Server), sd, PChar(AccountName), AccountNameLen, + PChar(DomainName), DomainNameLen, sidNameUse) then + StrResetLength(AccountName) + else + RaiseLastOSError; + Result := AccountName; + finally + FreeSID(sd); + end; +end; + +procedure ParseAccountName(const QualifiedName: string; out Domain, UserName: string); +var + Parts: TStringList; +begin + Parts := TStringList.Create; + try + StrTokenToStrings(QualifiedName, '\', Parts); + if Parts.Count = 1 then + UserName := Parts[0] + else + begin + Domain := Parts[0]; + UserName := Parts[1]; + end; + finally + Parts.Free; + end; +end; + +function IsLocalAccount(const AccountName: string): Boolean; +var + Domain: string; + UserName: string; + LocalServerName: string; +begin + LocalServerName := GetLocalComputerName; + ParseAccountName(AccountName, Domain, UserName); + Result := (Domain = '') or (Domain = LocalServerName); +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/JclLocales.pas b/3rdParty/JCL/source/windows/JclLocales.pas new file mode 100644 index 00000000..e7ebe108 --- /dev/null +++ b/3rdParty/JCL/source/windows/JclLocales.pas @@ -0,0 +1,1037 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclLocales.pas. } +{ } +{ The Initial Developer of the Original Code is Petr Vones. } +{ Portions created by Petr Vones are Copyright (C) Petr Vones. All Rights Reserved. } +{ } +{ Contributors: } +{ Marcel van Brakel } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ } +{**************************************************************************************************} +{ } +{ This unit contains a set of classes which allow you to easily retrieve locale specific } +{ information such the list of keyboard layouts, names used for dates and characters used for } +{ formatting numbers and dates. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclLocales; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF FPC} + JwaWinNLS, + {$ENDIF FPC} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, System.SysUtils, System.Classes, System.Contnrs, + {$ELSE ~HAS_UNITSCOPE} + Windows, SysUtils, Classes, Contnrs, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclWin32; + +type + // System locales + TJclLocalesDays = 1..7; + TJclLocalesMonths = 1..13; + TJclLocaleDateFormats = (ldShort, ldLong, ldYearMonth); + + TJclLocaleInfo = class(TObject) + private + FCalendars: TStringList; + FDateFormats: array [TJclLocaleDateFormats] of TStringList; + FLocaleID: LCID; + FTimeFormats: TStringList; + FUseSystemACP: Boolean; + FValidCalendars: Boolean; + FValidDateFormatLists: set of TJclLocaleDateFormats; + FValidTimeFormatLists: Boolean; + function GetCalendars: TStrings; + function GetCalendarIntegerInfo(Calendar: CALID; InfoType: Integer): Integer; + function GetCalendarStringInfo(Calendar: CALID; InfoType: Integer): string; + function GetIntegerInfo(InfoType: Integer): Integer; + function GetStringInfo(InfoType: Integer): string; + function GetLangID: LANGID; + function GetSortID: Word; + function GetLangIDPrimary: Word; + function GetLangIDSub: Word; + function GetLongMonthNames(Month: TJclLocalesMonths): string; + function GetAbbreviatedMonthNames(Month: TJclLocalesMonths): string; + function GetLongDayNames(Day: TJclLocalesDays): string; + function GetAbbreviatedDayNames(Day: TJclLocalesDays): string; + function GetCharInfo(InfoType: Integer): Char; + function GetTimeFormats: TStrings; + function GetDateFormats(Format: TJclLocaleDateFormats): TStrings; + function GetFontCharset: Byte; + function GetCalTwoDigitYearMax(Calendar: CALID): Integer; + procedure SetUseSystemACP(const Value: Boolean); + procedure SetCharInfo(InfoType: Integer; const Value: Char); + procedure SetIntegerInfo(InfoType: Integer; const Value: Integer); + procedure SetStringInfo(InfoType: Integer; const Value: string); + public + constructor Create(ALocaleID: LCID = LOCALE_SYSTEM_DEFAULT); + destructor Destroy; override; + property CharInfo[InfoType: Integer]: Char read GetCharInfo write SetCharInfo; + property IntegerInfo[InfoType: Integer]: Integer read GetIntegerInfo write SetIntegerInfo; + property StringInfo[InfoType: Integer]: string read GetStringInfo write SetStringInfo; default; + property UseSystemACP: Boolean read FUseSystemACP write SetUseSystemACP; + property FontCharset: Byte read GetFontCharset; + property LangID: LANGID read GetLangID; + property LocaleID: LCID read FLocaleID; + property LangIDPrimary: Word read GetLangIDPrimary; + property LangIDSub: Word read GetLangIDSub; + property SortID: Word read GetSortID; + property DateFormats[Format: TJclLocaleDateFormats]: TStrings read GetDateFormats; + property TimeFormats: TStrings read GetTimeFormats; + // Languages + property LanguageIndentifier: string index LOCALE_ILANGUAGE read GetStringInfo; + property LocalizedLangName: string index LOCALE_SLANGUAGE read GetStringInfo; + property EnglishLangName: string index LOCALE_SENGLANGUAGE read GetStringInfo; + property AbbreviatedLangName: string index LOCALE_SABBREVLANGNAME read GetStringInfo; + property NativeLangName: string index LOCALE_SNATIVELANGNAME read GetStringInfo; + property ISOAbbreviatedLangName: string index LOCALE_SISO639LANGNAME read GetStringInfo; + // Countries + property CountryCode: Integer index LOCALE_ICOUNTRY read GetIntegerInfo; + property LocalizedCountryName: string index LOCALE_SCOUNTRY read GetStringInfo; + property EnglishCountryName: string index LOCALE_SENGCOUNTRY read GetStringInfo; + property AbbreviatedCountryName: string index LOCALE_SABBREVCTRYNAME read GetStringInfo; + property NativeCountryName: string index LOCALE_SNATIVECTRYNAME read GetStringInfo; + property ISOAbbreviatedCountryName: string index LOCALE_SISO3166CTRYNAME read GetStringInfo; + // Codepages + property DefaultLanguageId: Integer index LOCALE_IDEFAULTLANGUAGE read GetIntegerInfo; + property DefaultCountryCode: Integer index LOCALE_IDEFAULTCOUNTRY read GetIntegerInfo; + property DefaultCodePageEBCDIC: Integer index LOCALE_IDEFAULTEBCDICCODEPAGE read GetIntegerInfo; + property CodePageOEM: Integer index LOCALE_IDEFAULTCODEPAGE read GetIntegerInfo; + property CodePageANSI: Integer index LOCALE_IDEFAULTANSICODEPAGE read GetIntegerInfo; + property CodePageMAC: Integer index LOCALE_IDEFAULTMACCODEPAGE read GetIntegerInfo; + // Digits + property ListItemSeparator: Char index LOCALE_SLIST read GetCharInfo write SetCharInfo; + property Measure: Integer index LOCALE_IMEASURE read GetIntegerInfo write SetIntegerInfo; + property DecimalSeparator: Char index LOCALE_SDECIMAL read GetCharInfo write SetCharInfo; + property ThousandSeparator: Char index LOCALE_STHOUSAND read GetCharInfo write SetCharInfo; + property DigitGrouping: string index LOCALE_SGROUPING read GetStringInfo write SetStringInfo; + property NumberOfFractionalDigits: Integer index LOCALE_IDIGITS read GetIntegerInfo write SetIntegerInfo; + property LeadingZeros: Integer index LOCALE_ILZERO read GetIntegerInfo write SetIntegerInfo; + property NegativeNumberMode: Integer index LOCALE_INEGNUMBER read GetIntegerInfo write SetIntegerInfo; + property NativeDigits: string index LOCALE_SNATIVEDIGITS read GetStringInfo; + property DigitSubstitution: Integer index LOCALE_IDIGITSUBSTITUTION read GetIntegerInfo; + // Monetary + property MonetarySymbolLocal: string index LOCALE_SCURRENCY read GetStringInfo write SetStringInfo; + property MonetarySymbolIntl: string index LOCALE_SINTLSYMBOL read GetStringInfo; + property MonetaryDecimalSeparator: Char index LOCALE_SMONDECIMALSEP read GetCharInfo write SetCharInfo; + property MonetaryThousandsSeparator: Char index LOCALE_SMONTHOUSANDSEP read GetCharInfo write SetCharInfo; + property MonetaryGrouping: string index LOCALE_SMONGROUPING read GetStringInfo write SetStringInfo; + property NumberOfLocalMonetaryDigits: Integer index LOCALE_ICURRDIGITS read GetIntegerInfo write SetIntegerInfo; + property NumberOfIntlMonetaryDigits: Integer index LOCALE_IINTLCURRDIGITS read GetIntegerInfo; + property PositiveCurrencyMode: string index LOCALE_ICURRENCY read GetStringInfo write SetStringInfo; + property NegativeCurrencyMode: string index LOCALE_INEGCURR read GetStringInfo write SetStringInfo; + property EnglishCurrencyName: string index LOCALE_SENGCURRNAME read GetStringInfo; + property NativeCurrencyName: string index LOCALE_SNATIVECURRNAME read GetStringInfo; + // Date and time + property DateSeparator: Char index LOCALE_SDATE read GetCharInfo write SetCharInfo; + property TimeSeparator: Char index LOCALE_STIME read GetCharInfo write SetCharInfo; + property ShortDateFormat: string index LOCALE_SSHORTDATE read GetStringInfo write SetStringInfo; + property LongDateFormat: string index LOCALE_SLONGDATE read GetStringInfo write SetStringInfo; + property TimeFormatString: string index LOCALE_STIMEFORMAT read GetStringInfo write SetStringInfo; + property ShortDateOrdering: Integer index LOCALE_IDATE read GetIntegerInfo; + property LongDateOrdering: Integer index LOCALE_ILDATE read GetIntegerInfo; + property TimeFormatSpecifier: Integer index LOCALE_ITIME read GetIntegerInfo write SetIntegerInfo; + property TimeMarkerPosition: Integer index LOCALE_ITIMEMARKPOSN read GetIntegerInfo; + property CenturyFormatSpecifier: Integer index LOCALE_ICENTURY read GetIntegerInfo; + property LeadZerosInTime: Integer index LOCALE_ITLZERO read GetIntegerInfo; + property LeadZerosInDay: Integer index LOCALE_IDAYLZERO read GetIntegerInfo; + property LeadZerosInMonth: Integer index LOCALE_IMONLZERO read GetIntegerInfo; + property AMDesignator: string index LOCALE_S1159 read GetStringInfo write SetStringInfo; + property PMDesignator: string index LOCALE_S2359 read GetStringInfo write SetStringInfo; + property YearMonthFormat: string index LOCALE_SYEARMONTH read GetStringInfo write SetStringInfo; + // Calendar + property CalendarType: Integer index LOCALE_ICALENDARTYPE read GetIntegerInfo write SetIntegerInfo; + property AdditionalCalendarTypes: Integer index LOCALE_IOPTIONALCALENDAR read GetIntegerInfo; + property FirstDayOfWeek: Integer index LOCALE_IFIRSTDAYOFWEEK read GetIntegerInfo write SetIntegerInfo; + property FirstWeekOfYear: Integer index LOCALE_IFIRSTWEEKOFYEAR read GetIntegerInfo write SetIntegerInfo; + // Day and month names + property LongDayNames[Day: TJclLocalesDays]: string read GetLongDayNames; + property AbbreviatedDayNames[Day: TJclLocalesDays]: string read GetAbbreviatedDayNames; + property LongMonthNames[Month: TJclLocalesMonths]: string read GetLongMonthNames; + property AbbreviatedMonthNames[Month: TJclLocalesMonths]: string read GetAbbreviatedMonthNames; + // Sign + property PositiveSign: string index LOCALE_SPOSITIVESIGN read GetStringInfo write SetStringInfo; + property NegativeSign: string index LOCALE_SNEGATIVESIGN read GetStringInfo write SetStringInfo; + property PositiveSignPos: Integer index LOCALE_IPOSSIGNPOSN read GetIntegerInfo; + property NegativeSignPos: Integer index LOCALE_INEGSIGNPOSN read GetIntegerInfo; + property PosOfPositiveMonetarySymbol: Integer index LOCALE_IPOSSYMPRECEDES read GetIntegerInfo; + property SepOfPositiveMonetarySymbol: Integer index LOCALE_IPOSSEPBYSPACE read GetIntegerInfo; + property PosOfNegativeMonetarySymbol: Integer index LOCALE_INEGSYMPRECEDES read GetIntegerInfo; + property SepOfNegativeMonetarySymbol: Integer index LOCALE_INEGSEPBYSPACE read GetIntegerInfo; + // Misc + property DefaultPaperSize: Integer index LOCALE_IPAPERSIZE read GetIntegerInfo; + property FontSignature: string index LOCALE_FONTSIGNATURE read GetStringInfo; + property LocalizedSortName: string index LOCALE_SSORTNAME read GetStringInfo; + // Calendar Info + property Calendars: TStrings read GetCalendars; + property CalendarIntegerInfo[Calendar: CALID; InfoType: Integer]: Integer read GetCalendarIntegerInfo; + property CalendarStringInfo[Calendar: CALID; InfoType: Integer]: string read GetCalendarStringInfo; + property CalTwoDigitYearMax[Calendar: CALID]: Integer read GetCalTwoDigitYearMax; + end; + + TJclLocalesKind = (lkInstalled, lkSupported); + + TJclLocalesList = class(TObjectList) + private + FCodePages: TStringList; + FKind: TJclLocalesKind; + function GetItemFromLangID(LangID: LANGID): TJclLocaleInfo; + function GetItemFromLangIDPrimary(LangIDPrimary: Word): TJclLocaleInfo; + function GetItemFromLocaleID(LocaleID: LCID): TJclLocaleInfo; + function GetItems(Index: TJclListSize): TJclLocaleInfo; + function GetCodePages: TStrings; + protected + procedure CreateList; + public + constructor Create(AKind: TJclLocalesKind = lkInstalled); + destructor Destroy; override; + procedure FillStrings(AStrings: TStrings; InfoType: Integer); + property CodePages: TStrings read GetCodePages; + property ItemFromLangID[LangID: LANGID]: TJclLocaleInfo read GetItemFromLangID; + property ItemFromLangIDPrimary[LangIDPrimary: Word]: TJclLocaleInfo read GetItemFromLangIDPrimary; + property ItemFromLocaleID[LocaleID: LCID]: TJclLocaleInfo read GetItemFromLocaleID; + property Items[Index: TJclListSize]: TJclLocaleInfo read GetItems; default; + property Kind: TJclLocalesKind read FKind; + end; + + // Keyboard layouts + TJclKeybLayoutFlag = (klReorder, klUnloadPrevious, klSetForProcess, + klActivate, klNotEllShell, klReplaceLang, klSubstituteOK); + + TJclKeybLayoutFlags = set of TJclKeybLayoutFlag; + + TJclKeyboardLayoutList = class; + + TJclAvailableKeybLayout = class(TObject) + private + FIdentifier: DWORD; + FLayoutID: Word; + FLayoutFile: string; + FOwner: TJclKeyboardLayoutList; + FName: string; + function GetIdentifierName: string; + function GetLayoutFileExists: Boolean; + public + function Load(const LoadFlags: TJclKeybLayoutFlags): Boolean; + property Identifier: DWORD read FIdentifier; + property IdentifierName: string read GetIdentifierName; + property LayoutID: Word read FLayoutID; + property LayoutFile: string read FLayoutFile; + property LayoutFileExists: Boolean read GetLayoutFileExists; + property Name: string read FName; + end; + + TJclKeyboardLayout = class(TObject) + private + FLayout: HKL; + FLocaleInfo: TJclLocaleInfo; + FOwner: TJclKeyboardLayoutList; + function GetDeviceHandle: Word; + function GetDisplayName: string; + function GetLocaleID: Word; + function GetLocaleInfo: TJclLocaleInfo; + function GetVariationName: string; + public + constructor Create(AOwner: TJclKeyboardLayoutList; ALayout: HKL); + destructor Destroy; override; + function Activate(ActivateFlags: TJclKeybLayoutFlags = []): Boolean; + function Unload: Boolean; + property DeviceHandle: Word read GetDeviceHandle; + property DisplayName: string read GetDisplayName; + property Layout: HKL read FLayout; + property LocaleID: Word read GetLocaleID; + property LocaleInfo: TJclLocaleInfo read GetLocaleInfo; + property VariationName: string read GetVariationName; + end; + + TJclKeyboardLayoutList = class(TObject) + private + FAvailableLayouts: TObjectList; + FList: TObjectList; + FOnRefresh: TNotifyEvent; + function GetCount: Integer; + function GetItems(Index: Integer): TJclKeyboardLayout; + function GetActiveLayout: TJclKeyboardLayout; + function GetItemFromHKL(Layout: HKL): TJclKeyboardLayout; + function GetLayoutFromLocaleID(LocaleID: Word): TJclKeyboardLayout; + function GetAvailableLayoutCount: Integer; + function GetAvailableLayouts(Index: Integer): TJclAvailableKeybLayout; + protected + procedure CreateAvailableLayouts; + procedure DoRefresh; dynamic; + public + constructor Create; + destructor Destroy; override; + function ActivatePrevLayout(ActivateFlags: TJclKeybLayoutFlags = []): Boolean; + function ActivateNextLayout(ActivateFlags: TJclKeybLayoutFlags = []): Boolean; + function LoadLayout(const LayoutName: string; LoadFlags: TJclKeybLayoutFlags): Boolean; + procedure Refresh; + property ActiveLayout: TJclKeyboardLayout read GetActiveLayout; + property AvailableLayouts[Index: Integer]: TJclAvailableKeybLayout read GetAvailableLayouts; + property AvailableLayoutCount: Integer read GetAvailableLayoutCount; + property Count: Integer read GetCount; + property ItemFromHKL[Layout: HKL]: TJclKeyboardLayout read GetItemFromHKL; + property Items[Index: Integer]: TJclKeyboardLayout read GetItems; default; + property LayoutFromLocaleID[LocaleID: Word]: TJclKeyboardLayout read GetLayoutFromLocaleID; + property OnRefresh: TNotifyEvent read FOnRefresh write FOnRefresh; + end; + +// Various routines +procedure JclLocalesInfoList(const Strings: TStrings; InfoType: Integer = LOCALE_SENGCOUNTRY); + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysConst, + {$ELSE ~HAS_UNITSCOPE} + SysConst, + {$ENDIF ~HAS_UNITSCOPE} + JclFileUtils, JclRegistry, JclStrings, JclSysInfo, JclUnicode; + +const + JclMaxKeyboardLayouts = 16; + LocaleUseAcp: array [Boolean] of DWORD = (0, LOCALE_USE_CP_ACP); + +function KeybLayoutFlagsToDWORD(const ActivateFlags: TJclKeybLayoutFlags; + const LoadMode: Boolean): DWORD; +begin + Result := 0; + if klReorder in ActivateFlags then + Inc(Result, KLF_REORDER); + if (klUnloadPrevious in ActivateFlags) and IsWinNT then + Inc(Result, KLF_UNLOADPREVIOUS); + if (klSetForProcess in ActivateFlags) and JclCheckWinVersion(5, 0) then // Win2k or newer + Inc(Result, KLF_SETFORPROCESS); + if LoadMode then + begin + if klActivate in ActivateFlags then + Inc(Result, KLF_ACTIVATE); + if klNotEllShell in ActivateFlags then + Inc(Result, KLF_NOTELLSHELL); + if (klReplaceLang in ActivateFlags) and not IsWinNT3 then + Inc(Result, KLF_REPLACELANG); + if klSubstituteOK in ActivateFlags then + Inc(Result, KLF_SUBSTITUTE_OK); + end; +end; + +// EnumXXX functions helper thread variables +threadvar + ProcessedLocaleInfoList: TStrings; + ProcessedLocalesList: TJclLocalesList; + +//=== { TJclLocaleInfo } ===================================================== + +constructor TJclLocaleInfo.Create(ALocaleID: LCID); +begin + inherited Create; + FLocaleID := ALocaleID; + FUseSystemACP := True; + FValidDateFormatLists := []; +end; + +destructor TJclLocaleInfo.Destroy; +var + DateFormat: TJclLocaleDateFormats; +begin + FreeAndNil(FCalendars); + for DateFormat := Low(DateFormat) to High(DateFormat) do + FreeAndNil(FDateFormats[DateFormat]); + FreeAndNil(FTimeFormats); + inherited Destroy; +end; + +function TJclLocaleInfo.GetAbbreviatedDayNames(Day: TJclLocalesDays): string; +begin + Result := GetStringInfo(LOCALE_SABBREVDAYNAME1 + Day - 1); +end; + +function TJclLocaleInfo.GetAbbreviatedMonthNames(Month: TJclLocalesMonths): string; +var + Param: DWORD; +begin + case Month of + 1..12: + Param := LOCALE_SABBREVMONTHNAME1 + Month - 1; + 13: + Param := LOCALE_SABBREVMONTHNAME13; + else + raise ERangeError.CreateRes(@SRangeError); + end; + Result := GetStringInfo(Param); +end; + +function TJclLocaleInfo.GetCalendarIntegerInfo(Calendar: CALID; InfoType: Integer): Integer; +var + Ret: DWORD; +begin + InfoType := InfoType or Integer(LocaleUseAcp[FUseSystemACP]) or CAL_RETURN_NUMBER; + Ret := JclWin32.RtdlGetCalendarInfoW(FLocaleID, Calendar, InfoType, nil, 0, @Result); + if Ret = 0 then + Ret := JclWin32.RtdlGetCalendarInfoA(FLocaleID, Calendar, InfoType, nil, 0, @Result); + if Ret = 0 then + Result := 0; +end; + +function TJclLocaleInfo.GetCalTwoDigitYearMax(Calendar: CALID): Integer; +begin + Result := GetCalendarIntegerInfo(Calendar, CAL_ITWODIGITYEARMAX); +end; + +function EnumCalendarInfoProcEx(lpCalendarInfoString: PWideChar; Calendar: CALID): BOOL; stdcall; +begin + ProcessedLocaleInfoList.AddObject(lpCalendarInfoString, Pointer(Calendar)); + Result := True; +end; + +function EnumCalendarInfoProcName(lpCalendarInfoString: PChar): BOOL; stdcall; +begin + ProcessedLocaleInfoList.Add(lpCalendarInfoString); + Result := True; +end; + +function TJclLocaleInfo.GetCalendars: TStrings; +var + C: CALTYPE; + +begin + if not FValidCalendars then + begin + if FCalendars = nil then + FCalendars := TStringList.Create + else + FCalendars.Clear; + ProcessedLocaleInfoList := FCalendars; + try + C := CAL_SCALNAME or LocaleUseAcp[FUseSystemACP]; + if not JclWin32.RtdlEnumCalendarInfoExW(EnumCalendarInfoProcEx, FLocaleID, ENUM_ALL_CALENDARS, C) then + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.EnumCalendarInfo(@EnumCalendarInfoProcName, FLocaleID, ENUM_ALL_CALENDARS, C); + FValidCalendars := True; + finally + ProcessedLocaleInfoList := nil; + end; + end; + Result := FCalendars; +end; + +function TJclLocaleInfo.GetCalendarStringInfo(Calendar: CALID; InfoType: Integer): string; +var + Buffer: Pointer; + BufferSize: Integer; + Ret: DWORD; +begin + Result := ''; + InfoType := InfoType or Integer(LocaleUseAcp[FUseSystemACP]); + Buffer := nil; + try + BufferSize := 128; + repeat + ReallocMem(Buffer, BufferSize); + Ret := RtdlGetCalendarInfoW(FLocaleID, Calendar, InfoType, Buffer, BufferSize, nil); + if (Ret = 0) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then + BufferSize := RtdlGetCalendarInfoW(FLocaleID, Calendar, InfoType, Buffer, 0, nil) * 2; + until (Ret > 0) or (GetLastError <> ERROR_INSUFFICIENT_BUFFER); + if Ret > 0 then + Result := PWideChar(Buffer) + else + begin + BufferSize := 64; + repeat + ReallocMem(Buffer, BufferSize); + Ret := RtdlGetCalendarInfoA(FLocaleID, Calendar, InfoType, Buffer, BufferSize, nil); + if (Ret = 0) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then + BufferSize := RtdlGetCalendarInfoA(FLocaleID, Calendar, InfoType, Buffer, 0, nil); + until (Ret > 0) or (GetLastError <> ERROR_INSUFFICIENT_BUFFER); + if Ret > 0 then + Result := PChar(Buffer); + end; + finally + FreeMem(Buffer); + end; +end; + +function TJclLocaleInfo.GetCharInfo(InfoType: Integer): Char; +var + S: string; +begin + S := GetStringInfo(InfoType); + if Length(S) >= 1 then + Result := S[1] + else + Result := ' '; +end; + +function EnumDateFormatsProc(lpDateFormatString: LPWSTR): BOOL; stdcall; +begin + ProcessedLocaleInfoList.Add(lpDateFormatString); + DWORD(Result) := 1; +end; + +function TJclLocaleInfo.GetDateFormats(Format: TJclLocaleDateFormats): TStrings; +const + DateFormats: array [TJclLocaleDateFormats] of DWORD = + (DATE_SHORTDATE, DATE_LONGDATE, DATE_YEARMONTH); +begin + if not (Format in FValidDateFormatLists) then + begin + if FDateFormats[Format] = nil then + FDateFormats[Format] := TStringList.Create + else + FDateFormats[Format].Clear; + ProcessedLocaleInfoList := FDateFormats[Format]; + try + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.EnumDateFormatsW(@EnumDateFormatsProc, FLocaleID, DateFormats[Format] or + LocaleUseAcp[FUseSystemACP]); + Include(FValidDateFormatLists, Format); + finally + ProcessedLocaleInfoList := nil; + end; + end; + Result := FDateFormats[Format]; +end; + +function TJclLocaleInfo.GetFontCharset: Byte; +begin + Result := CharSetFromLocale(FLocaleID); +end; + +function TJclLocaleInfo.GetIntegerInfo(InfoType: Integer): Integer; +begin + Result := StrToIntDef(GetStringInfo(InfoType), 0); +end; + +function TJclLocaleInfo.GetLangID: LANGID; +begin + Result := LANGIDFROMLCID(FLocaleID); +end; + +function TJclLocaleInfo.GetLangIDPrimary: Word; +begin + Result := PRIMARYLANGID(LangID); +end; + +function TJclLocaleInfo.GetLangIDSub: Word; +begin + Result := SUBLANGID(LangID); +end; + +function TJclLocaleInfo.GetLongDayNames(Day: TJclLocalesDays): string; +begin + Result := GetStringInfo(LOCALE_SDAYNAME1 + Day - 1); +end; + +function TJclLocaleInfo.GetLongMonthNames(Month: TJclLocalesMonths): string; +var + Param: DWORD; +begin + if Month = 13 then + Param := LOCALE_SMONTHNAME13 + else + Param := LOCALE_SMONTHNAME1 + Month - 1; + Result := GetStringInfo(Param); +end; + +function TJclLocaleInfo.GetSortID: Word; +begin + Result := SORTIDFROMLCID(FLocaleID); +end; + +function TJclLocaleInfo.GetStringInfo(InfoType: Integer): string; +var + Res: Integer; + W: PWideChar; +begin + InfoType := InfoType or Integer(LocaleUseAcp[FUseSystemACP]); + Res := GetLocaleInfoA(FLocaleID, InfoType, nil, 0); + if Res > 0 then + begin + SetString(Result, nil, Res); + Res := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetLocaleInfo(FLocaleID, InfoType, PChar(Result), Res); + StrResetLength(Result); + // Note: GetLocaleInfo returns sometimes incorrect length of string on Win95 (usually plus 1), + // that's why StrResetLength is called. + end + else // GetLocaleInfoA failed + if IsWinNT then + begin + Res := GetLocaleInfoW(FLocaleID, InfoType, nil, 0); + if Res > 0 then + begin + GetMem(W, Res * SizeOf(WideChar)); + Res := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetLocaleInfoW(FLocaleID, InfoType, W, Res); + Result := WideCharToString(W); + FreeMem(W); + end; + end; + if Res = 0 then + Result := ''; +end; + +function EnumTimeFormatsProc(lpTimeFormatString: LPWSTR): BOOL; stdcall; +begin + ProcessedLocaleInfoList.Add(lpTimeFormatString); + DWORD(Result) := 1; +end; + +function TJclLocaleInfo.GetTimeFormats: TStrings; +begin + if not FValidTimeFormatLists then + begin + if FTimeFormats = nil then + FTimeFormats := TStringList.Create + else + FTimeFormats.Clear; + ProcessedLocaleInfoList := FTimeFormats; + try + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.EnumTimeFormatsW(@EnumTimeFormatsProc, FLocaleID, LocaleUseAcp[FUseSystemACP]); + FValidTimeFormatLists := True; + finally + ProcessedLocaleInfoList := nil; + end; + end; + Result := FTimeFormats; +end; + +procedure TJclLocaleInfo.SetCharInfo(InfoType: Integer; const Value: Char); +begin + SetStringInfo(InfoType, Value); +end; + +procedure TJclLocaleInfo.SetIntegerInfo(InfoType: Integer; const Value: Integer); +begin + SetStringInfo(InfoType, IntToStr(Value)); +end; + +procedure TJclLocaleInfo.SetStringInfo(InfoType: Integer; const Value: string); +begin + Win32Check({$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.SetLocaleInfo(FLocaleID, InfoType, PChar(Value))); +end; + +procedure TJclLocaleInfo.SetUseSystemACP(const Value: Boolean); +begin + if FUseSystemACP <> Value then + begin + FUseSystemACP := Value; + FValidCalendars := False; + FValidDateFormatLists := []; + FValidTimeFormatLists := False; + end; +end; + +//=== { TJclLocalesList } ==================================================== + +constructor TJclLocalesList.Create(AKind: TJclLocalesKind); +begin + inherited Create(True); + FCodePages := TStringList.Create; + FKind := AKind; + CreateList; +end; + +destructor TJclLocalesList.Destroy; +begin + FreeAndNil(FCodePages); + inherited Destroy; +end; + +function EnumLocalesProc(lpLocaleString: LPWSTR): BOOL; stdcall; +var + LocaleID: LCID; +begin + LocaleID := StrToIntDef('$' + Copy(lpLocaleString, 5, 4), 0); + if LocaleID > 0 then + ProcessedLocalesList.Add(TJclLocaleInfo.Create(LocaleID)); + DWORD(Result) := 1; +end; + +function EnumCodePagesProc(lpCodePageString: LPWSTR): BOOL; stdcall; +begin + ProcessedLocalesList.CodePages.AddObject(lpCodePageString, Pointer(StrToIntDef(lpCodePageString, 0))); + DWORD(Result) := 1; +end; + +procedure TJclLocalesList.CreateList; +const + Flags: array [TJclLocalesKind] of DWORD = (LCID_INSTALLED, LCID_SUPPORTED); +begin + ProcessedLocalesList := Self; + try + Win32Check({$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.EnumSystemLocalesW(@EnumLocalesProc, Flags[FKind])); + Win32Check({$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.EnumSystemCodePagesW(@EnumCodePagesProc, Flags[FKind])); + finally + ProcessedLocalesList := nil; + end; +end; + +procedure TJclLocalesList.FillStrings(AStrings: TStrings; InfoType: Integer); +var + I: Integer; +begin + AStrings.BeginUpdate; + try + for I := 0 to Count - 1 do + with Items[I] do + AStrings.AddObject(StringInfo[InfoType], Pointer(LocaleId)); + finally + AStrings.EndUpdate; + end; +end; + +function TJclLocalesList.GetCodePages: TStrings; +begin + Result := FCodePages; +end; + +function TJclLocalesList.GetItemFromLangID(LangID: LANGID): TJclLocaleInfo; +var + I: Integer; +begin + Result := nil; + for I := 0 to Count - 1 do + if Items[I].LangID = LangID then + begin + Result := Items[I]; + Break; + end; +end; + +function TJclLocalesList.GetItemFromLangIDPrimary(LangIDPrimary: Word): TJclLocaleInfo; +var + I: Integer; +begin + Result := nil; + for I := 0 to Count - 1 do + if Items[I].LangIDPrimary = LangIDPrimary then + begin + Result := Items[I]; + Break; + end; +end; + +function TJclLocalesList.GetItemFromLocaleID(LocaleID: LCID): TJclLocaleInfo; +var + I: Integer; +begin + Result := nil; + for I := 0 to Count - 1 do + if Items[I].LocaleID = LocaleID then + begin + Result := Items[I]; + Break; + end; +end; + +function TJclLocalesList.GetItems(Index: TJclListSize): TJclLocaleInfo; +begin + Result := TJclLocaleInfo(inherited Items[Index]); +end; + +//=== { TJclAvailableKeybLayout } ============================================ + +function TJclAvailableKeybLayout.GetIdentifierName: string; +begin + Result := Format('%.8x', [FIdentifier]); +end; + +function TJclAvailableKeybLayout.GetLayoutFileExists: Boolean; +begin + Result := FileExists(PathAddSeparator(GetWindowsSystemFolder) + LayoutFile); +end; + +function TJclAvailableKeybLayout.Load(const LoadFlags: TJclKeybLayoutFlags): Boolean; +begin + Result := FOwner.LoadLayout(IdentifierName, LoadFlags); +end; + +//=== { TJclKeyboardLayout } ================================================= + +constructor TJclKeyboardLayout.Create(AOwner: TJclKeyboardLayoutList; ALayout: HKL); +begin + inherited Create; + FLayout := ALayout; + FOwner := AOwner; +end; + +destructor TJclKeyboardLayout.Destroy; +begin + FreeAndNil(FLocaleInfo); + inherited Destroy; +end; + +function TJclKeyboardLayout.Activate(ActivateFlags: TJclKeybLayoutFlags): Boolean; +begin + Result := ActivateKeyboardLayout(FLayout, KeybLayoutFlagsToDWORD(ActivateFlags, False)) {$IFNDEF FPC} <> 0 {$ENDIF}; +end; + +function TJclKeyboardLayout.GetDeviceHandle: Word; +begin + Result := HiWord(FLayout); +end; + +function TJclKeyboardLayout.GetDisplayName: string; +begin + Result := LocaleInfo.LocalizedLangName; + if HiWord(FLayout) <> LoWord(FLayout) then + Result := Result + ' - ' + VariationName; +end; + +function TJclKeyboardLayout.GetLocaleID: Word; +begin + Result := LoWord(FLayout); +end; + +function TJclKeyboardLayout.GetLocaleInfo: TJclLocaleInfo; +begin + if FLocaleInfo = nil then + FLocaleInfo := TJclLocaleInfo.Create(MAKELCID(GetLocaleID, SORT_DEFAULT)); + Result := FLocaleInfo; +end; + +function TJclKeyboardLayout.GetVariationName: string; +var + I: Integer; + Ident: DWORD; +begin + Result := ''; + if HiWord(FLayout) = LoWord(FLayout) then + Ident := LoWord(FLayout) + else + Ident := FLayout and $0FFFFFFF; + with FOwner do + for I := 0 to AvailableLayoutCount - 1 do + with AvailableLayouts[I] do + if (LoWord(Identifier) = LoWord(Ident)) and (LayoutID = HiWord(Ident)) then + begin + Result := Name; + Break; + end; +end; + +function TJclKeyboardLayout.Unload: Boolean; +begin + Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.UnloadKeyboardLayout(FLayout); + if Result then + FOwner.Refresh; +end; + +//=== { TJclKeyboardLayoutList } ============================================= + +constructor TJclKeyboardLayoutList.Create; +begin + inherited Create; + FList := TObjectList.Create(True); + CreateAvailableLayouts; + Refresh; +end; + +destructor TJclKeyboardLayoutList.Destroy; +begin + FreeAndNil(FAvailableLayouts); + FreeAndNil(FList); + inherited Destroy; +end; + +function TJclKeyboardLayoutList.ActivateNextLayout(ActivateFlags: TJclKeybLayoutFlags): Boolean; +begin + Result := ActivateKeyboardLayout(HKL_NEXT, KeybLayoutFlagsToDWORD(ActivateFlags, False)) {$IFNDEF FPC} <> 0 {$ENDIF}; +end; + +function TJclKeyboardLayoutList.ActivatePrevLayout( + ActivateFlags: TJclKeybLayoutFlags): Boolean; +begin + Result := ActivateKeyboardLayout(HKL_PREV, KeybLayoutFlagsToDWORD(ActivateFlags, False)) {$IFNDEF FPC} <> 0 {$ENDIF}; +end; + +// Documentation: + +// HOWTO: How to Find the Available Keyboard Layouts Under Windows NT +// Microsoft Knowledge Base Article - 139571 +// http://support.microsoft.com/default.aspx?scid=kb;en-us;139571 + +// Description of Typical Control Subkeys of the HKLM Registry Key +// Microsoft Knowledge Base Article - 250447 +// http://support.microsoft.com/default.aspx?scid=kb;en-us;250447 + +// http://www.microsoft.com/windows2000/techinfo/reskit/en-us/regentry/28326.asp + +procedure TJclKeyboardLayoutList.CreateAvailableLayouts; +const + cLayoutsKey = 'SYSTEM\CurrentControlSet\Control\Keyboard Layouts'; +var + I: Integer; + KeyNames: TStringList; + Item: TJclAvailableKeybLayout; + Layout: string; +begin + FAvailableLayouts := TObjectList.Create(True); + KeyNames := TStringList.Create; + try + RegGetKeyNames(HKEY_LOCAL_MACHINE, cLayoutsKey, KeyNames); + for I := 0 to KeyNames.Count - 1 do + begin + Layout := cLayoutsKey + '\' + KeyNames[I]; + Item := TJclAvailableKeybLayout.Create; + Item.FOwner := Self; + Item.FIdentifier := StrToIntDef('$' + KeyNames[I], 0); + Item.FName := RegReadStringDef(HKEY_LOCAL_MACHINE, Layout, 'Layout Text', ''); + Item.FLayoutFile := RegReadStringDef(HKEY_LOCAL_MACHINE, Layout, 'Layout File', ''); + Item.FLayoutID := StrToIntDef('$' + RegReadStringDef(HKEY_LOCAL_MACHINE, Layout, 'Layout Id', ''), 0); + FAvailableLayouts.Add(Item); + end; + finally + KeyNames.Free; + end; +end; + +procedure TJclKeyboardLayoutList.DoRefresh; +begin + if Assigned(FOnRefresh) then + FOnRefresh(Self); +end; + +function TJclKeyboardLayoutList.GetActiveLayout: TJclKeyboardLayout; +begin + Result := ItemFromHKL[GetKeyboardLayout(0)]; +end; + +function TJclKeyboardLayoutList.GetAvailableLayoutCount: Integer; +begin + Result := FAvailableLayouts.Count; +end; + +function TJclKeyboardLayoutList.GetAvailableLayouts(Index: Integer): TJclAvailableKeybLayout; +begin + Result := TJclAvailableKeybLayout(FAvailableLayouts[Index]); +end; + +function TJclKeyboardLayoutList.GetCount: Integer; +begin + Result := FList.Count; +end; + +function TJclKeyboardLayoutList.GetItemFromHKL(Layout: HKL): TJclKeyboardLayout; +var + I: Integer; +begin + Result := nil; + for I := 0 to Count - 1 do + if Items[I].Layout = Layout then + begin + Result := Items[I]; + Break; + end; +end; + +function TJclKeyboardLayoutList.GetItems(Index: Integer): TJclKeyboardLayout; +begin + Result := TJclKeyboardLayout(FList[Index]); +end; + +function TJclKeyboardLayoutList.GetLayoutFromLocaleID(LocaleID: Word): TJclKeyboardLayout; +var + I: Integer; +begin + Result := nil; + for I := 0 to Count - 1 do + if Items[I].LocaleID = LocaleID then + begin + Result := Items[I]; + Break; + end; +end; + +function TJclKeyboardLayoutList.LoadLayout(const LayoutName: string; + LoadFlags: TJclKeybLayoutFlags): Boolean; +begin + Result := LoadKeyboardLayout(PChar(LayoutName), + KeybLayoutFlagsToDWORD(LoadFlags, True)) <> 0; + if Result then + Refresh; +end; + +procedure TJclKeyboardLayoutList.Refresh; +var + Cnt, I: Integer; + Layouts: array [1..JclMaxKeyboardLayouts] of HKL; +begin + Layouts[1] := 0; + Cnt := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.GetKeyboardLayoutList(JclMaxKeyboardLayouts, Layouts); + // Note: GetKeyboardLayoutList doesn't work as expected, when pass 0 to nBuff it always returns 0 + // on Win95. + FList.Clear; + for I := 1 to Cnt do + FList.Add(TJclKeyboardLayout.Create(Self, Layouts[I])); + DoRefresh; +end; + +{ TODO : related MSDN entries, maybe to implement } +// Enabling the Shift Lock Feature on Windows NT 4.0 +// Microsoft Knowledge Base Article - 174543 +// http://support.microsoft.com/default.aspx?scid=kb;en-us;174543 + +//=== Various routines ======================================================= + +procedure JclLocalesInfoList(const Strings: TStrings; InfoType: Integer); +begin + with TJclLocalesList.Create(lkInstalled) do + try + FillStrings(Strings, InfoType); + finally + Free; + end; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/JclMapi.pas b/3rdParty/JCL/source/windows/JclMapi.pas new file mode 100644 index 00000000..585da99d --- /dev/null +++ b/3rdParty/JCL/source/windows/JclMapi.pas @@ -0,0 +1,1451 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclMapi.pas. } +{ } +{ The Initial Developer of the Original Code is Petr Vones. } +{ Portions created by Petr Vones are Copyright (C) Petr Vones. All Rights Reserved. } +{ } +{ Contributors: } +{ Marcel van Brakel } +{ Robert Marquardt (marquardt) } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ Carsten Schuette (schuettecarsten) } +{ } +{**************************************************************************************************} +{ } +{ Various classes and support routines for sending e-mail through Simple MAPI } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclMapi; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, System.Classes, System.Contnrs, Winapi.Mapi, System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + Windows, Classes, Contnrs, Mapi, SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclAnsiStrings; + +type + EJclMapiError = class(EJclError) + private + FErrorCode: DWORD; + public + property ErrorCode: DWORD read FErrorCode; + end; + + // Simple MAPI interface + TJclMapiClient = record + ClientName: string; + ClientPath: string; + RegKeyName: string; + Valid: Boolean; + end; + + TJclMapiClientConnect = (ctAutomatic, ctMapi, ctDirect); + + TJclSimpleMapi = class(TObject) + private + FAnyClientInstalled: Boolean; + FBeforeUnloadClient: TNotifyEvent; + FClients: array of TJclMapiClient; + FClientConnectKind: TJclMapiClientConnect; + FClientLibHandle: THandle; + FDefaultClientIndex: Integer; + FDefaultProfileName: AnsiString; + FFunctions: array[0..11] of ^Pointer; + FMapiInstalled: Boolean; + FMapiVersion: string; + FProfiles: array of AnsiString; + FSelectedClientIndex: Integer; + FSimpleMapiInstalled: Boolean; + { TODO : consider to move this to a internal single instance class with smart linking } + FMapiAddress: TFNMapiAddress; + FMapiDeleteMail: TFNMapiDeleteMail; + FMapiDetails: TFNMapiDetails; + FMapiFindNext: TFNMapiFindNext; + FMapiFreeBuffer: TFNMapiFreeBuffer; + FMapiLogOff: TFNMapiLogOff; + FMapiLogOn: TFNMapiLogOn; + FMapiReadMail: TFNMapiReadMail; + FMapiResolveName: TFNMapiResolveName; + FMapiSaveMail: TFNMapiSaveMail; + FMapiSendDocuments: TFNMapiSendDocuments; + FMapiSendMail: TFNMapiSendMail; + function GetClientCount: Integer; + function GetClients(Index: Integer): TJclMapiClient; + function GetCurrentClientName: string; + function GetProfileCount: Integer; + function GetProfiles(Index: Integer): AnsiString; + procedure SetSelectedClientIndex(const Value: Integer); + procedure SetClientConnectKind(const Value: TJclMapiClientConnect); + function UseMapi: Boolean; + protected + procedure BeforeUnloadClientLib; dynamic; + procedure CheckListIndex(I, ArrayLength: Integer); + function GetClientLibName: string; + class function ProfilesRegKey: string; + procedure ReadMapiSettings; + public + constructor Create; + destructor Destroy; override; + function ClientLibLoaded: Boolean; + procedure LoadClientLib; + procedure UnloadClientLib; + property AnyClientInstalled: Boolean read FAnyClientInstalled; + property ClientConnectKind: TJclMapiClientConnect read FClientConnectKind write SetClientConnectKind; + property ClientCount: Integer read GetClientCount; + property Clients[Index: Integer]: TJclMapiClient read GetClients; default; + property CurrentClientName: string read GetCurrentClientName; + property DefaultClientIndex: Integer read FDefaultClientIndex; + property DefaultProfileName: AnsiString read FDefaultProfileName; + property MapiInstalled: Boolean read FMapiInstalled; + property MapiVersion: string read FMapiVersion; + property ProfileCount: Integer read GetProfileCount; + property Profiles[Index: Integer]: AnsiString read GetProfiles; + property SelectedClientIndex: Integer read FSelectedClientIndex write SetSelectedClientIndex; + property SimpleMapiInstalled: Boolean read FSimpleMapiInstalled; + property BeforeUnloadClient: TNotifyEvent read FBeforeUnloadClient write FBeforeUnloadClient; + // Simple MAPI functions + property MapiAddress: TFNMapiAddress read FMapiAddress; + property MapiDeleteMail: TFNMapiDeleteMail read FMapiDeleteMail; + property MapiDetails: TFNMapiDetails read FMapiDetails; + property MapiFindNext: TFNMapiFindNext read FMapiFindNext; + property MapiFreeBuffer: TFNMapiFreeBuffer read FMapiFreeBuffer; + property MapiLogOff: TFNMapiLogOff read FMapiLogOff; + property MapiLogOn: TFNMapiLogOn read FMapiLogOn; + property MapiReadMail: TFNMapiReadMail read FMapiReadMail; + property MapiResolveName: TFNMapiResolveName read FMapiResolveName; + property MapiSaveMail: TFNMapiSaveMail read FMapiSaveMail; + property MapiSendDocuments: TFNMapiSendDocuments read FMapiSendDocuments; + property MapiSendMail: TFNMapiSendMail read FMapiSendMail; + end; + +const + // Simple email classes + MapiAddressTypeSMTP = 'SMTP'; + MapiAddressTypeFAX = 'FAX'; + MapiAddressTypeTLX = 'TLX'; + +type + TJclEmailRecipKind = (rkOriginator, rkTO, rkCC, rkBCC); + + TJclEmailRecip = class(TObject) + private + FAddress: AnsiString; + FAddressType: AnsiString; + FKind: TJclEmailRecipKind; + FName: AnsiString; + private + procedure SetAddress(Value: AnsiString); + protected + function SortingName: AnsiString; + public + function AddressAndName: AnsiString; + class function RecipKindToString(const AKind: TJclEmailRecipKind): AnsiString; + property AddressType: AnsiString read FAddressType write FAddressType; + property Address: AnsiString read FAddress write SetAddress; + property Kind: TJclEmailRecipKind read FKind write FKind; + property Name: AnsiString read FName write FName; + end; + + TJclEmailRecips = class(TObjectList) + private + FAddressesType: AnsiString; + function GetItems(Index: TJclListSize): TJclEmailRecip; + function GetOriginator: TJclEmailRecip; + public + function Add(const Address: AnsiString; + const Name: AnsiString = ''; + const Kind: TJclEmailRecipKind = rkTO; + const AddressType: AnsiString = ''): Integer; + procedure SortRecips; + property AddressesType: AnsiString read FAddressesType write FAddressesType; + property Items[Index: TJclListSize]: TJclEmailRecip read GetItems; default; + property Originator: TJclEmailRecip read GetOriginator; + end; + + TJclEmailFindOption = (foFifo, foUnreadOnly); + TJclEmailLogonOption = (loLogonUI, loNewSession, loForceDownload); + TJclEmailReadOption = (roAttachments, roHeaderOnly, roMarkAsRead); + + TJclEmailFindOptions = set of TJclEmailFindOption; + TJclEmailLogonOptions = set of TJclEmailLogonOption; + TJclEmailReadOptions = set of TJclEmailReadOption; + + TJclEmailReadMsg = record + ConversationID: AnsiString; + DateReceived: TDateTime; + MessageType: AnsiString; + Flags: FLAGS; + end; + + TJclTaskWindowsList = array of THandle; + + TJclEmail = class(TJclSimpleMapi) + private + FAttachments: TJclAnsiStringList; + FBody: AnsiString; + FFindOptions: TJclEmailFindOptions; + FHtmlBody: Boolean; + FLogonOptions: TJclEmailLogonOptions; + FParentWnd: THandle; + FParentWndValid: Boolean; + FReadMsg: TJclEmailReadMsg; + FRecipients: TJclEmailRecips; + FSeedMessageID: AnsiString; + FSessionHandle: THandle; + FSubject: AnsiString; + FTaskWindowList: TJclTaskWindowsList; + FAttachmentFiles: TStringList; + function GetAttachments: TJclAnsiStrings; + function GetAttachmentFiles: TStrings; + function GetParentWnd: THandle; + function GetUserLogged: Boolean; + procedure SetBody(const Value: AnsiString); + procedure SetParentWnd(const Value: THandle); + protected + procedure BeforeUnloadClientLib; override; + procedure DecodeRecips(RecipDesc: PMapiRecipDesc; Count: Integer); + function InternalSendOrSave(Save: Boolean; ShowDialog: Boolean): Boolean; + function LogonOptionsToFlags(ShowDialog: Boolean): DWORD; + public + constructor Create; + destructor Destroy; override; + function Address(const Caption: AnsiString = ''; EditFields: Integer = 3): Boolean; + procedure Clear; + function Delete(const MessageID: AnsiString): Boolean; + function FindFirstMessage: Boolean; + function FindNextMessage: Boolean; + procedure LogOff; + procedure LogOn(const ProfileName: AnsiString = ''; const Password: AnsiString = ''); + function MessageReport(Strings: TStrings; MaxWidth: Integer = 80; IncludeAddresses: Boolean = False): Integer; + function Read(const Options: TJclEmailReadOptions = []): Boolean; + function ResolveName(var Name, Address: AnsiString; ShowDialog: Boolean = False): Boolean; + procedure RestoreTaskWindows; + function Save: Boolean; + procedure SaveTaskWindows; + function Send(ShowDialog: Boolean = True): Boolean; + procedure SortAttachments; + property Attachments: TJclAnsiStrings read GetAttachments; + property AttachmentFiles: TStrings read GetAttachmentFiles; + property Body: AnsiString read FBody write SetBody; + property FindOptions: TJclEmailFindOptions read FFindOptions write FFindOptions; + property HtmlBody: Boolean read FHtmlBody write FHtmlBody; + property LogonOptions: TJclEmailLogonOptions read FLogonOptions write FLogonOptions; + property ParentWnd: THandle read GetParentWnd write SetParentWnd; + property ReadMsg: TJclEmailReadMsg read FReadMsg; + property Recipients: TJclEmailRecips read FRecipients; + property SeedMessageID: AnsiString read FSeedMessageID write FSeedMessageID; + property SessionHandle: THandle read FSessionHandle; + property Subject: AnsiString read FSubject write FSubject; + property UserLogged: Boolean read GetUserLogged; + end; + +// Simple email send function +function JclSimpleSendMail(const Recipient, Name, Subject, Body: AnsiString; + const Attachment: TFileName = ''; ShowDialog: Boolean = True; ParentWND: THandle = 0; + const ProfileName: AnsiString = ''; const Password: AnsiString = ''): Boolean; + +function JclSimpleSendFax(const Recipient, Name, Subject, Body: AnsiString; + const Attachment: TFileName = ''; ShowDialog: Boolean = True; ParentWND: THandle = 0; + const ProfileName: AnsiString = ''; const Password: AnsiString = ''): Boolean; + +function JclSimpleBringUpSendMailDialog(const Subject, Body: AnsiString; + const Attachment: TFileName = ''; ParentWND: THandle = 0; + const ProfileName: AnsiString = ''; const Password: AnsiString = ''): Boolean; + +// MAPI Errors +function MapiCheck(const Res: DWORD; IgnoreUserAbort: Boolean = True): DWORD; + +function MapiErrorMessage(const ErrorCode: DWORD): string; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + {$IFDEF HAS_UNIT_ANSISTRINGS} + System.AnsiStrings, + {$ENDIF HAS_UNIT_ANSISTRINGS} + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF HAS_UNIT_ANSISTRINGS} + AnsiStrings, + {$ENDIF HAS_UNIT_ANSISTRINGS} + {$ENDIF ~HAS_UNITSCOPE} + JclFileUtils, JclLogic, JclPeImage, JclRegistry, JclResources, JclSysInfo, JclSysUtils; + +const + MapiDll = 'mapi32.dll'; + MapiExportNames: array [0..11] of PChar = ( + 'MAPIAddress', + 'MAPIDeleteMail', + 'MAPIDetails', + 'MAPIFindNext', + 'MAPIFreeBuffer', + 'MAPILogoff', + 'MAPILogon', + 'MAPIReadMail', + 'MAPIResolveName', + 'MAPISaveMail', + 'MAPISendDocuments', + 'MAPISendMail'); + AddressTypeDelimiter = AnsiChar(':'); + +//=== MAPI Errors check ====================================================== + +function MapiCheck(const Res: DWORD; IgnoreUserAbort: Boolean): DWORD; +var + Error: EJclMapiError; +begin + if (Res = SUCCESS_SUCCESS) or (IgnoreUserAbort and (Res = MAPI_E_USER_ABORT)) then + Result := Res + else + begin + Error := EJclMapiError.CreateResFmt(@RsMapiError, [Res, MapiErrorMessage(Res)]); + Error.FErrorCode := Res; + raise Error; + end; +end; + +function MapiErrorMessage(const ErrorCode: DWORD): string; +begin + case ErrorCode of + MAPI_E_USER_ABORT: + Result := LoadResString(@RsMapiErrUSER_ABORT); + MAPI_E_FAILURE: + Result := LoadResString(@RsMapiErrFAILURE); + MAPI_E_LOGIN_FAILURE: + Result := LoadResString(@RsMapiErrLOGIN_FAILURE); + MAPI_E_DISK_FULL: + Result := LoadResString(@RsMapiErrDISK_FULL); + MAPI_E_INSUFFICIENT_MEMORY: + Result := LoadResString(@RsMapiErrINSUFFICIENT_MEMORY); + MAPI_E_ACCESS_DENIED: + Result := LoadResString(@RsMapiErrACCESS_DENIED); + MAPI_E_TOO_MANY_SESSIONS: + Result := LoadResString(@RsMapiErrTOO_MANY_SESSIONS); + MAPI_E_TOO_MANY_FILES: + Result := LoadResString(@RsMapiErrTOO_MANY_FILES); + MAPI_E_TOO_MANY_RECIPIENTS: + Result := LoadResString(@RsMapiErrTOO_MANY_RECIPIENTS); + MAPI_E_ATTACHMENT_NOT_FOUND: + Result := LoadResString(@RsMapiErrATTACHMENT_NOT_FOUND); + MAPI_E_ATTACHMENT_OPEN_FAILURE: + Result := LoadResString(@RsMapiErrATTACHMENT_OPEN_FAILURE); + MAPI_E_ATTACHMENT_WRITE_FAILURE: + Result := LoadResString(@RsMapiErrATTACHMENT_WRITE_FAILURE); + MAPI_E_UNKNOWN_RECIPIENT: + Result := LoadResString(@RsMapiErrUNKNOWN_RECIPIENT); + MAPI_E_BAD_RECIPTYPE: + Result := LoadResString(@RsMapiErrBAD_RECIPTYPE); + MAPI_E_NO_MESSAGES: + Result := LoadResString(@RsMapiErrNO_MESSAGES); + MAPI_E_INVALID_MESSAGE: + Result := LoadResString(@RsMapiErrINVALID_MESSAGE); + MAPI_E_TEXT_TOO_LARGE: + Result := LoadResString(@RsMapiErrTEXT_TOO_LARGE); + MAPI_E_INVALID_SESSION: + Result := LoadResString(@RsMapiErrINVALID_SESSION); + MAPI_E_TYPE_NOT_SUPPORTED: + Result := LoadResString(@RsMapiErrTYPE_NOT_SUPPORTED); + MAPI_E_AMBIGUOUS_RECIPIENT: + Result := LoadResString(@RsMapiErrAMBIGUOUS_RECIPIENT); + MAPI_E_MESSAGE_IN_USE: + Result := LoadResString(@RsMapiErrMESSAGE_IN_USE); + MAPI_E_NETWORK_FAILURE: + Result := LoadResString(@RsMapiErrNETWORK_FAILURE); + MAPI_E_INVALID_EDITFIELDS: + Result := LoadResString(@RsMapiErrINVALID_EDITFIELDS); + MAPI_E_INVALID_RECIPS: + Result := LoadResString(@RsMapiErrINVALID_RECIPS); + MAPI_E_NOT_SUPPORTED: + Result := LoadResString(@RsMapiErrNOT_SUPPORTED); + else + Result := ''; + end; +end; + +function RestoreTaskWnds(Wnd: THandle; List: TJclTaskWindowsList): BOOL; stdcall; +var + I: Integer; + EnableIt: Boolean; +begin + if IsWindowVisible(Wnd) then + begin + EnableIt := False; + for I := 1 to Length(List) - 1 do + if List[I] = Wnd then + begin + EnableIt := True; + Break; + end; + EnableWindow(Wnd, EnableIt); + end; + Result := True; +end; + +procedure RestoreTaskWindowsList(const List: TJclTaskWindowsList); +var + I: Integer; +begin + if Length(List) > 0 then + begin + EnumThreadWindows(MainThreadID, @RestoreTaskWnds, LPARAM(List)); + for I := 0 to Length(List) - 1 do + EnableWindow(List[I], True); + SetFocus(List[0]); + end; +end; + +function SaveTaskWnds(Wnd: THandle; var Data: TJclTaskWindowsList): BOOL; stdcall; +var + C: Integer; +begin + if IsWindowVisible(Wnd) and IsWindowEnabled(Wnd) then + begin + C := Length(Data); + SetLength(Data, C + 1); + Data[C] := Wnd; + end; + Result := True; +end; + +function SaveTaskWindowsList: TJclTaskWindowsList; +begin + SetLength(Result, 1); + Result[0] := GetFocus; + EnumThreadWindows(MainThreadID, @SaveTaskWnds, LPARAM(@Result)); +end; + +//=== { TJclSimpleMapi } ===================================================== + +constructor TJclSimpleMapi.Create; +begin + inherited Create; + FFunctions[0] := @@FMapiAddress; + FFunctions[1] := @@FMapiDeleteMail; + FFunctions[2] := @@FMapiDetails; + FFunctions[3] := @@FMapiFindNext; + FFunctions[4] := @@FMapiFreeBuffer; + FFunctions[5] := @@FMapiLogOff; + FFunctions[6] := @@FMapiLogOn; + FFunctions[7] := @@FMapiReadMail; + FFunctions[8] := @@FMapiResolveName; + FFunctions[9] := @@FMapiSaveMail; + FFunctions[10] := @@FMapiSendDocuments; + FFunctions[11] := @@FMapiSendMail; + FDefaultClientIndex := -1; + FClientConnectKind := ctAutomatic; + FSelectedClientIndex := -1; + ReadMapiSettings; +end; + +destructor TJclSimpleMapi.Destroy; +begin + UnloadClientLib; + inherited Destroy; +end; + +procedure TJclSimpleMapi.BeforeUnloadClientLib; +begin + if Assigned(FBeforeUnloadClient) then + FBeforeUnloadClient(Self); +end; + +procedure TJclSimpleMapi.CheckListIndex(I, ArrayLength: Integer); +begin + if (I < 0) or (I >= ArrayLength) then + raise EJclMapiError.CreateResFmt(@RsMapiInvalidIndex, [I]); +end; + +function TJclSimpleMapi.ClientLibLoaded: Boolean; +begin + Result := FClientLibHandle <> 0; +end; + +function TJclSimpleMapi.GetClientCount: Integer; +begin + Result := Length(FClients); +end; + +function TJclSimpleMapi.GetClientLibName: string; +begin + if UseMapi then + Result := MapiDll + else + Result := FClients[FSelectedClientIndex].ClientPath; +end; + +function TJclSimpleMapi.GetClients(Index: Integer): TJclMapiClient; +begin + CheckListIndex(Index, ClientCount); + Result := FClients[Index]; +end; + +function TJclSimpleMapi.GetCurrentClientName: string; +begin + if UseMapi then + Result := 'MAPI' + else + if ClientCount > 0 then + Result := Clients[SelectedClientIndex].ClientName + else + Result := ''; +end; + +function TJclSimpleMapi.GetProfileCount: Integer; +begin + Result := Length(FProfiles); +end; + +function TJclSimpleMapi.GetProfiles(Index: Integer): AnsiString; +begin + CheckListIndex(Index, ProfileCount); + Result := FProfiles[Index]; +end; + +procedure TJclSimpleMapi.LoadClientLib; +var + I: Integer; + P: Pointer; +begin + if ClientLibLoaded then + Exit; + FClientLibHandle := SafeLoadLibrary(GetClientLibName); + if FClientLibHandle = 0 then + RaiseLastOSError; + for I := 0 to Length(FFunctions) - 1 do + begin + P := GetProcAddress(FClientLibHandle, PChar(MapiExportNames[I])); + if P = nil then + begin + UnloadClientLib; + raise EJclMapiError.CreateResFmt(@RsMapiMissingExport, [MapiExportNames[I]]); + end + else + FFunctions[I]^ := P; + end; +end; + +class function TJclSimpleMapi.ProfilesRegKey: string; +begin + if IsWinNT then + Result := 'SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles' + else + Result := 'SOFTWARE\Microsoft\Windows Messaging Subsystem\Profiles'; +end; + +procedure TJclSimpleMapi.ReadMapiSettings; +const + MessageSubsytemKey = 'SOFTWARE\Microsoft\Windows Messaging Subsystem'; + MailClientsKey = 'SOFTWARE\Clients\Mail'; +var + DefaultValue, ClientKey: string; + SL: TStringList; + I: Integer; + + function CheckPeImageTarget(const ClientPath: string): Boolean; + var + Img: TJclPeImage; + begin + Img := TJclPeImage.Create(True); + try + Img.FileName := ClientPath; + {$IFDEF CPU32} + Result := Img.Target = taWin32; + {$ENDIF CPU32} + {$IFDEF CPU64} + Result := Img.Target = taWin64; + {$ENDIF CPU64} + finally + Img.Free; + end; + end; + + function CheckValid(var Client: TJclMapiClient): Boolean; + var + I: Integer; + LibHandle: THandle; + begin + LibHandle := LoadLibraryEx(PChar(Client.ClientPath), 0, DONT_RESOLVE_DLL_REFERENCES); + Result := (LibHandle <> 0); + if Result then + begin + for I := Low(MapiExportNames) to High(MapiExportNames) do + if GetProcAddress(LibHandle, PChar(MapiExportNames[I])) = nil then + begin + Result := False; + Break; + end; + FreeLibrary(LibHandle); + end; + Client.Valid := Result; + end; + +begin + FClients := nil; + FDefaultClientIndex := -1; + FProfiles := nil; + FDefaultProfileName := ''; + SL := TStringList.Create; + try + if RegKeyExists(HKEY_LOCAL_MACHINE, MessageSubsytemKey) then + begin + FMapiInstalled := RegReadStringDef(HKEY_LOCAL_MACHINE, MessageSubsytemKey, 'MAPIX', '') = '1'; + FSimpleMapiInstalled := RegReadStringDef(HKEY_LOCAL_MACHINE, MessageSubsytemKey, 'MAPI', '') = '1'; + FMapiVersion := RegReadStringDef(HKEY_LOCAL_MACHINE, MessageSubsytemKey, 'MAPIXVER', ''); + end; + FAnyClientInstalled := FMapiInstalled; + if RegKeyExists(HKEY_CURRENT_USER, MailClientsKey) then + DefaultValue := RegReadStringDef(HKEY_CURRENT_USER, MailClientsKey, '', ''); + if RegKeyExists(HKEY_LOCAL_MACHINE, MailClientsKey) then + begin + if DefaultValue = '' then + DefaultValue := RegReadStringDef(HKEY_LOCAL_MACHINE, MailClientsKey, '', ''); + if RegGetKeyNames(HKEY_LOCAL_MACHINE, MailClientsKey, SL) then + begin + SetLength(FClients, SL.Count); + for I := 0 to SL.Count - 1 do + begin + FClients[I].RegKeyName := SL[I]; + FClients[I].Valid := False; + ClientKey := MailClientsKey + '\' + SL[I]; + if RegKeyExists(HKEY_LOCAL_MACHINE, ClientKey) then + begin + FClients[I].ClientName := RegReadStringDef(HKEY_LOCAL_MACHINE, ClientKey, '', ''); + FClients[I].ClientPath := RegReadStringDef(HKEY_LOCAL_MACHINE, ClientKey, 'DLLPathEx', ''); + ExpandEnvironmentVar(FClients[I].ClientPath); + if (FClients[I].ClientPath = '') or not CheckPeImageTarget(FClients[I].ClientPath) then + begin + FClients[I].ClientPath := RegReadStringDef(HKEY_LOCAL_MACHINE, ClientKey, 'DLLPath', ''); + ExpandEnvironmentVar(FClients[I].ClientPath); + if not CheckPeImageTarget(FClients[I].ClientPath) then + FClients[I].ClientPath := ''; + end; + if CheckValid(FClients[I]) then + FAnyClientInstalled := True; + end; + end; + FDefaultClientIndex := SL.IndexOf(DefaultValue); + FSelectedClientIndex := FDefaultClientIndex; + end; + end; + if RegKeyExists(HKEY_CURRENT_USER, ProfilesRegKey) then + begin + FDefaultProfileName := RegReadAnsiStringDef(HKEY_CURRENT_USER, ProfilesRegKey, 'DefaultProfile', ''); + if RegGetKeyNames(HKEY_CURRENT_USER, ProfilesRegKey, SL) then + begin + SetLength(FProfiles, SL.Count); + for I := 0 to SL.Count - 1 do + FProfiles[I] := AnsiString(SL[I]); + end; + end; + finally + SL.Free; + end; +end; + +procedure TJclSimpleMapi.SetClientConnectKind(const Value: TJclMapiClientConnect); +begin + if FClientConnectKind <> Value then + begin + FClientConnectKind := Value; + UnloadClientLib; + end; +end; + +procedure TJclSimpleMapi.SetSelectedClientIndex(const Value: Integer); +begin + CheckListIndex(Value, ClientCount); + if FSelectedClientIndex <> Value then + begin + FSelectedClientIndex := Value; + UnloadClientLib; + end; +end; + +procedure TJclSimpleMapi.UnloadClientLib; +var + I: Integer; +begin + if ClientLibLoaded then + begin + BeforeUnloadClientLib; + FreeLibrary(FClientLibHandle); + FClientLibHandle := 0; + for I := 0 to Length(FFunctions) - 1 do + FFunctions[I]^ := nil; + end; +end; + +function TJclSimpleMapi.UseMapi: Boolean; +begin + case FClientConnectKind of + ctAutomatic: + UseMapi := FSimpleMapiInstalled; + ctMapi: + UseMapi := True; + ctDirect: + UseMapi := False; + else + UseMapi := True; + end; +end; + +//=== { TJclEmailRecip } ===================================================== + +function TJclEmailRecip.AddressAndName: AnsiString; +var + N: AnsiString; +begin + if Name = '' then + N := Address + else + N := Name; + Result := AnsiString(Format('"%s" <%s>', [N, Address])); +end; + +class function TJclEmailRecip.RecipKindToString(const AKind: TJclEmailRecipKind): AnsiString; +begin + case AKind of + rkOriginator: + Result := AnsiString(LoadResString(@RsMapiMailORIG)); + rkTO: + Result := AnsiString(LoadResString(@RsMapiMailTO)); + rkCC: + Result := AnsiString(LoadResString(@RsMapiMailCC)); + rkBCC: + Result := AnsiString(LoadResString(@RsMapiMailBCC)); + end; +end; + +procedure TJclEmailRecip.SetAddress(Value: AnsiString); +var + N: Integer; +begin + Value := Trim(Value); + N := Pos(AddressTypeDelimiter, Value); + if N = 0 then + FAddress := Value + else + begin + FAddress := Copy(Value, N + 1, Length(Value)); + FAddressType := Copy(Value, 1, N - 1); + end; +end; + +function TJclEmailRecip.SortingName: AnsiString; +begin + if FName = '' then + Result := FAddress + else + Result := FName; +end; + +//=== { TJclEmailRecips } ==================================================== + +function TJclEmailRecips.Add(const Address, Name: AnsiString; + const Kind: TJclEmailRecipKind; const AddressType: AnsiString): Integer; +var + Item: TJclEmailRecip; +begin + Item := TJclEmailRecip.Create; + try + Item.Address := Address; + if AddressType <> '' then + Item.AddressType := AddressType; + Item.Name := Name; + Item.Kind := Kind; + Result := inherited Add(Item); + except + Item.Free; + raise; + end; +end; + +function TJclEmailRecips.GetItems(Index: TJclListSize): TJclEmailRecip; +begin + Result := TJclEmailRecip(Get(Index)); +end; + +function TJclEmailRecips.GetOriginator: TJclEmailRecip; +var + I: Integer; +begin + Result := nil; + for I := 0 to Count - 1 do + if Items[I].Kind = rkOriginator then + begin + Result := Items[I]; + Break; + end; +end; + +function EmailRecipsCompare(Item1, Item2: Pointer): Integer; +var + R1, R2: TJclEmailRecip; +begin + R1 := TJclEmailRecip(Item1); + R2 := TJclEmailRecip(Item2); + Result := Integer(R1.Kind) - Integer(R2.Kind); + if Result = 0 then + Result := AnsiCompareStr(R1.SortingName, R2.SortingName); +end; + +procedure TJclEmailRecips.SortRecips; +begin + Sort(EmailRecipsCompare); +end; + +//=== { TJclEmail } ========================================================== + +constructor TJclEmail.Create; +begin + inherited Create; + FAttachments := TJclAnsiStringList.Create; + FAttachmentFiles := TStringList.Create; + FLogonOptions := [loLogonUI]; + FFindOptions := [foFifo]; + FRecipients := TJclEmailRecips.Create(True); + FRecipients.AddressesType := MapiAddressTypeSMTP; +end; + +destructor TJclEmail.Destroy; +begin + FreeAndNil(FAttachmentFiles); + FreeAndNil(FAttachments); + FreeAndNil(FRecipients); + inherited Destroy; +end; + +function TJclEmail.Address(const Caption: AnsiString; EditFields: Integer): Boolean; +var + NewRecipCount: ULONG; + NewRecips: PMapiRecipDesc; + Recips: TMapiRecipDesc; + Res: DWORD; +begin + LoadClientLib; + NewRecips := nil; + NewRecipCount := 0; + Res := MapiAddress(FSessionHandle, ParentWnd, PAnsiChar(Caption), EditFields, nil, + 0, Recips, LogonOptionsToFlags(False), 0, @NewRecipCount, NewRecips); + Result := (MapiCheck(Res, True) = SUCCESS_SUCCESS); + if Result then + try + DecodeRecips(NewRecips, NewRecipCount); + finally + MapiFreeBuffer(NewRecips); + end; +end; + +procedure TJclEmail.BeforeUnloadClientLib; +begin + LogOff; + inherited BeforeUnloadClientLib; +end; + +procedure TJclEmail.Clear; +begin + Attachments.Clear; + AttachmentFiles.Clear; + Body := ''; + FSubject := ''; + Recipients.Clear; + FReadMsg.MessageType := ''; + FReadMsg.DateReceived := 0; + FReadMsg.ConversationID := ''; + FReadMsg.Flags := 0; +end; + +procedure TJclEmail.DecodeRecips(RecipDesc: PMapiRecipDesc; Count: Integer); +var + S: AnsiString; + N, I: Integer; + Kind: TJclEmailRecipKind; +begin + for I := 0 to Count - 1 do + begin + if RecipDesc = nil then + Break; + Kind := rkOriginator; + with RecipDesc^ do + begin + case ulRecipClass of + MAPI_ORIG: + Kind := rkOriginator; + MAPI_TO: + Kind := rkTO; + MAPI_CC: + Kind := rkCC; + MAPI_BCC: + Kind := rkBCC; + $FFFFFFFF: // Eudora client version 5.2.0.9 bug + Kind := rkOriginator; + else + MapiCheck(MAPI_E_INVALID_MESSAGE, True); + end; + S := AnsiString(lpszAddress); + N := Pos(AddressTypeDelimiter, S); + if N = 0 then + Recipients.Add(S, lpszName, Kind) + else + Recipients.Add(Copy(S, N + 1, Length(S)), AnsiString(lpszName), Kind, Copy(S, 1, N - 1)); + end; + Inc(RecipDesc); + end; +end; + +function TJclEmail.Delete(const MessageID: AnsiString): Boolean; +begin + LoadClientLib; + Result := MapiCheck(MapiDeleteMail(FSessionHandle, 0, PAnsiChar(MessageID), 0, 0), + False) = SUCCESS_SUCCESS; +end; + +function TJclEmail.FindFirstMessage: Boolean; +begin + SeedMessageID := ''; + Result := FindNextMessage; +end; + +function TJclEmail.FindNextMessage: Boolean; +var + MsgID: array [0..512] of AnsiChar; + Flags, Res: ULONG; +begin + Result := False; + if not UserLogged then + Exit; + Flags := MAPI_LONG_MSGID; + if foFifo in FFindOptions then + Inc(Flags, MAPI_GUARANTEE_FIFO); + if foUnreadOnly in FFindOptions then + Inc(Flags, MAPI_UNREAD_ONLY); + Res := MapiFindNext(FSessionHandle, 0, nil, PAnsiChar(FSeedMessageID), Flags, 0, MsgId); + Result := (Res = SUCCESS_SUCCESS); + if Result then + SeedMessageID := MsgID + else + begin + SeedMessageID := ''; + if Res <> MAPI_E_NO_MESSAGES then + MapiCheck(Res, True); + end; +end; + +function TJclEmail.GetAttachments: TJclAnsiStrings; +begin + Result := FAttachments; +end; + +function TJclEmail.GetAttachmentFiles: TStrings; +begin + Result := FAttachmentFiles; +end; + +function TJclEmail.GetParentWnd: THandle; +begin + if FParentWndValid then + Result := FParentWnd + else + Result := GetMainAppWndFromPid(GetCurrentProcessId); +end; + +function TJclEmail.GetUserLogged: Boolean; +begin + Result := (FSessionHandle <> 0); +end; + +function TJclEmail.InternalSendOrSave(Save, ShowDialog: Boolean): Boolean; +const + RecipClasses: array [TJclEmailRecipKind] of DWORD = + (MAPI_ORIG, MAPI_TO, MAPI_CC, MAPI_BCC); +type + TSetDllDirectory = function(lpPathName: PChar): LONGBOOL; stdcall; + TGetDllDirectory = function(nBufferLength: DWord; lpPathName: PChar): LONGBOOL; stdcall; +var + AttachArray: packed array of TMapiFileDesc; + RecipArray: packed array of TMapiRecipDesc; + RealAddresses: array of AnsiString; + RealNames: array of AnsiString; + MapiMessage: TMapiMessage; + Flags, Res: DWORD; + I: Integer; + MsgID: array [0..512] of AnsiChar; + AttachmentFileNames: array of AnsiString; + AttachmentPathNames: array of AnsiString; + HtmlBodyFileName: TFileName; + SetDllDirectory: TSetDllDirectory; + GetDllDirectory: TGetDllDirectory; + DllDirectoryBuffer: array[0..1024] of Char; +begin + if not AnyClientInstalled then + raise EJclMapiError.CreateRes(@RsMapiMailNoClient); + + @GetDllDirectory := GetProcAddress(GetModuleHandle(kernel32), 'GetDllDirectory' + AWSuffix); + @SetDllDirectory := GetProcAddress(GetModuleHandle(kernel32), 'SetDllDirectory' + AWSuffix); + + if Assigned(@GetDllDirectory) and Assigned(@SetDllDirectory) then + begin + GetDllDirectory(Length(DllDirectoryBuffer), @DllDirectoryBuffer); + SetDllDirectory(nil); + end; + try + HtmlBodyFileName := ''; + try + if FHtmlBody then + begin + HtmlBodyFileName := FindUnusedFileName(PathAddSeparator(GetWindowsTempFolder) + 'JclMapi', 'htm', 'Temp'); + Attachments.Insert(0, AnsiString(HtmlBodyFileName)); + AttachmentFiles.Insert(0, ''); + StringToFile(HtmlBodyFileName, Body); + end; + // Create attachments + if Attachments.Count > 0 then + begin + SetLength(AttachArray, Attachments.Count); + SetLength(AttachmentFileNames, Attachments.Count); + SetLength(AttachmentPathNames, Attachments.Count); + for I := 0 to Attachments.Count - 1 do + begin + ResetMemory(AttachArray[I], SizeOf(TMapiFileDesc)); + AttachArray[I].nPosition := DWORD(-1); + if (AttachmentFiles.Count > I) and (AttachmentFiles[I] <> '') then + begin + AttachmentFileNames[I] := Attachments[I]; + AttachmentPathNames[I] := AnsiString({$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.ExpandFileName(AttachmentFiles[I])); + end + else + begin + AttachmentFileNames[I] := ExtractFileName(AnsiString(Attachments[I])); + AttachmentPathNames[I] := AnsiString({$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.ExpandFileName(string(Attachments[I]))); + end; + AttachArray[I].lpszFileName := PAnsiChar(AttachmentFileNames[I]); + AttachArray[I].lpszPathName := PAnsiChar(AttachmentPathNames[I]); + if not FileExists(string(AttachmentPathNames[I])) then + MapiCheck(MAPI_E_ATTACHMENT_NOT_FOUND, False); + end; + end + else + AttachArray := nil; + // Create recipients + if Recipients.Count > 0 then + begin + SetLength(RecipArray, Recipients.Count); + SetLength(RealAddresses, Recipients.Count); + SetLength(RealNames, Recipients.Count); + for I := 0 to Recipients.Count - 1 do + begin + ResetMemory(RecipArray[I], SizeOf(TMapiRecipDesc)); + with RecipArray[I], Recipients[I] do + begin + ulRecipClass := RecipClasses[Kind]; + if FName = '' then // some clients requires Name item always filled + begin + if FAddress = '' then + MapiCheck(MAPI_E_INVALID_RECIPS, False); + RealNames[I] := FAddress; + end + else + RealNames[I] := FName; + if FAddressType <> '' then + RealAddresses[I] := FAddressType + AddressTypeDelimiter + FAddress + else + if Recipients.AddressesType <> '' then + RealAddresses[I] := Recipients.AddressesType + AddressTypeDelimiter + FAddress + else + RealAddresses[I] := FAddress; + lpszName := PAnsiChar(AnsiString(RealNames[I])); + lpszAddress := PAnsiCharOrNil(AnsiString(RealAddresses[I])); + end; + end; + end + else + begin + if ShowDialog then + RecipArray := nil + else + MapiCheck(MAPI_E_INVALID_RECIPS, False); + end; + // Load MAPI client library + LoadClientLib; + // Fill MapiMessage structure + ResetMemory(MapiMessage, SizeOf(MapiMessage)); + MapiMessage.lpszSubject := PAnsiChar(FSubject); + if FHtmlBody then + MapiMessage.lpszNoteText := #0 + else + MapiMessage.lpszNoteText := PAnsiChar(FBody); + MapiMessage.nRecipCount := Length(RecipArray); + if MapiMessage.nRecipCount > 0 then + MapiMessage.lpRecips := PMapiRecipDesc(@RecipArray[0]); + MapiMessage.nFileCount := Length(AttachArray); + if MapiMessage.nFileCount > 0 then + MapiMessage.lpFiles := PMapiFileDesc(@AttachArray[0]); + Flags := LogonOptionsToFlags(ShowDialog); + if Save then + begin + StrPLCopyA(MsgID, SeedMessageID, Length(MsgID) - 1); + Res := MapiSaveMail(FSessionHandle, ParentWND, MapiMessage, Flags, MAPI_LONG_MSGID, @MsgID[0]); + if Res = SUCCESS_SUCCESS then + SeedMessageID := MsgID; + end + else + Res := MapiSendMail(FSessionHandle, ParentWND, MapiMessage, Flags, 0); + Result := (MapiCheck(Res, True) = SUCCESS_SUCCESS); + finally + SetLength(AttachArray, 0); + SetLength(RecipArray, 0); + SetLength(RealAddresses, 0); + SetLength(RealNames, 0); + SetLength(AttachmentFileNames, 0); + SetLength(AttachmentPathNames, 0); + if HtmlBodyFileName <> '' then + begin + DeleteFile(HtmlBodyFileName); + Attachments.Delete(0); + AttachmentFiles.Delete(0); + end; + end; + finally + if Assigned(@SetDllDirectory) then + SetDllDirectory(DllDirectoryBuffer); + end; +end; + +procedure TJclEmail.LogOff; +begin + if UserLogged then + begin + MapiCheck(MapiLogOff(FSessionHandle, ParentWND, 0, 0), True); + FSessionHandle := 0; + end; +end; + +procedure TJclEmail.LogOn(const ProfileName, Password: AnsiString); +begin + if not UserLogged then + begin + LoadClientLib; + MapiCheck(MapiLogOn(ParentWND, PAnsiChar(ProfileName), PAnsiChar(Password), + LogonOptionsToFlags(False), 0, @FSessionHandle), True); + end; +end; + +function TJclEmail.LogonOptionsToFlags(ShowDialog: Boolean): DWORD; +begin + Result := 0; + if FSessionHandle = 0 then + begin + if loLogonUI in FLogonOptions then + Inc(Result, MAPI_LOGON_UI); + if loNewSession in FLogonOptions then + Inc(Result, MAPI_NEW_SESSION); + if loForceDownload in FLogonOptions then + Inc(Result, MAPI_FORCE_DOWNLOAD); + end; + if ShowDialog then + Inc(Result, MAPI_DIALOG); +end; + +function TJclEmail.MessageReport(Strings: TStrings; MaxWidth: Integer; IncludeAddresses: Boolean): Integer; +const + NameDelimiter = ', '; +var + LabelsWidth: Integer; + NamesList: array [TJclEmailRecipKind] of AnsiString; + ReportKind: TJclEmailRecipKind; + I, Cnt: Integer; + MailSubject, BreakStr, S: AnsiString; +begin + Cnt := Strings.Count; + MailSubject := AnsiString(LoadResString(@RsMapiMailSubject)); + LabelsWidth := Length(MailSubject); + for ReportKind := Low(ReportKind) to High(ReportKind) do + begin + NamesList[ReportKind] := ''; + LabelsWidth := Max(LabelsWidth, Length(TJclEmailRecip.RecipKindToString(ReportKind))); + end; + BreakStr := NativeCrLf + StringOfChar(AnsiChar(' '), LabelsWidth + 2); + for I := 0 to Recipients.Count - 1 do + with Recipients[I] do + begin + if IncludeAddresses then + S := AddressAndName + else + S := Name; + NamesList[Kind] := NamesList[Kind] + S + NameDelimiter; + end; + + Strings.BeginUpdate; + try + for ReportKind := Low(ReportKind) to High(ReportKind) do + if NamesList[ReportKind] <> '' then + begin + S := StrPadRight(TJclEmailRecip.RecipKindToString(ReportKind), LabelsWidth, AnsiSpace) + ': ' + + Copy(NamesList[ReportKind], 1, Length(NamesList[ReportKind]) - Length(NameDelimiter)); + Strings.Add(WrapText(string(S), string(BreakStr), [AnsiTab, AnsiSpace], MaxWidth)); // OF AnsiString to TStrings + end; + S := MailSubject + ': ' + Subject; + Strings.Add(WrapText(string(S), string(BreakStr), [AnsiTab, AnsiSpace], MaxWidth)); // OF AnsiString to TStrings + Result := Strings.Count - Cnt; + Strings.Add(''); + Strings.Add(WrapText(string(Body), NativeCrLf, [AnsiTab, AnsiSpace, '-'], MaxWidth)); // OF AnsiString to TStrings + finally + Strings.EndUpdate; + end; +end; + +function TJclEmail.Read(const Options: TJclEmailReadOptions): Boolean; +var + Flags: ULONG; + Msg: PMapiMessage; + I: Integer; + Files: PMapiFileDesc; + + function CopyAndStrToInt(const S: AnsiString; Index, Count: Integer): Integer; + begin + Result := StrToIntDef(string(Copy(S, Index, Count)), 0); + end; + + function MessageDateToDate(const S: AnsiString): TDateTime; + var + T: TSystemTime; + begin + ResetMemory(T, SizeOf(T)); + with T do + begin + wYear := CopyAndStrToInt(S, 1, 4); + wMonth := CopyAndStrToInt(S, 6, 2); + wDay := CopyAndStrToInt(S, 9, 2); + wHour := CopyAndStrToInt(S, 12, 2); + wMinute := CopyAndStrToInt(S, 15,2); + Result := EncodeDate(wYear, wMonth, wDay) + EncodeTime(wHour, wMinute, wSecond, wMilliseconds); + end; + end; + +begin + Result := False; + if not UserLogged then + Exit; + Clear; + Flags := 0; + if roHeaderOnly in Options then + Inc(Flags, MAPI_ENVELOPE_ONLY); + if not (roMarkAsRead in Options) then + Inc(Flags, MAPI_PEEK); + if not (roAttachments in Options) then + Inc(Flags, MAPI_SUPPRESS_ATTACH); + MapiCheck(MapiReadMail(SessionHandle, 0, PAnsiChar(FSeedMessageID), Flags, 0, Msg), True); + if Msg <> nil then + try + DecodeRecips(Msg^.lpOriginator, 1); + DecodeRecips(Msg^.lpRecips, Msg^.nRecipCount); + FSubject := Msg^.lpszSubject; + Body := AnsiString(AdjustLineBreaks(string(AnsiString(Msg^.lpszNoteText)))); // OF AnsiString to TStrings + Files := Msg^.lpFiles; + if Files <> nil then + for I := 0 to Msg^.nFileCount - 1 do + begin + if Files^.lpszPathName <> nil then + Attachments.Add(AnsiString(Files^.lpszPathName)) + else + Attachments.Add(AnsiString(Files^.lpszFileName)); + Inc(Files); + end; + FReadMsg.MessageType := Msg^.lpszMessageType; + if Msg^.lpszDateReceived <> nil then + FReadMsg.DateReceived := MessageDateToDate(Msg^.lpszDateReceived); + FReadMsg.ConversationID := Msg^.lpszConversationID; + FReadMsg.Flags := Msg^.flFlags; + Result := True; + finally + MapiFreeBuffer(Msg); + end; +end; + +function TJclEmail.ResolveName(var Name, Address: AnsiString; ShowDialog: Boolean): Boolean; +var + Recip: PMapiRecipDesc; + Res, Flags: DWORD; +begin + LoadClientLib; + Flags := LogonOptionsToFlags(ShowDialog) or MAPI_AB_NOMODIFY; + Recip := nil; + Res := MapiResolveName(FSessionHandle, ParentWnd, PAnsiChar(Name), Flags, 0, Recip); + Result := (MapiCheck(Res, True) = SUCCESS_SUCCESS) and (Recip <> nil); + if Result then + begin + Address := Recip^.lpszAddress; + Name := Recip^.lpszName; + MapiFreeBuffer(Recip); + end; +end; + +procedure TJclEmail.RestoreTaskWindows; +begin + RestoreTaskWindowsList(FTaskWindowList); + FTaskWindowList := nil; +end; + +function TJclEmail.Save: Boolean; +begin + Result := InternalSendOrSave(True, False); +end; + +procedure TJclEmail.SaveTaskWindows; +begin + FTaskWindowList := SaveTaskWindowsList; +end; + +function TJclEmail.Send(ShowDialog: Boolean): Boolean; +begin + Result := InternalSendOrSave(False, ShowDialog); +end; + +procedure TJclEmail.SetBody(const Value: AnsiString); +begin + if Value = '' then + FBody := '' + else + FBody := StrEnsureSuffix(NativeCrLf, Value); +end; + +procedure TJclEmail.SetParentWnd(const Value: THandle); +begin + FParentWnd := Value; + FParentWndValid := True; +end; + +procedure TJclEmail.SortAttachments; +var + S, T: TJclAnsiStringList; + U: TStringList; + I, Nr: Integer; +begin + // This is confusing, quick and very dirty. + S := TJclAnsiStringList.Create; + try + S.Capacity := FAttachments.Count; + for I := 0 to Pred(FAttachments.Count) do + S.AddObject(FAttachments[I], Pointer(I)); + S.Sort; + T := TJclAnsiStringList.Create; + U := TStringList.Create; + try + T.Capacity := S.Count; + U.Capacity := S.Count; + for I := 0 to Pred(S.Count) do + begin + Nr := Integer(S.Objects[I]); + T.AddObject(FAttachments[Nr], FAttachments.Objects[Nr]); + U.AddObject(FAttachmentFiles[Nr], FAttachmentFiles.Objects[Nr]); + end; + FAttachments.Assign(T); + FAttachmentFiles.Assign(U); + finally + U.Free; + T.Free; + end; + finally + S.Free; + end; +end; + +//=== Simple email send function ============================================= + +function SimpleSendHelper(const ARecipient, AName, ASubject, ABody: AnsiString; const AAttachment: TFileName; + AShowDialog: Boolean; AParentWND: THandle; const AProfileName, APassword, AAddressType: AnsiString): Boolean; +var + AJclEmail: TJclEmail; +begin + AJclEmail := TJclEmail.Create; + try + if AParentWND <> 0 then + AJclEmail.ParentWnd := AParentWND; + if ARecipient <> '' then + AJclEmail.Recipients.Add(ARecipient, AName, rkTO, AAddressType); + AJclEmail.Subject := ASubject; + AJclEmail.Body := ABody; + if AAttachment <> '' then + AJclEmail.Attachments.Add(AnsiString(AAttachment)); + if AProfileName <> '' then + AJclEmail.LogOn(AProfileName, APassword); + Result := AJclEmail.Send(AShowDialog); + finally + AJclEmail.Free; + end; +end; + +function JclSimpleSendMail(const Recipient, Name, Subject, Body: AnsiString; + const Attachment: TFileName; ShowDialog: Boolean; ParentWND: THandle; + const ProfileName: AnsiString; const Password: AnsiString): Boolean; +begin + Result := SimpleSendHelper(Recipient, Name, Subject, Body, Attachment, ShowDialog, ParentWND, + ProfileName, Password, MapiAddressTypeSMTP); +end; + +function JclSimpleSendFax(const Recipient, Name, Subject, Body: AnsiString; + const Attachment: TFileName; ShowDialog: Boolean; ParentWND: THandle; + const ProfileName: AnsiString; const Password: AnsiString): Boolean; +begin + Result := SimpleSendHelper(Recipient, Name, Subject, Body, Attachment, ShowDialog, ParentWND, + ProfileName, Password, MapiAddressTypeFAX); +end; + +function JclSimpleBringUpSendMailDialog(const Subject, Body: AnsiString; + const Attachment: TFileName; ParentWND: THandle; + const ProfileName: AnsiString; const Password: AnsiString): Boolean; +begin + Result := SimpleSendHelper('', '', Subject, Body, Attachment, True, ParentWND, + ProfileName, Password, MapiAddressTypeSMTP); +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/JclMetadata.pas b/3rdParty/JCL/source/windows/JclMetadata.pas new file mode 100644 index 00000000..c9191fe5 --- /dev/null +++ b/3rdParty/JCL/source/windows/JclMetadata.pas @@ -0,0 +1,4860 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclMetadata.pas. } +{ } +{ The Initial Developer of the Original Code is Flier Lu (). } +{ Portions created by Flier Lu are Copyright (C) Flier Lu. All Rights Reserved. } +{ } +{ Contributors: } +{ Flier Lu (flier) } +{ Robert Marquardt (marquardt) } +{ Olivier Sannier (obones) } +{ } +{**************************************************************************************************} +{ } +{ Microsoft .Net framework Clr information support routines and classes. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclMetadata; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Winapi.Windows, + {$ENDIF MSWINDOWS} + System.Classes, System.SysUtils, System.Contnrs, + {$ELSE ~HAS_UNITSCOPE} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + Classes, SysUtils, Contnrs, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclClr, JclFileUtils, JclSysUtils; + +type + TJclClrElementType = (etEnd, etVoid, etBoolean, etChar, + etI1, etU1, etI2, etU2, etI4, etU4, etI8, etU8, etR4, etR8, etString, + etPtr, etByRef, etValueType, etClass, etArray, etTypedByRef, + etI, etU, etFnPtr, etObject, etSzArray, etCModReqd, etCModOpt, + etInternal, etMax, etModifier, etSentinel, etPinned); + + TJclClrTableModuleRow = class(TJclClrTableRow) + private + FGeneration: Word; + FNameOffset: DWORD; + FMvidIdx: DWORD; + FEncIdIdx: DWORD; + FEncBaseIdIdx: DWORD; + function GetMvid: TGUID; + function GetName: WideString; + function GetEncBaseId: TGUID; + function GetEncId: TGUID; + public + constructor Create(const ATable: TJclClrTable); override; + + function DumpIL: string; override; + + function HasEncId: Boolean; + function HasEncBaseId: Boolean; + + property Generation: Word read FGeneration; + property NameOffset: DWORD read FNameOffset; + property MvidIdx: DWORD read FMvidIdx; + property EncIdIdx: DWORD read FEncIdIdx; + property EncBaseIdIdx: DWORD read FEncBaseIdIdx; + + property Name: WideString read GetName; + property Mvid: TGUID read GetMvid; + property EncId: TGUID read GetEncId; + property EncBaseId: TGUID read GetEncBaseId; + end; + + TJclClrTableModule = class(TJclClrTable, ITableCanDumpIL) + private + function GetRow(const Idx: Integer): TJclClrTableModuleRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableModuleRow read GetRow; default; + end; + + TJclClrTableModuleRefRow = class(TJclClrTableRow) + private + FNameOffset: DWORD; + function GetName: WideString; + public + constructor Create(const ATable: TJclClrTable); override; + function DumpIL: string; override; + property NameOffset: DWORD read FNameOffset; + property Name: WideString read GetName; + end; + + TJclClrTableModuleRef = class(TJclClrTable, ITableCanDumpIL) + private + function GetRow(const Idx: Integer): TJclClrTableModuleRefRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableModuleRefRow read GetRow; default; + end; + + TJclClrAssemblyFlag = + (cafPublicKey, cafCompatibilityMask, cafSideBySideCompatible, + cafNonSideBySideAppDomain, cafNonSideBySideProcess, + cafNonSideBySideMachine, cafEnableJITcompileTracking, + cafDisableJITcompileOptimizer); + TJclClrAssemblyFlags = set of TJclClrAssemblyFlag; + + TJclClrTableAssemblyRow = class(TJclClrTableRow) + private + FCultureOffset: DWORD; + FPublicKeyOffset: DWORD; + FHashAlgId: DWORD; + FNameOffset: DWORD; + FMajorVersion: Word; + FBuildNumber: Word; + FRevisionNumber: Word; + FMinorVersion: Word; + FFlagMask: DWORD; + function GetCulture: WideString; + function GetName: WideString; + function GetPublicKey: TJclClrBlobRecord; + function GetVersion: string; + function GetFlags: TJclClrAssemblyFlags; + public + constructor Create(const ATable: TJclClrTable); override; + + function DumpIL: string; override; + + class function AssemblyFlags(const Flags: TJclClrAssemblyFlags): DWORD; overload; + class function AssemblyFlags(const Flags: DWORD): TJclClrAssemblyFlags; overload; + + property HashAlgId: DWORD read FHashAlgId; + property MajorVersion: Word read FMajorVersion; + property MinorVersion: Word read FMinorVersion; + property BuildNumber: Word read FBuildNumber; + property RevisionNumber: Word read FRevisionNumber; + property FlagMask: DWORD read FFlagMask; + property PublicKeyOffset: DWORD read FPublicKeyOffset; + property NameOffset: DWORD read FNameOffset; + property CultureOffset: DWORD read FCultureOffset; + + property PublicKey: TJclClrBlobRecord read GetPublicKey; + property Name: WideString read GetName; + property Culture: WideString read GetCulture; + property Version: string read GetVersion; + property Flags: TJclClrAssemblyFlags read GetFlags; + end; + + TJclClrTableAssembly = class(TJclClrTable, ITableCanDumpIL) + private + function GetRow(const Idx: Integer): TJclClrTableAssemblyRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableAssemblyRow read GetRow; default; + end; + + TJclClrTableAssemblyOSRow = class(TJclClrTableRow) + private + FPlatformID: DWORD; + FMajorVersion: DWORD; + FMinorVersion: DWORD; + function GetVersion: string; + public + constructor Create(const ATable: TJclClrTable); override; + + property PlatformID: DWORD read FPlatformID; + property MajorVersion: DWORD read FMajorVersion; + property MinorVersion: DWORD read FMinorVersion; + property Version: string read GetVersion; + end; + + TJclClrTableAssemblyOS = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableAssemblyOSRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableAssemblyOSRow read GetRow; default; + end; + + TJclClrTableAssemblyProcessorRow = class(TJclClrTableRow) + private + FProcessor: DWORD; + public + constructor Create(const ATable: TJclClrTable); override; + property Processor: DWORD read FProcessor; + end; + + TJclClrTableAssemblyProcessor = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableAssemblyProcessorRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableAssemblyProcessorRow read GetRow; default; + end; + + TJclClrTableAssemblyRefRow = class(TJclClrTableRow) + private + FCultureOffset: DWORD; + FNameOffset: DWORD; + FPublicKeyOrTokenOffset: DWORD; + FHashValueOffset: DWORD; + FMajorVersion: Word; + FRevisionNumber: Word; + FBuildNumber: Word; + FMinorVersion: Word; + FFlagMask: DWORD; + function GetCulture: WideString; + function GetHashValue: TJclClrBlobRecord; + function GetName: WideString; + function GetPublicKeyOrToken: TJclClrBlobRecord; + function GetVersion: string; + function GetFlags: TJclClrAssemblyFlags; + public + constructor Create(const ATable: TJclClrTable); override; + + function DumpIL: string; override; + + property MajorVersion: Word read FMajorVersion; + property MinorVersion: Word read FMinorVersion; + property BuildNumber: Word read FBuildNumber; + property RevisionNumber: Word read FRevisionNumber; + property FlagMask: DWORD read FFlagMask; + property PublicKeyOrTokenOffset: DWORD read FPublicKeyOrTokenOffset; + property NameOffset: DWORD read FNameOffset; + property CultureOffset: DWORD read FCultureOffset; + property HashValueOffset: DWORD read FHashValueOffset; + + property PublicKeyOrToken: TJclClrBlobRecord read GetPublicKeyOrToken; + property Name: WideString read GetName; + property Culture: WideString read GetCulture; + property Version: string read GetVersion; + property HashValue: TJclClrBlobRecord read GetHashValue; + property Flags: TJclClrAssemblyFlags read GetFlags; + end; + + TJclClrTableAssemblyRef = class(TJclClrTable, ITableCanDumpIL) + private + function GetRow(const Idx: Integer): TJclClrTableAssemblyRefRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableAssemblyRefRow read GetRow; default; + end; + + TJclClrTableAssemblyRefOSRow = class(TJclClrTableAssemblyOSRow) + private + FAssemblyRefIdx: DWORD; + function GetAssemblyRef: TJclClrTableAssemblyRefRow; + public + constructor Create(const ATable: TJclClrTable); override; + + property AssemblyRefIdx: DWORD read FAssemblyRefIdx; + property AssemblyRef: TJclClrTableAssemblyRefRow read GetAssemblyRef; + end; + + TJclClrTableAssemblyRefOS = class(TJclClrTableAssemblyOS) + private + function GetRow(const Idx: Integer): TJclClrTableAssemblyRefOSRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableAssemblyRefOSRow read GetRow; default; + end; + + TJclClrTableAssemblyRefProcessorRow = class(TJclClrTableAssemblyProcessorRow) + private + FAssemblyRefIdx: DWORD; + function GetAssemblyRef: TJclClrTableAssemblyRefRow; + public + constructor Create(const ATable: TJclClrTable); override; + + property AssemblyRefIdx: DWORD read FAssemblyRefIdx; + property AssemblyRef: TJclClrTableAssemblyRefRow read GetAssemblyRef; + end; + + TJclClrTableAssemblyRefProcessor = class(TJclClrTableAssemblyProcessor) + private + function GetRow(const Idx: Integer): TJclClrTableAssemblyRefProcessorRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableAssemblyRefProcessorRow read GetRow; default; + end; + + TJclClrTableClassLayoutRow = class(TJclClrTableRow) + private + FClassSize: DWORD; + FParentIdx: DWORD; + FPackingSize: Word; + public + constructor Create(const ATable: TJclClrTable); override; + + property PackingSize: Word read FPackingSize; + property ClassSize: DWORD read FClassSize; + property ParentIdx: DWORD read FParentIdx; + end; + + TJclClrTableClassLayout = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableClassLayoutRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableClassLayoutRow read GetRow; default; + end; + + TJclClrTableConstantRow = class(TJclClrTableRow) + private + FKind: Byte; + FParentIdx: DWORD; + FValueOffset: DWORD; + function GetElementType: TJclClrElementType; + function GetParent: TJclClrTableRow; + function GetValue: TJclClrBlobRecord; + public + constructor Create(const ATable: TJclClrTable); override; + + function DumpIL: string; override; + + property Kind: Byte read FKind; + property ParentIdx: DWORD read FParentIdx; + property ValueOffset: DWORD read FValueOffset; + + property ElementType: TJclClrElementType read GetElementType; + property Parent: TJclClrTableRow read GetParent; + property Value: TJclClrBlobRecord read GetValue; + end; + + TJclClrTableConstant = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableConstantRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableConstantRow read GetRow; default; + end; + + TJclClrTableCustomAttributeRow = class(TJclClrTableRow) + private + FParentIdx: DWORD; + FTypeIdx: DWORD; + FValueOffset: DWORD; + function GetValue: TJclClrBlobRecord; + function GetParent: TJclClrTableRow; + function GetMethod: TJclClrTableRow; + public + constructor Create(const ATable: TJclClrTable); override; + + function DumpIL: string; override; + + property ParentIdx: DWORD read FParentIdx; + property TypeIdx: DWORD read FTypeIdx; + property ValueOffset: DWORD read FValueOffset; + + property Parent: TJclClrTableRow read GetParent; + property Method: TJclClrTableRow read GetMethod; + property Value: TJclClrBlobRecord read GetValue; + end; + + TJclClrTableCustomAttribute = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableCustomAttributeRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableCustomAttributeRow read GetRow; default; + end; + + TJclClrTableDeclSecurityRow = class(TJclClrTableRow) + private + FPermissionSetOffset: DWORD; + FParentIdx: DWORD; + FAction: Word; + public + constructor Create(const ATable: TJclClrTable); override; + + property Action: Word read FAction; + property ParentIdx: DWORD read FParentIdx; + property PermissionSetOffset: DWORD read FPermissionSetOffset; + end; + + TJclClrTableDeclSecurity = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableDeclSecurityRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableDeclSecurityRow read GetRow; default; + end; + + TJclClrTableEventMapRow = class(TJclClrTableRow) + private + FEventListIdx: DWORD; + FParentIdx: DWORD; + public + constructor Create(const ATable: TJclClrTable); override; + + property ParentIdx: DWORD read FParentIdx; + property EventListIdx: DWORD read FEventListIdx; + end; + + TJclClrTableEventMap = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableEventMapRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableEventMapRow read GetRow; default; + end; + + TJclClrTableEventFlag = (efSpecialName, efRTSpecialName); + TJclClrTableEventFlags = set of TJclClrTableEventFlag; + + TJclClrTableEventDefRow = class(TJclClrTableRow) + private + FNameOffset: DWORD; + FEventTypeIdx: DWORD; + FEventFlags: Word; + function GetName: WideString; + public + constructor Create(const ATable: TJclClrTable); override; + + property EventFlags: Word read FEventFlags; + property NameOffset: DWORD read FNameOffset; + property EventTypeIdx: DWORD read FEventTypeIdx; + property Name: WideString read GetName; + end; + + TJclClrTableEventDef = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableEventDefRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableEventDefRow read GetRow; default; + end; + + TJclClrTableExportedTypeRow = class(TJclClrTableRow) + private + FTypeDefIdx: DWORD; + FFlags: DWORD; + FImplementationIdx: DWORD; + FTypeNamespaceOffset: DWORD; + FTypeNameOffset: DWORD; + function GetTypeName: WideString; + function GetTypeNamespace: WideString; + public + constructor Create(const ATable: TJclClrTable); override; + + property Flags: DWORD read FFlags; + property TypeDefIdx: DWORD read FTypeDefIdx; + property TypeNameOffset: DWORD read FTypeNameOffset; + property TypeNamespaceOffset: DWORD read FTypeNamespaceOffset; + property ImplementationIdx: DWORD read FImplementationIdx; + property TypeName: WideString read GetTypeName; + property TypeNamespace: WideString read GetTypeNamespace; + end; + + TJclClrTableEventPtrRow = class(TJclClrTableRow) + private + FEventIdx: DWORD; + function GetEvent: TJclClrTableEventDefRow; + public + constructor Create(const ATable: TJclClrTable); override; + + property EventIdx: DWORD read FEventIdx; + property Event: TJclClrTableEventDefRow read GetEvent; + end; + + TJclClrTableEventPtr = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableEventPtrRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableEventPtrRow read GetRow; default; + end; + + TJclClrTableExportedType = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableExportedTypeRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableExportedTypeRow read GetRow; default; + end; + + TJclClrTableTypeDefRow = class; + + TJclClrTableFieldDefVisibility = + (fvPrivateScope, fvPrivate, fvFamANDAssem, + fvAssembly, fvFamily, fvFamORAssem, fvPublic); + + TJclClrTableFieldDefFlag = + (ffStatic, ffInitOnly, ffLiteral, ffNotSerialized, + ffSpecialName, ffPinvokeImpl, ffRTSpecialName, + ffHasFieldMarshal, ffHasDefault, ffHasFieldRVA); + TJclClrTableFieldDefFlags = set of TJclClrTableFieldDefFlag; + + TJclClrTableFieldDefRow = class(TJclClrTableRow) + private + FFlags: Word; + FNameOffset: DWORD; + FSignatureOffset: DWORD; + FParentToken: TJclClrTableTypeDefRow; + function GetName: WideString; + function GetSignature: TJclClrBlobRecord; + function GetFlag: TJclClrTableFieldDefFlags; + function GetVisibility: TJclClrTableFieldDefVisibility; + protected + procedure SetParentToken(const ARow: TJclClrTableTypeDefRow); + public + constructor Create(const ATable: TJclClrTable); override; + + function DumpIL: string; override; + + property RawFlags: Word read FFlags; + property NameOffset: DWORD read FNameOffset; + property SignatureOffset: DWORD read FSignatureOffset; + + property Name: WideString read GetName; + property Signature: TJclClrBlobRecord read GetSignature; + + property ParentToken: TJclClrTableTypeDefRow read FParentToken; + property Visibility: TJclClrTableFieldDefVisibility read GetVisibility; + property Flags: TJclClrTableFieldDefFlags read GetFlag; + end; + + TJclClrTableFieldDef = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableFieldDefRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableFieldDefRow read GetRow; default; + end; + + TJclClrTableFieldPtrRow = class(TJclClrTableRow) + private + FFieldIdx: DWORD; + function GetField: TJclClrTableFieldDefRow; + public + constructor Create(const ATable: TJclClrTable); override; + + property FieldIdx: DWORD read FFieldIdx; + property Field: TJclClrTableFieldDefRow read GetField; + end; + + TJclClrTableFieldPtr = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableFieldPtrRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableFieldPtrRow read GetRow; default; + end; + + TJclClrTableFieldLayoutRow = class(TJclClrTableRow) + private + FOffset: DWORD; + FFieldIdx: DWORD; + public + constructor Create(const ATable: TJclClrTable); override; + + property Offset: DWORD read FOffset; + property FieldIdx: DWORD read FFieldIdx; + end; + + TJclClrTableFieldLayout = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableFieldLayoutRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableFieldLayoutRow read GetRow; default; + end; + + TJclClrTableFieldMarshalRow = class(TJclClrTableRow) + private + FParentIdx: DWORD; + FNativeTypeOffset: DWORD; + public + constructor Create(const ATable: TJclClrTable); override; + + property ParentIdx: DWORD read FParentIdx; + property NativeTypeOffset: DWORD read FNativeTypeOffset; + end; + + TJclClrTableFieldMarshal = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableFieldMarshalRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableFieldMarshalRow read GetRow; default; + end; + + TJclClrTableFieldRVARow = class(TJclClrTableRow) + private + FRVA: DWORD; + FFieldIdx: DWORD; + public + constructor Create(const ATable: TJclClrTable); override; + + property RVA: DWORD read FRVA; + property FieldIdx: DWORD read FFieldIdx; + end; + + TJclClrTableFieldRVA = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableFieldRVARow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableFieldRVARow read GetRow; default; + end; + + TJclClrTableFileRow = class(TJclClrTableRow) + private + FHashValueOffset: DWORD; + FNameOffset: DWORD; + FFlags: DWORD; + function GetName: WideString; + function GetHashValue: TJclClrBlobRecord; + function GetContainsMetadata: Boolean; + public + constructor Create(const ATable: TJclClrTable); override; + + function DumpIL: string; override; + + property Flags: DWORD read FFlags; + property NameOffset: DWORD read FNameOffset; + property HashValueOffset: DWORD read FHashValueOffset; + + property Name: WideString read GetName; + property HashValue: TJclClrBlobRecord read GetHashValue; + property ContainsMetadata: Boolean read GetContainsMetadata; + end; + + TJclClrTableFile = class(TJclClrTable, ITableCanDumpIL) + private + function GetRow(const Idx: Integer): TJclClrTableFileRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableFileRow read GetRow; default; + end; + + TJclClrTableImplMapRow = class(TJclClrTableRow) + private + FImportNameOffset: DWORD; + FMemberForwardedIdx: DWORD; + FImportScopeIdx: DWORD; + FMappingFlags: Word; + function GetImportName: WideString; + public + constructor Create(const ATable: TJclClrTable); override; + + property MappingFlags: Word read FMappingFlags; + property MemberForwardedIdx: DWORD read FMemberForwardedIdx; + property ImportNameOffset: DWORD read FImportNameOffset; + property ImportScopeIdx: DWORD read FImportScopeIdx; + property ImportName: WideString read GetImportName; + end; + + TJclClrTableImplMap = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableImplMapRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableImplMapRow read GetRow; default; + end; + + TJclClrTableInterfaceImplRow = class(TJclClrTableRow) + private + FInterfaceIdx: DWORD; + FClassIdx: DWORD; + function GetImplClass: TJclClrTableRow; + function GetImplInterface: TJclClrTableRow; + public + constructor Create(const ATable: TJclClrTable); override; + + function DumpIL: string; override; + + property ClassIdx: DWORD read FClassIdx; + property InterfaceIdx: DWORD read FInterfaceIdx; + + property ImplClass: TJclClrTableRow read GetImplClass; + property ImplInterface: TJclClrTableRow read GetImplInterface; + end; + + TJclClrTableInterfaceImpl = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableInterfaceImplRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableInterfaceImplRow read GetRow; default; + end; + + TJclClrTableManifestResourceVisibility = (rvPublic, rvPrivate); + + TJclClrTableManifestResourceRow = class(TJclClrTableRow) + private + FOffset: DWORD; + FFlags: DWORD; + FImplementationIdx: DWORD; + FNameOffset: DWORD; + function GetName: WideString; + function GetVisibility: TJclClrTableManifestResourceVisibility; + function GetImplementationRow: TJclClrTableRow; + public + constructor Create(const ATable: TJclClrTable); override; + + function DumpIL: string; override; + + property Offset: DWORD read FOffset; + property Flags: DWORD read FFlags; + property NameOffset: DWORD read FNameOffset; + property ImplementationIdx: DWORD read FImplementationIdx; + + property Name: WideString read GetName; + property Visibility: TJclClrTableManifestResourceVisibility read GetVisibility; + property ImplementationRow: TJclClrTableRow read GetImplementationRow; + end; + + TJclClrTableManifestResource = class(TJclClrTable, ITableCanDumpIL) + private + function GetRow(const Idx: Integer): TJclClrTableManifestResourceRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableManifestResourceRow read GetRow; default; + end; + + TJclClrTableMemberRefRow = class(TJclClrTableRow) + private + FClassIdx: DWORD; + FNameOffset: DWORD; + FSignatureOffset: DWORD; + function GetName: WideString; + function GetSignature: TJclClrBlobRecord; + function GetParentClass: TJclClrTableRow; + function GetFullName: WideString; + public + constructor Create(const ATable: TJclClrTable); override; + + property ClassIdx: DWORD read FClassIdx; + property NameOffset: DWORD read FNameOffset; + property SignatureOffset: DWORD read FSignatureOffset; + + property Name: WideString read GetName; + property FullName: WideString read GetFullName; + property Signature: TJclClrBlobRecord read GetSignature; + property ParentClass: TJclClrTableRow read GetParentClass; + end; + + TJclClrTableMemberRef = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableMemberRefRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableMemberRefRow read GetRow; default; + end; + + TJclClrTableMethodDefRow = class; + + TJclClrParamKind = (pkIn, pkOut, pkOptional, pkHasDefault, pkHasFieldMarshal); + TJclClrParamKinds = set of TJclClrParamKind; + + TJclClrTableParamDefRow = class(TJclClrTableRow) + private + FFlagMask: Word; + FSequence: Word; + FNameOffset: DWORD; + FMethod: TJclClrTableMethodDefRow; + FFlags: TJclClrParamKinds; + function GetName: WideString; + protected + procedure SetMethod(const AMethod: TJclClrTableMethodDefRow); + public + constructor Create(const ATable: TJclClrTable); override; + + function DumpIL: string; override; + + class function ParamFlags(const AFlags: TJclClrParamKinds): Word; overload; + class function ParamFlags(const AFlags: Word): TJclClrParamKinds; overload; + + property FlagMask: Word read FFlagMask; + property Sequence: Word read FSequence; + property NameOffset: DWORD read FNameOffset; + + property Name: WideString read GetName; + property Method: TJclClrTableMethodDefRow read FMethod; + property Flags: TJclClrParamKinds read FFlags; + end; + + TJclClrTableParamDef = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableParamDefRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableParamDefRow read GetRow; default; + end; + + TJclClrTableParamPtrRow = class(TJclClrTableRow) + private + FParamIdx: DWORD; + function GetParam: TJclClrTableParamDefRow; + public + constructor Create(const ATable: TJclClrTable); override; + + property ParamIdx: DWORD read FParamIdx; + property Param: TJclClrTableParamDefRow read GetParam; + end; + + TJclClrTableParamPtr = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableParamPtrRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableParamPtrRow read GetRow; default; + end; + + IMAGE_COR_ILMETHOD_TINY = packed record + Flags_CodeSize: Byte; + end; + TImageCorILMethodTiny = IMAGE_COR_ILMETHOD_TINY; + PImageCorILMethodTiny = ^TImageCorILMethodTiny; + + IMAGE_COR_ILMETHOD_FAT = packed record + Flags_Size, + MaxStack: Word; + CodeSize: DWORD; + LocalVarSigTok: TJclClrToken; + end; + TImageCorILMethodFat = IMAGE_COR_ILMETHOD_FAT; + PImageCorILMethodFat = ^TImageCorILMethodFat; + + PImageCorILMethodHeader = ^TImageCorILMethodHeader; + TImageCorILMethodHeader = packed record + case Boolean of + True: + (Tiny: TImageCorILMethodTiny); + False: + (Fat: TImageCorILMethodFat); + end; + + IMAGE_COR_ILMETHOD_SECT_SMALL = packed record + Kind: Byte; + Datasize: Byte; + Padding: Word; + end; + TImageCorILMethodSectSmall = IMAGE_COR_ILMETHOD_SECT_SMALL; + PImageCorILMethodSectSmall = ^TImageCorILMethodSectSmall; + + IMAGE_COR_ILMETHOD_SECT_FAT = packed record + Kind_DataSize: DWORD; + end; + TImageCorILMethodSectFat = IMAGE_COR_ILMETHOD_SECT_FAT; + PImageCorILMethodSectFat = ^TImageCorILMethodSectFat; + + PImageCorILMethodSectHeader = ^TImageCorILMethodSectHeader; + TImageCorILMethodSectHeader = packed record + case Boolean of + True: + (Small: TImageCorILMethodSectSmall); + False: + (Fat: TImageCorILMethodSectFat); + end; + + IMAGE_COR_ILMETHOD_SECT_EH_CLAUSE_FAT = packed record + Flags: DWORD; + TryOffset: DWORD; + TryLength: DWORD; // relative to start of try block + HandlerOffset: DWORD; + HandlerLength: DWORD; // relative to start of handler + case Boolean of + True: + (ClassToken: DWORD); // use for type-based exception handlers + False: + (FilterOffset: DWORD); // use for filter-based exception handlers (COR_ILEXCEPTION_FILTER is set) + end; + TImageCorILMethodSectEHClauseFat = IMAGE_COR_ILMETHOD_SECT_EH_CLAUSE_FAT; + PImageCorILMethodSectEHClauseFat = ^TImageCorILMethodSectEHClauseFat; + + IMAGE_COR_ILMETHOD_SECT_EH_FAT = packed record + SectFat: IMAGE_COR_ILMETHOD_SECT_FAT; + Clauses: array [0..MaxWord-1] of IMAGE_COR_ILMETHOD_SECT_EH_CLAUSE_FAT; // actually variable size + end; + TImageCorILMethodSectEHFat = IMAGE_COR_ILMETHOD_SECT_EH_FAT; + PImageCorILMethodSectEHFat = ^TImageCorILMethodSectEHFat; + + IMAGE_COR_ILMETHOD_SECT_EH_CLAUSE_SMALL = packed record + Flags, + TryOffset: Word; + TryLength: Byte; // relative to start of try block + HandlerOffset: Word; + HandlerLength: Byte; // relative to start of handler + case Boolean of + True: + (ClassToken: DWORD); // use for type-based exception handlers + False: + (FilterOffset: DWORD); // use for filter-based exception handlers (COR_ILEXCEPTION_FILTER is set) + end; + TImageCorILMethodSectEHClauseSmall = IMAGE_COR_ILMETHOD_SECT_EH_CLAUSE_SMALL; + PImageCorILMethodSectEHClauseSmall = ^TImageCorILMethodSectEHClauseSmall; + + IMAGE_COR_ILMETHOD_SECT_EH_SMALL = packed record + SectSmall: IMAGE_COR_ILMETHOD_SECT_SMALL; + Clauses: array [0..MaxWord-1] of IMAGE_COR_ILMETHOD_SECT_EH_CLAUSE_SMALL; // actually variable size + end; + TImageCorILMethodSectEHSmall = IMAGE_COR_ILMETHOD_SECT_EH_SMALL; + PImageCorILMethodSectEHSmall = ^TImageCorILMethodSectEHSmall; + + IMAGE_COR_ILMETHOD_SECT_EH = packed record + case Boolean of + True: + (Small: IMAGE_COR_ILMETHOD_SECT_EH_SMALL); + False: + (Fat: IMAGE_COR_ILMETHOD_SECT_EH_FAT); + end; + TImageCorILMethodSectEH = IMAGE_COR_ILMETHOD_SECT_EH; + PImageCorILMethodSectEH = ^TImageCorILMethodSectEH; + + TJclClrCodeBlock = record + Offset: DWORD; + Length: DWORD; + end; + + TJclClrExceptionClauseFlag = (cfException, cfFilter, cfFinally, cfFault); + TJclClrExceptionClauseFlags = set of TJclClrExceptionClauseFlag; + + TJclClrExceptionHandler = class(TObject) + private + FFlags: DWORD; + FFilterOffset: DWORD; + FTryBlock: TJclClrCodeBlock; + FHandlerBlock: TJclClrCodeBlock; + FClassToken: TJclClrToken; + function GetFlags: TJclClrExceptionClauseFlags; + public + constructor Create(const EHClause: TImageCorILMethodSectEHClauseSmall); overload; + constructor Create(const EHClause: TImageCorILMethodSectEHClauseFat); overload; + + property EHFlags: DWORD read FFlags; + property Flags: TJclClrExceptionClauseFlags read GetFlags; + + property TryBlock: TJclClrCodeBlock read FTryBlock; + property HandlerBlock: TJclClrCodeBlock read FHandlerBlock; + + property ClassToken: TJclClrToken read FClassToken; + property FilterOffset: DWORD read FFilterOffset; + end; + + TJclClrSignature = class(TObject) + private + FBlob: TJclClrBlobRecord; + protected + function IsModifierType(const AElementType: TJclClrElementType): Boolean; + function IsPrimitiveType(const AElementType: TJclClrElementType): Boolean; + + function Inc(var DataPtr: PJclByteArray; Step: TJclAddr = 1): PByte; + + function UncompressedDataSize(DataPtr: PJclByteArray): Integer; + function UncompressData(DataPtr: PJclByteArray; out Value: DWord): Integer; + function UncompressToken(DataPtr: PJclByteArray; out Token: TJclClrToken): Integer; + function UncompressCallingConv(DataPtr: PJclByteArray): Byte; + function UncompressSignedInt(DataPtr: PJclByteArray; out Value: Integer): Integer; + function UncompressElementType(DataPtr: PJclByteArray): TJclClrElementType; + function UncompressTypeSignature(DataPtr: PJclByteArray): string; + public + constructor Create(const ABlob: TJclClrBlobRecord); + + function UncompressFieldSignature: string; + + function ReadValue: DWORD; + function ReadByte: Byte; + function ReadInteger: Integer; + function ReadToken: TJclClrToken; + function ReadElementType: TJclClrElementType; + + property Blob: TJclClrBlobRecord read FBlob; + end; + + TJclClrArrayData = (adSize, adLowBound); + + TJclClrArraySignBound = array [TJclClrArrayData] of Integer; + TJclClrArraySignBounds = array of TJclClrArraySignBound; + + TJclClrArraySign = class(TJclClrSignature) + private + FBounds: TJclClrArraySignBounds; + public + constructor Create(const ABlob: TJclClrBlobRecord); + end; + + TJclClrLocalVarFlag = (lvfPinned, lvfByRef); + TJclClrLocalVarFlags = set of TJclClrLocalVarFlag; + + TJclClrLocalVar = class(TObject) + private + FElementType: TJclClrElementType; + FFlags: TJclClrLocalVarFlags; + FToken: TJclClrToken; + function GetName: WideString; + public + property ElementType: TJclClrElementType read FElementType write FElementType; + + property Name: WideString read GetName; + property Flags: TJclClrLocalVarFlags read FFlags write FFlags; + property Token: TJclClrToken read FToken write FToken; + end; + + TJclClrLocalVarSign = class(TJclClrSignature) + private + FLocalVars: TObjectList; + function GetLocalVar(const Idx: Integer): TJclClrLocalVar; + function GetLocalVarCount: Integer; + public + constructor Create(const ABlob: TJclClrBlobRecord); + destructor Destroy; override; + + property LocalVars[const Idx: Integer]: TJclClrLocalVar read GetLocalVar; + property LocalVarCount: Integer read GetLocalVarCount; + end; + + TJclClrMethodBody = class(TObject) + private + FMethod: TJclClrTableMethodDefRow; + FSize: DWORD; + FCode: Pointer; + FMaxStack: DWORD; + FLocalVarSignToken: TJclClrToken; + FLocalVarSign: TJclClrLocalVarSign; + FEHTable: TObjectList; + procedure AddEHTable(EHTable: PImageCorILMethodSectEH); + procedure AddOptILTable(OptILTable: Pointer; Size: Integer); + + procedure ParseMoreSections(SectHeader: PImageCorILMethodSectHeader); + + function GetExceptionHandler(const Idx: Integer): TJclClrExceptionHandler; + function GetExceptionHandlerCount: Integer; + function GetLocalVarSign: TJclClrLocalVarSign; + function GetLocalVarSignData: TJclClrBlobRecord; + public + constructor Create(const AMethod: TJclClrTableMethodDefRow); + destructor Destroy; override; + + property Method: TJclClrTableMethodDefRow read FMethod; + + property Size: DWORD read FSize; + property Code: Pointer read FCode; + + property MaxStack: DWORD read FMaxStack; + property LocalVarSignToken: TJclClrToken read FLocalVarSignToken; + property LocalVarSignData: TJclClrBlobRecord read GetLocalVarSignData; + property LocalVarSign: TJclClrLocalVarSign read GetLocalVarSign; + property ExceptionHandlers[const Idx: Integer]: TJclClrExceptionHandler read GetExceptionHandler; + property ExceptionHandlerCount: Integer read GetExceptionHandlerCount; + end; + + TJclClrCustomModifierSign = class(TJclClrSignature) + private + FRequired: Boolean; + FToken: TJclClrToken; + public + constructor Create(const ABlob: TJclClrBlobRecord); + property Required: Boolean read FRequired; + property Token: TJclClrToken read FToken; + end; + + TJclClrMethodSign = class; + + TJclClrMethodParam = class(TJclClrSignature) + private + FCustomMods: TObjectList; + FByRef: Boolean; + FElementType: TJclClrElementType; + FToken: TJclClrToken; + FMethodSign: TJclClrMethodSign; + FArraySign: TJclClrArraySign; + function GetCustomModifier(const Idx: Integer): TJclClrCustomModifierSign; + function GetCustomModifierCount: Integer; + public + constructor Create(const ABlob: TJclClrBlobRecord); + destructor Destroy; override; + + property CustomModifiers[const Idx: Integer]: TJclClrCustomModifierSign read GetCustomModifier; + property CustomModifierCount: Integer read GetCustomModifierCount; + + property ElementType: TJclClrElementType read FElementType; + property ByRef: Boolean read FByRef; + property Token: TJclClrToken read FToken; + property MethodSign: TJclClrMethodSign read FMethodSign; + property ArraySign: TJclClrArraySign read FArraySign; + end; + + TJclClrMethodRetType = class(TJclClrMethodParam) + end; + + TJclClrMethodSignFlag = (mfHasThis, mfExplicitThis, mfDefault, mfVarArg); + TJclClrMethodSignFlags = set of TJclClrMethodSignFlag; + + TJclClrMethodSign = class(TJclClrSignature) + private + FFlags: TJclClrMethodSignFlags; + FParams: TObjectList; + FRetType: TJclClrMethodRetType; + function GetParam(const Idx: Integer): TJclClrMethodParam; + function GetParamCount: Integer; + public + constructor Create(const ABlob: TJclClrBlobRecord); + destructor Destroy; override; + + property Flags: TJclClrMethodSignFlags read FFlags; + property Params[const Idx: Integer]: TJclClrMethodParam read GetParam; + property ParamCount: Integer read GetParamCount; + property RetType: TJclClrMethodRetType read FRetType; + end; + + TJclClrMemberAccess = + (maCompilercontrolled, maPrivate, maFamilyAndAssembly, + maAssembly, maFamily, maFamilyOrAssembly, maPublic); + + TJclClrMethodFlag = + (mfStatic, mfFinal, mfVirtual, mfHideBySig, + mfCheckAccessOnOverride, mfAbstract, mfSpecialName, + mfPInvokeImpl, mfUnmanagedExport, + mfRTSpcialName, mfHasSecurity, mfRequireSecObject); + TJclClrMethodFlags = set of TJclClrMethodFlag; + + TJclClrMethodCodeType = (ctIL, ctNative, ctOptIL, ctRuntime); + + TJclClrMethodImplFlag = + (mifForwardRef, mifPreserveSig, mifInternalCall, + mifSynchronized, mifNoInlining); + TJclClrMethodImplFlags = set of TJclClrMethodImplFlag; + + TJclClrTableMethodDefRow = class(TJclClrTableRow) + private + FRVA: DWORD; + FImplFlags: Word; + FFlags: Word; + FNameOffset: DWORD; + FSignatureOffset: DWORD; + FParamListIdx: DWORD; + FParentToken: TJclClrTableTypeDefRow; + FParams: TList; + FMethodBody: TJclClrMethodBody; + FSignature: TJclClrMethodSign; + function GetName: WideString; + function GetSignatureData: TJclClrBlobRecord; + function GetParam(const Idx: Integer): TJclClrTableParamDefRow; + function GetParamCount: Integer; + function GetHasParam: Boolean; + procedure UpdateParams; + function GetFullName: WideString; + function GetSignature: TJclClrMethodSign; + function GetMemberAccess: TJclClrMemberAccess; + function GetMethodFlags: TJclClrMethodFlags; + function GetNewSlot: Boolean; + function GetCodeType: TJclClrMethodCodeType; + function GetManaged: Boolean; + function GetMethodImplFlags: TJclClrMethodImplFlags; + protected + procedure Update; override; + procedure SetParentToken(const ARow: TJclClrTableTypeDefRow); + public + constructor Create(const ATable: TJclClrTable); override; + + function DumpIL: string; override; + + destructor Destroy; override; + + property RVA: DWORD read FRVA; + property ImplFlags: Word read FImplFlags; + property Flags: Word read FFlags; + property NameOffset: DWORD read FNameOffset; + property SignatureOffset: DWORD read FSignatureOffset; + property ParamListIdx: DWORD read FParamListIdx; + + property Name: WideString read GetName; + property FullName: WideString read GetFullName; + + property MethodFlags: TJclClrMethodFlags read GetMethodFlags; + property MethodImplFlags: TJclClrMethodImplFlags read GetMethodImplFlags; + + property MemberAccess: TJclClrMemberAccess read GetMemberAccess; + property NewSlot: Boolean read GetNewSlot; + property CodeType: TJclClrMethodCodeType read GetCodeType; + property Managed: Boolean read GetManaged; + + property Signature: TJclClrMethodSign read GetSignature; + property SignatureData: TJclClrBlobRecord read GetSignatureData; + property ParentToken: TJclClrTableTypeDefRow read FParentToken; + property HasParam: Boolean read GetHasParam; + property Params[const Idx: Integer]: TJclClrTableParamDefRow read GetParam; + property ParamCount: Integer read GetParamCount; + + property MethodBody: TJclClrMethodBody read FMethodBody; + end; + + TJclClrTableMethodDef = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableMethodDefRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableMethodDefRow read GetRow; default; + end; + + TJclClrTableMethodPtrRow = class(TJclClrTableRow) + private + FMethodIdx: DWORD; + function GetMethod: TJclClrTableMethodDefRow; + public + constructor Create(const ATable: TJclClrTable); override; + + property MethodIdx: DWORD read FMethodIdx; + property Method: TJclClrTableMethodDefRow read GetMethod; + end; + + TJclClrTableMethodPtr = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableMethodPtrRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableMethodPtrRow read GetRow; default; + end; + + TJclClrTableMethodImplRow = class(TJclClrTableRow) + private + FClassIdx: DWORD; + FMethodBodyIdx: DWORD; + FMethodDeclarationIdx: DWORD; + public + constructor Create(const ATable: TJclClrTable); override; + + property ClassIdx: DWORD read FClassIdx; + property MethodBodyIdx: DWORD read FMethodBodyIdx; + property MethodDeclarationIdx: DWORD read FMethodDeclarationIdx; + end; + + TJclClrTableMethodImpl = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableMethodImplRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableMethodImplRow read GetRow; default; + end; + + TJclClrTableMethodSemanticsRow = class(TJclClrTableRow) + private + FSemantics: Word; + FMethodIdx: DWORD; + FAssociationIdx: DWORD; + public + constructor Create(const ATable: TJclClrTable); override; + + property Semantics: Word read FSemantics; + property MethodIdx: DWORD read FMethodIdx; + property AssociationIdx: DWORD read FAssociationIdx; + end; + + TJclClrTableMethodSemantics = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableMethodSemanticsRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableMethodSemanticsRow read GetRow; default; + end; + + TJclClrTableMethodSpecRow = class(TJclClrTableRow) + private + FMethodIdx: DWORD; + FInstantiationOffset: DWORD; + function GetInstantiation: TJclClrBlobRecord; + function GetMethod: TJclClrTableRow; + public + constructor Create(const ATable: TJclClrTable); override; + property MethodIdx: DWORD read FMethodIdx; + property InstantiationOffset: DWORD read FInstantiationOffset; + property Method: TJclClrTableRow read GetMethod; + property Instantiation: TJclClrBlobRecord read GetInstantiation; + end; + + TJclClrTableMethodSpec = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableMethodSpecRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableMethodSpecRow read GetRow; default; + end; + + TJclClrTableNestedClassRow = class(TJclClrTableRow) + private + FEnclosingClassIdx: DWORD; + FNestedClassIdx: DWORD; + public + constructor Create(const ATable: TJclClrTable); override; + property NestedClassIdx: DWORD read FNestedClassIdx; + property EnclosingClassIdx: DWORD read FEnclosingClassIdx; + end; + + TJclClrTableNestedClass = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableNestedClassRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableNestedClassRow read GetRow; default; + end; + + TJclClrTablePropertyFlag = (pfSpecialName, pfRTSpecialName, pfHasDefault); + TJclClrTablePropertyFlags = set of TJclClrTablePropertyFlag; + + TJclClrTablePropertyDefRow = class(TJclClrTableRow) + private + FKindIdx: DWORD; + FNameOffset: DWORD; + FFlags: Word; + function GetName: WideString; + function GetFlags: TJclClrTablePropertyFlags; + public + constructor Create(const ATable: TJclClrTable); override; + + function DumpIL: string; override; + + property RawFlags: Word read FFlags; + property NameOffset: DWORD read FNameOffset; + property KindIdx: DWORD read FKindIdx; + + property Name: WideString read GetName; + property Flags: TJclClrTablePropertyFlags read GetFlags; + end; + + TJclClrTablePropertyDef = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTablePropertyDefRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTablePropertyDefRow read GetRow; default; + end; + + TJclClrTablePropertyPtrRow = class(TJclClrTableRow) + private + FPropertyIdx: DWORD; + function GetProperty: TJclClrTablePropertyDefRow; + public + constructor Create(const ATable: TJclClrTable); override; + property PropertyIdx: DWORD read FPropertyIdx; + property _Property: TJclClrTablePropertyDefRow read GetProperty; + end; + + TJclClrTablePropertyPtr = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTablePropertyPtrRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTablePropertyPtrRow read GetRow; default; + end; + + TJclClrTablePropertyMapRow = class(TJclClrTableRow) + private + FParentIdx: DWORD; + FPropertyListIdx: DWORD; + FProperties: TList; + function GetParent: TJclClrTableTypeDefRow; + function GetProperty(const Idx: Integer): TJclClrTablePropertyDefRow; + function GetPropertyCount: Integer; + protected + function Add(const ARow: TJclClrTablePropertyDefRow): Integer; + public + constructor Create(const ATable: TJclClrTable); override; + destructor Destroy; override; + + property ParentIdx: DWORD read FParentIdx; + property PropertyListIdx: DWORD read FPropertyListIdx; + + property Parent: TJclClrTableTypeDefRow read GetParent; + + property Properties[const Idx: Integer]: TJclClrTablePropertyDefRow read GetProperty; + property PropertyCount: Integer read GetPropertyCount; + end; + + TJclClrTablePropertyMap = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTablePropertyMapRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + procedure Update; override; + public + property Rows[const Idx: Integer]: TJclClrTablePropertyMapRow read GetRow; default; + end; + + TJclClrTableStandAloneSigRow = class(TJclClrTableRow) + private + FSignatureOffset: DWORD; + function GetSignature: TJclClrBlobRecord; + public + constructor Create(const ATable: TJclClrTable); override; + property SignatureOffset: DWORD read FSignatureOffset; + property Signature: TJclClrBlobRecord read GetSignature; + end; + + TJclClrTableStandAloneSig = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableStandAloneSigRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableStandAloneSigRow read GetRow; default; + end; + + TJclClrTypeVisibility = + (tvNotPublic, tvPublic, tvNestedPublic, + tvNestedPrivate, tvNestedFamily, tvNestedAssembly, + tvNestedFamANDAssem, tvNestedFamORAssem); + TJclClrClassLayout = (clAuto, clSequential, clExplicit); + TJclClrClassSemantics = (csClass, csInterface); + TJclClrStringFormatting = (sfAnsi, sfUnicode, sfAutoChar); + + TJclClrTypeAttribute = + (taAbstract, taSealed, taSpecialName, taImport, + taSerializable, taBeforeFieldInit, taRTSpecialName, taHasSecurity); + TJclClrTypeAttributes = set of TJclClrTypeAttribute; + + TJclClrTableTypeDefRow = class(TJclClrTableRow) + private + FNamespaceOffset: DWORD; + FNameOffset: DWORD; + FFlags: DWORD; + FExtendsIdx: DWORD; + FFieldListIdx: DWORD; + FMethodListIdx: DWORD; + FFields: TList; + FMethods: TList; + function GetName: WideString; + function GetNamespace: WideString; + function GetField(const Idx: Integer): TJclClrTableFieldDefRow; + function GetFieldCount: Integer; + function GetMethod(const Idx: Integer): TJclClrTableMethodDefRow; + function GetMethodCount: Integer; + procedure UpdateFields; + procedure UpdateMethods; + function GetFullName: WideString; + function GetAttributes: TJclClrTypeAttributes; + function GetClassLayout: TJclClrClassLayout; + function GetClassSemantics: TJclClrClassSemantics; + function GetStringFormatting: TJclClrStringFormatting; + function GetVisibility: TJclClrTypeVisibility; + function GetExtends: TJclClrTableRow; + protected + procedure Update; override; + public + constructor Create(const ATable: TJclClrTable); override; + destructor Destroy; override; + + function DumpIL: string; override; + + function HasField: Boolean; + function HasMethod: Boolean; + + property Flags: DWORD read FFlags; + property NameOffset: DWORD read FNameOffset; + property NamespaceOffset: DWORD read FNamespaceOffset; + property ExtendsIdx: DWORD read FExtendsIdx; + property FieldListIdx: DWORD read FFieldListIdx; + property MethodListIdx: DWORD read FMethodListIdx; + + property Name: WideString read GetName; + property Namespace: WideString read GetNamespace; + property FullName: WideString read GetFullName; + property Extends: TJclClrTableRow read GetExtends; + + property Attributes: TJclClrTypeAttributes read GetAttributes; + + property Visibility: TJclClrTypeVisibility read GetVisibility; + property ClassLayout: TJclClrClassLayout read GetClassLayout; + property ClassSemantics: TJclClrClassSemantics read GetClassSemantics; + property StringFormatting: TJclClrStringFormatting read GetStringFormatting; + + property Fields[const Idx: Integer]: TJclClrTableFieldDefRow read GetField; + property FieldCount: Integer read GetFieldCount; + property Methods[const Idx: Integer]: TJclClrTableMethodDefRow read GetMethod; + property MethodCount: Integer read GetMethodCount; + end; + + TJclClrTableTypeDef = class(TJclClrTable, ITableCanDumpIL) + private + function GetRow(const Idx: Integer): TJclClrTableTypeDefRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableTypeDefRow read GetRow; default; + end; + + TJclClrTableTypeRefRow = class(TJclClrTableRow) + private + FResolutionScopeIdx: DWORD; + FNamespaceOffset: DWORD; + FNameOffset: DWORD; + function GetName: WideString; + function GetNamespace: WideString; + function GetResolutionScope: TJclClrTableRow; + function GetResolutionScopeName: string; + function GetFullName: WideString; + public + constructor Create(const ATable: TJclClrTable); override; + function DumpIL: string; override; + + property ResolutionScopeIdx: DWORD read FResolutionScopeIdx; + property NameOffset: DWORD read FNameOffset; + property NamespaceOffset: DWORD read FNamespaceOffset; + + property ResolutionScope: TJclClrTableRow read GetResolutionScope; + property ResolutionScopeName: string read GetResolutionScopeName; + property Name: WideString read GetName; + property Namespace: WideString read GetNamespace; + property FullName: WideString read GetFullName; + end; + + TJclClrTableTypeRef = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableTypeRefRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableTypeRefRow read GetRow; default; + end; + + TJclClrTableTypeSpecRow = class(TJclClrTableRow) + private + FSignatureOffset: DWORD; + function GetSignature: TJclClrBlobRecord; + public + constructor Create(const ATable: TJclClrTable); override; + property SignatureOffset: DWORD read FSignatureOffset; + property Signature: TJclClrBlobRecord read GetSignature; + end; + + TJclClrTableTypeSpec = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableTypeSpecRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableTypeSpecRow read GetRow; default; + end; + + TJclClrTableENCMapRow = class(TJclClrTableRow) + private + FToken: DWORD; + FFuncCode: DWORD; + protected + property FuncCode: DWORD read FFuncCode; + public + constructor Create(const ATable: TJclClrTable); override; + end; + + TJclClrTableENCMap = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableENCMapRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableENCMapRow read GetRow; default; + end; + + TJclClrTableENCLogRow = class(TJclClrTableENCMapRow) + private + FFuncCode: DWORD; + protected + property FuncCode: DWORD read FFuncCode; + public + constructor Create(const ATable: TJclClrTable); override; + end; + + TJclClrTableENCLog = class(TJclClrTable) + private + function GetRow(const Idx: Integer): TJclClrTableENCLogRow; + protected + class function TableRowClass: TJclClrTableRowClass; override; + public + property Rows[const Idx: Integer]: TJclClrTableENCLogRow read GetRow; default; + end; + + EJclMetadataError = class(EJclError); + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.Math, + {$IFDEF HAS_UNIT_CHARACTER} + System.Character, + {$ENDIF HAS_UNIT_CHARACTER} + {$ELSE ~HAS_UNITSCOPE} + Math, + {$IFDEF HAS_UNIT_CHARACTER} + Character, + {$ENDIF HAS_UNIT_CHARACTER} + {$ENDIF ~HAS_UNITSCOPE} + JclCIL, JclResources, JclStrings; + +const + // MAX_CLASS_NAME = 1024; + MAX_PATH_NAME = 260; + + // Assembly attr bits, used by DefineAssembly. + afPublicKey = $0001; // The assembly ref holds the full (unhashed) public key. + afCompatibilityMask = $0070; + afSideBySideCompatible = $0000; // The assembly is side by side compatible. + afNonSideBySideAppDomain = $0010; // The assembly cannot execute with other versions if + // they are executing in the same application domain. + afNonSideBySideProcess = $0020; // The assembly cannot execute with other versions if + // they are executing in the same process. + afNonSideBySideMachine = $0030; // The assembly cannot execute with other versions if + // they are executing on the same machine. + afEnableJITcompileTracking = $8000; // From "DebuggableAttribute". + afDisableJITcompileOptimizer = $4000; // From "DebuggableAttribute". + + ClrAssemblyFlagMapping: array [TJclClrAssemblyFlag] of DWORD = + (afPublicKey, afCompatibilityMask, afSideBySideCompatible, + afNonSideBySideAppDomain, afNonSideBySideProcess, + afNonSideBySideMachine, afEnableJITcompileTracking, + afDisableJITcompileOptimizer); + + mrVisibilityMask = $0007; + mrPublic = $0001; // The Resource is exported from the Assembly. + mrPrivate = $0002; // The Resource is private to the Assembly. + + ManifestResourceVisibilityMapping: array [TJclClrTableManifestResourceVisibility] of DWORD = + (mrPublic, mrPrivate); + + // MethodDef attr bits, Used by DefineMethod. + // member access mask - Use this mask to retrieve accessibility information. + mdMemberAccessMask = $0007; + // mdPrivateScope = $0000; // Member not referenceable. + // mdPrivate = $0001; // Accessible only by the parent type. + // mdFamANDAssem = $0002; // Accessible by sub-types only in this Assembly. + // mdAssem = $0003; // Accessibly by anyone in the Assembly. + // mdFamily = $0004; // Accessible only by type and sub-types. + // mdFamORAssem = $0005; // Accessibly by sub-types anywhere, plus anyone in assembly. + // mdPublic = $0006; // Accessibly by anyone who has visibility to this scope. + // end member access mask + + // method contract attributes. + mdStatic = $0010; // Defined on type, else per instance. + mdFinal = $0020; // Method may not be overridden. + mdVirtual = $0040; // Method virtual. + mdHideBySig = $0080; // Method hides by name+sig, else just by name. + + // vtable layout mask - Use this mask to retrieve vtable attributes. + mdVtableLayoutMask = $0100; + // mdReuseSlot = $0000; // The default. + mdNewSlot = $0100; // Method always gets a new slot in the vtable. + // end vtable layout mask + + // method implementation attributes. + mdCheckAccessOnOverride = $0200; // Overridability is the same as the visibility. + mdAbstract = $0400; // Method does not provide an implementation. + mdSpecialName = $0800; // Method is special. Name describes how. + + // interop attributes + mdPinvokeImpl = $2000; // Implementation is forwarded through pinvoke. + mdUnmanagedExport = $0008; // Managed method exported via thunk to unmanaged code. + + // Reserved flags for runtime use only. + // mdReservedMask = $d000; + mdRTSpecialName = $1000; // Runtime should check name encoding. + mdHasSecurity = $4000; // Method has security associate with it. + mdRequireSecObject = $8000; // Method calls another method containing security code. + + // MethodImpl attr bits, used by DefineMethodImpl. + // code impl mask + miCodeTypeMask = $0003; // Flags about code type. + // miIL = $0000; // Method impl is IL. + // miNative = $0001; // Method impl is native. + // miOPTIL = $0002; // Method impl is OPTIL + // miRuntime = $0003; // Method impl is provided by the runtime. + // end code impl mask + + // managed mask + miManagedMask = $0004; // Flags specifying whether the code is managed or unmanaged. + // miUnmanaged = $0004; // Method impl is unmanaged, otherwise managed. + miManaged = $0000; // Method impl is managed. + // end managed mask + + // implementation info and interop + miForwardRef = $0010; // Indicates method is defined; used primarily in merge scenarios. + miPreserveSig = $0080; // Indicates method sig is not to be mangled to do HRESULT conversion. + + miInternalCall = $1000; // Reserved for internal use. + + miSynchronized = $0020; // Method is single threaded through the body. + miNoInlining = $0008; // Method may not be inlined. + // miMaxMethodImplVal = $ffff; // Range check value + + // Calling convention flags. + IMAGE_CEE_CS_CALLCONV_DEFAULT = $0; + IMAGE_CEE_CS_CALLCONV_VARARG = $5; + IMAGE_CEE_CS_CALLCONV_FIELD = $6; + IMAGE_CEE_CS_CALLCONV_LOCAL_SIG = $7; + // IMAGE_CEE_CS_CALLCONV_PROPERTY = $8; + // IMAGE_CEE_CS_CALLCONV_UNMGD = $9; + // IMAGE_CEE_CS_CALLCONV_MAX = $10; // first invalid calling convention + // The high bits of the calling convention convey additional info + IMAGE_CEE_CS_CALLCONV_MASK = $0f; // Calling convention is bottom 4 bits + IMAGE_CEE_CS_CALLCONV_HASTHIS = $20; // Top bit indicates a 'this' parameter + IMAGE_CEE_CS_CALLCONV_EXPLICITTHIS = $40; // This parameter is explicitly in the signature + + // TypeDef/ExportedType attr bits, used by DefineTypeDef. + // Use this mask to retrieve the type visibility information. + tdVisibilityMask = $00000007; + // tdNotPublic = $00000000; // Class is not public scope. + // tdPublic = $00000001; // Class is public scope. + // tdNestedPublic = $00000002; // Class is nested with public visibility. + // tdNestedPrivate = $00000003; // Class is nested with private visibility. + // tdNestedFamily = $00000004; // Class is nested with family visibility. + // tdNestedAssembly = $00000005; // Class is nested with assembly visibility. + // tdNestedFamANDAssem = $00000006; // Class is nested with family and assembly visibility. + // tdNestedFamORAssem = $00000007; // Class is nested with family or assembly visibility. + + // Use this mask to retrieve class layout information + tdLayoutMask = $00000018; + tdAutoLayout = $00000000; // Class fields are auto-laid out + tdSequentialLayout = $00000008; // Class fields are laid out sequentially + tdExplicitLayout = $00000010; // Layout is supplied explicitly + // end layout mask + + // Use this mask to retrieve class semantics information. + tdClassSemanticsMask = $00000020; + // tdClass = $00000000; // Type is a class. + tdInterface = $00000020; // Type is an interface. + // end semantics mask + + // Special semantics in addition to class semantics. + tdAbstract = $00000080; // Class is abstract + tdSealed = $00000100; // Class is concrete and may not be extended + tdSpecialName = $00000400; // Class name is special. Name describes how. + + // Implementation attributes. + tdImport = $00001000; // Class / interface is imported + tdSerializable = $00002000; // The class is Serializable. + + // Use tdStringFormatMask to retrieve string information for native interop + tdStringFormatMask = $00030000; + tdAnsiClass = $00000000; // LPTSTR is interpreted as ANSI in this class + tdUnicodeClass = $00010000; // LPTSTR is interpreted as UNICODE + tdAutoClass = $00020000; // LPTSTR is interpreted automatically + // end string format mask + + tdBeforeFieldInit = $00100000; // Initialize the class any time before first static field access. + + // Flags reserved for runtime use. + // tdReservedMask = $00040800; + tdRTSpecialName = $00000800; // Runtime should check name encoding. + tdHasSecurity = $00040000; // Class has security associate with it. + + // FieldDef attr bits, used by DefineField. + // member access mask - Use this mask to retrieve accessibility information. + fdFieldAccessMask = $0007; + fdPrivateScope = $0000; // Member not referenceable. + // fdPrivate = $0001; // Accessible only by the parent type. + // fdFamANDAssem = $0002; // Accessible by sub-types only in this Assembly. + // fdAssembly = $0003; // Accessibly by anyone in the Assembly. + // fdFamily = $0004; // Accessible only by type and sub-types. + // fdFamORAssem = $0005; // Accessibly by sub-types anywhere, plus anyone in assembly. + fdPublic = $0006; // Accessibly by anyone who has visibility to this scope. + // end member access mask + + // field contract attributes. + fdStatic = $0010; // Defined on type, else per instance. + fdInitOnly = $0020; // Field may only be initialized, not written to after init. + fdLiteral = $0040; // Value is compile time constant. + fdNotSerialized = $0080; // Field does not have to be serialized when type is remoted. + + fdSpecialName = $0200; // field is special. Name describes how. + + // interop attributes + fdPinvokeImpl = $2000; // Implementation is forwarded through pinvoke. + + // Reserved flags for runtime use only. + // fdReservedMask = $9500; + fdRTSpecialName = $0400; // Runtime(metadata internal APIs) should check name encoding. + fdHasFieldMarshal = $1000; // Field has marshalling information. + fdHasDefault = $8000; // Field has default. + fdHasFieldRVA = $0100; // Field has RVA. + + // Flags for Params + pdIn = $0001; // Param is [In] + pdOut = $0002; // Param is [out] + pdOptional = $0010; // Param is optional + + // Reserved flags for Runtime use only. + // pdReservedMask = $f000; + pdHasDefault = $1000; // Param has default value. + pdHasFieldMarshal = $2000; // Param has FieldMarshal. + + // pdUnused = $cfe0; + + ClrParamKindMapping: array [TJclClrParamKind] of DWORD = + (pdIn, pdOut, pdOptional, pdHasDefault, pdHasFieldMarshal); + + // Element type for Cor signature + ELEMENT_TYPE_END = $0; + ELEMENT_TYPE_VOID = $1; + ELEMENT_TYPE_BOOLEAN = $2; + ELEMENT_TYPE_CHAR = $3; + ELEMENT_TYPE_I1 = $4; + ELEMENT_TYPE_U1 = $5; + ELEMENT_TYPE_I2 = $6; + ELEMENT_TYPE_U2 = $7; + ELEMENT_TYPE_I4 = $8; + ELEMENT_TYPE_U4 = $9; + ELEMENT_TYPE_I8 = $a; + ELEMENT_TYPE_U8 = $b; + ELEMENT_TYPE_R4 = $c; + ELEMENT_TYPE_R8 = $d; + ELEMENT_TYPE_STRING = $e; + + // every type above PTR will be simple type + ELEMENT_TYPE_PTR = $f; // PTR + ELEMENT_TYPE_BYREF = $10; // BYREF + + // Please use ELEMENT_TYPE_VALUETYPE. ELEMENT_TYPE_VALUECLASS is deprecated. + ELEMENT_TYPE_VALUETYPE = $11; // VALUETYPE + ELEMENT_TYPE_CLASS = $12; // CLASS + + ELEMENT_TYPE_ARRAY = $14; // MDARRAY ... ... + + ELEMENT_TYPE_TYPEDBYREF = $16; // This is a simple type. + + ELEMENT_TYPE_I = $18; // native integer size + ELEMENT_TYPE_U = $19; // native unsigned integer size + ELEMENT_TYPE_FNPTR = $1B; // FNPTR + ELEMENT_TYPE_OBJECT = $1C; // Shortcut for System.Object + ELEMENT_TYPE_SZARRAY = $1D; // Shortcut for single dimension zero lower bound array + // SZARRAY + + // This is only for binding + ELEMENT_TYPE_CMOD_REQD = $1F; // required C modifier : E_T_CMOD_REQD + ELEMENT_TYPE_CMOD_OPT = $20; // optional C modifier : E_T_CMOD_OPT + + // This is for signatures generated internally (which will not be persisted in any way). + ELEMENT_TYPE_INTERNAL = $21; // INTERNAL + + // Note that this is the max of base type excluding modifiers + ELEMENT_TYPE_MAX = $22; // first invalid element type + + + ELEMENT_TYPE_MODIFIER = $40; + ELEMENT_TYPE_SENTINEL = $01 or ELEMENT_TYPE_MODIFIER; // sentinel for varargs + ELEMENT_TYPE_PINNED = $05 or ELEMENT_TYPE_MODIFIER; + + ClrElementTypeMapping: array [TJclClrElementType] of Byte = + (ELEMENT_TYPE_END, ELEMENT_TYPE_VOID, ELEMENT_TYPE_BOOLEAN, + ELEMENT_TYPE_CHAR, ELEMENT_TYPE_I1, ELEMENT_TYPE_U1, + ELEMENT_TYPE_I2, ELEMENT_TYPE_U2, ELEMENT_TYPE_I4, ELEMENT_TYPE_U4, + ELEMENT_TYPE_I8, ELEMENT_TYPE_U8, ELEMENT_TYPE_R4, ELEMENT_TYPE_R8, + ELEMENT_TYPE_STRING, ELEMENT_TYPE_PTR, ELEMENT_TYPE_BYREF, + ELEMENT_TYPE_VALUETYPE, ELEMENT_TYPE_CLASS, ELEMENT_TYPE_ARRAY, + ELEMENT_TYPE_TYPEDBYREF, ELEMENT_TYPE_I, ELEMENT_TYPE_U, + ELEMENT_TYPE_FNPTR, ELEMENT_TYPE_OBJECT, ELEMENT_TYPE_SZARRAY, + ELEMENT_TYPE_CMOD_REQD, ELEMENT_TYPE_CMOD_OPT, ELEMENT_TYPE_INTERNAL, + ELEMENT_TYPE_MAX, ELEMENT_TYPE_MODIFIER, ELEMENT_TYPE_SENTINEL, + ELEMENT_TYPE_PINNED); + + ClrMethodFlagMapping: array [TJclClrMethodFlag] of Word = + (mdStatic, mdFinal, mdVirtual, mdHideBySig, mdCheckAccessOnOverride, + mdAbstract, mdSpecialName, mdPinvokeImpl, mdUnmanagedExport, + mdRTSpecialName, mdHasSecurity, mdRequireSecObject); + + ClrMethodImplFlagMapping: array [TJclClrMethodImplFlag] of Word = + (miForwardRef, miPreserveSig, miInternalCall, miSynchronized, miNoInlining); + + // Property attr bits, used by DefineProperty. + prSpecialName = $0200; // property is special. Name describes how. + + // Reserved flags for Runtime use only. + // prReservedMask = $f400; + prRTSpecialName = $0400; // Runtime(metadata internal APIs) should check name encoding. + prHasDefault = $1000; // Property has default + + // prUnused = $e9ff; + + ClrTablePropertyFlagMapping: array [TJclClrTablePropertyFlag] of Word = + (prSpecialName, prRTSpecialName, prHasDefault); + + // Event attr bits, used by DefineEvent. + // evSpecialName = $0200; // event is special. Name describes how. + + // Reserved flags for Runtime use only. + // evReservedMask = $0400; + // evRTSpecialName = $0400; // Runtime(metadata internal APIs) should check name encoding. + + // ClrTableEventFlagMapping: array [TJclClrTableEventFlag] of Word = + // (evSpecialName, evRTSpecialName); + + // DeclSecurity attr bits, used by DefinePermissionSet + // dclActionMask = $000f; // Mask allows growth of enum. + // dclActionNil = $0000; + // dclRequest = $0001; + // dclDemand = $0002; + // dclAssert = $0003; + // dclDeny = $0004; + // dclPermitOnly = $0005; + // dclLinktimeCheck = $0006; + // dclInheritanceCheck = $0007; + // dclRequestMinimum = $0008; + // dclRequestOptional = $0009; + // dclRequestRefuse = $000a; + // dclPrejitGrant = $000b; // Persisted grant set at prejit time + // dclPrejitDenied = $000c; // Persisted denied set at prejit time + // dclNonCasDemand = $000d; // + // dclNonCasLinkDemand = $000e; + // dclNonCasInheritance = $000f; + // dclMaximumValue = $000f; // Maximum legal value + + // PinvokeMap attr bits, used by DefinePinvokeMap + // pmNoMangle = $0001; // Pinvoke is to use the member name as specified. + + // Use this mask to retrieve the CharSet information. + // pmCharSetMask = $0006; + // pmCharSetNotSpec = $0000; + // pmCharSetAnsi = $0002; + // pmCharSetUnicode = $0004; + // pmCharSetAuto = $0006; + + + // pmBestFitUseAssem = $0000; + // pmBestFitEnabled = $0010; + // pmBestFitDisabled = $0020; + // pmBestFitMask = $0030; + + // pmThrowOnUnmappableCharUseAssem = $0000; + // pmThrowOnUnmappableCharEnabled = $1000; + // pmThrowOnUnmappableCharDisabled = $2000; + // pmThrowOnUnmappableCharMask = $3000; + + // pmSupportsLastError = $0040; // Information about target function. Not relevant for fields. + + // None of the calling convention flags is relevant for fields. + // pmCallConvMask = $0700; + // pmCallConvWinapi = $0100; // Pinvoke will use native callconv appropriate to target windows platform. + // pmCallConvCdecl = $0200; + // pmCallConvStdcall = $0300; + // pmCallConvThiscall = $0400; // In M9, pinvoke will raise exception. + // pmCallConvFastcall = $0500; + +function IsBitSet(const Value, Flag: DWORD): Boolean; +begin + Result := (Value and Flag) = Flag; +end; + +//=== { TJclClrSignature } =================================================== + +constructor TJclClrSignature.Create(const ABlob: TJclClrBlobRecord); +begin + inherited Create; + FBlob := ABlob; +end; + +function TJclClrSignature.IsModifierType(const AElementType: TJclClrElementType): Boolean; +begin + Result := AElementType in [etPtr, etByRef, etModifier, etSentinel, etPinned]; +end; + +function TJclClrSignature.IsPrimitiveType(const AElementType: TJclClrElementType): Boolean; +begin + Result := AElementType < etPtr; +end; + +function TJclClrSignature.UncompressedDataSize(DataPtr: PJclByteArray): Integer; +begin + if (DataPtr[0] and $80) = 0 then + Result := 1 + else + if (DataPtr[0] and $C0) = $80 then + Result := 2 + else + Result := 4; +end; + +function TJclClrSignature.UncompressData(DataPtr: PJclByteArray; out Value: DWord): Integer; +begin + if (DataPtr[0] and $80) = 0 then // 0??? ???? + begin + Value := DataPtr[0]; + Result := 1; + end + else + if (DataPtr[0] and $C0) = $80 then // 10?? ???? + begin + Value := ((DataPtr[0] and $3F) shl 8) or DataPtr[1]; + Result := 2; + end + else + if (DataPtr[0] and $E0) = $C0 then // 110? ???? + begin + Value := ((DataPtr[0] and $1F) shl 24) or (DataPtr[1] shl 16) or (DataPtr[2] shl 8) or DataPtr[3]; + Result := 4; + end + else + raise EJclMetadataError.CreateResFmt(@RsInvalidSignatureData, + [DataPtr[0], DataPtr[1], DataPtr[2], DataPtr[3]]); +end; + +function TJclClrSignature.UncompressToken(DataPtr: PJclByteArray; out Token: TJclClrToken): Integer; +const + TableMapping: array [0..3] of TJclClrTableKind = (ttTypeDef, ttTypeRef, ttTypeSpec, TJclClrTableKind(0)); +begin + Result := UncompressData(DataPtr, Token); + Token := (Byte(TableMapping[Token and 3]) shl 24) or (Token shr 2); +end; + +function TJclClrSignature.UncompressCallingConv(DataPtr: PJclByteArray): Byte; +begin + Result := DataPtr[0]; +end; + +function TJclClrSignature.UncompressSignedInt(DataPtr: PJclByteArray; out Value: Integer): Integer; +var + Data: DWord; +begin + Result := UncompressData(DataPtr, Data); + + if (Data and 1) <> 0 then + begin + case Result of + 1: + Value := Integer(DWord(Data shr 1) or $ffffffc0); + 2: + Value := Integer(DWord(Data shr 1) or $ffffe000); + else + Value := Integer(DWord(Data shr 1) or $f0000000); + end; + end; +end; + +function TJclClrSignature.UncompressElementType(DataPtr: PJclByteArray): TJclClrElementType; +begin + for Result := Low(TJclClrElementType) to High(TJclClrElementType) do + if ClrElementTypeMapping[Result] = (DataPtr[0] and $7F) then + Break; +end; + +function TJclClrSignature.UncompressFieldSignature: string; +var + DataPtr: PJclByteArray; +begin + DataPtr := Blob.Memory; + + Assert(DataPtr[0] = IMAGE_CEE_CS_CALLCONV_FIELD); + Inc(DataPtr); + Result := UncompressTypeSignature(DataPtr); +end; + +function TJclClrSignature.UncompressTypeSignature(DataPtr: PJclByteArray): string; +const + SimpleTypeName: array [etVoid..etString] of PChar = + ('void', 'bool', 'char', + 'int8', 'unsigned int8', 'int16', 'unsigned int16', + 'int32', 'unsigned int32', 'int64', 'unsigned int64', + 'float32', 'float64', 'string'); + TypedTypeName: array [etPtr..etClass] of PChar = + ('ptr', 'byref', 'valuetype', 'class'); +var + ElementType: TJclClrElementType; + Token: TJclClrToken; +begin + ElementType := UncompressElementType(DataPtr); + + case ElementType of + etVoid, etBoolean, etChar, etI1, etU1, etI2, etU2, etI4, etU4, etI8, etU8, etR4, etR8, etString: + Result := SimpleTypeName[ElementType]; + etI: + Result := 'System.IntPtr'; + etU: + Result := 'System.UIntPtr'; + etObject: + Result := 'System.object'; + etTypedByRef: + Result := 'Typed By Ref'; + etPtr, etByRef, etValueType, etClass: + begin + UncompressToken(DataPtr, Token); + Result := Format('%s /*%.8x*/', [TypedTypeName[ElementType], Token]); + end; + etSzArray: + begin + end; + etFnPtr: + begin + end; + etArray: + begin + end; + else + Result := 'Unknown Type'; + end; +end; + +function TJclClrSignature.Inc(var DataPtr: PJclByteArray; Step: TJclAddr): PByte; +begin + Result := PByte(TJclAddr(DataPtr) + Step); + DataPtr := PJclByteArray(Result); +end; + +function TJclClrSignature.ReadValue: DWORD; +begin + FBlob.Seek(UncompressData(Blob.Data, Result), soFromCurrent); +end; + +function TJclClrSignature.ReadInteger: Integer; +begin + FBlob.Seek(UncompressSignedInt(Blob.Data, Result), soFromCurrent); +end; + +function TJclClrSignature.ReadToken: TJclClrToken; +begin + FBlob.Seek(UncompressToken(Blob.Data, Result), soFromCurrent); +end; + +function TJclClrSignature.ReadElementType: TJclClrElementType; +begin + Result := UncompressElementType(Blob.Data); + FBlob.Seek(1, soFromCurrent); +end; + +function TJclClrSignature.ReadByte: Byte; +begin + Result := Blob.Data[0]; + FBlob.Seek(1, soFromCurrent); +end; + +//=== { TJclClrArraySign } =================================================== + +constructor TJclClrArraySign.Create(const ABlob: TJclClrBlobRecord); +var + I: Integer; +begin + inherited Create(ABlob); + + SetLength(FBounds, ReadInteger); + + for I := 0 to Length(FBounds)-1 do + begin + FBounds[I][adSize] := 0; + FBounds[I][adLowBound] := 0; + end; + for I := 0 to ReadInteger-1 do + FBounds[I][adSize] := ReadInteger; + for I := 0 to ReadInteger-1 do + FBounds[I][adLowBound] := ReadInteger; +end; + +//=== { TJclClrTableModuleRow } ============================================== + +constructor TJclClrTableModuleRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FGeneration := Table.ReadWord; // Generation (reserved, shall be zero) + FNameOffset := Table.ReadIndex(hkString); // Name (index into String heap) + FMvidIdx := Table.ReadIndex(hkGuid); // Mvid (index into Guid heap) + FEncIdIdx := Table.ReadIndex(hkGuid); // Mvid (index into Guid heap) + FEncBaseIdIdx := Table.ReadIndex(hkGuid); // Mvid (index into Guid heap) +end; + +function TJclClrTableModuleRow.HasEncId: Boolean; +begin + Result := FEncIdIdx > 0; +end; + +function TJclClrTableModuleRow.HasEncBaseId: Boolean; +begin + Result := FEncBaseIdIdx > 0; +end; + +function TJclClrTableModuleRow.GetName: WideString; +begin + Result := Table.Stream.Metadata.StringAt(FNameOffset); + Assert(Result <> ''); // Name shall index a non-null string. + Assert(Length(Result) < MAX_PATH_NAME); +end; + +function TJclClrTableModuleRow.GetMvid: TGUID; +begin + // Mvid shall index a non-null GUID in the Guid heap + Assert(FMvidIdx <= DWORD(Table.Stream.Metadata.GuidCount)); + Result := Table.Stream.Metadata.Guids[FMvidIdx-1]; +end; + +function TJclClrTableModuleRow.GetEncId: TGUID; +begin + Result := Table.Stream.Metadata.Guids[FEncIdIdx-1]; +end; + +function TJclClrTableModuleRow.GetEncBaseId: TGUID; +begin + Result := Table.Stream.Metadata.Guids[FEncBaseIdIdx-1]; +end; + +function TJclClrTableModuleRow.DumpIL: string; +begin + Result := '.module ' + Name + ' // MVID:' + JclGUIDToString(Mvid) + NativeLineBreak; +end; + +function TJclClrTableModule.GetRow(const Idx: Integer): TJclClrTableModuleRow; +begin + Result := TJclClrTableModuleRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableModule.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableModuleRow; +end; + +//=== { TJclClrTableModuleRefRow } =========================================== + +constructor TJclClrTableModuleRefRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FNameOffset := Table.ReadIndex(hkString); +end; + +function TJclClrTableModuleRefRow.DumpIL: string; +begin + Result := '.module extern ' + Name + NativeLineBreak; +end; + +function TJclClrTableModuleRefRow.GetName: WideString; +begin + Result := Table.Stream.Metadata.StringAt(FNameOffset); +end; + +function TJclClrTableModuleRef.GetRow(const Idx: Integer): TJclClrTableModuleRefRow; +begin + Result := TJclClrTableModuleRefRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableModuleRef.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableModuleRefRow; +end; + +//=== { TJclClrTableAssemblyRow } ============================================ + +constructor TJclClrTableAssemblyRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + + FHashAlgId := Table.ReadDWord; + + FMajorVersion := Table.ReadWord; + FMinorVersion := Table.ReadWord; + FBuildNumber := Table.ReadWord; + FRevisionNumber := Table.ReadWord; + + FFlagMask := Table.ReadDWord; + + FPublicKeyOffset := Table.ReadIndex(hkBlob); + FNameOffset := Table.ReadIndex(hkString); + FCultureOffset := Table.ReadIndex(hkString); +end; + +function TJclClrTableAssemblyRow.GetCulture: WideString; +begin + Result := Table.Stream.Metadata.StringAt(FCultureOffset); +end; + +function TJclClrTableAssemblyRow.GetName: WideString; +begin + Result := Table.Stream.Metadata.StringAt(FNameOffset); +end; + +function TJclClrTableAssemblyRow.GetPublicKey: TJclClrBlobRecord; +begin + Result := Table.Stream.Metadata.BlobAt(FPublicKeyOffset); +end; + +function TJclClrTableAssemblyRow.GetVersion: string; +begin + Result := FormatVersionString(FMajorVersion, FMinorVersion, FBuildNumber, FRevisionNumber); +end; + +function TJclClrTableAssemblyRow.GetFlags: TJclClrAssemblyFlags; +begin + Result := AssemblyFlags(FFlagMask); +end; + +class function TJclClrTableAssemblyRow.AssemblyFlags(const Flags: DWORD): TJclClrAssemblyFlags; +var + AFlag: TJclClrAssemblyFlag; +begin + Result := []; + for AFlag := Low(TJclClrAssemblyFlag) to High(TJclClrAssemblyFlag) do + if (Flags and ClrAssemblyFlagMapping[AFlag]) = ClrAssemblyFlagMapping[AFlag] then + Include(Result, AFlag); +end; + +class function TJclClrTableAssemblyRow.AssemblyFlags(const Flags: TJclClrAssemblyFlags): DWORD; +var + AFlag: TJclClrAssemblyFlag; +begin + Result := 0; + for AFlag := Low(TJclClrAssemblyFlag) to High(TJclClrAssemblyFlag) do + if AFlag in Flags then + Result := Result or ClrAssemblyFlagMapping[AFlag]; +end; + +function TJclClrTableAssemblyRow.DumpIL: string; +var + I: Integer; + TblCustomAttribute: TJclClrTableCustomAttribute; +begin + with TStringList.Create do + try + Add(Format('.assembly /*%.8x*/ %s', [Token, Name])); + Add('{'); + + if Table.Stream.FindTable(ttCustomAttribute, TJclClrTable(TblCustomAttribute)) then + for I := 0 to TblCustomAttribute.RowCount-1 do + if TblCustomAttribute.Rows[I].Parent = Self then + Add(' ' + TblCustomAttribute.Rows[I].DumpIL); + + if FPublicKeyOffset <> 0 then + Add(PublicKey.Dump(' .publickey = ')); + + Add(' .hash algorithm 0x' + IntToHex(HashAlgId, 8)); + + if FCultureOffset <> 0 then + Add(' .culture "' + Culture + '"'); + + Add(' .ver ' + Version); + Add('}'); + Result := Text; + finally + Free; + end; +end; + +function TJclClrTableAssembly.GetRow(const Idx: Integer): TJclClrTableAssemblyRow; +begin + Result := TJclClrTableAssemblyRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableAssembly.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableAssemblyRow; +end; + +//=== { TJclClrTableAssemblyOSRow } ========================================== + +constructor TJclClrTableAssemblyOSRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + + FPlatformID := Table.ReadDWord; + FMajorVersion := Table.ReadDWord; + FMinorVersion := Table.ReadDWord; +end; + +function TJclClrTableAssemblyOSRow.GetVersion: string; +begin + Result := FormatVersionString(FMajorVersion, FMinorVersion); +end; + +function TJclClrTableAssemblyOS.GetRow(const Idx: Integer): TJclClrTableAssemblyOSRow; +begin + Result := TJclClrTableAssemblyOSRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableAssemblyOS.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableAssemblyOSRow; +end; + +//=== { TJclClrTableAssemblyProcessorRow } =================================== + +constructor TJclClrTableAssemblyProcessorRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FProcessor := Table.ReadDWord; +end; + +function TJclClrTableAssemblyProcessor.GetRow(const Idx: Integer): TJclClrTableAssemblyProcessorRow; +begin + Result := TJclClrTableAssemblyProcessorRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableAssemblyProcessor.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableAssemblyProcessorRow; +end; + +//=== { TJclClrTableAssemblyRefRow } ========================================= + +constructor TJclClrTableAssemblyRefRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + + FMajorVersion := Table.ReadWord; + FMinorVersion := Table.ReadWord; + FBuildNumber := Table.ReadWord; + FRevisionNumber := Table.ReadWord; + + FFlagMask := Table.ReadDWord; + + FPublicKeyOrTokenOffset := Table.ReadIndex(hkBlob); + FNameOffset := Table.ReadIndex(hkString); + FCultureOffset := Table.ReadIndex(hkString); + FHashValueOffset := Table.ReadIndex(hkBlob); +end; + +function TJclClrTableAssemblyRefRow.DumpIL: string; +var + I: Integer; + TblCustomAttribute: TJclClrTableCustomAttribute; + + function DumpPublicKey: string; + var + I: Integer; + Pch: PChar; + HexStr, AsciiStr: string; + begin + Pch := PChar(PublicKeyOrToken.Memory); + HexStr := ''; + AsciiStr := ''; + for I := 0 to PublicKeyOrToken.Size do + begin + HexStr := HexStr + IntToHex(Integer(Pch[I]), 2) + ' '; + if CharIsAlphaNum(Pch[I]) then + AsciiStr := AsciiStr + Pch[I] + else + AsciiStr := AsciiStr + '.'; + end; + Result := '(' + HexStr + ') // ' + AsciiStr; + end; + +begin + with TStringList.Create do + try + Add(Format('.assembly extern /*%.8x*/ %s', [Token, Name])); + Add('{'); + + if Table.Stream.FindTable(ttCustomAttribute, TJclClrTable(TblCustomAttribute)) then + for I := 0 to TblCustomAttribute.RowCount-1 do + if TblCustomAttribute.Rows[I].Parent = Self then + Add(' ' + TblCustomAttribute.Rows[I].DumpIL); + + if Assigned(HashValue) then + Add(PublicKeyOrToken.Dump(' .hash = ')); + + if Assigned(PublicKeyOrToken) then + Add(PublicKeyOrToken.Dump(' .publickeytoken = ')); + + if FCultureOffset <> 0 then + Add(' .culture "' + Culture + '"'); + + Add(' .ver ' + Version); + Add('}'); + Result := Text; + finally + Free; + end; +end; + +function TJclClrTableAssemblyRefRow.GetCulture: WideString; +begin + Result := Table.Stream.Metadata.StringAt(FCultureOffset); +end; + +function TJclClrTableAssemblyRefRow.GetFlags: TJclClrAssemblyFlags; +begin + Result := TJclClrTableAssemblyRow.AssemblyFlags(FFlagMask); +end; + +function TJclClrTableAssemblyRefRow.GetHashValue: TJclClrBlobRecord; +begin + Result := Table.Stream.Metadata.BlobAt(FHashValueOffset); +end; + +function TJclClrTableAssemblyRefRow.GetName: WideString; +begin + Result := Table.Stream.Metadata.StringAt(FNameOffset); +end; + +function TJclClrTableAssemblyRefRow.GetPublicKeyOrToken: TJclClrBlobRecord; +begin + Result := Table.Stream.Metadata.BlobAt(FPublicKeyOrTokenOffset); +end; + +function TJclClrTableAssemblyRefRow.GetVersion: string; +begin + Result := FormatVersionString(FMajorVersion, FMinorVersion, FBuildNumber, FRevisionNumber); +end; + +function TJclClrTableAssemblyRef.GetRow(const Idx: Integer): TJclClrTableAssemblyRefRow; +begin + Result := TJclClrTableAssemblyRefRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableAssemblyRef.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableAssemblyRefRow; +end; + +//=== { TJclClrTableAssemblyRefOSRow } ======================================= + +constructor TJclClrTableAssemblyRefOSRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FAssemblyRefIdx := Table.ReadIndex([ttAssemblyRef]); +end; + +function TJclClrTableAssemblyRefOSRow.GetAssemblyRef: TJclClrTableAssemblyRefRow; +var + AssemblyRefTable: TJclClrTableAssemblyRef; +begin + if Table.Stream.FindTable(ttAssemblyRef, TJclClrTable(AssemblyRefTable)) then + Result := AssemblyRefTable[FAssemblyRefIdx-1] + else + Result := nil; +end; + +function TJclClrTableAssemblyRefOS.GetRow(const Idx: Integer): TJclClrTableAssemblyRefOSRow; +begin + Result := TJclClrTableAssemblyRefOSRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableAssemblyRefOS.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableAssemblyRefOSRow; +end; + +//=== { TJclClrTableAssemblyRefProcessorRow } ================================ + +constructor TJclClrTableAssemblyRefProcessorRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FAssemblyRefIdx := Table.ReadIndex([ttAssemblyRef]); +end; + +function TJclClrTableAssemblyRefProcessorRow.GetAssemblyRef: TJclClrTableAssemblyRefRow; +var + AssemblyRefTable: TJclClrTableAssemblyRef; +begin + if Table.Stream.FindTable(ttAssemblyRef, TJclClrTable(AssemblyRefTable)) then + Result := AssemblyRefTable[FAssemblyRefIdx-1] + else + Result := nil; +end; + +function TJclClrTableAssemblyRefProcessor.GetRow( + const Idx: Integer): TJclClrTableAssemblyRefProcessorRow; +begin + Result := TJclClrTableAssemblyRefProcessorRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableAssemblyRefProcessor.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableAssemblyRefProcessorRow; +end; + +//=== { TJclClrTableClassLayoutRow } ========================================= + +constructor TJclClrTableClassLayoutRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FPackingSize := Table.ReadWord; + FClassSize := Table.ReadDWord; + FParentIdx := Table.ReadIndex([ttTypeDef]); +end; + +function TJclClrTableClassLayout.GetRow(const Idx: Integer): TJclClrTableClassLayoutRow; +begin + Result := TJclClrTableClassLayoutRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableClassLayout.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableClassLayoutRow; +end; + +//=== { TJclClrTableConstantRow } ============================================ + +constructor TJclClrTableConstantRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FKind := Table.ReadByte; + Table.ReadByte; // padding zero + FParentIdx := Table.ReadIndex([ttParamDef, ttFieldDef, ttPropertyDef]); + FValueOffset := Table.ReadIndex(hkBlob); +end; + +function TJclClrTableConstantRow.DumpIL: string; +begin + case ElementType of + etBoolean: + Result := BooleanToStr(Boolean(PBoolean(Value.Memory)^)); + etChar: + Result := PWideChar(Value.Memory)^; + etI1: + Result := IntToStr(PShortInt(Value.Memory)^); + etU1: + Result := IntToStr(PByte(Value.Memory)^); + etI2: + Result := IntToStr(PSmallint(Value.Memory)^); + etU2: + Result := IntToStr(PWord(Value.Memory)^); + etI4: + Result := IntToStr(PInteger(Value.Memory)^); + etU4: + Result := IntToStr(PDWORD(Value.Memory)^); + etI8: + Result := IntToStr(PInt64(Value.Memory)^); + etU8: + Result := IntToStr(PInt64(Value.Memory)^); + etR4: + Result := FloatToStr(PSingle(Value.Memory)^); + etR8: + Result := FloatToStr(PDouble(Value.Memory)^); + etString: + Result := '"' + WideCharLenToString(PWideChar(Value.Memory), Value.Size div 2) + '"'; + etClass: + begin + if FValueOffset = 0 then + begin + Result := ' nullref'; + Exit; + end; + + Result := Table.Stream.Metadata.Tokens[PJclClrToken(Value.Memory)^].DumpIL; + end; + end; + Result := ' = ' + Result; +end; + +function TJclClrTableConstantRow.GetElementType: TJclClrElementType; +begin + for Result := Low(TJclClrElementType) to High(TJclClrElementType) do + if ClrElementTypeMapping[Result] = FKind then + Exit; + Result := etEnd; +end; + +function TJclClrTableConstantRow.GetParent: TJclClrTableRow; +const + HasConstantMapping: array [0..2] of TJclClrTableKind = + (ttFieldDef, ttParamDef, ttPropertyDef); +begin + Assert(FParentIdx and 3 <> 3); + Result := Table.Stream.Tables[HasConstantMapping[FParentIdx and 3]].Rows[FParentIdx shr 2 - 1]; +end; + +function TJclClrTableConstantRow.GetValue: TJclClrBlobRecord; +begin + Result := Table.Stream.Metadata.BlobAt(FValueOffset); +end; + +function TJclClrTableConstant.GetRow(const Idx: Integer): TJclClrTableConstantRow; +begin + Result := TJclClrTableConstantRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableConstant.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableConstantRow; +end; + +//=== { TJclClrTableCustomAttributeRow } ===================================== + +constructor TJclClrTableCustomAttributeRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FParentIdx := Table.ReadIndex([ttModule, ttTypeRef, ttTypeDef, ttFieldDef, + ttMethodDef, ttParamDef, ttInterfaceImpl, ttMemberRef, ttConstant, + ttFieldMarshal, ttDeclSecurity, ttClassLayout, ttFieldLayout, ttSignature, + ttEventMap, ttEventDef, ttPropertyMap, ttPropertyDef, ttMethodSemantics, + ttMethodImpl, ttModuleRef, ttTypeSpec, ttImplMap, ttFieldRVA, ttAssembly, + ttAssemblyProcessor, ttAssemblyOS, ttAssemblyRef, ttAssemblyRefProcessor, + ttAssemblyRefOS, ttFile, ttExportedType, ttManifestResource, ttNestedClass]); + FTypeIdx := Table.ReadIndex([ttMethodDef, ttMemberRef]); + FValueOffset := Table.ReadIndex(hkBlob); +end; + +function TJclClrTableCustomAttributeRow.GetParent: TJclClrTableRow; +const + MapTagToTable: array [0..18] of TJclClrTableKind = + (ttMethodDef, ttFieldDef, ttTypeRef, ttTypeDef, ttParamDef, ttInterfaceImpl, + ttMemberRef, ttModule, ttDeclSecurity, ttPropertyDef, ttEventDef, ttSignature, + ttModuleRef, ttTypeSpec, ttAssembly, ttAssemblyRef, ttFile, ttExportedType, + ttManifestResource); +var + WideIndex: Boolean; +begin + WideIndex := Table.IsWideIndex([ttModule, ttTypeRef, ttTypeDef, ttFieldDef, + ttMethodDef, ttParamDef, ttInterfaceImpl, ttMemberRef, ttConstant, + ttFieldMarshal, ttDeclSecurity, ttClassLayout, ttFieldLayout, ttSignature, + ttEventMap, ttEventDef, ttPropertyMap, ttPropertyDef, ttMethodSemantics, + ttMethodImpl, ttModuleRef, ttTypeSpec, ttImplMap, ttFieldRVA, ttAssembly, + ttAssemblyProcessor, ttAssemblyOS, ttAssemblyRef, ttAssemblyRefProcessor, + ttAssemblyRefOS, ttFile, ttExportedType, ttManifestResource, ttNestedClass]); + + Assert(Table.GetCodedIndexTag(FParentIdx, 5, WideIndex) <= 18); + Result := Table.Stream.Tables[ + MapTagToTable[Table.GetCodedIndexTag(FParentIdx, 5, WideIndex)]]. + Rows[Table.GetCodedIndexValue(FParentIdx, 5, WideIndex)-1]; +end; + +function TJclClrTableCustomAttributeRow.GetMethod: TJclClrTableRow; +const + MapTagToTable: array [2..3] of TJclClrTableKind = (ttMethodDef, ttMemberRef); +var + WideIndex: Boolean; +begin + WideIndex := Table.IsWideIndex([ttMethodDef, ttMemberRef]); + Assert(Table.GetCodedIndexTag(FTypeIdx, 3, WideIndex) in [2, 3]); + Result := Table.Stream.Tables[ + MapTagToTable[Table.GetCodedIndexTag(FTypeIdx, 3, WideIndex)]]. + Rows[Table.GetCodedIndexValue(FTypeIdx, 3, WideIndex)-1]; +end; + +function TJclClrTableCustomAttributeRow.GetValue: TJclClrBlobRecord; +begin + Result := Table.Stream.Metadata.BlobAt(FValueOffset); +end; + +function TJclClrTableCustomAttributeRow.DumpIL: string; +begin + // .custom /*0C000001:0A00000C*/ intance void [mscorlib/* 23000001 */]System.Reflection.AssemblyInformationalVersionAttribute/* 0100001C */::.ctor(string) /* 0A00000C */ = ( 01 00 0A 31 2E 30 2E 33 37 30 35 2E 30 00 00 ) // ...1.0.3705.0.. + Result := Value.Dump(Format('.custom /*%.8x:%.8x*/ %s = ', [Token, Method.Token, Method.DumpIL])); +end; + +function TJclClrTableCustomAttribute.GetRow(const Idx: Integer): TJclClrTableCustomAttributeRow; +begin + Result := TJclClrTableCustomAttributeRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableCustomAttribute.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableCustomAttributeRow; +end; + +//=== { TJclClrTableDeclSecurityRow } ======================================== + +constructor TJclClrTableDeclSecurityRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FAction := Table.ReadWord; + FParentIdx := Table.ReadIndex([ttTypeDef, ttMethodDef, ttAssembly]); + FPermissionSetOffset := Table.ReadIndex(hkBlob); +end; + +function TJclClrTableDeclSecurity.GetRow(const Idx: Integer): TJclClrTableDeclSecurityRow; +begin + Result := TJclClrTableDeclSecurityRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableDeclSecurity.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableDeclSecurityRow; +end; + +//=== { TJclClrTableEventMapRow } ============================================ + +constructor TJclClrTableEventMapRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FParentIdx := Table.ReadIndex([ttTypeDef]); + FEventListIdx := Table.ReadIndex([ttEventDef]); +end; + +function TJclClrTableEventMap.GetRow(const Idx: Integer): TJclClrTableEventMapRow; +begin + Result := TJclClrTableEventMapRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableEventMap.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableEventMapRow; +end; + +//=== { TJclClrTableEventDefRow } ============================================ + +constructor TJclClrTableEventDefRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FEventFlags := Table.ReadWord; + FNameOffset := Table.ReadIndex(hkString); + FEventTypeIdx := Table.ReadIndex([ttTypeDef, ttTypeRef, ttTypeSpec]); +end; + +function TJclClrTableEventDefRow.GetName: WideString; +begin + Result := Table.Stream.Metadata.StringAt(FNameOffset); +end; + +function TJclClrTableEventDef.GetRow(const Idx: Integer): TJclClrTableEventDefRow; +begin + Result := TJclClrTableEventDefRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableEventDef.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableEventDefRow; +end; + +//=== { TJclClrTableEventPtrRow } ============================================ + +constructor TJclClrTableEventPtrRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FEventIdx := Table.ReadIndex([ttEventDef]); +end; + +function TJclClrTableEventPtrRow.GetEvent: TJclClrTableEventDefRow; +begin + Result := TJclClrTableEventDef(Table.Stream.Tables[ttEventDef]).Rows[FEventIdx-1]; +end; + +function TJclClrTableEventPtr.GetRow(const Idx: Integer): TJclClrTableEventPtrRow; +begin + Result := TJclClrTableEventPtrRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableEventPtr.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableEventPtrRow; +end; + +//=== { TJclClrTableExportedTypeRow } ======================================== + +constructor TJclClrTableExportedTypeRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FFlags := Table.ReadDWord; + FTypeDefIdx := Table.ReadDWord; + FTypeNameOffset := Table.ReadIndex(hkString); + FTypeNamespaceOffset := Table.ReadIndex(hkString); + FImplementationIdx := Table.ReadIndex([ttFile, ttExportedType]); +end; + +function TJclClrTableExportedTypeRow.GetTypeName: WideString; +begin + Result := Table.Stream.Metadata.StringAt(FTypeNameOffset); +end; + +function TJclClrTableExportedTypeRow.GetTypeNamespace: WideString; +begin + Result := Table.Stream.Metadata.StringAt(FTypeNamespaceOffset); +end; + +function TJclClrTableExportedType.GetRow(const Idx: Integer): TJclClrTableExportedTypeRow; +begin + Result := TJclClrTableExportedTypeRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableExportedType.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableExportedTypeRow; +end; + +//=== { TJclClrTableFieldDefRow } ============================================ + +constructor TJclClrTableFieldDefRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FFlags := Table.ReadWord; + FNameOffset := Table.ReadIndex(hkString); + FSignatureOffset := Table.ReadIndex(hkBlob); + FParentToken := nil; +end; + +function TJclClrTableFieldDefRow.DumpIL: string; +const + StaticName: array [Boolean] of PChar = + ('', 'static '); + VisibilityName: array [TJclClrTableFieldDefVisibility] of PChar = + ('', 'private', 'famandassem', 'assembly', 'family', 'famandassem', 'public'); +var + I: Integer; + + function DumpFlags: string; + const + FlagName: array [ffInitOnly..ffRTSpecialName] of PChar = + ('initonly', 'literal', 'notserialized', 'specialname', '', 'rtspecialname'); + var + AFlag: TJclClrTableFieldDefFlag; + begin + Result := ''; + for AFlag := Low(FlagName) to High(FlagName) do + if AFlag in Flags then + Result := Result + FlagName[AFlag] + ' '; + end; + + function DumpSignature: string; + begin + with TJclClrSignature.Create(Signature) do + try + Result := UncompressFieldSignature; + finally + Free; + end; + end; + +begin + Result := Format('.field /*%.8x*/ %s%s %s%s %s', [Token, + StaticName[ffStatic in Flags], VisibilityName[Visibility], + DumpFlags, DumpSignature, Name]); + + if ffHasDefault in Flags then + begin + with TJclClrTableConstant(Table.Stream.Tables[ttConstant]) do + for I := 0 to RowCount-1 do + if Rows[I].Parent = Self then + begin + Result := Result + Rows[I].DumpIL; + Break; + end; + end + else + if ffHasFieldRVA in Flags then + begin + { TODO : What to do? } + end; +end; + +function TJclClrTableFieldDefRow.GetName: WideString; +begin + Result := Table.Stream.Metadata.StringAt(FNameOffset); +end; + +function TJclClrTableFieldDefRow.GetSignature: TJclClrBlobRecord; +begin + Result := Table.Stream.Metadata.BlobAt(FSignatureOffset); +end; + +function TJclClrTableFieldDefRow.GetVisibility: TJclClrTableFieldDefVisibility; +const + FieldVisibilityMapping: array [fdPrivateScope..fdPublic] of TJclClrTableFieldDefVisibility = + (fvPrivateScope, fvPrivate, fvFamANDAssem, fvAssembly, fvFamily, fvFamORAssem, fvPublic); +begin + Result := FieldVisibilityMapping[FFlags and fdFieldAccessMask]; +end; + +function TJclClrTableFieldDefRow.GetFlag: TJclClrTableFieldDefFlags; +const + FieldFlagMapping: array [TJclClrTableFieldDefFlag] of Word = + (fdStatic, fdInitOnly, fdLiteral, fdNotSerialized, fdSpecialName, + fdPinvokeImpl, fdRTSpecialName, fdHasFieldMarshal, fdHasDefault, fdHasFieldRVA); +var + AFlag: TJclClrTableFieldDefFlag; +begin + Result := []; + for AFlag := Low(TJclClrTableFieldDefFlag) to High(TJclClrTableFieldDefFlag) do + if FFlags and FieldFlagMapping[AFlag] <> 0 then + Include(Result, AFlag); +end; + +procedure TJclClrTableFieldDefRow.SetParentToken(const ARow: TJclClrTableTypeDefRow); +begin + FParentToken := ARow; +end; + +function TJclClrTableFieldDef.GetRow(const Idx: Integer): TJclClrTableFieldDefRow; +begin + Result := TJclClrTableFieldDefRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableFieldDef.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableFieldDefRow; +end; + +//=== { TJclClrTableFieldPtrRow } ============================================ + +constructor TJclClrTableFieldPtrRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FFieldIdx := Table.ReadIndex([ttFieldDef]); +end; + +function TJclClrTableFieldPtrRow.GetField: TJclClrTableFieldDefRow; +begin + Result := TJclClrTableFieldDef(Table.Stream.Tables[ttFieldDef]).Rows[FFieldIdx-1]; +end; + +function TJclClrTableFieldPtr.GetRow(const Idx: Integer): TJclClrTableFieldPtrRow; +begin + Result := TJclClrTableFieldPtrRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableFieldPtr.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableFieldPtrRow; +end; + +//=== { TJclClrTableFieldLayoutRow } ========================================= + +constructor TJclClrTableFieldLayoutRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FOffset := Table.ReadDWord; + FFieldIdx := Table.ReadIndex([ttFieldDef]); +end; + +function TJclClrTableFieldLayout.GetRow( + const Idx: Integer): TJclClrTableFieldLayoutRow; +begin + Result := TJclClrTableFieldLayoutRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableFieldLayout.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableFieldLayoutRow; +end; + +//=== { TJclClrTableFieldMarshalRow } ======================================== + +constructor TJclClrTableFieldMarshalRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FParentIdx := Table.ReadIndex([ttFieldDef, ttParamDef]); + FNativeTypeOffset := Table.ReadIndex(hkBlob); +end; + +function TJclClrTableFieldMarshal.GetRow( + const Idx: Integer): TJclClrTableFieldMarshalRow; +begin + Result := TJclClrTableFieldMarshalRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableFieldMarshal.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableFieldMarshalRow; +end; + +//=== { TJclClrTableFieldRVARow } ============================================ + +constructor TJclClrTableFieldRVARow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FRVA := Table.ReadDWord; + FFieldIdx := Table.ReadIndex([ttFieldDef]); +end; + +function TJclClrTableFieldRVA.GetRow(const Idx: Integer): TJclClrTableFieldRVARow; +begin + Result := TJclClrTableFieldRVARow(inherited GetRow(Idx)); +end; + +class function TJclClrTableFieldRVA.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableFieldRVARow; +end; + +//=== { TJclClrTableFileRow } ================================================ + +constructor TJclClrTableFileRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FFlags := Table.ReadDWord; + FNameOffset := Table.ReadIndex(hkString); + FHashValueOffset := Table.ReadIndex(hkBlob); +end; + +function TJclClrTableFileRow.GetName: WideString; +begin + Result := Table.Stream.Metadata.StringAt(FNameOffset); +end; + +function TJclClrTableFileRow.GetHashValue: TJclClrBlobRecord; +begin + Result := Table.Stream.Metadata.BlobAt(FHashValueOffset); +end; + +function TJclClrTableFileRow.GetContainsMetadata: Boolean; +const + ffContainsNoMetaData = $0001; +begin + Result := (FFlags and ffContainsNoMetaData) = ffContainsNoMetaData; +end; + +function TJclClrTableFileRow.DumpIL: string; + + function GetMetadataName: string; + begin + if not ContainsMetadata then + Result := 'nometadata ' + end; + +begin + Result := HashValue.Dump('.file ' + GetMetadataName + Name + ' .hash = '); +end; + +function TJclClrTableFile.GetRow(const Idx: Integer): TJclClrTableFileRow; +begin + Result := TJclClrTableFileRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableFile.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableFileRow; +end; + +//=== { TJclClrTableImplMapRow } ============================================= + +constructor TJclClrTableImplMapRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FMappingFlags := Table.ReadWord; + FMemberForwardedIdx := Table.ReadIndex([ttFieldDef, ttMethodDef]); + FImportNameOffset := Table.ReadIndex(hkString); + FImportScopeIdx := Table.ReadIndex([ttModuleRef]); +end; + +function TJclClrTableImplMapRow.GetImportName: WideString; +begin + Result := Table.Stream.Metadata.StringAt(FImportNameOffset); +end; + +function TJclClrTableImplMap.GetRow(const Idx: Integer): TJclClrTableImplMapRow; +begin + Result := TJclClrTableImplMapRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableImplMap.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableImplMapRow; +end; + +//=== { TJclClrTableInterfaceImplRow } ======================================= + +constructor TJclClrTableInterfaceImplRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FClassIdx := Table.ReadIndex([ttTypeDef]); + FInterfaceIdx := Table.ReadIndex([ttTypeDef, ttTypeRef, ttTypeSpec]); +end; + +function TJclClrTableInterfaceImplRow.DumpIL: string; +begin + if ImplInterface is TJclClrTableTypeRefRow then + Result := TJclClrTableTypeRefRow(ImplInterface).DumpIL + else + if ImplInterface is TJclClrTableTypeDefRow then + with TJclClrTableTypeDefRow(ImplInterface) do + Result := Format('%s.%s/*%.8x*/', [Namespace, Name, Token]) + else + Result := 'Unknown'; +end; + +function TJclClrTableInterfaceImplRow.GetImplClass: TJclClrTableRow; +begin + Result := Table.Stream.Metadata.Tokens[FClassIdx]; +end; + +function TJclClrTableInterfaceImplRow.GetImplInterface: TJclClrTableRow; +begin + Result := DecodeTypeDefOrRef(FInterfaceIdx); +end; + +function TJclClrTableInterfaceImpl.GetRow( + const Idx: Integer): TJclClrTableInterfaceImplRow; +begin + Result := TJclClrTableInterfaceImplRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableInterfaceImpl.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableInterfaceImplRow; +end; + +//=== { TJclClrTableManifestResourceRow } ==================================== + +constructor TJclClrTableManifestResourceRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FOffset := Table.ReadDWord; + FFlags := Table.ReadDWord; + FNameOffset := Table.ReadIndex(hkString); + FImplementationIdx := Table.ReadIndex([ttFile, ttAssemblyRef]); +end; + +function TJclClrTableManifestResourceRow.DumpIL: string; +const + VisibilityName: array [TJclClrTableManifestResourceVisibility] of PChar = + ('public', 'private'); +var + I: Integer; + TblCustomAttribute: TJclClrTableCustomAttribute; +begin + with TStringList.Create do + try + Add(Format('.mresource /*%.8x*/ %s %s', [Token, VisibilityName[Visibility], Name])); + Add('('); + + if Table.Stream.FindTable(ttCustomAttribute, TJclClrTable(TblCustomAttribute)) then + for I := 0 to TblCustomAttribute.RowCount-1 do + if TblCustomAttribute.Rows[I].Parent = Self then + Add(' ' + TblCustomAttribute.Rows[I].DumpIL); + + if FImplementationIdx <> 0 then + if ImplementationRow is TJclClrTableAssemblyRefRow then + Add(' .assembly extern ' + + TJclClrTableAssemblyRefRow(ImplementationRow).Name) + else + Add(Format(' .file %s at %d', + [TJclClrTableFileRow(ImplementationRow).Name, Offset])); + Add(')'); + Result := Text; + finally + Free; + end; +end; + +function TJclClrTableManifestResourceRow.GetImplementationRow: TJclClrTableRow; +begin + Result := Table.Stream.Metadata.Tokens[FImplementationIdx]; +end; + +function TJclClrTableManifestResourceRow.GetName: WideString; +begin + Result := Table.Stream.Metadata.StringAt(FNameOffset); +end; + +function TJclClrTableManifestResourceRow.GetVisibility: TJclClrTableManifestResourceVisibility; +begin + for Result := Low(TJclClrTableManifestResourceVisibility) to High(TJclClrTableManifestResourceVisibility) do + if (FFlags and mrVisibilityMask) = ManifestResourceVisibilityMapping[Result] then + Exit; + raise EJclMetadataError.CreateResFmt(@RsUnknownManifestResource, [FFlags and mrVisibilityMask]); +end; + +function TJclClrTableManifestResource.GetRow( + const Idx: Integer): TJclClrTableManifestResourceRow; +begin + Result := TJclClrTableManifestResourceRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableManifestResource.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableManifestResourceRow; +end; + +//=== { TJclClrTableMemberRefRow } =========================================== + +constructor TJclClrTableMemberRefRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FClassIdx := Table.ReadIndex([ttTypeRef, ttModuleRef, ttMethodDef, ttTypeSpec, ttTypeDef]); + FNameOffset := Table.ReadIndex(hkString); + FSignatureOffset := Table.ReadIndex(hkBlob); +end; + +function TJclClrTableMemberRefRow.GetName: WideString; +begin + Result := Table.Stream.Metadata.StringAt(FNameOffset); +end; + +function TJclClrTableMemberRefRow.GetSignature: TJclClrBlobRecord; +begin + Result := Table.Stream.Metadata.BlobAt(FSignatureOffset); +end; + +function TJclClrTableMemberRefRow.GetParentClass: TJclClrTableRow; +const + MapTagToTable: array [1..5] of TJclClrTableKind = + (ttTypeRef, ttModuleRef, ttMethodDef, ttTypeSpec, ttTypeDef); +var + WideIndex: Boolean; +begin + WideIndex := Table.IsWideIndex([ttTypeRef, ttModuleRef, ttMethodDef, ttTypeSpec, ttTypeDef]); + Assert(Table.GetCodedIndexTag(FClassIdx, 3, WideIndex) in [1..5]); + Result := Table.Stream.Tables[ + MapTagToTable[Table.GetCodedIndexTag(FClassIdx, 3, WideIndex)]]. + Rows[Table.GetCodedIndexValue(FClassIdx, 3, WideIndex)-1]; +end; + +function TJclClrTableMemberRefRow.GetFullName: WideString; +var + Row: TJclClrTableRow; +begin + Row := GetParentClass; + + if Row is TJclClrTableTypeRefRow then + Result := TJclClrTableTypeRefRow(Row).FullName + else + if Row is TJclClrTableModuleRow then + Result := TJclClrTableModuleRow(Row).Name + else + if Row is TJclClrTableMethodDefRow then + Result := TJclClrTableMethodDefRow(Row).FullName + else + if Row is TJclClrTableTypeSpecRow then + Result := '' + else + if Row is TJclClrTableTypeDefRow then + Result := TJclClrTableTypeDefRow(Row).FullName; + + Result := Result + '.' + Name; +end; + +function TJclClrTableMemberRef.GetRow(const Idx: Integer): TJclClrTableMemberRefRow; +begin + Result := TJclClrTableMemberRefRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableMemberRef.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableMemberRefRow; +end; + +//=== { TJclClrTableParamDefRow } ============================================ + +constructor TJclClrTableParamDefRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FFlagMask := Table.ReadWord; + FSequence := Table.ReadWord; + FNameOffset := Table.ReadIndex(hkString); + + FMethod := nil; + FFlags := ParamFlags(FFlagMask); +end; + +function TJclClrTableParamDefRow.GetName: WideString; +begin + Result := Table.Stream.Metadata.StringAt(FNameOffset); +end; + +procedure TJclClrTableParamDefRow.SetMethod(const AMethod: TJclClrTableMethodDefRow); +begin + FMethod := AMethod; +end; + +class function TJclClrTableParamDefRow.ParamFlags(const AFlags: TJclClrParamKinds): Word; +var + AFlag: TJclClrParamKind; +begin + Result := 0; + for AFlag := Low(TJclClrParamKind) to High(TJclClrParamKind) do + if AFlag in AFlags then + Result := Result or ClrParamKindMapping[AFlag]; +end; + +class function TJclClrTableParamDefRow.ParamFlags(const AFlags: Word): TJclClrParamKinds; +var + AFlag: TJclClrParamKind; +begin + Result := []; + for AFlag := Low(TJclClrParamKind) to High(TJclClrParamKind) do + if (AFlags and ClrParamKindMapping[AFlag]) = ClrParamKindMapping[AFlag] then + Include(Result, AFlag); +end; + +function TJclClrTableParamDefRow.DumpIL: string; +begin + Result := ''; + { TODO : What to do? } +end; + +function TJclClrTableParamDef.GetRow(const Idx: Integer): TJclClrTableParamDefRow; +begin + Result := TJclClrTableParamDefRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableParamDef.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableParamDefRow; +end; + +//=== { TJclClrTableParamPtrRow } ============================================ + +constructor TJclClrTableParamPtrRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FParamIdx := Table.ReadIndex([ttParamDef]); +end; + +function TJclClrTableParamPtrRow.GetParam: TJclClrTableParamDefRow; +begin + Result := TJclClrTableParamDef(Table.Stream.Tables[ttParamDef]).Rows[FParamIdx-1]; +end; + +function TJclClrTableParamPtr.GetRow(const Idx: Integer): TJclClrTableParamPtrRow; +begin + Result := TJclClrTableParamPtrRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableParamPtr.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableParamPtrRow; +end; + +//=== { TJclClrExceptionHandler } ============================================ + +const + // Indicates the format for the COR_ILMETHOD header + CorILMethod_FormatShift = 2; + CorILMethod_FormatMask = ((1 shl CorILMethod_FormatShift) - 1); + + CorILMethod_TinyFormat = $0002; + // CorILMethod_FatFormat = $0003; + + // CorILMethod_TinyFormatEven = $0002; + // CorILMethod_TinyFormatOdd = $0006; + + // CorILMethod_InitLocals = $0010; + CorILMethod_MoreSects = $0008; + + // CorILMethod_Sect_Reserved = 0; + CorILMethod_Sect_EHTable = 1; + CorILMethod_Sect_OptILTable = 2; + + // CorILMethod_Sect_KindMask = $3F; // The mask for decoding the type code + CorILMethod_Sect_FatFormat = $40; // fat format + CorILMethod_Sect_MoreSects = $80; // there is another attribute after this one + + COR_ILEXCEPTION_CLAUSE_NONE = $0000; // This is a typed handler + // COR_ILEXCEPTION_CLAUSE_OFFSETLEN = $0000; // Deprecated + // COR_ILEXCEPTION_CLAUSE_DEPRECATED = $0000; // Deprecated + COR_ILEXCEPTION_CLAUSE_FILTER = $0001; // If this bit is on, then this EH entry is for a filter + COR_ILEXCEPTION_CLAUSE_FINALLY = $0002; // This clause is a finally clause + COR_ILEXCEPTION_CLAUSE_FAULT = $0004; // Fault clause (finally that is called on exception only) + + ExceptionClauseFlags: array [TJclClrExceptionClauseFlag] of DWORD = + (COR_ILEXCEPTION_CLAUSE_NONE, COR_ILEXCEPTION_CLAUSE_FILTER, + COR_ILEXCEPTION_CLAUSE_FINALLY, COR_ILEXCEPTION_CLAUSE_FAULT); + +constructor TJclClrExceptionHandler.Create(const EHClause: TImageCorILMethodSectEHClauseSmall); +begin + FFlags := EHClause.Flags; + FTryBlock.Offset := EHClause.TryOffset; + FTryBlock.Length := EHClause.TryLength; + FHandlerBlock.Offset := EHClause.HandlerOffset; + FHandlerBlock.Length := EHClause.HandlerLength; + if (FFlags and COR_ILEXCEPTION_CLAUSE_FILTER) = COR_ILEXCEPTION_CLAUSE_FILTER then + begin + FClassToken := 0; + FFilterOffset := EHClause.FilterOffset; + end + else + begin + FClassToken := EHClause.ClassToken; + FFilterOffset := 0; + end; +end; + +constructor TJclClrExceptionHandler.Create(const EHClause: TImageCorILMethodSectEHClauseFat); +begin + FFlags := EHClause.Flags; + FTryBlock.Offset := EHClause.TryOffset; + FTryBlock.Length := EHClause.TryLength; + FHandlerBlock.Offset := EHClause.HandlerOffset; + FHandlerBlock.Length := EHClause.HandlerLength; + if (FFlags and COR_ILEXCEPTION_CLAUSE_FILTER) = COR_ILEXCEPTION_CLAUSE_FILTER then + begin + FClassToken := 0; + FFilterOffset := EHClause.FilterOffset; + end + else + begin + FClassToken := EHClause.ClassToken; + FFilterOffset := 0; + end; +end; + +function TJclClrExceptionHandler.GetFlags: TJclClrExceptionClauseFlags; +var + AFlag: TJclClrExceptionClauseFlag; +begin + Result := []; + for AFlag := Low(TJclClrExceptionClauseFlag) to High(TJclClrExceptionClauseFlag) do + if (FFlags and ExceptionClauseFlags[AFlag]) = ExceptionClauseFlags[AFlag] then + Include(Result, AFlag); +end; + +//=== { TJclClrMethodBody } ================================================== + +constructor TJclClrMethodBody.Create(const AMethod: TJclClrTableMethodDefRow); +var + ILMethod: PImageCorILMethodHeader; +begin + FMethod := AMethod; + FEHTable := TObjectList.Create; + + FLocalVarSign := nil; + + ILMethod := FMethod.Table.Stream.Metadata.Image.RvaToVa(FMethod.RVA); + if (ILMethod.Tiny.Flags_CodeSize and CorILMethod_FormatMask) = CorILMethod_TinyFormat then + begin + FSize := (ILMethod.Tiny.Flags_CodeSize shr CorILMethod_FormatShift) and ((1 shl 6) - 1); + FCode := Pointer(TJclAddr(ILMethod) + 1); + FMaxStack := 0; + FLocalVarSignToken := 0; + end + else + begin + FSize := ILMethod.Fat.CodeSize; + FCode := Pointer(TJclAddr(ILMethod) + (ILMethod.Fat.Flags_Size shr 12) * SizeOf(DWORD)); + FMaxStack := ILMethod.Fat.MaxStack; + FLocalVarSignToken := ILMethod.Fat.LocalVarSigTok; + + if IsBitSet(ILMethod.Fat.Flags_Size, CorILMethod_MoreSects) then + ParseMoreSections(Pointer((TJclAddr(FCode) + FSize + 1) and not 1)); + end; +end; + +destructor TJclClrMethodBody.Destroy; +begin + FreeAndNil(FLocalVarSign); + FreeAndNil(FEHTable); + inherited Destroy; +end; + +procedure TJclClrMethodBody.AddEHTable(EHTable: PImageCorILMethodSectEH); +var + I, Count: Integer; + FatFormat: Boolean; +begin + FatFormat := IsBitSet( EHTable.Small.SectSmall.Kind, CorILMethod_Sect_FatFormat); + if FatFormat then + Count := ((EHTable.Fat.SectFat.Kind_DataSize shr 8) - SizeOf(DWORD)) div SizeOf(TImageCorILMethodSectEHClauseFat) + else + Count := (EHTable.Small.SectSmall.Datasize - SizeOf(DWORD)) div SizeOf(TImageCorILMethodSectEHClauseSmall); + + for I := 0 to Count-1 do + begin + if FatFormat then + FEHTable.Add(TJclClrExceptionHandler.Create(EHTable.Fat.Clauses[I])) + else + FEHTable.Add(TJclClrExceptionHandler.Create(EHTable.Small.Clauses[I])); + end; +end; + +procedure TJclClrMethodBody.AddOptILTable(OptILTable: Pointer; Size: Integer); +begin + { TODO : What to do? } +end; + +procedure TJclClrMethodBody.ParseMoreSections(SectHeader: PImageCorILMethodSectHeader); +var + SectSize: DWORD; +begin + if IsBitSet(SectHeader.Small.Kind, CorILMethod_Sect_FatFormat) then + SectSize := SectHeader.Fat.Kind_DataSize shr 8 + else + SectSize := SectHeader.Small.Datasize; + + if IsBitSet(SectHeader.Small.Kind, CorILMethod_Sect_EHTable) then + AddEHTable(PImageCorILMethodSectEH(SectHeader)) + else + if IsBitSet(SectHeader.Small.Kind, CorILMethod_Sect_OptILTable) then + AddOptILTable(Pointer(TJclAddr(FCode) + FSize), SectSize); + + if IsBitSet(SectHeader.Small.Kind, CorILMethod_Sect_MoreSects) then + ParseMoreSections(Pointer(TJclAddr(SectHeader) + SectSize)); +end; + +function TJclClrMethodBody.GetExceptionHandler(const Idx: Integer): TJclClrExceptionHandler; +begin + Result := TJclClrExceptionHandler(FEHTable.Items[Idx]); +end; + +function TJclClrMethodBody.GetExceptionHandlerCount: Integer; +begin + Result := FEHTable.Count; +end; + +function TJclClrMethodBody.GetLocalVarSign: TJclClrLocalVarSign; +begin + if not Assigned(FLocalVarSign) and (FLocalVarSignToken <> 0) then + FLocalVarSign := TJclClrLocalVarSign.Create(LocalVarSignData); + + Result := FLocalVarSign; +end; + +function TJclClrMethodBody.GetLocalVarSignData: TJclClrBlobRecord; +begin + Result := TJclClrTableStandAloneSigRow(FMethod.Table.Stream.Metadata.Tokens[FLocalVarSignToken]).Signature; +end; + +//=== { TJclClrTableMethodDefRow } =========================================== + +constructor TJclClrTableMethodDefRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + + FRVA := Table.ReadDWord; + FImplFlags := Table.ReadWord; + FFlags := Table.ReadWord; + FNameOffset := Table.ReadIndex(hkString); + FSignatureOffset := Table.ReadIndex(hkBlob); + FParamListIdx := Table.ReadIndex([ttParamDef]); + + FParentToken := nil; + FParams := nil; + FSignature := nil; + + if FRVA <> 0 then + FMethodBody := TJclClrMethodBody.Create(Self) + else + FMethodBody := nil; +end; + +destructor TJclClrTableMethodDefRow.Destroy; +begin + FreeAndNil(FParams); + FreeAndNil(FSignature); + inherited Destroy; +end; + +function TJclClrTableMethodDefRow.GetName: WideString; +begin + Result := Table.Stream.Metadata.StringAt(FNameOffset); +end; + +function TJclClrTableMethodDefRow.GetSignatureData: TJclClrBlobRecord; +begin + Result := Table.Stream.Metadata.BlobAt(FSignatureOffset); +end; + +procedure TJclClrTableMethodDefRow.SetParentToken(const ARow: TJclClrTableTypeDefRow); +begin + FParentToken := ARow; +end; + +procedure TJclClrTableMethodDefRow.UpdateParams; +var + ParamTable: TJclClrTableParamDef; + Idx, MaxParamListIdx: DWORD; +begin + with Table as TJclClrTableMethodDef do + if not Assigned(FParams) and (ParamListIdx <> 0) and + Stream.FindTable(ttParamDef, TJclClrTable(ParamTable)) then + begin + if RowCount > (Index+1) then + MaxParamListIdx := Rows[Index+1].ParamListIdx-1 + else + MaxParamListIdx := ParamTable.RowCount; + if (ParamListIdx-1) < MaxParamListIdx then + begin + FParams := TList.Create; + for Idx := ParamListIdx-1 to MaxParamListIdx-1 do + begin + FParams.Add(ParamTable.Rows[Idx]); + ParamTable.Rows[Idx].SetMethod(Self); + end; + end; + end; +end; + +procedure TJclClrTableMethodDefRow.Update; +begin + UpdateParams; +end; + +function TJclClrTableMethodDefRow.GetHasParam: Boolean; +begin + Result := Assigned(FParams); +end; + +function TJclClrTableMethodDefRow.GetParam(const Idx: Integer): TJclClrTableParamDefRow; +begin + Result := TJclClrTableParamDefRow(FParams.Items[Idx]); +end; + +function TJclClrTableMethodDefRow.GetParamCount: Integer; +begin + Result := FParams.Count; +end; + +function TJclClrTableMethodDefRow.DumpIL: string; +const + MemberAccessNames: array [TJclClrMemberAccess] of PChar = + ('compilercontrolled', 'private', 'famandassem', + 'assembly', 'family', 'famorassem', 'public'); + CodeTypeNames: array [TJclClrMethodCodeType] of PChar = + ('cil', 'native', 'optil', 'runtime'); + ManagedNames: array [Boolean] of PChar = + ('unmanaged', 'managed'); +var + I: Integer; + + function LocalVarToString(LocalVar: TJclClrLocalVar): string; + var + Row: TJclClrTableRow; + begin + case LocalVar.ElementType of + etClass: + if LocalVar.Token <> 0 then + begin + Row := Table.Stream.Metadata.Tokens[LocalVar.Token]; + if Row is TJclClrTableTypeDefRow then + Result := TJclClrTableTypeDefRow(Row).FullName + else + if Row is TJclClrTableTypeRefRow then + Result := TJclClrTableTypeRefRow(Row).FullName + else + if Row is TJclClrTableTypeSpecRow then + Result := TJclClrTableTypeSpecRow(Row).Signature.Dump('') + else + Result := '/*' + IntToHex(Row.Token, 8) + '*/'; + end; + else + Result := LocalVar.Name; + end; + end; + + function GetMethodFlagDescription: string; + const + MethodFlagName: array [TJclClrMethodFlag] of PChar = + ('static', 'final', 'virtual', 'hidebysig', '', 'abstract', + 'specialname', 'pinvokeimpl', 'unmanagedexp', 'rtspecialname', '', ''); + var + AFlag: TJclClrMethodFlag; + begin + Result := ''; + for AFlag := Low(TJclClrMethodFlag) to High(TJclClrMethodFlag) do + if AFlag in MethodFlags then + Result := Result + MethodFlagName[AFlag] + ' '; + end; + + function GetMethodImplFlagDescription: string; + const + MethodImplFlagName: array [TJclClrMethodImplFlag] of PChar = + ('forwardref', '', 'internalcall', 'synchronized', 'noinlining'); + var + AFlag: TJclClrMethodImplFlag; + begin + Result := ''; + for AFlag := Low(TJclClrMethodImplFlag) to High(TJclClrMethodImplFlag) do + if AFlag in MethodImplFlags then + Result := Result + ' ' + MethodImplFlagName[AFlag]; + end; + + function GetParamTypeName(Param: TJclClrMethodParam): string; + const + BuildInTypeNames: array [etVoid..etString] of PChar = + ('void', 'bool', 'char', 'sbyte', 'byte', 'short', 'ushort', + 'int', 'uint', 'long', 'ulong', 'float', 'double', 'string'); + var + Row: TJclClrTableRow; + begin + case Param.ElementType of + etVoid, etBoolean, etChar, + etI1, etU1, etI2, etU2, etI4, etU4, + etI8, etU8, etR4, etR8, etString: + Result := BuildInTypeNames[Param.ElementType]; + etI: + Result := 'System.IntPtr'; + etU: + Result := 'System.UIntPtr'; + etObject: + Result := 'object'; + etClass: + begin + Row := Table.Stream.Metadata.Tokens[Param.Token]; + if Row is TJclClrTableTypeDefRow then + Result := TJclClrTableTypeDefRow(Row).FullName + else + if Row is TJclClrTableTypeRefRow then + Result := TJclClrTableTypeRefRow(Row).FullName; + + Result := Result + ' /* ' + IntToHex(Param.Token, 8) + ' */'; + end; + etSzArray: + Result := 'char *'; + end; + if Param.ByRef then + Result := 'ref ' + Result; + end; + +begin + Result := Format('.method /*%.8x*/ %s %s%s %s(', [Token, + MemberAccessNames[MemberAccess], GetMethodFlagDescription, + GetParamTypeName(Signature.RetType), Name]); + if HasParam then + for I := 0 to Min(ParamCount, Signature.ParamCount)-1 do + begin + Result := Result + GetParamTypeName(Signature.Params[I]) + ' ' + Params[I].Name; + if I <> ParamCount-1 then + Result := Result + ', '; + end; + Result := Result + ') ' + CodeTypeNames[CodeType] + ' ' + ManagedNames[Managed] + GetMethodImplFlagDescription; + + if Assigned(MethodBody) then + begin + Result := Result + NativeLineBreak + '{' + NativeLineBreak + + '.maxstack ' + IntToStr(MethodBody.MaxStack) + NativeLineBreak; + + if MethodBody.LocalVarSignToken <> 0 then + begin + Result := Result + '.locals /* ' + IntToHex(MethodBody.LocalVarSignToken, 8) + ' */ init(' + NativeLineBreak; + for I := 0 to MethodBody.LocalVarSign.LocalVarCount-1 do + begin + Result := Format(Result+' %s V_%d', [LocalVarToString(MethodBody.LocalVarSign.LocalVars[I]), I]); + if I = MethodBody.LocalVarSign.LocalVarCount-1 then + Result := Result + ')' + NativeLineBreak + else + Result := Result + ',' + NativeLineBreak; + end; + end; + + with TJclClrILGenerator.Create(MethodBody) do + try + Result := Result + NativeLineBreak + DumpIL(InstructionDumpILAllOption); + finally + Free; + end; + Result := Result + '}'; + end; +end; + +function TJclClrTableMethodDefRow.GetFullName: WideString; +begin + Result := ParentToken.FullName + '.' + Name; +end; + +function TJclClrTableMethodDefRow.GetSignature: TJclClrMethodSign; +begin + if not Assigned(FSignature) then + FSignature := TJclClrMethodSign.Create(SignatureData); + Result := FSignature; +end; + +function TJclClrTableMethodDefRow.GetMemberAccess: TJclClrMemberAccess; +begin + Result := TJclClrMemberAccess(FFlags and mdMemberAccessMask) +end; + +function TJclClrTableMethodDefRow.GetMethodFlags: TJclClrMethodFlags; +var + AFlag: TJclClrMethodFlag; +begin + Result := []; + for AFlag := Low(TJclClrMethodFlag) to High(TJclClrMethodFlag) do + if (FFlags and ClrMethodFlagMapping[AFlag]) = ClrMethodFlagMapping[AFlag] then + Include(Result, AFlag); +end; + +function TJclClrTableMethodDefRow.GetNewSlot: Boolean; +begin + Result := (FFlags and mdVtableLayoutMask) = mdNewSlot; +end; + +function TJclClrTableMethodDefRow.GetCodeType: TJclClrMethodCodeType; +begin + Result := TJclClrMethodCodeType(FImplFlags and miCodeTypeMask); +end; + +function TJclClrTableMethodDefRow.GetManaged: Boolean; +begin + Result := (FImplFlags and miManagedMask) = miManaged; +end; + +function TJclClrTableMethodDefRow.GetMethodImplFlags: TJclClrMethodImplFlags; +var + AFlag: TJclClrMethodImplFlag; +begin + Result := []; + for AFlag := Low(TJclClrMethodImplFlag) to High(TJclClrMethodImplFlag) do + if (FFlags and ClrMethodImplFlagMapping[AFlag]) = ClrMethodImplFlagMapping[AFlag] then + Include(Result, AFlag); +end; + +function TJclClrTableMethodDef.GetRow(const Idx: Integer): TJclClrTableMethodDefRow; +begin + Result := TJclClrTableMethodDefRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableMethodDef.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableMethodDefRow; +end; + +//=== { TJclClrTableMethodPtrRow } =========================================== + +constructor TJclClrTableMethodPtrRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FMethodIdx := Table.ReadIndex([ttMethodDef]); +end; + +function TJclClrTableMethodPtrRow.GetMethod: TJclClrTableMethodDefRow; +begin + Result := TJclClrTableMethodDef(Table.Stream.Tables[ttMethodDef]).Rows[FMethodIdx-1]; +end; + +function TJclClrTableMethodPtr.GetRow(const Idx: Integer): TJclClrTableMethodPtrRow; +begin + Result := TJclClrTableMethodPtrRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableMethodPtr.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableMethodPtrRow; +end; + +//=== { TJclClrTableMethodImplRow } ========================================== + +constructor TJclClrTableMethodImplRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FClassIdx := Table.ReadIndex([ttTypeDef]); + FMethodBodyIdx := Table.ReadIndex([ttMethodDef, ttMemberRef]); + FMethodDeclarationIdx := Table.ReadIndex([ttMethodDef, ttMemberRef]); +end; + +function TJclClrTableMethodImpl.GetRow( + const Idx: Integer): TJclClrTableMethodImplRow; +begin + Result := TJclClrTableMethodImplRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableMethodImpl.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableMethodImplRow; +end; + +//=== { TJclClrTableMethodSemanticsRow } ===================================== + +constructor TJclClrTableMethodSemanticsRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FSemantics := Table.ReadWord; + FMethodIdx := Table.ReadIndex([ttMethodDef]); + FAssociationIdx := Table.ReadIndex([ttEventDef, ttPropertyDef]); +end; + +function TJclClrTableMethodSemantics.GetRow(const Idx: Integer): TJclClrTableMethodSemanticsRow; +begin + Result := TJclClrTableMethodSemanticsRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableMethodSemantics.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableMethodSemanticsRow; +end; + +//=== { TJclClrTableMethodSpecRow } ========================================== + +constructor TJclClrTableMethodSpecRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FMethodIdx := Table.ReadIndex([ttMethodDef, ttMemberRef]); + FInstantiationOffset := Table.ReadIndex(hkBlob); +end; + +function TJclClrTableMethodSpecRow.GetMethod: TJclClrTableRow; +const + MethodDefOrRefEncodedTag: array [0..1] of TJclClrTableKind = + (ttMethodDef, ttMemberRef); +begin + Result := Table.Stream.Metadata.Tables[MethodDefOrRefEncodedTag[FMethodIdx and 1]].Rows[FMethodIdx shr 1]; +end; + +function TJclClrTableMethodSpecRow.GetInstantiation: TJclClrBlobRecord; +begin + Result := Table.Stream.Metadata.BlobAt(FInstantiationOffset); +end; + +function TJclClrTableMethodSpec.GetRow(const Idx: Integer): TJclClrTableMethodSpecRow; +begin + Result := TJclClrTableMethodSpecRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableMethodSpec.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableMethodSpecRow; +end; + +//=== { TJclClrTableNestedClassRow } ========================================= + +constructor TJclClrTableNestedClassRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FNestedClassIdx := Table.ReadIndex([ttTypeDef]); + FEnclosingClassIdx := Table.ReadIndex([ttTypeDef]); +end; + +function TJclClrTableNestedClass.GetRow(const Idx: Integer): TJclClrTableNestedClassRow; +begin + Result := TJclClrTableNestedClassRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableNestedClass.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableNestedClassRow; +end; + +//=== { TJclClrTablePropertyDefRow } ========================================= + +constructor TJclClrTablePropertyDefRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FFlags := Table.ReadWord; + FNameOffset := Table.ReadIndex(hkString); + FKindIdx := Table.ReadIndex(hkBlob); +end; + +function TJclClrTablePropertyDefRow.DumpIL: string; + + function DumpFlags: string; + const + SpecialName: array [Boolean] of string = ('', 'specialname '); + RTSpecialName: array [Boolean] of string = ('', 'rtspecialname '); + begin + Result := SpecialName[pfSpecialName in Flags] + + RTSpecialName[pfRTSpecialName in Flags]; + end; + +begin + Result := Format('.property /*%.8x*/ %s%s ()', [Token, DumpFlags, Name]); +end; + +function TJclClrTablePropertyDefRow.GetFlags: TJclClrTablePropertyFlags; +var + AFlag: TJclClrTablePropertyFlag; +begin + Result := []; + for AFlag := Low(TJclClrTablePropertyFlag) to High(TJclClrTablePropertyFlag) do + if ClrTablePropertyFlagMapping[AFlag] and FFlags <> 0 then + Include(Result, AFlag); +end; + +function TJclClrTablePropertyDefRow.GetName: WideString; +begin + Result := Table.Stream.Metadata.StringAt(FNameOffset); +end; + +function TJclClrTablePropertyDef.GetRow(const Idx: Integer): TJclClrTablePropertyDefRow; +begin + Result := TJclClrTablePropertyDefRow(inherited GetRow(Idx)); +end; + +class function TJclClrTablePropertyDef.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTablePropertyDefRow; +end; + +//=== { TJclClrTablePropertyPtrRow } ========================================= + +constructor TJclClrTablePropertyPtrRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FPropertyIdx := Table.ReadIndex([ttPropertyDef]); +end; + +function TJclClrTablePropertyPtrRow.GetProperty: TJclClrTablePropertyDefRow; +begin + Result := TJclClrTablePropertyDef(Table.Stream.Tables[ttPropertyDef]).Rows[FPropertyIdx-1]; +end; + +function TJclClrTablePropertyPtr.GetRow(const Idx: Integer): TJclClrTablePropertyPtrRow; +begin + Result := TJclClrTablePropertyPtrRow(inherited GetRow(Idx)); +end; + +class function TJclClrTablePropertyPtr.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTablePropertyPtrRow; +end; + +//=== { TJclClrTablePropertyMapRow } ========================================= + +constructor TJclClrTablePropertyMapRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FParentIdx := Table.ReadIndex([ttTypeDef]); + FPropertyListIdx := Table.ReadIndex([ttPropertyDef]); + FProperties := TList.Create; +end; + +destructor TJclClrTablePropertyMapRow.Destroy; +begin + FreeAndNil(FProperties); + inherited Destroy; +end; + +function TJclClrTablePropertyMapRow.GetParent: TJclClrTableTypeDefRow; +begin + Result := TJclClrTableTypeDef(Table.Stream.Tables[ttTypeDef]).Rows[FParentIdx-1]; +end; + +function TJclClrTablePropertyMapRow.Add(const ARow: TJclClrTablePropertyDefRow): Integer; +begin + Result := FProperties.Add(ARow); +end; + +function TJclClrTablePropertyMapRow.GetProperty(const Idx: Integer): TJclClrTablePropertyDefRow; +begin + Result := TJclClrTablePropertyDefRow(FProperties.Items[Idx]); +end; + +function TJclClrTablePropertyMapRow.GetPropertyCount: Integer; +begin + Result := FProperties.Count; +end; + +function TJclClrTablePropertyMap.GetRow(const Idx: Integer): TJclClrTablePropertyMapRow; +begin + Result := TJclClrTablePropertyMapRow(inherited GetRow(Idx)); +end; + +class function TJclClrTablePropertyMap.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTablePropertyMapRow; +end; + +procedure TJclClrTablePropertyMap.Update; +var + I, J: Integer; +begin + J := 0; + with TJclClrTablePropertyDef(Stream.Tables[ttPropertyDef]) do + for I := 0 to RowCount-1 do + begin + if I >= Integer(Self.Rows[J].PropertyListIdx) then + Inc(J); + if J >= Self.RowCount then + Break; + Self.Rows[J].Add(Rows[I]); + end; +end; + +//=== { TJclClrTableStandAloneSigRow } ======================================= + +constructor TJclClrTableStandAloneSigRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FSignatureOffset := Table.ReadIndex(hkBlob); +end; + +function TJclClrTableStandAloneSigRow.GetSignature: TJclClrBlobRecord; +begin + Result := Table.Stream.Metadata.BlobAt(FSignatureOffset); +end; + +function TJclClrTableStandAloneSig.GetRow( + const Idx: Integer): TJclClrTableStandAloneSigRow; +begin + Result := TJclClrTableStandAloneSigRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableStandAloneSig.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableStandAloneSigRow; +end; + +//=== { TJclClrTableTypeDefRow } ============================================= + +constructor TJclClrTableTypeDefRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FFlags := Table.ReadDWord; + FNameOffset := Table.ReadIndex(hkString); + FNamespaceOffset := Table.ReadIndex(hkString); + FExtendsIdx := Table.ReadIndex([ttTypeDef, ttTypeRef, ttTypeSpec]); + FFieldListIdx := Table.ReadIndex([ttFieldDef]); + FMethodListIdx := Table.ReadIndex([ttMethodDef]); + + FFields := nil; + FMethods := nil; +end; + +destructor TJclClrTableTypeDefRow.Destroy; +begin + FreeAndNil(FFields); + FreeAndNil(FMethods); + inherited Destroy; +end; + +function TJclClrTableTypeDefRow.GetName: WideString; +begin + Result := Table.Stream.Metadata.StringAt(FNameOffset); +end; + +function TJclClrTableTypeDefRow.GetNamespace: WideString; +begin + Result := Table.Stream.Metadata.StringAt(FNamespaceOffset); +end; + +function TJclClrTableTypeDefRow.GetField(const Idx: Integer): TJclClrTableFieldDefRow; +begin + Result := TJclClrTableFieldDefRow(FFields.Items[Idx]) +end; + +function TJclClrTableTypeDefRow.GetFieldCount: Integer; +begin + Result := FFields.Count +end; + +function TJclClrTableTypeDefRow.HasField: Boolean; +begin + Result := Assigned(FFields); +end; + +function TJclClrTableTypeDefRow.GetMethod(const Idx: Integer): TJclClrTableMethodDefRow; +begin + Result := TJclClrTableMethodDefRow(FMethods.Items[Idx]) +end; + +function TJclClrTableTypeDefRow.GetMethodCount: Integer; +begin + Result := FMethods.Count +end; + +function TJclClrTableTypeDefRow.HasMethod: Boolean; +begin + Result := Assigned(FMethods); +end; + +procedure TJclClrTableTypeDefRow.UpdateFields; +var + FieldTable: TJclClrTableFieldDef; + Idx, MaxFieldListIdx: DWORD; +begin + with Table as TJclClrTableTypeDef do + if not Assigned(FFields) and (FieldListIdx <> 0) and + Stream.FindTable(ttFieldDef, TJclClrTable(FieldTable)) then + begin + if RowCount > (Index+1) then + MaxFieldListIdx := Rows[Index+1].FieldListIdx-1 + else + MaxFieldListIdx := FieldTable.RowCount; + if (FieldListIdx-1) < MaxFieldListIdx then + begin + FFields := TList.Create; + for Idx := FieldListIdx-1 to MaxFieldListIdx-1 do + begin + FFields.Add(FieldTable.Rows[Idx]); + FieldTable.Rows[Idx].SetParentToken(Self); + end; + end; + end; +end; + +procedure TJclClrTableTypeDefRow.UpdateMethods; +var + MethodTable: TJclClrTableMethodDef; + Idx, MaxMethodListIdx: DWORD; +begin + with Table as TJclClrTableTypeDef do + if not Assigned(FMethods) and (MethodListIdx <> 0) and + Stream.FindTable(ttMethodDef, TJclClrTable(MethodTable)) then + begin + if RowCount > (Index+1) then + MaxMethodListIdx := Rows[Index+1].MethodListIdx-1 + else + MaxMethodListIdx := MethodTable.RowCount; + if (MethodListIdx-1) < MaxMethodListIdx then + begin + FMethods := TList.Create; + for Idx := MethodListIdx-1 to MaxMethodListIdx-1 do + begin + FMethods.Add(MethodTable.Rows[Idx]); + MethodTable.Rows[Idx].SetParentToken(Self); + end; + end; + end; +end; + +procedure TJclClrTableTypeDefRow.Update; +begin + inherited Update; + UpdateFields; + UpdateMethods; +end; + +function TJclClrTableTypeDefRow.GetFullName: WideString; +begin + if FNamespaceOffset <> 0 then + Result := Namespace + '.' + Name + else + Result := Name; +end; + +function TJclClrTableTypeDefRow.GetAttributes: TJclClrTypeAttributes; +const + TypeAttributesMapping: array [TJclClrTypeAttribute] of DWORD = + (tdAbstract, tdSealed, tdSpecialName, tdImport, + tdSerializable, tdBeforeFieldInit, tdRTSpecialName, tdHasSecurity); +var + Attr: TJclClrTypeAttribute; +begin + Result := []; + for Attr := Low(TJclClrTypeAttribute) to High(TJclClrTypeAttribute) do + if (FFlags and TypeAttributesMapping[Attr]) = TypeAttributesMapping[Attr] then + Include(Result, Attr); +end; + +function TJclClrTableTypeDefRow.GetClassLayout: TJclClrClassLayout; +begin + case FFlags and tdLayoutMask of + tdAutoLayout: + Result := clAuto; + tdSequentialLayout: + Result := clSequential; + tdExplicitLayout: + Result := clExplicit; + else + raise EJclMetadataError.CreateResFmt(@RsUnknownClassLayout, [FFlags and tdLayoutMask]); + end; +end; + +function TJclClrTableTypeDefRow.GetClassSemantics: TJclClrClassSemantics; +const + ClassSemanticsMapping: array [Boolean] of TJclClrClassSemantics = + (csClass, csInterface); +begin + Result := ClassSemanticsMapping[(FFlags and tdClassSemanticsMask) = tdInterface]; +end; + +function TJclClrTableTypeDefRow.GetStringFormatting: TJclClrStringFormatting; +begin + case FFlags and tdStringFormatMask of + tdAnsiClass: + Result := sfAnsi; + tdUnicodeClass: + Result := sfUnicode; + tdAutoClass: + Result := sfAutoChar; + else + raise EJclMetadataError.CreateResFmt(@RsUnknownStringFormatting, [FFlags and tdStringFormatMask]); + end; +end; + +function TJclClrTableTypeDefRow.GetVisibility: TJclClrTypeVisibility; +begin + Result := TJclClrTypeVisibility(FFlags and tdVisibilityMask); +end; + +function TJclClrTableTypeDefRow.GetExtends: TJclClrTableRow; +begin + Result := DecodeTypeDefOrRef(FExtendsIdx); +end; + +function TJclClrTableTypeDefRow.DumpIL: string; +const + ClassSemanticName: array [TJclClrClassSemantics] of PChar = + ('class', 'interface'); + VisibilityName: array [TJclClrTypeVisibility] of PChar = + ('private', 'public', 'nested public', 'nested private', + 'nested family', 'nested assembly', 'nested famandassem', 'nested famorassem'); + ClassLayoutName: array [TJclClrClassLayout] of PChar = + ('auto', 'explicit', 'sequential'); + StringFormattingName: array [TJclClrStringFormatting] of PChar = + ('ansi', 'unicode', 'autoChar'); + TypeAttributeName: array [TJclClrTypeAttribute] of PChar = + ('abstract', 'sealed', 'specialname', '' {'import'}, + 'serializable', 'beforefieldinit', 'rtspecialname', '' {'hassecurity'}); + Indent = ' '; + IntfPrefix: array [Boolean] of PChar = (' ', 'implements '); +var + I, J: Integer; + ListIntfs: TList; + + function GetTypeAttributesName: string; + var + Attr: TJclClrTypeAttribute; + begin + Result := ''; + for Attr := Low(TJclClrTypeAttribute) to High(TJclClrTypeAttribute) do + if Attr in Attributes then + Result := Result + TypeAttributeName[Attr] + ' '; + end; + + function GetExtends(const Row: TJclClrTableTypeDefRow): string; overload; + begin + Result := Format('%s.%s/* %.8x */', [Row.Namespace, Row.Name, Row.Token]); + end; + + function GetExtends(const Row: TJclClrTableRow): string; overload; + begin + if Row is TJclClrTableTypeDefRow then + Result := GetExtends(TJclClrTableTypeDefRow(Row)) + else + if Row is TJclClrTableTypeRefRow then + Result := TJclClrTableTypeRefRow(Row).DumpIL + else + if Row is TJclClrTableTypeSpecRow then + Result := TJclClrTableTypeSpecRow(Row).DumpIL + else + Result := 'Unknown Extends ' + Row.ClassName; + end; + +begin + with TStringList.Create do + try + Add(Format('.%s /*%.8x*/ %s %s %s %s%s.%s', + [ClassSemanticName[ClassSemantics], Token, + VisibilityName[Visibility], ClassLayoutName[ClassLayout], + StringFormattingName[StringFormatting], GetTypeAttributesName, + Namespace, Name])); + + if ExtendsIdx <> 0 then + Add(Indent + 'extends ' + GetExtends(Extends)); + + ListIntfs := TList.Create; + try + if Assigned(Table.Stream.Tables[ttInterfaceImpl]) then + with TJclClrTableInterfaceImpl(Table.Stream.Tables[ttInterfaceImpl]) do + for I := 0 to RowCount-1 do + if Rows[I].ClassIdx = DWORD(Index + 1) then + ListIntfs.Add(Rows[I]); + + if ListIntfs.Count > 0 then + for I := 0 to ListIntfs.Count-1 do + Add(Indent + IntfPrefix[I = 0] + TJclClrTableInterfaceImplRow(ListIntfs[I]).DumpIL); + finally + ListIntfs.Free; + end; + + Add('('); + + if HasField then + for I := 0 to FieldCount-1 do + Add(Indent + Fields[I].DumpIL); + + if HasMethod then + for I := 0 to MethodCount-1 do + Add(Indent + Methods[I].DumpIL); + + if Assigned(Table.Stream.Tables[ttPropertyMap]) then + with TJclClrTablePropertyMap(Table.Stream.Tables[ttPropertyMap]) do + for I := 0 to RowCount-1 do + if Rows[I].Parent = Self then + for J := 0 to Rows[I].PropertyCount-1 do + Add(Indent + Rows[I].Properties[J].DumpIL); + + Add(') // end of class ' + Name); + Result := Text; + finally + Free; + end; +end; + +class function TJclClrTableTypeDef.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableTypeDefRow; +end; + +function TJclClrTableTypeDef.GetRow(const Idx: Integer): TJclClrTableTypeDefRow; +begin + Result := TJclClrTableTypeDefRow(inherited GetRow(Idx)); +end; + +//=== { TJclClrTableTypeRefRow } ============================================= + +constructor TJclClrTableTypeRefRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FResolutionScopeIdx := Table.ReadIndex([ttModule, ttModuleRef, ttAssemblyRef, ttTypeRef]); + FNameOffset := Table.ReadIndex(hkString); + FNamespaceOffset := Table.ReadIndex(hkString); +end; + +function TJclClrTableTypeRefRow.DumpIL: string; +begin + Result := Format('[%s/* %.8x */]%s.%s/* %.8x */', + [ResolutionScopeName, ResolutionScope.Token, Namespace, Name, Token]); +end; + +function TJclClrTableTypeRefRow.GetFullName: WideString; +begin + Result := Namespace + '.' + Name; +end; + +function TJclClrTableTypeRefRow.GetName: WideString; +begin + Result := Table.Stream.Metadata.StringAt(FNameOffset); +end; + +function TJclClrTableTypeRefRow.GetNamespace: WideString; +begin + Result := Table.Stream.Metadata.StringAt(FNamespaceOffset); +end; + +function TJclClrTableTypeRefRow.GetResolutionScope: TJclClrTableRow; +begin + Result := DecodeResolutionScope(FResolutionScopeIdx); +end; + +function TJclClrTableTypeRefRow.GetResolutionScopeName: string; +begin + if ResolutionScope is TJclClrTableModuleRow then + Result := TJclClrTableModuleRow(ResolutionScope).Name + else + if ResolutionScope is TJclClrTableModuleRefRow then + Result := TJclClrTableModuleRefRow(ResolutionScope).Name + else + if ResolutionScope is TJclClrTableAssemblyRefRow then + Result := TJclClrTableAssemblyRefRow(ResolutionScope).Name + else + if ResolutionScope is TJclClrTableTypeRefRow then + Result := TJclClrTableTypeRefRow(ResolutionScope).Namespace + '.' + + TJclClrTableTypeRefRow(ResolutionScope).Name + else + Result := 'Unknown'; +end; + +class function TJclClrTableTypeRef.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableTypeRefRow; +end; + +function TJclClrTableTypeRef.GetRow(const Idx: Integer): TJclClrTableTypeRefRow; +begin + Result := TJclClrTableTypeRefRow(inherited GetRow(Idx)); +end; + +//=== { TJclClrTableTypeSpecRow } ============================================ + +constructor TJclClrTableTypeSpecRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FSignatureOffset := Table.ReadIndex(hkBlob); +end; + +function TJclClrTableTypeSpecRow.GetSignature: TJclClrBlobRecord; +begin + Result := Table.Stream.Metadata.BlobAt(FSignatureOffset); +end; + +function TJclClrTableTypeSpec.GetRow(const Idx: Integer): TJclClrTableTypeSpecRow; +begin + Result := TJclClrTableTypeSpecRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableTypeSpec.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableTypeSpecRow; +end; + +//=== { TJclClrTableENCMapRow } ============================================== + +constructor TJclClrTableENCMapRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FToken := Table.ReadDWord; +end; + +function TJclClrTableENCMap.GetRow(const Idx: Integer): TJclClrTableENCMapRow; +begin + Result := TJclClrTableENCMapRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableENCMap.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableENCMapRow; +end; + +//=== { TJclClrTableENCLogRow } ============================================== + +constructor TJclClrTableENCLogRow.Create(const ATable: TJclClrTable); +begin + inherited Create(ATable); + FFuncCode := Table.ReadDWord; +end; + +function TJclClrTableENCLog.GetRow(const Idx: Integer): TJclClrTableENCLogRow; +begin + Result := TJclClrTableENCLogRow(inherited GetRow(Idx)); +end; + +class function TJclClrTableENCLog.TableRowClass: TJclClrTableRowClass; +begin + Result := TJclClrTableENCLogRow; +end; + +function TJclClrLocalVar.GetName: WideString; +const + ClrElementTypeNameMapping: array [etVoid..etString] of PChar = + ('void', 'bool', + 'char', 'sbyte', 'byte', + 'short', 'ushort', 'int', 'unit', + 'long', 'ulong', 'float', 'Double', + 'string'); +begin + case ElementType of + etVoid, etBoolean, etChar, + etI1, etU1, etI2, etU2, etI4, etU4, + etI8, etU8, etR4, etR8, etString: + Result := ClrElementTypeNameMapping[ElementType]; + etPtr, etByRef, etValueType, etClass: + Result := IntToHex(Token, 8); + etArray: + Result := 'Array'; + etTypedByRef: + Result := 'TypedByRef'; + etI: + Result := 'IntPtr'; + etU: + Result := 'UIntPtr'; + etFnPtr: + Result := 'Function'; + etObject: + Result := 'System.Object'; + etSzArray: + // (rom) possible BUG! Result not assigned + else + Result := 'Unknown'; + end; +end; + +//=== { TJclClrLocalVarSign } ================================================ + +constructor TJclClrLocalVarSign.Create(const ABlob: TJclClrBlobRecord); +var + Sign, ElemType: Byte; + T: TJclClrElementType; + I, VarCount: DWORD; + LocalVar: TJclClrLocalVar; +begin + inherited Create(ABlob); + + Blob.Seek(0, soFromBeginning); + + Sign := ReadByte; + + if (Sign and IMAGE_CEE_CS_CALLCONV_MASK) <> IMAGE_CEE_CS_CALLCONV_LOCAL_SIG then + raise EJclMetadataError.CreateResFmt(@RsNoLocalVarSig, [IntToHex(Sign, 2)]); + + VarCount := ReadValue; + if (VarCount < 1) or ($FFFE < VarCount) then + raise EJclMetadataError.CreateResFmt(@RsLocalVarSigOutOfRange, [VarCount]); + + FLocalVars := TObjectList.Create; + + LocalVar := TJclClrLocalVar.Create; + + for I := 0 to VarCount-1 do + begin + ElemType := ReadByte; + + case ElemType of + ELEMENT_TYPE_PINNED: + LocalVar.Flags := LocalVar.Flags + [lvfPinned]; + ELEMENT_TYPE_BYREF: + LocalVar.Flags := LocalVar.Flags + [lvfByRef]; + ELEMENT_TYPE_END: + Break; + else + for T := Low(TJclClrElementType) to High(TJclClrElementType) do + if ClrElementTypeMapping[T] = ElemType then + begin + LocalVar.ElementType := T; + Break; + end; + if LocalVar.ElementType in [etPtr, etByRef, etValueType, etClass] then + LocalVar.Token := ReadToken + else + LocalVar.Token := 0; + + FLocalVars.Add(LocalVar); + LocalVar := TJclClrLocalVar.Create; + end; + end; + FreeAndNil(LocalVar); +end; + +destructor TJclClrLocalVarSign.Destroy; +begin + FreeAndNil(FLocalVars); + inherited Destroy; +end; + +function TJclClrLocalVarSign.GetLocalVar(const Idx: Integer): TJclClrLocalVar; +begin + Result := TJclClrLocalVar(FLocalVars[Idx]); +end; + +function TJclClrLocalVarSign.GetLocalVarCount: Integer; +begin + Result := FLocalVars.Count; +end; + +//=== { TJclClrMethodSign } ================================================== + +constructor TJclClrMethodSign.Create(const ABlob: TJclClrBlobRecord); +var + Sign: Byte; + I, ParamCount: Integer; +begin + inherited Create(ABlob); + + FParams := TObjectList.Create; + + Sign := ReadByte; + + if IsBitSet(Sign, IMAGE_CEE_CS_CALLCONV_HASTHIS) then + Include(FFlags, mfHasThis); + + if IsBitSet(Sign, IMAGE_CEE_CS_CALLCONV_EXPLICITTHIS) then + Include(FFlags, mfExplicitThis); + + case Sign and IMAGE_CEE_CS_CALLCONV_MASK of + IMAGE_CEE_CS_CALLCONV_DEFAULT: + Include(FFlags, mfDefault); + IMAGE_CEE_CS_CALLCONV_VARARG: + Include(FFlags, mfVarArg); + end; + + ParamCount := ReadValue; + + FRetType := TJclClrMethodRetType.Create(Blob); + + for I := 0 to ParamCount-1 do + FParams.Add(TJclClrMethodParam.Create(Blob)); +end; + +destructor TJclClrMethodSign.Destroy; +begin + FreeAndNil(FParams); + inherited Destroy; +end; + +function TJclClrMethodSign.GetParam(const Idx: Integer): TJclClrMethodParam; +begin + Result := TJclClrMethodParam(FParams.Items[Idx]); +end; + +function TJclClrMethodSign.GetParamCount: Integer; +begin + Result := FParams.Count; +end; + +//=== { TJclClrCustomModifierSign } ========================================== + +constructor TJclClrCustomModifierSign.Create(const ABlob: TJclClrBlobRecord); +begin + inherited Create(ABlob); + FRequired := ReadByte = ELEMENT_TYPE_CMOD_REQD; + FToken := ReadToken; +end; + +//=== { TJclClrMethodParam } ================================================= + +constructor TJclClrMethodParam.Create(const ABlob: TJclClrBlobRecord); +var + By: Byte; + Finished: Boolean; +begin + inherited Create(ABlob); + + FCustomMods := TObjectList.Create; + FByRef := False; + FElementType := etEnd; + FToken := 0; + FMethodSign := nil; + + Finished := False; + while not Finished and (Blob.Position < Blob.Size) do + begin + By := ReadByte; + case By of + ELEMENT_TYPE_CMOD_REQD, ELEMENT_TYPE_CMOD_OPT: + begin + Blob.Seek(-SizeOf(Byte), soFromCurrent); + FCustomMods.Add(TJclClrCustomModifierSign.Create(Blob)); + end; + ELEMENT_TYPE_BYREF: + FByRef := True; + else + FElementType := TJclClrElementType(By); + case FElementType of + etPtr, etTypedByRef, etValueType, etClass: + FToken := ReadToken; + etFnPtr: + FMethodSign := TJclClrMethodSign.Create(Blob); + etArray: + FArraySign := TJclClrArraySign.Create(Blob); + end; + Finished := True; + end; + end; +end; + +destructor TJclClrMethodParam.Destroy; +begin + FreeAndNil(FCustomMods); + FreeAndNil(FMethodSign); + inherited Destroy; +end; + +function TJclClrMethodParam.GetCustomModifier(const Idx: Integer): TJclClrCustomModifierSign; +begin + Result := TJclClrCustomModifierSign(FCustomMods.Items[Idx]); +end; + +function TJclClrMethodParam.GetCustomModifierCount: Integer; +begin + Result := FCustomMods.Count; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/JclMiscel.pas b/3rdParty/JCL/source/windows/JclMiscel.pas new file mode 100644 index 00000000..90929f56 --- /dev/null +++ b/3rdParty/JCL/source/windows/JclMiscel.pas @@ -0,0 +1,539 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclMiscel.pas. } +{ } +{ The Initial Developers of the Original Code are Members of Team JCL. Portions created by these } +{ individuals are Copyright (C) of these individuals. All Rights Reserved } +{ } +{ Contributors: } +{ Jeroen Speldekamp } +{ Peter Friese } +{ Marcel van Brakel } +{ Robert Marquardt (marquardt) } +{ John C Molyneux } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ } +{**************************************************************************************************} +{ } +{ Various miscellaneous routines that do not (yet) fit nicely into other units } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclMiscel; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF MSWINDOWS} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, + {$ELSE ~HAS_UNITSCOPE} + Windows, + {$ENDIF ~HAS_UNITSCOPE} + JclWin32, + {$ENDIF MSWINDOWS} + JclBase; + +// StrLstLoadSave +function SetDisplayResolution(const XRes, YRes: DWORD): Longint; + +function CreateDOSProcessRedirected(CommandLine: string; const InputFile, OutputFile: string): Boolean; +function WinExec32(Cmd: string; const CmdShow: Integer): Boolean; +function WinExec32AndWait(Cmd: string; const CmdShow: Integer): Cardinal; +function WinExec32AndRedirectOutput(const Cmd: string; var Output: string; RawOutput: Boolean = False): Cardinal; + +type + TJclKillLevel = (klNormal, klNoSignal, klTimeOut); + +// klNormal: old shutdown style: waiting all applications to respond to the signals +// klNoSignal: do not send shutdown signal, all applications are killed (only Windows NT/2000/XP) +// klTimeOut: kill applications that do not respond within the timeout interval (only Windows 2000 and XP) + +function ExitWindows(ExitCode: Cardinal): Boolean; +function LogOffOS(KillLevel: TJclKillLevel = klNormal): Boolean; +function PowerOffOS(KillLevel: TJclKillLevel = klNormal): Boolean; +function ShutDownOS(KillLevel: TJclKillLevel = klNormal): Boolean; +function RebootOS(KillLevel: TJclKillLevel = klNormal): Boolean; +function HibernateOS(Force, DisableWakeEvents: Boolean): Boolean; +function SuspendOS(Force, DisableWakeEvents: Boolean): Boolean; + +function ShutDownDialog(const DialogMessage: string; TimeOut: DWORD; + Force, Reboot: Boolean): Boolean; overload; +function ShutDownDialog(const MachineName, DialogMessage: string; TimeOut: DWORD; + Force, Reboot: Boolean): Boolean; overload; +function AbortShutDown: Boolean; overload; +function AbortShutDown(const MachineName: string): Boolean; overload; + +type + TJclAllowedPowerOperation = (apoHibernate, apoShutdown, apoSuspend); + TJclAllowedPowerOperations = set of TJclAllowedPowerOperation; + +function GetAllowedPowerOperations: TJclAllowedPowerOperations; + +// CreateProcAsUser +type + EJclCreateProcessError = class(EJclWin32Error); + +procedure CreateProcAsUser(const UserDomain, UserName, PassWord, CommandLine: string); +procedure CreateProcAsUserEx(const UserDomain, UserName, Password, CommandLine: string; + const Environment: PChar); + +{$IFDEF SUPPORTS_EXTSYM} +{$EXTERNALSYM ExitWindows} +{$ENDIF SUPPORTS_EXTSYM} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclResources, JclSecurity, JclStrings, JclSysUtils, JclSysInfo; + +function SetDisplayResolution(const XRes, YRes: DWORD): Longint; +var + DevMode: TDeviceMode; +begin + Result := DISP_CHANGE_FAILED; + ResetMemory(DevMode, SizeOf(DevMode)); + DevMode.dmSize := SizeOf(DevMode); + if EnumDisplaySettings(nil, 0, DevMode) then + begin + DevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT; + DevMode.dmPelsWidth := XRes; + DevMode.dmPelsHeight := YRes; + Result := ChangeDisplaySettings(DevMode, 0); + end; +end; + +function CreateDOSProcessRedirected(CommandLine: string; const InputFile, OutputFile: string): Boolean; +var + StartupInfo: TStartupInfo; + ProcessInfo: TProcessInformation; + SecAtrrs: TSecurityAttributes; + hInputFile, hOutputFile: THandle; +begin + Result := False; + hInputFile := CreateFile(PChar(InputFile), GENERIC_READ, FILE_SHARE_READ, + CreateInheritable(SecAtrrs), OPEN_EXISTING, FILE_ATTRIBUTE_TEMPORARY, 0); + if hInputFile <> INVALID_HANDLE_VALUE then + begin + hOutputFile := CreateFile(PChar(OutPutFile), GENERIC_READ or GENERIC_WRITE, + FILE_SHARE_READ, CreateInheritable(SecAtrrs), CREATE_ALWAYS, + FILE_ATTRIBUTE_TEMPORARY, 0); + if hOutputFile <> INVALID_HANDLE_VALUE then + begin + ResetMemory(StartupInfo, SizeOf(StartupInfo)); + ResetMemory(ProcessInfo, SizeOf(ProcessInfo)); + StartupInfo.cb := SizeOf(StartupInfo); + StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES; + StartupInfo.wShowWindow := SW_HIDE; + StartupInfo.hStdOutput := hOutputFile; + StartupInfo.hStdInput := hInputFile; + UniqueString(CommandLine);//in the Unicode version the parameter lpCommandLine needs to be writable + Result := CreateProcess(nil, PChar(CommandLine), nil, nil, True, + CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, + ProcessInfo); + if Result then + begin + WaitForSingleObject(ProcessInfo.hProcess, INFINITE); + CloseHandle(ProcessInfo.hProcess); + CloseHandle(ProcessInfo.hThread); + end; + CloseHandle(hOutputFile); + end; + CloseHandle(hInputFile); + end; +end; + +function WinExec32(Cmd: string; const CmdShow: Integer): Boolean; +var + StartupInfo: TStartupInfo; + ProcessInfo: TProcessInformation; +begin + ResetMemory(StartupInfo, SizeOf(TStartupInfo)); + ResetMemory(ProcessInfo, SizeOf(ProcessInfo)); + StartupInfo.cb := SizeOf(TStartupInfo); + StartupInfo.dwFlags := STARTF_USESHOWWINDOW; + StartupInfo.wShowWindow := CmdShow; + UniqueString(Cmd);//in the Unicode version the parameter lpCommandLine needs to be writable + Result := CreateProcess(nil, PChar(Cmd), nil, nil, False, + NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo); + if Result then + begin + WaitForInputIdle(ProcessInfo.hProcess, INFINITE); + CloseHandle(ProcessInfo.hThread); + CloseHandle(ProcessInfo.hProcess); + end; +end; + +function WinExec32AndWait(Cmd: string; const CmdShow: Integer): Cardinal; +var + StartupInfo: TStartupInfo; + ProcessInfo: TProcessInformation; +begin + Result := Cardinal($FFFFFFFF); + ResetMemory(StartupInfo, SizeOf(TStartupInfo)); + ResetMemory(ProcessInfo, SizeOf(ProcessInfo)); + StartupInfo.cb := SizeOf(TStartupInfo); + StartupInfo.dwFlags := STARTF_USESHOWWINDOW; + StartupInfo.wShowWindow := CmdShow; + UniqueString(Cmd);//in the Unicode version the parameter lpCommandLine needs to be writable + if CreateProcess(nil, PChar(Cmd), nil, nil, False, NORMAL_PRIORITY_CLASS, + nil, nil, StartupInfo, ProcessInfo) then + begin + WaitForInputIdle(ProcessInfo.hProcess, INFINITE); + if WaitForSingleObject(ProcessInfo.hProcess, INFINITE) = WAIT_OBJECT_0 then + begin + if not GetExitCodeProcess(ProcessInfo.hProcess, Result) then + Result := Cardinal($FFFFFFFF); + end; + CloseHandle(ProcessInfo.hThread); + CloseHandle(ProcessInfo.hProcess); + end; +end; + +function WinExec32AndRedirectOutput(const Cmd: string; var Output: string; RawOutput: Boolean): Cardinal; +begin + Result := Execute(Cmd, Output, RawOutput); +end; + +function KillLevelToFlags(KillLevel: TJclKillLevel): Cardinal; +begin + Result := 0; + case KillLevel of + klNoSignal: + if not (GetWindowsVersion in [wvWin95, wvWin95OSR2, wvWin98, + wvWin98SE, wvWinME]) then + Result := EWX_FORCE; + klTimeOut: + if not (GetWindowsVersion in [wvWin95, wvWin95OSR2, wvWin98, + wvWin98SE, wvWinME, wvWinNT31, wvWinNT35, wvWinNT351, wvWinNT4]) then + Result := EWX_FORCEIFHUNG; + end; +end; + +function LogOffOS(KillLevel: TJclKillLevel): Boolean; +begin + {$IFDEF MSWINDOWS} + Result := JclMiscel.ExitWindows(EWX_LOGOFF or KillLevelToFlags(KillLevel)); + {$ENDIF MSWINDOWS} + { TODO : implement at least LINUX variants throwing an exception } +end; + +function PowerOffOS(KillLevel: TJclKillLevel): Boolean; +begin + {$IFDEF MSWINDOWS} + Result := JclMiscel.ExitWindows(EWX_POWEROFF or KillLevelToFlags(KillLevel)); + {$ENDIF MSWINDOWS} +end; + +function ShutDownOS(KillLevel: TJclKillLevel): Boolean; +begin + {$IFDEF MSWINDOWS} + Result := JclMiscel.ExitWindows(EWX_SHUTDOWN or KillLevelToFlags(KillLevel)); + {$ENDIF MSWINDOWS} +end; + +function RebootOS(KillLevel: TJclKillLevel): Boolean; +begin + {$IFDEF MSWINDOWS} + Result := JclMiscel.ExitWindows(EWX_REBOOT or KillLevelToFlags(KillLevel)); + {$ENDIF MSWINDOWS} +end; + +function ExitWindows(ExitCode: Cardinal): Boolean; +begin + { TODO -cTest : Check for Win9x } + if (Win32Platform = VER_PLATFORM_WIN32_NT) and not EnableProcessPrivilege(True, SE_SHUTDOWN_NAME) then + Result := False + else + Result := ExitWindowsEx(ExitCode, SHTDN_REASON_MAJOR_APPLICATION or SHTDN_REASON_MINOR_OTHER); +end; + +function HibernateOS(Force, DisableWakeEvents: Boolean): Boolean; +var + OldShutdownPrivilege: Boolean; +begin + {$IFDEF MSWINDOWS} + try + OldShutdownPrivilege := IsPrivilegeEnabled(SE_SHUTDOWN_NAME); + try + Result := EnableProcessPrivilege(True, SE_SHUTDOWN_NAME) + and SetSuspendState(True, Force, DisableWakeEvents); + finally + EnableProcessPrivilege(OldShutdownPrivilege, SE_SHUTDOWN_NAME); + end; + except + Result := False; + end; + {$ENDIF MSWINDOWS} +end; + +function SuspendOS(Force, DisableWakeEvents: Boolean): Boolean; +var + OldShutdownPrivilege: Boolean; +begin + {$IFDEF MSWINDOWS} + try + OldShutdownPrivilege := IsPrivilegeEnabled(SE_SHUTDOWN_NAME); + try + Result := EnableProcessPrivilege(True, SE_SHUTDOWN_NAME) + and SetSuspendState(False, Force, DisableWakeEvents); + finally + EnableProcessPrivilege(OldShutdownPrivilege, SE_SHUTDOWN_NAME); + end; + except + Result := False; + end; + {$ENDIF MSWINDOWS} +end; + +function ShutDownDialog(const DialogMessage: string; TimeOut: DWORD; + Force, Reboot: Boolean): Boolean; +begin + Result := ShutDownDialog('', DialogMessage, TimeOut, Force, Reboot); +end; + +function ShutDownDialog(const MachineName, DialogMessage: string; TimeOut: DWORD; + Force, Reboot: Boolean): Boolean; +var + OldShutdownPrivilege: Boolean; + PrivilegeName: string; +begin + {$IFDEF MSWINDOWS} + if MachineName = '' then + PrivilegeName := SE_SHUTDOWN_NAME + else + PrivilegeName := SE_REMOTE_SHUTDOWN_NAME; + + try + OldShutdownPrivilege := IsPrivilegeEnabled(PrivilegeName); + try + Result := EnableProcessPrivilege(True, PrivilegeName) + and InitiateSystemShutdown(PChar(MachineName), PChar(DialogMessage), + TimeOut, Force, Reboot); + finally + EnableProcessPrivilege(OldShutdownPrivilege, PrivilegeName); + end; + except + Result := False; + end; + {$ENDIF MSWINDOWS} +end; + +function AbortShutDown: Boolean; +begin + Result := AbortShutDown(''); +end; + +function AbortShutDown(const MachineName: string): Boolean; +var + OldShutdownPrivilege: Boolean; + PrivilegeName: string; +begin + {$IFDEF MSWINDOWS} + if MachineName = '' then + PrivilegeName := SE_SHUTDOWN_NAME + else + PrivilegeName := SE_REMOTE_SHUTDOWN_NAME; + + try + OldShutdownPrivilege := IsPrivilegeEnabled(PrivilegeName); + try + Result := EnableProcessPrivilege(True, PrivilegeName) + and AbortSystemShutDown(PChar(MachineName)); + finally + EnableProcessPrivilege(OldShutdownPrivilege, PrivilegeName); + end; + except + Result := False; + end; + {$ENDIF MSWINDOWS} +end; + +function GetAllowedPowerOperations: TJclAllowedPowerOperations; +begin + {$IFDEF MSWINDOWS} + Result := []; + try + if IsPwrSuspendAllowed then + Include(Result, apoSuspend); + if IsPwrHibernateAllowed then + Include(Result, apoHibernate); + if IsPwrShutdownAllowed then + Include(Result, apoShutdown); + except + Result := []; + end; + {$ENDIF MSWINDOWS} +end; + +procedure CheckOSVersion; +begin + if Win32Platform <> VER_PLATFORM_WIN32_NT then + raise EJclError.CreateRes(@RsCreateProcNTRequiredError); + if Win32BuildNumber < 1057 then + raise EJclError.CreateRes(@RsCreateProcBuild1057Error); +end; + +procedure CreateProcAsUser(const UserDomain, UserName, PassWord, CommandLine: string); +begin + CreateProcAsUserEx(UserDomain, UserName, Password, CommandLine, nil); +end; + +{ TODO -cTest : Check for Win9x } +procedure CreateProcAsUserEx(const UserDomain, UserName, Password, CommandLine: string; + const Environment: PChar); +const + // default values for window stations and desktops + CreateProcDEFWINSTATION = 'WinSta0'; + CreateProcDEFDESKTOP = 'Default'; + // CreateProcDOMUSERSEP = '\'; +var + ConsoleTitle: string; + Help: string; + WinStaName: string; + DesktopName: string; + hUserToken: THandle; + hWindowStation: HWINSTA; + hDesktop: HDESK; + StartUpInfo: TStartUpInfo; + ProcInfo: TProcessInformation; +begin + + // Step 1: check for the correct OS version + CheckOSVersion; + + // Step 2: logon as the specified user + hUserToken := 0; + if not LogonUser(PChar(UserName), PChar(UserDomain), PChar(Password), + LOGON32_LOGON_INTERACTIVE, LOGON32_PROVIDER_DEFAULT, hUserToken) then + begin + case GetLastError of + ERROR_PRIVILEGE_NOT_HELD: + raise EJclCreateProcessError.CreateResFmt(@RsCreateProcPrivilegeMissing, + [GetPrivilegeDisplayName(SE_TCB_NAME), SE_TCB_NAME]); + ERROR_LOGON_FAILURE: + raise EJclCreateProcessError.CreateRes(@RsCreateProcLogonUserError); + ERROR_ACCESS_DENIED: + raise EJclCreateProcessError.CreateRes(@RsCreateProcAccessDenied); + else + raise EJclCreateProcessError.CreateRes(@RsCreateProcLogonFailed); + end; + end; + + // Step 3: give the new user access to the current WindowStation and Desktop + hWindowStation:= GetProcessWindowStation; + WinStaName := GetUserObjectName(hWindowStation); + if WinStaName = '' then + WinStaName := CreateProcDEFWINSTATION; + + if not SetUserObjectFullAccess(hWindowStation) then + begin + CloseHandle(hUserToken); + raise EJclCreateProcessError.CreateResFmt(@RsCreateProcSetStationSecurityError, [WinStaName]); + end; + + hDesktop := GetThreadDesktop(GetCurrentThreadId); + DesktopName := GetUserObjectName(hDesktop); + if DesktopName = '' then + DesktopName := CreateProcDEFDESKTOP; + + if not SetUserObjectFullAccess(hDesktop) then + begin + CloseHandle(hUserToken); + raise EJclCreateProcessError.CreateResFmt(@RsCreateProcSetDesktopSecurityError, [DesktopName]); + end; + + // Step 4: set the startup info for the new process + ConsoleTitle := UserDomain + UserName; + ResetMemory(StartUpInfo, SizeOf(StartUpInfo)); + with StartUpInfo do + begin + cb:= SizeOf(StartUpInfo); + lpTitle:= PChar(ConsoleTitle); + Help := WinStaName + '\' + DeskTopName; + lpDesktop:= PChar(Help); + end; + + // Step 5: create the child process + if not CreateProcessAsUser(hUserToken, nil, PChar(CommandLine), nil, nil, + False, CREATE_NEW_CONSOLE or CREATE_NEW_PROCESS_GROUP, Environment, nil, + {$IFDEF FPC} + @StartUpInfo, @ProcInfo) then + {$ELSE ~FPC} + StartUpInfo, ProcInfo) then + {$ENDIF ~FPC} + begin + case GetLastError of + ERROR_PRIVILEGE_NOT_HELD: + raise EJclCreateProcessError.CreateResFmt(@RsCreateProcPrivilegesMissing, + [GetPrivilegeDisplayName(SE_ASSIGNPRIMARYTOKEN_NAME), SE_ASSIGNPRIMARYTOKEN_NAME, + GetPrivilegeDisplayName(SE_INCREASE_QUOTA_NAME), SE_INCREASE_QUOTA_NAME]); + ERROR_FILE_NOT_FOUND: + raise EJclCreateProcessError.CreateResFmt(@RsCreateProcCommandNotFound, [CommandLine]); + else + raise EJclCreateProcessError.CreateRes(@RsCreateProcFailed); + end; + end; + + // clean up + CloseWindowStation(hWindowStation); + CloseDesktop(hDesktop); + CloseHandle(hUserToken); + + // if this code should be called although there has + // been an exception during invocation of CreateProcessAsUser, + // it will quite surely fail. you should make sure this doesn't happen. + // (it shouldn't happen due to the use of exceptions in the above lines) + CloseHandle(ProcInfo.hThread); + CloseHandle(ProcInfo.hProcess); +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/JclMsBuild.pas b/3rdParty/JCL/source/windows/JclMsBuild.pas new file mode 100644 index 00000000..eec6abf4 --- /dev/null +++ b/3rdParty/JCL/source/windows/JclMsBuild.pas @@ -0,0 +1,2739 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclMsBuild.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet. } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All Rights Reserved. } +{ } +{ Contributor(s): } +{ } +{**************************************************************************************************} +{ } +{ Routines around MsBuild project files. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclMsBuild; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + Windows, + SysUtils, + Classes, + Contnrs, + JclBase, + JclFileUtils, + JclRegistry, + JclStreams, + JclSimpleXml, + JclSysInfo; + +(* simple test procedure: load Jcl.dproj and emit custom properties and files to be compiled + +procedure Test; +var + MsBuildParser: TJclMsBuildParser; +begin + MsBuildParser := TJclMsBuildParser.Create('C:\dev\jcl\jcl\packages\d11\Jcl.dproj'); + try + MsBuildParser.Init; + MsBuildParser.Parse; + WriteLn(MsBuildParser.Properties.CustomProperties.Text); + WriteLn(MsBuildParser.EvaluateString('@(DCCReference->''%(FullPath)'')')); + finally + MsBuildParser.Free; + end; +end; *) + +type + EJclMsBuildError = class(EJclError); + + TJclMsBuildItem = class + private + FItemName: string; + FItemInclude: string; + FItemFullInclude: string; //full path + FItemExclude: string; + FItemRemove: string; + FItemMetaData: TStrings; + public + constructor Create; + destructor Destroy; override; + property ItemName: string read FItemName; + property ItemInclude: string read FItemInclude; + property ItemFullInclude: string read FItemFullInclude; + property ItemExclude: string read FItemExclude; + property ItemRemove: string read FItemRemove; + property ItemMetaData: TStrings read FItemMetaData; + end; + + TJclMsBuildTaskOutput = class + private + FTaskParameter: string; + FPropertyName: string; + FItemName: string; + public + property TaskParameter: string read FTaskParameter; + property PropertyName: string read FPropertyName; + property ItemName: string read FItemName; + end; + + TJclMsBuildParameter = class + private + FParameterName: string; + FParameterType: string; + FOutput: Boolean; + FRequired: Boolean; + public + property ParameterName: string read FParameterName; + property ParameterType: string read FParameterType; + property Output: Boolean read FOutput; + property Required: Boolean read FRequired; + end; + + TJclMsBuildUsingTask = class + private + FAssemblyName: string; + FAssemblyFile: string; + FTaskFactory: string; + FTaskName: string; + FParameters: TObjectList; + FTaskBody: string; + function AddParameter(Parameter: TJclMsBuildParameter): Integer; + function GetParameterCount: Integer; + function GetParameter(Index: Integer): TJclMsBuildParameter; + public + constructor Create; + destructor Destroy; override; + property AssemblyName: string read FAssemblyName; + property AssemblyFile: string read FAssemblyFile; + property TaskFactory: string read FTaskFactory; + property TaskName: string read FTaskName; + property ParameterCount: Integer read GetParameterCount; + property Parameters[Index: Integer]: TJclMsBuildParameter read GetParameter; + property TaskBody: string read FTaskBody; + end; + + TJclMsBuildTask = class + private + FTaskName: string; + FContinueOnError: Boolean; + FParameters: TStrings; + FOutputs: TObjectList; + function AddOutput(AOutput: TJclMsBuildTaskOutput): Integer; + function GetOutputCount: Integer; + function GetOutput(Index: Integer): TJclMsBuildTaskOutput; + public + constructor Create; + destructor Destroy; override; + property TaskName: string read FTaskName; + property ContinueOnError: Boolean read FContinueOnError; + property Parameters: TStrings read FParameters; + property OutputCount: Integer read GetOutputCount; + property Outputs[Index: Integer]: TJclMsBuildTaskOutput read GetOutput; + end; + + TJclMsBuildTarget = class + private + FTargetName: string; + FDepends: TStrings; + FReturns: TStrings; + FInputs: TStrings; + FOutputs: TStrings; + FBeforeTargets: TStrings; + FAfterTargets: TStrings; + FKeepDuplicateOutputs: Boolean; + FTasks: TObjectList; + FErrorTargets: TStrings; + function AddTask(Task: TJclMsBuildTask): Integer; + function GetTaskCount: Integer; + function GetTask(Index: Integer): TJclMsBuildTask; + public + constructor Create; + destructor Destroy; override; + property TargetName: string read FTargetName; + property Depends: TStrings read FDepends; + property Returns: TStrings read FReturns; + property Inputs: TStrings read FInputs; + property Outputs: TStrings read FOutputs; + property BeforeTargets: TStrings read FBeforeTargets; + property AfterTargets: TStrings read FAfterTargets; + property KeepDuplicateOutputs: Boolean read FKeepDuplicateOutputs; + property TaskCount: Integer read GetTaskCount; + property Tasks[Index: Integer]: TJclMsBuildTask read GetTask; + property ErrorTargets: TStrings read FErrorTargets; + end; + + TJclMsBuildParser = class; + + // TStrings wrapper for all the MsBuild properties, values are searched + // in the following ordered property classes: + // - reserved properties defined by MsBuild, + // their value cannot be overriden or an error will be raised + // - properties taken from the emulated "command line" + // their value cannot be overriden, no error is raised + // - custom properties defined by the script + // - environment properties taken from the environment variables + // their value can be silently overriden + // - registry properties handled by event + // - function properties handled by event + + TJclMsBuildProperties = class(TStrings) + private + FParser: TJclMsBuildParser; + FReservedProperties: TStrings; + FGlobalProperties: TStrings; + FCustomProperties: TStrings; + FEnvironmentProperties: TStrings; + protected + function Get(Index: Integer): string; override; + function GetCount: Integer; override; + function GetObject(Index: Integer): TObject; override; + function GetRawValue(const Name: string): string; + procedure Put(Index: Integer; const S: string); override; + procedure PutObject(Index: Integer; AObject: TObject); override; + procedure SetRawValue(const Name, Value: string); + public + constructor Create(AParser: TJclMsBuildParser); + destructor Destroy; override; + + property Parser: TJclMsBuildParser read FParser; + + procedure Clear; override; + + procedure Delete(Index: Integer); override; + function IndexOf(const S: string): Integer; override; + procedure Insert(Index: Integer; const S: string); override; + + procedure MergeEnvironmentProperties(SystemEnvironmentProperties: TStrings); + + property ReservedProperties: TStrings read FReservedProperties; + property EnvironmentProperties: TStrings read FEnvironmentProperties; + property GlobalProperties: TStrings read FGlobalProperties; + property CustomProperties: TStrings read FCustomProperties; + + property RawValues[const Name: string]: string read GetRawValue write SetRawValue; + end; + + TJclMsBuildImportEvent = procedure (Sender: TJclMsBuildParser; var FileName: TFileName; + var SubXml: TJclSimpleXml; var SubOwnsXml: Boolean) of object; + TJclMsBuildToolsVersionEvent = procedure (Sender: TJclMsBuildParser; const ToolsVersion: string) of object; + TJclMsBuildRegistryPropertyEvent = function (Sender: TJclMsBuildParser; Root: HKEY; + const Path, Name: string; out Value: string): Boolean of object; + TJclMsBuildFunctionPropertyEvent = function (Sender: TJclMsBuildParser; const Command: string; + out Value: string): Boolean of object; + + TJclMsBuildParser = class + private + FCurrentFileName: TFileName; + FProjectFileName: TFileName; + FXml: TJclSimpleXml; + FOwnsXml: Boolean; + FProperties: TJclMsBuildProperties; + FItems: TObjectList; + FItemDefinitions: TObjectList; + FTargets: TObjectList; + FUsingTasks: TObjectList; + FInitialTargets: TStrings; + FDefaultTargets: TStrings; + FToolsVersion: string; + FDotNetVersion: string; + FIgnoreFunctionProperties: Boolean; + FWorkingDirectory: string; + FFirstPropertyGroup: TJclSimpleXMLElem; + FProjectExtensions: TJclSimpleXMLElem; + FOnImport: TJclMsBuildImportEvent; + FOnToolsVersion: TJclMsBuildToolsVersionEvent; + FOnRegistryProperty: TJclMsBuildRegistryPropertyEvent; + FOnFunctionProperty: TJclMsBuildFunctionPropertyEvent; + function GetItemCount: Integer; + function GetItem(Index: Integer): TJclMsBuildItem; + function GetItemDefinitionCount: Integer; + function GetItemDefinition(Index: Integer): TJclMsBuildItem; + function GetTargetCount: Integer; + function GetTarget(Index: Integer): TJclMsBuildTarget; + function GetUsingTaskCount: Integer; + function GetUsingTask(Index: Integer): TJclMsBuildUsingTask; + procedure ParseChoose(XmlElem: TJclSimpleXmlElem); + procedure ParseImport(XmlElem: TJclSimpleXmlElem); + procedure ParseImportGroup(XmlElem: TJclSimpleXmlElem); + procedure ParseItem(XmlElem: TJclSimpleXmlElem; Definition: Boolean); + procedure ParseItemDefinitionGroup(XmlElem: TJclSimpleXmlElem); + procedure ParseItemGroup(XmlElem: TJclSimpleXmlElem); + procedure ParseItemMetaData(XmlElem: TJclSimpleXmlElem; ItemMetaData: TStrings); + procedure ParseOnError(XmlElem: TJclSimpleXMLElem; Target: TJclMsBuildTarget); + function ParseOtherwise(XmlElem: TJclSimpleXmlElem; Skip: Boolean): Boolean; + procedure ParseOutput(XmlElem: TJclSimpleXMLElem; Task: TJclMsBuildTask); + procedure ParseParameter(XmlElem: TJclSimpleXMLElem; UsingTask: TJclMsBuildUsingTask); + procedure ParseParameterGroup(XmlElem: TJclSimpleXMLElem; UsingTask: TJclMsBuildUsingTask); + procedure ParseProject(XmlElem: TJclSimpleXmlElem); + procedure ParseProperty(XmlElem: TJclSimpleXmlElem); + procedure ParsePropertyGroup(XmlElem: TJclSimpleXmlElem); + procedure ParseTarget(XmlElem: TJclSimpleXmlElem); + procedure ParseTask(XmlElem: TJclSimpleXMLElem; Target: TJclMsBuildTarget); + procedure ParseTaskBody(XmlElem: TJclSimpleXMLElem; UsingTask: TJclMsBuildUsingTask); + procedure ParseUsingTask(XmlElem: TJclSimpleXmlElem); + function ParseWhen(XmlElem: TJclSimpleXmlElem; Skip: Boolean): Boolean; + procedure ParseXml(AXml: TJclSimpleXML); + protected + function GetPropertyValue(const Name: string): string; virtual; + procedure SetPropertyValue(const Name, Value: string); virtual; + public + // evaluate known MsBuild properties + // http://msdn.microsoft.com/en-us/library/ms171458.aspx + function EvaluateFunctionProperty(const Command: string): string; + function EvaluateList(const Name: string): string; + function EvaluateRegistryProperty(Root: HKEY; const Path, Name: string): string; + function EvaluateString(const S: string): string; + function EvaluateTransform(ItemList: TStrings; const Transform: string): string; + public + // this function parses MsBuild condition as described at: + // http://msdn.microsoft.com/en-us/library/7szfhaft.aspx + function ParseCondition(const Condition: string): Boolean; + function ParseConditionLength(const Condition: string; var Position: Integer; Len: Integer): Boolean; + function ParseConditionOperand(const Condition: string; var Position: Integer; Len: Integer): Boolean; + function ParseConditionString(const Condition: string; var Position: Integer; Len: Integer): string; + public + constructor Create(const AFileName: TFileName; AXml: TJclSimpleXml; AOwnsXml: Boolean = False); overload; + constructor Create(const AFileName: TFileName; Encoding: TJclStringEncoding = seAuto; CodePage: Word = CP_ACP); overload; + constructor Create(const AFileName: TFileName; ExtraImportsFileName: array of string; Encoding: TJclStringEncoding = seAuto; CodePage: Word = CP_ACP); overload; + destructor Destroy; override; + + procedure Clear; + procedure ClearItems; + procedure ClearItemDefinitions; + procedure ClearTargets; + + procedure Parse; + procedure Save; + + procedure FindItemIncludes(const ItemName: string; List: TStrings); + function FindItemDefinition(const ItemName: string): TJclMsBuildItem; + function FindTarget(const TargetName: string): TJclMsBuildTarget; + + class function SameItemName(const ItemName1, ItemName2: string): Boolean; + + procedure Init; + procedure InitEnvironmentProperties; + procedure InitReservedProperties; + + // encode just <, > and & + procedure XMLEncodeValue(Sender: TObject; var Value: string); + // decode all entities + procedure XMLDecodeValue(Sender: TObject; var Value: string); + + property CurrentFileName: TFileName read FCurrentFileName; + property ProjectFileName: TFileName read FProjectFileName; + property Xml: TJclSimpleXml read FXml; + property OwnsXml: Boolean read FOwnsXml write FOwnsXml; + property Properties: TJclMsBuildProperties read FProperties; + property ItemCount: Integer read GetItemCount; + property Items[Index: Integer]: TJclMsBuildItem read GetItem; + property ItemDefinitionCount: Integer read GetItemDefinitionCount; + property ItemDefinitions[Index: Integer]: TJclMsBuildItem read GetItemDefinition; + property TargetCount: Integer read GetTargetCount; + property Targets[Index: Integer]: TJclMsBuildTarget read GetTarget; + property UsingTaskCount: Integer read GetUsingTaskCount; + property UsingTasks[Index: Integer]: TJclMsBuildUsingTask read GetUsingTask; + property ProjectExtensions: TJclSimpleXMLElem read FProjectExtensions; + property InitialTargets: TStrings read FInitialTargets; + property DefaultTargets: TStrings read FDefaultTargets; + property ToolsVersion: string read FToolsVersion; + property DotNetVersion: string read FDotNetVersion write FDotNetVersion; + property IgnoreFunctionProperties: Boolean read FIgnoreFunctionProperties write FIgnoreFunctionProperties; + property WorkingDirectory: string read FWorkingDirectory write FWorkingDirectory; + property OnImport: TJclMsBuildImportEvent read FOnImport write FOnImport; + property OnToolsVersion: TJclMsBuildToolsVersionEvent read FOnToolsVersion write FOnToolsVersion; + property OnRegistryProperty: TJclMsBuildRegistryPropertyEvent read FOnRegistryProperty write FOnRegistryProperty; + property OnFunctionProperty: TJclMsBuildFunctionPropertyEvent read FOnFunctionProperty write FOnFunctionProperty; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + SysConst, + JclWin32, + JclDotNet, + JclShell, + JclStrings, + JclDevToolsResources; + +//=== { TJclMsBuildItem } ==================================================== + +constructor TJclMsBuildItem.Create; +begin + inherited Create; + FItemMetaData := TStringList.Create; +end; + +destructor TJclMsBuildItem.Destroy; +begin + FItemMetaData.Free; + inherited Destroy; +end; + +//=== { TJclMsBuildUsingTask } =============================================== + +function TJclMsBuildUsingTask.AddParameter(Parameter: TJclMsBuildParameter): Integer; +begin + Result := FParameters.Add(Parameter); +end; + +constructor TJclMsBuildUsingTask.Create; +begin + inherited Create; + FParameters := TObjectList.Create(True); +end; + +destructor TJclMsBuildUsingTask.Destroy; +begin + FParameters.Free; + inherited Destroy; +end; + +function TJclMsBuildUsingTask.GetParameter( + Index: Integer): TJclMsBuildParameter; +begin + Result := TJclMsBuildParameter(FParameters.Items[Index]); +end; + +function TJclMsBuildUsingTask.GetParameterCount: Integer; +begin + Result := FParameters.Count; +end; + +//=== { TJclMsBuildTask } ==================================================== + +constructor TJclMsBuildTask.Create; +begin + inherited Create; + FParameters := TStringList.Create; + FOutputs := TObjectList.Create(True); +end; + +destructor TJclMsBuildTask.Destroy; +begin + FOutputs.Free; + FParameters.Free; + inherited Destroy; +end; + +function TJclMsBuildTask.AddOutput(AOutput: TJclMsBuildTaskOutput): Integer; +begin + Result := FOutputs.Add(AOutput); +end; + +function TJclMsBuildTask.GetOutput(Index: Integer): TJclMsBuildTaskOutput; +begin + Result := TJclMsBuildTaskOutput(FOutputs.Items[Index]); +end; + +function TJclMsBuildTask.GetOutputCount: Integer; +begin + Result := FOutputs.Count; +end; + +//=== { TJclMsBuildTarget } ================================================== + +constructor TJclMsBuildTarget.Create; +begin + inherited Create; + FDepends := TStringList.Create; + FReturns := TStringList.Create; + FInputs := TStringList.Create; + FOutputs := TStringList.Create; + FBeforeTargets := TStringList.Create; + FAfterTargets := TStringList.Create; + FTasks := TObjectList.Create(True); + FErrorTargets := TStringList.Create; +end; + +destructor TJclMsBuildTarget.Destroy; +begin + FErrorTargets.Free; + FTasks.Free; + FAfterTargets.Free; + FBeforeTargets.Free; + FOutputs.Free; + FInputs.Free; + FReturns.Free; + FDepends.Free; + inherited Destroy; +end; + +function TJclMsBuildTarget.AddTask(Task: TJclMsBuildTask): Integer; +begin + Result := FTasks.Add(Task); +end; + +function TJclMsBuildTarget.GetTask(Index: Integer): TJclMsBuildTask; +begin + Result := TJclMsBuildTask(FTasks.Items[Index]); +end; + +function TJclMsBuildTarget.GetTaskCount: Integer; +begin + Result := FTasks.Count; +end; + +//=== { TJclMsBuildProperties } ============================================== + +constructor TJclMsBuildProperties.Create(AParser: TJclMsBuildParser); +begin + inherited Create; + FParser := AParser; + FReservedProperties := TStringList.Create; + FGlobalProperties := TStringList.Create; + FCustomProperties := TStringList.Create; + FEnvironmentProperties := TStringList.Create; +end; + +destructor TJclMsBuildProperties.Destroy; +begin + FEnvironmentProperties.Free; + FCustomProperties.Free; + FGlobalProperties.Free; + FReservedProperties.Free; + inherited Destroy; +end; + +procedure TJclMsBuildProperties.Clear; +begin + ReservedProperties.Clear; + CustomProperties.Clear; + EnvironmentProperties.Clear; + GlobalProperties.Clear; +end; + +procedure TJclMsBuildProperties.Delete(Index: Integer); +begin + // - reserved properties defined by MsBuild, + // their value cannot be overriden or an error will be raised + if (Index >= 0) and (Index < FReservedProperties.Count) then + raise EJclMsBuildError.CreateRes(@RsEReservedProperty); + Dec(Index, FReservedProperties.Count); + + // - properties taken from the emulated "command line" + // their value cannot be overriden, no error is raised + if (Index >= 0) and (Index < FGlobalProperties.Count) then + Exit; + Dec(Index, FGlobalProperties.Count); + + // - custom properties defined by the script + if (Index >= 0) and (Index < FCustomProperties.Count) then + begin + FCustomProperties.Delete(Index); + Exit; + end; + Dec(Index, FCustomProperties.Count); + + // - environment properties taken from the environment variables + // their value can be silently overriden + if (Index >= 0) and (Index < FEnvironmentProperties.Count) then + begin + FEnvironmentProperties.Delete(Index); + Exit; + end; + + raise EJclMsBuildError.CreateRes(@SRangeError); +end; + +function TJclMsBuildProperties.Get(Index: Integer): string; +begin + // - reserved properties defined by MsBuild, + if (Index >= 0) and (Index < FReservedProperties.Count) then + begin + Result := FReservedProperties.Strings[Index]; + Exit; + end; + Dec(Index, FReservedProperties.Count); + + // - properties taken from the emulated "command line" + if (Index >= 0) and (Index < FGlobalProperties.Count) then + begin + Result := FGlobalProperties.Strings[Index]; + Exit; + end; + Dec(Index, FGlobalProperties.Count); + + // - custom properties defined by the script + if (Index >= 0) and (Index < FCustomProperties.Count) then + begin + Result := FCustomProperties.Strings[Index]; + Exit; + end; + Dec(Index, FCustomProperties.Count); + + // - environment properties taken from the environment variables + if (Index >= 0) and (Index < FEnvironmentProperties.Count) then + begin + Result := FEnvironmentProperties.Strings[Index]; + Exit; + end; + + raise EJclMsBuildError.CreateRes(@SRangeError); +end; + +function TJclMsBuildProperties.GetCount: Integer; +begin + Result := FReservedProperties.Count + FGlobalProperties.Count + + FCustomProperties.Count + FEnvironmentProperties.Count; +end; + +function TJclMsBuildProperties.GetObject(Index: Integer): TObject; +begin + // - reserved properties defined by MsBuild, + if (Index >= 0) and (Index < FReservedProperties.Count) then + begin + Result := FReservedProperties.Objects[Index]; + Exit; + end; + Dec(Index, FReservedProperties.Count); + + // - properties taken from the emulated "command line" + if (Index >= 0) and (Index < FGlobalProperties.Count) then + begin + Result := FGlobalProperties.Objects[Index]; + Exit; + end; + Dec(Index, FGlobalProperties.Count); + + // - custom properties defined by the script + if (Index >= 0) and (Index < FCustomProperties.Count) then + begin + Result := FCustomProperties.Objects[Index]; + Exit; + end; + Dec(Index, FCustomProperties.Count); + + // - environment properties taken from the environment variables + if (Index >= 0) and (Index < FEnvironmentProperties.Count) then + begin + Result := FEnvironmentProperties.Objects[Index]; + Exit; + end; + + raise EJclMsBuildError.CreateRes(@SRangeError); +end; + +function TJclMsBuildProperties.GetRawValue(const Name: string): string; +var + Index: Integer; + XmlElem: TJclSimpleXmlElem; +begin + Index := IndexOfName(Name); + XmlElem := nil; + if Index >= 0 then + XmlElem := TJclSimpleXMLElem(Objects[Index]); + if Assigned(XmlElem) then + Result := XmlElem.Value + else + Result := ''; +end; + +function TJclMsBuildProperties.IndexOf(const S: string): Integer; +begin + // - reserved properties defined by MsBuild, + Result := FReservedProperties.IndexOf(S); + if Result >= 0 then + Exit; + + // - properties taken from the emulated "command line" + Result := FGlobalProperties.IndexOf(S); + if Result >= 0 then + begin + Inc(Result, FReservedProperties.Count); + Exit; + end; + + // - custom properties defined by the script + Result := FCustomProperties.IndexOf(S); + if Result >= 0 then + begin + Inc(Result, FReservedProperties.Count); + Inc(Result, FGlobalProperties.Count); + Exit; + end; + + // - environment properties taken from the environment variables + Result := FEnvironmentProperties.IndexOf(S); + if Result >= 0 then + begin + Inc(Result, FReservedProperties.Count); + Inc(Result, FGlobalProperties.Count); + Inc(Result, FCustomProperties.Count); + Exit; + end; +end; + +procedure TJclMsBuildProperties.Insert(Index: Integer; const S: string); +begin + // - reserved properties defined by MsBuild, + // their value cannot be overriden or an error will be raised + if (Index >= 0) and (Index < FReservedProperties.Count) then + raise EJclMsBuildError.CreateRes(@RsEReservedProperty); + Dec(Index, FReservedProperties.Count); + + // - properties taken from the emulated "command line" + // their value cannot be overriden, no error is raised + if (Index >= 0) and (Index < FGlobalProperties.Count) then + Exit; + Dec(Index, FGlobalProperties.Count); + + // - custom properties defined by the script + if (Index >= 0) and (Index < FCustomProperties.Count) then + begin + FCustomProperties.Insert(Index, S); + Exit; + end; + Dec(Index, FCustomProperties.Count); + + // - environment properties taken from the environment variables + // their value can be silently overriden + if (Index >= 0) and (Index <= FEnvironmentProperties.Count) then + begin + FCustomProperties.Add(S); + Exit; + end; + + raise EJclMsBuildError.CreateRes(@SRangeError); +end; + +procedure TJclMsBuildProperties.MergeEnvironmentProperties( + SystemEnvironmentProperties: TStrings); +var + I: Integer; + PropName: string; + SystemValue: string; +begin + for I := 0 to FEnvironmentProperties.Count - 1 do + begin + PropName := FEnvironmentProperties.Names[I]; + SystemValue := SystemEnvironmentProperties.Values[PropName]; + if SystemValue <> '' then + FEnvironmentProperties.Values[PropName] := SystemValue; + end; +end; + +procedure TJclMsBuildProperties.Put(Index: Integer; const S: string); +begin + // - reserved properties defined by MsBuild, + // their value cannot be overriden or an error will be raised + if (Index >= 0) and (Index < FReservedProperties.Count) then + raise EJclMsBuildError.CreateRes(@RsEReservedProperty); + Dec(Index, FReservedProperties.Count); + + // - properties taken from the emulated "command line" + // their value cannot be overriden, no error is raised + if (Index >= 0) and (Index < FGlobalProperties.Count) then + Exit; + Dec(Index, FGlobalProperties.Count); + + // - custom properties defined by the script + if (Index >= 0) and (Index < FCustomProperties.Count) then + begin + FCustomProperties.Strings[Index] := S; + Exit; + end; + Dec(Index, FCustomProperties.Count); + + // - environment properties taken from the environment variables + // their value can be silently overriden + if (Index >= 0) and (Index < FEnvironmentProperties.Count) then + begin + if (FCustomProperties.Count > 0) and (FCustomProperties.Strings[FCustomProperties.Count - 1] = '') then + FCustomProperties.Strings[FCustomProperties.Count - 1] := S + else + FCustomProperties.Add(S); + Exit; + end; + + raise EJclMsBuildError.CreateRes(@SRangeError); +end; + +procedure TJclMsBuildProperties.PutObject(Index: Integer; AObject: TObject); +begin + // - reserved properties defined by MsBuild, + if (Index >= 0) and (Index < FReservedProperties.Count) then + begin + FReservedProperties.Objects[Index] := AObject; + Exit; + end; + Dec(Index, FReservedProperties.Count); + + // - properties taken from the emulated "command line" + if (Index >= 0) and (Index < FGlobalProperties.Count) then + begin + FGlobalProperties.Objects[Index] := AObject; + Exit; + end; + Dec(Index, FGlobalProperties.Count); + + // - custom properties defined by the script + if (Index >= 0) and (Index < FCustomProperties.Count) then + begin + FCustomProperties.Objects[Index] := AObject; + Exit; + end; + Dec(Index, FCustomProperties.Count); + + // - environment properties taken from the environment variables + if (Index >= 0) and (Index < FEnvironmentProperties.Count) then + begin + FEnvironmentProperties.Objects[Index] := AObject; + Exit; + end; + + raise EJclMsBuildError.CreateRes(@SRangeError); +end; + +procedure TJclMsBuildProperties.SetRawValue(const Name, Value: string); +var + Index: Integer; + XmlElem: TJclSimpleXmlElem; +begin + Index := IndexOfName(Name); + XmlElem := nil; + if Index >= 0 then + XmlElem := TJclSimpleXMLElem(Objects[Index]); + if Assigned(XmlElem) then + XmlElem.Value := Value + else + if Assigned(Parser.FFirstPropertyGroup) then + Parser.FFirstPropertyGroup.Items.Add(Name, Value) + else + raise EJclMsBuildError.CreateResFmt(@RsELocateXmlElem, [Name]); +end; + +//=== { TJclMsBuildParser } ================================================== + +constructor TJclMsBuildParser.Create(const AFileName: TFileName; Encoding: TJclStringEncoding; CodePage: Word); +var + AXml: TJclSimpleXML; +begin + AXml := TJclSimpleXML.Create; + try + AXml.Options := AXml.Options - [sxoAutoEncodeValue,sxoAutoEncodeEntity]; + AXml.OnEncodeValue := XMLEncodeValue; + AXml.OnDecodeValue := XMLDecodeValue; + AXml.LoadFromFile(AFileName, Encoding, CodePage); + except + AXml.Free; + raise; + end; + Create(AFileName, AXml, True); +end; + +constructor TJclMsBuildParser.Create(const AFileName: TFileName; ExtraImportsFileName: array of string; Encoding: TJclStringEncoding = seAuto; CodePage: Word = CP_ACP); +var + I: Integer; +begin + Create(AFileName, Encoding, CodePage); + + for I := Low(ExtraImportsFileName) to High(ExtraImportsFileName) do + FXML.Root.Items.Insert('Import', I - Low(ExtraImportsFileName)).Properties.Add('Project', ExtraImportsFileName[I]); +end; + +constructor TJclMsBuildParser.Create(const AFileName: TFileName; + AXml: TJclSimpleXml; AOwnsXml: Boolean); +begin + inherited Create; + FProjectFileName := AFileName; + FXml := AXml; + FOwnsXml := AOwnsXml; + FProperties := TJclMsBuildProperties.Create(Self); + FItems := TObjectList.Create(True); + FItemDefinitions := TObjectList.Create(True); + FTargets := TObjectList.Create(True); + FUsingTasks := TObjectList.Create(True); + FInitialTargets := TStringList.Create; + FDefaultTargets := TStringList.Create; + FIgnoreFunctionProperties := True; +end; + +destructor TJclMsBuildParser.Destroy; +begin + FDefaultTargets.Free; + FInitialTargets.Free; + FUsingTasks.Free; + FTargets.Free; + FItemDefinitions.Free; + FItems.Free; + FProperties.Free; + if FOwnsXml then + FXml.Free; + inherited Destroy; +end; + +procedure TJclMsBuildParser.Clear; +begin + ClearItems; + ClearItemDefinitions; + ClearTargets; + FProperties.Clear; + FInitialTargets.Clear; + FDefaultTargets.Clear; + FProjectExtensions := nil; +end; + +procedure TJclMsBuildParser.ClearItemDefinitions; +begin + FItemDefinitions.Clear; +end; + +procedure TJclMsBuildParser.ClearItems; +begin + FItems.Clear; +end; + +procedure TJclMsBuildParser.ClearTargets; +begin + FTargets.Clear; +end; + +function TJclMsBuildParser.EvaluateString(const S: string): string; + + function FindClosingBrace(const R: string; var Position: Integer): Boolean; + var + Index, Len, BraceCount: Integer; + Quotes: string; + begin + Len := Length(R); + BraceCount := 0; + Quotes := ''; + while (Position <= Len) do + begin + // handle quotes first + if (R[Position] = NativeSingleQuote) then + begin + Index := JclStrings.CharPos(Quotes, NativeSingleQuote); + if Index >= 0 then + SetLength(Quotes, Index - 1) + else + Quotes := Quotes + NativeSingleQuote; + end; + + if (R[Position] = NativeDoubleQuote) then + begin + Index := JclStrings.CharPos(Quotes, NativeDoubleQuote); + if Index >= 0 then + SetLength(Quotes, Index - 1) + else + Quotes := Quotes + NativeDoubleQuote; + end; + + if (R[Position] = '`') then + begin + Index := JclStrings.CharPos(Quotes, '`'); + if Index >= 0 then + SetLength(Quotes, Index - 1) + else + Quotes := Quotes + '`'; + end; + + if Quotes = '' then + begin + if R[Position] = ')' then + begin + Dec(BraceCount); + if BraceCount = 0 then + Break; + end + else + if R[Position] = '(' then + Inc(BraceCount); + end; + Inc(Position); + end; + Result := Position <= Len; + +// Delphi XE's CodeGear.Delphi.Targets has a bug where the closing paran is missing +// "'$(DelphiWin32DebugDCUPath'!=''". But it is still a valid string and not worth +// an exception. +// +// if Position > Len then +// raise EJclMsBuildError.CreateResFmt(@RsEEndOfString, [S]); + end; + +var + Start, Position, Index: Integer; + PropertyName, PropertyValue, Path, Name: string; + Prop, Reg: Boolean; + Root: THandle; +begin + Result := S; + if Result <> '' then + begin + repeat + // start with the last match in order to convert $(some$(other)) + // evaluate properties + Start := StrLastPos('$(', Result); + if Start > 0 then + begin + Position := Start; + if not FindClosingBrace(Result, Position) then + Break; + PropertyName := Copy(Result, Start + 2, Position - Start - 2); + + Prop := True; + for Index := 1 to Length(PropertyName) do + if not CharIsValidIdentifierLetter(PropertyName[Index]) then + begin + Prop := False; + Break; + end; + if Prop then + PropertyValue := GetPropertyValue(PropertyName) + else + begin + Reg := Copy(PropertyName, 1, 9) = 'registry:'; + if Reg then + begin + PropertyName := Copy(PropertyName, 10, Length(PropertyName) - 9); + Index := CharPos(PropertyName, '\'); + Root := RootKeyValue(Copy(PropertyName, 1, Index - 1)); + PropertyName := Copy(PropertyName, Index + 1, Length(PropertyName) - Index); + Index := CharPos(PropertyName, '@'); + if Index >= 0 then + begin + Path := Copy(PropertyName, 1, Index - 1); + Name := Copy(PropertyName, Index + 1, Length(PropertyName) - Index); + end + else + begin + Path := PropertyName; + Name := ''; + end; + PropertyValue := EvaluateRegistryProperty(Root, Path, Name); + end + else + PropertyValue := EvaluateFunctionProperty(PropertyName); + end; + StrReplace(Result, + Copy(Result, Start, Position - Start + 1), // $(PropertyName) + PropertyValue, + [rfReplaceAll, rfIgnoreCase]) + end; + if Start = 0 then + begin + // evaluate item list + Start := StrLastPos('@(', Result); + if Start > 0 then + begin + Position := Start; + if not FindClosingBrace(Result, Position) then + raise EJclMsBuildError.CreateResFmt(@RsEEndOfString, [Result]); + PropertyName := Copy(Result, Start + 2, Position - Start - 2); + + PropertyValue := EvaluateList(PropertyName); + + StrReplace(Result, + Copy(Result, Start, Position - Start + 1), // @(PropertyName...) + PropertyValue, + [rfReplaceAll, rfIgnoreCase]) + end; + end; + until Start = 0; + // convert hexa to decimal + if Copy(Result, 1, 2) = '0x' then + Result := IntToStr(StrToInt64('$' + Copy(Result, 3, Length(Result) - 2))); + end; +end; + +function TJclMsBuildParser.EvaluateTransform(ItemList: TStrings; const Transform: string): string; +type + TVarRecArray = array of TVarRec; +const + WellKnownItemMetadataCount = 11; +var + UserDefinedMetadataNames: TStrings; + + function GetTransformPattern(const Transform: string): string; + var + Index, EndIndex, Num: Integer; + MetaDataName: string; + begin + Result := Transform; + StrReplace(Result, '%(FullPath)', '%0:s', [rfReplaceAll, rfIgnoreCase]); + StrReplace(Result, '%(RootDir)', '%1:s', [rfReplaceAll, rfIgnoreCase]); + StrReplace(Result, '%(Filename)', '%2:s', [rfReplaceAll, rfIgnoreCase]); + StrReplace(Result, '%(Extension)', '%3:s', [rfReplaceAll, rfIgnoreCase]); + StrReplace(Result, '%(RelativeDir)', '%4:s', [rfReplaceAll, rfIgnoreCase]); + StrReplace(Result, '%(Directory)', '%5:s', [rfReplaceAll, rfIgnoreCase]); + StrReplace(Result, '%(RecursiveDir)', '%6:s', [rfReplaceAll, rfIgnoreCase]); + StrReplace(Result, '%(Identity)', '%7:s', [rfReplaceAll, rfIgnoreCase]); + StrReplace(Result, '%(ModifiedTime)', '%8:s', [rfReplaceAll, rfIgnoreCase]); + StrReplace(Result, '%(CreatedTime)', '%9:s', [rfReplaceAll, rfIgnoreCase]); + StrReplace(Result, '%(AccessedTime)', '%10:s', [rfReplaceAll, rfIgnoreCase]); + + // replace user defined metadata + Num := WellKnownItemMetadataCount; + Index := Pos('%(', Result); + while Index <> 0 do + begin + EndIndex := StrSearch(')', Result, Index + 2); + MetaDataName := Copy(Result, Index + 2, EndIndex - Index - 2); + UserDefinedMetadataNames.Add(MetaDataName); + StrReplace(Result, '%(' + MetaDataName + ')', '%' + IntToStr(Num) + ':s', [rfReplaceAll, rfIgnoreCase]); + Inc(Num); + Index := StrSearch('%(', Result, Index); + end; + end; + + procedure GetTransformParameters(Item: TJclMsBuildItem; var Storage: TDynStringArray; + var Formats: TVarRecArray); + const + DateTimeFormat = 'yyyy-mm-dd hh:nn:ss.zzz'; + var + Index, DotIdx: Integer; + ItemFullInclude: string; + LocalDateTime: TDateTime; + begin + if Length(Formats) <> WellKnownItemMetadataCount + UserDefinedMetadataNames.Count then + begin + SetLength(Formats, WellKnownItemMetadataCount + UserDefinedMetadataNames.Count); + for Index := Low(Formats) to High(Formats) do + begin + {$IFDEF SUPPORTS_UNICODE} + Formats[Index].VType := vtPWideChar; + Formats[Index].VPWideChar := nil; + {$ELSE ~SUPPORTS_UNICODE} + Formats[Index].VType := vtPChar; + Formats[Index].VPChar := nil; + {$ENDIF ~SUPPORTS_UNICODE} + end; + end; + + if Length(Storage) <> WellKnownItemMetadataCount + UserDefinedMetadataNames.Count then + SetLength(Storage, WellKnownItemMetadataCount + UserDefinedMetadataNames.Count); + + ItemFullInclude := Item.ItemFullInclude; + + // %(FullPath) Contains the full path of the item. For example: + Storage[0] := ItemFullInclude; + + // %(RootDir) Contains the root directory of the item. For example: + if PathIsAbsolute(ItemFullInclude) and not PathIsUNC(ItemFullInclude) and + (ItemFullInclude <> '') and CharIsDriveLetter(ItemFullInclude[1]) then + Storage[1] := ItemFullInclude[1] + ':\' + else + Storage[1] := ''; + + // %(Filename) Contains the file name of the item, without the extension. For example: + Storage[2] := ChangeFileExt(ExtractFileName(Item.ItemInclude), ''); + + // %(Extension) Contains the file name extension of the item. For example: + Storage[3] := ExtractFileExt(Item.ItemInclude); + + // %(RelativeDir) Contains the path specified in the Include attribute, up to the final backslash (\). For example: + Storage[4] := PathAddSeparator(ExtractFilePath(Item.ItemInclude)); + + // %(Directory) Contains the directory of the item, without the root directory. For example: + Index := CharPos(ItemFullInclude, '\'); + if Index > 0 then + // skip the root + Index := CharPos(ItemFullInclude, '\', Index + 1); + if Index > 0 then + Storage[5] := Copy(ItemFullInclude, Index + 1, Length(ItemFullInclude) - Index) + else + Storage[5] := ''; + + // %(RecursiveDir) + Storage[6] := ''; // TODO: path expansion + + // %(Identity) The item specified in the Include attribute.. For example: + Storage[7] := Item.ItemInclude; + + // %(ModifiedTime) Contains the timestamp from the last time the item was modified. For example: + if GetFileLastWrite(ItemFullInclude, LocalDateTime) then + Storage[8] := FormatDateTime(DateTimeFormat, LocalDateTime) + else + Storage[8] := ''; + + // %(CreatedTime) Contains the timestamp from when the item was created. For example: + if GetFileCreation(ItemFullInclude, LocalDateTime) then + Storage[9] := FormatDateTime(DateTimeFormat, LocalDateTime) + else + Storage[9] := ''; + + // %(AccessedTime) Contains the timestamp from the last time the time was accessed. + if GetFileLastAccess(ItemFullInclude, LocalDateTime) then + Storage[10] := FormatDateTime(DateTimeFormat, LocalDateTime) + else + Storage[10] := ''; + + for Index := 0 to UserDefinedMetadataNames.Count - 1 do + begin + DotIdx := Pos('.', UserDefinedMetadataNames[Index]); + if DotIdx <> 0 then // references different item => batch + begin + Storage[WellKnownItemMetadataCount + Index] := ''; // not implemented yet. Outer loop must iterator over this item + end + else + Storage[WellKnownItemMetadataCount + Index] := Item.ItemMetaData.Values[UserDefinedMetadataNames[Index]]; + end; + + for Index := Low(Formats) to High(Formats) do + {$IFDEF SUPPORTS_UNICODE} + Formats[Index].VPWideChar := PChar(Storage[Index]); + {$ELSE ~SUPPORTS_UNICODE} + Formats[Index].VPChar := PChar(Storage[Index]); + {$ENDIF ~SUPPORTS_UNICODE} + end; + +var + Index: Integer; + TransformPattern, TransformResult: string; + TransformParameters: TVarRecArray; + TransformStorage: TDynStringArray; +begin + UserDefinedMetadataNames := TStringList.Create; + try + TransformPattern := GetTransformPattern(Transform); + + Result := ''; + for Index := 0 to ItemList.Count - 1 do + begin + GetTransformParameters(TJclMsBuildItem(ItemList.Objects[Index]), TransformStorage, TransformParameters); + TransformResult := Format(TransformPattern, TransformParameters); + if Result <> '' then + Result := Result + ';' + TransformResult + else + Result := TransformResult; + end; + finally + UserDefinedMetadataNames.Free; + end; +end; + +function TJclMsBuildParser.EvaluateFunctionProperty(const Command: string): string; +begin + if (not Assigned(FOnFunctionProperty) or not FOnFunctionProperty(Self, Command, Result)) and + (not IgnoreFunctionProperties) then + raise EJclMsBuildError.CreateResFmt(@RsEFunctionProperty, [Command]); +end; + +function TJclMsBuildParser.EvaluateList(const Name: string): string; +var + Index: Integer; + Transform: string; + List: TStrings; +begin + Index := Pos('->', Name); + if Index = 0 then + begin + // no transformation + List := TStringList.Create; + try + FindItemIncludes(Name, List); + Result := StringsToStr(List, ';', False); + finally + List.Free; + end; + end + else + begin + Transform := Copy(Name, Index + 2, Length(Name) - Index - 1); + Transform := StrTrimCharLeft(StrTrimCharRight(Transform, NativeSingleQuote), NativeSingleQuote); + List := TStringList.Create; + try + FindItemIncludes(Copy(Name, 1, Index - 1), List); + Result := EvaluateTransform(List, Transform); + finally + List.Free; + end; + end; +end; + +function TJclMsBuildParser.EvaluateRegistryProperty(Root: HKEY; const Path, Name: string): string; +begin + if (not Assigned(FOnRegistryProperty) or not FOnRegistryProperty(Self, Root, Path, Name, Result)) and + (not RegReadStringEx(Root, Path, Name, Result, False)) then + raise EJclMsBuildError.CreateResFmt(@RsERegistryProperty, [RootKeyName(Root), Path, Name]); +end; + +function TJclMsBuildParser.FindItemDefinition( + const ItemName: string): TJclMsBuildItem; +var + Index: Integer; +begin + for Index := 0 to FItemDefinitions.Count - 1 do + begin + Result := TJclMsBuildItem(FItemDefinitions.Items[Index]); + if SameItemName(Result.ItemName, ItemName) then + Exit; + end; + Result := nil; +end; + +procedure TJclMsBuildParser.FindItemIncludes(const ItemName: string; List: TStrings); +var + Index: Integer; + Item: TJclMsBuildItem; +begin + List.Clear; + List.BeginUpdate; + try + for Index := 0 to FItems.Count - 1 do + begin + Item := TJclMsBuildItem(FItems.Items[Index]); + if SameItemName(Item.ItemName, ItemName) then + List.AddObject(Item.ItemInclude, Item); + end; + finally + List.EndUpdate; + end; +end; + +function TJclMsBuildParser.FindTarget(const TargetName: string): TJclMsBuildTarget; +var + Index: Integer; +begin + for Index := 0 to FTargets.Count - 1 do + begin + Result := TJclMsBuildTarget(FTargets.Items[Index]); + if Result.TargetName = TargetName then + Exit; + end; + Result := nil; +end; + +class function TJclMsBuildParser.SameItemName(const ItemName1, ItemName2: string): Boolean; +begin + Result := SameText(ItemName1, ItemName2); +end; + +function TJclMsBuildParser.GetItem(Index: Integer): TJclMsBuildItem; +begin + Result := TJclMsBuildItem(FItems.Items[Index]); +end; + +function TJclMsBuildParser.GetItemCount: Integer; +begin + Result := FItems.Count; +end; + +function TJclMsBuildParser.GetItemDefinition( + Index: Integer): TJclMsBuildItem; +begin + Result := TJclMsBuildItem(FItemDefinitions.Items[Index]); +end; + +function TJclMsBuildParser.GetItemDefinitionCount: Integer; +begin + Result := FItemDefinitions.Count; +end; + +function TJclMsBuildParser.GetPropertyValue(const Name: string): string; +begin + Result := Properties.Values[Name]; +end; + +function TJclMsBuildParser.GetTarget(Index: Integer): TJclMsBuildTarget; +begin + Result := TJclMsBuildTarget(FTargets.Items[Index]); +end; + +function TJclMsBuildParser.GetTargetCount: Integer; +begin + Result := FTargets.Count; +end; + +function TJclMsBuildParser.GetUsingTask(Index: Integer): TJclMsBuildUsingTask; +begin + Result := TJclMsBuildUsingTask(FUsingTasks.Items[Index]); +end; + +function TJclMsBuildParser.GetUsingTaskCount: Integer; +begin + Result := FUsingTasks.Count; +end; + +procedure TJclMsBuildParser.Init; +begin + InitReservedProperties; + InitEnvironmentProperties; +end; + +procedure TJclMsBuildParser.InitEnvironmentProperties; +begin + Properties.EnvironmentProperties.Clear; + GetEnvironmentVars(Properties.EnvironmentProperties, True); + + // from http://msdn.microsoft.com/en-us/library/ms164309.aspx + + // MSBuildExtensionsPath + // can be overriden, not used by Embarcadero's project files + + // MSBuildExtensionsPath32 + // can be overriden, not used by Embarcadero's project files + + // MSBuildExtensionsPath64 + // can be overriden, not used by Embarcadero's project files +end; + +procedure TJclMsBuildParser.InitReservedProperties; +var + Index: Integer; + Path: string; + DotNetVersions: TStrings; +begin + Properties.ReservedProperties.Clear; + + // from http://msdn.microsoft.com/en-us/library/ms164309.aspx + + // MSBuildProjectDirectory + Properties.ReservedProperties.Values['MSBuildProjectDirectory'] := PathRemoveSeparator(ExtractFileDir(ProjectFileName)); + + // MSBuildProjectFile + Properties.ReservedProperties.Values['MSBuildProjectFile'] := ExtractFileName(ProjectFileName); + + // MSBuildProjectExtension + Properties.ReservedProperties.Values['MSBuildProjectExtension'] := ExtractFileExt(ProjectFileName); + + // MSBuildProjectFullPath + Properties.ReservedProperties.Values['MSBuildProjectFullPath'] := ProjectFileName; + + // MSBuildProjectName + Properties.ReservedProperties.Values['MSBuildProjectName'] := ChangeFileExt(ExtractFileName(ProjectFileName), ''); + + DotNetVersions := TStringList.Create; + try + TJclClrHost.GetClrVersions(DotNetVersions); + for Index := DotNetVersions.Count - 1 downto 0 do + begin + Path := DotNetVersions.Values[DotNetVersions.Names[Index]]; + if not FileExists(PathAddSeparator(Path) + 'MSBuild.exe') then + DotNetVersions.Delete(Index); + end; + + if DotNetVersion <> '' then + begin + Path := DotNetVersions.Values[DotNetVersion]; + // MSBuildToolsVersion + Properties.ReservedProperties.Values['MSBuildToolsVersion'] := DotNetVersion; + end + else + if DotNetVersions.Count > 0 then + begin + Path := DotNetVersions.Values[DotNetVersions.Names[0]]; + // MSBuildToolsVersion + Properties.ReservedProperties.Values['MSBuildToolsVersion'] := DotNetVersions.Names[0]; + end + else + Path := ''; + + if Path <> '' then + begin + // MSBuildBinPath + Properties.ReservedProperties.Values['MSBuildBinPath'] := Path; + // MSBuildToolsPath + Properties.ReservedProperties.Values['MSBuildToolsPath'] := Path; + end + else + raise EJclMsBuildError.CreateRes(@RsEMSBuildPath); + finally + DotNetVersions.Free; + end; + + // MSBuildProjectDefaultTargets + // postponed to the ParseProject + + // MSBuildExtensionsPath + // in the environment variables + + // MSBuildExtensionsPath32 + // in the environment variables + + // MSBuildExtensionsPath64 + // in the environment variables + + // MSBuildStartupDirectory + if WorkingDirectory <> '' then + Path := PathRemoveSeparator(WorkingDirectory) + else + Path := PathRemoveSeparator(ExtractFilePath(ProjectFileName)); + Properties.ReservedProperties.Values['MSBuildStartupDirectory'] := Path; + + // MSBuildNodeCount + Properties.ReservedProperties.Values['MSBuildNodeCount'] := '1'; + + // MSBuildLastTaskResult + Properties.ReservedProperties.Values['MSBuildLastTaskResult'] := 'true'; + + // MSBuildOverrideTasksPath + // supported only in .net 4.0 + + // MSBuildProgramFiles32 + Path := GetSpecialFolderLocation(CSIDL_PROGRAM_FILESX86); + if Path = '' then + Path := GetSpecialFolderLocation(CSIDL_PROGRAM_FILES); + Properties.ReservedProperties.Values['MSBuildProgramFiles32'] := Path; + + // MSBuildProjectDirectoryNoRoot + Path := PathRemoveSeparator(ExtractFilePath(ProjectFileName)); + if PathIsAbsolute(Path) and not PathIsUNC(Path) and (Path <> '') and CharIsDriveLetter(Path[1]) then + Path := Copy(Path, 3, Length(Path) - 2); + Properties.ReservedProperties.Values['MSBuildProjectDirectoryNoRoot'] := Path; + + // MSBuildThisFile + Properties.ReservedProperties.Values['MSBuildThisFile'] := CurrentFileName; + + // MSBuildThisFileDirectory + Properties.ReservedProperties.Values['MSBuildThisFileDirectory'] := PathRemoveSeparator(ExtractFilePath(CurrentFileName)); +end; + +procedure TJclMsBuildParser.Parse; +begin + FFirstPropertyGroup := nil; + FProjectExtensions := nil; + FCurrentFileName := FProjectFileName; + ParseXml(FXml); +end; + +procedure TJclMsBuildParser.ParseChoose(XmlElem: TJclSimpleXmlElem); +var + Index: Integer; + Prop: TJclSimpleXmlProp; + SubElem: TJclSimpleXmlElem; + Executed, _Otherwise: Boolean; +begin + for Index := 0 to XmlElem.PropertyCount - 1 do + begin + Prop := XmlElem.Properties.Item[Index]; + raise EJclMsBuildError.CreateResFmt(@RsEUnknownProperty, [Prop.Name]); + end; + + Executed := False; + _Otherwise := False; + + for Index := 0 to XmlElem.ItemCount - 1 do + begin + SubElem := XmlElem.Items.Item[Index]; + if SubElem.Name = 'When' then + Executed := ParseWhen(SubElem, Executed) + else + if SubElem.Name = 'Otherwise' then + begin + if _Otherwise then + raise EJclMsBuildError.CreateRes(@RsEMultipleOtherwise); + _Otherwise := True; + Executed := ParseOtherwise(SubElem, Executed); + end + else + if not (SubElem is TJclSimpleXMLElemComment) then + raise EJclMsBuildError.CreateResFmt(@RsEUnknownElement, [SubElem.Name]); + end; +end; + +function TJclMsBuildParser.ParseCondition(const Condition: string): Boolean; +var + Position, Len: Integer; +begin + Len := Length(Condition); + Position := 1; + Result := ParseConditionLength(Condition, Position, Len); +end; + +function TJclMsBuildParser.ParseConditionLength(const Condition: string; var Position: Integer; Len: Integer): Boolean; +type + TOperator = (opUnknown, opAnd, opOr); +var + LeftOperand, RightOperand: Boolean; + MiddleOperator: TOperator; +begin + Result := True; + if Condition <> '' then + begin + // read first word + LeftOperand := ParseConditionOperand(Condition, Position, Len); + if (Position <= Len) and (Condition[Position] = '(') then + begin + // skip opening parenthesis + Inc(Position); + LeftOperand := ParseConditionLength(Condition, Position, Len); + while (Position <= Len) and CharIsWhiteSpace(Condition[Position]) do + Inc(Position); + if Condition[Position] <> ')' then + raise EJclMsBuildError.CreateResFmt(@RsEMissingParenthesis, [Condition]); + // skip closing parenthesis + Inc(Position); + end; + while (Position <= Len) and CharIsWhiteSpace(Condition[Position]) do + Inc(Position); + while True do + begin + // read infix operator + MiddleOperator := opUnknown; + if ((Position + 2) <= Len) and (MiddleOperator = opUnknown) then + begin + if ((Condition[Position] = 'A') or (Condition[Position] = 'a')) and + ((Condition[Position + 1] = 'N') or (Condition[Position + 1] = 'n')) and + ((Condition[Position + 2] = 'D') or (Condition[Position + 2] = 'd')) then + MiddleOperator := opAnd; + if MiddleOperator <> opUnknown then + Inc(Position, 3); + end; + if ((Position + 1) <= Len) and (MiddleOperator = opUnknown) then + begin + if ((Condition[Position] = 'O') or (Condition[Position] = 'o')) and + ((Condition[Position + 1] = 'R') or (Condition[Position + 1] = 'r')) then + MiddleOperator := opOr; + if MiddleOperator <> opUnknown then + Inc(Position, 2); + end; + if MiddleOperator <> opUnknown then + begin + // read right operand if any + RightOperand := ParseConditionOperand(Condition, Position, Len); + if (Position <= Len) and (Condition[Position] = '(') then + begin + // skip opening parenthesis + Inc(Position); + RightOperand := ParseConditionLength(Condition, Position, Len); + while (Position <= Len) and CharIsWhiteSpace(Condition[Position]) do + Inc(Position); + if Condition[Position] <> ')' then + raise EJclMsBuildError.CreateResFmt(@RsEMissingParenthesis, [Condition]); + // skip closing parenthesis + Inc(Position); + end; + while (Position <= Len) and CharIsWhiteSpace(Condition[Position]) do + Inc(Position); + + case MiddleOperator of + opUnknown: + raise EJclMsBuildError.CreateResFmt(@RsEUnknownOperator, [Condition]); + opAnd: + LeftOperand := LeftOperand and RightOperand; + opOr: + LeftOperand := LeftOperand or RightOperand; + end; + end + else + Break; + end; + // no second word + Result := LeftOperand + end; +end; + +function TJclMsBuildParser.ParseConditionOperand(const Condition: string; var Position: Integer; Len: Integer): Boolean; +type + TOperator = (opUnknown, opEqual, opNotEqual, opLess, opLessOrEqual, opGreater, OpGreaterOrEqual); +var + LeftString, RightString: string; + MiddleOperator: TOperator; +begin + Result := True; + if Condition <> '' then + begin + // read first word + LeftString := ParseConditionString(Condition, Position, Len); + if (LeftString = '') and (Position <= Len) and (Condition[Position] = '(') then + begin + // skip opening parenthesis + Inc(Position); + LeftString := BoolToStr(ParseConditionLength(Condition, Position, Len), True); + while (Position <= Len) and CharIsWhiteSpace(Condition[Position]) do + Inc(Position); + if Condition[Position] <> ')' then + raise EJclMsBuildError.CreateResFmt(@RsEMissingParenthesis, [Condition]); + // skip closing parenthesis + Inc(Position); + end; + while (Position <= Len) and CharIsWhiteSpace(Condition[Position]) do + Inc(Position); + // read infix operator + MiddleOperator := opUnknown; + if ((Position + 1) <= Len) and (MiddleOperator = opUnknown) then + begin + if (Condition[Position] = '=') and (Condition[Position + 1] = '=') then + MiddleOperator := opEqual + else + if (Condition[Position] = '!') and (Condition[Position + 1] = '=') then + MiddleOperator := opNotEqual + else + if (Condition[Position] = '<') and (Condition[Position + 1] = '=') then + MiddleOperator := opLessOrEqual + else + if (Condition[Position] = '>') and (Condition[Position + 1] = '=') then + MiddleOperator := OpGreaterOrEqual; + if MiddleOperator <> opUnknown then + Inc(Position, 2); + end; + if (Position <= Len) and (MiddleOperator = opUnknown) then + begin + if Condition[Position] = '<' then + MiddleOperator := opLess + else + if Condition[Position] = '>' then + MiddleOperator := opGreater; + if MiddleOperator <> opUnknown then + Inc(Position); + end; + if MiddleOperator <> opUnknown then + begin + // read right operand if needed + RightString := ParseConditionString(Condition, Position, Len); + if (RightString = '') and (Position <= Len) and (Condition[Position] = '(') then + begin + // skip opening parenthesis + Inc(Position); + RightString := BoolToStr(ParseConditionLength(Condition, Position, Len), True); + while (Position <= Len) and CharIsWhiteSpace(Condition[Position]) do + Inc(Position); + if Condition[Position] <> ')' then + raise EJclMsBuildError.CreateResFmt(@RsEMissingParenthesis, [Condition]); + // skip closing parenthesis + Inc(Position); + end; + while (Position <= Len) and CharIsWhiteSpace(Condition[Position]) do + Inc(Position); + + case MiddleOperator of + opUnknown: + raise EJclMsBuildError.CreateResFmt(@RsEUnknownOperator, [Condition]); + opEqual: + Result := LeftString = RightString; + opNotEqual: + Result := LeftString <> RightString; + opLess: + Result := StrToInt64(LeftString) < StrToInt64(RightString); + opLessOrEqual: + Result := StrToInt64(LeftString) <= StrToInt64(RightString); + opGreater: + Result := StrToInt64(LeftString) > StrToInt64(RightString); + OpGreaterOrEqual: + Result := StrToInt64(LeftString) >= StrToInt64(RightString); + end; + end + else + if LeftString = '' then + Result := True + else + // no second word + Result := StrToBool(LeftString) + end; +end; + +function TJclMsBuildParser.ParseConditionString(const Condition: string; var Position: Integer; Len: Integer): string; +var + StartPos, EndPos: Integer; + HasQuote: Boolean; + FileOrDirectory: string; +begin + // skip heading spaces + while (Position <= Len) and CharIsWhiteSpace(Condition[Position]) do + Inc(Position); + StartPos := Position; + HasQuote := Condition[Position] = NativeSingleQuote; + if HasQuote then + begin + // skip heading quote + Inc(StartPos); + Inc(Position); + // quoted string + while (Position <= Len) and (Condition[Position] <> NativeSingleQuote) do + Inc(Position); + if Position > Len then + raise EJclMsBuildError.CreateResFmt(@RsEEndOfString, [Condition]); + EndPos := Position; + // skip closing quote + Inc(Position); + end + else + begin + // alphanumeric strings do not need to be quoted + while (Position <= Len) and CharIsValidIdentifierLetter(Condition[Position]) do + Inc(Position); + EndPos := Position; + end; + Result := Copy(Condition, StartPos, EndPos - StartPos); + + // evaluate builtin operators and functions + if (Result = '') and (Condition[StartPos] = '!') and not HasQuote then + begin + Inc(Position); + Result := BoolToStr(not ParseConditionLength(Condition, Position, Len)); + end + else + if (CompareText(Result, 'Exists') = 0) and not HasQuote then + begin + while (Position <= Len) and CharIsWhiteSpace(Condition[Position]) do + Inc(Position); + // skip opening parenthesis + if Condition[Position] <> '(' then + raise EJclMsBuildError.CreateResFmt(@RsEMissingParenthesis, [Condition]); + Inc(Position); + FileOrDirectory := ParseConditionString(Condition, Position, Len); + Result := BoolToStr(FileExists(FileOrDirectory) or DirectoryExists(FileOrDirectory), True); + while (Position <= Len) and CharIsWhiteSpace(Condition[Position]) do + Inc(Position); + // skip inner $(xxxx) inside an outer Exists( ) - Necessary, starting with XE8. + if (Position <= Len) and (Condition[Position] = '$') then + Inc(Position); + if (Position <= Len) and (Condition[Position] = '(') then + while (Position <= Len) do + begin + Inc(Position); + if Condition[Position-1] = ')' then + Break; + end; + // skip closing parenthesis + if Condition[Position] <> ')' then + raise EJclMsBuildError.CreateResFmt(@RsEMissingParenthesis, [Condition]); + Inc(Position); + end + else + if (CompareText(Result, 'HasTrailingSlash') = 0) and not HasQuote then + begin + while (Position <= Len) and CharIsWhiteSpace(Condition[Position]) do + Inc(Position); + // skip opening parenthesis + if Condition[Position] <> '(' then + raise EJclMsBuildError.CreateResFmt(@RsEMissingParenthesis, [Condition]); + Inc(Position); + FileOrDirectory := ParseConditionString(Condition, Position, Len); + Result := BoolToStr((FileOrDirectory <> '') and (FileOrDirectory[Length(FileOrDirectory)] = PathDelim), True); + while (Position <= Len) and CharIsWhiteSpace(Condition[Position]) do + Inc(Position); + // skip closing parenthesis + if Condition[Position] <> ')' then + raise EJclMsBuildError.CreateResFmt(@RsEMissingParenthesis, [Condition]); + Inc(Position); + end + else + Result := EvaluateString(Result); + // skip tailing spaces + while (Position <= Len) and CharIsWhiteSpace(Condition[Position]) do + Inc(Position); +end; + +procedure TJclMsBuildParser.ParseImport(XmlElem: TJclSimpleXmlElem); +var + Index: Integer; + Prop: TJclSimpleXMLProp; + SubElem, OldProjectExtensions: TJclSimpleXmlElem; + Condition: Boolean; + Project: TFileName; + SubXml: TJclSimpleXml; + SubOwnsXml: Boolean; + OldCurrentFileName: TFileName; +begin + Condition := True; + + for Index := 0 to XmlElem.PropertyCount - 1 do + begin + Prop := XmlElem.Properties.Item[Index]; + if Prop.Name = 'Condition' then + Condition := ParseCondition(Prop.Value) + else + if Prop.Name = 'Project' then + Project := TFileName(EvaluateString(Prop.Value)) + else + raise EJclMsBuildError.CreateResFmt(@RsEUnknownProperty, [Prop.Name]); + end; + + for Index := 0 to XmlElem.ItemCount - 1 do + begin + SubElem := XmlElem.Items.Item[Index]; + if not (SubElem is TJclSimpleXMLElemComment) then + raise EJclMsBuildError.CreateResFmt(@RsEUnknownElement, [SubElem.Name]); + end; + + if Condition then + begin + SubXml := nil; + SubOwnsXml := False; + + if not PathIsAbsolute(Project) then + Project := PathCanonicalize(PathGetRelativePath(ExtractFilePath(CurrentFileName), Project)); + + if Assigned(FOnImport) then + FOnImport(Self, Project, SubXml, SubOwnsXml); + + if (Project <> '') or (SubXml <> nil) then // abort if both are not assigned + try + if not Assigned(SubXml) then + begin + SubXml := TJclSimpleXML.Create; + SubXml.Options := SubXml.Options - [sxoAutoEncodeValue,sxoAutoEncodeEntity]; + SubXml.OnEncodeValue := XMLEncodeValue; + SubXml.OnDecodeValue := XMLDecodeValue; + SubXml.LoadFromFile(Project); + SubOwnsXml := True; + end; + + OldCurrentFileName := CurrentFileName; + OldProjectExtensions := ProjectExtensions; + try + FCurrentFileName := Project; + FProjectExtensions := nil; + InitReservedProperties; + ParseXml(SubXml); + finally + FCurrentFileName := OldCurrentFileName; + FProjectExtensions := OldProjectExtensions; + InitReservedProperties; + end; + + finally + if SubOwnsXml then + SubXml.Free; + end; + + end; +end; + +procedure TJclMsBuildParser.ParseImportGroup(XmlElem: TJclSimpleXmlElem); +var + Index: Integer; + Prop: TJclSimpleXMLProp; + SubElem: TJclSimpleXmlElem; + Condition: Boolean; +begin + Condition := True; + + for Index := 0 to XmlElem.PropertyCount - 1 do + begin + Prop := XmlElem.Properties.Item[Index]; + if Prop.Name = 'Condition' then + Condition := ParseCondition(Prop.Value) + else + raise EJclMsBuildError.CreateResFmt(@RsEUnknownProperty, [Prop.Name]); + end; + + for Index := 0 to XmlElem.ItemCount - 1 do + begin + SubElem := XmlElem.Items.Item[Index]; + if SubElem.Name = 'Import' then + begin + if Condition then + ParseImport(SubElem); + end + else + if not (SubElem is TJclSimpleXMLElemComment) then + raise EJclMsBuildError.CreateResFmt(@RsEUnknownElement, [SubElem.Name]); + end; +end; + +procedure TJclMsBuildParser.ParseItem(XmlElem: TJclSimpleXmlElem; Definition: Boolean); +var + Index: Integer; + Prop: TJclSimpleXMLProp; + SubElem: TJclSimpleXmlElem; + Condition: Boolean; + Item: TJclMsBuildItem; + ItemName, ItemExclude, ItemInclude, ItemRemove: string; +begin + Condition := True; + + ItemName := XmlElem.Name; + + for Index := 0 to XmlElem.PropertyCount - 1 do + begin + Prop := XmlElem.Properties.Item[Index]; + if Prop.Name = 'Condition' then + Condition := ParseCondition(Prop.Value) + else + if Prop.Name = 'Exclude' then + ItemExclude := EvaluateString(Prop.Value) + else + if Prop.Name = 'Include' then + ItemInclude := EvaluateString(Prop.Value) + else + if Prop.Name = 'Remove' then + ItemRemove := EvaluateString(Prop.Value) + else + raise EJclMsBuildError.CreateResFmt(@RsEUnknownProperty, [Prop.Name]); + end; + + if Condition then + begin + Item := TJclMsBuildItem.Create; + Item.FItemName := ItemName; + Item.FItemInclude := ItemInclude; + Item.FItemExclude := ItemExclude; + Item.FItemRemove := ItemRemove; + + if PathIsAbsolute(ItemInclude) then + Item.FItemFullInclude := ItemInclude + else + if PathIsAbsolute(CurrentFileName) then + Item.FItemFullInclude := PathCanonicalize(PathGetRelativePath(ExtractFilePath(CurrentFileName), ItemInclude)) + else + Item.FItemFullInclude := PathCanonicalize(PathGetRelativePath(WorkingDirectory, ItemInclude)); + if not FileExists(Item.FItemFullInclude) then + Item.FItemFullInclude := Item.FItemInclude; + + if Definition then + FItemDefinitions.Add(Item) + else + FItems.Add(Item); + + for Index := 0 to XmlElem.ItemCount - 1 do + begin + SubElem := XmlElem.Items.Item[Index]; + ParseItemMetaData(SubElem, Item.ItemMetaData); + end; + end; +end; + +procedure TJclMsBuildParser.ParseItemDefinitionGroup(XmlElem: TJclSimpleXmlElem); +var + Index: Integer; + Prop: TJclSimpleXMLProp; + SubElem: TJclSimpleXmlElem; + Condition: Boolean; +begin + Condition := True; + + for Index := 0 to XmlElem.PropertyCount - 1 do + begin + Prop := XmlElem.Properties.Item[Index]; + if Prop.Name = 'Condition' then + Condition := ParseCondition(Prop.Value) + else + raise EJclMsBuildError.CreateResFmt(@RsEUnknownProperty, [Prop.Name]); + end; + + if Condition then + for Index := 0 to XmlElem.ItemCount - 1 do + begin + SubElem := XmlElem.Items.Item[Index]; + ParseItem(SubElem, True); + end; +end; + +procedure TJclMsBuildParser.ParseItemGroup(XmlElem: TJclSimpleXmlElem); +var + Index: Integer; + Prop: TJclSimpleXMLProp; + SubElem: TJclSimpleXmlElem; + Condition: Boolean; +begin + Condition := True; + + for Index := 0 to XmlElem.PropertyCount - 1 do + begin + Prop := XmlElem.Properties.Item[Index]; + if Prop.Name = 'Condition' then + Condition := ParseCondition(Prop.Value) + else + raise EJclMsBuildError.CreateResFmt(@RsEUnknownProperty, [Prop.Name]); + end; + + if Condition then + for Index := 0 to XmlElem.ItemCount - 1 do + begin + SubElem := XmlElem.Items.Item[Index]; + ParseItem(SubElem, False); + end; +end; + +procedure TJclMsBuildParser.ParseItemMetaData(XmlElem: TJclSimpleXmlElem; ItemMetaData: TStrings); +var + Index: Integer; + Prop: TJclSimpleXMLProp; + Condition: Boolean; +begin + Condition := True; + + for Index := 0 to XmlElem.PropertyCount - 1 do + begin + Prop := XmlElem.Properties.Item[Index]; + if Prop.Name = 'Condition' then + Condition := ParseCondition(Prop.Value) + else + raise EJclMsBuildError.CreateResFmt(@RsEUnknownProperty, [Prop.Name]); + end; + + if Condition then + ItemMetaData.Values[XmlElem.Name] := EvaluateString(XmlElem.Value); +end; + +procedure TJclMsBuildParser.ParseOnError(XmlElem: TJclSimpleXMLElem; Target: TJclMsBuildTarget); +var + Index: Integer; + Prop: TJclSimpleXMLProp; + SubElem: TJclSimpleXmlElem; + Condition: Boolean; + ExecuteTargets: string; + TempStrings: TStrings; +begin + Condition := True; + + for Index := 0 to XmlElem.PropertyCount - 1 do + begin + Prop := XmlElem.Properties.Item[Index]; + if Prop.Name = 'Condition' then + Condition := ParseCondition(Prop.Value) + else + if Prop.Name = 'ExecuteTargets' then + ExecuteTargets := EvaluateString(Prop.Value) + else + raise EJclMsBuildError.CreateResFmt(@RsEUnknownProperty, [Prop.Name]); + end; + + for Index := 0 to XmlElem.ItemCount - 1 do + begin + SubElem := XmlElem.Items.Item[Index]; + if not (SubElem is TJclSimpleXMLElemComment) then + raise EJclMsBuildError.CreateResFmt(@RsEUnknownElement, [SubElem.Name]); + end; + + if Condition then + begin + TempStrings := TStringList.Create; + try + StrToStrings(ExecuteTargets, ';', TempStrings, False); + Target.ErrorTargets.AddStrings(TempStrings); + finally + TempStrings.Free; + end; + end; +end; + +function TJclMsBuildParser.ParseOtherwise(XmlElem: TJclSimpleXmlElem; Skip: Boolean): Boolean; +var + Index: Integer; + Prop: TJclSimpleXMLProp; + SubElem: TJclSimpleXmlElem; +begin + for Index := 0 to XmlElem.PropertyCount - 1 do + begin + Prop := XmlElem.Properties.Item[Index]; + raise EJclMsBuildError.CreateResFmt(@RsEUnknownProperty, [Prop.Name]); + end; + + Result := not Skip; + + for Index := 0 to XmlElem.ItemCount - 1 do + begin + SubElem := XmlElem.Items.Item[Index]; + if SubElem.Name = 'Choose' then + begin + if Result then + ParseChoose(SubElem); + end + else + if SubElem.Name = 'ItemGroup' then + begin + if Result then + ParseItemGroup(SubElem); + end + else + if SubElem.Name = 'PropertyGroup' then + begin + if Result then + ParsePropertyGroup(SubElem); + end + else + if not (SubElem is TJclSimpleXMLElemComment) then + raise EJclMsBuildError.CreateResFmt(@RsEUnknownElement, [SubElem.Name]); + end; +end; + +procedure TJclMsBuildParser.ParseOutput(XmlElem: TJclSimpleXMLElem; Task: TJclMsBuildTask); +var + Index: Integer; + Prop: TJclSimpleXMLProp; + SubElem: TJclSimpleXmlElem; + Condition: Boolean; + TaskParameter, PropertyName, ItemName: string; + TaskOutput: TJclMsBuildTaskOutput; +begin + Condition := True; + + for Index := 0 to XmlElem.PropertyCount - 1 do + begin + Prop := XmlElem.Properties.Item[Index]; + if Prop.Name = 'Condition' then + Condition := ParseCondition(Prop.Value) + else + if Prop.Name = 'TaskParameter' then + TaskParameter := EvaluateString(Prop.Value) + else + if Prop.Name = 'PropertyName' then + PropertyName := EvaluateString(Prop.Value) + else + if Prop.Name = 'ItemName' then + ItemName := EvaluateString(Prop.Value) + else + raise EJclMsBuildError.CreateResFmt(@RsEUnknownProperty, [Prop.Name]); + end; + + for Index := 0 to XmlElem.ItemCount - 1 do + begin + SubElem := XmlElem.Items.Item[Index]; + if not (SubElem is TJclSimpleXMLElemComment) then + raise EJclMsBuildError.CreateResFmt(@RsEUnknownElement, [SubElem.Name]); + end; + + if TaskParameter = '' then + raise EJclMsBuildError.CreateRes(@RsEMissingTaskParameter); + + if (PropertyName = '') and (ItemName = '') then + raise EJclMsBuildError.CreateRes(@RsEMissingOutputName); + + if Condition then + begin + TaskOutput := TJclMsBuildTaskOutput.Create; + TaskOutput.FTaskParameter := TaskParameter; + TaskOutput.FPropertyName := PropertyName; + TaskOutput.FItemName := ItemName; + Task.AddOutput(TaskOutput); + end; +end; + +procedure TJclMsBuildParser.ParseParameter(XmlElem: TJclSimpleXMLElem; UsingTask: TJclMsBuildUsingTask); +var + Index: Integer; + Prop: TJclSimpleXMLProp; + SubElem: TJclSimpleXmlElem; + ParameterName, ParameterType: string; + Output, Required: Boolean; + Parameter: TJclMsBuildParameter; +begin + Output := False; + Required := False; + + ParameterName := XmlElem.Name; + + for Index := 0 to XmlElem.PropertyCount - 1 do + begin + Prop := XmlElem.Properties.Item[Index]; + if Prop.Name = 'ParameterType' then + ParameterType := EvaluateString(Prop.Value) + else + if Prop.Name = 'Output' then + Output := Prop.BoolValue + else + if Prop.Name = 'Required' then + Required := Prop.BoolValue + else + raise EJclMsBuildError.CreateResFmt(@RsEUnknownProperty, [Prop.Name]); + end; + + for Index := 0 to XmlElem.ItemCount - 1 do + begin + SubElem := XmlElem.Items.Item[Index]; + if not (SubElem is TJclSimpleXMLElemComment) then + raise EJclMsBuildError.CreateResFmt(@RsEUnknownElement, [SubElem.Name]); + end; + + Parameter := TJclMsBuildParameter.Create; + Parameter.FParameterName := ParameterName; + Parameter.FParameterType := ParameterType; + Parameter.FOutput := Output; + Parameter.FRequired := Required; + UsingTask.AddParameter(Parameter); +end; + +procedure TJclMsBuildParser.ParseParameterGroup(XmlElem: TJclSimpleXMLElem; UsingTask: TJclMsBuildUsingTask); +var + Index: Integer; + Prop: TJclSimpleXMLProp; + SubElem: TJclSimpleXmlElem; +begin + for Index := 0 to XmlElem.PropertyCount - 1 do + begin + Prop := XmlElem.Properties.Item[Index]; + raise EJclMsBuildError.CreateResFmt(@RsEUnknownProperty, [Prop.Name]); + end; + + for Index := 0 to XmlElem.ItemCount - 1 do + begin + SubElem := XmlElem.Items.Item[Index]; + ParseParameter(SubElem, UsingTask); + end; +end; + +procedure TJclMsBuildParser.ParseProject(XmlElem: TJclSimpleXmlElem); +var + Index: Integer; + Prop: TJclSimpleXMLProp; + SubElem: TJclSimpleXmlElem; + S: string; +begin + for Index := 0 to XmlElem.PropertyCount - 1 do + begin + Prop := XmlElem.Properties.Item[Index]; + if Prop.Name = 'InitialTargets' then + StrToStrings(EvaluateString(Prop.Value), ';', FInitialTargets, False) + else + if Prop.Name = 'DefaultTargets' then + begin + S := EvaluateString(Prop.Value); + Properties.ReservedProperties.Values['MSBuildProjectDefaultTargets'] := S; + StrToStrings(S, ';', FDefaultTargets, False) + end + else + if Prop.Name = 'ToolsVersion' then + begin + S := EvaluateString(Prop.Value); + if Assigned(FOnToolsVersion) then + FOnToolsVersion(Self, S); + FToolsVersion := S; + end + else + if Prop.Name = 'xmlns' then + begin + if Prop.Value <> 'http://schemas.microsoft.com/developer/msbuild/2003' then + raise EJclMsBuildError.CreateResFmt(@RsEUnknownSchema, [Prop.Value]); + end + else + raise EJclMsBuildError.CreateResFmt(@RsEUnknownProperty, [Prop.Name]); + end; + + for Index := 0 to XmlElem.ItemCount - 1 do + begin + SubElem := XmlElem.Items.Item[Index]; + if SubElem.Name = 'Choose' then + ParseChoose(SubElem) + else + if SubElem.Name = 'Import' then + ParseImport(SubElem) + else + if SubElem.Name = 'ImportGroup' then + ParseImportGroup(SubElem) + else + if SubElem.Name = 'ItemDefinitionGroup' then + ParseItemDefinitionGroup(SubElem) + else + if SubElem.Name = 'ItemGroup' then + ParseItemGroup(SubElem) + else + if SubElem.Name = 'ProjectExtensions' then + begin + if Assigned(FProjectExtensions) then + raise EJclMsBuildError.CreateRes(@RsEMultipleProjectExtensions); + FProjectExtensions := SubElem; + end + else + if SubElem.Name = 'PropertyGroup' then + begin + if (CurrentFileName = ProjectFileName) and not Assigned(FFirstPropertyGroup) then + FFirstPropertyGroup := SubElem; + ParsePropertyGroup(SubElem) + end + else + if SubElem.Name = 'Target' then + ParseTarget(SubElem) + else + if SubElem.Name = 'UsingTask' then + ParseUsingTask(SubElem) + else + if not (SubElem is TJclSimpleXMLElemComment) then + raise EJclMsBuildError.CreateResFmt(@RsEUnknownElement, [SubElem.Name]); + end; +end; + +procedure TJclMsBuildParser.ParseProperty(XmlElem: TJclSimpleXmlElem); +var + Index: Integer; + Prop: TJclSimpleXMLProp; + SubElem: TJclSimpleXmlElem; + Condition: Boolean; +begin + Condition := True; + + for Index := 0 to XmlElem.PropertyCount - 1 do + begin + Prop := XmlElem.Properties.Item[Index]; + if Prop.Name = 'Condition' then + Condition := ParseCondition(Prop.Value) + else + raise EJclMsBuildError.CreateResFmt(@RsEUnknownProperty, [Prop.Name]); + end; + + for Index := 0 to XmlElem.ItemCount - 1 do + begin + SubElem := XmlElem.Items.Item[Index]; + if not (SubElem is TJclSimpleXMLElemComment) and not (SubElem is TJclSimpleXMLElemText) then + begin + if SubElem.Name <> '' then + raise EJclMsBuildError.CreateResFmt(@RsEUnknownElement, [SubElem.Name]) + else + raise EJclMsBuildError.CreateResFmt(@RsEUnsupportedChildTypeInElement, [SubElem.ClassName, XMLElem.Name]) + end; + end; + + if Condition then + begin + SetPropertyValue(XmlElem.Name, EvaluateString(XmlElem.Value)); + // store the XML element for further modifications in the current file + if CurrentFileName = ProjectFileName then + begin + Index := Properties.IndexOfName(XmlElem.Name); + if Index >= 0 then + Properties.Objects[Index] := XmlElem; + end; + end; +end; + +procedure TJclMsBuildParser.ParsePropertyGroup(XmlElem: TJclSimpleXmlElem); +var + Index: Integer; + Prop: TJclSimpleXmlProp; + SubElem: TJclSimpleXmlElem; + Condition: Boolean; +begin + Condition := True; + + for Index := 0 to XmlElem.PropertyCount - 1 do + begin + Prop := XmlElem.Properties.Item[Index]; + if Prop.Name = 'Condition' then + Condition := ParseCondition(Prop.Value) + else + raise EJclMsBuildError.CreateResFmt(@RsEUnknownProperty, [Prop.Name]); + end; + + if Condition then + for Index := 0 to XmlElem.ItemCount - 1 do + begin + SubElem := XmlElem.Items.Item[Index]; + ParseProperty(SubElem); + end; +end; + +procedure TJclMsBuildParser.ParseTarget(XmlElem: TJclSimpleXMLElem); +var + Index: Integer; + Prop: TJclSimpleXMLProp; + SubElem: TJclSimpleXmlElem; + Condition, KeepDuplicateOutput: Boolean; + TargetName, Depends, Returns, Inputs, Outputs, BeforeTargets, AfterTargets: string; + Target: TJclMsBuildTarget; +begin + Condition := True; + KeepDuplicateOutput := False; + + for Index := 0 to XmlElem.PropertyCount - 1 do + begin + Prop := XmlElem.Properties.Item[Index]; + if Prop.Name = 'Condition' then + Condition := ParseCondition(Prop.Value) + else + if Prop.Name = 'Name' then + TargetName := EvaluateString(Prop.Value) + else + if Prop.Name = 'DependsOnTargets' then + Depends := EvaluateString(Prop.Value) + else + if Prop.Name = 'Returns' then + Returns := EvaluateString(Prop.Value) + else + if Prop.Name = 'Inputs' then + Inputs := EvaluateString(Prop.Value) + else + if Prop.Name = 'Outputs' then + Outputs := EvaluateString(Prop.Value) + else + if Prop.Name = 'BeforeTargets' then + BeforeTargets := EvaluateString(Prop.Value) + else + if Prop.Name = 'AfterTargets' then + AfterTargets := EvaluateString(Prop.Value) + else + if Prop.Name = 'KeepDuplicateOutputs' then + KeepDuplicateOutput := Prop.BoolValue + else + raise EJclMsBuildError.CreateResFmt(@RsEUnknownProperty, [Prop.Name]); + end; + + if TargetName = '' then + raise EJclMsBuildError.CreateRes(@RsEMissingTargetName); + + Target := TJclMsBuildTarget.Create; + FTargets.Add(Target); + + Target.FTargetName := TargetName; + StrToStrings(Depends, ';', Target.FDepends, False); + StrToStrings(Returns, ';', Target.FReturns, False); + StrToStrings(Inputs, ';', Target.FInputs, False); + StrToStrings(Outputs, ';', Target.FOutputs, False); + StrToStrings(BeforeTargets, ';', Target.FBeforeTargets, False); + StrToStrings(AfterTargets, ';', Target.FAfterTargets, False); + Target.FKeepDuplicateOutputs := KeepDuplicateOutput; + + if Condition then + for Index := 0 to XmlElem.ItemCount - 1 do + begin + SubElem := XmlElem.Items.Item[Index]; + if SubElem.Name = 'OnError' then + ParseOnError(SubElem, Target) + else + if (SubElem.Name = 'PropertyGroup') or (SubElem.Name = 'ItemGroup') then + // apparently targets can contain several other nodes + // see comments in http://msdn.microsoft.com/en-us/library/t50z2hka.aspx + // they should be ignored during the static analysis implemented in this parser + else + ParseTask(SubElem, Target); + end; +end; + +procedure TJclMsBuildParser.ParseTask(XmlElem: TJclSimpleXMLElem; Target: TJclMsBuildTarget); +var + Index: Integer; + Prop: TJclSimpleXMLProp; + SubElem: TJclSimpleXmlElem; + TaskName: string; + Condition, ContinueOnError: Boolean; + Task: TJclMsBuildTask; +begin + Condition := True; + ContinueOnError := False; + + TaskName := XmlElem.Name; + + for Index := 0 to XmlElem.PropertyCount - 1 do + begin + Prop := XmlElem.Properties.Item[Index]; + if Prop.Name = 'Condition' then + Condition := ParseCondition(Prop.Value) + else + if Prop.Name = 'ContinueOnError' then + ContinueOnError := Prop.BoolValue; + end; + + if Condition then + begin + Task := TJclMsBuildTask.Create; + Task.FTaskName := TaskName; + Task.FContinueOnError := ContinueOnError; + Target.AddTask(Task); + + for Index := 0 to XmlElem.PropertyCount - 1 do + begin + Prop := XmlElem.Properties.Item[Index]; + if (Prop.Name <> 'Condition') and (Prop.Name <> 'ContinueOnError') then + Task.Parameters.Values[Prop.Name] := EvaluateString(Prop.Value); + end; + + for Index := 0 to XmlElem.ItemCount - 1 do + begin + SubElem := XmlElem.Items.Item[Index]; + if SubElem.Name = 'Output' then + ParseOutput(SubElem, Task) + else + if not (SubElem is TJclSimpleXMLElemComment) then + raise EJclMsBuildError.CreateResFmt(@RsEUnknownElement, [SubElem.Name]); + end; + + end; +end; + +procedure TJclMsBuildParser.ParseTaskBody(XmlElem: TJclSimpleXMLElem; UsingTask: TJclMsBuildUsingTask); +var + Index: Integer; + Prop: TJclSimpleXMLProp; + SubElem: TJclSimpleXmlElem; + Evaluate: Boolean; +begin + Evaluate := False; + + for Index := 0 to XmlElem.PropertyCount - 1 do + begin + Prop := XmlElem.Properties.Item[Index]; + if Prop.Name = 'Evaluate' then + Evaluate := Prop.BoolValue + else + raise EJclMsBuildError.CreateResFmt(@RsEUnknownProperty, [Prop.Name]); + end; + + for Index := 0 to XmlElem.ItemCount - 1 do + begin + SubElem := XmlElem.Items.Item[Index]; + if not (SubElem is TJclSimpleXMLElemComment) then + raise EJclMsBuildError.CreateResFmt(@RsEUnknownElement, [SubElem.Name]); + end; + + if Evaluate then + UsingTask.FTaskBody := EvaluateString(XmlElem.Value) + else + UsingTask.FTaskBody := XmlElem.Value; +end; + +procedure TJclMsBuildParser.ParseUsingTask(XmlElem: TJclSimpleXmlElem); +var + Index: Integer; + Prop: TJclSimpleXmlProp; + SubElem: TJclSimpleXmlElem; + Condition: Boolean; + AssemblyName, AssemblyFile, TaskFactory, TaskName: string; + UsingTask: TJclMsBuildUsingTask; +begin + Condition := True; + + for Index := 0 to XmlElem.PropertyCount - 1 do + begin + Prop := XmlElem.Properties.Item[Index]; + if Prop.Name = 'Condition' then + Condition := ParseCondition(Prop.Value) + else + if Prop.Name = 'TaskName' then + TaskName := EvaluateString(Prop.Value) + else + if Prop.Name = 'TaskFactory' then + TaskFactory := EvaluateString(Prop.Value) + else + if Prop.Name = 'AssemblyName' then + AssemblyName := EvaluateString(Prop.Value) + else + if Prop.Name = 'AssemblyFile' then + AssemblyFile := EvaluateString(Prop.Value) + else + raise EJclMsBuildError.CreateResFmt(@RsEUnknownProperty, [Prop.Name]); + end; + + if TaskName = '' then + raise EJclMsBuildError.CreateRes(@RsEMissingTaskName); + + if (AssemblyName = '') and (AssemblyFile = '') then + raise EJclMsBuildError.CreateRes(@RsEMissingAssembly); + + if Condition then + begin + UsingTask := TJclMsBuildUsingTask.Create; + UsingTask.FAssemblyName := AssemblyName; + UsingTask.FAssemblyFile := AssemblyFile; + UsingTask.FTaskFactory := TaskFactory; + UsingTask.FTaskName := TaskName; + for Index := 0 to XmlElem.ItemCount - 1 do + begin + SubElem := XmlElem.Items.Item[Index]; + if SubElem.Name = 'ParameterGroup' then + ParseParameterGroup(SubElem, UsingTask) + else + if SubElem.Name = 'TaskBody' then + ParseTaskBody(SubElem, UsingTask) + else + if not (SubElem is TJclSimpleXMLElemComment) then + raise EJclMsBuildError.CreateResFmt(@RsEUnknownElement, [SubElem.Name]); + end; + FUsingTasks.Add(UsingTask); + end; +end; + +function TJclMsBuildParser.ParseWhen(XmlElem: TJclSimpleXmlElem; Skip: Boolean): Boolean; +var + Index: Integer; + Prop: TJclSimpleXmlProp; + SubElem: TJclSimpleXmlElem; +begin + Result := False; + + for Index := 0 to XmlElem.PropertyCount - 1 do + begin + Prop := XmlElem.Properties.Item[Index]; + if Prop.Name = 'Condition' then + Result := Skip or ParseCondition(Prop.Value) + else + raise EJclMsBuildError.CreateResFmt(@RsEUnknownProperty, [Prop.Name]); + end; + + if XmlElem.PropertyCount <> 1 then + raise EJclMsBuildError.CreateRes(@RsEConditionNotUnique); + + for Index := 0 to XmlElem.ItemCount - 1 do + begin + SubElem := XmlElem.Items.Item[Index]; + if SubElem.Name = 'Choose' then + begin + if Result then + ParseChoose(SubElem); + end + else + if SubElem.Name = 'ItemGroup' then + begin + if Result then + ParseItemGroup(SubElem); + end + else + if SubElem.Name = 'PropertyGroup' then + begin + if Result then + ParsePropertyGroup(SubElem); + end + else + if not (SubElem is TJclSimpleXMLElemComment) then + raise EJclMsBuildError.CreateResFmt(@RsEUnknownElement, [SubElem.Name]); + end; +end; + +procedure TJclMsBuildParser.ParseXml(AXml: TJclSimpleXML); +begin + if AXml.Root.Name <> 'Project' then + raise EJclMsBuildError.CreateResFmt(@RsENoProjectElem, [AXml.Root.Name]); + ParseProject(AXml.Root); +end; + +procedure TJclMsBuildParser.Save; +begin + Xml.SaveToFile(ProjectFileName); +end; + +procedure TJclMsBuildParser.SetPropertyValue(const Name, Value: string); +begin + Properties.Values[Name] := Value; +end; + +procedure TJclMsBuildParser.XMLDecodeValue(Sender: TObject; var Value: string); +begin + Value := XMLDecode(Value); +end; + +procedure TJclMsBuildParser.XMLEncodeValue(Sender: TObject; var Value: string); +begin + StrReplace(Value, '&', '&', [rfReplaceAll]); + StrReplace(Value, '<', '<', [rfReplaceAll]); + StrReplace(Value, '>', '>', [rfReplaceAll]); +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/JclMsdosSys.pas b/3rdParty/JCL/source/windows/JclMsdosSys.pas new file mode 100644 index 00000000..622fd9ae --- /dev/null +++ b/3rdParty/JCL/source/windows/JclMsdosSys.pas @@ -0,0 +1,663 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclMsdosSys.pas. } +{ } +{ The Initial Developer of the Original Code is Robert Marquardt } +{ Portions created by Robert Marquardt are Copyright (C) 2001 Robert Marquardt } +{ All Rights Reserved. } +{ } +{ Contributor(s): Robert Rossmair (IJclMsdosSys interface) } +{ } +{ You may retrieve the latest version of this file at the Project JEDI's Code Library home page, } +{ located at https://github.com/project-jedi/jcl } +{ } +{ Known Issues: None } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclMsdosSys; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.Classes, System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + Classes, SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +type + IJclMsdosSys = interface + ['{3E1C7E48-49E5-408B-86D2-9924D223B5C5}'] + // Property access methods + function GetAutoScan: Boolean; + function GetBootDelay: Cardinal; + function GetBootGUI: Boolean; + function GetBootKeys: Boolean; + function GetBootMenu: Boolean; + function GetBootMenuDefault: Cardinal; + function GetBootMenuDelay: Cardinal; + function GetBootMulti: Boolean; + function GetBootSafe: Boolean; + function GetBootWarn: Boolean; + function GetBootWin: Boolean; + function GetDBLSpace: Boolean; + function GetDoubleBuffer: Boolean; + function GetDRVSpace: Boolean; + function GetHostWinBootDrv: Char; + function GetLoadTop: Boolean; + function GetLogo: Boolean; + function GetNetwork: Boolean; + function GetUninstallDir: Char; + function GetWinBootDir: string; + function GetWinDir: string; + function GetWinVer: string; + procedure SetUninstallDir(AUninstallDir: Char); + procedure SetWinDir(AWinDir: string); + procedure SetWinBootDir(AWinBootDir: string); + procedure SetHostWinBootDrv(AHostWinBootDrv: Char); + procedure SetAutoScan(AAutoScan: Boolean); + procedure SetBootDelay(ABootDelay: Cardinal); + procedure SetBootGUI(ABootGUI: Boolean); + procedure SetBootKeys(ABootKeys: Boolean); + procedure SetBootMenu(ABootMenu: Boolean); + procedure SetBootMenuDefault(ABootMenuDefault: Cardinal); + procedure SetBootMenuDelay(ABootMenuDelay: Cardinal); + procedure SetBootMulti(ABootMulti: Boolean); + procedure SetBootSafe(ABootSafe: Boolean); + procedure SetBootWarn(ABootWarn: Boolean); + procedure SetBootWin(ABootWin: Boolean); + procedure SetDBLSpace(ADBLSpace: Boolean); + procedure SetDRVSpace(ADRVSpace: Boolean); + procedure SetDoubleBuffer(ADoubleBuffer: Boolean); + procedure SetLoadTop(ALoadTop: Boolean); + procedure SetLogo(ALogo: Boolean); + procedure SetNetwork(ANetwork: Boolean); + procedure SetWinVer(AWinVer: string); + procedure SetBool(var ANew: Boolean; AOld: Boolean); + procedure SetString(var ANew: string; AOld: string); + // Properties + property UninstallDir: Char read GetUninstallDir write SetUninstallDir; + property WinDir: string read GetWinDir write SetWinDir; + property WinBootDir: string read GetWinBootDir write SetWinBootDir; + property HostWinBootDrv: Char read GetHostWinBootDrv write SetHostWinBootDrv; + property AutoScan: Boolean read GetAutoScan write SetAutoScan; + property BootDelay: Cardinal read GetBootDelay write SetBootDelay; + property BootGUI: Boolean read GetBootGUI write SetBootGUI; + property BootKeys: Boolean read GetBootKeys write SetBootKeys; + property BootMenu: Boolean read GetBootMenu write SetBootMenu; + property BootMenuDefault: Cardinal read GetBootMenuDefault write SetBootMenuDefault; + property BootMenuDelay: Cardinal read GetBootMenuDelay write SetBootMenuDelay; + property BootMulti: Boolean read GetBootMulti write SetBootMulti; + property BootSafe: Boolean read GetBootSafe write SetBootSafe; + property BootWarn: Boolean read GetBootWarn write SetBootWarn; + property BootWin: Boolean read GetBootWin write SetBootWin; + property DBLSpace: Boolean read GetDBLSpace write SetDBLSpace; + property DRVSpace: Boolean read GetDRVSpace write SetDRVSpace; + property DoubleBuffer: Boolean read GetDoubleBuffer write SetDoubleBuffer; + property LoadTop: Boolean read GetLoadTop write SetLoadTop; + property Logo: Boolean read GetLogo write SetLogo; + property Network: Boolean read GetNetwork write SetNetwork; + property WinVer: string read GetWinVer write SetWinVer; + end; + +type + TJclMsdosSys = class(TInterfacedObject, IJclMsdosSys) + private + FUninstallDir: Char; + FWinDir: string; + FWinBootDir: string; + FHostWinBootDrv: Char; + FAutoScan: Boolean; + FBootDelay: Cardinal; + FBootGUI: Boolean; + FBootKeys: Boolean; + FBootMenu: Boolean; + FBootMenuDefault: Cardinal; + FBootMenuDelay: Cardinal; + FBootMulti: Boolean; + FBootSafe: Boolean; + FBootWarn: Boolean; + FBootWin: Boolean; + FDBLSpace: Boolean; + FDRVSpace: Boolean; + FDoubleBuffer: Boolean; + FLoadTop: Boolean; + FLogo: Boolean; + FNetwork: Boolean; + FWinVer: string; + public + constructor Create; + destructor Destroy; override; + { IJclMsdosSys } + function GetAutoScan: Boolean; + function GetBootDelay: Cardinal; + function GetBootGUI: Boolean; + function GetBootKeys: Boolean; + function GetBootMenu: Boolean; + function GetBootMenuDefault: Cardinal; + function GetBootMenuDelay: Cardinal; + function GetBootMulti: Boolean; + function GetBootSafe: Boolean; + function GetBootWarn: Boolean; + function GetBootWin: Boolean; + function GetDBLSpace: Boolean; + function GetDoubleBuffer: Boolean; + function GetDRVSpace: Boolean; + function GetHostWinBootDrv: Char; + function GetLoadTop: Boolean; + function GetLogo: Boolean; + function GetNetwork: Boolean; + function GetUninstallDir: Char; + function GetWinBootDir: string; + function GetWinDir: string; + function GetWinVer: string; + procedure SetUninstallDir(AUninstallDir: Char); + procedure SetWinDir(AWinDir: string); + procedure SetWinBootDir(AWinBootDir: string); + procedure SetHostWinBootDrv(AHostWinBootDrv: Char); + procedure SetAutoScan(AAutoScan: Boolean); + procedure SetBootDelay(ABootDelay: Cardinal); + procedure SetBootGUI(ABootGUI: Boolean); + procedure SetBootKeys(ABootKeys: Boolean); + procedure SetBootMenu(ABootMenu: Boolean); + procedure SetBootMenuDefault(ABootMenuDefault: Cardinal); + procedure SetBootMenuDelay(ABootMenuDelay: Cardinal); + procedure SetBootMulti(ABootMulti: Boolean); + procedure SetBootSafe(ABootSafe: Boolean); + procedure SetBootWarn(ABootWarn: Boolean); + procedure SetBootWin(ABootWin: Boolean); + procedure SetDBLSpace(ADBLSpace: Boolean); + procedure SetDRVSpace(ADRVSpace: Boolean); + procedure SetDoubleBuffer(ADoubleBuffer: Boolean); + procedure SetLoadTop(ALoadTop: Boolean); + procedure SetLogo(ALogo: Boolean); + procedure SetNetwork(ANetwork: Boolean); + procedure SetWinVer(AWinVer: string); + procedure SetBool(var ANew: Boolean; AOld: Boolean); + procedure SetString(var ANew: string; AOld: string); + procedure ReadMsdosSys; + procedure WriteMsdosSys; + property UninstallDir: Char read GetUninstallDir write SetUninstallDir; + property WinDir: string read GetWinDir write SetWinDir; + property WinBootDir: string read GetWinBootDir write SetWinBootDir; + property HostWinBootDrv: Char read GetHostWinBootDrv write SetHostWinBootDrv; + property AutoScan: Boolean read GetAutoScan write SetAutoScan; + property BootDelay: Cardinal read GetBootDelay write SetBootDelay; + property BootGUI: Boolean read GetBootGUI write SetBootGUI; + property BootKeys: Boolean read GetBootKeys write SetBootKeys; + property BootMenu: Boolean read GetBootMenu write SetBootMenu; + property BootMenuDefault: Cardinal read GetBootMenuDefault write SetBootMenuDefault; + property BootMenuDelay: Cardinal read GetBootMenuDelay write SetBootMenuDelay; + property BootMulti: Boolean read GetBootMulti write SetBootMulti; + property BootSafe: Boolean read GetBootSafe write SetBootSafe; + property BootWarn: Boolean read GetBootWarn write SetBootWarn; + property BootWin: Boolean read GetBootWin write SetBootWin; + property DBLSpace: Boolean read GetDBLSpace write SetDBLSpace; + property DRVSpace: Boolean read GetDRVSpace write SetDRVSpace; + property DoubleBuffer: Boolean read GetDoubleBuffer write SetDoubleBuffer; + property LoadTop: Boolean read GetLoadTop write SetLoadTop; + property Logo: Boolean read GetLogo write SetLogo; + property Network: Boolean read GetNetwork write SetNetwork; + property WinVer: string read GetWinVer write SetWinVer; + end; + + +function GetMsdosSys: IJclMsdosSys; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +const + cMsdosSys = 'C:\MSDOS.SYS'; + +function GetMsdosSys: IJclMsdosSys; +begin + Result := TJclMsdosSys.Create; +end; + +//=== { TJclMsdosSys } ======================================================= + +constructor TJclMsdosSys.Create; +begin + inherited Create; + ReadMsdosSys; +end; + +destructor TJclMsdosSys.Destroy; +begin + WriteMsdosSys; + inherited Destroy; +end; + +function TJclMsdosSys.GetAutoScan: Boolean; +begin + Result := FAutoScan; +end; + +function TJclMsdosSys.GetBootDelay: Cardinal; +begin + Result := FBootDelay; +end; + +function TJclMsdosSys.GetBootGUI: Boolean; +begin + Result := FBootGUI; +end; + +function TJclMsdosSys.GetBootMenu: Boolean; +begin + Result := FBootMenu; +end; + +function TJclMsdosSys.GetBootKeys: Boolean; +begin + Result := FBootKeys; +end; + +function TJclMsdosSys.GetBootMenuDefault: Cardinal; +begin + Result := FBootMenuDefault; +end; + +function TJclMsdosSys.GetBootMenuDelay: Cardinal; +begin + Result := FBootMenuDelay; +end; + +function TJclMsdosSys.GetBootMulti: Boolean; +begin + Result := FBootMulti; +end; + +function TJclMsdosSys.GetBootSafe: Boolean; +begin + Result := FBootSafe; +end; + +function TJclMsdosSys.GetBootWarn: Boolean; +begin + Result := FBootWarn; +end; + +function TJclMsdosSys.GetBootWin: Boolean; +begin + Result := FBootWin; +end; + +function TJclMsdosSys.GetDBLSpace: Boolean; +begin + Result := FDBLSpace; +end; + +function TJclMsdosSys.GetDoubleBuffer: Boolean; +begin + Result := FDoubleBuffer; +end; + +function TJclMsdosSys.GetDRVSpace: Boolean; +begin + Result := FDRVSpace; +end; + +function TJclMsdosSys.GetHostWinBootDrv: Char; +begin + Result := FHostWinBootDrv; +end; + +function TJclMsdosSys.GetLoadTop: Boolean; +begin + Result := FLoadTop; +end; + +function TJclMsdosSys.GetLogo: Boolean; +begin + Result := FLogo; +end; + +function TJclMsdosSys.GetNetwork: Boolean; +begin + Result := FNetWork; +end; + +function TJclMsdosSys.GetUninstallDir: Char; +begin + Result := FUninstallDir; +end; + +function TJclMsdosSys.GetWinBootDir: string; +begin + Result := FWinBootDir; +end; + +function TJclMsdosSys.GetWinDir: string; +begin + Result := FWinDir; +end; + +function TJclMsdosSys.GetWinVer: string; +begin + Result := FWinVer; +end; + +procedure TJclMsdosSys.SetUninstallDir(AUninstallDir: Char); +begin + if UninstallDir <> AUninstallDir then + begin + FUninstallDir := AUninstallDir; + WriteMsdosSys; + end; +end; + +procedure TJclMsdosSys.SetWinDir(AWinDir: string); +begin + SetString(FWinDir, AWinDir); +end; + +procedure TJclMsdosSys.SetWinBootDir(AWinBootDir: string); +begin + SetString(FWinBootDir, AWinBootDir); +end; + +procedure TJclMsdosSys.SetHostWinBootDrv(AHostWinBootDrv: Char); +begin + if HostWinBootDrv <> AHostWinBootDrv then + begin + FHostWinBootDrv := AHostWinBootDrv; + WriteMsdosSys; + end; +end; + +procedure TJclMsdosSys.SetAutoScan(AAutoScan: Boolean); +begin + SetBool(FAutoScan, AAutoScan); +end; + +procedure TJclMsdosSys.SetBootDelay(ABootDelay: Cardinal); +begin + if BootDelay <> ABootDelay then + begin + FBootDelay := ABootDelay; + WriteMsdosSys; + end; +end; + +procedure TJclMsdosSys.SetBootGUI(ABootGUI: Boolean); +begin + SetBool(FBootGUI, ABootGUI); +end; + +procedure TJclMsdosSys.SetBootKeys(ABootKeys: Boolean); +begin + SetBool(FBootKeys, ABootKeys); +end; + +procedure TJclMsdosSys.SetBootMenu(ABootMenu: Boolean); +begin + SetBool(FBootMenu, ABootMenu); +end; + +procedure TJclMsdosSys.SetBootMenuDefault(ABootMenuDefault: Cardinal); +begin + if BootMenuDefault <> ABootMenuDefault then + begin + FBootMenuDefault := ABootMenuDefault; + WriteMsdosSys; + end; +end; + +procedure TJclMsdosSys.SetBootMenuDelay(ABootMenuDelay: Cardinal); +begin + if BootMenuDelay <> ABootMenuDelay then + begin + FBootMenuDelay := ABootMenuDelay; + WriteMsdosSys; + end; +end; + +procedure TJclMsdosSys.SetBootMulti(ABootMulti: Boolean); +begin + SetBool(FBootMulti, ABootMulti); +end; + +procedure TJclMsdosSys.SetBootSafe(ABootSafe: Boolean); +begin + SetBool(FBootSafe, ABootSafe); +end; + +procedure TJclMsdosSys.SetBootWarn(ABootWarn: Boolean); +begin + SetBool(FBootWarn, ABootWarn); +end; + +procedure TJclMsdosSys.SetBootWin(ABootWin: Boolean); +begin + SetBool(FBootWin, ABootWin); +end; + +procedure TJclMsdosSys.SetDBLSpace(ADBLSpace: Boolean); +begin + SetBool(FDBLSpace, ADBLSpace); +end; + +procedure TJclMsdosSys.SetDRVSpace(ADRVSpace: Boolean); +begin + SetBool(FDRVSpace, ADRVSpace); +end; + +procedure TJclMsdosSys.SetDoubleBuffer(ADoubleBuffer: Boolean); +begin + SetBool(FDoubleBuffer, ADoubleBuffer); +end; + +procedure TJclMsdosSys.SetLoadTop(ALoadTop: Boolean); +begin + SetBool(FLoadTop, ALoadTop); +end; + +procedure TJclMsdosSys.SetLogo(ALogo: Boolean); +begin + SetBool(FLogo, ALogo); +end; + +procedure TJclMsdosSys.SetNetwork(ANetwork: Boolean); +begin + SetBool(FNetwork, ANetwork); +end; + +procedure TJclMsdosSys.SetWinVer(AWinVer: string); +begin + SetString(FWinVer, AWinVer); +end; + +procedure TJclMsdosSys.SetBool(var ANew: Boolean; AOld: Boolean); +begin + if ANew <> AOld then + begin + ANew := AOld; + WriteMsdosSys; + end; +end; + +procedure TJclMsdosSys.SetString(var ANew: string; AOld: string); +begin + if ANew <> AOld then + begin + ANew := AOld; + WriteMsdosSys; + end; +end; + +procedure TJclMsdosSys.ReadMsdosSys; +var + List: TStringList; + Value: string; + + function BoolVal(const Name: string; const Def: Boolean): Boolean; + var + Val: string; + begin + Result := Def; + Val := Trim(List.Values[Name]); + if Val <> '' then + if Val[1] = '0' then + Result := False + else + if Val[1] = '1' then + Result := True; + end; + +begin + FUninstallDir := #0; + FHostWinBootDrv := #0; + List := TStringList.Create; + try + List.LoadFromFile(cMsDosSys); + Value := Trim(List.Values['UninstallDir']); + if Value <> '' then + FUninstallDir := Value[1]; + FWinDir := Trim(List.Values['WinDir']); + FWinBootDir := Trim(List.Values['WinBootDir']); + Value := Trim(List.Values['HostWinBootDrv']); + if Value <> '' then + FHostWinBootDrv := Value[1]; + + FAutoScan := BoolVal('AutoScan', True); + FBootDelay := StrToIntDef(Trim(List.Values['BootDelay']), 2); + FBootGUI := BoolVal('BootGUI', True); + FBootKeys := BoolVal('BootKeys', True); + FBootMenu := BoolVal('BootMenu', False); + FBootMenuDefault := StrToIntDef(Trim(List.Values['BootMenuDefault']), 1); + FBootMenuDelay := StrToIntDef(Trim(List.Values['BootMenuDelay']), 30); + FBootMulti := BoolVal('BootMulti', False); + FBootSafe := BoolVal('BootSafe', False); + FBootWarn := BoolVal('BootWarn', True); + FBootWin := BoolVal('BootWin', True); + FDBLSpace := BoolVal('DBLSpace', True); + FDRVSpace := BoolVal('DRVSpace', True); + FDoubleBuffer := BoolVal('DoubleBuffer', False); + FLoadTop := BoolVal('LoadTop', True); + FLogo := BoolVal('Logo', True); + FNetwork := BoolVal('Network', False); + FWinVer := Trim(List.Values['WinVer']); + finally + List.Free; + end; +end; + +procedure TJclMsdosSys.WriteMsdosSys; +var + Attributes: Integer; + I: Char; + Line: string; +begin + if not FileExists(cMsDosSys) then + Exit; + with TStringList.Create do + try + Add('[Paths]'); + if UninstallDir <> #0 then + Add('UninstallDir=' + UninstallDir); + if WinDir <> '' then + Add('WinDir=' + WinDir); + if WinBootDir <> '' then + Add('WinBootDir=' + WinBootDir); + if HostWinBootDrv <> #0 then + Add('HostWinBootDrv=' + HostWinBootDrv); + Add(''); + + Add('[Options]'); + if not AutoScan then + Add('AutoScan=0'); + if BootDelay <> 2 then + Add('BootDelay=' + IntToStr(BootDelay)); + if not BootGUI then + Add('BootGUI=0'); + if not BootKeys then + Add('BootKeys=0'); + if BootMenu then + Add('BootMenu=1'); + if BootMenuDefault <> 1 then + Add('BootMenuDefault=' + IntToStr(BootMenuDefault)); + if BootMenuDelay <> 30 then + Add('BootMenuDelay=' + IntToStr(BootMenuDelay)); + if BootMulti then + Add('BootMulti=1'); + if BootSafe then + Add('BootSafe=1'); + if not BootWarn then + Add('BootWarn=0'); + if not BootWin then + Add('BootWin=0'); + if not DBLSpace then + Add('DBLSpace=0'); + if not DRVSpace then + Add('DRVSpace=0'); + if DoubleBuffer then + Add('DoubleBuffer=1'); + if not LoadTop then + Add('LoadTop=0'); + if not Logo then + Add('Logo=0'); + if Network then + Add('Network=1'); + if WinVer <> '' then + Add('WinVer=' + WinVer); + + Add(';'); + Add(';The following lines are required for compatibility with other programs.'); + Add(';Do not remove them(MSDOS.SYS needs to be >1024 bytes).'); + Line := ';' + StringOfChar('x', 69); + for I := 'a' to 's' do + Add(Line+I); + Attributes := FileGetAttr(cMsDosSys) and not faReadOnly; + FileSetAttr(cMsDosSys, Attributes); + SaveToFile(cMsDosSys); + FileSetAttr(cMsDosSys, Attributes or faReadOnly); + finally + Free; + end; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/JclMultimedia.pas b/3rdParty/JCL/source/windows/JclMultimedia.pas new file mode 100644 index 00000000..f1714127 --- /dev/null +++ b/3rdParty/JCL/source/windows/JclMultimedia.pas @@ -0,0 +1,1355 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclMultimedia.pas. } +{ } +{ The Initial Developers of the Original Code are Marcel van Brakel and Bernhard Berger. } +{ Portions created by these individuals are Copyright (C) of these individuals. } +{ All Rights Reserved. } +{ } +{ Contributor(s): } +{ Marcel van Brakel } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ } +{**************************************************************************************************} +{ } +{ Contains a high performance timer based on the MultiMedia API and a routine to open or close the } +{ CD-ROM drive. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclMultimedia; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, System.Classes, Winapi.MMSystem, System.Contnrs, + {$ELSE ~HAS_UNITSCOPE} + Windows, Classes, MMSystem, Contnrs, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclSynch, JclStrings; + +type + // Multimedia timer + TMmTimerKind = (tkOneShot, tkPeriodic); + TMmNotificationKind = (nkCallback, nkSetEvent, nkPulseEvent); + + TJclMultimediaTimer = class(TObject) + private + FEvent: TJclEvent; + FKind: TMmTimerKind; + FNotification: TMmNotificationKind; + FOnTimer: TNotifyEvent; + FPeriod: Cardinal; + FStartTime: Cardinal; + FTimeCaps: TTimeCaps; + FTimerId: Cardinal; + function GetMinMaxPeriod(Index: Integer): Cardinal; + procedure SetPeriod(Value: Cardinal); + protected + procedure Timer(Id: Cardinal); virtual; + public + constructor Create(Kind: TMmTimerKind; Notification: TMmNotificationKind); + destructor Destroy; override; + class function GetTime: Cardinal; + class function BeginPeriod(const Period: Cardinal): Boolean; { TODO -cHelp : Doc } + class function EndPeriod(const Period: Cardinal): Boolean; { TODO -cHelp : Doc } + procedure BeginTimer(const Delay, Resolution: Cardinal); + procedure EndTimer; + function Elapsed(const Update: Boolean): Cardinal; + function WaitFor(const TimeOut: Cardinal): TJclWaitResult; + property Event: TJclEvent read FEvent; + property Kind: TMmTimerKind read FKind; + property MaxPeriod: Cardinal index 0 read GetMinMaxPeriod; + property MinPeriod: Cardinal index 1 read GetMinMaxPeriod; + property Notification: TMmNotificationKind read FNotification; + property OnTimer: TNotifyEvent read FOnTimer write FOnTimer; + property Period: Cardinal read FPeriod write SetPeriod; + end; + + EJclMmTimerError = class(EJclError); + + // Audio Mixer + { TODO -cDoc : mixer API wrapper code. Author: Petr Vones } + + EJclMixerError = class(EJclError); + + TJclMixerDevice = class; + TJclMixerLine = class; + TJclMixerDestination = class; + + TJclMixerLineControl = class(TObject) + private + FControlInfo: TMixerControl; + FIsList: Boolean; + FIsMultiple: Boolean; + FIsUniform: Boolean; + FListText: TStringList; + FMixerLine: TJclMixerLine; + function GetIsDisabled: Boolean; + function GetID: DWORD; + function GetListText: TStrings; + function GetName: string; + function GetUniformValue: Cardinal; + function GetValue: TDynCardinalArray; + function GetValueString: string; + procedure SetUniformValue(const Value: Cardinal); + procedure SetValue(const Value: TDynCardinalArray); + protected + procedure PrepareControlDetailsStruc(out ControlDetails: TMixerControlDetails; AUniform, AMultiple: Boolean); + public + constructor Create(AMixerLine: TJclMixerLine; const AControlInfo: TMixerControl); + destructor Destroy; override; + function FormatValue(AValue: Cardinal): string; + property ControlInfo: TMixerControl read FControlInfo; + property ID: DWORD read GetID; + property IsDisabled: Boolean read GetIsDisabled; + property IsList: Boolean read FIsList; + property IsMultiple: Boolean read FIsMultiple; + property IsUniform: Boolean read FIsUniform; + property ListText: TStrings read GetListText; + property MixerLine: TJclMixerLine read FMixerLine; + property Name: string read GetName; + property UniformValue: Cardinal read GetUniformValue write SetUniformValue; + property Value: TDynCardinalArray read GetValue write SetValue; + property ValueString: string read GetValueString; + end; + + TJclMixerLine = class(TObject) + private + FLineControls: TObjectList; + FLineInfo: TMixerLine; + FMixerDevice: TJclMixerDevice; + function GetComponentString: string; + function GetLineControlByType(ControlType: DWORD): TJclMixerLineControl; + function GetLineControlCount: Integer; + function GetLineControls(Index: Integer): TJclMixerLineControl; + function GetHasControlType(ControlType: DWORD): Boolean; + function GetID: DWORD; + function GetName: string; + protected + procedure BuildLineControls; + public + constructor Create(AMixerDevice: TJclMixerDevice); + destructor Destroy; override; + class function ComponentTypeToString(const ComponentType: DWORD): string; + property ComponentString: string read GetComponentString; + property HasControlType[ControlType: DWORD]: Boolean read GetHasControlType; + property ID: DWORD read GetID; + property LineControlByType[ControlType: DWORD]: TJclMixerLineControl read GetLineControlByType; + property LineControls[Index: Integer]: TJclMixerLineControl read GetLineControls; default; + property LineControlCount: Integer read GetLineControlCount; + property LineInfo: TMixerLine read FLineInfo; + property Name: string read GetName; + property MixerDevice: TJclMixerDevice read FMixerDevice; + end; + + TJclMixerSource = class(TJclMixerLine) + private + FMixerDestination: TJclMixerDestination; + public + constructor Create(AMixerDestination: TJclMixerDestination; ASourceIndex: Cardinal); + property MixerDestination: TJclMixerDestination read FMixerDestination; + end; + + TJclMixerDestination = class(TJclMixerLine) + private + FSources: TObjectList; + function GetSourceCount: Integer; + function GetSources(Index: Integer): TJclMixerSource; + protected + procedure BuildSources; + public + constructor Create(AMixerDevice: TJclMixerDevice; ADestinationIndex: Cardinal); + destructor Destroy; override; + property Sources[Index: Integer]: TJclMixerSource read GetSources; default; + property SourceCount: Integer read GetSourceCount; + end; + + TJclMixerDevice = class(TObject) + private + FCapabilities: TMixerCaps; + FDestinations: TObjectList; + FDeviceIndex: Cardinal; + FHandle: HMIXER; + FLines: TList; + function GetProductName: string; + function GetDestinationCount: Integer; + function GetDestinations(Index: Integer): TJclMixerDestination; + function GetLineCount: Integer; + function GetLines(Index: Integer): TJclMixerLine; + function GetLineByComponentType(ComponentType: DWORD): TJclMixerLine; + function GetLineByID(LineID: DWORD): TJclMixerLine; + function GetLineControlByID(ControlID: DWORD): TJclMixerLineControl; + function GetLineUniformValue(ComponentType, ControlType: DWORD): Cardinal; + procedure SetLineUniformValue(ComponentType, ControlType: DWORD; const Value: Cardinal); + protected + procedure BuildDestinations; + procedure BuildLines; + procedure Close; + procedure Open(ACallBackWnd: THandle); + public + constructor Create(ADeviceIndex: Cardinal; ACallBackWnd: THandle); + destructor Destroy; override; + function FindLineControl(ComponentType, ControlType: DWORD): TJclMixerLineControl; + property Capabilities: TMixerCaps read FCapabilities; + property DeviceIndex: Cardinal read FDeviceIndex; + property Destinations[Index: Integer]: TJclMixerDestination read GetDestinations; default; + property DestinationCount: Integer read GetDestinationCount; + property Handle: HMIXER read FHandle; + property LineByID[LineID: DWORD]: TJclMixerLine read GetLineByID; + property LineByComponentType[ComponentType: DWORD]: TJclMixerLine read GetLineByComponentType; + property Lines[Index: Integer]: TJclMixerLine read GetLines; + property LineCount: Integer read GetLineCount; + property LineControlByID[ControlID: DWORD]: TJclMixerLineControl read GetLineControlByID; + property LineUniformValue[ComponentType, ControlType: DWORD]: Cardinal read GetLineUniformValue write SetLineUniformValue; + property ProductName: string read GetProductName; + end; + + TJclMixer = class(TObject) + private + FCallbackWnd: THandle; + FDeviceList: TObjectList; + function GetDeviceCount: Integer; + function GetDevices(Index: Integer): TJclMixerDevice; + function GetFirstDevice: TJclMixerDevice; + function GetLineMute(ComponentType: Integer): Boolean; + function GetLineVolume(ComponentType: Integer): Cardinal; + function GetLineByID(MixerHandle: HMIXER; LineID: DWORD): TJclMixerLine; + function GetLineControlByID(MixerHandle: HMIXER; LineID: DWORD): TJclMixerLineControl; + procedure SetLineMute(ComponentType: Integer; const Value: Boolean); + procedure SetLineVolume(ComponentType: Integer; const Value: Cardinal); + protected + procedure BuildDevices; + public + constructor Create(ACallBackWnd: THandle = 0); + destructor Destroy; override; + property CallbackWnd: THandle read FCallbackWnd; + property Devices[Index: Integer]: TJclMixerDevice read GetDevices; default; + property DeviceCount: Integer read GetDeviceCount; + property FirstDevice: TJclMixerDevice read GetFirstDevice; + property LineByID[MixerHandle: HMIXER; LineID: DWORD]: TJclMixerLine read GetLineByID; + property LineControlByID[MixerHandle: HMIXER; LineID: DWORD]: TJclMixerLineControl read GetLineControlByID; + property LineMute[ComponentType: Integer]: Boolean read GetLineMute write SetLineMute; + property LineVolume[ComponentType: Integer]: Cardinal read GetLineVolume write SetLineVolume; + property SpeakersMute: Boolean index MIXERLINE_COMPONENTTYPE_DST_SPEAKERS read GetLineMute write SetLineMute; + property SpeakersVolume: Cardinal index MIXERLINE_COMPONENTTYPE_DST_SPEAKERS read GetLineVolume write SetLineVolume; + end; + + function MixerLeftRightToArray(Left, Right: Cardinal): TDynCardinalArray; + +const + {$IFDEF BORLAND} + INVALID_MIXER_HANDLE: HMIXER = -1; + {$ENDIF BORLAND} + {$IFDEF FPC} + INVALID_MIXER_HANDLE: HMIXER = $FFFFFFFF; + {$ENDIF FPC} + +type + // MCI Error checking + EJclMciError = class(EJclError) + private + FMciErrorNo: DWORD; + FMciErrorMsg: string; + public + constructor Create(MciErrNo: MCIERROR; const Msg: string); + constructor CreateFmt(MciErrNo: MCIERROR; const Msg: string; const Args: array of const); + constructor CreateRes(MciErrNo: MCIERROR; Ident: Integer; Dummy: Integer); + property MciErrorNo: DWORD read FMciErrorNo; + property MciErrorMsg: string read FMciErrorMsg; + end; + +function MMCheck(const MciError: MCIERROR; const Msg: string = ''): MCIERROR; +function GetMciErrorMessage(const MciErrNo: MCIERROR): string; + +// CD Drive MCI Routines +function OpenCdMciDevice(out OpenParams: TMCI_Open_Parms; Drive: Char = #0): MCIERROR; +function CloseCdMciDevice(var OpenParams: TMCI_Open_Parms): MCIERROR; + +// CD Drive specific routines +procedure OpenCloseCdDrive(OpenMode: Boolean; Drive: Char = #0); + +function IsMediaPresentInDrive(Drive: Char = #0): Boolean; + +type + TJclCdMediaInfo = (miProduct, miIdentity, miUPC); + + TJclCdTrackType = (ttAudio, ttOther); + TJclCdTrackInfo = record + Minute: Byte; + Second: Byte; + TrackType: TJclCdTrackType; + end; + TJclCdTrackInfoArray = array of TJclCdTrackInfo; + +function GetCdInfo(InfoType: TJclCdMediaInfo; Drive: Char = #0): string; + +function GetCDAudioTrackList(out TrackList: TJclCdTrackInfoArray; Drive: Char = #0): TJclCdTrackInfo; overload; +function GetCDAudioTrackList(TrackList: TStrings; IncludeTrackType: Boolean = False; Drive: Char = #0): string; overload; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclResources, JclSysUtils; + +//=== { TJclMultimediaTimer } ================================================ + +constructor TJclMultimediaTimer.Create(Kind: TMmTimerKind; Notification: TMmNotificationKind); +begin + FKind := Kind; + FNotification := Notification; + FPeriod := 0; + FTimerID := 0; + FEvent := nil; + ResetMemory(FTimeCaps, SizeOf(FTimeCaps)); + if timeGetDevCaps(@FTimeCaps, SizeOf(FTimeCaps)) = TIMERR_STRUCT then + raise EJclMmTimerError.CreateRes(@RsMmTimerGetCaps); + FPeriod := FTimeCaps.wPeriodMin; + if Notification <> nkCallback then + FEvent := TJclEvent.Create(nil, Notification = nkSetEvent, False, ''); +end; + +destructor TJclMultimediaTimer.Destroy; +begin + EndTimer; + FreeAndNil(FEvent); + FOnTimer := nil; + inherited Destroy; +end; + +procedure MmTimerCallback(TimerId, Msg: Cardinal; User, dw1, dw2: DWORD); stdcall; +begin + TJclMultimediaTimer(User).Timer(TimerId); +end; + +class function TJclMultimediaTimer.BeginPeriod(const Period: Cardinal): Boolean; +begin + Result := timeBeginPeriod(Period) = TIMERR_NOERROR; +end; + +procedure TJclMultimediaTimer.BeginTimer(const Delay, Resolution: Cardinal); +var + Event: Cardinal; + TimerCallback: TFNTimeCallBack; +begin + if FTimerId <> 0 then + raise EJclMmTimerError.CreateRes(@RsMmTimerActive); + Event := 0; + TimerCallback := nil; + case FKind of + tkPeriodic: + Event := TIME_PERIODIC; + tkOneShot: + Event := TIME_ONESHOT; + end; + case FNotification of + nkCallback: + begin + Event := Event or TIME_CALLBACK_FUNCTION; + TimerCallback := @MmTimerCallback; + end; + nkSetEvent: + begin + Event := Event or TIME_CALLBACK_EVENT_SET; + TimerCallback := TFNTimeCallback(FEvent.Handle); + end; + nkPulseEvent: + begin + Event := Event or TIME_CALLBACK_EVENT_PULSE; + TimerCallback := TFNTimeCallback(FEvent.Handle); + end; + end; + FStartTime := GetTime; + if timeBeginPeriod(FPeriod) = TIMERR_NOERROR then + FTimerId := timeSetEvent(Delay, Resolution, TimerCallBack, DWORD_PTR(Self), Event); + if FTimerId = 0 then + raise EJclMmTimerError.CreateRes(@RsMmSetEvent); +end; + +function TJclMultimediaTimer.Elapsed(const Update: Boolean): Cardinal; +var + CurrentTime: Cardinal; +begin + if FTimerId = 0 then + Result := 0 + else + begin + CurrentTime := GetTime; + if CurrentTime >= FStartTime then + Result := CurrentTime - FStartTime + else + Result := (High(Cardinal) - FStartTime) + CurrentTime; + if Update then + FStartTime := CurrentTime; + end; +end; + +class function TJclMultimediaTimer.EndPeriod(const Period: Cardinal): Boolean; +begin + Result := timeEndPeriod(Period) = TIMERR_NOERROR; +end; + +procedure TJclMultimediaTimer.EndTimer; +begin + if FTimerId <> 0 then + begin + if FKind = tkPeriodic then + timeKillEvent(FTimerId); + timeEndPeriod(FPeriod); + FTimerId := 0; + end; +end; + +function TJclMultimediaTimer.GetMinMaxPeriod(Index: Integer): Cardinal; +begin + case Index of + 0: + Result := FTimeCaps.wPeriodMax; + 1: + Result := FTimeCaps.wPeriodMin; + else + Result := 0; + end; +end; + +class function TJclMultimediaTimer.GetTime: Cardinal; +begin + Result := timeGetTime; +end; + +procedure TJclMultimediaTimer.SetPeriod(Value: Cardinal); +begin + if FTimerId <> 0 then + raise EJclMmTimerError.CreateRes(@RsMmTimerActive); + FPeriod := Value; +end; + +{ TODO -cHelp : Applications should not call any system-defined functions from + inside a callback function, except for PostMessage, timeGetSystemTime, + timeGetTime, timeSetEvent, timeKillEvent, midiOutShortMsg, midiOutLongMsg, + and OutputDebugString. } +procedure TJclMultimediaTimer.Timer(Id: Cardinal); +begin + { TODO : A exception in the callbacl i very likely very critically } + if Id <> FTimerId then + raise EJclMmTimerError.CreateRes(@RsMmInconsistentId); + if Assigned(FOnTimer) then + FOnTimer(Self); +end; + +function TJclMultimediaTimer.WaitFor(const TimeOut: Cardinal): TJclWaitResult; +begin + if FNotification = nkCallback then + Result := wrError + else + Result := FEvent.WaitFor(TimeOut); +end; + +//=== { TJclMixerLineControl } =============================================== + +function MixerLeftRightToArray(Left, Right: Cardinal): TDynCardinalArray; +begin + SetLength(Result, 2); + Result[0] := Left; + Result[1] := Right; +end; + +constructor TJclMixerLineControl.Create(AMixerLine: TJclMixerLine; const AControlInfo: TMixerControl); +begin + FControlInfo := AControlInfo; + FMixerLine := AMixerLine; + FIsList := (ControlInfo.dwControlType and MIXERCONTROL_CT_CLASS_MASK) = MIXERCONTROL_CT_CLASS_LIST; + FIsMultiple := FControlInfo.fdwControl and MIXERCONTROL_CONTROLF_MULTIPLE <> 0; + FIsUniform := FControlInfo.fdwControl and MIXERCONTROL_CONTROLF_UNIFORM <> 0; +end; + +destructor TJclMixerLineControl.Destroy; +begin + FreeAndNil(FListText); + inherited Destroy; +end; + +function TJclMixerLineControl.FormatValue(AValue: Cardinal): string; +begin + case FControlInfo.dwControlType and MIXERCONTROL_CT_UNITS_MASK of + MIXERCONTROL_CT_UNITS_BOOLEAN: + Result := BooleanToStr(Boolean(AValue)); + MIXERCONTROL_CT_UNITS_SIGNED: + Result := Format('%d', [AValue]); + MIXERCONTROL_CT_UNITS_UNSIGNED: + Result := Format('%u', [AValue]); + MIXERCONTROL_CT_UNITS_DECIBELS: + Result := Format('%.1fdB', [AValue / 10]); + MIXERCONTROL_CT_UNITS_PERCENT: + Result := Format('%.1f%%', [AValue / 10]); + else + Result := ''; + end; +end; + +function TJclMixerLineControl.GetID: DWORD; +begin + Result := ControlInfo.dwControlID; +end; + +function TJclMixerLineControl.GetIsDisabled: Boolean; +begin + Result := FControlInfo.fdwControl and MIXERCONTROL_CONTROLF_DISABLED <> 0; +end; + +function TJclMixerLineControl.GetListText: TStrings; +var + ControlDetails: TMIXERCONTROLDETAILS; + ListTexts, P: ^MIXERCONTROLDETAILS_LISTTEXT; + I: Cardinal; +begin + if FListText = nil then + begin + FListText := TStringList.Create; + if IsMultiple and IsList then + begin + PrepareControlDetailsStruc(ControlDetails, True, IsMultiple); + ControlDetails.cbDetails := SizeOf(MIXERCONTROLDETAILS_LISTTEXT); + GetMem(ListTexts, SizeOf(MIXERCONTROLDETAILS_LISTTEXT) * ControlDetails.cMultipleItems); + try + ControlDetails.paDetails := ListTexts; + if mixerGetControlDetails(MixerLine.MixerDevice.Handle, @ControlDetails, MIXER_GETCONTROLDETAILSF_LISTTEXT) = MMSYSERR_NOERROR then + begin + P := ListTexts; + for I := 1 to ControlDetails.cMultipleItems do + begin + FListText.AddObject(P^.szName, Pointer(P^.dwParam1)); + Inc(P); + end; + end; + finally + FreeMem(ListTexts); + end; + end; + end; + Result := FListText; +end; + +function TJclMixerLineControl.GetName: string; +begin + Result := FControlInfo.szName; +end; + +function TJclMixerLineControl.GetUniformValue: Cardinal; +var + ControlDetails: TMixerControlDetails; +begin + PrepareControlDetailsStruc(ControlDetails, True, False); + ControlDetails.cbDetails := SizeOf(Cardinal); + ControlDetails.paDetails := @Result; + MMCheck(mixerGetControlDetails(MixerLine.MixerDevice.Handle, @ControlDetails, MIXER_GETCONTROLDETAILSF_VALUE)); +end; + +function TJclMixerLineControl.GetValue: TDynCardinalArray; +var + ControlDetails: TMixerControlDetails; + ItemCount: Cardinal; +begin + PrepareControlDetailsStruc(ControlDetails, IsUniform, IsMultiple); + if IsUniform then + ItemCount := 1 + else + ItemCount := ControlDetails.cChannels; + if IsMultiple then + ItemCount := ItemCount * ControlDetails.cMultipleItems; + SetLength(Result, ItemCount); + ControlDetails.cbDetails := SizeOf(Cardinal); + ControlDetails.paDetails := @Result[0]; + MMCheck(mixerGetControlDetails(MixerLine.MixerDevice.Handle, @ControlDetails, MIXER_GETCONTROLDETAILSF_VALUE)); +end; + +function TJclMixerLineControl.GetValueString: string; +var + TempValue: TDynCardinalArray; + I: Integer; +begin + TempValue := Value; + Result := ''; + for I := Low(TempValue) to High(TempValue) do + Result := Result + ',' + FormatValue(TempValue[I]); + Delete(Result, 1, 1); +end; + +procedure TJclMixerLineControl.PrepareControlDetailsStruc(out ControlDetails: TMixerControlDetails; + AUniform, AMultiple: Boolean); +begin + ResetMemory(ControlDetails, SizeOf(ControlDetails)); + ControlDetails.cbStruct := SizeOf(ControlDetails); + ControlDetails.dwControlID := FControlInfo.dwControlID; + if AUniform then + ControlDetails.cChannels := MIXERCONTROL_CONTROLF_UNIFORM + else + ControlDetails.cChannels := MixerLine.LineInfo.cChannels; + if AMultiple then + ControlDetails.cMultipleItems := FControlInfo.cMultipleItems; +end; + +procedure TJclMixerLineControl.SetUniformValue(const Value: Cardinal); +var + ControlDetails: TMixerControlDetails; +begin + PrepareControlDetailsStruc(ControlDetails, True, False); + ControlDetails.cbDetails := SizeOf(Cardinal); + ControlDetails.paDetails := @Value; + MMCheck(mixerSetControlDetails(MixerLine.MixerDevice.Handle, @ControlDetails, MIXER_GETCONTROLDETAILSF_VALUE)); +end; + +procedure TJclMixerLineControl.SetValue(const Value: TDynCardinalArray); +var + ControlDetails: TMixerControlDetails; + {$IFDEF ASSERTIONS_ON} + ItemCount: Cardinal; + {$ENDIF ASSERTIONS_ON} +begin + PrepareControlDetailsStruc(ControlDetails, IsUniform, IsMultiple); + {$IFDEF ASSERTIONS_ON} + if IsUniform then + ItemCount := 1 + else + ItemCount := ControlDetails.cChannels; + if IsMultiple then + ItemCount := ItemCount * ControlDetails.cMultipleItems; + Assert(ItemCount = Cardinal(Length(Value))); + {$ENDIF ASSERTIONS_ON} + ControlDetails.cbDetails := SizeOf(Cardinal); + ControlDetails.paDetails := @Value[0]; + MMCheck(mixerSetControlDetails(MixerLine.MixerDevice.Handle, @ControlDetails, MIXER_GETCONTROLDETAILSF_VALUE)); +end; + +//=== { TJclMixerLine } ====================================================== + +function MixerLineCompareID(Item1, Item2: Pointer): Integer; +begin + Result := Integer(TJclMixerLine(Item1).ID) - Integer(TJclMixerLine(Item2).ID); +end; + +function MixerLineSearchID(Param: Pointer; ItemIndex: Integer; const Value): Integer; +begin + Result := Integer(TJclMixerDevice(Param).Lines[ItemIndex].ID) - Integer(Value); +end; + +constructor TJclMixerLine.Create(AMixerDevice: TJclMixerDevice); +begin + FMixerDevice := AMixerDevice; + FLineControls := TObjectList.Create; +end; + +destructor TJclMixerLine.Destroy; +begin + FreeAndNil(FLineControls); + inherited Destroy; +end; + +procedure TJclMixerLine.BuildLineControls; +var + MixerControls: TMixerLineControls; + Controls, P: PMixerControl; + I: Cardinal; + Item: TJclMixerLineControl; +begin + GetMem(Controls, SizeOf(TMixerControl) * FLineInfo.cControls); + try + MixerControls.cbStruct := SizeOf(MixerControls); + MixerControls.dwLineID := FLineInfo.dwLineID; + MixerControls.cControls := FLineInfo.cControls; + MixerControls.cbmxctrl := SizeOf(TMixerControl); + MixerControls.pamxctrl := Controls; + if mixerGetLineControls(FMixerDevice.Handle, @MixerControls, MIXER_GETLINECONTROLSF_ALL) = MMSYSERR_NOERROR then + begin + P := Controls; + for I := 1 to FLineInfo.cControls do + begin + Item := TJclMixerLineControl.Create(Self, P^); + FLineControls.Add(Item); + Inc(P); + end; + end; + finally + FreeMem(Controls); + end; +end; + +class function TJclMixerLine.ComponentTypeToString(const ComponentType: DWORD): string; +begin + case ComponentType of + MIXERLINE_COMPONENTTYPE_DST_UNDEFINED: + Result := LoadResString(@RsMmMixerUndefined); + MIXERLINE_COMPONENTTYPE_DST_DIGITAL, MIXERLINE_COMPONENTTYPE_SRC_DIGITAL: + Result := LoadResString(@RsMmMixerDigital); + MIXERLINE_COMPONENTTYPE_DST_LINE, MIXERLINE_COMPONENTTYPE_SRC_LINE: + Result := LoadResString(@RsMmMixerLine); + MIXERLINE_COMPONENTTYPE_DST_MONITOR: + Result := LoadResString(@RsMmMixerMonitor); + MIXERLINE_COMPONENTTYPE_DST_SPEAKERS: + Result := LoadResString(@RsMmMixerSpeakers); + MIXERLINE_COMPONENTTYPE_DST_HEADPHONES: + Result := LoadResString(@RsMmMixerHeadphones); + MIXERLINE_COMPONENTTYPE_DST_TELEPHONE, MIXERLINE_COMPONENTTYPE_SRC_TELEPHONE: + Result := LoadResString(@RsMmMixerTelephone); + MIXERLINE_COMPONENTTYPE_DST_WAVEIN: + Result := LoadResString(@RsMmMixerWaveIn); + MIXERLINE_COMPONENTTYPE_DST_VOICEIN: + Result := LoadResString(@RsMmMixerVoiceIn); + MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE: + Result := LoadResString(@RsMmMixerMicrophone); + MIXERLINE_COMPONENTTYPE_SRC_SYNTHESIZER: + Result := LoadResString(@RsMmMixerSynthesizer); + MIXERLINE_COMPONENTTYPE_SRC_COMPACTDISC: + Result := LoadResString(@RsMmMixerCompactDisc); + MIXERLINE_COMPONENTTYPE_SRC_PCSPEAKER: + Result := LoadResString(@RsMmMixerPcSpeaker); + MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT: + Result := LoadResString(@RsMmMixerWaveOut); + MIXERLINE_COMPONENTTYPE_SRC_AUXILIARY: + Result := LoadResString(@RsMmMixerAuxiliary); + MIXERLINE_COMPONENTTYPE_SRC_ANALOG: + Result := LoadResString(@RsMmMixerAnalog); + else + Result := ''; + end; +end; + +function TJclMixerLine.GetComponentString: string; +begin + Result := ComponentTypeToString(FLineInfo.dwComponentType); +end; + +function TJclMixerLine.GetHasControlType(ControlType: DWORD): Boolean; +begin + Result := LineControlByType[ControlType] <> nil; +end; + +function TJclMixerLine.GetID: DWORD; +begin + Result := LineInfo.dwLineID; +end; + +function TJclMixerLine.GetLineControlByType(ControlType: DWORD): TJclMixerLineControl; +var + I: Integer; +begin + Result := nil; + for I := 0 to LineControlCount - 1 do + if LineControls[I].ControlInfo.dwControlType = ControlType then + begin + Result := LineControls[I]; + Break; + end; +end; + +function TJclMixerLine.GetLineControlCount: Integer; +begin + Result := FLineControls.Count; + if Result = 0 then + begin + BuildLineControls; + Result := FLineControls.Count; + end; +end; + +function TJclMixerLine.GetLineControls(Index: Integer): TJclMixerLineControl; +begin + Result := TJclMixerLineControl(FLineControls[Index]); +end; + +function TJclMixerLine.GetName: string; +begin + Result := FLineInfo.szName; +end; + +//=== { TJclMixerSource } ==================================================== + +constructor TJclMixerSource.Create(AMixerDestination: TJclMixerDestination; ASourceIndex: Cardinal); +begin + inherited Create(AMixerDestination.MixerDevice); + FMixerDestination := AMixerDestination; + FLineInfo.cbStruct := SizeOf(FLineInfo); + FLineInfo.dwDestination := FMixerDestination.LineInfo.dwDestination; + FLineInfo.dwSource := ASourceIndex; + MMCheck(mixerGetLineInfo(FMixerDestination.MixerDevice.Handle, @FLineInfo, MIXER_GETLINEINFOF_SOURCE)); +end; + +//=== { TJclMixerDestination } =============================================== + +constructor TJclMixerDestination.Create(AMixerDevice: TJclMixerDevice; ADestinationIndex: Cardinal); +begin + inherited Create(AMixerDevice); + FLineInfo.cbStruct := SizeOf(FLineInfo); + FLineInfo.dwDestination := ADestinationIndex; + MMCheck(mixerGetLineInfo(AMixerDevice.Handle, @FLineInfo, MIXER_GETLINEINFOF_DESTINATION)); + FSources := TObjectList.Create; +end; + +destructor TJclMixerDestination.Destroy; +begin + FreeAndNil(FSources); + inherited Destroy; +end; + +procedure TJclMixerDestination.BuildSources; +var + I: Cardinal; + Item: TJclMixerSource; +begin + for I := 1 to LineInfo.cConnections do + begin + Item := TJclMixerSource.Create(Self, I - 1); + FSources.Add(Item); + end; +end; + +function TJclMixerDestination.GetSourceCount: Integer; +begin + Result := FSources.Count; + if Result = 0 then + begin + BuildSources; + Result := FSources.Count; + end; +end; + +function TJclMixerDestination.GetSources(Index: Integer): TJclMixerSource; +begin + Result := TJclMixerSource(FSources[Index]); +end; + +//=== { TJclMixerDevice } ==================================================== + +constructor TJclMixerDevice.Create(ADeviceIndex: Cardinal; ACallBackWnd: THandle); +begin + FDeviceIndex := ADeviceIndex; + FHandle := INVALID_MIXER_HANDLE; + FDestinations := TObjectList.Create; + FLines := TList.Create; + MMCheck(mixerGetDevCaps(ADeviceIndex, @FCapabilities, SizeOf(FCapabilities))); + Open(ACallBackWnd); + BuildDestinations; +end; + +destructor TJclMixerDevice.Destroy; +begin + Close; + FreeAndNil(FDestinations); + FreeAndNil(FLines); + inherited Destroy; +end; + +procedure TJclMixerDevice.BuildDestinations; +var + I: Cardinal; + Item: TJclMixerDestination; +begin + for I := 1 to FCapabilities.cDestinations do + begin + Item := TJclMixerDestination.Create(Self, I - 1); + FDestinations.Add(Item); + end; +end; + +procedure TJclMixerDevice.BuildLines; +var + D, I: Integer; + Dest: TJclMixerDestination; +begin + for D := 0 to DestinationCount - 1 do + begin + Dest := Destinations[D]; + FLines.Add(Dest); + for I := 0 to Dest.SourceCount - 1 do + FLines.Add(Dest.Sources[I]); + end; + FLines.Sort(MixerLineCompareID); +end; + +procedure TJclMixerDevice.Close; +begin + if FHandle <> INVALID_MIXER_HANDLE then + begin + mixerClose(FHandle); + FHandle := INVALID_MIXER_HANDLE; + end; +end; + +function TJclMixerDevice.FindLineControl(ComponentType, ControlType: DWORD): TJclMixerLineControl; +var + TempLine: TJclMixerLine; +begin + Result := nil; + TempLine := LineByComponentType[ComponentType]; + if TempLine <> nil then + Result := TempLine.LineControlByType[ControlType]; +end; + +function TJclMixerDevice.GetDestinationCount: Integer; +begin + Result := FDestinations.Count; +end; + +function TJclMixerDevice.GetDestinations(Index: Integer): TJclMixerDestination; +begin + Result := TJclMixerDestination(FDestinations[Index]); +end; + +function TJclMixerDevice.GetLineByComponentType(ComponentType: DWORD): TJclMixerLine; +var + I: Integer; +begin + Result := nil; + for I := 0 to LineCount - 1 do + if Lines[I].LineInfo.dwComponentType = ComponentType then + begin + Result := Lines[I]; + Break; + end; +end; + +function TJclMixerDevice.GetLineByID(LineID: DWORD): TJclMixerLine; +var + I: Integer; +begin + I := SearchSortedUntyped(Self, LineCount, MixerLineSearchID, LineID); + if I = -1 then + Result := nil + else + Result := Lines[I]; +end; + +function TJclMixerDevice.GetLineControlByID(ControlID: DWORD): TJclMixerLineControl; +var + L, C: Integer; + TempLine: TJclMixerLine; +begin + Result := nil; + for L := 0 to LineCount - 1 do + begin + TempLine := Lines[L]; + for C := 0 to TempLine.LineControlCount - 1 do + if TempLine.LineControls[C].ID = ControlID then + begin + Result := TempLine.LineControls[C]; + Break; + end; + end; +end; + +function TJclMixerDevice.GetLineCount: Integer; +begin + Result := FLines.Count; + if Result = 0 then + begin + BuildLines; + Result := FLines.Count; + end; +end; + +function TJclMixerDevice.GetLines(Index: Integer): TJclMixerLine; +begin + Result := TJclMixerLine(FLines[Index]); +end; + +function TJclMixerDevice.GetLineUniformValue(ComponentType, ControlType: DWORD): Cardinal; +var + LineControl: TJclMixerLineControl; +begin + LineControl := FindLineControl(ComponentType, ControlType); + if LineControl <> nil then + Result := LineControl.UniformValue + else + Result := 0; +end; + +function TJclMixerDevice.GetProductName: string; +begin + Result := FCapabilities.szPname; +end; + +procedure TJclMixerDevice.Open(ACallBackWnd: THandle); +var + Flags: DWORD; +begin + if FHandle = INVALID_MIXER_HANDLE then + begin + Flags := MIXER_OBJECTF_HMIXER; + if ACallBackWnd <> 0 then + Inc(Flags, CALLBACK_WINDOW); + MMCheck(mixerOpen(@FHandle, DeviceIndex, ACallBackWnd, 0, Flags)); + end; +end; + +procedure TJclMixerDevice.SetLineUniformValue(ComponentType, ControlType: DWORD; const Value: Cardinal); +var + LineControl: TJclMixerLineControl; +begin + LineControl := FindLineControl(ComponentType, ControlType); + if LineControl <> nil then + LineControl.UniformValue := Value + else + raise EJclMixerError.CreateResFmt(@RsMmMixerCtlNotFound, + [TJclMixerLine.ComponentTypeToString(ComponentType), ControlType]); +end; + +//=== { TJclMixer } ========================================================== + +constructor TJclMixer.Create(ACallBackWnd: THandle); +begin + FDeviceList := TObjectList.Create; + FCallbackWnd := ACallBackWnd; + BuildDevices; +end; + +destructor TJclMixer.Destroy; +begin + FreeAndNil(FDeviceList); + inherited Destroy; +end; + +procedure TJclMixer.BuildDevices; +var + I: Cardinal; + Item: TJclMixerDevice; +begin + for I := 1 to mixerGetNumDevs do + begin + Item := TJclMixerDevice.Create(I - 1, FCallbackWnd); + FDeviceList.Add(Item); + end; +end; + +function TJclMixer.GetDeviceCount: Integer; +begin + Result := FDeviceList.Count; +end; + +function TJclMixer.GetDevices(Index: Integer): TJclMixerDevice; +begin + Result := TJclMixerDevice(FDeviceList.Items[Index]); +end; + +function TJclMixer.GetFirstDevice: TJclMixerDevice; +begin + if DeviceCount = 0 then + raise EJclMixerError.CreateRes(@RsMmMixerNoDevices); + Result := Devices[0]; +end; + +function TJclMixer.GetLineByID(MixerHandle: HMIXER; LineID: DWORD): TJclMixerLine; +var + I: Integer; + TempDevice: TJclMixerDevice; +begin + Result := nil; + for I := 0 to DeviceCount - 1 do + begin + TempDevice := Devices[I]; + if TempDevice.Handle = MixerHandle then + begin + Result := TempDevice.LineByID[LineID]; + if Result <> nil then + Break; + end; + end; +end; + +function TJclMixer.GetLineControlByID(MixerHandle: HMIXER; LineID: DWORD): TJclMixerLineControl; +var + I: Integer; + TempDevice: TJclMixerDevice; +begin + Result := nil; + for I := 0 to DeviceCount - 1 do + begin + TempDevice := Devices[I]; + if TempDevice.Handle = MixerHandle then + begin + Result := TempDevice.LineControlByID[LineID]; + if Result <> nil then + Break; + end; + end; +end; + +function TJclMixer.GetLineMute(ComponentType: Integer): Boolean; +begin + Result := Boolean(FirstDevice.LineUniformValue[Cardinal(ComponentType), MIXERCONTROL_CONTROLTYPE_MUTE]); +end; + +function TJclMixer.GetLineVolume(ComponentType: Integer): Cardinal; +begin + Result := FirstDevice.LineUniformValue[Cardinal(ComponentType), MIXERCONTROL_CONTROLTYPE_VOLUME]; +end; + +procedure TJclMixer.SetLineMute(ComponentType: Integer; const Value: Boolean); +begin + FirstDevice.LineUniformValue[Cardinal(ComponentType), MIXERCONTROL_CONTROLTYPE_MUTE] := Cardinal(Value); +end; + +procedure TJclMixer.SetLineVolume(ComponentType: Integer; const Value: Cardinal); +begin + FirstDevice.LineUniformValue[Cardinal(ComponentType), MIXERCONTROL_CONTROLTYPE_VOLUME] := Value; +end; + +//=== { EJclMciError } ======================================================= + +constructor EJclMciError.Create(MciErrNo: MCIERROR; const Msg: string); +begin + FMciErrorNo := MciErrNo; + FMciErrorMsg := GetMciErrorMessage(MciErrNo); + inherited Create(Msg + NativeLineBreak + LoadResString(@RsMmMciErrorPrefix) + FMciErrorMsg); +end; + +constructor EJclMciError.CreateFmt(MciErrNo: MCIERROR; const Msg: string; + const Args: array of const); +begin + FMciErrorNo := MciErrNo; + FMciErrorMsg := GetMciErrorMessage(MciErrNo); + inherited CreateFmt(Msg + NativeLineBreak + LoadResString(@RsMmMciErrorPrefix) + FMciErrorMsg, Args); +end; + +constructor EJclMciError.CreateRes(MciErrNo: MCIERROR; Ident: Integer; Dummy: Integer); +begin + FMciErrorNo := MciErrNo; + FMciErrorMsg := GetMciErrorMessage(MciErrNo); + inherited Create(LoadStr(Ident)+ NativeLineBreak + LoadResString(@RsMmMciErrorPrefix) + FMciErrorMsg); +end; + +function GetMciErrorMessage(const MciErrNo: MCIERROR): string; +var + Buffer: array [0..{$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}MMSystem.MAXERRORLENGTH - 1] of Char; +begin + if mciGetErrorString(MciErrNo, Buffer, Length(Buffer)) then + Result := Buffer + else + Result := Format(LoadResString(@RsMmUnknownError), [MciErrNo]); +end; + +function MMCheck(const MciError: MCIERROR; const Msg: string): MCIERROR; +begin + if MciError <> MMSYSERR_NOERROR then + raise EJclMciError.Create(MciError, Msg); + Result := MciError; +end; + +//=== CD Drive MCI Routines ================================================== + +function OpenCdMciDevice(out OpenParams: TMCI_Open_Parms; Drive: Char): MCIERROR; +var + OpenParam: DWORD; + DriveName: array [0..2] of Char; +begin + ResetMemory(OpenParams, SizeOf(OpenParams)); + OpenParam := MCI_OPEN_TYPE or MCI_OPEN_TYPE_ID or MCI_OPEN_SHAREABLE; + OpenParams.lpstrDeviceType := PChar(MCI_DEVTYPE_CD_AUDIO); + if Drive <> #0 then + begin + OpenParams.lpstrElementName := StrFmt(DriveName, '%s:', [UpCase(Drive)]); + Inc(OpenParam, MCI_OPEN_ELEMENT); + end; + Result := mciSendCommand(0, MCI_OPEN, OpenParam, TJclAddr(@OpenParams)); +end; + +function CloseCdMciDevice(var OpenParams: TMCI_Open_Parms): MCIERROR; +begin + Result := mciSendCommand(OpenParams.wDeviceID, MCI_CLOSE, MCI_WAIT, 0); + if Result = MMSYSERR_NOERROR then + ResetMemory(OpenParams, SizeOf(OpenParams)); +end; + +//=== CD Drive specific routines ============================================= + +procedure OpenCloseCdDrive(OpenMode: Boolean; Drive: Char); +const + OpenCmd: array [Boolean] of DWORD = + (MCI_SET_DOOR_CLOSED, MCI_SET_DOOR_OPEN); +var + Mci: TMCI_Open_Parms; +begin + MMCheck(OpenCdMciDevice(Mci, Drive), LoadResString(@RsMmNoCdAudio)); + try + MMCheck(mciSendCommand(Mci.wDeviceID, MCI_SET, OpenCmd[OpenMode], 0)); + finally + CloseCdMciDevice(Mci); + end; +end; + +function IsMediaPresentInDrive(Drive: Char): Boolean; +var + Mci: TMCI_Open_Parms; + StatusParams: TMCI_Status_Parms; +begin + MMCheck(OpenCdMciDevice(Mci, Drive), LoadResString(@RsMmNoCdAudio)); + try + ResetMemory(StatusParams, SizeOf(StatusParams)); + StatusParams.dwItem := MCI_STATUS_MEDIA_PRESENT; + MMCheck(mciSendCommand(Mci.wDeviceID, MCI_STATUS, MCI_STATUS_ITEM or MCI_WAIT, TJclAddr(@StatusParams))); + Result := Boolean(StatusParams.dwReturn); + finally + CloseCdMciDevice(Mci); + end; +end; + +function GetCdInfo(InfoType: TJclCdMediaInfo; Drive: Char): string; +const + InfoConsts: array [TJclCdMediaInfo] of DWORD = + (MCI_INFO_PRODUCT, MCI_INFO_MEDIA_IDENTITY, MCI_INFO_MEDIA_UPC); +var + Mci: TMCI_Open_Parms; + InfoParams: TMCI_Info_Parms; + Buffer: array [0..255] of Char; +begin + Result := ''; + MMCheck(OpenCdMciDevice(Mci, Drive), LoadResString(@RsMmNoCdAudio)); + try + ResetMemory(Buffer, SizeOf(Buffer)); + InfoParams.dwCallback := 0; + InfoParams.lpstrReturn := Buffer; + InfoParams.dwRetSize := Length(Buffer) - 1; + if mciSendCommand(Mci.wDeviceID, MCI_INFO, InfoConsts[InfoType], TJclAddr(@InfoParams)) = MMSYSERR_NOERROR then + Result := Buffer; + finally + CloseCdMciDevice(Mci); + end; +end; + +function GetCDAudioTrackList(out TrackList: TJclCdTrackInfoArray; Drive: Char): TJclCdTrackInfo; +var + Mci: TMCI_Open_Parms; + SetParams: TMCI_Set_Parms; + TrackCnt, Ret: Cardinal; + I: Integer; + + function GetTrackInfo(Command, Item, Track: DWORD): DWORD; + var + StatusParams: TMCI_Status_Parms; + begin + ResetMemory(StatusParams, SizeOf(StatusParams)); + StatusParams.dwItem := Item; + StatusParams.dwTrack := Track; + if mciSendCommand(Mci.wDeviceID, MCI_STATUS, Command, TJclAddr(@StatusParams)) = MMSYSERR_NOERROR then + Result := StatusParams.dwReturn + else + Result := 0; + end; + +begin + MMCheck(OpenCdMciDevice(Mci, Drive), LoadResString(@RsMmNoCdAudio)); + try + ResetMemory(SetParams, SizeOf(SetParams)); + SetParams.dwTimeFormat := MCI_FORMAT_MSF; + MMCheck(mciSendCommand(Mci.wDeviceID, MCI_SET, MCI_SET_TIME_FORMAT, TJclAddr(@SetParams))); + Result.TrackType := ttOther; + TrackCnt := GetTrackInfo(MCI_STATUS_ITEM, MCI_STATUS_NUMBER_OF_TRACKS, 0); + SetLength(TrackList, TrackCnt); + for I := 0 to TrackCnt - 1 do + begin + Ret := GetTrackInfo(MCI_STATUS_ITEM or MCI_TRACK, MCI_STATUS_LENGTH, I + 1); + TrackList[I].Minute := mci_MSF_Minute(Ret); + TrackList[I].Second := mci_MSF_Second(Ret); + Ret := GetTrackInfo(MCI_STATUS_ITEM or MCI_TRACK, MCI_CDA_STATUS_TYPE_TRACK, I + 1); + if Ret = MCI_CDA_TRACK_AUDIO then + begin + Result.TrackType := ttAudio; + TrackList[I].TrackType := ttAudio; + end + else + TrackList[I].TrackType := ttOther; + end; + Ret := GetTrackInfo(MCI_STATUS_ITEM, MCI_STATUS_LENGTH, 0); + Result.Minute := mci_MSF_Minute(Ret); + Result.Second := mci_MSF_Second(Ret); + finally + CloseCdMciDevice(Mci); + end; +end; + +function GetCDAudioTrackList(TrackList: TStrings; IncludeTrackType: Boolean; Drive: Char): string; +var + Tracks: TJclCdTrackInfoArray; + TotalTime: TJclCdTrackInfo; + I: Integer; + S: string; +begin + TotalTime := GetCDAudioTrackList(Tracks, Drive); + TrackList.BeginUpdate; + try + for I := Low(Tracks) to High(Tracks) do + with Tracks[I] do + begin + if IncludeTrackType then + begin + case TrackType of + ttAudio: + S := LoadResString(@RsMMTrackAudio); + ttOther: + S := LoadResString(@RsMMTrackOther); + end; + S := Format('[%s]', [S]); + end + else + S := ''; + S := Format(LoadResString(@RsMmCdTrackNo), [I + 1]) + ' ' + S; + S := S + ' ' + Format(LoadResString(@RsMMCdTimeFormat), [I + 1, Minute, Second]); + TrackList.Add(S); + end; + finally + TrackList.EndUpdate; + end; + Result := Format(LoadResString(@RsMMCdTimeFormat), [TotalTime.Minute, TotalTime.Second]); +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/JclNTFS.pas b/3rdParty/JCL/source/windows/JclNTFS.pas new file mode 100644 index 00000000..fe9a4d43 --- /dev/null +++ b/3rdParty/JCL/source/windows/JclNTFS.pas @@ -0,0 +1,2519 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclNTFS.pas. } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. Portions created by Marcel van } +{ Brakel are Copyright (C) Marcel van Brakel. All Rights Reserved. } +{ } +{ Contributor(s): } +{ Marcel van Brakel } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Petr Vones (pvones) } +{ Oliver Schneider (assarbad) } +{ ZENsan } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ Contains routines to perform filesystem related tasks available only with NTFS. These are mostly } +{ relatively straightforward wrappers for various IOCTs related to compression, sparse files, } +{ reparse points, volume mount points and so forth. Note that some functions require NTFS 5 or } +{ higher! } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +// Comments on Win9x compatibility of the functions used in this unit + +// These stubs exist on Windows 95B already but all of them +// return ERROR_CALL_NOT_IMPLEMENTED: +// BackupSeek, BackupRead, BackupWrite + +unit JclNTFS; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, System.SysUtils, System.Classes, Winapi.ActiveX, + {$ELSE ~HAS_UNITSCOPE} + Windows, SysUtils, Classes, ActiveX, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclWin32; + +// NTFS Exception +type + EJclNtfsError = class(EJclWin32Error); + +// NTFS - Compression +type + TFileCompressionState = (fcNoCompression, fcDefaultCompression, fcLZNT1Compression); + +function NtfsGetCompression(const FileName: TFileName; out State: Short): Boolean; overload; +function NtfsGetCompression(const FileName: TFileName): TFileCompressionState; overload; +function NtfsSetCompression(const FileName: TFileName; const State: Short): Boolean; +procedure NtfsSetFileCompression(const FileName: TFileName; const State: TFileCompressionState); +procedure NtfsSetDirectoryTreeCompression(const Directory: string; const State: TFileCompressionState); +procedure NtfsSetDefaultFileCompression(const Directory: string; const State: TFileCompressionState); +procedure NtfsSetPathCompression(const Path: string; const State: TFileCompressionState; Recursive: Boolean); + +// NTFS - Sparse Files +type + TNtfsAllocRanges = record + Entries: Cardinal; + Data: PFileAllocatedRangeBuffer; + MoreData: Boolean; + end; + +function NtfsSetSparse(const FileName: string): Boolean; +function NtfsZeroDataByHandle(const Handle: THandle; const First, Last: Int64): Boolean; +function NtfsZeroDataByName(const FileName: string; const First, Last: Int64): Boolean; +function NtfsQueryAllocRanges(const FileName: string; Offset, Count: Int64; var Ranges: TNtfsAllocRanges): Boolean; +function NtfsGetAllocRangeEntry(const Ranges: TNtfsAllocRanges; Index: TJclAddr): TFileAllocatedRangeBuffer; +function NtfsSparseStreamsSupported(const Volume: string): Boolean; +function NtfsGetSparse(const FileName: string): Boolean; + +// NTFS - Reparse Points +function NtfsDeleteReparsePoint(const FileName: string; ReparseTag: DWORD): Boolean; +function NtfsSetReparsePoint(const FileName: string; var ReparseData; Size: Longword): Boolean; +function NtfsGetReparsePoint(const FileName: string; var ReparseData: TReparseGuidDataBuffer): Boolean; +function NtfsGetReparseTag(const Path: string; var Tag: DWORD): Boolean; +function NtfsReparsePointsSupported(const Volume: string): Boolean; +function NtfsFileHasReparsePoint(const Path: string): Boolean; + +// NTFS - Volume Mount Points +function NtfsIsFolderMountPoint(const Path: string): Boolean; +function NtfsMountDeviceAsDrive(const Device: WideString; Drive: Char): Boolean; +function NtfsMountVolume(const Volume: WideChar; const MountPoint: WideString): Boolean; + +// NTFS - Change Journal +// NTFS - Opportunistic Locks +type + TOpLock = (olExclusive, olReadOnly, olBatch, olFilter); + +function NtfsOpLockAckClosePending(Handle: THandle; Overlapped: TOverlapped): Boolean; +function NtfsOpLockBreakAckNo2(Handle: THandle; Overlapped: TOverlapped): Boolean; +function NtfsOpLockBreakAcknowledge(Handle: THandle; Overlapped: TOverlapped): Boolean; +function NtfsOpLockBreakNotify(Handle: THandle; Overlapped: TOverlapped): Boolean; +function NtfsRequestOpLock(Handle: THandle; Kind: TOpLock; Overlapped: TOverlapped): Boolean; + +// Junction Points +function NtfsIsJunctionPoint(const Path: string): Boolean; +function NtfsCreateJunctionPoint(const Source, Destination: string): Boolean; +function NtfsDeleteJunctionPoint(const Source: string): Boolean; +function NtfsGetJunctionPointDestination(const Source: string; var Destination: string; RemovePathPrefix: Boolean = False): Boolean; + +// Symbolic Links +function NtfsIsSymlink(const Path: string): Boolean; +function NtfsGetSymlinkDestination(const Source: string; var Destination: string; RemovePathPrefix: Boolean = False): Boolean; + +function NtfsGetReparsePointDestination(const Source: string; var Destination: string; RemovePathPrefix: Boolean = False): Boolean; + +// Streams +type + TStreamId = (siInvalid, siStandard, siExtendedAttribute, siSecurity, siAlternate, + siHardLink, siProperty, siObjectIdentifier, siReparsePoints, siSparseFile); + TStreamIds = set of TStreamId; + + TInternalFindStreamData = record + FileHandle: THandle; + Context: Pointer; + StreamIds: TStreamIds; + end; + + TFindStreamData = record + Internal: TInternalFindStreamData; + Attributes: DWORD; + StreamID: TStreamId; + Name: WideString; + Size: Int64; + end; + +function NtfsFindFirstStream(const FileName: string; StreamIds: TStreamIds; var Data: TFindStreamData): Boolean; +function NtfsFindNextStream(var Data: TFindStreamData): Boolean; +function NtfsFindStreamClose(var Data: TFindStreamData): Boolean; + +// Hard links +function NtfsCreateHardLink(const LinkFileName, ExistingFileName: String): Boolean; +// ANSI-specific version +function NtfsCreateHardLinkA(const LinkFileName, ExistingFileName: AnsiString): Boolean; +// UNICODE-specific version +function NtfsCreateHardLinkW(const LinkFileName, ExistingFileName: WideString): Boolean; + +type + TNtfsHardLinkInfo = record + LinkCount: Cardinal; + case Integer of + 0: ( + FileIndexHigh: Cardinal; + FileIndexLow: Cardinal); + 1: ( + FileIndex: Int64); + end; + +function NtfsGetHardLinkInfo(const FileName: string; var Info: TNtfsHardLinkInfo): Boolean; + +function NtfsFindHardLinks(const Path: string; const FileIndexHigh, FileIndexLow: Cardinal; const List: TStrings): Boolean; +function NtfsDeleteHardLinks(const FileName: string): Boolean; + +// NTFS File summary +type + EJclFileSummaryError = class(EJclError); + + TJclFileSummaryAccess = (fsaRead, fsaWrite, fsaReadWrite); + TJclFileSummaryShare = (fssDenyNone, fssDenyRead, fssDenyWrite, fssDenyAll); + TJclFileSummaryPropSetCallback = function(const FMTID: TGUID): Boolean of object; + TJclFileSummaryPropCallback = function(const Name: WideString; ID: TPropID; + Vt: TVarType): Boolean of object; + + TJclFileSummary = class; + + TJclFilePropertySet = class + private + FPropertyStorage: IPropertyStorage; + public + constructor Create(APropertyStorage: IPropertyStorage); + destructor Destroy; override; + + class function GetFMTID: TGUID; virtual; + function GetProperty(ID: TPropID): TPropVariant; overload; + function GetProperty(const Name: WideString): TPropVariant; overload; + procedure SetProperty(ID: TPropID; const Value: TPropVariant); overload; + procedure SetProperty(const Name: WideString; const Value: TPropVariant; + AllocationBase: TPropID = PID_FIRST_USABLE); overload; + procedure DeleteProperty(ID: TPropID); overload; + procedure DeleteProperty(const Name: WideString); overload; + function EnumProperties(Proc: TJclFileSummaryPropCallback): Boolean; + + // casted properties + // Type of ID changed to Integer to be compatible with indexed properties + // VT_LPWSTR + function GetWideStringProperty(const ID: Integer): WideString; + procedure SetWideStringProperty(const ID: Integer; const Value: WideString); + // VT_LPSTR + function GetAnsiStringProperty(const ID: Integer): AnsiString; + procedure SetAnsiStringProperty(const ID: Integer; const Value: AnsiString); + // VT_I4 + function GetIntegerProperty(const ID: Integer): Integer; + procedure SetIntegerProperty(const ID: Integer; const Value: Integer); + // VT_UI4 + function GetCardinalProperty(const ID: Integer): Cardinal; + procedure SetCardinalProperty(const ID: Integer; const Value: Cardinal); + // VT_FILETIME + function GetFileTimeProperty(const ID: Integer): TFileTime; + procedure SetFileTimeProperty(const ID: Integer; const Value: TFileTime); + // VT_CF + function GetClipDataProperty(const ID: Integer): PClipData; + procedure SetClipDataProperty(const ID: Integer; const Value: PClipData); + // VT_BOOL + function GetBooleanProperty(const ID: Integer): Boolean; + procedure SetBooleanProperty(const ID: Integer; const Value: Boolean); + // VT_VARIANT | VT_VECTOR + function GetTCAPROPVARIANTProperty(const ID: Integer): TCAPROPVARIANT; + procedure SetTCAPROPVARIANTProperty(const ID: Integer; const Value: TCAPROPVARIANT); + // // VT_LPSTR | VT_VECTOR + function GetTCALPSTRProperty(const ID: Integer): TCALPSTR; + procedure SetTCALPSTRProperty(const ID: Integer; const Value: TCALPSTR); + // VT_UI2 + function GetWordProperty(const ID: Integer): Word; + procedure SetWordProperty(const ID: Integer; const Value: Word); + // VT_BSTR + function GetBSTRProperty(const ID: Integer): WideString; + procedure SetBSTRProperty(const ID: Integer; const Value: WideString); + + // property names + function GetPropertyName(ID: TPropID): WideString; + procedure SetPropertyName(ID: TPropID; const Name: WideString); + procedure DeletePropertyName(ID: TPropID); + end; + + TJclFilePropertySetClass = class of TJclFilePropertySet; + + TJclFileSummary = class + private + FFileName: WideString; + FAccessMode: TJclFileSummaryAccess; + FShareMode: TJclFileSummaryShare; + FStorage: IPropertySetStorage; + public + constructor Create(AFileName: WideString; AAccessMode: TJclFileSummaryAccess; + AShareMode: TJclFileSummaryShare; AsDocument: Boolean = False; + ACreate: Boolean = False); + destructor Destroy; override; + + function CreatePropertySet(AClass: TJclFilePropertySetClass; ResetExisting: Boolean): TJclFilePropertySet; + procedure GetPropertySet(AClass: TJclFilePropertySetClass; out Instance); overload; + procedure GetPropertySet(const FMTID: TGUID; out Instance); overload; + function GetPropertySet(const FMTID: TGUID): IPropertyStorage; overload; + procedure DeletePropertySet(const FMTID: TGUID); overload; + procedure DeletePropertySet(AClass: TJclFilePropertySetClass); overload; + function EnumPropertySet(Proc: TJclFileSummaryPropSetCallback): Boolean; + + property FileName: WideString read FFileName; + property AccessMode: TJclFileSummaryAccess read FAccessMode; + property ShareMode: TJclFileSummaryShare read FShareMode; + end; + + TJclFileSummaryInformation = class(TJclFilePropertySet) + public + class function GetFMTID: TGUID; override; + + property Title: AnsiString index PIDSI_TITLE read GetAnsiStringProperty + write SetAnsiStringProperty; + property Subject: AnsiString index PIDSI_SUBJECT read GetAnsiStringProperty + write SetAnsiStringProperty; + property Author: AnsiString index PIDSI_AUTHOR read GetAnsiStringProperty + write SetAnsiStringProperty; + property KeyWords: AnsiString index PIDSI_KEYWORDS read GetAnsiStringProperty + write SetAnsiStringProperty; + property Comments: AnsiString index PIDSI_COMMENTS read GetAnsiStringProperty + write SetAnsiStringProperty; + property Template: AnsiString index PIDSI_TEMPLATE read GetAnsiStringProperty + write SetAnsiStringProperty; + property LastAuthor: AnsiString index PIDSI_LASTAUTHOR read GetAnsiStringProperty + write SetAnsiStringProperty; + property RevNumber: AnsiString index PIDSI_REVNUMBER read GetAnsiStringProperty + write SetAnsiStringProperty; + property EditTime: TFileTime index PIDSI_EDITTIME read GetFileTimeProperty + write SetFileTimeProperty; + property LastPrintedTime: TFileTime index PIDSI_LASTPRINTED read GetFileTimeProperty + write SetFileTimeProperty; + property CreationTime: TFileTime index PIDSI_CREATE_DTM read GetFileTimeProperty + write SetFileTimeProperty; + property LastSaveTime: TFileTime index PIDSI_LASTSAVE_DTM read GetFileTimeProperty + write SetFileTimeProperty; + property PageCount: Integer index PIDSI_PAGECOUNT read GetIntegerProperty + write SetIntegerProperty; + property WordCount: Integer index PIDSI_WORDCOUNT read GetIntegerProperty + write SetIntegerProperty; + property CharCount: Integer index PIDSI_CHARCOUNT read GetIntegerProperty + write SetIntegerProperty; + property Thumnail: PClipData index PIDSI_THUMBNAIL read GetClipDataProperty + write SetClipDataProperty; + property AppName: AnsiString index PIDSI_APPNAME read GetAnsiStringProperty + write SetAnsiStringProperty; + property Security: Integer index PIDSI_DOC_SECURITY read GetIntegerProperty + write SetIntegerProperty; + end; + + TJclDocSummaryInformation = class(TJclFilePropertySet) + public + class function GetFMTID: TGUID; override; + + property Category: AnsiString index PIDDSI_CATEGORY read GetAnsiStringProperty + write SetAnsiStringProperty; + property PresFormat: AnsiString index PIDDSI_PRESFORMAT read GetAnsiStringProperty + write SetAnsiStringProperty; + property ByteCount: Integer index PIDDSI_BYTECOUNT read GetIntegerProperty + write SetIntegerProperty; + property LineCount: Integer index PIDDSI_LINECOUNT read GetIntegerProperty + write SetIntegerProperty; + property ParCount: Integer index PIDDSI_PARCOUNT read GetIntegerProperty + write SetIntegerProperty; + property SlideCount: Integer index PIDDSI_SLIDECOUNT read GetIntegerProperty + write SetIntegerProperty; + property NoteCount: Integer index PIDDSI_NOTECOUNT read GetIntegerProperty + write SetIntegerProperty; + property HiddenCount: Integer index PIDDSI_HIDDENCOUNT read GetIntegerProperty + write SetIntegerProperty; + property MMClipCount: Integer index PIDDSI_MMCLIPCOUNT read GetIntegerProperty + write SetIntegerProperty; + property Scale: Boolean index PIDDSI_SCALE read GetBooleanProperty + write SetBooleanProperty; + property HeadingPair: TCAPROPVARIANT index PIDDSI_HEADINGPAIR read GetTCAPROPVARIANTProperty + write SetTCAPROPVARIANTProperty; + property DocParts: TCALPSTR index PIDDSI_DOCPARTS read GetTCALPSTRProperty + write SetTCALPSTRProperty; + property Manager: AnsiString index PIDDSI_MANAGER read GetAnsiStringProperty + write SetAnsiStringProperty; + property Company: AnsiString index PIDDSI_COMPANY read GetAnsiStringProperty + write SetAnsiStringProperty; + property LinksDirty: Boolean index PIDDSI_LINKSDIRTY read GetBooleanProperty + write SetBooleanProperty; + end; + + TJclMediaFileSummaryInformation = class(TJclFilePropertySet) + public + class function GetFMTID: TGUID; override; + + property Editor: WideString index PIDMSI_EDITOR read GetWideStringProperty + write SetWideStringProperty; + property Supplier: WideString index PIDMSI_SUPPLIER read GetWideStringProperty + write SetWideStringProperty; + property Source: WideString index PIDMSI_SOURCE read GetWideStringProperty + write SetWideStringProperty; + property SequenceNo: WideString index PIDMSI_SEQUENCE_NO read GetWideStringProperty + write SetWideStringProperty; + property Project: WideString index PIDMSI_PROJECT read GetWideStringProperty + write SetWideStringProperty; + property Status: Cardinal index PIDMSI_STATUS read GetCardinalProperty + write SetCardinalProperty; + property Owner: WideString index PIDMSI_OWNER read GetWideStringProperty + write SetWideStringProperty; + property Rating: WideString index PIDMSI_RATING read GetWideStringProperty + write SetWideStringProperty; + property Production: TFileTime index PIDMSI_PRODUCTION read GetFileTimeProperty + write SetFileTimeProperty; + property Copyright: WideString index PIDMSI_COPYRIGHT read GetWideStringProperty + write SetWideStringProperty; + end; + + TJclMSISummaryInformation = class(TJclFilePropertySet) + public + class function GetFMTID: TGUID; override; + + property Version: Integer index PID_MSIVERSION read GetIntegerProperty + write SetIntegerProperty; // integer, Installer version number (major*100+minor) + property Source: Integer index PID_MSISOURCE read GetIntegerProperty + write SetIntegerProperty; // integer, type of file image, short/long, media/tree + property Restrict: Integer index PID_MSIRESTRICT read GetIntegerProperty + write SetIntegerProperty; // integer, transform restrictions + end; + + TJclShellSummaryInformation = class(TJclFilePropertySet) + public + class function GetFMTID: TGUID; override; + + {PID_FINDDATA = 0; + PID_NETRESOURCE = 1; + PID_DESCRIPTIONID = 2; + PID_WHICHFOLDER = 3; + PID_NETWORKLOCATION = 4; + PID_COMPUTERNAME = 5;} + end; + + TJclStorageSummaryInformation = class(TJclFilePropertySet) + public + class function GetFMTID: TGUID; override; + end; + + TJclImageSummaryInformation = class(TJclFilePropertySet) + public + class function GetFMTID: TGUID; override; + end; + + TJclDisplacedSummaryInformation = class(TJclFilePropertySet) + public + class function GetFMTID: TGUID; override; + + {PID_FINDDATA = 0; + PID_NETRESOURCE = 1; + PID_DESCRIPTIONID = 2; + PID_WHICHFOLDER = 3; + PID_NETWORKLOCATION = 4; + PID_COMPUTERNAME = 5;} + end; + + TJclBriefCaseSummaryInformation = class(TJclFilePropertySet) + public + class function GetFMTID: TGUID; override; + + {PID_SYNC_COPY_IN = 2;} + end; + + TJclMiscSummaryInformation = class(TJclFilePropertySet) + public + class function GetFMTID: TGUID; override; + + {PID_MISC_STATUS = 2; + PID_MISC_ACCESSCOUNT = 3; + PID_MISC_OWNER = 4; + PID_HTMLINFOTIPFILE = 5; + PID_MISC_PICS = 6;} + end; + + TJclWebViewSummaryInformation = class(TJclFilePropertySet) + public + class function GetFMTID: TGUID; override; + + {PID_DISPLAY_PROPERTIES = 0; + PID_INTROTEXT = 1;} + end; + + TJclMusicSummaryInformation = class(TJclFilePropertySet) + public + class function GetFMTID: TGUID; override; + {PIDSI_ARTIST = 2; + PIDSI_SONGTITLE = 3; + PIDSI_ALBUM = 4; + PIDSI_YEAR = 5; + PIDSI_COMMENT = 6; + PIDSI_TRACK = 7; + PIDSI_GENRE = 11; + PIDSI_LYRICS = 12;} + end; + + TJclDRMSummaryInformation = class(TJclFilePropertySet) + public + class function GetFMTID: TGUID; override; + {PIDDRSI_PROTECTED = 2; + PIDDRSI_DESCRIPTION = 3; + PIDDRSI_PLAYCOUNT = 4; + PIDDRSI_PLAYSTARTS = 5; + PIDDRSI_PLAYEXPIRES = 6;} + end; + + TJclVideoSummaryInformation = class(TJclFilePropertySet) + public + class function GetFMTID: TGUID; override; + + property StreamName: WideString index PIDVSI_STREAM_NAME read GetWideStringProperty + write SetWideStringProperty; // "StreamName", VT_LPWSTR + property Width: Cardinal index PIDVSI_FRAME_WIDTH read GetCardinalProperty + write SetCardinalProperty; // "FrameWidth", VT_UI4 + property Height: Cardinal index PIDVSI_FRAME_HEIGHT read GetCardinalProperty + write SetCardinalProperty; // "FrameHeight", VT_UI4 + property TimeLength: Cardinal index PIDVSI_TIMELENGTH read GetCardinalProperty + write SetCardinalProperty; // "TimeLength", VT_UI4, milliseconds + property FrameCount: Cardinal index PIDVSI_FRAME_COUNT read GetCardinalProperty + write SetCardinalProperty; // "FrameCount". VT_UI4 + property FrameRate: Cardinal index PIDVSI_FRAME_RATE read GetCardinalProperty + write SetCardinalProperty; // "FrameRate", VT_UI4, frames/millisecond + property DataRate: Cardinal index PIDVSI_DATA_RATE read GetCardinalProperty + write SetCardinalProperty; // "DataRate", VT_UI4, bytes/second + property SampleSize: Cardinal index PIDVSI_SAMPLE_SIZE read GetCardinalProperty + write SetCardinalProperty; // "SampleSize", VT_UI4 + property Compression: WideString index PIDVSI_COMPRESSION read GetWideStringProperty + write SetWideStringProperty; // "Compression", VT_LPWSTR + property StreamNumber: Word index PIDVSI_STREAM_NUMBER read GetWordProperty + write SetWordProperty; // "StreamNumber", VT_UI2} + end; + + TJclAudioSummaryInformation = class(TJclFilePropertySet) + public + class function GetFMTID: TGUID; override; + + property Format: WideString index PIDASI_FORMAT read GetBSTRProperty + write SetBSTRProperty; // VT_BSTR + property TimeLength: Cardinal index PIDASI_TIMELENGTH read GetCardinalProperty + write SetCardinalProperty; // VT_UI4, milliseconds + property AverageDataRate: Cardinal index PIDASI_AVG_DATA_RATE read GetCardinalProperty + write SetCardinalProperty; // VT_UI4, Hz + property SampleRate: Cardinal index PIDASI_SAMPLE_RATE read GetCardinalProperty + write SetCardinalProperty; // VT_UI4, bits + property SampleSize: Cardinal index PIDASI_SAMPLE_SIZE read GetCardinalProperty + write SetCardinalProperty; // VT_UI4, bits + property ChannelCount: Cardinal index PIDASI_CHANNEL_COUNT read GetCardinalProperty + write SetCardinalProperty; // VT_UI4 + property StreamNumber: Word index PIDASI_STREAM_NUMBER read GetWordProperty + write SetWordProperty; // VT_UI2 + property StreamName: WideString index PIDASI_STREAM_NAME read GetWideStringProperty + write SetWideStringProperty; // VT_LPWSTR + property Compression: WideString index PIDASI_COMPRESSION read GetWideStringProperty + write SetWideStringProperty; // VT_LPWSTR} + end; + + TJclControlPanelSummaryInformation = class(TJclFilePropertySet) + public + class function GetFMTID: TGUID; override; + {PID_CONTROLPANEL_CATEGORY = 2;} + end; + + TJclVolumeSummaryInformation = class(TJclFilePropertySet) + public + class function GetFMTID: TGUID; override; + {PID_VOLUME_FREE = 2; + PID_VOLUME_CAPACITY = 3; + PID_VOLUME_FILESYSTEM = 4;} + end; + + TJclShareSummaryInformation = class(TJclFilePropertySet) + public + class function GetFMTID: TGUID; override; + {PID_SHARE_CSC_STATUS = 2;} + end; + + TJclLinkSummaryInformation = class(TJclFilePropertySet) + public + class function GetFMTID: TGUID; override; + {PID_LINK_TARGET = 2;} + end; + + TJclQuerySummaryInformation = class(TJclFilePropertySet) + public + class function GetFMTID: TGUID; override; + {PID_QUERY_RANK = 2;} + end; + + TJclImageInformation = class(TJclFilePropertySet) + public + class function GetFMTID: TGUID; override; + {FMTID_ImageInformation} + end; + + TJclJpegSummaryInformation = class(TJclFilePropertySet) + public + class function GetFMTID: TGUID; override; + {FMTID_JpegAppHeaders} + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.Win.ComObj, + {$ELSE ~HAS_UNITSCOPE} + ComObj, + {$ENDIF ~HAS_UNITSCOPE} + Hardlinks, + JclSysUtils, JclFileUtils, JclSysInfo, JclResources; + +//=== NTFS - Compression ===================================================== + +// Helper consts, helper types, helper routines + +const + CompressionFormat: array [TFileCompressionState] of Short = + ( + COMPRESSION_FORMAT_NONE, + COMPRESSION_FORMAT_DEFAULT, + COMPRESSION_FORMAT_LZNT1 + ); + + // use IsDirectory(FileName) as array index + FileFlag: array [Boolean] of DWORD = (0, FILE_FLAG_BACKUP_SEMANTICS); + +type + TStackFrame = packed record + CallersEBP: TJclAddr; + CallerAddress: TJclAddr; + end; + + EJclInvalidArgument = class(EJclError); + +{$STACKFRAMES OFF} + +function CallersCallerAddress: Pointer; +asm + {$IFDEF CPU32} + MOV EAX, [EBP] + MOV EAX, TStackFrame([EAX]).CallerAddress + {$ENDIF CPU32} + {$IFDEF CPU64} + MOV RAX, [RBP] + MOV RAX, TStackFrame([RAX]).CallerAddress + {$ENDIF CPU64} +end; + +{$STACKFRAMES ON} + +procedure ValidateArgument(Condition: Boolean; const Routine: string; + const Argument: string); +begin + if not Condition then + raise EJclInvalidArgument.CreateResFmt(@RsInvalidArgument, [Routine, Argument]) + at CallersCallerAddress; +end; + +{$IFNDEF STACKFRAMES_ON} +{$STACKFRAMES OFF} +{$ENDIF ~STACKFRAMES_ON} + +function SetCompression(const FileName: string; const State: Short; FileFlag: DWORD): Boolean; +var + Handle: THandle; + BytesReturned: DWORD; + Buffer: Short; +begin + Result := False; + Handle := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE, + FILE_SHARE_READ, nil, OPEN_EXISTING, FileFlag, 0); + if Handle <> INVALID_HANDLE_VALUE then + try + Buffer := State; + BytesReturned := 0; + Result := DeviceIoControl(Handle, FSCTL_SET_COMPRESSION, @Buffer, + SizeOf(Short), nil, 0, BytesReturned, nil); + finally + CloseHandle(Handle); + end +end; + +function SetPathCompression(Dir: string; const Mask: string; const State: Short; + const SetDefault, Recursive: Boolean): Boolean; +var + FileName: string; + SearchRec: TSearchRec; + R: Integer; +begin + if SetDefault then + Result := SetCompression(Dir, State, FILE_FLAG_BACKUP_SEMANTICS) + else + Result := True; + if Result then + begin + Dir := PathAddSeparator(Dir); + if FindFirst(Dir + Mask, faAnyFile, SearchRec) = 0 then + try + repeat + if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then + begin + FileName := Dir + SearchRec.Name; + if (SearchRec.Attr and faDirectory) = 0 then + Result := SetCompression(FileName, State, 0) + else + if Recursive then + Result := SetPathCompression(FileName, Mask, State, SetDefault, True); + if not Result then + Exit; + end; + R := FindNext(SearchRec); + until R <> 0; + Result := (R = ERROR_NO_MORE_FILES); + finally + {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindClose(SearchRec); + end; + end; +end; + +function NtfsGetCompression(const FileName: TFileName; out State: Short): Boolean; +var + Handle: THandle; + BytesReturned: DWORD; +begin + State := 0; + Result := False; + Handle := CreateFile(PChar(FileName), 0, 0, nil, OPEN_EXISTING, + FileFlag[IsDirectory(FileName)], 0); + if Handle <> INVALID_HANDLE_VALUE then + try + BytesReturned := 0; + Result := DeviceIoControl(Handle, FSCTL_GET_COMPRESSION, nil, 0, @State, + SizeOf(Short), BytesReturned, nil); + finally + CloseHandle(Handle); + end; +end; + +function NtfsGetCompression(const FileName: TFileName): TFileCompressionState; +var + State: Short; +begin + if not NtfsGetCompression(FileName, State) then + RaiseLastOSError; + case State of + COMPRESSION_FORMAT_NONE: + Result := fcNoCompression; + COMPRESSION_FORMAT_LZNT1: + Result := fcLZNT1Compression; + else + // (rom) very dubious. + Assert(False, 'TFileCompressionState requires expansion'); + Result := TFileCompressionState(State); + end; +end; + +function NtfsSetCompression(const FileName: TFileName; const State: Short): Boolean; +begin + Result := SetCompression(FileName, State, FileFlag[IsDirectory(FileName)]); +end; + +{$STACKFRAMES ON} + +procedure NtfsSetFileCompression(const FileName: TFileName; const State: TFileCompressionState); +begin + ValidateArgument(not IsDirectory(FileName), 'NtfsSetFileCompression', 'FileName'); + if not SetCompression(FileName, CompressionFormat[State], 0) then + RaiseLastOSError; +end; + +procedure NtfsSetDefaultFileCompression(const Directory: string; const State: TFileCompressionState); +begin + ValidateArgument(IsDirectory(Directory), 'NtfsSetDefaultFileCompression', 'Directory'); + if not SetCompression(Directory, CompressionFormat[State], FILE_FLAG_BACKUP_SEMANTICS) then + RaiseLastOSError; +end; + +procedure NtfsSetDirectoryTreeCompression(const Directory: string; const State: TFileCompressionState); +begin + ValidateArgument(IsDirectory(Directory), 'NtfsSetDirectoryTreeCompression', 'Directory'); + if not SetPathCompression(Directory, '*', CompressionFormat[State], True, True) then + RaiseLastOSError; +end; + +{$IFNDEF STACKFRAMES_ON} +{$STACKFRAMES OFF} +{$ENDIF ~STACKFRAMES_ON} + +procedure NtfsSetPathCompression(const Path: string; + const State: TFileCompressionState; Recursive: Boolean); +var + Dir, Mask: string; + SetDefault: Boolean; +begin + SetDefault := IsDirectory(Path); + if SetDefault then + begin + Dir := Path; + Mask := '*'; + end + else + begin + Dir := ExtractFilePath(Path); + Mask := ExtractFileName(Path); + if Mask = '' then + Mask := '*'; + end; + if not SetPathCompression(Dir, Mask, CompressionFormat[State], SetDefault, Recursive) then + RaiseLastOSError; +end; + +//=== NTFS - Sparse Files ==================================================== + +function NtfsSetSparse(const FileName: string): Boolean; +var + Handle: THandle; + BytesReturned: DWORD; +begin + Result := False; + Handle := CreateFile(PChar(FileName), GENERIC_WRITE, 0, nil, OPEN_EXISTING, 0, 0); + if Handle <> INVALID_HANDLE_VALUE then + try + BytesReturned := 0; + Result := DeviceIoControl(Handle, FSCTL_SET_SPARSE, nil, 0, nil, 0, BytesReturned, nil); + finally + CloseHandle(Handle); + end; +end; + +function NtfsZeroDataByHandle(const Handle: THandle; const First, Last: Int64): Boolean; +var + BytesReturned: DWORD; + ZeroDataInfo: TFileZeroDataInformation; + Info: TByHandleFileInformation; +begin + Result := False; + if Handle <> INVALID_HANDLE_VALUE then + begin + // Continue only if the file is a sparse file, this avoids the overhead + // associated with an IOCTL when the file isn't even a sparse file. + ResetMemory(Info, SizeOf(Info)); + GetFileInformationByHandle(Handle, Info); + Result := (Info.dwFileAttributes and FILE_ATTRIBUTE_SPARSE_FILE) <> 0; + if Result then + begin + ZeroDataInfo.FileOffset.QuadPart := First; + ZeroDataInfo.BeyondFinalZero.QuadPart := Last; + BytesReturned := 0; + Result := DeviceIoControl(Handle, FSCTL_SET_ZERO_DATA, @ZeroDataInfo, + SizeOf(ZeroDataInfo), nil, 0, BytesReturned, nil); + end; + end; +end; + +function NtfsZeroDataByName(const FileName: string; const First, Last: Int64): Boolean; +var + Handle: THandle; +begin + Result := False; + Handle := CreateFile(PChar(FileName), GENERIC_WRITE, 0, nil, OPEN_EXISTING, 0, 0); + if Handle <> INVALID_HANDLE_VALUE then + try + Result := NtfsZeroDataByHandle(Handle, First, Last); + finally + CloseHandle(Handle); + end; +end; + +function NtfsGetAllocRangeEntry(const Ranges: TNtfsAllocRanges; + Index: TJclAddr): TFileAllocatedRangeBuffer; +var + Offset: TJclAddr; +begin + Assert(Index < Ranges.Entries); + Offset := TJclAddr(Ranges.Data) + Index * SizeOf(TFileAllocatedRangeBuffer); + Result := PFileAllocatedRangeBuffer(Offset)^; +end; + +function __QueryAllocRanges(const Handle: THandle; const Offset, Count: Int64; + var Ranges: PFileAllocatedRangeBuffer; var MoreData: Boolean; var Size: Cardinal): Boolean; +var + BytesReturned: DWORD; + SearchRange: TFileAllocatedRangeBuffer; + BufferSize: Cardinal; +begin + SearchRange.FileOffset.QuadPart := Offset; + SearchRange.Length.QuadPart := Count; + BufferSize := 4 * 64 * SizeOf(TFileAllocatedRangeBuffer); + Ranges := AllocMem(BufferSize); + BytesReturned := 0; + Result := DeviceIoControl(Handle, FSCTL_QUERY_ALLOCATED_RANGES, @SearchRange, + SizeOf(SearchRange), Ranges, BufferSize, BytesReturned, nil); + MoreData := GetLastError = ERROR_MORE_DATA; + if MoreData then + Result := True; + Size := BytesReturned; + if BytesReturned = 0 then + begin + FreeMem(Ranges); + Ranges := nil; + end; +end; + +function NtfsQueryAllocRanges(const FileName: string; Offset, Count: Int64; + var Ranges: TNtfsAllocRanges): Boolean; +var + Handle: THandle; + CurrRanges: PFileAllocatedRangeBuffer; + R, MoreData: Boolean; + Size: Cardinal; +begin + Result := False; + Handle := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0); + if Handle <> INVALID_HANDLE_VALUE then + try + Size := 0; + MoreData := False; + CurrRanges := nil; + R := __QueryAllocRanges(Handle, Offset, Count, CurrRanges, MoreData, Size); + Ranges.MoreData := MoreData; + Result := R; + if R then + begin + Ranges.Entries := Size div SizeOf(TFileAllocatedRangeBuffer); + Ranges.Data := CurrRanges; + end + else + begin + Ranges.Entries := 0; + Ranges.Data := nil; + end; + finally + CloseHandle(Handle); + end; +end; + +function NtfsSparseStreamsSupported(const Volume: string): Boolean; +begin + Result := fsSupportsSparseFiles in GetVolumeFileSystemFlags(Volume); +end; + +function NtfsGetSparse(const FileName: string): Boolean; +var + Handle: THandle; + Info: TByHandleFileInformation; +begin + Result := False; + Handle := CreateFile(PChar(FileName), FILE_READ_ATTRIBUTES, FILE_SHARE_READ or FILE_SHARE_WRITE, + nil, OPEN_EXISTING, 0, 0); + if Handle <> INVALID_HANDLE_VALUE then + try + ResetMemory(Info, SizeOf(Info)); + GetFileInformationByHandle(Handle, Info); + Result := (Info.dwFileAttributes and FILE_ATTRIBUTE_SPARSE_FILE) <> 0; + finally + CloseHandle(Handle); + end; +end; + +//=== NTFS - Reparse Points ================================================== + +function NtfsGetReparseTag(const Path: string; var Tag: DWORD): Boolean; +var + SearchRec: TSearchRec; +begin + Result := NtfsFileHasReparsePoint(Path); + if Result then + begin + Result := FindFirst(Path, faAnyFile, SearchRec) = 0; + if Result then + begin + // Check if file has a reparse point + Result := ((SearchRec.Attr and FILE_ATTRIBUTE_REPARSE_POINT) <> 0); + // If so the dwReserved0 field contains the reparse tag + if Result then + Tag := SearchRec.FindData.dwReserved0; + FindClose(SearchRec); + end; + end; +end; + +function NtfsReparsePointsSupported(const Volume: string): Boolean; +begin + Result := fsSupportsReparsePoints in GetVolumeFileSystemFlags(Volume); +end; + +function NtfsFileHasReparsePoint(const Path: string): Boolean; +var + Attr: DWORD; +begin + Result := False; + Attr := GetFileAttributes(PChar(Path)); + if Attr <> DWORD(-1) then + Result := (Attr and FILE_ATTRIBUTE_REPARSE_POINT) <> 0; +end; + +function NtfsDeleteReparsePoint(const FileName: string; ReparseTag: DWORD): Boolean; +var + Handle: THandle; + BytesReturned: DWORD; + ReparseData: TReparseGuidDataBuffer; +begin + Result := False; + Handle := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE, 0, nil, + OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OPEN_REPARSE_POINT, 0); + if Handle <> INVALID_HANDLE_VALUE then + try + ResetMemory(ReparseData, SizeOf(ReparseData)); + ReparseData.ReparseTag := ReparseTag; + BytesReturned := 0; + Result := DeviceIoControl(Handle, FSCTL_DELETE_REPARSE_POINT, @ReparseData, + REPARSE_GUID_DATA_BUFFER_HEADER_SIZE, nil, 0, BytesReturned, nil); + finally + CloseHandle(Handle); + end; +end; + +function NtfsSetReparsePoint(const FileName: string; var ReparseData; Size: Longword): Boolean; +var + Handle: THandle; + BytesReturned: DWORD; +begin + Result := False; + Handle := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE, 0, nil, + OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OPEN_REPARSE_POINT, 0); + if Handle <> INVALID_HANDLE_VALUE then + try + BytesReturned := 0; + Result := DeviceIoControl(Handle, FSCTL_SET_REPARSE_POINT, @ReparseData, + Size, nil, 0, BytesReturned, nil); + finally + CloseHandle(Handle); + end; +end; + +function NtfsGetReparsePoint(const FileName: string; var ReparseData: TReparseGuidDataBuffer): Boolean; +var + Handle: THandle; + BytesReturned: DWORD; + LastError: DWORD; +begin + Result := False; + Handle := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ, nil, + OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OPEN_REPARSE_POINT, 0); + LastError := GetLastError; + if Handle <> INVALID_HANDLE_VALUE then + try + BytesReturned := 0; + Result := DeviceIoControl(Handle, FSCTL_GET_REPARSE_POINT, nil, 0, @ReparseData, + ReparseData.ReparseDataLength + SizeOf(ReparseData), BytesReturned, nil); + if not Result then + begin + ReparseData.ReparseDataLength := BytesReturned; + LastError := GetLastError; + end; + finally + CloseHandle(Handle); + SetLastError(LastError); + end; +end; + +//=== NTFS - Volume Mount Points ============================================= + +function NtfsIsFolderMountPoint(const Path: string): Boolean; +var + Tag: DWORD; +begin + Tag := 0; + Result := NtfsGetReparseTag(Path, Tag); + if Result then + Result := (Tag = IO_REPARSE_TAG_MOUNT_POINT); +end; + +function NtfsMountDeviceAsDrive(const Device: WideString; Drive: Char): Boolean; +const + DDD_FLAGS = DDD_RAW_TARGET_PATH or DDD_REMOVE_DEFINITION or DDD_EXACT_MATCH_ON_REMOVE; +var + DriveStr: WideString; + VolumeName: WideString; +begin + // To create a mount point we must obtain a unique volume name first. To obtain + // a unique volume name the drive must exist. Therefore we must temporarily + // create a symbolic link for the drive using DefineDosDevice. + DriveStr := Drive + ':'; + Result := DefineDosDeviceW(DDD_RAW_TARGET_PATH, PWideChar(DriveStr), PWideChar(Device)); + if Result then + begin + SetLength(VolumeName, 1024); + Result := RtdlGetVolumeNameForVolumeMountPointW(PWideChar(DriveStr + '\'), PWideChar(VolumeName), 1024); + // Attempt to delete the symbolic link, if it fails then don't attempt to + // set the mountpoint either but raise an exception instead, there's something + // seriously wrong so let's try to control the damage done already :) + if not DefineDosDeviceW(DDD_FLAGS, PWideChar(DriveStr), PWideChar(Device)) then + raise EJclNtfsError.CreateRes(@RsNtfsUnableToDeleteSymbolicLink); + if Result then + Result := RtdlSetVolumeMountPointW(PWideChar(DriveStr + '\'), PWideChar(VolumeName)); + end; +end; + +function NtfsMountVolume(const Volume: WideChar; const MountPoint: WideString): Boolean; +var + VolumeName: WideString; + VolumeStr: WideString; +begin + SetLength(VolumeName, 1024); + VolumeStr := Volume + ':\'; + Result := RtdlGetVolumeNameForVolumeMountPointW(PWideChar(VolumeStr), PWideChar(VolumeName), 1024); + if Result then + begin + if not JclFileUtils.DirectoryExists(MountPoint) then + JclFileUtils.ForceDirectories(MountPoint); + Result := RtdlSetVolumeMountPointW(PWideChar(MountPoint), PWideChar(VolumeName)); + end; +end; + +//=== NTFS - Change Journal ================================================== + +//=== NTFS - Opportunistic Locks ============================================= + +function NtfsOpLockAckClosePending(Handle: THandle; Overlapped: TOverlapped): Boolean; +var + BytesReturned: Cardinal; +begin + BytesReturned := 0; + Result := DeviceIoControl(Handle, FSCTL_OPBATCH_ACK_CLOSE_PENDING, nil, 0, nil, + 0, BytesReturned, @Overlapped); +end; + +function NtfsOpLockBreakAckNo2(Handle: THandle; Overlapped: TOverlapped): Boolean; +var + BytesReturned: Cardinal; +begin + BytesReturned := 0; + Result := DeviceIoControl(Handle, FSCTL_OPLOCK_BREAK_ACK_NO_2, nil, 0, nil, 0, + BytesReturned, @Overlapped); +end; + +function NtfsOpLockBreakAcknowledge(Handle: THandle; Overlapped: TOverlapped): Boolean; +var + BytesReturned: Cardinal; +begin + BytesReturned := 0; + Result := DeviceIoControl(Handle, FSCTL_OPLOCK_BREAK_ACKNOWLEDGE, nil, 0, nil, + 0, BytesReturned, @Overlapped); + Result := Result or (GetLastError = ERROR_IO_PENDING); +end; + +function NtfsOpLockBreakNotify(Handle: THandle; Overlapped: TOverlapped): Boolean; +var + BytesReturned: Cardinal; +begin + BytesReturned := 0; + Result := DeviceIoControl(Handle, FSCTL_OPLOCK_BREAK_NOTIFY, nil, 0, nil, 0, + BytesReturned, @Overlapped); +end; + +function NtfsRequestOpLock(Handle: THandle; Kind: TOpLock; Overlapped: TOverlapped): Boolean; +const + IoCodes: array [TOpLock] of Cardinal = ( + FSCTL_REQUEST_OPLOCK_LEVEL_1, FSCTL_REQUEST_OPLOCK_LEVEL_2, + FSCTL_REQUEST_BATCH_OPLOCK, FSCTL_REQUEST_FILTER_OPLOCK); +var + BytesReturned: Cardinal; +begin + BytesReturned := 0; + Result := DeviceIoControl(Handle, IoCodes[Kind], nil, 0, nil, 0, BytesReturned, @Overlapped); + Result := Result or (GetLastError = ERROR_IO_PENDING); +end; + +//=== Junction Points ======================================================== + +type + TReparseDataBufferOverlay = record + case Boolean of + False: + (Reparse: TReparseDataBuffer;); + True: + (Buffer: array [0..MAXIMUM_REPARSE_DATA_BUFFER_SIZE] of Char;); + end; + +function IsReparseTagValid(Tag: DWORD): Boolean; +begin + Result := (Tag and (not IO_REPARSE_TAG_VALID_VALUES) = 0) and + (Tag > IO_REPARSE_TAG_RESERVED_RANGE); +end; + +function NtfsRemovePathPrefix(Path: PWideChar; var Len: Integer): PWideChar; +begin + Result := Path; + if Len > 4 then + begin + // Remove '\??\' and '\\?\' + if (Path[0] = '\') and (Path[2] = '?') and (Path[3] = '\') and ((Path[1] = '\') or (Path[1] = '?')) then + begin + Inc(Result, 4); + Dec(Len, 4); + end; + end; +end; + +function NtfsReadMountPointDestination(const ReparseData: TReparseDataBufferOverlay; var Destination: string; RemovePathPrefix: Boolean): Boolean; +var + {$IFNDEF UNICODE} + SubstituteName: WideString; + {$ENDIF ~UNICODE} + SubstituteNameAddr: PWideChar; + Offset: Word; + WideLen: Integer; +begin + case ReparseData.Reparse.ReparseTag of + IO_REPARSE_TAG_MOUNT_POINT: + begin + Offset := ReparseData.Reparse.MountPointReparseBuffer.SubstituteNameOffset div SizeOf(WideChar); + SubstituteNameAddr := @ReparseData.Reparse.MountPointReparseBuffer.PathBuffer[Offset]; + WideLen := ReparseData.Reparse.MountPointReparseBuffer.SubstituteNameLength div SizeOf(WideChar); + end; + + IO_REPARSE_TAG_SYMLINK: + begin + Offset := ReparseData.Reparse.SymbolicLinkReparseBuffer.SubstituteNameOffset div SizeOf(WideChar); + SubstituteNameAddr := @ReparseData.Reparse.SymbolicLinkReparseBuffer.PathBuffer[Offset]; + WideLen := ReparseData.Reparse.SymbolicLinkReparseBuffer.SubstituteNameLength div SizeOf(WideChar); + end; + + else + Result := False; + Exit; + end; + + if RemovePathPrefix then + SubstituteNameAddr := NtfsRemovePathPrefix(SubstituteNameAddr, WideLen); + {$IFDEF UNICODE} + SetString(Destination, SubstituteNameAddr, WideLen); + {$ELSE} + SetString(SubstituteName, SubstituteNameAddr, WideLen); + Destination := string(SubstituteName); + {$ENDIF UNICODE} + + Result := True; +end; + +function NtfsIsJunctionPoint(const Path: string): Boolean; +var + Tag: DWORD; +begin + if NtfsGetReparseTag(Path, Tag) then + Result := Tag = IO_REPARSE_TAG_MOUNT_POINT + else + Result := False; +end; + +function NtfsGetReparsePointData(const Path: string; var ReparseData: TReparseDataBufferOverlay): Boolean; +var + Handle: THandle; + BytesReturned: DWORD; + ByteLen: DWORD; +begin + BytesReturned := 0; + Result := False; + if NtfsFileHasReparsePoint(Path) then + begin + Handle := CreateFile(PChar(Path), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, + OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OPEN_REPARSE_POINT, 0); + if Handle <> INVALID_HANDLE_VALUE then + begin + try + if DeviceIoControl(Handle, FSCTL_GET_REPARSE_POINT, nil, 0, @ReparseData, + MAXIMUM_REPARSE_DATA_BUFFER_SIZE, BytesReturned, nil) {and + IsReparseTagValid(ReparseData.Reparse.ReparseTag) then} + then + begin + case ReparseData.Reparse.ReparseTag of + IO_REPARSE_TAG_SYMLINK: + ByteLen := DWORD(ReparseData.Reparse.SymbolicLinkReparseBuffer.SubstituteNameLength) + SizeOf(WideChar); + else + //IO_REPARSE_TAG_MOUNT_POINT: + ByteLen := DWORD(ReparseData.Reparse.MountPointReparseBuffer.SubstituteNameLength) + SizeOf(WideChar); + end; + if BytesReturned >= ByteLen then + Result := True; + end; + finally + CloseHandle(Handle); + end; + end; + end; +end; + +function NtfsCreateJunctionPoint(const Source, Destination: string): Boolean; +var + Dest: array [0..1024] of Char; // Writable copy of Destination + DestW: WideString; // Unicode version of Dest + FullDir: array [0..1024] of Char; + FilePart: PChar; + ReparseData: TReparseDataBufferOverlay; + NameLength: Longword; +begin + Result := False; + // For some reason the destination string must be prefixed with \??\ otherwise + // the IOCTL will fail, ensure it's there. + if Copy(Destination, 1, 3) = '\??' then + StrPCopy(Dest, Destination) + else + begin + // Make sure Destination is a directory or again, the IOCTL will fail. + FilePart := nil; + if (GetFullPathName(PChar(Destination), 1024, FullDir, FilePart) = 0) or + (GetFileAttributes(FullDir) = DWORD(-1)) then + begin + SetLastError(ERROR_PATH_NOT_FOUND); + Exit; + end; + StrPCopy(Dest, '\??\' + Destination); + end; + ResetMemory(ReparseData, SizeOf(ReparseData)); + NameLength := StrLen(Dest) * SizeOf(WideChar); + ReparseData.Reparse.ReparseTag := IO_REPARSE_TAG_MOUNT_POINT; + ReparseData.Reparse.ReparseDataLength := NameLength + 12; + ReparseData.Reparse.MountPointReparseBuffer.SubstituteNameLength := NameLength; + ReparseData.Reparse.MountPointReparseBuffer.PrintNameOffset := NameLength + SizeOf(WideChar); // #0 + // Not the most elegant way to copy an AnsiString into an Unicode buffer but + // let's avoid dependencies on JclUnicode.pas (adds significant resources). + DestW := WideString(Dest); + Move(DestW[1], ReparseData.Reparse.MountPointReparseBuffer.PathBuffer, Length(DestW) * SizeOf(WideChar)); + Result := NtfsSetReparsePoint(Source, ReparseData.Reparse, + ReparseData.Reparse.ReparseDataLength + REPARSE_DATA_BUFFER_HEADER_SIZE); +end; + +function NtfsDeleteJunctionPoint(const Source: string): Boolean; +begin + Result := NtfsDeleteReparsePoint(Source, IO_REPARSE_TAG_MOUNT_POINT); +end; + +function NtfsGetJunctionPointDestination(const Source: string; var Destination: string; RemovePathPrefix: Boolean): Boolean; +var + ReparseData: TReparseDataBufferOverlay; +begin + Result := False; + if NtfsGetReparsePointData(Source, ReparseData) then + if ReparseData.Reparse.ReparseTag = IO_REPARSE_TAG_MOUNT_POINT then + Result := NtfsReadMountPointDestination(ReparseData, Destination, RemovePathPrefix); +end; + +function NtfsIsSymlink(const Path: string): Boolean; +var + Tag: DWORD; +begin + if NtfsGetReparseTag(Path, Tag) then + Result := Tag = IO_REPARSE_TAG_SYMLINK + else + Result := False; +end; + +function NtfsGetSymlinkDestination(const Source: string; var Destination: string; RemovePathPrefix: Boolean): Boolean; +var + ReparseData: TReparseDataBufferOverlay; +begin + Result := False; + if NtfsGetReparsePointData(Source, ReparseData) then + if ReparseData.Reparse.ReparseTag = IO_REPARSE_TAG_SYMLINK then + Result := NtfsReadMountPointDestination(ReparseData, Destination, RemovePathPrefix); +end; + +function NtfsGetReparsePointDestination(const Source: string; var Destination: string; RemovePathPrefix: Boolean): Boolean; +var + ReparseData: TReparseDataBufferOverlay; +begin + Result := False; + if NtfsGetReparsePointData(Source, ReparseData) then + begin + case ReparseData.Reparse.ReparseTag of + IO_REPARSE_TAG_MOUNT_POINT, + IO_REPARSE_TAG_SYMLINK: + Result := NtfsReadMountPointDestination(ReparseData, Destination, RemovePathPrefix); + end; + end; +end; + +//=== Streams ================================================================ + +// FindStream is an internal helper routine for NtfsFindFirstStream and +// NtfsFindNextStream. It uses the backup API to enumerate the streams in an +// NTFS file and returns when it either finds a stream that matches the filter +// specified in the Data parameter or hits EOF. Details are returned through +// the Data parameter and success/failure as the Boolean result value. + +function FindStream(var Data: TFindStreamData): Boolean; +var + Header: TWin32StreamId; + BytesToRead, BytesRead: DWORD; + BytesToSeek: TJclULargeInteger; + Hi, Lo: DWORD; + FoundStream: Boolean; + StreamName: PWideChar; +begin + Result := False; + FoundStream := False; + ResetMemory(Header, SizeOf(Header)); + // We loop until we either found a stream or an error occurs. + while not FoundStream do + begin + // Read stream header + BytesToRead := DWORD(TJclAddr(@Header.cStreamName[0]) - TJclAddr(@Header.dwStreamId)); + BytesRead := 0; + if not {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.BackupRead(Data.Internal.FileHandle, (@Header), BytesToRead, BytesRead, + False, True, Data.Internal.Context) then + begin + SetLastError(ERROR_READ_FAULT); + Exit; + end; + if BytesRead = 0 then // EOF + begin + SetLastError(ERROR_NO_MORE_FILES); + Exit; + end; + // If stream has a name then read it + if Header.dwStreamNameSize > 0 then + begin + StreamName := HeapAlloc(GetProcessHeap, 0, Header.dwStreamNameSize + SizeOf(WCHAR)); + if StreamName = nil then + begin + SetLastError(ERROR_OUTOFMEMORY); + Exit; + end; + if not {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.BackupRead(Data.Internal.FileHandle, Pointer(StreamName), + Header.dwStreamNameSize, BytesRead, False, True, Data.Internal.Context) then + begin + HeapFree(GetProcessHeap, 0, StreamName); + SetLastError(ERROR_READ_FAULT); + Exit; + end; + StreamName[Header.dwStreamNameSize div SizeOf(WCHAR)] := WideChar(#0); + end + else + StreamName := nil; + // Did we find any of the specified streams ([] means any stream)? + if (Data.Internal.StreamIds = []) or + (TStreamId(Header.dwStreamId) in Data.Internal.StreamIds) then + begin + FoundStream := True; + {$IFDEF FPC} + Data.Size := Header.Size.QuadPart; + {$ELSE ~FPC} + Data.Size := Header.Size; + {$ENDIF ~FPC} + Data.Name := StreamName; + Data.Attributes := Header.dwStreamAttributes; + Data.StreamId := TStreamId(Header.dwStreamId); + end; + // Release stream name memory if necessary + if Header.dwStreamNameSize > 0 then + HeapFree(GetProcessHeap, 0, StreamName); + // Move past data part to beginning of next stream (or EOF) + {$IFDEF FPC} + BytesToSeek.QuadPart := Header.Size.QuadPart; + if (Header.Size.QuadPart <> 0) and (not JclWin32.BackupSeek(Data.Internal.FileHandle, BytesToSeek.LowPart, + BytesToSeek.HighPart, Lo, Hi, Data.Internal.Context)) then + {$ELSE ~FPC} + BytesToSeek.QuadPart := Header.Size; + if (Header.Size <> 0) and (not JclWin32.BackupSeek(Data.Internal.FileHandle, BytesToSeek.LowPart, + BytesToSeek.HighPart, Lo, Hi, Data.Internal.Context)) then + {$ENDIF ~FPC} + begin + SetLastError(ERROR_READ_FAULT); + Exit; + end; + end; + // Due to the usage of Exit, we only get here if everything succeeded + Result := True; +end; + +function NtfsFindFirstStream(const FileName: string; StreamIds: TStreamIds; + var Data: TFindStreamData): Boolean; +begin + Result := False; + // Open file for reading, note that the FILE_FLAG_BACKUP_SEMANTICS requires + // the SE_BACKUP_NAME and SE_RESTORE_NAME privileges. + Data.Internal.FileHandle := CreateFile(PChar(FileName), GENERIC_READ, + FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, + FILE_FLAG_BACKUP_SEMANTICS, 0); + if Data.Internal.FileHandle <> INVALID_HANDLE_VALUE then + begin + // Initialize private context + Data.Internal.StreamIds := StreamIds; + Data.Internal.Context := nil; + // Call upon the Borg worker to find the next (first) stream + Result := FindStream(Data); + if not Result then + begin + // Failure, cleanup relieving the caller of having to call FindStreamClose + CloseHandle(Data.Internal.FileHandle); + Data.Internal.FileHandle := INVALID_HANDLE_VALUE; + Data.Internal.Context := nil; + if GetLastError = ERROR_NO_MORE_FILES then + SetLastError(ERROR_FILE_NOT_FOUND); + end; + end; +end; + +function NtfsFindNextStream(var Data: TFindStreamData): Boolean; +begin + Result := False; + if Data.Internal.FileHandle <> INVALID_HANDLE_VALUE then + Result := FindStream(Data) + else + SetLastError(ERROR_INVALID_HANDLE); +end; + +function NtfsFindStreamClose(var Data: TFindStreamData): Boolean; +var + BytesRead: DWORD; + LastError: DWORD; +begin + Result := Data.Internal.FileHandle <> INVALID_HANDLE_VALUE; + LastError := ERROR_SUCCESS; + if Result then + begin + // Call BackupRead one last time to signal that we're done with it + BytesRead := 0; + Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.BackupRead(0, nil, 0, BytesRead, True, False, Data.Internal.Context); + if not Result then + LastError := GetLastError; + CloseHandle(Data.Internal.FileHandle); + Data.Internal.FileHandle := INVALID_HANDLE_VALUE; + Data.Internal.Context := nil; + end + else + LastError := ERROR_INVALID_HANDLE; + SetLastError(LastError); +end; + +//=== Hard links ============================================================= +(* + Implementation of CreateHardLink completely swapped to the unit Hardlink.pas + + As with all APIs on the NT platform this version is completely implemented in + UNICODE and calling the ANSI version results in conversion of parameters and + call of the underlying UNICODE version of the function. + + This holds both for the homegrown and the Windows API (where it exists). +*) + +// For a description see: NtfsCreateHardLink() +(* ANSI implementation of the function - calling UNICODE anyway ;-) *) +function NtfsCreateHardLinkA(const LinkFileName, ExistingFileName: AnsiString): Boolean; +begin + // Invoke either (homegrown vs. API) function and supply NIL for security attributes + Result := CreateHardLinkA(PAnsiChar(LinkFileName), PAnsiChar(ExistingFileName), nil); +end; + +// For a description see: NtfsCreateHardLink() +(* UNICODE implementation of the function - we are on NT, aren't we ;-) *) +function NtfsCreateHardLinkW(const LinkFileName, ExistingFileName: WideString): Boolean; +begin + // Invoke either (homegrown vs. API) function and supply NIL for security attributes + Result := CreateHardLinkW(PWideChar(LinkFileName), PWideChar(ExistingFileName), nil); +end; + +// NtfsCreateHardLink +// +// Creates a hardlink on NT 4 and above. +// Both, LinkFileName and ExistingFileName must reside on the same, NTFS formatted volume. +// +// LinkName: Name of the hard link to create +// ExistingFileName: Fully qualified path of the file for which to create a hard link +// Result: True if successful, +// False if failed. +// In the latter case use GetLastError to obtain the reason of failure. +// +// Remark: +// Hardlinks are the same as cross-referenced files were on DOS. With one exception +// on NTFS they are allowed and are a feature of the filesystem, whereas on FAT +// they were a feared kind of corruption of the filesystem. +// +// Hardlinks are no more than references (with different names, but not necessarily +// in different directories) of the filesystem to exactly the same data! +// +// To test this you may create a hardlink to some file on your harddisk and then edit +// it using Notepad (some editors do not work on the original file, but Notepad does). +// The changes will appear in the "linked" and the "original" location. +// +// Why did I use quotes? Easy: hardlinks are references to the same data - and such +// as with handles the object (i.e. data) is only destroyed after all references are +// "released". To "release" a reference (i.e. a hardlink) simply delete it using +// the well-known methods to delete files. Because: +// +// Files are hardlinks and hardlinks are files. +// +// The above holds for NTFS volumes (and those filesystems supporting hardlinks). +// Why all references need to reside on the same volume should be clear from these +// remarks. +function NtfsCreateHardLink(const LinkFileName, ExistingFileName: String): Boolean; +begin + {$IFDEF SUPPORTS_UNICODE} + Result := CreateHardLinkW(PWideChar(LinkFileName), PWideChar(ExistingFileName), nil); + {$ELSE ~SUPPORTS_UNICODE} + Result := CreateHardLinkA(PAnsiChar(LinkFileName), PAnsiChar(ExistingFileName), nil); + {$ENDIF ~SUPPORTS_UNICODE} +end; + +function NtfsGetHardLinkInfo(const FileName: string; var Info: TNtfsHardLinkInfo): Boolean; +var + F: THandle; + FileInfo: TByHandleFileInformation; +begin + Result := False; + // GENERIC_READ triggers anti virus scanners to scan the file. But we are not interested + // in the file's content, only its attributes. + F := CreateFile(PChar(FileName), FILE_READ_ATTRIBUTES, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0); + if F <> INVALID_HANDLE_VALUE then + try + ResetMemory(FileInfo, SizeOf(FileInfo)); + if GetFileInformationByHandle(F, FileInfo) then + begin + Info.LinkCount := FileInfo.nNumberOfLinks; + Info.FileIndexHigh := FileInfo.nFileIndexHigh; + Info.FileIndexLow := FileInfo.nFileIndexLow; + Result := True; + end; + finally + CloseHandle(F); + end +end; + +function NtfsFindHardLinks(const Path: string; const FileIndexHigh, FileIndexLow: Cardinal; const List: TStrings): Boolean; +var + SearchRec: TSearchRec; + R: Integer; + Info: TNtfsHardLinkInfo; +begin + // start the search + R := FindFirst(Path + '\*.*', faAnyFile, SearchRec); + Result := (R = 0); + if Result then + begin + List.BeginUpdate; + try + while R = 0 do + begin + if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then + begin + if (SearchRec.Attr and faDirectory) = faDirectory then + begin + // recurse into subdirectory + Result := NtfsFindHardLinks(Path + '\' + SearchRec.Name, FileIndexHigh, FileIndexLow, List); + if not Result then + Break; + end + else + begin + // found a file, is it a hard link? + ResetMemory(Info, SizeOf(Info)); + if NtfsGetHardLinkInfo(Path + '\' + SearchRec.Name, Info) then + begin + if (Info.FileIndexHigh = FileIndexHigh) and (Info.FileIndexLow = FileIndexLow) then + List.Add(Path + '\' + SearchRec.Name); + end; + end; + end; + R := FindNext(SearchRec); + end; + Result := R = ERROR_NO_MORE_FILES; + finally + {$IFDEF HAS_UNITSCOPE}System.{$ENDIF}SysUtils.FindClose(SearchRec); + List.EndUpdate; + end; + end; + if R = ERROR_ACCESS_DENIED then + Result := True; +end; + +function NtfsDeleteHardLinks(const FileName: string): Boolean; +var + FullPathName: string; + FilePart: PChar; + Files: TStringList; + I: Integer; + Info: TNtfsHardLinkInfo; +begin + Result := False; + // get the full pathname of the specified file + SetLength(FullPathName, MAX_PATH); + FilePart := nil; + GetFullPathName(PChar(FileName), MAX_PATH, PChar(FullPathName), FilePart); + SetLength(FullPathName, StrLen(PChar(FullPathName))); + // get hard link information + ResetMemory(Info, SizeOf(Info)); + if NtfsGetHardLinkInfo(FullPathName, Info) then + begin + Files := TStringList.Create; + try + if Info.LinkCount > 1 then + begin + // find all hard links for this file + if not NtfsFindHardLinks(FullPathName[1] + ':', Info.FileIndexHigh, Info.FileIndexLow, Files) then + Exit; + // first delete the originally specified file from the list, we don't delete that one until all hard links + // are successfully deleted so we can use it to restore them if anything goes wrong. Theoretically one could + // use any of the hard links but in case the restore goes wrong, at least the specified file still exists... + for I := 0 to Files.Count - 1 do + begin + if CompareStr(FullPathName, Files[I]) = 0 then + begin + Files.Delete(I); + Break; + end; + end; + // delete all found hard links + I := 0; + while I < Files.Count do + begin + if not DeleteFile(Files[I]) then + Break; + Inc(I); + end; + if I = Files.Count then + begin + // all hard links successfully deleted, now delete the originally specified file. if this fails we set + // I to Files.Count - 1 so that the next code block will restore all hard links we just deleted. + Result := DeleteFile(FullPathName); + if not Result then + I := Files.Count - 1; + end; + if I < Files.Count then + begin + // not all hard links could be deleted, attempt to restore the ones that were + while I >= 0 do + begin + // ignore result, just attempt to restore... + NtfsCreateHardLink(Files[I], FullPathName); + Dec(I); + end; + end; + end + else + // there are no hard links, just delete the file + Result := DeleteFile(FullPathName); + finally + Files.Free; + end; + end; +end; + +//=== { TJclFileSummary } ==================================================== + +const + AccessModes: array [TJclFileSummaryAccess] of DWORD = + ( STGM_READ, STGM_WRITE, STGM_READWRITE ); + ShareModes: array [TJclFileSummaryShare] of DWORD = + ( STGM_SHARE_DENY_NONE, STGM_SHARE_DENY_READ, STGM_SHARE_DENY_WRITE, + STGM_SHARE_EXCLUSIVE ); + +constructor TJclFileSummary.Create(AFileName: WideString; AAccessMode: TJclFileSummaryAccess; + AShareMode: TJclFileSummaryShare; AsDocument: Boolean; ACreate: Boolean); +var + Format: DWORD; + IntfGUID: TGUID; + AIntf: IInterface; +begin + inherited Create; + FAccessMode := AAccessMode; + FShareMode := AShareMode; + FFileName := AFileName; + + if AsDocument then + Format := STGFMT_DOCFILE + else + if ACreate then + Format := STGFMT_FILE + else + Format := STGFMT_ANY; + IntfGUID := IPropertySetStorage; + + if ACreate then + OleCheck(StgCreateStorageEx(PWideChar(AFileName), + STGM_DIRECT or AccessModes[AAccessMode] or ShareModes[AShareMode], Format, 0, + nil, nil, @IntfGUID, AIntf)) + else + OleCheck(StgOpenStorageEx(PWideChar(AFileName), + STGM_DIRECT or AccessModes[AAccessMode] or ShareModes[AShareMode], Format, 0, + nil, nil, @IntfGUID, AIntf)); + + FStorage := AIntf as IPropertySetStorage; +end; + +function TJclFileSummary.CreatePropertySet(AClass: TJclFilePropertySetClass; + ResetExisting: Boolean): TJclFilePropertySet; +var + PropertyStorage: IPropertyStorage; +begin + OleCheck(FStorage.Create(AClass.GetFMTID, AClass.GetFMTID, PROPSETFLAG_DEFAULT, + STGM_CREATE or STGM_DIRECT or AccessModes[AccessMode] or ShareModes[ShareMode], + PropertyStorage)); + if Assigned(PropertyStorage) then + Result := AClass.Create(PropertyStorage) + else + raise EJclFileSummaryError.CreateRes(@RsEUnableToCreatePropertyStorage); +end; + +procedure TJclFileSummary.DeletePropertySet(AClass: TJclFilePropertySetClass); +begin + DeletePropertySet(AClass.GetFMTID); +end; + +procedure TJclFileSummary.DeletePropertySet(const FMTID: TGUID); +begin + OleCheck(FStorage.Delete(FMTID)); +end; + +destructor TJclFileSummary.Destroy; +begin + FStorage := nil; + inherited Destroy; +end; + +function TJclFileSummary.EnumPropertySet( + Proc: TJclFileSummaryPropSetCallback): Boolean; +var + Enum: IEnumSTATPROPSETSTG; + PropSet: STATPROPSETSTG; + Returned: ULONG; + Status: HRESULT; +begin + OleCheck(FStorage.Enum(Enum)); + ZeroMemory(@PropSet, SizeOf(PropSet)); + + OleCheck(Enum.Reset); + Status := Enum.Next(1, PropSet, @Returned); + Result := True; + + while Result and (Status = S_OK) and (Returned = 1) do + begin + Result := Proc(PropSet.fmtid); + if Result then + Status := Enum.Next(1, PropSet, @Returned); + end; +end; + +procedure TJclFileSummary.GetPropertySet(AClass: TJclFilePropertySetClass; + out Instance); +var + PropertyStorage: IPropertyStorage; +begin + TJclFilePropertySet(Instance) := nil; + PropertyStorage := GetPropertySet(AClass.GetFMTID); + if Assigned(PropertyStorage) then + TJclFilePropertySet(Instance) := AClass.Create(PropertyStorage); +end; + +procedure TJclFileSummary.GetPropertySet(const FMTID: TGUID; out Instance); +var + PropertyStorage: IPropertyStorage; +begin + TJclFilePropertySet(Instance) := nil; + PropertyStorage := GetPropertySet(FMTID); + if Assigned(PropertyStorage) then + TJclFilePropertySet(Instance) := TJclFilePropertySet.Create(PropertyStorage); +end; + +function TJclFileSummary.GetPropertySet(const FMTID: TGUID): IPropertyStorage; +var + Status: HRESULT; +begin + Status := FStorage.Open(FMTID, + STGM_DIRECT or AccessModes[AccessMode] or ShareModes[ShareMode], + Result); + if (Status = STG_E_FILENOTFOUND) then + begin + if AccessMode = fsaRead then + Result := nil + else + OleCheck(FStorage.Create(FMTID, FMTID, PROPSETFLAG_DEFAULT, + STGM_CREATE or STGM_DIRECT or AccessModes[AccessMode] or ShareModes[ShareMode], + Result)) + end + else + OleCheck(Status); +end; + +//=== { TJclFilePropertySet } ================================================ + +constructor TJclFilePropertySet.Create(APropertyStorage: IPropertyStorage); +begin + inherited Create; + FPropertyStorage := APropertyStorage; +end; + +procedure TJclFilePropertySet.DeleteProperty(const Name: WideString); +var + Prop: TPropSpec; +begin + Prop.ulKind := PRSPEC_LPWSTR; + Prop.lpwstr := PWideChar(Name); + OleCheck(FPropertyStorage.DeleteMultiple(1, @Prop)); +end; + +procedure TJclFilePropertySet.DeletePropertyName(ID: TPropID); +begin + OleCheck(FPropertyStorage.DeletePropertyNames(1, @ID)); +end; + +procedure TJclFilePropertySet.DeleteProperty(ID: TPropID); +var + Prop: TPropSpec; +begin + Prop.ulKind := PRSPEC_PROPID; + Prop.propid := ID; + OleCheck(FPropertyStorage.DeleteMultiple(1, @Prop)); +end; + +destructor TJclFilePropertySet.Destroy; +begin + FPropertyStorage := nil; + inherited Destroy; +end; + +function TJclFilePropertySet.EnumProperties( + Proc: TJclFileSummaryPropCallback): Boolean; +var + Enum: IEnumSTATPROPSTG; + Status: HRESULT; + Returned: ULONG; + Prop: STATPROPSTG; +begin + OleCheck(FPropertyStorage.Enum(Enum)); + + ZeroMemory(@Prop, SizeOf(Prop)); + OleCheck(Enum.Reset); + Status := Enum.Next(1, Prop, @Returned); + Result := True; + + while Result and (Status = S_OK) and (Returned = 1) do + begin + try + Result := Proc(Prop.lpwstrName, Prop.propid, Prop.vt); + finally + if Assigned(Prop.lpwstrName) then + CoTaskMemFree(Prop.lpwstrName); + end; + + if Result then + Status := Enum.Next(1, Prop, @Returned); + end; +end; + +function TJclFilePropertySet.GetAnsiStringProperty( + const ID: Integer): AnsiString; +var + PropValue: TPropVariant; +begin + Result := ''; + PropValue := GetProperty(ID); + try + case PropValue.vt of + VT_EMPTY, VT_NULL: ; + VT_LPSTR: + Result := PropValue.pszVal; + VT_LPWSTR: + Result := AnsiString(WideString(PropValue.pwszVal)); + VT_BSTR: + Result := AnsiString(WideString(PropValue.bstrVal)); + else + raise EJclFileSummaryError.CreateRes(@RsEIncomatibleDataFormat); + end; + finally + PropVariantClear(PropValue); + end; +end; + +function TJclFilePropertySet.GetBooleanProperty(const ID: Integer): Boolean; +var + PropValue: TPropVariant; +begin + Result := False; + PropValue := GetProperty(ID); + try + case PropValue.vt of + VT_EMPTY, VT_NULL: ; + VT_BOOL: + Result := PropValue.bool; + else + raise EJclFileSummaryError.CreateRes(@RsEIncomatibleDataFormat); + end; + finally + PropVariantClear(PropValue); + end; +end; + +function TJclFilePropertySet.GetBSTRProperty(const ID: Integer): WideString; +var + PropValue: TPropVariant; +begin + Result := ''; + PropValue := GetProperty(ID); + try + case PropValue.vt of + VT_EMPTY, VT_NULL: ; + VT_LPSTR: + Result := WideString(AnsiString(PropValue.pszVal)); + VT_LPWSTR: + Result := PropValue.pwszVal; + VT_BSTR: + Result := PropValue.bstrVal; + else + raise EJclFileSummaryError.CreateRes(@RsEIncomatibleDataFormat); + end; + finally + PropVariantClear(PropValue); + end; +end; + +function TJclFilePropertySet.GetCardinalProperty(const ID: Integer): Cardinal; +var + PropValue: TPropVariant; +begin + Result := 0; + PropValue := GetProperty(ID); + try + case PropValue.vt of + VT_EMPTY, VT_NULL: ; + VT_I2: + Result := PropValue.iVal; + VT_I4, VT_INT: + Result := PropValue.lVal; + VT_I1: + Result := PropValue.bVal; // no ShortInt? (cVal) + VT_UI1: + Result := PropValue.bVal; + VT_UI2: + Result := PropValue.uiVal; + VT_UI4, VT_UINT: + Result := PropValue.ulVal; + else + raise EJclFileSummaryError.CreateRes(@RsEIncomatibleDataFormat); + end; + finally + PropVariantClear(PropValue); + end; +end; + +function TJclFilePropertySet.GetClipDataProperty(const ID: Integer): PClipData; +var + PropValue: TPropVariant; +begin + Result := nil; + PropValue := GetProperty(ID); + try + case PropValue.vt of + VT_EMPTY, VT_NULL: ; + VT_CF: + Result := PropValue.pclipdata + else + raise EJclFileSummaryError.CreateRes(@RsEIncomatibleDataFormat); + end; + finally + PropVariantClear(PropValue); + end; +end; + +function TJclFilePropertySet.GetFileTimeProperty(const ID: Integer): TFileTime; +var + PropValue: TPropVariant; +begin + ZeroMemory(@Result, SizeOf(Result)); + PropValue := GetProperty(ID); + try + case PropValue.vt of + VT_EMPTY, VT_NULL: ; + VT_FILETIME: + Result := PropValue.filetime; + else + raise EJclFileSummaryError.CreateRes(@RsEIncomatibleDataFormat); + end; + finally + PropVariantClear(PropValue); + end; +end; + +class function TJclFilePropertySet.GetFMTID: TGUID; +begin + Result := GUID_NULL; +end; + +function TJclFilePropertySet.GetIntegerProperty(const ID: Integer): Integer; +var + PropValue: TPropVariant; +begin + Result := 0; + PropValue := GetProperty(ID); + try + case PropValue.vt of + VT_EMPTY, VT_NULL: ; + VT_I2: + Result := PropValue.iVal; + VT_I4, VT_INT: + Result := PropValue.lVal; + VT_I1: + Result := PropValue.bVal; // no ShortInt? (cVal) + VT_UI1: + Result := PropValue.bVal; + VT_UI2: + Result := PropValue.uiVal; + VT_UI4, VT_UINT: + Result := PropValue.ulVal; + else + raise EJclFileSummaryError.CreateRes(@RsEIncomatibleDataFormat); + end; + finally + PropVariantClear(PropValue); + end; +end; + +function TJclFilePropertySet.GetProperty(const Name: WideString): TPropVariant; +var + Prop: TPropSpec; +begin + Prop.ulKind := PRSPEC_LPWSTR; + Prop.lpwstr := PWideChar(Name); + + OleCheck(FPropertyStorage.ReadMultiple(1, @Prop, @Result)); +end; + +function TJclFilePropertySet.GetProperty(ID: TPropID): TPropVariant; +var + Prop: TPropSpec; +begin + Prop.ulKind := PRSPEC_PROPID; + Prop.propid := ID; + + OleCheck(FPropertyStorage.ReadMultiple(1, @Prop, @Result)); +end; + +function TJclFilePropertySet.GetPropertyName(ID: TPropID): WideString; +var + AName: PWideChar; +begin + AName := nil; + try + OleCheck(FPropertyStorage.ReadPropertyNames(1, @ID, @AName)); + Result := AName; + finally + if Assigned(AName) then + CoTaskMemFree(AName); + end; +end; + +function TJclFilePropertySet.GetTCALPSTRProperty(const ID: Integer): TCALPSTR; +var + PropValue: TPropVariant; +begin + ZeroMemory(@Result, SizeOf(Result)); + PropValue := GetProperty(ID); + try + case PropValue.vt of + VT_EMPTY, VT_NULL: ; + VT_LPSTR or VT_VECTOR: + Result := PropValue.calpstr; + else + raise EJclFileSummaryError.CreateRes(@RsEIncomatibleDataFormat); + end; + finally + PropVariantClear(PropValue); + end; +end; + +function TJclFilePropertySet.GetTCAPROPVARIANTProperty( + const ID: Integer): TCAPROPVARIANT; +var + PropValue: TPropVariant; +begin + ZeroMemory(@Result, SizeOf(Result)); + PropValue := GetProperty(ID); + try + case PropValue.vt of + VT_EMPTY, VT_NULL: ; + VT_VARIANT or VT_VECTOR: + Result := PropValue.capropvar; + else + raise EJclFileSummaryError.CreateRes(@RsEIncomatibleDataFormat); + end; + finally + PropVariantClear(PropValue); + end; +end; + +function TJclFilePropertySet.GetWideStringProperty( + const ID: Integer): WideString; +var + PropValue: TPropVariant; +begin + Result := ''; + PropValue := GetProperty(ID); + try + case PropValue.vt of + VT_EMPTY, VT_NULL: ; + VT_LPSTR: + Result := WideString(AnsiString(PropValue.pszVal)); + VT_LPWSTR: + Result := PropValue.pwszVal; + VT_BSTR: + Result := PropValue.bstrVal; + else + raise EJclFileSummaryError.CreateRes(@RsEIncomatibleDataFormat); + end; + finally + PropVariantClear(PropValue); + end; +end; + +function TJclFilePropertySet.GetWordProperty(const ID: Integer): Word; +var + PropValue: TPropVariant; +begin + Result := 0; + PropValue := GetProperty(ID); + try + case PropValue.vt of + VT_EMPTY, VT_NULL: ; + VT_I2: + Result := PropValue.iVal; + VT_I1: + Result := PropValue.bVal; // no ShortInt? (cVal) + VT_UI1: + Result := PropValue.bVal; + VT_UI2: + Result := PropValue.uiVal; + else + raise EJclFileSummaryError.CreateRes(@RsEIncomatibleDataFormat); + end; + finally + PropVariantClear(PropValue); + end; +end; + +procedure TJclFilePropertySet.SetAnsiStringProperty(const ID: Integer; + const Value: AnsiString); +var + PropValue: TPropVariant; +begin + PropValue.vt := VT_LPSTR; + PropValue.pszVal := PAnsiChar(Value); + SetProperty(ID, PropValue); +end; + +procedure TJclFilePropertySet.SetBooleanProperty(const ID: Integer; + const Value: Boolean); +var + PropValue: TPropVariant; +begin + PropValue.vt := VT_BOOL; + PropValue.bool := Value; + SetProperty(ID, PropValue); +end; + +procedure TJclFilePropertySet.SetBSTRProperty(const ID: Integer; + const Value: WideString); +var + PropValue: TPropVariant; +begin + PropValue.vt := VT_BSTR; + PropValue.bstrVal := SysAllocString(PWideChar(Value)); + SetProperty(ID, PropValue); +end; + +procedure TJclFilePropertySet.SetCardinalProperty(const ID: Integer; + const Value: Cardinal); +var + PropValue: TPropVariant; +begin + PropValue.vt := VT_UI4; + PropValue.ulVal := Value; + SetProperty(ID, PropValue); +end; + +procedure TJclFilePropertySet.SetClipDataProperty(const ID: Integer; + const Value: PClipData); +var + PropValue: TPropVariant; +begin + PropValue.vt := VT_CF; + PropValue.pclipdata := Value; + SetProperty(ID, PropValue); +end; + +procedure TJclFilePropertySet.SetFileTimeProperty(const ID: Integer; + const Value: TFileTime); +var + PropValue: TPropVariant; +begin + PropValue.vt := VT_FILETIME; + PropValue.filetime := Value; + SetProperty(ID, PropValue); +end; + +procedure TJclFilePropertySet.SetIntegerProperty(const ID, Value: Integer); +var + PropValue: TPropVariant; +begin + PropValue.vt := VT_I4; + PropValue.lVal := Value; + SetProperty(ID, PropValue); +end; + +procedure TJclFilePropertySet.SetProperty(const Name: WideString; + const Value: TPropVariant; AllocationBase: TPropID); +var + Prop: TPropSpec; +begin + Prop.ulKind := PRSPEC_LPWSTR; + Prop.lpwstr := PWideChar(Name); + + OleCheck(FPropertyStorage.WriteMultiple(1, @Prop, @Value, AllocationBase)); +end; + +procedure TJclFilePropertySet.SetPropertyName(ID: TPropID; + const Name: WideString); +var + AName: PWideChar; +begin + AName := PWideChar(Name); + OleCheck(FPropertyStorage.WritePropertyNames(1, @ID, @AName)); +end; + +procedure TJclFilePropertySet.SetTCALPSTRProperty(const ID: Integer; + const Value: TCALPSTR); +var + PropValue: TPropVariant; +begin + PropValue.vt := VT_LPSTR or VT_VECTOR; + PropValue.calpstr := Value; + SetProperty(ID, PropValue); +end; + +procedure TJclFilePropertySet.SetTCAPROPVARIANTProperty(const ID: Integer; + const Value: TCAPROPVARIANT); +var + PropValue: TPropVariant; +begin + PropValue.vt := VT_VARIANT or VT_VECTOR; + PropValue.capropvar := Value; + SetProperty(ID, PropValue); +end; + +procedure TJclFilePropertySet.SetWideStringProperty(const ID: Integer; + const Value: WideString); +var + PropValue: TPropVariant; +begin + PropValue.vt := VT_LPWSTR; + PropValue.pwszVal := PWideChar(Value); + SetProperty(ID, PropValue); +end; + +procedure TJclFilePropertySet.SetWordProperty(const ID: Integer; + const Value: Word); +var + PropValue: TPropVariant; +begin + PropValue.vt := VT_UI2; + PropValue.uiVal := Value; + SetProperty(ID, PropValue); +end; + +procedure TJclFilePropertySet.SetProperty(ID: TPropID; const Value: TPropVariant); +var + Prop: TPropSpec; +begin + Prop.ulKind := PRSPEC_PROPID; + Prop.propid := ID; + + OleCheck(FPropertyStorage.WriteMultiple(1, @Prop, @Value, PID_FIRST_USABLE)); +end; + +//=== { TJclFileSummaryInformation } ========================================= + +class function TJclFileSummaryInformation.GetFMTID: TGUID; +begin + Result := FMTID_SummaryInformation; +end; + +//=== { TJclDocSummaryInformation } ========================================== + +class function TJclDocSummaryInformation.GetFMTID: TGUID; +begin + Result := FMTID_DocumentSummaryInformation; +end; + +//=== { TJclMediaSummaryInformation } ======================================== + +class function TJclMediaFileSummaryInformation.GetFMTID: TGUID; +begin + Result := FMTID_MediaFileSummaryInformation +end; + +//=== { TJclMSISummaryInformation } ========================================== + +class function TJclMSISummaryInformation.GetFMTID: TGUID; +begin + Result := FMTID_SummaryInformation; +end; + +//=== { TJclShellSummaryInformation } ======================================== + +class function TJclShellSummaryInformation.GetFMTID: TGUID; +begin + Result := FMTID_ShellDetails; +end; + +//=== { TJclStorageSummaryInformation } ====================================== + +class function TJclStorageSummaryInformation.GetFMTID: TGUID; +begin + Result := FMTID_Storage; +end; + +//=== { TJclImageSummaryInformation } ======================================== + +class function TJclImageSummaryInformation.GetFMTID: TGUID; +begin + Result := FMTID_ImageSummaryInformation; +end; + +//=== { TJclDisplacedSummaryInformation } ==================================== + +class function TJclDisplacedSummaryInformation.GetFMTID: TGUID; +begin + Result := FMTID_Displaced; +end; + +//=== { TJclBriefCaseSummaryInformation } + +class function TJclBriefCaseSummaryInformation.GetFMTID: TGUID; +begin + Result := FMTID_Briefcase; +end; + +//=== { TJclMiscSummaryInformation } ========================================= + +class function TJclMiscSummaryInformation.GetFMTID: TGUID; +begin + Result := FMTID_Misc; +end; + +//=== { TJclWebViewSummaryInformation } ====================================== + +class function TJclWebViewSummaryInformation.GetFMTID: TGUID; +begin + Result := FMTID_WebView; +end; + +//=== { TJclMusicSummaryInformation } ======================================== + +class function TJclMusicSummaryInformation.GetFMTID: TGUID; +begin + Result := FMTID_MUSIC; +end; + +//=== { TJclDRMSummaryInformation } ========================================== + +class function TJclDRMSummaryInformation.GetFMTID: TGUID; +begin + Result := FMTID_DRM; +end; + +//=== { TJclVideoSummaryInformation } ======================================== + +class function TJclVideoSummaryInformation.GetFMTID: TGUID; +begin + Result := FMTID_Video; +end; + +//=== { TJclAudioSummaryInformation } ======================================== + +class function TJclAudioSummaryInformation.GetFMTID: TGUID; +begin + Result := FMTID_Audio; +end; + +//=== { TJclControlPanelSummaryInformation } ================================= + +class function TJclControlPanelSummaryInformation.GetFMTID: TGUID; +begin + Result := FMTID_ControlPanel; +end; + +//=== { TJclVolumeSummaryInformation } ======================================= + +class function TJclVolumeSummaryInformation.GetFMTID: TGUID; +begin + Result := FMTID_Volume; +end; + +//=== { TJclShareSummaryInformation } ======================================== + +class function TJclShareSummaryInformation.GetFMTID: TGUID; +begin + Result := FMTID_Share; +end; + +//=== { TJclLinkSummaryInformation } ========================================= + +class function TJclLinkSummaryInformation.GetFMTID: TGUID; +begin + Result := FMTID_Link; +end; + +//=== { TJclQuerySummaryInformation } ======================================== + +class function TJclQuerySummaryInformation.GetFMTID: TGUID; +begin + Result := FMTID_Query; +end; + +//=== { TJclImageInformation } =============================================== + +class function TJclImageInformation.GetFMTID: TGUID; +begin + Result := FMTID_ImageInformation; +end; + +//=== { TJclJpegSummaryInformation } ========================================= + +class function TJclJpegSummaryInformation.GetFMTID: TGUID; +begin + Result := FMTID_JpegAppHeaders; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/JclNoDepAdmin.manifest b/3rdParty/JCL/source/windows/JclNoDepAdmin.manifest new file mode 100644 index 00000000..77df082d --- /dev/null +++ b/3rdParty/JCL/source/windows/JclNoDepAdmin.manifest @@ -0,0 +1,17 @@ + + + + + + + + + + + diff --git a/3rdParty/JCL/source/windows/JclNoDepAdmin.rc b/3rdParty/JCL/source/windows/JclNoDepAdmin.rc new file mode 100644 index 00000000..4acf87dc --- /dev/null +++ b/3rdParty/JCL/source/windows/JclNoDepAdmin.rc @@ -0,0 +1,7 @@ +/**************************************************************************************************** + + VistaElevate.rc + +****************************************************************************************************/ + +LANGUAGE 0,0 1 24 "JclNoDepAdmin.manifest" diff --git a/3rdParty/JCL/source/windows/JclNoDepAdmin.res b/3rdParty/JCL/source/windows/JclNoDepAdmin.res new file mode 100644 index 0000000000000000000000000000000000000000..20e2726eac5862b7e9233ee31aae4c7f1e498be0 GIT binary patch literal 612 zcma)4&r8EF7_A-!?;d0BYxfHoqje0OFxkO_iq|atx&@kK=1c4P*UztOSGI#-AdtNG zeJ}4N34$PCG!KVn((+>5U!V9ps<}FH{j-XAw%0i;!J)Dy;e)Wx85n6(Wi|=_cz@|l zI72T?DspQe;T0gCJ>K5L0ul5&uNVm!OnBkU6y+AQz@AppS+tq&Nvo# z(0`tvMpBG*V#^eaSH7x2#(cG-6MvK$4S9nYp$U0iJTKXkO@Xb{+6h;+Y!_n~j>CR9 z9t}@@J7*;zS~quct2{_wI1>7rJn*P-;9Y@!X)^oIJR^SWBku^ZaOAn&6XM{zpq!At zIaR70Hh>*@PA~S<>gnQFP(t1$taCG#*FeH+A?0A6YGo99C%koS)~2pdb6E#VcqVd$ cHcZ3C(ceDe=)!dzb@9n)9G%{lHuP710gAk_m;e9( literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/JclNoDepAsInvoker.manifest b/3rdParty/JCL/source/windows/JclNoDepAsInvoker.manifest new file mode 100644 index 00000000..d1d73bb3 --- /dev/null +++ b/3rdParty/JCL/source/windows/JclNoDepAsInvoker.manifest @@ -0,0 +1,17 @@ + + + + + + + + + + + diff --git a/3rdParty/JCL/source/windows/JclNoDepAsInvoker.rc b/3rdParty/JCL/source/windows/JclNoDepAsInvoker.rc new file mode 100644 index 00000000..3ea60ac6 --- /dev/null +++ b/3rdParty/JCL/source/windows/JclNoDepAsInvoker.rc @@ -0,0 +1,7 @@ +/**************************************************************************************************** + + VistaElevate.rc + +****************************************************************************************************/ + +LANGUAGE 0,0 1 24 "JclNoDepAsInvoker.manifest" diff --git a/3rdParty/JCL/source/windows/JclNoDepAsInvoker.res b/3rdParty/JCL/source/windows/JclNoDepAsInvoker.res new file mode 100644 index 0000000000000000000000000000000000000000..d646051ce9c35e370f95187b030eb4b315870b38 GIT binary patch literal 600 zcma)(&r8EF6vwMa!K-)-xv$+XWQ^7^bi!l@4=P@>^mPk1$;?aZ`q$6bwJY-=7ziZa zZ{B;~Pa6b5z-S*1&8Fk8b#r<0Z|Tj&(d(bRh-Z79vl1LCYZ5*P`<#K1HdSVm@VD2e z-h?ys!lWX%1`=KY^4b0MRV)xeuk(sg1A_@KoSCBBf)?1*N;-=+^F3+xRG<#a0cTnm zl>z$q^J&zIv98%N1>=>kYLPKt?P%h+GNU1H6eBb#&x^+;d$1|6m0CODs@Cl=hT%Bu zhvU)kRJU_h0-|+uC%4Lj^o65FACo&CH3_^c&@WA9|H(7r$2!W6APYyC+dC-^z6#=m z^u?)C<*)(l%yWCOr&3QJeg!4u4PnjASY8VW7q~Q~{RGznHfEvbvZhIRCUS(9pz-49 W@8NOuD{35d%#<#UPCt|`LGS~6O03}k literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/JclPeImage.pas b/3rdParty/JCL/source/windows/JclPeImage.pas index a5cc9d76..e4273bf4 100644 --- a/3rdParty/JCL/source/windows/JclPeImage.pas +++ b/3rdParty/JCL/source/windows/JclPeImage.pas @@ -152,7 +152,7 @@ TJclPeImportLibItem = class(TJclPeImageBaseList) FThunkData: Pointer; function GetCount: Integer; function GetFileName: TFileName; - function GetItems(Index: Integer): TJclPeImportFuncItem; + function GetItems(Index: TJclListSize): TJclPeImportFuncItem; function GetName: string; function GetThunkData32: PImageThunkData32; function GetThunkData64: PImageThunkData64; @@ -172,7 +172,7 @@ TJclPeImportLibItem = class(TJclPeImageBaseList) property ImportDescriptor: Pointer read FImportDescriptor; property ImportDirectoryIndex: Integer read FImportDirectoryIndex; property ImportKind: TJclPeImportKind read FImportKind; - property Items[Index: Integer]: TJclPeImportFuncItem read GetItems; default; + property Items[Index: TJclListSize]: TJclPeImportFuncItem read GetItems; default; property Name: string read GetName; property OriginalName: string read FName; // use the following properties @@ -193,7 +193,7 @@ TJclPeImportList = class(TJclPeImageBaseList) FUniqueNamesList: TStringList; function GetAllItemCount: Integer; function GetAllItems(Index: Integer): TJclPeImportFuncItem; - function GetItems(Index: Integer): TJclPeImportLibItem; + function GetItems(Index: TJclListSize): TJclPeImportLibItem; function GetUniqueLibItemCount: Integer; function GetUniqueLibItems(Index: Integer): TJclPeImportLibItem; function GetUniqueLibNames(Index: Integer): string; @@ -214,7 +214,7 @@ TJclPeImportList = class(TJclPeImageBaseList) property AllItems[Index: Integer]: TJclPeImportFuncItem read GetAllItems; property AllItemCount: Integer read GetAllItemCount; property FilterModuleName: string read FFilterModuleName write SetFilterModuleName; - property Items[Index: Integer]: TJclPeImportLibItem read GetItems; default; + property Items[Index: TJclListSize]: TJclPeImportLibItem read GetItems; default; property LinkerProducer: TJclPeLinkerProducer read FLinkerProducer; property UniqueLibItemCount: Integer read GetUniqueLibItemCount; property UniqueLibItemFromName[const Name: string]: TJclPeImportLibItem read GetUniqueLibItemFromName; @@ -279,7 +279,7 @@ TJclPeExportFuncList = class(TJclPeImageBaseList) FSorted: Boolean; FTotalResolveCheck: TJclPeResolveCheck; function GetForwardedLibsList: TStrings; - function GetItems(Index: Integer): TJclPeExportFuncItem; + function GetItems(Index: TJclListSize): TJclPeExportFuncItem; function GetItemFromAddress(Address: DWORD): TJclPeExportFuncItem; function GetItemFromOrdinal(Ordinal: DWORD): TJclPeExportFuncItem; function GetItemFromName(const Name: string): TJclPeExportFuncItem; @@ -304,7 +304,7 @@ TJclPeExportFuncList = class(TJclPeImageBaseList) property ExportDir: PImageExportDirectory read FExportDir; property ForwardedLibsList: TStrings read GetForwardedLibsList; property FunctionCount: DWORD read FFunctionCount; - property Items[Index: Integer]: TJclPeExportFuncItem read GetItems; default; + property Items[Index: TJclListSize]: TJclPeExportFuncItem read GetItems; default; property ItemFromAddress[Address: DWORD]: TJclPeExportFuncItem read GetItemFromAddress; property ItemFromName[const Name: string]: TJclPeExportFuncItem read GetItemFromName; property ItemFromOrdinal[Ordinal: DWORD]: TJclPeExportFuncItem read GetItemFromOrdinal; @@ -399,7 +399,7 @@ TJclPeResourceList = class(TJclPeImageBaseList) private FDirectory: PImageResourceDirectory; FParentItem: TJclPeResourceItem; - function GetItems(Index: Integer): TJclPeResourceItem; + function GetItems(Index: TJclListSize): TJclPeResourceItem; protected procedure CreateList(AParentItem: TJclPeResourceItem); public @@ -407,7 +407,7 @@ TJclPeResourceList = class(TJclPeImageBaseList) ADirectory: PImageResourceDirectory); function FindName(const Name: string): TJclPeResourceItem; property Directory: PImageResourceDirectory read FDirectory; - property Items[Index: Integer]: TJclPeResourceItem read GetItems; default; + property Items[Index: TJclListSize]: TJclPeResourceItem read GetItems; default; property ParentItem: TJclPeResourceItem read FParentItem; end; @@ -450,7 +450,7 @@ TJclPeRelocEntry = class(TObject) TJclPeRelocList = class(TJclPeImageBaseList) private FAllItemCount: Integer; - function GetItems(Index: Integer): TJclPeRelocEntry; + function GetItems(Index: TJclListSize): TJclPeRelocEntry; function GetAllItems(Index: Integer): TJclPeRelocation; protected procedure CreateList; @@ -458,19 +458,19 @@ TJclPeRelocList = class(TJclPeImageBaseList) constructor Create(AImage: TJclPeImage); property AllItems[Index: Integer]: TJclPeRelocation read GetAllItems; property AllItemCount: Integer read FAllItemCount; - property Items[Index: Integer]: TJclPeRelocEntry read GetItems; default; + property Items[Index: TJclListSize]: TJclPeRelocEntry read GetItems; default; end; // Debug section related classes TJclPeDebugList = class(TJclPeImageBaseList) private - function GetItems(Index: Integer): TImageDebugDirectory; + function GetItems(Index: TJclListSize): TImageDebugDirectory; function IsTD32DebugInfo(DebugDir: PImageDebugDirectory): Boolean; protected procedure CreateList; public constructor Create(AImage: TJclPeImage); - property Items[Index: Integer]: TImageDebugDirectory read GetItems; default; + property Items[Index: TJclListSize]: TImageDebugDirectory read GetItems; default; end; // Certificates section related classes @@ -486,12 +486,12 @@ TJclPeCertificate = class(TObject) TJclPeCertificateList = class(TJclPeImageBaseList) private - function GetItems(Index: Integer): TJclPeCertificate; + function GetItems(Index: TJclListSize): TJclPeCertificate; protected procedure CreateList; public constructor Create(AImage: TJclPeImage); - property Items[Index: Integer]: TJclPeCertificate read GetItems; default; + property Items[Index: TJclListSize]: TJclPeCertificate read GetItems; default; end; // Common Language Runtime section related classes @@ -1045,7 +1045,7 @@ TJclPeMapImgHookItem = class(TObject) TJclPeMapImgHooks = class(TObjectList) private - function GetItems(Index: Integer): TJclPeMapImgHookItem; + function GetItems(Index: TJclListSize): TJclPeMapImgHookItem; function GetItemFromOriginalAddress(OriginalAddress: Pointer): TJclPeMapImgHookItem; function GetItemFromNewAddress(NewAddress: Pointer): TJclPeMapImgHookItem; public @@ -1057,7 +1057,7 @@ TJclPeMapImgHooks = class(TObjectList) procedure UnhookAll; function UnhookByNewAddress(NewAddress: Pointer): Boolean; procedure UnhookByBaseAddress(BaseAddress: Pointer); - property Items[Index: Integer]: TJclPeMapImgHookItem read GetItems; default; + property Items[Index: TJclListSize]: TJclPeMapImgHookItem read GetItems; default; property ItemFromOriginalAddress[OriginalAddress: Pointer]: TJclPeMapImgHookItem read GetItemFromOriginalAddress; property ItemFromNewAddress[NewAddress: Pointer]: TJclPeMapImgHookItem read GetItemFromNewAddress; end; @@ -1639,7 +1639,7 @@ function TJclPeImportLibItem.GetFileName: TFileName; Result := Image.ExpandModuleName(Name); end; -function TJclPeImportLibItem.GetItems(Index: Integer): TJclPeImportFuncItem; +function TJclPeImportLibItem.GetItems(Index: TJclListSize): TJclPeImportFuncItem; begin Result := TJclPeImportFuncItem(Get(Index)); end; @@ -1899,7 +1899,7 @@ function TJclPeImportList.GetAllItems(Index: Integer): TJclPeImportFuncItem; Result := TJclPeImportFuncItem(FAllItemsList[Index]); end; -function TJclPeImportList.GetItems(Index: Integer): TJclPeImportLibItem; +function TJclPeImportList.GetItems(Index: TJclListSize): TJclPeImportLibItem; begin Result := TJclPeImportLibItem(Get(Index)); end; @@ -2512,7 +2512,7 @@ function TJclPeExportFuncList.GetItemFromOrdinal(Ordinal: DWORD): TJclPeExportFu end; end; -function TJclPeExportFuncList.GetItems(Index: Integer): TJclPeExportFuncItem; +function TJclPeExportFuncList.GetItems(Index: TJclListSize): TJclPeExportFuncItem; begin Result := TJclPeExportFuncItem(Get(Index)); end; @@ -2803,7 +2803,7 @@ function TJclPeResourceList.FindName(const Name: string): TJclPeResourceItem; end; end; -function TJclPeResourceList.GetItems(Index: Integer): TJclPeResourceItem; +function TJclPeResourceList.GetItems(Index: TJclListSize): TJclPeResourceItem; begin Result := TJclPeResourceItem(Get(Index)); end; @@ -3004,7 +3004,7 @@ function TJclPeRelocList.GetAllItems(Index: Integer): TJclPeRelocation; end; end; -function TJclPeRelocList.GetItems(Index: Integer): TJclPeRelocEntry; +function TJclPeRelocList.GetItems(Index: TJclListSize): TJclPeRelocEntry; begin Result := TJclPeRelocEntry(Get(Index)); end; @@ -3060,7 +3060,7 @@ procedure TJclPeDebugList.CreateList; end; end; -function TJclPeDebugList.GetItems(Index: Integer): TImageDebugDirectory; +function TJclPeDebugList.GetItems(Index: TJclListSize): TImageDebugDirectory; begin Result := PImageDebugDirectory(Get(Index))^; end; @@ -3102,7 +3102,7 @@ procedure TJclPeCertificateList.CreateList; end; end; -function TJclPeCertificateList.GetItems(Index: Integer): TJclPeCertificate; +function TJclPeCertificateList.GetItems(Index: TJclListSize): TJclPeCertificate; begin Result := TJclPeCertificate(Get(Index)); end; @@ -6480,7 +6480,7 @@ function TJclPeMapImgHooks.GetItemFromOriginalAddress(OriginalAddress: Pointer): end; end; -function TJclPeMapImgHooks.GetItems(Index: Integer): TJclPeMapImgHookItem; +function TJclPeMapImgHooks.GetItems(Index: TJclListSize): TJclPeMapImgHookItem; begin Result := TJclPeMapImgHookItem(Get(Index)); end; diff --git a/3rdParty/JCL/source/windows/JclRegistry.pas b/3rdParty/JCL/source/windows/JclRegistry.pas index c410ede8..6d8dca3e 100644 --- a/3rdParty/JCL/source/windows/JclRegistry.pas +++ b/3rdParty/JCL/source/windows/JclRegistry.pas @@ -1,2156 +1,2156 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is JclRegistry.pas. } -{ } -{ The Initial Developers of the Original Code are John C Molyneux, Marcel van Brakel and } -{ Charlie Calvert. Portions created by these individuals are Copyright (C) of these individuals. } -{ All Rights Reserved. } -{ } -{ Contributors: } -{ Marcel van Brakel } -{ Stephane Fillon } -{ Eric S.Fisher } -{ Peter Friese } -{ Andreas Hausladen (ahuser) } -{ Manlio Laschena (manlio) } -{ Robert Marquardt (marquardt) } -{ Robert Rossmair (rrossmair) } -{ Olivier Sannier (obones) } -{ Petr Vones (pvones) } -{ kogerbnz } -{ } -{**************************************************************************************************} -{ } -{ Contains various utility routines to read and write registry values. Using these routines } -{ prevents you from having to instantiate temporary TRegistry objects and since the routines } -{ directly call the registry API they do not suffer from the resource overhead as TRegistry does. } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -unit JclRegistry; - -{$I jcl.inc} -{$I windowsonly.inc} - -interface - -uses - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - {$IFDEF HAS_UNITSCOPE} - Winapi.Windows, System.Classes, - {$ELSE ~HAS_UNITSCOPE} - Windows, Classes, - {$ENDIF ~HAS_UNITSCOPE} - JclBase, JclStrings; - -type - DelphiHKEY = {$IFDEF CPUX64}type Winapi.Windows.HKEY{$ELSE}Longword{$ENDIF CPUX64}; - {$HPPEMIT '// BCB users must typecast the HKEY values to DelphiHKEY or use the HK-values below.'} - - TExecKind = (ekMachineRun, ekMachineRunOnce, ekUserRun, ekUserRunOnce, - ekServiceRun, ekServiceRunOnce); - - EJclRegistryError = class(EJclError); - -{$IFDEF FPC} -const - HKCR = DelphiHKEY($80000000); - HKCU = DelphiHKEY($80000001); - HKLM = DelphiHKEY($80000002); - HKUS = DelphiHKEY($80000003); - HKPD = DelphiHKEY($80000004); - HKCC = DelphiHKEY($80000005); - HKDD = DelphiHKEY($80000006); -{$ELSE ~FPC} -const - HKCR = DelphiHKEY(HKEY_CLASSES_ROOT); - HKCU = DelphiHKEY(HKEY_CURRENT_USER); - HKLM = DelphiHKEY(HKEY_LOCAL_MACHINE); - HKUS = DelphiHKEY(HKEY_USERS); - HKPD = DelphiHKEY(HKEY_PERFORMANCE_DATA); - HKCC = DelphiHKEY(HKEY_CURRENT_CONFIG); - HKDD = DelphiHKEY(HKEY_DYN_DATA); -{$IFDEF CPU64} -{$NODEFINE DelphiHKEY} -{$NODEFINE HKCR} -{$NODEFINE HKCU} -{$NODEFINE HKLM} -{$NODEFINE HKUS} -{$NODEFINE HKPD} -{$NODEFINE HKCC} -{$NODEFINE HKDD} -{$HPPEMIT 'typedef HKEY DelphiHKEY;'} -{$HPPEMIT 'static const DelphiHKEY HKCR = HKEY_CLASSES_ROOT;'} -{$HPPEMIT 'static const DelphiHKEY HKCU = HKEY_CURRENT_USER;'} -{$HPPEMIT 'static const DelphiHKEY HKLM = HKEY_LOCAL_MACHINE;'} -{$HPPEMIT 'static const DelphiHKEY HKUS = HKEY_USERS;'} -{$HPPEMIT 'static const DelphiHKEY HKPD = HKEY_PERFORMANCE_DATA;'} -{$HPPEMIT 'static const DelphiHKEY HKCC = HKEY_CURRENT_CONFIG;'} -{$HPPEMIT 'static const DelphiHKEY HKDD = HKEY_DYN_DATA;'} -{$ENDIF CPU64} -{$ENDIF FPC} - -function RootKeyName(const RootKey: THandle): string; -function RootKeyValue(const Name: string): THandle; - -const - RegKeyDelimiter = '\'; - -function RegCreateKey(const RootKey: DelphiHKEY; const Key: string): Longint; overload; -function RegCreateKey(const RootKey: DelphiHKEY; const Key, Value: string): Longint; overload; -function RegDeleteEntry(const RootKey: DelphiHKEY; const Key, Name: string): Boolean; -function RegDeleteKeyTree(const RootKey: DelphiHKEY; const Key: string): Boolean; - -function RegGetDataSize(const RootKey: DelphiHKEY; const Key, Name: string; - out DataSize: Cardinal): Boolean; -function RegGetDataType(const RootKey: DelphiHKEY; const Key, Name: string; - out DataType: Cardinal): Boolean; -function RegReadBool(const RootKey: DelphiHKEY; const Key, Name: string): Boolean; -function RegReadBoolDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Boolean): Boolean; -function RegReadIntegerEx(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: Integer; RaiseException: Boolean = False): Boolean; -function RegReadInteger(const RootKey: DelphiHKEY; const Key, Name: string): Integer; -function RegReadIntegerDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Integer): Integer; -function RegReadCardinalEx(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: Cardinal; RaiseException: Boolean = False): Boolean; -function RegReadCardinal(const RootKey: DelphiHKEY; const Key, Name: string): Cardinal; -function RegReadCardinalDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Cardinal): Cardinal; -function RegReadDWORDEx(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: DWORD; RaiseException: Boolean = False): Boolean; -function RegReadDWORD(const RootKey: DelphiHKEY; const Key, Name: string): DWORD; -function RegReadDWORDDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: DWORD): DWORD; -function RegReadInt64Ex(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: Int64; RaiseException: Boolean = False): Boolean; -function RegReadInt64(const RootKey: DelphiHKEY; const Key, Name: string): Int64; -function RegReadInt64Def(const RootKey: DelphiHKEY; const Key, Name: string; Def: Int64): Int64; -function RegReadUInt64Ex(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: UInt64; RaiseException: Boolean = False): Boolean; -function RegReadUInt64(const RootKey: DelphiHKEY; const Key, Name: string): UInt64; -function RegReadUInt64Def(const RootKey: DelphiHKEY; const Key, Name: string; Def: UInt64): UInt64; -function RegReadSingleEx(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: Single; RaiseException: Boolean = False): Boolean; -function RegReadSingle(const RootKey: DelphiHKEY; const Key, Name: string): Single; -function RegReadSingleDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Single): Single; -function RegReadDoubleEx(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: Double; RaiseException: Boolean = False): Boolean; -function RegReadDouble(const RootKey: DelphiHKEY; const Key, Name: string): Double; -function RegReadDoubleDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Double): Double; -function RegReadExtendedEx(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: Extended; RaiseException: Boolean = False): Boolean; -function RegReadExtended(const RootKey: DelphiHKEY; const Key, Name: string): Extended; -function RegReadExtendedDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Extended): Extended; - -function RegReadStringEx(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: string; RaiseException: Boolean = False): Boolean; -function RegReadString(const RootKey: DelphiHKEY; const Key, Name: string): string; -function RegReadStringDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: string): string; -function RegReadAnsiStringEx(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: AnsiString; RaiseException: Boolean = False): Boolean; -function RegReadAnsiString(const RootKey: DelphiHKEY; const Key, Name: string): AnsiString; -function RegReadAnsiStringDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: AnsiString): AnsiString; -function RegReadWideStringEx(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: WideString; RaiseException: Boolean = False): Boolean; -function RegReadWideString(const RootKey: DelphiHKEY; const Key, Name: string): WideString; -function RegReadWideStringDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: WideString): WideString; - -function RegReadMultiSzEx(const RootKey: DelphiHKEY; const Key, Name: string; Value: TStrings; - RaiseException: Boolean = False): Boolean; overload; -function RegReadMultiSzEx(const RootKey: DelphiHKEY; const Key, Name: string; out RetValue: PMultiSz; - RaiseException: Boolean = False): Boolean; overload; -procedure RegReadMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: TStrings); overload; -function RegReadMultiSz(const RootKey: DelphiHKEY; const Key, Name: string): PMultiSz; overload; -procedure RegReadMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; Value, Def: TStrings); overload; -function RegReadMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: PMultiSz): PMultiSz; overload; - -function RegReadAnsiMultiSzEx(const RootKey: DelphiHKEY; const Key, Name: string; Value: TAnsiStrings; - RaiseException: Boolean = False): Boolean; overload; -function RegReadAnsiMultiSzEx(const RootKey: DelphiHKEY; const Key, Name: string; out RetValue: PAnsiMultiSz; - RaiseException: Boolean = False): Boolean; overload; -procedure RegReadAnsiMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: TAnsiStrings); overload; -function RegReadAnsiMultiSz(const RootKey: DelphiHKEY; const Key, Name: string): PAnsiMultiSz; overload; -procedure RegReadAnsiMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; - Value, Def: TAnsiStrings); overload; -function RegReadAnsiMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; - Def: PAnsiMultiSz): PAnsiMultiSz; overload; - -function RegReadWideMultiSzEx(const RootKey: DelphiHKEY; const Key, Name: string; Value: TWideStrings; - RaiseException: Boolean = False): Boolean; overload; -function RegReadWideMultiSzEx(const RootKey: DelphiHKEY; const Key, Name: string; out RetValue: PWideMultiSz; - RaiseException: Boolean = False): Boolean; overload; -procedure RegReadWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: TWideStrings); overload; -function RegReadWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string): PWideMultiSz; overload; -procedure RegReadWideMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; - Value, Def: TWideStrings); overload; -function RegReadWideMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; - Def: PWideMultiSz): PWideMultiSz; overload; - -function RegReadBinaryEx(const RootKey: DelphiHKEY; const Key, Name: string; var Value; const ValueSize: Cardinal; - out DataSize: Cardinal; RaiseException: Boolean = False): Boolean; -function RegReadBinary(const RootKey: DelphiHKEY; const Key, Name: string; - var Value; const ValueSize: Cardinal): Cardinal; -function RegReadBinaryDef(const RootKey: DelphiHKEY; const Key, Name: string; - var Value; const ValueSize: Cardinal; const Def: Byte): Cardinal; - -procedure RegWriteBool(const RootKey: DelphiHKEY; const Key, Name: string; Value: Boolean); overload; -procedure RegWriteBool(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - Value: Boolean); overload; -procedure RegWriteInteger(const RootKey: DelphiHKEY; const Key, Name: string; Value: Integer); overload; -procedure RegWriteInteger(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - Value: Integer); overload; -procedure RegWriteCardinal(const RootKey: DelphiHKEY; const Key, Name: string; Value: Cardinal); overload; -procedure RegWriteCardinal(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - Value: Cardinal); overload; -procedure RegWriteDWORD(const RootKey: DelphiHKEY; const Key, Name: string; Value: DWORD); overload; -procedure RegWriteDWORD(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - Value: DWORD); overload; -procedure RegWriteInt64(const RootKey: DelphiHKEY; const Key, Name: string; Value: Int64); overload; -procedure RegWriteInt64(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - Value: Int64); overload; -procedure RegWriteUInt64(const RootKey: DelphiHKEY; const Key, Name: string; Value: UInt64); overload; -procedure RegWriteUInt64(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - Value: UInt64); overload; -procedure RegWriteSingle(const RootKey: DelphiHKEY; const Key, Name: string; Value: Single); overload; -procedure RegWriteSingle(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - Value: Single); overload; -procedure RegWriteDouble(const RootKey: DelphiHKEY; const Key, Name: string; Value: Double); overload; -procedure RegWriteDouble(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - Value: Double); overload; -procedure RegWriteExtended(const RootKey: DelphiHKEY; const Key, Name: string; Value: Extended); overload; -procedure RegWriteExtended(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - Value: Extended); overload; - -procedure RegWriteString(const RootKey: DelphiHKEY; const Key, Name, Value: string); overload; -procedure RegWriteString(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - const Value: string); overload; -procedure RegWriteAnsiString(const RootKey: DelphiHKEY; const Key, Name: string; const Value: AnsiString); overload; -procedure RegWriteAnsiString(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - const Value: AnsiString); overload; -procedure RegWriteWideString(const RootKey: DelphiHKEY; const Key, Name: string; const Value: WideString); overload; -procedure RegWriteWideString(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - const Value: WideString); overload; - -procedure RegWriteMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: PMultiSz); overload; -procedure RegWriteMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; const Value: TStrings); overload; -procedure RegWriteMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - Value: PMultiSz); overload; -procedure RegWriteMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - const Value: TStrings); overload; - -procedure RegWriteAnsiMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: PAnsiMultiSz); overload; -procedure RegWriteAnsiMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; - const Value: TAnsiStrings); overload; -procedure RegWriteAnsiMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - Value: PAnsiMultiSz); overload; -procedure RegWriteAnsiMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - const Value: TAnsiStrings); overload; - -procedure RegWriteWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: PWideMultiSz); overload; -procedure RegWriteWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; - const Value: TWideStrings); overload; -procedure RegWriteWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - Value: PWideMultiSz); overload; -procedure RegWriteWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - const Value: TWideStrings); overload; - -procedure RegWriteBinary(const RootKey: DelphiHKEY; const Key, Name: string; const Value; const ValueSize: Cardinal); - -function RegGetValueNames(const RootKey: DelphiHKEY; const Key: string; const List: TStrings): Boolean; -function RegGetKeyNames(const RootKey: DelphiHKEY; const Key: string; const List: TStrings): Boolean; -function RegGetValueNamesAndValues(const RootKey: HKEY; const Key: string; const List: TStrings): Boolean; -function RegHasSubKeys(const RootKey: DelphiHKEY; const Key: string): Boolean; - -function AllowRegKeyForEveryone(const RootKey: DelphiHKEY; Path: string): Boolean; - -function RegAutoExecEnabled(const ExecKind: TExecKind; const Name: string; out CmdLine: string): Boolean; - -{ -From: Jean-Fabien Connault [cycocrew att worldnet dott fr] -Descr: Test whether a registry key exists as a subkey of RootKey -Used test cases: -procedure TForm1.Button1Click(Sender: TObject); -var - RegKey: HKEY; -begin - if RegOpenKeyEx(HKEY_CURRENT_USER, 'Software', 0, KEY_READ, RegKey) = ERROR_SUCCESS then - begin - Assert(not RegKeyExists(RegKey, 'Microsoft\_Windows')); - RegCloseKey(RegKey); - end; - if RegOpenKeyEx(HKEY_CURRENT_USER, 'Software', 0, KEY_READ, RegKey) = ERROR_SUCCESS then - begin - Assert(RegKeyExists(RegKey, 'Microsoft\Windows'));; - RegCloseKey(RegKey); - end; - Assert(RegKeyExists(HKEY_CURRENT_USER, '')); - Assert(RegKeyExists(HKEY_CURRENT_USER, 'Software')); - Assert(RegKeyExists(HKEY_CURRENT_USER, 'Software\Microsoft')); - Assert(RegKeyExists(HKEY_CURRENT_USER, 'Software\Microsoft\Windows')); - Assert(RegKeyExists(HKEY_CURRENT_USER, '\Software\Microsoft\Windows')); - Assert(not RegKeyExists(HKEY_CURRENT_USER, '\Software\Microsoft2\Windows')); -end; -} -function RegKeyExists(const RootKey: DelphiHKEY; const Key: string): Boolean; -function RegValueExists(const RootKey: DelphiHKEY; const Key, Name: string): Boolean; - -function UnregisterAutoExec(ExecKind: TExecKind; const Name: string): Boolean; -function RegisterAutoExec(ExecKind: TExecKind; const Name, Cmdline: string): Boolean; - -function RegSaveList(const RootKey: DelphiHKEY; const Key: string; const ListName: string; - const Items: TStrings): Boolean; -function RegLoadList(const RootKey: DelphiHKEY; const Key: string; const ListName: string; - const SaveTo: TStrings): Boolean; -function RegDelList(const RootKey: DelphiHKEY; const Key: string; const ListName: string): Boolean; - -const - HKCRLongName = 'HKEY_CLASSES_ROOT'; - HKCULongName = 'HKEY_CURRENT_USER'; - HKLMLongName = 'HKEY_LOCAL_MACHINE'; - HKUSLongName = 'HKEY_USERS'; - HKPDLongName = 'HKEY_PERFORMANCE_DATA'; - HKCCLongName = 'HKEY_CURRENT_CONFIG'; - HKDDLongName = 'HKEY_DYN_DATA'; - HKCRShortName = 'HKCR'; - HKCUShortName = 'HKCU'; - HKLMShortName = 'HKLM'; - HKUSShortName = 'HKUS'; - HKPDShortName = 'HKPD'; - HKCCShortName = 'HKCC'; - HKDDShortName = 'HKDD'; - -type - TRootKey = record - Key: DelphiHKEY; - AnsiName: AnsiString; - WideName: TUTF16String; - end; - -const - RootKeys: array [0..13] of TRootKey = - ( - (Key: HKCR; AnsiName: HKCRLongName; WideName: HKCRLongName), - (Key: HKCU; AnsiName: HKCULongName; WideName: HKCULongName), - (Key: HKLM; AnsiName: HKLMLongName; WideName: HKLMLongName), - (Key: HKUS; AnsiName: HKUSLongName; WideName: HKUSLongName), - (Key: HKPD; AnsiName: HKPDLongName; WideName: HKPDLongName), - (Key: HKCC; AnsiName: HKCCLongName; WideName: HKCCLongName), - (Key: HKDD; AnsiName: HKDDLongName; WideName: HKDDLongName), - (Key: HKCR; AnsiName: HKCRShortName; WideName: HKCRShortName), - (Key: HKCU; AnsiName: HKCUShortName; WideName: HKCUShortName), - (Key: HKLM; AnsiName: HKLMShortName; WideName: HKLMShortName), - (Key: HKUS; AnsiName: HKUSShortName; WideName: HKUSShortName), - (Key: HKPD; AnsiName: HKPDShortName; WideName: HKPDShortName), - (Key: HKCC; AnsiName: HKCCShortName; WideName: HKCCShortName), - (Key: HKDD; AnsiName: HKDDShortName; WideName: HKDDShortName) - ); - -type - { clRegWOW64Access allows the user to switch all registry functions to the 64 bit registry - key on a 64bit system. - - OS/Application 32bit/32bit 64bit/32bit 64bit/64bit - raDefault Software Wow6432Node Software - raNative Software Software Software - ra32Key Software Wow6432Node Wow6432Node - ra64Key Software Software Software - } - TJclRegWOW64Access = (raDefault, raNative, ra32Key, ra64Key); - -// cannot access variable JclRegWOW64Access from outside package -// so these helper functions can be used. -function RegGetWOW64AccessMode: TJclRegWOW64Access; -procedure RegSetWOW64AccessMode(Access: TJclRegWOW64Access); - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\windows'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -uses - {$IFDEF HAS_UNITSCOPE} - System.SysUtils, - Winapi.AccCtrl, - {$ELSE ~HAS_UNITSCOPE} - SysUtils, - AccCtrl, - {$ENDIF ~HAS_UNITSCOPE} - {$IFDEF FPC} -// JwaAccCtrl, - {$ELSE ~FPC} - JclSysUtils, - {$ENDIF ~FPC} - JclResources, JclWin32, JclSysInfo, - JclAnsiStrings, JclWideStrings; - -type - TRegKind = REG_NONE..REG_QWORD; - TRegKinds = set of TRegKind; - -const - cItems = 'Items'; - cRegBinKinds = [REG_SZ..REG_QWORD]; // all types - -var - CachedIsWindows64: Integer = -1; - -threadvar - JclRegWOW64Access: TJclRegWOW64Access {= raDefault}; - -function RegGetWOW64AccessMode: TJclRegWOW64Access; -begin - Result := JclRegWOW64Access; -end; - -procedure RegSetWOW64AccessMode(Access: TJclRegWOW64Access); -begin - JclRegWOW64Access := Access; -end; - -//=== Internal helper routines =============================================== - -function GetWOW64AccessMode(samDesired: REGSAM): REGSAM; -const - KEY_WOW64_32KEY = $0200; - KEY_WOW64_64KEY = $0100; - KEY_WOW64_RES = $0300; - RegWOW64Accesses: array[Boolean, TJclRegWOW64Access] of HKEY = ( - (HKEY(0), HKEY(0), HKEY(0), HKEY(0)), - (HKEY(0), KEY_WOW64_64KEY, KEY_WOW64_32KEY, KEY_WOW64_64KEY) - ); -begin - Result := samDesired; - if (Win32Platform = VER_PLATFORM_WIN32_NT) and (samDesired and KEY_WOW64_RES = 0) then - begin - if CachedIsWindows64 = -1 then - if IsWindows64 then - CachedIsWindows64 := 1 - else - CachedIsWindows64 := 0; - - Result := Result or RegWOW64Accesses[CachedIsWindows64 = 1, JclRegWOW64Access]; - end; -end; - -function RootKeyName(const RootKey: THandle): string; -begin - case RootKey of - {$IFDEF DELPHI64_TEMPORARY} - Integer(HKCR) : Result := HKCRLongName; - Integer(HKCU) : Result := HKCULongName; - Integer(HKLM) : Result := HKLMLongName; - Integer(HKUS) : Result := HKUSLongName; - Integer(HKPD) : Result := HKPDLongName; - Integer(HKCC) : Result := HKCCLongName; - Integer(HKDD) : Result := HKDDLongName; - {$ELSE ~DELPHI64_TEMPORARY} - HKCR : Result := HKCRLongName; - HKCU : Result := HKCULongName; - HKLM : Result := HKLMLongName; - HKUS : Result := HKUSLongName; - HKPD : Result := HKPDLongName; - HKCC : Result := HKCCLongName; - HKDD : Result := HKDDLongName; - {$ENDIF ~DELPHI64_TEMPORARY} - else - Result := Format(HexFmt, [RootKey]); - end; -end; - -function RootKeyValue(const Name: string): THandle; -var - Index: Integer; -begin - for Index := Low(RootKeys) to High(RootKeys) do - if string(RootKeys[Index].AnsiName) = Name then - begin - Result := RootKeys[Index].Key; - Exit; - end; - raise EJclRegistryError.CreateResFmt(@RsInconsistentPath, [Name]); -end; - -procedure ReadError(const RootKey: THandle; const Key: string); -begin - raise EJclRegistryError.CreateResFmt(@RsUnableToOpenKeyRead, [RootKeyName(RootKey), Key]); -end; - -procedure WriteError(const RootKey: THandle; const Key: string); -begin - raise EJclRegistryError.CreateResFmt(@RsUnableToOpenKeyWrite, [RootKeyName(RootKey), Key]); -end; - -procedure ValueError(const RootKey: THandle; const Key, Name: string); -begin - raise EJclRegistryError.CreateResFmt(@RsUnableToAccessValue, [RootKeyName(RootKey), Key, Name]); -end; - -procedure DataError(const RootKey: THandle; const Key, Name: string); -begin - raise EJclRegistryError.CreateResFmt(@RsWrongDataType, [RootKeyName(RootKey), Key, Name]); -end; - -function GetKeyAndPath(ExecKind: TExecKind; out Key: HKEY; out RegPath: string): Boolean; -begin - Result := False; - if (ExecKind in [ekServiceRun, ekServiceRunOnce]) and (Win32Platform = VER_PLATFORM_WIN32_NT) then - Exit; - if ExecKind in [ekMachineRun, ekMachineRunOnce, ekServiceRun, ekServiceRunOnce] then - Key := HKEY_LOCAL_MACHINE - else - Key := HKEY_CURRENT_USER; - RegPath := 'Software\Microsoft\Windows\CurrentVersion\'; - case ExecKind of - ekMachineRun, ekUserRun: - RegPath := RegPath + 'Run'; - ekMachineRunOnce, ekUserRunOnce: - RegPath := RegPath + 'RunOnce'; - ekServiceRun: - RegPath := RegPath + 'RunServices'; - ekServiceRunOnce: - RegPath := RegPath + 'RunServicesOnce'; - end; - Result := True; -end; - -function RelativeKey(const RootKey: DelphiHKEY; Key: PAnsiChar): PAnsiChar; overload; -var - I: Integer; -begin - Result := Key; - if Result^ = RegKeyDelimiter then - Inc(Result); - for I := Low(RootKeys) to High(RootKeys) do - if StrPosA(Key, PAnsiChar(RootKeys[I].AnsiName + RegKeyDelimiter)) = Result then - begin - if RootKey <> RootKeys[I].Key then - raise EJclRegistryError.CreateResFmt(@RsInconsistentPath, [Key]) - else - Inc(Result, Length(RootKeys[I].AnsiName)); - Break; - end; -end; - -function RelativeKey(const RootKey: DelphiHKEY; Key: PWideChar): PWideChar; overload; -var - I: Integer; -begin - Result := Key; - if Result^ = RegKeyDelimiter then - Inc(Result); - for I := Low(RootKeys) to High(RootKeys) do - if StrPosW(Key, PWideChar(RootKeys[I].WideName + RegKeyDelimiter)) = Result then - begin - if RootKey <> RootKeys[I].Key then - raise EJclRegistryError.CreateResFmt(@RsInconsistentPath, [Key]) - else - Inc(Result, Length(RootKeys[I].WideName)); - Break; - end; -end; - -function InternalRegOpenKeyEx(Key: HKEY; SubKey: PWideChar; - ulOptions: DWORD; samDesired: REGSAM; var RegKey: HKEY): Longint; overload; -var - RelKey: AnsiString; -begin - if Win32Platform = VER_PLATFORM_WIN32_NT then - Result := RegOpenKeyExW(Key, RelativeKey(Key, SubKey), ulOptions, GetWOW64AccessMode(samDesired), RegKey) - else - begin - RelKey := AnsiString(WideString(RelativeKey(Key, SubKey))); - Result := RegOpenKeyExA(Key, PAnsiChar(RelKey), ulOptions, samDesired, RegKey); - end; -end; - -function InternalRegOpenKeyEx(Key: HKEY; SubKey: PAnsiChar; - ulOptions: DWORD; samDesired: REGSAM; var RegKey: HKEY): Longint; overload; -begin - if Win32Platform = VER_PLATFORM_WIN32_NT then - Result := RegOpenKeyExA(Key, RelativeKey(Key, SubKey), ulOptions, GetWOW64AccessMode(samDesired), RegKey) - else - Result := RegOpenKeyExA(Key, RelativeKey(Key, SubKey), ulOptions, samDesired, RegKey); -end; - -function InternalRegQueryValueEx(Key: HKEY; ValueName: PWideChar; - lpReserved: Pointer; lpType: PDWORD; lpData: Pointer; lpcbData: PDWORD): Longint; -var - ValName: AnsiString; -begin - if Win32Platform = VER_PLATFORM_WIN32_NT then - Result := RegQueryValueExW(Key, ValueName, lpReserved, lpType, lpData, lpcbData) - else - begin - ValName := AnsiString(WideString(ValueName)); - Result := RegQueryValueExA(Key, PAnsiChar(ValName), lpReserved, lpType, lpData, lpcbData); - end; -end; - -function InternalRegSetValueEx(Key: HKEY; ValueName: PWideChar; - Reserved: DWORD; dwType: DWORD; lpData: Pointer; cbData: DWORD): Longint; stdcall; -var - ValName: AnsiString; -begin - if Win32Platform = VER_PLATFORM_WIN32_NT then - Result := RegSetValueExW(Key, ValueName, Reserved, dwType, lpData, cbData) - else - begin - ValName := AnsiString(WideString(ValueName)); - Result := RegSetValueExA(Key, PAnsiChar(ValName), Reserved, dwType, lpData, cbData); - end; -end; - -function InternalGetData(const RootKey: DelphiHKEY; const Key, Name: TUTF16String; - RegKinds: TRegKinds; ExpectedSize: DWORD; - out DataType: DWORD; Data: Pointer; out DataSize: DWORD; RaiseException: Boolean): Boolean; -var - RegKey: HKEY; -begin - Result := True; - DataType := REG_NONE; - DataSize := 0; - RegKey := 0; - if InternalRegOpenKeyEx(RootKey, PWideChar(Key), 0, KEY_READ, RegKey) = ERROR_SUCCESS then - try - if InternalRegQueryValueEx(RegKey, PWideChar(Name), nil, @DataType, nil, @DataSize) = ERROR_SUCCESS then - begin - if not (DataType in RegKinds) or (DataSize > ExpectedSize) then - if RaiseException then - DataError(RootKey, Key, Name) - else - Result := False; - if InternalRegQueryValueEx(RegKey, PWideChar(Name), nil, nil, Data, @DataSize) <> ERROR_SUCCESS then - if RaiseException then - ValueError(RootKey, Key, Name) - else - Result := False; - end - else - if RaiseException then - ValueError(RootKey, Key, Name) - else - Result := False; - finally - RegCloseKey(RegKey); - end - else - if RaiseException then - ReadError(RootKey, Key) - else - Result := False; -end; - -function InternalGetAnsiString(const RootKey: DelphiHKEY; const Key, Name: WideString; MultiFlag: Boolean; - out RetValue: AnsiString; RaiseException: Boolean): Boolean; -var - RegKey: HKEY; - DataType, DataSize: DWORD; - TmpRet: WideString; - DataLength: Integer; - RegKinds: TRegKinds; -begin - Result := True; - DataType := REG_NONE; - DataSize := 0; - RetValue := ''; - RegKey := 0; - if InternalRegOpenKeyEx(RootKey, PWideChar(Key), 0, KEY_READ, RegKey) = ERROR_SUCCESS then - try - if InternalRegQueryValueEx(RegKey, PWideChar(Name), nil, @DataType, nil, @DataSize) = ERROR_SUCCESS then - begin - if MultiFlag then - RegKinds := [REG_BINARY, REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ] - else - RegKinds := [REG_BINARY, REG_SZ, REG_EXPAND_SZ]; - if DataType in RegKinds then - begin - if Win32Platform = VER_PLATFORM_WIN32_NT then - begin - DataLength := DataSize div SizeOf(WideChar); - SetLength(TmpRet, DataLength); - Result := InternalRegQueryValueEx(RegKey, PWideChar(Name), nil, nil, PWideChar(TmpRet), @DataSize) = ERROR_SUCCESS; - if Result then - RetValue := AnsiString(Copy(TmpRet, 1, DataLength - 1)); - end - else - begin - DataLength := DataSize div SizeOf(AnsiChar); - SetLength(RetValue, DataLength); - Result := InternalRegQueryValueEx(RegKey, PWideChar(Name), nil, nil, PAnsiChar(RetValue), @DataSize) = ERROR_SUCCESS; - if Result then - SetLength(RetValue, DataLength - 1); - end; - if not Result then - begin - RetValue := ''; - if RaiseException then - ValueError(RootKey, Key, Name) - else - Result := False; - end; - end - else - begin - RetValue := ''; - if RaiseException then - DataError(RootKey, Key, Name) - else - Result := False; - end; - end - else - if RaiseException then - ValueError(RootKey, Key, Name) - else - Result := False; - finally - RegCloseKey(RegKey); - end - else - if RaiseException then - ReadError(RootKey, Key) - else - Result := False; -end; - -function InternalGetWideString(const RootKey: DelphiHKEY; const Key, Name: WideString; MultiFlag: Boolean; - out RetValue: WideString; RaiseException: Boolean): Boolean; -var - RegKey: HKEY; - DataType, DataSize: DWORD; - RegKinds: TRegKinds; - DataLength: Integer; -begin - Result := True; - DataType := REG_NONE; - DataSize := 0; - RetValue := ''; - RegKey := 0; - if InternalRegOpenKeyEx(RootKey, PWideChar(Key), 0, KEY_READ, RegKey) = ERROR_SUCCESS then - try - if InternalRegQueryValueEx(RegKey, PWideChar(Name), nil, @DataType, nil, @DataSize) = ERROR_SUCCESS then - begin - if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then - RegKinds := [REG_BINARY] - else - if MultiFlag then - RegKinds := [REG_BINARY, REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ] - else - RegKinds := [REG_BINARY, REG_SZ, REG_EXPAND_SZ]; - if DataType in RegKinds then - begin - DataLength := DataSize div SizeOf(WideChar); - SetLength(RetValue, DataLength); - if InternalRegQueryValueEx(RegKey, PWideChar(Name), nil, nil, PWideChar(RetValue), @DataSize) = ERROR_SUCCESS then - SetLength(RetValue, DataLength - 1) - else - begin - RetValue := ''; - if RaiseException then - ValueError(RootKey, Key, Name) - else - Result := False; - end; - end - else - begin - RetValue := ''; - if RaiseException then - DataError(RootKey, Key, Name) - else - Result := False; - end; - end - else - if RaiseException then - ValueError(RootKey, Key, Name) - else - Result := False; - finally - RegCloseKey(RegKey); - end - else - if RaiseException then - ReadError(RootKey, Key) - else - Result := False; -end; - -function InternalStrToFloat(const RootKey: DelphiHKEY; const Key, Name: string; out Success: Boolean; - RaiseException: Boolean): Extended; -var - {$IFDEF RTL150_UP} - FS: TFormatSettings; - {$ELSE ~RTL150_UP} - OldSep: Char; - {$ENDIF ~RTL150_UP} -begin - {$IFDEF RTL150_UP} - FS.ThousandSeparator := ','; - FS.DecimalSeparator := '.'; - {$ELSE ~RTL150_UP} - OldSep := DecimalSeparator; - try - DecimalSeparator := '.'; - {$ENDIF ~RTL150_UP} - if RaiseException then - begin - Result := StrToFloat(RegReadString(RootKey, Key, Name){$IFDEF RTL150_UP}, FS{$ENDIF}); - Success := True; - end - else - Success := TryStrToFloat(RegReadString(RootKey, Key, Name), Result{$IFDEF RTL150_UP}, FS{$ENDIF}); - {$IFNDEF RTL150_UP} - finally - DecimalSeparator := OldSep; - end; - {$ENDIF ~RTL150_UP} -end; - -procedure InternalSetData(const RootKey: DelphiHKEY; const Key, Name: WideString; - RegKind: TRegKind; Value: Pointer; ValueSize: Cardinal); -var - RegKey: HKEY; -begin - if not RegKeyExists(RootKey, Key) then - RegCreateKey(RootKey, Key); - RegKey := 0; - if InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PWideChar(Key)), 0, KEY_WRITE, RegKey) = ERROR_SUCCESS then - try - if InternalRegSetValueEx(RegKey, PWideChar(Name), 0, RegKind, Value, ValueSize) <> ERROR_SUCCESS then - WriteError(RootKey, Key); - finally - RegCloseKey(RegKey); - end - else - WriteError(RootKey, Key); -end; - -procedure InternalSetAnsiData(const RootKey: DelphiHKEY; const Key, Name: WideString; - RegKind: TRegKind; Value: Pointer; ValueSize: Cardinal); -var - Source: AnsiString; - Dest: WideString; -begin - if Win32Platform = VER_PLATFORM_WIN32_NT then - begin - // destination must be wide data - SetLength(Source, ValueSize div SizeOf(AnsiChar)); - Move(Value^,Source[1],ValueSize * SizeOf(AnsiChar)); - Dest := WideString(Source); - InternalSetData(RootKey, Key, Name, RegKind, PWideChar(Dest), SizeOf(WideChar) * ValueSize); - end - else - InternalSetData(RootKey, Key, Name, RegKind, Value, ValueSize); -end; - -procedure InternalSetWideData(const RootKey: DelphiHKEY; const Key, Name: string; - RegKind: TRegKind; Value: Pointer; ValueSize: Cardinal); -begin - if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and (RegKind in [REG_SZ, REG_MULTI_SZ, REG_EXPAND_SZ]) then - RegKind := REG_BINARY; - InternalSetData(RootKey, Key, Name, RegKind, Value, ValueSize); -end; - -//=== Registry =============================================================== - -function RegCreateKey(const RootKey: DelphiHKEY; const Key: string): Longint; -var - RegKey: HKEY; -begin - RegKey := 0; - Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.RegCreateKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, nil, 0, - GetWOW64AccessMode(KEY_ALL_ACCESS), nil, RegKey, nil); - if Result = ERROR_SUCCESS then - RegCloseKey(RegKey); -end; - -function RegCreateKey(const RootKey: DelphiHKEY; const Key, Value: string): Longint; -begin - Result := RegSetValue(RootKey, RelativeKey(RootKey, PChar(Key)), REG_SZ, PChar(Value), Length(Value)); -end; - -function RegDeleteEntry(const RootKey: DelphiHKEY; const Key, Name: string): Boolean; -var - RegKey: HKEY; -begin - Result := False; - RegKey := 0; - if InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_SET_VALUE, RegKey) = ERROR_SUCCESS then - begin - Result := RegDeleteValue(RegKey, PChar(Name)) = ERROR_SUCCESS; - RegCloseKey(RegKey); - if not Result then - ValueError(RootKey, Key, Name); - end - else - WriteError(RootKey, Key); -end; - -function RegDeleteKeyTree(const RootKey: DelphiHKEY; const Key: string): Boolean; -var - RegKey: HKEY; - I: DWORD; - Size: DWORD; - NumSubKeys: DWORD; - MaxSubKeyLen: DWORD; - KeyName: string; -begin - RegKey := 0; - Result := InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_ALL_ACCESS, RegKey) = ERROR_SUCCESS; - if Result then - begin - RegQueryInfoKey(RegKey, nil, nil, nil, @NumSubKeys, @MaxSubKeyLen, nil, nil, nil, nil, nil, nil); - if NumSubKeys <> 0 then - for I := NumSubKeys - 1 downto 0 do - begin - Size := MaxSubKeyLen+1; - SetLength(KeyName, Size); - RegEnumKeyEx(RegKey, I, PChar(KeyName), Size, nil, nil, nil, nil); - SetLength(KeyName, StrLen(PChar(KeyName))); - Result := RegDeleteKeyTree(RootKey, Key + RegKeyDelimiter + KeyName); - if not Result then - Break; - end; - RegCloseKey(RegKey); - if Result then - Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.RegDeleteKey(RootKey, RelativeKey(RootKey, PChar(Key))) = ERROR_SUCCESS; - end - else - WriteError(RootKey, Key); -end; - -function RegGetDataSize(const RootKey: DelphiHKEY; const Key, Name: string; - out DataSize: Cardinal): Boolean; -var - RegKey: HKEY; -begin - DataSize := 0; - RegKey := 0; - Result := InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS; - if Result then - begin - Result := RegQueryValueEx(RegKey, PChar(Name), nil, nil, nil, @DataSize) = ERROR_SUCCESS; - RegCloseKey(RegKey); - end; -end; - -function RegGetDataType(const RootKey: DelphiHKEY; const Key, Name: string; - out DataType: DWORD): Boolean; -var - RegKey: HKEY; -begin - DataType := REG_NONE; - RegKey := 0; - Result := InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS; - if Result then - begin - Result := RegQueryValueEx(RegKey, PChar(Name), nil, @DataType, nil, nil) = ERROR_SUCCESS; - RegCloseKey(RegKey); - end; -end; - -function RegReadBool(const RootKey: DelphiHKEY; const Key, Name: string): Boolean; -begin - Result := RegReadInteger(RootKey, Key, Name) <> 0; -end; - -function RegReadBoolDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Boolean): Boolean; -begin - Result := RegReadIntegerDef(RootKey, Key, Name, Ord(Def)) <> 0; -end; - -function RegReadIntegerEx(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: Integer; RaiseException: Boolean): Boolean; -var - DataType, DataSize: DWORD; - Ret: Int64; -begin - Ret := 0; - RegGetDataType(RootKey, Key, Name, DataType); - if DataType in [REG_SZ, REG_EXPAND_SZ] then - if RaiseException then - begin - Ret := StrToInt64(RegReadString(RootKey, Key, Name)); - Result := True; - end - else - Result := TryStrToInt64(RegReadString(RootKey, Key, Name), Ret) - else - Result := InternalGetData(RootKey, Key, Name, [REG_BINARY, REG_DWORD, REG_QWORD], - SizeOf(Ret), DataType, @Ret, DataSize, RaiseException); - RetValue := Integer(Ret and $FFFFFFFF); -end; - -function RegReadInteger(const RootKey: DelphiHKEY; const Key, Name: string): Integer; -begin - RegReadIntegerEx(RootKey, Key, Name, Result, True); -end; - -function RegReadIntegerDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Integer): Integer; -begin - try - if not RegReadIntegerEx(RootKey, Key, Name, Result, False) then - Result := Def; - except - Result := Def; - end; -end; - -function RegReadCardinalEx(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: Cardinal; RaiseException: Boolean): Boolean; -var - DataType, DataSize: DWORD; - Ret: Int64; -begin - Ret := 0; - RegGetDataType(RootKey, Key, Name, DataType); - if DataType in [REG_SZ, REG_EXPAND_SZ] then - if RaiseException then - begin - Ret := StrToInt64(RegReadString(RootKey, Key, Name)); - Result := True; - end - else - Result := TryStrToInt64(RegReadString(RootKey, Key, Name), Ret) - else - Result := InternalGetData(RootKey, Key, Name, [REG_BINARY, REG_DWORD, REG_QWORD], - SizeOf(Ret), DataType, @Ret, DataSize, RaiseException); - RetValue := Cardinal(Ret) and $FFFFFFFF; -end; - -function RegReadCardinal(const RootKey: DelphiHKEY; const Key, Name: string): Cardinal; -begin - RegReadCardinalEx(RootKey, Key, Name, Result, True); -end; - -function RegReadCardinalDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Cardinal): Cardinal; -begin - try - if not RegReadCardinalEx(RootKey, Key, Name, Result, False) then - Result := Def; - except - Result := Def; - end; -end; - -function RegReadDWORDEx(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: DWORD; RaiseException: Boolean): Boolean; -begin - Result := RegReadCardinalEx(RootKey, Key, Name, RetValue, RaiseException); -end; - -function RegReadDWORD(const RootKey: DelphiHKEY; const Key, Name: string): DWORD; -begin - Result := RegReadCardinal(RootKey, Key, Name); -end; - -function RegReadDWORDDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: DWORD): DWORD; -begin - Result := RegReadCardinalDef(RootKey, Key, Name, Def); -end; - -function RegReadInt64Ex(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: Int64; RaiseException: Boolean): Boolean; -var - DataType, DataSize: DWORD; - Data: array [0..1] of Integer; - Ret: Int64; -begin - RegGetDataType(RootKey, Key, Name, DataType); - if DataType in [REG_SZ, REG_EXPAND_SZ] then - begin - // (rom) circumvents internal compiler error for D6 - if RaiseException then - begin - Ret := StrToInt64(RegReadString(RootKey, Key, Name)); - Result := True; - end - else - Result := TryStrToInt64(RegReadString(RootKey, Key, Name), Ret); - RetValue := Ret; - end - else - begin - Data[0] := 0; - Data[1] := 0; - Result := InternalGetData(RootKey, Key, Name, [REG_BINARY, REG_DWORD, REG_QWORD], - SizeOf(Data), DataType, @Data, DataSize, RaiseException); - // REG_BINARY is implicitly unsigned if DataSize < 8 - if DataType = REG_DWORD then - // DWORDs get sign extended - RetValue := Data[0] - else - Move(Data[0], RetValue, SizeOf(Data)); - end; -end; - -function RegReadInt64(const RootKey: DelphiHKEY; const Key, Name: string): Int64; -begin - RegReadInt64Ex(RootKey, Key, Name, Result, True); -end; - -function RegReadInt64Def(const RootKey: DelphiHKEY; const Key, Name: string; Def: Int64): Int64; -begin - try - if not RegReadInt64Ex(RootKey, Key, Name, Result, False) then - Result := Def; - except - Result := Def; - end; -end; - -function RegReadUInt64Ex(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: UInt64; RaiseException: Boolean): Boolean; -var - DataType, DataSize: DWORD; - Ret: Int64; -begin - RegGetDataType(RootKey, Key, Name, DataType); - if DataType in [REG_SZ, REG_EXPAND_SZ] then - begin - // (rom) circumvents internal compiler error for D6 - if RaiseException then - begin - Ret := StrToInt64(RegReadString(RootKey, Key, Name)); - Result := True; - end - else - Result := TryStrToInt64(RegReadString(RootKey, Key, Name), Ret); - RetValue := UInt64(Ret); - end - else - begin - // type cast required to circumvent internal error in D7 - RetValue := UInt64(0); - Result := InternalGetData(RootKey, Key, Name, [REG_BINARY, REG_DWORD, REG_QWORD], - SizeOf(RetValue), DataType, @RetValue, DataSize, RaiseException); - end; -end; - -function RegReadUInt64(const RootKey: DelphiHKEY; const Key, Name: string): UInt64; -begin - RegReadUInt64Ex(RootKey, Key, Name, Result, True); -end; - -function RegReadUInt64Def(const RootKey: DelphiHKEY; const Key, Name: string; Def: UInt64): UInt64; -begin - try - if not RegReadUInt64Ex(RootKey, Key, Name, Result, False) then - Result := Def; - except - Result := Def; - end; -end; - -function RegReadSingleEx(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: Single; RaiseException: Boolean): Boolean; -var - DataType, DataSize: DWORD; -begin - RegGetDataType(RootKey, Key, Name, DataType); - if DataType in [REG_SZ, REG_EXPAND_SZ] then - RetValue := InternalStrToFloat(RootKey, Key, Name, Result, RaiseException) - else - Result := InternalGetData(RootKey, Key, Name, [REG_BINARY], - SizeOf(RetValue), DataType, @RetValue, DataSize, RaiseException); -end; - -function RegReadSingle(const RootKey: DelphiHKEY; const Key, Name: string): Single; -begin - RegReadSingleEx(RootKey, KEy, Name, Result, True); -end; - -function RegReadSingleDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Single): Single; -begin - try - if not RegReadSingleEx(RootKey, KEy, Name, Result, False) then - Result := Def; - except - Result := Def; - end; -end; - -function RegReadDoubleEx(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: Double; RaiseException: Boolean): Boolean; -var - DataType, DataSize: DWORD; -begin - RegGetDataType(RootKey, Key, Name, DataType); - if DataType in [REG_SZ, REG_EXPAND_SZ] then - RetValue := InternalStrToFloat(RootKey, Key, Name, Result, RaiseException) - else - Result := InternalGetData(RootKey, Key, Name, [REG_BINARY], - SizeOf(RetValue), DataType, @RetValue, DataSize, RaiseException); -end; - -function RegReadDouble(const RootKey: DelphiHKEY; const Key, Name: string): Double; -begin - RegReadDoubleEx(RootKey, Key, Name, Result, True); -end; - -function RegReadDoubleDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Double): Double; -begin - try - if not RegReadDoubleEx(RootKey, Key, Name, Result, False) then - Result := Def; - except - Result := Def; - end; -end; - -function RegReadExtendedEx(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: Extended; RaiseException: Boolean): Boolean; -var - DataType, DataSize: DWORD; -begin - RegGetDataType(RootKey, Key, Name, DataType); - if DataType in [REG_SZ, REG_EXPAND_SZ] then - RetValue := InternalStrToFloat(RootKey, Key, Name, Result, RaiseException) - else - Result := InternalGetData(RootKey, Key, Name, [REG_BINARY], - SizeOf(RetValue), DataType, @RetValue, DataSize, RaiseException); -end; - -function RegReadExtended(const RootKey: DelphiHKEY; const Key, Name: string): Extended; -begin - RegReadExtendedEx(RootKey, Key, Name, Result, True); -end; - -function RegReadExtendedDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Extended): Extended; -begin - try - if not RegReadExtendedEx(RootKey, Key, Name, Result, False) then - Result := Def; - except - Result := Def; - end; -end; - -function RegReadStringEx(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: string; RaiseException: Boolean): Boolean; -{$IFDEF SUPPORTS_UNICODE} -var - TmpRet: WideString; -begin - Result := InternalGetWideString(RootKey, Key, Name, False, TmpRet, RaiseException); - RetValue := string(TmpRet); -end; -{$ELSE ~SUPPORTS_UNICODE} -var - TmpRet: AnsiString; -begin - Result := InternalGetAnsiString(RootKey, Key, Name, False, TmpRet, RaiseException); - RetValue := string(TmpRet); -end; -{$ENDIF ~SUPPORTS_UNICODE} - -function RegReadString(const RootKey: DelphiHKEY; const Key, Name: string): string; -begin - RegReadStringEx(RootKey, Key, Name, Result, True); -end; - -function RegReadStringDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: string): string; -begin - try - if not RegReadStringEx(RootKey, Key, Name, Result, False) then - Result := Def; - except - Result := Def; - end; -end; - -function RegReadAnsiStringEx(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: AnsiString; RaiseException: Boolean): Boolean; -begin - Result := InternalGetAnsiString(RootKey, Key, Name, False, RetValue, RaiseException); -end; - -function RegReadAnsiString(const RootKey: DelphiHKEY; const Key, Name: string): AnsiString; -begin - RegReadAnsiStringEx(RootKey, Key, Name, Result, True); -end; - -function RegReadAnsiStringDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: AnsiString): AnsiString; -begin - try - if not RegReadAnsiStringEx(RootKey, Key, Name, Result, False) then - Result := Def; - except - Result := Def; - end; -end; - -function RegReadWideStringEx(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: WideString; RaiseException: Boolean): Boolean; -begin - Result := InternalGetWideString(RootKey, Key, Name, False, RetValue, RaiseException); -end; - -function RegReadWideString(const RootKey: DelphiHKEY; const Key, Name: string): WideString; -begin - RegReadWideStringEx(RootKey, Key, Name, Result, True); -end; - -function RegReadWideStringDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: WideString): WideString; -begin - try - if not RegReadWideStringEx(RootKey, Key, Name, Result, False) then - Result := Def; - except - Result := Def; - end; -end; - -function RegReadMultiSzEx(const RootKey: DelphiHKEY; const Key, Name: string; Value: TStrings; - RaiseException: Boolean): Boolean; -{$IFDEF SUPPORTS_UNICODE} -var - S: WideString; -begin - Result := InternalGetWideString(RootKey, Key, Name, True, S, RaiseException); - if Result then - WideMultiSzToWideStrings(Value, PWideMultiSz(PChar(S))); -end; -{$ELSE ~SUPPORTS_UNICODE} -var - S: AnsiString; -begin - Result := InternalGetAnsiString(RootKey, Key, Name, True, S, RaiseException); - if Result then - JclStrings.MultiSzToStrings(Value, PAnsiMultiSz(PChar(S))); -end; -{$ENDIF ~SUPPORTS_UNICODE} - -procedure RegReadMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: TStrings); -begin - RegReadMultiSzEx(RootKey, Key, Name, Value, True); -end; - -procedure RegReadMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; Value, Def: TStrings); -begin - try - if not RegReadMultiSzEx(RootKey, Key, Name, Value, False) then - Value.Assign(Def); - except - Value.Assign(Def); - end; -end; - -function RegReadMultiSzEx(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: PMultiSz; RaiseException: Boolean): Boolean; -{$IFDEF SUPPORTS_UNICODE} -var - S: WideString; -begin - Result := InternalGetWideString(RootKey, Key, Name, True, S, RaiseException); - if Result then - // always returns a newly allocated PMultiSz - RetValue := WideMultiSzDup(PWideMultiSz(S)) - else - RetValue := nil; -end; -{$ELSE ~SUPPORTS_UNICODE} -var - S: AnsiString; -begin - Result := InternalGetAnsiString(RootKey, Key, Name, True, S, RaiseException); - if Result then - // always returns a newly allocated PMultiSz - RetValue := JclAnsiStrings.MultiSzDup(PAnsiMultiSz(S)) - else - RetValue := nil; -end; -{$ENDIF ~SUPPORTS_UNICODE} - -function RegReadMultiSz(const RootKey: DelphiHKEY; const Key, Name: string): JclStrings.PMultiSz; -begin - RegReadMultiSzEx(RootKey, Key, Name, Result, True); -end; - -function RegReadMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: JclStrings.PMultiSz): JclStrings.PMultiSz; -begin - try - if not RegReadMultiSzEx(RootKey, Key, Name, Result, False) then - // always returns a newly allocated PMultiSz - Result := JclStrings.MultiSzDup(Def); - except - // always returns a newly allocated PMultiSz - Result := JclStrings.MultiSzDup(Def); - end; -end; - -function RegReadAnsiMultiSzEx(const RootKey: DelphiHKEY; const Key, Name: string; Value: TAnsiStrings; - RaiseException: Boolean): Boolean; -var - S: AnsiString; -begin - Result := InternalGetAnsiString(RootKey, Key, Name, True, S, RaiseException); - if Result then - JclAnsiStrings.MultiSzToStrings(Value, PAnsiMultiSz(S)); -end; - -procedure RegReadAnsiMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: TAnsiStrings); -begin - RegReadAnsiMultiSzEx(RootKey, Key, Name, Value, True); -end; - -procedure RegReadAnsiMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; Value, Def: TAnsiStrings); -begin - try - if not RegReadAnsiMultiSzEx(RootKey, Key, Name, Value, False) then - Value.Assign(Def); - except - Value.Assign(Def); - end; -end; - -function RegReadAnsiMultiSzEx(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: PAnsiMultiSz; RaiseException: Boolean): Boolean; overload; -var - S: AnsiString; -begin - RetValue := nil; - Result := InternalGetAnsiString(RootKey, Key, Name, True, S, RaiseException); - if Result then - // always returns a newly allocated PMultiAnsiSz - RetValue := JclAnsiStrings.MultiSzDup(PAnsiMultiSz(S)); -end; - -function RegReadAnsiMultiSz(const RootKey: DelphiHKEY; const Key, Name: string): PAnsiMultiSz; -begin - RegReadAnsiMultiSzEx(RootKey, Key, Name, Result, True); -end; - -function RegReadAnsiMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: PAnsiMultiSz): PAnsiMultiSz; -begin - try - if RegReadAnsiMultiSzEx(RootKey, Key, Name, Result, False) then - // always returns a newly allocated PAnsiMultiSz - Result := JclAnsiStrings.MultiSzDup(Def); - except - // always returns a newly allocated PAnsiMultiSz - Result := JclAnsiStrings.MultiSzDup(Def); - end; -end; - -function RegReadWideMultiSzEx(const RootKey: DelphiHKEY; const Key, Name: string; Value: TWideStrings; - RaiseException: Boolean): Boolean; -var - S: WideString; -begin - Result := InternalGetWideString(RootKey, Key, Name, True, S, RaiseException); - if Result then - JclWideStrings.MultiSzToStrings(Value, PWideMultiSz(S)); -end; - -procedure RegReadWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: TWideStrings); -begin - RegReadWideMultiSzEx(RootKey, Key, Name, Value, True); -end; - -procedure RegReadWideMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; Value, Def: TWideStrings); -begin - try - if not RegReadWideMultiSzEx(RootKey, Key, Name, Value, False) then - Value.Assign(Def); - except - Value.Assign(Def); - end; -end; - -function RegReadWideMultiSzEx(const RootKey: DelphiHKEY; const Key, Name: string; - out RetValue: PWideMultiSz; RaiseException: Boolean): Boolean; overload; -var - S: WideString; -begin - RetValue := nil; - Result := InternalGetWideString(RootKey, Key, Name, True, S, RaiseException); - if Result then - // always returns a newly allocated PMultiWideSz - RetValue := JclWideStrings.MultiSzDup(PWideMultiSz(S)); -end; - -function RegReadWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string): PWideMultiSz; -begin - RegReadWideMultiSzEx(RootKey, Key, Name, Result, True); -end; - -function RegReadWideMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: PWideMultiSz): PWideMultiSz; -begin - try - if RegReadWideMultiSzEx(RootKey, Key, Name, Result, False) then - // always returns a newly allocated PWideMultiSz - Result := JclWideStrings.MultiSzDup(Def); - except - // always returns a newly allocated PWideMultiSz - Result := JclWideStrings.MultiSzDup(Def); - end; -end; - -function RegReadBinaryEx(const RootKey: DelphiHKEY; const Key, Name: string; var Value; - const ValueSize: Cardinal; out DataSize: Cardinal; RaiseException: Boolean): Boolean; -var - DataType: DWORD; -begin - Result := InternalGetData(RootKey, Key, Name, cRegBinKinds, ValueSize, DataType, @Value, DataSize, RaiseException); -end; - -function RegReadBinary(const RootKey: DelphiHKEY; const Key, Name: string; var Value; - const ValueSize: Cardinal): Cardinal; -begin - RegReadBinaryEx(RootKey, Key, Name, Value, ValueSize, Result, True); -end; - -function RegReadBinaryDef(const RootKey: DelphiHKEY; const Key, Name: string; - var Value; const ValueSize: Cardinal; const Def: Byte): Cardinal; -begin - try - if not RegReadBinaryEx(RootKey, Key, Name, Value, ValueSize, Result, False) then - begin - FillChar(Value, ValueSize, Def); - Result := ValueSize; - end; - except - FillChar(Value, ValueSize, Def); - Result := ValueSize; - end; -end; - -procedure RegWriteBool(const RootKey: DelphiHKEY; const Key, Name: string; Value: Boolean); -begin - RegWriteCardinal(RootKey, Key, Name, REG_DWORD, Cardinal(Ord(Value))); -end; - -procedure RegWriteBool(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: Boolean); -begin - RegWriteCardinal(RootKey, Key, Name, DataType, Cardinal(Ord(Value))); -end; - -procedure RegWriteInteger(const RootKey: DelphiHKEY; const Key, Name: string; Value: Integer); -begin - RegWriteInteger(RootKey, Key, Name, REG_DWORD, Value); -end; - -procedure RegWriteInteger(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: Integer); -var - Val: Int64; - Size: Integer; -begin - if DataType in [REG_SZ, REG_EXPAND_SZ] then - RegWriteString(RootKey, Key, Name, DataType, Format('%d', [Value])) - else - if DataType in [REG_DWORD, REG_QWORD, REG_BINARY] then - begin - // sign extension - Val := Value; - if DataType = REG_QWORD then - Size := SizeOf(Int64) - else - Size := SizeOf(Value); - InternalSetData(RootKey, Key, Name, DataType, @Val, Size); - end - else - DataError(RootKey, Key, Name); -end; - -procedure RegWriteCardinal(const RootKey: DelphiHKEY; const Key, Name: string; Value: Cardinal); -begin - RegWriteCardinal(RootKey, Key, Name, REG_DWORD, Cardinal(Value)); -end; - -procedure RegWriteCardinal(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: Cardinal); -var - Val: Int64; - Size: Integer; -begin - if DataType in [REG_SZ, REG_EXPAND_SZ] then - RegWriteString(RootKey, Key, Name, DataType, Format('%u', [Value])) - else - if DataType in [REG_DWORD, REG_QWORD, REG_BINARY] then - begin - // no sign extension - Val := Value and $FFFFFFFF; - if DataType = REG_QWORD then - Size := SizeOf(Int64) - else - Size := SizeOf(Value); - InternalSetData(RootKey, Key, Name, DataType, @Val, Size); - end - else - DataError(RootKey, Key, Name); -end; - -procedure RegWriteDWORD(const RootKey: DelphiHKEY; const Key, Name: string; Value: DWORD); -begin - RegWriteCardinal(RootKey, Key, Name, REG_DWORD, Cardinal(Value)); -end; - -procedure RegWriteDWORD(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: DWORD); -begin - RegWriteCardinal(RootKey, Key, Name, DataType, Cardinal(Value)); -end; - -procedure RegWriteInt64(const RootKey: DelphiHKEY; const Key, Name: string; Value: Int64); -begin - RegWriteInt64(RootKey, Key, Name, REG_QWORD, Value); -end; - -procedure RegWriteInt64(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: Int64); -begin - if DataType in [REG_SZ, REG_EXPAND_SZ] then - RegWriteString(RootKey, Key, Name, DataType, Format('%d', [Value])) - else - RegWriteUInt64(RootKey, Key, Name, DataType, UInt64(Value)); -end; - -procedure RegWriteUInt64(const RootKey: DelphiHKEY; const Key, Name: string; Value: UInt64); -begin - RegWriteUInt64(RootKey, Key, Name, REG_QWORD, Value); -end; - -procedure RegWriteUInt64(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: UInt64); -begin - if DataType in [REG_SZ, REG_EXPAND_SZ] then - RegWriteString(RootKey, Key, Name, DataType, Format('%u', [Value])) - else - if DataType in [REG_QWORD, REG_BINARY] then - InternalSetData(RootKey, Key, Name, DataType, @Value, SizeOf(Value)) - else - DataError(RootKey, Key, Name); -end; - -procedure RegWriteSingle(const RootKey: DelphiHKEY; const Key, Name: string; Value: Single); -begin - RegWriteSingle(RootKey, Key, Name, REG_BINARY, Value); -end; - -procedure RegWriteSingle(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: Single); -begin - if DataType in [REG_SZ, REG_EXPAND_SZ] then - RegWriteString(RootKey, Key, Name, DataType, Format('%g', [Value])) - else - if DataType in [REG_BINARY] then - InternalSetData(RootKey, Key, Name, DataType, @Value, SizeOf(Value)) - else - DataError(RootKey, Key, Name); -end; - -procedure RegWriteDouble(const RootKey: DelphiHKEY; const Key, Name: string; Value: Double); -begin - RegWriteDouble(RootKey, Key, Name, REG_BINARY, Value); -end; - -procedure RegWriteDouble(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: Double); -begin - if DataType in [REG_SZ, REG_EXPAND_SZ] then - RegWriteString(RootKey, Key, Name, DataType, Format('%g', [Value])) - else - if DataType in [REG_BINARY] then - InternalSetData(RootKey, Key, Name, DataType, @Value, SizeOf(Value)) - else - DataError(RootKey, Key, Name); -end; - -procedure RegWriteExtended(const RootKey: DelphiHKEY; const Key, Name: string; Value: Extended); -begin - RegWriteExtended(RootKey, Key, Name, REG_BINARY, Value); -end; - -procedure RegWriteExtended(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: Extended); -begin - if DataType in [REG_SZ, REG_EXPAND_SZ] then - RegWriteString(RootKey, Key, Name, DataType, Format('%g', [Value])) - else - if DataType in [REG_BINARY] then - InternalSetData(RootKey, Key, Name, DataType, @Value, SizeOf(Value)) - else - DataError(RootKey, Key, Name); -end; - -procedure RegWriteString(const RootKey: DelphiHKEY; const Key, Name, Value: string); -begin - RegWriteString(RootKey, Key, Name, REG_SZ, Value); -end; - -procedure RegWriteString(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; const Value: string); -begin - if DataType in [REG_BINARY, REG_SZ, REG_EXPAND_SZ] then - {$IFDEF SUPPORTS_UNICODE} - InternalSetWideData(RootKey, Key, Name, DataType, PChar(Value), - (Length(Value) + 1) * SizeOf(Char)) - {$ELSE ~SUPPORTS_UNICODE} - InternalSetAnsiData(RootKey, Key, Name, DataType, PChar(Value), - (Length(Value) + 1) * SizeOf(Char)) - {$ENDIF ~SUPPORTS_UNICODE} - else - DataError(RootKey, Key, Name); -end; - -procedure RegWriteAnsiString(const RootKey: DelphiHKEY; const Key, Name: string; const Value: AnsiString); -begin - RegWriteAnsiString(RootKey, Key, Name, REG_SZ, Value); -end; - -procedure RegWriteAnsiString(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - const Value: AnsiString); -begin - if DataType in [REG_BINARY, REG_SZ, REG_EXPAND_SZ] then - InternalSetAnsiData(RootKey, Key, Name, DataType, PAnsiChar(Value), - (Length(Value) + 1) * SizeOf(AnsiChar)) - else - DataError(RootKey, Key, Name); -end; - -procedure RegWriteWideString(const RootKey: DelphiHKEY; const Key, Name: string; const Value: WideString); -begin - RegWriteWideString(RootKey, Key, Name, REG_SZ, Value); -end; - -procedure RegWriteWideString(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - const Value: WideString); -begin - if DataType in [REG_BINARY, REG_SZ, REG_EXPAND_SZ] then - InternalSetWideData(RootKey, Key, Name, DataType, PWideChar(Value), - (Length(Value) + 1) * SizeOf(WideChar)) - else - DataError(RootKey, Key, Name); -end; - -procedure RegWriteMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: JclStrings.PMultiSz); -begin - RegWriteMultiSz(RootKey, Key, Name, REG_MULTI_SZ, Value); -end; - -procedure RegWriteMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: JclStrings.PMultiSz); -begin - if DataType in [REG_BINARY, REG_MULTI_SZ] then - {$IFDEF SUPPORTS_UNICODE} - InternalSetWideData(RootKey, Key, Name, DataType, Value, - MultiSzLength(Value) * SizeOf(Char)) - {$ELSE ~SUPPORTS_UNICODE} - InternalSetAnsiData(RootKey, Key, Name, DataType, Value, - JclStrings.MultiSzLength(Value) * SizeOf(Char)) - {$ENDIF ~SUPPORTS_UNICODE} - else - DataError(RootKey, Key, Name); -end; - -procedure RegWriteMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; const Value: TStrings); -begin - RegWriteMultiSz(RootKey, Key, Name, REG_MULTI_SZ, Value); -end; - -procedure RegWriteMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - const Value: TStrings); -var - Dest: JclStrings.PMultiSz; -begin - if DataType in [REG_BINARY, REG_MULTI_SZ] then - begin - Dest := nil; - JclStrings.StringsToMultiSz(Dest, Value); - try - RegWriteMultiSz(RootKey, Key, Name, DataType, Dest); - finally - JclStrings.FreeMultiSz(Dest); - end; - end - else - DataError(RootKey, Key, Name); -end; - -procedure RegWriteAnsiMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: PAnsiMultiSz); -begin - RegWriteAnsiMultiSz(RootKey, Key, Name, REG_MULTI_SZ, Value); -end; - -procedure RegWriteAnsiMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - Value: PAnsiMultiSz); -begin - if DataType in [REG_BINARY, REG_MULTI_SZ] then - InternalSetAnsiData(RootKey, Key, Name, DataType, Value, - JclAnsiStrings.MultiSzLength(Value) * SizeOf(AnsiChar)) - else - DataError(RootKey, Key, Name); -end; - -procedure RegWriteAnsiMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; const Value: TAnsiStrings); -begin - RegWriteAnsiMultiSz(RootKey, Key, Name, REG_MULTI_SZ, Value); -end; - -procedure RegWriteAnsiMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - const Value: TAnsiStrings); -var - Dest: PAnsiMultiSz; -begin - if DataType in [REG_BINARY, REG_MULTI_SZ] then - begin - Dest := nil; - JclAnsiStrings.StringsToMultiSz(Dest, Value); - try - RegWriteAnsiMultiSz(RootKey, Key, Name, DataType, Dest); - finally - JclAnsiStrings.FreeMultiSz(Dest); - end; - end - else - DataError(RootKey, Key, Name); -end; - -procedure RegWriteWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: PWideMultiSz); -begin - RegWriteWideMultiSz(RootKey, Key, Name, REG_MULTI_SZ, Value); -end; - -procedure RegWriteWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - Value: PWideMultiSz); -begin - if DataType in [REG_BINARY, REG_MULTI_SZ] then - InternalSetWideData(RootKey, Key, Name, DataType, Value, - JclWideStrings.MultiSzLength(Value) * SizeOf(WideChar)) - else - DataError(RootKey, Key, Name); -end; - -procedure RegWriteWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; const Value: TWideStrings); -begin - RegWriteWideMultiSz(RootKey, Key, Name, REG_MULTI_SZ, Value); -end; - -procedure RegWriteWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; - const Value: TWideStrings); -var - Dest: PWideMultiSz; -begin - if DataType in [REG_BINARY, REG_MULTI_SZ] then - begin - Dest := nil; - JclWideStrings.StringsToMultiSz(Dest, Value); - try - RegWriteWideMultiSz(RootKey, Key, Name, DataType, Dest); - finally - JclWideStrings.FreeMultiSz(Dest); - end; - end - else - DataError(RootKey, Key, Name); -end; - -procedure RegWriteBinary(const RootKey: DelphiHKEY; const Key, Name: string; const Value; const ValueSize: Cardinal); -begin - InternalSetData(RootKey, Key, Name, REG_BINARY, @Value, ValueSize); -end; - -function UnregisterAutoExec(ExecKind: TExecKind; const Name: string): Boolean; -var - Key: HKEY; - RegPath: string; -begin - Result := GetKeyAndPath(ExecKind, Key, RegPath); - if Result then - Result := RegDeleteEntry(Key, RegPath, Name); -end; - -function RegisterAutoExec(ExecKind: TExecKind; const Name, Cmdline: string): Boolean; -var - Key: HKEY; - RegPath: string; -begin - Result := GetKeyAndPath(ExecKind, Key, RegPath); - if Result then - RegWriteString(Key, RegPath, Name, Cmdline); -end; - -function RegGetValueNames(const RootKey: DelphiHKEY; const Key: string; const List: TStrings): Boolean; -var - RegKey: HKEY; - I: DWORD; - Size: DWORD; - NumSubKeys: DWORD; - NumSubValues: DWORD; - MaxSubValueLen: DWORD; - ValueName: string; -begin - Result := False; - List.BeginUpdate; - try - List.Clear; - RegKey := 0; - if InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS then - begin - if RegQueryInfoKey(RegKey, nil, nil, nil, @NumSubKeys, nil, nil, - @NumSubValues, @MaxSubValueLen, nil, nil, nil) = ERROR_SUCCESS then - begin - SetLength(ValueName, MaxSubValueLen + 1); - if NumSubValues <> 0 then - for I := 0 to NumSubValues - 1 do - begin - Size := MaxSubValueLen + 1; - RegEnumValue(RegKey, I, PChar(ValueName), Size, nil, nil, nil, nil); - List.Add(PChar(ValueName)); - end; - Result := True; - end; - RegCloseKey(RegKey); - end - else - ReadError(RootKey, Key); - finally - List.EndUpdate; - end; -end; - -function RegGetKeyNames(const RootKey: DelphiHKEY; const Key: string; const List: TStrings): Boolean; -var - RegKey: HKEY; - I: DWORD; - Size: DWORD; - NumSubKeys: DWORD; - MaxSubKeyLen: DWORD; - KeyName: string; -begin - Result := False; - List.BeginUpdate; - try - List.Clear; - RegKey := 0; - if InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS then - begin - if RegQueryInfoKey(RegKey, nil, nil, nil, - @NumSubKeys, @MaxSubKeyLen, nil, nil, nil, nil, nil, nil) = ERROR_SUCCESS then - begin - SetLength(KeyName, MaxSubKeyLen+1); - if NumSubKeys <> 0 then - for I := 0 to NumSubKeys-1 do - begin - Size := MaxSubKeyLen+1; - RegEnumKeyEx(RegKey, I, PChar(KeyName), Size, nil, nil, nil, nil); - List.Add(PChar(KeyName)); - end; - Result := True; - end; - RegCloseKey(RegKey); - end - else - ReadError(RootKey, Key); - finally - List.EndUpdate; - end; -end; - -function RegGetValueNamesAndValues(const RootKey: HKEY; const Key: string; const List: TStrings): Boolean; -var - I: Integer; - TempList: TStringList; - Name: string; - DataType: DWORD; -begin - List.BeginUpdate; - TempList := TStringList.Create; - try - List.Clear; - Result := RegKeyExists(RootKey, Key) and RegGetValueNames(RootKey, Key, TempList); - if Result then - begin - for I := 0 to TempList.Count - 1 do - begin - Name := TempList[I]; - if RegGetDataType(RootKey, Key, Name, DataType) and - ((DataType = REG_SZ) or (DataType = REG_EXPAND_SZ) or (DataType = REG_BINARY)) then - List.Values[Name] := RegReadStringDef(RootKey, Key, Name, ''); - end; - end; - finally - List.EndUpdate; - TempList.Free; - end; -end; - -function RegHasSubKeys(const RootKey: DelphiHKEY; const Key: string): Boolean; -var - RegKey: HKEY; - NumSubKeys: Integer; -begin - Result := False; - RegKey := 0; - if InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS then - begin - RegQueryInfoKey(RegKey, nil, nil, nil, @NumSubKeys, nil, nil, nil, nil, nil, nil, nil); - Result := NumSubKeys <> 0; - RegCloseKey(RegKey); - end - else - ReadError(RootKey, Key); -end; - -function RegKeyExists(const RootKey: DelphiHKEY; const Key: string): Boolean; -var - RegKey: HKEY; -begin - RegKey := 0; - Result := (InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS); - if Result then - RegCloseKey(RegKey); -end; - -function RegValueExists(const RootKey: DelphiHKEY; const Key, Name: string): Boolean; -var - RegKey: HKEY; -begin - RegKey := 0; - Result := (InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS); - if Result then - begin - Result := RegQueryValueEx(RegKey, PChar(Name), nil, nil, nil, nil) = ERROR_SUCCESS; - RegCloseKey(RegKey); - end; -end; - -function RegSaveList(const RootKey: DelphiHKEY; const Key: string; - const ListName: string; const Items: TStrings): Boolean; -var - I: Integer; - SubKey: string; -begin - Result := False; - SubKey := Key + RegKeyDelimiter + ListName; - if RegCreateKey(RootKey, SubKey) = ERROR_SUCCESS then - begin - // Save Number of strings - RegWriteInteger(RootKey, SubKey, cItems, Items.Count); - for I := 1 to Items.Count do - RegWriteString(RootKey, SubKey, IntToStr(I), Items[I-1]); - Result := True; - end; -end; - -function RegLoadList(const RootKey: DelphiHKEY; const Key: string; - const ListName: string; const SaveTo: TStrings): Boolean; -var - I, N: Integer; - SubKey: string; -begin - SaveTo.BeginUpdate; - try - SaveTo.Clear; - SubKey := Key + RegKeyDelimiter + ListName; - N := RegReadIntegerDef(RootKey, SubKey, cItems, -1); - for I := 1 to N do - SaveTo.Add(RegReadString(RootKey, SubKey, IntToStr(I))); - Result := N > 0; - finally - SaveTo.EndUpdate; - end; -end; - -function RegDelList(const RootKey: DelphiHKEY; const Key: string; const ListName: string): Boolean; -var - I, N: Integer; - SubKey: string; -begin - Result := False; - SubKey := Key + RegKeyDelimiter + ListName; - N := RegReadIntegerDef(RootKey, SubKey, cItems, -1); - if (N > 0) and RegDeleteEntry(RootKey, SubKey, cItems) then - for I := 1 to N do - begin - Result := RegDeleteEntry(RootKey, SubKey, IntToStr(I)); - if not Result then - Break; - end; -end; - -function AllowRegKeyForEveryone(const RootKey: DelphiHKEY; Path: string): Boolean; -var - WidePath: PWideChar; - Len: Integer; - -// This is an ugly kludge until the x64 compiler allows 64bit constants in case statements -// http://qc.embarcadero.com/wc/qcmain.aspx?d=95499 -const - HKLM2 = Cardinal(HKLM); - HKCU2 = Cardinal(HKCU); - HKCR2 = Cardinal(HKCR); - HKUS2 = Cardinal(HKUS); - -begin - Result := Win32Platform <> VER_PLATFORM_WIN32_NT; - if not Result then // Win 2000/XP - begin - case Cardinal(RootKey) of - HKLM2: - Path := HKLMLongName + RegKeyDelimiter + RelativeKey(RootKey, PChar(Path)); - HKCU2: - Path := HKCULongName + RegKeyDelimiter + RelativeKey(RootKey, PChar(Path)); - HKCR2: - Path := HKCRLongName + RegKeyDelimiter + RelativeKey(RootKey, PChar(Path)); - HKUS2: - Path := HKUSLongName + RegKeyDelimiter + RelativeKey(RootKey, PChar(Path)); - end; - Len := (Length(Path) + 1) * SizeOf(WideChar); - GetMem(WidePath, Len); - MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PAnsiChar(AnsiString(Path)), -1, WidePath, Len); - Result := RtdlSetNamedSecurityInfoW(WidePath, SE_REGISTRY_KEY, - DACL_SECURITY_INFORMATION, nil, nil, nil, nil) = ERROR_SUCCESS; - FreeMem(WidePath); - end; -end; - -function RegAutoExecEnabled(const ExecKind: TExecKind; const Name: string; out CmdLine: string): Boolean; -var - Key: HKEY; - RegPath: string; -begin - CmdLine := ''; - - Result := GetKeyAndPath(ExecKind, Key, RegPath); - if Result then - begin - try - CmdLine := RegReadString(Key, RegPath, Name); - except - Result := False; - CmdLine := ''; - end; - end - else - CmdLine := ''; -end; - -{$IFDEF UNITVERSIONING} -initialization - RegisterUnitVersion(HInstance, UnitVersioning); - -finalization - UnregisterUnitVersion(HInstance); -{$ENDIF UNITVERSIONING} - -end. - +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclRegistry.pas. } +{ } +{ The Initial Developers of the Original Code are John C Molyneux, Marcel van Brakel and } +{ Charlie Calvert. Portions created by these individuals are Copyright (C) of these individuals. } +{ All Rights Reserved. } +{ } +{ Contributors: } +{ Marcel van Brakel } +{ Stephane Fillon } +{ Eric S.Fisher } +{ Peter Friese } +{ Andreas Hausladen (ahuser) } +{ Manlio Laschena (manlio) } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Olivier Sannier (obones) } +{ Petr Vones (pvones) } +{ kogerbnz } +{ } +{**************************************************************************************************} +{ } +{ Contains various utility routines to read and write registry values. Using these routines } +{ prevents you from having to instantiate temporary TRegistry objects and since the routines } +{ directly call the registry API they do not suffer from the resource overhead as TRegistry does. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclRegistry; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Windows, Classes, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclStrings; + +type + DelphiHKEY = {$IFDEF CPUX64}type Winapi.Windows.HKEY{$ELSE}Longword{$ENDIF CPUX64}; + {$HPPEMIT '// BCB users must typecast the HKEY values to DelphiHKEY or use the HK-values below.'} + + TExecKind = (ekMachineRun, ekMachineRunOnce, ekUserRun, ekUserRunOnce, + ekServiceRun, ekServiceRunOnce); + + EJclRegistryError = class(EJclError); + +{$IFDEF FPC} +const + HKCR = DelphiHKEY($80000000); + HKCU = DelphiHKEY($80000001); + HKLM = DelphiHKEY($80000002); + HKUS = DelphiHKEY($80000003); + HKPD = DelphiHKEY($80000004); + HKCC = DelphiHKEY($80000005); + HKDD = DelphiHKEY($80000006); +{$ELSE ~FPC} +const + HKCR = DelphiHKEY(HKEY_CLASSES_ROOT); + HKCU = DelphiHKEY(HKEY_CURRENT_USER); + HKLM = DelphiHKEY(HKEY_LOCAL_MACHINE); + HKUS = DelphiHKEY(HKEY_USERS); + HKPD = DelphiHKEY(HKEY_PERFORMANCE_DATA); + HKCC = DelphiHKEY(HKEY_CURRENT_CONFIG); + HKDD = DelphiHKEY(HKEY_DYN_DATA); +{$IFDEF CPU64} +{$NODEFINE DelphiHKEY} +{$NODEFINE HKCR} +{$NODEFINE HKCU} +{$NODEFINE HKLM} +{$NODEFINE HKUS} +{$NODEFINE HKPD} +{$NODEFINE HKCC} +{$NODEFINE HKDD} +{$HPPEMIT 'typedef HKEY DelphiHKEY;'} +{$HPPEMIT 'static const DelphiHKEY HKCR = HKEY_CLASSES_ROOT;'} +{$HPPEMIT 'static const DelphiHKEY HKCU = HKEY_CURRENT_USER;'} +{$HPPEMIT 'static const DelphiHKEY HKLM = HKEY_LOCAL_MACHINE;'} +{$HPPEMIT 'static const DelphiHKEY HKUS = HKEY_USERS;'} +{$HPPEMIT 'static const DelphiHKEY HKPD = HKEY_PERFORMANCE_DATA;'} +{$HPPEMIT 'static const DelphiHKEY HKCC = HKEY_CURRENT_CONFIG;'} +{$HPPEMIT 'static const DelphiHKEY HKDD = HKEY_DYN_DATA;'} +{$ENDIF CPU64} +{$ENDIF FPC} + +function RootKeyName(const RootKey: THandle): string; +function RootKeyValue(const Name: string): THandle; + +const + RegKeyDelimiter = '\'; + +function RegCreateKey(const RootKey: DelphiHKEY; const Key: string): Longint; overload; +function RegCreateKey(const RootKey: DelphiHKEY; const Key, Value: string): Longint; overload; +function RegDeleteEntry(const RootKey: DelphiHKEY; const Key, Name: string): Boolean; +function RegDeleteKeyTree(const RootKey: DelphiHKEY; const Key: string): Boolean; + +function RegGetDataSize(const RootKey: DelphiHKEY; const Key, Name: string; + out DataSize: Cardinal): Boolean; +function RegGetDataType(const RootKey: DelphiHKEY; const Key, Name: string; + out DataType: Cardinal): Boolean; +function RegReadBool(const RootKey: DelphiHKEY; const Key, Name: string): Boolean; +function RegReadBoolDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Boolean): Boolean; +function RegReadIntegerEx(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: Integer; RaiseException: Boolean = False): Boolean; +function RegReadInteger(const RootKey: DelphiHKEY; const Key, Name: string): Integer; +function RegReadIntegerDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Integer): Integer; +function RegReadCardinalEx(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: Cardinal; RaiseException: Boolean = False): Boolean; +function RegReadCardinal(const RootKey: DelphiHKEY; const Key, Name: string): Cardinal; +function RegReadCardinalDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Cardinal): Cardinal; +function RegReadDWORDEx(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: DWORD; RaiseException: Boolean = False): Boolean; +function RegReadDWORD(const RootKey: DelphiHKEY; const Key, Name: string): DWORD; +function RegReadDWORDDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: DWORD): DWORD; +function RegReadInt64Ex(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: Int64; RaiseException: Boolean = False): Boolean; +function RegReadInt64(const RootKey: DelphiHKEY; const Key, Name: string): Int64; +function RegReadInt64Def(const RootKey: DelphiHKEY; const Key, Name: string; Def: Int64): Int64; +function RegReadUInt64Ex(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: UInt64; RaiseException: Boolean = False): Boolean; +function RegReadUInt64(const RootKey: DelphiHKEY; const Key, Name: string): UInt64; +function RegReadUInt64Def(const RootKey: DelphiHKEY; const Key, Name: string; Def: UInt64): UInt64; +function RegReadSingleEx(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: Single; RaiseException: Boolean = False): Boolean; +function RegReadSingle(const RootKey: DelphiHKEY; const Key, Name: string): Single; +function RegReadSingleDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Single): Single; +function RegReadDoubleEx(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: Double; RaiseException: Boolean = False): Boolean; +function RegReadDouble(const RootKey: DelphiHKEY; const Key, Name: string): Double; +function RegReadDoubleDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Double): Double; +function RegReadExtendedEx(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: Extended; RaiseException: Boolean = False): Boolean; +function RegReadExtended(const RootKey: DelphiHKEY; const Key, Name: string): Extended; +function RegReadExtendedDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Extended): Extended; + +function RegReadStringEx(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: string; RaiseException: Boolean = False): Boolean; +function RegReadString(const RootKey: DelphiHKEY; const Key, Name: string): string; +function RegReadStringDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: string): string; +function RegReadAnsiStringEx(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: AnsiString; RaiseException: Boolean = False): Boolean; +function RegReadAnsiString(const RootKey: DelphiHKEY; const Key, Name: string): AnsiString; +function RegReadAnsiStringDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: AnsiString): AnsiString; +function RegReadWideStringEx(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: WideString; RaiseException: Boolean = False): Boolean; +function RegReadWideString(const RootKey: DelphiHKEY; const Key, Name: string): WideString; +function RegReadWideStringDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: WideString): WideString; + +function RegReadMultiSzEx(const RootKey: DelphiHKEY; const Key, Name: string; Value: TStrings; + RaiseException: Boolean = False): Boolean; overload; +function RegReadMultiSzEx(const RootKey: DelphiHKEY; const Key, Name: string; out RetValue: PMultiSz; + RaiseException: Boolean = False): Boolean; overload; +procedure RegReadMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: TStrings); overload; +function RegReadMultiSz(const RootKey: DelphiHKEY; const Key, Name: string): PMultiSz; overload; +procedure RegReadMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; Value, Def: TStrings); overload; +function RegReadMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: PMultiSz): PMultiSz; overload; + +function RegReadAnsiMultiSzEx(const RootKey: DelphiHKEY; const Key, Name: string; Value: TAnsiStrings; + RaiseException: Boolean = False): Boolean; overload; +function RegReadAnsiMultiSzEx(const RootKey: DelphiHKEY; const Key, Name: string; out RetValue: PAnsiMultiSz; + RaiseException: Boolean = False): Boolean; overload; +procedure RegReadAnsiMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: TAnsiStrings); overload; +function RegReadAnsiMultiSz(const RootKey: DelphiHKEY; const Key, Name: string): PAnsiMultiSz; overload; +procedure RegReadAnsiMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; + Value, Def: TAnsiStrings); overload; +function RegReadAnsiMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; + Def: PAnsiMultiSz): PAnsiMultiSz; overload; + +function RegReadWideMultiSzEx(const RootKey: DelphiHKEY; const Key, Name: string; Value: TWideStrings; + RaiseException: Boolean = False): Boolean; overload; +function RegReadWideMultiSzEx(const RootKey: DelphiHKEY; const Key, Name: string; out RetValue: PWideMultiSz; + RaiseException: Boolean = False): Boolean; overload; +procedure RegReadWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: TWideStrings); overload; +function RegReadWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string): PWideMultiSz; overload; +procedure RegReadWideMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; + Value, Def: TWideStrings); overload; +function RegReadWideMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; + Def: PWideMultiSz): PWideMultiSz; overload; + +function RegReadBinaryEx(const RootKey: DelphiHKEY; const Key, Name: string; var Value; const ValueSize: Cardinal; + out DataSize: Cardinal; RaiseException: Boolean = False): Boolean; +function RegReadBinary(const RootKey: DelphiHKEY; const Key, Name: string; + var Value; const ValueSize: Cardinal): Cardinal; +function RegReadBinaryDef(const RootKey: DelphiHKEY; const Key, Name: string; + var Value; const ValueSize: Cardinal; const Def: Byte): Cardinal; + +procedure RegWriteBool(const RootKey: DelphiHKEY; const Key, Name: string; Value: Boolean); overload; +procedure RegWriteBool(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + Value: Boolean); overload; +procedure RegWriteInteger(const RootKey: DelphiHKEY; const Key, Name: string; Value: Integer); overload; +procedure RegWriteInteger(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + Value: Integer); overload; +procedure RegWriteCardinal(const RootKey: DelphiHKEY; const Key, Name: string; Value: Cardinal); overload; +procedure RegWriteCardinal(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + Value: Cardinal); overload; +procedure RegWriteDWORD(const RootKey: DelphiHKEY; const Key, Name: string; Value: DWORD); overload; +procedure RegWriteDWORD(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + Value: DWORD); overload; +procedure RegWriteInt64(const RootKey: DelphiHKEY; const Key, Name: string; Value: Int64); overload; +procedure RegWriteInt64(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + Value: Int64); overload; +procedure RegWriteUInt64(const RootKey: DelphiHKEY; const Key, Name: string; Value: UInt64); overload; +procedure RegWriteUInt64(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + Value: UInt64); overload; +procedure RegWriteSingle(const RootKey: DelphiHKEY; const Key, Name: string; Value: Single); overload; +procedure RegWriteSingle(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + Value: Single); overload; +procedure RegWriteDouble(const RootKey: DelphiHKEY; const Key, Name: string; Value: Double); overload; +procedure RegWriteDouble(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + Value: Double); overload; +procedure RegWriteExtended(const RootKey: DelphiHKEY; const Key, Name: string; Value: Extended); overload; +procedure RegWriteExtended(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + Value: Extended); overload; + +procedure RegWriteString(const RootKey: DelphiHKEY; const Key, Name, Value: string); overload; +procedure RegWriteString(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + const Value: string); overload; +procedure RegWriteAnsiString(const RootKey: DelphiHKEY; const Key, Name: string; const Value: AnsiString); overload; +procedure RegWriteAnsiString(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + const Value: AnsiString); overload; +procedure RegWriteWideString(const RootKey: DelphiHKEY; const Key, Name: string; const Value: WideString); overload; +procedure RegWriteWideString(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + const Value: WideString); overload; + +procedure RegWriteMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: PMultiSz); overload; +procedure RegWriteMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; const Value: TStrings); overload; +procedure RegWriteMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + Value: PMultiSz); overload; +procedure RegWriteMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + const Value: TStrings); overload; + +procedure RegWriteAnsiMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: PAnsiMultiSz); overload; +procedure RegWriteAnsiMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; + const Value: TAnsiStrings); overload; +procedure RegWriteAnsiMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + Value: PAnsiMultiSz); overload; +procedure RegWriteAnsiMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + const Value: TAnsiStrings); overload; + +procedure RegWriteWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: PWideMultiSz); overload; +procedure RegWriteWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; + const Value: TWideStrings); overload; +procedure RegWriteWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + Value: PWideMultiSz); overload; +procedure RegWriteWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + const Value: TWideStrings); overload; + +procedure RegWriteBinary(const RootKey: DelphiHKEY; const Key, Name: string; const Value; const ValueSize: Cardinal); + +function RegGetValueNames(const RootKey: DelphiHKEY; const Key: string; const List: TStrings): Boolean; +function RegGetKeyNames(const RootKey: DelphiHKEY; const Key: string; const List: TStrings): Boolean; +function RegGetValueNamesAndValues(const RootKey: HKEY; const Key: string; const List: TStrings): Boolean; +function RegHasSubKeys(const RootKey: DelphiHKEY; const Key: string): Boolean; + +function AllowRegKeyForEveryone(const RootKey: DelphiHKEY; Path: string): Boolean; + +function RegAutoExecEnabled(const ExecKind: TExecKind; const Name: string; out CmdLine: string): Boolean; + +{ +From: Jean-Fabien Connault [cycocrew att worldnet dott fr] +Descr: Test whether a registry key exists as a subkey of RootKey +Used test cases: +procedure TForm1.Button1Click(Sender: TObject); +var + RegKey: HKEY; +begin + if RegOpenKeyEx(HKEY_CURRENT_USER, 'Software', 0, KEY_READ, RegKey) = ERROR_SUCCESS then + begin + Assert(not RegKeyExists(RegKey, 'Microsoft\_Windows')); + RegCloseKey(RegKey); + end; + if RegOpenKeyEx(HKEY_CURRENT_USER, 'Software', 0, KEY_READ, RegKey) = ERROR_SUCCESS then + begin + Assert(RegKeyExists(RegKey, 'Microsoft\Windows'));; + RegCloseKey(RegKey); + end; + Assert(RegKeyExists(HKEY_CURRENT_USER, '')); + Assert(RegKeyExists(HKEY_CURRENT_USER, 'Software')); + Assert(RegKeyExists(HKEY_CURRENT_USER, 'Software\Microsoft')); + Assert(RegKeyExists(HKEY_CURRENT_USER, 'Software\Microsoft\Windows')); + Assert(RegKeyExists(HKEY_CURRENT_USER, '\Software\Microsoft\Windows')); + Assert(not RegKeyExists(HKEY_CURRENT_USER, '\Software\Microsoft2\Windows')); +end; +} +function RegKeyExists(const RootKey: DelphiHKEY; const Key: string): Boolean; +function RegValueExists(const RootKey: DelphiHKEY; const Key, Name: string): Boolean; + +function UnregisterAutoExec(ExecKind: TExecKind; const Name: string): Boolean; +function RegisterAutoExec(ExecKind: TExecKind; const Name, Cmdline: string): Boolean; + +function RegSaveList(const RootKey: DelphiHKEY; const Key: string; const ListName: string; + const Items: TStrings): Boolean; +function RegLoadList(const RootKey: DelphiHKEY; const Key: string; const ListName: string; + const SaveTo: TStrings): Boolean; +function RegDelList(const RootKey: DelphiHKEY; const Key: string; const ListName: string): Boolean; + +const + HKCRLongName = 'HKEY_CLASSES_ROOT'; + HKCULongName = 'HKEY_CURRENT_USER'; + HKLMLongName = 'HKEY_LOCAL_MACHINE'; + HKUSLongName = 'HKEY_USERS'; + HKPDLongName = 'HKEY_PERFORMANCE_DATA'; + HKCCLongName = 'HKEY_CURRENT_CONFIG'; + HKDDLongName = 'HKEY_DYN_DATA'; + HKCRShortName = 'HKCR'; + HKCUShortName = 'HKCU'; + HKLMShortName = 'HKLM'; + HKUSShortName = 'HKUS'; + HKPDShortName = 'HKPD'; + HKCCShortName = 'HKCC'; + HKDDShortName = 'HKDD'; + +type + TRootKey = record + Key: DelphiHKEY; + AnsiName: AnsiString; + WideName: TUTF16String; + end; + +const + RootKeys: array [0..13] of TRootKey = + ( + (Key: HKCR; AnsiName: HKCRLongName; WideName: HKCRLongName), + (Key: HKCU; AnsiName: HKCULongName; WideName: HKCULongName), + (Key: HKLM; AnsiName: HKLMLongName; WideName: HKLMLongName), + (Key: HKUS; AnsiName: HKUSLongName; WideName: HKUSLongName), + (Key: HKPD; AnsiName: HKPDLongName; WideName: HKPDLongName), + (Key: HKCC; AnsiName: HKCCLongName; WideName: HKCCLongName), + (Key: HKDD; AnsiName: HKDDLongName; WideName: HKDDLongName), + (Key: HKCR; AnsiName: HKCRShortName; WideName: HKCRShortName), + (Key: HKCU; AnsiName: HKCUShortName; WideName: HKCUShortName), + (Key: HKLM; AnsiName: HKLMShortName; WideName: HKLMShortName), + (Key: HKUS; AnsiName: HKUSShortName; WideName: HKUSShortName), + (Key: HKPD; AnsiName: HKPDShortName; WideName: HKPDShortName), + (Key: HKCC; AnsiName: HKCCShortName; WideName: HKCCShortName), + (Key: HKDD; AnsiName: HKDDShortName; WideName: HKDDShortName) + ); + +type + { clRegWOW64Access allows the user to switch all registry functions to the 64 bit registry + key on a 64bit system. + + OS/Application 32bit/32bit 64bit/32bit 64bit/64bit + raDefault Software Wow6432Node Software + raNative Software Software Software + ra32Key Software Wow6432Node Wow6432Node + ra64Key Software Software Software + } + TJclRegWOW64Access = (raDefault, raNative, ra32Key, ra64Key); + +// cannot access variable JclRegWOW64Access from outside package +// so these helper functions can be used. +function RegGetWOW64AccessMode: TJclRegWOW64Access; +procedure RegSetWOW64AccessMode(Access: TJclRegWOW64Access); + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, + Winapi.AccCtrl, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, + AccCtrl, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF FPC} +// JwaAccCtrl, + {$ELSE ~FPC} + JclSysUtils, + {$ENDIF ~FPC} + JclResources, JclWin32, JclSysInfo, + JclAnsiStrings, JclWideStrings; + +type + TRegKind = REG_NONE..REG_QWORD; + TRegKinds = set of TRegKind; + +const + cItems = 'Items'; + cRegBinKinds = [REG_SZ..REG_QWORD]; // all types + +var + CachedIsWindows64: Integer = -1; + +threadvar + JclRegWOW64Access: TJclRegWOW64Access {= raDefault}; + +function RegGetWOW64AccessMode: TJclRegWOW64Access; +begin + Result := JclRegWOW64Access; +end; + +procedure RegSetWOW64AccessMode(Access: TJclRegWOW64Access); +begin + JclRegWOW64Access := Access; +end; + +//=== Internal helper routines =============================================== + +function GetWOW64AccessMode(samDesired: REGSAM): REGSAM; +const + KEY_WOW64_32KEY = $0200; + KEY_WOW64_64KEY = $0100; + KEY_WOW64_RES = $0300; + RegWOW64Accesses: array[Boolean, TJclRegWOW64Access] of HKEY = ( + (HKEY(0), HKEY(0), HKEY(0), HKEY(0)), + (HKEY(0), KEY_WOW64_64KEY, KEY_WOW64_32KEY, KEY_WOW64_64KEY) + ); +begin + Result := samDesired; + if (Win32Platform = VER_PLATFORM_WIN32_NT) and (samDesired and KEY_WOW64_RES = 0) then + begin + if CachedIsWindows64 = -1 then + if IsWindows64 then + CachedIsWindows64 := 1 + else + CachedIsWindows64 := 0; + + Result := Result or RegWOW64Accesses[CachedIsWindows64 = 1, JclRegWOW64Access]; + end; +end; + +function RootKeyName(const RootKey: THandle): string; +begin + case RootKey of + {$IFDEF DELPHI64_TEMPORARY} + Integer(HKCR) : Result := HKCRLongName; + Integer(HKCU) : Result := HKCULongName; + Integer(HKLM) : Result := HKLMLongName; + Integer(HKUS) : Result := HKUSLongName; + Integer(HKPD) : Result := HKPDLongName; + Integer(HKCC) : Result := HKCCLongName; + Integer(HKDD) : Result := HKDDLongName; + {$ELSE ~DELPHI64_TEMPORARY} + HKCR : Result := HKCRLongName; + HKCU : Result := HKCULongName; + HKLM : Result := HKLMLongName; + HKUS : Result := HKUSLongName; + HKPD : Result := HKPDLongName; + HKCC : Result := HKCCLongName; + HKDD : Result := HKDDLongName; + {$ENDIF ~DELPHI64_TEMPORARY} + else + Result := Format(HexFmt, [RootKey]); + end; +end; + +function RootKeyValue(const Name: string): THandle; +var + Index: Integer; +begin + for Index := Low(RootKeys) to High(RootKeys) do + if string(RootKeys[Index].AnsiName) = Name then + begin + Result := RootKeys[Index].Key; + Exit; + end; + raise EJclRegistryError.CreateResFmt(@RsInconsistentPath, [Name]); +end; + +procedure ReadError(const RootKey: THandle; const Key: string); +begin + raise EJclRegistryError.CreateResFmt(@RsUnableToOpenKeyRead, [RootKeyName(RootKey), Key]); +end; + +procedure WriteError(const RootKey: THandle; const Key: string); +begin + raise EJclRegistryError.CreateResFmt(@RsUnableToOpenKeyWrite, [RootKeyName(RootKey), Key]); +end; + +procedure ValueError(const RootKey: THandle; const Key, Name: string); +begin + raise EJclRegistryError.CreateResFmt(@RsUnableToAccessValue, [RootKeyName(RootKey), Key, Name]); +end; + +procedure DataError(const RootKey: THandle; const Key, Name: string); +begin + raise EJclRegistryError.CreateResFmt(@RsWrongDataType, [RootKeyName(RootKey), Key, Name]); +end; + +function GetKeyAndPath(ExecKind: TExecKind; out Key: HKEY; out RegPath: string): Boolean; +begin + Result := False; + if (ExecKind in [ekServiceRun, ekServiceRunOnce]) and (Win32Platform = VER_PLATFORM_WIN32_NT) then + Exit; + if ExecKind in [ekMachineRun, ekMachineRunOnce, ekServiceRun, ekServiceRunOnce] then + Key := HKEY_LOCAL_MACHINE + else + Key := HKEY_CURRENT_USER; + RegPath := 'Software\Microsoft\Windows\CurrentVersion\'; + case ExecKind of + ekMachineRun, ekUserRun: + RegPath := RegPath + 'Run'; + ekMachineRunOnce, ekUserRunOnce: + RegPath := RegPath + 'RunOnce'; + ekServiceRun: + RegPath := RegPath + 'RunServices'; + ekServiceRunOnce: + RegPath := RegPath + 'RunServicesOnce'; + end; + Result := True; +end; + +function RelativeKey(const RootKey: DelphiHKEY; Key: PAnsiChar): PAnsiChar; overload; +var + I: Integer; +begin + Result := Key; + if Result^ = RegKeyDelimiter then + Inc(Result); + for I := Low(RootKeys) to High(RootKeys) do + if StrPosA(Key, PAnsiChar(RootKeys[I].AnsiName + RegKeyDelimiter)) = Result then + begin + if RootKey <> RootKeys[I].Key then + raise EJclRegistryError.CreateResFmt(@RsInconsistentPath, [Key]) + else + Inc(Result, Length(RootKeys[I].AnsiName)); + Break; + end; +end; + +function RelativeKey(const RootKey: DelphiHKEY; Key: PWideChar): PWideChar; overload; +var + I: Integer; +begin + Result := Key; + if Result^ = RegKeyDelimiter then + Inc(Result); + for I := Low(RootKeys) to High(RootKeys) do + if StrPosW(Key, PWideChar(RootKeys[I].WideName + RegKeyDelimiter)) = Result then + begin + if RootKey <> RootKeys[I].Key then + raise EJclRegistryError.CreateResFmt(@RsInconsistentPath, [Key]) + else + Inc(Result, Length(RootKeys[I].WideName)); + Break; + end; +end; + +function InternalRegOpenKeyEx(Key: HKEY; SubKey: PWideChar; + ulOptions: DWORD; samDesired: REGSAM; var RegKey: HKEY): Longint; overload; +var + RelKey: AnsiString; +begin + if Win32Platform = VER_PLATFORM_WIN32_NT then + Result := RegOpenKeyExW(Key, RelativeKey(Key, SubKey), ulOptions, GetWOW64AccessMode(samDesired), RegKey) + else + begin + RelKey := AnsiString(WideString(RelativeKey(Key, SubKey))); + Result := RegOpenKeyExA(Key, PAnsiChar(RelKey), ulOptions, samDesired, RegKey); + end; +end; + +function InternalRegOpenKeyEx(Key: HKEY; SubKey: PAnsiChar; + ulOptions: DWORD; samDesired: REGSAM; var RegKey: HKEY): Longint; overload; +begin + if Win32Platform = VER_PLATFORM_WIN32_NT then + Result := RegOpenKeyExA(Key, RelativeKey(Key, SubKey), ulOptions, GetWOW64AccessMode(samDesired), RegKey) + else + Result := RegOpenKeyExA(Key, RelativeKey(Key, SubKey), ulOptions, samDesired, RegKey); +end; + +function InternalRegQueryValueEx(Key: HKEY; ValueName: PWideChar; + lpReserved: Pointer; lpType: PDWORD; lpData: Pointer; lpcbData: PDWORD): Longint; +var + ValName: AnsiString; +begin + if Win32Platform = VER_PLATFORM_WIN32_NT then + Result := RegQueryValueExW(Key, ValueName, lpReserved, lpType, lpData, lpcbData) + else + begin + ValName := AnsiString(WideString(ValueName)); + Result := RegQueryValueExA(Key, PAnsiChar(ValName), lpReserved, lpType, lpData, lpcbData); + end; +end; + +function InternalRegSetValueEx(Key: HKEY; ValueName: PWideChar; + Reserved: DWORD; dwType: DWORD; lpData: Pointer; cbData: DWORD): Longint; stdcall; +var + ValName: AnsiString; +begin + if Win32Platform = VER_PLATFORM_WIN32_NT then + Result := RegSetValueExW(Key, ValueName, Reserved, dwType, lpData, cbData) + else + begin + ValName := AnsiString(WideString(ValueName)); + Result := RegSetValueExA(Key, PAnsiChar(ValName), Reserved, dwType, lpData, cbData); + end; +end; + +function InternalGetData(const RootKey: DelphiHKEY; const Key, Name: TUTF16String; + RegKinds: TRegKinds; ExpectedSize: DWORD; + out DataType: DWORD; Data: Pointer; out DataSize: DWORD; RaiseException: Boolean): Boolean; +var + RegKey: HKEY; +begin + Result := True; + DataType := REG_NONE; + DataSize := 0; + RegKey := 0; + if InternalRegOpenKeyEx(RootKey, PWideChar(Key), 0, KEY_READ, RegKey) = ERROR_SUCCESS then + try + if InternalRegQueryValueEx(RegKey, PWideChar(Name), nil, @DataType, nil, @DataSize) = ERROR_SUCCESS then + begin + if not (DataType in RegKinds) or (DataSize > ExpectedSize) then + if RaiseException then + DataError(RootKey, Key, Name) + else + Result := False; + if InternalRegQueryValueEx(RegKey, PWideChar(Name), nil, nil, Data, @DataSize) <> ERROR_SUCCESS then + if RaiseException then + ValueError(RootKey, Key, Name) + else + Result := False; + end + else + if RaiseException then + ValueError(RootKey, Key, Name) + else + Result := False; + finally + RegCloseKey(RegKey); + end + else + if RaiseException then + ReadError(RootKey, Key) + else + Result := False; +end; + +function InternalGetAnsiString(const RootKey: DelphiHKEY; const Key, Name: WideString; MultiFlag: Boolean; + out RetValue: AnsiString; RaiseException: Boolean): Boolean; +var + RegKey: HKEY; + DataType, DataSize: DWORD; + TmpRet: WideString; + DataLength: Integer; + RegKinds: TRegKinds; +begin + Result := True; + DataType := REG_NONE; + DataSize := 0; + RetValue := ''; + RegKey := 0; + if InternalRegOpenKeyEx(RootKey, PWideChar(Key), 0, KEY_READ, RegKey) = ERROR_SUCCESS then + try + if InternalRegQueryValueEx(RegKey, PWideChar(Name), nil, @DataType, nil, @DataSize) = ERROR_SUCCESS then + begin + if MultiFlag then + RegKinds := [REG_BINARY, REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ] + else + RegKinds := [REG_BINARY, REG_SZ, REG_EXPAND_SZ]; + if DataType in RegKinds then + begin + if Win32Platform = VER_PLATFORM_WIN32_NT then + begin + DataLength := DataSize div SizeOf(WideChar); + SetLength(TmpRet, DataLength); + Result := InternalRegQueryValueEx(RegKey, PWideChar(Name), nil, nil, PWideChar(TmpRet), @DataSize) = ERROR_SUCCESS; + if Result then + RetValue := AnsiString(Copy(TmpRet, 1, DataLength - 1)); + end + else + begin + DataLength := DataSize div SizeOf(AnsiChar); + SetLength(RetValue, DataLength); + Result := InternalRegQueryValueEx(RegKey, PWideChar(Name), nil, nil, PAnsiChar(RetValue), @DataSize) = ERROR_SUCCESS; + if Result then + SetLength(RetValue, DataLength - 1); + end; + if not Result then + begin + RetValue := ''; + if RaiseException then + ValueError(RootKey, Key, Name) + else + Result := False; + end; + end + else + begin + RetValue := ''; + if RaiseException then + DataError(RootKey, Key, Name) + else + Result := False; + end; + end + else + if RaiseException then + ValueError(RootKey, Key, Name) + else + Result := False; + finally + RegCloseKey(RegKey); + end + else + if RaiseException then + ReadError(RootKey, Key) + else + Result := False; +end; + +function InternalGetWideString(const RootKey: DelphiHKEY; const Key, Name: WideString; MultiFlag: Boolean; + out RetValue: WideString; RaiseException: Boolean): Boolean; +var + RegKey: HKEY; + DataType, DataSize: DWORD; + RegKinds: TRegKinds; + DataLength: Integer; +begin + Result := True; + DataType := REG_NONE; + DataSize := 0; + RetValue := ''; + RegKey := 0; + if InternalRegOpenKeyEx(RootKey, PWideChar(Key), 0, KEY_READ, RegKey) = ERROR_SUCCESS then + try + if InternalRegQueryValueEx(RegKey, PWideChar(Name), nil, @DataType, nil, @DataSize) = ERROR_SUCCESS then + begin + if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then + RegKinds := [REG_BINARY] + else + if MultiFlag then + RegKinds := [REG_BINARY, REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ] + else + RegKinds := [REG_BINARY, REG_SZ, REG_EXPAND_SZ]; + if DataType in RegKinds then + begin + DataLength := DataSize div SizeOf(WideChar); + SetLength(RetValue, DataLength); + if InternalRegQueryValueEx(RegKey, PWideChar(Name), nil, nil, PWideChar(RetValue), @DataSize) = ERROR_SUCCESS then + SetLength(RetValue, DataLength - 1) + else + begin + RetValue := ''; + if RaiseException then + ValueError(RootKey, Key, Name) + else + Result := False; + end; + end + else + begin + RetValue := ''; + if RaiseException then + DataError(RootKey, Key, Name) + else + Result := False; + end; + end + else + if RaiseException then + ValueError(RootKey, Key, Name) + else + Result := False; + finally + RegCloseKey(RegKey); + end + else + if RaiseException then + ReadError(RootKey, Key) + else + Result := False; +end; + +function InternalStrToFloat(const RootKey: DelphiHKEY; const Key, Name: string; out Success: Boolean; + RaiseException: Boolean): Extended; +var + {$IFDEF RTL150_UP} + FS: TFormatSettings; + {$ELSE ~RTL150_UP} + OldSep: Char; + {$ENDIF ~RTL150_UP} +begin + {$IFDEF RTL150_UP} + FS.ThousandSeparator := ','; + FS.DecimalSeparator := '.'; + {$ELSE ~RTL150_UP} + OldSep := DecimalSeparator; + try + DecimalSeparator := '.'; + {$ENDIF ~RTL150_UP} + if RaiseException then + begin + Result := StrToFloat(RegReadString(RootKey, Key, Name){$IFDEF RTL150_UP}, FS{$ENDIF}); + Success := True; + end + else + Success := TryStrToFloat(RegReadString(RootKey, Key, Name), Result{$IFDEF RTL150_UP}, FS{$ENDIF}); + {$IFNDEF RTL150_UP} + finally + DecimalSeparator := OldSep; + end; + {$ENDIF ~RTL150_UP} +end; + +procedure InternalSetData(const RootKey: DelphiHKEY; const Key, Name: WideString; + RegKind: TRegKind; Value: Pointer; ValueSize: Cardinal); +var + RegKey: HKEY; +begin + if not RegKeyExists(RootKey, Key) then + RegCreateKey(RootKey, Key); + RegKey := 0; + if InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PWideChar(Key)), 0, KEY_WRITE, RegKey) = ERROR_SUCCESS then + try + if InternalRegSetValueEx(RegKey, PWideChar(Name), 0, RegKind, Value, ValueSize) <> ERROR_SUCCESS then + WriteError(RootKey, Key); + finally + RegCloseKey(RegKey); + end + else + WriteError(RootKey, Key); +end; + +procedure InternalSetAnsiData(const RootKey: DelphiHKEY; const Key, Name: WideString; + RegKind: TRegKind; Value: Pointer; ValueSize: Cardinal); +var + Source: AnsiString; + Dest: WideString; +begin + if Win32Platform = VER_PLATFORM_WIN32_NT then + begin + // destination must be wide data + SetLength(Source, ValueSize div SizeOf(AnsiChar)); + Move(Value^,Source[1],ValueSize * SizeOf(AnsiChar)); + Dest := WideString(Source); + InternalSetData(RootKey, Key, Name, RegKind, PWideChar(Dest), SizeOf(WideChar) * ValueSize); + end + else + InternalSetData(RootKey, Key, Name, RegKind, Value, ValueSize); +end; + +procedure InternalSetWideData(const RootKey: DelphiHKEY; const Key, Name: string; + RegKind: TRegKind; Value: Pointer; ValueSize: Cardinal); +begin + if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and (RegKind in [REG_SZ, REG_MULTI_SZ, REG_EXPAND_SZ]) then + RegKind := REG_BINARY; + InternalSetData(RootKey, Key, Name, RegKind, Value, ValueSize); +end; + +//=== Registry =============================================================== + +function RegCreateKey(const RootKey: DelphiHKEY; const Key: string): Longint; +var + RegKey: HKEY; +begin + RegKey := 0; + Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.RegCreateKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, nil, 0, + GetWOW64AccessMode(KEY_ALL_ACCESS), nil, RegKey, nil); + if Result = ERROR_SUCCESS then + RegCloseKey(RegKey); +end; + +function RegCreateKey(const RootKey: DelphiHKEY; const Key, Value: string): Longint; +begin + Result := RegSetValue(RootKey, RelativeKey(RootKey, PChar(Key)), REG_SZ, PChar(Value), Length(Value)); +end; + +function RegDeleteEntry(const RootKey: DelphiHKEY; const Key, Name: string): Boolean; +var + RegKey: HKEY; +begin + Result := False; + RegKey := 0; + if InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_SET_VALUE, RegKey) = ERROR_SUCCESS then + begin + Result := RegDeleteValue(RegKey, PChar(Name)) = ERROR_SUCCESS; + RegCloseKey(RegKey); + if not Result then + ValueError(RootKey, Key, Name); + end + else + WriteError(RootKey, Key); +end; + +function RegDeleteKeyTree(const RootKey: DelphiHKEY; const Key: string): Boolean; +var + RegKey: HKEY; + I: DWORD; + Size: DWORD; + NumSubKeys: DWORD; + MaxSubKeyLen: DWORD; + KeyName: string; +begin + RegKey := 0; + Result := InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_ALL_ACCESS, RegKey) = ERROR_SUCCESS; + if Result then + begin + RegQueryInfoKey(RegKey, nil, nil, nil, @NumSubKeys, @MaxSubKeyLen, nil, nil, nil, nil, nil, nil); + if NumSubKeys <> 0 then + for I := NumSubKeys - 1 downto 0 do + begin + Size := MaxSubKeyLen+1; + SetLength(KeyName, Size); + RegEnumKeyEx(RegKey, I, PChar(KeyName), Size, nil, nil, nil, nil); + SetLength(KeyName, StrLen(PChar(KeyName))); + Result := RegDeleteKeyTree(RootKey, Key + RegKeyDelimiter + KeyName); + if not Result then + Break; + end; + RegCloseKey(RegKey); + if Result then + Result := {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.RegDeleteKey(RootKey, RelativeKey(RootKey, PChar(Key))) = ERROR_SUCCESS; + end + else + WriteError(RootKey, Key); +end; + +function RegGetDataSize(const RootKey: DelphiHKEY; const Key, Name: string; + out DataSize: Cardinal): Boolean; +var + RegKey: HKEY; +begin + DataSize := 0; + RegKey := 0; + Result := InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS; + if Result then + begin + Result := RegQueryValueEx(RegKey, PChar(Name), nil, nil, nil, @DataSize) = ERROR_SUCCESS; + RegCloseKey(RegKey); + end; +end; + +function RegGetDataType(const RootKey: DelphiHKEY; const Key, Name: string; + out DataType: DWORD): Boolean; +var + RegKey: HKEY; +begin + DataType := REG_NONE; + RegKey := 0; + Result := InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS; + if Result then + begin + Result := RegQueryValueEx(RegKey, PChar(Name), nil, @DataType, nil, nil) = ERROR_SUCCESS; + RegCloseKey(RegKey); + end; +end; + +function RegReadBool(const RootKey: DelphiHKEY; const Key, Name: string): Boolean; +begin + Result := RegReadInteger(RootKey, Key, Name) <> 0; +end; + +function RegReadBoolDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Boolean): Boolean; +begin + Result := RegReadIntegerDef(RootKey, Key, Name, Ord(Def)) <> 0; +end; + +function RegReadIntegerEx(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: Integer; RaiseException: Boolean): Boolean; +var + DataType, DataSize: DWORD; + Ret: Int64; +begin + Ret := 0; + RegGetDataType(RootKey, Key, Name, DataType); + if DataType in [REG_SZ, REG_EXPAND_SZ] then + if RaiseException then + begin + Ret := StrToInt64(RegReadString(RootKey, Key, Name)); + Result := True; + end + else + Result := TryStrToInt64(RegReadString(RootKey, Key, Name), Ret) + else + Result := InternalGetData(RootKey, Key, Name, [REG_BINARY, REG_DWORD, REG_QWORD], + SizeOf(Ret), DataType, @Ret, DataSize, RaiseException); + RetValue := Integer(Ret and $FFFFFFFF); +end; + +function RegReadInteger(const RootKey: DelphiHKEY; const Key, Name: string): Integer; +begin + RegReadIntegerEx(RootKey, Key, Name, Result, True); +end; + +function RegReadIntegerDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Integer): Integer; +begin + try + if not RegReadIntegerEx(RootKey, Key, Name, Result, False) then + Result := Def; + except + Result := Def; + end; +end; + +function RegReadCardinalEx(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: Cardinal; RaiseException: Boolean): Boolean; +var + DataType, DataSize: DWORD; + Ret: Int64; +begin + Ret := 0; + RegGetDataType(RootKey, Key, Name, DataType); + if DataType in [REG_SZ, REG_EXPAND_SZ] then + if RaiseException then + begin + Ret := StrToInt64(RegReadString(RootKey, Key, Name)); + Result := True; + end + else + Result := TryStrToInt64(RegReadString(RootKey, Key, Name), Ret) + else + Result := InternalGetData(RootKey, Key, Name, [REG_BINARY, REG_DWORD, REG_QWORD], + SizeOf(Ret), DataType, @Ret, DataSize, RaiseException); + RetValue := Cardinal(Ret) and $FFFFFFFF; +end; + +function RegReadCardinal(const RootKey: DelphiHKEY; const Key, Name: string): Cardinal; +begin + RegReadCardinalEx(RootKey, Key, Name, Result, True); +end; + +function RegReadCardinalDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Cardinal): Cardinal; +begin + try + if not RegReadCardinalEx(RootKey, Key, Name, Result, False) then + Result := Def; + except + Result := Def; + end; +end; + +function RegReadDWORDEx(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: DWORD; RaiseException: Boolean): Boolean; +begin + Result := RegReadCardinalEx(RootKey, Key, Name, RetValue, RaiseException); +end; + +function RegReadDWORD(const RootKey: DelphiHKEY; const Key, Name: string): DWORD; +begin + Result := RegReadCardinal(RootKey, Key, Name); +end; + +function RegReadDWORDDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: DWORD): DWORD; +begin + Result := RegReadCardinalDef(RootKey, Key, Name, Def); +end; + +function RegReadInt64Ex(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: Int64; RaiseException: Boolean): Boolean; +var + DataType, DataSize: DWORD; + Data: array [0..1] of Integer; + Ret: Int64; +begin + RegGetDataType(RootKey, Key, Name, DataType); + if DataType in [REG_SZ, REG_EXPAND_SZ] then + begin + // (rom) circumvents internal compiler error for D6 + if RaiseException then + begin + Ret := StrToInt64(RegReadString(RootKey, Key, Name)); + Result := True; + end + else + Result := TryStrToInt64(RegReadString(RootKey, Key, Name), Ret); + RetValue := Ret; + end + else + begin + Data[0] := 0; + Data[1] := 0; + Result := InternalGetData(RootKey, Key, Name, [REG_BINARY, REG_DWORD, REG_QWORD], + SizeOf(Data), DataType, @Data, DataSize, RaiseException); + // REG_BINARY is implicitly unsigned if DataSize < 8 + if DataType = REG_DWORD then + // DWORDs get sign extended + RetValue := Data[0] + else + Move(Data[0], RetValue, SizeOf(Data)); + end; +end; + +function RegReadInt64(const RootKey: DelphiHKEY; const Key, Name: string): Int64; +begin + RegReadInt64Ex(RootKey, Key, Name, Result, True); +end; + +function RegReadInt64Def(const RootKey: DelphiHKEY; const Key, Name: string; Def: Int64): Int64; +begin + try + if not RegReadInt64Ex(RootKey, Key, Name, Result, False) then + Result := Def; + except + Result := Def; + end; +end; + +function RegReadUInt64Ex(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: UInt64; RaiseException: Boolean): Boolean; +var + DataType, DataSize: DWORD; + Ret: Int64; +begin + RegGetDataType(RootKey, Key, Name, DataType); + if DataType in [REG_SZ, REG_EXPAND_SZ] then + begin + // (rom) circumvents internal compiler error for D6 + if RaiseException then + begin + Ret := StrToInt64(RegReadString(RootKey, Key, Name)); + Result := True; + end + else + Result := TryStrToInt64(RegReadString(RootKey, Key, Name), Ret); + RetValue := UInt64(Ret); + end + else + begin + // type cast required to circumvent internal error in D7 + RetValue := UInt64(0); + Result := InternalGetData(RootKey, Key, Name, [REG_BINARY, REG_DWORD, REG_QWORD], + SizeOf(RetValue), DataType, @RetValue, DataSize, RaiseException); + end; +end; + +function RegReadUInt64(const RootKey: DelphiHKEY; const Key, Name: string): UInt64; +begin + RegReadUInt64Ex(RootKey, Key, Name, Result, True); +end; + +function RegReadUInt64Def(const RootKey: DelphiHKEY; const Key, Name: string; Def: UInt64): UInt64; +begin + try + if not RegReadUInt64Ex(RootKey, Key, Name, Result, False) then + Result := Def; + except + Result := Def; + end; +end; + +function RegReadSingleEx(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: Single; RaiseException: Boolean): Boolean; +var + DataType, DataSize: DWORD; +begin + RegGetDataType(RootKey, Key, Name, DataType); + if DataType in [REG_SZ, REG_EXPAND_SZ] then + RetValue := InternalStrToFloat(RootKey, Key, Name, Result, RaiseException) + else + Result := InternalGetData(RootKey, Key, Name, [REG_BINARY], + SizeOf(RetValue), DataType, @RetValue, DataSize, RaiseException); +end; + +function RegReadSingle(const RootKey: DelphiHKEY; const Key, Name: string): Single; +begin + RegReadSingleEx(RootKey, KEy, Name, Result, True); +end; + +function RegReadSingleDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Single): Single; +begin + try + if not RegReadSingleEx(RootKey, KEy, Name, Result, False) then + Result := Def; + except + Result := Def; + end; +end; + +function RegReadDoubleEx(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: Double; RaiseException: Boolean): Boolean; +var + DataType, DataSize: DWORD; +begin + RegGetDataType(RootKey, Key, Name, DataType); + if DataType in [REG_SZ, REG_EXPAND_SZ] then + RetValue := InternalStrToFloat(RootKey, Key, Name, Result, RaiseException) + else + Result := InternalGetData(RootKey, Key, Name, [REG_BINARY], + SizeOf(RetValue), DataType, @RetValue, DataSize, RaiseException); +end; + +function RegReadDouble(const RootKey: DelphiHKEY; const Key, Name: string): Double; +begin + RegReadDoubleEx(RootKey, Key, Name, Result, True); +end; + +function RegReadDoubleDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Double): Double; +begin + try + if not RegReadDoubleEx(RootKey, Key, Name, Result, False) then + Result := Def; + except + Result := Def; + end; +end; + +function RegReadExtendedEx(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: Extended; RaiseException: Boolean): Boolean; +var + DataType, DataSize: DWORD; +begin + RegGetDataType(RootKey, Key, Name, DataType); + if DataType in [REG_SZ, REG_EXPAND_SZ] then + RetValue := InternalStrToFloat(RootKey, Key, Name, Result, RaiseException) + else + Result := InternalGetData(RootKey, Key, Name, [REG_BINARY], + SizeOf(RetValue), DataType, @RetValue, DataSize, RaiseException); +end; + +function RegReadExtended(const RootKey: DelphiHKEY; const Key, Name: string): Extended; +begin + RegReadExtendedEx(RootKey, Key, Name, Result, True); +end; + +function RegReadExtendedDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: Extended): Extended; +begin + try + if not RegReadExtendedEx(RootKey, Key, Name, Result, False) then + Result := Def; + except + Result := Def; + end; +end; + +function RegReadStringEx(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: string; RaiseException: Boolean): Boolean; +{$IFDEF SUPPORTS_UNICODE} +var + TmpRet: WideString; +begin + Result := InternalGetWideString(RootKey, Key, Name, False, TmpRet, RaiseException); + RetValue := string(TmpRet); +end; +{$ELSE ~SUPPORTS_UNICODE} +var + TmpRet: AnsiString; +begin + Result := InternalGetAnsiString(RootKey, Key, Name, False, TmpRet, RaiseException); + RetValue := string(TmpRet); +end; +{$ENDIF ~SUPPORTS_UNICODE} + +function RegReadString(const RootKey: DelphiHKEY; const Key, Name: string): string; +begin + RegReadStringEx(RootKey, Key, Name, Result, True); +end; + +function RegReadStringDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: string): string; +begin + try + if not RegReadStringEx(RootKey, Key, Name, Result, False) then + Result := Def; + except + Result := Def; + end; +end; + +function RegReadAnsiStringEx(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: AnsiString; RaiseException: Boolean): Boolean; +begin + Result := InternalGetAnsiString(RootKey, Key, Name, False, RetValue, RaiseException); +end; + +function RegReadAnsiString(const RootKey: DelphiHKEY; const Key, Name: string): AnsiString; +begin + RegReadAnsiStringEx(RootKey, Key, Name, Result, True); +end; + +function RegReadAnsiStringDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: AnsiString): AnsiString; +begin + try + if not RegReadAnsiStringEx(RootKey, Key, Name, Result, False) then + Result := Def; + except + Result := Def; + end; +end; + +function RegReadWideStringEx(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: WideString; RaiseException: Boolean): Boolean; +begin + Result := InternalGetWideString(RootKey, Key, Name, False, RetValue, RaiseException); +end; + +function RegReadWideString(const RootKey: DelphiHKEY; const Key, Name: string): WideString; +begin + RegReadWideStringEx(RootKey, Key, Name, Result, True); +end; + +function RegReadWideStringDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: WideString): WideString; +begin + try + if not RegReadWideStringEx(RootKey, Key, Name, Result, False) then + Result := Def; + except + Result := Def; + end; +end; + +function RegReadMultiSzEx(const RootKey: DelphiHKEY; const Key, Name: string; Value: TStrings; + RaiseException: Boolean): Boolean; +{$IFDEF SUPPORTS_UNICODE} +var + S: WideString; +begin + Result := InternalGetWideString(RootKey, Key, Name, True, S, RaiseException); + if Result then + WideMultiSzToWideStrings(Value, PWideMultiSz(PChar(S))); +end; +{$ELSE ~SUPPORTS_UNICODE} +var + S: AnsiString; +begin + Result := InternalGetAnsiString(RootKey, Key, Name, True, S, RaiseException); + if Result then + JclStrings.MultiSzToStrings(Value, PAnsiMultiSz(PChar(S))); +end; +{$ENDIF ~SUPPORTS_UNICODE} + +procedure RegReadMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: TStrings); +begin + RegReadMultiSzEx(RootKey, Key, Name, Value, True); +end; + +procedure RegReadMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; Value, Def: TStrings); +begin + try + if not RegReadMultiSzEx(RootKey, Key, Name, Value, False) then + Value.Assign(Def); + except + Value.Assign(Def); + end; +end; + +function RegReadMultiSzEx(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: PMultiSz; RaiseException: Boolean): Boolean; +{$IFDEF SUPPORTS_UNICODE} +var + S: WideString; +begin + Result := InternalGetWideString(RootKey, Key, Name, True, S, RaiseException); + if Result then + // always returns a newly allocated PMultiSz + RetValue := WideMultiSzDup(PWideMultiSz(S)) + else + RetValue := nil; +end; +{$ELSE ~SUPPORTS_UNICODE} +var + S: AnsiString; +begin + Result := InternalGetAnsiString(RootKey, Key, Name, True, S, RaiseException); + if Result then + // always returns a newly allocated PMultiSz + RetValue := JclAnsiStrings.MultiSzDup(PAnsiMultiSz(S)) + else + RetValue := nil; +end; +{$ENDIF ~SUPPORTS_UNICODE} + +function RegReadMultiSz(const RootKey: DelphiHKEY; const Key, Name: string): JclStrings.PMultiSz; +begin + RegReadMultiSzEx(RootKey, Key, Name, Result, True); +end; + +function RegReadMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: JclStrings.PMultiSz): JclStrings.PMultiSz; +begin + try + if not RegReadMultiSzEx(RootKey, Key, Name, Result, False) then + // always returns a newly allocated PMultiSz + Result := JclStrings.MultiSzDup(Def); + except + // always returns a newly allocated PMultiSz + Result := JclStrings.MultiSzDup(Def); + end; +end; + +function RegReadAnsiMultiSzEx(const RootKey: DelphiHKEY; const Key, Name: string; Value: TAnsiStrings; + RaiseException: Boolean): Boolean; +var + S: AnsiString; +begin + Result := InternalGetAnsiString(RootKey, Key, Name, True, S, RaiseException); + if Result then + JclAnsiStrings.MultiSzToStrings(Value, PAnsiMultiSz(S)); +end; + +procedure RegReadAnsiMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: TAnsiStrings); +begin + RegReadAnsiMultiSzEx(RootKey, Key, Name, Value, True); +end; + +procedure RegReadAnsiMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; Value, Def: TAnsiStrings); +begin + try + if not RegReadAnsiMultiSzEx(RootKey, Key, Name, Value, False) then + Value.Assign(Def); + except + Value.Assign(Def); + end; +end; + +function RegReadAnsiMultiSzEx(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: PAnsiMultiSz; RaiseException: Boolean): Boolean; overload; +var + S: AnsiString; +begin + RetValue := nil; + Result := InternalGetAnsiString(RootKey, Key, Name, True, S, RaiseException); + if Result then + // always returns a newly allocated PMultiAnsiSz + RetValue := JclAnsiStrings.MultiSzDup(PAnsiMultiSz(S)); +end; + +function RegReadAnsiMultiSz(const RootKey: DelphiHKEY; const Key, Name: string): PAnsiMultiSz; +begin + RegReadAnsiMultiSzEx(RootKey, Key, Name, Result, True); +end; + +function RegReadAnsiMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: PAnsiMultiSz): PAnsiMultiSz; +begin + try + if RegReadAnsiMultiSzEx(RootKey, Key, Name, Result, False) then + // always returns a newly allocated PAnsiMultiSz + Result := JclAnsiStrings.MultiSzDup(Def); + except + // always returns a newly allocated PAnsiMultiSz + Result := JclAnsiStrings.MultiSzDup(Def); + end; +end; + +function RegReadWideMultiSzEx(const RootKey: DelphiHKEY; const Key, Name: string; Value: TWideStrings; + RaiseException: Boolean): Boolean; +var + S: WideString; +begin + Result := InternalGetWideString(RootKey, Key, Name, True, S, RaiseException); + if Result then + JclWideStrings.MultiSzToStrings(Value, PWideMultiSz(S)); +end; + +procedure RegReadWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: TWideStrings); +begin + RegReadWideMultiSzEx(RootKey, Key, Name, Value, True); +end; + +procedure RegReadWideMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; Value, Def: TWideStrings); +begin + try + if not RegReadWideMultiSzEx(RootKey, Key, Name, Value, False) then + Value.Assign(Def); + except + Value.Assign(Def); + end; +end; + +function RegReadWideMultiSzEx(const RootKey: DelphiHKEY; const Key, Name: string; + out RetValue: PWideMultiSz; RaiseException: Boolean): Boolean; overload; +var + S: WideString; +begin + RetValue := nil; + Result := InternalGetWideString(RootKey, Key, Name, True, S, RaiseException); + if Result then + // always returns a newly allocated PMultiWideSz + RetValue := JclWideStrings.MultiSzDup(PWideMultiSz(S)); +end; + +function RegReadWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string): PWideMultiSz; +begin + RegReadWideMultiSzEx(RootKey, Key, Name, Result, True); +end; + +function RegReadWideMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: PWideMultiSz): PWideMultiSz; +begin + try + if RegReadWideMultiSzEx(RootKey, Key, Name, Result, False) then + // always returns a newly allocated PWideMultiSz + Result := JclWideStrings.MultiSzDup(Def); + except + // always returns a newly allocated PWideMultiSz + Result := JclWideStrings.MultiSzDup(Def); + end; +end; + +function RegReadBinaryEx(const RootKey: DelphiHKEY; const Key, Name: string; var Value; + const ValueSize: Cardinal; out DataSize: Cardinal; RaiseException: Boolean): Boolean; +var + DataType: DWORD; +begin + Result := InternalGetData(RootKey, Key, Name, cRegBinKinds, ValueSize, DataType, @Value, DataSize, RaiseException); +end; + +function RegReadBinary(const RootKey: DelphiHKEY; const Key, Name: string; var Value; + const ValueSize: Cardinal): Cardinal; +begin + RegReadBinaryEx(RootKey, Key, Name, Value, ValueSize, Result, True); +end; + +function RegReadBinaryDef(const RootKey: DelphiHKEY; const Key, Name: string; + var Value; const ValueSize: Cardinal; const Def: Byte): Cardinal; +begin + try + if not RegReadBinaryEx(RootKey, Key, Name, Value, ValueSize, Result, False) then + begin + FillChar(Value, ValueSize, Def); + Result := ValueSize; + end; + except + FillChar(Value, ValueSize, Def); + Result := ValueSize; + end; +end; + +procedure RegWriteBool(const RootKey: DelphiHKEY; const Key, Name: string; Value: Boolean); +begin + RegWriteCardinal(RootKey, Key, Name, REG_DWORD, Cardinal(Ord(Value))); +end; + +procedure RegWriteBool(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: Boolean); +begin + RegWriteCardinal(RootKey, Key, Name, DataType, Cardinal(Ord(Value))); +end; + +procedure RegWriteInteger(const RootKey: DelphiHKEY; const Key, Name: string; Value: Integer); +begin + RegWriteInteger(RootKey, Key, Name, REG_DWORD, Value); +end; + +procedure RegWriteInteger(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: Integer); +var + Val: Int64; + Size: Integer; +begin + if DataType in [REG_SZ, REG_EXPAND_SZ] then + RegWriteString(RootKey, Key, Name, DataType, Format('%d', [Value])) + else + if DataType in [REG_DWORD, REG_QWORD, REG_BINARY] then + begin + // sign extension + Val := Value; + if DataType = REG_QWORD then + Size := SizeOf(Int64) + else + Size := SizeOf(Value); + InternalSetData(RootKey, Key, Name, DataType, @Val, Size); + end + else + DataError(RootKey, Key, Name); +end; + +procedure RegWriteCardinal(const RootKey: DelphiHKEY; const Key, Name: string; Value: Cardinal); +begin + RegWriteCardinal(RootKey, Key, Name, REG_DWORD, Cardinal(Value)); +end; + +procedure RegWriteCardinal(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: Cardinal); +var + Val: Int64; + Size: Integer; +begin + if DataType in [REG_SZ, REG_EXPAND_SZ] then + RegWriteString(RootKey, Key, Name, DataType, Format('%u', [Value])) + else + if DataType in [REG_DWORD, REG_QWORD, REG_BINARY] then + begin + // no sign extension + Val := Value and $FFFFFFFF; + if DataType = REG_QWORD then + Size := SizeOf(Int64) + else + Size := SizeOf(Value); + InternalSetData(RootKey, Key, Name, DataType, @Val, Size); + end + else + DataError(RootKey, Key, Name); +end; + +procedure RegWriteDWORD(const RootKey: DelphiHKEY; const Key, Name: string; Value: DWORD); +begin + RegWriteCardinal(RootKey, Key, Name, REG_DWORD, Cardinal(Value)); +end; + +procedure RegWriteDWORD(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: DWORD); +begin + RegWriteCardinal(RootKey, Key, Name, DataType, Cardinal(Value)); +end; + +procedure RegWriteInt64(const RootKey: DelphiHKEY; const Key, Name: string; Value: Int64); +begin + RegWriteInt64(RootKey, Key, Name, REG_QWORD, Value); +end; + +procedure RegWriteInt64(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: Int64); +begin + if DataType in [REG_SZ, REG_EXPAND_SZ] then + RegWriteString(RootKey, Key, Name, DataType, Format('%d', [Value])) + else + RegWriteUInt64(RootKey, Key, Name, DataType, UInt64(Value)); +end; + +procedure RegWriteUInt64(const RootKey: DelphiHKEY; const Key, Name: string; Value: UInt64); +begin + RegWriteUInt64(RootKey, Key, Name, REG_QWORD, Value); +end; + +procedure RegWriteUInt64(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: UInt64); +begin + if DataType in [REG_SZ, REG_EXPAND_SZ] then + RegWriteString(RootKey, Key, Name, DataType, Format('%u', [Value])) + else + if DataType in [REG_QWORD, REG_BINARY] then + InternalSetData(RootKey, Key, Name, DataType, @Value, SizeOf(Value)) + else + DataError(RootKey, Key, Name); +end; + +procedure RegWriteSingle(const RootKey: DelphiHKEY; const Key, Name: string; Value: Single); +begin + RegWriteSingle(RootKey, Key, Name, REG_BINARY, Value); +end; + +procedure RegWriteSingle(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: Single); +begin + if DataType in [REG_SZ, REG_EXPAND_SZ] then + RegWriteString(RootKey, Key, Name, DataType, Format('%g', [Value])) + else + if DataType in [REG_BINARY] then + InternalSetData(RootKey, Key, Name, DataType, @Value, SizeOf(Value)) + else + DataError(RootKey, Key, Name); +end; + +procedure RegWriteDouble(const RootKey: DelphiHKEY; const Key, Name: string; Value: Double); +begin + RegWriteDouble(RootKey, Key, Name, REG_BINARY, Value); +end; + +procedure RegWriteDouble(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: Double); +begin + if DataType in [REG_SZ, REG_EXPAND_SZ] then + RegWriteString(RootKey, Key, Name, DataType, Format('%g', [Value])) + else + if DataType in [REG_BINARY] then + InternalSetData(RootKey, Key, Name, DataType, @Value, SizeOf(Value)) + else + DataError(RootKey, Key, Name); +end; + +procedure RegWriteExtended(const RootKey: DelphiHKEY; const Key, Name: string; Value: Extended); +begin + RegWriteExtended(RootKey, Key, Name, REG_BINARY, Value); +end; + +procedure RegWriteExtended(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: Extended); +begin + if DataType in [REG_SZ, REG_EXPAND_SZ] then + RegWriteString(RootKey, Key, Name, DataType, Format('%g', [Value])) + else + if DataType in [REG_BINARY] then + InternalSetData(RootKey, Key, Name, DataType, @Value, SizeOf(Value)) + else + DataError(RootKey, Key, Name); +end; + +procedure RegWriteString(const RootKey: DelphiHKEY; const Key, Name, Value: string); +begin + RegWriteString(RootKey, Key, Name, REG_SZ, Value); +end; + +procedure RegWriteString(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; const Value: string); +begin + if DataType in [REG_BINARY, REG_SZ, REG_EXPAND_SZ] then + {$IFDEF SUPPORTS_UNICODE} + InternalSetWideData(RootKey, Key, Name, DataType, PChar(Value), + (Length(Value) + 1) * SizeOf(Char)) + {$ELSE ~SUPPORTS_UNICODE} + InternalSetAnsiData(RootKey, Key, Name, DataType, PChar(Value), + (Length(Value) + 1) * SizeOf(Char)) + {$ENDIF ~SUPPORTS_UNICODE} + else + DataError(RootKey, Key, Name); +end; + +procedure RegWriteAnsiString(const RootKey: DelphiHKEY; const Key, Name: string; const Value: AnsiString); +begin + RegWriteAnsiString(RootKey, Key, Name, REG_SZ, Value); +end; + +procedure RegWriteAnsiString(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + const Value: AnsiString); +begin + if DataType in [REG_BINARY, REG_SZ, REG_EXPAND_SZ] then + InternalSetAnsiData(RootKey, Key, Name, DataType, PAnsiChar(Value), + (Length(Value) + 1) * SizeOf(AnsiChar)) + else + DataError(RootKey, Key, Name); +end; + +procedure RegWriteWideString(const RootKey: DelphiHKEY; const Key, Name: string; const Value: WideString); +begin + RegWriteWideString(RootKey, Key, Name, REG_SZ, Value); +end; + +procedure RegWriteWideString(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + const Value: WideString); +begin + if DataType in [REG_BINARY, REG_SZ, REG_EXPAND_SZ] then + InternalSetWideData(RootKey, Key, Name, DataType, PWideChar(Value), + (Length(Value) + 1) * SizeOf(WideChar)) + else + DataError(RootKey, Key, Name); +end; + +procedure RegWriteMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: JclStrings.PMultiSz); +begin + RegWriteMultiSz(RootKey, Key, Name, REG_MULTI_SZ, Value); +end; + +procedure RegWriteMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: JclStrings.PMultiSz); +begin + if DataType in [REG_BINARY, REG_MULTI_SZ] then + {$IFDEF SUPPORTS_UNICODE} + InternalSetWideData(RootKey, Key, Name, DataType, Value, + MultiSzLength(Value) * SizeOf(Char)) + {$ELSE ~SUPPORTS_UNICODE} + InternalSetAnsiData(RootKey, Key, Name, DataType, Value, + JclStrings.MultiSzLength(Value) * SizeOf(Char)) + {$ENDIF ~SUPPORTS_UNICODE} + else + DataError(RootKey, Key, Name); +end; + +procedure RegWriteMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; const Value: TStrings); +begin + RegWriteMultiSz(RootKey, Key, Name, REG_MULTI_SZ, Value); +end; + +procedure RegWriteMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + const Value: TStrings); +var + Dest: JclStrings.PMultiSz; +begin + if DataType in [REG_BINARY, REG_MULTI_SZ] then + begin + Dest := nil; + JclStrings.StringsToMultiSz(Dest, Value); + try + RegWriteMultiSz(RootKey, Key, Name, DataType, Dest); + finally + JclStrings.FreeMultiSz(Dest); + end; + end + else + DataError(RootKey, Key, Name); +end; + +procedure RegWriteAnsiMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: PAnsiMultiSz); +begin + RegWriteAnsiMultiSz(RootKey, Key, Name, REG_MULTI_SZ, Value); +end; + +procedure RegWriteAnsiMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + Value: PAnsiMultiSz); +begin + if DataType in [REG_BINARY, REG_MULTI_SZ] then + InternalSetAnsiData(RootKey, Key, Name, DataType, Value, + JclAnsiStrings.MultiSzLength(Value) * SizeOf(AnsiChar)) + else + DataError(RootKey, Key, Name); +end; + +procedure RegWriteAnsiMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; const Value: TAnsiStrings); +begin + RegWriteAnsiMultiSz(RootKey, Key, Name, REG_MULTI_SZ, Value); +end; + +procedure RegWriteAnsiMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + const Value: TAnsiStrings); +var + Dest: PAnsiMultiSz; +begin + if DataType in [REG_BINARY, REG_MULTI_SZ] then + begin + Dest := nil; + JclAnsiStrings.StringsToMultiSz(Dest, Value); + try + RegWriteAnsiMultiSz(RootKey, Key, Name, DataType, Dest); + finally + JclAnsiStrings.FreeMultiSz(Dest); + end; + end + else + DataError(RootKey, Key, Name); +end; + +procedure RegWriteWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: PWideMultiSz); +begin + RegWriteWideMultiSz(RootKey, Key, Name, REG_MULTI_SZ, Value); +end; + +procedure RegWriteWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + Value: PWideMultiSz); +begin + if DataType in [REG_BINARY, REG_MULTI_SZ] then + InternalSetWideData(RootKey, Key, Name, DataType, Value, + JclWideStrings.MultiSzLength(Value) * SizeOf(WideChar)) + else + DataError(RootKey, Key, Name); +end; + +procedure RegWriteWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; const Value: TWideStrings); +begin + RegWriteWideMultiSz(RootKey, Key, Name, REG_MULTI_SZ, Value); +end; + +procedure RegWriteWideMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; + const Value: TWideStrings); +var + Dest: PWideMultiSz; +begin + if DataType in [REG_BINARY, REG_MULTI_SZ] then + begin + Dest := nil; + JclWideStrings.StringsToMultiSz(Dest, Value); + try + RegWriteWideMultiSz(RootKey, Key, Name, DataType, Dest); + finally + JclWideStrings.FreeMultiSz(Dest); + end; + end + else + DataError(RootKey, Key, Name); +end; + +procedure RegWriteBinary(const RootKey: DelphiHKEY; const Key, Name: string; const Value; const ValueSize: Cardinal); +begin + InternalSetData(RootKey, Key, Name, REG_BINARY, @Value, ValueSize); +end; + +function UnregisterAutoExec(ExecKind: TExecKind; const Name: string): Boolean; +var + Key: HKEY; + RegPath: string; +begin + Result := GetKeyAndPath(ExecKind, Key, RegPath); + if Result then + Result := RegDeleteEntry(Key, RegPath, Name); +end; + +function RegisterAutoExec(ExecKind: TExecKind; const Name, Cmdline: string): Boolean; +var + Key: HKEY; + RegPath: string; +begin + Result := GetKeyAndPath(ExecKind, Key, RegPath); + if Result then + RegWriteString(Key, RegPath, Name, Cmdline); +end; + +function RegGetValueNames(const RootKey: DelphiHKEY; const Key: string; const List: TStrings): Boolean; +var + RegKey: HKEY; + I: DWORD; + Size: DWORD; + NumSubKeys: DWORD; + NumSubValues: DWORD; + MaxSubValueLen: DWORD; + ValueName: string; +begin + Result := False; + List.BeginUpdate; + try + List.Clear; + RegKey := 0; + if InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS then + begin + if RegQueryInfoKey(RegKey, nil, nil, nil, @NumSubKeys, nil, nil, + @NumSubValues, @MaxSubValueLen, nil, nil, nil) = ERROR_SUCCESS then + begin + SetLength(ValueName, MaxSubValueLen + 1); + if NumSubValues <> 0 then + for I := 0 to NumSubValues - 1 do + begin + Size := MaxSubValueLen + 1; + RegEnumValue(RegKey, I, PChar(ValueName), Size, nil, nil, nil, nil); + List.Add(PChar(ValueName)); + end; + Result := True; + end; + RegCloseKey(RegKey); + end + else + ReadError(RootKey, Key); + finally + List.EndUpdate; + end; +end; + +function RegGetKeyNames(const RootKey: DelphiHKEY; const Key: string; const List: TStrings): Boolean; +var + RegKey: HKEY; + I: DWORD; + Size: DWORD; + NumSubKeys: DWORD; + MaxSubKeyLen: DWORD; + KeyName: string; +begin + Result := False; + List.BeginUpdate; + try + List.Clear; + RegKey := 0; + if InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS then + begin + if RegQueryInfoKey(RegKey, nil, nil, nil, + @NumSubKeys, @MaxSubKeyLen, nil, nil, nil, nil, nil, nil) = ERROR_SUCCESS then + begin + SetLength(KeyName, MaxSubKeyLen+1); + if NumSubKeys <> 0 then + for I := 0 to NumSubKeys-1 do + begin + Size := MaxSubKeyLen+1; + RegEnumKeyEx(RegKey, I, PChar(KeyName), Size, nil, nil, nil, nil); + List.Add(PChar(KeyName)); + end; + Result := True; + end; + RegCloseKey(RegKey); + end + else + ReadError(RootKey, Key); + finally + List.EndUpdate; + end; +end; + +function RegGetValueNamesAndValues(const RootKey: HKEY; const Key: string; const List: TStrings): Boolean; +var + I: Integer; + TempList: TStringList; + Name: string; + DataType: DWORD; +begin + List.BeginUpdate; + TempList := TStringList.Create; + try + List.Clear; + Result := RegKeyExists(RootKey, Key) and RegGetValueNames(RootKey, Key, TempList); + if Result then + begin + for I := 0 to TempList.Count - 1 do + begin + Name := TempList[I]; + if RegGetDataType(RootKey, Key, Name, DataType) and + ((DataType = REG_SZ) or (DataType = REG_EXPAND_SZ) or (DataType = REG_BINARY)) then + List.Values[Name] := RegReadStringDef(RootKey, Key, Name, ''); + end; + end; + finally + List.EndUpdate; + TempList.Free; + end; +end; + +function RegHasSubKeys(const RootKey: DelphiHKEY; const Key: string): Boolean; +var + RegKey: HKEY; + NumSubKeys: Integer; +begin + Result := False; + RegKey := 0; + if InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS then + begin + RegQueryInfoKey(RegKey, nil, nil, nil, @NumSubKeys, nil, nil, nil, nil, nil, nil, nil); + Result := NumSubKeys <> 0; + RegCloseKey(RegKey); + end + else + ReadError(RootKey, Key); +end; + +function RegKeyExists(const RootKey: DelphiHKEY; const Key: string): Boolean; +var + RegKey: HKEY; +begin + RegKey := 0; + Result := (InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS); + if Result then + RegCloseKey(RegKey); +end; + +function RegValueExists(const RootKey: DelphiHKEY; const Key, Name: string): Boolean; +var + RegKey: HKEY; +begin + RegKey := 0; + Result := (InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS); + if Result then + begin + Result := RegQueryValueEx(RegKey, PChar(Name), nil, nil, nil, nil) = ERROR_SUCCESS; + RegCloseKey(RegKey); + end; +end; + +function RegSaveList(const RootKey: DelphiHKEY; const Key: string; + const ListName: string; const Items: TStrings): Boolean; +var + I: Integer; + SubKey: string; +begin + Result := False; + SubKey := Key + RegKeyDelimiter + ListName; + if RegCreateKey(RootKey, SubKey) = ERROR_SUCCESS then + begin + // Save Number of strings + RegWriteInteger(RootKey, SubKey, cItems, Items.Count); + for I := 1 to Items.Count do + RegWriteString(RootKey, SubKey, IntToStr(I), Items[I-1]); + Result := True; + end; +end; + +function RegLoadList(const RootKey: DelphiHKEY; const Key: string; + const ListName: string; const SaveTo: TStrings): Boolean; +var + I, N: Integer; + SubKey: string; +begin + SaveTo.BeginUpdate; + try + SaveTo.Clear; + SubKey := Key + RegKeyDelimiter + ListName; + N := RegReadIntegerDef(RootKey, SubKey, cItems, -1); + for I := 1 to N do + SaveTo.Add(RegReadString(RootKey, SubKey, IntToStr(I))); + Result := N > 0; + finally + SaveTo.EndUpdate; + end; +end; + +function RegDelList(const RootKey: DelphiHKEY; const Key: string; const ListName: string): Boolean; +var + I, N: Integer; + SubKey: string; +begin + Result := False; + SubKey := Key + RegKeyDelimiter + ListName; + N := RegReadIntegerDef(RootKey, SubKey, cItems, -1); + if (N > 0) and RegDeleteEntry(RootKey, SubKey, cItems) then + for I := 1 to N do + begin + Result := RegDeleteEntry(RootKey, SubKey, IntToStr(I)); + if not Result then + Break; + end; +end; + +function AllowRegKeyForEveryone(const RootKey: DelphiHKEY; Path: string): Boolean; +var + WidePath: PWideChar; + Len: Integer; + +// This is an ugly kludge until the x64 compiler allows 64bit constants in case statements +// http://qc.embarcadero.com/wc/qcmain.aspx?d=95499 +const + HKLM2 = Cardinal(HKLM); + HKCU2 = Cardinal(HKCU); + HKCR2 = Cardinal(HKCR); + HKUS2 = Cardinal(HKUS); + +begin + Result := Win32Platform <> VER_PLATFORM_WIN32_NT; + if not Result then // Win 2000/XP + begin + case Cardinal(RootKey) of + HKLM2: + Path := HKLMLongName + RegKeyDelimiter + RelativeKey(RootKey, PChar(Path)); + HKCU2: + Path := HKCULongName + RegKeyDelimiter + RelativeKey(RootKey, PChar(Path)); + HKCR2: + Path := HKCRLongName + RegKeyDelimiter + RelativeKey(RootKey, PChar(Path)); + HKUS2: + Path := HKUSLongName + RegKeyDelimiter + RelativeKey(RootKey, PChar(Path)); + end; + Len := (Length(Path) + 1) * SizeOf(WideChar); + GetMem(WidePath, Len); + MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PAnsiChar(AnsiString(Path)), -1, WidePath, Len); + Result := RtdlSetNamedSecurityInfoW(WidePath, SE_REGISTRY_KEY, + DACL_SECURITY_INFORMATION, nil, nil, nil, nil) = ERROR_SUCCESS; + FreeMem(WidePath); + end; +end; + +function RegAutoExecEnabled(const ExecKind: TExecKind; const Name: string; out CmdLine: string): Boolean; +var + Key: HKEY; + RegPath: string; +begin + CmdLine := ''; + + Result := GetKeyAndPath(ExecKind, Key, RegPath); + if Result then + begin + try + CmdLine := RegReadString(Key, RegPath, Name); + except + Result := False; + CmdLine := ''; + end; + end + else + CmdLine := ''; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/windows/JclSecurity.pas b/3rdParty/JCL/source/windows/JclSecurity.pas index f1f38294..f3c66f8b 100644 --- a/3rdParty/JCL/source/windows/JclSecurity.pas +++ b/3rdParty/JCL/source/windows/JclSecurity.pas @@ -1,847 +1,847 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is JclSecurity.pas. } -{ } -{ The Initial Developer of the Original Code is Marcel van Brakel. } -{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. All Rights Reserved. } -{ } -{ Contributor(s): } -{ Marcel van Brakel } -{ Peter Friese } -{ Robert Marquardt (marquardt) } -{ John C Molyneux } -{ Robert Rossmair (rrossmair) } -{ Matthias Thoma (mthoma) } -{ Petr Vones (pvones) } -{ Christoph Lindeman } -{ } -{**************************************************************************************************} -{ } -{ Various NT security related routines to perform commen asks such as enabling and disabling } -{ privileges. } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -unit JclSecurity; - -{$I jcl.inc} -{$I windowsonly.inc} - -{$HPPEMIT '#define TTokenInformationClass TOKEN_INFORMATION_CLASS'} - -interface - -uses - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - {$IFDEF HAS_UNITSCOPE} - Winapi.Windows, System.SysUtils, - {$ELSE ~HAS_UNITSCOPE} - Windows, SysUtils, - {$ENDIF ~HAS_UNITSCOPE} - JclBase; - -type - EJclSecurityError = class(EJclError); - -// Access Control -function CreateNullDacl(out Sa: TSecurityAttributes; const Inheritable: Boolean): PSecurityAttributes; -function CreateInheritable(out Sa: TSecurityAttributes): PSecurityAttributes; - -// Privileges -function IsGroupMember(RelativeGroupID: DWORD): Boolean; -function IsAdministrator: Boolean; -function IsUser: Boolean; -function IsGuest: Boolean; -function IsPowerUser: Boolean; -function IsAccountOperator: Boolean; -function IsSystemOperator: Boolean; -function IsPrintOperator: Boolean; -function IsBackupOperator: Boolean; -function IsReplicator: Boolean; -function IsRASServer: Boolean; -function IsPreWin2000CompAccess: Boolean; -function IsRemoteDesktopUser: Boolean; -function IsNetworkConfigurationOperator: Boolean; -function IsIncomingForestTrustBuilder: Boolean; -function IsMonitoringUser: Boolean; -function IsLoggingUser: Boolean; -function IsAuthorizationAccess: Boolean; -function IsTSLicenseServer: Boolean; - -function EnableProcessPrivilege(const Enable: Boolean; const Privilege: string): Boolean; -function EnableThreadPrivilege(const Enable: Boolean; const Privilege: string): Boolean; -function IsPrivilegeEnabled(const Privilege: string): Boolean; - -function GetPrivilegeDisplayName(const PrivilegeName: string): string; -function SetUserObjectFullAccess(hUserObject: THandle): Boolean; -function GetUserObjectName(hUserObject: THandle): string; - -// Account Information -procedure LookupAccountBySid(Sid: PSID; out Name, Domain: AnsiString; Silent: Boolean = False); overload; -procedure LookupAccountBySid(Sid: PSID; out Name, Domain: WideString; Silent: Boolean = False); overload; -procedure QueryTokenInformation(Token: THandle; InformationClass: TTokenInformationClass; var Buffer: Pointer); -procedure FreeTokenInformation(var Buffer: Pointer); -function GetInteractiveUserName: string; - -// SID utilities -function SIDToString(ASID: PSID): string; -procedure StringToSID(const SIDString: String; SID: PSID; cbSID: DWORD); - -// Computer Information -function GetComputerSID(SID: PSID; cbSID: DWORD): Boolean; - -// Windows Vista/Server 2008 UAC (User Account Control) -function IsUACEnabled: Boolean; -function IsElevated: Boolean; - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\windows'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -uses - {$IFDEF HAS_UNITSCOPE} - System.Classes, - {$IFDEF BORLAND} - Winapi.AccCtrl, - {$ENDIF BORLAND} - {$ELSE ~HAS_UNITSCOPE} - Classes, - {$IFDEF BORLAND} - AccCtrl, - {$ENDIF BORLAND} - {$ENDIF ~HAS_UNITSCOPE} - JclRegistry, JclResources, JclStrings, JclSysInfo, JclWin32; - -//=== Access Control ========================================================= - -function CreateNullDacl(out Sa: TSecurityAttributes; const Inheritable: Boolean): PSecurityAttributes; -begin - if IsWinNT then - begin - Sa.lpSecurityDescriptor := AllocMem(SizeOf(TSecurityDescriptor)); - try - Sa.nLength := SizeOf(Sa); - Sa.bInheritHandle := Inheritable; - Win32Check(InitializeSecurityDescriptor(Sa.lpSecurityDescriptor, SECURITY_DESCRIPTOR_REVISION)); - Win32Check(SetSecurityDescriptorDacl(Sa.lpSecurityDescriptor, True, nil, False)); - Result := @Sa; - except - FreeMem(Sa.lpSecurityDescriptor); - Sa.lpSecurityDescriptor := nil; - raise; - end; - end - else - begin - Sa.lpSecurityDescriptor := nil; - Result := nil; - end; -end; - -function CreateInheritable(out Sa: TSecurityAttributes): PSecurityAttributes; -begin - Sa.nLength := SizeOf(Sa); - Sa.lpSecurityDescriptor := nil; - Sa.bInheritHandle := True; - if IsWinNT then - Result := @Sa - else - Result := nil; -end; - -//=== Privileges ============================================================= - -function IsGroupMember(RelativeGroupID: DWORD): Boolean; -var - psidAdmin: Pointer; - Token: THandle; - Count: DWORD; - TokenInfo: PTokenGroups; - HaveToken: Boolean; - I: Integer; -const - SE_GROUP_USE_FOR_DENY_ONLY = $00000010; -begin - Result := not IsWinNT; - if Result then // Win9x and ME don't have user groups - Exit; - psidAdmin := nil; - TokenInfo := nil; - HaveToken := False; - try - Token := 0; - HaveToken := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, Token); - if (not HaveToken) and (GetLastError = ERROR_NO_TOKEN) then - HaveToken := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, Token); - if HaveToken then - begin - {$IFDEF FPC} - Win32Check(AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2, - SECURITY_BUILTIN_DOMAIN_RID, RelativeGroupID, 0, 0, 0, 0, 0, 0, - psidAdmin)); - if GetTokenInformation(Token, TokenGroups, nil, 0, @Count) or - (GetLastError <> ERROR_INSUFFICIENT_BUFFER) then - RaiseLastOSError; - TokenInfo := PTokenGroups(AllocMem(Count)); - Win32Check(GetTokenInformation(Token, TokenGroups, TokenInfo, Count, @Count)); - {$ELSE FPC} - Win32Check(AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2, - SECURITY_BUILTIN_DOMAIN_RID, RelativeGroupID, 0, 0, 0, 0, 0, 0, - psidAdmin)); - if GetTokenInformation(Token, TokenGroups, nil, 0, Count) or - (GetLastError <> ERROR_INSUFFICIENT_BUFFER) then - RaiseLastOSError; - TokenInfo := PTokenGroups(AllocMem(Count)); - Win32Check(GetTokenInformation(Token, TokenGroups, TokenInfo, Count, Count)); - {$ENDIF FPC} - for I := 0 to TokenInfo^.GroupCount - 1 do - begin - {$RANGECHECKS OFF} // Groups is an array [0..0] of TSIDAndAttributes, ignore ERangeError - Result := EqualSid(psidAdmin, TokenInfo^.Groups[I].Sid); - if Result then - begin - //consider denied ACE with Administrator SID - Result := TokenInfo^.Groups[I].Attributes and SE_GROUP_USE_FOR_DENY_ONLY - <> SE_GROUP_USE_FOR_DENY_ONLY; - Break; - end; - {$IFDEF RANGECHECKS_ON} - {$RANGECHECKS ON} - {$ENDIF RANGECHECKS_ON} - end; - end; - finally - if TokenInfo <> nil then - FreeMem(TokenInfo); - if HaveToken then - CloseHandle(Token); - if psidAdmin <> nil then - FreeSid(psidAdmin); - end; -end; - -function IsAdministrator: Boolean; -begin - Result := IsGroupMember(DOMAIN_ALIAS_RID_ADMINS); -end; - -function IsUser: Boolean; -begin - Result := IsGroupMember(DOMAIN_ALIAS_RID_USERS); -end; - -function IsGuest: Boolean; -begin - Result := IsGroupMember(DOMAIN_ALIAS_RID_GUESTS); -end; - -function IsPowerUser: Boolean; -begin - Result := IsGroupMember(DOMAIN_ALIAS_RID_POWER_USERS); -end; - -function IsAccountOperator: Boolean; -begin - Result := IsGroupMember(DOMAIN_ALIAS_RID_ACCOUNT_OPS); -end; - -function IsSystemOperator: Boolean; -begin - Result := IsGroupMember(DOMAIN_ALIAS_RID_SYSTEM_OPS); -end; - -function IsPrintOperator: Boolean; -begin - Result := IsGroupMember(DOMAIN_ALIAS_RID_PRINT_OPS); -end; - -function IsBackupOperator: Boolean; -begin - Result := IsGroupMember(DOMAIN_ALIAS_RID_BACKUP_OPS); -end; - -function IsReplicator: Boolean; -begin - Result := IsGroupMember(DOMAIN_ALIAS_RID_REPLICATOR); -end; - -function IsRASServer: Boolean; -begin - Result := IsGroupMember(DOMAIN_ALIAS_RID_RAS_SERVERS); -end; - -function IsPreWin2000CompAccess: Boolean; -begin - Result := IsGroupMember(DOMAIN_ALIAS_RID_PREW2KCOMPACCESS); -end; - -function IsRemoteDesktopUser: Boolean; -begin - Result := IsGroupMember(DOMAIN_ALIAS_RID_REMOTE_DESKTOP_USERS); -end; - -function IsNetworkConfigurationOperator: Boolean; -begin - Result := IsGroupMember(DOMAIN_ALIAS_RID_NETWORK_CONFIGURATION_OPS); -end; - -function IsIncomingForestTrustBuilder: Boolean; -begin - Result := IsGroupMember(DOMAIN_ALIAS_RID_INCOMING_FOREST_TRUST_BUILDERS); -end; - -function IsMonitoringUser: Boolean; -begin - Result := IsGroupMember(DOMAIN_ALIAS_RID_MONITORING_USERS); -end; - -function IsLoggingUser: Boolean; -begin - Result := IsGroupMember(DOMAIN_ALIAS_RID_LOGGING_USERS); -end; - -function IsAuthorizationAccess: Boolean; -begin - Result := IsGroupMember(DOMAIN_ALIAS_RID_AUTHORIZATIONACCESS); -end; - -function IsTSLicenseServer: Boolean; -begin - Result := IsGroupMember(DOMAIN_ALIAS_RID_TS_LICENSE_SERVERS); -end; - -function EnableProcessPrivilege(const Enable: Boolean; const Privilege: string): Boolean; -const - PrivAttrs: array [Boolean] of DWORD = (0, SE_PRIVILEGE_ENABLED); -var - Token: THandle; - TokenPriv: TTokenPrivileges; -begin - Result := not IsWinNT; - if Result then // if Win9x, then function return True - Exit; - Token := 0; - if OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, Token) then - begin - TokenPriv.PrivilegeCount := 1; - LookupPrivilegeValue(nil, PChar(Privilege), TokenPriv.Privileges[0].Luid); - TokenPriv.Privileges[0].Attributes := PrivAttrs[Enable]; - JclWin32.AdjustTokenPrivileges(Token, False, TokenPriv, SizeOf(TokenPriv), nil, nil); - Result := GetLastError = ERROR_SUCCESS; - CloseHandle(Token); - end; -end; - -function EnableThreadPrivilege(const Enable: Boolean; const Privilege: string): Boolean; -const - PrivAttrs: array [Boolean] of DWORD = (0, SE_PRIVILEGE_ENABLED); -var - Token: THandle; - TokenPriv: TTokenPrivileges; - HaveToken: Boolean; -begin - Result := not IsWinNT; - if Result then // Win9x/ME - Exit; - Token := 0; - HaveToken := OpenThreadToken(GetCurrentThread, TOKEN_ADJUST_PRIVILEGES, - False, Token); - if (not HaveToken) and (GetLastError = ERROR_NO_TOKEN) then - HaveToken := OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, Token); - if HaveToken then - begin - TokenPriv.PrivilegeCount := 1; - LookupPrivilegeValue(nil, PChar(Privilege), TokenPriv.Privileges[0].Luid); - TokenPriv.Privileges[0].Attributes := PrivAttrs[Enable]; - JclWin32.AdjustTokenPrivileges(Token, False, TokenPriv, SizeOf(TokenPriv), nil, nil); - Result := GetLastError = ERROR_SUCCESS; - CloseHandle(Token); - end; -end; - -function IsPrivilegeEnabled(const Privilege: string): Boolean; -var - Token: THandle; - TokenPriv: TPrivilegeSet; - Res: LongBool; - HaveToken: Boolean; -begin - Result := not IsWinNT; - if Result then // Win9x/ME - Exit; - Token := 0; - HaveToken := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, False, Token); - if (not HaveToken) and (GetLastError = ERROR_NO_TOKEN) then - HaveToken := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, Token); - if HaveToken then - begin - TokenPriv.PrivilegeCount := 1; - TokenPriv.Control := 0; - LookupPrivilegeValue(nil, PChar(Privilege), TokenPriv.Privilege[0].Luid); - Res := False; - Result := PrivilegeCheck(Token, TokenPriv, Res) and Res; - CloseHandle(Token); - end; -end; - -function GetPrivilegeDisplayName(const PrivilegeName: string): string; -var - Count: DWORD; - LangID: DWORD; -begin - if IsWinNT then - begin - Count := 0; - LangID := LANG_USER_DEFAULT; - - // have the the API function determine the required string length - Result := ''; - if not LookupPrivilegeDisplayName(nil, PChar(PrivilegeName), PChar(Result), Count, LangID) then - Count := 256; - SetLength(Result, Count + 1); - - if LookupPrivilegeDisplayName(nil, PChar(PrivilegeName), PChar(Result), Count, LangID) then - StrResetLength(Result) - else - Result := ''; - end - else - Result := ''; // Win9x/ME -end; - -function SetUserObjectFullAccess(hUserObject: THandle): Boolean; -var - Sd: PSecurity_Descriptor; - Si: Security_Information; -begin - Result := not IsWinNT; - if Result then // Win9x/ME - Exit; - { TODO : Check the success of called functions } - Sd := PSecurity_Descriptor(LocalAlloc(LPTR, SECURITY_DESCRIPTOR_MIN_LENGTH)); - InitializeSecurityDescriptor(Sd, SECURITY_DESCRIPTOR_REVISION); - SetSecurityDescriptorDacl(Sd, True, nil, False); - - Si := DACL_SECURITY_INFORMATION; - Result := SetUserObjectSecurity(hUserObject, Si, Sd); - - LocalFree(HLOCAL(Sd)); -end; - -function GetUserObjectName(hUserObject: THandle): string; -var - Count: DWORD; -begin - if IsWinNT then - begin - // have the API function determine the required string length - Count := 0; - Result := ''; - GetUserObjectInformation(hUserObject, UOI_NAME, PChar(Result), 0, Count); - SetLength(Result, Count + 1); - - if GetUserObjectInformation(hUserObject, UOI_NAME, PChar(Result), Count, Count) then - StrResetLength(Result) - else - Result := ''; - end - else - Result := ''; -end; - -//=== Account Information ==================================================== - -procedure LookupAccountBySid(Sid: PSID; out Name, Domain: AnsiString; Silent: Boolean); -var - NameSize, DomainSize: DWORD; - Use: SID_NAME_USE; - Success: Boolean; -begin - if IsWinNT then - begin - NameSize := 0; - DomainSize := 0; - Use := SidTypeUnknown; - LookupAccountSidA(nil, Sid, nil, NameSize, nil, DomainSize, Use); - if NameSize > 0 then - SetLength(Name, NameSize - 1); - if DomainSize > 0 then - SetLength(Domain, DomainSize - 1); - Success := LookupAccountSidA(nil, Sid, PAnsiChar(Name), NameSize, PAnsiChar(Domain), DomainSize, Use); - if Silent and not Success then - begin - Name := AnsiString(SIDToString(Sid)); - Domain := ''; - end - else - Win32Check(Success); - end - else - begin // if Win9x, then function return '' - Name := ''; - Domain := ''; - end; -end; - -procedure LookupAccountBySid(Sid: PSID; out Name, Domain: WideString; Silent: Boolean); -var - NameSize, DomainSize: DWORD; - Use: SID_NAME_USE; - Success: Boolean; -begin - if IsWinNT then - begin - NameSize := 0; - DomainSize := 0; - Use := SidTypeUnknown; - LookupAccountSidW(nil, Sid, nil, NameSize, nil, DomainSize, Use); - if NameSize > 0 then - SetLength(Name, NameSize - 1); - if DomainSize > 0 then - SetLength(Domain, DomainSize - 1); - Success := LookupAccountSidW(nil, Sid, PWideChar(Name), NameSize, PWideChar(Domain), DomainSize, Use); - if Silent and not Success then - begin - Name := WideString(SIDToString(Sid)); - Domain := ''; - end - else - Win32Check(Success); - end - else - begin - Name := ''; - Domain := ''; - end; -end; - -procedure QueryTokenInformation(Token: THandle; - InformationClass: TTokenInformationClass; var Buffer: Pointer); -var - Ret: BOOL; - Length, LastError: DWORD; -begin - Buffer := nil; - if not IsWinNT then // Win9x/ME - Exit; - Length := 0; - {$IFDEF FPC} - Ret := GetTokenInformation(Token, InformationClass, Buffer, Length, @Length); - {$ELSE ~FPC} - Ret := GetTokenInformation(Token, InformationClass, Buffer, Length, Length); - {$ENDIF ~FPC} - if (not Ret) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then - begin - GetMem(Buffer, Length); - {$IFDEF FPC} - Ret := GetTokenInformation(Token, InformationClass, Buffer, Length, @Length); - {$ELSE ~FPC} - Ret := GetTokenInformation(Token, InformationClass, Buffer, Length, Length); - {$ENDIF ~FPC} - if not Ret then - begin - LastError := GetLastError; - FreeTokenInformation(Buffer); - SetLastError(LastError); - end; - end; -end; - -procedure FreeTokenInformation(var Buffer: Pointer); -begin - if Buffer <> nil then - FreeMem(Buffer); - Buffer := nil; -end; - -function GetInteractiveUserName: string; -var - Handle: THandle; - Token: THandle; - User: PTokenUser; - {$IFDEF SUPPORTS_UNICODE} - Name, Domain: WideString; - {$ELSE ~SUPPORTS_UNICODE} - Name, Domain: AnsiString; - {$ENDIF ~SUPPORTS_UNICODE} -begin - Result := ''; - if not IsWinNT then // if Win9x, then function return '' - Exit; - Handle := GetShellProcessHandle; - try - Token := 0; - Win32Check(OpenProcessToken(Handle, TOKEN_QUERY, Token)); - try - User := nil; - QueryTokenInformation(Token, TokenUser, Pointer(User)); - try - LookupAccountBySid(User.User.Sid, Name, Domain); - Result := Domain + '\' + Name; - finally - FreeMem(User); - end; - finally - CloseHandle(Token); - end; - finally - CloseHandle(Handle); - end; -end; - -//=== SID utilities ========================================================== - -function SIDToString(ASID: PSID): string; -var - SidIdAuthority: PSIDIdentifierAuthority; - SubAuthorities, SidRev, SidSize: DWORD; - Counter: Integer; -begin - SidRev := SID_REVISION; - - // Validate the binary SID. - if not IsValidSid(ASid) then - Raise EJclSecurityError.CreateRes(@RsInvalidSID); - - // Get the identifier authority value from the SID. - SidIdAuthority := GetSidIdentifierAuthority(ASid); - - // Get the number of subauthorities in the SID. - SubAuthorities := GetSidSubAuthorityCount(ASid)^; - - //Compute the buffer length. - // S-SID_REVISION- + IdentifierAuthority- + subauthorities- + NULL - SidSize := (15 + 12 + (12 * SubAuthorities) + 1) * SizeOf(CHAR); - - SetLength(Result, SidSize+1); - - // Add 'S' prefix and revision number to the string. - Result := Format('S-%u-',[SidRev]); - - // Add SID identifier authority to the string. - if (SidIdAuthority^.Value[0] <> 0) or (SidIdAuthority^.Value[1] <> 0) then - Result := Result + AnsiLowerCase(Format('0x%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x', - [USHORT(SidIdAuthority^.Value[0]), - USHORT(SidIdAuthority^.Value[1]), - USHORT(SidIdAuthority^.Value[2]), - USHORT(SidIdAuthority^.Value[3]), - USHORT(SidIdAuthority^.Value[4]), - USHORT(SidIdAuthority^.Value[5])])) - else - Result := Result + Format('%u', - [ULONG(SidIdAuthority^.Value[5])+ - ULONG(SidIdAuthority^.Value[4] shl 8)+ - ULONG(SidIdAuthority^.Value[3] shl 16)+ - ULONG(SidIdAuthority^.Value[2] shl 24)]); - - // Add SID subauthorities to the string. - for Counter := 0 to SubAuthorities-1 do - Result := Result + Format('-%u',[GetSidSubAuthority(ASid, Counter)^]); -end; - -procedure StringToSID(const SIDString: String; SID: PSID; cbSID: DWORD); -var - {$IFDEF FPC} ASID: PSID; {$ELSE} ASID : ^_SID; {$ENDIF} - CurrentPos, TempPos: Integer; - AuthorityValue, RequiredSize: DWORD; - Authority: string; -begin - if (Length (SIDString) <= 3) or (SIDString [1] <> 'S') or (SIDString [2] <> '-') then - raise EJclSecurityError.CreateRes(@RsInvalidSID); - - RequiredSize := SizeOf(_SID) - SizeOf(DWORD); // _SID.Revision + _SID.SubAuthorityCount + _SID.IdentifierAuthority - if cbSID < RequiredSize then - raise EJclSecurityError.CreateRes(@RsSIDBufferTooSmall); - - ASID := SID; // typecast from opaque structure - - CurrentPos := StrFind('-', SIDString, 3); - if CurrentPos <= 0 then - raise EJclSecurityError.CreateRes(@RsInvalidSID); - ASID^.Revision := StrToInt(Copy(SIDString, 3, CurrentPos - 3)); - - Inc(CurrentPos); - TempPos := StrFind('-', SIDString, CurrentPos); - if TempPos = 0 then - Authority := Copy(SIDString, CurrentPos, Length(SIDString) - CurrentPos + 1) - else - Authority := Copy(SIDString, CurrentPos, TempPos - CurrentPos); - - if Length(Authority) < 1 then - raise EJclSecurityError.CreateRes(@RsInvalidSID); - if (Length(Authority) = 14) and (Authority[1] = '0') and (Authority[2] = 'x') then - begin - ASID^.IdentifierAuthority.Value[0] := StrToInt(HexPrefix + Authority[3] + Authority[4]); - ASID^.IdentifierAuthority.Value[1] := StrToInt(HexPrefix + Authority[5] + Authority[6]); - ASID^.IdentifierAuthority.Value[2] := StrToInt(HexPrefix + Authority[7] + Authority[8]); - ASID^.IdentifierAuthority.Value[3] := StrToInt(HexPrefix + Authority[9] + Authority[10]); - ASID^.IdentifierAuthority.Value[4] := StrToInt(HexPrefix + Authority[11] + Authority[12]); - ASID^.IdentifierAuthority.Value[5] := StrToInt(HexPrefix + Authority[13] + Authority[14]); - end - else - begin - ASID^.IdentifierAuthority.Value[0] := 0; - ASID^.IdentifierAuthority.Value[1] := 0; - AuthorityValue := StrToInt(Authority); - ASID^.IdentifierAuthority.Value[2] := (AuthorityValue and $FF000000) shr 24; - ASID^.IdentifierAuthority.Value[3] := (AuthorityValue and $00FF0000) shr 16; - ASID^.IdentifierAuthority.Value[4] := (AuthorityValue and $0000FF00) shr 8; - ASID^.IdentifierAuthority.Value[5] := AuthorityValue and $000000FF; - end; - - CurrentPos := TempPos + 1; - ASID^.SubAuthorityCount := 0; - - while CurrentPos > 1 do - begin - TempPos := StrFind('-', SIDString, CurrentPos); - - Inc(RequiredSize, SizeOf(DWORD)); // _SID.SubAuthority[x] - if cbSID < RequiredSize then - raise EJclSecurityError.CreateRes(@RsSIDBufferTooSmall); - - if TempPos = 0 then - Authority := Copy(SIDString, CurrentPos, Length(SIDString) - CurrentPos + 1) - else - Authority := Copy(SIDString, CurrentPos, TempPos - CurrentPos); - - {$RANGECHECKS OFF} - ASID^.SubAuthority[ASID^.SubAuthorityCount] := StrToInt64(Authority); - {$IFDEF RANGECHECKS_ON} - {$RANGECHECKS ON} - {$ENDIF RANGECHECKS_ON} - Inc(ASID^.SubAuthorityCount); - - CurrentPos := TempPos + 1; - end; -end; - -//=== Computer Information =================================================== - -function LsaNTCheck(NTResult: Cardinal) : Cardinal; -var - WinError: Cardinal; -begin - Result := NTResult; - if ($C0000000 and Cardinal(NTResult)) = $C0000000 then - begin - WinError := LsaNtStatusToWinError(NTResult); - if WinError <> ERROR_SUCCESS then - raise EJclSecurityError.CreateResFmt(@RsLsaError, [NTResult, SysErrorMessage(WinError)]); - end; -end; - -function GetComputerSID(SID: PSID; cbSID: DWORD): Boolean; -var - ObjectAttributes: TLsaObjectAttributes; - PolicyHandle: TLsaHandle; - Info: PPolicyAccountDomainInfo; -begin - if IsWinNT then - begin - ZeroMemory(@ObjectAttributes,SizeOf(ObjectAttributes)); - - {$IFDEF FPC} - PolicyHandle := 0; - {$ENDIF FPC} - LsaNTCheck(LsaOpenPolicy(nil, // Use local system - ObjectAttributes, //Object attributes. - POLICY_VIEW_LOCAL_INFORMATION, // We're just looking - PolicyHandle)); //Receives the policy handle. - try - Info := nil; - LsaNTCheck(LsaQueryInformationPolicy(PolicyHandle, PolicyAccountDomainInformation, - Pointer(Info))); - try - Result := CopySid(cbSID,SID,Info^.DomainSid); - finally - LsaFreeMemory(Info); - end; - finally - LsaClose(PolicyHandle); - end; - end - else - Result := False; // Win9x -end; - -//=== Windows Vista/Server 2008 UAC (User Account Control) =================== - -function IsUACEnabled: Boolean; -begin - Result := JclCheckWinVersion(6, 0) and - RegReadBoolDef(HKLM, '\Software\Microsoft\Windows\CurrentVersion\Policies\System', 'EnableLUA', False); -end; - -// source: Vista elevator from the Code Project -function IsElevated: Boolean; -const - TokenElevation = TTokenInformationClass(20); -type - TOKEN_ELEVATION = record - TokenIsElevated: DWORD; - end; -var - TokenHandle: THandle; - ResultLength: Cardinal; - ATokenElevation: TOKEN_ELEVATION; -begin - if JclCheckWinVersion(6, 0) then - begin - TokenHandle := 0; - if OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, TokenHandle) then - begin - try - ResultLength := 0; - if GetTokenInformation(TokenHandle, TokenElevation, @ATokenElevation, SizeOf(ATokenElevation), ResultLength) then - Result := ATokenElevation.TokenIsElevated <> 0 - else - Result := False; - finally - CloseHandle(TokenHandle); - end; - end - else - Result := False; - end - else - Result := IsAdministrator; -end; - -{$IFDEF UNITVERSIONING} -initialization - RegisterUnitVersion(HInstance, UnitVersioning); - -finalization - UnregisterUnitVersion(HInstance); -{$ENDIF UNITVERSIONING} - -end. +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclSecurity.pas. } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. } +{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. All Rights Reserved. } +{ } +{ Contributor(s): } +{ Marcel van Brakel } +{ Peter Friese } +{ Robert Marquardt (marquardt) } +{ John C Molyneux } +{ Robert Rossmair (rrossmair) } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ Christoph Lindeman } +{ } +{**************************************************************************************************} +{ } +{ Various NT security related routines to perform commen asks such as enabling and disabling } +{ privileges. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclSecurity; + +{$I jcl.inc} +{$I windowsonly.inc} + +{$HPPEMIT '#define TTokenInformationClass TOKEN_INFORMATION_CLASS'} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, System.SysUtils, + {$ELSE ~HAS_UNITSCOPE} + Windows, SysUtils, + {$ENDIF ~HAS_UNITSCOPE} + JclBase; + +type + EJclSecurityError = class(EJclError); + +// Access Control +function CreateNullDacl(out Sa: TSecurityAttributes; const Inheritable: Boolean): PSecurityAttributes; +function CreateInheritable(out Sa: TSecurityAttributes): PSecurityAttributes; + +// Privileges +function IsGroupMember(RelativeGroupID: DWORD): Boolean; +function IsAdministrator: Boolean; +function IsUser: Boolean; +function IsGuest: Boolean; +function IsPowerUser: Boolean; +function IsAccountOperator: Boolean; +function IsSystemOperator: Boolean; +function IsPrintOperator: Boolean; +function IsBackupOperator: Boolean; +function IsReplicator: Boolean; +function IsRASServer: Boolean; +function IsPreWin2000CompAccess: Boolean; +function IsRemoteDesktopUser: Boolean; +function IsNetworkConfigurationOperator: Boolean; +function IsIncomingForestTrustBuilder: Boolean; +function IsMonitoringUser: Boolean; +function IsLoggingUser: Boolean; +function IsAuthorizationAccess: Boolean; +function IsTSLicenseServer: Boolean; + +function EnableProcessPrivilege(const Enable: Boolean; const Privilege: string): Boolean; +function EnableThreadPrivilege(const Enable: Boolean; const Privilege: string): Boolean; +function IsPrivilegeEnabled(const Privilege: string): Boolean; + +function GetPrivilegeDisplayName(const PrivilegeName: string): string; +function SetUserObjectFullAccess(hUserObject: THandle): Boolean; +function GetUserObjectName(hUserObject: THandle): string; + +// Account Information +procedure LookupAccountBySid(Sid: PSID; out Name, Domain: AnsiString; Silent: Boolean = False); overload; +procedure LookupAccountBySid(Sid: PSID; out Name, Domain: WideString; Silent: Boolean = False); overload; +procedure QueryTokenInformation(Token: THandle; InformationClass: TTokenInformationClass; var Buffer: Pointer); +procedure FreeTokenInformation(var Buffer: Pointer); +function GetInteractiveUserName: string; + +// SID utilities +function SIDToString(ASID: PSID): string; +procedure StringToSID(const SIDString: String; SID: PSID; cbSID: DWORD); + +// Computer Information +function GetComputerSID(SID: PSID; cbSID: DWORD): Boolean; + +// Windows Vista/Server 2008 UAC (User Account Control) +function IsUACEnabled: Boolean; +function IsElevated: Boolean; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.Classes, + {$IFDEF BORLAND} + Winapi.AccCtrl, + {$ENDIF BORLAND} + {$ELSE ~HAS_UNITSCOPE} + Classes, + {$IFDEF BORLAND} + AccCtrl, + {$ENDIF BORLAND} + {$ENDIF ~HAS_UNITSCOPE} + JclRegistry, JclResources, JclStrings, JclSysInfo, JclWin32; + +//=== Access Control ========================================================= + +function CreateNullDacl(out Sa: TSecurityAttributes; const Inheritable: Boolean): PSecurityAttributes; +begin + if IsWinNT then + begin + Sa.lpSecurityDescriptor := AllocMem(SizeOf(TSecurityDescriptor)); + try + Sa.nLength := SizeOf(Sa); + Sa.bInheritHandle := Inheritable; + Win32Check(InitializeSecurityDescriptor(Sa.lpSecurityDescriptor, SECURITY_DESCRIPTOR_REVISION)); + Win32Check(SetSecurityDescriptorDacl(Sa.lpSecurityDescriptor, True, nil, False)); + Result := @Sa; + except + FreeMem(Sa.lpSecurityDescriptor); + Sa.lpSecurityDescriptor := nil; + raise; + end; + end + else + begin + Sa.lpSecurityDescriptor := nil; + Result := nil; + end; +end; + +function CreateInheritable(out Sa: TSecurityAttributes): PSecurityAttributes; +begin + Sa.nLength := SizeOf(Sa); + Sa.lpSecurityDescriptor := nil; + Sa.bInheritHandle := True; + if IsWinNT then + Result := @Sa + else + Result := nil; +end; + +//=== Privileges ============================================================= + +function IsGroupMember(RelativeGroupID: DWORD): Boolean; +var + psidAdmin: Pointer; + Token: THandle; + Count: DWORD; + TokenInfo: PTokenGroups; + HaveToken: Boolean; + I: Integer; +const + SE_GROUP_USE_FOR_DENY_ONLY = $00000010; +begin + Result := not IsWinNT; + if Result then // Win9x and ME don't have user groups + Exit; + psidAdmin := nil; + TokenInfo := nil; + HaveToken := False; + try + Token := 0; + HaveToken := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, Token); + if (not HaveToken) and (GetLastError = ERROR_NO_TOKEN) then + HaveToken := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, Token); + if HaveToken then + begin + {$IFDEF FPC} + Win32Check(AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2, + SECURITY_BUILTIN_DOMAIN_RID, RelativeGroupID, 0, 0, 0, 0, 0, 0, + psidAdmin)); + if GetTokenInformation(Token, TokenGroups, nil, 0, @Count) or + (GetLastError <> ERROR_INSUFFICIENT_BUFFER) then + RaiseLastOSError; + TokenInfo := PTokenGroups(AllocMem(Count)); + Win32Check(GetTokenInformation(Token, TokenGroups, TokenInfo, Count, @Count)); + {$ELSE FPC} + Win32Check(AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2, + SECURITY_BUILTIN_DOMAIN_RID, RelativeGroupID, 0, 0, 0, 0, 0, 0, + psidAdmin)); + if GetTokenInformation(Token, TokenGroups, nil, 0, Count) or + (GetLastError <> ERROR_INSUFFICIENT_BUFFER) then + RaiseLastOSError; + TokenInfo := PTokenGroups(AllocMem(Count)); + Win32Check(GetTokenInformation(Token, TokenGroups, TokenInfo, Count, Count)); + {$ENDIF FPC} + for I := 0 to TokenInfo^.GroupCount - 1 do + begin + {$RANGECHECKS OFF} // Groups is an array [0..0] of TSIDAndAttributes, ignore ERangeError + Result := EqualSid(psidAdmin, TokenInfo^.Groups[I].Sid); + if Result then + begin + //consider denied ACE with Administrator SID + Result := TokenInfo^.Groups[I].Attributes and SE_GROUP_USE_FOR_DENY_ONLY + <> SE_GROUP_USE_FOR_DENY_ONLY; + Break; + end; + {$IFDEF RANGECHECKS_ON} + {$RANGECHECKS ON} + {$ENDIF RANGECHECKS_ON} + end; + end; + finally + if TokenInfo <> nil then + FreeMem(TokenInfo); + if HaveToken then + CloseHandle(Token); + if psidAdmin <> nil then + FreeSid(psidAdmin); + end; +end; + +function IsAdministrator: Boolean; +begin + Result := IsGroupMember(DOMAIN_ALIAS_RID_ADMINS); +end; + +function IsUser: Boolean; +begin + Result := IsGroupMember(DOMAIN_ALIAS_RID_USERS); +end; + +function IsGuest: Boolean; +begin + Result := IsGroupMember(DOMAIN_ALIAS_RID_GUESTS); +end; + +function IsPowerUser: Boolean; +begin + Result := IsGroupMember(DOMAIN_ALIAS_RID_POWER_USERS); +end; + +function IsAccountOperator: Boolean; +begin + Result := IsGroupMember(DOMAIN_ALIAS_RID_ACCOUNT_OPS); +end; + +function IsSystemOperator: Boolean; +begin + Result := IsGroupMember(DOMAIN_ALIAS_RID_SYSTEM_OPS); +end; + +function IsPrintOperator: Boolean; +begin + Result := IsGroupMember(DOMAIN_ALIAS_RID_PRINT_OPS); +end; + +function IsBackupOperator: Boolean; +begin + Result := IsGroupMember(DOMAIN_ALIAS_RID_BACKUP_OPS); +end; + +function IsReplicator: Boolean; +begin + Result := IsGroupMember(DOMAIN_ALIAS_RID_REPLICATOR); +end; + +function IsRASServer: Boolean; +begin + Result := IsGroupMember(DOMAIN_ALIAS_RID_RAS_SERVERS); +end; + +function IsPreWin2000CompAccess: Boolean; +begin + Result := IsGroupMember(DOMAIN_ALIAS_RID_PREW2KCOMPACCESS); +end; + +function IsRemoteDesktopUser: Boolean; +begin + Result := IsGroupMember(DOMAIN_ALIAS_RID_REMOTE_DESKTOP_USERS); +end; + +function IsNetworkConfigurationOperator: Boolean; +begin + Result := IsGroupMember(DOMAIN_ALIAS_RID_NETWORK_CONFIGURATION_OPS); +end; + +function IsIncomingForestTrustBuilder: Boolean; +begin + Result := IsGroupMember(DOMAIN_ALIAS_RID_INCOMING_FOREST_TRUST_BUILDERS); +end; + +function IsMonitoringUser: Boolean; +begin + Result := IsGroupMember(DOMAIN_ALIAS_RID_MONITORING_USERS); +end; + +function IsLoggingUser: Boolean; +begin + Result := IsGroupMember(DOMAIN_ALIAS_RID_LOGGING_USERS); +end; + +function IsAuthorizationAccess: Boolean; +begin + Result := IsGroupMember(DOMAIN_ALIAS_RID_AUTHORIZATIONACCESS); +end; + +function IsTSLicenseServer: Boolean; +begin + Result := IsGroupMember(DOMAIN_ALIAS_RID_TS_LICENSE_SERVERS); +end; + +function EnableProcessPrivilege(const Enable: Boolean; const Privilege: string): Boolean; +const + PrivAttrs: array [Boolean] of DWORD = (0, SE_PRIVILEGE_ENABLED); +var + Token: THandle; + TokenPriv: TTokenPrivileges; +begin + Result := not IsWinNT; + if Result then // if Win9x, then function return True + Exit; + Token := 0; + if OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, Token) then + begin + TokenPriv.PrivilegeCount := 1; + LookupPrivilegeValue(nil, PChar(Privilege), TokenPriv.Privileges[0].Luid); + TokenPriv.Privileges[0].Attributes := PrivAttrs[Enable]; + JclWin32.AdjustTokenPrivileges(Token, False, TokenPriv, SizeOf(TokenPriv), nil, nil); + Result := GetLastError = ERROR_SUCCESS; + CloseHandle(Token); + end; +end; + +function EnableThreadPrivilege(const Enable: Boolean; const Privilege: string): Boolean; +const + PrivAttrs: array [Boolean] of DWORD = (0, SE_PRIVILEGE_ENABLED); +var + Token: THandle; + TokenPriv: TTokenPrivileges; + HaveToken: Boolean; +begin + Result := not IsWinNT; + if Result then // Win9x/ME + Exit; + Token := 0; + HaveToken := OpenThreadToken(GetCurrentThread, TOKEN_ADJUST_PRIVILEGES, + False, Token); + if (not HaveToken) and (GetLastError = ERROR_NO_TOKEN) then + HaveToken := OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, Token); + if HaveToken then + begin + TokenPriv.PrivilegeCount := 1; + LookupPrivilegeValue(nil, PChar(Privilege), TokenPriv.Privileges[0].Luid); + TokenPriv.Privileges[0].Attributes := PrivAttrs[Enable]; + JclWin32.AdjustTokenPrivileges(Token, False, TokenPriv, SizeOf(TokenPriv), nil, nil); + Result := GetLastError = ERROR_SUCCESS; + CloseHandle(Token); + end; +end; + +function IsPrivilegeEnabled(const Privilege: string): Boolean; +var + Token: THandle; + TokenPriv: TPrivilegeSet; + Res: LongBool; + HaveToken: Boolean; +begin + Result := not IsWinNT; + if Result then // Win9x/ME + Exit; + Token := 0; + HaveToken := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, False, Token); + if (not HaveToken) and (GetLastError = ERROR_NO_TOKEN) then + HaveToken := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, Token); + if HaveToken then + begin + TokenPriv.PrivilegeCount := 1; + TokenPriv.Control := 0; + LookupPrivilegeValue(nil, PChar(Privilege), TokenPriv.Privilege[0].Luid); + Res := False; + Result := PrivilegeCheck(Token, TokenPriv, Res) and Res; + CloseHandle(Token); + end; +end; + +function GetPrivilegeDisplayName(const PrivilegeName: string): string; +var + Count: DWORD; + LangID: DWORD; +begin + if IsWinNT then + begin + Count := 0; + LangID := LANG_USER_DEFAULT; + + // have the the API function determine the required string length + Result := ''; + if not LookupPrivilegeDisplayName(nil, PChar(PrivilegeName), PChar(Result), Count, LangID) then + Count := 256; + SetLength(Result, Count + 1); + + if LookupPrivilegeDisplayName(nil, PChar(PrivilegeName), PChar(Result), Count, LangID) then + StrResetLength(Result) + else + Result := ''; + end + else + Result := ''; // Win9x/ME +end; + +function SetUserObjectFullAccess(hUserObject: THandle): Boolean; +var + Sd: PSecurity_Descriptor; + Si: Security_Information; +begin + Result := not IsWinNT; + if Result then // Win9x/ME + Exit; + { TODO : Check the success of called functions } + Sd := PSecurity_Descriptor(LocalAlloc(LPTR, SECURITY_DESCRIPTOR_MIN_LENGTH)); + InitializeSecurityDescriptor(Sd, SECURITY_DESCRIPTOR_REVISION); + SetSecurityDescriptorDacl(Sd, True, nil, False); + + Si := DACL_SECURITY_INFORMATION; + Result := SetUserObjectSecurity(hUserObject, Si, Sd); + + LocalFree(HLOCAL(Sd)); +end; + +function GetUserObjectName(hUserObject: THandle): string; +var + Count: DWORD; +begin + if IsWinNT then + begin + // have the API function determine the required string length + Count := 0; + Result := ''; + GetUserObjectInformation(hUserObject, UOI_NAME, PChar(Result), 0, Count); + SetLength(Result, Count + 1); + + if GetUserObjectInformation(hUserObject, UOI_NAME, PChar(Result), Count, Count) then + StrResetLength(Result) + else + Result := ''; + end + else + Result := ''; +end; + +//=== Account Information ==================================================== + +procedure LookupAccountBySid(Sid: PSID; out Name, Domain: AnsiString; Silent: Boolean); +var + NameSize, DomainSize: DWORD; + Use: SID_NAME_USE; + Success: Boolean; +begin + if IsWinNT then + begin + NameSize := 0; + DomainSize := 0; + Use := SidTypeUnknown; + LookupAccountSidA(nil, Sid, nil, NameSize, nil, DomainSize, Use); + if NameSize > 0 then + SetLength(Name, NameSize - 1); + if DomainSize > 0 then + SetLength(Domain, DomainSize - 1); + Success := LookupAccountSidA(nil, Sid, PAnsiChar(Name), NameSize, PAnsiChar(Domain), DomainSize, Use); + if Silent and not Success then + begin + Name := AnsiString(SIDToString(Sid)); + Domain := ''; + end + else + Win32Check(Success); + end + else + begin // if Win9x, then function return '' + Name := ''; + Domain := ''; + end; +end; + +procedure LookupAccountBySid(Sid: PSID; out Name, Domain: WideString; Silent: Boolean); +var + NameSize, DomainSize: DWORD; + Use: SID_NAME_USE; + Success: Boolean; +begin + if IsWinNT then + begin + NameSize := 0; + DomainSize := 0; + Use := SidTypeUnknown; + LookupAccountSidW(nil, Sid, nil, NameSize, nil, DomainSize, Use); + if NameSize > 0 then + SetLength(Name, NameSize - 1); + if DomainSize > 0 then + SetLength(Domain, DomainSize - 1); + Success := LookupAccountSidW(nil, Sid, PWideChar(Name), NameSize, PWideChar(Domain), DomainSize, Use); + if Silent and not Success then + begin + Name := WideString(SIDToString(Sid)); + Domain := ''; + end + else + Win32Check(Success); + end + else + begin + Name := ''; + Domain := ''; + end; +end; + +procedure QueryTokenInformation(Token: THandle; + InformationClass: TTokenInformationClass; var Buffer: Pointer); +var + Ret: BOOL; + Length, LastError: DWORD; +begin + Buffer := nil; + if not IsWinNT then // Win9x/ME + Exit; + Length := 0; + {$IFDEF FPC} + Ret := GetTokenInformation(Token, InformationClass, Buffer, Length, @Length); + {$ELSE ~FPC} + Ret := GetTokenInformation(Token, InformationClass, Buffer, Length, Length); + {$ENDIF ~FPC} + if (not Ret) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then + begin + GetMem(Buffer, Length); + {$IFDEF FPC} + Ret := GetTokenInformation(Token, InformationClass, Buffer, Length, @Length); + {$ELSE ~FPC} + Ret := GetTokenInformation(Token, InformationClass, Buffer, Length, Length); + {$ENDIF ~FPC} + if not Ret then + begin + LastError := GetLastError; + FreeTokenInformation(Buffer); + SetLastError(LastError); + end; + end; +end; + +procedure FreeTokenInformation(var Buffer: Pointer); +begin + if Buffer <> nil then + FreeMem(Buffer); + Buffer := nil; +end; + +function GetInteractiveUserName: string; +var + Handle: THandle; + Token: THandle; + User: PTokenUser; + {$IFDEF SUPPORTS_UNICODE} + Name, Domain: WideString; + {$ELSE ~SUPPORTS_UNICODE} + Name, Domain: AnsiString; + {$ENDIF ~SUPPORTS_UNICODE} +begin + Result := ''; + if not IsWinNT then // if Win9x, then function return '' + Exit; + Handle := GetShellProcessHandle; + try + Token := 0; + Win32Check(OpenProcessToken(Handle, TOKEN_QUERY, Token)); + try + User := nil; + QueryTokenInformation(Token, TokenUser, Pointer(User)); + try + LookupAccountBySid(User.User.Sid, Name, Domain); + Result := Domain + '\' + Name; + finally + FreeMem(User); + end; + finally + CloseHandle(Token); + end; + finally + CloseHandle(Handle); + end; +end; + +//=== SID utilities ========================================================== + +function SIDToString(ASID: PSID): string; +var + SidIdAuthority: PSIDIdentifierAuthority; + SubAuthorities, SidRev, SidSize: DWORD; + Counter: Integer; +begin + SidRev := SID_REVISION; + + // Validate the binary SID. + if not IsValidSid(ASid) then + Raise EJclSecurityError.CreateRes(@RsInvalidSID); + + // Get the identifier authority value from the SID. + SidIdAuthority := GetSidIdentifierAuthority(ASid); + + // Get the number of subauthorities in the SID. + SubAuthorities := GetSidSubAuthorityCount(ASid)^; + + //Compute the buffer length. + // S-SID_REVISION- + IdentifierAuthority- + subauthorities- + NULL + SidSize := (15 + 12 + (12 * SubAuthorities) + 1) * SizeOf(CHAR); + + SetLength(Result, SidSize+1); + + // Add 'S' prefix and revision number to the string. + Result := Format('S-%u-',[SidRev]); + + // Add SID identifier authority to the string. + if (SidIdAuthority^.Value[0] <> 0) or (SidIdAuthority^.Value[1] <> 0) then + Result := Result + AnsiLowerCase(Format('0x%2.2x%2.2x%2.2x%2.2x%2.2x%2.2x', + [USHORT(SidIdAuthority^.Value[0]), + USHORT(SidIdAuthority^.Value[1]), + USHORT(SidIdAuthority^.Value[2]), + USHORT(SidIdAuthority^.Value[3]), + USHORT(SidIdAuthority^.Value[4]), + USHORT(SidIdAuthority^.Value[5])])) + else + Result := Result + Format('%u', + [ULONG(SidIdAuthority^.Value[5])+ + ULONG(SidIdAuthority^.Value[4] shl 8)+ + ULONG(SidIdAuthority^.Value[3] shl 16)+ + ULONG(SidIdAuthority^.Value[2] shl 24)]); + + // Add SID subauthorities to the string. + for Counter := 0 to SubAuthorities-1 do + Result := Result + Format('-%u',[GetSidSubAuthority(ASid, Counter)^]); +end; + +procedure StringToSID(const SIDString: String; SID: PSID; cbSID: DWORD); +var + {$IFDEF FPC} ASID: PSID; {$ELSE} ASID : ^_SID; {$ENDIF} + CurrentPos, TempPos: Integer; + AuthorityValue, RequiredSize: DWORD; + Authority: string; +begin + if (Length (SIDString) <= 3) or (SIDString [1] <> 'S') or (SIDString [2] <> '-') then + raise EJclSecurityError.CreateRes(@RsInvalidSID); + + RequiredSize := SizeOf(_SID) - SizeOf(DWORD); // _SID.Revision + _SID.SubAuthorityCount + _SID.IdentifierAuthority + if cbSID < RequiredSize then + raise EJclSecurityError.CreateRes(@RsSIDBufferTooSmall); + + ASID := SID; // typecast from opaque structure + + CurrentPos := StrFind('-', SIDString, 3); + if CurrentPos <= 0 then + raise EJclSecurityError.CreateRes(@RsInvalidSID); + ASID^.Revision := StrToInt(Copy(SIDString, 3, CurrentPos - 3)); + + Inc(CurrentPos); + TempPos := StrFind('-', SIDString, CurrentPos); + if TempPos = 0 then + Authority := Copy(SIDString, CurrentPos, Length(SIDString) - CurrentPos + 1) + else + Authority := Copy(SIDString, CurrentPos, TempPos - CurrentPos); + + if Length(Authority) < 1 then + raise EJclSecurityError.CreateRes(@RsInvalidSID); + if (Length(Authority) = 14) and (Authority[1] = '0') and (Authority[2] = 'x') then + begin + ASID^.IdentifierAuthority.Value[0] := StrToInt(HexPrefix + Authority[3] + Authority[4]); + ASID^.IdentifierAuthority.Value[1] := StrToInt(HexPrefix + Authority[5] + Authority[6]); + ASID^.IdentifierAuthority.Value[2] := StrToInt(HexPrefix + Authority[7] + Authority[8]); + ASID^.IdentifierAuthority.Value[3] := StrToInt(HexPrefix + Authority[9] + Authority[10]); + ASID^.IdentifierAuthority.Value[4] := StrToInt(HexPrefix + Authority[11] + Authority[12]); + ASID^.IdentifierAuthority.Value[5] := StrToInt(HexPrefix + Authority[13] + Authority[14]); + end + else + begin + ASID^.IdentifierAuthority.Value[0] := 0; + ASID^.IdentifierAuthority.Value[1] := 0; + AuthorityValue := StrToInt(Authority); + ASID^.IdentifierAuthority.Value[2] := (AuthorityValue and $FF000000) shr 24; + ASID^.IdentifierAuthority.Value[3] := (AuthorityValue and $00FF0000) shr 16; + ASID^.IdentifierAuthority.Value[4] := (AuthorityValue and $0000FF00) shr 8; + ASID^.IdentifierAuthority.Value[5] := AuthorityValue and $000000FF; + end; + + CurrentPos := TempPos + 1; + ASID^.SubAuthorityCount := 0; + + while CurrentPos > 1 do + begin + TempPos := StrFind('-', SIDString, CurrentPos); + + Inc(RequiredSize, SizeOf(DWORD)); // _SID.SubAuthority[x] + if cbSID < RequiredSize then + raise EJclSecurityError.CreateRes(@RsSIDBufferTooSmall); + + if TempPos = 0 then + Authority := Copy(SIDString, CurrentPos, Length(SIDString) - CurrentPos + 1) + else + Authority := Copy(SIDString, CurrentPos, TempPos - CurrentPos); + + {$RANGECHECKS OFF} + ASID^.SubAuthority[ASID^.SubAuthorityCount] := StrToInt64(Authority); + {$IFDEF RANGECHECKS_ON} + {$RANGECHECKS ON} + {$ENDIF RANGECHECKS_ON} + Inc(ASID^.SubAuthorityCount); + + CurrentPos := TempPos + 1; + end; +end; + +//=== Computer Information =================================================== + +function LsaNTCheck(NTResult: Cardinal) : Cardinal; +var + WinError: Cardinal; +begin + Result := NTResult; + if ($C0000000 and Cardinal(NTResult)) = $C0000000 then + begin + WinError := LsaNtStatusToWinError(NTResult); + if WinError <> ERROR_SUCCESS then + raise EJclSecurityError.CreateResFmt(@RsLsaError, [NTResult, SysErrorMessage(WinError)]); + end; +end; + +function GetComputerSID(SID: PSID; cbSID: DWORD): Boolean; +var + ObjectAttributes: TLsaObjectAttributes; + PolicyHandle: TLsaHandle; + Info: PPolicyAccountDomainInfo; +begin + if IsWinNT then + begin + ZeroMemory(@ObjectAttributes,SizeOf(ObjectAttributes)); + + {$IFDEF FPC} + PolicyHandle := 0; + {$ENDIF FPC} + LsaNTCheck(LsaOpenPolicy(nil, // Use local system + ObjectAttributes, //Object attributes. + POLICY_VIEW_LOCAL_INFORMATION, // We're just looking + PolicyHandle)); //Receives the policy handle. + try + Info := nil; + LsaNTCheck(LsaQueryInformationPolicy(PolicyHandle, PolicyAccountDomainInformation, + Pointer(Info))); + try + Result := CopySid(cbSID,SID,Info^.DomainSid); + finally + LsaFreeMemory(Info); + end; + finally + LsaClose(PolicyHandle); + end; + end + else + Result := False; // Win9x +end; + +//=== Windows Vista/Server 2008 UAC (User Account Control) =================== + +function IsUACEnabled: Boolean; +begin + Result := JclCheckWinVersion(6, 0) and + RegReadBoolDef(HKLM, '\Software\Microsoft\Windows\CurrentVersion\Policies\System', 'EnableLUA', False); +end; + +// source: Vista elevator from the Code Project +function IsElevated: Boolean; +const + TokenElevation = TTokenInformationClass(20); +type + TOKEN_ELEVATION = record + TokenIsElevated: DWORD; + end; +var + TokenHandle: THandle; + ResultLength: Cardinal; + ATokenElevation: TOKEN_ELEVATION; +begin + if JclCheckWinVersion(6, 0) then + begin + TokenHandle := 0; + if OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, TokenHandle) then + begin + try + ResultLength := 0; + if GetTokenInformation(TokenHandle, TokenElevation, @ATokenElevation, SizeOf(ATokenElevation), ResultLength) then + Result := ATokenElevation.TokenIsElevated <> 0 + else + Result := False; + finally + CloseHandle(TokenHandle); + end; + end + else + Result := False; + end + else + Result := IsAdministrator; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/JclShell.pas b/3rdParty/JCL/source/windows/JclShell.pas index 6ff950fb..c17fa09e 100644 --- a/3rdParty/JCL/source/windows/JclShell.pas +++ b/3rdParty/JCL/source/windows/JclShell.pas @@ -1,1634 +1,1634 @@ -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is JclShell.pas. } -{ } -{ The Initial Developers of the Original Code are Marcel van Brakel and Petr Vones. } -{ Portions created by these individuals are Copyright (C) of these individuals. } -{ All Rights Reserved. } -{ } -{ Contributor(s): } -{ Rik Barker (rikbarker) } -{ Marcel van Brakel } -{ Jean-Fabien Connault (cycocrew) } -{ Aleksej Kudinov } -{ Robert Marquardt (marquardt) } -{ Robert Rossmair (rrossmair) } -{ Olivier Sannier (obones) } -{ Matthias Thoma (mthoma) } -{ Petr Vones (pvones) } -{ kogerbnz } -{ Florent Ouchet (outchy) } -{ } -{**************************************************************************************************} -{ } -{ This unit contains routines and classes which makes working with the Windows Shell a bit easier. } -{ Included are routines for working with PIDL's, special folder's, file and folder manipulation } -{ through shell interfaces, shortcut's and program execution. } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -unit JclShell; - -{$I jcl.inc} -{$I windowsonly.inc} - -interface - -uses - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - {$IFDEF HAS_UNITSCOPE} - Winapi.Windows, System.SysUtils, System.Classes, Winapi.ShlObj, - {$ELSE ~HAS_UNITSCOPE} - Windows, SysUtils, Classes, ShlObj, - {$ENDIF ~HAS_UNITSCOPE} - JclBase, JclWin32, JclSysUtils; - -// Files and Folders -type - TSHDeleteOption = (doSilent, doAllowUndo, doFilesOnly); - TSHDeleteOptions = set of TSHDeleteOption; - TSHRenameOption = (roSilent, roRenameOnCollision); - TSHRenameOptions = set of TSHRenameOption; - TSHCopyOption = (coSilent, coAllowUndo, coFilesOnly, coNoConfirmation); - TSHCopyOptions = set of TSHCopyOption; - TSHMoveOption = (moSilent, moAllowUndo, moFilesOnly, moNoConfirmation); - TSHMoveOptions = set of TSHMoveOption; - -function SHDeleteFiles(Parent: THandle; const Files: string; Options: TSHDeleteOptions): Boolean; -function SHDeleteFolder(Parent: THandle; const Folder: string; Options: TSHDeleteOptions): Boolean; -function SHRenameFile(const Src, Dest: string; Options: TSHRenameOptions): Boolean; -function SHCopy(Parent: THandle; const Src, Dest: string; Options: TSHCopyOptions): Boolean; -function SHMove(Parent: THandle; const Src, Dest: string; Options: TSHMoveOptions): Boolean; - -type - TEnumFolderFlag = (efFolders, efNonFolders, efIncludeHidden); - TEnumFolderFlags = set of TEnumFolderFlag; - - TEnumFolderRec = record - DisplayName: string; - Attributes: DWORD; - IconLarge: HICON; - IconSmall: HICON; - Item: PItemIdList; - EnumIdList: IEnumIdList; - Folder: IShellFolder; - end; - -function SHEnumFolderFirst(const Folder: string; Flags: TEnumFolderFlags; - var F: TEnumFolderRec): Boolean; -function SHEnumSpecialFolderFirst(SpecialFolder: DWORD; Flags: TEnumFolderFlags; - var F: TEnumFolderRec): Boolean; -procedure SHEnumFolderClose(var F: TEnumFolderRec); -function SHEnumFolderNext(var F: TEnumFolderRec): Boolean; - -function GetSpecialFolderLocation(const FolderID: Integer): string; - -function DisplayPropDialog(const Handle: THandle; const FileName: string): Boolean; overload; -function DisplayPropDialog(const Handle: THandle; Item: PItemIdList): Boolean; overload; - -function DisplayContextMenuPidl(const Handle: THandle; const Folder: IShellFolder; - Item: PItemIdList; Pos: TPoint): Boolean; -function DisplayContextMenu(const Handle: THandle; const FileName: string; - Pos: TPoint): Boolean; - -function OpenFolder(const Path: string; Parent: THandle = 0; Explore: Boolean = False): Boolean; -function OpenSpecialFolder(FolderID: Integer; Parent: THandle = 0; Explore: Boolean = False): Boolean; - -// Memory Management -function SHReallocMem(var P: Pointer; Count: Integer): Boolean; -function SHAllocMem(out P: Pointer; Count: Integer): Boolean; -function SHGetMem(var P: Pointer; Count: Integer): Boolean; -function SHFreeMem(var P: Pointer): Boolean; - -// Paths and PIDLs -function DriveToPidlBind(const DriveName: string; out Folder: IShellFolder): PItemIdList; -function PathToPidl(const Path: string; Folder: IShellFolder): PItemIdList; -function PathToPidlBind(const FileName: string; out Folder: IShellFolder): PItemIdList; -function PidlBindToParent(IdList: PItemIdList; out Folder: IShellFolder; out Last: PItemIdList): Boolean; -function PidlCompare(Pidl1, Pidl2: PItemIdList): Boolean; -function PidlCopy(Source: PItemIdList; out Dest: PItemIdList): Boolean; -function PidlFree(var IdList: PItemIdList): Boolean; -function PidlGetDepth(Pidl: PItemIdList): Integer; -function PidlGetLength(Pidl: PItemIdList): Integer; -function PidlGetNext(Pidl: PItemIdList): PItemIdList; -function PidlToPath(IdList: PItemIdList): string; - -function StrRetFreeMem(StrRet: TStrRet): Boolean; -function StrRetToString(IdList: PItemIdList; StrRet: TStrRet; Free: Boolean): string; - -// Shortcuts / Shell link -type - PShellLink = ^TShellLink; - TShellLink = record - Arguments: string; - ShowCmd: Integer; - WorkingDirectory: string; - IdList: PItemIDList; - Target: string; - Description: string; - IconLocation: string; - IconIndex: Integer; - HotKey: Word; // Use ShellLinkShortCut() to convert it to a TShortCut - end; - -procedure ShellLinkFree(var Link: TShellLink); -function ShellLinkResolve(const FileName: string; out Link: TShellLink): HRESULT; overload; -function ShellLinkResolve(const FileName: string; out Link: TShellLink; - const ResolveFlags: Cardinal): HRESULT; overload; -function ShellLinkCreate(const Link: TShellLink; const FileName: string): HRESULT; -function ShellLinkCreateSystem(const Link: TShellLink; const Folder: Integer; const FileName: string): HRESULT; -function ShellLinkIcon(const Link: TShellLink): HICON; overload; -function ShellLinkIcon(const FileName: string): HICON; overload; -function ShellLinkShortCut(const Link: TShellLink): TShortCut; - -// Miscellaneous -function SHDllGetVersion(const FileName: string; var Version: TDllVersionInfo): Boolean; - -function GetSystemIcon(IconIndex: Integer; Flags: Cardinal): HICON; -function OverlayIcon(var Icon: HICON; Overlay: HICON; Large: Boolean): Boolean; -function OverlayIconShortCut(var Large, Small: HICON): Boolean; -function OverlayIconShared(var Large, Small: HICON): Boolean; -function SHGetItemInfoTip(const Folder: IShellFolder; Item: PItemIdList): string; - -function ShellExecEx(const FileName: string; const Parameters: string = ''; const Verb: string = ''; - CmdShow: Integer = SW_SHOWNORMAL): Boolean; -function ShellExec(Wnd: Integer; const Operation, FileName, Parameters, Directory: string; ShowCommand: Integer): Boolean; -function ShellExecAndWait(const FileName: string; const Parameters: string = ''; const Verb: string = ''; - CmdShow: Integer = SW_SHOWNORMAL; const Directory: string = ''): Boolean; - -function ShellOpenAs(const FileName: string): Boolean; -function ShellRasDial(const EntryName: string): Boolean; -function ShellRunControlPanel(const NameOrFileName: string; AppletNumber: Integer = 0): Boolean; - -function RunAsAdmin(const FileName: string; const Parameters: string = ''; const Parent: THandle = 0): Boolean; - -function GetFileNameIcon(const FileName: string; Flags: Cardinal = 0): HICON; - -type - TJclFileExeType = (etError, etMsDos, etWin16, etWin32Gui, etWin32Con); - -function GetFileExeType(const FileName: TFileName): TJclFileExeType; - -function ShellFindExecutable(const FileName, DefaultDir: string): string; - -//MSI functions and types used in ShellLinkResolve - copied from JwaMsi.pas -type - INSTALLSTATE = Longint; -const - MSILIB = 'msi.dll'; - GetShortcutTargetName = 'MsiGetShortcutTarget' + AWSuffix; - GetComponentPathName = 'MsiGetComponentPath' + AWSuffix; -var - // MSI.DLL functions can''t be converted to Unicode due to an internal compiler bug (F2084 Internal Error: URW1021) - RtdlMsiLibHandle: TModuleHandle = INVALID_MODULEHANDLE_VALUE; - RtdlMsiGetShortcutTarget: function(szShortcutPath: LPCTSTR; szProductCode: LPTSTR; - szFeatureId: LPTSTR; szComponentCode: LPTSTR): UINT stdcall = nil; - - RtdlMsiGetComponentPath: function(szProduct: LPCTSTR; szComponent: LPCTSTR; - lpPathBuf: LPTSTR; pcchBuf: LPDWORD): INSTALLSTATE stdcall = nil; - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\windows'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -uses - {$IFDEF HAS_UNITSCOPE} - Winapi.ActiveX, Winapi.CommCtrl, Winapi.Messages, Winapi.ShellAPI, - {$ELSE ~HAS_UNITSCOPE} - ActiveX, CommCtrl, Messages, ShellAPI, - {$ENDIF ~HAS_UNITSCOPE} - JclFileUtils, JclStrings, JclSysInfo; - -type - TWidePath = array [0..MAX_PATH-1] of WideChar; - {$IFDEF SUPPORTS_UNICODE} - TWidePathPtr = PWideChar; - {$ELSE ~SUPPORTS_UNICODE} - TWidePathPtr = TWidePath; - {$ENDIF ~SUPPORTS_UNICODE} - -const - cVerbProperties = 'properties'; - cVerbOpen = 'open'; - cVerbExplore = 'explore'; - cVerbRunas = 'runas'; - -//=== Files and Folders ====================================================== - -// Helper function and constant to map a TSHDeleteOptions set to a Cardinal - -const - FOF_COMPLETELYSILENT = FOF_SILENT or FOF_NOCONFIRMATION or FOF_NOERRORUI or FOF_NOCONFIRMMKDIR; - -function DeleteOptionsToCardinal(Options: TSHDeleteOptions): Cardinal; -begin - Result := 0; - if doSilent in Options then - Result := Result or FOF_COMPLETELYSILENT; - if doAllowUndo in Options then - Result := Result or FOF_ALLOWUNDO; - if doFilesOnly in Options then - Result := Result or FOF_FILESONLY; -end; - -function SHDeleteFiles(Parent: THandle; const Files: string; - Options: TSHDeleteOptions): Boolean; -var - FileOp: TSHFileOpStruct; - Source: string; -begin - ResetMemory(FileOp, SizeOf(FileOp)); - with FileOp do - begin - Wnd := Parent; - wFunc := FO_DELETE; - Source := Files + #0#0; - pFrom := PChar(Source); - fFlags := DeleteOptionsToCardinal(Options); - end; - Result := SHFileOperation(FileOp) = 0; -end; - -function SHDeleteFolder(Parent: THandle; const Folder: string; - Options: TSHDeleteOptions): Boolean; -begin - Exclude(Options, doFilesOnly); - Result := SHDeleteFiles(Parent, PathAddSeparator(Folder) + '*.*', Options); - if Result then - Result := SHDeleteFiles(Parent, PathRemoveSeparator(Folder), Options); -end; - -// Helper function to map a TSHRenameOptions set to a cardinal - -function RenameOptionsToCardinal(Options: TSHRenameOptions): Cardinal; -begin - Result := 0; - if roRenameOnCollision in Options then - Result := Result or FOF_RENAMEONCOLLISION; - if roSilent in Options then - Result := Result or FOF_COMPLETELYSILENT; -end; - -function SHRenameFile(const Src, Dest: string; Options: TSHRenameOptions): Boolean; -var - FileOp: TSHFileOpStruct; - Source, Destination: string; -begin - ResetMemory(FileOp, SizeOf(FileOp)); - with FileOp do - begin - Wnd := GetDesktopWindow; - wFunc := FO_RENAME; - Source := Src + #0#0; - Destination := Dest + #0#0; - pFrom := PChar(Source); - pTo := PChar(Destination); - fFlags := RenameOptionsToCardinal(Options); - end; - Result := SHFileOperation(FileOp) = 0; -end; - -function CopyOptionsToCardinal(Options: TSHCopyOptions): Cardinal; -begin - Result := 0; - if coSilent in Options then - Result := Result or FOF_SILENT; - if coAllowUndo in Options then - Result := Result or FOF_ALLOWUNDO; - if coFilesOnly in Options then - Result := Result or FOF_FILESONLY; - if coNoConfirmation in Options then - Result := Result or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR; -end; - -function SHCopy(Parent: THandle; const Src, Dest: string; Options: TSHCopyOptions): Boolean; -var - FileOp: TSHFileOpStruct; - Source, Destination: string; -begin - ResetMemory(FileOp, SizeOf(FileOp)); - FileOp.Wnd := Parent; - FileOp.wFunc := FO_COPY; - Source := Src + #0#0; - Destination := Dest + #0#0; - FileOp.pFrom := PChar(Source); - FileOp.pTo := PChar(Destination); - FileOp.fFlags := CopyOptionsToCardinal(Options); - Result := SHFileOperation(FileOp) = 0; -end; - -function MoveOptionsToCardinal(Options: TSHMoveOptions): Cardinal; -begin - Result := 0; - if moSilent in Options then - Result := Result or FOF_SILENT; - if moAllowUndo in Options then - Result := Result or FOF_ALLOWUNDO; - if moFilesOnly in Options then - Result := Result or FOF_FILESONLY; - if moNoConfirmation in Options then - Result := Result or FOF_NOCONFIRMATION; -end; - -function SHMove(Parent: THandle; const Src, Dest: string; Options: TSHMoveOptions): Boolean; -var - FileOp: TSHFileOpStruct; - Source, Destination: string; -begin - ResetMemory(FileOp, SizeOf(FileOp)); - FileOp.Wnd := Parent; - FileOp.wFunc := FO_MOVE; - Source := Src + #0#0; - Destination := Dest + #0#0; - FileOp.pFrom := PChar(Source); - FileOp.pTo := PChar(Destination); - FileOp.fFlags := MoveOptionsToCardinal(Options); - Result := SHFileOperation(FileOp) = 0; -end; - -function EnumFolderFlagsToCardinal(Flags: TEnumFolderFlags): Cardinal; -begin - Result := 0; - if efFolders in Flags then - Result := Result or SHCONTF_FOLDERS; - if efNonFolders in Flags then - Result := Result or SHCONTF_NONFOLDERS; - if efIncludeHidden in Flags then - Result := Result or SHCONTF_INCLUDEHIDDEN; -end; - -procedure ClearEnumFolderRec(var F: TEnumFolderRec; const Free, Release: Boolean); -begin - if Release then - begin - F.EnumIdList := nil; - F.Folder := nil; - end; - if Free then - begin - PidlFree(F.Item); - DestroyIcon(F.IconLarge); - DestroyIcon(F.IconSmall); - end; - F.Attributes := 0; - F.Item := nil; - F.IconLarge := 0; - F.IconSmall := 0; -end; - -procedure SHEnumFolderClose(var F: TEnumFolderRec); -begin - ClearEnumFolderRec(F, True, True); -end; - -function SHEnumFolderNext(var F: TEnumFolderRec): Boolean; -const - Attr = Cardinal(SFGAO_CAPABILITYMASK or SFGAO_DISPLAYATTRMASK or SFGAO_CONTENTSMASK); -var - DisplayNameRet: TStrRet; - ItemsFetched: ULONG; - ExtractIcon: IExtractIcon; - IconFile: TWidePath; - IconIndex: Integer; - Flags: DWORD; -begin - Result := False; - ClearEnumFolderRec(F, True, False); - if (F.EnumIdList = nil) or (F.Folder = nil) then - Exit; - ItemsFetched := 0; - if F.EnumIdList.Next(1, F.Item, ItemsFetched) = NO_ERROR then - begin - DisplayNameRet.utype := 0; - F.Folder.GetDisplayNameOf(F.Item, SHGDN_INFOLDER, DisplayNameRet); - F.DisplayName := StrRetToString(F.Item, DisplayNameRet, True); - F.Attributes := Attr; - F.Folder.GetAttributesOf(1, F.Item, F.Attributes); - F.Folder.GetUIObjectOf(0, 1, F.Item, IID_IExtractIconW, nil, - Pointer(ExtractIcon)); - Flags := 0; - F.IconLarge := 0; - F.IconSmall := 0; - - if Assigned(ExtractIcon) then - begin - IconIndex := 0; - ExtractIcon.GetIconLocation(0, @IconFile, MAX_PATH, IconIndex, Flags); - if (IconIndex < 0) or ((Flags and GIL_NOTFILENAME) = 0) then - ExtractIconEx(@IconFile, IconIndex, F.IconLarge, F.IconSmall, 1) - else - ExtractIcon.Extract(@IconFile, IconIndex, F.IconLarge, F.IconSmall, - MakeLong(32, 16)); - end; - - Result := True; - end; -end; - -function SHEnumSpecialFolderFirst(SpecialFolder: DWORD; Flags: TEnumFolderFlags; - var F: TEnumFolderRec): Boolean; -var - DesktopFolder: IShellFolder; - FolderPidl: PItemIdList; -begin - ClearEnumFolderRec(F, False, False); - Result := Succeeded(SHGetDesktopFolder(DesktopFolder)); - if Result then - begin - if SpecialFolder = CSIDL_DESKTOP then - F.Folder := DesktopFolder - else - begin - Result := Succeeded(SHGetSpecialFolderLocation(0, SpecialFolder, FolderPidl)); - if Result then - begin - try - Result := Succeeded(DesktopFolder.BindToObject(FolderPidl, nil, IID_IShellFolder, Pointer(F.Folder))); - finally - CoTaskMemFree(FolderPidl); - end; - end; - end; - end; - if Result then - begin - F.Folder.EnumObjects(0, EnumFolderFlagsToCardinal(Flags), F.EnumIdList); - Result := SHEnumFolderNext(F); - if not Result then - SHEnumFolderClose(F); - end; -end; - -function SHEnumFolderFirst(const Folder: string; Flags: TEnumFolderFlags; - var F: TEnumFolderRec): Boolean; -var - DesktopFolder: IShellFolder; - FolderPidl: PItemIdList; -begin - ClearEnumFolderRec(F, False, False); - SHGetDesktopFolder(DesktopFolder); - FolderPidl := PathToPidl(PathAddSeparator(Folder), DesktopFolder); - try - DesktopFolder.BindToObject(FolderPidl, nil, IID_IShellFolder, Pointer(F.Folder)); - F.Folder.EnumObjects(0, EnumFolderFlagsToCardinal(Flags), F.EnumIdList); - Result := SHEnumFolderNext(F); - if not Result then - SHEnumFolderClose(F); - finally - PidlFree(FolderPidl); - end; -end; - -function GetSpecialFolderLocation(const FolderID: Integer): string; -var - FolderPidl: PItemIdList; -begin - if Succeeded(SHGetSpecialFolderLocation(0, FolderID, FolderPidl)) then - begin - Result := PidlToPath(FolderPidl); - CoTaskMemFree(FolderPidl); - end - else - Result := ''; -end; - -function DisplayPropDialog(const Handle: THandle; const FileName: string): Boolean; -var - Info: TShellExecuteInfo; -begin - ResetMemory(Info, SizeOf(Info)); - with Info do - begin - cbSize := SizeOf(Info); - lpFile := PChar(FileName); - nShow := SW_SHOW; - fMask := SEE_MASK_INVOKEIDLIST; - Wnd := Handle; - lpVerb := cVerbProperties; - end; - {$TYPEDADDRESS ON} // need this because ShellExecuteEx is overloaded in FPC -A -W - Result := ShellExecuteEx(@Info); - {$IFNDEF TYPEDADDRESS_ON} - {$TYPEDADDRESS OFF} - {$ENDIF ~TYPEDADDRESS_ON} -end; - -function DisplayPropDialog(const Handle: THandle; Item: PItemIdList): Boolean; -var - Info: TShellExecuteInfo; -begin - ResetMemory(Info, SizeOf(Info)); - with Info do - begin - cbSize := SizeOf(Info); - nShow := SW_SHOW; - lpIDList := Item; - fMask := SEE_MASK_INVOKEIDLIST or SEE_MASK_IDLIST; - Wnd := Handle; - lpVerb := cVerbProperties; - end; - {$TYPEDADDRESS ON} - Result := ShellExecuteEx(@Info); - {$IFNDEF TYPEDADDRESS_ON} - {$TYPEDADDRESS OFF} - {$ENDIF ~TYPEDADDRESS_ON} -end; - -// Window procedure for the callback window created by DisplayContextMenu. -// It simply forwards messages to the folder. If you don't do this then the -// system created submenu's will be empty (except for 1 stub item!) -// note: storing the IContextMenu2 pointer in the window's user data was -// 'inspired' by (read: copied from) code by Brad Stowers. - -function MenuCallback(Wnd: THandle; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; -var - ContextMenu2: IContextMenu2; -begin - case Msg of - WM_CREATE: - begin - ContextMenu2 := IContextMenu2(PCreateStruct(lParam).lpCreateParams); - SetWindowLongPtr(Wnd, GWLP_USERDATA, LONG_PTR(ContextMenu2)); - Result := DefWindowProc(Wnd, Msg, wParam, lParam); - end; - WM_INITMENUPOPUP: - begin - ContextMenu2 := IContextMenu2(GetWindowLongPtr(Wnd, GWLP_USERDATA)); - ContextMenu2.HandleMenuMsg(Msg, wParam, lParam); - Result := 0; - end; - WM_DRAWITEM, WM_MEASUREITEM: - begin - ContextMenu2 := IContextMenu2(GetWindowLongPtr(Wnd, GWLP_USERDATA)); - ContextMenu2.HandleMenuMsg(Msg, wParam, lParam); - Result := 1; - end; - else - Result := DefWindowProc(Wnd, Msg, wParam, lParam); - end; -end; - -// Helper function for DisplayContextMenu, creates the callback window. - -function CreateMenuCallbackWnd(const ContextMenu: IContextMenu2): THandle; -const - IcmCallbackWnd = 'ICMCALLBACKWND'; -var - WndClass: TWndClass; -begin - ResetMemory(WndClass, SizeOf(WndClass)); - WndClass.lpszClassName := PChar(IcmCallbackWnd); - WndClass.lpfnWndProc := @MenuCallback; - WndClass.hInstance := HInstance; - {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.RegisterClass(WndClass); - Result := CreateWindow(IcmCallbackWnd, IcmCallbackWnd, WS_POPUPWINDOW, 0, - 0, 0, 0, 0, 0, HInstance, Pointer(ContextMenu)); -end; - -function DisplayContextMenuPidl(const Handle: THandle; const Folder: IShellFolder; - Item: PItemIdList; Pos: TPoint): Boolean; -var - Cmd: Cardinal; - ContextMenu: IContextMenu; - ContextMenu2: IContextMenu2; - Menu: HMENU; - CommandInfo: TCMInvokeCommandInfo; - CallbackWindow: THandle; -begin - Result := False; - if (Item = nil) or (Folder = nil) then - Exit; - Folder.GetUIObjectOf(Handle, 1, Item, IID_IContextMenu, nil, - Pointer(ContextMenu)); - if ContextMenu <> nil then - begin - Menu := CreatePopupMenu; - if Menu <> 0 then - begin - if Succeeded(ContextMenu.QueryContextMenu(Menu, 0, 1, $7FFF, CMF_EXPLORE)) then - begin - CallbackWindow := 0; - if Succeeded(ContextMenu.QueryInterface(IContextMenu2, ContextMenu2)) then - begin - CallbackWindow := CreateMenuCallbackWnd(ContextMenu2); - end; - ClientToScreen(Handle, Pos); - Cmd := Cardinal(TrackPopupMenu(Menu, TPM_LEFTALIGN or TPM_LEFTBUTTON or - TPM_RIGHTBUTTON or TPM_RETURNCMD, Pos.X, Pos.Y, 0, CallbackWindow, nil)); - if Cmd <> 0 then - begin - ResetMemory(CommandInfo, SizeOf(CommandInfo)); - CommandInfo.cbSize := SizeOf(TCMInvokeCommandInfo); - CommandInfo.hwnd := Handle; - CommandInfo.lpVerb := MakeIntResourceA(Cmd - 1); - CommandInfo.nShow := SW_SHOWNORMAL; - Result := Succeeded(ContextMenu.InvokeCommand(CommandInfo)); - end; - if CallbackWindow <> 0 then - DestroyWindow(CallbackWindow); - end; - DestroyMenu(Menu); - end; - end; -end; - -function DisplayContextMenu(const Handle: THandle; const FileName: string; - Pos: TPoint): Boolean; -var - ItemIdList: PItemIdList; - Folder: IShellFolder; -begin - Result := False; - ItemIdList := PathToPidlBind(FileName, Folder); - if ItemIdList <> nil then - begin - Result := DisplayContextMenuPidl(Handle, Folder, ItemIdList, Pos); - PidlFree(ItemIdList); - end; -end; - -function OpenFolder(const Path: string; Parent: THandle; Explore: Boolean): Boolean; -var - Sei: TShellExecuteInfo; -begin - Result := False; - if IsDirectory(Path) then - begin - ResetMemory(Sei, SizeOf(Sei)); - with Sei do - begin - cbSize := SizeOf(Sei); - Wnd := Parent; - if Explore then - lpVerb := cVerbExplore - else - lpVerb := cVerbOpen; - lpFile := PChar(Path); - nShow := SW_SHOWNORMAL; - end; - {$TYPEDADDRESS ON} - Result := ShellExecuteEx(@Sei); - {$IFNDEF TYPEDADDRESS_ON} - {$TYPEDADDRESS OFF} - {$ENDIF ~TYPEDADDRESS_ON} - end; -end; - -function OpenSpecialFolder(FolderID: Integer; Parent: THandle; Explore: Boolean): Boolean; -var - Pidl: PItemIDList; - Sei: TShellExecuteInfo; -begin - Result := False; - if Succeeded(SHGetSpecialFolderLocation(Parent, FolderID, Pidl)) then - begin - ResetMemory(Sei, SizeOf(Sei)); - with Sei do - begin - cbSize := SizeOf(Sei); - Wnd := Parent; - fMask := SEE_MASK_INVOKEIDLIST; - if Explore then - lpVerb := cVerbExplore - else - lpVerb := cVerbOpen; - lpIDList := Pidl; - nShow := SW_SHOWNORMAL; - if PidlToPath(Pidl) = '' then - begin - fMask := SEE_MASK_INVOKEIDLIST; - lpIDList := Pidl; - end - else - lpFile := PChar(PidlToPath(Pidl)); - end; - {$TYPEDADDRESS ON} - Result := ShellExecuteEx(@Sei); - {$IFNDEF TYPEDADDRESS_ON} - {$TYPEDADDRESS OFF} - {$ENDIF ~TYPEDADDRESS_ON} - CoTaskMemFree(Pidl); - end; -end; - -//=== Memory Management ====================================================== - -function SHAllocMem(out P: Pointer; Count: Integer): Boolean; -var - Malloc: IMalloc; -begin - Result := False; - P := nil; - if Succeeded(SHGetMalloc(Malloc)) then - begin - P := Malloc.Alloc(Count); - if P <> nil then - begin - ResetMemory(P^, Count); - Result := True; - end; - end; -end; - -function SHFreeMem(var P: Pointer): Boolean; -var - Malloc: IMalloc; -begin - Result := False; - if P <> nil then - begin - if Succeeded(SHGetMalloc(Malloc)) and (Malloc.DidAlloc(P) > 0) then - begin - Malloc.Free(P); - P := nil; - Result := True; - end; - end; -end; - -function SHGetMem(var P: Pointer; Count: Integer): Boolean; -var - Malloc: IMalloc; -begin - Result := False; - if Succeeded(SHGetMalloc(Malloc)) then - begin - P := Malloc.Alloc(Count); - if P <> nil then - Result := True; - end; -end; - -function SHReallocMem(var P: Pointer; Count: Integer): Boolean; -var - Malloc: IMalloc; -begin - Result := False; - if Succeeded(SHGetMalloc(Malloc)) then - begin - if (P <> nil) and (Malloc.DidAlloc(P) <= 0) then - Exit; - P := Malloc.ReAlloc(P, Count); - Result := (P <> nil) or (Count = 0); - end; -end; - -//=== Paths and PIDLs ======================================================== - -function DriveToPidlBind(const DriveName: string; out Folder: IShellFolder): PItemIdList; -var - Attr: ULONG; - Eaten: ULONG; - DesktopFolder: IShellFolder; - Drives: PItemIdList; - Path: TWidePathPtr; -begin - Result := nil; - if Succeeded(SHGetDesktopFolder(DesktopFolder)) then - begin - if Succeeded(SHGetSpecialFolderLocation(0, CSIDL_DRIVES, Drives)) then - begin - if Succeeded(DesktopFolder.BindToObject(Drives, nil, IID_IShellFolder, - Pointer(Folder))) then - begin - {$IFDEF SUPPORTS_UNICODE} - Path := PChar(PathAddSeparator(DriveName)); - {$ELSE ~SUPPORTS_UNICODE} - MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PAnsiChar(PathAddSeparator(DriveName)), -1, Path, MAX_PATH); - {$ENDIF ~SUPPORTS_UNICODE} - Attr := 0; - if Failed(Folder.ParseDisplayName(0, nil, Path, Eaten, Result, Attr)) then - begin - Folder := nil; - // Failure probably means that this is not a drive. However, do not - // call PathToPidlBind() because it may cause infinite recursion. - end; - end; - end; - CoTaskMemFree(Drives); - end; -end; - -function PathToPidl(const Path: string; Folder: IShellFolder): PItemIdList; -var - DesktopFolder: IShellFolder; - CharsParsed, Attr: ULONG; - WidePath: TWidePathPtr; -begin - Result := nil; - {$IFDEF SUPPORTS_UNICODE} - WidePath := PChar(Path); - {$ELSE ~SUPPORTS_UNICODE} - MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PAnsiChar(Path), -1, WidePath, MAX_PATH); - {$ENDIF ~SUPPORTS_UNICODE} - Attr := 0; - if Folder <> nil then - Folder.ParseDisplayName(0, nil, WidePath, CharsParsed, Result, Attr) - else - if Succeeded(SHGetDesktopFolder(DesktopFolder)) then - DesktopFolder.ParseDisplayName(0, nil, WidePath, CharsParsed, Result, Attr); -end; - -function PathToPidlBind(const FileName: string; out Folder: IShellFolder): PItemIdList; -var - Attr, Eaten: ULONG; - PathIdList: PItemIdList; - DesktopFolder: IShellFolder; - Path, ItemName: TWidePathPtr; -begin - Result := nil; - {$IFDEF SUPPORTS_UNICODE} - Path := PChar(ExtractFilePath(FileName)); - ItemName := PChar(ExtractFileName(FileName)); - {$ELSE ~SUPPORTS_UNICODE} - MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PAnsiChar(ExtractFilePath(FileName)), -1, Path, MAX_PATH); - MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PAnsiChar(ExtractFileName(FileName)), -1, ItemName, MAX_PATH); - {$ENDIF ~SUPPORTS_UNICODE} - if Succeeded(SHGetDesktopFolder(DesktopFolder)) then - begin - Attr := 0; - if Succeeded(DesktopFolder.ParseDisplayName(0, nil, Path, Eaten, PathIdList, - Attr)) then - begin - if Succeeded(DesktopFolder.BindToObject(PathIdList, nil, IID_IShellFolder, - Pointer(Folder))) then - begin - if Failed(Folder.ParseDisplayName(0, nil, ItemName, Eaten, Result, Attr)) then - begin - Folder := nil; - Result := DriveToPidlBind(FileName, Folder); - end; - end; - PidlFree(PathIdList); - end - else - Result := DriveToPidlBind(FileName, Folder); - end; -end; - -function PidlBindToParent(IdList: PItemIdList; out Folder: IShellFolder; out Last: PItemIdList): Boolean; -var - Path: string; -begin - Last := nil; - Path := PidlToPath(IdList); - Last := PathToPidlBind(Path, Folder); - Result := Last <> nil; - if Last = nil then - Folder := nil; -end; - -function PidlCompare(Pidl1, Pidl2: PItemIdList): Boolean; -var - L: Integer; -begin - Result := False; - L := PidlGetLength(Pidl1); - if L = PidlGetLength(Pidl2) then - Result := CompareMem(Pidl1, Pidl2, L); -end; - -function PidlCopy(Source: PItemIdList; out Dest: PItemIdList): Boolean; -var - L: Integer; -begin - Result := False; - Dest := Source; - if Source <> nil then - begin - L := PidlGetLength(Source) + 2; - if SHAllocMem(Pointer(Dest), L) then - begin - Move(Source^, Dest^, L); - Result := True; - end; - end; -end; - -function PidlFree(var IdList: PItemIdList): Boolean; -var - Malloc: IMalloc; -begin - Result := False; - if IdList = nil then - Result := True - else - begin - Malloc := nil; - if Succeeded(SHGetMalloc(Malloc)) and (Malloc.DidAlloc(IdList) > 0) then - begin - Malloc.Free(IdList); - IdList := nil; - Result := True; - end; - end; -end; - -function PidlGetDepth(Pidl: PItemIdList): Integer; -var - P: PItemIdList; -begin - Result := 0; - if Pidl <> nil then - begin - P := Pidl; - while (P^.mkId.cb <> 0) and (Result < MAX_PATH) do - begin - Inc(Result); - P := PItemIdList(@P^.mkId.abID[P^.mkId.cb - 2]); - end; - end; - if Result = MAX_PATH then - Result := -1; -end; - -function PidlGetLength(Pidl: PItemIdList): Integer; -var - P: PItemIdList; - I: Integer; -begin - Result := 0; - if Pidl <> nil then - begin - I := 0; - P := Pidl; - while (P^.mkId.cb <> 0) and (I < MAX_PATH) do - begin - Inc(I); - Inc(Result, P^.mkId.cb); - P := PItemIdList(@P^.mkId.abID[P^.mkId.cb - 2]); - end; - if I = MAX_PATH then - Result := -1; - end; -end; - -function PidlGetNext(Pidl: PItemIdList): PItemIdList; -begin - Result := nil; - if (Pidl <> nil) and (Pidl^.mkid.cb <> 0) then - begin - Result := PItemIdList(@Pidl^.mkId.abID[Pidl^.mkId.cb - 2]); - if Result^.mkid.cb = 0 then - Result := nil; - end; -end; - -function PidlToPath(IdList: PItemIdList): string; -begin - SetLength(Result, MAX_PATH); - if SHGetPathFromIdList(IdList, PChar(Result)) then - StrResetLength(Result) - else - Result := ''; -end; - -function StrRetFreeMem(StrRet: TStrRet): Boolean; -begin - Result := False; - if StrRet.uType = STRRET_WSTR then - Result := SHFreeMem(Pointer(StrRet.pOleStr)); -end; - -function StrRetToString(IdList: PItemIdList; StrRet: TStrRet; Free: Boolean): string; -begin - case StrRet.uType of - STRRET_WSTR: - begin - Result := WideCharToString(StrRet.pOleStr); - if Free then - SHFreeMem(Pointer(StrRet.pOleStr)); - end; - STRRET_OFFSET: - if IdList <> nil then - Result := PChar(IdList) + StrRet.uOffset - else - Result := ''; - STRRET_CSTR: - Result := string(AnsiString(StrRet.cStr)); - else - Result := ''; - end; -end; - -//=== ShortCuts / Shell link ================================================= - -procedure ShellLinkFree(var Link: TShellLink); -begin - PidlFree(Link.IdList); -end; - -const - {$IFDEF SUPPORTS_UNICODE} - IID_IShellLink: TGUID = { IID_IShellLinkW } - (D1:$000214F9; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46)); - {$ELSE ~SUPPORTS_UNICODE} - IID_IShellLink: TGUID = { IID_IShellLinkA } - (D1:$000214EE; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46)); - {$ENDIF ~SUPPORTS_UNICODE} - -function ShellLinkCreateSystem(const Link: TShellLink; const Folder: Integer; - const FileName: string): HRESULT; -var - Path: string; - Pidl: PItemIDList; -begin - Result := E_INVALIDARG; - SetLength(Path, MAX_PATH); - if Succeeded(SHGetSpecialFolderLocation(0, Folder, Pidl)) then - begin - try - Path := PidltoPath(Pidl); - if Path <> '' then - begin - StrResetLength(Path); - Result := ShellLinkCreate(Link, PathAddSeparator(Path) + FileName); - end; - finally - CoTaskMemFree(Pidl); - end; - end; -end; - -function ShellLinkCreate(const Link: TShellLink; const FileName: string): HRESULT; -var - ShellLink: IShellLink; - PersistFile: IPersistFile; - LinkName: TWidePathPtr; -begin - Result := CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, - IID_IShellLink, ShellLink); - if Succeeded(Result) then - begin - ShellLink.SetArguments(PChar(Link.Arguments)); - ShellLink.SetShowCmd(Link.ShowCmd); - ShellLink.SetWorkingDirectory(PChar(Link.WorkingDirectory)); - ShellLink.SetPath(PChar(Link.Target)); - ShellLink.SetDescription(PChar(Link.Description)); - ShellLink.SetHotkey(Link.HotKey); - ShellLink.SetIconLocation(PChar(Link.IconLocation), Link.IconIndex); - PersistFile := ShellLink as IPersistFile; - {$IFDEF SUPPORTS_UNICODE} - LinkName := PChar(FileName); - {$ELSE ~SUPPORTS_UNICODE} - MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PAnsiChar(FileName), -1, - LinkName, MAX_PATH); - {$ENDIF ~SUPPORTS_UNICODE} - Result := PersistFile.Save(LinkName, True); - end; -end; - -function RtdlLoadMsiFuncs:Boolean; -begin - Result:=False; - if LoadModule(rtdlMsiLibHandle,MSILIB) then - begin - if not Assigned(RtdlMsiGetShortcutTarget) then - RtdlMsiGetShortcutTarget := GetModuleSymbol(rtdlMsiLibHandle,GetShortcutTargetName); - - if not Assigned(RtdlMsiGetComponentPath) then - RtdlMsiGetComponentPath := GetModuleSymbol(rtdlMsiLibHandle,GetComponentPathName); - - Result:=(Assigned(RtdlMsiGetShortcutTarget)) and (Assigned(RtdlMsiGetComponentPath)); - end; -end; - -function ShellLinkResolve(const FileName: string; out Link: TShellLink): HRESULT; -begin - Result := ShellLinkResolve(FileName, Link, SLR_ANY_MATCH); -end; - -function ShellLinkResolve(const FileName: string; out Link: TShellLink; - const ResolveFlags: Cardinal): HRESULT; -const - MAX_FEATURE_CHARS = 38; // maximum chars in MSI feature name -var - ShellLink: IShellLink; - PersistFile: IPersistFile; - LinkName: TWidePathPtr; - Buffer: string; - Win32FindData: TWin32FindData; - FullPath: string; - ProductGuid: array [0..38] of Char; - FeatureID: array [0..MAX_FEATURE_CHARS] of Char; - ComponentGUID: array [0..38] of Char; - TargetFile: array [0..MAX_PATH] of Char; - PathSize: DWORD; - TargetResolved: Boolean; -begin - Result := CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, - IID_IShellLink, ShellLink); - - if Succeeded(Result) then - begin - TargetResolved := False; - - // Handle MSI style shortcuts without invoking the Windows installer if - // the feature was set to "Install on first use" - if RtdlLoadMsiFuncs then - begin - ResetMemory(ProductGuid, SizeOf(ProductGuid)); - ResetMemory(FeatureID, SizeOf(FeatureID)); - ResetMemory(ComponentGuid, SizeOf(ComponentGuid)); - ResetMemory(TargetFile, SizeOf(TargetFile)); - - if RtdlMsiGetShortcutTarget(PChar(FileName), ProductGuid, FeatureID, ComponentGuid) = ERROR_SUCCESS then - begin - PathSize := MAX_PATH + 1; - RtdlMsiGetComponentPath(ProductGuid, ComponentGuid, TargetFile, @PathSize); - - if TargetFile <> '' then - begin - Link.Target := TargetFile; - TargetResolved := True; - end; - end; - end; - - PersistFile := ShellLink as IPersistFile; - // PersistFile.Load fails if the filename is not fully qualified - FullPath := ExpandFileName(FileName); - {$IFDEF SUPPORTS_UNICODE} - LinkName := PWideChar(FullPath); - {$ELSE ~SUPPORTS_UNICODE} - MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PAnsiChar(FullPath), -1, LinkName, MAX_PATH); - {$ENDIF ~SUPPORTS_UNICODE} - Result := PersistFile.Load(LinkName, STGM_READ); - - if Succeeded(Result) then - begin - Result := ShellLink.Resolve(0, ResolveFlags); - - if Succeeded(Result) then - begin - SetLength(Buffer, MAX_PATH); - - if not TargetResolved then - begin - Win32FindData.dwFileAttributes := 0; - ShellLink.GetPath(PChar(Buffer), MAX_PATH, Win32FindData, SLGP_SHORTPATH); - Link.Target := PChar(Buffer); - end; - - ShellLink.GetArguments(PChar(Buffer), MAX_PATH); - Link.Arguments := PChar(Buffer); - ShellLink.GetShowCmd(Link.ShowCmd); - ShellLink.GetWorkingDirectory(PChar(Buffer), MAX_PATH); - Link.WorkingDirectory := PChar(Buffer); - ShellLink.GetDescription(PChar(Buffer), MAX_PATH); - Link.Description := PChar(Buffer); - ShellLink.GetIconLocation(PChar(Buffer), MAX_PATH, Link.IconIndex); - Link.IconLocation := PChar(Buffer); - ShellLink.GetHotkey(Link.HotKey); - ShellLink.GetIDList(Link.IdList); - end; - end; - end; -end; - -function ShellLinkIcon(const Link: TShellLink): HICON; overload; -var - LocExt: string; - Info: TSHFileInfo; -begin - Result := 0; - LocExt := LowerCase(ExtractFileExt(Link.IconLocation)); - // 1. See if IconLocation specifies a valid icon file - if (LocExt = '.ico') and (FileExists(Link.IconLocation)) then - begin - { TODO : Implement loading from an .ico file } - end; - // 2. See if IconLocation specifies an executable - if Result = 0 then - begin - if (LocExt = '.dll') or (LocExt = '.exe') then - Result := ExtractIcon(0, PChar(Link.IconLocation), Link.IconIndex); - end; - // 3. See if target specifies a file - if Result = 0 then - begin - if FileExists(Link.Target) then - Result := ExtractIcon(0, PChar(Link.Target), Link.IconIndex); - end; - // 4. See if the target is an object - if Result = 0 then - begin - if Link.IdList <> nil then - begin - ResetMemory(Info, SizeOf(Info)); - if SHGetFileInfo(PChar(Link.IdList), 0, Info, SizeOf(Info), SHGFI_PIDL or SHGFI_ICON) <> 0 then - Result := Info.hIcon; - end; - end; -end; - -function ShellLinkIcon(const FileName: string): HICON; overload; -var - Link: TShellLink; -begin - if Succeeded(ShellLinkResolve(FileName, Link)) then - begin - Result := ShellLinkIcon(Link); - ShellLinkFree(Link); - end - else - Result := 0; -end; - -function ShellLinkShortCut(const Link: TShellLink): TShortCut; -type - THotKeyModifiers = set of (hkShift, hkCtrl, hkAlt, hkExt); -var - Modifiers: THotKeyModifiers; -begin - if Link.HotKey = 0 then - Result := scNone - else - begin - Modifiers := THotKeyModifiers(HiByte(Link.HotKey)); - Result := LoWord(LoByte(Link.HotKey)); - if hkShift in Modifiers then - Result := Result or scShift; - if hkCtrl in Modifiers then - Result := Result or scCtrl; - if hkAlt in Modifiers then - Result := Result or scAlt; - end; -end; - - -//=== Miscellaneous ========================================================== - -function SHGetItemInfoTip(const Folder: IShellFolder; Item: PItemIdList): string; -var - QueryInfo: IQueryInfo; - InfoTip: PWideChar; -begin - Result := ''; - if (Item = nil) or (Folder = nil) then - Exit; - if Succeeded(Folder.GetUIObjectOf(0, 1, Item, IQueryInfo, nil, - Pointer(QueryInfo))) then - begin - InfoTip := nil; - if Succeeded(QueryInfo.GetInfoTip(0, InfoTip)) then - begin - Result := WideCharToString(InfoTip); - SHFreeMem(Pointer(InfoTip)); - end; - end; -end; - -function SHDllGetVersion(const FileName: string; var Version: TDllVersionInfo): Boolean; -type - TDllGetVersionProc = function (var pdvi: TDllVersionInfo): HRESULT; stdcall; -var - _DllGetVersion: TDllGetVersionProc; - LibHandle: HINST; -begin - Result := False; - LibHandle := SafeLoadLibrary(FileName); - if LibHandle <> 0 then - begin - @_DllGetVersion := GetProcAddress(LibHandle, PChar('DllGetVersion')); - if @_DllGetVersion <> nil then - begin - Version.cbSize := SizeOf(TDllVersionInfo); - Result := Succeeded(_DllGetVersion(Version)); - end; - FreeLibrary(LibHandle); - end; -end; - -function OverlayIcon(var Icon: HICON; Overlay: HICON; Large: Boolean): Boolean; -var - Source, Dest: HIMAGELIST; - Width, Height: Integer; -begin - Result := False; - if Large then - begin - Width := GetSystemMetrics(SM_CXICON); - Height := GetSystemMetrics(SM_CYICON); - Source := ImageList_Create(Width, Height, ILC_MASK or ILC_COLOR32, 1, 0); - end - else - begin - Width := GetSystemMetrics(SM_CXSMICON); - Height := GetSystemMetrics(SM_CYSMICON); - Source := ImageList_Create(Width, Height, ILC_MASK or ILC_COLOR32, 1, 0); - end; - if Source <> 0 then - begin - if (ImageList_AddIcon(Source, Icon) <> -1) and - (ImageList_AddIcon(Source, Overlay) <> -1) then - begin - Dest := HIMAGELIST(ImageList_Merge(Source, 0, Source, 1, 0, 0)); - if Dest <> 0 then - begin - DestroyIcon(Icon); - Icon := ImageList_ExtractIcon(0, Dest, 0); - ImageList_Destroy(Dest); - Result := True; - end; - end; - ImageList_Destroy(Source); - end; -end; - -function OverlayIconShortCut(var Large, Small: HICON): Boolean; -var - OvlLarge, OvlSmall: HICON; -begin - Result := False; - OvlLarge := 0; - OvlSmall := 0; - if ExtractIconEx(PChar('shell32.dll'), 29, OvlLarge, OvlSmall, 1) = 2 then - begin - OverlayIcon(Large, OvlLarge, True); - OverlayIcon(Small, OvlSmall, False); - end; -end; - -function OverlayIconShared(var Large, Small: HICON): Boolean; -var - OvlLarge, OvlSmall: HICON; -begin - Result := False; - OvlLarge := 0; - OvlSmall := 0; - if ExtractIconEx(PChar('shell32.dll'), 28, OvlLarge, OvlSmall, 1) = 2 then - begin - OverlayIcon(Large, OvlLarge, True); - OverlayIcon(Small, OvlSmall, False); - end; -end; - -function GetSystemIcon(IconIndex: Integer; Flags: Cardinal): HICON; -var - FileInfo: TSHFileInfo; - ImageList: HIMAGELIST; -begin - ResetMemory(FileInfo, SizeOf(FileInfo)); - if Flags = 0 then - Flags := SHGFI_SHELLICONSIZE; - ImageList := SHGetFileInfo('', 0, FileInfo, SizeOf(FileInfo), - Flags or SHGFI_SYSICONINDEX); - Result := ImageList_ExtractIcon(0, ImageList, IconIndex); -end; - -function ShellExecEx(const FileName: string; const Parameters: string; - const Verb: string; CmdShow: Integer): Boolean; -var - Sei: TShellExecuteInfo; -begin - ResetMemory(Sei, SizeOf(Sei)); - Sei.cbSize := SizeOf(Sei); - Sei.fMask := SEE_MASK_DOENVSUBST or SEE_MASK_FLAG_NO_UI; - Sei.lpFile := PChar(FileName); - Sei.lpParameters := PCharOrNil(Parameters); - Sei.lpVerb := PCharOrNil(Verb); - Sei.nShow := CmdShow; - {$TYPEDADDRESS ON} - Result := ShellExecuteEx(@Sei); - {$IFNDEF TYPEDADDRESS_ON} - {$TYPEDADDRESS OFF} - {$ENDIF ~TYPEDADDRESS_ON} -end; - -{ TODO -cHelp : author Jean-Fabien Connault note, ShellExecEx() above used to be ShellExec()... } - -function ShellExec(Wnd: Integer; const Operation, FileName, Parameters, Directory: string; ShowCommand: Integer): Boolean; -begin - Result := ShellExecute(Wnd, PChar(Operation), PChar(FileName), PChar(Parameters), - PChar(Directory), ShowCommand) > 32; -end; - -function ShellExecAndWait(const FileName: string; const Parameters: string; - const Verb: string; CmdShow: Integer; const Directory: string): Boolean; -var - Sei: TShellExecuteInfo; - Res: LongBool; - Msg: tagMSG; -begin - ResetMemory(Sei, SizeOf(Sei)); - Sei.cbSize := SizeOf(Sei); - Sei.fMask := SEE_MASK_DOENVSUBST or SEE_MASK_FLAG_NO_UI or SEE_MASK_NOCLOSEPROCESS or - SEE_MASK_FLAG_DDEWAIT; - Sei.lpFile := PChar(FileName); - Sei.lpParameters := PCharOrNil(Parameters); - Sei.lpVerb := PCharOrNil(Verb); - Sei.nShow := CmdShow; - Sei.lpDirectory := PCharOrNil(Directory); - {$TYPEDADDRESS ON} - Result := ShellExecuteEx(@Sei); - {$IFNDEF TYPEDADDRESS_ON} - {$TYPEDADDRESS OFF} - {$ENDIF ~TYPEDADDRESS_ON} - if Result then - begin - WaitForInputIdle(Sei.hProcess, INFINITE); - while WaitForSingleObject(Sei.hProcess, 10) = WAIT_TIMEOUT do - repeat - Msg.hwnd := 0; - Res := PeekMessage(Msg, Sei.Wnd, 0, 0, PM_REMOVE); - if Res then - begin - TranslateMessage(Msg); - DispatchMessage(Msg); - end; - until not Res; - CloseHandle(Sei.hProcess); - end; -end; - -function ShellOpenAs(const FileName: string): Boolean; -begin - Result := ShellExecEx('rundll32', Format('shell32.dll,OpenAs_RunDLL "%s"', [FileName]), '', SW_SHOWNORMAL); -end; - -{ TODO: Dynamic linking - move TRasDialDlgA to JclWin32} -type - TRasDialDlgFunc = function(lpszPhonebook, lpszEntry, lpszPhoneNumber: PChar; lpInfo: PRasDialDlg): BOOL; stdcall; - -function ShellRasDial(const EntryName: string): Boolean; -var - Info: TRasDialDlg; - RasDlg: HModule; - RasDialDlg: TRasDialDlgFunc; -begin - if IsWinNT then - begin - Result := False; - RasDlg := SafeLoadLibrary('rasdlg.dll'); - if RasDlg <> 0 then - try - @RasDialDlg := GetProcAddress(RasDlg, PChar('RasDialDlg' + AWSuffix)); - if @RasDialDlg <> nil then - begin - ResetMemory(Info, SizeOf(Info)); - Info.dwSize := SizeOf(Info); - Result := RasDialDlg(nil, PChar(EntryName), nil, @Info); - end; - finally - FreeLibrary(RasDlg); - end; - end - else - Result := ShellExecEx('rundll32', Format('rnaui.dll,RnaDial "%s"', [EntryName]), '', SW_SHOWNORMAL); -end; - -// You can pass simple name of standard system control panel (e.g. 'timedate') -// or full qualified file name (Window 95 only? doesn't work on Win2K!) -// MT: Added support for Windows 98..XP. Have no win95 anymore so I have to -// trust that the original version works on Windows 95 and Windows 95OSR2. - -function ShellRunControlPanel(const NameOrFileName: string; AppletNumber: Integer): Boolean; -var - FileName: TFileName; -begin - if ExtractFilePath(NameOrFileName) = '' then - FileName := ChangeFileExt(PathAddSeparator(GetWindowsSystemFolder) + NameOrFileName, '.cpl') - else - FileName := NameOrFileName; - if FileExists(FileName) then - begin - if (IsWin95 or IsWin95OSR2) then - Result := ShellExecEx('rundll32', Format('shell32.dll,Control_RunDLL "%s", @%d', - [FileName, AppletNumber]), '', SW_SHOWNORMAL) - else - Result := ShellExecEx('rundll32', Format('shell32.dll,Control_RunDLL "%s",,%d', - [FileName, AppletNumber]), '', SW_SHOWNORMAL) - end - else - begin - Result := False; - SetLastError(ERROR_FILE_NOT_FOUND); - end; -end; - -// Compare http://msdn.microsoft.com/en-us/library/bb756922.aspx - -function RunAsAdmin(const FileName: string; const Parameters: string = ''; const Parent: THandle = 0): Boolean; -var - Sei: TShellExecuteInfo; -begin - ResetMemory(Sei, SizeOf(Sei)); - Sei.cbSize := SizeOf(TShellExecuteInfo); - Sei.Wnd := Parent; - Sei.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI; - Sei.lpVerb := PChar(cVerbRunas); - Sei.lpFile := PChar(FileName); - Sei.lpParameters := PCharOrNil(Parameters); - Sei.nShow := SW_SHOWNORMAL; - - {$TYPEDADDRESS ON} - Result := ShellExecuteEx(@Sei); - {$IFNDEF TYPEDADDRESS_ON} - {$TYPEDADDRESS OFF} - {$ENDIF ~TYPEDADDRESS_ON} -end; - -function GetFileExeType(const FileName: TFileName): TJclFileExeType; -var - FileInfo: TSHFileInfo; - R: DWORD; -begin - FileInfo.dwAttributes := 0; - R := SHGetFileInfo(PChar(FileName), 0, FileInfo, SizeOf(FileInfo), SHGFI_EXETYPE); - case LoWord(R) of - IMAGE_DOS_SIGNATURE: - Result := etMsDos; - IMAGE_OS2_SIGNATURE: - Result := etWin16; - Word(IMAGE_NT_SIGNATURE): - if HiWord(R) = 0 then - Result := etWin32Con - else - Result := etWin32Gui; - else - Result := etError; - end; -end; - -function ShellFindExecutable(const FileName, DefaultDir: string): string; -var - Res: HINST; - Buffer: array [0..MAX_PATH-1] of Char; - I: Integer; -begin - ResetMemory(Buffer, SizeOf(Buffer)); - Res := FindExecutable(PChar(FileName), PCharOrNil(DefaultDir), Buffer); - if Res > 32 then - begin - // FindExecutable replaces #32 with #0 - for I := Low(Buffer) to High(Buffer) - 1 do - if Buffer[I] = #0 then - Buffer[I] := #32; - Buffer[High(Buffer)] := #0; - Result := Trim(Buffer); - end - else - Result := ''; -end; - -function GetFileNameIcon(const FileName: string; Flags: Cardinal = 0): HICON; -var - FileInfo: TSHFileInfo; - ImageList: HIMAGELIST; -begin - ResetMemory(FileInfo, SizeOf(FileInfo)); - if Flags = 0 then - Flags := SHGFI_SHELLICONSIZE; - ImageList := SHGetFileInfo(PChar(FileName), 0, FileInfo, SizeOf(FileInfo), - Flags or SHGFI_SYSICONINDEX); - if ImageList <> 0 then - Result := ImageList_ExtractIcon(0, ImageList, FileInfo.iIcon) - else - Result := 0; -end; - -initialization - //We don't load the msi functions until the first attempt to resolve an MSI link - - {$IFDEF UNITVERSIONING} - RegisterUnitVersion(HInstance, UnitVersioning); - {$ENDIF UNITVERSIONING} - -finalization - {$IFDEF UNITVERSIONING} - UnregisterUnitVersion(HInstance); - {$ENDIF UNITVERSIONING} - UnloadModule(rtdlMsiLibHandle); - -end. - - +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclShell.pas. } +{ } +{ The Initial Developers of the Original Code are Marcel van Brakel and Petr Vones. } +{ Portions created by these individuals are Copyright (C) of these individuals. } +{ All Rights Reserved. } +{ } +{ Contributor(s): } +{ Rik Barker (rikbarker) } +{ Marcel van Brakel } +{ Jean-Fabien Connault (cycocrew) } +{ Aleksej Kudinov } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Olivier Sannier (obones) } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ kogerbnz } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ This unit contains routines and classes which makes working with the Windows Shell a bit easier. } +{ Included are routines for working with PIDL's, special folder's, file and folder manipulation } +{ through shell interfaces, shortcut's and program execution. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclShell; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, System.SysUtils, System.Classes, Winapi.ShlObj, + {$ELSE ~HAS_UNITSCOPE} + Windows, SysUtils, Classes, ShlObj, + {$ENDIF ~HAS_UNITSCOPE} + JclBase, JclWin32, JclSysUtils; + +// Files and Folders +type + TSHDeleteOption = (doSilent, doAllowUndo, doFilesOnly); + TSHDeleteOptions = set of TSHDeleteOption; + TSHRenameOption = (roSilent, roRenameOnCollision); + TSHRenameOptions = set of TSHRenameOption; + TSHCopyOption = (coSilent, coAllowUndo, coFilesOnly, coNoConfirmation); + TSHCopyOptions = set of TSHCopyOption; + TSHMoveOption = (moSilent, moAllowUndo, moFilesOnly, moNoConfirmation); + TSHMoveOptions = set of TSHMoveOption; + +function SHDeleteFiles(Parent: THandle; const Files: string; Options: TSHDeleteOptions): Boolean; +function SHDeleteFolder(Parent: THandle; const Folder: string; Options: TSHDeleteOptions): Boolean; +function SHRenameFile(const Src, Dest: string; Options: TSHRenameOptions): Boolean; +function SHCopy(Parent: THandle; const Src, Dest: string; Options: TSHCopyOptions): Boolean; +function SHMove(Parent: THandle; const Src, Dest: string; Options: TSHMoveOptions): Boolean; + +type + TEnumFolderFlag = (efFolders, efNonFolders, efIncludeHidden); + TEnumFolderFlags = set of TEnumFolderFlag; + + TEnumFolderRec = record + DisplayName: string; + Attributes: DWORD; + IconLarge: HICON; + IconSmall: HICON; + Item: PItemIdList; + EnumIdList: IEnumIdList; + Folder: IShellFolder; + end; + +function SHEnumFolderFirst(const Folder: string; Flags: TEnumFolderFlags; + var F: TEnumFolderRec): Boolean; +function SHEnumSpecialFolderFirst(SpecialFolder: DWORD; Flags: TEnumFolderFlags; + var F: TEnumFolderRec): Boolean; +procedure SHEnumFolderClose(var F: TEnumFolderRec); +function SHEnumFolderNext(var F: TEnumFolderRec): Boolean; + +function GetSpecialFolderLocation(const FolderID: Integer): string; + +function DisplayPropDialog(const Handle: THandle; const FileName: string): Boolean; overload; +function DisplayPropDialog(const Handle: THandle; Item: PItemIdList): Boolean; overload; + +function DisplayContextMenuPidl(const Handle: THandle; const Folder: IShellFolder; + Item: PItemIdList; Pos: TPoint): Boolean; +function DisplayContextMenu(const Handle: THandle; const FileName: string; + Pos: TPoint): Boolean; + +function OpenFolder(const Path: string; Parent: THandle = 0; Explore: Boolean = False): Boolean; +function OpenSpecialFolder(FolderID: Integer; Parent: THandle = 0; Explore: Boolean = False): Boolean; + +// Memory Management +function SHReallocMem(var P: Pointer; Count: Integer): Boolean; +function SHAllocMem(out P: Pointer; Count: Integer): Boolean; +function SHGetMem(var P: Pointer; Count: Integer): Boolean; +function SHFreeMem(var P: Pointer): Boolean; + +// Paths and PIDLs +function DriveToPidlBind(const DriveName: string; out Folder: IShellFolder): PItemIdList; +function PathToPidl(const Path: string; Folder: IShellFolder): PItemIdList; +function PathToPidlBind(const FileName: string; out Folder: IShellFolder): PItemIdList; +function PidlBindToParent(IdList: PItemIdList; out Folder: IShellFolder; out Last: PItemIdList): Boolean; +function PidlCompare(Pidl1, Pidl2: PItemIdList): Boolean; +function PidlCopy(Source: PItemIdList; out Dest: PItemIdList): Boolean; +function PidlFree(var IdList: PItemIdList): Boolean; +function PidlGetDepth(Pidl: PItemIdList): Integer; +function PidlGetLength(Pidl: PItemIdList): Integer; +function PidlGetNext(Pidl: PItemIdList): PItemIdList; +function PidlToPath(IdList: PItemIdList): string; + +function StrRetFreeMem(StrRet: TStrRet): Boolean; +function StrRetToString(IdList: PItemIdList; StrRet: TStrRet; Free: Boolean): string; + +// Shortcuts / Shell link +type + PShellLink = ^TShellLink; + TShellLink = record + Arguments: string; + ShowCmd: Integer; + WorkingDirectory: string; + IdList: PItemIDList; + Target: string; + Description: string; + IconLocation: string; + IconIndex: Integer; + HotKey: Word; // Use ShellLinkShortCut() to convert it to a TShortCut + end; + +procedure ShellLinkFree(var Link: TShellLink); +function ShellLinkResolve(const FileName: string; out Link: TShellLink): HRESULT; overload; +function ShellLinkResolve(const FileName: string; out Link: TShellLink; + const ResolveFlags: Cardinal): HRESULT; overload; +function ShellLinkCreate(const Link: TShellLink; const FileName: string): HRESULT; +function ShellLinkCreateSystem(const Link: TShellLink; const Folder: Integer; const FileName: string): HRESULT; +function ShellLinkIcon(const Link: TShellLink): HICON; overload; +function ShellLinkIcon(const FileName: string): HICON; overload; +function ShellLinkShortCut(const Link: TShellLink): TShortCut; + +// Miscellaneous +function SHDllGetVersion(const FileName: string; var Version: TDllVersionInfo): Boolean; + +function GetSystemIcon(IconIndex: Integer; Flags: Cardinal): HICON; +function OverlayIcon(var Icon: HICON; Overlay: HICON; Large: Boolean): Boolean; +function OverlayIconShortCut(var Large, Small: HICON): Boolean; +function OverlayIconShared(var Large, Small: HICON): Boolean; +function SHGetItemInfoTip(const Folder: IShellFolder; Item: PItemIdList): string; + +function ShellExecEx(const FileName: string; const Parameters: string = ''; const Verb: string = ''; + CmdShow: Integer = SW_SHOWNORMAL): Boolean; +function ShellExec(Wnd: Integer; const Operation, FileName, Parameters, Directory: string; ShowCommand: Integer): Boolean; +function ShellExecAndWait(const FileName: string; const Parameters: string = ''; const Verb: string = ''; + CmdShow: Integer = SW_SHOWNORMAL; const Directory: string = ''): Boolean; + +function ShellOpenAs(const FileName: string): Boolean; +function ShellRasDial(const EntryName: string): Boolean; +function ShellRunControlPanel(const NameOrFileName: string; AppletNumber: Integer = 0): Boolean; + +function RunAsAdmin(const FileName: string; const Parameters: string = ''; const Parent: THandle = 0): Boolean; + +function GetFileNameIcon(const FileName: string; Flags: Cardinal = 0): HICON; + +type + TJclFileExeType = (etError, etMsDos, etWin16, etWin32Gui, etWin32Con); + +function GetFileExeType(const FileName: TFileName): TJclFileExeType; + +function ShellFindExecutable(const FileName, DefaultDir: string): string; + +//MSI functions and types used in ShellLinkResolve - copied from JwaMsi.pas +type + INSTALLSTATE = Longint; +const + MSILIB = 'msi.dll'; + GetShortcutTargetName = 'MsiGetShortcutTarget' + AWSuffix; + GetComponentPathName = 'MsiGetComponentPath' + AWSuffix; +var + // MSI.DLL functions can''t be converted to Unicode due to an internal compiler bug (F2084 Internal Error: URW1021) + RtdlMsiLibHandle: TModuleHandle = INVALID_MODULEHANDLE_VALUE; + RtdlMsiGetShortcutTarget: function(szShortcutPath: LPCTSTR; szProductCode: LPTSTR; + szFeatureId: LPTSTR; szComponentCode: LPTSTR): UINT stdcall = nil; + + RtdlMsiGetComponentPath: function(szProduct: LPCTSTR; szComponent: LPCTSTR; + lpPathBuf: LPTSTR; pcchBuf: LPDWORD): INSTALLSTATE stdcall = nil; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + Winapi.ActiveX, Winapi.CommCtrl, Winapi.Messages, Winapi.ShellAPI, + {$ELSE ~HAS_UNITSCOPE} + ActiveX, CommCtrl, Messages, ShellAPI, + {$ENDIF ~HAS_UNITSCOPE} + JclFileUtils, JclStrings, JclSysInfo; + +type + TWidePath = array [0..MAX_PATH-1] of WideChar; + {$IFDEF SUPPORTS_UNICODE} + TWidePathPtr = PWideChar; + {$ELSE ~SUPPORTS_UNICODE} + TWidePathPtr = TWidePath; + {$ENDIF ~SUPPORTS_UNICODE} + +const + cVerbProperties = 'properties'; + cVerbOpen = 'open'; + cVerbExplore = 'explore'; + cVerbRunas = 'runas'; + +//=== Files and Folders ====================================================== + +// Helper function and constant to map a TSHDeleteOptions set to a Cardinal + +const + FOF_COMPLETELYSILENT = FOF_SILENT or FOF_NOCONFIRMATION or FOF_NOERRORUI or FOF_NOCONFIRMMKDIR; + +function DeleteOptionsToCardinal(Options: TSHDeleteOptions): Cardinal; +begin + Result := 0; + if doSilent in Options then + Result := Result or FOF_COMPLETELYSILENT; + if doAllowUndo in Options then + Result := Result or FOF_ALLOWUNDO; + if doFilesOnly in Options then + Result := Result or FOF_FILESONLY; +end; + +function SHDeleteFiles(Parent: THandle; const Files: string; + Options: TSHDeleteOptions): Boolean; +var + FileOp: TSHFileOpStruct; + Source: string; +begin + ResetMemory(FileOp, SizeOf(FileOp)); + with FileOp do + begin + Wnd := Parent; + wFunc := FO_DELETE; + Source := Files + #0#0; + pFrom := PChar(Source); + fFlags := DeleteOptionsToCardinal(Options); + end; + Result := SHFileOperation(FileOp) = 0; +end; + +function SHDeleteFolder(Parent: THandle; const Folder: string; + Options: TSHDeleteOptions): Boolean; +begin + Exclude(Options, doFilesOnly); + Result := SHDeleteFiles(Parent, PathAddSeparator(Folder) + '*.*', Options); + if Result then + Result := SHDeleteFiles(Parent, PathRemoveSeparator(Folder), Options); +end; + +// Helper function to map a TSHRenameOptions set to a cardinal + +function RenameOptionsToCardinal(Options: TSHRenameOptions): Cardinal; +begin + Result := 0; + if roRenameOnCollision in Options then + Result := Result or FOF_RENAMEONCOLLISION; + if roSilent in Options then + Result := Result or FOF_COMPLETELYSILENT; +end; + +function SHRenameFile(const Src, Dest: string; Options: TSHRenameOptions): Boolean; +var + FileOp: TSHFileOpStruct; + Source, Destination: string; +begin + ResetMemory(FileOp, SizeOf(FileOp)); + with FileOp do + begin + Wnd := GetDesktopWindow; + wFunc := FO_RENAME; + Source := Src + #0#0; + Destination := Dest + #0#0; + pFrom := PChar(Source); + pTo := PChar(Destination); + fFlags := RenameOptionsToCardinal(Options); + end; + Result := SHFileOperation(FileOp) = 0; +end; + +function CopyOptionsToCardinal(Options: TSHCopyOptions): Cardinal; +begin + Result := 0; + if coSilent in Options then + Result := Result or FOF_SILENT; + if coAllowUndo in Options then + Result := Result or FOF_ALLOWUNDO; + if coFilesOnly in Options then + Result := Result or FOF_FILESONLY; + if coNoConfirmation in Options then + Result := Result or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR; +end; + +function SHCopy(Parent: THandle; const Src, Dest: string; Options: TSHCopyOptions): Boolean; +var + FileOp: TSHFileOpStruct; + Source, Destination: string; +begin + ResetMemory(FileOp, SizeOf(FileOp)); + FileOp.Wnd := Parent; + FileOp.wFunc := FO_COPY; + Source := Src + #0#0; + Destination := Dest + #0#0; + FileOp.pFrom := PChar(Source); + FileOp.pTo := PChar(Destination); + FileOp.fFlags := CopyOptionsToCardinal(Options); + Result := SHFileOperation(FileOp) = 0; +end; + +function MoveOptionsToCardinal(Options: TSHMoveOptions): Cardinal; +begin + Result := 0; + if moSilent in Options then + Result := Result or FOF_SILENT; + if moAllowUndo in Options then + Result := Result or FOF_ALLOWUNDO; + if moFilesOnly in Options then + Result := Result or FOF_FILESONLY; + if moNoConfirmation in Options then + Result := Result or FOF_NOCONFIRMATION; +end; + +function SHMove(Parent: THandle; const Src, Dest: string; Options: TSHMoveOptions): Boolean; +var + FileOp: TSHFileOpStruct; + Source, Destination: string; +begin + ResetMemory(FileOp, SizeOf(FileOp)); + FileOp.Wnd := Parent; + FileOp.wFunc := FO_MOVE; + Source := Src + #0#0; + Destination := Dest + #0#0; + FileOp.pFrom := PChar(Source); + FileOp.pTo := PChar(Destination); + FileOp.fFlags := MoveOptionsToCardinal(Options); + Result := SHFileOperation(FileOp) = 0; +end; + +function EnumFolderFlagsToCardinal(Flags: TEnumFolderFlags): Cardinal; +begin + Result := 0; + if efFolders in Flags then + Result := Result or SHCONTF_FOLDERS; + if efNonFolders in Flags then + Result := Result or SHCONTF_NONFOLDERS; + if efIncludeHidden in Flags then + Result := Result or SHCONTF_INCLUDEHIDDEN; +end; + +procedure ClearEnumFolderRec(var F: TEnumFolderRec; const Free, Release: Boolean); +begin + if Release then + begin + F.EnumIdList := nil; + F.Folder := nil; + end; + if Free then + begin + PidlFree(F.Item); + DestroyIcon(F.IconLarge); + DestroyIcon(F.IconSmall); + end; + F.Attributes := 0; + F.Item := nil; + F.IconLarge := 0; + F.IconSmall := 0; +end; + +procedure SHEnumFolderClose(var F: TEnumFolderRec); +begin + ClearEnumFolderRec(F, True, True); +end; + +function SHEnumFolderNext(var F: TEnumFolderRec): Boolean; +const + Attr = Cardinal(SFGAO_CAPABILITYMASK or SFGAO_DISPLAYATTRMASK or SFGAO_CONTENTSMASK); +var + DisplayNameRet: TStrRet; + ItemsFetched: ULONG; + ExtractIcon: IExtractIcon; + IconFile: TWidePath; + IconIndex: Integer; + Flags: DWORD; +begin + Result := False; + ClearEnumFolderRec(F, True, False); + if (F.EnumIdList = nil) or (F.Folder = nil) then + Exit; + ItemsFetched := 0; + if F.EnumIdList.Next(1, F.Item, ItemsFetched) = NO_ERROR then + begin + DisplayNameRet.utype := 0; + F.Folder.GetDisplayNameOf(F.Item, SHGDN_INFOLDER, DisplayNameRet); + F.DisplayName := StrRetToString(F.Item, DisplayNameRet, True); + F.Attributes := Attr; + F.Folder.GetAttributesOf(1, F.Item, F.Attributes); + F.Folder.GetUIObjectOf(0, 1, F.Item, IID_IExtractIconW, nil, + Pointer(ExtractIcon)); + Flags := 0; + F.IconLarge := 0; + F.IconSmall := 0; + + if Assigned(ExtractIcon) then + begin + IconIndex := 0; + ExtractIcon.GetIconLocation(0, @IconFile, MAX_PATH, IconIndex, Flags); + if (IconIndex < 0) or ((Flags and GIL_NOTFILENAME) = 0) then + ExtractIconEx(@IconFile, IconIndex, F.IconLarge, F.IconSmall, 1) + else + ExtractIcon.Extract(@IconFile, IconIndex, F.IconLarge, F.IconSmall, + MakeLong(32, 16)); + end; + + Result := True; + end; +end; + +function SHEnumSpecialFolderFirst(SpecialFolder: DWORD; Flags: TEnumFolderFlags; + var F: TEnumFolderRec): Boolean; +var + DesktopFolder: IShellFolder; + FolderPidl: PItemIdList; +begin + ClearEnumFolderRec(F, False, False); + Result := Succeeded(SHGetDesktopFolder(DesktopFolder)); + if Result then + begin + if SpecialFolder = CSIDL_DESKTOP then + F.Folder := DesktopFolder + else + begin + Result := Succeeded(SHGetSpecialFolderLocation(0, SpecialFolder, FolderPidl)); + if Result then + begin + try + Result := Succeeded(DesktopFolder.BindToObject(FolderPidl, nil, IID_IShellFolder, Pointer(F.Folder))); + finally + CoTaskMemFree(FolderPidl); + end; + end; + end; + end; + if Result then + begin + F.Folder.EnumObjects(0, EnumFolderFlagsToCardinal(Flags), F.EnumIdList); + Result := SHEnumFolderNext(F); + if not Result then + SHEnumFolderClose(F); + end; +end; + +function SHEnumFolderFirst(const Folder: string; Flags: TEnumFolderFlags; + var F: TEnumFolderRec): Boolean; +var + DesktopFolder: IShellFolder; + FolderPidl: PItemIdList; +begin + ClearEnumFolderRec(F, False, False); + SHGetDesktopFolder(DesktopFolder); + FolderPidl := PathToPidl(PathAddSeparator(Folder), DesktopFolder); + try + DesktopFolder.BindToObject(FolderPidl, nil, IID_IShellFolder, Pointer(F.Folder)); + F.Folder.EnumObjects(0, EnumFolderFlagsToCardinal(Flags), F.EnumIdList); + Result := SHEnumFolderNext(F); + if not Result then + SHEnumFolderClose(F); + finally + PidlFree(FolderPidl); + end; +end; + +function GetSpecialFolderLocation(const FolderID: Integer): string; +var + FolderPidl: PItemIdList; +begin + if Succeeded(SHGetSpecialFolderLocation(0, FolderID, FolderPidl)) then + begin + Result := PidlToPath(FolderPidl); + CoTaskMemFree(FolderPidl); + end + else + Result := ''; +end; + +function DisplayPropDialog(const Handle: THandle; const FileName: string): Boolean; +var + Info: TShellExecuteInfo; +begin + ResetMemory(Info, SizeOf(Info)); + with Info do + begin + cbSize := SizeOf(Info); + lpFile := PChar(FileName); + nShow := SW_SHOW; + fMask := SEE_MASK_INVOKEIDLIST; + Wnd := Handle; + lpVerb := cVerbProperties; + end; + {$TYPEDADDRESS ON} // need this because ShellExecuteEx is overloaded in FPC -A -W + Result := ShellExecuteEx(@Info); + {$IFNDEF TYPEDADDRESS_ON} + {$TYPEDADDRESS OFF} + {$ENDIF ~TYPEDADDRESS_ON} +end; + +function DisplayPropDialog(const Handle: THandle; Item: PItemIdList): Boolean; +var + Info: TShellExecuteInfo; +begin + ResetMemory(Info, SizeOf(Info)); + with Info do + begin + cbSize := SizeOf(Info); + nShow := SW_SHOW; + lpIDList := Item; + fMask := SEE_MASK_INVOKEIDLIST or SEE_MASK_IDLIST; + Wnd := Handle; + lpVerb := cVerbProperties; + end; + {$TYPEDADDRESS ON} + Result := ShellExecuteEx(@Info); + {$IFNDEF TYPEDADDRESS_ON} + {$TYPEDADDRESS OFF} + {$ENDIF ~TYPEDADDRESS_ON} +end; + +// Window procedure for the callback window created by DisplayContextMenu. +// It simply forwards messages to the folder. If you don't do this then the +// system created submenu's will be empty (except for 1 stub item!) +// note: storing the IContextMenu2 pointer in the window's user data was +// 'inspired' by (read: copied from) code by Brad Stowers. + +function MenuCallback(Wnd: THandle; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; +var + ContextMenu2: IContextMenu2; +begin + case Msg of + WM_CREATE: + begin + ContextMenu2 := IContextMenu2(PCreateStruct(lParam).lpCreateParams); + SetWindowLongPtr(Wnd, GWLP_USERDATA, LONG_PTR(ContextMenu2)); + Result := DefWindowProc(Wnd, Msg, wParam, lParam); + end; + WM_INITMENUPOPUP: + begin + ContextMenu2 := IContextMenu2(GetWindowLongPtr(Wnd, GWLP_USERDATA)); + ContextMenu2.HandleMenuMsg(Msg, wParam, lParam); + Result := 0; + end; + WM_DRAWITEM, WM_MEASUREITEM: + begin + ContextMenu2 := IContextMenu2(GetWindowLongPtr(Wnd, GWLP_USERDATA)); + ContextMenu2.HandleMenuMsg(Msg, wParam, lParam); + Result := 1; + end; + else + Result := DefWindowProc(Wnd, Msg, wParam, lParam); + end; +end; + +// Helper function for DisplayContextMenu, creates the callback window. + +function CreateMenuCallbackWnd(const ContextMenu: IContextMenu2): THandle; +const + IcmCallbackWnd = 'ICMCALLBACKWND'; +var + WndClass: TWndClass; +begin + ResetMemory(WndClass, SizeOf(WndClass)); + WndClass.lpszClassName := PChar(IcmCallbackWnd); + WndClass.lpfnWndProc := @MenuCallback; + WndClass.hInstance := HInstance; + {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.RegisterClass(WndClass); + Result := CreateWindow(IcmCallbackWnd, IcmCallbackWnd, WS_POPUPWINDOW, 0, + 0, 0, 0, 0, 0, HInstance, Pointer(ContextMenu)); +end; + +function DisplayContextMenuPidl(const Handle: THandle; const Folder: IShellFolder; + Item: PItemIdList; Pos: TPoint): Boolean; +var + Cmd: Cardinal; + ContextMenu: IContextMenu; + ContextMenu2: IContextMenu2; + Menu: HMENU; + CommandInfo: TCMInvokeCommandInfo; + CallbackWindow: THandle; +begin + Result := False; + if (Item = nil) or (Folder = nil) then + Exit; + Folder.GetUIObjectOf(Handle, 1, Item, IID_IContextMenu, nil, + Pointer(ContextMenu)); + if ContextMenu <> nil then + begin + Menu := CreatePopupMenu; + if Menu <> 0 then + begin + if Succeeded(ContextMenu.QueryContextMenu(Menu, 0, 1, $7FFF, CMF_EXPLORE)) then + begin + CallbackWindow := 0; + if Succeeded(ContextMenu.QueryInterface(IContextMenu2, ContextMenu2)) then + begin + CallbackWindow := CreateMenuCallbackWnd(ContextMenu2); + end; + ClientToScreen(Handle, Pos); + Cmd := Cardinal(TrackPopupMenu(Menu, TPM_LEFTALIGN or TPM_LEFTBUTTON or + TPM_RIGHTBUTTON or TPM_RETURNCMD, Pos.X, Pos.Y, 0, CallbackWindow, nil)); + if Cmd <> 0 then + begin + ResetMemory(CommandInfo, SizeOf(CommandInfo)); + CommandInfo.cbSize := SizeOf(TCMInvokeCommandInfo); + CommandInfo.hwnd := Handle; + CommandInfo.lpVerb := MakeIntResourceA(Cmd - 1); + CommandInfo.nShow := SW_SHOWNORMAL; + Result := Succeeded(ContextMenu.InvokeCommand(CommandInfo)); + end; + if CallbackWindow <> 0 then + DestroyWindow(CallbackWindow); + end; + DestroyMenu(Menu); + end; + end; +end; + +function DisplayContextMenu(const Handle: THandle; const FileName: string; + Pos: TPoint): Boolean; +var + ItemIdList: PItemIdList; + Folder: IShellFolder; +begin + Result := False; + ItemIdList := PathToPidlBind(FileName, Folder); + if ItemIdList <> nil then + begin + Result := DisplayContextMenuPidl(Handle, Folder, ItemIdList, Pos); + PidlFree(ItemIdList); + end; +end; + +function OpenFolder(const Path: string; Parent: THandle; Explore: Boolean): Boolean; +var + Sei: TShellExecuteInfo; +begin + Result := False; + if IsDirectory(Path) then + begin + ResetMemory(Sei, SizeOf(Sei)); + with Sei do + begin + cbSize := SizeOf(Sei); + Wnd := Parent; + if Explore then + lpVerb := cVerbExplore + else + lpVerb := cVerbOpen; + lpFile := PChar(Path); + nShow := SW_SHOWNORMAL; + end; + {$TYPEDADDRESS ON} + Result := ShellExecuteEx(@Sei); + {$IFNDEF TYPEDADDRESS_ON} + {$TYPEDADDRESS OFF} + {$ENDIF ~TYPEDADDRESS_ON} + end; +end; + +function OpenSpecialFolder(FolderID: Integer; Parent: THandle; Explore: Boolean): Boolean; +var + Pidl: PItemIDList; + Sei: TShellExecuteInfo; +begin + Result := False; + if Succeeded(SHGetSpecialFolderLocation(Parent, FolderID, Pidl)) then + begin + ResetMemory(Sei, SizeOf(Sei)); + with Sei do + begin + cbSize := SizeOf(Sei); + Wnd := Parent; + fMask := SEE_MASK_INVOKEIDLIST; + if Explore then + lpVerb := cVerbExplore + else + lpVerb := cVerbOpen; + lpIDList := Pidl; + nShow := SW_SHOWNORMAL; + if PidlToPath(Pidl) = '' then + begin + fMask := SEE_MASK_INVOKEIDLIST; + lpIDList := Pidl; + end + else + lpFile := PChar(PidlToPath(Pidl)); + end; + {$TYPEDADDRESS ON} + Result := ShellExecuteEx(@Sei); + {$IFNDEF TYPEDADDRESS_ON} + {$TYPEDADDRESS OFF} + {$ENDIF ~TYPEDADDRESS_ON} + CoTaskMemFree(Pidl); + end; +end; + +//=== Memory Management ====================================================== + +function SHAllocMem(out P: Pointer; Count: Integer): Boolean; +var + Malloc: IMalloc; +begin + Result := False; + P := nil; + if Succeeded(SHGetMalloc(Malloc)) then + begin + P := Malloc.Alloc(Count); + if P <> nil then + begin + ResetMemory(P^, Count); + Result := True; + end; + end; +end; + +function SHFreeMem(var P: Pointer): Boolean; +var + Malloc: IMalloc; +begin + Result := False; + if P <> nil then + begin + if Succeeded(SHGetMalloc(Malloc)) and (Malloc.DidAlloc(P) > 0) then + begin + Malloc.Free(P); + P := nil; + Result := True; + end; + end; +end; + +function SHGetMem(var P: Pointer; Count: Integer): Boolean; +var + Malloc: IMalloc; +begin + Result := False; + if Succeeded(SHGetMalloc(Malloc)) then + begin + P := Malloc.Alloc(Count); + if P <> nil then + Result := True; + end; +end; + +function SHReallocMem(var P: Pointer; Count: Integer): Boolean; +var + Malloc: IMalloc; +begin + Result := False; + if Succeeded(SHGetMalloc(Malloc)) then + begin + if (P <> nil) and (Malloc.DidAlloc(P) <= 0) then + Exit; + P := Malloc.ReAlloc(P, Count); + Result := (P <> nil) or (Count = 0); + end; +end; + +//=== Paths and PIDLs ======================================================== + +function DriveToPidlBind(const DriveName: string; out Folder: IShellFolder): PItemIdList; +var + Attr: ULONG; + Eaten: ULONG; + DesktopFolder: IShellFolder; + Drives: PItemIdList; + Path: TWidePathPtr; +begin + Result := nil; + if Succeeded(SHGetDesktopFolder(DesktopFolder)) then + begin + if Succeeded(SHGetSpecialFolderLocation(0, CSIDL_DRIVES, Drives)) then + begin + if Succeeded(DesktopFolder.BindToObject(Drives, nil, IID_IShellFolder, + Pointer(Folder))) then + begin + {$IFDEF SUPPORTS_UNICODE} + Path := PChar(PathAddSeparator(DriveName)); + {$ELSE ~SUPPORTS_UNICODE} + MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PAnsiChar(PathAddSeparator(DriveName)), -1, Path, MAX_PATH); + {$ENDIF ~SUPPORTS_UNICODE} + Attr := 0; + if Failed(Folder.ParseDisplayName(0, nil, Path, Eaten, Result, Attr)) then + begin + Folder := nil; + // Failure probably means that this is not a drive. However, do not + // call PathToPidlBind() because it may cause infinite recursion. + end; + end; + end; + CoTaskMemFree(Drives); + end; +end; + +function PathToPidl(const Path: string; Folder: IShellFolder): PItemIdList; +var + DesktopFolder: IShellFolder; + CharsParsed, Attr: ULONG; + WidePath: TWidePathPtr; +begin + Result := nil; + {$IFDEF SUPPORTS_UNICODE} + WidePath := PChar(Path); + {$ELSE ~SUPPORTS_UNICODE} + MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PAnsiChar(Path), -1, WidePath, MAX_PATH); + {$ENDIF ~SUPPORTS_UNICODE} + Attr := 0; + if Folder <> nil then + Folder.ParseDisplayName(0, nil, WidePath, CharsParsed, Result, Attr) + else + if Succeeded(SHGetDesktopFolder(DesktopFolder)) then + DesktopFolder.ParseDisplayName(0, nil, WidePath, CharsParsed, Result, Attr); +end; + +function PathToPidlBind(const FileName: string; out Folder: IShellFolder): PItemIdList; +var + Attr, Eaten: ULONG; + PathIdList: PItemIdList; + DesktopFolder: IShellFolder; + Path, ItemName: TWidePathPtr; +begin + Result := nil; + {$IFDEF SUPPORTS_UNICODE} + Path := PChar(ExtractFilePath(FileName)); + ItemName := PChar(ExtractFileName(FileName)); + {$ELSE ~SUPPORTS_UNICODE} + MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PAnsiChar(ExtractFilePath(FileName)), -1, Path, MAX_PATH); + MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PAnsiChar(ExtractFileName(FileName)), -1, ItemName, MAX_PATH); + {$ENDIF ~SUPPORTS_UNICODE} + if Succeeded(SHGetDesktopFolder(DesktopFolder)) then + begin + Attr := 0; + if Succeeded(DesktopFolder.ParseDisplayName(0, nil, Path, Eaten, PathIdList, + Attr)) then + begin + if Succeeded(DesktopFolder.BindToObject(PathIdList, nil, IID_IShellFolder, + Pointer(Folder))) then + begin + if Failed(Folder.ParseDisplayName(0, nil, ItemName, Eaten, Result, Attr)) then + begin + Folder := nil; + Result := DriveToPidlBind(FileName, Folder); + end; + end; + PidlFree(PathIdList); + end + else + Result := DriveToPidlBind(FileName, Folder); + end; +end; + +function PidlBindToParent(IdList: PItemIdList; out Folder: IShellFolder; out Last: PItemIdList): Boolean; +var + Path: string; +begin + Last := nil; + Path := PidlToPath(IdList); + Last := PathToPidlBind(Path, Folder); + Result := Last <> nil; + if Last = nil then + Folder := nil; +end; + +function PidlCompare(Pidl1, Pidl2: PItemIdList): Boolean; +var + L: Integer; +begin + Result := False; + L := PidlGetLength(Pidl1); + if L = PidlGetLength(Pidl2) then + Result := CompareMem(Pidl1, Pidl2, L); +end; + +function PidlCopy(Source: PItemIdList; out Dest: PItemIdList): Boolean; +var + L: Integer; +begin + Result := False; + Dest := Source; + if Source <> nil then + begin + L := PidlGetLength(Source) + 2; + if SHAllocMem(Pointer(Dest), L) then + begin + Move(Source^, Dest^, L); + Result := True; + end; + end; +end; + +function PidlFree(var IdList: PItemIdList): Boolean; +var + Malloc: IMalloc; +begin + Result := False; + if IdList = nil then + Result := True + else + begin + Malloc := nil; + if Succeeded(SHGetMalloc(Malloc)) and (Malloc.DidAlloc(IdList) > 0) then + begin + Malloc.Free(IdList); + IdList := nil; + Result := True; + end; + end; +end; + +function PidlGetDepth(Pidl: PItemIdList): Integer; +var + P: PItemIdList; +begin + Result := 0; + if Pidl <> nil then + begin + P := Pidl; + while (P^.mkId.cb <> 0) and (Result < MAX_PATH) do + begin + Inc(Result); + P := PItemIdList(@P^.mkId.abID[P^.mkId.cb - 2]); + end; + end; + if Result = MAX_PATH then + Result := -1; +end; + +function PidlGetLength(Pidl: PItemIdList): Integer; +var + P: PItemIdList; + I: Integer; +begin + Result := 0; + if Pidl <> nil then + begin + I := 0; + P := Pidl; + while (P^.mkId.cb <> 0) and (I < MAX_PATH) do + begin + Inc(I); + Inc(Result, P^.mkId.cb); + P := PItemIdList(@P^.mkId.abID[P^.mkId.cb - 2]); + end; + if I = MAX_PATH then + Result := -1; + end; +end; + +function PidlGetNext(Pidl: PItemIdList): PItemIdList; +begin + Result := nil; + if (Pidl <> nil) and (Pidl^.mkid.cb <> 0) then + begin + Result := PItemIdList(@Pidl^.mkId.abID[Pidl^.mkId.cb - 2]); + if Result^.mkid.cb = 0 then + Result := nil; + end; +end; + +function PidlToPath(IdList: PItemIdList): string; +begin + SetLength(Result, MAX_PATH); + if SHGetPathFromIdList(IdList, PChar(Result)) then + StrResetLength(Result) + else + Result := ''; +end; + +function StrRetFreeMem(StrRet: TStrRet): Boolean; +begin + Result := False; + if StrRet.uType = STRRET_WSTR then + Result := SHFreeMem(Pointer(StrRet.pOleStr)); +end; + +function StrRetToString(IdList: PItemIdList; StrRet: TStrRet; Free: Boolean): string; +begin + case StrRet.uType of + STRRET_WSTR: + begin + Result := WideCharToString(StrRet.pOleStr); + if Free then + SHFreeMem(Pointer(StrRet.pOleStr)); + end; + STRRET_OFFSET: + if IdList <> nil then + Result := PChar(IdList) + StrRet.uOffset + else + Result := ''; + STRRET_CSTR: + Result := string(AnsiString(StrRet.cStr)); + else + Result := ''; + end; +end; + +//=== ShortCuts / Shell link ================================================= + +procedure ShellLinkFree(var Link: TShellLink); +begin + PidlFree(Link.IdList); +end; + +const + {$IFDEF SUPPORTS_UNICODE} + IID_IShellLink: TGUID = { IID_IShellLinkW } + (D1:$000214F9; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46)); + {$ELSE ~SUPPORTS_UNICODE} + IID_IShellLink: TGUID = { IID_IShellLinkA } + (D1:$000214EE; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46)); + {$ENDIF ~SUPPORTS_UNICODE} + +function ShellLinkCreateSystem(const Link: TShellLink; const Folder: Integer; + const FileName: string): HRESULT; +var + Path: string; + Pidl: PItemIDList; +begin + Result := E_INVALIDARG; + SetLength(Path, MAX_PATH); + if Succeeded(SHGetSpecialFolderLocation(0, Folder, Pidl)) then + begin + try + Path := PidltoPath(Pidl); + if Path <> '' then + begin + StrResetLength(Path); + Result := ShellLinkCreate(Link, PathAddSeparator(Path) + FileName); + end; + finally + CoTaskMemFree(Pidl); + end; + end; +end; + +function ShellLinkCreate(const Link: TShellLink; const FileName: string): HRESULT; +var + ShellLink: IShellLink; + PersistFile: IPersistFile; + LinkName: TWidePathPtr; +begin + Result := CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, + IID_IShellLink, ShellLink); + if Succeeded(Result) then + begin + ShellLink.SetArguments(PChar(Link.Arguments)); + ShellLink.SetShowCmd(Link.ShowCmd); + ShellLink.SetWorkingDirectory(PChar(Link.WorkingDirectory)); + ShellLink.SetPath(PChar(Link.Target)); + ShellLink.SetDescription(PChar(Link.Description)); + ShellLink.SetHotkey(Link.HotKey); + ShellLink.SetIconLocation(PChar(Link.IconLocation), Link.IconIndex); + PersistFile := ShellLink as IPersistFile; + {$IFDEF SUPPORTS_UNICODE} + LinkName := PChar(FileName); + {$ELSE ~SUPPORTS_UNICODE} + MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PAnsiChar(FileName), -1, + LinkName, MAX_PATH); + {$ENDIF ~SUPPORTS_UNICODE} + Result := PersistFile.Save(LinkName, True); + end; +end; + +function RtdlLoadMsiFuncs:Boolean; +begin + Result:=False; + if LoadModule(rtdlMsiLibHandle,MSILIB) then + begin + if not Assigned(RtdlMsiGetShortcutTarget) then + RtdlMsiGetShortcutTarget := GetModuleSymbol(rtdlMsiLibHandle,GetShortcutTargetName); + + if not Assigned(RtdlMsiGetComponentPath) then + RtdlMsiGetComponentPath := GetModuleSymbol(rtdlMsiLibHandle,GetComponentPathName); + + Result:=(Assigned(RtdlMsiGetShortcutTarget)) and (Assigned(RtdlMsiGetComponentPath)); + end; +end; + +function ShellLinkResolve(const FileName: string; out Link: TShellLink): HRESULT; +begin + Result := ShellLinkResolve(FileName, Link, SLR_ANY_MATCH); +end; + +function ShellLinkResolve(const FileName: string; out Link: TShellLink; + const ResolveFlags: Cardinal): HRESULT; +const + MAX_FEATURE_CHARS = 38; // maximum chars in MSI feature name +var + ShellLink: IShellLink; + PersistFile: IPersistFile; + LinkName: TWidePathPtr; + Buffer: string; + Win32FindData: TWin32FindData; + FullPath: string; + ProductGuid: array [0..38] of Char; + FeatureID: array [0..MAX_FEATURE_CHARS] of Char; + ComponentGUID: array [0..38] of Char; + TargetFile: array [0..MAX_PATH] of Char; + PathSize: DWORD; + TargetResolved: Boolean; +begin + Result := CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, + IID_IShellLink, ShellLink); + + if Succeeded(Result) then + begin + TargetResolved := False; + + // Handle MSI style shortcuts without invoking the Windows installer if + // the feature was set to "Install on first use" + if RtdlLoadMsiFuncs then + begin + ResetMemory(ProductGuid, SizeOf(ProductGuid)); + ResetMemory(FeatureID, SizeOf(FeatureID)); + ResetMemory(ComponentGuid, SizeOf(ComponentGuid)); + ResetMemory(TargetFile, SizeOf(TargetFile)); + + if RtdlMsiGetShortcutTarget(PChar(FileName), ProductGuid, FeatureID, ComponentGuid) = ERROR_SUCCESS then + begin + PathSize := MAX_PATH + 1; + RtdlMsiGetComponentPath(ProductGuid, ComponentGuid, TargetFile, @PathSize); + + if TargetFile <> '' then + begin + Link.Target := TargetFile; + TargetResolved := True; + end; + end; + end; + + PersistFile := ShellLink as IPersistFile; + // PersistFile.Load fails if the filename is not fully qualified + FullPath := ExpandFileName(FileName); + {$IFDEF SUPPORTS_UNICODE} + LinkName := PWideChar(FullPath); + {$ELSE ~SUPPORTS_UNICODE} + MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PAnsiChar(FullPath), -1, LinkName, MAX_PATH); + {$ENDIF ~SUPPORTS_UNICODE} + Result := PersistFile.Load(LinkName, STGM_READ); + + if Succeeded(Result) then + begin + Result := ShellLink.Resolve(0, ResolveFlags); + + if Succeeded(Result) then + begin + SetLength(Buffer, MAX_PATH); + + if not TargetResolved then + begin + Win32FindData.dwFileAttributes := 0; + ShellLink.GetPath(PChar(Buffer), MAX_PATH, Win32FindData, SLGP_SHORTPATH); + Link.Target := PChar(Buffer); + end; + + ShellLink.GetArguments(PChar(Buffer), MAX_PATH); + Link.Arguments := PChar(Buffer); + ShellLink.GetShowCmd(Link.ShowCmd); + ShellLink.GetWorkingDirectory(PChar(Buffer), MAX_PATH); + Link.WorkingDirectory := PChar(Buffer); + ShellLink.GetDescription(PChar(Buffer), MAX_PATH); + Link.Description := PChar(Buffer); + ShellLink.GetIconLocation(PChar(Buffer), MAX_PATH, Link.IconIndex); + Link.IconLocation := PChar(Buffer); + ShellLink.GetHotkey(Link.HotKey); + ShellLink.GetIDList(Link.IdList); + end; + end; + end; +end; + +function ShellLinkIcon(const Link: TShellLink): HICON; overload; +var + LocExt: string; + Info: TSHFileInfo; +begin + Result := 0; + LocExt := LowerCase(ExtractFileExt(Link.IconLocation)); + // 1. See if IconLocation specifies a valid icon file + if (LocExt = '.ico') and (FileExists(Link.IconLocation)) then + begin + { TODO : Implement loading from an .ico file } + end; + // 2. See if IconLocation specifies an executable + if Result = 0 then + begin + if (LocExt = '.dll') or (LocExt = '.exe') then + Result := ExtractIcon(0, PChar(Link.IconLocation), Link.IconIndex); + end; + // 3. See if target specifies a file + if Result = 0 then + begin + if FileExists(Link.Target) then + Result := ExtractIcon(0, PChar(Link.Target), Link.IconIndex); + end; + // 4. See if the target is an object + if Result = 0 then + begin + if Link.IdList <> nil then + begin + ResetMemory(Info, SizeOf(Info)); + if SHGetFileInfo(PChar(Link.IdList), 0, Info, SizeOf(Info), SHGFI_PIDL or SHGFI_ICON) <> 0 then + Result := Info.hIcon; + end; + end; +end; + +function ShellLinkIcon(const FileName: string): HICON; overload; +var + Link: TShellLink; +begin + if Succeeded(ShellLinkResolve(FileName, Link)) then + begin + Result := ShellLinkIcon(Link); + ShellLinkFree(Link); + end + else + Result := 0; +end; + +function ShellLinkShortCut(const Link: TShellLink): TShortCut; +type + THotKeyModifiers = set of (hkShift, hkCtrl, hkAlt, hkExt); +var + Modifiers: THotKeyModifiers; +begin + if Link.HotKey = 0 then + Result := scNone + else + begin + Modifiers := THotKeyModifiers(HiByte(Link.HotKey)); + Result := LoWord(LoByte(Link.HotKey)); + if hkShift in Modifiers then + Result := Result or scShift; + if hkCtrl in Modifiers then + Result := Result or scCtrl; + if hkAlt in Modifiers then + Result := Result or scAlt; + end; +end; + + +//=== Miscellaneous ========================================================== + +function SHGetItemInfoTip(const Folder: IShellFolder; Item: PItemIdList): string; +var + QueryInfo: IQueryInfo; + InfoTip: PWideChar; +begin + Result := ''; + if (Item = nil) or (Folder = nil) then + Exit; + if Succeeded(Folder.GetUIObjectOf(0, 1, Item, IQueryInfo, nil, + Pointer(QueryInfo))) then + begin + InfoTip := nil; + if Succeeded(QueryInfo.GetInfoTip(0, InfoTip)) then + begin + Result := WideCharToString(InfoTip); + SHFreeMem(Pointer(InfoTip)); + end; + end; +end; + +function SHDllGetVersion(const FileName: string; var Version: TDllVersionInfo): Boolean; +type + TDllGetVersionProc = function (var pdvi: TDllVersionInfo): HRESULT; stdcall; +var + _DllGetVersion: TDllGetVersionProc; + LibHandle: HINST; +begin + Result := False; + LibHandle := SafeLoadLibrary(FileName); + if LibHandle <> 0 then + begin + @_DllGetVersion := GetProcAddress(LibHandle, PChar('DllGetVersion')); + if @_DllGetVersion <> nil then + begin + Version.cbSize := SizeOf(TDllVersionInfo); + Result := Succeeded(_DllGetVersion(Version)); + end; + FreeLibrary(LibHandle); + end; +end; + +function OverlayIcon(var Icon: HICON; Overlay: HICON; Large: Boolean): Boolean; +var + Source, Dest: HIMAGELIST; + Width, Height: Integer; +begin + Result := False; + if Large then + begin + Width := GetSystemMetrics(SM_CXICON); + Height := GetSystemMetrics(SM_CYICON); + Source := ImageList_Create(Width, Height, ILC_MASK or ILC_COLOR32, 1, 0); + end + else + begin + Width := GetSystemMetrics(SM_CXSMICON); + Height := GetSystemMetrics(SM_CYSMICON); + Source := ImageList_Create(Width, Height, ILC_MASK or ILC_COLOR32, 1, 0); + end; + if Source <> 0 then + begin + if (ImageList_AddIcon(Source, Icon) <> -1) and + (ImageList_AddIcon(Source, Overlay) <> -1) then + begin + Dest := HIMAGELIST(ImageList_Merge(Source, 0, Source, 1, 0, 0)); + if Dest <> 0 then + begin + DestroyIcon(Icon); + Icon := ImageList_ExtractIcon(0, Dest, 0); + ImageList_Destroy(Dest); + Result := True; + end; + end; + ImageList_Destroy(Source); + end; +end; + +function OverlayIconShortCut(var Large, Small: HICON): Boolean; +var + OvlLarge, OvlSmall: HICON; +begin + Result := False; + OvlLarge := 0; + OvlSmall := 0; + if ExtractIconEx(PChar('shell32.dll'), 29, OvlLarge, OvlSmall, 1) = 2 then + begin + OverlayIcon(Large, OvlLarge, True); + OverlayIcon(Small, OvlSmall, False); + end; +end; + +function OverlayIconShared(var Large, Small: HICON): Boolean; +var + OvlLarge, OvlSmall: HICON; +begin + Result := False; + OvlLarge := 0; + OvlSmall := 0; + if ExtractIconEx(PChar('shell32.dll'), 28, OvlLarge, OvlSmall, 1) = 2 then + begin + OverlayIcon(Large, OvlLarge, True); + OverlayIcon(Small, OvlSmall, False); + end; +end; + +function GetSystemIcon(IconIndex: Integer; Flags: Cardinal): HICON; +var + FileInfo: TSHFileInfo; + ImageList: HIMAGELIST; +begin + ResetMemory(FileInfo, SizeOf(FileInfo)); + if Flags = 0 then + Flags := SHGFI_SHELLICONSIZE; + ImageList := SHGetFileInfo('', 0, FileInfo, SizeOf(FileInfo), + Flags or SHGFI_SYSICONINDEX); + Result := ImageList_ExtractIcon(0, ImageList, IconIndex); +end; + +function ShellExecEx(const FileName: string; const Parameters: string; + const Verb: string; CmdShow: Integer): Boolean; +var + Sei: TShellExecuteInfo; +begin + ResetMemory(Sei, SizeOf(Sei)); + Sei.cbSize := SizeOf(Sei); + Sei.fMask := SEE_MASK_DOENVSUBST or SEE_MASK_FLAG_NO_UI; + Sei.lpFile := PChar(FileName); + Sei.lpParameters := PCharOrNil(Parameters); + Sei.lpVerb := PCharOrNil(Verb); + Sei.nShow := CmdShow; + {$TYPEDADDRESS ON} + Result := ShellExecuteEx(@Sei); + {$IFNDEF TYPEDADDRESS_ON} + {$TYPEDADDRESS OFF} + {$ENDIF ~TYPEDADDRESS_ON} +end; + +{ TODO -cHelp : author Jean-Fabien Connault note, ShellExecEx() above used to be ShellExec()... } + +function ShellExec(Wnd: Integer; const Operation, FileName, Parameters, Directory: string; ShowCommand: Integer): Boolean; +begin + Result := ShellExecute(Wnd, PChar(Operation), PChar(FileName), PChar(Parameters), + PChar(Directory), ShowCommand) > 32; +end; + +function ShellExecAndWait(const FileName: string; const Parameters: string; + const Verb: string; CmdShow: Integer; const Directory: string): Boolean; +var + Sei: TShellExecuteInfo; + Res: LongBool; + Msg: tagMSG; +begin + ResetMemory(Sei, SizeOf(Sei)); + Sei.cbSize := SizeOf(Sei); + Sei.fMask := SEE_MASK_DOENVSUBST or SEE_MASK_FLAG_NO_UI or SEE_MASK_NOCLOSEPROCESS or + SEE_MASK_FLAG_DDEWAIT; + Sei.lpFile := PChar(FileName); + Sei.lpParameters := PCharOrNil(Parameters); + Sei.lpVerb := PCharOrNil(Verb); + Sei.nShow := CmdShow; + Sei.lpDirectory := PCharOrNil(Directory); + {$TYPEDADDRESS ON} + Result := ShellExecuteEx(@Sei); + {$IFNDEF TYPEDADDRESS_ON} + {$TYPEDADDRESS OFF} + {$ENDIF ~TYPEDADDRESS_ON} + if Result then + begin + WaitForInputIdle(Sei.hProcess, INFINITE); + while WaitForSingleObject(Sei.hProcess, 10) = WAIT_TIMEOUT do + repeat + Msg.hwnd := 0; + Res := PeekMessage(Msg, Sei.Wnd, 0, 0, PM_REMOVE); + if Res then + begin + TranslateMessage(Msg); + DispatchMessage(Msg); + end; + until not Res; + CloseHandle(Sei.hProcess); + end; +end; + +function ShellOpenAs(const FileName: string): Boolean; +begin + Result := ShellExecEx('rundll32', Format('shell32.dll,OpenAs_RunDLL "%s"', [FileName]), '', SW_SHOWNORMAL); +end; + +{ TODO: Dynamic linking - move TRasDialDlgA to JclWin32} +type + TRasDialDlgFunc = function(lpszPhonebook, lpszEntry, lpszPhoneNumber: PChar; lpInfo: PRasDialDlg): BOOL; stdcall; + +function ShellRasDial(const EntryName: string): Boolean; +var + Info: TRasDialDlg; + RasDlg: HModule; + RasDialDlg: TRasDialDlgFunc; +begin + if IsWinNT then + begin + Result := False; + RasDlg := SafeLoadLibrary('rasdlg.dll'); + if RasDlg <> 0 then + try + @RasDialDlg := GetProcAddress(RasDlg, PChar('RasDialDlg' + AWSuffix)); + if @RasDialDlg <> nil then + begin + ResetMemory(Info, SizeOf(Info)); + Info.dwSize := SizeOf(Info); + Result := RasDialDlg(nil, PChar(EntryName), nil, @Info); + end; + finally + FreeLibrary(RasDlg); + end; + end + else + Result := ShellExecEx('rundll32', Format('rnaui.dll,RnaDial "%s"', [EntryName]), '', SW_SHOWNORMAL); +end; + +// You can pass simple name of standard system control panel (e.g. 'timedate') +// or full qualified file name (Window 95 only? doesn't work on Win2K!) +// MT: Added support for Windows 98..XP. Have no win95 anymore so I have to +// trust that the original version works on Windows 95 and Windows 95OSR2. + +function ShellRunControlPanel(const NameOrFileName: string; AppletNumber: Integer): Boolean; +var + FileName: TFileName; +begin + if ExtractFilePath(NameOrFileName) = '' then + FileName := ChangeFileExt(PathAddSeparator(GetWindowsSystemFolder) + NameOrFileName, '.cpl') + else + FileName := NameOrFileName; + if FileExists(FileName) then + begin + if (IsWin95 or IsWin95OSR2) then + Result := ShellExecEx('rundll32', Format('shell32.dll,Control_RunDLL "%s", @%d', + [FileName, AppletNumber]), '', SW_SHOWNORMAL) + else + Result := ShellExecEx('rundll32', Format('shell32.dll,Control_RunDLL "%s",,%d', + [FileName, AppletNumber]), '', SW_SHOWNORMAL) + end + else + begin + Result := False; + SetLastError(ERROR_FILE_NOT_FOUND); + end; +end; + +// Compare http://msdn.microsoft.com/en-us/library/bb756922.aspx + +function RunAsAdmin(const FileName: string; const Parameters: string = ''; const Parent: THandle = 0): Boolean; +var + Sei: TShellExecuteInfo; +begin + ResetMemory(Sei, SizeOf(Sei)); + Sei.cbSize := SizeOf(TShellExecuteInfo); + Sei.Wnd := Parent; + Sei.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI; + Sei.lpVerb := PChar(cVerbRunas); + Sei.lpFile := PChar(FileName); + Sei.lpParameters := PCharOrNil(Parameters); + Sei.nShow := SW_SHOWNORMAL; + + {$TYPEDADDRESS ON} + Result := ShellExecuteEx(@Sei); + {$IFNDEF TYPEDADDRESS_ON} + {$TYPEDADDRESS OFF} + {$ENDIF ~TYPEDADDRESS_ON} +end; + +function GetFileExeType(const FileName: TFileName): TJclFileExeType; +var + FileInfo: TSHFileInfo; + R: DWORD; +begin + FileInfo.dwAttributes := 0; + R := SHGetFileInfo(PChar(FileName), 0, FileInfo, SizeOf(FileInfo), SHGFI_EXETYPE); + case LoWord(R) of + IMAGE_DOS_SIGNATURE: + Result := etMsDos; + IMAGE_OS2_SIGNATURE: + Result := etWin16; + Word(IMAGE_NT_SIGNATURE): + if HiWord(R) = 0 then + Result := etWin32Con + else + Result := etWin32Gui; + else + Result := etError; + end; +end; + +function ShellFindExecutable(const FileName, DefaultDir: string): string; +var + Res: HINST; + Buffer: array [0..MAX_PATH-1] of Char; + I: Integer; +begin + ResetMemory(Buffer, SizeOf(Buffer)); + Res := FindExecutable(PChar(FileName), PCharOrNil(DefaultDir), Buffer); + if Res > 32 then + begin + // FindExecutable replaces #32 with #0 + for I := Low(Buffer) to High(Buffer) - 1 do + if Buffer[I] = #0 then + Buffer[I] := #32; + Buffer[High(Buffer)] := #0; + Result := Trim(Buffer); + end + else + Result := ''; +end; + +function GetFileNameIcon(const FileName: string; Flags: Cardinal = 0): HICON; +var + FileInfo: TSHFileInfo; + ImageList: HIMAGELIST; +begin + ResetMemory(FileInfo, SizeOf(FileInfo)); + if Flags = 0 then + Flags := SHGFI_SHELLICONSIZE; + ImageList := SHGetFileInfo(PChar(FileName), 0, FileInfo, SizeOf(FileInfo), + Flags or SHGFI_SYSICONINDEX); + if ImageList <> 0 then + Result := ImageList_ExtractIcon(0, ImageList, FileInfo.iIcon) + else + Result := 0; +end; + +initialization + //We don't load the msi functions until the first attempt to resolve an MSI link + + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + UnloadModule(rtdlMsiLibHandle); + +end. + + diff --git a/3rdParty/JCL/source/windows/JclStructStorage.pas b/3rdParty/JCL/source/windows/JclStructStorage.pas new file mode 100644 index 00000000..e15100a9 --- /dev/null +++ b/3rdParty/JCL/source/windows/JclStructStorage.pas @@ -0,0 +1,808 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclStructStore.pas. } +{ } +{ The Initial Developer of the Original Code is Peter Thornqvist. } +{ Portions created by Peter Thornqvist are Copyright (C) Peter Thornqvist. All Rights Reserved. } +{ } +{ Contributor(s): } +{ A. Schmidt (shmia (at) bizerba.de) } +{ } +{**************************************************************************************************} +{ } +{ MS Structured storage class wrapper } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +{ +Description: + +Wrapper around MS structured storage library to simplify handling compound files +(the filetype used in Word, Excel, newer versions of Access, Project et al). + +Note that MS documentation uses the terms "Storage" and "Streams". I've decided to use the +names Folders (for Storages) and Files (for Streams) since that more closely +resembles how the content of a compound file is percieved and used. + +Very briefly, a compound (or structured) file is a disk file that contains data organized +in an internal structure. The structure is similar to a normal file system +in that the file can contain folders (storages) and subfiles (streams). Folders +can contain subfolders and files but no data of it's own, files can contain data but no subitems. + +This implementation is simplified in a number of ways compared to what can actually be +done with the IStorage implementation in Windows: + +* creating a new file with the same name as an existing will silently overwrite + the existing file, even if it's not a compound file +* SetClassID has not been implemented / surfaced +* STGM_SIMPLE, STGM_PRIORITY, STGM_NOSCRATCH, STGM_FAILIFTHERE and a few other esoteric flags are not supported + +BTW, what's the difference between "compound" and "structured"? MS seems a bit confused +themselves on this topic, but it looks like the term "compound file" is used to +describe the actual Microsoft OLE/COM implementation of the theoretical idea +of "structured storage"... + +-----------------------------------------------------------------------------} + +unit JclStructStorage; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, System.Classes, System.SysUtils, Winapi.ActiveX, + {$ELSE ~HAS_UNITSCOPE} + Windows, Classes, SysUtils, ActiveX, + {$ENDIF ~HAS_UNITSCOPE} + JclBase; + +type + EJclStructStorageError = class(EJclError); + TJclStructStorageAccessMode = (smOpenRead, smOpenWrite, smCreate, smShareDenyRead, smShareDenyWrite, smTransacted); + TJclStructStorageAccessModes = set of TJclStructStorageAccessMode; + + TJclStructStorageFolder = class(TPersistent) + private + function GetName: string; + protected + FStorage: IStorage; + FLastError: HRESULT; + FFileName: string; + FAccessMode: TJclStructStorageAccessModes; + FConvertedMode: UINT; + procedure Check; + function CheckResult(HR: HRESULT): Boolean; + // Calls to Dest.Assign will eventually end up here. + // AssignTo is implemented as a call to IStorage.CopyTo(Dest) + // This method merges elements contained in the source storage object with + // those already present in the destination. The layout of the destination + // storage object may differ from the source storage object. + // The copy process is recursive, invoking IStorage::CopyTo and IStream::CopyTo + // on the elements nested inside the source. + // When copying a stream on top of an existing stream with the same name, + // the existing stream is first removed and then replaced with the source stream. + // When copying a storage on top of an existing storage with the same name, + // the existing storage is not removed. As a result, after the copy operation, + // the destination IStorage contains older elements, unless they were replaced by + // newer ones with the same names. + procedure AssignTo(Dest: TPersistent); override; + public + // Returns S_OK if FileName is a compound file + class function IsStructured(const FileName: string): HRESULT; + // Converts FileName to a structured file and puts the existing content of the file + // into a root file stream called 'CONTENTS' + // Returns S_OK or STG_S_CONVERTED if the file could be converted or if it was already a structured file + class function Convert(const FileName: string): HRESULT; + // Copies a sub storage or stream to another storage + // Before calling this method, the element to be copied must be closed, + // and the destination storage must be open. Also, the destination object + // and element cannot be the same storage object/element name as the source + // of the copy. That is, you cannot copy an element to itself. + function CopyTo(const OldName, NewName: string; Dest: TJclStructStorageFolder): Boolean; + // Moves a sub storage or stream to another storage + // Before calling this method, the element to be moved must be closed, + // and the destination storage must be open. Also, the destination object + // and element cannot be the same storage object/element name as the source + // of the move. That is, you cannot move an element to itself. + function MoveTo(const OldName, NewName: string; Dest: TJclStructStorageFolder): Boolean; + // Commits any changes when smTransacted is true + // When smTransacted is false, changes are committed immediately and thus cannot be committed + function Commit: Boolean; + // Reverts any changes when smTransacted is true + // When smTransacted is false, changes are committed immediately and thus cannot be reverted + function Revert: Boolean; + // Create a new or open an existing structured file (or subfolder) depending on AccessMode. + // NOTE that the file will not actually be opened or created until you call + // one of the methods in this class (except for Destroy). To force a direct open of the file, set OpenDirect to true + constructor Create(const FileName: string; AccessMode: TJclStructStorageAccessModes; + OpenDirect: Boolean = False); virtual; + // Destroys the class instance and releases the compound file (or subfolder) + destructor Destroy; override; + // Returns statistics for this storage. The returned structure contains + // various information about the storage. NOTE that some items may not always be valid or set + // (f ex the GUID or the date values) + // + // NOTE: if you call this function with IncludeName = true, you *must* + // free the returned Stat by calling FreeStats; + function GetStats(out Stat: TStatStg; IncludeName: Boolean): Boolean; + procedure FreeStats(var Stat: TStatStg); + // Gets the names of all subitems (files or folders depending on the Folders flag) of this storage + // and puts it in Strings. Strings is cleared before adding the items + function GetSubItems(Strings: TStrings; Folders: Boolean): Boolean; + // Adds a new file or folder to this folder. If the file/folder already exists, it is overwritten. + // NB: Name must be < 31 characters + function Add(const Name: string; IsFolder: Boolean): Boolean; + // Deletes a file /folder + function Delete(const Name: string): Boolean; + // Renames a file/folder. The element must be closed before calling this method + // NB: NewName must be < 31 characters + function Rename(const OldName, NewName: string): Boolean; + // Returns an existing folder by name. The folder is opened using the same AccessMode + // as passed into the constructor, except for any smCreate and with sharing set to [smShareDenyRead,smShareDenyWrite] + // because the MS implementation doesn't support opening the same storage more than once + // from the same parent storage + function GetFolder(const Name: string; out Storage: TJclStructStorageFolder): Boolean; + // Returns an existing file stream by name. The stream is opened using the same AccessMode + // as passed into the constructor, except for any smCreate and with sharing set to [smShareDenyRead,smShareDenyWrite] + // because the MS implementation doesn't support opening the same stream more than once + // from the same parent storage + function GetFileStream(const Name: string; out Stream: TStream): Boolean; + // Set the various time fields -a(ccess)time, c(reation)time, m(odified)time - for + // a stream or storage as specified by Name. Values in Stat that are set to 0 are left + // unmodified. + // To set these values for the root storage, pass an empty string in Name. + // To get the current values, call GetStats on the specific storage or stream + function SetElementTimes(const Name: string; Stat: TStatStg): Boolean; + + // The name of the storage, either a (sub)folder name or the fully qualified name of the disk file (for the root object) + property Name: string read GetName; + // pointer to the IStorage + property Intf: IStorage read FStorage; + // last error for this object (can be S_OK) + property LastError: HRESULT read FLastError; + end; + + // NOTE: you should not create instances of this class: an instance is created by + // TJclStructStorageFolder when you call GetFileStream + TJclStructStorageStream = class(TStream) + private + function GetName: string; + protected + FStream: IStream; + FName: string; + FLastError: HRESULT; + procedure Check; + function CheckResult(HR: HRESULT): Boolean; + procedure SetSize(NewSize: Longint); override; + public + destructor Destroy; override; + + // Returns the TStatStg for this stream. This structure contains + // the name, size and various date/time values for the stream in addition to + // several other values + // + // NOTE: if you call this function with IncludeName = true, you *must* + // free the returned Stat by calling FreStats or using this type of code: + // CoGetMalloc(1,AMalloc); + // AMalloc.Free(Stat.pwcsName) + // where AMalloc is declared as an IMalloc type + // see also example in TJclStructStorageFolder.GetSubItems above + function GetStats(out Stat: TStatStg; IncludeName: Boolean): Boolean; + procedure FreeStats(var Stat: TStatStg); + // Create a new stream that points to this stream. + // Returns nil on failure + // NB! Caller is responsible for freeing this object! + // To create a copy of a stream, call CopyTo instead + function Clone: TJclStructStorageStream; + function CopyTo(Stream: TJclStructStorageStream; Size: Int64): Boolean; + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + function Seek(Offset: Longint; Origin: Word): Longint; override; + // name of the stream + property Name: string read GetName; + // pointer to the IStream interface + property Intf: IStream read FStream; + // the last error for this object (can be S_OK) + property LastError: HRESULT read FLastError; + end; + +procedure CoMallocFree(P: Pointer); + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.Win.ComObj, + {$ELSE ~HAS_UNITSCOPE} + ComObj, + {$ENDIF ~HAS_UNITSCOPE} + JclResources; + +var + FMalloc: IMalloc = nil; + +// type + // PStgOptions = ^TStgOptions; + // tagSTGOPTIONS = record + // usVersion: Byte; + // reserved: Byte; + // ulSectorSize: DWORD; + // pwcsTemplateFile: POleStr; + // end; + // {$EXTERNALSYM tagSTGOPTIONS} + // TStgOptions = tagSTGOPTIONS; + + // TStgCreateStorageExFunc = function(pwcsName: POleStr; grfMode: Longint; StgFmt: Longint; grfAttrs: DWORD; pStgOptions: + // PStgOptions; + // reserved2: Pointer; riid: TIID; out ppObjectOpen: IUnknown): HRESULT; stdcall; + // TStgOpenStorageExFunc = function(pwcsName: POleStr; grfMode: Longint; StgFmt: Longint; grfAttrs: DWORD; pStgOptions: + // PStgOptions; + // reserved2: Pointer; riid: TIID; out ppObjectOpen: IUnknown): HRESULT; stdcall; + +//var + // replacements for StgCreateDocFile and StgOpenStorage on Win2k and XP - not currently used + // StgCreateStorageEx: TStgCreateStorageExFunc = nil; + // {$EXTERNALSYM StgCreateStorageEx} + // StgOpenStorageEx: TStgOpenStorageExFunc = nil; + // {$EXTERNALSYM StgOpenStorageEx} + +procedure CoMallocFree(P: Pointer); +begin + if FMalloc = nil then + OleCheck(CoGetMalloc(1, FMalloc)); + FMalloc.Free(P); +end; + +function AccessToMode(AccessMode: TJclStructStorageAccessModes): UINT; +begin + { NOTE: + MS has some very specific restrictions when combining the different + Mode flags and certain combinations will lead to errors. I have mostly resisted the + temptation to try to consolidate the restrictions here, so you might have to + read up on the valid combinations on MSDN. Generally, the following rules apply + when opening a file in non-transacted mode: + + * To create a new file, you must use [smCreate,smRead,smWrite,smShareDenyRead,smShareDenyWrite] + = STGM_CREATE or STGM_READWRITE or STGM_SHARE_EXCLUSIVE + * When opening as read-only, you must use [smRead,smShareDenyWrite] + = STGM_READ or STGM_SHARE_DENY_WRITE + * when opening for reading and writing, you must use [smRead,smWrite,smShareDenyRead,smShareDenyWrite] + = STGM_READWRITE or STGM_SHARE_EXCLUSIVE + + These restrictions pretty much exist for transacted files as well with the difference that most + errors are not reported until a call is made to Commit... + } + + // creation: + if smCreate in AccessMode then + begin + // only one valid combination, so set up and jump out: + Result := STGM_CREATE or STGM_READWRITE or STGM_SHARE_EXCLUSIVE; + Exit; + end; + + // transactions: + if smTransacted in AccessMode then + Result := STGM_TRANSACTED + else + Result := STGM_DIRECT; + + // access: + if AccessMode * [smOpenRead, smOpenWrite] = [smOpenRead, smOpenWrite] then + Result := Result or STGM_READWRITE // this is *not* the same as (STGM_READ or STGM_WRITE) + else + if smOpenWrite in AccessMode then + Result := Result or STGM_WRITE + else + if smOpenRead in AccessMode then // not strictly necessary, since STGM_READ = 0, but makes it more self-documenting + Result := Result or STGM_READ; + + // sharing: + if AccessMode * [smShareDenyRead, smShareDenyWrite] = [smShareDenyRead, smShareDenyWrite] then + Result := Result or STGM_SHARE_EXCLUSIVE // *not* the same as (STGM_SHARE_READ or STGM_SHARE_WRITE)! + else + if smShareDenyRead in AccessMode then + Result := Result or STGM_SHARE_DENY_READ + else + if smShareDenyWrite in AccessMode then + Result := Result or STGM_SHARE_DENY_WRITE + else + Result := Result or STGM_SHARE_DENY_NONE; + // not strictly necessary, since STGM_SHARE_DENY_NONE = 0, but makes it more self-documenting +end; + +// simpler and less convoluted than using StringToWideChar + +function StrToWChar(const S: string): PWideChar; +begin + if S = '' then + Result := nil + else + begin + {$IFDEF SUPPORTS_UNICODE} + Result := PWideChar(S); + {$ELSE ~SUPPORTS_UNICODE} + Result := AllocMem((Length(S)+1) * SizeOf(WideChar)); + MultiByteToWideChar(CP_ACP, 0, PChar(S), Length(S), Result, Length(S)); + // (outchy) length(S) is the number of characters, not the size in bytes + // (rom) fixed output buffer size (see Win32 help) + //MultiByteToWideChar(CP_ACP, 0, PChar(S), Length(S), Result, Length(S) div 2); + {$ENDIF ~SUPPORTS_UNICODE} + end; +end; + +procedure FreeWChar(W: PWideChar); +begin + {$IFNDEF SUPPORTS_UNICODE} + if Assigned(W) then + FreeMem(W); + {$ENDIF ~SUPPORTS_UNICODE} +end; + +//=== { TJclStructStorageFolder } ============================================ + +constructor TJclStructStorageFolder.Create(const FileName: string; AccessMode: TJclStructStorageAccessModes; + OpenDirect: Boolean = False); +begin + inherited Create; + FFileName := FileName; + FAccessMode := AccessMode; + FConvertedMode := AccessToMode(FAccessMode); + if FFileName = '' then + FConvertedMode := FConvertedMode or STGM_DELETEONRELEASE; + if OpenDirect then + Check; +end; + +destructor TJclStructStorageFolder.Destroy; +begin + FStorage := nil; + inherited Destroy; +end; + +function TJclStructStorageFolder.Add(const Name: string; + IsFolder: Boolean): Boolean; +var + AName: PWideChar; + Strg: IStorage; + Stm: IStream; +begin + Check; + AName := StrToWChar(Name); + try + // always overwrite existing (fails if storage/stream exists and is open) + if IsFolder then + Result := CheckResult(FStorage.CreateStorage(AName, STGM_CREATE or STGM_SHARE_EXCLUSIVE, 0, 0, Strg)) + else + Result := CheckResult(FStorage.CreateStream(AName, STGM_CREATE or STGM_SHARE_EXCLUSIVE, 0, 0, Stm)); + finally + FreeWChar(AName); + end; +end; + +function TJclStructStorageFolder.Delete(const Name: string): Boolean; +var + AName: PWideChar; +begin + Check; + AName := StrToWChar(Name); + try + Result := CheckResult(FStorage.DestroyElement(AName)); + finally + FreeWChar(AName); + end; +end; + +procedure TJclStructStorageFolder.Check; +var + AName: PWideChar; + HR: HRESULT; +begin + if FStorage = nil then + begin + AName := StrToWChar(FFileName); + try + if FConvertedMode and STGM_CREATE = STGM_CREATE then + HR := StgCreateDocfile(AName, FConvertedMode, 0, FStorage) + else + HR := StgOpenStorage(AName, nil, FConvertedMode, nil, 0, FStorage); + finally + FreeWChar(AName); + end; + if not Succeeded(HR) then + raise EJclStructStorageError.Create(SysErrorMessage(HR)); + end; +end; + +function TJclStructStorageFolder.CheckResult(HR: HRESULT): Boolean; +begin + Result := Succeeded(HR); + FLastError := HR; +end; + +function TJclStructStorageFolder.GetFileStream(const Name: string; out Stream: TStream): Boolean; +var + AName: PWideChar; + Stm: IStream; +begin + Check; + AName := StrToWChar(Name); + try + // Streams don't support transactions, so always create in direct mode + // Streams only support STGM_SHARE_EXCLUSIVE so add this explicitly + if Succeeded(FStorage.OpenStream(AName, nil, + AccessToMode(FAccessMode - [smCreate] + [smShareDenyRead, smShareDenyWrite]), 0, Stm)) then + begin + Stream := TJclStructStorageStream.Create; + TJclStructStorageStream(Stream).FStream := Stm; + TJclStructStorageStream(Stream).FName := Name; + Result := True; + end + else + begin + Result := False; + Stream := nil; + end; + finally + FreeWChar(AName); + end; +end; + +function TJclStructStorageFolder.GetFolder(const Name: string; out Storage: TJclStructStorageFolder): Boolean; +var + AName: PWideChar; + AMode: UINT; + Strg: IStorage; +begin + Check; + AName := StrToWChar(Name); + try + // Sub storages only supports STGM_SHARE_EXCLUSIVE, so add explicitly + AMode := AccessToMode(FAccessMode - [smCreate] + [smShareDenyRead, smShareDenyWrite]); + if Succeeded(FStorage.OpenStorage(AName, nil, + AMode, nil, 0, Strg)) then + begin + // The parameters here has no real meaning since we set up the private fields directly + Storage := TJclStructStorageFolder.Create(Name, FAccessMode); + TJclStructStorageFolder(Storage).FConvertedMode := AMode; + TJclStructStorageFolder(Storage).FStorage := Strg; + TJclStructStorageFolder(Storage).FFileName := Name; + Result := True; + end + else + begin + Storage := nil; + Result := False; + end; + finally + FreeWChar(AName); + end; +end; + +function TJclStructStorageFolder.GetSubItems(Strings: TStrings; + Folders: Boolean): Boolean; +var + Enum: IEnumSTATSTG; + Stat: TStatStg; + NumFetch: Longint; +begin + Check; + Strings.BeginUpdate; + try + Strings.Clear; + Result := CheckResult(FStorage.EnumElements(0, nil, 0, Enum)); + if not Result then + Exit; + while Succeeded(Enum.Next(1, Stat, @NumFetch)) and (NumFetch = 1) do + try + if Folders and (Stat.dwType = STGTY_STORAGE) then + Strings.Add(WideCharToString(Stat.pwcsName)) + else + if not Folders and (Stat.dwType = STGTY_STREAM) then + Strings.Add(WideCharToString(Stat.pwcsName)); + finally + CoMallocFree(Stat.pwcsName); + end; + finally + Strings.EndUpdate; + end; +end; + +function TJclStructStorageFolder.Rename(const OldName, NewName: string): Boolean; +var + PWO, PWN: PWideChar; +begin + Check; + PWO := StrToWChar(OldName); + PWN := StrToWChar(NewName); + try + // this will fail if the subelement is open + Result := CheckResult(FStorage.RenameElement(PWO, PWN)); + finally + FreeWChar(PWO); + FreeWChar(PWN); + end; +end; + +class function TJclStructStorageFolder.IsStructured(const FileName: string): HRESULT; +var + AName: PWideChar; +begin + AName := StrToWChar(FileName); + try + Result := StgIsStorageFile(AName); + finally + FreeWChar(AName); + end; +end; + +class function TJclStructStorageFolder.Convert(const FileName: string): HRESULT; +var + Strg: IStorage; + AName: PWideChar; +begin + Result := IsStructured(FileName); + if Succeeded(Result) then + begin + AName := StrToWChar(FileName); + try + Result := StgCreateDocFile(AName, STGM_READWRITE or STGM_SHARE_EXCLUSIVE or STGM_CONVERT, 0, Strg); +// Result := (HR = S_OK) or (HR = STG_S_CONVERTED); + finally + FreeWChar(AName); + end; + end; +end; + +function TJclStructStorageFolder.GetStats(out Stat: TStatStg; IncludeName: Boolean): Boolean; +const + Flags: array [Boolean] of Longint = + (STATFLAG_NONAME, STATFLAG_DEFAULT); +begin + Check; + Result := CheckResult(FStorage.Stat(Stat, Flags[IncludeName])); +end; + +function TJclStructStorageFolder.SetElementTimes(const Name: string; Stat: TStatStg): Boolean; +var + AName: PWideChar; +begin + Check; + AName := StrToWChar(Name); + try + with Stat do + Result := CheckResult(FStorage.SetElementTimes(AName, ctime, atime, mtime)); + finally + FreeWChar(AName); + end; +end; + +function TJclStructStorageFolder.Commit: Boolean; +begin + Check; + Result := CheckResult(FStorage.Commit(STGC_DEFAULT)) or + CheckResult(FStorage.Commit(STGC_OVERWRITE)); +end; + +function TJclStructStorageFolder.Revert: Boolean; +begin + Check; + Result := CheckResult(FStorage.Revert); +end; + +function TJclStructStorageFolder.CopyTo(const OldName, NewName: string; Dest: TJclStructStorageFolder): Boolean; +var + PWO, PWN: PWideChar; +begin + Result := False; + if Dest = nil then + Exit; + Check; + Dest.Check; + PWO := StrToWChar(OldName); + PWN := StrToWChar(NewName); + try + Result := CheckResult(FStorage.MoveElementTo(PWO, Dest.FStorage, PWN, STGMOVE_COPY)); + finally + FreeWChar(PWO); + FreeWChar(PWN); + end; +end; + +procedure TJclStructStorageFolder.AssignTo(Dest: TPersistent); +begin + if Dest is TJclStructStorageFolder then + begin + Check; + TJclStructStorageFolder(Dest).Check; + CheckResult(FStorage.CopyTo(0, nil, nil, TJclStructStorageFolder(Dest).FStorage)); + end + else + inherited AssignTo(Dest); +end; + +function TJclStructStorageFolder.MoveTo(const OldName, NewName: string; + Dest: TJclStructStorageFolder): Boolean; +var + PWO, PWN: PWideChar; +begin + Result := False; + if Dest = nil then + Exit; + Check; + Dest.Check; + PWO := StrToWChar(OldName); + PWN := StrToWChar(NewName); + try + Result := CheckResult(FStorage.MoveElementTo(PWO, Dest.FStorage, PWN, STGMOVE_MOVE)); + finally + FreeWChar(PWO); + FreeWChar(PWN); + end; +end; + +function TJclStructStorageFolder.GetName: string; +var + Stat: StatStg; +begin + if (FStorage <> nil) and CheckResult(FStorage.Stat(Stat, STATFLAG_DEFAULT)) then + begin + Result := WideCharToString(Stat.pwcsName); + CoMallocFree(Stat.pwcsName); + end + else + Result := FFileName; +end; + +procedure TJclStructStorageFolder.FreeStats(var Stat: TStatStg); +begin + if Stat.pwcsName <> nil then + CoMallocFree(Stat.pwcsName); +end; + +//=== { TJclStructStorageStream } ============================================ + +destructor TJclStructStorageStream.Destroy; +begin + FStream := nil; + inherited Destroy; +end; + +procedure TJclStructStorageStream.Check; +begin + if FStream = nil then + raise EJclStructStorageError.CreateRes(@RsIStreamNil); +end; + +function TJclStructStorageStream.CheckResult(HR: HRESULT): Boolean; +begin + Result := Succeeded(HR); + FlastError := HR; +end; + +function TJclStructStorageStream.Clone: TJclStructStorageStream; +var + Stm: IStream; +begin + if Succeeded(FStream.Clone(Stm)) then + begin + Result := TJclStructStorageStream.Create; + Result.FStream := Stm; + end + else + Result := nil; +end; + +function TJclStructStorageStream.CopyTo(Stream: TJclStructStorageStream; + Size: Int64): Boolean; +var + DidRead, DidWrite: {$IFDEF RTL290_UP}LargeUInt{$ELSE}Largeint{$ENDIF RTL290_UP}; +begin + DidRead := 0; + DidWrite := 0; + Result := Succeeded(FStream.CopyTo(Stream.FStream, Size, DidRead, DidWrite)); +end; + +procedure TJclStructStorageStream.FreeStats(var Stat: TStatStg); +begin + if Stat.pwcsName <> nil then + CoMallocFree(Stat.pwcsName); +end; + +function TJclStructStorageStream.GetName: string; +var + Stat: StatStg; +begin + if (FStream <> nil) and CheckResult(FStream.Stat(Stat, STATFLAG_DEFAULT)) then + begin + Result := WideCharToString(Stat.pwcsName); + CoMallocFree(Stat.pwcsName); + end + else + Result := Fname; +end; + +function TJclStructStorageStream.GetStats(out Stat: TStatStg; IncludeName: Boolean): Boolean; +const + Flags: array [Boolean] of Longint = + (STATFLAG_NONAME, STATFLAG_DEFAULT); +begin + Check; + Result := CheckResult(FStream.Stat(Stat, Flags[IncludeName])); +end; + +function TJclStructStorageStream.Read(var Buffer; Count: Longint): Longint; +begin + Check; + if not Succeeded(FStream.Read(@Buffer, Count, @Result)) then + Result := 0; +end; + +function TJclStructStorageStream.Seek(Offset: Integer; Origin: Word): Longint; +var + N: {$IFDEF RTL290_UP}LargeUInt{$ELSE}Largeint{$ENDIF RTL290_UP}; +begin + Check; + if not Succeeded(FStream.Seek(Offset, Ord(Origin), N)) then + Result := -1 + else + Result := N; +end; + +procedure TJclStructStorageStream.SetSize(NewSize: Longint); +begin + Check; + FStream.SetSize(NewSize); +end; + +function TJclStructStorageStream.Write(const Buffer; Count: Longint): Longint; +begin + Check; + if not Succeeded(FStream.Write(@Buffer, Count, @Result)) then + Result := 0; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/windows/JclSvcCtrl.pas b/3rdParty/JCL/source/windows/JclSvcCtrl.pas new file mode 100644 index 00000000..d2228402 --- /dev/null +++ b/3rdParty/JCL/source/windows/JclSvcCtrl.pas @@ -0,0 +1,1554 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclSvcCtrl.pas. } +{ } +{ The Initial Developer of the Original Code is Flier Lu (). } +{ Portions created by Flier Lu are Copyright (C) Flier Lu. All Rights Reserved. } +{ } +{ Contributors: } +{ Flier Lu (flier) } +{ Matthias Thoma (mthoma) } +{ Olivier Sannier (obones) } +{ Petr Vones (pvones) } +{ Rik Barker (rikbarker) } +{ Robert Rossmair (rrossmair) } +{ Warren Postma } +{ Terry Yapt } +{ } +{**************************************************************************************************} +{ } +{ This unit contains routines and classes to control NT service } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclSvcCtrl; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, System.Classes, System.SysUtils, System.Contnrs, + {$ELSE ~HAS_UNITSCOPE} + Windows, Classes, SysUtils, Contnrs, + {$ENDIF ~HAS_UNITSCOPE} + {$IFDEF FPC} + JwaWinNT, JwaWinSvc, + {$ELSE ~FPC} + {$IFDEF HAS_UNITSCOPE} + Winapi.WinSvc, + {$ELSE ~HAS_UNITSCOPE} + WinSvc, + {$ENDIF ~HAS_UNITSCOPE} + {$ENDIF ~FPC} + JclBase, JclSysUtils; + +// Service Types +type + TJclServiceType = + (stKernelDriver, // SERVICE_KERNEL_DRIVER + stFileSystemDriver, // SERVICE_FILE_SYSTEM_DRIVER + stAdapter, // SERVICE_ADAPTER + stRecognizerDriver, // SERVICE_RECOGNIZER_DRIVER + stWin32OwnProcess, // SERVICE_WIN32_OWN_PROCESS + stWin32ShareProcess, // SERVICE_WIN32_SHARE_PROCESS + stInteractiveProcess); // SERVICE_INTERACTIVE_PROCESS + + TJclServiceTypes = set of TJclServiceType; + +const + stDriverService = [stKernelDriver, stFileSystemDriver, stRecognizerDriver]; + stWin32Service = [stWin32OwnProcess, stWin32ShareProcess]; + stAllTypeService = stDriverService + stWin32Service + [stAdapter, stInteractiveProcess]; + +// Service State +type + TJclServiceState = + (ssUnknown, // Just fill the value 0 + ssStopped, // SERVICE_STOPPED + ssStartPending, // SERVICE_START_PENDING + ssStopPending, // SERVICE_STOP_PENDING + ssRunning, // SERVICE_RUNNING + ssContinuePending, // SERVICE_CONTINUE_PENDING + ssPausePending, // SERVICE_PAUSE_PENDING + ssPaused); // SERVICE_PAUSED + + TJclServiceStates = set of TJclServiceState; + +const + ssPendingStates = [ssStartPending, ssStopPending, ssContinuePending, ssPausePending]; + +// Start Type +type + TJclServiceStartType = + (sstBoot, // SERVICE_BOOT_START + sstSystem, // SERVICE_SYSTEM_START + sstAuto, // SERVICE_AUTO_START + sstDemand, // SERVICE_DEMAND_START + sstDisabled); // SERVICE_DISABLED + +// Error control type +type + TJclServiceErrorControlType = + (ectIgnore, // SSERVICE_ERROR_IGNORE + ectNormal, // SSERVICE_ERROR_NORMAL + ectSevere, // SSERVICE_ERROR_SEVERE + ectCritical); // SERVICE_ERROR_CRITICAL + + +// Controls Accepted +type + TJclServiceControlAccepted = + (caStop, // SERVICE_ACCEPT_STOP + caPauseContinue, // SERVICE_ACCEPT_PAUSE_CONTINUE + caShutdown); // SERVICE_ACCEPT_SHUTDOWN + + TJclServiceControlAccepteds = set of TJclServiceControlAccepted; + +// Service sort type +type + TJclServiceSortOrderType = + (sotServiceName, + sotDisplayName, + sotDescription, + sotFileName, + sotServiceState, + sotStartType, + sotErrorControlType, + sotLoadOrderGroup, + sotWin32ExitCode); + +const + // Everyone in WinNT/2K or Authenticated users in WinXP + EveryoneSCMDesiredAccess = + SC_MANAGER_CONNECT or + SC_MANAGER_ENUMERATE_SERVICE or + SC_MANAGER_QUERY_LOCK_STATUS or + STANDARD_RIGHTS_READ; + + LocalSystemSCMDesiredAccess = + SC_MANAGER_CONNECT or + SC_MANAGER_ENUMERATE_SERVICE or + SC_MANAGER_MODIFY_BOOT_CONFIG or + SC_MANAGER_QUERY_LOCK_STATUS or + STANDARD_RIGHTS_READ; + + AdministratorsSCMDesiredAccess = SC_MANAGER_ALL_ACCESS; + DefaultSCMDesiredAccess = EveryoneSCMDesiredAccess; + DefaultSvcDesiredAccess = SERVICE_ALL_ACCESS; + +// Service description +const + SERVICE_CONFIG_DESCRIPTION = 1; + {$EXTERNALSYM SERVICE_CONFIG_DESCRIPTION} + SERVICE_CONFIG_FAILURE_ACTIONS = 2; + {$EXTERNALSYM SERVICE_CONFIG_FAILURE_ACTIONS} + +{$IFNDEF FPC} +type + LPSERVICE_DESCRIPTIONA = ^SERVICE_DESCRIPTIONA; + {$EXTERNALSYM LPSERVICE_DESCRIPTIONA} + SERVICE_DESCRIPTIONA = record + lpDescription: LPSTR; + end; + {$EXTERNALSYM SERVICE_DESCRIPTIONA} + TServiceDescriptionA = SERVICE_DESCRIPTIONA; + PServiceDescriptionA = LPSERVICE_DESCRIPTIONA; +{$ENDIF ~FPC} + +type + TQueryServiceConfig2A = function(hService: SC_HANDLE; dwInfoLevel: DWORD; + lpBuffer: PByte; cbBufSize: DWORD; var pcbBytesNeeded: DWORD): BOOL; stdcall; + +// Service related classes +type + TJclServiceGroup = class; + TJclSCManager = class; + + TJclNtService = class(TObject) + private + FSCManager: TJclSCManager; + FHandle: SC_HANDLE; + FDesiredAccess: DWORD; + FServiceName: string; + FDisplayName: string; + FDescription: string; + FFileName: TFileName; + FServiceStartName: string; + FPassword: string; + FDependentServices: TList; + FDependentGroups: TList; + FDependentByServices: TList; + FServiceTypes: TJclServiceTypes; + FServiceState: TJclServiceState; + FStartType: TJclServiceStartType; + FErrorControlType: TJclServiceErrorControlType; + FWin32ExitCode: DWORD; + FGroup: TJclServiceGroup; + FControlsAccepted: TJclServiceControlAccepteds; + FCommitNeeded:Boolean; + function GetActive: Boolean; + procedure SetActive(const Value: Boolean); + procedure SetServiceStartName(const Value: string); + procedure SetPassword(const Value: string); + function GetDependentService(const Idx: Integer): TJclNtService; + function GetDependentServiceCount: Integer; + function GetDependentGroup(const Idx: Integer): TJclServiceGroup; + function GetDependentGroupCount: Integer; + function GetDependentByService(const Idx: Integer): TJclNtService; + function GetDependentByServiceCount: Integer; + protected + procedure Open(const ADesiredAccess: DWORD = DefaultSvcDesiredAccess); + procedure Close; + function GetServiceStatus: TServiceStatus; + procedure UpdateDescription; + procedure UpdateDependents; + procedure UpdateStatus(const SvcStatus: TServiceStatus); + procedure UpdateConfig(const SvcConfig: TQueryServiceConfig); + procedure CommitConfig(var SvcConfig: TQueryServiceConfig); + procedure SetStartType(AStartType: TJclServiceStartType); + public + constructor Create(const ASCManager: TJclSCManager; const SvcStatus: TEnumServiceStatus); + destructor Destroy; override; + procedure Refresh; + procedure Commit; + procedure Delete; + function Controls(const ControlType: DWORD; const ADesiredAccess: DWORD = DefaultSvcDesiredAccess): TServiceStatus; + procedure Start(const Args: array of string; const Sync: Boolean = True); overload; + procedure Start(const Sync: Boolean = True); overload; + procedure Stop(const Sync: Boolean = True); + procedure Pause(const Sync: Boolean = True); + procedure Continue(const Sync: Boolean = True); + function WaitFor(const State: TJclServiceState; const TimeOut: DWORD = INFINITE): Boolean; + property SCManager: TJclSCManager read FSCManager; + property Active: Boolean read GetActive write SetActive; + property Handle: SC_HANDLE read FHandle; + property ServiceName: string read FServiceName; + property DisplayName: string read FDisplayName; + property DesiredAccess: DWORD read FDesiredAccess; + property Description: string read FDescription; // Win2K or later + property FileName: TFileName read FFileName; + property ServiceStartName: string read FServiceStartName write SetServiceStartName; + property Password: string read FPassword write SetPassword; // Write-Only! + property DependentServices[const Idx: Integer]: TJclNtService read GetDependentService; + property DependentServiceCount: Integer read GetDependentServiceCount; + property DependentGroups[const Idx: Integer]: TJclServiceGroup read GetDependentGroup; + property DependentGroupCount: Integer read GetDependentGroupCount; + property DependentByServices[const Idx: Integer]: TJclNtService read GetDependentByService; + property DependentByServiceCount: Integer read GetDependentByServiceCount; + property ServiceTypes: TJclServiceTypes read FServiceTypes; + property ServiceState: TJclServiceState read FServiceState; + property StartType: TJclServiceStartType read FStartType write SetStartType; + property ErrorControlType: TJclServiceErrorControlType read FErrorControlType; + property Win32ExitCode: DWORD read FWin32ExitCode; + property Group: TJclServiceGroup read FGroup; + property ControlsAccepted: TJclServiceControlAccepteds read FControlsAccepted; + end; + + TJclServiceGroup = class(TObject) + private + FSCManager: TJclSCManager; + FName: string; + FOrder: Integer; + FServices: TList; + function GetService(const Idx: Integer): TJclNtService; + function GetServiceCount: Integer; + protected + function Add(const AService: TJclNtService): Integer; + function Remove(const AService: TJclNtService): Integer; + public + constructor Create(const ASCManager: TJclSCManager; const AName: string; const AOrder: Integer); + destructor Destroy; override; + property SCManager: TJclSCManager read FSCManager; + property Name: string read FName; + property Order: Integer read FOrder; + property Services[const Idx: Integer]: TJclNtService read GetService; + property ServiceCount: Integer read GetServiceCount; + end; + + TJclSCManager = class(TObject) + private + FMachineName: string; + FDatabaseName: string; + FDesiredAccess: DWORD; + FHandle: SC_HANDLE; + FLock: SC_LOCK; + FServices: TObjectList; + FGroups: TObjectList; + FAdvApi32Handle: TModuleHandle; + FQueryServiceConfig2A: TQueryServiceConfig2A; + function GetActive: Boolean; + procedure SetActive(const Value: Boolean); + function GetService(const Idx: Integer): TJclNtService; + function GetServiceCount: Integer; + function GetGroup(const Idx: Integer): TJclServiceGroup; + function GetGroupCount: Integer; + procedure SetOrderAsc(const Value: Boolean); + procedure SetOrderType(const Value: TJclServiceSortOrderType); + function GetAdvApi32Handle: TModuleHandle; + function GetQueryServiceConfig2A: TQueryServiceConfig2A; + protected + FOrderType: TJclServiceSortOrderType; + FOrderAsc: Boolean; + procedure Open; + procedure Close; + function AddService(const AService: TJclNtService): Integer; + function AddGroup(const AGroup: TJclServiceGroup): Integer; + function GetServiceLockStatus: PQueryServiceLockStatus; + property AdvApi32Handle: TModuleHandle read GetAdvApi32Handle; + property QueryServiceConfig2A: TQueryServiceConfig2A read GetQueryServiceConfig2A; + public + constructor Create(const AMachineName: string = ''; + const ADesiredAccess: DWORD = DefaultSCMDesiredAccess; + const ADatabaseName: string = SERVICES_ACTIVE_DATABASE); + destructor Destroy; override; + procedure Clear; + procedure Refresh(const RefreshAll: Boolean = False); + function Install(const ServiceName, DisplayName, ImageName: string; + const Description: string = ''; + ServiceTypes: TJclServiceTypes = [stWin32OwnProcess]; + StartType: TJclServiceStartType = sstDemand; + ErrorControlType: TJclServiceErrorControlType = ectNormal; + DesiredAccess: DWORD = DefaultSvcDesiredAccess; + const LoadOrderGroup: TJclServiceGroup = nil; const Dependencies: PChar = nil; + const Account: PChar = nil; const Password: PChar = nil): TJclNtService; + procedure Sort(const AOrderType: TJclServiceSortOrderType; const AOrderAsc: Boolean = True); + function FindService(const SvcName: string; out NtSvc: TJclNtService): Boolean; + function FindGroup(const GrpName: string; out SvcGrp: TJclServiceGroup; + const AutoAdd: Boolean = True): Boolean; + procedure Lock; + procedure Unlock; + function IsLocked: Boolean; + function LockOwner: string; + function LockDuration: DWORD; + class function ServiceType(const SvcType: TJclServiceTypes): DWORD; overload; + class function ServiceType(const SvcType: DWORD): TJclServiceTypes; overload; + class function ControlAccepted(const CtrlAccepted: TJclServiceControlAccepteds): DWORD; overload; + class function ControlAccepted(const CtrlAccepted: DWORD): TJclServiceControlAccepteds; overload; + property MachineName: string read FMachineName; + property DatabaseName: string read FDatabaseName; + property DesiredAccess: DWORD read FDesiredAccess; + property Active: Boolean read GetActive write SetActive; + property Handle: SC_HANDLE read FHandle; + property Services[const Idx: Integer]: TJclNtService read GetService; + property ServiceCount: Integer read GetServiceCount; + property Groups[const Idx: Integer]: TJclServiceGroup read GetGroup; + property GroupCount: Integer read GetGroupCount; + property OrderType: TJclServiceSortOrderType read FOrderType write SetOrderType; + property OrderAsc: Boolean read FOrderAsc write SetOrderAsc; + end; + +// helper functions +function GetServiceStatus(ServiceHandle: SC_HANDLE): DWORD; +function GetServiceStatusWaitingIfPending(ServiceHandle: SC_HANDLE): DWORD; + +function GetServiceStatusByName(const AServer,AServiceName:string): TJclServiceState; +function StopServiceByName(const AServer, AServiceName: string): Boolean; +function StartServiceByName(const AServer,AServiceName: string): Boolean; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF FPC} + JwaRegStr, + {$ELSE ~FPC} + {$IFDEF HAS_UNITSCOPE} + Winapi.RegStr, + System.Types, // inlining of TList.Remove + {$ELSE ~HAS_UNITSCOPE} + RegStr, + {$ENDIF ~HAS_UNITSCOPE} + {$ENDIF ~FPC} + {$IFDEF HAS_UNITSCOPE} + System.Math, + {$ELSE ~HAS_UNITSCOPE} + Math, + {$ENDIF ~HAS_UNITSCOPE} + JclRegistry, JclStrings, JclSysInfo; + +const + INVALID_SCM_HANDLE = 0; + + ServiceTypeMapping: array [TJclServiceType] of DWORD = + (SERVICE_KERNEL_DRIVER, SERVICE_FILE_SYSTEM_DRIVER, SERVICE_ADAPTER, + SERVICE_RECOGNIZER_DRIVER, SERVICE_WIN32_OWN_PROCESS, + SERVICE_WIN32_SHARE_PROCESS, SERVICE_INTERACTIVE_PROCESS); + + ServiceControlAcceptedMapping: array [TJclServiceControlAccepted] of DWORD = + (SERVICE_ACCEPT_STOP, SERVICE_ACCEPT_PAUSE_CONTINUE, SERVICE_ACCEPT_SHUTDOWN); + +//=== { TJclNtService } ====================================================== + +constructor TJclNtService.Create(const ASCManager: TJclSCManager; const SvcStatus: TEnumServiceStatus); +begin + Assert(Assigned(ASCManager)); + inherited Create; + FSCManager := ASCManager; + FHandle := INVALID_SCM_HANDLE; + FServiceName := SvcStatus.lpServiceName; + FDisplayName := SvcStatus.lpDisplayName; + FDescription := ''; + FGroup := nil; + FDependentServices := TList.Create; + FDependentGroups := TList.Create; + FDependentByServices := nil; // Create on demand + FSCManager.AddService(Self); +end; + +destructor TJclNtService.Destroy; +begin + FreeAndNil(FDependentServices); + FreeAndNil(FDependentGroups); + FreeAndNil(FDependentByServices); + inherited Destroy; +end; + +procedure TJclNtService.UpdateDescription; +var + Ret: BOOL; + BytesNeeded: DWORD; + PSvcDesc: PServiceDescriptionA; +begin + if Assigned(SCManager.QueryServiceConfig2A) then + try + PSvcDesc := nil; + BytesNeeded := 4096; + repeat + ReallocMem(PSvcDesc, BytesNeeded); + Ret := SCManager.QueryServiceConfig2A(FHandle, SERVICE_CONFIG_DESCRIPTION, + PByte(PSvcDesc), BytesNeeded, BytesNeeded); + until Ret or (GetLastError <> ERROR_INSUFFICIENT_BUFFER); + Win32Check(Ret); + + FDescription := string(PSvcDesc.lpDescription); + finally + FreeMem(PSvcDesc); + end; +end; + +function TJclNtService.GetActive: Boolean; +begin + Result := FHandle <> INVALID_SCM_HANDLE; +end; + +procedure TJclNtService.SetActive(const Value: Boolean); +begin + if Value <> GetActive then + begin + if Value then + Open + else + Close; + Assert(Value = GetActive); + end; +end; + +procedure TJclNtService.SetStartType(AStartType: TJclServiceStartType); +begin + if AStartType <> FStartType then + begin + FStartType := AStartType; + FCommitNeeded := True; + end; +end; + +procedure TJclNtService.SetServiceStartName(const Value: string); +begin + if Value <> FServiceStartName then + begin + FServiceStartName := Value; + FCommitNeeded := True; + end; +end; + +procedure TJclNtService.SetPassword(const Value: string); +begin + if Value <> FPassword then + begin + FPassword := Value; + FCommitNeeded := True; + end; +end; + +procedure TJclNtService.UpdateDependents; +var + I: Integer; + Ret: BOOL; + PBuf: Pointer; + PEss: PEnumServiceStatus; + NtSvc: TJclNtService; + BytesNeeded, ServicesReturned: DWORD; +begin + Open(SERVICE_ENUMERATE_DEPENDENTS); + try + if Assigned(FDependentByServices) then + FDependentByServices.Clear + else + FDependentByServices := TList.Create; + + try + PBuf := nil; + BytesNeeded := 40960; + repeat + ReallocMem(PBuf, BytesNeeded); + ServicesReturned := 0; + Ret := EnumDependentServices(FHandle, SERVICE_STATE_ALL, + PEnumServiceStatus(PBuf){$IFNDEF FPC}{$IFNDEF RTL340_UP}^{$ENDIF}{$ENDIF}, BytesNeeded, BytesNeeded, ServicesReturned); + until Ret or (GetLastError <> ERROR_INSUFFICIENT_BUFFER); + Win32Check(Ret); + + PEss := PBuf; + if ServicesReturned > 0 then + for I := 0 to ServicesReturned - 1 do + begin + if (PEss.lpServiceName[1] <> SC_GROUP_IDENTIFIER) and + (SCManager.FindService(PEss.lpServiceName, NtSvc)) then + FDependentByServices.Add(NtSvc); + Inc(PEss); + end; + finally + FreeMem(PBuf); + end; + finally + Close; + end; +end; + +function TJclNtService.GetDependentService(const Idx: Integer): TJclNtService; +begin + Result := TJclNtService(FDependentServices.Items[Idx]); +end; + +function TJclNtService.GetDependentServiceCount: Integer; +begin + Result := FDependentServices.Count; +end; + +function TJclNtService.GetDependentGroup(const Idx: Integer): TJclServiceGroup; +begin + Result := TJclServiceGroup(FDependentGroups.Items[Idx]); +end; + +function TJclNtService.GetDependentGroupCount: Integer; +begin + Result := FDependentGroups.Count; +end; + +function TJclNtService.GetDependentByService(const Idx: Integer): TJclNtService; +begin + if not Assigned(FDependentByServices) then + UpdateDependents; + Result := TJclNtService(FDependentByServices.Items[Idx]) +end; + +function TJclNtService.GetDependentByServiceCount: Integer; +begin + if not Assigned(FDependentByServices) then + UpdateDependents; + Result := FDependentByServices.Count; +end; + +function TJclNtService.GetServiceStatus: TServiceStatus; +begin + Assert(Active); + Assert((DesiredAccess and SERVICE_QUERY_STATUS) <> 0); + Win32Check(QueryServiceStatus(FHandle, Result)); +end; + + +procedure TJclNtService.UpdateStatus(const SvcStatus: TServiceStatus); +begin + with SvcStatus do + begin + FServiceTypes := TJclSCManager.ServiceType(dwServiceType); + FServiceState := TJclServiceState(dwCurrentState); + FControlsAccepted := TJclSCManager.ControlAccepted(dwControlsAccepted); + FWin32ExitCode := dwWin32ExitCode; + end; +end; + +procedure TJclNtService.UpdateConfig(const SvcConfig: TQueryServiceConfig); + + procedure UpdateLoadOrderGroup; + begin + if not Assigned(FGroup) then + SCManager.FindGroup(SvcConfig.lpLoadOrderGroup, FGroup) + else + if CompareText(Group.Name, SvcConfig.lpLoadOrderGroup) = 0 then + begin + FGroup.Remove(Self); + SCManager.FindGroup(SvcConfig.lpLoadOrderGroup, FGroup); + FGroup.Add(Self); + end; + end; + + procedure UpdateDependencies; + var + P: PChar; + NtSvc: TJclNtService; + SvcGrp: TJclServiceGroup; + begin + P := SvcConfig.lpDependencies; + FDependentServices.Clear; + FDependentGroups.Clear; + if Assigned(P) then + while P^ <> #0 do + begin + if P^ = SC_GROUP_IDENTIFIER then + begin + SCManager.FindGroup(P + 1, SvcGrp); + FDependentGroups.Add(SvcGrp); + end + else + if SCManager.FindService(P, NtSvc) then + FDependentServices.Add(NtSvc); + Inc(P, StrLen(P) + 1); + end; + end; + +begin + with SvcConfig do + begin + FFileName := lpBinaryPathName; + FStartType := TJclServiceStartType(dwStartType); + FServiceStartName := lpServiceStartName; + FPassword := ''; // Write-Only! + FErrorControlType := TJclServiceErrorControlType(dwErrorControl); + UpdateLoadOrderGroup; + UpdateDependencies; + end; +end; + +procedure TJclNtService.CommitConfig(var SvcConfig: TQueryServiceConfig); +begin + with SvcConfig do + begin + StrCopy(lpBinaryPathName, PChar(FileName)); + dwStartType := Ord(StartType); {TJclServiceStartType} + dwErrorControl := Ord(ErrorControlType); {TJclServiceErrorControlType} + //UpdateLoadOrderGroup; + //UpdateDependencies; + end; +end; + +procedure TJclNtService.Open(const ADesiredAccess: DWORD); +begin + Assert((ADesiredAccess and (not SERVICE_ALL_ACCESS)) = 0); + Active := False; + FDesiredAccess := ADesiredAccess; + FHandle := OpenService(SCManager.Handle, PChar(ServiceName), DesiredAccess); + Win32Check(FHandle <> INVALID_SCM_HANDLE); +end; + +procedure TJclNtService.Close; +begin + Assert(Active); + Win32Check(CloseServiceHandle(FHandle)); + FHandle := INVALID_SCM_HANDLE; +end; + +procedure TJclNtService.Refresh; +var + Ret: BOOL; + BytesNeeded: DWORD; + PQrySvcCnfg: {$IFDEF RTL230_UP}LPQUERY_SERVICE_CONFIG{$ELSE}PQueryServiceConfig{$ENDIF RTL230_UP}; +begin + Open(SERVICE_QUERY_STATUS or SERVICE_QUERY_CONFIG); + try + UpdateDescription; + UpdateStatus(GetServiceStatus); + try + PQrySvcCnfg := nil; + BytesNeeded := 4096; + repeat + ReallocMem(PQrySvcCnfg, BytesNeeded); + Ret := QueryServiceConfig(FHandle, PQrySvcCnfg, BytesNeeded, BytesNeeded); + until Ret or (GetLastError <> ERROR_INSUFFICIENT_BUFFER); + Win32Check(Ret); + + UpdateConfig(PQrySvcCnfg^); + finally + FreeMem(PQrySvcCnfg); + end; + finally + Close; + end; +end; + +// Commit is reverse of Refresh. +procedure TJclNtService.Commit; +var + Ret: BOOL; + BytesNeeded: DWORD; + PQrySvcCnfg: {$IFDEF RTL230_UP}LPQUERY_SERVICE_CONFIG{$ELSE}PQueryServiceConfig{$ENDIF RTL230_UP}; + ServiceStartNamePtr: PChar; + PasswordPtr: PChar; +begin + if not FCommitNeeded then + Exit; + FCommitNeeded := False; + + Open(SERVICE_CHANGE_CONFIG or SERVICE_QUERY_STATUS or SERVICE_QUERY_CONFIG); + try + //UpdateDescription; + //UpdateStatus(GetServiceStatus); + try + PQrySvcCnfg := nil; + BytesNeeded := 4096; + repeat + ReallocMem(PQrySvcCnfg, BytesNeeded); + Ret := QueryServiceConfig(FHandle, PQrySvcCnfg, BytesNeeded, BytesNeeded); + until Ret or (GetLastError <> ERROR_INSUFFICIENT_BUFFER); + Win32Check(Ret); + + CommitConfig(PQrySvcCnfg^); + + // If the ServiceStartName was set/changed then into ChangeServiceConfig + if (FServiceStartName <> '') + and (FServiceStartName <> PQrySvcCnfg^.lpServiceStartName) then + ServiceStartNamePtr := PChar(FServiceStartName) + else + ServiceStartNamePtr := nil; + + // If a Password was set then pass it into ChangeServiceConfig + if (FServiceStartName <> '') and (FPassword <> '') then + PasswordPtr := PChar(FPassword) + else + PasswordPtr := nil; + + Win32Check(ChangeServiceConfig(Handle, + PQrySvcCnfg^.dwServiceType, + PQrySvcCnfg^.dwStartType, + PQrySvcCnfg^.dwErrorControl, + nil, {PQrySvcCnfg^.lpBinaryPathName,} + nil, {PQrySvcCnfg^.lpLoadOrderGroup,} + nil, {PQrySvcCnfg^.dwTagId,} + nil, {PQrySvcCnfg^.lpDependencies,} + ServiceStartNamePtr, + PasswordPtr, + PQrySvcCnfg^.lpDisplayName)); + finally + FreeMem(PQrySvcCnfg); + end; + finally + Close; + end; +end; + +procedure TJclNtService.Delete; +{$IFDEF FPC} +const + _DELETE = $00010000; { Renamed from DELETE } +{$ENDIF FPC} +begin + Open(_DELETE); + try + Win32Check(DeleteService(FHandle)); + finally + Close; + end; +end; + +procedure TJclNtService.Start(const Args: array of string; const Sync: Boolean); +type + PStrArray = ^TStrArray; + TStrArray = array [0..32767] of PChar; +var + I: Integer; + PServiceArgVectors: PChar; +begin + Open(SERVICE_START); + try + try + if Length(Args) = 0 then + PServiceArgVectors := nil + else + begin + GetMem(PServiceArgVectors, SizeOf(PChar)*Length(Args)); + for I := 0 to Length(Args) - 1 do + PStrArray(PServiceArgVectors)^[I] := PChar(Args[I]); + end; + Win32Check(StartService(FHandle, Length(Args), PServiceArgVectors)); + finally + FreeMem(PServiceArgVectors); + end; + finally + Close; + end; + if Sync then + WaitFor(ssRunning); +end; + +procedure TJclNtService.Start(const Sync: Boolean = True); +begin + Start([], Sync); +end; + +function TJclNtService.Controls(const ControlType: DWORD; const ADesiredAccess: DWORD): TServiceStatus; +begin + Open(ADesiredAccess); + try + Win32Check(ControlService(FHandle, ControlType, Result)); + finally + Close; + end; +end; + +procedure TJclNtService.Stop(const Sync: Boolean); +begin + Controls(SERVICE_CONTROL_STOP, SERVICE_STOP); + if Sync then + WaitFor(ssStopped); +end; + +procedure TJclNtService.Pause(const Sync: Boolean); +begin + Controls(SERVICE_CONTROL_PAUSE, SERVICE_PAUSE_CONTINUE); + if Sync then + WaitFor(ssPaused); +end; + +procedure TJclNtService.Continue(const Sync: Boolean); +begin + Controls(SERVICE_CONTROL_CONTINUE, SERVICE_PAUSE_CONTINUE); + if Sync then + WaitFor(ssRunning); +end; + +function TJclNtService.WaitFor(const State: TJclServiceState; const TimeOut: DWORD): Boolean; +var + SvcStatus: TServiceStatus; + WaitedState, StartTickCount, OldCheckPoint, WaitTime: DWORD; +begin + WaitedState := DWORD(State); + Open(SERVICE_QUERY_STATUS); + try + StartTickCount := GetTickCount; + OldCheckPoint := 0; + while True do + begin + SvcStatus := GetServiceStatus; + if SvcStatus.dwCurrentState = WaitedState then + Break; + if SvcStatus.dwCheckPoint > OldCheckPoint then + begin + StartTickCount := GetTickCount; + OldCheckPoint := SvcStatus.dwCheckPoint; + end + else + begin + if TimeOut <> INFINITE then + { TODO : Do we need to disable RangeCheck? } + if (GetTickCount - StartTickCount) > Max(SvcStatus.dwWaitHint, TimeOut) then + Break; + end; + WaitTime := SvcStatus.dwWaitHint div 10; + if WaitTime < 1000 then + WaitTime := 1000 + else + if WaitTime > 10000 then + WaitTime := 10000; + Sleep(WaitTime); + end; + Result := SvcStatus.dwCurrentState = WaitedState; + finally + Close; + end; +end; + +//=== { TJclServiceGroup } =================================================== + +constructor TJclServiceGroup.Create(const ASCManager: TJclSCManager; + const AName: string; const AOrder: Integer); +begin + Assert(Assigned(ASCManager)); + inherited Create; + FSCManager := ASCManager; + FName := AName; + if FName <> '' then + FOrder := AOrder + else + FOrder := MaxInt; + FServices := TList.Create; +end; + +destructor TJclServiceGroup.Destroy; +begin + FreeAndNil(FServices); + inherited Destroy; +end; + +function TJclServiceGroup.Add(const AService: TJclNtService): Integer; +begin + Result := FServices.Add(AService); +end; + +function TJclServiceGroup.Remove(const AService: TJclNtService): Integer; +begin + Result := FServices.Remove(AService); +end; + +function TJclServiceGroup.GetService(const Idx: Integer): TJclNtService; +begin + Result := TJclNtService(FServices.Items[Idx]); +end; + +function TJclServiceGroup.GetServiceCount: Integer; +begin + Result := FServices.Count; +end; + +//=== { TJclSCManager } ====================================================== + +constructor TJclSCManager.Create(const AMachineName: string; + const ADesiredAccess: DWORD; const ADatabaseName: string); +begin + Assert((ADesiredAccess and (not SC_MANAGER_ALL_ACCESS)) = 0); + inherited Create; + FMachineName := AMachineName; + FDatabaseName := ADatabaseName; + FDesiredAccess := ADesiredAccess; + FHandle := INVALID_SCM_HANDLE; + FServices := TObjectList.Create; + FGroups := TObjectList.Create; + FOrderType := sotServiceName; + FOrderAsc := True; + FAdvApi32Handle := INVALID_MODULEHANDLE_VALUE; + FQueryServiceConfig2A := nil; +end; + +destructor TJclSCManager.Destroy; +begin + FreeAndNil(FGroups); + FreeAndNil(FServices); + Close; + UnloadModule(FAdvApi32Handle); + inherited Destroy; +end; + +function TJclSCManager.AddService(const AService: TJclNtService): Integer; +begin + Result := FServices.Add(AService); +end; + +function TJclSCManager.GetService(const Idx: Integer): TJclNtService; +begin + Result := TJclNtService(FServices.Items[Idx]); +end; + +function TJclSCManager.GetServiceCount: Integer; +begin + Result := FServices.Count; +end; + +function TJclSCManager.AddGroup(const AGroup: TJclServiceGroup): Integer; +begin + Result := FGroups.Add(AGroup); +end; + +function TJclSCManager.GetGroup(const Idx: Integer): TJclServiceGroup; +begin + Result := TJclServiceGroup(FGroups.Items[Idx]); +end; + +function TJclSCManager.GetGroupCount: Integer; +begin + Result := FGroups.Count; +end; + +procedure TJclSCManager.SetOrderAsc(const Value: Boolean); +begin + if FOrderAsc <> Value then + Sort(OrderType, Value); +end; + +procedure TJclSCManager.SetOrderType(const Value: TJclServiceSortOrderType); +begin + if FOrderType <> Value then + Sort(Value, FOrderAsc); +end; + +function TJclSCManager.GetActive: Boolean; +begin + Result := FHandle <> INVALID_SCM_HANDLE; +end; + +procedure TJclSCManager.SetActive(const Value: Boolean); +begin + if Value <> GetActive then + begin + if Value then + Open + else + Close; + Assert(Value = GetActive); + end; +end; + +procedure TJclSCManager.Open; +begin + if not Active then + begin + FHandle := OpenSCManager(Pointer(FMachineName), Pointer(FDatabaseName), FDesiredAccess); + Win32Check(FHandle <> INVALID_SCM_HANDLE); + end; +end; + +procedure TJclSCManager.Close; +begin + if Active then + Win32Check(CloseServiceHandle(FHandle)); + FHandle := INVALID_SCM_HANDLE; +end; + +procedure TJclSCManager.Lock; +begin + Assert((DesiredAccess and SC_MANAGER_LOCK) <> 0); + Active := True; + FLock := LockServiceDatabase(FHandle); + Win32Check(FLock <> nil); +end; + +procedure TJclSCManager.Unlock; +begin + Assert(Active); + Assert((DesiredAccess and SC_MANAGER_LOCK) <> 0); + Assert(FLock <> nil); + Win32Check(UnlockServiceDatabase(FLock)); +end; + +procedure TJclSCManager.Clear; +begin + FServices.Clear; + FGroups.Clear; +end; + +procedure TJclSCManager.Refresh(const RefreshAll: Boolean); + + procedure EnumServices; + var + I: Integer; + Ret: BOOL; + PBuf: Pointer; + PEss: PEnumServiceStatus; + NtSvc: TJclNtService; + BytesNeeded, ServicesReturned, ResumeHandle: DWORD; + LastError: Cardinal; + begin + Assert((DesiredAccess and SC_MANAGER_ENUMERATE_SERVICE) <> 0); + // Enum the services + ResumeHandle := 0; // Must set this value to zero !!! + try + PBuf := nil; + BytesNeeded := 0; + //from MSDN: + //The maximum size of this array is 256K bytes. To determine the required + //size, specify NULL for this parameter and 0 for the cbBufSize parameter. + //The function will fail and GetLastError will return + //ERROR_INSUFFICIENT_BUFFER. The pcbBytesNeeded parameter will receive the + //required size. + + //(it doesn't actually return ERROR_INSUFFICIENT_BUFFER apparently) + + repeat + ReallocMem(PBuf, BytesNeeded); + ServicesReturned := 0; + Ret := EnumServicesStatus(FHandle, SERVICE_WIN32 or SERVICE_ADAPTER or SERVICE_DRIVER or SERVICE_INTERACTIVE_PROCESS, SERVICE_STATE_ALL, + PEnumServiceStatus(PBuf){$IFNDEF FPC}{$IFNDEF RTL340_UP}^{$ENDIF}{$ENDIF}, + BytesNeeded, BytesNeeded, ServicesReturned, ResumeHandle); + LastError := GetLastError; + + if (ServicesReturned > 0) and (Ret or (LastError = ERROR_MORE_DATA)) then + begin + PEss := PBuf; + for I := 0 to ServicesReturned - 1 do + begin + NtSvc := TJclNtService.Create(Self, PEss^); + try + NtSvc.Refresh; + except + // trap invalid services + end; + Inc(PEss); + end; + end; + until Ret or (LastError <> ERROR_MORE_DATA); + Win32Check(Ret); + + finally + FreeMem(PBuf); + end; + end; + + { TODO : Delete after Test } + {procedure EnumServiceGroups; + const + cKeyServiceGroupOrder = 'SYSTEM\CurrentControlSet\Control\ServiceGroupOrder'; + cValList = 'List'; + var + Buf: array of Char; + P: PChar; + DataSize: DWORD; + begin + // Get the service groups + DataSize := RegReadBinary(HKEY_LOCAL_MACHINE, cKeyServiceGroupOrder, cValList, PChar(nil)^, 0); + SetLength(Buf, DataSize); + if DataSize > 0 then + begin + DataSize := RegReadBinary(HKEY_LOCAL_MACHINE, cKeyServiceGroupOrder, cValList, Buf[0], DataSize); + + P := @Buf[0]; + while P^ <> #0 do + begin + AddGroup(TJclServiceGroup.Create(Self, P, GetGroupCount)); + Inc(P, StrLen(P) + 1); + end; + end; + end;} + + { TODO -cTest : Test, if OK delete function above } + { TODO -cHelp : } + procedure EnumServiceGroups; + const + cKeyServiceGroupOrder = 'SYSTEM\CurrentControlSet\Control\ServiceGroupOrder'; + cValList = 'List'; + var + List: TStringList; + I: Integer; + begin + // Get the service groups + List := TStringList.Create; + try + RegReadMultiSz(HKEY_LOCAL_MACHINE, cKeyServiceGroupOrder, cValList, List); + for I := 0 to List.Count - 1 do + AddGroup(TJclServiceGroup.Create(Self, List[I], GetGroupCount)); + finally + List.Free; + end; + end; + + procedure RefreshAllServices; + var + I: Integer; + begin + for I := 0 to GetServiceCount - 1 do + try + GetService(I).Refresh; + except + // trap invalid services + end; + end; + +begin + Active := True; + if RefreshAll then + begin + Clear; + EnumServiceGroups; + EnumServices; + end; + RefreshAllServices; +end; + +function ServiceSortFunc(Item1, Item2: Pointer): Integer; +var + Svc1, Svc2: TJclNtService; +begin + Svc1 := Item1; + Svc2 := Item2; + case Svc1.SCManager.FOrderType of + sotServiceName: + Result := AnsiCompareStr(Svc1.ServiceName, Svc2.ServiceName); + sotDisplayName: + Result := AnsiCompareStr(Svc1.DisplayName, Svc2.DisplayName); + sotDescription: + Result := AnsiCompareStr(Svc1.Description, Svc2.Description); + sotFileName: + Result := AnsiCompareStr(Svc1.FileName, Svc2.FileName); + sotServiceState: + Result := Integer(Svc1.ServiceState) - Integer(Svc2.ServiceState); + sotStartType: + Result := Integer(Svc1.StartType) - Integer(Svc2.StartType); + sotErrorControlType: + Result := Integer(Svc1.ErrorControlType) - Integer(Svc2.ErrorControlType); + sotLoadOrderGroup: + Result := Svc1.Group.Order - Svc2.Group.Order; + sotWin32ExitCode: + Result := Svc1.Win32ExitCode - Svc2.Win32ExitCode; + else + Result := 0; + end; + if not Svc1.SCManager.FOrderAsc then + Result := -Result; +end; + +procedure TJclSCManager.Sort(const AOrderType: TJclServiceSortOrderType; const AOrderAsc: Boolean); +begin + FOrderType := AOrderType; + FOrderAsc := AOrderAsc; + FServices.Sort(ServiceSortFunc); +end; + +function TJclSCManager.FindService(const SvcName: string; out NtSvc: TJclNtService): Boolean; +var + I: Integer; +begin + Result := False; + for I := 0 to GetServiceCount - 1 do + begin + NtSvc := GetService(I); + if CompareText(NtSvc.ServiceName, SvcName) = 0 then + begin + Result := True; + Exit; + end; + end; + NtSvc := nil; +end; + +function TJclSCManager.FindGroup(const GrpName: string; out SvcGrp: TJclServiceGroup; + const AutoAdd: Boolean): Boolean; +var + I: Integer; +begin + Result := False; + for I := 0 to GetGroupCount - 1 do + begin + if CompareText(GetGroup(I).Name, GrpName) = 0 then + begin + SvcGrp := GetGroup(I); + Result := True; + Exit; + end; + end; + if AutoAdd then + begin + SvcGrp := TJclServiceGroup.Create(Self, GrpName, GetGroupCount); + AddGroup(SvcGrp); + end + else + SvcGrp := nil; +end; + +function TJclSCManager.GetServiceLockStatus: PQueryServiceLockStatus; +var + Ret: BOOL; + BytesNeeded: DWORD; +begin + Assert((DesiredAccess and SC_MANAGER_QUERY_LOCK_STATUS) <> 0); + Active := True; + + try + Result := nil; + BytesNeeded := 10240; + repeat + ReallocMem(Result, BytesNeeded); + Ret := QueryServiceLockStatus(FHandle, Result{$IFNDEF FPC}^{$ENDIF FPC}, BytesNeeded, BytesNeeded); + until Ret or (GetLastError <> ERROR_INSUFFICIENT_BUFFER); + Win32Check(Ret); + except + FreeMem(Result); + raise; + end; +end; + +function TJclSCManager.IsLocked: Boolean; +var + PQsls: PQueryServiceLockStatus; +begin + PQsls := GetServiceLockStatus; + Result := Assigned(PQsls) and (PQsls.fIsLocked <> 0); + FreeMem(PQsls); +end; + +function TJclSCManager.LockOwner: string; +var + PQsls: PQueryServiceLockStatus; +begin + PQsls := GetServiceLockStatus; + if Assigned(PQsls) then + Result := PQsls.lpLockOwner + else + Result := ''; + FreeMem(PQsls); +end; + +function TJclSCManager.LockDuration: DWORD; +var + PQsls: PQueryServiceLockStatus; +begin + PQsls := GetServiceLockStatus; + if Assigned(PQsls) then + Result := PQsls.dwLockDuration + else + Result := INFINITE; + FreeMem(PQsls); +end; + +function TJclSCManager.GetAdvApi32Handle: TModuleHandle; +const + cAdvApi32 = 'advapi32.dll'; // don't localize +begin + if FAdvApi32Handle = INVALID_MODULEHANDLE_VALUE then + LoadModule(FAdvApi32Handle, cAdvApi32); + Result := FAdvApi32Handle; +end; + +{ TODO : Standard Rtdl } +function TJclSCManager.GetQueryServiceConfig2A: TQueryServiceConfig2A; +const + cQueryServiceConfig2 = 'QueryServiceConfig2A'; // don't localize +begin + // Win2K or later + if (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 5) then + FQueryServiceConfig2A := GetModuleSymbol(AdvApi32Handle, cQueryServiceConfig2); + + Result := FQueryServiceConfig2A; +end; + +function TJclSCManager.Install(const ServiceName, DisplayName, ImageName, Description: string; + ServiceTypes: TJclServiceTypes; StartType: TJclServiceStartType; + ErrorControlType: TJclServiceErrorControlType; DesiredAccess: DWORD; + const LoadOrderGroup: TJclServiceGroup; + const Dependencies, Account, Password: PChar): TJclNtService; +var + LoadOrderGroupName: string; + LoadOrderGroupNamePtr: PChar; + EnumServiceStatus: TEnumServiceStatus; + Svc: THandle; +begin + if Assigned(LoadOrderGroup) then + begin + LoadOrderGroupName := LoadOrderGroup.Name; + LoadOrderGroupNamePtr := PChar(LoadOrderGroupName); + end + else + begin + LoadOrderGroupName := ''; + LoadOrderGroupNamePtr := nil; + end; + + Svc := CreateService(FHandle, PChar(ServiceName), PChar(DisplayName), + DesiredAccess, TJclSCManager.ServiceType(ServiceTypes), DWORD(StartType), + DWORD(ErrorControlType), PChar(ImageName), LoadOrderGroupNamePtr, nil, + Dependencies, Account, Password); + if Svc = 0 then + RaiseLastOsError; + CloseServiceHandle(Svc); + + if (Description <> '') and JclCheckWinVersion(5, 0) then // Win2k or newer + RegWriteString(HKEY_LOCAL_MACHINE, '\' + REGSTR_PATH_SERVICES + '\' + ServiceName, + 'Description', Description); + + EnumServiceStatus.lpServiceName := PChar(ServiceName); + EnumServiceStatus.lpDisplayName := PChar(DisplayName); + + Result := TJclNtService.Create(Self, EnumServiceStatus); + Result.Refresh; +end; + +class function TJclSCManager.ServiceType(const SvcType: TJclServiceTypes): DWORD; +var + AType: TJclServiceType; +begin + Result := 0; + for AType := Low(TJclServiceType) to High(TJclServiceType) do + if AType in SvcType then + Result := Result or ServiceTypeMapping[AType]; +end; + +class function TJclSCManager.ServiceType(const SvcType: DWORD): TJclServiceTypes; +var + AType: TJclServiceType; +begin + Result := []; + for AType := Low(TJclServiceType) to High(TJclServiceType) do + if (SvcType and ServiceTypeMapping[AType]) <> 0 then + Include(Result, AType); +end; + +class function TJclSCManager.ControlAccepted(const CtrlAccepted: TJclServiceControlAccepteds): DWORD; +var + ACtrl: TJclServiceControlAccepted; +begin + Result := 0; + for ACtrl := Low(TJclServiceControlAccepted) to High(TJclServiceControlAccepted) do + if ACtrl in CtrlAccepted then + Result := Result or ServiceControlAcceptedMapping[ACtrl]; +end; + +class function TJclSCManager.ControlAccepted(const CtrlAccepted: DWORD): TJclServiceControlAccepteds; +var + ACtrl: TJclServiceControlAccepted; +begin + Result := []; + for ACtrl := Low(TJclServiceControlAccepted) to High(TJclServiceControlAccepted) do + if (CtrlAccepted and ServiceControlAcceptedMapping[ACtrl]) <> 0 then + Include(Result, ACtrl); +end; + +function GetServiceStatusByName(const AServer,AServiceName:string):TJclServiceState; +var + ServiceHandle, + SCMHandle: SC_HANDLE; + SCMAccess, Access: DWORD; + ServiceStatus: TServiceStatus; +begin + Result := ssUnknown; + + SCMAccess := SC_MANAGER_CONNECT or SC_MANAGER_ENUMERATE_SERVICE or SC_MANAGER_QUERY_LOCK_STATUS; + Access := SERVICE_INTERROGATE or GENERIC_READ; + + SCMHandle := OpenSCManager(PChar(AServer), nil, SCMAccess); + if SCMHandle <> 0 then + try + ServiceHandle := OpenService(SCMHandle,PChar(AServiceName),Access); + if ServiceHandle <> 0 then + try + ResetMemory(ServiceStatus, SizeOf(ServiceStatus)); + if QueryServiceStatus(ServiceHandle, ServiceStatus) then + Result := TJclServiceState(ServiceStatus.dwCurrentState); + finally + CloseServiceHandle(ServiceHandle); + end; + finally + CloseServiceHandle(SCMHandle); + end; +end; + +function StartServiceByName(const AServer,AServiceName: String):Boolean; +var + ServiceHandle, + SCMHandle: SC_HANDLE; + P: PChar; +begin + P := nil; + Result := False; + + SCMHandle := OpenSCManager(PChar(AServer), nil, SC_MANAGER_ALL_ACCESS); + if SCMHandle <> 0 then + try + ServiceHandle := OpenService(SCMHandle, PChar(AServiceName), SERVICE_ALL_ACCESS); + if ServiceHandle <> 0 then + Result := StartService(ServiceHandle, 0, P); + + CloseServiceHandle(ServiceHandle); + finally + CloseServiceHandle(SCMHandle); + end; +end; + +function StopServiceByName(const AServer, AServiceName: String):Boolean; +var + ServiceHandle, + SCMHandle: SC_HANDLE; + SS: _Service_Status; +begin + Result := False; + + SCMHandle := OpenSCManager(PChar(AServer), nil, SC_MANAGER_ALL_ACCESS); + if SCMHandle <> 0 then + try + ServiceHandle := OpenService(SCMHandle, PChar(AServiceName), SERVICE_ALL_ACCESS); + if ServiceHandle <> 0 then + begin + ResetMemory(SS, SizeOf(SS)); + Result := ControlService(ServiceHandle, SERVICE_CONTROL_STOP, SS); + end; + + CloseServiceHandle(ServiceHandle); + finally + CloseServiceHandle(SCMHandle); + end; +end; + +function GetServiceStatus(ServiceHandle: SC_HANDLE): DWORD; +var + ServiceStatus: TServiceStatus; +begin + ResetMemory(ServiceStatus, SizeOf(ServiceStatus)); + if not QueryServiceStatus(ServiceHandle, ServiceStatus) then + RaiseLastOSError; + + Result := ServiceStatus.dwCurrentState; +end; + +function GetServiceStatusWaitingIfPending(ServiceHandle: SC_HANDLE): DWORD; +var + ServiceStatus: TServiceStatus; + WaitDuration: DWORD; + LastCheckPoint: DWORD; +begin + ResetMemory(ServiceStatus, SizeOf(ServiceStatus)); + if not QueryServiceStatus(ServiceHandle, ServiceStatus) then + RaiseLastOSError; + + Result := ServiceStatus.dwCurrentState; + + while TJclServiceState(Result) in ssPendingStates do + begin + LastCheckPoint := ServiceStatus.dwCheckPoint; + + // Multiple operations might alter the expected wait duration, so check inside the loop + WaitDuration := ServiceStatus.dwWaitHint; + if WaitDuration < 1000 then + WaitDuration := 1000 + else + if WaitDuration > 10000 then + WaitDuration := 10000; + + Sleep(WaitDuration); + + // Get the new status + if not QueryServiceStatus(ServiceHandle, ServiceStatus) then + RaiseLastOSError; + + Result := ServiceStatus.dwCurrentState; + + if ServiceStatus.dwCheckPoint = LastCheckPoint then // No progress made + Break; + end; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/JclTask.pas b/3rdParty/JCL/source/windows/JclTask.pas new file mode 100644 index 00000000..0cb5bed8 --- /dev/null +++ b/3rdParty/JCL/source/windows/JclTask.pas @@ -0,0 +1,973 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclSvcCtrl.pas. } +{ } +{ The Initial Developer of the Original Code is Flier Lu (). } +{ Portions created by Flier Lu are Copyright (C) Flier Lu. All Rights Reserved. } +{ } +{ Contributors: } +{ Flier Lu (flier) } +{ Robert Rossmair (rrossmair) } +{ Petr Vones (pvones) } +{ } +{**************************************************************************************************} +{ } +{ This unit contains routines and classes to control Microsoft task schedule service } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclTask; + +interface + +{$I jcl.inc} +{$I windowsonly.inc} + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, System.Classes, System.SysUtils, System.Contnrs, + {$ELSE ~HAS_UNITSCOPE} + Windows, Classes, SysUtils, Contnrs, + {$ENDIF ~HAS_UNITSCOPE} + MSTask, + JclBase, JclSysUtils, JclSysInfo, JclWideStrings, JclWin32; + +type + TDateTimeArray = array of TDateTime; + + TJclScheduledTaskStatus = (tsUnknown, tsReady, tsRunning, tsNotScheduled, tsHasNotRun); + + TJclScheduledTaskFlag = + (tfInteractive, tfDeleteWhenDone, tfDisabled, tfStartOnlyIfIdle, + tfKillOnIdleEndl, tfDontStartIfOnBatteries, tfKillIfGoingOnBatteries, + tfRunOnlyIfDocked, tfHidden, tfRunIfConnectedToInternet, + tfRestartOnIdleResume, tfSystemRequired, tfRunOnlyIfLoggedOn); + TJclScheduledTaskFlags = set of TJclScheduledTaskFlag; + + TJclScheduleTaskPropertyPage = (ppTask, ppSchedule, ppSettings); + TJclScheduleTaskPropertyPages = set of TJclScheduleTaskPropertyPage; + +const + JclScheduleTaskAllPages = [ppTask, ppSchedule, ppSettings]; + + LocalSystemAccount = 'SYSTEM'; // Local system account name + InfiniteTime = 0.0; + +type + TJclScheduledTask = class; + +{$HPPEMIT '#define _di_ITaskScheduler ITaskScheduler*'} +{$HPPEMIT '#define _di_ITask ITask*'} + + TJclTaskSchedule = class(TObject) + private + FTaskScheduler: ITaskScheduler; + FTasks: TObjectList; + function GetTargetComputer: WideString; + procedure SetTargetComputer(const Value: WideString); + function GetTask(const Idx: Integer): TJclScheduledTask; + function GetTaskCount: Integer; + public + constructor Create(const ComputerName: WideString = ''); + destructor Destroy; override; + procedure Refresh; + function Add(const TaskName: WideString): TJclScheduledTask; + procedure Delete(const Idx: Integer); + function Remove(const TaskName: WideString): Integer; overload; + function Remove(const TaskIntf: ITask): Integer; overload; + function Remove(const ATask: TJclScheduledTask): Integer; overload; + property TaskScheduler: ITaskScheduler read FTaskScheduler; + property TargetComputer: WideString read GetTargetComputer write SetTargetComputer; + property Tasks[const Idx: Integer]: TJclScheduledTask read GetTask; default; + property TaskCount: Integer read GetTaskCount; + public + class function IsRunning: Boolean; + class procedure Start; + class procedure Stop; + end; + +{$HPPEMIT '#define _di_ITaskTrigger ITaskTrigger*'} + + TJclTaskTrigger = class(TCollectionItem) + private + FTaskTrigger: ITaskTrigger; + procedure SetTaskTrigger(const Value: ITaskTrigger); + function GetTrigger: TTaskTrigger; + procedure SetTrigger(const Value: TTaskTrigger); + function GetTriggerString: WideString; + public + property TaskTrigger: ITaskTrigger read FTaskTrigger; + property Trigger: TTaskTrigger read GetTrigger write SetTrigger; + property TriggerString: WideString read GetTriggerString; + end; + + TJclScheduledWorkItem = class; + + TJclTaskTriggers = class(TCollection) + public + FWorkItem: TJclScheduledWorkItem; + function GetItem(Index: Integer): TJclTaskTrigger; + procedure SetItem(Index: Integer; Value: TJclTaskTrigger); + protected + function GetOwner: TPersistent; override; + public + constructor Create(AWorkItem: TJclScheduledWorkItem); + function Add(ATrigger: ITaskTrigger): TJclTaskTrigger; overload; + function Add: TJclTaskTrigger; overload; + function AddItem(Item: TJclTaskTrigger; Index: Integer): TJclTaskTrigger; + function Insert(Index: Integer): TJclTaskTrigger; + property Items[Index: Integer]: TJclTaskTrigger read GetItem write SetItem; default; + end; + +{$HPPEMIT '#define _di_IScheduledWorkItem IScheduledWorkItem*'} + + TJclScheduledWorkItem = class(TPersistent) + private + FScheduledWorkItem: IScheduledWorkItem; + FTaskName: WideString; + FData: TMemoryStream; + FTriggers: TJclTaskTriggers; + function GetAccountName: WideString; + procedure SetAccountName(const Value: WideString); + procedure SetPassword(const Value: WideString); + function GetComment: WideString; + procedure SetComment(const Value: WideString); + function GetCreator: WideString; + procedure SetCreator(const Value: WideString); + function GetExitCode: DWORD; + function GetDeadlineMinutes: Word; + function GetIdleMinutes: Word; + function GetMostRecentRunTime: {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.TSystemTime; + function GetNextRunTime: {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.TSystemTime; + function GetStatus: TJclScheduledTaskStatus; + function GetErrorRetryCount: Word; + procedure SetErrorRetryCount(const Value: Word); + function GetErrorRetryInterval: Word; + procedure SetErrorRetryInterval(const Value: Word); + function GetFlags: TJclScheduledTaskFlags; + procedure SetFlags(const Value: TJclScheduledTaskFlags); + function GetData: TStream; { TODO : stream is owned by instance } + procedure SetData(const Value: TStream); { TODO : stream is owned by caller (copy) } + function GetTrigger(const Idx: Integer): TJclTaskTrigger; + function GetTriggerCount: Integer; + public + constructor Create(const ATaskName: WideString; const AScheduledWorkItem: IScheduledWorkItem); + destructor Destroy; override; + procedure Save; + procedure Refresh; + procedure Run; + procedure Terminate; + function AddTrigger: TJclTaskTrigger; + procedure SetAccountInformation(const Name, Password: WideString); + function GetRunTimes(const BeginTime: TDateTime; const EndTime: TDateTime = InfiniteTime): TDateTimeArray; + property ScheduledWorkItem: IScheduledWorkItem read FScheduledWorkItem; + property TaskName: WideString read FTaskName write FTaskName; + property AccountName: WideString read GetAccountName write SetAccountName; + property Password: WideString write SetPassword; + property Comment: WideString read GetComment write SetComment; + property Creator: WideString read GetCreator write SetCreator; + property ErrorRetryCount: Word read GetErrorRetryCount write SetErrorRetryCount; + property ErrorRetryInterval: Word read GetErrorRetryInterval write SetErrorRetryInterval; + property ExitCode: DWORD read GetExitCode; + property OwnerData: TStream read GetData write SetData; { TODO : wrong design, get: stream is owned by instance, set stream is owned by caller } + property IdleMinutes: Word read GetIdleMinutes; + property DeadlineMinutes: Word read GetDeadlineMinutes; + property MostRecentRunTime: {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.TSystemTime read GetMostRecentRunTime; + property NextRunTime: {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.TSystemTime read GetNextRunTime; + property Status: TJclScheduledTaskStatus read GetStatus; + property Flags: TJclScheduledTaskFlags read GetFlags write SetFlags; + property Triggers[const Idx: Integer]: TJclTaskTrigger read GetTrigger; default; + property TriggerCount: Integer read GetTriggerCount; + end; + + TJclScheduledTask = class(TJclScheduledWorkItem) + private + function GetApplicationName: WideString; + procedure SetApplicationName(const Value: WideString); + function GetMaxRunTime: DWORD; + procedure SetMaxRunTime(const Value: DWORD); + function GetParameters: WideString; + procedure SetParameters(const Value: WideString); + function GetPriority: DWORD; + procedure SetPriority(const Value: DWORD); + function GetTaskFlags: DWORD; + procedure SetTaskFlags(const Value: DWORD); + function GetWorkingDirectory: WideString; + procedure SetWorkingDirectory(const Value: WideString); + function GetTask: ITask; + public + function ShowPage(Pages: TJclScheduleTaskPropertyPages = JclScheduleTaskAllPages): Boolean; + property Task: ITask read GetTask; + property ApplicationName: WideString read GetApplicationName write SetApplicationName; + property WorkingDirectory: WideString read GetWorkingDirectory write SetWorkingDirectory; + property MaxRunTime: DWORD read GetMaxRunTime write SetMaxRunTime; + property Parameters: WideString read GetParameters write SetParameters; + property Priority: DWORD read GetPriority write SetPriority; + property TaskFlags: DWORD read GetTaskFlags write SetTaskFlags; + end; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + Winapi.ActiveX, System.Win.ComObj, + {$IFDEF BORLAND} + Winapi.CommCtrl, + {$ENDIF BORLAND} + {$ELSE ~HAS_UNITSCOPE} + ActiveX, ComObj, + {$IFDEF BORLAND} + CommCtrl, + {$ENDIF BORLAND} + {$ENDIF ~HAS_UNITSCOPE} + JclSvcCtrl; + +const + TaskFlagMapping: array [TJclScheduledTaskFlag] of DWORD = + (TASK_FLAG_INTERACTIVE, TASK_FLAG_DELETE_WHEN_DONE, TASK_FLAG_DISABLED, + TASK_FLAG_START_ONLY_IF_IDLE, TASK_FLAG_KILL_ON_IDLE_END, + TASK_FLAG_DONT_START_IF_ON_BATTERIES, TASK_FLAG_KILL_IF_GOING_ON_BATTERIES, + TASK_FLAG_RUN_ONLY_IF_DOCKED, TASK_FLAG_HIDDEN, + TASK_FLAG_RUN_IF_CONNECTED_TO_INTERNET, TASK_FLAG_RESTART_ON_IDLE_RESUME, + TASK_FLAG_SYSTEM_REQUIRED, TASK_FLAG_RUN_ONLY_IF_LOGGED_ON); + +//== { TJclTaskSchedule } ==================================================== + +constructor TJclTaskSchedule.Create(const ComputerName: WideString = ''); +begin + inherited Create; + FTaskScheduler := CreateComObject(CLSID_CTaskScheduler) as ITaskScheduler; + FTasks := TObjectList.Create; + if ComputerName <> '' then + SetTargetComputer(ComputerName); +end; + +destructor TJclTaskSchedule.Destroy; +begin + FreeAndNil(FTasks); + inherited Destroy; +end; + +function TJclTaskSchedule.GetTargetComputer: WideString; +var + ComputerName: PWideChar; +begin + OleCheck(FTaskScheduler.GetTargetComputer(ComputerName)); + Result := ComputerName; + CoTaskMemFree(ComputerName); +end; + +procedure TJclTaskSchedule.SetTargetComputer(const Value: WideString); +begin + OleCheck(FTaskScheduler.SetTargetComputer(PWideCharOrNil(Value))); +end; + +class function TJclTaskSchedule.IsRunning: Boolean; + + function IsRunning9x: Boolean; + begin + Result := FindWindow('SAGEWINDOWCLASS', 'SYSTEM AGENT COM WINDOW') <> 0; + end; + + function IsRunningNt: Boolean; + var + NtSvc: TJclNtService; + begin + with TJclSCManager.Create do + try + Refresh(True); + Result := FindService('Schedule', NtSvc) and (NtSvc.ServiceState = ssRunning); + finally + Free; + end; + end; + +begin + if IsWinNT then + Result := IsRunningNt + else + Result := IsRunning9x; +end; + +class procedure TJclTaskSchedule.Start; + + procedure Start9x; + var + AppName: array [0..MAX_PATH] of Char; + FilePart: PChar; + si: TStartupInfo; + pi: TProcessInformation; + begin + FilePart := nil; + Win32Check(SearchPath(nil, 'mstask.exe', nil, MAX_PATH, AppName, FilePart) > 0); + + ResetMemory(si, SizeOf(si)); + si.cb := SizeOf(si); + ResetMemory(pi, SizeOf(pi)); + Win32Check(CreateProcess(AppName, nil, nil, nil, False, + CREATE_NEW_CONSOLE or CREATE_NEW_PROCESS_GROUP, nil, nil, si, pi)); + + CloseHandle(pi.hProcess); + CloseHandle(pi.hThread); + end; + + procedure StartNt; + var + NtSvc: TJclNtService; + begin + with TJclSCManager.Create do + try + Refresh; + if FindService('Schedule', NtSvc) then + NtSvc.Start; + finally + Free; + end; + end; + +begin + if IsWinNT then + StartNt + else + Start9x; +end; + +class procedure TJclTaskSchedule.Stop; + + procedure Stop9x; + var + hProcess: THandle; + begin + if IsRunning then + begin + hProcess := OpenProcess(PROCESS_TERMINATE, False, + GetWindowThreadProcessId( + FindWindow('SAGEWINDOWCLASS', 'SYSTEM AGENT COM WINDOW'), nil)); + Win32Check(hProcess <> 0); + Win32Check(TerminateProcess(hProcess, ERROR_PROCESS_ABORTED)); + Win32Check(CloseHandle(hProcess)); + end; + end; + + procedure StopNt; + var + NtSvc: TJclNtService; + begin + with TJclSCManager.Create do + try + if FindService('Schedule', NtSvc) then + NtSvc.Stop; + finally + Free; + end; + end; + +begin + if Win32Platform = VER_PLATFORM_WIN32_NT then + StopNt + else + Stop9x; +end; + +function TJclTaskSchedule.GetTask(const Idx: Integer): TJclScheduledTask; +begin + Result := TJclScheduledTask(FTasks.Items[Idx]); +end; + +function TJclTaskSchedule.GetTaskCount: Integer; +begin + Result := FTasks.Count; +end; + +procedure TJclTaskSchedule.Refresh; +var + EnumWorkItems: IEnumWorkItems; + ItemName: PLPWSTR; + RealItemName: PWideChar; + FetchedCount: DWORD; + TaskIid: TIID; + spUnk: IUnknown; + ATask: TJclScheduledTask; +begin + OleCheck(TaskScheduler.Enum(EnumWorkItems)); + TaskIid := IID_ITask; + ItemName := nil; + FTasks.Clear; + while SUCCEEDED(EnumWorkItems.Next(1, ItemName, FetchedCount)) and (FetchedCount > 0) do + begin + RealItemName := ItemName^; + OleCheck(TaskScheduler.Activate(RealItemName, TaskIid, spUnk)); + ATask := TJclScheduledTask.Create(RealItemName, spUnk as ITask); + ATask.Refresh; + FTasks.Add(ATask); + end; +end; + +function TJclTaskSchedule.Add(const TaskName: WideString): TJclScheduledTask; +var + TaskClsId: TCLSID; + TaskIid: TIID; + spUnk: IUnknown; +begin + TaskClsId := CLSID_CTask; + TaskIid := IID_ITask; + OleCheck(TaskScheduler.NewWorkItem(PWideChar(TaskName), TaskClsId, TaskIid, spUnk)); + Result := TJclScheduledTask.Create(TaskName, spUnk as ITask); + Result.SetAccountInformation(LocalSystemAccount, ''); + Result.Save; + Result.Refresh; + FTasks.Add(Result); +end; + +procedure TJclTaskSchedule.Delete(const Idx: Integer); +begin + Remove(Tasks[Idx]); +end; + +function TJclTaskSchedule.Remove(const TaskName: WideString): Integer; +begin + for Result := 0 to TaskCount-1 do + if WideCompareText(Tasks[Result].TaskName, TaskName) = 0 then + begin + Delete(Result); + Exit; + end; + Result := -1; +end; + +function TJclTaskSchedule.Remove(const TaskIntf: ITask): Integer; +begin + for Result := 0 to TaskCount-1 do + if Tasks[Result].Task = TaskIntf then + begin + Delete(Result); + Exit; + end; + Result := -1; +end; + +function TJclTaskSchedule.Remove(const ATask: TJclScheduledTask): Integer; +begin + Result := FTasks.IndexOf(ATask); + if Result <> -1 then + begin + FTaskScheduler.Delete(PWideChar(Tasks[Result].TaskName)); + FTasks.Delete(Result); + Exit; + end; +end; + +//=== { TJclTaskTrigger } ==================================================== + +procedure TJclTaskTrigger.SetTaskTrigger(const Value: ITaskTrigger); +begin + FTaskTrigger := Value; +end; + +function TJclTaskTrigger.GetTrigger: TTaskTrigger; +begin + Result.cbTriggerSize := SizeOf(Result); + OleCheck(TaskTrigger.GetTrigger(Result)); +end; + +procedure TJclTaskTrigger.SetTrigger(const Value: TTaskTrigger); +begin + OleCheck(TaskTrigger.SetTrigger(Value)); +end; + +function TJclTaskTrigger.GetTriggerString: WideString; +var + Trigger: PWideChar; +begin + OleCheck(TaskTrigger.GetTriggerString(Trigger)); + Result := Trigger; + CoTaskMemFree(Trigger); +end; + +//=== { TJclTaskTriggers } =================================================== + +constructor TJclTaskTriggers.Create(AWorkItem: TJclScheduledWorkItem); +begin + inherited Create(TJclTaskTrigger); + FWorkItem := AWorkItem; +end; + +function TJclTaskTriggers.GetItem(Index: Integer): TJclTaskTrigger; +begin + Result := TJclTaskTrigger(inherited GetItem(Index)); +end; + +procedure TJclTaskTriggers.SetItem(Index: Integer; Value: TJclTaskTrigger); +begin + inherited SetItem(Index, Value); +end; + +function TJclTaskTriggers.GetOwner: TPersistent; +begin + Result := FWorkItem; +end; + +function TJclTaskTriggers.Add(ATrigger: ITaskTrigger): TJclTaskTrigger; +begin + Result := Add; + Result.SetTaskTrigger(ATrigger); +end; + +function TJclTaskTriggers.Add: TJclTaskTrigger; +begin + Result := TJclTaskTrigger(inherited Add); +end; + +function TJclTaskTriggers.AddItem(Item: TJclTaskTrigger; Index: Integer): TJclTaskTrigger; +begin + if Item = nil then + Result := Add + else + Result := Item; + + if Assigned(Result) then + begin + Result.Collection := Self; + if Index < 0 then + Index := Count - 1; + Result.Index := Index; + end; +end; + +function TJclTaskTriggers.Insert(Index: Integer): TJclTaskTrigger; +begin + Result := AddItem(nil, Index); +end; + +//=== { TJclScheduledWorkItem } ============================================== + +constructor TJclScheduledWorkItem.Create(const ATaskName: WideString; + const AScheduledWorkItem: IScheduledWorkItem); +begin + inherited Create; + FScheduledWorkItem := AScheduledWorkItem; + FTaskName := ATaskName; + FData := TMemoryStream.Create; + FTriggers := TJclTaskTriggers.Create(Self); +end; + +destructor TJclScheduledWorkItem.Destroy; +begin + FreeAndNil(FTriggers); + FreeAndNil(FData); + inherited Destroy; +end; + +function TJclScheduledWorkItem.AddTrigger: TJclTaskTrigger; +var + TaskTrigger: ITaskTrigger; + Dummy: Word; +begin + Result := FTriggers.Add; + OleCheck(ScheduledWorkItem.CreateTrigger(Dummy, TaskTrigger)); + Result.SetTaskTrigger(TaskTrigger); +end; + +procedure TJclScheduledWorkItem.Save; +begin + OleCheck((FScheduledWorkItem as IPersistFile).Save(nil, True)); +end; + +procedure TJclScheduledWorkItem.Run; +begin + OleCheck(FScheduledWorkItem.Run); +end; + +procedure TJclScheduledWorkItem.Terminate; +begin + OleCheck(FScheduledWorkItem.Terminate); +end; + +function TJclScheduledWorkItem.GetAccountName: WideString; +var + AccountName: PWideChar; +begin + Result := ''; + if IsWinNT then // ignore this method in Win9x/ME + try + OleCheck(FScheduledWorkItem.GetAccountInformation(AccountName)); + Result := AccountName; + CoTaskMemFree(AccountName); + + if Result = '' then + Result := GetLocalComputerName + '\' + LocalSystemAccount; + except + Result := ''; + end; +end; + +procedure TJclScheduledWorkItem.SetAccountInformation(const Name, Password: WideString); +begin + if IsWinNT then // ignore this method in Win9x/ME + if (Name = LocalSystemAccount) or (Name = '') then + OleCheck(FScheduledWorkItem.SetAccountInformation('', nil)) + else + OleCheck(FScheduledWorkItem.SetAccountInformation(PWideChar(Name), PWideChar(Password))); +end; + +procedure TJclScheduledWorkItem.SetAccountName(const Value: WideString); +begin + SetAccountInformation(Value, ''); +end; + +procedure TJclScheduledWorkItem.SetPassword(const Value: WideString); +begin + SetAccountInformation(GetAccountName, Value); +end; + +function TJclScheduledWorkItem.GetComment: WideString; +var + Comment: PWideChar; +begin + OleCheck(FScheduledWorkItem.GetComment(Comment)); + Result := Comment; + CoTaskMemFree(Comment); +end; + +procedure TJclScheduledWorkItem.SetComment(const Value: WideString); +begin + OleCheck(FScheduledWorkItem.SetComment(PWideChar(Value))); +end; + +function TJclScheduledWorkItem.GetCreator: WideString; +var + Creator: PWideChar; +begin + OleCheck(FScheduledWorkItem.GetCreator(Creator)); + Result := Creator; + CoTaskMemFree(Creator); +end; + +procedure TJclScheduledWorkItem.SetCreator(const Value: WideString); +begin + OleCheck(FScheduledWorkItem.SetCreator(PWideChar(Value))); +end; + +function TJclScheduledWorkItem.GetExitCode: DWORD; +begin + OleCheck(FScheduledWorkItem.GetExitCode(Result)); +end; + +function TJclScheduledWorkItem.GetDeadlineMinutes: Word; +var + Dummy: Word; +begin + OleCheck(FScheduledWorkItem.GetIdleWait(Result, Dummy)); +end; + +function TJclScheduledWorkItem.GetIdleMinutes: Word; +var + Dummy: Word; +begin + OleCheck(FScheduledWorkItem.GetIdleWait(Dummy, Result)); +end; + +function TJclScheduledWorkItem.GetMostRecentRunTime: TSystemTime; +begin + OleCheck(FScheduledWorkItem.GetMostRecentRunTime(Result)); +end; + +function TJclScheduledWorkItem.GetNextRunTime: TSystemTime; +begin + OleCheck(FScheduledWorkItem.GetNextRunTime(Result)); +end; + +function TJclScheduledWorkItem.GetRunTimes(const BeginTime, EndTime: TDateTime): TDateTimeArray; +var + BeginSysTime, EndSysTime: TSystemTime; + I, Count: Word; + TaskTimes: PSystemTime; +begin + DateTimeToSystemTime(BeginTime, BeginSysTime); + DateTimeToSystemTime(EndTime, EndSysTime); + + Count := 0; + if EndTime = InfiniteTime then + OleCheck(FScheduledWorkItem.GetRunTimes(@BeginSysTime, nil, Count, TaskTimes)) + else + OleCheck(FScheduledWorkItem.GetRunTimes(@BeginSysTime, @EndSysTime, Count, TaskTimes)); + try + SetLength(Result, Count); + for I := 0 to Count-1 do + begin + Result[I] := SystemTimeToDateTime({$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.PSystemTime(TaskTimes)^); + Inc(TaskTimes); + end; + finally + CoTaskMemFree(TaskTimes); + end; +end; + +function TJclScheduledWorkItem.GetStatus: TJclScheduledTaskStatus; +var + Status: HRESULT; +begin + OleCheck(FScheduledWorkItem.GetStatus(Status)); + case Status of + SCHED_S_TASK_READY: + Result := tsReady; + SCHED_S_TASK_RUNNING: + Result := tsRunning; + SCHED_S_TASK_NOT_SCHEDULED: + Result := tsNotScheduled; + SCHED_S_TASK_HAS_NOT_RUN: + Result := tsHasNotRun; + else + Result := tsUnknown; + end; +end; + +function TJclScheduledWorkItem.GetErrorRetryCount: Word; +begin + OleCheck(FScheduledWorkItem.GetErrorRetryCount(Result)); +end; + +procedure TJclScheduledWorkItem.SetErrorRetryCount(const Value: Word); +begin + OleCheck(FScheduledWorkItem.SetErrorRetryCount(Value)); +end; + +function TJclScheduledWorkItem.GetErrorRetryInterval: Word; +begin + OleCheck(FScheduledWorkItem.GetErrorRetryInterval(Result)); +end; + +procedure TJclScheduledWorkItem.SetErrorRetryInterval(const Value: Word); +begin + OleCheck(FScheduledWorkItem.SetErrorRetryInterval(Value)); +end; + +function TJclScheduledWorkItem.GetFlags: TJclScheduledTaskFlags; +var + AFlags: DWORD; + AFlag: TJclScheduledTaskFlag; +begin + OleCheck(FScheduledWorkItem.GetFlags(AFlags)); + Result := []; + for AFlag:=Low(TJclScheduledTaskFlag) to High(TJclScheduledTaskFlag) do + if (AFlags and TaskFlagMapping[AFlag]) = TaskFlagMapping[AFlag] then + Include(Result, AFlag); +end; + +procedure TJclScheduledWorkItem.SetFlags(const Value: TJclScheduledTaskFlags); +var + AFlags: DWORD; + AFlag: TJclScheduledTaskFlag; +begin + AFlags := 0; + for AFlag:=Low(TJclScheduledTaskFlag) to High(TJclScheduledTaskFlag) do + if AFlag in Value then + AFlags := AFlags or TaskFlagMapping[AFlag]; + OleCheck(FScheduledWorkItem.SetFlags(AFlags)); +end; + +function TJclScheduledWorkItem.GetData: TStream; +var + Count: Word; + Buf: PByte; +begin + FData.Clear; + Buf := nil; + OleCheck(FScheduledWorkItem.GetWorkItemData(Count, Buf)); + try + FData.Write(Buf^, Count); + FData.Seek(0, soFromBeginning); + finally + CoTaskMemFree(Buf); + end; + Result := FData; +end; + +procedure TJclScheduledWorkItem.SetData(const Value: TStream); +begin + FData.Clear; + FData.CopyFrom(Value, 0); + OleCheck(FScheduledWorkItem.SetWorkItemData(FData.Size, PByte(FData.Memory))); +end; + +procedure TJclScheduledWorkItem.Refresh; +var + I, Count: Word; + ATrigger: ITaskTrigger; +begin + OleCheck(FScheduledWorkItem.GetTriggerCount(Count)); + + FTriggers.Clear; + if Count > 0 then + for I:=0 to Count-1 do + begin + OleCheck(FScheduledWorkItem.GetTrigger(I, ATrigger)); + FTriggers.Add(ATrigger); + end; +end; + +function TJclScheduledWorkItem.GetTriggerCount: Integer; +begin + Result := FTriggers.Count; +end; + +function TJclScheduledWorkItem.GetTrigger(const Idx: Integer): TJclTaskTrigger; +begin + Result := TJclTaskTrigger(FTriggers.Items[Idx]); +end; + +//=== { TJclScheduledTask } ================================================== + +function TJclScheduledTask.GetApplicationName: WideString; +var + AppName: PWideChar; +begin + OleCheck(Task.GetApplicationName(AppName)); + Result := AppName; + CoTaskMemFree(AppName); +end; + +procedure TJclScheduledTask.SetApplicationName(const Value: WideString); +begin + OleCheck(Task.SetApplicationName(PWideChar(Value))); +end; + +function TJclScheduledTask.GetMaxRunTime: DWORD; +begin + OleCheck(Task.GetMaxRunTime(Result)); +end; + +procedure TJclScheduledTask.SetMaxRunTime(const Value: DWORD); +begin + OleCheck(Task.SetMaxRunTime(Value)); +end; + +function TJclScheduledTask.GetParameters: WideString; +var + Parameters: PWideChar; +begin + OleCheck(Task.GetParameters(Parameters)); + Result := Parameters; + CoTaskMemFree(Parameters); +end; + +procedure TJclScheduledTask.SetParameters(const Value: WideString); +begin + OleCheck(Task.SetParameters(PWideChar(Value))); +end; + +function TJclScheduledTask.GetPriority: DWORD; +begin + OleCheck(Task.GetPriority(Result)); +end; + +procedure TJclScheduledTask.SetPriority(const Value: DWORD); +begin + OleCheck(Task.SetPriority(Value)); +end; + +function TJclScheduledTask.GetTaskFlags: DWORD; +begin + OleCheck(Task.GetTaskFlags(Result)); +end; + +procedure TJclScheduledTask.SetTaskFlags(const Value: DWORD); +begin + OleCheck(Task.SetTaskFlags(Value)); +end; + +function TJclScheduledTask.GetWorkingDirectory: WideString; +var + WorkingDir: PWideChar; +begin + OleCheck(Task.GetWorkingDirectory(WorkingDir)); + Result := WorkingDir; + CoTaskMemFree(WorkingDir); +end; + +procedure TJclScheduledTask.SetWorkingDirectory(const Value: WideString); +begin + OleCheck(Task.SetWorkingDirectory(PWideChar(Value))); +end; + +{$IFDEF FPC} +// strange issue ther, PropertySheet is declared in commctrl but FPC cannot resolve it +function PropertySheet(const lppsph:PROPSHEETHEADER):longint; external 'commctrl.dll' name 'PropertySheetW'; +{$ENDIF FPC} + +function TJclScheduledTask.ShowPage(Pages: TJclScheduleTaskPropertyPages): Boolean; +var + PageCount: Integer; + PropPages: array [0..2] of {$IFDEF BORLAND}MSTask.{$ENDIF}HPropSheetPage; + PropHeader: TPropSheetHeader; +begin + PageCount := 0; + if ppTask in Pages then + begin + OleCheck((FScheduledWorkItem as IProvideTaskPage).GetPage(TASKPAGE_TASK, True, PropPages[PageCount])); + Inc(PageCount); + end; + if ppSchedule in Pages then + begin + OleCheck((FScheduledWorkItem as IProvideTaskPage).GetPage(TASKPAGE_SCHEDULE, True, PropPages[PageCount])); + Inc(PageCount); + end; + if ppSettings in Pages then + begin + OleCheck((FScheduledWorkItem as IProvideTaskPage).GetPage(TASKPAGE_SETTINGS, True, PropPages[PageCount])); + Inc(PageCount); + end; + + ResetMemory(PropHeader, SizeOf(PropHeader)); + PropHeader.dwSize := SizeOf(PropHeader); + PropHeader.dwFlags := PSH_DEFAULT or PSH_NOAPPLYNOW; + PropHeader.phpage := @PropPages; + PropHeader.nPages := PageCount; + Result := PropertySheet(PropHeader) > 0; +end; + +function TJclScheduledTask.GetTask: ITask; +begin + Result := ScheduledWorkItem as ITask; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/JclTimeZones.pas b/3rdParty/JCL/source/windows/JclTimeZones.pas new file mode 100644 index 00000000..0dbc96e1 --- /dev/null +++ b/3rdParty/JCL/source/windows/JclTimeZones.pas @@ -0,0 +1,833 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is TimeZones.pas. } +{ } +{ The Initial Developer of the Original Code is Rik Barker } +{ . } +{ Portions created by Rik Barker are Copyright (C) Rik Barker. All Rights Reserved. } +{ } +{ Contributors: } +{ } +{**************************************************************************************************} +{ } +{ Routines and classes for working with Timezones and UTC dates. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + + +{**************************************************************************************************} +{ Important: } +{ Information on Timezones is pretty sparse and often vague. } +{ According to MSDN GetTimeZoneInformation will return TIME_ZONE_ID_DAYLIGHT if } +{ } +{ "the system is operating in the range covered by the DaylightDate } +{ member of the TIME_ZONE_INFORMATION structure." } +{ } +{ What it fails to mention is that it will take liberties with the TIME_ZONE_INFORMATION structure.} +{ Unless "Automatically Adjust clock for Daylight savings changes" is enabled, DayLightDate } +{ will contain StandardDate and DayLightName will contain StandardName. } +{ So you know you're supposed to be in daylight savings, but you can't find out when it started or } +{ what the Daylight Name is. } +{ } +{ Where possible use the functions/classes that read the data direct from the registry, } +{ these will always return the correct daylight savings date and name } +{**************************************************************************************************} + +unit JclTimeZones; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, System.SysUtils, System.Contnrs, System.Classes, + {$ELSE ~HAS_UNITSCOPE} + Windows, SysUtils, Contnrs, Classes, + {$ENDIF ~HAS_UNITSCOPE} + JclBase; + +type + // Contents of the TZI value in the Time Zones section of the registry + TJclTZIValueInfo = record + Bias: Longint; + StandardBias: Integer; + DaylightBias: Integer; + StandardDate: TSystemTime; + DaylightDate: TSystemTime; + end; + + // All other Time Zone values in the registry + PJclTimeZoneRegInfo = ^TJclTimeZoneRegInfo; + TJclTimeZoneRegInfo = record + DisplayDesc: string; + StandardName: string; + DaylightName: string; + SortIndex: Integer; + MapID: string; + TZI: TJclTZIValueInfo; + end; + +type + // Callback prototype for EnumTimeZones + TJclTimeZoneCallBackFunc = function(const TimeZoneRec: TJclTimeZoneRegInfo): Boolean of object; + +type + TJclTimeZoneInfo = class(TObject) + private + FStandardName: string; + FDaylightName: string; + FTZDescription: string; + FSortIndex: Integer; // Order to sort the timezones into + FMapID: string; // Coordinates for the Date/Time properties map + FBiasInfo: TJclTZIValueInfo; // Bias information from the registry + function GetActiveBias: Integer; + function GetCurrentDateTime: TDateTime; + function GetDaylightSavingsStartDate: TDateTime; + function GetGMTOffset: string; + function GetStandardStartDate: TDateTime; + function GetSupportsDaylightSavings: Boolean; + function GetTimeZoneType(TZI: TJclTZIValueInfo): Cardinal; + public + procedure Assign(Source: TJclTimeZoneRegInfo); + procedure ApplyTimeZone; + function DayLightSavingsPeriod: string; + function DateTimeIsInDaylightSavings(ADateTime: TDateTime):Boolean; + function StandardStartDateInYear(const AYear: Integer): TDateTime; + function DaylightStartDateInYear(const AYear: Integer): TDateTime; + // These are all the values we want to be able to stream + property ActiveBias: Integer read GetActiveBias; + property CurrentDateTime: TDateTime read GetCurrentDateTime; + property DaylightName: string read FDaylightName; + property DaylightSavingsStartDate: TDateTime read GetDaylightSavingsStartDate; + property DisplayDescription: string read FTZDescription; + property GMTOffset: string read GetGMTOffset; + property MapID: string read FMapID; + property SortIndex: Integer read FSortIndex; + property StandardName: string read FStandardName; + property StandardStartDate: TDateTime read GetStandardStartDate; + property SupportsDaylightSavings: Boolean read GetSupportsDaylightSavings; + end; + + TJclTimeZones = class(TObject) + private + FActiveTimeZoneIndex: Integer; + FTimeZones: TObjectList; + FAutoAdjustEnabled: Boolean; + function GetAutoAdjustEnabled: Boolean; + function GetActiveTimeZoneInfo: TJclTimeZoneInfo; + function GetCount: Integer; + function GetItem(Index: Integer): TJclTimeZoneInfo; + procedure LoadTimeZones; + function TimeZoneCallback(const TimeZoneRec: TJclTimeZoneRegInfo): Boolean; + public + constructor Create; + destructor Destroy; override; + function SetDateTime(DateTime: TDateTime): Boolean; + procedure SetAutoAdjustEnabled(Value: Boolean); + property Count: Integer read GetCount; + property Items[Index: Integer]: TJclTimeZoneInfo read GetItem; default; + property ActiveTimeZone: TJclTimeZoneInfo read GetActiveTimeZoneInfo; + property AutoAdjustEnabled: Boolean read FAutoAdjustEnabled write FAutoAdjustEnabled; + end; + +type + EDaylightSavingsNotSupported = class(EJclError); + EAutoAdjustNotEnabled = class(EJclError); + +// Enumerate all time zones from the registry +function EnumTimeZones(CallBackFunc: TJclTimeZoneCallBackFunc): Boolean; + +// Functions that read from the current time zone +function IsAutoAdjustEnabled: Boolean; +function CurrentTimeZoneSupportsDaylightSavings: Boolean; +function DateCurrentTimeZoneClocksChangeToStandard: TDateTime; +function DateCurrentTimeZoneClocksChangeToDaylightSavings: TDateTime; +function GetCurrentTimeZoneDescription: string; +function GetCurrentTimeZoneDaylightSavingsPeriod: string; +function GetCurrentTimeZoneGMTOffset: string; +function GetCurrentTimeZoneUTCBias: Integer; + +// Misc UTC related functions +function GetWMIScheduledJobUTCTime(Time: TDateTime): string; +function UTCNow: TDateTime; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + Winapi.Messages, + {$ELSE ~HAS_UNITSCOPE} + Messages, + {$ENDIF ~HAS_UNITSCOPE} + JclResources, + JclDateTime, JclRegistry; + +const + cAutoAdjustKey = '\System\CurrentControlSet\Control\TimeZoneInformation'; + cAutoAdjustValue = 'DisableAutoDaylightTimeSet'; + +const + UTCDays: array [0..6] of PChar = + ('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday'); + UTCDaysOffset: array [1..5] of PChar = + ('first', 'second', 'third', 'fourth', 'last'); + UTCMonths: array [1..12] of string = + ('January', 'February', 'March', 'April', 'May', 'June', + 'July', 'August', 'September', 'October', 'November', 'December'); + +//-------------------------------------------------------------------------------------------------- +// Callback enumerator of timezone information. Return false to stop enumeration + +function EnumTimeZones(CallBackFunc: TJclTimeZoneCallBackFunc): Boolean; +var + TimeZoneRootName: string; + TimeZones: TStringList; + I: Integer; + TimeZoneRegInfo: TJclTimeZoneRegInfo; +begin + Result := True; + + if not Assigned(CallBackFunc) then + raise Exception.Create(RsENoCallbackFunc); + + TimeZones := TStringList.Create; + try + if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then + TimeZoneRootName := '\Software\Microsoft\Windows\CurrentVersion\Time Zones\' + else + TimeZoneRootName := '\Software\Microsoft\Windows NT\CurrentVersion\Time Zones\'; + + if not RegGetKeyNames(HKEY_LOCAL_MACHINE, TimeZoneRootName, TimeZones) then + Exit; + + for I := 0 to TimeZones.Count - 1 do + begin + FillChar(TimeZoneRegInfo, SizeOf(TJclTimeZoneRegInfo), #0); + + TimeZoneRegInfo.DisplayDesc := RegReadString(HKEY_LOCAL_MACHINE, TimeZoneRootName + TimeZones[I], 'Display'); + TimeZoneRegInfo.StandardName := RegReadString(HKEY_LOCAL_MACHINE, TimeZoneRootName + TimeZones[I], 'Std'); + TimeZoneRegInfo.DaylightName := RegReadString(HKEY_LOCAL_MACHINE, TimeZoneRootName + TimeZones[I], 'Dlt'); + TimeZoneRegInfo.SortIndex := RegReadIntegerDef(HKEY_LOCAL_MACHINE, TimeZoneRootName + TimeZones[I], 'Index', -1); + TimeZoneRegInfo.MapID := RegReadStringDef(HKEY_LOCAL_MACHINE, TimeZoneRootName + TimeZones[I], 'MapID', ''); + RegReadBinary(HKEY_LOCAL_MACHINE, TimeZoneRootName + TimeZones[I], 'TZI', TimeZoneRegInfo.TZI, + SizeOf(TJclTZIValueInfo)); + + // Allow the callback function to stop the enumeration + if not CallBackFunc(TimeZoneRegInfo) then + Break; + end; + finally + TimeZones.Free; + end; +end; + +//-------------------------------------------------------------------------------------------------- +// Translates dates like "the third thursday in March" into the actual date + +function CalculateTransitionDate(TransitionInfo: TSystemTime; CalculateForYear: Integer= -1): TDateTime; +var + CheckDate, FirstOfMonth: TDateTime; + MonthStartDOW: Integer; + TransitionDOW: Word; + TransitionDay: Word; + PartialDays: Integer; + I, MonthDays: Integer; + Year, Month, Day: Word; + ActiveYear: Integer; +begin + if CalculateForYear= -1 then + ActiveYear:=YearOfDate(Now) + else + ActiveYear:=CalculateForYear; + + // If the date is empty, we've been passed a system date for a timezone that has no daylight support + if (TransitionInfo.wYear = 0) and (TransitionInfo.wMonth = 0) and (TransitionInfo.wDay = 0) then + begin + Result := 0; + Exit; + end; + + // Work out what day the first of the month is + FirstOfMonth := EncodeDate(ActiveYear, TransitionInfo.wMonth, 1); + + // System time is 0 based, Day of Week is 1 based + MonthStartDOW := DayOfWeek(FirstOfMonth); + TransitionDOW := TransitionInfo.wDayOfWeek + 1; + + if MonthStartDOW > TransitionDOW then + PartialDays := 7 - (MonthStartDOW - TransitionDOW) + 1 + else + PartialDays := (TransitionDOW - MonthStartDOW) + 1; + + // According to MSDN, wDay member is a value in the range 1 through 5. + // Using this notation, the first Sunday in April can be specified, + // as can the last Thursday in October (5 is equal to "the last"). + TransitionDay := 1; + case TransitionInfo.wDay of + 1: + TransitionDay := PartialDays; + 2, 3, 4: + TransitionDay := (7 * (TransitionInfo.wDay - 1)) + PartialDays; + 5: + begin + // Work out the date of the last X day in the month + MonthDays := DaysInMonth(FirstOfMonth); + DecodeDate(FirstOfMonth, Year, Month, Day); + + for I := MonthDays downto MonthDays - 7 do + begin + CheckDate := EncodeDate(Year, Month, I); + if DayOfWeek(CheckDate) = TransitionDOW then + begin + TransitionDay := I; + Break; + end; + end; + end; + end; + + Result := EncodeDate(ActiveYear, TransitionInfo.wMonth, TransitionDay); +end; + +//-------------------------------------------------------------------------------------------------- +//Returns the date range in friendly format "From the 1st sunday in March to the last Sunday in October" + +function GetDayLightSavingsPeriod(StandardDate, DayLightDate: TSystemTime): string; +begin + if (DaylightDate.wMonth = 0) and (StandardDate.wMonth = 0) then + Result := '' // There is no daylight savings period for this timezone + else + begin + if (DaylightDate.wMonth = StandardDate.wMonth) and (DaylightDate.wDay = StandardDate.wDay) then + Result := '' // AutoAdjust for Daylight savings is not enabled, so Windows returns the entire year + else + begin + Result := 'From the ' + UTCDaysOffset[DaylightDate.wDay] + ' ' + UTCDays[DaylightDate.wDayOfWeek] + ' of ' + + UTCMonths[DaylightDate.wMonth] + + ' to the ' + UTCDaysOffset[StandardDate.wDay] + ' ' + UTCDays[StandardDate.wDayOfWeek] + ' of ' + + UTCMonths[StandardDate.wMonth]; + end; + end; +end; + +//-------------------------------------------------------------------------------------------------- +// Functions relating to the current time zone +//-------------------------------------------------------------------------------------------------- + +//-------------------------------------------------------------------------------------------------- +// Returns true if the current timezone supports daylight savings - regardless of whether +// AutoAdjust is enabled or not + +function CurrentTimeZoneSupportsDaylightSavings: Boolean; +var + TimeZoneInfo: TTimeZoneInformation; +begin + Result := False; + + FillChar(TimeZoneInfo, SizeOf(TimeZoneInfo), #0); + case GetTimeZoneInformation(TimeZoneInfo) of + TIME_ZONE_ID_STANDARD: + Result := TimeZoneInfo.StandardDate.wMonth <> 0; + TIME_ZONE_ID_DAYLIGHT: + Result := True; + end; +end; + +//----------------------------------------------------------------------------- +// Returns the exact date that clocks switch to daylight savings in the current +// year for the current time zone + +function DateCurrentTimeZoneClocksChangeToDaylightSavings: TDateTime; +var + TimeZoneInfo: TTimeZoneInformation; +begin + // The daylight savings time is only returned if AutoAdjust is enabled and the + // timezone supports Daylight savings. + if not CurrentTimeZoneSupportsDaylightSavings then + raise EDaylightSavingsNotSupported.Create(RsEDaylightSavingsNotSupported); + + if not IsAutoAdjustEnabled then + raise EAutoAdjustNotEnabled.Create(RsEAutoAdjustNotEnabled); + + Result := 0; + FillChar(TimeZoneInfo, SizeOf(TimeZoneInfo), #0); + if GetTimeZoneInformation(TimeZoneInfo) in [TIME_ZONE_ID_DAYLIGHT, TIME_ZONE_ID_STANDARD] then + Result := CalculateTransitionDate(TimeZoneInfo.DaylightDate); +end; + +//----------------------------------------------------------------------------- +// Returns the exact date that clocks switch to standard time in the current year +// for the current time zone + +function DateCurrentTimeZoneClocksChangeToStandard: TDateTime; +var + TimeZoneInfo: TTimeZoneInformation; +begin + if not CurrentTimeZoneSupportsDaylightSavings then + raise EDaylightSavingsNotSupported.Create(RsEDaylightSavingsNotSupported); + + Result := 0; + FillChar(TimeZoneInfo, SizeOf(TimeZoneInfo), #0); + if GetTimeZoneInformation(TimeZoneInfo) in [TIME_ZONE_ID_DAYLIGHT, TIME_ZONE_ID_STANDARD] then + Result := CalculateTransitionDate(TimeZoneInfo.StandardDate); +end; + +//---------------------------------------------------------------------------- +// Returns the name of the current time zone + +function GetCurrentTimeZoneDescription: string; +var + TimeZoneInfo: TTimeZoneInformation; +begin + FillChar(TimeZoneInfo, SizeOf(TimeZoneInfo), #0); + case GetTimeZoneInformation(TimeZoneInfo) of + TIME_ZONE_ID_INVALID: + Result := ''; + TIME_ZONE_ID_STANDARD: + Result := TimeZoneInfo.StandardName; + TIME_ZONE_ID_UNKNOWN: + Result := TimeZoneInfo.StandardName; + TIME_ZONE_ID_DAYLIGHT: + Result := TimeZoneInfo.DaylightName; + end; +end; + +//----------------------------------------------------------------------------- +// Returns the date range in friendly format for the current timezone + +function GetCurrentTimeZoneDaylightSavingsPeriod: string; +var + TimeZoneInfo: TTimeZoneInformation; +begin + Result := ''; + if not IsAutoAdjustEnabled then + Exit; + + FillChar(TimeZoneInfo, SizeOf(TimeZoneInfo), #0); + if GetTimeZoneInformation(TimeZoneInfo) = TIME_ZONE_ID_INVALID then + Exit; + + Result := GetDaylightSavingsPeriod(TimeZoneInfo.StandardDate, TimeZoneInfo.DaylightDate); +end; + +//----------------------------------------------------------------------------- +// Returns the current offset from GMT as a string "GMT+03:00" + +function GetCurrentTimeZoneGMTOffset: string; +var + Bias: Integer; + Hours, Minutes: Integer; +begin + Bias := GetCurrentTimeZoneUTCBias; + + Hours := Bias div 60; + Minutes := Abs(Bias) mod 60; + if Bias >= 0 then + Result := Format('GMT+%.2d:%.2d', [Hours, Minutes]) + else + // (rom) not GMT- here? + Result := Format('GMT%.2d:%.2d', [Hours, Minutes]); +end; + +//----------------------------------------------------------------------------- +// Returns the Current Time Zone UTC Bias from GMT in minutes + +function GetCurrentTimeZoneUTCBias: Integer; +var + TimeZoneInfo: TTimeZoneInformation; +begin + Result := 0; + FillChar(TimeZoneInfo, SizeOf(TimeZoneInfo), #0); + case GetTimeZoneInformation(TimeZoneInfo) of + TIME_ZONE_ID_STANDARD: + Result := -(TimeZoneInfo.Bias + TimeZoneInfo.StandardBias); + TIME_ZONE_ID_UNKNOWN: + Result := -(TimeZoneInfo.Bias + TimeZoneInfo.StandardBias); + TIME_ZONE_ID_DAYLIGHT: + Result := -(TimeZoneInfo.Bias + TimeZoneInfo.DaylightBias); + end; +end; + +//----------------------------------------------------------------------------- +// Miscellaneous UTC functions +//----------------------------------------------------------------------------- + +//----------------------------------------------------------------------------- +// Returns the current UTC time + +function UTCNow: TDateTime; +var + SystemTime: TSystemTime; +begin + GetSystemTime(SystemTime); + Result := EncodeDate(SystemTime.wYear, SystemTime.wMonth, SystemTime.wDay) + + EncodeTime(SystemTime.wHour, SystemTime.wMinute, SystemTime.wSecond, SystemTime.wMilliseconds); +end; + +//----------------------------------------------------------------------------- +// Returns Time in the UTC string format expected by root\cimv2\Win32_ScheduledJob +// TODO: This works for scheduling local jobs, but fails on remote jobs - looks +// like Windows does something a bit odd with remote scheduled jobs, it's not +// handling the time correctly at all. So much for UTC. + +function GetWMIScheduledJobUTCTime(Time: TDateTime): string; +var + TimeBias: Integer; + Hour, Min, Sec, MSec: Word; +begin + Result := ''; + + TimeBias := GetCurrentTimeZoneUTCBias; + + DecodeTime(Time, Hour, Min, Sec, MSec); + + Result := '********' + Format('%.2d%.2d%.2d.000000', [Hour, Min, Sec]); + + if TimeBias >= 0 then + Result := Result + Format('+%.3d', [TimeBias]) + else + Result := Result + Format('%.3d', [TimeBias]); +end; + +//----------------------------------------------------------------------------- +// Returns true if "Automatically Adjust clock for daylight saving changes" is checked + +function IsAutoAdjustEnabled: Boolean; +begin + Result := RegReadIntegerDef(HKEY_LOCAL_MACHINE, cAutoAdjustKey, cAutoAdjustValue, 0) = 0; +end; + +//=== { TJclTimeZoneInfo } ==================================================== + +procedure TJclTimeZoneInfo.ApplyTimeZone; +var + TimeZoneInfo: TTimeZoneInformation; +begin + TimeZoneInfo.Bias := FBiasInfo.Bias; + + StringToWideChar(FStandardName, TimeZoneInfo.StandardName, 32); + TimeZoneInfo.StandardDate := FBiasInfo.StandardDate; + TimeZoneInfo.StandardBias := FBiasInfo.StandardBias; + StringToWideChar(FDaylightName, TimeZoneInfo.DaylightName, 32); + TimeZoneInfo.DaylightDate := FBiasInfo.DaylightDate; + TimeZoneInfo.DaylightBias := FBiasInfo.DaylightBias; + + if not SetTimeZoneInformation({$IFDEF FPC}@{$ENDIF FPC}TimeZoneInfo) then + RaiseLastOSError; + + SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0); +end; + +procedure TJclTimeZoneInfo.Assign(Source: TJclTimeZoneRegInfo); +begin + FStandardName := Source.StandardName; + FDaylightName := Source.DaylightName; + FTZDescription := Source.DisplayDesc; + FSortIndex := Source.SortIndex; + FMapID := Source.MapID; + FBiasInfo := Source.TZI; +end; + +function TJclTimeZoneInfo.GetActiveBias: Integer; +begin + // Return the active bias (including any skew derived from auto-adjust being enabled) + Result := 0; + + case GetTimeZoneType(FBiasInfo) of + TIME_ZONE_ID_STANDARD: + Result := -(FBiasInfo.Bias + FBiasInfo.StandardBias); + TIME_ZONE_ID_UNKNOWN: + Result := -(FBiasInfo.Bias + FBiasInfo.StandardBias); + TIME_ZONE_ID_DAYLIGHT: + // the bias is different if autoadjust is turned off + if IsAutoAdjustEnabled then + Result := -(FBiasInfo.Bias + FBiasInfo.DaylightBias) + else + Result := -(FBiasInfo.Bias + FBiasInfo.StandardBias); + end; +end; + +//----------------------------------------------------------------------------- +// Returns the exact date that clocks switch to daylight savings in the current +// year for the specified standard date + +function TJclTimeZoneInfo.DayLightSavingsPeriod: string; +begin + Result := GetDayLightSavingsPeriod(FBiasInfo.StandardDate, FBiasInfo.DayLightDate); +end; + +function TJclTimeZoneInfo.GetDaylightSavingsStartDate: TDateTime; +begin + Result := CalculateTransitionDate(FBiasInfo.DaylightDate); +end; + +//----------------------------------------------------------------------------- +// Returns the offset from GMT as a string "GMT+03:00" + +function TJclTimeZoneInfo.GetGMTOffset: string; +var + Hours, Minutes: Integer; +begin + Hours := -FBiasInfo.Bias div 60; + Minutes := Abs(FBiasInfo.Bias) mod 60; + if Hours >= 0 then + Result := Format('GMT+%.2d:%.2d', [Hours, Minutes]) + else + // (rom) No GMT- here? + Result := Format('GMT%.2d:%.2d', [Hours, Minutes]); +end; + +function TJclTimeZoneInfo.GetStandardStartDate: TDateTime; +begin + Result := CalculateTransitionDate(FBiasInfo.StandardDate); +end; + +function TJclTimeZoneInfo.GetSupportsDaylightSavings: Boolean; +begin + Result := False; + + // TODO: Check this is correct on 9x + case GetTimeZoneType(FBiasInfo) of + TIME_ZONE_ID_STANDARD: + Result := FBiasInfo.StandardDate.wMonth <> 0; + TIME_ZONE_ID_DAYLIGHT: + Result := True; + end; +end; + +function TJclTimeZoneInfo.GetCurrentDateTime: TDateTime; +begin + // Return the current date time in this time zone + Result := UTCNow + (GetActiveBias / 1440); +end; + +// Returns the TimeZone type based on StandardDate and DaylightDate + +function TJclTimeZoneInfo.GetTimeZoneType(TZI: TJclTZIValueInfo): Cardinal; +var + StandardDate: TDateTime; + DaylightSavingsDate: TDateTime; +begin + StandardDate := CalculateTransitionDate(TZI.StandardDate); + DaylightSavingsDate := CalculateTransitionDate(TZI.DaylightDate); + + if (StandardDate = 0) and (DayLightSavingsDate = 0) then + Result := TIME_ZONE_ID_UNKNOWN + else + begin + // In places like Australia, Daylight savings is after Standard, in the UK it's the other way round + if DayLightSavingsDate > StandardDate then + begin + if (Now >= StandardDate) and (Now < DaylightSavingsDate) then + Result := TIME_ZONE_ID_STANDARD + else + Result := TIME_ZONE_ID_DAYLIGHT; + end + else + begin + if (Now >= DaylightSavingsDate) and (Now < StandardDate) then + Result := TIME_ZONE_ID_DAYLIGHT + else + Result := TIME_ZONE_ID_STANDARD; + end; + end; +end; + +//=== { TJclTimeZones } ======================================================= + +function TimeZoneSort(Item1, Item2: Pointer): Integer; +begin + Result := TJclTimeZoneInfo(Item1).SortIndex - TJclTimeZoneInfo(Item2).SortIndex; + if (Result = 0) or (TJclTimeZoneInfo(Item1).SortIndex = -1) or (TJclTimeZoneInfo(Item2).SortIndex = -1) then + Result := CompareText(TJclTimeZoneInfo(Item1).DisplayDescription, TJclTimeZoneInfo(Item2).DisplayDescription); +end; + +constructor TJclTimeZones.Create; +begin + inherited Create; + FAutoAdjustEnabled := GetAutoAdjustEnabled; + FTimeZones := TObjectList.Create(True); + LoadTimeZones; +end; + +destructor TJclTimeZones.Destroy; +begin + FreeAndNil(FTimeZones); + inherited Destroy; +end; + +function TJclTimeZones.GetAutoAdjustEnabled: Boolean; +begin + Result := IsAutoAdjustEnabled; +end; + +function TJclTimeZones.GetActiveTimeZoneInfo: TJclTimeZoneInfo; +begin + Result := GetItem(FActiveTimeZoneIndex); +end; + +function TJclTimeZones.GetCount: Integer; +begin + Result := FTimeZones.Count; +end; + +function TJclTimeZones.GetItem(Index: Integer): TJclTimeZoneInfo; +begin + if (Index >= 0) or (Index < FTimeZones.Count) then + Result := TJclTimeZoneInfo(FTimeZones[Index]) + else + Result := nil; +end; + +procedure TJclTimeZones.LoadTimeZones; +var + CurrentTimeZoneDesc: string; + I: Integer; +begin + EnumTimeZones(TimeZoneCallback); + FTimeZones.Sort(@TimeZoneSort); + + CurrentTimeZoneDesc := GetCurrentTimeZoneDescription; + + FActiveTimeZoneIndex := -1; + for I := 0 to FTimeZones.Count - 1 do + if (TJclTimeZoneInfo(FTimeZones[I]).StandardName = CurrentTimeZoneDesc) or + (TJclTimeZoneInfo(FTimeZones[I]).DayLightName = CurrentTimeZoneDesc) then + begin + FActiveTimeZoneIndex := I; + Break; + end; +end; + +procedure TJclTimeZones.SetAutoAdjustEnabled(Value: Boolean); +begin + // TODO: PC isn't being notified correctly of the change + if FAutoAdjustEnabled <> Value then + begin + if not Value then + RegWriteInteger(HKEY_LOCAL_MACHINE, cAutoAdjustKey, cAutoAdjustValue, 1) + else + RegDeleteEntry(HKEY_LOCAL_MACHINE, cAutoAdjustKey, cAutoAdjustValue); + + FAutoAdjustEnabled := Value; + SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0, LPARAM(PChar('intl'))); + SendMessage(HWND_TOPMOST, WM_TIMECHANGE, 0, 0); + end; +end; + +function TJclTimeZones.TimeZoneCallback(const TimeZoneRec: TJclTimeZoneRegInfo): Boolean; +var + TimeZone: TJclTimeZoneInfo; +begin + Result := True; + TimeZone := TJclTimeZoneInfo.Create; + TimeZone.Assign(TimeZoneRec); + FTimeZones.Add(TimeZone) +end; + +function TJclTimeZones.SetDateTime(DateTime: TDateTime): Boolean; +var + SystemTime: TSystemTime; +begin + // The date time we have is local. Convert it to UTC + DateTime := LocalDateTimeToDateTime(DateTime); + + DecodeDate(DateTime, SystemTime.wYear, SystemTime.wMonth, SystemTime.wDay); + DecodeTime(DateTime, SystemTime.wHour, SystemTime.wMinute, SystemTime.wSecond, SystemTime.wMilliSeconds); + + Result := SetSystemTime(SystemTime); + + if not Result then + RaiseLastOSError; + + SendMessage(HWND_TOPMOST, WM_TIMECHANGE, 0, 0); +end; + +function TJclTimeZoneInfo.DateTimeIsInDaylightSavings(ADateTime: TDateTime): Boolean; +var + dsStartDate: TDateTime; + stdStartDate: TDateTime; + Year: Integer; +begin + //Return whether the specified date time is DaylightSavings or not + Result:=False; + + if not SupportsDaylightSavings then + Exit; + + Year:=YearOfDate(ADateTime); + dsStartDate := CalculateTransitionDate(FBiasInfo.DaylightDate, Year); + stdStartDate:= CalculateTransitionDate(FBiasInfo.StandardDate, Year); + + // In places like Australia, Daylight savings is after Standard, in the UK it's the other way round + if dsStartDate > stdStartDate then + begin + if (ADateTime >= stdStartDate) and (ADateTime < dsStartDate) then + Result := False + else + Result := True; + end + else + begin + if (ADateTime >= dsStartDate) and (ADateTime < stdStartDate) then + Result := True + else + Result := False; + end; +end; + +function TJclTimeZoneInfo.DaylightStartDateInYear( + const AYear: Integer): TDateTime; +begin + Result:= CalculateTransitionDate(FBiasInfo.DaylightDate, AYear); +end; + +function TJclTimeZoneInfo.StandardStartDateInYear( + const AYear: Integer): TDateTime; +begin + Result:= CalculateTransitionDate(FBiasInfo.StandardDate, AYear); +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/windows/JclWin32.pas b/3rdParty/JCL/source/windows/JclWin32.pas index ea67dffc..99060dd4 100644 --- a/3rdParty/JCL/source/windows/JclWin32.pas +++ b/3rdParty/JCL/source/windows/JclWin32.pas @@ -1,9333 +1,9333 @@ -{**************************************************************************************************} -{ WARNING: JEDI preprocessor generated unit. Do not edit. } -{**************************************************************************************************} - -{**************************************************************************************************} -{ } -{ Project JEDI Code Library (JCL) } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ Portions of this code are translated from DelayImp.h. } -{ The Initial Developer of DelayImp.h is Inprise Corporation. Portions created by Inprise } -{ Corporation are Copyright (C) 1999, 2000 by Inprise Corporation. All Rights Reserved. } -{ } -{ The Original Code is JclWin32.pas. } -{ } -{ The Initial Developer of the Original Code is Marcel van Brakel. Portions created by Marcel van } -{ Brakel are Copyright (C) Marcel van Brakel. All Rights Reserved. } -{ } -{ Contributors: } -{ Marcel van Brakel } -{ Peter Friese } -{ Andreas Hausladen (ahuser) } -{ Flier Lu (flier) } -{ Robert Marquardt (marquardt) } -{ Robert Rossmair (rrossmair) } -{ Olivier Sannier (obones) } -{ Matthias Thoma (mthoma) } -{ Petr Vones (pvones) } -{ Florent Ouchet (outchy) } -{ } -{**************************************************************************************************} -{ } -{ This unit defines various Win32 API declarations which are either missing or incorrect in one or } -{ more of the supported Delphi versions. This unit is not intended for regular code, only API } -{ declarations. } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -unit JclWin32; - -{$I jcl.inc} -{$I windowsonly.inc} - -{$MINENUMSIZE 4} -{$ALIGN ON} - -interface - -uses - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - {$IFDEF HAS_UNITSCOPE} - Winapi.Windows, System.SysUtils, - {$IFNDEF FPC} - Winapi.AccCtrl, Winapi.ActiveX, - {$ENDIF ~FPC} - {$ELSE ~HAS_UNITSCOPE} - Windows, SysUtils, - {$IFNDEF FPC} - AccCtrl, - {$ENDIF ~FPC} - ActiveX, - {$ENDIF ~HAS_UNITSCOPE} - JclBase; - -{$HPPEMIT '#include '} -{$HPPEMIT '#include '} -{$HPPEMIT '#include '} -{$HPPEMIT '#include '} -{$HPPEMIT '#include '} -{$HPPEMIT '#include '} -{$HPPEMIT '#include '} -{$HPPEMIT '#include '} -{$HPPEMIT '#include '} -{$HPPEMIT '#include '} -{$HPPEMIT '#include '} -{$HPPEMIT '#include '} -{$HPPEMIT '#include '} -//{$HPPEMIT '#include '} -{$HPPEMIT '#include '} -{$HPPEMIT '#include '} -{$HPPEMIT '#include '} -{$HPPEMIT '#include '} -{$IFNDEF COMPILER14_UP} -{$HPPEMIT '#include '} -{$ENDIF ~COMPILER14_UP} -{$HPPEMIT '#include '} -{$HPPEMIT '#include '} -{$HPPEMIT ''} -{$IFDEF RTL230_UP} -{$HPPEMIT '// To avoid ambiguity between IMAGE_LOAD_CONFIG_DIRECTORY32 and Winapi::Windows::IMAGE_LOAD_CONFIG_DIRECTORY32'} -{$HPPEMIT '#define IMAGE_LOAD_CONFIG_DIRECTORY32 ::IMAGE_LOAD_CONFIG_DIRECTORY32'} -{$HPPEMIT ''} -{$HPPEMIT '// To avoid ambiguity between IMAGE_LOAD_CONFIG_DIRECTORY64 and Winapi::Windows::IMAGE_LOAD_CONFIG_DIRECTORY64'} -{$HPPEMIT '#define IMAGE_LOAD_CONFIG_DIRECTORY64 ::IMAGE_LOAD_CONFIG_DIRECTORY64'} -{$HPPEMIT ''} -{$ENDIF RTL230_UP} - -// EJclWin32Error -type - EJclWin32Error = class(EJclError) - private - FLastError: DWORD; - FLastErrorMsg: string; - public - constructor Create(const Msg: string); - constructor CreateFmt(const Msg: string; const Args: array of const); - constructor CreateRes(Ident: Integer); overload; - constructor CreateRes(ResStringRec: PResStringRec); overload; - property LastError: DWORD read FLastError; - property LastErrorMsg: string read FLastErrorMsg; - end; - -//DOM-IGNORE-BEGIN - -{$IFNDEF FPC} - -// -// Unsigned Basics -// - -type - USHORT = Word; - {$EXTERNALSYM USHORT} - -{$ENDIF ~FPC} -//================================================================================================== -// presumable from any older WinNT.h or from WinIfs.h -//================================================================================================== - -//-------------------------------------------------------------------------------------------------- -// NTFS Reparse Points -//-------------------------------------------------------------------------------------------------- - -// The reparse structure is used by layered drivers to store data in a -// reparse point. The constraints on reparse tags are defined below. -// This version of the reparse data buffer is only for Microsoft tags. - -(*$HPPEMIT 'typedef struct _REPARSE_DATA_BUFFER {'*) -(*$HPPEMIT ''*) -(*$HPPEMIT ' DWORD ReparseTag;'*) -(*$HPPEMIT ' WORD ReparseDataLength;'*) -(*$HPPEMIT ' WORD Reserved;'*) -(*$HPPEMIT ''*) -(*$HPPEMIT ' union {'*) -(*$HPPEMIT ''*) -(*$HPPEMIT ' struct {'*) -(*$HPPEMIT ' WORD SubstituteNameOffset;'*) -(*$HPPEMIT ' WORD SubstituteNameLength;'*) -(*$HPPEMIT ' WORD PrintNameOffset;'*) -(*$HPPEMIT ' WORD PrintNameLength;'*) -(*$HPPEMIT ' WCHAR PathBuffer[1];'*) -(*$HPPEMIT ' } SymbolicLinkReparseBuffer;'*) -(*$HPPEMIT ''*) -(*$HPPEMIT ' struct {'*) -(*$HPPEMIT ' WORD SubstituteNameOffset;'*) -(*$HPPEMIT ' WORD SubstituteNameLength;'*) -(*$HPPEMIT ' WORD PrintNameOffset;'*) -(*$HPPEMIT ' WORD PrintNameLength;'*) -(*$HPPEMIT ' WCHAR PathBuffer[1];'*) -(*$HPPEMIT ' } MountPointReparseBuffer;'*) -(*$HPPEMIT ''*) -(*$HPPEMIT ' struct {'*) -(*$HPPEMIT ' UCHAR DataBuffer[1];'*) -(*$HPPEMIT ' } GenericReparseBuffer;'*) -(*$HPPEMIT ' };'*) -(*$HPPEMIT ''*) -(*$HPPEMIT '} REPARSE_DATA_BUFFER, *PREPARSE_DATA_BUFFER;'*) -(*$HPPEMIT ''*) -(*$HPPEMIT '#ifndef REPARSE_DATA_BUFFER_HEADER_SIZE'*) -(*$HPPEMIT '#define REPARSE_DATA_BUFFER_HEADER_SIZE 8'*) -(*$HPPEMIT '#endif'*) -(*$HPPEMIT ''*) -(*$HPPEMIT 'typedef struct _REPARSE_POINT_INFORMATION {'*) -(*$HPPEMIT ' WORD ReparseDataLength;'*) -(*$HPPEMIT ' WORD UnparsedNameLength;'*) -(*$HPPEMIT '} REPARSE_POINT_INFORMATION, *PREPARSE_POINT_INFORMATION;'*) -(*$HPPEMIT ''*) -(*$HPPEMIT '#ifndef IO_REPARSE_TAG_VALID_VALUES'*) -(*$HPPEMIT '#define IO_REPARSE_TAG_VALID_VALUES 0x0E000FFFF'*) -(*$HPPEMIT '#endif'*) -(*$HPPEMIT ''*) - -type - {$EXTERNALSYM _REPARSE_DATA_BUFFER} - _REPARSE_DATA_BUFFER = record - ReparseTag: DWORD; - ReparseDataLength: Word; - Reserved: Word; - case Integer of - 0: ( - SymbolicLinkReparseBuffer: record - SubstituteNameOffset: Word; - SubstituteNameLength: Word; - PrintNameOffset: Word; - PrintNameLength: Word; - Flags: ULONG; - PathBuffer: array [0..0] of WCHAR; - end); - 1: ( - MountPointReparseBuffer: record - SubstituteNameOffset: Word; - SubstituteNameLength: Word; - PrintNameOffset: Word; - PrintNameLength: Word; - PathBuffer: array [0..0] of WCHAR; - end); - 2: ( - GenericReparseBuffer: record - DataBuffer: array [0..0] of Byte; - end); - end; - {$EXTERNALSYM REPARSE_DATA_BUFFER} - REPARSE_DATA_BUFFER = _REPARSE_DATA_BUFFER; - {$EXTERNALSYM PREPARSE_DATA_BUFFER} - PREPARSE_DATA_BUFFER = ^_REPARSE_DATA_BUFFER; - TReparseDataBuffer = _REPARSE_DATA_BUFFER; - PReparseDataBuffer = PREPARSE_DATA_BUFFER; - -const - {$EXTERNALSYM REPARSE_DATA_BUFFER_HEADER_SIZE} - REPARSE_DATA_BUFFER_HEADER_SIZE = 8; - -type - {$EXTERNALSYM _REPARSE_POINT_INFORMATION} - _REPARSE_POINT_INFORMATION = record - ReparseDataLength: Word; - UnparsedNameLength: Word; - end; - {$EXTERNALSYM REPARSE_POINT_INFORMATION} - REPARSE_POINT_INFORMATION = _REPARSE_POINT_INFORMATION; - {$EXTERNALSYM PREPARSE_POINT_INFORMATION} - PREPARSE_POINT_INFORMATION = ^_REPARSE_POINT_INFORMATION; - TReparsePointInformation = _REPARSE_POINT_INFORMATION; - PReparsePointInformation = PREPARSE_POINT_INFORMATION; - -const - {$EXTERNALSYM IO_REPARSE_TAG_VALID_VALUES} - IO_REPARSE_TAG_VALID_VALUES = DWORD($E000FFFF); - -//================================================================================================== - -// from JwaWinNT.pas (few declarations from JwaWinType) - -const - MAXLONGLONG = $7fffffffffffffff; - {$EXTERNALSYM MAXLONGLONG} - -{$IFNDEF FPC} -type - ULONGLONG = Int64; - {$EXTERNALSYM ULONGLONG} - PLONGLONG = ^LONGLONG; - {$EXTERNALSYM PLONGLONG} - PULONGLONG = ^ULONGLONG; - {$EXTERNALSYM PULONGLONG} -{$ENDIF ~FPC} - -const - ANYSIZE_ARRAY = 1; - {$EXTERNALSYM ANYSIZE_ARRAY} - - MAX_NATURAL_ALIGNMENT = SizeOf(ULONG); - {$EXTERNALSYM MAX_NATURAL_ALIGNMENT} - -// line 72 - -const - VER_SERVER_NT = DWORD($80000000); - {$EXTERNALSYM VER_SERVER_NT} - VER_WORKSTATION_NT = $40000000; - {$EXTERNALSYM VER_WORKSTATION_NT} - VER_SUITE_SMALLBUSINESS = $00000001; - {$EXTERNALSYM VER_SUITE_SMALLBUSINESS} - VER_SUITE_ENTERPRISE = $00000002; - {$EXTERNALSYM VER_SUITE_ENTERPRISE} - VER_SUITE_BACKOFFICE = $00000004; - {$EXTERNALSYM VER_SUITE_BACKOFFICE} - VER_SUITE_COMMUNICATIONS = $00000008; - {$EXTERNALSYM VER_SUITE_COMMUNICATIONS} - VER_SUITE_TERMINAL = $00000010; - {$EXTERNALSYM VER_SUITE_TERMINAL} - VER_SUITE_SMALLBUSINESS_RESTRICTED = $00000020; - {$EXTERNALSYM VER_SUITE_SMALLBUSINESS_RESTRICTED} - VER_SUITE_EMBEDDEDNT = $00000040; - {$EXTERNALSYM VER_SUITE_EMBEDDEDNT} - VER_SUITE_DATACENTER = $00000080; - {$EXTERNALSYM VER_SUITE_DATACENTER} - VER_SUITE_SINGLEUSERTS = $00000100; - {$EXTERNALSYM VER_SUITE_SINGLEUSERTS} - VER_SUITE_PERSONAL = $00000200; - {$EXTERNALSYM VER_SUITE_PERSONAL} - VER_SUITE_BLADE = $00000400; - {$EXTERNALSYM VER_SUITE_BLADE} - VER_SUITE_EMBEDDED_RESTRICTED = $00000800; - {$EXTERNALSYM VER_SUITE_EMBEDDED_RESTRICTED} - VER_SUITE_SECURITY_APPLIANCE = $00001000; - {$EXTERNALSYM VER_SUITE_SECURITY_APPLIANCE} - VER_SUITE_STORAGE_SERVER = $00002000; - {$EXTERNALSYM VER_SUITE_STORAGE_SERVER} - VER_SUITE_COMPUTE_SERVER = $00004000; - {$EXTERNALSYM VER_SUITE_COMPUTE_SERVER} - -// line 515 - -// -// A language ID is a 16 bit value which is the combination of a -// primary language ID and a secondary language ID. The bits are -// allocated as follows: -// -// +-----------------------+-------------------------+ -// | Sublanguage ID | Primary Language ID | -// +-----------------------+-------------------------+ -// 15 10 9 0 bit -// -// -// Language ID creation/extraction macros: -// -// MAKELANGID - construct language id from a primary language id and -// a sublanguage id. -// PRIMARYLANGID - extract primary language id from a language id. -// SUBLANGID - extract sublanguage id from a language id. -// - -function MAKELANGID(PrimaryLang, SubLang: USHORT): WORD; -{$EXTERNALSYM MAKELANGID} -function PRIMARYLANGID(LangId: WORD): WORD; -{$EXTERNALSYM PRIMARYLANGID} -function SUBLANGID(LangId: WORD): WORD; -{$EXTERNALSYM SUBLANGID} - -// -// A locale ID is a 32 bit value which is the combination of a -// language ID, a sort ID, and a reserved area. The bits are -// allocated as follows: -// -// +-------------+---------+-------------------------+ -// | Reserved | Sort ID | Language ID | -// +-------------+---------+-------------------------+ -// 31 20 19 16 15 0 bit -// -// -// Locale ID creation/extraction macros: -// -// MAKELCID - construct the locale id from a language id and a sort id. -// MAKESORTLCID - construct the locale id from a language id, sort id, and sort version. -// LANGIDFROMLCID - extract the language id from a locale id. -// SORTIDFROMLCID - extract the sort id from a locale id. -// SORTVERSIONFROMLCID - extract the sort version from a locale id. -// - -const - NLS_VALID_LOCALE_MASK = $000fffff; - {$EXTERNALSYM NLS_VALID_LOCALE_MASK} - -function MAKELCID(LangId, SortId: WORD): DWORD; -{$EXTERNALSYM MAKELCID} -function MAKESORTLCID(LangId, SortId, SortVersion: WORD): DWORD; -{$EXTERNALSYM MAKESORTLCID} -function LANGIDFROMLCID(LocaleId: LCID): WORD; -{$EXTERNALSYM LANGIDFROMLCID} -function SORTIDFROMLCID(LocaleId: LCID): WORD; -{$EXTERNALSYM SORTIDFROMLCID} -function SORTVERSIONFROMLCID(LocaleId: LCID): WORD; -{$EXTERNALSYM SORTVERSIONFROMLCID} - -// line 1154 - -//////////////////////////////////////////////////////////////////////// -// // -// Security Id (SID) // -// // -//////////////////////////////////////////////////////////////////////// -// -// -// Pictorially the structure of an SID is as follows: -// -// 1 1 1 1 1 1 -// 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 -// +---------------------------------------------------------------+ -// | SubAuthorityCount |Reserved1 (SBZ)| Revision | -// +---------------------------------------------------------------+ -// | IdentifierAuthority[0] | -// +---------------------------------------------------------------+ -// | IdentifierAuthority[1] | -// +---------------------------------------------------------------+ -// | IdentifierAuthority[2] | -// +---------------------------------------------------------------+ -// | | -// +- - - - - - - - SubAuthority[] - - - - - - - - -+ -// | | -// +---------------------------------------------------------------+ -// -// - -{$IFNDEF FPC} -type - _SID_IDENTIFIER_AUTHORITY = record - Value: array [0..5] of Byte; - end; - {$EXTERNALSYM _SID_IDENTIFIER_AUTHORITY} - SID_IDENTIFIER_AUTHORITY = _SID_IDENTIFIER_AUTHORITY; - {$EXTERNALSYM SID_IDENTIFIER_AUTHORITY} - PSID_IDENTIFIER_AUTHORITY = ^_SID_IDENTIFIER_AUTHORITY; - {$EXTERNALSYM PSID_IDENTIFIER_AUTHORITY} - - // PSid = ^SID; - _SID = record - Revision: Byte; - SubAuthorityCount: Byte; - IdentifierAuthority: SID_IDENTIFIER_AUTHORITY; - SubAuthority: array [0..ANYSIZE_ARRAY - 1] of DWORD; - end; - {$EXTERNALSYM _SID} - SID = _SID; - {$EXTERNALSYM SID} - PPSID = ^PSID; - {$NODEFINE PPSID} - TSid = SID; -{$ENDIF ~FPC} - -const - SID_REVISION = (1); // Current revision level - {$EXTERNALSYM SID_REVISION} - SID_MAX_SUB_AUTHORITIES = (15); - {$EXTERNALSYM SID_MAX_SUB_AUTHORITIES} - SID_RECOMMENDED_SUB_AUTHORITIES = (1); // Will change to around 6 in a future release. - {$EXTERNALSYM SID_RECOMMENDED_SUB_AUTHORITIES} - - SECURITY_MAX_SID_SIZE = SizeOf(SID) - SizeOf(DWORD) + (SID_MAX_SUB_AUTHORITIES * SizeOf(DWORD)); - {$EXTERNALSYM SECURITY_MAX_SID_SIZE} - -{$IFNDEF FPC} - SidTypeUser = 1; - {$EXTERNALSYM SidTypeUser} - SidTypeGroup = 2; - {$EXTERNALSYM SidTypeGroup} - SidTypeDomain = 3; - {$EXTERNALSYM SidTypeDomain} - SidTypeAlias = 4; - {$EXTERNALSYM SidTypeAlias} - SidTypeWellKnownGroup = 5; - {$EXTERNALSYM SidTypeWellKnownGroup} - SidTypeDeletedAccount = 6; - {$EXTERNALSYM SidTypeDeletedAccount} - SidTypeInvalid = 7; - {$EXTERNALSYM SidTypeInvalid} - SidTypeUnknown = 8; - {$EXTERNALSYM SidTypeUnknown} - SidTypeComputer = 9; - {$EXTERNALSYM SidTypeComputer} - -type - _SID_NAME_USE = DWORD; - {$EXTERNALSYM _SID_NAME_USE} -// SID_NAME_USE = _SID_NAME_USE; -// {$EXTERNALSYM SID_NAME_USE} - PSID_NAME_USE = ^SID_NAME_USE; - {$EXTERNALSYM PSID_NAME_USE} - TSidNameUse = SID_NAME_USE; - PSidNameUSe = PSID_NAME_USE; - - PSID_AND_ATTRIBUTES = ^SID_AND_ATTRIBUTES; - {$EXTERNALSYM PSID_AND_ATTRIBUTES} - _SID_AND_ATTRIBUTES = record - Sid: PSID; - Attributes: DWORD; - end; - {$EXTERNALSYM _SID_AND_ATTRIBUTES} - SID_AND_ATTRIBUTES = _SID_AND_ATTRIBUTES; - {$EXTERNALSYM SID_AND_ATTRIBUTES} - TSidAndAttributes = SID_AND_ATTRIBUTES; - PSidAndAttributes = PSID_AND_ATTRIBUTES; - - SID_AND_ATTRIBUTES_ARRAY = array [0..ANYSIZE_ARRAY - 1] of SID_AND_ATTRIBUTES; - {$EXTERNALSYM SID_AND_ATTRIBUTES_ARRAY} - PSID_AND_ATTRIBUTES_ARRAY = ^SID_AND_ATTRIBUTES_ARRAY; - {$EXTERNALSYM PSID_AND_ATTRIBUTES_ARRAY} - PSidAndAttributesArray = ^TSidAndAttributesArray; - TSidAndAttributesArray = SID_AND_ATTRIBUTES_ARRAY; -{$ENDIF ~FPC} - -///////////////////////////////////////////////////////////////////////////// -// // -// Universal well-known SIDs // -// // -// Null SID S-1-0-0 // -// World S-1-1-0 // -// Local S-1-2-0 // -// Creator Owner ID S-1-3-0 // -// Creator Group ID S-1-3-1 // -// Creator Owner Server ID S-1-3-2 // -// Creator Group Server ID S-1-3-3 // -// // -// (Non-unique IDs) S-1-4 // -// // -///////////////////////////////////////////////////////////////////////////// - -const - SECURITY_NULL_SID_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 0)); - {$EXTERNALSYM SECURITY_NULL_SID_AUTHORITY} - SECURITY_WORLD_SID_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 1)); - {$EXTERNALSYM SECURITY_WORLD_SID_AUTHORITY} - SECURITY_LOCAL_SID_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 2)); - {$EXTERNALSYM SECURITY_LOCAL_SID_AUTHORITY} - SECURITY_CREATOR_SID_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 3)); - {$EXTERNALSYM SECURITY_CREATOR_SID_AUTHORITY} - SECURITY_NON_UNIQUE_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 4)); - {$EXTERNALSYM SECURITY_NON_UNIQUE_AUTHORITY} - SECURITY_RESOURCE_MANAGER_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 9)); - {$EXTERNALSYM SECURITY_RESOURCE_MANAGER_AUTHORITY} - - SECURITY_NULL_RID = ($00000000); - {$EXTERNALSYM SECURITY_NULL_RID} - SECURITY_WORLD_RID = ($00000000); - {$EXTERNALSYM SECURITY_WORLD_RID} - SECURITY_LOCAL_RID = ($00000000); - {$EXTERNALSYM SECURITY_LOCAL_RID} - - SECURITY_CREATOR_OWNER_RID = ($00000000); - {$EXTERNALSYM SECURITY_CREATOR_OWNER_RID} - SECURITY_CREATOR_GROUP_RID = ($00000001); - {$EXTERNALSYM SECURITY_CREATOR_GROUP_RID} - - SECURITY_CREATOR_OWNER_SERVER_RID = ($00000002); - {$EXTERNALSYM SECURITY_CREATOR_OWNER_SERVER_RID} - SECURITY_CREATOR_GROUP_SERVER_RID = ($00000003); - {$EXTERNALSYM SECURITY_CREATOR_GROUP_SERVER_RID} - -///////////////////////////////////////////////////////////////////////////// -// // -// NT well-known SIDs // -// // -// NT Authority S-1-5 // -// Dialup S-1-5-1 // -// // -// Network S-1-5-2 // -// Batch S-1-5-3 // -// Interactive S-1-5-4 // -// (Logon IDs) S-1-5-5-X-Y // -// Service S-1-5-6 // -// AnonymousLogon S-1-5-7 (aka null logon session) // -// Proxy S-1-5-8 // -// Enterprise DC (EDC) S-1-5-9 (aka domain controller account) // -// Self S-1-5-10 (self RID) // -// Authenticated User S-1-5-11 (Authenticated user somewhere) // -// Restricted Code S-1-5-12 (Running restricted code) // -// Terminal Server S-1-5-13 (Running on Terminal Server) // -// Remote Logon S-1-5-14 (Remote Interactive Logon) // -// This Organization S-1-5-15 // -// // -// Local System S-1-5-18 // -// Local Service S-1-5-19 // -// Network Service S-1-5-20 // -// // -// (NT non-unique IDs) S-1-5-0x15-... (NT Domain Sids) // -// // -// (Built-in domain) S-1-5-0x20 // -// // -// (Security Package IDs) S-1-5-0x40 // -// NTLM Authentication S-1-5-0x40-10 // -// SChannel Authentication S-1-5-0x40-14 // -// Digest Authentication S-1-5-0x40-21 // -// // -// Other Organization S-1-5-1000 (>=1000 can not be filtered) // -// // -// // -// NOTE: the relative identifier values (RIDs) determine which security // -// boundaries the SID is allowed to cross. Before adding new RIDs, // -// a determination needs to be made regarding which range they should // -// be added to in order to ensure proper "SID filtering" // -// // -///////////////////////////////////////////////////////////////////////////// - -const - SECURITY_NT_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5)); - {$EXTERNALSYM SECURITY_NT_AUTHORITY} - - SECURITY_DIALUP_RID = ($00000001); - {$EXTERNALSYM SECURITY_DIALUP_RID} - SECURITY_NETWORK_RID = ($00000002); - {$EXTERNALSYM SECURITY_NETWORK_RID} - SECURITY_BATCH_RID = ($00000003); - {$EXTERNALSYM SECURITY_BATCH_RID} - SECURITY_INTERACTIVE_RID = ($00000004); - {$EXTERNALSYM SECURITY_INTERACTIVE_RID} - SECURITY_LOGON_IDS_RID = ($00000005); - {$EXTERNALSYM SECURITY_LOGON_IDS_RID} - SECURITY_LOGON_IDS_RID_COUNT = (3); - {$EXTERNALSYM SECURITY_LOGON_IDS_RID_COUNT} - SECURITY_SERVICE_RID = ($00000006); - {$EXTERNALSYM SECURITY_SERVICE_RID} - SECURITY_ANONYMOUS_LOGON_RID = ($00000007); - {$EXTERNALSYM SECURITY_ANONYMOUS_LOGON_RID} - SECURITY_PROXY_RID = ($00000008); - {$EXTERNALSYM SECURITY_PROXY_RID} - SECURITY_ENTERPRISE_CONTROLLERS_RID = ($00000009); - {$EXTERNALSYM SECURITY_ENTERPRISE_CONTROLLERS_RID} - SECURITY_SERVER_LOGON_RID = SECURITY_ENTERPRISE_CONTROLLERS_RID; - {$EXTERNALSYM SECURITY_SERVER_LOGON_RID} - SECURITY_PRINCIPAL_SELF_RID = ($0000000A); - {$EXTERNALSYM SECURITY_PRINCIPAL_SELF_RID} - SECURITY_AUTHENTICATED_USER_RID = ($0000000B); - {$EXTERNALSYM SECURITY_AUTHENTICATED_USER_RID} - SECURITY_RESTRICTED_CODE_RID = ($0000000C); - {$EXTERNALSYM SECURITY_RESTRICTED_CODE_RID} - SECURITY_TERMINAL_SERVER_RID = ($0000000D); - {$EXTERNALSYM SECURITY_TERMINAL_SERVER_RID} - SECURITY_REMOTE_LOGON_RID = ($0000000E); - {$EXTERNALSYM SECURITY_REMOTE_LOGON_RID} - SECURITY_THIS_ORGANIZATION_RID = ($0000000F); - {$EXTERNALSYM SECURITY_THIS_ORGANIZATION_RID} - - SECURITY_LOCAL_SYSTEM_RID = ($00000012); - {$EXTERNALSYM SECURITY_LOCAL_SYSTEM_RID} - SECURITY_LOCAL_SERVICE_RID = ($00000013); - {$EXTERNALSYM SECURITY_LOCAL_SERVICE_RID} - SECURITY_NETWORK_SERVICE_RID = ($00000014); - {$EXTERNALSYM SECURITY_NETWORK_SERVICE_RID} - - SECURITY_NT_NON_UNIQUE = ($00000015); - {$EXTERNALSYM SECURITY_NT_NON_UNIQUE} - SECURITY_NT_NON_UNIQUE_SUB_AUTH_COUNT = (3); - {$EXTERNALSYM SECURITY_NT_NON_UNIQUE_SUB_AUTH_COUNT} - - SECURITY_BUILTIN_DOMAIN_RID = ($00000020); - {$EXTERNALSYM SECURITY_BUILTIN_DOMAIN_RID} - - SECURITY_PACKAGE_BASE_RID = ($00000040); - {$EXTERNALSYM SECURITY_PACKAGE_BASE_RID} - SECURITY_PACKAGE_RID_COUNT = (2); - {$EXTERNALSYM SECURITY_PACKAGE_RID_COUNT} - SECURITY_PACKAGE_NTLM_RID = ($0000000A); - {$EXTERNALSYM SECURITY_PACKAGE_NTLM_RID} - SECURITY_PACKAGE_SCHANNEL_RID = ($0000000E); - {$EXTERNALSYM SECURITY_PACKAGE_SCHANNEL_RID} - SECURITY_PACKAGE_DIGEST_RID = ($00000015); - {$EXTERNALSYM SECURITY_PACKAGE_DIGEST_RID} - - SECURITY_MAX_ALWAYS_FILTERED = ($000003E7); - {$EXTERNALSYM SECURITY_MAX_ALWAYS_FILTERED} - SECURITY_MIN_NEVER_FILTERED = ($000003E8); - {$EXTERNALSYM SECURITY_MIN_NEVER_FILTERED} - - SECURITY_OTHER_ORGANIZATION_RID = ($000003E8); - {$EXTERNALSYM SECURITY_OTHER_ORGANIZATION_RID} - -///////////////////////////////////////////////////////////////////////////// -// // -// well-known domain relative sub-authority values (RIDs)... // -// // -///////////////////////////////////////////////////////////////////////////// - -// Well-known users ... - - FOREST_USER_RID_MAX = ($000001F3); - {$EXTERNALSYM FOREST_USER_RID_MAX} - - DOMAIN_USER_RID_ADMIN = ($000001F4); - {$EXTERNALSYM DOMAIN_USER_RID_ADMIN} - DOMAIN_USER_RID_GUEST = ($000001F5); - {$EXTERNALSYM DOMAIN_USER_RID_GUEST} - DOMAIN_USER_RID_KRBTGT = ($000001F6); - {$EXTERNALSYM DOMAIN_USER_RID_KRBTGT} - - DOMAIN_USER_RID_MAX = ($000003E7); - {$EXTERNALSYM DOMAIN_USER_RID_MAX} - -// well-known groups ... - - DOMAIN_GROUP_RID_ADMINS = ($00000200); - {$EXTERNALSYM DOMAIN_GROUP_RID_ADMINS} - DOMAIN_GROUP_RID_USERS = ($00000201); - {$EXTERNALSYM DOMAIN_GROUP_RID_USERS} - DOMAIN_GROUP_RID_GUESTS = ($00000202); - {$EXTERNALSYM DOMAIN_GROUP_RID_GUESTS} - DOMAIN_GROUP_RID_COMPUTERS = ($00000203); - {$EXTERNALSYM DOMAIN_GROUP_RID_COMPUTERS} - DOMAIN_GROUP_RID_CONTROLLERS = ($00000204); - {$EXTERNALSYM DOMAIN_GROUP_RID_CONTROLLERS} - DOMAIN_GROUP_RID_CERT_ADMINS = ($00000205); - {$EXTERNALSYM DOMAIN_GROUP_RID_CERT_ADMINS} - DOMAIN_GROUP_RID_SCHEMA_ADMINS = ($00000206); - {$EXTERNALSYM DOMAIN_GROUP_RID_SCHEMA_ADMINS} - DOMAIN_GROUP_RID_ENTERPRISE_ADMINS = ($00000207); - {$EXTERNALSYM DOMAIN_GROUP_RID_ENTERPRISE_ADMINS} - DOMAIN_GROUP_RID_POLICY_ADMINS = ($00000208); - {$EXTERNALSYM DOMAIN_GROUP_RID_POLICY_ADMINS} - -// well-known aliases ... - - DOMAIN_ALIAS_RID_ADMINS = ($00000220); - {$EXTERNALSYM DOMAIN_ALIAS_RID_ADMINS} - DOMAIN_ALIAS_RID_USERS = ($00000221); - {$EXTERNALSYM DOMAIN_ALIAS_RID_USERS} - DOMAIN_ALIAS_RID_GUESTS = ($00000222); - {$EXTERNALSYM DOMAIN_ALIAS_RID_GUESTS} - DOMAIN_ALIAS_RID_POWER_USERS = ($00000223); - {$EXTERNALSYM DOMAIN_ALIAS_RID_POWER_USERS} - - DOMAIN_ALIAS_RID_ACCOUNT_OPS = ($00000224); - {$EXTERNALSYM DOMAIN_ALIAS_RID_ACCOUNT_OPS} - DOMAIN_ALIAS_RID_SYSTEM_OPS = ($00000225); - {$EXTERNALSYM DOMAIN_ALIAS_RID_SYSTEM_OPS} - DOMAIN_ALIAS_RID_PRINT_OPS = ($00000226); - {$EXTERNALSYM DOMAIN_ALIAS_RID_PRINT_OPS} - DOMAIN_ALIAS_RID_BACKUP_OPS = ($00000227); - {$EXTERNALSYM DOMAIN_ALIAS_RID_BACKUP_OPS} - - DOMAIN_ALIAS_RID_REPLICATOR = ($00000228); - {$EXTERNALSYM DOMAIN_ALIAS_RID_REPLICATOR} - DOMAIN_ALIAS_RID_RAS_SERVERS = ($00000229); - {$EXTERNALSYM DOMAIN_ALIAS_RID_RAS_SERVERS} - DOMAIN_ALIAS_RID_PREW2KCOMPACCESS = ($0000022A); - {$EXTERNALSYM DOMAIN_ALIAS_RID_PREW2KCOMPACCESS} - DOMAIN_ALIAS_RID_REMOTE_DESKTOP_USERS = ($0000022B); - {$EXTERNALSYM DOMAIN_ALIAS_RID_REMOTE_DESKTOP_USERS} - DOMAIN_ALIAS_RID_NETWORK_CONFIGURATION_OPS = ($0000022C); - {$EXTERNALSYM DOMAIN_ALIAS_RID_NETWORK_CONFIGURATION_OPS} - DOMAIN_ALIAS_RID_INCOMING_FOREST_TRUST_BUILDERS = ($0000022D); - {$EXTERNALSYM DOMAIN_ALIAS_RID_INCOMING_FOREST_TRUST_BUILDERS} - - DOMAIN_ALIAS_RID_MONITORING_USERS = ($0000022E); - {$EXTERNALSYM DOMAIN_ALIAS_RID_MONITORING_USERS} - DOMAIN_ALIAS_RID_LOGGING_USERS = ($0000022F); - {$EXTERNALSYM DOMAIN_ALIAS_RID_LOGGING_USERS} - DOMAIN_ALIAS_RID_AUTHORIZATIONACCESS = ($00000230); - {$EXTERNALSYM DOMAIN_ALIAS_RID_AUTHORIZATIONACCESS} - DOMAIN_ALIAS_RID_TS_LICENSE_SERVERS = ($00000231); - {$EXTERNALSYM DOMAIN_ALIAS_RID_TS_LICENSE_SERVERS} - -// line 2495 - -//////////////////////////////////////////////////////////////////////// -// // -// NT Defined Privileges // -// // -//////////////////////////////////////////////////////////////////////// - -const - SE_CREATE_TOKEN_NAME = 'SeCreateTokenPrivilege'; - {$EXTERNALSYM SE_CREATE_TOKEN_NAME} - SE_ASSIGNPRIMARYTOKEN_NAME = 'SeAssignPrimaryTokenPrivilege'; - {$EXTERNALSYM SE_ASSIGNPRIMARYTOKEN_NAME} - SE_LOCK_MEMORY_NAME = 'SeLockMemoryPrivilege'; - {$EXTERNALSYM SE_LOCK_MEMORY_NAME} - SE_INCREASE_QUOTA_NAME = 'SeIncreaseQuotaPrivilege'; - {$EXTERNALSYM SE_INCREASE_QUOTA_NAME} - SE_UNSOLICITED_INPUT_NAME = 'SeUnsolicitedInputPrivilege'; - {$EXTERNALSYM SE_UNSOLICITED_INPUT_NAME} - SE_MACHINE_ACCOUNT_NAME = 'SeMachineAccountPrivilege'; - {$EXTERNALSYM SE_MACHINE_ACCOUNT_NAME} - SE_TCB_NAME = 'SeTcbPrivilege'; - {$EXTERNALSYM SE_TCB_NAME} - SE_SECURITY_NAME = 'SeSecurityPrivilege'; - {$EXTERNALSYM SE_SECURITY_NAME} - SE_TAKE_OWNERSHIP_NAME = 'SeTakeOwnershipPrivilege'; - {$EXTERNALSYM SE_TAKE_OWNERSHIP_NAME} - SE_LOAD_DRIVER_NAME = 'SeLoadDriverPrivilege'; - {$EXTERNALSYM SE_LOAD_DRIVER_NAME} - SE_SYSTEM_PROFILE_NAME = 'SeSystemProfilePrivilege'; - {$EXTERNALSYM SE_SYSTEM_PROFILE_NAME} - SE_SYSTEMTIME_NAME = 'SeSystemtimePrivilege'; - {$EXTERNALSYM SE_SYSTEMTIME_NAME} - SE_PROF_SINGLE_PROCESS_NAME = 'SeProfileSingleProcessPrivilege'; - {$EXTERNALSYM SE_PROF_SINGLE_PROCESS_NAME} - SE_INC_BASE_PRIORITY_NAME = 'SeIncreaseBasePriorityPrivilege'; - {$EXTERNALSYM SE_INC_BASE_PRIORITY_NAME} - SE_CREATE_PAGEFILE_NAME = 'SeCreatePagefilePrivilege'; - {$EXTERNALSYM SE_CREATE_PAGEFILE_NAME} - SE_CREATE_PERMANENT_NAME = 'SeCreatePermanentPrivilege'; - {$EXTERNALSYM SE_CREATE_PERMANENT_NAME} - SE_BACKUP_NAME = 'SeBackupPrivilege'; - {$EXTERNALSYM SE_BACKUP_NAME} - SE_RESTORE_NAME = 'SeRestorePrivilege'; - {$EXTERNALSYM SE_RESTORE_NAME} - SE_SHUTDOWN_NAME = 'SeShutdownPrivilege'; - {$EXTERNALSYM SE_SHUTDOWN_NAME} - SE_DEBUG_NAME = 'SeDebugPrivilege'; - {$EXTERNALSYM SE_DEBUG_NAME} - SE_AUDIT_NAME = 'SeAuditPrivilege'; - {$EXTERNALSYM SE_AUDIT_NAME} - SE_SYSTEM_ENVIRONMENT_NAME = 'SeSystemEnvironmentPrivilege'; - {$EXTERNALSYM SE_SYSTEM_ENVIRONMENT_NAME} - SE_CHANGE_NOTIFY_NAME = 'SeChangeNotifyPrivilege'; - {$EXTERNALSYM SE_CHANGE_NOTIFY_NAME} - SE_REMOTE_SHUTDOWN_NAME = 'SeRemoteShutdownPrivilege'; - {$EXTERNALSYM SE_REMOTE_SHUTDOWN_NAME} - SE_UNDOCK_NAME = 'SeUndockPrivilege'; - {$EXTERNALSYM SE_UNDOCK_NAME} - SE_SYNC_AGENT_NAME = 'SeSyncAgentPrivilege'; - {$EXTERNALSYM SE_SYNC_AGENT_NAME} - SE_ENABLE_DELEGATION_NAME = 'SeEnableDelegationPrivilege'; - {$EXTERNALSYM SE_ENABLE_DELEGATION_NAME} - SE_MANAGE_VOLUME_NAME = 'SeManageVolumePrivilege'; - {$EXTERNALSYM SE_MANAGE_VOLUME_NAME} - SE_IMPERSONATE_NAME = 'SeImpersonatePrivilege'; - {$EXTERNALSYM SE_IMPERSONATE_NAME} - SE_CREATE_GLOBAL_NAME = 'SeCreateGlobalPrivilege'; - {$EXTERNALSYM SE_CREATE_GLOBAL_NAME} - -// -// Thread Information Block (TIB) -// - -type - NT_TIB32 = packed record - ExceptionList: DWORD; - StackBase: DWORD; - StackLimit: DWORD; - SubSystemTib: DWORD; - case Integer of - 0 : ( - FiberData: DWORD; - ArbitraryUserPointer: DWORD; - Self: DWORD; - ); - 1 : ( - Version: DWORD; - ); - end; - {$EXTERNALSYM NT_TIB32} - PNT_TIB32 = ^NT_TIB32; - {$EXTERNALSYM PNT_TIB32} - - NT_TIB64 = packed record - ExceptionList: TJclAddr64; - StackBase: TJclAddr64; - StackLimit: TJclAddr64; - SubSystemTib: TJclAddr64; - case Integer of - 0 : ( - FiberData: TJclAddr64; - ArbitraryUserPointer: TJclAddr64; - Self: TJclAddr64; - ); - 1 : ( - Version: DWORD; - ); - end; - {$EXTERNALSYM NT_TIB64} - PNT_TIB64 = ^NT_TIB64; - {$EXTERNALSYM PNT_TIB64} - -// line 2686 - -// -// Token information class structures -// - -{$IFNDEF FPC} -type - PTOKEN_USER = ^TOKEN_USER; - {$EXTERNALSYM PTOKEN_USER} - _TOKEN_USER = record - User: SID_AND_ATTRIBUTES; - end; - {$EXTERNALSYM _TOKEN_USER} - TOKEN_USER = _TOKEN_USER; - {$EXTERNALSYM TOKEN_USER} - TTokenUser = TOKEN_USER; - PTokenUser = PTOKEN_USER; -{$ENDIF ~FPC} - -function CaptureStackBackTrace(FramesToSkip, FramesToCapture: DWORD; - BackTrace: Pointer; out BackTraceHash: DWORD): Word; stdcall; -{$EXTERNALSYM CaptureStackBackTrace} - -// line 3858 - -// -// Define access rights to files and directories -// - -// -// The FILE_READ_DATA and FILE_WRITE_DATA constants are also defined in -// devioctl.h as FILE_READ_ACCESS and FILE_WRITE_ACCESS. The values for these -// constants *MUST* always be in sync. -// The values are redefined in devioctl.h because they must be available to -// both DOS and NT. -// - -const - FILE_READ_DATA = ($0001); // file & pipe - {$EXTERNALSYM FILE_READ_DATA} - FILE_LIST_DIRECTORY = ($0001); // directory - {$EXTERNALSYM FILE_LIST_DIRECTORY} - - FILE_WRITE_DATA = ($0002); // file & pipe - {$EXTERNALSYM FILE_WRITE_DATA} - FILE_ADD_FILE = ($0002); // directory - {$EXTERNALSYM FILE_ADD_FILE} - - FILE_APPEND_DATA = ($0004); // file - {$EXTERNALSYM FILE_APPEND_DATA} - FILE_ADD_SUBDIRECTORY = ($0004); // directory - {$EXTERNALSYM FILE_ADD_SUBDIRECTORY} - FILE_CREATE_PIPE_INSTANCE = ($0004); // named pipe - {$EXTERNALSYM FILE_CREATE_PIPE_INSTANCE} - - FILE_READ_EA = ($0008); // file & directory - {$EXTERNALSYM FILE_READ_EA} - - FILE_WRITE_EA = ($0010); // file & directory - {$EXTERNALSYM FILE_WRITE_EA} - - FILE_EXECUTE = ($0020); // file - {$EXTERNALSYM FILE_EXECUTE} - FILE_TRAVERSE = ($0020); // directory - {$EXTERNALSYM FILE_TRAVERSE} - - FILE_DELETE_CHILD = ($0040); // directory - {$EXTERNALSYM FILE_DELETE_CHILD} - - FILE_READ_ATTRIBUTES = ($0080); // all - {$EXTERNALSYM FILE_READ_ATTRIBUTES} - - FILE_WRITE_ATTRIBUTES = ($0100); // all - {$EXTERNALSYM FILE_WRITE_ATTRIBUTES} - - FILE_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or $1FF); - {$EXTERNALSYM FILE_ALL_ACCESS} - - FILE_GENERIC_READ = (STANDARD_RIGHTS_READ or FILE_READ_DATA or - FILE_READ_ATTRIBUTES or FILE_READ_EA or SYNCHRONIZE); - {$EXTERNALSYM FILE_GENERIC_READ} - - FILE_GENERIC_WRITE = (STANDARD_RIGHTS_WRITE or FILE_WRITE_DATA or - FILE_WRITE_ATTRIBUTES or FILE_WRITE_EA or FILE_APPEND_DATA or SYNCHRONIZE); - {$EXTERNALSYM FILE_GENERIC_WRITE} - - FILE_GENERIC_EXECUTE = (STANDARD_RIGHTS_EXECUTE or FILE_READ_ATTRIBUTES or - FILE_EXECUTE or SYNCHRONIZE); - {$EXTERNALSYM FILE_GENERIC_EXECUTE} - - FILE_SHARE_READ = $00000001; - {$EXTERNALSYM FILE_SHARE_READ} - FILE_SHARE_WRITE = $00000002; - {$EXTERNALSYM FILE_SHARE_WRITE} - FILE_SHARE_DELETE = $00000004; - {$EXTERNALSYM FILE_SHARE_DELETE} - FILE_ATTRIBUTE_READONLY = $00000001; - {$EXTERNALSYM FILE_ATTRIBUTE_READONLY} - FILE_ATTRIBUTE_HIDDEN = $00000002; - {$EXTERNALSYM FILE_ATTRIBUTE_HIDDEN} - FILE_ATTRIBUTE_SYSTEM = $00000004; - {$EXTERNALSYM FILE_ATTRIBUTE_SYSTEM} - FILE_ATTRIBUTE_DIRECTORY = $00000010; - {$EXTERNALSYM FILE_ATTRIBUTE_DIRECTORY} - FILE_ATTRIBUTE_ARCHIVE = $00000020; - {$EXTERNALSYM FILE_ATTRIBUTE_ARCHIVE} - FILE_ATTRIBUTE_DEVICE = $00000040; - {$EXTERNALSYM FILE_ATTRIBUTE_DEVICE} - FILE_ATTRIBUTE_NORMAL = $00000080; - {$EXTERNALSYM FILE_ATTRIBUTE_NORMAL} - FILE_ATTRIBUTE_TEMPORARY = $00000100; - {$EXTERNALSYM FILE_ATTRIBUTE_TEMPORARY} - FILE_ATTRIBUTE_SPARSE_FILE = $00000200; - {$EXTERNALSYM FILE_ATTRIBUTE_SPARSE_FILE} - FILE_ATTRIBUTE_REPARSE_POINT = $00000400; - {$EXTERNALSYM FILE_ATTRIBUTE_REPARSE_POINT} - FILE_ATTRIBUTE_COMPRESSED = $00000800; - {$EXTERNALSYM FILE_ATTRIBUTE_COMPRESSED} - FILE_ATTRIBUTE_OFFLINE = $00001000; - {$EXTERNALSYM FILE_ATTRIBUTE_OFFLINE} - FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = $00002000; - {$EXTERNALSYM FILE_ATTRIBUTE_NOT_CONTENT_INDEXED} - FILE_ATTRIBUTE_ENCRYPTED = $00004000; - {$EXTERNALSYM FILE_ATTRIBUTE_ENCRYPTED} - FILE_NOTIFY_CHANGE_FILE_NAME = $00000001; - {$EXTERNALSYM FILE_NOTIFY_CHANGE_FILE_NAME} - FILE_NOTIFY_CHANGE_DIR_NAME = $00000002; - {$EXTERNALSYM FILE_NOTIFY_CHANGE_DIR_NAME} - FILE_NOTIFY_CHANGE_ATTRIBUTES = $00000004; - {$EXTERNALSYM FILE_NOTIFY_CHANGE_ATTRIBUTES} - FILE_NOTIFY_CHANGE_SIZE = $00000008; - {$EXTERNALSYM FILE_NOTIFY_CHANGE_SIZE} - FILE_NOTIFY_CHANGE_LAST_WRITE = $00000010; - {$EXTERNALSYM FILE_NOTIFY_CHANGE_LAST_WRITE} - FILE_NOTIFY_CHANGE_LAST_ACCESS = $00000020; - {$EXTERNALSYM FILE_NOTIFY_CHANGE_LAST_ACCESS} - FILE_NOTIFY_CHANGE_CREATION = $00000040; - {$EXTERNALSYM FILE_NOTIFY_CHANGE_CREATION} - FILE_NOTIFY_CHANGE_SECURITY = $00000100; - {$EXTERNALSYM FILE_NOTIFY_CHANGE_SECURITY} - FILE_ACTION_ADDED = $00000001; - {$EXTERNALSYM FILE_ACTION_ADDED} - FILE_ACTION_REMOVED = $00000002; - {$EXTERNALSYM FILE_ACTION_REMOVED} - FILE_ACTION_MODIFIED = $00000003; - {$EXTERNALSYM FILE_ACTION_MODIFIED} - FILE_ACTION_RENAMED_OLD_NAME = $00000004; - {$EXTERNALSYM FILE_ACTION_RENAMED_OLD_NAME} - FILE_ACTION_RENAMED_NEW_NAME = $00000005; - {$EXTERNALSYM FILE_ACTION_RENAMED_NEW_NAME} - MAILSLOT_NO_MESSAGE = DWORD(-1); - {$EXTERNALSYM MAILSLOT_NO_MESSAGE} - MAILSLOT_WAIT_FOREVER = DWORD(-1); - {$EXTERNALSYM MAILSLOT_WAIT_FOREVER} - FILE_CASE_SENSITIVE_SEARCH = $00000001; - {$EXTERNALSYM FILE_CASE_SENSITIVE_SEARCH} - FILE_CASE_PRESERVED_NAMES = $00000002; - {$EXTERNALSYM FILE_CASE_PRESERVED_NAMES} - FILE_UNICODE_ON_DISK = $00000004; - {$EXTERNALSYM FILE_UNICODE_ON_DISK} - FILE_PERSISTENT_ACLS = $00000008; - {$EXTERNALSYM FILE_PERSISTENT_ACLS} - FILE_FILE_COMPRESSION = $00000010; - {$EXTERNALSYM FILE_FILE_COMPRESSION} - FILE_VOLUME_QUOTAS = $00000020; - {$EXTERNALSYM FILE_VOLUME_QUOTAS} - FILE_SUPPORTS_SPARSE_FILES = $00000040; - {$EXTERNALSYM FILE_SUPPORTS_SPARSE_FILES} - FILE_SUPPORTS_REPARSE_POINTS = $00000080; - {$EXTERNALSYM FILE_SUPPORTS_REPARSE_POINTS} - FILE_SUPPORTS_REMOTE_STORAGE = $00000100; - {$EXTERNALSYM FILE_SUPPORTS_REMOTE_STORAGE} - FILE_VOLUME_IS_COMPRESSED = $00008000; - {$EXTERNALSYM FILE_VOLUME_IS_COMPRESSED} - FILE_SUPPORTS_OBJECT_IDS = $00010000; - {$EXTERNALSYM FILE_SUPPORTS_OBJECT_IDS} - FILE_SUPPORTS_ENCRYPTION = $00020000; - {$EXTERNALSYM FILE_SUPPORTS_ENCRYPTION} - FILE_NAMED_STREAMS = $00040000; - {$EXTERNALSYM FILE_NAMED_STREAMS} - FILE_READ_ONLY_VOLUME = $00080000; - {$EXTERNALSYM FILE_READ_ONLY_VOLUME} - -// line 4052 - -// -// The reparse GUID structure is used by all 3rd party layered drivers to -// store data in a reparse point. For non-Microsoft tags, The GUID field -// cannot be GUID_NULL. -// The constraints on reparse tags are defined below. -// Microsoft tags can also be used with this format of the reparse point buffer. -// - -type - TGenericReparseBuffer = record - DataBuffer: array [0..0] of BYTE; - end; - - PREPARSE_GUID_DATA_BUFFER = ^REPARSE_GUID_DATA_BUFFER; - {$EXTERNALSYM PREPARSE_GUID_DATA_BUFFER} - _REPARSE_GUID_DATA_BUFFER = record - ReparseTag: DWORD; - ReparseDataLength: WORD; - Reserved: WORD; - ReparseGuid: TGUID; - GenericReparseBuffer: TGenericReparseBuffer; - end; - {$EXTERNALSYM _REPARSE_GUID_DATA_BUFFER} - REPARSE_GUID_DATA_BUFFER = _REPARSE_GUID_DATA_BUFFER; - {$EXTERNALSYM REPARSE_GUID_DATA_BUFFER} - TReparseGuidDataBuffer = REPARSE_GUID_DATA_BUFFER; - PReparseGuidDataBuffer = PREPARSE_GUID_DATA_BUFFER; - -const - REPARSE_GUID_DATA_BUFFER_HEADER_SIZE = 24; - {$EXTERNALSYM REPARSE_GUID_DATA_BUFFER_HEADER_SIZE} -// -// Maximum allowed size of the reparse data. -// - -const - MAXIMUM_REPARSE_DATA_BUFFER_SIZE = 16 * 1024; - {$EXTERNALSYM MAXIMUM_REPARSE_DATA_BUFFER_SIZE} - -// -// Predefined reparse tags. -// These tags need to avoid conflicting with IO_REMOUNT defined in ntos\inc\io.h -// - - IO_REPARSE_TAG_RESERVED_ZERO = (0); - {$EXTERNALSYM IO_REPARSE_TAG_RESERVED_ZERO} - IO_REPARSE_TAG_RESERVED_ONE = (1); - {$EXTERNALSYM IO_REPARSE_TAG_RESERVED_ONE} - -// -// The value of the following constant needs to satisfy the following conditions: -// (1) Be at least as large as the largest of the reserved tags. -// (2) Be strictly smaller than all the tags in use. -// - - IO_REPARSE_TAG_RESERVED_RANGE = IO_REPARSE_TAG_RESERVED_ONE; - {$EXTERNALSYM IO_REPARSE_TAG_RESERVED_RANGE} - -// -// The reparse tags are a DWORD. The 32 bits are laid out as follows: -// -// 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 -// 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 -// +-+-+-+-+-----------------------+-------------------------------+ -// |M|R|N|R| Reserved bits | Reparse Tag Value | -// +-+-+-+-+-----------------------+-------------------------------+ -// -// M is the Microsoft bit. When set to 1, it denotes a tag owned by Microsoft. -// All ISVs must use a tag with a 0 in this position. -// Note: If a Microsoft tag is used by non-Microsoft software, the -// behavior is not defined. -// -// R is reserved. Must be zero for non-Microsoft tags. -// -// N is name surrogate. When set to 1, the file represents another named -// entity in the system. -// -// The M and N bits are OR-able. -// The following macros check for the M and N bit values: -// - -// -// Macro to determine whether a reparse point tag corresponds to a tag -// owned by Microsoft. -// - -function IsReparseTagMicrosoft(Tag: ULONG): Boolean; -{$EXTERNALSYM IsReparseTagMicrosoft} - -// -// Macro to determine whether a reparse point tag corresponds to a file -// that is to be displayed with the slow icon overlay. -// - -function IsReparseTagHighLatency(Tag: ULONG): Boolean; -{$EXTERNALSYM IsReparseTagHighLatency} - -// -// Macro to determine whether a reparse point tag is a name surrogate -// - -function IsReparseTagNameSurrogate(Tag: ULONG): Boolean; -{$EXTERNALSYM IsReparseTagNameSurrogate} - -const - IO_REPARSE_TAG_MOUNT_POINT = DWORD($A0000003); - {$EXTERNALSYM IO_REPARSE_TAG_MOUNT_POINT} - IO_REPARSE_TAG_HSM = DWORD($C0000004); - {$EXTERNALSYM IO_REPARSE_TAG_HSM} - IO_REPARSE_TAG_DRIVER_EXTENDER = DWORD($80000005); - {$EXTERNALSYM IO_REPARSE_TAG_DRIVER_EXTENDER} - IO_REPARSE_TAG_HSM2 = DWORD($80000006); - {$EXTERNALSYM IO_REPARSE_TAG_HSM2} - IO_REPARSE_TAG_SIS = DWORD($80000007); - {$EXTERNALSYM IO_REPARSE_TAG_SIS} - IO_REPARSE_TAG_DFS = DWORD($8000000A); - {$EXTERNALSYM IO_REPARSE_TAG_DFS} - IO_REPARSE_TAG_FILTER_MANAGER = DWORD($8000000B); - {$EXTERNALSYM IO_REPARSE_TAG_FILTER_MANAGER} - IO_REPARSE_TAG_SYMLINK = DWORD($A000000C); - {$EXTERNALSYM IO_REPARSE_TAG_SYMLINK} - IO_REPARSE_TAG_DFSR = DWORD($80000012); - {$EXTERNALSYM IO_REPARSE_TAG_DFSR} - IO_REPARSE_TAG_NFS = DWORD($80000014); - {$EXTERNALSYM IO_REPARSE_TAG_NFS} - - IO_COMPLETION_MODIFY_STATE = $0002; - {$EXTERNALSYM IO_COMPLETION_MODIFY_STATE} - IO_COMPLETION_ALL_ACCESS = DWORD(STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or $3); - {$EXTERNALSYM IO_COMPLETION_ALL_ACCESS} - - DUPLICATE_CLOSE_SOURCE = $00000001; - {$EXTERNALSYM DUPLICATE_CLOSE_SOURCE} - DUPLICATE_SAME_ACCESS = $00000002; - {$EXTERNALSYM DUPLICATE_SAME_ACCESS} - -// line 4763 - -// -// File header format. -// - -{$IFNDEF FPC} -type - PIMAGE_FILE_HEADER = ^IMAGE_FILE_HEADER; - {$EXTERNALSYM PIMAGE_FILE_HEADER} - _IMAGE_FILE_HEADER = record - Machine: WORD; - NumberOfSections: WORD; - TimeDateStamp: DWORD; - PointerToSymbolTable: DWORD; - NumberOfSymbols: DWORD; - SizeOfOptionalHeader: WORD; - Characteristics: WORD; - end; - {$EXTERNALSYM _IMAGE_FILE_HEADER} - IMAGE_FILE_HEADER = _IMAGE_FILE_HEADER; - {$EXTERNALSYM IMAGE_FILE_HEADER} - TImageFileHeader = IMAGE_FILE_HEADER; - PImageFileHeader = PIMAGE_FILE_HEADER; -{$ENDIF ~FPC} - -const - IMAGE_SIZEOF_FILE_HEADER = 20; - {$EXTERNALSYM IMAGE_SIZEOF_FILE_HEADER} - - IMAGE_FILE_RELOCS_STRIPPED = $0001; // Relocation info stripped from file. - {$EXTERNALSYM IMAGE_FILE_RELOCS_STRIPPED} - IMAGE_FILE_EXECUTABLE_IMAGE = $0002; // File is executable (i.e. no unresolved externel references). - {$EXTERNALSYM IMAGE_FILE_EXECUTABLE_IMAGE} - IMAGE_FILE_LINE_NUMS_STRIPPED = $0004; // Line nunbers stripped from file. - {$EXTERNALSYM IMAGE_FILE_LINE_NUMS_STRIPPED} - IMAGE_FILE_LOCAL_SYMS_STRIPPED = $0008; // Local symbols stripped from file. - {$EXTERNALSYM IMAGE_FILE_LOCAL_SYMS_STRIPPED} - IMAGE_FILE_AGGRESIVE_WS_TRIM = $0010; // Agressively trim working set - {$EXTERNALSYM IMAGE_FILE_AGGRESIVE_WS_TRIM} - IMAGE_FILE_LARGE_ADDRESS_AWARE = $0020; // App can handle >2gb addresses - {$EXTERNALSYM IMAGE_FILE_LARGE_ADDRESS_AWARE} - IMAGE_FILE_BYTES_REVERSED_LO = $0080; // Bytes of machine word are reversed. - {$EXTERNALSYM IMAGE_FILE_BYTES_REVERSED_LO} - IMAGE_FILE_32BIT_MACHINE = $0100; // 32 bit word machine. - {$EXTERNALSYM IMAGE_FILE_32BIT_MACHINE} - IMAGE_FILE_DEBUG_STRIPPED = $0200; // Debugging info stripped from file in .DBG file - {$EXTERNALSYM IMAGE_FILE_DEBUG_STRIPPED} - IMAGE_FILE_REMOVABLE_RUN_FROM_SWAP = $0400; // If Image is on removable media, copy and run from the swap file. - {$EXTERNALSYM IMAGE_FILE_REMOVABLE_RUN_FROM_SWAP} - IMAGE_FILE_NET_RUN_FROM_SWAP = $0800; // If Image is on Net, copy and run from the swap file. - {$EXTERNALSYM IMAGE_FILE_NET_RUN_FROM_SWAP} - IMAGE_FILE_SYSTEM = $1000; // System File. - {$EXTERNALSYM IMAGE_FILE_SYSTEM} - IMAGE_FILE_DLL = $2000; // File is a DLL. - {$EXTERNALSYM IMAGE_FILE_DLL} - IMAGE_FILE_UP_SYSTEM_ONLY = $4000; // File should only be run on a UP machine - {$EXTERNALSYM IMAGE_FILE_UP_SYSTEM_ONLY} - IMAGE_FILE_BYTES_REVERSED_HI = $8000; // Bytes of machine word are reversed. - {$EXTERNALSYM IMAGE_FILE_BYTES_REVERSED_HI} - - IMAGE_FILE_MACHINE_UNKNOWN = 0; - {$EXTERNALSYM IMAGE_FILE_MACHINE_UNKNOWN} - IMAGE_FILE_MACHINE_I386 = $014c; // Intel 386. - {$EXTERNALSYM IMAGE_FILE_MACHINE_I386} - IMAGE_FILE_MACHINE_R3000 = $0162; // MIPS little-endian, 0x160 big-endian - {$EXTERNALSYM IMAGE_FILE_MACHINE_R3000} - IMAGE_FILE_MACHINE_R4000 = $0166; // MIPS little-endian - {$EXTERNALSYM IMAGE_FILE_MACHINE_R4000} - IMAGE_FILE_MACHINE_R10000 = $0168; // MIPS little-endian - {$EXTERNALSYM IMAGE_FILE_MACHINE_R10000} - IMAGE_FILE_MACHINE_WCEMIPSV2 = $0169; // MIPS little-endian WCE v2 - {$EXTERNALSYM IMAGE_FILE_MACHINE_WCEMIPSV2} - IMAGE_FILE_MACHINE_ALPHA = $0184; // Alpha_AXP - {$EXTERNALSYM IMAGE_FILE_MACHINE_ALPHA} - IMAGE_FILE_MACHINE_SH3 = $01a2; // SH3 little-endian - {$EXTERNALSYM IMAGE_FILE_MACHINE_SH3} - IMAGE_FILE_MACHINE_SH3DSP = $01a3; - {$EXTERNALSYM IMAGE_FILE_MACHINE_SH3DSP} - IMAGE_FILE_MACHINE_SH3E = $01a4; // SH3E little-endian - {$EXTERNALSYM IMAGE_FILE_MACHINE_SH3E} - IMAGE_FILE_MACHINE_SH4 = $01a6; // SH4 little-endian - {$EXTERNALSYM IMAGE_FILE_MACHINE_SH4} - IMAGE_FILE_MACHINE_SH5 = $01a8; // SH5 - {$EXTERNALSYM IMAGE_FILE_MACHINE_SH5} - IMAGE_FILE_MACHINE_ARM = $01c0; // ARM Little-Endian - {$EXTERNALSYM IMAGE_FILE_MACHINE_ARM} - IMAGE_FILE_MACHINE_THUMB = $01c2; - {$EXTERNALSYM IMAGE_FILE_MACHINE_THUMB} - IMAGE_FILE_MACHINE_AM33 = $01d3; - {$EXTERNALSYM IMAGE_FILE_MACHINE_AM33} - IMAGE_FILE_MACHINE_POWERPC = $01F0; // IBM PowerPC Little-Endian - {$EXTERNALSYM IMAGE_FILE_MACHINE_POWERPC} - IMAGE_FILE_MACHINE_POWERPCFP = $01f1; - {$EXTERNALSYM IMAGE_FILE_MACHINE_POWERPCFP} - IMAGE_FILE_MACHINE_IA64 = $0200; // Intel 64 - {$EXTERNALSYM IMAGE_FILE_MACHINE_IA64} - IMAGE_FILE_MACHINE_MIPS16 = $0266; // MIPS - {$EXTERNALSYM IMAGE_FILE_MACHINE_MIPS16} - IMAGE_FILE_MACHINE_ALPHA64 = $0284; // ALPHA64 - {$EXTERNALSYM IMAGE_FILE_MACHINE_ALPHA64} - IMAGE_FILE_MACHINE_MIPSFPU = $0366; // MIPS - {$EXTERNALSYM IMAGE_FILE_MACHINE_MIPSFPU} - IMAGE_FILE_MACHINE_MIPSFPU16 = $0466; // MIPS - {$EXTERNALSYM IMAGE_FILE_MACHINE_MIPSFPU16} - IMAGE_FILE_MACHINE_AXP64 = IMAGE_FILE_MACHINE_ALPHA64; - {$EXTERNALSYM IMAGE_FILE_MACHINE_AXP64} - IMAGE_FILE_MACHINE_TRICORE = $0520; // Infineon - {$EXTERNALSYM IMAGE_FILE_MACHINE_TRICORE} - IMAGE_FILE_MACHINE_CEF = $0CEF; - {$EXTERNALSYM IMAGE_FILE_MACHINE_CEF} - IMAGE_FILE_MACHINE_EBC = $0EBC; // EFI Byte Code - {$EXTERNALSYM IMAGE_FILE_MACHINE_EBC} - IMAGE_FILE_MACHINE_AMD64 = $8664; // AMD64 (K8) - {$EXTERNALSYM IMAGE_FILE_MACHINE_AMD64} - IMAGE_FILE_MACHINE_M32R = $9041; // M32R little-endian - {$EXTERNALSYM IMAGE_FILE_MACHINE_M32R} - IMAGE_FILE_MACHINE_CEE = $C0EE; - {$EXTERNALSYM IMAGE_FILE_MACHINE_CEE} - -// -// Directory format. -// - -const - IMAGE_NUMBEROF_DIRECTORY_ENTRIES = 16; - {$EXTERNALSYM IMAGE_NUMBEROF_DIRECTORY_ENTRIES} - -// -// Optional header format. -// - -{$IFNDEF FPC} -type - PIMAGE_OPTIONAL_HEADER32 = ^IMAGE_OPTIONAL_HEADER32; - {$EXTERNALSYM PIMAGE_OPTIONAL_HEADER32} - - {$IF declared(_IMAGE_OPTIONAL_HEADER32)} // XE2+ - IMAGE_OPTIONAL_HEADER32 = _IMAGE_OPTIONAL_HEADER32; - {$ELSE} - IMAGE_OPTIONAL_HEADER32 = _IMAGE_OPTIONAL_HEADER; - {$IFEND} - {$EXTERNALSYM IMAGE_OPTIONAL_HEADER32} - TImageOptionalHeader32 = IMAGE_OPTIONAL_HEADER32; - PImageOptionalHeader32 = PIMAGE_OPTIONAL_HEADER32; - - PIMAGE_ROM_OPTIONAL_HEADER = ^IMAGE_ROM_OPTIONAL_HEADER; - {$EXTERNALSYM PIMAGE_ROM_OPTIONAL_HEADER} - _IMAGE_ROM_OPTIONAL_HEADER = record - Magic: Word; - MajorLinkerVersion: Byte; - MinorLinkerVersion: Byte; - SizeOfCode: DWORD; - SizeOfInitializedData: DWORD; - SizeOfUninitializedData: DWORD; - AddressOfEntryPoint: DWORD; - BaseOfCode: DWORD; - BaseOfData: DWORD; - BaseOfBss: DWORD; - GprMask: DWORD; - CprMask: array [0..3] of DWORD; - GpValue: DWORD; - end; - {$EXTERNALSYM _IMAGE_ROM_OPTIONAL_HEADER} - IMAGE_ROM_OPTIONAL_HEADER = _IMAGE_ROM_OPTIONAL_HEADER; - {$EXTERNALSYM IMAGE_ROM_OPTIONAL_HEADER} - TImageRomOptionalHeader = IMAGE_ROM_OPTIONAL_HEADER; - PImageRomOptionalHeader = PIMAGE_ROM_OPTIONAL_HEADER; - - PIMAGE_OPTIONAL_HEADER64 = ^IMAGE_OPTIONAL_HEADER64; - {$EXTERNALSYM PIMAGE_OPTIONAL_HEADER64} - _IMAGE_OPTIONAL_HEADER64 = record - Magic: Word; - MajorLinkerVersion: Byte; - MinorLinkerVersion: Byte; - SizeOfCode: DWORD; - SizeOfInitializedData: DWORD; - SizeOfUninitializedData: DWORD; - AddressOfEntryPoint: DWORD; - BaseOfCode: DWORD; - ImageBase: Int64; - SectionAlignment: DWORD; - FileAlignment: DWORD; - MajorOperatingSystemVersion: Word; - MinorOperatingSystemVersion: Word; - MajorImageVersion: Word; - MinorImageVersion: Word; - MajorSubsystemVersion: Word; - MinorSubsystemVersion: Word; - Win32VersionValue: DWORD; - SizeOfImage: DWORD; - SizeOfHeaders: DWORD; - CheckSum: DWORD; - Subsystem: Word; - DllCharacteristics: Word; - SizeOfStackReserve: Int64; - SizeOfStackCommit: Int64; - SizeOfHeapReserve: Int64; - SizeOfHeapCommit: Int64; - LoaderFlags: DWORD; - NumberOfRvaAndSizes: DWORD; - DataDirectory: array [0..IMAGE_NUMBEROF_DIRECTORY_ENTRIES - 1] of IMAGE_DATA_DIRECTORY; - end; - {$EXTERNALSYM _IMAGE_OPTIONAL_HEADER64} - IMAGE_OPTIONAL_HEADER64 = _IMAGE_OPTIONAL_HEADER64; - {$EXTERNALSYM IMAGE_OPTIONAL_HEADER64} - TImageOptionalHeader64 = IMAGE_OPTIONAL_HEADER64; - PImageOptionalHeader64 = PIMAGE_OPTIONAL_HEADER64; -{$ENDIF ~FPC} - -const - IMAGE_SIZEOF_ROM_OPTIONAL_HEADER = 56; - {$EXTERNALSYM IMAGE_SIZEOF_ROM_OPTIONAL_HEADER} - IMAGE_SIZEOF_STD_OPTIONAL_HEADER = 28; - {$EXTERNALSYM IMAGE_SIZEOF_STD_OPTIONAL_HEADER} - IMAGE_SIZEOF_NT_OPTIONAL32_HEADER = 224; - {$EXTERNALSYM IMAGE_SIZEOF_NT_OPTIONAL32_HEADER} - IMAGE_SIZEOF_NT_OPTIONAL64_HEADER = 240; - {$EXTERNALSYM IMAGE_SIZEOF_NT_OPTIONAL64_HEADER} - - IMAGE_NT_OPTIONAL_HDR32_MAGIC = $10b; - {$EXTERNALSYM IMAGE_NT_OPTIONAL_HDR32_MAGIC} - IMAGE_NT_OPTIONAL_HDR64_MAGIC = $20b; - {$EXTERNALSYM IMAGE_NT_OPTIONAL_HDR64_MAGIC} - IMAGE_ROM_OPTIONAL_HDR_MAGIC = $107; - {$EXTERNALSYM IMAGE_ROM_OPTIONAL_HDR_MAGIC} - -(* -type - IMAGE_OPTIONAL_HEADER = IMAGE_OPTIONAL_HEADER32; - {$EXTERNALSYM IMAGE_OPTIONAL_HEADER} - PIMAGE_OPTIONAL_HEADER = PIMAGE_OPTIONAL_HEADER32; - {$EXTERNALSYM PIMAGE_OPTIONAL_HEADER} -*) - -const - IMAGE_SIZEOF_NT_OPTIONAL_HEADER = IMAGE_SIZEOF_NT_OPTIONAL32_HEADER; - {$EXTERNALSYM IMAGE_SIZEOF_NT_OPTIONAL_HEADER} - IMAGE_NT_OPTIONAL_HDR_MAGIC = IMAGE_NT_OPTIONAL_HDR32_MAGIC; - {$EXTERNALSYM IMAGE_NT_OPTIONAL_HDR_MAGIC} - -{$IFNDEF FPC} -type - PIMAGE_NT_HEADERS64 = ^IMAGE_NT_HEADERS64; - {$EXTERNALSYM PIMAGE_NT_HEADERS64} - _IMAGE_NT_HEADERS64 = record - Signature: DWORD; - FileHeader: IMAGE_FILE_HEADER; - OptionalHeader: IMAGE_OPTIONAL_HEADER64; - end; - {$EXTERNALSYM _IMAGE_NT_HEADERS64} - IMAGE_NT_HEADERS64 = _IMAGE_NT_HEADERS64; - {$EXTERNALSYM IMAGE_NT_HEADERS64} - TImageNtHeaders64 = IMAGE_NT_HEADERS64; - PImageNtHeaders64 = PIMAGE_NT_HEADERS64; - - PIMAGE_NT_HEADERS32 = ^IMAGE_NT_HEADERS32; - {$EXTERNALSYM PIMAGE_NT_HEADERS32} - _IMAGE_NT_HEADERS = record - Signature: DWORD; - FileHeader: IMAGE_FILE_HEADER; - OptionalHeader: IMAGE_OPTIONAL_HEADER32; - end; - {$EXTERNALSYM _IMAGE_NT_HEADERS} - IMAGE_NT_HEADERS32 = _IMAGE_NT_HEADERS; - {$EXTERNALSYM IMAGE_NT_HEADERS32} - TImageNtHeaders32 = IMAGE_NT_HEADERS32; - PImageNtHeaders32 = PIMAGE_NT_HEADERS32; -{$ENDIF ~FPC} - -// Subsystem Values - -const - IMAGE_SUBSYSTEM_UNKNOWN = 0; // Unknown subsystem. - {$EXTERNALSYM IMAGE_SUBSYSTEM_UNKNOWN} - IMAGE_SUBSYSTEM_NATIVE = 1; // Image doesn't require a subsystem. - {$EXTERNALSYM IMAGE_SUBSYSTEM_NATIVE} - IMAGE_SUBSYSTEM_WINDOWS_GUI = 2; // Image runs in the Windows GUI subsystem. - {$EXTERNALSYM IMAGE_SUBSYSTEM_WINDOWS_GUI} - IMAGE_SUBSYSTEM_WINDOWS_CUI = 3; // Image runs in the Windows character subsystem. - {$EXTERNALSYM IMAGE_SUBSYSTEM_WINDOWS_CUI} - IMAGE_SUBSYSTEM_OS2_CUI = 5; // image runs in the OS/2 character subsystem. - {$EXTERNALSYM IMAGE_SUBSYSTEM_OS2_CUI} - IMAGE_SUBSYSTEM_POSIX_CUI = 7; // image runs in the Posix character subsystem. - {$EXTERNALSYM IMAGE_SUBSYSTEM_POSIX_CUI} - IMAGE_SUBSYSTEM_NATIVE_WINDOWS = 8; // image is a native Win9x driver. - {$EXTERNALSYM IMAGE_SUBSYSTEM_NATIVE_WINDOWS} - IMAGE_SUBSYSTEM_WINDOWS_CE_GUI = 9; // Image runs in the Windows CE subsystem. - {$EXTERNALSYM IMAGE_SUBSYSTEM_WINDOWS_CE_GUI} - IMAGE_SUBSYSTEM_EFI_APPLICATION = 10; - {$EXTERNALSYM IMAGE_SUBSYSTEM_EFI_APPLICATION} - IMAGE_SUBSYSTEM_EFI_BOOT_SERVICE_DRIVER = 11; - {$EXTERNALSYM IMAGE_SUBSYSTEM_EFI_BOOT_SERVICE_DRIVER} - IMAGE_SUBSYSTEM_EFI_RUNTIME_DRIVER = 12; - {$EXTERNALSYM IMAGE_SUBSYSTEM_EFI_RUNTIME_DRIVER} - IMAGE_SUBSYSTEM_EFI_ROM = 13; - {$EXTERNALSYM IMAGE_SUBSYSTEM_EFI_ROM} - IMAGE_SUBSYSTEM_XBOX = 14; - {$EXTERNALSYM IMAGE_SUBSYSTEM_XBOX} - -// DllCharacteristics Entries - -// IMAGE_LIBRARY_PROCESS_INIT 0x0001 // Reserved. -// IMAGE_LIBRARY_PROCESS_TERM 0x0002 // Reserved. -// IMAGE_LIBRARY_THREAD_INIT 0x0004 // Reserved. -// IMAGE_LIBRARY_THREAD_TERM 0x0008 // Reserved. - IMAGE_DLLCHARACTERISTICS_NO_ISOLATION = $0200; // Image understands isolation and doesn't want it - {$EXTERNALSYM IMAGE_DLLCHARACTERISTICS_NO_ISOLATION} - IMAGE_DLLCHARACTERISTICS_NO_SEH = $0400; // Image does not use SEH. No SE handler may reside in this image - {$EXTERNALSYM IMAGE_DLLCHARACTERISTICS_NO_SEH} - IMAGE_DLLCHARACTERISTICS_NO_BIND = $0800; // Do not bind this image. - {$EXTERNALSYM IMAGE_DLLCHARACTERISTICS_NO_BIND} - -// 0x1000 // Reserved. - - IMAGE_DLLCHARACTERISTICS_WDM_DRIVER = $2000; // Driver uses WDM model - {$EXTERNALSYM IMAGE_DLLCHARACTERISTICS_WDM_DRIVER} - -// 0x4000 // Reserved. - - IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE = $8000; - {$EXTERNALSYM IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE} - -// Directory Entries - - IMAGE_DIRECTORY_ENTRY_EXPORT = 0; // Export Directory - {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_EXPORT} - IMAGE_DIRECTORY_ENTRY_IMPORT = 1; // Import Directory - {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_IMPORT} - IMAGE_DIRECTORY_ENTRY_RESOURCE = 2; // Resource Directory - {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_RESOURCE} - IMAGE_DIRECTORY_ENTRY_EXCEPTION = 3; // Exception Directory - {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_EXCEPTION} - IMAGE_DIRECTORY_ENTRY_SECURITY = 4; // Security Directory - {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_SECURITY} - IMAGE_DIRECTORY_ENTRY_BASERELOC = 5; // Base Relocation Table - {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_BASERELOC} - IMAGE_DIRECTORY_ENTRY_DEBUG = 6; // Debug Directory - {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_DEBUG} - -// IMAGE_DIRECTORY_ENTRY_COPYRIGHT 7 // (X86 usage) - - IMAGE_DIRECTORY_ENTRY_ARCHITECTURE = 7; // Architecture Specific Data - {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_ARCHITECTURE} - IMAGE_DIRECTORY_ENTRY_GLOBALPTR = 8; // RVA of GP - {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_GLOBALPTR} - IMAGE_DIRECTORY_ENTRY_TLS = 9; // TLS Directory - {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_TLS} - IMAGE_DIRECTORY_ENTRY_LOAD_CONFIG = 10; // Load Configuration Directory - {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_LOAD_CONFIG} - IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT = 11; // Bound Import Directory in headers - {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT} - IMAGE_DIRECTORY_ENTRY_IAT = 12; // Import Address Table - {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_IAT} - IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT = 13; // Delay Load Import Descriptors - {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT} - IMAGE_DIRECTORY_ENTRY_COM_DESCRIPTOR = 14; // COM Runtime descriptor - {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_COM_DESCRIPTOR} - -// -// Non-COFF Object file header -// - -type - PAnonObjectHeader = ^ANON_OBJECT_HEADER; - ANON_OBJECT_HEADER = record - Sig1: Word; // Must be IMAGE_FILE_MACHINE_UNKNOWN - Sig2: Word; // Must be 0xffff - Version: Word; // >= 1 (implies the CLSID field is present) - Machine: Word; - TimeDateStamp: DWORD; - ClassID: TCLSID; // Used to invoke CoCreateInstance - SizeOfData: DWORD; // Size of data that follows the header - end; - {$EXTERNALSYM ANON_OBJECT_HEADER} - TAnonObjectHeader = ANON_OBJECT_HEADER; - -// -// Section header format. -// - -const - IMAGE_SIZEOF_SHORT_NAME = 8; - {$EXTERNALSYM IMAGE_SIZEOF_SHORT_NAME} - -type - PPImageSectionHeader = ^PImageSectionHeader; - -// IMAGE_FIRST_SECTION doesn't need 32/64 versions since the file header is the same either way. - -function IMAGE_FIRST_SECTION(NtHeader: PImageNtHeaders): PImageSectionHeader; -{$EXTERNALSYM IMAGE_FIRST_SECTION} - -const - IMAGE_SIZEOF_SECTION_HEADER = 40; - {$EXTERNALSYM IMAGE_SIZEOF_SECTION_HEADER} - -// -// Section characteristics. -// -// IMAGE_SCN_TYPE_REG 0x00000000 // Reserved. -// IMAGE_SCN_TYPE_DSECT 0x00000001 // Reserved. -// IMAGE_SCN_TYPE_NOLOAD 0x00000002 // Reserved. -// IMAGE_SCN_TYPE_GROUP 0x00000004 // Reserved. - - IMAGE_SCN_TYPE_NO_PAD = $00000008; // Reserved. - {$EXTERNALSYM IMAGE_SCN_TYPE_NO_PAD} - -// IMAGE_SCN_TYPE_COPY 0x00000010 // Reserved. - - IMAGE_SCN_CNT_CODE = $00000020; // Section contains code. - {$EXTERNALSYM IMAGE_SCN_CNT_CODE} - IMAGE_SCN_CNT_INITIALIZED_DATA = $00000040; // Section contains initialized data. - {$EXTERNALSYM IMAGE_SCN_CNT_INITIALIZED_DATA} - IMAGE_SCN_CNT_UNINITIALIZED_DATA = $00000080; // Section contains uninitialized data. - {$EXTERNALSYM IMAGE_SCN_CNT_UNINITIALIZED_DATA} - - IMAGE_SCN_LNK_OTHER = $00000100; // Reserved. - {$EXTERNALSYM IMAGE_SCN_LNK_OTHER} - IMAGE_SCN_LNK_INFO = $00000200; // Section contains comments or some other type of information. - {$EXTERNALSYM IMAGE_SCN_LNK_INFO} - -// IMAGE_SCN_TYPE_OVER 0x00000400 // Reserved. - - IMAGE_SCN_LNK_REMOVE = $00000800; // Section contents will not become part of image. - {$EXTERNALSYM IMAGE_SCN_LNK_REMOVE} - IMAGE_SCN_LNK_COMDAT = $00001000; // Section contents comdat. - {$EXTERNALSYM IMAGE_SCN_LNK_COMDAT} - -// 0x00002000 // Reserved. -// IMAGE_SCN_MEM_PROTECTED - Obsolete 0x00004000 - - IMAGE_SCN_NO_DEFER_SPEC_EXC = $00004000; // Reset speculative exceptions handling bits in the TLB entries for this section. - {$EXTERNALSYM IMAGE_SCN_NO_DEFER_SPEC_EXC} - IMAGE_SCN_GPREL = $00008000; // Section content can be accessed relative to GP - {$EXTERNALSYM IMAGE_SCN_GPREL} - IMAGE_SCN_MEM_FARDATA = $00008000; - {$EXTERNALSYM IMAGE_SCN_MEM_FARDATA} - -// IMAGE_SCN_MEM_SYSHEAP - Obsolete 0x00010000 - - IMAGE_SCN_MEM_PURGEABLE = $00020000; - {$EXTERNALSYM IMAGE_SCN_MEM_PURGEABLE} - IMAGE_SCN_MEM_16BIT = $00020000; - {$EXTERNALSYM IMAGE_SCN_MEM_16BIT} - IMAGE_SCN_MEM_LOCKED = $00040000; - {$EXTERNALSYM IMAGE_SCN_MEM_LOCKED} - IMAGE_SCN_MEM_PRELOAD = $00080000; - {$EXTERNALSYM IMAGE_SCN_MEM_PRELOAD} - - IMAGE_SCN_ALIGN_1BYTES = $00100000; - {$EXTERNALSYM IMAGE_SCN_ALIGN_1BYTES} - IMAGE_SCN_ALIGN_2BYTES = $00200000; - {$EXTERNALSYM IMAGE_SCN_ALIGN_2BYTES} - IMAGE_SCN_ALIGN_4BYTES = $00300000; - {$EXTERNALSYM IMAGE_SCN_ALIGN_4BYTES} - IMAGE_SCN_ALIGN_8BYTES = $00400000; - {$EXTERNALSYM IMAGE_SCN_ALIGN_8BYTES} - IMAGE_SCN_ALIGN_16BYTES = $00500000; // Default alignment if no others are specified. - {$EXTERNALSYM IMAGE_SCN_ALIGN_16BYTES} - IMAGE_SCN_ALIGN_32BYTES = $00600000; - {$EXTERNALSYM IMAGE_SCN_ALIGN_32BYTES} - IMAGE_SCN_ALIGN_64BYTES = $00700000; - {$EXTERNALSYM IMAGE_SCN_ALIGN_64BYTES} - IMAGE_SCN_ALIGN_128BYTES = $00800000; - {$EXTERNALSYM IMAGE_SCN_ALIGN_128BYTES} - IMAGE_SCN_ALIGN_256BYTES = $00900000; - {$EXTERNALSYM IMAGE_SCN_ALIGN_256BYTES} - IMAGE_SCN_ALIGN_512BYTES = $00A00000; - {$EXTERNALSYM IMAGE_SCN_ALIGN_512BYTES} - IMAGE_SCN_ALIGN_1024BYTES = $00B00000; - {$EXTERNALSYM IMAGE_SCN_ALIGN_1024BYTES} - IMAGE_SCN_ALIGN_2048BYTES = $00C00000; - {$EXTERNALSYM IMAGE_SCN_ALIGN_2048BYTES} - IMAGE_SCN_ALIGN_4096BYTES = $00D00000; - {$EXTERNALSYM IMAGE_SCN_ALIGN_4096BYTES} - IMAGE_SCN_ALIGN_8192BYTES = $00E00000; - {$EXTERNALSYM IMAGE_SCN_ALIGN_8192BYTES} - -// Unused 0x00F00000 - - IMAGE_SCN_ALIGN_MASK = $00F00000; - {$EXTERNALSYM IMAGE_SCN_ALIGN_MASK} - - IMAGE_SCN_LNK_NRELOC_OVFL = $01000000; // Section contains extended relocations. - {$EXTERNALSYM IMAGE_SCN_LNK_NRELOC_OVFL} - IMAGE_SCN_MEM_DISCARDABLE = $02000000; // Section can be discarded. - {$EXTERNALSYM IMAGE_SCN_MEM_DISCARDABLE} - IMAGE_SCN_MEM_NOT_CACHED = $04000000; // Section is not cacheable. - {$EXTERNALSYM IMAGE_SCN_MEM_NOT_CACHED} - IMAGE_SCN_MEM_NOT_PAGED = $08000000; // Section is not pageable. - {$EXTERNALSYM IMAGE_SCN_MEM_NOT_PAGED} - IMAGE_SCN_MEM_SHARED = $10000000; // Section is shareable. - {$EXTERNALSYM IMAGE_SCN_MEM_SHARED} - IMAGE_SCN_MEM_EXECUTE = $20000000; // Section is executable. - {$EXTERNALSYM IMAGE_SCN_MEM_EXECUTE} - IMAGE_SCN_MEM_READ = $40000000; // Section is readable. - {$EXTERNALSYM IMAGE_SCN_MEM_READ} - IMAGE_SCN_MEM_WRITE = DWORD($80000000); // Section is writeable. - {$EXTERNALSYM IMAGE_SCN_MEM_WRITE} - -// line 6232 - -// -// Line number format. -// - -type - TImgLineNoType = record - case Integer of - 0: (SymbolTableIndex: DWORD); // Symbol table index of function name if Linenumber is 0. - 1: (VirtualAddress: DWORD); // Virtual address of line number. - end; - - PIMAGE_LINENUMBER = ^IMAGE_LINENUMBER; - {$EXTERNALSYM PIMAGE_LINENUMBER} - _IMAGE_LINENUMBER = record - Type_: TImgLineNoType; - Linenumber: WORD; // Line number. - end; - {$EXTERNALSYM _IMAGE_LINENUMBER} - IMAGE_LINENUMBER = _IMAGE_LINENUMBER; - {$EXTERNALSYM IMAGE_LINENUMBER} - TImageLineNumber = IMAGE_LINENUMBER; - PImageLineNumber = PIMAGE_LINENUMBER; - -const - IMAGE_SIZEOF_LINENUMBER = 6; - {$EXTERNALSYM IMAGE_SIZEOF_LINENUMBER} - -// #include "poppack.h" // Back to 4 byte packing - -// -// Based relocation format. -// - -type - PIMAGE_BASE_RELOCATION = ^IMAGE_BASE_RELOCATION; - {$EXTERNALSYM PIMAGE_BASE_RELOCATION} - _IMAGE_BASE_RELOCATION = record - VirtualAddress: DWORD; - SizeOfBlock: DWORD; - // WORD TypeOffset[1]; - end; - {$EXTERNALSYM _IMAGE_BASE_RELOCATION} - IMAGE_BASE_RELOCATION = _IMAGE_BASE_RELOCATION; - {$EXTERNALSYM IMAGE_BASE_RELOCATION} - TImageBaseRelocation = IMAGE_BASE_RELOCATION; - PImageBaseRelocation = PIMAGE_BASE_RELOCATION; - -const - IMAGE_SIZEOF_BASE_RELOCATION = 8; - {$EXTERNALSYM IMAGE_SIZEOF_BASE_RELOCATION} - -// -// Based relocation types. -// - - IMAGE_REL_BASED_ABSOLUTE = 0; - {$EXTERNALSYM IMAGE_REL_BASED_ABSOLUTE} - IMAGE_REL_BASED_HIGH = 1; - {$EXTERNALSYM IMAGE_REL_BASED_HIGH} - IMAGE_REL_BASED_LOW = 2; - {$EXTERNALSYM IMAGE_REL_BASED_LOW} - IMAGE_REL_BASED_HIGHLOW = 3; - {$EXTERNALSYM IMAGE_REL_BASED_HIGHLOW} - IMAGE_REL_BASED_HIGHADJ = 4; - {$EXTERNALSYM IMAGE_REL_BASED_HIGHADJ} - IMAGE_REL_BASED_MIPS_JMPADDR = 5; - {$EXTERNALSYM IMAGE_REL_BASED_MIPS_JMPADDR} - - IMAGE_REL_BASED_MIPS_JMPADDR16 = 9; - {$EXTERNALSYM IMAGE_REL_BASED_MIPS_JMPADDR16} - IMAGE_REL_BASED_IA64_IMM64 = 9; - {$EXTERNALSYM IMAGE_REL_BASED_IA64_IMM64} - IMAGE_REL_BASED_DIR64 = 10; - {$EXTERNALSYM IMAGE_REL_BASED_DIR64} - -// -// Archive format. -// - - IMAGE_ARCHIVE_START_SIZE = 8; - {$EXTERNALSYM IMAGE_ARCHIVE_START_SIZE} - IMAGE_ARCHIVE_START = '!'#10; - {$EXTERNALSYM IMAGE_ARCHIVE_START} - IMAGE_ARCHIVE_END = '`'#10; - {$EXTERNALSYM IMAGE_ARCHIVE_END} - IMAGE_ARCHIVE_PAD = #10; - {$EXTERNALSYM IMAGE_ARCHIVE_PAD} - IMAGE_ARCHIVE_LINKER_MEMBER = '/ '; - {$EXTERNALSYM IMAGE_ARCHIVE_LINKER_MEMBER} - IMAGE_ARCHIVE_LONGNAMES_MEMBER = '// '; - {$EXTERNALSYM IMAGE_ARCHIVE_LONGNAMES_MEMBER} - -type - PIMAGE_ARCHIVE_MEMBER_HEADER = ^IMAGE_ARCHIVE_MEMBER_HEADER; - {$EXTERNALSYM PIMAGE_ARCHIVE_MEMBER_HEADER} - _IMAGE_ARCHIVE_MEMBER_HEADER = record - Name: array [0..15] of Byte; // File member name - `/' terminated. - Date: array [0..11] of Byte; // File member date - decimal. - UserID: array [0..5] of Byte; // File member user id - decimal. - GroupID: array [0..5] of Byte; // File member group id - decimal. - Mode: array [0..7] of Byte; // File member mode - octal. - Size: array [0..9] of Byte; // File member size - decimal. - EndHeader: array [0..1] of Byte; // String to end header. - end; - {$EXTERNALSYM _IMAGE_ARCHIVE_MEMBER_HEADER} - IMAGE_ARCHIVE_MEMBER_HEADER = _IMAGE_ARCHIVE_MEMBER_HEADER; - {$EXTERNALSYM IMAGE_ARCHIVE_MEMBER_HEADER} - TImageArchiveMemberHeader = IMAGE_ARCHIVE_MEMBER_HEADER; - PImageArchiveMemberHeader = PIMAGE_ARCHIVE_MEMBER_HEADER; - -const - IMAGE_SIZEOF_ARCHIVE_MEMBER_HDR = 60; - {$EXTERNALSYM IMAGE_SIZEOF_ARCHIVE_MEMBER_HDR} - -// line 6346 - -// -// DLL support. -// - -// -// Export Format -// - -type - PIMAGE_EXPORT_DIRECTORY = ^IMAGE_EXPORT_DIRECTORY; - {$EXTERNALSYM PIMAGE_EXPORT_DIRECTORY} - _IMAGE_EXPORT_DIRECTORY = record - Characteristics: DWORD; - TimeDateStamp: DWORD; - MajorVersion: Word; - MinorVersion: Word; - Name: DWORD; - Base: DWORD; - NumberOfFunctions: DWORD; - NumberOfNames: DWORD; - AddressOfFunctions: DWORD; // RVA from base of image - AddressOfNames: DWORD; // RVA from base of image - AddressOfNameOrdinals: DWORD; // RVA from base of image - end; - {$EXTERNALSYM _IMAGE_EXPORT_DIRECTORY} - IMAGE_EXPORT_DIRECTORY = _IMAGE_EXPORT_DIRECTORY; - {$EXTERNALSYM IMAGE_EXPORT_DIRECTORY} - TImageExportDirectory = IMAGE_EXPORT_DIRECTORY; - PImageExportDirectory = PIMAGE_EXPORT_DIRECTORY; - -// -// Import Format -// - - PIMAGE_IMPORT_BY_NAME = ^IMAGE_IMPORT_BY_NAME; - {$EXTERNALSYM PIMAGE_IMPORT_BY_NAME} - _IMAGE_IMPORT_BY_NAME = record - Hint: Word; - Name: array [0..0] of AnsiChar; - end; - {$EXTERNALSYM _IMAGE_IMPORT_BY_NAME} - IMAGE_IMPORT_BY_NAME = _IMAGE_IMPORT_BY_NAME; - {$EXTERNALSYM IMAGE_IMPORT_BY_NAME} - TImageImportByName = IMAGE_IMPORT_BY_NAME; - PImageImportByName = PIMAGE_IMPORT_BY_NAME; - -// #include "pshpack8.h" // Use align 8 for the 64-bit IAT. - - PIMAGE_THUNK_DATA64 = ^IMAGE_THUNK_DATA64; - {$EXTERNALSYM PIMAGE_THUNK_DATA64} - _IMAGE_THUNK_DATA64 = record - case Integer of - 0: (ForwarderString: ULONGLONG); // PBYTE - 1: (Function_: ULONGLONG); // PDWORD - 2: (Ordinal: ULONGLONG); - 3: (AddressOfData: ULONGLONG); // PIMAGE_IMPORT_BY_NAME - end; - {$EXTERNALSYM _IMAGE_THUNK_DATA64} - IMAGE_THUNK_DATA64 = _IMAGE_THUNK_DATA64; - {$EXTERNALSYM IMAGE_THUNK_DATA64} - TImageThunkData64 = IMAGE_THUNK_DATA64; - PImageThunkData64 = PIMAGE_THUNK_DATA64; - -// #include "poppack.h" // Back to 4 byte packing - - PIMAGE_THUNK_DATA32 = ^IMAGE_THUNK_DATA32; - {$EXTERNALSYM PIMAGE_THUNK_DATA32} - _IMAGE_THUNK_DATA32 = record - case Integer of - 0: (ForwarderString: DWORD); // PBYTE - 1: (Function_: DWORD); // PDWORD - 2: (Ordinal: DWORD); - 3: (AddressOfData: DWORD); // PIMAGE_IMPORT_BY_NAME - end; - {$EXTERNALSYM _IMAGE_THUNK_DATA32} - IMAGE_THUNK_DATA32 = _IMAGE_THUNK_DATA32; - {$EXTERNALSYM IMAGE_THUNK_DATA32} - TImageThunkData32 = IMAGE_THUNK_DATA32; - PImageThunkData32 = PIMAGE_THUNK_DATA32; - -const - IMAGE_ORDINAL_FLAG64 = ULONGLONG($8000000000000000); - {$EXTERNALSYM IMAGE_ORDINAL_FLAG64} - IMAGE_ORDINAL_FLAG32 = DWORD($80000000); - {$EXTERNALSYM IMAGE_ORDINAL_FLAG32} - -function IMAGE_ORDINAL64(Ordinal: ULONGLONG): ULONGLONG; -{$EXTERNALSYM IMAGE_ORDINAL64} -function IMAGE_ORDINAL32(Ordinal: DWORD): DWORD; -{$EXTERNALSYM IMAGE_ORDINAL32} -function IMAGE_SNAP_BY_ORDINAL64(Ordinal: ULONGLONG): Boolean; -{$EXTERNALSYM IMAGE_SNAP_BY_ORDINAL64} -function IMAGE_SNAP_BY_ORDINAL32(Ordinal: DWORD): Boolean; -{$EXTERNALSYM IMAGE_SNAP_BY_ORDINAL32} - -// -// Thread Local Storage -// - -type - PIMAGE_TLS_CALLBACK = procedure (DllHandle: Pointer; Reason: DWORD; Reserved: Pointer); stdcall; - {$EXTERNALSYM PIMAGE_TLS_CALLBACK} - TImageTlsCallback = PIMAGE_TLS_CALLBACK; - - PIMAGE_TLS_DIRECTORY64 = ^IMAGE_TLS_DIRECTORY64; - {$EXTERNALSYM PIMAGE_TLS_DIRECTORY64} - _IMAGE_TLS_DIRECTORY64 = record - StartAddressOfRawData: ULONGLONG; - EndAddressOfRawData: ULONGLONG; - AddressOfIndex: ULONGLONG; // PDWORD - AddressOfCallBacks: ULONGLONG; // PIMAGE_TLS_CALLBACK *; - SizeOfZeroFill: DWORD; - Characteristics: DWORD; - end; - {$EXTERNALSYM _IMAGE_TLS_DIRECTORY64} - IMAGE_TLS_DIRECTORY64 = _IMAGE_TLS_DIRECTORY64; - {$EXTERNALSYM IMAGE_TLS_DIRECTORY64} - TImageTlsDirectory64 = IMAGE_TLS_DIRECTORY64; - {$EXTERNALSYM TImageTlsDirectory64} - PImageTlsDirectory64 = PIMAGE_TLS_DIRECTORY64; - {$EXTERNALSYM PImageTlsDirectory64} - - PIMAGE_TLS_DIRECTORY32 = ^IMAGE_TLS_DIRECTORY32; - {$EXTERNALSYM PIMAGE_TLS_DIRECTORY32} - _IMAGE_TLS_DIRECTORY32 = record - StartAddressOfRawData: DWORD; - EndAddressOfRawData: DWORD; - AddressOfIndex: DWORD; // PDWORD - AddressOfCallBacks: DWORD; // PIMAGE_TLS_CALLBACK * - SizeOfZeroFill: DWORD; - Characteristics: DWORD; - end; - {$EXTERNALSYM _IMAGE_TLS_DIRECTORY32} - IMAGE_TLS_DIRECTORY32 = _IMAGE_TLS_DIRECTORY32; - {$EXTERNALSYM IMAGE_TLS_DIRECTORY32} - TImageTlsDirectory32 = IMAGE_TLS_DIRECTORY32; - {$EXTERNALSYM TImageTlsDirectory32} - PImageTlsDirectory32 = PIMAGE_TLS_DIRECTORY32; - {$EXTERNALSYM PImageTlsDirectory32} - -const - IMAGE_ORDINAL_FLAG = IMAGE_ORDINAL_FLAG32; - {$EXTERNALSYM IMAGE_ORDINAL_FLAG} - -function IMAGE_ORDINAL(Ordinal: DWORD): DWORD; -{$EXTERNALSYM IMAGE_ORDINAL} - -type - IMAGE_THUNK_DATA = IMAGE_THUNK_DATA32; - {$EXTERNALSYM IMAGE_THUNK_DATA} - PIMAGE_THUNK_DATA = PIMAGE_THUNK_DATA32; - {$EXTERNALSYM PIMAGE_THUNK_DATA} - TImageThunkData = TImageThunkData32; - PImageThunkData = PImageThunkData32; - -function IMAGE_SNAP_BY_ORDINAL(Ordinal: DWORD): Boolean; -{$EXTERNALSYM IMAGE_SNAP_BY_ORDINAL} - -type - IMAGE_TLS_DIRECTORY = IMAGE_TLS_DIRECTORY32; - {$EXTERNALSYM IMAGE_TLS_DIRECTORY} - PIMAGE_TLS_DIRECTORY = PIMAGE_TLS_DIRECTORY32; - {$EXTERNALSYM PIMAGE_TLS_DIRECTORY} - TImageTlsDirectory = TImageTlsDirectory32; - {$EXTERNALSYM TImageTlsDirectory} - PImageTlsDirectory = PImageTlsDirectory32; - {$EXTERNALSYM PImageTlsDirectory} - - TIIDUnion = record - case Integer of - 0: (Characteristics: DWORD); // 0 for terminating null import descriptor - 1: (OriginalFirstThunk: DWORD); // RVA to original unbound IAT (PIMAGE_THUNK_DATA) - end; - - PIMAGE_IMPORT_DESCRIPTOR = ^IMAGE_IMPORT_DESCRIPTOR; - {$EXTERNALSYM PIMAGE_IMPORT_DESCRIPTOR} - _IMAGE_IMPORT_DESCRIPTOR = record - Union: TIIDUnion; - TimeDateStamp: DWORD; // 0 if not bound, - // -1 if bound, and real date\time stamp - // in IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT (new BIND) - // O.W. date/time stamp of DLL bound to (Old BIND) - - ForwarderChain: DWORD; // -1 if no forwarders - Name: DWORD; - FirstThunk: DWORD; // RVA to IAT (if bound this IAT has actual addresses) - end; - {$EXTERNALSYM _IMAGE_IMPORT_DESCRIPTOR} - IMAGE_IMPORT_DESCRIPTOR = _IMAGE_IMPORT_DESCRIPTOR; - {$EXTERNALSYM IMAGE_IMPORT_DESCRIPTOR} - TImageImportDescriptor = IMAGE_IMPORT_DESCRIPTOR; - PImageImportDescriptor = PIMAGE_IMPORT_DESCRIPTOR; - -// -// New format import descriptors pointed to by DataDirectory[ IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT ] -// - -type - PIMAGE_BOUND_IMPORT_DESCRIPTOR = ^IMAGE_BOUND_IMPORT_DESCRIPTOR; - {$EXTERNALSYM PIMAGE_BOUND_IMPORT_DESCRIPTOR} - _IMAGE_BOUND_IMPORT_DESCRIPTOR = record - TimeDateStamp: DWORD; - OffsetModuleName: Word; - NumberOfModuleForwarderRefs: Word; - // Array of zero or more IMAGE_BOUND_FORWARDER_REF follows - end; - {$EXTERNALSYM _IMAGE_BOUND_IMPORT_DESCRIPTOR} - IMAGE_BOUND_IMPORT_DESCRIPTOR = _IMAGE_BOUND_IMPORT_DESCRIPTOR; - {$EXTERNALSYM IMAGE_BOUND_IMPORT_DESCRIPTOR} - TImageBoundImportDescriptor = IMAGE_BOUND_IMPORT_DESCRIPTOR; - PImageBoundImportDescriptor = PIMAGE_BOUND_IMPORT_DESCRIPTOR; - - PIMAGE_BOUND_FORWARDER_REF = ^IMAGE_BOUND_FORWARDER_REF; - {$EXTERNALSYM PIMAGE_BOUND_FORWARDER_REF} - _IMAGE_BOUND_FORWARDER_REF = record - TimeDateStamp: DWORD; - OffsetModuleName: Word; - Reserved: Word; - end; - {$EXTERNALSYM _IMAGE_BOUND_FORWARDER_REF} - IMAGE_BOUND_FORWARDER_REF = _IMAGE_BOUND_FORWARDER_REF; - {$EXTERNALSYM IMAGE_BOUND_FORWARDER_REF} - TImageBoundForwarderRef = IMAGE_BOUND_FORWARDER_REF; - PImageBoundForwarderRef = PIMAGE_BOUND_FORWARDER_REF; - -// -// Resource Format. -// - -// -// Resource directory consists of two counts, following by a variable length -// array of directory entries. The first count is the number of entries at -// beginning of the array that have actual names associated with each entry. -// The entries are in ascending order, case insensitive strings. The second -// count is the number of entries that immediately follow the named entries. -// This second count identifies the number of entries that have 16-bit integer -// Ids as their name. These entries are also sorted in ascending order. -// -// This structure allows fast lookup by either name or number, but for any -// given resource entry only one form of lookup is supported, not both. -// This is consistant with the syntax of the .RC file and the .RES file. -// - - PIMAGE_RESOURCE_DIRECTORY = ^IMAGE_RESOURCE_DIRECTORY; - {$EXTERNALSYM PIMAGE_RESOURCE_DIRECTORY} - _IMAGE_RESOURCE_DIRECTORY = record - Characteristics: DWORD; - TimeDateStamp: DWORD; - MajorVersion: Word; - MinorVersion: Word; - NumberOfNamedEntries: Word; - NumberOfIdEntries: Word; - // IMAGE_RESOURCE_DIRECTORY_ENTRY DirectoryEntries[]; - end; - {$EXTERNALSYM _IMAGE_RESOURCE_DIRECTORY} - IMAGE_RESOURCE_DIRECTORY = _IMAGE_RESOURCE_DIRECTORY; - {$EXTERNALSYM IMAGE_RESOURCE_DIRECTORY} - TImageResourceDirectory = IMAGE_RESOURCE_DIRECTORY; - PImageResourceDirectory = PIMAGE_RESOURCE_DIRECTORY; - -const - IMAGE_RESOURCE_NAME_IS_STRING = DWORD($80000000); - {$EXTERNALSYM IMAGE_RESOURCE_NAME_IS_STRING} - IMAGE_RESOURCE_DATA_IS_DIRECTORY = DWORD($80000000); - {$EXTERNALSYM IMAGE_RESOURCE_DATA_IS_DIRECTORY} - -// -// Each directory contains the 32-bit Name of the entry and an offset, -// relative to the beginning of the resource directory of the data associated -// with this directory entry. If the name of the entry is an actual text -// string instead of an integer Id, then the high order bit of the name field -// is set to one and the low order 31-bits are an offset, relative to the -// beginning of the resource directory of the string, which is of type -// IMAGE_RESOURCE_DIRECTORY_STRING. Otherwise the high bit is clear and the -// low-order 16-bits are the integer Id that identify this resource directory -// entry. If the directory entry is yet another resource directory (i.e. a -// subdirectory), then the high order bit of the offset field will be -// set to indicate this. Otherwise the high bit is clear and the offset -// field points to a resource data entry. -// - -type - PIMAGE_RESOURCE_DIRECTORY_ENTRY = ^IMAGE_RESOURCE_DIRECTORY_ENTRY; - {$EXTERNALSYM PIMAGE_RESOURCE_DIRECTORY_ENTRY} - _IMAGE_RESOURCE_DIRECTORY_ENTRY = record - case Integer of - 0: ( - // DWORD NameOffset:31; - // DWORD NameIsString:1; - NameOffset: DWORD; - OffsetToData: DWORD - ); - 1: ( - Name: DWORD; - // DWORD OffsetToDirectory:31; - // DWORD DataIsDirectory:1; - OffsetToDirectory: DWORD; - ); - 2: ( - Id: WORD; - ); - end; - {$EXTERNALSYM _IMAGE_RESOURCE_DIRECTORY_ENTRY} - IMAGE_RESOURCE_DIRECTORY_ENTRY = _IMAGE_RESOURCE_DIRECTORY_ENTRY; - {$EXTERNALSYM IMAGE_RESOURCE_DIRECTORY_ENTRY} - TImageResourceDirectoryEntry = IMAGE_RESOURCE_DIRECTORY_ENTRY; - PImageResourceDirectoryEntry = PIMAGE_RESOURCE_DIRECTORY_ENTRY; - -// -// For resource directory entries that have actual string names, the Name -// field of the directory entry points to an object of the following type. -// All of these string objects are stored together after the last resource -// directory entry and before the first resource data object. This minimizes -// the impact of these variable length objects on the alignment of the fixed -// size directory entry objects. -// - -type - PIMAGE_RESOURCE_DIRECTORY_STRING = ^IMAGE_RESOURCE_DIRECTORY_STRING; - {$EXTERNALSYM PIMAGE_RESOURCE_DIRECTORY_STRING} - _IMAGE_RESOURCE_DIRECTORY_STRING = record - Length: Word; - NameString: array [0..0] of AnsiCHAR; - end; - {$EXTERNALSYM _IMAGE_RESOURCE_DIRECTORY_STRING} - IMAGE_RESOURCE_DIRECTORY_STRING = _IMAGE_RESOURCE_DIRECTORY_STRING; - {$EXTERNALSYM IMAGE_RESOURCE_DIRECTORY_STRING} - TImageResourceDirectoryString = IMAGE_RESOURCE_DIRECTORY_STRING; - PImageResourceDirectoryString = PIMAGE_RESOURCE_DIRECTORY_STRING; - - PIMAGE_RESOURCE_DIR_STRING_U = ^IMAGE_RESOURCE_DIR_STRING_U; - {$EXTERNALSYM PIMAGE_RESOURCE_DIR_STRING_U} - _IMAGE_RESOURCE_DIR_STRING_U = record - Length: Word; - NameString: array [0..0] of WCHAR; - end; - {$EXTERNALSYM _IMAGE_RESOURCE_DIR_STRING_U} - IMAGE_RESOURCE_DIR_STRING_U = _IMAGE_RESOURCE_DIR_STRING_U; - {$EXTERNALSYM IMAGE_RESOURCE_DIR_STRING_U} - TImageResourceDirStringU = IMAGE_RESOURCE_DIR_STRING_U; - PImageResourceDirStringU = PIMAGE_RESOURCE_DIR_STRING_U; - -// -// Each resource data entry describes a leaf node in the resource directory -// tree. It contains an offset, relative to the beginning of the resource -// directory of the data for the resource, a size field that gives the number -// of bytes of data at that offset, a CodePage that should be used when -// decoding code point values within the resource data. Typically for new -// applications the code page would be the unicode code page. -// - - PIMAGE_RESOURCE_DATA_ENTRY = ^IMAGE_RESOURCE_DATA_ENTRY; - {$EXTERNALSYM PIMAGE_RESOURCE_DATA_ENTRY} - _IMAGE_RESOURCE_DATA_ENTRY = record - OffsetToData: DWORD; - Size: DWORD; - CodePage: DWORD; - Reserved: DWORD; - end; - {$EXTERNALSYM _IMAGE_RESOURCE_DATA_ENTRY} - IMAGE_RESOURCE_DATA_ENTRY = _IMAGE_RESOURCE_DATA_ENTRY; - {$EXTERNALSYM IMAGE_RESOURCE_DATA_ENTRY} - TImageResourceDataEntry = IMAGE_RESOURCE_DATA_ENTRY; - PImageResourceDataEntry = PIMAGE_RESOURCE_DATA_ENTRY; - -// -// Load Configuration Directory Entry -// - -{$IFNDEF FPC} -type - PIMAGE_LOAD_CONFIG_DIRECTORY32 = ^IMAGE_LOAD_CONFIG_DIRECTORY32; - {$EXTERNALSYM PIMAGE_LOAD_CONFIG_DIRECTORY32} - IMAGE_LOAD_CONFIG_DIRECTORY32 = record - Size: DWORD; - TimeDateStamp: DWORD; - MajorVersion: WORD; - MinorVersion: WORD; - GlobalFlagsClear: DWORD; - GlobalFlagsSet: DWORD; - CriticalSectionDefaultTimeout: DWORD; - DeCommitFreeBlockThreshold: DWORD; - DeCommitTotalFreeThreshold: DWORD; - LockPrefixTable: DWORD; // VA - MaximumAllocationSize: DWORD; - VirtualMemoryThreshold: DWORD; - ProcessHeapFlags: DWORD; - ProcessAffinityMask: DWORD; - CSDVersion: WORD; - Reserved1: WORD; - EditList: DWORD; // VA - SecurityCookie: DWORD; // VA - SEHandlerTable: DWORD; // VA - SEHandlerCount: DWORD; - end; - {$EXTERNALSYM IMAGE_LOAD_CONFIG_DIRECTORY32} - TImageLoadConfigDirectory32 = IMAGE_LOAD_CONFIG_DIRECTORY32; - PImageLoadConfigDirectory32 = PIMAGE_LOAD_CONFIG_DIRECTORY32; - - PIMAGE_LOAD_CONFIG_DIRECTORY64 = ^IMAGE_LOAD_CONFIG_DIRECTORY64; - {$EXTERNALSYM PIMAGE_LOAD_CONFIG_DIRECTORY64} - IMAGE_LOAD_CONFIG_DIRECTORY64 = record - Size: DWORD; - TimeDateStamp: DWORD; - MajorVersion: WORD; - MinorVersion: WORD; - GlobalFlagsClear: DWORD; - GlobalFlagsSet: DWORD; - CriticalSectionDefaultTimeout: DWORD; - DeCommitFreeBlockThreshold: ULONGLONG; - DeCommitTotalFreeThreshold: ULONGLONG; - LockPrefixTable: ULONGLONG; // VA - MaximumAllocationSize: ULONGLONG; - VirtualMemoryThreshold: ULONGLONG; - ProcessAffinityMask: ULONGLONG; - ProcessHeapFlags: DWORD; - CSDVersion: WORD; - Reserved1: WORD; - EditList: ULONGLONG; // VA - SecurityCookie: ULONGLONG; // VA - SEHandlerTable: ULONGLONG; // VA - SEHandlerCount: ULONGLONG; - end; - {$EXTERNALSYM IMAGE_LOAD_CONFIG_DIRECTORY64} - TImageLoadConfigDirectory64 = IMAGE_LOAD_CONFIG_DIRECTORY64; - PImageLoadConfigDirectory64 = PIMAGE_LOAD_CONFIG_DIRECTORY64; - - IMAGE_LOAD_CONFIG_DIRECTORY = IMAGE_LOAD_CONFIG_DIRECTORY32; - {$EXTERNALSYM IMAGE_LOAD_CONFIG_DIRECTORY} - PIMAGE_LOAD_CONFIG_DIRECTORY = PIMAGE_LOAD_CONFIG_DIRECTORY32; - {$EXTERNALSYM PIMAGE_LOAD_CONFIG_DIRECTORY} - TImageLoadConfigDirectory = TImageLoadConfigDirectory32; - PImageLoadConfigDirectory = PImageLoadConfigDirectory32; -{$ENDIF ~FPC} - -// line 6802 - -// -// Debug Format -// -(* -type - PIMAGE_DEBUG_DIRECTORY = ^IMAGE_DEBUG_DIRECTORY; - {$EXTERNALSYM PIMAGE_DEBUG_DIRECTORY} - _IMAGE_DEBUG_DIRECTORY = record - Characteristics: DWORD; - TimeDateStamp: DWORD; - MajorVersion: Word; - MinorVersion: Word; - Type_: DWORD; - SizeOfData: DWORD; - AddressOfRawData: DWORD; - PointerToRawData: DWORD; - end; - {$EXTERNALSYM _IMAGE_DEBUG_DIRECTORY} - IMAGE_DEBUG_DIRECTORY = _IMAGE_DEBUG_DIRECTORY; - {$EXTERNALSYM IMAGE_DEBUG_DIRECTORY} - TImageDebugDirectory = IMAGE_DEBUG_DIRECTORY; - PImageDebugDirectory = PIMAGE_DEBUG_DIRECTORY; - -const - IMAGE_DEBUG_TYPE_UNKNOWN = 0; - {$EXTERNALSYM IMAGE_DEBUG_TYPE_UNKNOWN} - IMAGE_DEBUG_TYPE_COFF = 1; - {$EXTERNALSYM IMAGE_DEBUG_TYPE_COFF} - IMAGE_DEBUG_TYPE_CODEVIEW = 2; - {$EXTERNALSYM IMAGE_DEBUG_TYPE_CODEVIEW} - IMAGE_DEBUG_TYPE_FPO = 3; - {$EXTERNALSYM IMAGE_DEBUG_TYPE_FPO} - IMAGE_DEBUG_TYPE_MISC = 4; - {$EXTERNALSYM IMAGE_DEBUG_TYPE_MISC} - IMAGE_DEBUG_TYPE_EXCEPTION = 5; - {$EXTERNALSYM IMAGE_DEBUG_TYPE_EXCEPTION} - IMAGE_DEBUG_TYPE_FIXUP = 6; - {$EXTERNALSYM IMAGE_DEBUG_TYPE_FIXUP} - IMAGE_DEBUG_TYPE_OMAP_TO_SRC = 7; - {$EXTERNALSYM IMAGE_DEBUG_TYPE_OMAP_TO_SRC} - IMAGE_DEBUG_TYPE_OMAP_FROM_SRC = 8; - {$EXTERNALSYM IMAGE_DEBUG_TYPE_OMAP_FROM_SRC} - IMAGE_DEBUG_TYPE_BORLAND = 9; - {$EXTERNALSYM IMAGE_DEBUG_TYPE_BORLAND} - IMAGE_DEBUG_TYPE_RESERVED10 = 10; - {$EXTERNALSYM IMAGE_DEBUG_TYPE_RESERVED10} - IMAGE_DEBUG_TYPE_CLSID = 11; - {$EXTERNALSYM IMAGE_DEBUG_TYPE_CLSID} -*) - -{$IFNDEF FPC} -type - PIMAGE_COFF_SYMBOLS_HEADER = ^IMAGE_COFF_SYMBOLS_HEADER; - {$EXTERNALSYM PIMAGE_COFF_SYMBOLS_HEADER} - _IMAGE_COFF_SYMBOLS_HEADER = record - NumberOfSymbols: DWORD; - LvaToFirstSymbol: DWORD; - NumberOfLinenumbers: DWORD; - LvaToFirstLinenumber: DWORD; - RvaToFirstByteOfCode: DWORD; - RvaToLastByteOfCode: DWORD; - RvaToFirstByteOfData: DWORD; - RvaToLastByteOfData: DWORD; - end; - {$EXTERNALSYM _IMAGE_COFF_SYMBOLS_HEADER} - IMAGE_COFF_SYMBOLS_HEADER = _IMAGE_COFF_SYMBOLS_HEADER; - {$EXTERNALSYM IMAGE_COFF_SYMBOLS_HEADER} - TImageCoffSymbolsHeader = IMAGE_COFF_SYMBOLS_HEADER; - PImageCoffSymbolsHeader = PIMAGE_COFF_SYMBOLS_HEADER; -{$ENDIF ~FPC} - -const - FRAME_FPO = 0; - {$EXTERNALSYM FRAME_FPO} - FRAME_TRAP = 1; - {$EXTERNALSYM FRAME_TRAP} - FRAME_TSS = 2; - {$EXTERNALSYM FRAME_TSS} - FRAME_NONFPO = 3; - {$EXTERNALSYM FRAME_NONFPO} - - FPOFLAGS_PROLOG = $00FF; // # bytes in prolog - FPOFLAGS_REGS = $0700; // # regs saved - FPOFLAGS_HAS_SEH = $0800; // TRUE if SEH in func - FPOFLAGS_USE_BP = $1000; // TRUE if EBP has been allocated - FPOFLAGS_RESERVED = $2000; // reserved for future use - FPOFLAGS_FRAME = $C000; // frame type - -{$IFNDEF FPC} -type - PFPO_DATA = ^FPO_DATA; - {$EXTERNALSYM PFPO_DATA} - _FPO_DATA = record - ulOffStart: DWORD; // offset 1st byte of function code - cbProcSize: DWORD; // # bytes in function - cdwLocals: DWORD; // # bytes in locals/4 - cdwParams: WORD; // # bytes in params/4 - Flags: WORD; - end; - {$EXTERNALSYM _FPO_DATA} - FPO_DATA = _FPO_DATA; - {$EXTERNALSYM FPO_DATA} - TFpoData = FPO_DATA; - PFpoData = PFPO_DATA; -{$ENDIF ~FPC} - -const - SIZEOF_RFPO_DATA = 16; - {$EXTERNALSYM SIZEOF_RFPO_DATA} - - IMAGE_DEBUG_MISC_EXENAME = 1; - {$EXTERNALSYM IMAGE_DEBUG_MISC_EXENAME} - -type - PIMAGE_DEBUG_MISC = ^IMAGE_DEBUG_MISC; - {$EXTERNALSYM PIMAGE_DEBUG_MISC} - _IMAGE_DEBUG_MISC = record - DataType: DWORD; // type of misc data, see defines - Length: DWORD; // total length of record, rounded to four byte multiple. - Unicode: ByteBool; // TRUE if data is unicode string - Reserved: array [0..2] of Byte; - Data: array [0..0] of Byte; // Actual data - end; - {$EXTERNALSYM _IMAGE_DEBUG_MISC} - IMAGE_DEBUG_MISC = _IMAGE_DEBUG_MISC; - {$EXTERNALSYM IMAGE_DEBUG_MISC} - TImageDebugMisc = IMAGE_DEBUG_MISC; - PImageDebugMisc = PIMAGE_DEBUG_MISC; - -// -// Function table extracted from MIPS/ALPHA/IA64 images. Does not contain -// information needed only for runtime support. Just those fields for -// each entry needed by a debugger. -// - -{$IFNDEF FPC} - PIMAGE_FUNCTION_ENTRY = ^IMAGE_FUNCTION_ENTRY; - {$EXTERNALSYM PIMAGE_FUNCTION_ENTRY} - _IMAGE_FUNCTION_ENTRY = record - StartingAddress: DWORD; - EndingAddress: DWORD; - EndOfPrologue: DWORD; - end; - {$EXTERNALSYM _IMAGE_FUNCTION_ENTRY} - IMAGE_FUNCTION_ENTRY = _IMAGE_FUNCTION_ENTRY; - {$EXTERNALSYM IMAGE_FUNCTION_ENTRY} - TImageFunctionEntry = IMAGE_FUNCTION_ENTRY; - PImageFunctionEntry = PIMAGE_FUNCTION_ENTRY; - - PIMAGE_FUNCTION_ENTRY64 = ^IMAGE_FUNCTION_ENTRY64; - {$EXTERNALSYM PIMAGE_FUNCTION_ENTRY64} - _IMAGE_FUNCTION_ENTRY64 = record - StartingAddress: ULONGLONG; - EndingAddress: ULONGLONG; - case Integer of - 0: (EndOfPrologue: ULONGLONG); - 1: (UnwindInfoAddress: ULONGLONG); - end; - {$EXTERNALSYM _IMAGE_FUNCTION_ENTRY64} - IMAGE_FUNCTION_ENTRY64 = _IMAGE_FUNCTION_ENTRY64; - {$EXTERNALSYM IMAGE_FUNCTION_ENTRY64} - TImageFunctionEntry64 = IMAGE_FUNCTION_ENTRY64; - PImageFunctionEntry64 = PIMAGE_FUNCTION_ENTRY64; - -{$ENDIF ~FPC} - -// -// Debugging information can be stripped from an image file and placed -// in a separate .DBG file, whose file name part is the same as the -// image file name part (e.g. symbols for CMD.EXE could be stripped -// and placed in CMD.DBG). This is indicated by the IMAGE_FILE_DEBUG_STRIPPED -// flag in the Characteristics field of the file header. The beginning of -// the .DBG file contains the following structure which captures certain -// information from the image file. This allows a debug to proceed even if -// the original image file is not accessable. This header is followed by -// zero of more IMAGE_SECTION_HEADER structures, followed by zero or more -// IMAGE_DEBUG_DIRECTORY structures. The latter structures and those in -// the image file contain file offsets relative to the beginning of the -// .DBG file. -// -// If symbols have been stripped from an image, the IMAGE_DEBUG_MISC structure -// is left in the image file, but not mapped. This allows a debugger to -// compute the name of the .DBG file, from the name of the image in the -// IMAGE_DEBUG_MISC structure. -// - - PIMAGE_SEPARATE_DEBUG_HEADER = ^IMAGE_SEPARATE_DEBUG_HEADER; - {$EXTERNALSYM PIMAGE_SEPARATE_DEBUG_HEADER} - _IMAGE_SEPARATE_DEBUG_HEADER = record - Signature: Word; - Flags: Word; - Machine: Word; - Characteristics: Word; - TimeDateStamp: DWORD; - CheckSum: DWORD; - ImageBase: DWORD; - SizeOfImage: DWORD; - NumberOfSections: DWORD; - ExportedNamesSize: DWORD; - DebugDirectorySize: DWORD; - SectionAlignment: DWORD; - Reserved: array [0..1] of DWORD; - end; - {$EXTERNALSYM _IMAGE_SEPARATE_DEBUG_HEADER} - IMAGE_SEPARATE_DEBUG_HEADER = _IMAGE_SEPARATE_DEBUG_HEADER; - {$EXTERNALSYM IMAGE_SEPARATE_DEBUG_HEADER} - TImageSeparateDebugHeader = IMAGE_SEPARATE_DEBUG_HEADER; - PImageSeparateDebugHeader = PIMAGE_SEPARATE_DEBUG_HEADER; - - _NON_PAGED_DEBUG_INFO = record - Signature: WORD; - Flags: WORD; - Size: DWORD; - Machine: WORD; - Characteristics: WORD; - TimeDateStamp: DWORD; - CheckSum: DWORD; - SizeOfImage: DWORD; - ImageBase: ULONGLONG; - //DebugDirectorySize - //IMAGE_DEBUG_DIRECTORY - end; - {$EXTERNALSYM _NON_PAGED_DEBUG_INFO} - NON_PAGED_DEBUG_INFO = _NON_PAGED_DEBUG_INFO; - {$EXTERNALSYM NON_PAGED_DEBUG_INFO} - PNON_PAGED_DEBUG_INFO = ^NON_PAGED_DEBUG_INFO; - {$EXTERNALSYM PNON_PAGED_DEBUG_INFO} - -const - IMAGE_SEPARATE_DEBUG_SIGNATURE = $4944; - {$EXTERNALSYM IMAGE_SEPARATE_DEBUG_SIGNATURE} - NON_PAGED_DEBUG_SIGNATURE = $494E; - {$EXTERNALSYM NON_PAGED_DEBUG_SIGNATURE} - - IMAGE_SEPARATE_DEBUG_FLAGS_MASK = $8000; - {$EXTERNALSYM IMAGE_SEPARATE_DEBUG_FLAGS_MASK} - IMAGE_SEPARATE_DEBUG_MISMATCH = $8000; // when DBG was updated, the old checksum didn't match. - {$EXTERNALSYM IMAGE_SEPARATE_DEBUG_MISMATCH} - -// -// The .arch section is made up of headers, each describing an amask position/value -// pointing to an array of IMAGE_ARCHITECTURE_ENTRY's. Each "array" (both the header -// and entry arrays) are terminiated by a quadword of 0xffffffffL. -// -// NOTE: There may be quadwords of 0 sprinkled around and must be skipped. -// - -const - IAHMASK_VALUE = $00000001; // 1 -> code section depends on mask bit - // 0 -> new instruction depends on mask bit - IAHMASK_MBZ7 = $000000FE; // MBZ - IAHMASK_SHIFT = $0000FF00; // Amask bit in question for this fixup - IAHMASK_MBZ16 = DWORD($FFFF0000); // MBZ - -type - PIMAGE_ARCHITECTURE_HEADER = ^IMAGE_ARCHITECTURE_HEADER; - {$EXTERNALSYM PIMAGE_ARCHITECTURE_HEADER} - _ImageArchitectureHeader = record - Mask: DWORD; - FirstEntryRVA: DWORD; // RVA into .arch section to array of ARCHITECTURE_ENTRY's - end; - {$EXTERNALSYM _ImageArchitectureHeader} - IMAGE_ARCHITECTURE_HEADER = _ImageArchitectureHeader; - {$EXTERNALSYM IMAGE_ARCHITECTURE_HEADER} - TImageArchitectureHeader = IMAGE_ARCHITECTURE_HEADER; - PImageArchitectureHeader = PIMAGE_ARCHITECTURE_HEADER; - - PIMAGE_ARCHITECTURE_ENTRY = ^IMAGE_ARCHITECTURE_ENTRY; - {$EXTERNALSYM PIMAGE_ARCHITECTURE_ENTRY} - _ImageArchitectureEntry = record - FixupInstRVA: DWORD; // RVA of instruction to fixup - NewInst: DWORD; // fixup instruction (see alphaops.h) - end; - {$EXTERNALSYM _ImageArchitectureEntry} - IMAGE_ARCHITECTURE_ENTRY = _ImageArchitectureEntry; - {$EXTERNALSYM IMAGE_ARCHITECTURE_ENTRY} - TImageArchitectureEntry = IMAGE_ARCHITECTURE_ENTRY; - PImageArchitectureEntry = PIMAGE_ARCHITECTURE_ENTRY; - -// #include "poppack.h" // Back to the initial value - -// The following structure defines the new import object. Note the values of the first two fields, -// which must be set as stated in order to differentiate old and new import members. -// Following this structure, the linker emits two null-terminated strings used to recreate the -// import at the time of use. The first string is the import's name, the second is the dll's name. - -const - IMPORT_OBJECT_HDR_SIG2 = $ffff; - {$EXTERNALSYM IMPORT_OBJECT_HDR_SIG2} - -const - IOHFLAGS_TYPE = $0003; // IMPORT_TYPE - IAHFLAGS_NAMETYPE = $001C; // IMPORT_NAME_TYPE - IAHFLAGS_RESERVED = $FFE0; // Reserved. Must be zero. - -type - PImportObjectHeader = ^IMPORT_OBJECT_HEADER; - IMPORT_OBJECT_HEADER = record - Sig1: WORD; // Must be IMAGE_FILE_MACHINE_UNKNOWN - Sig2: WORD; // Must be IMPORT_OBJECT_HDR_SIG2. - Version: WORD; - Machine: WORD; - TimeDateStamp: DWORD; // Time/date stamp - SizeOfData: DWORD; // particularly useful for incremental links - OrdinalOrHint: record - case Integer of - 0: (Ordinal: WORD); // if grf & IMPORT_OBJECT_ORDINAL - 1: (Flags: DWORD); - end; - Flags: WORD; - //WORD Type : 2; // IMPORT_TYPE - //WORD NameType : 3; // IMPORT_NAME_TYPE - //WORD Reserved : 11; // Reserved. Must be zero. - end; - {$EXTERNALSYM IMPORT_OBJECT_HEADER} - TImportObjectHeader = IMPORT_OBJECT_HEADER; - - IMPORT_OBJECT_TYPE = (IMPORT_OBJECT_CODE, IMPORT_OBJECT_DATA, IMPORT_OBJECT_CONST); - {$EXTERNALSYM IMPORT_OBJECT_TYPE} - TImportObjectType = IMPORT_OBJECT_TYPE; - - IMPORT_OBJECT_NAME_TYPE = ( - IMPORT_OBJECT_ORDINAL, // Import by ordinal - IMPORT_OBJECT_NAME, // Import name == public symbol name. - IMPORT_OBJECT_NAME_NO_PREFIX, // Import name == public symbol name skipping leading ?, @, or optionally _. - IMPORT_OBJECT_NAME_UNDECORATE); // Import name == public symbol name skipping leading ?, @, or optionally _ - // and truncating at first @ - {$EXTERNALSYM IMPORT_OBJECT_NAME_TYPE} - TImportObjectNameType = IMPORT_OBJECT_NAME_TYPE; - - ReplacesCorHdrNumericDefines = DWORD; - {$EXTERNALSYM ReplacesCorHdrNumericDefines} - -const - -// COM+ Header entry point flags. - - COMIMAGE_FLAGS_ILONLY = $00000001; - {$EXTERNALSYM COMIMAGE_FLAGS_ILONLY} - COMIMAGE_FLAGS_32BITREQUIRED = $00000002; - {$EXTERNALSYM COMIMAGE_FLAGS_32BITREQUIRED} - COMIMAGE_FLAGS_IL_LIBRARY = $00000004; - {$EXTERNALSYM COMIMAGE_FLAGS_IL_LIBRARY} - COMIMAGE_FLAGS_STRONGNAMESIGNED = $00000008; - {$EXTERNALSYM COMIMAGE_FLAGS_STRONGNAMESIGNED} - COMIMAGE_FLAGS_TRACKDEBUGDATA = $00010000; - {$EXTERNALSYM COMIMAGE_FLAGS_TRACKDEBUGDATA} - -// Version flags for image. - - COR_VERSION_MAJOR_V2 = 2; - {$EXTERNALSYM COR_VERSION_MAJOR_V2} - COR_VERSION_MAJOR = COR_VERSION_MAJOR_V2; - {$EXTERNALSYM COR_VERSION_MAJOR} - COR_VERSION_MINOR = 0; - {$EXTERNALSYM COR_VERSION_MINOR} - COR_DELETED_NAME_LENGTH = 8; - {$EXTERNALSYM COR_DELETED_NAME_LENGTH} - COR_VTABLEGAP_NAME_LENGTH = 8; - {$EXTERNALSYM COR_VTABLEGAP_NAME_LENGTH} - -// Maximum size of a NativeType descriptor. - - NATIVE_TYPE_MAX_CB = 1; - {$EXTERNALSYM NATIVE_TYPE_MAX_CB} - COR_ILMETHOD_SECT_SMALL_MAX_DATASIZE= $FF; - {$EXTERNALSYM COR_ILMETHOD_SECT_SMALL_MAX_DATASIZE} - -// #defines for the MIH FLAGS - - IMAGE_COR_MIH_METHODRVA = $01; - {$EXTERNALSYM IMAGE_COR_MIH_METHODRVA} - IMAGE_COR_MIH_EHRVA = $02; - {$EXTERNALSYM IMAGE_COR_MIH_EHRVA} - IMAGE_COR_MIH_BASICBLOCK = $08; - {$EXTERNALSYM IMAGE_COR_MIH_BASICBLOCK} - -// V-table constants - - COR_VTABLE_32BIT = $01; // V-table slots are 32-bits in size. - {$EXTERNALSYM COR_VTABLE_32BIT} - COR_VTABLE_64BIT = $02; // V-table slots are 64-bits in size. - {$EXTERNALSYM COR_VTABLE_64BIT} - COR_VTABLE_FROM_UNMANAGED = $04; // If set, transition from unmanaged. - {$EXTERNALSYM COR_VTABLE_FROM_UNMANAGED} - COR_VTABLE_CALL_MOST_DERIVED = $10; // Call most derived method described by - {$EXTERNALSYM COR_VTABLE_CALL_MOST_DERIVED} - -// EATJ constants - - IMAGE_COR_EATJ_THUNK_SIZE = 32; // Size of a jump thunk reserved range. - {$EXTERNALSYM IMAGE_COR_EATJ_THUNK_SIZE} - -// Max name lengths -// Change to unlimited name lengths. - - MAX_CLASS_NAME = 1024; - {$EXTERNALSYM MAX_CLASS_NAME} - MAX_PACKAGE_NAME = 1024; - {$EXTERNALSYM MAX_PACKAGE_NAME} - -// COM+ 2.0 header structure. - -type - IMAGE_COR20_HEADER = record - - // Header versioning - - cb: DWORD; - MajorRuntimeVersion: WORD; - MinorRuntimeVersion: WORD; - - // Symbol table and startup information - - MetaData: IMAGE_DATA_DIRECTORY; - Flags: DWORD; - EntryPointToken: DWORD; - - // Binding information - - Resources: IMAGE_DATA_DIRECTORY; - StrongNameSignature: IMAGE_DATA_DIRECTORY; - - // Regular fixup and binding information - - CodeManagerTable: IMAGE_DATA_DIRECTORY; - VTableFixups: IMAGE_DATA_DIRECTORY; - ExportAddressTableJumps: IMAGE_DATA_DIRECTORY; - - // Precompiled image info (internal use only - set to zero) - - ManagedNativeHeader: IMAGE_DATA_DIRECTORY; - end; - PIMAGE_COR20_HEADER = ^IMAGE_COR20_HEADER; - TImageCor20Header = IMAGE_COR20_HEADER; - PImageCor20Header = PIMAGE_COR20_HEADER; - -// line 7351 - -const - COMPRESSION_FORMAT_NONE = ($0000); - {$EXTERNALSYM COMPRESSION_FORMAT_NONE} - COMPRESSION_FORMAT_DEFAULT = ($0001); - {$EXTERNALSYM COMPRESSION_FORMAT_DEFAULT} - COMPRESSION_FORMAT_LZNT1 = ($0002); - {$EXTERNALSYM COMPRESSION_FORMAT_LZNT1} - COMPRESSION_ENGINE_STANDARD = ($0000); - {$EXTERNALSYM COMPRESSION_ENGINE_STANDARD} - COMPRESSION_ENGINE_MAXIMUM = ($0100); - {$EXTERNALSYM COMPRESSION_ENGINE_MAXIMUM} - COMPRESSION_ENGINE_HIBER = ($0200); - {$EXTERNALSYM COMPRESSION_ENGINE_HIBER} - -// line 7462 - -type - POSVERSIONINFOEXA = ^OSVERSIONINFOEXA; - {$EXTERNALSYM POSVERSIONINFOEXA} - _OSVERSIONINFOEXA = record - dwOSVersionInfoSize: DWORD; - dwMajorVersion: DWORD; - dwMinorVersion: DWORD; - dwBuildNumber: DWORD; - dwPlatformId: DWORD; - szCSDVersion: array [0..127] of ANSICHAR; // Maintenance string for PSS usage - wServicePackMajor: WORD; - wServicePackMinor: WORD; - wSuiteMask: WORD; - wProductType: BYTE; - wReserved: BYTE; - end; - {$EXTERNALSYM _OSVERSIONINFOEXA} - OSVERSIONINFOEXA = _OSVERSIONINFOEXA; - {$EXTERNALSYM OSVERSIONINFOEXA} - LPOSVERSIONINFOEXA = ^OSVERSIONINFOEXA; - {$EXTERNALSYM LPOSVERSIONINFOEXA} - TOSVersionInfoExA = _OSVERSIONINFOEXA; - - POSVERSIONINFOEXW = ^OSVERSIONINFOEXW; - {$EXTERNALSYM POSVERSIONINFOEXW} - _OSVERSIONINFOEXW = record - dwOSVersionInfoSize: DWORD; - dwMajorVersion: DWORD; - dwMinorVersion: DWORD; - dwBuildNumber: DWORD; - dwPlatformId: DWORD; - szCSDVersion: array [0..127] of WCHAR; // Maintenance string for PSS usage - wServicePackMajor: WORD; - wServicePackMinor: WORD; - wSuiteMask: WORD; - wProductType: BYTE; - wReserved: BYTE; - end; - {$EXTERNALSYM _OSVERSIONINFOEXW} - OSVERSIONINFOEXW = _OSVERSIONINFOEXW; - {$EXTERNALSYM OSVERSIONINFOEXW} - LPOSVERSIONINFOEXW = ^OSVERSIONINFOEXW; - {$EXTERNALSYM LPOSVERSIONINFOEXW} - RTL_OSVERSIONINFOEXW = _OSVERSIONINFOEXW; - {$EXTERNALSYM RTL_OSVERSIONINFOEXW} - PRTL_OSVERSIONINFOEXW = ^RTL_OSVERSIONINFOEXW; - {$EXTERNALSYM PRTL_OSVERSIONINFOEXW} - TOSVersionInfoExW = _OSVERSIONINFOEXW; - -{$IFDEF SUPPORTS_UNICODE} - - OSVERSIONINFOEX = OSVERSIONINFOEXW; - {$EXTERNALSYM OSVERSIONINFOEX} - POSVERSIONINFOEX = POSVERSIONINFOEXW; - {$EXTERNALSYM POSVERSIONINFOEX} - LPOSVERSIONINFOEX = LPOSVERSIONINFOEXW; - {$EXTERNALSYM LPOSVERSIONINFOEX} - TOSVersionInfoEx = TOSVersionInfoExW; - -{$ELSE ~SUPPORTS_UNICODE} - - OSVERSIONINFOEX = OSVERSIONINFOEXA; - {$EXTERNALSYM OSVERSIONINFOEX} - POSVERSIONINFOEX = POSVERSIONINFOEXA; - {$EXTERNALSYM POSVERSIONINFOEX} - LPOSVERSIONINFOEX = LPOSVERSIONINFOEXA; - {$EXTERNALSYM LPOSVERSIONINFOEX} - TOSVersionInfoEx = TOSVersionInfoExA; - -{$ENDIF ~SUPPORTS_UNICODE} - -// -// RtlVerifyVersionInfo() conditions -// - -const - VER_EQUAL = 1; - {$EXTERNALSYM VER_EQUAL} - VER_GREATER = 2; - {$EXTERNALSYM VER_GREATER} - VER_GREATER_EQUAL = 3; - {$EXTERNALSYM VER_GREATER_EQUAL} - VER_LESS = 4; - {$EXTERNALSYM VER_LESS} - VER_LESS_EQUAL = 5; - {$EXTERNALSYM VER_LESS_EQUAL} - VER_AND = 6; - {$EXTERNALSYM VER_AND} - VER_OR = 7; - {$EXTERNALSYM VER_OR} - - VER_CONDITION_MASK = 7; - {$EXTERNALSYM VER_CONDITION_MASK} - VER_NUM_BITS_PER_CONDITION_MASK = 3; - {$EXTERNALSYM VER_NUM_BITS_PER_CONDITION_MASK} - -// -// RtlVerifyVersionInfo() type mask bits -// - - VER_MINORVERSION = $0000001; - {$EXTERNALSYM VER_MINORVERSION} - VER_MAJORVERSION = $0000002; - {$EXTERNALSYM VER_MAJORVERSION} - VER_BUILDNUMBER = $0000004; - {$EXTERNALSYM VER_BUILDNUMBER} - VER_PLATFORMID = $0000008; - {$EXTERNALSYM VER_PLATFORMID} - VER_SERVICEPACKMINOR = $0000010; - {$EXTERNALSYM VER_SERVICEPACKMINOR} - VER_SERVICEPACKMAJOR = $0000020; - {$EXTERNALSYM VER_SERVICEPACKMAJOR} - VER_SUITENAME = $0000040; - {$EXTERNALSYM VER_SUITENAME} - VER_PRODUCT_TYPE = $0000080; - {$EXTERNALSYM VER_PRODUCT_TYPE} - -// -// RtlVerifyVersionInfo() os product type values -// - - VER_NT_WORKSTATION = $0000001; - {$EXTERNALSYM VER_NT_WORKSTATION} - VER_NT_DOMAIN_CONTROLLER = $0000002; - {$EXTERNALSYM VER_NT_DOMAIN_CONTROLLER} - VER_NT_SERVER = $0000003; - {$EXTERNALSYM VER_NT_SERVER} - -// -// dwPlatformId defines: -// - - VER_PLATFORM_WIN32s = 0; - {$EXTERNALSYM VER_PLATFORM_WIN32s} - VER_PLATFORM_WIN32_WINDOWS = 1; - {$EXTERNALSYM VER_PLATFORM_WIN32_WINDOWS} - VER_PLATFORM_WIN32_NT = 2; - {$EXTERNALSYM VER_PLATFORM_WIN32_NT} - -const -// -// -// Predefined Value Types. -// - - REG_NONE = ( 0 ); // No value type - {$EXTERNALSYM REG_NONE} - REG_SZ = ( 1 ); // Unicode nul terminated string - {$EXTERNALSYM REG_SZ} - REG_EXPAND_SZ = ( 2 ); // Unicode nul terminated string - {$EXTERNALSYM REG_EXPAND_SZ} - // (with environment variable references) - REG_BINARY = ( 3 ); // Free form binary - {$EXTERNALSYM REG_BINARY} - REG_DWORD = ( 4 ); // 32-bit number - {$EXTERNALSYM REG_DWORD} - REG_DWORD_LITTLE_ENDIAN = ( 4 ); // 32-bit number (same as REG_DWORD) - {$EXTERNALSYM REG_DWORD_LITTLE_ENDIAN} - REG_DWORD_BIG_ENDIAN = ( 5 ); // 32-bit number - {$EXTERNALSYM REG_DWORD_BIG_ENDIAN} - REG_LINK = ( 6 ); // Symbolic Link (unicode) - {$EXTERNALSYM REG_LINK} - REG_MULTI_SZ = ( 7 ); // Multiple Unicode strings - {$EXTERNALSYM REG_MULTI_SZ} - REG_RESOURCE_LIST = ( 8 ); // Resource list in the resource map - {$EXTERNALSYM REG_RESOURCE_LIST} - REG_FULL_RESOURCE_DESCRIPTOR = ( 9 ); // Resource list in the hardware description - {$EXTERNALSYM REG_FULL_RESOURCE_DESCRIPTOR} - REG_RESOURCE_REQUIREMENTS_LIST = ( 10 ); - {$EXTERNALSYM REG_RESOURCE_REQUIREMENTS_LIST} - REG_QWORD = ( 11 ); // 64-bit number - {$EXTERNALSYM REG_QWORD} - REG_QWORD_LITTLE_ENDIAN = ( 11 ); // 64-bit number (same as REG_QWORD) - {$EXTERNALSYM REG_QWORD_LITTLE_ENDIAN} - - // Windows 7 debugging types - -type - _CONTEXT_CHUNK = packed record - Offset: Integer; - Length: DWORD; - end; - {$EXTERNALSYM _CONTEXT_CHUNK} - CONTEXT_CHUNK = _CONTEXT_CHUNK; - {$EXTERNALSYM CONTEXT_CHUNK} - PCONTEXT_CHUNK = ^_CONTEXT_CHUNK; - {$EXTERNALSYM PCONTEXT_CHUNK} - -type - _CONTEXT_EX = packed record - // - // The total length of the structure starting from the chunk with - // the smallest offset. N.B. that the offset may be negative. - // - All: CONTEXT_CHUNK; - - // - // Wrapper for the traditional CONTEXT structure. N.B. the size of - // the chunk may be less than sizeof(CONTEXT) is some cases (when - // CONTEXT_EXTENDED_REGISTERS is not set on x86 for instance). - // - - Legacy: CONTEXT_CHUNK; - - // - // CONTEXT_XSTATE: Extended processor state chunk. The state is - // stored in the same format XSAVE operation strores it with - // exception of the first 512 bytes, i.e. staring from - // XSAVE_AREA_HEADER. The lower two bits corresponding FP and - // SSE state must be zero. - // - - XState: CONTEXT_CHUNK; - end; - {$EXTERNALSYM _CONTEXT_EX} - CONTEXT_EX = _CONTEXT_EX; - {$EXTERNALSYM CONTEXT_EX} - PCONTEXT_EX = ^_CONTEXT_EX; - {$EXTERNALSYM PCONTEXT_EX} - -// -// Known extended CPU state feature IDs -// - -const - XSTATE_LEGACY_FLOATING_POINT = 0; - {$EXTERNALSYM XSTATE_LEGACY_FLOATING_POINT} - XSTATE_LEGACY_SSE = 1; - {$EXTERNALSYM XSTATE_LEGACY_SSE} - XSTATE_GSSE = 2; - {$EXTERNALSYM XSTATE_GSSE} - - XSTATE_MASK_LEGACY_FLOATING_POINT = Int64(1) shl XSTATE_LEGACY_FLOATING_POINT; - {$EXTERNALSYM XSTATE_MASK_LEGACY_FLOATING_POINT} - XSTATE_MASK_LEGACY_SSE = Int64(1) shl XSTATE_LEGACY_SSE; - {$EXTERNALSYM XSTATE_MASK_LEGACY_SSE} - XSTATE_MASK_LEGACY = XSTATE_MASK_LEGACY_FLOATING_POINT or XSTATE_MASK_LEGACY_SSE; - {$EXTERNALSYM XSTATE_MASK_LEGACY} - XSTATE_MASK_GSSE = Int64(1) shl XSTATE_GSSE; - {$EXTERNALSYM XSTATE_MASK_GSSE} - - MAXIMUM_XSTATE_FEATURES = 64; - {$EXTERNALSYM MAXIMUM_XSTATE_FEATURES} - -// -// The following flags control the contents of the CONTEXT structure. -// -const - CONTEXT_i386 = $00010000; // this assumes that i386 and - {$EXTERNALSYM CONTEXT_i386} - CONTEXT_i486 = $00010000; // i486 have identical context records - {$EXTERNALSYM CONTEXT_i486} - - CONTEXT_CONTROL = CONTEXT_i386 or $00000001; // SS:SP, CS:IP, FLAGS, BP - {$EXTERNALSYM CONTEXT_CONTROL} - CONTEXT_INTEGER = CONTEXT_i386 or $00000002; // AX, BX, CX, DX, SI, DI - {$EXTERNALSYM CONTEXT_INTEGER} - CONTEXT_SEGMENTS = CONTEXT_i386 or $00000004; // DS, ES, FS, GS - {$EXTERNALSYM CONTEXT_SEGMENTS} - CONTEXT_FLOATING_POINT = CONTEXT_i386 or $00000008; // 387 state - {$EXTERNALSYM CONTEXT_FLOATING_POINT} - CONTEXT_DEBUG_REGISTERS = CONTEXT_i386 or $00000010; // DB 0-3,6,7 - {$EXTERNALSYM CONTEXT_DEBUG_REGISTERS} - CONTEXT_EXTENDED_REGISTERS = CONTEXT_i386 or $00000020; // cpu specific extensions - {$EXTERNALSYM CONTEXT_EXTENDED_REGISTERS} - - CONTEXT_FULL = CONTEXT_CONTROL or CONTEXT_INTEGER or CONTEXT_SEGMENTS; - {$EXTERNALSYM CONTEXT_FULL} - - CONTEXT_ALL = CONTEXT_CONTROL or CONTEXT_INTEGER or CONTEXT_SEGMENTS or CONTEXT_FLOATING_POINT or - CONTEXT_DEBUG_REGISTERS or CONTEXT_EXTENDED_REGISTERS; - {$EXTERNALSYM CONTEXT_ALL} - - CONTEXT_XSTATE = CONTEXT_i386 or $00000040; - {$EXTERNALSYM CONTEXT_XSTATE} - -// line 160 - -// -// File creation flags must start at the high end since they -// are combined with the attributes -// - -const - FILE_FLAG_WRITE_THROUGH = DWORD($80000000); - {$EXTERNALSYM FILE_FLAG_WRITE_THROUGH} - FILE_FLAG_OVERLAPPED = $40000000; - {$EXTERNALSYM FILE_FLAG_OVERLAPPED} - FILE_FLAG_NO_BUFFERING = $20000000; - {$EXTERNALSYM FILE_FLAG_NO_BUFFERING} - FILE_FLAG_RANDOM_ACCESS = $10000000; - {$EXTERNALSYM FILE_FLAG_RANDOM_ACCESS} - FILE_FLAG_SEQUENTIAL_SCAN = $08000000; - {$EXTERNALSYM FILE_FLAG_SEQUENTIAL_SCAN} - FILE_FLAG_DELETE_ON_CLOSE = $04000000; - {$EXTERNALSYM FILE_FLAG_DELETE_ON_CLOSE} - FILE_FLAG_BACKUP_SEMANTICS = $02000000; - {$EXTERNALSYM FILE_FLAG_BACKUP_SEMANTICS} - FILE_FLAG_POSIX_SEMANTICS = $01000000; - {$EXTERNALSYM FILE_FLAG_POSIX_SEMANTICS} - FILE_FLAG_OPEN_REPARSE_POINT = $00200000; - {$EXTERNALSYM FILE_FLAG_OPEN_REPARSE_POINT} - FILE_FLAG_OPEN_NO_RECALL = $00100000; - {$EXTERNALSYM FILE_FLAG_OPEN_NO_RECALL} - FILE_FLAG_FIRST_PIPE_INSTANCE = $00080000; - {$EXTERNALSYM FILE_FLAG_FIRST_PIPE_INSTANCE} - -// line 2727 -type - _MEMORYSTATUSEX = packed record - dwLength: DWORD; - dwMemoryLoad: DWORD; - ullTotalPhys: Int64; - ullAvailPhys: Int64; - ullTotalPageFile: Int64; - ullAvailPageFile: Int64; - ullTotalVirtual: Int64; - ullAvailVirtual: Int64; - ullAvailExtendedVirtual: Int64; - end; - {$EXTERNALSYM _MEMORYSTATUSEX} - - MEMORYSTATUSEX = _MEMORYSTATUSEX; - {$EXTERNALSYM MEMORYSTATUSEX} - LPMEMORYSTATUSEX = ^_MEMORYSTATUSEX; - {$EXTERNALSYM LPMEMORYSTATUSEX} - - TMemoryStatusEx = _MEMORYSTATUSEX; - -function GlobalMemoryStatusEx(out lpBuffer: TMemoryStatusEx): BOOL; stdcall; - -// line 3189 - - -function BackupSeek(hFile: THandle; dwLowBytesToSeek, dwHighBytesToSeek: DWORD; - out lpdwLowByteSeeked, lpdwHighByteSeeked: DWORD; - var lpContext: Pointer): BOOL; stdcall; -{$EXTERNALSYM BackupSeek} - -// line 5454 - -function AdjustTokenPrivileges(TokenHandle: THandle; DisableAllPrivileges: BOOL; - const NewState: TTokenPrivileges; BufferLength: DWORD; - PreviousState: PTokenPrivileges; - ReturnLength: PDWORD - ): BOOL; stdcall; -{$EXTERNALSYM AdjustTokenPrivileges} - -{ -From: Ray Lischner -Subject: CreateMutex bug -Date: 1999/12/10 -Message-ID: #1/1 -Content-Transfer-Encoding: 7bit -Organization: Tempest Software, Inc., Corvallis, Oregon -Content-Type: text/plain; charset=us-ascii -Mime-Version: 1.0 -Newsgroups: borland.public.delphi.winapi - - -Windows NT 4 has a bug in CreateMutex. The second argument is documented -to be a BOOL, but in truth, the CreateMutex interprets 1 as True and all -other values as False. (Do I detect an "if (bInitialOwner == TRUE)" in -the implementation of CreateMutex?) - -The problem is that Delphi declares CreateMutex according to the -documentation, so bInitialOwner is declared as LongBool. Delphi maps -True values to $FFFFFFFF, which should work, but doesn't in this case. - -My workaround is to declare CreateMutex with a LongInt as the second -argument, and pass the value 1 for True. - -I have not had this problem on Windows 98. --- -Ray Lischner, author of Delphi in a Nutshell (coming later this year) -http://www.bardware.com and http://www.tempest-sw.com -} -function CreateMutex(lpMutexAttributes: PSecurityAttributes; bInitialOwner: BOOL; lpName: PChar): THandle; stdcall; -{$EXTERNALSYM CreateMutex} - -// alternative conversion for WinNT 4.0 SP6 and later (OSVersionInfoEx instead of OSVersionInfo) -{$EXTERNALSYM GetVersionEx} -function GetVersionEx(var lpVersionInformation: TOSVersionInfoEx): BOOL; stdcall; overload; -{$EXTERNALSYM GetVersionEx} -function GetVersionEx(lpVersionInformation: POSVERSIONINFOEX): BOOL; stdcall; overload; - {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} - -// line 3585 - -function SetWaitableTimer(hTimer: THandle; var lpDueTime: TLargeInteger; - lPeriod: Longint; pfnCompletionRoutine: TFNTimerAPCRoutine; - lpArgToCompletionRoutine: Pointer; fResume: BOOL): BOOL; stdcall; - {$EXTERNALSYM SetWaitableTimer} - -// WinBase.h line 8839 - -function SetFileSecurityA(lpFileName: LPCSTR; SecurityInformation: SECURITY_INFORMATION; - pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; stdcall; -{$EXTERNALSYM SetFileSecurityA} -function SetFileSecurityW(lpFileName: LPCWSTR; SecurityInformation: SECURITY_INFORMATION; - pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; stdcall; -{$EXTERNALSYM SetFileSecurityW} -function SetFileSecurity(lpFileName: LPCTSTR; SecurityInformation: SECURITY_INFORMATION; - pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; stdcall; -{$EXTERNALSYM SetFileSecurity} - -function GetFileSecurityA(lpFileName: LPCSTR; RequestedInformation: SECURITY_INFORMATION; - pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; - var lpnLengthNeeded: DWORD): BOOL; stdcall; -{$EXTERNALSYM GetFileSecurityA} -function GetFileSecurityW(lpFileName: LPCWSTR; RequestedInformation: SECURITY_INFORMATION; - pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; - var lpnLengthNeeded: DWORD): BOOL; stdcall; -{$EXTERNALSYM GetFileSecurityW} -function GetFileSecurity(lpFileName: LPCTSTR; RequestedInformation: SECURITY_INFORMATION; - pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; - var lpnLengthNeeded: DWORD): BOOL; stdcall; -{$EXTERNALSYM GetFileSecurity} - -// WinBase.h line 10251 - -function SetVolumeMountPointW(lpszVolumeMountPoint, lpszVolumeName: LPCWSTR): BOOL; stdcall; -{$EXTERNALSYM SetVolumeMountPointW} - -function DeleteVolumeMountPointW(lpszVolumeMountPoint: LPCWSTR): BOOL; stdcall; -{$EXTERNALSYM DeleteVolumeMountPointW} - -function GetVolumeNameForVolumeMountPointW(lpszVolumeMountPoint: LPCWSTR; - lpszVolumeName: LPWSTR; cchBufferLength: DWORD): BOOL; stdcall; -{$EXTERNALSYM GetVolumeNameForVolumeMountPointW} - -// new Windows 7 debugging API -function CopyExtendedContext(Destination: PCONTEXT_EX; ContextFlags: DWORD; Source: PCONTEXT_EX): BOOL; stdcall; -{$EXTERNALSYM CopyExtendedContext} - -function InitializeExtendedContext(Context: Pointer; ContextFlags: DWORD; out ContextEx: PCONTEXT_EX): BOOL; stdcall; -{$EXTERNALSYM InitializeExtendedContext} - -function GetEnabledExtendedFeatures(const FeatureMask: Int64): Int64; stdcall; -{$EXTERNALSYM GetEnabledExtendedFeatures} - -function GetExtendedContextLength(ContextFlags: DWORD; ContextLength: PDWORD): BOOL; stdcall; -{$EXTERNALSYM GetExtendedContextLength} - -function GetExtendedFeaturesMask(ContextEx: PCONTEXT_EX): Int64; stdcall; -{$EXTERNALSYM GetExtendedFeaturesMask} - -function LocateExtendedFeature(ContextEx: PCONTEXT_EX; FeatureId: DWORD; Length: PDWORD): Pointer; stdcall; -{$EXTERNALSYM LocateExtendedFeature} - -function LocateLegacyContext(ContextEx: PCONTEXT_EX; Length: PDWORD): PCONTEXT; stdcall; -{$EXTERNALSYM LocateLegacyContext} - -procedure SetExtendedFeaturesMask(ContextEx: PCONTEXT_EX; const FeatureMask: Int64); stdcall; -{$EXTERNALSYM SetExtendedFeaturesMask} - -function ProcessIdToSessionId(dwProcessId: DWORD; out dwSessionId: DWORD): BOOL; stdcall; -{$EXTERNALSYM ProcessIdToSessionId} - - -// From JwaAclApi - -// line 185 - -function SetNamedSecurityInfoW(pObjectName: LPWSTR; ObjectType: SE_OBJECT_TYPE; - SecurityInfo: SECURITY_INFORMATION; psidOwner, psidGroup: PSID; - pDacl, pSacl: PACL): DWORD; stdcall; -{$EXTERNALSYM SetNamedSecurityInfoW} -const - IMAGE_SEPARATION = (64*1024); - {$EXTERNALSYM IMAGE_SEPARATION} - -type - PLOADED_IMAGE = ^LOADED_IMAGE; - {$EXTERNALSYM PLOADED_IMAGE} - _LOADED_IMAGE = record - ModuleName: PAnsiChar; - hFile: THandle; - MappedAddress: PUCHAR; - FileHeader: PImageNtHeaders; - LastRvaSection: PImageSectionHeader; - NumberOfSections: ULONG; - Sections: PImageSectionHeader; - Characteristics: ULONG; - fSystemImage: ByteBool; - fDOSImage: ByteBool; - Links: LIST_ENTRY; - SizeOfImage: ULONG; - end; - {$EXTERNALSYM _LOADED_IMAGE} - LOADED_IMAGE = _LOADED_IMAGE; - {$EXTERNALSYM LOADED_IMAGE} - TLoadedImage = LOADED_IMAGE; - PLoadedImage = PLOADED_IMAGE; - - PIMAGE_SYMBOL = ^IMAGE_SYMBOL; - {$EXTERNALSYM PIMAGE_SYMBOL} - _IMAGE_SYMBOL = packed record // MUST pack to obtain the right size - Name: array [0..7] of AnsiChar; - Value: ULONG; - SectionNumber: USHORT; - _Type: USHORT; - StorageClass: BYTE; - NumberOfAuxSymbols: BYTE; - end; - {$EXTERNALSYM _IMAGE_SYMBOL} - IMAGE_SYMBOL = _IMAGE_SYMBOL; - {$EXTERNALSYM IMAGE_SYMBOL} - TImageSymbol = IMAGE_SYMBOL; - PImageSymbol = PIMAGE_SYMBOL; - -// line 152 - - -function ReBaseImage(CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; - fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; - var OldImageSize: TJclAddr32; var OldImageBase: TJclAddr; - var NewImageSize: TJclAddr32; var NewImageBase: TJclAddr; TimeStamp: ULONG): BOOL; stdcall; -{$EXTERNALSYM ReBaseImage} - -function ReBaseImage64(CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; - fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; - var OldImageSize: TJclAddr32; var OldImageBase: TJclAddr64; - var NewImageSize: TJclAddr32; var NewImageBase: TJclAddr64; TimeStamp: ULONG): BOOL; stdcall; -{$EXTERNALSYM ReBaseImage64} - -// line 199 - -// -// Define checksum function prototypes. -// - -function CheckSumMappedFile(BaseAddress: Pointer; FileLength: DWORD; - out HeaderSum, CheckSum: DWORD): PImageNtHeaders; stdcall; -{$EXTERNALSYM CheckSumMappedFile} - -// line 227 - -function GetImageUnusedHeaderBytes(const LoadedImage: LOADED_IMAGE; - var SizeUnusedHeaderBytes: DWORD): DWORD; stdcall; -{$EXTERNALSYM GetImageUnusedHeaderBytes} - -// line 285 - -function MapAndLoad(ImageName, DllPath: PAnsiChar; var LoadedImage: LOADED_IMAGE; - DotDll: BOOL; ReadOnly: BOOL): BOOL; stdcall; -{$EXTERNALSYM MapAndLoad} - -function UnMapAndLoad(const LoadedImage: LOADED_IMAGE): BOOL; stdcall; -{$EXTERNALSYM UnMapAndLoad} - -function TouchFileTimes(const FileHandle: THandle; const pSystemTime: TSystemTime): BOOL; stdcall; -{$EXTERNALSYM TouchFileTimes} - -// line 347 - -function ImageDirectoryEntryToData(Base: Pointer; MappedAsImage: ByteBool; - DirectoryEntry: USHORT; var Size: ULONG): Pointer; stdcall; -{$EXTERNALSYM ImageDirectoryEntryToData} - -function ImageRvaToSection(NtHeaders: PImageNtHeaders; Base: Pointer; Rva: ULONG): PImageSectionHeader; stdcall; -{$EXTERNALSYM ImageRvaToSection} - -function ImageRvaToVa(NtHeaders: PImageNtHeaders; Base: Pointer; Rva: ULONG; - LastRvaSection: PPImageSectionHeader): Pointer; stdcall; -{$EXTERNALSYM ImageRvaToVa} - - -// line 461 - -// -// UnDecorateSymbolName Flags -// - -const - UNDNAME_COMPLETE = ($0000); // Enable full undecoration - {$EXTERNALSYM UNDNAME_COMPLETE} - UNDNAME_NO_LEADING_UNDERSCORES = ($0001); // Remove leading underscores from MS extended keywords - {$EXTERNALSYM UNDNAME_NO_LEADING_UNDERSCORES} - UNDNAME_NO_MS_KEYWORDS = ($0002); // Disable expansion of MS extended keywords - {$EXTERNALSYM UNDNAME_NO_MS_KEYWORDS} - UNDNAME_NO_FUNCTION_RETURNS = ($0004); // Disable expansion of return type for primary declaration - {$EXTERNALSYM UNDNAME_NO_FUNCTION_RETURNS} - UNDNAME_NO_ALLOCATION_MODEL = ($0008); // Disable expansion of the declaration model - {$EXTERNALSYM UNDNAME_NO_ALLOCATION_MODEL} - UNDNAME_NO_ALLOCATION_LANGUAGE = ($0010); // Disable expansion of the declaration language specifier - {$EXTERNALSYM UNDNAME_NO_ALLOCATION_LANGUAGE} - UNDNAME_NO_MS_THISTYPE = ($0020); // NYI Disable expansion of MS keywords on the 'this' type for primary declaration - {$EXTERNALSYM UNDNAME_NO_MS_THISTYPE} - UNDNAME_NO_CV_THISTYPE = ($0040); // NYI Disable expansion of CV modifiers on the 'this' type for primary declaration - {$EXTERNALSYM UNDNAME_NO_CV_THISTYPE} - UNDNAME_NO_THISTYPE = ($0060); // Disable all modifiers on the 'this' type - {$EXTERNALSYM UNDNAME_NO_THISTYPE} - UNDNAME_NO_ACCESS_SPECIFIERS = ($0080); // Disable expansion of access specifiers for members - {$EXTERNALSYM UNDNAME_NO_ACCESS_SPECIFIERS} - UNDNAME_NO_THROW_SIGNATURES = ($0100); // Disable expansion of 'throw-signatures' for functions and pointers to functions - {$EXTERNALSYM UNDNAME_NO_THROW_SIGNATURES} - UNDNAME_NO_MEMBER_TYPE = ($0200); // Disable expansion of 'static' or 'virtual'ness of members - {$EXTERNALSYM UNDNAME_NO_MEMBER_TYPE} - UNDNAME_NO_RETURN_UDT_MODEL = ($0400); // Disable expansion of MS model for UDT returns - {$EXTERNALSYM UNDNAME_NO_RETURN_UDT_MODEL} - UNDNAME_32_BIT_DECODE = ($0800); // Undecorate 32-bit decorated names - {$EXTERNALSYM UNDNAME_32_BIT_DECODE} - UNDNAME_NAME_ONLY = ($1000); // Crack only the name for primary declaration; - {$EXTERNALSYM UNDNAME_NAME_ONLY} - // return just [scope::]name. Does expand template params - UNDNAME_NO_ARGUMENTS = ($2000); // Don't undecorate arguments to function - {$EXTERNALSYM UNDNAME_NO_ARGUMENTS} - UNDNAME_NO_SPECIAL_SYMS = ($4000); // Don't undecorate special names (v-table, vcall, vector xxx, metatype, etc) - {$EXTERNALSYM UNDNAME_NO_SPECIAL_SYMS} - -// line 1342 - -type - {$EXTERNALSYM SYM_TYPE} - SYM_TYPE = ( - SymNone, - SymCoff, - SymCv, - SymPdb, - SymExport, - SymDeferred, - SymSym { .sym file } - ); - TSymType = SYM_TYPE; - - { symbol data structure } - {$EXTERNALSYM PImagehlpSymbolA} - PImagehlpSymbolA = ^TImagehlpSymbolA; - {$EXTERNALSYM _IMAGEHLP_SYMBOLA} - _IMAGEHLP_SYMBOLA = packed record - SizeOfStruct: DWORD; { set to sizeof(IMAGEHLP_SYMBOL) } - Address: DWORD; { virtual address including dll base address } - Size: DWORD; { estimated size of symbol, can be zero } - Flags: DWORD; { info about the symbols, see the SYMF defines } - MaxNameLength: DWORD; { maximum size of symbol name in 'Name' } - Name: packed array[0..0] of AnsiChar; { symbol name (null terminated string) } - end; - {$EXTERNALSYM IMAGEHLP_SYMBOLA} - IMAGEHLP_SYMBOLA = _IMAGEHLP_SYMBOLA; - {$EXTERNALSYM TImagehlpSymbolA} - TImagehlpSymbolA = _IMAGEHLP_SYMBOLA; - - { symbol data structure } - {$EXTERNALSYM PImagehlpSymbolA64} - PImagehlpSymbolA64 = ^TImagehlpSymbolA64; - {$EXTERNALSYM _IMAGEHLP_SYMBOLA64} - _IMAGEHLP_SYMBOLA64 = packed record - SizeOfStruct: DWORD; { set to sizeof(IMAGEHLP_SYMBOL) } - Address: TJclAddr64; { virtual address including dll base address } - Size: DWORD; { estimated size of symbol, can be zero } - Flags: DWORD; { info about the symbols, see the SYMF defines } - MaxNameLength: DWORD; { maximum size of symbol name in 'Name' } - Name: packed array[0..0] of AnsiChar; { symbol name (null terminated string) } - end; - {$EXTERNALSYM IMAGEHLP_SYMBOLA64} - IMAGEHLP_SYMBOLA64 = _IMAGEHLP_SYMBOLA64; - {$EXTERNALSYM TImagehlpSymbolA64} - TImagehlpSymbolA64 = _IMAGEHLP_SYMBOLA64; - - { symbol data structure } - {$EXTERNALSYM PImagehlpSymbolW} - PImagehlpSymbolW = ^TImagehlpSymbolW; - {$EXTERNALSYM _IMAGEHLP_SYMBOLW} - _IMAGEHLP_SYMBOLW = packed record - SizeOfStruct: DWORD; { set to sizeof(IMAGEHLP_SYMBOL) } - Address: DWORD; { virtual address including dll base address } - Size: DWORD; { estimated size of symbol, can be zero } - Flags: DWORD; { info about the symbols, see the SYMF defines } - MaxNameLength: DWORD; { maximum size of symbol name in 'Name' } - Name: packed array[0..0] of WideChar; { symbol name (null terminated string) } - end; - {$EXTERNALSYM IMAGEHLP_SYMBOLW} - IMAGEHLP_SYMBOLW = _IMAGEHLP_SYMBOLW; - {$EXTERNALSYM TImagehlpSymbolW} - TImagehlpSymbolW = _IMAGEHLP_SYMBOLW; - - { symbol data structure } - {$EXTERNALSYM PImagehlpSymbolW64} - PImagehlpSymbolW64 = ^TImagehlpSymbolW64; - {$EXTERNALSYM _IMAGEHLP_SYMBOLW64} - _IMAGEHLP_SYMBOLW64 = packed record - SizeOfStruct: DWORD; { set to sizeof(IMAGEHLP_SYMBOL) } - Address: TJclAddr64; { virtual address including dll base address } - Size: DWORD; { estimated size of symbol, can be zero } - Flags: DWORD; { info about the symbols, see the SYMF defines } - MaxNameLength: DWORD; { maximum size of symbol name in 'Name' } - Name: packed array[0..0] of WideChar; { symbol name (null terminated string) } - end; - {$EXTERNALSYM IMAGEHLP_SYMBOLW64} - IMAGEHLP_SYMBOLW64 = _IMAGEHLP_SYMBOLW64; - {$EXTERNALSYM TImagehlpSymbolW64} - TImagehlpSymbolW64 = _IMAGEHLP_SYMBOLW64; - - { module data structure } - {$EXTERNALSYM PImagehlpModuleA} - PImagehlpModuleA = ^TImagehlpModuleA; - {$EXTERNALSYM _IMAGEHLP_MODULEA} - _IMAGEHLP_MODULEA = record - SizeOfStruct: DWORD; { set to sizeof(IMAGEHLP_MODULE) } - BaseOfImage: DWORD; { base load address of module } - ImageSize: DWORD; { virtual size of the loaded module } - TimeDateStamp: DWORD; { date/time stamp from pe header } - CheckSum: DWORD; { checksum from the pe header } - NumSyms: DWORD; { number of symbols in the symbol table } - SymType: TSymType; { type of symbols loaded } - ModuleName: packed array[0..31] of AnsiChar; { module name } - ImageName: packed array[0..255] of AnsiChar; { image name } - LoadedImageName: packed array[0..255] of AnsiChar; { symbol file name } - end; - {$EXTERNALSYM IMAGEHLP_MODULEA} - IMAGEHLP_MODULEA = _IMAGEHLP_MODULEA; - {$EXTERNALSYM TImagehlpModuleA} - TImagehlpModuleA = _IMAGEHLP_MODULEA; - - { module data structure } - {$EXTERNALSYM PImagehlpModuleA64} - PImagehlpModuleA64 = ^TImagehlpModuleA64; - {$EXTERNALSYM _IMAGEHLP_MODULEA64} - _IMAGEHLP_MODULEA64 = record - SizeOfStruct: DWORD; { set to sizeof(IMAGEHLP_MODULE) } - BaseOfImage: TJclAddr64; { base load address of module } - ImageSize: DWORD; { virtual size of the loaded module } - TimeDateStamp: DWORD; { date/time stamp from pe header } - CheckSum: DWORD; { checksum from the pe header } - NumSyms: DWORD; { number of symbols in the symbol table } - SymType: TSymType; { type of symbols loaded } - ModuleName: packed array[0..31] of AnsiChar; { module name } - ImageName: packed array[0..255] of AnsiChar; { image name } - LoadedImageName: packed array[0..255] of AnsiChar; { symbol file name } - end; - {$EXTERNALSYM IMAGEHLP_MODULEA64} - IMAGEHLP_MODULEA64 = _IMAGEHLP_MODULEA64; - {$EXTERNALSYM TImagehlpModuleA64} - TImagehlpModuleA64 = _IMAGEHLP_MODULEA64; - - { module data structure } - {$EXTERNALSYM PImagehlpModuleW} - PImagehlpModuleW = ^TImagehlpModuleW; - {$EXTERNALSYM _IMAGEHLP_MODULEW} - _IMAGEHLP_MODULEW = record - SizeOfStruct: DWORD; { set to sizeof(IMAGEHLP_MODULE) } - BaseOfImage: DWORD; { base load address of module } - ImageSize: DWORD; { virtual size of the loaded module } - TimeDateStamp: DWORD; { date/time stamp from pe header } - CheckSum: DWORD; { checksum from the pe header } - NumSyms: DWORD; { number of symbols in the symbol table } - SymType: TSymType; { type of symbols loaded } - ModuleName: packed array[0..31] of WideChar; { module name } - ImageName: packed array[0..255] of WideChar; { image name } - LoadedImageName: packed array[0..255] of WideChar; { symbol file name } - end; - {$EXTERNALSYM IMAGEHLP_MODULEW} - IMAGEHLP_MODULEW = _IMAGEHLP_MODULEW; - {$EXTERNALSYM TImagehlpModuleW} - TImagehlpModuleW = _IMAGEHLP_MODULEW; - - { module data structure } - {$EXTERNALSYM PImagehlpModuleW64} - PImagehlpModuleW64 = ^TImagehlpModuleW64; - {$EXTERNALSYM _IMAGEHLP_MODULEW64} - _IMAGEHLP_MODULEW64 = record - SizeOfStruct: DWORD; { set to sizeof(IMAGEHLP_MODULE) } - BaseOfImage: TJclAddr64; { base load address of module } - ImageSize: DWORD; { virtual size of the loaded module } - TimeDateStamp: DWORD; { date/time stamp from pe header } - CheckSum: DWORD; { checksum from the pe header } - NumSyms: DWORD; { number of symbols in the symbol table } - SymType: TSymType; { type of symbols loaded } - ModuleName: packed array[0..31] of WideChar; { module name } - ImageName: packed array[0..255] of WideChar; { image name } - LoadedImageName: packed array[0..255] of WideChar; { symbol file name } - end; - {$EXTERNALSYM IMAGEHLP_MODULEW64} - IMAGEHLP_MODULEW64 = _IMAGEHLP_MODULEW64; - {$EXTERNALSYM TImagehlpModuleW64} - TImagehlpModuleW64 = _IMAGEHLP_MODULEW64; - - _IMAGEHLP_LINEA = packed record - SizeOfStruct: DWORD; // set to sizeof(IMAGEHLP_LINE) - Key: Pointer; // internal - LineNumber: DWORD; // line number in file - FileName: PAnsiChar; // full filename - Address: DWORD; // first instruction of line - end; - IMAGEHLP_LINEA = _IMAGEHLP_LINEA; - PIMAGEHLP_LINEA = ^_IMAGEHLP_LINEA; - TImageHlpLineA = _IMAGEHLP_LINEA; - PImageHlpLineA = PIMAGEHLP_LINEA; - - _IMAGEHLP_LINEA64 = packed record - SizeOfStruct: DWORD; // set to sizeof(IMAGEHLP_LINE) - Key: Pointer; // internal - LineNumber: DWORD; // line number in file - FileName: PAnsiChar; // full filename - Address: TJclAddr64; // first instruction of line - end; - IMAGEHLP_LINEA64 = _IMAGEHLP_LINEA64; - PIMAGEHLP_LINEA64 = ^_IMAGEHLP_LINEA64; - TImageHlpLineA64 = _IMAGEHLP_LINEA64; - PImageHlpLineA64 = PIMAGEHLP_LINEA64; - - _IMAGEHLP_LINEW = packed record - SizeOfStruct: DWORD; // set to sizeof(IMAGEHLP_LINE) - Key: Pointer; // internal - LineNumber: DWORD; // line number in file - FileName: PWideChar; // full filename - Address: DWORD; // first instruction of line - end; - IMAGEHLP_LINEW = _IMAGEHLP_LINEW; - PIMAGEHLP_LINEW = ^_IMAGEHLP_LINEW; - TImageHlpLineW = _IMAGEHLP_LINEW; - PImageHlpLineW = PIMAGEHLP_LINEW; - - _IMAGEHLP_LINEW64 = packed record - SizeOfStruct: DWORD; // set to sizeof(IMAGEHLP_LINE) - Key: Pointer; // internal - LineNumber: DWORD; // line number in file - FileName: PWideChar; // full filename - Address: TJclAddr64; // first instruction of line - end; - IMAGEHLP_LINEW64 = _IMAGEHLP_LINEW64; - PIMAGEHLP_LINEW64 = ^_IMAGEHLP_LINEW64; - TImageHlpLineW64 = _IMAGEHLP_LINEW64; - PImageHlpLineW64 = PIMAGEHLP_LINEW64; - -// line 1475 - -// -// options that are set/returned by SymSetOptions() & SymGetOptions() -// these are used as a mask -// - -const - SYMOPT_CASE_INSENSITIVE = $00000001; - {$EXTERNALSYM SYMOPT_CASE_INSENSITIVE} - SYMOPT_UNDNAME = $00000002; - {$EXTERNALSYM SYMOPT_UNDNAME} - SYMOPT_DEFERRED_LOADS = $00000004; - {$EXTERNALSYM SYMOPT_DEFERRED_LOADS} - SYMOPT_NO_CPP = $00000008; - {$EXTERNALSYM SYMOPT_NO_CPP} - SYMOPT_LOAD_LINES = $00000010; - {$EXTERNALSYM SYMOPT_LOAD_LINES} - SYMOPT_OMAP_FIND_NEAREST = $00000020; - {$EXTERNALSYM SYMOPT_OMAP_FIND_NEAREST} - SYMOPT_LOAD_ANYTHING = $00000040; - {$EXTERNALSYM SYMOPT_LOAD_ANYTHING} - SYMOPT_IGNORE_CVREC = $00000080; - {$EXTERNALSYM SYMOPT_IGNORE_CVREC} - SYMOPT_NO_UNQUALIFIED_LOADS = $00000100; - {$EXTERNALSYM SYMOPT_NO_UNQUALIFIED_LOADS} - SYMOPT_FAIL_CRITICAL_ERRORS = $00000200; - {$EXTERNALSYM SYMOPT_FAIL_CRITICAL_ERRORS} - SYMOPT_EXACT_SYMBOLS = $00000400; - {$EXTERNALSYM SYMOPT_EXACT_SYMBOLS} - SYMOPT_ALLOW_ABSOLUTE_SYMBOLS = $00000800; - {$EXTERNALSYM SYMOPT_ALLOW_ABSOLUTE_SYMBOLS} - SYMOPT_IGNORE_NT_SYMPATH = $00001000; - {$EXTERNALSYM SYMOPT_IGNORE_NT_SYMPATH} - SYMOPT_INCLUDE_32BIT_MODULES = $00002000; - {$EXTERNALSYM SYMOPT_INCLUDE_32BIT_MODULES} - SYMOPT_PUBLICS_ONLY = $00004000; - {$EXTERNALSYM SYMOPT_PUBLICS_ONLY} - SYMOPT_NO_PUBLICS = $00008000; - {$EXTERNALSYM SYMOPT_NO_PUBLICS} - SYMOPT_AUTO_PUBLICS = $00010000; - {$EXTERNALSYM SYMOPT_AUTO_PUBLICS} - SYMOPT_NO_IMAGE_SEARCH = $00020000; - {$EXTERNALSYM SYMOPT_NO_IMAGE_SEARCH} - SYMOPT_SECURE = $00040000; - {$EXTERNALSYM SYMOPT_SECURE} - SYMOPT_NO_PROMPTS = $00080000; - {$EXTERNALSYM SYMOPT_NO_PROMPTS} - - SYMOPT_DEBUG = $80000000; - {$EXTERNALSYM SYMOPT_DEBUG} - -// IoAPI.h - - -function CancelIo(hFile: THandle): BOOL; stdcall; -{$EXTERNALSYM CancelIo} - - -const - NERR_Success = 0; // Success - {$EXTERNALSYM NERR_Success} - -// ERROR_ equates can be intermixed with NERR_ equates. - -// NERR_BASE is the base of error codes from network utilities, -// chosen to avoid conflict with system and redirector error codes. -// 2100 is a value that has been assigned to us by system. - - NERR_BASE = 2100; - {$EXTERNALSYM NERR_BASE} - - -//*INTERNAL_ONLY* - -{**********WARNING ***************** - *See the comment in lmcons.h for * - *info on the allocation of errors * - ***********************************} - -{**********WARNING ***************** - *The range 2750-2799 has been * - *allocated to the IBM LAN Server * - ***********************************} - -{**********WARNING ***************** - *The range 2900-2999 has been * - *reserved for Microsoft OEMs * - ***********************************} - -// UNUSED BASE+0 -// UNUSED BASE+1 - NERR_NetNotStarted = (NERR_BASE+2); // The workstation driver is not installed. - {$EXTERNALSYM NERR_NetNotStarted} - NERR_UnknownServer = (NERR_BASE+3); // The server could not be located. - {$EXTERNALSYM NERR_UnknownServer} - NERR_ShareMem = (NERR_BASE+4); // An internal error occurred. The network cannot access a shared memory segment. - {$EXTERNALSYM NERR_ShareMem} - - NERR_NoNetworkResource = (NERR_BASE+5); // A network resource shortage occurred . - {$EXTERNALSYM NERR_NoNetworkResource} - NERR_RemoteOnly = (NERR_BASE+6); // This operation is not supported on workstations. - {$EXTERNALSYM NERR_RemoteOnly} - NERR_DevNotRedirected = (NERR_BASE+7); // The device is not connected. - {$EXTERNALSYM NERR_DevNotRedirected} -// NERR_BASE+8 is used for ERROR_CONNECTED_OTHER_PASSWORD -// NERR_BASE+9 is used for ERROR_CONNECTED_OTHER_PASSWORD_DEFAULT -// UNUSED BASE+10 -// UNUSED BASE+11 -// UNUSED BASE+12 -// UNUSED BASE+13 - NERR_ServerNotStarted = (NERR_BASE+14); // The Server service is not started. - {$EXTERNALSYM NERR_ServerNotStarted} - NERR_ItemNotFound = (NERR_BASE+15); // The queue is empty. - {$EXTERNALSYM NERR_ItemNotFound} - NERR_UnknownDevDir = (NERR_BASE+16); // The device or directory does not exist. - {$EXTERNALSYM NERR_UnknownDevDir} - NERR_RedirectedPath = (NERR_BASE+17); // The operation is invalid on a redirected resource. - {$EXTERNALSYM NERR_RedirectedPath} - NERR_DuplicateShare = (NERR_BASE+18); // The name has already been shared. - {$EXTERNALSYM NERR_DuplicateShare} - NERR_NoRoom = (NERR_BASE+19); // The server is currently out of the requested resource. - {$EXTERNALSYM NERR_NoRoom} -// UNUSED BASE+20 - NERR_TooManyItems = (NERR_BASE+21); // Requested addition of items exceeds the maximum allowed. - {$EXTERNALSYM NERR_TooManyItems} - NERR_InvalidMaxUsers = (NERR_BASE+22); // The Peer service supports only two simultaneous users. - {$EXTERNALSYM NERR_InvalidMaxUsers} - NERR_BufTooSmall = (NERR_BASE+23); // The API return buffer is too small. - {$EXTERNALSYM NERR_BufTooSmall} -// UNUSED BASE+24 -// UNUSED BASE+25 -// UNUSED BASE+26 - NERR_RemoteErr = (NERR_BASE+27); // A remote API error occurred. - {$EXTERNALSYM NERR_RemoteErr} -// UNUSED BASE+28 -// UNUSED BASE+29 -// UNUSED BASE+30 - NERR_LanmanIniError = (NERR_BASE+31); // An error occurred when opening or reading the configuration file. - {$EXTERNALSYM NERR_LanmanIniError} -// UNUSED BASE+32 -// UNUSED BASE+33 -// UNUSED BASE+34 -// UNUSED BASE+35 - NERR_NetworkError = (NERR_BASE+36); // A general network error occurred. - {$EXTERNALSYM NERR_NetworkError} - NERR_WkstaInconsistentState = (NERR_BASE+37); - {$EXTERNALSYM NERR_WkstaInconsistentState} - // The Workstation service is in an inconsistent state. Restart the computer before restarting the Workstation service. - NERR_WkstaNotStarted = (NERR_BASE+38); // The Workstation service has not been started. - {$EXTERNALSYM NERR_WkstaNotStarted} - NERR_BrowserNotStarted = (NERR_BASE+39); // The requested information is not available. - {$EXTERNALSYM NERR_BrowserNotStarted} - NERR_InternalError = (NERR_BASE+40); // An internal Windows 2000 error occurred. - {$EXTERNALSYM NERR_InternalError} - NERR_BadTransactConfig = (NERR_BASE+41); // The server is not configured for transactions. - {$EXTERNALSYM NERR_BadTransactConfig} - NERR_InvalidAPI = (NERR_BASE+42); // The requested API is not supported on the remote server. - {$EXTERNALSYM NERR_InvalidAPI} - NERR_BadEventName = (NERR_BASE+43); // The event name is invalid. - {$EXTERNALSYM NERR_BadEventName} - NERR_DupNameReboot = (NERR_BASE+44); // The computer name already exists on the network. Change it and restart the computer. - {$EXTERNALSYM NERR_DupNameReboot} - -// -// Config API related -// Error codes from BASE+45 to BASE+49 - - -// UNUSED BASE+45 - NERR_CfgCompNotFound = (NERR_BASE+46); // The specified component could not be found in the configuration information. - {$EXTERNALSYM NERR_CfgCompNotFound} - NERR_CfgParamNotFound = (NERR_BASE+47); // The specified parameter could not be found in the configuration information. - {$EXTERNALSYM NERR_CfgParamNotFound} - NERR_LineTooLong = (NERR_BASE+49); // A line in the configuration file is too long. - {$EXTERNALSYM NERR_LineTooLong} - -// -// Spooler API related -// Error codes from BASE+50 to BASE+79 - - - NERR_QNotFound = (NERR_BASE+50); // The printer does not exist. - {$EXTERNALSYM NERR_QNotFound} - NERR_JobNotFound = (NERR_BASE+51); // The print job does not exist. - {$EXTERNALSYM NERR_JobNotFound} - NERR_DestNotFound = (NERR_BASE+52); // The printer destination cannot be found. - {$EXTERNALSYM NERR_DestNotFound} - NERR_DestExists = (NERR_BASE+53); // The printer destination already exists. - {$EXTERNALSYM NERR_DestExists} - NERR_QExists = (NERR_BASE+54); // The printer queue already exists. - {$EXTERNALSYM NERR_QExists} - NERR_QNoRoom = (NERR_BASE+55); // No more printers can be added. - {$EXTERNALSYM NERR_QNoRoom} - NERR_JobNoRoom = (NERR_BASE+56); // No more print jobs can be added. - {$EXTERNALSYM NERR_JobNoRoom} - NERR_DestNoRoom = (NERR_BASE+57); // No more printer destinations can be added. - {$EXTERNALSYM NERR_DestNoRoom} - NERR_DestIdle = (NERR_BASE+58); // This printer destination is idle and cannot accept control operations. - {$EXTERNALSYM NERR_DestIdle} - NERR_DestInvalidOp = (NERR_BASE+59); // This printer destination request contains an invalid control function. - {$EXTERNALSYM NERR_DestInvalidOp} - NERR_ProcNoRespond = (NERR_BASE+60); // The print processor is not responding. - {$EXTERNALSYM NERR_ProcNoRespond} - NERR_SpoolerNotLoaded = (NERR_BASE+61); // The spooler is not running. - {$EXTERNALSYM NERR_SpoolerNotLoaded} - NERR_DestInvalidState = (NERR_BASE+62); // This operation cannot be performed on the print destination in its current state. - {$EXTERNALSYM NERR_DestInvalidState} - NERR_QInvalidState = (NERR_BASE+63); // This operation cannot be performed on the printer queue in its current state. - {$EXTERNALSYM NERR_QInvalidState} - NERR_JobInvalidState = (NERR_BASE+64); // This operation cannot be performed on the print job in its current state. - {$EXTERNALSYM NERR_JobInvalidState} - NERR_SpoolNoMemory = (NERR_BASE+65); // A spooler memory allocation failure occurred. - {$EXTERNALSYM NERR_SpoolNoMemory} - NERR_DriverNotFound = (NERR_BASE+66); // The device driver does not exist. - {$EXTERNALSYM NERR_DriverNotFound} - NERR_DataTypeInvalid = (NERR_BASE+67); // The data type is not supported by the print processor. - {$EXTERNALSYM NERR_DataTypeInvalid} - NERR_ProcNotFound = (NERR_BASE+68); // The print processor is not installed. - {$EXTERNALSYM NERR_ProcNotFound} - -// -// Service API related -// Error codes from BASE+80 to BASE+99 - - - NERR_ServiceTableLocked = (NERR_BASE+80); // The service database is locked. - {$EXTERNALSYM NERR_ServiceTableLocked} - NERR_ServiceTableFull = (NERR_BASE+81); // The service table is full. - {$EXTERNALSYM NERR_ServiceTableFull} - NERR_ServiceInstalled = (NERR_BASE+82); // The requested service has already been started. - {$EXTERNALSYM NERR_ServiceInstalled} - NERR_ServiceEntryLocked = (NERR_BASE+83); // The service does not respond to control actions. - {$EXTERNALSYM NERR_ServiceEntryLocked} - NERR_ServiceNotInstalled = (NERR_BASE+84); // The service has not been started. - {$EXTERNALSYM NERR_ServiceNotInstalled} - NERR_BadServiceName = (NERR_BASE+85); // The service name is invalid. - {$EXTERNALSYM NERR_BadServiceName} - NERR_ServiceCtlTimeout = (NERR_BASE+86); // The service is not responding to the control function. - {$EXTERNALSYM NERR_ServiceCtlTimeout} - NERR_ServiceCtlBusy = (NERR_BASE+87); // The service control is busy. - {$EXTERNALSYM NERR_ServiceCtlBusy} - NERR_BadServiceProgName = (NERR_BASE+88); // The configuration file contains an invalid service program name. - {$EXTERNALSYM NERR_BadServiceProgName} - NERR_ServiceNotCtrl = (NERR_BASE+89); // The service could not be controlled in its present state. - {$EXTERNALSYM NERR_ServiceNotCtrl} - NERR_ServiceKillProc = (NERR_BASE+90); // The service ended abnormally. - {$EXTERNALSYM NERR_ServiceKillProc} - NERR_ServiceCtlNotValid = (NERR_BASE+91); // The requested pause,continue, or stop is not valid for this service. - {$EXTERNALSYM NERR_ServiceCtlNotValid} - NERR_NotInDispatchTbl = (NERR_BASE+92); // The service control dispatcher could not find the service name in the dispatch table. - {$EXTERNALSYM NERR_NotInDispatchTbl} - NERR_BadControlRecv = (NERR_BASE+93); // The service control dispatcher pipe read failed. - {$EXTERNALSYM NERR_BadControlRecv} - NERR_ServiceNotStarting = (NERR_BASE+94); // A thread for the new service could not be created. - {$EXTERNALSYM NERR_ServiceNotStarting} - -// -// Wksta and Logon API related -// Error codes from BASE+100 to BASE+118 - - - NERR_AlreadyLoggedOn = (NERR_BASE+100); // This workstation is already logged on to the local-area network. - {$EXTERNALSYM NERR_AlreadyLoggedOn} - NERR_NotLoggedOn = (NERR_BASE+101); // The workstation is not logged on to the local-area network. - {$EXTERNALSYM NERR_NotLoggedOn} - NERR_BadUsername = (NERR_BASE+102); // The user name or group name parameter is invalid. - {$EXTERNALSYM NERR_BadUsername} - NERR_BadPassword = (NERR_BASE+103); // The password parameter is invalid. - {$EXTERNALSYM NERR_BadPassword} - NERR_UnableToAddName_W = (NERR_BASE+104); // @W The logon processor did not add the message alias. - {$EXTERNALSYM NERR_UnableToAddName_W} - NERR_UnableToAddName_F = (NERR_BASE+105); // The logon processor did not add the message alias. - {$EXTERNALSYM NERR_UnableToAddName_F} - NERR_UnableToDelName_W = (NERR_BASE+106); // @W The logoff processor did not delete the message alias. - {$EXTERNALSYM NERR_UnableToDelName_W} - NERR_UnableToDelName_F = (NERR_BASE+107); // The logoff processor did not delete the message alias. - {$EXTERNALSYM NERR_UnableToDelName_F} -// UNUSED BASE+108 - NERR_LogonsPaused = (NERR_BASE+109); // Network logons are paused. - {$EXTERNALSYM NERR_LogonsPaused} - NERR_LogonServerConflict = (NERR_BASE+110); // A centralized logon-server conflict occurred. - {$EXTERNALSYM NERR_LogonServerConflict} - NERR_LogonNoUserPath = (NERR_BASE+111); // The server is configured without a valid user path. - {$EXTERNALSYM NERR_LogonNoUserPath} - NERR_LogonScriptError = (NERR_BASE+112); // An error occurred while loading or running the logon script. - {$EXTERNALSYM NERR_LogonScriptError} -// UNUSED BASE+113 - NERR_StandaloneLogon = (NERR_BASE+114); // The logon server was not specified. Your computer will be logged on as STANDALONE. - {$EXTERNALSYM NERR_StandaloneLogon} - NERR_LogonServerNotFound = (NERR_BASE+115); // The logon server could not be found. - {$EXTERNALSYM NERR_LogonServerNotFound} - NERR_LogonDomainExists = (NERR_BASE+116); // There is already a logon domain for this computer. - {$EXTERNALSYM NERR_LogonDomainExists} - NERR_NonValidatedLogon = (NERR_BASE+117); // The logon server could not validate the logon. - {$EXTERNALSYM NERR_NonValidatedLogon} - -// -// ACF API related (access, user, group) -// Error codes from BASE+119 to BASE+149 - - - NERR_ACFNotFound = (NERR_BASE+119); // The security database could not be found. - {$EXTERNALSYM NERR_ACFNotFound} - NERR_GroupNotFound = (NERR_BASE+120); // The group name could not be found. - {$EXTERNALSYM NERR_GroupNotFound} - NERR_UserNotFound = (NERR_BASE+121); // The user name could not be found. - {$EXTERNALSYM NERR_UserNotFound} - NERR_ResourceNotFound = (NERR_BASE+122); // The resource name could not be found. - {$EXTERNALSYM NERR_ResourceNotFound} - NERR_GroupExists = (NERR_BASE+123); // The group already exists. - {$EXTERNALSYM NERR_GroupExists} - NERR_UserExists = (NERR_BASE+124); // The account already exists. - {$EXTERNALSYM NERR_UserExists} - NERR_ResourceExists = (NERR_BASE+125); // The resource permission list already exists. - {$EXTERNALSYM NERR_ResourceExists} - NERR_NotPrimary = (NERR_BASE+126); // This operation is only allowed on the primary domain controller of the domain. - {$EXTERNALSYM NERR_NotPrimary} - NERR_ACFNotLoaded = (NERR_BASE+127); // The security database has not been started. - {$EXTERNALSYM NERR_ACFNotLoaded} - NERR_ACFNoRoom = (NERR_BASE+128); // There are too many names in the user accounts database. - {$EXTERNALSYM NERR_ACFNoRoom} - NERR_ACFFileIOFail = (NERR_BASE+129); // A disk I/O failure occurred. - {$EXTERNALSYM NERR_ACFFileIOFail} - NERR_ACFTooManyLists = (NERR_BASE+130); // The limit of 64 entries per resource was exceeded. - {$EXTERNALSYM NERR_ACFTooManyLists} - NERR_UserLogon = (NERR_BASE+131); // Deleting a user with a session is not allowed. - {$EXTERNALSYM NERR_UserLogon} - NERR_ACFNoParent = (NERR_BASE+132); // The parent directory could not be located. - {$EXTERNALSYM NERR_ACFNoParent} - NERR_CanNotGrowSegment = (NERR_BASE+133); // Unable to add to the security database session cache segment. - {$EXTERNALSYM NERR_CanNotGrowSegment} - NERR_SpeGroupOp = (NERR_BASE+134); // This operation is not allowed on this special group. - {$EXTERNALSYM NERR_SpeGroupOp} - NERR_NotInCache = (NERR_BASE+135); // This user is not cached in user accounts database session cache. - {$EXTERNALSYM NERR_NotInCache} - NERR_UserInGroup = (NERR_BASE+136); // The user already belongs to this group. - {$EXTERNALSYM NERR_UserInGroup} - NERR_UserNotInGroup = (NERR_BASE+137); // The user does not belong to this group. - {$EXTERNALSYM NERR_UserNotInGroup} - NERR_AccountUndefined = (NERR_BASE+138); // This user account is undefined. - {$EXTERNALSYM NERR_AccountUndefined} - NERR_AccountExpired = (NERR_BASE+139); // This user account has expired. - {$EXTERNALSYM NERR_AccountExpired} - NERR_InvalidWorkstation = (NERR_BASE+140); // The user is not allowed to log on from this workstation. - {$EXTERNALSYM NERR_InvalidWorkstation} - NERR_InvalidLogonHours = (NERR_BASE+141); // The user is not allowed to log on at this time. - {$EXTERNALSYM NERR_InvalidLogonHours} - NERR_PasswordExpired = (NERR_BASE+142); // The password of this user has expired. - {$EXTERNALSYM NERR_PasswordExpired} - NERR_PasswordCantChange = (NERR_BASE+143); // The password of this user cannot change. - {$EXTERNALSYM NERR_PasswordCantChange} - NERR_PasswordHistConflict = (NERR_BASE+144); // This password cannot be used now. - {$EXTERNALSYM NERR_PasswordHistConflict} - NERR_PasswordTooShort = (NERR_BASE+145); // The password does not meet the password policy requirements. Check the minimum password length, password complexity and password history requirements. - {$EXTERNALSYM NERR_PasswordTooShort} - NERR_PasswordTooRecent = (NERR_BASE+146); // The password of this user is too recent to change. - {$EXTERNALSYM NERR_PasswordTooRecent} - NERR_InvalidDatabase = (NERR_BASE+147); // The security database is corrupted. - {$EXTERNALSYM NERR_InvalidDatabase} - NERR_DatabaseUpToDate = (NERR_BASE+148); // No updates are necessary to this replicant network/local security database. - {$EXTERNALSYM NERR_DatabaseUpToDate} - NERR_SyncRequired = (NERR_BASE+149); // This replicant database is outdated; synchronization is required. - {$EXTERNALSYM NERR_SyncRequired} - -// -// Use API related -// Error codes from BASE+150 to BASE+169 - - - NERR_UseNotFound = (NERR_BASE+150); // The network connection could not be found. - {$EXTERNALSYM NERR_UseNotFound} - NERR_BadAsgType = (NERR_BASE+151); // This asg_type is invalid. - {$EXTERNALSYM NERR_BadAsgType} - NERR_DeviceIsShared = (NERR_BASE+152); // This device is currently being shared. - {$EXTERNALSYM NERR_DeviceIsShared} - -// -// Message Server related -// Error codes BASE+170 to BASE+209 - - - NERR_NoComputerName = (NERR_BASE+170); // The computer name could not be added as a message alias. The name may already exist on the network. - {$EXTERNALSYM NERR_NoComputerName} - NERR_MsgAlreadyStarted = (NERR_BASE+171); // The Messenger service is already started. - {$EXTERNALSYM NERR_MsgAlreadyStarted} - NERR_MsgInitFailed = (NERR_BASE+172); // The Messenger service failed to start. - {$EXTERNALSYM NERR_MsgInitFailed} - NERR_NameNotFound = (NERR_BASE+173); // The message alias could not be found on the network. - {$EXTERNALSYM NERR_NameNotFound} - NERR_AlreadyForwarded = (NERR_BASE+174); // This message alias has already been forwarded. - {$EXTERNALSYM NERR_AlreadyForwarded} - NERR_AddForwarded = (NERR_BASE+175); // This message alias has been added but is still forwarded. - {$EXTERNALSYM NERR_AddForwarded} - NERR_AlreadyExists = (NERR_BASE+176); // This message alias already exists locally. - {$EXTERNALSYM NERR_AlreadyExists} - NERR_TooManyNames = (NERR_BASE+177); // The maximum number of added message aliases has been exceeded. - {$EXTERNALSYM NERR_TooManyNames} - NERR_DelComputerName = (NERR_BASE+178); // The computer name could not be deleted. - {$EXTERNALSYM NERR_DelComputerName} - NERR_LocalForward = (NERR_BASE+179); // Messages cannot be forwarded back to the same workstation. - {$EXTERNALSYM NERR_LocalForward} - NERR_GrpMsgProcessor = (NERR_BASE+180); // An error occurred in the domain message processor. - {$EXTERNALSYM NERR_GrpMsgProcessor} - NERR_PausedRemote = (NERR_BASE+181); // The message was sent, but the recipient has paused the Messenger service. - {$EXTERNALSYM NERR_PausedRemote} - NERR_BadReceive = (NERR_BASE+182); // The message was sent but not received. - {$EXTERNALSYM NERR_BadReceive} - NERR_NameInUse = (NERR_BASE+183); // The message alias is currently in use. Try again later. - {$EXTERNALSYM NERR_NameInUse} - NERR_MsgNotStarted = (NERR_BASE+184); // The Messenger service has not been started. - {$EXTERNALSYM NERR_MsgNotStarted} - NERR_NotLocalName = (NERR_BASE+185); // The name is not on the local computer. - {$EXTERNALSYM NERR_NotLocalName} - NERR_NoForwardName = (NERR_BASE+186); // The forwarded message alias could not be found on the network. - {$EXTERNALSYM NERR_NoForwardName} - NERR_RemoteFull = (NERR_BASE+187); // The message alias table on the remote station is full. - {$EXTERNALSYM NERR_RemoteFull} - NERR_NameNotForwarded = (NERR_BASE+188); // Messages for this alias are not currently being forwarded. - {$EXTERNALSYM NERR_NameNotForwarded} - NERR_TruncatedBroadcast = (NERR_BASE+189); // The broadcast message was truncated. - {$EXTERNALSYM NERR_TruncatedBroadcast} - NERR_InvalidDevice = (NERR_BASE+194); // This is an invalid device name. - {$EXTERNALSYM NERR_InvalidDevice} - NERR_WriteFault = (NERR_BASE+195); // A write fault occurred. - {$EXTERNALSYM NERR_WriteFault} -// UNUSED BASE+196 - NERR_DuplicateName = (NERR_BASE+197); // A duplicate message alias exists on the network. - {$EXTERNALSYM NERR_DuplicateName} - NERR_DeleteLater = (NERR_BASE+198); // @W This message alias will be deleted later. - {$EXTERNALSYM NERR_DeleteLater} - NERR_IncompleteDel = (NERR_BASE+199); // The message alias was not successfully deleted from all networks. - {$EXTERNALSYM NERR_IncompleteDel} - NERR_MultipleNets = (NERR_BASE+200); // This operation is not supported on computers with multiple networks. - {$EXTERNALSYM NERR_MultipleNets} - -// -// Server API related -// Error codes BASE+210 to BASE+229 - - - NERR_NetNameNotFound = (NERR_BASE+210); // This shared resource does not exist. - {$EXTERNALSYM NERR_NetNameNotFound} - NERR_DeviceNotShared = (NERR_BASE+211); // This device is not shared. - {$EXTERNALSYM NERR_DeviceNotShared} - NERR_ClientNameNotFound = (NERR_BASE+212); // A session does not exist with that computer name. - {$EXTERNALSYM NERR_ClientNameNotFound} - NERR_FileIdNotFound = (NERR_BASE+214); // There is not an open file with that identification number. - {$EXTERNALSYM NERR_FileIdNotFound} - NERR_ExecFailure = (NERR_BASE+215); // A failure occurred when executing a remote administration command. - {$EXTERNALSYM NERR_ExecFailure} - NERR_TmpFile = (NERR_BASE+216); // A failure occurred when opening a remote temporary file. - {$EXTERNALSYM NERR_TmpFile} - NERR_TooMuchData = (NERR_BASE+217); // The data returned from a remote administration command has been truncated to 64K. - {$EXTERNALSYM NERR_TooMuchData} - NERR_DeviceShareConflict = (NERR_BASE+218); // This device cannot be shared as both a spooled and a non-spooled resource. - {$EXTERNALSYM NERR_DeviceShareConflict} - NERR_BrowserTableIncomplete = (NERR_BASE+219); // The information in the list of servers may be incorrect. - {$EXTERNALSYM NERR_BrowserTableIncomplete} - NERR_NotLocalDomain = (NERR_BASE+220); // The computer is not active in this domain. - {$EXTERNALSYM NERR_NotLocalDomain} - NERR_IsDfsShare = (NERR_BASE+221); // The share must be removed from the Distributed File System before it can be deleted. - {$EXTERNALSYM NERR_IsDfsShare} - -// -// CharDev API related -// Error codes BASE+230 to BASE+249 - - -// UNUSED BASE+230 - NERR_DevInvalidOpCode = (NERR_BASE+231); // The operation is invalid for this device. - {$EXTERNALSYM NERR_DevInvalidOpCode} - NERR_DevNotFound = (NERR_BASE+232); // This device cannot be shared. - {$EXTERNALSYM NERR_DevNotFound} - NERR_DevNotOpen = (NERR_BASE+233); // This device was not open. - {$EXTERNALSYM NERR_DevNotOpen} - NERR_BadQueueDevString = (NERR_BASE+234); // This device name list is invalid. - {$EXTERNALSYM NERR_BadQueueDevString} - NERR_BadQueuePriority = (NERR_BASE+235); // The queue priority is invalid. - {$EXTERNALSYM NERR_BadQueuePriority} - NERR_NoCommDevs = (NERR_BASE+237); // There are no shared communication devices. - {$EXTERNALSYM NERR_NoCommDevs} - NERR_QueueNotFound = (NERR_BASE+238); // The queue you specified does not exist. - {$EXTERNALSYM NERR_QueueNotFound} - NERR_BadDevString = (NERR_BASE+240); // This list of devices is invalid. - {$EXTERNALSYM NERR_BadDevString} - NERR_BadDev = (NERR_BASE+241); // The requested device is invalid. - {$EXTERNALSYM NERR_BadDev} - NERR_InUseBySpooler = (NERR_BASE+242); // This device is already in use by the spooler. - {$EXTERNALSYM NERR_InUseBySpooler} - NERR_CommDevInUse = (NERR_BASE+243); // This device is already in use as a communication device. - {$EXTERNALSYM NERR_CommDevInUse} - -// -// NetICanonicalize and NetIType and NetIMakeLMFileName -// NetIListCanon and NetINameCheck -// Error codes BASE+250 to BASE+269 - - - NERR_InvalidComputer = (NERR_BASE+251); // This computer name is invalid. - {$EXTERNALSYM NERR_InvalidComputer} -// UNUSED BASE+252 -// UNUSED BASE+253 - NERR_MaxLenExceeded = (NERR_BASE+254); // The string and prefix specified are too long. - {$EXTERNALSYM NERR_MaxLenExceeded} -// UNUSED BASE+255 - NERR_BadComponent = (NERR_BASE+256); // This path component is invalid. - {$EXTERNALSYM NERR_BadComponent} - NERR_CantType = (NERR_BASE+257); // Could not determine the type of input. - {$EXTERNALSYM NERR_CantType} -// UNUSED BASE+258 -// UNUSED BASE+259 - NERR_TooManyEntries = (NERR_BASE+262); // The buffer for types is not big enough. - {$EXTERNALSYM NERR_TooManyEntries} - -// -// NetProfile -// Error codes BASE+270 to BASE+276 - - - NERR_ProfileFileTooBig = (NERR_BASE+270); // Profile files cannot exceed 64K. - {$EXTERNALSYM NERR_ProfileFileTooBig} - NERR_ProfileOffset = (NERR_BASE+271); // The start offset is out of range. - {$EXTERNALSYM NERR_ProfileOffset} - NERR_ProfileCleanup = (NERR_BASE+272); // The system cannot delete current connections to network resources. - {$EXTERNALSYM NERR_ProfileCleanup} - NERR_ProfileUnknownCmd = (NERR_BASE+273); // The system was unable to parse the command line in this file. - {$EXTERNALSYM NERR_ProfileUnknownCmd} - NERR_ProfileLoadErr = (NERR_BASE+274); // An error occurred while loading the profile file. - {$EXTERNALSYM NERR_ProfileLoadErr} - NERR_ProfileSaveErr = (NERR_BASE+275); // @W Errors occurred while saving the profile file. The profile was partially saved. - {$EXTERNALSYM NERR_ProfileSaveErr} - - -// -// NetAudit and NetErrorLog -// Error codes BASE+277 to BASE+279 - - - NERR_LogOverflow = (NERR_BASE+277); // Log file %1 is full. - {$EXTERNALSYM NERR_LogOverflow} - NERR_LogFileChanged = (NERR_BASE+278); // This log file has changed between reads. - {$EXTERNALSYM NERR_LogFileChanged} - NERR_LogFileCorrupt = (NERR_BASE+279); // Log file %1 is corrupt. - {$EXTERNALSYM NERR_LogFileCorrupt} - - -// -// NetRemote -// Error codes BASE+280 to BASE+299 - - NERR_SourceIsDir = (NERR_BASE+280); // The source path cannot be a directory. - {$EXTERNALSYM NERR_SourceIsDir} - NERR_BadSource = (NERR_BASE+281); // The source path is illegal. - {$EXTERNALSYM NERR_BadSource} - NERR_BadDest = (NERR_BASE+282); // The destination path is illegal. - {$EXTERNALSYM NERR_BadDest} - NERR_DifferentServers = (NERR_BASE+283); // The source and destination paths are on different servers. - {$EXTERNALSYM NERR_DifferentServers} -// UNUSED BASE+284 - NERR_RunSrvPaused = (NERR_BASE+285); // The Run server you requested is paused. - {$EXTERNALSYM NERR_RunSrvPaused} -// UNUSED BASE+286 -// UNUSED BASE+287 -// UNUSED BASE+288 - NERR_ErrCommRunSrv = (NERR_BASE+289); // An error occurred when communicating with a Run server. - {$EXTERNALSYM NERR_ErrCommRunSrv} -// UNUSED BASE+290 - NERR_ErrorExecingGhost = (NERR_BASE+291); // An error occurred when starting a background process. - {$EXTERNALSYM NERR_ErrorExecingGhost} - NERR_ShareNotFound = (NERR_BASE+292); // The shared resource you are connected to could not be found. - {$EXTERNALSYM NERR_ShareNotFound} -// UNUSED BASE+293 -// UNUSED BASE+294 - - -// -// NetWksta.sys (redir) returned error codes. -// -// NERR_BASE + (300-329) - - - NERR_InvalidLana = (NERR_BASE+300); // The LAN adapter number is invalid. - {$EXTERNALSYM NERR_InvalidLana} - NERR_OpenFiles = (NERR_BASE+301); // There are open files on the connection. - {$EXTERNALSYM NERR_OpenFiles} - NERR_ActiveConns = (NERR_BASE+302); // Active connections still exist. - {$EXTERNALSYM NERR_ActiveConns} - NERR_BadPasswordCore = (NERR_BASE+303); // This share name or password is invalid. - {$EXTERNALSYM NERR_BadPasswordCore} - NERR_DevInUse = (NERR_BASE+304); // The device is being accessed by an active process. - {$EXTERNALSYM NERR_DevInUse} - NERR_LocalDrive = (NERR_BASE+305); // The drive letter is in use locally. - {$EXTERNALSYM NERR_LocalDrive} - -// -// Alert error codes. -// -// NERR_BASE + (330-339) - - NERR_AlertExists = (NERR_BASE+330); // The specified client is already registered for the specified event. - {$EXTERNALSYM NERR_AlertExists} - NERR_TooManyAlerts = (NERR_BASE+331); // The alert table is full. - {$EXTERNALSYM NERR_TooManyAlerts} - NERR_NoSuchAlert = (NERR_BASE+332); // An invalid or nonexistent alert name was raised. - {$EXTERNALSYM NERR_NoSuchAlert} - NERR_BadRecipient = (NERR_BASE+333); // The alert recipient is invalid. - {$EXTERNALSYM NERR_BadRecipient} - NERR_AcctLimitExceeded = (NERR_BASE+334); // A user's session with this server has been deleted - {$EXTERNALSYM NERR_AcctLimitExceeded} - // because the user's logon hours are no longer valid. - -// -// Additional Error and Audit log codes. -// -// NERR_BASE +(340-343) - - NERR_InvalidLogSeek = (NERR_BASE+340); // The log file does not contain the requested record number. - {$EXTERNALSYM NERR_InvalidLogSeek} -// UNUSED BASE+341 -// UNUSED BASE+342 -// UNUSED BASE+343 - -// -// Additional UAS and NETLOGON codes -// -// NERR_BASE +(350-359) - - NERR_BadUasConfig = (NERR_BASE+350); // The user accounts database is not configured correctly. - {$EXTERNALSYM NERR_BadUasConfig} - NERR_InvalidUASOp = (NERR_BASE+351); // This operation is not permitted when the Netlogon service is running. - {$EXTERNALSYM NERR_InvalidUASOp} - NERR_LastAdmin = (NERR_BASE+352); // This operation is not allowed on the last administrative account. - {$EXTERNALSYM NERR_LastAdmin} - NERR_DCNotFound = (NERR_BASE+353); // Could not find domain controller for this domain. - {$EXTERNALSYM NERR_DCNotFound} - NERR_LogonTrackingError = (NERR_BASE+354); // Could not set logon information for this user. - {$EXTERNALSYM NERR_LogonTrackingError} - NERR_NetlogonNotStarted = (NERR_BASE+355); // The Netlogon service has not been started. - {$EXTERNALSYM NERR_NetlogonNotStarted} - NERR_CanNotGrowUASFile = (NERR_BASE+356); // Unable to add to the user accounts database. - {$EXTERNALSYM NERR_CanNotGrowUASFile} - NERR_TimeDiffAtDC = (NERR_BASE+357); // This server's clock is not synchronized with the primary domain controller's clock. - {$EXTERNALSYM NERR_TimeDiffAtDC} - NERR_PasswordMismatch = (NERR_BASE+358); // A password mismatch has been detected. - {$EXTERNALSYM NERR_PasswordMismatch} - - -// -// Server Integration error codes. -// -// NERR_BASE +(360-369) - - NERR_NoSuchServer = (NERR_BASE+360); // The server identification does not specify a valid server. - {$EXTERNALSYM NERR_NoSuchServer} - NERR_NoSuchSession = (NERR_BASE+361); // The session identification does not specify a valid session. - {$EXTERNALSYM NERR_NoSuchSession} - NERR_NoSuchConnection = (NERR_BASE+362); // The connection identification does not specify a valid connection. - {$EXTERNALSYM NERR_NoSuchConnection} - NERR_TooManyServers = (NERR_BASE+363); // There is no space for another entry in the table of available servers. - {$EXTERNALSYM NERR_TooManyServers} - NERR_TooManySessions = (NERR_BASE+364); // The server has reached the maximum number of sessions it supports. - {$EXTERNALSYM NERR_TooManySessions} - NERR_TooManyConnections = (NERR_BASE+365); // The server has reached the maximum number of connections it supports. - {$EXTERNALSYM NERR_TooManyConnections} - NERR_TooManyFiles = (NERR_BASE+366); // The server cannot open more files because it has reached its maximum number. - {$EXTERNALSYM NERR_TooManyFiles} - NERR_NoAlternateServers = (NERR_BASE+367); // There are no alternate servers registered on this server. - {$EXTERNALSYM NERR_NoAlternateServers} -// UNUSED BASE+368 -// UNUSED BASE+369 - - NERR_TryDownLevel = (NERR_BASE+370); // Try down-level (remote admin protocol) version of API instead. - {$EXTERNALSYM NERR_TryDownLevel} - -// -// UPS error codes. -// -// NERR_BASE + (380-384) - - NERR_UPSDriverNotStarted = (NERR_BASE+380); // The UPS driver could not be accessed by the UPS service. - {$EXTERNALSYM NERR_UPSDriverNotStarted} - NERR_UPSInvalidConfig = (NERR_BASE+381); // The UPS service is not configured correctly. - {$EXTERNALSYM NERR_UPSInvalidConfig} - NERR_UPSInvalidCommPort = (NERR_BASE+382); // The UPS service could not access the specified Comm Port. - {$EXTERNALSYM NERR_UPSInvalidCommPort} - NERR_UPSSignalAsserted = (NERR_BASE+383); // The UPS indicated a line fail or low battery situation. Service not started. - {$EXTERNALSYM NERR_UPSSignalAsserted} - NERR_UPSShutdownFailed = (NERR_BASE+384); // The UPS service failed to perform a system shut down. - {$EXTERNALSYM NERR_UPSShutdownFailed} - -// -// Remoteboot error codes. -// -// NERR_BASE + (400-419) -// Error codes 400 - 405 are used by RPLBOOT.SYS. -// Error codes 403, 407 - 416 are used by RPLLOADR.COM, -// Error code 417 is the alerter message of REMOTEBOOT (RPLSERVR.EXE). -// Error code 418 is for when REMOTEBOOT can't start -// Error code 419 is for a disallowed 2nd rpl connection -// - - NERR_BadDosRetCode = (NERR_BASE+400); // The program below returned an MS-DOS error code: - {$EXTERNALSYM NERR_BadDosRetCode} - NERR_ProgNeedsExtraMem = (NERR_BASE+401); // The program below needs more memory: - {$EXTERNALSYM NERR_ProgNeedsExtraMem} - NERR_BadDosFunction = (NERR_BASE+402); // The program below called an unsupported MS-DOS function: - {$EXTERNALSYM NERR_BadDosFunction} - NERR_RemoteBootFailed = (NERR_BASE+403); // The workstation failed to boot. - {$EXTERNALSYM NERR_RemoteBootFailed} - NERR_BadFileCheckSum = (NERR_BASE+404); // The file below is corrupt. - {$EXTERNALSYM NERR_BadFileCheckSum} - NERR_NoRplBootSystem = (NERR_BASE+405); // No loader is specified in the boot-block definition file. - {$EXTERNALSYM NERR_NoRplBootSystem} - NERR_RplLoadrNetBiosErr = (NERR_BASE+406); // NetBIOS returned an error: The NCB and SMB are dumped above. - {$EXTERNALSYM NERR_RplLoadrNetBiosErr} - NERR_RplLoadrDiskErr = (NERR_BASE+407); // A disk I/O error occurred. - {$EXTERNALSYM NERR_RplLoadrDiskErr} - NERR_ImageParamErr = (NERR_BASE+408); // Image parameter substitution failed. - {$EXTERNALSYM NERR_ImageParamErr} - NERR_TooManyImageParams = (NERR_BASE+409); // Too many image parameters cross disk sector boundaries. - {$EXTERNALSYM NERR_TooManyImageParams} - NERR_NonDosFloppyUsed = (NERR_BASE+410); // The image was not generated from an MS-DOS diskette formatted with /S. - {$EXTERNALSYM NERR_NonDosFloppyUsed} - NERR_RplBootRestart = (NERR_BASE+411); // Remote boot will be restarted later. - {$EXTERNALSYM NERR_RplBootRestart} - NERR_RplSrvrCallFailed = (NERR_BASE+412); // The call to the Remoteboot server failed. - {$EXTERNALSYM NERR_RplSrvrCallFailed} - NERR_CantConnectRplSrvr = (NERR_BASE+413); // Cannot connect to the Remoteboot server. - {$EXTERNALSYM NERR_CantConnectRplSrvr} - NERR_CantOpenImageFile = (NERR_BASE+414); // Cannot open image file on the Remoteboot server. - {$EXTERNALSYM NERR_CantOpenImageFile} - NERR_CallingRplSrvr = (NERR_BASE+415); // Connecting to the Remoteboot server... - {$EXTERNALSYM NERR_CallingRplSrvr} - NERR_StartingRplBoot = (NERR_BASE+416); // Connecting to the Remoteboot server... - {$EXTERNALSYM NERR_StartingRplBoot} - NERR_RplBootServiceTerm = (NERR_BASE+417); // Remote boot service was stopped; check the error log for the cause of the problem. - {$EXTERNALSYM NERR_RplBootServiceTerm} - NERR_RplBootStartFailed = (NERR_BASE+418); // Remote boot startup failed; check the error log for the cause of the problem. - {$EXTERNALSYM NERR_RplBootStartFailed} - NERR_RPL_CONNECTED = (NERR_BASE+419); // A second connection to a Remoteboot resource is not allowed. - {$EXTERNALSYM NERR_RPL_CONNECTED} - -// -// FTADMIN API error codes -// -// NERR_BASE + (425-434) -// -// (Currently not used in NT) -// - - -// -// Browser service API error codes -// -// NERR_BASE + (450-475) -// - - NERR_BrowserConfiguredToNotRun = (NERR_BASE+450); // The browser service was configured with MaintainServerList=No. - {$EXTERNALSYM NERR_BrowserConfiguredToNotRun} - -// -// Additional Remoteboot error codes. -// -// NERR_BASE + (510-550) - - NERR_RplNoAdaptersStarted = (NERR_BASE+510); // Service failed to start since none of the network adapters started with this service. - {$EXTERNALSYM NERR_RplNoAdaptersStarted} - NERR_RplBadRegistry = (NERR_BASE+511); // Service failed to start due to bad startup information in the registry. - {$EXTERNALSYM NERR_RplBadRegistry} - NERR_RplBadDatabase = (NERR_BASE+512); // Service failed to start because its database is absent or corrupt. - {$EXTERNALSYM NERR_RplBadDatabase} - NERR_RplRplfilesShare = (NERR_BASE+513); // Service failed to start because RPLFILES share is absent. - {$EXTERNALSYM NERR_RplRplfilesShare} - NERR_RplNotRplServer = (NERR_BASE+514); // Service failed to start because RPLUSER group is absent. - {$EXTERNALSYM NERR_RplNotRplServer} - NERR_RplCannotEnum = (NERR_BASE+515); // Cannot enumerate service records. - {$EXTERNALSYM NERR_RplCannotEnum} - NERR_RplWkstaInfoCorrupted = (NERR_BASE+516); // Workstation record information has been corrupted. - {$EXTERNALSYM NERR_RplWkstaInfoCorrupted} - NERR_RplWkstaNotFound = (NERR_BASE+517); // Workstation record was not found. - {$EXTERNALSYM NERR_RplWkstaNotFound} - NERR_RplWkstaNameUnavailable = (NERR_BASE+518); // Workstation name is in use by some other workstation. - {$EXTERNALSYM NERR_RplWkstaNameUnavailable} - NERR_RplProfileInfoCorrupted = (NERR_BASE+519); // Profile record information has been corrupted. - {$EXTERNALSYM NERR_RplProfileInfoCorrupted} - NERR_RplProfileNotFound = (NERR_BASE+520); // Profile record was not found. - {$EXTERNALSYM NERR_RplProfileNotFound} - NERR_RplProfileNameUnavailable = (NERR_BASE+521); // Profile name is in use by some other profile. - {$EXTERNALSYM NERR_RplProfileNameUnavailable} - NERR_RplProfileNotEmpty = (NERR_BASE+522); // There are workstations using this profile. - {$EXTERNALSYM NERR_RplProfileNotEmpty} - NERR_RplConfigInfoCorrupted = (NERR_BASE+523); // Configuration record information has been corrupted. - {$EXTERNALSYM NERR_RplConfigInfoCorrupted} - NERR_RplConfigNotFound = (NERR_BASE+524); // Configuration record was not found. - {$EXTERNALSYM NERR_RplConfigNotFound} - NERR_RplAdapterInfoCorrupted = (NERR_BASE+525); // Adapter id record information has been corrupted. - {$EXTERNALSYM NERR_RplAdapterInfoCorrupted} - NERR_RplInternal = (NERR_BASE+526); // An internal service error has occurred. - {$EXTERNALSYM NERR_RplInternal} - NERR_RplVendorInfoCorrupted = (NERR_BASE+527); // Vendor id record information has been corrupted. - {$EXTERNALSYM NERR_RplVendorInfoCorrupted} - NERR_RplBootInfoCorrupted = (NERR_BASE+528); // Boot block record information has been corrupted. - {$EXTERNALSYM NERR_RplBootInfoCorrupted} - NERR_RplWkstaNeedsUserAcct = (NERR_BASE+529); // The user account for this workstation record is missing. - {$EXTERNALSYM NERR_RplWkstaNeedsUserAcct} - NERR_RplNeedsRPLUSERAcct = (NERR_BASE+530); // The RPLUSER local group could not be found. - {$EXTERNALSYM NERR_RplNeedsRPLUSERAcct} - NERR_RplBootNotFound = (NERR_BASE+531); // Boot block record was not found. - {$EXTERNALSYM NERR_RplBootNotFound} - NERR_RplIncompatibleProfile = (NERR_BASE+532); // Chosen profile is incompatible with this workstation. - {$EXTERNALSYM NERR_RplIncompatibleProfile} - NERR_RplAdapterNameUnavailable = (NERR_BASE+533); // Chosen network adapter id is in use by some other workstation. - {$EXTERNALSYM NERR_RplAdapterNameUnavailable} - NERR_RplConfigNotEmpty = (NERR_BASE+534); // There are profiles using this configuration. - {$EXTERNALSYM NERR_RplConfigNotEmpty} - NERR_RplBootInUse = (NERR_BASE+535); // There are workstations, profiles or configurations using this boot block. - {$EXTERNALSYM NERR_RplBootInUse} - NERR_RplBackupDatabase = (NERR_BASE+536); // Service failed to backup Remoteboot database. - {$EXTERNALSYM NERR_RplBackupDatabase} - NERR_RplAdapterNotFound = (NERR_BASE+537); // Adapter record was not found. - {$EXTERNALSYM NERR_RplAdapterNotFound} - NERR_RplVendorNotFound = (NERR_BASE+538); // Vendor record was not found. - {$EXTERNALSYM NERR_RplVendorNotFound} - NERR_RplVendorNameUnavailable = (NERR_BASE+539); // Vendor name is in use by some other vendor record. - {$EXTERNALSYM NERR_RplVendorNameUnavailable} - NERR_RplBootNameUnavailable = (NERR_BASE+540); // (boot name, vendor id) is in use by some other boot block record. - {$EXTERNALSYM NERR_RplBootNameUnavailable} - NERR_RplConfigNameUnavailable = (NERR_BASE+541); // Configuration name is in use by some other configuration. - {$EXTERNALSYM NERR_RplConfigNameUnavailable} - -//*INTERNAL_ONLY* - -// -// Dfs API error codes. -// -// NERR_BASE + (560-590) - - - NERR_DfsInternalCorruption = (NERR_BASE+560); // The internal database maintained by the DFS service is corrupt - {$EXTERNALSYM NERR_DfsInternalCorruption} - NERR_DfsVolumeDataCorrupt = (NERR_BASE+561); // One of the records in the internal DFS database is corrupt - {$EXTERNALSYM NERR_DfsVolumeDataCorrupt} - NERR_DfsNoSuchVolume = (NERR_BASE+562); // There is no DFS name whose entry path matches the input Entry Path - {$EXTERNALSYM NERR_DfsNoSuchVolume} - NERR_DfsVolumeAlreadyExists = (NERR_BASE+563); // A root or link with the given name already exists - {$EXTERNALSYM NERR_DfsVolumeAlreadyExists} - NERR_DfsAlreadyShared = (NERR_BASE+564); // The server share specified is already shared in the DFS - {$EXTERNALSYM NERR_DfsAlreadyShared} - NERR_DfsNoSuchShare = (NERR_BASE+565); // The indicated server share does not support the indicated DFS namespace - {$EXTERNALSYM NERR_DfsNoSuchShare} - NERR_DfsNotALeafVolume = (NERR_BASE+566); // The operation is not valid on this portion of the namespace - {$EXTERNALSYM NERR_DfsNotALeafVolume} - NERR_DfsLeafVolume = (NERR_BASE+567); // The operation is not valid on this portion of the namespace - {$EXTERNALSYM NERR_DfsLeafVolume} - NERR_DfsVolumeHasMultipleServers = (NERR_BASE+568); // The operation is ambiguous because the link has multiple servers - {$EXTERNALSYM NERR_DfsVolumeHasMultipleServers} - NERR_DfsCantCreateJunctionPoint = (NERR_BASE+569); // Unable to create a link - {$EXTERNALSYM NERR_DfsCantCreateJunctionPoint} - NERR_DfsServerNotDfsAware = (NERR_BASE+570); // The server is not DFS Aware - {$EXTERNALSYM NERR_DfsServerNotDfsAware} - NERR_DfsBadRenamePath = (NERR_BASE+571); // The specified rename target path is invalid - {$EXTERNALSYM NERR_DfsBadRenamePath} - NERR_DfsVolumeIsOffline = (NERR_BASE+572); // The specified DFS link is offline - {$EXTERNALSYM NERR_DfsVolumeIsOffline} - NERR_DfsNoSuchServer = (NERR_BASE+573); // The specified server is not a server for this link - {$EXTERNALSYM NERR_DfsNoSuchServer} - NERR_DfsCyclicalName = (NERR_BASE+574); // A cycle in the DFS name was detected - {$EXTERNALSYM NERR_DfsCyclicalName} - NERR_DfsNotSupportedInServerDfs = (NERR_BASE+575); // The operation is not supported on a server-based DFS - {$EXTERNALSYM NERR_DfsNotSupportedInServerDfs} - NERR_DfsDuplicateService = (NERR_BASE+576); // This link is already supported by the specified server-share - {$EXTERNALSYM NERR_DfsDuplicateService} - NERR_DfsCantRemoveLastServerShare = (NERR_BASE+577); // Can't remove the last server-share supporting this root or link - {$EXTERNALSYM NERR_DfsCantRemoveLastServerShare} - NERR_DfsVolumeIsInterDfs = (NERR_BASE+578); // The operation is not supported for an Inter-DFS link - {$EXTERNALSYM NERR_DfsVolumeIsInterDfs} - NERR_DfsInconsistent = (NERR_BASE+579); // The internal state of the DFS Service has become inconsistent - {$EXTERNALSYM NERR_DfsInconsistent} - NERR_DfsServerUpgraded = (NERR_BASE+580); // The DFS Service has been installed on the specified server - {$EXTERNALSYM NERR_DfsServerUpgraded} - NERR_DfsDataIsIdentical = (NERR_BASE+581); // The DFS data being reconciled is identical - {$EXTERNALSYM NERR_DfsDataIsIdentical} - NERR_DfsCantRemoveDfsRoot = (NERR_BASE+582); // The DFS root cannot be deleted - Uninstall DFS if required - {$EXTERNALSYM NERR_DfsCantRemoveDfsRoot} - NERR_DfsChildOrParentInDfs = (NERR_BASE+583); // A child or parent directory of the share is already in a DFS - {$EXTERNALSYM NERR_DfsChildOrParentInDfs} - NERR_DfsInternalError = (NERR_BASE+590); // DFS internal error - {$EXTERNALSYM NERR_DfsInternalError} - -// -// Net setup error codes. -// -// NERR_BASE + (591-600) - - NERR_SetupAlreadyJoined = (NERR_BASE+591); // This machine is already joined to a domain. - {$EXTERNALSYM NERR_SetupAlreadyJoined} - NERR_SetupNotJoined = (NERR_BASE+592); // This machine is not currently joined to a domain. - {$EXTERNALSYM NERR_SetupNotJoined} - NERR_SetupDomainController = (NERR_BASE+593); // This machine is a domain controller and cannot be unjoined from a domain. - {$EXTERNALSYM NERR_SetupDomainController} - NERR_DefaultJoinRequired = (NERR_BASE+594); // The destination domain controller does not support creating machine accounts in OUs. - {$EXTERNALSYM NERR_DefaultJoinRequired} - NERR_InvalidWorkgroupName = (NERR_BASE+595); // The specified workgroup name is invalid. - {$EXTERNALSYM NERR_InvalidWorkgroupName} - NERR_NameUsesIncompatibleCodePage = (NERR_BASE+596); // The specified computer name is incompatible with the default language used on the domain controller. - {$EXTERNALSYM NERR_NameUsesIncompatibleCodePage} - NERR_ComputerAccountNotFound = (NERR_BASE+597); // The specified computer account could not be found. - {$EXTERNALSYM NERR_ComputerAccountNotFound} - NERR_PersonalSku = (NERR_BASE+598); // This version of Windows cannot be joined to a domain. - {$EXTERNALSYM NERR_PersonalSku} - -// -// Some Password and account error results -// -// NERR_BASE + (601 - 608) -// - - NERR_PasswordMustChange = (NERR_BASE + 601); // Password must change at next logon - {$EXTERNALSYM NERR_PasswordMustChange} - NERR_AccountLockedOut = (NERR_BASE + 602); // Account is locked out - {$EXTERNALSYM NERR_AccountLockedOut} - NERR_PasswordTooLong = (NERR_BASE + 603); // Password is too long - {$EXTERNALSYM NERR_PasswordTooLong} - NERR_PasswordNotComplexEnough = (NERR_BASE + 604); // Password doesn't meet the complexity policy - {$EXTERNALSYM NERR_PasswordNotComplexEnough} - NERR_PasswordFilterError = (NERR_BASE + 605); // Password doesn't meet the requirements of the filter dll's - {$EXTERNALSYM NERR_PasswordFilterError} - -//**********WARNING **************** -//The range 2750-2799 has been * -//allocated to the IBM LAN Server * -//********************************* - -//**********WARNING **************** -//The range 2900-2999 has been * -//reserved for Microsoft OEMs * -//********************************* - -//*END_INTERNAL* - - MAX_NERR = (NERR_BASE+899); // This is the last error in NERR range. - {$EXTERNALSYM MAX_NERR} - -// -// end of list -// -// WARNING: Do not exceed MAX_NERR; values above this are used by -// other error code ranges (errlog.h, service.h, apperr.h). - -// JwaLmCons, complete -// LAN Manager common definitions - -const - NetApi32 = 'netapi32.dll'; - -// -// NOTE: Lengths of strings are given as the maximum lengths of the -// string in characters (not bytes). This does not include space for the -// terminating 0-characters. When allocating space for such an item, -// use the form: -// -// TCHAR username[UNLEN+1]; -// -// Definitions of the form LN20_* define those values in effect for -// LanMan 2.0. -// - -// -// String Lengths for various LanMan names -// - -const - CNLEN = 15; // Computer name length - {$EXTERNALSYM CNLEN} - LM20_CNLEN = 15; // LM 2.0 Computer name length - {$EXTERNALSYM LM20_CNLEN} - DNLEN = CNLEN; // Maximum domain name length - {$EXTERNALSYM DNLEN} - LM20_DNLEN = LM20_CNLEN; // LM 2.0 Maximum domain name length - {$EXTERNALSYM LM20_DNLEN} - -//#if (CNLEN != DNLEN) -//#error CNLEN and DNLEN are not equal -//#endif - - UNCLEN = (CNLEN+2); // UNC computer name length - {$EXTERNALSYM UNCLEN} - LM20_UNCLEN = (LM20_CNLEN+2); // LM 2.0 UNC computer name length - {$EXTERNALSYM LM20_UNCLEN} - - NNLEN = 80; // Net name length (share name) - {$EXTERNALSYM NNLEN} - LM20_NNLEN = 12; // LM 2.0 Net name length - {$EXTERNALSYM LM20_NNLEN} - - RMLEN = (UNCLEN+1+NNLEN); // Max remote name length - {$EXTERNALSYM RMLEN} - LM20_RMLEN = (LM20_UNCLEN+1+LM20_NNLEN); // LM 2.0 Max remote name length - {$EXTERNALSYM LM20_RMLEN} - - SNLEN = 80; // Service name length - {$EXTERNALSYM SNLEN} - LM20_SNLEN = 15; // LM 2.0 Service name length - {$EXTERNALSYM LM20_SNLEN} - STXTLEN = 256; // Service text length - {$EXTERNALSYM STXTLEN} - LM20_STXTLEN = 63; // LM 2.0 Service text length - {$EXTERNALSYM LM20_STXTLEN} - - PATHLEN = 256; // Max. path (not including drive name) - {$EXTERNALSYM PATHLEN} - LM20_PATHLEN = 256; // LM 2.0 Max. path - {$EXTERNALSYM LM20_PATHLEN} - - DEVLEN = 80; // Device name length - {$EXTERNALSYM DEVLEN} - LM20_DEVLEN = 8; // LM 2.0 Device name length - {$EXTERNALSYM LM20_DEVLEN} - - EVLEN = 16; // Event name length - {$EXTERNALSYM EVLEN} - -// -// User, Group and Password lengths -// - - UNLEN = 256; // Maximum user name length - {$EXTERNALSYM UNLEN} - LM20_UNLEN = 20; // LM 2.0 Maximum user name length - {$EXTERNALSYM LM20_UNLEN} - - GNLEN = UNLEN; // Group name - {$EXTERNALSYM GNLEN} - LM20_GNLEN = LM20_UNLEN; // LM 2.0 Group name - {$EXTERNALSYM LM20_GNLEN} - - PWLEN = 256; // Maximum password length - {$EXTERNALSYM PWLEN} - LM20_PWLEN = 14; // LM 2.0 Maximum password length - {$EXTERNALSYM LM20_PWLEN} - - SHPWLEN = 8; // Share password length (bytes) - {$EXTERNALSYM SHPWLEN} - - CLTYPE_LEN = 12; // Length of client type string - {$EXTERNALSYM CLTYPE_LEN} - - MAXCOMMENTSZ = 256; // Multipurpose comment length - {$EXTERNALSYM MAXCOMMENTSZ} - LM20_MAXCOMMENTSZ = 48; // LM 2.0 Multipurpose comment length - {$EXTERNALSYM LM20_MAXCOMMENTSZ} - - QNLEN = NNLEN; // Queue name maximum length - {$EXTERNALSYM QNLEN} - LM20_QNLEN = LM20_NNLEN; // LM 2.0 Queue name maximum length - {$EXTERNALSYM LM20_QNLEN} - -//#if (QNLEN != NNLEN) -//# error QNLEN and NNLEN are not equal -//#endif - -// -// The ALERTSZ and MAXDEVENTRIES defines have not yet been NT'ized. -// Whoever ports these components should change these values appropriately. -// - - ALERTSZ = 128; // size of alert string in server - {$EXTERNALSYM ALERTSZ} - MAXDEVENTRIES = (SizeOf(Integer)*8); // Max number of device entries - {$EXTERNALSYM MAXDEVENTRIES} - - // - // We use int bitmap to represent - // - - NETBIOS_NAME_LEN = 16; // NetBIOS net name (bytes) - {$EXTERNALSYM NETBIOS_NAME_LEN} - -// -// Value to be used with APIs which have a "preferred maximum length" -// parameter. This value indicates that the API should just allocate -// "as much as it takes." -// - - MAX_PREFERRED_LENGTH = DWORD(-1); - {$EXTERNALSYM MAX_PREFERRED_LENGTH} - -// -// Constants used with encryption -// - - CRYPT_KEY_LEN = 7; - {$EXTERNALSYM CRYPT_KEY_LEN} - CRYPT_TXT_LEN = 8; - {$EXTERNALSYM CRYPT_TXT_LEN} - ENCRYPTED_PWLEN = 16; - {$EXTERNALSYM ENCRYPTED_PWLEN} - SESSION_PWLEN = 24; - {$EXTERNALSYM SESSION_PWLEN} - SESSION_CRYPT_KLEN = 21; - {$EXTERNALSYM SESSION_CRYPT_KLEN} - -// -// Value to be used with SetInfo calls to allow setting of all -// settable parameters (parmnum zero option) -// - - PARMNUM_ALL = 0; - {$EXTERNALSYM PARMNUM_ALL} - - PARM_ERROR_UNKNOWN = DWORD(-1); - {$EXTERNALSYM PARM_ERROR_UNKNOWN} - PARM_ERROR_NONE = 0; - {$EXTERNALSYM PARM_ERROR_NONE} - PARMNUM_BASE_INFOLEVEL = 1000; - {$EXTERNALSYM PARMNUM_BASE_INFOLEVEL} - -// -// Only the UNICODE version of the LM APIs are available on NT. -// Non-UNICODE version on other platforms -// - -//#if defined( _WIN32_WINNT ) || defined( WINNT ) || defined( FORCE_UNICODE ) - -{$IFDEF _WIN32_WINNT} -{$DEFINE LM_USE_UNICODE} -{$ENDIF} - -{$IFDEF FORCE_UNICODE} -{$DEFINE LM_USE_UNICODE} -{$ENDIF} - -{$IFDEF LM_USE_UNICODE} - -type - LMSTR = LPWSTR; - {$EXTERNALSYM LMSTR} - LMCSTR = LPCWSTR; - {$EXTERNALSYM LMCSTR} - PLMSTR = ^LMSTR; - {$NODEFINE PLMSTR} - -{$ELSE ~LM_USE_UNICODE} - -type - LMSTR = LPSTR; - {$EXTERNALSYM LMSTR} - LMCSTR = LPCSTR; - {$EXTERNALSYM LMCSTR} - -{$ENDIF ~LM_USE_UNICODE} - -// -// Message File Names -// - -const - MESSAGE_FILENAME = 'NETMSG'; - {$EXTERNALSYM MESSAGE_FILENAME} - OS2MSG_FILENAME = 'BASE'; - {$EXTERNALSYM OS2MSG_FILENAME} - HELP_MSG_FILENAME = 'NETH'; - {$EXTERNALSYM HELP_MSG_FILENAME} - -// ** INTERNAL_ONLY ** - -// The backup message file named here is a duplicate of net.msg. It -// is not shipped with the product, but is used at buildtime to -// msgbind certain messages to netapi.dll and some of the services. -// This allows for OEMs to modify the message text in net.msg and -// have those changes show up. Only in case there is an error in -// retrieving the messages from net.msg do we then get the bound -// messages out of bak.msg (really out of the message segment). - - BACKUP_MSG_FILENAME = 'BAK.MSG'; - {$EXTERNALSYM BACKUP_MSG_FILENAME} - -// ** END_INTERNAL ** - -// -// Keywords used in Function Prototypes -// - -type - NET_API_STATUS = DWORD; - {$EXTERNALSYM NET_API_STATUS} - TNetApiStatus = NET_API_STATUS; - -// -// The platform ID indicates the levels to use for platform-specific -// information. -// - -const - PLATFORM_ID_DOS = 300; - {$EXTERNALSYM PLATFORM_ID_DOS} - PLATFORM_ID_OS2 = 400; - {$EXTERNALSYM PLATFORM_ID_OS2} - PLATFORM_ID_NT = 500; - {$EXTERNALSYM PLATFORM_ID_NT} - PLATFORM_ID_OSF = 600; - {$EXTERNALSYM PLATFORM_ID_OSF} - PLATFORM_ID_VMS = 700; - {$EXTERNALSYM PLATFORM_ID_VMS} - -// -// There message numbers assigned to different LANMAN components -// are as defined below. -// -// lmerr.h: 2100 - 2999 NERR_BASE -// alertmsg.h: 3000 - 3049 ALERT_BASE -// lmsvc.h: 3050 - 3099 SERVICE_BASE -// lmerrlog.h: 3100 - 3299 ERRLOG_BASE -// msgtext.h: 3300 - 3499 MTXT_BASE -// apperr.h: 3500 - 3999 APPERR_BASE -// apperrfs.h: 4000 - 4299 APPERRFS_BASE -// apperr2.h: 4300 - 5299 APPERR2_BASE -// ncberr.h: 5300 - 5499 NRCERR_BASE -// alertmsg.h: 5500 - 5599 ALERT2_BASE -// lmsvc.h: 5600 - 5699 SERVICE2_BASE -// lmerrlog.h 5700 - 5899 ERRLOG2_BASE -// - - MIN_LANMAN_MESSAGE_ID = NERR_BASE; - {$EXTERNALSYM MIN_LANMAN_MESSAGE_ID} - MAX_LANMAN_MESSAGE_ID = 5899; - {$EXTERNALSYM MAX_LANMAN_MESSAGE_ID} - -// line 59 - -// -// Function Prototypes - User -// - - -function NetUserAdd(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetUserAdd} - -function NetUserEnum(servername: LPCWSTR; level, filter: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries, resume_handle: LPDWORD): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetUserEnum} - -function NetUserGetInfo(servername, username: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetUserGetInfo} - -function NetUserSetInfo(servername, username: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetUserSetInfo} - -function NetUserDel(servername: LPCWSTR; username: LPCWSTR): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetUserDel} - -function NetUserGetGroups(servername, username: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetUserGetGroups} - -function NetUserSetGroups(servername, username: LPCWSTR; level: DWORD; buf: PByte; num_entries: DWORD): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetUserSetGroups} - -function NetUserGetLocalGroups(servername, username: LPCWSTR; level, flags: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetUserGetLocalGroups} - -function NetUserModalsGet(servername: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetUserModalsGet} - -function NetUserModalsSet(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetUserModalsSet} - -function NetUserChangePassword(domainname, username, oldpassword, newpassword: LPCWSTR): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetUserChangePassword} - - -// -// Data Structures - User -// - -type - {$IFNDEF FPC} - LPUSER_INFO_0 = ^USER_INFO_0; - {$EXTERNALSYM LPUSER_INFO_0} - PUSER_INFO_0 = ^USER_INFO_0; - {$EXTERNALSYM PUSER_INFO_0} - _USER_INFO_0 = record - usri0_name: LPWSTR; - end; - {$EXTERNALSYM _USER_INFO_0} - USER_INFO_0 = _USER_INFO_0; - {$EXTERNALSYM USER_INFO_0} - TUserInfo0 = USER_INFO_0; - PUserInfo0 = PUSER_INFO_0; - {$ENDIF ~FPC} - - LPUSER_INFO_1 = ^USER_INFO_1; - {$EXTERNALSYM LPUSER_INFO_1} - PUSER_INFO_1 = ^USER_INFO_1; - {$EXTERNALSYM PUSER_INFO_1} - _USER_INFO_1 = record - usri1_name: LPWSTR; - usri1_password: LPWSTR; - usri1_password_age: DWORD; - usri1_priv: DWORD; - usri1_home_dir: LPWSTR; - usri1_comment: LPWSTR; - usri1_flags: DWORD; - usri1_script_path: LPWSTR; - end; - {$EXTERNALSYM _USER_INFO_1} - USER_INFO_1 = _USER_INFO_1; - {$EXTERNALSYM USER_INFO_1} - TUserInfo1 = USER_INFO_1; - PUserInfo1 = PUSER_INFO_1; - - {$IFNDEF FPC} - LPUSER_INFO_2 = ^USER_INFO_2; - {$EXTERNALSYM LPUSER_INFO_2} - PUSER_INFO_2 = ^USER_INFO_2; - {$EXTERNALSYM PUSER_INFO_2} - _USER_INFO_2 = record - usri2_name: LPWSTR; - usri2_password: LPWSTR; - usri2_password_age: DWORD; - usri2_priv: DWORD; - usri2_home_dir: LPWSTR; - usri2_comment: LPWSTR; - usri2_flags: DWORD; - usri2_script_path: LPWSTR; - usri2_auth_flags: DWORD; - usri2_full_name: LPWSTR; - usri2_usr_comment: LPWSTR; - usri2_parms: LPWSTR; - usri2_workstations: LPWSTR; - usri2_last_logon: DWORD; - usri2_last_logoff: DWORD; - usri2_acct_expires: DWORD; - usri2_max_storage: DWORD; - usri2_units_per_week: DWORD; - usri2_logon_hours: PBYTE; - usri2_bad_pw_count: DWORD; - usri2_num_logons: DWORD; - usri2_logon_server: LPWSTR; - usri2_country_code: DWORD; - usri2_code_page: DWORD; - end; - {$EXTERNALSYM _USER_INFO_2} - USER_INFO_2 = _USER_INFO_2; - {$EXTERNALSYM USER_INFO_2} - TUserInfo2 = USER_INFO_2; - PUserInfo2 = puser_info_2; - {$ENDIF ~FPC} - -// line 799 - -// -// Special Values and Constants - User -// - -// -// Bit masks for field usriX_flags of USER_INFO_X (X = 0/1). -// - -const - UF_SCRIPT = $0001; - {$EXTERNALSYM UF_SCRIPT} - UF_ACCOUNTDISABLE = $0002; - {$EXTERNALSYM UF_ACCOUNTDISABLE} - UF_HOMEDIR_REQUIRED = $0008; - {$EXTERNALSYM UF_HOMEDIR_REQUIRED} - UF_LOCKOUT = $0010; - {$EXTERNALSYM UF_LOCKOUT} - UF_PASSWD_NOTREQD = $0020; - {$EXTERNALSYM UF_PASSWD_NOTREQD} - UF_PASSWD_CANT_CHANGE = $0040; - {$EXTERNALSYM UF_PASSWD_CANT_CHANGE} - UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED = $0080; - {$EXTERNALSYM UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED} - -// -// Account type bits as part of usri_flags. -// - - UF_TEMP_DUPLICATE_ACCOUNT = $0100; - {$EXTERNALSYM UF_TEMP_DUPLICATE_ACCOUNT} - UF_NORMAL_ACCOUNT = $0200; - {$EXTERNALSYM UF_NORMAL_ACCOUNT} - UF_INTERDOMAIN_TRUST_ACCOUNT = $0800; - {$EXTERNALSYM UF_INTERDOMAIN_TRUST_ACCOUNT} - UF_WORKSTATION_TRUST_ACCOUNT = $1000; - {$EXTERNALSYM UF_WORKSTATION_TRUST_ACCOUNT} - UF_SERVER_TRUST_ACCOUNT = $2000; - {$EXTERNALSYM UF_SERVER_TRUST_ACCOUNT} - - UF_MACHINE_ACCOUNT_MASK = UF_INTERDOMAIN_TRUST_ACCOUNT or UF_WORKSTATION_TRUST_ACCOUNT or UF_SERVER_TRUST_ACCOUNT; - {$EXTERNALSYM UF_MACHINE_ACCOUNT_MASK} - - UF_ACCOUNT_TYPE_MASK = UF_TEMP_DUPLICATE_ACCOUNT or UF_NORMAL_ACCOUNT or - UF_INTERDOMAIN_TRUST_ACCOUNT or UF_WORKSTATION_TRUST_ACCOUNT or UF_SERVER_TRUST_ACCOUNT; - {$EXTERNALSYM UF_ACCOUNT_TYPE_MASK} - - UF_DONT_EXPIRE_PASSWD = $10000; - {$EXTERNALSYM UF_DONT_EXPIRE_PASSWD} - UF_MNS_LOGON_ACCOUNT = $20000; - {$EXTERNALSYM UF_MNS_LOGON_ACCOUNT} - UF_SMARTCARD_REQUIRED = $40000; - {$EXTERNALSYM UF_SMARTCARD_REQUIRED} - UF_TRUSTED_FOR_DELEGATION = $80000; - {$EXTERNALSYM UF_TRUSTED_FOR_DELEGATION} - UF_NOT_DELEGATED = $100000; - {$EXTERNALSYM UF_NOT_DELEGATED} - UF_USE_DES_KEY_ONLY = $200000; - {$EXTERNALSYM UF_USE_DES_KEY_ONLY} - UF_DONT_REQUIRE_PREAUTH = $400000; - {$EXTERNALSYM UF_DONT_REQUIRE_PREAUTH} - UF_PASSWORD_EXPIRED = DWORD($800000); - {$EXTERNALSYM UF_PASSWORD_EXPIRED} - UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION = $1000000; - {$EXTERNALSYM UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION} - - - UF_SETTABLE_BITS = - UF_SCRIPT or - UF_ACCOUNTDISABLE or - UF_LOCKOUT or - UF_HOMEDIR_REQUIRED or - UF_PASSWD_NOTREQD or - UF_PASSWD_CANT_CHANGE or - UF_ACCOUNT_TYPE_MASK or - UF_DONT_EXPIRE_PASSWD or - UF_MNS_LOGON_ACCOUNT or - UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED or - UF_SMARTCARD_REQUIRED or - UF_TRUSTED_FOR_DELEGATION or - UF_NOT_DELEGATED or - UF_USE_DES_KEY_ONLY or - UF_DONT_REQUIRE_PREAUTH or - UF_PASSWORD_EXPIRED or - UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION; - {$EXTERNALSYM UF_SETTABLE_BITS} - -// line 1056 - -// -// For SetInfo call (parmnum 0) when password change not required -// - - NULL_USERSETINFO_PASSWD = ' '; - {$EXTERNALSYM NULL_USERSETINFO_PASSWD} - - TIMEQ_FOREVER = ULONG(-1); - {$EXTERNALSYM TIMEQ_FOREVER} - USER_MAXSTORAGE_UNLIMITED = ULONG(-1); - {$EXTERNALSYM USER_MAXSTORAGE_UNLIMITED} - USER_NO_LOGOFF = ULONG(-1); - {$EXTERNALSYM USER_NO_LOGOFF} - UNITS_PER_DAY = 24; - {$EXTERNALSYM UNITS_PER_DAY} - UNITS_PER_WEEK = UNITS_PER_DAY * 7; - {$EXTERNALSYM UNITS_PER_WEEK} - -// -// Privilege levels (USER_INFO_X field usriX_priv (X = 0/1)). -// - - USER_PRIV_MASK = $3; - {$EXTERNALSYM USER_PRIV_MASK} - USER_PRIV_GUEST = 0; - {$EXTERNALSYM USER_PRIV_GUEST} - USER_PRIV_USER = 1; - {$EXTERNALSYM USER_PRIV_USER} - USER_PRIV_ADMIN = 2; - {$EXTERNALSYM USER_PRIV_ADMIN} - -// line 1177 - -// -// Group Class -// - -// -// Function Prototypes -// - - -function NetGroupAdd(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetGroupAdd} - -function NetGroupAddUser(servername, GroupName, username: LPCWSTR): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetGroupAddUser} - -function NetGroupEnum(servername: LPCWSTR; level: DWORD; out bufptr: PByte; - prefmaxlen: DWORD; out entriesread, totalentries: DWORD; resume_handle: PDWORD_PTR): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetGroupEnum} - -function NetGroupGetInfo(servername, groupname: LPCWSTR; level: DWORD; bufptr: PByte): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetGroupGetInfo} - -function NetGroupSetInfo(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetGroupSetInfo} - -function NetGroupDel(servername: LPCWSTR; groupname: LPCWSTR): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetGroupDel} - -function NetGroupDelUser(servername: LPCWSTR; GroupName: LPCWSTR; Username: LPCWSTR): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetGroupDelUser} - -function NetGroupGetUsers(servername, groupname: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD; ResumeHandle: PDWORD_PTR): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetGroupGetUsers} - -function NetGroupSetUsers(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetGroupSetUsers} - - -// -// Data Structures - Group -// - -type - LPGROUP_INFO_0 = ^GROUP_INFO_0; - {$EXTERNALSYM LPGROUP_INFO_0} - PGROUP_INFO_0 = ^GROUP_INFO_0; - {$EXTERNALSYM PGROUP_INFO_0} - _GROUP_INFO_0 = record - grpi0_name: LPWSTR; - end; - {$EXTERNALSYM _GROUP_INFO_0} - GROUP_INFO_0 = _GROUP_INFO_0; - {$EXTERNALSYM GROUP_INFO_0} - TGroupInfo0 = GROUP_INFO_0; - PGroupInfo0 = PGROUP_INFO_0; - - LPGROUP_INFO_1 = ^GROUP_INFO_1; - {$EXTERNALSYM LPGROUP_INFO_1} - PGROUP_INFO_1 = ^GROUP_INFO_1; - {$EXTERNALSYM PGROUP_INFO_1} - _GROUP_INFO_1 = record - grpi1_name: LPWSTR; - grpi1_comment: LPWSTR; - end; - {$EXTERNALSYM _GROUP_INFO_1} - GROUP_INFO_1 = _GROUP_INFO_1; - {$EXTERNALSYM GROUP_INFO_1} - TGroupInfo1 = GROUP_INFO_1; - PGroupInfo1 = PGROUP_INFO_1; - -// line 1380 - -// -// LocalGroup Class -// - -// -// Function Prototypes -// - - -function NetLocalGroupAdd(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetLocalGroupAdd} - -function NetLocalGroupAddMember(servername, groupname: LPCWSTR; membersid: PSID): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetLocalGroupAddMember} - -function NetLocalGroupEnum(servername: LPCWSTR; level: DWORD; out bufptr: PByte; - prefmaxlen: DWORD; out entriesread, totalentries: DWORD; resumehandle: PDWORD_PTR): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetLocalGroupEnum} - -function NetLocalGroupGetInfo(servername, groupname: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetLocalGroupGetInfo} - -function NetLocalGroupSetInfo(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetLocalGroupSetInfo} - -function NetLocalGroupDel(servername: LPCWSTR; groupname: LPCWSTR): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetLocalGroupDel} - -function NetLocalGroupDelMember(servername: LPCWSTR; groupname: LPCWSTR; membersid: PSID): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetLocalGroupDelMember} - -function NetLocalGroupGetMembers(servername, localgroupname: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD; resumehandle: PDWORD_PTR): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetLocalGroupGetMembers} - -function NetLocalGroupSetMembers(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetLocalGroupSetMembers} - -function NetLocalGroupAddMembers(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetLocalGroupAddMembers} - -function NetLocalGroupDelMembers(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetLocalGroupDelMembers} - - -// -// Data Structures - LocalGroup -// - -type - {$IFNDEF FPC} - LPLOCALGROUP_INFO_0 = ^LOCALGROUP_INFO_0; - {$EXTERNALSYM LPLOCALGROUP_INFO_0} - PLOCALGROUP_INFO_0 = ^LOCALGROUP_INFO_0; - {$EXTERNALSYM PLOCALGROUP_INFO_0} - _LOCALGROUP_INFO_0 = record - lgrpi0_name: LPWSTR; - end; - {$EXTERNALSYM _LOCALGROUP_INFO_0} - LOCALGROUP_INFO_0 = _LOCALGROUP_INFO_0; - {$EXTERNALSYM LOCALGROUP_INFO_0} - TLocalGroupInfo0 = LOCALGROUP_INFO_0; - PLocalGroupInfo0 = PLOCALGROUP_INFO_0; - {$ENDIF ~FPC} - - LPLOCALGROUP_INFO_1 = ^LOCALGROUP_INFO_1; - {$EXTERNALSYM LPLOCALGROUP_INFO_1} - PLOCALGROUP_INFO_1 = ^LOCALGROUP_INFO_1; - {$EXTERNALSYM PLOCALGROUP_INFO_1} - _LOCALGROUP_INFO_1 = record - lgrpi1_name: LPWSTR; - lgrpi1_comment: LPWSTR; - end; - {$EXTERNALSYM _LOCALGROUP_INFO_1} - LOCALGROUP_INFO_1 = _LOCALGROUP_INFO_1; - {$EXTERNALSYM LOCALGROUP_INFO_1} - TLocalGroupInfo1 = LOCALGROUP_INFO_1; - PLocalGroupInfo1 = PLOCALGROUP_INFO_1; - - LPLOCALGROUP_INFO_1002 = ^LOCALGROUP_INFO_1002; - {$EXTERNALSYM LPLOCALGROUP_INFO_1002} - PLOCALGROUP_INFO_1002 = ^LOCALGROUP_INFO_1002; - {$EXTERNALSYM PLOCALGROUP_INFO_1002} - _LOCALGROUP_INFO_1002 = record - lgrpi1002_comment: LPWSTR; - end; - {$EXTERNALSYM _LOCALGROUP_INFO_1002} - LOCALGROUP_INFO_1002 = _LOCALGROUP_INFO_1002; - {$EXTERNALSYM LOCALGROUP_INFO_1002} - TLocalGroupInfo1002 = LOCALGROUP_INFO_1002; - PLocalGroupInfo1002 = PLOCALGROUP_INFO_1002; - - {$IFNDEF FPC} - LPLOCALGROUP_MEMBERS_INFO_0 = ^LOCALGROUP_MEMBERS_INFO_0; - {$EXTERNALSYM LPLOCALGROUP_MEMBERS_INFO_0} - PLOCALGROUP_MEMBERS_INFO_0 = ^LOCALGROUP_MEMBERS_INFO_0; - {$EXTERNALSYM PLOCALGROUP_MEMBERS_INFO_0} - _LOCALGROUP_MEMBERS_INFO_0 = record - lgrmi0_sid: PSID; - end; - {$EXTERNALSYM _LOCALGROUP_MEMBERS_INFO_0} - LOCALGROUP_MEMBERS_INFO_0 = _LOCALGROUP_MEMBERS_INFO_0; - {$EXTERNALSYM LOCALGROUP_MEMBERS_INFO_0} - TLocalGroupMembersInfo0 = LOCALGROUP_MEMBERS_INFO_0; - PLocalGroupMembersInfo0 = PLOCALGROUP_MEMBERS_INFO_0; - {$ENDIF ~FPC} - - LPLOCALGROUP_MEMBERS_INFO_1 = ^LOCALGROUP_MEMBERS_INFO_1; - {$EXTERNALSYM LPLOCALGROUP_MEMBERS_INFO_1} - PLOCALGROUP_MEMBERS_INFO_1 = ^LOCALGROUP_MEMBERS_INFO_1; - {$EXTERNALSYM PLOCALGROUP_MEMBERS_INFO_1} - _LOCALGROUP_MEMBERS_INFO_1 = record - lgrmi1_sid: PSID; - lgrmi1_sidusage: SID_NAME_USE; - lgrmi1_name: LPWSTR; - end; - {$EXTERNALSYM _LOCALGROUP_MEMBERS_INFO_1} - LOCALGROUP_MEMBERS_INFO_1 = _LOCALGROUP_MEMBERS_INFO_1; - {$EXTERNALSYM LOCALGROUP_MEMBERS_INFO_1} - TLocalGroupMembersInfo1 = LOCALGROUP_MEMBERS_INFO_1; - PLocalGroupMembersInfo1 = PLOCALGROUP_MEMBERS_INFO_1; - - LPLOCALGROUP_MEMBERS_INFO_2 = ^LOCALGROUP_MEMBERS_INFO_2; - {$EXTERNALSYM LPLOCALGROUP_MEMBERS_INFO_2} - PLOCALGROUP_MEMBERS_INFO_2 = ^LOCALGROUP_MEMBERS_INFO_2; - {$EXTERNALSYM PLOCALGROUP_MEMBERS_INFO_2} - _LOCALGROUP_MEMBERS_INFO_2 = record - lgrmi2_sid: PSID; - lgrmi2_sidusage: SID_NAME_USE; - lgrmi2_domainandname: LPWSTR; - end; - {$EXTERNALSYM _LOCALGROUP_MEMBERS_INFO_2} - LOCALGROUP_MEMBERS_INFO_2 = _LOCALGROUP_MEMBERS_INFO_2; - {$EXTERNALSYM LOCALGROUP_MEMBERS_INFO_2} - TLocalGroupMembersInfo2 = LOCALGROUP_MEMBERS_INFO_2; - PLocalGroupMembersInfo2 = PLOCALGROUP_MEMBERS_INFO_2; - - {$IFNDEF FPC} - LPLOCALGROUP_MEMBERS_INFO_3 = ^LOCALGROUP_MEMBERS_INFO_3; - {$EXTERNALSYM LPLOCALGROUP_MEMBERS_INFO_3} - PLOCALGROUP_MEMBERS_INFO_3 = ^LOCALGROUP_MEMBERS_INFO_3; - {$EXTERNALSYM PLOCALGROUP_MEMBERS_INFO_3} - _LOCALGROUP_MEMBERS_INFO_3 = record - lgrmi3_domainandname: LPWSTR; - end; - {$EXTERNALSYM _LOCALGROUP_MEMBERS_INFO_3} - LOCALGROUP_MEMBERS_INFO_3 = _LOCALGROUP_MEMBERS_INFO_3; - {$EXTERNALSYM LOCALGROUP_MEMBERS_INFO_3} - TLocalGroupMembersInfo3 = LOCALGROUP_MEMBERS_INFO_3; - PLocalGroupMembersInfo3 = PLOCALGROUP_MEMBERS_INFO_3; - {$ENDIF ~FPC} - -function NetApiBufferFree(Buffer: Pointer): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetApiBufferFree} - -type - _WKSTA_INFO_100 = record - wki100_platform_id: DWORD; - wki100_computername: LMSTR; - wki100_langroup: LMSTR; - wki100_ver_major: DWORD; - wki100_ver_minor: DWORD; - end; - {$EXTERNALSYM _WKSTA_INFO_100} - WKSTA_INFO_100 = _WKSTA_INFO_100; - {$EXTERNALSYM WKSTA_INFO_100} - PWKSTA_INFO_100 = ^_WKSTA_INFO_100; - {$EXTERNALSYM PWKSTA_INFO_100} - LPWKSTA_INFO_100 = ^_WKSTA_INFO_100; - {$EXTERNALSYM LPWKSTA_INFO_100} - -function NetWkstaGetInfo(servername: PWideChar; level: DWORD; out bufptr: PByte): NET_API_STATUS; stdcall; -{$EXTERNALSYM NetWkstaGetInfo} - -(**************************************************************** - * * - * Data structure templates * - * * - ****************************************************************) - -const - NCBNAMSZ = 16; // absolute length of a net name - {$EXTERNALSYM NCBNAMSZ} - MAX_LANA = 254; // lana's in range 0 to MAX_LANA inclusive - {$EXTERNALSYM MAX_LANA} - -// -// Network Control Block -// - -type - {$IFNDEF FPC} - PNCB = ^NCB; - {$ENDIF ~FPC} - - TNcbPost = procedure (P: PNCB); stdcall; - - {$IFNDEF FPC} - _NCB = record - ncb_command: UCHAR; // command code - ncb_retcode: UCHAR; // return code - ncb_lsn: UCHAR; // local session number - ncb_num: UCHAR; // number of our network name - ncb_buffer: PUCHAR; // address of message buffer - ncb_length: Word; // size of message buffer - ncb_callname: array [0..NCBNAMSZ - 1] of UCHAR; // blank-padded name of remote - ncb_name: array [0..NCBNAMSZ - 1] of UCHAR; // our blank-padded netname - ncb_rto: UCHAR; // rcv timeout/retry count - ncb_sto: UCHAR; // send timeout/sys timeout - ncb_post: TNcbPost; // POST routine address - ncb_lana_num: UCHAR; // lana (adapter) number - ncb_cmd_cplt: UCHAR; // 0xff => commmand pending - {$IFDEF _WIN64} - ncb_reserve: array [0..17] of UCHAR; // reserved, used by BIOS - {$ELSE ~_WIN64} - ncb_reserve: array [0..9] of UCHAR; // reserved, used by BIOS - {$ENDIF ~_WIN64} - ncb_event: THandle; // HANDLE to Win32 event which - // will be set to the signalled - // state when an ASYNCH command - // completes - end; - {$EXTERNALSYM _NCB} - NCB = _NCB; - {$EXTERNALSYM NCB} - TNcb = NCB; - {$ENDIF ~FPC} - -// -// Structure returned to the NCB command NCBASTAT is ADAPTER_STATUS followed -// by an array of NAME_BUFFER structures. -// -{$IFNDEF FPC} -type - _ADAPTER_STATUS = record - adapter_address: array [0..5] of UCHAR; - rev_major: UCHAR; - reserved0: UCHAR; - adapter_type: UCHAR; - rev_minor: UCHAR; - duration: WORD; - frmr_recv: WORD; - frmr_xmit: WORD; - iframe_recv_err: WORD; - xmit_aborts: WORD; - xmit_success: DWORD; - recv_success: DWORD; - iframe_xmit_err: WORD; - recv_buff_unavail: WORD; - t1_timeouts: WORD; - ti_timeouts: WORD; - reserved1: DWORD; - free_ncbs: WORD; - max_cfg_ncbs: WORD; - max_ncbs: WORD; - xmit_buf_unavail: WORD; - max_dgram_size: WORD; - pending_sess: WORD; - max_cfg_sess: WORD; - max_sess: WORD; - max_sess_pkt_size: WORD; - name_count: WORD; - end; - {$EXTERNALSYM _ADAPTER_STATUS} - ADAPTER_STATUS = _ADAPTER_STATUS; - {$EXTERNALSYM ADAPTER_STATUS} - PADAPTER_STATUS = ^ADAPTER_STATUS; - {$EXTERNALSYM PADAPTER_STATUS} - TAdapterStatus = ADAPTER_STATUS; - PAdapterStatus = PADAPTER_STATUS; - - _NAME_BUFFER = record - name: array [0..NCBNAMSZ - 1] of UCHAR; - name_num: UCHAR; - name_flags: UCHAR; - end; - {$EXTERNALSYM _NAME_BUFFER} - NAME_BUFFER = _NAME_BUFFER; - {$EXTERNALSYM NAME_BUFFER} - PNAME_BUFFER = ^NAME_BUFFER; - {$EXTERNALSYM PNAME_BUFFER} - TNameBuffer = NAME_BUFFER; - PNameBuffer = PNAME_BUFFER; -{$ENDIF ~FPC} - -// values for name_flags bits. - -const - NAME_FLAGS_MASK = $87; - {$EXTERNALSYM NAME_FLAGS_MASK} - - GROUP_NAME = $80; - {$EXTERNALSYM GROUP_NAME} - UNIQUE_NAME = $00; - {$EXTERNALSYM UNIQUE_NAME} - - REGISTERING = $00; - {$EXTERNALSYM REGISTERING} - REGISTERED = $04; - {$EXTERNALSYM REGISTERED} - DEREGISTERED = $05; - {$EXTERNALSYM DEREGISTERED} - DUPLICATE = $06; - {$EXTERNALSYM DUPLICATE} - DUPLICATE_DEREG = $07; - {$EXTERNALSYM DUPLICATE_DEREG} - -// -// Structure returned to the NCB command NCBSSTAT is SESSION_HEADER followed -// by an array of SESSION_BUFFER structures. If the NCB_NAME starts with an -// asterisk then an array of these structures is returned containing the -// status for all names. -// - -{$IFNDEF FPC} -type - _SESSION_HEADER = record - sess_name: UCHAR; - num_sess: UCHAR; - rcv_dg_outstanding: UCHAR; - rcv_any_outstanding: UCHAR; - end; - {$EXTERNALSYM _SESSION_HEADER} - SESSION_HEADER = _SESSION_HEADER; - {$EXTERNALSYM SESSION_HEADER} - PSESSION_HEADER = ^SESSION_HEADER; - {$EXTERNALSYM PSESSION_HEADER} - TSessionHeader = SESSION_HEADER; - PSessionHeader = PSESSION_HEADER; - - _SESSION_BUFFER = record - lsn: UCHAR; - state: UCHAR; - local_name: array [0..NCBNAMSZ - 1] of UCHAR; - remote_name: array [0..NCBNAMSZ - 1] of UCHAR; - rcvs_outstanding: UCHAR; - sends_outstanding: UCHAR; - end; - {$EXTERNALSYM _SESSION_BUFFER} - SESSION_BUFFER = _SESSION_BUFFER; - {$EXTERNALSYM SESSION_BUFFER} - PSESSION_BUFFER = ^SESSION_BUFFER; - {$EXTERNALSYM PSESSION_BUFFER} - TSessionBuffer = SESSION_BUFFER; - PSessionBuffer = PSESSION_BUFFER; -{$ENDIF ~FPC} - -// Values for state - -const - LISTEN_OUTSTANDING = $01; - {$EXTERNALSYM LISTEN_OUTSTANDING} - CALL_PENDING = $02; - {$EXTERNALSYM CALL_PENDING} - SESSION_ESTABLISHED = $03; - {$EXTERNALSYM SESSION_ESTABLISHED} - HANGUP_PENDING = $04; - {$EXTERNALSYM HANGUP_PENDING} - HANGUP_COMPLETE = $05; - {$EXTERNALSYM HANGUP_COMPLETE} - SESSION_ABORTED = $06; - {$EXTERNALSYM SESSION_ABORTED} - -// -// Structure returned to the NCB command NCBENUM. -// -// On a system containing lana's 0, 2 and 3, a structure with -// length =3, lana[0]=0, lana[1]=2 and lana[2]=3 will be returned. -// - -{$IFNDEF FPC} -type - _LANA_ENUM = record - length: UCHAR; // Number of valid entries in lana[] - lana: array [0..MAX_LANA] of UCHAR; - end; - {$EXTERNALSYM _LANA_ENUM} - LANA_ENUM = _LANA_ENUM; - {$EXTERNALSYM LANA_ENUM} - PLANA_ENUM = ^LANA_ENUM; - {$EXTERNALSYM PLANA_ENUM} - TLanaEnum = LANA_ENUM; - PLanaEnum = PLANA_ENUM; -{$ENDIF ~FPC} - -// -// Structure returned to the NCB command NCBFINDNAME is FIND_NAME_HEADER followed -// by an array of FIND_NAME_BUFFER structures. -// - -{$IFNDEF FPC} -type - _FIND_NAME_HEADER = record - node_count: WORD; - reserved: UCHAR; - unique_group: UCHAR; - end; - {$EXTERNALSYM _FIND_NAME_HEADER} - FIND_NAME_HEADER = _FIND_NAME_HEADER; - {$EXTERNALSYM FIND_NAME_HEADER} - PFIND_NAME_HEADER = ^FIND_NAME_HEADER; - {$EXTERNALSYM PFIND_NAME_HEADER} - TFindNameHeader = FIND_NAME_HEADER; - PFindNameHeader = PFIND_NAME_HEADER; - - _FIND_NAME_BUFFER = record - length: UCHAR; - access_control: UCHAR; - frame_control: UCHAR; - destination_addr: array [0..5] of UCHAR; - source_addr: array [0..5] of UCHAR; - routing_info: array [0..17] of UCHAR; - end; - {$EXTERNALSYM _FIND_NAME_BUFFER} - FIND_NAME_BUFFER = _FIND_NAME_BUFFER; - {$EXTERNALSYM FIND_NAME_BUFFER} - PFIND_NAME_BUFFER = ^FIND_NAME_BUFFER; - {$EXTERNALSYM PFIND_NAME_BUFFER} - TFindNameBuffer = FIND_NAME_BUFFER; - PFindNameBuffer = PFIND_NAME_BUFFER; - -// -// Structure provided with NCBACTION. The purpose of NCBACTION is to provide -// transport specific extensions to netbios. -// - - _ACTION_HEADER = record - transport_id: ULONG; - action_code: USHORT; - reserved: USHORT; - end; - {$EXTERNALSYM _ACTION_HEADER} - ACTION_HEADER = _ACTION_HEADER; - {$EXTERNALSYM ACTION_HEADER} - PACTION_HEADER = ^ACTION_HEADER; - {$EXTERNALSYM PACTION_HEADER} - TActionHeader = ACTION_HEADER; - PActionHeader = PACTION_HEADER; -{$ENDIF ~FPC} - -// Values for transport_id - -const - ALL_TRANSPORTS = 'M'#0#0#0; - {$EXTERNALSYM ALL_TRANSPORTS} - MS_NBF = 'MNBF'; - {$EXTERNALSYM MS_NBF} - -(**************************************************************** - * * - * Special values and constants * - * * - ****************************************************************) - -// -// NCB Command codes -// - -const - NCBCALL = $10; // NCB CALL - {$EXTERNALSYM NCBCALL} - NCBLISTEN = $11; // NCB LISTEN - {$EXTERNALSYM NCBLISTEN} - NCBHANGUP = $12; // NCB HANG UP - {$EXTERNALSYM NCBHANGUP} - NCBSEND = $14; // NCB SEND - {$EXTERNALSYM NCBSEND} - NCBRECV = $15; // NCB RECEIVE - {$EXTERNALSYM NCBRECV} - NCBRECVANY = $16; // NCB RECEIVE ANY - {$EXTERNALSYM NCBRECVANY} - NCBCHAINSEND = $17; // NCB CHAIN SEND - {$EXTERNALSYM NCBCHAINSEND} - NCBDGSEND = $20; // NCB SEND DATAGRAM - {$EXTERNALSYM NCBDGSEND} - NCBDGRECV = $21; // NCB RECEIVE DATAGRAM - {$EXTERNALSYM NCBDGRECV} - NCBDGSENDBC = $22; // NCB SEND BROADCAST DATAGRAM - {$EXTERNALSYM NCBDGSENDBC} - NCBDGRECVBC = $23; // NCB RECEIVE BROADCAST DATAGRAM - {$EXTERNALSYM NCBDGRECVBC} - NCBADDNAME = $30; // NCB ADD NAME - {$EXTERNALSYM NCBADDNAME} - NCBDELNAME = $31; // NCB DELETE NAME - {$EXTERNALSYM NCBDELNAME} - NCBRESET = $32; // NCB RESET - {$EXTERNALSYM NCBRESET} - NCBASTAT = $33; // NCB ADAPTER STATUS - {$EXTERNALSYM NCBASTAT} - NCBSSTAT = $34; // NCB SESSION STATUS - {$EXTERNALSYM NCBSSTAT} - NCBCANCEL = $35; // NCB CANCEL - {$EXTERNALSYM NCBCANCEL} - NCBADDGRNAME = $36; // NCB ADD GROUP NAME - {$EXTERNALSYM NCBADDGRNAME} - NCBENUM = $37; // NCB ENUMERATE LANA NUMBERS - {$EXTERNALSYM NCBENUM} - NCBUNLINK = $70; // NCB UNLINK - {$EXTERNALSYM NCBUNLINK} - NCBSENDNA = $71; // NCB SEND NO ACK - {$EXTERNALSYM NCBSENDNA} - NCBCHAINSENDNA = $72; // NCB CHAIN SEND NO ACK - {$EXTERNALSYM NCBCHAINSENDNA} - NCBLANSTALERT = $73; // NCB LAN STATUS ALERT - {$EXTERNALSYM NCBLANSTALERT} - NCBACTION = $77; // NCB ACTION - {$EXTERNALSYM NCBACTION} - NCBFINDNAME = $78; // NCB FIND NAME - {$EXTERNALSYM NCBFINDNAME} - NCBTRACE = $79; // NCB TRACE - {$EXTERNALSYM NCBTRACE} - - ASYNCH = $80; // high bit set == asynchronous - {$EXTERNALSYM ASYNCH} - -// -// NCB Return codes -// - - NRC_GOODRET = $00; // good return also returned when ASYNCH request accepted - {$EXTERNALSYM NRC_GOODRET} - NRC_BUFLEN = $01; // illegal buffer length - {$EXTERNALSYM NRC_BUFLEN} - NRC_ILLCMD = $03; // illegal command - {$EXTERNALSYM NRC_ILLCMD} - NRC_CMDTMO = $05; // command timed out - {$EXTERNALSYM NRC_CMDTMO} - NRC_INCOMP = $06; // message incomplete, issue another command - {$EXTERNALSYM NRC_INCOMP} - NRC_BADDR = $07; // illegal buffer address - {$EXTERNALSYM NRC_BADDR} - NRC_SNUMOUT = $08; // session number out of range - {$EXTERNALSYM NRC_SNUMOUT} - NRC_NORES = $09; // no resource available - {$EXTERNALSYM NRC_NORES} - NRC_SCLOSED = $0a; // session closed - {$EXTERNALSYM NRC_SCLOSED} - NRC_CMDCAN = $0b; // command cancelled - {$EXTERNALSYM NRC_CMDCAN} - NRC_DUPNAME = $0d; // duplicate name - {$EXTERNALSYM NRC_DUPNAME} - NRC_NAMTFUL = $0e; // name table full - {$EXTERNALSYM NRC_NAMTFUL} - NRC_ACTSES = $0f; // no deletions, name has active sessions - {$EXTERNALSYM NRC_ACTSES} - NRC_LOCTFUL = $11; // local session table full - {$EXTERNALSYM NRC_LOCTFUL} - NRC_REMTFUL = $12; // remote session table full - {$EXTERNALSYM NRC_REMTFUL} - NRC_ILLNN = $13; // illegal name number - {$EXTERNALSYM NRC_ILLNN} - NRC_NOCALL = $14; // no callname - {$EXTERNALSYM NRC_NOCALL} - NRC_NOWILD = $15; // cannot put * in NCB_NAME - {$EXTERNALSYM NRC_NOWILD} - NRC_INUSE = $16; // name in use on remote adapter - {$EXTERNALSYM NRC_INUSE} - NRC_NAMERR = $17; // name deleted - {$EXTERNALSYM NRC_NAMERR} - NRC_SABORT = $18; // session ended abnormally - {$EXTERNALSYM NRC_SABORT} - NRC_NAMCONF = $19; // name conflict detected - {$EXTERNALSYM NRC_NAMCONF} - NRC_IFBUSY = $21; // interface busy, IRET before retrying - {$EXTERNALSYM NRC_IFBUSY} - NRC_TOOMANY = $22; // too many commands outstanding, retry later - {$EXTERNALSYM NRC_TOOMANY} - NRC_BRIDGE = $23; // ncb_lana_num field invalid - {$EXTERNALSYM NRC_BRIDGE} - NRC_CANOCCR = $24; // command completed while cancel occurring - {$EXTERNALSYM NRC_CANOCCR} - NRC_CANCEL = $26; // command not valid to cancel - {$EXTERNALSYM NRC_CANCEL} - NRC_DUPENV = $30; // name defined by anther local process - {$EXTERNALSYM NRC_DUPENV} - NRC_ENVNOTDEF = $34; // environment undefined. RESET required - {$EXTERNALSYM NRC_ENVNOTDEF} - NRC_OSRESNOTAV = $35; // required OS resources exhausted - {$EXTERNALSYM NRC_OSRESNOTAV} - NRC_MAXAPPS = $36; // max number of applications exceeded - {$EXTERNALSYM NRC_MAXAPPS} - NRC_NOSAPS = $37; // no saps available for netbios - {$EXTERNALSYM NRC_NOSAPS} - NRC_NORESOURCES = $38; // requested resources are not available - {$EXTERNALSYM NRC_NORESOURCES} - NRC_INVADDRESS = $39; // invalid ncb address or length > segment - {$EXTERNALSYM NRC_INVADDRESS} - NRC_INVDDID = $3B; // invalid NCB DDID - {$EXTERNALSYM NRC_INVDDID} - NRC_LOCKFAIL = $3C; // lock of user area failed - {$EXTERNALSYM NRC_LOCKFAIL} - NRC_OPENERR = $3f; // NETBIOS not loaded - {$EXTERNALSYM NRC_OPENERR} - NRC_SYSTEM = $40; // system error - {$EXTERNALSYM NRC_SYSTEM} - - NRC_PENDING = $ff; // asynchronous command is not yet finished - {$EXTERNALSYM NRC_PENDING} - -(**************************************************************** - * * - * main user entry point for NetBIOS 3.0 * - * * - * Usage: result = Netbios( pncb ); * - ****************************************************************) - -function Netbios(pncb: PNCB): UCHAR; stdcall; -{$EXTERNALSYM Netbios} - -type - PRasDialDlg = ^TRasDialDlg; - tagRASDIALDLG = packed record - dwSize: DWORD; - hwndOwner: HWND; - dwFlags: DWORD; - xDlg: Longint; - yDlg: Longint; - dwSubEntry: DWORD; - dwError: DWORD; - reserved: Longword; - reserved2: Longword; - end; - {$EXTERNALSYM tagRASDIALDLG} - RASDIALDLG = tagRASDIALDLG; - {$EXTERNALSYM RASDIALDLG} - TRasDialDlg = tagRASDIALDLG; - - -// Reason flags - -// Flags used by the various UIs. - -const - SHTDN_REASON_FLAG_COMMENT_REQUIRED = $01000000; - {$EXTERNALSYM SHTDN_REASON_FLAG_COMMENT_REQUIRED} - SHTDN_REASON_FLAG_DIRTY_PROBLEM_ID_REQUIRED = $02000000; - {$EXTERNALSYM SHTDN_REASON_FLAG_DIRTY_PROBLEM_ID_REQUIRED} - SHTDN_REASON_FLAG_CLEAN_UI = $04000000; - {$EXTERNALSYM SHTDN_REASON_FLAG_CLEAN_UI} - SHTDN_REASON_FLAG_DIRTY_UI = $08000000; - {$EXTERNALSYM SHTDN_REASON_FLAG_DIRTY_UI} - -// Flags that end up in the event log code. - - SHTDN_REASON_FLAG_USER_DEFINED = $40000000; - {$EXTERNALSYM SHTDN_REASON_FLAG_USER_DEFINED} - SHTDN_REASON_FLAG_PLANNED = DWORD($80000000); - {$EXTERNALSYM SHTDN_REASON_FLAG_PLANNED} - -// Microsoft major reasons. - - SHTDN_REASON_MAJOR_OTHER = $00000000; - {$EXTERNALSYM SHTDN_REASON_MAJOR_OTHER} - SHTDN_REASON_MAJOR_NONE = $00000000; - {$EXTERNALSYM SHTDN_REASON_MAJOR_NONE} - SHTDN_REASON_MAJOR_HARDWARE = $00010000; - {$EXTERNALSYM SHTDN_REASON_MAJOR_HARDWARE} - SHTDN_REASON_MAJOR_OPERATINGSYSTEM = $00020000; - {$EXTERNALSYM SHTDN_REASON_MAJOR_OPERATINGSYSTEM} - SHTDN_REASON_MAJOR_SOFTWARE = $00030000; - {$EXTERNALSYM SHTDN_REASON_MAJOR_SOFTWARE} - SHTDN_REASON_MAJOR_APPLICATION = $00040000; - {$EXTERNALSYM SHTDN_REASON_MAJOR_APPLICATION} - SHTDN_REASON_MAJOR_SYSTEM = $00050000; - {$EXTERNALSYM SHTDN_REASON_MAJOR_SYSTEM} - SHTDN_REASON_MAJOR_POWER = $00060000; - {$EXTERNALSYM SHTDN_REASON_MAJOR_POWER} - SHTDN_REASON_MAJOR_LEGACY_API = $00070000; - {$EXTERNALSYM SHTDN_REASON_MAJOR_LEGACY_API} - -// Microsoft minor reasons. - - SHTDN_REASON_MINOR_OTHER = $00000000; - {$EXTERNALSYM SHTDN_REASON_MINOR_OTHER} - SHTDN_REASON_MINOR_NONE = $000000ff; - {$EXTERNALSYM SHTDN_REASON_MINOR_NONE} - SHTDN_REASON_MINOR_MAINTENANCE = $00000001; - {$EXTERNALSYM SHTDN_REASON_MINOR_MAINTENANCE} - SHTDN_REASON_MINOR_INSTALLATION = $00000002; - {$EXTERNALSYM SHTDN_REASON_MINOR_INSTALLATION} - SHTDN_REASON_MINOR_UPGRADE = $00000003; - {$EXTERNALSYM SHTDN_REASON_MINOR_UPGRADE} - SHTDN_REASON_MINOR_RECONFIG = $00000004; - {$EXTERNALSYM SHTDN_REASON_MINOR_RECONFIG} - SHTDN_REASON_MINOR_HUNG = $00000005; - {$EXTERNALSYM SHTDN_REASON_MINOR_HUNG} - SHTDN_REASON_MINOR_UNSTABLE = $00000006; - {$EXTERNALSYM SHTDN_REASON_MINOR_UNSTABLE} - SHTDN_REASON_MINOR_DISK = $00000007; - {$EXTERNALSYM SHTDN_REASON_MINOR_DISK} - SHTDN_REASON_MINOR_PROCESSOR = $00000008; - {$EXTERNALSYM SHTDN_REASON_MINOR_PROCESSOR} - SHTDN_REASON_MINOR_NETWORKCARD = $00000009; - {$EXTERNALSYM SHTDN_REASON_MINOR_NETWORKCARD} - SHTDN_REASON_MINOR_POWER_SUPPLY = $0000000a; - {$EXTERNALSYM SHTDN_REASON_MINOR_POWER_SUPPLY} - SHTDN_REASON_MINOR_CORDUNPLUGGED = $0000000b; - {$EXTERNALSYM SHTDN_REASON_MINOR_CORDUNPLUGGED} - SHTDN_REASON_MINOR_ENVIRONMENT = $0000000c; - {$EXTERNALSYM SHTDN_REASON_MINOR_ENVIRONMENT} - SHTDN_REASON_MINOR_HARDWARE_DRIVER = $0000000d; - {$EXTERNALSYM SHTDN_REASON_MINOR_HARDWARE_DRIVER} - SHTDN_REASON_MINOR_OTHERDRIVER = $0000000e; - {$EXTERNALSYM SHTDN_REASON_MINOR_OTHERDRIVER} - SHTDN_REASON_MINOR_BLUESCREEN = $0000000F; - {$EXTERNALSYM SHTDN_REASON_MINOR_BLUESCREEN} - SHTDN_REASON_MINOR_SERVICEPACK = $00000010; - {$EXTERNALSYM SHTDN_REASON_MINOR_SERVICEPACK} - SHTDN_REASON_MINOR_HOTFIX = $00000011; - {$EXTERNALSYM SHTDN_REASON_MINOR_HOTFIX} - SHTDN_REASON_MINOR_SECURITYFIX = $00000012; - {$EXTERNALSYM SHTDN_REASON_MINOR_SECURITYFIX} - SHTDN_REASON_MINOR_SECURITY = $00000013; - {$EXTERNALSYM SHTDN_REASON_MINOR_SECURITY} - SHTDN_REASON_MINOR_NETWORK_CONNECTIVITY = $00000014; - {$EXTERNALSYM SHTDN_REASON_MINOR_NETWORK_CONNECTIVITY} - SHTDN_REASON_MINOR_WMI = $00000015; - {$EXTERNALSYM SHTDN_REASON_MINOR_WMI} - SHTDN_REASON_MINOR_SERVICEPACK_UNINSTALL = $00000016; - {$EXTERNALSYM SHTDN_REASON_MINOR_SERVICEPACK_UNINSTALL} - SHTDN_REASON_MINOR_HOTFIX_UNINSTALL = $00000017; - {$EXTERNALSYM SHTDN_REASON_MINOR_HOTFIX_UNINSTALL} - SHTDN_REASON_MINOR_SECURITYFIX_UNINSTALL = $00000018; - {$EXTERNALSYM SHTDN_REASON_MINOR_SECURITYFIX_UNINSTALL} - SHTDN_REASON_MINOR_MMC = $00000019; - {$EXTERNALSYM SHTDN_REASON_MINOR_MMC} - SHTDN_REASON_MINOR_TERMSRV = $00000020; - {$EXTERNALSYM SHTDN_REASON_MINOR_TERMSRV} - SHTDN_REASON_MINOR_DC_PROMOTION = $00000021; - {$EXTERNALSYM SHTDN_REASON_MINOR_DC_PROMOTION} - SHTDN_REASON_MINOR_DC_DEMOTION = $00000022; - {$EXTERNALSYM SHTDN_REASON_MINOR_DC_DEMOTION} - - SHTDN_REASON_UNKNOWN = SHTDN_REASON_MINOR_NONE; - {$EXTERNALSYM SHTDN_REASON_UNKNOWN} - SHTDN_REASON_LEGACY_API = (SHTDN_REASON_MAJOR_LEGACY_API or SHTDN_REASON_FLAG_PLANNED); - {$EXTERNALSYM SHTDN_REASON_LEGACY_API} - -// This mask cuts out UI flags. - - SHTDN_REASON_VALID_BIT_MASK = DWORD($c0ffffff); - {$EXTERNALSYM SHTDN_REASON_VALID_BIT_MASK} - -// Convenience flags. - - PCLEANUI = (SHTDN_REASON_FLAG_PLANNED or SHTDN_REASON_FLAG_CLEAN_UI); - {$EXTERNALSYM PCLEANUI} - UCLEANUI = (SHTDN_REASON_FLAG_CLEAN_UI); - {$EXTERNALSYM UCLEANUI} - PDIRTYUI = (SHTDN_REASON_FLAG_PLANNED or SHTDN_REASON_FLAG_DIRTY_UI); - {$EXTERNALSYM PDIRTYUI} - UDIRTYUI = (SHTDN_REASON_FLAG_DIRTY_UI); - {$EXTERNALSYM UDIRTYUI} - -const - CSIDL_LOCAL_APPDATA = $001C; { \Local Settings\Application Data (non roaming) } - CSIDL_COMMON_APPDATA = $0023; { All Users\Application Data } - CSIDL_WINDOWS = $0024; { GetWindowsDirectory() } - CSIDL_SYSTEM = $0025; { GetSystemDirectory() } - CSIDL_PROGRAM_FILES = $0026; { C:\Program Files } - CSIDL_MYPICTURES = $0027; { C:\Program Files\My Pictures } - CSIDL_PROFILE = $0028; { USERPROFILE } - CSIDL_PROGRAM_FILESX86 = $002A; { C:\Program Files (x86)\My Pictures } - CSIDL_PROGRAM_FILES_COMMON = $002B; { C:\Program Files\Common } - CSIDL_COMMON_TEMPLATES = $002D; { All Users\Templates } - CSIDL_COMMON_DOCUMENTS = $002E; { All Users\Documents } - CSIDL_COMMON_ADMINTOOLS = $002F; { All Users\Start Menu\Programs\Administrative Tools } - CSIDL_ADMINTOOLS = $0030; { \Start Menu\Programs\Administrative Tools } - CSIDL_CONNECTIONS = $0031; { Network and Dial-up Connections } - CSIDL_COMMON_MUSIC = $0035; { All Users\My Music } - CSIDL_COMMON_PICTURES = $0036; { All Users\My Pictures } - CSIDL_COMMON_VIDEO = $0037; { All Users\My Video } - CSIDL_RESOURCES = $0038; { Resource Directory } - CSIDL_RESOURCES_LOCALIZED = $0039; { Localized Resource Directory } - CSIDL_COMMON_OEM_LINKS = $003A; { Links to All Users OEM specific apps } - CSIDL_CDBURN_AREA = $003B; { USERPROFILE\Local Settings\Application Data\Microsoft\CD Burning } - CSIDL_COMPUTERSNEARME = $003D; { Computers Near Me (computered from Workgroup membership) } - - {$EXTERNALSYM CSIDL_LOCAL_APPDATA} - {$EXTERNALSYM CSIDL_COMMON_APPDATA} - {$EXTERNALSYM CSIDL_WINDOWS} - {$EXTERNALSYM CSIDL_SYSTEM} - {$EXTERNALSYM CSIDL_PROGRAM_FILES} - {$EXTERNALSYM CSIDL_MYPICTURES} - {$EXTERNALSYM CSIDL_PROFILE} - {$EXTERNALSYM CSIDL_PROGRAM_FILESX86} - {$EXTERNALSYM CSIDL_PROGRAM_FILES_COMMON} - {$EXTERNALSYM CSIDL_COMMON_TEMPLATES} - {$EXTERNALSYM CSIDL_COMMON_DOCUMENTS} - {$EXTERNALSYM CSIDL_COMMON_ADMINTOOLS} - {$EXTERNALSYM CSIDL_ADMINTOOLS} - {$EXTERNALSYM CSIDL_CONNECTIONS} - {$EXTERNALSYM CSIDL_COMMON_MUSIC} - {$EXTERNALSYM CSIDL_COMMON_PICTURES} - {$EXTERNALSYM CSIDL_COMMON_VIDEO} - {$EXTERNALSYM CSIDL_RESOURCES} - {$EXTERNALSYM CSIDL_RESOURCES_LOCALIZED} - {$EXTERNALSYM CSIDL_COMMON_OEM_LINKS} - {$EXTERNALSYM CSIDL_CDBURN_AREA} - {$EXTERNALSYM CSIDL_COMPUTERSNEARME} - -type - ITaskbarList = interface(IUnknown) - ['{56FDF342-FD6D-11D0-958A-006097C9A090}'] - function HrInit: HRESULT; stdcall; - function AddTab(hwnd: HWND): HRESULT; stdcall; - function DeleteTab(hwnd: HWND): HRESULT; stdcall; - function ActivateTab(hwnd: HWND): HRESULT; stdcall; - function SetActiveAlt(hwnd: HWND): HRESULT; stdcall; - end; - {$EXTERNALSYM ITaskbarList} - - ITaskbarList2 = interface(ITaskbarList) - ['{602D4995-B13A-429B-A66E-1935E44F4317}'] - function MarkFullscreenWindow(hwnd: HWND; fFullscreen: BOOL): HRESULT; stdcall; - end; - {$EXTERNALSYM ITaskbarList2} - -type - THUMBBUTTON = record - dwMask: DWORD; - iId: UINT; - iBitmap: UINT; - hIcon: HICON; - szTip: packed array[0..259] of WCHAR; - dwFlags: DWORD; - end; - {$EXTERNALSYM THUMBBUTTON} - tagTHUMBBUTTON = THUMBBUTTON; - {$EXTERNALSYM tagTHUMBBUTTON} - TThumbButton = THUMBBUTTON; - {$EXTERNALSYM TThumbButton} - PThumbButton = ^TThumbButton; - {$EXTERNALSYM PThumbButton} - -// for ThumbButtons.dwFlags -const - THBF_ENABLED = $0000; - {$EXTERNALSYM THBF_ENABLED} - THBF_DISABLED = $0001; - {$EXTERNALSYM THBF_DISABLED} - THBF_DISMISSONCLICK = $0002; - {$EXTERNALSYM THBF_DISMISSONCLICK} - THBF_NOBACKGROUND = $0004; - {$EXTERNALSYM THBF_NOBACKGROUND} - THBF_HIDDEN = $0008; - {$EXTERNALSYM THBF_HIDDEN} - THBF_NONINTERACTIVE = $0010; - {$EXTERNALSYM THBF_NONINTERACTIVE} - -// for ThumbButton.dwMask -const - THB_BITMAP = $0001; - {$EXTERNALSYM THB_BITMAP} - THB_ICON = $0002; - {$EXTERNALSYM THB_ICON} - THB_TOOLTIP = $0004; - {$EXTERNALSYM THB_TOOLTIP} - THB_FLAGS = $0008; - {$EXTERNALSYM THB_FLAGS} - -// wParam for WM_COMMAND message (lParam = Button ID) -const - THBN_CLICKED = $1800; - {$EXTERNALSYM THBN_CLICKED} - -// for ITaskBarList3.SetProgressState -const - TBPF_NOPROGRESS = 0; - {$EXTERNALSYM TBPF_NOPROGRESS} - TBPF_INDETERMINATE = $1; - {$EXTERNALSYM TBPF_INDETERMINATE} - TBPF_NORMAL = $2; - {$EXTERNALSYM TBPF_NORMAL} - TBPF_ERROR = $4; - {$EXTERNALSYM TBPF_ERROR} - TBPF_PAUSED = $8; - {$EXTERNALSYM TBPF_PAUSED} - -type - ITaskbarList3 = interface(ITaskbarList2) - ['{EA1AFB91-9E28-4B86-90E9-9E9F8A5EEFAF}'] - function SetProgressValue(hwnd: HWND; ullCompleted: ULONGLONG; - ullTotal: ULONGLONG): HRESULT; stdcall; - function SetProgressState(hwnd: HWND; tbpFlags: Integer): HRESULT; stdcall; - function RegisterTab(hwndTab: HWND; hwndMDI: HWND): HRESULT; stdcall; - function UnregisterTab(hwndTab: HWND): HRESULT; stdcall; - function SetTabOrder(hwndTab: HWND; hwndInsertBefore: HWND): HRESULT; stdcall; - function SetTabActive(hwndTab: HWND; hwndMDI: HWND; - tbatFlags: Integer): HRESULT; stdcall; - function ThumbBarAddButtons(hwnd: HWND; cButtons: UINT; - pButton: PThumbButton): HRESULT; stdcall; - function ThumbBarUpdateButtons(hwnd: HWND; cButtons: UINT; - pButton: PThumbButton): HRESULT; stdcall; - function ThumbBarSetImageList(hwnd: HWND; himl: THandle): HRESULT; stdcall; - function SetOverlayIcon(hwnd: HWND; hIcon: HICON; - pszDescription: LPCWSTR): HRESULT; stdcall; - function SetThumbnailTooltip(hwnd: HWND; pszTip: LPCWSTR): HRESULT; stdcall; - function SetThumbnailClip(hwnd: HWND; var prcClip: TRect): HRESULT; stdcall; - end; - {$EXTERNALSYM ITaskbarList3} - -type - STPFLAG = Integer; - {$EXTERNALSYM STPFLAG} -const - STPF_NONE = 0; - {$EXTERNALSYM STPF_NONE} - STPF_USEAPPTHUMBNAILALWAYS = $1; - {$EXTERNALSYM STPF_USEAPPTHUMBNAILALWAYS} - STPF_USEAPPTHUMBNAILWHENACTIVE = $2; - {$EXTERNALSYM STPF_USEAPPTHUMBNAILWHENACTIVE} - STPF_USEAPPPEEKALWAYS = $4; - {$EXTERNALSYM STPF_USEAPPPEEKALWAYS} - STPF_USEAPPPEEKWHENACTIVE = $8; - {$EXTERNALSYM STPF_USEAPPPEEKWHENACTIVE} - -type - ITaskbarList4 = interface(ITaskbarList3) - ['{C43DC798-95D1-4BEA-9030-BB99E2983A1A}'] - function SetTabProperties(hwndTab: HWND; stpFlags: STPFLAG): HRESULT; stdcall; - end; - {$EXTERNALSYM ITaskbarList4} - -const - CLSID_TaskbarList: TGUID = '{56FDF344-FD6D-11d0-958A-006097C9A090}'; - {$EXTERNALSYM CLSID_TaskbarList} - - -{ TODO BCB-compatibility} - -const - DLLVER_PLATFORM_WINDOWS = $00000001; - {$EXTERNALSYM DLLVER_PLATFORM_WINDOWS} - DLLVER_PLATFORM_NT = $00000002; - {$EXTERNALSYM DLLVER_PLATFORM_NT} - -type - PDllVersionInfo = ^TDllVersionInfo; - _DLLVERSIONINFO = packed record - cbSize: DWORD; - dwMajorVersion: DWORD; - dwMinorVersion: DWORD; - dwBuildNumber: DWORD; - dwPlatformId: DWORD; - end; - {$EXTERNALSYM _DLLVERSIONINFO} - TDllVersionInfo = _DLLVERSIONINFO; - DLLVERSIONINFO = _DLLVERSIONINFO; - {$EXTERNALSYM DLLVERSIONINFO} - - -// JwaWinError -// line 22146 - -const - -// -// Task Scheduler errors -// -// -// MessageId: SCHED_S_TASK_READY -// -// MessageText: -// -// The task is ready to run at its next scheduled time. -// - SCHED_S_TASK_READY = HRESULT($00041300); - {$EXTERNALSYM SCHED_S_TASK_READY} - -// -// MessageId: SCHED_S_TASK_RUNNING -// -// MessageText: -// -// The task is currently running. -// - SCHED_S_TASK_RUNNING = HRESULT($00041301); - {$EXTERNALSYM SCHED_S_TASK_RUNNING} - -// -// MessageId: SCHED_S_TASK_DISABLED -// -// MessageText: -// -// The task will not run at the scheduled times because it has been disabled. -// - SCHED_S_TASK_DISABLED = HRESULT($00041302); - {$EXTERNALSYM SCHED_S_TASK_DISABLED} - -// -// MessageId: SCHED_S_TASK_HAS_NOT_RUN -// -// MessageText: -// -// The task has not yet run. -// - SCHED_S_TASK_HAS_NOT_RUN = HRESULT($00041303); - {$EXTERNALSYM SCHED_S_TASK_HAS_NOT_RUN} - -// -// MessageId: SCHED_S_TASK_NO_MORE_RUNS -// -// MessageText: -// -// There are no more runs scheduled for this task. -// - SCHED_S_TASK_NO_MORE_RUNS = HRESULT($00041304); - {$EXTERNALSYM SCHED_S_TASK_NO_MORE_RUNS} - -// -// MessageId: SCHED_S_TASK_NOT_SCHEDULED -// -// MessageText: -// -// One or more of the properties that are needed to run this task on a schedule have not been set. -// - SCHED_S_TASK_NOT_SCHEDULED = HRESULT($00041305); - {$EXTERNALSYM SCHED_S_TASK_NOT_SCHEDULED} - -// -// MessageId: SCHED_S_TASK_TERMINATED -// -// MessageText: -// -// The last run of the task was terminated by the user. -// - SCHED_S_TASK_TERMINATED = HRESULT($00041306); - {$EXTERNALSYM SCHED_S_TASK_TERMINATED} - -// -// MessageId: SCHED_S_TASK_NO_VALID_TRIGGERS -// -// MessageText: -// -// Either the task has no triggers or the existing triggers are disabled or not set. -// - SCHED_S_TASK_NO_VALID_TRIGGERS = HRESULT($00041307); - {$EXTERNALSYM SCHED_S_TASK_NO_VALID_TRIGGERS} - -// -// MessageId: SCHED_S_EVENT_TRIGGER -// -// MessageText: -// -// Event triggers don't have set run times. -// - SCHED_S_EVENT_TRIGGER = HRESULT($00041308); - {$EXTERNALSYM SCHED_S_EVENT_TRIGGER} - -// -// MessageId: SCHED_E_TRIGGER_NOT_FOUND -// -// MessageText: -// -// Trigger not found. -// - SCHED_E_TRIGGER_NOT_FOUND = HRESULT($80041309); - {$EXTERNALSYM SCHED_E_TRIGGER_NOT_FOUND} - -// -// MessageId: SCHED_E_TASK_NOT_READY -// -// MessageText: -// -// One or more of the properties that are needed to run this task have not been set. -// - SCHED_E_TASK_NOT_READY = HRESULT($8004130A); - {$EXTERNALSYM SCHED_E_TASK_NOT_READY} - -// -// MessageId: SCHED_E_TASK_NOT_RUNNING -// -// MessageText: -// -// There is no running instance of the task to terminate. -// - SCHED_E_TASK_NOT_RUNNING = HRESULT($8004130B); - {$EXTERNALSYM SCHED_E_TASK_NOT_RUNNING} - -// -// MessageId: SCHED_E_SERVICE_NOT_INSTALLED -// -// MessageText: -// -// The Task Scheduler Service is not installed on this computer. -// - SCHED_E_SERVICE_NOT_INSTALLED = HRESULT($8004130C); - {$EXTERNALSYM SCHED_E_SERVICE_NOT_INSTALLED} - -// -// MessageId: SCHED_E_CANNOT_OPEN_TASK -// -// MessageText: -// -// The task object could not be opened. -// - SCHED_E_CANNOT_OPEN_TASK = HRESULT($8004130D); - {$EXTERNALSYM SCHED_E_CANNOT_OPEN_TASK} - -// -// MessageId: SCHED_E_INVALID_TASK -// -// MessageText: -// -// The object is either an invalid task object or is not a task object. -// - SCHED_E_INVALID_TASK = HRESULT($8004130E); - {$EXTERNALSYM SCHED_E_INVALID_TASK} - -// -// MessageId: SCHED_E_ACCOUNT_INFORMATION_NOT_SET -// -// MessageText: -// -// No account information could be found in the Task Scheduler security database for the task indicated. -// - SCHED_E_ACCOUNT_INFORMATION_NOT_SET = HRESULT($8004130F); - {$EXTERNALSYM SCHED_E_ACCOUNT_INFORMATION_NOT_SET} - -// -// MessageId: SCHED_E_ACCOUNT_NAME_NOT_FOUND -// -// MessageText: -// -// Unable to establish existence of the account specified. -// - SCHED_E_ACCOUNT_NAME_NOT_FOUND = HRESULT($80041310); - {$EXTERNALSYM SCHED_E_ACCOUNT_NAME_NOT_FOUND} - -// -// MessageId: SCHED_E_ACCOUNT_DBASE_CORRUPT -// -// MessageText: -// -// Corruption was detected in the Task Scheduler security database; the database has been reset. -// - SCHED_E_ACCOUNT_DBASE_CORRUPT = HRESULT($80041311); - {$EXTERNALSYM SCHED_E_ACCOUNT_DBASE_CORRUPT} - -// -// MessageId: SCHED_E_NO_SECURITY_SERVICES -// -// MessageText: -// -// Task Scheduler security services are available only on Windows NT. -// - SCHED_E_NO_SECURITY_SERVICES = HRESULT($80041312); - {$EXTERNALSYM SCHED_E_NO_SECURITY_SERVICES} - -// -// MessageId: SCHED_E_UNKNOWN_OBJECT_VERSION -// -// MessageText: -// -// The task object version is either unsupported or invalid. -// - SCHED_E_UNKNOWN_OBJECT_VERSION = HRESULT($80041313); - {$EXTERNALSYM SCHED_E_UNKNOWN_OBJECT_VERSION} - -// -// MessageId: SCHED_E_UNSUPPORTED_ACCOUNT_OPTION -// -// MessageText: -// -// The task has been configured with an unsupported combination of account settings and run time options. -// - SCHED_E_UNSUPPORTED_ACCOUNT_OPTION = HRESULT($80041314); - {$EXTERNALSYM SCHED_E_UNSUPPORTED_ACCOUNT_OPTION} - -// -// MessageId: SCHED_E_SERVICE_NOT_RUNNING -// -// MessageText: -// -// The Task Scheduler Service is not running. -// - SCHED_E_SERVICE_NOT_RUNNING = HRESULT($80041315); - {$EXTERNALSYM SCHED_E_SERVICE_NOT_RUNNING} - - -// line 151 - -// -// Define the various device type values. Note that values used by Microsoft -// Corporation are in the range 0-32767, and 32768-65535 are reserved for use -// by customers. -// - -type - DEVICE_TYPE = DWORD; - {$EXTERNALSYM DEVICE_TYPE} - -const - FILE_DEVICE_BEEP = $00000001; - {$EXTERNALSYM FILE_DEVICE_BEEP} - FILE_DEVICE_CD_ROM = $00000002; - {$EXTERNALSYM FILE_DEVICE_CD_ROM} - FILE_DEVICE_CD_ROM_FILE_SYSTEM = $00000003; - {$EXTERNALSYM FILE_DEVICE_CD_ROM_FILE_SYSTEM} - FILE_DEVICE_CONTROLLER = $00000004; - {$EXTERNALSYM FILE_DEVICE_CONTROLLER} - FILE_DEVICE_DATALINK = $00000005; - {$EXTERNALSYM FILE_DEVICE_DATALINK} - FILE_DEVICE_DFS = $00000006; - {$EXTERNALSYM FILE_DEVICE_DFS} - FILE_DEVICE_DISK = $00000007; - {$EXTERNALSYM FILE_DEVICE_DISK} - FILE_DEVICE_DISK_FILE_SYSTEM = $00000008; - {$EXTERNALSYM FILE_DEVICE_DISK_FILE_SYSTEM} - FILE_DEVICE_FILE_SYSTEM = $00000009; - {$EXTERNALSYM FILE_DEVICE_FILE_SYSTEM} - FILE_DEVICE_INPORT_PORT = $0000000a; - {$EXTERNALSYM FILE_DEVICE_INPORT_PORT} - FILE_DEVICE_KEYBOARD = $0000000b; - {$EXTERNALSYM FILE_DEVICE_KEYBOARD} - FILE_DEVICE_MAILSLOT = $0000000c; - {$EXTERNALSYM FILE_DEVICE_MAILSLOT} - FILE_DEVICE_MIDI_IN = $0000000d; - {$EXTERNALSYM FILE_DEVICE_MIDI_IN} - FILE_DEVICE_MIDI_OUT = $0000000e; - {$EXTERNALSYM FILE_DEVICE_MIDI_OUT} - FILE_DEVICE_MOUSE = $0000000f; - {$EXTERNALSYM FILE_DEVICE_MOUSE} - FILE_DEVICE_MULTI_UNC_PROVIDER = $00000010; - {$EXTERNALSYM FILE_DEVICE_MULTI_UNC_PROVIDER} - FILE_DEVICE_NAMED_PIPE = $00000011; - {$EXTERNALSYM FILE_DEVICE_NAMED_PIPE} - FILE_DEVICE_NETWORK = $00000012; - {$EXTERNALSYM FILE_DEVICE_NETWORK} - FILE_DEVICE_NETWORK_BROWSER = $00000013; - {$EXTERNALSYM FILE_DEVICE_NETWORK_BROWSER} - FILE_DEVICE_NETWORK_FILE_SYSTEM = $00000014; - {$EXTERNALSYM FILE_DEVICE_NETWORK_FILE_SYSTEM} - FILE_DEVICE_NULL = $00000015; - {$EXTERNALSYM FILE_DEVICE_NULL} - FILE_DEVICE_PARALLEL_PORT = $00000016; - {$EXTERNALSYM FILE_DEVICE_PARALLEL_PORT} - FILE_DEVICE_PHYSICAL_NETCARD = $00000017; - {$EXTERNALSYM FILE_DEVICE_PHYSICAL_NETCARD} - FILE_DEVICE_PRINTER = $00000018; - {$EXTERNALSYM FILE_DEVICE_PRINTER} - FILE_DEVICE_SCANNER = $00000019; - {$EXTERNALSYM FILE_DEVICE_SCANNER} - FILE_DEVICE_SERIAL_MOUSE_PORT = $0000001a; - {$EXTERNALSYM FILE_DEVICE_SERIAL_MOUSE_PORT} - FILE_DEVICE_SERIAL_PORT = $0000001b; - {$EXTERNALSYM FILE_DEVICE_SERIAL_PORT} - FILE_DEVICE_SCREEN = $0000001c; - {$EXTERNALSYM FILE_DEVICE_SCREEN} - FILE_DEVICE_SOUND = $0000001d; - {$EXTERNALSYM FILE_DEVICE_SOUND} - FILE_DEVICE_STREAMS = $0000001e; - {$EXTERNALSYM FILE_DEVICE_STREAMS} - FILE_DEVICE_TAPE = $0000001f; - {$EXTERNALSYM FILE_DEVICE_TAPE} - FILE_DEVICE_TAPE_FILE_SYSTEM = $00000020; - {$EXTERNALSYM FILE_DEVICE_TAPE_FILE_SYSTEM} - FILE_DEVICE_TRANSPORT = $00000021; - {$EXTERNALSYM FILE_DEVICE_TRANSPORT} - FILE_DEVICE_UNKNOWN = $00000022; - {$EXTERNALSYM FILE_DEVICE_UNKNOWN} - FILE_DEVICE_VIDEO = $00000023; - {$EXTERNALSYM FILE_DEVICE_VIDEO} - FILE_DEVICE_VIRTUAL_DISK = $00000024; - {$EXTERNALSYM FILE_DEVICE_VIRTUAL_DISK} - FILE_DEVICE_WAVE_IN = $00000025; - {$EXTERNALSYM FILE_DEVICE_WAVE_IN} - FILE_DEVICE_WAVE_OUT = $00000026; - {$EXTERNALSYM FILE_DEVICE_WAVE_OUT} - FILE_DEVICE_8042_PORT = $00000027; - {$EXTERNALSYM FILE_DEVICE_8042_PORT} - FILE_DEVICE_NETWORK_REDIRECTOR = $00000028; - {$EXTERNALSYM FILE_DEVICE_NETWORK_REDIRECTOR} - FILE_DEVICE_BATTERY = $00000029; - {$EXTERNALSYM FILE_DEVICE_BATTERY} - FILE_DEVICE_BUS_EXTENDER = $0000002a; - {$EXTERNALSYM FILE_DEVICE_BUS_EXTENDER} - FILE_DEVICE_MODEM = $0000002b; - {$EXTERNALSYM FILE_DEVICE_MODEM} - FILE_DEVICE_VDM = $0000002c; - {$EXTERNALSYM FILE_DEVICE_VDM} - FILE_DEVICE_MASS_STORAGE = $0000002d; - {$EXTERNALSYM FILE_DEVICE_MASS_STORAGE} - FILE_DEVICE_SMB = $0000002e; - {$EXTERNALSYM FILE_DEVICE_SMB} - FILE_DEVICE_KS = $0000002f; - {$EXTERNALSYM FILE_DEVICE_KS} - FILE_DEVICE_CHANGER = $00000030; - {$EXTERNALSYM FILE_DEVICE_CHANGER} - FILE_DEVICE_SMARTCARD = $00000031; - {$EXTERNALSYM FILE_DEVICE_SMARTCARD} - FILE_DEVICE_ACPI = $00000032; - {$EXTERNALSYM FILE_DEVICE_ACPI} - FILE_DEVICE_DVD = $00000033; - {$EXTERNALSYM FILE_DEVICE_DVD} - FILE_DEVICE_FULLSCREEN_VIDEO = $00000034; - {$EXTERNALSYM FILE_DEVICE_FULLSCREEN_VIDEO} - FILE_DEVICE_DFS_FILE_SYSTEM = $00000035; - {$EXTERNALSYM FILE_DEVICE_DFS_FILE_SYSTEM} - FILE_DEVICE_DFS_VOLUME = $00000036; - {$EXTERNALSYM FILE_DEVICE_DFS_VOLUME} - FILE_DEVICE_SERENUM = $00000037; - {$EXTERNALSYM FILE_DEVICE_SERENUM} - FILE_DEVICE_TERMSRV = $00000038; - {$EXTERNALSYM FILE_DEVICE_TERMSRV} - FILE_DEVICE_KSEC = $00000039; - {$EXTERNALSYM FILE_DEVICE_KSEC} - FILE_DEVICE_FIPS = $0000003A; - {$EXTERNALSYM FILE_DEVICE_FIPS} - FILE_DEVICE_INFINIBAND = $0000003B; - {$EXTERNALSYM FILE_DEVICE_INFINIBAND} - -// line 297 - -// -// Define the method codes for how buffers are passed for I/O and FS controls -// - -const - METHOD_BUFFERED = 0; - {$EXTERNALSYM METHOD_BUFFERED} - METHOD_IN_DIRECT = 1; - {$EXTERNALSYM METHOD_IN_DIRECT} - METHOD_OUT_DIRECT = 2; - {$EXTERNALSYM METHOD_OUT_DIRECT} - METHOD_NEITHER = 3; - {$EXTERNALSYM METHOD_NEITHER} - -// -// Define some easier to comprehend aliases: -// METHOD_DIRECT_TO_HARDWARE (writes, aka METHOD_IN_DIRECT) -// METHOD_DIRECT_FROM_HARDWARE (reads, aka METHOD_OUT_DIRECT) -// - - METHOD_DIRECT_TO_HARDWARE = METHOD_IN_DIRECT; - {$EXTERNALSYM METHOD_DIRECT_TO_HARDWARE} - METHOD_DIRECT_FROM_HARDWARE = METHOD_OUT_DIRECT; - {$EXTERNALSYM METHOD_DIRECT_FROM_HARDWARE} - -// -// Define the access check value for any access -// -// -// The FILE_READ_ACCESS and FILE_WRITE_ACCESS constants are also defined in -// ntioapi.h as FILE_READ_DATA and FILE_WRITE_DATA. The values for these -// constants *MUST* always be in sync. -// -// -// FILE_SPECIAL_ACCESS is checked by the NT I/O system the same as FILE_ANY_ACCESS. -// The file systems, however, may add additional access checks for I/O and FS controls -// that use this value. -// - -const - FILE_ANY_ACCESS = 0; - {$EXTERNALSYM FILE_ANY_ACCESS} - FILE_SPECIAL_ACCESS = FILE_ANY_ACCESS; - {$EXTERNALSYM FILE_SPECIAL_ACCESS} - FILE_READ_ACCESS = $0001; // file & pipe - {$EXTERNALSYM FILE_READ_ACCESS} - FILE_WRITE_ACCESS = $0002; // file & pipe - {$EXTERNALSYM FILE_WRITE_ACCESS} - -// line 3425 - -// -// The following is a list of the native file system fsctls followed by -// additional network file system fsctls. Some values have been -// decommissioned. -// - -const - - FSCTL_REQUEST_OPLOCK_LEVEL_1 = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (0 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_REQUEST_OPLOCK_LEVEL_1} - - FSCTL_REQUEST_OPLOCK_LEVEL_2 = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (1 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_REQUEST_OPLOCK_LEVEL_2} - - FSCTL_REQUEST_BATCH_OPLOCK = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (2 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_REQUEST_BATCH_OPLOCK} - - FSCTL_OPLOCK_BREAK_ACKNOWLEDGE = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (3 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_OPLOCK_BREAK_ACKNOWLEDGE} - - FSCTL_OPBATCH_ACK_CLOSE_PENDING = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (4 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_OPBATCH_ACK_CLOSE_PENDING} - - FSCTL_OPLOCK_BREAK_NOTIFY = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (5 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_OPLOCK_BREAK_NOTIFY} - - FSCTL_LOCK_VOLUME = ((FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or (6 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_LOCK_VOLUME} - - FSCTL_UNLOCK_VOLUME = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (7 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_UNLOCK_VOLUME} - - FSCTL_DISMOUNT_VOLUME = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (8 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_DISMOUNT_VOLUME} - -// decommissioned fsctl value 9 - - FSCTL_IS_VOLUME_MOUNTED = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (10 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_IS_VOLUME_MOUNTED} - - FSCTL_IS_PATHNAME_VALID = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (11 shl 2) or METHOD_BUFFERED); // PATHNAME_BUFFER, - {$EXTERNALSYM FSCTL_IS_PATHNAME_VALID} - - FSCTL_MARK_VOLUME_DIRTY = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (12 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_MARK_VOLUME_DIRTY} - -// decommissioned fsctl value 13 - - FSCTL_QUERY_RETRIEVAL_POINTERS = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (14 shl 2) or METHOD_NEITHER); - {$EXTERNALSYM FSCTL_QUERY_RETRIEVAL_POINTERS} - - FSCTL_GET_COMPRESSION = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (15 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_GET_COMPRESSION} - - FSCTL_SET_COMPRESSION = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or ((FILE_READ_DATA or FILE_WRITE_DATA) shl 14) or - (16 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_SET_COMPRESSION} - -// decommissioned fsctl value 17 -// decommissioned fsctl value 18 - - FSCTL_MARK_AS_SYSTEM_HIVE = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (19 shl 2) or METHOD_NEITHER); - {$EXTERNALSYM FSCTL_MARK_AS_SYSTEM_HIVE} - - FSCTL_OPLOCK_BREAK_ACK_NO_2 = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (20 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_OPLOCK_BREAK_ACK_NO_2} - - FSCTL_INVALIDATE_VOLUMES = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (21 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_INVALIDATE_VOLUMES} - - FSCTL_QUERY_FAT_BPB = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (22 shl 2) or METHOD_BUFFERED); // FSCTL_QUERY_FAT_BPB_BUFFER - {$EXTERNALSYM FSCTL_QUERY_FAT_BPB} - - FSCTL_REQUEST_FILTER_OPLOCK = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (23 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_REQUEST_FILTER_OPLOCK} - - FSCTL_FILESYSTEM_GET_STATISTICS = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (24 shl 2) or METHOD_BUFFERED); // FILESYSTEM_STATISTICS - {$EXTERNALSYM FSCTL_FILESYSTEM_GET_STATISTICS} - - FSCTL_GET_NTFS_VOLUME_DATA = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (25 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_GET_NTFS_VOLUME_DATA} - - FSCTL_GET_NTFS_FILE_RECORD = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (26 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_GET_NTFS_FILE_RECORD} - - FSCTL_GET_VOLUME_BITMAP = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (27 shl 2) or METHOD_NEITHER); - {$EXTERNALSYM FSCTL_GET_VOLUME_BITMAP} - - FSCTL_GET_RETRIEVAL_POINTERS = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (28 shl 2) or METHOD_NEITHER); - {$EXTERNALSYM FSCTL_GET_RETRIEVAL_POINTERS} - - FSCTL_MOVE_FILE = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or - (29 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_MOVE_FILE} - - FSCTL_IS_VOLUME_DIRTY = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (30 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_IS_VOLUME_DIRTY} - -// decomissioned fsctl value 31 -(* FSCTL_GET_HFS_INFORMATION = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (31 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_GET_HFS_INFORMATION} -*) - - FSCTL_ALLOW_EXTENDED_DASD_IO = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (32 shl 2) or METHOD_NEITHER); - {$EXTERNALSYM FSCTL_ALLOW_EXTENDED_DASD_IO} - -// decommissioned fsctl value 33 -// decommissioned fsctl value 34 - -(* - FSCTL_READ_PROPERTY_DATA = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (33 shl 2) or METHOD_NEITHER); - {$EXTERNALSYM FSCTL_READ_PROPERTY_DATA} - - FSCTL_WRITE_PROPERTY_DATA = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (34 shl 2) or METHOD_NEITHER); - {$EXTERNALSYM FSCTL_WRITE_PROPERTY_DATA} -*) - - FSCTL_FIND_FILES_BY_SID = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (35 shl 2) or METHOD_NEITHER); - {$EXTERNALSYM FSCTL_FIND_FILES_BY_SID} - -// decommissioned fsctl value 36 -// decommissioned fsctl value 37 - -(* FSCTL_DUMP_PROPERTY_DATA = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (37 shl 2) or METHOD_NEITHER); - {$EXTERNALSYM FSCTL_DUMP_PROPERTY_DATA} -*) - - FSCTL_SET_OBJECT_ID = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or - (38 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_SET_OBJECT_ID} - - FSCTL_GET_OBJECT_ID = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (39 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_GET_OBJECT_ID} - - FSCTL_DELETE_OBJECT_ID = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or - (40 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_DELETE_OBJECT_ID} - - FSCTL_SET_REPARSE_POINT = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or - (41 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_SET_REPARSE_POINT} - - FSCTL_GET_REPARSE_POINT = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (42 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_GET_REPARSE_POINT} - - FSCTL_DELETE_REPARSE_POINT = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or - (43 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_DELETE_REPARSE_POINT} - - FSCTL_ENUM_USN_DATA = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (44 shl 2) or METHOD_NEITHER); - {$EXTERNALSYM FSCTL_ENUM_USN_DATA} - - FSCTL_SECURITY_ID_CHECK = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_READ_DATA shl 14) or - (45 shl 2) or METHOD_NEITHER); - {$EXTERNALSYM FSCTL_SECURITY_ID_CHECK} - - FSCTL_READ_USN_JOURNAL = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (46 shl 2) or METHOD_NEITHER); - {$EXTERNALSYM FSCTL_READ_USN_JOURNAL} - - FSCTL_SET_OBJECT_ID_EXTENDED = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or - (47 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_SET_OBJECT_ID_EXTENDED} - - FSCTL_CREATE_OR_GET_OBJECT_ID = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (48 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_CREATE_OR_GET_OBJECT_ID} - - FSCTL_SET_SPARSE = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or - (49 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_SET_SPARSE} - - FSCTL_SET_ZERO_DATA = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_WRITE_DATA shl 14) or - (50 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_SET_ZERO_DATA} - - FSCTL_QUERY_ALLOCATED_RANGES = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_READ_DATA shl 14) or - (51 shl 2) or METHOD_NEITHER); - {$EXTERNALSYM FSCTL_QUERY_ALLOCATED_RANGES} - -// decommissioned fsctl value 52 -(* - FSCTL_ENABLE_UPGRADE = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_WRITE_DATA shl 14) or - (52 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_ENABLE_UPGRADE} -*) - - FSCTL_SET_ENCRYPTION = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (53 shl 2) or METHOD_NEITHER); - {$EXTERNALSYM FSCTL_SET_ENCRYPTION} - - FSCTL_ENCRYPTION_FSCTL_IO = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (54 shl 2) or METHOD_NEITHER); - {$EXTERNALSYM FSCTL_ENCRYPTION_FSCTL_IO} - - FSCTL_WRITE_RAW_ENCRYPTED = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or - (55 shl 2) or METHOD_NEITHER); - {$EXTERNALSYM FSCTL_WRITE_RAW_ENCRYPTED} - - FSCTL_READ_RAW_ENCRYPTED = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or - (56 shl 2) or METHOD_NEITHER); - {$EXTERNALSYM FSCTL_READ_RAW_ENCRYPTED} - - FSCTL_CREATE_USN_JOURNAL = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (57 shl 2) or METHOD_NEITHER); - {$EXTERNALSYM FSCTL_CREATE_USN_JOURNAL} - - FSCTL_READ_FILE_USN_DATA = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (58 shl 2) or METHOD_NEITHER); - {$EXTERNALSYM FSCTL_READ_FILE_USN_DATA} - - FSCTL_WRITE_USN_CLOSE_RECORD = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (59 shl 2) or METHOD_NEITHER); - {$EXTERNALSYM FSCTL_WRITE_USN_CLOSE_RECORD} - - FSCTL_EXTEND_VOLUME = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (60 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_EXTEND_VOLUME} - - FSCTL_QUERY_USN_JOURNAL = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (61 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_QUERY_USN_JOURNAL} - - FSCTL_DELETE_USN_JOURNAL = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (62 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_DELETE_USN_JOURNAL} - - FSCTL_MARK_HANDLE = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (63 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_MARK_HANDLE} - - FSCTL_SIS_COPYFILE = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (64 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_SIS_COPYFILE} - - FSCTL_SIS_LINK_FILES = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or ((FILE_READ_DATA or FILE_WRITE_DATA) shl 14) or - (65 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_SIS_LINK_FILES} - - FSCTL_HSM_MSG = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or ((FILE_READ_DATA or FILE_WRITE_DATA) shl 14) or - (66 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_HSM_MSG} - -// decommissioned fsctl value 67 -(* - FSCTL_NSS_CONTROL = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_WRITE_DATA shl 14) or - (67 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_NSS_CONTROL} -*) - - FSCTL_HSM_DATA = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or ((FILE_READ_DATA or FILE_WRITE_DATA) shl 14) or - (68 shl 2) or METHOD_NEITHER); - {$EXTERNALSYM FSCTL_HSM_DATA} - - FSCTL_RECALL_FILE = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or - (69 shl 2) or METHOD_NEITHER); - {$EXTERNALSYM FSCTL_RECALL_FILE} - -// decommissioned fsctl value 70 -(* - FSCTL_NSS_RCONTROL = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_READ_DATA shl 14) or - (70 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_NSS_RCONTROL} -*) - - FSCTL_READ_FROM_PLEX = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_READ_DATA shl 14) or - (71 shl 2) or METHOD_OUT_DIRECT); - {$EXTERNALSYM FSCTL_READ_FROM_PLEX} - - FSCTL_FILE_PREFETCH = ( - (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or - (72 shl 2) or METHOD_BUFFERED); - {$EXTERNALSYM FSCTL_FILE_PREFETCH} - -// line 4553 - -// -// Structure for FSCTL_SET_ZERO_DATA -// - -type - - PFILE_ZERO_DATA_INFORMATION = ^FILE_ZERO_DATA_INFORMATION; - {$EXTERNALSYM PFILE_ZERO_DATA_INFORMATION} - _FILE_ZERO_DATA_INFORMATION = record - FileOffset: LARGE_INTEGER; - BeyondFinalZero: LARGE_INTEGER; - end; - {$EXTERNALSYM _FILE_ZERO_DATA_INFORMATION} - FILE_ZERO_DATA_INFORMATION = _FILE_ZERO_DATA_INFORMATION; - {$EXTERNALSYM FILE_ZERO_DATA_INFORMATION} - TFileZeroDataInformation = FILE_ZERO_DATA_INFORMATION; - PFileZeroDataInformation = PFILE_ZERO_DATA_INFORMATION; - -// -// Structure for FSCTL_QUERY_ALLOCATED_RANGES -// - -// -// Querying the allocated ranges requires an output buffer to store the -// allocated ranges and an input buffer to specify the range to query. -// The input buffer contains a single entry, the output buffer is an -// array of the following structure. -// - - PFILE_ALLOCATED_RANGE_BUFFER = ^FILE_ALLOCATED_RANGE_BUFFER; - {$EXTERNALSYM PFILE_ALLOCATED_RANGE_BUFFER} - _FILE_ALLOCATED_RANGE_BUFFER = record - FileOffset: LARGE_INTEGER; - Length: LARGE_INTEGER; - end; - {$EXTERNALSYM _FILE_ALLOCATED_RANGE_BUFFER} - FILE_ALLOCATED_RANGE_BUFFER = _FILE_ALLOCATED_RANGE_BUFFER; - {$EXTERNALSYM FILE_ALLOCATED_RANGE_BUFFER} - TFileAllocatedRangeBuffer = FILE_ALLOCATED_RANGE_BUFFER; - PFileAllocatedRangeBuffer = PFILE_ALLOCATED_RANGE_BUFFER; - - -// line 340 - -// -// Code Page Default Values. -// - -const - CP_ACP = 0; // default to ANSI code page - {$EXTERNALSYM CP_ACP} - CP_OEMCP = 1; // default to OEM code page - {$EXTERNALSYM CP_OEMCP} - CP_MACCP = 2; // default to MAC code page - {$EXTERNALSYM CP_MACCP} - CP_THREAD_ACP = 3; // current thread's ANSI code page - {$EXTERNALSYM CP_THREAD_ACP} - CP_SYMBOL = 42; // SYMBOL translations - {$EXTERNALSYM CP_SYMBOL} - - CP_UTF7 = 65000; // UTF-7 translation - {$EXTERNALSYM CP_UTF7} - CP_UTF8 = 65001; // UTF-8 translation - {$EXTERNALSYM CP_UTF8} - -// line 597 - -const - -// -// The following LCTypes may be used in combination with any other LCTypes. -// -// LOCALE_NOUSEROVERRIDE is also used in GetTimeFormat and -// GetDateFormat. -// -// LOCALE_USE_CP_ACP is used in many of the A (Ansi) apis that need -// to do string translation. -// -// LOCALE_RETURN_NUMBER will return the result from GetLocaleInfo as a -// number instead of a string. This flag is only valid for the LCTypes -// beginning with LOCALE_I. -// - - LOCALE_NOUSEROVERRIDE = DWORD($80000000); // do not use user overrides - {$EXTERNALSYM LOCALE_NOUSEROVERRIDE} - LOCALE_USE_CP_ACP = $40000000; // use the system ACP - {$EXTERNALSYM LOCALE_USE_CP_ACP} - - LOCALE_RETURN_NUMBER = $20000000; // return number instead of string - {$EXTERNALSYM LOCALE_RETURN_NUMBER} - -// line 841 - -const - LOCALE_IDEFAULTEBCDICCODEPAGE = $00001012; // default ebcdic code page - {$EXTERNALSYM LOCALE_IDEFAULTEBCDICCODEPAGE} - LOCALE_IPAPERSIZE = $0000100A; // 1 = letter, 5 = legal, 8 = a3, 9 = a4 - {$EXTERNALSYM LOCALE_IPAPERSIZE} - LOCALE_SENGCURRNAME = $00001007; // english name of currency - {$EXTERNALSYM LOCALE_SENGCURRNAME} - LOCALE_SNATIVECURRNAME = $00001008; // native name of currency - {$EXTERNALSYM LOCALE_SNATIVECURRNAME} - LOCALE_SYEARMONTH = $00001006; // year month format string - {$EXTERNALSYM LOCALE_SYEARMONTH} - LOCALE_SSORTNAME = $00001013; // sort name - {$EXTERNALSYM LOCALE_SSORTNAME} - LOCALE_IDIGITSUBSTITUTION = $00001014; // 0 = context, 1 = none, 2 = national - {$EXTERNALSYM LOCALE_IDIGITSUBSTITUTION} - -// line 880 - - DATE_YEARMONTH = $00000008; // use year month picture - {$EXTERNALSYM DATE_YEARMONTH} - DATE_LTRREADING = $00000010; // add marks for left to right reading order layout - {$EXTERNALSYM DATE_LTRREADING} - DATE_RTLREADING = $00000020; // add marks for right to left reading order layout - {$EXTERNALSYM DATE_RTLREADING} - -// -// Calendar Types. -// -// These types are used for the EnumCalendarInfo and GetCalendarInfo -// NLS API routines. -// Some of these types are also used for the SetCalendarInfo NLS API -// routine. -// - -// -// The following CalTypes may be used in combination with any other CalTypes. -// -// CAL_NOUSEROVERRIDE -// -// CAL_USE_CP_ACP is used in the A (Ansi) apis that need to do string -// translation. -// -// CAL_RETURN_NUMBER will return the result from GetCalendarInfo as a -// number instead of a string. This flag is only valid for the CalTypes -// beginning with CAL_I. -// - - CAL_NOUSEROVERRIDE = LOCALE_NOUSEROVERRIDE; // do not use user overrides - {$EXTERNALSYM CAL_NOUSEROVERRIDE} - CAL_USE_CP_ACP = LOCALE_USE_CP_ACP; // use the system ACP - {$EXTERNALSYM CAL_USE_CP_ACP} - CAL_RETURN_NUMBER = LOCALE_RETURN_NUMBER; // return number instead of string - {$EXTERNALSYM CAL_RETURN_NUMBER} - -// line 1014 - - CAL_SYEARMONTH = $0000002f; // year month format string - {$EXTERNALSYM CAL_SYEARMONTH} - CAL_ITWODIGITYEARMAX = $00000030; // two digit year max - {$EXTERNALSYM CAL_ITWODIGITYEARMAX} - -// line 1424 - -type - CALINFO_ENUMPROCEXW = function (lpCalendarInfoString: LPWSTR; Calendar: CALID): BOOL; stdcall; - {$EXTERNALSYM CALINFO_ENUMPROCEXW} - TCalInfoEnumProcExW = CALINFO_ENUMPROCEXW; - -// line 1635 - - -function GetCalendarInfoA(Locale: LCID; Calendar: CALID; CalType: CALTYPE; - lpCalData: LPSTR; cchData: Integer; lpValue: LPDWORD): Integer; stdcall; -{$EXTERNALSYM GetCalendarInfoA} -function GetCalendarInfoW(Locale: LCID; Calendar: CALID; CalType: CALTYPE; - lpCalData: LPWSTR; cchData: Integer; lpValue: LPDWORD): Integer; stdcall; -{$EXTERNALSYM GetCalendarInfoW} - -// line 1754 - -function EnumCalendarInfoExW(lpCalInfoEnumProcEx: CALINFO_ENUMPROCEXW; - Locale: LCID; Calendar: CALID; CalType: CALTYPE): BOOL; stdcall; -{$EXTERNALSYM EnumCalendarInfoExW} - - -{$IFNDEF FPC} -type - MAKEINTRESOURCEA = LPSTR; - {$EXTERNALSYM MAKEINTRESOURCEA} - MAKEINTRESOURCEW = LPWSTR; - {$EXTERNALSYM MAKEINTRESOURCEW} -{$IFDEF SUPPORTS_UNICODE} - MAKEINTRESOURCE = MAKEINTRESOURCEW; - {$EXTERNALSYM MAKEINTRESOURCE} -{$ELSE ~SUPPORTS_UNICODE} - MAKEINTRESOURCE = MAKEINTRESOURCEA; - {$EXTERNALSYM MAKEINTRESOURCE} -{$ENDIF ~SUPPORTS_UNICODE} -{$ENDIF ~FPC} - -// -// Predefined Resource Types -// - -const - RT_CURSOR = MAKEINTRESOURCE(1); - {$EXTERNALSYM RT_CURSOR} - RT_BITMAP = MAKEINTRESOURCE(2); - {$EXTERNALSYM RT_BITMAP} - RT_ICON = MAKEINTRESOURCE(3); - {$EXTERNALSYM RT_ICON} - RT_MENU = MAKEINTRESOURCE(4); - {$EXTERNALSYM RT_MENU} - RT_DIALOG = MAKEINTRESOURCE(5); - {$EXTERNALSYM RT_DIALOG} - RT_STRING = MAKEINTRESOURCE(6); - {$EXTERNALSYM RT_STRING} - RT_FONTDIR = MAKEINTRESOURCE(7); - {$EXTERNALSYM RT_FONTDIR} - RT_FONT = MAKEINTRESOURCE(8); - {$EXTERNALSYM RT_FONT} - RT_ACCELERATOR = MAKEINTRESOURCE(9); - {$EXTERNALSYM RT_ACCELERATOR} - RT_RCDATA = MAKEINTRESOURCE(10); - {$EXTERNALSYM RT_RCDATA} - RT_MESSAGETABLE = MAKEINTRESOURCE(11); - {$EXTERNALSYM RT_MESSAGETABLE} - - DIFFERENCE = 11; - {$EXTERNALSYM DIFFERENCE} - - RT_GROUP_CURSOR = MAKEINTRESOURCE(ULONG_PTR(RT_CURSOR) + DIFFERENCE); - {$EXTERNALSYM RT_GROUP_CURSOR} - RT_GROUP_ICON = MAKEINTRESOURCE(ULONG_PTR(RT_ICON) + DIFFERENCE); - {$EXTERNALSYM RT_GROUP_ICON} - RT_VERSION = MAKEINTRESOURCE(16); - {$EXTERNALSYM RT_VERSION} - RT_DLGINCLUDE = MAKEINTRESOURCE(17); - {$EXTERNALSYM RT_DLGINCLUDE} - RT_PLUGPLAY = MAKEINTRESOURCE(19); - {$EXTERNALSYM RT_PLUGPLAY} - RT_VXD = MAKEINTRESOURCE(20); - {$EXTERNALSYM RT_VXD} - RT_ANICURSOR = MAKEINTRESOURCE(21); - {$EXTERNALSYM RT_ANICURSOR} - RT_ANIICON = MAKEINTRESOURCE(22); - {$EXTERNALSYM RT_ANIICON} - RT_HTML = MAKEINTRESOURCE(23); - {$EXTERNALSYM RT_HTML} - RT_MANIFEST = MAKEINTRESOURCE(24); - CREATEPROCESS_MANIFEST_RESOURCE_ID = MAKEINTRESOURCE(1); - {$EXTERNALSYM CREATEPROCESS_MANIFEST_RESOURCE_ID} - ISOLATIONAWARE_MANIFEST_RESOURCE_ID = MAKEINTRESOURCE(2); - {$EXTERNALSYM ISOLATIONAWARE_MANIFEST_RESOURCE_ID} - ISOLATIONAWARE_NOSTATICIMPORT_MANIFEST_RESOURCE_ID = MAKEINTRESOURCE(3); - {$EXTERNALSYM ISOLATIONAWARE_NOSTATICIMPORT_MANIFEST_RESOURCE_ID} - MINIMUM_RESERVED_MANIFEST_RESOURCE_ID = MAKEINTRESOURCE(1{inclusive}); - {$EXTERNALSYM MINIMUM_RESERVED_MANIFEST_RESOURCE_ID} - MAXIMUM_RESERVED_MANIFEST_RESOURCE_ID = MAKEINTRESOURCE(16{inclusive}); - {$EXTERNALSYM MAXIMUM_RESERVED_MANIFEST_RESOURCE_ID} - -// line 1451 - - KLF_SETFORPROCESS = $00000100; - {$EXTERNALSYM KLF_SETFORPROCESS} - KLF_SHIFTLOCK = $00010000; - {$EXTERNALSYM KLF_SHIFTLOCK} - KLF_RESET = $40000000; - {$EXTERNALSYM KLF_RESET} - -// 64 compatible version of GetWindowLong and SetWindowLong - -const - GWLP_WNDPROC = -4; - {$EXTERNALSYM GWLP_WNDPROC} - GWLP_HINSTANCE = -6; - {$EXTERNALSYM GWLP_HINSTANCE} - GWLP_HWNDPARENT = -8; - {$EXTERNALSYM GWLP_HWNDPARENT} - GWLP_USERDATA = -21; - {$EXTERNALSYM GWLP_USERDATA} - GWLP_ID = -12; - {$EXTERNALSYM GWLP_ID} - -{$EXTERNALSYM GetWindowLongPtr} -function GetWindowLongPtr(hWnd: HWND; nIndex: Integer): TJclAddr; stdcall; -{$EXTERNALSYM SetWindowLongPtr} -function SetWindowLongPtr(hWnd: HWND; nIndex: Integer; dwNewLong: TJclAddr): Longint; stdcall; - -function IsPwrSuspendAllowed: BOOL; stdcall; -function IsPwrHibernateAllowed: BOOL; stdcall; -function IsPwrShutdownAllowed: BOOL; stdcall; -function SetSuspendState(Hibernate, ForceCritical, DisableWakeEvent: BOOL): BOOL; stdcall; - -type - // Microsoft version (64 bit SDK) - {$EXTERNALSYM RVA} - RVA = DWORD; - - // 64-bit PE - {$EXTERNALSYM ImgDelayDescrV2} - ImgDelayDescrV2 = packed record - grAttrs: DWORD; // attributes - rvaDLLName: RVA; // RVA to dll name - rvaHmod: RVA; // RVA of module handle - rvaIAT: RVA; // RVA of the IAT - rvaINT: RVA; // RVA of the INT - rvaBoundIAT: RVA; // RVA of the optional bound IAT - rvaUnloadIAT: RVA; // RVA of optional copy of original IAT - dwTimeStamp: DWORD; // 0 if not bound, - // O.W. date/time stamp of DLL bound to (Old BIND) - end; - {$EXTERNALSYM TImgDelayDescrV2} - TImgDelayDescrV2 = ImgDelayDescrV2; - {$EXTERNALSYM PImgDelayDescrV2} - PImgDelayDescrV2 = ^ImgDelayDescrV2; - - {$EXTERNALSYM PHMODULE} - PHMODULE = ^HMODULE; - - // 32-bit PE - {$EXTERNALSYM ImgDelayDescrV1} - ImgDelayDescrV1 = packed record - grAttrs: DWORD; // attributes - szName: LPCSTR; // pointer to dll name - phmod: PHMODULE; // address of module handle - pIAT: PImageThunkData32; // address of the IAT - pINT: PImageThunkData32; // address of the INT - pBoundIAT: PImageThunkData32; // address of the optional bound IAT - pUnloadIAT: PImageThunkData32; // address of optional copy of original IAT - dwTimeStamp: DWORD; // 0 if not bound, - // O.W. date/time stamp of DLL bound to (Old BIND) - end; - {$EXTERNALSYM TImgDelayDescrV1} - TImgDelayDescrV1 = ImgDelayDescrV1; - {$EXTERNALSYM PImgDelayDescrV1} - PImgDelayDescrV1 = ^ImgDelayDescrV1; - - //{$EXTERNALSYM PImgDelayDescr} - //PImgDelayDescr = ImgDelayDescr; - //TImgDelayDescr = ImgDelayDescr; - -// msidefs.h line 349 - -// PIDs given specific meanings for Installer - -const - PID_MSIVERSION = $0000000E; // integer, Installer version number (major*100+minor) - {$EXTERNALSYM PID_MSIVERSION} - PID_MSISOURCE = $0000000F; // integer, type of file image, short/long, media/tree - {$EXTERNALSYM PID_MSISOURCE} - PID_MSIRESTRICT = $00000010; // integer, transform restrictions - {$EXTERNALSYM PID_MSIRESTRICT} - - -// shlguid.h line 404 - -const - FMTID_ShellDetails: TGUID = '{28636aa6-953d-11d2-b5d6-00c04fd918d0}'; - {$EXTERNALSYM FMTID_ShellDetails} - - PID_FINDDATA = 0; - {$EXTERNALSYM PID_FINDDATA} - PID_NETRESOURCE = 1; - {$EXTERNALSYM PID_NETRESOURCE} - PID_DESCRIPTIONID = 2; - {$EXTERNALSYM PID_DESCRIPTIONID} - PID_WHICHFOLDER = 3; - {$EXTERNALSYM PID_WHICHFOLDER} - PID_NETWORKLOCATION = 4; - {$EXTERNALSYM PID_NETWORKLOCATION} - PID_COMPUTERNAME = 5; - {$EXTERNALSYM PID_COMPUTERNAME} - -// PSGUID_STORAGE comes from ntquery.h -const - FMTID_Storage: TGUID = '{b725f130-47ef-101a-a5f1-02608c9eebac}'; - {$EXTERNALSYM FMTID_Storage} - -// Image properties -const - FMTID_ImageProperties: TGUID = '{14b81da1-0135-4d31-96d9-6cbfc9671a99}'; - {$EXTERNALSYM FMTID_ImageProperties} - -// The GUIDs used to identify shell item attributes (columns). See IShellFolder2::GetDetailsEx implementations... - -const - FMTID_Displaced: TGUID = '{9B174B33-40FF-11d2-A27E-00C04FC30871}'; - {$EXTERNALSYM FMTID_Displaced} - PID_DISPLACED_FROM = 2; - {$EXTERNALSYM PID_DISPLACED_FROM} - PID_DISPLACED_DATE = 3; - {$EXTERNALSYM PID_DISPLACED_DATE} - -const - FMTID_Briefcase: TGUID = '{328D8B21-7729-4bfc-954C-902B329D56B0}'; - {$EXTERNALSYM FMTID_Briefcase} - PID_SYNC_COPY_IN = 2; - {$EXTERNALSYM PID_SYNC_COPY_IN} - -const - FMTID_Misc: TGUID = '{9B174B34-40FF-11d2-A27E-00C04FC30871}'; - {$EXTERNALSYM FMTID_Misc} - PID_MISC_STATUS = 2; - {$EXTERNALSYM PID_MISC_STATUS} - PID_MISC_ACCESSCOUNT = 3; - {$EXTERNALSYM PID_MISC_ACCESSCOUNT} - PID_MISC_OWNER = 4; - {$EXTERNALSYM PID_MISC_OWNER} - PID_HTMLINFOTIPFILE = 5; - {$EXTERNALSYM PID_HTMLINFOTIPFILE} - PID_MISC_PICS = 6; - {$EXTERNALSYM PID_MISC_PICS} - -const - FMTID_WebView: TGUID = '{F2275480-F782-4291-BD94-F13693513AEC}'; - {$EXTERNALSYM FMTID_WebView} - PID_DISPLAY_PROPERTIES = 0; - {$EXTERNALSYM PID_DISPLAY_PROPERTIES} - PID_INTROTEXT = 1; - {$EXTERNALSYM PID_INTROTEXT} - -const - FMTID_MUSIC: TGUID = '{56A3372E-CE9C-11d2-9F0E-006097C686F6}'; - {$EXTERNALSYM FMTID_MUSIC} - PIDSI_ARTIST = 2; - {$EXTERNALSYM PIDSI_ARTIST} - PIDSI_SONGTITLE = 3; - {$EXTERNALSYM PIDSI_SONGTITLE} - PIDSI_ALBUM = 4; - {$EXTERNALSYM PIDSI_ALBUM} - PIDSI_YEAR = 5; - {$EXTERNALSYM PIDSI_YEAR} - PIDSI_COMMENT = 6; - {$EXTERNALSYM PIDSI_COMMENT} - PIDSI_TRACK = 7; - {$EXTERNALSYM PIDSI_TRACK} - PIDSI_GENRE = 11; - {$EXTERNALSYM PIDSI_GENRE} - PIDSI_LYRICS = 12; - {$EXTERNALSYM PIDSI_LYRICS} - -const - FMTID_DRM: TGUID = '{AEAC19E4-89AE-4508-B9B7-BB867ABEE2ED}'; - {$EXTERNALSYM FMTID_DRM} - PIDDRSI_PROTECTED = 2; - {$EXTERNALSYM PIDDRSI_PROTECTED} - PIDDRSI_DESCRIPTION = 3; - {$EXTERNALSYM PIDDRSI_DESCRIPTION} - PIDDRSI_PLAYCOUNT = 4; - {$EXTERNALSYM PIDDRSI_PLAYCOUNT} - PIDDRSI_PLAYSTARTS = 5; - {$EXTERNALSYM PIDDRSI_PLAYSTARTS} - PIDDRSI_PLAYEXPIRES = 6; - {$EXTERNALSYM PIDDRSI_PLAYEXPIRES} - -// FMTID_VideoSummaryInformation property identifiers -const - FMTID_Video: TGUID = '{64440491-4c8b-11d1-8b70-080036b11a03}'; - {$EXTERNALSYM FMTID_Video} - PIDVSI_STREAM_NAME = $00000002; // "StreamName", VT_LPWSTR - {$EXTERNALSYM PIDVSI_STREAM_NAME} - PIDVSI_FRAME_WIDTH = $00000003; // "FrameWidth", VT_UI4 - {$EXTERNALSYM PIDVSI_FRAME_WIDTH} - PIDVSI_FRAME_HEIGHT = $00000004; // "FrameHeight", VT_UI4 - {$EXTERNALSYM PIDVSI_FRAME_HEIGHT} - PIDVSI_TIMELENGTH = $00000007; // "TimeLength", VT_UI4, milliseconds - {$EXTERNALSYM PIDVSI_TIMELENGTH} - PIDVSI_FRAME_COUNT = $00000005; // "FrameCount". VT_UI4 - {$EXTERNALSYM PIDVSI_FRAME_COUNT} - PIDVSI_FRAME_RATE = $00000006; // "FrameRate", VT_UI4, frames/millisecond - {$EXTERNALSYM PIDVSI_FRAME_RATE} - PIDVSI_DATA_RATE = $00000008; // "DataRate", VT_UI4, bytes/second - {$EXTERNALSYM PIDVSI_DATA_RATE} - PIDVSI_SAMPLE_SIZE = $00000009; // "SampleSize", VT_UI4 - {$EXTERNALSYM PIDVSI_SAMPLE_SIZE} - PIDVSI_COMPRESSION = $0000000A; // "Compression", VT_LPWSTR - {$EXTERNALSYM PIDVSI_COMPRESSION} - PIDVSI_STREAM_NUMBER = $0000000B; // "StreamNumber", VT_UI2 - {$EXTERNALSYM PIDVSI_STREAM_NUMBER} - -// FMTID_AudioSummaryInformation property identifiers -const - FMTID_Audio: TGUID = '{64440490-4c8b-11d1-8b70-080036b11a03}'; - {$EXTERNALSYM FMTID_Audio} - PIDASI_FORMAT = $00000002; // VT_BSTR - {$EXTERNALSYM PIDASI_FORMAT} - PIDASI_TIMELENGTH = $00000003; // VT_UI4, milliseconds - {$EXTERNALSYM PIDASI_TIMELENGTH} - PIDASI_AVG_DATA_RATE = $00000004; // VT_UI4, Hz - {$EXTERNALSYM PIDASI_AVG_DATA_RATE} - PIDASI_SAMPLE_RATE = $00000005; // VT_UI4, bits - {$EXTERNALSYM PIDASI_SAMPLE_RATE} - PIDASI_SAMPLE_SIZE = $00000006; // VT_UI4, bits - {$EXTERNALSYM PIDASI_SAMPLE_SIZE} - PIDASI_CHANNEL_COUNT = $00000007; // VT_UI4 - {$EXTERNALSYM PIDASI_CHANNEL_COUNT} - PIDASI_STREAM_NUMBER = $00000008; // VT_UI2 - {$EXTERNALSYM PIDASI_STREAM_NUMBER} - PIDASI_STREAM_NAME = $00000009; // VT_LPWSTR - {$EXTERNALSYM PIDASI_STREAM_NAME} - PIDASI_COMPRESSION = $0000000A; // VT_LPWSTR - {$EXTERNALSYM PIDASI_COMPRESSION} - -const - FMTID_ControlPanel: TGUID = '{305CA226-D286-468e-B848-2B2E8E697B74}'; - {$EXTERNALSYM FMTID_ControlPanel} - PID_CONTROLPANEL_CATEGORY = 2; - {$EXTERNALSYM PID_CONTROLPANEL_CATEGORY} - -const - FMTID_Volume: TGUID = '{9B174B35-40FF-11d2-A27E-00C04FC30871}'; - {$EXTERNALSYM FMTID_Volume} - PID_VOLUME_FREE = 2; - {$EXTERNALSYM PID_VOLUME_FREE} - PID_VOLUME_CAPACITY = 3; - {$EXTERNALSYM PID_VOLUME_CAPACITY} - PID_VOLUME_FILESYSTEM = 4; - {$EXTERNALSYM PID_VOLUME_FILESYSTEM} - -const - FMTID_Share: TGUID = '{D8C3986F-813B-449c-845D-87B95D674ADE}'; - {$EXTERNALSYM FMTID_Share} - PID_SHARE_CSC_STATUS = 2; - {$EXTERNALSYM PID_SHARE_CSC_STATUS} - -const - FMTID_Link: TGUID = '{B9B4B3FC-2B51-4a42-B5D8-324146AFCF25}'; - {$EXTERNALSYM FMTID_Link} - PID_LINK_TARGET = 2; - {$EXTERNALSYM PID_LINK_TARGET} - -const - FMTID_Query: TGUID = '{49691c90-7e17-101a-a91c-08002b2ecda9}'; - {$EXTERNALSYM FMTID_Query} - PID_QUERY_RANK = 2; - {$EXTERNALSYM PID_QUERY_RANK} - -const - FMTID_SummaryInformation: TGUID = '{f29f85e0-4ff9-1068-ab91-08002b27b3d9}'; - {$EXTERNALSYM FMTID_SummaryInformation} - FMTID_DocumentSummaryInformation: TGUID = '{d5cdd502-2e9c-101b-9397-08002b2cf9ae}'; - {$EXTERNALSYM FMTID_DocumentSummaryInformation} - FMTID_MediaFileSummaryInformation: TGUID = '{64440492-4c8b-11d1-8b70-080036b11a03}'; - {$EXTERNALSYM FMTID_MediaFileSummaryInformation} - FMTID_ImageSummaryInformation: TGUID = '{6444048f-4c8b-11d1-8b70-080036b11a03}'; - {$EXTERNALSYM FMTID_ImageSummaryInformation} - -// imgguids.h line 75 - -// Property sets -const - FMTID_ImageInformation: TGUID = '{e5836cbe-5eef-4f1d-acde-ae4c43b608ce}'; - {$EXTERNALSYM FMTID_ImageInformation} - FMTID_JpegAppHeaders: TGUID = '{1c4afdcd-6177-43cf-abc7-5f51af39ee85}'; - {$EXTERNALSYM FMTID_JpegAppHeaders} - - - -// objbase.h line 390 -const - STGFMT_STORAGE = 0; - {$EXTERNALSYM STGFMT_STORAGE} - STGFMT_NATIVE = 1; - {$EXTERNALSYM STGFMT_NATIVE} - STGFMT_FILE = 3; - {$EXTERNALSYM STGFMT_FILE} - STGFMT_ANY = 4; - {$EXTERNALSYM STGFMT_ANY} - STGFMT_DOCFILE = 5; - {$EXTERNALSYM STGFMT_DOCFILE} -// This is a legacy define to allow old component to builds - STGFMT_DOCUMENT = 0; - {$EXTERNALSYM STGFMT_DOCUMENT} - -// objbase.h line 913 - -type - tagSTGOPTIONS = record - usVersion: Word; // Versions 1 and 2 supported - reserved: Word; // must be 0 for padding - ulSectorSize: Cardinal; // docfile header sector size (512) - pwcsTemplateFile: PWideChar; // version 2 or above - end; - {$EXTERNALSYM tagSTGOPTIONS} - STGOPTIONS = tagSTGOPTIONS; - {$EXTERNALSYM STGOPTIONS} - PSTGOPTIONS = ^STGOPTIONS; - {$EXTERNALSYM PSTGOPTIONS} - -function StgCreateStorageEx(const pwcsName: PWideChar; grfMode: DWORD; - stgfmt: DWORD; grfAttrs: DWORD; pStgOptions: PSTGOPTIONS; reserved2: Pointer; - riid: PGUID; out stgOpen: IInterface): HResult; stdcall; -{$EXTERNALSYM StgCreateStorageEx} - -function StgOpenStorageEx(const pwcsName: PWideChar; grfMode: DWORD; - stgfmt: DWORD; grfAttrs: DWORD; pStgOptions: PSTGOPTIONS; reserved2: Pointer; - riid: PGUID; out stgOpen: IInterface): HResult; stdcall; -{$EXTERNALSYM StgOpenStorageEx} - - -// propidl.h line 386 - -// Reserved global Property IDs -const - PID_DICTIONARY = $00000000; // integer count + array of entries - {$EXTERNALSYM PID_DICTIONARY} - PID_CODEPAGE = $00000001; // short integer - {$EXTERNALSYM PID_CODEPAGE} - PID_FIRST_USABLE = $00000002; - {$EXTERNALSYM PID_FIRST_USABLE} - PID_FIRST_NAME_DEFAULT = $00000FFF; - {$EXTERNALSYM PID_FIRST_NAME_DEFAULT} - PID_LOCALE = $80000000; - {$EXTERNALSYM PID_LOCALE} - PID_MODIFY_TIME = $80000001; - {$EXTERNALSYM PID_MODIFY_TIME} - PID_SECURITY = $80000002; - {$EXTERNALSYM PID_SECURITY} - PID_BEHAVIOR = $80000003; - {$EXTERNALSYM PID_BEHAVIOR} - PID_ILLEGAL = $FFFFFFFF; - {$EXTERNALSYM PID_ILLEGAL} - -// Range which is read-only to downlevel implementations - -const - PID_MIN_READONLY = $80000000; - {$EXTERNALSYM PID_MIN_READONLY} - PID_MAX_READONLY = $BFFFFFFF; - {$EXTERNALSYM PID_MAX_READONLY} - -// Property IDs for the DiscardableInformation Property Set - -const - PIDDI_THUMBNAIL = $00000002; // VT_BLOB - {$EXTERNALSYM PIDDI_THUMBNAIL} - -// Property IDs for the SummaryInformation Property Set - -const - PIDSI_TITLE = $00000002; // VT_LPSTR - {$EXTERNALSYM PIDSI_TITLE} - PIDSI_SUBJECT = $00000003; // VT_LPSTR - {$EXTERNALSYM PIDSI_SUBJECT} - PIDSI_AUTHOR = $00000004; // VT_LPSTR - {$EXTERNALSYM PIDSI_AUTHOR} - PIDSI_KEYWORDS = $00000005; // VT_LPSTR - {$EXTERNALSYM PIDSI_KEYWORDS} - PIDSI_COMMENTS = $00000006; // VT_LPSTR - {$EXTERNALSYM PIDSI_COMMENTS} - PIDSI_TEMPLATE = $00000007; // VT_LPSTR - {$EXTERNALSYM PIDSI_TEMPLATE} - PIDSI_LASTAUTHOR = $00000008; // VT_LPSTR - {$EXTERNALSYM PIDSI_LASTAUTHOR} - PIDSI_REVNUMBER = $00000009; // VT_LPSTR - {$EXTERNALSYM PIDSI_REVNUMBER} - PIDSI_EDITTIME = $0000000A; // VT_FILETIME (UTC) - {$EXTERNALSYM PIDSI_EDITTIME} - PIDSI_LASTPRINTED = $0000000B; // VT_FILETIME (UTC) - {$EXTERNALSYM PIDSI_LASTPRINTED} - PIDSI_CREATE_DTM = $0000000C; // VT_FILETIME (UTC) - {$EXTERNALSYM PIDSI_CREATE_DTM} - PIDSI_LASTSAVE_DTM = $0000000D; // VT_FILETIME (UTC) - {$EXTERNALSYM PIDSI_LASTSAVE_DTM} - PIDSI_PAGECOUNT = $0000000E; // VT_I4 - {$EXTERNALSYM PIDSI_PAGECOUNT} - PIDSI_WORDCOUNT = $0000000F; // VT_I4 - {$EXTERNALSYM PIDSI_WORDCOUNT} - PIDSI_CHARCOUNT = $00000010; // VT_I4 - {$EXTERNALSYM PIDSI_CHARCOUNT} - PIDSI_THUMBNAIL = $00000011; // VT_CF - {$EXTERNALSYM PIDSI_THUMBNAIL} - PIDSI_APPNAME = $00000012; // VT_LPSTR - {$EXTERNALSYM PIDSI_APPNAME} - PIDSI_DOC_SECURITY = $00000013; // VT_I4 - {$EXTERNALSYM PIDSI_DOC_SECURITY} - -// Property IDs for the DocSummaryInformation Property Set - -const - PIDDSI_CATEGORY = $00000002; // VT_LPSTR - {$EXTERNALSYM PIDDSI_CATEGORY} - PIDDSI_PRESFORMAT = $00000003; // VT_LPSTR - {$EXTERNALSYM PIDDSI_PRESFORMAT} - PIDDSI_BYTECOUNT = $00000004; // VT_I4 - {$EXTERNALSYM PIDDSI_BYTECOUNT} - PIDDSI_LINECOUNT = $00000005; // VT_I4 - {$EXTERNALSYM PIDDSI_LINECOUNT} - PIDDSI_PARCOUNT = $00000006; // VT_I4 - {$EXTERNALSYM PIDDSI_PARCOUNT} - PIDDSI_SLIDECOUNT = $00000007; // VT_I4 - {$EXTERNALSYM PIDDSI_SLIDECOUNT} - PIDDSI_NOTECOUNT = $00000008; // VT_I4 - {$EXTERNALSYM PIDDSI_NOTECOUNT} - PIDDSI_HIDDENCOUNT = $00000009; // VT_I4 - {$EXTERNALSYM PIDDSI_HIDDENCOUNT} - PIDDSI_MMCLIPCOUNT = $0000000A; // VT_I4 - {$EXTERNALSYM PIDDSI_MMCLIPCOUNT} - PIDDSI_SCALE = $0000000B; // VT_BOOL - {$EXTERNALSYM PIDDSI_SCALE} - PIDDSI_HEADINGPAIR = $0000000C; // VT_VARIANT | VT_VECTOR - {$EXTERNALSYM PIDDSI_HEADINGPAIR} - PIDDSI_DOCPARTS = $0000000D; // VT_LPSTR | VT_VECTOR - {$EXTERNALSYM PIDDSI_DOCPARTS} - PIDDSI_MANAGER = $0000000E; // VT_LPSTR - {$EXTERNALSYM PIDDSI_MANAGER} - PIDDSI_COMPANY = $0000000F; // VT_LPSTR - {$EXTERNALSYM PIDDSI_COMPANY} - PIDDSI_LINKSDIRTY = $00000010; // VT_BOOL - {$EXTERNALSYM PIDDSI_LINKSDIRTY} - -// FMTID_MediaFileSummaryInfo - Property IDs - -const - PIDMSI_EDITOR = $00000002; // VT_LPWSTR - {$EXTERNALSYM PIDMSI_EDITOR} - PIDMSI_SUPPLIER = $00000003; // VT_LPWSTR - {$EXTERNALSYM PIDMSI_SUPPLIER} - PIDMSI_SOURCE = $00000004; // VT_LPWSTR - {$EXTERNALSYM PIDMSI_SOURCE} - PIDMSI_SEQUENCE_NO = $00000005; // VT_LPWSTR - {$EXTERNALSYM PIDMSI_SEQUENCE_NO} - PIDMSI_PROJECT = $00000006; // VT_LPWSTR - {$EXTERNALSYM PIDMSI_PROJECT} - PIDMSI_STATUS = $00000007; // VT_UI4 - {$EXTERNALSYM PIDMSI_STATUS} - PIDMSI_OWNER = $00000008; // VT_LPWSTR - {$EXTERNALSYM PIDMSI_OWNER} - PIDMSI_RATING = $00000009; // VT_LPWSTR - {$EXTERNALSYM PIDMSI_RATING} - PIDMSI_PRODUCTION = $0000000A; // VT_FILETIME (UTC) - {$EXTERNALSYM PIDMSI_PRODUCTION} - PIDMSI_COPYRIGHT = $0000000B; // VT_LPWSTR - {$EXTERNALSYM PIDMSI_COPYRIGHT} - -function PropVariantClear(var Prop: TPropVariant): HResult; stdcall; -{$EXTERNALSYM PropVariantClear} - - -// NtSecApi.h line 566 -type - PLSA_UNICODE_STRING = ^LSA_UNICODE_STRING; - _LSA_UNICODE_STRING = record - Length: USHORT; - MaximumLength: USHORT; - Buffer: {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.LPWSTR; - end; - LSA_UNICODE_STRING = _LSA_UNICODE_STRING; - TLsaUnicodeString = LSA_UNICODE_STRING; - PLsaUnicodeString = PLSA_UNICODE_STRING; - - PLSA_STRING = ^LSA_STRING; - _LSA_STRING = record - Length: USHORT; - MaximumLength: USHORT; - Buffer: PANSICHAR; - end; - LSA_STRING = _LSA_STRING; - TLsaString = LSA_STRING; - PLsaString = PLSA_STRING; - - PLSA_OBJECT_ATTRIBUTES = ^LSA_OBJECT_ATTRIBUTES; - _LSA_OBJECT_ATTRIBUTES = record - Length: ULONG; - RootDirectory: {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.THandle; - ObjectName: PLSA_UNICODE_STRING; - Attributes: ULONG; - SecurityDescriptor: Pointer; // Points to type SECURITY_DESCRIPTOR - SecurityQualityOfService: Pointer; // Points to type SECURITY_QUALITY_OF_SERVICE - end; - LSA_OBJECT_ATTRIBUTES = _LSA_OBJECT_ATTRIBUTES; - TLsaObjectAttributes = _LSA_OBJECT_ATTRIBUTES; - PLsaObjectAttributes = PLSA_OBJECT_ATTRIBUTES; - -// NtSecApi.h line 680 - -//////////////////////////////////////////////////////////////////////////// -// // -// Local Security Policy Administration API datatypes and defines // -// // -//////////////////////////////////////////////////////////////////////////// - -// -// Access types for the Policy object -// - -const - POLICY_VIEW_LOCAL_INFORMATION = $00000001; - {$EXTERNALSYM POLICY_VIEW_LOCAL_INFORMATION} - POLICY_VIEW_AUDIT_INFORMATION = $00000002; - {$EXTERNALSYM POLICY_VIEW_AUDIT_INFORMATION} - POLICY_GET_PRIVATE_INFORMATION = $00000004; - {$EXTERNALSYM POLICY_GET_PRIVATE_INFORMATION} - POLICY_TRUST_ADMIN = $00000008; - {$EXTERNALSYM POLICY_TRUST_ADMIN} - POLICY_CREATE_ACCOUNT = $00000010; - {$EXTERNALSYM POLICY_CREATE_ACCOUNT} - POLICY_CREATE_SECRET = $00000020; - {$EXTERNALSYM POLICY_CREATE_SECRET} - POLICY_CREATE_PRIVILEGE = $00000040; - {$EXTERNALSYM POLICY_CREATE_PRIVILEGE} - POLICY_SET_DEFAULT_QUOTA_LIMITS = $00000080; - {$EXTERNALSYM POLICY_SET_DEFAULT_QUOTA_LIMITS} - POLICY_SET_AUDIT_REQUIREMENTS = $00000100; - {$EXTERNALSYM POLICY_SET_AUDIT_REQUIREMENTS} - POLICY_AUDIT_LOG_ADMIN = $00000200; - {$EXTERNALSYM POLICY_AUDIT_LOG_ADMIN} - POLICY_SERVER_ADMIN = $00000400; - {$EXTERNALSYM POLICY_SERVER_ADMIN} - POLICY_LOOKUP_NAMES = $00000800; - {$EXTERNALSYM POLICY_LOOKUP_NAMES} - POLICY_NOTIFICATION = $00001000; - {$EXTERNALSYM POLICY_NOTIFICATION} - - POLICY_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED or - POLICY_VIEW_LOCAL_INFORMATION or - POLICY_VIEW_AUDIT_INFORMATION or - POLICY_GET_PRIVATE_INFORMATION or - POLICY_TRUST_ADMIN or - POLICY_CREATE_ACCOUNT or - POLICY_CREATE_SECRET or - POLICY_CREATE_PRIVILEGE or - POLICY_SET_DEFAULT_QUOTA_LIMITS or - POLICY_SET_AUDIT_REQUIREMENTS or - POLICY_AUDIT_LOG_ADMIN or - POLICY_SERVER_ADMIN or - POLICY_LOOKUP_NAMES); - {$EXTERNALSYM POLICY_ALL_ACCESS} - - POLICY_READ = (STANDARD_RIGHTS_READ or - POLICY_VIEW_AUDIT_INFORMATION or - POLICY_GET_PRIVATE_INFORMATION); - {$EXTERNALSYM POLICY_READ} - - POLICY_WRITE = (STANDARD_RIGHTS_WRITE or - POLICY_TRUST_ADMIN or - POLICY_CREATE_ACCOUNT or - POLICY_CREATE_SECRET or - POLICY_CREATE_PRIVILEGE or - POLICY_SET_DEFAULT_QUOTA_LIMITS or - POLICY_SET_AUDIT_REQUIREMENTS or - POLICY_AUDIT_LOG_ADMIN or - POLICY_SERVER_ADMIN); - {$EXTERNALSYM POLICY_WRITE} - - POLICY_EXECUTE = (STANDARD_RIGHTS_EXECUTE or - POLICY_VIEW_LOCAL_INFORMATION or - POLICY_LOOKUP_NAMES); - {$EXTERNALSYM POLICY_EXECUTE} - -// NtSecApi.h line 914 -type - _POLICY_INFORMATION_CLASS = ( - picFill0, - PolicyAuditLogInformation, - PolicyAuditEventsInformation, - PolicyPrimaryDomainInformation, - PolicyPdAccountInformation, - PolicyAccountDomainInformation, - PolicyLsaServerRoleInformation, - PolicyReplicaSourceInformation, - PolicyDefaultQuotaInformation, - PolicyModificationInformation, - PolicyAuditFullSetInformation, - PolicyAuditFullQueryInformation, - PolicyDnsDomainInformation, - PolicyDnsDomainInformationInt); - {$EXTERNALSYM _POLICY_INFORMATION_CLASS} - POLICY_INFORMATION_CLASS = _POLICY_INFORMATION_CLASS; - {$EXTERNALSYM POLICY_INFORMATION_CLASS} - PPOLICY_INFORMATION_CLASS = ^POLICY_INFORMATION_CLASS; - {$EXTERNALSYM PPOLICY_INFORMATION_CLASS} - TPolicyInformationClass = POLICY_INFORMATION_CLASS; - {$EXTERNALSYM TPolicyInformationClass} - PPolicyInformationClass = PPOLICY_INFORMATION_CLASS; - {$EXTERNALSYM PPolicyInformationClass} - -// NtSecApi.h line 1031 -// -// The following structure corresponds to the PolicyAccountDomainInformation -// information class. -// -type - PPOLICY_ACCOUNT_DOMAIN_INFO = ^POLICY_ACCOUNT_DOMAIN_INFO; - _POLICY_ACCOUNT_DOMAIN_INFO = record - DomainName: LSA_UNICODE_STRING; - DomainSid: {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.PSID; - end; - POLICY_ACCOUNT_DOMAIN_INFO = _POLICY_ACCOUNT_DOMAIN_INFO; - TPolicyAccountDomainInfo = POLICY_ACCOUNT_DOMAIN_INFO; - PPolicyAccountDomainInfo = PPOLICY_ACCOUNT_DOMAIN_INFO; - -// NtSecApi.h line 1298 -type - LSA_HANDLE = Pointer; - PLSA_HANDLE = ^LSA_HANDLE; - TLsaHandle = LSA_HANDLE; - -// NtSecApi.h line 1714 -type - NTSTATUS = DWORD; - -function LsaOpenPolicy(SystemName: PLSA_UNICODE_STRING; - var ObjectAttributes: LSA_OBJECT_ATTRIBUTES; DesiredAccess: ACCESS_MASK; - var PolicyHandle: LSA_HANDLE): NTSTATUS; stdcall; -function LsaQueryInformationPolicy(PolicyHandle: LSA_HANDLE; - InformationClass: POLICY_INFORMATION_CLASS; var Buffer: Pointer): NTSTATUS; stdcall; -function LsaFreeMemory(Buffer: Pointer): NTSTATUS; stdcall; -function LsaFreeReturnBuffer(Buffer: Pointer): NTSTATUS; stdcall; -function LsaClose(ObjectHandle: LSA_HANDLE): NTSTATUS; stdcall; -function LsaNtStatusToWinError(Status: NTSTATUS): ULONG; stdcall; - - -// Snapshot function - -function CreateToolhelp32Snapshot(dwFlags, th32ProcessID: DWORD): THandle; stdcall; -{$EXTERNALSYM CreateToolhelp32Snapshot} - -// -// The th32ProcessID argument is only used if TH32CS_SNAPHEAPLIST or -// TH32CS_SNAPMODULE is specified. th32ProcessID == 0 means the current -// process. -// -// NOTE that all of the snapshots are global except for the heap and module -// lists which are process specific. To enumerate the heap or module -// state for all WIN32 processes call with TH32CS_SNAPALL and the -// current process. Then for each process in the TH32CS_SNAPPROCESS -// list that isn't the current process, do a call with just -// TH32CS_SNAPHEAPLIST and/or TH32CS_SNAPMODULE. -// -// dwFlags -// - -const - TH32CS_SNAPHEAPLIST = $00000001; - {$EXTERNALSYM TH32CS_SNAPHEAPLIST} - TH32CS_SNAPPROCESS = $00000002; - {$EXTERNALSYM TH32CS_SNAPPROCESS} - TH32CS_SNAPTHREAD = $00000004; - {$EXTERNALSYM TH32CS_SNAPTHREAD} - TH32CS_SNAPMODULE = $00000008; - {$EXTERNALSYM TH32CS_SNAPMODULE} - TH32CS_SNAPMODULE32 = $00000010; - {$EXTERNALSYM TH32CS_SNAPMODULE32} - TH32CS_SNAPALL = TH32CS_SNAPHEAPLIST or TH32CS_SNAPPROCESS or - TH32CS_SNAPTHREAD or TH32CS_SNAPMODULE; - {$EXTERNALSYM TH32CS_SNAPALL} - TH32CS_INHERIT = $80000000; - {$EXTERNALSYM TH32CS_INHERIT} - -// -// Use CloseHandle to destroy the snapshot -// - -// Thread walking - -type - PTHREADENTRY32 = ^THREADENTRY32; - {$EXTERNALSYM PTHREADENTRY32} - tagTHREADENTRY32 = record - dwSize: DWORD; - cntUsage: DWORD; - th32ThreadID: DWORD; // this thread - th32OwnerProcessID: DWORD; // Process this thread is associated with - tpBasePri: Longint; - tpDeltaPri: Longint; - dwFlags: DWORD; - end; - {$EXTERNALSYM tagTHREADENTRY32} - THREADENTRY32 = tagTHREADENTRY32; - {$EXTERNALSYM THREADENTRY32} - LPTHREADENTRY32 = ^THREADENTRY32; - {$EXTERNALSYM LPTHREADENTRY32} - TThreadEntry32 = THREADENTRY32; - {$EXTERNALSYM TThreadEntry32} - -function Thread32First(hSnapshot: THandle; var lpte: THREADENTRY32): BOOL; stdcall; -{$EXTERNALSYM Thread32First} -function Thread32Next(hSnapshot: THandle; var lpte: THREADENTRY32): BOOL; stdcall; -{$EXTERNALSYM Thread32Next} - - - -type - _THREAD_INFORMATION_CLASS = type Cardinal; - {$EXTERNALSYM _THREAD_INFORMATION_CLASS} - THREAD_INFORMATION_CLASS = _THREAD_INFORMATION_CLASS; - {$EXTERNALSYM THREAD_INFORMATION_CLASS} - PTHREAD_INFORMATION_CLASS = ^_THREAD_INFORMATION_CLASS; - {$EXTERNALSYM PTHREAD_INFORMATION_CLASS} - -const - ThreadBasicInformation = 0; - {$EXTERNALSYM ThreadBasicInformation} - ThreadTimes = 1; - {$EXTERNALSYM ThreadTimes} - ThreadPriority = 2; - {$EXTERNALSYM ThreadPriority} - ThreadBasePriority = 3; - {$EXTERNALSYM ThreadBasePriority} - ThreadAffinityMask = 4; - {$EXTERNALSYM ThreadAffinityMask} - ThreadImpersonationToken = 5; - {$EXTERNALSYM ThreadImpersonationToken} - ThreadDescriptorTableEntry = 6; - {$EXTERNALSYM ThreadDescriptorTableEntry} - ThreadEnableAlignmentFaultFixup = 7; - {$EXTERNALSYM ThreadEnableAlignmentFaultFixup} - ThreadEventPair = 8; - {$EXTERNALSYM ThreadEventPair} - ThreadQuerySetWin32StartAddress = 9; - {$EXTERNALSYM ThreadQuerySetWin32StartAddress} - ThreadZeroTlsCell = 10; - {$EXTERNALSYM ThreadZeroTlsCell} - ThreadPerformanceCount = 11; - {$EXTERNALSYM ThreadPerformanceCount} - ThreadAmILastThread = 12; - {$EXTERNALSYM ThreadAmILastThread} - ThreadIdealProcessor = 13; - {$EXTERNALSYM ThreadIdealProcessor} - ThreadPriorityBoost = 14; - {$EXTERNALSYM ThreadPriorityBoost} - ThreadSetTlsArrayAddress = 15; - {$EXTERNALSYM ThreadSetTlsArrayAddress} - ThreadIsIoPending = 16; - {$EXTERNALSYM ThreadIsIoPending} - ThreadHideFromDebugger = 17; - {$EXTERNALSYM ThreadHideFromDebugger} - -type - _CLIENT_ID = record - UniqueProcess: THandle; - UniqueThread: THandle; - end; - {$EXTERNALSYM _CLIENT_ID} - CLIENT_ID = _CLIENT_ID; - {$EXTERNALSYM CLIENT_ID} - PCLIENT_ID = ^CLIENT_ID; - {$EXTERNALSYM PCLIENT_ID} - - KAFFINITY = ULONG; - {$EXTERNALSYM KAFFINITY} - - KPRIORITY = LongInt; - {$EXTERNALSYM KPRIORITY} - - _THREAD_BASIC_INFORMATION = record - ExitStatus: NTSTATUS; - TebBaseAddress: Pointer; - ClientId: CLIENT_ID; - AffinityMask: KAFFINITY; - Priority: KPRIORITY; - BasePriority: KPRIORITY; - end; - {$EXTERNALSYM _THREAD_BASIC_INFORMATION} - THREAD_BASIC_INFORMATION = _THREAD_BASIC_INFORMATION; - {$EXTERNALSYM THREAD_BASIC_INFORMATION} - PTHREAD_BASIC_INFORMATION = ^_THREAD_BASIC_INFORMATION; - {$EXTERNALSYM PTHREAD_BASIC_INFORMATION} - -function NtQueryInformationThread(ThreadHandle: THandle; ThreadInformationClass: THREAD_INFORMATION_CLASS; - ThreadInformation: Pointer; ThreadInformationLength: ULONG; ReturnLength: PULONG): NTSTATUS; stdcall; -{$EXTERNALSYM NtQueryInformationThread} - - - -//DOM-IGNORE-END - - -const - RtdlSetNamedSecurityInfoW: function(pObjectName: LPWSTR; ObjectType: SE_OBJECT_TYPE; - SecurityInfo: SECURITY_INFORMATION; psidOwner, psidGroup: PSID; - pDacl, pSacl: PACL): DWORD stdcall = SetNamedSecurityInfoW; - - RtdlSetWaitableTimer: function(hTimer: THandle; var lpDueTime: TLargeInteger; - lPeriod: Longint; pfnCompletionRoutine: TFNTimerAPCRoutine; - lpArgToCompletionRoutine: Pointer; fResume: BOOL): BOOL stdcall = SetWaitableTimer; - - RtdlNetUserAdd: function(servername: LPCWSTR; level: DWORD; - buf: PByte; parm_err: PDWord): NET_API_STATUS stdcall = NetUserAdd; - - RtdlNetUserDel: function(servername: LPCWSTR; - username: LPCWSTR): NET_API_STATUS stdcall = NetUserDel; - - RtdlNetGroupAdd: function(servername: LPCWSTR; level: DWORD; buf: PByte; - parm_err: PDWord): NET_API_STATUS stdcall = NetGroupAdd; - - RtdlNetGroupEnum: function(servername: LPCWSTR; level: DWORD; - out bufptr: PByte; prefmaxlen: DWORD; out entriesread, totalentries: DWORD; - resume_handle: PDWORD_PTR): NET_API_STATUS stdcall = NetGroupEnum; - - RtdlNetGroupDel: function(servername: LPCWSTR; - groupname: LPCWSTR): NET_API_STATUS stdcall = NetGroupDel; - - RtdlNetLocalGroupAdd: function(servername: LPCWSTR; level: DWORD; - buf: PByte; parm_err: PDWord): NET_API_STATUS stdcall = NetLocalGroupAdd; - - RtdlNetLocalGroupEnum: function(servername: LPCWSTR; level: DWORD; - out bufptr: PByte; prefmaxlen: DWORD; out entriesread, totalentries: DWORD; - resumehandle: PDWORD_PTR): NET_API_STATUS stdcall = NetLocalGroupEnum; - - RtdlNetLocalGroupDel: function(servername: LPCWSTR; - groupname: LPCWSTR): NET_API_STATUS stdcall = NetLocalGroupDel; - - RtdlNetLocalGroupAddMembers: function(servername: LPCWSTR; groupname: LPCWSTR; - level: DWORD; buf: PByte; - totalentries: DWORD): NET_API_STATUS stdcall = NetLocalGroupAddMembers; - - RtdlNetApiBufferFree: function(Buffer: Pointer): NET_API_STATUS stdcall = NetApiBufferFree; - - RtdlGetCalendarInfoA: function(Locale: LCID; Calendar: CALID; CalType: CALTYPE; - lpCalData: PAnsiChar; cchData: Integer; - lpValue: PDWORD): Integer stdcall = GetCalendarInfoA; - - RtdlGetCalendarInfoW: function(Locale: LCID; Calendar: CALID; CalType: CALTYPE; - lpCalData: PWideChar; cchData: Integer; - lpValue: PDWORD): Integer stdcall = GetCalendarInfoW; - - RtdlEnumCalendarInfoExW: function(lpCalInfoEnumProc: TCalInfoEnumProcExW; - Locale: LCID; Calendar: CALID; CalType: CALTYPE): BOOL stdcall = EnumCalendarInfoExW; - - RtdlGetVolumeNameForVolumeMountPointW: function(lpszVolumeMountPoint: LPCWSTR; - lpszVolumeName: LPWSTR; cchBufferLength: DWORD): BOOL stdcall = GetVolumeNameForVolumeMountPointW; - - RtdlSetVolumeMountPointW: function(lpszVolumeMountPoint: LPCWSTR; - lpszVolumeName: LPCWSTR): BOOL stdcall = SetVolumeMountPointW; - - RtdlDeleteVolumeMountPointW: function(lpszVolumeMountPoint: LPCWSTR): BOOL - stdcall = DeleteVolumeMountPointW; - - RtdlNetBios: function(P: PNCB): UCHAR stdcall = NetBios; - - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\windows' - ); -{$ENDIF UNITVERSIONING} - -implementation - -uses - JclResources; - -procedure GetProcedureAddress(var P: Pointer; const ModuleName, ProcName: string); -var - ModuleHandle: HMODULE; -begin - if not Assigned(P) then - begin - ModuleHandle := GetModuleHandle(PChar(ModuleName)); - if ModuleHandle = 0 then - begin - ModuleHandle := SafeLoadLibrary(PChar(ModuleName)); - if ModuleHandle = 0 then - raise EJclError.CreateResFmt(@RsELibraryNotFound, [ModuleName]); - end; - P := GetProcAddress(ModuleHandle, PChar(ProcName)); - if not Assigned(P) then - raise EJclError.CreateResFmt(@RsEFunctionNotFound, [ModuleName, ProcName]); - end; -end; - -//== { EJclWin32Error } ====================================================== - - -constructor EJclWin32Error.Create(const Msg: string); -begin - FLastError := GetLastError; - FLastErrorMsg := SysErrorMessage(FLastError); - inherited CreateResFmt(@RsWin32Error, [FLastErrorMsg, FLastError, NativeLineBreak, Msg]); -end; - -constructor EJclWin32Error.CreateFmt(const Msg: string; const Args: array of const); -begin - FLastError := GetLastError; - FLastErrorMsg := SysErrorMessage(FLastError); - inherited CreateResFmt(@RsWin32Error, [FLastErrorMsg, FLastError, NativeLineBreak, Format(Msg, Args)]); -end; - -constructor EJclWin32Error.CreateRes(Ident: Integer); -begin - FLastError := GetLastError; - FLastErrorMsg := SysErrorMessage(FLastError); - inherited CreateResFmt(@RsWin32Error, [FLastErrorMsg, FLastError, NativeLineBreak, LoadStr(Ident)]); -end; - -constructor EJclWin32Error.CreateRes(ResStringRec: PResStringRec); -begin - FLastError := GetLastError; - FLastErrorMsg := SysErrorMessage(FLastError); - inherited CreateResFmt(@RsWin32Error, [FLastErrorMsg, FLastError, NativeLineBreak, LoadResString(ResStringRec)]); -end; - - - -const - aclapilib = 'advapi32.dll'; - -type - TSetNamedSecurityInfoW = function (pObjectName: LPWSTR; ObjectType: SE_OBJECT_TYPE; - SecurityInfo: SECURITY_INFORMATION; psidOwner, psidGroup: PSID; - pDacl, pSacl: PACL): DWORD; stdcall; - -var - _SetNamedSecurityInfoW: TSetNamedSecurityInfoW = nil; - -function SetNamedSecurityInfoW(pObjectName: LPWSTR; ObjectType: SE_OBJECT_TYPE; - SecurityInfo: SECURITY_INFORMATION; psidOwner, psidGroup: PSID; - pDacl, pSacl: PACL): DWORD; -begin - GetProcedureAddress(Pointer(@_SetNamedSecurityInfoW), aclapilib, 'SetNamedSecurityInfoW'); - Result := _SetNamedSecurityInfoW(pObjectName, ObjectType, SecurityInfo, psidOwner, psidGroup, pDacl, pSacl); -end; - - - -const - ImageHlpLib = 'imagehlp.dll'; - -type - TReBaseImage = function (CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; - fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; - var OldImageSize: TJclAddr32; var OldImageBase: TJclAddr; - var NewImageSize: TJclAddr32; var NewImageBase: TJclAddr; TimeStamp: ULONG): BOOL; stdcall; - -var - _ReBaseImage: TReBaseImage = nil; - -function ReBaseImage(CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; - fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; - var OldImageSize: TJclAddr32; var OldImageBase: TJclAddr; - var NewImageSize: TJclAddr32; var NewImageBase: TJclAddr; TimeStamp: ULONG): BOOL; -begin - GetProcedureAddress(Pointer(@_ReBaseImage), ImageHlpLib, 'ReBaseImage'); - Result := _ReBaseImage(CurrentImageName, SymbolPath, fReBase, fRebaseSysfileOk, fGoingDown, CheckImageSize, OldImageSize, OldImageBase, NewImageSize, NewImageBase, TimeStamp); -end; - -type - TReBaseImage64 = function (CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; - fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; - var OldImageSize: TJclAddr32; var OldImageBase: TJclAddr64; - var NewImageSize: TJclAddr32; var NewImageBase: TJclAddr64; TimeStamp: ULONG): BOOL; stdcall; - -var - _ReBaseImage64: TReBaseImage64 = nil; - -function ReBaseImage64(CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; - fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; - var OldImageSize: TJclAddr32; var OldImageBase: TJclAddr64; - var NewImageSize: TJclAddr32; var NewImageBase: TJclAddr64; TimeStamp: ULONG): BOOL; -begin - GetProcedureAddress(Pointer(@_ReBaseImage64), ImageHlpLib, 'ReBaseImage64'); - Result := _ReBaseImage64(CurrentImageName, SymbolPath, fReBase, fRebaseSysfileOk, fGoingDown, CheckImageSize, OldImageSize, OldImageBase, NewImageSize, NewImageBase, TimeStamp); -end; - -type - TCheckSumMappedFile = function (BaseAddress: Pointer; FileLength: DWORD; - out HeaderSum, CheckSum: DWORD): PImageNtHeaders; stdcall; - -var - _CheckSumMappedFile: TCheckSumMappedFile = nil; - -function CheckSumMappedFile(BaseAddress: Pointer; FileLength: DWORD; - out HeaderSum, CheckSum: DWORD): PImageNtHeaders; -begin - GetProcedureAddress(Pointer(@_CheckSumMappedFile), ImageHlpLib, 'CheckSumMappedFile'); - Result := _CheckSumMappedFile(BaseAddress, FileLength, HeaderSum, CheckSum); -end; - -type - TGetImageUnusedHeaderBytes = function (const LoadedImage: LOADED_IMAGE; - var SizeUnusedHeaderBytes: DWORD): DWORD; stdcall; - -var - _GetImageUnusedHeaderBytes: TGetImageUnusedHeaderBytes = nil; - -function GetImageUnusedHeaderBytes(const LoadedImage: LOADED_IMAGE; - var SizeUnusedHeaderBytes: DWORD): DWORD; -begin - GetProcedureAddress(Pointer(@_GetImageUnusedHeaderBytes), ImageHlpLib, 'GetImageUnusedHeaderBytes'); - Result := _GetImageUnusedHeaderBytes(LoadedImage, SizeUnusedHeaderBytes); -end; - -type - TMapAndLoad = function (ImageName, DllPath: PAnsiChar; var LoadedImage: LOADED_IMAGE; - DotDll: BOOL; ReadOnly: BOOL): BOOL; stdcall; - -var - _MapAndLoad: TMapAndLoad = nil; - -function MapAndLoad(ImageName, DllPath: PAnsiChar; var LoadedImage: LOADED_IMAGE; - DotDll: BOOL; ReadOnly: BOOL): BOOL; -begin - GetProcedureAddress(Pointer(@_MapAndLoad), ImageHlpLib, 'MapAndLoad'); - Result := _MapAndLoad(ImageName, DllPath, LoadedImage, DotDll, ReadOnly); -end; - -type - TUnMapAndLoad = function (const LoadedImage: LOADED_IMAGE): BOOL; stdcall; - -var - _UnMapAndLoad: TUnMapAndLoad = nil; - -function UnMapAndLoad(const LoadedImage: LOADED_IMAGE): BOOL; -begin - GetProcedureAddress(Pointer(@_UnMapAndLoad), ImageHlpLib, 'UnMapAndLoad'); - Result := _UnMapAndLoad(LoadedImage); -end; - -type - TTouchFileTimes = function (const FileHandle: THandle; const pSystemTime: TSystemTime): BOOL; stdcall; - -var - _TouchFileTimes: TTouchFileTimes = nil; - -function TouchFileTimes(const FileHandle: THandle; const pSystemTime: TSystemTime): BOOL; -begin - GetProcedureAddress(Pointer(@_TouchFileTimes), ImageHlpLib, 'TouchFileTimes'); - Result := _TouchFileTimes(FileHandle, pSystemTime); -end; - -type - TImageDirectoryEntryToData = function (Base: Pointer; MappedAsImage: ByteBool; - DirectoryEntry: USHORT; var Size: ULONG): Pointer; stdcall; - -var - _ImageDirectoryEntryToData: TImageDirectoryEntryToData = nil; - -function ImageDirectoryEntryToData(Base: Pointer; MappedAsImage: ByteBool; - DirectoryEntry: USHORT; var Size: ULONG): Pointer; -begin - GetProcedureAddress(Pointer(@_ImageDirectoryEntryToData), ImageHlpLib, 'ImageDirectoryEntryToData'); - Result := _ImageDirectoryEntryToData(Base, MappedAsImage, DirectoryEntry, Size); -end; - -type - TImageRvaToSection = function (NtHeaders: PImageNtHeaders; Base: Pointer; Rva: ULONG): PImageSectionHeader; stdcall; - -var - _ImageRvaToSection: TImageRvaToSection = nil; - -function ImageRvaToSection(NtHeaders: PImageNtHeaders; Base: Pointer; Rva: ULONG): PImageSectionHeader; -begin - GetProcedureAddress(Pointer(@_ImageRvaToSection), ImageHlpLib, 'ImageRvaToSection'); - Result := _ImageRvaToSection(NtHeaders, Base, Rva); -end; - -type - TImageRvaToVa = function (NtHeaders: PImageNtHeaders; Base: Pointer; Rva: ULONG; - LastRvaSection: PPImageSectionHeader): Pointer; stdcall; - -var - _ImageRvaToVa: TImageRvaToVa = nil; - -function ImageRvaToVa(NtHeaders: PImageNtHeaders; Base: Pointer; Rva: ULONG; - LastRvaSection: PPImageSectionHeader): Pointer; -begin - GetProcedureAddress(Pointer(@_ImageRvaToVa), ImageHlpLib, 'ImageRvaToVa'); - Result := _ImageRvaToVa(NtHeaders, Base, Rva, LastRvaSection); -end; - - - - -type - TCancelIo = function (hFile: THandle): BOOL; stdcall; -var - _CancelIo: TCancelIo = nil; - -function CancelIo(hFile: THandle): BOOL; -begin - GetProcedureAddress(Pointer(@_CancelIo), kernel32, 'CancelIo'); - Result := _CancelIo(hFile); -end; - - -type - TNetUserAdd = function (servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; -var - _NetUserAdd: TNetUserAdd = nil; - -function NetUserAdd(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetUserAdd), netapi32, 'NetUserAdd'); - Result := _NetUserAdd(servername, level, buf, parm_err); -end; - -type - TNetUserEnum = function (servername: LPCWSTR; level, filter: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries, resume_handle: LPDWORD): NET_API_STATUS; stdcall; - -var - _NetUserEnum: TNetUserEnum = nil; - -function NetUserEnum(servername: LPCWSTR; level, filter: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries, resume_handle: LPDWORD): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetUserEnum), netapi32, 'NetUserEnum'); - Result := _NetUserEnum(servername, level, filter, bufptr, prefmaxlen, entriesread, totalentries, resume_handle); -end; - -type - TNetUserGetInfo = function (servername, username: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; stdcall; - -var - _NetUserGetInfo: TNetUserGetInfo = nil; - -function NetUserGetInfo(servername, username: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetUserGetInfo), netapi32, 'NetUserGetInfo'); - Result := _NetUserGetInfo(servername, username, level, bufptr); -end; - -type - TNetUserSetInfo = function (servername, username: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; - -var - _NetUserSetInfo: TNetUserSetInfo = nil; - -function NetUserSetInfo(servername, username: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetUserSetInfo), netapi32, 'NetUserSetInfo'); - Result := _NetUserSetInfo(servername, username, level, buf, parm_err); -end; - -type - TNetUserDel = function (servername: LPCWSTR; username: LPCWSTR): NET_API_STATUS; stdcall; - -var - _NetUserDel: TNetUserDel = nil; - -function NetUserDel(servername: LPCWSTR; username: LPCWSTR): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetUserDel), netapi32, 'NetUserDel'); - Result := _NetUserDel(servername, username); -end; - -type - TNetUserGetGroups = function (servername, username: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD): NET_API_STATUS; stdcall; - -var - _NetUserGetGroups: TNetUserGetGroups = nil; - -function NetUserGetGroups(servername, username: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetUserGetGroups), netapi32, 'NetUserGetGroups'); - Result := _NetUserGetGroups(servername, username, level, bufptr, prefmaxlen, entriesread, totalentries); -end; - -type - TNetUserSetGroups = function (servername, username: LPCWSTR; level: DWORD; buf: PByte; num_entries: DWORD): NET_API_STATUS; stdcall; - -var - _NetUserSetGroups: TNetUserSetGroups = nil; - -function NetUserSetGroups(servername, username: LPCWSTR; level: DWORD; buf: PByte; num_entries: DWORD): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetUserSetGroups), netapi32, 'NetUserSetGroups'); - Result := _NetUserSetGroups(servername, username, level, buf, num_entries); -end; - -type - TNetUserGetLocalGroups = function (servername, username: LPCWSTR; level, flags: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD): NET_API_STATUS; stdcall; - -var - _NetUserGetLocalGroups: TNetUserGetLocalGroups = nil; - -function NetUserGetLocalGroups(servername, username: LPCWSTR; level, flags: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetUserGetLocalGroups), netapi32, 'NetUserGetLocalGroups'); - Result := _NetUserGetLocalGroups(servername, username, level, flags, bufptr, prefmaxlen, entriesread, totalentries); -end; - -type - TNetUserModalsGet = function (servername: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; stdcall; - -var - _NetUserModalsGet: TNetUserModalsGet = nil; - -function NetUserModalsGet(servername: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetUserModalsGet), netapi32, 'NetUserModalsGet'); - Result := _NetUserModalsGet(servername, level, bufptr); -end; - -type - TNetUserModalsSet = function (servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; - -var - _NetUserModalsSet: TNetUserModalsSet = nil; - -function NetUserModalsSet(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetUserModalsSet), netapi32, 'NetUserModalsSet'); - Result := _NetUserModalsSet(servername, level, buf, parm_err); -end; - -type - TNetUserChangePassword = function (domainname, username, oldpassword, newpassword: LPCWSTR): NET_API_STATUS; stdcall; - -var - _NetUserChangePassword: TNetUserChangePassword = nil; - -function NetUserChangePassword(domainname, username, oldpassword, newpassword: LPCWSTR): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetUserChangePassword), netapi32, 'NetUserChangePassword'); - Result := _NetUserChangePassword(domainname, username, oldpassword, newpassword); -end; - -type - TNetGroupAdd = function (servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; - -var - _NetGroupAdd: TNetGroupAdd = nil; - -function NetGroupAdd(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetGroupAdd), netapi32, 'NetGroupAdd'); - Result := _NetGroupAdd(servername, level, buf, parm_err); -end; - -type - TNetGroupAddUser = function (servername, GroupName, username: LPCWSTR): NET_API_STATUS; stdcall; - -var - _NetGroupAddUser: TNetGroupAddUser = nil; - -function NetGroupAddUser(servername, GroupName, username: LPCWSTR): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetGroupAddUser), netapi32, 'NetGroupAddUser'); - Result := _NetGroupAddUser(servername, GroupName, username); -end; - -type - TNetGroupEnum = function (servername: LPCWSTR; level: DWORD; out bufptr: PByte; - prefmaxlen: DWORD; out entriesread, totalentries: DWORD; resume_handle: PDWORD_PTR): NET_API_STATUS; stdcall; - -var - _NetGroupEnum: TNetGroupEnum = nil; - -function NetGroupEnum(servername: LPCWSTR; level: DWORD; out bufptr: PByte; - prefmaxlen: DWORD; out entriesread, totalentries: DWORD; resume_handle: PDWORD_PTR): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetGroupEnum), netapi32, 'NetGroupEnum'); - Result := _NetGroupEnum(servername, level, bufptr, prefmaxlen, entriesread, totalentries, resume_handle); -end; - -type - TNetGroupGetInfo = function (servername, groupname: LPCWSTR; level: DWORD; bufptr: PByte): NET_API_STATUS; stdcall; - -var - _NetGroupGetInfo: TNetGroupGetInfo = nil; - -function NetGroupGetInfo(servername, groupname: LPCWSTR; level: DWORD; bufptr: PByte): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetGroupGetInfo), netapi32, 'NetGroupGetInfo'); - Result := _NetGroupGetInfo(servername, groupname, level, bufptr); -end; - -type - TNetGroupSetInfo = function (servername, groupname: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; - -var - _NetGroupSetInfo: TNetGroupSetInfo = nil; - -function NetGroupSetInfo(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetGroupSetInfo), netapi32, 'NetGroupSetInfo'); - Result := _NetGroupSetInfo(servername, groupname, level, buf, parm_err); -end; - -type - TNetGroupDel = function (servername: LPCWSTR; groupname: LPCWSTR): NET_API_STATUS; stdcall; - -var - _NetGroupDel: TNetGroupDel = nil; - -function NetGroupDel(servername: LPCWSTR; groupname: LPCWSTR): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetGroupDel), netapi32, 'NetGroupDel'); - Result := _NetGroupDel(servername, groupname); -end; - -type - TNetGroupDelUser = function (servername: LPCWSTR; GroupName: LPCWSTR; Username: LPCWSTR): NET_API_STATUS; stdcall; - -var - _NetGroupDelUser: TNetGroupDelUser = nil; - -function NetGroupDelUser(servername: LPCWSTR; GroupName: LPCWSTR; Username: LPCWSTR): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetGroupDelUser), netapi32, 'NetGroupDelUser'); - Result := _NetGroupDelUser(servername, GroupName, Username); -end; - -type - TNetGroupGetUsers = function (servername, groupname: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD; ResumeHandle: PDWORD_PTR): NET_API_STATUS; stdcall; - -var - _NetGroupGetUsers: TNetGroupGetUsers = nil; - -function NetGroupGetUsers(servername, groupname: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD; ResumeHandle: PDWORD_PTR): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetGroupGetUsers), netapi32, 'NetGroupGetUsers'); - Result := _NetGroupGetUsers(servername, groupname, level, bufptr, prefmaxlen, entriesread, totalentries, ResumeHandle); -end; - -type - TNetGroupSetUsers = function (servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; stdcall; - -var - _NetGroupSetUsers: TNetGroupSetUsers = nil; - -function NetGroupSetUsers(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetGroupSetUsers), netapi32, 'NetGroupSetUsers'); - Result := _NetGroupSetUsers(servername, groupname, level, buf, totalentries); -end; - -type - TNetLocalGroupAdd = function (servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; - -var - _NetLocalGroupAdd: TNetLocalGroupAdd = nil; - -function NetLocalGroupAdd(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetLocalGroupAdd), netapi32, 'NetLocalGroupAdd'); - Result := _NetLocalGroupAdd(servername, level, buf, parm_err); -end; - -type - TNetLocalGroupAddMember = function (servername, groupname: LPCWSTR; membersid: PSID): NET_API_STATUS; stdcall; - -var - _NetLocalGroupAddMember: TNetLocalGroupAddMember = nil; - -function NetLocalGroupAddMember(servername, groupname: LPCWSTR; membersid: PSID): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetLocalGroupAddMember), netapi32, 'NetLocalGroupAddMember'); - Result := _NetLocalGroupAddMember(servername, groupname, membersid); -end; - -type - TNetLocalGroupEnum = function (servername: LPCWSTR; level: DWORD; out bufptr: PByte; - prefmaxlen: DWORD; out entriesread, totalentries: DWORD; resumehandle: PDWORD_PTR): NET_API_STATUS; stdcall; - -var - _NetLocalGroupEnum: TNetLocalGroupEnum = nil; - -function NetLocalGroupEnum(servername: LPCWSTR; level: DWORD; out bufptr: PByte; - prefmaxlen: DWORD; out entriesread, totalentries: DWORD; resumehandle: PDWORD_PTR): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetLocalGroupEnum), netapi32, 'NetLocalGroupEnum'); - Result := _NetLocalGroupEnum(servername, level, bufptr, prefmaxlen, entriesread, totalentries, resumehandle); -end; - -type - TNetLocalGroupGetInfo = function (servername, groupname: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; stdcall; - -var - _NetLocalGroupGetInfo: TNetLocalGroupGetInfo = nil; - -function NetLocalGroupGetInfo(servername, groupname: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetLocalGroupGetInfo), netapi32, 'NetLocalGroupGetInfo'); - Result := _NetLocalGroupGetInfo(servername, groupname, level, bufptr); -end; - -type - TNetLocalGroupSetInfo = function (servername, groupname: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; - -var - _NetLocalGroupSetInfo: TNetLocalGroupSetInfo = nil; - -function NetLocalGroupSetInfo(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetLocalGroupSetInfo), netapi32, 'NetLocalGroupSetInfo'); - Result := _NetLocalGroupSetInfo(servername, groupname, level, buf, parm_err); -end; - -type - TNetLocalGroupDel = function (servername: LPCWSTR; groupname: LPCWSTR): NET_API_STATUS; stdcall; - -var - _NetLocalGroupDel: TNetLocalGroupDel = nil; - -function NetLocalGroupDel(servername: LPCWSTR; groupname: LPCWSTR): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetLocalGroupDel), netapi32, 'NetLocalGroupDel'); - Result := _NetLocalGroupDel(servername, groupname); -end; - -type - TNetLocalGroupDelMember = function (servername: LPCWSTR; groupname: LPCWSTR; membersid: PSID): NET_API_STATUS; stdcall; - -var - _NetLocalGroupDelMember: TNetLocalGroupDelMember = nil; - -function NetLocalGroupDelMember(servername: LPCWSTR; groupname: LPCWSTR; membersid: PSID): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetLocalGroupDelMember), netapi32, 'NetLocalGroupDelMember'); - Result := _NetLocalGroupDelMember(servername, groupname, membersid); -end; - -type - TNetLocalGroupGetMembers = function (servername, localgroupname: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD; resumehandle: PDWORD_PTR): NET_API_STATUS; stdcall; - -var - _NetLocalGroupGetMembers: TNetLocalGroupGetMembers = nil; - -function NetLocalGroupGetMembers(servername, localgroupname: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD; resumehandle: PDWORD_PTR): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetLocalGroupGetMembers), netapi32, 'NetLocalGroupGetMembers'); - Result := _NetLocalGroupGetMembers(servername, localgroupname, level, bufptr, prefmaxlen, entriesread, totalentries, resumehandle); -end; - -type - TNetLocalGroupSetMembers = function (servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; stdcall; - -var - _NetLocalGroupSetMembers: TNetLocalGroupSetMembers = nil; - -function NetLocalGroupSetMembers(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetLocalGroupSetMembers), netapi32, 'NetLocalGroupSetMembers'); - Result := _NetLocalGroupSetMembers(servername, groupname, level, buf, totalentries); -end; - -type - TNetLocalGroupAddMembers = function (servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; stdcall; - -var - _NetLocalGroupAddMembers: TNetLocalGroupAddMembers = nil; - -function NetLocalGroupAddMembers(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetLocalGroupAddMembers), netapi32, 'NetLocalGroupAddMembers'); - Result := _NetLocalGroupAddMembers(servername, groupname, level, buf, totalentries); -end; - -type - TNetLocalGroupDelMembers = function (servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; stdcall; - -var - _NetLocalGroupDelMembers: TNetLocalGroupDelMembers = nil; - -function NetLocalGroupDelMembers(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetLocalGroupDelMembers), netapi32, 'NetLocalGroupDelMembers'); - Result := _NetLocalGroupDelMembers(servername, groupname, level, buf, totalentries); -end; - - - -type - TNetApiBufferFree = function (Buffer: Pointer): NET_API_STATUS; stdcall; - -var - _NetApiBufferFree: TNetApiBufferFree = nil; - -function NetApiBufferFree(Buffer: Pointer): NET_API_STATUS; -begin - GetProcedureAddress(Pointer(@_NetApiBufferFree), netapi32, 'NetApiBufferFree'); - Result := _NetApiBufferFree(Buffer); -end; - - - -type - TNetWkstaGetInfo = function (servername: PWideChar; level: DWORD; out bufptr: PByte): NET_API_STATUS; stdcall; - -var - _NetWkstaGetInfo: TNetWkstaGetInfo = nil; - -function NetWkstaGetInfo(servername: PWideChar; level: DWORD; out bufptr: PByte): NET_API_STATUS; stdcall; -begin - GetProcedureAddress(Pointer(@_NetWkstaGetInfo), netapi32, 'NetWkstaGetInfo'); - Result := _NetWkstaGetInfo(servername, level, bufptr); -end; - - - -type - TNetbios = function (pncb: PNCB): UCHAR; stdcall; -var - _Netbios: TNetbios = nil; - -function Netbios(pncb: PNCB): UCHAR; -begin - GetProcedureAddress(Pointer(@_Netbios), 'netapi32.dll', 'Netbios'); - Result := _Netbios(pncb); -end; - - - -type - TGlobalMemoryStatusEx = function (out lpBuffer: TMemoryStatusEx): BOOL; stdcall; - -var - _GlobalMemoryStatusEx: TGlobalMemoryStatusEx = nil; - -function GlobalMemoryStatusEx(out lpBuffer: TMemoryStatusEx): BOOL; stdcall; -begin - GetProcedureAddress(Pointer(@_GlobalMemoryStatusEx), kernel32, 'GlobalMemoryStatusEx'); - Result := _GlobalMemoryStatusEx(lpBuffer); -end; - -type - TBackupSeek = function (hFile: THandle; dwLowBytesToSeek, dwHighBytesToSeek: DWORD; - out lpdwLowByteSeeked, lpdwHighByteSeeked: DWORD; - var lpContext: Pointer): BOOL; stdcall; - -var - _BackupSeek: TBackupSeek = nil; - -function BackupSeek(hFile: THandle; dwLowBytesToSeek, dwHighBytesToSeek: DWORD; - out lpdwLowByteSeeked, lpdwHighByteSeeked: DWORD; - var lpContext: Pointer): BOOL; -begin - GetProcedureAddress(Pointer(@_BackupSeek), kernel32, 'BackupSeek'); - Result := _BackupSeek(hFile, dwLowBytesToSeek, dwHighBytesToSeek, lpdwLowByteSeeked, lpdwHighByteSeeked, lpContext); -end; - -type - TAdjustTokenPrivileges = function (TokenHandle: THandle; DisableAllPrivileges: BOOL; - const NewState: TTokenPrivileges; BufferLength: DWORD; - PreviousState: PTokenPrivileges; - ReturnLength: PDWORD - ): BOOL; stdcall; - -var - _AdjustTokenPrivileges: TAdjustTokenPrivileges = nil; - -function AdjustTokenPrivileges(TokenHandle: THandle; DisableAllPrivileges: BOOL; - const NewState: TTokenPrivileges; BufferLength: DWORD; - PreviousState: PTokenPrivileges; - ReturnLength: PDWORD - ): BOOL; -begin - GetProcedureAddress(Pointer(@_AdjustTokenPrivileges), advapi32, 'AdjustTokenPrivileges'); - Result := _AdjustTokenPrivileges(TokenHandle, DisableAllPrivileges, NewState, BufferLength, PreviousState, ReturnLength); -end; - -function CreateMutex(lpMutexAttributes: PSecurityAttributes; bInitialOwner: BOOL; lpName: PChar): THandle; stdcall; - external kernel32 name 'CreateMutex' + AWSuffix; - -function GetVersionEx(var lpVersionInformation: TOSVersionInfoEx): BOOL; stdcall; - external kernel32 name 'GetVersionEx' + AWSuffix; -function GetVersionEx(lpVersionInformation: POSVersionInfoEx): BOOL; stdcall; - external kernel32 name 'GetVersionEx' + AWSuffix; - -type - TSetWaitableTimer = function (hTimer: THandle; var lpDueTime: TLargeInteger; - lPeriod: Longint; pfnCompletionRoutine: TFNTimerAPCRoutine; - lpArgToCompletionRoutine: Pointer; fResume: BOOL): BOOL; stdcall; - -var - _SetWaitableTimer: TSetWaitableTimer = nil; - -function SetWaitableTimer(hTimer: THandle; var lpDueTime: TLargeInteger; - lPeriod: Longint; pfnCompletionRoutine: TFNTimerAPCRoutine; - lpArgToCompletionRoutine: Pointer; fResume: BOOL): BOOL; -begin - GetProcedureAddress(Pointer(@_SetWaitableTimer), kernel32, 'SetWaitableTimer'); - Result := _SetWaitableTimer(hTimer, lpDueTime, lPeriod, pfnCompletionRoutine, lpArgToCompletionRoutine, fResume); -end; - -type - TSetFileSecurityA = function (lpFileName: LPCSTR; SecurityInformation: SECURITY_INFORMATION; - pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; stdcall; -var - _SetFileSecurityA: TSetFileSecurityA = nil; - -function SetFileSecurityA(lpFileName: LPCSTR; SecurityInformation: SECURITY_INFORMATION; - pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; -begin - GetProcedureAddress(Pointer(@_SetFileSecurityA), advapi32, 'SetFileSecurityA'); - Result := _SetFileSecurityA(lpFileName, SecurityInformation, pSecurityDescriptor); -end; - -type - TSetFileSecurityW = function (lpFileName: LPCWSTR; SecurityInformation: SECURITY_INFORMATION; - pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; stdcall; - -var - _SetFileSecurityW: TSetFileSecurityW = nil; - -function SetFileSecurityW(lpFileName: LPCWSTR; SecurityInformation: SECURITY_INFORMATION; - pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; -begin - GetProcedureAddress(Pointer(@_SetFileSecurityW), advapi32, 'SetFileSecurityW'); - Result := _SetFileSecurityW(lpFileName, SecurityInformation, pSecurityDescriptor); -end; - -type - TSetFileSecurity = function (lpFileName: LPCTSTR; SecurityInformation: SECURITY_INFORMATION; - pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; stdcall; - -var - _SetFileSecurity: TSetFileSecurity = nil; - -function SetFileSecurity(lpFileName: LPCTSTR; SecurityInformation: SECURITY_INFORMATION; - pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; -begin - GetProcedureAddress(Pointer(@_SetFileSecurity), advapi32, 'SetFileSecurity' + AWSuffix); - Result := _SetFileSecurity(lpFileName, SecurityInformation, pSecurityDescriptor); -end; - -type - TGetFileSecurityA = function (lpFileName: LPCSTR; RequestedInformation: SECURITY_INFORMATION; - pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; - var lpnLengthNeeded: DWORD): BOOL; stdcall; - -var - _GetFileSecurityA: TGetFileSecurityA = nil; - -function GetFileSecurityA(lpFileName: LPCSTR; RequestedInformation: SECURITY_INFORMATION; - pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; - var lpnLengthNeeded: DWORD): BOOL; -begin - GetProcedureAddress(Pointer(@_GetFileSecurityA), advapi32, 'GetFileSecurityA'); - Result := _GetFileSecurityA(lpFileName, RequestedInformation, pSecurityDescriptor, nLength, lpnLengthNeeded); -end; - -type - TGetFileSecurityW = function (lpFileName: LPCWSTR; RequestedInformation: SECURITY_INFORMATION; - pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; - var lpnLengthNeeded: DWORD): BOOL; stdcall; - -var - _GetFileSecurityW: TGetFileSecurityW = nil; - -function GetFileSecurityW(lpFileName: LPCWSTR; RequestedInformation: SECURITY_INFORMATION; - pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; - var lpnLengthNeeded: DWORD): BOOL; -begin - GetProcedureAddress(Pointer(@_GetFileSecurityW), advapi32, 'GetFileSecurityW'); - Result := _GetFileSecurityW(lpFileName, RequestedInformation, pSecurityDescriptor, nLength, lpnLengthNeeded); -end; - -type - TGetFileSecurity = function (lpFileName: LPCTSTR; RequestedInformation: SECURITY_INFORMATION; - pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; - var lpnLengthNeeded: DWORD): BOOL; stdcall; - -var - _GetFileSecurity: TGetFileSecurity = nil; - -function GetFileSecurity(lpFileName: LPCTSTR; RequestedInformation: SECURITY_INFORMATION; - pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; - var lpnLengthNeeded: DWORD): BOOL; -begin - GetProcedureAddress(Pointer(@_GetFileSecurity), advapi32, 'GetFileSecurity' + AWSuffix); - Result := _GetFileSecurity(lpFileName, RequestedInformation, pSecurityDescriptor, nLength, lpnLengthNeeded); -end; - -type - TSetVolumeMountPointW = function (lpszVolumeMountPoint, lpszVolumeName: LPCWSTR): BOOL; stdcall; - -var - _SetVolumeMountPointW: TSetVolumeMountPointW = nil; - -function SetVolumeMountPointW(lpszVolumeMountPoint, lpszVolumeName: LPCWSTR): BOOL; -begin - GetProcedureAddress(Pointer(@_SetVolumeMountPointW), kernel32, 'SetVolumeMountPointW'); - Result := _SetVolumeMountPointW(lpszVolumeMountPoint, lpszVolumeName); -end; - -type - TDeleteVolumeMountPointW = function (lpszVolumeMountPoint: LPCWSTR): BOOL; stdcall; - -var - _DeleteVolumeMountPointW: TDeleteVolumeMountPointW = nil; - -function DeleteVolumeMountPointW(lpszVolumeMountPoint: LPCWSTR): BOOL; -begin - GetProcedureAddress(Pointer(@_DeleteVolumeMountPointW), kernel32, 'DeleteVolumeMountPointW'); - Result := _DeleteVolumeMountPointW(lpszVolumeMountPoint); -end; - -type - TGetVolumeNameForVolumeMountPointW = function (lpszVolumeMountPoint: LPCWSTR; - lpszVolumeName: LPWSTR; cchBufferLength: DWORD): BOOL; stdcall; - -var - _GetVolumeNameForVolMountPointW: TGetVolumeNameForVolumeMountPointW = nil; - -function GetVolumeNameForVolumeMountPointW(lpszVolumeMountPoint: LPCWSTR; - lpszVolumeName: LPWSTR; cchBufferLength: DWORD): BOOL; -begin - GetProcedureAddress(Pointer(@_GetVolumeNameForVolMountPointW), kernel32, 'GetVolumeNameForVolumeMountPointW'); - Result := _GetVolumeNameForVolMountPointW(lpszVolumeMountPoint, lpszVolumeName, cchBufferLength); -end; - -type - TCopyExtendedContext = function (Destination: PCONTEXT_EX; ContextFlags: DWORD; Source: PCONTEXT_EX): BOOL; stdcall; - -var - _CopyExtendedContext: TCopyExtendedContext = nil; - -function CopyExtendedContext(Destination: PCONTEXT_EX; ContextFlags: DWORD; Source: PCONTEXT_EX): BOOL; -begin - GetProcedureAddress(Pointer(@_CopyExtendedContext), kernel32, 'CopyExtendedContext'); - Result := _CopyExtendedContext(Destination, ContextFlags, Source); -end; - -type - TInitializeExtendedContext = function (Context: Pointer; ContextFlags: DWORD; out ContextEx: PCONTEXT_EX): BOOL; stdcall; - -var - _InitializeExtendedContext: TInitializeExtendedContext = nil; - -function InitializeExtendedContext(Context: Pointer; ContextFlags: DWORD; out ContextEx: PCONTEXT_EX): BOOL; -begin - GetProcedureAddress(Pointer(@_InitializeExtendedContext), kernel32, 'InitializeExtendedContext'); - Result := _InitializeExtendedContext(Context, ContextFlags, ContextEx); -end; - -type - TGetEnabledExtendedFeatures = function (const FeatureMask: Int64): Int64; stdcall; -var - _GetEnabledExtendedFeatures: TGetEnabledExtendedFeatures = nil; - -function GetEnabledExtendedFeatures(const FeatureMask: Int64): Int64; -begin - GetProcedureAddress(Pointer(@_GetEnabledExtendedFeatures), kernel32, 'GetEnabledExtendedFeatures'); - Result := _GetEnabledExtendedFeatures(FeatureMask); -end; - -type - TGetExtendedContextLength = function (ContextFlags: DWORD; ContextLength: PDWORD): BOOL; stdcall; - -var - _GetExtendedContextLength: TGetExtendedContextLength = nil; - -function GetExtendedContextLength(ContextFlags: DWORD; ContextLength: PDWORD): BOOL; -begin - GetProcedureAddress(Pointer(@_GetExtendedContextLength), kernel32, 'GetExtendedContextLength'); - Result := _GetExtendedContextLength(ContextFlags, ContextLength); -end; - -type - TGetExtendedFeaturesMask = function (ContextEx: PCONTEXT_EX): Int64; stdcall; - -var - _GetExtendedFeaturesMask: TGetExtendedFeaturesMask = nil; - -function GetExtendedFeaturesMask(ContextEx: PCONTEXT_EX): Int64; -begin - GetProcedureAddress(Pointer(@_GetExtendedFeaturesMask), kernel32, 'GetExtendedFeaturesMask'); - Result := _GetExtendedFeaturesMask(ContextEx); -end; - -type - TLocateExtendedFeature = function (ContextEx: PCONTEXT_EX; FeatureId: DWORD; Length: PDWORD): Pointer; stdcall; - -var - _LocateExtendedFeature: TLocateExtendedFeature = nil; - -function LocateExtendedFeature(ContextEx: PCONTEXT_EX; FeatureId: DWORD; Length: PDWORD): Pointer; -begin - GetProcedureAddress(Pointer(@_LocateExtendedFeature), kernel32, 'LocateExtendedFeature'); - Result := _LocateExtendedFeature(ContextEx, FeatureId, Length); -end; - -type - TLocateLegacyContext = function (ContextEx: PCONTEXT_EX; Length: PDWORD): PCONTEXT; stdcall; - -var - _LocateLegacyContext: TLocateLegacyContext = nil; - -function LocateLegacyContext(ContextEx: PCONTEXT_EX; Length: PDWORD): PCONTEXT; -begin - GetProcedureAddress(Pointer(@_LocateLegacyContext), kernel32, 'LocateLegacyContext'); - Result := _LocateLegacyContext(ContextEx, Length); -end; - -type - TSetExtendedFeaturesMask = procedure (ContextEx: PCONTEXT_EX; const FeatureMask: Int64); stdcall; - -var - _SetExtendedFeaturesMask: TSetExtendedFeaturesMask = nil; - -procedure SetExtendedFeaturesMask(ContextEx: PCONTEXT_EX; const FeatureMask: Int64); -begin - GetProcedureAddress(Pointer(@_SetExtendedFeaturesMask), kernel32, 'SetExtendedFeaturesMask'); - _SetExtendedFeaturesMask(ContextEx, FeatureMask); -end; - -type - TProcessIdToSessionId = function (dwProcessId: DWORD; out dwSessionId: DWORD): BOOL; stdcall; - -var - _ProcessIdToSessionId: TProcessIdToSessionId = nil; - -function ProcessIdToSessionId(dwProcessId: DWORD; out dwSessionId: DWORD): BOOL; -begin - GetProcedureAddress(Pointer(@_ProcessIdToSessionId), kernel32, 'ProcessIdToSessionId'); - Result := _ProcessIdToSessionId(dwProcessId, dwSessionId); -end; - - - -type - TGetCalendarInfoA = function (Locale: LCID; Calendar: CALID; CalType: CALTYPE; - lpCalData: LPSTR; cchData: Integer; lpValue: LPDWORD): Integer; stdcall; - -var - _GetCalendarInfoA: TGetCalendarInfoA = nil; - -function GetCalendarInfoA(Locale: LCID; Calendar: CALID; CalType: CALTYPE; - lpCalData: LPSTR; cchData: Integer; lpValue: LPDWORD): Integer; -begin - GetProcedureAddress(Pointer(@_GetCalendarInfoA), kernel32, 'GetCalendarInfoA'); - Result := _GetCalendarInfoA(Locale, Calendar, CalType, lpCalData, cchData, lpValue); -end; - -type - TGetCalendarInfoW = function (Locale: LCID; Calendar: CALID; CalType: CALTYPE; - lpCalData: LPWSTR; cchData: Integer; lpValue: LPDWORD): Integer; stdcall; - -var - _GetCalendarInfoW: TGetCalendarInfoW = nil; - -function GetCalendarInfoW(Locale: LCID; Calendar: CALID; CalType: CALTYPE; - lpCalData: LPWSTR; cchData: Integer; lpValue: LPDWORD): Integer; -begin - GetProcedureAddress(Pointer(@_GetCalendarInfoW), kernel32, 'GetCalendarInfoW'); - Result := _GetCalendarInfoW(Locale, Calendar, CalType, lpCalData, cchData, lpValue); -end; - -type - TEnumCalendarInfoExW = function (lpCalInfoEnumProcEx: CALINFO_ENUMPROCEXW; - Locale: LCID; Calendar: CALID; CalType: CALTYPE): BOOL; stdcall; - -var - _EnumCalendarInfoExW: TEnumCalendarInfoExW = nil; - -function EnumCalendarInfoExW(lpCalInfoEnumProcEx: CALINFO_ENUMPROCEXW; - Locale: LCID; Calendar: CALID; CalType: CALTYPE): BOOL; -begin - GetProcedureAddress(Pointer(@_EnumCalendarInfoExW), kernel32, 'EnumCalendarInfoExW'); - Result := _EnumCalendarInfoExW(lpCalInfoEnumProcEx, Locale, Calendar, CalType); -end; - - -type - TGetWindowLongPtr = function (hWnd: HWND; nIndex: Integer): TJclAddr; stdcall; - -var - _GetWindowLongPtr: TGetWindowLongPtr = nil; - -function GetWindowLongPtr(hWnd: HWND; nIndex: Integer): TJclAddr; -begin - GetProcedureAddress(Pointer(@_GetWindowLongPtr), user32, 'GetWindowLong' + AWSuffix); - Result := _GetWindowLongPtr(hWnd, nIndex); -end; - -type - TSetWindowLongPtr = function (hWnd: HWND; nIndex: Integer; dwNewLong: TJclAddr): Longint; stdcall; - -var - _SetWindowLongPtr: TSetWindowLongPtr = nil; - -function SetWindowLongPtr(hWnd: HWND; nIndex: Integer; dwNewLong: TJclAddr): Longint; -begin - GetProcedureAddress(Pointer(@_SetWindowLongPtr), user32, 'SetWindowLong' + AWSuffix); - Result := _SetWindowLongPtr(hWnd, nIndex, dwNewLong); -end; - - -// line 9078 - -function MAKELANGID(PrimaryLang, SubLang: USHORT): WORD; -begin - Result := (SubLang shl 10) or PrimaryLang; -end; - -function PRIMARYLANGID(LangId: WORD): WORD; -begin - Result := LangId and $03FF; -end; - -function SUBLANGID(LangId: WORD): WORD; -begin - Result := LangId shr 10; -end; - -function MAKELCID(LangId, SortId: WORD): DWORD; -begin - Result := (DWORD(SortId) shl 16) or DWORD(LangId); -end; - -function MAKESORTLCID(LangId, SortId, SortVersion: WORD): DWORD; -begin - Result := MAKELCID(LangId, SortId) or (SortVersion shl 20); -end; - -function LANGIDFROMLCID(LocaleId: LCID): WORD; -begin - Result := WORD(LocaleId); -end; - -function SORTIDFROMLCID(LocaleId: LCID): WORD; -begin - Result := WORD((DWORD(LocaleId) shr 16) and $000F); -end; - -function SORTVERSIONFROMLCID(LocaleId: LCID): WORD; -begin - Result := WORD((DWORD(LocaleId) shr 20) and $000F); -end; - -type - TCaptureStackBackTrace = function(FramesToSkip, FramesToCapture: DWORD; - BackTrace: Pointer; out BackTraceHash: DWORD): Word; stdcall; - -var - _CaptureStackBackTrace: TCaptureStackBackTrace = nil; - -function CaptureStackBackTrace(FramesToSkip, FramesToCapture: DWORD; - BackTrace: Pointer; out BackTraceHash: DWORD): Word; stdcall; -begin - GetProcedureAddress(Pointer(@_CaptureStackBackTrace), kernel32, 'RtlCaptureStackBackTrace'); - Result := _CaptureStackBackTrace(FramesToSkip, FramesToCapture, BackTrace, BackTraceHash); -end; - -// line 9149 - -function IsReparseTagMicrosoft(Tag: ULONG): Boolean; -begin - Result := (Tag and ULONG($80000000)) <> 0; -end; - -function IsReparseTagHighLatency(Tag: ULONG): Boolean; -begin - Result := (Tag and ULONG($40000000)) <> 0; -end; - -function IsReparseTagNameSurrogate(Tag: ULONG): Boolean; -begin - Result := (Tag and ULONG($20000000)) <> 0; -end; - -// IMAGE_FIRST_SECTION by Nico Bendlin - supplied by Markus Fuchs - -function IMAGE_FIRST_SECTION(NtHeader: PImageNtHeaders): PImageSectionHeader; -var - OptionalHeaderAddr: PByte; -begin - OptionalHeaderAddr := @NtHeader^.OptionalHeader; - Inc(OptionalHeaderAddr, NtHeader^.FileHeader.SizeOfOptionalHeader); - Result := PImageSectionHeader(OptionalHeaderAddr); -end; - -// line 9204 - -function IMAGE_ORDINAL64(Ordinal: ULONGLONG): ULONGLONG; -begin - Result := (Ordinal and $FFFF); -end; - -function IMAGE_ORDINAL32(Ordinal: DWORD): DWORD; -begin - Result := (Ordinal and $0000FFFF); -end; - -function IMAGE_ORDINAL(Ordinal: DWORD): DWORD; -begin - Result := (Ordinal and $0000FFFF); -end; - -function IMAGE_SNAP_BY_ORDINAL64(Ordinal: ULONGLONG): Boolean; -begin - Result := ((Ordinal and IMAGE_ORDINAL_FLAG64) <> 0); -end; - -function IMAGE_SNAP_BY_ORDINAL32(Ordinal: DWORD): Boolean; -begin - Result := ((Ordinal and IMAGE_ORDINAL_FLAG32) <> 0); -end; - -function IMAGE_SNAP_BY_ORDINAL(Ordinal: DWORD): Boolean; -begin - Result := ((Ordinal and IMAGE_ORDINAL_FLAG32) <> 0); -end; - -const - PowrprofLib = 'PowrProf.dll'; - -type - TIsPwrSuspendAllowed = function : BOOL; stdcall; - -var - _IsPwrSuspendAllowed: TIsPwrSuspendAllowed = nil; - -function IsPwrSuspendAllowed: BOOL; -begin - GetProcedureAddress(Pointer(@_IsPwrSuspendAllowed), PowrprofLib, 'IsPwrSuspendAllowed'); - Result := _IsPwrSuspendAllowed; -end; - -type - TIsPwrHibernateAllowed = function : BOOL; stdcall; - -var - _IsPwrHibernateAllowed: TIsPwrHibernateAllowed = nil; - -function IsPwrHibernateAllowed: BOOL; -begin - GetProcedureAddress(Pointer(@_IsPwrHibernateAllowed), PowrprofLib, 'IsPwrHibernateAllowed'); - Result := _IsPwrHibernateAllowed; -end; - -type - TIsPwrShutdownAllowed = function : BOOL; stdcall; - -var - _IsPwrShutdownAllowed: TIsPwrShutdownAllowed = nil; - -function IsPwrShutdownAllowed: BOOL; -begin - GetProcedureAddress(Pointer(@_IsPwrShutdownAllowed), PowrprofLib, 'IsPwrShutdownAllowed'); - Result := _IsPwrShutdownAllowed; -end; - -type - TSetSuspendState = function (Hibernate, ForceCritical, DisableWakeEvent: BOOL): BOOL; stdcall; - -var - _SetSuspendState: TSetSuspendState = nil; - -function SetSuspendState(Hibernate, ForceCritical, DisableWakeEvent: BOOL): BOOL; -begin - GetProcedureAddress(Pointer(@_SetSuspendState), PowrprofLib, 'SetSuspendState'); - Result := _SetSuspendState(Hibernate, ForceCritical, DisableWakeEvent); -end; - - -const - Ole32Lib = 'ole32.dll'; - -type - TStgCreateStorageEx = function (const pwcsName: PWideChar; grfMode: DWORD; - stgfmt: DWORD; grfAttrs: DWORD; pStgOptions: PSTGOPTIONS; reserved2: Pointer; - riid: PGUID; out stgOpen: IInterface): HResult; stdcall; - -var - _StgCreateStorageEx: TStgCreateStorageEx = nil; - -function StgCreateStorageEx(const pwcsName: PWideChar; grfMode: DWORD; - stgfmt: DWORD; grfAttrs: DWORD; pStgOptions: PSTGOPTIONS; reserved2: Pointer; - riid: PGUID; out stgOpen: IInterface): HResult; -begin - GetProcedureAddress(Pointer(@_StgCreateStorageEx), Ole32Lib, 'StgCreateStorageEx'); - Result := _StgCreateStorageEx(pwcsName, grfMode, stgfmt, grfAttrs, pStgOptions, reserved2, riid, stgOpen); -end; - -type - TStgOpenStorageEx = function (const pwcsName: PWideChar; grfMode: DWORD; - stgfmt: DWORD; grfAttrs: DWORD; pStgOptions: PSTGOPTIONS; reserved2: Pointer; - riid: PGUID; out stgOpen: IInterface): HResult; stdcall; - -var - _StgOpenStorageEx: TStgOpenStorageEx = nil; - -function StgOpenStorageEx(const pwcsName: PWideChar; grfMode: DWORD; - stgfmt: DWORD; grfAttrs: DWORD; pStgOptions: PSTGOPTIONS; reserved2: Pointer; - riid: PGUID; out stgOpen: IInterface): HResult; -begin - GetProcedureAddress(Pointer(@_StgOpenStorageEx), Ole32Lib, 'StgOpenStorageEx'); - Result := _StgOpenStorageEx(pwcsName, grfMode, stgfmt, grfAttrs, pStgOptions, reserved2, riid, stgOpen); -end; - - -type - TPropVariantClear = function (var Prop: TPropVariant): HResult; stdcall; - -var - _PropVariantClear: TPropVariantClear = nil; - -function PropVariantClear(var Prop: TPropVariant): HResult; -begin - GetProcedureAddress(Pointer(@_PropVariantClear), Ole32Lib, 'PropVariantClear'); - Result := _PropVariantClear(Prop); -end; - - -type - TLsaOpenPolicy = function (SystemName: PLSA_UNICODE_STRING; - var ObjectAttributes: LSA_OBJECT_ATTRIBUTES; DesiredAccess: ACCESS_MASK; - var PolicyHandle: LSA_HANDLE): NTSTATUS; stdcall; - -var - _LsaOpenPolicy: TLsaOpenPolicy = nil; - -function LsaOpenPolicy(SystemName: PLSA_UNICODE_STRING; - var ObjectAttributes: LSA_OBJECT_ATTRIBUTES; DesiredAccess: ACCESS_MASK; - var PolicyHandle: LSA_HANDLE): NTSTATUS; -begin - GetProcedureAddress(Pointer(@_LsaOpenPolicy), advapi32, 'LsaOpenPolicy'); - Result := _LsaOpenPolicy(SystemName, ObjectAttributes, DesiredAccess, PolicyHandle); -end; - -type - TLsaQueryInformationPolicy = function (PolicyHandle: LSA_HANDLE; - InformationClass: POLICY_INFORMATION_CLASS; var Buffer: Pointer): NTSTATUS; stdcall; - -var - _LsaQueryInformationPolicy: TLsaQueryInformationPolicy = nil; - -function LsaQueryInformationPolicy(PolicyHandle: LSA_HANDLE; - InformationClass: POLICY_INFORMATION_CLASS; var Buffer: Pointer): NTSTATUS; -begin - GetProcedureAddress(Pointer(@_LsaQueryInformationPolicy), advapi32, 'LsaQueryInformationPolicy'); - Result := _LsaQueryInformationPolicy(PolicyHandle, InformationClass, Buffer); -end; - -type - TLsaFreeMemory = function (Buffer: Pointer): NTSTATUS; stdcall; - -var - _LsaFreeMemory: TLsaFreeMemory = nil; - -function LsaFreeMemory(Buffer: Pointer): NTSTATUS; -begin - GetProcedureAddress(Pointer(@_LsaFreeMemory), advapi32, 'LsaFreeMemory'); - Result := _LsaFreeMemory(Buffer); -end; - -type - TLsaFreeReturnBuffer = function (Buffer: Pointer): NTSTATUS; stdcall; - -var - _LsaFreeReturnBuffer: TLsaFreeReturnBuffer = nil; - -function LsaFreeReturnBuffer(Buffer: Pointer): NTSTATUS; -begin - GetProcedureAddress(Pointer(@_LsaFreeReturnBuffer), advapi32, 'LsaFreeReturnBuffer'); - Result := _LsaFreeReturnBuffer(Buffer); -end; - -type - TLsaClose = function (ObjectHandle: LSA_HANDLE): NTSTATUS; stdcall; - -var - _LsaClose: TLsaClose = nil; - -function LsaClose(ObjectHandle: LSA_HANDLE): NTSTATUS; -begin - GetProcedureAddress(Pointer(@_LsaClose), advapi32, 'LsaClose'); - Result := _LsaClose(ObjectHandle); -end; - -type - TLsaNtStatusToWinError = function (Status: NTSTATUS): ULONG; stdcall; - -var - _LsaNtStatusToWinError: TLsaNtStatusToWinError = nil; - -function LsaNtStatusToWinError(Status: NTSTATUS): ULONG; -begin - GetProcedureAddress(Pointer(@_LsaNtStatusToWinError), advapi32, 'LsaNtStatusToWinError'); - Result := _LsaNtStatusToWinError(Status); -end; - - -type - TCreateToolhelp32Snapshot = function (dwFlags, th32ProcessID: DWORD): THandle; stdcall; - -var - _CreateToolhelp32Snapshot: TCreateToolhelp32Snapshot = nil; - -function CreateToolhelp32Snapshot(dwFlags, th32ProcessID: DWORD): THandle; -begin - GetProcedureAddress(Pointer(@_CreateToolhelp32Snapshot), kernel32, 'CreateToolhelp32Snapshot'); - Result := _CreateToolhelp32Snapshot(dwFlags, th32ProcessID); -end; - -type - TThread32First = function (hSnapshot: THandle; var lpte: THREADENTRY32): BOOL; stdcall; - -var - _Thread32First: TThread32First = nil; - -function Thread32First(hSnapshot: THandle; var lpte: THREADENTRY32): BOOL; -begin - GetProcedureAddress(Pointer(@_Thread32First), kernel32, 'Thread32First'); - Result := _Thread32First(hSnapshot, lpte); -end; - -type - TThread32Next = function (hSnapshot: THandle; var lpte: THREADENTRY32): BOOL; stdcall; - -var - _Thread32Next: TThread32Next = nil; - -function Thread32Next(hSnapshot: THandle; var lpte: THREADENTRY32): BOOL; -begin - GetProcedureAddress(Pointer(@_Thread32Next), kernel32, 'Thread32Next'); - Result := _Thread32Next(hSnapshot, lpte); -end; - - -const - ntdll = 'ntdll.dll'; - -type - TNtQueryInformationThread = function (ThreadHandle: THandle; ThreadInformationClass: THREAD_INFORMATION_CLASS; - ThreadInformation: Pointer; ThreadInformationLength: ULONG; ReturnLength: PULONG): NTSTATUS; stdcall; - -var - _NtQueryInformationThread: TNtQueryInformationThread = nil; - -function NtQueryInformationThread(ThreadHandle: THandle; ThreadInformationClass: THREAD_INFORMATION_CLASS; - ThreadInformation: Pointer; ThreadInformationLength: ULONG; ReturnLength: PULONG): NTSTATUS; -begin - GetProcedureAddress(Pointer(@_NtQueryInformationThread), ntdll, 'NtQueryInformationThread'); - Result := _NtQueryInformationThread(ThreadHandle, ThreadInformationClass, ThreadInformation, ThreadInformationLength, ReturnLength); -end; - - - -{$IFDEF UNITVERSIONING} -initialization - RegisterUnitVersion(HInstance, UnitVersioning); - -finalization - UnregisterUnitVersion(HInstance); -{$ENDIF UNITVERSIONING} - -end. - - - +{**************************************************************************************************} +{ WARNING: JEDI preprocessor generated unit. Do not edit. } +{**************************************************************************************************} + +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ Portions of this code are translated from DelayImp.h. } +{ The Initial Developer of DelayImp.h is Inprise Corporation. Portions created by Inprise } +{ Corporation are Copyright (C) 1999, 2000 by Inprise Corporation. All Rights Reserved. } +{ } +{ The Original Code is JclWin32.pas. } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. Portions created by Marcel van } +{ Brakel are Copyright (C) Marcel van Brakel. All Rights Reserved. } +{ } +{ Contributors: } +{ Marcel van Brakel } +{ Peter Friese } +{ Andreas Hausladen (ahuser) } +{ Flier Lu (flier) } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Olivier Sannier (obones) } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ This unit defines various Win32 API declarations which are either missing or incorrect in one or } +{ more of the supported Delphi versions. This unit is not intended for regular code, only API } +{ declarations. } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclWin32; + +{$I jcl.inc} +{$I windowsonly.inc} + +{$MINENUMSIZE 4} +{$ALIGN ON} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, System.SysUtils, + {$IFNDEF FPC} + Winapi.AccCtrl, Winapi.ActiveX, + {$ENDIF ~FPC} + {$ELSE ~HAS_UNITSCOPE} + Windows, SysUtils, + {$IFNDEF FPC} + AccCtrl, + {$ENDIF ~FPC} + ActiveX, + {$ENDIF ~HAS_UNITSCOPE} + JclBase; + +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +//{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$IFNDEF COMPILER14_UP} +{$HPPEMIT '#include '} +{$ENDIF ~COMPILER14_UP} +{$HPPEMIT '#include '} +{$HPPEMIT '#include '} +{$HPPEMIT ''} +{$IFDEF RTL230_UP} +{$HPPEMIT '// To avoid ambiguity between IMAGE_LOAD_CONFIG_DIRECTORY32 and Winapi::Windows::IMAGE_LOAD_CONFIG_DIRECTORY32'} +{$HPPEMIT '#define IMAGE_LOAD_CONFIG_DIRECTORY32 ::IMAGE_LOAD_CONFIG_DIRECTORY32'} +{$HPPEMIT ''} +{$HPPEMIT '// To avoid ambiguity between IMAGE_LOAD_CONFIG_DIRECTORY64 and Winapi::Windows::IMAGE_LOAD_CONFIG_DIRECTORY64'} +{$HPPEMIT '#define IMAGE_LOAD_CONFIG_DIRECTORY64 ::IMAGE_LOAD_CONFIG_DIRECTORY64'} +{$HPPEMIT ''} +{$ENDIF RTL230_UP} + +// EJclWin32Error +type + EJclWin32Error = class(EJclError) + private + FLastError: DWORD; + FLastErrorMsg: string; + public + constructor Create(const Msg: string); + constructor CreateFmt(const Msg: string; const Args: array of const); + constructor CreateRes(Ident: Integer); overload; + constructor CreateRes(ResStringRec: PResStringRec); overload; + property LastError: DWORD read FLastError; + property LastErrorMsg: string read FLastErrorMsg; + end; + +//DOM-IGNORE-BEGIN + +{$IFNDEF FPC} + +// +// Unsigned Basics +// + +type + USHORT = Word; + {$EXTERNALSYM USHORT} + +{$ENDIF ~FPC} +//================================================================================================== +// presumable from any older WinNT.h or from WinIfs.h +//================================================================================================== + +//-------------------------------------------------------------------------------------------------- +// NTFS Reparse Points +//-------------------------------------------------------------------------------------------------- + +// The reparse structure is used by layered drivers to store data in a +// reparse point. The constraints on reparse tags are defined below. +// This version of the reparse data buffer is only for Microsoft tags. + +(*$HPPEMIT 'typedef struct _REPARSE_DATA_BUFFER {'*) +(*$HPPEMIT ''*) +(*$HPPEMIT ' DWORD ReparseTag;'*) +(*$HPPEMIT ' WORD ReparseDataLength;'*) +(*$HPPEMIT ' WORD Reserved;'*) +(*$HPPEMIT ''*) +(*$HPPEMIT ' union {'*) +(*$HPPEMIT ''*) +(*$HPPEMIT ' struct {'*) +(*$HPPEMIT ' WORD SubstituteNameOffset;'*) +(*$HPPEMIT ' WORD SubstituteNameLength;'*) +(*$HPPEMIT ' WORD PrintNameOffset;'*) +(*$HPPEMIT ' WORD PrintNameLength;'*) +(*$HPPEMIT ' WCHAR PathBuffer[1];'*) +(*$HPPEMIT ' } SymbolicLinkReparseBuffer;'*) +(*$HPPEMIT ''*) +(*$HPPEMIT ' struct {'*) +(*$HPPEMIT ' WORD SubstituteNameOffset;'*) +(*$HPPEMIT ' WORD SubstituteNameLength;'*) +(*$HPPEMIT ' WORD PrintNameOffset;'*) +(*$HPPEMIT ' WORD PrintNameLength;'*) +(*$HPPEMIT ' WCHAR PathBuffer[1];'*) +(*$HPPEMIT ' } MountPointReparseBuffer;'*) +(*$HPPEMIT ''*) +(*$HPPEMIT ' struct {'*) +(*$HPPEMIT ' UCHAR DataBuffer[1];'*) +(*$HPPEMIT ' } GenericReparseBuffer;'*) +(*$HPPEMIT ' };'*) +(*$HPPEMIT ''*) +(*$HPPEMIT '} REPARSE_DATA_BUFFER, *PREPARSE_DATA_BUFFER;'*) +(*$HPPEMIT ''*) +(*$HPPEMIT '#ifndef REPARSE_DATA_BUFFER_HEADER_SIZE'*) +(*$HPPEMIT '#define REPARSE_DATA_BUFFER_HEADER_SIZE 8'*) +(*$HPPEMIT '#endif'*) +(*$HPPEMIT ''*) +(*$HPPEMIT 'typedef struct _REPARSE_POINT_INFORMATION {'*) +(*$HPPEMIT ' WORD ReparseDataLength;'*) +(*$HPPEMIT ' WORD UnparsedNameLength;'*) +(*$HPPEMIT '} REPARSE_POINT_INFORMATION, *PREPARSE_POINT_INFORMATION;'*) +(*$HPPEMIT ''*) +(*$HPPEMIT '#ifndef IO_REPARSE_TAG_VALID_VALUES'*) +(*$HPPEMIT '#define IO_REPARSE_TAG_VALID_VALUES 0x0E000FFFF'*) +(*$HPPEMIT '#endif'*) +(*$HPPEMIT ''*) + +type + {$EXTERNALSYM _REPARSE_DATA_BUFFER} + _REPARSE_DATA_BUFFER = record + ReparseTag: DWORD; + ReparseDataLength: Word; + Reserved: Word; + case Integer of + 0: ( + SymbolicLinkReparseBuffer: record + SubstituteNameOffset: Word; + SubstituteNameLength: Word; + PrintNameOffset: Word; + PrintNameLength: Word; + Flags: ULONG; + PathBuffer: array [0..0] of WCHAR; + end); + 1: ( + MountPointReparseBuffer: record + SubstituteNameOffset: Word; + SubstituteNameLength: Word; + PrintNameOffset: Word; + PrintNameLength: Word; + PathBuffer: array [0..0] of WCHAR; + end); + 2: ( + GenericReparseBuffer: record + DataBuffer: array [0..0] of Byte; + end); + end; + {$EXTERNALSYM REPARSE_DATA_BUFFER} + REPARSE_DATA_BUFFER = _REPARSE_DATA_BUFFER; + {$EXTERNALSYM PREPARSE_DATA_BUFFER} + PREPARSE_DATA_BUFFER = ^_REPARSE_DATA_BUFFER; + TReparseDataBuffer = _REPARSE_DATA_BUFFER; + PReparseDataBuffer = PREPARSE_DATA_BUFFER; + +const + {$EXTERNALSYM REPARSE_DATA_BUFFER_HEADER_SIZE} + REPARSE_DATA_BUFFER_HEADER_SIZE = 8; + +type + {$EXTERNALSYM _REPARSE_POINT_INFORMATION} + _REPARSE_POINT_INFORMATION = record + ReparseDataLength: Word; + UnparsedNameLength: Word; + end; + {$EXTERNALSYM REPARSE_POINT_INFORMATION} + REPARSE_POINT_INFORMATION = _REPARSE_POINT_INFORMATION; + {$EXTERNALSYM PREPARSE_POINT_INFORMATION} + PREPARSE_POINT_INFORMATION = ^_REPARSE_POINT_INFORMATION; + TReparsePointInformation = _REPARSE_POINT_INFORMATION; + PReparsePointInformation = PREPARSE_POINT_INFORMATION; + +const + {$EXTERNALSYM IO_REPARSE_TAG_VALID_VALUES} + IO_REPARSE_TAG_VALID_VALUES = DWORD($E000FFFF); + +//================================================================================================== + +// from JwaWinNT.pas (few declarations from JwaWinType) + +const + MAXLONGLONG = $7fffffffffffffff; + {$EXTERNALSYM MAXLONGLONG} + +{$IFNDEF FPC} +type + ULONGLONG = Int64; + {$EXTERNALSYM ULONGLONG} + PLONGLONG = ^LONGLONG; + {$EXTERNALSYM PLONGLONG} + PULONGLONG = ^ULONGLONG; + {$EXTERNALSYM PULONGLONG} +{$ENDIF ~FPC} + +const + ANYSIZE_ARRAY = 1; + {$EXTERNALSYM ANYSIZE_ARRAY} + + MAX_NATURAL_ALIGNMENT = SizeOf(ULONG); + {$EXTERNALSYM MAX_NATURAL_ALIGNMENT} + +// line 72 + +const + VER_SERVER_NT = DWORD($80000000); + {$EXTERNALSYM VER_SERVER_NT} + VER_WORKSTATION_NT = $40000000; + {$EXTERNALSYM VER_WORKSTATION_NT} + VER_SUITE_SMALLBUSINESS = $00000001; + {$EXTERNALSYM VER_SUITE_SMALLBUSINESS} + VER_SUITE_ENTERPRISE = $00000002; + {$EXTERNALSYM VER_SUITE_ENTERPRISE} + VER_SUITE_BACKOFFICE = $00000004; + {$EXTERNALSYM VER_SUITE_BACKOFFICE} + VER_SUITE_COMMUNICATIONS = $00000008; + {$EXTERNALSYM VER_SUITE_COMMUNICATIONS} + VER_SUITE_TERMINAL = $00000010; + {$EXTERNALSYM VER_SUITE_TERMINAL} + VER_SUITE_SMALLBUSINESS_RESTRICTED = $00000020; + {$EXTERNALSYM VER_SUITE_SMALLBUSINESS_RESTRICTED} + VER_SUITE_EMBEDDEDNT = $00000040; + {$EXTERNALSYM VER_SUITE_EMBEDDEDNT} + VER_SUITE_DATACENTER = $00000080; + {$EXTERNALSYM VER_SUITE_DATACENTER} + VER_SUITE_SINGLEUSERTS = $00000100; + {$EXTERNALSYM VER_SUITE_SINGLEUSERTS} + VER_SUITE_PERSONAL = $00000200; + {$EXTERNALSYM VER_SUITE_PERSONAL} + VER_SUITE_BLADE = $00000400; + {$EXTERNALSYM VER_SUITE_BLADE} + VER_SUITE_EMBEDDED_RESTRICTED = $00000800; + {$EXTERNALSYM VER_SUITE_EMBEDDED_RESTRICTED} + VER_SUITE_SECURITY_APPLIANCE = $00001000; + {$EXTERNALSYM VER_SUITE_SECURITY_APPLIANCE} + VER_SUITE_STORAGE_SERVER = $00002000; + {$EXTERNALSYM VER_SUITE_STORAGE_SERVER} + VER_SUITE_COMPUTE_SERVER = $00004000; + {$EXTERNALSYM VER_SUITE_COMPUTE_SERVER} + +// line 515 + +// +// A language ID is a 16 bit value which is the combination of a +// primary language ID and a secondary language ID. The bits are +// allocated as follows: +// +// +-----------------------+-------------------------+ +// | Sublanguage ID | Primary Language ID | +// +-----------------------+-------------------------+ +// 15 10 9 0 bit +// +// +// Language ID creation/extraction macros: +// +// MAKELANGID - construct language id from a primary language id and +// a sublanguage id. +// PRIMARYLANGID - extract primary language id from a language id. +// SUBLANGID - extract sublanguage id from a language id. +// + +function MAKELANGID(PrimaryLang, SubLang: USHORT): WORD; +{$EXTERNALSYM MAKELANGID} +function PRIMARYLANGID(LangId: WORD): WORD; +{$EXTERNALSYM PRIMARYLANGID} +function SUBLANGID(LangId: WORD): WORD; +{$EXTERNALSYM SUBLANGID} + +// +// A locale ID is a 32 bit value which is the combination of a +// language ID, a sort ID, and a reserved area. The bits are +// allocated as follows: +// +// +-------------+---------+-------------------------+ +// | Reserved | Sort ID | Language ID | +// +-------------+---------+-------------------------+ +// 31 20 19 16 15 0 bit +// +// +// Locale ID creation/extraction macros: +// +// MAKELCID - construct the locale id from a language id and a sort id. +// MAKESORTLCID - construct the locale id from a language id, sort id, and sort version. +// LANGIDFROMLCID - extract the language id from a locale id. +// SORTIDFROMLCID - extract the sort id from a locale id. +// SORTVERSIONFROMLCID - extract the sort version from a locale id. +// + +const + NLS_VALID_LOCALE_MASK = $000fffff; + {$EXTERNALSYM NLS_VALID_LOCALE_MASK} + +function MAKELCID(LangId, SortId: WORD): DWORD; +{$EXTERNALSYM MAKELCID} +function MAKESORTLCID(LangId, SortId, SortVersion: WORD): DWORD; +{$EXTERNALSYM MAKESORTLCID} +function LANGIDFROMLCID(LocaleId: LCID): WORD; +{$EXTERNALSYM LANGIDFROMLCID} +function SORTIDFROMLCID(LocaleId: LCID): WORD; +{$EXTERNALSYM SORTIDFROMLCID} +function SORTVERSIONFROMLCID(LocaleId: LCID): WORD; +{$EXTERNALSYM SORTVERSIONFROMLCID} + +// line 1154 + +//////////////////////////////////////////////////////////////////////// +// // +// Security Id (SID) // +// // +//////////////////////////////////////////////////////////////////////// +// +// +// Pictorially the structure of an SID is as follows: +// +// 1 1 1 1 1 1 +// 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 +// +---------------------------------------------------------------+ +// | SubAuthorityCount |Reserved1 (SBZ)| Revision | +// +---------------------------------------------------------------+ +// | IdentifierAuthority[0] | +// +---------------------------------------------------------------+ +// | IdentifierAuthority[1] | +// +---------------------------------------------------------------+ +// | IdentifierAuthority[2] | +// +---------------------------------------------------------------+ +// | | +// +- - - - - - - - SubAuthority[] - - - - - - - - -+ +// | | +// +---------------------------------------------------------------+ +// +// + +{$IFNDEF FPC} +type + _SID_IDENTIFIER_AUTHORITY = record + Value: array [0..5] of Byte; + end; + {$EXTERNALSYM _SID_IDENTIFIER_AUTHORITY} + SID_IDENTIFIER_AUTHORITY = _SID_IDENTIFIER_AUTHORITY; + {$EXTERNALSYM SID_IDENTIFIER_AUTHORITY} + PSID_IDENTIFIER_AUTHORITY = ^_SID_IDENTIFIER_AUTHORITY; + {$EXTERNALSYM PSID_IDENTIFIER_AUTHORITY} + + // PSid = ^SID; + _SID = record + Revision: Byte; + SubAuthorityCount: Byte; + IdentifierAuthority: SID_IDENTIFIER_AUTHORITY; + SubAuthority: array [0..ANYSIZE_ARRAY - 1] of DWORD; + end; + {$EXTERNALSYM _SID} + SID = _SID; + {$EXTERNALSYM SID} + PPSID = ^PSID; + {$NODEFINE PPSID} + TSid = SID; +{$ENDIF ~FPC} + +const + SID_REVISION = (1); // Current revision level + {$EXTERNALSYM SID_REVISION} + SID_MAX_SUB_AUTHORITIES = (15); + {$EXTERNALSYM SID_MAX_SUB_AUTHORITIES} + SID_RECOMMENDED_SUB_AUTHORITIES = (1); // Will change to around 6 in a future release. + {$EXTERNALSYM SID_RECOMMENDED_SUB_AUTHORITIES} + + SECURITY_MAX_SID_SIZE = SizeOf(SID) - SizeOf(DWORD) + (SID_MAX_SUB_AUTHORITIES * SizeOf(DWORD)); + {$EXTERNALSYM SECURITY_MAX_SID_SIZE} + +{$IFNDEF FPC} + SidTypeUser = 1; + {$EXTERNALSYM SidTypeUser} + SidTypeGroup = 2; + {$EXTERNALSYM SidTypeGroup} + SidTypeDomain = 3; + {$EXTERNALSYM SidTypeDomain} + SidTypeAlias = 4; + {$EXTERNALSYM SidTypeAlias} + SidTypeWellKnownGroup = 5; + {$EXTERNALSYM SidTypeWellKnownGroup} + SidTypeDeletedAccount = 6; + {$EXTERNALSYM SidTypeDeletedAccount} + SidTypeInvalid = 7; + {$EXTERNALSYM SidTypeInvalid} + SidTypeUnknown = 8; + {$EXTERNALSYM SidTypeUnknown} + SidTypeComputer = 9; + {$EXTERNALSYM SidTypeComputer} + +type + _SID_NAME_USE = DWORD; + {$EXTERNALSYM _SID_NAME_USE} +// SID_NAME_USE = _SID_NAME_USE; +// {$EXTERNALSYM SID_NAME_USE} + PSID_NAME_USE = ^SID_NAME_USE; + {$EXTERNALSYM PSID_NAME_USE} + TSidNameUse = SID_NAME_USE; + PSidNameUSe = PSID_NAME_USE; + + PSID_AND_ATTRIBUTES = ^SID_AND_ATTRIBUTES; + {$EXTERNALSYM PSID_AND_ATTRIBUTES} + _SID_AND_ATTRIBUTES = record + Sid: PSID; + Attributes: DWORD; + end; + {$EXTERNALSYM _SID_AND_ATTRIBUTES} + SID_AND_ATTRIBUTES = _SID_AND_ATTRIBUTES; + {$EXTERNALSYM SID_AND_ATTRIBUTES} + TSidAndAttributes = SID_AND_ATTRIBUTES; + PSidAndAttributes = PSID_AND_ATTRIBUTES; + + SID_AND_ATTRIBUTES_ARRAY = array [0..ANYSIZE_ARRAY - 1] of SID_AND_ATTRIBUTES; + {$EXTERNALSYM SID_AND_ATTRIBUTES_ARRAY} + PSID_AND_ATTRIBUTES_ARRAY = ^SID_AND_ATTRIBUTES_ARRAY; + {$EXTERNALSYM PSID_AND_ATTRIBUTES_ARRAY} + PSidAndAttributesArray = ^TSidAndAttributesArray; + TSidAndAttributesArray = SID_AND_ATTRIBUTES_ARRAY; +{$ENDIF ~FPC} + +///////////////////////////////////////////////////////////////////////////// +// // +// Universal well-known SIDs // +// // +// Null SID S-1-0-0 // +// World S-1-1-0 // +// Local S-1-2-0 // +// Creator Owner ID S-1-3-0 // +// Creator Group ID S-1-3-1 // +// Creator Owner Server ID S-1-3-2 // +// Creator Group Server ID S-1-3-3 // +// // +// (Non-unique IDs) S-1-4 // +// // +///////////////////////////////////////////////////////////////////////////// + +const + SECURITY_NULL_SID_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 0)); + {$EXTERNALSYM SECURITY_NULL_SID_AUTHORITY} + SECURITY_WORLD_SID_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 1)); + {$EXTERNALSYM SECURITY_WORLD_SID_AUTHORITY} + SECURITY_LOCAL_SID_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 2)); + {$EXTERNALSYM SECURITY_LOCAL_SID_AUTHORITY} + SECURITY_CREATOR_SID_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 3)); + {$EXTERNALSYM SECURITY_CREATOR_SID_AUTHORITY} + SECURITY_NON_UNIQUE_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 4)); + {$EXTERNALSYM SECURITY_NON_UNIQUE_AUTHORITY} + SECURITY_RESOURCE_MANAGER_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 9)); + {$EXTERNALSYM SECURITY_RESOURCE_MANAGER_AUTHORITY} + + SECURITY_NULL_RID = ($00000000); + {$EXTERNALSYM SECURITY_NULL_RID} + SECURITY_WORLD_RID = ($00000000); + {$EXTERNALSYM SECURITY_WORLD_RID} + SECURITY_LOCAL_RID = ($00000000); + {$EXTERNALSYM SECURITY_LOCAL_RID} + + SECURITY_CREATOR_OWNER_RID = ($00000000); + {$EXTERNALSYM SECURITY_CREATOR_OWNER_RID} + SECURITY_CREATOR_GROUP_RID = ($00000001); + {$EXTERNALSYM SECURITY_CREATOR_GROUP_RID} + + SECURITY_CREATOR_OWNER_SERVER_RID = ($00000002); + {$EXTERNALSYM SECURITY_CREATOR_OWNER_SERVER_RID} + SECURITY_CREATOR_GROUP_SERVER_RID = ($00000003); + {$EXTERNALSYM SECURITY_CREATOR_GROUP_SERVER_RID} + +///////////////////////////////////////////////////////////////////////////// +// // +// NT well-known SIDs // +// // +// NT Authority S-1-5 // +// Dialup S-1-5-1 // +// // +// Network S-1-5-2 // +// Batch S-1-5-3 // +// Interactive S-1-5-4 // +// (Logon IDs) S-1-5-5-X-Y // +// Service S-1-5-6 // +// AnonymousLogon S-1-5-7 (aka null logon session) // +// Proxy S-1-5-8 // +// Enterprise DC (EDC) S-1-5-9 (aka domain controller account) // +// Self S-1-5-10 (self RID) // +// Authenticated User S-1-5-11 (Authenticated user somewhere) // +// Restricted Code S-1-5-12 (Running restricted code) // +// Terminal Server S-1-5-13 (Running on Terminal Server) // +// Remote Logon S-1-5-14 (Remote Interactive Logon) // +// This Organization S-1-5-15 // +// // +// Local System S-1-5-18 // +// Local Service S-1-5-19 // +// Network Service S-1-5-20 // +// // +// (NT non-unique IDs) S-1-5-0x15-... (NT Domain Sids) // +// // +// (Built-in domain) S-1-5-0x20 // +// // +// (Security Package IDs) S-1-5-0x40 // +// NTLM Authentication S-1-5-0x40-10 // +// SChannel Authentication S-1-5-0x40-14 // +// Digest Authentication S-1-5-0x40-21 // +// // +// Other Organization S-1-5-1000 (>=1000 can not be filtered) // +// // +// // +// NOTE: the relative identifier values (RIDs) determine which security // +// boundaries the SID is allowed to cross. Before adding new RIDs, // +// a determination needs to be made regarding which range they should // +// be added to in order to ensure proper "SID filtering" // +// // +///////////////////////////////////////////////////////////////////////////// + +const + SECURITY_NT_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5)); + {$EXTERNALSYM SECURITY_NT_AUTHORITY} + + SECURITY_DIALUP_RID = ($00000001); + {$EXTERNALSYM SECURITY_DIALUP_RID} + SECURITY_NETWORK_RID = ($00000002); + {$EXTERNALSYM SECURITY_NETWORK_RID} + SECURITY_BATCH_RID = ($00000003); + {$EXTERNALSYM SECURITY_BATCH_RID} + SECURITY_INTERACTIVE_RID = ($00000004); + {$EXTERNALSYM SECURITY_INTERACTIVE_RID} + SECURITY_LOGON_IDS_RID = ($00000005); + {$EXTERNALSYM SECURITY_LOGON_IDS_RID} + SECURITY_LOGON_IDS_RID_COUNT = (3); + {$EXTERNALSYM SECURITY_LOGON_IDS_RID_COUNT} + SECURITY_SERVICE_RID = ($00000006); + {$EXTERNALSYM SECURITY_SERVICE_RID} + SECURITY_ANONYMOUS_LOGON_RID = ($00000007); + {$EXTERNALSYM SECURITY_ANONYMOUS_LOGON_RID} + SECURITY_PROXY_RID = ($00000008); + {$EXTERNALSYM SECURITY_PROXY_RID} + SECURITY_ENTERPRISE_CONTROLLERS_RID = ($00000009); + {$EXTERNALSYM SECURITY_ENTERPRISE_CONTROLLERS_RID} + SECURITY_SERVER_LOGON_RID = SECURITY_ENTERPRISE_CONTROLLERS_RID; + {$EXTERNALSYM SECURITY_SERVER_LOGON_RID} + SECURITY_PRINCIPAL_SELF_RID = ($0000000A); + {$EXTERNALSYM SECURITY_PRINCIPAL_SELF_RID} + SECURITY_AUTHENTICATED_USER_RID = ($0000000B); + {$EXTERNALSYM SECURITY_AUTHENTICATED_USER_RID} + SECURITY_RESTRICTED_CODE_RID = ($0000000C); + {$EXTERNALSYM SECURITY_RESTRICTED_CODE_RID} + SECURITY_TERMINAL_SERVER_RID = ($0000000D); + {$EXTERNALSYM SECURITY_TERMINAL_SERVER_RID} + SECURITY_REMOTE_LOGON_RID = ($0000000E); + {$EXTERNALSYM SECURITY_REMOTE_LOGON_RID} + SECURITY_THIS_ORGANIZATION_RID = ($0000000F); + {$EXTERNALSYM SECURITY_THIS_ORGANIZATION_RID} + + SECURITY_LOCAL_SYSTEM_RID = ($00000012); + {$EXTERNALSYM SECURITY_LOCAL_SYSTEM_RID} + SECURITY_LOCAL_SERVICE_RID = ($00000013); + {$EXTERNALSYM SECURITY_LOCAL_SERVICE_RID} + SECURITY_NETWORK_SERVICE_RID = ($00000014); + {$EXTERNALSYM SECURITY_NETWORK_SERVICE_RID} + + SECURITY_NT_NON_UNIQUE = ($00000015); + {$EXTERNALSYM SECURITY_NT_NON_UNIQUE} + SECURITY_NT_NON_UNIQUE_SUB_AUTH_COUNT = (3); + {$EXTERNALSYM SECURITY_NT_NON_UNIQUE_SUB_AUTH_COUNT} + + SECURITY_BUILTIN_DOMAIN_RID = ($00000020); + {$EXTERNALSYM SECURITY_BUILTIN_DOMAIN_RID} + + SECURITY_PACKAGE_BASE_RID = ($00000040); + {$EXTERNALSYM SECURITY_PACKAGE_BASE_RID} + SECURITY_PACKAGE_RID_COUNT = (2); + {$EXTERNALSYM SECURITY_PACKAGE_RID_COUNT} + SECURITY_PACKAGE_NTLM_RID = ($0000000A); + {$EXTERNALSYM SECURITY_PACKAGE_NTLM_RID} + SECURITY_PACKAGE_SCHANNEL_RID = ($0000000E); + {$EXTERNALSYM SECURITY_PACKAGE_SCHANNEL_RID} + SECURITY_PACKAGE_DIGEST_RID = ($00000015); + {$EXTERNALSYM SECURITY_PACKAGE_DIGEST_RID} + + SECURITY_MAX_ALWAYS_FILTERED = ($000003E7); + {$EXTERNALSYM SECURITY_MAX_ALWAYS_FILTERED} + SECURITY_MIN_NEVER_FILTERED = ($000003E8); + {$EXTERNALSYM SECURITY_MIN_NEVER_FILTERED} + + SECURITY_OTHER_ORGANIZATION_RID = ($000003E8); + {$EXTERNALSYM SECURITY_OTHER_ORGANIZATION_RID} + +///////////////////////////////////////////////////////////////////////////// +// // +// well-known domain relative sub-authority values (RIDs)... // +// // +///////////////////////////////////////////////////////////////////////////// + +// Well-known users ... + + FOREST_USER_RID_MAX = ($000001F3); + {$EXTERNALSYM FOREST_USER_RID_MAX} + + DOMAIN_USER_RID_ADMIN = ($000001F4); + {$EXTERNALSYM DOMAIN_USER_RID_ADMIN} + DOMAIN_USER_RID_GUEST = ($000001F5); + {$EXTERNALSYM DOMAIN_USER_RID_GUEST} + DOMAIN_USER_RID_KRBTGT = ($000001F6); + {$EXTERNALSYM DOMAIN_USER_RID_KRBTGT} + + DOMAIN_USER_RID_MAX = ($000003E7); + {$EXTERNALSYM DOMAIN_USER_RID_MAX} + +// well-known groups ... + + DOMAIN_GROUP_RID_ADMINS = ($00000200); + {$EXTERNALSYM DOMAIN_GROUP_RID_ADMINS} + DOMAIN_GROUP_RID_USERS = ($00000201); + {$EXTERNALSYM DOMAIN_GROUP_RID_USERS} + DOMAIN_GROUP_RID_GUESTS = ($00000202); + {$EXTERNALSYM DOMAIN_GROUP_RID_GUESTS} + DOMAIN_GROUP_RID_COMPUTERS = ($00000203); + {$EXTERNALSYM DOMAIN_GROUP_RID_COMPUTERS} + DOMAIN_GROUP_RID_CONTROLLERS = ($00000204); + {$EXTERNALSYM DOMAIN_GROUP_RID_CONTROLLERS} + DOMAIN_GROUP_RID_CERT_ADMINS = ($00000205); + {$EXTERNALSYM DOMAIN_GROUP_RID_CERT_ADMINS} + DOMAIN_GROUP_RID_SCHEMA_ADMINS = ($00000206); + {$EXTERNALSYM DOMAIN_GROUP_RID_SCHEMA_ADMINS} + DOMAIN_GROUP_RID_ENTERPRISE_ADMINS = ($00000207); + {$EXTERNALSYM DOMAIN_GROUP_RID_ENTERPRISE_ADMINS} + DOMAIN_GROUP_RID_POLICY_ADMINS = ($00000208); + {$EXTERNALSYM DOMAIN_GROUP_RID_POLICY_ADMINS} + +// well-known aliases ... + + DOMAIN_ALIAS_RID_ADMINS = ($00000220); + {$EXTERNALSYM DOMAIN_ALIAS_RID_ADMINS} + DOMAIN_ALIAS_RID_USERS = ($00000221); + {$EXTERNALSYM DOMAIN_ALIAS_RID_USERS} + DOMAIN_ALIAS_RID_GUESTS = ($00000222); + {$EXTERNALSYM DOMAIN_ALIAS_RID_GUESTS} + DOMAIN_ALIAS_RID_POWER_USERS = ($00000223); + {$EXTERNALSYM DOMAIN_ALIAS_RID_POWER_USERS} + + DOMAIN_ALIAS_RID_ACCOUNT_OPS = ($00000224); + {$EXTERNALSYM DOMAIN_ALIAS_RID_ACCOUNT_OPS} + DOMAIN_ALIAS_RID_SYSTEM_OPS = ($00000225); + {$EXTERNALSYM DOMAIN_ALIAS_RID_SYSTEM_OPS} + DOMAIN_ALIAS_RID_PRINT_OPS = ($00000226); + {$EXTERNALSYM DOMAIN_ALIAS_RID_PRINT_OPS} + DOMAIN_ALIAS_RID_BACKUP_OPS = ($00000227); + {$EXTERNALSYM DOMAIN_ALIAS_RID_BACKUP_OPS} + + DOMAIN_ALIAS_RID_REPLICATOR = ($00000228); + {$EXTERNALSYM DOMAIN_ALIAS_RID_REPLICATOR} + DOMAIN_ALIAS_RID_RAS_SERVERS = ($00000229); + {$EXTERNALSYM DOMAIN_ALIAS_RID_RAS_SERVERS} + DOMAIN_ALIAS_RID_PREW2KCOMPACCESS = ($0000022A); + {$EXTERNALSYM DOMAIN_ALIAS_RID_PREW2KCOMPACCESS} + DOMAIN_ALIAS_RID_REMOTE_DESKTOP_USERS = ($0000022B); + {$EXTERNALSYM DOMAIN_ALIAS_RID_REMOTE_DESKTOP_USERS} + DOMAIN_ALIAS_RID_NETWORK_CONFIGURATION_OPS = ($0000022C); + {$EXTERNALSYM DOMAIN_ALIAS_RID_NETWORK_CONFIGURATION_OPS} + DOMAIN_ALIAS_RID_INCOMING_FOREST_TRUST_BUILDERS = ($0000022D); + {$EXTERNALSYM DOMAIN_ALIAS_RID_INCOMING_FOREST_TRUST_BUILDERS} + + DOMAIN_ALIAS_RID_MONITORING_USERS = ($0000022E); + {$EXTERNALSYM DOMAIN_ALIAS_RID_MONITORING_USERS} + DOMAIN_ALIAS_RID_LOGGING_USERS = ($0000022F); + {$EXTERNALSYM DOMAIN_ALIAS_RID_LOGGING_USERS} + DOMAIN_ALIAS_RID_AUTHORIZATIONACCESS = ($00000230); + {$EXTERNALSYM DOMAIN_ALIAS_RID_AUTHORIZATIONACCESS} + DOMAIN_ALIAS_RID_TS_LICENSE_SERVERS = ($00000231); + {$EXTERNALSYM DOMAIN_ALIAS_RID_TS_LICENSE_SERVERS} + +// line 2495 + +//////////////////////////////////////////////////////////////////////// +// // +// NT Defined Privileges // +// // +//////////////////////////////////////////////////////////////////////// + +const + SE_CREATE_TOKEN_NAME = 'SeCreateTokenPrivilege'; + {$EXTERNALSYM SE_CREATE_TOKEN_NAME} + SE_ASSIGNPRIMARYTOKEN_NAME = 'SeAssignPrimaryTokenPrivilege'; + {$EXTERNALSYM SE_ASSIGNPRIMARYTOKEN_NAME} + SE_LOCK_MEMORY_NAME = 'SeLockMemoryPrivilege'; + {$EXTERNALSYM SE_LOCK_MEMORY_NAME} + SE_INCREASE_QUOTA_NAME = 'SeIncreaseQuotaPrivilege'; + {$EXTERNALSYM SE_INCREASE_QUOTA_NAME} + SE_UNSOLICITED_INPUT_NAME = 'SeUnsolicitedInputPrivilege'; + {$EXTERNALSYM SE_UNSOLICITED_INPUT_NAME} + SE_MACHINE_ACCOUNT_NAME = 'SeMachineAccountPrivilege'; + {$EXTERNALSYM SE_MACHINE_ACCOUNT_NAME} + SE_TCB_NAME = 'SeTcbPrivilege'; + {$EXTERNALSYM SE_TCB_NAME} + SE_SECURITY_NAME = 'SeSecurityPrivilege'; + {$EXTERNALSYM SE_SECURITY_NAME} + SE_TAKE_OWNERSHIP_NAME = 'SeTakeOwnershipPrivilege'; + {$EXTERNALSYM SE_TAKE_OWNERSHIP_NAME} + SE_LOAD_DRIVER_NAME = 'SeLoadDriverPrivilege'; + {$EXTERNALSYM SE_LOAD_DRIVER_NAME} + SE_SYSTEM_PROFILE_NAME = 'SeSystemProfilePrivilege'; + {$EXTERNALSYM SE_SYSTEM_PROFILE_NAME} + SE_SYSTEMTIME_NAME = 'SeSystemtimePrivilege'; + {$EXTERNALSYM SE_SYSTEMTIME_NAME} + SE_PROF_SINGLE_PROCESS_NAME = 'SeProfileSingleProcessPrivilege'; + {$EXTERNALSYM SE_PROF_SINGLE_PROCESS_NAME} + SE_INC_BASE_PRIORITY_NAME = 'SeIncreaseBasePriorityPrivilege'; + {$EXTERNALSYM SE_INC_BASE_PRIORITY_NAME} + SE_CREATE_PAGEFILE_NAME = 'SeCreatePagefilePrivilege'; + {$EXTERNALSYM SE_CREATE_PAGEFILE_NAME} + SE_CREATE_PERMANENT_NAME = 'SeCreatePermanentPrivilege'; + {$EXTERNALSYM SE_CREATE_PERMANENT_NAME} + SE_BACKUP_NAME = 'SeBackupPrivilege'; + {$EXTERNALSYM SE_BACKUP_NAME} + SE_RESTORE_NAME = 'SeRestorePrivilege'; + {$EXTERNALSYM SE_RESTORE_NAME} + SE_SHUTDOWN_NAME = 'SeShutdownPrivilege'; + {$EXTERNALSYM SE_SHUTDOWN_NAME} + SE_DEBUG_NAME = 'SeDebugPrivilege'; + {$EXTERNALSYM SE_DEBUG_NAME} + SE_AUDIT_NAME = 'SeAuditPrivilege'; + {$EXTERNALSYM SE_AUDIT_NAME} + SE_SYSTEM_ENVIRONMENT_NAME = 'SeSystemEnvironmentPrivilege'; + {$EXTERNALSYM SE_SYSTEM_ENVIRONMENT_NAME} + SE_CHANGE_NOTIFY_NAME = 'SeChangeNotifyPrivilege'; + {$EXTERNALSYM SE_CHANGE_NOTIFY_NAME} + SE_REMOTE_SHUTDOWN_NAME = 'SeRemoteShutdownPrivilege'; + {$EXTERNALSYM SE_REMOTE_SHUTDOWN_NAME} + SE_UNDOCK_NAME = 'SeUndockPrivilege'; + {$EXTERNALSYM SE_UNDOCK_NAME} + SE_SYNC_AGENT_NAME = 'SeSyncAgentPrivilege'; + {$EXTERNALSYM SE_SYNC_AGENT_NAME} + SE_ENABLE_DELEGATION_NAME = 'SeEnableDelegationPrivilege'; + {$EXTERNALSYM SE_ENABLE_DELEGATION_NAME} + SE_MANAGE_VOLUME_NAME = 'SeManageVolumePrivilege'; + {$EXTERNALSYM SE_MANAGE_VOLUME_NAME} + SE_IMPERSONATE_NAME = 'SeImpersonatePrivilege'; + {$EXTERNALSYM SE_IMPERSONATE_NAME} + SE_CREATE_GLOBAL_NAME = 'SeCreateGlobalPrivilege'; + {$EXTERNALSYM SE_CREATE_GLOBAL_NAME} + +// +// Thread Information Block (TIB) +// + +type + NT_TIB32 = packed record + ExceptionList: DWORD; + StackBase: DWORD; + StackLimit: DWORD; + SubSystemTib: DWORD; + case Integer of + 0 : ( + FiberData: DWORD; + ArbitraryUserPointer: DWORD; + Self: DWORD; + ); + 1 : ( + Version: DWORD; + ); + end; + {$EXTERNALSYM NT_TIB32} + PNT_TIB32 = ^NT_TIB32; + {$EXTERNALSYM PNT_TIB32} + + NT_TIB64 = packed record + ExceptionList: TJclAddr64; + StackBase: TJclAddr64; + StackLimit: TJclAddr64; + SubSystemTib: TJclAddr64; + case Integer of + 0 : ( + FiberData: TJclAddr64; + ArbitraryUserPointer: TJclAddr64; + Self: TJclAddr64; + ); + 1 : ( + Version: DWORD; + ); + end; + {$EXTERNALSYM NT_TIB64} + PNT_TIB64 = ^NT_TIB64; + {$EXTERNALSYM PNT_TIB64} + +// line 2686 + +// +// Token information class structures +// + +{$IFNDEF FPC} +type + PTOKEN_USER = ^TOKEN_USER; + {$EXTERNALSYM PTOKEN_USER} + _TOKEN_USER = record + User: SID_AND_ATTRIBUTES; + end; + {$EXTERNALSYM _TOKEN_USER} + TOKEN_USER = _TOKEN_USER; + {$EXTERNALSYM TOKEN_USER} + TTokenUser = TOKEN_USER; + PTokenUser = PTOKEN_USER; +{$ENDIF ~FPC} + +function CaptureStackBackTrace(FramesToSkip, FramesToCapture: DWORD; + BackTrace: Pointer; out BackTraceHash: DWORD): Word; stdcall; +{$EXTERNALSYM CaptureStackBackTrace} + +// line 3858 + +// +// Define access rights to files and directories +// + +// +// The FILE_READ_DATA and FILE_WRITE_DATA constants are also defined in +// devioctl.h as FILE_READ_ACCESS and FILE_WRITE_ACCESS. The values for these +// constants *MUST* always be in sync. +// The values are redefined in devioctl.h because they must be available to +// both DOS and NT. +// + +const + FILE_READ_DATA = ($0001); // file & pipe + {$EXTERNALSYM FILE_READ_DATA} + FILE_LIST_DIRECTORY = ($0001); // directory + {$EXTERNALSYM FILE_LIST_DIRECTORY} + + FILE_WRITE_DATA = ($0002); // file & pipe + {$EXTERNALSYM FILE_WRITE_DATA} + FILE_ADD_FILE = ($0002); // directory + {$EXTERNALSYM FILE_ADD_FILE} + + FILE_APPEND_DATA = ($0004); // file + {$EXTERNALSYM FILE_APPEND_DATA} + FILE_ADD_SUBDIRECTORY = ($0004); // directory + {$EXTERNALSYM FILE_ADD_SUBDIRECTORY} + FILE_CREATE_PIPE_INSTANCE = ($0004); // named pipe + {$EXTERNALSYM FILE_CREATE_PIPE_INSTANCE} + + FILE_READ_EA = ($0008); // file & directory + {$EXTERNALSYM FILE_READ_EA} + + FILE_WRITE_EA = ($0010); // file & directory + {$EXTERNALSYM FILE_WRITE_EA} + + FILE_EXECUTE = ($0020); // file + {$EXTERNALSYM FILE_EXECUTE} + FILE_TRAVERSE = ($0020); // directory + {$EXTERNALSYM FILE_TRAVERSE} + + FILE_DELETE_CHILD = ($0040); // directory + {$EXTERNALSYM FILE_DELETE_CHILD} + + FILE_READ_ATTRIBUTES = ($0080); // all + {$EXTERNALSYM FILE_READ_ATTRIBUTES} + + FILE_WRITE_ATTRIBUTES = ($0100); // all + {$EXTERNALSYM FILE_WRITE_ATTRIBUTES} + + FILE_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or $1FF); + {$EXTERNALSYM FILE_ALL_ACCESS} + + FILE_GENERIC_READ = (STANDARD_RIGHTS_READ or FILE_READ_DATA or + FILE_READ_ATTRIBUTES or FILE_READ_EA or SYNCHRONIZE); + {$EXTERNALSYM FILE_GENERIC_READ} + + FILE_GENERIC_WRITE = (STANDARD_RIGHTS_WRITE or FILE_WRITE_DATA or + FILE_WRITE_ATTRIBUTES or FILE_WRITE_EA or FILE_APPEND_DATA or SYNCHRONIZE); + {$EXTERNALSYM FILE_GENERIC_WRITE} + + FILE_GENERIC_EXECUTE = (STANDARD_RIGHTS_EXECUTE or FILE_READ_ATTRIBUTES or + FILE_EXECUTE or SYNCHRONIZE); + {$EXTERNALSYM FILE_GENERIC_EXECUTE} + + FILE_SHARE_READ = $00000001; + {$EXTERNALSYM FILE_SHARE_READ} + FILE_SHARE_WRITE = $00000002; + {$EXTERNALSYM FILE_SHARE_WRITE} + FILE_SHARE_DELETE = $00000004; + {$EXTERNALSYM FILE_SHARE_DELETE} + FILE_ATTRIBUTE_READONLY = $00000001; + {$EXTERNALSYM FILE_ATTRIBUTE_READONLY} + FILE_ATTRIBUTE_HIDDEN = $00000002; + {$EXTERNALSYM FILE_ATTRIBUTE_HIDDEN} + FILE_ATTRIBUTE_SYSTEM = $00000004; + {$EXTERNALSYM FILE_ATTRIBUTE_SYSTEM} + FILE_ATTRIBUTE_DIRECTORY = $00000010; + {$EXTERNALSYM FILE_ATTRIBUTE_DIRECTORY} + FILE_ATTRIBUTE_ARCHIVE = $00000020; + {$EXTERNALSYM FILE_ATTRIBUTE_ARCHIVE} + FILE_ATTRIBUTE_DEVICE = $00000040; + {$EXTERNALSYM FILE_ATTRIBUTE_DEVICE} + FILE_ATTRIBUTE_NORMAL = $00000080; + {$EXTERNALSYM FILE_ATTRIBUTE_NORMAL} + FILE_ATTRIBUTE_TEMPORARY = $00000100; + {$EXTERNALSYM FILE_ATTRIBUTE_TEMPORARY} + FILE_ATTRIBUTE_SPARSE_FILE = $00000200; + {$EXTERNALSYM FILE_ATTRIBUTE_SPARSE_FILE} + FILE_ATTRIBUTE_REPARSE_POINT = $00000400; + {$EXTERNALSYM FILE_ATTRIBUTE_REPARSE_POINT} + FILE_ATTRIBUTE_COMPRESSED = $00000800; + {$EXTERNALSYM FILE_ATTRIBUTE_COMPRESSED} + FILE_ATTRIBUTE_OFFLINE = $00001000; + {$EXTERNALSYM FILE_ATTRIBUTE_OFFLINE} + FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = $00002000; + {$EXTERNALSYM FILE_ATTRIBUTE_NOT_CONTENT_INDEXED} + FILE_ATTRIBUTE_ENCRYPTED = $00004000; + {$EXTERNALSYM FILE_ATTRIBUTE_ENCRYPTED} + FILE_NOTIFY_CHANGE_FILE_NAME = $00000001; + {$EXTERNALSYM FILE_NOTIFY_CHANGE_FILE_NAME} + FILE_NOTIFY_CHANGE_DIR_NAME = $00000002; + {$EXTERNALSYM FILE_NOTIFY_CHANGE_DIR_NAME} + FILE_NOTIFY_CHANGE_ATTRIBUTES = $00000004; + {$EXTERNALSYM FILE_NOTIFY_CHANGE_ATTRIBUTES} + FILE_NOTIFY_CHANGE_SIZE = $00000008; + {$EXTERNALSYM FILE_NOTIFY_CHANGE_SIZE} + FILE_NOTIFY_CHANGE_LAST_WRITE = $00000010; + {$EXTERNALSYM FILE_NOTIFY_CHANGE_LAST_WRITE} + FILE_NOTIFY_CHANGE_LAST_ACCESS = $00000020; + {$EXTERNALSYM FILE_NOTIFY_CHANGE_LAST_ACCESS} + FILE_NOTIFY_CHANGE_CREATION = $00000040; + {$EXTERNALSYM FILE_NOTIFY_CHANGE_CREATION} + FILE_NOTIFY_CHANGE_SECURITY = $00000100; + {$EXTERNALSYM FILE_NOTIFY_CHANGE_SECURITY} + FILE_ACTION_ADDED = $00000001; + {$EXTERNALSYM FILE_ACTION_ADDED} + FILE_ACTION_REMOVED = $00000002; + {$EXTERNALSYM FILE_ACTION_REMOVED} + FILE_ACTION_MODIFIED = $00000003; + {$EXTERNALSYM FILE_ACTION_MODIFIED} + FILE_ACTION_RENAMED_OLD_NAME = $00000004; + {$EXTERNALSYM FILE_ACTION_RENAMED_OLD_NAME} + FILE_ACTION_RENAMED_NEW_NAME = $00000005; + {$EXTERNALSYM FILE_ACTION_RENAMED_NEW_NAME} + MAILSLOT_NO_MESSAGE = DWORD(-1); + {$EXTERNALSYM MAILSLOT_NO_MESSAGE} + MAILSLOT_WAIT_FOREVER = DWORD(-1); + {$EXTERNALSYM MAILSLOT_WAIT_FOREVER} + FILE_CASE_SENSITIVE_SEARCH = $00000001; + {$EXTERNALSYM FILE_CASE_SENSITIVE_SEARCH} + FILE_CASE_PRESERVED_NAMES = $00000002; + {$EXTERNALSYM FILE_CASE_PRESERVED_NAMES} + FILE_UNICODE_ON_DISK = $00000004; + {$EXTERNALSYM FILE_UNICODE_ON_DISK} + FILE_PERSISTENT_ACLS = $00000008; + {$EXTERNALSYM FILE_PERSISTENT_ACLS} + FILE_FILE_COMPRESSION = $00000010; + {$EXTERNALSYM FILE_FILE_COMPRESSION} + FILE_VOLUME_QUOTAS = $00000020; + {$EXTERNALSYM FILE_VOLUME_QUOTAS} + FILE_SUPPORTS_SPARSE_FILES = $00000040; + {$EXTERNALSYM FILE_SUPPORTS_SPARSE_FILES} + FILE_SUPPORTS_REPARSE_POINTS = $00000080; + {$EXTERNALSYM FILE_SUPPORTS_REPARSE_POINTS} + FILE_SUPPORTS_REMOTE_STORAGE = $00000100; + {$EXTERNALSYM FILE_SUPPORTS_REMOTE_STORAGE} + FILE_VOLUME_IS_COMPRESSED = $00008000; + {$EXTERNALSYM FILE_VOLUME_IS_COMPRESSED} + FILE_SUPPORTS_OBJECT_IDS = $00010000; + {$EXTERNALSYM FILE_SUPPORTS_OBJECT_IDS} + FILE_SUPPORTS_ENCRYPTION = $00020000; + {$EXTERNALSYM FILE_SUPPORTS_ENCRYPTION} + FILE_NAMED_STREAMS = $00040000; + {$EXTERNALSYM FILE_NAMED_STREAMS} + FILE_READ_ONLY_VOLUME = $00080000; + {$EXTERNALSYM FILE_READ_ONLY_VOLUME} + +// line 4052 + +// +// The reparse GUID structure is used by all 3rd party layered drivers to +// store data in a reparse point. For non-Microsoft tags, The GUID field +// cannot be GUID_NULL. +// The constraints on reparse tags are defined below. +// Microsoft tags can also be used with this format of the reparse point buffer. +// + +type + TGenericReparseBuffer = record + DataBuffer: array [0..0] of BYTE; + end; + + PREPARSE_GUID_DATA_BUFFER = ^REPARSE_GUID_DATA_BUFFER; + {$EXTERNALSYM PREPARSE_GUID_DATA_BUFFER} + _REPARSE_GUID_DATA_BUFFER = record + ReparseTag: DWORD; + ReparseDataLength: WORD; + Reserved: WORD; + ReparseGuid: TGUID; + GenericReparseBuffer: TGenericReparseBuffer; + end; + {$EXTERNALSYM _REPARSE_GUID_DATA_BUFFER} + REPARSE_GUID_DATA_BUFFER = _REPARSE_GUID_DATA_BUFFER; + {$EXTERNALSYM REPARSE_GUID_DATA_BUFFER} + TReparseGuidDataBuffer = REPARSE_GUID_DATA_BUFFER; + PReparseGuidDataBuffer = PREPARSE_GUID_DATA_BUFFER; + +const + REPARSE_GUID_DATA_BUFFER_HEADER_SIZE = 24; + {$EXTERNALSYM REPARSE_GUID_DATA_BUFFER_HEADER_SIZE} +// +// Maximum allowed size of the reparse data. +// + +const + MAXIMUM_REPARSE_DATA_BUFFER_SIZE = 16 * 1024; + {$EXTERNALSYM MAXIMUM_REPARSE_DATA_BUFFER_SIZE} + +// +// Predefined reparse tags. +// These tags need to avoid conflicting with IO_REMOUNT defined in ntos\inc\io.h +// + + IO_REPARSE_TAG_RESERVED_ZERO = (0); + {$EXTERNALSYM IO_REPARSE_TAG_RESERVED_ZERO} + IO_REPARSE_TAG_RESERVED_ONE = (1); + {$EXTERNALSYM IO_REPARSE_TAG_RESERVED_ONE} + +// +// The value of the following constant needs to satisfy the following conditions: +// (1) Be at least as large as the largest of the reserved tags. +// (2) Be strictly smaller than all the tags in use. +// + + IO_REPARSE_TAG_RESERVED_RANGE = IO_REPARSE_TAG_RESERVED_ONE; + {$EXTERNALSYM IO_REPARSE_TAG_RESERVED_RANGE} + +// +// The reparse tags are a DWORD. The 32 bits are laid out as follows: +// +// 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 +// 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 +// +-+-+-+-+-----------------------+-------------------------------+ +// |M|R|N|R| Reserved bits | Reparse Tag Value | +// +-+-+-+-+-----------------------+-------------------------------+ +// +// M is the Microsoft bit. When set to 1, it denotes a tag owned by Microsoft. +// All ISVs must use a tag with a 0 in this position. +// Note: If a Microsoft tag is used by non-Microsoft software, the +// behavior is not defined. +// +// R is reserved. Must be zero for non-Microsoft tags. +// +// N is name surrogate. When set to 1, the file represents another named +// entity in the system. +// +// The M and N bits are OR-able. +// The following macros check for the M and N bit values: +// + +// +// Macro to determine whether a reparse point tag corresponds to a tag +// owned by Microsoft. +// + +function IsReparseTagMicrosoft(Tag: ULONG): Boolean; +{$EXTERNALSYM IsReparseTagMicrosoft} + +// +// Macro to determine whether a reparse point tag corresponds to a file +// that is to be displayed with the slow icon overlay. +// + +function IsReparseTagHighLatency(Tag: ULONG): Boolean; +{$EXTERNALSYM IsReparseTagHighLatency} + +// +// Macro to determine whether a reparse point tag is a name surrogate +// + +function IsReparseTagNameSurrogate(Tag: ULONG): Boolean; +{$EXTERNALSYM IsReparseTagNameSurrogate} + +const + IO_REPARSE_TAG_MOUNT_POINT = DWORD($A0000003); + {$EXTERNALSYM IO_REPARSE_TAG_MOUNT_POINT} + IO_REPARSE_TAG_HSM = DWORD($C0000004); + {$EXTERNALSYM IO_REPARSE_TAG_HSM} + IO_REPARSE_TAG_DRIVER_EXTENDER = DWORD($80000005); + {$EXTERNALSYM IO_REPARSE_TAG_DRIVER_EXTENDER} + IO_REPARSE_TAG_HSM2 = DWORD($80000006); + {$EXTERNALSYM IO_REPARSE_TAG_HSM2} + IO_REPARSE_TAG_SIS = DWORD($80000007); + {$EXTERNALSYM IO_REPARSE_TAG_SIS} + IO_REPARSE_TAG_DFS = DWORD($8000000A); + {$EXTERNALSYM IO_REPARSE_TAG_DFS} + IO_REPARSE_TAG_FILTER_MANAGER = DWORD($8000000B); + {$EXTERNALSYM IO_REPARSE_TAG_FILTER_MANAGER} + IO_REPARSE_TAG_SYMLINK = DWORD($A000000C); + {$EXTERNALSYM IO_REPARSE_TAG_SYMLINK} + IO_REPARSE_TAG_DFSR = DWORD($80000012); + {$EXTERNALSYM IO_REPARSE_TAG_DFSR} + IO_REPARSE_TAG_NFS = DWORD($80000014); + {$EXTERNALSYM IO_REPARSE_TAG_NFS} + + IO_COMPLETION_MODIFY_STATE = $0002; + {$EXTERNALSYM IO_COMPLETION_MODIFY_STATE} + IO_COMPLETION_ALL_ACCESS = DWORD(STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or $3); + {$EXTERNALSYM IO_COMPLETION_ALL_ACCESS} + + DUPLICATE_CLOSE_SOURCE = $00000001; + {$EXTERNALSYM DUPLICATE_CLOSE_SOURCE} + DUPLICATE_SAME_ACCESS = $00000002; + {$EXTERNALSYM DUPLICATE_SAME_ACCESS} + +// line 4763 + +// +// File header format. +// + +{$IFNDEF FPC} +type + PIMAGE_FILE_HEADER = ^IMAGE_FILE_HEADER; + {$EXTERNALSYM PIMAGE_FILE_HEADER} + _IMAGE_FILE_HEADER = record + Machine: WORD; + NumberOfSections: WORD; + TimeDateStamp: DWORD; + PointerToSymbolTable: DWORD; + NumberOfSymbols: DWORD; + SizeOfOptionalHeader: WORD; + Characteristics: WORD; + end; + {$EXTERNALSYM _IMAGE_FILE_HEADER} + IMAGE_FILE_HEADER = _IMAGE_FILE_HEADER; + {$EXTERNALSYM IMAGE_FILE_HEADER} + TImageFileHeader = IMAGE_FILE_HEADER; + PImageFileHeader = PIMAGE_FILE_HEADER; +{$ENDIF ~FPC} + +const + IMAGE_SIZEOF_FILE_HEADER = 20; + {$EXTERNALSYM IMAGE_SIZEOF_FILE_HEADER} + + IMAGE_FILE_RELOCS_STRIPPED = $0001; // Relocation info stripped from file. + {$EXTERNALSYM IMAGE_FILE_RELOCS_STRIPPED} + IMAGE_FILE_EXECUTABLE_IMAGE = $0002; // File is executable (i.e. no unresolved externel references). + {$EXTERNALSYM IMAGE_FILE_EXECUTABLE_IMAGE} + IMAGE_FILE_LINE_NUMS_STRIPPED = $0004; // Line nunbers stripped from file. + {$EXTERNALSYM IMAGE_FILE_LINE_NUMS_STRIPPED} + IMAGE_FILE_LOCAL_SYMS_STRIPPED = $0008; // Local symbols stripped from file. + {$EXTERNALSYM IMAGE_FILE_LOCAL_SYMS_STRIPPED} + IMAGE_FILE_AGGRESIVE_WS_TRIM = $0010; // Agressively trim working set + {$EXTERNALSYM IMAGE_FILE_AGGRESIVE_WS_TRIM} + IMAGE_FILE_LARGE_ADDRESS_AWARE = $0020; // App can handle >2gb addresses + {$EXTERNALSYM IMAGE_FILE_LARGE_ADDRESS_AWARE} + IMAGE_FILE_BYTES_REVERSED_LO = $0080; // Bytes of machine word are reversed. + {$EXTERNALSYM IMAGE_FILE_BYTES_REVERSED_LO} + IMAGE_FILE_32BIT_MACHINE = $0100; // 32 bit word machine. + {$EXTERNALSYM IMAGE_FILE_32BIT_MACHINE} + IMAGE_FILE_DEBUG_STRIPPED = $0200; // Debugging info stripped from file in .DBG file + {$EXTERNALSYM IMAGE_FILE_DEBUG_STRIPPED} + IMAGE_FILE_REMOVABLE_RUN_FROM_SWAP = $0400; // If Image is on removable media, copy and run from the swap file. + {$EXTERNALSYM IMAGE_FILE_REMOVABLE_RUN_FROM_SWAP} + IMAGE_FILE_NET_RUN_FROM_SWAP = $0800; // If Image is on Net, copy and run from the swap file. + {$EXTERNALSYM IMAGE_FILE_NET_RUN_FROM_SWAP} + IMAGE_FILE_SYSTEM = $1000; // System File. + {$EXTERNALSYM IMAGE_FILE_SYSTEM} + IMAGE_FILE_DLL = $2000; // File is a DLL. + {$EXTERNALSYM IMAGE_FILE_DLL} + IMAGE_FILE_UP_SYSTEM_ONLY = $4000; // File should only be run on a UP machine + {$EXTERNALSYM IMAGE_FILE_UP_SYSTEM_ONLY} + IMAGE_FILE_BYTES_REVERSED_HI = $8000; // Bytes of machine word are reversed. + {$EXTERNALSYM IMAGE_FILE_BYTES_REVERSED_HI} + + IMAGE_FILE_MACHINE_UNKNOWN = 0; + {$EXTERNALSYM IMAGE_FILE_MACHINE_UNKNOWN} + IMAGE_FILE_MACHINE_I386 = $014c; // Intel 386. + {$EXTERNALSYM IMAGE_FILE_MACHINE_I386} + IMAGE_FILE_MACHINE_R3000 = $0162; // MIPS little-endian, 0x160 big-endian + {$EXTERNALSYM IMAGE_FILE_MACHINE_R3000} + IMAGE_FILE_MACHINE_R4000 = $0166; // MIPS little-endian + {$EXTERNALSYM IMAGE_FILE_MACHINE_R4000} + IMAGE_FILE_MACHINE_R10000 = $0168; // MIPS little-endian + {$EXTERNALSYM IMAGE_FILE_MACHINE_R10000} + IMAGE_FILE_MACHINE_WCEMIPSV2 = $0169; // MIPS little-endian WCE v2 + {$EXTERNALSYM IMAGE_FILE_MACHINE_WCEMIPSV2} + IMAGE_FILE_MACHINE_ALPHA = $0184; // Alpha_AXP + {$EXTERNALSYM IMAGE_FILE_MACHINE_ALPHA} + IMAGE_FILE_MACHINE_SH3 = $01a2; // SH3 little-endian + {$EXTERNALSYM IMAGE_FILE_MACHINE_SH3} + IMAGE_FILE_MACHINE_SH3DSP = $01a3; + {$EXTERNALSYM IMAGE_FILE_MACHINE_SH3DSP} + IMAGE_FILE_MACHINE_SH3E = $01a4; // SH3E little-endian + {$EXTERNALSYM IMAGE_FILE_MACHINE_SH3E} + IMAGE_FILE_MACHINE_SH4 = $01a6; // SH4 little-endian + {$EXTERNALSYM IMAGE_FILE_MACHINE_SH4} + IMAGE_FILE_MACHINE_SH5 = $01a8; // SH5 + {$EXTERNALSYM IMAGE_FILE_MACHINE_SH5} + IMAGE_FILE_MACHINE_ARM = $01c0; // ARM Little-Endian + {$EXTERNALSYM IMAGE_FILE_MACHINE_ARM} + IMAGE_FILE_MACHINE_THUMB = $01c2; + {$EXTERNALSYM IMAGE_FILE_MACHINE_THUMB} + IMAGE_FILE_MACHINE_AM33 = $01d3; + {$EXTERNALSYM IMAGE_FILE_MACHINE_AM33} + IMAGE_FILE_MACHINE_POWERPC = $01F0; // IBM PowerPC Little-Endian + {$EXTERNALSYM IMAGE_FILE_MACHINE_POWERPC} + IMAGE_FILE_MACHINE_POWERPCFP = $01f1; + {$EXTERNALSYM IMAGE_FILE_MACHINE_POWERPCFP} + IMAGE_FILE_MACHINE_IA64 = $0200; // Intel 64 + {$EXTERNALSYM IMAGE_FILE_MACHINE_IA64} + IMAGE_FILE_MACHINE_MIPS16 = $0266; // MIPS + {$EXTERNALSYM IMAGE_FILE_MACHINE_MIPS16} + IMAGE_FILE_MACHINE_ALPHA64 = $0284; // ALPHA64 + {$EXTERNALSYM IMAGE_FILE_MACHINE_ALPHA64} + IMAGE_FILE_MACHINE_MIPSFPU = $0366; // MIPS + {$EXTERNALSYM IMAGE_FILE_MACHINE_MIPSFPU} + IMAGE_FILE_MACHINE_MIPSFPU16 = $0466; // MIPS + {$EXTERNALSYM IMAGE_FILE_MACHINE_MIPSFPU16} + IMAGE_FILE_MACHINE_AXP64 = IMAGE_FILE_MACHINE_ALPHA64; + {$EXTERNALSYM IMAGE_FILE_MACHINE_AXP64} + IMAGE_FILE_MACHINE_TRICORE = $0520; // Infineon + {$EXTERNALSYM IMAGE_FILE_MACHINE_TRICORE} + IMAGE_FILE_MACHINE_CEF = $0CEF; + {$EXTERNALSYM IMAGE_FILE_MACHINE_CEF} + IMAGE_FILE_MACHINE_EBC = $0EBC; // EFI Byte Code + {$EXTERNALSYM IMAGE_FILE_MACHINE_EBC} + IMAGE_FILE_MACHINE_AMD64 = $8664; // AMD64 (K8) + {$EXTERNALSYM IMAGE_FILE_MACHINE_AMD64} + IMAGE_FILE_MACHINE_M32R = $9041; // M32R little-endian + {$EXTERNALSYM IMAGE_FILE_MACHINE_M32R} + IMAGE_FILE_MACHINE_CEE = $C0EE; + {$EXTERNALSYM IMAGE_FILE_MACHINE_CEE} + +// +// Directory format. +// + +const + IMAGE_NUMBEROF_DIRECTORY_ENTRIES = 16; + {$EXTERNALSYM IMAGE_NUMBEROF_DIRECTORY_ENTRIES} + +// +// Optional header format. +// + +{$IFNDEF FPC} +type + PIMAGE_OPTIONAL_HEADER32 = ^IMAGE_OPTIONAL_HEADER32; + {$EXTERNALSYM PIMAGE_OPTIONAL_HEADER32} + + {$IF declared(_IMAGE_OPTIONAL_HEADER32)} // XE2+ + IMAGE_OPTIONAL_HEADER32 = _IMAGE_OPTIONAL_HEADER32; + {$ELSE} + IMAGE_OPTIONAL_HEADER32 = _IMAGE_OPTIONAL_HEADER; + {$IFEND} + {$EXTERNALSYM IMAGE_OPTIONAL_HEADER32} + TImageOptionalHeader32 = IMAGE_OPTIONAL_HEADER32; + PImageOptionalHeader32 = PIMAGE_OPTIONAL_HEADER32; + + PIMAGE_ROM_OPTIONAL_HEADER = ^IMAGE_ROM_OPTIONAL_HEADER; + {$EXTERNALSYM PIMAGE_ROM_OPTIONAL_HEADER} + _IMAGE_ROM_OPTIONAL_HEADER = record + Magic: Word; + MajorLinkerVersion: Byte; + MinorLinkerVersion: Byte; + SizeOfCode: DWORD; + SizeOfInitializedData: DWORD; + SizeOfUninitializedData: DWORD; + AddressOfEntryPoint: DWORD; + BaseOfCode: DWORD; + BaseOfData: DWORD; + BaseOfBss: DWORD; + GprMask: DWORD; + CprMask: array [0..3] of DWORD; + GpValue: DWORD; + end; + {$EXTERNALSYM _IMAGE_ROM_OPTIONAL_HEADER} + IMAGE_ROM_OPTIONAL_HEADER = _IMAGE_ROM_OPTIONAL_HEADER; + {$EXTERNALSYM IMAGE_ROM_OPTIONAL_HEADER} + TImageRomOptionalHeader = IMAGE_ROM_OPTIONAL_HEADER; + PImageRomOptionalHeader = PIMAGE_ROM_OPTIONAL_HEADER; + + PIMAGE_OPTIONAL_HEADER64 = ^IMAGE_OPTIONAL_HEADER64; + {$EXTERNALSYM PIMAGE_OPTIONAL_HEADER64} + _IMAGE_OPTIONAL_HEADER64 = record + Magic: Word; + MajorLinkerVersion: Byte; + MinorLinkerVersion: Byte; + SizeOfCode: DWORD; + SizeOfInitializedData: DWORD; + SizeOfUninitializedData: DWORD; + AddressOfEntryPoint: DWORD; + BaseOfCode: DWORD; + ImageBase: Int64; + SectionAlignment: DWORD; + FileAlignment: DWORD; + MajorOperatingSystemVersion: Word; + MinorOperatingSystemVersion: Word; + MajorImageVersion: Word; + MinorImageVersion: Word; + MajorSubsystemVersion: Word; + MinorSubsystemVersion: Word; + Win32VersionValue: DWORD; + SizeOfImage: DWORD; + SizeOfHeaders: DWORD; + CheckSum: DWORD; + Subsystem: Word; + DllCharacteristics: Word; + SizeOfStackReserve: Int64; + SizeOfStackCommit: Int64; + SizeOfHeapReserve: Int64; + SizeOfHeapCommit: Int64; + LoaderFlags: DWORD; + NumberOfRvaAndSizes: DWORD; + DataDirectory: array [0..IMAGE_NUMBEROF_DIRECTORY_ENTRIES - 1] of IMAGE_DATA_DIRECTORY; + end; + {$EXTERNALSYM _IMAGE_OPTIONAL_HEADER64} + IMAGE_OPTIONAL_HEADER64 = _IMAGE_OPTIONAL_HEADER64; + {$EXTERNALSYM IMAGE_OPTIONAL_HEADER64} + TImageOptionalHeader64 = IMAGE_OPTIONAL_HEADER64; + PImageOptionalHeader64 = PIMAGE_OPTIONAL_HEADER64; +{$ENDIF ~FPC} + +const + IMAGE_SIZEOF_ROM_OPTIONAL_HEADER = 56; + {$EXTERNALSYM IMAGE_SIZEOF_ROM_OPTIONAL_HEADER} + IMAGE_SIZEOF_STD_OPTIONAL_HEADER = 28; + {$EXTERNALSYM IMAGE_SIZEOF_STD_OPTIONAL_HEADER} + IMAGE_SIZEOF_NT_OPTIONAL32_HEADER = 224; + {$EXTERNALSYM IMAGE_SIZEOF_NT_OPTIONAL32_HEADER} + IMAGE_SIZEOF_NT_OPTIONAL64_HEADER = 240; + {$EXTERNALSYM IMAGE_SIZEOF_NT_OPTIONAL64_HEADER} + + IMAGE_NT_OPTIONAL_HDR32_MAGIC = $10b; + {$EXTERNALSYM IMAGE_NT_OPTIONAL_HDR32_MAGIC} + IMAGE_NT_OPTIONAL_HDR64_MAGIC = $20b; + {$EXTERNALSYM IMAGE_NT_OPTIONAL_HDR64_MAGIC} + IMAGE_ROM_OPTIONAL_HDR_MAGIC = $107; + {$EXTERNALSYM IMAGE_ROM_OPTIONAL_HDR_MAGIC} + +(* +type + IMAGE_OPTIONAL_HEADER = IMAGE_OPTIONAL_HEADER32; + {$EXTERNALSYM IMAGE_OPTIONAL_HEADER} + PIMAGE_OPTIONAL_HEADER = PIMAGE_OPTIONAL_HEADER32; + {$EXTERNALSYM PIMAGE_OPTIONAL_HEADER} +*) + +const + IMAGE_SIZEOF_NT_OPTIONAL_HEADER = IMAGE_SIZEOF_NT_OPTIONAL32_HEADER; + {$EXTERNALSYM IMAGE_SIZEOF_NT_OPTIONAL_HEADER} + IMAGE_NT_OPTIONAL_HDR_MAGIC = IMAGE_NT_OPTIONAL_HDR32_MAGIC; + {$EXTERNALSYM IMAGE_NT_OPTIONAL_HDR_MAGIC} + +{$IFNDEF FPC} +type + PIMAGE_NT_HEADERS64 = ^IMAGE_NT_HEADERS64; + {$EXTERNALSYM PIMAGE_NT_HEADERS64} + _IMAGE_NT_HEADERS64 = record + Signature: DWORD; + FileHeader: IMAGE_FILE_HEADER; + OptionalHeader: IMAGE_OPTIONAL_HEADER64; + end; + {$EXTERNALSYM _IMAGE_NT_HEADERS64} + IMAGE_NT_HEADERS64 = _IMAGE_NT_HEADERS64; + {$EXTERNALSYM IMAGE_NT_HEADERS64} + TImageNtHeaders64 = IMAGE_NT_HEADERS64; + PImageNtHeaders64 = PIMAGE_NT_HEADERS64; + + PIMAGE_NT_HEADERS32 = ^IMAGE_NT_HEADERS32; + {$EXTERNALSYM PIMAGE_NT_HEADERS32} + _IMAGE_NT_HEADERS = record + Signature: DWORD; + FileHeader: IMAGE_FILE_HEADER; + OptionalHeader: IMAGE_OPTIONAL_HEADER32; + end; + {$EXTERNALSYM _IMAGE_NT_HEADERS} + IMAGE_NT_HEADERS32 = _IMAGE_NT_HEADERS; + {$EXTERNALSYM IMAGE_NT_HEADERS32} + TImageNtHeaders32 = IMAGE_NT_HEADERS32; + PImageNtHeaders32 = PIMAGE_NT_HEADERS32; +{$ENDIF ~FPC} + +// Subsystem Values + +const + IMAGE_SUBSYSTEM_UNKNOWN = 0; // Unknown subsystem. + {$EXTERNALSYM IMAGE_SUBSYSTEM_UNKNOWN} + IMAGE_SUBSYSTEM_NATIVE = 1; // Image doesn't require a subsystem. + {$EXTERNALSYM IMAGE_SUBSYSTEM_NATIVE} + IMAGE_SUBSYSTEM_WINDOWS_GUI = 2; // Image runs in the Windows GUI subsystem. + {$EXTERNALSYM IMAGE_SUBSYSTEM_WINDOWS_GUI} + IMAGE_SUBSYSTEM_WINDOWS_CUI = 3; // Image runs in the Windows character subsystem. + {$EXTERNALSYM IMAGE_SUBSYSTEM_WINDOWS_CUI} + IMAGE_SUBSYSTEM_OS2_CUI = 5; // image runs in the OS/2 character subsystem. + {$EXTERNALSYM IMAGE_SUBSYSTEM_OS2_CUI} + IMAGE_SUBSYSTEM_POSIX_CUI = 7; // image runs in the Posix character subsystem. + {$EXTERNALSYM IMAGE_SUBSYSTEM_POSIX_CUI} + IMAGE_SUBSYSTEM_NATIVE_WINDOWS = 8; // image is a native Win9x driver. + {$EXTERNALSYM IMAGE_SUBSYSTEM_NATIVE_WINDOWS} + IMAGE_SUBSYSTEM_WINDOWS_CE_GUI = 9; // Image runs in the Windows CE subsystem. + {$EXTERNALSYM IMAGE_SUBSYSTEM_WINDOWS_CE_GUI} + IMAGE_SUBSYSTEM_EFI_APPLICATION = 10; + {$EXTERNALSYM IMAGE_SUBSYSTEM_EFI_APPLICATION} + IMAGE_SUBSYSTEM_EFI_BOOT_SERVICE_DRIVER = 11; + {$EXTERNALSYM IMAGE_SUBSYSTEM_EFI_BOOT_SERVICE_DRIVER} + IMAGE_SUBSYSTEM_EFI_RUNTIME_DRIVER = 12; + {$EXTERNALSYM IMAGE_SUBSYSTEM_EFI_RUNTIME_DRIVER} + IMAGE_SUBSYSTEM_EFI_ROM = 13; + {$EXTERNALSYM IMAGE_SUBSYSTEM_EFI_ROM} + IMAGE_SUBSYSTEM_XBOX = 14; + {$EXTERNALSYM IMAGE_SUBSYSTEM_XBOX} + +// DllCharacteristics Entries + +// IMAGE_LIBRARY_PROCESS_INIT 0x0001 // Reserved. +// IMAGE_LIBRARY_PROCESS_TERM 0x0002 // Reserved. +// IMAGE_LIBRARY_THREAD_INIT 0x0004 // Reserved. +// IMAGE_LIBRARY_THREAD_TERM 0x0008 // Reserved. + IMAGE_DLLCHARACTERISTICS_NO_ISOLATION = $0200; // Image understands isolation and doesn't want it + {$EXTERNALSYM IMAGE_DLLCHARACTERISTICS_NO_ISOLATION} + IMAGE_DLLCHARACTERISTICS_NO_SEH = $0400; // Image does not use SEH. No SE handler may reside in this image + {$EXTERNALSYM IMAGE_DLLCHARACTERISTICS_NO_SEH} + IMAGE_DLLCHARACTERISTICS_NO_BIND = $0800; // Do not bind this image. + {$EXTERNALSYM IMAGE_DLLCHARACTERISTICS_NO_BIND} + +// 0x1000 // Reserved. + + IMAGE_DLLCHARACTERISTICS_WDM_DRIVER = $2000; // Driver uses WDM model + {$EXTERNALSYM IMAGE_DLLCHARACTERISTICS_WDM_DRIVER} + +// 0x4000 // Reserved. + + IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE = $8000; + {$EXTERNALSYM IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE} + +// Directory Entries + + IMAGE_DIRECTORY_ENTRY_EXPORT = 0; // Export Directory + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_EXPORT} + IMAGE_DIRECTORY_ENTRY_IMPORT = 1; // Import Directory + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_IMPORT} + IMAGE_DIRECTORY_ENTRY_RESOURCE = 2; // Resource Directory + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_RESOURCE} + IMAGE_DIRECTORY_ENTRY_EXCEPTION = 3; // Exception Directory + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_EXCEPTION} + IMAGE_DIRECTORY_ENTRY_SECURITY = 4; // Security Directory + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_SECURITY} + IMAGE_DIRECTORY_ENTRY_BASERELOC = 5; // Base Relocation Table + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_BASERELOC} + IMAGE_DIRECTORY_ENTRY_DEBUG = 6; // Debug Directory + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_DEBUG} + +// IMAGE_DIRECTORY_ENTRY_COPYRIGHT 7 // (X86 usage) + + IMAGE_DIRECTORY_ENTRY_ARCHITECTURE = 7; // Architecture Specific Data + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_ARCHITECTURE} + IMAGE_DIRECTORY_ENTRY_GLOBALPTR = 8; // RVA of GP + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_GLOBALPTR} + IMAGE_DIRECTORY_ENTRY_TLS = 9; // TLS Directory + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_TLS} + IMAGE_DIRECTORY_ENTRY_LOAD_CONFIG = 10; // Load Configuration Directory + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_LOAD_CONFIG} + IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT = 11; // Bound Import Directory in headers + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT} + IMAGE_DIRECTORY_ENTRY_IAT = 12; // Import Address Table + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_IAT} + IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT = 13; // Delay Load Import Descriptors + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT} + IMAGE_DIRECTORY_ENTRY_COM_DESCRIPTOR = 14; // COM Runtime descriptor + {$EXTERNALSYM IMAGE_DIRECTORY_ENTRY_COM_DESCRIPTOR} + +// +// Non-COFF Object file header +// + +type + PAnonObjectHeader = ^ANON_OBJECT_HEADER; + ANON_OBJECT_HEADER = record + Sig1: Word; // Must be IMAGE_FILE_MACHINE_UNKNOWN + Sig2: Word; // Must be 0xffff + Version: Word; // >= 1 (implies the CLSID field is present) + Machine: Word; + TimeDateStamp: DWORD; + ClassID: TCLSID; // Used to invoke CoCreateInstance + SizeOfData: DWORD; // Size of data that follows the header + end; + {$EXTERNALSYM ANON_OBJECT_HEADER} + TAnonObjectHeader = ANON_OBJECT_HEADER; + +// +// Section header format. +// + +const + IMAGE_SIZEOF_SHORT_NAME = 8; + {$EXTERNALSYM IMAGE_SIZEOF_SHORT_NAME} + +type + PPImageSectionHeader = ^PImageSectionHeader; + +// IMAGE_FIRST_SECTION doesn't need 32/64 versions since the file header is the same either way. + +function IMAGE_FIRST_SECTION(NtHeader: PImageNtHeaders): PImageSectionHeader; +{$EXTERNALSYM IMAGE_FIRST_SECTION} + +const + IMAGE_SIZEOF_SECTION_HEADER = 40; + {$EXTERNALSYM IMAGE_SIZEOF_SECTION_HEADER} + +// +// Section characteristics. +// +// IMAGE_SCN_TYPE_REG 0x00000000 // Reserved. +// IMAGE_SCN_TYPE_DSECT 0x00000001 // Reserved. +// IMAGE_SCN_TYPE_NOLOAD 0x00000002 // Reserved. +// IMAGE_SCN_TYPE_GROUP 0x00000004 // Reserved. + + IMAGE_SCN_TYPE_NO_PAD = $00000008; // Reserved. + {$EXTERNALSYM IMAGE_SCN_TYPE_NO_PAD} + +// IMAGE_SCN_TYPE_COPY 0x00000010 // Reserved. + + IMAGE_SCN_CNT_CODE = $00000020; // Section contains code. + {$EXTERNALSYM IMAGE_SCN_CNT_CODE} + IMAGE_SCN_CNT_INITIALIZED_DATA = $00000040; // Section contains initialized data. + {$EXTERNALSYM IMAGE_SCN_CNT_INITIALIZED_DATA} + IMAGE_SCN_CNT_UNINITIALIZED_DATA = $00000080; // Section contains uninitialized data. + {$EXTERNALSYM IMAGE_SCN_CNT_UNINITIALIZED_DATA} + + IMAGE_SCN_LNK_OTHER = $00000100; // Reserved. + {$EXTERNALSYM IMAGE_SCN_LNK_OTHER} + IMAGE_SCN_LNK_INFO = $00000200; // Section contains comments or some other type of information. + {$EXTERNALSYM IMAGE_SCN_LNK_INFO} + +// IMAGE_SCN_TYPE_OVER 0x00000400 // Reserved. + + IMAGE_SCN_LNK_REMOVE = $00000800; // Section contents will not become part of image. + {$EXTERNALSYM IMAGE_SCN_LNK_REMOVE} + IMAGE_SCN_LNK_COMDAT = $00001000; // Section contents comdat. + {$EXTERNALSYM IMAGE_SCN_LNK_COMDAT} + +// 0x00002000 // Reserved. +// IMAGE_SCN_MEM_PROTECTED - Obsolete 0x00004000 + + IMAGE_SCN_NO_DEFER_SPEC_EXC = $00004000; // Reset speculative exceptions handling bits in the TLB entries for this section. + {$EXTERNALSYM IMAGE_SCN_NO_DEFER_SPEC_EXC} + IMAGE_SCN_GPREL = $00008000; // Section content can be accessed relative to GP + {$EXTERNALSYM IMAGE_SCN_GPREL} + IMAGE_SCN_MEM_FARDATA = $00008000; + {$EXTERNALSYM IMAGE_SCN_MEM_FARDATA} + +// IMAGE_SCN_MEM_SYSHEAP - Obsolete 0x00010000 + + IMAGE_SCN_MEM_PURGEABLE = $00020000; + {$EXTERNALSYM IMAGE_SCN_MEM_PURGEABLE} + IMAGE_SCN_MEM_16BIT = $00020000; + {$EXTERNALSYM IMAGE_SCN_MEM_16BIT} + IMAGE_SCN_MEM_LOCKED = $00040000; + {$EXTERNALSYM IMAGE_SCN_MEM_LOCKED} + IMAGE_SCN_MEM_PRELOAD = $00080000; + {$EXTERNALSYM IMAGE_SCN_MEM_PRELOAD} + + IMAGE_SCN_ALIGN_1BYTES = $00100000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_1BYTES} + IMAGE_SCN_ALIGN_2BYTES = $00200000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_2BYTES} + IMAGE_SCN_ALIGN_4BYTES = $00300000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_4BYTES} + IMAGE_SCN_ALIGN_8BYTES = $00400000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_8BYTES} + IMAGE_SCN_ALIGN_16BYTES = $00500000; // Default alignment if no others are specified. + {$EXTERNALSYM IMAGE_SCN_ALIGN_16BYTES} + IMAGE_SCN_ALIGN_32BYTES = $00600000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_32BYTES} + IMAGE_SCN_ALIGN_64BYTES = $00700000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_64BYTES} + IMAGE_SCN_ALIGN_128BYTES = $00800000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_128BYTES} + IMAGE_SCN_ALIGN_256BYTES = $00900000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_256BYTES} + IMAGE_SCN_ALIGN_512BYTES = $00A00000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_512BYTES} + IMAGE_SCN_ALIGN_1024BYTES = $00B00000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_1024BYTES} + IMAGE_SCN_ALIGN_2048BYTES = $00C00000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_2048BYTES} + IMAGE_SCN_ALIGN_4096BYTES = $00D00000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_4096BYTES} + IMAGE_SCN_ALIGN_8192BYTES = $00E00000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_8192BYTES} + +// Unused 0x00F00000 + + IMAGE_SCN_ALIGN_MASK = $00F00000; + {$EXTERNALSYM IMAGE_SCN_ALIGN_MASK} + + IMAGE_SCN_LNK_NRELOC_OVFL = $01000000; // Section contains extended relocations. + {$EXTERNALSYM IMAGE_SCN_LNK_NRELOC_OVFL} + IMAGE_SCN_MEM_DISCARDABLE = $02000000; // Section can be discarded. + {$EXTERNALSYM IMAGE_SCN_MEM_DISCARDABLE} + IMAGE_SCN_MEM_NOT_CACHED = $04000000; // Section is not cacheable. + {$EXTERNALSYM IMAGE_SCN_MEM_NOT_CACHED} + IMAGE_SCN_MEM_NOT_PAGED = $08000000; // Section is not pageable. + {$EXTERNALSYM IMAGE_SCN_MEM_NOT_PAGED} + IMAGE_SCN_MEM_SHARED = $10000000; // Section is shareable. + {$EXTERNALSYM IMAGE_SCN_MEM_SHARED} + IMAGE_SCN_MEM_EXECUTE = $20000000; // Section is executable. + {$EXTERNALSYM IMAGE_SCN_MEM_EXECUTE} + IMAGE_SCN_MEM_READ = $40000000; // Section is readable. + {$EXTERNALSYM IMAGE_SCN_MEM_READ} + IMAGE_SCN_MEM_WRITE = DWORD($80000000); // Section is writeable. + {$EXTERNALSYM IMAGE_SCN_MEM_WRITE} + +// line 6232 + +// +// Line number format. +// + +type + TImgLineNoType = record + case Integer of + 0: (SymbolTableIndex: DWORD); // Symbol table index of function name if Linenumber is 0. + 1: (VirtualAddress: DWORD); // Virtual address of line number. + end; + + PIMAGE_LINENUMBER = ^IMAGE_LINENUMBER; + {$EXTERNALSYM PIMAGE_LINENUMBER} + _IMAGE_LINENUMBER = record + Type_: TImgLineNoType; + Linenumber: WORD; // Line number. + end; + {$EXTERNALSYM _IMAGE_LINENUMBER} + IMAGE_LINENUMBER = _IMAGE_LINENUMBER; + {$EXTERNALSYM IMAGE_LINENUMBER} + TImageLineNumber = IMAGE_LINENUMBER; + PImageLineNumber = PIMAGE_LINENUMBER; + +const + IMAGE_SIZEOF_LINENUMBER = 6; + {$EXTERNALSYM IMAGE_SIZEOF_LINENUMBER} + +// #include "poppack.h" // Back to 4 byte packing + +// +// Based relocation format. +// + +type + PIMAGE_BASE_RELOCATION = ^IMAGE_BASE_RELOCATION; + {$EXTERNALSYM PIMAGE_BASE_RELOCATION} + _IMAGE_BASE_RELOCATION = record + VirtualAddress: DWORD; + SizeOfBlock: DWORD; + // WORD TypeOffset[1]; + end; + {$EXTERNALSYM _IMAGE_BASE_RELOCATION} + IMAGE_BASE_RELOCATION = _IMAGE_BASE_RELOCATION; + {$EXTERNALSYM IMAGE_BASE_RELOCATION} + TImageBaseRelocation = IMAGE_BASE_RELOCATION; + PImageBaseRelocation = PIMAGE_BASE_RELOCATION; + +const + IMAGE_SIZEOF_BASE_RELOCATION = 8; + {$EXTERNALSYM IMAGE_SIZEOF_BASE_RELOCATION} + +// +// Based relocation types. +// + + IMAGE_REL_BASED_ABSOLUTE = 0; + {$EXTERNALSYM IMAGE_REL_BASED_ABSOLUTE} + IMAGE_REL_BASED_HIGH = 1; + {$EXTERNALSYM IMAGE_REL_BASED_HIGH} + IMAGE_REL_BASED_LOW = 2; + {$EXTERNALSYM IMAGE_REL_BASED_LOW} + IMAGE_REL_BASED_HIGHLOW = 3; + {$EXTERNALSYM IMAGE_REL_BASED_HIGHLOW} + IMAGE_REL_BASED_HIGHADJ = 4; + {$EXTERNALSYM IMAGE_REL_BASED_HIGHADJ} + IMAGE_REL_BASED_MIPS_JMPADDR = 5; + {$EXTERNALSYM IMAGE_REL_BASED_MIPS_JMPADDR} + + IMAGE_REL_BASED_MIPS_JMPADDR16 = 9; + {$EXTERNALSYM IMAGE_REL_BASED_MIPS_JMPADDR16} + IMAGE_REL_BASED_IA64_IMM64 = 9; + {$EXTERNALSYM IMAGE_REL_BASED_IA64_IMM64} + IMAGE_REL_BASED_DIR64 = 10; + {$EXTERNALSYM IMAGE_REL_BASED_DIR64} + +// +// Archive format. +// + + IMAGE_ARCHIVE_START_SIZE = 8; + {$EXTERNALSYM IMAGE_ARCHIVE_START_SIZE} + IMAGE_ARCHIVE_START = '!'#10; + {$EXTERNALSYM IMAGE_ARCHIVE_START} + IMAGE_ARCHIVE_END = '`'#10; + {$EXTERNALSYM IMAGE_ARCHIVE_END} + IMAGE_ARCHIVE_PAD = #10; + {$EXTERNALSYM IMAGE_ARCHIVE_PAD} + IMAGE_ARCHIVE_LINKER_MEMBER = '/ '; + {$EXTERNALSYM IMAGE_ARCHIVE_LINKER_MEMBER} + IMAGE_ARCHIVE_LONGNAMES_MEMBER = '// '; + {$EXTERNALSYM IMAGE_ARCHIVE_LONGNAMES_MEMBER} + +type + PIMAGE_ARCHIVE_MEMBER_HEADER = ^IMAGE_ARCHIVE_MEMBER_HEADER; + {$EXTERNALSYM PIMAGE_ARCHIVE_MEMBER_HEADER} + _IMAGE_ARCHIVE_MEMBER_HEADER = record + Name: array [0..15] of Byte; // File member name - `/' terminated. + Date: array [0..11] of Byte; // File member date - decimal. + UserID: array [0..5] of Byte; // File member user id - decimal. + GroupID: array [0..5] of Byte; // File member group id - decimal. + Mode: array [0..7] of Byte; // File member mode - octal. + Size: array [0..9] of Byte; // File member size - decimal. + EndHeader: array [0..1] of Byte; // String to end header. + end; + {$EXTERNALSYM _IMAGE_ARCHIVE_MEMBER_HEADER} + IMAGE_ARCHIVE_MEMBER_HEADER = _IMAGE_ARCHIVE_MEMBER_HEADER; + {$EXTERNALSYM IMAGE_ARCHIVE_MEMBER_HEADER} + TImageArchiveMemberHeader = IMAGE_ARCHIVE_MEMBER_HEADER; + PImageArchiveMemberHeader = PIMAGE_ARCHIVE_MEMBER_HEADER; + +const + IMAGE_SIZEOF_ARCHIVE_MEMBER_HDR = 60; + {$EXTERNALSYM IMAGE_SIZEOF_ARCHIVE_MEMBER_HDR} + +// line 6346 + +// +// DLL support. +// + +// +// Export Format +// + +type + PIMAGE_EXPORT_DIRECTORY = ^IMAGE_EXPORT_DIRECTORY; + {$EXTERNALSYM PIMAGE_EXPORT_DIRECTORY} + _IMAGE_EXPORT_DIRECTORY = record + Characteristics: DWORD; + TimeDateStamp: DWORD; + MajorVersion: Word; + MinorVersion: Word; + Name: DWORD; + Base: DWORD; + NumberOfFunctions: DWORD; + NumberOfNames: DWORD; + AddressOfFunctions: DWORD; // RVA from base of image + AddressOfNames: DWORD; // RVA from base of image + AddressOfNameOrdinals: DWORD; // RVA from base of image + end; + {$EXTERNALSYM _IMAGE_EXPORT_DIRECTORY} + IMAGE_EXPORT_DIRECTORY = _IMAGE_EXPORT_DIRECTORY; + {$EXTERNALSYM IMAGE_EXPORT_DIRECTORY} + TImageExportDirectory = IMAGE_EXPORT_DIRECTORY; + PImageExportDirectory = PIMAGE_EXPORT_DIRECTORY; + +// +// Import Format +// + + PIMAGE_IMPORT_BY_NAME = ^IMAGE_IMPORT_BY_NAME; + {$EXTERNALSYM PIMAGE_IMPORT_BY_NAME} + _IMAGE_IMPORT_BY_NAME = record + Hint: Word; + Name: array [0..0] of AnsiChar; + end; + {$EXTERNALSYM _IMAGE_IMPORT_BY_NAME} + IMAGE_IMPORT_BY_NAME = _IMAGE_IMPORT_BY_NAME; + {$EXTERNALSYM IMAGE_IMPORT_BY_NAME} + TImageImportByName = IMAGE_IMPORT_BY_NAME; + PImageImportByName = PIMAGE_IMPORT_BY_NAME; + +// #include "pshpack8.h" // Use align 8 for the 64-bit IAT. + + PIMAGE_THUNK_DATA64 = ^IMAGE_THUNK_DATA64; + {$EXTERNALSYM PIMAGE_THUNK_DATA64} + _IMAGE_THUNK_DATA64 = record + case Integer of + 0: (ForwarderString: ULONGLONG); // PBYTE + 1: (Function_: ULONGLONG); // PDWORD + 2: (Ordinal: ULONGLONG); + 3: (AddressOfData: ULONGLONG); // PIMAGE_IMPORT_BY_NAME + end; + {$EXTERNALSYM _IMAGE_THUNK_DATA64} + IMAGE_THUNK_DATA64 = _IMAGE_THUNK_DATA64; + {$EXTERNALSYM IMAGE_THUNK_DATA64} + TImageThunkData64 = IMAGE_THUNK_DATA64; + PImageThunkData64 = PIMAGE_THUNK_DATA64; + +// #include "poppack.h" // Back to 4 byte packing + + PIMAGE_THUNK_DATA32 = ^IMAGE_THUNK_DATA32; + {$EXTERNALSYM PIMAGE_THUNK_DATA32} + _IMAGE_THUNK_DATA32 = record + case Integer of + 0: (ForwarderString: DWORD); // PBYTE + 1: (Function_: DWORD); // PDWORD + 2: (Ordinal: DWORD); + 3: (AddressOfData: DWORD); // PIMAGE_IMPORT_BY_NAME + end; + {$EXTERNALSYM _IMAGE_THUNK_DATA32} + IMAGE_THUNK_DATA32 = _IMAGE_THUNK_DATA32; + {$EXTERNALSYM IMAGE_THUNK_DATA32} + TImageThunkData32 = IMAGE_THUNK_DATA32; + PImageThunkData32 = PIMAGE_THUNK_DATA32; + +const + IMAGE_ORDINAL_FLAG64 = ULONGLONG($8000000000000000); + {$EXTERNALSYM IMAGE_ORDINAL_FLAG64} + IMAGE_ORDINAL_FLAG32 = DWORD($80000000); + {$EXTERNALSYM IMAGE_ORDINAL_FLAG32} + +function IMAGE_ORDINAL64(Ordinal: ULONGLONG): ULONGLONG; +{$EXTERNALSYM IMAGE_ORDINAL64} +function IMAGE_ORDINAL32(Ordinal: DWORD): DWORD; +{$EXTERNALSYM IMAGE_ORDINAL32} +function IMAGE_SNAP_BY_ORDINAL64(Ordinal: ULONGLONG): Boolean; +{$EXTERNALSYM IMAGE_SNAP_BY_ORDINAL64} +function IMAGE_SNAP_BY_ORDINAL32(Ordinal: DWORD): Boolean; +{$EXTERNALSYM IMAGE_SNAP_BY_ORDINAL32} + +// +// Thread Local Storage +// + +type + PIMAGE_TLS_CALLBACK = procedure (DllHandle: Pointer; Reason: DWORD; Reserved: Pointer); stdcall; + {$EXTERNALSYM PIMAGE_TLS_CALLBACK} + TImageTlsCallback = PIMAGE_TLS_CALLBACK; + + PIMAGE_TLS_DIRECTORY64 = ^IMAGE_TLS_DIRECTORY64; + {$EXTERNALSYM PIMAGE_TLS_DIRECTORY64} + _IMAGE_TLS_DIRECTORY64 = record + StartAddressOfRawData: ULONGLONG; + EndAddressOfRawData: ULONGLONG; + AddressOfIndex: ULONGLONG; // PDWORD + AddressOfCallBacks: ULONGLONG; // PIMAGE_TLS_CALLBACK *; + SizeOfZeroFill: DWORD; + Characteristics: DWORD; + end; + {$EXTERNALSYM _IMAGE_TLS_DIRECTORY64} + IMAGE_TLS_DIRECTORY64 = _IMAGE_TLS_DIRECTORY64; + {$EXTERNALSYM IMAGE_TLS_DIRECTORY64} + TImageTlsDirectory64 = IMAGE_TLS_DIRECTORY64; + {$EXTERNALSYM TImageTlsDirectory64} + PImageTlsDirectory64 = PIMAGE_TLS_DIRECTORY64; + {$EXTERNALSYM PImageTlsDirectory64} + + PIMAGE_TLS_DIRECTORY32 = ^IMAGE_TLS_DIRECTORY32; + {$EXTERNALSYM PIMAGE_TLS_DIRECTORY32} + _IMAGE_TLS_DIRECTORY32 = record + StartAddressOfRawData: DWORD; + EndAddressOfRawData: DWORD; + AddressOfIndex: DWORD; // PDWORD + AddressOfCallBacks: DWORD; // PIMAGE_TLS_CALLBACK * + SizeOfZeroFill: DWORD; + Characteristics: DWORD; + end; + {$EXTERNALSYM _IMAGE_TLS_DIRECTORY32} + IMAGE_TLS_DIRECTORY32 = _IMAGE_TLS_DIRECTORY32; + {$EXTERNALSYM IMAGE_TLS_DIRECTORY32} + TImageTlsDirectory32 = IMAGE_TLS_DIRECTORY32; + {$EXTERNALSYM TImageTlsDirectory32} + PImageTlsDirectory32 = PIMAGE_TLS_DIRECTORY32; + {$EXTERNALSYM PImageTlsDirectory32} + +const + IMAGE_ORDINAL_FLAG = IMAGE_ORDINAL_FLAG32; + {$EXTERNALSYM IMAGE_ORDINAL_FLAG} + +function IMAGE_ORDINAL(Ordinal: DWORD): DWORD; +{$EXTERNALSYM IMAGE_ORDINAL} + +type + IMAGE_THUNK_DATA = IMAGE_THUNK_DATA32; + {$EXTERNALSYM IMAGE_THUNK_DATA} + PIMAGE_THUNK_DATA = PIMAGE_THUNK_DATA32; + {$EXTERNALSYM PIMAGE_THUNK_DATA} + TImageThunkData = TImageThunkData32; + PImageThunkData = PImageThunkData32; + +function IMAGE_SNAP_BY_ORDINAL(Ordinal: DWORD): Boolean; +{$EXTERNALSYM IMAGE_SNAP_BY_ORDINAL} + +type + IMAGE_TLS_DIRECTORY = IMAGE_TLS_DIRECTORY32; + {$EXTERNALSYM IMAGE_TLS_DIRECTORY} + PIMAGE_TLS_DIRECTORY = PIMAGE_TLS_DIRECTORY32; + {$EXTERNALSYM PIMAGE_TLS_DIRECTORY} + TImageTlsDirectory = TImageTlsDirectory32; + {$EXTERNALSYM TImageTlsDirectory} + PImageTlsDirectory = PImageTlsDirectory32; + {$EXTERNALSYM PImageTlsDirectory} + + TIIDUnion = record + case Integer of + 0: (Characteristics: DWORD); // 0 for terminating null import descriptor + 1: (OriginalFirstThunk: DWORD); // RVA to original unbound IAT (PIMAGE_THUNK_DATA) + end; + + PIMAGE_IMPORT_DESCRIPTOR = ^IMAGE_IMPORT_DESCRIPTOR; + {$EXTERNALSYM PIMAGE_IMPORT_DESCRIPTOR} + _IMAGE_IMPORT_DESCRIPTOR = record + Union: TIIDUnion; + TimeDateStamp: DWORD; // 0 if not bound, + // -1 if bound, and real date\time stamp + // in IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT (new BIND) + // O.W. date/time stamp of DLL bound to (Old BIND) + + ForwarderChain: DWORD; // -1 if no forwarders + Name: DWORD; + FirstThunk: DWORD; // RVA to IAT (if bound this IAT has actual addresses) + end; + {$EXTERNALSYM _IMAGE_IMPORT_DESCRIPTOR} + IMAGE_IMPORT_DESCRIPTOR = _IMAGE_IMPORT_DESCRIPTOR; + {$EXTERNALSYM IMAGE_IMPORT_DESCRIPTOR} + TImageImportDescriptor = IMAGE_IMPORT_DESCRIPTOR; + PImageImportDescriptor = PIMAGE_IMPORT_DESCRIPTOR; + +// +// New format import descriptors pointed to by DataDirectory[ IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT ] +// + +type + PIMAGE_BOUND_IMPORT_DESCRIPTOR = ^IMAGE_BOUND_IMPORT_DESCRIPTOR; + {$EXTERNALSYM PIMAGE_BOUND_IMPORT_DESCRIPTOR} + _IMAGE_BOUND_IMPORT_DESCRIPTOR = record + TimeDateStamp: DWORD; + OffsetModuleName: Word; + NumberOfModuleForwarderRefs: Word; + // Array of zero or more IMAGE_BOUND_FORWARDER_REF follows + end; + {$EXTERNALSYM _IMAGE_BOUND_IMPORT_DESCRIPTOR} + IMAGE_BOUND_IMPORT_DESCRIPTOR = _IMAGE_BOUND_IMPORT_DESCRIPTOR; + {$EXTERNALSYM IMAGE_BOUND_IMPORT_DESCRIPTOR} + TImageBoundImportDescriptor = IMAGE_BOUND_IMPORT_DESCRIPTOR; + PImageBoundImportDescriptor = PIMAGE_BOUND_IMPORT_DESCRIPTOR; + + PIMAGE_BOUND_FORWARDER_REF = ^IMAGE_BOUND_FORWARDER_REF; + {$EXTERNALSYM PIMAGE_BOUND_FORWARDER_REF} + _IMAGE_BOUND_FORWARDER_REF = record + TimeDateStamp: DWORD; + OffsetModuleName: Word; + Reserved: Word; + end; + {$EXTERNALSYM _IMAGE_BOUND_FORWARDER_REF} + IMAGE_BOUND_FORWARDER_REF = _IMAGE_BOUND_FORWARDER_REF; + {$EXTERNALSYM IMAGE_BOUND_FORWARDER_REF} + TImageBoundForwarderRef = IMAGE_BOUND_FORWARDER_REF; + PImageBoundForwarderRef = PIMAGE_BOUND_FORWARDER_REF; + +// +// Resource Format. +// + +// +// Resource directory consists of two counts, following by a variable length +// array of directory entries. The first count is the number of entries at +// beginning of the array that have actual names associated with each entry. +// The entries are in ascending order, case insensitive strings. The second +// count is the number of entries that immediately follow the named entries. +// This second count identifies the number of entries that have 16-bit integer +// Ids as their name. These entries are also sorted in ascending order. +// +// This structure allows fast lookup by either name or number, but for any +// given resource entry only one form of lookup is supported, not both. +// This is consistant with the syntax of the .RC file and the .RES file. +// + + PIMAGE_RESOURCE_DIRECTORY = ^IMAGE_RESOURCE_DIRECTORY; + {$EXTERNALSYM PIMAGE_RESOURCE_DIRECTORY} + _IMAGE_RESOURCE_DIRECTORY = record + Characteristics: DWORD; + TimeDateStamp: DWORD; + MajorVersion: Word; + MinorVersion: Word; + NumberOfNamedEntries: Word; + NumberOfIdEntries: Word; + // IMAGE_RESOURCE_DIRECTORY_ENTRY DirectoryEntries[]; + end; + {$EXTERNALSYM _IMAGE_RESOURCE_DIRECTORY} + IMAGE_RESOURCE_DIRECTORY = _IMAGE_RESOURCE_DIRECTORY; + {$EXTERNALSYM IMAGE_RESOURCE_DIRECTORY} + TImageResourceDirectory = IMAGE_RESOURCE_DIRECTORY; + PImageResourceDirectory = PIMAGE_RESOURCE_DIRECTORY; + +const + IMAGE_RESOURCE_NAME_IS_STRING = DWORD($80000000); + {$EXTERNALSYM IMAGE_RESOURCE_NAME_IS_STRING} + IMAGE_RESOURCE_DATA_IS_DIRECTORY = DWORD($80000000); + {$EXTERNALSYM IMAGE_RESOURCE_DATA_IS_DIRECTORY} + +// +// Each directory contains the 32-bit Name of the entry and an offset, +// relative to the beginning of the resource directory of the data associated +// with this directory entry. If the name of the entry is an actual text +// string instead of an integer Id, then the high order bit of the name field +// is set to one and the low order 31-bits are an offset, relative to the +// beginning of the resource directory of the string, which is of type +// IMAGE_RESOURCE_DIRECTORY_STRING. Otherwise the high bit is clear and the +// low-order 16-bits are the integer Id that identify this resource directory +// entry. If the directory entry is yet another resource directory (i.e. a +// subdirectory), then the high order bit of the offset field will be +// set to indicate this. Otherwise the high bit is clear and the offset +// field points to a resource data entry. +// + +type + PIMAGE_RESOURCE_DIRECTORY_ENTRY = ^IMAGE_RESOURCE_DIRECTORY_ENTRY; + {$EXTERNALSYM PIMAGE_RESOURCE_DIRECTORY_ENTRY} + _IMAGE_RESOURCE_DIRECTORY_ENTRY = record + case Integer of + 0: ( + // DWORD NameOffset:31; + // DWORD NameIsString:1; + NameOffset: DWORD; + OffsetToData: DWORD + ); + 1: ( + Name: DWORD; + // DWORD OffsetToDirectory:31; + // DWORD DataIsDirectory:1; + OffsetToDirectory: DWORD; + ); + 2: ( + Id: WORD; + ); + end; + {$EXTERNALSYM _IMAGE_RESOURCE_DIRECTORY_ENTRY} + IMAGE_RESOURCE_DIRECTORY_ENTRY = _IMAGE_RESOURCE_DIRECTORY_ENTRY; + {$EXTERNALSYM IMAGE_RESOURCE_DIRECTORY_ENTRY} + TImageResourceDirectoryEntry = IMAGE_RESOURCE_DIRECTORY_ENTRY; + PImageResourceDirectoryEntry = PIMAGE_RESOURCE_DIRECTORY_ENTRY; + +// +// For resource directory entries that have actual string names, the Name +// field of the directory entry points to an object of the following type. +// All of these string objects are stored together after the last resource +// directory entry and before the first resource data object. This minimizes +// the impact of these variable length objects on the alignment of the fixed +// size directory entry objects. +// + +type + PIMAGE_RESOURCE_DIRECTORY_STRING = ^IMAGE_RESOURCE_DIRECTORY_STRING; + {$EXTERNALSYM PIMAGE_RESOURCE_DIRECTORY_STRING} + _IMAGE_RESOURCE_DIRECTORY_STRING = record + Length: Word; + NameString: array [0..0] of AnsiCHAR; + end; + {$EXTERNALSYM _IMAGE_RESOURCE_DIRECTORY_STRING} + IMAGE_RESOURCE_DIRECTORY_STRING = _IMAGE_RESOURCE_DIRECTORY_STRING; + {$EXTERNALSYM IMAGE_RESOURCE_DIRECTORY_STRING} + TImageResourceDirectoryString = IMAGE_RESOURCE_DIRECTORY_STRING; + PImageResourceDirectoryString = PIMAGE_RESOURCE_DIRECTORY_STRING; + + PIMAGE_RESOURCE_DIR_STRING_U = ^IMAGE_RESOURCE_DIR_STRING_U; + {$EXTERNALSYM PIMAGE_RESOURCE_DIR_STRING_U} + _IMAGE_RESOURCE_DIR_STRING_U = record + Length: Word; + NameString: array [0..0] of WCHAR; + end; + {$EXTERNALSYM _IMAGE_RESOURCE_DIR_STRING_U} + IMAGE_RESOURCE_DIR_STRING_U = _IMAGE_RESOURCE_DIR_STRING_U; + {$EXTERNALSYM IMAGE_RESOURCE_DIR_STRING_U} + TImageResourceDirStringU = IMAGE_RESOURCE_DIR_STRING_U; + PImageResourceDirStringU = PIMAGE_RESOURCE_DIR_STRING_U; + +// +// Each resource data entry describes a leaf node in the resource directory +// tree. It contains an offset, relative to the beginning of the resource +// directory of the data for the resource, a size field that gives the number +// of bytes of data at that offset, a CodePage that should be used when +// decoding code point values within the resource data. Typically for new +// applications the code page would be the unicode code page. +// + + PIMAGE_RESOURCE_DATA_ENTRY = ^IMAGE_RESOURCE_DATA_ENTRY; + {$EXTERNALSYM PIMAGE_RESOURCE_DATA_ENTRY} + _IMAGE_RESOURCE_DATA_ENTRY = record + OffsetToData: DWORD; + Size: DWORD; + CodePage: DWORD; + Reserved: DWORD; + end; + {$EXTERNALSYM _IMAGE_RESOURCE_DATA_ENTRY} + IMAGE_RESOURCE_DATA_ENTRY = _IMAGE_RESOURCE_DATA_ENTRY; + {$EXTERNALSYM IMAGE_RESOURCE_DATA_ENTRY} + TImageResourceDataEntry = IMAGE_RESOURCE_DATA_ENTRY; + PImageResourceDataEntry = PIMAGE_RESOURCE_DATA_ENTRY; + +// +// Load Configuration Directory Entry +// + +{$IFNDEF FPC} +type + PIMAGE_LOAD_CONFIG_DIRECTORY32 = ^IMAGE_LOAD_CONFIG_DIRECTORY32; + {$EXTERNALSYM PIMAGE_LOAD_CONFIG_DIRECTORY32} + IMAGE_LOAD_CONFIG_DIRECTORY32 = record + Size: DWORD; + TimeDateStamp: DWORD; + MajorVersion: WORD; + MinorVersion: WORD; + GlobalFlagsClear: DWORD; + GlobalFlagsSet: DWORD; + CriticalSectionDefaultTimeout: DWORD; + DeCommitFreeBlockThreshold: DWORD; + DeCommitTotalFreeThreshold: DWORD; + LockPrefixTable: DWORD; // VA + MaximumAllocationSize: DWORD; + VirtualMemoryThreshold: DWORD; + ProcessHeapFlags: DWORD; + ProcessAffinityMask: DWORD; + CSDVersion: WORD; + Reserved1: WORD; + EditList: DWORD; // VA + SecurityCookie: DWORD; // VA + SEHandlerTable: DWORD; // VA + SEHandlerCount: DWORD; + end; + {$EXTERNALSYM IMAGE_LOAD_CONFIG_DIRECTORY32} + TImageLoadConfigDirectory32 = IMAGE_LOAD_CONFIG_DIRECTORY32; + PImageLoadConfigDirectory32 = PIMAGE_LOAD_CONFIG_DIRECTORY32; + + PIMAGE_LOAD_CONFIG_DIRECTORY64 = ^IMAGE_LOAD_CONFIG_DIRECTORY64; + {$EXTERNALSYM PIMAGE_LOAD_CONFIG_DIRECTORY64} + IMAGE_LOAD_CONFIG_DIRECTORY64 = record + Size: DWORD; + TimeDateStamp: DWORD; + MajorVersion: WORD; + MinorVersion: WORD; + GlobalFlagsClear: DWORD; + GlobalFlagsSet: DWORD; + CriticalSectionDefaultTimeout: DWORD; + DeCommitFreeBlockThreshold: ULONGLONG; + DeCommitTotalFreeThreshold: ULONGLONG; + LockPrefixTable: ULONGLONG; // VA + MaximumAllocationSize: ULONGLONG; + VirtualMemoryThreshold: ULONGLONG; + ProcessAffinityMask: ULONGLONG; + ProcessHeapFlags: DWORD; + CSDVersion: WORD; + Reserved1: WORD; + EditList: ULONGLONG; // VA + SecurityCookie: ULONGLONG; // VA + SEHandlerTable: ULONGLONG; // VA + SEHandlerCount: ULONGLONG; + end; + {$EXTERNALSYM IMAGE_LOAD_CONFIG_DIRECTORY64} + TImageLoadConfigDirectory64 = IMAGE_LOAD_CONFIG_DIRECTORY64; + PImageLoadConfigDirectory64 = PIMAGE_LOAD_CONFIG_DIRECTORY64; + + IMAGE_LOAD_CONFIG_DIRECTORY = IMAGE_LOAD_CONFIG_DIRECTORY32; + {$EXTERNALSYM IMAGE_LOAD_CONFIG_DIRECTORY} + PIMAGE_LOAD_CONFIG_DIRECTORY = PIMAGE_LOAD_CONFIG_DIRECTORY32; + {$EXTERNALSYM PIMAGE_LOAD_CONFIG_DIRECTORY} + TImageLoadConfigDirectory = TImageLoadConfigDirectory32; + PImageLoadConfigDirectory = PImageLoadConfigDirectory32; +{$ENDIF ~FPC} + +// line 6802 + +// +// Debug Format +// +(* +type + PIMAGE_DEBUG_DIRECTORY = ^IMAGE_DEBUG_DIRECTORY; + {$EXTERNALSYM PIMAGE_DEBUG_DIRECTORY} + _IMAGE_DEBUG_DIRECTORY = record + Characteristics: DWORD; + TimeDateStamp: DWORD; + MajorVersion: Word; + MinorVersion: Word; + Type_: DWORD; + SizeOfData: DWORD; + AddressOfRawData: DWORD; + PointerToRawData: DWORD; + end; + {$EXTERNALSYM _IMAGE_DEBUG_DIRECTORY} + IMAGE_DEBUG_DIRECTORY = _IMAGE_DEBUG_DIRECTORY; + {$EXTERNALSYM IMAGE_DEBUG_DIRECTORY} + TImageDebugDirectory = IMAGE_DEBUG_DIRECTORY; + PImageDebugDirectory = PIMAGE_DEBUG_DIRECTORY; + +const + IMAGE_DEBUG_TYPE_UNKNOWN = 0; + {$EXTERNALSYM IMAGE_DEBUG_TYPE_UNKNOWN} + IMAGE_DEBUG_TYPE_COFF = 1; + {$EXTERNALSYM IMAGE_DEBUG_TYPE_COFF} + IMAGE_DEBUG_TYPE_CODEVIEW = 2; + {$EXTERNALSYM IMAGE_DEBUG_TYPE_CODEVIEW} + IMAGE_DEBUG_TYPE_FPO = 3; + {$EXTERNALSYM IMAGE_DEBUG_TYPE_FPO} + IMAGE_DEBUG_TYPE_MISC = 4; + {$EXTERNALSYM IMAGE_DEBUG_TYPE_MISC} + IMAGE_DEBUG_TYPE_EXCEPTION = 5; + {$EXTERNALSYM IMAGE_DEBUG_TYPE_EXCEPTION} + IMAGE_DEBUG_TYPE_FIXUP = 6; + {$EXTERNALSYM IMAGE_DEBUG_TYPE_FIXUP} + IMAGE_DEBUG_TYPE_OMAP_TO_SRC = 7; + {$EXTERNALSYM IMAGE_DEBUG_TYPE_OMAP_TO_SRC} + IMAGE_DEBUG_TYPE_OMAP_FROM_SRC = 8; + {$EXTERNALSYM IMAGE_DEBUG_TYPE_OMAP_FROM_SRC} + IMAGE_DEBUG_TYPE_BORLAND = 9; + {$EXTERNALSYM IMAGE_DEBUG_TYPE_BORLAND} + IMAGE_DEBUG_TYPE_RESERVED10 = 10; + {$EXTERNALSYM IMAGE_DEBUG_TYPE_RESERVED10} + IMAGE_DEBUG_TYPE_CLSID = 11; + {$EXTERNALSYM IMAGE_DEBUG_TYPE_CLSID} +*) + +{$IFNDEF FPC} +type + PIMAGE_COFF_SYMBOLS_HEADER = ^IMAGE_COFF_SYMBOLS_HEADER; + {$EXTERNALSYM PIMAGE_COFF_SYMBOLS_HEADER} + _IMAGE_COFF_SYMBOLS_HEADER = record + NumberOfSymbols: DWORD; + LvaToFirstSymbol: DWORD; + NumberOfLinenumbers: DWORD; + LvaToFirstLinenumber: DWORD; + RvaToFirstByteOfCode: DWORD; + RvaToLastByteOfCode: DWORD; + RvaToFirstByteOfData: DWORD; + RvaToLastByteOfData: DWORD; + end; + {$EXTERNALSYM _IMAGE_COFF_SYMBOLS_HEADER} + IMAGE_COFF_SYMBOLS_HEADER = _IMAGE_COFF_SYMBOLS_HEADER; + {$EXTERNALSYM IMAGE_COFF_SYMBOLS_HEADER} + TImageCoffSymbolsHeader = IMAGE_COFF_SYMBOLS_HEADER; + PImageCoffSymbolsHeader = PIMAGE_COFF_SYMBOLS_HEADER; +{$ENDIF ~FPC} + +const + FRAME_FPO = 0; + {$EXTERNALSYM FRAME_FPO} + FRAME_TRAP = 1; + {$EXTERNALSYM FRAME_TRAP} + FRAME_TSS = 2; + {$EXTERNALSYM FRAME_TSS} + FRAME_NONFPO = 3; + {$EXTERNALSYM FRAME_NONFPO} + + FPOFLAGS_PROLOG = $00FF; // # bytes in prolog + FPOFLAGS_REGS = $0700; // # regs saved + FPOFLAGS_HAS_SEH = $0800; // TRUE if SEH in func + FPOFLAGS_USE_BP = $1000; // TRUE if EBP has been allocated + FPOFLAGS_RESERVED = $2000; // reserved for future use + FPOFLAGS_FRAME = $C000; // frame type + +{$IFNDEF FPC} +type + PFPO_DATA = ^FPO_DATA; + {$EXTERNALSYM PFPO_DATA} + _FPO_DATA = record + ulOffStart: DWORD; // offset 1st byte of function code + cbProcSize: DWORD; // # bytes in function + cdwLocals: DWORD; // # bytes in locals/4 + cdwParams: WORD; // # bytes in params/4 + Flags: WORD; + end; + {$EXTERNALSYM _FPO_DATA} + FPO_DATA = _FPO_DATA; + {$EXTERNALSYM FPO_DATA} + TFpoData = FPO_DATA; + PFpoData = PFPO_DATA; +{$ENDIF ~FPC} + +const + SIZEOF_RFPO_DATA = 16; + {$EXTERNALSYM SIZEOF_RFPO_DATA} + + IMAGE_DEBUG_MISC_EXENAME = 1; + {$EXTERNALSYM IMAGE_DEBUG_MISC_EXENAME} + +type + PIMAGE_DEBUG_MISC = ^IMAGE_DEBUG_MISC; + {$EXTERNALSYM PIMAGE_DEBUG_MISC} + _IMAGE_DEBUG_MISC = record + DataType: DWORD; // type of misc data, see defines + Length: DWORD; // total length of record, rounded to four byte multiple. + Unicode: ByteBool; // TRUE if data is unicode string + Reserved: array [0..2] of Byte; + Data: array [0..0] of Byte; // Actual data + end; + {$EXTERNALSYM _IMAGE_DEBUG_MISC} + IMAGE_DEBUG_MISC = _IMAGE_DEBUG_MISC; + {$EXTERNALSYM IMAGE_DEBUG_MISC} + TImageDebugMisc = IMAGE_DEBUG_MISC; + PImageDebugMisc = PIMAGE_DEBUG_MISC; + +// +// Function table extracted from MIPS/ALPHA/IA64 images. Does not contain +// information needed only for runtime support. Just those fields for +// each entry needed by a debugger. +// + +{$IFNDEF FPC} + PIMAGE_FUNCTION_ENTRY = ^IMAGE_FUNCTION_ENTRY; + {$EXTERNALSYM PIMAGE_FUNCTION_ENTRY} + _IMAGE_FUNCTION_ENTRY = record + StartingAddress: DWORD; + EndingAddress: DWORD; + EndOfPrologue: DWORD; + end; + {$EXTERNALSYM _IMAGE_FUNCTION_ENTRY} + IMAGE_FUNCTION_ENTRY = _IMAGE_FUNCTION_ENTRY; + {$EXTERNALSYM IMAGE_FUNCTION_ENTRY} + TImageFunctionEntry = IMAGE_FUNCTION_ENTRY; + PImageFunctionEntry = PIMAGE_FUNCTION_ENTRY; + + PIMAGE_FUNCTION_ENTRY64 = ^IMAGE_FUNCTION_ENTRY64; + {$EXTERNALSYM PIMAGE_FUNCTION_ENTRY64} + _IMAGE_FUNCTION_ENTRY64 = record + StartingAddress: ULONGLONG; + EndingAddress: ULONGLONG; + case Integer of + 0: (EndOfPrologue: ULONGLONG); + 1: (UnwindInfoAddress: ULONGLONG); + end; + {$EXTERNALSYM _IMAGE_FUNCTION_ENTRY64} + IMAGE_FUNCTION_ENTRY64 = _IMAGE_FUNCTION_ENTRY64; + {$EXTERNALSYM IMAGE_FUNCTION_ENTRY64} + TImageFunctionEntry64 = IMAGE_FUNCTION_ENTRY64; + PImageFunctionEntry64 = PIMAGE_FUNCTION_ENTRY64; + +{$ENDIF ~FPC} + +// +// Debugging information can be stripped from an image file and placed +// in a separate .DBG file, whose file name part is the same as the +// image file name part (e.g. symbols for CMD.EXE could be stripped +// and placed in CMD.DBG). This is indicated by the IMAGE_FILE_DEBUG_STRIPPED +// flag in the Characteristics field of the file header. The beginning of +// the .DBG file contains the following structure which captures certain +// information from the image file. This allows a debug to proceed even if +// the original image file is not accessable. This header is followed by +// zero of more IMAGE_SECTION_HEADER structures, followed by zero or more +// IMAGE_DEBUG_DIRECTORY structures. The latter structures and those in +// the image file contain file offsets relative to the beginning of the +// .DBG file. +// +// If symbols have been stripped from an image, the IMAGE_DEBUG_MISC structure +// is left in the image file, but not mapped. This allows a debugger to +// compute the name of the .DBG file, from the name of the image in the +// IMAGE_DEBUG_MISC structure. +// + + PIMAGE_SEPARATE_DEBUG_HEADER = ^IMAGE_SEPARATE_DEBUG_HEADER; + {$EXTERNALSYM PIMAGE_SEPARATE_DEBUG_HEADER} + _IMAGE_SEPARATE_DEBUG_HEADER = record + Signature: Word; + Flags: Word; + Machine: Word; + Characteristics: Word; + TimeDateStamp: DWORD; + CheckSum: DWORD; + ImageBase: DWORD; + SizeOfImage: DWORD; + NumberOfSections: DWORD; + ExportedNamesSize: DWORD; + DebugDirectorySize: DWORD; + SectionAlignment: DWORD; + Reserved: array [0..1] of DWORD; + end; + {$EXTERNALSYM _IMAGE_SEPARATE_DEBUG_HEADER} + IMAGE_SEPARATE_DEBUG_HEADER = _IMAGE_SEPARATE_DEBUG_HEADER; + {$EXTERNALSYM IMAGE_SEPARATE_DEBUG_HEADER} + TImageSeparateDebugHeader = IMAGE_SEPARATE_DEBUG_HEADER; + PImageSeparateDebugHeader = PIMAGE_SEPARATE_DEBUG_HEADER; + + _NON_PAGED_DEBUG_INFO = record + Signature: WORD; + Flags: WORD; + Size: DWORD; + Machine: WORD; + Characteristics: WORD; + TimeDateStamp: DWORD; + CheckSum: DWORD; + SizeOfImage: DWORD; + ImageBase: ULONGLONG; + //DebugDirectorySize + //IMAGE_DEBUG_DIRECTORY + end; + {$EXTERNALSYM _NON_PAGED_DEBUG_INFO} + NON_PAGED_DEBUG_INFO = _NON_PAGED_DEBUG_INFO; + {$EXTERNALSYM NON_PAGED_DEBUG_INFO} + PNON_PAGED_DEBUG_INFO = ^NON_PAGED_DEBUG_INFO; + {$EXTERNALSYM PNON_PAGED_DEBUG_INFO} + +const + IMAGE_SEPARATE_DEBUG_SIGNATURE = $4944; + {$EXTERNALSYM IMAGE_SEPARATE_DEBUG_SIGNATURE} + NON_PAGED_DEBUG_SIGNATURE = $494E; + {$EXTERNALSYM NON_PAGED_DEBUG_SIGNATURE} + + IMAGE_SEPARATE_DEBUG_FLAGS_MASK = $8000; + {$EXTERNALSYM IMAGE_SEPARATE_DEBUG_FLAGS_MASK} + IMAGE_SEPARATE_DEBUG_MISMATCH = $8000; // when DBG was updated, the old checksum didn't match. + {$EXTERNALSYM IMAGE_SEPARATE_DEBUG_MISMATCH} + +// +// The .arch section is made up of headers, each describing an amask position/value +// pointing to an array of IMAGE_ARCHITECTURE_ENTRY's. Each "array" (both the header +// and entry arrays) are terminiated by a quadword of 0xffffffffL. +// +// NOTE: There may be quadwords of 0 sprinkled around and must be skipped. +// + +const + IAHMASK_VALUE = $00000001; // 1 -> code section depends on mask bit + // 0 -> new instruction depends on mask bit + IAHMASK_MBZ7 = $000000FE; // MBZ + IAHMASK_SHIFT = $0000FF00; // Amask bit in question for this fixup + IAHMASK_MBZ16 = DWORD($FFFF0000); // MBZ + +type + PIMAGE_ARCHITECTURE_HEADER = ^IMAGE_ARCHITECTURE_HEADER; + {$EXTERNALSYM PIMAGE_ARCHITECTURE_HEADER} + _ImageArchitectureHeader = record + Mask: DWORD; + FirstEntryRVA: DWORD; // RVA into .arch section to array of ARCHITECTURE_ENTRY's + end; + {$EXTERNALSYM _ImageArchitectureHeader} + IMAGE_ARCHITECTURE_HEADER = _ImageArchitectureHeader; + {$EXTERNALSYM IMAGE_ARCHITECTURE_HEADER} + TImageArchitectureHeader = IMAGE_ARCHITECTURE_HEADER; + PImageArchitectureHeader = PIMAGE_ARCHITECTURE_HEADER; + + PIMAGE_ARCHITECTURE_ENTRY = ^IMAGE_ARCHITECTURE_ENTRY; + {$EXTERNALSYM PIMAGE_ARCHITECTURE_ENTRY} + _ImageArchitectureEntry = record + FixupInstRVA: DWORD; // RVA of instruction to fixup + NewInst: DWORD; // fixup instruction (see alphaops.h) + end; + {$EXTERNALSYM _ImageArchitectureEntry} + IMAGE_ARCHITECTURE_ENTRY = _ImageArchitectureEntry; + {$EXTERNALSYM IMAGE_ARCHITECTURE_ENTRY} + TImageArchitectureEntry = IMAGE_ARCHITECTURE_ENTRY; + PImageArchitectureEntry = PIMAGE_ARCHITECTURE_ENTRY; + +// #include "poppack.h" // Back to the initial value + +// The following structure defines the new import object. Note the values of the first two fields, +// which must be set as stated in order to differentiate old and new import members. +// Following this structure, the linker emits two null-terminated strings used to recreate the +// import at the time of use. The first string is the import's name, the second is the dll's name. + +const + IMPORT_OBJECT_HDR_SIG2 = $ffff; + {$EXTERNALSYM IMPORT_OBJECT_HDR_SIG2} + +const + IOHFLAGS_TYPE = $0003; // IMPORT_TYPE + IAHFLAGS_NAMETYPE = $001C; // IMPORT_NAME_TYPE + IAHFLAGS_RESERVED = $FFE0; // Reserved. Must be zero. + +type + PImportObjectHeader = ^IMPORT_OBJECT_HEADER; + IMPORT_OBJECT_HEADER = record + Sig1: WORD; // Must be IMAGE_FILE_MACHINE_UNKNOWN + Sig2: WORD; // Must be IMPORT_OBJECT_HDR_SIG2. + Version: WORD; + Machine: WORD; + TimeDateStamp: DWORD; // Time/date stamp + SizeOfData: DWORD; // particularly useful for incremental links + OrdinalOrHint: record + case Integer of + 0: (Ordinal: WORD); // if grf & IMPORT_OBJECT_ORDINAL + 1: (Flags: DWORD); + end; + Flags: WORD; + //WORD Type : 2; // IMPORT_TYPE + //WORD NameType : 3; // IMPORT_NAME_TYPE + //WORD Reserved : 11; // Reserved. Must be zero. + end; + {$EXTERNALSYM IMPORT_OBJECT_HEADER} + TImportObjectHeader = IMPORT_OBJECT_HEADER; + + IMPORT_OBJECT_TYPE = (IMPORT_OBJECT_CODE, IMPORT_OBJECT_DATA, IMPORT_OBJECT_CONST); + {$EXTERNALSYM IMPORT_OBJECT_TYPE} + TImportObjectType = IMPORT_OBJECT_TYPE; + + IMPORT_OBJECT_NAME_TYPE = ( + IMPORT_OBJECT_ORDINAL, // Import by ordinal + IMPORT_OBJECT_NAME, // Import name == public symbol name. + IMPORT_OBJECT_NAME_NO_PREFIX, // Import name == public symbol name skipping leading ?, @, or optionally _. + IMPORT_OBJECT_NAME_UNDECORATE); // Import name == public symbol name skipping leading ?, @, or optionally _ + // and truncating at first @ + {$EXTERNALSYM IMPORT_OBJECT_NAME_TYPE} + TImportObjectNameType = IMPORT_OBJECT_NAME_TYPE; + + ReplacesCorHdrNumericDefines = DWORD; + {$EXTERNALSYM ReplacesCorHdrNumericDefines} + +const + +// COM+ Header entry point flags. + + COMIMAGE_FLAGS_ILONLY = $00000001; + {$EXTERNALSYM COMIMAGE_FLAGS_ILONLY} + COMIMAGE_FLAGS_32BITREQUIRED = $00000002; + {$EXTERNALSYM COMIMAGE_FLAGS_32BITREQUIRED} + COMIMAGE_FLAGS_IL_LIBRARY = $00000004; + {$EXTERNALSYM COMIMAGE_FLAGS_IL_LIBRARY} + COMIMAGE_FLAGS_STRONGNAMESIGNED = $00000008; + {$EXTERNALSYM COMIMAGE_FLAGS_STRONGNAMESIGNED} + COMIMAGE_FLAGS_TRACKDEBUGDATA = $00010000; + {$EXTERNALSYM COMIMAGE_FLAGS_TRACKDEBUGDATA} + +// Version flags for image. + + COR_VERSION_MAJOR_V2 = 2; + {$EXTERNALSYM COR_VERSION_MAJOR_V2} + COR_VERSION_MAJOR = COR_VERSION_MAJOR_V2; + {$EXTERNALSYM COR_VERSION_MAJOR} + COR_VERSION_MINOR = 0; + {$EXTERNALSYM COR_VERSION_MINOR} + COR_DELETED_NAME_LENGTH = 8; + {$EXTERNALSYM COR_DELETED_NAME_LENGTH} + COR_VTABLEGAP_NAME_LENGTH = 8; + {$EXTERNALSYM COR_VTABLEGAP_NAME_LENGTH} + +// Maximum size of a NativeType descriptor. + + NATIVE_TYPE_MAX_CB = 1; + {$EXTERNALSYM NATIVE_TYPE_MAX_CB} + COR_ILMETHOD_SECT_SMALL_MAX_DATASIZE= $FF; + {$EXTERNALSYM COR_ILMETHOD_SECT_SMALL_MAX_DATASIZE} + +// #defines for the MIH FLAGS + + IMAGE_COR_MIH_METHODRVA = $01; + {$EXTERNALSYM IMAGE_COR_MIH_METHODRVA} + IMAGE_COR_MIH_EHRVA = $02; + {$EXTERNALSYM IMAGE_COR_MIH_EHRVA} + IMAGE_COR_MIH_BASICBLOCK = $08; + {$EXTERNALSYM IMAGE_COR_MIH_BASICBLOCK} + +// V-table constants + + COR_VTABLE_32BIT = $01; // V-table slots are 32-bits in size. + {$EXTERNALSYM COR_VTABLE_32BIT} + COR_VTABLE_64BIT = $02; // V-table slots are 64-bits in size. + {$EXTERNALSYM COR_VTABLE_64BIT} + COR_VTABLE_FROM_UNMANAGED = $04; // If set, transition from unmanaged. + {$EXTERNALSYM COR_VTABLE_FROM_UNMANAGED} + COR_VTABLE_CALL_MOST_DERIVED = $10; // Call most derived method described by + {$EXTERNALSYM COR_VTABLE_CALL_MOST_DERIVED} + +// EATJ constants + + IMAGE_COR_EATJ_THUNK_SIZE = 32; // Size of a jump thunk reserved range. + {$EXTERNALSYM IMAGE_COR_EATJ_THUNK_SIZE} + +// Max name lengths +// Change to unlimited name lengths. + + MAX_CLASS_NAME = 1024; + {$EXTERNALSYM MAX_CLASS_NAME} + MAX_PACKAGE_NAME = 1024; + {$EXTERNALSYM MAX_PACKAGE_NAME} + +// COM+ 2.0 header structure. + +type + IMAGE_COR20_HEADER = record + + // Header versioning + + cb: DWORD; + MajorRuntimeVersion: WORD; + MinorRuntimeVersion: WORD; + + // Symbol table and startup information + + MetaData: IMAGE_DATA_DIRECTORY; + Flags: DWORD; + EntryPointToken: DWORD; + + // Binding information + + Resources: IMAGE_DATA_DIRECTORY; + StrongNameSignature: IMAGE_DATA_DIRECTORY; + + // Regular fixup and binding information + + CodeManagerTable: IMAGE_DATA_DIRECTORY; + VTableFixups: IMAGE_DATA_DIRECTORY; + ExportAddressTableJumps: IMAGE_DATA_DIRECTORY; + + // Precompiled image info (internal use only - set to zero) + + ManagedNativeHeader: IMAGE_DATA_DIRECTORY; + end; + PIMAGE_COR20_HEADER = ^IMAGE_COR20_HEADER; + TImageCor20Header = IMAGE_COR20_HEADER; + PImageCor20Header = PIMAGE_COR20_HEADER; + +// line 7351 + +const + COMPRESSION_FORMAT_NONE = ($0000); + {$EXTERNALSYM COMPRESSION_FORMAT_NONE} + COMPRESSION_FORMAT_DEFAULT = ($0001); + {$EXTERNALSYM COMPRESSION_FORMAT_DEFAULT} + COMPRESSION_FORMAT_LZNT1 = ($0002); + {$EXTERNALSYM COMPRESSION_FORMAT_LZNT1} + COMPRESSION_ENGINE_STANDARD = ($0000); + {$EXTERNALSYM COMPRESSION_ENGINE_STANDARD} + COMPRESSION_ENGINE_MAXIMUM = ($0100); + {$EXTERNALSYM COMPRESSION_ENGINE_MAXIMUM} + COMPRESSION_ENGINE_HIBER = ($0200); + {$EXTERNALSYM COMPRESSION_ENGINE_HIBER} + +// line 7462 + +type + POSVERSIONINFOEXA = ^OSVERSIONINFOEXA; + {$EXTERNALSYM POSVERSIONINFOEXA} + _OSVERSIONINFOEXA = record + dwOSVersionInfoSize: DWORD; + dwMajorVersion: DWORD; + dwMinorVersion: DWORD; + dwBuildNumber: DWORD; + dwPlatformId: DWORD; + szCSDVersion: array [0..127] of ANSICHAR; // Maintenance string for PSS usage + wServicePackMajor: WORD; + wServicePackMinor: WORD; + wSuiteMask: WORD; + wProductType: BYTE; + wReserved: BYTE; + end; + {$EXTERNALSYM _OSVERSIONINFOEXA} + OSVERSIONINFOEXA = _OSVERSIONINFOEXA; + {$EXTERNALSYM OSVERSIONINFOEXA} + LPOSVERSIONINFOEXA = ^OSVERSIONINFOEXA; + {$EXTERNALSYM LPOSVERSIONINFOEXA} + TOSVersionInfoExA = _OSVERSIONINFOEXA; + + POSVERSIONINFOEXW = ^OSVERSIONINFOEXW; + {$EXTERNALSYM POSVERSIONINFOEXW} + _OSVERSIONINFOEXW = record + dwOSVersionInfoSize: DWORD; + dwMajorVersion: DWORD; + dwMinorVersion: DWORD; + dwBuildNumber: DWORD; + dwPlatformId: DWORD; + szCSDVersion: array [0..127] of WCHAR; // Maintenance string for PSS usage + wServicePackMajor: WORD; + wServicePackMinor: WORD; + wSuiteMask: WORD; + wProductType: BYTE; + wReserved: BYTE; + end; + {$EXTERNALSYM _OSVERSIONINFOEXW} + OSVERSIONINFOEXW = _OSVERSIONINFOEXW; + {$EXTERNALSYM OSVERSIONINFOEXW} + LPOSVERSIONINFOEXW = ^OSVERSIONINFOEXW; + {$EXTERNALSYM LPOSVERSIONINFOEXW} + RTL_OSVERSIONINFOEXW = _OSVERSIONINFOEXW; + {$EXTERNALSYM RTL_OSVERSIONINFOEXW} + PRTL_OSVERSIONINFOEXW = ^RTL_OSVERSIONINFOEXW; + {$EXTERNALSYM PRTL_OSVERSIONINFOEXW} + TOSVersionInfoExW = _OSVERSIONINFOEXW; + +{$IFDEF SUPPORTS_UNICODE} + + OSVERSIONINFOEX = OSVERSIONINFOEXW; + {$EXTERNALSYM OSVERSIONINFOEX} + POSVERSIONINFOEX = POSVERSIONINFOEXW; + {$EXTERNALSYM POSVERSIONINFOEX} + LPOSVERSIONINFOEX = LPOSVERSIONINFOEXW; + {$EXTERNALSYM LPOSVERSIONINFOEX} + TOSVersionInfoEx = TOSVersionInfoExW; + +{$ELSE ~SUPPORTS_UNICODE} + + OSVERSIONINFOEX = OSVERSIONINFOEXA; + {$EXTERNALSYM OSVERSIONINFOEX} + POSVERSIONINFOEX = POSVERSIONINFOEXA; + {$EXTERNALSYM POSVERSIONINFOEX} + LPOSVERSIONINFOEX = LPOSVERSIONINFOEXA; + {$EXTERNALSYM LPOSVERSIONINFOEX} + TOSVersionInfoEx = TOSVersionInfoExA; + +{$ENDIF ~SUPPORTS_UNICODE} + +// +// RtlVerifyVersionInfo() conditions +// + +const + VER_EQUAL = 1; + {$EXTERNALSYM VER_EQUAL} + VER_GREATER = 2; + {$EXTERNALSYM VER_GREATER} + VER_GREATER_EQUAL = 3; + {$EXTERNALSYM VER_GREATER_EQUAL} + VER_LESS = 4; + {$EXTERNALSYM VER_LESS} + VER_LESS_EQUAL = 5; + {$EXTERNALSYM VER_LESS_EQUAL} + VER_AND = 6; + {$EXTERNALSYM VER_AND} + VER_OR = 7; + {$EXTERNALSYM VER_OR} + + VER_CONDITION_MASK = 7; + {$EXTERNALSYM VER_CONDITION_MASK} + VER_NUM_BITS_PER_CONDITION_MASK = 3; + {$EXTERNALSYM VER_NUM_BITS_PER_CONDITION_MASK} + +// +// RtlVerifyVersionInfo() type mask bits +// + + VER_MINORVERSION = $0000001; + {$EXTERNALSYM VER_MINORVERSION} + VER_MAJORVERSION = $0000002; + {$EXTERNALSYM VER_MAJORVERSION} + VER_BUILDNUMBER = $0000004; + {$EXTERNALSYM VER_BUILDNUMBER} + VER_PLATFORMID = $0000008; + {$EXTERNALSYM VER_PLATFORMID} + VER_SERVICEPACKMINOR = $0000010; + {$EXTERNALSYM VER_SERVICEPACKMINOR} + VER_SERVICEPACKMAJOR = $0000020; + {$EXTERNALSYM VER_SERVICEPACKMAJOR} + VER_SUITENAME = $0000040; + {$EXTERNALSYM VER_SUITENAME} + VER_PRODUCT_TYPE = $0000080; + {$EXTERNALSYM VER_PRODUCT_TYPE} + +// +// RtlVerifyVersionInfo() os product type values +// + + VER_NT_WORKSTATION = $0000001; + {$EXTERNALSYM VER_NT_WORKSTATION} + VER_NT_DOMAIN_CONTROLLER = $0000002; + {$EXTERNALSYM VER_NT_DOMAIN_CONTROLLER} + VER_NT_SERVER = $0000003; + {$EXTERNALSYM VER_NT_SERVER} + +// +// dwPlatformId defines: +// + + VER_PLATFORM_WIN32s = 0; + {$EXTERNALSYM VER_PLATFORM_WIN32s} + VER_PLATFORM_WIN32_WINDOWS = 1; + {$EXTERNALSYM VER_PLATFORM_WIN32_WINDOWS} + VER_PLATFORM_WIN32_NT = 2; + {$EXTERNALSYM VER_PLATFORM_WIN32_NT} + +const +// +// +// Predefined Value Types. +// + + REG_NONE = ( 0 ); // No value type + {$EXTERNALSYM REG_NONE} + REG_SZ = ( 1 ); // Unicode nul terminated string + {$EXTERNALSYM REG_SZ} + REG_EXPAND_SZ = ( 2 ); // Unicode nul terminated string + {$EXTERNALSYM REG_EXPAND_SZ} + // (with environment variable references) + REG_BINARY = ( 3 ); // Free form binary + {$EXTERNALSYM REG_BINARY} + REG_DWORD = ( 4 ); // 32-bit number + {$EXTERNALSYM REG_DWORD} + REG_DWORD_LITTLE_ENDIAN = ( 4 ); // 32-bit number (same as REG_DWORD) + {$EXTERNALSYM REG_DWORD_LITTLE_ENDIAN} + REG_DWORD_BIG_ENDIAN = ( 5 ); // 32-bit number + {$EXTERNALSYM REG_DWORD_BIG_ENDIAN} + REG_LINK = ( 6 ); // Symbolic Link (unicode) + {$EXTERNALSYM REG_LINK} + REG_MULTI_SZ = ( 7 ); // Multiple Unicode strings + {$EXTERNALSYM REG_MULTI_SZ} + REG_RESOURCE_LIST = ( 8 ); // Resource list in the resource map + {$EXTERNALSYM REG_RESOURCE_LIST} + REG_FULL_RESOURCE_DESCRIPTOR = ( 9 ); // Resource list in the hardware description + {$EXTERNALSYM REG_FULL_RESOURCE_DESCRIPTOR} + REG_RESOURCE_REQUIREMENTS_LIST = ( 10 ); + {$EXTERNALSYM REG_RESOURCE_REQUIREMENTS_LIST} + REG_QWORD = ( 11 ); // 64-bit number + {$EXTERNALSYM REG_QWORD} + REG_QWORD_LITTLE_ENDIAN = ( 11 ); // 64-bit number (same as REG_QWORD) + {$EXTERNALSYM REG_QWORD_LITTLE_ENDIAN} + + // Windows 7 debugging types + +type + _CONTEXT_CHUNK = packed record + Offset: Integer; + Length: DWORD; + end; + {$EXTERNALSYM _CONTEXT_CHUNK} + CONTEXT_CHUNK = _CONTEXT_CHUNK; + {$EXTERNALSYM CONTEXT_CHUNK} + PCONTEXT_CHUNK = ^_CONTEXT_CHUNK; + {$EXTERNALSYM PCONTEXT_CHUNK} + +type + _CONTEXT_EX = packed record + // + // The total length of the structure starting from the chunk with + // the smallest offset. N.B. that the offset may be negative. + // + All: CONTEXT_CHUNK; + + // + // Wrapper for the traditional CONTEXT structure. N.B. the size of + // the chunk may be less than sizeof(CONTEXT) is some cases (when + // CONTEXT_EXTENDED_REGISTERS is not set on x86 for instance). + // + + Legacy: CONTEXT_CHUNK; + + // + // CONTEXT_XSTATE: Extended processor state chunk. The state is + // stored in the same format XSAVE operation strores it with + // exception of the first 512 bytes, i.e. staring from + // XSAVE_AREA_HEADER. The lower two bits corresponding FP and + // SSE state must be zero. + // + + XState: CONTEXT_CHUNK; + end; + {$EXTERNALSYM _CONTEXT_EX} + CONTEXT_EX = _CONTEXT_EX; + {$EXTERNALSYM CONTEXT_EX} + PCONTEXT_EX = ^_CONTEXT_EX; + {$EXTERNALSYM PCONTEXT_EX} + +// +// Known extended CPU state feature IDs +// + +const + XSTATE_LEGACY_FLOATING_POINT = 0; + {$EXTERNALSYM XSTATE_LEGACY_FLOATING_POINT} + XSTATE_LEGACY_SSE = 1; + {$EXTERNALSYM XSTATE_LEGACY_SSE} + XSTATE_GSSE = 2; + {$EXTERNALSYM XSTATE_GSSE} + + XSTATE_MASK_LEGACY_FLOATING_POINT = Int64(1) shl XSTATE_LEGACY_FLOATING_POINT; + {$EXTERNALSYM XSTATE_MASK_LEGACY_FLOATING_POINT} + XSTATE_MASK_LEGACY_SSE = Int64(1) shl XSTATE_LEGACY_SSE; + {$EXTERNALSYM XSTATE_MASK_LEGACY_SSE} + XSTATE_MASK_LEGACY = XSTATE_MASK_LEGACY_FLOATING_POINT or XSTATE_MASK_LEGACY_SSE; + {$EXTERNALSYM XSTATE_MASK_LEGACY} + XSTATE_MASK_GSSE = Int64(1) shl XSTATE_GSSE; + {$EXTERNALSYM XSTATE_MASK_GSSE} + + MAXIMUM_XSTATE_FEATURES = 64; + {$EXTERNALSYM MAXIMUM_XSTATE_FEATURES} + +// +// The following flags control the contents of the CONTEXT structure. +// +const + CONTEXT_i386 = $00010000; // this assumes that i386 and + {$EXTERNALSYM CONTEXT_i386} + CONTEXT_i486 = $00010000; // i486 have identical context records + {$EXTERNALSYM CONTEXT_i486} + + CONTEXT_CONTROL = CONTEXT_i386 or $00000001; // SS:SP, CS:IP, FLAGS, BP + {$EXTERNALSYM CONTEXT_CONTROL} + CONTEXT_INTEGER = CONTEXT_i386 or $00000002; // AX, BX, CX, DX, SI, DI + {$EXTERNALSYM CONTEXT_INTEGER} + CONTEXT_SEGMENTS = CONTEXT_i386 or $00000004; // DS, ES, FS, GS + {$EXTERNALSYM CONTEXT_SEGMENTS} + CONTEXT_FLOATING_POINT = CONTEXT_i386 or $00000008; // 387 state + {$EXTERNALSYM CONTEXT_FLOATING_POINT} + CONTEXT_DEBUG_REGISTERS = CONTEXT_i386 or $00000010; // DB 0-3,6,7 + {$EXTERNALSYM CONTEXT_DEBUG_REGISTERS} + CONTEXT_EXTENDED_REGISTERS = CONTEXT_i386 or $00000020; // cpu specific extensions + {$EXTERNALSYM CONTEXT_EXTENDED_REGISTERS} + + CONTEXT_FULL = CONTEXT_CONTROL or CONTEXT_INTEGER or CONTEXT_SEGMENTS; + {$EXTERNALSYM CONTEXT_FULL} + + CONTEXT_ALL = CONTEXT_CONTROL or CONTEXT_INTEGER or CONTEXT_SEGMENTS or CONTEXT_FLOATING_POINT or + CONTEXT_DEBUG_REGISTERS or CONTEXT_EXTENDED_REGISTERS; + {$EXTERNALSYM CONTEXT_ALL} + + CONTEXT_XSTATE = CONTEXT_i386 or $00000040; + {$EXTERNALSYM CONTEXT_XSTATE} + +// line 160 + +// +// File creation flags must start at the high end since they +// are combined with the attributes +// + +const + FILE_FLAG_WRITE_THROUGH = DWORD($80000000); + {$EXTERNALSYM FILE_FLAG_WRITE_THROUGH} + FILE_FLAG_OVERLAPPED = $40000000; + {$EXTERNALSYM FILE_FLAG_OVERLAPPED} + FILE_FLAG_NO_BUFFERING = $20000000; + {$EXTERNALSYM FILE_FLAG_NO_BUFFERING} + FILE_FLAG_RANDOM_ACCESS = $10000000; + {$EXTERNALSYM FILE_FLAG_RANDOM_ACCESS} + FILE_FLAG_SEQUENTIAL_SCAN = $08000000; + {$EXTERNALSYM FILE_FLAG_SEQUENTIAL_SCAN} + FILE_FLAG_DELETE_ON_CLOSE = $04000000; + {$EXTERNALSYM FILE_FLAG_DELETE_ON_CLOSE} + FILE_FLAG_BACKUP_SEMANTICS = $02000000; + {$EXTERNALSYM FILE_FLAG_BACKUP_SEMANTICS} + FILE_FLAG_POSIX_SEMANTICS = $01000000; + {$EXTERNALSYM FILE_FLAG_POSIX_SEMANTICS} + FILE_FLAG_OPEN_REPARSE_POINT = $00200000; + {$EXTERNALSYM FILE_FLAG_OPEN_REPARSE_POINT} + FILE_FLAG_OPEN_NO_RECALL = $00100000; + {$EXTERNALSYM FILE_FLAG_OPEN_NO_RECALL} + FILE_FLAG_FIRST_PIPE_INSTANCE = $00080000; + {$EXTERNALSYM FILE_FLAG_FIRST_PIPE_INSTANCE} + +// line 2727 +type + _MEMORYSTATUSEX = packed record + dwLength: DWORD; + dwMemoryLoad: DWORD; + ullTotalPhys: Int64; + ullAvailPhys: Int64; + ullTotalPageFile: Int64; + ullAvailPageFile: Int64; + ullTotalVirtual: Int64; + ullAvailVirtual: Int64; + ullAvailExtendedVirtual: Int64; + end; + {$EXTERNALSYM _MEMORYSTATUSEX} + + MEMORYSTATUSEX = _MEMORYSTATUSEX; + {$EXTERNALSYM MEMORYSTATUSEX} + LPMEMORYSTATUSEX = ^_MEMORYSTATUSEX; + {$EXTERNALSYM LPMEMORYSTATUSEX} + + TMemoryStatusEx = _MEMORYSTATUSEX; + +function GlobalMemoryStatusEx(out lpBuffer: TMemoryStatusEx): BOOL; stdcall; + +// line 3189 + + +function BackupSeek(hFile: THandle; dwLowBytesToSeek, dwHighBytesToSeek: DWORD; + out lpdwLowByteSeeked, lpdwHighByteSeeked: DWORD; + var lpContext: Pointer): BOOL; stdcall; +{$EXTERNALSYM BackupSeek} + +// line 5454 + +function AdjustTokenPrivileges(TokenHandle: THandle; DisableAllPrivileges: BOOL; + const NewState: TTokenPrivileges; BufferLength: DWORD; + PreviousState: PTokenPrivileges; + ReturnLength: PDWORD + ): BOOL; stdcall; +{$EXTERNALSYM AdjustTokenPrivileges} + +{ +From: Ray Lischner +Subject: CreateMutex bug +Date: 1999/12/10 +Message-ID: #1/1 +Content-Transfer-Encoding: 7bit +Organization: Tempest Software, Inc., Corvallis, Oregon +Content-Type: text/plain; charset=us-ascii +Mime-Version: 1.0 +Newsgroups: borland.public.delphi.winapi + + +Windows NT 4 has a bug in CreateMutex. The second argument is documented +to be a BOOL, but in truth, the CreateMutex interprets 1 as True and all +other values as False. (Do I detect an "if (bInitialOwner == TRUE)" in +the implementation of CreateMutex?) + +The problem is that Delphi declares CreateMutex according to the +documentation, so bInitialOwner is declared as LongBool. Delphi maps +True values to $FFFFFFFF, which should work, but doesn't in this case. + +My workaround is to declare CreateMutex with a LongInt as the second +argument, and pass the value 1 for True. + +I have not had this problem on Windows 98. +-- +Ray Lischner, author of Delphi in a Nutshell (coming later this year) +http://www.bardware.com and http://www.tempest-sw.com +} +function CreateMutex(lpMutexAttributes: PSecurityAttributes; bInitialOwner: BOOL; lpName: PChar): THandle; stdcall; +{$EXTERNALSYM CreateMutex} + +// alternative conversion for WinNT 4.0 SP6 and later (OSVersionInfoEx instead of OSVersionInfo) +{$EXTERNALSYM GetVersionEx} +function GetVersionEx(var lpVersionInformation: TOSVersionInfoEx): BOOL; stdcall; overload; +{$EXTERNALSYM GetVersionEx} +function GetVersionEx(lpVersionInformation: POSVERSIONINFOEX): BOOL; stdcall; overload; + {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} + +// line 3585 + +function SetWaitableTimer(hTimer: THandle; var lpDueTime: TLargeInteger; + lPeriod: Longint; pfnCompletionRoutine: TFNTimerAPCRoutine; + lpArgToCompletionRoutine: Pointer; fResume: BOOL): BOOL; stdcall; + {$EXTERNALSYM SetWaitableTimer} + +// WinBase.h line 8839 + +function SetFileSecurityA(lpFileName: LPCSTR; SecurityInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; stdcall; +{$EXTERNALSYM SetFileSecurityA} +function SetFileSecurityW(lpFileName: LPCWSTR; SecurityInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; stdcall; +{$EXTERNALSYM SetFileSecurityW} +function SetFileSecurity(lpFileName: LPCTSTR; SecurityInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; stdcall; +{$EXTERNALSYM SetFileSecurity} + +function GetFileSecurityA(lpFileName: LPCSTR; RequestedInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; + var lpnLengthNeeded: DWORD): BOOL; stdcall; +{$EXTERNALSYM GetFileSecurityA} +function GetFileSecurityW(lpFileName: LPCWSTR; RequestedInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; + var lpnLengthNeeded: DWORD): BOOL; stdcall; +{$EXTERNALSYM GetFileSecurityW} +function GetFileSecurity(lpFileName: LPCTSTR; RequestedInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; + var lpnLengthNeeded: DWORD): BOOL; stdcall; +{$EXTERNALSYM GetFileSecurity} + +// WinBase.h line 10251 + +function SetVolumeMountPointW(lpszVolumeMountPoint, lpszVolumeName: LPCWSTR): BOOL; stdcall; +{$EXTERNALSYM SetVolumeMountPointW} + +function DeleteVolumeMountPointW(lpszVolumeMountPoint: LPCWSTR): BOOL; stdcall; +{$EXTERNALSYM DeleteVolumeMountPointW} + +function GetVolumeNameForVolumeMountPointW(lpszVolumeMountPoint: LPCWSTR; + lpszVolumeName: LPWSTR; cchBufferLength: DWORD): BOOL; stdcall; +{$EXTERNALSYM GetVolumeNameForVolumeMountPointW} + +// new Windows 7 debugging API +function CopyExtendedContext(Destination: PCONTEXT_EX; ContextFlags: DWORD; Source: PCONTEXT_EX): BOOL; stdcall; +{$EXTERNALSYM CopyExtendedContext} + +function InitializeExtendedContext(Context: Pointer; ContextFlags: DWORD; out ContextEx: PCONTEXT_EX): BOOL; stdcall; +{$EXTERNALSYM InitializeExtendedContext} + +function GetEnabledExtendedFeatures(const FeatureMask: Int64): Int64; stdcall; +{$EXTERNALSYM GetEnabledExtendedFeatures} + +function GetExtendedContextLength(ContextFlags: DWORD; ContextLength: PDWORD): BOOL; stdcall; +{$EXTERNALSYM GetExtendedContextLength} + +function GetExtendedFeaturesMask(ContextEx: PCONTEXT_EX): Int64; stdcall; +{$EXTERNALSYM GetExtendedFeaturesMask} + +function LocateExtendedFeature(ContextEx: PCONTEXT_EX; FeatureId: DWORD; Length: PDWORD): Pointer; stdcall; +{$EXTERNALSYM LocateExtendedFeature} + +function LocateLegacyContext(ContextEx: PCONTEXT_EX; Length: PDWORD): PCONTEXT; stdcall; +{$EXTERNALSYM LocateLegacyContext} + +procedure SetExtendedFeaturesMask(ContextEx: PCONTEXT_EX; const FeatureMask: Int64); stdcall; +{$EXTERNALSYM SetExtendedFeaturesMask} + +function ProcessIdToSessionId(dwProcessId: DWORD; out dwSessionId: DWORD): BOOL; stdcall; +{$EXTERNALSYM ProcessIdToSessionId} + + +// From JwaAclApi + +// line 185 + +function SetNamedSecurityInfoW(pObjectName: LPWSTR; ObjectType: SE_OBJECT_TYPE; + SecurityInfo: SECURITY_INFORMATION; psidOwner, psidGroup: PSID; + pDacl, pSacl: PACL): DWORD; stdcall; +{$EXTERNALSYM SetNamedSecurityInfoW} +const + IMAGE_SEPARATION = (64*1024); + {$EXTERNALSYM IMAGE_SEPARATION} + +type + PLOADED_IMAGE = ^LOADED_IMAGE; + {$EXTERNALSYM PLOADED_IMAGE} + _LOADED_IMAGE = record + ModuleName: PAnsiChar; + hFile: THandle; + MappedAddress: PUCHAR; + FileHeader: PImageNtHeaders; + LastRvaSection: PImageSectionHeader; + NumberOfSections: ULONG; + Sections: PImageSectionHeader; + Characteristics: ULONG; + fSystemImage: ByteBool; + fDOSImage: ByteBool; + Links: LIST_ENTRY; + SizeOfImage: ULONG; + end; + {$EXTERNALSYM _LOADED_IMAGE} + LOADED_IMAGE = _LOADED_IMAGE; + {$EXTERNALSYM LOADED_IMAGE} + TLoadedImage = LOADED_IMAGE; + PLoadedImage = PLOADED_IMAGE; + + PIMAGE_SYMBOL = ^IMAGE_SYMBOL; + {$EXTERNALSYM PIMAGE_SYMBOL} + _IMAGE_SYMBOL = packed record // MUST pack to obtain the right size + Name: array [0..7] of AnsiChar; + Value: ULONG; + SectionNumber: USHORT; + _Type: USHORT; + StorageClass: BYTE; + NumberOfAuxSymbols: BYTE; + end; + {$EXTERNALSYM _IMAGE_SYMBOL} + IMAGE_SYMBOL = _IMAGE_SYMBOL; + {$EXTERNALSYM IMAGE_SYMBOL} + TImageSymbol = IMAGE_SYMBOL; + PImageSymbol = PIMAGE_SYMBOL; + +// line 152 + + +function ReBaseImage(CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; + fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; + var OldImageSize: TJclAddr32; var OldImageBase: TJclAddr; + var NewImageSize: TJclAddr32; var NewImageBase: TJclAddr; TimeStamp: ULONG): BOOL; stdcall; +{$EXTERNALSYM ReBaseImage} + +function ReBaseImage64(CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; + fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; + var OldImageSize: TJclAddr32; var OldImageBase: TJclAddr64; + var NewImageSize: TJclAddr32; var NewImageBase: TJclAddr64; TimeStamp: ULONG): BOOL; stdcall; +{$EXTERNALSYM ReBaseImage64} + +// line 199 + +// +// Define checksum function prototypes. +// + +function CheckSumMappedFile(BaseAddress: Pointer; FileLength: DWORD; + out HeaderSum, CheckSum: DWORD): PImageNtHeaders; stdcall; +{$EXTERNALSYM CheckSumMappedFile} + +// line 227 + +function GetImageUnusedHeaderBytes(const LoadedImage: LOADED_IMAGE; + var SizeUnusedHeaderBytes: DWORD): DWORD; stdcall; +{$EXTERNALSYM GetImageUnusedHeaderBytes} + +// line 285 + +function MapAndLoad(ImageName, DllPath: PAnsiChar; var LoadedImage: LOADED_IMAGE; + DotDll: BOOL; ReadOnly: BOOL): BOOL; stdcall; +{$EXTERNALSYM MapAndLoad} + +function UnMapAndLoad(const LoadedImage: LOADED_IMAGE): BOOL; stdcall; +{$EXTERNALSYM UnMapAndLoad} + +function TouchFileTimes(const FileHandle: THandle; const pSystemTime: TSystemTime): BOOL; stdcall; +{$EXTERNALSYM TouchFileTimes} + +// line 347 + +function ImageDirectoryEntryToData(Base: Pointer; MappedAsImage: ByteBool; + DirectoryEntry: USHORT; var Size: ULONG): Pointer; stdcall; +{$EXTERNALSYM ImageDirectoryEntryToData} + +function ImageRvaToSection(NtHeaders: PImageNtHeaders; Base: Pointer; Rva: ULONG): PImageSectionHeader; stdcall; +{$EXTERNALSYM ImageRvaToSection} + +function ImageRvaToVa(NtHeaders: PImageNtHeaders; Base: Pointer; Rva: ULONG; + LastRvaSection: PPImageSectionHeader): Pointer; stdcall; +{$EXTERNALSYM ImageRvaToVa} + + +// line 461 + +// +// UnDecorateSymbolName Flags +// + +const + UNDNAME_COMPLETE = ($0000); // Enable full undecoration + {$EXTERNALSYM UNDNAME_COMPLETE} + UNDNAME_NO_LEADING_UNDERSCORES = ($0001); // Remove leading underscores from MS extended keywords + {$EXTERNALSYM UNDNAME_NO_LEADING_UNDERSCORES} + UNDNAME_NO_MS_KEYWORDS = ($0002); // Disable expansion of MS extended keywords + {$EXTERNALSYM UNDNAME_NO_MS_KEYWORDS} + UNDNAME_NO_FUNCTION_RETURNS = ($0004); // Disable expansion of return type for primary declaration + {$EXTERNALSYM UNDNAME_NO_FUNCTION_RETURNS} + UNDNAME_NO_ALLOCATION_MODEL = ($0008); // Disable expansion of the declaration model + {$EXTERNALSYM UNDNAME_NO_ALLOCATION_MODEL} + UNDNAME_NO_ALLOCATION_LANGUAGE = ($0010); // Disable expansion of the declaration language specifier + {$EXTERNALSYM UNDNAME_NO_ALLOCATION_LANGUAGE} + UNDNAME_NO_MS_THISTYPE = ($0020); // NYI Disable expansion of MS keywords on the 'this' type for primary declaration + {$EXTERNALSYM UNDNAME_NO_MS_THISTYPE} + UNDNAME_NO_CV_THISTYPE = ($0040); // NYI Disable expansion of CV modifiers on the 'this' type for primary declaration + {$EXTERNALSYM UNDNAME_NO_CV_THISTYPE} + UNDNAME_NO_THISTYPE = ($0060); // Disable all modifiers on the 'this' type + {$EXTERNALSYM UNDNAME_NO_THISTYPE} + UNDNAME_NO_ACCESS_SPECIFIERS = ($0080); // Disable expansion of access specifiers for members + {$EXTERNALSYM UNDNAME_NO_ACCESS_SPECIFIERS} + UNDNAME_NO_THROW_SIGNATURES = ($0100); // Disable expansion of 'throw-signatures' for functions and pointers to functions + {$EXTERNALSYM UNDNAME_NO_THROW_SIGNATURES} + UNDNAME_NO_MEMBER_TYPE = ($0200); // Disable expansion of 'static' or 'virtual'ness of members + {$EXTERNALSYM UNDNAME_NO_MEMBER_TYPE} + UNDNAME_NO_RETURN_UDT_MODEL = ($0400); // Disable expansion of MS model for UDT returns + {$EXTERNALSYM UNDNAME_NO_RETURN_UDT_MODEL} + UNDNAME_32_BIT_DECODE = ($0800); // Undecorate 32-bit decorated names + {$EXTERNALSYM UNDNAME_32_BIT_DECODE} + UNDNAME_NAME_ONLY = ($1000); // Crack only the name for primary declaration; + {$EXTERNALSYM UNDNAME_NAME_ONLY} + // return just [scope::]name. Does expand template params + UNDNAME_NO_ARGUMENTS = ($2000); // Don't undecorate arguments to function + {$EXTERNALSYM UNDNAME_NO_ARGUMENTS} + UNDNAME_NO_SPECIAL_SYMS = ($4000); // Don't undecorate special names (v-table, vcall, vector xxx, metatype, etc) + {$EXTERNALSYM UNDNAME_NO_SPECIAL_SYMS} + +// line 1342 + +type + {$EXTERNALSYM SYM_TYPE} + SYM_TYPE = ( + SymNone, + SymCoff, + SymCv, + SymPdb, + SymExport, + SymDeferred, + SymSym { .sym file } + ); + TSymType = SYM_TYPE; + + { symbol data structure } + {$EXTERNALSYM PImagehlpSymbolA} + PImagehlpSymbolA = ^TImagehlpSymbolA; + {$EXTERNALSYM _IMAGEHLP_SYMBOLA} + _IMAGEHLP_SYMBOLA = packed record + SizeOfStruct: DWORD; { set to sizeof(IMAGEHLP_SYMBOL) } + Address: DWORD; { virtual address including dll base address } + Size: DWORD; { estimated size of symbol, can be zero } + Flags: DWORD; { info about the symbols, see the SYMF defines } + MaxNameLength: DWORD; { maximum size of symbol name in 'Name' } + Name: packed array[0..0] of AnsiChar; { symbol name (null terminated string) } + end; + {$EXTERNALSYM IMAGEHLP_SYMBOLA} + IMAGEHLP_SYMBOLA = _IMAGEHLP_SYMBOLA; + {$EXTERNALSYM TImagehlpSymbolA} + TImagehlpSymbolA = _IMAGEHLP_SYMBOLA; + + { symbol data structure } + {$EXTERNALSYM PImagehlpSymbolA64} + PImagehlpSymbolA64 = ^TImagehlpSymbolA64; + {$EXTERNALSYM _IMAGEHLP_SYMBOLA64} + _IMAGEHLP_SYMBOLA64 = packed record + SizeOfStruct: DWORD; { set to sizeof(IMAGEHLP_SYMBOL) } + Address: TJclAddr64; { virtual address including dll base address } + Size: DWORD; { estimated size of symbol, can be zero } + Flags: DWORD; { info about the symbols, see the SYMF defines } + MaxNameLength: DWORD; { maximum size of symbol name in 'Name' } + Name: packed array[0..0] of AnsiChar; { symbol name (null terminated string) } + end; + {$EXTERNALSYM IMAGEHLP_SYMBOLA64} + IMAGEHLP_SYMBOLA64 = _IMAGEHLP_SYMBOLA64; + {$EXTERNALSYM TImagehlpSymbolA64} + TImagehlpSymbolA64 = _IMAGEHLP_SYMBOLA64; + + { symbol data structure } + {$EXTERNALSYM PImagehlpSymbolW} + PImagehlpSymbolW = ^TImagehlpSymbolW; + {$EXTERNALSYM _IMAGEHLP_SYMBOLW} + _IMAGEHLP_SYMBOLW = packed record + SizeOfStruct: DWORD; { set to sizeof(IMAGEHLP_SYMBOL) } + Address: DWORD; { virtual address including dll base address } + Size: DWORD; { estimated size of symbol, can be zero } + Flags: DWORD; { info about the symbols, see the SYMF defines } + MaxNameLength: DWORD; { maximum size of symbol name in 'Name' } + Name: packed array[0..0] of WideChar; { symbol name (null terminated string) } + end; + {$EXTERNALSYM IMAGEHLP_SYMBOLW} + IMAGEHLP_SYMBOLW = _IMAGEHLP_SYMBOLW; + {$EXTERNALSYM TImagehlpSymbolW} + TImagehlpSymbolW = _IMAGEHLP_SYMBOLW; + + { symbol data structure } + {$EXTERNALSYM PImagehlpSymbolW64} + PImagehlpSymbolW64 = ^TImagehlpSymbolW64; + {$EXTERNALSYM _IMAGEHLP_SYMBOLW64} + _IMAGEHLP_SYMBOLW64 = packed record + SizeOfStruct: DWORD; { set to sizeof(IMAGEHLP_SYMBOL) } + Address: TJclAddr64; { virtual address including dll base address } + Size: DWORD; { estimated size of symbol, can be zero } + Flags: DWORD; { info about the symbols, see the SYMF defines } + MaxNameLength: DWORD; { maximum size of symbol name in 'Name' } + Name: packed array[0..0] of WideChar; { symbol name (null terminated string) } + end; + {$EXTERNALSYM IMAGEHLP_SYMBOLW64} + IMAGEHLP_SYMBOLW64 = _IMAGEHLP_SYMBOLW64; + {$EXTERNALSYM TImagehlpSymbolW64} + TImagehlpSymbolW64 = _IMAGEHLP_SYMBOLW64; + + { module data structure } + {$EXTERNALSYM PImagehlpModuleA} + PImagehlpModuleA = ^TImagehlpModuleA; + {$EXTERNALSYM _IMAGEHLP_MODULEA} + _IMAGEHLP_MODULEA = record + SizeOfStruct: DWORD; { set to sizeof(IMAGEHLP_MODULE) } + BaseOfImage: DWORD; { base load address of module } + ImageSize: DWORD; { virtual size of the loaded module } + TimeDateStamp: DWORD; { date/time stamp from pe header } + CheckSum: DWORD; { checksum from the pe header } + NumSyms: DWORD; { number of symbols in the symbol table } + SymType: TSymType; { type of symbols loaded } + ModuleName: packed array[0..31] of AnsiChar; { module name } + ImageName: packed array[0..255] of AnsiChar; { image name } + LoadedImageName: packed array[0..255] of AnsiChar; { symbol file name } + end; + {$EXTERNALSYM IMAGEHLP_MODULEA} + IMAGEHLP_MODULEA = _IMAGEHLP_MODULEA; + {$EXTERNALSYM TImagehlpModuleA} + TImagehlpModuleA = _IMAGEHLP_MODULEA; + + { module data structure } + {$EXTERNALSYM PImagehlpModuleA64} + PImagehlpModuleA64 = ^TImagehlpModuleA64; + {$EXTERNALSYM _IMAGEHLP_MODULEA64} + _IMAGEHLP_MODULEA64 = record + SizeOfStruct: DWORD; { set to sizeof(IMAGEHLP_MODULE) } + BaseOfImage: TJclAddr64; { base load address of module } + ImageSize: DWORD; { virtual size of the loaded module } + TimeDateStamp: DWORD; { date/time stamp from pe header } + CheckSum: DWORD; { checksum from the pe header } + NumSyms: DWORD; { number of symbols in the symbol table } + SymType: TSymType; { type of symbols loaded } + ModuleName: packed array[0..31] of AnsiChar; { module name } + ImageName: packed array[0..255] of AnsiChar; { image name } + LoadedImageName: packed array[0..255] of AnsiChar; { symbol file name } + end; + {$EXTERNALSYM IMAGEHLP_MODULEA64} + IMAGEHLP_MODULEA64 = _IMAGEHLP_MODULEA64; + {$EXTERNALSYM TImagehlpModuleA64} + TImagehlpModuleA64 = _IMAGEHLP_MODULEA64; + + { module data structure } + {$EXTERNALSYM PImagehlpModuleW} + PImagehlpModuleW = ^TImagehlpModuleW; + {$EXTERNALSYM _IMAGEHLP_MODULEW} + _IMAGEHLP_MODULEW = record + SizeOfStruct: DWORD; { set to sizeof(IMAGEHLP_MODULE) } + BaseOfImage: DWORD; { base load address of module } + ImageSize: DWORD; { virtual size of the loaded module } + TimeDateStamp: DWORD; { date/time stamp from pe header } + CheckSum: DWORD; { checksum from the pe header } + NumSyms: DWORD; { number of symbols in the symbol table } + SymType: TSymType; { type of symbols loaded } + ModuleName: packed array[0..31] of WideChar; { module name } + ImageName: packed array[0..255] of WideChar; { image name } + LoadedImageName: packed array[0..255] of WideChar; { symbol file name } + end; + {$EXTERNALSYM IMAGEHLP_MODULEW} + IMAGEHLP_MODULEW = _IMAGEHLP_MODULEW; + {$EXTERNALSYM TImagehlpModuleW} + TImagehlpModuleW = _IMAGEHLP_MODULEW; + + { module data structure } + {$EXTERNALSYM PImagehlpModuleW64} + PImagehlpModuleW64 = ^TImagehlpModuleW64; + {$EXTERNALSYM _IMAGEHLP_MODULEW64} + _IMAGEHLP_MODULEW64 = record + SizeOfStruct: DWORD; { set to sizeof(IMAGEHLP_MODULE) } + BaseOfImage: TJclAddr64; { base load address of module } + ImageSize: DWORD; { virtual size of the loaded module } + TimeDateStamp: DWORD; { date/time stamp from pe header } + CheckSum: DWORD; { checksum from the pe header } + NumSyms: DWORD; { number of symbols in the symbol table } + SymType: TSymType; { type of symbols loaded } + ModuleName: packed array[0..31] of WideChar; { module name } + ImageName: packed array[0..255] of WideChar; { image name } + LoadedImageName: packed array[0..255] of WideChar; { symbol file name } + end; + {$EXTERNALSYM IMAGEHLP_MODULEW64} + IMAGEHLP_MODULEW64 = _IMAGEHLP_MODULEW64; + {$EXTERNALSYM TImagehlpModuleW64} + TImagehlpModuleW64 = _IMAGEHLP_MODULEW64; + + _IMAGEHLP_LINEA = packed record + SizeOfStruct: DWORD; // set to sizeof(IMAGEHLP_LINE) + Key: Pointer; // internal + LineNumber: DWORD; // line number in file + FileName: PAnsiChar; // full filename + Address: DWORD; // first instruction of line + end; + IMAGEHLP_LINEA = _IMAGEHLP_LINEA; + PIMAGEHLP_LINEA = ^_IMAGEHLP_LINEA; + TImageHlpLineA = _IMAGEHLP_LINEA; + PImageHlpLineA = PIMAGEHLP_LINEA; + + _IMAGEHLP_LINEA64 = packed record + SizeOfStruct: DWORD; // set to sizeof(IMAGEHLP_LINE) + Key: Pointer; // internal + LineNumber: DWORD; // line number in file + FileName: PAnsiChar; // full filename + Address: TJclAddr64; // first instruction of line + end; + IMAGEHLP_LINEA64 = _IMAGEHLP_LINEA64; + PIMAGEHLP_LINEA64 = ^_IMAGEHLP_LINEA64; + TImageHlpLineA64 = _IMAGEHLP_LINEA64; + PImageHlpLineA64 = PIMAGEHLP_LINEA64; + + _IMAGEHLP_LINEW = packed record + SizeOfStruct: DWORD; // set to sizeof(IMAGEHLP_LINE) + Key: Pointer; // internal + LineNumber: DWORD; // line number in file + FileName: PWideChar; // full filename + Address: DWORD; // first instruction of line + end; + IMAGEHLP_LINEW = _IMAGEHLP_LINEW; + PIMAGEHLP_LINEW = ^_IMAGEHLP_LINEW; + TImageHlpLineW = _IMAGEHLP_LINEW; + PImageHlpLineW = PIMAGEHLP_LINEW; + + _IMAGEHLP_LINEW64 = packed record + SizeOfStruct: DWORD; // set to sizeof(IMAGEHLP_LINE) + Key: Pointer; // internal + LineNumber: DWORD; // line number in file + FileName: PWideChar; // full filename + Address: TJclAddr64; // first instruction of line + end; + IMAGEHLP_LINEW64 = _IMAGEHLP_LINEW64; + PIMAGEHLP_LINEW64 = ^_IMAGEHLP_LINEW64; + TImageHlpLineW64 = _IMAGEHLP_LINEW64; + PImageHlpLineW64 = PIMAGEHLP_LINEW64; + +// line 1475 + +// +// options that are set/returned by SymSetOptions() & SymGetOptions() +// these are used as a mask +// + +const + SYMOPT_CASE_INSENSITIVE = $00000001; + {$EXTERNALSYM SYMOPT_CASE_INSENSITIVE} + SYMOPT_UNDNAME = $00000002; + {$EXTERNALSYM SYMOPT_UNDNAME} + SYMOPT_DEFERRED_LOADS = $00000004; + {$EXTERNALSYM SYMOPT_DEFERRED_LOADS} + SYMOPT_NO_CPP = $00000008; + {$EXTERNALSYM SYMOPT_NO_CPP} + SYMOPT_LOAD_LINES = $00000010; + {$EXTERNALSYM SYMOPT_LOAD_LINES} + SYMOPT_OMAP_FIND_NEAREST = $00000020; + {$EXTERNALSYM SYMOPT_OMAP_FIND_NEAREST} + SYMOPT_LOAD_ANYTHING = $00000040; + {$EXTERNALSYM SYMOPT_LOAD_ANYTHING} + SYMOPT_IGNORE_CVREC = $00000080; + {$EXTERNALSYM SYMOPT_IGNORE_CVREC} + SYMOPT_NO_UNQUALIFIED_LOADS = $00000100; + {$EXTERNALSYM SYMOPT_NO_UNQUALIFIED_LOADS} + SYMOPT_FAIL_CRITICAL_ERRORS = $00000200; + {$EXTERNALSYM SYMOPT_FAIL_CRITICAL_ERRORS} + SYMOPT_EXACT_SYMBOLS = $00000400; + {$EXTERNALSYM SYMOPT_EXACT_SYMBOLS} + SYMOPT_ALLOW_ABSOLUTE_SYMBOLS = $00000800; + {$EXTERNALSYM SYMOPT_ALLOW_ABSOLUTE_SYMBOLS} + SYMOPT_IGNORE_NT_SYMPATH = $00001000; + {$EXTERNALSYM SYMOPT_IGNORE_NT_SYMPATH} + SYMOPT_INCLUDE_32BIT_MODULES = $00002000; + {$EXTERNALSYM SYMOPT_INCLUDE_32BIT_MODULES} + SYMOPT_PUBLICS_ONLY = $00004000; + {$EXTERNALSYM SYMOPT_PUBLICS_ONLY} + SYMOPT_NO_PUBLICS = $00008000; + {$EXTERNALSYM SYMOPT_NO_PUBLICS} + SYMOPT_AUTO_PUBLICS = $00010000; + {$EXTERNALSYM SYMOPT_AUTO_PUBLICS} + SYMOPT_NO_IMAGE_SEARCH = $00020000; + {$EXTERNALSYM SYMOPT_NO_IMAGE_SEARCH} + SYMOPT_SECURE = $00040000; + {$EXTERNALSYM SYMOPT_SECURE} + SYMOPT_NO_PROMPTS = $00080000; + {$EXTERNALSYM SYMOPT_NO_PROMPTS} + + SYMOPT_DEBUG = $80000000; + {$EXTERNALSYM SYMOPT_DEBUG} + +// IoAPI.h + + +function CancelIo(hFile: THandle): BOOL; stdcall; +{$EXTERNALSYM CancelIo} + + +const + NERR_Success = 0; // Success + {$EXTERNALSYM NERR_Success} + +// ERROR_ equates can be intermixed with NERR_ equates. + +// NERR_BASE is the base of error codes from network utilities, +// chosen to avoid conflict with system and redirector error codes. +// 2100 is a value that has been assigned to us by system. + + NERR_BASE = 2100; + {$EXTERNALSYM NERR_BASE} + + +//*INTERNAL_ONLY* + +{**********WARNING ***************** + *See the comment in lmcons.h for * + *info on the allocation of errors * + ***********************************} + +{**********WARNING ***************** + *The range 2750-2799 has been * + *allocated to the IBM LAN Server * + ***********************************} + +{**********WARNING ***************** + *The range 2900-2999 has been * + *reserved for Microsoft OEMs * + ***********************************} + +// UNUSED BASE+0 +// UNUSED BASE+1 + NERR_NetNotStarted = (NERR_BASE+2); // The workstation driver is not installed. + {$EXTERNALSYM NERR_NetNotStarted} + NERR_UnknownServer = (NERR_BASE+3); // The server could not be located. + {$EXTERNALSYM NERR_UnknownServer} + NERR_ShareMem = (NERR_BASE+4); // An internal error occurred. The network cannot access a shared memory segment. + {$EXTERNALSYM NERR_ShareMem} + + NERR_NoNetworkResource = (NERR_BASE+5); // A network resource shortage occurred . + {$EXTERNALSYM NERR_NoNetworkResource} + NERR_RemoteOnly = (NERR_BASE+6); // This operation is not supported on workstations. + {$EXTERNALSYM NERR_RemoteOnly} + NERR_DevNotRedirected = (NERR_BASE+7); // The device is not connected. + {$EXTERNALSYM NERR_DevNotRedirected} +// NERR_BASE+8 is used for ERROR_CONNECTED_OTHER_PASSWORD +// NERR_BASE+9 is used for ERROR_CONNECTED_OTHER_PASSWORD_DEFAULT +// UNUSED BASE+10 +// UNUSED BASE+11 +// UNUSED BASE+12 +// UNUSED BASE+13 + NERR_ServerNotStarted = (NERR_BASE+14); // The Server service is not started. + {$EXTERNALSYM NERR_ServerNotStarted} + NERR_ItemNotFound = (NERR_BASE+15); // The queue is empty. + {$EXTERNALSYM NERR_ItemNotFound} + NERR_UnknownDevDir = (NERR_BASE+16); // The device or directory does not exist. + {$EXTERNALSYM NERR_UnknownDevDir} + NERR_RedirectedPath = (NERR_BASE+17); // The operation is invalid on a redirected resource. + {$EXTERNALSYM NERR_RedirectedPath} + NERR_DuplicateShare = (NERR_BASE+18); // The name has already been shared. + {$EXTERNALSYM NERR_DuplicateShare} + NERR_NoRoom = (NERR_BASE+19); // The server is currently out of the requested resource. + {$EXTERNALSYM NERR_NoRoom} +// UNUSED BASE+20 + NERR_TooManyItems = (NERR_BASE+21); // Requested addition of items exceeds the maximum allowed. + {$EXTERNALSYM NERR_TooManyItems} + NERR_InvalidMaxUsers = (NERR_BASE+22); // The Peer service supports only two simultaneous users. + {$EXTERNALSYM NERR_InvalidMaxUsers} + NERR_BufTooSmall = (NERR_BASE+23); // The API return buffer is too small. + {$EXTERNALSYM NERR_BufTooSmall} +// UNUSED BASE+24 +// UNUSED BASE+25 +// UNUSED BASE+26 + NERR_RemoteErr = (NERR_BASE+27); // A remote API error occurred. + {$EXTERNALSYM NERR_RemoteErr} +// UNUSED BASE+28 +// UNUSED BASE+29 +// UNUSED BASE+30 + NERR_LanmanIniError = (NERR_BASE+31); // An error occurred when opening or reading the configuration file. + {$EXTERNALSYM NERR_LanmanIniError} +// UNUSED BASE+32 +// UNUSED BASE+33 +// UNUSED BASE+34 +// UNUSED BASE+35 + NERR_NetworkError = (NERR_BASE+36); // A general network error occurred. + {$EXTERNALSYM NERR_NetworkError} + NERR_WkstaInconsistentState = (NERR_BASE+37); + {$EXTERNALSYM NERR_WkstaInconsistentState} + // The Workstation service is in an inconsistent state. Restart the computer before restarting the Workstation service. + NERR_WkstaNotStarted = (NERR_BASE+38); // The Workstation service has not been started. + {$EXTERNALSYM NERR_WkstaNotStarted} + NERR_BrowserNotStarted = (NERR_BASE+39); // The requested information is not available. + {$EXTERNALSYM NERR_BrowserNotStarted} + NERR_InternalError = (NERR_BASE+40); // An internal Windows 2000 error occurred. + {$EXTERNALSYM NERR_InternalError} + NERR_BadTransactConfig = (NERR_BASE+41); // The server is not configured for transactions. + {$EXTERNALSYM NERR_BadTransactConfig} + NERR_InvalidAPI = (NERR_BASE+42); // The requested API is not supported on the remote server. + {$EXTERNALSYM NERR_InvalidAPI} + NERR_BadEventName = (NERR_BASE+43); // The event name is invalid. + {$EXTERNALSYM NERR_BadEventName} + NERR_DupNameReboot = (NERR_BASE+44); // The computer name already exists on the network. Change it and restart the computer. + {$EXTERNALSYM NERR_DupNameReboot} + +// +// Config API related +// Error codes from BASE+45 to BASE+49 + + +// UNUSED BASE+45 + NERR_CfgCompNotFound = (NERR_BASE+46); // The specified component could not be found in the configuration information. + {$EXTERNALSYM NERR_CfgCompNotFound} + NERR_CfgParamNotFound = (NERR_BASE+47); // The specified parameter could not be found in the configuration information. + {$EXTERNALSYM NERR_CfgParamNotFound} + NERR_LineTooLong = (NERR_BASE+49); // A line in the configuration file is too long. + {$EXTERNALSYM NERR_LineTooLong} + +// +// Spooler API related +// Error codes from BASE+50 to BASE+79 + + + NERR_QNotFound = (NERR_BASE+50); // The printer does not exist. + {$EXTERNALSYM NERR_QNotFound} + NERR_JobNotFound = (NERR_BASE+51); // The print job does not exist. + {$EXTERNALSYM NERR_JobNotFound} + NERR_DestNotFound = (NERR_BASE+52); // The printer destination cannot be found. + {$EXTERNALSYM NERR_DestNotFound} + NERR_DestExists = (NERR_BASE+53); // The printer destination already exists. + {$EXTERNALSYM NERR_DestExists} + NERR_QExists = (NERR_BASE+54); // The printer queue already exists. + {$EXTERNALSYM NERR_QExists} + NERR_QNoRoom = (NERR_BASE+55); // No more printers can be added. + {$EXTERNALSYM NERR_QNoRoom} + NERR_JobNoRoom = (NERR_BASE+56); // No more print jobs can be added. + {$EXTERNALSYM NERR_JobNoRoom} + NERR_DestNoRoom = (NERR_BASE+57); // No more printer destinations can be added. + {$EXTERNALSYM NERR_DestNoRoom} + NERR_DestIdle = (NERR_BASE+58); // This printer destination is idle and cannot accept control operations. + {$EXTERNALSYM NERR_DestIdle} + NERR_DestInvalidOp = (NERR_BASE+59); // This printer destination request contains an invalid control function. + {$EXTERNALSYM NERR_DestInvalidOp} + NERR_ProcNoRespond = (NERR_BASE+60); // The print processor is not responding. + {$EXTERNALSYM NERR_ProcNoRespond} + NERR_SpoolerNotLoaded = (NERR_BASE+61); // The spooler is not running. + {$EXTERNALSYM NERR_SpoolerNotLoaded} + NERR_DestInvalidState = (NERR_BASE+62); // This operation cannot be performed on the print destination in its current state. + {$EXTERNALSYM NERR_DestInvalidState} + NERR_QInvalidState = (NERR_BASE+63); // This operation cannot be performed on the printer queue in its current state. + {$EXTERNALSYM NERR_QInvalidState} + NERR_JobInvalidState = (NERR_BASE+64); // This operation cannot be performed on the print job in its current state. + {$EXTERNALSYM NERR_JobInvalidState} + NERR_SpoolNoMemory = (NERR_BASE+65); // A spooler memory allocation failure occurred. + {$EXTERNALSYM NERR_SpoolNoMemory} + NERR_DriverNotFound = (NERR_BASE+66); // The device driver does not exist. + {$EXTERNALSYM NERR_DriverNotFound} + NERR_DataTypeInvalid = (NERR_BASE+67); // The data type is not supported by the print processor. + {$EXTERNALSYM NERR_DataTypeInvalid} + NERR_ProcNotFound = (NERR_BASE+68); // The print processor is not installed. + {$EXTERNALSYM NERR_ProcNotFound} + +// +// Service API related +// Error codes from BASE+80 to BASE+99 + + + NERR_ServiceTableLocked = (NERR_BASE+80); // The service database is locked. + {$EXTERNALSYM NERR_ServiceTableLocked} + NERR_ServiceTableFull = (NERR_BASE+81); // The service table is full. + {$EXTERNALSYM NERR_ServiceTableFull} + NERR_ServiceInstalled = (NERR_BASE+82); // The requested service has already been started. + {$EXTERNALSYM NERR_ServiceInstalled} + NERR_ServiceEntryLocked = (NERR_BASE+83); // The service does not respond to control actions. + {$EXTERNALSYM NERR_ServiceEntryLocked} + NERR_ServiceNotInstalled = (NERR_BASE+84); // The service has not been started. + {$EXTERNALSYM NERR_ServiceNotInstalled} + NERR_BadServiceName = (NERR_BASE+85); // The service name is invalid. + {$EXTERNALSYM NERR_BadServiceName} + NERR_ServiceCtlTimeout = (NERR_BASE+86); // The service is not responding to the control function. + {$EXTERNALSYM NERR_ServiceCtlTimeout} + NERR_ServiceCtlBusy = (NERR_BASE+87); // The service control is busy. + {$EXTERNALSYM NERR_ServiceCtlBusy} + NERR_BadServiceProgName = (NERR_BASE+88); // The configuration file contains an invalid service program name. + {$EXTERNALSYM NERR_BadServiceProgName} + NERR_ServiceNotCtrl = (NERR_BASE+89); // The service could not be controlled in its present state. + {$EXTERNALSYM NERR_ServiceNotCtrl} + NERR_ServiceKillProc = (NERR_BASE+90); // The service ended abnormally. + {$EXTERNALSYM NERR_ServiceKillProc} + NERR_ServiceCtlNotValid = (NERR_BASE+91); // The requested pause,continue, or stop is not valid for this service. + {$EXTERNALSYM NERR_ServiceCtlNotValid} + NERR_NotInDispatchTbl = (NERR_BASE+92); // The service control dispatcher could not find the service name in the dispatch table. + {$EXTERNALSYM NERR_NotInDispatchTbl} + NERR_BadControlRecv = (NERR_BASE+93); // The service control dispatcher pipe read failed. + {$EXTERNALSYM NERR_BadControlRecv} + NERR_ServiceNotStarting = (NERR_BASE+94); // A thread for the new service could not be created. + {$EXTERNALSYM NERR_ServiceNotStarting} + +// +// Wksta and Logon API related +// Error codes from BASE+100 to BASE+118 + + + NERR_AlreadyLoggedOn = (NERR_BASE+100); // This workstation is already logged on to the local-area network. + {$EXTERNALSYM NERR_AlreadyLoggedOn} + NERR_NotLoggedOn = (NERR_BASE+101); // The workstation is not logged on to the local-area network. + {$EXTERNALSYM NERR_NotLoggedOn} + NERR_BadUsername = (NERR_BASE+102); // The user name or group name parameter is invalid. + {$EXTERNALSYM NERR_BadUsername} + NERR_BadPassword = (NERR_BASE+103); // The password parameter is invalid. + {$EXTERNALSYM NERR_BadPassword} + NERR_UnableToAddName_W = (NERR_BASE+104); // @W The logon processor did not add the message alias. + {$EXTERNALSYM NERR_UnableToAddName_W} + NERR_UnableToAddName_F = (NERR_BASE+105); // The logon processor did not add the message alias. + {$EXTERNALSYM NERR_UnableToAddName_F} + NERR_UnableToDelName_W = (NERR_BASE+106); // @W The logoff processor did not delete the message alias. + {$EXTERNALSYM NERR_UnableToDelName_W} + NERR_UnableToDelName_F = (NERR_BASE+107); // The logoff processor did not delete the message alias. + {$EXTERNALSYM NERR_UnableToDelName_F} +// UNUSED BASE+108 + NERR_LogonsPaused = (NERR_BASE+109); // Network logons are paused. + {$EXTERNALSYM NERR_LogonsPaused} + NERR_LogonServerConflict = (NERR_BASE+110); // A centralized logon-server conflict occurred. + {$EXTERNALSYM NERR_LogonServerConflict} + NERR_LogonNoUserPath = (NERR_BASE+111); // The server is configured without a valid user path. + {$EXTERNALSYM NERR_LogonNoUserPath} + NERR_LogonScriptError = (NERR_BASE+112); // An error occurred while loading or running the logon script. + {$EXTERNALSYM NERR_LogonScriptError} +// UNUSED BASE+113 + NERR_StandaloneLogon = (NERR_BASE+114); // The logon server was not specified. Your computer will be logged on as STANDALONE. + {$EXTERNALSYM NERR_StandaloneLogon} + NERR_LogonServerNotFound = (NERR_BASE+115); // The logon server could not be found. + {$EXTERNALSYM NERR_LogonServerNotFound} + NERR_LogonDomainExists = (NERR_BASE+116); // There is already a logon domain for this computer. + {$EXTERNALSYM NERR_LogonDomainExists} + NERR_NonValidatedLogon = (NERR_BASE+117); // The logon server could not validate the logon. + {$EXTERNALSYM NERR_NonValidatedLogon} + +// +// ACF API related (access, user, group) +// Error codes from BASE+119 to BASE+149 + + + NERR_ACFNotFound = (NERR_BASE+119); // The security database could not be found. + {$EXTERNALSYM NERR_ACFNotFound} + NERR_GroupNotFound = (NERR_BASE+120); // The group name could not be found. + {$EXTERNALSYM NERR_GroupNotFound} + NERR_UserNotFound = (NERR_BASE+121); // The user name could not be found. + {$EXTERNALSYM NERR_UserNotFound} + NERR_ResourceNotFound = (NERR_BASE+122); // The resource name could not be found. + {$EXTERNALSYM NERR_ResourceNotFound} + NERR_GroupExists = (NERR_BASE+123); // The group already exists. + {$EXTERNALSYM NERR_GroupExists} + NERR_UserExists = (NERR_BASE+124); // The account already exists. + {$EXTERNALSYM NERR_UserExists} + NERR_ResourceExists = (NERR_BASE+125); // The resource permission list already exists. + {$EXTERNALSYM NERR_ResourceExists} + NERR_NotPrimary = (NERR_BASE+126); // This operation is only allowed on the primary domain controller of the domain. + {$EXTERNALSYM NERR_NotPrimary} + NERR_ACFNotLoaded = (NERR_BASE+127); // The security database has not been started. + {$EXTERNALSYM NERR_ACFNotLoaded} + NERR_ACFNoRoom = (NERR_BASE+128); // There are too many names in the user accounts database. + {$EXTERNALSYM NERR_ACFNoRoom} + NERR_ACFFileIOFail = (NERR_BASE+129); // A disk I/O failure occurred. + {$EXTERNALSYM NERR_ACFFileIOFail} + NERR_ACFTooManyLists = (NERR_BASE+130); // The limit of 64 entries per resource was exceeded. + {$EXTERNALSYM NERR_ACFTooManyLists} + NERR_UserLogon = (NERR_BASE+131); // Deleting a user with a session is not allowed. + {$EXTERNALSYM NERR_UserLogon} + NERR_ACFNoParent = (NERR_BASE+132); // The parent directory could not be located. + {$EXTERNALSYM NERR_ACFNoParent} + NERR_CanNotGrowSegment = (NERR_BASE+133); // Unable to add to the security database session cache segment. + {$EXTERNALSYM NERR_CanNotGrowSegment} + NERR_SpeGroupOp = (NERR_BASE+134); // This operation is not allowed on this special group. + {$EXTERNALSYM NERR_SpeGroupOp} + NERR_NotInCache = (NERR_BASE+135); // This user is not cached in user accounts database session cache. + {$EXTERNALSYM NERR_NotInCache} + NERR_UserInGroup = (NERR_BASE+136); // The user already belongs to this group. + {$EXTERNALSYM NERR_UserInGroup} + NERR_UserNotInGroup = (NERR_BASE+137); // The user does not belong to this group. + {$EXTERNALSYM NERR_UserNotInGroup} + NERR_AccountUndefined = (NERR_BASE+138); // This user account is undefined. + {$EXTERNALSYM NERR_AccountUndefined} + NERR_AccountExpired = (NERR_BASE+139); // This user account has expired. + {$EXTERNALSYM NERR_AccountExpired} + NERR_InvalidWorkstation = (NERR_BASE+140); // The user is not allowed to log on from this workstation. + {$EXTERNALSYM NERR_InvalidWorkstation} + NERR_InvalidLogonHours = (NERR_BASE+141); // The user is not allowed to log on at this time. + {$EXTERNALSYM NERR_InvalidLogonHours} + NERR_PasswordExpired = (NERR_BASE+142); // The password of this user has expired. + {$EXTERNALSYM NERR_PasswordExpired} + NERR_PasswordCantChange = (NERR_BASE+143); // The password of this user cannot change. + {$EXTERNALSYM NERR_PasswordCantChange} + NERR_PasswordHistConflict = (NERR_BASE+144); // This password cannot be used now. + {$EXTERNALSYM NERR_PasswordHistConflict} + NERR_PasswordTooShort = (NERR_BASE+145); // The password does not meet the password policy requirements. Check the minimum password length, password complexity and password history requirements. + {$EXTERNALSYM NERR_PasswordTooShort} + NERR_PasswordTooRecent = (NERR_BASE+146); // The password of this user is too recent to change. + {$EXTERNALSYM NERR_PasswordTooRecent} + NERR_InvalidDatabase = (NERR_BASE+147); // The security database is corrupted. + {$EXTERNALSYM NERR_InvalidDatabase} + NERR_DatabaseUpToDate = (NERR_BASE+148); // No updates are necessary to this replicant network/local security database. + {$EXTERNALSYM NERR_DatabaseUpToDate} + NERR_SyncRequired = (NERR_BASE+149); // This replicant database is outdated; synchronization is required. + {$EXTERNALSYM NERR_SyncRequired} + +// +// Use API related +// Error codes from BASE+150 to BASE+169 + + + NERR_UseNotFound = (NERR_BASE+150); // The network connection could not be found. + {$EXTERNALSYM NERR_UseNotFound} + NERR_BadAsgType = (NERR_BASE+151); // This asg_type is invalid. + {$EXTERNALSYM NERR_BadAsgType} + NERR_DeviceIsShared = (NERR_BASE+152); // This device is currently being shared. + {$EXTERNALSYM NERR_DeviceIsShared} + +// +// Message Server related +// Error codes BASE+170 to BASE+209 + + + NERR_NoComputerName = (NERR_BASE+170); // The computer name could not be added as a message alias. The name may already exist on the network. + {$EXTERNALSYM NERR_NoComputerName} + NERR_MsgAlreadyStarted = (NERR_BASE+171); // The Messenger service is already started. + {$EXTERNALSYM NERR_MsgAlreadyStarted} + NERR_MsgInitFailed = (NERR_BASE+172); // The Messenger service failed to start. + {$EXTERNALSYM NERR_MsgInitFailed} + NERR_NameNotFound = (NERR_BASE+173); // The message alias could not be found on the network. + {$EXTERNALSYM NERR_NameNotFound} + NERR_AlreadyForwarded = (NERR_BASE+174); // This message alias has already been forwarded. + {$EXTERNALSYM NERR_AlreadyForwarded} + NERR_AddForwarded = (NERR_BASE+175); // This message alias has been added but is still forwarded. + {$EXTERNALSYM NERR_AddForwarded} + NERR_AlreadyExists = (NERR_BASE+176); // This message alias already exists locally. + {$EXTERNALSYM NERR_AlreadyExists} + NERR_TooManyNames = (NERR_BASE+177); // The maximum number of added message aliases has been exceeded. + {$EXTERNALSYM NERR_TooManyNames} + NERR_DelComputerName = (NERR_BASE+178); // The computer name could not be deleted. + {$EXTERNALSYM NERR_DelComputerName} + NERR_LocalForward = (NERR_BASE+179); // Messages cannot be forwarded back to the same workstation. + {$EXTERNALSYM NERR_LocalForward} + NERR_GrpMsgProcessor = (NERR_BASE+180); // An error occurred in the domain message processor. + {$EXTERNALSYM NERR_GrpMsgProcessor} + NERR_PausedRemote = (NERR_BASE+181); // The message was sent, but the recipient has paused the Messenger service. + {$EXTERNALSYM NERR_PausedRemote} + NERR_BadReceive = (NERR_BASE+182); // The message was sent but not received. + {$EXTERNALSYM NERR_BadReceive} + NERR_NameInUse = (NERR_BASE+183); // The message alias is currently in use. Try again later. + {$EXTERNALSYM NERR_NameInUse} + NERR_MsgNotStarted = (NERR_BASE+184); // The Messenger service has not been started. + {$EXTERNALSYM NERR_MsgNotStarted} + NERR_NotLocalName = (NERR_BASE+185); // The name is not on the local computer. + {$EXTERNALSYM NERR_NotLocalName} + NERR_NoForwardName = (NERR_BASE+186); // The forwarded message alias could not be found on the network. + {$EXTERNALSYM NERR_NoForwardName} + NERR_RemoteFull = (NERR_BASE+187); // The message alias table on the remote station is full. + {$EXTERNALSYM NERR_RemoteFull} + NERR_NameNotForwarded = (NERR_BASE+188); // Messages for this alias are not currently being forwarded. + {$EXTERNALSYM NERR_NameNotForwarded} + NERR_TruncatedBroadcast = (NERR_BASE+189); // The broadcast message was truncated. + {$EXTERNALSYM NERR_TruncatedBroadcast} + NERR_InvalidDevice = (NERR_BASE+194); // This is an invalid device name. + {$EXTERNALSYM NERR_InvalidDevice} + NERR_WriteFault = (NERR_BASE+195); // A write fault occurred. + {$EXTERNALSYM NERR_WriteFault} +// UNUSED BASE+196 + NERR_DuplicateName = (NERR_BASE+197); // A duplicate message alias exists on the network. + {$EXTERNALSYM NERR_DuplicateName} + NERR_DeleteLater = (NERR_BASE+198); // @W This message alias will be deleted later. + {$EXTERNALSYM NERR_DeleteLater} + NERR_IncompleteDel = (NERR_BASE+199); // The message alias was not successfully deleted from all networks. + {$EXTERNALSYM NERR_IncompleteDel} + NERR_MultipleNets = (NERR_BASE+200); // This operation is not supported on computers with multiple networks. + {$EXTERNALSYM NERR_MultipleNets} + +// +// Server API related +// Error codes BASE+210 to BASE+229 + + + NERR_NetNameNotFound = (NERR_BASE+210); // This shared resource does not exist. + {$EXTERNALSYM NERR_NetNameNotFound} + NERR_DeviceNotShared = (NERR_BASE+211); // This device is not shared. + {$EXTERNALSYM NERR_DeviceNotShared} + NERR_ClientNameNotFound = (NERR_BASE+212); // A session does not exist with that computer name. + {$EXTERNALSYM NERR_ClientNameNotFound} + NERR_FileIdNotFound = (NERR_BASE+214); // There is not an open file with that identification number. + {$EXTERNALSYM NERR_FileIdNotFound} + NERR_ExecFailure = (NERR_BASE+215); // A failure occurred when executing a remote administration command. + {$EXTERNALSYM NERR_ExecFailure} + NERR_TmpFile = (NERR_BASE+216); // A failure occurred when opening a remote temporary file. + {$EXTERNALSYM NERR_TmpFile} + NERR_TooMuchData = (NERR_BASE+217); // The data returned from a remote administration command has been truncated to 64K. + {$EXTERNALSYM NERR_TooMuchData} + NERR_DeviceShareConflict = (NERR_BASE+218); // This device cannot be shared as both a spooled and a non-spooled resource. + {$EXTERNALSYM NERR_DeviceShareConflict} + NERR_BrowserTableIncomplete = (NERR_BASE+219); // The information in the list of servers may be incorrect. + {$EXTERNALSYM NERR_BrowserTableIncomplete} + NERR_NotLocalDomain = (NERR_BASE+220); // The computer is not active in this domain. + {$EXTERNALSYM NERR_NotLocalDomain} + NERR_IsDfsShare = (NERR_BASE+221); // The share must be removed from the Distributed File System before it can be deleted. + {$EXTERNALSYM NERR_IsDfsShare} + +// +// CharDev API related +// Error codes BASE+230 to BASE+249 + + +// UNUSED BASE+230 + NERR_DevInvalidOpCode = (NERR_BASE+231); // The operation is invalid for this device. + {$EXTERNALSYM NERR_DevInvalidOpCode} + NERR_DevNotFound = (NERR_BASE+232); // This device cannot be shared. + {$EXTERNALSYM NERR_DevNotFound} + NERR_DevNotOpen = (NERR_BASE+233); // This device was not open. + {$EXTERNALSYM NERR_DevNotOpen} + NERR_BadQueueDevString = (NERR_BASE+234); // This device name list is invalid. + {$EXTERNALSYM NERR_BadQueueDevString} + NERR_BadQueuePriority = (NERR_BASE+235); // The queue priority is invalid. + {$EXTERNALSYM NERR_BadQueuePriority} + NERR_NoCommDevs = (NERR_BASE+237); // There are no shared communication devices. + {$EXTERNALSYM NERR_NoCommDevs} + NERR_QueueNotFound = (NERR_BASE+238); // The queue you specified does not exist. + {$EXTERNALSYM NERR_QueueNotFound} + NERR_BadDevString = (NERR_BASE+240); // This list of devices is invalid. + {$EXTERNALSYM NERR_BadDevString} + NERR_BadDev = (NERR_BASE+241); // The requested device is invalid. + {$EXTERNALSYM NERR_BadDev} + NERR_InUseBySpooler = (NERR_BASE+242); // This device is already in use by the spooler. + {$EXTERNALSYM NERR_InUseBySpooler} + NERR_CommDevInUse = (NERR_BASE+243); // This device is already in use as a communication device. + {$EXTERNALSYM NERR_CommDevInUse} + +// +// NetICanonicalize and NetIType and NetIMakeLMFileName +// NetIListCanon and NetINameCheck +// Error codes BASE+250 to BASE+269 + + + NERR_InvalidComputer = (NERR_BASE+251); // This computer name is invalid. + {$EXTERNALSYM NERR_InvalidComputer} +// UNUSED BASE+252 +// UNUSED BASE+253 + NERR_MaxLenExceeded = (NERR_BASE+254); // The string and prefix specified are too long. + {$EXTERNALSYM NERR_MaxLenExceeded} +// UNUSED BASE+255 + NERR_BadComponent = (NERR_BASE+256); // This path component is invalid. + {$EXTERNALSYM NERR_BadComponent} + NERR_CantType = (NERR_BASE+257); // Could not determine the type of input. + {$EXTERNALSYM NERR_CantType} +// UNUSED BASE+258 +// UNUSED BASE+259 + NERR_TooManyEntries = (NERR_BASE+262); // The buffer for types is not big enough. + {$EXTERNALSYM NERR_TooManyEntries} + +// +// NetProfile +// Error codes BASE+270 to BASE+276 + + + NERR_ProfileFileTooBig = (NERR_BASE+270); // Profile files cannot exceed 64K. + {$EXTERNALSYM NERR_ProfileFileTooBig} + NERR_ProfileOffset = (NERR_BASE+271); // The start offset is out of range. + {$EXTERNALSYM NERR_ProfileOffset} + NERR_ProfileCleanup = (NERR_BASE+272); // The system cannot delete current connections to network resources. + {$EXTERNALSYM NERR_ProfileCleanup} + NERR_ProfileUnknownCmd = (NERR_BASE+273); // The system was unable to parse the command line in this file. + {$EXTERNALSYM NERR_ProfileUnknownCmd} + NERR_ProfileLoadErr = (NERR_BASE+274); // An error occurred while loading the profile file. + {$EXTERNALSYM NERR_ProfileLoadErr} + NERR_ProfileSaveErr = (NERR_BASE+275); // @W Errors occurred while saving the profile file. The profile was partially saved. + {$EXTERNALSYM NERR_ProfileSaveErr} + + +// +// NetAudit and NetErrorLog +// Error codes BASE+277 to BASE+279 + + + NERR_LogOverflow = (NERR_BASE+277); // Log file %1 is full. + {$EXTERNALSYM NERR_LogOverflow} + NERR_LogFileChanged = (NERR_BASE+278); // This log file has changed between reads. + {$EXTERNALSYM NERR_LogFileChanged} + NERR_LogFileCorrupt = (NERR_BASE+279); // Log file %1 is corrupt. + {$EXTERNALSYM NERR_LogFileCorrupt} + + +// +// NetRemote +// Error codes BASE+280 to BASE+299 + + NERR_SourceIsDir = (NERR_BASE+280); // The source path cannot be a directory. + {$EXTERNALSYM NERR_SourceIsDir} + NERR_BadSource = (NERR_BASE+281); // The source path is illegal. + {$EXTERNALSYM NERR_BadSource} + NERR_BadDest = (NERR_BASE+282); // The destination path is illegal. + {$EXTERNALSYM NERR_BadDest} + NERR_DifferentServers = (NERR_BASE+283); // The source and destination paths are on different servers. + {$EXTERNALSYM NERR_DifferentServers} +// UNUSED BASE+284 + NERR_RunSrvPaused = (NERR_BASE+285); // The Run server you requested is paused. + {$EXTERNALSYM NERR_RunSrvPaused} +// UNUSED BASE+286 +// UNUSED BASE+287 +// UNUSED BASE+288 + NERR_ErrCommRunSrv = (NERR_BASE+289); // An error occurred when communicating with a Run server. + {$EXTERNALSYM NERR_ErrCommRunSrv} +// UNUSED BASE+290 + NERR_ErrorExecingGhost = (NERR_BASE+291); // An error occurred when starting a background process. + {$EXTERNALSYM NERR_ErrorExecingGhost} + NERR_ShareNotFound = (NERR_BASE+292); // The shared resource you are connected to could not be found. + {$EXTERNALSYM NERR_ShareNotFound} +// UNUSED BASE+293 +// UNUSED BASE+294 + + +// +// NetWksta.sys (redir) returned error codes. +// +// NERR_BASE + (300-329) + + + NERR_InvalidLana = (NERR_BASE+300); // The LAN adapter number is invalid. + {$EXTERNALSYM NERR_InvalidLana} + NERR_OpenFiles = (NERR_BASE+301); // There are open files on the connection. + {$EXTERNALSYM NERR_OpenFiles} + NERR_ActiveConns = (NERR_BASE+302); // Active connections still exist. + {$EXTERNALSYM NERR_ActiveConns} + NERR_BadPasswordCore = (NERR_BASE+303); // This share name or password is invalid. + {$EXTERNALSYM NERR_BadPasswordCore} + NERR_DevInUse = (NERR_BASE+304); // The device is being accessed by an active process. + {$EXTERNALSYM NERR_DevInUse} + NERR_LocalDrive = (NERR_BASE+305); // The drive letter is in use locally. + {$EXTERNALSYM NERR_LocalDrive} + +// +// Alert error codes. +// +// NERR_BASE + (330-339) + + NERR_AlertExists = (NERR_BASE+330); // The specified client is already registered for the specified event. + {$EXTERNALSYM NERR_AlertExists} + NERR_TooManyAlerts = (NERR_BASE+331); // The alert table is full. + {$EXTERNALSYM NERR_TooManyAlerts} + NERR_NoSuchAlert = (NERR_BASE+332); // An invalid or nonexistent alert name was raised. + {$EXTERNALSYM NERR_NoSuchAlert} + NERR_BadRecipient = (NERR_BASE+333); // The alert recipient is invalid. + {$EXTERNALSYM NERR_BadRecipient} + NERR_AcctLimitExceeded = (NERR_BASE+334); // A user's session with this server has been deleted + {$EXTERNALSYM NERR_AcctLimitExceeded} + // because the user's logon hours are no longer valid. + +// +// Additional Error and Audit log codes. +// +// NERR_BASE +(340-343) + + NERR_InvalidLogSeek = (NERR_BASE+340); // The log file does not contain the requested record number. + {$EXTERNALSYM NERR_InvalidLogSeek} +// UNUSED BASE+341 +// UNUSED BASE+342 +// UNUSED BASE+343 + +// +// Additional UAS and NETLOGON codes +// +// NERR_BASE +(350-359) + + NERR_BadUasConfig = (NERR_BASE+350); // The user accounts database is not configured correctly. + {$EXTERNALSYM NERR_BadUasConfig} + NERR_InvalidUASOp = (NERR_BASE+351); // This operation is not permitted when the Netlogon service is running. + {$EXTERNALSYM NERR_InvalidUASOp} + NERR_LastAdmin = (NERR_BASE+352); // This operation is not allowed on the last administrative account. + {$EXTERNALSYM NERR_LastAdmin} + NERR_DCNotFound = (NERR_BASE+353); // Could not find domain controller for this domain. + {$EXTERNALSYM NERR_DCNotFound} + NERR_LogonTrackingError = (NERR_BASE+354); // Could not set logon information for this user. + {$EXTERNALSYM NERR_LogonTrackingError} + NERR_NetlogonNotStarted = (NERR_BASE+355); // The Netlogon service has not been started. + {$EXTERNALSYM NERR_NetlogonNotStarted} + NERR_CanNotGrowUASFile = (NERR_BASE+356); // Unable to add to the user accounts database. + {$EXTERNALSYM NERR_CanNotGrowUASFile} + NERR_TimeDiffAtDC = (NERR_BASE+357); // This server's clock is not synchronized with the primary domain controller's clock. + {$EXTERNALSYM NERR_TimeDiffAtDC} + NERR_PasswordMismatch = (NERR_BASE+358); // A password mismatch has been detected. + {$EXTERNALSYM NERR_PasswordMismatch} + + +// +// Server Integration error codes. +// +// NERR_BASE +(360-369) + + NERR_NoSuchServer = (NERR_BASE+360); // The server identification does not specify a valid server. + {$EXTERNALSYM NERR_NoSuchServer} + NERR_NoSuchSession = (NERR_BASE+361); // The session identification does not specify a valid session. + {$EXTERNALSYM NERR_NoSuchSession} + NERR_NoSuchConnection = (NERR_BASE+362); // The connection identification does not specify a valid connection. + {$EXTERNALSYM NERR_NoSuchConnection} + NERR_TooManyServers = (NERR_BASE+363); // There is no space for another entry in the table of available servers. + {$EXTERNALSYM NERR_TooManyServers} + NERR_TooManySessions = (NERR_BASE+364); // The server has reached the maximum number of sessions it supports. + {$EXTERNALSYM NERR_TooManySessions} + NERR_TooManyConnections = (NERR_BASE+365); // The server has reached the maximum number of connections it supports. + {$EXTERNALSYM NERR_TooManyConnections} + NERR_TooManyFiles = (NERR_BASE+366); // The server cannot open more files because it has reached its maximum number. + {$EXTERNALSYM NERR_TooManyFiles} + NERR_NoAlternateServers = (NERR_BASE+367); // There are no alternate servers registered on this server. + {$EXTERNALSYM NERR_NoAlternateServers} +// UNUSED BASE+368 +// UNUSED BASE+369 + + NERR_TryDownLevel = (NERR_BASE+370); // Try down-level (remote admin protocol) version of API instead. + {$EXTERNALSYM NERR_TryDownLevel} + +// +// UPS error codes. +// +// NERR_BASE + (380-384) + + NERR_UPSDriverNotStarted = (NERR_BASE+380); // The UPS driver could not be accessed by the UPS service. + {$EXTERNALSYM NERR_UPSDriverNotStarted} + NERR_UPSInvalidConfig = (NERR_BASE+381); // The UPS service is not configured correctly. + {$EXTERNALSYM NERR_UPSInvalidConfig} + NERR_UPSInvalidCommPort = (NERR_BASE+382); // The UPS service could not access the specified Comm Port. + {$EXTERNALSYM NERR_UPSInvalidCommPort} + NERR_UPSSignalAsserted = (NERR_BASE+383); // The UPS indicated a line fail or low battery situation. Service not started. + {$EXTERNALSYM NERR_UPSSignalAsserted} + NERR_UPSShutdownFailed = (NERR_BASE+384); // The UPS service failed to perform a system shut down. + {$EXTERNALSYM NERR_UPSShutdownFailed} + +// +// Remoteboot error codes. +// +// NERR_BASE + (400-419) +// Error codes 400 - 405 are used by RPLBOOT.SYS. +// Error codes 403, 407 - 416 are used by RPLLOADR.COM, +// Error code 417 is the alerter message of REMOTEBOOT (RPLSERVR.EXE). +// Error code 418 is for when REMOTEBOOT can't start +// Error code 419 is for a disallowed 2nd rpl connection +// + + NERR_BadDosRetCode = (NERR_BASE+400); // The program below returned an MS-DOS error code: + {$EXTERNALSYM NERR_BadDosRetCode} + NERR_ProgNeedsExtraMem = (NERR_BASE+401); // The program below needs more memory: + {$EXTERNALSYM NERR_ProgNeedsExtraMem} + NERR_BadDosFunction = (NERR_BASE+402); // The program below called an unsupported MS-DOS function: + {$EXTERNALSYM NERR_BadDosFunction} + NERR_RemoteBootFailed = (NERR_BASE+403); // The workstation failed to boot. + {$EXTERNALSYM NERR_RemoteBootFailed} + NERR_BadFileCheckSum = (NERR_BASE+404); // The file below is corrupt. + {$EXTERNALSYM NERR_BadFileCheckSum} + NERR_NoRplBootSystem = (NERR_BASE+405); // No loader is specified in the boot-block definition file. + {$EXTERNALSYM NERR_NoRplBootSystem} + NERR_RplLoadrNetBiosErr = (NERR_BASE+406); // NetBIOS returned an error: The NCB and SMB are dumped above. + {$EXTERNALSYM NERR_RplLoadrNetBiosErr} + NERR_RplLoadrDiskErr = (NERR_BASE+407); // A disk I/O error occurred. + {$EXTERNALSYM NERR_RplLoadrDiskErr} + NERR_ImageParamErr = (NERR_BASE+408); // Image parameter substitution failed. + {$EXTERNALSYM NERR_ImageParamErr} + NERR_TooManyImageParams = (NERR_BASE+409); // Too many image parameters cross disk sector boundaries. + {$EXTERNALSYM NERR_TooManyImageParams} + NERR_NonDosFloppyUsed = (NERR_BASE+410); // The image was not generated from an MS-DOS diskette formatted with /S. + {$EXTERNALSYM NERR_NonDosFloppyUsed} + NERR_RplBootRestart = (NERR_BASE+411); // Remote boot will be restarted later. + {$EXTERNALSYM NERR_RplBootRestart} + NERR_RplSrvrCallFailed = (NERR_BASE+412); // The call to the Remoteboot server failed. + {$EXTERNALSYM NERR_RplSrvrCallFailed} + NERR_CantConnectRplSrvr = (NERR_BASE+413); // Cannot connect to the Remoteboot server. + {$EXTERNALSYM NERR_CantConnectRplSrvr} + NERR_CantOpenImageFile = (NERR_BASE+414); // Cannot open image file on the Remoteboot server. + {$EXTERNALSYM NERR_CantOpenImageFile} + NERR_CallingRplSrvr = (NERR_BASE+415); // Connecting to the Remoteboot server... + {$EXTERNALSYM NERR_CallingRplSrvr} + NERR_StartingRplBoot = (NERR_BASE+416); // Connecting to the Remoteboot server... + {$EXTERNALSYM NERR_StartingRplBoot} + NERR_RplBootServiceTerm = (NERR_BASE+417); // Remote boot service was stopped; check the error log for the cause of the problem. + {$EXTERNALSYM NERR_RplBootServiceTerm} + NERR_RplBootStartFailed = (NERR_BASE+418); // Remote boot startup failed; check the error log for the cause of the problem. + {$EXTERNALSYM NERR_RplBootStartFailed} + NERR_RPL_CONNECTED = (NERR_BASE+419); // A second connection to a Remoteboot resource is not allowed. + {$EXTERNALSYM NERR_RPL_CONNECTED} + +// +// FTADMIN API error codes +// +// NERR_BASE + (425-434) +// +// (Currently not used in NT) +// + + +// +// Browser service API error codes +// +// NERR_BASE + (450-475) +// + + NERR_BrowserConfiguredToNotRun = (NERR_BASE+450); // The browser service was configured with MaintainServerList=No. + {$EXTERNALSYM NERR_BrowserConfiguredToNotRun} + +// +// Additional Remoteboot error codes. +// +// NERR_BASE + (510-550) + + NERR_RplNoAdaptersStarted = (NERR_BASE+510); // Service failed to start since none of the network adapters started with this service. + {$EXTERNALSYM NERR_RplNoAdaptersStarted} + NERR_RplBadRegistry = (NERR_BASE+511); // Service failed to start due to bad startup information in the registry. + {$EXTERNALSYM NERR_RplBadRegistry} + NERR_RplBadDatabase = (NERR_BASE+512); // Service failed to start because its database is absent or corrupt. + {$EXTERNALSYM NERR_RplBadDatabase} + NERR_RplRplfilesShare = (NERR_BASE+513); // Service failed to start because RPLFILES share is absent. + {$EXTERNALSYM NERR_RplRplfilesShare} + NERR_RplNotRplServer = (NERR_BASE+514); // Service failed to start because RPLUSER group is absent. + {$EXTERNALSYM NERR_RplNotRplServer} + NERR_RplCannotEnum = (NERR_BASE+515); // Cannot enumerate service records. + {$EXTERNALSYM NERR_RplCannotEnum} + NERR_RplWkstaInfoCorrupted = (NERR_BASE+516); // Workstation record information has been corrupted. + {$EXTERNALSYM NERR_RplWkstaInfoCorrupted} + NERR_RplWkstaNotFound = (NERR_BASE+517); // Workstation record was not found. + {$EXTERNALSYM NERR_RplWkstaNotFound} + NERR_RplWkstaNameUnavailable = (NERR_BASE+518); // Workstation name is in use by some other workstation. + {$EXTERNALSYM NERR_RplWkstaNameUnavailable} + NERR_RplProfileInfoCorrupted = (NERR_BASE+519); // Profile record information has been corrupted. + {$EXTERNALSYM NERR_RplProfileInfoCorrupted} + NERR_RplProfileNotFound = (NERR_BASE+520); // Profile record was not found. + {$EXTERNALSYM NERR_RplProfileNotFound} + NERR_RplProfileNameUnavailable = (NERR_BASE+521); // Profile name is in use by some other profile. + {$EXTERNALSYM NERR_RplProfileNameUnavailable} + NERR_RplProfileNotEmpty = (NERR_BASE+522); // There are workstations using this profile. + {$EXTERNALSYM NERR_RplProfileNotEmpty} + NERR_RplConfigInfoCorrupted = (NERR_BASE+523); // Configuration record information has been corrupted. + {$EXTERNALSYM NERR_RplConfigInfoCorrupted} + NERR_RplConfigNotFound = (NERR_BASE+524); // Configuration record was not found. + {$EXTERNALSYM NERR_RplConfigNotFound} + NERR_RplAdapterInfoCorrupted = (NERR_BASE+525); // Adapter id record information has been corrupted. + {$EXTERNALSYM NERR_RplAdapterInfoCorrupted} + NERR_RplInternal = (NERR_BASE+526); // An internal service error has occurred. + {$EXTERNALSYM NERR_RplInternal} + NERR_RplVendorInfoCorrupted = (NERR_BASE+527); // Vendor id record information has been corrupted. + {$EXTERNALSYM NERR_RplVendorInfoCorrupted} + NERR_RplBootInfoCorrupted = (NERR_BASE+528); // Boot block record information has been corrupted. + {$EXTERNALSYM NERR_RplBootInfoCorrupted} + NERR_RplWkstaNeedsUserAcct = (NERR_BASE+529); // The user account for this workstation record is missing. + {$EXTERNALSYM NERR_RplWkstaNeedsUserAcct} + NERR_RplNeedsRPLUSERAcct = (NERR_BASE+530); // The RPLUSER local group could not be found. + {$EXTERNALSYM NERR_RplNeedsRPLUSERAcct} + NERR_RplBootNotFound = (NERR_BASE+531); // Boot block record was not found. + {$EXTERNALSYM NERR_RplBootNotFound} + NERR_RplIncompatibleProfile = (NERR_BASE+532); // Chosen profile is incompatible with this workstation. + {$EXTERNALSYM NERR_RplIncompatibleProfile} + NERR_RplAdapterNameUnavailable = (NERR_BASE+533); // Chosen network adapter id is in use by some other workstation. + {$EXTERNALSYM NERR_RplAdapterNameUnavailable} + NERR_RplConfigNotEmpty = (NERR_BASE+534); // There are profiles using this configuration. + {$EXTERNALSYM NERR_RplConfigNotEmpty} + NERR_RplBootInUse = (NERR_BASE+535); // There are workstations, profiles or configurations using this boot block. + {$EXTERNALSYM NERR_RplBootInUse} + NERR_RplBackupDatabase = (NERR_BASE+536); // Service failed to backup Remoteboot database. + {$EXTERNALSYM NERR_RplBackupDatabase} + NERR_RplAdapterNotFound = (NERR_BASE+537); // Adapter record was not found. + {$EXTERNALSYM NERR_RplAdapterNotFound} + NERR_RplVendorNotFound = (NERR_BASE+538); // Vendor record was not found. + {$EXTERNALSYM NERR_RplVendorNotFound} + NERR_RplVendorNameUnavailable = (NERR_BASE+539); // Vendor name is in use by some other vendor record. + {$EXTERNALSYM NERR_RplVendorNameUnavailable} + NERR_RplBootNameUnavailable = (NERR_BASE+540); // (boot name, vendor id) is in use by some other boot block record. + {$EXTERNALSYM NERR_RplBootNameUnavailable} + NERR_RplConfigNameUnavailable = (NERR_BASE+541); // Configuration name is in use by some other configuration. + {$EXTERNALSYM NERR_RplConfigNameUnavailable} + +//*INTERNAL_ONLY* + +// +// Dfs API error codes. +// +// NERR_BASE + (560-590) + + + NERR_DfsInternalCorruption = (NERR_BASE+560); // The internal database maintained by the DFS service is corrupt + {$EXTERNALSYM NERR_DfsInternalCorruption} + NERR_DfsVolumeDataCorrupt = (NERR_BASE+561); // One of the records in the internal DFS database is corrupt + {$EXTERNALSYM NERR_DfsVolumeDataCorrupt} + NERR_DfsNoSuchVolume = (NERR_BASE+562); // There is no DFS name whose entry path matches the input Entry Path + {$EXTERNALSYM NERR_DfsNoSuchVolume} + NERR_DfsVolumeAlreadyExists = (NERR_BASE+563); // A root or link with the given name already exists + {$EXTERNALSYM NERR_DfsVolumeAlreadyExists} + NERR_DfsAlreadyShared = (NERR_BASE+564); // The server share specified is already shared in the DFS + {$EXTERNALSYM NERR_DfsAlreadyShared} + NERR_DfsNoSuchShare = (NERR_BASE+565); // The indicated server share does not support the indicated DFS namespace + {$EXTERNALSYM NERR_DfsNoSuchShare} + NERR_DfsNotALeafVolume = (NERR_BASE+566); // The operation is not valid on this portion of the namespace + {$EXTERNALSYM NERR_DfsNotALeafVolume} + NERR_DfsLeafVolume = (NERR_BASE+567); // The operation is not valid on this portion of the namespace + {$EXTERNALSYM NERR_DfsLeafVolume} + NERR_DfsVolumeHasMultipleServers = (NERR_BASE+568); // The operation is ambiguous because the link has multiple servers + {$EXTERNALSYM NERR_DfsVolumeHasMultipleServers} + NERR_DfsCantCreateJunctionPoint = (NERR_BASE+569); // Unable to create a link + {$EXTERNALSYM NERR_DfsCantCreateJunctionPoint} + NERR_DfsServerNotDfsAware = (NERR_BASE+570); // The server is not DFS Aware + {$EXTERNALSYM NERR_DfsServerNotDfsAware} + NERR_DfsBadRenamePath = (NERR_BASE+571); // The specified rename target path is invalid + {$EXTERNALSYM NERR_DfsBadRenamePath} + NERR_DfsVolumeIsOffline = (NERR_BASE+572); // The specified DFS link is offline + {$EXTERNALSYM NERR_DfsVolumeIsOffline} + NERR_DfsNoSuchServer = (NERR_BASE+573); // The specified server is not a server for this link + {$EXTERNALSYM NERR_DfsNoSuchServer} + NERR_DfsCyclicalName = (NERR_BASE+574); // A cycle in the DFS name was detected + {$EXTERNALSYM NERR_DfsCyclicalName} + NERR_DfsNotSupportedInServerDfs = (NERR_BASE+575); // The operation is not supported on a server-based DFS + {$EXTERNALSYM NERR_DfsNotSupportedInServerDfs} + NERR_DfsDuplicateService = (NERR_BASE+576); // This link is already supported by the specified server-share + {$EXTERNALSYM NERR_DfsDuplicateService} + NERR_DfsCantRemoveLastServerShare = (NERR_BASE+577); // Can't remove the last server-share supporting this root or link + {$EXTERNALSYM NERR_DfsCantRemoveLastServerShare} + NERR_DfsVolumeIsInterDfs = (NERR_BASE+578); // The operation is not supported for an Inter-DFS link + {$EXTERNALSYM NERR_DfsVolumeIsInterDfs} + NERR_DfsInconsistent = (NERR_BASE+579); // The internal state of the DFS Service has become inconsistent + {$EXTERNALSYM NERR_DfsInconsistent} + NERR_DfsServerUpgraded = (NERR_BASE+580); // The DFS Service has been installed on the specified server + {$EXTERNALSYM NERR_DfsServerUpgraded} + NERR_DfsDataIsIdentical = (NERR_BASE+581); // The DFS data being reconciled is identical + {$EXTERNALSYM NERR_DfsDataIsIdentical} + NERR_DfsCantRemoveDfsRoot = (NERR_BASE+582); // The DFS root cannot be deleted - Uninstall DFS if required + {$EXTERNALSYM NERR_DfsCantRemoveDfsRoot} + NERR_DfsChildOrParentInDfs = (NERR_BASE+583); // A child or parent directory of the share is already in a DFS + {$EXTERNALSYM NERR_DfsChildOrParentInDfs} + NERR_DfsInternalError = (NERR_BASE+590); // DFS internal error + {$EXTERNALSYM NERR_DfsInternalError} + +// +// Net setup error codes. +// +// NERR_BASE + (591-600) + + NERR_SetupAlreadyJoined = (NERR_BASE+591); // This machine is already joined to a domain. + {$EXTERNALSYM NERR_SetupAlreadyJoined} + NERR_SetupNotJoined = (NERR_BASE+592); // This machine is not currently joined to a domain. + {$EXTERNALSYM NERR_SetupNotJoined} + NERR_SetupDomainController = (NERR_BASE+593); // This machine is a domain controller and cannot be unjoined from a domain. + {$EXTERNALSYM NERR_SetupDomainController} + NERR_DefaultJoinRequired = (NERR_BASE+594); // The destination domain controller does not support creating machine accounts in OUs. + {$EXTERNALSYM NERR_DefaultJoinRequired} + NERR_InvalidWorkgroupName = (NERR_BASE+595); // The specified workgroup name is invalid. + {$EXTERNALSYM NERR_InvalidWorkgroupName} + NERR_NameUsesIncompatibleCodePage = (NERR_BASE+596); // The specified computer name is incompatible with the default language used on the domain controller. + {$EXTERNALSYM NERR_NameUsesIncompatibleCodePage} + NERR_ComputerAccountNotFound = (NERR_BASE+597); // The specified computer account could not be found. + {$EXTERNALSYM NERR_ComputerAccountNotFound} + NERR_PersonalSku = (NERR_BASE+598); // This version of Windows cannot be joined to a domain. + {$EXTERNALSYM NERR_PersonalSku} + +// +// Some Password and account error results +// +// NERR_BASE + (601 - 608) +// + + NERR_PasswordMustChange = (NERR_BASE + 601); // Password must change at next logon + {$EXTERNALSYM NERR_PasswordMustChange} + NERR_AccountLockedOut = (NERR_BASE + 602); // Account is locked out + {$EXTERNALSYM NERR_AccountLockedOut} + NERR_PasswordTooLong = (NERR_BASE + 603); // Password is too long + {$EXTERNALSYM NERR_PasswordTooLong} + NERR_PasswordNotComplexEnough = (NERR_BASE + 604); // Password doesn't meet the complexity policy + {$EXTERNALSYM NERR_PasswordNotComplexEnough} + NERR_PasswordFilterError = (NERR_BASE + 605); // Password doesn't meet the requirements of the filter dll's + {$EXTERNALSYM NERR_PasswordFilterError} + +//**********WARNING **************** +//The range 2750-2799 has been * +//allocated to the IBM LAN Server * +//********************************* + +//**********WARNING **************** +//The range 2900-2999 has been * +//reserved for Microsoft OEMs * +//********************************* + +//*END_INTERNAL* + + MAX_NERR = (NERR_BASE+899); // This is the last error in NERR range. + {$EXTERNALSYM MAX_NERR} + +// +// end of list +// +// WARNING: Do not exceed MAX_NERR; values above this are used by +// other error code ranges (errlog.h, service.h, apperr.h). + +// JwaLmCons, complete +// LAN Manager common definitions + +const + NetApi32 = 'netapi32.dll'; + +// +// NOTE: Lengths of strings are given as the maximum lengths of the +// string in characters (not bytes). This does not include space for the +// terminating 0-characters. When allocating space for such an item, +// use the form: +// +// TCHAR username[UNLEN+1]; +// +// Definitions of the form LN20_* define those values in effect for +// LanMan 2.0. +// + +// +// String Lengths for various LanMan names +// + +const + CNLEN = 15; // Computer name length + {$EXTERNALSYM CNLEN} + LM20_CNLEN = 15; // LM 2.0 Computer name length + {$EXTERNALSYM LM20_CNLEN} + DNLEN = CNLEN; // Maximum domain name length + {$EXTERNALSYM DNLEN} + LM20_DNLEN = LM20_CNLEN; // LM 2.0 Maximum domain name length + {$EXTERNALSYM LM20_DNLEN} + +//#if (CNLEN != DNLEN) +//#error CNLEN and DNLEN are not equal +//#endif + + UNCLEN = (CNLEN+2); // UNC computer name length + {$EXTERNALSYM UNCLEN} + LM20_UNCLEN = (LM20_CNLEN+2); // LM 2.0 UNC computer name length + {$EXTERNALSYM LM20_UNCLEN} + + NNLEN = 80; // Net name length (share name) + {$EXTERNALSYM NNLEN} + LM20_NNLEN = 12; // LM 2.0 Net name length + {$EXTERNALSYM LM20_NNLEN} + + RMLEN = (UNCLEN+1+NNLEN); // Max remote name length + {$EXTERNALSYM RMLEN} + LM20_RMLEN = (LM20_UNCLEN+1+LM20_NNLEN); // LM 2.0 Max remote name length + {$EXTERNALSYM LM20_RMLEN} + + SNLEN = 80; // Service name length + {$EXTERNALSYM SNLEN} + LM20_SNLEN = 15; // LM 2.0 Service name length + {$EXTERNALSYM LM20_SNLEN} + STXTLEN = 256; // Service text length + {$EXTERNALSYM STXTLEN} + LM20_STXTLEN = 63; // LM 2.0 Service text length + {$EXTERNALSYM LM20_STXTLEN} + + PATHLEN = 256; // Max. path (not including drive name) + {$EXTERNALSYM PATHLEN} + LM20_PATHLEN = 256; // LM 2.0 Max. path + {$EXTERNALSYM LM20_PATHLEN} + + DEVLEN = 80; // Device name length + {$EXTERNALSYM DEVLEN} + LM20_DEVLEN = 8; // LM 2.0 Device name length + {$EXTERNALSYM LM20_DEVLEN} + + EVLEN = 16; // Event name length + {$EXTERNALSYM EVLEN} + +// +// User, Group and Password lengths +// + + UNLEN = 256; // Maximum user name length + {$EXTERNALSYM UNLEN} + LM20_UNLEN = 20; // LM 2.0 Maximum user name length + {$EXTERNALSYM LM20_UNLEN} + + GNLEN = UNLEN; // Group name + {$EXTERNALSYM GNLEN} + LM20_GNLEN = LM20_UNLEN; // LM 2.0 Group name + {$EXTERNALSYM LM20_GNLEN} + + PWLEN = 256; // Maximum password length + {$EXTERNALSYM PWLEN} + LM20_PWLEN = 14; // LM 2.0 Maximum password length + {$EXTERNALSYM LM20_PWLEN} + + SHPWLEN = 8; // Share password length (bytes) + {$EXTERNALSYM SHPWLEN} + + CLTYPE_LEN = 12; // Length of client type string + {$EXTERNALSYM CLTYPE_LEN} + + MAXCOMMENTSZ = 256; // Multipurpose comment length + {$EXTERNALSYM MAXCOMMENTSZ} + LM20_MAXCOMMENTSZ = 48; // LM 2.0 Multipurpose comment length + {$EXTERNALSYM LM20_MAXCOMMENTSZ} + + QNLEN = NNLEN; // Queue name maximum length + {$EXTERNALSYM QNLEN} + LM20_QNLEN = LM20_NNLEN; // LM 2.0 Queue name maximum length + {$EXTERNALSYM LM20_QNLEN} + +//#if (QNLEN != NNLEN) +//# error QNLEN and NNLEN are not equal +//#endif + +// +// The ALERTSZ and MAXDEVENTRIES defines have not yet been NT'ized. +// Whoever ports these components should change these values appropriately. +// + + ALERTSZ = 128; // size of alert string in server + {$EXTERNALSYM ALERTSZ} + MAXDEVENTRIES = (SizeOf(Integer)*8); // Max number of device entries + {$EXTERNALSYM MAXDEVENTRIES} + + // + // We use int bitmap to represent + // + + NETBIOS_NAME_LEN = 16; // NetBIOS net name (bytes) + {$EXTERNALSYM NETBIOS_NAME_LEN} + +// +// Value to be used with APIs which have a "preferred maximum length" +// parameter. This value indicates that the API should just allocate +// "as much as it takes." +// + + MAX_PREFERRED_LENGTH = DWORD(-1); + {$EXTERNALSYM MAX_PREFERRED_LENGTH} + +// +// Constants used with encryption +// + + CRYPT_KEY_LEN = 7; + {$EXTERNALSYM CRYPT_KEY_LEN} + CRYPT_TXT_LEN = 8; + {$EXTERNALSYM CRYPT_TXT_LEN} + ENCRYPTED_PWLEN = 16; + {$EXTERNALSYM ENCRYPTED_PWLEN} + SESSION_PWLEN = 24; + {$EXTERNALSYM SESSION_PWLEN} + SESSION_CRYPT_KLEN = 21; + {$EXTERNALSYM SESSION_CRYPT_KLEN} + +// +// Value to be used with SetInfo calls to allow setting of all +// settable parameters (parmnum zero option) +// + + PARMNUM_ALL = 0; + {$EXTERNALSYM PARMNUM_ALL} + + PARM_ERROR_UNKNOWN = DWORD(-1); + {$EXTERNALSYM PARM_ERROR_UNKNOWN} + PARM_ERROR_NONE = 0; + {$EXTERNALSYM PARM_ERROR_NONE} + PARMNUM_BASE_INFOLEVEL = 1000; + {$EXTERNALSYM PARMNUM_BASE_INFOLEVEL} + +// +// Only the UNICODE version of the LM APIs are available on NT. +// Non-UNICODE version on other platforms +// + +//#if defined( _WIN32_WINNT ) || defined( WINNT ) || defined( FORCE_UNICODE ) + +{$IFDEF _WIN32_WINNT} +{$DEFINE LM_USE_UNICODE} +{$ENDIF} + +{$IFDEF FORCE_UNICODE} +{$DEFINE LM_USE_UNICODE} +{$ENDIF} + +{$IFDEF LM_USE_UNICODE} + +type + LMSTR = LPWSTR; + {$EXTERNALSYM LMSTR} + LMCSTR = LPCWSTR; + {$EXTERNALSYM LMCSTR} + PLMSTR = ^LMSTR; + {$NODEFINE PLMSTR} + +{$ELSE ~LM_USE_UNICODE} + +type + LMSTR = LPSTR; + {$EXTERNALSYM LMSTR} + LMCSTR = LPCSTR; + {$EXTERNALSYM LMCSTR} + +{$ENDIF ~LM_USE_UNICODE} + +// +// Message File Names +// + +const + MESSAGE_FILENAME = 'NETMSG'; + {$EXTERNALSYM MESSAGE_FILENAME} + OS2MSG_FILENAME = 'BASE'; + {$EXTERNALSYM OS2MSG_FILENAME} + HELP_MSG_FILENAME = 'NETH'; + {$EXTERNALSYM HELP_MSG_FILENAME} + +// ** INTERNAL_ONLY ** + +// The backup message file named here is a duplicate of net.msg. It +// is not shipped with the product, but is used at buildtime to +// msgbind certain messages to netapi.dll and some of the services. +// This allows for OEMs to modify the message text in net.msg and +// have those changes show up. Only in case there is an error in +// retrieving the messages from net.msg do we then get the bound +// messages out of bak.msg (really out of the message segment). + + BACKUP_MSG_FILENAME = 'BAK.MSG'; + {$EXTERNALSYM BACKUP_MSG_FILENAME} + +// ** END_INTERNAL ** + +// +// Keywords used in Function Prototypes +// + +type + NET_API_STATUS = DWORD; + {$EXTERNALSYM NET_API_STATUS} + TNetApiStatus = NET_API_STATUS; + +// +// The platform ID indicates the levels to use for platform-specific +// information. +// + +const + PLATFORM_ID_DOS = 300; + {$EXTERNALSYM PLATFORM_ID_DOS} + PLATFORM_ID_OS2 = 400; + {$EXTERNALSYM PLATFORM_ID_OS2} + PLATFORM_ID_NT = 500; + {$EXTERNALSYM PLATFORM_ID_NT} + PLATFORM_ID_OSF = 600; + {$EXTERNALSYM PLATFORM_ID_OSF} + PLATFORM_ID_VMS = 700; + {$EXTERNALSYM PLATFORM_ID_VMS} + +// +// There message numbers assigned to different LANMAN components +// are as defined below. +// +// lmerr.h: 2100 - 2999 NERR_BASE +// alertmsg.h: 3000 - 3049 ALERT_BASE +// lmsvc.h: 3050 - 3099 SERVICE_BASE +// lmerrlog.h: 3100 - 3299 ERRLOG_BASE +// msgtext.h: 3300 - 3499 MTXT_BASE +// apperr.h: 3500 - 3999 APPERR_BASE +// apperrfs.h: 4000 - 4299 APPERRFS_BASE +// apperr2.h: 4300 - 5299 APPERR2_BASE +// ncberr.h: 5300 - 5499 NRCERR_BASE +// alertmsg.h: 5500 - 5599 ALERT2_BASE +// lmsvc.h: 5600 - 5699 SERVICE2_BASE +// lmerrlog.h 5700 - 5899 ERRLOG2_BASE +// + + MIN_LANMAN_MESSAGE_ID = NERR_BASE; + {$EXTERNALSYM MIN_LANMAN_MESSAGE_ID} + MAX_LANMAN_MESSAGE_ID = 5899; + {$EXTERNALSYM MAX_LANMAN_MESSAGE_ID} + +// line 59 + +// +// Function Prototypes - User +// + + +function NetUserAdd(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetUserAdd} + +function NetUserEnum(servername: LPCWSTR; level, filter: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries, resume_handle: LPDWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetUserEnum} + +function NetUserGetInfo(servername, username: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetUserGetInfo} + +function NetUserSetInfo(servername, username: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetUserSetInfo} + +function NetUserDel(servername: LPCWSTR; username: LPCWSTR): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetUserDel} + +function NetUserGetGroups(servername, username: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetUserGetGroups} + +function NetUserSetGroups(servername, username: LPCWSTR; level: DWORD; buf: PByte; num_entries: DWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetUserSetGroups} + +function NetUserGetLocalGroups(servername, username: LPCWSTR; level, flags: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetUserGetLocalGroups} + +function NetUserModalsGet(servername: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetUserModalsGet} + +function NetUserModalsSet(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetUserModalsSet} + +function NetUserChangePassword(domainname, username, oldpassword, newpassword: LPCWSTR): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetUserChangePassword} + + +// +// Data Structures - User +// + +type + {$IFNDEF FPC} + LPUSER_INFO_0 = ^USER_INFO_0; + {$EXTERNALSYM LPUSER_INFO_0} + PUSER_INFO_0 = ^USER_INFO_0; + {$EXTERNALSYM PUSER_INFO_0} + _USER_INFO_0 = record + usri0_name: LPWSTR; + end; + {$EXTERNALSYM _USER_INFO_0} + USER_INFO_0 = _USER_INFO_0; + {$EXTERNALSYM USER_INFO_0} + TUserInfo0 = USER_INFO_0; + PUserInfo0 = PUSER_INFO_0; + {$ENDIF ~FPC} + + LPUSER_INFO_1 = ^USER_INFO_1; + {$EXTERNALSYM LPUSER_INFO_1} + PUSER_INFO_1 = ^USER_INFO_1; + {$EXTERNALSYM PUSER_INFO_1} + _USER_INFO_1 = record + usri1_name: LPWSTR; + usri1_password: LPWSTR; + usri1_password_age: DWORD; + usri1_priv: DWORD; + usri1_home_dir: LPWSTR; + usri1_comment: LPWSTR; + usri1_flags: DWORD; + usri1_script_path: LPWSTR; + end; + {$EXTERNALSYM _USER_INFO_1} + USER_INFO_1 = _USER_INFO_1; + {$EXTERNALSYM USER_INFO_1} + TUserInfo1 = USER_INFO_1; + PUserInfo1 = PUSER_INFO_1; + + {$IFNDEF FPC} + LPUSER_INFO_2 = ^USER_INFO_2; + {$EXTERNALSYM LPUSER_INFO_2} + PUSER_INFO_2 = ^USER_INFO_2; + {$EXTERNALSYM PUSER_INFO_2} + _USER_INFO_2 = record + usri2_name: LPWSTR; + usri2_password: LPWSTR; + usri2_password_age: DWORD; + usri2_priv: DWORD; + usri2_home_dir: LPWSTR; + usri2_comment: LPWSTR; + usri2_flags: DWORD; + usri2_script_path: LPWSTR; + usri2_auth_flags: DWORD; + usri2_full_name: LPWSTR; + usri2_usr_comment: LPWSTR; + usri2_parms: LPWSTR; + usri2_workstations: LPWSTR; + usri2_last_logon: DWORD; + usri2_last_logoff: DWORD; + usri2_acct_expires: DWORD; + usri2_max_storage: DWORD; + usri2_units_per_week: DWORD; + usri2_logon_hours: PBYTE; + usri2_bad_pw_count: DWORD; + usri2_num_logons: DWORD; + usri2_logon_server: LPWSTR; + usri2_country_code: DWORD; + usri2_code_page: DWORD; + end; + {$EXTERNALSYM _USER_INFO_2} + USER_INFO_2 = _USER_INFO_2; + {$EXTERNALSYM USER_INFO_2} + TUserInfo2 = USER_INFO_2; + PUserInfo2 = puser_info_2; + {$ENDIF ~FPC} + +// line 799 + +// +// Special Values and Constants - User +// + +// +// Bit masks for field usriX_flags of USER_INFO_X (X = 0/1). +// + +const + UF_SCRIPT = $0001; + {$EXTERNALSYM UF_SCRIPT} + UF_ACCOUNTDISABLE = $0002; + {$EXTERNALSYM UF_ACCOUNTDISABLE} + UF_HOMEDIR_REQUIRED = $0008; + {$EXTERNALSYM UF_HOMEDIR_REQUIRED} + UF_LOCKOUT = $0010; + {$EXTERNALSYM UF_LOCKOUT} + UF_PASSWD_NOTREQD = $0020; + {$EXTERNALSYM UF_PASSWD_NOTREQD} + UF_PASSWD_CANT_CHANGE = $0040; + {$EXTERNALSYM UF_PASSWD_CANT_CHANGE} + UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED = $0080; + {$EXTERNALSYM UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED} + +// +// Account type bits as part of usri_flags. +// + + UF_TEMP_DUPLICATE_ACCOUNT = $0100; + {$EXTERNALSYM UF_TEMP_DUPLICATE_ACCOUNT} + UF_NORMAL_ACCOUNT = $0200; + {$EXTERNALSYM UF_NORMAL_ACCOUNT} + UF_INTERDOMAIN_TRUST_ACCOUNT = $0800; + {$EXTERNALSYM UF_INTERDOMAIN_TRUST_ACCOUNT} + UF_WORKSTATION_TRUST_ACCOUNT = $1000; + {$EXTERNALSYM UF_WORKSTATION_TRUST_ACCOUNT} + UF_SERVER_TRUST_ACCOUNT = $2000; + {$EXTERNALSYM UF_SERVER_TRUST_ACCOUNT} + + UF_MACHINE_ACCOUNT_MASK = UF_INTERDOMAIN_TRUST_ACCOUNT or UF_WORKSTATION_TRUST_ACCOUNT or UF_SERVER_TRUST_ACCOUNT; + {$EXTERNALSYM UF_MACHINE_ACCOUNT_MASK} + + UF_ACCOUNT_TYPE_MASK = UF_TEMP_DUPLICATE_ACCOUNT or UF_NORMAL_ACCOUNT or + UF_INTERDOMAIN_TRUST_ACCOUNT or UF_WORKSTATION_TRUST_ACCOUNT or UF_SERVER_TRUST_ACCOUNT; + {$EXTERNALSYM UF_ACCOUNT_TYPE_MASK} + + UF_DONT_EXPIRE_PASSWD = $10000; + {$EXTERNALSYM UF_DONT_EXPIRE_PASSWD} + UF_MNS_LOGON_ACCOUNT = $20000; + {$EXTERNALSYM UF_MNS_LOGON_ACCOUNT} + UF_SMARTCARD_REQUIRED = $40000; + {$EXTERNALSYM UF_SMARTCARD_REQUIRED} + UF_TRUSTED_FOR_DELEGATION = $80000; + {$EXTERNALSYM UF_TRUSTED_FOR_DELEGATION} + UF_NOT_DELEGATED = $100000; + {$EXTERNALSYM UF_NOT_DELEGATED} + UF_USE_DES_KEY_ONLY = $200000; + {$EXTERNALSYM UF_USE_DES_KEY_ONLY} + UF_DONT_REQUIRE_PREAUTH = $400000; + {$EXTERNALSYM UF_DONT_REQUIRE_PREAUTH} + UF_PASSWORD_EXPIRED = DWORD($800000); + {$EXTERNALSYM UF_PASSWORD_EXPIRED} + UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION = $1000000; + {$EXTERNALSYM UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION} + + + UF_SETTABLE_BITS = + UF_SCRIPT or + UF_ACCOUNTDISABLE or + UF_LOCKOUT or + UF_HOMEDIR_REQUIRED or + UF_PASSWD_NOTREQD or + UF_PASSWD_CANT_CHANGE or + UF_ACCOUNT_TYPE_MASK or + UF_DONT_EXPIRE_PASSWD or + UF_MNS_LOGON_ACCOUNT or + UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED or + UF_SMARTCARD_REQUIRED or + UF_TRUSTED_FOR_DELEGATION or + UF_NOT_DELEGATED or + UF_USE_DES_KEY_ONLY or + UF_DONT_REQUIRE_PREAUTH or + UF_PASSWORD_EXPIRED or + UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION; + {$EXTERNALSYM UF_SETTABLE_BITS} + +// line 1056 + +// +// For SetInfo call (parmnum 0) when password change not required +// + + NULL_USERSETINFO_PASSWD = ' '; + {$EXTERNALSYM NULL_USERSETINFO_PASSWD} + + TIMEQ_FOREVER = ULONG(-1); + {$EXTERNALSYM TIMEQ_FOREVER} + USER_MAXSTORAGE_UNLIMITED = ULONG(-1); + {$EXTERNALSYM USER_MAXSTORAGE_UNLIMITED} + USER_NO_LOGOFF = ULONG(-1); + {$EXTERNALSYM USER_NO_LOGOFF} + UNITS_PER_DAY = 24; + {$EXTERNALSYM UNITS_PER_DAY} + UNITS_PER_WEEK = UNITS_PER_DAY * 7; + {$EXTERNALSYM UNITS_PER_WEEK} + +// +// Privilege levels (USER_INFO_X field usriX_priv (X = 0/1)). +// + + USER_PRIV_MASK = $3; + {$EXTERNALSYM USER_PRIV_MASK} + USER_PRIV_GUEST = 0; + {$EXTERNALSYM USER_PRIV_GUEST} + USER_PRIV_USER = 1; + {$EXTERNALSYM USER_PRIV_USER} + USER_PRIV_ADMIN = 2; + {$EXTERNALSYM USER_PRIV_ADMIN} + +// line 1177 + +// +// Group Class +// + +// +// Function Prototypes +// + + +function NetGroupAdd(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetGroupAdd} + +function NetGroupAddUser(servername, GroupName, username: LPCWSTR): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetGroupAddUser} + +function NetGroupEnum(servername: LPCWSTR; level: DWORD; out bufptr: PByte; + prefmaxlen: DWORD; out entriesread, totalentries: DWORD; resume_handle: PDWORD_PTR): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetGroupEnum} + +function NetGroupGetInfo(servername, groupname: LPCWSTR; level: DWORD; bufptr: PByte): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetGroupGetInfo} + +function NetGroupSetInfo(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetGroupSetInfo} + +function NetGroupDel(servername: LPCWSTR; groupname: LPCWSTR): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetGroupDel} + +function NetGroupDelUser(servername: LPCWSTR; GroupName: LPCWSTR; Username: LPCWSTR): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetGroupDelUser} + +function NetGroupGetUsers(servername, groupname: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD; ResumeHandle: PDWORD_PTR): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetGroupGetUsers} + +function NetGroupSetUsers(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetGroupSetUsers} + + +// +// Data Structures - Group +// + +type + LPGROUP_INFO_0 = ^GROUP_INFO_0; + {$EXTERNALSYM LPGROUP_INFO_0} + PGROUP_INFO_0 = ^GROUP_INFO_0; + {$EXTERNALSYM PGROUP_INFO_0} + _GROUP_INFO_0 = record + grpi0_name: LPWSTR; + end; + {$EXTERNALSYM _GROUP_INFO_0} + GROUP_INFO_0 = _GROUP_INFO_0; + {$EXTERNALSYM GROUP_INFO_0} + TGroupInfo0 = GROUP_INFO_0; + PGroupInfo0 = PGROUP_INFO_0; + + LPGROUP_INFO_1 = ^GROUP_INFO_1; + {$EXTERNALSYM LPGROUP_INFO_1} + PGROUP_INFO_1 = ^GROUP_INFO_1; + {$EXTERNALSYM PGROUP_INFO_1} + _GROUP_INFO_1 = record + grpi1_name: LPWSTR; + grpi1_comment: LPWSTR; + end; + {$EXTERNALSYM _GROUP_INFO_1} + GROUP_INFO_1 = _GROUP_INFO_1; + {$EXTERNALSYM GROUP_INFO_1} + TGroupInfo1 = GROUP_INFO_1; + PGroupInfo1 = PGROUP_INFO_1; + +// line 1380 + +// +// LocalGroup Class +// + +// +// Function Prototypes +// + + +function NetLocalGroupAdd(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetLocalGroupAdd} + +function NetLocalGroupAddMember(servername, groupname: LPCWSTR; membersid: PSID): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetLocalGroupAddMember} + +function NetLocalGroupEnum(servername: LPCWSTR; level: DWORD; out bufptr: PByte; + prefmaxlen: DWORD; out entriesread, totalentries: DWORD; resumehandle: PDWORD_PTR): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetLocalGroupEnum} + +function NetLocalGroupGetInfo(servername, groupname: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetLocalGroupGetInfo} + +function NetLocalGroupSetInfo(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetLocalGroupSetInfo} + +function NetLocalGroupDel(servername: LPCWSTR; groupname: LPCWSTR): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetLocalGroupDel} + +function NetLocalGroupDelMember(servername: LPCWSTR; groupname: LPCWSTR; membersid: PSID): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetLocalGroupDelMember} + +function NetLocalGroupGetMembers(servername, localgroupname: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD; resumehandle: PDWORD_PTR): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetLocalGroupGetMembers} + +function NetLocalGroupSetMembers(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetLocalGroupSetMembers} + +function NetLocalGroupAddMembers(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetLocalGroupAddMembers} + +function NetLocalGroupDelMembers(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetLocalGroupDelMembers} + + +// +// Data Structures - LocalGroup +// + +type + {$IFNDEF FPC} + LPLOCALGROUP_INFO_0 = ^LOCALGROUP_INFO_0; + {$EXTERNALSYM LPLOCALGROUP_INFO_0} + PLOCALGROUP_INFO_0 = ^LOCALGROUP_INFO_0; + {$EXTERNALSYM PLOCALGROUP_INFO_0} + _LOCALGROUP_INFO_0 = record + lgrpi0_name: LPWSTR; + end; + {$EXTERNALSYM _LOCALGROUP_INFO_0} + LOCALGROUP_INFO_0 = _LOCALGROUP_INFO_0; + {$EXTERNALSYM LOCALGROUP_INFO_0} + TLocalGroupInfo0 = LOCALGROUP_INFO_0; + PLocalGroupInfo0 = PLOCALGROUP_INFO_0; + {$ENDIF ~FPC} + + LPLOCALGROUP_INFO_1 = ^LOCALGROUP_INFO_1; + {$EXTERNALSYM LPLOCALGROUP_INFO_1} + PLOCALGROUP_INFO_1 = ^LOCALGROUP_INFO_1; + {$EXTERNALSYM PLOCALGROUP_INFO_1} + _LOCALGROUP_INFO_1 = record + lgrpi1_name: LPWSTR; + lgrpi1_comment: LPWSTR; + end; + {$EXTERNALSYM _LOCALGROUP_INFO_1} + LOCALGROUP_INFO_1 = _LOCALGROUP_INFO_1; + {$EXTERNALSYM LOCALGROUP_INFO_1} + TLocalGroupInfo1 = LOCALGROUP_INFO_1; + PLocalGroupInfo1 = PLOCALGROUP_INFO_1; + + LPLOCALGROUP_INFO_1002 = ^LOCALGROUP_INFO_1002; + {$EXTERNALSYM LPLOCALGROUP_INFO_1002} + PLOCALGROUP_INFO_1002 = ^LOCALGROUP_INFO_1002; + {$EXTERNALSYM PLOCALGROUP_INFO_1002} + _LOCALGROUP_INFO_1002 = record + lgrpi1002_comment: LPWSTR; + end; + {$EXTERNALSYM _LOCALGROUP_INFO_1002} + LOCALGROUP_INFO_1002 = _LOCALGROUP_INFO_1002; + {$EXTERNALSYM LOCALGROUP_INFO_1002} + TLocalGroupInfo1002 = LOCALGROUP_INFO_1002; + PLocalGroupInfo1002 = PLOCALGROUP_INFO_1002; + + {$IFNDEF FPC} + LPLOCALGROUP_MEMBERS_INFO_0 = ^LOCALGROUP_MEMBERS_INFO_0; + {$EXTERNALSYM LPLOCALGROUP_MEMBERS_INFO_0} + PLOCALGROUP_MEMBERS_INFO_0 = ^LOCALGROUP_MEMBERS_INFO_0; + {$EXTERNALSYM PLOCALGROUP_MEMBERS_INFO_0} + _LOCALGROUP_MEMBERS_INFO_0 = record + lgrmi0_sid: PSID; + end; + {$EXTERNALSYM _LOCALGROUP_MEMBERS_INFO_0} + LOCALGROUP_MEMBERS_INFO_0 = _LOCALGROUP_MEMBERS_INFO_0; + {$EXTERNALSYM LOCALGROUP_MEMBERS_INFO_0} + TLocalGroupMembersInfo0 = LOCALGROUP_MEMBERS_INFO_0; + PLocalGroupMembersInfo0 = PLOCALGROUP_MEMBERS_INFO_0; + {$ENDIF ~FPC} + + LPLOCALGROUP_MEMBERS_INFO_1 = ^LOCALGROUP_MEMBERS_INFO_1; + {$EXTERNALSYM LPLOCALGROUP_MEMBERS_INFO_1} + PLOCALGROUP_MEMBERS_INFO_1 = ^LOCALGROUP_MEMBERS_INFO_1; + {$EXTERNALSYM PLOCALGROUP_MEMBERS_INFO_1} + _LOCALGROUP_MEMBERS_INFO_1 = record + lgrmi1_sid: PSID; + lgrmi1_sidusage: SID_NAME_USE; + lgrmi1_name: LPWSTR; + end; + {$EXTERNALSYM _LOCALGROUP_MEMBERS_INFO_1} + LOCALGROUP_MEMBERS_INFO_1 = _LOCALGROUP_MEMBERS_INFO_1; + {$EXTERNALSYM LOCALGROUP_MEMBERS_INFO_1} + TLocalGroupMembersInfo1 = LOCALGROUP_MEMBERS_INFO_1; + PLocalGroupMembersInfo1 = PLOCALGROUP_MEMBERS_INFO_1; + + LPLOCALGROUP_MEMBERS_INFO_2 = ^LOCALGROUP_MEMBERS_INFO_2; + {$EXTERNALSYM LPLOCALGROUP_MEMBERS_INFO_2} + PLOCALGROUP_MEMBERS_INFO_2 = ^LOCALGROUP_MEMBERS_INFO_2; + {$EXTERNALSYM PLOCALGROUP_MEMBERS_INFO_2} + _LOCALGROUP_MEMBERS_INFO_2 = record + lgrmi2_sid: PSID; + lgrmi2_sidusage: SID_NAME_USE; + lgrmi2_domainandname: LPWSTR; + end; + {$EXTERNALSYM _LOCALGROUP_MEMBERS_INFO_2} + LOCALGROUP_MEMBERS_INFO_2 = _LOCALGROUP_MEMBERS_INFO_2; + {$EXTERNALSYM LOCALGROUP_MEMBERS_INFO_2} + TLocalGroupMembersInfo2 = LOCALGROUP_MEMBERS_INFO_2; + PLocalGroupMembersInfo2 = PLOCALGROUP_MEMBERS_INFO_2; + + {$IFNDEF FPC} + LPLOCALGROUP_MEMBERS_INFO_3 = ^LOCALGROUP_MEMBERS_INFO_3; + {$EXTERNALSYM LPLOCALGROUP_MEMBERS_INFO_3} + PLOCALGROUP_MEMBERS_INFO_3 = ^LOCALGROUP_MEMBERS_INFO_3; + {$EXTERNALSYM PLOCALGROUP_MEMBERS_INFO_3} + _LOCALGROUP_MEMBERS_INFO_3 = record + lgrmi3_domainandname: LPWSTR; + end; + {$EXTERNALSYM _LOCALGROUP_MEMBERS_INFO_3} + LOCALGROUP_MEMBERS_INFO_3 = _LOCALGROUP_MEMBERS_INFO_3; + {$EXTERNALSYM LOCALGROUP_MEMBERS_INFO_3} + TLocalGroupMembersInfo3 = LOCALGROUP_MEMBERS_INFO_3; + PLocalGroupMembersInfo3 = PLOCALGROUP_MEMBERS_INFO_3; + {$ENDIF ~FPC} + +function NetApiBufferFree(Buffer: Pointer): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetApiBufferFree} + +type + _WKSTA_INFO_100 = record + wki100_platform_id: DWORD; + wki100_computername: LMSTR; + wki100_langroup: LMSTR; + wki100_ver_major: DWORD; + wki100_ver_minor: DWORD; + end; + {$EXTERNALSYM _WKSTA_INFO_100} + WKSTA_INFO_100 = _WKSTA_INFO_100; + {$EXTERNALSYM WKSTA_INFO_100} + PWKSTA_INFO_100 = ^_WKSTA_INFO_100; + {$EXTERNALSYM PWKSTA_INFO_100} + LPWKSTA_INFO_100 = ^_WKSTA_INFO_100; + {$EXTERNALSYM LPWKSTA_INFO_100} + +function NetWkstaGetInfo(servername: PWideChar; level: DWORD; out bufptr: PByte): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetWkstaGetInfo} + +(**************************************************************** + * * + * Data structure templates * + * * + ****************************************************************) + +const + NCBNAMSZ = 16; // absolute length of a net name + {$EXTERNALSYM NCBNAMSZ} + MAX_LANA = 254; // lana's in range 0 to MAX_LANA inclusive + {$EXTERNALSYM MAX_LANA} + +// +// Network Control Block +// + +type + {$IFNDEF FPC} + PNCB = ^NCB; + {$ENDIF ~FPC} + + TNcbPost = procedure (P: PNCB); stdcall; + + {$IFNDEF FPC} + _NCB = record + ncb_command: UCHAR; // command code + ncb_retcode: UCHAR; // return code + ncb_lsn: UCHAR; // local session number + ncb_num: UCHAR; // number of our network name + ncb_buffer: PUCHAR; // address of message buffer + ncb_length: Word; // size of message buffer + ncb_callname: array [0..NCBNAMSZ - 1] of UCHAR; // blank-padded name of remote + ncb_name: array [0..NCBNAMSZ - 1] of UCHAR; // our blank-padded netname + ncb_rto: UCHAR; // rcv timeout/retry count + ncb_sto: UCHAR; // send timeout/sys timeout + ncb_post: TNcbPost; // POST routine address + ncb_lana_num: UCHAR; // lana (adapter) number + ncb_cmd_cplt: UCHAR; // 0xff => commmand pending + {$IFDEF _WIN64} + ncb_reserve: array [0..17] of UCHAR; // reserved, used by BIOS + {$ELSE ~_WIN64} + ncb_reserve: array [0..9] of UCHAR; // reserved, used by BIOS + {$ENDIF ~_WIN64} + ncb_event: THandle; // HANDLE to Win32 event which + // will be set to the signalled + // state when an ASYNCH command + // completes + end; + {$EXTERNALSYM _NCB} + NCB = _NCB; + {$EXTERNALSYM NCB} + TNcb = NCB; + {$ENDIF ~FPC} + +// +// Structure returned to the NCB command NCBASTAT is ADAPTER_STATUS followed +// by an array of NAME_BUFFER structures. +// +{$IFNDEF FPC} +type + _ADAPTER_STATUS = record + adapter_address: array [0..5] of UCHAR; + rev_major: UCHAR; + reserved0: UCHAR; + adapter_type: UCHAR; + rev_minor: UCHAR; + duration: WORD; + frmr_recv: WORD; + frmr_xmit: WORD; + iframe_recv_err: WORD; + xmit_aborts: WORD; + xmit_success: DWORD; + recv_success: DWORD; + iframe_xmit_err: WORD; + recv_buff_unavail: WORD; + t1_timeouts: WORD; + ti_timeouts: WORD; + reserved1: DWORD; + free_ncbs: WORD; + max_cfg_ncbs: WORD; + max_ncbs: WORD; + xmit_buf_unavail: WORD; + max_dgram_size: WORD; + pending_sess: WORD; + max_cfg_sess: WORD; + max_sess: WORD; + max_sess_pkt_size: WORD; + name_count: WORD; + end; + {$EXTERNALSYM _ADAPTER_STATUS} + ADAPTER_STATUS = _ADAPTER_STATUS; + {$EXTERNALSYM ADAPTER_STATUS} + PADAPTER_STATUS = ^ADAPTER_STATUS; + {$EXTERNALSYM PADAPTER_STATUS} + TAdapterStatus = ADAPTER_STATUS; + PAdapterStatus = PADAPTER_STATUS; + + _NAME_BUFFER = record + name: array [0..NCBNAMSZ - 1] of UCHAR; + name_num: UCHAR; + name_flags: UCHAR; + end; + {$EXTERNALSYM _NAME_BUFFER} + NAME_BUFFER = _NAME_BUFFER; + {$EXTERNALSYM NAME_BUFFER} + PNAME_BUFFER = ^NAME_BUFFER; + {$EXTERNALSYM PNAME_BUFFER} + TNameBuffer = NAME_BUFFER; + PNameBuffer = PNAME_BUFFER; +{$ENDIF ~FPC} + +// values for name_flags bits. + +const + NAME_FLAGS_MASK = $87; + {$EXTERNALSYM NAME_FLAGS_MASK} + + GROUP_NAME = $80; + {$EXTERNALSYM GROUP_NAME} + UNIQUE_NAME = $00; + {$EXTERNALSYM UNIQUE_NAME} + + REGISTERING = $00; + {$EXTERNALSYM REGISTERING} + REGISTERED = $04; + {$EXTERNALSYM REGISTERED} + DEREGISTERED = $05; + {$EXTERNALSYM DEREGISTERED} + DUPLICATE = $06; + {$EXTERNALSYM DUPLICATE} + DUPLICATE_DEREG = $07; + {$EXTERNALSYM DUPLICATE_DEREG} + +// +// Structure returned to the NCB command NCBSSTAT is SESSION_HEADER followed +// by an array of SESSION_BUFFER structures. If the NCB_NAME starts with an +// asterisk then an array of these structures is returned containing the +// status for all names. +// + +{$IFNDEF FPC} +type + _SESSION_HEADER = record + sess_name: UCHAR; + num_sess: UCHAR; + rcv_dg_outstanding: UCHAR; + rcv_any_outstanding: UCHAR; + end; + {$EXTERNALSYM _SESSION_HEADER} + SESSION_HEADER = _SESSION_HEADER; + {$EXTERNALSYM SESSION_HEADER} + PSESSION_HEADER = ^SESSION_HEADER; + {$EXTERNALSYM PSESSION_HEADER} + TSessionHeader = SESSION_HEADER; + PSessionHeader = PSESSION_HEADER; + + _SESSION_BUFFER = record + lsn: UCHAR; + state: UCHAR; + local_name: array [0..NCBNAMSZ - 1] of UCHAR; + remote_name: array [0..NCBNAMSZ - 1] of UCHAR; + rcvs_outstanding: UCHAR; + sends_outstanding: UCHAR; + end; + {$EXTERNALSYM _SESSION_BUFFER} + SESSION_BUFFER = _SESSION_BUFFER; + {$EXTERNALSYM SESSION_BUFFER} + PSESSION_BUFFER = ^SESSION_BUFFER; + {$EXTERNALSYM PSESSION_BUFFER} + TSessionBuffer = SESSION_BUFFER; + PSessionBuffer = PSESSION_BUFFER; +{$ENDIF ~FPC} + +// Values for state + +const + LISTEN_OUTSTANDING = $01; + {$EXTERNALSYM LISTEN_OUTSTANDING} + CALL_PENDING = $02; + {$EXTERNALSYM CALL_PENDING} + SESSION_ESTABLISHED = $03; + {$EXTERNALSYM SESSION_ESTABLISHED} + HANGUP_PENDING = $04; + {$EXTERNALSYM HANGUP_PENDING} + HANGUP_COMPLETE = $05; + {$EXTERNALSYM HANGUP_COMPLETE} + SESSION_ABORTED = $06; + {$EXTERNALSYM SESSION_ABORTED} + +// +// Structure returned to the NCB command NCBENUM. +// +// On a system containing lana's 0, 2 and 3, a structure with +// length =3, lana[0]=0, lana[1]=2 and lana[2]=3 will be returned. +// + +{$IFNDEF FPC} +type + _LANA_ENUM = record + length: UCHAR; // Number of valid entries in lana[] + lana: array [0..MAX_LANA] of UCHAR; + end; + {$EXTERNALSYM _LANA_ENUM} + LANA_ENUM = _LANA_ENUM; + {$EXTERNALSYM LANA_ENUM} + PLANA_ENUM = ^LANA_ENUM; + {$EXTERNALSYM PLANA_ENUM} + TLanaEnum = LANA_ENUM; + PLanaEnum = PLANA_ENUM; +{$ENDIF ~FPC} + +// +// Structure returned to the NCB command NCBFINDNAME is FIND_NAME_HEADER followed +// by an array of FIND_NAME_BUFFER structures. +// + +{$IFNDEF FPC} +type + _FIND_NAME_HEADER = record + node_count: WORD; + reserved: UCHAR; + unique_group: UCHAR; + end; + {$EXTERNALSYM _FIND_NAME_HEADER} + FIND_NAME_HEADER = _FIND_NAME_HEADER; + {$EXTERNALSYM FIND_NAME_HEADER} + PFIND_NAME_HEADER = ^FIND_NAME_HEADER; + {$EXTERNALSYM PFIND_NAME_HEADER} + TFindNameHeader = FIND_NAME_HEADER; + PFindNameHeader = PFIND_NAME_HEADER; + + _FIND_NAME_BUFFER = record + length: UCHAR; + access_control: UCHAR; + frame_control: UCHAR; + destination_addr: array [0..5] of UCHAR; + source_addr: array [0..5] of UCHAR; + routing_info: array [0..17] of UCHAR; + end; + {$EXTERNALSYM _FIND_NAME_BUFFER} + FIND_NAME_BUFFER = _FIND_NAME_BUFFER; + {$EXTERNALSYM FIND_NAME_BUFFER} + PFIND_NAME_BUFFER = ^FIND_NAME_BUFFER; + {$EXTERNALSYM PFIND_NAME_BUFFER} + TFindNameBuffer = FIND_NAME_BUFFER; + PFindNameBuffer = PFIND_NAME_BUFFER; + +// +// Structure provided with NCBACTION. The purpose of NCBACTION is to provide +// transport specific extensions to netbios. +// + + _ACTION_HEADER = record + transport_id: ULONG; + action_code: USHORT; + reserved: USHORT; + end; + {$EXTERNALSYM _ACTION_HEADER} + ACTION_HEADER = _ACTION_HEADER; + {$EXTERNALSYM ACTION_HEADER} + PACTION_HEADER = ^ACTION_HEADER; + {$EXTERNALSYM PACTION_HEADER} + TActionHeader = ACTION_HEADER; + PActionHeader = PACTION_HEADER; +{$ENDIF ~FPC} + +// Values for transport_id + +const + ALL_TRANSPORTS = 'M'#0#0#0; + {$EXTERNALSYM ALL_TRANSPORTS} + MS_NBF = 'MNBF'; + {$EXTERNALSYM MS_NBF} + +(**************************************************************** + * * + * Special values and constants * + * * + ****************************************************************) + +// +// NCB Command codes +// + +const + NCBCALL = $10; // NCB CALL + {$EXTERNALSYM NCBCALL} + NCBLISTEN = $11; // NCB LISTEN + {$EXTERNALSYM NCBLISTEN} + NCBHANGUP = $12; // NCB HANG UP + {$EXTERNALSYM NCBHANGUP} + NCBSEND = $14; // NCB SEND + {$EXTERNALSYM NCBSEND} + NCBRECV = $15; // NCB RECEIVE + {$EXTERNALSYM NCBRECV} + NCBRECVANY = $16; // NCB RECEIVE ANY + {$EXTERNALSYM NCBRECVANY} + NCBCHAINSEND = $17; // NCB CHAIN SEND + {$EXTERNALSYM NCBCHAINSEND} + NCBDGSEND = $20; // NCB SEND DATAGRAM + {$EXTERNALSYM NCBDGSEND} + NCBDGRECV = $21; // NCB RECEIVE DATAGRAM + {$EXTERNALSYM NCBDGRECV} + NCBDGSENDBC = $22; // NCB SEND BROADCAST DATAGRAM + {$EXTERNALSYM NCBDGSENDBC} + NCBDGRECVBC = $23; // NCB RECEIVE BROADCAST DATAGRAM + {$EXTERNALSYM NCBDGRECVBC} + NCBADDNAME = $30; // NCB ADD NAME + {$EXTERNALSYM NCBADDNAME} + NCBDELNAME = $31; // NCB DELETE NAME + {$EXTERNALSYM NCBDELNAME} + NCBRESET = $32; // NCB RESET + {$EXTERNALSYM NCBRESET} + NCBASTAT = $33; // NCB ADAPTER STATUS + {$EXTERNALSYM NCBASTAT} + NCBSSTAT = $34; // NCB SESSION STATUS + {$EXTERNALSYM NCBSSTAT} + NCBCANCEL = $35; // NCB CANCEL + {$EXTERNALSYM NCBCANCEL} + NCBADDGRNAME = $36; // NCB ADD GROUP NAME + {$EXTERNALSYM NCBADDGRNAME} + NCBENUM = $37; // NCB ENUMERATE LANA NUMBERS + {$EXTERNALSYM NCBENUM} + NCBUNLINK = $70; // NCB UNLINK + {$EXTERNALSYM NCBUNLINK} + NCBSENDNA = $71; // NCB SEND NO ACK + {$EXTERNALSYM NCBSENDNA} + NCBCHAINSENDNA = $72; // NCB CHAIN SEND NO ACK + {$EXTERNALSYM NCBCHAINSENDNA} + NCBLANSTALERT = $73; // NCB LAN STATUS ALERT + {$EXTERNALSYM NCBLANSTALERT} + NCBACTION = $77; // NCB ACTION + {$EXTERNALSYM NCBACTION} + NCBFINDNAME = $78; // NCB FIND NAME + {$EXTERNALSYM NCBFINDNAME} + NCBTRACE = $79; // NCB TRACE + {$EXTERNALSYM NCBTRACE} + + ASYNCH = $80; // high bit set == asynchronous + {$EXTERNALSYM ASYNCH} + +// +// NCB Return codes +// + + NRC_GOODRET = $00; // good return also returned when ASYNCH request accepted + {$EXTERNALSYM NRC_GOODRET} + NRC_BUFLEN = $01; // illegal buffer length + {$EXTERNALSYM NRC_BUFLEN} + NRC_ILLCMD = $03; // illegal command + {$EXTERNALSYM NRC_ILLCMD} + NRC_CMDTMO = $05; // command timed out + {$EXTERNALSYM NRC_CMDTMO} + NRC_INCOMP = $06; // message incomplete, issue another command + {$EXTERNALSYM NRC_INCOMP} + NRC_BADDR = $07; // illegal buffer address + {$EXTERNALSYM NRC_BADDR} + NRC_SNUMOUT = $08; // session number out of range + {$EXTERNALSYM NRC_SNUMOUT} + NRC_NORES = $09; // no resource available + {$EXTERNALSYM NRC_NORES} + NRC_SCLOSED = $0a; // session closed + {$EXTERNALSYM NRC_SCLOSED} + NRC_CMDCAN = $0b; // command cancelled + {$EXTERNALSYM NRC_CMDCAN} + NRC_DUPNAME = $0d; // duplicate name + {$EXTERNALSYM NRC_DUPNAME} + NRC_NAMTFUL = $0e; // name table full + {$EXTERNALSYM NRC_NAMTFUL} + NRC_ACTSES = $0f; // no deletions, name has active sessions + {$EXTERNALSYM NRC_ACTSES} + NRC_LOCTFUL = $11; // local session table full + {$EXTERNALSYM NRC_LOCTFUL} + NRC_REMTFUL = $12; // remote session table full + {$EXTERNALSYM NRC_REMTFUL} + NRC_ILLNN = $13; // illegal name number + {$EXTERNALSYM NRC_ILLNN} + NRC_NOCALL = $14; // no callname + {$EXTERNALSYM NRC_NOCALL} + NRC_NOWILD = $15; // cannot put * in NCB_NAME + {$EXTERNALSYM NRC_NOWILD} + NRC_INUSE = $16; // name in use on remote adapter + {$EXTERNALSYM NRC_INUSE} + NRC_NAMERR = $17; // name deleted + {$EXTERNALSYM NRC_NAMERR} + NRC_SABORT = $18; // session ended abnormally + {$EXTERNALSYM NRC_SABORT} + NRC_NAMCONF = $19; // name conflict detected + {$EXTERNALSYM NRC_NAMCONF} + NRC_IFBUSY = $21; // interface busy, IRET before retrying + {$EXTERNALSYM NRC_IFBUSY} + NRC_TOOMANY = $22; // too many commands outstanding, retry later + {$EXTERNALSYM NRC_TOOMANY} + NRC_BRIDGE = $23; // ncb_lana_num field invalid + {$EXTERNALSYM NRC_BRIDGE} + NRC_CANOCCR = $24; // command completed while cancel occurring + {$EXTERNALSYM NRC_CANOCCR} + NRC_CANCEL = $26; // command not valid to cancel + {$EXTERNALSYM NRC_CANCEL} + NRC_DUPENV = $30; // name defined by anther local process + {$EXTERNALSYM NRC_DUPENV} + NRC_ENVNOTDEF = $34; // environment undefined. RESET required + {$EXTERNALSYM NRC_ENVNOTDEF} + NRC_OSRESNOTAV = $35; // required OS resources exhausted + {$EXTERNALSYM NRC_OSRESNOTAV} + NRC_MAXAPPS = $36; // max number of applications exceeded + {$EXTERNALSYM NRC_MAXAPPS} + NRC_NOSAPS = $37; // no saps available for netbios + {$EXTERNALSYM NRC_NOSAPS} + NRC_NORESOURCES = $38; // requested resources are not available + {$EXTERNALSYM NRC_NORESOURCES} + NRC_INVADDRESS = $39; // invalid ncb address or length > segment + {$EXTERNALSYM NRC_INVADDRESS} + NRC_INVDDID = $3B; // invalid NCB DDID + {$EXTERNALSYM NRC_INVDDID} + NRC_LOCKFAIL = $3C; // lock of user area failed + {$EXTERNALSYM NRC_LOCKFAIL} + NRC_OPENERR = $3f; // NETBIOS not loaded + {$EXTERNALSYM NRC_OPENERR} + NRC_SYSTEM = $40; // system error + {$EXTERNALSYM NRC_SYSTEM} + + NRC_PENDING = $ff; // asynchronous command is not yet finished + {$EXTERNALSYM NRC_PENDING} + +(**************************************************************** + * * + * main user entry point for NetBIOS 3.0 * + * * + * Usage: result = Netbios( pncb ); * + ****************************************************************) + +function Netbios(pncb: PNCB): UCHAR; stdcall; +{$EXTERNALSYM Netbios} + +type + PRasDialDlg = ^TRasDialDlg; + tagRASDIALDLG = packed record + dwSize: DWORD; + hwndOwner: HWND; + dwFlags: DWORD; + xDlg: Longint; + yDlg: Longint; + dwSubEntry: DWORD; + dwError: DWORD; + reserved: Longword; + reserved2: Longword; + end; + {$EXTERNALSYM tagRASDIALDLG} + RASDIALDLG = tagRASDIALDLG; + {$EXTERNALSYM RASDIALDLG} + TRasDialDlg = tagRASDIALDLG; + + +// Reason flags + +// Flags used by the various UIs. + +const + SHTDN_REASON_FLAG_COMMENT_REQUIRED = $01000000; + {$EXTERNALSYM SHTDN_REASON_FLAG_COMMENT_REQUIRED} + SHTDN_REASON_FLAG_DIRTY_PROBLEM_ID_REQUIRED = $02000000; + {$EXTERNALSYM SHTDN_REASON_FLAG_DIRTY_PROBLEM_ID_REQUIRED} + SHTDN_REASON_FLAG_CLEAN_UI = $04000000; + {$EXTERNALSYM SHTDN_REASON_FLAG_CLEAN_UI} + SHTDN_REASON_FLAG_DIRTY_UI = $08000000; + {$EXTERNALSYM SHTDN_REASON_FLAG_DIRTY_UI} + +// Flags that end up in the event log code. + + SHTDN_REASON_FLAG_USER_DEFINED = $40000000; + {$EXTERNALSYM SHTDN_REASON_FLAG_USER_DEFINED} + SHTDN_REASON_FLAG_PLANNED = DWORD($80000000); + {$EXTERNALSYM SHTDN_REASON_FLAG_PLANNED} + +// Microsoft major reasons. + + SHTDN_REASON_MAJOR_OTHER = $00000000; + {$EXTERNALSYM SHTDN_REASON_MAJOR_OTHER} + SHTDN_REASON_MAJOR_NONE = $00000000; + {$EXTERNALSYM SHTDN_REASON_MAJOR_NONE} + SHTDN_REASON_MAJOR_HARDWARE = $00010000; + {$EXTERNALSYM SHTDN_REASON_MAJOR_HARDWARE} + SHTDN_REASON_MAJOR_OPERATINGSYSTEM = $00020000; + {$EXTERNALSYM SHTDN_REASON_MAJOR_OPERATINGSYSTEM} + SHTDN_REASON_MAJOR_SOFTWARE = $00030000; + {$EXTERNALSYM SHTDN_REASON_MAJOR_SOFTWARE} + SHTDN_REASON_MAJOR_APPLICATION = $00040000; + {$EXTERNALSYM SHTDN_REASON_MAJOR_APPLICATION} + SHTDN_REASON_MAJOR_SYSTEM = $00050000; + {$EXTERNALSYM SHTDN_REASON_MAJOR_SYSTEM} + SHTDN_REASON_MAJOR_POWER = $00060000; + {$EXTERNALSYM SHTDN_REASON_MAJOR_POWER} + SHTDN_REASON_MAJOR_LEGACY_API = $00070000; + {$EXTERNALSYM SHTDN_REASON_MAJOR_LEGACY_API} + +// Microsoft minor reasons. + + SHTDN_REASON_MINOR_OTHER = $00000000; + {$EXTERNALSYM SHTDN_REASON_MINOR_OTHER} + SHTDN_REASON_MINOR_NONE = $000000ff; + {$EXTERNALSYM SHTDN_REASON_MINOR_NONE} + SHTDN_REASON_MINOR_MAINTENANCE = $00000001; + {$EXTERNALSYM SHTDN_REASON_MINOR_MAINTENANCE} + SHTDN_REASON_MINOR_INSTALLATION = $00000002; + {$EXTERNALSYM SHTDN_REASON_MINOR_INSTALLATION} + SHTDN_REASON_MINOR_UPGRADE = $00000003; + {$EXTERNALSYM SHTDN_REASON_MINOR_UPGRADE} + SHTDN_REASON_MINOR_RECONFIG = $00000004; + {$EXTERNALSYM SHTDN_REASON_MINOR_RECONFIG} + SHTDN_REASON_MINOR_HUNG = $00000005; + {$EXTERNALSYM SHTDN_REASON_MINOR_HUNG} + SHTDN_REASON_MINOR_UNSTABLE = $00000006; + {$EXTERNALSYM SHTDN_REASON_MINOR_UNSTABLE} + SHTDN_REASON_MINOR_DISK = $00000007; + {$EXTERNALSYM SHTDN_REASON_MINOR_DISK} + SHTDN_REASON_MINOR_PROCESSOR = $00000008; + {$EXTERNALSYM SHTDN_REASON_MINOR_PROCESSOR} + SHTDN_REASON_MINOR_NETWORKCARD = $00000009; + {$EXTERNALSYM SHTDN_REASON_MINOR_NETWORKCARD} + SHTDN_REASON_MINOR_POWER_SUPPLY = $0000000a; + {$EXTERNALSYM SHTDN_REASON_MINOR_POWER_SUPPLY} + SHTDN_REASON_MINOR_CORDUNPLUGGED = $0000000b; + {$EXTERNALSYM SHTDN_REASON_MINOR_CORDUNPLUGGED} + SHTDN_REASON_MINOR_ENVIRONMENT = $0000000c; + {$EXTERNALSYM SHTDN_REASON_MINOR_ENVIRONMENT} + SHTDN_REASON_MINOR_HARDWARE_DRIVER = $0000000d; + {$EXTERNALSYM SHTDN_REASON_MINOR_HARDWARE_DRIVER} + SHTDN_REASON_MINOR_OTHERDRIVER = $0000000e; + {$EXTERNALSYM SHTDN_REASON_MINOR_OTHERDRIVER} + SHTDN_REASON_MINOR_BLUESCREEN = $0000000F; + {$EXTERNALSYM SHTDN_REASON_MINOR_BLUESCREEN} + SHTDN_REASON_MINOR_SERVICEPACK = $00000010; + {$EXTERNALSYM SHTDN_REASON_MINOR_SERVICEPACK} + SHTDN_REASON_MINOR_HOTFIX = $00000011; + {$EXTERNALSYM SHTDN_REASON_MINOR_HOTFIX} + SHTDN_REASON_MINOR_SECURITYFIX = $00000012; + {$EXTERNALSYM SHTDN_REASON_MINOR_SECURITYFIX} + SHTDN_REASON_MINOR_SECURITY = $00000013; + {$EXTERNALSYM SHTDN_REASON_MINOR_SECURITY} + SHTDN_REASON_MINOR_NETWORK_CONNECTIVITY = $00000014; + {$EXTERNALSYM SHTDN_REASON_MINOR_NETWORK_CONNECTIVITY} + SHTDN_REASON_MINOR_WMI = $00000015; + {$EXTERNALSYM SHTDN_REASON_MINOR_WMI} + SHTDN_REASON_MINOR_SERVICEPACK_UNINSTALL = $00000016; + {$EXTERNALSYM SHTDN_REASON_MINOR_SERVICEPACK_UNINSTALL} + SHTDN_REASON_MINOR_HOTFIX_UNINSTALL = $00000017; + {$EXTERNALSYM SHTDN_REASON_MINOR_HOTFIX_UNINSTALL} + SHTDN_REASON_MINOR_SECURITYFIX_UNINSTALL = $00000018; + {$EXTERNALSYM SHTDN_REASON_MINOR_SECURITYFIX_UNINSTALL} + SHTDN_REASON_MINOR_MMC = $00000019; + {$EXTERNALSYM SHTDN_REASON_MINOR_MMC} + SHTDN_REASON_MINOR_TERMSRV = $00000020; + {$EXTERNALSYM SHTDN_REASON_MINOR_TERMSRV} + SHTDN_REASON_MINOR_DC_PROMOTION = $00000021; + {$EXTERNALSYM SHTDN_REASON_MINOR_DC_PROMOTION} + SHTDN_REASON_MINOR_DC_DEMOTION = $00000022; + {$EXTERNALSYM SHTDN_REASON_MINOR_DC_DEMOTION} + + SHTDN_REASON_UNKNOWN = SHTDN_REASON_MINOR_NONE; + {$EXTERNALSYM SHTDN_REASON_UNKNOWN} + SHTDN_REASON_LEGACY_API = (SHTDN_REASON_MAJOR_LEGACY_API or SHTDN_REASON_FLAG_PLANNED); + {$EXTERNALSYM SHTDN_REASON_LEGACY_API} + +// This mask cuts out UI flags. + + SHTDN_REASON_VALID_BIT_MASK = DWORD($c0ffffff); + {$EXTERNALSYM SHTDN_REASON_VALID_BIT_MASK} + +// Convenience flags. + + PCLEANUI = (SHTDN_REASON_FLAG_PLANNED or SHTDN_REASON_FLAG_CLEAN_UI); + {$EXTERNALSYM PCLEANUI} + UCLEANUI = (SHTDN_REASON_FLAG_CLEAN_UI); + {$EXTERNALSYM UCLEANUI} + PDIRTYUI = (SHTDN_REASON_FLAG_PLANNED or SHTDN_REASON_FLAG_DIRTY_UI); + {$EXTERNALSYM PDIRTYUI} + UDIRTYUI = (SHTDN_REASON_FLAG_DIRTY_UI); + {$EXTERNALSYM UDIRTYUI} + +const + CSIDL_LOCAL_APPDATA = $001C; { \Local Settings\Application Data (non roaming) } + CSIDL_COMMON_APPDATA = $0023; { All Users\Application Data } + CSIDL_WINDOWS = $0024; { GetWindowsDirectory() } + CSIDL_SYSTEM = $0025; { GetSystemDirectory() } + CSIDL_PROGRAM_FILES = $0026; { C:\Program Files } + CSIDL_MYPICTURES = $0027; { C:\Program Files\My Pictures } + CSIDL_PROFILE = $0028; { USERPROFILE } + CSIDL_PROGRAM_FILESX86 = $002A; { C:\Program Files (x86)\My Pictures } + CSIDL_PROGRAM_FILES_COMMON = $002B; { C:\Program Files\Common } + CSIDL_COMMON_TEMPLATES = $002D; { All Users\Templates } + CSIDL_COMMON_DOCUMENTS = $002E; { All Users\Documents } + CSIDL_COMMON_ADMINTOOLS = $002F; { All Users\Start Menu\Programs\Administrative Tools } + CSIDL_ADMINTOOLS = $0030; { \Start Menu\Programs\Administrative Tools } + CSIDL_CONNECTIONS = $0031; { Network and Dial-up Connections } + CSIDL_COMMON_MUSIC = $0035; { All Users\My Music } + CSIDL_COMMON_PICTURES = $0036; { All Users\My Pictures } + CSIDL_COMMON_VIDEO = $0037; { All Users\My Video } + CSIDL_RESOURCES = $0038; { Resource Directory } + CSIDL_RESOURCES_LOCALIZED = $0039; { Localized Resource Directory } + CSIDL_COMMON_OEM_LINKS = $003A; { Links to All Users OEM specific apps } + CSIDL_CDBURN_AREA = $003B; { USERPROFILE\Local Settings\Application Data\Microsoft\CD Burning } + CSIDL_COMPUTERSNEARME = $003D; { Computers Near Me (computered from Workgroup membership) } + + {$EXTERNALSYM CSIDL_LOCAL_APPDATA} + {$EXTERNALSYM CSIDL_COMMON_APPDATA} + {$EXTERNALSYM CSIDL_WINDOWS} + {$EXTERNALSYM CSIDL_SYSTEM} + {$EXTERNALSYM CSIDL_PROGRAM_FILES} + {$EXTERNALSYM CSIDL_MYPICTURES} + {$EXTERNALSYM CSIDL_PROFILE} + {$EXTERNALSYM CSIDL_PROGRAM_FILESX86} + {$EXTERNALSYM CSIDL_PROGRAM_FILES_COMMON} + {$EXTERNALSYM CSIDL_COMMON_TEMPLATES} + {$EXTERNALSYM CSIDL_COMMON_DOCUMENTS} + {$EXTERNALSYM CSIDL_COMMON_ADMINTOOLS} + {$EXTERNALSYM CSIDL_ADMINTOOLS} + {$EXTERNALSYM CSIDL_CONNECTIONS} + {$EXTERNALSYM CSIDL_COMMON_MUSIC} + {$EXTERNALSYM CSIDL_COMMON_PICTURES} + {$EXTERNALSYM CSIDL_COMMON_VIDEO} + {$EXTERNALSYM CSIDL_RESOURCES} + {$EXTERNALSYM CSIDL_RESOURCES_LOCALIZED} + {$EXTERNALSYM CSIDL_COMMON_OEM_LINKS} + {$EXTERNALSYM CSIDL_CDBURN_AREA} + {$EXTERNALSYM CSIDL_COMPUTERSNEARME} + +type + ITaskbarList = interface(IUnknown) + ['{56FDF342-FD6D-11D0-958A-006097C9A090}'] + function HrInit: HRESULT; stdcall; + function AddTab(hwnd: HWND): HRESULT; stdcall; + function DeleteTab(hwnd: HWND): HRESULT; stdcall; + function ActivateTab(hwnd: HWND): HRESULT; stdcall; + function SetActiveAlt(hwnd: HWND): HRESULT; stdcall; + end; + {$EXTERNALSYM ITaskbarList} + + ITaskbarList2 = interface(ITaskbarList) + ['{602D4995-B13A-429B-A66E-1935E44F4317}'] + function MarkFullscreenWindow(hwnd: HWND; fFullscreen: BOOL): HRESULT; stdcall; + end; + {$EXTERNALSYM ITaskbarList2} + +type + THUMBBUTTON = record + dwMask: DWORD; + iId: UINT; + iBitmap: UINT; + hIcon: HICON; + szTip: packed array[0..259] of WCHAR; + dwFlags: DWORD; + end; + {$EXTERNALSYM THUMBBUTTON} + tagTHUMBBUTTON = THUMBBUTTON; + {$EXTERNALSYM tagTHUMBBUTTON} + TThumbButton = THUMBBUTTON; + {$EXTERNALSYM TThumbButton} + PThumbButton = ^TThumbButton; + {$EXTERNALSYM PThumbButton} + +// for ThumbButtons.dwFlags +const + THBF_ENABLED = $0000; + {$EXTERNALSYM THBF_ENABLED} + THBF_DISABLED = $0001; + {$EXTERNALSYM THBF_DISABLED} + THBF_DISMISSONCLICK = $0002; + {$EXTERNALSYM THBF_DISMISSONCLICK} + THBF_NOBACKGROUND = $0004; + {$EXTERNALSYM THBF_NOBACKGROUND} + THBF_HIDDEN = $0008; + {$EXTERNALSYM THBF_HIDDEN} + THBF_NONINTERACTIVE = $0010; + {$EXTERNALSYM THBF_NONINTERACTIVE} + +// for ThumbButton.dwMask +const + THB_BITMAP = $0001; + {$EXTERNALSYM THB_BITMAP} + THB_ICON = $0002; + {$EXTERNALSYM THB_ICON} + THB_TOOLTIP = $0004; + {$EXTERNALSYM THB_TOOLTIP} + THB_FLAGS = $0008; + {$EXTERNALSYM THB_FLAGS} + +// wParam for WM_COMMAND message (lParam = Button ID) +const + THBN_CLICKED = $1800; + {$EXTERNALSYM THBN_CLICKED} + +// for ITaskBarList3.SetProgressState +const + TBPF_NOPROGRESS = 0; + {$EXTERNALSYM TBPF_NOPROGRESS} + TBPF_INDETERMINATE = $1; + {$EXTERNALSYM TBPF_INDETERMINATE} + TBPF_NORMAL = $2; + {$EXTERNALSYM TBPF_NORMAL} + TBPF_ERROR = $4; + {$EXTERNALSYM TBPF_ERROR} + TBPF_PAUSED = $8; + {$EXTERNALSYM TBPF_PAUSED} + +type + ITaskbarList3 = interface(ITaskbarList2) + ['{EA1AFB91-9E28-4B86-90E9-9E9F8A5EEFAF}'] + function SetProgressValue(hwnd: HWND; ullCompleted: ULONGLONG; + ullTotal: ULONGLONG): HRESULT; stdcall; + function SetProgressState(hwnd: HWND; tbpFlags: Integer): HRESULT; stdcall; + function RegisterTab(hwndTab: HWND; hwndMDI: HWND): HRESULT; stdcall; + function UnregisterTab(hwndTab: HWND): HRESULT; stdcall; + function SetTabOrder(hwndTab: HWND; hwndInsertBefore: HWND): HRESULT; stdcall; + function SetTabActive(hwndTab: HWND; hwndMDI: HWND; + tbatFlags: Integer): HRESULT; stdcall; + function ThumbBarAddButtons(hwnd: HWND; cButtons: UINT; + pButton: PThumbButton): HRESULT; stdcall; + function ThumbBarUpdateButtons(hwnd: HWND; cButtons: UINT; + pButton: PThumbButton): HRESULT; stdcall; + function ThumbBarSetImageList(hwnd: HWND; himl: THandle): HRESULT; stdcall; + function SetOverlayIcon(hwnd: HWND; hIcon: HICON; + pszDescription: LPCWSTR): HRESULT; stdcall; + function SetThumbnailTooltip(hwnd: HWND; pszTip: LPCWSTR): HRESULT; stdcall; + function SetThumbnailClip(hwnd: HWND; var prcClip: TRect): HRESULT; stdcall; + end; + {$EXTERNALSYM ITaskbarList3} + +type + STPFLAG = Integer; + {$EXTERNALSYM STPFLAG} +const + STPF_NONE = 0; + {$EXTERNALSYM STPF_NONE} + STPF_USEAPPTHUMBNAILALWAYS = $1; + {$EXTERNALSYM STPF_USEAPPTHUMBNAILALWAYS} + STPF_USEAPPTHUMBNAILWHENACTIVE = $2; + {$EXTERNALSYM STPF_USEAPPTHUMBNAILWHENACTIVE} + STPF_USEAPPPEEKALWAYS = $4; + {$EXTERNALSYM STPF_USEAPPPEEKALWAYS} + STPF_USEAPPPEEKWHENACTIVE = $8; + {$EXTERNALSYM STPF_USEAPPPEEKWHENACTIVE} + +type + ITaskbarList4 = interface(ITaskbarList3) + ['{C43DC798-95D1-4BEA-9030-BB99E2983A1A}'] + function SetTabProperties(hwndTab: HWND; stpFlags: STPFLAG): HRESULT; stdcall; + end; + {$EXTERNALSYM ITaskbarList4} + +const + CLSID_TaskbarList: TGUID = '{56FDF344-FD6D-11d0-958A-006097C9A090}'; + {$EXTERNALSYM CLSID_TaskbarList} + + +{ TODO BCB-compatibility} + +const + DLLVER_PLATFORM_WINDOWS = $00000001; + {$EXTERNALSYM DLLVER_PLATFORM_WINDOWS} + DLLVER_PLATFORM_NT = $00000002; + {$EXTERNALSYM DLLVER_PLATFORM_NT} + +type + PDllVersionInfo = ^TDllVersionInfo; + _DLLVERSIONINFO = packed record + cbSize: DWORD; + dwMajorVersion: DWORD; + dwMinorVersion: DWORD; + dwBuildNumber: DWORD; + dwPlatformId: DWORD; + end; + {$EXTERNALSYM _DLLVERSIONINFO} + TDllVersionInfo = _DLLVERSIONINFO; + DLLVERSIONINFO = _DLLVERSIONINFO; + {$EXTERNALSYM DLLVERSIONINFO} + + +// JwaWinError +// line 22146 + +const + +// +// Task Scheduler errors +// +// +// MessageId: SCHED_S_TASK_READY +// +// MessageText: +// +// The task is ready to run at its next scheduled time. +// + SCHED_S_TASK_READY = HRESULT($00041300); + {$EXTERNALSYM SCHED_S_TASK_READY} + +// +// MessageId: SCHED_S_TASK_RUNNING +// +// MessageText: +// +// The task is currently running. +// + SCHED_S_TASK_RUNNING = HRESULT($00041301); + {$EXTERNALSYM SCHED_S_TASK_RUNNING} + +// +// MessageId: SCHED_S_TASK_DISABLED +// +// MessageText: +// +// The task will not run at the scheduled times because it has been disabled. +// + SCHED_S_TASK_DISABLED = HRESULT($00041302); + {$EXTERNALSYM SCHED_S_TASK_DISABLED} + +// +// MessageId: SCHED_S_TASK_HAS_NOT_RUN +// +// MessageText: +// +// The task has not yet run. +// + SCHED_S_TASK_HAS_NOT_RUN = HRESULT($00041303); + {$EXTERNALSYM SCHED_S_TASK_HAS_NOT_RUN} + +// +// MessageId: SCHED_S_TASK_NO_MORE_RUNS +// +// MessageText: +// +// There are no more runs scheduled for this task. +// + SCHED_S_TASK_NO_MORE_RUNS = HRESULT($00041304); + {$EXTERNALSYM SCHED_S_TASK_NO_MORE_RUNS} + +// +// MessageId: SCHED_S_TASK_NOT_SCHEDULED +// +// MessageText: +// +// One or more of the properties that are needed to run this task on a schedule have not been set. +// + SCHED_S_TASK_NOT_SCHEDULED = HRESULT($00041305); + {$EXTERNALSYM SCHED_S_TASK_NOT_SCHEDULED} + +// +// MessageId: SCHED_S_TASK_TERMINATED +// +// MessageText: +// +// The last run of the task was terminated by the user. +// + SCHED_S_TASK_TERMINATED = HRESULT($00041306); + {$EXTERNALSYM SCHED_S_TASK_TERMINATED} + +// +// MessageId: SCHED_S_TASK_NO_VALID_TRIGGERS +// +// MessageText: +// +// Either the task has no triggers or the existing triggers are disabled or not set. +// + SCHED_S_TASK_NO_VALID_TRIGGERS = HRESULT($00041307); + {$EXTERNALSYM SCHED_S_TASK_NO_VALID_TRIGGERS} + +// +// MessageId: SCHED_S_EVENT_TRIGGER +// +// MessageText: +// +// Event triggers don't have set run times. +// + SCHED_S_EVENT_TRIGGER = HRESULT($00041308); + {$EXTERNALSYM SCHED_S_EVENT_TRIGGER} + +// +// MessageId: SCHED_E_TRIGGER_NOT_FOUND +// +// MessageText: +// +// Trigger not found. +// + SCHED_E_TRIGGER_NOT_FOUND = HRESULT($80041309); + {$EXTERNALSYM SCHED_E_TRIGGER_NOT_FOUND} + +// +// MessageId: SCHED_E_TASK_NOT_READY +// +// MessageText: +// +// One or more of the properties that are needed to run this task have not been set. +// + SCHED_E_TASK_NOT_READY = HRESULT($8004130A); + {$EXTERNALSYM SCHED_E_TASK_NOT_READY} + +// +// MessageId: SCHED_E_TASK_NOT_RUNNING +// +// MessageText: +// +// There is no running instance of the task to terminate. +// + SCHED_E_TASK_NOT_RUNNING = HRESULT($8004130B); + {$EXTERNALSYM SCHED_E_TASK_NOT_RUNNING} + +// +// MessageId: SCHED_E_SERVICE_NOT_INSTALLED +// +// MessageText: +// +// The Task Scheduler Service is not installed on this computer. +// + SCHED_E_SERVICE_NOT_INSTALLED = HRESULT($8004130C); + {$EXTERNALSYM SCHED_E_SERVICE_NOT_INSTALLED} + +// +// MessageId: SCHED_E_CANNOT_OPEN_TASK +// +// MessageText: +// +// The task object could not be opened. +// + SCHED_E_CANNOT_OPEN_TASK = HRESULT($8004130D); + {$EXTERNALSYM SCHED_E_CANNOT_OPEN_TASK} + +// +// MessageId: SCHED_E_INVALID_TASK +// +// MessageText: +// +// The object is either an invalid task object or is not a task object. +// + SCHED_E_INVALID_TASK = HRESULT($8004130E); + {$EXTERNALSYM SCHED_E_INVALID_TASK} + +// +// MessageId: SCHED_E_ACCOUNT_INFORMATION_NOT_SET +// +// MessageText: +// +// No account information could be found in the Task Scheduler security database for the task indicated. +// + SCHED_E_ACCOUNT_INFORMATION_NOT_SET = HRESULT($8004130F); + {$EXTERNALSYM SCHED_E_ACCOUNT_INFORMATION_NOT_SET} + +// +// MessageId: SCHED_E_ACCOUNT_NAME_NOT_FOUND +// +// MessageText: +// +// Unable to establish existence of the account specified. +// + SCHED_E_ACCOUNT_NAME_NOT_FOUND = HRESULT($80041310); + {$EXTERNALSYM SCHED_E_ACCOUNT_NAME_NOT_FOUND} + +// +// MessageId: SCHED_E_ACCOUNT_DBASE_CORRUPT +// +// MessageText: +// +// Corruption was detected in the Task Scheduler security database; the database has been reset. +// + SCHED_E_ACCOUNT_DBASE_CORRUPT = HRESULT($80041311); + {$EXTERNALSYM SCHED_E_ACCOUNT_DBASE_CORRUPT} + +// +// MessageId: SCHED_E_NO_SECURITY_SERVICES +// +// MessageText: +// +// Task Scheduler security services are available only on Windows NT. +// + SCHED_E_NO_SECURITY_SERVICES = HRESULT($80041312); + {$EXTERNALSYM SCHED_E_NO_SECURITY_SERVICES} + +// +// MessageId: SCHED_E_UNKNOWN_OBJECT_VERSION +// +// MessageText: +// +// The task object version is either unsupported or invalid. +// + SCHED_E_UNKNOWN_OBJECT_VERSION = HRESULT($80041313); + {$EXTERNALSYM SCHED_E_UNKNOWN_OBJECT_VERSION} + +// +// MessageId: SCHED_E_UNSUPPORTED_ACCOUNT_OPTION +// +// MessageText: +// +// The task has been configured with an unsupported combination of account settings and run time options. +// + SCHED_E_UNSUPPORTED_ACCOUNT_OPTION = HRESULT($80041314); + {$EXTERNALSYM SCHED_E_UNSUPPORTED_ACCOUNT_OPTION} + +// +// MessageId: SCHED_E_SERVICE_NOT_RUNNING +// +// MessageText: +// +// The Task Scheduler Service is not running. +// + SCHED_E_SERVICE_NOT_RUNNING = HRESULT($80041315); + {$EXTERNALSYM SCHED_E_SERVICE_NOT_RUNNING} + + +// line 151 + +// +// Define the various device type values. Note that values used by Microsoft +// Corporation are in the range 0-32767, and 32768-65535 are reserved for use +// by customers. +// + +type + DEVICE_TYPE = DWORD; + {$EXTERNALSYM DEVICE_TYPE} + +const + FILE_DEVICE_BEEP = $00000001; + {$EXTERNALSYM FILE_DEVICE_BEEP} + FILE_DEVICE_CD_ROM = $00000002; + {$EXTERNALSYM FILE_DEVICE_CD_ROM} + FILE_DEVICE_CD_ROM_FILE_SYSTEM = $00000003; + {$EXTERNALSYM FILE_DEVICE_CD_ROM_FILE_SYSTEM} + FILE_DEVICE_CONTROLLER = $00000004; + {$EXTERNALSYM FILE_DEVICE_CONTROLLER} + FILE_DEVICE_DATALINK = $00000005; + {$EXTERNALSYM FILE_DEVICE_DATALINK} + FILE_DEVICE_DFS = $00000006; + {$EXTERNALSYM FILE_DEVICE_DFS} + FILE_DEVICE_DISK = $00000007; + {$EXTERNALSYM FILE_DEVICE_DISK} + FILE_DEVICE_DISK_FILE_SYSTEM = $00000008; + {$EXTERNALSYM FILE_DEVICE_DISK_FILE_SYSTEM} + FILE_DEVICE_FILE_SYSTEM = $00000009; + {$EXTERNALSYM FILE_DEVICE_FILE_SYSTEM} + FILE_DEVICE_INPORT_PORT = $0000000a; + {$EXTERNALSYM FILE_DEVICE_INPORT_PORT} + FILE_DEVICE_KEYBOARD = $0000000b; + {$EXTERNALSYM FILE_DEVICE_KEYBOARD} + FILE_DEVICE_MAILSLOT = $0000000c; + {$EXTERNALSYM FILE_DEVICE_MAILSLOT} + FILE_DEVICE_MIDI_IN = $0000000d; + {$EXTERNALSYM FILE_DEVICE_MIDI_IN} + FILE_DEVICE_MIDI_OUT = $0000000e; + {$EXTERNALSYM FILE_DEVICE_MIDI_OUT} + FILE_DEVICE_MOUSE = $0000000f; + {$EXTERNALSYM FILE_DEVICE_MOUSE} + FILE_DEVICE_MULTI_UNC_PROVIDER = $00000010; + {$EXTERNALSYM FILE_DEVICE_MULTI_UNC_PROVIDER} + FILE_DEVICE_NAMED_PIPE = $00000011; + {$EXTERNALSYM FILE_DEVICE_NAMED_PIPE} + FILE_DEVICE_NETWORK = $00000012; + {$EXTERNALSYM FILE_DEVICE_NETWORK} + FILE_DEVICE_NETWORK_BROWSER = $00000013; + {$EXTERNALSYM FILE_DEVICE_NETWORK_BROWSER} + FILE_DEVICE_NETWORK_FILE_SYSTEM = $00000014; + {$EXTERNALSYM FILE_DEVICE_NETWORK_FILE_SYSTEM} + FILE_DEVICE_NULL = $00000015; + {$EXTERNALSYM FILE_DEVICE_NULL} + FILE_DEVICE_PARALLEL_PORT = $00000016; + {$EXTERNALSYM FILE_DEVICE_PARALLEL_PORT} + FILE_DEVICE_PHYSICAL_NETCARD = $00000017; + {$EXTERNALSYM FILE_DEVICE_PHYSICAL_NETCARD} + FILE_DEVICE_PRINTER = $00000018; + {$EXTERNALSYM FILE_DEVICE_PRINTER} + FILE_DEVICE_SCANNER = $00000019; + {$EXTERNALSYM FILE_DEVICE_SCANNER} + FILE_DEVICE_SERIAL_MOUSE_PORT = $0000001a; + {$EXTERNALSYM FILE_DEVICE_SERIAL_MOUSE_PORT} + FILE_DEVICE_SERIAL_PORT = $0000001b; + {$EXTERNALSYM FILE_DEVICE_SERIAL_PORT} + FILE_DEVICE_SCREEN = $0000001c; + {$EXTERNALSYM FILE_DEVICE_SCREEN} + FILE_DEVICE_SOUND = $0000001d; + {$EXTERNALSYM FILE_DEVICE_SOUND} + FILE_DEVICE_STREAMS = $0000001e; + {$EXTERNALSYM FILE_DEVICE_STREAMS} + FILE_DEVICE_TAPE = $0000001f; + {$EXTERNALSYM FILE_DEVICE_TAPE} + FILE_DEVICE_TAPE_FILE_SYSTEM = $00000020; + {$EXTERNALSYM FILE_DEVICE_TAPE_FILE_SYSTEM} + FILE_DEVICE_TRANSPORT = $00000021; + {$EXTERNALSYM FILE_DEVICE_TRANSPORT} + FILE_DEVICE_UNKNOWN = $00000022; + {$EXTERNALSYM FILE_DEVICE_UNKNOWN} + FILE_DEVICE_VIDEO = $00000023; + {$EXTERNALSYM FILE_DEVICE_VIDEO} + FILE_DEVICE_VIRTUAL_DISK = $00000024; + {$EXTERNALSYM FILE_DEVICE_VIRTUAL_DISK} + FILE_DEVICE_WAVE_IN = $00000025; + {$EXTERNALSYM FILE_DEVICE_WAVE_IN} + FILE_DEVICE_WAVE_OUT = $00000026; + {$EXTERNALSYM FILE_DEVICE_WAVE_OUT} + FILE_DEVICE_8042_PORT = $00000027; + {$EXTERNALSYM FILE_DEVICE_8042_PORT} + FILE_DEVICE_NETWORK_REDIRECTOR = $00000028; + {$EXTERNALSYM FILE_DEVICE_NETWORK_REDIRECTOR} + FILE_DEVICE_BATTERY = $00000029; + {$EXTERNALSYM FILE_DEVICE_BATTERY} + FILE_DEVICE_BUS_EXTENDER = $0000002a; + {$EXTERNALSYM FILE_DEVICE_BUS_EXTENDER} + FILE_DEVICE_MODEM = $0000002b; + {$EXTERNALSYM FILE_DEVICE_MODEM} + FILE_DEVICE_VDM = $0000002c; + {$EXTERNALSYM FILE_DEVICE_VDM} + FILE_DEVICE_MASS_STORAGE = $0000002d; + {$EXTERNALSYM FILE_DEVICE_MASS_STORAGE} + FILE_DEVICE_SMB = $0000002e; + {$EXTERNALSYM FILE_DEVICE_SMB} + FILE_DEVICE_KS = $0000002f; + {$EXTERNALSYM FILE_DEVICE_KS} + FILE_DEVICE_CHANGER = $00000030; + {$EXTERNALSYM FILE_DEVICE_CHANGER} + FILE_DEVICE_SMARTCARD = $00000031; + {$EXTERNALSYM FILE_DEVICE_SMARTCARD} + FILE_DEVICE_ACPI = $00000032; + {$EXTERNALSYM FILE_DEVICE_ACPI} + FILE_DEVICE_DVD = $00000033; + {$EXTERNALSYM FILE_DEVICE_DVD} + FILE_DEVICE_FULLSCREEN_VIDEO = $00000034; + {$EXTERNALSYM FILE_DEVICE_FULLSCREEN_VIDEO} + FILE_DEVICE_DFS_FILE_SYSTEM = $00000035; + {$EXTERNALSYM FILE_DEVICE_DFS_FILE_SYSTEM} + FILE_DEVICE_DFS_VOLUME = $00000036; + {$EXTERNALSYM FILE_DEVICE_DFS_VOLUME} + FILE_DEVICE_SERENUM = $00000037; + {$EXTERNALSYM FILE_DEVICE_SERENUM} + FILE_DEVICE_TERMSRV = $00000038; + {$EXTERNALSYM FILE_DEVICE_TERMSRV} + FILE_DEVICE_KSEC = $00000039; + {$EXTERNALSYM FILE_DEVICE_KSEC} + FILE_DEVICE_FIPS = $0000003A; + {$EXTERNALSYM FILE_DEVICE_FIPS} + FILE_DEVICE_INFINIBAND = $0000003B; + {$EXTERNALSYM FILE_DEVICE_INFINIBAND} + +// line 297 + +// +// Define the method codes for how buffers are passed for I/O and FS controls +// + +const + METHOD_BUFFERED = 0; + {$EXTERNALSYM METHOD_BUFFERED} + METHOD_IN_DIRECT = 1; + {$EXTERNALSYM METHOD_IN_DIRECT} + METHOD_OUT_DIRECT = 2; + {$EXTERNALSYM METHOD_OUT_DIRECT} + METHOD_NEITHER = 3; + {$EXTERNALSYM METHOD_NEITHER} + +// +// Define some easier to comprehend aliases: +// METHOD_DIRECT_TO_HARDWARE (writes, aka METHOD_IN_DIRECT) +// METHOD_DIRECT_FROM_HARDWARE (reads, aka METHOD_OUT_DIRECT) +// + + METHOD_DIRECT_TO_HARDWARE = METHOD_IN_DIRECT; + {$EXTERNALSYM METHOD_DIRECT_TO_HARDWARE} + METHOD_DIRECT_FROM_HARDWARE = METHOD_OUT_DIRECT; + {$EXTERNALSYM METHOD_DIRECT_FROM_HARDWARE} + +// +// Define the access check value for any access +// +// +// The FILE_READ_ACCESS and FILE_WRITE_ACCESS constants are also defined in +// ntioapi.h as FILE_READ_DATA and FILE_WRITE_DATA. The values for these +// constants *MUST* always be in sync. +// +// +// FILE_SPECIAL_ACCESS is checked by the NT I/O system the same as FILE_ANY_ACCESS. +// The file systems, however, may add additional access checks for I/O and FS controls +// that use this value. +// + +const + FILE_ANY_ACCESS = 0; + {$EXTERNALSYM FILE_ANY_ACCESS} + FILE_SPECIAL_ACCESS = FILE_ANY_ACCESS; + {$EXTERNALSYM FILE_SPECIAL_ACCESS} + FILE_READ_ACCESS = $0001; // file & pipe + {$EXTERNALSYM FILE_READ_ACCESS} + FILE_WRITE_ACCESS = $0002; // file & pipe + {$EXTERNALSYM FILE_WRITE_ACCESS} + +// line 3425 + +// +// The following is a list of the native file system fsctls followed by +// additional network file system fsctls. Some values have been +// decommissioned. +// + +const + + FSCTL_REQUEST_OPLOCK_LEVEL_1 = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (0 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_REQUEST_OPLOCK_LEVEL_1} + + FSCTL_REQUEST_OPLOCK_LEVEL_2 = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (1 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_REQUEST_OPLOCK_LEVEL_2} + + FSCTL_REQUEST_BATCH_OPLOCK = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (2 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_REQUEST_BATCH_OPLOCK} + + FSCTL_OPLOCK_BREAK_ACKNOWLEDGE = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (3 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_OPLOCK_BREAK_ACKNOWLEDGE} + + FSCTL_OPBATCH_ACK_CLOSE_PENDING = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (4 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_OPBATCH_ACK_CLOSE_PENDING} + + FSCTL_OPLOCK_BREAK_NOTIFY = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (5 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_OPLOCK_BREAK_NOTIFY} + + FSCTL_LOCK_VOLUME = ((FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or (6 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_LOCK_VOLUME} + + FSCTL_UNLOCK_VOLUME = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (7 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_UNLOCK_VOLUME} + + FSCTL_DISMOUNT_VOLUME = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (8 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_DISMOUNT_VOLUME} + +// decommissioned fsctl value 9 + + FSCTL_IS_VOLUME_MOUNTED = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (10 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_IS_VOLUME_MOUNTED} + + FSCTL_IS_PATHNAME_VALID = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (11 shl 2) or METHOD_BUFFERED); // PATHNAME_BUFFER, + {$EXTERNALSYM FSCTL_IS_PATHNAME_VALID} + + FSCTL_MARK_VOLUME_DIRTY = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (12 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_MARK_VOLUME_DIRTY} + +// decommissioned fsctl value 13 + + FSCTL_QUERY_RETRIEVAL_POINTERS = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (14 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_QUERY_RETRIEVAL_POINTERS} + + FSCTL_GET_COMPRESSION = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (15 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_GET_COMPRESSION} + + FSCTL_SET_COMPRESSION = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or ((FILE_READ_DATA or FILE_WRITE_DATA) shl 14) or + (16 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_SET_COMPRESSION} + +// decommissioned fsctl value 17 +// decommissioned fsctl value 18 + + FSCTL_MARK_AS_SYSTEM_HIVE = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (19 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_MARK_AS_SYSTEM_HIVE} + + FSCTL_OPLOCK_BREAK_ACK_NO_2 = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (20 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_OPLOCK_BREAK_ACK_NO_2} + + FSCTL_INVALIDATE_VOLUMES = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (21 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_INVALIDATE_VOLUMES} + + FSCTL_QUERY_FAT_BPB = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (22 shl 2) or METHOD_BUFFERED); // FSCTL_QUERY_FAT_BPB_BUFFER + {$EXTERNALSYM FSCTL_QUERY_FAT_BPB} + + FSCTL_REQUEST_FILTER_OPLOCK = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (23 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_REQUEST_FILTER_OPLOCK} + + FSCTL_FILESYSTEM_GET_STATISTICS = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (24 shl 2) or METHOD_BUFFERED); // FILESYSTEM_STATISTICS + {$EXTERNALSYM FSCTL_FILESYSTEM_GET_STATISTICS} + + FSCTL_GET_NTFS_VOLUME_DATA = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (25 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_GET_NTFS_VOLUME_DATA} + + FSCTL_GET_NTFS_FILE_RECORD = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (26 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_GET_NTFS_FILE_RECORD} + + FSCTL_GET_VOLUME_BITMAP = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (27 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_GET_VOLUME_BITMAP} + + FSCTL_GET_RETRIEVAL_POINTERS = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (28 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_GET_RETRIEVAL_POINTERS} + + FSCTL_MOVE_FILE = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or + (29 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_MOVE_FILE} + + FSCTL_IS_VOLUME_DIRTY = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (30 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_IS_VOLUME_DIRTY} + +// decomissioned fsctl value 31 +(* FSCTL_GET_HFS_INFORMATION = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (31 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_GET_HFS_INFORMATION} +*) + + FSCTL_ALLOW_EXTENDED_DASD_IO = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (32 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_ALLOW_EXTENDED_DASD_IO} + +// decommissioned fsctl value 33 +// decommissioned fsctl value 34 + +(* + FSCTL_READ_PROPERTY_DATA = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (33 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_READ_PROPERTY_DATA} + + FSCTL_WRITE_PROPERTY_DATA = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (34 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_WRITE_PROPERTY_DATA} +*) + + FSCTL_FIND_FILES_BY_SID = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (35 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_FIND_FILES_BY_SID} + +// decommissioned fsctl value 36 +// decommissioned fsctl value 37 + +(* FSCTL_DUMP_PROPERTY_DATA = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (37 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_DUMP_PROPERTY_DATA} +*) + + FSCTL_SET_OBJECT_ID = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or + (38 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_SET_OBJECT_ID} + + FSCTL_GET_OBJECT_ID = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (39 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_GET_OBJECT_ID} + + FSCTL_DELETE_OBJECT_ID = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or + (40 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_DELETE_OBJECT_ID} + + FSCTL_SET_REPARSE_POINT = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or + (41 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_SET_REPARSE_POINT} + + FSCTL_GET_REPARSE_POINT = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (42 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_GET_REPARSE_POINT} + + FSCTL_DELETE_REPARSE_POINT = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or + (43 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_DELETE_REPARSE_POINT} + + FSCTL_ENUM_USN_DATA = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (44 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_ENUM_USN_DATA} + + FSCTL_SECURITY_ID_CHECK = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_READ_DATA shl 14) or + (45 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_SECURITY_ID_CHECK} + + FSCTL_READ_USN_JOURNAL = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (46 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_READ_USN_JOURNAL} + + FSCTL_SET_OBJECT_ID_EXTENDED = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or + (47 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_SET_OBJECT_ID_EXTENDED} + + FSCTL_CREATE_OR_GET_OBJECT_ID = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (48 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_CREATE_OR_GET_OBJECT_ID} + + FSCTL_SET_SPARSE = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or + (49 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_SET_SPARSE} + + FSCTL_SET_ZERO_DATA = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_WRITE_DATA shl 14) or + (50 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_SET_ZERO_DATA} + + FSCTL_QUERY_ALLOCATED_RANGES = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_READ_DATA shl 14) or + (51 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_QUERY_ALLOCATED_RANGES} + +// decommissioned fsctl value 52 +(* + FSCTL_ENABLE_UPGRADE = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_WRITE_DATA shl 14) or + (52 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_ENABLE_UPGRADE} +*) + + FSCTL_SET_ENCRYPTION = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (53 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_SET_ENCRYPTION} + + FSCTL_ENCRYPTION_FSCTL_IO = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (54 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_ENCRYPTION_FSCTL_IO} + + FSCTL_WRITE_RAW_ENCRYPTED = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or + (55 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_WRITE_RAW_ENCRYPTED} + + FSCTL_READ_RAW_ENCRYPTED = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or + (56 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_READ_RAW_ENCRYPTED} + + FSCTL_CREATE_USN_JOURNAL = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (57 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_CREATE_USN_JOURNAL} + + FSCTL_READ_FILE_USN_DATA = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (58 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_READ_FILE_USN_DATA} + + FSCTL_WRITE_USN_CLOSE_RECORD = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (59 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_WRITE_USN_CLOSE_RECORD} + + FSCTL_EXTEND_VOLUME = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (60 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_EXTEND_VOLUME} + + FSCTL_QUERY_USN_JOURNAL = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (61 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_QUERY_USN_JOURNAL} + + FSCTL_DELETE_USN_JOURNAL = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (62 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_DELETE_USN_JOURNAL} + + FSCTL_MARK_HANDLE = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (63 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_MARK_HANDLE} + + FSCTL_SIS_COPYFILE = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (64 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_SIS_COPYFILE} + + FSCTL_SIS_LINK_FILES = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or ((FILE_READ_DATA or FILE_WRITE_DATA) shl 14) or + (65 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_SIS_LINK_FILES} + + FSCTL_HSM_MSG = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or ((FILE_READ_DATA or FILE_WRITE_DATA) shl 14) or + (66 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_HSM_MSG} + +// decommissioned fsctl value 67 +(* + FSCTL_NSS_CONTROL = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_WRITE_DATA shl 14) or + (67 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_NSS_CONTROL} +*) + + FSCTL_HSM_DATA = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or ((FILE_READ_DATA or FILE_WRITE_DATA) shl 14) or + (68 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_HSM_DATA} + + FSCTL_RECALL_FILE = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 14) or + (69 shl 2) or METHOD_NEITHER); + {$EXTERNALSYM FSCTL_RECALL_FILE} + +// decommissioned fsctl value 70 +(* + FSCTL_NSS_RCONTROL = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_READ_DATA shl 14) or + (70 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_NSS_RCONTROL} +*) + + FSCTL_READ_FROM_PLEX = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_READ_DATA shl 14) or + (71 shl 2) or METHOD_OUT_DIRECT); + {$EXTERNALSYM FSCTL_READ_FROM_PLEX} + + FSCTL_FILE_PREFETCH = ( + (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_SPECIAL_ACCESS shl 14) or + (72 shl 2) or METHOD_BUFFERED); + {$EXTERNALSYM FSCTL_FILE_PREFETCH} + +// line 4553 + +// +// Structure for FSCTL_SET_ZERO_DATA +// + +type + + PFILE_ZERO_DATA_INFORMATION = ^FILE_ZERO_DATA_INFORMATION; + {$EXTERNALSYM PFILE_ZERO_DATA_INFORMATION} + _FILE_ZERO_DATA_INFORMATION = record + FileOffset: LARGE_INTEGER; + BeyondFinalZero: LARGE_INTEGER; + end; + {$EXTERNALSYM _FILE_ZERO_DATA_INFORMATION} + FILE_ZERO_DATA_INFORMATION = _FILE_ZERO_DATA_INFORMATION; + {$EXTERNALSYM FILE_ZERO_DATA_INFORMATION} + TFileZeroDataInformation = FILE_ZERO_DATA_INFORMATION; + PFileZeroDataInformation = PFILE_ZERO_DATA_INFORMATION; + +// +// Structure for FSCTL_QUERY_ALLOCATED_RANGES +// + +// +// Querying the allocated ranges requires an output buffer to store the +// allocated ranges and an input buffer to specify the range to query. +// The input buffer contains a single entry, the output buffer is an +// array of the following structure. +// + + PFILE_ALLOCATED_RANGE_BUFFER = ^FILE_ALLOCATED_RANGE_BUFFER; + {$EXTERNALSYM PFILE_ALLOCATED_RANGE_BUFFER} + _FILE_ALLOCATED_RANGE_BUFFER = record + FileOffset: LARGE_INTEGER; + Length: LARGE_INTEGER; + end; + {$EXTERNALSYM _FILE_ALLOCATED_RANGE_BUFFER} + FILE_ALLOCATED_RANGE_BUFFER = _FILE_ALLOCATED_RANGE_BUFFER; + {$EXTERNALSYM FILE_ALLOCATED_RANGE_BUFFER} + TFileAllocatedRangeBuffer = FILE_ALLOCATED_RANGE_BUFFER; + PFileAllocatedRangeBuffer = PFILE_ALLOCATED_RANGE_BUFFER; + + +// line 340 + +// +// Code Page Default Values. +// + +const + CP_ACP = 0; // default to ANSI code page + {$EXTERNALSYM CP_ACP} + CP_OEMCP = 1; // default to OEM code page + {$EXTERNALSYM CP_OEMCP} + CP_MACCP = 2; // default to MAC code page + {$EXTERNALSYM CP_MACCP} + CP_THREAD_ACP = 3; // current thread's ANSI code page + {$EXTERNALSYM CP_THREAD_ACP} + CP_SYMBOL = 42; // SYMBOL translations + {$EXTERNALSYM CP_SYMBOL} + + CP_UTF7 = 65000; // UTF-7 translation + {$EXTERNALSYM CP_UTF7} + CP_UTF8 = 65001; // UTF-8 translation + {$EXTERNALSYM CP_UTF8} + +// line 597 + +const + +// +// The following LCTypes may be used in combination with any other LCTypes. +// +// LOCALE_NOUSEROVERRIDE is also used in GetTimeFormat and +// GetDateFormat. +// +// LOCALE_USE_CP_ACP is used in many of the A (Ansi) apis that need +// to do string translation. +// +// LOCALE_RETURN_NUMBER will return the result from GetLocaleInfo as a +// number instead of a string. This flag is only valid for the LCTypes +// beginning with LOCALE_I. +// + + LOCALE_NOUSEROVERRIDE = DWORD($80000000); // do not use user overrides + {$EXTERNALSYM LOCALE_NOUSEROVERRIDE} + LOCALE_USE_CP_ACP = $40000000; // use the system ACP + {$EXTERNALSYM LOCALE_USE_CP_ACP} + + LOCALE_RETURN_NUMBER = $20000000; // return number instead of string + {$EXTERNALSYM LOCALE_RETURN_NUMBER} + +// line 841 + +const + LOCALE_IDEFAULTEBCDICCODEPAGE = $00001012; // default ebcdic code page + {$EXTERNALSYM LOCALE_IDEFAULTEBCDICCODEPAGE} + LOCALE_IPAPERSIZE = $0000100A; // 1 = letter, 5 = legal, 8 = a3, 9 = a4 + {$EXTERNALSYM LOCALE_IPAPERSIZE} + LOCALE_SENGCURRNAME = $00001007; // english name of currency + {$EXTERNALSYM LOCALE_SENGCURRNAME} + LOCALE_SNATIVECURRNAME = $00001008; // native name of currency + {$EXTERNALSYM LOCALE_SNATIVECURRNAME} + LOCALE_SYEARMONTH = $00001006; // year month format string + {$EXTERNALSYM LOCALE_SYEARMONTH} + LOCALE_SSORTNAME = $00001013; // sort name + {$EXTERNALSYM LOCALE_SSORTNAME} + LOCALE_IDIGITSUBSTITUTION = $00001014; // 0 = context, 1 = none, 2 = national + {$EXTERNALSYM LOCALE_IDIGITSUBSTITUTION} + +// line 880 + + DATE_YEARMONTH = $00000008; // use year month picture + {$EXTERNALSYM DATE_YEARMONTH} + DATE_LTRREADING = $00000010; // add marks for left to right reading order layout + {$EXTERNALSYM DATE_LTRREADING} + DATE_RTLREADING = $00000020; // add marks for right to left reading order layout + {$EXTERNALSYM DATE_RTLREADING} + +// +// Calendar Types. +// +// These types are used for the EnumCalendarInfo and GetCalendarInfo +// NLS API routines. +// Some of these types are also used for the SetCalendarInfo NLS API +// routine. +// + +// +// The following CalTypes may be used in combination with any other CalTypes. +// +// CAL_NOUSEROVERRIDE +// +// CAL_USE_CP_ACP is used in the A (Ansi) apis that need to do string +// translation. +// +// CAL_RETURN_NUMBER will return the result from GetCalendarInfo as a +// number instead of a string. This flag is only valid for the CalTypes +// beginning with CAL_I. +// + + CAL_NOUSEROVERRIDE = LOCALE_NOUSEROVERRIDE; // do not use user overrides + {$EXTERNALSYM CAL_NOUSEROVERRIDE} + CAL_USE_CP_ACP = LOCALE_USE_CP_ACP; // use the system ACP + {$EXTERNALSYM CAL_USE_CP_ACP} + CAL_RETURN_NUMBER = LOCALE_RETURN_NUMBER; // return number instead of string + {$EXTERNALSYM CAL_RETURN_NUMBER} + +// line 1014 + + CAL_SYEARMONTH = $0000002f; // year month format string + {$EXTERNALSYM CAL_SYEARMONTH} + CAL_ITWODIGITYEARMAX = $00000030; // two digit year max + {$EXTERNALSYM CAL_ITWODIGITYEARMAX} + +// line 1424 + +type + CALINFO_ENUMPROCEXW = function (lpCalendarInfoString: LPWSTR; Calendar: CALID): BOOL; stdcall; + {$EXTERNALSYM CALINFO_ENUMPROCEXW} + TCalInfoEnumProcExW = CALINFO_ENUMPROCEXW; + +// line 1635 + + +function GetCalendarInfoA(Locale: LCID; Calendar: CALID; CalType: CALTYPE; + lpCalData: LPSTR; cchData: Integer; lpValue: LPDWORD): Integer; stdcall; +{$EXTERNALSYM GetCalendarInfoA} +function GetCalendarInfoW(Locale: LCID; Calendar: CALID; CalType: CALTYPE; + lpCalData: LPWSTR; cchData: Integer; lpValue: LPDWORD): Integer; stdcall; +{$EXTERNALSYM GetCalendarInfoW} + +// line 1754 + +function EnumCalendarInfoExW(lpCalInfoEnumProcEx: CALINFO_ENUMPROCEXW; + Locale: LCID; Calendar: CALID; CalType: CALTYPE): BOOL; stdcall; +{$EXTERNALSYM EnumCalendarInfoExW} + + +{$IFNDEF FPC} +type + MAKEINTRESOURCEA = LPSTR; + {$EXTERNALSYM MAKEINTRESOURCEA} + MAKEINTRESOURCEW = LPWSTR; + {$EXTERNALSYM MAKEINTRESOURCEW} +{$IFDEF SUPPORTS_UNICODE} + MAKEINTRESOURCE = MAKEINTRESOURCEW; + {$EXTERNALSYM MAKEINTRESOURCE} +{$ELSE ~SUPPORTS_UNICODE} + MAKEINTRESOURCE = MAKEINTRESOURCEA; + {$EXTERNALSYM MAKEINTRESOURCE} +{$ENDIF ~SUPPORTS_UNICODE} +{$ENDIF ~FPC} + +// +// Predefined Resource Types +// + +const + RT_CURSOR = MAKEINTRESOURCE(1); + {$EXTERNALSYM RT_CURSOR} + RT_BITMAP = MAKEINTRESOURCE(2); + {$EXTERNALSYM RT_BITMAP} + RT_ICON = MAKEINTRESOURCE(3); + {$EXTERNALSYM RT_ICON} + RT_MENU = MAKEINTRESOURCE(4); + {$EXTERNALSYM RT_MENU} + RT_DIALOG = MAKEINTRESOURCE(5); + {$EXTERNALSYM RT_DIALOG} + RT_STRING = MAKEINTRESOURCE(6); + {$EXTERNALSYM RT_STRING} + RT_FONTDIR = MAKEINTRESOURCE(7); + {$EXTERNALSYM RT_FONTDIR} + RT_FONT = MAKEINTRESOURCE(8); + {$EXTERNALSYM RT_FONT} + RT_ACCELERATOR = MAKEINTRESOURCE(9); + {$EXTERNALSYM RT_ACCELERATOR} + RT_RCDATA = MAKEINTRESOURCE(10); + {$EXTERNALSYM RT_RCDATA} + RT_MESSAGETABLE = MAKEINTRESOURCE(11); + {$EXTERNALSYM RT_MESSAGETABLE} + + DIFFERENCE = 11; + {$EXTERNALSYM DIFFERENCE} + + RT_GROUP_CURSOR = MAKEINTRESOURCE(ULONG_PTR(RT_CURSOR) + DIFFERENCE); + {$EXTERNALSYM RT_GROUP_CURSOR} + RT_GROUP_ICON = MAKEINTRESOURCE(ULONG_PTR(RT_ICON) + DIFFERENCE); + {$EXTERNALSYM RT_GROUP_ICON} + RT_VERSION = MAKEINTRESOURCE(16); + {$EXTERNALSYM RT_VERSION} + RT_DLGINCLUDE = MAKEINTRESOURCE(17); + {$EXTERNALSYM RT_DLGINCLUDE} + RT_PLUGPLAY = MAKEINTRESOURCE(19); + {$EXTERNALSYM RT_PLUGPLAY} + RT_VXD = MAKEINTRESOURCE(20); + {$EXTERNALSYM RT_VXD} + RT_ANICURSOR = MAKEINTRESOURCE(21); + {$EXTERNALSYM RT_ANICURSOR} + RT_ANIICON = MAKEINTRESOURCE(22); + {$EXTERNALSYM RT_ANIICON} + RT_HTML = MAKEINTRESOURCE(23); + {$EXTERNALSYM RT_HTML} + RT_MANIFEST = MAKEINTRESOURCE(24); + CREATEPROCESS_MANIFEST_RESOURCE_ID = MAKEINTRESOURCE(1); + {$EXTERNALSYM CREATEPROCESS_MANIFEST_RESOURCE_ID} + ISOLATIONAWARE_MANIFEST_RESOURCE_ID = MAKEINTRESOURCE(2); + {$EXTERNALSYM ISOLATIONAWARE_MANIFEST_RESOURCE_ID} + ISOLATIONAWARE_NOSTATICIMPORT_MANIFEST_RESOURCE_ID = MAKEINTRESOURCE(3); + {$EXTERNALSYM ISOLATIONAWARE_NOSTATICIMPORT_MANIFEST_RESOURCE_ID} + MINIMUM_RESERVED_MANIFEST_RESOURCE_ID = MAKEINTRESOURCE(1{inclusive}); + {$EXTERNALSYM MINIMUM_RESERVED_MANIFEST_RESOURCE_ID} + MAXIMUM_RESERVED_MANIFEST_RESOURCE_ID = MAKEINTRESOURCE(16{inclusive}); + {$EXTERNALSYM MAXIMUM_RESERVED_MANIFEST_RESOURCE_ID} + +// line 1451 + + KLF_SETFORPROCESS = $00000100; + {$EXTERNALSYM KLF_SETFORPROCESS} + KLF_SHIFTLOCK = $00010000; + {$EXTERNALSYM KLF_SHIFTLOCK} + KLF_RESET = $40000000; + {$EXTERNALSYM KLF_RESET} + +// 64 compatible version of GetWindowLong and SetWindowLong + +const + GWLP_WNDPROC = -4; + {$EXTERNALSYM GWLP_WNDPROC} + GWLP_HINSTANCE = -6; + {$EXTERNALSYM GWLP_HINSTANCE} + GWLP_HWNDPARENT = -8; + {$EXTERNALSYM GWLP_HWNDPARENT} + GWLP_USERDATA = -21; + {$EXTERNALSYM GWLP_USERDATA} + GWLP_ID = -12; + {$EXTERNALSYM GWLP_ID} + +{$EXTERNALSYM GetWindowLongPtr} +function GetWindowLongPtr(hWnd: HWND; nIndex: Integer): TJclAddr; stdcall; +{$EXTERNALSYM SetWindowLongPtr} +function SetWindowLongPtr(hWnd: HWND; nIndex: Integer; dwNewLong: TJclAddr): Longint; stdcall; + +function IsPwrSuspendAllowed: BOOL; stdcall; +function IsPwrHibernateAllowed: BOOL; stdcall; +function IsPwrShutdownAllowed: BOOL; stdcall; +function SetSuspendState(Hibernate, ForceCritical, DisableWakeEvent: BOOL): BOOL; stdcall; + +type + // Microsoft version (64 bit SDK) + {$EXTERNALSYM RVA} + RVA = DWORD; + + // 64-bit PE + {$EXTERNALSYM ImgDelayDescrV2} + ImgDelayDescrV2 = packed record + grAttrs: DWORD; // attributes + rvaDLLName: RVA; // RVA to dll name + rvaHmod: RVA; // RVA of module handle + rvaIAT: RVA; // RVA of the IAT + rvaINT: RVA; // RVA of the INT + rvaBoundIAT: RVA; // RVA of the optional bound IAT + rvaUnloadIAT: RVA; // RVA of optional copy of original IAT + dwTimeStamp: DWORD; // 0 if not bound, + // O.W. date/time stamp of DLL bound to (Old BIND) + end; + {$EXTERNALSYM TImgDelayDescrV2} + TImgDelayDescrV2 = ImgDelayDescrV2; + {$EXTERNALSYM PImgDelayDescrV2} + PImgDelayDescrV2 = ^ImgDelayDescrV2; + + {$EXTERNALSYM PHMODULE} + PHMODULE = ^HMODULE; + + // 32-bit PE + {$EXTERNALSYM ImgDelayDescrV1} + ImgDelayDescrV1 = packed record + grAttrs: DWORD; // attributes + szName: LPCSTR; // pointer to dll name + phmod: PHMODULE; // address of module handle + pIAT: PImageThunkData32; // address of the IAT + pINT: PImageThunkData32; // address of the INT + pBoundIAT: PImageThunkData32; // address of the optional bound IAT + pUnloadIAT: PImageThunkData32; // address of optional copy of original IAT + dwTimeStamp: DWORD; // 0 if not bound, + // O.W. date/time stamp of DLL bound to (Old BIND) + end; + {$EXTERNALSYM TImgDelayDescrV1} + TImgDelayDescrV1 = ImgDelayDescrV1; + {$EXTERNALSYM PImgDelayDescrV1} + PImgDelayDescrV1 = ^ImgDelayDescrV1; + + //{$EXTERNALSYM PImgDelayDescr} + //PImgDelayDescr = ImgDelayDescr; + //TImgDelayDescr = ImgDelayDescr; + +// msidefs.h line 349 + +// PIDs given specific meanings for Installer + +const + PID_MSIVERSION = $0000000E; // integer, Installer version number (major*100+minor) + {$EXTERNALSYM PID_MSIVERSION} + PID_MSISOURCE = $0000000F; // integer, type of file image, short/long, media/tree + {$EXTERNALSYM PID_MSISOURCE} + PID_MSIRESTRICT = $00000010; // integer, transform restrictions + {$EXTERNALSYM PID_MSIRESTRICT} + + +// shlguid.h line 404 + +const + FMTID_ShellDetails: TGUID = '{28636aa6-953d-11d2-b5d6-00c04fd918d0}'; + {$EXTERNALSYM FMTID_ShellDetails} + + PID_FINDDATA = 0; + {$EXTERNALSYM PID_FINDDATA} + PID_NETRESOURCE = 1; + {$EXTERNALSYM PID_NETRESOURCE} + PID_DESCRIPTIONID = 2; + {$EXTERNALSYM PID_DESCRIPTIONID} + PID_WHICHFOLDER = 3; + {$EXTERNALSYM PID_WHICHFOLDER} + PID_NETWORKLOCATION = 4; + {$EXTERNALSYM PID_NETWORKLOCATION} + PID_COMPUTERNAME = 5; + {$EXTERNALSYM PID_COMPUTERNAME} + +// PSGUID_STORAGE comes from ntquery.h +const + FMTID_Storage: TGUID = '{b725f130-47ef-101a-a5f1-02608c9eebac}'; + {$EXTERNALSYM FMTID_Storage} + +// Image properties +const + FMTID_ImageProperties: TGUID = '{14b81da1-0135-4d31-96d9-6cbfc9671a99}'; + {$EXTERNALSYM FMTID_ImageProperties} + +// The GUIDs used to identify shell item attributes (columns). See IShellFolder2::GetDetailsEx implementations... + +const + FMTID_Displaced: TGUID = '{9B174B33-40FF-11d2-A27E-00C04FC30871}'; + {$EXTERNALSYM FMTID_Displaced} + PID_DISPLACED_FROM = 2; + {$EXTERNALSYM PID_DISPLACED_FROM} + PID_DISPLACED_DATE = 3; + {$EXTERNALSYM PID_DISPLACED_DATE} + +const + FMTID_Briefcase: TGUID = '{328D8B21-7729-4bfc-954C-902B329D56B0}'; + {$EXTERNALSYM FMTID_Briefcase} + PID_SYNC_COPY_IN = 2; + {$EXTERNALSYM PID_SYNC_COPY_IN} + +const + FMTID_Misc: TGUID = '{9B174B34-40FF-11d2-A27E-00C04FC30871}'; + {$EXTERNALSYM FMTID_Misc} + PID_MISC_STATUS = 2; + {$EXTERNALSYM PID_MISC_STATUS} + PID_MISC_ACCESSCOUNT = 3; + {$EXTERNALSYM PID_MISC_ACCESSCOUNT} + PID_MISC_OWNER = 4; + {$EXTERNALSYM PID_MISC_OWNER} + PID_HTMLINFOTIPFILE = 5; + {$EXTERNALSYM PID_HTMLINFOTIPFILE} + PID_MISC_PICS = 6; + {$EXTERNALSYM PID_MISC_PICS} + +const + FMTID_WebView: TGUID = '{F2275480-F782-4291-BD94-F13693513AEC}'; + {$EXTERNALSYM FMTID_WebView} + PID_DISPLAY_PROPERTIES = 0; + {$EXTERNALSYM PID_DISPLAY_PROPERTIES} + PID_INTROTEXT = 1; + {$EXTERNALSYM PID_INTROTEXT} + +const + FMTID_MUSIC: TGUID = '{56A3372E-CE9C-11d2-9F0E-006097C686F6}'; + {$EXTERNALSYM FMTID_MUSIC} + PIDSI_ARTIST = 2; + {$EXTERNALSYM PIDSI_ARTIST} + PIDSI_SONGTITLE = 3; + {$EXTERNALSYM PIDSI_SONGTITLE} + PIDSI_ALBUM = 4; + {$EXTERNALSYM PIDSI_ALBUM} + PIDSI_YEAR = 5; + {$EXTERNALSYM PIDSI_YEAR} + PIDSI_COMMENT = 6; + {$EXTERNALSYM PIDSI_COMMENT} + PIDSI_TRACK = 7; + {$EXTERNALSYM PIDSI_TRACK} + PIDSI_GENRE = 11; + {$EXTERNALSYM PIDSI_GENRE} + PIDSI_LYRICS = 12; + {$EXTERNALSYM PIDSI_LYRICS} + +const + FMTID_DRM: TGUID = '{AEAC19E4-89AE-4508-B9B7-BB867ABEE2ED}'; + {$EXTERNALSYM FMTID_DRM} + PIDDRSI_PROTECTED = 2; + {$EXTERNALSYM PIDDRSI_PROTECTED} + PIDDRSI_DESCRIPTION = 3; + {$EXTERNALSYM PIDDRSI_DESCRIPTION} + PIDDRSI_PLAYCOUNT = 4; + {$EXTERNALSYM PIDDRSI_PLAYCOUNT} + PIDDRSI_PLAYSTARTS = 5; + {$EXTERNALSYM PIDDRSI_PLAYSTARTS} + PIDDRSI_PLAYEXPIRES = 6; + {$EXTERNALSYM PIDDRSI_PLAYEXPIRES} + +// FMTID_VideoSummaryInformation property identifiers +const + FMTID_Video: TGUID = '{64440491-4c8b-11d1-8b70-080036b11a03}'; + {$EXTERNALSYM FMTID_Video} + PIDVSI_STREAM_NAME = $00000002; // "StreamName", VT_LPWSTR + {$EXTERNALSYM PIDVSI_STREAM_NAME} + PIDVSI_FRAME_WIDTH = $00000003; // "FrameWidth", VT_UI4 + {$EXTERNALSYM PIDVSI_FRAME_WIDTH} + PIDVSI_FRAME_HEIGHT = $00000004; // "FrameHeight", VT_UI4 + {$EXTERNALSYM PIDVSI_FRAME_HEIGHT} + PIDVSI_TIMELENGTH = $00000007; // "TimeLength", VT_UI4, milliseconds + {$EXTERNALSYM PIDVSI_TIMELENGTH} + PIDVSI_FRAME_COUNT = $00000005; // "FrameCount". VT_UI4 + {$EXTERNALSYM PIDVSI_FRAME_COUNT} + PIDVSI_FRAME_RATE = $00000006; // "FrameRate", VT_UI4, frames/millisecond + {$EXTERNALSYM PIDVSI_FRAME_RATE} + PIDVSI_DATA_RATE = $00000008; // "DataRate", VT_UI4, bytes/second + {$EXTERNALSYM PIDVSI_DATA_RATE} + PIDVSI_SAMPLE_SIZE = $00000009; // "SampleSize", VT_UI4 + {$EXTERNALSYM PIDVSI_SAMPLE_SIZE} + PIDVSI_COMPRESSION = $0000000A; // "Compression", VT_LPWSTR + {$EXTERNALSYM PIDVSI_COMPRESSION} + PIDVSI_STREAM_NUMBER = $0000000B; // "StreamNumber", VT_UI2 + {$EXTERNALSYM PIDVSI_STREAM_NUMBER} + +// FMTID_AudioSummaryInformation property identifiers +const + FMTID_Audio: TGUID = '{64440490-4c8b-11d1-8b70-080036b11a03}'; + {$EXTERNALSYM FMTID_Audio} + PIDASI_FORMAT = $00000002; // VT_BSTR + {$EXTERNALSYM PIDASI_FORMAT} + PIDASI_TIMELENGTH = $00000003; // VT_UI4, milliseconds + {$EXTERNALSYM PIDASI_TIMELENGTH} + PIDASI_AVG_DATA_RATE = $00000004; // VT_UI4, Hz + {$EXTERNALSYM PIDASI_AVG_DATA_RATE} + PIDASI_SAMPLE_RATE = $00000005; // VT_UI4, bits + {$EXTERNALSYM PIDASI_SAMPLE_RATE} + PIDASI_SAMPLE_SIZE = $00000006; // VT_UI4, bits + {$EXTERNALSYM PIDASI_SAMPLE_SIZE} + PIDASI_CHANNEL_COUNT = $00000007; // VT_UI4 + {$EXTERNALSYM PIDASI_CHANNEL_COUNT} + PIDASI_STREAM_NUMBER = $00000008; // VT_UI2 + {$EXTERNALSYM PIDASI_STREAM_NUMBER} + PIDASI_STREAM_NAME = $00000009; // VT_LPWSTR + {$EXTERNALSYM PIDASI_STREAM_NAME} + PIDASI_COMPRESSION = $0000000A; // VT_LPWSTR + {$EXTERNALSYM PIDASI_COMPRESSION} + +const + FMTID_ControlPanel: TGUID = '{305CA226-D286-468e-B848-2B2E8E697B74}'; + {$EXTERNALSYM FMTID_ControlPanel} + PID_CONTROLPANEL_CATEGORY = 2; + {$EXTERNALSYM PID_CONTROLPANEL_CATEGORY} + +const + FMTID_Volume: TGUID = '{9B174B35-40FF-11d2-A27E-00C04FC30871}'; + {$EXTERNALSYM FMTID_Volume} + PID_VOLUME_FREE = 2; + {$EXTERNALSYM PID_VOLUME_FREE} + PID_VOLUME_CAPACITY = 3; + {$EXTERNALSYM PID_VOLUME_CAPACITY} + PID_VOLUME_FILESYSTEM = 4; + {$EXTERNALSYM PID_VOLUME_FILESYSTEM} + +const + FMTID_Share: TGUID = '{D8C3986F-813B-449c-845D-87B95D674ADE}'; + {$EXTERNALSYM FMTID_Share} + PID_SHARE_CSC_STATUS = 2; + {$EXTERNALSYM PID_SHARE_CSC_STATUS} + +const + FMTID_Link: TGUID = '{B9B4B3FC-2B51-4a42-B5D8-324146AFCF25}'; + {$EXTERNALSYM FMTID_Link} + PID_LINK_TARGET = 2; + {$EXTERNALSYM PID_LINK_TARGET} + +const + FMTID_Query: TGUID = '{49691c90-7e17-101a-a91c-08002b2ecda9}'; + {$EXTERNALSYM FMTID_Query} + PID_QUERY_RANK = 2; + {$EXTERNALSYM PID_QUERY_RANK} + +const + FMTID_SummaryInformation: TGUID = '{f29f85e0-4ff9-1068-ab91-08002b27b3d9}'; + {$EXTERNALSYM FMTID_SummaryInformation} + FMTID_DocumentSummaryInformation: TGUID = '{d5cdd502-2e9c-101b-9397-08002b2cf9ae}'; + {$EXTERNALSYM FMTID_DocumentSummaryInformation} + FMTID_MediaFileSummaryInformation: TGUID = '{64440492-4c8b-11d1-8b70-080036b11a03}'; + {$EXTERNALSYM FMTID_MediaFileSummaryInformation} + FMTID_ImageSummaryInformation: TGUID = '{6444048f-4c8b-11d1-8b70-080036b11a03}'; + {$EXTERNALSYM FMTID_ImageSummaryInformation} + +// imgguids.h line 75 + +// Property sets +const + FMTID_ImageInformation: TGUID = '{e5836cbe-5eef-4f1d-acde-ae4c43b608ce}'; + {$EXTERNALSYM FMTID_ImageInformation} + FMTID_JpegAppHeaders: TGUID = '{1c4afdcd-6177-43cf-abc7-5f51af39ee85}'; + {$EXTERNALSYM FMTID_JpegAppHeaders} + + + +// objbase.h line 390 +const + STGFMT_STORAGE = 0; + {$EXTERNALSYM STGFMT_STORAGE} + STGFMT_NATIVE = 1; + {$EXTERNALSYM STGFMT_NATIVE} + STGFMT_FILE = 3; + {$EXTERNALSYM STGFMT_FILE} + STGFMT_ANY = 4; + {$EXTERNALSYM STGFMT_ANY} + STGFMT_DOCFILE = 5; + {$EXTERNALSYM STGFMT_DOCFILE} +// This is a legacy define to allow old component to builds + STGFMT_DOCUMENT = 0; + {$EXTERNALSYM STGFMT_DOCUMENT} + +// objbase.h line 913 + +type + tagSTGOPTIONS = record + usVersion: Word; // Versions 1 and 2 supported + reserved: Word; // must be 0 for padding + ulSectorSize: Cardinal; // docfile header sector size (512) + pwcsTemplateFile: PWideChar; // version 2 or above + end; + {$EXTERNALSYM tagSTGOPTIONS} + STGOPTIONS = tagSTGOPTIONS; + {$EXTERNALSYM STGOPTIONS} + PSTGOPTIONS = ^STGOPTIONS; + {$EXTERNALSYM PSTGOPTIONS} + +function StgCreateStorageEx(const pwcsName: PWideChar; grfMode: DWORD; + stgfmt: DWORD; grfAttrs: DWORD; pStgOptions: PSTGOPTIONS; reserved2: Pointer; + riid: PGUID; out stgOpen: IInterface): HResult; stdcall; +{$EXTERNALSYM StgCreateStorageEx} + +function StgOpenStorageEx(const pwcsName: PWideChar; grfMode: DWORD; + stgfmt: DWORD; grfAttrs: DWORD; pStgOptions: PSTGOPTIONS; reserved2: Pointer; + riid: PGUID; out stgOpen: IInterface): HResult; stdcall; +{$EXTERNALSYM StgOpenStorageEx} + + +// propidl.h line 386 + +// Reserved global Property IDs +const + PID_DICTIONARY = $00000000; // integer count + array of entries + {$EXTERNALSYM PID_DICTIONARY} + PID_CODEPAGE = $00000001; // short integer + {$EXTERNALSYM PID_CODEPAGE} + PID_FIRST_USABLE = $00000002; + {$EXTERNALSYM PID_FIRST_USABLE} + PID_FIRST_NAME_DEFAULT = $00000FFF; + {$EXTERNALSYM PID_FIRST_NAME_DEFAULT} + PID_LOCALE = $80000000; + {$EXTERNALSYM PID_LOCALE} + PID_MODIFY_TIME = $80000001; + {$EXTERNALSYM PID_MODIFY_TIME} + PID_SECURITY = $80000002; + {$EXTERNALSYM PID_SECURITY} + PID_BEHAVIOR = $80000003; + {$EXTERNALSYM PID_BEHAVIOR} + PID_ILLEGAL = $FFFFFFFF; + {$EXTERNALSYM PID_ILLEGAL} + +// Range which is read-only to downlevel implementations + +const + PID_MIN_READONLY = $80000000; + {$EXTERNALSYM PID_MIN_READONLY} + PID_MAX_READONLY = $BFFFFFFF; + {$EXTERNALSYM PID_MAX_READONLY} + +// Property IDs for the DiscardableInformation Property Set + +const + PIDDI_THUMBNAIL = $00000002; // VT_BLOB + {$EXTERNALSYM PIDDI_THUMBNAIL} + +// Property IDs for the SummaryInformation Property Set + +const + PIDSI_TITLE = $00000002; // VT_LPSTR + {$EXTERNALSYM PIDSI_TITLE} + PIDSI_SUBJECT = $00000003; // VT_LPSTR + {$EXTERNALSYM PIDSI_SUBJECT} + PIDSI_AUTHOR = $00000004; // VT_LPSTR + {$EXTERNALSYM PIDSI_AUTHOR} + PIDSI_KEYWORDS = $00000005; // VT_LPSTR + {$EXTERNALSYM PIDSI_KEYWORDS} + PIDSI_COMMENTS = $00000006; // VT_LPSTR + {$EXTERNALSYM PIDSI_COMMENTS} + PIDSI_TEMPLATE = $00000007; // VT_LPSTR + {$EXTERNALSYM PIDSI_TEMPLATE} + PIDSI_LASTAUTHOR = $00000008; // VT_LPSTR + {$EXTERNALSYM PIDSI_LASTAUTHOR} + PIDSI_REVNUMBER = $00000009; // VT_LPSTR + {$EXTERNALSYM PIDSI_REVNUMBER} + PIDSI_EDITTIME = $0000000A; // VT_FILETIME (UTC) + {$EXTERNALSYM PIDSI_EDITTIME} + PIDSI_LASTPRINTED = $0000000B; // VT_FILETIME (UTC) + {$EXTERNALSYM PIDSI_LASTPRINTED} + PIDSI_CREATE_DTM = $0000000C; // VT_FILETIME (UTC) + {$EXTERNALSYM PIDSI_CREATE_DTM} + PIDSI_LASTSAVE_DTM = $0000000D; // VT_FILETIME (UTC) + {$EXTERNALSYM PIDSI_LASTSAVE_DTM} + PIDSI_PAGECOUNT = $0000000E; // VT_I4 + {$EXTERNALSYM PIDSI_PAGECOUNT} + PIDSI_WORDCOUNT = $0000000F; // VT_I4 + {$EXTERNALSYM PIDSI_WORDCOUNT} + PIDSI_CHARCOUNT = $00000010; // VT_I4 + {$EXTERNALSYM PIDSI_CHARCOUNT} + PIDSI_THUMBNAIL = $00000011; // VT_CF + {$EXTERNALSYM PIDSI_THUMBNAIL} + PIDSI_APPNAME = $00000012; // VT_LPSTR + {$EXTERNALSYM PIDSI_APPNAME} + PIDSI_DOC_SECURITY = $00000013; // VT_I4 + {$EXTERNALSYM PIDSI_DOC_SECURITY} + +// Property IDs for the DocSummaryInformation Property Set + +const + PIDDSI_CATEGORY = $00000002; // VT_LPSTR + {$EXTERNALSYM PIDDSI_CATEGORY} + PIDDSI_PRESFORMAT = $00000003; // VT_LPSTR + {$EXTERNALSYM PIDDSI_PRESFORMAT} + PIDDSI_BYTECOUNT = $00000004; // VT_I4 + {$EXTERNALSYM PIDDSI_BYTECOUNT} + PIDDSI_LINECOUNT = $00000005; // VT_I4 + {$EXTERNALSYM PIDDSI_LINECOUNT} + PIDDSI_PARCOUNT = $00000006; // VT_I4 + {$EXTERNALSYM PIDDSI_PARCOUNT} + PIDDSI_SLIDECOUNT = $00000007; // VT_I4 + {$EXTERNALSYM PIDDSI_SLIDECOUNT} + PIDDSI_NOTECOUNT = $00000008; // VT_I4 + {$EXTERNALSYM PIDDSI_NOTECOUNT} + PIDDSI_HIDDENCOUNT = $00000009; // VT_I4 + {$EXTERNALSYM PIDDSI_HIDDENCOUNT} + PIDDSI_MMCLIPCOUNT = $0000000A; // VT_I4 + {$EXTERNALSYM PIDDSI_MMCLIPCOUNT} + PIDDSI_SCALE = $0000000B; // VT_BOOL + {$EXTERNALSYM PIDDSI_SCALE} + PIDDSI_HEADINGPAIR = $0000000C; // VT_VARIANT | VT_VECTOR + {$EXTERNALSYM PIDDSI_HEADINGPAIR} + PIDDSI_DOCPARTS = $0000000D; // VT_LPSTR | VT_VECTOR + {$EXTERNALSYM PIDDSI_DOCPARTS} + PIDDSI_MANAGER = $0000000E; // VT_LPSTR + {$EXTERNALSYM PIDDSI_MANAGER} + PIDDSI_COMPANY = $0000000F; // VT_LPSTR + {$EXTERNALSYM PIDDSI_COMPANY} + PIDDSI_LINKSDIRTY = $00000010; // VT_BOOL + {$EXTERNALSYM PIDDSI_LINKSDIRTY} + +// FMTID_MediaFileSummaryInfo - Property IDs + +const + PIDMSI_EDITOR = $00000002; // VT_LPWSTR + {$EXTERNALSYM PIDMSI_EDITOR} + PIDMSI_SUPPLIER = $00000003; // VT_LPWSTR + {$EXTERNALSYM PIDMSI_SUPPLIER} + PIDMSI_SOURCE = $00000004; // VT_LPWSTR + {$EXTERNALSYM PIDMSI_SOURCE} + PIDMSI_SEQUENCE_NO = $00000005; // VT_LPWSTR + {$EXTERNALSYM PIDMSI_SEQUENCE_NO} + PIDMSI_PROJECT = $00000006; // VT_LPWSTR + {$EXTERNALSYM PIDMSI_PROJECT} + PIDMSI_STATUS = $00000007; // VT_UI4 + {$EXTERNALSYM PIDMSI_STATUS} + PIDMSI_OWNER = $00000008; // VT_LPWSTR + {$EXTERNALSYM PIDMSI_OWNER} + PIDMSI_RATING = $00000009; // VT_LPWSTR + {$EXTERNALSYM PIDMSI_RATING} + PIDMSI_PRODUCTION = $0000000A; // VT_FILETIME (UTC) + {$EXTERNALSYM PIDMSI_PRODUCTION} + PIDMSI_COPYRIGHT = $0000000B; // VT_LPWSTR + {$EXTERNALSYM PIDMSI_COPYRIGHT} + +function PropVariantClear(var Prop: TPropVariant): HResult; stdcall; +{$EXTERNALSYM PropVariantClear} + + +// NtSecApi.h line 566 +type + PLSA_UNICODE_STRING = ^LSA_UNICODE_STRING; + _LSA_UNICODE_STRING = record + Length: USHORT; + MaximumLength: USHORT; + Buffer: {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.LPWSTR; + end; + LSA_UNICODE_STRING = _LSA_UNICODE_STRING; + TLsaUnicodeString = LSA_UNICODE_STRING; + PLsaUnicodeString = PLSA_UNICODE_STRING; + + PLSA_STRING = ^LSA_STRING; + _LSA_STRING = record + Length: USHORT; + MaximumLength: USHORT; + Buffer: PANSICHAR; + end; + LSA_STRING = _LSA_STRING; + TLsaString = LSA_STRING; + PLsaString = PLSA_STRING; + + PLSA_OBJECT_ATTRIBUTES = ^LSA_OBJECT_ATTRIBUTES; + _LSA_OBJECT_ATTRIBUTES = record + Length: ULONG; + RootDirectory: {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.THandle; + ObjectName: PLSA_UNICODE_STRING; + Attributes: ULONG; + SecurityDescriptor: Pointer; // Points to type SECURITY_DESCRIPTOR + SecurityQualityOfService: Pointer; // Points to type SECURITY_QUALITY_OF_SERVICE + end; + LSA_OBJECT_ATTRIBUTES = _LSA_OBJECT_ATTRIBUTES; + TLsaObjectAttributes = _LSA_OBJECT_ATTRIBUTES; + PLsaObjectAttributes = PLSA_OBJECT_ATTRIBUTES; + +// NtSecApi.h line 680 + +//////////////////////////////////////////////////////////////////////////// +// // +// Local Security Policy Administration API datatypes and defines // +// // +//////////////////////////////////////////////////////////////////////////// + +// +// Access types for the Policy object +// + +const + POLICY_VIEW_LOCAL_INFORMATION = $00000001; + {$EXTERNALSYM POLICY_VIEW_LOCAL_INFORMATION} + POLICY_VIEW_AUDIT_INFORMATION = $00000002; + {$EXTERNALSYM POLICY_VIEW_AUDIT_INFORMATION} + POLICY_GET_PRIVATE_INFORMATION = $00000004; + {$EXTERNALSYM POLICY_GET_PRIVATE_INFORMATION} + POLICY_TRUST_ADMIN = $00000008; + {$EXTERNALSYM POLICY_TRUST_ADMIN} + POLICY_CREATE_ACCOUNT = $00000010; + {$EXTERNALSYM POLICY_CREATE_ACCOUNT} + POLICY_CREATE_SECRET = $00000020; + {$EXTERNALSYM POLICY_CREATE_SECRET} + POLICY_CREATE_PRIVILEGE = $00000040; + {$EXTERNALSYM POLICY_CREATE_PRIVILEGE} + POLICY_SET_DEFAULT_QUOTA_LIMITS = $00000080; + {$EXTERNALSYM POLICY_SET_DEFAULT_QUOTA_LIMITS} + POLICY_SET_AUDIT_REQUIREMENTS = $00000100; + {$EXTERNALSYM POLICY_SET_AUDIT_REQUIREMENTS} + POLICY_AUDIT_LOG_ADMIN = $00000200; + {$EXTERNALSYM POLICY_AUDIT_LOG_ADMIN} + POLICY_SERVER_ADMIN = $00000400; + {$EXTERNALSYM POLICY_SERVER_ADMIN} + POLICY_LOOKUP_NAMES = $00000800; + {$EXTERNALSYM POLICY_LOOKUP_NAMES} + POLICY_NOTIFICATION = $00001000; + {$EXTERNALSYM POLICY_NOTIFICATION} + + POLICY_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED or + POLICY_VIEW_LOCAL_INFORMATION or + POLICY_VIEW_AUDIT_INFORMATION or + POLICY_GET_PRIVATE_INFORMATION or + POLICY_TRUST_ADMIN or + POLICY_CREATE_ACCOUNT or + POLICY_CREATE_SECRET or + POLICY_CREATE_PRIVILEGE or + POLICY_SET_DEFAULT_QUOTA_LIMITS or + POLICY_SET_AUDIT_REQUIREMENTS or + POLICY_AUDIT_LOG_ADMIN or + POLICY_SERVER_ADMIN or + POLICY_LOOKUP_NAMES); + {$EXTERNALSYM POLICY_ALL_ACCESS} + + POLICY_READ = (STANDARD_RIGHTS_READ or + POLICY_VIEW_AUDIT_INFORMATION or + POLICY_GET_PRIVATE_INFORMATION); + {$EXTERNALSYM POLICY_READ} + + POLICY_WRITE = (STANDARD_RIGHTS_WRITE or + POLICY_TRUST_ADMIN or + POLICY_CREATE_ACCOUNT or + POLICY_CREATE_SECRET or + POLICY_CREATE_PRIVILEGE or + POLICY_SET_DEFAULT_QUOTA_LIMITS or + POLICY_SET_AUDIT_REQUIREMENTS or + POLICY_AUDIT_LOG_ADMIN or + POLICY_SERVER_ADMIN); + {$EXTERNALSYM POLICY_WRITE} + + POLICY_EXECUTE = (STANDARD_RIGHTS_EXECUTE or + POLICY_VIEW_LOCAL_INFORMATION or + POLICY_LOOKUP_NAMES); + {$EXTERNALSYM POLICY_EXECUTE} + +// NtSecApi.h line 914 +type + _POLICY_INFORMATION_CLASS = ( + picFill0, + PolicyAuditLogInformation, + PolicyAuditEventsInformation, + PolicyPrimaryDomainInformation, + PolicyPdAccountInformation, + PolicyAccountDomainInformation, + PolicyLsaServerRoleInformation, + PolicyReplicaSourceInformation, + PolicyDefaultQuotaInformation, + PolicyModificationInformation, + PolicyAuditFullSetInformation, + PolicyAuditFullQueryInformation, + PolicyDnsDomainInformation, + PolicyDnsDomainInformationInt); + {$EXTERNALSYM _POLICY_INFORMATION_CLASS} + POLICY_INFORMATION_CLASS = _POLICY_INFORMATION_CLASS; + {$EXTERNALSYM POLICY_INFORMATION_CLASS} + PPOLICY_INFORMATION_CLASS = ^POLICY_INFORMATION_CLASS; + {$EXTERNALSYM PPOLICY_INFORMATION_CLASS} + TPolicyInformationClass = POLICY_INFORMATION_CLASS; + {$EXTERNALSYM TPolicyInformationClass} + PPolicyInformationClass = PPOLICY_INFORMATION_CLASS; + {$EXTERNALSYM PPolicyInformationClass} + +// NtSecApi.h line 1031 +// +// The following structure corresponds to the PolicyAccountDomainInformation +// information class. +// +type + PPOLICY_ACCOUNT_DOMAIN_INFO = ^POLICY_ACCOUNT_DOMAIN_INFO; + _POLICY_ACCOUNT_DOMAIN_INFO = record + DomainName: LSA_UNICODE_STRING; + DomainSid: {$IFDEF HAS_UNITSCOPE}Winapi.{$ENDIF}Windows.PSID; + end; + POLICY_ACCOUNT_DOMAIN_INFO = _POLICY_ACCOUNT_DOMAIN_INFO; + TPolicyAccountDomainInfo = POLICY_ACCOUNT_DOMAIN_INFO; + PPolicyAccountDomainInfo = PPOLICY_ACCOUNT_DOMAIN_INFO; + +// NtSecApi.h line 1298 +type + LSA_HANDLE = Pointer; + PLSA_HANDLE = ^LSA_HANDLE; + TLsaHandle = LSA_HANDLE; + +// NtSecApi.h line 1714 +type + NTSTATUS = DWORD; + +function LsaOpenPolicy(SystemName: PLSA_UNICODE_STRING; + var ObjectAttributes: LSA_OBJECT_ATTRIBUTES; DesiredAccess: ACCESS_MASK; + var PolicyHandle: LSA_HANDLE): NTSTATUS; stdcall; +function LsaQueryInformationPolicy(PolicyHandle: LSA_HANDLE; + InformationClass: POLICY_INFORMATION_CLASS; var Buffer: Pointer): NTSTATUS; stdcall; +function LsaFreeMemory(Buffer: Pointer): NTSTATUS; stdcall; +function LsaFreeReturnBuffer(Buffer: Pointer): NTSTATUS; stdcall; +function LsaClose(ObjectHandle: LSA_HANDLE): NTSTATUS; stdcall; +function LsaNtStatusToWinError(Status: NTSTATUS): ULONG; stdcall; + + +// Snapshot function + +function CreateToolhelp32Snapshot(dwFlags, th32ProcessID: DWORD): THandle; stdcall; +{$EXTERNALSYM CreateToolhelp32Snapshot} + +// +// The th32ProcessID argument is only used if TH32CS_SNAPHEAPLIST or +// TH32CS_SNAPMODULE is specified. th32ProcessID == 0 means the current +// process. +// +// NOTE that all of the snapshots are global except for the heap and module +// lists which are process specific. To enumerate the heap or module +// state for all WIN32 processes call with TH32CS_SNAPALL and the +// current process. Then for each process in the TH32CS_SNAPPROCESS +// list that isn't the current process, do a call with just +// TH32CS_SNAPHEAPLIST and/or TH32CS_SNAPMODULE. +// +// dwFlags +// + +const + TH32CS_SNAPHEAPLIST = $00000001; + {$EXTERNALSYM TH32CS_SNAPHEAPLIST} + TH32CS_SNAPPROCESS = $00000002; + {$EXTERNALSYM TH32CS_SNAPPROCESS} + TH32CS_SNAPTHREAD = $00000004; + {$EXTERNALSYM TH32CS_SNAPTHREAD} + TH32CS_SNAPMODULE = $00000008; + {$EXTERNALSYM TH32CS_SNAPMODULE} + TH32CS_SNAPMODULE32 = $00000010; + {$EXTERNALSYM TH32CS_SNAPMODULE32} + TH32CS_SNAPALL = TH32CS_SNAPHEAPLIST or TH32CS_SNAPPROCESS or + TH32CS_SNAPTHREAD or TH32CS_SNAPMODULE; + {$EXTERNALSYM TH32CS_SNAPALL} + TH32CS_INHERIT = $80000000; + {$EXTERNALSYM TH32CS_INHERIT} + +// +// Use CloseHandle to destroy the snapshot +// + +// Thread walking + +type + PTHREADENTRY32 = ^THREADENTRY32; + {$EXTERNALSYM PTHREADENTRY32} + tagTHREADENTRY32 = record + dwSize: DWORD; + cntUsage: DWORD; + th32ThreadID: DWORD; // this thread + th32OwnerProcessID: DWORD; // Process this thread is associated with + tpBasePri: Longint; + tpDeltaPri: Longint; + dwFlags: DWORD; + end; + {$EXTERNALSYM tagTHREADENTRY32} + THREADENTRY32 = tagTHREADENTRY32; + {$EXTERNALSYM THREADENTRY32} + LPTHREADENTRY32 = ^THREADENTRY32; + {$EXTERNALSYM LPTHREADENTRY32} + TThreadEntry32 = THREADENTRY32; + {$EXTERNALSYM TThreadEntry32} + +function Thread32First(hSnapshot: THandle; var lpte: THREADENTRY32): BOOL; stdcall; +{$EXTERNALSYM Thread32First} +function Thread32Next(hSnapshot: THandle; var lpte: THREADENTRY32): BOOL; stdcall; +{$EXTERNALSYM Thread32Next} + + + +type + _THREAD_INFORMATION_CLASS = type Cardinal; + {$EXTERNALSYM _THREAD_INFORMATION_CLASS} + THREAD_INFORMATION_CLASS = _THREAD_INFORMATION_CLASS; + {$EXTERNALSYM THREAD_INFORMATION_CLASS} + PTHREAD_INFORMATION_CLASS = ^_THREAD_INFORMATION_CLASS; + {$EXTERNALSYM PTHREAD_INFORMATION_CLASS} + +const + ThreadBasicInformation = 0; + {$EXTERNALSYM ThreadBasicInformation} + ThreadTimes = 1; + {$EXTERNALSYM ThreadTimes} + ThreadPriority = 2; + {$EXTERNALSYM ThreadPriority} + ThreadBasePriority = 3; + {$EXTERNALSYM ThreadBasePriority} + ThreadAffinityMask = 4; + {$EXTERNALSYM ThreadAffinityMask} + ThreadImpersonationToken = 5; + {$EXTERNALSYM ThreadImpersonationToken} + ThreadDescriptorTableEntry = 6; + {$EXTERNALSYM ThreadDescriptorTableEntry} + ThreadEnableAlignmentFaultFixup = 7; + {$EXTERNALSYM ThreadEnableAlignmentFaultFixup} + ThreadEventPair = 8; + {$EXTERNALSYM ThreadEventPair} + ThreadQuerySetWin32StartAddress = 9; + {$EXTERNALSYM ThreadQuerySetWin32StartAddress} + ThreadZeroTlsCell = 10; + {$EXTERNALSYM ThreadZeroTlsCell} + ThreadPerformanceCount = 11; + {$EXTERNALSYM ThreadPerformanceCount} + ThreadAmILastThread = 12; + {$EXTERNALSYM ThreadAmILastThread} + ThreadIdealProcessor = 13; + {$EXTERNALSYM ThreadIdealProcessor} + ThreadPriorityBoost = 14; + {$EXTERNALSYM ThreadPriorityBoost} + ThreadSetTlsArrayAddress = 15; + {$EXTERNALSYM ThreadSetTlsArrayAddress} + ThreadIsIoPending = 16; + {$EXTERNALSYM ThreadIsIoPending} + ThreadHideFromDebugger = 17; + {$EXTERNALSYM ThreadHideFromDebugger} + +type + _CLIENT_ID = record + UniqueProcess: THandle; + UniqueThread: THandle; + end; + {$EXTERNALSYM _CLIENT_ID} + CLIENT_ID = _CLIENT_ID; + {$EXTERNALSYM CLIENT_ID} + PCLIENT_ID = ^CLIENT_ID; + {$EXTERNALSYM PCLIENT_ID} + + KAFFINITY = ULONG; + {$EXTERNALSYM KAFFINITY} + + KPRIORITY = LongInt; + {$EXTERNALSYM KPRIORITY} + + _THREAD_BASIC_INFORMATION = record + ExitStatus: NTSTATUS; + TebBaseAddress: Pointer; + ClientId: CLIENT_ID; + AffinityMask: KAFFINITY; + Priority: KPRIORITY; + BasePriority: KPRIORITY; + end; + {$EXTERNALSYM _THREAD_BASIC_INFORMATION} + THREAD_BASIC_INFORMATION = _THREAD_BASIC_INFORMATION; + {$EXTERNALSYM THREAD_BASIC_INFORMATION} + PTHREAD_BASIC_INFORMATION = ^_THREAD_BASIC_INFORMATION; + {$EXTERNALSYM PTHREAD_BASIC_INFORMATION} + +function NtQueryInformationThread(ThreadHandle: THandle; ThreadInformationClass: THREAD_INFORMATION_CLASS; + ThreadInformation: Pointer; ThreadInformationLength: ULONG; ReturnLength: PULONG): NTSTATUS; stdcall; +{$EXTERNALSYM NtQueryInformationThread} + + + +//DOM-IGNORE-END + + +const + RtdlSetNamedSecurityInfoW: function(pObjectName: LPWSTR; ObjectType: SE_OBJECT_TYPE; + SecurityInfo: SECURITY_INFORMATION; psidOwner, psidGroup: PSID; + pDacl, pSacl: PACL): DWORD stdcall = SetNamedSecurityInfoW; + + RtdlSetWaitableTimer: function(hTimer: THandle; var lpDueTime: TLargeInteger; + lPeriod: Longint; pfnCompletionRoutine: TFNTimerAPCRoutine; + lpArgToCompletionRoutine: Pointer; fResume: BOOL): BOOL stdcall = SetWaitableTimer; + + RtdlNetUserAdd: function(servername: LPCWSTR; level: DWORD; + buf: PByte; parm_err: PDWord): NET_API_STATUS stdcall = NetUserAdd; + + RtdlNetUserDel: function(servername: LPCWSTR; + username: LPCWSTR): NET_API_STATUS stdcall = NetUserDel; + + RtdlNetGroupAdd: function(servername: LPCWSTR; level: DWORD; buf: PByte; + parm_err: PDWord): NET_API_STATUS stdcall = NetGroupAdd; + + RtdlNetGroupEnum: function(servername: LPCWSTR; level: DWORD; + out bufptr: PByte; prefmaxlen: DWORD; out entriesread, totalentries: DWORD; + resume_handle: PDWORD_PTR): NET_API_STATUS stdcall = NetGroupEnum; + + RtdlNetGroupDel: function(servername: LPCWSTR; + groupname: LPCWSTR): NET_API_STATUS stdcall = NetGroupDel; + + RtdlNetLocalGroupAdd: function(servername: LPCWSTR; level: DWORD; + buf: PByte; parm_err: PDWord): NET_API_STATUS stdcall = NetLocalGroupAdd; + + RtdlNetLocalGroupEnum: function(servername: LPCWSTR; level: DWORD; + out bufptr: PByte; prefmaxlen: DWORD; out entriesread, totalentries: DWORD; + resumehandle: PDWORD_PTR): NET_API_STATUS stdcall = NetLocalGroupEnum; + + RtdlNetLocalGroupDel: function(servername: LPCWSTR; + groupname: LPCWSTR): NET_API_STATUS stdcall = NetLocalGroupDel; + + RtdlNetLocalGroupAddMembers: function(servername: LPCWSTR; groupname: LPCWSTR; + level: DWORD; buf: PByte; + totalentries: DWORD): NET_API_STATUS stdcall = NetLocalGroupAddMembers; + + RtdlNetApiBufferFree: function(Buffer: Pointer): NET_API_STATUS stdcall = NetApiBufferFree; + + RtdlGetCalendarInfoA: function(Locale: LCID; Calendar: CALID; CalType: CALTYPE; + lpCalData: PAnsiChar; cchData: Integer; + lpValue: PDWORD): Integer stdcall = GetCalendarInfoA; + + RtdlGetCalendarInfoW: function(Locale: LCID; Calendar: CALID; CalType: CALTYPE; + lpCalData: PWideChar; cchData: Integer; + lpValue: PDWORD): Integer stdcall = GetCalendarInfoW; + + RtdlEnumCalendarInfoExW: function(lpCalInfoEnumProc: TCalInfoEnumProcExW; + Locale: LCID; Calendar: CALID; CalType: CALTYPE): BOOL stdcall = EnumCalendarInfoExW; + + RtdlGetVolumeNameForVolumeMountPointW: function(lpszVolumeMountPoint: LPCWSTR; + lpszVolumeName: LPWSTR; cchBufferLength: DWORD): BOOL stdcall = GetVolumeNameForVolumeMountPointW; + + RtdlSetVolumeMountPointW: function(lpszVolumeMountPoint: LPCWSTR; + lpszVolumeName: LPCWSTR): BOOL stdcall = SetVolumeMountPointW; + + RtdlDeleteVolumeMountPointW: function(lpszVolumeMountPoint: LPCWSTR): BOOL + stdcall = DeleteVolumeMountPointW; + + RtdlNetBios: function(P: PNCB): UCHAR stdcall = NetBios; + + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows' + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + JclResources; + +procedure GetProcedureAddress(var P: Pointer; const ModuleName, ProcName: string); +var + ModuleHandle: HMODULE; +begin + if not Assigned(P) then + begin + ModuleHandle := GetModuleHandle(PChar(ModuleName)); + if ModuleHandle = 0 then + begin + ModuleHandle := SafeLoadLibrary(PChar(ModuleName)); + if ModuleHandle = 0 then + raise EJclError.CreateResFmt(@RsELibraryNotFound, [ModuleName]); + end; + P := GetProcAddress(ModuleHandle, PChar(ProcName)); + if not Assigned(P) then + raise EJclError.CreateResFmt(@RsEFunctionNotFound, [ModuleName, ProcName]); + end; +end; + +//== { EJclWin32Error } ====================================================== + + +constructor EJclWin32Error.Create(const Msg: string); +begin + FLastError := GetLastError; + FLastErrorMsg := SysErrorMessage(FLastError); + inherited CreateResFmt(@RsWin32Error, [FLastErrorMsg, FLastError, NativeLineBreak, Msg]); +end; + +constructor EJclWin32Error.CreateFmt(const Msg: string; const Args: array of const); +begin + FLastError := GetLastError; + FLastErrorMsg := SysErrorMessage(FLastError); + inherited CreateResFmt(@RsWin32Error, [FLastErrorMsg, FLastError, NativeLineBreak, Format(Msg, Args)]); +end; + +constructor EJclWin32Error.CreateRes(Ident: Integer); +begin + FLastError := GetLastError; + FLastErrorMsg := SysErrorMessage(FLastError); + inherited CreateResFmt(@RsWin32Error, [FLastErrorMsg, FLastError, NativeLineBreak, LoadStr(Ident)]); +end; + +constructor EJclWin32Error.CreateRes(ResStringRec: PResStringRec); +begin + FLastError := GetLastError; + FLastErrorMsg := SysErrorMessage(FLastError); + inherited CreateResFmt(@RsWin32Error, [FLastErrorMsg, FLastError, NativeLineBreak, LoadResString(ResStringRec)]); +end; + + + +const + aclapilib = 'advapi32.dll'; + +type + TSetNamedSecurityInfoW = function (pObjectName: LPWSTR; ObjectType: SE_OBJECT_TYPE; + SecurityInfo: SECURITY_INFORMATION; psidOwner, psidGroup: PSID; + pDacl, pSacl: PACL): DWORD; stdcall; + +var + _SetNamedSecurityInfoW: TSetNamedSecurityInfoW = nil; + +function SetNamedSecurityInfoW(pObjectName: LPWSTR; ObjectType: SE_OBJECT_TYPE; + SecurityInfo: SECURITY_INFORMATION; psidOwner, psidGroup: PSID; + pDacl, pSacl: PACL): DWORD; +begin + GetProcedureAddress(Pointer(@_SetNamedSecurityInfoW), aclapilib, 'SetNamedSecurityInfoW'); + Result := _SetNamedSecurityInfoW(pObjectName, ObjectType, SecurityInfo, psidOwner, psidGroup, pDacl, pSacl); +end; + + + +const + ImageHlpLib = 'imagehlp.dll'; + +type + TReBaseImage = function (CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; + fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; + var OldImageSize: TJclAddr32; var OldImageBase: TJclAddr; + var NewImageSize: TJclAddr32; var NewImageBase: TJclAddr; TimeStamp: ULONG): BOOL; stdcall; + +var + _ReBaseImage: TReBaseImage = nil; + +function ReBaseImage(CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; + fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; + var OldImageSize: TJclAddr32; var OldImageBase: TJclAddr; + var NewImageSize: TJclAddr32; var NewImageBase: TJclAddr; TimeStamp: ULONG): BOOL; +begin + GetProcedureAddress(Pointer(@_ReBaseImage), ImageHlpLib, 'ReBaseImage'); + Result := _ReBaseImage(CurrentImageName, SymbolPath, fReBase, fRebaseSysfileOk, fGoingDown, CheckImageSize, OldImageSize, OldImageBase, NewImageSize, NewImageBase, TimeStamp); +end; + +type + TReBaseImage64 = function (CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; + fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; + var OldImageSize: TJclAddr32; var OldImageBase: TJclAddr64; + var NewImageSize: TJclAddr32; var NewImageBase: TJclAddr64; TimeStamp: ULONG): BOOL; stdcall; + +var + _ReBaseImage64: TReBaseImage64 = nil; + +function ReBaseImage64(CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; + fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; + var OldImageSize: TJclAddr32; var OldImageBase: TJclAddr64; + var NewImageSize: TJclAddr32; var NewImageBase: TJclAddr64; TimeStamp: ULONG): BOOL; +begin + GetProcedureAddress(Pointer(@_ReBaseImage64), ImageHlpLib, 'ReBaseImage64'); + Result := _ReBaseImage64(CurrentImageName, SymbolPath, fReBase, fRebaseSysfileOk, fGoingDown, CheckImageSize, OldImageSize, OldImageBase, NewImageSize, NewImageBase, TimeStamp); +end; + +type + TCheckSumMappedFile = function (BaseAddress: Pointer; FileLength: DWORD; + out HeaderSum, CheckSum: DWORD): PImageNtHeaders; stdcall; + +var + _CheckSumMappedFile: TCheckSumMappedFile = nil; + +function CheckSumMappedFile(BaseAddress: Pointer; FileLength: DWORD; + out HeaderSum, CheckSum: DWORD): PImageNtHeaders; +begin + GetProcedureAddress(Pointer(@_CheckSumMappedFile), ImageHlpLib, 'CheckSumMappedFile'); + Result := _CheckSumMappedFile(BaseAddress, FileLength, HeaderSum, CheckSum); +end; + +type + TGetImageUnusedHeaderBytes = function (const LoadedImage: LOADED_IMAGE; + var SizeUnusedHeaderBytes: DWORD): DWORD; stdcall; + +var + _GetImageUnusedHeaderBytes: TGetImageUnusedHeaderBytes = nil; + +function GetImageUnusedHeaderBytes(const LoadedImage: LOADED_IMAGE; + var SizeUnusedHeaderBytes: DWORD): DWORD; +begin + GetProcedureAddress(Pointer(@_GetImageUnusedHeaderBytes), ImageHlpLib, 'GetImageUnusedHeaderBytes'); + Result := _GetImageUnusedHeaderBytes(LoadedImage, SizeUnusedHeaderBytes); +end; + +type + TMapAndLoad = function (ImageName, DllPath: PAnsiChar; var LoadedImage: LOADED_IMAGE; + DotDll: BOOL; ReadOnly: BOOL): BOOL; stdcall; + +var + _MapAndLoad: TMapAndLoad = nil; + +function MapAndLoad(ImageName, DllPath: PAnsiChar; var LoadedImage: LOADED_IMAGE; + DotDll: BOOL; ReadOnly: BOOL): BOOL; +begin + GetProcedureAddress(Pointer(@_MapAndLoad), ImageHlpLib, 'MapAndLoad'); + Result := _MapAndLoad(ImageName, DllPath, LoadedImage, DotDll, ReadOnly); +end; + +type + TUnMapAndLoad = function (const LoadedImage: LOADED_IMAGE): BOOL; stdcall; + +var + _UnMapAndLoad: TUnMapAndLoad = nil; + +function UnMapAndLoad(const LoadedImage: LOADED_IMAGE): BOOL; +begin + GetProcedureAddress(Pointer(@_UnMapAndLoad), ImageHlpLib, 'UnMapAndLoad'); + Result := _UnMapAndLoad(LoadedImage); +end; + +type + TTouchFileTimes = function (const FileHandle: THandle; const pSystemTime: TSystemTime): BOOL; stdcall; + +var + _TouchFileTimes: TTouchFileTimes = nil; + +function TouchFileTimes(const FileHandle: THandle; const pSystemTime: TSystemTime): BOOL; +begin + GetProcedureAddress(Pointer(@_TouchFileTimes), ImageHlpLib, 'TouchFileTimes'); + Result := _TouchFileTimes(FileHandle, pSystemTime); +end; + +type + TImageDirectoryEntryToData = function (Base: Pointer; MappedAsImage: ByteBool; + DirectoryEntry: USHORT; var Size: ULONG): Pointer; stdcall; + +var + _ImageDirectoryEntryToData: TImageDirectoryEntryToData = nil; + +function ImageDirectoryEntryToData(Base: Pointer; MappedAsImage: ByteBool; + DirectoryEntry: USHORT; var Size: ULONG): Pointer; +begin + GetProcedureAddress(Pointer(@_ImageDirectoryEntryToData), ImageHlpLib, 'ImageDirectoryEntryToData'); + Result := _ImageDirectoryEntryToData(Base, MappedAsImage, DirectoryEntry, Size); +end; + +type + TImageRvaToSection = function (NtHeaders: PImageNtHeaders; Base: Pointer; Rva: ULONG): PImageSectionHeader; stdcall; + +var + _ImageRvaToSection: TImageRvaToSection = nil; + +function ImageRvaToSection(NtHeaders: PImageNtHeaders; Base: Pointer; Rva: ULONG): PImageSectionHeader; +begin + GetProcedureAddress(Pointer(@_ImageRvaToSection), ImageHlpLib, 'ImageRvaToSection'); + Result := _ImageRvaToSection(NtHeaders, Base, Rva); +end; + +type + TImageRvaToVa = function (NtHeaders: PImageNtHeaders; Base: Pointer; Rva: ULONG; + LastRvaSection: PPImageSectionHeader): Pointer; stdcall; + +var + _ImageRvaToVa: TImageRvaToVa = nil; + +function ImageRvaToVa(NtHeaders: PImageNtHeaders; Base: Pointer; Rva: ULONG; + LastRvaSection: PPImageSectionHeader): Pointer; +begin + GetProcedureAddress(Pointer(@_ImageRvaToVa), ImageHlpLib, 'ImageRvaToVa'); + Result := _ImageRvaToVa(NtHeaders, Base, Rva, LastRvaSection); +end; + + + + +type + TCancelIo = function (hFile: THandle): BOOL; stdcall; +var + _CancelIo: TCancelIo = nil; + +function CancelIo(hFile: THandle): BOOL; +begin + GetProcedureAddress(Pointer(@_CancelIo), kernel32, 'CancelIo'); + Result := _CancelIo(hFile); +end; + + +type + TNetUserAdd = function (servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; +var + _NetUserAdd: TNetUserAdd = nil; + +function NetUserAdd(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetUserAdd), netapi32, 'NetUserAdd'); + Result := _NetUserAdd(servername, level, buf, parm_err); +end; + +type + TNetUserEnum = function (servername: LPCWSTR; level, filter: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries, resume_handle: LPDWORD): NET_API_STATUS; stdcall; + +var + _NetUserEnum: TNetUserEnum = nil; + +function NetUserEnum(servername: LPCWSTR; level, filter: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries, resume_handle: LPDWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetUserEnum), netapi32, 'NetUserEnum'); + Result := _NetUserEnum(servername, level, filter, bufptr, prefmaxlen, entriesread, totalentries, resume_handle); +end; + +type + TNetUserGetInfo = function (servername, username: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; stdcall; + +var + _NetUserGetInfo: TNetUserGetInfo = nil; + +function NetUserGetInfo(servername, username: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetUserGetInfo), netapi32, 'NetUserGetInfo'); + Result := _NetUserGetInfo(servername, username, level, bufptr); +end; + +type + TNetUserSetInfo = function (servername, username: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; + +var + _NetUserSetInfo: TNetUserSetInfo = nil; + +function NetUserSetInfo(servername, username: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetUserSetInfo), netapi32, 'NetUserSetInfo'); + Result := _NetUserSetInfo(servername, username, level, buf, parm_err); +end; + +type + TNetUserDel = function (servername: LPCWSTR; username: LPCWSTR): NET_API_STATUS; stdcall; + +var + _NetUserDel: TNetUserDel = nil; + +function NetUserDel(servername: LPCWSTR; username: LPCWSTR): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetUserDel), netapi32, 'NetUserDel'); + Result := _NetUserDel(servername, username); +end; + +type + TNetUserGetGroups = function (servername, username: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD): NET_API_STATUS; stdcall; + +var + _NetUserGetGroups: TNetUserGetGroups = nil; + +function NetUserGetGroups(servername, username: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetUserGetGroups), netapi32, 'NetUserGetGroups'); + Result := _NetUserGetGroups(servername, username, level, bufptr, prefmaxlen, entriesread, totalentries); +end; + +type + TNetUserSetGroups = function (servername, username: LPCWSTR; level: DWORD; buf: PByte; num_entries: DWORD): NET_API_STATUS; stdcall; + +var + _NetUserSetGroups: TNetUserSetGroups = nil; + +function NetUserSetGroups(servername, username: LPCWSTR; level: DWORD; buf: PByte; num_entries: DWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetUserSetGroups), netapi32, 'NetUserSetGroups'); + Result := _NetUserSetGroups(servername, username, level, buf, num_entries); +end; + +type + TNetUserGetLocalGroups = function (servername, username: LPCWSTR; level, flags: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD): NET_API_STATUS; stdcall; + +var + _NetUserGetLocalGroups: TNetUserGetLocalGroups = nil; + +function NetUserGetLocalGroups(servername, username: LPCWSTR; level, flags: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetUserGetLocalGroups), netapi32, 'NetUserGetLocalGroups'); + Result := _NetUserGetLocalGroups(servername, username, level, flags, bufptr, prefmaxlen, entriesread, totalentries); +end; + +type + TNetUserModalsGet = function (servername: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; stdcall; + +var + _NetUserModalsGet: TNetUserModalsGet = nil; + +function NetUserModalsGet(servername: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetUserModalsGet), netapi32, 'NetUserModalsGet'); + Result := _NetUserModalsGet(servername, level, bufptr); +end; + +type + TNetUserModalsSet = function (servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; + +var + _NetUserModalsSet: TNetUserModalsSet = nil; + +function NetUserModalsSet(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetUserModalsSet), netapi32, 'NetUserModalsSet'); + Result := _NetUserModalsSet(servername, level, buf, parm_err); +end; + +type + TNetUserChangePassword = function (domainname, username, oldpassword, newpassword: LPCWSTR): NET_API_STATUS; stdcall; + +var + _NetUserChangePassword: TNetUserChangePassword = nil; + +function NetUserChangePassword(domainname, username, oldpassword, newpassword: LPCWSTR): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetUserChangePassword), netapi32, 'NetUserChangePassword'); + Result := _NetUserChangePassword(domainname, username, oldpassword, newpassword); +end; + +type + TNetGroupAdd = function (servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; + +var + _NetGroupAdd: TNetGroupAdd = nil; + +function NetGroupAdd(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetGroupAdd), netapi32, 'NetGroupAdd'); + Result := _NetGroupAdd(servername, level, buf, parm_err); +end; + +type + TNetGroupAddUser = function (servername, GroupName, username: LPCWSTR): NET_API_STATUS; stdcall; + +var + _NetGroupAddUser: TNetGroupAddUser = nil; + +function NetGroupAddUser(servername, GroupName, username: LPCWSTR): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetGroupAddUser), netapi32, 'NetGroupAddUser'); + Result := _NetGroupAddUser(servername, GroupName, username); +end; + +type + TNetGroupEnum = function (servername: LPCWSTR; level: DWORD; out bufptr: PByte; + prefmaxlen: DWORD; out entriesread, totalentries: DWORD; resume_handle: PDWORD_PTR): NET_API_STATUS; stdcall; + +var + _NetGroupEnum: TNetGroupEnum = nil; + +function NetGroupEnum(servername: LPCWSTR; level: DWORD; out bufptr: PByte; + prefmaxlen: DWORD; out entriesread, totalentries: DWORD; resume_handle: PDWORD_PTR): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetGroupEnum), netapi32, 'NetGroupEnum'); + Result := _NetGroupEnum(servername, level, bufptr, prefmaxlen, entriesread, totalentries, resume_handle); +end; + +type + TNetGroupGetInfo = function (servername, groupname: LPCWSTR; level: DWORD; bufptr: PByte): NET_API_STATUS; stdcall; + +var + _NetGroupGetInfo: TNetGroupGetInfo = nil; + +function NetGroupGetInfo(servername, groupname: LPCWSTR; level: DWORD; bufptr: PByte): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetGroupGetInfo), netapi32, 'NetGroupGetInfo'); + Result := _NetGroupGetInfo(servername, groupname, level, bufptr); +end; + +type + TNetGroupSetInfo = function (servername, groupname: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; + +var + _NetGroupSetInfo: TNetGroupSetInfo = nil; + +function NetGroupSetInfo(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetGroupSetInfo), netapi32, 'NetGroupSetInfo'); + Result := _NetGroupSetInfo(servername, groupname, level, buf, parm_err); +end; + +type + TNetGroupDel = function (servername: LPCWSTR; groupname: LPCWSTR): NET_API_STATUS; stdcall; + +var + _NetGroupDel: TNetGroupDel = nil; + +function NetGroupDel(servername: LPCWSTR; groupname: LPCWSTR): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetGroupDel), netapi32, 'NetGroupDel'); + Result := _NetGroupDel(servername, groupname); +end; + +type + TNetGroupDelUser = function (servername: LPCWSTR; GroupName: LPCWSTR; Username: LPCWSTR): NET_API_STATUS; stdcall; + +var + _NetGroupDelUser: TNetGroupDelUser = nil; + +function NetGroupDelUser(servername: LPCWSTR; GroupName: LPCWSTR; Username: LPCWSTR): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetGroupDelUser), netapi32, 'NetGroupDelUser'); + Result := _NetGroupDelUser(servername, GroupName, Username); +end; + +type + TNetGroupGetUsers = function (servername, groupname: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD; ResumeHandle: PDWORD_PTR): NET_API_STATUS; stdcall; + +var + _NetGroupGetUsers: TNetGroupGetUsers = nil; + +function NetGroupGetUsers(servername, groupname: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD; ResumeHandle: PDWORD_PTR): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetGroupGetUsers), netapi32, 'NetGroupGetUsers'); + Result := _NetGroupGetUsers(servername, groupname, level, bufptr, prefmaxlen, entriesread, totalentries, ResumeHandle); +end; + +type + TNetGroupSetUsers = function (servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; stdcall; + +var + _NetGroupSetUsers: TNetGroupSetUsers = nil; + +function NetGroupSetUsers(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetGroupSetUsers), netapi32, 'NetGroupSetUsers'); + Result := _NetGroupSetUsers(servername, groupname, level, buf, totalentries); +end; + +type + TNetLocalGroupAdd = function (servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; + +var + _NetLocalGroupAdd: TNetLocalGroupAdd = nil; + +function NetLocalGroupAdd(servername: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetLocalGroupAdd), netapi32, 'NetLocalGroupAdd'); + Result := _NetLocalGroupAdd(servername, level, buf, parm_err); +end; + +type + TNetLocalGroupAddMember = function (servername, groupname: LPCWSTR; membersid: PSID): NET_API_STATUS; stdcall; + +var + _NetLocalGroupAddMember: TNetLocalGroupAddMember = nil; + +function NetLocalGroupAddMember(servername, groupname: LPCWSTR; membersid: PSID): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetLocalGroupAddMember), netapi32, 'NetLocalGroupAddMember'); + Result := _NetLocalGroupAddMember(servername, groupname, membersid); +end; + +type + TNetLocalGroupEnum = function (servername: LPCWSTR; level: DWORD; out bufptr: PByte; + prefmaxlen: DWORD; out entriesread, totalentries: DWORD; resumehandle: PDWORD_PTR): NET_API_STATUS; stdcall; + +var + _NetLocalGroupEnum: TNetLocalGroupEnum = nil; + +function NetLocalGroupEnum(servername: LPCWSTR; level: DWORD; out bufptr: PByte; + prefmaxlen: DWORD; out entriesread, totalentries: DWORD; resumehandle: PDWORD_PTR): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetLocalGroupEnum), netapi32, 'NetLocalGroupEnum'); + Result := _NetLocalGroupEnum(servername, level, bufptr, prefmaxlen, entriesread, totalentries, resumehandle); +end; + +type + TNetLocalGroupGetInfo = function (servername, groupname: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; stdcall; + +var + _NetLocalGroupGetInfo: TNetLocalGroupGetInfo = nil; + +function NetLocalGroupGetInfo(servername, groupname: LPCWSTR; level: DWORD; var bufptr: PByte): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetLocalGroupGetInfo), netapi32, 'NetLocalGroupGetInfo'); + Result := _NetLocalGroupGetInfo(servername, groupname, level, bufptr); +end; + +type + TNetLocalGroupSetInfo = function (servername, groupname: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; stdcall; + +var + _NetLocalGroupSetInfo: TNetLocalGroupSetInfo = nil; + +function NetLocalGroupSetInfo(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; parm_err: LPDWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetLocalGroupSetInfo), netapi32, 'NetLocalGroupSetInfo'); + Result := _NetLocalGroupSetInfo(servername, groupname, level, buf, parm_err); +end; + +type + TNetLocalGroupDel = function (servername: LPCWSTR; groupname: LPCWSTR): NET_API_STATUS; stdcall; + +var + _NetLocalGroupDel: TNetLocalGroupDel = nil; + +function NetLocalGroupDel(servername: LPCWSTR; groupname: LPCWSTR): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetLocalGroupDel), netapi32, 'NetLocalGroupDel'); + Result := _NetLocalGroupDel(servername, groupname); +end; + +type + TNetLocalGroupDelMember = function (servername: LPCWSTR; groupname: LPCWSTR; membersid: PSID): NET_API_STATUS; stdcall; + +var + _NetLocalGroupDelMember: TNetLocalGroupDelMember = nil; + +function NetLocalGroupDelMember(servername: LPCWSTR; groupname: LPCWSTR; membersid: PSID): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetLocalGroupDelMember), netapi32, 'NetLocalGroupDelMember'); + Result := _NetLocalGroupDelMember(servername, groupname, membersid); +end; + +type + TNetLocalGroupGetMembers = function (servername, localgroupname: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD; resumehandle: PDWORD_PTR): NET_API_STATUS; stdcall; + +var + _NetLocalGroupGetMembers: TNetLocalGroupGetMembers = nil; + +function NetLocalGroupGetMembers(servername, localgroupname: LPCWSTR; level: DWORD; var bufptr: PByte; prefmaxlen: DWORD; entriesread, totalentries: LPDWORD; resumehandle: PDWORD_PTR): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetLocalGroupGetMembers), netapi32, 'NetLocalGroupGetMembers'); + Result := _NetLocalGroupGetMembers(servername, localgroupname, level, bufptr, prefmaxlen, entriesread, totalentries, resumehandle); +end; + +type + TNetLocalGroupSetMembers = function (servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; stdcall; + +var + _NetLocalGroupSetMembers: TNetLocalGroupSetMembers = nil; + +function NetLocalGroupSetMembers(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetLocalGroupSetMembers), netapi32, 'NetLocalGroupSetMembers'); + Result := _NetLocalGroupSetMembers(servername, groupname, level, buf, totalentries); +end; + +type + TNetLocalGroupAddMembers = function (servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; stdcall; + +var + _NetLocalGroupAddMembers: TNetLocalGroupAddMembers = nil; + +function NetLocalGroupAddMembers(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetLocalGroupAddMembers), netapi32, 'NetLocalGroupAddMembers'); + Result := _NetLocalGroupAddMembers(servername, groupname, level, buf, totalentries); +end; + +type + TNetLocalGroupDelMembers = function (servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; stdcall; + +var + _NetLocalGroupDelMembers: TNetLocalGroupDelMembers = nil; + +function NetLocalGroupDelMembers(servername, groupname: LPCWSTR; level: DWORD; buf: PByte; totalentries: DWORD): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetLocalGroupDelMembers), netapi32, 'NetLocalGroupDelMembers'); + Result := _NetLocalGroupDelMembers(servername, groupname, level, buf, totalentries); +end; + + + +type + TNetApiBufferFree = function (Buffer: Pointer): NET_API_STATUS; stdcall; + +var + _NetApiBufferFree: TNetApiBufferFree = nil; + +function NetApiBufferFree(Buffer: Pointer): NET_API_STATUS; +begin + GetProcedureAddress(Pointer(@_NetApiBufferFree), netapi32, 'NetApiBufferFree'); + Result := _NetApiBufferFree(Buffer); +end; + + + +type + TNetWkstaGetInfo = function (servername: PWideChar; level: DWORD; out bufptr: PByte): NET_API_STATUS; stdcall; + +var + _NetWkstaGetInfo: TNetWkstaGetInfo = nil; + +function NetWkstaGetInfo(servername: PWideChar; level: DWORD; out bufptr: PByte): NET_API_STATUS; stdcall; +begin + GetProcedureAddress(Pointer(@_NetWkstaGetInfo), netapi32, 'NetWkstaGetInfo'); + Result := _NetWkstaGetInfo(servername, level, bufptr); +end; + + + +type + TNetbios = function (pncb: PNCB): UCHAR; stdcall; +var + _Netbios: TNetbios = nil; + +function Netbios(pncb: PNCB): UCHAR; +begin + GetProcedureAddress(Pointer(@_Netbios), 'netapi32.dll', 'Netbios'); + Result := _Netbios(pncb); +end; + + + +type + TGlobalMemoryStatusEx = function (out lpBuffer: TMemoryStatusEx): BOOL; stdcall; + +var + _GlobalMemoryStatusEx: TGlobalMemoryStatusEx = nil; + +function GlobalMemoryStatusEx(out lpBuffer: TMemoryStatusEx): BOOL; stdcall; +begin + GetProcedureAddress(Pointer(@_GlobalMemoryStatusEx), kernel32, 'GlobalMemoryStatusEx'); + Result := _GlobalMemoryStatusEx(lpBuffer); +end; + +type + TBackupSeek = function (hFile: THandle; dwLowBytesToSeek, dwHighBytesToSeek: DWORD; + out lpdwLowByteSeeked, lpdwHighByteSeeked: DWORD; + var lpContext: Pointer): BOOL; stdcall; + +var + _BackupSeek: TBackupSeek = nil; + +function BackupSeek(hFile: THandle; dwLowBytesToSeek, dwHighBytesToSeek: DWORD; + out lpdwLowByteSeeked, lpdwHighByteSeeked: DWORD; + var lpContext: Pointer): BOOL; +begin + GetProcedureAddress(Pointer(@_BackupSeek), kernel32, 'BackupSeek'); + Result := _BackupSeek(hFile, dwLowBytesToSeek, dwHighBytesToSeek, lpdwLowByteSeeked, lpdwHighByteSeeked, lpContext); +end; + +type + TAdjustTokenPrivileges = function (TokenHandle: THandle; DisableAllPrivileges: BOOL; + const NewState: TTokenPrivileges; BufferLength: DWORD; + PreviousState: PTokenPrivileges; + ReturnLength: PDWORD + ): BOOL; stdcall; + +var + _AdjustTokenPrivileges: TAdjustTokenPrivileges = nil; + +function AdjustTokenPrivileges(TokenHandle: THandle; DisableAllPrivileges: BOOL; + const NewState: TTokenPrivileges; BufferLength: DWORD; + PreviousState: PTokenPrivileges; + ReturnLength: PDWORD + ): BOOL; +begin + GetProcedureAddress(Pointer(@_AdjustTokenPrivileges), advapi32, 'AdjustTokenPrivileges'); + Result := _AdjustTokenPrivileges(TokenHandle, DisableAllPrivileges, NewState, BufferLength, PreviousState, ReturnLength); +end; + +function CreateMutex(lpMutexAttributes: PSecurityAttributes; bInitialOwner: BOOL; lpName: PChar): THandle; stdcall; + external kernel32 name 'CreateMutex' + AWSuffix; + +function GetVersionEx(var lpVersionInformation: TOSVersionInfoEx): BOOL; stdcall; + external kernel32 name 'GetVersionEx' + AWSuffix; +function GetVersionEx(lpVersionInformation: POSVersionInfoEx): BOOL; stdcall; + external kernel32 name 'GetVersionEx' + AWSuffix; + +type + TSetWaitableTimer = function (hTimer: THandle; var lpDueTime: TLargeInteger; + lPeriod: Longint; pfnCompletionRoutine: TFNTimerAPCRoutine; + lpArgToCompletionRoutine: Pointer; fResume: BOOL): BOOL; stdcall; + +var + _SetWaitableTimer: TSetWaitableTimer = nil; + +function SetWaitableTimer(hTimer: THandle; var lpDueTime: TLargeInteger; + lPeriod: Longint; pfnCompletionRoutine: TFNTimerAPCRoutine; + lpArgToCompletionRoutine: Pointer; fResume: BOOL): BOOL; +begin + GetProcedureAddress(Pointer(@_SetWaitableTimer), kernel32, 'SetWaitableTimer'); + Result := _SetWaitableTimer(hTimer, lpDueTime, lPeriod, pfnCompletionRoutine, lpArgToCompletionRoutine, fResume); +end; + +type + TSetFileSecurityA = function (lpFileName: LPCSTR; SecurityInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; stdcall; +var + _SetFileSecurityA: TSetFileSecurityA = nil; + +function SetFileSecurityA(lpFileName: LPCSTR; SecurityInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; +begin + GetProcedureAddress(Pointer(@_SetFileSecurityA), advapi32, 'SetFileSecurityA'); + Result := _SetFileSecurityA(lpFileName, SecurityInformation, pSecurityDescriptor); +end; + +type + TSetFileSecurityW = function (lpFileName: LPCWSTR; SecurityInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; stdcall; + +var + _SetFileSecurityW: TSetFileSecurityW = nil; + +function SetFileSecurityW(lpFileName: LPCWSTR; SecurityInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; +begin + GetProcedureAddress(Pointer(@_SetFileSecurityW), advapi32, 'SetFileSecurityW'); + Result := _SetFileSecurityW(lpFileName, SecurityInformation, pSecurityDescriptor); +end; + +type + TSetFileSecurity = function (lpFileName: LPCTSTR; SecurityInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; stdcall; + +var + _SetFileSecurity: TSetFileSecurity = nil; + +function SetFileSecurity(lpFileName: LPCTSTR; SecurityInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR): BOOL; +begin + GetProcedureAddress(Pointer(@_SetFileSecurity), advapi32, 'SetFileSecurity' + AWSuffix); + Result := _SetFileSecurity(lpFileName, SecurityInformation, pSecurityDescriptor); +end; + +type + TGetFileSecurityA = function (lpFileName: LPCSTR; RequestedInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; + var lpnLengthNeeded: DWORD): BOOL; stdcall; + +var + _GetFileSecurityA: TGetFileSecurityA = nil; + +function GetFileSecurityA(lpFileName: LPCSTR; RequestedInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; + var lpnLengthNeeded: DWORD): BOOL; +begin + GetProcedureAddress(Pointer(@_GetFileSecurityA), advapi32, 'GetFileSecurityA'); + Result := _GetFileSecurityA(lpFileName, RequestedInformation, pSecurityDescriptor, nLength, lpnLengthNeeded); +end; + +type + TGetFileSecurityW = function (lpFileName: LPCWSTR; RequestedInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; + var lpnLengthNeeded: DWORD): BOOL; stdcall; + +var + _GetFileSecurityW: TGetFileSecurityW = nil; + +function GetFileSecurityW(lpFileName: LPCWSTR; RequestedInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; + var lpnLengthNeeded: DWORD): BOOL; +begin + GetProcedureAddress(Pointer(@_GetFileSecurityW), advapi32, 'GetFileSecurityW'); + Result := _GetFileSecurityW(lpFileName, RequestedInformation, pSecurityDescriptor, nLength, lpnLengthNeeded); +end; + +type + TGetFileSecurity = function (lpFileName: LPCTSTR; RequestedInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; + var lpnLengthNeeded: DWORD): BOOL; stdcall; + +var + _GetFileSecurity: TGetFileSecurity = nil; + +function GetFileSecurity(lpFileName: LPCTSTR; RequestedInformation: SECURITY_INFORMATION; + pSecurityDescriptor: PSECURITY_DESCRIPTOR; nLength: DWORD; + var lpnLengthNeeded: DWORD): BOOL; +begin + GetProcedureAddress(Pointer(@_GetFileSecurity), advapi32, 'GetFileSecurity' + AWSuffix); + Result := _GetFileSecurity(lpFileName, RequestedInformation, pSecurityDescriptor, nLength, lpnLengthNeeded); +end; + +type + TSetVolumeMountPointW = function (lpszVolumeMountPoint, lpszVolumeName: LPCWSTR): BOOL; stdcall; + +var + _SetVolumeMountPointW: TSetVolumeMountPointW = nil; + +function SetVolumeMountPointW(lpszVolumeMountPoint, lpszVolumeName: LPCWSTR): BOOL; +begin + GetProcedureAddress(Pointer(@_SetVolumeMountPointW), kernel32, 'SetVolumeMountPointW'); + Result := _SetVolumeMountPointW(lpszVolumeMountPoint, lpszVolumeName); +end; + +type + TDeleteVolumeMountPointW = function (lpszVolumeMountPoint: LPCWSTR): BOOL; stdcall; + +var + _DeleteVolumeMountPointW: TDeleteVolumeMountPointW = nil; + +function DeleteVolumeMountPointW(lpszVolumeMountPoint: LPCWSTR): BOOL; +begin + GetProcedureAddress(Pointer(@_DeleteVolumeMountPointW), kernel32, 'DeleteVolumeMountPointW'); + Result := _DeleteVolumeMountPointW(lpszVolumeMountPoint); +end; + +type + TGetVolumeNameForVolumeMountPointW = function (lpszVolumeMountPoint: LPCWSTR; + lpszVolumeName: LPWSTR; cchBufferLength: DWORD): BOOL; stdcall; + +var + _GetVolumeNameForVolMountPointW: TGetVolumeNameForVolumeMountPointW = nil; + +function GetVolumeNameForVolumeMountPointW(lpszVolumeMountPoint: LPCWSTR; + lpszVolumeName: LPWSTR; cchBufferLength: DWORD): BOOL; +begin + GetProcedureAddress(Pointer(@_GetVolumeNameForVolMountPointW), kernel32, 'GetVolumeNameForVolumeMountPointW'); + Result := _GetVolumeNameForVolMountPointW(lpszVolumeMountPoint, lpszVolumeName, cchBufferLength); +end; + +type + TCopyExtendedContext = function (Destination: PCONTEXT_EX; ContextFlags: DWORD; Source: PCONTEXT_EX): BOOL; stdcall; + +var + _CopyExtendedContext: TCopyExtendedContext = nil; + +function CopyExtendedContext(Destination: PCONTEXT_EX; ContextFlags: DWORD; Source: PCONTEXT_EX): BOOL; +begin + GetProcedureAddress(Pointer(@_CopyExtendedContext), kernel32, 'CopyExtendedContext'); + Result := _CopyExtendedContext(Destination, ContextFlags, Source); +end; + +type + TInitializeExtendedContext = function (Context: Pointer; ContextFlags: DWORD; out ContextEx: PCONTEXT_EX): BOOL; stdcall; + +var + _InitializeExtendedContext: TInitializeExtendedContext = nil; + +function InitializeExtendedContext(Context: Pointer; ContextFlags: DWORD; out ContextEx: PCONTEXT_EX): BOOL; +begin + GetProcedureAddress(Pointer(@_InitializeExtendedContext), kernel32, 'InitializeExtendedContext'); + Result := _InitializeExtendedContext(Context, ContextFlags, ContextEx); +end; + +type + TGetEnabledExtendedFeatures = function (const FeatureMask: Int64): Int64; stdcall; +var + _GetEnabledExtendedFeatures: TGetEnabledExtendedFeatures = nil; + +function GetEnabledExtendedFeatures(const FeatureMask: Int64): Int64; +begin + GetProcedureAddress(Pointer(@_GetEnabledExtendedFeatures), kernel32, 'GetEnabledExtendedFeatures'); + Result := _GetEnabledExtendedFeatures(FeatureMask); +end; + +type + TGetExtendedContextLength = function (ContextFlags: DWORD; ContextLength: PDWORD): BOOL; stdcall; + +var + _GetExtendedContextLength: TGetExtendedContextLength = nil; + +function GetExtendedContextLength(ContextFlags: DWORD; ContextLength: PDWORD): BOOL; +begin + GetProcedureAddress(Pointer(@_GetExtendedContextLength), kernel32, 'GetExtendedContextLength'); + Result := _GetExtendedContextLength(ContextFlags, ContextLength); +end; + +type + TGetExtendedFeaturesMask = function (ContextEx: PCONTEXT_EX): Int64; stdcall; + +var + _GetExtendedFeaturesMask: TGetExtendedFeaturesMask = nil; + +function GetExtendedFeaturesMask(ContextEx: PCONTEXT_EX): Int64; +begin + GetProcedureAddress(Pointer(@_GetExtendedFeaturesMask), kernel32, 'GetExtendedFeaturesMask'); + Result := _GetExtendedFeaturesMask(ContextEx); +end; + +type + TLocateExtendedFeature = function (ContextEx: PCONTEXT_EX; FeatureId: DWORD; Length: PDWORD): Pointer; stdcall; + +var + _LocateExtendedFeature: TLocateExtendedFeature = nil; + +function LocateExtendedFeature(ContextEx: PCONTEXT_EX; FeatureId: DWORD; Length: PDWORD): Pointer; +begin + GetProcedureAddress(Pointer(@_LocateExtendedFeature), kernel32, 'LocateExtendedFeature'); + Result := _LocateExtendedFeature(ContextEx, FeatureId, Length); +end; + +type + TLocateLegacyContext = function (ContextEx: PCONTEXT_EX; Length: PDWORD): PCONTEXT; stdcall; + +var + _LocateLegacyContext: TLocateLegacyContext = nil; + +function LocateLegacyContext(ContextEx: PCONTEXT_EX; Length: PDWORD): PCONTEXT; +begin + GetProcedureAddress(Pointer(@_LocateLegacyContext), kernel32, 'LocateLegacyContext'); + Result := _LocateLegacyContext(ContextEx, Length); +end; + +type + TSetExtendedFeaturesMask = procedure (ContextEx: PCONTEXT_EX; const FeatureMask: Int64); stdcall; + +var + _SetExtendedFeaturesMask: TSetExtendedFeaturesMask = nil; + +procedure SetExtendedFeaturesMask(ContextEx: PCONTEXT_EX; const FeatureMask: Int64); +begin + GetProcedureAddress(Pointer(@_SetExtendedFeaturesMask), kernel32, 'SetExtendedFeaturesMask'); + _SetExtendedFeaturesMask(ContextEx, FeatureMask); +end; + +type + TProcessIdToSessionId = function (dwProcessId: DWORD; out dwSessionId: DWORD): BOOL; stdcall; + +var + _ProcessIdToSessionId: TProcessIdToSessionId = nil; + +function ProcessIdToSessionId(dwProcessId: DWORD; out dwSessionId: DWORD): BOOL; +begin + GetProcedureAddress(Pointer(@_ProcessIdToSessionId), kernel32, 'ProcessIdToSessionId'); + Result := _ProcessIdToSessionId(dwProcessId, dwSessionId); +end; + + + +type + TGetCalendarInfoA = function (Locale: LCID; Calendar: CALID; CalType: CALTYPE; + lpCalData: LPSTR; cchData: Integer; lpValue: LPDWORD): Integer; stdcall; + +var + _GetCalendarInfoA: TGetCalendarInfoA = nil; + +function GetCalendarInfoA(Locale: LCID; Calendar: CALID; CalType: CALTYPE; + lpCalData: LPSTR; cchData: Integer; lpValue: LPDWORD): Integer; +begin + GetProcedureAddress(Pointer(@_GetCalendarInfoA), kernel32, 'GetCalendarInfoA'); + Result := _GetCalendarInfoA(Locale, Calendar, CalType, lpCalData, cchData, lpValue); +end; + +type + TGetCalendarInfoW = function (Locale: LCID; Calendar: CALID; CalType: CALTYPE; + lpCalData: LPWSTR; cchData: Integer; lpValue: LPDWORD): Integer; stdcall; + +var + _GetCalendarInfoW: TGetCalendarInfoW = nil; + +function GetCalendarInfoW(Locale: LCID; Calendar: CALID; CalType: CALTYPE; + lpCalData: LPWSTR; cchData: Integer; lpValue: LPDWORD): Integer; +begin + GetProcedureAddress(Pointer(@_GetCalendarInfoW), kernel32, 'GetCalendarInfoW'); + Result := _GetCalendarInfoW(Locale, Calendar, CalType, lpCalData, cchData, lpValue); +end; + +type + TEnumCalendarInfoExW = function (lpCalInfoEnumProcEx: CALINFO_ENUMPROCEXW; + Locale: LCID; Calendar: CALID; CalType: CALTYPE): BOOL; stdcall; + +var + _EnumCalendarInfoExW: TEnumCalendarInfoExW = nil; + +function EnumCalendarInfoExW(lpCalInfoEnumProcEx: CALINFO_ENUMPROCEXW; + Locale: LCID; Calendar: CALID; CalType: CALTYPE): BOOL; +begin + GetProcedureAddress(Pointer(@_EnumCalendarInfoExW), kernel32, 'EnumCalendarInfoExW'); + Result := _EnumCalendarInfoExW(lpCalInfoEnumProcEx, Locale, Calendar, CalType); +end; + + +type + TGetWindowLongPtr = function (hWnd: HWND; nIndex: Integer): TJclAddr; stdcall; + +var + _GetWindowLongPtr: TGetWindowLongPtr = nil; + +function GetWindowLongPtr(hWnd: HWND; nIndex: Integer): TJclAddr; +begin + GetProcedureAddress(Pointer(@_GetWindowLongPtr), user32, 'GetWindowLong' + AWSuffix); + Result := _GetWindowLongPtr(hWnd, nIndex); +end; + +type + TSetWindowLongPtr = function (hWnd: HWND; nIndex: Integer; dwNewLong: TJclAddr): Longint; stdcall; + +var + _SetWindowLongPtr: TSetWindowLongPtr = nil; + +function SetWindowLongPtr(hWnd: HWND; nIndex: Integer; dwNewLong: TJclAddr): Longint; +begin + GetProcedureAddress(Pointer(@_SetWindowLongPtr), user32, 'SetWindowLong' + AWSuffix); + Result := _SetWindowLongPtr(hWnd, nIndex, dwNewLong); +end; + + +// line 9078 + +function MAKELANGID(PrimaryLang, SubLang: USHORT): WORD; +begin + Result := (SubLang shl 10) or PrimaryLang; +end; + +function PRIMARYLANGID(LangId: WORD): WORD; +begin + Result := LangId and $03FF; +end; + +function SUBLANGID(LangId: WORD): WORD; +begin + Result := LangId shr 10; +end; + +function MAKELCID(LangId, SortId: WORD): DWORD; +begin + Result := (DWORD(SortId) shl 16) or DWORD(LangId); +end; + +function MAKESORTLCID(LangId, SortId, SortVersion: WORD): DWORD; +begin + Result := MAKELCID(LangId, SortId) or (SortVersion shl 20); +end; + +function LANGIDFROMLCID(LocaleId: LCID): WORD; +begin + Result := WORD(LocaleId); +end; + +function SORTIDFROMLCID(LocaleId: LCID): WORD; +begin + Result := WORD((DWORD(LocaleId) shr 16) and $000F); +end; + +function SORTVERSIONFROMLCID(LocaleId: LCID): WORD; +begin + Result := WORD((DWORD(LocaleId) shr 20) and $000F); +end; + +type + TCaptureStackBackTrace = function(FramesToSkip, FramesToCapture: DWORD; + BackTrace: Pointer; out BackTraceHash: DWORD): Word; stdcall; + +var + _CaptureStackBackTrace: TCaptureStackBackTrace = nil; + +function CaptureStackBackTrace(FramesToSkip, FramesToCapture: DWORD; + BackTrace: Pointer; out BackTraceHash: DWORD): Word; stdcall; +begin + GetProcedureAddress(Pointer(@_CaptureStackBackTrace), kernel32, 'RtlCaptureStackBackTrace'); + Result := _CaptureStackBackTrace(FramesToSkip, FramesToCapture, BackTrace, BackTraceHash); +end; + +// line 9149 + +function IsReparseTagMicrosoft(Tag: ULONG): Boolean; +begin + Result := (Tag and ULONG($80000000)) <> 0; +end; + +function IsReparseTagHighLatency(Tag: ULONG): Boolean; +begin + Result := (Tag and ULONG($40000000)) <> 0; +end; + +function IsReparseTagNameSurrogate(Tag: ULONG): Boolean; +begin + Result := (Tag and ULONG($20000000)) <> 0; +end; + +// IMAGE_FIRST_SECTION by Nico Bendlin - supplied by Markus Fuchs + +function IMAGE_FIRST_SECTION(NtHeader: PImageNtHeaders): PImageSectionHeader; +var + OptionalHeaderAddr: PByte; +begin + OptionalHeaderAddr := @NtHeader^.OptionalHeader; + Inc(OptionalHeaderAddr, NtHeader^.FileHeader.SizeOfOptionalHeader); + Result := PImageSectionHeader(OptionalHeaderAddr); +end; + +// line 9204 + +function IMAGE_ORDINAL64(Ordinal: ULONGLONG): ULONGLONG; +begin + Result := (Ordinal and $FFFF); +end; + +function IMAGE_ORDINAL32(Ordinal: DWORD): DWORD; +begin + Result := (Ordinal and $0000FFFF); +end; + +function IMAGE_ORDINAL(Ordinal: DWORD): DWORD; +begin + Result := (Ordinal and $0000FFFF); +end; + +function IMAGE_SNAP_BY_ORDINAL64(Ordinal: ULONGLONG): Boolean; +begin + Result := ((Ordinal and IMAGE_ORDINAL_FLAG64) <> 0); +end; + +function IMAGE_SNAP_BY_ORDINAL32(Ordinal: DWORD): Boolean; +begin + Result := ((Ordinal and IMAGE_ORDINAL_FLAG32) <> 0); +end; + +function IMAGE_SNAP_BY_ORDINAL(Ordinal: DWORD): Boolean; +begin + Result := ((Ordinal and IMAGE_ORDINAL_FLAG32) <> 0); +end; + +const + PowrprofLib = 'PowrProf.dll'; + +type + TIsPwrSuspendAllowed = function : BOOL; stdcall; + +var + _IsPwrSuspendAllowed: TIsPwrSuspendAllowed = nil; + +function IsPwrSuspendAllowed: BOOL; +begin + GetProcedureAddress(Pointer(@_IsPwrSuspendAllowed), PowrprofLib, 'IsPwrSuspendAllowed'); + Result := _IsPwrSuspendAllowed; +end; + +type + TIsPwrHibernateAllowed = function : BOOL; stdcall; + +var + _IsPwrHibernateAllowed: TIsPwrHibernateAllowed = nil; + +function IsPwrHibernateAllowed: BOOL; +begin + GetProcedureAddress(Pointer(@_IsPwrHibernateAllowed), PowrprofLib, 'IsPwrHibernateAllowed'); + Result := _IsPwrHibernateAllowed; +end; + +type + TIsPwrShutdownAllowed = function : BOOL; stdcall; + +var + _IsPwrShutdownAllowed: TIsPwrShutdownAllowed = nil; + +function IsPwrShutdownAllowed: BOOL; +begin + GetProcedureAddress(Pointer(@_IsPwrShutdownAllowed), PowrprofLib, 'IsPwrShutdownAllowed'); + Result := _IsPwrShutdownAllowed; +end; + +type + TSetSuspendState = function (Hibernate, ForceCritical, DisableWakeEvent: BOOL): BOOL; stdcall; + +var + _SetSuspendState: TSetSuspendState = nil; + +function SetSuspendState(Hibernate, ForceCritical, DisableWakeEvent: BOOL): BOOL; +begin + GetProcedureAddress(Pointer(@_SetSuspendState), PowrprofLib, 'SetSuspendState'); + Result := _SetSuspendState(Hibernate, ForceCritical, DisableWakeEvent); +end; + + +const + Ole32Lib = 'ole32.dll'; + +type + TStgCreateStorageEx = function (const pwcsName: PWideChar; grfMode: DWORD; + stgfmt: DWORD; grfAttrs: DWORD; pStgOptions: PSTGOPTIONS; reserved2: Pointer; + riid: PGUID; out stgOpen: IInterface): HResult; stdcall; + +var + _StgCreateStorageEx: TStgCreateStorageEx = nil; + +function StgCreateStorageEx(const pwcsName: PWideChar; grfMode: DWORD; + stgfmt: DWORD; grfAttrs: DWORD; pStgOptions: PSTGOPTIONS; reserved2: Pointer; + riid: PGUID; out stgOpen: IInterface): HResult; +begin + GetProcedureAddress(Pointer(@_StgCreateStorageEx), Ole32Lib, 'StgCreateStorageEx'); + Result := _StgCreateStorageEx(pwcsName, grfMode, stgfmt, grfAttrs, pStgOptions, reserved2, riid, stgOpen); +end; + +type + TStgOpenStorageEx = function (const pwcsName: PWideChar; grfMode: DWORD; + stgfmt: DWORD; grfAttrs: DWORD; pStgOptions: PSTGOPTIONS; reserved2: Pointer; + riid: PGUID; out stgOpen: IInterface): HResult; stdcall; + +var + _StgOpenStorageEx: TStgOpenStorageEx = nil; + +function StgOpenStorageEx(const pwcsName: PWideChar; grfMode: DWORD; + stgfmt: DWORD; grfAttrs: DWORD; pStgOptions: PSTGOPTIONS; reserved2: Pointer; + riid: PGUID; out stgOpen: IInterface): HResult; +begin + GetProcedureAddress(Pointer(@_StgOpenStorageEx), Ole32Lib, 'StgOpenStorageEx'); + Result := _StgOpenStorageEx(pwcsName, grfMode, stgfmt, grfAttrs, pStgOptions, reserved2, riid, stgOpen); +end; + + +type + TPropVariantClear = function (var Prop: TPropVariant): HResult; stdcall; + +var + _PropVariantClear: TPropVariantClear = nil; + +function PropVariantClear(var Prop: TPropVariant): HResult; +begin + GetProcedureAddress(Pointer(@_PropVariantClear), Ole32Lib, 'PropVariantClear'); + Result := _PropVariantClear(Prop); +end; + + +type + TLsaOpenPolicy = function (SystemName: PLSA_UNICODE_STRING; + var ObjectAttributes: LSA_OBJECT_ATTRIBUTES; DesiredAccess: ACCESS_MASK; + var PolicyHandle: LSA_HANDLE): NTSTATUS; stdcall; + +var + _LsaOpenPolicy: TLsaOpenPolicy = nil; + +function LsaOpenPolicy(SystemName: PLSA_UNICODE_STRING; + var ObjectAttributes: LSA_OBJECT_ATTRIBUTES; DesiredAccess: ACCESS_MASK; + var PolicyHandle: LSA_HANDLE): NTSTATUS; +begin + GetProcedureAddress(Pointer(@_LsaOpenPolicy), advapi32, 'LsaOpenPolicy'); + Result := _LsaOpenPolicy(SystemName, ObjectAttributes, DesiredAccess, PolicyHandle); +end; + +type + TLsaQueryInformationPolicy = function (PolicyHandle: LSA_HANDLE; + InformationClass: POLICY_INFORMATION_CLASS; var Buffer: Pointer): NTSTATUS; stdcall; + +var + _LsaQueryInformationPolicy: TLsaQueryInformationPolicy = nil; + +function LsaQueryInformationPolicy(PolicyHandle: LSA_HANDLE; + InformationClass: POLICY_INFORMATION_CLASS; var Buffer: Pointer): NTSTATUS; +begin + GetProcedureAddress(Pointer(@_LsaQueryInformationPolicy), advapi32, 'LsaQueryInformationPolicy'); + Result := _LsaQueryInformationPolicy(PolicyHandle, InformationClass, Buffer); +end; + +type + TLsaFreeMemory = function (Buffer: Pointer): NTSTATUS; stdcall; + +var + _LsaFreeMemory: TLsaFreeMemory = nil; + +function LsaFreeMemory(Buffer: Pointer): NTSTATUS; +begin + GetProcedureAddress(Pointer(@_LsaFreeMemory), advapi32, 'LsaFreeMemory'); + Result := _LsaFreeMemory(Buffer); +end; + +type + TLsaFreeReturnBuffer = function (Buffer: Pointer): NTSTATUS; stdcall; + +var + _LsaFreeReturnBuffer: TLsaFreeReturnBuffer = nil; + +function LsaFreeReturnBuffer(Buffer: Pointer): NTSTATUS; +begin + GetProcedureAddress(Pointer(@_LsaFreeReturnBuffer), advapi32, 'LsaFreeReturnBuffer'); + Result := _LsaFreeReturnBuffer(Buffer); +end; + +type + TLsaClose = function (ObjectHandle: LSA_HANDLE): NTSTATUS; stdcall; + +var + _LsaClose: TLsaClose = nil; + +function LsaClose(ObjectHandle: LSA_HANDLE): NTSTATUS; +begin + GetProcedureAddress(Pointer(@_LsaClose), advapi32, 'LsaClose'); + Result := _LsaClose(ObjectHandle); +end; + +type + TLsaNtStatusToWinError = function (Status: NTSTATUS): ULONG; stdcall; + +var + _LsaNtStatusToWinError: TLsaNtStatusToWinError = nil; + +function LsaNtStatusToWinError(Status: NTSTATUS): ULONG; +begin + GetProcedureAddress(Pointer(@_LsaNtStatusToWinError), advapi32, 'LsaNtStatusToWinError'); + Result := _LsaNtStatusToWinError(Status); +end; + + +type + TCreateToolhelp32Snapshot = function (dwFlags, th32ProcessID: DWORD): THandle; stdcall; + +var + _CreateToolhelp32Snapshot: TCreateToolhelp32Snapshot = nil; + +function CreateToolhelp32Snapshot(dwFlags, th32ProcessID: DWORD): THandle; +begin + GetProcedureAddress(Pointer(@_CreateToolhelp32Snapshot), kernel32, 'CreateToolhelp32Snapshot'); + Result := _CreateToolhelp32Snapshot(dwFlags, th32ProcessID); +end; + +type + TThread32First = function (hSnapshot: THandle; var lpte: THREADENTRY32): BOOL; stdcall; + +var + _Thread32First: TThread32First = nil; + +function Thread32First(hSnapshot: THandle; var lpte: THREADENTRY32): BOOL; +begin + GetProcedureAddress(Pointer(@_Thread32First), kernel32, 'Thread32First'); + Result := _Thread32First(hSnapshot, lpte); +end; + +type + TThread32Next = function (hSnapshot: THandle; var lpte: THREADENTRY32): BOOL; stdcall; + +var + _Thread32Next: TThread32Next = nil; + +function Thread32Next(hSnapshot: THandle; var lpte: THREADENTRY32): BOOL; +begin + GetProcedureAddress(Pointer(@_Thread32Next), kernel32, 'Thread32Next'); + Result := _Thread32Next(hSnapshot, lpte); +end; + + +const + ntdll = 'ntdll.dll'; + +type + TNtQueryInformationThread = function (ThreadHandle: THandle; ThreadInformationClass: THREAD_INFORMATION_CLASS; + ThreadInformation: Pointer; ThreadInformationLength: ULONG; ReturnLength: PULONG): NTSTATUS; stdcall; + +var + _NtQueryInformationThread: TNtQueryInformationThread = nil; + +function NtQueryInformationThread(ThreadHandle: THandle; ThreadInformationClass: THREAD_INFORMATION_CLASS; + ThreadInformation: Pointer; ThreadInformationLength: ULONG; ReturnLength: PULONG): NTSTATUS; +begin + GetProcedureAddress(Pointer(@_NtQueryInformationThread), ntdll, 'NtQueryInformationThread'); + Result := _NtQueryInformationThread(ThreadHandle, ThreadInformationClass, ThreadInformation, ThreadInformationLength, ReturnLength); +end; + + + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + + + diff --git a/3rdParty/JCL/source/windows/JclWin32Ex.pas b/3rdParty/JCL/source/windows/JclWin32Ex.pas new file mode 100644 index 00000000..50eea3fa --- /dev/null +++ b/3rdParty/JCL/source/windows/JclWin32Ex.pas @@ -0,0 +1,409 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclWin32Ex.pas. } +{ } +{ The Initial Developer of the Original Code is Virgo Pärna (virgo dott parna att mail dott ee). } +{ Portions created by Virgo Pärna are Copyright (C) 2006 Virgo Pärna. All Rights Reserved. } +{ } +{ Contributor(s): } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclWin32Ex; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + Windows, SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +type + TJclWin32ExFunction = (jwfTryEnterCriticalSection, jwfSignalObjectAndWait, + jwfSetCriticalSectionSpinCount, jwfOpenWaitableTimer, + jwfInitializeCriticalSectionAndSpinCount, jwfGetFileAttributesEx, + jwfCreateWaitableTimer, jwfCancelWaitableTimer, jwfglGetString, + jwfglGetError, jwfwglCreateContext, jwfwglDeleteContext, jwfwglMakeCurrent, + jwfgluErrorString); + TJclWin32ExFunctions = set of TJclWin32ExFunction; + +function JclTryEnterCriticalSection(lpCriticalSection: TRTLCriticalSection): Boolean; +function JclSignalObjectAndWait(hObjectToSignal: THandle; + hObjectToWaitOn: THandle; dwMilliseconds: Cardinal; + bAlertable: Boolean): Cardinal; +function JclSetCriticalSectionSpinCount(lpCriticalSection: TRTLCriticalSection; + dwSpinCount: Cardinal): Cardinal; +function JclOpenWaitableTimer(dwDesiredAccess: Cardinal; + bInheritHandle: Boolean; const lpTimerName: string): THandle; +function JclInitializeCriticalSectionAndSpinCount(lpCriticalSection: TRTLCriticalSection; + dwSpinCount: Cardinal): Boolean; +function JclGetFileAttributesEx(const lpFileName: string; + fInfoLevelId: TGetFileExInfoLevels; lpFileInformation: Pointer): Boolean; +function JclCreateWaitableTimer(lpTimerAttributes: PSecurityAttributes; + bManualReset: Boolean; const lpTimerName: AnsiString): THandle; +function JclCancelWaitableTimer(hTimer: THandle): Boolean; + +function JclglGetString(name: Cardinal): PChar; +function JclglGetError: Cardinal; + +function JclwglCreateContext(hdc: HDC): HGLRC; +function JclwglDeleteContext(hglrc: HGLRC): BOOL; +function JclwglMakeCurrent(hdc: HDC; hglrc: HGLRC): BOOL; + +function JclgluErrorString(errCode: Cardinal): PChar; + +function JclWin32ExFunctions: TJclWin32ExFunctions; + +procedure JclCheckAndInitializeOpenGL; + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + JclBase, JclResources; + +type + TTryEnterCriticalSectionProc = function(lpCriticalSection: TRTLCriticalSection): BOOL; stdcall; + TSignalObjectAndWaitProc = function(hObjectToSignal: THandle; + hObjectToWaitOn: THandle; dwMilliseconds: DWORD; bAlertable: BOOL): DWORD; stdcall; + TSetCriticalSectionSpinCountProc = function(lpCriticalSection: TRTLCriticalSection; + dwSpincCount: DWORD): DWORD; stdcall; + TInitializeCriticalSectionAndSpinCountProc = function(lpCriticalSection: TRTLCriticalSection; + dwSpinCount: DWORD): BOOL; stdcall; + + TOpenWaitableTimerAProc = function(dwDesiredAccess: DWORD; + bInheritHandle: BOOL; lpTimerName: LPCTSTR): THandle; stdcall; + TCreateWaitableTimerAProc = function(lpTimerAttributes: PSecurityAttributes; + bManualReset: BOOL; lpTimerName: PAnsiChar): THandle; stdcall; + TCancelWaitableTimerProc = function(hTimer: THandle): BOOL; stdcall; + + TGetFileAttributesExAProc = function(lpFileName: PChar; + fInfoLevelId: TGetFileExInfoLevels; lpFileInformation: Pointer): BOOL; stdcall; + + TglGetStringProc = function(name: Cardinal): PChar; stdcall; + TglGetErrorProc = function: Cardinal; stdcall; + + TwglCreateContextProc = function (hdc: HDC): HGLRC; stdcall; + TwglDeleteContextProc = function (hglrc: HGLRC): BOOL; stdcall; + TwglMakeCurrentProc = function (hdc: HDC; hglrc: HGLRC): BOOL; stdcall; + + TgluErrorStringProc = function(errCode: Cardinal): PChar; stdcall; + +var + Kernel32DllHandle: HMODULE = 0; + OpenGl32DllHandle: HMODULE = 0; + Glu32DllHandle: HMODULE = 0; + +type + TDllFunctionRec = record + FunctionName: string; + FunctionAddr: Pointer; + DllName: string; + DllHandle: ^HModule; + end; + +const + Glu32 = 'glu32.dll'; + +var + Win32ExFunctions: array [TJclWin32ExFunction] of TDllFunctionRec = + ( // jwfTryEnterCriticalSection + (FunctionName: 'TryEnterCriticalSection'; FunctionAddr: nil; + DllName: kernel32; DllHandle: @Kernel32DllHandle), + // jwfSignalObjectAndWait + (FunctionName: 'SignalObjectAndWait'; FunctionAddr: nil; + DllName: kernel32; DllHandle: @Kernel32DllHandle), + // jwfSetCriticalSectionSpinCount + (FunctionName: 'SetCriticalSectionSpinCount'; FunctionAddr: nil; + DllName: kernel32; DllHandle: @Kernel32DllHandle), + // jwfOpenWaitableTimer + (FunctionName: 'OpenWaitableTimerA'; FunctionAddr: nil; + DllName: kernel32; DllHandle: @Kernel32DllHandle), + // jwfInitializeCriticalSectionAndSpinCount + (FunctionName: 'InitializeCriticalSectionAndSpinCount'; FunctionAddr: nil; + DllName: kernel32; DllHandle: @Kernel32DllHandle), + // jwfGetFileAttributesEx + (FunctionName: 'GetFileAttributesExA'; FunctionAddr: nil; + DllName: kernel32; DllHandle: @Kernel32DllHandle), + // jwfCreateWaitableTimer + (FunctionName: 'CreateWaitableTimerA'; FunctionAddr: nil; + DllName: kernel32; DllHandle: @Kernel32DllHandle), + // jwfCancelWaitableTimer + (FunctionName: 'CancelWaitableTimer'; FunctionAddr: nil; + DllName: kernel32; DllHandle: @Kernel32DllHandle), + // jwfglGetString + (FunctionName: 'glGetString'; FunctionAddr: nil; + DllName: opengl32; DllHandle: @OpenGl32DllHandle), + // jwfglGetError + (FunctionName: 'glGetError'; FunctionAddr: nil; + DllName: opengl32; DllHandle: @OpenGl32DllHandle), + // jwfwglCreateContext + (FunctionName: 'wglCreateContext'; FunctionAddr: nil; + DllName: opengl32; DllHandle: @OpenGl32DllHandle), + // jwfwglDeleteContext + (FunctionName: 'wglDeleteContext'; FunctionAddr: nil; + DllName: opengl32; DllHandle: @OpenGl32DllHandle), + // jwfwglMakeCurrent + (FunctionName: 'wglMakeCurrent'; FunctionAddr: nil; + DllName: opengl32; DllHandle: @OpenGl32DllHandle), + // jwfgluErrorString + (FunctionName: 'gluErrorString'; FunctionAddr: nil; + DllName: Glu32; DllHandle: @Glu32DllHandle) + ); + +function LoadWin32ExFunction(const Win32ExFunction: TJclWin32ExFunction): Pointer; +begin + with Win32ExFunctions[Win32ExFunction] do + begin + if not Assigned(FunctionAddr) then + begin + if DllHandle^ = 0 then + DllHandle^ := SafeLoadLibrary(DllName); + if DllHandle^ = 0 then + raise EJclError.CreateResFmt(@RsELibraryNotFound, [DllName]) + else + FunctionAddr := GetProcAddress(DllHandle^, PChar(FunctionName)); + if not Assigned(FunctionAddr) then + raise EJclError.CreateResFmt(@RsEFunctionNotFound, [DllName, FunctionName]); + end; + Result := FunctionAddr; + end; +end; + +function JclTryEnterCriticalSection(lpCriticalSection: TRTLCriticalSection): Boolean; +var + FunctionAddr: Pointer; +begin + FunctionAddr := Win32ExFunctions[jwfTryEnterCriticalSection].FunctionAddr; + if not Assigned(FunctionAddr) then + FunctionAddr := LoadWin32ExFunction(jwfTryEnterCriticalSection); + + Result := TTryEnterCriticalSectionProc(FunctionAddr)(lpCriticalSection); +end; + +function JclSignalObjectAndWait(hObjectToSignal: THandle; hObjectToWaitOn: THandle; dwMilliseconds: Cardinal; bAlertable: Boolean): Cardinal; +var + FunctionAddr: Pointer; +begin + FunctionAddr := Win32ExFunctions[jwfSignalObjectAndWait].FunctionAddr; + if not Assigned(FunctionAddr) then + FunctionAddr := LoadWin32ExFunction(jwfSignalObjectAndWait); + + Result := TSignalObjectAndWaitProc(FunctionAddr)(hObjectToSignal, hObjectToWaitOn, dwMilliseconds, bAlertable); +end; + +function JclSetCriticalSectionSpinCount(lpCriticalSection: TRTLCriticalSection; dwSpinCount: Cardinal): Cardinal; +var + FunctionAddr: Pointer; +begin + FunctionAddr := Win32ExFunctions[jwfSetCriticalSectionSpinCount].FunctionAddr; + if not Assigned(FunctionAddr) then + FunctionAddr := LoadWin32ExFunction(jwfSetCriticalSectionSpinCount); + + Result := TSetCriticalSectionSpinCountProc(FunctionAddr)(lpCriticalSection, dwSpinCount); +end; + +function JclOpenWaitableTimer(dwDesiredAccess: Cardinal; bInheritHandle: Boolean; const lpTimerName: string): THandle; +var + FunctionAddr: Pointer; +begin + FunctionAddr := Win32ExFunctions[jwfOpenWaitableTimer].FunctionAddr; + if not Assigned(FunctionAddr) then + FunctionAddr := LoadWin32ExFunction(jwfOpenWaitableTimer); + + Result := TOpenWaitableTimerAProc(FunctionAddr)(dwDesiredAccess, bInheritHandle, PChar(lpTimerName)); +end; + +function JclInitializeCriticalSectionAndSpinCount(lpCriticalSection: TRTLCriticalSection; dwSpinCount: Cardinal): Boolean; +var + FunctionAddr: Pointer; +begin + FunctionAddr := Win32ExFunctions[jwfInitializeCriticalSectionAndSpinCount].FunctionAddr; + if not Assigned(FunctionAddr) then + FunctionAddr := LoadWin32ExFunction(jwfInitializeCriticalSectionAndSpinCount); + + Result := TInitializeCriticalSectionAndSpinCountProc(FunctionAddr)(lpCriticalSection, dwSpinCount); +end; + +function JclGetFileAttributesEx(const lpFileName: string; fInfoLevelId: TGetFileExInfoLevels; lpFileInformation: Pointer): Boolean; +var + FunctionAddr: Pointer; +begin + FunctionAddr := Win32ExFunctions[jwfGetFileAttributesEx].FunctionAddr; + if not Assigned(FunctionAddr) then + FunctionAddr := LoadWin32ExFunction(jwfGetFileAttributesEx); + + Result := TGetFileAttributesExAProc(FunctionAddr)(PChar(lpFileName), fInfoLevelId, lpFileInformation); +end; + +function JclCreateWaitableTimer(lpTimerAttributes: PSecurityAttributes; bManualReset: Boolean; const lpTimerName: AnsiString): THandle; +var + FunctionAddr: Pointer; +begin + FunctionAddr := Win32ExFunctions[jwfCreateWaitableTimer].FunctionAddr; + if not Assigned(FunctionAddr) then + FunctionAddr := LoadWin32ExFunction(jwfCreateWaitableTimer); + + Result := TCreateWaitableTimerAProc(FunctionAddr)(lpTimerAttributes, bManualReset, PAnsiChar(lpTimerName)); +end; + +function JclCancelWaitableTimer(hTimer: THandle): Boolean; +var + FunctionAddr: Pointer; +begin + FunctionAddr := Win32ExFunctions[jwfCancelWaitableTimer].FunctionAddr; + if not Assigned(FunctionAddr) then + FunctionAddr := LoadWin32ExFunction(jwfCancelWaitableTimer); + + Result := TCancelWaitableTimerProc(FunctionAddr)(hTimer); +end; + +function JclglGetString(name: Cardinal): PChar; +var + FunctionAddr: Pointer; +begin + FunctionAddr := Win32ExFunctions[jwfglGetString].FunctionAddr; + if not Assigned(FunctionAddr) then + FunctionAddr := LoadWin32ExFunction(jwfglGetString); + + Result := TglGetStringProc(FunctionAddr)(name); +end; + +function JclglGetError: Cardinal; +var + FunctionAddr: Pointer; +begin + FunctionAddr := Win32ExFunctions[jwfglGetError].FunctionAddr; + if not Assigned(FunctionAddr) then + FunctionAddr := LoadWin32ExFunction(jwfglGetError); + + Result := TglGetErrorProc(FunctionAddr); +end; + +function JclwglCreateContext(hdc: HDC): HGLRC; +var + FunctionAddr: Pointer; +begin + FunctionAddr := Win32ExFunctions[jwfwglCreateContext].FunctionAddr; + if not Assigned(FunctionAddr) then + FunctionAddr := LoadWin32ExFunction(jwfwglCreateContext); + + Result := TwglCreateContextProc(FunctionAddr)(hdc); +end; + +function JclwglDeleteContext(hglrc: HGLRC): BOOL; +var + FunctionAddr: Pointer; +begin + FunctionAddr := Win32ExFunctions[jwfwglDeleteContext].FunctionAddr; + if not Assigned(FunctionAddr) then + FunctionAddr := LoadWin32ExFunction(jwfwglDeleteContext); + + Result := TwglDeleteContextProc(FunctionAddr)(hglrc); +end; + +function JclwglMakeCurrent(hdc: HDC; hglrc: HGLRC): BOOL; +var + FunctionAddr: Pointer; +begin + FunctionAddr := Win32ExFunctions[jwfwglMakeCurrent].FunctionAddr; + if not Assigned(FunctionAddr) then + FunctionAddr := LoadWin32ExFunction(jwfwglMakeCurrent); + + Result := TwglMakeCurrentProc(FunctionAddr)(hdc, hglrc); +end; + +function JclgluErrorString(errCode: Cardinal): PChar; +var + FunctionAddr: Pointer; +begin + FunctionAddr := Win32ExFunctions[jwfgluErrorString].FunctionAddr; + if not Assigned(FunctionAddr) then + FunctionAddr := LoadWin32ExFunction(jwfgluErrorString); + + Result := TgluErrorStringProc(FunctionAddr)(errCode); +end; + +function JclWin32ExFunctions: TJclWin32ExFunctions; +var + Index: TJclWin32ExFunction; +begin + Result := []; + for Index := Low(TJclWin32ExFunction) to High(TJclWin32ExFunction) do + if Assigned(Win32ExFunctions[Index].FunctionAddr) + or (LoadWin32ExFunction(Index) <> nil) then + Include(Result, Index); +end; + +procedure UnloadLibraries; +var + Index: TJclWin32ExFunction; +begin + for Index := Low(TJclWin32ExFunction) to High(TJclWin32ExFunction) do + with Win32ExFunctions[Index] do + begin + FunctionAddr := nil; + if DllHandle^ <> 0 then + begin + FreeLibrary(DllHandle^); + DllHandle^ := 0; + end; + end; +end; + +procedure JclCheckAndInitializeOpenGL; +begin + if OpenGl32DllHandle = 0 then + OpenGl32DllHandle := SafeLoadLibrary(opengl32); + if OpenGl32DllHandle = 0 then + raise EJclError.CreateResFmt(@RsELibraryNotFound, [opengl32]); +end; + +initialization + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + UnloadLibraries; + +end. + diff --git a/3rdParty/JCL/source/windows/JclWinMIDI.pas b/3rdParty/JCL/source/windows/JclWinMIDI.pas new file mode 100644 index 00000000..a800de95 --- /dev/null +++ b/3rdParty/JCL/source/windows/JclWinMIDI.pas @@ -0,0 +1,305 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclWinMidi.pas. } +{ } +{ The Initial Developer of the Original Code is Robert Rossmair } +{ Portions created by Robert Rossmair are Copyright (C) Robert Rossmair. All Rights Reserved. } +{ } +{ Contributor(s): } +{ Robert Rossmair } +{ } +{**************************************************************************************************} +{ } +{ MIDI functions for MS Windows platform } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit JclWinMidi; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + System.SysUtils, System.Classes, Winapi.Windows, Winapi.MMSystem, + {$ELSE ~HAS_UNITSCOPE} + SysUtils, Classes, Windows, MMSystem, + {$ENDIF ~HAS_UNITSCOPE} + JclMIDI; + +type + TStereoChannel = (scLeft, scRight); + + // MIDI Out + IJclWinMidiOut = interface(IJclMidiOut) + ['{F3FCE71C-B924-462C-BA0D-8C2DC118DADB}'] + // property access methods + function GetChannelVolume(Channel: TStereoChannel): Word; + procedure SetChannelVolume(Channel: TStereoChannel; const Value: Word); + function GetVolume: Word; + procedure SetVolume(const Value: Word); + // properties + property ChannelVolume[Channel: TStereoChannel]: Word read GetChannelVolume write SetChannelVolume; + property Volume: Word read GetVolume write SetVolume; + end; + +type + TJclWinMidiOut = class(TJclMidiOut, IJclWinMidiOut) + private + FHandle: HMIDIOUT; + FDeviceID: Cardinal; + FDeviceCaps: MIDIOUTCAPS; + FVolume: DWORD; + procedure SetLRVolume(const LeftValue, RightValue: Word); + protected + procedure LongMessage(const Data: array of Byte); + procedure DoSendMessage(const Data: array of Byte); override; + public + constructor Create(ADeviceID: Cardinal); + destructor Destroy; override; + property DeviceID: Cardinal read FDeviceID; + function GetName: string; override; + property Name: string read GetName; + { IJclWinMidiOut } + function GetChannelVolume(Channel: TStereoChannel): Word; + procedure SetChannelVolume(Channel: TStereoChannel; const Value: Word); + function GetVolume: Word; + procedure SetVolume(const Value: Word); + property ChannelVolume[Channel: TStereoChannel]: Word read GetChannelVolume write SetChannelVolume; + property Volume: Word read GetVolume write SetVolume; + end; + +function MidiOut(DeviceID: Cardinal): IJclWinMidiOut; +procedure GetMidiOutputs(const List: TStrings); +procedure MidiOutCheck(Code: MMResult); + +// MIDI In +procedure MidiInCheck(Code: MMResult); + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + JclResources, JclStrings, JclSysUtils; + +var + FMidiOutputs: TStringList = nil; + +function MidiOutputs: TStrings; +var + I: Integer; + Caps: MIDIOUTCAPS; +begin + if FMidiOutputs = nil then + begin + FMidiOutputs := TStringList.Create; + for I := 0 to midiOutGetNumDevs - 1 do + if (midiOutGetDevCaps(I, @Caps, SizeOf(Caps)) = MMSYSERR_NOERROR) then + FMidiOutputs.Add(Caps.szPName); + end; + Result := FMidiOutputs; +end; + +procedure GetMidiOutputs(const List: TStrings); +begin + List.Assign(MidiOutputs); +end; + +function GetMidiInErrorMessage(const ErrorCode: MMRESULT): string; +begin + SetLength(Result, MAXERRORLENGTH-1); + if midiInGetErrorText(ErrorCode, @Result[1], MAXERRORLENGTH) = MMSYSERR_NOERROR then + StrResetLength(Result) + else + Result := Format(RsMidiInUnknownError, [ErrorCode]); +end; + +function GetMidiOutErrorMessage(const ErrorCode: MMRESULT): string; +begin + SetLength(Result, MAXERRORLENGTH-1); + if midiOutGetErrorText(ErrorCode, @Result[1], MAXERRORLENGTH) = MMSYSERR_NOERROR then + StrResetLength(Result) + else + Result := Format(RsMidiOutUnknownError, [ErrorCode]); +end; + +procedure MidiInCheck(Code: MMResult); +begin + if Code <> MMSYSERR_NOERROR then + raise EJclMidiError.Create(GetMidiInErrorMessage(Code)); +end; + +procedure MidiOutCheck(Code: MMResult); +begin + if Code <> MMSYSERR_NOERROR then + raise EJclMidiError.Create(GetMidiOutErrorMessage(Code)); +end; + +//=== { TJclWinMidiOut } ===================================================== + +var + MidiMapperDeviceID: Cardinal = MIDI_MAPPER; + +function MidiOut(DeviceID: Cardinal): IJclWinMidiOut; +var + Device: TJclWinMidiOut; +begin + if DeviceID = MIDI_MAPPER then + DeviceID := MidiMapperDeviceID; + Device := nil; + if DeviceID <> MIDI_MAPPER then + Device := TJclWinMidiOut(MidiOutputs.Objects[DeviceID]); + // make instance a singleton for a given device ID + if not Assigned(Device) then + begin + Device := TJclWinMidiOut.Create(DeviceID); + if DeviceID = MIDI_MAPPER then + MidiMapperDeviceID := Device.DeviceID; + // cannot use DeviceID argument as index here, since it might be MIDI_MAPPER + MidiOutputs.Objects[Device.DeviceID] := Device; + end; + Result := Device; +end; + +constructor TJclWinMidiOut.Create(ADeviceID: Cardinal); +begin + inherited Create; + FVolume := $FFFFFFFF; // max. volume, in case Get/SetChannelVolume not supported + MidiOutCheck(midiOutGetDevCaps(ADeviceID, @FDeviceCaps, SizeOf(FDeviceCaps))); + MidiOutCheck(midiOutOpen(@FHandle, ADeviceID, 0, 0, 0)); + MidiOutCheck(midiOutGetID(FHandle, @FDeviceID)); +end; + +destructor TJclWinMidiOut.Destroy; +begin + inherited Destroy; + midiOutClose(FHandle); + MidiOutputs.Objects[FDeviceID] := nil; +end; + +function TJclWinMidiOut.GetName: string; +begin + Result := FDeviceCaps.szPName; +end; + +procedure TJclWinMidiOut.LongMessage(const Data: array of Byte); +var + Hdr: MIDIHDR; +begin + ResetMemory(Hdr, SizeOf(Hdr)); + Hdr.dwBufferLength := High(Data) - Low(Data) + 1;; + Hdr.dwBytesRecorded := Hdr.dwBufferLength; + Hdr.lpData := @Data; + Hdr.dwFlags := 0; + MidiOutCheck(midiOutPrepareHeader(FHandle, @Hdr, SizeOf(Hdr))); + MidiOutCheck(midiOutLongMsg(FHandle, @Hdr, SizeOf(Hdr))); + repeat + until (Hdr.dwFlags and MHDR_DONE) <> 0; +end; + +procedure TJclWinMidiOut.DoSendMessage(const Data: array of Byte); +var + I: Integer; + Msg: packed record + case Integer of + 0: + (Bytes: array [0..2] of Byte); + 1: + (DWord: LongWord); + end; +begin + if High(Data) < 3 then + begin + for I := 0 to High(Data) do + Msg.Bytes[I] := Data[I]; + MidiOutCheck(midiOutShortMsg(FHandle, Msg.DWord)); + end + else + LongMessage(Data); +end; + +function TJclWinMidiOut.GetChannelVolume(Channel: TStereoChannel): Word; +begin + midiOutGetVolume(FHandle, @FVolume); + Result := FVolume; +end; + +procedure TJclWinMidiOut.SetChannelVolume(Channel: TStereoChannel; const Value: Word); +begin + if Channel = scLeft then + SetLRVolume(Value, ChannelVolume[scRight]) + else + SetLRVolume(ChannelVolume[scLeft], Value); +end; + +function TJclWinMidiOut.GetVolume: Word; +begin + Result := GetChannelVolume(scLeft); +end; + +procedure TJclWinMidiOut.SetVolume(const Value: Word); +begin + SetLRVolume(Value, Value); +end; + +procedure TJclWinMidiOut.SetLRVolume(const LeftValue, RightValue: Word); +var + Value: DWORD; +begin + with LongRec(Value) do + begin + Lo := LeftValue; + Hi := RightValue; + end; + if Value <> FVolume then + begin + if (MIDICAPS_VOLUME and FDeviceCaps.dwSupport) <> 0 then + MidiOutCheck(midiOutSetVolume(FHandle, Value)); + FVolume := Value; + end; +end; + +initialization + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + FreeAndNil(FMidiOutputs); + +end. diff --git a/3rdParty/JCL/source/windows/MSHelpServices_TLB.pas b/3rdParty/JCL/source/windows/MSHelpServices_TLB.pas new file mode 100644 index 00000000..2050c94f --- /dev/null +++ b/3rdParty/JCL/source/windows/MSHelpServices_TLB.pas @@ -0,0 +1,1667 @@ +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit MSHelpServices_TLB; + +// ************************************************************************ // +// WARNING +// ------- +// The types declared in this file were generated from data read from a +// Type Library. If this type library is explicitly or indirectly (via +// another type library referring to this type library) re-imported, or the +// 'Refresh' command of the Type Library Editor activated while editing the +// Type Library, the contents of this file will be regenerated and all +// manual modifications will be lost. +// ************************************************************************ // + +// PASTLWTR : 1.2 +// File generated on 25/02/2006 20:01:26 from Type Library described below. + +// ************************************************************************ // +// Type Lib: C:\Program Files\Fichiers communs\Microsoft Shared\Help\hxds.dll (1) +// LIBID: {31411197-A502-11D2-BBCA-00C04F8EC294} +// LCID: 0 +// Helpfile: +// HelpString: Microsoft Help Data Services 1.0 Type Library +// DepndLst: +// (1) v2.0 stdole, (C:\WINNT\system32\stdole2.tlb) +// Parent TypeLibrary: +// (0) v1.0 MSHelpControls, (C:\Program Files\Fichiers communs\Microsoft Shared\Help\hxvz.dll) +// Errors: +// Hint: Parameter 'var' of IHxTopic.SetProperty changed to 'var_' +// Hint: Parameter 'var' of IHxAttribute.SetProperty changed to 'var_' +// Hint: Parameter 'var' of IHxCollection.SetProperty changed to 'var_' +// Hint: Parameter 'var' of IHxAttrName.SetProperty changed to 'var_' +// Hint: Parameter 'var' of IHxAttrValue.SetProperty changed to 'var_' +// Hint: Parameter 'type' of IHxRegisterSession.GetRegistrationObject changed to 'type_' +// ************************************************************************ // +// *************************************************************************// +// NOTE: +// Items guarded by $IFDEF_LIVE_SERVER_AT_DESIGN_TIME are used by properties +// which return objects that may need to be explicitly created via a function +// call prior to any access via the property. These items have been disabled +// in order to prevent accidental use from within the object inspector. You +// may enable them by defining LIVE_SERVER_AT_DESIGN_TIME or by selectively +// removing them from the $IFDEF blocks. However, such items must still be +// programmatically created via a method of the appropriate CoClass before +// they can be used. +{ $TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. + +{$I jcl.inc} +{$I windowsonly.inc} + +{$IFDEF SUPPORTS_WEAKPACKAGEUNIT} + {$IFDEF UNITVERSIONING} + {$WEAKPACKAGEUNIT OFF} + {$ELSE ~UNITVERSIONING} + {$WEAKPACKAGEUNIT ON} + {$ENDIF ~UNITVERSIONING} +{$ENDIF SUPPORTS_WEAKPACKAGEUNIT} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.ActiveX, System.Classes; + {$ELSE ~HAS_UNITSCOPE} + ActiveX, Classes; + {$ENDIF ~HAS_UNITSCOPE} + +//DOM-IGNORE-BEGIN + +// *********************************************************************// +// GUIDS declared in the TypeLibrary. Following prefixes are used: +// Type Libraries : LIBID_xxxx +// CoClasses : CLASS_xxxx +// DISPInterfaces : DIID_xxxx +// Non-DISP interfaces: IID_xxxx +// *********************************************************************// +const + // TypeLibrary Major and minor versions + MSHelpServicesMajorVersion = 1; + MSHelpServicesMinorVersion = 0; + + LIBID_MSHelpServices: TGUID = '{31411197-A502-11D2-BBCA-00C04F8EC294}'; + + IID_IHxHierarchy: TGUID = '{314111B2-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxTopic: TGUID = '{31411196-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxAttributeList: TGUID = '{314111AB-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxAttribute: TGUID = '{314111A9-A502-11D2-BBCA-00C04F8EC294}'; + IID_IEnumHxAttribute: TGUID = '{314111AD-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxRegister: TGUID = '{314111BC-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxIndex: TGUID = '{314111CC-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxSession: TGUID = '{31411192-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxTopicList: TGUID = '{31411194-A502-11D2-BBCA-00C04F8EC294}'; + IID_IEnumHxTopic: TGUID = '{31411195-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxQuery: TGUID = '{31411193-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxCollection: TGUID = '{314111A1-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxAttrNameList: TGUID = '{314111CE-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxAttrName: TGUID = '{314111D2-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxAttrValueList: TGUID = '{314111D4-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxAttrValue: TGUID = '{314111D8-A502-11D2-BBCA-00C04F8EC294}'; + IID_IEnumHxAttrValue: TGUID = '{314111D6-A502-11D2-BBCA-00C04F8EC294}'; + IID_IEnumHxAttrName: TGUID = '{314111D0-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxFilters: TGUID = '{314111E3-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxRegFilterList: TGUID = '{31411212-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxRegFilter: TGUID = '{31411221-A502-11D2-BBCA-00C04F8EC294}'; + IID_IEnumHxRegFilter: TGUID = '{3141121C-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxSampleCollection: TGUID = '{314111E6-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxSample: TGUID = '{314111E8-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxRegistryWalker: TGUID = '{314111EF-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxRegNamespaceList: TGUID = '{314111F3-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxRegNamespace: TGUID = '{314111F1-A502-11D2-BBCA-00C04F8EC294}'; + IID_IEnumHxRegNamespace: TGUID = '{314111F5-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxRegTitle: TGUID = '{31411202-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxRegTitleList: TGUID = '{31411203-A502-11D2-BBCA-00C04F8EC294}'; + IID_IEnumHxRegTitle: TGUID = '{31411204-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxRegPlugIn: TGUID = '{3141120A-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxRegPlugInList: TGUID = '{3141120B-A502-11D2-BBCA-00C04F8EC294}'; + IID_IEnumHxRegPlugIn: TGUID = '{3141120C-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxRegisterSession: TGUID = '{31411218-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxPlugIn: TGUID = '{314111DA-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxInitialize: TGUID = '{314111AE-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxCancel: TGUID = '{31411225-A502-11D2-BBCA-00C04F8EC294}'; + DIID_IHxSessionEvents: TGUID = '{314111ED-A502-11D2-BBCA-00C04F8EC294}'; + DIID_IHxRegisterSessionEvents: TGUID = '{31411223-A502-11D2-BBCA-00C04F8EC294}'; + CLASS_HxSession: TGUID = '{31411198-A502-11D2-BBCA-00C04F8EC294}'; + CLASS_HxRegistryWalker: TGUID = '{314111F0-A502-11D2-BBCA-00C04F8EC294}'; + CLASS_HxRegisterSession: TGUID = '{31411219-A502-11D2-BBCA-00C04F8EC294}'; + IID_IHxRegisterProtocol: TGUID = '{31411227-A502-11D2-BBCA-00C04F8EC294}'; + CLASS_HxRegisterProtocol: TGUID = '{31411228-A502-11D2-BBCA-00C04F8EC294}'; + +// *********************************************************************// +// Declaration of Enumerations defined in Type Library +// *********************************************************************// +// Constants for enum HxHierarchyNodeType +type + HxHierarchyNodeType = TOleEnum; +const + HxHierarchy_Book = $00000003; + HxHierarchy_BookPage = $00000004; + HxHierarchy_Page = $00000005; + HxHierarchy_Unknown = $00000008; + +// Constants for enum HxHierarchyPropId +type + HxHierarchyPropId = TOleEnum; +const + HxHierarchyTocFont = $00000000; + HxHierarchyTocFontSize = $00000001; + HxHierarchyTocLangId = $00000002; + HxHierarchyTocCharSet = $00000003; + HxHierarchyTocId = $00000004; + HxHierarchyTocFileVer = $00000005; + HxHierarchyTocIconFile = $00000006; + HxHierarchyTocParentNodeIcon = $00000007; + HxHierarchyTocIcon = $00000008; + +// Constants for enum HxTopicGetTitleType +type + HxTopicGetTitleType = TOleEnum; +const + HxTopicGetTOCTitle = $00000000; + HxTopicGetRLTitle = $00000001; + HxTopicGetHTMTitle = $00000002; + +// Constants for enum HxTopicGetTitleDefVal +type + HxTopicGetTitleDefVal = TOleEnum; +const + HxTopicGetTitleFullURL = $00000000; + HxTopicGetTitleFileName = $00000001; + HxTopicGetTitleNoDefault = $00000002; + +// Constants for enum HxQueryPropId +type + HxQueryPropId = TOleEnum; +const + HxPropIdQueryFirst = $00000000; + +// Constants for enum HxTopicPropId +type + HxTopicPropId = TOleEnum; +const + HxTopicPropIdFirst = $00000000; + +// Constants for enum HxHierarchy_PrintNode_Options +type + HxHierarchy_PrintNode_Options = TOleEnum; +const + HxHierarchy_PrintNode_Option_Node = $00000000; + HxHierarchy_PrintNode_Option_Children = $00000001; + +// Constants for enum HxQuery_Options +type + HxQuery_Options = TOleEnum; +const + HxQuery_No_Option = $00000000; + HxQuery_FullTextSearch_Title_Only = $00000001; + HxQuery_FullTextSearch_Enable_Stemming = $00000002; + HxQuery_FullTextSearch_SearchPrevious = $00000004; + HxQuery_KeywordSearch_CaseSensitive = $0000000A; + +// Constants for enum HxCollectionPropId +type + HxCollectionPropId = TOleEnum; +const + HxCollectionProp_NamespaceName = $00000001; + HxCollectionProp_Font = $00000002; + HxCollectionProp_FontSize = $00000003; + HxCollectionProp_LangId = $00000004; + HxCollectionProp_CharSet = $00000005; + HxCollectionProp_Id = $00000006; + HxCollectionProp_FileVer = $00000007; + HxCollectionProp_CopyRight = $00000008; + +// Constants for enum HxRegFilterPropId +type + HxRegFilterPropId = TOleEnum; +const + HxRegFilterName = $00000000; + HxRegFilterQuery = $00000001; + +// Constants for enum HxIndexPropId +type + HxIndexPropId = TOleEnum; +const + HxIndexFont = $00000000; + HxIndexFontSize = $00000001; + HxIndexLangId = $00000002; + HxIndexCharSet = $00000003; + HxIndexTitleStr = $00000004; + HxIndexIsVisible = $00000005; + HxIndexId = $00000006; + +// Constants for enum HxSampleFileCopyOption +type + HxSampleFileCopyOption = TOleEnum; +const + HxSampleFileCopyNoOption = $00000000; + HxSampleFileCopyOverwrite = $00000001; + HxSampleFileCopyFileOnly = $00000002; + +// Constants for enum HxRegNamespacePropId +type + HxRegNamespacePropId = TOleEnum; +const + HxRegNamespaceTitleList = $00000000; + HxRegNamespacePlugInList = $00000001; + HxRegNamespaceName = $00000002; + HxRegNamespaceCollection = $00000003; + HxRegNamespaceDescription = $00000004; + HxRegNamespaceFilterList = $00000008; + +// Constants for enum HxRegTitlePropId +type + HxRegTitlePropId = TOleEnum; +const + HxRegTitleFileName = $00000000; + HxRegTitleIndexName = $00000001; + HxRegTitleQueryName = $00000002; + HxRegTitleId = $00000003; + HxRegTitleLangId = $00000004; + HxRegAttrQueryName = $00000005; + HxRegTitleHxsMediaLoc = $00000006; + HxRegTitleHxqMediaLoc = $00000007; + HxRegTitleHxrMediaLoc = $00000008; + HxRegTitleSampleMediaLoc = $00000009; + +// Constants for enum HxRegPlugInPropId +type + HxRegPlugInPropId = TOleEnum; +const + HxRegPlugInName = $00000000; + +// Constants for enum HxRegisterSession_InterfaceType +type + HxRegisterSession_InterfaceType = TOleEnum; +const + HxRegisterSession_IHxRegister = $00000000; + HxRegisterSession_IHxFilters = $00000001; + HxRegisterSession_IHxPlugIn = $00000002; + +// Constants for enum HxCancelStatus +type + HxCancelStatus = TOleEnum; +const + HxCancelStatus_Continue = $00000000; + HxCancelStatus_Cancel = $00000001; + +type + +// *********************************************************************// +// Forward declaration of types defined in TypeLibrary +// *********************************************************************// + IHxHierarchy = interface; + IHxHierarchyDisp = dispinterface; + IHxTopic = interface; + IHxTopicDisp = dispinterface; + IHxAttributeList = interface; + IHxAttributeListDisp = dispinterface; + IHxAttribute = interface; + IHxAttributeDisp = dispinterface; + IEnumHxAttribute = interface; + IHxRegister = interface; + IHxRegisterDisp = dispinterface; + IHxIndex = interface; + IHxIndexDisp = dispinterface; + IHxSession = interface; + IHxSessionDisp = dispinterface; + IHxTopicList = interface; + IHxTopicListDisp = dispinterface; + IEnumHxTopic = interface; + IHxQuery = interface; + IHxQueryDisp = dispinterface; + IHxCollection = interface; + IHxCollectionDisp = dispinterface; + IHxAttrNameList = interface; + IHxAttrNameListDisp = dispinterface; + IHxAttrName = interface; + IHxAttrNameDisp = dispinterface; + IHxAttrValueList = interface; + IHxAttrValueListDisp = dispinterface; + IHxAttrValue = interface; + IHxAttrValueDisp = dispinterface; + IEnumHxAttrValue = interface; + IEnumHxAttrName = interface; + IHxFilters = interface; + IHxFiltersDisp = dispinterface; + IHxRegFilterList = interface; + IHxRegFilterListDisp = dispinterface; + IHxRegFilter = interface; + IHxRegFilterDisp = dispinterface; + IEnumHxRegFilter = interface; + IHxSampleCollection = interface; + IHxSampleCollectionDisp = dispinterface; + IHxSample = interface; + IHxSampleDisp = dispinterface; + IHxRegistryWalker = interface; + IHxRegistryWalkerDisp = dispinterface; + IHxRegNamespaceList = interface; + IHxRegNamespaceListDisp = dispinterface; + IHxRegNamespace = interface; + IHxRegNamespaceDisp = dispinterface; + IEnumHxRegNamespace = interface; + IHxRegTitle = interface; + IHxRegTitleDisp = dispinterface; + IHxRegTitleList = interface; + IHxRegTitleListDisp = dispinterface; + IEnumHxRegTitle = interface; + IHxRegPlugIn = interface; + IHxRegPlugInDisp = dispinterface; + IHxRegPlugInList = interface; + IHxRegPlugInListDisp = dispinterface; + IEnumHxRegPlugIn = interface; + IHxRegisterSession = interface; + IHxRegisterSessionDisp = dispinterface; + IHxPlugIn = interface; + IHxPlugInDisp = dispinterface; + IHxInitialize = interface; + IHxInitializeDisp = dispinterface; + IHxCancel = interface; + IHxCancelDisp = dispinterface; + IHxSessionEvents = dispinterface; + IHxRegisterSessionEvents = dispinterface; + IHxRegisterProtocol = interface; + IHxRegisterProtocolDisp = dispinterface; + +// *********************************************************************// +// Declaration of CoClasses defined in Type Library +// (NOTE: Here we map each CoClass to its Default Interface) +// *********************************************************************// + HxSession = IHxSession; + HxRegistryWalker = IHxRegistryWalker; + HxRegisterSession = IHxRegisterSession; + HxRegisterProtocol = IHxRegisterProtocol; + + +// *********************************************************************// +// Declaration of structures, unions and aliases. +// *********************************************************************// + PUserType1 = ^TGUID; {*} + POleVariant1 = ^OleVariant; {*} + + +// *********************************************************************// +// Interface: IHxHierarchy +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111B2-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxHierarchy = interface(IDispatch) + ['{314111B2-A502-11D2-BBCA-00C04F8EC294}'] + function GetRoot: Integer; safecall; + function GetParent(hNode: Integer): Integer; safecall; + function GetSibling(hNode: Integer): Integer; safecall; + function GetFirstChild(hNode: Integer): Integer; safecall; + function GetNextFromUrl(const pURL: WideString): Integer; safecall; + function GetPrevFromUrl(const pURL: WideString): Integer; safecall; + function GetType(hNode: Integer): HxHierarchyNodeType; safecall; + function IsNew(hNode: Integer): WordBool; safecall; + function HasChild(hNode: Integer): WordBool; safecall; + function GetSyncInfo(const pURL: WideString): PSafeArray; safecall; + function GetTitle(hNode: Integer): WideString; safecall; + function GetImageIndexes(hNode: Integer; out pOpen: Integer): Integer; safecall; + function GetURL(hNode: Integer): WideString; safecall; + function OnNavigation(const pbstrURL: WideString): WordBool; safecall; + procedure OnHierarchyNavigation(hNode: Integer); safecall; + function GetProperty(propid: HxHierarchyPropId; hNode: Integer): OleVariant; safecall; + function GetNextFromNode(hNode: Integer): Integer; safecall; + function GetPrevFromNode(hNode: Integer): Integer; safecall; + function GetTopic(hNode: Integer): IHxTopic; safecall; + function GetOpenImageIndex(hNode: Integer): Integer; safecall; + function GetClosedImageIndex(hNode: Integer): Integer; safecall; + procedure PrintNode(hwnd: Integer; hNode: Integer; options: HxHierarchy_PrintNode_Options); safecall; + end; + +// *********************************************************************// +// DispIntf: IHxHierarchyDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111B2-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxHierarchyDisp = dispinterface + ['{314111B2-A502-11D2-BBCA-00C04F8EC294}'] + function GetRoot: Integer; dispid 66561; + function GetParent(hNode: Integer): Integer; dispid 66562; + function GetSibling(hNode: Integer): Integer; dispid 66563; + function GetFirstChild(hNode: Integer): Integer; dispid 66564; + function GetNextFromUrl(const pURL: WideString): Integer; dispid 66565; + function GetPrevFromUrl(const pURL: WideString): Integer; dispid 66566; + function GetType(hNode: Integer): HxHierarchyNodeType; dispid 66567; + function IsNew(hNode: Integer): WordBool; dispid 66568; + function HasChild(hNode: Integer): WordBool; dispid 66569; + function GetSyncInfo(const pURL: WideString): {??PSafeArray}OleVariant; dispid 66570; + function GetTitle(hNode: Integer): WideString; dispid 66571; + function GetImageIndexes(hNode: Integer; out pOpen: Integer): Integer; dispid 66572; + function GetURL(hNode: Integer): WideString; dispid 66573; + function OnNavigation(const pbstrURL: WideString): WordBool; dispid 66574; + procedure OnHierarchyNavigation(hNode: Integer); dispid 66575; + function GetProperty(propid: HxHierarchyPropId; hNode: Integer): OleVariant; dispid 66576; + function GetNextFromNode(hNode: Integer): Integer; dispid 66577; + function GetPrevFromNode(hNode: Integer): Integer; dispid 66578; + function GetTopic(hNode: Integer): IHxTopic; dispid 66579; + function GetOpenImageIndex(hNode: Integer): Integer; dispid 66580; + function GetClosedImageIndex(hNode: Integer): Integer; dispid 66581; + procedure PrintNode(hwnd: Integer; hNode: Integer; options: HxHierarchy_PrintNode_Options); dispid 66582; + end; + {$EXTERNALSYM IHxHierarchyDisp} + +// *********************************************************************// +// Interface: IHxTopic +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {31411196-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxTopic = interface(IDispatch) + ['{31411196-A502-11D2-BBCA-00C04F8EC294}'] + function Get_Title(optType: HxTopicGetTitleType; optDef: HxTopicGetTitleDefVal): WideString; safecall; + function Get_URL: WideString; safecall; + function Get_Location: WideString; safecall; + function Get_Rank: Integer; safecall; + function Get_Attributes: IHxAttributeList; safecall; + procedure GetInfo(out pTitle: WideString; out pURL: WideString; out pLocation: WideString; + out pRank: Integer); safecall; + function GetProperty(propid: HxTopicPropId): OleVariant; safecall; + procedure SetProperty(propid: HxTopicPropId; var_: OleVariant); safecall; + function HasAttribute(const Name: WideString; const Value: WideString): WordBool; safecall; + function HasAttrName(const Name: WideString): WordBool; safecall; + procedure HighlightDocument(const pIDispatch: IDispatch); safecall; + property Title[optType: HxTopicGetTitleType; optDef: HxTopicGetTitleDefVal]: WideString read Get_Title; + property URL: WideString read Get_URL; + property Location: WideString read Get_Location; + property Rank: Integer read Get_Rank; + property Attributes: IHxAttributeList read Get_Attributes; + end; + +// *********************************************************************// +// DispIntf: IHxTopicDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {31411196-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxTopicDisp = dispinterface + ['{31411196-A502-11D2-BBCA-00C04F8EC294}'] + property Title[optType: HxTopicGetTitleType; optDef: HxTopicGetTitleDefVal]: WideString readonly dispid 68097; + property URL: WideString readonly dispid 68098; + property Location: WideString readonly dispid 68099; + property Rank: Integer readonly dispid 68100; + property Attributes: IHxAttributeList readonly dispid 68101; + procedure GetInfo(out pTitle: WideString; out pURL: WideString; out pLocation: WideString; + out pRank: Integer); dispid 68102; + function GetProperty(propid: HxTopicPropId): OleVariant; dispid 68103; + procedure SetProperty(propid: HxTopicPropId; var_: OleVariant); dispid 68104; + function HasAttribute(const Name: WideString; const Value: WideString): WordBool; dispid 68105; + function HasAttrName(const Name: WideString): WordBool; dispid 68106; + procedure HighlightDocument(const pIDispatch: IDispatch); dispid 68107; + end; + {$EXTERNALSYM IHxTopicDisp} + +// *********************************************************************// +// Interface: IHxAttributeList +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111AB-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxAttributeList = interface(IDispatch) + ['{314111AB-A502-11D2-BBCA-00C04F8EC294}'] + function Get_Count: Integer; safecall; + function ItemAt(index: Integer): IHxAttribute; safecall; + function EnumAttribute(filter: Integer; options: Integer): IEnumHxAttribute; safecall; + function Get__NewEnum: IUnknown; safecall; + function Item(index: OleVariant): IHxAttribute; safecall; + property Count: Integer read Get_Count; + property _NewEnum: IUnknown read Get__NewEnum; + end; + +// *********************************************************************// +// DispIntf: IHxAttributeListDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111AB-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxAttributeListDisp = dispinterface + ['{314111AB-A502-11D2-BBCA-00C04F8EC294}'] + property Count: Integer readonly dispid 70400; + function ItemAt(index: Integer): IHxAttribute; dispid 70401; + function EnumAttribute(filter: Integer; options: Integer): IEnumHxAttribute; dispid 70402; + property _NewEnum: IUnknown readonly dispid -4; + function Item(index: OleVariant): IHxAttribute; dispid 70403; + end; + {$EXTERNALSYM IHxAttributeListDisp} + +// *********************************************************************// +// Interface: IHxAttribute +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111A9-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxAttribute = interface(IDispatch) + ['{314111A9-A502-11D2-BBCA-00C04F8EC294}'] + function GetProperty(propid: HxQueryPropId): OleVariant; safecall; + procedure SetProperty(propid: HxQueryPropId; var_: OleVariant); safecall; + function Get_Name: WideString; safecall; + function Get_Value: WideString; safecall; + function Get_DisplayName: WideString; safecall; + function Get_DisplayValue: WideString; safecall; + property Name: WideString read Get_Name; + property Value: WideString read Get_Value; + property DisplayName: WideString read Get_DisplayName; + property DisplayValue: WideString read Get_DisplayValue; + end; + +// *********************************************************************// +// DispIntf: IHxAttributeDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111A9-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxAttributeDisp = dispinterface + ['{314111A9-A502-11D2-BBCA-00C04F8EC294}'] + function GetProperty(propid: HxQueryPropId): OleVariant; dispid 69888; + procedure SetProperty(propid: HxQueryPropId; var_: OleVariant); dispid 69889; + property Name: WideString readonly dispid 69890; + property Value: WideString readonly dispid 69891; + property DisplayName: WideString readonly dispid 69892; + property DisplayValue: WideString readonly dispid 69893; + end; + {$EXTERNALSYM IHxAttributeDisp} + +// *********************************************************************// +// Interface: IEnumHxAttribute +// Flags: (16) Hidden +// GUID: {314111AD-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IEnumHxAttribute = interface(IUnknown) + ['{314111AD-A502-11D2-BBCA-00C04F8EC294}'] + function Next(celt: LongWord; out ppIHxAttribute: IHxAttribute; out pceltFetched: LongWord): HResult; stdcall; + function Reset: HResult; stdcall; + function Skip(celt: LongWord): HResult; stdcall; + function Clone(out ppEnum: IEnumHxAttribute): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: IHxRegister +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111BC-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegister = interface(IDispatch) + ['{314111BC-A502-11D2-BBCA-00C04F8EC294}'] + procedure RegisterNamespace(const bstrNamespace: WideString; const bstrCollection: WideString; + const bstrDescription: WideString); safecall; + function IsNamespace(const bstrNamespace: WideString): WordBool; safecall; + function GetCollection(const bstrNamespace: WideString): WideString; safecall; + function GetDescription(const bstrNamespace: WideString): WideString; safecall; + procedure RemoveNamespace(const bstrNamespace: WideString); safecall; + procedure RegisterHelpFile(const bstrNamespace: WideString; const bstrId: WideString; + LangId: Integer; const bstrHelpFile: WideString); safecall; + function RegisterMedia(const bstrNamespace: WideString; const bstrFriendly: WideString; + const bstrPath: WideString): Integer; safecall; + procedure RemoveHelpFile(const bstrNamespace: WideString; const bstrId: WideString; + LangId: Integer); safecall; + procedure RegisterHelpFileSet(const bstrNamespace: WideString; const bstrId: WideString; + LangId: Integer; const bstrHxs: WideString; + const bstrHxi: WideString; const bstrHxq: WideString; + const bstrHxr: WideString; lHxsMediaId: Integer; + lHxqMediaId: Integer; lHxrMediaId: Integer; + lSampleMediaId: Integer); safecall; + end; + +// *********************************************************************// +// DispIntf: IHxRegisterDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111BC-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegisterDisp = dispinterface + ['{314111BC-A502-11D2-BBCA-00C04F8EC294}'] + procedure RegisterNamespace(const bstrNamespace: WideString; const bstrCollection: WideString; + const bstrDescription: WideString); dispid 66817; + function IsNamespace(const bstrNamespace: WideString): WordBool; dispid 66818; + function GetCollection(const bstrNamespace: WideString): WideString; dispid 66830; + function GetDescription(const bstrNamespace: WideString): WideString; dispid 66829; + procedure RemoveNamespace(const bstrNamespace: WideString); dispid 66819; + procedure RegisterHelpFile(const bstrNamespace: WideString; const bstrId: WideString; + LangId: Integer; const bstrHelpFile: WideString); dispid 66822; + function RegisterMedia(const bstrNamespace: WideString; const bstrFriendly: WideString; + const bstrPath: WideString): Integer; dispid 66823; + procedure RemoveHelpFile(const bstrNamespace: WideString; const bstrId: WideString; + LangId: Integer); dispid 66825; + procedure RegisterHelpFileSet(const bstrNamespace: WideString; const bstrId: WideString; + LangId: Integer; const bstrHxs: WideString; + const bstrHxi: WideString; const bstrHxq: WideString; + const bstrHxr: WideString; lHxsMediaId: Integer; + lHxqMediaId: Integer; lHxrMediaId: Integer; + lSampleMediaId: Integer); dispid 66831; + end; + {$EXTERNALSYM IHxRegisterDisp} + +// *********************************************************************// +// Interface: IHxIndex +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111CC-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxIndex = interface(IDispatch) + ['{314111CC-A502-11D2-BBCA-00C04F8EC294}'] + function GetSession: IHxSession; safecall; + function Get_Count: Integer; safecall; + function GetStringFromSlot(iSlot: Integer): WideString; safecall; + function GetLevelFromSlot(iSlot: Integer): Integer; safecall; + function GetSlotFromString(const bszLink: WideString): Integer; safecall; + function GetTopicsFromSlot(uiSlot: Integer): IHxTopicList; safecall; + function GetTopicsFromString(const bszLink: WideString; options: Integer): IHxTopicList; safecall; + function GetInfoFromSlot(iSlot: Integer; out piLevel: Integer): WideString; safecall; + function GetProperty(propid: HxIndexPropId): OleVariant; safecall; + function GetCrossRef(iSlot: Integer): WideString; safecall; + function GetFullStringFromSlot(iSlot: Integer; const sep: WideString): WideString; safecall; + function GetCrossRefSlot(iSlot: Integer): Integer; safecall; + property Count: Integer read Get_Count; + end; + +// *********************************************************************// +// DispIntf: IHxIndexDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111CC-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxIndexDisp = dispinterface + ['{314111CC-A502-11D2-BBCA-00C04F8EC294}'] + function GetSession: IHxSession; dispid 67072; + property Count: Integer readonly dispid 67073; + function GetStringFromSlot(iSlot: Integer): WideString; dispid 67074; + function GetLevelFromSlot(iSlot: Integer): Integer; dispid 67078; + function GetSlotFromString(const bszLink: WideString): Integer; dispid 67075; + function GetTopicsFromSlot(uiSlot: Integer): IHxTopicList; dispid 67076; + function GetTopicsFromString(const bszLink: WideString; options: Integer): IHxTopicList; dispid 67077; + function GetInfoFromSlot(iSlot: Integer; out piLevel: Integer): WideString; dispid 67079; + function GetProperty(propid: HxIndexPropId): OleVariant; dispid 67080; + function GetCrossRef(iSlot: Integer): WideString; dispid 67081; + function GetFullStringFromSlot(iSlot: Integer; const sep: WideString): WideString; dispid 67082; + function GetCrossRefSlot(iSlot: Integer): Integer; dispid 67083; + end; + {$EXTERNALSYM IHxIndexDisp} + +// *********************************************************************// +// Interface: IHxSession +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {31411192-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxSession = interface(IDispatch) + ['{31411192-A502-11D2-BBCA-00C04F8EC294}'] + procedure Initialize(const NameSpace: WideString; options: Integer); safecall; + function Query(const keywords: WideString; const NavDataMoniker: WideString; options: Integer; + const FilterMoniker: WideString): IHxTopicList; safecall; + function QueryForTopic(const keywords: WideString; const NavDataMoniker: WideString; + options: Integer; const FilterMoniker: WideString): IHxTopic; safecall; + function QueryForUrl(const keywords: WideString; const NavDataMoniker: WideString; + options: Integer; const FilterMoniker: WideString): WideString; safecall; + function GetNavigationInterface(const NavDataMoniker: WideString; + const FilterMoniker: WideString; var refiid: TGUID): IDispatch; safecall; + function GetNavigationObject(const NavDataMoniker: WideString; const FilterMoniker: WideString): IDispatch; safecall; + function GetQueryObject(const NavDataMoniker: WideString; const FilterMoniker: WideString): IHxQuery; safecall; + function Get_Collection: IHxCollection; safecall; + function Get_LangId: Smallint; safecall; + procedure Set_LangId(piHelpLangId: Smallint); safecall; + function GetFilterList: IHxRegFilterList; safecall; + property Collection: IHxCollection read Get_Collection; + property LangId: Smallint read Get_LangId write Set_LangId; + end; + +// *********************************************************************// +// DispIntf: IHxSessionDisp +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {31411192-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxSessionDisp = dispinterface + ['{31411192-A502-11D2-BBCA-00C04F8EC294}'] + procedure Initialize(const NameSpace: WideString; options: Integer); dispid 65792; + function Query(const keywords: WideString; const NavDataMoniker: WideString; options: Integer; + const FilterMoniker: WideString): IHxTopicList; dispid 65793; + function QueryForTopic(const keywords: WideString; const NavDataMoniker: WideString; + options: Integer; const FilterMoniker: WideString): IHxTopic; dispid 65794; + function QueryForUrl(const keywords: WideString; const NavDataMoniker: WideString; + options: Integer; const FilterMoniker: WideString): WideString; dispid 65795; + function GetNavigationInterface(const NavDataMoniker: WideString; + const FilterMoniker: WideString; var refiid: {??TGUID}OleVariant): IDispatch; dispid 65796; + function GetNavigationObject(const NavDataMoniker: WideString; const FilterMoniker: WideString): IDispatch; dispid 65797; + function GetQueryObject(const NavDataMoniker: WideString; const FilterMoniker: WideString): IHxQuery; dispid 65798; + property Collection: IHxCollection readonly dispid 65799; + property LangId: Smallint dispid 65803; + function GetFilterList: IHxRegFilterList; dispid 65805; + end; + {$EXTERNALSYM IHxSessionDisp} + +// *********************************************************************// +// Interface: IHxTopicList +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {31411194-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxTopicList = interface(IDispatch) + ['{31411194-A502-11D2-BBCA-00C04F8EC294}'] + function Item(index: OleVariant): IHxTopic; safecall; + function ItemAt(index: Integer): IHxTopic; safecall; + function EnumTopics(filter: Integer; options: Integer): IEnumHxTopic; safecall; + function Get__NewEnum: IUnknown; safecall; + function Get_Count: Integer; safecall; + property _NewEnum: IUnknown read Get__NewEnum; + property Count: Integer read Get_Count; + end; + +// *********************************************************************// +// DispIntf: IHxTopicListDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {31411194-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxTopicListDisp = dispinterface + ['{31411194-A502-11D2-BBCA-00C04F8EC294}'] + function Item(index: OleVariant): IHxTopic; dispid 0; + function ItemAt(index: Integer): IHxTopic; dispid 67584; + function EnumTopics(filter: Integer; options: Integer): IEnumHxTopic; dispid 67585; + property _NewEnum: IUnknown readonly dispid -4; + property Count: Integer readonly dispid 67586; + end; + {$EXTERNALSYM IHxTopicListDisp} + +// *********************************************************************// +// Interface: IEnumHxTopic +// Flags: (16) Hidden +// GUID: {31411195-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IEnumHxTopic = interface(IUnknown) + ['{31411195-A502-11D2-BBCA-00C04F8EC294}'] + function Next(celt: LongWord; out ppIHxTopic: IHxTopic; out pceltFetched: LongWord): HResult; stdcall; + function Reset: HResult; stdcall; + function Skip(celt: LongWord): HResult; stdcall; + function Clone(out ppEnum: IEnumHxTopic): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: IHxQuery +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {31411193-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxQuery = interface(IDispatch) + ['{31411193-A502-11D2-BBCA-00C04F8EC294}'] + function Query(const keywords: WideString; options: HxQuery_Options): IHxTopicList; safecall; + function QueryForTopic(const keywords: WideString; options: HxQuery_Options): IHxTopic; safecall; + function QueryForUrl(const keywords: WideString; options: HxQuery_Options): WideString; safecall; + end; + +// *********************************************************************// +// DispIntf: IHxQueryDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {31411193-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxQueryDisp = dispinterface + ['{31411193-A502-11D2-BBCA-00C04F8EC294}'] + function Query(const keywords: WideString; options: HxQuery_Options): IHxTopicList; dispid 67328; + function QueryForTopic(const keywords: WideString; options: HxQuery_Options): IHxTopic; dispid 67329; + function QueryForUrl(const keywords: WideString; options: HxQuery_Options): WideString; dispid 67330; + end; + {$EXTERNALSYM IHxQueryDisp} + +// *********************************************************************// +// Interface: IHxCollection +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111A1-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxCollection = interface(IDispatch) + ['{314111A1-A502-11D2-BBCA-00C04F8EC294}'] + function GetProperty(propid: HxCollectionPropId): OleVariant; safecall; + procedure SetProperty(propid: HxCollectionPropId; var_: OleVariant); safecall; + function Get_URL: WideString; safecall; + function Get_AttributeNames: IHxAttrNameList; safecall; + function Get_Filters: IHxFilters; safecall; + function Get_Title: WideString; safecall; + procedure MergeIndex; safecall; + function GetFilterTopicCount(const bstrQuery: WideString): Integer; safecall; + property URL: WideString read Get_URL; + property AttributeNames: IHxAttrNameList read Get_AttributeNames; + property Filters: IHxFilters read Get_Filters; + property Title: WideString read Get_Title; + end; + +// *********************************************************************// +// DispIntf: IHxCollectionDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111A1-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxCollectionDisp = dispinterface + ['{314111A1-A502-11D2-BBCA-00C04F8EC294}'] + function GetProperty(propid: HxCollectionPropId): OleVariant; dispid 68352; + procedure SetProperty(propid: HxCollectionPropId; var_: OleVariant); dispid 68353; + property URL: WideString readonly dispid 68354; + property AttributeNames: IHxAttrNameList readonly dispid 68357; + property Filters: IHxFilters readonly dispid 68358; + property Title: WideString readonly dispid 68359; + procedure MergeIndex; dispid 68360; + function GetFilterTopicCount(const bstrQuery: WideString): Integer; dispid 68361; + end; + {$EXTERNALSYM IHxCollectionDisp} + +// *********************************************************************// +// Interface: IHxAttrNameList +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111CE-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxAttrNameList = interface(IDispatch) + ['{314111CE-A502-11D2-BBCA-00C04F8EC294}'] + function Get_Count: Integer; safecall; + function ItemAt(index: Integer): IHxAttrName; safecall; + function EnumAttrName(filter: Integer; options: Integer): IEnumHxAttrName; safecall; + function Get__NewEnum: IUnknown; safecall; + function Item(index: OleVariant): IHxAttrName; safecall; + property Count: Integer read Get_Count; + property _NewEnum: IUnknown read Get__NewEnum; + end; + +// *********************************************************************// +// DispIntf: IHxAttrNameListDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111CE-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxAttrNameListDisp = dispinterface + ['{314111CE-A502-11D2-BBCA-00C04F8EC294}'] + property Count: Integer readonly dispid 71168; + function ItemAt(index: Integer): IHxAttrName; dispid 71169; + function EnumAttrName(filter: Integer; options: Integer): IEnumHxAttrName; dispid 71170; + property _NewEnum: IUnknown readonly dispid -4; + function Item(index: OleVariant): IHxAttrName; dispid 71171; + end; + {$EXTERNALSYM IHxAttrNameListDisp} + +// *********************************************************************// +// Interface: IHxAttrName +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111D2-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxAttrName = interface(IDispatch) + ['{314111D2-A502-11D2-BBCA-00C04F8EC294}'] + function GetProperty(propid: HxQueryPropId): OleVariant; safecall; + procedure SetProperty(propid: HxQueryPropId; var_: OleVariant); safecall; + function Get_Name: WideString; safecall; + function Get_DisplayName: WideString; safecall; + function Get_Flag: Integer; safecall; + function Get_AttributeValues: IHxAttrValueList; safecall; + property Name: WideString read Get_Name; + property DisplayName: WideString read Get_DisplayName; + property Flag: Integer read Get_Flag; + property AttributeValues: IHxAttrValueList read Get_AttributeValues; + end; + +// *********************************************************************// +// DispIntf: IHxAttrNameDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111D2-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxAttrNameDisp = dispinterface + ['{314111D2-A502-11D2-BBCA-00C04F8EC294}'] + function GetProperty(propid: HxQueryPropId): OleVariant; dispid 70656; + procedure SetProperty(propid: HxQueryPropId; var_: OleVariant); dispid 70657; + property Name: WideString readonly dispid 70658; + property DisplayName: WideString readonly dispid 70659; + property Flag: Integer readonly dispid 70660; + property AttributeValues: IHxAttrValueList readonly dispid 70661; + end; + {$EXTERNALSYM IHxAttrNameDisp} + +// *********************************************************************// +// Interface: IHxAttrValueList +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111D4-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxAttrValueList = interface(IDispatch) + ['{314111D4-A502-11D2-BBCA-00C04F8EC294}'] + function Get_Count: Integer; safecall; + function ItemAt(index: Integer): IHxAttrValue; safecall; + function EnumAttrValue(filter: Integer; options: Integer): IEnumHxAttrValue; safecall; + function Get__NewEnum: IUnknown; safecall; + function Item(index: OleVariant): IHxAttrValue; safecall; + property Count: Integer read Get_Count; + property _NewEnum: IUnknown read Get__NewEnum; + end; + +// *********************************************************************// +// DispIntf: IHxAttrValueListDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111D4-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxAttrValueListDisp = dispinterface + ['{314111D4-A502-11D2-BBCA-00C04F8EC294}'] + property Count: Integer readonly dispid 71936; + function ItemAt(index: Integer): IHxAttrValue; dispid 71937; + function EnumAttrValue(filter: Integer; options: Integer): IEnumHxAttrValue; dispid 71938; + property _NewEnum: IUnknown readonly dispid -4; + function Item(index: OleVariant): IHxAttrValue; dispid 71939; + end; + {$EXTERNALSYM IHxAttrValueListDisp} + +// *********************************************************************// +// Interface: IHxAttrValue +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111D8-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxAttrValue = interface(IDispatch) + ['{314111D8-A502-11D2-BBCA-00C04F8EC294}'] + function GetProperty(propid: HxQueryPropId): OleVariant; safecall; + procedure SetProperty(propid: HxQueryPropId; var_: OleVariant); safecall; + function Get_Value: WideString; safecall; + function Get_DisplayValue: WideString; safecall; + function Get_Flag: Integer; safecall; + property Value: WideString read Get_Value; + property DisplayValue: WideString read Get_DisplayValue; + property Flag: Integer read Get_Flag; + end; + +// *********************************************************************// +// DispIntf: IHxAttrValueDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111D8-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxAttrValueDisp = dispinterface + ['{314111D8-A502-11D2-BBCA-00C04F8EC294}'] + function GetProperty(propid: HxQueryPropId): OleVariant; dispid 71424; + procedure SetProperty(propid: HxQueryPropId; var_: OleVariant); dispid 71425; + property Value: WideString readonly dispid 71426; + property DisplayValue: WideString readonly dispid 71427; + property Flag: Integer readonly dispid 71428; + end; + {$EXTERNALSYM IHxAttrValueDisp} + +// *********************************************************************// +// Interface: IEnumHxAttrValue +// Flags: (16) Hidden +// GUID: {314111D6-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IEnumHxAttrValue = interface(IUnknown) + ['{314111D6-A502-11D2-BBCA-00C04F8EC294}'] + function Next(celt: LongWord; out ppIHxAttrValue: IHxAttrValue; out pceltFetched: LongWord): HResult; stdcall; + function Reset: HResult; stdcall; + function Skip(celt: LongWord): HResult; stdcall; + function Clone(out ppEnum: IEnumHxAttrValue): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: IEnumHxAttrName +// Flags: (16) Hidden +// GUID: {314111D0-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IEnumHxAttrName = interface(IUnknown) + ['{314111D0-A502-11D2-BBCA-00C04F8EC294}'] + function Next(celt: LongWord; out ppIHxAttrName: IHxAttrName; out pceltFetched: LongWord): HResult; stdcall; + function Reset: HResult; stdcall; + function Skip(celt: LongWord): HResult; stdcall; + function Clone(out ppEnum: IEnumHxAttrName): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: IHxFilters +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111E3-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxFilters = interface(IDispatch) + ['{314111E3-A502-11D2-BBCA-00C04F8EC294}'] + function Count: Integer; safecall; + function GetFilter(iIndex: Integer; out pbstrName: WideString): WideString; safecall; + function GetFilterName(iIndex: Integer): WideString; safecall; + function GetFilterQuery(iIndex: Integer): WideString; safecall; + procedure RegisterFilter(const bstrName: WideString; const bstrQuery: WideString); safecall; + procedure RemoveFilter(const bstrName: WideString); safecall; + function FindFilter(const bstrName: WideString): WideString; safecall; + procedure SetNamespace(const bstrName: WideString); safecall; + procedure SetCollectionFiltersFlag(vb: WordBool); safecall; + end; + +// *********************************************************************// +// DispIntf: IHxFiltersDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111E3-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxFiltersDisp = dispinterface + ['{314111E3-A502-11D2-BBCA-00C04F8EC294}'] + function Count: Integer; dispid 66048; + function GetFilter(iIndex: Integer; out pbstrName: WideString): WideString; dispid 66049; + function GetFilterName(iIndex: Integer): WideString; dispid 66054; + function GetFilterQuery(iIndex: Integer): WideString; dispid 66055; + procedure RegisterFilter(const bstrName: WideString; const bstrQuery: WideString); dispid 66050; + procedure RemoveFilter(const bstrName: WideString); dispid 66051; + function FindFilter(const bstrName: WideString): WideString; dispid 66052; + procedure SetNamespace(const bstrName: WideString); dispid 66053; + procedure SetCollectionFiltersFlag(vb: WordBool); dispid 66057; + end; + {$EXTERNALSYM IHxFiltersDisp} + +// *********************************************************************// +// Interface: IHxRegFilterList +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {31411212-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegFilterList = interface(IDispatch) + ['{31411212-A502-11D2-BBCA-00C04F8EC294}'] + function Item(index: OleVariant): IHxRegFilter; safecall; + function ItemAt(index: Integer): IHxRegFilter; safecall; + function EnumRegFilter(filter: Integer; options: Integer): IEnumHxRegFilter; safecall; + function Get__NewEnum: IUnknown; safecall; + function Get_Count: Integer; safecall; + function FindFilter(const bstrFilterName: WideString): IHxRegFilter; safecall; + property _NewEnum: IUnknown read Get__NewEnum; + property Count: Integer read Get_Count; + end; + +// *********************************************************************// +// DispIntf: IHxRegFilterListDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {31411212-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegFilterListDisp = dispinterface + ['{31411212-A502-11D2-BBCA-00C04F8EC294}'] + function Item(index: OleVariant): IHxRegFilter; dispid 0; + function ItemAt(index: Integer): IHxRegFilter; dispid 75776; + function EnumRegFilter(filter: Integer; options: Integer): IEnumHxRegFilter; dispid 75777; + property _NewEnum: IUnknown readonly dispid -4; + property Count: Integer readonly dispid 75778; + function FindFilter(const bstrFilterName: WideString): IHxRegFilter; dispid 75779; + end; + {$EXTERNALSYM IHxRegFilterListDisp} + +// *********************************************************************// +// Interface: IHxRegFilter +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {31411221-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegFilter = interface(IDispatch) + ['{31411221-A502-11D2-BBCA-00C04F8EC294}'] + function GetProperty(propid: HxRegFilterPropId): OleVariant; safecall; + end; + +// *********************************************************************// +// DispIntf: IHxRegFilterDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {31411221-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegFilterDisp = dispinterface + ['{31411221-A502-11D2-BBCA-00C04F8EC294}'] + function GetProperty(propid: HxRegFilterPropId): OleVariant; dispid 75520; + end; + {$EXTERNALSYM IHxRegFilterDisp} + +// *********************************************************************// +// Interface: IEnumHxRegFilter +// Flags: (16) Hidden +// GUID: {3141121C-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IEnumHxRegFilter = interface(IUnknown) + ['{3141121C-A502-11D2-BBCA-00C04F8EC294}'] + function Next(celt: LongWord; out ppIHxRegFilter: IHxRegFilter; out pceltFetched: LongWord): HResult; stdcall; + function Reset: HResult; stdcall; + function Skip(celt: LongWord): HResult; stdcall; + function Clone(out ppEnum: IEnumHxRegFilter): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: IHxSampleCollection +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111E6-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxSampleCollection = interface(IDispatch) + ['{314111E6-A502-11D2-BBCA-00C04F8EC294}'] + function GetSampleFromId(const bstrTopicUrl: WideString; const bstrId: WideString; + const bstrSFLName: WideString): IHxSample; safecall; + end; + +// *********************************************************************// +// DispIntf: IHxSampleCollectionDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111E6-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxSampleCollectionDisp = dispinterface + ['{314111E6-A502-11D2-BBCA-00C04F8EC294}'] + function GetSampleFromId(const bstrTopicUrl: WideString; const bstrId: WideString; + const bstrSFLName: WideString): IHxSample; dispid 72448; + end; + {$EXTERNALSYM IHxSampleCollectionDisp} + +// *********************************************************************// +// Interface: IHxSample +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111E8-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxSample = interface(IDispatch) + ['{314111E8-A502-11D2-BBCA-00C04F8EC294}'] + function Get_SampleId: WideString; safecall; + function Get_LoadString: WideString; safecall; + function Get_DestinationDir: WideString; safecall; + function Get_ProjectFileExt: WideString; safecall; + function Get_FileCount: Integer; safecall; + function GetFileNameAtIndex(index: Integer): WideString; safecall; + procedure CopyFileAtIndex(index: Integer; const bstrDest: WideString; + option: HxSampleFileCopyOption); safecall; + function ChooseDirectory(const bstrDefaultDir: WideString; const bstrTitle: WideString): WideString; safecall; + function GetFileTextAtIndex(index: Integer): WideString; safecall; + property SampleId: WideString read Get_SampleId; + property LoadString: WideString read Get_LoadString; + property DestinationDir: WideString read Get_DestinationDir; + property ProjectFileExt: WideString read Get_ProjectFileExt; + property FileCount: Integer read Get_FileCount; + end; + +// *********************************************************************// +// DispIntf: IHxSampleDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111E8-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxSampleDisp = dispinterface + ['{314111E8-A502-11D2-BBCA-00C04F8EC294}'] + property SampleId: WideString readonly dispid 72704; + property LoadString: WideString readonly dispid 72705; + property DestinationDir: WideString readonly dispid 72706; + property ProjectFileExt: WideString readonly dispid 72707; + property FileCount: Integer readonly dispid 72709; + function GetFileNameAtIndex(index: Integer): WideString; dispid 72710; + procedure CopyFileAtIndex(index: Integer; const bstrDest: WideString; + option: HxSampleFileCopyOption); dispid 72711; + function ChooseDirectory(const bstrDefaultDir: WideString; const bstrTitle: WideString): WideString; dispid 72713; + function GetFileTextAtIndex(index: Integer): WideString; dispid 72714; + end; + {$EXTERNALSYM IHxSampleDisp} + +// *********************************************************************// +// Interface: IHxRegistryWalker +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111EF-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegistryWalker = interface(IDispatch) + ['{314111EF-A502-11D2-BBCA-00C04F8EC294}'] + function Get_RegisteredNamespaceList(const bstrStart: WideString): IHxRegNamespaceList; safecall; + property RegisteredNamespaceList[const bstrStart: WideString]: IHxRegNamespaceList read Get_RegisteredNamespaceList; + end; + +// *********************************************************************// +// DispIntf: IHxRegistryWalkerDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111EF-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegistryWalkerDisp = dispinterface + ['{314111EF-A502-11D2-BBCA-00C04F8EC294}'] + property RegisteredNamespaceList[const bstrStart: WideString]: IHxRegNamespaceList readonly dispid 72960; + end; + {$EXTERNALSYM IHxRegistryWalkerDisp} + +// *********************************************************************// +// Interface: IHxRegNamespaceList +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111F3-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegNamespaceList = interface(IDispatch) + ['{314111F3-A502-11D2-BBCA-00C04F8EC294}'] + function Item(index: OleVariant): IHxRegNamespace; safecall; + function ItemAt(index: Integer): IHxRegNamespace; safecall; + function EnumRegNamespace(filter: Integer; options: Integer): IEnumHxRegNamespace; safecall; + function Get__NewEnum: IUnknown; safecall; + function Get_Count: Integer; safecall; + property _NewEnum: IUnknown read Get__NewEnum; + property Count: Integer read Get_Count; + end; + +// *********************************************************************// +// DispIntf: IHxRegNamespaceListDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111F3-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegNamespaceListDisp = dispinterface + ['{314111F3-A502-11D2-BBCA-00C04F8EC294}'] + function Item(index: OleVariant): IHxRegNamespace; dispid 0; + function ItemAt(index: Integer): IHxRegNamespace; dispid 73472; + function EnumRegNamespace(filter: Integer; options: Integer): IEnumHxRegNamespace; dispid 73473; + property _NewEnum: IUnknown readonly dispid -4; + property Count: Integer readonly dispid 73474; + end; + {$EXTERNALSYM IHxRegNamespaceListDisp} + +// *********************************************************************// +// Interface: IHxRegNamespace +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111F1-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegNamespace = interface(IDispatch) + ['{314111F1-A502-11D2-BBCA-00C04F8EC294}'] + function Get_Name: WideString; safecall; + function GetProperty(propid: HxRegNamespacePropId): OleVariant; safecall; + function IsTitle(const bstrTitle: WideString): WordBool; safecall; + property Name: WideString read Get_Name; + end; + +// *********************************************************************// +// DispIntf: IHxRegNamespaceDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111F1-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegNamespaceDisp = dispinterface + ['{314111F1-A502-11D2-BBCA-00C04F8EC294}'] + property Name: WideString readonly dispid 73216; + function GetProperty(propid: HxRegNamespacePropId): OleVariant; dispid 73217; + function IsTitle(const bstrTitle: WideString): WordBool; dispid 73218; + end; + {$EXTERNALSYM IHxRegNamespaceDisp} + +// *********************************************************************// +// Interface: IEnumHxRegNamespace +// Flags: (16) Hidden +// GUID: {314111F5-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IEnumHxRegNamespace = interface(IUnknown) + ['{314111F5-A502-11D2-BBCA-00C04F8EC294}'] + function Next(celt: LongWord; out ppIHxRegNamespace: IHxRegNamespace; out pceltFetched: LongWord): HResult; stdcall; + function Reset: HResult; stdcall; + function Skip(celt: LongWord): HResult; stdcall; + function Clone(out ppEnum: IEnumHxRegNamespace): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: IHxRegTitle +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {31411202-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegTitle = interface(IDispatch) + ['{31411202-A502-11D2-BBCA-00C04F8EC294}'] + function GetProperty(propid: HxRegTitlePropId): OleVariant; safecall; + end; + +// *********************************************************************// +// DispIntf: IHxRegTitleDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {31411202-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegTitleDisp = dispinterface + ['{31411202-A502-11D2-BBCA-00C04F8EC294}'] + function GetProperty(propid: HxRegTitlePropId): OleVariant; dispid 73984; + end; + {$EXTERNALSYM IHxRegTitleDisp} + +// *********************************************************************// +// Interface: IHxRegTitleList +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {31411203-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegTitleList = interface(IDispatch) + ['{31411203-A502-11D2-BBCA-00C04F8EC294}'] + function Item(index: OleVariant): IHxRegTitle; safecall; + function ItemAt(index: Integer): IHxRegTitle; safecall; + function EnumRegTitle(filter: Integer; options: Integer): IEnumHxRegTitle; safecall; + function Get__NewEnum: IUnknown; safecall; + function Get_Count: Integer; safecall; + property _NewEnum: IUnknown read Get__NewEnum; + property Count: Integer read Get_Count; + end; + +// *********************************************************************// +// DispIntf: IHxRegTitleListDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {31411203-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegTitleListDisp = dispinterface + ['{31411203-A502-11D2-BBCA-00C04F8EC294}'] + function Item(index: OleVariant): IHxRegTitle; dispid 0; + function ItemAt(index: Integer): IHxRegTitle; dispid 74240; + function EnumRegTitle(filter: Integer; options: Integer): IEnumHxRegTitle; dispid 74241; + property _NewEnum: IUnknown readonly dispid -4; + property Count: Integer readonly dispid 74242; + end; + {$EXTERNALSYM IHxRegTitleListDisp} + +// *********************************************************************// +// Interface: IEnumHxRegTitle +// Flags: (16) Hidden +// GUID: {31411204-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IEnumHxRegTitle = interface(IUnknown) + ['{31411204-A502-11D2-BBCA-00C04F8EC294}'] + function Next(celt: LongWord; out ppIHxRegTitle: IHxRegTitle; out pceltFetched: LongWord): HResult; stdcall; + function Reset: HResult; stdcall; + function Skip(celt: LongWord): HResult; stdcall; + function Clone(out ppEnum: IEnumHxRegTitle): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: IHxRegPlugIn +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {3141120A-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegPlugIn = interface(IDispatch) + ['{3141120A-A502-11D2-BBCA-00C04F8EC294}'] + function GetProperty(propid: HxRegPlugInPropId): OleVariant; safecall; + end; + +// *********************************************************************// +// DispIntf: IHxRegPlugInDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {3141120A-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegPlugInDisp = dispinterface + ['{3141120A-A502-11D2-BBCA-00C04F8EC294}'] + function GetProperty(propid: HxRegPlugInPropId): OleVariant; dispid 74752; + end; + {$EXTERNALSYM IHxRegPluginDisp} + +// *********************************************************************// +// Interface: IHxRegPlugInList +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {3141120B-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegPlugInList = interface(IDispatch) + ['{3141120B-A502-11D2-BBCA-00C04F8EC294}'] + function Item(index: OleVariant): IHxRegPlugIn; safecall; + function ItemAt(index: Integer): IHxRegPlugIn; safecall; + function EnumRegPlugIn(filter: Integer; options: Integer): IEnumHxRegPlugIn; safecall; + function Get__NewEnum: IUnknown; safecall; + function Get_Count: Integer; safecall; + property _NewEnum: IUnknown read Get__NewEnum; + property Count: Integer read Get_Count; + end; + +// *********************************************************************// +// DispIntf: IHxRegPlugInListDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {3141120B-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegPlugInListDisp = dispinterface + ['{3141120B-A502-11D2-BBCA-00C04F8EC294}'] + function Item(index: OleVariant): IHxRegPlugIn; dispid 0; + function ItemAt(index: Integer): IHxRegPlugIn; dispid 75008; + function EnumRegPlugIn(filter: Integer; options: Integer): IEnumHxRegPlugIn; dispid 75009; + property _NewEnum: IUnknown readonly dispid -4; + property Count: Integer readonly dispid 75010; + end; + {$EXTERNALSYM IHxRegPluginListDisp} + +// *********************************************************************// +// Interface: IEnumHxRegPlugIn +// Flags: (16) Hidden +// GUID: {3141120C-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IEnumHxRegPlugIn = interface(IUnknown) + ['{3141120C-A502-11D2-BBCA-00C04F8EC294}'] + function Next(celt: LongWord; out ppIHxRegPlugIn: IHxRegPlugIn; out pceltFetched: LongWord): HResult; stdcall; + function Reset: HResult; stdcall; + function Skip(celt: LongWord): HResult; stdcall; + function Clone(out ppEnum: IEnumHxRegPlugIn): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: IHxRegisterSession +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {31411218-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegisterSession = interface(IDispatch) + ['{31411218-A502-11D2-BBCA-00C04F8EC294}'] + function CreateTransaction(const bstrInToken: WideString): WideString; safecall; + function PostponeTransaction: WideString; safecall; + procedure ContinueTransaction(const bstrToken: WideString); safecall; + procedure CommitTransaction; safecall; + procedure RevertTransaction; safecall; + function GetRegistrationObject(type_: HxRegisterSession_InterfaceType): IDispatch; safecall; + end; + +// *********************************************************************// +// DispIntf: IHxRegisterSessionDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {31411218-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegisterSessionDisp = dispinterface + ['{31411218-A502-11D2-BBCA-00C04F8EC294}'] + function CreateTransaction(const bstrInToken: WideString): WideString; dispid 75265; + function PostponeTransaction: WideString; dispid 75268; + procedure ContinueTransaction(const bstrToken: WideString); dispid 75269; + procedure CommitTransaction; dispid 75266; + procedure RevertTransaction; dispid 75267; + function GetRegistrationObject(type_: HxRegisterSession_InterfaceType): IDispatch; dispid 75270; + end; + {$EXTERNALSYM IHxRegisterSessionDisp} + +// *********************************************************************// +// Interface: IHxPlugIn +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {314111DA-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxPlugIn = interface(IDispatch) + ['{314111DA-A502-11D2-BBCA-00C04F8EC294}'] + procedure RegisterHelpPlugIn(const bstrProductNamespace: WideString; + const bstrProductHxt: WideString; const bstrNamespace: WideString; + const bstrHxt: WideString; const bstrHxa: WideString; + options: Integer); safecall; + procedure RemoveHelpPlugIn(const bstrProductNamespace: WideString; + const bstrProductHxt: WideString; const bstrNamespace: WideString; + const bstrHxt: WideString; const bstrHxa: WideString); safecall; + end; + +// *********************************************************************// +// DispIntf: IHxPlugInDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {314111DA-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxPlugInDisp = dispinterface + ['{314111DA-A502-11D2-BBCA-00C04F8EC294}'] + procedure RegisterHelpPlugIn(const bstrProductNamespace: WideString; + const bstrProductHxt: WideString; const bstrNamespace: WideString; + const bstrHxt: WideString; const bstrHxa: WideString; + options: Integer); dispid 66304; + procedure RemoveHelpPlugIn(const bstrProductNamespace: WideString; + const bstrProductHxt: WideString; const bstrNamespace: WideString; + const bstrHxt: WideString; const bstrHxa: WideString); dispid 66305; + end; + {$EXTERNALSYM IHxPlugInDisp} + +// *********************************************************************// +// Interface: IHxInitialize +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111AE-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxInitialize = interface(IDispatch) + ['{314111AE-A502-11D2-BBCA-00C04F8EC294}'] + procedure Initialize(const InitString: WideString; options: Integer); safecall; + function Get_filter: WideString; safecall; + procedure Set_filter(const pFilterMoniker: WideString); safecall; + property filter: WideString read Get_filter write Set_filter; + end; + +// *********************************************************************// +// DispIntf: IHxInitializeDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {314111AE-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxInitializeDisp = dispinterface + ['{314111AE-A502-11D2-BBCA-00C04F8EC294}'] + procedure Initialize(const InitString: WideString; options: Integer); dispid 72192; + property filter: WideString dispid 72193; + end; + {$EXTERNALSYM IHxInitializeDisp} + +// *********************************************************************// +// Interface: IHxCancel +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {31411225-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxCancel = interface(IDispatch) + ['{31411225-A502-11D2-BBCA-00C04F8EC294}'] + function Get_Cancel: HxCancelStatus; safecall; + procedure Set_Cancel(pbCancel: HxCancelStatus); safecall; + property Cancel: HxCancelStatus read Get_Cancel write Set_Cancel; + end; + +// *********************************************************************// +// DispIntf: IHxCancelDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {31411225-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxCancelDisp = dispinterface + ['{31411225-A502-11D2-BBCA-00C04F8EC294}'] + property Cancel: HxCancelStatus dispid 76032; + end; + {$EXTERNALSYM IHxCancelDisp} + +// *********************************************************************// +// DispIntf: IHxSessionEvents +// Flags: (4096) Dispatchable +// GUID: {314111ED-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxSessionEvents = dispinterface + ['{314111ED-A502-11D2-BBCA-00C04F8EC294}'] + procedure QueryCancel(const pSession: IDispatch; const pCancel: IDispatch; status: Integer); dispid 65800; + procedure IndexMergeStatus(const pSession: IDispatch; const pCancel: IDispatch; status: Integer); dispid 65801; + procedure PrintMergeStatus(const pSession: IDispatch; const pCancel: IDispatch; status: Integer); dispid 65802; + procedure MergeIndexFileName(const pDisp: IDispatch; const bstrFile: WideString); dispid 65804; + end; + {$EXTERNALSYM IHxSessionEvents} + +// *********************************************************************// +// DispIntf: IHxRegisterSessionEvents +// Flags: (4096) Dispatchable +// GUID: {31411223-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegisterSessionEvents = dispinterface + ['{31411223-A502-11D2-BBCA-00C04F8EC294}'] + procedure FiltersChanged(const pDisp: IDispatch; var pvar: OleVariant); dispid 75271; + end; + {$EXTERNALSYM IHxRegisterSessionEvents} + +// *********************************************************************// +// Interface: IHxRegisterProtocol +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {31411227-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegisterProtocol = interface(IDispatch) + ['{31411227-A502-11D2-BBCA-00C04F8EC294}'] + procedure Register; safecall; + procedure Unregister; safecall; + end; + +// *********************************************************************// +// DispIntf: IHxRegisterProtocolDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {31411227-A502-11D2-BBCA-00C04F8EC294} +// *********************************************************************// + IHxRegisterProtocolDisp = dispinterface + ['{31411227-A502-11D2-BBCA-00C04F8EC294}'] + procedure Register; dispid 1610743808; + procedure Unregister; dispid 1610743809; + end; + {$EXTERNALSYM IHxRegisterProtocolDisp} + +// *********************************************************************// +// The Class CoHxSession provides a Create and CreateRemote method to +// create instances of the default interface IHxSession exposed by +// the CoClass HxSession. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoHxSession = class + class function Create: IHxSession; + class function CreateRemote(const MachineName: string): IHxSession; + end; + +// *********************************************************************// +// The Class CoHxRegistryWalker provides a Create and CreateRemote method to +// create instances of the default interface IHxRegistryWalker exposed by +// the CoClass HxRegistryWalker. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoHxRegistryWalker = class + class function Create: IHxRegistryWalker; + class function CreateRemote(const MachineName: string): IHxRegistryWalker; + end; + +// *********************************************************************// +// The Class CoHxRegisterSession provides a Create and CreateRemote method to +// create instances of the default interface IHxRegisterSession exposed by +// the CoClass HxRegisterSession. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoHxRegisterSession = class + class function Create: IHxRegisterSession; + class function CreateRemote(const MachineName: string): IHxRegisterSession; + end; + +// *********************************************************************// +// The Class CoHxRegisterProtocol provides a Create and CreateRemote method to +// create instances of the default interface IHxRegisterProtocol exposed by +// the CoClass HxRegisterProtocol. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoHxRegisterProtocol = class + class function Create: IHxRegisterProtocol; + class function CreateRemote(const MachineName: string): IHxRegisterProtocol; + end; + +//DOM-IGNORE-END + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.Win.ComObj; + {$ELSE ~HAS_UNITSCOPE} + ComObj; + {$ENDIF ~HAS_UNITSCOPE} + +class function CoHxSession.Create: IHxSession; +begin + Result := CreateComObject(CLASS_HxSession) as IHxSession; +end; + +class function CoHxSession.CreateRemote(const MachineName: string): IHxSession; +begin + Result := CreateRemoteComObject(MachineName, CLASS_HxSession) as IHxSession; +end; + +class function CoHxRegistryWalker.Create: IHxRegistryWalker; +begin + Result := CreateComObject(CLASS_HxRegistryWalker) as IHxRegistryWalker; +end; + +class function CoHxRegistryWalker.CreateRemote(const MachineName: string): IHxRegistryWalker; +begin + Result := CreateRemoteComObject(MachineName, CLASS_HxRegistryWalker) as IHxRegistryWalker; +end; + +class function CoHxRegisterSession.Create: IHxRegisterSession; +begin + Result := CreateComObject(CLASS_HxRegisterSession) as IHxRegisterSession; +end; + +class function CoHxRegisterSession.CreateRemote(const MachineName: string): IHxRegisterSession; +begin + Result := CreateRemoteComObject(MachineName, CLASS_HxRegisterSession) as IHxRegisterSession; +end; + +class function CoHxRegisterProtocol.Create: IHxRegisterProtocol; +begin + Result := CreateComObject(CLASS_HxRegisterProtocol) as IHxRegisterProtocol; +end; + +class function CoHxRegisterProtocol.CreateRemote(const MachineName: string): IHxRegisterProtocol; +begin + Result := CreateRemoteComObject(MachineName, CLASS_HxRegisterProtocol) as IHxRegisterProtocol; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/MSTask.pas b/3rdParty/JCL/source/windows/MSTask.pas new file mode 100644 index 00000000..f6cfd39d --- /dev/null +++ b/3rdParty/JCL/source/windows/MSTask.pas @@ -0,0 +1,699 @@ +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +(***************************************************************************** + This IDL-file has been converted by "the fIDLer". + [written by -=Assarbad=- Sept-2004] under MPL + Visit the fIDLer homepage at: http://assarbad.net/en/stuff/ + {The 3 above lines should be retained} + + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + NOTE: + + There's no guarantee for correct case of parameter or variable types. + If you have a type like BLA_YADDA in IDL then fIDLer will have converted it + to 'TBlaYadda' already. But if the type identifier was BLAYADDA and both + BLA and YADDA being distinct words the result will not be correctly + capitalized! + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + The original file was 'MSTask.Idl' + File converted: 2004-10-08@18:38:57 + + Cosmetics and review by: + 2004-10-08 - Oliver Schneider + Changes: + 2004-11-15 - Scott Price + *****************************************************************************) + +unit MSTask; + +{$I jcl.inc} +{$I windowsonly.inc} + +{$IFDEF SUPPORTS_WEAKPACKAGEUNIT} + {$IFDEF UNITVERSIONING} + {$WEAKPACKAGEUNIT OFF} + {$ELSE ~UNITVERSIONING} + {$WEAKPACKAGEUNIT ON} + {$ENDIF ~UNITVERSIONING} +{$ENDIF SUPPORTS_WEAKPACKAGEUNIT} + +{$ALIGN ON} +{$MINENUMSIZE 4} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.ActiveX, Winapi.Windows; + {$ELSE ~HAS_UNITSCOPE} + ActiveX, Windows; + {$ENDIF ~HAS_UNITSCOPE} + +//DOM-IGNORE-BEGIN + +(*$HPPEMIT '#include ' *) + +//+---------------------------------------------------------------------------- +// +// Task Scheduler +// +// Microsoft Windows +// Copyright (C) Microsoft Corporation, 1992 - 1999. +// +// File: mstask.idl +// +// Contents: ITaskTrigger, ITask, ITaskScheduler, IEnumWorkItems +// interfaces and related definitions +// +// History: 06-Sep-95 EricB created +// +//----------------------------------------------------------------------------- + + +// import "oaidl.idl"; + +// import "oleidl.idl"; + +// 148BD520-A2AB-11CE-B11F-00AA00530503 - Task object class ID +// 148BD52A-A2AB-11CE-B11F-00AA00530503 - Task Scheduler class ID +// A6B952F0-A4B1-11D0-997D-00AA006887EC - IScheduledWorkItem interface ID +// 148BD524-A2AB-11CE-B11F-00AA00530503 - ITask interface ID +// 148BD527-A2AB-11CE-B11F-00AA00530503 - ITaskScheduler interface ID +// 148BD528-A2AB-11CE-B11F-00AA00530503 - IEnumWorkItems interface ID +// 148BD52B-A2AB-11CE-B11F-00AA00530503 - ITaskTrigger interface ID + +//+---------------------------------------------------------------------------- +// +// Datatypes +// +//----------------------------------------------------------------------------- + +const +{$EXTERNALSYM TASK_SUNDAY} + TASK_SUNDAY = $1; +const +{$EXTERNALSYM TASK_MONDAY} + TASK_MONDAY = $2; +const +{$EXTERNALSYM TASK_TUESDAY} + TASK_TUESDAY = $4; +const +{$EXTERNALSYM TASK_WEDNESDAY} + TASK_WEDNESDAY = $8; +const +{$EXTERNALSYM TASK_THURSDAY} + TASK_THURSDAY = $10; +const +{$EXTERNALSYM TASK_FRIDAY} + TASK_FRIDAY = $20; +const +{$EXTERNALSYM TASK_SATURDAY} + TASK_SATURDAY = $40; +const +{$EXTERNALSYM TASK_FIRST_WEEK} + TASK_FIRST_WEEK = 1; +const +{$EXTERNALSYM TASK_SECOND_WEEK} + TASK_SECOND_WEEK = 2; +const +{$EXTERNALSYM TASK_THIRD_WEEK} + TASK_THIRD_WEEK = 3; +const +{$EXTERNALSYM TASK_FOURTH_WEEK} + TASK_FOURTH_WEEK = 4; +const +{$EXTERNALSYM TASK_LAST_WEEK} + TASK_LAST_WEEK = 5; +const +{$EXTERNALSYM TASK_JANUARY} + TASK_JANUARY = $1; +const +{$EXTERNALSYM TASK_FEBRUARY} + TASK_FEBRUARY = $2; +const +{$EXTERNALSYM TASK_MARCH} + TASK_MARCH = $4; +const +{$EXTERNALSYM TASK_APRIL} + TASK_APRIL = $8; +const +{$EXTERNALSYM TASK_MAY} + TASK_MAY = $10; +const +{$EXTERNALSYM TASK_JUNE} + TASK_JUNE = $20; +const +{$EXTERNALSYM TASK_JULY} + TASK_JULY = $40; +const +{$EXTERNALSYM TASK_AUGUST} + TASK_AUGUST = $80; +const +{$EXTERNALSYM TASK_SEPTEMBER} + TASK_SEPTEMBER = $100; +const +{$EXTERNALSYM TASK_OCTOBER} + TASK_OCTOBER = $200; +const +{$EXTERNALSYM TASK_NOVEMBER} + TASK_NOVEMBER = $400; +const +{$EXTERNALSYM TASK_DECEMBER} + TASK_DECEMBER = $800; + +const +{$EXTERNALSYM TASK_FLAG_INTERACTIVE} + TASK_FLAG_INTERACTIVE = $1; +const +{$EXTERNALSYM TASK_FLAG_DELETE_WHEN_DONE} + TASK_FLAG_DELETE_WHEN_DONE = $2; +const +{$EXTERNALSYM TASK_FLAG_DISABLED} + TASK_FLAG_DISABLED = $4; +const +{$EXTERNALSYM TASK_FLAG_START_ONLY_IF_IDLE} + TASK_FLAG_START_ONLY_IF_IDLE = $10; +const +{$EXTERNALSYM TASK_FLAG_KILL_ON_IDLE_END} + TASK_FLAG_KILL_ON_IDLE_END = $20; +const +{$EXTERNALSYM TASK_FLAG_DONT_START_IF_ON_BATTERIES} + TASK_FLAG_DONT_START_IF_ON_BATTERIES = $40; +const +{$EXTERNALSYM TASK_FLAG_KILL_IF_GOING_ON_BATTERIES} + TASK_FLAG_KILL_IF_GOING_ON_BATTERIES = $80; +const +{$EXTERNALSYM TASK_FLAG_RUN_ONLY_IF_DOCKED} + TASK_FLAG_RUN_ONLY_IF_DOCKED = $100; +const +{$EXTERNALSYM TASK_FLAG_HIDDEN} + TASK_FLAG_HIDDEN = $200; +const +{$EXTERNALSYM TASK_FLAG_RUN_IF_CONNECTED_TO_INTERNET} + TASK_FLAG_RUN_IF_CONNECTED_TO_INTERNET = $400; +const +{$EXTERNALSYM TASK_FLAG_RESTART_ON_IDLE_RESUME} + TASK_FLAG_RESTART_ON_IDLE_RESUME = $800; +const +{$EXTERNALSYM TASK_FLAG_SYSTEM_REQUIRED} + TASK_FLAG_SYSTEM_REQUIRED = $1000; +const +{$EXTERNALSYM TASK_FLAG_RUN_ONLY_IF_LOGGED_ON} + TASK_FLAG_RUN_ONLY_IF_LOGGED_ON = $2000; + +const +{$EXTERNALSYM TASK_TRIGGER_FLAG_HAS_END_DATE} + TASK_TRIGGER_FLAG_HAS_END_DATE = $1; +const +{$EXTERNALSYM TASK_TRIGGER_FLAG_KILL_AT_DURATION_END} + TASK_TRIGGER_FLAG_KILL_AT_DURATION_END = $2; +const +{$EXTERNALSYM TASK_TRIGGER_FLAG_DISABLED} + TASK_TRIGGER_FLAG_DISABLED = $4; + +// +// 1440 = 60 mins/hour * 24 hrs/day since a trigger/TASK could run all day at +// one minute intervals. +// + +const +{$EXTERNALSYM TASK_MAX_RUN_TIMES} + TASK_MAX_RUN_TIMES: Integer = 1440; + +// +// The TASK_TRIGGER_TYPE field of the TASK_TRIGGER structure determines +// which member of the TRIGGER_TYPE_UNION field to use. +// +type +{$EXTERNALSYM _TASK_TRIGGER_TYPE} + _TASK_TRIGGER_TYPE = ( +{$EXTERNALSYM TASK_TIME_TRIGGER_ONCE} + TASK_TIME_TRIGGER_ONCE, // 0 // Ignore the Type field. +{$EXTERNALSYM TASK_TIME_TRIGGER_DAILY} + TASK_TIME_TRIGGER_DAILY, // 1 // Use DAILY +{$EXTERNALSYM TASK_TIME_TRIGGER_WEEKLY} + TASK_TIME_TRIGGER_WEEKLY, // 2 // Use WEEKLY +{$EXTERNALSYM TASK_TIME_TRIGGER_MONTHLYDATE} + TASK_TIME_TRIGGER_MONTHLYDATE, // 3 // Use MONTHLYDATE +{$EXTERNALSYM TASK_TIME_TRIGGER_MONTHLYDOW} + TASK_TIME_TRIGGER_MONTHLYDOW, // 4 // Use MONTHLYDOW +{$EXTERNALSYM TASK_EVENT_TRIGGER_ON_IDLE} + TASK_EVENT_TRIGGER_ON_IDLE, // 5 // Ignore the Type field. +{$EXTERNALSYM TASK_EVENT_TRIGGER_AT_SYSTEMSTART} + TASK_EVENT_TRIGGER_AT_SYSTEMSTART, // 6 // Ignore the Type field. +{$EXTERNALSYM TASK_EVENT_TRIGGER_AT_LOGON} + TASK_EVENT_TRIGGER_AT_LOGON // 7 // Ignore the Type field. + ); +{$EXTERNALSYM TASK_TRIGGER_TYPE} + TASK_TRIGGER_TYPE = _TASK_TRIGGER_TYPE; + TTaskTriggerType = _TASK_TRIGGER_TYPE; + +{$EXTERNALSYM PTASK_TRIGGER_TYPE} + PTASK_TRIGGER_TYPE = ^_TASK_TRIGGER_TYPE; + PTaskTriggerType = ^_TASK_TRIGGER_TYPE; + + +type +{$EXTERNALSYM _DAILY} + _DAILY = packed record + DaysInterval: WORD; + end; +{$EXTERNALSYM DAILY} + DAILY = _DAILY; + TDaily = _DAILY; + + +type +{$EXTERNALSYM _WEEKLY} + _WEEKLY = packed record + WeeksInterval: WORD; + rgfDaysOfTheWeek: WORD; + end; +{$EXTERNALSYM WEEKLY} + WEEKLY = _WEEKLY; + TWeekly = _WEEKLY; + + +type +{$EXTERNALSYM _MONTHLYDATE} + _MONTHLYDATE = packed record + rgfDays: DWORD; + rgfMonths: WORD; + end; +{$EXTERNALSYM MONTHLYDATE} + MONTHLYDATE = _MONTHLYDATE; + TMonthlyDate = _MONTHLYDATE; // OS: Changed capitalization + + +type +{$EXTERNALSYM _MONTHLYDOW} + _MONTHLYDOW = packed record + wWhichWeek: WORD; + rgfDaysOfTheWeek: WORD; + rgfMonths: WORD; + end; +{$EXTERNALSYM MONTHLYDOW} + MONTHLYDOW = _MONTHLYDOW; + TMonthlyDOW = _MONTHLYDOW; // OS: Changed capitalization + + +type +{$EXTERNALSYM _TRIGGER_TYPE_UNION} + _TRIGGER_TYPE_UNION = packed record + case Integer of + 0: (Daily: DAILY); + 1: (Weekly: WEEKLY); + 2: (MonthlyDate: MONTHLYDATE); + 3: (MonthlyDOW: MONTHLYDOW); + end; +{$EXTERNALSYM TRIGGER_TYPE_UNION} + TRIGGER_TYPE_UNION = _TRIGGER_TYPE_UNION; + TTriggerTypeUnion = _TRIGGER_TYPE_UNION; + + +type +{$EXTERNALSYM _TASK_TRIGGER} + _TASK_TRIGGER = record // SP: removed packed record statement as seemed to affect SetTrigger + cbTriggerSize: WORD; // Structure size. + Reserved1: WORD; // Reserved. Must be zero. + wBeginYear: WORD; // Trigger beginning date year. + wBeginMonth: WORD; // Trigger beginning date month. + wBeginDay: WORD; // Trigger beginning date day. + wEndYear: WORD; // Optional trigger ending date year. + wEndMonth: WORD; // Optional trigger ending date month. + wEndDay: WORD; // Optional trigger ending date day. + wStartHour: WORD; // Run bracket start time hour. + wStartMinute: WORD; // Run bracket start time minute. + MinutesDuration: DWORD; // Duration of run bracket. + MinutesInterval: DWORD; // Run bracket repetition interval. + rgFlags: DWORD; // Trigger flags. + TriggerType: TASK_TRIGGER_TYPE; // Trigger type. + Type_: TRIGGER_TYPE_UNION; // Trigger data. + Reserved2: WORD; // Reserved. Must be zero. + wRandomMinutesInterval: WORD; // Maximum number of random minutes + // after start time. + + end; +{$EXTERNALSYM TASK_TRIGGER} + + TASK_TRIGGER = _TASK_TRIGGER; + TTaskTrigger = _TASK_TRIGGER; + +{$EXTERNALSYM PTASK_TRIGGER} + PTASK_TRIGGER = ^_TASK_TRIGGER; + PTaskTrigger = ^_TASK_TRIGGER; + + +//+---------------------------------------------------------------------------- +// +// Interfaces +// +//----------------------------------------------------------------------------- + +//+---------------------------------------------------------------------------- +// +// Interface: ITaskTrigger +// +// Synopsis: Trigger object interface. A Task object may contain several +// of these. +// +//----------------------------------------------------------------------------- +// {148BD52B-A2AB-11CE-B11F-00AA00530503} +const +{$EXTERNALSYM IID_ITaskTrigger} + IID_ITaskTrigger: TIID = (D1: $148BD52B; D2: $A2AB; D3: $11CE; D4: ($B1, $1F, $00, $AA, $00, $53, $05, $03)); + + +// interface ITaskTrigger; +type +{$EXTERNALSYM ITaskTrigger} + ITaskTrigger = interface(IUnknown) + ['{148BD52B-A2AB-11CE-B11F-00AA00530503}'] +// Methods: + function SetTrigger(const pTrigger: TTaskTrigger): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} const PTASK_TRIGGER pTrigger |*) + function GetTrigger(out pTrigger: TTaskTrigger): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {out} PTASK_TRIGGER pTrigger |*) + function GetTriggerString(out ppwszTrigger: LPWSTR): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {out} LPWSTR * ppwszTrigger |*) + end; + +//+---------------------------------------------------------------------------- +// +// Interface: IScheduledWorkItem +// +// Synopsis: Abstract base class for any runnable work item that can be +// scheduled by the task scheduler. +// +//----------------------------------------------------------------------------- +// {a6b952f0-a4b1-11d0-997d-00aa006887ec} +const +{$EXTERNALSYM IID_IScheduledWorkItem} + IID_IScheduledWorkItem: TIID = (D1: $A6B952F0; D2: $A4B1; D3: $11D0; D4: ($99, $7D, $00, $AA, $00, $68, $87, $EC)); + + +// interface IScheduledWorkItem; +type +{$EXTERNALSYM IScheduledWorkItem} + IScheduledWorkItem = interface(IUnknown) + ['{A6B952F0-A4B1-11D0-997D-00AA006887EC}'] +// Methods concerning scheduling: + function CreateTrigger(out piNewTrigger: WORD; out ppTrigger: ITaskTrigger): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {out} WORD * piNewTrigger, {out} ITaskTrigger ** ppTrigger |*) + function DeleteTrigger(iTrigger: WORD): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} WORD iTrigger |*) + function GetTriggerCount(out pwCount: WORD): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {out} WORD * pwCount |*) + function GetTrigger(iTrigger: WORD; out ppTrigger: ITaskTrigger): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} WORD iTrigger, {out} ITaskTrigger ** ppTrigger |*) + function GetTriggerString(iTrigger: WORD; out ppwszTrigger: LPWSTR): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} WORD iTrigger, {out} LPWSTR * ppwszTrigger |*) + function GetRunTimes(pstBegin: PSystemTime; pstEnd: PSystemTime; var pCount: WORD; out rgstTaskTimes: PSystemTime): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} const LPSYSTEMTIME pstBegin, {in} const LPSYSTEMTIME pstEnd, {in; out} WORD * pCount, {out} LPSYSTEMTIME * rgstTaskTimes |*) + function GetNextRunTime(var pstNextRun: SYSTEMTIME): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in; out} SYSTEMTIME * pstNextRun |*) + function SetIdleWait(wIdleMinutes: WORD; wDeadlineMinutes: WORD): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} WORD wIdleMinutes, {in} WORD wDeadlineMinutes |*) + function GetIdleWait(out pwIdleMinutes: WORD; out pwDeadlineMinutes: WORD): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {out} WORD * pwIdleMinutes, {out} WORD * pwDeadlineMinutes |*) +// Other methods: + function Run(): HRESULT; stdcall; + function Terminate(): HRESULT; stdcall; + function EditWorkItem(hParent: HWND; dwReserved: DWORD): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} HWND hParent, {in} DWORD dwReserved |*) + function GetMostRecentRunTime(out pstLastRun: SYSTEMTIME): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {out} SYSTEMTIME * pstLastRun |*) + function GetStatus(out phrStatus: HRESULT): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {out} HRESULT * phrStatus |*) + function GetExitCode(out pdwExitCode: DWORD): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {out} DWORD * pdwExitCode |*) +// Properties: + function SetComment(pwszComment: LPCWSTR): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} LPCWSTR pwszComment |*) + function GetComment(out ppwszComment: LPWSTR): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {out} LPWSTR * ppwszComment |*) + function SetCreator(pwszCreator: LPCWSTR): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} LPCWSTR pwszCreator |*) + function GetCreator(out ppwszCreator: LPWSTR): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {out} LPWSTR * ppwszCreator |*) + function SetWorkItemData(cbData: WORD; rgbData: PByte): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} WORD cbData, {in} BYTE rgbData[] |*) + function GetWorkItemData(out pcbData: WORD; out prgbData: PByte): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {out} WORD * pcbData, {out} BYTE ** prgbData |*) + function SetErrorRetryCount(wRetryCount: WORD): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} WORD wRetryCount |*) + function GetErrorRetryCount(out pwRetryCount: WORD): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {out} WORD * pwRetryCount |*) + function SetErrorRetryInterval(wRetryInterval: WORD): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} WORD wRetryInterval |*) + function GetErrorRetryInterval(out pwRetryInterval: WORD): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {out} WORD * pwRetryInterval |*) + function SetFlags(dwFlags: DWORD): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} DWORD dwFlags |*) + function GetFlags(out pdwFlags: DWORD): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {out} DWORD * pdwFlags |*) + function SetAccountInformation(pwszAccountName: LPCWSTR; pwszPassword: LPCWSTR): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} LPCWSTR pwszAccountName, {in} LPCWSTR pwszPassword |*) + function GetAccountInformation(out ppwszAccountName: LPWSTR): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {out} LPWSTR * ppwszAccountName |*) + end; + +//+---------------------------------------------------------------------------- +// +// Interface: ITask +// +// Synopsis: Task object interface. The primary means of task object +// manipulation. +// +//----------------------------------------------------------------------------- +// {148BD524-A2AB-11CE-B11F-00AA00530503} +const +{$EXTERNALSYM IID_ITask} + IID_ITask: TIID = (D1: $148BD524; D2: $A2AB; D3: $11CE; D4: ($B1, $1F, $00, $AA, $00, $53, $05, $03)); + + +// interface ITask; +type +{$EXTERNALSYM ITask} + ITask = interface(IScheduledWorkItem) + ['{148BD524-A2AB-11CE-B11F-00AA00530503}'] +// Properties that correspond to parameters of CreateProcess: + function SetApplicationName(pwszApplicationName: LPCWSTR): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} LPCWSTR pwszApplicationName |*) + function GetApplicationName(out ppwszApplicationName: LPWSTR): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {out} LPWSTR * ppwszApplicationName |*) + function SetParameters(pwszParameters: LPCWSTR): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} LPCWSTR pwszParameters |*) + function GetParameters(out ppwszParameters: LPWSTR): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {out} LPWSTR * ppwszParameters |*) + function SetWorkingDirectory(pwszWorkingDirectory: LPCWSTR): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} LPCWSTR pwszWorkingDirectory |*) + function GetWorkingDirectory(out ppwszWorkingDirectory: LPWSTR): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {out} LPWSTR * ppwszWorkingDirectory |*) + function SetPriority(dwPriority: DWORD): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} DWORD dwPriority |*) + function GetPriority(out pdwPriority: DWORD): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {out} DWORD * pdwPriority |*) +// Other properties: + function SetTaskFlags(dwFlags: DWORD): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} DWORD dwFlags |*) + function GetTaskFlags(out pdwFlags: DWORD): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {out} DWORD * pdwFlags |*) + function SetMaxRunTime(dwMaxRunTimeMS: DWORD): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} DWORD dwMaxRunTimeMS |*) + function GetMaxRunTime(out pdwMaxRunTimeMS: DWORD): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {out} DWORD * pdwMaxRunTimeMS |*) + end; + +//+---------------------------------------------------------------------------- +// +// Interface: IEnumWorkItems +// +// Synopsis: Work item object enumerator. Enumerates the work item objects +// within the Tasks folder. +// +//----------------------------------------------------------------------------- +// {148BD528-A2AB-11CE-B11F-00AA00530503} +const +{$EXTERNALSYM IID_IEnumWorkItems} + IID_IEnumWorkItems: TIID = (D1: $148BD528; D2: $A2AB; D3: $11CE; D4: ($B1, $1F, $00, $AA, $00, $53, $05, $03)); + + +// interface IEnumWorkItems; +type +{$EXTERNALSYM IEnumWorkItems} + IEnumWorkItems = interface(IUnknown) + ['{148BD528-A2AB-11CE-B11F-00AA00530503}'] +// Methods: + function Next(celt: ULONG; out rgpwszNames: PLPWSTR; out pceltFetched: ULONG): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} ULONG celt, {out} LPWSTR ** rgpwszNames, {out} ULONG * pceltFetched |*) + function Skip(celt: ULONG): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} ULONG celt |*) + function Reset(): HRESULT; stdcall; + function Clone(out ppEnumWorkItems: IEnumWorkItems): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {out} IEnumWorkItems ** ppEnumWorkItems |*) + end; + +//+---------------------------------------------------------------------------- +// +// Interface: ITaskScheduler +// +// Synopsis: Task Scheduler interface. Provides location transparent +// manipulation of task and/or queue objects within the Tasks +// folder. +// +//----------------------------------------------------------------------------- +// {148BD527-A2AB-11CE-B11F-00AA00530503} +const +{$EXTERNALSYM IID_ITaskScheduler} + IID_ITaskScheduler: TIID = (D1: $148BD527; D2: $A2AB; D3: $11CE; D4: ($B1, $1F, $00, $AA, $00, $53, $05, $03)); + + +// interface ITaskScheduler; +type +{$EXTERNALSYM ITaskScheduler} + ITaskScheduler = interface(IUnknown) + ['{148BD527-A2AB-11CE-B11F-00AA00530503}'] +// Methods: + function SetTargetComputer(pwszComputer: LPCWSTR): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} LPCWSTR pwszComputer |*) + function GetTargetComputer(out ppwszComputer: LPWSTR): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {out} LPWSTR * ppwszComputer |*) + function Enum(out ppEnumWorkItems: IEnumWorkItems): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {out} IEnumWorkItems ** ppEnumWorkItems |*) + function Activate(pwszName: LPCWSTR; const riid: TIID; out ppUnk: IUnknown): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} LPCWSTR pwszName, {in} REFIID riid, {out} IUnknown ** ppUnk |*) + function Delete(pwszName: LPCWSTR): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} LPCWSTR pwszName |*) + function NewWorkItem(pwszTaskName: LPCWSTR; const rclsid: TCLSID; const riid: TIID; out ppUnk: IUnknown): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} LPCWSTR pwszTaskName, {in} REFCLSID rclsid, {in} REFIID riid, {out} IUnknown ** ppUnk |*) + function AddWorkItem(pwszTaskName: LPCWSTR; const pWorkItem: IScheduledWorkItem): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} LPCWSTR pwszTaskName, {in} IScheduledWorkItem * pWorkItem |*) + function IsOfType(pwszName: LPCWSTR; const riid: TIID): HRESULT; stdcall; + (*| Parameter(s) was/were [CPP]: {in} LPCWSTR pwszName, {in} REFIID riid |*) + end; + +// EXTERN_C const CLSID CLSID_CTask; +// EXTERN_C const CLSID CLSID_CTaskScheduler; + +// {148BD520-A2AB-11CE-B11F-00AA00530503} +const +{$EXTERNALSYM CLSID_CTask} + CLSID_CTask: TCLSID = (D1: $148BD520; D2: $A2AB; D3: $11CE; D4: ($B1, $1F, $00, $AA, $00, $53, $05, $03)); + +// {148BD52A-A2AB-11CE-B11F-00AA00530503} +const +{$EXTERNALSYM CLSID_CTaskScheduler} + CLSID_CTaskScheduler: TCLSID = (D1: $148BD52A; D2: $A2AB; D3: $11CE; D4: ($B1, $1F, $00, $AA, $00, $53, $05, $03)); + + + +// +// NOTE: Definition of HPROPSHEETPAGE is from sdk\inc\prsht.h +// Including this header file causes numerous redefinition errors. +// + +type +{$EXTERNALSYM _PSP} + _PSP = record end; + +{$IFNDEF FPC} +type +{$EXTERNALSYM HPROPSHEETPAGE} + HPROPSHEETPAGE = ^_PSP; +{$ENDIF ~FPC} + +type +{$EXTERNALSYM _TASKPAGE} + _TASKPAGE = ( +{$EXTERNALSYM TASKPAGE_TASK} + TASKPAGE_TASK, // 0 +{$EXTERNALSYM TASKPAGE_SCHEDULE} + TASKPAGE_SCHEDULE, // 1 +{$EXTERNALSYM TASKPAGE_SETTINGS} + TASKPAGE_SETTINGS // 2 + ); +{$EXTERNALSYM TASKPAGE} + TASKPAGE = _TASKPAGE; + TTaskPage = _TASKPAGE; // OS: Changed capitalization + + +//+---------------------------------------------------------------------------- +// +// Interface: IProvideTaskPage +// +// Synopsis: Task property page retrieval interface. With this interface, +// it is possible to retrieve one or more property pages +// associated with a task object. Task objects inherit this +// interface. +// +//----------------------------------------------------------------------------- +// {4086658a-cbbb-11cf-b604-00c04fd8d565} +const +{$EXTERNALSYM IID_IProvideTaskPage} + IID_IProvideTaskPage: TIID = (D1: $4086658A; D2: $CBBB; D3: $11CF; D4: ($B6, $04, $00, $C0, $4F, $D8, $D5, $65)); + + +// interface IProvideTaskPage; +type +{$EXTERNALSYM IProvideTaskPage} + IProvideTaskPage = interface(IUnknown) + ['{4086658A-CBBB-11CF-B604-00C04FD8D565}'] +// Methods: + function GetPage(tpType: TTaskPage; fPersistChanges: BOOL; out phPage: HPROPSHEETPAGE): HRESULT; stdcall; // OS: Changed TASKPAGE to TTaskPage + (*| Parameter(s) was/were [CPP]: {in} TASKPAGE tpType, {in} BOOL fPersistChanges, {out} HPROPSHEETPAGE * phPage |*) + end; + + +type +{$EXTERNALSYM ISchedulingAgent} + ISchedulingAgent = ITaskScheduler; + +type +{$EXTERNALSYM IEnumTasks} + IEnumTasks = IEnumWorkItems; + +const +{$EXTERNALSYM IID_ISchedulingAgent} + IID_ISchedulingAgent: TIID = (D1: $148BD527; D2: $A2AB; D3: $11CE; D4: ($B1, $1F, $00, $AA, $00, $53, $05, $03)); + +const +{$EXTERNALSYM CLSID_CSchedulingAgent} + CLSID_CSchedulingAgent: TCLSID = (D1: $148BD52A; D2: $A2AB; D3: $11CE; D4: ($B1, $1F, $00, $AA, $00, $53, $05, $03)); + +//DOM-IGNORE-END + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. + diff --git a/3rdParty/JCL/source/windows/Snmp.pas b/3rdParty/JCL/source/windows/Snmp.pas index a6d529eb..309b5874 100644 --- a/3rdParty/JCL/source/windows/Snmp.pas +++ b/3rdParty/JCL/source/windows/Snmp.pas @@ -1,946 +1,946 @@ -{**************************************************************************************************} -{ } -{ Delphi Runtime Library } -{ SNMP functions interface unit } -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License") } -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is: snmp.h. } -{ The Initial Developer of the Original Code is Microsoft. Portions created by Microsoft are } -{ Copyright (C) 1992-1999 Microsoft Corporation. All Rights Reserved. } -{ } -{ The Original Pascal code is: Snmp.pas, released 2001-10-05. } -{ The Initial Developer of the Original Pascal code is Petr Vones } -{ (petrdott v att mujmail dott cz). Portions created by Petr Vones are Copyright (C) 2001 Petr } -{ Vones. All Rights Reserved. } -{ } -{ Obtained through: } -{ Joint Endeavour of Delphi Innovators (Project JEDI) } -{ } -{ You may retrieve the latest version of this file at the Project JEDI homepage, located at } -{ http://delphi-jedi.org } -{ } -{ Contributor(s): } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: $ } -{ Revision: $Rev:: $ } -{ Author: $Author:: $ } -{ } -{**************************************************************************************************} - -unit Snmp; - -interface - -{$I jcl.inc} -{$I windowsonly.inc} - -{$DEFINE SNMP_DYNAMIC_LINK} -{$DEFINE SNMP_DYNAMIC_LINK_EXPLICIT} -{$DEFINE SNMPSTRICT} - -{$ALIGN ON} -{$MINENUMSIZE 4} - -{$IFNDEF SNMP_DYNAMIC_LINK} -{$IFDEF SUPPORTS_WEAKPACKAGEUNIT} - {$WEAKPACKAGEUNIT ON} -{$ENDIF SUPPORTS_WEAKPACKAGEUNIT} -{$ENDIF ~SNMP_DYNAMIC_LINK} - -{$IFDEF UNICODE} -{$A4} // MANTIS 4931 - GetMacAddress crash in Delphi 2009. record alignment fix. -{$ENDIF} - -uses - {$IFDEF UNITVERSIONING} - JclUnitVersioning, - {$ENDIF UNITVERSIONING} - {$IFDEF HAS_UNITSCOPE} - Winapi.Windows, System.SysUtils; - {$ELSE ~HAS_UNITSCOPE} - Windows, SysUtils; - {$ENDIF ~HAS_UNITSCOPE} - -//DOM-IGNORE-BEGIN - -(*$HPPEMIT '#include '*) - -type - PAsnOctetString = ^TAsnOctetString; - TAsnOctetString = record - stream: PAnsiChar; - length: UINT; - dynamic_: Boolean; - end; - - PAsnObjectIdentifier = ^TAsnObjectIdentifier; - TAsnObjectIdentifier = record - idLength: UINT; - ids: PUINT; - end; - - TAsnInteger32 = LongInt; - {$EXTERNALSYM TAsnInteger32} - TAsnUnsigned32 = ULONG; - {$EXTERNALSYM TAsnUnsigned32} - TAsnCounter64 = ULARGE_INTEGER; - {$EXTERNALSYM TAsnCounter64} - TAsnCounter32 = TAsnUnsigned32; - {$EXTERNALSYM TAsnCounter32} - TAsnGauge32 = TAsnUnsigned32; - {$EXTERNALSYM TAsnGauge32} - TAsnTimeticks = TAsnUnsigned32; - {$EXTERNALSYM TAsnTimeticks} - TAsnBits = TAsnOctetString; - {$EXTERNALSYM TAsnBits} - TAsnSequence = TAsnOctetString; - {$EXTERNALSYM TAsnSequence} - TAsnImplicitSequence = TAsnOctetString; - {$EXTERNALSYM TAsnImplicitSequence} - TAsnIPAddress = TAsnOctetString; - {$EXTERNALSYM TAsnIPAddress} - TAsnNetworkAddress = TAsnOctetString; - {$EXTERNALSYM TAsnNetworkAddress} - TAsnDisplayString = TAsnOctetString; - {$EXTERNALSYM TAsnDisplayString} - TAsnOpaque = TAsnOctetString; - {$EXTERNALSYM TAsnOpaque} - - PAsnAny = ^TAsnAny; - TAsnAny = record - asnType: Byte; - case Integer of - 0: (number: TAsnInteger32); // ASN_INTEGER, ASN_INTEGER32 - 1: (unsigned32: TAsnUnsigned32); // ASN_UNSIGNED32 - 2: (counter64: TAsnCounter64); // ASN_COUNTER64 - 3: (string_: TAsnOctetString); // ASN_OCTETSTRING - 4: (bits: TAsnBits); // ASN_BITS - 5: (object_: TAsnObjectIdentifier); // ASN_OBJECTIDENTIFIER - 6: (sequence: TAsnSequence); // ASN_SEQUENCE - 7: (address: TAsnIPAddress); // ASN_IPADDRESS - 8: (counter: TAsnCounter32); // ASN_COUNTER32 - 9: (gauge: TAsnGauge32); // ASN_GAUGE32 - 10: (ticks: TAsnTimeticks); // ASN_TIMETICKS - 11: (arbitrary: TAsnOpaque); // ASN_OPAQUE - end; - - TAsnObjectName = TAsnObjectIdentifier; - TAsnObjectSyntax = TAsnAny; - - PSnmpVarBind = ^TSnmpVarBind; - TSnmpVarBind = record - name: TAsnObjectName; - value: TAsnObjectSyntax; - end; - - PSnmpVarBindList = ^TSnmpVarBindList; - TSnmpVarBindList = record - list: PSnmpVarBind; - len: UINT; - end; - -const - -{ ASN/BER Base Types } - - ASN_UNIVERSAL = $00; - {$EXTERNALSYM ASN_UNIVERSAL} - ASN_APPLICATION = $40; - {$EXTERNALSYM ASN_APPLICATION} - ASN_CONTEXT = $80; - {$EXTERNALSYM ASN_CONTEXT} - ASN_PRIVATE = $C0; - {$EXTERNALSYM ASN_PRIVATE} - - ASN_PRIMITIVE = $00; - {$EXTERNALSYM ASN_PRIMITIVE} - ASN_CONSTRUCTOR = $20; - {$EXTERNALSYM ASN_CONSTRUCTOR} - -{ PDU Type Values } - - SNMP_PDU_GET = (ASN_CONTEXT or ASN_CONSTRUCTOR or $0); - {$EXTERNALSYM SNMP_PDU_GET} - SNMP_PDU_GETNEXT = (ASN_CONTEXT or ASN_CONSTRUCTOR or $1); - {$EXTERNALSYM SNMP_PDU_GETNEXT} - SNMP_PDU_RESPONSE = (ASN_CONTEXT or ASN_CONSTRUCTOR or $2); - {$EXTERNALSYM SNMP_PDU_RESPONSE} - SNMP_PDU_SET = (ASN_CONTEXT or ASN_CONSTRUCTOR or $3); - {$EXTERNALSYM SNMP_PDU_SET} - SNMP_PDU_V1TRAP = (ASN_CONTEXT or ASN_CONSTRUCTOR or $4); - {$EXTERNALSYM SNMP_PDU_V1TRAP} - SNMP_PDU_GETBULK = (ASN_CONTEXT or ASN_CONSTRUCTOR or $5); - {$EXTERNALSYM SNMP_PDU_GETBULK} - SNMP_PDU_INFORM = (ASN_CONTEXT or ASN_CONSTRUCTOR or $6); - {$EXTERNALSYM SNMP_PDU_INFORM} - SNMP_PDU_TRAP = (ASN_CONTEXT or ASN_CONSTRUCTOR or $7); - {$EXTERNALSYM SNMP_PDU_TRAP} - -{ SNMP Simple Syntax Values } - - ASN_INTEGER = (ASN_UNIVERSAL or ASN_PRIMITIVE or $02); - {$EXTERNALSYM ASN_INTEGER} - ASN_BITS = (ASN_UNIVERSAL or ASN_PRIMITIVE or $03); - {$EXTERNALSYM ASN_BITS} - ASN_OCTETSTRING = (ASN_UNIVERSAL or ASN_PRIMITIVE or $04); - {$EXTERNALSYM ASN_OCTETSTRING} - ASN_NULL = (ASN_UNIVERSAL or ASN_PRIMITIVE or $05); - {$EXTERNALSYM ASN_NULL} - ASN_OBJECTIDENTIFIER = (ASN_UNIVERSAL or ASN_PRIMITIVE or $06); - {$EXTERNALSYM ASN_OBJECTIDENTIFIER} - ASN_INTEGER32 = ASN_INTEGER; - {$EXTERNALSYM ASN_INTEGER32} - -{ SNMP Constructor Syntax Values } - - ASN_SEQUENCE = (ASN_UNIVERSAL or ASN_CONSTRUCTOR or $10); - {$EXTERNALSYM ASN_SEQUENCE} - ASN_SEQUENCEOF = ASN_SEQUENCE; - {$EXTERNALSYM ASN_SEQUENCEOF} - -{ SNMP Application Syntax Values } - - ASN_IPADDRESS = (ASN_APPLICATION or ASN_PRIMITIVE or $00); - {$EXTERNALSYM ASN_IPADDRESS} - ASN_COUNTER32 = (ASN_APPLICATION or ASN_PRIMITIVE or $01); - {$EXTERNALSYM ASN_COUNTER32} - ASN_GAUGE32 = (ASN_APPLICATION or ASN_PRIMITIVE or $02); - {$EXTERNALSYM ASN_GAUGE32} - ASN_TIMETICKS = (ASN_APPLICATION or ASN_PRIMITIVE or $03); - {$EXTERNALSYM ASN_TIMETICKS} - ASN_OPAQUE = (ASN_APPLICATION or ASN_PRIMITIVE or $04); - {$EXTERNALSYM ASN_OPAQUE} - ASN_COUNTER64 = (ASN_APPLICATION or ASN_PRIMITIVE or $06); - {$EXTERNALSYM ASN_COUNTER64} - ASN_UNSIGNED32 = (ASN_APPLICATION or ASN_PRIMITIVE or $07); - {$EXTERNALSYM ASN_UNSIGNED32} - -{ SNMP Exception Conditions } - - SNMP_EXCEPTION_NOSUCHOBJECT = (ASN_CONTEXT or ASN_PRIMITIVE or $00); - {$EXTERNALSYM SNMP_EXCEPTION_NOSUCHOBJECT} - SNMP_EXCEPTION_NOSUCHINSTANCE = (ASN_CONTEXT or ASN_PRIMITIVE or $01); - {$EXTERNALSYM SNMP_EXCEPTION_NOSUCHINSTANCE} - SNMP_EXCEPTION_ENDOFMIBVIEW = (ASN_CONTEXT or ASN_PRIMITIVE or $02); - {$EXTERNALSYM SNMP_EXCEPTION_ENDOFMIBVIEW} - -{ SNMP Request Types (used in SnmpExtensionQueryEx) } - - SNMP_EXTENSION_GET = SNMP_PDU_GET; - {$EXTERNALSYM SNMP_EXTENSION_GET} - SNMP_EXTENSION_GET_NEXT = SNMP_PDU_GETNEXT; - {$EXTERNALSYM SNMP_EXTENSION_GET_NEXT} - SNMP_EXTENSION_GET_BULK = SNMP_PDU_GETBULK; - {$EXTERNALSYM SNMP_EXTENSION_GET_BULK} - SNMP_EXTENSION_SET_TEST = (ASN_PRIVATE or ASN_CONSTRUCTOR or $0); - {$EXTERNALSYM SNMP_EXTENSION_SET_TEST} - SNMP_EXTENSION_SET_COMMIT = SNMP_PDU_SET; - {$EXTERNALSYM SNMP_EXTENSION_SET_COMMIT} - SNMP_EXTENSION_SET_UNDO = (ASN_PRIVATE or ASN_CONSTRUCTOR or $1); - {$EXTERNALSYM SNMP_EXTENSION_SET_UNDO} - SNMP_EXTENSION_SET_CLEANUP = (ASN_PRIVATE or ASN_CONSTRUCTOR or $2); - {$EXTERNALSYM SNMP_EXTENSION_SET_CLEANUP} - -{ SNMP Error Codes } - - SNMP_ERRORSTATUS_NOERROR = 0; - {$EXTERNALSYM SNMP_ERRORSTATUS_NOERROR} - SNMP_ERRORSTATUS_TOOBIG = 1; - {$EXTERNALSYM SNMP_ERRORSTATUS_TOOBIG} - SNMP_ERRORSTATUS_NOSUCHNAME = 2; - {$EXTERNALSYM SNMP_ERRORSTATUS_NOSUCHNAME} - SNMP_ERRORSTATUS_BADVALUE = 3; - {$EXTERNALSYM SNMP_ERRORSTATUS_BADVALUE} - SNMP_ERRORSTATUS_READONLY = 4; - {$EXTERNALSYM SNMP_ERRORSTATUS_READONLY} - SNMP_ERRORSTATUS_GENERR = 5; - {$EXTERNALSYM SNMP_ERRORSTATUS_GENERR} - SNMP_ERRORSTATUS_NOACCESS = 6; - {$EXTERNALSYM SNMP_ERRORSTATUS_NOACCESS} - SNMP_ERRORSTATUS_WRONGTYPE = 7; - {$EXTERNALSYM SNMP_ERRORSTATUS_WRONGTYPE} - SNMP_ERRORSTATUS_WRONGLENGTH = 8; - {$EXTERNALSYM SNMP_ERRORSTATUS_WRONGLENGTH} - SNMP_ERRORSTATUS_WRONGENCODING = 9; - {$EXTERNALSYM SNMP_ERRORSTATUS_WRONGENCODING} - SNMP_ERRORSTATUS_WRONGVALUE = 10; - {$EXTERNALSYM SNMP_ERRORSTATUS_WRONGVALUE} - SNMP_ERRORSTATUS_NOCREATION = 11; - {$EXTERNALSYM SNMP_ERRORSTATUS_NOCREATION} - SNMP_ERRORSTATUS_INCONSISTENTVALUE = 12; - {$EXTERNALSYM SNMP_ERRORSTATUS_INCONSISTENTVALUE} - SNMP_ERRORSTATUS_RESOURCEUNAVAILABLE = 13; - {$EXTERNALSYM SNMP_ERRORSTATUS_RESOURCEUNAVAILABLE} - SNMP_ERRORSTATUS_COMMITFAILED = 14; - {$EXTERNALSYM SNMP_ERRORSTATUS_COMMITFAILED} - SNMP_ERRORSTATUS_UNDOFAILED = 15; - {$EXTERNALSYM SNMP_ERRORSTATUS_UNDOFAILED} - SNMP_ERRORSTATUS_AUTHORIZATIONERROR = 16; - {$EXTERNALSYM SNMP_ERRORSTATUS_AUTHORIZATIONERROR} - SNMP_ERRORSTATUS_NOTWRITABLE = 17; - {$EXTERNALSYM SNMP_ERRORSTATUS_NOTWRITABLE} - SNMP_ERRORSTATUS_INCONSISTENTNAME = 18; - {$EXTERNALSYM SNMP_ERRORSTATUS_INCONSISTENTNAME} - -{ SNMPv1 Trap Types } - - SNMP_GENERICTRAP_COLDSTART = 0; - {$EXTERNALSYM SNMP_GENERICTRAP_COLDSTART} - SNMP_GENERICTRAP_WARMSTART = 1; - {$EXTERNALSYM SNMP_GENERICTRAP_WARMSTART} - SNMP_GENERICTRAP_LINKDOWN = 2; - {$EXTERNALSYM SNMP_GENERICTRAP_LINKDOWN} - SNMP_GENERICTRAP_LINKUP = 3; - {$EXTERNALSYM SNMP_GENERICTRAP_LINKUP} - SNMP_GENERICTRAP_AUTHFAILURE = 4; - {$EXTERNALSYM SNMP_GENERICTRAP_AUTHFAILURE} - SNMP_GENERICTRAP_EGPNEIGHLOSS = 5; - {$EXTERNALSYM SNMP_GENERICTRAP_EGPNEIGHLOSS} - SNMP_GENERICTRAP_ENTERSPECIFIC = 6; - {$EXTERNALSYM SNMP_GENERICTRAP_ENTERSPECIFIC} - -{ SNMP Access Types } - - SNMP_ACCESS_NONE = 0; - {$EXTERNALSYM SNMP_ACCESS_NONE} - SNMP_ACCESS_NOTIFY = 1; - {$EXTERNALSYM SNMP_ACCESS_NOTIFY} - SNMP_ACCESS_READ_ONLY = 2; - {$EXTERNALSYM SNMP_ACCESS_READ_ONLY} - SNMP_ACCESS_READ_WRITE = 3; - {$EXTERNALSYM SNMP_ACCESS_READ_WRITE} - SNMP_ACCESS_READ_CREATE = 4; - {$EXTERNALSYM SNMP_ACCESS_READ_CREATE} - -{ SNMP API Return Code Definitions } - -type - SNMPAPI = Integer; - {$EXTERNALSYM SNMPAPI} -const - SNMPAPI_NOERROR = True; - {$EXTERNALSYM SNMPAPI_NOERROR} - SNMPAPI_ERROR = False; - {$EXTERNALSYM SNMPAPI_ERROR} - -{ SNMP Extension API Type Definitions } - -type - TSnmpExtensionInit = function (dwUptimeReference: DWORD; var phSubagentTrapEvent: THandle; - var pFirstSupportedRegion: PAsnObjectIdentifier): Boolean; stdcall; - - TSnmpExtensionInitEx = function (var pNextSupportedRegion: PAsnObjectIdentifier): Boolean; stdcall; - - TSnmpExtensionMonitor = function (pAgentMgmtData: Pointer): Boolean; stdcall; - - TSnmpExtensionQuery = function (bPduType: Byte; var pVarBindList: TSnmpVarBindList; - var pErrorStatus: TAsnInteger32; var pErrorIndex: TAsnInteger32): Boolean; stdcall; - - TSnmpExtensionQueryEx = function (nRequestType: UINT; nTransactionId: UINT; var pVarBindList: PSnmpVarBindList; - var pContextInfo: PAsnOctetString; var pErrorStatus: TAsnInteger32; var pErrorIndex: TAsnInteger32): Boolean; stdcall; - - TSnmpExtensionTrap = function (pEnterpriseOid: PAsnObjectIdentifier; var pGenericTrapId: TAsnInteger32; - var pSpecificTrapId: TAsnInteger32; var pTimeStamp: TAsnTimeticks; var pVarBindList: PSnmpVarBindList): Boolean; stdcall; - - TSnmpExtensionClose = procedure; stdcall; - -{ SNMP API Prototypes } - -{$IFDEF SNMP_DYNAMIC_LINK} - -var - SnmpUtilOidCpy: function(pOidDst: PAsnObjectIdentifier; pOidSrc: PAsnObjectIdentifier): SNMPAPI; stdcall; - SnmpUtilOidAppend: function(pOidDst: PAsnObjectIdentifier; pOidSrc: PAsnObjectIdentifier): SNMPAPI; stdcall; - SnmpUtilOidNCmp: function(pOid1, pOid2: PAsnObjectIdentifier; nSubIds: UINT): SNMPAPI; stdcall; - SnmpUtilOidCmp: function(pOid1, pOid2: PAsnObjectIdentifier): SNMPAPI; stdcall; - SnmpUtilOidFree: procedure(pOid: PAsnObjectIdentifier); stdcall; - SnmpUtilOctetsCmp: function(pOctets1, pOctets2: PAsnOctetString): SNMPAPI; stdcall; - SnmpUtilOctetsNCmp: function(pOctets1, pOctets2: PAsnOctetString; nChars: UINT): SNMPAPI; stdcall; - SnmpUtilOctetsCpy: function(pOctetsDst, pOctetsSrc: PAsnOctetString): SNMPAPI; stdcall; - SnmpUtilOctetsFree: procedure(pOctets: PAsnOctetString); stdcall; - SnmpUtilAsnAnyCpy: function(pAnyDst, pAnySrc: PAsnAny): SNMPAPI; stdcall; - SnmpUtilAsnAnyFree: procedure(pAny: PAsnAny); stdcall; - SnmpUtilVarBindCpy: function(pVbDst: PSnmpVarBind; pVbSrc: PSnmpVarBind): SNMPAPI; stdcall; - SnmpUtilVarBindFree: procedure(pVb: PSnmpVarBind); stdcall; - SnmpUtilVarBindListCpy: function(pVblDst: PSnmpVarBindList; pVblSrc: PSnmpVarBindList): SNMPAPI; stdcall; - SnmpUtilVarBindListFree: procedure(pVbl: PSnmpVarBindList); stdcall; - SnmpUtilMemFree: procedure(pMem: Pointer); stdcall; - SnmpUtilMemAlloc: function(nBytes: UINT): Pointer; stdcall; - SnmpUtilMemReAlloc: function(pMem: Pointer; nBytes: UINT): Pointer; stdcall; - SnmpUtilOidToA: function(Oid: PAsnObjectIdentifier): PAnsiChar; stdcall; - SnmpUtilIdsToA: function(Ids: PUINT; IdLength: UINT): PAnsiChar; stdcall; - SnmpUtilPrintOid: procedure(Oid: PAsnObjectIdentifier); stdcall; - SnmpUtilPrintAsnAny: procedure(pAny: PAsnAny); stdcall; - SnmpSvcGetUptime: function: DWORD; stdcall; - SnmpSvcSetLogLevel: procedure(nLogLevel: Integer); stdcall; - SnmpSvcSetLogType: procedure(nLogType: Integer); stdcall; - -{$ELSE ~SNMP_DYNAMIC_LINK} - -function SnmpUtilOidCpy(pOidDst: PAsnObjectIdentifier; pOidSrc: PAsnObjectIdentifier): SNMPAPI; stdcall; -function SnmpUtilOidAppend(pOidDst: PAsnObjectIdentifier; pOidSrc: PAsnObjectIdentifier): SNMPAPI; stdcall; -function SnmpUtilOidNCmp(pOid1, pOid2: PAsnObjectIdentifier; nSubIds: UINT): SNMPAPI; stdcall; -function SnmpUtilOidCmp(pOid1, pOid2: PAsnObjectIdentifier): SNMPAPI; stdcall; -procedure SnmpUtilOidFree(pOid: TAsnObjectIdentifier); stdcall; -function SnmpUtilOctetsCmp(pOctets1, pOctets2: PAsnOctetString): SNMPAPI; stdcall; -function SnmpUtilOctetsNCmp(pOctets1, pOctets2: PAsnOctetString; nChars: UINT): SNMPAPI; stdcall; -function SnmpUtilOctetsCpy(pOctetsDst, pOctetsSrc: PAsnOctetString): SNMPAPI; stdcall; -procedure SnmpUtilOctetsFree(pOctets: PAsnOctetString); stdcall; -function SnmpUtilAsnAnyCpy(pAnyDst, pAnySrc: PAsnAny): SNMPAPI; stdcall; -procedure SnmpUtilAsnAnyFree(pAny: PAsnAny); stdcall; -function SnmpUtilVarBindCpy(pVbDst: PSnmpVarBind; pVbSrc: PSnmpVarBind): SNMPAPI; stdcall; -procedure SnmpUtilVarBindFree(pVb: PSnmpVarBind); stdcall; -function SnmpUtilVarBindListCpy(pVblDst: PSnmpVarBindList; pVblSrc: PSnmpVarBindList): SNMPAPI; stdcall; -procedure SnmpUtilVarBindListFree(pVbl: PSnmpVarBindList); stdcall; -procedure SnmpUtilMemFree(pMem: Pointer); stdcall; -function SnmpUtilMemAlloc(nBytes: UINT): Pointer; stdcall; -function SnmpUtilMemReAlloc(pMem: Pointer; nBytes: UINT): Pointer; stdcall; -function SnmpUtilOidToA(Oid: PAsnObjectIdentifier): PAnsiChar; stdcall; -function SnmpUtilIdsToA(Ids: PUINT; IdLength: UINT): PAnsiChar; stdcall; -procedure SnmpUtilPrintOid(Oid: PAsnObjectIdentifier); stdcall; -procedure SnmpUtilPrintAsnAny(pAny: PAsnAny); stdcall; -function SnmpSvcGetUptime: DWORD; stdcall; -procedure SnmpSvcSetLogLevel(nLogLevel: Integer); stdcall; -procedure SnmpSvcSetLogType(nLogType: Integer); stdcall; - -{$ENDIF ~SNMP_DYNAMIC_LINK} - -{$EXTERNALSYM SnmpUtilOidCpy} -{$EXTERNALSYM SnmpUtilOidAppend} -{$EXTERNALSYM SnmpUtilOidNCmp} -{$EXTERNALSYM SnmpUtilOidCmp} -{$EXTERNALSYM SnmpUtilOidFree} -{$EXTERNALSYM SnmpUtilOctetsCmp} -{$EXTERNALSYM SnmpUtilOctetsNCmp} -{$EXTERNALSYM SnmpUtilOctetsCpy} -{$EXTERNALSYM SnmpUtilOctetsFree} -{$EXTERNALSYM SnmpUtilAsnAnyCpy} -{$EXTERNALSYM SnmpUtilAsnAnyFree} -{$EXTERNALSYM SnmpUtilVarBindCpy} -{$EXTERNALSYM SnmpUtilVarBindFree} -{$EXTERNALSYM SnmpUtilVarBindListCpy} -{$EXTERNALSYM SnmpUtilVarBindListFree} -{$EXTERNALSYM SnmpUtilMemFree} -{$EXTERNALSYM SnmpUtilMemAlloc} -{$EXTERNALSYM SnmpUtilMemReAlloc} -{$EXTERNALSYM SnmpUtilOidToA} -{$EXTERNALSYM SnmpUtilIdsToA} -{$EXTERNALSYM SnmpUtilPrintOid} -{$EXTERNALSYM SnmpUtilPrintAsnAny} -{$EXTERNALSYM SnmpSvcGetUptime} -{$EXTERNALSYM SnmpSvcSetLogLevel} -{$EXTERNALSYM SnmpSvcSetLogType} - -{ SNMP Debugging Definitions } - -const - SNMP_LOG_SILENT = $0; - {$EXTERNALSYM SNMP_LOG_SILENT} - SNMP_LOG_FATAL = $1; - {$EXTERNALSYM SNMP_LOG_FATAL} - SNMP_LOG_ERROR = $2; - {$EXTERNALSYM SNMP_LOG_ERROR} - SNMP_LOG_WARNING = $3; - {$EXTERNALSYM SNMP_LOG_WARNING} - SNMP_LOG_TRACE = $4; - {$EXTERNALSYM SNMP_LOG_TRACE} - SNMP_LOG_VERBOSE = $5; - {$EXTERNALSYM SNMP_LOG_VERBOSE} - - SNMP_OUTPUT_TO_CONSOLE = $1; - {$EXTERNALSYM SNMP_OUTPUT_TO_CONSOLE} - SNMP_OUTPUT_TO_LOGFILE = $2; - {$EXTERNALSYM SNMP_OUTPUT_TO_LOGFILE} - SNMP_OUTPUT_TO_EVENTLOG = $4; // no longer supported - {$EXTERNALSYM SNMP_OUTPUT_TO_EVENTLOG} - SNMP_OUTPUT_TO_DEBUGGER = $8; - {$EXTERNALSYM SNMP_OUTPUT_TO_DEBUGGER} - -{ SNMP Debugging Prototypes } - -{$IFNDEF SNMP_DYNAMIC_LINK} - -procedure SnmpUtilDbgPrint(nLogLevel: Integer; szFormat: PAnsiChar); stdcall; - -{$ELSE SNMP_DYNAMIC_LINK} - -var - SnmpUtilDbgPrint: procedure (nLogLevel: Integer; szFormat: PAnsiChar); stdcall; - -{$ENDIF ~SNMP_DYNAMIC_LINK} - -{$EXTERNALSYM SnmpUtilDbgPrint} - -{ Miscellaneous definitions } - -const - DEFINE_NULLOID: TAsnObjectIdentifier = (idLength: 0; ids: nil); - {$EXTERNALSYM DEFINE_NULLOID} - DEFINE_NULLOCTETS: TAsnOctetString = (stream: nil; length: 0; dynamic_: False); - {$EXTERNALSYM DEFINE_NULLOCTETS} - - DEFAULT_SNMP_PORT_UDP = 161; - {$EXTERNALSYM DEFAULT_SNMP_PORT_UDP} - DEFAULT_SNMP_PORT_IPX = 36879; - {$EXTERNALSYM DEFAULT_SNMP_PORT_IPX} - DEFAULT_SNMPTRAP_PORT_UDP = 162; - {$EXTERNALSYM DEFAULT_SNMPTRAP_PORT_UDP} - DEFAULT_SNMPTRAP_PORT_IPX = 36880; - {$EXTERNALSYM DEFAULT_SNMPTRAP_PORT_IPX} - SNMP_MAX_OID_LEN = 128; - {$EXTERNALSYM SNMP_MAX_OID_LEN} - -{ API Error Code Definitions } - - SNMP_MEM_ALLOC_ERROR = 1; - {$EXTERNALSYM SNMP_MEM_ALLOC_ERROR} - SNMP_BERAPI_INVALID_LENGTH = 10; - {$EXTERNALSYM SNMP_BERAPI_INVALID_LENGTH} - SNMP_BERAPI_INVALID_TAG = 11; - {$EXTERNALSYM SNMP_BERAPI_INVALID_TAG} - SNMP_BERAPI_OVERFLOW = 12; - {$EXTERNALSYM SNMP_BERAPI_OVERFLOW} - SNMP_BERAPI_SHORT_BUFFER = 13; - {$EXTERNALSYM SNMP_BERAPI_SHORT_BUFFER} - SNMP_BERAPI_INVALID_OBJELEM = 14; - {$EXTERNALSYM SNMP_BERAPI_INVALID_OBJELEM} - SNMP_PDUAPI_UNRECOGNIZED_PDU = 20; - {$EXTERNALSYM SNMP_PDUAPI_UNRECOGNIZED_PDU} - SNMP_PDUAPI_INVALID_ES = 21; - {$EXTERNALSYM SNMP_PDUAPI_INVALID_ES} - SNMP_PDUAPI_INVALID_GT = 22; - {$EXTERNALSYM SNMP_PDUAPI_INVALID_GT} - SNMP_AUTHAPI_INVALID_VERSION = 30; - {$EXTERNALSYM SNMP_AUTHAPI_INVALID_VERSION} - SNMP_AUTHAPI_INVALID_MSG_TYPE = 31; - {$EXTERNALSYM SNMP_AUTHAPI_INVALID_MSG_TYPE} - SNMP_AUTHAPI_TRIV_AUTH_FAILED = 32; - {$EXTERNALSYM SNMP_AUTHAPI_TRIV_AUTH_FAILED} - -{ Support for old definitions (support disabled via SNMPSTRICT) } - -{$IFNDEF SNMPSTRICT} - -{$IFNDEF SNMP_DYNAMIC_LINK} - -var - SNMP_oidcpy: function (pOidDst: PAsnObjectIdentifier; pOidSrc: PAsnObjectIdentifier): SNMPAPI; stdcall; - SNMP_oidappend: function (pOidDst: PAsnObjectIdentifier; pOidSrc: PAsnObjectIdentifier): SNMPAPI; stdcall; - SNMP_oidncmp: function (pOid1, pOid2: PAsnObjectIdentifier; nSubIds: UINT): SNMPAPI; stdcall; - SNMP_oidcmp: function (pOid1, pOid2: PAsnObjectIdentifier): SNMPAPI; stdcall; - SNMP_oidfree: procedure (pOid: TAsnObjectIdentifier); stdcall; - - SNMP_CopyVarBind: function (pVbDst: PSnmpVarBind; pVbSrc: PSnmpVarBind): SNMPAPI; stdcall; - SNMP_FreeVarBind: procedure (pVb: PSnmpVarBind); stdcall; - SNMP_CopyVarBindList: function (pVblDst: PSnmpVarBindList; pVblSrc: PSnmpVarBindList): SNMPAPI; stdcall; - SNMP_FreeVarBindList: procedure (pVbl: PSnmpVarBindList); stdcall; - - SNMP_printany: procedure (pAny: PAsnAny); stdcall; - - SNMP_free: procedure (pMem: Pointer); stdcall; - SNMP_malloc: function (nBytes: UINT): Pointer; stdcall; - SNMP_realloc: function (pMem: Pointer; nBytes: UINT): Pointer; stdcall; - - SNMP_DBG_free: procedure (pMem: Pointer); stdcall; - SNMP_DBG_malloc: function (nBytes: UINT): Pointer; stdcall; - SNMP_DBG_realloc: function (pMem: Pointer; nBytes: UINT): Pointer; stdcall; - -{$ELSE SNMP_DYNAMIC_LINK} - -function SNMP_oidcpy(pOidDst: PAsnObjectIdentifier; pOidSrc: PAsnObjectIdentifier): SNMPAPI; stdcall; -function SNMP_oidappend(pOidDst: PAsnObjectIdentifier; pOidSrc: PAsnObjectIdentifier): SNMPAPI; stdcall; -function SNMP_oidncmp(pOid1, pOid2: PAsnObjectIdentifier; nSubIds: UINT): SNMPAPI; stdcall; -function SNMP_oidcmp(pOid1, pOid2: PAsnObjectIdentifier): SNMPAPI; stdcall; -procedure SNMP_oidfree(pOid: TAsnObjectIdentifier); stdcall; - -function SNMP_CopyVarBind(pVbDst: PSnmpVarBind; pVbSrc: PSnmpVarBind): SNMPAPI; stdcall; -procedure SNMP_FreeVarBind(pVb: PSnmpVarBind); stdcall; -function SNMP_CopyVarBindList(pVblDst: PSnmpVarBindList; pVblSrc: PSnmpVarBindList): SNMPAPI; stdcall; -procedure SNMP_FreeVarBindList(pVbl: PSnmpVarBindList); stdcall; - -procedure SNMP_printany(pAny: PAsnAny); stdcall; - -procedure SNMP_free(pMem: Pointer); stdcall; -function SNMP_malloc(nBytes: UINT): Pointer; stdcall; -function SNMP_realloc(pMem: Pointer; nBytes: UINT): Pointer; stdcall; - -procedure SNMP_DBG_free(pMem: Pointer); stdcall; -function SNMP_DBG_malloc(nBytes: UINT): Pointer; stdcall; -function SNMP_DBG_realloc(pMem: Pointer; nBytes: UINT): Pointer; stdcall; - -{$ENDIF SNMP_DYNAMIC_LINK} - -{$EXTERNALSYM SNMP_oidcpy} -{$EXTERNALSYM SNMP_oidappend} -{$EXTERNALSYM SNMP_oidncmp} -{$EXTERNALSYM SNMP_oidcmp} -{$EXTERNALSYM SNMP_oidfree} - -{$EXTERNALSYM SNMP_CopyVarBind} -{$EXTERNALSYM SNMP_FreeVarBind} -{$EXTERNALSYM SNMP_CopyVarBindList} -{$EXTERNALSYM SNMP_FreeVarBindList} - -{$EXTERNALSYM SNMP_printany} - -{$EXTERNALSYM SNMP_free} -{$EXTERNALSYM SNMP_malloc} -{$EXTERNALSYM SNMP_realloc} - -{$EXTERNALSYM SNMP_DBG_free} -{$EXTERNALSYM SNMP_DBG_malloc} -{$EXTERNALSYM SNMP_DBG_realloc} - -const - ASN_RFC1155_IPADDRESS = ASN_IPADDRESS; - {$EXTERNALSYM ASN_RFC1155_IPADDRESS} - ASN_RFC1155_COUNTER = ASN_COUNTER32; - {$EXTERNALSYM ASN_RFC1155_COUNTER} - ASN_RFC1155_GAUGE = ASN_GAUGE32; - {$EXTERNALSYM ASN_RFC1155_GAUGE} - ASN_RFC1155_TIMETICKS = ASN_TIMETICKS; - {$EXTERNALSYM ASN_RFC1155_TIMETICKS} - ASN_RFC1155_OPAQUE = ASN_OPAQUE; - {$EXTERNALSYM ASN_RFC1155_OPAQUE} - ASN_RFC1213_DISPSTRING = ASN_OCTETSTRING; - {$EXTERNALSYM ASN_RFC1213_DISPSTRING} - - ASN_RFC1157_GETREQUEST = SNMP_PDU_GET; - {$EXTERNALSYM ASN_RFC1157_GETREQUEST} - ASN_RFC1157_GETNEXTREQUEST = SNMP_PDU_GETNEXT; - {$EXTERNALSYM ASN_RFC1157_GETNEXTREQUEST} - ASN_RFC1157_GETRESPONSE = SNMP_PDU_RESPONSE; - {$EXTERNALSYM ASN_RFC1157_GETRESPONSE} - ASN_RFC1157_SETREQUEST = SNMP_PDU_SET; - {$EXTERNALSYM ASN_RFC1157_SETREQUEST} - ASN_RFC1157_TRAP = SNMP_PDU_V1TRAP; - {$EXTERNALSYM ASN_RFC1157_TRAP} - - ASN_CONTEXTSPECIFIC = ASN_CONTEXT; - {$EXTERNALSYM ASN_CONTEXTSPECIFIC} - ASN_PRIMATIVE = ASN_PRIMITIVE; - {$EXTERNALSYM ASN_PRIMATIVE} - -type - RFC1157VarBindList = TSnmpVarBindList; - {$EXTERNALSYM RFC1157VarBindList} - RFC1157VarBind = TSnmpVarBind; - {$EXTERNALSYM RFC1157VarBind} - TAsnInteger = TAsnInteger32; - {$EXTERNALSYM TAsnInteger} - TAsnCounter = TAsnCounter32; - {$EXTERNALSYM TAsnCounter} - TAsnGauge = TAsnGauge32; - {$EXTERNALSYM TAsnGauge} - -{$ENDIF ~SNMPSTRICT} - -{ SNMP Extension API Prototypes } - -var - SnmpExtensionInit: TSnmpExtensionInit; - {$EXTERNALSYM SnmpExtensionInit} - SnmpExtensionInitEx: TSnmpExtensionInitEx; - {$EXTERNALSYM SnmpExtensionInitEx} - SnmpExtensionMonitor: TSnmpExtensionMonitor; - {$EXTERNALSYM SnmpExtensionMonitor} - SnmpExtensionQuery: TSnmpExtensionQuery; - {$EXTERNALSYM SnmpExtensionQuery} - SnmpExtensionQueryEx: TSnmpExtensionQueryEx; - {$EXTERNALSYM SnmpExtensionQueryEx} - SnmpExtensionTrap: TSnmpExtensionTrap; - {$EXTERNALSYM SnmpExtensionTrap} - SnmpExtensionClose: TSnmpExtensionClose; - {$EXTERNALSYM SnmpExtensionClose} - -//DOM-IGNORE-END - -function SnmpExtensionLoaded: Boolean; -function LoadSnmpExtension(const LibName: string): Boolean; -function UnloadSnmpExtension: Boolean; - -{$IFDEF SNMP_DYNAMIC_LINK} -function SnmpLoaded: Boolean; -{$IFDEF SNMP_DYNAMIC_LINK_EXPLICIT} -function LoadSnmp: Boolean; -function UnloadSnmp: Boolean; -{$ENDIF SNMP_DYNAMIC_LINK_EXPLICIT} -{$ENDIF SNMP_DYNAMIC_LINK} - -{$IFDEF UNITVERSIONING} -const - UnitVersioning: TUnitVersionInfo = ( - RCSfile: '$URL$'; - Revision: '$Revision$'; - Date: '$Date$'; - LogPath: 'JCL\source\windows'; - Extra: ''; - Data: nil - ); -{$ENDIF UNITVERSIONING} - -implementation - -const - snmpapilib = 'snmpapi.dll'; - -var - ExtensionLibHandle: THandle; - -function SnmpExtensionLoaded: Boolean; -begin - Result := ExtensionLibHandle <> 0; -end; - -function LoadSnmpExtension(const LibName: string): Boolean; -begin - Result := UnloadSnmpExtension; - if Result then - begin - ExtensionLibHandle := SafeLoadLibrary(LibName); - Result := SnmpExtensionLoaded; - if Result then - begin - @SnmpExtensionInit := GetProcAddress(ExtensionLibHandle, 'SnmpExtensionInit'); - @SnmpExtensionInitEx := GetProcAddress(ExtensionLibHandle, 'SnmpExtensionInitEx'); - @SnmpExtensionMonitor := GetProcAddress(ExtensionLibHandle, 'SnmpExtensionMonitor'); - @SnmpExtensionQuery := GetProcAddress(ExtensionLibHandle, 'SnmpExtensionQuery'); - @SnmpExtensionQueryEx := GetProcAddress(ExtensionLibHandle, 'SnmpExtensionQueryEx'); - @SnmpExtensionTrap := GetProcAddress(ExtensionLibHandle, 'SnmpExtensionTrap'); - @SnmpExtensionClose := GetProcAddress(ExtensionLibHandle, 'SnmpExtensionClose'); - Result := Assigned(SnmpExtensionInit); - if not Result then - UnloadSnmpExtension; - end; - end; -end; - -function UnloadSnmpExtension: Boolean; -begin - if SnmpExtensionLoaded then - begin - Result := FreeLibrary(ExtensionLibHandle); - ExtensionLibHandle := 0; - @SnmpExtensionInit := nil; - @SnmpExtensionInitEx := nil; - @SnmpExtensionMonitor := nil; - @SnmpExtensionQuery := nil; - @SnmpExtensionQueryEx := nil; - @SnmpExtensionTrap := nil; - @SnmpExtensionClose := nil; - end - else - Result := True; -end; - -{$IFDEF SNMP_DYNAMIC_LINK} - -var - SnmpLibHandle: THandle; - -function SnmpLoaded: Boolean; -begin - Result := SnmpLibHandle <> 0; -end; - -function UnloadSnmp: Boolean; -begin - Result := True; - if SnmpLoaded then - begin - Result := FreeLibrary(SnmpLibHandle); - SnmpLibHandle := 0; - @SnmpUtilOidCpy := nil; - @SnmpUtilOidAppend := nil; - @SnmpUtilOidNCmp := nil; - @SnmpUtilOidCmp := nil; - @SnmpUtilOidFree := nil; - @SnmpUtilOctetsCmp := nil; - @SnmpUtilOctetsNCmp := nil; - @SnmpUtilOctetsCpy := nil; - @SnmpUtilOctetsFree := nil; - @SnmpUtilAsnAnyCpy := nil; - @SnmpUtilAsnAnyFree := nil; - @SnmpUtilVarBindCpy := nil; - @SnmpUtilVarBindFree := nil; - @SnmpUtilVarBindListCpy := nil; - @SnmpUtilVarBindListFree := nil; - @SnmpUtilMemFree := nil; - @SnmpUtilMemAlloc := nil; - @SnmpUtilMemReAlloc := nil; - @SnmpUtilOidToA := nil; - @SnmpUtilIdsToA := nil; - @SnmpUtilPrintOid := nil; - @SnmpUtilPrintAsnAny := nil; - @SnmpSvcGetUptime := nil; - @SnmpSvcSetLogLevel := nil; - @SnmpSvcSetLogType := nil; - @SnmpUtilDbgPrint := nil; - {$IFNDEF SNMPSTRICT} - @SNMP_oidcpy := nil; - @SNMP_oidappend := nil; - @SNMP_oidncmp := nil; - @SNMP_oidcmp := nil; - @SNMP_oidfree := nil; - @SNMP_CopyVarBind := nil; - @SNMP_FreeVarBind := nil; - @SNMP_CopyVarBindList := nil; - @SNMP_FreeVarBindList := nil; - @SNMP_printany := nil; - @SNMP_free := nil; - @SNMP_malloc := nil; - @SNMP_realloc := nil; - @SNMP_DBG_free := nil; - @SNMP_DBG_malloc := nil; - @SNMP_DBG_realloc := nil; - {$ENDIF ~SNMPSTRICT} - end; -end; - -function LoadSnmp: Boolean; -begin - Result := SnmpLoaded; - if not Result then - begin - SnmpLibHandle := SafeLoadLibrary(snmpapilib); - if SnmpLoaded then - begin - @SnmpUtilOidCpy := GetProcAddress(SnmpLibHandle, 'SnmpUtilOidCpy'); - @SnmpUtilOidAppend := GetProcAddress(SnmpLibHandle, 'SnmpUtilOidAppend'); - @SnmpUtilOidNCmp := GetProcAddress(SnmpLibHandle, 'SnmpUtilOidNCmp'); - @SnmpUtilOidCmp := GetProcAddress(SnmpLibHandle, 'SnmpUtilOidCmp'); - @SnmpUtilOidFree := GetProcAddress(SnmpLibHandle, 'SnmpUtilOidFree'); - @SnmpUtilOctetsCmp := GetProcAddress(SnmpLibHandle, 'SnmpUtilOctetsCmp'); - @SnmpUtilOctetsNCmp := GetProcAddress(SnmpLibHandle, 'SnmpUtilOctetsNCmp'); - @SnmpUtilOctetsCpy := GetProcAddress(SnmpLibHandle, 'SnmpUtilOctetsCpy'); - @SnmpUtilOctetsFree := GetProcAddress(SnmpLibHandle, 'SnmpUtilOctetsFree'); - @SnmpUtilAsnAnyCpy := GetProcAddress(SnmpLibHandle, 'SnmpUtilAsnAnyCpy'); - @SnmpUtilAsnAnyFree := GetProcAddress(SnmpLibHandle, 'SnmpUtilAsnAnyFree'); - @SnmpUtilVarBindCpy := GetProcAddress(SnmpLibHandle, 'SnmpUtilVarBindCpy'); - @SnmpUtilVarBindFree := GetProcAddress(SnmpLibHandle, 'SnmpUtilVarBindFree'); - @SnmpUtilVarBindListCpy := GetProcAddress(SnmpLibHandle, 'SnmpUtilVarBindListCpy'); - @SnmpUtilVarBindListFree := GetProcAddress(SnmpLibHandle, 'SnmpUtilVarBindListFree'); - @SnmpUtilMemFree := GetProcAddress(SnmpLibHandle, 'SnmpUtilMemFree'); - @SnmpUtilMemAlloc := GetProcAddress(SnmpLibHandle, 'SnmpUtilMemAlloc'); - @SnmpUtilMemReAlloc := GetProcAddress(SnmpLibHandle, 'SnmpUtilMemReAlloc'); - @SnmpUtilOidToA := GetProcAddress(SnmpLibHandle, 'SnmpUtilOidToA'); - @SnmpUtilIdsToA := GetProcAddress(SnmpLibHandle, 'SnmpUtilIdsToA'); - @SnmpUtilPrintOid := GetProcAddress(SnmpLibHandle, 'SnmpUtilPrintOid'); - @SnmpUtilPrintAsnAny := GetProcAddress(SnmpLibHandle, 'SnmpUtilPrintAsnAny'); - @SnmpSvcGetUptime := GetProcAddress(SnmpLibHandle, 'SnmpSvcGetUptime'); - @SnmpSvcSetLogLevel := GetProcAddress(SnmpLibHandle, 'SnmpSvcSetLogLevel'); - @SnmpSvcSetLogType := GetProcAddress(SnmpLibHandle, 'SnmpSvcSetLogType'); - @SnmpUtilDbgPrint := GetProcAddress(SnmpLibHandle, 'SnmpUtilDbgPrint'); - {$IFNDEF SNMPSTRICT} - @SNMP_oidcpy := GetProcAddress(SnmpLibHandle, 'SnmpUtilOidCpy'); - @SNMP_oidappend := GetProcAddress(SnmpLibHandle, 'SnmpUtilOidAppend'); - @SNMP_oidncmp := GetProcAddress(SnmpLibHandle, 'SnmpUtilOidNCmp'); - @SNMP_oidcmp := GetProcAddress(SnmpLibHandle, 'SnmpUtilOidCmp'); - @SNMP_oidfree := GetProcAddress(SnmpLibHandle, 'SnmpUtilOidFree'); - @SNMP_CopyVarBind := GetProcAddress(SnmpLibHandle, 'SnmpUtilVarBindCpy'); - @SNMP_FreeVarBind := GetProcAddress(SnmpLibHandle, 'SnmpUtilVarBindFree'); - @SNMP_CopyVarBindList := GetProcAddress(SnmpLibHandle, 'SnmpUtilVarBindListCpy'); - @SNMP_FreeVarBindList := GetProcAddress(SnmpLibHandle, 'SnmpUtilVarBindListFree'); - @SNMP_printany := GetProcAddress(SnmpLibHandle, 'SnmpUtilPrintAsnAny'); - @SNMP_free := GetProcAddress(SnmpLibHandle, 'SnmpUtilMemFree'); - @SNMP_malloc := GetProcAddress(SnmpLibHandle, 'SnmpUtilMemAlloc'); - @SNMP_realloc := GetProcAddress(SnmpLibHandle, 'SnmpUtilMemReAlloc'); - @SNMP_DBG_free := GetProcAddress(SnmpLibHandle, 'SnmpUtilMemFree'); - @SNMP_DBG_malloc := GetProcAddress(SnmpLibHandle, 'SnmpUtilMemAlloc'); - @SNMP_DBG_realloc := GetProcAddress(SnmpLibHandle, 'SnmpUtilMemReAlloc'); - {$ENDIF ~SNMPSTRICT} - Result := True; - end; - end; -end; - -{$ELSE ~SNMP_DYNAMIC_LINK} - -function SnmpUtilOidCpy; external snmpapilib name 'SnmpUtilOidCpy'; -function SnmpUtilOidAppend; external snmpapilib name 'SnmpUtilOidAppend'; -function SnmpUtilOidNCmp; external snmpapilib name 'SnmpUtilOidNCmp'; -function SnmpUtilOidCmp; external snmpapilib name 'SnmpUtilOidCmp'; -procedure SnmpUtilOidFree; external snmpapilib name 'SnmpUtilOidFree'; -function SnmpUtilOctetsCmp; external snmpapilib name 'SnmpUtilOctetsCmp'; -function SnmpUtilOctetsNCmp; external snmpapilib name 'SnmpUtilOctetsNCmp'; -function SnmpUtilOctetsCpy; external snmpapilib name 'SnmpUtilOctetsCpy'; -procedure SnmpUtilOctetsFree; external snmpapilib name 'SnmpUtilOctetsFree'; -function SnmpUtilAsnAnyCpy; external snmpapilib name 'SnmpUtilAsnAnyCpy'; -procedure SnmpUtilAsnAnyFree; external snmpapilib name 'SnmpUtilAsnAnyFree'; -function SnmpUtilVarBindCpy; external snmpapilib name 'SnmpUtilVarBindCpy'; -procedure SnmpUtilVarBindFree; external snmpapilib name 'SnmpUtilVarBindFree'; -function SnmpUtilVarBindListCpy; external snmpapilib name 'SnmpUtilVarBindListCpy'; -procedure SnmpUtilVarBindListFree; external snmpapilib name 'SnmpUtilVarBindListFree'; -procedure SnmpUtilMemFree; external snmpapilib name 'SnmpUtilMemFree'; -function SnmpUtilMemAlloc; external snmpapilib name 'SnmpUtilMemAlloc'; -function SnmpUtilMemReAlloc; external snmpapilib name 'SnmpUtilMemReAlloc'; -function SnmpUtilOidToA; external snmpapilib name 'SnmpUtilOidToA'; -function SnmpUtilIdsToA; external snmpapilib name 'SnmpUtilIdsToA'; -procedure SnmpUtilPrintOid; external snmpapilib name 'SnmpUtilPrintOid'; -procedure SnmpUtilPrintAsnAny; external snmpapilib name 'SnmpUtilPrintAsnAny'; -function SnmpSvcGetUptime; external snmpapilib name 'SnmpSvcGetUptime'; -procedure SnmpSvcSetLogLevel; external snmpapilib name 'SnmpSvcSetLogLevel'; -procedure SnmpSvcSetLogType; external snmpapilib name 'SnmpSvcSetLogType'; -procedure SnmpUtilDbgPrint; external snmpapilib name 'SnmpUtilDbgPrint'; - -{$IFNDEF SNMPSTRICT} -function SNMP_oidcpy; external snmpapilib name 'SnmpUtilOidCpy'; -function SNMP_oidappend; external snmpapilib name 'SnmpUtilOidAppend'; -function SNMP_oidncmp; external snmpapilib name 'SnmpUtilOidNCmp'; -function SNMP_oidcmp; external snmpapilib name 'SnmpUtilOidCmp'; -procedure SNMP_oidfree; external snmpapilib name 'SnmpUtilOidFree'; -function SNMP_CopyVarBind; external snmpapilib name 'SnmpUtilVarBindCpy'; -procedure SNMP_FreeVarBind; external snmpapilib name 'SnmpUtilVarBindFree'; -function SNMP_CopyVarBindList; external snmpapilib name 'SnmpUtilVarBindListCpy'; -procedure SNMP_FreeVarBindList; external snmpapilib name 'SnmpUtilVarBindListFree'; -procedure SNMP_printany; external snmpapilib name 'SnmpUtilPrintAsnAny'; -procedure SNMP_free; external snmpapilib name 'SnmpUtilMemFree'; -function SNMP_malloc; external snmpapilib name 'SnmpUtilMemAlloc'; -function SNMP_realloc; external snmpapilib name 'SnmpUtilMemReAlloc'; -procedure SNMP_DBG_free; external snmpapilib name 'SnmpUtilMemFree'; -function SNMP_DBG_malloc; external snmpapilib name 'SnmpUtilMemAlloc'; -function SNMP_DBG_realloc; external snmpapilib name 'SnmpUtilMemReAlloc'; -{$ENDIF ~SNMPSTRICT} - -{$ENDIF ~SNMP_DYNAMIC_LINK} - -procedure InitializeSnmp; -begin - {$IFDEF SNMP_DYNAMIC_LINK} - {$IFNDEF SNMP_DYNAMIC_LINK_EXPLICIT} - LoadSnmp; - {$ENDIF ~SNMP_DYNAMIC_LINK_EXPLICIT} - {$ENDIF SNMP_DYNAMIC_LINK} -end; - -procedure FinalizeSnmp; -begin - {$IFDEF SNMP_DYNAMIC_LINK} - {$IFNDEF SNMP_DYNAMIC_LINK_EXPLICIT} - UnloadSnmp; - {$ENDIF ~SNMP_DYNAMIC_LINK_EXPLICIT} - {$ENDIF SNMP_DYNAMIC_LINK} -end; - -initialization - InitializeSnmp; - {$IFDEF UNITVERSIONING} - RegisterUnitVersion(HInstance, UnitVersioning); - {$ENDIF UNITVERSIONING} - -finalization - FinalizeSnmp; - {$IFDEF UNITVERSIONING} - UnregisterUnitVersion(HInstance); - {$ENDIF UNITVERSIONING} - -end. +{**************************************************************************************************} +{ } +{ Delphi Runtime Library } +{ SNMP functions interface unit } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License") } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is: snmp.h. } +{ The Initial Developer of the Original Code is Microsoft. Portions created by Microsoft are } +{ Copyright (C) 1992-1999 Microsoft Corporation. All Rights Reserved. } +{ } +{ The Original Pascal code is: Snmp.pas, released 2001-10-05. } +{ The Initial Developer of the Original Pascal code is Petr Vones } +{ (petrdott v att mujmail dott cz). Portions created by Petr Vones are Copyright (C) 2001 Petr } +{ Vones. All Rights Reserved. } +{ } +{ Obtained through: } +{ Joint Endeavour of Delphi Innovators (Project JEDI) } +{ } +{ You may retrieve the latest version of this file at the Project JEDI homepage, located at } +{ http://delphi-jedi.org } +{ } +{ Contributor(s): } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit Snmp; + +interface + +{$I jcl.inc} +{$I windowsonly.inc} + +{$DEFINE SNMP_DYNAMIC_LINK} +{$DEFINE SNMP_DYNAMIC_LINK_EXPLICIT} +{$DEFINE SNMPSTRICT} + +{$ALIGN ON} +{$MINENUMSIZE 4} + +{$IFNDEF SNMP_DYNAMIC_LINK} +{$IFDEF SUPPORTS_WEAKPACKAGEUNIT} + {$WEAKPACKAGEUNIT ON} +{$ENDIF SUPPORTS_WEAKPACKAGEUNIT} +{$ENDIF ~SNMP_DYNAMIC_LINK} + +{$IFDEF UNICODE} +{$A4} // MANTIS 4931 - GetMacAddress crash in Delphi 2009. record alignment fix. +{$ENDIF} + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.Windows, System.SysUtils; + {$ELSE ~HAS_UNITSCOPE} + Windows, SysUtils; + {$ENDIF ~HAS_UNITSCOPE} + +//DOM-IGNORE-BEGIN + +(*$HPPEMIT '#include '*) + +type + PAsnOctetString = ^TAsnOctetString; + TAsnOctetString = record + stream: PAnsiChar; + length: UINT; + dynamic_: Boolean; + end; + + PAsnObjectIdentifier = ^TAsnObjectIdentifier; + TAsnObjectIdentifier = record + idLength: UINT; + ids: PUINT; + end; + + TAsnInteger32 = LongInt; + {$EXTERNALSYM TAsnInteger32} + TAsnUnsigned32 = ULONG; + {$EXTERNALSYM TAsnUnsigned32} + TAsnCounter64 = ULARGE_INTEGER; + {$EXTERNALSYM TAsnCounter64} + TAsnCounter32 = TAsnUnsigned32; + {$EXTERNALSYM TAsnCounter32} + TAsnGauge32 = TAsnUnsigned32; + {$EXTERNALSYM TAsnGauge32} + TAsnTimeticks = TAsnUnsigned32; + {$EXTERNALSYM TAsnTimeticks} + TAsnBits = TAsnOctetString; + {$EXTERNALSYM TAsnBits} + TAsnSequence = TAsnOctetString; + {$EXTERNALSYM TAsnSequence} + TAsnImplicitSequence = TAsnOctetString; + {$EXTERNALSYM TAsnImplicitSequence} + TAsnIPAddress = TAsnOctetString; + {$EXTERNALSYM TAsnIPAddress} + TAsnNetworkAddress = TAsnOctetString; + {$EXTERNALSYM TAsnNetworkAddress} + TAsnDisplayString = TAsnOctetString; + {$EXTERNALSYM TAsnDisplayString} + TAsnOpaque = TAsnOctetString; + {$EXTERNALSYM TAsnOpaque} + + PAsnAny = ^TAsnAny; + TAsnAny = record + asnType: Byte; + case Integer of + 0: (number: TAsnInteger32); // ASN_INTEGER, ASN_INTEGER32 + 1: (unsigned32: TAsnUnsigned32); // ASN_UNSIGNED32 + 2: (counter64: TAsnCounter64); // ASN_COUNTER64 + 3: (string_: TAsnOctetString); // ASN_OCTETSTRING + 4: (bits: TAsnBits); // ASN_BITS + 5: (object_: TAsnObjectIdentifier); // ASN_OBJECTIDENTIFIER + 6: (sequence: TAsnSequence); // ASN_SEQUENCE + 7: (address: TAsnIPAddress); // ASN_IPADDRESS + 8: (counter: TAsnCounter32); // ASN_COUNTER32 + 9: (gauge: TAsnGauge32); // ASN_GAUGE32 + 10: (ticks: TAsnTimeticks); // ASN_TIMETICKS + 11: (arbitrary: TAsnOpaque); // ASN_OPAQUE + end; + + TAsnObjectName = TAsnObjectIdentifier; + TAsnObjectSyntax = TAsnAny; + + PSnmpVarBind = ^TSnmpVarBind; + TSnmpVarBind = record + name: TAsnObjectName; + value: TAsnObjectSyntax; + end; + + PSnmpVarBindList = ^TSnmpVarBindList; + TSnmpVarBindList = record + list: PSnmpVarBind; + len: UINT; + end; + +const + +{ ASN/BER Base Types } + + ASN_UNIVERSAL = $00; + {$EXTERNALSYM ASN_UNIVERSAL} + ASN_APPLICATION = $40; + {$EXTERNALSYM ASN_APPLICATION} + ASN_CONTEXT = $80; + {$EXTERNALSYM ASN_CONTEXT} + ASN_PRIVATE = $C0; + {$EXTERNALSYM ASN_PRIVATE} + + ASN_PRIMITIVE = $00; + {$EXTERNALSYM ASN_PRIMITIVE} + ASN_CONSTRUCTOR = $20; + {$EXTERNALSYM ASN_CONSTRUCTOR} + +{ PDU Type Values } + + SNMP_PDU_GET = (ASN_CONTEXT or ASN_CONSTRUCTOR or $0); + {$EXTERNALSYM SNMP_PDU_GET} + SNMP_PDU_GETNEXT = (ASN_CONTEXT or ASN_CONSTRUCTOR or $1); + {$EXTERNALSYM SNMP_PDU_GETNEXT} + SNMP_PDU_RESPONSE = (ASN_CONTEXT or ASN_CONSTRUCTOR or $2); + {$EXTERNALSYM SNMP_PDU_RESPONSE} + SNMP_PDU_SET = (ASN_CONTEXT or ASN_CONSTRUCTOR or $3); + {$EXTERNALSYM SNMP_PDU_SET} + SNMP_PDU_V1TRAP = (ASN_CONTEXT or ASN_CONSTRUCTOR or $4); + {$EXTERNALSYM SNMP_PDU_V1TRAP} + SNMP_PDU_GETBULK = (ASN_CONTEXT or ASN_CONSTRUCTOR or $5); + {$EXTERNALSYM SNMP_PDU_GETBULK} + SNMP_PDU_INFORM = (ASN_CONTEXT or ASN_CONSTRUCTOR or $6); + {$EXTERNALSYM SNMP_PDU_INFORM} + SNMP_PDU_TRAP = (ASN_CONTEXT or ASN_CONSTRUCTOR or $7); + {$EXTERNALSYM SNMP_PDU_TRAP} + +{ SNMP Simple Syntax Values } + + ASN_INTEGER = (ASN_UNIVERSAL or ASN_PRIMITIVE or $02); + {$EXTERNALSYM ASN_INTEGER} + ASN_BITS = (ASN_UNIVERSAL or ASN_PRIMITIVE or $03); + {$EXTERNALSYM ASN_BITS} + ASN_OCTETSTRING = (ASN_UNIVERSAL or ASN_PRIMITIVE or $04); + {$EXTERNALSYM ASN_OCTETSTRING} + ASN_NULL = (ASN_UNIVERSAL or ASN_PRIMITIVE or $05); + {$EXTERNALSYM ASN_NULL} + ASN_OBJECTIDENTIFIER = (ASN_UNIVERSAL or ASN_PRIMITIVE or $06); + {$EXTERNALSYM ASN_OBJECTIDENTIFIER} + ASN_INTEGER32 = ASN_INTEGER; + {$EXTERNALSYM ASN_INTEGER32} + +{ SNMP Constructor Syntax Values } + + ASN_SEQUENCE = (ASN_UNIVERSAL or ASN_CONSTRUCTOR or $10); + {$EXTERNALSYM ASN_SEQUENCE} + ASN_SEQUENCEOF = ASN_SEQUENCE; + {$EXTERNALSYM ASN_SEQUENCEOF} + +{ SNMP Application Syntax Values } + + ASN_IPADDRESS = (ASN_APPLICATION or ASN_PRIMITIVE or $00); + {$EXTERNALSYM ASN_IPADDRESS} + ASN_COUNTER32 = (ASN_APPLICATION or ASN_PRIMITIVE or $01); + {$EXTERNALSYM ASN_COUNTER32} + ASN_GAUGE32 = (ASN_APPLICATION or ASN_PRIMITIVE or $02); + {$EXTERNALSYM ASN_GAUGE32} + ASN_TIMETICKS = (ASN_APPLICATION or ASN_PRIMITIVE or $03); + {$EXTERNALSYM ASN_TIMETICKS} + ASN_OPAQUE = (ASN_APPLICATION or ASN_PRIMITIVE or $04); + {$EXTERNALSYM ASN_OPAQUE} + ASN_COUNTER64 = (ASN_APPLICATION or ASN_PRIMITIVE or $06); + {$EXTERNALSYM ASN_COUNTER64} + ASN_UNSIGNED32 = (ASN_APPLICATION or ASN_PRIMITIVE or $07); + {$EXTERNALSYM ASN_UNSIGNED32} + +{ SNMP Exception Conditions } + + SNMP_EXCEPTION_NOSUCHOBJECT = (ASN_CONTEXT or ASN_PRIMITIVE or $00); + {$EXTERNALSYM SNMP_EXCEPTION_NOSUCHOBJECT} + SNMP_EXCEPTION_NOSUCHINSTANCE = (ASN_CONTEXT or ASN_PRIMITIVE or $01); + {$EXTERNALSYM SNMP_EXCEPTION_NOSUCHINSTANCE} + SNMP_EXCEPTION_ENDOFMIBVIEW = (ASN_CONTEXT or ASN_PRIMITIVE or $02); + {$EXTERNALSYM SNMP_EXCEPTION_ENDOFMIBVIEW} + +{ SNMP Request Types (used in SnmpExtensionQueryEx) } + + SNMP_EXTENSION_GET = SNMP_PDU_GET; + {$EXTERNALSYM SNMP_EXTENSION_GET} + SNMP_EXTENSION_GET_NEXT = SNMP_PDU_GETNEXT; + {$EXTERNALSYM SNMP_EXTENSION_GET_NEXT} + SNMP_EXTENSION_GET_BULK = SNMP_PDU_GETBULK; + {$EXTERNALSYM SNMP_EXTENSION_GET_BULK} + SNMP_EXTENSION_SET_TEST = (ASN_PRIVATE or ASN_CONSTRUCTOR or $0); + {$EXTERNALSYM SNMP_EXTENSION_SET_TEST} + SNMP_EXTENSION_SET_COMMIT = SNMP_PDU_SET; + {$EXTERNALSYM SNMP_EXTENSION_SET_COMMIT} + SNMP_EXTENSION_SET_UNDO = (ASN_PRIVATE or ASN_CONSTRUCTOR or $1); + {$EXTERNALSYM SNMP_EXTENSION_SET_UNDO} + SNMP_EXTENSION_SET_CLEANUP = (ASN_PRIVATE or ASN_CONSTRUCTOR or $2); + {$EXTERNALSYM SNMP_EXTENSION_SET_CLEANUP} + +{ SNMP Error Codes } + + SNMP_ERRORSTATUS_NOERROR = 0; + {$EXTERNALSYM SNMP_ERRORSTATUS_NOERROR} + SNMP_ERRORSTATUS_TOOBIG = 1; + {$EXTERNALSYM SNMP_ERRORSTATUS_TOOBIG} + SNMP_ERRORSTATUS_NOSUCHNAME = 2; + {$EXTERNALSYM SNMP_ERRORSTATUS_NOSUCHNAME} + SNMP_ERRORSTATUS_BADVALUE = 3; + {$EXTERNALSYM SNMP_ERRORSTATUS_BADVALUE} + SNMP_ERRORSTATUS_READONLY = 4; + {$EXTERNALSYM SNMP_ERRORSTATUS_READONLY} + SNMP_ERRORSTATUS_GENERR = 5; + {$EXTERNALSYM SNMP_ERRORSTATUS_GENERR} + SNMP_ERRORSTATUS_NOACCESS = 6; + {$EXTERNALSYM SNMP_ERRORSTATUS_NOACCESS} + SNMP_ERRORSTATUS_WRONGTYPE = 7; + {$EXTERNALSYM SNMP_ERRORSTATUS_WRONGTYPE} + SNMP_ERRORSTATUS_WRONGLENGTH = 8; + {$EXTERNALSYM SNMP_ERRORSTATUS_WRONGLENGTH} + SNMP_ERRORSTATUS_WRONGENCODING = 9; + {$EXTERNALSYM SNMP_ERRORSTATUS_WRONGENCODING} + SNMP_ERRORSTATUS_WRONGVALUE = 10; + {$EXTERNALSYM SNMP_ERRORSTATUS_WRONGVALUE} + SNMP_ERRORSTATUS_NOCREATION = 11; + {$EXTERNALSYM SNMP_ERRORSTATUS_NOCREATION} + SNMP_ERRORSTATUS_INCONSISTENTVALUE = 12; + {$EXTERNALSYM SNMP_ERRORSTATUS_INCONSISTENTVALUE} + SNMP_ERRORSTATUS_RESOURCEUNAVAILABLE = 13; + {$EXTERNALSYM SNMP_ERRORSTATUS_RESOURCEUNAVAILABLE} + SNMP_ERRORSTATUS_COMMITFAILED = 14; + {$EXTERNALSYM SNMP_ERRORSTATUS_COMMITFAILED} + SNMP_ERRORSTATUS_UNDOFAILED = 15; + {$EXTERNALSYM SNMP_ERRORSTATUS_UNDOFAILED} + SNMP_ERRORSTATUS_AUTHORIZATIONERROR = 16; + {$EXTERNALSYM SNMP_ERRORSTATUS_AUTHORIZATIONERROR} + SNMP_ERRORSTATUS_NOTWRITABLE = 17; + {$EXTERNALSYM SNMP_ERRORSTATUS_NOTWRITABLE} + SNMP_ERRORSTATUS_INCONSISTENTNAME = 18; + {$EXTERNALSYM SNMP_ERRORSTATUS_INCONSISTENTNAME} + +{ SNMPv1 Trap Types } + + SNMP_GENERICTRAP_COLDSTART = 0; + {$EXTERNALSYM SNMP_GENERICTRAP_COLDSTART} + SNMP_GENERICTRAP_WARMSTART = 1; + {$EXTERNALSYM SNMP_GENERICTRAP_WARMSTART} + SNMP_GENERICTRAP_LINKDOWN = 2; + {$EXTERNALSYM SNMP_GENERICTRAP_LINKDOWN} + SNMP_GENERICTRAP_LINKUP = 3; + {$EXTERNALSYM SNMP_GENERICTRAP_LINKUP} + SNMP_GENERICTRAP_AUTHFAILURE = 4; + {$EXTERNALSYM SNMP_GENERICTRAP_AUTHFAILURE} + SNMP_GENERICTRAP_EGPNEIGHLOSS = 5; + {$EXTERNALSYM SNMP_GENERICTRAP_EGPNEIGHLOSS} + SNMP_GENERICTRAP_ENTERSPECIFIC = 6; + {$EXTERNALSYM SNMP_GENERICTRAP_ENTERSPECIFIC} + +{ SNMP Access Types } + + SNMP_ACCESS_NONE = 0; + {$EXTERNALSYM SNMP_ACCESS_NONE} + SNMP_ACCESS_NOTIFY = 1; + {$EXTERNALSYM SNMP_ACCESS_NOTIFY} + SNMP_ACCESS_READ_ONLY = 2; + {$EXTERNALSYM SNMP_ACCESS_READ_ONLY} + SNMP_ACCESS_READ_WRITE = 3; + {$EXTERNALSYM SNMP_ACCESS_READ_WRITE} + SNMP_ACCESS_READ_CREATE = 4; + {$EXTERNALSYM SNMP_ACCESS_READ_CREATE} + +{ SNMP API Return Code Definitions } + +type + SNMPAPI = Integer; + {$EXTERNALSYM SNMPAPI} +const + SNMPAPI_NOERROR = True; + {$EXTERNALSYM SNMPAPI_NOERROR} + SNMPAPI_ERROR = False; + {$EXTERNALSYM SNMPAPI_ERROR} + +{ SNMP Extension API Type Definitions } + +type + TSnmpExtensionInit = function (dwUptimeReference: DWORD; var phSubagentTrapEvent: THandle; + var pFirstSupportedRegion: PAsnObjectIdentifier): Boolean; stdcall; + + TSnmpExtensionInitEx = function (var pNextSupportedRegion: PAsnObjectIdentifier): Boolean; stdcall; + + TSnmpExtensionMonitor = function (pAgentMgmtData: Pointer): Boolean; stdcall; + + TSnmpExtensionQuery = function (bPduType: Byte; var pVarBindList: TSnmpVarBindList; + var pErrorStatus: TAsnInteger32; var pErrorIndex: TAsnInteger32): Boolean; stdcall; + + TSnmpExtensionQueryEx = function (nRequestType: UINT; nTransactionId: UINT; var pVarBindList: PSnmpVarBindList; + var pContextInfo: PAsnOctetString; var pErrorStatus: TAsnInteger32; var pErrorIndex: TAsnInteger32): Boolean; stdcall; + + TSnmpExtensionTrap = function (pEnterpriseOid: PAsnObjectIdentifier; var pGenericTrapId: TAsnInteger32; + var pSpecificTrapId: TAsnInteger32; var pTimeStamp: TAsnTimeticks; var pVarBindList: PSnmpVarBindList): Boolean; stdcall; + + TSnmpExtensionClose = procedure; stdcall; + +{ SNMP API Prototypes } + +{$IFDEF SNMP_DYNAMIC_LINK} + +var + SnmpUtilOidCpy: function(pOidDst: PAsnObjectIdentifier; pOidSrc: PAsnObjectIdentifier): SNMPAPI; stdcall; + SnmpUtilOidAppend: function(pOidDst: PAsnObjectIdentifier; pOidSrc: PAsnObjectIdentifier): SNMPAPI; stdcall; + SnmpUtilOidNCmp: function(pOid1, pOid2: PAsnObjectIdentifier; nSubIds: UINT): SNMPAPI; stdcall; + SnmpUtilOidCmp: function(pOid1, pOid2: PAsnObjectIdentifier): SNMPAPI; stdcall; + SnmpUtilOidFree: procedure(pOid: PAsnObjectIdentifier); stdcall; + SnmpUtilOctetsCmp: function(pOctets1, pOctets2: PAsnOctetString): SNMPAPI; stdcall; + SnmpUtilOctetsNCmp: function(pOctets1, pOctets2: PAsnOctetString; nChars: UINT): SNMPAPI; stdcall; + SnmpUtilOctetsCpy: function(pOctetsDst, pOctetsSrc: PAsnOctetString): SNMPAPI; stdcall; + SnmpUtilOctetsFree: procedure(pOctets: PAsnOctetString); stdcall; + SnmpUtilAsnAnyCpy: function(pAnyDst, pAnySrc: PAsnAny): SNMPAPI; stdcall; + SnmpUtilAsnAnyFree: procedure(pAny: PAsnAny); stdcall; + SnmpUtilVarBindCpy: function(pVbDst: PSnmpVarBind; pVbSrc: PSnmpVarBind): SNMPAPI; stdcall; + SnmpUtilVarBindFree: procedure(pVb: PSnmpVarBind); stdcall; + SnmpUtilVarBindListCpy: function(pVblDst: PSnmpVarBindList; pVblSrc: PSnmpVarBindList): SNMPAPI; stdcall; + SnmpUtilVarBindListFree: procedure(pVbl: PSnmpVarBindList); stdcall; + SnmpUtilMemFree: procedure(pMem: Pointer); stdcall; + SnmpUtilMemAlloc: function(nBytes: UINT): Pointer; stdcall; + SnmpUtilMemReAlloc: function(pMem: Pointer; nBytes: UINT): Pointer; stdcall; + SnmpUtilOidToA: function(Oid: PAsnObjectIdentifier): PAnsiChar; stdcall; + SnmpUtilIdsToA: function(Ids: PUINT; IdLength: UINT): PAnsiChar; stdcall; + SnmpUtilPrintOid: procedure(Oid: PAsnObjectIdentifier); stdcall; + SnmpUtilPrintAsnAny: procedure(pAny: PAsnAny); stdcall; + SnmpSvcGetUptime: function: DWORD; stdcall; + SnmpSvcSetLogLevel: procedure(nLogLevel: Integer); stdcall; + SnmpSvcSetLogType: procedure(nLogType: Integer); stdcall; + +{$ELSE ~SNMP_DYNAMIC_LINK} + +function SnmpUtilOidCpy(pOidDst: PAsnObjectIdentifier; pOidSrc: PAsnObjectIdentifier): SNMPAPI; stdcall; +function SnmpUtilOidAppend(pOidDst: PAsnObjectIdentifier; pOidSrc: PAsnObjectIdentifier): SNMPAPI; stdcall; +function SnmpUtilOidNCmp(pOid1, pOid2: PAsnObjectIdentifier; nSubIds: UINT): SNMPAPI; stdcall; +function SnmpUtilOidCmp(pOid1, pOid2: PAsnObjectIdentifier): SNMPAPI; stdcall; +procedure SnmpUtilOidFree(pOid: TAsnObjectIdentifier); stdcall; +function SnmpUtilOctetsCmp(pOctets1, pOctets2: PAsnOctetString): SNMPAPI; stdcall; +function SnmpUtilOctetsNCmp(pOctets1, pOctets2: PAsnOctetString; nChars: UINT): SNMPAPI; stdcall; +function SnmpUtilOctetsCpy(pOctetsDst, pOctetsSrc: PAsnOctetString): SNMPAPI; stdcall; +procedure SnmpUtilOctetsFree(pOctets: PAsnOctetString); stdcall; +function SnmpUtilAsnAnyCpy(pAnyDst, pAnySrc: PAsnAny): SNMPAPI; stdcall; +procedure SnmpUtilAsnAnyFree(pAny: PAsnAny); stdcall; +function SnmpUtilVarBindCpy(pVbDst: PSnmpVarBind; pVbSrc: PSnmpVarBind): SNMPAPI; stdcall; +procedure SnmpUtilVarBindFree(pVb: PSnmpVarBind); stdcall; +function SnmpUtilVarBindListCpy(pVblDst: PSnmpVarBindList; pVblSrc: PSnmpVarBindList): SNMPAPI; stdcall; +procedure SnmpUtilVarBindListFree(pVbl: PSnmpVarBindList); stdcall; +procedure SnmpUtilMemFree(pMem: Pointer); stdcall; +function SnmpUtilMemAlloc(nBytes: UINT): Pointer; stdcall; +function SnmpUtilMemReAlloc(pMem: Pointer; nBytes: UINT): Pointer; stdcall; +function SnmpUtilOidToA(Oid: PAsnObjectIdentifier): PAnsiChar; stdcall; +function SnmpUtilIdsToA(Ids: PUINT; IdLength: UINT): PAnsiChar; stdcall; +procedure SnmpUtilPrintOid(Oid: PAsnObjectIdentifier); stdcall; +procedure SnmpUtilPrintAsnAny(pAny: PAsnAny); stdcall; +function SnmpSvcGetUptime: DWORD; stdcall; +procedure SnmpSvcSetLogLevel(nLogLevel: Integer); stdcall; +procedure SnmpSvcSetLogType(nLogType: Integer); stdcall; + +{$ENDIF ~SNMP_DYNAMIC_LINK} + +{$EXTERNALSYM SnmpUtilOidCpy} +{$EXTERNALSYM SnmpUtilOidAppend} +{$EXTERNALSYM SnmpUtilOidNCmp} +{$EXTERNALSYM SnmpUtilOidCmp} +{$EXTERNALSYM SnmpUtilOidFree} +{$EXTERNALSYM SnmpUtilOctetsCmp} +{$EXTERNALSYM SnmpUtilOctetsNCmp} +{$EXTERNALSYM SnmpUtilOctetsCpy} +{$EXTERNALSYM SnmpUtilOctetsFree} +{$EXTERNALSYM SnmpUtilAsnAnyCpy} +{$EXTERNALSYM SnmpUtilAsnAnyFree} +{$EXTERNALSYM SnmpUtilVarBindCpy} +{$EXTERNALSYM SnmpUtilVarBindFree} +{$EXTERNALSYM SnmpUtilVarBindListCpy} +{$EXTERNALSYM SnmpUtilVarBindListFree} +{$EXTERNALSYM SnmpUtilMemFree} +{$EXTERNALSYM SnmpUtilMemAlloc} +{$EXTERNALSYM SnmpUtilMemReAlloc} +{$EXTERNALSYM SnmpUtilOidToA} +{$EXTERNALSYM SnmpUtilIdsToA} +{$EXTERNALSYM SnmpUtilPrintOid} +{$EXTERNALSYM SnmpUtilPrintAsnAny} +{$EXTERNALSYM SnmpSvcGetUptime} +{$EXTERNALSYM SnmpSvcSetLogLevel} +{$EXTERNALSYM SnmpSvcSetLogType} + +{ SNMP Debugging Definitions } + +const + SNMP_LOG_SILENT = $0; + {$EXTERNALSYM SNMP_LOG_SILENT} + SNMP_LOG_FATAL = $1; + {$EXTERNALSYM SNMP_LOG_FATAL} + SNMP_LOG_ERROR = $2; + {$EXTERNALSYM SNMP_LOG_ERROR} + SNMP_LOG_WARNING = $3; + {$EXTERNALSYM SNMP_LOG_WARNING} + SNMP_LOG_TRACE = $4; + {$EXTERNALSYM SNMP_LOG_TRACE} + SNMP_LOG_VERBOSE = $5; + {$EXTERNALSYM SNMP_LOG_VERBOSE} + + SNMP_OUTPUT_TO_CONSOLE = $1; + {$EXTERNALSYM SNMP_OUTPUT_TO_CONSOLE} + SNMP_OUTPUT_TO_LOGFILE = $2; + {$EXTERNALSYM SNMP_OUTPUT_TO_LOGFILE} + SNMP_OUTPUT_TO_EVENTLOG = $4; // no longer supported + {$EXTERNALSYM SNMP_OUTPUT_TO_EVENTLOG} + SNMP_OUTPUT_TO_DEBUGGER = $8; + {$EXTERNALSYM SNMP_OUTPUT_TO_DEBUGGER} + +{ SNMP Debugging Prototypes } + +{$IFNDEF SNMP_DYNAMIC_LINK} + +procedure SnmpUtilDbgPrint(nLogLevel: Integer; szFormat: PAnsiChar); stdcall; + +{$ELSE SNMP_DYNAMIC_LINK} + +var + SnmpUtilDbgPrint: procedure (nLogLevel: Integer; szFormat: PAnsiChar); stdcall; + +{$ENDIF ~SNMP_DYNAMIC_LINK} + +{$EXTERNALSYM SnmpUtilDbgPrint} + +{ Miscellaneous definitions } + +const + DEFINE_NULLOID: TAsnObjectIdentifier = (idLength: 0; ids: nil); + {$EXTERNALSYM DEFINE_NULLOID} + DEFINE_NULLOCTETS: TAsnOctetString = (stream: nil; length: 0; dynamic_: False); + {$EXTERNALSYM DEFINE_NULLOCTETS} + + DEFAULT_SNMP_PORT_UDP = 161; + {$EXTERNALSYM DEFAULT_SNMP_PORT_UDP} + DEFAULT_SNMP_PORT_IPX = 36879; + {$EXTERNALSYM DEFAULT_SNMP_PORT_IPX} + DEFAULT_SNMPTRAP_PORT_UDP = 162; + {$EXTERNALSYM DEFAULT_SNMPTRAP_PORT_UDP} + DEFAULT_SNMPTRAP_PORT_IPX = 36880; + {$EXTERNALSYM DEFAULT_SNMPTRAP_PORT_IPX} + SNMP_MAX_OID_LEN = 128; + {$EXTERNALSYM SNMP_MAX_OID_LEN} + +{ API Error Code Definitions } + + SNMP_MEM_ALLOC_ERROR = 1; + {$EXTERNALSYM SNMP_MEM_ALLOC_ERROR} + SNMP_BERAPI_INVALID_LENGTH = 10; + {$EXTERNALSYM SNMP_BERAPI_INVALID_LENGTH} + SNMP_BERAPI_INVALID_TAG = 11; + {$EXTERNALSYM SNMP_BERAPI_INVALID_TAG} + SNMP_BERAPI_OVERFLOW = 12; + {$EXTERNALSYM SNMP_BERAPI_OVERFLOW} + SNMP_BERAPI_SHORT_BUFFER = 13; + {$EXTERNALSYM SNMP_BERAPI_SHORT_BUFFER} + SNMP_BERAPI_INVALID_OBJELEM = 14; + {$EXTERNALSYM SNMP_BERAPI_INVALID_OBJELEM} + SNMP_PDUAPI_UNRECOGNIZED_PDU = 20; + {$EXTERNALSYM SNMP_PDUAPI_UNRECOGNIZED_PDU} + SNMP_PDUAPI_INVALID_ES = 21; + {$EXTERNALSYM SNMP_PDUAPI_INVALID_ES} + SNMP_PDUAPI_INVALID_GT = 22; + {$EXTERNALSYM SNMP_PDUAPI_INVALID_GT} + SNMP_AUTHAPI_INVALID_VERSION = 30; + {$EXTERNALSYM SNMP_AUTHAPI_INVALID_VERSION} + SNMP_AUTHAPI_INVALID_MSG_TYPE = 31; + {$EXTERNALSYM SNMP_AUTHAPI_INVALID_MSG_TYPE} + SNMP_AUTHAPI_TRIV_AUTH_FAILED = 32; + {$EXTERNALSYM SNMP_AUTHAPI_TRIV_AUTH_FAILED} + +{ Support for old definitions (support disabled via SNMPSTRICT) } + +{$IFNDEF SNMPSTRICT} + +{$IFNDEF SNMP_DYNAMIC_LINK} + +var + SNMP_oidcpy: function (pOidDst: PAsnObjectIdentifier; pOidSrc: PAsnObjectIdentifier): SNMPAPI; stdcall; + SNMP_oidappend: function (pOidDst: PAsnObjectIdentifier; pOidSrc: PAsnObjectIdentifier): SNMPAPI; stdcall; + SNMP_oidncmp: function (pOid1, pOid2: PAsnObjectIdentifier; nSubIds: UINT): SNMPAPI; stdcall; + SNMP_oidcmp: function (pOid1, pOid2: PAsnObjectIdentifier): SNMPAPI; stdcall; + SNMP_oidfree: procedure (pOid: TAsnObjectIdentifier); stdcall; + + SNMP_CopyVarBind: function (pVbDst: PSnmpVarBind; pVbSrc: PSnmpVarBind): SNMPAPI; stdcall; + SNMP_FreeVarBind: procedure (pVb: PSnmpVarBind); stdcall; + SNMP_CopyVarBindList: function (pVblDst: PSnmpVarBindList; pVblSrc: PSnmpVarBindList): SNMPAPI; stdcall; + SNMP_FreeVarBindList: procedure (pVbl: PSnmpVarBindList); stdcall; + + SNMP_printany: procedure (pAny: PAsnAny); stdcall; + + SNMP_free: procedure (pMem: Pointer); stdcall; + SNMP_malloc: function (nBytes: UINT): Pointer; stdcall; + SNMP_realloc: function (pMem: Pointer; nBytes: UINT): Pointer; stdcall; + + SNMP_DBG_free: procedure (pMem: Pointer); stdcall; + SNMP_DBG_malloc: function (nBytes: UINT): Pointer; stdcall; + SNMP_DBG_realloc: function (pMem: Pointer; nBytes: UINT): Pointer; stdcall; + +{$ELSE SNMP_DYNAMIC_LINK} + +function SNMP_oidcpy(pOidDst: PAsnObjectIdentifier; pOidSrc: PAsnObjectIdentifier): SNMPAPI; stdcall; +function SNMP_oidappend(pOidDst: PAsnObjectIdentifier; pOidSrc: PAsnObjectIdentifier): SNMPAPI; stdcall; +function SNMP_oidncmp(pOid1, pOid2: PAsnObjectIdentifier; nSubIds: UINT): SNMPAPI; stdcall; +function SNMP_oidcmp(pOid1, pOid2: PAsnObjectIdentifier): SNMPAPI; stdcall; +procedure SNMP_oidfree(pOid: TAsnObjectIdentifier); stdcall; + +function SNMP_CopyVarBind(pVbDst: PSnmpVarBind; pVbSrc: PSnmpVarBind): SNMPAPI; stdcall; +procedure SNMP_FreeVarBind(pVb: PSnmpVarBind); stdcall; +function SNMP_CopyVarBindList(pVblDst: PSnmpVarBindList; pVblSrc: PSnmpVarBindList): SNMPAPI; stdcall; +procedure SNMP_FreeVarBindList(pVbl: PSnmpVarBindList); stdcall; + +procedure SNMP_printany(pAny: PAsnAny); stdcall; + +procedure SNMP_free(pMem: Pointer); stdcall; +function SNMP_malloc(nBytes: UINT): Pointer; stdcall; +function SNMP_realloc(pMem: Pointer; nBytes: UINT): Pointer; stdcall; + +procedure SNMP_DBG_free(pMem: Pointer); stdcall; +function SNMP_DBG_malloc(nBytes: UINT): Pointer; stdcall; +function SNMP_DBG_realloc(pMem: Pointer; nBytes: UINT): Pointer; stdcall; + +{$ENDIF SNMP_DYNAMIC_LINK} + +{$EXTERNALSYM SNMP_oidcpy} +{$EXTERNALSYM SNMP_oidappend} +{$EXTERNALSYM SNMP_oidncmp} +{$EXTERNALSYM SNMP_oidcmp} +{$EXTERNALSYM SNMP_oidfree} + +{$EXTERNALSYM SNMP_CopyVarBind} +{$EXTERNALSYM SNMP_FreeVarBind} +{$EXTERNALSYM SNMP_CopyVarBindList} +{$EXTERNALSYM SNMP_FreeVarBindList} + +{$EXTERNALSYM SNMP_printany} + +{$EXTERNALSYM SNMP_free} +{$EXTERNALSYM SNMP_malloc} +{$EXTERNALSYM SNMP_realloc} + +{$EXTERNALSYM SNMP_DBG_free} +{$EXTERNALSYM SNMP_DBG_malloc} +{$EXTERNALSYM SNMP_DBG_realloc} + +const + ASN_RFC1155_IPADDRESS = ASN_IPADDRESS; + {$EXTERNALSYM ASN_RFC1155_IPADDRESS} + ASN_RFC1155_COUNTER = ASN_COUNTER32; + {$EXTERNALSYM ASN_RFC1155_COUNTER} + ASN_RFC1155_GAUGE = ASN_GAUGE32; + {$EXTERNALSYM ASN_RFC1155_GAUGE} + ASN_RFC1155_TIMETICKS = ASN_TIMETICKS; + {$EXTERNALSYM ASN_RFC1155_TIMETICKS} + ASN_RFC1155_OPAQUE = ASN_OPAQUE; + {$EXTERNALSYM ASN_RFC1155_OPAQUE} + ASN_RFC1213_DISPSTRING = ASN_OCTETSTRING; + {$EXTERNALSYM ASN_RFC1213_DISPSTRING} + + ASN_RFC1157_GETREQUEST = SNMP_PDU_GET; + {$EXTERNALSYM ASN_RFC1157_GETREQUEST} + ASN_RFC1157_GETNEXTREQUEST = SNMP_PDU_GETNEXT; + {$EXTERNALSYM ASN_RFC1157_GETNEXTREQUEST} + ASN_RFC1157_GETRESPONSE = SNMP_PDU_RESPONSE; + {$EXTERNALSYM ASN_RFC1157_GETRESPONSE} + ASN_RFC1157_SETREQUEST = SNMP_PDU_SET; + {$EXTERNALSYM ASN_RFC1157_SETREQUEST} + ASN_RFC1157_TRAP = SNMP_PDU_V1TRAP; + {$EXTERNALSYM ASN_RFC1157_TRAP} + + ASN_CONTEXTSPECIFIC = ASN_CONTEXT; + {$EXTERNALSYM ASN_CONTEXTSPECIFIC} + ASN_PRIMATIVE = ASN_PRIMITIVE; + {$EXTERNALSYM ASN_PRIMATIVE} + +type + RFC1157VarBindList = TSnmpVarBindList; + {$EXTERNALSYM RFC1157VarBindList} + RFC1157VarBind = TSnmpVarBind; + {$EXTERNALSYM RFC1157VarBind} + TAsnInteger = TAsnInteger32; + {$EXTERNALSYM TAsnInteger} + TAsnCounter = TAsnCounter32; + {$EXTERNALSYM TAsnCounter} + TAsnGauge = TAsnGauge32; + {$EXTERNALSYM TAsnGauge} + +{$ENDIF ~SNMPSTRICT} + +{ SNMP Extension API Prototypes } + +var + SnmpExtensionInit: TSnmpExtensionInit; + {$EXTERNALSYM SnmpExtensionInit} + SnmpExtensionInitEx: TSnmpExtensionInitEx; + {$EXTERNALSYM SnmpExtensionInitEx} + SnmpExtensionMonitor: TSnmpExtensionMonitor; + {$EXTERNALSYM SnmpExtensionMonitor} + SnmpExtensionQuery: TSnmpExtensionQuery; + {$EXTERNALSYM SnmpExtensionQuery} + SnmpExtensionQueryEx: TSnmpExtensionQueryEx; + {$EXTERNALSYM SnmpExtensionQueryEx} + SnmpExtensionTrap: TSnmpExtensionTrap; + {$EXTERNALSYM SnmpExtensionTrap} + SnmpExtensionClose: TSnmpExtensionClose; + {$EXTERNALSYM SnmpExtensionClose} + +//DOM-IGNORE-END + +function SnmpExtensionLoaded: Boolean; +function LoadSnmpExtension(const LibName: string): Boolean; +function UnloadSnmpExtension: Boolean; + +{$IFDEF SNMP_DYNAMIC_LINK} +function SnmpLoaded: Boolean; +{$IFDEF SNMP_DYNAMIC_LINK_EXPLICIT} +function LoadSnmp: Boolean; +function UnloadSnmp: Boolean; +{$ENDIF SNMP_DYNAMIC_LINK_EXPLICIT} +{$ENDIF SNMP_DYNAMIC_LINK} + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +const + snmpapilib = 'snmpapi.dll'; + +var + ExtensionLibHandle: THandle; + +function SnmpExtensionLoaded: Boolean; +begin + Result := ExtensionLibHandle <> 0; +end; + +function LoadSnmpExtension(const LibName: string): Boolean; +begin + Result := UnloadSnmpExtension; + if Result then + begin + ExtensionLibHandle := SafeLoadLibrary(LibName); + Result := SnmpExtensionLoaded; + if Result then + begin + @SnmpExtensionInit := GetProcAddress(ExtensionLibHandle, 'SnmpExtensionInit'); + @SnmpExtensionInitEx := GetProcAddress(ExtensionLibHandle, 'SnmpExtensionInitEx'); + @SnmpExtensionMonitor := GetProcAddress(ExtensionLibHandle, 'SnmpExtensionMonitor'); + @SnmpExtensionQuery := GetProcAddress(ExtensionLibHandle, 'SnmpExtensionQuery'); + @SnmpExtensionQueryEx := GetProcAddress(ExtensionLibHandle, 'SnmpExtensionQueryEx'); + @SnmpExtensionTrap := GetProcAddress(ExtensionLibHandle, 'SnmpExtensionTrap'); + @SnmpExtensionClose := GetProcAddress(ExtensionLibHandle, 'SnmpExtensionClose'); + Result := Assigned(SnmpExtensionInit); + if not Result then + UnloadSnmpExtension; + end; + end; +end; + +function UnloadSnmpExtension: Boolean; +begin + if SnmpExtensionLoaded then + begin + Result := FreeLibrary(ExtensionLibHandle); + ExtensionLibHandle := 0; + @SnmpExtensionInit := nil; + @SnmpExtensionInitEx := nil; + @SnmpExtensionMonitor := nil; + @SnmpExtensionQuery := nil; + @SnmpExtensionQueryEx := nil; + @SnmpExtensionTrap := nil; + @SnmpExtensionClose := nil; + end + else + Result := True; +end; + +{$IFDEF SNMP_DYNAMIC_LINK} + +var + SnmpLibHandle: THandle; + +function SnmpLoaded: Boolean; +begin + Result := SnmpLibHandle <> 0; +end; + +function UnloadSnmp: Boolean; +begin + Result := True; + if SnmpLoaded then + begin + Result := FreeLibrary(SnmpLibHandle); + SnmpLibHandle := 0; + @SnmpUtilOidCpy := nil; + @SnmpUtilOidAppend := nil; + @SnmpUtilOidNCmp := nil; + @SnmpUtilOidCmp := nil; + @SnmpUtilOidFree := nil; + @SnmpUtilOctetsCmp := nil; + @SnmpUtilOctetsNCmp := nil; + @SnmpUtilOctetsCpy := nil; + @SnmpUtilOctetsFree := nil; + @SnmpUtilAsnAnyCpy := nil; + @SnmpUtilAsnAnyFree := nil; + @SnmpUtilVarBindCpy := nil; + @SnmpUtilVarBindFree := nil; + @SnmpUtilVarBindListCpy := nil; + @SnmpUtilVarBindListFree := nil; + @SnmpUtilMemFree := nil; + @SnmpUtilMemAlloc := nil; + @SnmpUtilMemReAlloc := nil; + @SnmpUtilOidToA := nil; + @SnmpUtilIdsToA := nil; + @SnmpUtilPrintOid := nil; + @SnmpUtilPrintAsnAny := nil; + @SnmpSvcGetUptime := nil; + @SnmpSvcSetLogLevel := nil; + @SnmpSvcSetLogType := nil; + @SnmpUtilDbgPrint := nil; + {$IFNDEF SNMPSTRICT} + @SNMP_oidcpy := nil; + @SNMP_oidappend := nil; + @SNMP_oidncmp := nil; + @SNMP_oidcmp := nil; + @SNMP_oidfree := nil; + @SNMP_CopyVarBind := nil; + @SNMP_FreeVarBind := nil; + @SNMP_CopyVarBindList := nil; + @SNMP_FreeVarBindList := nil; + @SNMP_printany := nil; + @SNMP_free := nil; + @SNMP_malloc := nil; + @SNMP_realloc := nil; + @SNMP_DBG_free := nil; + @SNMP_DBG_malloc := nil; + @SNMP_DBG_realloc := nil; + {$ENDIF ~SNMPSTRICT} + end; +end; + +function LoadSnmp: Boolean; +begin + Result := SnmpLoaded; + if not Result then + begin + SnmpLibHandle := SafeLoadLibrary(snmpapilib); + if SnmpLoaded then + begin + @SnmpUtilOidCpy := GetProcAddress(SnmpLibHandle, 'SnmpUtilOidCpy'); + @SnmpUtilOidAppend := GetProcAddress(SnmpLibHandle, 'SnmpUtilOidAppend'); + @SnmpUtilOidNCmp := GetProcAddress(SnmpLibHandle, 'SnmpUtilOidNCmp'); + @SnmpUtilOidCmp := GetProcAddress(SnmpLibHandle, 'SnmpUtilOidCmp'); + @SnmpUtilOidFree := GetProcAddress(SnmpLibHandle, 'SnmpUtilOidFree'); + @SnmpUtilOctetsCmp := GetProcAddress(SnmpLibHandle, 'SnmpUtilOctetsCmp'); + @SnmpUtilOctetsNCmp := GetProcAddress(SnmpLibHandle, 'SnmpUtilOctetsNCmp'); + @SnmpUtilOctetsCpy := GetProcAddress(SnmpLibHandle, 'SnmpUtilOctetsCpy'); + @SnmpUtilOctetsFree := GetProcAddress(SnmpLibHandle, 'SnmpUtilOctetsFree'); + @SnmpUtilAsnAnyCpy := GetProcAddress(SnmpLibHandle, 'SnmpUtilAsnAnyCpy'); + @SnmpUtilAsnAnyFree := GetProcAddress(SnmpLibHandle, 'SnmpUtilAsnAnyFree'); + @SnmpUtilVarBindCpy := GetProcAddress(SnmpLibHandle, 'SnmpUtilVarBindCpy'); + @SnmpUtilVarBindFree := GetProcAddress(SnmpLibHandle, 'SnmpUtilVarBindFree'); + @SnmpUtilVarBindListCpy := GetProcAddress(SnmpLibHandle, 'SnmpUtilVarBindListCpy'); + @SnmpUtilVarBindListFree := GetProcAddress(SnmpLibHandle, 'SnmpUtilVarBindListFree'); + @SnmpUtilMemFree := GetProcAddress(SnmpLibHandle, 'SnmpUtilMemFree'); + @SnmpUtilMemAlloc := GetProcAddress(SnmpLibHandle, 'SnmpUtilMemAlloc'); + @SnmpUtilMemReAlloc := GetProcAddress(SnmpLibHandle, 'SnmpUtilMemReAlloc'); + @SnmpUtilOidToA := GetProcAddress(SnmpLibHandle, 'SnmpUtilOidToA'); + @SnmpUtilIdsToA := GetProcAddress(SnmpLibHandle, 'SnmpUtilIdsToA'); + @SnmpUtilPrintOid := GetProcAddress(SnmpLibHandle, 'SnmpUtilPrintOid'); + @SnmpUtilPrintAsnAny := GetProcAddress(SnmpLibHandle, 'SnmpUtilPrintAsnAny'); + @SnmpSvcGetUptime := GetProcAddress(SnmpLibHandle, 'SnmpSvcGetUptime'); + @SnmpSvcSetLogLevel := GetProcAddress(SnmpLibHandle, 'SnmpSvcSetLogLevel'); + @SnmpSvcSetLogType := GetProcAddress(SnmpLibHandle, 'SnmpSvcSetLogType'); + @SnmpUtilDbgPrint := GetProcAddress(SnmpLibHandle, 'SnmpUtilDbgPrint'); + {$IFNDEF SNMPSTRICT} + @SNMP_oidcpy := GetProcAddress(SnmpLibHandle, 'SnmpUtilOidCpy'); + @SNMP_oidappend := GetProcAddress(SnmpLibHandle, 'SnmpUtilOidAppend'); + @SNMP_oidncmp := GetProcAddress(SnmpLibHandle, 'SnmpUtilOidNCmp'); + @SNMP_oidcmp := GetProcAddress(SnmpLibHandle, 'SnmpUtilOidCmp'); + @SNMP_oidfree := GetProcAddress(SnmpLibHandle, 'SnmpUtilOidFree'); + @SNMP_CopyVarBind := GetProcAddress(SnmpLibHandle, 'SnmpUtilVarBindCpy'); + @SNMP_FreeVarBind := GetProcAddress(SnmpLibHandle, 'SnmpUtilVarBindFree'); + @SNMP_CopyVarBindList := GetProcAddress(SnmpLibHandle, 'SnmpUtilVarBindListCpy'); + @SNMP_FreeVarBindList := GetProcAddress(SnmpLibHandle, 'SnmpUtilVarBindListFree'); + @SNMP_printany := GetProcAddress(SnmpLibHandle, 'SnmpUtilPrintAsnAny'); + @SNMP_free := GetProcAddress(SnmpLibHandle, 'SnmpUtilMemFree'); + @SNMP_malloc := GetProcAddress(SnmpLibHandle, 'SnmpUtilMemAlloc'); + @SNMP_realloc := GetProcAddress(SnmpLibHandle, 'SnmpUtilMemReAlloc'); + @SNMP_DBG_free := GetProcAddress(SnmpLibHandle, 'SnmpUtilMemFree'); + @SNMP_DBG_malloc := GetProcAddress(SnmpLibHandle, 'SnmpUtilMemAlloc'); + @SNMP_DBG_realloc := GetProcAddress(SnmpLibHandle, 'SnmpUtilMemReAlloc'); + {$ENDIF ~SNMPSTRICT} + Result := True; + end; + end; +end; + +{$ELSE ~SNMP_DYNAMIC_LINK} + +function SnmpUtilOidCpy; external snmpapilib name 'SnmpUtilOidCpy'; +function SnmpUtilOidAppend; external snmpapilib name 'SnmpUtilOidAppend'; +function SnmpUtilOidNCmp; external snmpapilib name 'SnmpUtilOidNCmp'; +function SnmpUtilOidCmp; external snmpapilib name 'SnmpUtilOidCmp'; +procedure SnmpUtilOidFree; external snmpapilib name 'SnmpUtilOidFree'; +function SnmpUtilOctetsCmp; external snmpapilib name 'SnmpUtilOctetsCmp'; +function SnmpUtilOctetsNCmp; external snmpapilib name 'SnmpUtilOctetsNCmp'; +function SnmpUtilOctetsCpy; external snmpapilib name 'SnmpUtilOctetsCpy'; +procedure SnmpUtilOctetsFree; external snmpapilib name 'SnmpUtilOctetsFree'; +function SnmpUtilAsnAnyCpy; external snmpapilib name 'SnmpUtilAsnAnyCpy'; +procedure SnmpUtilAsnAnyFree; external snmpapilib name 'SnmpUtilAsnAnyFree'; +function SnmpUtilVarBindCpy; external snmpapilib name 'SnmpUtilVarBindCpy'; +procedure SnmpUtilVarBindFree; external snmpapilib name 'SnmpUtilVarBindFree'; +function SnmpUtilVarBindListCpy; external snmpapilib name 'SnmpUtilVarBindListCpy'; +procedure SnmpUtilVarBindListFree; external snmpapilib name 'SnmpUtilVarBindListFree'; +procedure SnmpUtilMemFree; external snmpapilib name 'SnmpUtilMemFree'; +function SnmpUtilMemAlloc; external snmpapilib name 'SnmpUtilMemAlloc'; +function SnmpUtilMemReAlloc; external snmpapilib name 'SnmpUtilMemReAlloc'; +function SnmpUtilOidToA; external snmpapilib name 'SnmpUtilOidToA'; +function SnmpUtilIdsToA; external snmpapilib name 'SnmpUtilIdsToA'; +procedure SnmpUtilPrintOid; external snmpapilib name 'SnmpUtilPrintOid'; +procedure SnmpUtilPrintAsnAny; external snmpapilib name 'SnmpUtilPrintAsnAny'; +function SnmpSvcGetUptime; external snmpapilib name 'SnmpSvcGetUptime'; +procedure SnmpSvcSetLogLevel; external snmpapilib name 'SnmpSvcSetLogLevel'; +procedure SnmpSvcSetLogType; external snmpapilib name 'SnmpSvcSetLogType'; +procedure SnmpUtilDbgPrint; external snmpapilib name 'SnmpUtilDbgPrint'; + +{$IFNDEF SNMPSTRICT} +function SNMP_oidcpy; external snmpapilib name 'SnmpUtilOidCpy'; +function SNMP_oidappend; external snmpapilib name 'SnmpUtilOidAppend'; +function SNMP_oidncmp; external snmpapilib name 'SnmpUtilOidNCmp'; +function SNMP_oidcmp; external snmpapilib name 'SnmpUtilOidCmp'; +procedure SNMP_oidfree; external snmpapilib name 'SnmpUtilOidFree'; +function SNMP_CopyVarBind; external snmpapilib name 'SnmpUtilVarBindCpy'; +procedure SNMP_FreeVarBind; external snmpapilib name 'SnmpUtilVarBindFree'; +function SNMP_CopyVarBindList; external snmpapilib name 'SnmpUtilVarBindListCpy'; +procedure SNMP_FreeVarBindList; external snmpapilib name 'SnmpUtilVarBindListFree'; +procedure SNMP_printany; external snmpapilib name 'SnmpUtilPrintAsnAny'; +procedure SNMP_free; external snmpapilib name 'SnmpUtilMemFree'; +function SNMP_malloc; external snmpapilib name 'SnmpUtilMemAlloc'; +function SNMP_realloc; external snmpapilib name 'SnmpUtilMemReAlloc'; +procedure SNMP_DBG_free; external snmpapilib name 'SnmpUtilMemFree'; +function SNMP_DBG_malloc; external snmpapilib name 'SnmpUtilMemAlloc'; +function SNMP_DBG_realloc; external snmpapilib name 'SnmpUtilMemReAlloc'; +{$ENDIF ~SNMPSTRICT} + +{$ENDIF ~SNMP_DYNAMIC_LINK} + +procedure InitializeSnmp; +begin + {$IFDEF SNMP_DYNAMIC_LINK} + {$IFNDEF SNMP_DYNAMIC_LINK_EXPLICIT} + LoadSnmp; + {$ENDIF ~SNMP_DYNAMIC_LINK_EXPLICIT} + {$ENDIF SNMP_DYNAMIC_LINK} +end; + +procedure FinalizeSnmp; +begin + {$IFDEF SNMP_DYNAMIC_LINK} + {$IFNDEF SNMP_DYNAMIC_LINK_EXPLICIT} + UnloadSnmp; + {$ENDIF ~SNMP_DYNAMIC_LINK_EXPLICIT} + {$ENDIF SNMP_DYNAMIC_LINK} +end; + +initialization + InitializeSnmp; + {$IFDEF UNITVERSIONING} + RegisterUnitVersion(HInstance, UnitVersioning); + {$ENDIF UNITVERSIONING} + +finalization + FinalizeSnmp; + {$IFDEF UNITVERSIONING} + UnregisterUnitVersion(HInstance); + {$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/dirinfo.txt b/3rdParty/JCL/source/windows/dirinfo.txt new file mode 100644 index 00000000..01430eb9 --- /dev/null +++ b/3rdParty/JCL/source/windows/dirinfo.txt @@ -0,0 +1 @@ +This is the directory where Win32-specific units reside. \ No newline at end of file diff --git a/3rdParty/JCL/source/windows/mscoree_TLB.pas b/3rdParty/JCL/source/windows/mscoree_TLB.pas new file mode 100644 index 00000000..26f7876a --- /dev/null +++ b/3rdParty/JCL/source/windows/mscoree_TLB.pas @@ -0,0 +1,497 @@ +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit mscoree_TLB; + +// ************************************************************************ // +// WARNING +// ------- +// The types declared in this file were generated from data read from a +// Type Library. If this type library is explicitly or indirectly (via +// another type library referring to this type library) re-imported, or the +// 'Refresh' command of the Type Library Editor activated while editing the +// Type Library, the contents of this file will be regenerated and all +// manual modifications will be lost. +// ************************************************************************ // + +// PASTLWTR : $Revision$ +// File generated on 14.12.2003 01:39:55 from Type Library described below. + +// ************************************************************************ // +// Type Lib: F:\WINNT\Microsoft.NET\Framework\v1.1.4322\mscoree.tlb (1) +// LIBID: {5477469E-83B1-11D2-8B49-00A0C9B7C9C4} +// LCID: 0 +// Helpfile: +// DepndLst: +// (1) v2.0 stdole, (F:\WINNT\system32\STDOLE2.TLB) +// (2) v4.0 StdVCL, (F:\WINNT\system32\STDVCL40.DLL) +// Errors: +// Hint: Member 'type' of 'tagSTATSTG' changed to 'type_' +// ************************************************************************ // +{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. + +{$I jcl.inc} +{$I windowsonly.inc} + +{$IFDEF SUPPORTS_WEAKPACKAGEUNIT} + {$IFDEF UNITVERSIONING} + {$WEAKPACKAGEUNIT OFF} + {$ELSE ~UNITVERSIONING} + {$WEAKPACKAGEUNIT ON} + {$ENDIF ~UNITVERSIONING} +{$ENDIF SUPPORTS_WEAKPACKAGEUNIT} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.ActiveX, System.Classes; + {$ELSE ~HAS_UNITSCOPE} + ActiveX, Classes; + {$ENDIF ~HAS_UNITSCOPE} + +//DOM-IGNORE-BEGIN + +{$HPPEMIT '#include '} + +// *********************************************************************// +// GUIDS declared in the TypeLibrary. Following prefixes are used: +// Type Libraries : LIBID_xxxx +// CoClasses : CLASS_xxxx +// DISPInterfaces : DIID_xxxx +// Non-DISP interfaces: IID_xxxx +// *********************************************************************// +const + // TypeLibrary Major and minor versions + mscoreeMajorVersion = 1; + mscoreeMinorVersion = 1; + + LIBID_mscoree: TGUID = '{5477469E-83B1-11D2-8B49-00A0C9B7C9C4}'; + + IID_IApartmentCallback: TGUID = '{178E5337-1528-4591-B1C9-1C6E484686D8}'; + IID_IManagedObject: TGUID = '{C3FCC19E-A970-11D2-8B5A-00A0C9B7C9C4}'; + IID_ICatalogServices: TGUID = '{04C6BE1E-1DB1-4058-AB7A-700CCCFBF254}'; + IID_IMarshal: TGUID = '{00000003-0000-0000-C000-000000000046}'; + CLASS_ComCallUnmarshal: TGUID = '{3F281000-E95A-11D2-886B-00C04F869F04}'; + IID_ISequentialStream: TGUID = '{0C733A30-2A1C-11CE-ADE5-00AA0044773D}'; + IID_IStream: TGUID = '{0000000C-0000-0000-C000-000000000046}'; + IID_ICorRuntimeHost: TGUID = '{CB2F6722-AB3A-11D2-9C40-00C04FA30A3E}'; + IID_IGCHost: TGUID = '{FAC34F6E-0DCD-47B5-8021-531BC5ECCA63}'; + IID_ICorConfiguration: TGUID = '{5C2B07A5-1E98-11D3-872F-00C04F79ED0D}'; + IID_IGCThreadControl: TGUID = '{F31D1788-C397-4725-87A5-6AF3472C2791}'; + IID_IGCHostControl: TGUID = '{5513D564-8374-4CB9-AED9-0083F4160A1D}'; + IID_IDebuggerThreadControl: TGUID = '{23D86786-0BB5-4774-8FB5-E3522ADD6246}'; + IID_IValidator: TGUID = '{63DF8730-DC81-4062-84A2-1FF943F59FAC}'; + IID_IDebuggerInfo: TGUID = '{BF24142D-A47D-4D24-A66D-8C2141944E44}'; + IID_IVEHandler: TGUID = '{856CA1B2-7DAB-11D3-ACEC-00C04F86C309}'; + CLASS_CorRuntimeHost: TGUID = '{CB2F6723-AB3A-11D2-9C40-00C04FA30A3E}'; +type + +// *********************************************************************// +// Forward declaration of types defined in TypeLibrary +// *********************************************************************// + IApartmentCallback = interface; + IManagedObject = interface; + ICatalogServices = interface; + {$IFNDEF FPC} + IMarshal = interface; + ISequentialStream = interface; + IStream = interface; + {$ENDIF ~FPC} + ICorRuntimeHost = interface; + IGCHost = interface; + ICorConfiguration = interface; + IGCThreadControl = interface; + IGCHostControl = interface; + IDebuggerThreadControl = interface; + IValidator = interface; + IDebuggerInfo = interface; + IVEHandler = interface; + +// *********************************************************************// +// Declaration of CoClasses defined in Type Library +// (NOTE: Here we map each CoClass to its Default Interface) +// *********************************************************************// + ComCallUnmarshal = IMarshal; + CorRuntimeHost = ICorRuntimeHost; + + +// *********************************************************************// +// Declaration of structures, unions and aliases. +// *********************************************************************// + PUserType1 = ^TGUID; {*} + PPUserType1 = ^ISequentialStream; {*} + PByte1 = ^Byte; {*} + PUINT1 = ^LongWord; {*} + + {$IFNDEF FPC} + ULONG_PTR = LongWord; + {$EXTERNALSYM ULONG_PTR} + {$ENDIF ~FPC} + + _LARGE_INTEGER = packed record + QuadPart: Int64; + end; + + _ULARGE_INTEGER = packed record + QuadPart: Largeuint; + end; + {$IFDEF RTL320_UP} + {$EXTERNALSYM _ULARGE_INTEGER} + {$ENDIF RTL320_UP} + + _FILETIME = packed record + dwLowDateTime: LongWord; + dwHighDateTime: LongWord; + end; + {$EXTERNALSYM _FILETIME} + + {$IFNDEF FPC} + tagSTATSTG = packed record + pwcsName: PWideChar; + type_: LongWord; + cbSize: _ULARGE_INTEGER; + mtime: _FILETIME; + ctime: _FILETIME; + atime: _FILETIME; + grfMode: LongWord; + grfLocksSupported: LongWord; + clsid: TGUID; + grfStateBits: LongWord; + reserved: LongWord; + end; + {$EXTERNALSYM tagSTATSTG} + {$ENDIF ~FPC} + + _COR_GC_STATS = packed record + Flags: LongWord; + ExplicitGCCount: ULONG_PTR; + GenCollectionsTaken: array[0..2] of ULONG_PTR; + CommittedKBytes: ULONG_PTR; + ReservedKBytes: ULONG_PTR; + Gen0HeapSizeKBytes: ULONG_PTR; + Gen1HeapSizeKBytes: ULONG_PTR; + Gen2HeapSizeKBytes: ULONG_PTR; + LargeObjectHeapSizeKBytes: ULONG_PTR; + KBytesPromotedFromGen0: ULONG_PTR; + KBytesPromotedFromGen1: ULONG_PTR; + end; + + _COR_GC_THREAD_STATS = packed record + PerThreadAllocation: Largeuint; + Flags: LongWord; + end; + + tag_VerError = packed record + Flags: LongWord; + opcode: LongWord; + uOffset: LongWord; + Token: LongWord; + item1_flags: LongWord; + item1_data: ^SYSINT; + item2_flags: LongWord; + item2_data: ^SYSINT; + end; + + +// *********************************************************************// +// Interface: IApartmentCallback +// Flags: (256) OleAutomation +// GUID: {178E5337-1528-4591-B1C9-1C6E484686D8} +// *********************************************************************// + IApartmentCallback = interface(IUnknown) + ['{178E5337-1528-4591-B1C9-1C6E484686D8}'] + function DoCallback(pFunc: ULONG_PTR; pData: ULONG_PTR): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: IManagedObject +// Flags: (256) OleAutomation +// GUID: {C3FCC19E-A970-11D2-8B5A-00A0C9B7C9C4} +// *********************************************************************// + IManagedObject = interface(IUnknown) + ['{C3FCC19E-A970-11D2-8B5A-00A0C9B7C9C4}'] + function GetSerializedBuffer(out pBSTR: WideString): HResult; stdcall; + function GetObjectIdentity(out pBSTRGUID: WideString; out AppDomainID: SYSINT; out pCCW: SYSINT): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: ICatalogServices +// Flags: (256) OleAutomation +// GUID: {04C6BE1E-1DB1-4058-AB7A-700CCCFBF254} +// *********************************************************************// + ICatalogServices = interface(IUnknown) + ['{04C6BE1E-1DB1-4058-AB7A-700CCCFBF254}'] + function Autodone: HResult; stdcall; + function NotAutodone: HResult; stdcall; + end; + + {$IFNDEF FPC} +// *********************************************************************// +// Interface: IMarshal +// Flags: (0) +// GUID: {00000003-0000-0000-C000-000000000046} +// *********************************************************************// + IMarshal = interface(IUnknown) + ['{00000003-0000-0000-C000-000000000046}'] + function GetUnmarshalClass(var riid: TGUID; var pv: Pointer; dwDestContext: LongWord; + var pvDestContext: Pointer; mshlflags: LongWord; out pCid: TGUID): HResult; stdcall; + function GetMarshalSizeMax(var riid: TGUID; var pv: Pointer; dwDestContext: LongWord; + var pvDestContext: Pointer; mshlflags: LongWord; out pSize: LongWord): HResult; stdcall; + function MarshalInterface(var pstm: ISequentialStream; var riid: TGUID; var pv: Pointer; + dwDestContext: LongWord; var pvDestContext: Pointer; + mshlflags: LongWord): HResult; stdcall; + function UnmarshalInterface(const pstm: ISequentialStream; var riid: TGUID; out ppv: Pointer): HResult; stdcall; + function ReleaseMarshalData(const pstm: ISequentialStream): HResult; stdcall; + function DisconnectObject(dwReserved: LongWord): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: ISequentialStream +// Flags: (0) +// GUID: {0C733A30-2A1C-11CE-ADE5-00AA0044773D} +// *********************************************************************// + ISequentialStream = interface(IUnknown) + ['{0C733A30-2A1C-11CE-ADE5-00AA0044773D}'] + function Read(out pv: Pointer; cb: LongWord; out pcbRead: LongWord): HResult; stdcall; + function RemoteRead(out pv: Byte; cb: LongWord; out pcbRead: LongWord): HResult; stdcall; + function Write(var pv: Pointer; cb: LongWord; out pcbWritten: LongWord): HResult; stdcall; + function RemoteWrite(var pv: Byte; cb: LongWord; out pcbWritten: LongWord): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: IStream +// Flags: (0) +// GUID: {0000000C-0000-0000-C000-000000000046} +// *********************************************************************// + IStream = interface(ISequentialStream) + ['{0000000C-0000-0000-C000-000000000046}'] + function Seek(dlibMove: _LARGE_INTEGER; dwOrigin: LongWord; out plibNewPosition: _ULARGE_INTEGER): HResult; stdcall; + function RemoteSeek(dlibMove: _LARGE_INTEGER; dwOrigin: LongWord; + out plibNewPosition: _ULARGE_INTEGER): HResult; stdcall; + function SetSize(libNewSize: _ULARGE_INTEGER): HResult; stdcall; + function CopyTo(const pstm: ISequentialStream; cb: _ULARGE_INTEGER; + out pcbRead: _ULARGE_INTEGER; out pcbWritten: _ULARGE_INTEGER): HResult; stdcall; + function RemoteCopyTo(const pstm: ISequentialStream; cb: _ULARGE_INTEGER; + out pcbRead: _ULARGE_INTEGER; out pcbWritten: _ULARGE_INTEGER): HResult; stdcall; + function Commit(grfCommitFlags: LongWord): HResult; stdcall; + function Revert: HResult; stdcall; + function LockRegion(libOffset: _ULARGE_INTEGER; cb: _ULARGE_INTEGER; dwLockType: LongWord): HResult; stdcall; + function UnlockRegion(libOffset: _ULARGE_INTEGER; cb: _ULARGE_INTEGER; dwLockType: LongWord): HResult; stdcall; + function Stat(out pstatstg: tagSTATSTG; grfStatFlag: LongWord): HResult; stdcall; + function Clone(out ppstm: ISequentialStream): HResult; stdcall; + end; + {$EXTERNALSYM IStream} + {$ENDIF ~FPC} + +// *********************************************************************// +// Interface: ICorRuntimeHost +// Flags: (0) +// GUID: {CB2F6722-AB3A-11D2-9C40-00C04FA30A3E} +// *********************************************************************// + ICorRuntimeHost = interface(IUnknown) + ['{CB2F6722-AB3A-11D2-9C40-00C04FA30A3E}'] + function CreateLogicalThreadState: HResult; stdcall; + function DeleteLogicalThreadState: HResult; stdcall; + function SwitchInLogicalThreadState(var pFiberCookie: LongWord): HResult; stdcall; + function SwitchOutLogicalThreadState(out pFiberCookie: PUINT1): HResult; stdcall; + function LocksHeldByLogicalThread(out pCount: LongWord): HResult; stdcall; + function MapFile(var hFile: Pointer; out hMapAddress: Pointer): HResult; stdcall; + function GetConfiguration(out pConfiguration: ICorConfiguration): HResult; stdcall; + function Start: HResult; stdcall; + function Stop: HResult; stdcall; + function CreateDomain(pwzFriendlyName: PWideChar; const pIdentityArray: IUnknown; + out pAppDomain: IUnknown): HResult; stdcall; + function GetDefaultDomain(out pAppDomain: IUnknown): HResult; stdcall; + function EnumDomains(out hEnum: Pointer): HResult; stdcall; + function NextDomain(hEnum: Pointer; out pAppDomain: IUnknown): HResult; stdcall; + function CloseEnum(hEnum: Pointer): HResult; stdcall; + function CreateDomainEx(pwzFriendlyName: PWideChar; const pSetup: IUnknown; + const pEvidence: IUnknown; out pAppDomain: IUnknown): HResult; stdcall; + function CreateDomainSetup(out pAppDomainSetup: IUnknown): HResult; stdcall; + function CreateEvidence(out pEvidence: IUnknown): HResult; stdcall; + function UnloadDomain(const pAppDomain: IUnknown): HResult; stdcall; + function CurrentDomain(out pAppDomain: IUnknown): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: IGCHost +// Flags: (0) +// GUID: {FAC34F6E-0DCD-47B5-8021-531BC5ECCA63} +// *********************************************************************// + IGCHost = interface(IUnknown) + ['{FAC34F6E-0DCD-47B5-8021-531BC5ECCA63}'] + function SetGCStartupLimits(SegmentSize: LongWord; MaxGen0Size: LongWord): HResult; stdcall; + function Collect(Generation: Integer): HResult; stdcall; + function GetStats(var pStats: _COR_GC_STATS): HResult; stdcall; + function GetThreadStats(var pFiberCookie: LongWord; var pStats: _COR_GC_THREAD_STATS): HResult; stdcall; + function SetVirtualMemLimit(sztMaxVirtualMemMB: ULONG_PTR): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: ICorConfiguration +// Flags: (0) +// GUID: {5C2B07A5-1E98-11D3-872F-00C04F79ED0D} +// *********************************************************************// + ICorConfiguration = interface(IUnknown) + ['{5C2B07A5-1E98-11D3-872F-00C04F79ED0D}'] + function SetGCThreadControl(const pGCThreadControl: IGCThreadControl): HResult; stdcall; + function SetGCHostControl(const pGCHostControl: IGCHostControl): HResult; stdcall; + function SetDebuggerThreadControl(const pDebuggerThreadControl: IDebuggerThreadControl): HResult; stdcall; + function AddDebuggerSpecialThread(dwSpecialThreadId: LongWord): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: IGCThreadControl +// Flags: (0) +// GUID: {F31D1788-C397-4725-87A5-6AF3472C2791} +// *********************************************************************// + IGCThreadControl = interface(IUnknown) + ['{F31D1788-C397-4725-87A5-6AF3472C2791}'] + function ThreadIsBlockingForSuspension: HResult; stdcall; + function SuspensionStarting: HResult; stdcall; + function SuspensionEnding(Generation: LongWord): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: IGCHostControl +// Flags: (0) +// GUID: {5513D564-8374-4CB9-AED9-0083F4160A1D} +// *********************************************************************// + IGCHostControl = interface(IUnknown) + ['{5513D564-8374-4CB9-AED9-0083F4160A1D}'] + function RequestVirtualMemLimit(sztMaxVirtualMemMB: ULONG_PTR; + var psztNewMaxVirtualMemMB: ULONG_PTR): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: IDebuggerThreadControl +// Flags: (0) +// GUID: {23D86786-0BB5-4774-8FB5-E3522ADD6246} +// *********************************************************************// + IDebuggerThreadControl = interface(IUnknown) + ['{23D86786-0BB5-4774-8FB5-E3522ADD6246}'] + function ThreadIsBlockingForDebugger: HResult; stdcall; + function ReleaseAllRuntimeThreads: HResult; stdcall; + function StartBlockingForDebugger(dwUnused: LongWord): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: IValidator +// Flags: (0) +// GUID: {63DF8730-DC81-4062-84A2-1FF943F59FAC} +// *********************************************************************// + IValidator = interface(IUnknown) + ['{63DF8730-DC81-4062-84A2-1FF943F59FAC}'] + function Validate(const veh: IVEHandler; const pAppDomain: IUnknown; ulFlags: LongWord; + ulMaxError: LongWord; Token: LongWord; fileName: PWideChar; var pe: Byte; + ulSize: LongWord): HResult; stdcall; + function FormatEventInfo(hVECode: HResult; Context: tag_VerError; msg: PWideChar; + ulMaxLength: LongWord; psa: PSafeArray): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: IDebuggerInfo +// Flags: (0) +// GUID: {BF24142D-A47D-4D24-A66D-8C2141944E44} +// *********************************************************************// + IDebuggerInfo = interface(IUnknown) + ['{BF24142D-A47D-4D24-A66D-8C2141944E44}'] + function IsDebuggerAttached(out pbAttached: Integer): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: IVEHandler +// Flags: (0) +// GUID: {856CA1B2-7DAB-11D3-ACEC-00C04F86C309} +// *********************************************************************// + IVEHandler = interface(IUnknown) + ['{856CA1B2-7DAB-11D3-ACEC-00C04F86C309}'] + function VEHandler(VECode: HResult; Context: tag_VerError; psa: PSafeArray): HResult; stdcall; + function SetReporterFtn(lFnPtr: Int64): HResult; stdcall; + end; + +// *********************************************************************// +// The Class CoComCallUnmarshal provides a Create and CreateRemote method to +// create instances of the default interface IMarshal exposed by +// the CoClass ComCallUnmarshal. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoComCallUnmarshal = class + class function Create: IMarshal; + class function CreateRemote(const MachineName: string): IMarshal; + end; + +// *********************************************************************// +// The Class CoCorRuntimeHost provides a Create and CreateRemote method to +// create instances of the default interface ICorRuntimeHost exposed by +// the CoClass CorRuntimeHost. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCorRuntimeHost = class + class function Create: ICorRuntimeHost; + class function CreateRemote(const MachineName: string): ICorRuntimeHost; + end; + +//DOM-IGNORE-END + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.Win.ComObj; + {$ELSE ~HAS_UNITSCOPE} + ComObj; + {$ENDIF ~HAS_UNITSCOPE} + +class function CoComCallUnmarshal.Create: IMarshal; +begin + Result := CreateComObject(CLASS_ComCallUnmarshal) as IMarshal; +end; + +class function CoComCallUnmarshal.CreateRemote(const MachineName: string): IMarshal; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ComCallUnmarshal) as IMarshal; +end; + +class function CoCorRuntimeHost.Create: ICorRuntimeHost; +begin + Result := CreateComObject(CLASS_CorRuntimeHost) as ICorRuntimeHost; +end; + +class function CoCorRuntimeHost.CreateRemote(const MachineName: string): ICorRuntimeHost; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CorRuntimeHost) as ICorRuntimeHost; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/mscorlib_TLB.pas b/3rdParty/JCL/source/windows/mscorlib_TLB.pas new file mode 100644 index 00000000..a5cb475e --- /dev/null +++ b/3rdParty/JCL/source/windows/mscorlib_TLB.pas @@ -0,0 +1,32373 @@ +{**************************************************************************************************} +{ } +{ Last modified: $Date:: $ } +{ Revision: $Rev:: $ } +{ Author: $Author:: $ } +{ } +{**************************************************************************************************} + +unit mscorlib_TLB; + +// ************************************************************************ // +// WARNING +// ------- +// The types declared in this file were generated from data read from a +// Type Library. If this type library is explicitly or indirectly (via +// another type library referring to this type library) re-imported, or the +// 'Refresh' command of the Type Library Editor activated while editing the +// Type Library, the contents of this file will be regenerated and all +// manual modifications will be lost. +// ************************************************************************ // + +// PASTLWTR : $Revision$ +// File generated on 14.12.2003 01:40:37 from Type Library described below. + +// ************************************************************************ // +// Type Lib: F:\WINNT\Microsoft.NET\Framework\v1.1.4322\mscorlib.tlb (1) +// LIBID: {BED7F4EA-1A96-11D2-8F08-00A0C9A6186D} +// LCID: 0 +// Helpfile: +// DepndLst: +// (1) v2.0 stdole, (F:\WINNT\system32\STDOLE2.TLB) +// (2) v4.0 StdVCL, (F:\WINNT\system32\STDVCL40.DLL) +// Errors: +// Hint: TypeInfo 'Object' changed to 'Object_' +// Hint: TypeInfo 'Array' changed to 'Array_' +// Hint: TypeInfo 'String' changed to 'String_' +// Hint: TypeInfo 'Type' changed to 'Type_' +// Hint: TypeInfo 'File' changed to 'File_' +// Hint: TypeInfo 'Label' changed to 'Label_' +// Hint: Parameter 'Array' of ICollection.CopyTo changed to 'Array_' +// Hint: Member 'Type' of 'TypedReference' changed to 'Type_' +// Hint: Parameter 'Type' of IFormatterConverter.Convert changed to 'Type_' +// Hint: Parameter 'Type' of ISurrogateSelector.GetSurrogate changed to 'Type_' +// Hint: Parameter 'Type' of IRegistrationServices.GetProgIdForType changed to 'Type_' +// Hint: Parameter 'Type' of IRegistrationServices.RegisterTypeForComClients changed to 'Type_' +// Hint: Parameter 'Type' of IRegistrationServices.TypeRequiresRegistration changed to 'Type_' +// Hint: Parameter 'Type' of IRegistrationServices.TypeRepresentsComType changed to 'Type_' +// Hint: Parameter 'or' of ITrackingHandler.MarshaledObject changed to 'or_' +// Hint: Parameter 'or' of ITrackingHandler.UnmarshaledObject changed to 'or_' +// Hint: Parameter 'Type' of _Binder.ChangeType changed to 'Type_' +// Hint: Parameter 'Type' of _Type.GetMember changed to 'Type_' +// Hint: Parameter 'Type' of _Assembly.GetManifestResourceStream changed to 'Type_' +// ************************************************************************ // +{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. + +{$I jcl.inc} +{$I windowsonly.inc} + +{$IFDEF SUPPORTS_WEAKPACKAGEUNIT} + {$IFDEF UNITVERSIONING} + {$WEAKPACKAGEUNIT OFF} + {$ELSE ~UNITVERSIONING} + {$WEAKPACKAGEUNIT ON} + {$ENDIF ~UNITVERSIONING} +{$ENDIF SUPPORTS_WEAKPACKAGEUNIT} + +interface + +uses + {$IFDEF UNITVERSIONING} + JclUnitVersioning, + {$ENDIF UNITVERSIONING} + {$IFDEF HAS_UNITSCOPE} + Winapi.ActiveX, System.Classes; + {$ELSE ~HAS_UNITSCOPE} + ActiveX, Classes; + {$ENDIF ~HAS_UNITSCOPE} + +//DOM-IGNORE-BEGIN + +// *********************************************************************// +// GUIDS declared in the TypeLibrary. Following prefixes are used: +// Type Libraries : LIBID_xxxx +// CoClasses : CLASS_xxxx +// DISPInterfaces : DIID_xxxx +// Non-DISP interfaces: IID_xxxx +// *********************************************************************// +const + // TypeLibrary Major and minor versions + mscorlibMajorVersion = 1; + mscorlibMinorVersion = 10; + + LIBID_mscorlib: TGUID = '{BED7F4EA-1A96-11D2-8F08-00A0C9A6186D}'; + + IID__Object: TGUID = '{65074F7F-63C0-304E-AF0A-D51741CB4A8D}'; + IID_ICloneable: TGUID = '{0CB251A7-3AB3-3B5C-A0B8-9DDF88824B85}'; + IID_IEnumerable: TGUID = '{496B0ABE-CDEE-11D3-88E8-00902754C43A}'; + IID_ICollection: TGUID = '{DE8DB6F8-D101-3A92-8D1C-E72E5F10E992}'; + IID_IList: TGUID = '{7BCFA00F-F764-3113-9140-3BBD127A96BB}'; + IID__Array: TGUID = '{2B67CECE-71C3-36A9-A136-925CCC1935A8}'; + IID_IEnumerator: TGUID = '{496B0ABF-CDEE-11D3-88E8-00902754C43A}'; + IID_IComparable: TGUID = '{DEB0E770-91FD-3CF6-9A6C-E6A3656F3965}'; + IID_IConvertible: TGUID = '{805E3B62-B5E9-393D-8941-377D8BF4556B}'; + IID__String: TGUID = '{36936699-FC79-324D-AB43-E33C1F94E263}'; + IID__StringBuilder: TGUID = '{9FB09782-8D39-3B0C-B79E-F7A37A65B3DA}'; + IID_ISerializable: TGUID = '{D0EEAA62-3D30-3EE2-B896-A2F34DDA47D8}'; + IID__Exception: TGUID = '{B36B5C63-42EF-38BC-A07E-0B34C98F164A}'; + IID__ValueType: TGUID = '{139E041D-0E41-39F5-A302-C4387E9D0A6C}'; + IID_IFormattable: TGUID = '{9A604EE7-E630-3DED-9444-BAAE247075AB}'; + IID__SystemException: TGUID = '{4C482CC2-68E9-37C6-8353-9A94BD2D7F0B}'; + IID__OutOfMemoryException: TGUID = '{CF3EDB7E-0574-3383-A44F-292F7C145DB4}'; + IID__StackOverflowException: TGUID = '{9CF4339A-2911-3B8A-8F30-E5C6B5BE9A29}'; + IID__ExecutionEngineException: TGUID = '{CCF0139C-79F7-3D0A-AFFE-2B0762C65B07}'; + IID__Delegate: TGUID = '{FB6AB00F-5096-3AF8-A33D-D7885A5FA829}'; + IID__MulticastDelegate: TGUID = '{16FE0885-9129-3884-A232-90B58C5B2AA9}'; + IID__Enum: TGUID = '{D09D1E04-D590-39A3-B517-B734A49A9277}'; + IID__MemberAccessException: TGUID = '{7EABA4E2-1259-3CF2-B084-9854278E5897}'; + IID__Activator: TGUID = '{03973551-57A1-3900-A2B5-9083E3FF2943}'; + IID__ApplicationException: TGUID = '{D81130BF-D627-3B91-A7C7-CEA597093464}'; + IID__EventArgs: TGUID = '{1F9EC719-343A-3CB3-8040-3927626777C1}'; + IID__ResolveEventArgs: TGUID = '{98947CF0-77E7-328E-B709-5DD1AA1C9C96}'; + IID__AssemblyLoadEventArgs: TGUID = '{7A0325F0-22C2-31F9-8823-9B8AEE9456B1}'; + IID__ResolveEventHandler: TGUID = '{8E54A9CC-7AA4-34CA-985B-BD7D7527B110}'; + IID__AssemblyLoadEventHandler: TGUID = '{DEECE11F-A893-3E35-A4C3-DAB7FA0911EB}'; + IID__MarshalByRefObject: TGUID = '{2C358E27-8C1A-3C03-B086-A40465625557}'; + IID__AppDomain: TGUID = '{05F696DC-2B29-3663-AD8B-C4389CF2A713}'; + IID_IEvidenceFactory: TGUID = '{35A8F3AC-FE28-360F-A0C0-9A4D50C4682A}'; + CLASS_AppDomain: TGUID = '{5FE0A145-A82B-3D96-94E3-FD214C9D6EB9}'; + IID__CrossAppDomainDelegate: TGUID = '{AF93163F-C2F4-3FAB-9FF1-728A7AAAD1CB}'; + IID_IAppDomainSetup: TGUID = '{27FFF232-A7A8-40DD-8D4A-734AD59FCD41}'; + IID__Attribute: TGUID = '{917B14D0-2D9E-38B8-92A9-381ACF52F7C0}'; + IID__LoaderOptimizationAttribute: TGUID = '{CE59D7AD-05CA-33B4-A1DD-06028D46E9D2}'; + IID__AppDomainUnloadedException: TGUID = '{6E96AA70-9FFB-399D-96BF-A68436095C54}'; + IID__ArgumentException: TGUID = '{4DB2C2B7-CBC2-3185-B966-875D4625B1A8}'; + IID__ArgumentNullException: TGUID = '{C991949B-E623-3F24-885C-BBB01FF43564}'; + IID__ArgumentOutOfRangeException: TGUID = '{77DA3028-BC45-3E82-BF76-2C123EE2C021}'; + IID__ArithmeticException: TGUID = '{9B012CF1-ACF6-3389-A336-C023040C62A2}'; + IID__ArrayTypeMismatchException: TGUID = '{DD7488A6-1B3F-3823-9556-C2772B15150F}'; + IID__AsyncCallback: TGUID = '{3612706E-0239-35FD-B900-0819D16D442D}'; + IID__AttributeUsageAttribute: TGUID = '{A902A192-49BA-3EC8-B444-AF5F7743F61A}'; + IID__BadImageFormatException: TGUID = '{F98BCE04-4A4B-398C-A512-FD8348D51E3B}'; + IID__BitConverter: TGUID = '{5CD861E8-CA91-301B-9E24-141E3D85BD5D}'; + IID__Buffer: TGUID = '{F036BCA4-F8DF-3682-8290-75285CE7456C}'; + IID__CannotUnloadAppDomainException: TGUID = '{6D4B6ADB-B9FA-3809-B5EA-FA57B56C546F}'; + IID__CharEnumerator: TGUID = '{1DD627FC-89E3-384F-BB9D-58CB4EFB9456}'; + IID__CLSCompliantAttribute: TGUID = '{BF1AF177-94CA-3E6D-9D91-55CF9E859D22}'; + IID__TypeUnloadedException: TGUID = '{C2A10F3A-356A-3C77-AAB9-8991D73A2561}'; + IID__Console: TGUID = '{88592805-9549-3E00-8308-03CFA6B93882}'; + IID__ContextMarshalException: TGUID = '{7386F4D7-7C11-389F-BB75-895714B12BB5}'; + IID__Convert: TGUID = '{9E1348D4-3FAC-3704-840D-20D91E4AD542}'; + IID__ContextBoundObject: TGUID = '{3EB1D909-E8BF-3C6B-ADA5-0E86E31E186E}'; + IID__ContextStaticAttribute: TGUID = '{160D517F-F175-3B61-8264-6D2305B8246C}'; + IID__TimeZone: TGUID = '{3025F666-7891-33D7-AACD-23D169EF354E}'; + IID__DBNull: TGUID = '{0D9F1B65-6D27-3E9F-BAF3-0597837E0F33}'; + IID__Binder: TGUID = '{3169AB11-7109-3808-9A61-EF4BA0534FD9}'; + IID_IObjectReference: TGUID = '{6E70ED5F-0439-38CE-83BB-860F1421F29F}'; + IID__DivideByZeroException: TGUID = '{BDEEA460-8241-3B41-9ED3-6E3E9977AC7F}'; + IID__DuplicateWaitObjectException: TGUID = '{D345A42B-CFE0-3EEE-861C-F3322812B388}'; + IID__TypeLoadException: TGUID = '{82D6B3BF-A633-3B3B-A09E-2363E4B24A41}'; + IID__EntryPointNotFoundException: TGUID = '{67388F3F-B600-3BCF-84AA-BB2B88DD9EE2}'; + IID__DllNotFoundException: TGUID = '{24AE6464-2834-32CD-83D6-FA06953DE62A}'; + IID__Environment: TGUID = '{29DC56CF-B981-3432-97C8-3680AB6D862D}'; + IID__EventHandler: TGUID = '{7CEFC46E-16E0-3E65-9C38-55B4342BA7F0}'; + IID__FieldAccessException: TGUID = '{8D5F5811-FFA1-3306-93E3-8AFC572B9B82}'; + IID__FlagsAttribute: TGUID = '{EBE3746D-DDEC-3D23-8E8D-9361BA87BAC6}'; + IID__FormatException: TGUID = '{07F92156-398A-3548-90B7-2E58026353D0}'; + IID__GC: TGUID = '{679ED106-5DC1-38FE-8B5C-2ADCA3552298}'; + IID_IAsyncResult: TGUID = '{11AB34E7-0176-3C9E-9EFE-197858400A3D}'; + IID_ICustomFormatter: TGUID = '{2B130940-CA5E-3406-8385-E259E68AB039}'; + IID_IDisposable: TGUID = '{805D7A98-D4AF-3F0F-967F-E5CF45312D2C}'; + IID_IFormatProvider: TGUID = '{C8CB1DED-2814-396A-9CC0-473CA49779CC}'; + IID__IndexOutOfRangeException: TGUID = '{E5A5F1E4-82C1-391F-A1C6-F39EAE9DC72F}'; + IID__InvalidCastException: TGUID = '{FA047CBD-9BA5-3A13-9B1F-6694D622CD76}'; + IID__InvalidOperationException: TGUID = '{8D520D10-0B8A-3553-8874-D30A4AD2FF4C}'; + IID__InvalidProgramException: TGUID = '{3410E0FB-636F-3CD1-8045-3993CA113F25}'; + IID__LocalDataStoreSlot: TGUID = '{DC77F976-318D-3A1A-9B60-ABB9DD9406D6}'; + IID__Math: TGUID = '{A19F91C8-7D23-3DFB-A988-CEE05B039121}'; + IID__MethodAccessException: TGUID = '{FF0BF77D-8F81-3D31-A3BB-6F54440FA7E5}'; + IID__MissingMemberException: TGUID = '{8897D14B-7FB3-3D8B-9EE4-221C3DBAD6FE}'; + IID__MissingFieldException: TGUID = '{9717176D-1179-3487-8849-CF5F63DE356E}'; + IID__MissingMethodException: TGUID = '{E5C659F6-92C8-3887-A07E-74D0D9C6267A}'; + IID__MulticastNotSupportedException: TGUID = '{D2BA71CC-1B3D-3966-A0D7-C61E957AD325}'; + IID__NonSerializedAttribute: TGUID = '{665C9669-B9C6-3ADD-9213-099F0127C893}'; + IID__NotFiniteNumberException: TGUID = '{8E21CE22-4F17-347B-B3B5-6A6DF3E0E58A}'; + IID__NotImplementedException: TGUID = '{1E4D31A2-63EA-397A-A77E-B20AD87A9614}'; + IID__NotSupportedException: TGUID = '{40E5451F-B237-33F8-945B-0230DB700BBB}'; + IID__NullReferenceException: TGUID = '{ECBE2313-CF41-34B4-9FD0-B6CD602B023F}'; + IID__ObjectDisposedException: TGUID = '{17B730BA-45EF-3DDF-9F8D-A490BAC731F4}'; + IID__ObsoleteAttribute: TGUID = '{E84307BE-3036-307A-ACC2-5D5DE8A006A8}'; + IID__OperatingSystem: TGUID = '{9E230640-A5D0-30E1-B217-9D2B6CC0FC40}'; + IID__OverflowException: TGUID = '{37C69A5D-7619-3A0F-A96B-9C9578AE00EF}'; + IID__ParamArrayAttribute: TGUID = '{D54500AE-8CF4-3092-9054-90DC91AC65C9}'; + IID__PlatformNotSupportedException: TGUID = '{1EB8340B-8190-3D9D-92F8-51244B9804C5}'; + IID__Random: TGUID = '{0F240708-629A-31AB-94A5-2BB476FE1783}'; + IID__RankException: TGUID = '{871DDC46-B68E-3FEE-A09A-C808B0F827E6}'; + IID_ICustomAttributeProvider: TGUID = '{B9B91146-D6C2-3A62-8159-C2D1794CDEB0}'; + IID__MemberInfo: TGUID = '{F7102FA9-CABB-3A74-A6DA-B4567EF1B079}'; + IID_IReflect: TGUID = '{AFBF15E5-C37C-11D2-B88E-00A0C9B471B8}'; + IID__Type: TGUID = '{BCA8B44D-AAD6-3A86-8AB7-03349F4F2DA2}'; + IID__SerializableAttribute: TGUID = '{1B96E53C-4028-38BC-9DC3-8D7A9555C311}'; + IID__TypeInitializationException: TGUID = '{FEB0323D-8CE4-36A4-A41E-0BA0C32E1A6A}'; + IID__UnauthorizedAccessException: TGUID = '{6193C5F6-6807-3561-A7F3-B64C80B5F00F}'; + IID__UnhandledExceptionEventArgs: TGUID = '{A218E20A-0905-3741-B0B3-9E3193162E50}'; + IID__UnhandledExceptionEventHandler: TGUID = '{84199E64-439C-3011-B249-3C9065735ADB}'; + IID__Version: TGUID = '{011A90C5-4910-3C29-BBB7-50D05CCBAA4A}'; + IID__WeakReference: TGUID = '{C5DF3568-C251-3C58-AFB4-32E79E8261F0}'; + IID__WaitHandle: TGUID = '{40DFC50A-E93A-3C08-B9EF-E2B4F28B5676}'; + IID__AutoResetEvent: TGUID = '{3F243EBD-612F-3DB8-9E03-BD92343A8371}'; + IID__CompressedStack: TGUID = '{4BCBC4D6-98EB-381A-A8A6-08B2378738ED}'; + IID__Interlocked: TGUID = '{DF20F518-8ED1-35E3-950E-020214FDB9B2}'; + IID_IObjectHandle: TGUID = '{C460E2B4-E199-412A-8456-84DC3E4838C3}'; + IID__ManualResetEvent: TGUID = '{C0BB9361-268F-3E72-BF6F-4120175A1500}'; + IID__Monitor: TGUID = '{EE22485E-4C45-3C9D-9027-A8D61C5F53F2}'; + IID__Mutex: TGUID = '{36CB559B-87C6-3AD2-9225-62A7ED499B37}'; + IID__Overlapped: TGUID = '{DD846FCC-8D04-3665-81B6-AACBE99C19C3}'; + IID__ReaderWriterLock: TGUID = '{AD89B568-4FD4-3F8D-8327-B396B20A460E}'; + IID__SynchronizationLockException: TGUID = '{87F55344-17E0-30FD-8EB9-38EAF6A19B3F}'; + IID__Thread: TGUID = '{C281C7F1-4AA9-3517-961A-463CFED57E75}'; + IID__ThreadAbortException: TGUID = '{95B525DB-6B81-3CDC-8FE7-713F7FC793C0}'; + IID__STAThreadAttribute: TGUID = '{85D72F83-BE91-3CB1-B4F0-76B56FF04033}'; + IID__MTAThreadAttribute: TGUID = '{C02468D1-8713-3225-BDA3-49B2FE37DDBB}'; + IID__ThreadInterruptedException: TGUID = '{B9E07599-7C44-33BE-A70E-EFA16F51F54A}'; + IID__RegisteredWaitHandle: TGUID = '{64409425-F8C9-370E-809E-3241CE804541}'; + IID__WaitCallback: TGUID = '{CE949142-4D4C-358D-89A9-E69A531AA363}'; + IID__WaitOrTimerCallback: TGUID = '{F078F795-F452-3D2D-8CC8-16D66AE46C67}'; + IID__IOCompletionCallback: TGUID = '{BBAE942D-BFF4-36E2-A3BC-508BB3801F4F}'; + IID__ThreadPool: TGUID = '{F5E02ADE-E724-3001-B498-3305B2A93D72}'; + IID__ThreadStart: TGUID = '{B45BBD7E-A977-3F56-A626-7A693E5DBBC5}'; + IID__ThreadStateException: TGUID = '{A13A41CF-E066-3B90-82F4-73109104E348}'; + IID__ThreadStaticAttribute: TGUID = '{A6B94B6D-854E-3172-A4EC-A17EDD16F85E}'; + IID__Timeout: TGUID = '{81456E86-22AF-31D1-A91A-9C370C0E2530}'; + IID__TimerCallback: TGUID = '{3741BC6F-101B-36D7-A9D5-03FCC0ECDA35}'; + IID__Timer: TGUID = '{B49A029B-406B-3B1E-88E4-F86690D20364}'; + IID__ArrayList: TGUID = '{401F89CB-C127-3041-82FD-B67035395C56}'; + IID__BitArray: TGUID = '{F145C46A-D170-3170-B52F-4678DFCA0300}'; + IID_IComparer: TGUID = '{C20FD3EB-7022-3D14-8477-760FAB54E50D}'; + IID__CaseInsensitiveComparer: TGUID = '{EA6795AC-97D6-3377-BE64-829ABD67607B}'; + IID_IHashCodeProvider: TGUID = '{5D573036-3435-3C5A-AEFF-2B8191082C71}'; + IID__CaseInsensitiveHashCodeProvider: TGUID = '{0422B845-B636-3688-8F61-9B6D93096336}'; + IID__CollectionBase: TGUID = '{B7D29E26-7798-3FA4-90F4-E6A22D2099F9}'; + IID__Comparer: TGUID = '{8064A157-B5C8-3A4A-AD3D-02DC1A39C417}'; + IID_IDictionary: TGUID = '{6A6841DF-3287-3D87-8060-CE0B4C77D2A1}'; + IID__DictionaryBase: TGUID = '{DDD44DA2-BC6B-3620-9317-C0372968C741}'; + IID_IDeserializationCallback: TGUID = '{AB3F47E4-C227-3B05-BF9F-94649BEF9888}'; + IID__Hashtable: TGUID = '{D25A197E-3E69-3271-A989-23D85E97F920}'; + IID_IDictionaryEnumerator: TGUID = '{35D574BF-7A4F-3588-8C19-12212A0FE4DC}'; + IID__Queue: TGUID = '{3A7D3CA4-B7D1-3A2A-800C-8FC2ACFCBDA4}'; + IID__ReadOnlyCollectionBase: TGUID = '{BD32D878-A59B-3E5C-BFE0-A96B1A1E9D6F}'; + IID__SortedList: TGUID = '{56421139-A143-3AE9-9852-1DBDFE3D6BFA}'; + IID__Stack: TGUID = '{AB538809-3C2F-35D9-80E6-7BAD540484A1}'; + IID__ConditionalAttribute: TGUID = '{E40A025C-645B-3C8E-A1AC-9C5CCA279625}'; + IID__Debugger: TGUID = '{A9B4786C-08E3-344F-A651-2F9926DEAC5E}'; + IID__DebuggerStepThroughAttribute: TGUID = '{3344E8B4-A5C3-3882-8D30-63792485ECCF}'; + IID__DebuggerHiddenAttribute: TGUID = '{55B6903B-55FE-35E0-804F-E42A096D2EB0}'; + IID__DebuggableAttribute: TGUID = '{428E3627-2B1F-302C-A7E6-6388CD535E75}'; + IID__StackTrace: TGUID = '{9A2669EC-FF84-3726-89A0-663A3EF3B5CD}'; + IID__StackFrame: TGUID = '{0E9B8E47-CA67-38B6-B9DB-2C42EE757B08}'; + IID_ISymbolBinder: TGUID = '{20808ADC-CC01-3F3A-8F09-ED12940FC212}'; + IID_ISymbolDocument: TGUID = '{1C32F012-2684-3EFE-8D50-9C2973ACC00B}'; + IID_ISymbolDocumentWriter: TGUID = '{FA682F24-3A3C-390D-B8A2-96F1106F4B37}'; + IID_ISymbolMethod: TGUID = '{25C72EB0-E437-3F17-946D-3B72A3ACFF37}'; + IID_ISymbolNamespace: TGUID = '{23ED2454-6899-3C28-BAB7-6EC86683964A}'; + IID_ISymbolReader: TGUID = '{E809A5F1-D3D7-3144-9BEF-FE8AC0364699}'; + IID_ISymbolScope: TGUID = '{1CEE3A11-01AE-3244-A939-4972FC9703EF}'; + IID_ISymbolVariable: TGUID = '{4042BD4D-B5AB-30E8-919B-14910687BAAE}'; + IID_ISymbolWriter: TGUID = '{DA295A1B-C5BD-3B34-8ACD-1D7D334FFB7F}'; + IID__SymDocumentType: TGUID = '{5141D79C-7B01-37DA-B7E9-53E5A271BAF8}'; + IID__SymLanguageType: TGUID = '{22BB8891-FD21-313D-92E4-8A892DC0B39C}'; + IID__SymLanguageVendor: TGUID = '{01364E7B-C983-3651-B7D8-FD1B64FC0E00}'; + IID__AmbiguousMatchException: TGUID = '{81AA0D59-C3B1-36A3-B2E7-054928FBFC1A}'; + IID__ModuleResolveEventHandler: TGUID = '{05532E88-E0F2-3263-9B57-805AC6B6BB72}'; + IID__Assembly: TGUID = '{17156360-2F1A-384A-BC52-FDE93C215C5B}'; + IID__AssemblyCultureAttribute: TGUID = '{177C4E63-9E0B-354D-838B-B52AA8683EF6}'; + IID__AssemblyVersionAttribute: TGUID = '{A1693C5C-101F-3557-94DB-C480CEB4C16B}'; + IID__AssemblyKeyFileAttribute: TGUID = '{A9FCDA18-C237-3C6F-A6EF-749BE22BA2BF}'; + IID__AssemblyKeyNameAttribute: TGUID = '{322A304D-11AC-3814-A905-A019F6E3DAE9}'; + IID__AssemblyDelaySignAttribute: TGUID = '{6CF1C077-C974-38E1-90A4-976E4835E165}'; + IID__AssemblyAlgorithmIdAttribute: TGUID = '{57B849AA-D8EF-3EA6-9538-C5B4D498C2F7}'; + IID__AssemblyFlagsAttribute: TGUID = '{0ECD8635-F5EB-3E4A-8989-4D684D67C48A}'; + IID__AssemblyFileVersionAttribute: TGUID = '{B101FE3C-4479-311A-A945-1225EE1731E8}'; + IID__AssemblyName: TGUID = '{B42B6AAC-317E-34D5-9FA9-093BB4160C50}'; + IID__AssemblyNameProxy: TGUID = '{FE52F19A-8AA8-309C-BF99-9D0A566FB76A}'; + IID__AssemblyCopyrightAttribute: TGUID = '{6163F792-3CD6-38F1-B5F7-000B96A5082B}'; + IID__AssemblyTrademarkAttribute: TGUID = '{64C26BF9-C9E5-3F66-AD74-BEBAADE36214}'; + IID__AssemblyProductAttribute: TGUID = '{DE10D587-A188-3DCB-8000-92DFDB9B8021}'; + IID__AssemblyCompanyAttribute: TGUID = '{C6802233-EF82-3C91-AD72-B3A5D7230ED5}'; + IID__AssemblyDescriptionAttribute: TGUID = '{6B2C0BC4-DDB7-38EA-8A86-F0B59E192816}'; + IID__AssemblyTitleAttribute: TGUID = '{DF44CAD3-CEF2-36A9-B013-383CC03177D7}'; + IID__AssemblyConfigurationAttribute: TGUID = '{746D1D1E-EE37-393B-B6FA-E387D37553AA}'; + IID__AssemblyDefaultAliasAttribute: TGUID = '{04311D35-75EC-347B-BEDF-969487CE4014}'; + IID__AssemblyInformationalVersionAttribute: TGUID = '{C6F5946C-143A-3747-A7C0-ABFADA6BDEB7}'; + IID__CustomAttributeFormatException: TGUID = '{1660EB67-EE41-363E-BEB0-C2DE09214ABF}'; + IID__MethodBase: TGUID = '{6240837A-707F-3181-8E98-A36AE086766B}'; + IID__ConstructorInfo: TGUID = '{E9A19478-9646-3679-9B10-8411AE1FD57D}'; + IID__DefaultMemberAttribute: TGUID = '{C462B072-FE6E-3BDC-9FAB-4CDBFCBCD124}'; + IID__EventInfo: TGUID = '{9DE59C64-D889-35A1-B897-587D74469E5B}'; + IID__FieldInfo: TGUID = '{8A7C1442-A9FB-366B-80D8-4939FFA6DBE0}'; + IID__InvalidFilterCriteriaException: TGUID = '{E6DF0AE7-BA15-3F80-8AFA-27773AE414FC}'; + IID__ManifestResourceInfo: TGUID = '{3188878C-DEB3-3558-80E8-84E9ED95F92C}'; + IID__MemberFilter: TGUID = '{FAE5D9B7-40C1-3DE1-BE06-A91C9DA1BA9F}'; + IID__MethodInfo: TGUID = '{FFCC1B5D-ECB8-38DD-9B01-3DC8ABC2AA5F}'; + IID__Missing: TGUID = '{0C48F55D-5240-30C7-A8F1-AF87A640CEFE}'; + IID__Module: TGUID = '{D002E9BA-D9E3-3749-B1D3-D565A08B13E7}'; + IID__ParameterInfo: TGUID = '{993634C4-E47A-32CC-BE08-85F567DC27D6}'; + IID__Pointer: TGUID = '{F0DEAFE9-5EBA-3737-9950-C1795739CDCD}'; + IID__PropertyInfo: TGUID = '{F59ED4E4-E68F-3218-BD77-061AA82824BF}'; + IID__ReflectionTypeLoadException: TGUID = '{22C26A41-5FA3-34E3-A76F-BA480252D8EC}'; + IID__StrongNameKeyPair: TGUID = '{FC4963CB-E52B-32D8-A418-D058FA51A1FA}'; + IID__TargetException: TGUID = '{98B1524D-DA12-3C4B-8A69-7539A6DEC4FA}'; + IID__TargetInvocationException: TGUID = '{A90106ED-9099-3329-8A5A-2044B3D8552B}'; + IID__TargetParameterCountException: TGUID = '{6032B3CD-9BED-351C-A145-9D500B0F636F}'; + IID__TypeDelegator: TGUID = '{34E00EF9-83E2-3BBC-B6AF-4CAE703838BD}'; + IID__TypeFilter: TGUID = '{E1817846-3745-3C97-B4A6-EE20A1641B29}'; + IID__UnmanagedMarshal: TGUID = '{FD302D86-240A-3694-A31F-9EF59E6E41BC}'; + IID_IFormatter: TGUID = '{93D7A8C5-D2EB-319B-A374-A65D321F2AA9}'; + IID__Formatter: TGUID = '{D9BD3C8D-9395-3657-B6EE-D1B509C38B70}'; + IID_IFormatterConverter: TGUID = '{F4F5C303-FAD3-3D0C-A4DF-BB82B5EE308F}'; + IID__FormatterConverter: TGUID = '{3FAA35EE-C867-3E2E-BF48-2DA271F88303}'; + IID__FormatterServices: TGUID = '{F859954A-78CF-3D00-86AB-EF661E6A4B8D}'; + IID_ISerializationSurrogate: TGUID = '{62339172-DBFA-337B-8AC8-053B241E06AB}'; + IID_ISurrogateSelector: TGUID = '{7C66FF18-A1A5-3E19-857B-0E7B6A9E3F38}'; + IID__ObjectIDGenerator: TGUID = '{A30646CC-F710-3BFA-A356-B4C858D4ED8E}'; + IID__ObjectManager: TGUID = '{F28E7D04-3319-3968-8201-C6E55BECD3D4}'; + IID__SerializationBinder: TGUID = '{450222D0-87CA-3699-A7B4-D8A0FDB72357}'; + IID__SerializationInfo: TGUID = '{B58D62CF-B03A-3A14-B0B6-B1E5AD4E4AD5}'; + IID__SerializationInfoEnumerator: TGUID = '{607056C6-1BCA-36C8-AB87-33B202EBF0D8}'; + IID__SerializationException: TGUID = '{245FE7FD-E020-3053-B5F6-7467FD2C6883}'; + IID__SurrogateSelector: TGUID = '{6DE1230E-1F52-3779-9619-F5184103466C}'; + IID__Calendar: TGUID = '{4CCA29E4-584B-3CD0-AD25-855DC5799C16}'; + IID__CompareInfo: TGUID = '{505DEFE5-AEFA-3E23-82B0-D5EB085BB840}'; + IID__CultureInfo: TGUID = '{152722C2-F0B1-3D19-ADA8-F40CA5CAECB8}'; + IID__DateTimeFormatInfo: TGUID = '{015E9F67-337C-398A-A0C1-DA4AF1905571}'; + IID__DaylightTime: TGUID = '{EFEA8FEB-EE7F-3E48-8A36-6206A6ACBF73}'; + IID__GregorianCalendar: TGUID = '{677AD8B5-8A0E-3C39-92FB-72FB817CF694}'; + IID__HebrewCalendar: TGUID = '{96A62D6C-72A9-387A-81FA-E6DD5998CAEE}'; + IID__HijriCalendar: TGUID = '{28DDC187-56B2-34CF-A078-48BD1E113D1E}'; + IID__JapaneseCalendar: TGUID = '{D662AE3F-CEF9-38B4-BB8E-5D8DD1DBF806}'; + IID__JulianCalendar: TGUID = '{36E2DE92-1FB3-3D7D-BA26-9CAD5B98DD52}'; + IID__KoreanCalendar: TGUID = '{48BEA6C4-752E-3974-8CA8-CFB6274E2379}'; + IID__RegionInfo: TGUID = '{F9E97E04-4E1E-368F-B6C6-5E96CE4362D6}'; + IID__SortKey: TGUID = '{F4C70E15-2CA6-3E90-96ED-92E28491F538}'; + IID__StringInfo: TGUID = '{0A25141F-51B3-3121-AA30-0AF4556A52D9}'; + IID__TaiwanCalendar: TGUID = '{0C08ED74-0ACF-32A9-99DF-09A9DC4786DD}'; + IID__TextElementEnumerator: TGUID = '{8C248251-3E6C-3151-9F8E-A255FB8D2B12}'; + IID__TextInfo: TGUID = '{DB8DE23F-F264-39AC-B61C-CC1E7EB4A5E6}'; + IID__ThaiBuddhistCalendar: TGUID = '{C70C8AE8-925B-37CE-8944-34F15FF94307}'; + IID__NumberFormatInfo: TGUID = '{25E47D71-20DD-31BE-B261-7AE76497D6B9}'; + IID__Encoding: TGUID = '{DDEDB94D-4F3F-35C1-97C9-3F1D87628D9E}'; + IID__System_Text_Decoder: TGUID = '{2ADB0D4A-5976-38E4-852B-C131797430F5}'; + IID__System_Text_Encoder: TGUID = '{8FD56502-8724-3DF0-A1B5-9D0E8D4E4F78}'; + IID__ASCIIEncoding: TGUID = '{0CBE0204-12A1-3D40-9D9E-195DE6AAA534}'; + IID__UnicodeEncoding: TGUID = '{F7DD3B7F-2B05-3894-8EDA-59CDF9395B6A}'; + IID__UTF7Encoding: TGUID = '{89B9F00B-AA2A-3A49-91B4-E8D1F1C00E58}'; + IID__UTF8Encoding: TGUID = '{010FC1D0-3EF9-3F3B-AA0A-B78A1FF83A37}'; + IID_IResourceReader: TGUID = '{8965A22F-FBA8-36AD-8132-70BBD0DA457D}'; + IID_IResourceWriter: TGUID = '{E97AA6E5-595E-31C3-82F0-688FB91954C6}'; + IID__MissingManifestResourceException: TGUID = '{1A4E1878-FE8C-3F59-B6A9-21AB82BE57E9}'; + IID__NeutralResourcesLanguageAttribute: TGUID = '{F48DF808-8B7D-3F4E-9159-1DFD60F298D6}'; + IID__ResourceManager: TGUID = '{4DE671B7-7C85-37E9-AFF8-1222ABE4883E}'; + IID__ResourceReader: TGUID = '{7FBCFDC7-5CEC-3945-8095-DAED61BE5FB1}'; + IID__ResourceSet: TGUID = '{44D5F81A-727C-35AE-8DF8-9FF6722F1C6C}'; + IID__ResourceWriter: TGUID = '{AF170258-AAC6-3A86-BD34-303E62CED10E}'; + IID__SatelliteContractVersionAttribute: TGUID = '{5CBB1F47-FBA5-33B9-9D4A-57D6E3D133D2}'; + IID__Registry: TGUID = '{23BAE0C0-3A36-32F0-9DAD-0E95ADD67D23}'; + IID__RegistryKey: TGUID = '{2EAC6733-8D92-31D9-BE04-DC467EFC3EB1}'; + IID__X509Certificate: TGUID = '{68FD6F14-A7B2-36C8-A724-D01F90D73477}'; + IID__AsymmetricAlgorithm: TGUID = '{09343AC0-D19A-3E62-BC16-0F600F10180A}'; + IID__AsymmetricKeyExchangeDeformatter: TGUID = '{B6685CCA-7A49-37D1-A805-3DE829CB8DEB}'; + IID__AsymmetricKeyExchangeFormatter: TGUID = '{1365B84B-6477-3C40-BE6A-089DC01ECED9}'; + IID__AsymmetricSignatureDeformatter: TGUID = '{7CA5FE57-D1AC-3064-BB0B-F450BE40F194}'; + IID__AsymmetricSignatureFormatter: TGUID = '{5363D066-6295-3618-BE33-3F0B070B7976}'; + IID_ICryptoTransform: TGUID = '{8ABAD867-F515-3CF6-BB62-5F0C88B3BB11}'; + IID__ToBase64Transform: TGUID = '{23DED1E1-7D5F-3936-AA4E-18BBCC39B155}'; + IID__FromBase64Transform: TGUID = '{FC0717A6-2E86-372F-81F4-B35ED4BDF0DE}'; + IID__KeySizes: TGUID = '{8978B0BE-A89E-3FF9-9834-77862CEBFF3D}'; + IID__CryptographicException: TGUID = '{4311E8F5-B249-3F81-8FF4-CF853D85306D}'; + IID__CryptographicUnexpectedOperationException: TGUID = '{7FB08423-038F-3ACC-B600-E6D072BAE160}'; + IID__CryptoAPITransform: TGUID = '{983B8639-2ED7-364C-9899-682ABB2CE850}'; + IID__CspParameters: TGUID = '{D5331D95-FFF2-358F-AFD5-588F469FF2E4}'; + IID__CryptoConfig: TGUID = '{AB00F3F8-7DDE-3FF5-B805-6C5DBB200549}'; + IID__Stream: TGUID = '{2752364A-924F-3603-8F6F-6586DF98B292}'; + IID__CryptoStream: TGUID = '{4134F762-D0EC-3210-93C0-DE4F443D5669}'; + IID__SymmetricAlgorithm: TGUID = '{05BC0E38-7136-3825-9E34-26C1CF2142C9}'; + IID__DES: TGUID = '{C7EF0214-B91C-3799-98DD-C994AABFC741}'; + IID__DESCryptoServiceProvider: TGUID = '{65E8495E-5207-3248-9250-0FC849B4F096}'; + IID__DeriveBytes: TGUID = '{140EE78F-067F-3765-9258-C3BC72FE976B}'; + IID__DSA: TGUID = '{0EB5B5E0-1BE6-3A5F-87B3-E3323342F44E}'; + IID__DSACryptoServiceProvider: TGUID = '{1F38AAFE-7502-332F-971F-C2FC700A1D55}'; + IID__DSASignatureDeformatter: TGUID = '{0E774498-ADE6-3820-B1D5-426B06397BE7}'; + IID__DSASignatureFormatter: TGUID = '{4B5FC561-5983-31E4-903B-1404231B2C89}'; + IID__HashAlgorithm: TGUID = '{69D3BABA-1C3D-354C-ACFE-F19109EC3896}'; + IID__KeyedHashAlgorithm: TGUID = '{D182CF91-628C-3FF6-87F0-41BA51CC7433}'; + IID__HMACSHA1: TGUID = '{63AC7C37-C51A-3D82-8FDD-2A567039E46D}'; + IID__MACTripleDES: TGUID = '{1CAC0BDA-AC58-31BC-B624-63F77D0C3D2F}'; + IID__MD5: TGUID = '{9AA8765E-69A0-30E3-9CDE-EBC70662AE37}'; + IID__MD5CryptoServiceProvider: TGUID = '{D3F5C812-5867-33C9-8CEE-CB170E8D844A}'; + IID__MaskGenerationMethod: TGUID = '{85601FEE-A79D-3710-AF21-099089EDC0BF}'; + IID__PasswordDeriveBytes: TGUID = '{3CD62D67-586F-309E-A6D8-1F4BAAC5AC28}'; + IID__PKCS1MaskGenerationMethod: TGUID = '{425BFF0D-59E4-36A8-B1FF-1F5D39D698F4}'; + IID__RC2: TGUID = '{F7C0C4CC-0D49-31EE-A3D3-B8B551E4928C}'; + IID__RC2CryptoServiceProvider: TGUID = '{875715C5-CB64-3920-8156-0EE9CB0E07EA}'; + IID__RandomNumberGenerator: TGUID = '{7AE4B03C-414A-36E0-BA68-F9603004C925}'; + IID__RNGCryptoServiceProvider: TGUID = '{2C65D4C0-584C-3E4E-8E6D-1AFB112BFF69}'; + IID__RSA: TGUID = '{0B3FB710-A25C-3310-8774-1CF117F95BD4}'; + IID__RSACryptoServiceProvider: TGUID = '{BD9DF856-2300-3254-BCF0-679BA03C7A13}'; + IID__RSAOAEPKeyExchangeDeformatter: TGUID = '{37625095-7BAA-377D-A0DC-7F465C0167AA}'; + IID__RSAOAEPKeyExchangeFormatter: TGUID = '{77A416E7-2AC6-3D0E-98FF-3BA0F586F56F}'; + IID__RSAPKCS1KeyExchangeDeformatter: TGUID = '{8034AAF4-3666-3B6F-85CF-463F9BFD31A9}'; + IID__RSAPKCS1KeyExchangeFormatter: TGUID = '{9FF67F8E-A7AA-3BA6-90EE-9D44AF6E2F8C}'; + IID__RSAPKCS1SignatureDeformatter: TGUID = '{FC38507E-06A4-3300-8652-8D7B54341F65}'; + IID__RSAPKCS1SignatureFormatter: TGUID = '{FB7A5FF4-CFA8-3F24-AD5F-D5EB39359707}'; + IID__Rijndael: TGUID = '{21B52A91-856F-373C-AD42-4CF3F1021F5A}'; + IID__RijndaelManaged: TGUID = '{427EA9D3-11D8-3E38-9E05-A4F7FA684183}'; + IID__SHA1: TGUID = '{48600DD2-0099-337F-92D6-961D1E5010D4}'; + IID__SHA1CryptoServiceProvider: TGUID = '{A16537BC-1EDF-3516-B75E-CC65CAF873AB}'; + IID__SHA1Managed: TGUID = '{C27990BB-3CFD-3D29-8DC0-BBE5FBADEAFD}'; + IID__SHA256: TGUID = '{3B274703-DFAE-3F9C-A1B5-9990DF9D7FA3}'; + IID__SHA256Managed: TGUID = '{3D077954-7BCC-325B-9DDA-3B17A03378E0}'; + IID__SHA384: TGUID = '{B60AD5D7-2C2E-35B7-8D77-7946156CFE8E}'; + IID__SHA384Managed: TGUID = '{DE541460-F838-3698-B2DA-510B09070118}'; + IID__SHA512: TGUID = '{49DD9E4B-84F3-3D6D-91FB-3FEDCEF634C7}'; + IID__SHA512Managed: TGUID = '{DC8CE439-7954-36ED-803C-674F72F27249}'; + IID__SignatureDescription: TGUID = '{8017B414-4886-33DA-80A3-7865C1350D43}'; + IID__TripleDES: TGUID = '{C040B889-5278-3132-AFF9-AFA61707A81D}'; + IID__TripleDESCryptoServiceProvider: TGUID = '{EC69D083-3CD0-3C0C-998C-3B738DB535D5}'; + IID_ISecurityEncodable: TGUID = '{FD46BDE5-ACDF-3CA5-B189-F0678387077F}'; + IID_ISecurityPolicyEncodable: TGUID = '{E6C21BA7-21BB-34E9-8E57-DB66D8CE4A70}'; + IID_IMembershipCondition: TGUID = '{6844EFF4-4F86-3CA1-A1EA-AAF583A6395E}'; + IID__AllMembershipCondition: TGUID = '{99F01720-3CC2-366D-9AB9-50E36647617F}'; + IID__ApplicationDirectory: TGUID = '{9CCC831B-1BA7-34BE-A966-56D5A6DB5AAD}'; + IID__ApplicationDirectoryMembershipCondition: TGUID = '{A02A2B22-1DBA-3F92-9F84-5563182851BB}'; + IID__CodeGroup: TGUID = '{D7093F61-ED6B-343F-B1E9-02472FCC710E}'; + IID__Evidence: TGUID = '{A505EDBC-380E-3B23-9E1A-0974D4EF02EF}'; + IID__FileCodeGroup: TGUID = '{DFAD74DC-8390-32F6-9612-1BD293B233F4}'; + IID__FirstMatchCodeGroup: TGUID = '{54B0AFB1-E7D3-3770-BB0E-75A95E8D2656}'; + IID__Hash: TGUID = '{7574E121-74A6-3626-B578-0783BADB19D2}'; + IID__HashMembershipCondition: TGUID = '{6BA6EA7A-C9FC-3E73-82EC-18F29D83EEFD}'; + IID_IIdentityPermissionFactory: TGUID = '{4E95244E-C6FC-3A86-8DB7-1712454DE3B6}'; + IID__NetCodeGroup: TGUID = '{A8F69ECA-8C48-3B5E-92A1-654925058059}'; + IID__PermissionRequestEvidence: TGUID = '{34B0417E-E71D-304C-9FAC-689350A1B41C}'; + IID__PolicyException: TGUID = '{A9C9F3D9-E153-39B8-A533-B8DF4664407B}'; + IID__PolicyLevel: TGUID = '{44494E35-C370-3014-BC78-0F2ECBF83F53}'; + IID__PolicyStatement: TGUID = '{3EEFD1FC-4D8D-3177-99F6-6C19D9E088D3}'; + IID__Publisher: TGUID = '{77CCA693-ABF6-3773-BF58-C0B02701A744}'; + IID__PublisherMembershipCondition: TGUID = '{3515CF63-9863-3044-B3E1-210E98EFC702}'; + IID__Site: TGUID = '{90C40B4C-B0D0-30F5-B520-FDBA97BC31A0}'; + IID__SiteMembershipCondition: TGUID = '{0A7C3542-8031-3593-872C-78D85D7CC273}'; + IID__StrongName: TGUID = '{2A75C1FD-06B0-3CBB-B467-2545D4D6C865}'; + IID__StrongNameMembershipCondition: TGUID = '{579E93BC-FFAB-3B8D-9181-CE9C22B51915}'; + IID__UnionCodeGroup: TGUID = '{D9D822DE-44E5-33CE-A43F-173E475CECB1}'; + IID__Url: TGUID = '{D94ED9BF-C065-3703-81A2-2F76EA8E312F}'; + IID__UrlMembershipCondition: TGUID = '{BB7A158D-DBD9-3E13-B137-8E61E87E1128}'; + IID__Zone: TGUID = '{742E0C26-0E23-3D20-968C-D221094909AA}'; + IID__ZoneMembershipCondition: TGUID = '{ADBC3463-0101-3429-A06C-DB2F1DD6B724}'; + IID_IIdentity: TGUID = '{F4205A87-4D46-303D-B1D9-5A99F7C90D30}'; + IID__GenericIdentity: TGUID = '{9A37D8B2-2256-3FE3-8BF0-4FC421A1244F}'; + IID_IPrincipal: TGUID = '{4283CA6C-D291-3481-83C9-9554481FE888}'; + IID__GenericPrincipal: TGUID = '{B4701C26-1509-3726-B2E1-409A636C9B4F}'; + IID__WindowsIdentity: TGUID = '{D8CF3F23-1A66-3344-8230-07EB53970B85}'; + IID__WindowsImpersonationContext: TGUID = '{60ECFDDA-650A-324C-B4B3-F4D75B563BB1}'; + IID__WindowsPrincipal: TGUID = '{6C42BAF9-1893-34FC-B3AF-06931E9B34A3}'; + IID__DispIdAttribute: TGUID = '{BBE41AC5-8692-3427-9AE1-C1058A38D492}'; + IID__InterfaceTypeAttribute: TGUID = '{A2145F38-CAC1-33DD-A318-21948AF6825D}'; + IID__ClassInterfaceAttribute: TGUID = '{6B6391EE-842F-3E9A-8EEE-F13325E10996}'; + IID__ComVisibleAttribute: TGUID = '{1E7FFFE2-AAD9-34EE-8A9F-3C016B880FF0}'; + IID__LCIDConversionAttribute: TGUID = '{4AB67927-3C86-328A-8186-F85357DD5527}'; + IID__ComRegisterFunctionAttribute: TGUID = '{51BA926F-AAB5-3945-B8A6-C8F0F4A7D12B}'; + IID__ComUnregisterFunctionAttribute: TGUID = '{9F164188-34EB-3F86-9F74-0BBE4155E65E}'; + IID__ProgIdAttribute: TGUID = '{2B9F01DF-5A12-3688-98D6-C34BF5ED1865}'; + IID__ImportedFromTypeLibAttribute: TGUID = '{3F3311CE-6BAF-3FB0-B855-489AFF740B6E}'; + IID__IDispatchImplAttribute: TGUID = '{5778E7C7-2040-330E-B47A-92974DFFCFD4}'; + IID__ComSourceInterfacesAttribute: TGUID = '{E1984175-55F5-3065-82D8-A683FDFCF0AC}'; + IID__ComConversionLossAttribute: TGUID = '{FD5B6AAC-FF8C-3472-B894-CD6DFADB6939}'; + IID__TypeLibTypeAttribute: TGUID = '{B5A1729E-B721-3121-A838-FDE43AF13468}'; + IID__TypeLibFuncAttribute: TGUID = '{3D18A8E2-EEDE-3139-B29D-8CAC057955DF}'; + IID__TypeLibVarAttribute: TGUID = '{7B89862A-02A4-3279-8B42-4095FA3A778E}'; + IID__MarshalAsAttribute: TGUID = '{D858399F-E19E-3423-A720-AC12ABE2E5E8}'; + IID__ComImportAttribute: TGUID = '{1B093056-5454-386F-8971-BBCBC4E9A8F3}'; + IID__GuidAttribute: TGUID = '{74435DAD-EC55-354B-8F5B-FA70D13B6293}'; + IID__PreserveSigAttribute: TGUID = '{FDF2A2EE-C882-3198-A48B-E37F0E574DFA}'; + IID__InAttribute: TGUID = '{8474B65C-C39A-3D05-893D-577B9A314615}'; + IID__OutAttribute: TGUID = '{0697FC8C-9B04-3783-95C7-45ECCAC1CA27}'; + IID__OptionalAttribute: TGUID = '{0D6BD9AD-198E-3904-AD99-F6F82A2787C4}'; + IID__DllImportAttribute: TGUID = '{A1A26181-D55E-3EE2-96E6-70B354EF9371}'; + IID__StructLayoutAttribute: TGUID = '{23753322-C7B3-3F9A-AC96-52672C1B1CA9}'; + IID__FieldOffsetAttribute: TGUID = '{C14342B8-BAFD-322A-BB71-62C672DA284E}'; + IID__ComAliasNameAttribute: TGUID = '{E78785C4-3A73-3C15-9390-618BF3A14719}'; + IID__AutomationProxyAttribute: TGUID = '{57B908A8-C082-3581-8A47-6B41B86E8FDC}'; + IID__PrimaryInteropAssemblyAttribute: TGUID = '{C69E96B2-6161-3621-B165-5805198C6B8D}'; + IID__CoClassAttribute: TGUID = '{15D54C00-7C95-38D7-B859-E19346677DCD}'; + IID__ComEventInterfaceAttribute: TGUID = '{76CC0491-9A10-35C0-8A66-7931EC345B7F}'; + IID__TypeLibVersionAttribute: TGUID = '{A03B61A4-CA61-3460-8232-2F4EC96AA88F}'; + IID__ComCompatibleVersionAttribute: TGUID = '{AD419379-2AC8-3588-AB1E-0115413277C4}'; + IID__BestFitMappingAttribute: TGUID = '{ED47ABE7-C84B-39F9-BE1B-828CFB925AFE}'; + IID__ExternalException: TGUID = '{A83F04E9-FD28-384A-9DFF-410688AC23AB}'; + IID__COMException: TGUID = '{A28C19DF-B488-34AE-BECC-7DE744D17F7B}'; + IID__CurrencyWrapper: TGUID = '{7DF6F279-DA62-3C9F-8944-4DD3C0F08170}'; + IID__DispatchWrapper: TGUID = '{72103C67-D511-329C-B19A-DD5EC3F1206C}'; + IID__ErrorWrapper: TGUID = '{F79DB336-06BE-3959-A5AB-58B2AB6C5FD1}'; + IID__ExtensibleClassFactory: TGUID = '{519EB857-7A2D-3A95-A2A3-8BB8ED63D41B}'; + IID_ICustomAdapter: TGUID = '{3CC86595-FEB5-3CE9-BA14-D05C8DC3321C}'; + IID_ICustomMarshaler: TGUID = '{601CD486-04BF-3213-9EA9-06EBE4351D74}'; + IID_ICustomFactory: TGUID = '{0CA9008E-EE90-356E-9F6D-B59E6006B9A4}'; + IID__InvalidComObjectException: TGUID = '{DE9156B5-5E7A-3041-BF45-A29A6C2CF48A}'; + IID__InvalidOleVariantTypeException: TGUID = '{76E5DBD6-F960-3C65-8EA6-FC8AD6A67022}'; + IID_IRegistrationServices: TGUID = '{CCBD682C-73A5-4568-B8B0-C7007E11ABA2}'; + IID_ITypeLibImporterNotifySink: TGUID = '{F1C3BF76-C3E4-11D3-88E7-00902754C43A}'; + IID_ITypeLibExporterNotifySink: TGUID = '{F1C3BF77-C3E4-11D3-88E7-00902754C43A}'; + IID_ITypeLibConverter: TGUID = '{F1C3BF78-C3E4-11D3-88E7-00902754C43A}'; + IID_ITypeLibExporterNameProvider: TGUID = '{FA1F3615-ACB9-486D-9EAC-1BEF87E36B09}'; + IID__Marshal: TGUID = '{5F06D2F8-F3D4-3585-814C-2E886C465F25}'; + IID__MarshalDirectiveException: TGUID = '{523F42A5-1FD2-355D-82BF-0D67C4A0A0E7}'; + IID__ObjectCreationDelegate: TGUID = '{E4A369D3-6CF0-3B05-9C0C-1A91E331641A}'; + CLASS_RegistrationServices: TGUID = '{475E398F-8AFA-43A7-A3BE-F4EF8D6787C9}'; + IID__RuntimeEnvironment: TGUID = '{EDCEE21A-3E3A-331E-A86D-274028BE6716}'; + IID__SafeArrayRankMismatchException: TGUID = '{8608FE7B-2FDC-318A-B711-6F7B2FEDED06}'; + IID__SafeArrayTypeMismatchException: TGUID = '{E093FB32-E43B-3B3F-A163-742C920C2AF3}'; + IID__SEHException: TGUID = '{3E72E067-4C5E-36C8-BBEF-1E2978C7780D}'; + CLASS_TypeLibConverter: TGUID = '{F1C3BF79-C3E4-11D3-88E7-00902754C43A}'; + IID__UnknownWrapper: TGUID = '{1C8D8B14-4589-3DCA-8E0F-A30E80FBD1A8}'; + IID_IExpando: TGUID = '{AFBF15E6-C37C-11D2-B88E-00A0C9B471B8}'; + IID__BinaryReader: TGUID = '{442E3C03-A205-3F21-AA4D-31768BB8EA28}'; + IID__BinaryWriter: TGUID = '{4CA8147E-BAA3-3A7F-92CE-A4FD7F17D8DA}'; + IID__BufferedStream: TGUID = '{4B7571C3-1275-3457-8FEE-9976FD3937E3}'; + IID__Directory: TGUID = '{8CE58FF5-F26D-38A4-9195-0E2ECB3B56B9}'; + IID__FileSystemInfo: TGUID = '{A5D29A57-36A8-3E36-A099-7458B1FABAA2}'; + IID__DirectoryInfo: TGUID = '{487E52F1-2BB9-3BD0-A0CA-6728B3A1D051}'; + IID__IOException: TGUID = '{C5BFC9BF-27A7-3A59-A986-44C85F3521BF}'; + IID__DirectoryNotFoundException: TGUID = '{C8A200E4-9735-30E4-B168-ED861A3020F2}'; + IID__EndOfStreamException: TGUID = '{D625AFD0-8FD9-3113-A900-43912A54C421}'; + IID__File: TGUID = '{5D59051F-E19D-329A-9962-FD00D552E13D}'; + IID__FileInfo: TGUID = '{C3C429F9-8590-3A01-B2B2-434837F3D16D}'; + IID__FileLoadException: TGUID = '{51D2C393-9B70-3551-84B5-FF5409FB3ADA}'; + IID__FileNotFoundException: TGUID = '{A15A976B-81E3-3EF4-8FF1-D75DDBE20AEF}'; + IID__FileStream: TGUID = '{74265195-4A46-3D6F-A9DD-69C367EA39C8}'; + IID__MemoryStream: TGUID = '{2DBC46FE-B3DD-3858-AFC2-D3A2D492A588}'; + IID__Path: TGUID = '{6DF93530-D276-31D9-8573-346778C650AF}'; + IID__PathTooLongException: TGUID = '{468B8EB4-89AC-381B-8F86-5E47EC0648B4}'; + IID__TextReader: TGUID = '{897471F2-9450-3F03-A41F-D2E1F1397854}'; + IID__StreamReader: TGUID = '{E645B470-DC3F-3CE0-8104-5837FEDA04B3}'; + IID__TextWriter: TGUID = '{556137EA-8825-30BC-9D49-E47A9DB034EE}'; + IID__StreamWriter: TGUID = '{1F124E1C-D05D-3643-A59F-C3DE6051994F}'; + IID__StringReader: TGUID = '{59733B03-0EA5-358C-95B5-659FCD9AA0B4}'; + IID__StringWriter: TGUID = '{CB9F94C0-D691-3B62-B0B2-3CE5309CFA62}'; + IID__AccessedThroughPropertyAttribute: TGUID = '{998DCF16-F603-355D-8C89-3B675947997F}'; + IID__CallConvCdecl: TGUID = '{A6C2239B-08E6-3822-9769-E3D4B0431B82}'; + IID__CallConvStdcall: TGUID = '{8E17A5CD-1160-32DC-8548-407E7C3827C9}'; + IID__CallConvThiscall: TGUID = '{FA73DD3D-A472-35ED-B8BE-F99A13581F72}'; + IID__CallConvFastcall: TGUID = '{3B452D17-3C5E-36C4-A12D-5E9276036CF8}'; + IID__RuntimeHelpers: TGUID = '{028A39F4-2061-3C98-897C-2F6B29370B9B}'; + IID__CustomConstantAttribute: TGUID = '{62CAF4A2-6A78-3FC7-AF81-A6BBF930761F}'; + IID__DateTimeConstantAttribute: TGUID = '{EF387020-B664-3ACD-A1D2-806345845953}'; + IID__DiscardableAttribute: TGUID = '{3C3A8C69-7417-32FA-AA20-762D85E1B594}'; + IID__DecimalConstantAttribute: TGUID = '{7E133967-CCEC-3E89-8BD2-6CFCA649ECBF}'; + IID__CompilationRelaxationsAttribute: TGUID = '{C5C4F625-2329-3382-8994-AAF561E5DFE9}'; + IID__CompilerGlobalScopeAttribute: TGUID = '{1EED213E-656A-3A73-A4B9-0D3B26FD942B}'; + IID__IDispatchConstantAttribute: TGUID = '{97D0B28A-6932-3D74-B67F-6BCD3C921E7D}'; + IID__IndexerNameAttribute: TGUID = '{243368F5-67C9-3510-9424-335A8A67772F}'; + IID__IsVolatile: TGUID = '{0278C819-0C06-3756-B053-601A3E566D9B}'; + IID__IUnknownConstantAttribute: TGUID = '{54542649-CE64-3F96-BCE5-FDE3BB22F242}'; + IID__MethodImplAttribute: TGUID = '{98966503-5D80-3242-83EF-79E136F6B954}'; + IID__RequiredAttributeAttribute: TGUID = '{DB2C11D9-3870-35E7-A10C-A3DDC3DC79B1}'; + IID_IStackWalk: TGUID = '{60FC57B0-4A46-32A0-A5B4-B05B0DE8E781}'; + IID__PermissionSet: TGUID = '{C2AF4970-4FB6-319C-A8AA-0614D27F2B2C}'; + IID__NamedPermissionSet: TGUID = '{BA3E053F-ADE3-3233-874A-16E624C9A49B}'; + IID__SecurityElement: TGUID = '{8D597C42-2CFD-32B6-B6D6-86C9E2CFF00A}'; + IID__XmlSyntaxException: TGUID = '{D9FCAD88-D869-3788-A802-1B1E007C7A22}'; + IID_IPermission: TGUID = '{A19B3FC6-D680-3DD4-A17A-F58A7D481494}'; + IID__CodeAccessPermission: TGUID = '{4803CE39-2F30-31FC-B84B-5A0141385269}'; + IID_IUnrestrictedPermission: TGUID = '{0F1284E6-4399-3963-8DDD-A6A4904F66C8}'; + IID__EnvironmentPermission: TGUID = '{0720590D-5218-352A-A337-5449E6BD19DA}'; + IID__FileDialogPermission: TGUID = '{A8B7138C-8932-3D78-A585-A91569C743AC}'; + IID__FileIOPermission: TGUID = '{A2ED7EFC-8E59-3CCC-AE92-EA2377F4D5EF}'; + IID__IsolatedStoragePermission: TGUID = '{7FEE7903-F97C-3350-AD42-196B00AD2564}'; + IID__IsolatedStorageFilePermission: TGUID = '{0D0C83E8-BDE1-3BA5-B1EF-A8FC686D8BC9}'; + IID__SecurityAttribute: TGUID = '{48815668-6C27-3312-803E-2757F55CE96A}'; + IID__CodeAccessSecurityAttribute: TGUID = '{9C5149CB-D3C6-32FD-A0D5-95350DE7B813}'; + IID__EnvironmentPermissionAttribute: TGUID = '{4164071A-ED12-3BDD-AF40-FDABCAA77D5F}'; + IID__FileDialogPermissionAttribute: TGUID = '{0CCCA629-440F-313E-96CD-BA1B4B4997F7}'; + IID__FileIOPermissionAttribute: TGUID = '{0DCA817D-F21A-3943-B54C-5E800CE5BC50}'; + IID__PrincipalPermissionAttribute: TGUID = '{68AB69E4-5D68-3B51-B74D-1BEAB9F37F2B}'; + IID__ReflectionPermissionAttribute: TGUID = '{D31EED10-A5F0-308F-A951-E557961EC568}'; + IID__RegistryPermissionAttribute: TGUID = '{38B6068C-1E94-3119-8841-1ECA35ED8578}'; + IID__SecurityPermissionAttribute: TGUID = '{3A5B876C-CDE4-32D2-9C7E-020A14ACA332}'; + IID__UIPermissionAttribute: TGUID = '{1D5C0F70-AF29-38A3-9436-3070A310C73B}'; + IID__ZoneIdentityPermissionAttribute: TGUID = '{2E3BE3ED-2F22-3B20-9F92-BD29B79D6F42}'; + IID__StrongNameIdentityPermissionAttribute: TGUID = '{C9A740F4-26E9-39A8-8885-8CA26BD79B21}'; + IID__SiteIdentityPermissionAttribute: TGUID = '{6FE6894A-2A53-3FB6-A06E-348F9BDAD23B}'; + IID__UrlIdentityPermissionAttribute: TGUID = '{CA4A2073-48C5-3E61-8349-11701A90DD9B}'; + IID__PublisherIdentityPermissionAttribute: TGUID = '{6722C730-1239-3784-AC94-C285AE5B901A}'; + IID__IsolatedStoragePermissionAttribute: TGUID = '{5C4C522F-DE4E-3595-9AA9-9319C86A5283}'; + IID__IsolatedStorageFilePermissionAttribute: TGUID = '{6F1F8AAE-D667-39CC-98FA-722BEBBBEAC3}'; + IID__PermissionSetAttribute: TGUID = '{947A1995-BC16-3E7C-B65A-99E71F39C091}'; + IID__PublisherIdentityPermission: TGUID = '{E86CC74A-1233-3DF3-B13F-8B27EEAAC1F6}'; + IID__ReflectionPermission: TGUID = '{AEB3727F-5C3A-34C4-BF18-A38F088AC8C7}'; + IID__RegistryPermission: TGUID = '{C3FB5510-3454-3B31-B64F-DE6AAD6BE820}'; + IID__PrincipalPermission: TGUID = '{7C6B06D1-63AD-35EF-A938-149B4AD9A71F}'; + IID__SecurityPermission: TGUID = '{33C54A2D-02BD-3848-80B6-742D537085E5}'; + IID__SiteIdentityPermission: TGUID = '{790B3EE9-7E06-3CD0-8243-5848486D6A78}'; + IID__StrongNameIdentityPermission: TGUID = '{5F1562FB-0160-3655-BAEA-B15BEF609161}'; + IID__StrongNamePublicKeyBlob: TGUID = '{AF53D21A-D6AF-3406-B399-7DF9D2AAD48A}'; + IID__UIPermission: TGUID = '{47698389-F182-3A67-87DF-AED490E14DC6}'; + IID__UrlIdentityPermission: TGUID = '{EC7CAC31-08A2-393B-BDF2-D052EB53AF2C}'; + IID__ZoneIdentityPermission: TGUID = '{38B2F8D7-8CF4-323B-9C17-9C55EE287A63}'; + IID__SuppressUnmanagedCodeSecurityAttribute: TGUID = '{8000E51A-541C-3B20-A8EC-C8A8B41116C4}'; + IID__UnverifiableCodeAttribute: TGUID = '{41F41C1B-7B8D-39A3-A28F-AAE20787F469}'; + IID__AllowPartiallyTrustedCallersAttribute: TGUID = '{F1C930C4-2233-3924-9840-231D008259B4}'; + IID__SecurityException: TGUID = '{F174290F-E4CF-3976-88AA-4F8E32EB03DB}'; + IID__SecurityManager: TGUID = '{ABC04B16-5539-3C7E-92EC-0905A4A24464}'; + IID__VerificationException: TGUID = '{F65070DF-57AF-3AE3-B951-D2AD7D513347}'; + IID_IContextAttribute: TGUID = '{4A68BAA3-27AA-314A-BDBB-6AE9BDFC0420}'; + IID_IContextProperty: TGUID = '{F01D896D-8D5F-3235-BE59-20E1E10DC22A}'; + IID__ContextAttribute: TGUID = '{F042505B-7AAC-313B-A8C7-3F1AC949C311}'; + IID_IActivator: TGUID = '{C02BBB79-5AA8-390D-927F-717B7BFF06A1}'; + IID_IMessageSink: TGUID = '{941F8AAA-A353-3B1D-A019-12E44377F1CD}'; + IID__AsyncResult: TGUID = '{3936ABE1-B29E-3593-83F1-793D1A7F3898}'; + IID__CallContext: TGUID = '{53BCE4D4-6209-396D-BD4A-0B0A0A177DF9}'; + IID_ILogicalThreadAffinative: TGUID = '{4D125449-BA27-3927-8589-3E1B34B622E5}'; + IID__LogicalCallContext: TGUID = '{9AFF21F5-1C9C-35E7-AEA4-C3AA0BEB3B77}'; + IID__ChannelServices: TGUID = '{FFB2E16E-E5C7-367C-B326-965ABF510F24}'; + IID_IClientResponseChannelSinkStack: TGUID = '{3AFAB213-F5A2-3241-93BA-329EA4BA8016}'; + IID_IClientChannelSinkStack: TGUID = '{3A5FDE6B-DB46-34E8-BACD-16EA5A440540}'; + IID__ClientChannelSinkStack: TGUID = '{E1796120-C324-30D8-86F4-20086711463B}'; + IID_IServerResponseChannelSinkStack: TGUID = '{9BE679A6-61FD-38FC-A7B2-89982D33338B}'; + IID_IServerChannelSinkStack: TGUID = '{E694A733-768D-314D-B317-DCEAD136B11D}'; + IID__ServerChannelSinkStack: TGUID = '{52DA9F90-89B3-35AB-907B-3562642967DE}'; + IID__InternalMessageWrapper: TGUID = '{EF926E1F-3EE7-32BC-8B01-C6E98C24BC19}'; + IID_IMessage: TGUID = '{1A8B0DE6-B825-38C5-B744-8F93075FD6FA}'; + IID_IMethodMessage: TGUID = '{8E5E0B95-750E-310D-892C-8CA7231CF75B}'; + IID_IMethodCallMessage: TGUID = '{B90EFAA6-25E4-33D2-ACA3-94BF74DC4AB9}'; + IID__MethodCallMessageWrapper: TGUID = '{C9614D78-10EA-3310-87EA-821B70632898}'; + IID_ISponsor: TGUID = '{675591AF-0508-3131-A7CC-287D265CA7D6}'; + IID__ClientSponsor: TGUID = '{FF19D114-3BDA-30AC-8E89-36CA64A87120}'; + IID__CrossContextDelegate: TGUID = '{EE949B7B-439F-363E-B9FC-34DB1FB781D7}'; + IID__Context: TGUID = '{11A2EA7A-D600-307B-A606-511A6C7950D1}'; + IID__ContextProperty: TGUID = '{4ACB3495-05DB-381B-890A-D12F5340DCA3}'; + IID_IContextPropertyActivator: TGUID = '{7197B56B-5FA1-31EF-B38B-62FEE737277F}'; + IID_IChannel: TGUID = '{563581E8-C86D-39E2-B2E8-6C23F7987A4B}'; + IID_IChannelSender: TGUID = '{10F1D605-E201-3145-B7AE-3AD746701986}'; + IID_IChannelReceiver: TGUID = '{48AD41DA-0872-31DA-9887-F81F213527E6}'; + IID_IServerChannelSinkProvider: TGUID = '{7DD6E975-24EA-323C-A98C-0FDE96F9C4E6}'; + IID_IChannelSinkBase: TGUID = '{308DE042-ACC8-32F8-B632-7CB9799D9AA6}'; + IID_IServerChannelSink: TGUID = '{21B5F37B-BEF3-354C-8F84-0F9F0863F5C5}'; + IID__EnterpriseServicesHelper: TGUID = '{77C9BCEB-9958-33C0-A858-599F66697DA7}'; + IID__Header: TGUID = '{0D296515-AD19-3602-B415-D8EC77066081}'; + IID__HeaderHandler: TGUID = '{5DBBAF39-A3DF-30B7-AAEA-9FD11394123F}'; + IID_IConstructionCallMessage: TGUID = '{FA28E3AF-7D09-31D5-BEEB-7F2626497CDE}'; + IID_IMethodReturnMessage: TGUID = '{F617690A-55F4-36AF-9149-D199831F8594}'; + IID_IConstructionReturnMessage: TGUID = '{CA0AB564-F5E9-3A7F-A80B-EB0AEEFA44E9}'; + IID_IChannelReceiverHook: TGUID = '{3A02D3F7-3F40-3022-853D-CFDA765182FE}'; + IID_IClientChannelSinkProvider: TGUID = '{3F8742C2-AC57-3440-A283-FE5FF4C75025}'; + IID_IClientFormatterSinkProvider: TGUID = '{6D94B6F3-DA91-3C2F-B876-083769667468}'; + IID_IServerFormatterSinkProvider: TGUID = '{042B5200-4317-3E4D-B653-7E9A08F1A5F2}'; + IID_IClientChannelSink: TGUID = '{FF726320-6B92-3E6C-AAAC-F97063D0B142}'; + IID_IClientFormatterSink: TGUID = '{46527C03-B144-3CF0-86B3-B8776148A6E9}'; + IID_IChannelDataStore: TGUID = '{1E250CCD-DC30-3217-A7E4-148F375A0088}'; + IID__ChannelDataStore: TGUID = '{AA6DA581-F972-36DE-A53B-7585428A68AB}'; + IID_ITransportHeaders: TGUID = '{1AC82FBE-4FF0-383C-BBFD-FE40ECB3628D}'; + IID__TransportHeaders: TGUID = '{65887F70-C646-3A66-8697-8A3F7D8FE94D}'; + IID__SinkProviderData: TGUID = '{A18545B7-E5EE-31EE-9B9B-41199B11C995}'; + IID__BaseChannelObjectWithProperties: TGUID = '{A1329EC9-E567-369F-8258-18366D89EAF8}'; + IID__BaseChannelSinkWithProperties: TGUID = '{8AF3451E-154D-3D86-80D8-F8478B9733ED}'; + IID__BaseChannelWithProperties: TGUID = '{94BB98ED-18BB-3843-A7FE-642824AB4E01}'; + IID_IContributeClientContextSink: TGUID = '{4DB956B7-69D0-312A-AA75-44FB55FD5D4B}'; + IID_IContributeDynamicSink: TGUID = '{A0FE9B86-0C06-32CE-85FA-2FF1B58697FB}'; + IID_IContributeEnvoySink: TGUID = '{124777B6-0308-3569-97E5-E6FE88EAE4EB}'; + IID_IContributeObjectSink: TGUID = '{6A5D38BC-2789-3546-81A1-F10C0FB59366}'; + IID_IContributeServerContextSink: TGUID = '{0CAA23EC-F78C-39C9-8D25-B7A9CE4097A7}'; + IID_IDynamicProperty: TGUID = '{00A358D4-4D58-3B9D-8FB6-FB7F6BC1713B}'; + IID_IDynamicMessageSink: TGUID = '{C74076BB-8A2D-3C20-A542-625329E9AF04}'; + IID_ILease: TGUID = '{53A561F2-CBBF-3748-BFFE-2180002DB3DF}'; + IID_IMessageCtrl: TGUID = '{3677CBB0-784D-3C15-BBC8-75CD7DC3901E}'; + IID_IRemotingFormatter: TGUID = '{AE1850FD-3596-3727-A242-2FC31C5A0312}'; + IID__LifetimeServices: TGUID = '{B0AD9A21-5439-3D88-8975-4018B828D74C}'; + IID__ReturnMessage: TGUID = '{0EEFF4C2-84BF-3E4E-BF22-B7BDBB5DF899}'; + IID__MethodCall: TGUID = '{95E01216-5467-371B-8597-4074402CCB06}'; + IID__ConstructionCall: TGUID = '{A2246AE7-EB81-3A20-8E70-C9FA341C7E10}'; + IID__MethodResponse: TGUID = '{9E9EA93A-D000-3AB9-BFCA-DDEB398A55B9}'; + IID_IFieldInfo: TGUID = '{CC18FD4D-AA2D-3AB4-9848-584BBAE4AB44}'; + IID__ConstructionResponse: TGUID = '{BE457280-6FFA-3E76-9822-83DE63C0C4E0}'; + IID__MethodReturnMessageWrapper: TGUID = '{89304439-A24F-30F6-9A8F-89CE472D85DA}'; + IID__ObjectHandle: TGUID = '{EA675B47-64E0-3B5F-9BE7-F7DC2990730D}'; + IID_IRemotingTypeInfo: TGUID = '{C09EFFA9-1FFE-3A52-A733-6236CBC45E7B}'; + IID_IChannelInfo: TGUID = '{855E6566-014A-3FE8-AA70-1EAC771E3A88}'; + IID_IEnvoyInfo: TGUID = '{2A6E91B9-A874-38E4-99C2-C5D83D78140D}'; + IID__ObjRef: TGUID = '{1DD3CF3D-DF8E-32FF-91EC-E19AA10B63FB}'; + IID__OneWayAttribute: TGUID = '{8FFEDC68-5233-3FA8-813D-405AABB33ECB}'; + IID__ProxyAttribute: TGUID = '{D80FF312-2930-3680-A5E9-B48296C7415F}'; + IID__RealProxy: TGUID = '{E0CF3F77-C7C3-33DA-BEB4-46147FC905DE}'; + IID__SoapAttribute: TGUID = '{725692A5-9E12-37F6-911C-E3DA77E5FACA}'; + IID__SoapTypeAttribute: TGUID = '{EBCDCD84-8C74-39FD-821C-F5EB3A2704D7}'; + IID__SoapMethodAttribute: TGUID = '{C58145B5-BD5A-3896-95D9-B358F54FBC44}'; + IID__SoapFieldAttribute: TGUID = '{46A3F9FF-F73C-33C7-BCC3-1BEF4B25E4AE}'; + IID__SoapParameterAttribute: TGUID = '{C32ABFC9-3917-30BF-A7BC-44250BDFC5D8}'; + IID__RemotingConfiguration: TGUID = '{4B10971E-D61D-373F-BC8D-2CCF31126215}'; + IID__System_Runtime_Remoting_TypeEntry: TGUID = '{8359F3AB-643F-3BCF-91E8-16E779EDEBE1}'; + IID__ActivatedClientTypeEntry: TGUID = '{BAC12781-6865-3558-A8D1-F1CADD2806DD}'; + IID__ActivatedServiceTypeEntry: TGUID = '{94855A3B-5CA2-32CF-B1AB-48FD3915822C}'; + IID__WellKnownClientTypeEntry: TGUID = '{4D0BC339-E3F9-3E9E-8F68-92168E6F6981}'; + IID__WellKnownServiceTypeEntry: TGUID = '{60B8B604-0AED-3093-AC05-EB98FB29FC47}'; + IID__RemotingException: TGUID = '{7264843F-F60C-39A9-99E1-029126AA0815}'; + IID__ServerException: TGUID = '{19373C44-55B4-3487-9AD8-4C621AAE85EA}'; + IID__RemotingTimeoutException: TGUID = '{44DB8E15-ACB1-34EE-81F9-56ED7AE37A5C}'; + IID__RemotingServices: TGUID = '{7B91368D-A50A-3D36-BE8E-5B8836A419AD}'; + IID__InternalRemotingServices: TGUID = '{F4EFB305-CDC4-31C5-8102-33C9B91774F3}'; + IID__MessageSurrogateFilter: TGUID = '{04A35D22-0B08-34E7-A573-88EF2374375E}'; + IID__RemotingSurrogateSelector: TGUID = '{551F7A57-8651-37DB-A94A-6A3CA09C0ED7}'; + IID__SoapServices: TGUID = '{7416B6EE-82E8-3A16-966B-018A40E7B1AA}'; + IID_ISoapXsd: TGUID = '{80031D2A-AD59-3FB4-97F3-B864D71DA86B}'; + IID__SoapDateTime: TGUID = '{1738ADBC-156E-3897-844F-C3147C528DEA}'; + IID__SoapDuration: TGUID = '{7EF50DDB-32A5-30A1-B412-47FAB911404A}'; + IID__SoapTime: TGUID = '{A3BF0BCD-EC32-38E6-92F2-5F37BAD8030D}'; + IID__SoapDate: TGUID = '{CFA6E9D2-B3DE-39A6-94D1-CC691DE193F8}'; + IID__SoapYearMonth: TGUID = '{103C7EF9-A9EE-35FB-84C5-3086C9725A20}'; + IID__SoapYear: TGUID = '{C20769F3-858D-316A-BE6D-C347A47948AD}'; + IID__SoapMonthDay: TGUID = '{F9EAD0AA-4156-368F-AE05-FD59D70F758D}'; + IID__SoapDay: TGUID = '{D9E8314D-5053-3497-8A33-97D3DCFE33E2}'; + IID__SoapMonth: TGUID = '{B4E32423-E473-3562-AA12-62FDE5A7D4A2}'; + IID__SoapHexBinary: TGUID = '{63B9DA95-FB91-358A-B7B7-90C34AA34AB7}'; + IID__SoapBase64Binary: TGUID = '{8ED115A1-5E7B-34DC-AB85-90316F28015D}'; + IID__SoapInteger: TGUID = '{30C65C40-4E54-3051-9D8F-4709B6AB214C}'; + IID__SoapPositiveInteger: TGUID = '{4979EC29-C2B7-3AD6-986D-5AAF7344CC4E}'; + IID__SoapNonPositiveInteger: TGUID = '{AAF5401E-F71C-3FE3-8A73-A25074B20D3A}'; + IID__SoapNonNegativeInteger: TGUID = '{BC261FC6-7132-3FB5-9AAC-224845D3AA99}'; + IID__SoapNegativeInteger: TGUID = '{E384AA10-A70C-3943-97CF-0F7C282C3BDC}'; + IID__SoapAnyUri: TGUID = '{818EC118-BE7E-3CDE-92C8-44B99160920E}'; + IID__SoapQName: TGUID = '{3AC646B6-6B84-382F-9AED-22C2433244E6}'; + IID__SoapNotation: TGUID = '{974F01F4-6086-3137-9448-6A31FC9BEF08}'; + IID__SoapNormalizedString: TGUID = '{F4926B50-3F23-37E0-9AFA-AA91FF89A7BD}'; + IID__SoapToken: TGUID = '{AB4E97B9-651D-36F4-AABA-28ACF5746624}'; + IID__SoapLanguage: TGUID = '{14AED851-A168-3462-B877-8F9A01126653}'; + IID__SoapName: TGUID = '{5EB06BEF-4ADF-3CC1-A6F2-62F76886B13A}'; + IID__SoapIdrefs: TGUID = '{7947A829-ADB5-34D0-9CC8-6C172742C803}'; + IID__SoapEntities: TGUID = '{ACA96DA3-96ED-397E-8A72-EE1BE1025F5E}'; + IID__SoapNmtoken: TGUID = '{E941FA15-E6C8-3DD4-B060-C0DDFBC0240A}'; + IID__SoapNmtokens: TGUID = '{A5E385AE-27FB-3708-BAF7-0BF1F3955747}'; + IID__SoapNcName: TGUID = '{725CDAF7-B739-35C1-8463-E2A923E1F618}'; + IID__SoapId: TGUID = '{6A46B6A2-2D2C-3C67-AF67-AAE0175F17AE}'; + IID__SoapIdref: TGUID = '{7DB7FD83-DE89-38E1-9645-D4CABDE694C0}'; + IID__SoapEntity: TGUID = '{37171746-B784-3586-A7D5-692A7604A66B}'; + IID__SynchronizationAttribute: TGUID = '{2D985674-231C-33D4-B14D-F3A6BD2EBE19}'; + IID_ITrackingHandler: TGUID = '{03EC7D10-17A5-3585-9A2E-0596FCAC3870}'; + IID__TrackingServices: TGUID = '{F51728F2-2DEF-308C-874A-CBB1BAA9CF9E}'; + IID__UrlAttribute: TGUID = '{717105A3-739B-3BC3-A2B7-AD215903FAD2}'; + IID__IsolatedStorage: TGUID = '{34EC3BD7-F2F6-3C20-A639-804BFF89DF65}'; + IID__IsolatedStorageFile: TGUID = '{6BBB7DEE-186F-3D51-9486-BE0A71E915CE}'; + IID__IsolatedStorageFileStream: TGUID = '{68D5592B-47C8-381A-8D51-3925C16CF025}'; + IID__IsolatedStorageException: TGUID = '{AEC2B0DE-9898-3607-B845-63E2E307CB5F}'; + IID_INormalizeForIsolatedStorage: TGUID = '{F5006531-D4D7-319E-9EDA-9B4B65AD8D4F}'; + IID_ISoapMessage: TGUID = '{E699146C-7793-3455-9BEF-964C90D8F995}'; + IID__InternalRM: TGUID = '{361A5049-1BC8-35A9-946A-53A877902F25}'; + IID__InternalST: TGUID = '{A864FB13-F945-3DC0-A01C-B903F944FC97}'; + IID__SoapMessage: TGUID = '{BC0847B2-BD5C-37B3-BA67-7D2D54B17238}'; + IID__SoapFault: TGUID = '{A1C392FC-314C-39D5-8DE6-1F8EBCA0A1E2}'; + IID__ServerFault: TGUID = '{02D1BD78-3BB6-37AD-A9F8-F7D5DA273E4E}'; + IID__BinaryFormatter: TGUID = '{3BCF0CB2-A849-375E-8189-1BA5F1F4A9B0}'; + IID__AssemblyBuilder: TGUID = '{BEBB2505-8B54-3443-AEAD-142A16DD9CC7}'; + IID__ConstructorBuilder: TGUID = '{ED3E4384-D7E2-3FA7-8FFD-8940D330519A}'; + IID__EventBuilder: TGUID = '{AADABA99-895D-3D65-9760-B1F12621FAE8}'; + IID__FieldBuilder: TGUID = '{CE1A3BF5-975E-30CC-97C9-1EF70F8F3993}'; + IID__ILGenerator: TGUID = '{A4924B27-6E3B-37F7-9B83-A4501955E6A7}'; + IID__LocalBuilder: TGUID = '{4E6350D1-A08B-3DEC-9A3E-C465F9AEEC0C}'; + IID__MethodBuilder: TGUID = '{007D8A14-FDF3-363E-9A0B-FEC0618260A2}'; + IID__CustomAttributeBuilder: TGUID = '{BE9ACCE8-AAFF-3B91-81AE-8211663F5CAD}'; + IID__MethodRental: TGUID = '{C2323C25-F57F-3880-8A4D-12EBEA7A5852}'; + IID__ModuleBuilder: TGUID = '{D05FFA9A-04AF-3519-8EE1-8D93AD73430B}'; + IID__OpCodes: TGUID = '{1DB1CC2A-DA73-389E-828B-5C616F4FAC49}'; + IID__ParameterBuilder: TGUID = '{36329EBA-F97A-3565-BC07-0ED5C6EF19FC}'; + IID__PropertyBuilder: TGUID = '{15F9A479-9397-3A63-ACBD-F51977FB0F02}'; + IID__SignatureHelper: TGUID = '{7D13DD37-5A04-393C-BBCA-A5FEA802893D}'; + IID__TypeBuilder: TGUID = '{7E5678EE-48B3-3F83-B076-C58543498A58}'; + IID__EnumBuilder: TGUID = '{C7BD73DE-9F85-3290-88EE-090B8BDFE2DF}'; + CLASS_AppDomainSetup: TGUID = '{3E8E0F03-D3FD-3A93-BAE0-C74A6494DBCA}'; + CLASS_Object_: TGUID = '{81C5FE01-027C-3E1C-98D5-DA9C9862AA21}'; + CLASS_Array_: TGUID = '{200FB91C-815D-39E0-9E07-0E1BDB2ED47B}'; + CLASS_String_: TGUID = '{296AFBFF-1B0B-3FF5-9D6C-4E7E599F8B57}'; + CLASS_StringBuilder: TGUID = '{E724B749-18D6-36AB-9F6D-09C36D9C6016}'; + CLASS_Exception: TGUID = '{A1C0A095-DF97-3441-BFC1-C9F194E494DB}'; + CLASS_ValueType: TGUID = '{CE8AD32F-B6DB-31EA-9F1E-C2424E0F5EEE}'; + CLASS_SystemException: TGUID = '{4224AC84-9B11-3561-8923-C893CA77ACBE}'; + CLASS_OutOfMemoryException: TGUID = '{CCF306AE-33BD-3003-9CCE-DAF5BEFEF611}'; + CLASS_StackOverflowException: TGUID = '{9C125A6F-EAE2-3FC1-97A1-C0DCEAB0B5DF}'; + CLASS_ExecutionEngineException: TGUID = '{E786FB32-B659-3D96-94C4-E1A9FC037868}'; + CLASS_Delegate: TGUID = '{03CE85F6-37CB-3588-B3DB-D5628BB1335B}'; + CLASS_MulticastDelegate: TGUID = '{198FFBDE-A6DB-3CC3-AB15-FBBB7250D624}'; + CLASS_Enum: TGUID = '{C43345B9-7FED-3FC7-8FC2-7B1B82BC109E}'; + CLASS_MemberAccessException: TGUID = '{0FF66430-C796-3EE7-902B-166C402CA288}'; + CLASS_Activator: TGUID = '{9BA4FD4E-2BC2-31A0-B721-D17ABA5B12C3}'; + CLASS_ApplicationException: TGUID = '{682D63B8-1692-31BE-88CD-5CB1F79EDB7B}'; + CLASS_EventArgs: TGUID = '{3FB717AF-9D21-3016-871A-DF817ABDDD51}'; + CLASS_ResolveEventArgs: TGUID = '{1C1D34A9-3F45-3B51-A9AF-0354975BF8CC}'; + CLASS_AssemblyLoadEventArgs: TGUID = '{81548590-3849-32A8-AA6F-F2B3137CF4A3}'; + CLASS_ResolveEventHandler: TGUID = '{A4B8C851-941A-3DEE-BD08-D9E2EED101C5}'; + CLASS_AssemblyLoadEventHandler: TGUID = '{2E130DC8-564E-397F-A628-397709DA52E9}'; + CLASS_MarshalByRefObject: TGUID = '{14B542C6-1C5A-3869-B8F8-FEEFD7B29D09}'; + CLASS_CrossAppDomainDelegate: TGUID = '{496219C1-3FB7-3DCF-8AF7-D56032F7891F}'; + CLASS_Attribute: TGUID = '{1765714B-E628-34C3-B66F-7686FAF462DA}'; + CLASS_LoaderOptimizationAttribute: TGUID = '{B39742FD-1A55-3810-9EA5-F6E86EBEB472}'; + CLASS_AppDomainUnloadedException: TGUID = '{61B3E12B-3586-3A58-A497-7ED7C4C794B9}'; + CLASS_ArgumentException: TGUID = '{3FDCEEC6-B14B-37E2-BB69-ABC7CA0DA22F}'; + CLASS_ArgumentNullException: TGUID = '{3BD1F243-9BC4-305D-9B1C-0D10C80329FC}'; + CLASS_ArgumentOutOfRangeException: TGUID = '{74BDD0B9-38D7-3FDA-A67E-D404EE684F24}'; + CLASS_ArithmeticException: TGUID = '{647053C3-1879-34D7-AE57-67015C91FC70}'; + CLASS_ArrayTypeMismatchException: TGUID = '{676E1164-752C-3A74-8D3F-BCD32A2026D6}'; + CLASS_AsyncCallback: TGUID = '{B2A87DDB-5DAB-395F-B7BE-AD83058FB516}'; + CLASS_AttributeUsageAttribute: TGUID = '{53A62BB1-75B9-3B52-AE98-92AFD573CDB1}'; + CLASS_BadImageFormatException: TGUID = '{E9148312-A9BF-3A45-BBCA-350967FD78F5}'; + CLASS_BitConverter: TGUID = '{450AD484-5D18-3A7A-8B24-A228680FD885}'; + CLASS_Buffer: TGUID = '{830FE109-4566-3AF2-9B57-5602724FCACE}'; + CLASS_CannotUnloadAppDomainException: TGUID = '{29C69707-875F-3678-8F01-283094A2DFB1}'; + CLASS_CharEnumerator: TGUID = '{277EABD6-F03A-3C52-8B42-B8E326D9C0CC}'; + CLASS_CLSCompliantAttribute: TGUID = '{15DBEC24-0E2D-3DB2-AF66-932203215895}'; + CLASS_TypeUnloadedException: TGUID = '{D6D2034D-5F67-30D7-9CC5-452F2C46694F}'; + CLASS_Console: TGUID = '{1929386A-E10F-3B73-84A1-F50E745332F0}'; + CLASS_ContextMarshalException: TGUID = '{CBEAA915-4D2C-3F77-98E8-A258B0FD3CEF}'; + CLASS_Convert: TGUID = '{5CB28930-956D-3ED0-B569-AC70F15470F9}'; + CLASS_ContextBoundObject: TGUID = '{7916CBEF-050E-3E39-B83A-5AB9558E72F1}'; + CLASS_ContextStaticAttribute: TGUID = '{96705EE3-F7AB-3E9A-9FB2-AD1D536E901A}'; + CLASS_TimeZone: TGUID = '{543C0DD8-A713-3777-B01A-AEB801DAC001}'; + CLASS_DBNull: TGUID = '{8C1A4524-3CEB-3436-B449-CAC456ECAB09}'; + CLASS_Binder: TGUID = '{74A6B90C-8710-32DA-BBF7-9D4445E071E9}'; + CLASS_DivideByZeroException: TGUID = '{F6914A11-D95D-324F-BA0F-39A374625290}'; + CLASS_DuplicateWaitObjectException: TGUID = '{CC20C6DF-A054-3F09-A5F5-A3B5A25F4CE6}'; + CLASS_TypeLoadException: TGUID = '{112BC2E7-9EF9-3648-AF9E-45C0D4B89929}'; + CLASS_EntryPointNotFoundException: TGUID = '{AD326409-BF80-3E0C-BA6F-EE2C33B675A5}'; + CLASS_DllNotFoundException: TGUID = '{46E97093-B2EC-3787-A9A5-470D1A27417C}'; + CLASS_Environment: TGUID = '{DF81B4FF-7226-30FA-84DF-80795BA1A642}'; + CLASS_EventHandler: TGUID = '{DCA836DE-C23D-334C-86B7-8385BE47030D}'; + CLASS_FieldAccessException: TGUID = '{BDA7BEE5-85F1-3B66-B610-DDF1D5898006}'; + CLASS_FlagsAttribute: TGUID = '{66CE75D4-0334-3CA6-BCA8-CE9AF28A4396}'; + CLASS_FormatException: TGUID = '{964AA3BD-4B12-3E23-9D7F-99342AFAE812}'; + CLASS_GC: TGUID = '{F87CDD00-CBF2-365C-BC2D-78CECD0CBF49}'; + CLASS_IndexOutOfRangeException: TGUID = '{5CA9971B-2DC3-3BC8-847A-5E6D15CBB16E}'; + CLASS_InvalidCastException: TGUID = '{7F6BCBE5-EB30-370B-9F1B-92A6265AFEDD}'; + CLASS_InvalidOperationException: TGUID = '{9546306B-1B68-33AF-80DB-3A9206501515}'; + CLASS_InvalidProgramException: TGUID = '{91591469-EFEF-3D63-90F9-88520F0AA1EF}'; + CLASS_LocalDataStoreSlot: TGUID = '{E95E800A-CBA4-3613-821D-6D6EF3BCBF6B}'; + CLASS_Math: TGUID = '{40CE262D-D951-3EB6-9B05-48A1EB4D0EBC}'; + CLASS_MethodAccessException: TGUID = '{92E76A74-2622-3AA9-A3CA-1AE8BD7BC4A8}'; + CLASS_MissingMemberException: TGUID = '{CDC70043-D56B-3799-B7BD-6113BBCA160A}'; + CLASS_MissingFieldException: TGUID = '{8D36569B-14D6-3C3D-B55C-9D02A45BFC3D}'; + CLASS_MissingMethodException: TGUID = '{58897D76-EF6C-327A-93F7-6CD66C424E11}'; + CLASS_MulticastNotSupportedException: TGUID = '{9DA2F8B8-59F0-3852-B509-0663E3BF643B}'; + CLASS_NonSerializedAttribute: TGUID = '{CC77F5F3-222D-3586-88C3-410477A3B65D}'; + CLASS_NotFiniteNumberException: TGUID = '{7E34AB89-0684-3B86-8A0F-E638EB4E6252}'; + CLASS_NotImplementedException: TGUID = '{F8BE2AD5-4E99-3E00-B10E-7C54D31C1C1D}'; + CLASS_NotSupportedException: TGUID = '{DAFB2462-2A5B-3818-B17E-602984FE1BB0}'; + CLASS_NullReferenceException: TGUID = '{7F71DB2D-1EA0-3CAE-8087-26095F5215E6}'; + CLASS_ObjectDisposedException: TGUID = '{F17BAAF6-D35C-3C6E-ACD3-D0D49A5022C4}'; + CLASS_ObsoleteAttribute: TGUID = '{08295C62-7462-3633-B35E-7AE68ACA3948}'; + CLASS_OperatingSystem: TGUID = '{D7CA3B25-A57B-354C-8758-9FE3A905C1AC}'; + CLASS_OverflowException: TGUID = '{4286FA72-A2FA-3245-8751-D4206070A191}'; + CLASS_ParamArrayAttribute: TGUID = '{3495E5FA-2A90-3CA7-B3B5-58736C4441DD}'; + CLASS_PlatformNotSupportedException: TGUID = '{A36738B5-FA8F-3316-A929-68099A32B43B}'; + CLASS_Random: TGUID = '{4E77EC8F-51D8-386C-85FE-7DC931B7A8E7}'; + CLASS_RankException: TGUID = '{C9F61CBD-287F-3D24-9FEB-2C3F347CF570}'; + CLASS_MemberInfo: TGUID = '{5AE028B5-9A3A-32A9-899C-1DEEFB85CC50}'; + CLASS_Type_: TGUID = '{6C9863DC-7207-327F-A048-C3BB63474BFC}'; + CLASS_SerializableAttribute: TGUID = '{89BCC804-53A5-3EB2-A342-6282CC410260}'; + CLASS_TypeInitializationException: TGUID = '{811FB5F2-9BFE-3557-83DE-1279F0B3EB55}'; + CLASS_UnauthorizedAccessException: TGUID = '{75215200-A2FE-30F6-A34B-8F1A1830358E}'; + CLASS_UnhandledExceptionEventArgs: TGUID = '{B55DAE2E-C8E8-3C48-B404-D991979A9D9D}'; + CLASS_UnhandledExceptionEventHandler: TGUID = '{DB4D2D94-3FA3-36F5-B22E-A00FF22F08BD}'; + CLASS_Version: TGUID = '{43CD41AD-3B78-3531-9031-3059E0AA64EB}'; + CLASS_WeakReference: TGUID = '{D3F54E92-A0C7-3BF4-A114-F1F384CE3EFF}'; + CLASS_WaitHandle: TGUID = '{4D0E564A-78C8-31E0-BA03-73AF7BDFF5A9}'; + CLASS_AutoResetEvent: TGUID = '{E35AF4DD-EB37-39FC-9071-4CE39B1A54BE}'; + CLASS_CompressedStack: TGUID = '{F3CE7312-70AE-37FF-98F6-CF1DCB22B9E4}'; + CLASS_Interlocked: TGUID = '{6AFBF244-9AB3-37D7-B4D4-357A72B76DE1}'; + CLASS_ManualResetEvent: TGUID = '{17A355C3-C65E-3F26-8A80-236890EBC997}'; + CLASS_Monitor: TGUID = '{9E97213A-0B49-3C05-A0BF-D203C4FC8487}'; + CLASS_Mutex: TGUID = '{D74D613D-F27F-311B-A9A3-27EBC63A1A5D}'; + CLASS_Overlapped: TGUID = '{7FE87A55-1321-3D9F-8FEF-CD2F5E8AB2E9}'; + CLASS_ReaderWriterLock: TGUID = '{9173D971-B142-38A5-8488-D10A9DCF71B0}'; + CLASS_SynchronizationLockException: TGUID = '{48A75519-CB7A-3D18-B91E-BE62EE842A3E}'; + CLASS_Thread: TGUID = '{A5889AAD-36A6-3B3E-89F9-118CE3A77D7C}'; + CLASS_ThreadAbortException: TGUID = '{EA1CF67D-7904-36A3-BD5B-DD028985861C}'; + CLASS_STAThreadAttribute: TGUID = '{50AAD4C2-61FA-3B1F-8157-5BA3B27AEE61}'; + CLASS_MTAThreadAttribute: TGUID = '{B406AC70-4D7E-3D24-B241-AEAEAC343BD9}'; + CLASS_ThreadInterruptedException: TGUID = '{27E986E1-BAEC-3D48-82E4-14169CA8CECF}'; + CLASS_RegisteredWaitHandle: TGUID = '{50F8AE2B-69F0-37EF-954B-D2618E3E8267}'; + CLASS_WaitCallback: TGUID = '{D8E04CC2-F4F5-367D-A23F-F71AFF4F14F3}'; + CLASS_WaitOrTimerCallback: TGUID = '{3C8C9F02-2C23-39FF-AC7B-CD0EE1D14A79}'; + CLASS_IOCompletionCallback: TGUID = '{8A937E3B-9C07-3D4D-B50A-4F4F3C85317C}'; + CLASS_ThreadPool: TGUID = '{F18C1BBB-EFA1-3789-8CDF-2D89E83834E5}'; + CLASS_ThreadStart: TGUID = '{E7AC1E4D-35DB-3432-A032-E94C012B2D39}'; + CLASS_ThreadStateException: TGUID = '{3E5509F0-1FB9-304D-8174-75D6C9AFE5DA}'; + CLASS_ThreadStaticAttribute: TGUID = '{FFC9F9AE-E87A-3252-8E25-B22423A40065}'; + CLASS_Timeout: TGUID = '{5A49B766-B474-3501-901E-5BDAC8B48A3D}'; + CLASS_TimerCallback: TGUID = '{DDF7BA7F-4B7C-378D-A153-6285B84C6593}'; + CLASS_Timer: TGUID = '{490CA7A8-D03F-3459-8208-D428EA010DA0}'; + CLASS_ArrayList: TGUID = '{6896B49D-7AFB-34DC-934E-5ADD38EEEE39}'; + CLASS_BitArray: TGUID = '{5D2FB755-C658-3F51-86F2-881F4A1A2A55}'; + CLASS_CaseInsensitiveComparer: TGUID = '{35E946E4-7CDA-3824-8B24-D799A96309AD}'; + CLASS_CaseInsensitiveHashCodeProvider: TGUID = '{47D3C68D-7D85-3227-A9E7-88451D6BADFC}'; + CLASS_CollectionBase: TGUID = '{87259279-9F5D-3C0A-BB58-723A2A6E4DBA}'; + CLASS_Comparer: TGUID = '{8A63140F-7EB8-3F4E-BA59-19B8C747843F}'; + CLASS_DictionaryBase: TGUID = '{9840C5C3-21D3-3B8A-94C1-3FC542B0227E}'; + CLASS_Hashtable: TGUID = '{146855FA-309F-3D0E-BB3E-DF525F30A715}'; + CLASS_Queue: TGUID = '{7F976B72-4B71-3858-BEE8-8E3A3189A651}'; + CLASS_ReadOnlyCollectionBase: TGUID = '{B66406BD-746D-3D10-98A1-41D097CF42B7}'; + CLASS_SortedList: TGUID = '{026CC6D7-34B2-33D5-B551-CA31EB6CE345}'; + CLASS_Stack: TGUID = '{4599202D-460F-3FB7-8A1C-C2CC6ED6C7C8}'; + CLASS_ConditionalAttribute: TGUID = '{75B3810E-F2D5-36E2-8D27-514EBCAD4511}'; + CLASS_Debugger: TGUID = '{91F672A3-6B82-3E04-B2D7-BAC5D6676609}'; + CLASS_DebuggerStepThroughAttribute: TGUID = '{93F551D6-2F9E-301B-BE63-85AEF508CAE0}'; + CLASS_DebuggerHiddenAttribute: TGUID = '{41970D73-92F6-36D9-874D-3BD0762A0D6F}'; + CLASS_DebuggableAttribute: TGUID = '{DF1F67B4-74F7-30AF-922D-29F0B91ABC25}'; + CLASS_StackTrace: TGUID = '{405C2D81-315B-3CB0-8442-EF5A38D4C3B8}'; + CLASS_StackFrame: TGUID = '{14910622-09D4-3B4A-8C1E-9991DBDCC553}'; + CLASS_SymDocumentType: TGUID = '{40AE2088-CE00-33AD-9320-5D201CB46FC9}'; + CLASS_SymLanguageType: TGUID = '{5A18D43E-115B-3B8B-8245-9A06B204B717}'; + CLASS_SymLanguageVendor: TGUID = '{DFD888A7-A6B0-3B1B-985E-4CDAB0E4C17D}'; + CLASS_AmbiguousMatchException: TGUID = '{2846AE5E-A9FA-36CF-B2D1-6E95596DBDE7}'; + CLASS_ModuleResolveEventHandler: TGUID = '{AAAA10C6-9902-3DBB-B173-EBA1EBA2CD5E}'; + CLASS_Assembly: TGUID = '{28E89A9F-E67D-3028-AA1B-E5EBCDE6F3C8}'; + CLASS_AssemblyCultureAttribute: TGUID = '{4265AB21-A68F-38A9-98D8-5D62B8035EA0}'; + CLASS_AssemblyVersionAttribute: TGUID = '{2D0FA06F-88FD-3643-8DBC-1F428A2B1A3B}'; + CLASS_AssemblyKeyFileAttribute: TGUID = '{FF408450-1DB9-3203-84EC-B70A01F48A06}'; + CLASS_AssemblyKeyNameAttribute: TGUID = '{3DACE301-6C51-3BF7-B975-E4A05F00FD4D}'; + CLASS_AssemblyDelaySignAttribute: TGUID = '{4804184F-4741-396B-AF5B-71134937F21A}'; + CLASS_AssemblyAlgorithmIdAttribute: TGUID = '{0D052B0A-23D1-3BAC-85EE-4E764B814CEE}'; + CLASS_AssemblyFlagsAttribute: TGUID = '{4554ED74-4243-3E7C-9B33-E9A89379C4F1}'; + CLASS_AssemblyFileVersionAttribute: TGUID = '{14152CB5-DC51-3C42-8A43-09854DEA1B8F}'; + CLASS_AssemblyName: TGUID = '{F12FDE6A-9394-3C32-8E4D-F3D470947284}'; + CLASS_AssemblyNameProxy: TGUID = '{3F4A4283-6A08-3E90-A976-2C2D3BE4EB0B}'; + CLASS_AssemblyCopyrightAttribute: TGUID = '{8687959F-D86D-3217-8D58-BE9A0427BB84}'; + CLASS_AssemblyTrademarkAttribute: TGUID = '{E64C95DF-EADC-3D08-9C6F-80F29D92CB4E}'; + CLASS_AssemblyProductAttribute: TGUID = '{CFE2BCF1-683C-39B5-83CE-4B186A521513}'; + CLASS_AssemblyCompanyAttribute: TGUID = '{62342FB2-16BF-30A9-88AD-6BC781EEC94F}'; + CLASS_AssemblyDescriptionAttribute: TGUID = '{432E5E9F-03BA-37B2-8EDF-7FAC14B03B4F}'; + CLASS_AssemblyTitleAttribute: TGUID = '{51B4F67C-2FCB-391D-A381-D040100D6717}'; + CLASS_AssemblyConfigurationAttribute: TGUID = '{09DD9840-5E39-317A-AAB3-0A467998DE25}'; + CLASS_AssemblyDefaultAliasAttribute: TGUID = '{8BEB1256-5D9B-3262-BF85-BEB6287E4EEA}'; + CLASS_AssemblyInformationalVersionAttribute: TGUID = '{894593B9-99E5-3B61-A592-EE44B9396277}'; + CLASS_CustomAttributeFormatException: TGUID = '{D5CB383D-99F4-3C7E-A9C3-85B53661448F}'; + CLASS_MethodBase: TGUID = '{CA308C9F-3B97-3152-ACFA-8AB23C17DF73}'; + CLASS_ConstructorInfo: TGUID = '{0A541F87-EBD7-36A0-9A7D-9BBF86188766}'; + CLASS_DefaultMemberAttribute: TGUID = '{CF452B26-6040-3ACB-9C72-CE5BB86E5046}'; + CLASS_EventInfo: TGUID = '{15762CA5-BC5C-3B86-A450-ACF32FC98AA5}'; + CLASS_FieldInfo: TGUID = '{98BA57DC-4CF2-3ED1-B4A2-890C21BBBF4B}'; + CLASS_InvalidFilterCriteriaException: TGUID = '{7B938A6F-77BF-351C-A712-69483C91115D}'; + CLASS_ManifestResourceInfo: TGUID = '{F695C021-DCF5-397B-A300-EDAA51DA5A5B}'; + CLASS_MemberFilter: TGUID = '{F52FD74C-ADA6-38CC-AE0F-693AFB9B9A8F}'; + CLASS_MethodInfo: TGUID = '{0E22CC27-CA1E-3138-9640-BE831F721659}'; + CLASS_Missing: TGUID = '{D5FAAC26-DB25-34E7-ADBD-AD5ED51F9433}'; + CLASS_Module: TGUID = '{128191C5-B188-3054-81B7-E4F588EACF0E}'; + CLASS_ParameterInfo: TGUID = '{E5CE8078-0CA7-3578-80DB-F20FCA8786A6}'; + CLASS_Pointer: TGUID = '{0517463E-1139-3970-BFA9-DCC997B23E7C}'; + CLASS_PropertyInfo: TGUID = '{BFDF1F57-230D-394A-B773-D9EC58CBEF9A}'; + CLASS_ReflectionTypeLoadException: TGUID = '{843B19AD-A02B-3852-AC56-FDC798935630}'; + CLASS_StrongNameKeyPair: TGUID = '{D633F013-0563-312A-B9D6-D067A7D59231}'; + CLASS_TargetException: TGUID = '{0D23F8B4-F2A6-3EFF-9D37-BDF79AC6B440}'; + CLASS_TargetInvocationException: TGUID = '{03D016E3-CAE1-3068-880E-AF8D08D517F0}'; + CLASS_TargetParameterCountException: TGUID = '{DA317BE2-1A0D-37B3-83F2-A0F32787FC67}'; + CLASS_TypeDelegator: TGUID = '{19E2E2F7-B53C-366B-8840-ABA2F8CB98B5}'; + CLASS_TypeFilter: TGUID = '{37E24F25-5EF0-366F-9D0F-F7B9E3EDFFD9}'; + CLASS_UnmanagedMarshal: TGUID = '{E3C3A258-E508-3704-B9EB-264601956FE5}'; + CLASS_Formatter: TGUID = '{E6854C08-0666-3939-BDF1-E1555A2C49FA}'; + CLASS_FormatterConverter: TGUID = '{D23D2F41-1D69-3E03-A275-32AE381223AC}'; + CLASS_FormatterServices: TGUID = '{688C32EA-1E9C-3A4B-90E0-A4D2A1D73F3F}'; + CLASS_ObjectIDGenerator: TGUID = '{4F272C37-F0A8-350C-867B-2C03B2B16B80}'; + CLASS_ObjectManager: TGUID = '{C3A27C9A-5F79-3B7A-963D-39B1E5202B55}'; + CLASS_SerializationBinder: TGUID = '{25D97DB7-BDC3-3205-B86B-956B852ECE76}'; + CLASS_SerializationInfo: TGUID = '{D69398C1-7541-33E7-B544-A803F380FFB6}'; + CLASS_SerializationInfoEnumerator: TGUID = '{341BA870-B7FE-3CBC-9A72-B7894C6EC171}'; + CLASS_SerializationException: TGUID = '{57154C7C-EDB2-3BFD-A8BA-924C60913EBF}'; + CLASS_SurrogateSelector: TGUID = '{88C8A919-EB24-3CCA-84F7-2EA82BB3F3ED}'; + CLASS_Calendar: TGUID = '{8A93390F-4331-317F-B450-1E0E4914E335}'; + CLASS_CompareInfo: TGUID = '{6747FF61-F8DA-3689-BB01-47F2266AE261}'; + CLASS_CultureInfo: TGUID = '{348A8C6D-464A-3F21-856B-061370D54599}'; + CLASS_DateTimeFormatInfo: TGUID = '{70A738D1-1BC5-3175-BD42-603E2B82C08B}'; + CLASS_DaylightTime: TGUID = '{5050FE97-72A6-3BC6-92F2-9DD0413041E3}'; + CLASS_GregorianCalendar: TGUID = '{68F8AEA9-1968-35B9-8A0E-6FDC637A4F8E}'; + CLASS_HebrewCalendar: TGUID = '{2206D773-CA1C-3258-9456-CEB7706C3710}'; + CLASS_HijriCalendar: TGUID = '{EE832CE3-06CA-33EF-8F01-61C7C218BD7E}'; + CLASS_JapaneseCalendar: TGUID = '{374050DD-6190-3257-8812-8230BF095147}'; + CLASS_JulianCalendar: TGUID = '{5C3E6CE8-B218-3762-883C-91BC987CDC2D}'; + CLASS_KoreanCalendar: TGUID = '{1A06A4DC-E239-3717-89E1-D0683F3A5320}'; + CLASS_RegionInfo: TGUID = '{0C630393-7583-333C-AB5D-CB10B910F69B}'; + CLASS_SortKey: TGUID = '{F34B5293-82D0-32A5-9165-AE789FD3CF15}'; + CLASS_StringInfo: TGUID = '{31C967B5-2F8A-3957-9C6D-34A0731DB36C}'; + CLASS_TaiwanCalendar: TGUID = '{769B8B68-64F7-3B61-B744-160A9FCC3216}'; + CLASS_TextElementEnumerator: TGUID = '{4C96DA7C-8858-3C24-A973-CB50F2860A91}'; + CLASS_TextInfo: TGUID = '{BCA1528C-6369-37AD-8CC1-DB24A92CC6B1}'; + CLASS_ThaiBuddhistCalendar: TGUID = '{EC3DAC94-DF80-3017-B381-B13DCED6C4D8}'; + CLASS_NumberFormatInfo: TGUID = '{146A47AB-A2CF-3587-BB25-2B286D7566B4}'; + CLASS_Encoding: TGUID = '{EAECC459-5CE4-35A2-A085-5AFC0451C03A}'; + CLASS_System_Text_Decoder: TGUID = '{A924269D-5DF2-33AF-B72A-3250C4105EBE}'; + CLASS_System_Text_Encoder: TGUID = '{CC9D4538-57E8-3A82-886A-5FE65A127A5A}'; + CLASS_ASCIIEncoding: TGUID = '{9E28EF95-9C6F-3A00-B525-36A76178CC9C}'; + CLASS_UnicodeEncoding: TGUID = '{A0F5F5DC-337B-38D7-B1A3-FB1B95666BBF}'; + CLASS_UTF7Encoding: TGUID = '{3C9DCA8B-4410-3143-B801-559553EB6725}'; + CLASS_UTF8Encoding: TGUID = '{8C40D44A-4EDE-3760-9B61-50255056D3C7}'; + CLASS_MissingManifestResourceException: TGUID = '{726BBDF4-6C6D-30F4-B3A0-F14D6AEC08C7}'; + CLASS_NeutralResourcesLanguageAttribute: TGUID = '{87797538-6BAE-366A-A9BC-012C8F62EA44}'; + CLASS_ResourceManager: TGUID = '{9AFB3B93-E6DA-35D6-B9FE-44815E2BFD45}'; + CLASS_ResourceReader: TGUID = '{DD78B5ED-AA52-3B2B-A1B4-6CE3CE3155EA}'; + CLASS_ResourceSet: TGUID = '{A907F7CD-8C99-31EA-AC00-80FA4D94780A}'; + CLASS_ResourceWriter: TGUID = '{9187A0D6-508C-36CC-A79F-F90B89A0E154}'; + CLASS_SatelliteContractVersionAttribute: TGUID = '{F4AE34F8-6CE4-32DC-96BA-9C7A0A9C6D06}'; + CLASS_Registry: TGUID = '{9B4EF4FA-742E-3878-953A-474999711087}'; + CLASS_RegistryKey: TGUID = '{2C8FA9BD-CBE4-3223-B592-41B5A22FB820}'; + CLASS_X509Certificate: TGUID = '{4C69C54F-9824-38CC-8387-A22DC67E0BAB}'; + CLASS_AsymmetricAlgorithm: TGUID = '{4B135D8E-7B1B-3EA8-8D06-10E34F157E9D}'; + CLASS_AsymmetricKeyExchangeDeformatter: TGUID = '{0202CE16-1F18-3BFB-807D-760B157AB260}'; + CLASS_AsymmetricKeyExchangeFormatter: TGUID = '{CE38DC2D-EB2D-3B6A-AFAC-8537BD0B9BF7}'; + CLASS_AsymmetricSignatureDeformatter: TGUID = '{BEE4E9FD-DE7A-3512-93D8-0C5E006B167A}'; + CLASS_AsymmetricSignatureFormatter: TGUID = '{5B475A84-5310-3C64-B625-E2BF00476F53}'; + CLASS_ToBase64Transform: TGUID = '{5F3A0F8D-5EF9-3AD5-94E0-53AFF8BCE960}'; + CLASS_FromBase64Transform: TGUID = '{C1ABB475-F198-39D5-BF8D-330BC7189661}'; + CLASS_KeySizes: TGUID = '{D7A12132-100F-37AE-A277-268A2656E476}'; + CLASS_CryptographicException: TGUID = '{7F8C7DC5-D8B4-3758-981F-02AF6B42461A}'; + CLASS_CryptographicUnexpectedOperationException: TGUID = '{C41FA05C-8A7A-3157-8166-4104BB4925BA}'; + CLASS_CryptoAPITransform: TGUID = '{AE746923-16BB-3D31-9D08-CE50EF6F7B1A}'; + CLASS_CspParameters: TGUID = '{AF60343F-6C7B-3761-839F-0C44E3CA06DA}'; + CLASS_CryptoConfig: TGUID = '{9EA60ECA-3DCD-340F-8E95-67845D185999}'; + CLASS_Stream: TGUID = '{E331083B-C22D-3046-8EC7-D222D6BE031F}'; + CLASS_CryptoStream: TGUID = '{B5C4E3CA-476A-3961-BCA5-A6C0AD73E7B1}'; + CLASS_SymmetricAlgorithm: TGUID = '{5B67EA6B-D85D-3F48-86D2-8581DB230C43}'; + CLASS_DES: TGUID = '{F30D404C-A350-36FA-A6FC-054C3F583420}'; + CLASS_DESCryptoServiceProvider: TGUID = '{B6EB52D5-BB1C-3380-8BCA-345FF43F4B04}'; + CLASS_DeriveBytes: TGUID = '{7D62DB2D-86E3-3ADE-90C4-215950643D10}'; + CLASS_DSA: TGUID = '{C13E7301-9B3F-3530-B60A-7F141D6DDE83}'; + CLASS_DSACryptoServiceProvider: TGUID = '{673DFE75-9F93-304F-ABA8-D2A86BA87D7C}'; + CLASS_DSASignatureDeformatter: TGUID = '{1F17C39C-99D5-37E0-8E98-8F27044BD50A}'; + CLASS_DSASignatureFormatter: TGUID = '{8F6D198C-E66F-3A87-AA3F-F885DD09EA13}'; + CLASS_HashAlgorithm: TGUID = '{68549FC3-F82C-3387-8578-E5FB09833740}'; + CLASS_KeyedHashAlgorithm: TGUID = '{BF1B2D6A-E41E-3645-8257-A08D7483BD41}'; + CLASS_HMACSHA1: TGUID = '{00B01B2E-B1FE-33A6-AD40-57DE8358DC7D}'; + CLASS_MACTripleDES: TGUID = '{39B68485-6773-3C46-82E9-56D8F0B4570C}'; + CLASS_MD5: TGUID = '{668515A6-213D-377A-8FE4-5A1E59A10AC9}'; + CLASS_MD5CryptoServiceProvider: TGUID = '{D2548BF2-801A-36AF-8800-1F11FBF54361}'; + CLASS_MaskGenerationMethod: TGUID = '{BE1E426E-676B-3524-9CED-21E306E9B827}'; + CLASS_PasswordDeriveBytes: TGUID = '{EED31DD9-AA11-3993-80E0-0088C1F5FEBA}'; + CLASS_PKCS1MaskGenerationMethod: TGUID = '{7AE844F0-ECA8-3F15-AE27-AFA21A2AA6F8}'; + CLASS_RC2: TGUID = '{1C6DC255-62D6-3366-BB25-01C509085473}'; + CLASS_RC2CryptoServiceProvider: TGUID = '{62E92675-CB77-3FC9-8597-1A81A5F18013}'; + CLASS_RandomNumberGenerator: TGUID = '{3E04DC56-84CE-3893-8BEF-6C9B95F9CCF4}'; + CLASS_RNGCryptoServiceProvider: TGUID = '{40031115-09D2-3851-A13F-56930BE48038}'; + CLASS_RSA: TGUID = '{3E39CA4F-CD6F-3CFE-8659-7FDC8D1C9F0B}'; + CLASS_RSACryptoServiceProvider: TGUID = '{D9035152-6B1F-33E3-86F4-411CD21CDE0E}'; + CLASS_RSAOAEPKeyExchangeDeformatter: TGUID = '{4D187AC2-D815-3B7E-BCEA-8E0BBC702F7C}'; + CLASS_RSAOAEPKeyExchangeFormatter: TGUID = '{A0E2E749-63CE-3651-8F4F-F5F996344C32}'; + CLASS_RSAPKCS1KeyExchangeDeformatter: TGUID = '{EE96F4E1-377E-315C-AEF5-874DC8C7A2AA}'; + CLASS_RSAPKCS1KeyExchangeFormatter: TGUID = '{92755472-2059-3F96-8938-8AC767B5187B}'; + CLASS_RSAPKCS1SignatureDeformatter: TGUID = '{6F674828-9081-3B45-BC39-791BD84CCF8F}'; + CLASS_RSAPKCS1SignatureFormatter: TGUID = '{7BC115CD-1EE2-3068-894D-E3D3F7632F40}'; + CLASS_Rijndael: TGUID = '{48CBEB8F-DB77-3103-899C-CD24A832B5CC}'; + CLASS_RijndaelManaged: TGUID = '{1F9F18A3-EFC0-3913-84A5-90678A4A9A80}'; + CLASS_SHA1: TGUID = '{EB52B161-AFB3-3DEA-BFAF-C183AEB57E56}'; + CLASS_SHA1CryptoServiceProvider: TGUID = '{FC13A7D5-E2B3-37BA-B807-7FA6238284D5}'; + CLASS_SHA1Managed: TGUID = '{FDF9C30D-CCAB-3E2D-B584-9E24CE8038E3}'; + CLASS_SHA256: TGUID = '{E29B25FC-9402-3A80-AAA5-EB07D9EF5488}'; + CLASS_SHA256Managed: TGUID = '{44181B13-AE94-3CFB-81D1-37DB59145030}'; + CLASS_SHA384: TGUID = '{0C00C2E9-7BBE-359E-8261-FD9B9C882A15}'; + CLASS_SHA384Managed: TGUID = '{7FD3958D-0A14-3001-8074-0D15EAD7F05C}'; + CLASS_SHA512: TGUID = '{8DE638D4-0575-3083-9CD7-41619EF9AC75}'; + CLASS_SHA512Managed: TGUID = '{A6673C32-3943-3BBB-B476-C09A0EC0BCD6}'; + CLASS_SignatureDescription: TGUID = '{3FA7A1C5-812C-3B56-B957-CB14AF670C09}'; + CLASS_TripleDES: TGUID = '{3D79AE1A-A949-3601-978F-02BEA1E70A98}'; + CLASS_TripleDESCryptoServiceProvider: TGUID = '{DAA132BF-1170-3D8B-A0EF-E2F55A68A91D}'; + CLASS_AllMembershipCondition: TGUID = '{06B81C12-A5DA-340D-AFF7-FA1453FBC29A}'; + CLASS_ApplicationDirectory: TGUID = '{720BF501-75AA-39F3-B6C2-EABE2F47CEE5}'; + CLASS_ApplicationDirectoryMembershipCondition: TGUID = '{3DDB2114-9285-30A6-906D-B117640CA927}'; + CLASS_CodeGroup: TGUID = '{05C4D71E-FB7D-30BE-B6B4-1DF8999CEEE1}'; + CLASS_Evidence: TGUID = '{62545937-20A9-3D0F-B04B-322E854EACB0}'; + CLASS_FileCodeGroup: TGUID = '{3F8D7E3A-24E7-3F7C-9DC5-4CA22EE7C782}'; + CLASS_FirstMatchCodeGroup: TGUID = '{28635CC7-4C39-3779-8C31-839101001F78}'; + CLASS_Hash: TGUID = '{260356E2-BAFA-3349-8BF7-86EEB460A2C7}'; + CLASS_HashMembershipCondition: TGUID = '{769EDEAD-E3B2-3C89-B9A6-948CD7288587}'; + CLASS_NetCodeGroup: TGUID = '{A601B6B7-422D-3B21-A61C-A77C5512F36A}'; + CLASS_PermissionRequestEvidence: TGUID = '{E1C3E338-B088-3C69-9989-A0E59E96FEA8}'; + CLASS_PolicyException: TGUID = '{89D26277-8408-3FC8-BD44-CF5F0E614C82}'; + CLASS_PolicyLevel: TGUID = '{64E304C1-D80D-3388-94EF-002F45D5AC05}'; + CLASS_PolicyStatement: TGUID = '{ABCC3DF5-7E59-3780-A3CC-4F412008A5EA}'; + CLASS_Publisher: TGUID = '{649546A7-965F-366F-A735-0FB522917B5A}'; + CLASS_PublisherMembershipCondition: TGUID = '{05BF00F9-44B8-39A7-AF36-7E11C9B502DD}'; + CLASS_Site: TGUID = '{0F71B36D-4006-35B5-9F42-4C468514AF70}'; + CLASS_SiteMembershipCondition: TGUID = '{7F5E4FD8-9575-3691-BF0C-2D30A21E4376}'; + CLASS_StrongName: TGUID = '{F1566AAF-63FE-3F4B-B121-DCD17999119B}'; + CLASS_StrongNameMembershipCondition: TGUID = '{7CFFAC1C-7370-30F9-AA72-E30FE39257D9}'; + CLASS_UnionCodeGroup: TGUID = '{F424D0BE-F3CB-3D09-9B18-C523A739EBFE}'; + CLASS_Url: TGUID = '{7A2AE0C8-EF79-334E-BACF-D7BA452CAF7C}'; + CLASS_UrlMembershipCondition: TGUID = '{93E33D56-812D-3112-BEEB-276A67D1172E}'; + CLASS_Zone: TGUID = '{6FCF98FF-B4D6-37A4-9DAB-4DE11A5FE5F2}'; + CLASS_ZoneMembershipCondition: TGUID = '{D72F9AEB-23F8-3B88-B6FD-8A143E3245A1}'; + CLASS_GenericIdentity: TGUID = '{4C534A8E-3C46-3745-BDAE-5119C40F98E7}'; + CLASS_GenericPrincipal: TGUID = '{2EACB710-FE48-3C13-8145-E810792C58A2}'; + CLASS_WindowsIdentity: TGUID = '{70C7CEC2-5BB2-3770-A26E-FC180C81F4FE}'; + CLASS_WindowsImpersonationContext: TGUID = '{FC1ABB5C-D107-3145-908A-3EA107D53748}'; + CLASS_WindowsPrincipal: TGUID = '{138887DB-C015-3254-B05A-D15616BF9AEE}'; + CLASS_DispIdAttribute: TGUID = '{B36860B2-BAC3-3C25-81EE-1F62CB91FC76}'; + CLASS_InterfaceTypeAttribute: TGUID = '{C8A36B3C-BC72-31E7-8BA2-EF949A54BD0C}'; + CLASS_ClassInterfaceAttribute: TGUID = '{5819DB84-163F-3FA2-853B-43A0269626B1}'; + CLASS_ComVisibleAttribute: TGUID = '{1F4BCC99-E9D8-3AAB-99AF-4D1EC26E3376}'; + CLASS_LCIDConversionAttribute: TGUID = '{F912451B-8766-32CD-917F-3B9FEE4421A8}'; + CLASS_ComRegisterFunctionAttribute: TGUID = '{630A3EF1-23C6-31FE-9D25-294E3B3E7486}'; + CLASS_ComUnregisterFunctionAttribute: TGUID = '{8F45C7FF-1E6E-34C1-A7CC-260985392A05}'; + CLASS_ProgIdAttribute: TGUID = '{47854AE8-F71C-3459-A943-1E91EDC951A7}'; + CLASS_ImportedFromTypeLibAttribute: TGUID = '{8AFEAA55-757F-3DDB-A750-B2CAA6A0B80B}'; + CLASS_IDispatchImplAttribute: TGUID = '{3AB97590-3A62-36FB-903F-BB70B015F156}'; + CLASS_ComSourceInterfacesAttribute: TGUID = '{AC0C43B1-6CA0-3E6C-B088-B11E96FA0CE3}'; + CLASS_ComConversionLossAttribute: TGUID = '{8A3FD229-B2A9-347F-93D2-87F3B7F92753}'; + CLASS_TypeLibTypeAttribute: TGUID = '{2F53C69E-F1F0-3E98-AD3B-EEAA89A88906}'; + CLASS_TypeLibFuncAttribute: TGUID = '{05074A9C-0B30-3A78-AAEF-99356E49DF45}'; + CLASS_TypeLibVarAttribute: TGUID = '{36BDD1DA-2B15-3428-B055-BDABF4667C3F}'; + CLASS_MarshalAsAttribute: TGUID = '{AAFFEF00-519D-3EE0-8763-D4B650611E0D}'; + CLASS_ComImportAttribute: TGUID = '{F1EBA909-6621-346D-9CE2-39F266C9D011}'; + CLASS_GuidAttribute: TGUID = '{FDE6D643-768A-3C91-A169-2C8FB7C1CD1F}'; + CLASS_PreserveSigAttribute: TGUID = '{204D5A28-46A0-3F04-BD7C-B5672631E57F}'; + CLASS_InAttribute: TGUID = '{96A058CD-FAF7-386C-85BF-E47F00C81795}'; + CLASS_OutAttribute: TGUID = '{FDB2DC94-B5A0-3702-AE84-BBFA752ACB36}'; + CLASS_OptionalAttribute: TGUID = '{B81CB5ED-E654-399F-9698-C83C50665786}'; + CLASS_DllImportAttribute: TGUID = '{3C52777E-F51C-300A-8122-479A19164325}'; + CLASS_StructLayoutAttribute: TGUID = '{A0FFF774-26BD-3DE7-95CE-DBCEA6088F96}'; + CLASS_FieldOffsetAttribute: TGUID = '{3BA14C59-4C61-3D7C-8161-9962D7A89292}'; + CLASS_ComAliasNameAttribute: TGUID = '{E1AA0B69-CA47-3749-AEB1-133DCE4C705F}'; + CLASS_AutomationProxyAttribute: TGUID = '{0E67C08B-D921-33D0-82FE-B6FD28BBAEFF}'; + CLASS_PrimaryInteropAssemblyAttribute: TGUID = '{6DD18F5D-7A5C-3868-B1C2-7E19DA873386}'; + CLASS_CoClassAttribute: TGUID = '{03E4C7F5-974C-3253-9BE0-41470697BBAD}'; + CLASS_ComEventInterfaceAttribute: TGUID = '{830AC1F5-98EE-39A3-9212-FA5626CA855A}'; + CLASS_TypeLibVersionAttribute: TGUID = '{5F8DC45F-A2D8-3E34-8C86-586ED6A74984}'; + CLASS_ComCompatibleVersionAttribute: TGUID = '{7F962EBF-2220-30F0-8B92-24A73B7CD268}'; + CLASS_BestFitMappingAttribute: TGUID = '{84FEE617-858B-364B-A662-8BF7ED5330CA}'; + CLASS_ExternalException: TGUID = '{AFC681CF-E82F-361A-8280-CF4E1F844C3E}'; + CLASS_COMException: TGUID = '{07F94112-A42E-328B-B508-702EF62BCC29}'; + CLASS_CurrencyWrapper: TGUID = '{D540A482-8FB8-3720-B52E-08C7A2C1B9DF}'; + CLASS_DispatchWrapper: TGUID = '{DA7109D3-BCD8-3D4C-B172-DFC2E585562A}'; + CLASS_ErrorWrapper: TGUID = '{D7900EBD-FF28-3AE6-B517-7E32714F578B}'; + CLASS_ExtensibleClassFactory: TGUID = '{58734403-8382-3110-B729-14C7855982F9}'; + CLASS_InvalidComObjectException: TGUID = '{A7248EC6-A8A5-3D07-890E-6107F8C247E5}'; + CLASS_InvalidOleVariantTypeException: TGUID = '{9A944885-EDAF-3A81-A2FF-6A9D5D1ABFC7}'; + CLASS_Marshal: TGUID = '{F6B3BABB-CE60-38B7-9822-6C65F003A73C}'; + CLASS_MarshalDirectiveException: TGUID = '{742AD1FB-B2F0-3681-B4AA-E736A3BCE4E1}'; + CLASS_ObjectCreationDelegate: TGUID = '{8A21DF64-F31A-306F-9DB8-0DFA164ED9EE}'; + CLASS_RuntimeEnvironment: TGUID = '{78D22140-40CF-303E-BE96-B3AC0407A34D}'; + CLASS_SafeArrayRankMismatchException: TGUID = '{4BE89AC3-603D-36B2-AB9B-9C38866F56D5}'; + CLASS_SafeArrayTypeMismatchException: TGUID = '{2D5EC63C-1B3E-3EE4-9052-EB0D0303549C}'; + CLASS_SEHException: TGUID = '{CA805B13-468C-3A22-BF9A-818E97EFA6B7}'; + CLASS_UnknownWrapper: TGUID = '{887D4D94-31D1-37F3-9938-643ED2A46155}'; + CLASS_BinaryReader: TGUID = '{2484AFDA-7B47-3CD7-97B5-951F5C6AB5B6}'; + CLASS_BinaryWriter: TGUID = '{D92CCD03-5C88-3339-8011-46E8B01A2BA8}'; + CLASS_BufferedStream: TGUID = '{1500ABC0-1DD4-37DD-985F-82430314C798}'; + CLASS_Directory: TGUID = '{0EBD869E-64BF-3682-80BB-690A70114BE0}'; + CLASS_FileSystemInfo: TGUID = '{1F0E8DB5-8F52-3360-8A47-9D3DC3A5ACAF}'; + CLASS_DirectoryInfo: TGUID = '{40A8B2FA-E055-3F59-8BA6-54C4E35649B5}'; + CLASS_IOException: TGUID = '{A164C0BF-67AE-3C7E-BC05-BFE24A8CDB62}'; + CLASS_DirectoryNotFoundException: TGUID = '{8833BC41-DC6B-34B9-A799-682D2554F02F}'; + CLASS_EndOfStreamException: TGUID = '{58D052BC-A3DF-3508-AC95-FF297BDC9F0C}'; + CLASS_File_: TGUID = '{2A96793E-4CF3-3976-A893-B66886D89A03}'; + CLASS_FileInfo: TGUID = '{D6DFFEAD-0B46-3DED-83DE-1943413B94D5}'; + CLASS_FileLoadException: TGUID = '{AF8C5F8A-9999-3E92-BB41-C5F4955174CD}'; + CLASS_FileNotFoundException: TGUID = '{48C6E96F-A2F3-33E7-BA7F-C8F74866760B}'; + CLASS_FileStream: TGUID = '{7F25E491-33BE-31E2-A334-CB506D4EE471}'; + CLASS_MemoryStream: TGUID = '{F5E692D9-8A87-349D-9657-F96E5799D2F4}'; + CLASS_Path: TGUID = '{B7AE0CAE-979E-3EBF-B33F-8F121DAFD78E}'; + CLASS_PathTooLongException: TGUID = '{C016A313-9606-36D3-A823-33EBF5006189}'; + CLASS_TextReader: TGUID = '{7457D481-248A-3C89-B7E0-FCEB8FD827E5}'; + CLASS_StreamReader: TGUID = '{405FB68B-360D-382C-8A64-1DA3C853D161}'; + CLASS_TextWriter: TGUID = '{08416C5B-A003-327C-9F0F-93942467E6E0}'; + CLASS_StreamWriter: TGUID = '{EF1AB726-0B87-3E09-AEF4-3A87C5DCDDA0}'; + CLASS_StringReader: TGUID = '{0247D5AF-D61D-341C-8615-0FF28865B7CB}'; + CLASS_StringWriter: TGUID = '{27F31D55-D6C6-3676-9D42-C40F3A918636}'; + CLASS_AccessedThroughPropertyAttribute: TGUID = '{5EFB687D-2B50-3216-BD74-52D06C8D3CD1}'; + CLASS_CallConvCdecl: TGUID = '{A3A1F076-1FA7-3A26-886D-8841CB45382F}'; + CLASS_CallConvStdcall: TGUID = '{BCB67D4D-2096-36BE-974C-A003FC95041B}'; + CLASS_CallConvThiscall: TGUID = '{46080CA7-7CB8-3A55-A72E-8E50ECA4D4FC}'; + CLASS_CallConvFastcall: TGUID = '{ED0BC45C-2438-31A9-BBB6-E2A3B5916419}'; + CLASS_RuntimeHelpers: TGUID = '{8D360300-B535-3B0F-8C16-BFE8BB46D369}'; + CLASS_CustomConstantAttribute: TGUID = '{6F7A3516-EFD9-31C3-BC9A-A89DF19F64E7}'; + CLASS_DateTimeConstantAttribute: TGUID = '{3178FD5D-2A5B-30B9-9C5C-7593802F9C1A}'; + CLASS_DiscardableAttribute: TGUID = '{837A6733-1675-3BC9-BBF8-13889F84DAF4}'; + CLASS_DecimalConstantAttribute: TGUID = '{AC8DE863-B115-3179-810F-162B43ABD2B5}'; + CLASS_CompilationRelaxationsAttribute: TGUID = '{76CEC05B-C55E-3ADF-92A2-0698F1CF2017}'; + CLASS_CompilerGlobalScopeAttribute: TGUID = '{4B601364-A04B-38BC-BD38-A18E981324CF}'; + CLASS_IDispatchConstantAttribute: TGUID = '{E947A0B0-D47F-3AA3-9B77-4624E0F3ACA4}'; + CLASS_IndexerNameAttribute: TGUID = '{9599C078-DC94-3EA2-8761-408295BD1155}'; + CLASS_IsVolatile: TGUID = '{86527C04-536A-33C6-8C84-3D5A5B458DB3}'; + CLASS_IUnknownConstantAttribute: TGUID = '{590E4A07-DAFC-3BE7-A178-DA349BBA980B}'; + CLASS_MethodImplAttribute: TGUID = '{48D0CFE7-3128-3D2C-A5B5-8C7B82B4AB4F}'; + CLASS_RequiredAttributeAttribute: TGUID = '{D49C12A2-C401-3894-8005-716C2F692D38}'; + CLASS_PermissionSet: TGUID = '{AFAFD122-DAC4-3FF9-9646-DC032A4A8806}'; + CLASS_NamedPermissionSet: TGUID = '{C23E56CE-0A9A-3733-8189-46B43C9E4FB3}'; + CLASS_SecurityElement: TGUID = '{B9033CD1-C905-3059-9D29-562ECB13B0B3}'; + CLASS_XmlSyntaxException: TGUID = '{E38DA416-8050-3786-8201-46F187C15213}'; + CLASS_CodeAccessPermission: TGUID = '{AF6550FA-7C4B-3477-86DD-235F8286EAAC}'; + CLASS_EnvironmentPermission: TGUID = '{801F6E40-B384-3D27-B75F-DE2DF38F1192}'; + CLASS_FileDialogPermission: TGUID = '{9E1239B4-493A-3D2D-8F91-6636EC9ECA21}'; + CLASS_FileIOPermission: TGUID = '{DC50CD5A-0CAD-3B47-BF0D-79E85F3C2FC7}'; + CLASS_IsolatedStoragePermission: TGUID = '{F458ABF2-2B5E-3158-B0E4-228E8CDCF759}'; + CLASS_IsolatedStorageFilePermission: TGUID = '{AE588447-D98E-3E39-96F7-073433DB8D35}'; + CLASS_SecurityAttribute: TGUID = '{47DCD758-DF63-3226-A3A9-B0B88872A311}'; + CLASS_CodeAccessSecurityAttribute: TGUID = '{21858390-FE95-33A9-A103-F322C64D85AE}'; + CLASS_EnvironmentPermissionAttribute: TGUID = '{6161DF0C-CD78-33E1-B3E1-978B27025E40}'; + CLASS_FileDialogPermissionAttribute: TGUID = '{A141F926-E6B5-3903-8EFA-1014D4970F1C}'; + CLASS_FileIOPermissionAttribute: TGUID = '{DE440C06-7EC3-3E59-83C8-3829090198F7}'; + CLASS_PrincipalPermissionAttribute: TGUID = '{6D0AE73B-ED58-32E2-973C-765897783971}'; + CLASS_ReflectionPermissionAttribute: TGUID = '{64578750-937F-3B27-B631-C57E0BFFF97F}'; + CLASS_RegistryPermissionAttribute: TGUID = '{F69CF20D-F85B-3436-9E0E-DD3CB3E8B2CD}'; + CLASS_SecurityPermissionAttribute: TGUID = '{5E77314C-043D-3D8C-9C9D-D18F09FB3500}'; + CLASS_UIPermissionAttribute: TGUID = '{5F4ED054-C453-3D2B-A0FE-64E89871D364}'; + CLASS_ZoneIdentityPermissionAttribute: TGUID = '{C386115F-2B99-356B-B4A1-2CF57CE52988}'; + CLASS_StrongNameIdentityPermissionAttribute: TGUID = '{EF2C9DE4-BCDA-3322-AE75-16CC3EC2665C}'; + CLASS_SiteIdentityPermissionAttribute: TGUID = '{23F73179-6349-3183-A55C-BCFB1A2446E8}'; + CLASS_UrlIdentityPermissionAttribute: TGUID = '{6852BE7D-8C00-3F66-BEE3-463F74838491}'; + CLASS_PublisherIdentityPermissionAttribute: TGUID = '{2335C1DA-CD60-3208-AB5E-447F16A087E5}'; + CLASS_IsolatedStoragePermissionAttribute: TGUID = '{A56859A3-98ED-39A9-BD33-5807F0D6291F}'; + CLASS_IsolatedStorageFilePermissionAttribute: TGUID = '{F6610DF3-8D62-38BD-BF6B-2A4BA839EB3B}'; + CLASS_PermissionSetAttribute: TGUID = '{24151BA6-6D79-3EC4-8C77-014FFBE735AE}'; + CLASS_PublisherIdentityPermission: TGUID = '{73CF786B-CD2C-37E4-9835-824E4A019F11}'; + CLASS_ReflectionPermission: TGUID = '{E71CDC85-7FE7-3F51-BCDB-02459770DB87}'; + CLASS_RegistryPermission: TGUID = '{B35E31F2-9E50-3D43-8EAF-EC111F6B3295}'; + CLASS_PrincipalPermission: TGUID = '{67100ADE-60CF-33F1-8D95-F6FE1174458A}'; + CLASS_SecurityPermission: TGUID = '{D5F5125A-3D46-3C57-8393-0E4EE9D8016B}'; + CLASS_SiteIdentityPermission: TGUID = '{3BCFC458-07DC-3BA7-8404-97EB76641080}'; + CLASS_StrongNameIdentityPermission: TGUID = '{2B00B9EC-B4F4-3243-90AB-532E64FEE941}'; + CLASS_StrongNamePublicKeyBlob: TGUID = '{A463394F-7BA6-3721-8AD8-842748612B4C}'; + CLASS_UIPermission: TGUID = '{05B46A2D-7C6B-3EFF-A09A-1490A36811C2}'; + CLASS_UrlIdentityPermission: TGUID = '{AB7D1AB9-D192-3A95-B34C-A3996837C6A7}'; + CLASS_ZoneIdentityPermission: TGUID = '{CAEB199E-CEB9-388A-B240-E29C9F55199B}'; + CLASS_SuppressUnmanagedCodeSecurityAttribute: TGUID = '{7AE01D6C-BEE7-38F6-9A86-329D8A917803}'; + CLASS_UnverifiableCodeAttribute: TGUID = '{7E3393AB-2AB2-320B-8F6F-EAB6F5CF2CAF}'; + CLASS_AllowPartiallyTrustedCallersAttribute: TGUID = '{5610F042-FF1D-36D0-996C-68F7A207D1F0}'; + CLASS_SecurityException: TGUID = '{EEF05C76-5C98-3685-A69C-6E1A26A7F846}'; + CLASS_SecurityManager: TGUID = '{DF4E1BB0-8CDC-3C4B-A1C9-FEE64BBEF8C5}'; + CLASS_VerificationException: TGUID = '{EBAA029C-01C0-32B6-AAE6-FE21ADFC3E5D}'; + CLASS_ContextAttribute: TGUID = '{1764148E-73C1-320A-83FC-337DE81A68B4}'; + CLASS_AsyncResult: TGUID = '{614E973A-B737-38F5-9DDF-5825AC923135}'; + CLASS_CallContext: TGUID = '{9D0DF3B9-107C-3392-88C8-FE629CA21DAB}'; + CLASS_LogicalCallContext: TGUID = '{5DB435A0-0DB3-3F4A-BF49-191A69D451BB}'; + CLASS_ChannelServices: TGUID = '{D625BA4C-7C4C-3B86-99EA-780204EDE5CD}'; + CLASS_ClientChannelSinkStack: TGUID = '{DD5856E5-8151-3334-B8E9-07CB152B20A4}'; + CLASS_ServerChannelSinkStack: TGUID = '{5C35F099-165E-3225-A3A5-564150EA17F5}'; + CLASS_InternalMessageWrapper: TGUID = '{30C4CD02-66A2-3ABE-BC6C-638E6730E534}'; + CLASS_MethodCallMessageWrapper: TGUID = '{40133645-FFAF-3A9C-B408-997E049D5C11}'; + CLASS_ClientSponsor: TGUID = '{FD8C8FCE-4F85-36B2-B8E8-F5A183654539}'; + CLASS_CrossContextDelegate: TGUID = '{8DE7F105-07F6-31A8-8469-BAFCDC5024B8}'; + CLASS_Context: TGUID = '{A36E4EAF-EA3F-30A6-906D-374BBF7903B1}'; + CLASS_ContextProperty: TGUID = '{6134805F-E8FF-3FD8-931E-4D847BCA7551}'; + CLASS_EnterpriseServicesHelper: TGUID = '{BC5062B6-79E8-3F19-A87E-F9DAF826960C}'; + CLASS_Header: TGUID = '{14309FAB-EACD-3C64-877E-07EB01B89C91}'; + CLASS_HeaderHandler: TGUID = '{CC4C81B2-365E-3BA5-B374-A949B727E929}'; + CLASS_ChannelDataStore: TGUID = '{F3E38CEA-40E4-33C1-9DF7-BD103BE2D68B}'; + CLASS_TransportHeaders: TGUID = '{48728B3F-F7D9-36C1-B3E7-8BF2E63CE1B3}'; + CLASS_SinkProviderData: TGUID = '{B8BE8D68-5FE6-38C5-838E-67CE2FCA9D70}'; + CLASS_BaseChannelObjectWithProperties: TGUID = '{F369A73E-78D8-3BCC-AE36-522D116E19F9}'; + CLASS_BaseChannelSinkWithProperties: TGUID = '{0E9EB6E5-D899-3132-90C5-7376970C4FB5}'; + CLASS_BaseChannelWithProperties: TGUID = '{22282340-9E30-3591-BD1E-6571930E8582}'; + CLASS_LifetimeServices: TGUID = '{8FD730C1-DD1B-3694-84A1-8CE7159E266B}'; + CLASS_ReturnMessage: TGUID = '{7B3BBD13-C870-3105-B123-FFCA166CDC04}'; + CLASS_MethodCall: TGUID = '{4F592B1F-4A0C-3FC0-9914-3677F64FC5A8}'; + CLASS_ConstructionCall: TGUID = '{54DAC96D-ECAF-38DB-A27B-3DDB102130C4}'; + CLASS_MethodResponse: TGUID = '{7E7BF3C0-B07B-3209-A424-7BC35D76EA7D}'; + CLASS_ConstructionResponse: TGUID = '{25E8547A-6B49-3F00-B963-D45FDCEF4F11}'; + CLASS_MethodReturnMessageWrapper: TGUID = '{2EC528FB-B987-3B3B-A444-9F94C3A257C1}'; + CLASS_ObjectHandle: TGUID = '{ABEB0459-03B9-35AF-96E1-66BB7BC923F7}'; + CLASS_ObjRef: TGUID = '{21F5A790-53EA-3D73-86C3-A5BA6CF65FE9}'; + CLASS_OneWayAttribute: TGUID = '{C30ABD41-7B5A-3D10-A6EF-56862E2979B6}'; + CLASS_ProxyAttribute: TGUID = '{1163D0CA-2A02-37C1-BF3F-A9B9E9D49245}'; + CLASS_RealProxy: TGUID = '{531D00A5-2CFF-30D7-8245-97E18CD4D037}'; + CLASS_SoapAttribute: TGUID = '{9B924EC5-BF13-3A98-8AC0-80877995D403}'; + CLASS_SoapTypeAttribute: TGUID = '{9C67F424-22DC-3D05-AB36-17EAF95881F2}'; + CLASS_SoapMethodAttribute: TGUID = '{01FF4E4B-8AD0-3171-8C82-5C2F48B87E3D}'; + CLASS_SoapFieldAttribute: TGUID = '{5B76534C-3ACC-3D52-AA61-D788B134ABE2}'; + CLASS_SoapParameterAttribute: TGUID = '{C76B435D-86C2-30FD-9329-E2603246095C}'; + CLASS_RemotingConfiguration: TGUID = '{3DB6F309-9DAB-36EC-8036-D901172C994C}'; + CLASS_System_Runtime_Remoting_TypeEntry: TGUID = '{4E52D7D6-9FDF-3B59-B318-778E0F40F37C}'; + CLASS_ActivatedClientTypeEntry: TGUID = '{3ED0F148-E447-3EFE-8488-3C834082CC96}'; + CLASS_ActivatedServiceTypeEntry: TGUID = '{6CD360CD-D53D-3775-87EF-00D72E6645F5}'; + CLASS_WellKnownClientTypeEntry: TGUID = '{6B3B6647-B39D-3ED4-992F-DF6C49ACE82E}'; + CLASS_WellKnownServiceTypeEntry: TGUID = '{2CE0DA26-18EF-3CF4-ABAC-BE90965F5F90}'; + CLASS_RemotingException: TGUID = '{24540EBC-316E-35D2-80DB-8A535CAF6A35}'; + CLASS_ServerException: TGUID = '{DB13821E-9835-3958-8539-1E021399AB6C}'; + CLASS_RemotingTimeoutException: TGUID = '{3CDED51A-86B4-39F0-A12A-5D1FDCED6546}'; + CLASS_RemotingServices: TGUID = '{8DF4C38A-8492-3C47-8332-D9D04FAF3C59}'; + CLASS_InternalRemotingServices: TGUID = '{53A3C917-BB24-3908-B58B-09ECDA99265F}'; + CLASS_MessageSurrogateFilter: TGUID = '{C48CA9BC-BBDB-3059-AEC8-763CF7E9A88C}'; + CLASS_RemotingSurrogateSelector: TGUID = '{24EEC005-3938-3C71-821D-7F68FD850B2D}'; + CLASS_SoapServices: TGUID = '{DA5681DA-7C21-3A2D-AFAC-69E3A4D11F4D}'; + CLASS_SoapDateTime: TGUID = '{48AD62E8-BD40-37F4-8FD7-F7A17478A8E6}'; + CLASS_SoapDuration: TGUID = '{DE47D9CF-0107-3D66-93E9-A8ACB06B4583}'; + CLASS_SoapTime: TGUID = '{D049DC2B-82C3-3350-A1CC-BF69FEE3825E}'; + CLASS_SoapDate: TGUID = '{2DECBCB7-BAC0-316D-9131-43035C5CB480}'; + CLASS_SoapYearMonth: TGUID = '{A7136BDF-B141-3913-9D1C-9BC5AFF21470}'; + CLASS_SoapYear: TGUID = '{75999EBA-0679-3D43-BDC4-02E4D637F1B1}'; + CLASS_SoapMonthDay: TGUID = '{463AE13F-C7E5-357E-A41C-DF8762FFF85C}'; + CLASS_SoapDay: TGUID = '{C9F0A842-3CE1-338F-A1D4-6D7BB397BDAA}'; + CLASS_SoapMonth: TGUID = '{CAEC7D4F-0B02-3579-943F-821738EE78CC}'; + CLASS_SoapHexBinary: TGUID = '{8C1425C9-A7D3-35CD-8248-928CA52AD49B}'; + CLASS_SoapBase64Binary: TGUID = '{F59D514C-F200-319F-BF3F-9E4E23B2848C}'; + CLASS_SoapInteger: TGUID = '{09A60795-31C0-3A79-9250-8D93C74FE540}'; + CLASS_SoapPositiveInteger: TGUID = '{7B769B29-35F0-3BDC-AAE9-E99937F6CDEC}'; + CLASS_SoapNonPositiveInteger: TGUID = '{2BB6C5E0-C2B9-3608-8868-21CFD6DDB91E}'; + CLASS_SoapNonNegativeInteger: TGUID = '{6850404F-D7FB-32BD-8328-C94F66E8C1C7}'; + CLASS_SoapNegativeInteger: TGUID = '{C41D0B30-A518-3093-A18F-364AF9E71EB7}'; + CLASS_SoapAnyUri: TGUID = '{CDFA7117-B2A4-3A3F-B393-BC19D44F9749}'; + CLASS_SoapQName: TGUID = '{D8A4F3EB-E7EC-3620-831A-B052A67C9944}'; + CLASS_SoapNotation: TGUID = '{B54E38F8-17FF-3D0A-9FF3-5E662DE2055F}'; + CLASS_SoapNormalizedString: TGUID = '{0E71F9BD-C109-3352-BD60-14F96D56B6F3}'; + CLASS_SoapToken: TGUID = '{777F668E-3272-39CD-A8B5-860935A35181}'; + CLASS_SoapLanguage: TGUID = '{84F70B6C-D59E-394A-B879-FFCC30DDCAA2}'; + CLASS_SoapName: TGUID = '{4E515531-7A71-3CDD-8078-0A01C85C8F9D}'; + CLASS_SoapIdrefs: TGUID = '{2763BE6B-F8CF-39D9-A2E8-9E9815C0815E}'; + CLASS_SoapEntities: TGUID = '{9A3A64F4-8BA5-3DCF-880C-8D3EE06C5538}'; + CLASS_SoapNmtoken: TGUID = '{C498F2D9-A77C-3D4B-A1A5-12CC7B99115D}'; + CLASS_SoapNmtokens: TGUID = '{14BE6B21-C682-3A3A-8B24-FEE75B4FF8C5}'; + CLASS_SoapNcName: TGUID = '{D13B741D-051F-322F-93AA-1367A3C8AAFB}'; + CLASS_SoapId: TGUID = '{FA0B54D5-F221-3648-A20C-F67A96F4A207}'; + CLASS_SoapIdref: TGUID = '{433CA926-9887-3541-89CC-5D74D0259144}'; + CLASS_SoapEntity: TGUID = '{F00CA7A7-4B8D-3F2F-A5F2-CE4A4478B39C}'; + CLASS_SynchronizationAttribute: TGUID = '{5520B6D3-6EC6-3CE7-958B-E69FAF6EFF99}'; + CLASS_TrackingServices: TGUID = '{E822F35C-DDC2-3FB2-9768-A2AEBCED7C40}'; + CLASS_UrlAttribute: TGUID = '{79C14066-E37E-3643-A449-D166FA0E8EC2}'; + CLASS_IsolatedStorage: TGUID = '{70541B17-BF7E-399B-8D33-2AFA4F5AF395}'; + CLASS_IsolatedStorageFile: TGUID = '{5E45C68A-E894-3B38-AEEE-634540BD0D57}'; + CLASS_IsolatedStorageFileStream: TGUID = '{E5CFDFFC-AEB5-3489-B12C-640F7B031B57}'; + CLASS_IsolatedStorageException: TGUID = '{4479C009-4CC3-39A2-8F92-DFCDF034F748}'; + CLASS_InternalRM: TGUID = '{CF8F7FCF-94FE-3516-90E9-C103156DD2D5}'; + CLASS_InternalST: TGUID = '{CBBAF6EC-251A-3480-8A3D-4D56BC7320D0}'; + CLASS_SoapMessage: TGUID = '{E772BBE6-CB52-3C19-876A-D1BFA2305F4E}'; + CLASS_SoapFault: TGUID = '{A8D058C4-D923-3859-9490-D3888FC90439}'; + CLASS_ServerFault: TGUID = '{817ACCB7-35D8-3C18-BAF2-0A5CE2157B74}'; + CLASS_BinaryFormatter: TGUID = '{50369004-DB9A-3A75-BE7A-1D0EF017B9D3}'; + CLASS_AssemblyBuilder: TGUID = '{0814BE2A-48E5-3D61-90F3-EF3D05DF9D5E}'; + CLASS_ConstructorBuilder: TGUID = '{93C24CDB-4014-3EFD-B564-E836BA48C765}'; + CLASS_EventBuilder: TGUID = '{DC18B7EC-91E4-3999-910A-188D7AFA0A68}'; + CLASS_FieldBuilder: TGUID = '{36D63E48-1646-345F-A3D4-B34E4C42C3C5}'; + CLASS_ILGenerator: TGUID = '{5A3DCD44-5855-3D89-A0EC-CE50A3B144A9}'; + CLASS_LocalBuilder: TGUID = '{A6BCAA25-D357-3F79-A716-AD1434E4D832}'; + CLASS_MethodBuilder: TGUID = '{53DF4FB3-A164-37D3-8310-F0D15730AB32}'; + CLASS_CustomAttributeBuilder: TGUID = '{71BC3E08-0082-320A-8BA5-EFA8D2B9798A}'; + CLASS_MethodRental: TGUID = '{726D83B0-9A52-36B0-919C-60E625F03211}'; + CLASS_ModuleBuilder: TGUID = '{FB2ED445-2862-3A63-9F5A-BBF6C2195DCE}'; + CLASS_OpCodes: TGUID = '{2A59A0E6-11B2-3025-92DE-E036A6DDBC00}'; + CLASS_ParameterBuilder: TGUID = '{027AD5C3-D619-3506-B8E6-CA67A33B9C8F}'; + CLASS_PropertyBuilder: TGUID = '{22D4C021-1B3C-3EE3-93B6-4C9D810CE077}'; + CLASS_SignatureHelper: TGUID = '{798B57A2-064A-3098-9A80-E12DA70E0085}'; + CLASS_TypeBuilder: TGUID = '{0F445332-E34C-3F8C-90ED-AB7F0724ADAB}'; + CLASS_EnumBuilder: TGUID = '{70F855DA-4948-38AB-A727-431C386AB9F5}'; + +// *********************************************************************// +// Declaration of Enumerations defined in Type Library +// *********************************************************************// +// Constants for enum LoaderOptimization +type + LoaderOptimization = TOleEnum; +const + LoaderOptimization_NotSpecified = $00000000; + LoaderOptimization_SingleDomain = $00000001; + LoaderOptimization_MultiDomain = $00000002; + LoaderOptimization_MultiDomainHost = $00000003; + LoaderOptimization_DomainMask = $00000003; + LoaderOptimization_DisallowBindings = $00000004; + +// Constants for enum AttributeTargets +type + AttributeTargets = TOleEnum; +const + AttributeTargets_Assembly = $00000001; + AttributeTargets_Module = $00000002; + AttributeTargets_Class = $00000004; + AttributeTargets_Struct = $00000008; + AttributeTargets_Enum = $00000010; + AttributeTargets_Constructor = $00000020; + AttributeTargets_Method = $00000040; + AttributeTargets_Property = $00000080; + AttributeTargets_Field = $00000100; + AttributeTargets_Event = $00000200; + AttributeTargets_Interface = $00000400; + AttributeTargets_Parameter = $00000800; + AttributeTargets_Delegate = $00001000; + AttributeTargets_ReturnValue = $00002000; + AttributeTargets_All = $00003FFF; + +// Constants for enum DayOfWeek +type + DayOfWeek = TOleEnum; +const + DayOfWeek_Sunday = $00000000; + DayOfWeek_Monday = $00000001; + DayOfWeek_Tuesday = $00000002; + DayOfWeek_Wednesday = $00000003; + DayOfWeek_Thursday = $00000004; + DayOfWeek_Friday = $00000005; + DayOfWeek_Saturday = $00000006; + +// Constants for enum SpecialFolder +type + SpecialFolder = TOleEnum; +const + SpecialFolder_ApplicationData = $0000001A; + SpecialFolder_CommonApplicationData = $00000023; + SpecialFolder_LocalApplicationData = $0000001C; + SpecialFolder_Cookies = $00000021; + SpecialFolder_Desktop = $00000000; + SpecialFolder_Favorites = $00000006; + SpecialFolder_History = $00000022; + SpecialFolder_InternetCache = $00000020; + SpecialFolder_Programs = $00000002; + SpecialFolder_MyComputer = $00000011; + SpecialFolder_MyMusic = $0000000D; + SpecialFolder_MyPictures = $00000027; + SpecialFolder_Recent = $00000008; + SpecialFolder_SendTo = $00000009; + SpecialFolder_StartMenu = $0000000B; + SpecialFolder_Startup = $00000007; + SpecialFolder_System = $00000025; + SpecialFolder_Templates = $00000015; + SpecialFolder_DesktopDirectory = $00000010; + SpecialFolder_Personal = $00000005; + SpecialFolder_ProgramFiles = $00000026; + SpecialFolder_CommonProgramFiles = $0000002B; + +// Constants for enum PlatformID +type + PlatformID = TOleEnum; +const + PlatformID_Win32S = $00000000; + PlatformID_Win32Windows = $00000001; + PlatformID_Win32NT = $00000002; + PlatformID_WinCE = $00000003; + +// Constants for enum TypeCode +type + TypeCode = TOleEnum; +const + TypeCode_Empty = $00000000; + TypeCode_Object = $00000001; + TypeCode_DBNull = $00000002; + TypeCode_Boolean = $00000003; + TypeCode_Char = $00000004; + TypeCode_SByte = $00000005; + TypeCode_Byte = $00000006; + TypeCode_Int16 = $00000007; + TypeCode_UInt16 = $00000008; + TypeCode_Int32 = $00000009; + TypeCode_UInt32 = $0000000A; + TypeCode_Int64 = $0000000B; + TypeCode_UInt64 = $0000000C; + TypeCode_Single = $0000000D; + TypeCode_Double = $0000000E; + TypeCode_Decimal = $0000000F; + TypeCode_DateTime = $00000010; + TypeCode_String = $00000012; + +// Constants for enum ApartmentState +type + ApartmentState = TOleEnum; +const + ApartmentState_STA = $00000000; + ApartmentState_MTA = $00000001; + ApartmentState_Unknown = $00000002; + +// Constants for enum ThreadPriority +type + ThreadPriority = TOleEnum; +const + ThreadPriority_Lowest = $00000000; + ThreadPriority_BelowNormal = $00000001; + ThreadPriority_Normal = $00000002; + ThreadPriority_AboveNormal = $00000003; + ThreadPriority_Highest = $00000004; + +// Constants for enum ThreadState +type + ThreadState = TOleEnum; +const + ThreadState_Running = $00000000; + ThreadState_StopRequested = $00000001; + ThreadState_SuspendRequested = $00000002; + ThreadState_Background = $00000004; + ThreadState_Unstarted = $00000008; + ThreadState_Stopped = $00000010; + ThreadState_WaitSleepJoin = $00000020; + ThreadState_Suspended = $00000040; + ThreadState_AbortRequested = $00000080; + ThreadState_Aborted = $00000100; + +// Constants for enum SymAddressKind +type + SymAddressKind = TOleEnum; +const + SymAddressKind_ILOffset = $00000001; + SymAddressKind_NativeRVA = $00000002; + SymAddressKind_NativeRegister = $00000003; + SymAddressKind_NativeRegisterRelative = $00000004; + SymAddressKind_NativeOffset = $00000005; + SymAddressKind_NativeRegisterRegister = $00000006; + SymAddressKind_NativeRegisterStack = $00000007; + SymAddressKind_NativeStackRegister = $00000008; + SymAddressKind_BitField = $00000009; + +// Constants for enum AssemblyNameFlags +type + AssemblyNameFlags = TOleEnum; +const + AssemblyNameFlags_None = $00000000; + AssemblyNameFlags_PublicKey = $00000001; + AssemblyNameFlags_Retargetable = $00000100; + +// Constants for enum BindingFlags +type + BindingFlags = TOleEnum; +const + BindingFlags_Default = $00000000; + BindingFlags_IgnoreCase = $00000001; + BindingFlags_DeclaredOnly = $00000002; + BindingFlags_Instance = $00000004; + BindingFlags_Static = $00000008; + BindingFlags_Public = $00000010; + BindingFlags_NonPublic = $00000020; + BindingFlags_FlattenHierarchy = $00000040; + BindingFlags_InvokeMethod = $00000100; + BindingFlags_CreateInstance = $00000200; + BindingFlags_GetField = $00000400; + BindingFlags_SetField = $00000800; + BindingFlags_GetProperty = $00001000; + BindingFlags_SetProperty = $00002000; + BindingFlags_PutDispProperty = $00004000; + BindingFlags_PutRefDispProperty = $00008000; + BindingFlags_ExactBinding = $00010000; + BindingFlags_SuppressChangeType = $00020000; + BindingFlags_OptionalParamBinding = $00040000; + BindingFlags_IgnoreReturn = $01000000; + +// Constants for enum CallingConventions +type + CallingConventions = TOleEnum; +const + CallingConventions_Standard = $00000001; + CallingConventions_VarArgs = $00000002; + CallingConventions_Any = $00000003; + CallingConventions_HasThis = $00000020; + CallingConventions_ExplicitThis = $00000040; + +// Constants for enum EventAttributes +type + EventAttributes = TOleEnum; +const + EventAttributes_None = $00000000; + EventAttributes_SpecialName = $00000200; + EventAttributes_ReservedMask = $00000400; + EventAttributes_RTSpecialName = $00000400; + +// Constants for enum FieldAttributes +type + FieldAttributes = TOleEnum; +const + FieldAttributes_FieldAccessMask = $00000007; + FieldAttributes_PrivateScope = $00000000; + FieldAttributes_Private = $00000001; + FieldAttributes_FamANDAssem = $00000002; + FieldAttributes_Assembly = $00000003; + FieldAttributes_Family = $00000004; + FieldAttributes_FamORAssem = $00000005; + FieldAttributes_Public = $00000006; + FieldAttributes_Static = $00000010; + FieldAttributes_InitOnly = $00000020; + FieldAttributes_Literal = $00000040; + FieldAttributes_NotSerialized = $00000080; + FieldAttributes_SpecialName = $00000200; + FieldAttributes_PinvokeImpl = $00002000; + FieldAttributes_ReservedMask = $00009500; + FieldAttributes_RTSpecialName = $00000400; + FieldAttributes_HasFieldMarshal = $00001000; + FieldAttributes_HasDefault = $00008000; + FieldAttributes_HasFieldRVA = $00000100; + +// Constants for enum ResourceLocation +type + ResourceLocation = TOleEnum; +const + ResourceLocation_Embedded = $00000001; + ResourceLocation_ContainedInAnotherAssembly = $00000002; + ResourceLocation_ContainedInManifestFile = $00000004; + +// Constants for enum MemberTypes +type + MemberTypes = TOleEnum; +const + MemberTypes_Constructor = $00000001; + MemberTypes_Event = $00000002; + MemberTypes_Field = $00000004; + MemberTypes_Method = $00000008; + MemberTypes_Property = $00000010; + MemberTypes_TypeInfo = $00000020; + MemberTypes_Custom = $00000040; + MemberTypes_NestedType = $00000080; + MemberTypes_All = $000000BF; + +// Constants for enum MethodAttributes +type + MethodAttributes = TOleEnum; +const + MethodAttributes_MemberAccessMask = $00000007; + MethodAttributes_PrivateScope = $00000000; + MethodAttributes_Private = $00000001; + MethodAttributes_FamANDAssem = $00000002; + MethodAttributes_Assembly = $00000003; + MethodAttributes_Family = $00000004; + MethodAttributes_FamORAssem = $00000005; + MethodAttributes_Public = $00000006; + MethodAttributes_Static = $00000010; + MethodAttributes_Final = $00000020; + MethodAttributes_Virtual = $00000040; + MethodAttributes_HideBySig = $00000080; + MethodAttributes_CheckAccessOnOverride = $00000200; + MethodAttributes_VtableLayoutMask = $00000100; + MethodAttributes_ReuseSlot = $00000000; + MethodAttributes_NewSlot = $00000100; + MethodAttributes_Abstract = $00000400; + MethodAttributes_SpecialName = $00000800; + MethodAttributes_PinvokeImpl = $00002000; + MethodAttributes_UnmanagedExport = $00000008; + MethodAttributes_RTSpecialName = $00001000; + MethodAttributes_ReservedMask = $0000D000; + MethodAttributes_HasSecurity = $00004000; + MethodAttributes_RequireSecObject = $00008000; + +// Constants for enum MethodImplAttributes +type + MethodImplAttributes = TOleEnum; +const + MethodImplAttributes_CodeTypeMask = $00000003; + MethodImplAttributes_IL = $00000000; + MethodImplAttributes_Native = $00000001; + MethodImplAttributes_OPTIL = $00000002; + MethodImplAttributes_Runtime = $00000003; + MethodImplAttributes_ManagedMask = $00000004; + MethodImplAttributes_Unmanaged = $00000004; + MethodImplAttributes_Managed = $00000000; + MethodImplAttributes_ForwardRef = $00000010; + MethodImplAttributes_PreserveSig = $00000080; + MethodImplAttributes_InternalCall = $00001000; + MethodImplAttributes_Synchronized = $00000020; + MethodImplAttributes_NoInlining = $00000008; + MethodImplAttributes_MaxMethodImplVal = $0000FFFF; + +// Constants for enum ParameterAttributes +type + ParameterAttributes = TOleEnum; +const + ParameterAttributes_None = $00000000; + ParameterAttributes_In = $00000001; + ParameterAttributes_Out = $00000002; + ParameterAttributes_Lcid = $00000004; + ParameterAttributes_Retval = $00000008; + ParameterAttributes_Optional = $00000010; + ParameterAttributes_ReservedMask = $0000F000; + ParameterAttributes_HasDefault = $00001000; + ParameterAttributes_HasFieldMarshal = $00002000; + ParameterAttributes_Reserved3 = $00004000; + ParameterAttributes_Reserved4 = $00008000; + +// Constants for enum PropertyAttributes +type + PropertyAttributes = TOleEnum; +const + PropertyAttributes_None = $00000000; + PropertyAttributes_SpecialName = $00000200; + PropertyAttributes_ReservedMask = $0000F400; + PropertyAttributes_RTSpecialName = $00000400; + PropertyAttributes_HasDefault = $00001000; + PropertyAttributes_Reserved2 = $00002000; + PropertyAttributes_Reserved3 = $00004000; + PropertyAttributes_Reserved4 = $00008000; + +// Constants for enum ResourceAttributes +type + ResourceAttributes = TOleEnum; +const + ResourceAttributes_Public = $00000001; + ResourceAttributes_Private = $00000002; + +// Constants for enum TypeAttributes +type + TypeAttributes = TOleEnum; +const + TypeAttributes_VisibilityMask = $00000007; + TypeAttributes_NotPublic = $00000000; + TypeAttributes_Public = $00000001; + TypeAttributes_NestedPublic = $00000002; + TypeAttributes_NestedPrivate = $00000003; + TypeAttributes_NestedFamily = $00000004; + TypeAttributes_NestedAssembly = $00000005; + TypeAttributes_NestedFamANDAssem = $00000006; + TypeAttributes_NestedFamORAssem = $00000007; + TypeAttributes_LayoutMask = $00000018; + TypeAttributes_AutoLayout = $00000000; + TypeAttributes_SequentialLayout = $00000008; + TypeAttributes_ExplicitLayout = $00000010; + TypeAttributes_ClassSemanticsMask = $00000020; + TypeAttributes_Class = $00000000; + TypeAttributes_Interface = $00000020; + TypeAttributes_Abstract = $00000080; + TypeAttributes_Sealed = $00000100; + TypeAttributes_SpecialName = $00000400; + TypeAttributes_Import = $00001000; + TypeAttributes_Serializable = $00002000; + TypeAttributes_StringFormatMask = $00030000; + TypeAttributes_AnsiClass = $00000000; + TypeAttributes_UnicodeClass = $00010000; + TypeAttributes_AutoClass = $00020000; + TypeAttributes_BeforeFieldInit = $00100000; + TypeAttributes_ReservedMask = $00040800; + TypeAttributes_RTSpecialName = $00000800; + TypeAttributes_HasSecurity = $00040000; + +// Constants for enum StreamingContextStates +type + StreamingContextStates = TOleEnum; +const + StreamingContextStates_CrossProcess = $00000001; + StreamingContextStates_CrossMachine = $00000002; + StreamingContextStates_File = $00000004; + StreamingContextStates_Persistence = $00000008; + StreamingContextStates_Remoting = $00000010; + StreamingContextStates_Other = $00000020; + StreamingContextStates_Clone = $00000040; + StreamingContextStates_CrossAppDomain = $00000080; + StreamingContextStates_All = $000000FF; + +// Constants for enum CalendarWeekRule +type + CalendarWeekRule = TOleEnum; +const + CalendarWeekRule_FirstDay = $00000000; + CalendarWeekRule_FirstFullWeek = $00000001; + CalendarWeekRule_FirstFourDayWeek = $00000002; + +// Constants for enum CompareOptions +type + CompareOptions = TOleEnum; +const + CompareOptions_None = $00000000; + CompareOptions_IgnoreCase = $00000001; + CompareOptions_IgnoreNonSpace = $00000002; + CompareOptions_IgnoreSymbols = $00000004; + CompareOptions_IgnoreKanaType = $00000008; + CompareOptions_IgnoreWidth = $00000010; + CompareOptions_StringSort = $20000000; + CompareOptions_Ordinal = $40000000; + +// Constants for enum CultureTypes +type + CultureTypes = TOleEnum; +const + CultureTypes_NeutralCultures = $00000001; + CultureTypes_SpecificCultures = $00000002; + CultureTypes_InstalledWin32Cultures = $00000004; + CultureTypes_AllCultures = $00000007; + +// Constants for enum DateTimeStyles +type + DateTimeStyles = TOleEnum; +const + DateTimeStyles_None = $00000000; + DateTimeStyles_AllowLeadingWhite = $00000001; + DateTimeStyles_AllowTrailingWhite = $00000002; + DateTimeStyles_AllowInnerWhite = $00000004; + DateTimeStyles_AllowWhiteSpaces = $00000007; + DateTimeStyles_NoCurrentDateDefault = $00000008; + DateTimeStyles_AdjustToUniversal = $00000010; + +// Constants for enum GregorianCalendarTypes +type + GregorianCalendarTypes = TOleEnum; +const + GregorianCalendarTypes_Localized = $00000001; + GregorianCalendarTypes_USEnglish = $00000002; + GregorianCalendarTypes_MiddleEastFrench = $00000009; + GregorianCalendarTypes_Arabic = $0000000A; + GregorianCalendarTypes_TransliteratedEnglish = $0000000B; + GregorianCalendarTypes_TransliteratedFrench = $0000000C; + +// Constants for enum NumberStyles +type + NumberStyles = TOleEnum; +const + NumberStyles_None = $00000000; + NumberStyles_AllowLeadingWhite = $00000001; + NumberStyles_AllowTrailingWhite = $00000002; + NumberStyles_AllowLeadingSign = $00000004; + NumberStyles_AllowTrailingSign = $00000008; + NumberStyles_AllowParentheses = $00000010; + NumberStyles_AllowDecimalPoint = $00000020; + NumberStyles_AllowThousands = $00000040; + NumberStyles_AllowExponent = $00000080; + NumberStyles_AllowCurrencySymbol = $00000100; + NumberStyles_AllowHexSpecifier = $00000200; + NumberStyles_Integer = $00000007; + NumberStyles_HexNumber = $00000203; + NumberStyles_Number = $0000006F; + NumberStyles_Float = $000000A7; + NumberStyles_Currency = $0000017F; + NumberStyles_Any = $000001FF; + +// Constants for enum UnicodeCategory +type + UnicodeCategory = TOleEnum; +const + UnicodeCategory_UppercaseLetter = $00000000; + UnicodeCategory_LowercaseLetter = $00000001; + UnicodeCategory_TitlecaseLetter = $00000002; + UnicodeCategory_ModifierLetter = $00000003; + UnicodeCategory_OtherLetter = $00000004; + UnicodeCategory_NonSpacingMark = $00000005; + UnicodeCategory_SpacingCombiningMark = $00000006; + UnicodeCategory_EnclosingMark = $00000007; + UnicodeCategory_DecimalDigitNumber = $00000008; + UnicodeCategory_LetterNumber = $00000009; + UnicodeCategory_OtherNumber = $0000000A; + UnicodeCategory_SpaceSeparator = $0000000B; + UnicodeCategory_LineSeparator = $0000000C; + UnicodeCategory_ParagraphSeparator = $0000000D; + UnicodeCategory_Control = $0000000E; + UnicodeCategory_Format = $0000000F; + UnicodeCategory_Surrogate = $00000010; + UnicodeCategory_PrivateUse = $00000011; + UnicodeCategory_ConnectorPunctuation = $00000012; + UnicodeCategory_DashPunctuation = $00000013; + UnicodeCategory_OpenPunctuation = $00000014; + UnicodeCategory_ClosePunctuation = $00000015; + UnicodeCategory_InitialQuotePunctuation = $00000016; + UnicodeCategory_FinalQuotePunctuation = $00000017; + UnicodeCategory_OtherPunctuation = $00000018; + UnicodeCategory_MathSymbol = $00000019; + UnicodeCategory_CurrencySymbol = $0000001A; + UnicodeCategory_ModifierSymbol = $0000001B; + UnicodeCategory_OtherSymbol = $0000001C; + UnicodeCategory_OtherNotAssigned = $0000001D; + +// Constants for enum RegistryHive +type + RegistryHive = TOleEnum; +const + RegistryHive_ClassesRoot = $80000000; + RegistryHive_CurrentUser = $80000001; + RegistryHive_LocalMachine = $80000002; + RegistryHive_Users = $80000003; + RegistryHive_PerformanceData = $80000004; + RegistryHive_CurrentConfig = $80000005; + RegistryHive_DynData = $80000006; + +// Constants for enum FromBase64TransformMode +type + FromBase64TransformMode = TOleEnum; +const + FromBase64TransformMode_IgnoreWhiteSpaces = $00000000; + FromBase64TransformMode_DoNotIgnoreWhiteSpaces = $00000001; + +// Constants for enum CipherMode +type + CipherMode = TOleEnum; +const + CipherMode_CBC = $00000001; + CipherMode_ECB = $00000002; + CipherMode_OFB = $00000003; + CipherMode_CFB = $00000004; + CipherMode_CTS = $00000005; + +// Constants for enum PaddingMode +type + PaddingMode = TOleEnum; +const + PaddingMode_None = $00000001; + PaddingMode_PKCS7 = $00000002; + PaddingMode_Zeros = $00000003; + +// Constants for enum CspProviderFlags +type + CspProviderFlags = TOleEnum; +const + CspProviderFlags_UseMachineKeyStore = $00000001; + CspProviderFlags_UseDefaultKeyContainer = $00000002; + +// Constants for enum CryptoStreamMode +type + CryptoStreamMode = TOleEnum; +const + CryptoStreamMode_Read = $00000000; + CryptoStreamMode_Write = $00000001; + +// Constants for enum PolicyStatementAttribute +type + PolicyStatementAttribute = TOleEnum; +const + PolicyStatementAttribute_Nothing = $00000000; + PolicyStatementAttribute_Exclusive = $00000001; + PolicyStatementAttribute_LevelFinal = $00000002; + PolicyStatementAttribute_All = $00000003; + +// Constants for enum PrincipalPolicy +type + PrincipalPolicy = TOleEnum; +const + PrincipalPolicy_UnauthenticatedPrincipal = $00000000; + PrincipalPolicy_NoPrincipal = $00000001; + PrincipalPolicy_WindowsPrincipal = $00000002; + +// Constants for enum WindowsAccountType +type + WindowsAccountType = TOleEnum; +const + WindowsAccountType_Normal = $00000000; + WindowsAccountType_Guest = $00000001; + WindowsAccountType_System = $00000002; + WindowsAccountType_Anonymous = $00000003; + +// Constants for enum WindowsBuiltInRole +type + WindowsBuiltInRole = TOleEnum; +const + WindowsBuiltInRole_Administrator = $00000220; + WindowsBuiltInRole_User = $00000221; + WindowsBuiltInRole_Guest = $00000222; + WindowsBuiltInRole_PowerUser = $00000223; + WindowsBuiltInRole_AccountOperator = $00000224; + WindowsBuiltInRole_SystemOperator = $00000225; + WindowsBuiltInRole_PrintOperator = $00000226; + WindowsBuiltInRole_BackupOperator = $00000227; + WindowsBuiltInRole_Replicator = $00000228; + +// Constants for enum ComInterfaceType +type + ComInterfaceType = TOleEnum; +const + ComInterfaceType_InterfaceIsDual = $00000000; + ComInterfaceType_InterfaceIsIUnknown = $00000001; + ComInterfaceType_InterfaceIsIDispatch = $00000002; + +// Constants for enum ClassInterfaceType +type + ClassInterfaceType = TOleEnum; +const + ClassInterfaceType_None = $00000000; + ClassInterfaceType_AutoDispatch = $00000001; + ClassInterfaceType_AutoDual = $00000002; + +// Constants for enum IDispatchImplType +type + IDispatchImplType = TOleEnum; +const + IDispatchImplType_SystemDefinedImpl = $00000000; + IDispatchImplType_InternalImpl = $00000001; + IDispatchImplType_CompatibleImpl = $00000002; + +// Constants for enum TypeLibTypeFlags +type + TypeLibTypeFlags = TOleEnum; +const + TypeLibTypeFlags_FAppObject = $00000001; + TypeLibTypeFlags_FCanCreate = $00000002; + TypeLibTypeFlags_FLicensed = $00000004; + TypeLibTypeFlags_FPreDeclId = $00000008; + TypeLibTypeFlags_FHidden = $00000010; + TypeLibTypeFlags_FControl = $00000020; + TypeLibTypeFlags_FDual = $00000040; + TypeLibTypeFlags_FNonExtensible = $00000080; + TypeLibTypeFlags_FOleAutomation = $00000100; + TypeLibTypeFlags_FRestricted = $00000200; + TypeLibTypeFlags_FAggregatable = $00000400; + TypeLibTypeFlags_FReplaceable = $00000800; + TypeLibTypeFlags_FDispatchable = $00001000; + TypeLibTypeFlags_FReverseBind = $00002000; + +// Constants for enum TypeLibFuncFlags +type + TypeLibFuncFlags = TOleEnum; +const + TypeLibFuncFlags_FRestricted = $00000001; + TypeLibFuncFlags_FSource = $00000002; + TypeLibFuncFlags_FBindable = $00000004; + TypeLibFuncFlags_FRequestEdit = $00000008; + TypeLibFuncFlags_FDisplayBind = $00000010; + TypeLibFuncFlags_FDefaultBind = $00000020; + TypeLibFuncFlags_FHidden = $00000040; + TypeLibFuncFlags_FUsesGetLastError = $00000080; + TypeLibFuncFlags_FDefaultCollelem = $00000100; + TypeLibFuncFlags_FUiDefault = $00000200; + TypeLibFuncFlags_FNonBrowsable = $00000400; + TypeLibFuncFlags_FReplaceable = $00000800; + TypeLibFuncFlags_FImmediateBind = $00001000; + +// Constants for enum TypeLibVarFlags +type + TypeLibVarFlags = TOleEnum; +const + TypeLibVarFlags_FReadOnly = $00000001; + TypeLibVarFlags_FSource = $00000002; + TypeLibVarFlags_FBindable = $00000004; + TypeLibVarFlags_FRequestEdit = $00000008; + TypeLibVarFlags_FDisplayBind = $00000010; + TypeLibVarFlags_FDefaultBind = $00000020; + TypeLibVarFlags_FHidden = $00000040; + TypeLibVarFlags_FRestricted = $00000080; + TypeLibVarFlags_FDefaultCollelem = $00000100; + TypeLibVarFlags_FUiDefault = $00000200; + TypeLibVarFlags_FNonBrowsable = $00000400; + TypeLibVarFlags_FReplaceable = $00000800; + TypeLibVarFlags_FImmediateBind = $00001000; + +// Constants for enum VarEnum +type + VarEnum = TOleEnum; +const + VarEnum_VT_EMPTY = $00000000; + VarEnum_VT_NULL = $00000001; + VarEnum_VT_I2 = $00000002; + VarEnum_VT_I4 = $00000003; + VarEnum_VT_R4 = $00000004; + VarEnum_VT_R8 = $00000005; + VarEnum_VT_CY = $00000006; + VarEnum_VT_DATE = $00000007; + VarEnum_VT_BSTR = $00000008; + VarEnum_VT_DISPATCH = $00000009; + VarEnum_VT_ERROR = $0000000A; + VarEnum_VT_BOOL = $0000000B; + VarEnum_VT_VARIANT = $0000000C; + VarEnum_VT_UNKNOWN = $0000000D; + VarEnum_VT_DECIMAL = $0000000E; + VarEnum_VT_I1 = $00000010; + VarEnum_VT_UI1 = $00000011; + VarEnum_VT_UI2 = $00000012; + VarEnum_VT_UI4 = $00000013; + VarEnum_VT_I8 = $00000014; + VarEnum_VT_UI8 = $00000015; + VarEnum_VT_INT = $00000016; + VarEnum_VT_UINT = $00000017; + VarEnum_VT_VOID = $00000018; + VarEnum_VT_HRESULT = $00000019; + VarEnum_VT_PTR = $0000001A; + VarEnum_VT_SAFEARRAY = $0000001B; + VarEnum_VT_CARRAY = $0000001C; + VarEnum_VT_USERDEFINED = $0000001D; + VarEnum_VT_LPSTR = $0000001E; + VarEnum_VT_LPWSTR = $0000001F; + VarEnum_VT_RECORD = $00000024; + VarEnum_VT_FILETIME = $00000040; + VarEnum_VT_BLOB = $00000041; + VarEnum_VT_STREAM = $00000042; + VarEnum_VT_STORAGE = $00000043; + VarEnum_VT_STREAMED_OBJECT = $00000044; + VarEnum_VT_STORED_OBJECT = $00000045; + VarEnum_VT_BLOB_OBJECT = $00000046; + VarEnum_VT_CF = $00000047; + VarEnum_VT_CLSID = $00000048; + VarEnum_VT_VECTOR = $00001000; + VarEnum_VT_ARRAY = $00002000; + VarEnum_VT_BYREF = $00004000; + +// Constants for enum UnmanagedType +type + UnmanagedType = TOleEnum; +const + UnmanagedType_Bool = $00000002; + UnmanagedType_I1 = $00000003; + UnmanagedType_U1 = $00000004; + UnmanagedType_I2 = $00000005; + UnmanagedType_U2 = $00000006; + UnmanagedType_I4 = $00000007; + UnmanagedType_U4 = $00000008; + UnmanagedType_I8 = $00000009; + UnmanagedType_U8 = $0000000A; + UnmanagedType_R4 = $0000000B; + UnmanagedType_R8 = $0000000C; + UnmanagedType_Currency = $0000000F; + UnmanagedType_BStr = $00000013; + UnmanagedType_LPStr = $00000014; + UnmanagedType_LPWStr = $00000015; + UnmanagedType_LPTStr = $00000016; + UnmanagedType_ByValTStr = $00000017; + UnmanagedType_IUnknown = $00000019; + UnmanagedType_IDispatch = $0000001A; + UnmanagedType_Struct = $0000001B; + UnmanagedType_Interface = $0000001C; + UnmanagedType_SafeArray = $0000001D; + UnmanagedType_ByValArray = $0000001E; + UnmanagedType_SysInt = $0000001F; + UnmanagedType_SysUInt = $00000020; + UnmanagedType_VBByRefStr = $00000022; + UnmanagedType_AnsiBStr = $00000023; + UnmanagedType_TBStr = $00000024; + UnmanagedType_VariantBool = $00000025; + UnmanagedType_FunctionPtr = $00000026; + UnmanagedType_AsAny = $00000028; + UnmanagedType_LPArray = $0000002A; + UnmanagedType_LPStruct = $0000002B; + UnmanagedType_CustomMarshaler = $0000002C; + UnmanagedType_Error = $0000002D; + +// Constants for enum CallingConvention +type + CallingConvention = TOleEnum; +const + CallingConvention_Winapi = $00000001; + CallingConvention_Cdecl = $00000002; + CallingConvention_StdCall = $00000003; + CallingConvention_ThisCall = $00000004; + CallingConvention_FastCall = $00000005; + +// Constants for enum CharSet +type + CharSet = TOleEnum; +const + CharSet_None = $00000001; + CharSet_Ansi = $00000002; + CharSet_Unicode = $00000003; + CharSet_Auto = $00000004; + +// Constants for enum ComMemberType +type + ComMemberType = TOleEnum; +const + ComMemberType_Method = $00000000; + ComMemberType_PropGet = $00000001; + ComMemberType_PropSet = $00000002; + +// Constants for enum GCHandleType +type + GCHandleType = TOleEnum; +const + GCHandleType_Weak = $00000000; + GCHandleType_WeakTrackResurrection = $00000001; + GCHandleType_Normal = $00000002; + GCHandleType_Pinned = $00000003; + +// Constants for enum AssemblyRegistrationFlags +type + AssemblyRegistrationFlags = TOleEnum; +const + AssemblyRegistrationFlags_None = $00000000; + AssemblyRegistrationFlags_SetCodeBase = $00000001; + +// Constants for enum TypeLibImporterFlags +type + TypeLibImporterFlags = TOleEnum; +const + TypeLibImporterFlags_PrimaryInteropAssembly = $00000001; + TypeLibImporterFlags_UnsafeInterfaces = $00000002; + TypeLibImporterFlags_SafeArrayAsSystemArray = $00000004; + TypeLibImporterFlags_TransformDispRetVals = $00000008; + +// Constants for enum TypeLibExporterFlags +type + TypeLibExporterFlags = TOleEnum; +const + TypeLibExporterFlags_OnlyReferenceRegistered = $00000001; + +// Constants for enum ImporterEventKind +type + ImporterEventKind = TOleEnum; +const + ImporterEventKind_NOTIF_TYPECONVERTED = $00000000; + ImporterEventKind_NOTIF_CONVERTWARNING = $00000001; + ImporterEventKind_ERROR_REFTOINVALIDTYPELIB = $00000002; + +// Constants for enum ExporterEventKind +type + ExporterEventKind = TOleEnum; +const + ExporterEventKind_NOTIF_TYPECONVERTED = $00000000; + ExporterEventKind_NOTIF_CONVERTWARNING = $00000001; + ExporterEventKind_ERROR_REFTOINVALIDASSEMBLY = $00000002; + +// Constants for enum LayoutKind +type + LayoutKind = TOleEnum; +const + LayoutKind_Sequential = $00000000; + LayoutKind_Explicit = $00000002; + LayoutKind_Auto = $00000003; + +// Constants for enum FileAccess +type + FileAccess = TOleEnum; +const + FileAccess_Read = $00000001; + FileAccess_Write = $00000002; + FileAccess_ReadWrite = $00000003; + +// Constants for enum FileMode +type + FileMode = TOleEnum; +const + FileMode_CreateNew = $00000001; + FileMode_Create = $00000002; + FileMode_Open = $00000003; + FileMode_OpenOrCreate = $00000004; + FileMode_Truncate = $00000005; + FileMode_Append = $00000006; + +// Constants for enum FileShare +type + FileShare = TOleEnum; +const + FileShare_None = $00000000; + FileShare_Read = $00000001; + FileShare_Write = $00000002; + FileShare_ReadWrite = $00000003; + FileShare_Inheritable = $00000010; + +// Constants for enum FileAttributes +type + FileAttributes = TOleEnum; +const + FileAttributes_ReadOnly = $00000001; + FileAttributes_Hidden = $00000002; + FileAttributes_System = $00000004; + FileAttributes_Directory = $00000010; + FileAttributes_Archive = $00000020; + FileAttributes_Device = $00000040; + FileAttributes_Normal = $00000080; + FileAttributes_Temporary = $00000100; + FileAttributes_SparseFile = $00000200; + FileAttributes_ReparsePoint = $00000400; + FileAttributes_Compressed = $00000800; + FileAttributes_Offline = $00001000; + FileAttributes_NotContentIndexed = $00002000; + FileAttributes_Encrypted = $00004000; + +// Constants for enum SeekOrigin +type + SeekOrigin = TOleEnum; +const + SeekOrigin_Begin = $00000000; + SeekOrigin_Current = $00000001; + SeekOrigin_End = $00000002; + +// Constants for enum MethodImplOptions +type + MethodImplOptions = TOleEnum; +const + MethodImplOptions_Unmanaged = $00000004; + MethodImplOptions_ForwardRef = $00000010; + MethodImplOptions_PreserveSig = $00000080; + MethodImplOptions_InternalCall = $00001000; + MethodImplOptions_Synchronized = $00000020; + MethodImplOptions_NoInlining = $00000008; + +// Constants for enum MethodCodeType +type + MethodCodeType = TOleEnum; +const + MethodCodeType_IL = $00000000; + MethodCodeType_Native = $00000001; + MethodCodeType_OPTIL = $00000002; + MethodCodeType_Runtime = $00000003; + +// Constants for enum EnvironmentPermissionAccess +type + EnvironmentPermissionAccess = TOleEnum; +const + EnvironmentPermissionAccess_NoAccess = $00000000; + EnvironmentPermissionAccess_Read = $00000001; + EnvironmentPermissionAccess_Write = $00000002; + EnvironmentPermissionAccess_AllAccess = $00000003; + +// Constants for enum FileDialogPermissionAccess +type + FileDialogPermissionAccess = TOleEnum; +const + FileDialogPermissionAccess_None = $00000000; + FileDialogPermissionAccess_Open = $00000001; + FileDialogPermissionAccess_Save = $00000002; + FileDialogPermissionAccess_OpenSave = $00000003; + +// Constants for enum FileIOPermissionAccess +type + FileIOPermissionAccess = TOleEnum; +const + FileIOPermissionAccess_NoAccess = $00000000; + FileIOPermissionAccess_Read = $00000001; + FileIOPermissionAccess_Write = $00000002; + FileIOPermissionAccess_Append = $00000004; + FileIOPermissionAccess_PathDiscovery = $00000008; + FileIOPermissionAccess_AllAccess = $0000000F; + +// Constants for enum IsolatedStorageContainment +type + IsolatedStorageContainment = TOleEnum; +const + IsolatedStorageContainment_None = $00000000; + IsolatedStorageContainment_DomainIsolationByUser = $00000010; + IsolatedStorageContainment_AssemblyIsolationByUser = $00000020; + IsolatedStorageContainment_DomainIsolationByRoamingUser = $00000050; + IsolatedStorageContainment_AssemblyIsolationByRoamingUser = $00000060; + IsolatedStorageContainment_AdministerIsolatedStorageByUser = $00000070; + IsolatedStorageContainment_UnrestrictedIsolatedStorage = $000000F0; + +// Constants for enum PermissionState +type + PermissionState = TOleEnum; +const + PermissionState_Unrestricted = $00000001; + PermissionState_None = $00000000; + +// Constants for enum SecurityAction +type + SecurityAction = TOleEnum; +const + SecurityAction_Demand = $00000002; + SecurityAction_Assert = $00000003; + SecurityAction_Deny = $00000004; + SecurityAction_PermitOnly = $00000005; + SecurityAction_LinkDemand = $00000006; + SecurityAction_InheritanceDemand = $00000007; + SecurityAction_RequestMinimum = $00000008; + SecurityAction_RequestOptional = $00000009; + SecurityAction_RequestRefuse = $0000000A; + +// Constants for enum ReflectionPermissionFlag +type + ReflectionPermissionFlag = TOleEnum; +const + ReflectionPermissionFlag_NoFlags = $00000000; + ReflectionPermissionFlag_TypeInformation = $00000001; + ReflectionPermissionFlag_MemberAccess = $00000002; + ReflectionPermissionFlag_ReflectionEmit = $00000004; + ReflectionPermissionFlag_AllFlags = $00000007; + +// Constants for enum RegistryPermissionAccess +type + RegistryPermissionAccess = TOleEnum; +const + RegistryPermissionAccess_NoAccess = $00000000; + RegistryPermissionAccess_Read = $00000001; + RegistryPermissionAccess_Write = $00000002; + RegistryPermissionAccess_Create = $00000004; + RegistryPermissionAccess_AllAccess = $00000007; + +// Constants for enum SecurityPermissionFlag +type + SecurityPermissionFlag = TOleEnum; +const + SecurityPermissionFlag_NoFlags = $00000000; + SecurityPermissionFlag_Assertion = $00000001; + SecurityPermissionFlag_UnmanagedCode = $00000002; + SecurityPermissionFlag_SkipVerification = $00000004; + SecurityPermissionFlag_Execution = $00000008; + SecurityPermissionFlag_ControlThread = $00000010; + SecurityPermissionFlag_ControlEvidence = $00000020; + SecurityPermissionFlag_ControlPolicy = $00000040; + SecurityPermissionFlag_SerializationFormatter = $00000080; + SecurityPermissionFlag_ControlDomainPolicy = $00000100; + SecurityPermissionFlag_ControlPrincipal = $00000200; + SecurityPermissionFlag_ControlAppDomain = $00000400; + SecurityPermissionFlag_RemotingConfiguration = $00000800; + SecurityPermissionFlag_Infrastructure = $00001000; + SecurityPermissionFlag_BindingRedirects = $00002000; + SecurityPermissionFlag_AllFlags = $00003FFF; + +// Constants for enum UIPermissionWindow +type + UIPermissionWindow = TOleEnum; +const + UIPermissionWindow_NoWindows = $00000000; + UIPermissionWindow_SafeSubWindows = $00000001; + UIPermissionWindow_SafeTopLevelWindows = $00000002; + UIPermissionWindow_AllWindows = $00000003; + +// Constants for enum UIPermissionClipboard +type + UIPermissionClipboard = TOleEnum; +const + UIPermissionClipboard_NoClipboard = $00000000; + UIPermissionClipboard_OwnClipboard = $00000001; + UIPermissionClipboard_AllClipboard = $00000002; + +// Constants for enum PolicyLevelType +type + PolicyLevelType = TOleEnum; +const + PolicyLevelType_User = $00000000; + PolicyLevelType_Machine = $00000001; + PolicyLevelType_Enterprise = $00000002; + PolicyLevelType_AppDomain = $00000003; + +// Constants for enum SecurityZone +type + SecurityZone = TOleEnum; +const + SecurityZone_MyComputer = $00000000; + SecurityZone_Intranet = $00000001; + SecurityZone_Trusted = $00000002; + SecurityZone_Internet = $00000003; + SecurityZone_Untrusted = $00000004; + SecurityZone_NoZone = $FFFFFFFF; + +// Constants for enum WellKnownObjectMode +type + WellKnownObjectMode = TOleEnum; +const + WellKnownObjectMode_Singleton = $00000001; + WellKnownObjectMode_SingleCall = $00000002; + +// Constants for enum ActivatorLevel +type + ActivatorLevel = TOleEnum; +const + ActivatorLevel_Construction = $00000004; + ActivatorLevel_Context = $00000008; + ActivatorLevel_AppDomain = $0000000C; + ActivatorLevel_Process = $00000010; + ActivatorLevel_Machine = $00000014; + +// Constants for enum ServerProcessing +type + ServerProcessing = TOleEnum; +const + ServerProcessing_Complete = $00000000; + ServerProcessing_OneWay = $00000001; + ServerProcessing_Async = $00000002; + +// Constants for enum LeaseState +type + LeaseState = TOleEnum; +const + LeaseState_Null = $00000000; + LeaseState_Initial = $00000001; + LeaseState_Active = $00000002; + LeaseState_Renewing = $00000003; + LeaseState_Expired = $00000004; + +// Constants for enum SoapOption +type + SoapOption = TOleEnum; +const + SoapOption_None = $00000000; + SoapOption_AlwaysIncludeTypes = $00000001; + SoapOption_XsdString = $00000002; + SoapOption_EmbedAll = $00000004; + SoapOption_Option1 = $00000008; + SoapOption_Option2 = $00000010; + +// Constants for enum XmlFieldOrderOption +type + XmlFieldOrderOption = TOleEnum; +const + XmlFieldOrderOption_All = $00000000; + XmlFieldOrderOption_Sequence = $00000001; + XmlFieldOrderOption_Choice = $00000002; + +// Constants for enum IsolatedStorageScope +type + IsolatedStorageScope = TOleEnum; +const + IsolatedStorageScope_None = $00000000; + IsolatedStorageScope_User = $00000001; + IsolatedStorageScope_Domain = $00000002; + IsolatedStorageScope_Assembly = $00000004; + IsolatedStorageScope_Roaming = $00000008; + +// Constants for enum FormatterTypeStyle +type + FormatterTypeStyle = TOleEnum; +const + FormatterTypeStyle_TypesWhenNeeded = $00000000; + FormatterTypeStyle_TypesAlways = $00000001; + FormatterTypeStyle_XsdString = $00000002; + +// Constants for enum FormatterAssemblyStyle +type + FormatterAssemblyStyle = TOleEnum; +const + FormatterAssemblyStyle_Simple = $00000000; + FormatterAssemblyStyle_Full = $00000001; + +// Constants for enum TypeFilterLevel +type + TypeFilterLevel = TOleEnum; +const + TypeFilterLevel_Low = $00000002; + TypeFilterLevel_Full = $00000003; + +// Constants for enum AssemblyBuilderAccess +type + AssemblyBuilderAccess = TOleEnum; +const + AssemblyBuilderAccess_Run = $00000001; + AssemblyBuilderAccess_Save = $00000002; + AssemblyBuilderAccess_RunAndSave = $00000003; + +// Constants for enum PEFileKinds +type + PEFileKinds = TOleEnum; +const + PEFileKinds_Dll = $00000001; + PEFileKinds_ConsoleApplication = $00000002; + PEFileKinds_WindowApplication = $00000003; + +// Constants for enum OpCodeType +type + OpCodeType = TOleEnum; +const + OpCodeType_Annotation = $00000000; + OpCodeType_Macro = $00000001; + OpCodeType_Nternal = $00000002; + OpCodeType_Objmodel = $00000003; + OpCodeType_Prefix = $00000004; + OpCodeType_Primitive = $00000005; + +// Constants for enum StackBehaviour +type + StackBehaviour = TOleEnum; +const + StackBehaviour_Pop0 = $00000000; + StackBehaviour_Pop1 = $00000001; + StackBehaviour_Pop1_pop1 = $00000002; + StackBehaviour_Popi = $00000003; + StackBehaviour_Popi_pop1 = $00000004; + StackBehaviour_Popi_popi = $00000005; + StackBehaviour_Popi_popi8 = $00000006; + StackBehaviour_Popi_popi_popi = $00000007; + StackBehaviour_Popi_popr4 = $00000008; + StackBehaviour_Popi_popr8 = $00000009; + StackBehaviour_Popref = $0000000A; + StackBehaviour_Popref_pop1 = $0000000B; + StackBehaviour_Popref_popi = $0000000C; + StackBehaviour_Popref_popi_popi = $0000000D; + StackBehaviour_Popref_popi_popi8 = $0000000E; + StackBehaviour_Popref_popi_popr4 = $0000000F; + StackBehaviour_Popref_popi_popr8 = $00000010; + StackBehaviour_Popref_popi_popref = $00000011; + StackBehaviour_Push0 = $00000012; + StackBehaviour_Push1 = $00000013; + StackBehaviour_Push1_push1 = $00000014; + StackBehaviour_Pushi = $00000015; + StackBehaviour_Pushi8 = $00000016; + StackBehaviour_Pushr4 = $00000017; + StackBehaviour_Pushr8 = $00000018; + StackBehaviour_Pushref = $00000019; + StackBehaviour_Varpop = $0000001A; + StackBehaviour_Varpush = $0000001B; + +// Constants for enum OperandType +type + OperandType = TOleEnum; +const + OperandType_InlineBrTarget = $00000000; + OperandType_InlineField = $00000001; + OperandType_InlineI = $00000002; + OperandType_InlineI8 = $00000003; + OperandType_InlineMethod = $00000004; + OperandType_InlineNone = $00000005; + OperandType_InlinePhi = $00000006; + OperandType_InlineR = $00000007; + OperandType_InlineSig = $00000009; + OperandType_InlineString = $0000000A; + OperandType_InlineSwitch = $0000000B; + OperandType_InlineTok = $0000000C; + OperandType_InlineType = $0000000D; + OperandType_InlineVar = $0000000E; + OperandType_ShortInlineBrTarget = $0000000F; + OperandType_ShortInlineI = $00000010; + OperandType_ShortInlineR = $00000011; + OperandType_ShortInlineVar = $00000012; + +// Constants for enum FlowControl +type + FlowControl = TOleEnum; +const + FlowControl_Branch = $00000000; + FlowControl_Break = $00000001; + FlowControl_Call = $00000002; + FlowControl_Cond_Branch = $00000003; + FlowControl_Meta = $00000004; + FlowControl_Next = $00000005; + FlowControl_Phi = $00000006; + FlowControl_Return = $00000007; + FlowControl_Throw = $00000008; + +// Constants for enum PackingSize +type + PackingSize = TOleEnum; +const + PackingSize_Unspecified = $00000000; + PackingSize_Size1 = $00000001; + PackingSize_Size2 = $00000002; + PackingSize_Size4 = $00000004; + PackingSize_Size8 = $00000008; + PackingSize_Size16 = $00000010; + +// Constants for enum AssemblyHashAlgorithm +type + AssemblyHashAlgorithm = TOleEnum; +const + AssemblyHashAlgorithm_None = $00000000; + AssemblyHashAlgorithm_MD5 = $00008003; + AssemblyHashAlgorithm_SHA1 = $00008004; + +// Constants for enum AssemblyVersionCompatibility +type + AssemblyVersionCompatibility = TOleEnum; +const + AssemblyVersionCompatibility_SameMachine = $00000001; + AssemblyVersionCompatibility_SameProcess = $00000002; + AssemblyVersionCompatibility_SameDomain = $00000003; + +type + +// *********************************************************************// +// Forward declaration of types defined in TypeLibrary +// *********************************************************************// + _Object = interface; + _ObjectDisp = dispinterface; + ICloneable = interface; + ICloneableDisp = dispinterface; + IEnumerable = interface; + IEnumerableDisp = dispinterface; + ICollection = interface; + ICollectionDisp = dispinterface; + IList = interface; + IListDisp = dispinterface; + _Array = interface; + _ArrayDisp = dispinterface; + IEnumerator = interface; + IEnumeratorDisp = dispinterface; + IComparable = interface; + IComparableDisp = dispinterface; + IConvertible = interface; + IConvertibleDisp = dispinterface; + _String = interface; + _StringDisp = dispinterface; + _StringBuilder = interface; + _StringBuilderDisp = dispinterface; + ISerializable = interface; + ISerializableDisp = dispinterface; + _Exception = interface; + _ExceptionDisp = dispinterface; + _ValueType = interface; + _ValueTypeDisp = dispinterface; + IFormattable = interface; + IFormattableDisp = dispinterface; + _SystemException = interface; + _SystemExceptionDisp = dispinterface; + _OutOfMemoryException = interface; + _OutOfMemoryExceptionDisp = dispinterface; + _StackOverflowException = interface; + _StackOverflowExceptionDisp = dispinterface; + _ExecutionEngineException = interface; + _ExecutionEngineExceptionDisp = dispinterface; + _Delegate = interface; + _DelegateDisp = dispinterface; + _MulticastDelegate = interface; + _MulticastDelegateDisp = dispinterface; + _Enum = interface; + _EnumDisp = dispinterface; + _MemberAccessException = interface; + _MemberAccessExceptionDisp = dispinterface; + _Activator = interface; + _ActivatorDisp = dispinterface; + _ApplicationException = interface; + _ApplicationExceptionDisp = dispinterface; + _EventArgs = interface; + _EventArgsDisp = dispinterface; + _ResolveEventArgs = interface; + _ResolveEventArgsDisp = dispinterface; + _AssemblyLoadEventArgs = interface; + _AssemblyLoadEventArgsDisp = dispinterface; + _ResolveEventHandler = interface; + _ResolveEventHandlerDisp = dispinterface; + _AssemblyLoadEventHandler = interface; + _AssemblyLoadEventHandlerDisp = dispinterface; + _MarshalByRefObject = interface; + _MarshalByRefObjectDisp = dispinterface; + _AppDomain = interface; + _AppDomainDisp = dispinterface; + IEvidenceFactory = interface; + IEvidenceFactoryDisp = dispinterface; + _CrossAppDomainDelegate = interface; + _CrossAppDomainDelegateDisp = dispinterface; + IAppDomainSetup = interface; + _Attribute = interface; + _AttributeDisp = dispinterface; + _LoaderOptimizationAttribute = interface; + _LoaderOptimizationAttributeDisp = dispinterface; + _AppDomainUnloadedException = interface; + _AppDomainUnloadedExceptionDisp = dispinterface; + _ArgumentException = interface; + _ArgumentExceptionDisp = dispinterface; + _ArgumentNullException = interface; + _ArgumentNullExceptionDisp = dispinterface; + _ArgumentOutOfRangeException = interface; + _ArgumentOutOfRangeExceptionDisp = dispinterface; + _ArithmeticException = interface; + _ArithmeticExceptionDisp = dispinterface; + _ArrayTypeMismatchException = interface; + _ArrayTypeMismatchExceptionDisp = dispinterface; + _AsyncCallback = interface; + _AsyncCallbackDisp = dispinterface; + _AttributeUsageAttribute = interface; + _AttributeUsageAttributeDisp = dispinterface; + _BadImageFormatException = interface; + _BadImageFormatExceptionDisp = dispinterface; + _BitConverter = interface; + _BitConverterDisp = dispinterface; + _Buffer = interface; + _BufferDisp = dispinterface; + _CannotUnloadAppDomainException = interface; + _CannotUnloadAppDomainExceptionDisp = dispinterface; + _CharEnumerator = interface; + _CharEnumeratorDisp = dispinterface; + _CLSCompliantAttribute = interface; + _CLSCompliantAttributeDisp = dispinterface; + _TypeUnloadedException = interface; + _TypeUnloadedExceptionDisp = dispinterface; + _Console = interface; + _ConsoleDisp = dispinterface; + _ContextMarshalException = interface; + _ContextMarshalExceptionDisp = dispinterface; + _Convert = interface; + _ConvertDisp = dispinterface; + _ContextBoundObject = interface; + _ContextBoundObjectDisp = dispinterface; + _ContextStaticAttribute = interface; + _ContextStaticAttributeDisp = dispinterface; + _TimeZone = interface; + _TimeZoneDisp = dispinterface; + _DBNull = interface; + _DBNullDisp = dispinterface; + _Binder = interface; + _BinderDisp = dispinterface; + IObjectReference = interface; + IObjectReferenceDisp = dispinterface; + _DivideByZeroException = interface; + _DivideByZeroExceptionDisp = dispinterface; + _DuplicateWaitObjectException = interface; + _DuplicateWaitObjectExceptionDisp = dispinterface; + _TypeLoadException = interface; + _TypeLoadExceptionDisp = dispinterface; + _EntryPointNotFoundException = interface; + _EntryPointNotFoundExceptionDisp = dispinterface; + _DllNotFoundException = interface; + _DllNotFoundExceptionDisp = dispinterface; + _Environment = interface; + _EnvironmentDisp = dispinterface; + _EventHandler = interface; + _EventHandlerDisp = dispinterface; + _FieldAccessException = interface; + _FieldAccessExceptionDisp = dispinterface; + _FlagsAttribute = interface; + _FlagsAttributeDisp = dispinterface; + _FormatException = interface; + _FormatExceptionDisp = dispinterface; + _GC = interface; + _GCDisp = dispinterface; + IAsyncResult = interface; + IAsyncResultDisp = dispinterface; + ICustomFormatter = interface; + ICustomFormatterDisp = dispinterface; + IDisposable = interface; + IDisposableDisp = dispinterface; + IFormatProvider = interface; + IFormatProviderDisp = dispinterface; + _IndexOutOfRangeException = interface; + _IndexOutOfRangeExceptionDisp = dispinterface; + _InvalidCastException = interface; + _InvalidCastExceptionDisp = dispinterface; + _InvalidOperationException = interface; + _InvalidOperationExceptionDisp = dispinterface; + _InvalidProgramException = interface; + _InvalidProgramExceptionDisp = dispinterface; + _LocalDataStoreSlot = interface; + _LocalDataStoreSlotDisp = dispinterface; + _Math = interface; + _MathDisp = dispinterface; + _MethodAccessException = interface; + _MethodAccessExceptionDisp = dispinterface; + _MissingMemberException = interface; + _MissingMemberExceptionDisp = dispinterface; + _MissingFieldException = interface; + _MissingFieldExceptionDisp = dispinterface; + _MissingMethodException = interface; + _MissingMethodExceptionDisp = dispinterface; + _MulticastNotSupportedException = interface; + _MulticastNotSupportedExceptionDisp = dispinterface; + _NonSerializedAttribute = interface; + _NonSerializedAttributeDisp = dispinterface; + _NotFiniteNumberException = interface; + _NotFiniteNumberExceptionDisp = dispinterface; + _NotImplementedException = interface; + _NotImplementedExceptionDisp = dispinterface; + _NotSupportedException = interface; + _NotSupportedExceptionDisp = dispinterface; + _NullReferenceException = interface; + _NullReferenceExceptionDisp = dispinterface; + _ObjectDisposedException = interface; + _ObjectDisposedExceptionDisp = dispinterface; + _ObsoleteAttribute = interface; + _ObsoleteAttributeDisp = dispinterface; + _OperatingSystem = interface; + _OperatingSystemDisp = dispinterface; + _OverflowException = interface; + _OverflowExceptionDisp = dispinterface; + _ParamArrayAttribute = interface; + _ParamArrayAttributeDisp = dispinterface; + _PlatformNotSupportedException = interface; + _PlatformNotSupportedExceptionDisp = dispinterface; + _Random = interface; + _RandomDisp = dispinterface; + _RankException = interface; + _RankExceptionDisp = dispinterface; + ICustomAttributeProvider = interface; + ICustomAttributeProviderDisp = dispinterface; + _MemberInfo = interface; + _MemberInfoDisp = dispinterface; + IReflect = interface; + IReflectDisp = dispinterface; + _Type = interface; + _TypeDisp = dispinterface; + _SerializableAttribute = interface; + _SerializableAttributeDisp = dispinterface; + _TypeInitializationException = interface; + _TypeInitializationExceptionDisp = dispinterface; + _UnauthorizedAccessException = interface; + _UnauthorizedAccessExceptionDisp = dispinterface; + _UnhandledExceptionEventArgs = interface; + _UnhandledExceptionEventArgsDisp = dispinterface; + _UnhandledExceptionEventHandler = interface; + _UnhandledExceptionEventHandlerDisp = dispinterface; + _Version = interface; + _VersionDisp = dispinterface; + _WeakReference = interface; + _WeakReferenceDisp = dispinterface; + _WaitHandle = interface; + _WaitHandleDisp = dispinterface; + _AutoResetEvent = interface; + _AutoResetEventDisp = dispinterface; + _CompressedStack = interface; + _CompressedStackDisp = dispinterface; + _Interlocked = interface; + _InterlockedDisp = dispinterface; + IObjectHandle = interface; + _ManualResetEvent = interface; + _ManualResetEventDisp = dispinterface; + _Monitor = interface; + _MonitorDisp = dispinterface; + _Mutex = interface; + _MutexDisp = dispinterface; + _Overlapped = interface; + _OverlappedDisp = dispinterface; + _ReaderWriterLock = interface; + _ReaderWriterLockDisp = dispinterface; + _SynchronizationLockException = interface; + _SynchronizationLockExceptionDisp = dispinterface; + _Thread = interface; + _ThreadDisp = dispinterface; + _ThreadAbortException = interface; + _ThreadAbortExceptionDisp = dispinterface; + _STAThreadAttribute = interface; + _STAThreadAttributeDisp = dispinterface; + _MTAThreadAttribute = interface; + _MTAThreadAttributeDisp = dispinterface; + _ThreadInterruptedException = interface; + _ThreadInterruptedExceptionDisp = dispinterface; + _RegisteredWaitHandle = interface; + _RegisteredWaitHandleDisp = dispinterface; + _WaitCallback = interface; + _WaitCallbackDisp = dispinterface; + _WaitOrTimerCallback = interface; + _WaitOrTimerCallbackDisp = dispinterface; + _IOCompletionCallback = interface; + _IOCompletionCallbackDisp = dispinterface; + _ThreadPool = interface; + _ThreadPoolDisp = dispinterface; + _ThreadStart = interface; + _ThreadStartDisp = dispinterface; + _ThreadStateException = interface; + _ThreadStateExceptionDisp = dispinterface; + _ThreadStaticAttribute = interface; + _ThreadStaticAttributeDisp = dispinterface; + _Timeout = interface; + _TimeoutDisp = dispinterface; + _TimerCallback = interface; + _TimerCallbackDisp = dispinterface; + _Timer = interface; + _TimerDisp = dispinterface; + _ArrayList = interface; + _ArrayListDisp = dispinterface; + _BitArray = interface; + _BitArrayDisp = dispinterface; + IComparer = interface; + IComparerDisp = dispinterface; + _CaseInsensitiveComparer = interface; + _CaseInsensitiveComparerDisp = dispinterface; + IHashCodeProvider = interface; + IHashCodeProviderDisp = dispinterface; + _CaseInsensitiveHashCodeProvider = interface; + _CaseInsensitiveHashCodeProviderDisp = dispinterface; + _CollectionBase = interface; + _CollectionBaseDisp = dispinterface; + _Comparer = interface; + _ComparerDisp = dispinterface; + IDictionary = interface; + IDictionaryDisp = dispinterface; + _DictionaryBase = interface; + _DictionaryBaseDisp = dispinterface; + IDeserializationCallback = interface; + IDeserializationCallbackDisp = dispinterface; + _Hashtable = interface; + _HashtableDisp = dispinterface; + IDictionaryEnumerator = interface; + IDictionaryEnumeratorDisp = dispinterface; + _Queue = interface; + _QueueDisp = dispinterface; + _ReadOnlyCollectionBase = interface; + _ReadOnlyCollectionBaseDisp = dispinterface; + _SortedList = interface; + _SortedListDisp = dispinterface; + _Stack = interface; + _StackDisp = dispinterface; + _ConditionalAttribute = interface; + _ConditionalAttributeDisp = dispinterface; + _Debugger = interface; + _DebuggerDisp = dispinterface; + _DebuggerStepThroughAttribute = interface; + _DebuggerStepThroughAttributeDisp = dispinterface; + _DebuggerHiddenAttribute = interface; + _DebuggerHiddenAttributeDisp = dispinterface; + _DebuggableAttribute = interface; + _DebuggableAttributeDisp = dispinterface; + _StackTrace = interface; + _StackTraceDisp = dispinterface; + _StackFrame = interface; + _StackFrameDisp = dispinterface; + ISymbolBinder = interface; + ISymbolBinderDisp = dispinterface; + ISymbolDocument = interface; + ISymbolDocumentDisp = dispinterface; + ISymbolDocumentWriter = interface; + ISymbolDocumentWriterDisp = dispinterface; + ISymbolMethod = interface; + ISymbolMethodDisp = dispinterface; + ISymbolNamespace = interface; + ISymbolNamespaceDisp = dispinterface; + ISymbolReader = interface; + ISymbolReaderDisp = dispinterface; + ISymbolScope = interface; + ISymbolScopeDisp = dispinterface; + ISymbolVariable = interface; + ISymbolVariableDisp = dispinterface; + ISymbolWriter = interface; + ISymbolWriterDisp = dispinterface; + _SymDocumentType = interface; + _SymDocumentTypeDisp = dispinterface; + _SymLanguageType = interface; + _SymLanguageTypeDisp = dispinterface; + _SymLanguageVendor = interface; + _SymLanguageVendorDisp = dispinterface; + _AmbiguousMatchException = interface; + _AmbiguousMatchExceptionDisp = dispinterface; + _ModuleResolveEventHandler = interface; + _ModuleResolveEventHandlerDisp = dispinterface; + _Assembly = interface; + _AssemblyDisp = dispinterface; + _AssemblyCultureAttribute = interface; + _AssemblyCultureAttributeDisp = dispinterface; + _AssemblyVersionAttribute = interface; + _AssemblyVersionAttributeDisp = dispinterface; + _AssemblyKeyFileAttribute = interface; + _AssemblyKeyFileAttributeDisp = dispinterface; + _AssemblyKeyNameAttribute = interface; + _AssemblyKeyNameAttributeDisp = dispinterface; + _AssemblyDelaySignAttribute = interface; + _AssemblyDelaySignAttributeDisp = dispinterface; + _AssemblyAlgorithmIdAttribute = interface; + _AssemblyAlgorithmIdAttributeDisp = dispinterface; + _AssemblyFlagsAttribute = interface; + _AssemblyFlagsAttributeDisp = dispinterface; + _AssemblyFileVersionAttribute = interface; + _AssemblyFileVersionAttributeDisp = dispinterface; + _AssemblyName = interface; + _AssemblyNameDisp = dispinterface; + _AssemblyNameProxy = interface; + _AssemblyNameProxyDisp = dispinterface; + _AssemblyCopyrightAttribute = interface; + _AssemblyCopyrightAttributeDisp = dispinterface; + _AssemblyTrademarkAttribute = interface; + _AssemblyTrademarkAttributeDisp = dispinterface; + _AssemblyProductAttribute = interface; + _AssemblyProductAttributeDisp = dispinterface; + _AssemblyCompanyAttribute = interface; + _AssemblyCompanyAttributeDisp = dispinterface; + _AssemblyDescriptionAttribute = interface; + _AssemblyDescriptionAttributeDisp = dispinterface; + _AssemblyTitleAttribute = interface; + _AssemblyTitleAttributeDisp = dispinterface; + _AssemblyConfigurationAttribute = interface; + _AssemblyConfigurationAttributeDisp = dispinterface; + _AssemblyDefaultAliasAttribute = interface; + _AssemblyDefaultAliasAttributeDisp = dispinterface; + _AssemblyInformationalVersionAttribute = interface; + _AssemblyInformationalVersionAttributeDisp = dispinterface; + _CustomAttributeFormatException = interface; + _CustomAttributeFormatExceptionDisp = dispinterface; + _MethodBase = interface; + _MethodBaseDisp = dispinterface; + _ConstructorInfo = interface; + _ConstructorInfoDisp = dispinterface; + _DefaultMemberAttribute = interface; + _DefaultMemberAttributeDisp = dispinterface; + _EventInfo = interface; + _EventInfoDisp = dispinterface; + _FieldInfo = interface; + _FieldInfoDisp = dispinterface; + _InvalidFilterCriteriaException = interface; + _InvalidFilterCriteriaExceptionDisp = dispinterface; + _ManifestResourceInfo = interface; + _ManifestResourceInfoDisp = dispinterface; + _MemberFilter = interface; + _MemberFilterDisp = dispinterface; + _MethodInfo = interface; + _MethodInfoDisp = dispinterface; + _Missing = interface; + _MissingDisp = dispinterface; + _Module = interface; + _ModuleDisp = dispinterface; + _ParameterInfo = interface; + _ParameterInfoDisp = dispinterface; + _Pointer = interface; + _PointerDisp = dispinterface; + _PropertyInfo = interface; + _PropertyInfoDisp = dispinterface; + _ReflectionTypeLoadException = interface; + _ReflectionTypeLoadExceptionDisp = dispinterface; + _StrongNameKeyPair = interface; + _StrongNameKeyPairDisp = dispinterface; + _TargetException = interface; + _TargetExceptionDisp = dispinterface; + _TargetInvocationException = interface; + _TargetInvocationExceptionDisp = dispinterface; + _TargetParameterCountException = interface; + _TargetParameterCountExceptionDisp = dispinterface; + _TypeDelegator = interface; + _TypeDelegatorDisp = dispinterface; + _TypeFilter = interface; + _TypeFilterDisp = dispinterface; + _UnmanagedMarshal = interface; + _UnmanagedMarshalDisp = dispinterface; + IFormatter = interface; + IFormatterDisp = dispinterface; + _Formatter = interface; + _FormatterDisp = dispinterface; + IFormatterConverter = interface; + IFormatterConverterDisp = dispinterface; + _FormatterConverter = interface; + _FormatterConverterDisp = dispinterface; + _FormatterServices = interface; + _FormatterServicesDisp = dispinterface; + ISerializationSurrogate = interface; + ISerializationSurrogateDisp = dispinterface; + ISurrogateSelector = interface; + ISurrogateSelectorDisp = dispinterface; + _ObjectIDGenerator = interface; + _ObjectIDGeneratorDisp = dispinterface; + _ObjectManager = interface; + _ObjectManagerDisp = dispinterface; + _SerializationBinder = interface; + _SerializationBinderDisp = dispinterface; + _SerializationInfo = interface; + _SerializationInfoDisp = dispinterface; + _SerializationInfoEnumerator = interface; + _SerializationInfoEnumeratorDisp = dispinterface; + _SerializationException = interface; + _SerializationExceptionDisp = dispinterface; + _SurrogateSelector = interface; + _SurrogateSelectorDisp = dispinterface; + _Calendar = interface; + _CalendarDisp = dispinterface; + _CompareInfo = interface; + _CompareInfoDisp = dispinterface; + _CultureInfo = interface; + _CultureInfoDisp = dispinterface; + _DateTimeFormatInfo = interface; + _DateTimeFormatInfoDisp = dispinterface; + _DaylightTime = interface; + _DaylightTimeDisp = dispinterface; + _GregorianCalendar = interface; + _GregorianCalendarDisp = dispinterface; + _HebrewCalendar = interface; + _HebrewCalendarDisp = dispinterface; + _HijriCalendar = interface; + _HijriCalendarDisp = dispinterface; + _JapaneseCalendar = interface; + _JapaneseCalendarDisp = dispinterface; + _JulianCalendar = interface; + _JulianCalendarDisp = dispinterface; + _KoreanCalendar = interface; + _KoreanCalendarDisp = dispinterface; + _RegionInfo = interface; + _RegionInfoDisp = dispinterface; + _SortKey = interface; + _SortKeyDisp = dispinterface; + _StringInfo = interface; + _StringInfoDisp = dispinterface; + _TaiwanCalendar = interface; + _TaiwanCalendarDisp = dispinterface; + _TextElementEnumerator = interface; + _TextElementEnumeratorDisp = dispinterface; + _TextInfo = interface; + _TextInfoDisp = dispinterface; + _ThaiBuddhistCalendar = interface; + _ThaiBuddhistCalendarDisp = dispinterface; + _NumberFormatInfo = interface; + _NumberFormatInfoDisp = dispinterface; + _Encoding = interface; + _EncodingDisp = dispinterface; + _System_Text_Decoder = interface; + _System_Text_DecoderDisp = dispinterface; + _System_Text_Encoder = interface; + _System_Text_EncoderDisp = dispinterface; + _ASCIIEncoding = interface; + _ASCIIEncodingDisp = dispinterface; + _UnicodeEncoding = interface; + _UnicodeEncodingDisp = dispinterface; + _UTF7Encoding = interface; + _UTF7EncodingDisp = dispinterface; + _UTF8Encoding = interface; + _UTF8EncodingDisp = dispinterface; + IResourceReader = interface; + IResourceReaderDisp = dispinterface; + IResourceWriter = interface; + IResourceWriterDisp = dispinterface; + _MissingManifestResourceException = interface; + _MissingManifestResourceExceptionDisp = dispinterface; + _NeutralResourcesLanguageAttribute = interface; + _NeutralResourcesLanguageAttributeDisp = dispinterface; + _ResourceManager = interface; + _ResourceManagerDisp = dispinterface; + _ResourceReader = interface; + _ResourceReaderDisp = dispinterface; + _ResourceSet = interface; + _ResourceSetDisp = dispinterface; + _ResourceWriter = interface; + _ResourceWriterDisp = dispinterface; + _SatelliteContractVersionAttribute = interface; + _SatelliteContractVersionAttributeDisp = dispinterface; + _Registry = interface; + _RegistryDisp = dispinterface; + _RegistryKey = interface; + _RegistryKeyDisp = dispinterface; + _X509Certificate = interface; + _X509CertificateDisp = dispinterface; + _AsymmetricAlgorithm = interface; + _AsymmetricAlgorithmDisp = dispinterface; + _AsymmetricKeyExchangeDeformatter = interface; + _AsymmetricKeyExchangeDeformatterDisp = dispinterface; + _AsymmetricKeyExchangeFormatter = interface; + _AsymmetricKeyExchangeFormatterDisp = dispinterface; + _AsymmetricSignatureDeformatter = interface; + _AsymmetricSignatureDeformatterDisp = dispinterface; + _AsymmetricSignatureFormatter = interface; + _AsymmetricSignatureFormatterDisp = dispinterface; + ICryptoTransform = interface; + ICryptoTransformDisp = dispinterface; + _ToBase64Transform = interface; + _ToBase64TransformDisp = dispinterface; + _FromBase64Transform = interface; + _FromBase64TransformDisp = dispinterface; + _KeySizes = interface; + _KeySizesDisp = dispinterface; + _CryptographicException = interface; + _CryptographicExceptionDisp = dispinterface; + _CryptographicUnexpectedOperationException = interface; + _CryptographicUnexpectedOperationExceptionDisp = dispinterface; + _CryptoAPITransform = interface; + _CryptoAPITransformDisp = dispinterface; + _CspParameters = interface; + _CspParametersDisp = dispinterface; + _CryptoConfig = interface; + _CryptoConfigDisp = dispinterface; + _Stream = interface; + _StreamDisp = dispinterface; + _CryptoStream = interface; + _CryptoStreamDisp = dispinterface; + _SymmetricAlgorithm = interface; + _SymmetricAlgorithmDisp = dispinterface; + _DES = interface; + _DESDisp = dispinterface; + _DESCryptoServiceProvider = interface; + _DESCryptoServiceProviderDisp = dispinterface; + _DeriveBytes = interface; + _DeriveBytesDisp = dispinterface; + _DSA = interface; + _DSADisp = dispinterface; + _DSACryptoServiceProvider = interface; + _DSACryptoServiceProviderDisp = dispinterface; + _DSASignatureDeformatter = interface; + _DSASignatureDeformatterDisp = dispinterface; + _DSASignatureFormatter = interface; + _DSASignatureFormatterDisp = dispinterface; + _HashAlgorithm = interface; + _HashAlgorithmDisp = dispinterface; + _KeyedHashAlgorithm = interface; + _KeyedHashAlgorithmDisp = dispinterface; + _HMACSHA1 = interface; + _HMACSHA1Disp = dispinterface; + _MACTripleDES = interface; + _MACTripleDESDisp = dispinterface; + _MD5 = interface; + _MD5Disp = dispinterface; + _MD5CryptoServiceProvider = interface; + _MD5CryptoServiceProviderDisp = dispinterface; + _MaskGenerationMethod = interface; + _MaskGenerationMethodDisp = dispinterface; + _PasswordDeriveBytes = interface; + _PasswordDeriveBytesDisp = dispinterface; + _PKCS1MaskGenerationMethod = interface; + _PKCS1MaskGenerationMethodDisp = dispinterface; + _RC2 = interface; + _RC2Disp = dispinterface; + _RC2CryptoServiceProvider = interface; + _RC2CryptoServiceProviderDisp = dispinterface; + _RandomNumberGenerator = interface; + _RandomNumberGeneratorDisp = dispinterface; + _RNGCryptoServiceProvider = interface; + _RNGCryptoServiceProviderDisp = dispinterface; + _RSA = interface; + _RSADisp = dispinterface; + _RSACryptoServiceProvider = interface; + _RSACryptoServiceProviderDisp = dispinterface; + _RSAOAEPKeyExchangeDeformatter = interface; + _RSAOAEPKeyExchangeDeformatterDisp = dispinterface; + _RSAOAEPKeyExchangeFormatter = interface; + _RSAOAEPKeyExchangeFormatterDisp = dispinterface; + _RSAPKCS1KeyExchangeDeformatter = interface; + _RSAPKCS1KeyExchangeDeformatterDisp = dispinterface; + _RSAPKCS1KeyExchangeFormatter = interface; + _RSAPKCS1KeyExchangeFormatterDisp = dispinterface; + _RSAPKCS1SignatureDeformatter = interface; + _RSAPKCS1SignatureDeformatterDisp = dispinterface; + _RSAPKCS1SignatureFormatter = interface; + _RSAPKCS1SignatureFormatterDisp = dispinterface; + _Rijndael = interface; + _RijndaelDisp = dispinterface; + _RijndaelManaged = interface; + _RijndaelManagedDisp = dispinterface; + _SHA1 = interface; + _SHA1Disp = dispinterface; + _SHA1CryptoServiceProvider = interface; + _SHA1CryptoServiceProviderDisp = dispinterface; + _SHA1Managed = interface; + _SHA1ManagedDisp = dispinterface; + _SHA256 = interface; + _SHA256Disp = dispinterface; + _SHA256Managed = interface; + _SHA256ManagedDisp = dispinterface; + _SHA384 = interface; + _SHA384Disp = dispinterface; + _SHA384Managed = interface; + _SHA384ManagedDisp = dispinterface; + _SHA512 = interface; + _SHA512Disp = dispinterface; + _SHA512Managed = interface; + _SHA512ManagedDisp = dispinterface; + _SignatureDescription = interface; + _SignatureDescriptionDisp = dispinterface; + _TripleDES = interface; + _TripleDESDisp = dispinterface; + _TripleDESCryptoServiceProvider = interface; + _TripleDESCryptoServiceProviderDisp = dispinterface; + ISecurityEncodable = interface; + ISecurityEncodableDisp = dispinterface; + ISecurityPolicyEncodable = interface; + ISecurityPolicyEncodableDisp = dispinterface; + IMembershipCondition = interface; + IMembershipConditionDisp = dispinterface; + _AllMembershipCondition = interface; + _AllMembershipConditionDisp = dispinterface; + _ApplicationDirectory = interface; + _ApplicationDirectoryDisp = dispinterface; + _ApplicationDirectoryMembershipCondition = interface; + _ApplicationDirectoryMembershipConditionDisp = dispinterface; + _CodeGroup = interface; + _CodeGroupDisp = dispinterface; + _Evidence = interface; + _EvidenceDisp = dispinterface; + _FileCodeGroup = interface; + _FileCodeGroupDisp = dispinterface; + _FirstMatchCodeGroup = interface; + _FirstMatchCodeGroupDisp = dispinterface; + _Hash = interface; + _HashDisp = dispinterface; + _HashMembershipCondition = interface; + _HashMembershipConditionDisp = dispinterface; + IIdentityPermissionFactory = interface; + IIdentityPermissionFactoryDisp = dispinterface; + _NetCodeGroup = interface; + _NetCodeGroupDisp = dispinterface; + _PermissionRequestEvidence = interface; + _PermissionRequestEvidenceDisp = dispinterface; + _PolicyException = interface; + _PolicyExceptionDisp = dispinterface; + _PolicyLevel = interface; + _PolicyLevelDisp = dispinterface; + _PolicyStatement = interface; + _PolicyStatementDisp = dispinterface; + _Publisher = interface; + _PublisherDisp = dispinterface; + _PublisherMembershipCondition = interface; + _PublisherMembershipConditionDisp = dispinterface; + _Site = interface; + _SiteDisp = dispinterface; + _SiteMembershipCondition = interface; + _SiteMembershipConditionDisp = dispinterface; + _StrongName = interface; + _StrongNameDisp = dispinterface; + _StrongNameMembershipCondition = interface; + _StrongNameMembershipConditionDisp = dispinterface; + _UnionCodeGroup = interface; + _UnionCodeGroupDisp = dispinterface; + _Url = interface; + _UrlDisp = dispinterface; + _UrlMembershipCondition = interface; + _UrlMembershipConditionDisp = dispinterface; + _Zone = interface; + _ZoneDisp = dispinterface; + _ZoneMembershipCondition = interface; + _ZoneMembershipConditionDisp = dispinterface; + IIdentity = interface; + IIdentityDisp = dispinterface; + _GenericIdentity = interface; + _GenericIdentityDisp = dispinterface; + IPrincipal = interface; + IPrincipalDisp = dispinterface; + _GenericPrincipal = interface; + _GenericPrincipalDisp = dispinterface; + _WindowsIdentity = interface; + _WindowsIdentityDisp = dispinterface; + _WindowsImpersonationContext = interface; + _WindowsImpersonationContextDisp = dispinterface; + _WindowsPrincipal = interface; + _WindowsPrincipalDisp = dispinterface; + _DispIdAttribute = interface; + _DispIdAttributeDisp = dispinterface; + _InterfaceTypeAttribute = interface; + _InterfaceTypeAttributeDisp = dispinterface; + _ClassInterfaceAttribute = interface; + _ClassInterfaceAttributeDisp = dispinterface; + _ComVisibleAttribute = interface; + _ComVisibleAttributeDisp = dispinterface; + _LCIDConversionAttribute = interface; + _LCIDConversionAttributeDisp = dispinterface; + _ComRegisterFunctionAttribute = interface; + _ComRegisterFunctionAttributeDisp = dispinterface; + _ComUnregisterFunctionAttribute = interface; + _ComUnregisterFunctionAttributeDisp = dispinterface; + _ProgIdAttribute = interface; + _ProgIdAttributeDisp = dispinterface; + _ImportedFromTypeLibAttribute = interface; + _ImportedFromTypeLibAttributeDisp = dispinterface; + _IDispatchImplAttribute = interface; + _IDispatchImplAttributeDisp = dispinterface; + _ComSourceInterfacesAttribute = interface; + _ComSourceInterfacesAttributeDisp = dispinterface; + _ComConversionLossAttribute = interface; + _ComConversionLossAttributeDisp = dispinterface; + _TypeLibTypeAttribute = interface; + _TypeLibTypeAttributeDisp = dispinterface; + _TypeLibFuncAttribute = interface; + _TypeLibFuncAttributeDisp = dispinterface; + _TypeLibVarAttribute = interface; + _TypeLibVarAttributeDisp = dispinterface; + _MarshalAsAttribute = interface; + _MarshalAsAttributeDisp = dispinterface; + _ComImportAttribute = interface; + _ComImportAttributeDisp = dispinterface; + _GuidAttribute = interface; + _GuidAttributeDisp = dispinterface; + _PreserveSigAttribute = interface; + _PreserveSigAttributeDisp = dispinterface; + _InAttribute = interface; + _InAttributeDisp = dispinterface; + _OutAttribute = interface; + _OutAttributeDisp = dispinterface; + _OptionalAttribute = interface; + _OptionalAttributeDisp = dispinterface; + _DllImportAttribute = interface; + _DllImportAttributeDisp = dispinterface; + _StructLayoutAttribute = interface; + _StructLayoutAttributeDisp = dispinterface; + _FieldOffsetAttribute = interface; + _FieldOffsetAttributeDisp = dispinterface; + _ComAliasNameAttribute = interface; + _ComAliasNameAttributeDisp = dispinterface; + _AutomationProxyAttribute = interface; + _AutomationProxyAttributeDisp = dispinterface; + _PrimaryInteropAssemblyAttribute = interface; + _PrimaryInteropAssemblyAttributeDisp = dispinterface; + _CoClassAttribute = interface; + _CoClassAttributeDisp = dispinterface; + _ComEventInterfaceAttribute = interface; + _ComEventInterfaceAttributeDisp = dispinterface; + _TypeLibVersionAttribute = interface; + _TypeLibVersionAttributeDisp = dispinterface; + _ComCompatibleVersionAttribute = interface; + _ComCompatibleVersionAttributeDisp = dispinterface; + _BestFitMappingAttribute = interface; + _BestFitMappingAttributeDisp = dispinterface; + _ExternalException = interface; + _ExternalExceptionDisp = dispinterface; + _COMException = interface; + _COMExceptionDisp = dispinterface; + _CurrencyWrapper = interface; + _CurrencyWrapperDisp = dispinterface; + _DispatchWrapper = interface; + _DispatchWrapperDisp = dispinterface; + _ErrorWrapper = interface; + _ErrorWrapperDisp = dispinterface; + _ExtensibleClassFactory = interface; + _ExtensibleClassFactoryDisp = dispinterface; + ICustomAdapter = interface; + ICustomAdapterDisp = dispinterface; + ICustomMarshaler = interface; + ICustomMarshalerDisp = dispinterface; + ICustomFactory = interface; + ICustomFactoryDisp = dispinterface; + _InvalidComObjectException = interface; + _InvalidComObjectExceptionDisp = dispinterface; + _InvalidOleVariantTypeException = interface; + _InvalidOleVariantTypeExceptionDisp = dispinterface; + IRegistrationServices = interface; + IRegistrationServicesDisp = dispinterface; + ITypeLibImporterNotifySink = interface; + ITypeLibExporterNotifySink = interface; + ITypeLibConverter = interface; + ITypeLibExporterNameProvider = interface; + _Marshal = interface; + _MarshalDisp = dispinterface; + _MarshalDirectiveException = interface; + _MarshalDirectiveExceptionDisp = dispinterface; + _ObjectCreationDelegate = interface; + _ObjectCreationDelegateDisp = dispinterface; + _RuntimeEnvironment = interface; + _RuntimeEnvironmentDisp = dispinterface; + _SafeArrayRankMismatchException = interface; + _SafeArrayRankMismatchExceptionDisp = dispinterface; + _SafeArrayTypeMismatchException = interface; + _SafeArrayTypeMismatchExceptionDisp = dispinterface; + _SEHException = interface; + _SEHExceptionDisp = dispinterface; + _UnknownWrapper = interface; + _UnknownWrapperDisp = dispinterface; + IExpando = interface; + IExpandoDisp = dispinterface; + _BinaryReader = interface; + _BinaryReaderDisp = dispinterface; + _BinaryWriter = interface; + _BinaryWriterDisp = dispinterface; + _BufferedStream = interface; + _BufferedStreamDisp = dispinterface; + _Directory = interface; + _DirectoryDisp = dispinterface; + _FileSystemInfo = interface; + _FileSystemInfoDisp = dispinterface; + _DirectoryInfo = interface; + _DirectoryInfoDisp = dispinterface; + _IOException = interface; + _IOExceptionDisp = dispinterface; + _DirectoryNotFoundException = interface; + _DirectoryNotFoundExceptionDisp = dispinterface; + _EndOfStreamException = interface; + _EndOfStreamExceptionDisp = dispinterface; + _File = interface; + _FileDisp = dispinterface; + _FileInfo = interface; + _FileInfoDisp = dispinterface; + _FileLoadException = interface; + _FileLoadExceptionDisp = dispinterface; + _FileNotFoundException = interface; + _FileNotFoundExceptionDisp = dispinterface; + _FileStream = interface; + _FileStreamDisp = dispinterface; + _MemoryStream = interface; + _MemoryStreamDisp = dispinterface; + _Path = interface; + _PathDisp = dispinterface; + _PathTooLongException = interface; + _PathTooLongExceptionDisp = dispinterface; + _TextReader = interface; + _TextReaderDisp = dispinterface; + _StreamReader = interface; + _StreamReaderDisp = dispinterface; + _TextWriter = interface; + _TextWriterDisp = dispinterface; + _StreamWriter = interface; + _StreamWriterDisp = dispinterface; + _StringReader = interface; + _StringReaderDisp = dispinterface; + _StringWriter = interface; + _StringWriterDisp = dispinterface; + _AccessedThroughPropertyAttribute = interface; + _AccessedThroughPropertyAttributeDisp = dispinterface; + _CallConvCdecl = interface; + _CallConvCdeclDisp = dispinterface; + _CallConvStdcall = interface; + _CallConvStdcallDisp = dispinterface; + _CallConvThiscall = interface; + _CallConvThiscallDisp = dispinterface; + _CallConvFastcall = interface; + _CallConvFastcallDisp = dispinterface; + _RuntimeHelpers = interface; + _RuntimeHelpersDisp = dispinterface; + _CustomConstantAttribute = interface; + _CustomConstantAttributeDisp = dispinterface; + _DateTimeConstantAttribute = interface; + _DateTimeConstantAttributeDisp = dispinterface; + _DiscardableAttribute = interface; + _DiscardableAttributeDisp = dispinterface; + _DecimalConstantAttribute = interface; + _DecimalConstantAttributeDisp = dispinterface; + _CompilationRelaxationsAttribute = interface; + _CompilationRelaxationsAttributeDisp = dispinterface; + _CompilerGlobalScopeAttribute = interface; + _CompilerGlobalScopeAttributeDisp = dispinterface; + _IDispatchConstantAttribute = interface; + _IDispatchConstantAttributeDisp = dispinterface; + _IndexerNameAttribute = interface; + _IndexerNameAttributeDisp = dispinterface; + _IsVolatile = interface; + _IsVolatileDisp = dispinterface; + _IUnknownConstantAttribute = interface; + _IUnknownConstantAttributeDisp = dispinterface; + _MethodImplAttribute = interface; + _MethodImplAttributeDisp = dispinterface; + _RequiredAttributeAttribute = interface; + _RequiredAttributeAttributeDisp = dispinterface; + IStackWalk = interface; + IStackWalkDisp = dispinterface; + _PermissionSet = interface; + _PermissionSetDisp = dispinterface; + _NamedPermissionSet = interface; + _NamedPermissionSetDisp = dispinterface; + _SecurityElement = interface; + _SecurityElementDisp = dispinterface; + _XmlSyntaxException = interface; + _XmlSyntaxExceptionDisp = dispinterface; + IPermission = interface; + IPermissionDisp = dispinterface; + _CodeAccessPermission = interface; + _CodeAccessPermissionDisp = dispinterface; + IUnrestrictedPermission = interface; + IUnrestrictedPermissionDisp = dispinterface; + _EnvironmentPermission = interface; + _EnvironmentPermissionDisp = dispinterface; + _FileDialogPermission = interface; + _FileDialogPermissionDisp = dispinterface; + _FileIOPermission = interface; + _FileIOPermissionDisp = dispinterface; + _IsolatedStoragePermission = interface; + _IsolatedStoragePermissionDisp = dispinterface; + _IsolatedStorageFilePermission = interface; + _IsolatedStorageFilePermissionDisp = dispinterface; + _SecurityAttribute = interface; + _SecurityAttributeDisp = dispinterface; + _CodeAccessSecurityAttribute = interface; + _CodeAccessSecurityAttributeDisp = dispinterface; + _EnvironmentPermissionAttribute = interface; + _EnvironmentPermissionAttributeDisp = dispinterface; + _FileDialogPermissionAttribute = interface; + _FileDialogPermissionAttributeDisp = dispinterface; + _FileIOPermissionAttribute = interface; + _FileIOPermissionAttributeDisp = dispinterface; + _PrincipalPermissionAttribute = interface; + _PrincipalPermissionAttributeDisp = dispinterface; + _ReflectionPermissionAttribute = interface; + _ReflectionPermissionAttributeDisp = dispinterface; + _RegistryPermissionAttribute = interface; + _RegistryPermissionAttributeDisp = dispinterface; + _SecurityPermissionAttribute = interface; + _SecurityPermissionAttributeDisp = dispinterface; + _UIPermissionAttribute = interface; + _UIPermissionAttributeDisp = dispinterface; + _ZoneIdentityPermissionAttribute = interface; + _ZoneIdentityPermissionAttributeDisp = dispinterface; + _StrongNameIdentityPermissionAttribute = interface; + _StrongNameIdentityPermissionAttributeDisp = dispinterface; + _SiteIdentityPermissionAttribute = interface; + _SiteIdentityPermissionAttributeDisp = dispinterface; + _UrlIdentityPermissionAttribute = interface; + _UrlIdentityPermissionAttributeDisp = dispinterface; + _PublisherIdentityPermissionAttribute = interface; + _PublisherIdentityPermissionAttributeDisp = dispinterface; + _IsolatedStoragePermissionAttribute = interface; + _IsolatedStoragePermissionAttributeDisp = dispinterface; + _IsolatedStorageFilePermissionAttribute = interface; + _IsolatedStorageFilePermissionAttributeDisp = dispinterface; + _PermissionSetAttribute = interface; + _PermissionSetAttributeDisp = dispinterface; + _PublisherIdentityPermission = interface; + _PublisherIdentityPermissionDisp = dispinterface; + _ReflectionPermission = interface; + _ReflectionPermissionDisp = dispinterface; + _RegistryPermission = interface; + _RegistryPermissionDisp = dispinterface; + _PrincipalPermission = interface; + _PrincipalPermissionDisp = dispinterface; + _SecurityPermission = interface; + _SecurityPermissionDisp = dispinterface; + _SiteIdentityPermission = interface; + _SiteIdentityPermissionDisp = dispinterface; + _StrongNameIdentityPermission = interface; + _StrongNameIdentityPermissionDisp = dispinterface; + _StrongNamePublicKeyBlob = interface; + _StrongNamePublicKeyBlobDisp = dispinterface; + _UIPermission = interface; + _UIPermissionDisp = dispinterface; + _UrlIdentityPermission = interface; + _UrlIdentityPermissionDisp = dispinterface; + _ZoneIdentityPermission = interface; + _ZoneIdentityPermissionDisp = dispinterface; + _SuppressUnmanagedCodeSecurityAttribute = interface; + _SuppressUnmanagedCodeSecurityAttributeDisp = dispinterface; + _UnverifiableCodeAttribute = interface; + _UnverifiableCodeAttributeDisp = dispinterface; + _AllowPartiallyTrustedCallersAttribute = interface; + _AllowPartiallyTrustedCallersAttributeDisp = dispinterface; + _SecurityException = interface; + _SecurityExceptionDisp = dispinterface; + _SecurityManager = interface; + _SecurityManagerDisp = dispinterface; + _VerificationException = interface; + _VerificationExceptionDisp = dispinterface; + IContextAttribute = interface; + IContextAttributeDisp = dispinterface; + IContextProperty = interface; + IContextPropertyDisp = dispinterface; + _ContextAttribute = interface; + _ContextAttributeDisp = dispinterface; + IActivator = interface; + IActivatorDisp = dispinterface; + IMessageSink = interface; + IMessageSinkDisp = dispinterface; + _AsyncResult = interface; + _AsyncResultDisp = dispinterface; + _CallContext = interface; + _CallContextDisp = dispinterface; + ILogicalThreadAffinative = interface; + ILogicalThreadAffinativeDisp = dispinterface; + _LogicalCallContext = interface; + _LogicalCallContextDisp = dispinterface; + _ChannelServices = interface; + _ChannelServicesDisp = dispinterface; + IClientResponseChannelSinkStack = interface; + IClientResponseChannelSinkStackDisp = dispinterface; + IClientChannelSinkStack = interface; + IClientChannelSinkStackDisp = dispinterface; + _ClientChannelSinkStack = interface; + _ClientChannelSinkStackDisp = dispinterface; + IServerResponseChannelSinkStack = interface; + IServerResponseChannelSinkStackDisp = dispinterface; + IServerChannelSinkStack = interface; + IServerChannelSinkStackDisp = dispinterface; + _ServerChannelSinkStack = interface; + _ServerChannelSinkStackDisp = dispinterface; + _InternalMessageWrapper = interface; + _InternalMessageWrapperDisp = dispinterface; + IMessage = interface; + IMessageDisp = dispinterface; + IMethodMessage = interface; + IMethodMessageDisp = dispinterface; + IMethodCallMessage = interface; + IMethodCallMessageDisp = dispinterface; + _MethodCallMessageWrapper = interface; + _MethodCallMessageWrapperDisp = dispinterface; + ISponsor = interface; + ISponsorDisp = dispinterface; + _ClientSponsor = interface; + _ClientSponsorDisp = dispinterface; + _CrossContextDelegate = interface; + _CrossContextDelegateDisp = dispinterface; + _Context = interface; + _ContextDisp = dispinterface; + _ContextProperty = interface; + _ContextPropertyDisp = dispinterface; + IContextPropertyActivator = interface; + IContextPropertyActivatorDisp = dispinterface; + IChannel = interface; + IChannelDisp = dispinterface; + IChannelSender = interface; + IChannelSenderDisp = dispinterface; + IChannelReceiver = interface; + IChannelReceiverDisp = dispinterface; + IServerChannelSinkProvider = interface; + IServerChannelSinkProviderDisp = dispinterface; + IChannelSinkBase = interface; + IChannelSinkBaseDisp = dispinterface; + IServerChannelSink = interface; + IServerChannelSinkDisp = dispinterface; + _EnterpriseServicesHelper = interface; + _EnterpriseServicesHelperDisp = dispinterface; + _Header = interface; + _HeaderDisp = dispinterface; + _HeaderHandler = interface; + _HeaderHandlerDisp = dispinterface; + IConstructionCallMessage = interface; + IConstructionCallMessageDisp = dispinterface; + IMethodReturnMessage = interface; + IMethodReturnMessageDisp = dispinterface; + IConstructionReturnMessage = interface; + IConstructionReturnMessageDisp = dispinterface; + IChannelReceiverHook = interface; + IChannelReceiverHookDisp = dispinterface; + IClientChannelSinkProvider = interface; + IClientChannelSinkProviderDisp = dispinterface; + IClientFormatterSinkProvider = interface; + IClientFormatterSinkProviderDisp = dispinterface; + IServerFormatterSinkProvider = interface; + IServerFormatterSinkProviderDisp = dispinterface; + IClientChannelSink = interface; + IClientChannelSinkDisp = dispinterface; + IClientFormatterSink = interface; + IClientFormatterSinkDisp = dispinterface; + IChannelDataStore = interface; + IChannelDataStoreDisp = dispinterface; + _ChannelDataStore = interface; + _ChannelDataStoreDisp = dispinterface; + ITransportHeaders = interface; + ITransportHeadersDisp = dispinterface; + _TransportHeaders = interface; + _TransportHeadersDisp = dispinterface; + _SinkProviderData = interface; + _SinkProviderDataDisp = dispinterface; + _BaseChannelObjectWithProperties = interface; + _BaseChannelObjectWithPropertiesDisp = dispinterface; + _BaseChannelSinkWithProperties = interface; + _BaseChannelSinkWithPropertiesDisp = dispinterface; + _BaseChannelWithProperties = interface; + _BaseChannelWithPropertiesDisp = dispinterface; + IContributeClientContextSink = interface; + IContributeClientContextSinkDisp = dispinterface; + IContributeDynamicSink = interface; + IContributeDynamicSinkDisp = dispinterface; + IContributeEnvoySink = interface; + IContributeEnvoySinkDisp = dispinterface; + IContributeObjectSink = interface; + IContributeObjectSinkDisp = dispinterface; + IContributeServerContextSink = interface; + IContributeServerContextSinkDisp = dispinterface; + IDynamicProperty = interface; + IDynamicPropertyDisp = dispinterface; + IDynamicMessageSink = interface; + IDynamicMessageSinkDisp = dispinterface; + ILease = interface; + ILeaseDisp = dispinterface; + IMessageCtrl = interface; + IMessageCtrlDisp = dispinterface; + IRemotingFormatter = interface; + IRemotingFormatterDisp = dispinterface; + _LifetimeServices = interface; + _LifetimeServicesDisp = dispinterface; + _ReturnMessage = interface; + _ReturnMessageDisp = dispinterface; + _MethodCall = interface; + _MethodCallDisp = dispinterface; + _ConstructionCall = interface; + _ConstructionCallDisp = dispinterface; + _MethodResponse = interface; + _MethodResponseDisp = dispinterface; + IFieldInfo = interface; + IFieldInfoDisp = dispinterface; + _ConstructionResponse = interface; + _ConstructionResponseDisp = dispinterface; + _MethodReturnMessageWrapper = interface; + _MethodReturnMessageWrapperDisp = dispinterface; + _ObjectHandle = interface; + _ObjectHandleDisp = dispinterface; + IRemotingTypeInfo = interface; + IRemotingTypeInfoDisp = dispinterface; + IChannelInfo = interface; + IChannelInfoDisp = dispinterface; + IEnvoyInfo = interface; + IEnvoyInfoDisp = dispinterface; + _ObjRef = interface; + _ObjRefDisp = dispinterface; + _OneWayAttribute = interface; + _OneWayAttributeDisp = dispinterface; + _ProxyAttribute = interface; + _ProxyAttributeDisp = dispinterface; + _RealProxy = interface; + _RealProxyDisp = dispinterface; + _SoapAttribute = interface; + _SoapAttributeDisp = dispinterface; + _SoapTypeAttribute = interface; + _SoapTypeAttributeDisp = dispinterface; + _SoapMethodAttribute = interface; + _SoapMethodAttributeDisp = dispinterface; + _SoapFieldAttribute = interface; + _SoapFieldAttributeDisp = dispinterface; + _SoapParameterAttribute = interface; + _SoapParameterAttributeDisp = dispinterface; + _RemotingConfiguration = interface; + _RemotingConfigurationDisp = dispinterface; + _System_Runtime_Remoting_TypeEntry = interface; + _System_Runtime_Remoting_TypeEntryDisp = dispinterface; + _ActivatedClientTypeEntry = interface; + _ActivatedClientTypeEntryDisp = dispinterface; + _ActivatedServiceTypeEntry = interface; + _ActivatedServiceTypeEntryDisp = dispinterface; + _WellKnownClientTypeEntry = interface; + _WellKnownClientTypeEntryDisp = dispinterface; + _WellKnownServiceTypeEntry = interface; + _WellKnownServiceTypeEntryDisp = dispinterface; + _RemotingException = interface; + _RemotingExceptionDisp = dispinterface; + _ServerException = interface; + _ServerExceptionDisp = dispinterface; + _RemotingTimeoutException = interface; + _RemotingTimeoutExceptionDisp = dispinterface; + _RemotingServices = interface; + _RemotingServicesDisp = dispinterface; + _InternalRemotingServices = interface; + _InternalRemotingServicesDisp = dispinterface; + _MessageSurrogateFilter = interface; + _MessageSurrogateFilterDisp = dispinterface; + _RemotingSurrogateSelector = interface; + _RemotingSurrogateSelectorDisp = dispinterface; + _SoapServices = interface; + _SoapServicesDisp = dispinterface; + ISoapXsd = interface; + ISoapXsdDisp = dispinterface; + _SoapDateTime = interface; + _SoapDateTimeDisp = dispinterface; + _SoapDuration = interface; + _SoapDurationDisp = dispinterface; + _SoapTime = interface; + _SoapTimeDisp = dispinterface; + _SoapDate = interface; + _SoapDateDisp = dispinterface; + _SoapYearMonth = interface; + _SoapYearMonthDisp = dispinterface; + _SoapYear = interface; + _SoapYearDisp = dispinterface; + _SoapMonthDay = interface; + _SoapMonthDayDisp = dispinterface; + _SoapDay = interface; + _SoapDayDisp = dispinterface; + _SoapMonth = interface; + _SoapMonthDisp = dispinterface; + _SoapHexBinary = interface; + _SoapHexBinaryDisp = dispinterface; + _SoapBase64Binary = interface; + _SoapBase64BinaryDisp = dispinterface; + _SoapInteger = interface; + _SoapIntegerDisp = dispinterface; + _SoapPositiveInteger = interface; + _SoapPositiveIntegerDisp = dispinterface; + _SoapNonPositiveInteger = interface; + _SoapNonPositiveIntegerDisp = dispinterface; + _SoapNonNegativeInteger = interface; + _SoapNonNegativeIntegerDisp = dispinterface; + _SoapNegativeInteger = interface; + _SoapNegativeIntegerDisp = dispinterface; + _SoapAnyUri = interface; + _SoapAnyUriDisp = dispinterface; + _SoapQName = interface; + _SoapQNameDisp = dispinterface; + _SoapNotation = interface; + _SoapNotationDisp = dispinterface; + _SoapNormalizedString = interface; + _SoapNormalizedStringDisp = dispinterface; + _SoapToken = interface; + _SoapTokenDisp = dispinterface; + _SoapLanguage = interface; + _SoapLanguageDisp = dispinterface; + _SoapName = interface; + _SoapNameDisp = dispinterface; + _SoapIdrefs = interface; + _SoapIdrefsDisp = dispinterface; + _SoapEntities = interface; + _SoapEntitiesDisp = dispinterface; + _SoapNmtoken = interface; + _SoapNmtokenDisp = dispinterface; + _SoapNmtokens = interface; + _SoapNmtokensDisp = dispinterface; + _SoapNcName = interface; + _SoapNcNameDisp = dispinterface; + _SoapId = interface; + _SoapIdDisp = dispinterface; + _SoapIdref = interface; + _SoapIdrefDisp = dispinterface; + _SoapEntity = interface; + _SoapEntityDisp = dispinterface; + _SynchronizationAttribute = interface; + _SynchronizationAttributeDisp = dispinterface; + ITrackingHandler = interface; + ITrackingHandlerDisp = dispinterface; + _TrackingServices = interface; + _TrackingServicesDisp = dispinterface; + _UrlAttribute = interface; + _UrlAttributeDisp = dispinterface; + _IsolatedStorage = interface; + _IsolatedStorageDisp = dispinterface; + _IsolatedStorageFile = interface; + _IsolatedStorageFileDisp = dispinterface; + _IsolatedStorageFileStream = interface; + _IsolatedStorageFileStreamDisp = dispinterface; + _IsolatedStorageException = interface; + _IsolatedStorageExceptionDisp = dispinterface; + INormalizeForIsolatedStorage = interface; + INormalizeForIsolatedStorageDisp = dispinterface; + ISoapMessage = interface; + ISoapMessageDisp = dispinterface; + _InternalRM = interface; + _InternalRMDisp = dispinterface; + _InternalST = interface; + _InternalSTDisp = dispinterface; + _SoapMessage = interface; + _SoapMessageDisp = dispinterface; + _SoapFault = interface; + _SoapFaultDisp = dispinterface; + _ServerFault = interface; + _ServerFaultDisp = dispinterface; + _BinaryFormatter = interface; + _BinaryFormatterDisp = dispinterface; + _AssemblyBuilder = interface; + _AssemblyBuilderDisp = dispinterface; + _ConstructorBuilder = interface; + _ConstructorBuilderDisp = dispinterface; + _EventBuilder = interface; + _EventBuilderDisp = dispinterface; + _FieldBuilder = interface; + _FieldBuilderDisp = dispinterface; + _ILGenerator = interface; + _ILGeneratorDisp = dispinterface; + _LocalBuilder = interface; + _LocalBuilderDisp = dispinterface; + _MethodBuilder = interface; + _MethodBuilderDisp = dispinterface; + _CustomAttributeBuilder = interface; + _CustomAttributeBuilderDisp = dispinterface; + _MethodRental = interface; + _MethodRentalDisp = dispinterface; + _ModuleBuilder = interface; + _ModuleBuilderDisp = dispinterface; + _OpCodes = interface; + _OpCodesDisp = dispinterface; + _ParameterBuilder = interface; + _ParameterBuilderDisp = dispinterface; + _PropertyBuilder = interface; + _PropertyBuilderDisp = dispinterface; + _SignatureHelper = interface; + _SignatureHelperDisp = dispinterface; + _TypeBuilder = interface; + _TypeBuilderDisp = dispinterface; + _EnumBuilder = interface; + _EnumBuilderDisp = dispinterface; + +// *********************************************************************// +// Declaration of CoClasses defined in Type Library +// (NOTE: Here we map each CoClass to its Default Interface) +// *********************************************************************// + AppDomain = _AppDomain; + RegistrationServices = IRegistrationServices; + TypeLibConverter = ITypeLibConverter; + AppDomainSetup = IAppDomainSetup; + Object_ = _Object; + Array_ = _Array; + String_ = _String; + StringBuilder = _StringBuilder; + Exception = _Exception; + ValueType = _ValueType; + SystemException = _SystemException; + OutOfMemoryException = _OutOfMemoryException; + StackOverflowException = _StackOverflowException; + ExecutionEngineException = _ExecutionEngineException; + Delegate = _Delegate; + MulticastDelegate = _MulticastDelegate; + Enum = _Enum; + MemberAccessException = _MemberAccessException; + Activator = _Activator; + ApplicationException = _ApplicationException; + EventArgs = _EventArgs; + ResolveEventArgs = _ResolveEventArgs; + AssemblyLoadEventArgs = _AssemblyLoadEventArgs; + ResolveEventHandler = _ResolveEventHandler; + AssemblyLoadEventHandler = _AssemblyLoadEventHandler; + MarshalByRefObject = _MarshalByRefObject; + CrossAppDomainDelegate = _CrossAppDomainDelegate; + Attribute = _Attribute; + LoaderOptimizationAttribute = _LoaderOptimizationAttribute; + AppDomainUnloadedException = _AppDomainUnloadedException; + ArgumentException = _ArgumentException; + ArgumentNullException = _ArgumentNullException; + ArgumentOutOfRangeException = _ArgumentOutOfRangeException; + ArithmeticException = _ArithmeticException; + ArrayTypeMismatchException = _ArrayTypeMismatchException; + AsyncCallback = _AsyncCallback; + AttributeUsageAttribute = _AttributeUsageAttribute; + BadImageFormatException = _BadImageFormatException; + BitConverter = _BitConverter; + Buffer = _Buffer; + CannotUnloadAppDomainException = _CannotUnloadAppDomainException; + CharEnumerator = _CharEnumerator; + CLSCompliantAttribute = _CLSCompliantAttribute; + TypeUnloadedException = _TypeUnloadedException; + Console = _Console; + ContextMarshalException = _ContextMarshalException; + Convert = _Convert; + ContextBoundObject = _ContextBoundObject; + ContextStaticAttribute = _ContextStaticAttribute; + TimeZone = _TimeZone; + DBNull = _DBNull; + Binder = _Binder; + DivideByZeroException = _DivideByZeroException; + DuplicateWaitObjectException = _DuplicateWaitObjectException; + TypeLoadException = _TypeLoadException; + EntryPointNotFoundException = _EntryPointNotFoundException; + DllNotFoundException = _DllNotFoundException; + Environment = _Environment; + EventHandler = _EventHandler; + FieldAccessException = _FieldAccessException; + FlagsAttribute = _FlagsAttribute; + FormatException = _FormatException; + GC = _GC; + IndexOutOfRangeException = _IndexOutOfRangeException; + InvalidCastException = _InvalidCastException; + InvalidOperationException = _InvalidOperationException; + InvalidProgramException = _InvalidProgramException; + LocalDataStoreSlot = _LocalDataStoreSlot; + Math = _Math; + MethodAccessException = _MethodAccessException; + MissingMemberException = _MissingMemberException; + MissingFieldException = _MissingFieldException; + MissingMethodException = _MissingMethodException; + MulticastNotSupportedException = _MulticastNotSupportedException; + NonSerializedAttribute = _NonSerializedAttribute; + NotFiniteNumberException = _NotFiniteNumberException; + NotImplementedException = _NotImplementedException; + NotSupportedException = _NotSupportedException; + NullReferenceException = _NullReferenceException; + ObjectDisposedException = _ObjectDisposedException; + ObsoleteAttribute = _ObsoleteAttribute; + OperatingSystem = _OperatingSystem; + OverflowException = _OverflowException; + ParamArrayAttribute = _ParamArrayAttribute; + PlatformNotSupportedException = _PlatformNotSupportedException; + Random = _Random; + RankException = _RankException; + MemberInfo = _MemberInfo; + Type_ = _Type; + SerializableAttribute = _SerializableAttribute; + TypeInitializationException = _TypeInitializationException; + UnauthorizedAccessException = _UnauthorizedAccessException; + UnhandledExceptionEventArgs = _UnhandledExceptionEventArgs; + UnhandledExceptionEventHandler = _UnhandledExceptionEventHandler; + Version = _Version; + WeakReference = _WeakReference; + WaitHandle = _WaitHandle; + AutoResetEvent = _AutoResetEvent; + CompressedStack = _CompressedStack; + Interlocked = _Interlocked; + ManualResetEvent = _ManualResetEvent; + Monitor = _Monitor; + Mutex = _Mutex; + Overlapped = _Overlapped; + ReaderWriterLock = _ReaderWriterLock; + SynchronizationLockException = _SynchronizationLockException; + Thread = _Thread; + ThreadAbortException = _ThreadAbortException; + STAThreadAttribute = _STAThreadAttribute; + MTAThreadAttribute = _MTAThreadAttribute; + ThreadInterruptedException = _ThreadInterruptedException; + RegisteredWaitHandle = _RegisteredWaitHandle; + WaitCallback = _WaitCallback; + WaitOrTimerCallback = _WaitOrTimerCallback; + IOCompletionCallback = _IOCompletionCallback; + ThreadPool = _ThreadPool; + ThreadStart = _ThreadStart; + ThreadStateException = _ThreadStateException; + ThreadStaticAttribute = _ThreadStaticAttribute; + Timeout = _Timeout; + TimerCallback = _TimerCallback; + Timer = _Timer; + ArrayList = _ArrayList; + BitArray = _BitArray; + CaseInsensitiveComparer = _CaseInsensitiveComparer; + CaseInsensitiveHashCodeProvider = _CaseInsensitiveHashCodeProvider; + CollectionBase = _CollectionBase; + Comparer = _Comparer; + DictionaryBase = _DictionaryBase; + Hashtable = _Hashtable; + Queue = _Queue; + ReadOnlyCollectionBase = _ReadOnlyCollectionBase; + SortedList = _SortedList; + Stack = _Stack; + ConditionalAttribute = _ConditionalAttribute; + Debugger = _Debugger; + DebuggerStepThroughAttribute = _DebuggerStepThroughAttribute; + DebuggerHiddenAttribute = _DebuggerHiddenAttribute; + DebuggableAttribute = _DebuggableAttribute; + StackTrace = _StackTrace; + StackFrame = _StackFrame; + SymDocumentType = _SymDocumentType; + SymLanguageType = _SymLanguageType; + SymLanguageVendor = _SymLanguageVendor; + AmbiguousMatchException = _AmbiguousMatchException; + ModuleResolveEventHandler = _ModuleResolveEventHandler; + Assembly = _Assembly; + AssemblyCultureAttribute = _AssemblyCultureAttribute; + AssemblyVersionAttribute = _AssemblyVersionAttribute; + AssemblyKeyFileAttribute = _AssemblyKeyFileAttribute; + AssemblyKeyNameAttribute = _AssemblyKeyNameAttribute; + AssemblyDelaySignAttribute = _AssemblyDelaySignAttribute; + AssemblyAlgorithmIdAttribute = _AssemblyAlgorithmIdAttribute; + AssemblyFlagsAttribute = _AssemblyFlagsAttribute; + AssemblyFileVersionAttribute = _AssemblyFileVersionAttribute; + AssemblyName = _AssemblyName; + AssemblyNameProxy = _AssemblyNameProxy; + AssemblyCopyrightAttribute = _AssemblyCopyrightAttribute; + AssemblyTrademarkAttribute = _AssemblyTrademarkAttribute; + AssemblyProductAttribute = _AssemblyProductAttribute; + AssemblyCompanyAttribute = _AssemblyCompanyAttribute; + AssemblyDescriptionAttribute = _AssemblyDescriptionAttribute; + AssemblyTitleAttribute = _AssemblyTitleAttribute; + AssemblyConfigurationAttribute = _AssemblyConfigurationAttribute; + AssemblyDefaultAliasAttribute = _AssemblyDefaultAliasAttribute; + AssemblyInformationalVersionAttribute = _AssemblyInformationalVersionAttribute; + CustomAttributeFormatException = _CustomAttributeFormatException; + MethodBase = _MethodBase; + ConstructorInfo = _ConstructorInfo; + DefaultMemberAttribute = _DefaultMemberAttribute; + EventInfo = _EventInfo; + FieldInfo = _FieldInfo; + InvalidFilterCriteriaException = _InvalidFilterCriteriaException; + ManifestResourceInfo = _ManifestResourceInfo; + MemberFilter = _MemberFilter; + MethodInfo = _MethodInfo; + Missing = _Missing; + Module = _Module; + ParameterInfo = _ParameterInfo; + __Pointer = _Pointer; + PropertyInfo = _PropertyInfo; + ReflectionTypeLoadException = _ReflectionTypeLoadException; + StrongNameKeyPair = _StrongNameKeyPair; + TargetException = _TargetException; + TargetInvocationException = _TargetInvocationException; + TargetParameterCountException = _TargetParameterCountException; + TypeDelegator = _TypeDelegator; + TypeFilter = _TypeFilter; + UnmanagedMarshal = _UnmanagedMarshal; + Formatter = _Formatter; + FormatterConverter = _FormatterConverter; + FormatterServices = _FormatterServices; + ObjectIDGenerator = _ObjectIDGenerator; + ObjectManager = _ObjectManager; + SerializationBinder = _SerializationBinder; + SerializationInfo = _SerializationInfo; + SerializationInfoEnumerator = _SerializationInfoEnumerator; + SerializationException = _SerializationException; + SurrogateSelector = _SurrogateSelector; + Calendar = _Calendar; + CompareInfo = _CompareInfo; + CultureInfo = _CultureInfo; + DateTimeFormatInfo = _DateTimeFormatInfo; + DaylightTime = _DaylightTime; + GregorianCalendar = _GregorianCalendar; + HebrewCalendar = _HebrewCalendar; + HijriCalendar = _HijriCalendar; + JapaneseCalendar = _JapaneseCalendar; + JulianCalendar = _JulianCalendar; + KoreanCalendar = _KoreanCalendar; + RegionInfo = _RegionInfo; + SortKey = _SortKey; + StringInfo = _StringInfo; + TaiwanCalendar = _TaiwanCalendar; + TextElementEnumerator = _TextElementEnumerator; + TextInfo = _TextInfo; + ThaiBuddhistCalendar = _ThaiBuddhistCalendar; + NumberFormatInfo = _NumberFormatInfo; + Encoding = _Encoding; + System_Text_Decoder = _System_Text_Decoder; + System_Text_Encoder = _System_Text_Encoder; + ASCIIEncoding = _ASCIIEncoding; + UnicodeEncoding = _UnicodeEncoding; + UTF7Encoding = _UTF7Encoding; + UTF8Encoding = _UTF8Encoding; + MissingManifestResourceException = _MissingManifestResourceException; + NeutralResourcesLanguageAttribute = _NeutralResourcesLanguageAttribute; + ResourceManager = _ResourceManager; + ResourceReader = _ResourceReader; + ResourceSet = _ResourceSet; + ResourceWriter = _ResourceWriter; + SatelliteContractVersionAttribute = _SatelliteContractVersionAttribute; + Registry = _Registry; + RegistryKey = _RegistryKey; + X509Certificate = _X509Certificate; + AsymmetricAlgorithm = _AsymmetricAlgorithm; + AsymmetricKeyExchangeDeformatter = _AsymmetricKeyExchangeDeformatter; + AsymmetricKeyExchangeFormatter = _AsymmetricKeyExchangeFormatter; + AsymmetricSignatureDeformatter = _AsymmetricSignatureDeformatter; + AsymmetricSignatureFormatter = _AsymmetricSignatureFormatter; + ToBase64Transform = _ToBase64Transform; + FromBase64Transform = _FromBase64Transform; + KeySizes = _KeySizes; + CryptographicException = _CryptographicException; + CryptographicUnexpectedOperationException = _CryptographicUnexpectedOperationException; + CryptoAPITransform = _CryptoAPITransform; + CspParameters = _CspParameters; + CryptoConfig = _CryptoConfig; + Stream = _Stream; + CryptoStream = _CryptoStream; + SymmetricAlgorithm = _SymmetricAlgorithm; + DES = _DES; + DESCryptoServiceProvider = _DESCryptoServiceProvider; + DeriveBytes = _DeriveBytes; + DSA = _DSA; + DSACryptoServiceProvider = _DSACryptoServiceProvider; + DSASignatureDeformatter = _DSASignatureDeformatter; + DSASignatureFormatter = _DSASignatureFormatter; + HashAlgorithm = _HashAlgorithm; + KeyedHashAlgorithm = _KeyedHashAlgorithm; + HMACSHA1 = _HMACSHA1; + MACTripleDES = _MACTripleDES; + MD5 = _MD5; + MD5CryptoServiceProvider = _MD5CryptoServiceProvider; + MaskGenerationMethod = _MaskGenerationMethod; + PasswordDeriveBytes = _PasswordDeriveBytes; + PKCS1MaskGenerationMethod = _PKCS1MaskGenerationMethod; + RC2 = _RC2; + RC2CryptoServiceProvider = _RC2CryptoServiceProvider; + RandomNumberGenerator = _RandomNumberGenerator; + RNGCryptoServiceProvider = _RNGCryptoServiceProvider; + RSA = _RSA; + RSACryptoServiceProvider = _RSACryptoServiceProvider; + RSAOAEPKeyExchangeDeformatter = _RSAOAEPKeyExchangeDeformatter; + RSAOAEPKeyExchangeFormatter = _RSAOAEPKeyExchangeFormatter; + RSAPKCS1KeyExchangeDeformatter = _RSAPKCS1KeyExchangeDeformatter; + RSAPKCS1KeyExchangeFormatter = _RSAPKCS1KeyExchangeFormatter; + RSAPKCS1SignatureDeformatter = _RSAPKCS1SignatureDeformatter; + RSAPKCS1SignatureFormatter = _RSAPKCS1SignatureFormatter; + Rijndael = _Rijndael; + RijndaelManaged = _RijndaelManaged; + SHA1 = _SHA1; + SHA1CryptoServiceProvider = _SHA1CryptoServiceProvider; + SHA1Managed = _SHA1Managed; + SHA256 = _SHA256; + SHA256Managed = _SHA256Managed; + SHA384 = _SHA384; + SHA384Managed = _SHA384Managed; + SHA512 = _SHA512; + SHA512Managed = _SHA512Managed; + SignatureDescription = _SignatureDescription; + TripleDES = _TripleDES; + TripleDESCryptoServiceProvider = _TripleDESCryptoServiceProvider; + AllMembershipCondition = _AllMembershipCondition; + ApplicationDirectory = _ApplicationDirectory; + ApplicationDirectoryMembershipCondition = _ApplicationDirectoryMembershipCondition; + CodeGroup = _CodeGroup; + Evidence = _Evidence; + FileCodeGroup = _FileCodeGroup; + FirstMatchCodeGroup = _FirstMatchCodeGroup; + Hash = _Hash; + HashMembershipCondition = _HashMembershipCondition; + NetCodeGroup = _NetCodeGroup; + PermissionRequestEvidence = _PermissionRequestEvidence; + PolicyException = _PolicyException; + PolicyLevel = _PolicyLevel; + PolicyStatement = _PolicyStatement; + Publisher = _Publisher; + PublisherMembershipCondition = _PublisherMembershipCondition; + Site = _Site; + SiteMembershipCondition = _SiteMembershipCondition; + StrongName = _StrongName; + StrongNameMembershipCondition = _StrongNameMembershipCondition; + UnionCodeGroup = _UnionCodeGroup; + Url = _Url; + UrlMembershipCondition = _UrlMembershipCondition; + Zone = _Zone; + ZoneMembershipCondition = _ZoneMembershipCondition; + GenericIdentity = _GenericIdentity; + GenericPrincipal = _GenericPrincipal; + WindowsIdentity = _WindowsIdentity; + WindowsImpersonationContext = _WindowsImpersonationContext; + WindowsPrincipal = _WindowsPrincipal; + DispIdAttribute = _DispIdAttribute; + InterfaceTypeAttribute = _InterfaceTypeAttribute; + ClassInterfaceAttribute = _ClassInterfaceAttribute; + ComVisibleAttribute = _ComVisibleAttribute; + LCIDConversionAttribute = _LCIDConversionAttribute; + ComRegisterFunctionAttribute = _ComRegisterFunctionAttribute; + ComUnregisterFunctionAttribute = _ComUnregisterFunctionAttribute; + ProgIdAttribute = _ProgIdAttribute; + ImportedFromTypeLibAttribute = _ImportedFromTypeLibAttribute; + IDispatchImplAttribute = _IDispatchImplAttribute; + ComSourceInterfacesAttribute = _ComSourceInterfacesAttribute; + ComConversionLossAttribute = _ComConversionLossAttribute; + TypeLibTypeAttribute = _TypeLibTypeAttribute; + TypeLibFuncAttribute = _TypeLibFuncAttribute; + TypeLibVarAttribute = _TypeLibVarAttribute; + MarshalAsAttribute = _MarshalAsAttribute; + ComImportAttribute = _ComImportAttribute; + GuidAttribute = _GuidAttribute; + PreserveSigAttribute = _PreserveSigAttribute; + InAttribute = _InAttribute; + OutAttribute = _OutAttribute; + OptionalAttribute = _OptionalAttribute; + DllImportAttribute = _DllImportAttribute; + StructLayoutAttribute = _StructLayoutAttribute; + FieldOffsetAttribute = _FieldOffsetAttribute; + ComAliasNameAttribute = _ComAliasNameAttribute; + AutomationProxyAttribute = _AutomationProxyAttribute; + PrimaryInteropAssemblyAttribute = _PrimaryInteropAssemblyAttribute; + CoClassAttribute = _CoClassAttribute; + ComEventInterfaceAttribute = _ComEventInterfaceAttribute; + TypeLibVersionAttribute = _TypeLibVersionAttribute; + ComCompatibleVersionAttribute = _ComCompatibleVersionAttribute; + BestFitMappingAttribute = _BestFitMappingAttribute; + ExternalException = _ExternalException; + COMException = _COMException; + CurrencyWrapper = _CurrencyWrapper; + DispatchWrapper = _DispatchWrapper; + ErrorWrapper = _ErrorWrapper; + ExtensibleClassFactory = _ExtensibleClassFactory; + InvalidComObjectException = _InvalidComObjectException; + InvalidOleVariantTypeException = _InvalidOleVariantTypeException; + Marshal = _Marshal; + MarshalDirectiveException = _MarshalDirectiveException; + ObjectCreationDelegate = _ObjectCreationDelegate; + RuntimeEnvironment = _RuntimeEnvironment; + SafeArrayRankMismatchException = _SafeArrayRankMismatchException; + SafeArrayTypeMismatchException = _SafeArrayTypeMismatchException; + SEHException = _SEHException; + UnknownWrapper = _UnknownWrapper; + BinaryReader = _BinaryReader; + BinaryWriter = _BinaryWriter; + BufferedStream = _BufferedStream; + Directory = _Directory; + FileSystemInfo = _FileSystemInfo; + DirectoryInfo = _DirectoryInfo; + IOException = _IOException; + DirectoryNotFoundException = _DirectoryNotFoundException; + EndOfStreamException = _EndOfStreamException; + File_ = _File; + FileInfo = _FileInfo; + FileLoadException = _FileLoadException; + FileNotFoundException = _FileNotFoundException; + FileStream = _FileStream; + MemoryStream = _MemoryStream; + Path = _Path; + PathTooLongException = _PathTooLongException; + TextReader = _TextReader; + StreamReader = _StreamReader; + TextWriter = _TextWriter; + StreamWriter = _StreamWriter; + StringReader = _StringReader; + StringWriter = _StringWriter; + AccessedThroughPropertyAttribute = _AccessedThroughPropertyAttribute; + CallConvCdecl = _CallConvCdecl; + CallConvStdcall = _CallConvStdcall; + CallConvThiscall = _CallConvThiscall; + CallConvFastcall = _CallConvFastcall; + RuntimeHelpers = _RuntimeHelpers; + CustomConstantAttribute = _CustomConstantAttribute; + DateTimeConstantAttribute = _DateTimeConstantAttribute; + DiscardableAttribute = _DiscardableAttribute; + DecimalConstantAttribute = _DecimalConstantAttribute; + CompilationRelaxationsAttribute = _CompilationRelaxationsAttribute; + CompilerGlobalScopeAttribute = _CompilerGlobalScopeAttribute; + IDispatchConstantAttribute = _IDispatchConstantAttribute; + IndexerNameAttribute = _IndexerNameAttribute; + IsVolatile = _IsVolatile; + IUnknownConstantAttribute = _IUnknownConstantAttribute; + MethodImplAttribute = _MethodImplAttribute; + RequiredAttributeAttribute = _RequiredAttributeAttribute; + PermissionSet = _PermissionSet; + NamedPermissionSet = _NamedPermissionSet; + SecurityElement = _SecurityElement; + XmlSyntaxException = _XmlSyntaxException; + CodeAccessPermission = _CodeAccessPermission; + EnvironmentPermission = _EnvironmentPermission; + FileDialogPermission = _FileDialogPermission; + FileIOPermission = _FileIOPermission; + IsolatedStoragePermission = _IsolatedStoragePermission; + IsolatedStorageFilePermission = _IsolatedStorageFilePermission; + SecurityAttribute = _SecurityAttribute; + CodeAccessSecurityAttribute = _CodeAccessSecurityAttribute; + EnvironmentPermissionAttribute = _EnvironmentPermissionAttribute; + FileDialogPermissionAttribute = _FileDialogPermissionAttribute; + FileIOPermissionAttribute = _FileIOPermissionAttribute; + PrincipalPermissionAttribute = _PrincipalPermissionAttribute; + ReflectionPermissionAttribute = _ReflectionPermissionAttribute; + RegistryPermissionAttribute = _RegistryPermissionAttribute; + SecurityPermissionAttribute = _SecurityPermissionAttribute; + UIPermissionAttribute = _UIPermissionAttribute; + ZoneIdentityPermissionAttribute = _ZoneIdentityPermissionAttribute; + StrongNameIdentityPermissionAttribute = _StrongNameIdentityPermissionAttribute; + SiteIdentityPermissionAttribute = _SiteIdentityPermissionAttribute; + UrlIdentityPermissionAttribute = _UrlIdentityPermissionAttribute; + PublisherIdentityPermissionAttribute = _PublisherIdentityPermissionAttribute; + IsolatedStoragePermissionAttribute = _IsolatedStoragePermissionAttribute; + IsolatedStorageFilePermissionAttribute = _IsolatedStorageFilePermissionAttribute; + PermissionSetAttribute = _PermissionSetAttribute; + PublisherIdentityPermission = _PublisherIdentityPermission; + ReflectionPermission = _ReflectionPermission; + RegistryPermission = _RegistryPermission; + PrincipalPermission = _PrincipalPermission; + SecurityPermission = _SecurityPermission; + SiteIdentityPermission = _SiteIdentityPermission; + StrongNameIdentityPermission = _StrongNameIdentityPermission; + StrongNamePublicKeyBlob = _StrongNamePublicKeyBlob; + UIPermission = _UIPermission; + UrlIdentityPermission = _UrlIdentityPermission; + ZoneIdentityPermission = _ZoneIdentityPermission; + SuppressUnmanagedCodeSecurityAttribute = _SuppressUnmanagedCodeSecurityAttribute; + UnverifiableCodeAttribute = _UnverifiableCodeAttribute; + AllowPartiallyTrustedCallersAttribute = _AllowPartiallyTrustedCallersAttribute; + SecurityException = _SecurityException; + SecurityManager = _SecurityManager; + VerificationException = _VerificationException; + ContextAttribute = _ContextAttribute; + AsyncResult = _AsyncResult; + CallContext = _CallContext; + LogicalCallContext = _LogicalCallContext; + ChannelServices = _ChannelServices; + ClientChannelSinkStack = _ClientChannelSinkStack; + ServerChannelSinkStack = _ServerChannelSinkStack; + InternalMessageWrapper = _InternalMessageWrapper; + MethodCallMessageWrapper = _MethodCallMessageWrapper; + ClientSponsor = _ClientSponsor; + CrossContextDelegate = _CrossContextDelegate; + Context = _Context; + ContextProperty = _ContextProperty; + EnterpriseServicesHelper = _EnterpriseServicesHelper; + Header = _Header; + HeaderHandler = _HeaderHandler; + ChannelDataStore = _ChannelDataStore; + TransportHeaders = _TransportHeaders; + SinkProviderData = _SinkProviderData; + BaseChannelObjectWithProperties = _BaseChannelObjectWithProperties; + BaseChannelSinkWithProperties = _BaseChannelSinkWithProperties; + BaseChannelWithProperties = _BaseChannelWithProperties; + LifetimeServices = _LifetimeServices; + ReturnMessage = _ReturnMessage; + MethodCall = _MethodCall; + ConstructionCall = _ConstructionCall; + MethodResponse = _MethodResponse; + ConstructionResponse = _ConstructionResponse; + MethodReturnMessageWrapper = _MethodReturnMessageWrapper; + ObjectHandle = _ObjectHandle; + ObjRef = _ObjRef; + OneWayAttribute = _OneWayAttribute; + ProxyAttribute = _ProxyAttribute; + RealProxy = _RealProxy; + SoapAttribute = _SoapAttribute; + SoapTypeAttribute = _SoapTypeAttribute; + SoapMethodAttribute = _SoapMethodAttribute; + SoapFieldAttribute = _SoapFieldAttribute; + SoapParameterAttribute = _SoapParameterAttribute; + RemotingConfiguration = _RemotingConfiguration; + System_Runtime_Remoting_TypeEntry = _System_Runtime_Remoting_TypeEntry; + ActivatedClientTypeEntry = _ActivatedClientTypeEntry; + ActivatedServiceTypeEntry = _ActivatedServiceTypeEntry; + WellKnownClientTypeEntry = _WellKnownClientTypeEntry; + WellKnownServiceTypeEntry = _WellKnownServiceTypeEntry; + RemotingException = _RemotingException; + ServerException = _ServerException; + RemotingTimeoutException = _RemotingTimeoutException; + RemotingServices = _RemotingServices; + InternalRemotingServices = _InternalRemotingServices; + MessageSurrogateFilter = _MessageSurrogateFilter; + RemotingSurrogateSelector = _RemotingSurrogateSelector; + SoapServices = _SoapServices; + SoapDateTime = _SoapDateTime; + SoapDuration = _SoapDuration; + SoapTime = _SoapTime; + SoapDate = _SoapDate; + SoapYearMonth = _SoapYearMonth; + SoapYear = _SoapYear; + SoapMonthDay = _SoapMonthDay; + SoapDay = _SoapDay; + SoapMonth = _SoapMonth; + SoapHexBinary = _SoapHexBinary; + SoapBase64Binary = _SoapBase64Binary; + SoapInteger = _SoapInteger; + SoapPositiveInteger = _SoapPositiveInteger; + SoapNonPositiveInteger = _SoapNonPositiveInteger; + SoapNonNegativeInteger = _SoapNonNegativeInteger; + SoapNegativeInteger = _SoapNegativeInteger; + SoapAnyUri = _SoapAnyUri; + SoapQName = _SoapQName; + SoapNotation = _SoapNotation; + SoapNormalizedString = _SoapNormalizedString; + SoapToken = _SoapToken; + SoapLanguage = _SoapLanguage; + SoapName = _SoapName; + SoapIdrefs = _SoapIdrefs; + SoapEntities = _SoapEntities; + SoapNmtoken = _SoapNmtoken; + SoapNmtokens = _SoapNmtokens; + SoapNcName = _SoapNcName; + SoapId = _SoapId; + SoapIdref = _SoapIdref; + SoapEntity = _SoapEntity; + SynchronizationAttribute = _SynchronizationAttribute; + TrackingServices = _TrackingServices; + UrlAttribute = _UrlAttribute; + IsolatedStorage = _IsolatedStorage; + IsolatedStorageFile = _IsolatedStorageFile; + IsolatedStorageFileStream = _IsolatedStorageFileStream; + IsolatedStorageException = _IsolatedStorageException; + InternalRM = _InternalRM; + InternalST = _InternalST; + SoapMessage = _SoapMessage; + SoapFault = _SoapFault; + ServerFault = _ServerFault; + BinaryFormatter = _BinaryFormatter; + AssemblyBuilder = _AssemblyBuilder; + ConstructorBuilder = _ConstructorBuilder; + EventBuilder = _EventBuilder; + FieldBuilder = _FieldBuilder; + ILGenerator = _ILGenerator; + LocalBuilder = _LocalBuilder; + MethodBuilder = _MethodBuilder; + CustomAttributeBuilder = _CustomAttributeBuilder; + MethodRental = _MethodRental; + ModuleBuilder = _ModuleBuilder; + OpCodes = _OpCodes; + ParameterBuilder = _ParameterBuilder; + PropertyBuilder = _PropertyBuilder; + SignatureHelper = _SignatureHelper; + TypeBuilder = _TypeBuilder; + EnumBuilder = _EnumBuilder; + + +// *********************************************************************// +// Declaration of structures, unions and aliases. +// *********************************************************************// + DateTime = packed record + ticks: Int64; + end; + + ArgIterator = packed record + ArgCookie: Integer; + SigPtr: Integer; + ArgPtr: Integer; + RemainingArgs: Integer; + end; + + _Boolean = packed record + m_value: Integer; + end; + + _Byte = packed record + m_value: Byte; + end; + + _Char = packed record + m_value: Byte; + end; + + Decimal = packed record + flags: Integer; + hi: Integer; + lo: Integer; + mid: Integer; + end; + + _Double = packed record + m_value: Double; + end; + + Guid = packed record + _a: Integer; + _b: Smallint; + _c: Smallint; + _d: Byte; + _e: Byte; + _f: Byte; + _g: Byte; + _h: Byte; + _i: Byte; + _j: Byte; + _k: Byte; + end; + + Int16 = packed record + m_value: Smallint; + end; + + Int32 = packed record + m_value: Integer; + end; + + _Int64 = packed record + m_value: Int64; + end; + + IntPtr = packed record + m_value: Pointer; + end; + + RuntimeArgumentHandle = packed record + m_ptr: Integer; + end; + + RuntimeFieldHandle = packed record + m_ptr: Integer; + end; + + RuntimeMethodHandle = packed record + m_ptr: Integer; + end; + + RuntimeTypeHandle = packed record + m_ptr: Integer; + end; + + SByte = packed record + m_value: Shortint; + end; + + _Single = packed record + m_value: Single; + end; + + TimeSpan = packed record + _ticks: Int64; + end; + + TypedReference = packed record + value: Integer; + Type_: Integer; + end; + + UInt16 = packed record + m_value: Word; + end; + + UInt32 = packed record + m_value: LongWord; + end; + + {$IFNDEF FPC} + UInt64 = packed record + m_value: Largeuint; + end; + {$ENDIF ~FPC} + + UIntPtr = packed record + m_value: Pointer; + end; + + Void = packed record + end; + + LockCookie = packed record + _dwFlags: Integer; + _dwWriterSeqNum: Integer; + _wReaderAndWriterLevel: Integer; + _dwThreadID: Integer; + end; + + GCHandle = packed record + m_handle: Integer; + end; + + DictionaryEntry = packed record + _key: IUnknown; + _value: IUnknown; + end; + + SymbolToken = packed record + m_token: Integer; + end; + + InterfaceMapping = packed record + TargetType: _Type; + interfaceType: _Type; + TargetMethods: PSafeArray; + InterfaceMethods: PSafeArray; + end; + + ParameterModifier = packed record + _byRef: PSafeArray; + end; + + SerializationEntry = packed record + m_type: _Type; + m_value: IUnknown; + m_name: PChar; + end; + + StreamingContext = packed record + m_additionalContext: IUnknown; + m_state: StreamingContextStates; + end; + + DSAParameters = packed record + P: PSafeArray; + Q: PSafeArray; + G: PSafeArray; + y: PSafeArray; + J: PSafeArray; + x: PSafeArray; + Seed: PSafeArray; + Counter: Integer; + end; + + RSAParameters = packed record + Exponent: PSafeArray; + Modulus: PSafeArray; + P: PSafeArray; + Q: PSafeArray; + DP: PSafeArray; + DQ: PSafeArray; + InverseQ: PSafeArray; + D: PSafeArray; + end; + + ArrayWithOffset = packed record + m_array: IUnknown; + m_offset: Integer; + m_count: Integer; + end; + + NativeOverlapped = packed record + InternalLow: Integer; + InternalHigh: Integer; + OffsetLow: Integer; + OffsetHigh: Integer; + EventHandle: Integer; + ReservedCOR1: Integer; + ReservedCOR2: GCHandle; + ReservedCOR3: Integer; + ReservedClasslib: GCHandle; + end; + + HandleRef = packed record + m_wrapper: IUnknown; + m_handle: Integer; + end; + + EventToken = packed record + m_event: Integer; + end; + + FieldToken = packed record + m_fieldTok: Integer; + m_class: IUnknown; + end; + + Label_ = packed record + m_label: Integer; + end; + + MethodToken = packed record + m_method: Integer; + end; + + OpCode = packed record + m_stringname: PChar; + m_pop: StackBehaviour; + m_push: StackBehaviour; + m_operand: OperandType; + m_type: OpCodeType; + m_size: Integer; + m_s1: Byte; + m_s2: Byte; + m_ctrl: FlowControl; + m_endsUncondJmpBlk: Integer; + m_stackChange: Integer; + end; + + ParameterToken = packed record + m_tkParameter: Integer; + end; + + PropertyToken = packed record + m_property: Integer; + end; + + SignatureToken = packed record + m_signature: Integer; + m_moduleBuilder: _ModuleBuilder; + end; + + StringToken = packed record + m_string: Integer; + end; + + TypeToken = packed record + m_class: Integer; + end; + + AssemblyHash = packed record + _Algorithm: AssemblyHashAlgorithm; + _value: PSafeArray; + end; + + +// *********************************************************************// +// Interface: _Object +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {65074F7F-63C0-304E-AF0A-D51741CB4A8D} +// *********************************************************************// + _Object = interface(IDispatch) + ['{65074F7F-63C0-304E-AF0A-D51741CB4A8D}'] + function Get_ToString: WideString; safecall; + function Equals(obj: OleVariant): WordBool; safecall; + function GetHashCode: Integer; safecall; + function GetType: _Type; safecall; + property ToString: WideString read Get_ToString; + end; + +// *********************************************************************// +// DispIntf: _ObjectDisp +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {65074F7F-63C0-304E-AF0A-D51741CB4A8D} +// *********************************************************************// + _ObjectDisp = dispinterface + ['{65074F7F-63C0-304E-AF0A-D51741CB4A8D}'] + property ToString: WideString readonly dispid 0; + function Equals(obj: OleVariant): WordBool; dispid 1610743809; + function GetHashCode: Integer; dispid 1610743810; + function GetType: _Type; dispid 1610743811; + end; + {$EXTERNALSYM _ObjectDisp} + +// *********************************************************************// +// Interface: ICloneable +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {0CB251A7-3AB3-3B5C-A0B8-9DDF88824B85} +// *********************************************************************// + ICloneable = interface(IDispatch) + ['{0CB251A7-3AB3-3B5C-A0B8-9DDF88824B85}'] + function Clone: OleVariant; safecall; + end; + +// *********************************************************************// +// DispIntf: ICloneableDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {0CB251A7-3AB3-3B5C-A0B8-9DDF88824B85} +// *********************************************************************// + ICloneableDisp = dispinterface + ['{0CB251A7-3AB3-3B5C-A0B8-9DDF88824B85}'] + function Clone: OleVariant; dispid 1610743808; + end; + {$EXTERNALSYM ICloneableDisp} + +// *********************************************************************// +// Interface: IEnumerable +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {496B0ABE-CDEE-11D3-88E8-00902754C43A} +// *********************************************************************// + IEnumerable = interface(IDispatch) + ['{496B0ABE-CDEE-11D3-88E8-00902754C43A}'] + function GetEnumerator: IEnumVARIANT; safecall; + end; + +// *********************************************************************// +// DispIntf: IEnumerableDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {496B0ABE-CDEE-11D3-88E8-00902754C43A} +// *********************************************************************// + IEnumerableDisp = dispinterface + ['{496B0ABE-CDEE-11D3-88E8-00902754C43A}'] + function GetEnumerator: IEnumVARIANT; dispid -4; + end; + {$EXTERNALSYM IEnumerableDisp} + +// *********************************************************************// +// Interface: ICollection +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {DE8DB6F8-D101-3A92-8D1C-E72E5F10E992} +// *********************************************************************// + ICollection = interface(IDispatch) + ['{DE8DB6F8-D101-3A92-8D1C-E72E5F10E992}'] + procedure CopyTo(const Array_: _Array; index: Integer); safecall; + function Get_Count: Integer; safecall; + function Get_SyncRoot: OleVariant; safecall; + function Get_IsSynchronized: WordBool; safecall; + property Count: Integer read Get_Count; + property SyncRoot: OleVariant read Get_SyncRoot; + property IsSynchronized: WordBool read Get_IsSynchronized; + end; + +// *********************************************************************// +// DispIntf: ICollectionDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {DE8DB6F8-D101-3A92-8D1C-E72E5F10E992} +// *********************************************************************// + ICollectionDisp = dispinterface + ['{DE8DB6F8-D101-3A92-8D1C-E72E5F10E992}'] + procedure CopyTo(const Array_: _Array; index: Integer); dispid 1610743808; + property Count: Integer readonly dispid 1610743809; + property SyncRoot: OleVariant readonly dispid 1610743810; + property IsSynchronized: WordBool readonly dispid 1610743811; + end; + {$EXTERNALSYM ICollectionDisp} + +// *********************************************************************// +// Interface: IList +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {7BCFA00F-F764-3113-9140-3BBD127A96BB} +// *********************************************************************// + IList = interface(IDispatch) + ['{7BCFA00F-F764-3113-9140-3BBD127A96BB}'] + function Get_Item(index: Integer): OleVariant; safecall; + procedure _Set_Item(index: Integer; pRetVal: OleVariant); safecall; + function Add(value: OleVariant): Integer; safecall; + function Contains(value: OleVariant): WordBool; safecall; + procedure Clear; safecall; + function Get_IsReadOnly: WordBool; safecall; + function Get_IsFixedSize: WordBool; safecall; + function IndexOf(value: OleVariant): Integer; safecall; + procedure Insert(index: Integer; value: OleVariant); safecall; + procedure Remove(value: OleVariant); safecall; + procedure RemoveAt(index: Integer); safecall; + property Item[index: Integer]: OleVariant read Get_Item write _Set_Item; default; + property IsReadOnly: WordBool read Get_IsReadOnly; + property IsFixedSize: WordBool read Get_IsFixedSize; + end; + +// *********************************************************************// +// DispIntf: IListDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {7BCFA00F-F764-3113-9140-3BBD127A96BB} +// *********************************************************************// + IListDisp = dispinterface + ['{7BCFA00F-F764-3113-9140-3BBD127A96BB}'] + property Item[index: Integer]: OleVariant dispid 0; default; + function Add(value: OleVariant): Integer; dispid 1610743810; + function Contains(value: OleVariant): WordBool; dispid 1610743811; + procedure Clear; dispid 1610743812; + property IsReadOnly: WordBool readonly dispid 1610743813; + property IsFixedSize: WordBool readonly dispid 1610743814; + function IndexOf(value: OleVariant): Integer; dispid 1610743815; + procedure Insert(index: Integer; value: OleVariant); dispid 1610743816; + procedure Remove(value: OleVariant); dispid 1610743817; + procedure RemoveAt(index: Integer); dispid 1610743818; + end; + {$EXTERNALSYM IListDisp} + +// *********************************************************************// +// Interface: _Array +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {2B67CECE-71C3-36A9-A136-925CCC1935A8} +// *********************************************************************// + _Array = interface(IDispatch) + ['{2B67CECE-71C3-36A9-A136-925CCC1935A8}'] + end; + +// *********************************************************************// +// DispIntf: _ArrayDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {2B67CECE-71C3-36A9-A136-925CCC1935A8} +// *********************************************************************// + _ArrayDisp = dispinterface + ['{2B67CECE-71C3-36A9-A136-925CCC1935A8}'] + end; + {$EXTERNALSYM _ArrayDisp} + +// *********************************************************************// +// Interface: IEnumerator +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {496B0ABF-CDEE-11D3-88E8-00902754C43A} +// *********************************************************************// + IEnumerator = interface(IDispatch) + ['{496B0ABF-CDEE-11D3-88E8-00902754C43A}'] + function MoveNext: WordBool; safecall; + function Get_Current: OleVariant; safecall; + procedure Reset; safecall; + property Current: OleVariant read Get_Current; + end; + +// *********************************************************************// +// DispIntf: IEnumeratorDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {496B0ABF-CDEE-11D3-88E8-00902754C43A} +// *********************************************************************// + IEnumeratorDisp = dispinterface + ['{496B0ABF-CDEE-11D3-88E8-00902754C43A}'] + function MoveNext: WordBool; dispid 1610743808; + property Current: OleVariant readonly dispid 1610743809; + procedure Reset; dispid 1610743810; + end; + {$EXTERNALSYM IEnumeratorDisp} + +// *********************************************************************// +// Interface: IComparable +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {DEB0E770-91FD-3CF6-9A6C-E6A3656F3965} +// *********************************************************************// + IComparable = interface(IDispatch) + ['{DEB0E770-91FD-3CF6-9A6C-E6A3656F3965}'] + function CompareTo(obj: OleVariant): Integer; safecall; + end; + +// *********************************************************************// +// DispIntf: IComparableDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {DEB0E770-91FD-3CF6-9A6C-E6A3656F3965} +// *********************************************************************// + IComparableDisp = dispinterface + ['{DEB0E770-91FD-3CF6-9A6C-E6A3656F3965}'] + function CompareTo(obj: OleVariant): Integer; dispid 1610743808; + end; + {$EXTERNALSYM IComparableDisp} + +// *********************************************************************// +// Interface: IConvertible +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {805E3B62-B5E9-393D-8941-377D8BF4556B} +// *********************************************************************// + IConvertible = interface(IDispatch) + ['{805E3B62-B5E9-393D-8941-377D8BF4556B}'] + function GetTypeCode: TypeCode; safecall; + function ToBoolean(const provider: IFormatProvider): WordBool; safecall; + function ToChar(const provider: IFormatProvider): Word; safecall; + function ToSByte(const provider: IFormatProvider): Shortint; safecall; + function ToByte(const provider: IFormatProvider): Byte; safecall; + function ToInt16(const provider: IFormatProvider): Smallint; safecall; + function ToUInt16(const provider: IFormatProvider): Word; safecall; + function ToInt32(const provider: IFormatProvider): Integer; safecall; + function ToUInt32(const provider: IFormatProvider): LongWord; safecall; + function ToInt64(const provider: IFormatProvider): Int64; safecall; + function ToUInt64(const provider: IFormatProvider): Largeuint; safecall; + function ToSingle(const provider: IFormatProvider): Single; safecall; + function ToDouble(const provider: IFormatProvider): Double; safecall; + function ToDecimal(const provider: IFormatProvider): TDecimal; safecall; + function ToDateTime(const provider: IFormatProvider): TDateTime; safecall; + function Get_ToString(const provider: IFormatProvider): WideString; safecall; + function ToType(const conversionType: _Type; const provider: IFormatProvider): OleVariant; safecall; + property ToString[const provider: IFormatProvider]: WideString read Get_ToString; + end; + +// *********************************************************************// +// DispIntf: IConvertibleDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {805E3B62-B5E9-393D-8941-377D8BF4556B} +// *********************************************************************// + IConvertibleDisp = dispinterface + ['{805E3B62-B5E9-393D-8941-377D8BF4556B}'] + function GetTypeCode: TypeCode; dispid 1610743808; + function ToBoolean(const provider: IFormatProvider): WordBool; dispid 1610743809; + function ToChar(const provider: IFormatProvider): {??Word}OleVariant; dispid 1610743810; + function ToSByte(const provider: IFormatProvider): {??Shortint}OleVariant; dispid 1610743811; + function ToByte(const provider: IFormatProvider): Byte; dispid 1610743812; + function ToInt16(const provider: IFormatProvider): Smallint; dispid 1610743813; + function ToUInt16(const provider: IFormatProvider): {??Word}OleVariant; dispid 1610743814; + function ToInt32(const provider: IFormatProvider): Integer; dispid 1610743815; + function ToUInt32(const provider: IFormatProvider): LongWord; dispid 1610743816; + function ToInt64(const provider: IFormatProvider): {??Int64}OleVariant; dispid 1610743817; + function ToUInt64(const provider: IFormatProvider): {??Largeuint}OleVariant; dispid 1610743818; + function ToSingle(const provider: IFormatProvider): Single; dispid 1610743819; + function ToDouble(const provider: IFormatProvider): Double; dispid 1610743820; + function ToDecimal(const provider: IFormatProvider): {??TDecimal}OleVariant; dispid 1610743821; + function ToDateTime(const provider: IFormatProvider): TDateTime; dispid 1610743822; + property ToString[const provider: IFormatProvider]: WideString readonly dispid 1610743823; + function ToType(const conversionType: _Type; const provider: IFormatProvider): OleVariant; dispid 1610743824; + end; + {$EXTERNALSYM IConvertibleDisp} + +// *********************************************************************// +// Interface: _String +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {36936699-FC79-324D-AB43-E33C1F94E263} +// *********************************************************************// + _String = interface(IDispatch) + ['{36936699-FC79-324D-AB43-E33C1F94E263}'] + end; + +// *********************************************************************// +// DispIntf: _StringDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {36936699-FC79-324D-AB43-E33C1F94E263} +// *********************************************************************// + _StringDisp = dispinterface + ['{36936699-FC79-324D-AB43-E33C1F94E263}'] + end; + {$EXTERNALSYM _StringDisp} + +// *********************************************************************// +// Interface: _StringBuilder +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9FB09782-8D39-3B0C-B79E-F7A37A65B3DA} +// *********************************************************************// + _StringBuilder = interface(IDispatch) + ['{9FB09782-8D39-3B0C-B79E-F7A37A65B3DA}'] + end; + +// *********************************************************************// +// DispIntf: _StringBuilderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9FB09782-8D39-3B0C-B79E-F7A37A65B3DA} +// *********************************************************************// + _StringBuilderDisp = dispinterface + ['{9FB09782-8D39-3B0C-B79E-F7A37A65B3DA}'] + end; + {$EXTERNALSYM _StringBuilderDisp} + +// *********************************************************************// +// Interface: ISerializable +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {D0EEAA62-3D30-3EE2-B896-A2F34DDA47D8} +// *********************************************************************// + ISerializable = interface(IDispatch) + ['{D0EEAA62-3D30-3EE2-B896-A2F34DDA47D8}'] + procedure GetObjectData(const info: _SerializationInfo; Context: StreamingContext); safecall; + end; + +// *********************************************************************// +// DispIntf: ISerializableDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {D0EEAA62-3D30-3EE2-B896-A2F34DDA47D8} +// *********************************************************************// + ISerializableDisp = dispinterface + ['{D0EEAA62-3D30-3EE2-B896-A2F34DDA47D8}'] + procedure GetObjectData(const info: _SerializationInfo; Context: {??StreamingContext}OleVariant); dispid 1610743808; + end; + {$EXTERNALSYM ISerializableDisp} + +// *********************************************************************// +// Interface: _Exception +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {B36B5C63-42EF-38BC-A07E-0B34C98F164A} +// *********************************************************************// + _Exception = interface(IDispatch) + ['{B36B5C63-42EF-38BC-A07E-0B34C98F164A}'] + function Get_ToString: WideString; safecall; + function Equals(obj: OleVariant): WordBool; safecall; + function GetHashCode: Integer; safecall; + function GetType: _Type; safecall; + function Get_Message: WideString; safecall; + function GetBaseException: _Exception; safecall; + function Get_StackTrace: WideString; safecall; + function Get_HelpLink: WideString; safecall; + procedure Set_HelpLink(const pRetVal: WideString); safecall; + function Get_Source: WideString; safecall; + procedure Set_Source(const pRetVal: WideString); safecall; + procedure GetObjectData(const info: _SerializationInfo; Context: StreamingContext); safecall; + function Get_InnerException: _Exception; safecall; + function Get_TargetSite: _MethodBase; safecall; + property ToString: WideString read Get_ToString; + property Message: WideString read Get_Message; + property StackTrace: WideString read Get_StackTrace; + property HelpLink: WideString read Get_HelpLink; + property Source: WideString read Get_Source; + property InnerException: _Exception read Get_InnerException; + property TargetSite: _MethodBase read Get_TargetSite; + end; + +// *********************************************************************// +// DispIntf: _ExceptionDisp +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {B36B5C63-42EF-38BC-A07E-0B34C98F164A} +// *********************************************************************// + _ExceptionDisp = dispinterface + ['{B36B5C63-42EF-38BC-A07E-0B34C98F164A}'] + property ToString: WideString readonly dispid 0; + function Equals(obj: OleVariant): WordBool; dispid 1610743809; + function GetHashCode: Integer; dispid 1610743810; + function GetType: _Type; dispid 1610743811; + property Message: WideString readonly dispid 1610743812; + function GetBaseException: _Exception; dispid 1610743813; + property StackTrace: WideString readonly dispid 1610743814; + property HelpLink: WideString readonly dispid 1610743815; + property Source: WideString readonly dispid 1610743817; + procedure GetObjectData(const info: _SerializationInfo; Context: {??StreamingContext}OleVariant); dispid 1610743819; + property InnerException: _Exception readonly dispid 1610743820; + property TargetSite: _MethodBase readonly dispid 1610743821; + end; + {$EXTERNALSYM _ExceptionDisp} + +// *********************************************************************// +// Interface: _ValueType +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {139E041D-0E41-39F5-A302-C4387E9D0A6C} +// *********************************************************************// + _ValueType = interface(IDispatch) + ['{139E041D-0E41-39F5-A302-C4387E9D0A6C}'] + end; + +// *********************************************************************// +// DispIntf: _ValueTypeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {139E041D-0E41-39F5-A302-C4387E9D0A6C} +// *********************************************************************// + _ValueTypeDisp = dispinterface + ['{139E041D-0E41-39F5-A302-C4387E9D0A6C}'] + end; + {$EXTERNALSYM _ValueTypeDisp} + +// *********************************************************************// +// Interface: IFormattable +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {9A604EE7-E630-3DED-9444-BAAE247075AB} +// *********************************************************************// + IFormattable = interface(IDispatch) + ['{9A604EE7-E630-3DED-9444-BAAE247075AB}'] + function Get_ToString(const format: WideString; const formatProvider: IFormatProvider): WideString; safecall; + property ToString[const format: WideString; const formatProvider: IFormatProvider]: WideString read Get_ToString; + end; + +// *********************************************************************// +// DispIntf: IFormattableDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {9A604EE7-E630-3DED-9444-BAAE247075AB} +// *********************************************************************// + IFormattableDisp = dispinterface + ['{9A604EE7-E630-3DED-9444-BAAE247075AB}'] + property ToString[const format: WideString; const formatProvider: IFormatProvider]: WideString readonly dispid 1610743808; + end; + {$EXTERNALSYM IFormattableDisp} + +// *********************************************************************// +// Interface: _SystemException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4C482CC2-68E9-37C6-8353-9A94BD2D7F0B} +// *********************************************************************// + _SystemException = interface(IDispatch) + ['{4C482CC2-68E9-37C6-8353-9A94BD2D7F0B}'] + end; + +// *********************************************************************// +// DispIntf: _SystemExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4C482CC2-68E9-37C6-8353-9A94BD2D7F0B} +// *********************************************************************// + _SystemExceptionDisp = dispinterface + ['{4C482CC2-68E9-37C6-8353-9A94BD2D7F0B}'] + end; + {$EXTERNALSYM _SystemExceptionDisp} + +// *********************************************************************// +// Interface: _OutOfMemoryException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {CF3EDB7E-0574-3383-A44F-292F7C145DB4} +// *********************************************************************// + _OutOfMemoryException = interface(IDispatch) + ['{CF3EDB7E-0574-3383-A44F-292F7C145DB4}'] + end; + +// *********************************************************************// +// DispIntf: _OutOfMemoryExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {CF3EDB7E-0574-3383-A44F-292F7C145DB4} +// *********************************************************************// + _OutOfMemoryExceptionDisp = dispinterface + ['{CF3EDB7E-0574-3383-A44F-292F7C145DB4}'] + end; + {$EXTERNALSYM _OutOfMemoryExceptionDisp} + +// *********************************************************************// +// Interface: _StackOverflowException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9CF4339A-2911-3B8A-8F30-E5C6B5BE9A29} +// *********************************************************************// + _StackOverflowException = interface(IDispatch) + ['{9CF4339A-2911-3B8A-8F30-E5C6B5BE9A29}'] + end; + +// *********************************************************************// +// DispIntf: _StackOverflowExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9CF4339A-2911-3B8A-8F30-E5C6B5BE9A29} +// *********************************************************************// + _StackOverflowExceptionDisp = dispinterface + ['{9CF4339A-2911-3B8A-8F30-E5C6B5BE9A29}'] + end; + {$EXTERNALSYM _StackOverflowExceptionDisp} + +// *********************************************************************// +// Interface: _ExecutionEngineException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {CCF0139C-79F7-3D0A-AFFE-2B0762C65B07} +// *********************************************************************// + _ExecutionEngineException = interface(IDispatch) + ['{CCF0139C-79F7-3D0A-AFFE-2B0762C65B07}'] + end; + +// *********************************************************************// +// DispIntf: _ExecutionEngineExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {CCF0139C-79F7-3D0A-AFFE-2B0762C65B07} +// *********************************************************************// + _ExecutionEngineExceptionDisp = dispinterface + ['{CCF0139C-79F7-3D0A-AFFE-2B0762C65B07}'] + end; + {$EXTERNALSYM _ExecutionEngineExceptionDisp} + +// *********************************************************************// +// Interface: _Delegate +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {FB6AB00F-5096-3AF8-A33D-D7885A5FA829} +// *********************************************************************// + _Delegate = interface(IDispatch) + ['{FB6AB00F-5096-3AF8-A33D-D7885A5FA829}'] + function Get_ToString: WideString; safecall; + function Equals(obj: OleVariant): WordBool; safecall; + function GetHashCode: Integer; safecall; + function GetType: _Type; safecall; + function GetInvocationList: PSafeArray; safecall; + function Clone: OleVariant; safecall; + procedure GetObjectData(const info: _SerializationInfo; Context: StreamingContext); safecall; + function DynamicInvoke(args: PSafeArray): OleVariant; safecall; + function Get_Method: _MethodInfo; safecall; + function Get_Target: OleVariant; safecall; + property ToString: WideString read Get_ToString; + property Method: _MethodInfo read Get_Method; + property Target: OleVariant read Get_Target; + end; + +// *********************************************************************// +// DispIntf: _DelegateDisp +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {FB6AB00F-5096-3AF8-A33D-D7885A5FA829} +// *********************************************************************// + _DelegateDisp = dispinterface + ['{FB6AB00F-5096-3AF8-A33D-D7885A5FA829}'] + property ToString: WideString readonly dispid 0; + function Equals(obj: OleVariant): WordBool; dispid 1610743809; + function GetHashCode: Integer; dispid 1610743810; + function GetType: _Type; dispid 1610743811; + function GetInvocationList: {??PSafeArray}OleVariant; dispid 1610743812; + function Clone: OleVariant; dispid 1610743813; + procedure GetObjectData(const info: _SerializationInfo; Context: {??StreamingContext}OleVariant); dispid 1610743814; + function DynamicInvoke(args: {??PSafeArray}OleVariant): OleVariant; dispid 1610743815; + property Method: _MethodInfo readonly dispid 1610743816; + property Target: OleVariant readonly dispid 1610743817; + end; + {$EXTERNALSYM _DelegateDisp} + +// *********************************************************************// +// Interface: _MulticastDelegate +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {16FE0885-9129-3884-A232-90B58C5B2AA9} +// *********************************************************************// + _MulticastDelegate = interface(IDispatch) + ['{16FE0885-9129-3884-A232-90B58C5B2AA9}'] + end; + +// *********************************************************************// +// DispIntf: _MulticastDelegateDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {16FE0885-9129-3884-A232-90B58C5B2AA9} +// *********************************************************************// + _MulticastDelegateDisp = dispinterface + ['{16FE0885-9129-3884-A232-90B58C5B2AA9}'] + end; + {$EXTERNALSYM _MulticastDelegateDisp} + +// *********************************************************************// +// Interface: _Enum +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D09D1E04-D590-39A3-B517-B734A49A9277} +// *********************************************************************// + _Enum = interface(IDispatch) + ['{D09D1E04-D590-39A3-B517-B734A49A9277}'] + end; + +// *********************************************************************// +// DispIntf: _EnumDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D09D1E04-D590-39A3-B517-B734A49A9277} +// *********************************************************************// + _EnumDisp = dispinterface + ['{D09D1E04-D590-39A3-B517-B734A49A9277}'] + end; + {$EXTERNALSYM _EnumDisp} + +// *********************************************************************// +// Interface: _MemberAccessException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7EABA4E2-1259-3CF2-B084-9854278E5897} +// *********************************************************************// + _MemberAccessException = interface(IDispatch) + ['{7EABA4E2-1259-3CF2-B084-9854278E5897}'] + end; + +// *********************************************************************// +// DispIntf: _MemberAccessExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7EABA4E2-1259-3CF2-B084-9854278E5897} +// *********************************************************************// + _MemberAccessExceptionDisp = dispinterface + ['{7EABA4E2-1259-3CF2-B084-9854278E5897}'] + end; + {$EXTERNALSYM _MemberAccessExceptionDisp} + +// *********************************************************************// +// Interface: _Activator +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {03973551-57A1-3900-A2B5-9083E3FF2943} +// *********************************************************************// + _Activator = interface(IDispatch) + ['{03973551-57A1-3900-A2B5-9083E3FF2943}'] + end; + +// *********************************************************************// +// DispIntf: _ActivatorDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {03973551-57A1-3900-A2B5-9083E3FF2943} +// *********************************************************************// + _ActivatorDisp = dispinterface + ['{03973551-57A1-3900-A2B5-9083E3FF2943}'] + end; + {$EXTERNALSYM _ActivatorDisp} + +// *********************************************************************// +// Interface: _ApplicationException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D81130BF-D627-3B91-A7C7-CEA597093464} +// *********************************************************************// + _ApplicationException = interface(IDispatch) + ['{D81130BF-D627-3B91-A7C7-CEA597093464}'] + end; + +// *********************************************************************// +// DispIntf: _ApplicationExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D81130BF-D627-3B91-A7C7-CEA597093464} +// *********************************************************************// + _ApplicationExceptionDisp = dispinterface + ['{D81130BF-D627-3B91-A7C7-CEA597093464}'] + end; + {$EXTERNALSYM _ApplicationExceptionDisp} + +// *********************************************************************// +// Interface: _EventArgs +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1F9EC719-343A-3CB3-8040-3927626777C1} +// *********************************************************************// + _EventArgs = interface(IDispatch) + ['{1F9EC719-343A-3CB3-8040-3927626777C1}'] + end; + +// *********************************************************************// +// DispIntf: _EventArgsDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1F9EC719-343A-3CB3-8040-3927626777C1} +// *********************************************************************// + _EventArgsDisp = dispinterface + ['{1F9EC719-343A-3CB3-8040-3927626777C1}'] + end; + {$EXTERNALSYM _EventArgsDisp} + +// *********************************************************************// +// Interface: _ResolveEventArgs +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {98947CF0-77E7-328E-B709-5DD1AA1C9C96} +// *********************************************************************// + _ResolveEventArgs = interface(IDispatch) + ['{98947CF0-77E7-328E-B709-5DD1AA1C9C96}'] + end; + +// *********************************************************************// +// DispIntf: _ResolveEventArgsDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {98947CF0-77E7-328E-B709-5DD1AA1C9C96} +// *********************************************************************// + _ResolveEventArgsDisp = dispinterface + ['{98947CF0-77E7-328E-B709-5DD1AA1C9C96}'] + end; + {$EXTERNALSYM _ResolveEventArgsDisp} + +// *********************************************************************// +// Interface: _AssemblyLoadEventArgs +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7A0325F0-22C2-31F9-8823-9B8AEE9456B1} +// *********************************************************************// + _AssemblyLoadEventArgs = interface(IDispatch) + ['{7A0325F0-22C2-31F9-8823-9B8AEE9456B1}'] + end; + +// *********************************************************************// +// DispIntf: _AssemblyLoadEventArgsDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7A0325F0-22C2-31F9-8823-9B8AEE9456B1} +// *********************************************************************// + _AssemblyLoadEventArgsDisp = dispinterface + ['{7A0325F0-22C2-31F9-8823-9B8AEE9456B1}'] + end; + {$EXTERNALSYM _AssemblyLoadEventArgsDisp} + +// *********************************************************************// +// Interface: _ResolveEventHandler +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8E54A9CC-7AA4-34CA-985B-BD7D7527B110} +// *********************************************************************// + _ResolveEventHandler = interface(IDispatch) + ['{8E54A9CC-7AA4-34CA-985B-BD7D7527B110}'] + end; + +// *********************************************************************// +// DispIntf: _ResolveEventHandlerDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8E54A9CC-7AA4-34CA-985B-BD7D7527B110} +// *********************************************************************// + _ResolveEventHandlerDisp = dispinterface + ['{8E54A9CC-7AA4-34CA-985B-BD7D7527B110}'] + end; + {$EXTERNALSYM _ResolveEventHandlerDisp} + +// *********************************************************************// +// Interface: _AssemblyLoadEventHandler +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DEECE11F-A893-3E35-A4C3-DAB7FA0911EB} +// *********************************************************************// + _AssemblyLoadEventHandler = interface(IDispatch) + ['{DEECE11F-A893-3E35-A4C3-DAB7FA0911EB}'] + end; + +// *********************************************************************// +// DispIntf: _AssemblyLoadEventHandlerDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DEECE11F-A893-3E35-A4C3-DAB7FA0911EB} +// *********************************************************************// + _AssemblyLoadEventHandlerDisp = dispinterface + ['{DEECE11F-A893-3E35-A4C3-DAB7FA0911EB}'] + end; + {$EXTERNALSYM _AssemblyLoadEventHandlerDisp} + +// *********************************************************************// +// Interface: _MarshalByRefObject +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {2C358E27-8C1A-3C03-B086-A40465625557} +// *********************************************************************// + _MarshalByRefObject = interface(IDispatch) + ['{2C358E27-8C1A-3C03-B086-A40465625557}'] + end; + +// *********************************************************************// +// DispIntf: _MarshalByRefObjectDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {2C358E27-8C1A-3C03-B086-A40465625557} +// *********************************************************************// + _MarshalByRefObjectDisp = dispinterface + ['{2C358E27-8C1A-3C03-B086-A40465625557}'] + end; + {$EXTERNALSYM _MarshalByRefObjectDisp} + +// *********************************************************************// +// Interface: _AppDomain +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {05F696DC-2B29-3663-AD8B-C4389CF2A713} +// *********************************************************************// + _AppDomain = interface(IDispatch) + ['{05F696DC-2B29-3663-AD8B-C4389CF2A713}'] + function Get_ToString: WideString; safecall; + function Equals(other: OleVariant): WordBool; safecall; + function GetHashCode: Integer; safecall; + function GetType: _Type; safecall; + function InitializeLifetimeService: OleVariant; safecall; + function GetLifetimeService: OleVariant; safecall; + function Get_Evidence: _Evidence; safecall; + procedure add_DomainUnload(const value: _EventHandler); safecall; + procedure remove_DomainUnload(const value: _EventHandler); safecall; + procedure add_AssemblyLoad(const value: _AssemblyLoadEventHandler); safecall; + procedure remove_AssemblyLoad(const value: _AssemblyLoadEventHandler); safecall; + procedure add_ProcessExit(const value: _EventHandler); safecall; + procedure remove_ProcessExit(const value: _EventHandler); safecall; + procedure add_TypeResolve(const value: _ResolveEventHandler); safecall; + procedure remove_TypeResolve(const value: _ResolveEventHandler); safecall; + procedure add_ResourceResolve(const value: _ResolveEventHandler); safecall; + procedure remove_ResourceResolve(const value: _ResolveEventHandler); safecall; + procedure add_AssemblyResolve(const value: _ResolveEventHandler); safecall; + procedure remove_AssemblyResolve(const value: _ResolveEventHandler); safecall; + procedure add_UnhandledException(const value: _UnhandledExceptionEventHandler); safecall; + procedure remove_UnhandledException(const value: _UnhandledExceptionEventHandler); safecall; + function DefineDynamicAssembly(const name: _AssemblyName; access: AssemblyBuilderAccess): _AssemblyBuilder; safecall; + function DefineDynamicAssembly_2(const name: _AssemblyName; access: AssemblyBuilderAccess; + const dir: WideString): _AssemblyBuilder; safecall; + function DefineDynamicAssembly_3(const name: _AssemblyName; access: AssemblyBuilderAccess; + const Evidence: _Evidence): _AssemblyBuilder; safecall; + function DefineDynamicAssembly_4(const name: _AssemblyName; access: AssemblyBuilderAccess; + const requiredPermissions: _PermissionSet; + const optionalPermissions: _PermissionSet; + const refusedPermissions: _PermissionSet): _AssemblyBuilder; safecall; + function DefineDynamicAssembly_5(const name: _AssemblyName; access: AssemblyBuilderAccess; + const dir: WideString; const Evidence: _Evidence): _AssemblyBuilder; safecall; + function DefineDynamicAssembly_6(const name: _AssemblyName; access: AssemblyBuilderAccess; + const dir: WideString; + const requiredPermissions: _PermissionSet; + const optionalPermissions: _PermissionSet; + const refusedPermissions: _PermissionSet): _AssemblyBuilder; safecall; + function DefineDynamicAssembly_7(const name: _AssemblyName; access: AssemblyBuilderAccess; + const Evidence: _Evidence; + const requiredPermissions: _PermissionSet; + const optionalPermissions: _PermissionSet; + const refusedPermissions: _PermissionSet): _AssemblyBuilder; safecall; + function DefineDynamicAssembly_8(const name: _AssemblyName; access: AssemblyBuilderAccess; + const dir: WideString; const Evidence: _Evidence; + const requiredPermissions: _PermissionSet; + const optionalPermissions: _PermissionSet; + const refusedPermissions: _PermissionSet): _AssemblyBuilder; safecall; + function DefineDynamicAssembly_9(const name: _AssemblyName; access: AssemblyBuilderAccess; + const dir: WideString; const Evidence: _Evidence; + const requiredPermissions: _PermissionSet; + const optionalPermissions: _PermissionSet; + const refusedPermissions: _PermissionSet; + IsSynchronized: WordBool): _AssemblyBuilder; safecall; + function CreateInstance(const AssemblyName: WideString; const typeName: WideString): _ObjectHandle; safecall; + function CreateInstanceFrom(const assemblyFile: WideString; const typeName: WideString): _ObjectHandle; safecall; + function CreateInstance_2(const AssemblyName: WideString; const typeName: WideString; + activationAttributes: PSafeArray): _ObjectHandle; safecall; + function CreateInstanceFrom_2(const assemblyFile: WideString; const typeName: WideString; + activationAttributes: PSafeArray): _ObjectHandle; safecall; + function CreateInstance_3(const AssemblyName: WideString; const typeName: WideString; + ignoreCase: WordBool; bindingAttr: BindingFlags; + const Binder: _Binder; args: PSafeArray; const culture: _CultureInfo; + activationAttributes: PSafeArray; const securityAttributes: _Evidence): _ObjectHandle; safecall; + function CreateInstanceFrom_3(const assemblyFile: WideString; const typeName: WideString; + ignoreCase: WordBool; bindingAttr: BindingFlags; + const Binder: _Binder; args: PSafeArray; + const culture: _CultureInfo; activationAttributes: PSafeArray; + const securityAttributes: _Evidence): _ObjectHandle; safecall; + function Load(const assemblyRef: _AssemblyName): _Assembly; safecall; + function Load_2(const assemblyString: WideString): _Assembly; safecall; + function Load_3(rawAssembly: PSafeArray): _Assembly; safecall; + function Load_4(rawAssembly: PSafeArray; rawSymbolStore: PSafeArray): _Assembly; safecall; + function Load_5(rawAssembly: PSafeArray; rawSymbolStore: PSafeArray; + const securityEvidence: _Evidence): _Assembly; safecall; + function Load_6(const assemblyRef: _AssemblyName; const assemblySecurity: _Evidence): _Assembly; safecall; + function Load_7(const assemblyString: WideString; const assemblySecurity: _Evidence): _Assembly; safecall; + function ExecuteAssembly(const assemblyFile: WideString; const assemblySecurity: _Evidence): Integer; safecall; + function ExecuteAssembly_2(const assemblyFile: WideString): Integer; safecall; + function ExecuteAssembly_3(const assemblyFile: WideString; const assemblySecurity: _Evidence; + args: PSafeArray): Integer; safecall; + function Get_FriendlyName: WideString; safecall; + function Get_BaseDirectory: WideString; safecall; + function Get_RelativeSearchPath: WideString; safecall; + function Get_ShadowCopyFiles: WordBool; safecall; + function GetAssemblies: PSafeArray; safecall; + procedure AppendPrivatePath(const Path: WideString); safecall; + procedure ClearPrivatePath; safecall; + procedure SetShadowCopyPath(const s: WideString); safecall; + procedure ClearShadowCopyPath; safecall; + procedure SetCachePath(const s: WideString); safecall; + procedure SetData(const name: WideString; data: OleVariant); safecall; + function GetData(const name: WideString): OleVariant; safecall; + procedure SetAppDomainPolicy(const domainPolicy: _PolicyLevel); safecall; + procedure SetThreadPrincipal(const principal: IPrincipal); safecall; + procedure SetPrincipalPolicy(policy: PrincipalPolicy); safecall; + procedure DoCallBack(const theDelegate: _CrossAppDomainDelegate); safecall; + function Get_DynamicDirectory: WideString; safecall; + property ToString: WideString read Get_ToString; + property Evidence: _Evidence read Get_Evidence; + property FriendlyName: WideString read Get_FriendlyName; + property BaseDirectory: WideString read Get_BaseDirectory; + property RelativeSearchPath: WideString read Get_RelativeSearchPath; + property ShadowCopyFiles: WordBool read Get_ShadowCopyFiles; + property DynamicDirectory: WideString read Get_DynamicDirectory; + end; + +// *********************************************************************// +// DispIntf: _AppDomainDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {05F696DC-2B29-3663-AD8B-C4389CF2A713} +// *********************************************************************// + _AppDomainDisp = dispinterface + ['{05F696DC-2B29-3663-AD8B-C4389CF2A713}'] + property ToString: WideString readonly dispid 0; + function Equals(other: OleVariant): WordBool; dispid 1610743809; + function GetHashCode: Integer; dispid 1610743810; + function GetType: _Type; dispid 1610743811; + function InitializeLifetimeService: OleVariant; dispid 1610743812; + function GetLifetimeService: OleVariant; dispid 1610743813; + property Evidence: _Evidence readonly dispid 1610743814; + procedure add_DomainUnload(const value: _EventHandler); dispid 1610743815; + procedure remove_DomainUnload(const value: _EventHandler); dispid 1610743816; + procedure add_AssemblyLoad(const value: _AssemblyLoadEventHandler); dispid 1610743817; + procedure remove_AssemblyLoad(const value: _AssemblyLoadEventHandler); dispid 1610743818; + procedure add_ProcessExit(const value: _EventHandler); dispid 1610743819; + procedure remove_ProcessExit(const value: _EventHandler); dispid 1610743820; + procedure add_TypeResolve(const value: _ResolveEventHandler); dispid 1610743821; + procedure remove_TypeResolve(const value: _ResolveEventHandler); dispid 1610743822; + procedure add_ResourceResolve(const value: _ResolveEventHandler); dispid 1610743823; + procedure remove_ResourceResolve(const value: _ResolveEventHandler); dispid 1610743824; + procedure add_AssemblyResolve(const value: _ResolveEventHandler); dispid 1610743825; + procedure remove_AssemblyResolve(const value: _ResolveEventHandler); dispid 1610743826; + procedure add_UnhandledException(const value: _UnhandledExceptionEventHandler); dispid 1610743827; + procedure remove_UnhandledException(const value: _UnhandledExceptionEventHandler); dispid 1610743828; + function DefineDynamicAssembly(const name: _AssemblyName; access: AssemblyBuilderAccess): _AssemblyBuilder; dispid 1610743829; + function DefineDynamicAssembly_2(const name: _AssemblyName; access: AssemblyBuilderAccess; + const dir: WideString): _AssemblyBuilder; dispid 1610743830; + function DefineDynamicAssembly_3(const name: _AssemblyName; access: AssemblyBuilderAccess; + const Evidence: _Evidence): _AssemblyBuilder; dispid 1610743831; + function DefineDynamicAssembly_4(const name: _AssemblyName; access: AssemblyBuilderAccess; + const requiredPermissions: _PermissionSet; + const optionalPermissions: _PermissionSet; + const refusedPermissions: _PermissionSet): _AssemblyBuilder; dispid 1610743832; + function DefineDynamicAssembly_5(const name: _AssemblyName; access: AssemblyBuilderAccess; + const dir: WideString; const Evidence: _Evidence): _AssemblyBuilder; dispid 1610743833; + function DefineDynamicAssembly_6(const name: _AssemblyName; access: AssemblyBuilderAccess; + const dir: WideString; + const requiredPermissions: _PermissionSet; + const optionalPermissions: _PermissionSet; + const refusedPermissions: _PermissionSet): _AssemblyBuilder; dispid 1610743834; + function DefineDynamicAssembly_7(const name: _AssemblyName; access: AssemblyBuilderAccess; + const Evidence: _Evidence; + const requiredPermissions: _PermissionSet; + const optionalPermissions: _PermissionSet; + const refusedPermissions: _PermissionSet): _AssemblyBuilder; dispid 1610743835; + function DefineDynamicAssembly_8(const name: _AssemblyName; access: AssemblyBuilderAccess; + const dir: WideString; const Evidence: _Evidence; + const requiredPermissions: _PermissionSet; + const optionalPermissions: _PermissionSet; + const refusedPermissions: _PermissionSet): _AssemblyBuilder; dispid 1610743836; + function DefineDynamicAssembly_9(const name: _AssemblyName; access: AssemblyBuilderAccess; + const dir: WideString; const Evidence: _Evidence; + const requiredPermissions: _PermissionSet; + const optionalPermissions: _PermissionSet; + const refusedPermissions: _PermissionSet; + IsSynchronized: WordBool): _AssemblyBuilder; dispid 1610743837; + function CreateInstance(const AssemblyName: WideString; const typeName: WideString): _ObjectHandle; dispid 1610743838; + function CreateInstanceFrom(const assemblyFile: WideString; const typeName: WideString): _ObjectHandle; dispid 1610743839; + function CreateInstance_2(const AssemblyName: WideString; const typeName: WideString; + activationAttributes: {??PSafeArray}OleVariant): _ObjectHandle; dispid 1610743840; + function CreateInstanceFrom_2(const assemblyFile: WideString; const typeName: WideString; + activationAttributes: {??PSafeArray}OleVariant): _ObjectHandle; dispid 1610743841; + function CreateInstance_3(const AssemblyName: WideString; const typeName: WideString; + ignoreCase: WordBool; bindingAttr: BindingFlags; + const Binder: _Binder; args: {??PSafeArray}OleVariant; + const culture: _CultureInfo; + activationAttributes: {??PSafeArray}OleVariant; + const securityAttributes: _Evidence): _ObjectHandle; dispid 1610743842; + function CreateInstanceFrom_3(const assemblyFile: WideString; const typeName: WideString; + ignoreCase: WordBool; bindingAttr: BindingFlags; + const Binder: _Binder; args: {??PSafeArray}OleVariant; + const culture: _CultureInfo; + activationAttributes: {??PSafeArray}OleVariant; + const securityAttributes: _Evidence): _ObjectHandle; dispid 1610743843; + function Load(const assemblyRef: _AssemblyName): _Assembly; dispid 1610743844; + function Load_2(const assemblyString: WideString): _Assembly; dispid 1610743845; + function Load_3(rawAssembly: {??PSafeArray}OleVariant): _Assembly; dispid 1610743846; + function Load_4(rawAssembly: {??PSafeArray}OleVariant; rawSymbolStore: {??PSafeArray}OleVariant): _Assembly; dispid 1610743847; + function Load_5(rawAssembly: {??PSafeArray}OleVariant; + rawSymbolStore: {??PSafeArray}OleVariant; const securityEvidence: _Evidence): _Assembly; dispid 1610743848; + function Load_6(const assemblyRef: _AssemblyName; const assemblySecurity: _Evidence): _Assembly; dispid 1610743849; + function Load_7(const assemblyString: WideString; const assemblySecurity: _Evidence): _Assembly; dispid 1610743850; + function ExecuteAssembly(const assemblyFile: WideString; const assemblySecurity: _Evidence): Integer; dispid 1610743851; + function ExecuteAssembly_2(const assemblyFile: WideString): Integer; dispid 1610743852; + function ExecuteAssembly_3(const assemblyFile: WideString; const assemblySecurity: _Evidence; + args: {??PSafeArray}OleVariant): Integer; dispid 1610743853; + property FriendlyName: WideString readonly dispid 1610743854; + property BaseDirectory: WideString readonly dispid 1610743855; + property RelativeSearchPath: WideString readonly dispid 1610743856; + property ShadowCopyFiles: WordBool readonly dispid 1610743857; + function GetAssemblies: {??PSafeArray}OleVariant; dispid 1610743858; + procedure AppendPrivatePath(const Path: WideString); dispid 1610743859; + procedure ClearPrivatePath; dispid 1610743860; + procedure SetShadowCopyPath(const s: WideString); dispid 1610743861; + procedure ClearShadowCopyPath; dispid 1610743862; + procedure SetCachePath(const s: WideString); dispid 1610743863; + procedure SetData(const name: WideString; data: OleVariant); dispid 1610743864; + function GetData(const name: WideString): OleVariant; dispid 1610743865; + procedure SetAppDomainPolicy(const domainPolicy: _PolicyLevel); dispid 1610743866; + procedure SetThreadPrincipal(const principal: IPrincipal); dispid 1610743867; + procedure SetPrincipalPolicy(policy: PrincipalPolicy); dispid 1610743868; + procedure DoCallBack(const theDelegate: _CrossAppDomainDelegate); dispid 1610743869; + property DynamicDirectory: WideString readonly dispid 1610743870; + end; + {$EXTERNALSYM _AppDomainDisp} + +// *********************************************************************// +// Interface: IEvidenceFactory +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {35A8F3AC-FE28-360F-A0C0-9A4D50C4682A} +// *********************************************************************// + IEvidenceFactory = interface(IDispatch) + ['{35A8F3AC-FE28-360F-A0C0-9A4D50C4682A}'] + function Get_Evidence: _Evidence; safecall; + property Evidence: _Evidence read Get_Evidence; + end; + +// *********************************************************************// +// DispIntf: IEvidenceFactoryDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {35A8F3AC-FE28-360F-A0C0-9A4D50C4682A} +// *********************************************************************// + IEvidenceFactoryDisp = dispinterface + ['{35A8F3AC-FE28-360F-A0C0-9A4D50C4682A}'] + property Evidence: _Evidence readonly dispid 1610743808; + end; + {$EXTERNALSYM IEvidenceFactoryDisp} + +// *********************************************************************// +// Interface: _CrossAppDomainDelegate +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AF93163F-C2F4-3FAB-9FF1-728A7AAAD1CB} +// *********************************************************************// + _CrossAppDomainDelegate = interface(IDispatch) + ['{AF93163F-C2F4-3FAB-9FF1-728A7AAAD1CB}'] + end; + +// *********************************************************************// +// DispIntf: _CrossAppDomainDelegateDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AF93163F-C2F4-3FAB-9FF1-728A7AAAD1CB} +// *********************************************************************// + _CrossAppDomainDelegateDisp = dispinterface + ['{AF93163F-C2F4-3FAB-9FF1-728A7AAAD1CB}'] + end; + {$EXTERNALSYM _CrossAppDomainDelegateDisp} + +// *********************************************************************// +// Interface: IAppDomainSetup +// Flags: (256) OleAutomation +// GUID: {27FFF232-A7A8-40DD-8D4A-734AD59FCD41} +// *********************************************************************// + IAppDomainSetup = interface(IUnknown) + ['{27FFF232-A7A8-40DD-8D4A-734AD59FCD41}'] + function Get_ApplicationBase(out pRetVal: WideString): HResult; stdcall; + function Set_ApplicationBase(const pRetVal: WideString): HResult; stdcall; + function Get_ApplicationName(out pRetVal: WideString): HResult; stdcall; + function Set_ApplicationName(const pRetVal: WideString): HResult; stdcall; + function Get_CachePath(out pRetVal: WideString): HResult; stdcall; + function Set_CachePath(const pRetVal: WideString): HResult; stdcall; + function Get_ConfigurationFile(out pRetVal: WideString): HResult; stdcall; + function Set_ConfigurationFile(const pRetVal: WideString): HResult; stdcall; + function Get_DynamicBase(out pRetVal: WideString): HResult; stdcall; + function Set_DynamicBase(const pRetVal: WideString): HResult; stdcall; + function Get_LicenseFile(out pRetVal: WideString): HResult; stdcall; + function Set_LicenseFile(const pRetVal: WideString): HResult; stdcall; + function Get_PrivateBinPath(out pRetVal: WideString): HResult; stdcall; + function Set_PrivateBinPath(const pRetVal: WideString): HResult; stdcall; + function Get_PrivateBinPathProbe(out pRetVal: WideString): HResult; stdcall; + function Set_PrivateBinPathProbe(const pRetVal: WideString): HResult; stdcall; + function Get_ShadowCopyDirectories(out pRetVal: WideString): HResult; stdcall; + function Set_ShadowCopyDirectories(const pRetVal: WideString): HResult; stdcall; + function Get_ShadowCopyFiles(out pRetVal: WideString): HResult; stdcall; + function Set_ShadowCopyFiles(const pRetVal: WideString): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: _Attribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {917B14D0-2D9E-38B8-92A9-381ACF52F7C0} +// *********************************************************************// + _Attribute = interface(IDispatch) + ['{917B14D0-2D9E-38B8-92A9-381ACF52F7C0}'] + end; + +// *********************************************************************// +// DispIntf: _AttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {917B14D0-2D9E-38B8-92A9-381ACF52F7C0} +// *********************************************************************// + _AttributeDisp = dispinterface + ['{917B14D0-2D9E-38B8-92A9-381ACF52F7C0}'] + end; + {$EXTERNALSYM _AttributeDisp} + +// *********************************************************************// +// Interface: _LoaderOptimizationAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {CE59D7AD-05CA-33B4-A1DD-06028D46E9D2} +// *********************************************************************// + _LoaderOptimizationAttribute = interface(IDispatch) + ['{CE59D7AD-05CA-33B4-A1DD-06028D46E9D2}'] + end; + +// *********************************************************************// +// DispIntf: _LoaderOptimizationAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {CE59D7AD-05CA-33B4-A1DD-06028D46E9D2} +// *********************************************************************// + _LoaderOptimizationAttributeDisp = dispinterface + ['{CE59D7AD-05CA-33B4-A1DD-06028D46E9D2}'] + end; + {$EXTERNALSYM _LoaderOptimizationAttributeDisp} + +// *********************************************************************// +// Interface: _AppDomainUnloadedException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6E96AA70-9FFB-399D-96BF-A68436095C54} +// *********************************************************************// + _AppDomainUnloadedException = interface(IDispatch) + ['{6E96AA70-9FFB-399D-96BF-A68436095C54}'] + end; + +// *********************************************************************// +// DispIntf: _AppDomainUnloadedExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6E96AA70-9FFB-399D-96BF-A68436095C54} +// *********************************************************************// + _AppDomainUnloadedExceptionDisp = dispinterface + ['{6E96AA70-9FFB-399D-96BF-A68436095C54}'] + end; + {$EXTERNALSYM _AppDomainUnloadedExceptionDisp} + +// *********************************************************************// +// Interface: _ArgumentException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4DB2C2B7-CBC2-3185-B966-875D4625B1A8} +// *********************************************************************// + _ArgumentException = interface(IDispatch) + ['{4DB2C2B7-CBC2-3185-B966-875D4625B1A8}'] + end; + +// *********************************************************************// +// DispIntf: _ArgumentExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4DB2C2B7-CBC2-3185-B966-875D4625B1A8} +// *********************************************************************// + _ArgumentExceptionDisp = dispinterface + ['{4DB2C2B7-CBC2-3185-B966-875D4625B1A8}'] + end; + {$EXTERNALSYM _ArgumentExceptionDisp} + +// *********************************************************************// +// Interface: _ArgumentNullException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C991949B-E623-3F24-885C-BBB01FF43564} +// *********************************************************************// + _ArgumentNullException = interface(IDispatch) + ['{C991949B-E623-3F24-885C-BBB01FF43564}'] + end; + +// *********************************************************************// +// DispIntf: _ArgumentNullExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C991949B-E623-3F24-885C-BBB01FF43564} +// *********************************************************************// + _ArgumentNullExceptionDisp = dispinterface + ['{C991949B-E623-3F24-885C-BBB01FF43564}'] + end; + {$EXTERNALSYM _ArgumentNullExceptionDisp} + +// *********************************************************************// +// Interface: _ArgumentOutOfRangeException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {77DA3028-BC45-3E82-BF76-2C123EE2C021} +// *********************************************************************// + _ArgumentOutOfRangeException = interface(IDispatch) + ['{77DA3028-BC45-3E82-BF76-2C123EE2C021}'] + end; + +// *********************************************************************// +// DispIntf: _ArgumentOutOfRangeExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {77DA3028-BC45-3E82-BF76-2C123EE2C021} +// *********************************************************************// + _ArgumentOutOfRangeExceptionDisp = dispinterface + ['{77DA3028-BC45-3E82-BF76-2C123EE2C021}'] + end; + {$EXTERNALSYM _ArgumentOutOfRangeExceptionDisp} + +// *********************************************************************// +// Interface: _ArithmeticException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9B012CF1-ACF6-3389-A336-C023040C62A2} +// *********************************************************************// + _ArithmeticException = interface(IDispatch) + ['{9B012CF1-ACF6-3389-A336-C023040C62A2}'] + end; + +// *********************************************************************// +// DispIntf: _ArithmeticExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9B012CF1-ACF6-3389-A336-C023040C62A2} +// *********************************************************************// + _ArithmeticExceptionDisp = dispinterface + ['{9B012CF1-ACF6-3389-A336-C023040C62A2}'] + end; + {$EXTERNALSYM _ArithmeticExceptionDisp} + +// *********************************************************************// +// Interface: _ArrayTypeMismatchException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DD7488A6-1B3F-3823-9556-C2772B15150F} +// *********************************************************************// + _ArrayTypeMismatchException = interface(IDispatch) + ['{DD7488A6-1B3F-3823-9556-C2772B15150F}'] + end; + +// *********************************************************************// +// DispIntf: _ArrayTypeMismatchExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DD7488A6-1B3F-3823-9556-C2772B15150F} +// *********************************************************************// + _ArrayTypeMismatchExceptionDisp = dispinterface + ['{DD7488A6-1B3F-3823-9556-C2772B15150F}'] + end; + {$EXTERNALSYM _ArrayTypeMismatchExceptionDisp} + +// *********************************************************************// +// Interface: _AsyncCallback +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3612706E-0239-35FD-B900-0819D16D442D} +// *********************************************************************// + _AsyncCallback = interface(IDispatch) + ['{3612706E-0239-35FD-B900-0819D16D442D}'] + end; + +// *********************************************************************// +// DispIntf: _AsyncCallbackDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3612706E-0239-35FD-B900-0819D16D442D} +// *********************************************************************// + _AsyncCallbackDisp = dispinterface + ['{3612706E-0239-35FD-B900-0819D16D442D}'] + end; + {$EXTERNALSYM _AsyncCallbackDisp} + +// *********************************************************************// +// Interface: _AttributeUsageAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A902A192-49BA-3EC8-B444-AF5F7743F61A} +// *********************************************************************// + _AttributeUsageAttribute = interface(IDispatch) + ['{A902A192-49BA-3EC8-B444-AF5F7743F61A}'] + end; + +// *********************************************************************// +// DispIntf: _AttributeUsageAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A902A192-49BA-3EC8-B444-AF5F7743F61A} +// *********************************************************************// + _AttributeUsageAttributeDisp = dispinterface + ['{A902A192-49BA-3EC8-B444-AF5F7743F61A}'] + end; + {$EXTERNALSYM _AttributeUsageAttributeDisp} + +// *********************************************************************// +// Interface: _BadImageFormatException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F98BCE04-4A4B-398C-A512-FD8348D51E3B} +// *********************************************************************// + _BadImageFormatException = interface(IDispatch) + ['{F98BCE04-4A4B-398C-A512-FD8348D51E3B}'] + end; + +// *********************************************************************// +// DispIntf: _BadImageFormatExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F98BCE04-4A4B-398C-A512-FD8348D51E3B} +// *********************************************************************// + _BadImageFormatExceptionDisp = dispinterface + ['{F98BCE04-4A4B-398C-A512-FD8348D51E3B}'] + end; + {$EXTERNALSYM _BadImageFormatExceptionDisp} + +// *********************************************************************// +// Interface: _BitConverter +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {5CD861E8-CA91-301B-9E24-141E3D85BD5D} +// *********************************************************************// + _BitConverter = interface(IDispatch) + ['{5CD861E8-CA91-301B-9E24-141E3D85BD5D}'] + end; + +// *********************************************************************// +// DispIntf: _BitConverterDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {5CD861E8-CA91-301B-9E24-141E3D85BD5D} +// *********************************************************************// + _BitConverterDisp = dispinterface + ['{5CD861E8-CA91-301B-9E24-141E3D85BD5D}'] + end; + {$EXTERNALSYM _BitConverterDisp} + +// *********************************************************************// +// Interface: _Buffer +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F036BCA4-F8DF-3682-8290-75285CE7456C} +// *********************************************************************// + _Buffer = interface(IDispatch) + ['{F036BCA4-F8DF-3682-8290-75285CE7456C}'] + end; + +// *********************************************************************// +// DispIntf: _BufferDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F036BCA4-F8DF-3682-8290-75285CE7456C} +// *********************************************************************// + _BufferDisp = dispinterface + ['{F036BCA4-F8DF-3682-8290-75285CE7456C}'] + end; + {$EXTERNALSYM _BufferDisp} + +// *********************************************************************// +// Interface: _CannotUnloadAppDomainException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6D4B6ADB-B9FA-3809-B5EA-FA57B56C546F} +// *********************************************************************// + _CannotUnloadAppDomainException = interface(IDispatch) + ['{6D4B6ADB-B9FA-3809-B5EA-FA57B56C546F}'] + end; + +// *********************************************************************// +// DispIntf: _CannotUnloadAppDomainExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6D4B6ADB-B9FA-3809-B5EA-FA57B56C546F} +// *********************************************************************// + _CannotUnloadAppDomainExceptionDisp = dispinterface + ['{6D4B6ADB-B9FA-3809-B5EA-FA57B56C546F}'] + end; + {$EXTERNALSYM _CannotUnloadAppDomainExceptionDisp} + +// *********************************************************************// +// Interface: _CharEnumerator +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1DD627FC-89E3-384F-BB9D-58CB4EFB9456} +// *********************************************************************// + _CharEnumerator = interface(IDispatch) + ['{1DD627FC-89E3-384F-BB9D-58CB4EFB9456}'] + end; + +// *********************************************************************// +// DispIntf: _CharEnumeratorDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1DD627FC-89E3-384F-BB9D-58CB4EFB9456} +// *********************************************************************// + _CharEnumeratorDisp = dispinterface + ['{1DD627FC-89E3-384F-BB9D-58CB4EFB9456}'] + end; + {$EXTERNALSYM _CharEnumeratorDisp} + +// *********************************************************************// +// Interface: _CLSCompliantAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BF1AF177-94CA-3E6D-9D91-55CF9E859D22} +// *********************************************************************// + _CLSCompliantAttribute = interface(IDispatch) + ['{BF1AF177-94CA-3E6D-9D91-55CF9E859D22}'] + end; + +// *********************************************************************// +// DispIntf: _CLSCompliantAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BF1AF177-94CA-3E6D-9D91-55CF9E859D22} +// *********************************************************************// + _CLSCompliantAttributeDisp = dispinterface + ['{BF1AF177-94CA-3E6D-9D91-55CF9E859D22}'] + end; + {$EXTERNALSYM _CLSCompliantAttributeDisp} + +// *********************************************************************// +// Interface: _TypeUnloadedException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C2A10F3A-356A-3C77-AAB9-8991D73A2561} +// *********************************************************************// + _TypeUnloadedException = interface(IDispatch) + ['{C2A10F3A-356A-3C77-AAB9-8991D73A2561}'] + end; + +// *********************************************************************// +// DispIntf: _TypeUnloadedExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C2A10F3A-356A-3C77-AAB9-8991D73A2561} +// *********************************************************************// + _TypeUnloadedExceptionDisp = dispinterface + ['{C2A10F3A-356A-3C77-AAB9-8991D73A2561}'] + end; + {$EXTERNALSYM _TypeUnloadedExceptionDisp} + +// *********************************************************************// +// Interface: _Console +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {88592805-9549-3E00-8308-03CFA6B93882} +// *********************************************************************// + _Console = interface(IDispatch) + ['{88592805-9549-3E00-8308-03CFA6B93882}'] + end; + +// *********************************************************************// +// DispIntf: _ConsoleDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {88592805-9549-3E00-8308-03CFA6B93882} +// *********************************************************************// + _ConsoleDisp = dispinterface + ['{88592805-9549-3E00-8308-03CFA6B93882}'] + end; + {$EXTERNALSYM _ConsoleDisp} + +// *********************************************************************// +// Interface: _ContextMarshalException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7386F4D7-7C11-389F-BB75-895714B12BB5} +// *********************************************************************// + _ContextMarshalException = interface(IDispatch) + ['{7386F4D7-7C11-389F-BB75-895714B12BB5}'] + end; + +// *********************************************************************// +// DispIntf: _ContextMarshalExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7386F4D7-7C11-389F-BB75-895714B12BB5} +// *********************************************************************// + _ContextMarshalExceptionDisp = dispinterface + ['{7386F4D7-7C11-389F-BB75-895714B12BB5}'] + end; + {$EXTERNALSYM _ContextMarshalExceptionDisp} + +// *********************************************************************// +// Interface: _Convert +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9E1348D4-3FAC-3704-840D-20D91E4AD542} +// *********************************************************************// + _Convert = interface(IDispatch) + ['{9E1348D4-3FAC-3704-840D-20D91E4AD542}'] + end; + +// *********************************************************************// +// DispIntf: _ConvertDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9E1348D4-3FAC-3704-840D-20D91E4AD542} +// *********************************************************************// + _ConvertDisp = dispinterface + ['{9E1348D4-3FAC-3704-840D-20D91E4AD542}'] + end; + {$EXTERNALSYM _ConvertDisp} + +// *********************************************************************// +// Interface: _ContextBoundObject +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3EB1D909-E8BF-3C6B-ADA5-0E86E31E186E} +// *********************************************************************// + _ContextBoundObject = interface(IDispatch) + ['{3EB1D909-E8BF-3C6B-ADA5-0E86E31E186E}'] + end; + +// *********************************************************************// +// DispIntf: _ContextBoundObjectDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3EB1D909-E8BF-3C6B-ADA5-0E86E31E186E} +// *********************************************************************// + _ContextBoundObjectDisp = dispinterface + ['{3EB1D909-E8BF-3C6B-ADA5-0E86E31E186E}'] + end; + {$EXTERNALSYM _ContextBoundObjectDisp} + +// *********************************************************************// +// Interface: _ContextStaticAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {160D517F-F175-3B61-8264-6D2305B8246C} +// *********************************************************************// + _ContextStaticAttribute = interface(IDispatch) + ['{160D517F-F175-3B61-8264-6D2305B8246C}'] + end; + +// *********************************************************************// +// DispIntf: _ContextStaticAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {160D517F-F175-3B61-8264-6D2305B8246C} +// *********************************************************************// + _ContextStaticAttributeDisp = dispinterface + ['{160D517F-F175-3B61-8264-6D2305B8246C}'] + end; + {$EXTERNALSYM _ContextStaticAttributeDisp} + +// *********************************************************************// +// Interface: _TimeZone +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3025F666-7891-33D7-AACD-23D169EF354E} +// *********************************************************************// + _TimeZone = interface(IDispatch) + ['{3025F666-7891-33D7-AACD-23D169EF354E}'] + end; + +// *********************************************************************// +// DispIntf: _TimeZoneDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3025F666-7891-33D7-AACD-23D169EF354E} +// *********************************************************************// + _TimeZoneDisp = dispinterface + ['{3025F666-7891-33D7-AACD-23D169EF354E}'] + end; + {$EXTERNALSYM _TimeZoneDisp} + +// *********************************************************************// +// Interface: _DBNull +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0D9F1B65-6D27-3E9F-BAF3-0597837E0F33} +// *********************************************************************// + _DBNull = interface(IDispatch) + ['{0D9F1B65-6D27-3E9F-BAF3-0597837E0F33}'] + end; + +// *********************************************************************// +// DispIntf: _DBNullDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0D9F1B65-6D27-3E9F-BAF3-0597837E0F33} +// *********************************************************************// + _DBNullDisp = dispinterface + ['{0D9F1B65-6D27-3E9F-BAF3-0597837E0F33}'] + end; + {$EXTERNALSYM _DBNullDisp} + +// *********************************************************************// +// Interface: _Binder +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {3169AB11-7109-3808-9A61-EF4BA0534FD9} +// *********************************************************************// + _Binder = interface(IDispatch) + ['{3169AB11-7109-3808-9A61-EF4BA0534FD9}'] + function Get_ToString: WideString; safecall; + function Equals(obj: OleVariant): WordBool; safecall; + function GetHashCode: Integer; safecall; + function GetType: _Type; safecall; + function BindToMethod(bindingAttr: BindingFlags; match: PSafeArray; var args: PSafeArray; + modifiers: PSafeArray; const culture: _CultureInfo; names: PSafeArray; + out state: OleVariant): _MethodBase; safecall; + function BindToField(bindingAttr: BindingFlags; match: PSafeArray; value: OleVariant; + const culture: _CultureInfo): _FieldInfo; safecall; + function SelectMethod(bindingAttr: BindingFlags; match: PSafeArray; types: PSafeArray; + modifiers: PSafeArray): _MethodBase; safecall; + function SelectProperty(bindingAttr: BindingFlags; match: PSafeArray; const returnType: _Type; + indexes: PSafeArray; modifiers: PSafeArray): _PropertyInfo; safecall; + function ChangeType(value: OleVariant; const Type_: _Type; const culture: _CultureInfo): OleVariant; safecall; + procedure ReorderArgumentArray(var args: PSafeArray; state: OleVariant); safecall; + property ToString: WideString read Get_ToString; + end; + +// *********************************************************************// +// DispIntf: _BinderDisp +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {3169AB11-7109-3808-9A61-EF4BA0534FD9} +// *********************************************************************// + _BinderDisp = dispinterface + ['{3169AB11-7109-3808-9A61-EF4BA0534FD9}'] + property ToString: WideString readonly dispid 0; + function Equals(obj: OleVariant): WordBool; dispid 1610743809; + function GetHashCode: Integer; dispid 1610743810; + function GetType: _Type; dispid 1610743811; + function BindToMethod(bindingAttr: BindingFlags; match: {??PSafeArray}OleVariant; + var args: {??PSafeArray}OleVariant; modifiers: {??PSafeArray}OleVariant; + const culture: _CultureInfo; names: {??PSafeArray}OleVariant; + out state: OleVariant): _MethodBase; dispid 1610743812; + function BindToField(bindingAttr: BindingFlags; match: {??PSafeArray}OleVariant; + value: OleVariant; const culture: _CultureInfo): _FieldInfo; dispid 1610743813; + function SelectMethod(bindingAttr: BindingFlags; match: {??PSafeArray}OleVariant; + types: {??PSafeArray}OleVariant; modifiers: {??PSafeArray}OleVariant): _MethodBase; dispid 1610743814; + function SelectProperty(bindingAttr: BindingFlags; match: {??PSafeArray}OleVariant; + const returnType: _Type; indexes: {??PSafeArray}OleVariant; + modifiers: {??PSafeArray}OleVariant): _PropertyInfo; dispid 1610743815; + function ChangeType(value: OleVariant; const Type_: _Type; const culture: _CultureInfo): OleVariant; dispid 1610743816; + procedure ReorderArgumentArray(var args: {??PSafeArray}OleVariant; state: OleVariant); dispid 1610743817; + end; + {$EXTERNALSYM _BinderDisp} + +// *********************************************************************// +// Interface: IObjectReference +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {6E70ED5F-0439-38CE-83BB-860F1421F29F} +// *********************************************************************// + IObjectReference = interface(IDispatch) + ['{6E70ED5F-0439-38CE-83BB-860F1421F29F}'] + function GetRealObject(Context: StreamingContext): OleVariant; safecall; + end; + +// *********************************************************************// +// DispIntf: IObjectReferenceDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {6E70ED5F-0439-38CE-83BB-860F1421F29F} +// *********************************************************************// + IObjectReferenceDisp = dispinterface + ['{6E70ED5F-0439-38CE-83BB-860F1421F29F}'] + function GetRealObject(Context: {??StreamingContext}OleVariant): OleVariant; dispid 1610743808; + end; + {$EXTERNALSYM IObjectReferenceDisp} + +// *********************************************************************// +// Interface: _DivideByZeroException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BDEEA460-8241-3B41-9ED3-6E3E9977AC7F} +// *********************************************************************// + _DivideByZeroException = interface(IDispatch) + ['{BDEEA460-8241-3B41-9ED3-6E3E9977AC7F}'] + end; + +// *********************************************************************// +// DispIntf: _DivideByZeroExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BDEEA460-8241-3B41-9ED3-6E3E9977AC7F} +// *********************************************************************// + _DivideByZeroExceptionDisp = dispinterface + ['{BDEEA460-8241-3B41-9ED3-6E3E9977AC7F}'] + end; + {$EXTERNALSYM _DivideByZeroExceptionDisp} + +// *********************************************************************// +// Interface: _DuplicateWaitObjectException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D345A42B-CFE0-3EEE-861C-F3322812B388} +// *********************************************************************// + _DuplicateWaitObjectException = interface(IDispatch) + ['{D345A42B-CFE0-3EEE-861C-F3322812B388}'] + end; + +// *********************************************************************// +// DispIntf: _DuplicateWaitObjectExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D345A42B-CFE0-3EEE-861C-F3322812B388} +// *********************************************************************// + _DuplicateWaitObjectExceptionDisp = dispinterface + ['{D345A42B-CFE0-3EEE-861C-F3322812B388}'] + end; + {$EXTERNALSYM _DuplicateWaitObjectExceptionDisp} + +// *********************************************************************// +// Interface: _TypeLoadException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {82D6B3BF-A633-3B3B-A09E-2363E4B24A41} +// *********************************************************************// + _TypeLoadException = interface(IDispatch) + ['{82D6B3BF-A633-3B3B-A09E-2363E4B24A41}'] + end; + +// *********************************************************************// +// DispIntf: _TypeLoadExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {82D6B3BF-A633-3B3B-A09E-2363E4B24A41} +// *********************************************************************// + _TypeLoadExceptionDisp = dispinterface + ['{82D6B3BF-A633-3B3B-A09E-2363E4B24A41}'] + end; + {$EXTERNALSYM _TypeLoadExceptionDisp} + +// *********************************************************************// +// Interface: _EntryPointNotFoundException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {67388F3F-B600-3BCF-84AA-BB2B88DD9EE2} +// *********************************************************************// + _EntryPointNotFoundException = interface(IDispatch) + ['{67388F3F-B600-3BCF-84AA-BB2B88DD9EE2}'] + end; + +// *********************************************************************// +// DispIntf: _EntryPointNotFoundExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {67388F3F-B600-3BCF-84AA-BB2B88DD9EE2} +// *********************************************************************// + _EntryPointNotFoundExceptionDisp = dispinterface + ['{67388F3F-B600-3BCF-84AA-BB2B88DD9EE2}'] + end; + {$EXTERNALSYM _EntryPointNotFoundExceptionDisp} + +// *********************************************************************// +// Interface: _DllNotFoundException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {24AE6464-2834-32CD-83D6-FA06953DE62A} +// *********************************************************************// + _DllNotFoundException = interface(IDispatch) + ['{24AE6464-2834-32CD-83D6-FA06953DE62A}'] + end; + +// *********************************************************************// +// DispIntf: _DllNotFoundExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {24AE6464-2834-32CD-83D6-FA06953DE62A} +// *********************************************************************// + _DllNotFoundExceptionDisp = dispinterface + ['{24AE6464-2834-32CD-83D6-FA06953DE62A}'] + end; + {$EXTERNALSYM _DllNotFoundExceptionDisp} + +// *********************************************************************// +// Interface: _Environment +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {29DC56CF-B981-3432-97C8-3680AB6D862D} +// *********************************************************************// + _Environment = interface(IDispatch) + ['{29DC56CF-B981-3432-97C8-3680AB6D862D}'] + end; + +// *********************************************************************// +// DispIntf: _EnvironmentDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {29DC56CF-B981-3432-97C8-3680AB6D862D} +// *********************************************************************// + _EnvironmentDisp = dispinterface + ['{29DC56CF-B981-3432-97C8-3680AB6D862D}'] + end; + {$EXTERNALSYM _EnvironmentDisp} + +// *********************************************************************// +// Interface: _EventHandler +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7CEFC46E-16E0-3E65-9C38-55B4342BA7F0} +// *********************************************************************// + _EventHandler = interface(IDispatch) + ['{7CEFC46E-16E0-3E65-9C38-55B4342BA7F0}'] + end; + +// *********************************************************************// +// DispIntf: _EventHandlerDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7CEFC46E-16E0-3E65-9C38-55B4342BA7F0} +// *********************************************************************// + _EventHandlerDisp = dispinterface + ['{7CEFC46E-16E0-3E65-9C38-55B4342BA7F0}'] + end; + {$EXTERNALSYM _EventHandlerDisp} + +// *********************************************************************// +// Interface: _FieldAccessException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8D5F5811-FFA1-3306-93E3-8AFC572B9B82} +// *********************************************************************// + _FieldAccessException = interface(IDispatch) + ['{8D5F5811-FFA1-3306-93E3-8AFC572B9B82}'] + end; + +// *********************************************************************// +// DispIntf: _FieldAccessExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8D5F5811-FFA1-3306-93E3-8AFC572B9B82} +// *********************************************************************// + _FieldAccessExceptionDisp = dispinterface + ['{8D5F5811-FFA1-3306-93E3-8AFC572B9B82}'] + end; + {$EXTERNALSYM _FieldAccessExceptionDisp} + +// *********************************************************************// +// Interface: _FlagsAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {EBE3746D-DDEC-3D23-8E8D-9361BA87BAC6} +// *********************************************************************// + _FlagsAttribute = interface(IDispatch) + ['{EBE3746D-DDEC-3D23-8E8D-9361BA87BAC6}'] + end; + +// *********************************************************************// +// DispIntf: _FlagsAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {EBE3746D-DDEC-3D23-8E8D-9361BA87BAC6} +// *********************************************************************// + _FlagsAttributeDisp = dispinterface + ['{EBE3746D-DDEC-3D23-8E8D-9361BA87BAC6}'] + end; + {$EXTERNALSYM _FlagsAttributeDisp} + +// *********************************************************************// +// Interface: _FormatException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {07F92156-398A-3548-90B7-2E58026353D0} +// *********************************************************************// + _FormatException = interface(IDispatch) + ['{07F92156-398A-3548-90B7-2E58026353D0}'] + end; + +// *********************************************************************// +// DispIntf: _FormatExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {07F92156-398A-3548-90B7-2E58026353D0} +// *********************************************************************// + _FormatExceptionDisp = dispinterface + ['{07F92156-398A-3548-90B7-2E58026353D0}'] + end; + {$EXTERNALSYM _FormatExceptionDisp} + +// *********************************************************************// +// Interface: _GC +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {679ED106-5DC1-38FE-8B5C-2ADCA3552298} +// *********************************************************************// + _GC = interface(IDispatch) + ['{679ED106-5DC1-38FE-8B5C-2ADCA3552298}'] + end; + +// *********************************************************************// +// DispIntf: _GCDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {679ED106-5DC1-38FE-8B5C-2ADCA3552298} +// *********************************************************************// + _GCDisp = dispinterface + ['{679ED106-5DC1-38FE-8B5C-2ADCA3552298}'] + end; + {$EXTERNALSYM _GCDisp} + +// *********************************************************************// +// Interface: IAsyncResult +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {11AB34E7-0176-3C9E-9EFE-197858400A3D} +// *********************************************************************// + IAsyncResult = interface(IDispatch) + ['{11AB34E7-0176-3C9E-9EFE-197858400A3D}'] + function Get_IsCompleted: WordBool; safecall; + function Get_AsyncWaitHandle: _WaitHandle; safecall; + function Get_AsyncState: OleVariant; safecall; + function Get_CompletedSynchronously: WordBool; safecall; + property IsCompleted: WordBool read Get_IsCompleted; + property AsyncWaitHandle: _WaitHandle read Get_AsyncWaitHandle; + property AsyncState: OleVariant read Get_AsyncState; + property CompletedSynchronously: WordBool read Get_CompletedSynchronously; + end; + +// *********************************************************************// +// DispIntf: IAsyncResultDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {11AB34E7-0176-3C9E-9EFE-197858400A3D} +// *********************************************************************// + IAsyncResultDisp = dispinterface + ['{11AB34E7-0176-3C9E-9EFE-197858400A3D}'] + property IsCompleted: WordBool readonly dispid 1610743808; + property AsyncWaitHandle: _WaitHandle readonly dispid 1610743809; + property AsyncState: OleVariant readonly dispid 1610743810; + property CompletedSynchronously: WordBool readonly dispid 1610743811; + end; + {$EXTERNALSYM IAsyncResultDisp} + +// *********************************************************************// +// Interface: ICustomFormatter +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {2B130940-CA5E-3406-8385-E259E68AB039} +// *********************************************************************// + ICustomFormatter = interface(IDispatch) + ['{2B130940-CA5E-3406-8385-E259E68AB039}'] + function format(const format: WideString; arg: OleVariant; const formatProvider: IFormatProvider): WideString; safecall; + end; + +// *********************************************************************// +// DispIntf: ICustomFormatterDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {2B130940-CA5E-3406-8385-E259E68AB039} +// *********************************************************************// + ICustomFormatterDisp = dispinterface + ['{2B130940-CA5E-3406-8385-E259E68AB039}'] + function format(const format: WideString; arg: OleVariant; const formatProvider: IFormatProvider): WideString; dispid 1610743808; + end; + {$EXTERNALSYM ICustomFormatterDisp} + +// *********************************************************************// +// Interface: IDisposable +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {805D7A98-D4AF-3F0F-967F-E5CF45312D2C} +// *********************************************************************// + IDisposable = interface(IDispatch) + ['{805D7A98-D4AF-3F0F-967F-E5CF45312D2C}'] + procedure Dispose; safecall; + end; + +// *********************************************************************// +// DispIntf: IDisposableDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {805D7A98-D4AF-3F0F-967F-E5CF45312D2C} +// *********************************************************************// + IDisposableDisp = dispinterface + ['{805D7A98-D4AF-3F0F-967F-E5CF45312D2C}'] + procedure Dispose; dispid 1610743808; + end; + {$EXTERNALSYM IDisposableDisp} + +// *********************************************************************// +// Interface: IFormatProvider +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {C8CB1DED-2814-396A-9CC0-473CA49779CC} +// *********************************************************************// + IFormatProvider = interface(IDispatch) + ['{C8CB1DED-2814-396A-9CC0-473CA49779CC}'] + function GetFormat(const formatType: _Type): OleVariant; safecall; + end; + +// *********************************************************************// +// DispIntf: IFormatProviderDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {C8CB1DED-2814-396A-9CC0-473CA49779CC} +// *********************************************************************// + IFormatProviderDisp = dispinterface + ['{C8CB1DED-2814-396A-9CC0-473CA49779CC}'] + function GetFormat(const formatType: _Type): OleVariant; dispid 1610743808; + end; + {$EXTERNALSYM IFormatProviderDisp} + +// *********************************************************************// +// Interface: _IndexOutOfRangeException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E5A5F1E4-82C1-391F-A1C6-F39EAE9DC72F} +// *********************************************************************// + _IndexOutOfRangeException = interface(IDispatch) + ['{E5A5F1E4-82C1-391F-A1C6-F39EAE9DC72F}'] + end; + +// *********************************************************************// +// DispIntf: _IndexOutOfRangeExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E5A5F1E4-82C1-391F-A1C6-F39EAE9DC72F} +// *********************************************************************// + _IndexOutOfRangeExceptionDisp = dispinterface + ['{E5A5F1E4-82C1-391F-A1C6-F39EAE9DC72F}'] + end; + {$EXTERNALSYM _IndexOutOfRangeExceptionDisp} + +// *********************************************************************// +// Interface: _InvalidCastException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FA047CBD-9BA5-3A13-9B1F-6694D622CD76} +// *********************************************************************// + _InvalidCastException = interface(IDispatch) + ['{FA047CBD-9BA5-3A13-9B1F-6694D622CD76}'] + end; + +// *********************************************************************// +// DispIntf: _InvalidCastExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FA047CBD-9BA5-3A13-9B1F-6694D622CD76} +// *********************************************************************// + _InvalidCastExceptionDisp = dispinterface + ['{FA047CBD-9BA5-3A13-9B1F-6694D622CD76}'] + end; + {$EXTERNALSYM _InvalidCastExceptionDisp} + +// *********************************************************************// +// Interface: _InvalidOperationException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8D520D10-0B8A-3553-8874-D30A4AD2FF4C} +// *********************************************************************// + _InvalidOperationException = interface(IDispatch) + ['{8D520D10-0B8A-3553-8874-D30A4AD2FF4C}'] + end; + +// *********************************************************************// +// DispIntf: _InvalidOperationExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8D520D10-0B8A-3553-8874-D30A4AD2FF4C} +// *********************************************************************// + _InvalidOperationExceptionDisp = dispinterface + ['{8D520D10-0B8A-3553-8874-D30A4AD2FF4C}'] + end; + {$EXTERNALSYM _InvalidOperationExceptionDisp} + +// *********************************************************************// +// Interface: _InvalidProgramException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3410E0FB-636F-3CD1-8045-3993CA113F25} +// *********************************************************************// + _InvalidProgramException = interface(IDispatch) + ['{3410E0FB-636F-3CD1-8045-3993CA113F25}'] + end; + +// *********************************************************************// +// DispIntf: _InvalidProgramExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3410E0FB-636F-3CD1-8045-3993CA113F25} +// *********************************************************************// + _InvalidProgramExceptionDisp = dispinterface + ['{3410E0FB-636F-3CD1-8045-3993CA113F25}'] + end; + {$EXTERNALSYM _InvalidProgramExceptionDisp} + +// *********************************************************************// +// Interface: _LocalDataStoreSlot +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DC77F976-318D-3A1A-9B60-ABB9DD9406D6} +// *********************************************************************// + _LocalDataStoreSlot = interface(IDispatch) + ['{DC77F976-318D-3A1A-9B60-ABB9DD9406D6}'] + end; + +// *********************************************************************// +// DispIntf: _LocalDataStoreSlotDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DC77F976-318D-3A1A-9B60-ABB9DD9406D6} +// *********************************************************************// + _LocalDataStoreSlotDisp = dispinterface + ['{DC77F976-318D-3A1A-9B60-ABB9DD9406D6}'] + end; + {$EXTERNALSYM _LocalDataStoreSlotDisp} + +// *********************************************************************// +// Interface: _Math +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A19F91C8-7D23-3DFB-A988-CEE05B039121} +// *********************************************************************// + _Math = interface(IDispatch) + ['{A19F91C8-7D23-3DFB-A988-CEE05B039121}'] + end; + +// *********************************************************************// +// DispIntf: _MathDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A19F91C8-7D23-3DFB-A988-CEE05B039121} +// *********************************************************************// + _MathDisp = dispinterface + ['{A19F91C8-7D23-3DFB-A988-CEE05B039121}'] + end; + {$EXTERNALSYM _MathDisp} + +// *********************************************************************// +// Interface: _MethodAccessException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FF0BF77D-8F81-3D31-A3BB-6F54440FA7E5} +// *********************************************************************// + _MethodAccessException = interface(IDispatch) + ['{FF0BF77D-8F81-3D31-A3BB-6F54440FA7E5}'] + end; + +// *********************************************************************// +// DispIntf: _MethodAccessExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FF0BF77D-8F81-3D31-A3BB-6F54440FA7E5} +// *********************************************************************// + _MethodAccessExceptionDisp = dispinterface + ['{FF0BF77D-8F81-3D31-A3BB-6F54440FA7E5}'] + end; + {$EXTERNALSYM _MethodAccessExceptionDisp} + +// *********************************************************************// +// Interface: _MissingMemberException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8897D14B-7FB3-3D8B-9EE4-221C3DBAD6FE} +// *********************************************************************// + _MissingMemberException = interface(IDispatch) + ['{8897D14B-7FB3-3D8B-9EE4-221C3DBAD6FE}'] + end; + +// *********************************************************************// +// DispIntf: _MissingMemberExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8897D14B-7FB3-3D8B-9EE4-221C3DBAD6FE} +// *********************************************************************// + _MissingMemberExceptionDisp = dispinterface + ['{8897D14B-7FB3-3D8B-9EE4-221C3DBAD6FE}'] + end; + {$EXTERNALSYM _MissingMemberExceptionDisp} + +// *********************************************************************// +// Interface: _MissingFieldException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9717176D-1179-3487-8849-CF5F63DE356E} +// *********************************************************************// + _MissingFieldException = interface(IDispatch) + ['{9717176D-1179-3487-8849-CF5F63DE356E}'] + end; + +// *********************************************************************// +// DispIntf: _MissingFieldExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9717176D-1179-3487-8849-CF5F63DE356E} +// *********************************************************************// + _MissingFieldExceptionDisp = dispinterface + ['{9717176D-1179-3487-8849-CF5F63DE356E}'] + end; + {$EXTERNALSYM _MissingFieldExceptionDisp} + +// *********************************************************************// +// Interface: _MissingMethodException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E5C659F6-92C8-3887-A07E-74D0D9C6267A} +// *********************************************************************// + _MissingMethodException = interface(IDispatch) + ['{E5C659F6-92C8-3887-A07E-74D0D9C6267A}'] + end; + +// *********************************************************************// +// DispIntf: _MissingMethodExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E5C659F6-92C8-3887-A07E-74D0D9C6267A} +// *********************************************************************// + _MissingMethodExceptionDisp = dispinterface + ['{E5C659F6-92C8-3887-A07E-74D0D9C6267A}'] + end; + {$EXTERNALSYM _MissingMethodExceptionDisp} + +// *********************************************************************// +// Interface: _MulticastNotSupportedException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D2BA71CC-1B3D-3966-A0D7-C61E957AD325} +// *********************************************************************// + _MulticastNotSupportedException = interface(IDispatch) + ['{D2BA71CC-1B3D-3966-A0D7-C61E957AD325}'] + end; + +// *********************************************************************// +// DispIntf: _MulticastNotSupportedExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D2BA71CC-1B3D-3966-A0D7-C61E957AD325} +// *********************************************************************// + _MulticastNotSupportedExceptionDisp = dispinterface + ['{D2BA71CC-1B3D-3966-A0D7-C61E957AD325}'] + end; + {$EXTERNALSYM _MulticastNotSupportedExceptionDisp} + +// *********************************************************************// +// Interface: _NonSerializedAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {665C9669-B9C6-3ADD-9213-099F0127C893} +// *********************************************************************// + _NonSerializedAttribute = interface(IDispatch) + ['{665C9669-B9C6-3ADD-9213-099F0127C893}'] + end; + +// *********************************************************************// +// DispIntf: _NonSerializedAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {665C9669-B9C6-3ADD-9213-099F0127C893} +// *********************************************************************// + _NonSerializedAttributeDisp = dispinterface + ['{665C9669-B9C6-3ADD-9213-099F0127C893}'] + end; + {$EXTERNALSYM _NonSerializedAttributeDisp} + +// *********************************************************************// +// Interface: _NotFiniteNumberException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8E21CE22-4F17-347B-B3B5-6A6DF3E0E58A} +// *********************************************************************// + _NotFiniteNumberException = interface(IDispatch) + ['{8E21CE22-4F17-347B-B3B5-6A6DF3E0E58A}'] + end; + +// *********************************************************************// +// DispIntf: _NotFiniteNumberExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8E21CE22-4F17-347B-B3B5-6A6DF3E0E58A} +// *********************************************************************// + _NotFiniteNumberExceptionDisp = dispinterface + ['{8E21CE22-4F17-347B-B3B5-6A6DF3E0E58A}'] + end; + {$EXTERNALSYM _NotFiniteNumberExceptionDisp} + +// *********************************************************************// +// Interface: _NotImplementedException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1E4D31A2-63EA-397A-A77E-B20AD87A9614} +// *********************************************************************// + _NotImplementedException = interface(IDispatch) + ['{1E4D31A2-63EA-397A-A77E-B20AD87A9614}'] + end; + +// *********************************************************************// +// DispIntf: _NotImplementedExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1E4D31A2-63EA-397A-A77E-B20AD87A9614} +// *********************************************************************// + _NotImplementedExceptionDisp = dispinterface + ['{1E4D31A2-63EA-397A-A77E-B20AD87A9614}'] + end; + {$EXTERNALSYM _NotImplementedExceptionDisp} + +// *********************************************************************// +// Interface: _NotSupportedException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {40E5451F-B237-33F8-945B-0230DB700BBB} +// *********************************************************************// + _NotSupportedException = interface(IDispatch) + ['{40E5451F-B237-33F8-945B-0230DB700BBB}'] + end; + +// *********************************************************************// +// DispIntf: _NotSupportedExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {40E5451F-B237-33F8-945B-0230DB700BBB} +// *********************************************************************// + _NotSupportedExceptionDisp = dispinterface + ['{40E5451F-B237-33F8-945B-0230DB700BBB}'] + end; + {$EXTERNALSYM _NotSupportedExceptionDisp} + +// *********************************************************************// +// Interface: _NullReferenceException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {ECBE2313-CF41-34B4-9FD0-B6CD602B023F} +// *********************************************************************// + _NullReferenceException = interface(IDispatch) + ['{ECBE2313-CF41-34B4-9FD0-B6CD602B023F}'] + end; + +// *********************************************************************// +// DispIntf: _NullReferenceExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {ECBE2313-CF41-34B4-9FD0-B6CD602B023F} +// *********************************************************************// + _NullReferenceExceptionDisp = dispinterface + ['{ECBE2313-CF41-34B4-9FD0-B6CD602B023F}'] + end; + {$EXTERNALSYM _NullReferenceExceptionDisp} + +// *********************************************************************// +// Interface: _ObjectDisposedException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {17B730BA-45EF-3DDF-9F8D-A490BAC731F4} +// *********************************************************************// + _ObjectDisposedException = interface(IDispatch) + ['{17B730BA-45EF-3DDF-9F8D-A490BAC731F4}'] + end; + +// *********************************************************************// +// DispIntf: _ObjectDisposedExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {17B730BA-45EF-3DDF-9F8D-A490BAC731F4} +// *********************************************************************// + _ObjectDisposedExceptionDisp = dispinterface + ['{17B730BA-45EF-3DDF-9F8D-A490BAC731F4}'] + end; + {$EXTERNALSYM _ObjectDisposedExceptionDisp} + +// *********************************************************************// +// Interface: _ObsoleteAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E84307BE-3036-307A-ACC2-5D5DE8A006A8} +// *********************************************************************// + _ObsoleteAttribute = interface(IDispatch) + ['{E84307BE-3036-307A-ACC2-5D5DE8A006A8}'] + end; + +// *********************************************************************// +// DispIntf: _ObsoleteAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E84307BE-3036-307A-ACC2-5D5DE8A006A8} +// *********************************************************************// + _ObsoleteAttributeDisp = dispinterface + ['{E84307BE-3036-307A-ACC2-5D5DE8A006A8}'] + end; + {$EXTERNALSYM _ObsoleteAttributeDisp} + +// *********************************************************************// +// Interface: _OperatingSystem +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9E230640-A5D0-30E1-B217-9D2B6CC0FC40} +// *********************************************************************// + _OperatingSystem = interface(IDispatch) + ['{9E230640-A5D0-30E1-B217-9D2B6CC0FC40}'] + end; + +// *********************************************************************// +// DispIntf: _OperatingSystemDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9E230640-A5D0-30E1-B217-9D2B6CC0FC40} +// *********************************************************************// + _OperatingSystemDisp = dispinterface + ['{9E230640-A5D0-30E1-B217-9D2B6CC0FC40}'] + end; + {$EXTERNALSYM _OperatingSystemDisp} + +// *********************************************************************// +// Interface: _OverflowException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {37C69A5D-7619-3A0F-A96B-9C9578AE00EF} +// *********************************************************************// + _OverflowException = interface(IDispatch) + ['{37C69A5D-7619-3A0F-A96B-9C9578AE00EF}'] + end; + +// *********************************************************************// +// DispIntf: _OverflowExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {37C69A5D-7619-3A0F-A96B-9C9578AE00EF} +// *********************************************************************// + _OverflowExceptionDisp = dispinterface + ['{37C69A5D-7619-3A0F-A96B-9C9578AE00EF}'] + end; + {$EXTERNALSYM _OverflowExceptionDisp} + +// *********************************************************************// +// Interface: _ParamArrayAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D54500AE-8CF4-3092-9054-90DC91AC65C9} +// *********************************************************************// + _ParamArrayAttribute = interface(IDispatch) + ['{D54500AE-8CF4-3092-9054-90DC91AC65C9}'] + end; + +// *********************************************************************// +// DispIntf: _ParamArrayAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D54500AE-8CF4-3092-9054-90DC91AC65C9} +// *********************************************************************// + _ParamArrayAttributeDisp = dispinterface + ['{D54500AE-8CF4-3092-9054-90DC91AC65C9}'] + end; + {$EXTERNALSYM _ParamArrayAttributeDisp} + +// *********************************************************************// +// Interface: _PlatformNotSupportedException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1EB8340B-8190-3D9D-92F8-51244B9804C5} +// *********************************************************************// + _PlatformNotSupportedException = interface(IDispatch) + ['{1EB8340B-8190-3D9D-92F8-51244B9804C5}'] + end; + +// *********************************************************************// +// DispIntf: _PlatformNotSupportedExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1EB8340B-8190-3D9D-92F8-51244B9804C5} +// *********************************************************************// + _PlatformNotSupportedExceptionDisp = dispinterface + ['{1EB8340B-8190-3D9D-92F8-51244B9804C5}'] + end; + {$EXTERNALSYM _PlatformNotSupportedExceptionDisp} + +// *********************************************************************// +// Interface: _Random +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0F240708-629A-31AB-94A5-2BB476FE1783} +// *********************************************************************// + _Random = interface(IDispatch) + ['{0F240708-629A-31AB-94A5-2BB476FE1783}'] + end; + +// *********************************************************************// +// DispIntf: _RandomDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0F240708-629A-31AB-94A5-2BB476FE1783} +// *********************************************************************// + _RandomDisp = dispinterface + ['{0F240708-629A-31AB-94A5-2BB476FE1783}'] + end; + {$EXTERNALSYM _RandomDisp} + +// *********************************************************************// +// Interface: _RankException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {871DDC46-B68E-3FEE-A09A-C808B0F827E6} +// *********************************************************************// + _RankException = interface(IDispatch) + ['{871DDC46-B68E-3FEE-A09A-C808B0F827E6}'] + end; + +// *********************************************************************// +// DispIntf: _RankExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {871DDC46-B68E-3FEE-A09A-C808B0F827E6} +// *********************************************************************// + _RankExceptionDisp = dispinterface + ['{871DDC46-B68E-3FEE-A09A-C808B0F827E6}'] + end; + {$EXTERNALSYM _RankExceptionDisp} + +// *********************************************************************// +// Interface: ICustomAttributeProvider +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {B9B91146-D6C2-3A62-8159-C2D1794CDEB0} +// *********************************************************************// + ICustomAttributeProvider = interface(IDispatch) + ['{B9B91146-D6C2-3A62-8159-C2D1794CDEB0}'] + function GetCustomAttributes(const attributeType: _Type; inherit: WordBool): PSafeArray; safecall; + function GetCustomAttributes_2(inherit: WordBool): PSafeArray; safecall; + function IsDefined(const attributeType: _Type; inherit: WordBool): WordBool; safecall; + end; + +// *********************************************************************// +// DispIntf: ICustomAttributeProviderDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {B9B91146-D6C2-3A62-8159-C2D1794CDEB0} +// *********************************************************************// + ICustomAttributeProviderDisp = dispinterface + ['{B9B91146-D6C2-3A62-8159-C2D1794CDEB0}'] + function GetCustomAttributes(const attributeType: _Type; inherit: WordBool): {??PSafeArray}OleVariant; dispid 1610743808; + function GetCustomAttributes_2(inherit: WordBool): {??PSafeArray}OleVariant; dispid 1610743809; + function IsDefined(const attributeType: _Type; inherit: WordBool): WordBool; dispid 1610743810; + end; + {$EXTERNALSYM ICustomAttributeProviderDisp} + +// *********************************************************************// +// Interface: _MemberInfo +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {F7102FA9-CABB-3A74-A6DA-B4567EF1B079} +// *********************************************************************// + _MemberInfo = interface(IDispatch) + ['{F7102FA9-CABB-3A74-A6DA-B4567EF1B079}'] + function Get_ToString: WideString; safecall; + function Equals(obj: OleVariant): WordBool; safecall; + function GetHashCode: Integer; safecall; + function GetType: _Type; safecall; + function Get_MemberType: MemberTypes; safecall; + function Get_name: WideString; safecall; + function Get_DeclaringType: _Type; safecall; + function Get_ReflectedType: _Type; safecall; + function GetCustomAttributes(const attributeType: _Type; inherit: WordBool): PSafeArray; safecall; + function GetCustomAttributes_2(inherit: WordBool): PSafeArray; safecall; + function IsDefined(const attributeType: _Type; inherit: WordBool): WordBool; safecall; + property ToString: WideString read Get_ToString; + property MemberType: MemberTypes read Get_MemberType; + property name: WideString read Get_name; + property DeclaringType: _Type read Get_DeclaringType; + property ReflectedType: _Type read Get_ReflectedType; + end; + +// *********************************************************************// +// DispIntf: _MemberInfoDisp +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {F7102FA9-CABB-3A74-A6DA-B4567EF1B079} +// *********************************************************************// + _MemberInfoDisp = dispinterface + ['{F7102FA9-CABB-3A74-A6DA-B4567EF1B079}'] + property ToString: WideString readonly dispid 0; + function Equals(obj: OleVariant): WordBool; dispid 1610743809; + function GetHashCode: Integer; dispid 1610743810; + function GetType: _Type; dispid 1610743811; + property MemberType: MemberTypes readonly dispid 1610743812; + property name: WideString readonly dispid 1610743813; + property DeclaringType: _Type readonly dispid 1610743814; + property ReflectedType: _Type readonly dispid 1610743815; + function GetCustomAttributes(const attributeType: _Type; inherit: WordBool): {??PSafeArray}OleVariant; dispid 1610743816; + function GetCustomAttributes_2(inherit: WordBool): {??PSafeArray}OleVariant; dispid 1610743817; + function IsDefined(const attributeType: _Type; inherit: WordBool): WordBool; dispid 1610743818; + end; + {$EXTERNALSYM _MemberInfoDisp} + +// *********************************************************************// +// Interface: IReflect +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {AFBF15E5-C37C-11D2-B88E-00A0C9B471B8} +// *********************************************************************// + IReflect = interface(IDispatch) + ['{AFBF15E5-C37C-11D2-B88E-00A0C9B471B8}'] + function GetMethod(const name: WideString; bindingAttr: BindingFlags; const Binder: _Binder; + types: PSafeArray; modifiers: PSafeArray): _MethodInfo; safecall; + function GetMethod_2(const name: WideString; bindingAttr: BindingFlags): _MethodInfo; safecall; + function GetMethods(bindingAttr: BindingFlags): PSafeArray; safecall; + function GetField(const name: WideString; bindingAttr: BindingFlags): _FieldInfo; safecall; + function GetFields(bindingAttr: BindingFlags): PSafeArray; safecall; + function GetProperty(const name: WideString; bindingAttr: BindingFlags): _PropertyInfo; safecall; + function GetProperty_2(const name: WideString; bindingAttr: BindingFlags; + const Binder: _Binder; const returnType: _Type; types: PSafeArray; + modifiers: PSafeArray): _PropertyInfo; safecall; + function GetProperties(bindingAttr: BindingFlags): PSafeArray; safecall; + function GetMember(const name: WideString; bindingAttr: BindingFlags): PSafeArray; safecall; + function GetMembers(bindingAttr: BindingFlags): PSafeArray; safecall; + function InvokeMember(const name: WideString; invokeAttr: BindingFlags; const Binder: _Binder; + Target: OleVariant; args: PSafeArray; modifiers: PSafeArray; + const culture: _CultureInfo; namedParameters: PSafeArray): OleVariant; safecall; + function Get_UnderlyingSystemType: _Type; safecall; + property UnderlyingSystemType: _Type read Get_UnderlyingSystemType; + end; + +// *********************************************************************// +// DispIntf: IReflectDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {AFBF15E5-C37C-11D2-B88E-00A0C9B471B8} +// *********************************************************************// + IReflectDisp = dispinterface + ['{AFBF15E5-C37C-11D2-B88E-00A0C9B471B8}'] + function GetMethod(const name: WideString; bindingAttr: BindingFlags; const Binder: _Binder; + types: {??PSafeArray}OleVariant; modifiers: {??PSafeArray}OleVariant): _MethodInfo; dispid 1610743808; + function GetMethod_2(const name: WideString; bindingAttr: BindingFlags): _MethodInfo; dispid 1610743809; + function GetMethods(bindingAttr: BindingFlags): {??PSafeArray}OleVariant; dispid 1610743810; + function GetField(const name: WideString; bindingAttr: BindingFlags): _FieldInfo; dispid 1610743811; + function GetFields(bindingAttr: BindingFlags): {??PSafeArray}OleVariant; dispid 1610743812; + function GetProperty(const name: WideString; bindingAttr: BindingFlags): _PropertyInfo; dispid 1610743813; + function GetProperty_2(const name: WideString; bindingAttr: BindingFlags; + const Binder: _Binder; const returnType: _Type; + types: {??PSafeArray}OleVariant; modifiers: {??PSafeArray}OleVariant): _PropertyInfo; dispid 1610743814; + function GetProperties(bindingAttr: BindingFlags): {??PSafeArray}OleVariant; dispid 1610743815; + function GetMember(const name: WideString; bindingAttr: BindingFlags): {??PSafeArray}OleVariant; dispid 1610743816; + function GetMembers(bindingAttr: BindingFlags): {??PSafeArray}OleVariant; dispid 1610743817; + function InvokeMember(const name: WideString; invokeAttr: BindingFlags; const Binder: _Binder; + Target: OleVariant; args: {??PSafeArray}OleVariant; + modifiers: {??PSafeArray}OleVariant; const culture: _CultureInfo; + namedParameters: {??PSafeArray}OleVariant): OleVariant; dispid 1610743818; + property UnderlyingSystemType: _Type readonly dispid 1610743819; + end; + {$EXTERNALSYM IReflectDisp} + +// *********************************************************************// +// Interface: _Type +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {BCA8B44D-AAD6-3A86-8AB7-03349F4F2DA2} +// *********************************************************************// + _Type = interface(IDispatch) + ['{BCA8B44D-AAD6-3A86-8AB7-03349F4F2DA2}'] + function Get_ToString: WideString; safecall; + function Equals(o: OleVariant): WordBool; safecall; + function GetHashCode: Integer; safecall; + function GetType: _Type; safecall; + function Get_MemberType: MemberTypes; safecall; + function Get_name: WideString; safecall; + function Get_DeclaringType: _Type; safecall; + function Get_ReflectedType: _Type; safecall; + function GetCustomAttributes(const attributeType: _Type; inherit: WordBool): PSafeArray; safecall; + function GetCustomAttributes_2(inherit: WordBool): PSafeArray; safecall; + function IsDefined(const attributeType: _Type; inherit: WordBool): WordBool; safecall; + function Get_Guid: TGUID; safecall; + function Get_Module: _Module; safecall; + function Get_Assembly: _Assembly; safecall; + function Get_TypeHandle: RuntimeTypeHandle; safecall; + function Get_FullName: WideString; safecall; + function Get_Namespace: WideString; safecall; + function Get_AssemblyQualifiedName: WideString; safecall; + function GetArrayRank: Integer; safecall; + function Get_BaseType: _Type; safecall; + function GetConstructors(bindingAttr: BindingFlags): PSafeArray; safecall; + function GetInterface(const name: WideString; ignoreCase: WordBool): _Type; safecall; + function GetInterfaces: PSafeArray; safecall; + function FindInterfaces(const filter: _TypeFilter; filterCriteria: OleVariant): PSafeArray; safecall; + function GetEvent(const name: WideString; bindingAttr: BindingFlags): _EventInfo; safecall; + function GetEvents: PSafeArray; safecall; + function GetEvents_2(bindingAttr: BindingFlags): PSafeArray; safecall; + function GetNestedTypes(bindingAttr: BindingFlags): PSafeArray; safecall; + function GetNestedType(const name: WideString; bindingAttr: BindingFlags): _Type; safecall; + function GetMember(const name: WideString; Type_: MemberTypes; bindingAttr: BindingFlags): PSafeArray; safecall; + function GetDefaultMembers: PSafeArray; safecall; + function FindMembers(MemberType: MemberTypes; bindingAttr: BindingFlags; + const filter: _MemberFilter; filterCriteria: OleVariant): PSafeArray; safecall; + function GetElementType: _Type; safecall; + function IsSubclassOf(const c: _Type): WordBool; safecall; + function IsInstanceOfType(o: OleVariant): WordBool; safecall; + function IsAssignableFrom(const c: _Type): WordBool; safecall; + function GetInterfaceMap(const interfaceType: _Type): InterfaceMapping; safecall; + function GetMethod(const name: WideString; bindingAttr: BindingFlags; const Binder: _Binder; + types: PSafeArray; modifiers: PSafeArray): _MethodInfo; safecall; + function GetMethod_2(const name: WideString; bindingAttr: BindingFlags): _MethodInfo; safecall; + function GetMethods(bindingAttr: BindingFlags): PSafeArray; safecall; + function GetField(const name: WideString; bindingAttr: BindingFlags): _FieldInfo; safecall; + function GetFields(bindingAttr: BindingFlags): PSafeArray; safecall; + function GetProperty(const name: WideString; bindingAttr: BindingFlags): _PropertyInfo; safecall; + function GetProperty_2(const name: WideString; bindingAttr: BindingFlags; + const Binder: _Binder; const returnType: _Type; types: PSafeArray; + modifiers: PSafeArray): _PropertyInfo; safecall; + function GetProperties(bindingAttr: BindingFlags): PSafeArray; safecall; + function GetMember_2(const name: WideString; bindingAttr: BindingFlags): PSafeArray; safecall; + function GetMembers(bindingAttr: BindingFlags): PSafeArray; safecall; + function InvokeMember(const name: WideString; invokeAttr: BindingFlags; const Binder: _Binder; + Target: OleVariant; args: PSafeArray; modifiers: PSafeArray; + const culture: _CultureInfo; namedParameters: PSafeArray): OleVariant; safecall; + function Get_UnderlyingSystemType: _Type; safecall; + function InvokeMember_2(const name: WideString; invokeAttr: BindingFlags; + const Binder: _Binder; Target: OleVariant; args: PSafeArray; + const culture: _CultureInfo): OleVariant; safecall; + function InvokeMember_3(const name: WideString; invokeAttr: BindingFlags; + const Binder: _Binder; Target: OleVariant; args: PSafeArray): OleVariant; safecall; + function GetConstructor(bindingAttr: BindingFlags; const Binder: _Binder; + callConvention: CallingConventions; types: PSafeArray; + modifiers: PSafeArray): _ConstructorInfo; safecall; + function GetConstructor_2(bindingAttr: BindingFlags; const Binder: _Binder; types: PSafeArray; + modifiers: PSafeArray): _ConstructorInfo; safecall; + function GetConstructor_3(types: PSafeArray): _ConstructorInfo; safecall; + function GetConstructors_2: PSafeArray; safecall; + function Get_TypeInitializer: _ConstructorInfo; safecall; + function GetMethod_3(const name: WideString; bindingAttr: BindingFlags; const Binder: _Binder; + callConvention: CallingConventions; types: PSafeArray; + modifiers: PSafeArray): _MethodInfo; safecall; + function GetMethod_4(const name: WideString; types: PSafeArray; modifiers: PSafeArray): _MethodInfo; safecall; + function GetMethod_5(const name: WideString; types: PSafeArray): _MethodInfo; safecall; + function GetMethod_6(const name: WideString): _MethodInfo; safecall; + function GetMethods_2: PSafeArray; safecall; + function GetField_2(const name: WideString): _FieldInfo; safecall; + function GetFields_2: PSafeArray; safecall; + function GetInterface_2(const name: WideString): _Type; safecall; + function GetEvent_2(const name: WideString): _EventInfo; safecall; + function GetProperty_3(const name: WideString; const returnType: _Type; types: PSafeArray; + modifiers: PSafeArray): _PropertyInfo; safecall; + function GetProperty_4(const name: WideString; const returnType: _Type; types: PSafeArray): _PropertyInfo; safecall; + function GetProperty_5(const name: WideString; types: PSafeArray): _PropertyInfo; safecall; + function GetProperty_6(const name: WideString; const returnType: _Type): _PropertyInfo; safecall; + function GetProperty_7(const name: WideString): _PropertyInfo; safecall; + function GetProperties_2: PSafeArray; safecall; + function GetNestedTypes_2: PSafeArray; safecall; + function GetNestedType_2(const name: WideString): _Type; safecall; + function GetMember_3(const name: WideString): PSafeArray; safecall; + function GetMembers_2: PSafeArray; safecall; + function Get_Attributes: TypeAttributes; safecall; + function Get_IsNotPublic: WordBool; safecall; + function Get_IsPublic: WordBool; safecall; + function Get_IsNestedPublic: WordBool; safecall; + function Get_IsNestedPrivate: WordBool; safecall; + function Get_IsNestedFamily: WordBool; safecall; + function Get_IsNestedAssembly: WordBool; safecall; + function Get_IsNestedFamANDAssem: WordBool; safecall; + function Get_IsNestedFamORAssem: WordBool; safecall; + function Get_IsAutoLayout: WordBool; safecall; + function Get_IsLayoutSequential: WordBool; safecall; + function Get_IsExplicitLayout: WordBool; safecall; + function Get_IsClass: WordBool; safecall; + function Get_IsInterface: WordBool; safecall; + function Get_IsValueType: WordBool; safecall; + function Get_IsAbstract: WordBool; safecall; + function Get_IsSealed: WordBool; safecall; + function Get_IsEnum: WordBool; safecall; + function Get_IsSpecialName: WordBool; safecall; + function Get_IsImport: WordBool; safecall; + function Get_IsSerializable: WordBool; safecall; + function Get_IsAnsiClass: WordBool; safecall; + function Get_IsUnicodeClass: WordBool; safecall; + function Get_IsAutoClass: WordBool; safecall; + function Get_IsArray: WordBool; safecall; + function Get_IsByRef: WordBool; safecall; + function Get_IsPointer: WordBool; safecall; + function Get_IsPrimitive: WordBool; safecall; + function Get_IsCOMObject: WordBool; safecall; + function Get_HasElementType: WordBool; safecall; + function Get_IsContextful: WordBool; safecall; + function Get_IsMarshalByRef: WordBool; safecall; + function Equals_2(const o: _Type): WordBool; safecall; + property ToString: WideString read Get_ToString; + property MemberType: MemberTypes read Get_MemberType; + property name: WideString read Get_name; + property DeclaringType: _Type read Get_DeclaringType; + property ReflectedType: _Type read Get_ReflectedType; + property Guid: TGUID read Get_Guid; + property Module: _Module read Get_Module; + property Assembly: _Assembly read Get_Assembly; + property TypeHandle: RuntimeTypeHandle read Get_TypeHandle; + property FullName: WideString read Get_FullName; + property Namespace: WideString read Get_Namespace; + property AssemblyQualifiedName: WideString read Get_AssemblyQualifiedName; + property BaseType: _Type read Get_BaseType; + property UnderlyingSystemType: _Type read Get_UnderlyingSystemType; + property TypeInitializer: _ConstructorInfo read Get_TypeInitializer; + property Attributes: TypeAttributes read Get_Attributes; + property IsNotPublic: WordBool read Get_IsNotPublic; + property IsPublic: WordBool read Get_IsPublic; + property IsNestedPublic: WordBool read Get_IsNestedPublic; + property IsNestedPrivate: WordBool read Get_IsNestedPrivate; + property IsNestedFamily: WordBool read Get_IsNestedFamily; + property IsNestedAssembly: WordBool read Get_IsNestedAssembly; + property IsNestedFamANDAssem: WordBool read Get_IsNestedFamANDAssem; + property IsNestedFamORAssem: WordBool read Get_IsNestedFamORAssem; + property IsAutoLayout: WordBool read Get_IsAutoLayout; + property IsLayoutSequential: WordBool read Get_IsLayoutSequential; + property IsExplicitLayout: WordBool read Get_IsExplicitLayout; + property IsClass: WordBool read Get_IsClass; + property IsInterface: WordBool read Get_IsInterface; + property IsValueType: WordBool read Get_IsValueType; + property IsAbstract: WordBool read Get_IsAbstract; + property IsSealed: WordBool read Get_IsSealed; + property IsEnum: WordBool read Get_IsEnum; + property IsSpecialName: WordBool read Get_IsSpecialName; + property IsImport: WordBool read Get_IsImport; + property IsSerializable: WordBool read Get_IsSerializable; + property IsAnsiClass: WordBool read Get_IsAnsiClass; + property IsUnicodeClass: WordBool read Get_IsUnicodeClass; + property IsAutoClass: WordBool read Get_IsAutoClass; + property IsArray: WordBool read Get_IsArray; + property IsByRef: WordBool read Get_IsByRef; + property IsPointer: WordBool read Get_IsPointer; + property IsPrimitive: WordBool read Get_IsPrimitive; + property IsCOMObject: WordBool read Get_IsCOMObject; + property HasElementType: WordBool read Get_HasElementType; + property IsContextful: WordBool read Get_IsContextful; + property IsMarshalByRef: WordBool read Get_IsMarshalByRef; + end; + +// *********************************************************************// +// DispIntf: _TypeDisp +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {BCA8B44D-AAD6-3A86-8AB7-03349F4F2DA2} +// *********************************************************************// + _TypeDisp = dispinterface + ['{BCA8B44D-AAD6-3A86-8AB7-03349F4F2DA2}'] + property ToString: WideString readonly dispid 0; + function Equals(o: OleVariant): WordBool; dispid 1610743809; + function GetHashCode: Integer; dispid 1610743810; + function GetType: _Type; dispid 1610743811; + property MemberType: MemberTypes readonly dispid 1610743812; + property name: WideString readonly dispid 1610743813; + property DeclaringType: _Type readonly dispid 1610743814; + property ReflectedType: _Type readonly dispid 1610743815; + function GetCustomAttributes(const attributeType: _Type; inherit: WordBool): {??PSafeArray}OleVariant; dispid 1610743816; + function GetCustomAttributes_2(inherit: WordBool): {??PSafeArray}OleVariant; dispid 1610743817; + function IsDefined(const attributeType: _Type; inherit: WordBool): WordBool; dispid 1610743818; + property Guid: {??TGUID}OleVariant readonly dispid 1610743819; + property Module: _Module readonly dispid 1610743820; + property Assembly: _Assembly readonly dispid 1610743821; + property TypeHandle: {??RuntimeTypeHandle}OleVariant readonly dispid 1610743822; + property FullName: WideString readonly dispid 1610743823; + property Namespace: WideString readonly dispid 1610743824; + property AssemblyQualifiedName: WideString readonly dispid 1610743825; + function GetArrayRank: Integer; dispid 1610743826; + property BaseType: _Type readonly dispid 1610743827; + function GetConstructors(bindingAttr: BindingFlags): {??PSafeArray}OleVariant; dispid 1610743828; + function GetInterface(const name: WideString; ignoreCase: WordBool): _Type; dispid 1610743829; + function GetInterfaces: {??PSafeArray}OleVariant; dispid 1610743830; + function FindInterfaces(const filter: _TypeFilter; filterCriteria: OleVariant): {??PSafeArray}OleVariant; dispid 1610743831; + function GetEvent(const name: WideString; bindingAttr: BindingFlags): _EventInfo; dispid 1610743832; + function GetEvents: {??PSafeArray}OleVariant; dispid 1610743833; + function GetEvents_2(bindingAttr: BindingFlags): {??PSafeArray}OleVariant; dispid 1610743834; + function GetNestedTypes(bindingAttr: BindingFlags): {??PSafeArray}OleVariant; dispid 1610743835; + function GetNestedType(const name: WideString; bindingAttr: BindingFlags): _Type; dispid 1610743836; + function GetMember(const name: WideString; Type_: MemberTypes; bindingAttr: BindingFlags): {??PSafeArray}OleVariant; dispid 1610743837; + function GetDefaultMembers: {??PSafeArray}OleVariant; dispid 1610743838; + function FindMembers(MemberType: MemberTypes; bindingAttr: BindingFlags; + const filter: _MemberFilter; filterCriteria: OleVariant): {??PSafeArray}OleVariant; dispid 1610743839; + function GetElementType: _Type; dispid 1610743840; + function IsSubclassOf(const c: _Type): WordBool; dispid 1610743841; + function IsInstanceOfType(o: OleVariant): WordBool; dispid 1610743842; + function IsAssignableFrom(const c: _Type): WordBool; dispid 1610743843; + function GetInterfaceMap(const interfaceType: _Type): {??InterfaceMapping}OleVariant; dispid 1610743844; + function GetMethod(const name: WideString; bindingAttr: BindingFlags; const Binder: _Binder; + types: {??PSafeArray}OleVariant; modifiers: {??PSafeArray}OleVariant): _MethodInfo; dispid 1610743845; + function GetMethod_2(const name: WideString; bindingAttr: BindingFlags): _MethodInfo; dispid 1610743846; + function GetMethods(bindingAttr: BindingFlags): {??PSafeArray}OleVariant; dispid 1610743847; + function GetField(const name: WideString; bindingAttr: BindingFlags): _FieldInfo; dispid 1610743848; + function GetFields(bindingAttr: BindingFlags): {??PSafeArray}OleVariant; dispid 1610743849; + function GetProperty(const name: WideString; bindingAttr: BindingFlags): _PropertyInfo; dispid 1610743850; + function GetProperty_2(const name: WideString; bindingAttr: BindingFlags; + const Binder: _Binder; const returnType: _Type; + types: {??PSafeArray}OleVariant; modifiers: {??PSafeArray}OleVariant): _PropertyInfo; dispid 1610743851; + function GetProperties(bindingAttr: BindingFlags): {??PSafeArray}OleVariant; dispid 1610743852; + function GetMember_2(const name: WideString; bindingAttr: BindingFlags): {??PSafeArray}OleVariant; dispid 1610743853; + function GetMembers(bindingAttr: BindingFlags): {??PSafeArray}OleVariant; dispid 1610743854; + function InvokeMember(const name: WideString; invokeAttr: BindingFlags; const Binder: _Binder; + Target: OleVariant; args: {??PSafeArray}OleVariant; + modifiers: {??PSafeArray}OleVariant; const culture: _CultureInfo; + namedParameters: {??PSafeArray}OleVariant): OleVariant; dispid 1610743855; + property UnderlyingSystemType: _Type readonly dispid 1610743856; + function InvokeMember_2(const name: WideString; invokeAttr: BindingFlags; + const Binder: _Binder; Target: OleVariant; + args: {??PSafeArray}OleVariant; const culture: _CultureInfo): OleVariant; dispid 1610743857; + function InvokeMember_3(const name: WideString; invokeAttr: BindingFlags; + const Binder: _Binder; Target: OleVariant; + args: {??PSafeArray}OleVariant): OleVariant; dispid 1610743858; + function GetConstructor(bindingAttr: BindingFlags; const Binder: _Binder; + callConvention: CallingConventions; types: {??PSafeArray}OleVariant; + modifiers: {??PSafeArray}OleVariant): _ConstructorInfo; dispid 1610743859; + function GetConstructor_2(bindingAttr: BindingFlags; const Binder: _Binder; + types: {??PSafeArray}OleVariant; modifiers: {??PSafeArray}OleVariant): _ConstructorInfo; dispid 1610743860; + function GetConstructor_3(types: {??PSafeArray}OleVariant): _ConstructorInfo; dispid 1610743861; + function GetConstructors_2: {??PSafeArray}OleVariant; dispid 1610743862; + property TypeInitializer: _ConstructorInfo readonly dispid 1610743863; + function GetMethod_3(const name: WideString; bindingAttr: BindingFlags; const Binder: _Binder; + callConvention: CallingConventions; types: {??PSafeArray}OleVariant; + modifiers: {??PSafeArray}OleVariant): _MethodInfo; dispid 1610743864; + function GetMethod_4(const name: WideString; types: {??PSafeArray}OleVariant; + modifiers: {??PSafeArray}OleVariant): _MethodInfo; dispid 1610743865; + function GetMethod_5(const name: WideString; types: {??PSafeArray}OleVariant): _MethodInfo; dispid 1610743866; + function GetMethod_6(const name: WideString): _MethodInfo; dispid 1610743867; + function GetMethods_2: {??PSafeArray}OleVariant; dispid 1610743868; + function GetField_2(const name: WideString): _FieldInfo; dispid 1610743869; + function GetFields_2: {??PSafeArray}OleVariant; dispid 1610743870; + function GetInterface_2(const name: WideString): _Type; dispid 1610743871; + function GetEvent_2(const name: WideString): _EventInfo; dispid 1610743872; + function GetProperty_3(const name: WideString; const returnType: _Type; + types: {??PSafeArray}OleVariant; modifiers: {??PSafeArray}OleVariant): _PropertyInfo; dispid 1610743873; + function GetProperty_4(const name: WideString; const returnType: _Type; + types: {??PSafeArray}OleVariant): _PropertyInfo; dispid 1610743874; + function GetProperty_5(const name: WideString; types: {??PSafeArray}OleVariant): _PropertyInfo; dispid 1610743875; + function GetProperty_6(const name: WideString; const returnType: _Type): _PropertyInfo; dispid 1610743876; + function GetProperty_7(const name: WideString): _PropertyInfo; dispid 1610743877; + function GetProperties_2: {??PSafeArray}OleVariant; dispid 1610743878; + function GetNestedTypes_2: {??PSafeArray}OleVariant; dispid 1610743879; + function GetNestedType_2(const name: WideString): _Type; dispid 1610743880; + function GetMember_3(const name: WideString): {??PSafeArray}OleVariant; dispid 1610743881; + function GetMembers_2: {??PSafeArray}OleVariant; dispid 1610743882; + property Attributes: TypeAttributes readonly dispid 1610743883; + property IsNotPublic: WordBool readonly dispid 1610743884; + property IsPublic: WordBool readonly dispid 1610743885; + property IsNestedPublic: WordBool readonly dispid 1610743886; + property IsNestedPrivate: WordBool readonly dispid 1610743887; + property IsNestedFamily: WordBool readonly dispid 1610743888; + property IsNestedAssembly: WordBool readonly dispid 1610743889; + property IsNestedFamANDAssem: WordBool readonly dispid 1610743890; + property IsNestedFamORAssem: WordBool readonly dispid 1610743891; + property IsAutoLayout: WordBool readonly dispid 1610743892; + property IsLayoutSequential: WordBool readonly dispid 1610743893; + property IsExplicitLayout: WordBool readonly dispid 1610743894; + property IsClass: WordBool readonly dispid 1610743895; + property IsInterface: WordBool readonly dispid 1610743896; + property IsValueType: WordBool readonly dispid 1610743897; + property IsAbstract: WordBool readonly dispid 1610743898; + property IsSealed: WordBool readonly dispid 1610743899; + property IsEnum: WordBool readonly dispid 1610743900; + property IsSpecialName: WordBool readonly dispid 1610743901; + property IsImport: WordBool readonly dispid 1610743902; + property IsSerializable: WordBool readonly dispid 1610743903; + property IsAnsiClass: WordBool readonly dispid 1610743904; + property IsUnicodeClass: WordBool readonly dispid 1610743905; + property IsAutoClass: WordBool readonly dispid 1610743906; + property IsArray: WordBool readonly dispid 1610743907; + property IsByRef: WordBool readonly dispid 1610743908; + property IsPointer: WordBool readonly dispid 1610743909; + property IsPrimitive: WordBool readonly dispid 1610743910; + property IsCOMObject: WordBool readonly dispid 1610743911; + property HasElementType: WordBool readonly dispid 1610743912; + property IsContextful: WordBool readonly dispid 1610743913; + property IsMarshalByRef: WordBool readonly dispid 1610743914; + function Equals_2(const o: _Type): WordBool; dispid 1610743915; + end; + {$EXTERNALSYM _TypeDisp} + +// *********************************************************************// +// Interface: _SerializableAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1B96E53C-4028-38BC-9DC3-8D7A9555C311} +// *********************************************************************// + _SerializableAttribute = interface(IDispatch) + ['{1B96E53C-4028-38BC-9DC3-8D7A9555C311}'] + end; + +// *********************************************************************// +// DispIntf: _SerializableAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1B96E53C-4028-38BC-9DC3-8D7A9555C311} +// *********************************************************************// + _SerializableAttributeDisp = dispinterface + ['{1B96E53C-4028-38BC-9DC3-8D7A9555C311}'] + end; + {$EXTERNALSYM _SerializableAttributeDisp} + +// *********************************************************************// +// Interface: _TypeInitializationException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FEB0323D-8CE4-36A4-A41E-0BA0C32E1A6A} +// *********************************************************************// + _TypeInitializationException = interface(IDispatch) + ['{FEB0323D-8CE4-36A4-A41E-0BA0C32E1A6A}'] + end; + +// *********************************************************************// +// DispIntf: _TypeInitializationExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FEB0323D-8CE4-36A4-A41E-0BA0C32E1A6A} +// *********************************************************************// + _TypeInitializationExceptionDisp = dispinterface + ['{FEB0323D-8CE4-36A4-A41E-0BA0C32E1A6A}'] + end; + {$EXTERNALSYM _TypeInitializationExceptionDisp} + +// *********************************************************************// +// Interface: _UnauthorizedAccessException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6193C5F6-6807-3561-A7F3-B64C80B5F00F} +// *********************************************************************// + _UnauthorizedAccessException = interface(IDispatch) + ['{6193C5F6-6807-3561-A7F3-B64C80B5F00F}'] + end; + +// *********************************************************************// +// DispIntf: _UnauthorizedAccessExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6193C5F6-6807-3561-A7F3-B64C80B5F00F} +// *********************************************************************// + _UnauthorizedAccessExceptionDisp = dispinterface + ['{6193C5F6-6807-3561-A7F3-B64C80B5F00F}'] + end; + {$EXTERNALSYM _UnauthorizedAccessExceptionDisp} + +// *********************************************************************// +// Interface: _UnhandledExceptionEventArgs +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A218E20A-0905-3741-B0B3-9E3193162E50} +// *********************************************************************// + _UnhandledExceptionEventArgs = interface(IDispatch) + ['{A218E20A-0905-3741-B0B3-9E3193162E50}'] + end; + +// *********************************************************************// +// DispIntf: _UnhandledExceptionEventArgsDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A218E20A-0905-3741-B0B3-9E3193162E50} +// *********************************************************************// + _UnhandledExceptionEventArgsDisp = dispinterface + ['{A218E20A-0905-3741-B0B3-9E3193162E50}'] + end; + {$EXTERNALSYM _UnhandledExceptionEventArgsDisp} + +// *********************************************************************// +// Interface: _UnhandledExceptionEventHandler +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {84199E64-439C-3011-B249-3C9065735ADB} +// *********************************************************************// + _UnhandledExceptionEventHandler = interface(IDispatch) + ['{84199E64-439C-3011-B249-3C9065735ADB}'] + end; + +// *********************************************************************// +// DispIntf: _UnhandledExceptionEventHandlerDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {84199E64-439C-3011-B249-3C9065735ADB} +// *********************************************************************// + _UnhandledExceptionEventHandlerDisp = dispinterface + ['{84199E64-439C-3011-B249-3C9065735ADB}'] + end; + {$EXTERNALSYM _UnhandledExceptionEventHandlerDisp} + +// *********************************************************************// +// Interface: _Version +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {011A90C5-4910-3C29-BBB7-50D05CCBAA4A} +// *********************************************************************// + _Version = interface(IDispatch) + ['{011A90C5-4910-3C29-BBB7-50D05CCBAA4A}'] + end; + +// *********************************************************************// +// DispIntf: _VersionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {011A90C5-4910-3C29-BBB7-50D05CCBAA4A} +// *********************************************************************// + _VersionDisp = dispinterface + ['{011A90C5-4910-3C29-BBB7-50D05CCBAA4A}'] + end; + {$EXTERNALSYM _VersionDisp} + +// *********************************************************************// +// Interface: _WeakReference +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C5DF3568-C251-3C58-AFB4-32E79E8261F0} +// *********************************************************************// + _WeakReference = interface(IDispatch) + ['{C5DF3568-C251-3C58-AFB4-32E79E8261F0}'] + end; + +// *********************************************************************// +// DispIntf: _WeakReferenceDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C5DF3568-C251-3C58-AFB4-32E79E8261F0} +// *********************************************************************// + _WeakReferenceDisp = dispinterface + ['{C5DF3568-C251-3C58-AFB4-32E79E8261F0}'] + end; + {$EXTERNALSYM _WeakReferenceDisp} + +// *********************************************************************// +// Interface: _WaitHandle +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {40DFC50A-E93A-3C08-B9EF-E2B4F28B5676} +// *********************************************************************// + _WaitHandle = interface(IDispatch) + ['{40DFC50A-E93A-3C08-B9EF-E2B4F28B5676}'] + end; + +// *********************************************************************// +// DispIntf: _WaitHandleDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {40DFC50A-E93A-3C08-B9EF-E2B4F28B5676} +// *********************************************************************// + _WaitHandleDisp = dispinterface + ['{40DFC50A-E93A-3C08-B9EF-E2B4F28B5676}'] + end; + {$EXTERNALSYM _WaitHandleDisp} + +// *********************************************************************// +// Interface: _AutoResetEvent +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3F243EBD-612F-3DB8-9E03-BD92343A8371} +// *********************************************************************// + _AutoResetEvent = interface(IDispatch) + ['{3F243EBD-612F-3DB8-9E03-BD92343A8371}'] + end; + +// *********************************************************************// +// DispIntf: _AutoResetEventDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3F243EBD-612F-3DB8-9E03-BD92343A8371} +// *********************************************************************// + _AutoResetEventDisp = dispinterface + ['{3F243EBD-612F-3DB8-9E03-BD92343A8371}'] + end; + {$EXTERNALSYM _AutoResetEventDisp} + +// *********************************************************************// +// Interface: _CompressedStack +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4BCBC4D6-98EB-381A-A8A6-08B2378738ED} +// *********************************************************************// + _CompressedStack = interface(IDispatch) + ['{4BCBC4D6-98EB-381A-A8A6-08B2378738ED}'] + end; + +// *********************************************************************// +// DispIntf: _CompressedStackDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4BCBC4D6-98EB-381A-A8A6-08B2378738ED} +// *********************************************************************// + _CompressedStackDisp = dispinterface + ['{4BCBC4D6-98EB-381A-A8A6-08B2378738ED}'] + end; + {$EXTERNALSYM _CompressedStackDisp} + +// *********************************************************************// +// Interface: _Interlocked +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DF20F518-8ED1-35E3-950E-020214FDB9B2} +// *********************************************************************// + _Interlocked = interface(IDispatch) + ['{DF20F518-8ED1-35E3-950E-020214FDB9B2}'] + end; + +// *********************************************************************// +// DispIntf: _InterlockedDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DF20F518-8ED1-35E3-950E-020214FDB9B2} +// *********************************************************************// + _InterlockedDisp = dispinterface + ['{DF20F518-8ED1-35E3-950E-020214FDB9B2}'] + end; + {$EXTERNALSYM _InterlockedDisp} + +// *********************************************************************// +// Interface: IObjectHandle +// Flags: (256) OleAutomation +// GUID: {C460E2B4-E199-412A-8456-84DC3E4838C3} +// *********************************************************************// + IObjectHandle = interface(IUnknown) + ['{C460E2B4-E199-412A-8456-84DC3E4838C3}'] + function Unwrap(out pRetVal: OleVariant): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: _ManualResetEvent +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C0BB9361-268F-3E72-BF6F-4120175A1500} +// *********************************************************************// + _ManualResetEvent = interface(IDispatch) + ['{C0BB9361-268F-3E72-BF6F-4120175A1500}'] + end; + +// *********************************************************************// +// DispIntf: _ManualResetEventDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C0BB9361-268F-3E72-BF6F-4120175A1500} +// *********************************************************************// + _ManualResetEventDisp = dispinterface + ['{C0BB9361-268F-3E72-BF6F-4120175A1500}'] + end; + {$EXTERNALSYM _ManualResetEventDisp} + +// *********************************************************************// +// Interface: _Monitor +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {EE22485E-4C45-3C9D-9027-A8D61C5F53F2} +// *********************************************************************// + _Monitor = interface(IDispatch) + ['{EE22485E-4C45-3C9D-9027-A8D61C5F53F2}'] + end; + +// *********************************************************************// +// DispIntf: _MonitorDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {EE22485E-4C45-3C9D-9027-A8D61C5F53F2} +// *********************************************************************// + _MonitorDisp = dispinterface + ['{EE22485E-4C45-3C9D-9027-A8D61C5F53F2}'] + end; + {$EXTERNALSYM _MonitorDisp} + +// *********************************************************************// +// Interface: _Mutex +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {36CB559B-87C6-3AD2-9225-62A7ED499B37} +// *********************************************************************// + _Mutex = interface(IDispatch) + ['{36CB559B-87C6-3AD2-9225-62A7ED499B37}'] + end; + +// *********************************************************************// +// DispIntf: _MutexDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {36CB559B-87C6-3AD2-9225-62A7ED499B37} +// *********************************************************************// + _MutexDisp = dispinterface + ['{36CB559B-87C6-3AD2-9225-62A7ED499B37}'] + end; + {$EXTERNALSYM _MutexDisp} + +// *********************************************************************// +// Interface: _Overlapped +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DD846FCC-8D04-3665-81B6-AACBE99C19C3} +// *********************************************************************// + _Overlapped = interface(IDispatch) + ['{DD846FCC-8D04-3665-81B6-AACBE99C19C3}'] + end; + +// *********************************************************************// +// DispIntf: _OverlappedDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DD846FCC-8D04-3665-81B6-AACBE99C19C3} +// *********************************************************************// + _OverlappedDisp = dispinterface + ['{DD846FCC-8D04-3665-81B6-AACBE99C19C3}'] + end; + {$EXTERNALSYM _OverlappedDisp} + +// *********************************************************************// +// Interface: _ReaderWriterLock +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AD89B568-4FD4-3F8D-8327-B396B20A460E} +// *********************************************************************// + _ReaderWriterLock = interface(IDispatch) + ['{AD89B568-4FD4-3F8D-8327-B396B20A460E}'] + end; + +// *********************************************************************// +// DispIntf: _ReaderWriterLockDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AD89B568-4FD4-3F8D-8327-B396B20A460E} +// *********************************************************************// + _ReaderWriterLockDisp = dispinterface + ['{AD89B568-4FD4-3F8D-8327-B396B20A460E}'] + end; + {$EXTERNALSYM _ReaderWriterLockDisp} + +// *********************************************************************// +// Interface: _SynchronizationLockException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {87F55344-17E0-30FD-8EB9-38EAF6A19B3F} +// *********************************************************************// + _SynchronizationLockException = interface(IDispatch) + ['{87F55344-17E0-30FD-8EB9-38EAF6A19B3F}'] + end; + +// *********************************************************************// +// DispIntf: _SynchronizationLockExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {87F55344-17E0-30FD-8EB9-38EAF6A19B3F} +// *********************************************************************// + _SynchronizationLockExceptionDisp = dispinterface + ['{87F55344-17E0-30FD-8EB9-38EAF6A19B3F}'] + end; + {$EXTERNALSYM _SynchronizationLockExceptionDisp} + +// *********************************************************************// +// Interface: _Thread +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C281C7F1-4AA9-3517-961A-463CFED57E75} +// *********************************************************************// + _Thread = interface(IDispatch) + ['{C281C7F1-4AA9-3517-961A-463CFED57E75}'] + end; + +// *********************************************************************// +// DispIntf: _ThreadDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C281C7F1-4AA9-3517-961A-463CFED57E75} +// *********************************************************************// + _ThreadDisp = dispinterface + ['{C281C7F1-4AA9-3517-961A-463CFED57E75}'] + end; + {$EXTERNALSYM _ThreadDisp} + +// *********************************************************************// +// Interface: _ThreadAbortException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {95B525DB-6B81-3CDC-8FE7-713F7FC793C0} +// *********************************************************************// + _ThreadAbortException = interface(IDispatch) + ['{95B525DB-6B81-3CDC-8FE7-713F7FC793C0}'] + end; + +// *********************************************************************// +// DispIntf: _ThreadAbortExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {95B525DB-6B81-3CDC-8FE7-713F7FC793C0} +// *********************************************************************// + _ThreadAbortExceptionDisp = dispinterface + ['{95B525DB-6B81-3CDC-8FE7-713F7FC793C0}'] + end; + {$EXTERNALSYM _ThreadAbortExceptionDisp} + +// *********************************************************************// +// Interface: _STAThreadAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {85D72F83-BE91-3CB1-B4F0-76B56FF04033} +// *********************************************************************// + _STAThreadAttribute = interface(IDispatch) + ['{85D72F83-BE91-3CB1-B4F0-76B56FF04033}'] + end; + +// *********************************************************************// +// DispIntf: _STAThreadAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {85D72F83-BE91-3CB1-B4F0-76B56FF04033} +// *********************************************************************// + _STAThreadAttributeDisp = dispinterface + ['{85D72F83-BE91-3CB1-B4F0-76B56FF04033}'] + end; + {$EXTERNALSYM _STAThreadAttributeDisp} + +// *********************************************************************// +// Interface: _MTAThreadAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C02468D1-8713-3225-BDA3-49B2FE37DDBB} +// *********************************************************************// + _MTAThreadAttribute = interface(IDispatch) + ['{C02468D1-8713-3225-BDA3-49B2FE37DDBB}'] + end; + +// *********************************************************************// +// DispIntf: _MTAThreadAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C02468D1-8713-3225-BDA3-49B2FE37DDBB} +// *********************************************************************// + _MTAThreadAttributeDisp = dispinterface + ['{C02468D1-8713-3225-BDA3-49B2FE37DDBB}'] + end; + {$EXTERNALSYM _MTAThreadAttributeDisp} + +// *********************************************************************// +// Interface: _ThreadInterruptedException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B9E07599-7C44-33BE-A70E-EFA16F51F54A} +// *********************************************************************// + _ThreadInterruptedException = interface(IDispatch) + ['{B9E07599-7C44-33BE-A70E-EFA16F51F54A}'] + end; + +// *********************************************************************// +// DispIntf: _ThreadInterruptedExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B9E07599-7C44-33BE-A70E-EFA16F51F54A} +// *********************************************************************// + _ThreadInterruptedExceptionDisp = dispinterface + ['{B9E07599-7C44-33BE-A70E-EFA16F51F54A}'] + end; + {$EXTERNALSYM _ThreadInterruptedExceptionDisp} + +// *********************************************************************// +// Interface: _RegisteredWaitHandle +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {64409425-F8C9-370E-809E-3241CE804541} +// *********************************************************************// + _RegisteredWaitHandle = interface(IDispatch) + ['{64409425-F8C9-370E-809E-3241CE804541}'] + end; + +// *********************************************************************// +// DispIntf: _RegisteredWaitHandleDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {64409425-F8C9-370E-809E-3241CE804541} +// *********************************************************************// + _RegisteredWaitHandleDisp = dispinterface + ['{64409425-F8C9-370E-809E-3241CE804541}'] + end; + {$EXTERNALSYM _RegisteredWaitHandleDisp} + +// *********************************************************************// +// Interface: _WaitCallback +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {CE949142-4D4C-358D-89A9-E69A531AA363} +// *********************************************************************// + _WaitCallback = interface(IDispatch) + ['{CE949142-4D4C-358D-89A9-E69A531AA363}'] + end; + +// *********************************************************************// +// DispIntf: _WaitCallbackDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {CE949142-4D4C-358D-89A9-E69A531AA363} +// *********************************************************************// + _WaitCallbackDisp = dispinterface + ['{CE949142-4D4C-358D-89A9-E69A531AA363}'] + end; + {$EXTERNALSYM _WaitCallbackDisp} + +// *********************************************************************// +// Interface: _WaitOrTimerCallback +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F078F795-F452-3D2D-8CC8-16D66AE46C67} +// *********************************************************************// + _WaitOrTimerCallback = interface(IDispatch) + ['{F078F795-F452-3D2D-8CC8-16D66AE46C67}'] + end; + +// *********************************************************************// +// DispIntf: _WaitOrTimerCallbackDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F078F795-F452-3D2D-8CC8-16D66AE46C67} +// *********************************************************************// + _WaitOrTimerCallbackDisp = dispinterface + ['{F078F795-F452-3D2D-8CC8-16D66AE46C67}'] + end; + {$EXTERNALSYM _WaitOrTimerCallbackDisp} + +// *********************************************************************// +// Interface: _IOCompletionCallback +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BBAE942D-BFF4-36E2-A3BC-508BB3801F4F} +// *********************************************************************// + _IOCompletionCallback = interface(IDispatch) + ['{BBAE942D-BFF4-36E2-A3BC-508BB3801F4F}'] + end; + +// *********************************************************************// +// DispIntf: _IOCompletionCallbackDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BBAE942D-BFF4-36E2-A3BC-508BB3801F4F} +// *********************************************************************// + _IOCompletionCallbackDisp = dispinterface + ['{BBAE942D-BFF4-36E2-A3BC-508BB3801F4F}'] + end; + {$EXTERNALSYM _IOCompletionCallbackDisp} + +// *********************************************************************// +// Interface: _ThreadPool +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F5E02ADE-E724-3001-B498-3305B2A93D72} +// *********************************************************************// + _ThreadPool = interface(IDispatch) + ['{F5E02ADE-E724-3001-B498-3305B2A93D72}'] + end; + +// *********************************************************************// +// DispIntf: _ThreadPoolDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F5E02ADE-E724-3001-B498-3305B2A93D72} +// *********************************************************************// + _ThreadPoolDisp = dispinterface + ['{F5E02ADE-E724-3001-B498-3305B2A93D72}'] + end; + {$EXTERNALSYM _ThreadPoolDisp} + +// *********************************************************************// +// Interface: _ThreadStart +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B45BBD7E-A977-3F56-A626-7A693E5DBBC5} +// *********************************************************************// + _ThreadStart = interface(IDispatch) + ['{B45BBD7E-A977-3F56-A626-7A693E5DBBC5}'] + end; + +// *********************************************************************// +// DispIntf: _ThreadStartDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B45BBD7E-A977-3F56-A626-7A693E5DBBC5} +// *********************************************************************// + _ThreadStartDisp = dispinterface + ['{B45BBD7E-A977-3F56-A626-7A693E5DBBC5}'] + end; + {$EXTERNALSYM _ThreadStartDisp} + +// *********************************************************************// +// Interface: _ThreadStateException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A13A41CF-E066-3B90-82F4-73109104E348} +// *********************************************************************// + _ThreadStateException = interface(IDispatch) + ['{A13A41CF-E066-3B90-82F4-73109104E348}'] + end; + +// *********************************************************************// +// DispIntf: _ThreadStateExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A13A41CF-E066-3B90-82F4-73109104E348} +// *********************************************************************// + _ThreadStateExceptionDisp = dispinterface + ['{A13A41CF-E066-3B90-82F4-73109104E348}'] + end; + {$EXTERNALSYM _ThreadStateExceptionDisp} + +// *********************************************************************// +// Interface: _ThreadStaticAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A6B94B6D-854E-3172-A4EC-A17EDD16F85E} +// *********************************************************************// + _ThreadStaticAttribute = interface(IDispatch) + ['{A6B94B6D-854E-3172-A4EC-A17EDD16F85E}'] + end; + +// *********************************************************************// +// DispIntf: _ThreadStaticAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A6B94B6D-854E-3172-A4EC-A17EDD16F85E} +// *********************************************************************// + _ThreadStaticAttributeDisp = dispinterface + ['{A6B94B6D-854E-3172-A4EC-A17EDD16F85E}'] + end; + {$EXTERNALSYM _ThreadStaticAttributeDisp} + +// *********************************************************************// +// Interface: _Timeout +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {81456E86-22AF-31D1-A91A-9C370C0E2530} +// *********************************************************************// + _Timeout = interface(IDispatch) + ['{81456E86-22AF-31D1-A91A-9C370C0E2530}'] + end; + +// *********************************************************************// +// DispIntf: _TimeoutDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {81456E86-22AF-31D1-A91A-9C370C0E2530} +// *********************************************************************// + _TimeoutDisp = dispinterface + ['{81456E86-22AF-31D1-A91A-9C370C0E2530}'] + end; + {$EXTERNALSYM _TimeoutDisp} + +// *********************************************************************// +// Interface: _TimerCallback +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3741BC6F-101B-36D7-A9D5-03FCC0ECDA35} +// *********************************************************************// + _TimerCallback = interface(IDispatch) + ['{3741BC6F-101B-36D7-A9D5-03FCC0ECDA35}'] + end; + +// *********************************************************************// +// DispIntf: _TimerCallbackDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3741BC6F-101B-36D7-A9D5-03FCC0ECDA35} +// *********************************************************************// + _TimerCallbackDisp = dispinterface + ['{3741BC6F-101B-36D7-A9D5-03FCC0ECDA35}'] + end; + {$EXTERNALSYM _TimerCallbackDisp} + +// *********************************************************************// +// Interface: _Timer +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B49A029B-406B-3B1E-88E4-F86690D20364} +// *********************************************************************// + _Timer = interface(IDispatch) + ['{B49A029B-406B-3B1E-88E4-F86690D20364}'] + end; + +// *********************************************************************// +// DispIntf: _TimerDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B49A029B-406B-3B1E-88E4-F86690D20364} +// *********************************************************************// + _TimerDisp = dispinterface + ['{B49A029B-406B-3B1E-88E4-F86690D20364}'] + end; + {$EXTERNALSYM _TimerDisp} + +// *********************************************************************// +// Interface: _ArrayList +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {401F89CB-C127-3041-82FD-B67035395C56} +// *********************************************************************// + _ArrayList = interface(IDispatch) + ['{401F89CB-C127-3041-82FD-B67035395C56}'] + end; + +// *********************************************************************// +// DispIntf: _ArrayListDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {401F89CB-C127-3041-82FD-B67035395C56} +// *********************************************************************// + _ArrayListDisp = dispinterface + ['{401F89CB-C127-3041-82FD-B67035395C56}'] + end; + {$EXTERNALSYM _ArrayListDisp} + +// *********************************************************************// +// Interface: _BitArray +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F145C46A-D170-3170-B52F-4678DFCA0300} +// *********************************************************************// + _BitArray = interface(IDispatch) + ['{F145C46A-D170-3170-B52F-4678DFCA0300}'] + end; + +// *********************************************************************// +// DispIntf: _BitArrayDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F145C46A-D170-3170-B52F-4678DFCA0300} +// *********************************************************************// + _BitArrayDisp = dispinterface + ['{F145C46A-D170-3170-B52F-4678DFCA0300}'] + end; + {$EXTERNALSYM _BitArrayDisp} + +// *********************************************************************// +// Interface: IComparer +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {C20FD3EB-7022-3D14-8477-760FAB54E50D} +// *********************************************************************// + IComparer = interface(IDispatch) + ['{C20FD3EB-7022-3D14-8477-760FAB54E50D}'] + function Compare(x: OleVariant; y: OleVariant): Integer; safecall; + end; + +// *********************************************************************// +// DispIntf: IComparerDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {C20FD3EB-7022-3D14-8477-760FAB54E50D} +// *********************************************************************// + IComparerDisp = dispinterface + ['{C20FD3EB-7022-3D14-8477-760FAB54E50D}'] + function Compare(x: OleVariant; y: OleVariant): Integer; dispid 1610743808; + end; + {$EXTERNALSYM IComparerDisp} + +// *********************************************************************// +// Interface: _CaseInsensitiveComparer +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {EA6795AC-97D6-3377-BE64-829ABD67607B} +// *********************************************************************// + _CaseInsensitiveComparer = interface(IDispatch) + ['{EA6795AC-97D6-3377-BE64-829ABD67607B}'] + end; + +// *********************************************************************// +// DispIntf: _CaseInsensitiveComparerDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {EA6795AC-97D6-3377-BE64-829ABD67607B} +// *********************************************************************// + _CaseInsensitiveComparerDisp = dispinterface + ['{EA6795AC-97D6-3377-BE64-829ABD67607B}'] + end; + {$EXTERNALSYM _CaseInsensitiveComparerDisp} + +// *********************************************************************// +// Interface: IHashCodeProvider +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {5D573036-3435-3C5A-AEFF-2B8191082C71} +// *********************************************************************// + IHashCodeProvider = interface(IDispatch) + ['{5D573036-3435-3C5A-AEFF-2B8191082C71}'] + function GetHashCode(obj: OleVariant): Integer; safecall; + end; + +// *********************************************************************// +// DispIntf: IHashCodeProviderDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {5D573036-3435-3C5A-AEFF-2B8191082C71} +// *********************************************************************// + IHashCodeProviderDisp = dispinterface + ['{5D573036-3435-3C5A-AEFF-2B8191082C71}'] + function GetHashCode(obj: OleVariant): Integer; dispid 1610743808; + end; + {$EXTERNALSYM IHashCodeProviderDisp} + +// *********************************************************************// +// Interface: _CaseInsensitiveHashCodeProvider +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0422B845-B636-3688-8F61-9B6D93096336} +// *********************************************************************// + _CaseInsensitiveHashCodeProvider = interface(IDispatch) + ['{0422B845-B636-3688-8F61-9B6D93096336}'] + end; + +// *********************************************************************// +// DispIntf: _CaseInsensitiveHashCodeProviderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0422B845-B636-3688-8F61-9B6D93096336} +// *********************************************************************// + _CaseInsensitiveHashCodeProviderDisp = dispinterface + ['{0422B845-B636-3688-8F61-9B6D93096336}'] + end; + {$EXTERNALSYM _CaseInsensitiveHashCodeProviderDisp} + +// *********************************************************************// +// Interface: _CollectionBase +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B7D29E26-7798-3FA4-90F4-E6A22D2099F9} +// *********************************************************************// + _CollectionBase = interface(IDispatch) + ['{B7D29E26-7798-3FA4-90F4-E6A22D2099F9}'] + end; + +// *********************************************************************// +// DispIntf: _CollectionBaseDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B7D29E26-7798-3FA4-90F4-E6A22D2099F9} +// *********************************************************************// + _CollectionBaseDisp = dispinterface + ['{B7D29E26-7798-3FA4-90F4-E6A22D2099F9}'] + end; + {$EXTERNALSYM _CollectionBaseDisp} + +// *********************************************************************// +// Interface: _Comparer +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8064A157-B5C8-3A4A-AD3D-02DC1A39C417} +// *********************************************************************// + _Comparer = interface(IDispatch) + ['{8064A157-B5C8-3A4A-AD3D-02DC1A39C417}'] + end; + +// *********************************************************************// +// DispIntf: _ComparerDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8064A157-B5C8-3A4A-AD3D-02DC1A39C417} +// *********************************************************************// + _ComparerDisp = dispinterface + ['{8064A157-B5C8-3A4A-AD3D-02DC1A39C417}'] + end; + {$EXTERNALSYM _ComparerDisp} + +// *********************************************************************// +// Interface: IDictionary +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {6A6841DF-3287-3D87-8060-CE0B4C77D2A1} +// *********************************************************************// + IDictionary = interface(IDispatch) + ['{6A6841DF-3287-3D87-8060-CE0B4C77D2A1}'] + function Get_Item(key: OleVariant): OleVariant; safecall; + procedure _Set_Item(key: OleVariant; pRetVal: OleVariant); safecall; + function Get_Keys: ICollection; safecall; + function Get_Values: ICollection; safecall; + function Contains(key: OleVariant): WordBool; safecall; + procedure Add(key: OleVariant; value: OleVariant); safecall; + procedure Clear; safecall; + function Get_IsReadOnly: WordBool; safecall; + function Get_IsFixedSize: WordBool; safecall; + function GetEnumerator: IDictionaryEnumerator; safecall; + procedure Remove(key: OleVariant); safecall; + property Item[key: OleVariant]: OleVariant read Get_Item write _Set_Item; default; + property Keys: ICollection read Get_Keys; + property Values: ICollection read Get_Values; + property IsReadOnly: WordBool read Get_IsReadOnly; + property IsFixedSize: WordBool read Get_IsFixedSize; + end; + +// *********************************************************************// +// DispIntf: IDictionaryDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {6A6841DF-3287-3D87-8060-CE0B4C77D2A1} +// *********************************************************************// + IDictionaryDisp = dispinterface + ['{6A6841DF-3287-3D87-8060-CE0B4C77D2A1}'] + property Item[key: OleVariant]: OleVariant dispid 0; default; + property Keys: ICollection readonly dispid 1610743810; + property Values: ICollection readonly dispid 1610743811; + function Contains(key: OleVariant): WordBool; dispid 1610743812; + procedure Add(key: OleVariant; value: OleVariant); dispid 1610743813; + procedure Clear; dispid 1610743814; + property IsReadOnly: WordBool readonly dispid 1610743815; + property IsFixedSize: WordBool readonly dispid 1610743816; + function GetEnumerator: IDictionaryEnumerator; dispid 1610743817; + procedure Remove(key: OleVariant); dispid 1610743818; + end; + {$EXTERNALSYM IDictionaryDisp} + +// *********************************************************************// +// Interface: _DictionaryBase +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DDD44DA2-BC6B-3620-9317-C0372968C741} +// *********************************************************************// + _DictionaryBase = interface(IDispatch) + ['{DDD44DA2-BC6B-3620-9317-C0372968C741}'] + end; + +// *********************************************************************// +// DispIntf: _DictionaryBaseDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DDD44DA2-BC6B-3620-9317-C0372968C741} +// *********************************************************************// + _DictionaryBaseDisp = dispinterface + ['{DDD44DA2-BC6B-3620-9317-C0372968C741}'] + end; + {$EXTERNALSYM _DictionaryBaseDisp} + +// *********************************************************************// +// Interface: IDeserializationCallback +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {AB3F47E4-C227-3B05-BF9F-94649BEF9888} +// *********************************************************************// + IDeserializationCallback = interface(IDispatch) + ['{AB3F47E4-C227-3B05-BF9F-94649BEF9888}'] + procedure OnDeserialization(sender: OleVariant); safecall; + end; + +// *********************************************************************// +// DispIntf: IDeserializationCallbackDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {AB3F47E4-C227-3B05-BF9F-94649BEF9888} +// *********************************************************************// + IDeserializationCallbackDisp = dispinterface + ['{AB3F47E4-C227-3B05-BF9F-94649BEF9888}'] + procedure OnDeserialization(sender: OleVariant); dispid 1610743808; + end; + {$EXTERNALSYM IDeserializationCallbackDisp} + +// *********************************************************************// +// Interface: _Hashtable +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D25A197E-3E69-3271-A989-23D85E97F920} +// *********************************************************************// + _Hashtable = interface(IDispatch) + ['{D25A197E-3E69-3271-A989-23D85E97F920}'] + end; + +// *********************************************************************// +// DispIntf: _HashtableDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D25A197E-3E69-3271-A989-23D85E97F920} +// *********************************************************************// + _HashtableDisp = dispinterface + ['{D25A197E-3E69-3271-A989-23D85E97F920}'] + end; + {$EXTERNALSYM _HashtableDisp} + +// *********************************************************************// +// Interface: IDictionaryEnumerator +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {35D574BF-7A4F-3588-8C19-12212A0FE4DC} +// *********************************************************************// + IDictionaryEnumerator = interface(IDispatch) + ['{35D574BF-7A4F-3588-8C19-12212A0FE4DC}'] + function Get_key: OleVariant; safecall; + function Get_value: OleVariant; safecall; + function Get_Entry: DictionaryEntry; safecall; + property key: OleVariant read Get_key; + property value: OleVariant read Get_value; + property Entry: DictionaryEntry read Get_Entry; + end; + +// *********************************************************************// +// DispIntf: IDictionaryEnumeratorDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {35D574BF-7A4F-3588-8C19-12212A0FE4DC} +// *********************************************************************// + IDictionaryEnumeratorDisp = dispinterface + ['{35D574BF-7A4F-3588-8C19-12212A0FE4DC}'] + property key: OleVariant readonly dispid 1610743808; + property value: OleVariant readonly dispid 0; + property Entry: {??DictionaryEntry}OleVariant readonly dispid 1610743810; + end; + {$EXTERNALSYM IDictionaryEnumeratorDisp} + +// *********************************************************************// +// Interface: _Queue +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3A7D3CA4-B7D1-3A2A-800C-8FC2ACFCBDA4} +// *********************************************************************// + _Queue = interface(IDispatch) + ['{3A7D3CA4-B7D1-3A2A-800C-8FC2ACFCBDA4}'] + end; + +// *********************************************************************// +// DispIntf: _QueueDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3A7D3CA4-B7D1-3A2A-800C-8FC2ACFCBDA4} +// *********************************************************************// + _QueueDisp = dispinterface + ['{3A7D3CA4-B7D1-3A2A-800C-8FC2ACFCBDA4}'] + end; + {$EXTERNALSYM _QueueDisp} + +// *********************************************************************// +// Interface: _ReadOnlyCollectionBase +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BD32D878-A59B-3E5C-BFE0-A96B1A1E9D6F} +// *********************************************************************// + _ReadOnlyCollectionBase = interface(IDispatch) + ['{BD32D878-A59B-3E5C-BFE0-A96B1A1E9D6F}'] + end; + +// *********************************************************************// +// DispIntf: _ReadOnlyCollectionBaseDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BD32D878-A59B-3E5C-BFE0-A96B1A1E9D6F} +// *********************************************************************// + _ReadOnlyCollectionBaseDisp = dispinterface + ['{BD32D878-A59B-3E5C-BFE0-A96B1A1E9D6F}'] + end; + {$EXTERNALSYM _ReadOnlyCollectionBaseDisp} + +// *********************************************************************// +// Interface: _SortedList +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {56421139-A143-3AE9-9852-1DBDFE3D6BFA} +// *********************************************************************// + _SortedList = interface(IDispatch) + ['{56421139-A143-3AE9-9852-1DBDFE3D6BFA}'] + end; + +// *********************************************************************// +// DispIntf: _SortedListDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {56421139-A143-3AE9-9852-1DBDFE3D6BFA} +// *********************************************************************// + _SortedListDisp = dispinterface + ['{56421139-A143-3AE9-9852-1DBDFE3D6BFA}'] + end; + {$EXTERNALSYM _SortedListDisp} + +// *********************************************************************// +// Interface: _Stack +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AB538809-3C2F-35D9-80E6-7BAD540484A1} +// *********************************************************************// + _Stack = interface(IDispatch) + ['{AB538809-3C2F-35D9-80E6-7BAD540484A1}'] + end; + +// *********************************************************************// +// DispIntf: _StackDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AB538809-3C2F-35D9-80E6-7BAD540484A1} +// *********************************************************************// + _StackDisp = dispinterface + ['{AB538809-3C2F-35D9-80E6-7BAD540484A1}'] + end; + {$EXTERNALSYM _StackDisp} + +// *********************************************************************// +// Interface: _ConditionalAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E40A025C-645B-3C8E-A1AC-9C5CCA279625} +// *********************************************************************// + _ConditionalAttribute = interface(IDispatch) + ['{E40A025C-645B-3C8E-A1AC-9C5CCA279625}'] + end; + +// *********************************************************************// +// DispIntf: _ConditionalAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E40A025C-645B-3C8E-A1AC-9C5CCA279625} +// *********************************************************************// + _ConditionalAttributeDisp = dispinterface + ['{E40A025C-645B-3C8E-A1AC-9C5CCA279625}'] + end; + {$EXTERNALSYM _ConditionalAttributeDisp} + +// *********************************************************************// +// Interface: _Debugger +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A9B4786C-08E3-344F-A651-2F9926DEAC5E} +// *********************************************************************// + _Debugger = interface(IDispatch) + ['{A9B4786C-08E3-344F-A651-2F9926DEAC5E}'] + end; + +// *********************************************************************// +// DispIntf: _DebuggerDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A9B4786C-08E3-344F-A651-2F9926DEAC5E} +// *********************************************************************// + _DebuggerDisp = dispinterface + ['{A9B4786C-08E3-344F-A651-2F9926DEAC5E}'] + end; + {$EXTERNALSYM _DebuggerDisp} + +// *********************************************************************// +// Interface: _DebuggerStepThroughAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3344E8B4-A5C3-3882-8D30-63792485ECCF} +// *********************************************************************// + _DebuggerStepThroughAttribute = interface(IDispatch) + ['{3344E8B4-A5C3-3882-8D30-63792485ECCF}'] + end; + +// *********************************************************************// +// DispIntf: _DebuggerStepThroughAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3344E8B4-A5C3-3882-8D30-63792485ECCF} +// *********************************************************************// + _DebuggerStepThroughAttributeDisp = dispinterface + ['{3344E8B4-A5C3-3882-8D30-63792485ECCF}'] + end; + {$EXTERNALSYM _DebuggerStepThroughAttributeDisp} + +// *********************************************************************// +// Interface: _DebuggerHiddenAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {55B6903B-55FE-35E0-804F-E42A096D2EB0} +// *********************************************************************// + _DebuggerHiddenAttribute = interface(IDispatch) + ['{55B6903B-55FE-35E0-804F-E42A096D2EB0}'] + end; + +// *********************************************************************// +// DispIntf: _DebuggerHiddenAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {55B6903B-55FE-35E0-804F-E42A096D2EB0} +// *********************************************************************// + _DebuggerHiddenAttributeDisp = dispinterface + ['{55B6903B-55FE-35E0-804F-E42A096D2EB0}'] + end; + {$EXTERNALSYM _DebuggerHiddenAttributeDisp} + +// *********************************************************************// +// Interface: _DebuggableAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {428E3627-2B1F-302C-A7E6-6388CD535E75} +// *********************************************************************// + _DebuggableAttribute = interface(IDispatch) + ['{428E3627-2B1F-302C-A7E6-6388CD535E75}'] + end; + +// *********************************************************************// +// DispIntf: _DebuggableAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {428E3627-2B1F-302C-A7E6-6388CD535E75} +// *********************************************************************// + _DebuggableAttributeDisp = dispinterface + ['{428E3627-2B1F-302C-A7E6-6388CD535E75}'] + end; + {$EXTERNALSYM _DebuggableAttributeDisp} + +// *********************************************************************// +// Interface: _StackTrace +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9A2669EC-FF84-3726-89A0-663A3EF3B5CD} +// *********************************************************************// + _StackTrace = interface(IDispatch) + ['{9A2669EC-FF84-3726-89A0-663A3EF3B5CD}'] + end; + +// *********************************************************************// +// DispIntf: _StackTraceDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9A2669EC-FF84-3726-89A0-663A3EF3B5CD} +// *********************************************************************// + _StackTraceDisp = dispinterface + ['{9A2669EC-FF84-3726-89A0-663A3EF3B5CD}'] + end; + {$EXTERNALSYM _StackTraceDisp} + +// *********************************************************************// +// Interface: _StackFrame +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0E9B8E47-CA67-38B6-B9DB-2C42EE757B08} +// *********************************************************************// + _StackFrame = interface(IDispatch) + ['{0E9B8E47-CA67-38B6-B9DB-2C42EE757B08}'] + end; + +// *********************************************************************// +// DispIntf: _StackFrameDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0E9B8E47-CA67-38B6-B9DB-2C42EE757B08} +// *********************************************************************// + _StackFrameDisp = dispinterface + ['{0E9B8E47-CA67-38B6-B9DB-2C42EE757B08}'] + end; + {$EXTERNALSYM _StackFrameDisp} + +// *********************************************************************// +// Interface: ISymbolBinder +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {20808ADC-CC01-3F3A-8F09-ED12940FC212} +// *********************************************************************// + ISymbolBinder = interface(IDispatch) + ['{20808ADC-CC01-3F3A-8F09-ED12940FC212}'] + function GetReader(importer: Integer; const filename: WideString; const searchPath: WideString): ISymbolReader; safecall; + end; + +// *********************************************************************// +// DispIntf: ISymbolBinderDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {20808ADC-CC01-3F3A-8F09-ED12940FC212} +// *********************************************************************// + ISymbolBinderDisp = dispinterface + ['{20808ADC-CC01-3F3A-8F09-ED12940FC212}'] + function GetReader(importer: Integer; const filename: WideString; const searchPath: WideString): ISymbolReader; dispid 1610743808; + end; + {$EXTERNALSYM ISymbolBinderDisp} + +// *********************************************************************// +// Interface: ISymbolDocument +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {1C32F012-2684-3EFE-8D50-9C2973ACC00B} +// *********************************************************************// + ISymbolDocument = interface(IDispatch) + ['{1C32F012-2684-3EFE-8D50-9C2973ACC00B}'] + function Get_Url: WideString; safecall; + function Get_DocumentType: TGUID; safecall; + function Get_Language: TGUID; safecall; + function Get_LanguageVendor: TGUID; safecall; + function Get_CheckSumAlgorithmId: TGUID; safecall; + function GetCheckSum: PSafeArray; safecall; + function FindClosestLine(line: Integer): Integer; safecall; + function Get_HasEmbeddedSource: WordBool; safecall; + function Get_SourceLength: Integer; safecall; + function GetSourceRange(startLine: Integer; startColumn: Integer; endLine: Integer; + endColumn: Integer): PSafeArray; safecall; + property Url: WideString read Get_Url; + property DocumentType: TGUID read Get_DocumentType; + property Language: TGUID read Get_Language; + property LanguageVendor: TGUID read Get_LanguageVendor; + property CheckSumAlgorithmId: TGUID read Get_CheckSumAlgorithmId; + property HasEmbeddedSource: WordBool read Get_HasEmbeddedSource; + property SourceLength: Integer read Get_SourceLength; + end; + +// *********************************************************************// +// DispIntf: ISymbolDocumentDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {1C32F012-2684-3EFE-8D50-9C2973ACC00B} +// *********************************************************************// + ISymbolDocumentDisp = dispinterface + ['{1C32F012-2684-3EFE-8D50-9C2973ACC00B}'] + property Url: WideString readonly dispid 1610743808; + property DocumentType: {??TGUID}OleVariant readonly dispid 1610743809; + property Language: {??TGUID}OleVariant readonly dispid 1610743810; + property LanguageVendor: {??TGUID}OleVariant readonly dispid 1610743811; + property CheckSumAlgorithmId: {??TGUID}OleVariant readonly dispid 1610743812; + function GetCheckSum: {??PSafeArray}OleVariant; dispid 1610743813; + function FindClosestLine(line: Integer): Integer; dispid 1610743814; + property HasEmbeddedSource: WordBool readonly dispid 1610743815; + property SourceLength: Integer readonly dispid 1610743816; + function GetSourceRange(startLine: Integer; startColumn: Integer; endLine: Integer; + endColumn: Integer): {??PSafeArray}OleVariant; dispid 1610743817; + end; + {$EXTERNALSYM ISymbolDocumentDisp} + +// *********************************************************************// +// Interface: ISymbolDocumentWriter +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {FA682F24-3A3C-390D-B8A2-96F1106F4B37} +// *********************************************************************// + ISymbolDocumentWriter = interface(IDispatch) + ['{FA682F24-3A3C-390D-B8A2-96F1106F4B37}'] + procedure SetSource(Source: PSafeArray); safecall; + procedure SetCheckSum(algorithmId: TGUID; checkSum: PSafeArray); safecall; + end; + +// *********************************************************************// +// DispIntf: ISymbolDocumentWriterDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {FA682F24-3A3C-390D-B8A2-96F1106F4B37} +// *********************************************************************// + ISymbolDocumentWriterDisp = dispinterface + ['{FA682F24-3A3C-390D-B8A2-96F1106F4B37}'] + procedure SetSource(Source: {??PSafeArray}OleVariant); dispid 1610743808; + procedure SetCheckSum(algorithmId: {??TGUID}OleVariant; checkSum: {??PSafeArray}OleVariant); dispid 1610743809; + end; + {$EXTERNALSYM ISymbolDocumentWriterDisp} + +// *********************************************************************// +// Interface: ISymbolMethod +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {25C72EB0-E437-3F17-946D-3B72A3ACFF37} +// *********************************************************************// + ISymbolMethod = interface(IDispatch) + ['{25C72EB0-E437-3F17-946D-3B72A3ACFF37}'] + function Get_Token: SymbolToken; safecall; + function Get_SequencePointCount: Integer; safecall; + procedure GetSequencePoints(offsets: PSafeArray; documents: PSafeArray; lines: PSafeArray; + columns: PSafeArray; endLines: PSafeArray; endColumns: PSafeArray); safecall; + function Get_RootScope: ISymbolScope; safecall; + function GetScope(offset: Integer): ISymbolScope; safecall; + function GetOffset(const document: ISymbolDocument; line: Integer; column: Integer): Integer; safecall; + function GetRanges(const document: ISymbolDocument; line: Integer; column: Integer): PSafeArray; safecall; + function GetParameters: PSafeArray; safecall; + function GetNamespace: ISymbolNamespace; safecall; + function GetSourceStartEnd(docs: PSafeArray; lines: PSafeArray; columns: PSafeArray): WordBool; safecall; + property Token: SymbolToken read Get_Token; + property SequencePointCount: Integer read Get_SequencePointCount; + property RootScope: ISymbolScope read Get_RootScope; + end; + +// *********************************************************************// +// DispIntf: ISymbolMethodDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {25C72EB0-E437-3F17-946D-3B72A3ACFF37} +// *********************************************************************// + ISymbolMethodDisp = dispinterface + ['{25C72EB0-E437-3F17-946D-3B72A3ACFF37}'] + property Token: {??SymbolToken}OleVariant readonly dispid 1610743808; + property SequencePointCount: Integer readonly dispid 1610743809; + procedure GetSequencePoints(offsets: {??PSafeArray}OleVariant; + documents: {??PSafeArray}OleVariant; + lines: {??PSafeArray}OleVariant; columns: {??PSafeArray}OleVariant; + endLines: {??PSafeArray}OleVariant; + endColumns: {??PSafeArray}OleVariant); dispid 1610743810; + property RootScope: ISymbolScope readonly dispid 1610743811; + function GetScope(offset: Integer): ISymbolScope; dispid 1610743812; + function GetOffset(const document: ISymbolDocument; line: Integer; column: Integer): Integer; dispid 1610743813; + function GetRanges(const document: ISymbolDocument; line: Integer; column: Integer): {??PSafeArray}OleVariant; dispid 1610743814; + function GetParameters: {??PSafeArray}OleVariant; dispid 1610743815; + function GetNamespace: ISymbolNamespace; dispid 1610743816; + function GetSourceStartEnd(docs: {??PSafeArray}OleVariant; lines: {??PSafeArray}OleVariant; + columns: {??PSafeArray}OleVariant): WordBool; dispid 1610743817; + end; + {$EXTERNALSYM ISymbolMethodDisp} + +// *********************************************************************// +// Interface: ISymbolNamespace +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {23ED2454-6899-3C28-BAB7-6EC86683964A} +// *********************************************************************// + ISymbolNamespace = interface(IDispatch) + ['{23ED2454-6899-3C28-BAB7-6EC86683964A}'] + function Get_name: WideString; safecall; + function GetNamespaces: PSafeArray; safecall; + function GetVariables: PSafeArray; safecall; + property name: WideString read Get_name; + end; + +// *********************************************************************// +// DispIntf: ISymbolNamespaceDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {23ED2454-6899-3C28-BAB7-6EC86683964A} +// *********************************************************************// + ISymbolNamespaceDisp = dispinterface + ['{23ED2454-6899-3C28-BAB7-6EC86683964A}'] + property name: WideString readonly dispid 1610743808; + function GetNamespaces: {??PSafeArray}OleVariant; dispid 1610743809; + function GetVariables: {??PSafeArray}OleVariant; dispid 1610743810; + end; + {$EXTERNALSYM ISymbolNamespaceDisp} + +// *********************************************************************// +// Interface: ISymbolReader +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {E809A5F1-D3D7-3144-9BEF-FE8AC0364699} +// *********************************************************************// + ISymbolReader = interface(IDispatch) + ['{E809A5F1-D3D7-3144-9BEF-FE8AC0364699}'] + function GetDocument(const Url: WideString; Language: TGUID; LanguageVendor: TGUID; + DocumentType: TGUID): ISymbolDocument; safecall; + function GetDocuments: PSafeArray; safecall; + function Get_UserEntryPoint: SymbolToken; safecall; + function GetMethod(Method: SymbolToken): ISymbolMethod; safecall; + function GetMethod_2(Method: SymbolToken; Version: Integer): ISymbolMethod; safecall; + function GetVariables(parent: SymbolToken): PSafeArray; safecall; + function GetGlobalVariables: PSafeArray; safecall; + function GetMethodFromDocumentPosition(const document: ISymbolDocument; line: Integer; + column: Integer): ISymbolMethod; safecall; + function GetSymAttribute(parent: SymbolToken; const name: WideString): PSafeArray; safecall; + function GetNamespaces: PSafeArray; safecall; + property UserEntryPoint: SymbolToken read Get_UserEntryPoint; + end; + +// *********************************************************************// +// DispIntf: ISymbolReaderDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {E809A5F1-D3D7-3144-9BEF-FE8AC0364699} +// *********************************************************************// + ISymbolReaderDisp = dispinterface + ['{E809A5F1-D3D7-3144-9BEF-FE8AC0364699}'] + function GetDocument(const Url: WideString; Language: {??TGUID}OleVariant; + LanguageVendor: {??TGUID}OleVariant; DocumentType: {??TGUID}OleVariant): ISymbolDocument; dispid 1610743808; + function GetDocuments: {??PSafeArray}OleVariant; dispid 1610743809; + property UserEntryPoint: {??SymbolToken}OleVariant readonly dispid 1610743810; + function GetMethod(Method: {??SymbolToken}OleVariant): ISymbolMethod; dispid 1610743811; + function GetMethod_2(Method: {??SymbolToken}OleVariant; Version: Integer): ISymbolMethod; dispid 1610743812; + function GetVariables(parent: {??SymbolToken}OleVariant): {??PSafeArray}OleVariant; dispid 1610743813; + function GetGlobalVariables: {??PSafeArray}OleVariant; dispid 1610743814; + function GetMethodFromDocumentPosition(const document: ISymbolDocument; line: Integer; + column: Integer): ISymbolMethod; dispid 1610743815; + function GetSymAttribute(parent: {??SymbolToken}OleVariant; const name: WideString): {??PSafeArray}OleVariant; dispid 1610743816; + function GetNamespaces: {??PSafeArray}OleVariant; dispid 1610743817; + end; + {$EXTERNALSYM ISymbolReaderDisp} + +// *********************************************************************// +// Interface: ISymbolScope +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {1CEE3A11-01AE-3244-A939-4972FC9703EF} +// *********************************************************************// + ISymbolScope = interface(IDispatch) + ['{1CEE3A11-01AE-3244-A939-4972FC9703EF}'] + function Get_Method: ISymbolMethod; safecall; + function Get_parent: ISymbolScope; safecall; + function GetChildren: PSafeArray; safecall; + function Get_StartOffset: Integer; safecall; + function Get_EndOffset: Integer; safecall; + function GetLocals: PSafeArray; safecall; + function GetNamespaces: PSafeArray; safecall; + property Method: ISymbolMethod read Get_Method; + property parent: ISymbolScope read Get_parent; + property StartOffset: Integer read Get_StartOffset; + property EndOffset: Integer read Get_EndOffset; + end; + +// *********************************************************************// +// DispIntf: ISymbolScopeDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {1CEE3A11-01AE-3244-A939-4972FC9703EF} +// *********************************************************************// + ISymbolScopeDisp = dispinterface + ['{1CEE3A11-01AE-3244-A939-4972FC9703EF}'] + property Method: ISymbolMethod readonly dispid 1610743808; + property parent: ISymbolScope readonly dispid 1610743809; + function GetChildren: {??PSafeArray}OleVariant; dispid 1610743810; + property StartOffset: Integer readonly dispid 1610743811; + property EndOffset: Integer readonly dispid 1610743812; + function GetLocals: {??PSafeArray}OleVariant; dispid 1610743813; + function GetNamespaces: {??PSafeArray}OleVariant; dispid 1610743814; + end; + {$EXTERNALSYM ISymbolScopeDisp} + +// *********************************************************************// +// Interface: ISymbolVariable +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {4042BD4D-B5AB-30E8-919B-14910687BAAE} +// *********************************************************************// + ISymbolVariable = interface(IDispatch) + ['{4042BD4D-B5AB-30E8-919B-14910687BAAE}'] + function Get_name: WideString; safecall; + function Get_Attributes: OleVariant; safecall; + function GetSignature: PSafeArray; safecall; + function Get_AddressKind: SymAddressKind; safecall; + function Get_AddressField1: Integer; safecall; + function Get_AddressField2: Integer; safecall; + function Get_AddressField3: Integer; safecall; + function Get_StartOffset: Integer; safecall; + function Get_EndOffset: Integer; safecall; + property name: WideString read Get_name; + property Attributes: OleVariant read Get_Attributes; + property AddressKind: SymAddressKind read Get_AddressKind; + property AddressField1: Integer read Get_AddressField1; + property AddressField2: Integer read Get_AddressField2; + property AddressField3: Integer read Get_AddressField3; + property StartOffset: Integer read Get_StartOffset; + property EndOffset: Integer read Get_EndOffset; + end; + +// *********************************************************************// +// DispIntf: ISymbolVariableDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {4042BD4D-B5AB-30E8-919B-14910687BAAE} +// *********************************************************************// + ISymbolVariableDisp = dispinterface + ['{4042BD4D-B5AB-30E8-919B-14910687BAAE}'] + property name: WideString readonly dispid 1610743808; + property Attributes: OleVariant readonly dispid 1610743809; + function GetSignature: {??PSafeArray}OleVariant; dispid 1610743810; + property AddressKind: SymAddressKind readonly dispid 1610743811; + property AddressField1: Integer readonly dispid 1610743812; + property AddressField2: Integer readonly dispid 1610743813; + property AddressField3: Integer readonly dispid 1610743814; + property StartOffset: Integer readonly dispid 1610743815; + property EndOffset: Integer readonly dispid 1610743816; + end; + {$EXTERNALSYM ISymbolVariableDisp} + +// *********************************************************************// +// Interface: ISymbolWriter +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {DA295A1B-C5BD-3B34-8ACD-1D7D334FFB7F} +// *********************************************************************// + ISymbolWriter = interface(IDispatch) + ['{DA295A1B-C5BD-3B34-8ACD-1D7D334FFB7F}'] + procedure Initialize(emitter: Integer; const filename: WideString; fFullBuild: WordBool); safecall; + function DefineDocument(const Url: WideString; Language: TGUID; LanguageVendor: TGUID; + DocumentType: TGUID): ISymbolDocumentWriter; safecall; + procedure SetUserEntryPoint(entryMethod: SymbolToken); safecall; + procedure OpenMethod(Method: SymbolToken); safecall; + procedure CloseMethod; safecall; + procedure DefineSequencePoints(const document: ISymbolDocumentWriter; offsets: PSafeArray; + lines: PSafeArray; columns: PSafeArray; endLines: PSafeArray; + endColumns: PSafeArray); safecall; + function OpenScope(StartOffset: Integer): Integer; safecall; + procedure CloseScope(EndOffset: Integer); safecall; + procedure SetScopeRange(scopeID: Integer; StartOffset: Integer; EndOffset: Integer); safecall; + procedure DefineLocalVariable(const name: WideString; Attributes: FieldAttributes; + signature: PSafeArray; addrKind: SymAddressKind; addr1: Integer; + addr2: Integer; addr3: Integer; StartOffset: Integer; + EndOffset: Integer); safecall; + procedure DefineParameter(const name: WideString; Attributes: ParameterAttributes; + sequence: Integer; addrKind: SymAddressKind; addr1: Integer; + addr2: Integer; addr3: Integer); safecall; + procedure DefineField(parent: SymbolToken; const name: WideString; Attributes: FieldAttributes; + signature: PSafeArray; addrKind: SymAddressKind; addr1: Integer; + addr2: Integer; addr3: Integer); safecall; + procedure DefineGlobalVariable(const name: WideString; Attributes: FieldAttributes; + signature: PSafeArray; addrKind: SymAddressKind; addr1: Integer; + addr2: Integer; addr3: Integer); safecall; + procedure Close; safecall; + procedure SetSymAttribute(parent: SymbolToken; const name: WideString; data: PSafeArray); safecall; + procedure OpenNamespace(const name: WideString); safecall; + procedure CloseNamespace; safecall; + procedure UsingNamespace(const FullName: WideString); safecall; + procedure SetMethodSourceRange(const startDoc: ISymbolDocumentWriter; startLine: Integer; + startColumn: Integer; const endDoc: ISymbolDocumentWriter; + endLine: Integer; endColumn: Integer); safecall; + procedure SetUnderlyingWriter(underlyingWriter: Integer); safecall; + end; + +// *********************************************************************// +// DispIntf: ISymbolWriterDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {DA295A1B-C5BD-3B34-8ACD-1D7D334FFB7F} +// *********************************************************************// + ISymbolWriterDisp = dispinterface + ['{DA295A1B-C5BD-3B34-8ACD-1D7D334FFB7F}'] + procedure Initialize(emitter: Integer; const filename: WideString; fFullBuild: WordBool); dispid 1610743808; + function DefineDocument(const Url: WideString; Language: {??TGUID}OleVariant; + LanguageVendor: {??TGUID}OleVariant; DocumentType: {??TGUID}OleVariant): ISymbolDocumentWriter; dispid 1610743809; + procedure SetUserEntryPoint(entryMethod: {??SymbolToken}OleVariant); dispid 1610743810; + procedure OpenMethod(Method: {??SymbolToken}OleVariant); dispid 1610743811; + procedure CloseMethod; dispid 1610743812; + procedure DefineSequencePoints(const document: ISymbolDocumentWriter; + offsets: {??PSafeArray}OleVariant; + lines: {??PSafeArray}OleVariant; + columns: {??PSafeArray}OleVariant; + endLines: {??PSafeArray}OleVariant; + endColumns: {??PSafeArray}OleVariant); dispid 1610743813; + function OpenScope(StartOffset: Integer): Integer; dispid 1610743814; + procedure CloseScope(EndOffset: Integer); dispid 1610743815; + procedure SetScopeRange(scopeID: Integer; StartOffset: Integer; EndOffset: Integer); dispid 1610743816; + procedure DefineLocalVariable(const name: WideString; Attributes: FieldAttributes; + signature: {??PSafeArray}OleVariant; addrKind: SymAddressKind; + addr1: Integer; addr2: Integer; addr3: Integer; + StartOffset: Integer; EndOffset: Integer); dispid 1610743817; + procedure DefineParameter(const name: WideString; Attributes: ParameterAttributes; + sequence: Integer; addrKind: SymAddressKind; addr1: Integer; + addr2: Integer; addr3: Integer); dispid 1610743818; + procedure DefineField(parent: {??SymbolToken}OleVariant; const name: WideString; + Attributes: FieldAttributes; signature: {??PSafeArray}OleVariant; + addrKind: SymAddressKind; addr1: Integer; addr2: Integer; addr3: Integer); dispid 1610743819; + procedure DefineGlobalVariable(const name: WideString; Attributes: FieldAttributes; + signature: {??PSafeArray}OleVariant; addrKind: SymAddressKind; + addr1: Integer; addr2: Integer; addr3: Integer); dispid 1610743820; + procedure Close; dispid 1610743821; + procedure SetSymAttribute(parent: {??SymbolToken}OleVariant; const name: WideString; + data: {??PSafeArray}OleVariant); dispid 1610743822; + procedure OpenNamespace(const name: WideString); dispid 1610743823; + procedure CloseNamespace; dispid 1610743824; + procedure UsingNamespace(const FullName: WideString); dispid 1610743825; + procedure SetMethodSourceRange(const startDoc: ISymbolDocumentWriter; startLine: Integer; + startColumn: Integer; const endDoc: ISymbolDocumentWriter; + endLine: Integer; endColumn: Integer); dispid 1610743826; + procedure SetUnderlyingWriter(underlyingWriter: Integer); dispid 1610743827; + end; + {$EXTERNALSYM ISymbolWriterDisp} + +// *********************************************************************// +// Interface: _SymDocumentType +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {5141D79C-7B01-37DA-B7E9-53E5A271BAF8} +// *********************************************************************// + _SymDocumentType = interface(IDispatch) + ['{5141D79C-7B01-37DA-B7E9-53E5A271BAF8}'] + end; + +// *********************************************************************// +// DispIntf: _SymDocumentTypeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {5141D79C-7B01-37DA-B7E9-53E5A271BAF8} +// *********************************************************************// + _SymDocumentTypeDisp = dispinterface + ['{5141D79C-7B01-37DA-B7E9-53E5A271BAF8}'] + end; + {$EXTERNALSYM _SymDocumentTypeDisp} + +// *********************************************************************// +// Interface: _SymLanguageType +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {22BB8891-FD21-313D-92E4-8A892DC0B39C} +// *********************************************************************// + _SymLanguageType = interface(IDispatch) + ['{22BB8891-FD21-313D-92E4-8A892DC0B39C}'] + end; + +// *********************************************************************// +// DispIntf: _SymLanguageTypeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {22BB8891-FD21-313D-92E4-8A892DC0B39C} +// *********************************************************************// + _SymLanguageTypeDisp = dispinterface + ['{22BB8891-FD21-313D-92E4-8A892DC0B39C}'] + end; + {$EXTERNALSYM _SymLanguageTypeDisp} + +// *********************************************************************// +// Interface: _SymLanguageVendor +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {01364E7B-C983-3651-B7D8-FD1B64FC0E00} +// *********************************************************************// + _SymLanguageVendor = interface(IDispatch) + ['{01364E7B-C983-3651-B7D8-FD1B64FC0E00}'] + end; + +// *********************************************************************// +// DispIntf: _SymLanguageVendorDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {01364E7B-C983-3651-B7D8-FD1B64FC0E00} +// *********************************************************************// + _SymLanguageVendorDisp = dispinterface + ['{01364E7B-C983-3651-B7D8-FD1B64FC0E00}'] + end; + {$EXTERNALSYM _SymLanguageVendorDisp} + +// *********************************************************************// +// Interface: _AmbiguousMatchException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {81AA0D59-C3B1-36A3-B2E7-054928FBFC1A} +// *********************************************************************// + _AmbiguousMatchException = interface(IDispatch) + ['{81AA0D59-C3B1-36A3-B2E7-054928FBFC1A}'] + end; + +// *********************************************************************// +// DispIntf: _AmbiguousMatchExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {81AA0D59-C3B1-36A3-B2E7-054928FBFC1A} +// *********************************************************************// + _AmbiguousMatchExceptionDisp = dispinterface + ['{81AA0D59-C3B1-36A3-B2E7-054928FBFC1A}'] + end; + {$EXTERNALSYM _AmbiguousMatchExceptionDisp} + +// *********************************************************************// +// Interface: _ModuleResolveEventHandler +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {05532E88-E0F2-3263-9B57-805AC6B6BB72} +// *********************************************************************// + _ModuleResolveEventHandler = interface(IDispatch) + ['{05532E88-E0F2-3263-9B57-805AC6B6BB72}'] + end; + +// *********************************************************************// +// DispIntf: _ModuleResolveEventHandlerDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {05532E88-E0F2-3263-9B57-805AC6B6BB72} +// *********************************************************************// + _ModuleResolveEventHandlerDisp = dispinterface + ['{05532E88-E0F2-3263-9B57-805AC6B6BB72}'] + end; + {$EXTERNALSYM _ModuleResolveEventHandlerDisp} + +// *********************************************************************// +// Interface: _Assembly +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {17156360-2F1A-384A-BC52-FDE93C215C5B} +// *********************************************************************// + _Assembly = interface(IDispatch) + ['{17156360-2F1A-384A-BC52-FDE93C215C5B}'] + function Get_ToString: WideString; safecall; + function Equals(obj: OleVariant): WordBool; safecall; + function GetHashCode: Integer; safecall; + function GetType: _Type; safecall; + function Get_CodeBase: WideString; safecall; + function Get_EscapedCodeBase: WideString; safecall; + function GetName: _AssemblyName; safecall; + function GetName_2(copiedName: WordBool): _AssemblyName; safecall; + function Get_FullName: WideString; safecall; + function Get_EntryPoint: _MethodInfo; safecall; + function GetType_2(const name: WideString): _Type; safecall; + function GetType_3(const name: WideString; throwOnError: WordBool): _Type; safecall; + function GetExportedTypes: PSafeArray; safecall; + function GetTypes: PSafeArray; safecall; + function GetManifestResourceStream(const Type_: _Type; const name: WideString): _Stream; safecall; + function GetManifestResourceStream_2(const name: WideString): _Stream; safecall; + function GetFile(const name: WideString): _FileStream; safecall; + function GetFiles: PSafeArray; safecall; + function GetFiles_2(getResourceModules: WordBool): PSafeArray; safecall; + function GetManifestResourceNames: PSafeArray; safecall; + function GetManifestResourceInfo(const resourceName: WideString): _ManifestResourceInfo; safecall; + function Get_Location: WideString; safecall; + function Get_Evidence: _Evidence; safecall; + function GetCustomAttributes(const attributeType: _Type; inherit: WordBool): PSafeArray; safecall; + function GetCustomAttributes_2(inherit: WordBool): PSafeArray; safecall; + function IsDefined(const attributeType: _Type; inherit: WordBool): WordBool; safecall; + procedure GetObjectData(const info: _SerializationInfo; Context: StreamingContext); safecall; + procedure add_ModuleResolve(const value: _ModuleResolveEventHandler); safecall; + procedure remove_ModuleResolve(const value: _ModuleResolveEventHandler); safecall; + function GetType_4(const name: WideString; throwOnError: WordBool; ignoreCase: WordBool): _Type; safecall; + function GetSatelliteAssembly(const culture: _CultureInfo): _Assembly; safecall; + function GetSatelliteAssembly_2(const culture: _CultureInfo; const Version: _Version): _Assembly; safecall; + function LoadModule(const moduleName: WideString; rawModule: PSafeArray): _Module; safecall; + function LoadModule_2(const moduleName: WideString; rawModule: PSafeArray; + rawSymbolStore: PSafeArray): _Module; safecall; + function CreateInstance(const typeName: WideString): OleVariant; safecall; + function CreateInstance_2(const typeName: WideString; ignoreCase: WordBool): OleVariant; safecall; + function CreateInstance_3(const typeName: WideString; ignoreCase: WordBool; + bindingAttr: BindingFlags; const Binder: _Binder; args: PSafeArray; + const culture: _CultureInfo; activationAttributes: PSafeArray): OleVariant; safecall; + function GetLoadedModules: PSafeArray; safecall; + function GetLoadedModules_2(getResourceModules: WordBool): PSafeArray; safecall; + function GetModules: PSafeArray; safecall; + function GetModules_2(getResourceModules: WordBool): PSafeArray; safecall; + function GetModule(const name: WideString): _Module; safecall; + function GetReferencedAssemblies: PSafeArray; safecall; + function Get_GlobalAssemblyCache: WordBool; safecall; + property ToString: WideString read Get_ToString; + property CodeBase: WideString read Get_CodeBase; + property EscapedCodeBase: WideString read Get_EscapedCodeBase; + property FullName: WideString read Get_FullName; + property EntryPoint: _MethodInfo read Get_EntryPoint; + property Location: WideString read Get_Location; + property Evidence: _Evidence read Get_Evidence; + property GlobalAssemblyCache: WordBool read Get_GlobalAssemblyCache; + end; + +// *********************************************************************// +// DispIntf: _AssemblyDisp +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {17156360-2F1A-384A-BC52-FDE93C215C5B} +// *********************************************************************// + _AssemblyDisp = dispinterface + ['{17156360-2F1A-384A-BC52-FDE93C215C5B}'] + property ToString: WideString readonly dispid 0; + function Equals(obj: OleVariant): WordBool; dispid 1610743809; + function GetHashCode: Integer; dispid 1610743810; + function GetType: _Type; dispid 1610743811; + property CodeBase: WideString readonly dispid 1610743812; + property EscapedCodeBase: WideString readonly dispid 1610743813; + function GetName: _AssemblyName; dispid 1610743814; + function GetName_2(copiedName: WordBool): _AssemblyName; dispid 1610743815; + property FullName: WideString readonly dispid 1610743816; + property EntryPoint: _MethodInfo readonly dispid 1610743817; + function GetType_2(const name: WideString): _Type; dispid 1610743818; + function GetType_3(const name: WideString; throwOnError: WordBool): _Type; dispid 1610743819; + function GetExportedTypes: {??PSafeArray}OleVariant; dispid 1610743820; + function GetTypes: {??PSafeArray}OleVariant; dispid 1610743821; + function GetManifestResourceStream(const Type_: _Type; const name: WideString): _Stream; dispid 1610743822; + function GetManifestResourceStream_2(const name: WideString): _Stream; dispid 1610743823; + function GetFile(const name: WideString): _FileStream; dispid 1610743824; + function GetFiles: {??PSafeArray}OleVariant; dispid 1610743825; + function GetFiles_2(getResourceModules: WordBool): {??PSafeArray}OleVariant; dispid 1610743826; + function GetManifestResourceNames: {??PSafeArray}OleVariant; dispid 1610743827; + function GetManifestResourceInfo(const resourceName: WideString): _ManifestResourceInfo; dispid 1610743828; + property Location: WideString readonly dispid 1610743829; + property Evidence: _Evidence readonly dispid 1610743830; + function GetCustomAttributes(const attributeType: _Type; inherit: WordBool): {??PSafeArray}OleVariant; dispid 1610743831; + function GetCustomAttributes_2(inherit: WordBool): {??PSafeArray}OleVariant; dispid 1610743832; + function IsDefined(const attributeType: _Type; inherit: WordBool): WordBool; dispid 1610743833; + procedure GetObjectData(const info: _SerializationInfo; Context: {??StreamingContext}OleVariant); dispid 1610743834; + procedure add_ModuleResolve(const value: _ModuleResolveEventHandler); dispid 1610743835; + procedure remove_ModuleResolve(const value: _ModuleResolveEventHandler); dispid 1610743836; + function GetType_4(const name: WideString; throwOnError: WordBool; ignoreCase: WordBool): _Type; dispid 1610743837; + function GetSatelliteAssembly(const culture: _CultureInfo): _Assembly; dispid 1610743838; + function GetSatelliteAssembly_2(const culture: _CultureInfo; const Version: _Version): _Assembly; dispid 1610743839; + function LoadModule(const moduleName: WideString; rawModule: {??PSafeArray}OleVariant): _Module; dispid 1610743840; + function LoadModule_2(const moduleName: WideString; rawModule: {??PSafeArray}OleVariant; + rawSymbolStore: {??PSafeArray}OleVariant): _Module; dispid 1610743841; + function CreateInstance(const typeName: WideString): OleVariant; dispid 1610743842; + function CreateInstance_2(const typeName: WideString; ignoreCase: WordBool): OleVariant; dispid 1610743843; + function CreateInstance_3(const typeName: WideString; ignoreCase: WordBool; + bindingAttr: BindingFlags; const Binder: _Binder; + args: {??PSafeArray}OleVariant; const culture: _CultureInfo; + activationAttributes: {??PSafeArray}OleVariant): OleVariant; dispid 1610743844; + function GetLoadedModules: {??PSafeArray}OleVariant; dispid 1610743845; + function GetLoadedModules_2(getResourceModules: WordBool): {??PSafeArray}OleVariant; dispid 1610743846; + function GetModules: {??PSafeArray}OleVariant; dispid 1610743847; + function GetModules_2(getResourceModules: WordBool): {??PSafeArray}OleVariant; dispid 1610743848; + function GetModule(const name: WideString): _Module; dispid 1610743849; + function GetReferencedAssemblies: {??PSafeArray}OleVariant; dispid 1610743850; + property GlobalAssemblyCache: WordBool readonly dispid 1610743851; + end; + {$EXTERNALSYM _AssemblyDisp} + +// *********************************************************************// +// Interface: _AssemblyCultureAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {177C4E63-9E0B-354D-838B-B52AA8683EF6} +// *********************************************************************// + _AssemblyCultureAttribute = interface(IDispatch) + ['{177C4E63-9E0B-354D-838B-B52AA8683EF6}'] + end; + +// *********************************************************************// +// DispIntf: _AssemblyCultureAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {177C4E63-9E0B-354D-838B-B52AA8683EF6} +// *********************************************************************// + _AssemblyCultureAttributeDisp = dispinterface + ['{177C4E63-9E0B-354D-838B-B52AA8683EF6}'] + end; + {$EXTERNALSYM _AssemblyCultureAttributeDisp} + +// *********************************************************************// +// Interface: _AssemblyVersionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A1693C5C-101F-3557-94DB-C480CEB4C16B} +// *********************************************************************// + _AssemblyVersionAttribute = interface(IDispatch) + ['{A1693C5C-101F-3557-94DB-C480CEB4C16B}'] + end; + +// *********************************************************************// +// DispIntf: _AssemblyVersionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A1693C5C-101F-3557-94DB-C480CEB4C16B} +// *********************************************************************// + _AssemblyVersionAttributeDisp = dispinterface + ['{A1693C5C-101F-3557-94DB-C480CEB4C16B}'] + end; + {$EXTERNALSYM _AssemblyVersionAttributeDisp} + +// *********************************************************************// +// Interface: _AssemblyKeyFileAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A9FCDA18-C237-3C6F-A6EF-749BE22BA2BF} +// *********************************************************************// + _AssemblyKeyFileAttribute = interface(IDispatch) + ['{A9FCDA18-C237-3C6F-A6EF-749BE22BA2BF}'] + end; + +// *********************************************************************// +// DispIntf: _AssemblyKeyFileAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A9FCDA18-C237-3C6F-A6EF-749BE22BA2BF} +// *********************************************************************// + _AssemblyKeyFileAttributeDisp = dispinterface + ['{A9FCDA18-C237-3C6F-A6EF-749BE22BA2BF}'] + end; + {$EXTERNALSYM _AssemblyKeyFileAttributeDisp} + +// *********************************************************************// +// Interface: _AssemblyKeyNameAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {322A304D-11AC-3814-A905-A019F6E3DAE9} +// *********************************************************************// + _AssemblyKeyNameAttribute = interface(IDispatch) + ['{322A304D-11AC-3814-A905-A019F6E3DAE9}'] + end; + +// *********************************************************************// +// DispIntf: _AssemblyKeyNameAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {322A304D-11AC-3814-A905-A019F6E3DAE9} +// *********************************************************************// + _AssemblyKeyNameAttributeDisp = dispinterface + ['{322A304D-11AC-3814-A905-A019F6E3DAE9}'] + end; + {$EXTERNALSYM _AssemblyKeyNameAttributeDisp} + +// *********************************************************************// +// Interface: _AssemblyDelaySignAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6CF1C077-C974-38E1-90A4-976E4835E165} +// *********************************************************************// + _AssemblyDelaySignAttribute = interface(IDispatch) + ['{6CF1C077-C974-38E1-90A4-976E4835E165}'] + end; + +// *********************************************************************// +// DispIntf: _AssemblyDelaySignAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6CF1C077-C974-38E1-90A4-976E4835E165} +// *********************************************************************// + _AssemblyDelaySignAttributeDisp = dispinterface + ['{6CF1C077-C974-38E1-90A4-976E4835E165}'] + end; + {$EXTERNALSYM _AssemblyDelaySignAttributeDisp} + +// *********************************************************************// +// Interface: _AssemblyAlgorithmIdAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {57B849AA-D8EF-3EA6-9538-C5B4D498C2F7} +// *********************************************************************// + _AssemblyAlgorithmIdAttribute = interface(IDispatch) + ['{57B849AA-D8EF-3EA6-9538-C5B4D498C2F7}'] + end; + +// *********************************************************************// +// DispIntf: _AssemblyAlgorithmIdAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {57B849AA-D8EF-3EA6-9538-C5B4D498C2F7} +// *********************************************************************// + _AssemblyAlgorithmIdAttributeDisp = dispinterface + ['{57B849AA-D8EF-3EA6-9538-C5B4D498C2F7}'] + end; + {$EXTERNALSYM _AssemblyAlgorithmIdAttributeDisp} + +// *********************************************************************// +// Interface: _AssemblyFlagsAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0ECD8635-F5EB-3E4A-8989-4D684D67C48A} +// *********************************************************************// + _AssemblyFlagsAttribute = interface(IDispatch) + ['{0ECD8635-F5EB-3E4A-8989-4D684D67C48A}'] + end; + +// *********************************************************************// +// DispIntf: _AssemblyFlagsAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0ECD8635-F5EB-3E4A-8989-4D684D67C48A} +// *********************************************************************// + _AssemblyFlagsAttributeDisp = dispinterface + ['{0ECD8635-F5EB-3E4A-8989-4D684D67C48A}'] + end; + {$EXTERNALSYM _AssemblyFlagsAttributeDisp} + +// *********************************************************************// +// Interface: _AssemblyFileVersionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B101FE3C-4479-311A-A945-1225EE1731E8} +// *********************************************************************// + _AssemblyFileVersionAttribute = interface(IDispatch) + ['{B101FE3C-4479-311A-A945-1225EE1731E8}'] + end; + +// *********************************************************************// +// DispIntf: _AssemblyFileVersionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B101FE3C-4479-311A-A945-1225EE1731E8} +// *********************************************************************// + _AssemblyFileVersionAttributeDisp = dispinterface + ['{B101FE3C-4479-311A-A945-1225EE1731E8}'] + end; + {$EXTERNALSYM _AssemblyFileVersionAttributeDisp} + +// *********************************************************************// +// Interface: _AssemblyName +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B42B6AAC-317E-34D5-9FA9-093BB4160C50} +// *********************************************************************// + _AssemblyName = interface(IDispatch) + ['{B42B6AAC-317E-34D5-9FA9-093BB4160C50}'] + end; + +// *********************************************************************// +// DispIntf: _AssemblyNameDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B42B6AAC-317E-34D5-9FA9-093BB4160C50} +// *********************************************************************// + _AssemblyNameDisp = dispinterface + ['{B42B6AAC-317E-34D5-9FA9-093BB4160C50}'] + end; + {$EXTERNALSYM _AssemblyNameDisp} + +// *********************************************************************// +// Interface: _AssemblyNameProxy +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FE52F19A-8AA8-309C-BF99-9D0A566FB76A} +// *********************************************************************// + _AssemblyNameProxy = interface(IDispatch) + ['{FE52F19A-8AA8-309C-BF99-9D0A566FB76A}'] + end; + +// *********************************************************************// +// DispIntf: _AssemblyNameProxyDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FE52F19A-8AA8-309C-BF99-9D0A566FB76A} +// *********************************************************************// + _AssemblyNameProxyDisp = dispinterface + ['{FE52F19A-8AA8-309C-BF99-9D0A566FB76A}'] + end; + {$EXTERNALSYM _AssemblyNameProxyDisp} + +// *********************************************************************// +// Interface: _AssemblyCopyrightAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6163F792-3CD6-38F1-B5F7-000B96A5082B} +// *********************************************************************// + _AssemblyCopyrightAttribute = interface(IDispatch) + ['{6163F792-3CD6-38F1-B5F7-000B96A5082B}'] + end; + +// *********************************************************************// +// DispIntf: _AssemblyCopyrightAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6163F792-3CD6-38F1-B5F7-000B96A5082B} +// *********************************************************************// + _AssemblyCopyrightAttributeDisp = dispinterface + ['{6163F792-3CD6-38F1-B5F7-000B96A5082B}'] + end; + {$EXTERNALSYM _AssemblyCopyrightAttributeDisp} + +// *********************************************************************// +// Interface: _AssemblyTrademarkAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {64C26BF9-C9E5-3F66-AD74-BEBAADE36214} +// *********************************************************************// + _AssemblyTrademarkAttribute = interface(IDispatch) + ['{64C26BF9-C9E5-3F66-AD74-BEBAADE36214}'] + end; + +// *********************************************************************// +// DispIntf: _AssemblyTrademarkAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {64C26BF9-C9E5-3F66-AD74-BEBAADE36214} +// *********************************************************************// + _AssemblyTrademarkAttributeDisp = dispinterface + ['{64C26BF9-C9E5-3F66-AD74-BEBAADE36214}'] + end; + {$EXTERNALSYM _AssemblyTrademarkAttributeDisp} + +// *********************************************************************// +// Interface: _AssemblyProductAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DE10D587-A188-3DCB-8000-92DFDB9B8021} +// *********************************************************************// + _AssemblyProductAttribute = interface(IDispatch) + ['{DE10D587-A188-3DCB-8000-92DFDB9B8021}'] + end; + +// *********************************************************************// +// DispIntf: _AssemblyProductAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DE10D587-A188-3DCB-8000-92DFDB9B8021} +// *********************************************************************// + _AssemblyProductAttributeDisp = dispinterface + ['{DE10D587-A188-3DCB-8000-92DFDB9B8021}'] + end; + {$EXTERNALSYM _AssemblyProductAttributeDisp} + +// *********************************************************************// +// Interface: _AssemblyCompanyAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C6802233-EF82-3C91-AD72-B3A5D7230ED5} +// *********************************************************************// + _AssemblyCompanyAttribute = interface(IDispatch) + ['{C6802233-EF82-3C91-AD72-B3A5D7230ED5}'] + end; + +// *********************************************************************// +// DispIntf: _AssemblyCompanyAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C6802233-EF82-3C91-AD72-B3A5D7230ED5} +// *********************************************************************// + _AssemblyCompanyAttributeDisp = dispinterface + ['{C6802233-EF82-3C91-AD72-B3A5D7230ED5}'] + end; + {$EXTERNALSYM _AssemblyCompanyAttributeDisp} + +// *********************************************************************// +// Interface: _AssemblyDescriptionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6B2C0BC4-DDB7-38EA-8A86-F0B59E192816} +// *********************************************************************// + _AssemblyDescriptionAttribute = interface(IDispatch) + ['{6B2C0BC4-DDB7-38EA-8A86-F0B59E192816}'] + end; + +// *********************************************************************// +// DispIntf: _AssemblyDescriptionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6B2C0BC4-DDB7-38EA-8A86-F0B59E192816} +// *********************************************************************// + _AssemblyDescriptionAttributeDisp = dispinterface + ['{6B2C0BC4-DDB7-38EA-8A86-F0B59E192816}'] + end; + {$EXTERNALSYM _AssemblyDescriptionAttributeDisp} + +// *********************************************************************// +// Interface: _AssemblyTitleAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DF44CAD3-CEF2-36A9-B013-383CC03177D7} +// *********************************************************************// + _AssemblyTitleAttribute = interface(IDispatch) + ['{DF44CAD3-CEF2-36A9-B013-383CC03177D7}'] + end; + +// *********************************************************************// +// DispIntf: _AssemblyTitleAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DF44CAD3-CEF2-36A9-B013-383CC03177D7} +// *********************************************************************// + _AssemblyTitleAttributeDisp = dispinterface + ['{DF44CAD3-CEF2-36A9-B013-383CC03177D7}'] + end; + {$EXTERNALSYM _AssemblyTitleAttributeDisp} + +// *********************************************************************// +// Interface: _AssemblyConfigurationAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {746D1D1E-EE37-393B-B6FA-E387D37553AA} +// *********************************************************************// + _AssemblyConfigurationAttribute = interface(IDispatch) + ['{746D1D1E-EE37-393B-B6FA-E387D37553AA}'] + end; + +// *********************************************************************// +// DispIntf: _AssemblyConfigurationAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {746D1D1E-EE37-393B-B6FA-E387D37553AA} +// *********************************************************************// + _AssemblyConfigurationAttributeDisp = dispinterface + ['{746D1D1E-EE37-393B-B6FA-E387D37553AA}'] + end; + {$EXTERNALSYM _AssemblyConfigurationAttributeDisp} + +// *********************************************************************// +// Interface: _AssemblyDefaultAliasAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {04311D35-75EC-347B-BEDF-969487CE4014} +// *********************************************************************// + _AssemblyDefaultAliasAttribute = interface(IDispatch) + ['{04311D35-75EC-347B-BEDF-969487CE4014}'] + end; + +// *********************************************************************// +// DispIntf: _AssemblyDefaultAliasAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {04311D35-75EC-347B-BEDF-969487CE4014} +// *********************************************************************// + _AssemblyDefaultAliasAttributeDisp = dispinterface + ['{04311D35-75EC-347B-BEDF-969487CE4014}'] + end; + {$EXTERNALSYM _AssemblyDefaultAliasAttributeDisp} + +// *********************************************************************// +// Interface: _AssemblyInformationalVersionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C6F5946C-143A-3747-A7C0-ABFADA6BDEB7} +// *********************************************************************// + _AssemblyInformationalVersionAttribute = interface(IDispatch) + ['{C6F5946C-143A-3747-A7C0-ABFADA6BDEB7}'] + end; + +// *********************************************************************// +// DispIntf: _AssemblyInformationalVersionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C6F5946C-143A-3747-A7C0-ABFADA6BDEB7} +// *********************************************************************// + _AssemblyInformationalVersionAttributeDisp = dispinterface + ['{C6F5946C-143A-3747-A7C0-ABFADA6BDEB7}'] + end; + {$EXTERNALSYM _AssemblyInformationalVersionAttributeDisp} + +// *********************************************************************// +// Interface: _CustomAttributeFormatException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1660EB67-EE41-363E-BEB0-C2DE09214ABF} +// *********************************************************************// + _CustomAttributeFormatException = interface(IDispatch) + ['{1660EB67-EE41-363E-BEB0-C2DE09214ABF}'] + end; + +// *********************************************************************// +// DispIntf: _CustomAttributeFormatExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1660EB67-EE41-363E-BEB0-C2DE09214ABF} +// *********************************************************************// + _CustomAttributeFormatExceptionDisp = dispinterface + ['{1660EB67-EE41-363E-BEB0-C2DE09214ABF}'] + end; + {$EXTERNALSYM _CustomAttributeFormatExceptionDisp} + +// *********************************************************************// +// Interface: _MethodBase +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {6240837A-707F-3181-8E98-A36AE086766B} +// *********************************************************************// + _MethodBase = interface(IDispatch) + ['{6240837A-707F-3181-8E98-A36AE086766B}'] + function Get_ToString: WideString; safecall; + function Equals(obj: OleVariant): WordBool; safecall; + function GetHashCode: Integer; safecall; + function GetType: _Type; safecall; + function Get_MemberType: MemberTypes; safecall; + function Get_name: WideString; safecall; + function Get_DeclaringType: _Type; safecall; + function Get_ReflectedType: _Type; safecall; + function GetCustomAttributes(const attributeType: _Type; inherit: WordBool): PSafeArray; safecall; + function GetCustomAttributes_2(inherit: WordBool): PSafeArray; safecall; + function IsDefined(const attributeType: _Type; inherit: WordBool): WordBool; safecall; + function GetParameters: PSafeArray; safecall; + function GetMethodImplementationFlags: MethodImplAttributes; safecall; + function Get_MethodHandle: RuntimeMethodHandle; safecall; + function Get_Attributes: MethodAttributes; safecall; + function Get_CallingConvention: CallingConventions; safecall; + function Invoke_2(obj: OleVariant; invokeAttr: BindingFlags; const Binder: _Binder; + parameters: PSafeArray; const culture: _CultureInfo): OleVariant; safecall; + function Get_IsPublic: WordBool; safecall; + function Get_IsPrivate: WordBool; safecall; + function Get_IsFamily: WordBool; safecall; + function Get_IsAssembly: WordBool; safecall; + function Get_IsFamilyAndAssembly: WordBool; safecall; + function Get_IsFamilyOrAssembly: WordBool; safecall; + function Get_IsStatic: WordBool; safecall; + function Get_IsFinal: WordBool; safecall; + function Get_IsVirtual: WordBool; safecall; + function Get_IsHideBySig: WordBool; safecall; + function Get_IsAbstract: WordBool; safecall; + function Get_IsSpecialName: WordBool; safecall; + function Get_IsConstructor: WordBool; safecall; + function Invoke_3(obj: OleVariant; parameters: PSafeArray): OleVariant; safecall; + property ToString: WideString read Get_ToString; + property MemberType: MemberTypes read Get_MemberType; + property name: WideString read Get_name; + property DeclaringType: _Type read Get_DeclaringType; + property ReflectedType: _Type read Get_ReflectedType; + property MethodHandle: RuntimeMethodHandle read Get_MethodHandle; + property Attributes: MethodAttributes read Get_Attributes; + property CallingConvention: CallingConventions read Get_CallingConvention; + property IsPublic: WordBool read Get_IsPublic; + property IsPrivate: WordBool read Get_IsPrivate; + property IsFamily: WordBool read Get_IsFamily; + property IsAssembly: WordBool read Get_IsAssembly; + property IsFamilyAndAssembly: WordBool read Get_IsFamilyAndAssembly; + property IsFamilyOrAssembly: WordBool read Get_IsFamilyOrAssembly; + property IsStatic: WordBool read Get_IsStatic; + property IsFinal: WordBool read Get_IsFinal; + property IsVirtual: WordBool read Get_IsVirtual; + property IsHideBySig: WordBool read Get_IsHideBySig; + property IsAbstract: WordBool read Get_IsAbstract; + property IsSpecialName: WordBool read Get_IsSpecialName; + property IsConstructor: WordBool read Get_IsConstructor; + end; + +// *********************************************************************// +// DispIntf: _MethodBaseDisp +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {6240837A-707F-3181-8E98-A36AE086766B} +// *********************************************************************// + _MethodBaseDisp = dispinterface + ['{6240837A-707F-3181-8E98-A36AE086766B}'] + property ToString: WideString readonly dispid 0; + function Equals(obj: OleVariant): WordBool; dispid 1610743809; + function GetHashCode: Integer; dispid 1610743810; + function GetType: _Type; dispid 1610743811; + property MemberType: MemberTypes readonly dispid 1610743812; + property name: WideString readonly dispid 1610743813; + property DeclaringType: _Type readonly dispid 1610743814; + property ReflectedType: _Type readonly dispid 1610743815; + function GetCustomAttributes(const attributeType: _Type; inherit: WordBool): {??PSafeArray}OleVariant; dispid 1610743816; + function GetCustomAttributes_2(inherit: WordBool): {??PSafeArray}OleVariant; dispid 1610743817; + function IsDefined(const attributeType: _Type; inherit: WordBool): WordBool; dispid 1610743818; + function GetParameters: {??PSafeArray}OleVariant; dispid 1610743819; + function GetMethodImplementationFlags: MethodImplAttributes; dispid 1610743820; + property MethodHandle: {??RuntimeMethodHandle}OleVariant readonly dispid 1610743821; + property Attributes: MethodAttributes readonly dispid 1610743822; + property CallingConvention: CallingConventions readonly dispid 1610743823; + function Invoke_2(obj: OleVariant; invokeAttr: BindingFlags; const Binder: _Binder; + parameters: {??PSafeArray}OleVariant; const culture: _CultureInfo): OleVariant; dispid 1610743824; + property IsPublic: WordBool readonly dispid 1610743825; + property IsPrivate: WordBool readonly dispid 1610743826; + property IsFamily: WordBool readonly dispid 1610743827; + property IsAssembly: WordBool readonly dispid 1610743828; + property IsFamilyAndAssembly: WordBool readonly dispid 1610743829; + property IsFamilyOrAssembly: WordBool readonly dispid 1610743830; + property IsStatic: WordBool readonly dispid 1610743831; + property IsFinal: WordBool readonly dispid 1610743832; + property IsVirtual: WordBool readonly dispid 1610743833; + property IsHideBySig: WordBool readonly dispid 1610743834; + property IsAbstract: WordBool readonly dispid 1610743835; + property IsSpecialName: WordBool readonly dispid 1610743836; + property IsConstructor: WordBool readonly dispid 1610743837; + function Invoke_3(obj: OleVariant; parameters: {??PSafeArray}OleVariant): OleVariant; dispid 1610743838; + end; + {$EXTERNALSYM _MethodBaseDisp} + +// *********************************************************************// +// Interface: _ConstructorInfo +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {E9A19478-9646-3679-9B10-8411AE1FD57D} +// *********************************************************************// + _ConstructorInfo = interface(IDispatch) + ['{E9A19478-9646-3679-9B10-8411AE1FD57D}'] + function Get_ToString: WideString; safecall; + function Equals(obj: OleVariant): WordBool; safecall; + function GetHashCode: Integer; safecall; + function GetType: _Type; safecall; + function Get_MemberType: MemberTypes; safecall; + function Get_name: WideString; safecall; + function Get_DeclaringType: _Type; safecall; + function Get_ReflectedType: _Type; safecall; + function GetCustomAttributes(const attributeType: _Type; inherit: WordBool): PSafeArray; safecall; + function GetCustomAttributes_2(inherit: WordBool): PSafeArray; safecall; + function IsDefined(const attributeType: _Type; inherit: WordBool): WordBool; safecall; + function GetParameters: PSafeArray; safecall; + function GetMethodImplementationFlags: MethodImplAttributes; safecall; + function Get_MethodHandle: RuntimeMethodHandle; safecall; + function Get_Attributes: MethodAttributes; safecall; + function Get_CallingConvention: CallingConventions; safecall; + function Invoke_2(obj: OleVariant; invokeAttr: BindingFlags; const Binder: _Binder; + parameters: PSafeArray; const culture: _CultureInfo): OleVariant; safecall; + function Get_IsPublic: WordBool; safecall; + function Get_IsPrivate: WordBool; safecall; + function Get_IsFamily: WordBool; safecall; + function Get_IsAssembly: WordBool; safecall; + function Get_IsFamilyAndAssembly: WordBool; safecall; + function Get_IsFamilyOrAssembly: WordBool; safecall; + function Get_IsStatic: WordBool; safecall; + function Get_IsFinal: WordBool; safecall; + function Get_IsVirtual: WordBool; safecall; + function Get_IsHideBySig: WordBool; safecall; + function Get_IsAbstract: WordBool; safecall; + function Get_IsSpecialName: WordBool; safecall; + function Get_IsConstructor: WordBool; safecall; + function Invoke_3(obj: OleVariant; parameters: PSafeArray): OleVariant; safecall; + function Invoke_4(invokeAttr: BindingFlags; const Binder: _Binder; parameters: PSafeArray; + const culture: _CultureInfo): OleVariant; safecall; + function Invoke_5(parameters: PSafeArray): OleVariant; safecall; + property ToString: WideString read Get_ToString; + property MemberType: MemberTypes read Get_MemberType; + property name: WideString read Get_name; + property DeclaringType: _Type read Get_DeclaringType; + property ReflectedType: _Type read Get_ReflectedType; + property MethodHandle: RuntimeMethodHandle read Get_MethodHandle; + property Attributes: MethodAttributes read Get_Attributes; + property CallingConvention: CallingConventions read Get_CallingConvention; + property IsPublic: WordBool read Get_IsPublic; + property IsPrivate: WordBool read Get_IsPrivate; + property IsFamily: WordBool read Get_IsFamily; + property IsAssembly: WordBool read Get_IsAssembly; + property IsFamilyAndAssembly: WordBool read Get_IsFamilyAndAssembly; + property IsFamilyOrAssembly: WordBool read Get_IsFamilyOrAssembly; + property IsStatic: WordBool read Get_IsStatic; + property IsFinal: WordBool read Get_IsFinal; + property IsVirtual: WordBool read Get_IsVirtual; + property IsHideBySig: WordBool read Get_IsHideBySig; + property IsAbstract: WordBool read Get_IsAbstract; + property IsSpecialName: WordBool read Get_IsSpecialName; + property IsConstructor: WordBool read Get_IsConstructor; + end; + +// *********************************************************************// +// DispIntf: _ConstructorInfoDisp +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {E9A19478-9646-3679-9B10-8411AE1FD57D} +// *********************************************************************// + _ConstructorInfoDisp = dispinterface + ['{E9A19478-9646-3679-9B10-8411AE1FD57D}'] + property ToString: WideString readonly dispid 0; + function Equals(obj: OleVariant): WordBool; dispid 1610743809; + function GetHashCode: Integer; dispid 1610743810; + function GetType: _Type; dispid 1610743811; + property MemberType: MemberTypes readonly dispid 1610743812; + property name: WideString readonly dispid 1610743813; + property DeclaringType: _Type readonly dispid 1610743814; + property ReflectedType: _Type readonly dispid 1610743815; + function GetCustomAttributes(const attributeType: _Type; inherit: WordBool): {??PSafeArray}OleVariant; dispid 1610743816; + function GetCustomAttributes_2(inherit: WordBool): {??PSafeArray}OleVariant; dispid 1610743817; + function IsDefined(const attributeType: _Type; inherit: WordBool): WordBool; dispid 1610743818; + function GetParameters: {??PSafeArray}OleVariant; dispid 1610743819; + function GetMethodImplementationFlags: MethodImplAttributes; dispid 1610743820; + property MethodHandle: {??RuntimeMethodHandle}OleVariant readonly dispid 1610743821; + property Attributes: MethodAttributes readonly dispid 1610743822; + property CallingConvention: CallingConventions readonly dispid 1610743823; + function Invoke_2(obj: OleVariant; invokeAttr: BindingFlags; const Binder: _Binder; + parameters: {??PSafeArray}OleVariant; const culture: _CultureInfo): OleVariant; dispid 1610743824; + property IsPublic: WordBool readonly dispid 1610743825; + property IsPrivate: WordBool readonly dispid 1610743826; + property IsFamily: WordBool readonly dispid 1610743827; + property IsAssembly: WordBool readonly dispid 1610743828; + property IsFamilyAndAssembly: WordBool readonly dispid 1610743829; + property IsFamilyOrAssembly: WordBool readonly dispid 1610743830; + property IsStatic: WordBool readonly dispid 1610743831; + property IsFinal: WordBool readonly dispid 1610743832; + property IsVirtual: WordBool readonly dispid 1610743833; + property IsHideBySig: WordBool readonly dispid 1610743834; + property IsAbstract: WordBool readonly dispid 1610743835; + property IsSpecialName: WordBool readonly dispid 1610743836; + property IsConstructor: WordBool readonly dispid 1610743837; + function Invoke_3(obj: OleVariant; parameters: {??PSafeArray}OleVariant): OleVariant; dispid 1610743838; + function Invoke_4(invokeAttr: BindingFlags; const Binder: _Binder; + parameters: {??PSafeArray}OleVariant; const culture: _CultureInfo): OleVariant; dispid 1610743839; + function Invoke_5(parameters: {??PSafeArray}OleVariant): OleVariant; dispid 1610743840; + end; + {$EXTERNALSYM _ConstructorInfoDisp} + +// *********************************************************************// +// Interface: _DefaultMemberAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C462B072-FE6E-3BDC-9FAB-4CDBFCBCD124} +// *********************************************************************// + _DefaultMemberAttribute = interface(IDispatch) + ['{C462B072-FE6E-3BDC-9FAB-4CDBFCBCD124}'] + end; + +// *********************************************************************// +// DispIntf: _DefaultMemberAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C462B072-FE6E-3BDC-9FAB-4CDBFCBCD124} +// *********************************************************************// + _DefaultMemberAttributeDisp = dispinterface + ['{C462B072-FE6E-3BDC-9FAB-4CDBFCBCD124}'] + end; + {$EXTERNALSYM _DefaultMemberAttributeDisp} + +// *********************************************************************// +// Interface: _EventInfo +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {9DE59C64-D889-35A1-B897-587D74469E5B} +// *********************************************************************// + _EventInfo = interface(IDispatch) + ['{9DE59C64-D889-35A1-B897-587D74469E5B}'] + function Get_ToString: WideString; safecall; + function Equals(obj: OleVariant): WordBool; safecall; + function GetHashCode: Integer; safecall; + function GetType: _Type; safecall; + function Get_MemberType: MemberTypes; safecall; + function Get_name: WideString; safecall; + function Get_DeclaringType: _Type; safecall; + function Get_ReflectedType: _Type; safecall; + function GetCustomAttributes(const attributeType: _Type; inherit: WordBool): PSafeArray; safecall; + function GetCustomAttributes_2(inherit: WordBool): PSafeArray; safecall; + function IsDefined(const attributeType: _Type; inherit: WordBool): WordBool; safecall; + function GetAddMethod(nonPublic: WordBool): _MethodInfo; safecall; + function GetRemoveMethod(nonPublic: WordBool): _MethodInfo; safecall; + function GetRaiseMethod(nonPublic: WordBool): _MethodInfo; safecall; + function Get_Attributes: EventAttributes; safecall; + function GetAddMethod_2: _MethodInfo; safecall; + function GetRemoveMethod_2: _MethodInfo; safecall; + function GetRaiseMethod_2: _MethodInfo; safecall; + procedure AddEventHandler(Target: OleVariant; const handler: _Delegate); safecall; + procedure RemoveEventHandler(Target: OleVariant; const handler: _Delegate); safecall; + function Get_EventHandlerType: _Type; safecall; + function Get_IsSpecialName: WordBool; safecall; + function Get_IsMulticast: WordBool; safecall; + property ToString: WideString read Get_ToString; + property MemberType: MemberTypes read Get_MemberType; + property name: WideString read Get_name; + property DeclaringType: _Type read Get_DeclaringType; + property ReflectedType: _Type read Get_ReflectedType; + property Attributes: EventAttributes read Get_Attributes; + property EventHandlerType: _Type read Get_EventHandlerType; + property IsSpecialName: WordBool read Get_IsSpecialName; + property IsMulticast: WordBool read Get_IsMulticast; + end; + +// *********************************************************************// +// DispIntf: _EventInfoDisp +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {9DE59C64-D889-35A1-B897-587D74469E5B} +// *********************************************************************// + _EventInfoDisp = dispinterface + ['{9DE59C64-D889-35A1-B897-587D74469E5B}'] + property ToString: WideString readonly dispid 0; + function Equals(obj: OleVariant): WordBool; dispid 1610743809; + function GetHashCode: Integer; dispid 1610743810; + function GetType: _Type; dispid 1610743811; + property MemberType: MemberTypes readonly dispid 1610743812; + property name: WideString readonly dispid 1610743813; + property DeclaringType: _Type readonly dispid 1610743814; + property ReflectedType: _Type readonly dispid 1610743815; + function GetCustomAttributes(const attributeType: _Type; inherit: WordBool): {??PSafeArray}OleVariant; dispid 1610743816; + function GetCustomAttributes_2(inherit: WordBool): {??PSafeArray}OleVariant; dispid 1610743817; + function IsDefined(const attributeType: _Type; inherit: WordBool): WordBool; dispid 1610743818; + function GetAddMethod(nonPublic: WordBool): _MethodInfo; dispid 1610743819; + function GetRemoveMethod(nonPublic: WordBool): _MethodInfo; dispid 1610743820; + function GetRaiseMethod(nonPublic: WordBool): _MethodInfo; dispid 1610743821; + property Attributes: EventAttributes readonly dispid 1610743822; + function GetAddMethod_2: _MethodInfo; dispid 1610743823; + function GetRemoveMethod_2: _MethodInfo; dispid 1610743824; + function GetRaiseMethod_2: _MethodInfo; dispid 1610743825; + procedure AddEventHandler(Target: OleVariant; const handler: _Delegate); dispid 1610743826; + procedure RemoveEventHandler(Target: OleVariant; const handler: _Delegate); dispid 1610743827; + property EventHandlerType: _Type readonly dispid 1610743828; + property IsSpecialName: WordBool readonly dispid 1610743829; + property IsMulticast: WordBool readonly dispid 1610743830; + end; + {$EXTERNALSYM _EventInfoDisp} + +// *********************************************************************// +// Interface: _FieldInfo +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {8A7C1442-A9FB-366B-80D8-4939FFA6DBE0} +// *********************************************************************// + _FieldInfo = interface(IDispatch) + ['{8A7C1442-A9FB-366B-80D8-4939FFA6DBE0}'] + function Get_ToString: WideString; safecall; + function Equals(obj: OleVariant): WordBool; safecall; + function GetHashCode: Integer; safecall; + function GetType: _Type; safecall; + function Get_MemberType: MemberTypes; safecall; + function Get_name: WideString; safecall; + function Get_DeclaringType: _Type; safecall; + function Get_ReflectedType: _Type; safecall; + function GetCustomAttributes(const attributeType: _Type; inherit: WordBool): PSafeArray; safecall; + function GetCustomAttributes_2(inherit: WordBool): PSafeArray; safecall; + function IsDefined(const attributeType: _Type; inherit: WordBool): WordBool; safecall; + function Get_FieldType: _Type; safecall; + function GetValue(obj: OleVariant): OleVariant; safecall; + function GetValueDirect(obj: OleVariant): OleVariant; safecall; + procedure SetValue(obj: OleVariant; value: OleVariant; invokeAttr: BindingFlags; + const Binder: _Binder; const culture: _CultureInfo); safecall; + procedure SetValueDirect(obj: OleVariant; value: OleVariant); safecall; + function Get_FieldHandle: RuntimeFieldHandle; safecall; + function Get_Attributes: FieldAttributes; safecall; + procedure SetValue_2(obj: OleVariant; value: OleVariant); safecall; + function Get_IsPublic: WordBool; safecall; + function Get_IsPrivate: WordBool; safecall; + function Get_IsFamily: WordBool; safecall; + function Get_IsAssembly: WordBool; safecall; + function Get_IsFamilyAndAssembly: WordBool; safecall; + function Get_IsFamilyOrAssembly: WordBool; safecall; + function Get_IsStatic: WordBool; safecall; + function Get_IsInitOnly: WordBool; safecall; + function Get_IsLiteral: WordBool; safecall; + function Get_IsNotSerialized: WordBool; safecall; + function Get_IsSpecialName: WordBool; safecall; + function Get_IsPinvokeImpl: WordBool; safecall; + property ToString: WideString read Get_ToString; + property MemberType: MemberTypes read Get_MemberType; + property name: WideString read Get_name; + property DeclaringType: _Type read Get_DeclaringType; + property ReflectedType: _Type read Get_ReflectedType; + property FieldType: _Type read Get_FieldType; + property FieldHandle: RuntimeFieldHandle read Get_FieldHandle; + property Attributes: FieldAttributes read Get_Attributes; + property IsPublic: WordBool read Get_IsPublic; + property IsPrivate: WordBool read Get_IsPrivate; + property IsFamily: WordBool read Get_IsFamily; + property IsAssembly: WordBool read Get_IsAssembly; + property IsFamilyAndAssembly: WordBool read Get_IsFamilyAndAssembly; + property IsFamilyOrAssembly: WordBool read Get_IsFamilyOrAssembly; + property IsStatic: WordBool read Get_IsStatic; + property IsInitOnly: WordBool read Get_IsInitOnly; + property IsLiteral: WordBool read Get_IsLiteral; + property IsNotSerialized: WordBool read Get_IsNotSerialized; + property IsSpecialName: WordBool read Get_IsSpecialName; + property IsPinvokeImpl: WordBool read Get_IsPinvokeImpl; + end; + +// *********************************************************************// +// DispIntf: _FieldInfoDisp +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {8A7C1442-A9FB-366B-80D8-4939FFA6DBE0} +// *********************************************************************// + _FieldInfoDisp = dispinterface + ['{8A7C1442-A9FB-366B-80D8-4939FFA6DBE0}'] + property ToString: WideString readonly dispid 0; + function Equals(obj: OleVariant): WordBool; dispid 1610743809; + function GetHashCode: Integer; dispid 1610743810; + function GetType: _Type; dispid 1610743811; + property MemberType: MemberTypes readonly dispid 1610743812; + property name: WideString readonly dispid 1610743813; + property DeclaringType: _Type readonly dispid 1610743814; + property ReflectedType: _Type readonly dispid 1610743815; + function GetCustomAttributes(const attributeType: _Type; inherit: WordBool): {??PSafeArray}OleVariant; dispid 1610743816; + function GetCustomAttributes_2(inherit: WordBool): {??PSafeArray}OleVariant; dispid 1610743817; + function IsDefined(const attributeType: _Type; inherit: WordBool): WordBool; dispid 1610743818; + property FieldType: _Type readonly dispid 1610743819; + function GetValue(obj: OleVariant): OleVariant; dispid 1610743820; + function GetValueDirect(obj: OleVariant): OleVariant; dispid 1610743821; + procedure SetValue(obj: OleVariant; value: OleVariant; invokeAttr: BindingFlags; + const Binder: _Binder; const culture: _CultureInfo); dispid 1610743822; + procedure SetValueDirect(obj: OleVariant; value: OleVariant); dispid 1610743823; + property FieldHandle: {??RuntimeFieldHandle}OleVariant readonly dispid 1610743824; + property Attributes: FieldAttributes readonly dispid 1610743825; + procedure SetValue_2(obj: OleVariant; value: OleVariant); dispid 1610743826; + property IsPublic: WordBool readonly dispid 1610743827; + property IsPrivate: WordBool readonly dispid 1610743828; + property IsFamily: WordBool readonly dispid 1610743829; + property IsAssembly: WordBool readonly dispid 1610743830; + property IsFamilyAndAssembly: WordBool readonly dispid 1610743831; + property IsFamilyOrAssembly: WordBool readonly dispid 1610743832; + property IsStatic: WordBool readonly dispid 1610743833; + property IsInitOnly: WordBool readonly dispid 1610743834; + property IsLiteral: WordBool readonly dispid 1610743835; + property IsNotSerialized: WordBool readonly dispid 1610743836; + property IsSpecialName: WordBool readonly dispid 1610743837; + property IsPinvokeImpl: WordBool readonly dispid 1610743838; + end; + {$EXTERNALSYM _FieldInfoDisp} + +// *********************************************************************// +// Interface: _InvalidFilterCriteriaException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E6DF0AE7-BA15-3F80-8AFA-27773AE414FC} +// *********************************************************************// + _InvalidFilterCriteriaException = interface(IDispatch) + ['{E6DF0AE7-BA15-3F80-8AFA-27773AE414FC}'] + end; + +// *********************************************************************// +// DispIntf: _InvalidFilterCriteriaExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E6DF0AE7-BA15-3F80-8AFA-27773AE414FC} +// *********************************************************************// + _InvalidFilterCriteriaExceptionDisp = dispinterface + ['{E6DF0AE7-BA15-3F80-8AFA-27773AE414FC}'] + end; + {$EXTERNALSYM _InvalidFilterCriteriaExceptionDisp} + +// *********************************************************************// +// Interface: _ManifestResourceInfo +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3188878C-DEB3-3558-80E8-84E9ED95F92C} +// *********************************************************************// + _ManifestResourceInfo = interface(IDispatch) + ['{3188878C-DEB3-3558-80E8-84E9ED95F92C}'] + end; + +// *********************************************************************// +// DispIntf: _ManifestResourceInfoDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3188878C-DEB3-3558-80E8-84E9ED95F92C} +// *********************************************************************// + _ManifestResourceInfoDisp = dispinterface + ['{3188878C-DEB3-3558-80E8-84E9ED95F92C}'] + end; + {$EXTERNALSYM _ManifestResourceInfoDisp} + +// *********************************************************************// +// Interface: _MemberFilter +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FAE5D9B7-40C1-3DE1-BE06-A91C9DA1BA9F} +// *********************************************************************// + _MemberFilter = interface(IDispatch) + ['{FAE5D9B7-40C1-3DE1-BE06-A91C9DA1BA9F}'] + end; + +// *********************************************************************// +// DispIntf: _MemberFilterDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FAE5D9B7-40C1-3DE1-BE06-A91C9DA1BA9F} +// *********************************************************************// + _MemberFilterDisp = dispinterface + ['{FAE5D9B7-40C1-3DE1-BE06-A91C9DA1BA9F}'] + end; + {$EXTERNALSYM _MemberFilterDisp} + +// *********************************************************************// +// Interface: _MethodInfo +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {FFCC1B5D-ECB8-38DD-9B01-3DC8ABC2AA5F} +// *********************************************************************// + _MethodInfo = interface(IDispatch) + ['{FFCC1B5D-ECB8-38DD-9B01-3DC8ABC2AA5F}'] + function Get_ToString: WideString; safecall; + function Equals(obj: OleVariant): WordBool; safecall; + function GetHashCode: Integer; safecall; + function GetType: _Type; safecall; + function Get_MemberType: MemberTypes; safecall; + function Get_name: WideString; safecall; + function Get_DeclaringType: _Type; safecall; + function Get_ReflectedType: _Type; safecall; + function GetCustomAttributes(const attributeType: _Type; inherit: WordBool): PSafeArray; safecall; + function GetCustomAttributes_2(inherit: WordBool): PSafeArray; safecall; + function IsDefined(const attributeType: _Type; inherit: WordBool): WordBool; safecall; + function GetParameters: PSafeArray; safecall; + function GetMethodImplementationFlags: MethodImplAttributes; safecall; + function Get_MethodHandle: RuntimeMethodHandle; safecall; + function Get_Attributes: MethodAttributes; safecall; + function Get_CallingConvention: CallingConventions; safecall; + function Invoke_2(obj: OleVariant; invokeAttr: BindingFlags; const Binder: _Binder; + parameters: PSafeArray; const culture: _CultureInfo): OleVariant; safecall; + function Get_IsPublic: WordBool; safecall; + function Get_IsPrivate: WordBool; safecall; + function Get_IsFamily: WordBool; safecall; + function Get_IsAssembly: WordBool; safecall; + function Get_IsFamilyAndAssembly: WordBool; safecall; + function Get_IsFamilyOrAssembly: WordBool; safecall; + function Get_IsStatic: WordBool; safecall; + function Get_IsFinal: WordBool; safecall; + function Get_IsVirtual: WordBool; safecall; + function Get_IsHideBySig: WordBool; safecall; + function Get_IsAbstract: WordBool; safecall; + function Get_IsSpecialName: WordBool; safecall; + function Get_IsConstructor: WordBool; safecall; + function Invoke_3(obj: OleVariant; parameters: PSafeArray): OleVariant; safecall; + function Get_returnType: _Type; safecall; + function Get_ReturnTypeCustomAttributes: ICustomAttributeProvider; safecall; + function GetBaseDefinition: _MethodInfo; safecall; + property ToString: WideString read Get_ToString; + property MemberType: MemberTypes read Get_MemberType; + property name: WideString read Get_name; + property DeclaringType: _Type read Get_DeclaringType; + property ReflectedType: _Type read Get_ReflectedType; + property MethodHandle: RuntimeMethodHandle read Get_MethodHandle; + property Attributes: MethodAttributes read Get_Attributes; + property CallingConvention: CallingConventions read Get_CallingConvention; + property IsPublic: WordBool read Get_IsPublic; + property IsPrivate: WordBool read Get_IsPrivate; + property IsFamily: WordBool read Get_IsFamily; + property IsAssembly: WordBool read Get_IsAssembly; + property IsFamilyAndAssembly: WordBool read Get_IsFamilyAndAssembly; + property IsFamilyOrAssembly: WordBool read Get_IsFamilyOrAssembly; + property IsStatic: WordBool read Get_IsStatic; + property IsFinal: WordBool read Get_IsFinal; + property IsVirtual: WordBool read Get_IsVirtual; + property IsHideBySig: WordBool read Get_IsHideBySig; + property IsAbstract: WordBool read Get_IsAbstract; + property IsSpecialName: WordBool read Get_IsSpecialName; + property IsConstructor: WordBool read Get_IsConstructor; + property returnType: _Type read Get_returnType; + property ReturnTypeCustomAttributes: ICustomAttributeProvider read Get_ReturnTypeCustomAttributes; + end; + +// *********************************************************************// +// DispIntf: _MethodInfoDisp +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {FFCC1B5D-ECB8-38DD-9B01-3DC8ABC2AA5F} +// *********************************************************************// + _MethodInfoDisp = dispinterface + ['{FFCC1B5D-ECB8-38DD-9B01-3DC8ABC2AA5F}'] + property ToString: WideString readonly dispid 0; + function Equals(obj: OleVariant): WordBool; dispid 1610743809; + function GetHashCode: Integer; dispid 1610743810; + function GetType: _Type; dispid 1610743811; + property MemberType: MemberTypes readonly dispid 1610743812; + property name: WideString readonly dispid 1610743813; + property DeclaringType: _Type readonly dispid 1610743814; + property ReflectedType: _Type readonly dispid 1610743815; + function GetCustomAttributes(const attributeType: _Type; inherit: WordBool): {??PSafeArray}OleVariant; dispid 1610743816; + function GetCustomAttributes_2(inherit: WordBool): {??PSafeArray}OleVariant; dispid 1610743817; + function IsDefined(const attributeType: _Type; inherit: WordBool): WordBool; dispid 1610743818; + function GetParameters: {??PSafeArray}OleVariant; dispid 1610743819; + function GetMethodImplementationFlags: MethodImplAttributes; dispid 1610743820; + property MethodHandle: {??RuntimeMethodHandle}OleVariant readonly dispid 1610743821; + property Attributes: MethodAttributes readonly dispid 1610743822; + property CallingConvention: CallingConventions readonly dispid 1610743823; + function Invoke_2(obj: OleVariant; invokeAttr: BindingFlags; const Binder: _Binder; + parameters: {??PSafeArray}OleVariant; const culture: _CultureInfo): OleVariant; dispid 1610743824; + property IsPublic: WordBool readonly dispid 1610743825; + property IsPrivate: WordBool readonly dispid 1610743826; + property IsFamily: WordBool readonly dispid 1610743827; + property IsAssembly: WordBool readonly dispid 1610743828; + property IsFamilyAndAssembly: WordBool readonly dispid 1610743829; + property IsFamilyOrAssembly: WordBool readonly dispid 1610743830; + property IsStatic: WordBool readonly dispid 1610743831; + property IsFinal: WordBool readonly dispid 1610743832; + property IsVirtual: WordBool readonly dispid 1610743833; + property IsHideBySig: WordBool readonly dispid 1610743834; + property IsAbstract: WordBool readonly dispid 1610743835; + property IsSpecialName: WordBool readonly dispid 1610743836; + property IsConstructor: WordBool readonly dispid 1610743837; + function Invoke_3(obj: OleVariant; parameters: {??PSafeArray}OleVariant): OleVariant; dispid 1610743838; + property returnType: _Type readonly dispid 1610743839; + property ReturnTypeCustomAttributes: ICustomAttributeProvider readonly dispid 1610743840; + function GetBaseDefinition: _MethodInfo; dispid 1610743841; + end; + {$EXTERNALSYM _MethodInfoDisp} + +// *********************************************************************// +// Interface: _Missing +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0C48F55D-5240-30C7-A8F1-AF87A640CEFE} +// *********************************************************************// + _Missing = interface(IDispatch) + ['{0C48F55D-5240-30C7-A8F1-AF87A640CEFE}'] + end; + +// *********************************************************************// +// DispIntf: _MissingDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0C48F55D-5240-30C7-A8F1-AF87A640CEFE} +// *********************************************************************// + _MissingDisp = dispinterface + ['{0C48F55D-5240-30C7-A8F1-AF87A640CEFE}'] + end; + {$EXTERNALSYM _MissingDisp} + +// *********************************************************************// +// Interface: _Module +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D002E9BA-D9E3-3749-B1D3-D565A08B13E7} +// *********************************************************************// + _Module = interface(IDispatch) + ['{D002E9BA-D9E3-3749-B1D3-D565A08B13E7}'] + end; + +// *********************************************************************// +// DispIntf: _ModuleDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D002E9BA-D9E3-3749-B1D3-D565A08B13E7} +// *********************************************************************// + _ModuleDisp = dispinterface + ['{D002E9BA-D9E3-3749-B1D3-D565A08B13E7}'] + end; + {$EXTERNALSYM _ModuleDisp} + +// *********************************************************************// +// Interface: _ParameterInfo +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {993634C4-E47A-32CC-BE08-85F567DC27D6} +// *********************************************************************// + _ParameterInfo = interface(IDispatch) + ['{993634C4-E47A-32CC-BE08-85F567DC27D6}'] + end; + +// *********************************************************************// +// DispIntf: _ParameterInfoDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {993634C4-E47A-32CC-BE08-85F567DC27D6} +// *********************************************************************// + _ParameterInfoDisp = dispinterface + ['{993634C4-E47A-32CC-BE08-85F567DC27D6}'] + end; + {$EXTERNALSYM _ParameterInfoDisp} + +// *********************************************************************// +// Interface: _Pointer +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F0DEAFE9-5EBA-3737-9950-C1795739CDCD} +// *********************************************************************// + _Pointer = interface(IDispatch) + ['{F0DEAFE9-5EBA-3737-9950-C1795739CDCD}'] + end; + +// *********************************************************************// +// DispIntf: _PointerDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F0DEAFE9-5EBA-3737-9950-C1795739CDCD} +// *********************************************************************// + _PointerDisp = dispinterface + ['{F0DEAFE9-5EBA-3737-9950-C1795739CDCD}'] + end; + {$EXTERNALSYM _PointerDisp} + +// *********************************************************************// +// Interface: _PropertyInfo +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {F59ED4E4-E68F-3218-BD77-061AA82824BF} +// *********************************************************************// + _PropertyInfo = interface(IDispatch) + ['{F59ED4E4-E68F-3218-BD77-061AA82824BF}'] + function Get_ToString: WideString; safecall; + function Equals(obj: OleVariant): WordBool; safecall; + function GetHashCode: Integer; safecall; + function GetType: _Type; safecall; + function Get_MemberType: MemberTypes; safecall; + function Get_name: WideString; safecall; + function Get_DeclaringType: _Type; safecall; + function Get_ReflectedType: _Type; safecall; + function GetCustomAttributes(const attributeType: _Type; inherit: WordBool): PSafeArray; safecall; + function GetCustomAttributes_2(inherit: WordBool): PSafeArray; safecall; + function IsDefined(const attributeType: _Type; inherit: WordBool): WordBool; safecall; + function Get_PropertyType: _Type; safecall; + function GetValue(obj: OleVariant; index: PSafeArray): OleVariant; safecall; + function GetValue_2(obj: OleVariant; invokeAttr: BindingFlags; const Binder: _Binder; + index: PSafeArray; const culture: _CultureInfo): OleVariant; safecall; + procedure SetValue(obj: OleVariant; value: OleVariant; index: PSafeArray); safecall; + procedure SetValue_2(obj: OleVariant; value: OleVariant; invokeAttr: BindingFlags; + const Binder: _Binder; index: PSafeArray; const culture: _CultureInfo); safecall; + function GetAccessors(nonPublic: WordBool): PSafeArray; safecall; + function GetGetMethod(nonPublic: WordBool): _MethodInfo; safecall; + function GetSetMethod(nonPublic: WordBool): _MethodInfo; safecall; + function GetIndexParameters: PSafeArray; safecall; + function Get_Attributes: PropertyAttributes; safecall; + function Get_CanRead: WordBool; safecall; + function Get_CanWrite: WordBool; safecall; + function GetAccessors_2: PSafeArray; safecall; + function GetGetMethod_2: _MethodInfo; safecall; + function GetSetMethod_2: _MethodInfo; safecall; + function Get_IsSpecialName: WordBool; safecall; + property ToString: WideString read Get_ToString; + property MemberType: MemberTypes read Get_MemberType; + property name: WideString read Get_name; + property DeclaringType: _Type read Get_DeclaringType; + property ReflectedType: _Type read Get_ReflectedType; + property PropertyType: _Type read Get_PropertyType; + property Attributes: PropertyAttributes read Get_Attributes; + property CanRead: WordBool read Get_CanRead; + property CanWrite: WordBool read Get_CanWrite; + property IsSpecialName: WordBool read Get_IsSpecialName; + end; + +// *********************************************************************// +// DispIntf: _PropertyInfoDisp +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {F59ED4E4-E68F-3218-BD77-061AA82824BF} +// *********************************************************************// + _PropertyInfoDisp = dispinterface + ['{F59ED4E4-E68F-3218-BD77-061AA82824BF}'] + property ToString: WideString readonly dispid 0; + function Equals(obj: OleVariant): WordBool; dispid 1610743809; + function GetHashCode: Integer; dispid 1610743810; + function GetType: _Type; dispid 1610743811; + property MemberType: MemberTypes readonly dispid 1610743812; + property name: WideString readonly dispid 1610743813; + property DeclaringType: _Type readonly dispid 1610743814; + property ReflectedType: _Type readonly dispid 1610743815; + function GetCustomAttributes(const attributeType: _Type; inherit: WordBool): {??PSafeArray}OleVariant; dispid 1610743816; + function GetCustomAttributes_2(inherit: WordBool): {??PSafeArray}OleVariant; dispid 1610743817; + function IsDefined(const attributeType: _Type; inherit: WordBool): WordBool; dispid 1610743818; + property PropertyType: _Type readonly dispid 1610743819; + function GetValue(obj: OleVariant; index: {??PSafeArray}OleVariant): OleVariant; dispid 1610743820; + function GetValue_2(obj: OleVariant; invokeAttr: BindingFlags; const Binder: _Binder; + index: {??PSafeArray}OleVariant; const culture: _CultureInfo): OleVariant; dispid 1610743821; + procedure SetValue(obj: OleVariant; value: OleVariant; index: {??PSafeArray}OleVariant); dispid 1610743822; + procedure SetValue_2(obj: OleVariant; value: OleVariant; invokeAttr: BindingFlags; + const Binder: _Binder; index: {??PSafeArray}OleVariant; + const culture: _CultureInfo); dispid 1610743823; + function GetAccessors(nonPublic: WordBool): {??PSafeArray}OleVariant; dispid 1610743824; + function GetGetMethod(nonPublic: WordBool): _MethodInfo; dispid 1610743825; + function GetSetMethod(nonPublic: WordBool): _MethodInfo; dispid 1610743826; + function GetIndexParameters: {??PSafeArray}OleVariant; dispid 1610743827; + property Attributes: PropertyAttributes readonly dispid 1610743828; + property CanRead: WordBool readonly dispid 1610743829; + property CanWrite: WordBool readonly dispid 1610743830; + function GetAccessors_2: {??PSafeArray}OleVariant; dispid 1610743831; + function GetGetMethod_2: _MethodInfo; dispid 1610743832; + function GetSetMethod_2: _MethodInfo; dispid 1610743833; + property IsSpecialName: WordBool readonly dispid 1610743834; + end; + {$EXTERNALSYM _PropertyInfoDisp} + +// *********************************************************************// +// Interface: _ReflectionTypeLoadException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {22C26A41-5FA3-34E3-A76F-BA480252D8EC} +// *********************************************************************// + _ReflectionTypeLoadException = interface(IDispatch) + ['{22C26A41-5FA3-34E3-A76F-BA480252D8EC}'] + end; + +// *********************************************************************// +// DispIntf: _ReflectionTypeLoadExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {22C26A41-5FA3-34E3-A76F-BA480252D8EC} +// *********************************************************************// + _ReflectionTypeLoadExceptionDisp = dispinterface + ['{22C26A41-5FA3-34E3-A76F-BA480252D8EC}'] + end; + {$EXTERNALSYM _ReflectionTypeLoadExceptionDisp} + +// *********************************************************************// +// Interface: _StrongNameKeyPair +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FC4963CB-E52B-32D8-A418-D058FA51A1FA} +// *********************************************************************// + _StrongNameKeyPair = interface(IDispatch) + ['{FC4963CB-E52B-32D8-A418-D058FA51A1FA}'] + end; + +// *********************************************************************// +// DispIntf: _StrongNameKeyPairDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FC4963CB-E52B-32D8-A418-D058FA51A1FA} +// *********************************************************************// + _StrongNameKeyPairDisp = dispinterface + ['{FC4963CB-E52B-32D8-A418-D058FA51A1FA}'] + end; + {$EXTERNALSYM _StrongNameKeyPairDisp} + +// *********************************************************************// +// Interface: _TargetException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {98B1524D-DA12-3C4B-8A69-7539A6DEC4FA} +// *********************************************************************// + _TargetException = interface(IDispatch) + ['{98B1524D-DA12-3C4B-8A69-7539A6DEC4FA}'] + end; + +// *********************************************************************// +// DispIntf: _TargetExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {98B1524D-DA12-3C4B-8A69-7539A6DEC4FA} +// *********************************************************************// + _TargetExceptionDisp = dispinterface + ['{98B1524D-DA12-3C4B-8A69-7539A6DEC4FA}'] + end; + {$EXTERNALSYM _TargetExceptionDisp} + +// *********************************************************************// +// Interface: _TargetInvocationException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A90106ED-9099-3329-8A5A-2044B3D8552B} +// *********************************************************************// + _TargetInvocationException = interface(IDispatch) + ['{A90106ED-9099-3329-8A5A-2044B3D8552B}'] + end; + +// *********************************************************************// +// DispIntf: _TargetInvocationExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A90106ED-9099-3329-8A5A-2044B3D8552B} +// *********************************************************************// + _TargetInvocationExceptionDisp = dispinterface + ['{A90106ED-9099-3329-8A5A-2044B3D8552B}'] + end; + {$EXTERNALSYM _TargetInvocationExceptionDisp} + +// *********************************************************************// +// Interface: _TargetParameterCountException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6032B3CD-9BED-351C-A145-9D500B0F636F} +// *********************************************************************// + _TargetParameterCountException = interface(IDispatch) + ['{6032B3CD-9BED-351C-A145-9D500B0F636F}'] + end; + +// *********************************************************************// +// DispIntf: _TargetParameterCountExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6032B3CD-9BED-351C-A145-9D500B0F636F} +// *********************************************************************// + _TargetParameterCountExceptionDisp = dispinterface + ['{6032B3CD-9BED-351C-A145-9D500B0F636F}'] + end; + {$EXTERNALSYM _TargetParameterCountExceptionDisp} + +// *********************************************************************// +// Interface: _TypeDelegator +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {34E00EF9-83E2-3BBC-B6AF-4CAE703838BD} +// *********************************************************************// + _TypeDelegator = interface(IDispatch) + ['{34E00EF9-83E2-3BBC-B6AF-4CAE703838BD}'] + end; + +// *********************************************************************// +// DispIntf: _TypeDelegatorDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {34E00EF9-83E2-3BBC-B6AF-4CAE703838BD} +// *********************************************************************// + _TypeDelegatorDisp = dispinterface + ['{34E00EF9-83E2-3BBC-B6AF-4CAE703838BD}'] + end; + {$EXTERNALSYM _TypeDelegatorDisp} + +// *********************************************************************// +// Interface: _TypeFilter +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E1817846-3745-3C97-B4A6-EE20A1641B29} +// *********************************************************************// + _TypeFilter = interface(IDispatch) + ['{E1817846-3745-3C97-B4A6-EE20A1641B29}'] + end; + +// *********************************************************************// +// DispIntf: _TypeFilterDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E1817846-3745-3C97-B4A6-EE20A1641B29} +// *********************************************************************// + _TypeFilterDisp = dispinterface + ['{E1817846-3745-3C97-B4A6-EE20A1641B29}'] + end; + {$EXTERNALSYM _TypeFilterDisp} + +// *********************************************************************// +// Interface: _UnmanagedMarshal +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FD302D86-240A-3694-A31F-9EF59E6E41BC} +// *********************************************************************// + _UnmanagedMarshal = interface(IDispatch) + ['{FD302D86-240A-3694-A31F-9EF59E6E41BC}'] + end; + +// *********************************************************************// +// DispIntf: _UnmanagedMarshalDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FD302D86-240A-3694-A31F-9EF59E6E41BC} +// *********************************************************************// + _UnmanagedMarshalDisp = dispinterface + ['{FD302D86-240A-3694-A31F-9EF59E6E41BC}'] + end; + {$EXTERNALSYM _UnmanagedMarshalDisp} + +// *********************************************************************// +// Interface: IFormatter +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {93D7A8C5-D2EB-319B-A374-A65D321F2AA9} +// *********************************************************************// + IFormatter = interface(IDispatch) + ['{93D7A8C5-D2EB-319B-A374-A65D321F2AA9}'] + function Deserialize(const serializationStream: _Stream): OleVariant; safecall; + procedure Serialize(const serializationStream: _Stream; graph: OleVariant); safecall; + function Get_SurrogateSelector: ISurrogateSelector; safecall; + procedure _Set_SurrogateSelector(const pRetVal: ISurrogateSelector); safecall; + function Get_Binder: _SerializationBinder; safecall; + procedure _Set_Binder(const pRetVal: _SerializationBinder); safecall; + function Get_Context: StreamingContext; safecall; + procedure Set_Context(pRetVal: StreamingContext); safecall; + property SurrogateSelector: ISurrogateSelector read Get_SurrogateSelector; + property Binder: _SerializationBinder read Get_Binder; + property Context: StreamingContext read Get_Context; + end; + +// *********************************************************************// +// DispIntf: IFormatterDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {93D7A8C5-D2EB-319B-A374-A65D321F2AA9} +// *********************************************************************// + IFormatterDisp = dispinterface + ['{93D7A8C5-D2EB-319B-A374-A65D321F2AA9}'] + function Deserialize(const serializationStream: _Stream): OleVariant; dispid 1610743808; + procedure Serialize(const serializationStream: _Stream; graph: OleVariant); dispid 1610743809; + property SurrogateSelector: ISurrogateSelector readonly dispid 1610743810; + property Binder: _SerializationBinder readonly dispid 1610743812; + property Context: {??StreamingContext}OleVariant readonly dispid 1610743814; + end; + {$EXTERNALSYM IFormatterDisp} + +// *********************************************************************// +// Interface: _Formatter +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D9BD3C8D-9395-3657-B6EE-D1B509C38B70} +// *********************************************************************// + _Formatter = interface(IDispatch) + ['{D9BD3C8D-9395-3657-B6EE-D1B509C38B70}'] + end; + +// *********************************************************************// +// DispIntf: _FormatterDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D9BD3C8D-9395-3657-B6EE-D1B509C38B70} +// *********************************************************************// + _FormatterDisp = dispinterface + ['{D9BD3C8D-9395-3657-B6EE-D1B509C38B70}'] + end; + {$EXTERNALSYM _FormatterDisp} + +// *********************************************************************// +// Interface: IFormatterConverter +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {F4F5C303-FAD3-3D0C-A4DF-BB82B5EE308F} +// *********************************************************************// + IFormatterConverter = interface(IDispatch) + ['{F4F5C303-FAD3-3D0C-A4DF-BB82B5EE308F}'] + function Convert(value: OleVariant; const Type_: _Type): OleVariant; safecall; + function Convert_2(value: OleVariant; TypeCode: TypeCode): OleVariant; safecall; + function ToBoolean(value: OleVariant): WordBool; safecall; + function ToChar(value: OleVariant): Word; safecall; + function ToSByte(value: OleVariant): Shortint; safecall; + function ToByte(value: OleVariant): Byte; safecall; + function ToInt16(value: OleVariant): Smallint; safecall; + function ToUInt16(value: OleVariant): Word; safecall; + function ToInt32(value: OleVariant): Integer; safecall; + function ToUInt32(value: OleVariant): LongWord; safecall; + function ToInt64(value: OleVariant): Int64; safecall; + function ToUInt64(value: OleVariant): Largeuint; safecall; + function ToSingle(value: OleVariant): Single; safecall; + function ToDouble(value: OleVariant): Double; safecall; + function ToDecimal(value: OleVariant): TDecimal; safecall; + function ToDateTime(value: OleVariant): TDateTime; safecall; + function Get_ToString(value: OleVariant): WideString; safecall; + property ToString[value: OleVariant]: WideString read Get_ToString; + end; + +// *********************************************************************// +// DispIntf: IFormatterConverterDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {F4F5C303-FAD3-3D0C-A4DF-BB82B5EE308F} +// *********************************************************************// + IFormatterConverterDisp = dispinterface + ['{F4F5C303-FAD3-3D0C-A4DF-BB82B5EE308F}'] + function Convert(value: OleVariant; const Type_: _Type): OleVariant; dispid 1610743808; + function Convert_2(value: OleVariant; TypeCode: TypeCode): OleVariant; dispid 1610743809; + function ToBoolean(value: OleVariant): WordBool; dispid 1610743810; + function ToChar(value: OleVariant): {??Word}OleVariant; dispid 1610743811; + function ToSByte(value: OleVariant): {??Shortint}OleVariant; dispid 1610743812; + function ToByte(value: OleVariant): Byte; dispid 1610743813; + function ToInt16(value: OleVariant): Smallint; dispid 1610743814; + function ToUInt16(value: OleVariant): {??Word}OleVariant; dispid 1610743815; + function ToInt32(value: OleVariant): Integer; dispid 1610743816; + function ToUInt32(value: OleVariant): LongWord; dispid 1610743817; + function ToInt64(value: OleVariant): {??Int64}OleVariant; dispid 1610743818; + function ToUInt64(value: OleVariant): {??Largeuint}OleVariant; dispid 1610743819; + function ToSingle(value: OleVariant): Single; dispid 1610743820; + function ToDouble(value: OleVariant): Double; dispid 1610743821; + function ToDecimal(value: OleVariant): {??TDecimal}OleVariant; dispid 1610743822; + function ToDateTime(value: OleVariant): TDateTime; dispid 1610743823; + property ToString[value: OleVariant]: WideString readonly dispid 1610743824; + end; + {$EXTERNALSYM IFormatterConverterDisp} + +// *********************************************************************// +// Interface: _FormatterConverter +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3FAA35EE-C867-3E2E-BF48-2DA271F88303} +// *********************************************************************// + _FormatterConverter = interface(IDispatch) + ['{3FAA35EE-C867-3E2E-BF48-2DA271F88303}'] + end; + +// *********************************************************************// +// DispIntf: _FormatterConverterDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3FAA35EE-C867-3E2E-BF48-2DA271F88303} +// *********************************************************************// + _FormatterConverterDisp = dispinterface + ['{3FAA35EE-C867-3E2E-BF48-2DA271F88303}'] + end; + {$EXTERNALSYM _FormatterConverterDisp} + +// *********************************************************************// +// Interface: _FormatterServices +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F859954A-78CF-3D00-86AB-EF661E6A4B8D} +// *********************************************************************// + _FormatterServices = interface(IDispatch) + ['{F859954A-78CF-3D00-86AB-EF661E6A4B8D}'] + end; + +// *********************************************************************// +// DispIntf: _FormatterServicesDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F859954A-78CF-3D00-86AB-EF661E6A4B8D} +// *********************************************************************// + _FormatterServicesDisp = dispinterface + ['{F859954A-78CF-3D00-86AB-EF661E6A4B8D}'] + end; + {$EXTERNALSYM _FormatterServicesDisp} + +// *********************************************************************// +// Interface: ISerializationSurrogate +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {62339172-DBFA-337B-8AC8-053B241E06AB} +// *********************************************************************// + ISerializationSurrogate = interface(IDispatch) + ['{62339172-DBFA-337B-8AC8-053B241E06AB}'] + procedure GetObjectData(obj: OleVariant; const info: _SerializationInfo; + Context: StreamingContext); safecall; + function SetObjectData(obj: OleVariant; const info: _SerializationInfo; + Context: StreamingContext; const selector: ISurrogateSelector): OleVariant; safecall; + end; + +// *********************************************************************// +// DispIntf: ISerializationSurrogateDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {62339172-DBFA-337B-8AC8-053B241E06AB} +// *********************************************************************// + ISerializationSurrogateDisp = dispinterface + ['{62339172-DBFA-337B-8AC8-053B241E06AB}'] + procedure GetObjectData(obj: OleVariant; const info: _SerializationInfo; + Context: {??StreamingContext}OleVariant); dispid 1610743808; + function SetObjectData(obj: OleVariant; const info: _SerializationInfo; + Context: {??StreamingContext}OleVariant; + const selector: ISurrogateSelector): OleVariant; dispid 1610743809; + end; + {$EXTERNALSYM ISerializationSurrogateDisp} + +// *********************************************************************// +// Interface: ISurrogateSelector +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {7C66FF18-A1A5-3E19-857B-0E7B6A9E3F38} +// *********************************************************************// + ISurrogateSelector = interface(IDispatch) + ['{7C66FF18-A1A5-3E19-857B-0E7B6A9E3F38}'] + procedure ChainSelector(const selector: ISurrogateSelector); safecall; + function GetSurrogate(const Type_: _Type; Context: StreamingContext; + out selector: ISurrogateSelector): ISerializationSurrogate; safecall; + function GetNextSelector: ISurrogateSelector; safecall; + end; + +// *********************************************************************// +// DispIntf: ISurrogateSelectorDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {7C66FF18-A1A5-3E19-857B-0E7B6A9E3F38} +// *********************************************************************// + ISurrogateSelectorDisp = dispinterface + ['{7C66FF18-A1A5-3E19-857B-0E7B6A9E3F38}'] + procedure ChainSelector(const selector: ISurrogateSelector); dispid 1610743808; + function GetSurrogate(const Type_: _Type; Context: {??StreamingContext}OleVariant; + out selector: ISurrogateSelector): ISerializationSurrogate; dispid 1610743809; + function GetNextSelector: ISurrogateSelector; dispid 1610743810; + end; + {$EXTERNALSYM ISurrogateSelectorDisp} + +// *********************************************************************// +// Interface: _ObjectIDGenerator +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A30646CC-F710-3BFA-A356-B4C858D4ED8E} +// *********************************************************************// + _ObjectIDGenerator = interface(IDispatch) + ['{A30646CC-F710-3BFA-A356-B4C858D4ED8E}'] + end; + +// *********************************************************************// +// DispIntf: _ObjectIDGeneratorDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A30646CC-F710-3BFA-A356-B4C858D4ED8E} +// *********************************************************************// + _ObjectIDGeneratorDisp = dispinterface + ['{A30646CC-F710-3BFA-A356-B4C858D4ED8E}'] + end; + {$EXTERNALSYM _ObjectIDGeneratorDisp} + +// *********************************************************************// +// Interface: _ObjectManager +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F28E7D04-3319-3968-8201-C6E55BECD3D4} +// *********************************************************************// + _ObjectManager = interface(IDispatch) + ['{F28E7D04-3319-3968-8201-C6E55BECD3D4}'] + end; + +// *********************************************************************// +// DispIntf: _ObjectManagerDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F28E7D04-3319-3968-8201-C6E55BECD3D4} +// *********************************************************************// + _ObjectManagerDisp = dispinterface + ['{F28E7D04-3319-3968-8201-C6E55BECD3D4}'] + end; + {$EXTERNALSYM _ObjectManagerDisp} + +// *********************************************************************// +// Interface: _SerializationBinder +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {450222D0-87CA-3699-A7B4-D8A0FDB72357} +// *********************************************************************// + _SerializationBinder = interface(IDispatch) + ['{450222D0-87CA-3699-A7B4-D8A0FDB72357}'] + end; + +// *********************************************************************// +// DispIntf: _SerializationBinderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {450222D0-87CA-3699-A7B4-D8A0FDB72357} +// *********************************************************************// + _SerializationBinderDisp = dispinterface + ['{450222D0-87CA-3699-A7B4-D8A0FDB72357}'] + end; + {$EXTERNALSYM _SerializationBinderDisp} + +// *********************************************************************// +// Interface: _SerializationInfo +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B58D62CF-B03A-3A14-B0B6-B1E5AD4E4AD5} +// *********************************************************************// + _SerializationInfo = interface(IDispatch) + ['{B58D62CF-B03A-3A14-B0B6-B1E5AD4E4AD5}'] + end; + +// *********************************************************************// +// DispIntf: _SerializationInfoDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B58D62CF-B03A-3A14-B0B6-B1E5AD4E4AD5} +// *********************************************************************// + _SerializationInfoDisp = dispinterface + ['{B58D62CF-B03A-3A14-B0B6-B1E5AD4E4AD5}'] + end; + {$EXTERNALSYM _SerializationInfoDisp} + +// *********************************************************************// +// Interface: _SerializationInfoEnumerator +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {607056C6-1BCA-36C8-AB87-33B202EBF0D8} +// *********************************************************************// + _SerializationInfoEnumerator = interface(IDispatch) + ['{607056C6-1BCA-36C8-AB87-33B202EBF0D8}'] + end; + +// *********************************************************************// +// DispIntf: _SerializationInfoEnumeratorDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {607056C6-1BCA-36C8-AB87-33B202EBF0D8} +// *********************************************************************// + _SerializationInfoEnumeratorDisp = dispinterface + ['{607056C6-1BCA-36C8-AB87-33B202EBF0D8}'] + end; + {$EXTERNALSYM _SerializationInfoEnumeratorDisp} + +// *********************************************************************// +// Interface: _SerializationException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {245FE7FD-E020-3053-B5F6-7467FD2C6883} +// *********************************************************************// + _SerializationException = interface(IDispatch) + ['{245FE7FD-E020-3053-B5F6-7467FD2C6883}'] + end; + +// *********************************************************************// +// DispIntf: _SerializationExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {245FE7FD-E020-3053-B5F6-7467FD2C6883} +// *********************************************************************// + _SerializationExceptionDisp = dispinterface + ['{245FE7FD-E020-3053-B5F6-7467FD2C6883}'] + end; + {$EXTERNALSYM _SerializationExceptionDisp} + +// *********************************************************************// +// Interface: _SurrogateSelector +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6DE1230E-1F52-3779-9619-F5184103466C} +// *********************************************************************// + _SurrogateSelector = interface(IDispatch) + ['{6DE1230E-1F52-3779-9619-F5184103466C}'] + end; + +// *********************************************************************// +// DispIntf: _SurrogateSelectorDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6DE1230E-1F52-3779-9619-F5184103466C} +// *********************************************************************// + _SurrogateSelectorDisp = dispinterface + ['{6DE1230E-1F52-3779-9619-F5184103466C}'] + end; + {$EXTERNALSYM _SurrogateSelectorDisp} + +// *********************************************************************// +// Interface: _Calendar +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4CCA29E4-584B-3CD0-AD25-855DC5799C16} +// *********************************************************************// + _Calendar = interface(IDispatch) + ['{4CCA29E4-584B-3CD0-AD25-855DC5799C16}'] + end; + +// *********************************************************************// +// DispIntf: _CalendarDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4CCA29E4-584B-3CD0-AD25-855DC5799C16} +// *********************************************************************// + _CalendarDisp = dispinterface + ['{4CCA29E4-584B-3CD0-AD25-855DC5799C16}'] + end; + {$EXTERNALSYM _CalendarDisp} + +// *********************************************************************// +// Interface: _CompareInfo +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {505DEFE5-AEFA-3E23-82B0-D5EB085BB840} +// *********************************************************************// + _CompareInfo = interface(IDispatch) + ['{505DEFE5-AEFA-3E23-82B0-D5EB085BB840}'] + end; + +// *********************************************************************// +// DispIntf: _CompareInfoDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {505DEFE5-AEFA-3E23-82B0-D5EB085BB840} +// *********************************************************************// + _CompareInfoDisp = dispinterface + ['{505DEFE5-AEFA-3E23-82B0-D5EB085BB840}'] + end; + {$EXTERNALSYM _CompareInfoDisp} + +// *********************************************************************// +// Interface: _CultureInfo +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {152722C2-F0B1-3D19-ADA8-F40CA5CAECB8} +// *********************************************************************// + _CultureInfo = interface(IDispatch) + ['{152722C2-F0B1-3D19-ADA8-F40CA5CAECB8}'] + end; + +// *********************************************************************// +// DispIntf: _CultureInfoDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {152722C2-F0B1-3D19-ADA8-F40CA5CAECB8} +// *********************************************************************// + _CultureInfoDisp = dispinterface + ['{152722C2-F0B1-3D19-ADA8-F40CA5CAECB8}'] + end; + {$EXTERNALSYM _CultureInfoDisp} + +// *********************************************************************// +// Interface: _DateTimeFormatInfo +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {015E9F67-337C-398A-A0C1-DA4AF1905571} +// *********************************************************************// + _DateTimeFormatInfo = interface(IDispatch) + ['{015E9F67-337C-398A-A0C1-DA4AF1905571}'] + end; + +// *********************************************************************// +// DispIntf: _DateTimeFormatInfoDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {015E9F67-337C-398A-A0C1-DA4AF1905571} +// *********************************************************************// + _DateTimeFormatInfoDisp = dispinterface + ['{015E9F67-337C-398A-A0C1-DA4AF1905571}'] + end; + {$EXTERNALSYM _DateTimeFormatInfoDisp} + +// *********************************************************************// +// Interface: _DaylightTime +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {EFEA8FEB-EE7F-3E48-8A36-6206A6ACBF73} +// *********************************************************************// + _DaylightTime = interface(IDispatch) + ['{EFEA8FEB-EE7F-3E48-8A36-6206A6ACBF73}'] + end; + +// *********************************************************************// +// DispIntf: _DaylightTimeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {EFEA8FEB-EE7F-3E48-8A36-6206A6ACBF73} +// *********************************************************************// + _DaylightTimeDisp = dispinterface + ['{EFEA8FEB-EE7F-3E48-8A36-6206A6ACBF73}'] + end; + {$EXTERNALSYM _DaylightTimeDisp} + +// *********************************************************************// +// Interface: _GregorianCalendar +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {677AD8B5-8A0E-3C39-92FB-72FB817CF694} +// *********************************************************************// + _GregorianCalendar = interface(IDispatch) + ['{677AD8B5-8A0E-3C39-92FB-72FB817CF694}'] + end; + +// *********************************************************************// +// DispIntf: _GregorianCalendarDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {677AD8B5-8A0E-3C39-92FB-72FB817CF694} +// *********************************************************************// + _GregorianCalendarDisp = dispinterface + ['{677AD8B5-8A0E-3C39-92FB-72FB817CF694}'] + end; + {$EXTERNALSYM _GregorianCalendarDisp} + +// *********************************************************************// +// Interface: _HebrewCalendar +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {96A62D6C-72A9-387A-81FA-E6DD5998CAEE} +// *********************************************************************// + _HebrewCalendar = interface(IDispatch) + ['{96A62D6C-72A9-387A-81FA-E6DD5998CAEE}'] + end; + +// *********************************************************************// +// DispIntf: _HebrewCalendarDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {96A62D6C-72A9-387A-81FA-E6DD5998CAEE} +// *********************************************************************// + _HebrewCalendarDisp = dispinterface + ['{96A62D6C-72A9-387A-81FA-E6DD5998CAEE}'] + end; + {$EXTERNALSYM _HebrewCalendarDisp} + +// *********************************************************************// +// Interface: _HijriCalendar +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {28DDC187-56B2-34CF-A078-48BD1E113D1E} +// *********************************************************************// + _HijriCalendar = interface(IDispatch) + ['{28DDC187-56B2-34CF-A078-48BD1E113D1E}'] + end; + +// *********************************************************************// +// DispIntf: _HijriCalendarDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {28DDC187-56B2-34CF-A078-48BD1E113D1E} +// *********************************************************************// + _HijriCalendarDisp = dispinterface + ['{28DDC187-56B2-34CF-A078-48BD1E113D1E}'] + end; + {$EXTERNALSYM _HijriCalendarDisp} + +// *********************************************************************// +// Interface: _JapaneseCalendar +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D662AE3F-CEF9-38B4-BB8E-5D8DD1DBF806} +// *********************************************************************// + _JapaneseCalendar = interface(IDispatch) + ['{D662AE3F-CEF9-38B4-BB8E-5D8DD1DBF806}'] + end; + +// *********************************************************************// +// DispIntf: _JapaneseCalendarDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D662AE3F-CEF9-38B4-BB8E-5D8DD1DBF806} +// *********************************************************************// + _JapaneseCalendarDisp = dispinterface + ['{D662AE3F-CEF9-38B4-BB8E-5D8DD1DBF806}'] + end; + {$EXTERNALSYM _JapaneseCalendarDisp} + +// *********************************************************************// +// Interface: _JulianCalendar +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {36E2DE92-1FB3-3D7D-BA26-9CAD5B98DD52} +// *********************************************************************// + _JulianCalendar = interface(IDispatch) + ['{36E2DE92-1FB3-3D7D-BA26-9CAD5B98DD52}'] + end; + +// *********************************************************************// +// DispIntf: _JulianCalendarDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {36E2DE92-1FB3-3D7D-BA26-9CAD5B98DD52} +// *********************************************************************// + _JulianCalendarDisp = dispinterface + ['{36E2DE92-1FB3-3D7D-BA26-9CAD5B98DD52}'] + end; + {$EXTERNALSYM _JulianCalendarDisp} + +// *********************************************************************// +// Interface: _KoreanCalendar +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {48BEA6C4-752E-3974-8CA8-CFB6274E2379} +// *********************************************************************// + _KoreanCalendar = interface(IDispatch) + ['{48BEA6C4-752E-3974-8CA8-CFB6274E2379}'] + end; + +// *********************************************************************// +// DispIntf: _KoreanCalendarDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {48BEA6C4-752E-3974-8CA8-CFB6274E2379} +// *********************************************************************// + _KoreanCalendarDisp = dispinterface + ['{48BEA6C4-752E-3974-8CA8-CFB6274E2379}'] + end; + {$EXTERNALSYM _KoreanCalendarDisp} + +// *********************************************************************// +// Interface: _RegionInfo +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F9E97E04-4E1E-368F-B6C6-5E96CE4362D6} +// *********************************************************************// + _RegionInfo = interface(IDispatch) + ['{F9E97E04-4E1E-368F-B6C6-5E96CE4362D6}'] + end; + +// *********************************************************************// +// DispIntf: _RegionInfoDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F9E97E04-4E1E-368F-B6C6-5E96CE4362D6} +// *********************************************************************// + _RegionInfoDisp = dispinterface + ['{F9E97E04-4E1E-368F-B6C6-5E96CE4362D6}'] + end; + {$EXTERNALSYM _RegionInfoDisp} + +// *********************************************************************// +// Interface: _SortKey +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F4C70E15-2CA6-3E90-96ED-92E28491F538} +// *********************************************************************// + _SortKey = interface(IDispatch) + ['{F4C70E15-2CA6-3E90-96ED-92E28491F538}'] + end; + +// *********************************************************************// +// DispIntf: _SortKeyDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F4C70E15-2CA6-3E90-96ED-92E28491F538} +// *********************************************************************// + _SortKeyDisp = dispinterface + ['{F4C70E15-2CA6-3E90-96ED-92E28491F538}'] + end; + {$EXTERNALSYM _SortKeyDisp} + +// *********************************************************************// +// Interface: _StringInfo +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0A25141F-51B3-3121-AA30-0AF4556A52D9} +// *********************************************************************// + _StringInfo = interface(IDispatch) + ['{0A25141F-51B3-3121-AA30-0AF4556A52D9}'] + end; + +// *********************************************************************// +// DispIntf: _StringInfoDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0A25141F-51B3-3121-AA30-0AF4556A52D9} +// *********************************************************************// + _StringInfoDisp = dispinterface + ['{0A25141F-51B3-3121-AA30-0AF4556A52D9}'] + end; + {$EXTERNALSYM _StringInfoDisp} + +// *********************************************************************// +// Interface: _TaiwanCalendar +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0C08ED74-0ACF-32A9-99DF-09A9DC4786DD} +// *********************************************************************// + _TaiwanCalendar = interface(IDispatch) + ['{0C08ED74-0ACF-32A9-99DF-09A9DC4786DD}'] + end; + +// *********************************************************************// +// DispIntf: _TaiwanCalendarDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0C08ED74-0ACF-32A9-99DF-09A9DC4786DD} +// *********************************************************************// + _TaiwanCalendarDisp = dispinterface + ['{0C08ED74-0ACF-32A9-99DF-09A9DC4786DD}'] + end; + {$EXTERNALSYM _TaiwanCalendarDisp} + +// *********************************************************************// +// Interface: _TextElementEnumerator +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8C248251-3E6C-3151-9F8E-A255FB8D2B12} +// *********************************************************************// + _TextElementEnumerator = interface(IDispatch) + ['{8C248251-3E6C-3151-9F8E-A255FB8D2B12}'] + end; + +// *********************************************************************// +// DispIntf: _TextElementEnumeratorDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8C248251-3E6C-3151-9F8E-A255FB8D2B12} +// *********************************************************************// + _TextElementEnumeratorDisp = dispinterface + ['{8C248251-3E6C-3151-9F8E-A255FB8D2B12}'] + end; + {$EXTERNALSYM _TextElementEnumeratorDisp} + +// *********************************************************************// +// Interface: _TextInfo +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DB8DE23F-F264-39AC-B61C-CC1E7EB4A5E6} +// *********************************************************************// + _TextInfo = interface(IDispatch) + ['{DB8DE23F-F264-39AC-B61C-CC1E7EB4A5E6}'] + end; + +// *********************************************************************// +// DispIntf: _TextInfoDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DB8DE23F-F264-39AC-B61C-CC1E7EB4A5E6} +// *********************************************************************// + _TextInfoDisp = dispinterface + ['{DB8DE23F-F264-39AC-B61C-CC1E7EB4A5E6}'] + end; + {$EXTERNALSYM _TextInfoDisp} + +// *********************************************************************// +// Interface: _ThaiBuddhistCalendar +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C70C8AE8-925B-37CE-8944-34F15FF94307} +// *********************************************************************// + _ThaiBuddhistCalendar = interface(IDispatch) + ['{C70C8AE8-925B-37CE-8944-34F15FF94307}'] + end; + +// *********************************************************************// +// DispIntf: _ThaiBuddhistCalendarDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C70C8AE8-925B-37CE-8944-34F15FF94307} +// *********************************************************************// + _ThaiBuddhistCalendarDisp = dispinterface + ['{C70C8AE8-925B-37CE-8944-34F15FF94307}'] + end; + {$EXTERNALSYM _ThaiBuddhistCalendarDisp} + +// *********************************************************************// +// Interface: _NumberFormatInfo +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {25E47D71-20DD-31BE-B261-7AE76497D6B9} +// *********************************************************************// + _NumberFormatInfo = interface(IDispatch) + ['{25E47D71-20DD-31BE-B261-7AE76497D6B9}'] + end; + +// *********************************************************************// +// DispIntf: _NumberFormatInfoDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {25E47D71-20DD-31BE-B261-7AE76497D6B9} +// *********************************************************************// + _NumberFormatInfoDisp = dispinterface + ['{25E47D71-20DD-31BE-B261-7AE76497D6B9}'] + end; + {$EXTERNALSYM _NumberFormatInfoDisp} + +// *********************************************************************// +// Interface: _Encoding +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DDEDB94D-4F3F-35C1-97C9-3F1D87628D9E} +// *********************************************************************// + _Encoding = interface(IDispatch) + ['{DDEDB94D-4F3F-35C1-97C9-3F1D87628D9E}'] + end; + +// *********************************************************************// +// DispIntf: _EncodingDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DDEDB94D-4F3F-35C1-97C9-3F1D87628D9E} +// *********************************************************************// + _EncodingDisp = dispinterface + ['{DDEDB94D-4F3F-35C1-97C9-3F1D87628D9E}'] + end; + {$EXTERNALSYM _EncodingDisp} + +// *********************************************************************// +// Interface: _System_Text_Decoder +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {2ADB0D4A-5976-38E4-852B-C131797430F5} +// *********************************************************************// + _System_Text_Decoder = interface(IDispatch) + ['{2ADB0D4A-5976-38E4-852B-C131797430F5}'] + end; + +// *********************************************************************// +// DispIntf: _System_Text_DecoderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {2ADB0D4A-5976-38E4-852B-C131797430F5} +// *********************************************************************// + _System_Text_DecoderDisp = dispinterface + ['{2ADB0D4A-5976-38E4-852B-C131797430F5}'] + end; + {$EXTERNALSYM _System_Text_DecoderDisp} + +// *********************************************************************// +// Interface: _System_Text_Encoder +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8FD56502-8724-3DF0-A1B5-9D0E8D4E4F78} +// *********************************************************************// + _System_Text_Encoder = interface(IDispatch) + ['{8FD56502-8724-3DF0-A1B5-9D0E8D4E4F78}'] + end; + +// *********************************************************************// +// DispIntf: _System_Text_EncoderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8FD56502-8724-3DF0-A1B5-9D0E8D4E4F78} +// *********************************************************************// + _System_Text_EncoderDisp = dispinterface + ['{8FD56502-8724-3DF0-A1B5-9D0E8D4E4F78}'] + end; + {$EXTERNALSYM _System_Text_EncoderDisp} + +// *********************************************************************// +// Interface: _ASCIIEncoding +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0CBE0204-12A1-3D40-9D9E-195DE6AAA534} +// *********************************************************************// + _ASCIIEncoding = interface(IDispatch) + ['{0CBE0204-12A1-3D40-9D9E-195DE6AAA534}'] + end; + +// *********************************************************************// +// DispIntf: _ASCIIEncodingDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0CBE0204-12A1-3D40-9D9E-195DE6AAA534} +// *********************************************************************// + _ASCIIEncodingDisp = dispinterface + ['{0CBE0204-12A1-3D40-9D9E-195DE6AAA534}'] + end; + {$EXTERNALSYM _ASCIIEncodingDisp} + +// *********************************************************************// +// Interface: _UnicodeEncoding +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F7DD3B7F-2B05-3894-8EDA-59CDF9395B6A} +// *********************************************************************// + _UnicodeEncoding = interface(IDispatch) + ['{F7DD3B7F-2B05-3894-8EDA-59CDF9395B6A}'] + end; + +// *********************************************************************// +// DispIntf: _UnicodeEncodingDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F7DD3B7F-2B05-3894-8EDA-59CDF9395B6A} +// *********************************************************************// + _UnicodeEncodingDisp = dispinterface + ['{F7DD3B7F-2B05-3894-8EDA-59CDF9395B6A}'] + end; + {$EXTERNALSYM _UnicodeEncodingDisp} + +// *********************************************************************// +// Interface: _UTF7Encoding +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {89B9F00B-AA2A-3A49-91B4-E8D1F1C00E58} +// *********************************************************************// + _UTF7Encoding = interface(IDispatch) + ['{89B9F00B-AA2A-3A49-91B4-E8D1F1C00E58}'] + end; + +// *********************************************************************// +// DispIntf: _UTF7EncodingDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {89B9F00B-AA2A-3A49-91B4-E8D1F1C00E58} +// *********************************************************************// + _UTF7EncodingDisp = dispinterface + ['{89B9F00B-AA2A-3A49-91B4-E8D1F1C00E58}'] + end; + {$EXTERNALSYM _UTF7EncodingDisp} + +// *********************************************************************// +// Interface: _UTF8Encoding +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {010FC1D0-3EF9-3F3B-AA0A-B78A1FF83A37} +// *********************************************************************// + _UTF8Encoding = interface(IDispatch) + ['{010FC1D0-3EF9-3F3B-AA0A-B78A1FF83A37}'] + end; + +// *********************************************************************// +// DispIntf: _UTF8EncodingDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {010FC1D0-3EF9-3F3B-AA0A-B78A1FF83A37} +// *********************************************************************// + _UTF8EncodingDisp = dispinterface + ['{010FC1D0-3EF9-3F3B-AA0A-B78A1FF83A37}'] + end; + {$EXTERNALSYM _UTF8EncodingDisp} + +// *********************************************************************// +// Interface: IResourceReader +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {8965A22F-FBA8-36AD-8132-70BBD0DA457D} +// *********************************************************************// + IResourceReader = interface(IDispatch) + ['{8965A22F-FBA8-36AD-8132-70BBD0DA457D}'] + procedure Close; safecall; + function GetEnumerator: IDictionaryEnumerator; safecall; + end; + +// *********************************************************************// +// DispIntf: IResourceReaderDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {8965A22F-FBA8-36AD-8132-70BBD0DA457D} +// *********************************************************************// + IResourceReaderDisp = dispinterface + ['{8965A22F-FBA8-36AD-8132-70BBD0DA457D}'] + procedure Close; dispid 1610743808; + function GetEnumerator: IDictionaryEnumerator; dispid 1610743809; + end; + {$EXTERNALSYM IResourceReaderDisp} + +// *********************************************************************// +// Interface: IResourceWriter +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {E97AA6E5-595E-31C3-82F0-688FB91954C6} +// *********************************************************************// + IResourceWriter = interface(IDispatch) + ['{E97AA6E5-595E-31C3-82F0-688FB91954C6}'] + procedure AddResource(const name: WideString; const value: WideString); safecall; + procedure AddResource_2(const name: WideString; value: OleVariant); safecall; + procedure AddResource_3(const name: WideString; value: PSafeArray); safecall; + procedure Close; safecall; + procedure Generate; safecall; + end; + +// *********************************************************************// +// DispIntf: IResourceWriterDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {E97AA6E5-595E-31C3-82F0-688FB91954C6} +// *********************************************************************// + IResourceWriterDisp = dispinterface + ['{E97AA6E5-595E-31C3-82F0-688FB91954C6}'] + procedure AddResource(const name: WideString; const value: WideString); dispid 1610743808; + procedure AddResource_2(const name: WideString; value: OleVariant); dispid 1610743809; + procedure AddResource_3(const name: WideString; value: {??PSafeArray}OleVariant); dispid 1610743810; + procedure Close; dispid 1610743811; + procedure Generate; dispid 1610743812; + end; + {$EXTERNALSYM IResourceWriterDisp} + +// *********************************************************************// +// Interface: _MissingManifestResourceException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1A4E1878-FE8C-3F59-B6A9-21AB82BE57E9} +// *********************************************************************// + _MissingManifestResourceException = interface(IDispatch) + ['{1A4E1878-FE8C-3F59-B6A9-21AB82BE57E9}'] + end; + +// *********************************************************************// +// DispIntf: _MissingManifestResourceExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1A4E1878-FE8C-3F59-B6A9-21AB82BE57E9} +// *********************************************************************// + _MissingManifestResourceExceptionDisp = dispinterface + ['{1A4E1878-FE8C-3F59-B6A9-21AB82BE57E9}'] + end; + {$EXTERNALSYM _MissingManifestResourceExceptionDisp} + +// *********************************************************************// +// Interface: _NeutralResourcesLanguageAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F48DF808-8B7D-3F4E-9159-1DFD60F298D6} +// *********************************************************************// + _NeutralResourcesLanguageAttribute = interface(IDispatch) + ['{F48DF808-8B7D-3F4E-9159-1DFD60F298D6}'] + end; + +// *********************************************************************// +// DispIntf: _NeutralResourcesLanguageAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F48DF808-8B7D-3F4E-9159-1DFD60F298D6} +// *********************************************************************// + _NeutralResourcesLanguageAttributeDisp = dispinterface + ['{F48DF808-8B7D-3F4E-9159-1DFD60F298D6}'] + end; + {$EXTERNALSYM _NeutralResourcesLanguageAttributeDisp} + +// *********************************************************************// +// Interface: _ResourceManager +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4DE671B7-7C85-37E9-AFF8-1222ABE4883E} +// *********************************************************************// + _ResourceManager = interface(IDispatch) + ['{4DE671B7-7C85-37E9-AFF8-1222ABE4883E}'] + end; + +// *********************************************************************// +// DispIntf: _ResourceManagerDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4DE671B7-7C85-37E9-AFF8-1222ABE4883E} +// *********************************************************************// + _ResourceManagerDisp = dispinterface + ['{4DE671B7-7C85-37E9-AFF8-1222ABE4883E}'] + end; + {$EXTERNALSYM _ResourceManagerDisp} + +// *********************************************************************// +// Interface: _ResourceReader +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7FBCFDC7-5CEC-3945-8095-DAED61BE5FB1} +// *********************************************************************// + _ResourceReader = interface(IDispatch) + ['{7FBCFDC7-5CEC-3945-8095-DAED61BE5FB1}'] + end; + +// *********************************************************************// +// DispIntf: _ResourceReaderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7FBCFDC7-5CEC-3945-8095-DAED61BE5FB1} +// *********************************************************************// + _ResourceReaderDisp = dispinterface + ['{7FBCFDC7-5CEC-3945-8095-DAED61BE5FB1}'] + end; + {$EXTERNALSYM _ResourceReaderDisp} + +// *********************************************************************// +// Interface: _ResourceSet +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {44D5F81A-727C-35AE-8DF8-9FF6722F1C6C} +// *********************************************************************// + _ResourceSet = interface(IDispatch) + ['{44D5F81A-727C-35AE-8DF8-9FF6722F1C6C}'] + end; + +// *********************************************************************// +// DispIntf: _ResourceSetDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {44D5F81A-727C-35AE-8DF8-9FF6722F1C6C} +// *********************************************************************// + _ResourceSetDisp = dispinterface + ['{44D5F81A-727C-35AE-8DF8-9FF6722F1C6C}'] + end; + {$EXTERNALSYM _ResourceSetDisp} + +// *********************************************************************// +// Interface: _ResourceWriter +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AF170258-AAC6-3A86-BD34-303E62CED10E} +// *********************************************************************// + _ResourceWriter = interface(IDispatch) + ['{AF170258-AAC6-3A86-BD34-303E62CED10E}'] + end; + +// *********************************************************************// +// DispIntf: _ResourceWriterDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AF170258-AAC6-3A86-BD34-303E62CED10E} +// *********************************************************************// + _ResourceWriterDisp = dispinterface + ['{AF170258-AAC6-3A86-BD34-303E62CED10E}'] + end; + {$EXTERNALSYM _ResourceWriterDisp} + +// *********************************************************************// +// Interface: _SatelliteContractVersionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {5CBB1F47-FBA5-33B9-9D4A-57D6E3D133D2} +// *********************************************************************// + _SatelliteContractVersionAttribute = interface(IDispatch) + ['{5CBB1F47-FBA5-33B9-9D4A-57D6E3D133D2}'] + end; + +// *********************************************************************// +// DispIntf: _SatelliteContractVersionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {5CBB1F47-FBA5-33B9-9D4A-57D6E3D133D2} +// *********************************************************************// + _SatelliteContractVersionAttributeDisp = dispinterface + ['{5CBB1F47-FBA5-33B9-9D4A-57D6E3D133D2}'] + end; + {$EXTERNALSYM _SatelliteContractVersionAttributeDisp} + +// *********************************************************************// +// Interface: _Registry +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {23BAE0C0-3A36-32F0-9DAD-0E95ADD67D23} +// *********************************************************************// + _Registry = interface(IDispatch) + ['{23BAE0C0-3A36-32F0-9DAD-0E95ADD67D23}'] + end; + +// *********************************************************************// +// DispIntf: _RegistryDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {23BAE0C0-3A36-32F0-9DAD-0E95ADD67D23} +// *********************************************************************// + _RegistryDisp = dispinterface + ['{23BAE0C0-3A36-32F0-9DAD-0E95ADD67D23}'] + end; + {$EXTERNALSYM _RegistryDisp} + +// *********************************************************************// +// Interface: _RegistryKey +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {2EAC6733-8D92-31D9-BE04-DC467EFC3EB1} +// *********************************************************************// + _RegistryKey = interface(IDispatch) + ['{2EAC6733-8D92-31D9-BE04-DC467EFC3EB1}'] + end; + +// *********************************************************************// +// DispIntf: _RegistryKeyDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {2EAC6733-8D92-31D9-BE04-DC467EFC3EB1} +// *********************************************************************// + _RegistryKeyDisp = dispinterface + ['{2EAC6733-8D92-31D9-BE04-DC467EFC3EB1}'] + end; + {$EXTERNALSYM _RegistryKeyDisp} + +// *********************************************************************// +// Interface: _X509Certificate +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {68FD6F14-A7B2-36C8-A724-D01F90D73477} +// *********************************************************************// + _X509Certificate = interface(IDispatch) + ['{68FD6F14-A7B2-36C8-A724-D01F90D73477}'] + end; + +// *********************************************************************// +// DispIntf: _X509CertificateDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {68FD6F14-A7B2-36C8-A724-D01F90D73477} +// *********************************************************************// + _X509CertificateDisp = dispinterface + ['{68FD6F14-A7B2-36C8-A724-D01F90D73477}'] + end; + {$EXTERNALSYM _X509CertificateDisp} + +// *********************************************************************// +// Interface: _AsymmetricAlgorithm +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {09343AC0-D19A-3E62-BC16-0F600F10180A} +// *********************************************************************// + _AsymmetricAlgorithm = interface(IDispatch) + ['{09343AC0-D19A-3E62-BC16-0F600F10180A}'] + end; + +// *********************************************************************// +// DispIntf: _AsymmetricAlgorithmDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {09343AC0-D19A-3E62-BC16-0F600F10180A} +// *********************************************************************// + _AsymmetricAlgorithmDisp = dispinterface + ['{09343AC0-D19A-3E62-BC16-0F600F10180A}'] + end; + {$EXTERNALSYM _AsymmetricAlgorithmDisp} + +// *********************************************************************// +// Interface: _AsymmetricKeyExchangeDeformatter +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B6685CCA-7A49-37D1-A805-3DE829CB8DEB} +// *********************************************************************// + _AsymmetricKeyExchangeDeformatter = interface(IDispatch) + ['{B6685CCA-7A49-37D1-A805-3DE829CB8DEB}'] + end; + +// *********************************************************************// +// DispIntf: _AsymmetricKeyExchangeDeformatterDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B6685CCA-7A49-37D1-A805-3DE829CB8DEB} +// *********************************************************************// + _AsymmetricKeyExchangeDeformatterDisp = dispinterface + ['{B6685CCA-7A49-37D1-A805-3DE829CB8DEB}'] + end; + {$EXTERNALSYM _AsymmetricKeyExchangeDeformatterDisp} + +// *********************************************************************// +// Interface: _AsymmetricKeyExchangeFormatter +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1365B84B-6477-3C40-BE6A-089DC01ECED9} +// *********************************************************************// + _AsymmetricKeyExchangeFormatter = interface(IDispatch) + ['{1365B84B-6477-3C40-BE6A-089DC01ECED9}'] + end; + +// *********************************************************************// +// DispIntf: _AsymmetricKeyExchangeFormatterDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1365B84B-6477-3C40-BE6A-089DC01ECED9} +// *********************************************************************// + _AsymmetricKeyExchangeFormatterDisp = dispinterface + ['{1365B84B-6477-3C40-BE6A-089DC01ECED9}'] + end; + {$EXTERNALSYM _AsymmetricKeyExchangeFormatterDisp} + +// *********************************************************************// +// Interface: _AsymmetricSignatureDeformatter +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7CA5FE57-D1AC-3064-BB0B-F450BE40F194} +// *********************************************************************// + _AsymmetricSignatureDeformatter = interface(IDispatch) + ['{7CA5FE57-D1AC-3064-BB0B-F450BE40F194}'] + end; + +// *********************************************************************// +// DispIntf: _AsymmetricSignatureDeformatterDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7CA5FE57-D1AC-3064-BB0B-F450BE40F194} +// *********************************************************************// + _AsymmetricSignatureDeformatterDisp = dispinterface + ['{7CA5FE57-D1AC-3064-BB0B-F450BE40F194}'] + end; + {$EXTERNALSYM _AsymmetricSignatureDeformatterDisp} + +// *********************************************************************// +// Interface: _AsymmetricSignatureFormatter +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {5363D066-6295-3618-BE33-3F0B070B7976} +// *********************************************************************// + _AsymmetricSignatureFormatter = interface(IDispatch) + ['{5363D066-6295-3618-BE33-3F0B070B7976}'] + end; + +// *********************************************************************// +// DispIntf: _AsymmetricSignatureFormatterDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {5363D066-6295-3618-BE33-3F0B070B7976} +// *********************************************************************// + _AsymmetricSignatureFormatterDisp = dispinterface + ['{5363D066-6295-3618-BE33-3F0B070B7976}'] + end; + {$EXTERNALSYM _AsymmetricSignatureFormatterDisp} + +// *********************************************************************// +// Interface: ICryptoTransform +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {8ABAD867-F515-3CF6-BB62-5F0C88B3BB11} +// *********************************************************************// + ICryptoTransform = interface(IDispatch) + ['{8ABAD867-F515-3CF6-BB62-5F0C88B3BB11}'] + function Get_InputBlockSize: Integer; safecall; + function Get_OutputBlockSize: Integer; safecall; + function Get_CanTransformMultipleBlocks: WordBool; safecall; + function Get_CanReuseTransform: WordBool; safecall; + function TransformBlock(inputBuffer: PSafeArray; inputOffset: Integer; inputCount: Integer; + outputBuffer: PSafeArray; outputOffset: Integer): Integer; safecall; + function TransformFinalBlock(inputBuffer: PSafeArray; inputOffset: Integer; inputCount: Integer): PSafeArray; safecall; + property InputBlockSize: Integer read Get_InputBlockSize; + property OutputBlockSize: Integer read Get_OutputBlockSize; + property CanTransformMultipleBlocks: WordBool read Get_CanTransformMultipleBlocks; + property CanReuseTransform: WordBool read Get_CanReuseTransform; + end; + +// *********************************************************************// +// DispIntf: ICryptoTransformDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {8ABAD867-F515-3CF6-BB62-5F0C88B3BB11} +// *********************************************************************// + ICryptoTransformDisp = dispinterface + ['{8ABAD867-F515-3CF6-BB62-5F0C88B3BB11}'] + property InputBlockSize: Integer readonly dispid 1610743808; + property OutputBlockSize: Integer readonly dispid 1610743809; + property CanTransformMultipleBlocks: WordBool readonly dispid 1610743810; + property CanReuseTransform: WordBool readonly dispid 1610743811; + function TransformBlock(inputBuffer: {??PSafeArray}OleVariant; inputOffset: Integer; + inputCount: Integer; outputBuffer: {??PSafeArray}OleVariant; + outputOffset: Integer): Integer; dispid 1610743812; + function TransformFinalBlock(inputBuffer: {??PSafeArray}OleVariant; inputOffset: Integer; + inputCount: Integer): {??PSafeArray}OleVariant; dispid 1610743813; + end; + {$EXTERNALSYM ICryptoTransformDisp} + +// *********************************************************************// +// Interface: _ToBase64Transform +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {23DED1E1-7D5F-3936-AA4E-18BBCC39B155} +// *********************************************************************// + _ToBase64Transform = interface(IDispatch) + ['{23DED1E1-7D5F-3936-AA4E-18BBCC39B155}'] + end; + +// *********************************************************************// +// DispIntf: _ToBase64TransformDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {23DED1E1-7D5F-3936-AA4E-18BBCC39B155} +// *********************************************************************// + _ToBase64TransformDisp = dispinterface + ['{23DED1E1-7D5F-3936-AA4E-18BBCC39B155}'] + end; + {$EXTERNALSYM _ToBase64TransformDisp} + +// *********************************************************************// +// Interface: _FromBase64Transform +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FC0717A6-2E86-372F-81F4-B35ED4BDF0DE} +// *********************************************************************// + _FromBase64Transform = interface(IDispatch) + ['{FC0717A6-2E86-372F-81F4-B35ED4BDF0DE}'] + end; + +// *********************************************************************// +// DispIntf: _FromBase64TransformDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FC0717A6-2E86-372F-81F4-B35ED4BDF0DE} +// *********************************************************************// + _FromBase64TransformDisp = dispinterface + ['{FC0717A6-2E86-372F-81F4-B35ED4BDF0DE}'] + end; + {$EXTERNALSYM _FromBase64TransformDisp} + +// *********************************************************************// +// Interface: _KeySizes +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8978B0BE-A89E-3FF9-9834-77862CEBFF3D} +// *********************************************************************// + _KeySizes = interface(IDispatch) + ['{8978B0BE-A89E-3FF9-9834-77862CEBFF3D}'] + end; + +// *********************************************************************// +// DispIntf: _KeySizesDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8978B0BE-A89E-3FF9-9834-77862CEBFF3D} +// *********************************************************************// + _KeySizesDisp = dispinterface + ['{8978B0BE-A89E-3FF9-9834-77862CEBFF3D}'] + end; + {$EXTERNALSYM _KeySizesDisp} + +// *********************************************************************// +// Interface: _CryptographicException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4311E8F5-B249-3F81-8FF4-CF853D85306D} +// *********************************************************************// + _CryptographicException = interface(IDispatch) + ['{4311E8F5-B249-3F81-8FF4-CF853D85306D}'] + end; + +// *********************************************************************// +// DispIntf: _CryptographicExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4311E8F5-B249-3F81-8FF4-CF853D85306D} +// *********************************************************************// + _CryptographicExceptionDisp = dispinterface + ['{4311E8F5-B249-3F81-8FF4-CF853D85306D}'] + end; + {$EXTERNALSYM _CryptographicExceptionDisp} + +// *********************************************************************// +// Interface: _CryptographicUnexpectedOperationException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7FB08423-038F-3ACC-B600-E6D072BAE160} +// *********************************************************************// + _CryptographicUnexpectedOperationException = interface(IDispatch) + ['{7FB08423-038F-3ACC-B600-E6D072BAE160}'] + end; + +// *********************************************************************// +// DispIntf: _CryptographicUnexpectedOperationExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7FB08423-038F-3ACC-B600-E6D072BAE160} +// *********************************************************************// + _CryptographicUnexpectedOperationExceptionDisp = dispinterface + ['{7FB08423-038F-3ACC-B600-E6D072BAE160}'] + end; + {$EXTERNALSYM _CryptographicUnexpectedOperationExceptionDisp} + +// *********************************************************************// +// Interface: _CryptoAPITransform +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {983B8639-2ED7-364C-9899-682ABB2CE850} +// *********************************************************************// + _CryptoAPITransform = interface(IDispatch) + ['{983B8639-2ED7-364C-9899-682ABB2CE850}'] + end; + +// *********************************************************************// +// DispIntf: _CryptoAPITransformDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {983B8639-2ED7-364C-9899-682ABB2CE850} +// *********************************************************************// + _CryptoAPITransformDisp = dispinterface + ['{983B8639-2ED7-364C-9899-682ABB2CE850}'] + end; + {$EXTERNALSYM _CryptoAPITransformDisp} + +// *********************************************************************// +// Interface: _CspParameters +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D5331D95-FFF2-358F-AFD5-588F469FF2E4} +// *********************************************************************// + _CspParameters = interface(IDispatch) + ['{D5331D95-FFF2-358F-AFD5-588F469FF2E4}'] + end; + +// *********************************************************************// +// DispIntf: _CspParametersDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D5331D95-FFF2-358F-AFD5-588F469FF2E4} +// *********************************************************************// + _CspParametersDisp = dispinterface + ['{D5331D95-FFF2-358F-AFD5-588F469FF2E4}'] + end; + {$EXTERNALSYM _CspParametersDisp} + +// *********************************************************************// +// Interface: _CryptoConfig +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AB00F3F8-7DDE-3FF5-B805-6C5DBB200549} +// *********************************************************************// + _CryptoConfig = interface(IDispatch) + ['{AB00F3F8-7DDE-3FF5-B805-6C5DBB200549}'] + end; + +// *********************************************************************// +// DispIntf: _CryptoConfigDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AB00F3F8-7DDE-3FF5-B805-6C5DBB200549} +// *********************************************************************// + _CryptoConfigDisp = dispinterface + ['{AB00F3F8-7DDE-3FF5-B805-6C5DBB200549}'] + end; + {$EXTERNALSYM _CryptoConfigDisp} + +// *********************************************************************// +// Interface: _Stream +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {2752364A-924F-3603-8F6F-6586DF98B292} +// *********************************************************************// + _Stream = interface(IDispatch) + ['{2752364A-924F-3603-8F6F-6586DF98B292}'] + end; + +// *********************************************************************// +// DispIntf: _StreamDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {2752364A-924F-3603-8F6F-6586DF98B292} +// *********************************************************************// + _StreamDisp = dispinterface + ['{2752364A-924F-3603-8F6F-6586DF98B292}'] + end; + {$EXTERNALSYM _StreamDisp} + +// *********************************************************************// +// Interface: _CryptoStream +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4134F762-D0EC-3210-93C0-DE4F443D5669} +// *********************************************************************// + _CryptoStream = interface(IDispatch) + ['{4134F762-D0EC-3210-93C0-DE4F443D5669}'] + end; + +// *********************************************************************// +// DispIntf: _CryptoStreamDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4134F762-D0EC-3210-93C0-DE4F443D5669} +// *********************************************************************// + _CryptoStreamDisp = dispinterface + ['{4134F762-D0EC-3210-93C0-DE4F443D5669}'] + end; + {$EXTERNALSYM _CryptoStreamDisp} + +// *********************************************************************// +// Interface: _SymmetricAlgorithm +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {05BC0E38-7136-3825-9E34-26C1CF2142C9} +// *********************************************************************// + _SymmetricAlgorithm = interface(IDispatch) + ['{05BC0E38-7136-3825-9E34-26C1CF2142C9}'] + end; + +// *********************************************************************// +// DispIntf: _SymmetricAlgorithmDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {05BC0E38-7136-3825-9E34-26C1CF2142C9} +// *********************************************************************// + _SymmetricAlgorithmDisp = dispinterface + ['{05BC0E38-7136-3825-9E34-26C1CF2142C9}'] + end; + {$EXTERNALSYM _SymmetricAlgorithmDisp} + +// *********************************************************************// +// Interface: _DES +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C7EF0214-B91C-3799-98DD-C994AABFC741} +// *********************************************************************// + _DES = interface(IDispatch) + ['{C7EF0214-B91C-3799-98DD-C994AABFC741}'] + end; + +// *********************************************************************// +// DispIntf: _DESDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C7EF0214-B91C-3799-98DD-C994AABFC741} +// *********************************************************************// + _DESDisp = dispinterface + ['{C7EF0214-B91C-3799-98DD-C994AABFC741}'] + end; + {$EXTERNALSYM _DESDisp} + +// *********************************************************************// +// Interface: _DESCryptoServiceProvider +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {65E8495E-5207-3248-9250-0FC849B4F096} +// *********************************************************************// + _DESCryptoServiceProvider = interface(IDispatch) + ['{65E8495E-5207-3248-9250-0FC849B4F096}'] + end; + +// *********************************************************************// +// DispIntf: _DESCryptoServiceProviderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {65E8495E-5207-3248-9250-0FC849B4F096} +// *********************************************************************// + _DESCryptoServiceProviderDisp = dispinterface + ['{65E8495E-5207-3248-9250-0FC849B4F096}'] + end; + {$EXTERNALSYM _DESCryptoServiceProviderDisp} + +// *********************************************************************// +// Interface: _DeriveBytes +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {140EE78F-067F-3765-9258-C3BC72FE976B} +// *********************************************************************// + _DeriveBytes = interface(IDispatch) + ['{140EE78F-067F-3765-9258-C3BC72FE976B}'] + end; + +// *********************************************************************// +// DispIntf: _DeriveBytesDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {140EE78F-067F-3765-9258-C3BC72FE976B} +// *********************************************************************// + _DeriveBytesDisp = dispinterface + ['{140EE78F-067F-3765-9258-C3BC72FE976B}'] + end; + {$EXTERNALSYM _DeriveBytesDisp} + +// *********************************************************************// +// Interface: _DSA +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0EB5B5E0-1BE6-3A5F-87B3-E3323342F44E} +// *********************************************************************// + _DSA = interface(IDispatch) + ['{0EB5B5E0-1BE6-3A5F-87B3-E3323342F44E}'] + end; + +// *********************************************************************// +// DispIntf: _DSADisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0EB5B5E0-1BE6-3A5F-87B3-E3323342F44E} +// *********************************************************************// + _DSADisp = dispinterface + ['{0EB5B5E0-1BE6-3A5F-87B3-E3323342F44E}'] + end; + {$EXTERNALSYM _DSADisp} + +// *********************************************************************// +// Interface: _DSACryptoServiceProvider +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1F38AAFE-7502-332F-971F-C2FC700A1D55} +// *********************************************************************// + _DSACryptoServiceProvider = interface(IDispatch) + ['{1F38AAFE-7502-332F-971F-C2FC700A1D55}'] + end; + +// *********************************************************************// +// DispIntf: _DSACryptoServiceProviderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1F38AAFE-7502-332F-971F-C2FC700A1D55} +// *********************************************************************// + _DSACryptoServiceProviderDisp = dispinterface + ['{1F38AAFE-7502-332F-971F-C2FC700A1D55}'] + end; + {$EXTERNALSYM _DSACryptoServiceProviderDisp} + +// *********************************************************************// +// Interface: _DSASignatureDeformatter +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0E774498-ADE6-3820-B1D5-426B06397BE7} +// *********************************************************************// + _DSASignatureDeformatter = interface(IDispatch) + ['{0E774498-ADE6-3820-B1D5-426B06397BE7}'] + end; + +// *********************************************************************// +// DispIntf: _DSASignatureDeformatterDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0E774498-ADE6-3820-B1D5-426B06397BE7} +// *********************************************************************// + _DSASignatureDeformatterDisp = dispinterface + ['{0E774498-ADE6-3820-B1D5-426B06397BE7}'] + end; + {$EXTERNALSYM _DSASignatureDeformatterDisp} + +// *********************************************************************// +// Interface: _DSASignatureFormatter +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4B5FC561-5983-31E4-903B-1404231B2C89} +// *********************************************************************// + _DSASignatureFormatter = interface(IDispatch) + ['{4B5FC561-5983-31E4-903B-1404231B2C89}'] + end; + +// *********************************************************************// +// DispIntf: _DSASignatureFormatterDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4B5FC561-5983-31E4-903B-1404231B2C89} +// *********************************************************************// + _DSASignatureFormatterDisp = dispinterface + ['{4B5FC561-5983-31E4-903B-1404231B2C89}'] + end; + {$EXTERNALSYM _DSASignatureFormatterDisp} + +// *********************************************************************// +// Interface: _HashAlgorithm +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {69D3BABA-1C3D-354C-ACFE-F19109EC3896} +// *********************************************************************// + _HashAlgorithm = interface(IDispatch) + ['{69D3BABA-1C3D-354C-ACFE-F19109EC3896}'] + end; + +// *********************************************************************// +// DispIntf: _HashAlgorithmDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {69D3BABA-1C3D-354C-ACFE-F19109EC3896} +// *********************************************************************// + _HashAlgorithmDisp = dispinterface + ['{69D3BABA-1C3D-354C-ACFE-F19109EC3896}'] + end; + {$EXTERNALSYM _HashAlgorithmDisp} + +// *********************************************************************// +// Interface: _KeyedHashAlgorithm +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D182CF91-628C-3FF6-87F0-41BA51CC7433} +// *********************************************************************// + _KeyedHashAlgorithm = interface(IDispatch) + ['{D182CF91-628C-3FF6-87F0-41BA51CC7433}'] + end; + +// *********************************************************************// +// DispIntf: _KeyedHashAlgorithmDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D182CF91-628C-3FF6-87F0-41BA51CC7433} +// *********************************************************************// + _KeyedHashAlgorithmDisp = dispinterface + ['{D182CF91-628C-3FF6-87F0-41BA51CC7433}'] + end; + {$EXTERNALSYM _KeyedHashAlgorithmDisp} + +// *********************************************************************// +// Interface: _HMACSHA1 +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {63AC7C37-C51A-3D82-8FDD-2A567039E46D} +// *********************************************************************// + _HMACSHA1 = interface(IDispatch) + ['{63AC7C37-C51A-3D82-8FDD-2A567039E46D}'] + end; + +// *********************************************************************// +// DispIntf: _HMACSHA1Disp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {63AC7C37-C51A-3D82-8FDD-2A567039E46D} +// *********************************************************************// + _HMACSHA1Disp = dispinterface + ['{63AC7C37-C51A-3D82-8FDD-2A567039E46D}'] + end; + {$EXTERNALSYM _HMACSHA1Disp} + +// *********************************************************************// +// Interface: _MACTripleDES +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1CAC0BDA-AC58-31BC-B624-63F77D0C3D2F} +// *********************************************************************// + _MACTripleDES = interface(IDispatch) + ['{1CAC0BDA-AC58-31BC-B624-63F77D0C3D2F}'] + end; + +// *********************************************************************// +// DispIntf: _MACTripleDESDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1CAC0BDA-AC58-31BC-B624-63F77D0C3D2F} +// *********************************************************************// + _MACTripleDESDisp = dispinterface + ['{1CAC0BDA-AC58-31BC-B624-63F77D0C3D2F}'] + end; + {$EXTERNALSYM _MACTripleDESDisp} + +// *********************************************************************// +// Interface: _MD5 +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9AA8765E-69A0-30E3-9CDE-EBC70662AE37} +// *********************************************************************// + _MD5 = interface(IDispatch) + ['{9AA8765E-69A0-30E3-9CDE-EBC70662AE37}'] + end; + +// *********************************************************************// +// DispIntf: _MD5Disp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9AA8765E-69A0-30E3-9CDE-EBC70662AE37} +// *********************************************************************// + _MD5Disp = dispinterface + ['{9AA8765E-69A0-30E3-9CDE-EBC70662AE37}'] + end; + {$EXTERNALSYM _MD5Disp} + +// *********************************************************************// +// Interface: _MD5CryptoServiceProvider +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D3F5C812-5867-33C9-8CEE-CB170E8D844A} +// *********************************************************************// + _MD5CryptoServiceProvider = interface(IDispatch) + ['{D3F5C812-5867-33C9-8CEE-CB170E8D844A}'] + end; + +// *********************************************************************// +// DispIntf: _MD5CryptoServiceProviderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D3F5C812-5867-33C9-8CEE-CB170E8D844A} +// *********************************************************************// + _MD5CryptoServiceProviderDisp = dispinterface + ['{D3F5C812-5867-33C9-8CEE-CB170E8D844A}'] + end; + {$EXTERNALSYM _MD5CryptoServiceProviderDisp} + +// *********************************************************************// +// Interface: _MaskGenerationMethod +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {85601FEE-A79D-3710-AF21-099089EDC0BF} +// *********************************************************************// + _MaskGenerationMethod = interface(IDispatch) + ['{85601FEE-A79D-3710-AF21-099089EDC0BF}'] + end; + +// *********************************************************************// +// DispIntf: _MaskGenerationMethodDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {85601FEE-A79D-3710-AF21-099089EDC0BF} +// *********************************************************************// + _MaskGenerationMethodDisp = dispinterface + ['{85601FEE-A79D-3710-AF21-099089EDC0BF}'] + end; + {$EXTERNALSYM _MaskGenerationMethodDisp} + +// *********************************************************************// +// Interface: _PasswordDeriveBytes +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3CD62D67-586F-309E-A6D8-1F4BAAC5AC28} +// *********************************************************************// + _PasswordDeriveBytes = interface(IDispatch) + ['{3CD62D67-586F-309E-A6D8-1F4BAAC5AC28}'] + end; + +// *********************************************************************// +// DispIntf: _PasswordDeriveBytesDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3CD62D67-586F-309E-A6D8-1F4BAAC5AC28} +// *********************************************************************// + _PasswordDeriveBytesDisp = dispinterface + ['{3CD62D67-586F-309E-A6D8-1F4BAAC5AC28}'] + end; + {$EXTERNALSYM _PasswordDeriveBytesDisp} + +// *********************************************************************// +// Interface: _PKCS1MaskGenerationMethod +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {425BFF0D-59E4-36A8-B1FF-1F5D39D698F4} +// *********************************************************************// + _PKCS1MaskGenerationMethod = interface(IDispatch) + ['{425BFF0D-59E4-36A8-B1FF-1F5D39D698F4}'] + end; + +// *********************************************************************// +// DispIntf: _PKCS1MaskGenerationMethodDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {425BFF0D-59E4-36A8-B1FF-1F5D39D698F4} +// *********************************************************************// + _PKCS1MaskGenerationMethodDisp = dispinterface + ['{425BFF0D-59E4-36A8-B1FF-1F5D39D698F4}'] + end; + {$EXTERNALSYM _PKCS1MaskGenerationMethodDisp} + +// *********************************************************************// +// Interface: _RC2 +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F7C0C4CC-0D49-31EE-A3D3-B8B551E4928C} +// *********************************************************************// + _RC2 = interface(IDispatch) + ['{F7C0C4CC-0D49-31EE-A3D3-B8B551E4928C}'] + end; + +// *********************************************************************// +// DispIntf: _RC2Disp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F7C0C4CC-0D49-31EE-A3D3-B8B551E4928C} +// *********************************************************************// + _RC2Disp = dispinterface + ['{F7C0C4CC-0D49-31EE-A3D3-B8B551E4928C}'] + end; + {$EXTERNALSYM _RC2Disp} + +// *********************************************************************// +// Interface: _RC2CryptoServiceProvider +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {875715C5-CB64-3920-8156-0EE9CB0E07EA} +// *********************************************************************// + _RC2CryptoServiceProvider = interface(IDispatch) + ['{875715C5-CB64-3920-8156-0EE9CB0E07EA}'] + end; + +// *********************************************************************// +// DispIntf: _RC2CryptoServiceProviderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {875715C5-CB64-3920-8156-0EE9CB0E07EA} +// *********************************************************************// + _RC2CryptoServiceProviderDisp = dispinterface + ['{875715C5-CB64-3920-8156-0EE9CB0E07EA}'] + end; + {$EXTERNALSYM _RC2CryptoServiceProviderDisp} + +// *********************************************************************// +// Interface: _RandomNumberGenerator +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7AE4B03C-414A-36E0-BA68-F9603004C925} +// *********************************************************************// + _RandomNumberGenerator = interface(IDispatch) + ['{7AE4B03C-414A-36E0-BA68-F9603004C925}'] + end; + +// *********************************************************************// +// DispIntf: _RandomNumberGeneratorDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7AE4B03C-414A-36E0-BA68-F9603004C925} +// *********************************************************************// + _RandomNumberGeneratorDisp = dispinterface + ['{7AE4B03C-414A-36E0-BA68-F9603004C925}'] + end; + {$EXTERNALSYM _RandomNumberGeneratorDisp} + +// *********************************************************************// +// Interface: _RNGCryptoServiceProvider +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {2C65D4C0-584C-3E4E-8E6D-1AFB112BFF69} +// *********************************************************************// + _RNGCryptoServiceProvider = interface(IDispatch) + ['{2C65D4C0-584C-3E4E-8E6D-1AFB112BFF69}'] + end; + +// *********************************************************************// +// DispIntf: _RNGCryptoServiceProviderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {2C65D4C0-584C-3E4E-8E6D-1AFB112BFF69} +// *********************************************************************// + _RNGCryptoServiceProviderDisp = dispinterface + ['{2C65D4C0-584C-3E4E-8E6D-1AFB112BFF69}'] + end; + {$EXTERNALSYM _RNGCryptoServiceProviderDisp} + +// *********************************************************************// +// Interface: _RSA +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0B3FB710-A25C-3310-8774-1CF117F95BD4} +// *********************************************************************// + _RSA = interface(IDispatch) + ['{0B3FB710-A25C-3310-8774-1CF117F95BD4}'] + end; + +// *********************************************************************// +// DispIntf: _RSADisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0B3FB710-A25C-3310-8774-1CF117F95BD4} +// *********************************************************************// + _RSADisp = dispinterface + ['{0B3FB710-A25C-3310-8774-1CF117F95BD4}'] + end; + {$EXTERNALSYM _RSADisp} + +// *********************************************************************// +// Interface: _RSACryptoServiceProvider +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BD9DF856-2300-3254-BCF0-679BA03C7A13} +// *********************************************************************// + _RSACryptoServiceProvider = interface(IDispatch) + ['{BD9DF856-2300-3254-BCF0-679BA03C7A13}'] + end; + +// *********************************************************************// +// DispIntf: _RSACryptoServiceProviderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BD9DF856-2300-3254-BCF0-679BA03C7A13} +// *********************************************************************// + _RSACryptoServiceProviderDisp = dispinterface + ['{BD9DF856-2300-3254-BCF0-679BA03C7A13}'] + end; + {$EXTERNALSYM _RSACryptoServiceProviderDisp} + +// *********************************************************************// +// Interface: _RSAOAEPKeyExchangeDeformatter +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {37625095-7BAA-377D-A0DC-7F465C0167AA} +// *********************************************************************// + _RSAOAEPKeyExchangeDeformatter = interface(IDispatch) + ['{37625095-7BAA-377D-A0DC-7F465C0167AA}'] + end; + +// *********************************************************************// +// DispIntf: _RSAOAEPKeyExchangeDeformatterDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {37625095-7BAA-377D-A0DC-7F465C0167AA} +// *********************************************************************// + _RSAOAEPKeyExchangeDeformatterDisp = dispinterface + ['{37625095-7BAA-377D-A0DC-7F465C0167AA}'] + end; + {$EXTERNALSYM _RSAOAEPKeyExchangeDeformatterDisp} + +// *********************************************************************// +// Interface: _RSAOAEPKeyExchangeFormatter +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {77A416E7-2AC6-3D0E-98FF-3BA0F586F56F} +// *********************************************************************// + _RSAOAEPKeyExchangeFormatter = interface(IDispatch) + ['{77A416E7-2AC6-3D0E-98FF-3BA0F586F56F}'] + end; + +// *********************************************************************// +// DispIntf: _RSAOAEPKeyExchangeFormatterDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {77A416E7-2AC6-3D0E-98FF-3BA0F586F56F} +// *********************************************************************// + _RSAOAEPKeyExchangeFormatterDisp = dispinterface + ['{77A416E7-2AC6-3D0E-98FF-3BA0F586F56F}'] + end; + {$EXTERNALSYM _RSAOAEPKeyExchangeFormatterDisp} + +// *********************************************************************// +// Interface: _RSAPKCS1KeyExchangeDeformatter +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8034AAF4-3666-3B6F-85CF-463F9BFD31A9} +// *********************************************************************// + _RSAPKCS1KeyExchangeDeformatter = interface(IDispatch) + ['{8034AAF4-3666-3B6F-85CF-463F9BFD31A9}'] + end; + +// *********************************************************************// +// DispIntf: _RSAPKCS1KeyExchangeDeformatterDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8034AAF4-3666-3B6F-85CF-463F9BFD31A9} +// *********************************************************************// + _RSAPKCS1KeyExchangeDeformatterDisp = dispinterface + ['{8034AAF4-3666-3B6F-85CF-463F9BFD31A9}'] + end; + {$EXTERNALSYM _RSAPKCS1KeyExchangeDeformatterDisp} + +// *********************************************************************// +// Interface: _RSAPKCS1KeyExchangeFormatter +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9FF67F8E-A7AA-3BA6-90EE-9D44AF6E2F8C} +// *********************************************************************// + _RSAPKCS1KeyExchangeFormatter = interface(IDispatch) + ['{9FF67F8E-A7AA-3BA6-90EE-9D44AF6E2F8C}'] + end; + +// *********************************************************************// +// DispIntf: _RSAPKCS1KeyExchangeFormatterDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9FF67F8E-A7AA-3BA6-90EE-9D44AF6E2F8C} +// *********************************************************************// + _RSAPKCS1KeyExchangeFormatterDisp = dispinterface + ['{9FF67F8E-A7AA-3BA6-90EE-9D44AF6E2F8C}'] + end; + {$EXTERNALSYM _RSAPKCS1KeyExchangeFormatterDisp} + +// *********************************************************************// +// Interface: _RSAPKCS1SignatureDeformatter +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FC38507E-06A4-3300-8652-8D7B54341F65} +// *********************************************************************// + _RSAPKCS1SignatureDeformatter = interface(IDispatch) + ['{FC38507E-06A4-3300-8652-8D7B54341F65}'] + end; + +// *********************************************************************// +// DispIntf: _RSAPKCS1SignatureDeformatterDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FC38507E-06A4-3300-8652-8D7B54341F65} +// *********************************************************************// + _RSAPKCS1SignatureDeformatterDisp = dispinterface + ['{FC38507E-06A4-3300-8652-8D7B54341F65}'] + end; + {$EXTERNALSYM _RSAPKCS1SignatureDeformatterDisp} + +// *********************************************************************// +// Interface: _RSAPKCS1SignatureFormatter +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FB7A5FF4-CFA8-3F24-AD5F-D5EB39359707} +// *********************************************************************// + _RSAPKCS1SignatureFormatter = interface(IDispatch) + ['{FB7A5FF4-CFA8-3F24-AD5F-D5EB39359707}'] + end; + +// *********************************************************************// +// DispIntf: _RSAPKCS1SignatureFormatterDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FB7A5FF4-CFA8-3F24-AD5F-D5EB39359707} +// *********************************************************************// + _RSAPKCS1SignatureFormatterDisp = dispinterface + ['{FB7A5FF4-CFA8-3F24-AD5F-D5EB39359707}'] + end; + {$EXTERNALSYM _RSAPKCS1SignatureFormatterDisp} + +// *********************************************************************// +// Interface: _Rijndael +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {21B52A91-856F-373C-AD42-4CF3F1021F5A} +// *********************************************************************// + _Rijndael = interface(IDispatch) + ['{21B52A91-856F-373C-AD42-4CF3F1021F5A}'] + end; + +// *********************************************************************// +// DispIntf: _RijndaelDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {21B52A91-856F-373C-AD42-4CF3F1021F5A} +// *********************************************************************// + _RijndaelDisp = dispinterface + ['{21B52A91-856F-373C-AD42-4CF3F1021F5A}'] + end; + {$EXTERNALSYM _RijndaelDisp} + +// *********************************************************************// +// Interface: _RijndaelManaged +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {427EA9D3-11D8-3E38-9E05-A4F7FA684183} +// *********************************************************************// + _RijndaelManaged = interface(IDispatch) + ['{427EA9D3-11D8-3E38-9E05-A4F7FA684183}'] + end; + +// *********************************************************************// +// DispIntf: _RijndaelManagedDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {427EA9D3-11D8-3E38-9E05-A4F7FA684183} +// *********************************************************************// + _RijndaelManagedDisp = dispinterface + ['{427EA9D3-11D8-3E38-9E05-A4F7FA684183}'] + end; + {$EXTERNALSYM _RijndaelManagedDisp} + +// *********************************************************************// +// Interface: _SHA1 +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {48600DD2-0099-337F-92D6-961D1E5010D4} +// *********************************************************************// + _SHA1 = interface(IDispatch) + ['{48600DD2-0099-337F-92D6-961D1E5010D4}'] + end; + +// *********************************************************************// +// DispIntf: _SHA1Disp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {48600DD2-0099-337F-92D6-961D1E5010D4} +// *********************************************************************// + _SHA1Disp = dispinterface + ['{48600DD2-0099-337F-92D6-961D1E5010D4}'] + end; + {$EXTERNALSYM _SHA1Disp} + +// *********************************************************************// +// Interface: _SHA1CryptoServiceProvider +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A16537BC-1EDF-3516-B75E-CC65CAF873AB} +// *********************************************************************// + _SHA1CryptoServiceProvider = interface(IDispatch) + ['{A16537BC-1EDF-3516-B75E-CC65CAF873AB}'] + end; + +// *********************************************************************// +// DispIntf: _SHA1CryptoServiceProviderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A16537BC-1EDF-3516-B75E-CC65CAF873AB} +// *********************************************************************// + _SHA1CryptoServiceProviderDisp = dispinterface + ['{A16537BC-1EDF-3516-B75E-CC65CAF873AB}'] + end; + {$EXTERNALSYM _SHA1CryptoServiceProviderDisp} + +// *********************************************************************// +// Interface: _SHA1Managed +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C27990BB-3CFD-3D29-8DC0-BBE5FBADEAFD} +// *********************************************************************// + _SHA1Managed = interface(IDispatch) + ['{C27990BB-3CFD-3D29-8DC0-BBE5FBADEAFD}'] + end; + +// *********************************************************************// +// DispIntf: _SHA1ManagedDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C27990BB-3CFD-3D29-8DC0-BBE5FBADEAFD} +// *********************************************************************// + _SHA1ManagedDisp = dispinterface + ['{C27990BB-3CFD-3D29-8DC0-BBE5FBADEAFD}'] + end; + {$EXTERNALSYM _SHA1ManagedDisp} + +// *********************************************************************// +// Interface: _SHA256 +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3B274703-DFAE-3F9C-A1B5-9990DF9D7FA3} +// *********************************************************************// + _SHA256 = interface(IDispatch) + ['{3B274703-DFAE-3F9C-A1B5-9990DF9D7FA3}'] + end; + +// *********************************************************************// +// DispIntf: _SHA256Disp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3B274703-DFAE-3F9C-A1B5-9990DF9D7FA3} +// *********************************************************************// + _SHA256Disp = dispinterface + ['{3B274703-DFAE-3F9C-A1B5-9990DF9D7FA3}'] + end; + {$EXTERNALSYM _SHA256Disp} + +// *********************************************************************// +// Interface: _SHA256Managed +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3D077954-7BCC-325B-9DDA-3B17A03378E0} +// *********************************************************************// + _SHA256Managed = interface(IDispatch) + ['{3D077954-7BCC-325B-9DDA-3B17A03378E0}'] + end; + +// *********************************************************************// +// DispIntf: _SHA256ManagedDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3D077954-7BCC-325B-9DDA-3B17A03378E0} +// *********************************************************************// + _SHA256ManagedDisp = dispinterface + ['{3D077954-7BCC-325B-9DDA-3B17A03378E0}'] + end; + {$EXTERNALSYM _SHA256ManagedDisp} + +// *********************************************************************// +// Interface: _SHA384 +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B60AD5D7-2C2E-35B7-8D77-7946156CFE8E} +// *********************************************************************// + _SHA384 = interface(IDispatch) + ['{B60AD5D7-2C2E-35B7-8D77-7946156CFE8E}'] + end; + +// *********************************************************************// +// DispIntf: _SHA384Disp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B60AD5D7-2C2E-35B7-8D77-7946156CFE8E} +// *********************************************************************// + _SHA384Disp = dispinterface + ['{B60AD5D7-2C2E-35B7-8D77-7946156CFE8E}'] + end; + {$EXTERNALSYM _SHA384Disp} + +// *********************************************************************// +// Interface: _SHA384Managed +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DE541460-F838-3698-B2DA-510B09070118} +// *********************************************************************// + _SHA384Managed = interface(IDispatch) + ['{DE541460-F838-3698-B2DA-510B09070118}'] + end; + +// *********************************************************************// +// DispIntf: _SHA384ManagedDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DE541460-F838-3698-B2DA-510B09070118} +// *********************************************************************// + _SHA384ManagedDisp = dispinterface + ['{DE541460-F838-3698-B2DA-510B09070118}'] + end; + {$EXTERNALSYM _SHA384ManagedDisp} + +// *********************************************************************// +// Interface: _SHA512 +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {49DD9E4B-84F3-3D6D-91FB-3FEDCEF634C7} +// *********************************************************************// + _SHA512 = interface(IDispatch) + ['{49DD9E4B-84F3-3D6D-91FB-3FEDCEF634C7}'] + end; + +// *********************************************************************// +// DispIntf: _SHA512Disp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {49DD9E4B-84F3-3D6D-91FB-3FEDCEF634C7} +// *********************************************************************// + _SHA512Disp = dispinterface + ['{49DD9E4B-84F3-3D6D-91FB-3FEDCEF634C7}'] + end; + {$EXTERNALSYM _SHA512Disp} + +// *********************************************************************// +// Interface: _SHA512Managed +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DC8CE439-7954-36ED-803C-674F72F27249} +// *********************************************************************// + _SHA512Managed = interface(IDispatch) + ['{DC8CE439-7954-36ED-803C-674F72F27249}'] + end; + +// *********************************************************************// +// DispIntf: _SHA512ManagedDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DC8CE439-7954-36ED-803C-674F72F27249} +// *********************************************************************// + _SHA512ManagedDisp = dispinterface + ['{DC8CE439-7954-36ED-803C-674F72F27249}'] + end; + {$EXTERNALSYM _SHA512ManagedDisp} + +// *********************************************************************// +// Interface: _SignatureDescription +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8017B414-4886-33DA-80A3-7865C1350D43} +// *********************************************************************// + _SignatureDescription = interface(IDispatch) + ['{8017B414-4886-33DA-80A3-7865C1350D43}'] + end; + +// *********************************************************************// +// DispIntf: _SignatureDescriptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8017B414-4886-33DA-80A3-7865C1350D43} +// *********************************************************************// + _SignatureDescriptionDisp = dispinterface + ['{8017B414-4886-33DA-80A3-7865C1350D43}'] + end; + {$EXTERNALSYM _SignatureDescriptionDisp} + +// *********************************************************************// +// Interface: _TripleDES +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C040B889-5278-3132-AFF9-AFA61707A81D} +// *********************************************************************// + _TripleDES = interface(IDispatch) + ['{C040B889-5278-3132-AFF9-AFA61707A81D}'] + end; + +// *********************************************************************// +// DispIntf: _TripleDESDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C040B889-5278-3132-AFF9-AFA61707A81D} +// *********************************************************************// + _TripleDESDisp = dispinterface + ['{C040B889-5278-3132-AFF9-AFA61707A81D}'] + end; + {$EXTERNALSYM _TripleDESDisp} + +// *********************************************************************// +// Interface: _TripleDESCryptoServiceProvider +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {EC69D083-3CD0-3C0C-998C-3B738DB535D5} +// *********************************************************************// + _TripleDESCryptoServiceProvider = interface(IDispatch) + ['{EC69D083-3CD0-3C0C-998C-3B738DB535D5}'] + end; + +// *********************************************************************// +// DispIntf: _TripleDESCryptoServiceProviderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {EC69D083-3CD0-3C0C-998C-3B738DB535D5} +// *********************************************************************// + _TripleDESCryptoServiceProviderDisp = dispinterface + ['{EC69D083-3CD0-3C0C-998C-3B738DB535D5}'] + end; + {$EXTERNALSYM _TripleDESCryptoServiceProviderDisp} + +// *********************************************************************// +// Interface: ISecurityEncodable +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {FD46BDE5-ACDF-3CA5-B189-F0678387077F} +// *********************************************************************// + ISecurityEncodable = interface(IDispatch) + ['{FD46BDE5-ACDF-3CA5-B189-F0678387077F}'] + function ToXml: _SecurityElement; safecall; + procedure FromXml(const e: _SecurityElement); safecall; + end; + +// *********************************************************************// +// DispIntf: ISecurityEncodableDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {FD46BDE5-ACDF-3CA5-B189-F0678387077F} +// *********************************************************************// + ISecurityEncodableDisp = dispinterface + ['{FD46BDE5-ACDF-3CA5-B189-F0678387077F}'] + function ToXml: _SecurityElement; dispid 1610743808; + procedure FromXml(const e: _SecurityElement); dispid 1610743809; + end; + {$EXTERNALSYM ISecurityEncodableDisp} + +// *********************************************************************// +// Interface: ISecurityPolicyEncodable +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {E6C21BA7-21BB-34E9-8E57-DB66D8CE4A70} +// *********************************************************************// + ISecurityPolicyEncodable = interface(IDispatch) + ['{E6C21BA7-21BB-34E9-8E57-DB66D8CE4A70}'] + function ToXml(const level: _PolicyLevel): _SecurityElement; safecall; + procedure FromXml(const e: _SecurityElement; const level: _PolicyLevel); safecall; + end; + +// *********************************************************************// +// DispIntf: ISecurityPolicyEncodableDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {E6C21BA7-21BB-34E9-8E57-DB66D8CE4A70} +// *********************************************************************// + ISecurityPolicyEncodableDisp = dispinterface + ['{E6C21BA7-21BB-34E9-8E57-DB66D8CE4A70}'] + function ToXml(const level: _PolicyLevel): _SecurityElement; dispid 1610743808; + procedure FromXml(const e: _SecurityElement; const level: _PolicyLevel); dispid 1610743809; + end; + {$EXTERNALSYM ISecurityPolicyEncodableDisp} + +// *********************************************************************// +// Interface: IMembershipCondition +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {6844EFF4-4F86-3CA1-A1EA-AAF583A6395E} +// *********************************************************************// + IMembershipCondition = interface(IDispatch) + ['{6844EFF4-4F86-3CA1-A1EA-AAF583A6395E}'] + function Check(const Evidence: _Evidence): WordBool; safecall; + function Copy: IMembershipCondition; safecall; + function Get_ToString: WideString; safecall; + function Equals(obj: OleVariant): WordBool; safecall; + property ToString: WideString read Get_ToString; + end; + +// *********************************************************************// +// DispIntf: IMembershipConditionDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {6844EFF4-4F86-3CA1-A1EA-AAF583A6395E} +// *********************************************************************// + IMembershipConditionDisp = dispinterface + ['{6844EFF4-4F86-3CA1-A1EA-AAF583A6395E}'] + function Check(const Evidence: _Evidence): WordBool; dispid 1610743808; + function Copy: IMembershipCondition; dispid 1610743809; + property ToString: WideString readonly dispid 0; + function Equals(obj: OleVariant): WordBool; dispid 1610743811; + end; + {$EXTERNALSYM IMembershipConditionDisp} + +// *********************************************************************// +// Interface: _AllMembershipCondition +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {99F01720-3CC2-366D-9AB9-50E36647617F} +// *********************************************************************// + _AllMembershipCondition = interface(IDispatch) + ['{99F01720-3CC2-366D-9AB9-50E36647617F}'] + end; + +// *********************************************************************// +// DispIntf: _AllMembershipConditionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {99F01720-3CC2-366D-9AB9-50E36647617F} +// *********************************************************************// + _AllMembershipConditionDisp = dispinterface + ['{99F01720-3CC2-366D-9AB9-50E36647617F}'] + end; + {$EXTERNALSYM _AllMembershipConditionDisp} + +// *********************************************************************// +// Interface: _ApplicationDirectory +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9CCC831B-1BA7-34BE-A966-56D5A6DB5AAD} +// *********************************************************************// + _ApplicationDirectory = interface(IDispatch) + ['{9CCC831B-1BA7-34BE-A966-56D5A6DB5AAD}'] + end; + +// *********************************************************************// +// DispIntf: _ApplicationDirectoryDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9CCC831B-1BA7-34BE-A966-56D5A6DB5AAD} +// *********************************************************************// + _ApplicationDirectoryDisp = dispinterface + ['{9CCC831B-1BA7-34BE-A966-56D5A6DB5AAD}'] + end; + {$EXTERNALSYM _ApplicationDirectoryDisp} + +// *********************************************************************// +// Interface: _ApplicationDirectoryMembershipCondition +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A02A2B22-1DBA-3F92-9F84-5563182851BB} +// *********************************************************************// + _ApplicationDirectoryMembershipCondition = interface(IDispatch) + ['{A02A2B22-1DBA-3F92-9F84-5563182851BB}'] + end; + +// *********************************************************************// +// DispIntf: _ApplicationDirectoryMembershipConditionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A02A2B22-1DBA-3F92-9F84-5563182851BB} +// *********************************************************************// + _ApplicationDirectoryMembershipConditionDisp = dispinterface + ['{A02A2B22-1DBA-3F92-9F84-5563182851BB}'] + end; + {$EXTERNALSYM _ApplicationDirectoryMembershipConditionDisp} + +// *********************************************************************// +// Interface: _CodeGroup +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D7093F61-ED6B-343F-B1E9-02472FCC710E} +// *********************************************************************// + _CodeGroup = interface(IDispatch) + ['{D7093F61-ED6B-343F-B1E9-02472FCC710E}'] + end; + +// *********************************************************************// +// DispIntf: _CodeGroupDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D7093F61-ED6B-343F-B1E9-02472FCC710E} +// *********************************************************************// + _CodeGroupDisp = dispinterface + ['{D7093F61-ED6B-343F-B1E9-02472FCC710E}'] + end; + {$EXTERNALSYM _CodeGroupDisp} + +// *********************************************************************// +// Interface: _Evidence +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A505EDBC-380E-3B23-9E1A-0974D4EF02EF} +// *********************************************************************// + _Evidence = interface(IDispatch) + ['{A505EDBC-380E-3B23-9E1A-0974D4EF02EF}'] + end; + +// *********************************************************************// +// DispIntf: _EvidenceDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A505EDBC-380E-3B23-9E1A-0974D4EF02EF} +// *********************************************************************// + _EvidenceDisp = dispinterface + ['{A505EDBC-380E-3B23-9E1A-0974D4EF02EF}'] + end; + {$EXTERNALSYM _EvidenceDisp} + +// *********************************************************************// +// Interface: _FileCodeGroup +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DFAD74DC-8390-32F6-9612-1BD293B233F4} +// *********************************************************************// + _FileCodeGroup = interface(IDispatch) + ['{DFAD74DC-8390-32F6-9612-1BD293B233F4}'] + end; + +// *********************************************************************// +// DispIntf: _FileCodeGroupDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DFAD74DC-8390-32F6-9612-1BD293B233F4} +// *********************************************************************// + _FileCodeGroupDisp = dispinterface + ['{DFAD74DC-8390-32F6-9612-1BD293B233F4}'] + end; + {$EXTERNALSYM _FileCodeGroupDisp} + +// *********************************************************************// +// Interface: _FirstMatchCodeGroup +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {54B0AFB1-E7D3-3770-BB0E-75A95E8D2656} +// *********************************************************************// + _FirstMatchCodeGroup = interface(IDispatch) + ['{54B0AFB1-E7D3-3770-BB0E-75A95E8D2656}'] + end; + +// *********************************************************************// +// DispIntf: _FirstMatchCodeGroupDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {54B0AFB1-E7D3-3770-BB0E-75A95E8D2656} +// *********************************************************************// + _FirstMatchCodeGroupDisp = dispinterface + ['{54B0AFB1-E7D3-3770-BB0E-75A95E8D2656}'] + end; + {$EXTERNALSYM _FirstMatchCodeGroupDisp} + +// *********************************************************************// +// Interface: _Hash +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7574E121-74A6-3626-B578-0783BADB19D2} +// *********************************************************************// + _Hash = interface(IDispatch) + ['{7574E121-74A6-3626-B578-0783BADB19D2}'] + end; + +// *********************************************************************// +// DispIntf: _HashDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7574E121-74A6-3626-B578-0783BADB19D2} +// *********************************************************************// + _HashDisp = dispinterface + ['{7574E121-74A6-3626-B578-0783BADB19D2}'] + end; + {$EXTERNALSYM _HashDisp} + +// *********************************************************************// +// Interface: _HashMembershipCondition +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6BA6EA7A-C9FC-3E73-82EC-18F29D83EEFD} +// *********************************************************************// + _HashMembershipCondition = interface(IDispatch) + ['{6BA6EA7A-C9FC-3E73-82EC-18F29D83EEFD}'] + end; + +// *********************************************************************// +// DispIntf: _HashMembershipConditionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6BA6EA7A-C9FC-3E73-82EC-18F29D83EEFD} +// *********************************************************************// + _HashMembershipConditionDisp = dispinterface + ['{6BA6EA7A-C9FC-3E73-82EC-18F29D83EEFD}'] + end; + {$EXTERNALSYM _HashMembershipConditionDisp} + +// *********************************************************************// +// Interface: IIdentityPermissionFactory +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {4E95244E-C6FC-3A86-8DB7-1712454DE3B6} +// *********************************************************************// + IIdentityPermissionFactory = interface(IDispatch) + ['{4E95244E-C6FC-3A86-8DB7-1712454DE3B6}'] + function CreateIdentityPermission(const Evidence: _Evidence): IPermission; safecall; + end; + +// *********************************************************************// +// DispIntf: IIdentityPermissionFactoryDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {4E95244E-C6FC-3A86-8DB7-1712454DE3B6} +// *********************************************************************// + IIdentityPermissionFactoryDisp = dispinterface + ['{4E95244E-C6FC-3A86-8DB7-1712454DE3B6}'] + function CreateIdentityPermission(const Evidence: _Evidence): IPermission; dispid 1610743808; + end; + {$EXTERNALSYM IIdentityPermissionFactoryDisp} + +// *********************************************************************// +// Interface: _NetCodeGroup +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A8F69ECA-8C48-3B5E-92A1-654925058059} +// *********************************************************************// + _NetCodeGroup = interface(IDispatch) + ['{A8F69ECA-8C48-3B5E-92A1-654925058059}'] + end; + +// *********************************************************************// +// DispIntf: _NetCodeGroupDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A8F69ECA-8C48-3B5E-92A1-654925058059} +// *********************************************************************// + _NetCodeGroupDisp = dispinterface + ['{A8F69ECA-8C48-3B5E-92A1-654925058059}'] + end; + {$EXTERNALSYM _NetCodeGroupDisp} + +// *********************************************************************// +// Interface: _PermissionRequestEvidence +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {34B0417E-E71D-304C-9FAC-689350A1B41C} +// *********************************************************************// + _PermissionRequestEvidence = interface(IDispatch) + ['{34B0417E-E71D-304C-9FAC-689350A1B41C}'] + end; + +// *********************************************************************// +// DispIntf: _PermissionRequestEvidenceDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {34B0417E-E71D-304C-9FAC-689350A1B41C} +// *********************************************************************// + _PermissionRequestEvidenceDisp = dispinterface + ['{34B0417E-E71D-304C-9FAC-689350A1B41C}'] + end; + {$EXTERNALSYM _PermissionRequestEvidenceDisp} + +// *********************************************************************// +// Interface: _PolicyException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A9C9F3D9-E153-39B8-A533-B8DF4664407B} +// *********************************************************************// + _PolicyException = interface(IDispatch) + ['{A9C9F3D9-E153-39B8-A533-B8DF4664407B}'] + end; + +// *********************************************************************// +// DispIntf: _PolicyExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A9C9F3D9-E153-39B8-A533-B8DF4664407B} +// *********************************************************************// + _PolicyExceptionDisp = dispinterface + ['{A9C9F3D9-E153-39B8-A533-B8DF4664407B}'] + end; + {$EXTERNALSYM _PolicyExceptionDisp} + +// *********************************************************************// +// Interface: _PolicyLevel +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {44494E35-C370-3014-BC78-0F2ECBF83F53} +// *********************************************************************// + _PolicyLevel = interface(IDispatch) + ['{44494E35-C370-3014-BC78-0F2ECBF83F53}'] + end; + +// *********************************************************************// +// DispIntf: _PolicyLevelDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {44494E35-C370-3014-BC78-0F2ECBF83F53} +// *********************************************************************// + _PolicyLevelDisp = dispinterface + ['{44494E35-C370-3014-BC78-0F2ECBF83F53}'] + end; + {$EXTERNALSYM _PolicyLevelDisp} + +// *********************************************************************// +// Interface: _PolicyStatement +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3EEFD1FC-4D8D-3177-99F6-6C19D9E088D3} +// *********************************************************************// + _PolicyStatement = interface(IDispatch) + ['{3EEFD1FC-4D8D-3177-99F6-6C19D9E088D3}'] + end; + +// *********************************************************************// +// DispIntf: _PolicyStatementDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3EEFD1FC-4D8D-3177-99F6-6C19D9E088D3} +// *********************************************************************// + _PolicyStatementDisp = dispinterface + ['{3EEFD1FC-4D8D-3177-99F6-6C19D9E088D3}'] + end; + {$EXTERNALSYM _PolicyStatementDisp} + +// *********************************************************************// +// Interface: _Publisher +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {77CCA693-ABF6-3773-BF58-C0B02701A744} +// *********************************************************************// + _Publisher = interface(IDispatch) + ['{77CCA693-ABF6-3773-BF58-C0B02701A744}'] + end; + +// *********************************************************************// +// DispIntf: _PublisherDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {77CCA693-ABF6-3773-BF58-C0B02701A744} +// *********************************************************************// + _PublisherDisp = dispinterface + ['{77CCA693-ABF6-3773-BF58-C0B02701A744}'] + end; + {$EXTERNALSYM _PublisherDisp} + +// *********************************************************************// +// Interface: _PublisherMembershipCondition +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3515CF63-9863-3044-B3E1-210E98EFC702} +// *********************************************************************// + _PublisherMembershipCondition = interface(IDispatch) + ['{3515CF63-9863-3044-B3E1-210E98EFC702}'] + end; + +// *********************************************************************// +// DispIntf: _PublisherMembershipConditionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3515CF63-9863-3044-B3E1-210E98EFC702} +// *********************************************************************// + _PublisherMembershipConditionDisp = dispinterface + ['{3515CF63-9863-3044-B3E1-210E98EFC702}'] + end; + {$EXTERNALSYM _PublisherMembershipConditionDisp} + +// *********************************************************************// +// Interface: _Site +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {90C40B4C-B0D0-30F5-B520-FDBA97BC31A0} +// *********************************************************************// + _Site = interface(IDispatch) + ['{90C40B4C-B0D0-30F5-B520-FDBA97BC31A0}'] + end; + +// *********************************************************************// +// DispIntf: _SiteDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {90C40B4C-B0D0-30F5-B520-FDBA97BC31A0} +// *********************************************************************// + _SiteDisp = dispinterface + ['{90C40B4C-B0D0-30F5-B520-FDBA97BC31A0}'] + end; + {$EXTERNALSYM _SiteDisp} + +// *********************************************************************// +// Interface: _SiteMembershipCondition +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0A7C3542-8031-3593-872C-78D85D7CC273} +// *********************************************************************// + _SiteMembershipCondition = interface(IDispatch) + ['{0A7C3542-8031-3593-872C-78D85D7CC273}'] + end; + +// *********************************************************************// +// DispIntf: _SiteMembershipConditionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0A7C3542-8031-3593-872C-78D85D7CC273} +// *********************************************************************// + _SiteMembershipConditionDisp = dispinterface + ['{0A7C3542-8031-3593-872C-78D85D7CC273}'] + end; + {$EXTERNALSYM _SiteMembershipConditionDisp} + +// *********************************************************************// +// Interface: _StrongName +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {2A75C1FD-06B0-3CBB-B467-2545D4D6C865} +// *********************************************************************// + _StrongName = interface(IDispatch) + ['{2A75C1FD-06B0-3CBB-B467-2545D4D6C865}'] + end; + +// *********************************************************************// +// DispIntf: _StrongNameDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {2A75C1FD-06B0-3CBB-B467-2545D4D6C865} +// *********************************************************************// + _StrongNameDisp = dispinterface + ['{2A75C1FD-06B0-3CBB-B467-2545D4D6C865}'] + end; + {$EXTERNALSYM _StrongNameDisp} + +// *********************************************************************// +// Interface: _StrongNameMembershipCondition +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {579E93BC-FFAB-3B8D-9181-CE9C22B51915} +// *********************************************************************// + _StrongNameMembershipCondition = interface(IDispatch) + ['{579E93BC-FFAB-3B8D-9181-CE9C22B51915}'] + end; + +// *********************************************************************// +// DispIntf: _StrongNameMembershipConditionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {579E93BC-FFAB-3B8D-9181-CE9C22B51915} +// *********************************************************************// + _StrongNameMembershipConditionDisp = dispinterface + ['{579E93BC-FFAB-3B8D-9181-CE9C22B51915}'] + end; + {$EXTERNALSYM _StrongNameMembershipConditionDisp} + +// *********************************************************************// +// Interface: _UnionCodeGroup +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D9D822DE-44E5-33CE-A43F-173E475CECB1} +// *********************************************************************// + _UnionCodeGroup = interface(IDispatch) + ['{D9D822DE-44E5-33CE-A43F-173E475CECB1}'] + end; + +// *********************************************************************// +// DispIntf: _UnionCodeGroupDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D9D822DE-44E5-33CE-A43F-173E475CECB1} +// *********************************************************************// + _UnionCodeGroupDisp = dispinterface + ['{D9D822DE-44E5-33CE-A43F-173E475CECB1}'] + end; + {$EXTERNALSYM _UnionCodeGroupDisp} + +// *********************************************************************// +// Interface: _Url +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D94ED9BF-C065-3703-81A2-2F76EA8E312F} +// *********************************************************************// + _Url = interface(IDispatch) + ['{D94ED9BF-C065-3703-81A2-2F76EA8E312F}'] + end; + +// *********************************************************************// +// DispIntf: _UrlDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D94ED9BF-C065-3703-81A2-2F76EA8E312F} +// *********************************************************************// + _UrlDisp = dispinterface + ['{D94ED9BF-C065-3703-81A2-2F76EA8E312F}'] + end; + {$EXTERNALSYM _UrlDisp} + +// *********************************************************************// +// Interface: _UrlMembershipCondition +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BB7A158D-DBD9-3E13-B137-8E61E87E1128} +// *********************************************************************// + _UrlMembershipCondition = interface(IDispatch) + ['{BB7A158D-DBD9-3E13-B137-8E61E87E1128}'] + end; + +// *********************************************************************// +// DispIntf: _UrlMembershipConditionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BB7A158D-DBD9-3E13-B137-8E61E87E1128} +// *********************************************************************// + _UrlMembershipConditionDisp = dispinterface + ['{BB7A158D-DBD9-3E13-B137-8E61E87E1128}'] + end; + {$EXTERNALSYM _UrlMembershipConditionDisp} + +// *********************************************************************// +// Interface: _Zone +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {742E0C26-0E23-3D20-968C-D221094909AA} +// *********************************************************************// + _Zone = interface(IDispatch) + ['{742E0C26-0E23-3D20-968C-D221094909AA}'] + end; + +// *********************************************************************// +// DispIntf: _ZoneDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {742E0C26-0E23-3D20-968C-D221094909AA} +// *********************************************************************// + _ZoneDisp = dispinterface + ['{742E0C26-0E23-3D20-968C-D221094909AA}'] + end; + {$EXTERNALSYM _ZoneDisp} + +// *********************************************************************// +// Interface: _ZoneMembershipCondition +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {ADBC3463-0101-3429-A06C-DB2F1DD6B724} +// *********************************************************************// + _ZoneMembershipCondition = interface(IDispatch) + ['{ADBC3463-0101-3429-A06C-DB2F1DD6B724}'] + end; + +// *********************************************************************// +// DispIntf: _ZoneMembershipConditionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {ADBC3463-0101-3429-A06C-DB2F1DD6B724} +// *********************************************************************// + _ZoneMembershipConditionDisp = dispinterface + ['{ADBC3463-0101-3429-A06C-DB2F1DD6B724}'] + end; + {$EXTERNALSYM _ZoneMembershipConditionDisp} + +// *********************************************************************// +// Interface: IIdentity +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {F4205A87-4D46-303D-B1D9-5A99F7C90D30} +// *********************************************************************// + IIdentity = interface(IDispatch) + ['{F4205A87-4D46-303D-B1D9-5A99F7C90D30}'] + function Get_name: WideString; safecall; + function Get_AuthenticationType: WideString; safecall; + function Get_IsAuthenticated: WordBool; safecall; + property name: WideString read Get_name; + property AuthenticationType: WideString read Get_AuthenticationType; + property IsAuthenticated: WordBool read Get_IsAuthenticated; + end; + +// *********************************************************************// +// DispIntf: IIdentityDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {F4205A87-4D46-303D-B1D9-5A99F7C90D30} +// *********************************************************************// + IIdentityDisp = dispinterface + ['{F4205A87-4D46-303D-B1D9-5A99F7C90D30}'] + property name: WideString readonly dispid 1610743808; + property AuthenticationType: WideString readonly dispid 1610743809; + property IsAuthenticated: WordBool readonly dispid 1610743810; + end; + {$EXTERNALSYM IIdentityDisp} + +// *********************************************************************// +// Interface: _GenericIdentity +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9A37D8B2-2256-3FE3-8BF0-4FC421A1244F} +// *********************************************************************// + _GenericIdentity = interface(IDispatch) + ['{9A37D8B2-2256-3FE3-8BF0-4FC421A1244F}'] + end; + +// *********************************************************************// +// DispIntf: _GenericIdentityDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9A37D8B2-2256-3FE3-8BF0-4FC421A1244F} +// *********************************************************************// + _GenericIdentityDisp = dispinterface + ['{9A37D8B2-2256-3FE3-8BF0-4FC421A1244F}'] + end; + {$EXTERNALSYM _GenericIdentityDisp} + +// *********************************************************************// +// Interface: IPrincipal +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {4283CA6C-D291-3481-83C9-9554481FE888} +// *********************************************************************// + IPrincipal = interface(IDispatch) + ['{4283CA6C-D291-3481-83C9-9554481FE888}'] + function Get_Identity: IIdentity; safecall; + function IsInRole(const role: WideString): WordBool; safecall; + property Identity: IIdentity read Get_Identity; + end; + +// *********************************************************************// +// DispIntf: IPrincipalDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {4283CA6C-D291-3481-83C9-9554481FE888} +// *********************************************************************// + IPrincipalDisp = dispinterface + ['{4283CA6C-D291-3481-83C9-9554481FE888}'] + property Identity: IIdentity readonly dispid 1610743808; + function IsInRole(const role: WideString): WordBool; dispid 1610743809; + end; + {$EXTERNALSYM IPrincipalDisp} + +// *********************************************************************// +// Interface: _GenericPrincipal +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B4701C26-1509-3726-B2E1-409A636C9B4F} +// *********************************************************************// + _GenericPrincipal = interface(IDispatch) + ['{B4701C26-1509-3726-B2E1-409A636C9B4F}'] + end; + +// *********************************************************************// +// DispIntf: _GenericPrincipalDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B4701C26-1509-3726-B2E1-409A636C9B4F} +// *********************************************************************// + _GenericPrincipalDisp = dispinterface + ['{B4701C26-1509-3726-B2E1-409A636C9B4F}'] + end; + {$EXTERNALSYM _GenericPrincipalDisp} + +// *********************************************************************// +// Interface: _WindowsIdentity +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D8CF3F23-1A66-3344-8230-07EB53970B85} +// *********************************************************************// + _WindowsIdentity = interface(IDispatch) + ['{D8CF3F23-1A66-3344-8230-07EB53970B85}'] + end; + +// *********************************************************************// +// DispIntf: _WindowsIdentityDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D8CF3F23-1A66-3344-8230-07EB53970B85} +// *********************************************************************// + _WindowsIdentityDisp = dispinterface + ['{D8CF3F23-1A66-3344-8230-07EB53970B85}'] + end; + {$EXTERNALSYM _WindowsIdentityDisp} + +// *********************************************************************// +// Interface: _WindowsImpersonationContext +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {60ECFDDA-650A-324C-B4B3-F4D75B563BB1} +// *********************************************************************// + _WindowsImpersonationContext = interface(IDispatch) + ['{60ECFDDA-650A-324C-B4B3-F4D75B563BB1}'] + end; + +// *********************************************************************// +// DispIntf: _WindowsImpersonationContextDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {60ECFDDA-650A-324C-B4B3-F4D75B563BB1} +// *********************************************************************// + _WindowsImpersonationContextDisp = dispinterface + ['{60ECFDDA-650A-324C-B4B3-F4D75B563BB1}'] + end; + {$EXTERNALSYM _WindowsImpersonationContextDisp} + +// *********************************************************************// +// Interface: _WindowsPrincipal +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6C42BAF9-1893-34FC-B3AF-06931E9B34A3} +// *********************************************************************// + _WindowsPrincipal = interface(IDispatch) + ['{6C42BAF9-1893-34FC-B3AF-06931E9B34A3}'] + end; + +// *********************************************************************// +// DispIntf: _WindowsPrincipalDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6C42BAF9-1893-34FC-B3AF-06931E9B34A3} +// *********************************************************************// + _WindowsPrincipalDisp = dispinterface + ['{6C42BAF9-1893-34FC-B3AF-06931E9B34A3}'] + end; + {$EXTERNALSYM _WindowsPrincipalDisp} + +// *********************************************************************// +// Interface: _DispIdAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BBE41AC5-8692-3427-9AE1-C1058A38D492} +// *********************************************************************// + _DispIdAttribute = interface(IDispatch) + ['{BBE41AC5-8692-3427-9AE1-C1058A38D492}'] + end; + +// *********************************************************************// +// DispIntf: _DispIdAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BBE41AC5-8692-3427-9AE1-C1058A38D492} +// *********************************************************************// + _DispIdAttributeDisp = dispinterface + ['{BBE41AC5-8692-3427-9AE1-C1058A38D492}'] + end; + {$EXTERNALSYM _DispIdAttributeDisp} + +// *********************************************************************// +// Interface: _InterfaceTypeAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A2145F38-CAC1-33DD-A318-21948AF6825D} +// *********************************************************************// + _InterfaceTypeAttribute = interface(IDispatch) + ['{A2145F38-CAC1-33DD-A318-21948AF6825D}'] + end; + +// *********************************************************************// +// DispIntf: _InterfaceTypeAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A2145F38-CAC1-33DD-A318-21948AF6825D} +// *********************************************************************// + _InterfaceTypeAttributeDisp = dispinterface + ['{A2145F38-CAC1-33DD-A318-21948AF6825D}'] + end; + {$EXTERNALSYM _InterfaceTypeAttributeDisp} + +// *********************************************************************// +// Interface: _ClassInterfaceAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6B6391EE-842F-3E9A-8EEE-F13325E10996} +// *********************************************************************// + _ClassInterfaceAttribute = interface(IDispatch) + ['{6B6391EE-842F-3E9A-8EEE-F13325E10996}'] + end; + +// *********************************************************************// +// DispIntf: _ClassInterfaceAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6B6391EE-842F-3E9A-8EEE-F13325E10996} +// *********************************************************************// + _ClassInterfaceAttributeDisp = dispinterface + ['{6B6391EE-842F-3E9A-8EEE-F13325E10996}'] + end; + {$EXTERNALSYM _ClassInterfaceAttributeDisp} + +// *********************************************************************// +// Interface: _ComVisibleAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1E7FFFE2-AAD9-34EE-8A9F-3C016B880FF0} +// *********************************************************************// + _ComVisibleAttribute = interface(IDispatch) + ['{1E7FFFE2-AAD9-34EE-8A9F-3C016B880FF0}'] + end; + +// *********************************************************************// +// DispIntf: _ComVisibleAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1E7FFFE2-AAD9-34EE-8A9F-3C016B880FF0} +// *********************************************************************// + _ComVisibleAttributeDisp = dispinterface + ['{1E7FFFE2-AAD9-34EE-8A9F-3C016B880FF0}'] + end; + {$EXTERNALSYM _ComVisibleAttributeDisp} + +// *********************************************************************// +// Interface: _LCIDConversionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4AB67927-3C86-328A-8186-F85357DD5527} +// *********************************************************************// + _LCIDConversionAttribute = interface(IDispatch) + ['{4AB67927-3C86-328A-8186-F85357DD5527}'] + end; + +// *********************************************************************// +// DispIntf: _LCIDConversionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4AB67927-3C86-328A-8186-F85357DD5527} +// *********************************************************************// + _LCIDConversionAttributeDisp = dispinterface + ['{4AB67927-3C86-328A-8186-F85357DD5527}'] + end; + {$EXTERNALSYM _LCIDConversionAttributeDisp} + +// *********************************************************************// +// Interface: _ComRegisterFunctionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {51BA926F-AAB5-3945-B8A6-C8F0F4A7D12B} +// *********************************************************************// + _ComRegisterFunctionAttribute = interface(IDispatch) + ['{51BA926F-AAB5-3945-B8A6-C8F0F4A7D12B}'] + end; + +// *********************************************************************// +// DispIntf: _ComRegisterFunctionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {51BA926F-AAB5-3945-B8A6-C8F0F4A7D12B} +// *********************************************************************// + _ComRegisterFunctionAttributeDisp = dispinterface + ['{51BA926F-AAB5-3945-B8A6-C8F0F4A7D12B}'] + end; + {$EXTERNALSYM _ComRegisterFunctionAttributeDisp} + +// *********************************************************************// +// Interface: _ComUnregisterFunctionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9F164188-34EB-3F86-9F74-0BBE4155E65E} +// *********************************************************************// + _ComUnregisterFunctionAttribute = interface(IDispatch) + ['{9F164188-34EB-3F86-9F74-0BBE4155E65E}'] + end; + +// *********************************************************************// +// DispIntf: _ComUnregisterFunctionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9F164188-34EB-3F86-9F74-0BBE4155E65E} +// *********************************************************************// + _ComUnregisterFunctionAttributeDisp = dispinterface + ['{9F164188-34EB-3F86-9F74-0BBE4155E65E}'] + end; + {$EXTERNALSYM _ComUnregisterFunctionAttributeDisp} + +// *********************************************************************// +// Interface: _ProgIdAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {2B9F01DF-5A12-3688-98D6-C34BF5ED1865} +// *********************************************************************// + _ProgIdAttribute = interface(IDispatch) + ['{2B9F01DF-5A12-3688-98D6-C34BF5ED1865}'] + end; + +// *********************************************************************// +// DispIntf: _ProgIdAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {2B9F01DF-5A12-3688-98D6-C34BF5ED1865} +// *********************************************************************// + _ProgIdAttributeDisp = dispinterface + ['{2B9F01DF-5A12-3688-98D6-C34BF5ED1865}'] + end; + {$EXTERNALSYM _ProgIdAttributeDisp} + +// *********************************************************************// +// Interface: _ImportedFromTypeLibAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3F3311CE-6BAF-3FB0-B855-489AFF740B6E} +// *********************************************************************// + _ImportedFromTypeLibAttribute = interface(IDispatch) + ['{3F3311CE-6BAF-3FB0-B855-489AFF740B6E}'] + end; + +// *********************************************************************// +// DispIntf: _ImportedFromTypeLibAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3F3311CE-6BAF-3FB0-B855-489AFF740B6E} +// *********************************************************************// + _ImportedFromTypeLibAttributeDisp = dispinterface + ['{3F3311CE-6BAF-3FB0-B855-489AFF740B6E}'] + end; + {$EXTERNALSYM _ImportedFromTypeLibAttributeDisp} + +// *********************************************************************// +// Interface: _IDispatchImplAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {5778E7C7-2040-330E-B47A-92974DFFCFD4} +// *********************************************************************// + _IDispatchImplAttribute = interface(IDispatch) + ['{5778E7C7-2040-330E-B47A-92974DFFCFD4}'] + end; + +// *********************************************************************// +// DispIntf: _IDispatchImplAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {5778E7C7-2040-330E-B47A-92974DFFCFD4} +// *********************************************************************// + _IDispatchImplAttributeDisp = dispinterface + ['{5778E7C7-2040-330E-B47A-92974DFFCFD4}'] + end; + {$EXTERNALSYM _IDispatchImplAttributeDisp} + +// *********************************************************************// +// Interface: _ComSourceInterfacesAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E1984175-55F5-3065-82D8-A683FDFCF0AC} +// *********************************************************************// + _ComSourceInterfacesAttribute = interface(IDispatch) + ['{E1984175-55F5-3065-82D8-A683FDFCF0AC}'] + end; + +// *********************************************************************// +// DispIntf: _ComSourceInterfacesAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E1984175-55F5-3065-82D8-A683FDFCF0AC} +// *********************************************************************// + _ComSourceInterfacesAttributeDisp = dispinterface + ['{E1984175-55F5-3065-82D8-A683FDFCF0AC}'] + end; + {$EXTERNALSYM _ComSourceInterfacesAttributeDisp} + +// *********************************************************************// +// Interface: _ComConversionLossAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FD5B6AAC-FF8C-3472-B894-CD6DFADB6939} +// *********************************************************************// + _ComConversionLossAttribute = interface(IDispatch) + ['{FD5B6AAC-FF8C-3472-B894-CD6DFADB6939}'] + end; + +// *********************************************************************// +// DispIntf: _ComConversionLossAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FD5B6AAC-FF8C-3472-B894-CD6DFADB6939} +// *********************************************************************// + _ComConversionLossAttributeDisp = dispinterface + ['{FD5B6AAC-FF8C-3472-B894-CD6DFADB6939}'] + end; + {$EXTERNALSYM _ComConversionLossAttributeDisp} + +// *********************************************************************// +// Interface: _TypeLibTypeAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B5A1729E-B721-3121-A838-FDE43AF13468} +// *********************************************************************// + _TypeLibTypeAttribute = interface(IDispatch) + ['{B5A1729E-B721-3121-A838-FDE43AF13468}'] + end; + +// *********************************************************************// +// DispIntf: _TypeLibTypeAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B5A1729E-B721-3121-A838-FDE43AF13468} +// *********************************************************************// + _TypeLibTypeAttributeDisp = dispinterface + ['{B5A1729E-B721-3121-A838-FDE43AF13468}'] + end; + {$EXTERNALSYM _TypeLibTypeAttributeDisp} + +// *********************************************************************// +// Interface: _TypeLibFuncAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3D18A8E2-EEDE-3139-B29D-8CAC057955DF} +// *********************************************************************// + _TypeLibFuncAttribute = interface(IDispatch) + ['{3D18A8E2-EEDE-3139-B29D-8CAC057955DF}'] + end; + +// *********************************************************************// +// DispIntf: _TypeLibFuncAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3D18A8E2-EEDE-3139-B29D-8CAC057955DF} +// *********************************************************************// + _TypeLibFuncAttributeDisp = dispinterface + ['{3D18A8E2-EEDE-3139-B29D-8CAC057955DF}'] + end; + {$EXTERNALSYM _TypeLibFuncAttributeDisp} + +// *********************************************************************// +// Interface: _TypeLibVarAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7B89862A-02A4-3279-8B42-4095FA3A778E} +// *********************************************************************// + _TypeLibVarAttribute = interface(IDispatch) + ['{7B89862A-02A4-3279-8B42-4095FA3A778E}'] + end; + +// *********************************************************************// +// DispIntf: _TypeLibVarAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7B89862A-02A4-3279-8B42-4095FA3A778E} +// *********************************************************************// + _TypeLibVarAttributeDisp = dispinterface + ['{7B89862A-02A4-3279-8B42-4095FA3A778E}'] + end; + {$EXTERNALSYM _TypeLibVarAttributeDisp} + +// *********************************************************************// +// Interface: _MarshalAsAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D858399F-E19E-3423-A720-AC12ABE2E5E8} +// *********************************************************************// + _MarshalAsAttribute = interface(IDispatch) + ['{D858399F-E19E-3423-A720-AC12ABE2E5E8}'] + end; + +// *********************************************************************// +// DispIntf: _MarshalAsAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D858399F-E19E-3423-A720-AC12ABE2E5E8} +// *********************************************************************// + _MarshalAsAttributeDisp = dispinterface + ['{D858399F-E19E-3423-A720-AC12ABE2E5E8}'] + end; + {$EXTERNALSYM _MarshalAsAttributeDisp} + +// *********************************************************************// +// Interface: _ComImportAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1B093056-5454-386F-8971-BBCBC4E9A8F3} +// *********************************************************************// + _ComImportAttribute = interface(IDispatch) + ['{1B093056-5454-386F-8971-BBCBC4E9A8F3}'] + end; + +// *********************************************************************// +// DispIntf: _ComImportAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1B093056-5454-386F-8971-BBCBC4E9A8F3} +// *********************************************************************// + _ComImportAttributeDisp = dispinterface + ['{1B093056-5454-386F-8971-BBCBC4E9A8F3}'] + end; + {$EXTERNALSYM _ComImportAttributeDisp} + +// *********************************************************************// +// Interface: _GuidAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {74435DAD-EC55-354B-8F5B-FA70D13B6293} +// *********************************************************************// + _GuidAttribute = interface(IDispatch) + ['{74435DAD-EC55-354B-8F5B-FA70D13B6293}'] + end; + +// *********************************************************************// +// DispIntf: _GuidAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {74435DAD-EC55-354B-8F5B-FA70D13B6293} +// *********************************************************************// + _GuidAttributeDisp = dispinterface + ['{74435DAD-EC55-354B-8F5B-FA70D13B6293}'] + end; + {$EXTERNALSYM _GuidAttributeDisp} + +// *********************************************************************// +// Interface: _PreserveSigAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FDF2A2EE-C882-3198-A48B-E37F0E574DFA} +// *********************************************************************// + _PreserveSigAttribute = interface(IDispatch) + ['{FDF2A2EE-C882-3198-A48B-E37F0E574DFA}'] + end; + +// *********************************************************************// +// DispIntf: _PreserveSigAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FDF2A2EE-C882-3198-A48B-E37F0E574DFA} +// *********************************************************************// + _PreserveSigAttributeDisp = dispinterface + ['{FDF2A2EE-C882-3198-A48B-E37F0E574DFA}'] + end; + {$EXTERNALSYM _PreserveSigAttributeDisp} + +// *********************************************************************// +// Interface: _InAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8474B65C-C39A-3D05-893D-577B9A314615} +// *********************************************************************// + _InAttribute = interface(IDispatch) + ['{8474B65C-C39A-3D05-893D-577B9A314615}'] + end; + +// *********************************************************************// +// DispIntf: _InAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8474B65C-C39A-3D05-893D-577B9A314615} +// *********************************************************************// + _InAttributeDisp = dispinterface + ['{8474B65C-C39A-3D05-893D-577B9A314615}'] + end; + {$EXTERNALSYM _InAttributeDisp} + +// *********************************************************************// +// Interface: _OutAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0697FC8C-9B04-3783-95C7-45ECCAC1CA27} +// *********************************************************************// + _OutAttribute = interface(IDispatch) + ['{0697FC8C-9B04-3783-95C7-45ECCAC1CA27}'] + end; + +// *********************************************************************// +// DispIntf: _OutAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0697FC8C-9B04-3783-95C7-45ECCAC1CA27} +// *********************************************************************// + _OutAttributeDisp = dispinterface + ['{0697FC8C-9B04-3783-95C7-45ECCAC1CA27}'] + end; + {$EXTERNALSYM _OutAttributeDisp} + +// *********************************************************************// +// Interface: _OptionalAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0D6BD9AD-198E-3904-AD99-F6F82A2787C4} +// *********************************************************************// + _OptionalAttribute = interface(IDispatch) + ['{0D6BD9AD-198E-3904-AD99-F6F82A2787C4}'] + end; + +// *********************************************************************// +// DispIntf: _OptionalAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0D6BD9AD-198E-3904-AD99-F6F82A2787C4} +// *********************************************************************// + _OptionalAttributeDisp = dispinterface + ['{0D6BD9AD-198E-3904-AD99-F6F82A2787C4}'] + end; + {$EXTERNALSYM _OptionalAttributeDisp} + +// *********************************************************************// +// Interface: _DllImportAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A1A26181-D55E-3EE2-96E6-70B354EF9371} +// *********************************************************************// + _DllImportAttribute = interface(IDispatch) + ['{A1A26181-D55E-3EE2-96E6-70B354EF9371}'] + end; + +// *********************************************************************// +// DispIntf: _DllImportAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A1A26181-D55E-3EE2-96E6-70B354EF9371} +// *********************************************************************// + _DllImportAttributeDisp = dispinterface + ['{A1A26181-D55E-3EE2-96E6-70B354EF9371}'] + end; + {$EXTERNALSYM _DllImportAttributeDisp} + +// *********************************************************************// +// Interface: _StructLayoutAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {23753322-C7B3-3F9A-AC96-52672C1B1CA9} +// *********************************************************************// + _StructLayoutAttribute = interface(IDispatch) + ['{23753322-C7B3-3F9A-AC96-52672C1B1CA9}'] + end; + +// *********************************************************************// +// DispIntf: _StructLayoutAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {23753322-C7B3-3F9A-AC96-52672C1B1CA9} +// *********************************************************************// + _StructLayoutAttributeDisp = dispinterface + ['{23753322-C7B3-3F9A-AC96-52672C1B1CA9}'] + end; + {$EXTERNALSYM _StructLayoutAttributeDisp} + +// *********************************************************************// +// Interface: _FieldOffsetAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C14342B8-BAFD-322A-BB71-62C672DA284E} +// *********************************************************************// + _FieldOffsetAttribute = interface(IDispatch) + ['{C14342B8-BAFD-322A-BB71-62C672DA284E}'] + end; + +// *********************************************************************// +// DispIntf: _FieldOffsetAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C14342B8-BAFD-322A-BB71-62C672DA284E} +// *********************************************************************// + _FieldOffsetAttributeDisp = dispinterface + ['{C14342B8-BAFD-322A-BB71-62C672DA284E}'] + end; + {$EXTERNALSYM _FieldOffsetAttributeDisp} + +// *********************************************************************// +// Interface: _ComAliasNameAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E78785C4-3A73-3C15-9390-618BF3A14719} +// *********************************************************************// + _ComAliasNameAttribute = interface(IDispatch) + ['{E78785C4-3A73-3C15-9390-618BF3A14719}'] + end; + +// *********************************************************************// +// DispIntf: _ComAliasNameAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E78785C4-3A73-3C15-9390-618BF3A14719} +// *********************************************************************// + _ComAliasNameAttributeDisp = dispinterface + ['{E78785C4-3A73-3C15-9390-618BF3A14719}'] + end; + {$EXTERNALSYM _ComAliasNameAttributeDisp} + +// *********************************************************************// +// Interface: _AutomationProxyAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {57B908A8-C082-3581-8A47-6B41B86E8FDC} +// *********************************************************************// + _AutomationProxyAttribute = interface(IDispatch) + ['{57B908A8-C082-3581-8A47-6B41B86E8FDC}'] + end; + +// *********************************************************************// +// DispIntf: _AutomationProxyAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {57B908A8-C082-3581-8A47-6B41B86E8FDC} +// *********************************************************************// + _AutomationProxyAttributeDisp = dispinterface + ['{57B908A8-C082-3581-8A47-6B41B86E8FDC}'] + end; + {$EXTERNALSYM _AutomationProxyAttributeDisp} + +// *********************************************************************// +// Interface: _PrimaryInteropAssemblyAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C69E96B2-6161-3621-B165-5805198C6B8D} +// *********************************************************************// + _PrimaryInteropAssemblyAttribute = interface(IDispatch) + ['{C69E96B2-6161-3621-B165-5805198C6B8D}'] + end; + +// *********************************************************************// +// DispIntf: _PrimaryInteropAssemblyAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C69E96B2-6161-3621-B165-5805198C6B8D} +// *********************************************************************// + _PrimaryInteropAssemblyAttributeDisp = dispinterface + ['{C69E96B2-6161-3621-B165-5805198C6B8D}'] + end; + {$EXTERNALSYM _PrimaryInteropAssemblyAttributeDisp} + +// *********************************************************************// +// Interface: _CoClassAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {15D54C00-7C95-38D7-B859-E19346677DCD} +// *********************************************************************// + _CoClassAttribute = interface(IDispatch) + ['{15D54C00-7C95-38D7-B859-E19346677DCD}'] + end; + +// *********************************************************************// +// DispIntf: _CoClassAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {15D54C00-7C95-38D7-B859-E19346677DCD} +// *********************************************************************// + _CoClassAttributeDisp = dispinterface + ['{15D54C00-7C95-38D7-B859-E19346677DCD}'] + end; + {$EXTERNALSYM _CoClassAttributeDisp} + +// *********************************************************************// +// Interface: _ComEventInterfaceAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {76CC0491-9A10-35C0-8A66-7931EC345B7F} +// *********************************************************************// + _ComEventInterfaceAttribute = interface(IDispatch) + ['{76CC0491-9A10-35C0-8A66-7931EC345B7F}'] + end; + +// *********************************************************************// +// DispIntf: _ComEventInterfaceAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {76CC0491-9A10-35C0-8A66-7931EC345B7F} +// *********************************************************************// + _ComEventInterfaceAttributeDisp = dispinterface + ['{76CC0491-9A10-35C0-8A66-7931EC345B7F}'] + end; + {$EXTERNALSYM _ComEventInterfaceAttributeDisp} + +// *********************************************************************// +// Interface: _TypeLibVersionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A03B61A4-CA61-3460-8232-2F4EC96AA88F} +// *********************************************************************// + _TypeLibVersionAttribute = interface(IDispatch) + ['{A03B61A4-CA61-3460-8232-2F4EC96AA88F}'] + end; + +// *********************************************************************// +// DispIntf: _TypeLibVersionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A03B61A4-CA61-3460-8232-2F4EC96AA88F} +// *********************************************************************// + _TypeLibVersionAttributeDisp = dispinterface + ['{A03B61A4-CA61-3460-8232-2F4EC96AA88F}'] + end; + {$EXTERNALSYM _TypeLibVersionAttributeDisp} + +// *********************************************************************// +// Interface: _ComCompatibleVersionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AD419379-2AC8-3588-AB1E-0115413277C4} +// *********************************************************************// + _ComCompatibleVersionAttribute = interface(IDispatch) + ['{AD419379-2AC8-3588-AB1E-0115413277C4}'] + end; + +// *********************************************************************// +// DispIntf: _ComCompatibleVersionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AD419379-2AC8-3588-AB1E-0115413277C4} +// *********************************************************************// + _ComCompatibleVersionAttributeDisp = dispinterface + ['{AD419379-2AC8-3588-AB1E-0115413277C4}'] + end; + {$EXTERNALSYM _ComCompatibleVersionAttributeDisp} + +// *********************************************************************// +// Interface: _BestFitMappingAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {ED47ABE7-C84B-39F9-BE1B-828CFB925AFE} +// *********************************************************************// + _BestFitMappingAttribute = interface(IDispatch) + ['{ED47ABE7-C84B-39F9-BE1B-828CFB925AFE}'] + end; + +// *********************************************************************// +// DispIntf: _BestFitMappingAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {ED47ABE7-C84B-39F9-BE1B-828CFB925AFE} +// *********************************************************************// + _BestFitMappingAttributeDisp = dispinterface + ['{ED47ABE7-C84B-39F9-BE1B-828CFB925AFE}'] + end; + {$EXTERNALSYM _BestFitMappingAttributeDisp} + +// *********************************************************************// +// Interface: _ExternalException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A83F04E9-FD28-384A-9DFF-410688AC23AB} +// *********************************************************************// + _ExternalException = interface(IDispatch) + ['{A83F04E9-FD28-384A-9DFF-410688AC23AB}'] + end; + +// *********************************************************************// +// DispIntf: _ExternalExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A83F04E9-FD28-384A-9DFF-410688AC23AB} +// *********************************************************************// + _ExternalExceptionDisp = dispinterface + ['{A83F04E9-FD28-384A-9DFF-410688AC23AB}'] + end; + {$EXTERNALSYM _ExternalExceptionDisp} + +// *********************************************************************// +// Interface: _COMException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A28C19DF-B488-34AE-BECC-7DE744D17F7B} +// *********************************************************************// + _COMException = interface(IDispatch) + ['{A28C19DF-B488-34AE-BECC-7DE744D17F7B}'] + end; + +// *********************************************************************// +// DispIntf: _COMExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A28C19DF-B488-34AE-BECC-7DE744D17F7B} +// *********************************************************************// + _COMExceptionDisp = dispinterface + ['{A28C19DF-B488-34AE-BECC-7DE744D17F7B}'] + end; + {$EXTERNALSYM _COMExceptionDisp} + +// *********************************************************************// +// Interface: _CurrencyWrapper +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7DF6F279-DA62-3C9F-8944-4DD3C0F08170} +// *********************************************************************// + _CurrencyWrapper = interface(IDispatch) + ['{7DF6F279-DA62-3C9F-8944-4DD3C0F08170}'] + end; + +// *********************************************************************// +// DispIntf: _CurrencyWrapperDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7DF6F279-DA62-3C9F-8944-4DD3C0F08170} +// *********************************************************************// + _CurrencyWrapperDisp = dispinterface + ['{7DF6F279-DA62-3C9F-8944-4DD3C0F08170}'] + end; + {$EXTERNALSYM _CurrencyWrapperDisp} + +// *********************************************************************// +// Interface: _DispatchWrapper +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {72103C67-D511-329C-B19A-DD5EC3F1206C} +// *********************************************************************// + _DispatchWrapper = interface(IDispatch) + ['{72103C67-D511-329C-B19A-DD5EC3F1206C}'] + end; + +// *********************************************************************// +// DispIntf: _DispatchWrapperDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {72103C67-D511-329C-B19A-DD5EC3F1206C} +// *********************************************************************// + _DispatchWrapperDisp = dispinterface + ['{72103C67-D511-329C-B19A-DD5EC3F1206C}'] + end; + {$EXTERNALSYM _DispatchWrapperDisp} + +// *********************************************************************// +// Interface: _ErrorWrapper +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F79DB336-06BE-3959-A5AB-58B2AB6C5FD1} +// *********************************************************************// + _ErrorWrapper = interface(IDispatch) + ['{F79DB336-06BE-3959-A5AB-58B2AB6C5FD1}'] + end; + +// *********************************************************************// +// DispIntf: _ErrorWrapperDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F79DB336-06BE-3959-A5AB-58B2AB6C5FD1} +// *********************************************************************// + _ErrorWrapperDisp = dispinterface + ['{F79DB336-06BE-3959-A5AB-58B2AB6C5FD1}'] + end; + {$EXTERNALSYM _ErrorWrapperDisp} + +// *********************************************************************// +// Interface: _ExtensibleClassFactory +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {519EB857-7A2D-3A95-A2A3-8BB8ED63D41B} +// *********************************************************************// + _ExtensibleClassFactory = interface(IDispatch) + ['{519EB857-7A2D-3A95-A2A3-8BB8ED63D41B}'] + end; + +// *********************************************************************// +// DispIntf: _ExtensibleClassFactoryDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {519EB857-7A2D-3A95-A2A3-8BB8ED63D41B} +// *********************************************************************// + _ExtensibleClassFactoryDisp = dispinterface + ['{519EB857-7A2D-3A95-A2A3-8BB8ED63D41B}'] + end; + {$EXTERNALSYM _ExtensibleClassFactoryDisp} + +// *********************************************************************// +// Interface: ICustomAdapter +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {3CC86595-FEB5-3CE9-BA14-D05C8DC3321C} +// *********************************************************************// + ICustomAdapter = interface(IDispatch) + ['{3CC86595-FEB5-3CE9-BA14-D05C8DC3321C}'] + function GetUnderlyingObject: IUnknown; safecall; + end; + +// *********************************************************************// +// DispIntf: ICustomAdapterDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {3CC86595-FEB5-3CE9-BA14-D05C8DC3321C} +// *********************************************************************// + ICustomAdapterDisp = dispinterface + ['{3CC86595-FEB5-3CE9-BA14-D05C8DC3321C}'] + function GetUnderlyingObject: IUnknown; dispid 1610743808; + end; + {$EXTERNALSYM ICustomAdapterDisp} + +// *********************************************************************// +// Interface: ICustomMarshaler +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {601CD486-04BF-3213-9EA9-06EBE4351D74} +// *********************************************************************// + ICustomMarshaler = interface(IDispatch) + ['{601CD486-04BF-3213-9EA9-06EBE4351D74}'] + function MarshalNativeToManaged(pNativeData: Integer): OleVariant; safecall; + function MarshalManagedToNative(ManagedObj: OleVariant): Integer; safecall; + procedure CleanUpNativeData(pNativeData: Integer); safecall; + procedure CleanUpManagedData(ManagedObj: OleVariant); safecall; + function GetNativeDataSize: Integer; safecall; + end; + +// *********************************************************************// +// DispIntf: ICustomMarshalerDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {601CD486-04BF-3213-9EA9-06EBE4351D74} +// *********************************************************************// + ICustomMarshalerDisp = dispinterface + ['{601CD486-04BF-3213-9EA9-06EBE4351D74}'] + function MarshalNativeToManaged(pNativeData: Integer): OleVariant; dispid 1610743808; + function MarshalManagedToNative(ManagedObj: OleVariant): Integer; dispid 1610743809; + procedure CleanUpNativeData(pNativeData: Integer); dispid 1610743810; + procedure CleanUpManagedData(ManagedObj: OleVariant); dispid 1610743811; + function GetNativeDataSize: Integer; dispid 1610743812; + end; + {$EXTERNALSYM ICustomMarshalerDisp} + +// *********************************************************************// +// Interface: ICustomFactory +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {0CA9008E-EE90-356E-9F6D-B59E6006B9A4} +// *********************************************************************// + ICustomFactory = interface(IDispatch) + ['{0CA9008E-EE90-356E-9F6D-B59E6006B9A4}'] + function CreateInstance(const serverType: _Type): _MarshalByRefObject; safecall; + end; + +// *********************************************************************// +// DispIntf: ICustomFactoryDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {0CA9008E-EE90-356E-9F6D-B59E6006B9A4} +// *********************************************************************// + ICustomFactoryDisp = dispinterface + ['{0CA9008E-EE90-356E-9F6D-B59E6006B9A4}'] + function CreateInstance(const serverType: _Type): _MarshalByRefObject; dispid 1610743808; + end; + {$EXTERNALSYM ICustomFactoryDisp} + +// *********************************************************************// +// Interface: _InvalidComObjectException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DE9156B5-5E7A-3041-BF45-A29A6C2CF48A} +// *********************************************************************// + _InvalidComObjectException = interface(IDispatch) + ['{DE9156B5-5E7A-3041-BF45-A29A6C2CF48A}'] + end; + +// *********************************************************************// +// DispIntf: _InvalidComObjectExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DE9156B5-5E7A-3041-BF45-A29A6C2CF48A} +// *********************************************************************// + _InvalidComObjectExceptionDisp = dispinterface + ['{DE9156B5-5E7A-3041-BF45-A29A6C2CF48A}'] + end; + {$EXTERNALSYM _InvalidComObjectExceptionDisp} + +// *********************************************************************// +// Interface: _InvalidOleVariantTypeException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {76E5DBD6-F960-3C65-8EA6-FC8AD6A67022} +// *********************************************************************// + _InvalidOleVariantTypeException = interface(IDispatch) + ['{76E5DBD6-F960-3C65-8EA6-FC8AD6A67022}'] + end; + +// *********************************************************************// +// DispIntf: _InvalidOleVariantTypeExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {76E5DBD6-F960-3C65-8EA6-FC8AD6A67022} +// *********************************************************************// + _InvalidOleVariantTypeExceptionDisp = dispinterface + ['{76E5DBD6-F960-3C65-8EA6-FC8AD6A67022}'] + end; + {$EXTERNALSYM _InvalidOleVariantTypeExceptionDisp} + +// *********************************************************************// +// Interface: IRegistrationServices +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {CCBD682C-73A5-4568-B8B0-C7007E11ABA2} +// *********************************************************************// + IRegistrationServices = interface(IDispatch) + ['{CCBD682C-73A5-4568-B8B0-C7007E11ABA2}'] + function RegisterAssembly(const Assembly: _Assembly; flags: AssemblyRegistrationFlags): WordBool; safecall; + function UnregisterAssembly(const Assembly: _Assembly): WordBool; safecall; + function GetRegistrableTypesInAssembly(const Assembly: _Assembly): PSafeArray; safecall; + function GetProgIdForType(const Type_: _Type): WideString; safecall; + procedure RegisterTypeForComClients(const Type_: _Type; var G: TGUID); safecall; + function GetManagedCategoryGuid: TGUID; safecall; + function TypeRequiresRegistration(const Type_: _Type): WordBool; safecall; + function TypeRepresentsComType(const Type_: _Type): WordBool; safecall; + end; + +// *********************************************************************// +// DispIntf: IRegistrationServicesDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {CCBD682C-73A5-4568-B8B0-C7007E11ABA2} +// *********************************************************************// + IRegistrationServicesDisp = dispinterface + ['{CCBD682C-73A5-4568-B8B0-C7007E11ABA2}'] + function RegisterAssembly(const Assembly: _Assembly; flags: AssemblyRegistrationFlags): WordBool; dispid 1610743808; + function UnregisterAssembly(const Assembly: _Assembly): WordBool; dispid 1610743809; + function GetRegistrableTypesInAssembly(const Assembly: _Assembly): {??PSafeArray}OleVariant; dispid 1610743810; + function GetProgIdForType(const Type_: _Type): WideString; dispid 1610743811; + procedure RegisterTypeForComClients(const Type_: _Type; var G: {??TGUID}OleVariant); dispid 1610743812; + function GetManagedCategoryGuid: {??TGUID}OleVariant; dispid 1610743813; + function TypeRequiresRegistration(const Type_: _Type): WordBool; dispid 1610743814; + function TypeRepresentsComType(const Type_: _Type): WordBool; dispid 1610743815; + end; + {$EXTERNALSYM IRegistrationServicesDisp} + +// *********************************************************************// +// Interface: ITypeLibImporterNotifySink +// Flags: (256) OleAutomation +// GUID: {F1C3BF76-C3E4-11D3-88E7-00902754C43A} +// *********************************************************************// + ITypeLibImporterNotifySink = interface(IUnknown) + ['{F1C3BF76-C3E4-11D3-88E7-00902754C43A}'] + function ReportEvent(eventKind: ImporterEventKind; eventCode: Integer; + const eventMsg: WideString): HResult; stdcall; + function ResolveRef(const typeLib: IUnknown; out pRetVal: _Assembly): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: ITypeLibExporterNotifySink +// Flags: (256) OleAutomation +// GUID: {F1C3BF77-C3E4-11D3-88E7-00902754C43A} +// *********************************************************************// + ITypeLibExporterNotifySink = interface(IUnknown) + ['{F1C3BF77-C3E4-11D3-88E7-00902754C43A}'] + function ReportEvent(eventKind: ExporterEventKind; eventCode: Integer; + const eventMsg: WideString): HResult; stdcall; + function ResolveRef(const Assembly: _Assembly; out pRetVal: IUnknown): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: ITypeLibConverter +// Flags: (256) OleAutomation +// GUID: {F1C3BF78-C3E4-11D3-88E7-00902754C43A} +// *********************************************************************// + ITypeLibConverter = interface(IUnknown) + ['{F1C3BF78-C3E4-11D3-88E7-00902754C43A}'] + function ConvertTypeLibToAssembly(const typeLib: IUnknown; const asmFileName: WideString; + flags: TypeLibImporterFlags; + const notifySink: ITypeLibImporterNotifySink; + publicKey: PSafeArray; const keyPair: _StrongNameKeyPair; + const asmNamespace: WideString; const asmVersion: _Version; + out pRetVal: _AssemblyBuilder): HResult; stdcall; + function ConvertAssemblyToTypeLib(const Assembly: _Assembly; const typeLibName: WideString; + flags: TypeLibExporterFlags; + const notifySink: ITypeLibExporterNotifySink; + out pRetVal: IUnknown): HResult; stdcall; + function GetPrimaryInteropAssembly(G: TGUID; major: Integer; minor: Integer; lcid: Integer; + out asmName: WideString; out asmCodeBase: WideString; + out pRetVal: WordBool): HResult; stdcall; + function ConvertTypeLibToAssembly_2(const typeLib: IUnknown; const asmFileName: WideString; + flags: Integer; + const notifySink: ITypeLibImporterNotifySink; + publicKey: PSafeArray; const keyPair: _StrongNameKeyPair; + unsafeInterfaces: WordBool; out pRetVal: _AssemblyBuilder): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: ITypeLibExporterNameProvider +// Flags: (256) OleAutomation +// GUID: {FA1F3615-ACB9-486D-9EAC-1BEF87E36B09} +// *********************************************************************// + ITypeLibExporterNameProvider = interface(IUnknown) + ['{FA1F3615-ACB9-486D-9EAC-1BEF87E36B09}'] + function GetNames(out pRetVal: PSafeArray): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: _Marshal +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {5F06D2F8-F3D4-3585-814C-2E886C465F25} +// *********************************************************************// + _Marshal = interface(IDispatch) + ['{5F06D2F8-F3D4-3585-814C-2E886C465F25}'] + end; + +// *********************************************************************// +// DispIntf: _MarshalDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {5F06D2F8-F3D4-3585-814C-2E886C465F25} +// *********************************************************************// + _MarshalDisp = dispinterface + ['{5F06D2F8-F3D4-3585-814C-2E886C465F25}'] + end; + {$EXTERNALSYM _MarshalDisp} + +// *********************************************************************// +// Interface: _MarshalDirectiveException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {523F42A5-1FD2-355D-82BF-0D67C4A0A0E7} +// *********************************************************************// + _MarshalDirectiveException = interface(IDispatch) + ['{523F42A5-1FD2-355D-82BF-0D67C4A0A0E7}'] + end; + +// *********************************************************************// +// DispIntf: _MarshalDirectiveExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {523F42A5-1FD2-355D-82BF-0D67C4A0A0E7} +// *********************************************************************// + _MarshalDirectiveExceptionDisp = dispinterface + ['{523F42A5-1FD2-355D-82BF-0D67C4A0A0E7}'] + end; + {$EXTERNALSYM _MarshalDirectiveExceptionDisp} + +// *********************************************************************// +// Interface: _ObjectCreationDelegate +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E4A369D3-6CF0-3B05-9C0C-1A91E331641A} +// *********************************************************************// + _ObjectCreationDelegate = interface(IDispatch) + ['{E4A369D3-6CF0-3B05-9C0C-1A91E331641A}'] + end; + +// *********************************************************************// +// DispIntf: _ObjectCreationDelegateDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E4A369D3-6CF0-3B05-9C0C-1A91E331641A} +// *********************************************************************// + _ObjectCreationDelegateDisp = dispinterface + ['{E4A369D3-6CF0-3B05-9C0C-1A91E331641A}'] + end; + {$EXTERNALSYM _ObjectCreationDelegateDisp} + +// *********************************************************************// +// Interface: _RuntimeEnvironment +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {EDCEE21A-3E3A-331E-A86D-274028BE6716} +// *********************************************************************// + _RuntimeEnvironment = interface(IDispatch) + ['{EDCEE21A-3E3A-331E-A86D-274028BE6716}'] + end; + +// *********************************************************************// +// DispIntf: _RuntimeEnvironmentDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {EDCEE21A-3E3A-331E-A86D-274028BE6716} +// *********************************************************************// + _RuntimeEnvironmentDisp = dispinterface + ['{EDCEE21A-3E3A-331E-A86D-274028BE6716}'] + end; + {$EXTERNALSYM _RuntimeEnvironmentDisp} + +// *********************************************************************// +// Interface: _SafeArrayRankMismatchException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8608FE7B-2FDC-318A-B711-6F7B2FEDED06} +// *********************************************************************// + _SafeArrayRankMismatchException = interface(IDispatch) + ['{8608FE7B-2FDC-318A-B711-6F7B2FEDED06}'] + end; + +// *********************************************************************// +// DispIntf: _SafeArrayRankMismatchExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8608FE7B-2FDC-318A-B711-6F7B2FEDED06} +// *********************************************************************// + _SafeArrayRankMismatchExceptionDisp = dispinterface + ['{8608FE7B-2FDC-318A-B711-6F7B2FEDED06}'] + end; + {$EXTERNALSYM _SafeArrayRankMismatchExceptionDisp} + +// *********************************************************************// +// Interface: _SafeArrayTypeMismatchException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E093FB32-E43B-3B3F-A163-742C920C2AF3} +// *********************************************************************// + _SafeArrayTypeMismatchException = interface(IDispatch) + ['{E093FB32-E43B-3B3F-A163-742C920C2AF3}'] + end; + +// *********************************************************************// +// DispIntf: _SafeArrayTypeMismatchExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E093FB32-E43B-3B3F-A163-742C920C2AF3} +// *********************************************************************// + _SafeArrayTypeMismatchExceptionDisp = dispinterface + ['{E093FB32-E43B-3B3F-A163-742C920C2AF3}'] + end; + {$EXTERNALSYM _SafeArrayTypeMismatchExceptionDisp} + +// *********************************************************************// +// Interface: _SEHException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3E72E067-4C5E-36C8-BBEF-1E2978C7780D} +// *********************************************************************// + _SEHException = interface(IDispatch) + ['{3E72E067-4C5E-36C8-BBEF-1E2978C7780D}'] + end; + +// *********************************************************************// +// DispIntf: _SEHExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3E72E067-4C5E-36C8-BBEF-1E2978C7780D} +// *********************************************************************// + _SEHExceptionDisp = dispinterface + ['{3E72E067-4C5E-36C8-BBEF-1E2978C7780D}'] + end; + {$EXTERNALSYM _SEHExceptionDisp} + +// *********************************************************************// +// Interface: _UnknownWrapper +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1C8D8B14-4589-3DCA-8E0F-A30E80FBD1A8} +// *********************************************************************// + _UnknownWrapper = interface(IDispatch) + ['{1C8D8B14-4589-3DCA-8E0F-A30E80FBD1A8}'] + end; + +// *********************************************************************// +// DispIntf: _UnknownWrapperDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1C8D8B14-4589-3DCA-8E0F-A30E80FBD1A8} +// *********************************************************************// + _UnknownWrapperDisp = dispinterface + ['{1C8D8B14-4589-3DCA-8E0F-A30E80FBD1A8}'] + end; + {$EXTERNALSYM _UnknownWrapperDisp} + +// *********************************************************************// +// Interface: IExpando +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {AFBF15E6-C37C-11D2-B88E-00A0C9B471B8} +// *********************************************************************// + IExpando = interface(IDispatch) + ['{AFBF15E6-C37C-11D2-B88E-00A0C9B471B8}'] + function AddField(const name: WideString): _FieldInfo; safecall; + function AddProperty(const name: WideString): _PropertyInfo; safecall; + function AddMethod(const name: WideString; const Method: _Delegate): _MethodInfo; safecall; + procedure RemoveMember(const m: _MemberInfo); safecall; + end; + +// *********************************************************************// +// DispIntf: IExpandoDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {AFBF15E6-C37C-11D2-B88E-00A0C9B471B8} +// *********************************************************************// + IExpandoDisp = dispinterface + ['{AFBF15E6-C37C-11D2-B88E-00A0C9B471B8}'] + function AddField(const name: WideString): _FieldInfo; dispid 1610743808; + function AddProperty(const name: WideString): _PropertyInfo; dispid 1610743809; + function AddMethod(const name: WideString; const Method: _Delegate): _MethodInfo; dispid 1610743810; + procedure RemoveMember(const m: _MemberInfo); dispid 1610743811; + end; + {$EXTERNALSYM IExpandoDisp} + +// *********************************************************************// +// Interface: _BinaryReader +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {442E3C03-A205-3F21-AA4D-31768BB8EA28} +// *********************************************************************// + _BinaryReader = interface(IDispatch) + ['{442E3C03-A205-3F21-AA4D-31768BB8EA28}'] + end; + +// *********************************************************************// +// DispIntf: _BinaryReaderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {442E3C03-A205-3F21-AA4D-31768BB8EA28} +// *********************************************************************// + _BinaryReaderDisp = dispinterface + ['{442E3C03-A205-3F21-AA4D-31768BB8EA28}'] + end; + {$EXTERNALSYM _BinaryReaderDisp} + +// *********************************************************************// +// Interface: _BinaryWriter +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4CA8147E-BAA3-3A7F-92CE-A4FD7F17D8DA} +// *********************************************************************// + _BinaryWriter = interface(IDispatch) + ['{4CA8147E-BAA3-3A7F-92CE-A4FD7F17D8DA}'] + end; + +// *********************************************************************// +// DispIntf: _BinaryWriterDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4CA8147E-BAA3-3A7F-92CE-A4FD7F17D8DA} +// *********************************************************************// + _BinaryWriterDisp = dispinterface + ['{4CA8147E-BAA3-3A7F-92CE-A4FD7F17D8DA}'] + end; + {$EXTERNALSYM _BinaryWriterDisp} + +// *********************************************************************// +// Interface: _BufferedStream +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4B7571C3-1275-3457-8FEE-9976FD3937E3} +// *********************************************************************// + _BufferedStream = interface(IDispatch) + ['{4B7571C3-1275-3457-8FEE-9976FD3937E3}'] + end; + +// *********************************************************************// +// DispIntf: _BufferedStreamDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4B7571C3-1275-3457-8FEE-9976FD3937E3} +// *********************************************************************// + _BufferedStreamDisp = dispinterface + ['{4B7571C3-1275-3457-8FEE-9976FD3937E3}'] + end; + {$EXTERNALSYM _BufferedStreamDisp} + +// *********************************************************************// +// Interface: _Directory +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8CE58FF5-F26D-38A4-9195-0E2ECB3B56B9} +// *********************************************************************// + _Directory = interface(IDispatch) + ['{8CE58FF5-F26D-38A4-9195-0E2ECB3B56B9}'] + end; + +// *********************************************************************// +// DispIntf: _DirectoryDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8CE58FF5-F26D-38A4-9195-0E2ECB3B56B9} +// *********************************************************************// + _DirectoryDisp = dispinterface + ['{8CE58FF5-F26D-38A4-9195-0E2ECB3B56B9}'] + end; + {$EXTERNALSYM _DirectoryDisp} + +// *********************************************************************// +// Interface: _FileSystemInfo +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A5D29A57-36A8-3E36-A099-7458B1FABAA2} +// *********************************************************************// + _FileSystemInfo = interface(IDispatch) + ['{A5D29A57-36A8-3E36-A099-7458B1FABAA2}'] + end; + +// *********************************************************************// +// DispIntf: _FileSystemInfoDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A5D29A57-36A8-3E36-A099-7458B1FABAA2} +// *********************************************************************// + _FileSystemInfoDisp = dispinterface + ['{A5D29A57-36A8-3E36-A099-7458B1FABAA2}'] + end; + {$EXTERNALSYM _FileSystemInfoDisp} + +// *********************************************************************// +// Interface: _DirectoryInfo +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {487E52F1-2BB9-3BD0-A0CA-6728B3A1D051} +// *********************************************************************// + _DirectoryInfo = interface(IDispatch) + ['{487E52F1-2BB9-3BD0-A0CA-6728B3A1D051}'] + end; + +// *********************************************************************// +// DispIntf: _DirectoryInfoDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {487E52F1-2BB9-3BD0-A0CA-6728B3A1D051} +// *********************************************************************// + _DirectoryInfoDisp = dispinterface + ['{487E52F1-2BB9-3BD0-A0CA-6728B3A1D051}'] + end; + {$EXTERNALSYM _DirectoryInfoDisp} + +// *********************************************************************// +// Interface: _IOException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C5BFC9BF-27A7-3A59-A986-44C85F3521BF} +// *********************************************************************// + _IOException = interface(IDispatch) + ['{C5BFC9BF-27A7-3A59-A986-44C85F3521BF}'] + end; + +// *********************************************************************// +// DispIntf: _IOExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C5BFC9BF-27A7-3A59-A986-44C85F3521BF} +// *********************************************************************// + _IOExceptionDisp = dispinterface + ['{C5BFC9BF-27A7-3A59-A986-44C85F3521BF}'] + end; + {$EXTERNALSYM _IOExceptionDisp} + +// *********************************************************************// +// Interface: _DirectoryNotFoundException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C8A200E4-9735-30E4-B168-ED861A3020F2} +// *********************************************************************// + _DirectoryNotFoundException = interface(IDispatch) + ['{C8A200E4-9735-30E4-B168-ED861A3020F2}'] + end; + +// *********************************************************************// +// DispIntf: _DirectoryNotFoundExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C8A200E4-9735-30E4-B168-ED861A3020F2} +// *********************************************************************// + _DirectoryNotFoundExceptionDisp = dispinterface + ['{C8A200E4-9735-30E4-B168-ED861A3020F2}'] + end; + {$EXTERNALSYM _DirectoryNotFoundExceptionDisp} + +// *********************************************************************// +// Interface: _EndOfStreamException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D625AFD0-8FD9-3113-A900-43912A54C421} +// *********************************************************************// + _EndOfStreamException = interface(IDispatch) + ['{D625AFD0-8FD9-3113-A900-43912A54C421}'] + end; + +// *********************************************************************// +// DispIntf: _EndOfStreamExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D625AFD0-8FD9-3113-A900-43912A54C421} +// *********************************************************************// + _EndOfStreamExceptionDisp = dispinterface + ['{D625AFD0-8FD9-3113-A900-43912A54C421}'] + end; + {$EXTERNALSYM _EndOfStreamExceptionDisp} + +// *********************************************************************// +// Interface: _File +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {5D59051F-E19D-329A-9962-FD00D552E13D} +// *********************************************************************// + _File = interface(IDispatch) + ['{5D59051F-E19D-329A-9962-FD00D552E13D}'] + end; + +// *********************************************************************// +// DispIntf: _FileDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {5D59051F-E19D-329A-9962-FD00D552E13D} +// *********************************************************************// + _FileDisp = dispinterface + ['{5D59051F-E19D-329A-9962-FD00D552E13D}'] + end; + {$EXTERNALSYM _FileDisp} + +// *********************************************************************// +// Interface: _FileInfo +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C3C429F9-8590-3A01-B2B2-434837F3D16D} +// *********************************************************************// + _FileInfo = interface(IDispatch) + ['{C3C429F9-8590-3A01-B2B2-434837F3D16D}'] + end; + +// *********************************************************************// +// DispIntf: _FileInfoDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C3C429F9-8590-3A01-B2B2-434837F3D16D} +// *********************************************************************// + _FileInfoDisp = dispinterface + ['{C3C429F9-8590-3A01-B2B2-434837F3D16D}'] + end; + {$EXTERNALSYM _FileInfoDisp} + +// *********************************************************************// +// Interface: _FileLoadException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {51D2C393-9B70-3551-84B5-FF5409FB3ADA} +// *********************************************************************// + _FileLoadException = interface(IDispatch) + ['{51D2C393-9B70-3551-84B5-FF5409FB3ADA}'] + end; + +// *********************************************************************// +// DispIntf: _FileLoadExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {51D2C393-9B70-3551-84B5-FF5409FB3ADA} +// *********************************************************************// + _FileLoadExceptionDisp = dispinterface + ['{51D2C393-9B70-3551-84B5-FF5409FB3ADA}'] + end; + {$EXTERNALSYM _FileLoadExceptionDisp} + +// *********************************************************************// +// Interface: _FileNotFoundException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A15A976B-81E3-3EF4-8FF1-D75DDBE20AEF} +// *********************************************************************// + _FileNotFoundException = interface(IDispatch) + ['{A15A976B-81E3-3EF4-8FF1-D75DDBE20AEF}'] + end; + +// *********************************************************************// +// DispIntf: _FileNotFoundExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A15A976B-81E3-3EF4-8FF1-D75DDBE20AEF} +// *********************************************************************// + _FileNotFoundExceptionDisp = dispinterface + ['{A15A976B-81E3-3EF4-8FF1-D75DDBE20AEF}'] + end; + {$EXTERNALSYM _FileNotFoundExceptionDisp} + +// *********************************************************************// +// Interface: _FileStream +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {74265195-4A46-3D6F-A9DD-69C367EA39C8} +// *********************************************************************// + _FileStream = interface(IDispatch) + ['{74265195-4A46-3D6F-A9DD-69C367EA39C8}'] + end; + +// *********************************************************************// +// DispIntf: _FileStreamDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {74265195-4A46-3D6F-A9DD-69C367EA39C8} +// *********************************************************************// + _FileStreamDisp = dispinterface + ['{74265195-4A46-3D6F-A9DD-69C367EA39C8}'] + end; + {$EXTERNALSYM _FileStreamDisp} + +// *********************************************************************// +// Interface: _MemoryStream +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {2DBC46FE-B3DD-3858-AFC2-D3A2D492A588} +// *********************************************************************// + _MemoryStream = interface(IDispatch) + ['{2DBC46FE-B3DD-3858-AFC2-D3A2D492A588}'] + end; + +// *********************************************************************// +// DispIntf: _MemoryStreamDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {2DBC46FE-B3DD-3858-AFC2-D3A2D492A588} +// *********************************************************************// + _MemoryStreamDisp = dispinterface + ['{2DBC46FE-B3DD-3858-AFC2-D3A2D492A588}'] + end; + {$EXTERNALSYM _MemoryStreamDisp} + +// *********************************************************************// +// Interface: _Path +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6DF93530-D276-31D9-8573-346778C650AF} +// *********************************************************************// + _Path = interface(IDispatch) + ['{6DF93530-D276-31D9-8573-346778C650AF}'] + end; + +// *********************************************************************// +// DispIntf: _PathDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6DF93530-D276-31D9-8573-346778C650AF} +// *********************************************************************// + _PathDisp = dispinterface + ['{6DF93530-D276-31D9-8573-346778C650AF}'] + end; + {$EXTERNALSYM _PathDisp} + +// *********************************************************************// +// Interface: _PathTooLongException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {468B8EB4-89AC-381B-8F86-5E47EC0648B4} +// *********************************************************************// + _PathTooLongException = interface(IDispatch) + ['{468B8EB4-89AC-381B-8F86-5E47EC0648B4}'] + end; + +// *********************************************************************// +// DispIntf: _PathTooLongExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {468B8EB4-89AC-381B-8F86-5E47EC0648B4} +// *********************************************************************// + _PathTooLongExceptionDisp = dispinterface + ['{468B8EB4-89AC-381B-8F86-5E47EC0648B4}'] + end; + {$EXTERNALSYM _PathTooLongExceptionDisp} + +// *********************************************************************// +// Interface: _TextReader +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {897471F2-9450-3F03-A41F-D2E1F1397854} +// *********************************************************************// + _TextReader = interface(IDispatch) + ['{897471F2-9450-3F03-A41F-D2E1F1397854}'] + end; + +// *********************************************************************// +// DispIntf: _TextReaderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {897471F2-9450-3F03-A41F-D2E1F1397854} +// *********************************************************************// + _TextReaderDisp = dispinterface + ['{897471F2-9450-3F03-A41F-D2E1F1397854}'] + end; + {$EXTERNALSYM _TextReaderDisp} + +// *********************************************************************// +// Interface: _StreamReader +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E645B470-DC3F-3CE0-8104-5837FEDA04B3} +// *********************************************************************// + _StreamReader = interface(IDispatch) + ['{E645B470-DC3F-3CE0-8104-5837FEDA04B3}'] + end; + +// *********************************************************************// +// DispIntf: _StreamReaderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E645B470-DC3F-3CE0-8104-5837FEDA04B3} +// *********************************************************************// + _StreamReaderDisp = dispinterface + ['{E645B470-DC3F-3CE0-8104-5837FEDA04B3}'] + end; + {$EXTERNALSYM _StreamReaderDisp} + +// *********************************************************************// +// Interface: _TextWriter +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {556137EA-8825-30BC-9D49-E47A9DB034EE} +// *********************************************************************// + _TextWriter = interface(IDispatch) + ['{556137EA-8825-30BC-9D49-E47A9DB034EE}'] + end; + +// *********************************************************************// +// DispIntf: _TextWriterDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {556137EA-8825-30BC-9D49-E47A9DB034EE} +// *********************************************************************// + _TextWriterDisp = dispinterface + ['{556137EA-8825-30BC-9D49-E47A9DB034EE}'] + end; + {$EXTERNALSYM _TextWriterDisp} + +// *********************************************************************// +// Interface: _StreamWriter +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1F124E1C-D05D-3643-A59F-C3DE6051994F} +// *********************************************************************// + _StreamWriter = interface(IDispatch) + ['{1F124E1C-D05D-3643-A59F-C3DE6051994F}'] + end; + +// *********************************************************************// +// DispIntf: _StreamWriterDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1F124E1C-D05D-3643-A59F-C3DE6051994F} +// *********************************************************************// + _StreamWriterDisp = dispinterface + ['{1F124E1C-D05D-3643-A59F-C3DE6051994F}'] + end; + {$EXTERNALSYM _StreamWriterDisp} + +// *********************************************************************// +// Interface: _StringReader +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {59733B03-0EA5-358C-95B5-659FCD9AA0B4} +// *********************************************************************// + _StringReader = interface(IDispatch) + ['{59733B03-0EA5-358C-95B5-659FCD9AA0B4}'] + end; + +// *********************************************************************// +// DispIntf: _StringReaderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {59733B03-0EA5-358C-95B5-659FCD9AA0B4} +// *********************************************************************// + _StringReaderDisp = dispinterface + ['{59733B03-0EA5-358C-95B5-659FCD9AA0B4}'] + end; + {$EXTERNALSYM _StringReaderDisp} + +// *********************************************************************// +// Interface: _StringWriter +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {CB9F94C0-D691-3B62-B0B2-3CE5309CFA62} +// *********************************************************************// + _StringWriter = interface(IDispatch) + ['{CB9F94C0-D691-3B62-B0B2-3CE5309CFA62}'] + end; + +// *********************************************************************// +// DispIntf: _StringWriterDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {CB9F94C0-D691-3B62-B0B2-3CE5309CFA62} +// *********************************************************************// + _StringWriterDisp = dispinterface + ['{CB9F94C0-D691-3B62-B0B2-3CE5309CFA62}'] + end; + {$EXTERNALSYM _StringWriterDisp} + +// *********************************************************************// +// Interface: _AccessedThroughPropertyAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {998DCF16-F603-355D-8C89-3B675947997F} +// *********************************************************************// + _AccessedThroughPropertyAttribute = interface(IDispatch) + ['{998DCF16-F603-355D-8C89-3B675947997F}'] + end; + +// *********************************************************************// +// DispIntf: _AccessedThroughPropertyAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {998DCF16-F603-355D-8C89-3B675947997F} +// *********************************************************************// + _AccessedThroughPropertyAttributeDisp = dispinterface + ['{998DCF16-F603-355D-8C89-3B675947997F}'] + end; + {$EXTERNALSYM _AccessedThroughPropertyAttributeDisp} + +// *********************************************************************// +// Interface: _CallConvCdecl +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A6C2239B-08E6-3822-9769-E3D4B0431B82} +// *********************************************************************// + _CallConvCdecl = interface(IDispatch) + ['{A6C2239B-08E6-3822-9769-E3D4B0431B82}'] + end; + +// *********************************************************************// +// DispIntf: _CallConvCdeclDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A6C2239B-08E6-3822-9769-E3D4B0431B82} +// *********************************************************************// + _CallConvCdeclDisp = dispinterface + ['{A6C2239B-08E6-3822-9769-E3D4B0431B82}'] + end; + {$EXTERNALSYM _CallConvCdeclDisp} + +// *********************************************************************// +// Interface: _CallConvStdcall +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8E17A5CD-1160-32DC-8548-407E7C3827C9} +// *********************************************************************// + _CallConvStdcall = interface(IDispatch) + ['{8E17A5CD-1160-32DC-8548-407E7C3827C9}'] + end; + +// *********************************************************************// +// DispIntf: _CallConvStdcallDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8E17A5CD-1160-32DC-8548-407E7C3827C9} +// *********************************************************************// + _CallConvStdcallDisp = dispinterface + ['{8E17A5CD-1160-32DC-8548-407E7C3827C9}'] + end; + {$EXTERNALSYM _CallConvStdcallDisp} + +// *********************************************************************// +// Interface: _CallConvThiscall +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FA73DD3D-A472-35ED-B8BE-F99A13581F72} +// *********************************************************************// + _CallConvThiscall = interface(IDispatch) + ['{FA73DD3D-A472-35ED-B8BE-F99A13581F72}'] + end; + +// *********************************************************************// +// DispIntf: _CallConvThiscallDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FA73DD3D-A472-35ED-B8BE-F99A13581F72} +// *********************************************************************// + _CallConvThiscallDisp = dispinterface + ['{FA73DD3D-A472-35ED-B8BE-F99A13581F72}'] + end; + {$EXTERNALSYM _CallConvThiscallDisp} + +// *********************************************************************// +// Interface: _CallConvFastcall +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3B452D17-3C5E-36C4-A12D-5E9276036CF8} +// *********************************************************************// + _CallConvFastcall = interface(IDispatch) + ['{3B452D17-3C5E-36C4-A12D-5E9276036CF8}'] + end; + +// *********************************************************************// +// DispIntf: _CallConvFastcallDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3B452D17-3C5E-36C4-A12D-5E9276036CF8} +// *********************************************************************// + _CallConvFastcallDisp = dispinterface + ['{3B452D17-3C5E-36C4-A12D-5E9276036CF8}'] + end; + {$EXTERNALSYM _CallConvFastcallDisp} + +// *********************************************************************// +// Interface: _RuntimeHelpers +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {028A39F4-2061-3C98-897C-2F6B29370B9B} +// *********************************************************************// + _RuntimeHelpers = interface(IDispatch) + ['{028A39F4-2061-3C98-897C-2F6B29370B9B}'] + end; + +// *********************************************************************// +// DispIntf: _RuntimeHelpersDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {028A39F4-2061-3C98-897C-2F6B29370B9B} +// *********************************************************************// + _RuntimeHelpersDisp = dispinterface + ['{028A39F4-2061-3C98-897C-2F6B29370B9B}'] + end; + {$EXTERNALSYM _RuntimeHelpersDisp} + +// *********************************************************************// +// Interface: _CustomConstantAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {62CAF4A2-6A78-3FC7-AF81-A6BBF930761F} +// *********************************************************************// + _CustomConstantAttribute = interface(IDispatch) + ['{62CAF4A2-6A78-3FC7-AF81-A6BBF930761F}'] + end; + +// *********************************************************************// +// DispIntf: _CustomConstantAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {62CAF4A2-6A78-3FC7-AF81-A6BBF930761F} +// *********************************************************************// + _CustomConstantAttributeDisp = dispinterface + ['{62CAF4A2-6A78-3FC7-AF81-A6BBF930761F}'] + end; + {$EXTERNALSYM _CustomConstantAttributeDisp} + +// *********************************************************************// +// Interface: _DateTimeConstantAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {EF387020-B664-3ACD-A1D2-806345845953} +// *********************************************************************// + _DateTimeConstantAttribute = interface(IDispatch) + ['{EF387020-B664-3ACD-A1D2-806345845953}'] + end; + +// *********************************************************************// +// DispIntf: _DateTimeConstantAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {EF387020-B664-3ACD-A1D2-806345845953} +// *********************************************************************// + _DateTimeConstantAttributeDisp = dispinterface + ['{EF387020-B664-3ACD-A1D2-806345845953}'] + end; + {$EXTERNALSYM _DateTimeConstantAttributeDisp} + +// *********************************************************************// +// Interface: _DiscardableAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3C3A8C69-7417-32FA-AA20-762D85E1B594} +// *********************************************************************// + _DiscardableAttribute = interface(IDispatch) + ['{3C3A8C69-7417-32FA-AA20-762D85E1B594}'] + end; + +// *********************************************************************// +// DispIntf: _DiscardableAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3C3A8C69-7417-32FA-AA20-762D85E1B594} +// *********************************************************************// + _DiscardableAttributeDisp = dispinterface + ['{3C3A8C69-7417-32FA-AA20-762D85E1B594}'] + end; + {$EXTERNALSYM _DiscardableAttributeDisp} + +// *********************************************************************// +// Interface: _DecimalConstantAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7E133967-CCEC-3E89-8BD2-6CFCA649ECBF} +// *********************************************************************// + _DecimalConstantAttribute = interface(IDispatch) + ['{7E133967-CCEC-3E89-8BD2-6CFCA649ECBF}'] + end; + +// *********************************************************************// +// DispIntf: _DecimalConstantAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7E133967-CCEC-3E89-8BD2-6CFCA649ECBF} +// *********************************************************************// + _DecimalConstantAttributeDisp = dispinterface + ['{7E133967-CCEC-3E89-8BD2-6CFCA649ECBF}'] + end; + {$EXTERNALSYM _DecimalConstantAttributeDisp} + +// *********************************************************************// +// Interface: _CompilationRelaxationsAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C5C4F625-2329-3382-8994-AAF561E5DFE9} +// *********************************************************************// + _CompilationRelaxationsAttribute = interface(IDispatch) + ['{C5C4F625-2329-3382-8994-AAF561E5DFE9}'] + end; + +// *********************************************************************// +// DispIntf: _CompilationRelaxationsAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C5C4F625-2329-3382-8994-AAF561E5DFE9} +// *********************************************************************// + _CompilationRelaxationsAttributeDisp = dispinterface + ['{C5C4F625-2329-3382-8994-AAF561E5DFE9}'] + end; + {$EXTERNALSYM _CompilationRelaxationsAttributeDisp} + +// *********************************************************************// +// Interface: _CompilerGlobalScopeAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1EED213E-656A-3A73-A4B9-0D3B26FD942B} +// *********************************************************************// + _CompilerGlobalScopeAttribute = interface(IDispatch) + ['{1EED213E-656A-3A73-A4B9-0D3B26FD942B}'] + end; + +// *********************************************************************// +// DispIntf: _CompilerGlobalScopeAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1EED213E-656A-3A73-A4B9-0D3B26FD942B} +// *********************************************************************// + _CompilerGlobalScopeAttributeDisp = dispinterface + ['{1EED213E-656A-3A73-A4B9-0D3B26FD942B}'] + end; + {$EXTERNALSYM _CompilerGlobalScopeAttributeDisp} + +// *********************************************************************// +// Interface: _IDispatchConstantAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {97D0B28A-6932-3D74-B67F-6BCD3C921E7D} +// *********************************************************************// + _IDispatchConstantAttribute = interface(IDispatch) + ['{97D0B28A-6932-3D74-B67F-6BCD3C921E7D}'] + end; + +// *********************************************************************// +// DispIntf: _IDispatchConstantAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {97D0B28A-6932-3D74-B67F-6BCD3C921E7D} +// *********************************************************************// + _IDispatchConstantAttributeDisp = dispinterface + ['{97D0B28A-6932-3D74-B67F-6BCD3C921E7D}'] + end; + {$EXTERNALSYM _IDispatchConstantAttributeDisp} + +// *********************************************************************// +// Interface: _IndexerNameAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {243368F5-67C9-3510-9424-335A8A67772F} +// *********************************************************************// + _IndexerNameAttribute = interface(IDispatch) + ['{243368F5-67C9-3510-9424-335A8A67772F}'] + end; + +// *********************************************************************// +// DispIntf: _IndexerNameAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {243368F5-67C9-3510-9424-335A8A67772F} +// *********************************************************************// + _IndexerNameAttributeDisp = dispinterface + ['{243368F5-67C9-3510-9424-335A8A67772F}'] + end; + {$EXTERNALSYM _IndexerNameAttributeDisp} + +// *********************************************************************// +// Interface: _IsVolatile +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0278C819-0C06-3756-B053-601A3E566D9B} +// *********************************************************************// + _IsVolatile = interface(IDispatch) + ['{0278C819-0C06-3756-B053-601A3E566D9B}'] + end; + +// *********************************************************************// +// DispIntf: _IsVolatileDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0278C819-0C06-3756-B053-601A3E566D9B} +// *********************************************************************// + _IsVolatileDisp = dispinterface + ['{0278C819-0C06-3756-B053-601A3E566D9B}'] + end; + {$EXTERNALSYM _IsVolatileDisp} + +// *********************************************************************// +// Interface: _IUnknownConstantAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {54542649-CE64-3F96-BCE5-FDE3BB22F242} +// *********************************************************************// + _IUnknownConstantAttribute = interface(IDispatch) + ['{54542649-CE64-3F96-BCE5-FDE3BB22F242}'] + end; + +// *********************************************************************// +// DispIntf: _IUnknownConstantAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {54542649-CE64-3F96-BCE5-FDE3BB22F242} +// *********************************************************************// + _IUnknownConstantAttributeDisp = dispinterface + ['{54542649-CE64-3F96-BCE5-FDE3BB22F242}'] + end; + {$EXTERNALSYM _IUnknownConstantAttributeDisp} + +// *********************************************************************// +// Interface: _MethodImplAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {98966503-5D80-3242-83EF-79E136F6B954} +// *********************************************************************// + _MethodImplAttribute = interface(IDispatch) + ['{98966503-5D80-3242-83EF-79E136F6B954}'] + end; + +// *********************************************************************// +// DispIntf: _MethodImplAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {98966503-5D80-3242-83EF-79E136F6B954} +// *********************************************************************// + _MethodImplAttributeDisp = dispinterface + ['{98966503-5D80-3242-83EF-79E136F6B954}'] + end; + {$EXTERNALSYM _MethodImplAttributeDisp} + +// *********************************************************************// +// Interface: _RequiredAttributeAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DB2C11D9-3870-35E7-A10C-A3DDC3DC79B1} +// *********************************************************************// + _RequiredAttributeAttribute = interface(IDispatch) + ['{DB2C11D9-3870-35E7-A10C-A3DDC3DC79B1}'] + end; + +// *********************************************************************// +// DispIntf: _RequiredAttributeAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {DB2C11D9-3870-35E7-A10C-A3DDC3DC79B1} +// *********************************************************************// + _RequiredAttributeAttributeDisp = dispinterface + ['{DB2C11D9-3870-35E7-A10C-A3DDC3DC79B1}'] + end; + {$EXTERNALSYM _RequiredAttributeAttributeDisp} + +// *********************************************************************// +// Interface: IStackWalk +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {60FC57B0-4A46-32A0-A5B4-B05B0DE8E781} +// *********************************************************************// + IStackWalk = interface(IDispatch) + ['{60FC57B0-4A46-32A0-A5B4-B05B0DE8E781}'] + procedure _Assert; safecall; + procedure Demand; safecall; + procedure Deny; safecall; + procedure PermitOnly; safecall; + end; + +// *********************************************************************// +// DispIntf: IStackWalkDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {60FC57B0-4A46-32A0-A5B4-B05B0DE8E781} +// *********************************************************************// + IStackWalkDisp = dispinterface + ['{60FC57B0-4A46-32A0-A5B4-B05B0DE8E781}'] + procedure Assert; dispid 1610743808; + procedure Demand; dispid 1610743809; + procedure Deny; dispid 1610743810; + procedure PermitOnly; dispid 1610743811; + end; + {$EXTERNALSYM IStackWalkDisp} + +// *********************************************************************// +// Interface: _PermissionSet +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C2AF4970-4FB6-319C-A8AA-0614D27F2B2C} +// *********************************************************************// + _PermissionSet = interface(IDispatch) + ['{C2AF4970-4FB6-319C-A8AA-0614D27F2B2C}'] + end; + +// *********************************************************************// +// DispIntf: _PermissionSetDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C2AF4970-4FB6-319C-A8AA-0614D27F2B2C} +// *********************************************************************// + _PermissionSetDisp = dispinterface + ['{C2AF4970-4FB6-319C-A8AA-0614D27F2B2C}'] + end; + {$EXTERNALSYM _PermissionSetDisp} + +// *********************************************************************// +// Interface: _NamedPermissionSet +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BA3E053F-ADE3-3233-874A-16E624C9A49B} +// *********************************************************************// + _NamedPermissionSet = interface(IDispatch) + ['{BA3E053F-ADE3-3233-874A-16E624C9A49B}'] + end; + +// *********************************************************************// +// DispIntf: _NamedPermissionSetDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BA3E053F-ADE3-3233-874A-16E624C9A49B} +// *********************************************************************// + _NamedPermissionSetDisp = dispinterface + ['{BA3E053F-ADE3-3233-874A-16E624C9A49B}'] + end; + {$EXTERNALSYM _NamedPermissionSetDisp} + +// *********************************************************************// +// Interface: _SecurityElement +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8D597C42-2CFD-32B6-B6D6-86C9E2CFF00A} +// *********************************************************************// + _SecurityElement = interface(IDispatch) + ['{8D597C42-2CFD-32B6-B6D6-86C9E2CFF00A}'] + end; + +// *********************************************************************// +// DispIntf: _SecurityElementDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8D597C42-2CFD-32B6-B6D6-86C9E2CFF00A} +// *********************************************************************// + _SecurityElementDisp = dispinterface + ['{8D597C42-2CFD-32B6-B6D6-86C9E2CFF00A}'] + end; + {$EXTERNALSYM _SecurityElementDisp} + +// *********************************************************************// +// Interface: _XmlSyntaxException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D9FCAD88-D869-3788-A802-1B1E007C7A22} +// *********************************************************************// + _XmlSyntaxException = interface(IDispatch) + ['{D9FCAD88-D869-3788-A802-1B1E007C7A22}'] + end; + +// *********************************************************************// +// DispIntf: _XmlSyntaxExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D9FCAD88-D869-3788-A802-1B1E007C7A22} +// *********************************************************************// + _XmlSyntaxExceptionDisp = dispinterface + ['{D9FCAD88-D869-3788-A802-1B1E007C7A22}'] + end; + {$EXTERNALSYM _XmlSyntaxExceptionDisp} + +// *********************************************************************// +// Interface: IPermission +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {A19B3FC6-D680-3DD4-A17A-F58A7D481494} +// *********************************************************************// + IPermission = interface(IDispatch) + ['{A19B3FC6-D680-3DD4-A17A-F58A7D481494}'] + function Copy: IPermission; safecall; + function Intersect(const Target: IPermission): IPermission; safecall; + function Union(const Target: IPermission): IPermission; safecall; + function IsSubsetOf(const Target: IPermission): WordBool; safecall; + procedure Demand; safecall; + end; + +// *********************************************************************// +// DispIntf: IPermissionDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {A19B3FC6-D680-3DD4-A17A-F58A7D481494} +// *********************************************************************// + IPermissionDisp = dispinterface + ['{A19B3FC6-D680-3DD4-A17A-F58A7D481494}'] + function Copy: IPermission; dispid 1610743808; + function Intersect(const Target: IPermission): IPermission; dispid 1610743809; + function Union(const Target: IPermission): IPermission; dispid 1610743810; + function IsSubsetOf(const Target: IPermission): WordBool; dispid 1610743811; + procedure Demand; dispid 1610743812; + end; + {$EXTERNALSYM IPermissionDisp} + +// *********************************************************************// +// Interface: _CodeAccessPermission +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4803CE39-2F30-31FC-B84B-5A0141385269} +// *********************************************************************// + _CodeAccessPermission = interface(IDispatch) + ['{4803CE39-2F30-31FC-B84B-5A0141385269}'] + end; + +// *********************************************************************// +// DispIntf: _CodeAccessPermissionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4803CE39-2F30-31FC-B84B-5A0141385269} +// *********************************************************************// + _CodeAccessPermissionDisp = dispinterface + ['{4803CE39-2F30-31FC-B84B-5A0141385269}'] + end; + {$EXTERNALSYM _CodeAccessPermissionDisp} + +// *********************************************************************// +// Interface: IUnrestrictedPermission +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {0F1284E6-4399-3963-8DDD-A6A4904F66C8} +// *********************************************************************// + IUnrestrictedPermission = interface(IDispatch) + ['{0F1284E6-4399-3963-8DDD-A6A4904F66C8}'] + function IsUnrestricted: WordBool; safecall; + end; + +// *********************************************************************// +// DispIntf: IUnrestrictedPermissionDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {0F1284E6-4399-3963-8DDD-A6A4904F66C8} +// *********************************************************************// + IUnrestrictedPermissionDisp = dispinterface + ['{0F1284E6-4399-3963-8DDD-A6A4904F66C8}'] + function IsUnrestricted: WordBool; dispid 1610743808; + end; + {$EXTERNALSYM IUnrestrictedPermissionDisp} + +// *********************************************************************// +// Interface: _EnvironmentPermission +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0720590D-5218-352A-A337-5449E6BD19DA} +// *********************************************************************// + _EnvironmentPermission = interface(IDispatch) + ['{0720590D-5218-352A-A337-5449E6BD19DA}'] + end; + +// *********************************************************************// +// DispIntf: _EnvironmentPermissionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0720590D-5218-352A-A337-5449E6BD19DA} +// *********************************************************************// + _EnvironmentPermissionDisp = dispinterface + ['{0720590D-5218-352A-A337-5449E6BD19DA}'] + end; + {$EXTERNALSYM _EnvironmentPermissionDisp} + +// *********************************************************************// +// Interface: _FileDialogPermission +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A8B7138C-8932-3D78-A585-A91569C743AC} +// *********************************************************************// + _FileDialogPermission = interface(IDispatch) + ['{A8B7138C-8932-3D78-A585-A91569C743AC}'] + end; + +// *********************************************************************// +// DispIntf: _FileDialogPermissionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A8B7138C-8932-3D78-A585-A91569C743AC} +// *********************************************************************// + _FileDialogPermissionDisp = dispinterface + ['{A8B7138C-8932-3D78-A585-A91569C743AC}'] + end; + {$EXTERNALSYM _FileDialogPermissionDisp} + +// *********************************************************************// +// Interface: _FileIOPermission +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A2ED7EFC-8E59-3CCC-AE92-EA2377F4D5EF} +// *********************************************************************// + _FileIOPermission = interface(IDispatch) + ['{A2ED7EFC-8E59-3CCC-AE92-EA2377F4D5EF}'] + end; + +// *********************************************************************// +// DispIntf: _FileIOPermissionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A2ED7EFC-8E59-3CCC-AE92-EA2377F4D5EF} +// *********************************************************************// + _FileIOPermissionDisp = dispinterface + ['{A2ED7EFC-8E59-3CCC-AE92-EA2377F4D5EF}'] + end; + {$EXTERNALSYM _FileIOPermissionDisp} + +// *********************************************************************// +// Interface: _IsolatedStoragePermission +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7FEE7903-F97C-3350-AD42-196B00AD2564} +// *********************************************************************// + _IsolatedStoragePermission = interface(IDispatch) + ['{7FEE7903-F97C-3350-AD42-196B00AD2564}'] + end; + +// *********************************************************************// +// DispIntf: _IsolatedStoragePermissionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7FEE7903-F97C-3350-AD42-196B00AD2564} +// *********************************************************************// + _IsolatedStoragePermissionDisp = dispinterface + ['{7FEE7903-F97C-3350-AD42-196B00AD2564}'] + end; + {$EXTERNALSYM _IsolatedStoragePermissionDisp} + +// *********************************************************************// +// Interface: _IsolatedStorageFilePermission +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0D0C83E8-BDE1-3BA5-B1EF-A8FC686D8BC9} +// *********************************************************************// + _IsolatedStorageFilePermission = interface(IDispatch) + ['{0D0C83E8-BDE1-3BA5-B1EF-A8FC686D8BC9}'] + end; + +// *********************************************************************// +// DispIntf: _IsolatedStorageFilePermissionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0D0C83E8-BDE1-3BA5-B1EF-A8FC686D8BC9} +// *********************************************************************// + _IsolatedStorageFilePermissionDisp = dispinterface + ['{0D0C83E8-BDE1-3BA5-B1EF-A8FC686D8BC9}'] + end; + {$EXTERNALSYM _IsolatedStorageFilePermissionDisp} + +// *********************************************************************// +// Interface: _SecurityAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {48815668-6C27-3312-803E-2757F55CE96A} +// *********************************************************************// + _SecurityAttribute = interface(IDispatch) + ['{48815668-6C27-3312-803E-2757F55CE96A}'] + end; + +// *********************************************************************// +// DispIntf: _SecurityAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {48815668-6C27-3312-803E-2757F55CE96A} +// *********************************************************************// + _SecurityAttributeDisp = dispinterface + ['{48815668-6C27-3312-803E-2757F55CE96A}'] + end; + {$EXTERNALSYM _SecurityAttributeDisp} + +// *********************************************************************// +// Interface: _CodeAccessSecurityAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9C5149CB-D3C6-32FD-A0D5-95350DE7B813} +// *********************************************************************// + _CodeAccessSecurityAttribute = interface(IDispatch) + ['{9C5149CB-D3C6-32FD-A0D5-95350DE7B813}'] + end; + +// *********************************************************************// +// DispIntf: _CodeAccessSecurityAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9C5149CB-D3C6-32FD-A0D5-95350DE7B813} +// *********************************************************************// + _CodeAccessSecurityAttributeDisp = dispinterface + ['{9C5149CB-D3C6-32FD-A0D5-95350DE7B813}'] + end; + {$EXTERNALSYM _CodeAccessSecurityAttributeDisp} + +// *********************************************************************// +// Interface: _EnvironmentPermissionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4164071A-ED12-3BDD-AF40-FDABCAA77D5F} +// *********************************************************************// + _EnvironmentPermissionAttribute = interface(IDispatch) + ['{4164071A-ED12-3BDD-AF40-FDABCAA77D5F}'] + end; + +// *********************************************************************// +// DispIntf: _EnvironmentPermissionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4164071A-ED12-3BDD-AF40-FDABCAA77D5F} +// *********************************************************************// + _EnvironmentPermissionAttributeDisp = dispinterface + ['{4164071A-ED12-3BDD-AF40-FDABCAA77D5F}'] + end; + {$EXTERNALSYM _EnvironmentPermissionAttributeDisp} + +// *********************************************************************// +// Interface: _FileDialogPermissionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0CCCA629-440F-313E-96CD-BA1B4B4997F7} +// *********************************************************************// + _FileDialogPermissionAttribute = interface(IDispatch) + ['{0CCCA629-440F-313E-96CD-BA1B4B4997F7}'] + end; + +// *********************************************************************// +// DispIntf: _FileDialogPermissionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0CCCA629-440F-313E-96CD-BA1B4B4997F7} +// *********************************************************************// + _FileDialogPermissionAttributeDisp = dispinterface + ['{0CCCA629-440F-313E-96CD-BA1B4B4997F7}'] + end; + {$EXTERNALSYM _FileDialogPermissionAttributeDisp} + +// *********************************************************************// +// Interface: _FileIOPermissionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0DCA817D-F21A-3943-B54C-5E800CE5BC50} +// *********************************************************************// + _FileIOPermissionAttribute = interface(IDispatch) + ['{0DCA817D-F21A-3943-B54C-5E800CE5BC50}'] + end; + +// *********************************************************************// +// DispIntf: _FileIOPermissionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0DCA817D-F21A-3943-B54C-5E800CE5BC50} +// *********************************************************************// + _FileIOPermissionAttributeDisp = dispinterface + ['{0DCA817D-F21A-3943-B54C-5E800CE5BC50}'] + end; + {$EXTERNALSYM _FileIOPermissionAttributeDisp} + +// *********************************************************************// +// Interface: _PrincipalPermissionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {68AB69E4-5D68-3B51-B74D-1BEAB9F37F2B} +// *********************************************************************// + _PrincipalPermissionAttribute = interface(IDispatch) + ['{68AB69E4-5D68-3B51-B74D-1BEAB9F37F2B}'] + end; + +// *********************************************************************// +// DispIntf: _PrincipalPermissionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {68AB69E4-5D68-3B51-B74D-1BEAB9F37F2B} +// *********************************************************************// + _PrincipalPermissionAttributeDisp = dispinterface + ['{68AB69E4-5D68-3B51-B74D-1BEAB9F37F2B}'] + end; + {$EXTERNALSYM _PrincipalPermissionAttributeDisp} + +// *********************************************************************// +// Interface: _ReflectionPermissionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D31EED10-A5F0-308F-A951-E557961EC568} +// *********************************************************************// + _ReflectionPermissionAttribute = interface(IDispatch) + ['{D31EED10-A5F0-308F-A951-E557961EC568}'] + end; + +// *********************************************************************// +// DispIntf: _ReflectionPermissionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D31EED10-A5F0-308F-A951-E557961EC568} +// *********************************************************************// + _ReflectionPermissionAttributeDisp = dispinterface + ['{D31EED10-A5F0-308F-A951-E557961EC568}'] + end; + {$EXTERNALSYM _ReflectionPermissionAttributeDisp} + +// *********************************************************************// +// Interface: _RegistryPermissionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {38B6068C-1E94-3119-8841-1ECA35ED8578} +// *********************************************************************// + _RegistryPermissionAttribute = interface(IDispatch) + ['{38B6068C-1E94-3119-8841-1ECA35ED8578}'] + end; + +// *********************************************************************// +// DispIntf: _RegistryPermissionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {38B6068C-1E94-3119-8841-1ECA35ED8578} +// *********************************************************************// + _RegistryPermissionAttributeDisp = dispinterface + ['{38B6068C-1E94-3119-8841-1ECA35ED8578}'] + end; + {$EXTERNALSYM _RegistryPermissionAttributeDisp} + +// *********************************************************************// +// Interface: _SecurityPermissionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3A5B876C-CDE4-32D2-9C7E-020A14ACA332} +// *********************************************************************// + _SecurityPermissionAttribute = interface(IDispatch) + ['{3A5B876C-CDE4-32D2-9C7E-020A14ACA332}'] + end; + +// *********************************************************************// +// DispIntf: _SecurityPermissionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3A5B876C-CDE4-32D2-9C7E-020A14ACA332} +// *********************************************************************// + _SecurityPermissionAttributeDisp = dispinterface + ['{3A5B876C-CDE4-32D2-9C7E-020A14ACA332}'] + end; + {$EXTERNALSYM _SecurityPermissionAttributeDisp} + +// *********************************************************************// +// Interface: _UIPermissionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1D5C0F70-AF29-38A3-9436-3070A310C73B} +// *********************************************************************// + _UIPermissionAttribute = interface(IDispatch) + ['{1D5C0F70-AF29-38A3-9436-3070A310C73B}'] + end; + +// *********************************************************************// +// DispIntf: _UIPermissionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1D5C0F70-AF29-38A3-9436-3070A310C73B} +// *********************************************************************// + _UIPermissionAttributeDisp = dispinterface + ['{1D5C0F70-AF29-38A3-9436-3070A310C73B}'] + end; + {$EXTERNALSYM _UIPermissionAttributeDisp} + +// *********************************************************************// +// Interface: _ZoneIdentityPermissionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {2E3BE3ED-2F22-3B20-9F92-BD29B79D6F42} +// *********************************************************************// + _ZoneIdentityPermissionAttribute = interface(IDispatch) + ['{2E3BE3ED-2F22-3B20-9F92-BD29B79D6F42}'] + end; + +// *********************************************************************// +// DispIntf: _ZoneIdentityPermissionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {2E3BE3ED-2F22-3B20-9F92-BD29B79D6F42} +// *********************************************************************// + _ZoneIdentityPermissionAttributeDisp = dispinterface + ['{2E3BE3ED-2F22-3B20-9F92-BD29B79D6F42}'] + end; + {$EXTERNALSYM _ZoneIdentityPermissionAttributeDisp} + +// *********************************************************************// +// Interface: _StrongNameIdentityPermissionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C9A740F4-26E9-39A8-8885-8CA26BD79B21} +// *********************************************************************// + _StrongNameIdentityPermissionAttribute = interface(IDispatch) + ['{C9A740F4-26E9-39A8-8885-8CA26BD79B21}'] + end; + +// *********************************************************************// +// DispIntf: _StrongNameIdentityPermissionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C9A740F4-26E9-39A8-8885-8CA26BD79B21} +// *********************************************************************// + _StrongNameIdentityPermissionAttributeDisp = dispinterface + ['{C9A740F4-26E9-39A8-8885-8CA26BD79B21}'] + end; + {$EXTERNALSYM _StrongNameIdentityPermissionAttributeDisp} + +// *********************************************************************// +// Interface: _SiteIdentityPermissionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6FE6894A-2A53-3FB6-A06E-348F9BDAD23B} +// *********************************************************************// + _SiteIdentityPermissionAttribute = interface(IDispatch) + ['{6FE6894A-2A53-3FB6-A06E-348F9BDAD23B}'] + end; + +// *********************************************************************// +// DispIntf: _SiteIdentityPermissionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6FE6894A-2A53-3FB6-A06E-348F9BDAD23B} +// *********************************************************************// + _SiteIdentityPermissionAttributeDisp = dispinterface + ['{6FE6894A-2A53-3FB6-A06E-348F9BDAD23B}'] + end; + {$EXTERNALSYM _SiteIdentityPermissionAttributeDisp} + +// *********************************************************************// +// Interface: _UrlIdentityPermissionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {CA4A2073-48C5-3E61-8349-11701A90DD9B} +// *********************************************************************// + _UrlIdentityPermissionAttribute = interface(IDispatch) + ['{CA4A2073-48C5-3E61-8349-11701A90DD9B}'] + end; + +// *********************************************************************// +// DispIntf: _UrlIdentityPermissionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {CA4A2073-48C5-3E61-8349-11701A90DD9B} +// *********************************************************************// + _UrlIdentityPermissionAttributeDisp = dispinterface + ['{CA4A2073-48C5-3E61-8349-11701A90DD9B}'] + end; + {$EXTERNALSYM _UrlIdentityPermissionAttributeDisp} + +// *********************************************************************// +// Interface: _PublisherIdentityPermissionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6722C730-1239-3784-AC94-C285AE5B901A} +// *********************************************************************// + _PublisherIdentityPermissionAttribute = interface(IDispatch) + ['{6722C730-1239-3784-AC94-C285AE5B901A}'] + end; + +// *********************************************************************// +// DispIntf: _PublisherIdentityPermissionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6722C730-1239-3784-AC94-C285AE5B901A} +// *********************************************************************// + _PublisherIdentityPermissionAttributeDisp = dispinterface + ['{6722C730-1239-3784-AC94-C285AE5B901A}'] + end; + {$EXTERNALSYM _PublisherIdentityPermissionAttributeDisp} + +// *********************************************************************// +// Interface: _IsolatedStoragePermissionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {5C4C522F-DE4E-3595-9AA9-9319C86A5283} +// *********************************************************************// + _IsolatedStoragePermissionAttribute = interface(IDispatch) + ['{5C4C522F-DE4E-3595-9AA9-9319C86A5283}'] + end; + +// *********************************************************************// +// DispIntf: _IsolatedStoragePermissionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {5C4C522F-DE4E-3595-9AA9-9319C86A5283} +// *********************************************************************// + _IsolatedStoragePermissionAttributeDisp = dispinterface + ['{5C4C522F-DE4E-3595-9AA9-9319C86A5283}'] + end; + {$EXTERNALSYM _IsolatedStoragePermissionAttributeDisp} + +// *********************************************************************// +// Interface: _IsolatedStorageFilePermissionAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6F1F8AAE-D667-39CC-98FA-722BEBBBEAC3} +// *********************************************************************// + _IsolatedStorageFilePermissionAttribute = interface(IDispatch) + ['{6F1F8AAE-D667-39CC-98FA-722BEBBBEAC3}'] + end; + +// *********************************************************************// +// DispIntf: _IsolatedStorageFilePermissionAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6F1F8AAE-D667-39CC-98FA-722BEBBBEAC3} +// *********************************************************************// + _IsolatedStorageFilePermissionAttributeDisp = dispinterface + ['{6F1F8AAE-D667-39CC-98FA-722BEBBBEAC3}'] + end; + {$EXTERNALSYM _IsolatedStorageFilePermissionAttributeDisp} + +// *********************************************************************// +// Interface: _PermissionSetAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {947A1995-BC16-3E7C-B65A-99E71F39C091} +// *********************************************************************// + _PermissionSetAttribute = interface(IDispatch) + ['{947A1995-BC16-3E7C-B65A-99E71F39C091}'] + end; + +// *********************************************************************// +// DispIntf: _PermissionSetAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {947A1995-BC16-3E7C-B65A-99E71F39C091} +// *********************************************************************// + _PermissionSetAttributeDisp = dispinterface + ['{947A1995-BC16-3E7C-B65A-99E71F39C091}'] + end; + {$EXTERNALSYM _PermissionSetAttributeDisp} + +// *********************************************************************// +// Interface: _PublisherIdentityPermission +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E86CC74A-1233-3DF3-B13F-8B27EEAAC1F6} +// *********************************************************************// + _PublisherIdentityPermission = interface(IDispatch) + ['{E86CC74A-1233-3DF3-B13F-8B27EEAAC1F6}'] + end; + +// *********************************************************************// +// DispIntf: _PublisherIdentityPermissionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E86CC74A-1233-3DF3-B13F-8B27EEAAC1F6} +// *********************************************************************// + _PublisherIdentityPermissionDisp = dispinterface + ['{E86CC74A-1233-3DF3-B13F-8B27EEAAC1F6}'] + end; + {$EXTERNALSYM _PublisherIdentityPermissionDisp} + +// *********************************************************************// +// Interface: _ReflectionPermission +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AEB3727F-5C3A-34C4-BF18-A38F088AC8C7} +// *********************************************************************// + _ReflectionPermission = interface(IDispatch) + ['{AEB3727F-5C3A-34C4-BF18-A38F088AC8C7}'] + end; + +// *********************************************************************// +// DispIntf: _ReflectionPermissionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AEB3727F-5C3A-34C4-BF18-A38F088AC8C7} +// *********************************************************************// + _ReflectionPermissionDisp = dispinterface + ['{AEB3727F-5C3A-34C4-BF18-A38F088AC8C7}'] + end; + {$EXTERNALSYM _ReflectionPermissionDisp} + +// *********************************************************************// +// Interface: _RegistryPermission +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C3FB5510-3454-3B31-B64F-DE6AAD6BE820} +// *********************************************************************// + _RegistryPermission = interface(IDispatch) + ['{C3FB5510-3454-3B31-B64F-DE6AAD6BE820}'] + end; + +// *********************************************************************// +// DispIntf: _RegistryPermissionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C3FB5510-3454-3B31-B64F-DE6AAD6BE820} +// *********************************************************************// + _RegistryPermissionDisp = dispinterface + ['{C3FB5510-3454-3B31-B64F-DE6AAD6BE820}'] + end; + {$EXTERNALSYM _RegistryPermissionDisp} + +// *********************************************************************// +// Interface: _PrincipalPermission +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7C6B06D1-63AD-35EF-A938-149B4AD9A71F} +// *********************************************************************// + _PrincipalPermission = interface(IDispatch) + ['{7C6B06D1-63AD-35EF-A938-149B4AD9A71F}'] + end; + +// *********************************************************************// +// DispIntf: _PrincipalPermissionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7C6B06D1-63AD-35EF-A938-149B4AD9A71F} +// *********************************************************************// + _PrincipalPermissionDisp = dispinterface + ['{7C6B06D1-63AD-35EF-A938-149B4AD9A71F}'] + end; + {$EXTERNALSYM _PrincipalPermissionDisp} + +// *********************************************************************// +// Interface: _SecurityPermission +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {33C54A2D-02BD-3848-80B6-742D537085E5} +// *********************************************************************// + _SecurityPermission = interface(IDispatch) + ['{33C54A2D-02BD-3848-80B6-742D537085E5}'] + end; + +// *********************************************************************// +// DispIntf: _SecurityPermissionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {33C54A2D-02BD-3848-80B6-742D537085E5} +// *********************************************************************// + _SecurityPermissionDisp = dispinterface + ['{33C54A2D-02BD-3848-80B6-742D537085E5}'] + end; + {$EXTERNALSYM _SecurityPermissionDisp} + +// *********************************************************************// +// Interface: _SiteIdentityPermission +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {790B3EE9-7E06-3CD0-8243-5848486D6A78} +// *********************************************************************// + _SiteIdentityPermission = interface(IDispatch) + ['{790B3EE9-7E06-3CD0-8243-5848486D6A78}'] + end; + +// *********************************************************************// +// DispIntf: _SiteIdentityPermissionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {790B3EE9-7E06-3CD0-8243-5848486D6A78} +// *********************************************************************// + _SiteIdentityPermissionDisp = dispinterface + ['{790B3EE9-7E06-3CD0-8243-5848486D6A78}'] + end; + {$EXTERNALSYM _SiteIdentityPermissionDisp} + +// *********************************************************************// +// Interface: _StrongNameIdentityPermission +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {5F1562FB-0160-3655-BAEA-B15BEF609161} +// *********************************************************************// + _StrongNameIdentityPermission = interface(IDispatch) + ['{5F1562FB-0160-3655-BAEA-B15BEF609161}'] + end; + +// *********************************************************************// +// DispIntf: _StrongNameIdentityPermissionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {5F1562FB-0160-3655-BAEA-B15BEF609161} +// *********************************************************************// + _StrongNameIdentityPermissionDisp = dispinterface + ['{5F1562FB-0160-3655-BAEA-B15BEF609161}'] + end; + {$EXTERNALSYM _StrongNameIdentityPermissionDisp} + +// *********************************************************************// +// Interface: _StrongNamePublicKeyBlob +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AF53D21A-D6AF-3406-B399-7DF9D2AAD48A} +// *********************************************************************// + _StrongNamePublicKeyBlob = interface(IDispatch) + ['{AF53D21A-D6AF-3406-B399-7DF9D2AAD48A}'] + end; + +// *********************************************************************// +// DispIntf: _StrongNamePublicKeyBlobDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AF53D21A-D6AF-3406-B399-7DF9D2AAD48A} +// *********************************************************************// + _StrongNamePublicKeyBlobDisp = dispinterface + ['{AF53D21A-D6AF-3406-B399-7DF9D2AAD48A}'] + end; + {$EXTERNALSYM _StrongNamePublicKeyBlobDisp} + +// *********************************************************************// +// Interface: _UIPermission +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {47698389-F182-3A67-87DF-AED490E14DC6} +// *********************************************************************// + _UIPermission = interface(IDispatch) + ['{47698389-F182-3A67-87DF-AED490E14DC6}'] + end; + +// *********************************************************************// +// DispIntf: _UIPermissionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {47698389-F182-3A67-87DF-AED490E14DC6} +// *********************************************************************// + _UIPermissionDisp = dispinterface + ['{47698389-F182-3A67-87DF-AED490E14DC6}'] + end; + {$EXTERNALSYM _UIPermissionDisp} + +// *********************************************************************// +// Interface: _UrlIdentityPermission +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {EC7CAC31-08A2-393B-BDF2-D052EB53AF2C} +// *********************************************************************// + _UrlIdentityPermission = interface(IDispatch) + ['{EC7CAC31-08A2-393B-BDF2-D052EB53AF2C}'] + end; + +// *********************************************************************// +// DispIntf: _UrlIdentityPermissionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {EC7CAC31-08A2-393B-BDF2-D052EB53AF2C} +// *********************************************************************// + _UrlIdentityPermissionDisp = dispinterface + ['{EC7CAC31-08A2-393B-BDF2-D052EB53AF2C}'] + end; + {$EXTERNALSYM _UrlIdentityPermissionDisp} + +// *********************************************************************// +// Interface: _ZoneIdentityPermission +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {38B2F8D7-8CF4-323B-9C17-9C55EE287A63} +// *********************************************************************// + _ZoneIdentityPermission = interface(IDispatch) + ['{38B2F8D7-8CF4-323B-9C17-9C55EE287A63}'] + end; + +// *********************************************************************// +// DispIntf: _ZoneIdentityPermissionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {38B2F8D7-8CF4-323B-9C17-9C55EE287A63} +// *********************************************************************// + _ZoneIdentityPermissionDisp = dispinterface + ['{38B2F8D7-8CF4-323B-9C17-9C55EE287A63}'] + end; + {$EXTERNALSYM _ZoneIdentityPermissionDisp} + +// *********************************************************************// +// Interface: _SuppressUnmanagedCodeSecurityAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8000E51A-541C-3B20-A8EC-C8A8B41116C4} +// *********************************************************************// + _SuppressUnmanagedCodeSecurityAttribute = interface(IDispatch) + ['{8000E51A-541C-3B20-A8EC-C8A8B41116C4}'] + end; + +// *********************************************************************// +// DispIntf: _SuppressUnmanagedCodeSecurityAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8000E51A-541C-3B20-A8EC-C8A8B41116C4} +// *********************************************************************// + _SuppressUnmanagedCodeSecurityAttributeDisp = dispinterface + ['{8000E51A-541C-3B20-A8EC-C8A8B41116C4}'] + end; + {$EXTERNALSYM _SuppressUnmanagedCodeSecurityAttributeDisp} + +// *********************************************************************// +// Interface: _UnverifiableCodeAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {41F41C1B-7B8D-39A3-A28F-AAE20787F469} +// *********************************************************************// + _UnverifiableCodeAttribute = interface(IDispatch) + ['{41F41C1B-7B8D-39A3-A28F-AAE20787F469}'] + end; + +// *********************************************************************// +// DispIntf: _UnverifiableCodeAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {41F41C1B-7B8D-39A3-A28F-AAE20787F469} +// *********************************************************************// + _UnverifiableCodeAttributeDisp = dispinterface + ['{41F41C1B-7B8D-39A3-A28F-AAE20787F469}'] + end; + {$EXTERNALSYM _UnverifiableCodeAttributeDisp} + +// *********************************************************************// +// Interface: _AllowPartiallyTrustedCallersAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F1C930C4-2233-3924-9840-231D008259B4} +// *********************************************************************// + _AllowPartiallyTrustedCallersAttribute = interface(IDispatch) + ['{F1C930C4-2233-3924-9840-231D008259B4}'] + end; + +// *********************************************************************// +// DispIntf: _AllowPartiallyTrustedCallersAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F1C930C4-2233-3924-9840-231D008259B4} +// *********************************************************************// + _AllowPartiallyTrustedCallersAttributeDisp = dispinterface + ['{F1C930C4-2233-3924-9840-231D008259B4}'] + end; + {$EXTERNALSYM _AllowPartiallyTrustedCallersAttributeDisp} + +// *********************************************************************// +// Interface: _SecurityException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F174290F-E4CF-3976-88AA-4F8E32EB03DB} +// *********************************************************************// + _SecurityException = interface(IDispatch) + ['{F174290F-E4CF-3976-88AA-4F8E32EB03DB}'] + end; + +// *********************************************************************// +// DispIntf: _SecurityExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F174290F-E4CF-3976-88AA-4F8E32EB03DB} +// *********************************************************************// + _SecurityExceptionDisp = dispinterface + ['{F174290F-E4CF-3976-88AA-4F8E32EB03DB}'] + end; + {$EXTERNALSYM _SecurityExceptionDisp} + +// *********************************************************************// +// Interface: _SecurityManager +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {ABC04B16-5539-3C7E-92EC-0905A4A24464} +// *********************************************************************// + _SecurityManager = interface(IDispatch) + ['{ABC04B16-5539-3C7E-92EC-0905A4A24464}'] + end; + +// *********************************************************************// +// DispIntf: _SecurityManagerDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {ABC04B16-5539-3C7E-92EC-0905A4A24464} +// *********************************************************************// + _SecurityManagerDisp = dispinterface + ['{ABC04B16-5539-3C7E-92EC-0905A4A24464}'] + end; + {$EXTERNALSYM _SecurityManagerDisp} + +// *********************************************************************// +// Interface: _VerificationException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F65070DF-57AF-3AE3-B951-D2AD7D513347} +// *********************************************************************// + _VerificationException = interface(IDispatch) + ['{F65070DF-57AF-3AE3-B951-D2AD7D513347}'] + end; + +// *********************************************************************// +// DispIntf: _VerificationExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F65070DF-57AF-3AE3-B951-D2AD7D513347} +// *********************************************************************// + _VerificationExceptionDisp = dispinterface + ['{F65070DF-57AF-3AE3-B951-D2AD7D513347}'] + end; + {$EXTERNALSYM _VerificationExceptionDisp} + +// *********************************************************************// +// Interface: IContextAttribute +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {4A68BAA3-27AA-314A-BDBB-6AE9BDFC0420} +// *********************************************************************// + IContextAttribute = interface(IDispatch) + ['{4A68BAA3-27AA-314A-BDBB-6AE9BDFC0420}'] + function IsContextOK(const ctx: _Context; const msg: IConstructionCallMessage): WordBool; safecall; + procedure GetPropertiesForNewContext(const msg: IConstructionCallMessage); safecall; + end; + +// *********************************************************************// +// DispIntf: IContextAttributeDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {4A68BAA3-27AA-314A-BDBB-6AE9BDFC0420} +// *********************************************************************// + IContextAttributeDisp = dispinterface + ['{4A68BAA3-27AA-314A-BDBB-6AE9BDFC0420}'] + function IsContextOK(const ctx: _Context; const msg: IConstructionCallMessage): WordBool; dispid 1610743808; + procedure GetPropertiesForNewContext(const msg: IConstructionCallMessage); dispid 1610743809; + end; + {$EXTERNALSYM IContextAttributeDisp} + +// *********************************************************************// +// Interface: IContextProperty +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {F01D896D-8D5F-3235-BE59-20E1E10DC22A} +// *********************************************************************// + IContextProperty = interface(IDispatch) + ['{F01D896D-8D5F-3235-BE59-20E1E10DC22A}'] + function Get_name: WideString; safecall; + function IsNewContextOK(const newCtx: _Context): WordBool; safecall; + procedure Freeze(const newContext: _Context); safecall; + property name: WideString read Get_name; + end; + +// *********************************************************************// +// DispIntf: IContextPropertyDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {F01D896D-8D5F-3235-BE59-20E1E10DC22A} +// *********************************************************************// + IContextPropertyDisp = dispinterface + ['{F01D896D-8D5F-3235-BE59-20E1E10DC22A}'] + property name: WideString readonly dispid 1610743808; + function IsNewContextOK(const newCtx: _Context): WordBool; dispid 1610743809; + procedure Freeze(const newContext: _Context); dispid 1610743810; + end; + {$EXTERNALSYM IContextPropertyDisp} + +// *********************************************************************// +// Interface: _ContextAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F042505B-7AAC-313B-A8C7-3F1AC949C311} +// *********************************************************************// + _ContextAttribute = interface(IDispatch) + ['{F042505B-7AAC-313B-A8C7-3F1AC949C311}'] + end; + +// *********************************************************************// +// DispIntf: _ContextAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F042505B-7AAC-313B-A8C7-3F1AC949C311} +// *********************************************************************// + _ContextAttributeDisp = dispinterface + ['{F042505B-7AAC-313B-A8C7-3F1AC949C311}'] + end; + {$EXTERNALSYM _ContextAttributeDisp} + +// *********************************************************************// +// Interface: IActivator +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {C02BBB79-5AA8-390D-927F-717B7BFF06A1} +// *********************************************************************// + IActivator = interface(IDispatch) + ['{C02BBB79-5AA8-390D-927F-717B7BFF06A1}'] + function Get_NextActivator: IActivator; safecall; + procedure _Set_NextActivator(const pRetVal: IActivator); safecall; + function Activate(const msg: IConstructionCallMessage): IConstructionReturnMessage; safecall; + function Get_level: ActivatorLevel; safecall; + property NextActivator: IActivator read Get_NextActivator; + property level: ActivatorLevel read Get_level; + end; + +// *********************************************************************// +// DispIntf: IActivatorDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {C02BBB79-5AA8-390D-927F-717B7BFF06A1} +// *********************************************************************// + IActivatorDisp = dispinterface + ['{C02BBB79-5AA8-390D-927F-717B7BFF06A1}'] + property NextActivator: IActivator readonly dispid 1610743808; + function Activate(const msg: IConstructionCallMessage): IConstructionReturnMessage; dispid 1610743810; + property level: ActivatorLevel readonly dispid 1610743811; + end; + {$EXTERNALSYM IActivatorDisp} + +// *********************************************************************// +// Interface: IMessageSink +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {941F8AAA-A353-3B1D-A019-12E44377F1CD} +// *********************************************************************// + IMessageSink = interface(IDispatch) + ['{941F8AAA-A353-3B1D-A019-12E44377F1CD}'] + function SyncProcessMessage(const msg: IMessage): IMessage; safecall; + function AsyncProcessMessage(const msg: IMessage; const replySink: IMessageSink): IMessageCtrl; safecall; + function Get_NextSink: IMessageSink; safecall; + property NextSink: IMessageSink read Get_NextSink; + end; + +// *********************************************************************// +// DispIntf: IMessageSinkDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {941F8AAA-A353-3B1D-A019-12E44377F1CD} +// *********************************************************************// + IMessageSinkDisp = dispinterface + ['{941F8AAA-A353-3B1D-A019-12E44377F1CD}'] + function SyncProcessMessage(const msg: IMessage): IMessage; dispid 1610743808; + function AsyncProcessMessage(const msg: IMessage; const replySink: IMessageSink): IMessageCtrl; dispid 1610743809; + property NextSink: IMessageSink readonly dispid 1610743810; + end; + {$EXTERNALSYM IMessageSinkDisp} + +// *********************************************************************// +// Interface: _AsyncResult +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3936ABE1-B29E-3593-83F1-793D1A7F3898} +// *********************************************************************// + _AsyncResult = interface(IDispatch) + ['{3936ABE1-B29E-3593-83F1-793D1A7F3898}'] + end; + +// *********************************************************************// +// DispIntf: _AsyncResultDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3936ABE1-B29E-3593-83F1-793D1A7F3898} +// *********************************************************************// + _AsyncResultDisp = dispinterface + ['{3936ABE1-B29E-3593-83F1-793D1A7F3898}'] + end; + {$EXTERNALSYM _AsyncResultDisp} + +// *********************************************************************// +// Interface: _CallContext +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {53BCE4D4-6209-396D-BD4A-0B0A0A177DF9} +// *********************************************************************// + _CallContext = interface(IDispatch) + ['{53BCE4D4-6209-396D-BD4A-0B0A0A177DF9}'] + end; + +// *********************************************************************// +// DispIntf: _CallContextDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {53BCE4D4-6209-396D-BD4A-0B0A0A177DF9} +// *********************************************************************// + _CallContextDisp = dispinterface + ['{53BCE4D4-6209-396D-BD4A-0B0A0A177DF9}'] + end; + {$EXTERNALSYM _CallContextDisp} + +// *********************************************************************// +// Interface: ILogicalThreadAffinative +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {4D125449-BA27-3927-8589-3E1B34B622E5} +// *********************************************************************// + ILogicalThreadAffinative = interface(IDispatch) + ['{4D125449-BA27-3927-8589-3E1B34B622E5}'] + end; + +// *********************************************************************// +// DispIntf: ILogicalThreadAffinativeDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {4D125449-BA27-3927-8589-3E1B34B622E5} +// *********************************************************************// + ILogicalThreadAffinativeDisp = dispinterface + ['{4D125449-BA27-3927-8589-3E1B34B622E5}'] + end; + {$EXTERNALSYM ILogicalThreadAffinativeDisp} + +// *********************************************************************// +// Interface: _LogicalCallContext +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9AFF21F5-1C9C-35E7-AEA4-C3AA0BEB3B77} +// *********************************************************************// + _LogicalCallContext = interface(IDispatch) + ['{9AFF21F5-1C9C-35E7-AEA4-C3AA0BEB3B77}'] + end; + +// *********************************************************************// +// DispIntf: _LogicalCallContextDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9AFF21F5-1C9C-35E7-AEA4-C3AA0BEB3B77} +// *********************************************************************// + _LogicalCallContextDisp = dispinterface + ['{9AFF21F5-1C9C-35E7-AEA4-C3AA0BEB3B77}'] + end; + {$EXTERNALSYM _LogicalCallContextDisp} + +// *********************************************************************// +// Interface: _ChannelServices +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FFB2E16E-E5C7-367C-B326-965ABF510F24} +// *********************************************************************// + _ChannelServices = interface(IDispatch) + ['{FFB2E16E-E5C7-367C-B326-965ABF510F24}'] + end; + +// *********************************************************************// +// DispIntf: _ChannelServicesDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FFB2E16E-E5C7-367C-B326-965ABF510F24} +// *********************************************************************// + _ChannelServicesDisp = dispinterface + ['{FFB2E16E-E5C7-367C-B326-965ABF510F24}'] + end; + {$EXTERNALSYM _ChannelServicesDisp} + +// *********************************************************************// +// Interface: IClientResponseChannelSinkStack +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {3AFAB213-F5A2-3241-93BA-329EA4BA8016} +// *********************************************************************// + IClientResponseChannelSinkStack = interface(IDispatch) + ['{3AFAB213-F5A2-3241-93BA-329EA4BA8016}'] + procedure AsyncProcessResponse(const headers: ITransportHeaders; const Stream: _Stream); safecall; + procedure DispatchReplyMessage(const msg: IMessage); safecall; + procedure DispatchException(const e: _Exception); safecall; + end; + +// *********************************************************************// +// DispIntf: IClientResponseChannelSinkStackDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {3AFAB213-F5A2-3241-93BA-329EA4BA8016} +// *********************************************************************// + IClientResponseChannelSinkStackDisp = dispinterface + ['{3AFAB213-F5A2-3241-93BA-329EA4BA8016}'] + procedure AsyncProcessResponse(const headers: ITransportHeaders; const Stream: _Stream); dispid 1610743808; + procedure DispatchReplyMessage(const msg: IMessage); dispid 1610743809; + procedure DispatchException(const e: _Exception); dispid 1610743810; + end; + {$EXTERNALSYM IClientResponseChannelSinkStackDisp} + +// *********************************************************************// +// Interface: IClientChannelSinkStack +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {3A5FDE6B-DB46-34E8-BACD-16EA5A440540} +// *********************************************************************// + IClientChannelSinkStack = interface(IDispatch) + ['{3A5FDE6B-DB46-34E8-BACD-16EA5A440540}'] + procedure Push(const sink: IClientChannelSink; state: OleVariant); safecall; + function Pop(const sink: IClientChannelSink): OleVariant; safecall; + end; + +// *********************************************************************// +// DispIntf: IClientChannelSinkStackDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {3A5FDE6B-DB46-34E8-BACD-16EA5A440540} +// *********************************************************************// + IClientChannelSinkStackDisp = dispinterface + ['{3A5FDE6B-DB46-34E8-BACD-16EA5A440540}'] + procedure Push(const sink: IClientChannelSink; state: OleVariant); dispid 1610743808; + function Pop(const sink: IClientChannelSink): OleVariant; dispid 1610743809; + end; + {$EXTERNALSYM IClientChannelSinkStackDisp} + +// *********************************************************************// +// Interface: _ClientChannelSinkStack +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E1796120-C324-30D8-86F4-20086711463B} +// *********************************************************************// + _ClientChannelSinkStack = interface(IDispatch) + ['{E1796120-C324-30D8-86F4-20086711463B}'] + end; + +// *********************************************************************// +// DispIntf: _ClientChannelSinkStackDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E1796120-C324-30D8-86F4-20086711463B} +// *********************************************************************// + _ClientChannelSinkStackDisp = dispinterface + ['{E1796120-C324-30D8-86F4-20086711463B}'] + end; + {$EXTERNALSYM _ClientChannelSinkStackDisp} + +// *********************************************************************// +// Interface: IServerResponseChannelSinkStack +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {9BE679A6-61FD-38FC-A7B2-89982D33338B} +// *********************************************************************// + IServerResponseChannelSinkStack = interface(IDispatch) + ['{9BE679A6-61FD-38FC-A7B2-89982D33338B}'] + procedure AsyncProcessResponse(const msg: IMessage; const headers: ITransportHeaders; + const Stream: _Stream); safecall; + function GetResponseStream(const msg: IMessage; const headers: ITransportHeaders): _Stream; safecall; + end; + +// *********************************************************************// +// DispIntf: IServerResponseChannelSinkStackDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {9BE679A6-61FD-38FC-A7B2-89982D33338B} +// *********************************************************************// + IServerResponseChannelSinkStackDisp = dispinterface + ['{9BE679A6-61FD-38FC-A7B2-89982D33338B}'] + procedure AsyncProcessResponse(const msg: IMessage; const headers: ITransportHeaders; + const Stream: _Stream); dispid 1610743808; + function GetResponseStream(const msg: IMessage; const headers: ITransportHeaders): _Stream; dispid 1610743809; + end; + {$EXTERNALSYM IServerResponseChannelSinkStackDisp} + +// *********************************************************************// +// Interface: IServerChannelSinkStack +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {E694A733-768D-314D-B317-DCEAD136B11D} +// *********************************************************************// + IServerChannelSinkStack = interface(IDispatch) + ['{E694A733-768D-314D-B317-DCEAD136B11D}'] + procedure Push(const sink: IServerChannelSink; state: OleVariant); safecall; + function Pop(const sink: IServerChannelSink): OleVariant; safecall; + procedure Store(const sink: IServerChannelSink; state: OleVariant); safecall; + procedure StoreAndDispatch(const sink: IServerChannelSink; state: OleVariant); safecall; + procedure ServerCallback(const ar: IAsyncResult); safecall; + end; + +// *********************************************************************// +// DispIntf: IServerChannelSinkStackDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {E694A733-768D-314D-B317-DCEAD136B11D} +// *********************************************************************// + IServerChannelSinkStackDisp = dispinterface + ['{E694A733-768D-314D-B317-DCEAD136B11D}'] + procedure Push(const sink: IServerChannelSink; state: OleVariant); dispid 1610743808; + function Pop(const sink: IServerChannelSink): OleVariant; dispid 1610743809; + procedure Store(const sink: IServerChannelSink; state: OleVariant); dispid 1610743810; + procedure StoreAndDispatch(const sink: IServerChannelSink; state: OleVariant); dispid 1610743811; + procedure ServerCallback(const ar: IAsyncResult); dispid 1610743812; + end; + {$EXTERNALSYM IServerChannelSinkStackDisp} + +// *********************************************************************// +// Interface: _ServerChannelSinkStack +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {52DA9F90-89B3-35AB-907B-3562642967DE} +// *********************************************************************// + _ServerChannelSinkStack = interface(IDispatch) + ['{52DA9F90-89B3-35AB-907B-3562642967DE}'] + end; + +// *********************************************************************// +// DispIntf: _ServerChannelSinkStackDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {52DA9F90-89B3-35AB-907B-3562642967DE} +// *********************************************************************// + _ServerChannelSinkStackDisp = dispinterface + ['{52DA9F90-89B3-35AB-907B-3562642967DE}'] + end; + {$EXTERNALSYM _ServerChannelSinkStackDisp} + +// *********************************************************************// +// Interface: _InternalMessageWrapper +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {EF926E1F-3EE7-32BC-8B01-C6E98C24BC19} +// *********************************************************************// + _InternalMessageWrapper = interface(IDispatch) + ['{EF926E1F-3EE7-32BC-8B01-C6E98C24BC19}'] + end; + +// *********************************************************************// +// DispIntf: _InternalMessageWrapperDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {EF926E1F-3EE7-32BC-8B01-C6E98C24BC19} +// *********************************************************************// + _InternalMessageWrapperDisp = dispinterface + ['{EF926E1F-3EE7-32BC-8B01-C6E98C24BC19}'] + end; + {$EXTERNALSYM _InternalMessageWrapperDisp} + +// *********************************************************************// +// Interface: IMessage +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {1A8B0DE6-B825-38C5-B744-8F93075FD6FA} +// *********************************************************************// + IMessage = interface(IDispatch) + ['{1A8B0DE6-B825-38C5-B744-8F93075FD6FA}'] + function Get_Properties: IDictionary; safecall; + property Properties: IDictionary read Get_Properties; + end; + +// *********************************************************************// +// DispIntf: IMessageDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {1A8B0DE6-B825-38C5-B744-8F93075FD6FA} +// *********************************************************************// + IMessageDisp = dispinterface + ['{1A8B0DE6-B825-38C5-B744-8F93075FD6FA}'] + property Properties: IDictionary readonly dispid 1610743808; + end; + {$EXTERNALSYM IMessageDisp} + +// *********************************************************************// +// Interface: IMethodMessage +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {8E5E0B95-750E-310D-892C-8CA7231CF75B} +// *********************************************************************// + IMethodMessage = interface(IDispatch) + ['{8E5E0B95-750E-310D-892C-8CA7231CF75B}'] + function Get_Uri: WideString; safecall; + function Get_MethodName: WideString; safecall; + function Get_typeName: WideString; safecall; + function Get_MethodSignature: OleVariant; safecall; + function Get_ArgCount: Integer; safecall; + function GetArgName(index: Integer): WideString; safecall; + function GetArg(argNum: Integer): OleVariant; safecall; + function Get_args: PSafeArray; safecall; + function Get_HasVarArgs: WordBool; safecall; + function Get_LogicalCallContext: _LogicalCallContext; safecall; + function Get_MethodBase: _MethodBase; safecall; + property Uri: WideString read Get_Uri; + property MethodName: WideString read Get_MethodName; + property typeName: WideString read Get_typeName; + property MethodSignature: OleVariant read Get_MethodSignature; + property ArgCount: Integer read Get_ArgCount; + property args: PSafeArray read Get_args; + property HasVarArgs: WordBool read Get_HasVarArgs; + property LogicalCallContext: _LogicalCallContext read Get_LogicalCallContext; + property MethodBase: _MethodBase read Get_MethodBase; + end; + +// *********************************************************************// +// DispIntf: IMethodMessageDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {8E5E0B95-750E-310D-892C-8CA7231CF75B} +// *********************************************************************// + IMethodMessageDisp = dispinterface + ['{8E5E0B95-750E-310D-892C-8CA7231CF75B}'] + property Uri: WideString readonly dispid 1610743808; + property MethodName: WideString readonly dispid 1610743809; + property typeName: WideString readonly dispid 1610743810; + property MethodSignature: OleVariant readonly dispid 1610743811; + property ArgCount: Integer readonly dispid 1610743812; + function GetArgName(index: Integer): WideString; dispid 1610743813; + function GetArg(argNum: Integer): OleVariant; dispid 1610743814; + property args: {??PSafeArray}OleVariant readonly dispid 1610743815; + property HasVarArgs: WordBool readonly dispid 1610743816; + property LogicalCallContext: _LogicalCallContext readonly dispid 1610743817; + property MethodBase: _MethodBase readonly dispid 1610743818; + end; + {$EXTERNALSYM IMethodMessageDisp} + +// *********************************************************************// +// Interface: IMethodCallMessage +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {B90EFAA6-25E4-33D2-ACA3-94BF74DC4AB9} +// *********************************************************************// + IMethodCallMessage = interface(IDispatch) + ['{B90EFAA6-25E4-33D2-ACA3-94BF74DC4AB9}'] + function Get_InArgCount: Integer; safecall; + function GetInArgName(index: Integer): WideString; safecall; + function GetInArg(argNum: Integer): OleVariant; safecall; + function Get_InArgs: PSafeArray; safecall; + property InArgCount: Integer read Get_InArgCount; + property InArgs: PSafeArray read Get_InArgs; + end; + +// *********************************************************************// +// DispIntf: IMethodCallMessageDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {B90EFAA6-25E4-33D2-ACA3-94BF74DC4AB9} +// *********************************************************************// + IMethodCallMessageDisp = dispinterface + ['{B90EFAA6-25E4-33D2-ACA3-94BF74DC4AB9}'] + property InArgCount: Integer readonly dispid 1610743808; + function GetInArgName(index: Integer): WideString; dispid 1610743809; + function GetInArg(argNum: Integer): OleVariant; dispid 1610743810; + property InArgs: {??PSafeArray}OleVariant readonly dispid 1610743811; + end; + {$EXTERNALSYM IMethodCallMessageDisp} + +// *********************************************************************// +// Interface: _MethodCallMessageWrapper +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C9614D78-10EA-3310-87EA-821B70632898} +// *********************************************************************// + _MethodCallMessageWrapper = interface(IDispatch) + ['{C9614D78-10EA-3310-87EA-821B70632898}'] + end; + +// *********************************************************************// +// DispIntf: _MethodCallMessageWrapperDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C9614D78-10EA-3310-87EA-821B70632898} +// *********************************************************************// + _MethodCallMessageWrapperDisp = dispinterface + ['{C9614D78-10EA-3310-87EA-821B70632898}'] + end; + {$EXTERNALSYM _MethodCallMessageWrapperDisp} + +// *********************************************************************// +// Interface: ISponsor +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {675591AF-0508-3131-A7CC-287D265CA7D6} +// *********************************************************************// + ISponsor = interface(IDispatch) + ['{675591AF-0508-3131-A7CC-287D265CA7D6}'] + function Renewal(const lease: ILease): TimeSpan; safecall; + end; + +// *********************************************************************// +// DispIntf: ISponsorDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {675591AF-0508-3131-A7CC-287D265CA7D6} +// *********************************************************************// + ISponsorDisp = dispinterface + ['{675591AF-0508-3131-A7CC-287D265CA7D6}'] + function Renewal(const lease: ILease): {??TimeSpan}OleVariant; dispid 1610743808; + end; + {$EXTERNALSYM ISponsorDisp} + +// *********************************************************************// +// Interface: _ClientSponsor +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FF19D114-3BDA-30AC-8E89-36CA64A87120} +// *********************************************************************// + _ClientSponsor = interface(IDispatch) + ['{FF19D114-3BDA-30AC-8E89-36CA64A87120}'] + end; + +// *********************************************************************// +// DispIntf: _ClientSponsorDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {FF19D114-3BDA-30AC-8E89-36CA64A87120} +// *********************************************************************// + _ClientSponsorDisp = dispinterface + ['{FF19D114-3BDA-30AC-8E89-36CA64A87120}'] + end; + {$EXTERNALSYM _ClientSponsorDisp} + +// *********************************************************************// +// Interface: _CrossContextDelegate +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {EE949B7B-439F-363E-B9FC-34DB1FB781D7} +// *********************************************************************// + _CrossContextDelegate = interface(IDispatch) + ['{EE949B7B-439F-363E-B9FC-34DB1FB781D7}'] + end; + +// *********************************************************************// +// DispIntf: _CrossContextDelegateDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {EE949B7B-439F-363E-B9FC-34DB1FB781D7} +// *********************************************************************// + _CrossContextDelegateDisp = dispinterface + ['{EE949B7B-439F-363E-B9FC-34DB1FB781D7}'] + end; + {$EXTERNALSYM _CrossContextDelegateDisp} + +// *********************************************************************// +// Interface: _Context +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {11A2EA7A-D600-307B-A606-511A6C7950D1} +// *********************************************************************// + _Context = interface(IDispatch) + ['{11A2EA7A-D600-307B-A606-511A6C7950D1}'] + end; + +// *********************************************************************// +// DispIntf: _ContextDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {11A2EA7A-D600-307B-A606-511A6C7950D1} +// *********************************************************************// + _ContextDisp = dispinterface + ['{11A2EA7A-D600-307B-A606-511A6C7950D1}'] + end; + {$EXTERNALSYM _ContextDisp} + +// *********************************************************************// +// Interface: _ContextProperty +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4ACB3495-05DB-381B-890A-D12F5340DCA3} +// *********************************************************************// + _ContextProperty = interface(IDispatch) + ['{4ACB3495-05DB-381B-890A-D12F5340DCA3}'] + end; + +// *********************************************************************// +// DispIntf: _ContextPropertyDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4ACB3495-05DB-381B-890A-D12F5340DCA3} +// *********************************************************************// + _ContextPropertyDisp = dispinterface + ['{4ACB3495-05DB-381B-890A-D12F5340DCA3}'] + end; + {$EXTERNALSYM _ContextPropertyDisp} + +// *********************************************************************// +// Interface: IContextPropertyActivator +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {7197B56B-5FA1-31EF-B38B-62FEE737277F} +// *********************************************************************// + IContextPropertyActivator = interface(IDispatch) + ['{7197B56B-5FA1-31EF-B38B-62FEE737277F}'] + function IsOKToActivate(const msg: IConstructionCallMessage): WordBool; safecall; + procedure CollectFromClientContext(const msg: IConstructionCallMessage); safecall; + function DeliverClientContextToServerContext(const msg: IConstructionCallMessage): WordBool; safecall; + procedure CollectFromServerContext(const msg: IConstructionReturnMessage); safecall; + function DeliverServerContextToClientContext(const msg: IConstructionReturnMessage): WordBool; safecall; + end; + +// *********************************************************************// +// DispIntf: IContextPropertyActivatorDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {7197B56B-5FA1-31EF-B38B-62FEE737277F} +// *********************************************************************// + IContextPropertyActivatorDisp = dispinterface + ['{7197B56B-5FA1-31EF-B38B-62FEE737277F}'] + function IsOKToActivate(const msg: IConstructionCallMessage): WordBool; dispid 1610743808; + procedure CollectFromClientContext(const msg: IConstructionCallMessage); dispid 1610743809; + function DeliverClientContextToServerContext(const msg: IConstructionCallMessage): WordBool; dispid 1610743810; + procedure CollectFromServerContext(const msg: IConstructionReturnMessage); dispid 1610743811; + function DeliverServerContextToClientContext(const msg: IConstructionReturnMessage): WordBool; dispid 1610743812; + end; + {$EXTERNALSYM IContextPropertyActivatorDisp} + +// *********************************************************************// +// Interface: IChannel +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {563581E8-C86D-39E2-B2E8-6C23F7987A4B} +// *********************************************************************// + IChannel = interface(IDispatch) + ['{563581E8-C86D-39E2-B2E8-6C23F7987A4B}'] + function Get_ChannelPriority: Integer; safecall; + function Get_ChannelName: WideString; safecall; + function Parse(const Url: WideString; out objectURI: WideString): WideString; safecall; + property ChannelPriority: Integer read Get_ChannelPriority; + property ChannelName: WideString read Get_ChannelName; + end; + +// *********************************************************************// +// DispIntf: IChannelDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {563581E8-C86D-39E2-B2E8-6C23F7987A4B} +// *********************************************************************// + IChannelDisp = dispinterface + ['{563581E8-C86D-39E2-B2E8-6C23F7987A4B}'] + property ChannelPriority: Integer readonly dispid 1610743808; + property ChannelName: WideString readonly dispid 1610743809; + function Parse(const Url: WideString; out objectURI: WideString): WideString; dispid 1610743810; + end; + {$EXTERNALSYM IChannelDisp} + +// *********************************************************************// +// Interface: IChannelSender +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {10F1D605-E201-3145-B7AE-3AD746701986} +// *********************************************************************// + IChannelSender = interface(IDispatch) + ['{10F1D605-E201-3145-B7AE-3AD746701986}'] + function CreateMessageSink(const Url: WideString; remoteChannelData: OleVariant; + out objectURI: WideString): IMessageSink; safecall; + end; + +// *********************************************************************// +// DispIntf: IChannelSenderDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {10F1D605-E201-3145-B7AE-3AD746701986} +// *********************************************************************// + IChannelSenderDisp = dispinterface + ['{10F1D605-E201-3145-B7AE-3AD746701986}'] + function CreateMessageSink(const Url: WideString; remoteChannelData: OleVariant; + out objectURI: WideString): IMessageSink; dispid 1610743808; + end; + {$EXTERNALSYM IChannelSenderDisp} + +// *********************************************************************// +// Interface: IChannelReceiver +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {48AD41DA-0872-31DA-9887-F81F213527E6} +// *********************************************************************// + IChannelReceiver = interface(IDispatch) + ['{48AD41DA-0872-31DA-9887-F81F213527E6}'] + function Get_ChannelData: OleVariant; safecall; + function GetUrlsForUri(const objectURI: WideString): PSafeArray; safecall; + procedure StartListening(data: OleVariant); safecall; + procedure StopListening(data: OleVariant); safecall; + property ChannelData: OleVariant read Get_ChannelData; + end; + +// *********************************************************************// +// DispIntf: IChannelReceiverDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {48AD41DA-0872-31DA-9887-F81F213527E6} +// *********************************************************************// + IChannelReceiverDisp = dispinterface + ['{48AD41DA-0872-31DA-9887-F81F213527E6}'] + property ChannelData: OleVariant readonly dispid 1610743808; + function GetUrlsForUri(const objectURI: WideString): {??PSafeArray}OleVariant; dispid 1610743809; + procedure StartListening(data: OleVariant); dispid 1610743810; + procedure StopListening(data: OleVariant); dispid 1610743811; + end; + {$EXTERNALSYM IChannelReceiverDisp} + +// *********************************************************************// +// Interface: IServerChannelSinkProvider +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {7DD6E975-24EA-323C-A98C-0FDE96F9C4E6} +// *********************************************************************// + IServerChannelSinkProvider = interface(IDispatch) + ['{7DD6E975-24EA-323C-A98C-0FDE96F9C4E6}'] + procedure GetChannelData(const ChannelData: IChannelDataStore); safecall; + function CreateSink(const channel: IChannelReceiver): IServerChannelSink; safecall; + function Get_Next: IServerChannelSinkProvider; safecall; + procedure _Set_Next(const pRetVal: IServerChannelSinkProvider); safecall; + property Next: IServerChannelSinkProvider read Get_Next; + end; + +// *********************************************************************// +// DispIntf: IServerChannelSinkProviderDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {7DD6E975-24EA-323C-A98C-0FDE96F9C4E6} +// *********************************************************************// + IServerChannelSinkProviderDisp = dispinterface + ['{7DD6E975-24EA-323C-A98C-0FDE96F9C4E6}'] + procedure GetChannelData(const ChannelData: IChannelDataStore); dispid 1610743808; + function CreateSink(const channel: IChannelReceiver): IServerChannelSink; dispid 1610743809; + property Next: IServerChannelSinkProvider readonly dispid 1610743810; + end; + {$EXTERNALSYM IServerChannelSinkProviderDisp} + +// *********************************************************************// +// Interface: IChannelSinkBase +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {308DE042-ACC8-32F8-B632-7CB9799D9AA6} +// *********************************************************************// + IChannelSinkBase = interface(IDispatch) + ['{308DE042-ACC8-32F8-B632-7CB9799D9AA6}'] + function Get_Properties: IDictionary; safecall; + property Properties: IDictionary read Get_Properties; + end; + +// *********************************************************************// +// DispIntf: IChannelSinkBaseDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {308DE042-ACC8-32F8-B632-7CB9799D9AA6} +// *********************************************************************// + IChannelSinkBaseDisp = dispinterface + ['{308DE042-ACC8-32F8-B632-7CB9799D9AA6}'] + property Properties: IDictionary readonly dispid 1610743808; + end; + {$EXTERNALSYM IChannelSinkBaseDisp} + +// *********************************************************************// +// Interface: IServerChannelSink +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {21B5F37B-BEF3-354C-8F84-0F9F0863F5C5} +// *********************************************************************// + IServerChannelSink = interface(IDispatch) + ['{21B5F37B-BEF3-354C-8F84-0F9F0863F5C5}'] + function ProcessMessage(const sinkStack: IServerChannelSinkStack; const requestMsg: IMessage; + const requestHeaders: ITransportHeaders; const requestStream: _Stream; + out responseMsg: IMessage; out responseHeaders: ITransportHeaders; + out responseStream: _Stream): ServerProcessing; safecall; + procedure AsyncProcessResponse(const sinkStack: IServerResponseChannelSinkStack; + state: OleVariant; const msg: IMessage; + const headers: ITransportHeaders; const Stream: _Stream); safecall; + function GetResponseStream(const sinkStack: IServerResponseChannelSinkStack; state: OleVariant; + const msg: IMessage; const headers: ITransportHeaders): _Stream; safecall; + function Get_NextChannelSink: IServerChannelSink; safecall; + property NextChannelSink: IServerChannelSink read Get_NextChannelSink; + end; + +// *********************************************************************// +// DispIntf: IServerChannelSinkDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {21B5F37B-BEF3-354C-8F84-0F9F0863F5C5} +// *********************************************************************// + IServerChannelSinkDisp = dispinterface + ['{21B5F37B-BEF3-354C-8F84-0F9F0863F5C5}'] + function ProcessMessage(const sinkStack: IServerChannelSinkStack; const requestMsg: IMessage; + const requestHeaders: ITransportHeaders; const requestStream: _Stream; + out responseMsg: IMessage; out responseHeaders: ITransportHeaders; + out responseStream: _Stream): ServerProcessing; dispid 1610743808; + procedure AsyncProcessResponse(const sinkStack: IServerResponseChannelSinkStack; + state: OleVariant; const msg: IMessage; + const headers: ITransportHeaders; const Stream: _Stream); dispid 1610743809; + function GetResponseStream(const sinkStack: IServerResponseChannelSinkStack; state: OleVariant; + const msg: IMessage; const headers: ITransportHeaders): _Stream; dispid 1610743810; + property NextChannelSink: IServerChannelSink readonly dispid 1610743811; + end; + {$EXTERNALSYM IServerChannelSinkDisp} + +// *********************************************************************// +// Interface: _EnterpriseServicesHelper +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {77C9BCEB-9958-33C0-A858-599F66697DA7} +// *********************************************************************// + _EnterpriseServicesHelper = interface(IDispatch) + ['{77C9BCEB-9958-33C0-A858-599F66697DA7}'] + end; + +// *********************************************************************// +// DispIntf: _EnterpriseServicesHelperDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {77C9BCEB-9958-33C0-A858-599F66697DA7} +// *********************************************************************// + _EnterpriseServicesHelperDisp = dispinterface + ['{77C9BCEB-9958-33C0-A858-599F66697DA7}'] + end; + {$EXTERNALSYM _EnterpriseServicesHelperDisp} + +// *********************************************************************// +// Interface: _Header +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0D296515-AD19-3602-B415-D8EC77066081} +// *********************************************************************// + _Header = interface(IDispatch) + ['{0D296515-AD19-3602-B415-D8EC77066081}'] + end; + +// *********************************************************************// +// DispIntf: _HeaderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0D296515-AD19-3602-B415-D8EC77066081} +// *********************************************************************// + _HeaderDisp = dispinterface + ['{0D296515-AD19-3602-B415-D8EC77066081}'] + end; + {$EXTERNALSYM _HeaderDisp} + +// *********************************************************************// +// Interface: _HeaderHandler +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {5DBBAF39-A3DF-30B7-AAEA-9FD11394123F} +// *********************************************************************// + _HeaderHandler = interface(IDispatch) + ['{5DBBAF39-A3DF-30B7-AAEA-9FD11394123F}'] + end; + +// *********************************************************************// +// DispIntf: _HeaderHandlerDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {5DBBAF39-A3DF-30B7-AAEA-9FD11394123F} +// *********************************************************************// + _HeaderHandlerDisp = dispinterface + ['{5DBBAF39-A3DF-30B7-AAEA-9FD11394123F}'] + end; + {$EXTERNALSYM _HeaderHandlerDisp} + +// *********************************************************************// +// Interface: IConstructionCallMessage +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {FA28E3AF-7D09-31D5-BEEB-7F2626497CDE} +// *********************************************************************// + IConstructionCallMessage = interface(IDispatch) + ['{FA28E3AF-7D09-31D5-BEEB-7F2626497CDE}'] + function Get_Activator: IActivator; safecall; + procedure _Set_Activator(const pRetVal: IActivator); safecall; + function Get_CallSiteActivationAttributes: PSafeArray; safecall; + function Get_ActivationTypeName: WideString; safecall; + function Get_ActivationType: _Type; safecall; + function Get_ContextProperties: IList; safecall; + property Activator: IActivator read Get_Activator; + property CallSiteActivationAttributes: PSafeArray read Get_CallSiteActivationAttributes; + property ActivationTypeName: WideString read Get_ActivationTypeName; + property ActivationType: _Type read Get_ActivationType; + property ContextProperties: IList read Get_ContextProperties; + end; + +// *********************************************************************// +// DispIntf: IConstructionCallMessageDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {FA28E3AF-7D09-31D5-BEEB-7F2626497CDE} +// *********************************************************************// + IConstructionCallMessageDisp = dispinterface + ['{FA28E3AF-7D09-31D5-BEEB-7F2626497CDE}'] + property Activator: IActivator readonly dispid 1610743808; + property CallSiteActivationAttributes: {??PSafeArray}OleVariant readonly dispid 1610743810; + property ActivationTypeName: WideString readonly dispid 1610743811; + property ActivationType: _Type readonly dispid 1610743812; + property ContextProperties: IList readonly dispid 1610743813; + end; + {$EXTERNALSYM IConstructionCallMessageDisp} + +// *********************************************************************// +// Interface: IMethodReturnMessage +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {F617690A-55F4-36AF-9149-D199831F8594} +// *********************************************************************// + IMethodReturnMessage = interface(IDispatch) + ['{F617690A-55F4-36AF-9149-D199831F8594}'] + function Get_OutArgCount: Integer; safecall; + function GetOutArgName(index: Integer): WideString; safecall; + function GetOutArg(argNum: Integer): OleVariant; safecall; + function Get_OutArgs: PSafeArray; safecall; + function Get_Exception: _Exception; safecall; + function Get_ReturnValue: OleVariant; safecall; + property OutArgCount: Integer read Get_OutArgCount; + property OutArgs: PSafeArray read Get_OutArgs; + property Exception: _Exception read Get_Exception; + property ReturnValue: OleVariant read Get_ReturnValue; + end; + +// *********************************************************************// +// DispIntf: IMethodReturnMessageDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {F617690A-55F4-36AF-9149-D199831F8594} +// *********************************************************************// + IMethodReturnMessageDisp = dispinterface + ['{F617690A-55F4-36AF-9149-D199831F8594}'] + property OutArgCount: Integer readonly dispid 1610743808; + function GetOutArgName(index: Integer): WideString; dispid 1610743809; + function GetOutArg(argNum: Integer): OleVariant; dispid 1610743810; + property OutArgs: {??PSafeArray}OleVariant readonly dispid 1610743811; + property Exception: _Exception readonly dispid 1610743812; + property ReturnValue: OleVariant readonly dispid 1610743813; + end; + {$EXTERNALSYM IMethodReturnMessageDisp} + +// *********************************************************************// +// Interface: IConstructionReturnMessage +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {CA0AB564-F5E9-3A7F-A80B-EB0AEEFA44E9} +// *********************************************************************// + IConstructionReturnMessage = interface(IDispatch) + ['{CA0AB564-F5E9-3A7F-A80B-EB0AEEFA44E9}'] + end; + +// *********************************************************************// +// DispIntf: IConstructionReturnMessageDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {CA0AB564-F5E9-3A7F-A80B-EB0AEEFA44E9} +// *********************************************************************// + IConstructionReturnMessageDisp = dispinterface + ['{CA0AB564-F5E9-3A7F-A80B-EB0AEEFA44E9}'] + end; + {$EXTERNALSYM IConstructionReturnMessageDisp} + +// *********************************************************************// +// Interface: IChannelReceiverHook +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {3A02D3F7-3F40-3022-853D-CFDA765182FE} +// *********************************************************************// + IChannelReceiverHook = interface(IDispatch) + ['{3A02D3F7-3F40-3022-853D-CFDA765182FE}'] + function Get_ChannelScheme: WideString; safecall; + function Get_WantsToListen: WordBool; safecall; + function Get_ChannelSinkChain: IServerChannelSink; safecall; + procedure AddHookChannelUri(const channelUri: WideString); safecall; + property ChannelScheme: WideString read Get_ChannelScheme; + property WantsToListen: WordBool read Get_WantsToListen; + property ChannelSinkChain: IServerChannelSink read Get_ChannelSinkChain; + end; + +// *********************************************************************// +// DispIntf: IChannelReceiverHookDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {3A02D3F7-3F40-3022-853D-CFDA765182FE} +// *********************************************************************// + IChannelReceiverHookDisp = dispinterface + ['{3A02D3F7-3F40-3022-853D-CFDA765182FE}'] + property ChannelScheme: WideString readonly dispid 1610743808; + property WantsToListen: WordBool readonly dispid 1610743809; + property ChannelSinkChain: IServerChannelSink readonly dispid 1610743810; + procedure AddHookChannelUri(const channelUri: WideString); dispid 1610743811; + end; + {$EXTERNALSYM IChannelReceiverHookDisp} + +// *********************************************************************// +// Interface: IClientChannelSinkProvider +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {3F8742C2-AC57-3440-A283-FE5FF4C75025} +// *********************************************************************// + IClientChannelSinkProvider = interface(IDispatch) + ['{3F8742C2-AC57-3440-A283-FE5FF4C75025}'] + function CreateSink(const channel: IChannelSender; const Url: WideString; + remoteChannelData: OleVariant): IClientChannelSink; safecall; + function Get_Next: IClientChannelSinkProvider; safecall; + procedure _Set_Next(const pRetVal: IClientChannelSinkProvider); safecall; + property Next: IClientChannelSinkProvider read Get_Next; + end; + +// *********************************************************************// +// DispIntf: IClientChannelSinkProviderDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {3F8742C2-AC57-3440-A283-FE5FF4C75025} +// *********************************************************************// + IClientChannelSinkProviderDisp = dispinterface + ['{3F8742C2-AC57-3440-A283-FE5FF4C75025}'] + function CreateSink(const channel: IChannelSender; const Url: WideString; + remoteChannelData: OleVariant): IClientChannelSink; dispid 1610743808; + property Next: IClientChannelSinkProvider readonly dispid 1610743809; + end; + {$EXTERNALSYM IClientChannelSinkProviderDisp} + +// *********************************************************************// +// Interface: IClientFormatterSinkProvider +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {6D94B6F3-DA91-3C2F-B876-083769667468} +// *********************************************************************// + IClientFormatterSinkProvider = interface(IDispatch) + ['{6D94B6F3-DA91-3C2F-B876-083769667468}'] + end; + +// *********************************************************************// +// DispIntf: IClientFormatterSinkProviderDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {6D94B6F3-DA91-3C2F-B876-083769667468} +// *********************************************************************// + IClientFormatterSinkProviderDisp = dispinterface + ['{6D94B6F3-DA91-3C2F-B876-083769667468}'] + end; + {$EXTERNALSYM IClientFormatterSinkProviderDisp} + +// *********************************************************************// +// Interface: IServerFormatterSinkProvider +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {042B5200-4317-3E4D-B653-7E9A08F1A5F2} +// *********************************************************************// + IServerFormatterSinkProvider = interface(IDispatch) + ['{042B5200-4317-3E4D-B653-7E9A08F1A5F2}'] + end; + +// *********************************************************************// +// DispIntf: IServerFormatterSinkProviderDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {042B5200-4317-3E4D-B653-7E9A08F1A5F2} +// *********************************************************************// + IServerFormatterSinkProviderDisp = dispinterface + ['{042B5200-4317-3E4D-B653-7E9A08F1A5F2}'] + end; + {$EXTERNALSYM IServerFormatterSinkProviderDisp} + +// *********************************************************************// +// Interface: IClientChannelSink +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {FF726320-6B92-3E6C-AAAC-F97063D0B142} +// *********************************************************************// + IClientChannelSink = interface(IDispatch) + ['{FF726320-6B92-3E6C-AAAC-F97063D0B142}'] + procedure ProcessMessage(const msg: IMessage; const requestHeaders: ITransportHeaders; + const requestStream: _Stream; out responseHeaders: ITransportHeaders; + out responseStream: _Stream); safecall; + procedure AsyncProcessRequest(const sinkStack: IClientChannelSinkStack; const msg: IMessage; + const headers: ITransportHeaders; const Stream: _Stream); safecall; + procedure AsyncProcessResponse(const sinkStack: IClientResponseChannelSinkStack; + state: OleVariant; const headers: ITransportHeaders; + const Stream: _Stream); safecall; + function GetRequestStream(const msg: IMessage; const headers: ITransportHeaders): _Stream; safecall; + function Get_NextChannelSink: IClientChannelSink; safecall; + property NextChannelSink: IClientChannelSink read Get_NextChannelSink; + end; + +// *********************************************************************// +// DispIntf: IClientChannelSinkDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {FF726320-6B92-3E6C-AAAC-F97063D0B142} +// *********************************************************************// + IClientChannelSinkDisp = dispinterface + ['{FF726320-6B92-3E6C-AAAC-F97063D0B142}'] + procedure ProcessMessage(const msg: IMessage; const requestHeaders: ITransportHeaders; + const requestStream: _Stream; out responseHeaders: ITransportHeaders; + out responseStream: _Stream); dispid 1610743808; + procedure AsyncProcessRequest(const sinkStack: IClientChannelSinkStack; const msg: IMessage; + const headers: ITransportHeaders; const Stream: _Stream); dispid 1610743809; + procedure AsyncProcessResponse(const sinkStack: IClientResponseChannelSinkStack; + state: OleVariant; const headers: ITransportHeaders; + const Stream: _Stream); dispid 1610743810; + function GetRequestStream(const msg: IMessage; const headers: ITransportHeaders): _Stream; dispid 1610743811; + property NextChannelSink: IClientChannelSink readonly dispid 1610743812; + end; + {$EXTERNALSYM IClientChannelSinkDisp} + +// *********************************************************************// +// Interface: IClientFormatterSink +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {46527C03-B144-3CF0-86B3-B8776148A6E9} +// *********************************************************************// + IClientFormatterSink = interface(IDispatch) + ['{46527C03-B144-3CF0-86B3-B8776148A6E9}'] + end; + +// *********************************************************************// +// DispIntf: IClientFormatterSinkDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {46527C03-B144-3CF0-86B3-B8776148A6E9} +// *********************************************************************// + IClientFormatterSinkDisp = dispinterface + ['{46527C03-B144-3CF0-86B3-B8776148A6E9}'] + end; + {$EXTERNALSYM IClientFormatterSinkDisp} + +// *********************************************************************// +// Interface: IChannelDataStore +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {1E250CCD-DC30-3217-A7E4-148F375A0088} +// *********************************************************************// + IChannelDataStore = interface(IDispatch) + ['{1E250CCD-DC30-3217-A7E4-148F375A0088}'] + function Get_ChannelUris: PSafeArray; safecall; + function Get_Item(key: OleVariant): OleVariant; safecall; + procedure _Set_Item(key: OleVariant; pRetVal: OleVariant); safecall; + property ChannelUris: PSafeArray read Get_ChannelUris; + property Item[key: OleVariant]: OleVariant read Get_Item write _Set_Item; default; + end; + +// *********************************************************************// +// DispIntf: IChannelDataStoreDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {1E250CCD-DC30-3217-A7E4-148F375A0088} +// *********************************************************************// + IChannelDataStoreDisp = dispinterface + ['{1E250CCD-DC30-3217-A7E4-148F375A0088}'] + property ChannelUris: {??PSafeArray}OleVariant readonly dispid 1610743808; + property Item[key: OleVariant]: OleVariant dispid 0; default; + end; + {$EXTERNALSYM IChannelDataStoreDisp} + +// *********************************************************************// +// Interface: _ChannelDataStore +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AA6DA581-F972-36DE-A53B-7585428A68AB} +// *********************************************************************// + _ChannelDataStore = interface(IDispatch) + ['{AA6DA581-F972-36DE-A53B-7585428A68AB}'] + end; + +// *********************************************************************// +// DispIntf: _ChannelDataStoreDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AA6DA581-F972-36DE-A53B-7585428A68AB} +// *********************************************************************// + _ChannelDataStoreDisp = dispinterface + ['{AA6DA581-F972-36DE-A53B-7585428A68AB}'] + end; + {$EXTERNALSYM _ChannelDataStoreDisp} + +// *********************************************************************// +// Interface: ITransportHeaders +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {1AC82FBE-4FF0-383C-BBFD-FE40ECB3628D} +// *********************************************************************// + ITransportHeaders = interface(IDispatch) + ['{1AC82FBE-4FF0-383C-BBFD-FE40ECB3628D}'] + function Get_Item(key: OleVariant): OleVariant; safecall; + procedure _Set_Item(key: OleVariant; pRetVal: OleVariant); safecall; + function GetEnumerator: IEnumVARIANT; safecall; + property Item[key: OleVariant]: OleVariant read Get_Item write _Set_Item; default; + end; + +// *********************************************************************// +// DispIntf: ITransportHeadersDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {1AC82FBE-4FF0-383C-BBFD-FE40ECB3628D} +// *********************************************************************// + ITransportHeadersDisp = dispinterface + ['{1AC82FBE-4FF0-383C-BBFD-FE40ECB3628D}'] + property Item[key: OleVariant]: OleVariant dispid 0; default; + function GetEnumerator: IEnumVARIANT; dispid -4; + end; + {$EXTERNALSYM ITransportHeadersDisp} + +// *********************************************************************// +// Interface: _TransportHeaders +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {65887F70-C646-3A66-8697-8A3F7D8FE94D} +// *********************************************************************// + _TransportHeaders = interface(IDispatch) + ['{65887F70-C646-3A66-8697-8A3F7D8FE94D}'] + end; + +// *********************************************************************// +// DispIntf: _TransportHeadersDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {65887F70-C646-3A66-8697-8A3F7D8FE94D} +// *********************************************************************// + _TransportHeadersDisp = dispinterface + ['{65887F70-C646-3A66-8697-8A3F7D8FE94D}'] + end; + {$EXTERNALSYM _TransportHeadersDisp} + +// *********************************************************************// +// Interface: _SinkProviderData +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A18545B7-E5EE-31EE-9B9B-41199B11C995} +// *********************************************************************// + _SinkProviderData = interface(IDispatch) + ['{A18545B7-E5EE-31EE-9B9B-41199B11C995}'] + end; + +// *********************************************************************// +// DispIntf: _SinkProviderDataDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A18545B7-E5EE-31EE-9B9B-41199B11C995} +// *********************************************************************// + _SinkProviderDataDisp = dispinterface + ['{A18545B7-E5EE-31EE-9B9B-41199B11C995}'] + end; + {$EXTERNALSYM _SinkProviderDataDisp} + +// *********************************************************************// +// Interface: _BaseChannelObjectWithProperties +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A1329EC9-E567-369F-8258-18366D89EAF8} +// *********************************************************************// + _BaseChannelObjectWithProperties = interface(IDispatch) + ['{A1329EC9-E567-369F-8258-18366D89EAF8}'] + end; + +// *********************************************************************// +// DispIntf: _BaseChannelObjectWithPropertiesDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A1329EC9-E567-369F-8258-18366D89EAF8} +// *********************************************************************// + _BaseChannelObjectWithPropertiesDisp = dispinterface + ['{A1329EC9-E567-369F-8258-18366D89EAF8}'] + end; + {$EXTERNALSYM _BaseChannelObjectWithPropertiesDisp} + +// *********************************************************************// +// Interface: _BaseChannelSinkWithProperties +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8AF3451E-154D-3D86-80D8-F8478B9733ED} +// *********************************************************************// + _BaseChannelSinkWithProperties = interface(IDispatch) + ['{8AF3451E-154D-3D86-80D8-F8478B9733ED}'] + end; + +// *********************************************************************// +// DispIntf: _BaseChannelSinkWithPropertiesDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8AF3451E-154D-3D86-80D8-F8478B9733ED} +// *********************************************************************// + _BaseChannelSinkWithPropertiesDisp = dispinterface + ['{8AF3451E-154D-3D86-80D8-F8478B9733ED}'] + end; + {$EXTERNALSYM _BaseChannelSinkWithPropertiesDisp} + +// *********************************************************************// +// Interface: _BaseChannelWithProperties +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {94BB98ED-18BB-3843-A7FE-642824AB4E01} +// *********************************************************************// + _BaseChannelWithProperties = interface(IDispatch) + ['{94BB98ED-18BB-3843-A7FE-642824AB4E01}'] + end; + +// *********************************************************************// +// DispIntf: _BaseChannelWithPropertiesDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {94BB98ED-18BB-3843-A7FE-642824AB4E01} +// *********************************************************************// + _BaseChannelWithPropertiesDisp = dispinterface + ['{94BB98ED-18BB-3843-A7FE-642824AB4E01}'] + end; + {$EXTERNALSYM _BaseChannelWithPropertiesDisp} + +// *********************************************************************// +// Interface: IContributeClientContextSink +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {4DB956B7-69D0-312A-AA75-44FB55FD5D4B} +// *********************************************************************// + IContributeClientContextSink = interface(IDispatch) + ['{4DB956B7-69D0-312A-AA75-44FB55FD5D4B}'] + function GetClientContextSink(const NextSink: IMessageSink): IMessageSink; safecall; + end; + +// *********************************************************************// +// DispIntf: IContributeClientContextSinkDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {4DB956B7-69D0-312A-AA75-44FB55FD5D4B} +// *********************************************************************// + IContributeClientContextSinkDisp = dispinterface + ['{4DB956B7-69D0-312A-AA75-44FB55FD5D4B}'] + function GetClientContextSink(const NextSink: IMessageSink): IMessageSink; dispid 1610743808; + end; + {$EXTERNALSYM IContributeClientContextSinkDisp} + +// *********************************************************************// +// Interface: IContributeDynamicSink +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {A0FE9B86-0C06-32CE-85FA-2FF1B58697FB} +// *********************************************************************// + IContributeDynamicSink = interface(IDispatch) + ['{A0FE9B86-0C06-32CE-85FA-2FF1B58697FB}'] + function GetDynamicSink: IDynamicMessageSink; safecall; + end; + +// *********************************************************************// +// DispIntf: IContributeDynamicSinkDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {A0FE9B86-0C06-32CE-85FA-2FF1B58697FB} +// *********************************************************************// + IContributeDynamicSinkDisp = dispinterface + ['{A0FE9B86-0C06-32CE-85FA-2FF1B58697FB}'] + function GetDynamicSink: IDynamicMessageSink; dispid 1610743808; + end; + {$EXTERNALSYM IContributeDynamicSinkDisp} + +// *********************************************************************// +// Interface: IContributeEnvoySink +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {124777B6-0308-3569-97E5-E6FE88EAE4EB} +// *********************************************************************// + IContributeEnvoySink = interface(IDispatch) + ['{124777B6-0308-3569-97E5-E6FE88EAE4EB}'] + function GetEnvoySink(const obj: _MarshalByRefObject; const NextSink: IMessageSink): IMessageSink; safecall; + end; + +// *********************************************************************// +// DispIntf: IContributeEnvoySinkDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {124777B6-0308-3569-97E5-E6FE88EAE4EB} +// *********************************************************************// + IContributeEnvoySinkDisp = dispinterface + ['{124777B6-0308-3569-97E5-E6FE88EAE4EB}'] + function GetEnvoySink(const obj: _MarshalByRefObject; const NextSink: IMessageSink): IMessageSink; dispid 1610743808; + end; + {$EXTERNALSYM IContributeEnvoySinkDisp} + +// *********************************************************************// +// Interface: IContributeObjectSink +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {6A5D38BC-2789-3546-81A1-F10C0FB59366} +// *********************************************************************// + IContributeObjectSink = interface(IDispatch) + ['{6A5D38BC-2789-3546-81A1-F10C0FB59366}'] + function GetObjectSink(const obj: _MarshalByRefObject; const NextSink: IMessageSink): IMessageSink; safecall; + end; + +// *********************************************************************// +// DispIntf: IContributeObjectSinkDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {6A5D38BC-2789-3546-81A1-F10C0FB59366} +// *********************************************************************// + IContributeObjectSinkDisp = dispinterface + ['{6A5D38BC-2789-3546-81A1-F10C0FB59366}'] + function GetObjectSink(const obj: _MarshalByRefObject; const NextSink: IMessageSink): IMessageSink; dispid 1610743808; + end; + {$EXTERNALSYM IContributeObjectSinkDisp} + +// *********************************************************************// +// Interface: IContributeServerContextSink +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {0CAA23EC-F78C-39C9-8D25-B7A9CE4097A7} +// *********************************************************************// + IContributeServerContextSink = interface(IDispatch) + ['{0CAA23EC-F78C-39C9-8D25-B7A9CE4097A7}'] + function GetServerContextSink(const NextSink: IMessageSink): IMessageSink; safecall; + end; + +// *********************************************************************// +// DispIntf: IContributeServerContextSinkDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {0CAA23EC-F78C-39C9-8D25-B7A9CE4097A7} +// *********************************************************************// + IContributeServerContextSinkDisp = dispinterface + ['{0CAA23EC-F78C-39C9-8D25-B7A9CE4097A7}'] + function GetServerContextSink(const NextSink: IMessageSink): IMessageSink; dispid 1610743808; + end; + {$EXTERNALSYM IContributeServerContextSinkDisp} + +// *********************************************************************// +// Interface: IDynamicProperty +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {00A358D4-4D58-3B9D-8FB6-FB7F6BC1713B} +// *********************************************************************// + IDynamicProperty = interface(IDispatch) + ['{00A358D4-4D58-3B9D-8FB6-FB7F6BC1713B}'] + function Get_name: WideString; safecall; + property name: WideString read Get_name; + end; + +// *********************************************************************// +// DispIntf: IDynamicPropertyDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {00A358D4-4D58-3B9D-8FB6-FB7F6BC1713B} +// *********************************************************************// + IDynamicPropertyDisp = dispinterface + ['{00A358D4-4D58-3B9D-8FB6-FB7F6BC1713B}'] + property name: WideString readonly dispid 1610743808; + end; + {$EXTERNALSYM IDynamicPropertyDisp} + +// *********************************************************************// +// Interface: IDynamicMessageSink +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {C74076BB-8A2D-3C20-A542-625329E9AF04} +// *********************************************************************// + IDynamicMessageSink = interface(IDispatch) + ['{C74076BB-8A2D-3C20-A542-625329E9AF04}'] + procedure ProcessMessageStart(const reqMsg: IMessage; bCliSide: WordBool; bAsync: WordBool); safecall; + procedure ProcessMessageFinish(const replyMsg: IMessage; bCliSide: WordBool; bAsync: WordBool); safecall; + end; + +// *********************************************************************// +// DispIntf: IDynamicMessageSinkDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {C74076BB-8A2D-3C20-A542-625329E9AF04} +// *********************************************************************// + IDynamicMessageSinkDisp = dispinterface + ['{C74076BB-8A2D-3C20-A542-625329E9AF04}'] + procedure ProcessMessageStart(const reqMsg: IMessage; bCliSide: WordBool; bAsync: WordBool); dispid 1610743808; + procedure ProcessMessageFinish(const replyMsg: IMessage; bCliSide: WordBool; bAsync: WordBool); dispid 1610743809; + end; + {$EXTERNALSYM IDynamicMessageSinkDisp} + +// *********************************************************************// +// Interface: ILease +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {53A561F2-CBBF-3748-BFFE-2180002DB3DF} +// *********************************************************************// + ILease = interface(IDispatch) + ['{53A561F2-CBBF-3748-BFFE-2180002DB3DF}'] + procedure Register(const obj: ISponsor; renewalTime: TimeSpan); safecall; + procedure Register_2(const obj: ISponsor); safecall; + procedure Unregister(const obj: ISponsor); safecall; + function Renew(renewalTime: TimeSpan): TimeSpan; safecall; + function Get_RenewOnCallTime: TimeSpan; safecall; + procedure Set_RenewOnCallTime(pRetVal: TimeSpan); safecall; + function Get_SponsorshipTimeout: TimeSpan; safecall; + procedure Set_SponsorshipTimeout(pRetVal: TimeSpan); safecall; + function Get_InitialLeaseTime: TimeSpan; safecall; + procedure Set_InitialLeaseTime(pRetVal: TimeSpan); safecall; + function Get_CurrentLeaseTime: TimeSpan; safecall; + function Get_CurrentState: LeaseState; safecall; + property RenewOnCallTime: TimeSpan read Get_RenewOnCallTime; + property SponsorshipTimeout: TimeSpan read Get_SponsorshipTimeout; + property InitialLeaseTime: TimeSpan read Get_InitialLeaseTime; + property CurrentLeaseTime: TimeSpan read Get_CurrentLeaseTime; + property CurrentState: LeaseState read Get_CurrentState; + end; + +// *********************************************************************// +// DispIntf: ILeaseDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {53A561F2-CBBF-3748-BFFE-2180002DB3DF} +// *********************************************************************// + ILeaseDisp = dispinterface + ['{53A561F2-CBBF-3748-BFFE-2180002DB3DF}'] + procedure Register(const obj: ISponsor; renewalTime: {??TimeSpan}OleVariant); dispid 1610743808; + procedure Register_2(const obj: ISponsor); dispid 1610743809; + procedure Unregister(const obj: ISponsor); dispid 1610743810; + function Renew(renewalTime: {??TimeSpan}OleVariant): {??TimeSpan}OleVariant; dispid 1610743811; + property RenewOnCallTime: {??TimeSpan}OleVariant readonly dispid 1610743812; + property SponsorshipTimeout: {??TimeSpan}OleVariant readonly dispid 1610743814; + property InitialLeaseTime: {??TimeSpan}OleVariant readonly dispid 1610743816; + property CurrentLeaseTime: {??TimeSpan}OleVariant readonly dispid 1610743818; + property CurrentState: LeaseState readonly dispid 1610743819; + end; + {$EXTERNALSYM ILeaseDisp} + +// *********************************************************************// +// Interface: IMessageCtrl +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {3677CBB0-784D-3C15-BBC8-75CD7DC3901E} +// *********************************************************************// + IMessageCtrl = interface(IDispatch) + ['{3677CBB0-784D-3C15-BBC8-75CD7DC3901E}'] + procedure Cancel(msToCancel: Integer); safecall; + end; + +// *********************************************************************// +// DispIntf: IMessageCtrlDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {3677CBB0-784D-3C15-BBC8-75CD7DC3901E} +// *********************************************************************// + IMessageCtrlDisp = dispinterface + ['{3677CBB0-784D-3C15-BBC8-75CD7DC3901E}'] + procedure Cancel(msToCancel: Integer); dispid 1610743808; + end; + {$EXTERNALSYM IMessageCtrlDisp} + +// *********************************************************************// +// Interface: IRemotingFormatter +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {AE1850FD-3596-3727-A242-2FC31C5A0312} +// *********************************************************************// + IRemotingFormatter = interface(IDispatch) + ['{AE1850FD-3596-3727-A242-2FC31C5A0312}'] + function Deserialize(const serializationStream: _Stream; const handler: _HeaderHandler): OleVariant; safecall; + procedure Serialize(const serializationStream: _Stream; graph: OleVariant; headers: PSafeArray); safecall; + end; + +// *********************************************************************// +// DispIntf: IRemotingFormatterDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {AE1850FD-3596-3727-A242-2FC31C5A0312} +// *********************************************************************// + IRemotingFormatterDisp = dispinterface + ['{AE1850FD-3596-3727-A242-2FC31C5A0312}'] + function Deserialize(const serializationStream: _Stream; const handler: _HeaderHandler): OleVariant; dispid 1610743808; + procedure Serialize(const serializationStream: _Stream; graph: OleVariant; + headers: {??PSafeArray}OleVariant); dispid 1610743809; + end; + {$EXTERNALSYM IRemotingFormatterDisp} + +// *********************************************************************// +// Interface: _LifetimeServices +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B0AD9A21-5439-3D88-8975-4018B828D74C} +// *********************************************************************// + _LifetimeServices = interface(IDispatch) + ['{B0AD9A21-5439-3D88-8975-4018B828D74C}'] + end; + +// *********************************************************************// +// DispIntf: _LifetimeServicesDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B0AD9A21-5439-3D88-8975-4018B828D74C} +// *********************************************************************// + _LifetimeServicesDisp = dispinterface + ['{B0AD9A21-5439-3D88-8975-4018B828D74C}'] + end; + {$EXTERNALSYM _LifetimeServicesDisp} + +// *********************************************************************// +// Interface: _ReturnMessage +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0EEFF4C2-84BF-3E4E-BF22-B7BDBB5DF899} +// *********************************************************************// + _ReturnMessage = interface(IDispatch) + ['{0EEFF4C2-84BF-3E4E-BF22-B7BDBB5DF899}'] + end; + +// *********************************************************************// +// DispIntf: _ReturnMessageDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0EEFF4C2-84BF-3E4E-BF22-B7BDBB5DF899} +// *********************************************************************// + _ReturnMessageDisp = dispinterface + ['{0EEFF4C2-84BF-3E4E-BF22-B7BDBB5DF899}'] + end; + {$EXTERNALSYM _ReturnMessageDisp} + +// *********************************************************************// +// Interface: _MethodCall +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {95E01216-5467-371B-8597-4074402CCB06} +// *********************************************************************// + _MethodCall = interface(IDispatch) + ['{95E01216-5467-371B-8597-4074402CCB06}'] + end; + +// *********************************************************************// +// DispIntf: _MethodCallDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {95E01216-5467-371B-8597-4074402CCB06} +// *********************************************************************// + _MethodCallDisp = dispinterface + ['{95E01216-5467-371B-8597-4074402CCB06}'] + end; + {$EXTERNALSYM _MethodCallDisp} + +// *********************************************************************// +// Interface: _ConstructionCall +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A2246AE7-EB81-3A20-8E70-C9FA341C7E10} +// *********************************************************************// + _ConstructionCall = interface(IDispatch) + ['{A2246AE7-EB81-3A20-8E70-C9FA341C7E10}'] + end; + +// *********************************************************************// +// DispIntf: _ConstructionCallDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A2246AE7-EB81-3A20-8E70-C9FA341C7E10} +// *********************************************************************// + _ConstructionCallDisp = dispinterface + ['{A2246AE7-EB81-3A20-8E70-C9FA341C7E10}'] + end; + {$EXTERNALSYM _ConstructionCallDisp} + +// *********************************************************************// +// Interface: _MethodResponse +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9E9EA93A-D000-3AB9-BFCA-DDEB398A55B9} +// *********************************************************************// + _MethodResponse = interface(IDispatch) + ['{9E9EA93A-D000-3AB9-BFCA-DDEB398A55B9}'] + end; + +// *********************************************************************// +// DispIntf: _MethodResponseDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {9E9EA93A-D000-3AB9-BFCA-DDEB398A55B9} +// *********************************************************************// + _MethodResponseDisp = dispinterface + ['{9E9EA93A-D000-3AB9-BFCA-DDEB398A55B9}'] + end; + {$EXTERNALSYM _MethodResponseDisp} + +// *********************************************************************// +// Interface: IFieldInfo +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {CC18FD4D-AA2D-3AB4-9848-584BBAE4AB44} +// *********************************************************************// + IFieldInfo = interface(IDispatch) + ['{CC18FD4D-AA2D-3AB4-9848-584BBAE4AB44}'] + function Get_FieldNames: PSafeArray; safecall; + procedure Set_FieldNames(pRetVal: PSafeArray); safecall; + function Get_FieldTypes: PSafeArray; safecall; + procedure Set_FieldTypes(pRetVal: PSafeArray); safecall; + property FieldNames: PSafeArray read Get_FieldNames; + property FieldTypes: PSafeArray read Get_FieldTypes; + end; + +// *********************************************************************// +// DispIntf: IFieldInfoDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {CC18FD4D-AA2D-3AB4-9848-584BBAE4AB44} +// *********************************************************************// + IFieldInfoDisp = dispinterface + ['{CC18FD4D-AA2D-3AB4-9848-584BBAE4AB44}'] + property FieldNames: {??PSafeArray}OleVariant readonly dispid 1610743808; + property FieldTypes: {??PSafeArray}OleVariant readonly dispid 1610743810; + end; + {$EXTERNALSYM IFieldInfoDisp} + +// *********************************************************************// +// Interface: _ConstructionResponse +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BE457280-6FFA-3E76-9822-83DE63C0C4E0} +// *********************************************************************// + _ConstructionResponse = interface(IDispatch) + ['{BE457280-6FFA-3E76-9822-83DE63C0C4E0}'] + end; + +// *********************************************************************// +// DispIntf: _ConstructionResponseDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BE457280-6FFA-3E76-9822-83DE63C0C4E0} +// *********************************************************************// + _ConstructionResponseDisp = dispinterface + ['{BE457280-6FFA-3E76-9822-83DE63C0C4E0}'] + end; + {$EXTERNALSYM _ConstructionResponseDisp} + +// *********************************************************************// +// Interface: _MethodReturnMessageWrapper +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {89304439-A24F-30F6-9A8F-89CE472D85DA} +// *********************************************************************// + _MethodReturnMessageWrapper = interface(IDispatch) + ['{89304439-A24F-30F6-9A8F-89CE472D85DA}'] + end; + +// *********************************************************************// +// DispIntf: _MethodReturnMessageWrapperDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {89304439-A24F-30F6-9A8F-89CE472D85DA} +// *********************************************************************// + _MethodReturnMessageWrapperDisp = dispinterface + ['{89304439-A24F-30F6-9A8F-89CE472D85DA}'] + end; + {$EXTERNALSYM _MethodReturnMessageWrapperDisp} + +// *********************************************************************// +// Interface: _ObjectHandle +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {EA675B47-64E0-3B5F-9BE7-F7DC2990730D} +// *********************************************************************// + _ObjectHandle = interface(IDispatch) + ['{EA675B47-64E0-3B5F-9BE7-F7DC2990730D}'] + function Get_ToString: WideString; safecall; + function Equals(obj: OleVariant): WordBool; safecall; + function GetHashCode: Integer; safecall; + function GetType: _Type; safecall; + function GetLifetimeService: OleVariant; safecall; + function InitializeLifetimeService: OleVariant; safecall; + function CreateObjRef(const requestedType: _Type): _ObjRef; safecall; + function Unwrap: OleVariant; safecall; + property ToString: WideString read Get_ToString; + end; + +// *********************************************************************// +// DispIntf: _ObjectHandleDisp +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {EA675B47-64E0-3B5F-9BE7-F7DC2990730D} +// *********************************************************************// + _ObjectHandleDisp = dispinterface + ['{EA675B47-64E0-3B5F-9BE7-F7DC2990730D}'] + property ToString: WideString readonly dispid 0; + function Equals(obj: OleVariant): WordBool; dispid 1610743809; + function GetHashCode: Integer; dispid 1610743810; + function GetType: _Type; dispid 1610743811; + function GetLifetimeService: OleVariant; dispid 1610743812; + function InitializeLifetimeService: OleVariant; dispid 1610743813; + function CreateObjRef(const requestedType: _Type): _ObjRef; dispid 1610743814; + function Unwrap: OleVariant; dispid 1610743815; + end; + {$EXTERNALSYM _ObjectHandleDisp} + +// *********************************************************************// +// Interface: IRemotingTypeInfo +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {C09EFFA9-1FFE-3A52-A733-6236CBC45E7B} +// *********************************************************************// + IRemotingTypeInfo = interface(IDispatch) + ['{C09EFFA9-1FFE-3A52-A733-6236CBC45E7B}'] + function Get_typeName: WideString; safecall; + procedure Set_typeName(const pRetVal: WideString); safecall; + function CanCastTo(const fromType: _Type; o: OleVariant): WordBool; safecall; + property typeName: WideString read Get_typeName; + end; + +// *********************************************************************// +// DispIntf: IRemotingTypeInfoDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {C09EFFA9-1FFE-3A52-A733-6236CBC45E7B} +// *********************************************************************// + IRemotingTypeInfoDisp = dispinterface + ['{C09EFFA9-1FFE-3A52-A733-6236CBC45E7B}'] + property typeName: WideString readonly dispid 1610743808; + function CanCastTo(const fromType: _Type; o: OleVariant): WordBool; dispid 1610743810; + end; + {$EXTERNALSYM IRemotingTypeInfoDisp} + +// *********************************************************************// +// Interface: IChannelInfo +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {855E6566-014A-3FE8-AA70-1EAC771E3A88} +// *********************************************************************// + IChannelInfo = interface(IDispatch) + ['{855E6566-014A-3FE8-AA70-1EAC771E3A88}'] + function Get_ChannelData: PSafeArray; safecall; + procedure Set_ChannelData(pRetVal: PSafeArray); safecall; + property ChannelData: PSafeArray read Get_ChannelData; + end; + +// *********************************************************************// +// DispIntf: IChannelInfoDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {855E6566-014A-3FE8-AA70-1EAC771E3A88} +// *********************************************************************// + IChannelInfoDisp = dispinterface + ['{855E6566-014A-3FE8-AA70-1EAC771E3A88}'] + property ChannelData: {??PSafeArray}OleVariant readonly dispid 1610743808; + end; + {$EXTERNALSYM IChannelInfoDisp} + +// *********************************************************************// +// Interface: IEnvoyInfo +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {2A6E91B9-A874-38E4-99C2-C5D83D78140D} +// *********************************************************************// + IEnvoyInfo = interface(IDispatch) + ['{2A6E91B9-A874-38E4-99C2-C5D83D78140D}'] + function Get_EnvoySinks: IMessageSink; safecall; + procedure _Set_EnvoySinks(const pRetVal: IMessageSink); safecall; + property EnvoySinks: IMessageSink read Get_EnvoySinks; + end; + +// *********************************************************************// +// DispIntf: IEnvoyInfoDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {2A6E91B9-A874-38E4-99C2-C5D83D78140D} +// *********************************************************************// + IEnvoyInfoDisp = dispinterface + ['{2A6E91B9-A874-38E4-99C2-C5D83D78140D}'] + property EnvoySinks: IMessageSink readonly dispid 1610743808; + end; + {$EXTERNALSYM IEnvoyInfoDisp} + +// *********************************************************************// +// Interface: _ObjRef +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1DD3CF3D-DF8E-32FF-91EC-E19AA10B63FB} +// *********************************************************************// + _ObjRef = interface(IDispatch) + ['{1DD3CF3D-DF8E-32FF-91EC-E19AA10B63FB}'] + end; + +// *********************************************************************// +// DispIntf: _ObjRefDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1DD3CF3D-DF8E-32FF-91EC-E19AA10B63FB} +// *********************************************************************// + _ObjRefDisp = dispinterface + ['{1DD3CF3D-DF8E-32FF-91EC-E19AA10B63FB}'] + end; + {$EXTERNALSYM _ObjRefDisp} + +// *********************************************************************// +// Interface: _OneWayAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8FFEDC68-5233-3FA8-813D-405AABB33ECB} +// *********************************************************************// + _OneWayAttribute = interface(IDispatch) + ['{8FFEDC68-5233-3FA8-813D-405AABB33ECB}'] + end; + +// *********************************************************************// +// DispIntf: _OneWayAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8FFEDC68-5233-3FA8-813D-405AABB33ECB} +// *********************************************************************// + _OneWayAttributeDisp = dispinterface + ['{8FFEDC68-5233-3FA8-813D-405AABB33ECB}'] + end; + {$EXTERNALSYM _OneWayAttributeDisp} + +// *********************************************************************// +// Interface: _ProxyAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D80FF312-2930-3680-A5E9-B48296C7415F} +// *********************************************************************// + _ProxyAttribute = interface(IDispatch) + ['{D80FF312-2930-3680-A5E9-B48296C7415F}'] + end; + +// *********************************************************************// +// DispIntf: _ProxyAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D80FF312-2930-3680-A5E9-B48296C7415F} +// *********************************************************************// + _ProxyAttributeDisp = dispinterface + ['{D80FF312-2930-3680-A5E9-B48296C7415F}'] + end; + {$EXTERNALSYM _ProxyAttributeDisp} + +// *********************************************************************// +// Interface: _RealProxy +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E0CF3F77-C7C3-33DA-BEB4-46147FC905DE} +// *********************************************************************// + _RealProxy = interface(IDispatch) + ['{E0CF3F77-C7C3-33DA-BEB4-46147FC905DE}'] + end; + +// *********************************************************************// +// DispIntf: _RealProxyDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E0CF3F77-C7C3-33DA-BEB4-46147FC905DE} +// *********************************************************************// + _RealProxyDisp = dispinterface + ['{E0CF3F77-C7C3-33DA-BEB4-46147FC905DE}'] + end; + {$EXTERNALSYM _RealProxyDisp} + +// *********************************************************************// +// Interface: _SoapAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {725692A5-9E12-37F6-911C-E3DA77E5FACA} +// *********************************************************************// + _SoapAttribute = interface(IDispatch) + ['{725692A5-9E12-37F6-911C-E3DA77E5FACA}'] + end; + +// *********************************************************************// +// DispIntf: _SoapAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {725692A5-9E12-37F6-911C-E3DA77E5FACA} +// *********************************************************************// + _SoapAttributeDisp = dispinterface + ['{725692A5-9E12-37F6-911C-E3DA77E5FACA}'] + end; + {$EXTERNALSYM _SoapAttributeDisp} + +// *********************************************************************// +// Interface: _SoapTypeAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {EBCDCD84-8C74-39FD-821C-F5EB3A2704D7} +// *********************************************************************// + _SoapTypeAttribute = interface(IDispatch) + ['{EBCDCD84-8C74-39FD-821C-F5EB3A2704D7}'] + end; + +// *********************************************************************// +// DispIntf: _SoapTypeAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {EBCDCD84-8C74-39FD-821C-F5EB3A2704D7} +// *********************************************************************// + _SoapTypeAttributeDisp = dispinterface + ['{EBCDCD84-8C74-39FD-821C-F5EB3A2704D7}'] + end; + {$EXTERNALSYM _SoapTypeAttributeDisp} + +// *********************************************************************// +// Interface: _SoapMethodAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C58145B5-BD5A-3896-95D9-B358F54FBC44} +// *********************************************************************// + _SoapMethodAttribute = interface(IDispatch) + ['{C58145B5-BD5A-3896-95D9-B358F54FBC44}'] + end; + +// *********************************************************************// +// DispIntf: _SoapMethodAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C58145B5-BD5A-3896-95D9-B358F54FBC44} +// *********************************************************************// + _SoapMethodAttributeDisp = dispinterface + ['{C58145B5-BD5A-3896-95D9-B358F54FBC44}'] + end; + {$EXTERNALSYM _SoapMethodAttributeDisp} + +// *********************************************************************// +// Interface: _SoapFieldAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {46A3F9FF-F73C-33C7-BCC3-1BEF4B25E4AE} +// *********************************************************************// + _SoapFieldAttribute = interface(IDispatch) + ['{46A3F9FF-F73C-33C7-BCC3-1BEF4B25E4AE}'] + end; + +// *********************************************************************// +// DispIntf: _SoapFieldAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {46A3F9FF-F73C-33C7-BCC3-1BEF4B25E4AE} +// *********************************************************************// + _SoapFieldAttributeDisp = dispinterface + ['{46A3F9FF-F73C-33C7-BCC3-1BEF4B25E4AE}'] + end; + {$EXTERNALSYM _SoapFieldAttributeDisp} + +// *********************************************************************// +// Interface: _SoapParameterAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C32ABFC9-3917-30BF-A7BC-44250BDFC5D8} +// *********************************************************************// + _SoapParameterAttribute = interface(IDispatch) + ['{C32ABFC9-3917-30BF-A7BC-44250BDFC5D8}'] + end; + +// *********************************************************************// +// DispIntf: _SoapParameterAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C32ABFC9-3917-30BF-A7BC-44250BDFC5D8} +// *********************************************************************// + _SoapParameterAttributeDisp = dispinterface + ['{C32ABFC9-3917-30BF-A7BC-44250BDFC5D8}'] + end; + {$EXTERNALSYM _SoapParameterAttributeDisp} + +// *********************************************************************// +// Interface: _RemotingConfiguration +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4B10971E-D61D-373F-BC8D-2CCF31126215} +// *********************************************************************// + _RemotingConfiguration = interface(IDispatch) + ['{4B10971E-D61D-373F-BC8D-2CCF31126215}'] + end; + +// *********************************************************************// +// DispIntf: _RemotingConfigurationDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4B10971E-D61D-373F-BC8D-2CCF31126215} +// *********************************************************************// + _RemotingConfigurationDisp = dispinterface + ['{4B10971E-D61D-373F-BC8D-2CCF31126215}'] + end; + {$EXTERNALSYM _RemotingConfigurationDisp} + +// *********************************************************************// +// Interface: _System_Runtime_Remoting_TypeEntry +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8359F3AB-643F-3BCF-91E8-16E779EDEBE1} +// *********************************************************************// + _System_Runtime_Remoting_TypeEntry = interface(IDispatch) + ['{8359F3AB-643F-3BCF-91E8-16E779EDEBE1}'] + end; + +// *********************************************************************// +// DispIntf: _System_Runtime_Remoting_TypeEntryDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8359F3AB-643F-3BCF-91E8-16E779EDEBE1} +// *********************************************************************// + _System_Runtime_Remoting_TypeEntryDisp = dispinterface + ['{8359F3AB-643F-3BCF-91E8-16E779EDEBE1}'] + end; + {$EXTERNALSYM _System_Runtime_Remoting_TypeEntryDisp} + +// *********************************************************************// +// Interface: _ActivatedClientTypeEntry +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BAC12781-6865-3558-A8D1-F1CADD2806DD} +// *********************************************************************// + _ActivatedClientTypeEntry = interface(IDispatch) + ['{BAC12781-6865-3558-A8D1-F1CADD2806DD}'] + end; + +// *********************************************************************// +// DispIntf: _ActivatedClientTypeEntryDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BAC12781-6865-3558-A8D1-F1CADD2806DD} +// *********************************************************************// + _ActivatedClientTypeEntryDisp = dispinterface + ['{BAC12781-6865-3558-A8D1-F1CADD2806DD}'] + end; + {$EXTERNALSYM _ActivatedClientTypeEntryDisp} + +// *********************************************************************// +// Interface: _ActivatedServiceTypeEntry +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {94855A3B-5CA2-32CF-B1AB-48FD3915822C} +// *********************************************************************// + _ActivatedServiceTypeEntry = interface(IDispatch) + ['{94855A3B-5CA2-32CF-B1AB-48FD3915822C}'] + end; + +// *********************************************************************// +// DispIntf: _ActivatedServiceTypeEntryDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {94855A3B-5CA2-32CF-B1AB-48FD3915822C} +// *********************************************************************// + _ActivatedServiceTypeEntryDisp = dispinterface + ['{94855A3B-5CA2-32CF-B1AB-48FD3915822C}'] + end; + {$EXTERNALSYM _ActivatedServiceTypeEntryDisp} + +// *********************************************************************// +// Interface: _WellKnownClientTypeEntry +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4D0BC339-E3F9-3E9E-8F68-92168E6F6981} +// *********************************************************************// + _WellKnownClientTypeEntry = interface(IDispatch) + ['{4D0BC339-E3F9-3E9E-8F68-92168E6F6981}'] + end; + +// *********************************************************************// +// DispIntf: _WellKnownClientTypeEntryDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4D0BC339-E3F9-3E9E-8F68-92168E6F6981} +// *********************************************************************// + _WellKnownClientTypeEntryDisp = dispinterface + ['{4D0BC339-E3F9-3E9E-8F68-92168E6F6981}'] + end; + {$EXTERNALSYM _WellKnownClientTypeEntryDisp} + +// *********************************************************************// +// Interface: _WellKnownServiceTypeEntry +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {60B8B604-0AED-3093-AC05-EB98FB29FC47} +// *********************************************************************// + _WellKnownServiceTypeEntry = interface(IDispatch) + ['{60B8B604-0AED-3093-AC05-EB98FB29FC47}'] + end; + +// *********************************************************************// +// DispIntf: _WellKnownServiceTypeEntryDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {60B8B604-0AED-3093-AC05-EB98FB29FC47} +// *********************************************************************// + _WellKnownServiceTypeEntryDisp = dispinterface + ['{60B8B604-0AED-3093-AC05-EB98FB29FC47}'] + end; + {$EXTERNALSYM _WellKnownServiceTypeEntryDisp} + +// *********************************************************************// +// Interface: _RemotingException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7264843F-F60C-39A9-99E1-029126AA0815} +// *********************************************************************// + _RemotingException = interface(IDispatch) + ['{7264843F-F60C-39A9-99E1-029126AA0815}'] + end; + +// *********************************************************************// +// DispIntf: _RemotingExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7264843F-F60C-39A9-99E1-029126AA0815} +// *********************************************************************// + _RemotingExceptionDisp = dispinterface + ['{7264843F-F60C-39A9-99E1-029126AA0815}'] + end; + {$EXTERNALSYM _RemotingExceptionDisp} + +// *********************************************************************// +// Interface: _ServerException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {19373C44-55B4-3487-9AD8-4C621AAE85EA} +// *********************************************************************// + _ServerException = interface(IDispatch) + ['{19373C44-55B4-3487-9AD8-4C621AAE85EA}'] + end; + +// *********************************************************************// +// DispIntf: _ServerExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {19373C44-55B4-3487-9AD8-4C621AAE85EA} +// *********************************************************************// + _ServerExceptionDisp = dispinterface + ['{19373C44-55B4-3487-9AD8-4C621AAE85EA}'] + end; + {$EXTERNALSYM _ServerExceptionDisp} + +// *********************************************************************// +// Interface: _RemotingTimeoutException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {44DB8E15-ACB1-34EE-81F9-56ED7AE37A5C} +// *********************************************************************// + _RemotingTimeoutException = interface(IDispatch) + ['{44DB8E15-ACB1-34EE-81F9-56ED7AE37A5C}'] + end; + +// *********************************************************************// +// DispIntf: _RemotingTimeoutExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {44DB8E15-ACB1-34EE-81F9-56ED7AE37A5C} +// *********************************************************************// + _RemotingTimeoutExceptionDisp = dispinterface + ['{44DB8E15-ACB1-34EE-81F9-56ED7AE37A5C}'] + end; + {$EXTERNALSYM _RemotingTimeoutExceptionDisp} + +// *********************************************************************// +// Interface: _RemotingServices +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7B91368D-A50A-3D36-BE8E-5B8836A419AD} +// *********************************************************************// + _RemotingServices = interface(IDispatch) + ['{7B91368D-A50A-3D36-BE8E-5B8836A419AD}'] + end; + +// *********************************************************************// +// DispIntf: _RemotingServicesDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7B91368D-A50A-3D36-BE8E-5B8836A419AD} +// *********************************************************************// + _RemotingServicesDisp = dispinterface + ['{7B91368D-A50A-3D36-BE8E-5B8836A419AD}'] + end; + {$EXTERNALSYM _RemotingServicesDisp} + +// *********************************************************************// +// Interface: _InternalRemotingServices +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F4EFB305-CDC4-31C5-8102-33C9B91774F3} +// *********************************************************************// + _InternalRemotingServices = interface(IDispatch) + ['{F4EFB305-CDC4-31C5-8102-33C9B91774F3}'] + end; + +// *********************************************************************// +// DispIntf: _InternalRemotingServicesDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F4EFB305-CDC4-31C5-8102-33C9B91774F3} +// *********************************************************************// + _InternalRemotingServicesDisp = dispinterface + ['{F4EFB305-CDC4-31C5-8102-33C9B91774F3}'] + end; + {$EXTERNALSYM _InternalRemotingServicesDisp} + +// *********************************************************************// +// Interface: _MessageSurrogateFilter +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {04A35D22-0B08-34E7-A573-88EF2374375E} +// *********************************************************************// + _MessageSurrogateFilter = interface(IDispatch) + ['{04A35D22-0B08-34E7-A573-88EF2374375E}'] + end; + +// *********************************************************************// +// DispIntf: _MessageSurrogateFilterDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {04A35D22-0B08-34E7-A573-88EF2374375E} +// *********************************************************************// + _MessageSurrogateFilterDisp = dispinterface + ['{04A35D22-0B08-34E7-A573-88EF2374375E}'] + end; + {$EXTERNALSYM _MessageSurrogateFilterDisp} + +// *********************************************************************// +// Interface: _RemotingSurrogateSelector +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {551F7A57-8651-37DB-A94A-6A3CA09C0ED7} +// *********************************************************************// + _RemotingSurrogateSelector = interface(IDispatch) + ['{551F7A57-8651-37DB-A94A-6A3CA09C0ED7}'] + end; + +// *********************************************************************// +// DispIntf: _RemotingSurrogateSelectorDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {551F7A57-8651-37DB-A94A-6A3CA09C0ED7} +// *********************************************************************// + _RemotingSurrogateSelectorDisp = dispinterface + ['{551F7A57-8651-37DB-A94A-6A3CA09C0ED7}'] + end; + {$EXTERNALSYM _RemotingSurrogateSelectorDisp} + +// *********************************************************************// +// Interface: _SoapServices +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7416B6EE-82E8-3A16-966B-018A40E7B1AA} +// *********************************************************************// + _SoapServices = interface(IDispatch) + ['{7416B6EE-82E8-3A16-966B-018A40E7B1AA}'] + end; + +// *********************************************************************// +// DispIntf: _SoapServicesDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7416B6EE-82E8-3A16-966B-018A40E7B1AA} +// *********************************************************************// + _SoapServicesDisp = dispinterface + ['{7416B6EE-82E8-3A16-966B-018A40E7B1AA}'] + end; + {$EXTERNALSYM _SoapServicesDisp} + +// *********************************************************************// +// Interface: ISoapXsd +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {80031D2A-AD59-3FB4-97F3-B864D71DA86B} +// *********************************************************************// + ISoapXsd = interface(IDispatch) + ['{80031D2A-AD59-3FB4-97F3-B864D71DA86B}'] + function GetXsdType: WideString; safecall; + end; + +// *********************************************************************// +// DispIntf: ISoapXsdDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {80031D2A-AD59-3FB4-97F3-B864D71DA86B} +// *********************************************************************// + ISoapXsdDisp = dispinterface + ['{80031D2A-AD59-3FB4-97F3-B864D71DA86B}'] + function GetXsdType: WideString; dispid 1610743808; + end; + {$EXTERNALSYM ISoapXsdDisp} + +// *********************************************************************// +// Interface: _SoapDateTime +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1738ADBC-156E-3897-844F-C3147C528DEA} +// *********************************************************************// + _SoapDateTime = interface(IDispatch) + ['{1738ADBC-156E-3897-844F-C3147C528DEA}'] + end; + +// *********************************************************************// +// DispIntf: _SoapDateTimeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1738ADBC-156E-3897-844F-C3147C528DEA} +// *********************************************************************// + _SoapDateTimeDisp = dispinterface + ['{1738ADBC-156E-3897-844F-C3147C528DEA}'] + end; + {$EXTERNALSYM _SoapDateTimeDisp} + +// *********************************************************************// +// Interface: _SoapDuration +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7EF50DDB-32A5-30A1-B412-47FAB911404A} +// *********************************************************************// + _SoapDuration = interface(IDispatch) + ['{7EF50DDB-32A5-30A1-B412-47FAB911404A}'] + end; + +// *********************************************************************// +// DispIntf: _SoapDurationDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7EF50DDB-32A5-30A1-B412-47FAB911404A} +// *********************************************************************// + _SoapDurationDisp = dispinterface + ['{7EF50DDB-32A5-30A1-B412-47FAB911404A}'] + end; + {$EXTERNALSYM _SoapDurationDisp} + +// *********************************************************************// +// Interface: _SoapTime +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A3BF0BCD-EC32-38E6-92F2-5F37BAD8030D} +// *********************************************************************// + _SoapTime = interface(IDispatch) + ['{A3BF0BCD-EC32-38E6-92F2-5F37BAD8030D}'] + end; + +// *********************************************************************// +// DispIntf: _SoapTimeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A3BF0BCD-EC32-38E6-92F2-5F37BAD8030D} +// *********************************************************************// + _SoapTimeDisp = dispinterface + ['{A3BF0BCD-EC32-38E6-92F2-5F37BAD8030D}'] + end; + {$EXTERNALSYM _SoapTimeDisp} + +// *********************************************************************// +// Interface: _SoapDate +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {CFA6E9D2-B3DE-39A6-94D1-CC691DE193F8} +// *********************************************************************// + _SoapDate = interface(IDispatch) + ['{CFA6E9D2-B3DE-39A6-94D1-CC691DE193F8}'] + end; + +// *********************************************************************// +// DispIntf: _SoapDateDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {CFA6E9D2-B3DE-39A6-94D1-CC691DE193F8} +// *********************************************************************// + _SoapDateDisp = dispinterface + ['{CFA6E9D2-B3DE-39A6-94D1-CC691DE193F8}'] + end; + {$EXTERNALSYM _SoapDateDisp} + +// *********************************************************************// +// Interface: _SoapYearMonth +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {103C7EF9-A9EE-35FB-84C5-3086C9725A20} +// *********************************************************************// + _SoapYearMonth = interface(IDispatch) + ['{103C7EF9-A9EE-35FB-84C5-3086C9725A20}'] + end; + +// *********************************************************************// +// DispIntf: _SoapYearMonthDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {103C7EF9-A9EE-35FB-84C5-3086C9725A20} +// *********************************************************************// + _SoapYearMonthDisp = dispinterface + ['{103C7EF9-A9EE-35FB-84C5-3086C9725A20}'] + end; + {$EXTERNALSYM _SoapYearMonthDisp} + +// *********************************************************************// +// Interface: _SoapYear +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C20769F3-858D-316A-BE6D-C347A47948AD} +// *********************************************************************// + _SoapYear = interface(IDispatch) + ['{C20769F3-858D-316A-BE6D-C347A47948AD}'] + end; + +// *********************************************************************// +// DispIntf: _SoapYearDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C20769F3-858D-316A-BE6D-C347A47948AD} +// *********************************************************************// + _SoapYearDisp = dispinterface + ['{C20769F3-858D-316A-BE6D-C347A47948AD}'] + end; + {$EXTERNALSYM _SoapYearDisp} + +// *********************************************************************// +// Interface: _SoapMonthDay +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F9EAD0AA-4156-368F-AE05-FD59D70F758D} +// *********************************************************************// + _SoapMonthDay = interface(IDispatch) + ['{F9EAD0AA-4156-368F-AE05-FD59D70F758D}'] + end; + +// *********************************************************************// +// DispIntf: _SoapMonthDayDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F9EAD0AA-4156-368F-AE05-FD59D70F758D} +// *********************************************************************// + _SoapMonthDayDisp = dispinterface + ['{F9EAD0AA-4156-368F-AE05-FD59D70F758D}'] + end; + {$EXTERNALSYM _SoapMonthDayDisp} + +// *********************************************************************// +// Interface: _SoapDay +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D9E8314D-5053-3497-8A33-97D3DCFE33E2} +// *********************************************************************// + _SoapDay = interface(IDispatch) + ['{D9E8314D-5053-3497-8A33-97D3DCFE33E2}'] + end; + +// *********************************************************************// +// DispIntf: _SoapDayDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D9E8314D-5053-3497-8A33-97D3DCFE33E2} +// *********************************************************************// + _SoapDayDisp = dispinterface + ['{D9E8314D-5053-3497-8A33-97D3DCFE33E2}'] + end; + {$EXTERNALSYM _SoapDayDisp} + +// *********************************************************************// +// Interface: _SoapMonth +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B4E32423-E473-3562-AA12-62FDE5A7D4A2} +// *********************************************************************// + _SoapMonth = interface(IDispatch) + ['{B4E32423-E473-3562-AA12-62FDE5A7D4A2}'] + end; + +// *********************************************************************// +// DispIntf: _SoapMonthDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B4E32423-E473-3562-AA12-62FDE5A7D4A2} +// *********************************************************************// + _SoapMonthDisp = dispinterface + ['{B4E32423-E473-3562-AA12-62FDE5A7D4A2}'] + end; + {$EXTERNALSYM _SoapMonthDisp} + +// *********************************************************************// +// Interface: _SoapHexBinary +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {63B9DA95-FB91-358A-B7B7-90C34AA34AB7} +// *********************************************************************// + _SoapHexBinary = interface(IDispatch) + ['{63B9DA95-FB91-358A-B7B7-90C34AA34AB7}'] + end; + +// *********************************************************************// +// DispIntf: _SoapHexBinaryDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {63B9DA95-FB91-358A-B7B7-90C34AA34AB7} +// *********************************************************************// + _SoapHexBinaryDisp = dispinterface + ['{63B9DA95-FB91-358A-B7B7-90C34AA34AB7}'] + end; + {$EXTERNALSYM _SoapHexBinaryDisp} + +// *********************************************************************// +// Interface: _SoapBase64Binary +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8ED115A1-5E7B-34DC-AB85-90316F28015D} +// *********************************************************************// + _SoapBase64Binary = interface(IDispatch) + ['{8ED115A1-5E7B-34DC-AB85-90316F28015D}'] + end; + +// *********************************************************************// +// DispIntf: _SoapBase64BinaryDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {8ED115A1-5E7B-34DC-AB85-90316F28015D} +// *********************************************************************// + _SoapBase64BinaryDisp = dispinterface + ['{8ED115A1-5E7B-34DC-AB85-90316F28015D}'] + end; + {$EXTERNALSYM _SoapBase64BinaryDisp} + +// *********************************************************************// +// Interface: _SoapInteger +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {30C65C40-4E54-3051-9D8F-4709B6AB214C} +// *********************************************************************// + _SoapInteger = interface(IDispatch) + ['{30C65C40-4E54-3051-9D8F-4709B6AB214C}'] + end; + +// *********************************************************************// +// DispIntf: _SoapIntegerDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {30C65C40-4E54-3051-9D8F-4709B6AB214C} +// *********************************************************************// + _SoapIntegerDisp = dispinterface + ['{30C65C40-4E54-3051-9D8F-4709B6AB214C}'] + end; + {$EXTERNALSYM _SoapIntegerDisp} + +// *********************************************************************// +// Interface: _SoapPositiveInteger +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4979EC29-C2B7-3AD6-986D-5AAF7344CC4E} +// *********************************************************************// + _SoapPositiveInteger = interface(IDispatch) + ['{4979EC29-C2B7-3AD6-986D-5AAF7344CC4E}'] + end; + +// *********************************************************************// +// DispIntf: _SoapPositiveIntegerDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4979EC29-C2B7-3AD6-986D-5AAF7344CC4E} +// *********************************************************************// + _SoapPositiveIntegerDisp = dispinterface + ['{4979EC29-C2B7-3AD6-986D-5AAF7344CC4E}'] + end; + {$EXTERNALSYM _SoapPositiveIntegerDisp} + +// *********************************************************************// +// Interface: _SoapNonPositiveInteger +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AAF5401E-F71C-3FE3-8A73-A25074B20D3A} +// *********************************************************************// + _SoapNonPositiveInteger = interface(IDispatch) + ['{AAF5401E-F71C-3FE3-8A73-A25074B20D3A}'] + end; + +// *********************************************************************// +// DispIntf: _SoapNonPositiveIntegerDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AAF5401E-F71C-3FE3-8A73-A25074B20D3A} +// *********************************************************************// + _SoapNonPositiveIntegerDisp = dispinterface + ['{AAF5401E-F71C-3FE3-8A73-A25074B20D3A}'] + end; + {$EXTERNALSYM _SoapNonPositiveIntegerDisp} + +// *********************************************************************// +// Interface: _SoapNonNegativeInteger +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BC261FC6-7132-3FB5-9AAC-224845D3AA99} +// *********************************************************************// + _SoapNonNegativeInteger = interface(IDispatch) + ['{BC261FC6-7132-3FB5-9AAC-224845D3AA99}'] + end; + +// *********************************************************************// +// DispIntf: _SoapNonNegativeIntegerDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BC261FC6-7132-3FB5-9AAC-224845D3AA99} +// *********************************************************************// + _SoapNonNegativeIntegerDisp = dispinterface + ['{BC261FC6-7132-3FB5-9AAC-224845D3AA99}'] + end; + {$EXTERNALSYM _SoapNonNegativeIntegerDisp} + +// *********************************************************************// +// Interface: _SoapNegativeInteger +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E384AA10-A70C-3943-97CF-0F7C282C3BDC} +// *********************************************************************// + _SoapNegativeInteger = interface(IDispatch) + ['{E384AA10-A70C-3943-97CF-0F7C282C3BDC}'] + end; + +// *********************************************************************// +// DispIntf: _SoapNegativeIntegerDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E384AA10-A70C-3943-97CF-0F7C282C3BDC} +// *********************************************************************// + _SoapNegativeIntegerDisp = dispinterface + ['{E384AA10-A70C-3943-97CF-0F7C282C3BDC}'] + end; + {$EXTERNALSYM _SoapNegativeIntegerDisp} + +// *********************************************************************// +// Interface: _SoapAnyUri +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {818EC118-BE7E-3CDE-92C8-44B99160920E} +// *********************************************************************// + _SoapAnyUri = interface(IDispatch) + ['{818EC118-BE7E-3CDE-92C8-44B99160920E}'] + end; + +// *********************************************************************// +// DispIntf: _SoapAnyUriDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {818EC118-BE7E-3CDE-92C8-44B99160920E} +// *********************************************************************// + _SoapAnyUriDisp = dispinterface + ['{818EC118-BE7E-3CDE-92C8-44B99160920E}'] + end; + {$EXTERNALSYM _SoapAnyUriDisp} + +// *********************************************************************// +// Interface: _SoapQName +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3AC646B6-6B84-382F-9AED-22C2433244E6} +// *********************************************************************// + _SoapQName = interface(IDispatch) + ['{3AC646B6-6B84-382F-9AED-22C2433244E6}'] + end; + +// *********************************************************************// +// DispIntf: _SoapQNameDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3AC646B6-6B84-382F-9AED-22C2433244E6} +// *********************************************************************// + _SoapQNameDisp = dispinterface + ['{3AC646B6-6B84-382F-9AED-22C2433244E6}'] + end; + {$EXTERNALSYM _SoapQNameDisp} + +// *********************************************************************// +// Interface: _SoapNotation +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {974F01F4-6086-3137-9448-6A31FC9BEF08} +// *********************************************************************// + _SoapNotation = interface(IDispatch) + ['{974F01F4-6086-3137-9448-6A31FC9BEF08}'] + end; + +// *********************************************************************// +// DispIntf: _SoapNotationDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {974F01F4-6086-3137-9448-6A31FC9BEF08} +// *********************************************************************// + _SoapNotationDisp = dispinterface + ['{974F01F4-6086-3137-9448-6A31FC9BEF08}'] + end; + {$EXTERNALSYM _SoapNotationDisp} + +// *********************************************************************// +// Interface: _SoapNormalizedString +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F4926B50-3F23-37E0-9AFA-AA91FF89A7BD} +// *********************************************************************// + _SoapNormalizedString = interface(IDispatch) + ['{F4926B50-3F23-37E0-9AFA-AA91FF89A7BD}'] + end; + +// *********************************************************************// +// DispIntf: _SoapNormalizedStringDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F4926B50-3F23-37E0-9AFA-AA91FF89A7BD} +// *********************************************************************// + _SoapNormalizedStringDisp = dispinterface + ['{F4926B50-3F23-37E0-9AFA-AA91FF89A7BD}'] + end; + {$EXTERNALSYM _SoapNormalizedStringDisp} + +// *********************************************************************// +// Interface: _SoapToken +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AB4E97B9-651D-36F4-AABA-28ACF5746624} +// *********************************************************************// + _SoapToken = interface(IDispatch) + ['{AB4E97B9-651D-36F4-AABA-28ACF5746624}'] + end; + +// *********************************************************************// +// DispIntf: _SoapTokenDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AB4E97B9-651D-36F4-AABA-28ACF5746624} +// *********************************************************************// + _SoapTokenDisp = dispinterface + ['{AB4E97B9-651D-36F4-AABA-28ACF5746624}'] + end; + {$EXTERNALSYM _SoapTokenDisp} + +// *********************************************************************// +// Interface: _SoapLanguage +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {14AED851-A168-3462-B877-8F9A01126653} +// *********************************************************************// + _SoapLanguage = interface(IDispatch) + ['{14AED851-A168-3462-B877-8F9A01126653}'] + end; + +// *********************************************************************// +// DispIntf: _SoapLanguageDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {14AED851-A168-3462-B877-8F9A01126653} +// *********************************************************************// + _SoapLanguageDisp = dispinterface + ['{14AED851-A168-3462-B877-8F9A01126653}'] + end; + {$EXTERNALSYM _SoapLanguageDisp} + +// *********************************************************************// +// Interface: _SoapName +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {5EB06BEF-4ADF-3CC1-A6F2-62F76886B13A} +// *********************************************************************// + _SoapName = interface(IDispatch) + ['{5EB06BEF-4ADF-3CC1-A6F2-62F76886B13A}'] + end; + +// *********************************************************************// +// DispIntf: _SoapNameDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {5EB06BEF-4ADF-3CC1-A6F2-62F76886B13A} +// *********************************************************************// + _SoapNameDisp = dispinterface + ['{5EB06BEF-4ADF-3CC1-A6F2-62F76886B13A}'] + end; + {$EXTERNALSYM _SoapNameDisp} + +// *********************************************************************// +// Interface: _SoapIdrefs +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7947A829-ADB5-34D0-9CC8-6C172742C803} +// *********************************************************************// + _SoapIdrefs = interface(IDispatch) + ['{7947A829-ADB5-34D0-9CC8-6C172742C803}'] + end; + +// *********************************************************************// +// DispIntf: _SoapIdrefsDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7947A829-ADB5-34D0-9CC8-6C172742C803} +// *********************************************************************// + _SoapIdrefsDisp = dispinterface + ['{7947A829-ADB5-34D0-9CC8-6C172742C803}'] + end; + {$EXTERNALSYM _SoapIdrefsDisp} + +// *********************************************************************// +// Interface: _SoapEntities +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {ACA96DA3-96ED-397E-8A72-EE1BE1025F5E} +// *********************************************************************// + _SoapEntities = interface(IDispatch) + ['{ACA96DA3-96ED-397E-8A72-EE1BE1025F5E}'] + end; + +// *********************************************************************// +// DispIntf: _SoapEntitiesDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {ACA96DA3-96ED-397E-8A72-EE1BE1025F5E} +// *********************************************************************// + _SoapEntitiesDisp = dispinterface + ['{ACA96DA3-96ED-397E-8A72-EE1BE1025F5E}'] + end; + {$EXTERNALSYM _SoapEntitiesDisp} + +// *********************************************************************// +// Interface: _SoapNmtoken +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E941FA15-E6C8-3DD4-B060-C0DDFBC0240A} +// *********************************************************************// + _SoapNmtoken = interface(IDispatch) + ['{E941FA15-E6C8-3DD4-B060-C0DDFBC0240A}'] + end; + +// *********************************************************************// +// DispIntf: _SoapNmtokenDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E941FA15-E6C8-3DD4-B060-C0DDFBC0240A} +// *********************************************************************// + _SoapNmtokenDisp = dispinterface + ['{E941FA15-E6C8-3DD4-B060-C0DDFBC0240A}'] + end; + {$EXTERNALSYM _SoapNmtokenDisp} + +// *********************************************************************// +// Interface: _SoapNmtokens +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A5E385AE-27FB-3708-BAF7-0BF1F3955747} +// *********************************************************************// + _SoapNmtokens = interface(IDispatch) + ['{A5E385AE-27FB-3708-BAF7-0BF1F3955747}'] + end; + +// *********************************************************************// +// DispIntf: _SoapNmtokensDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A5E385AE-27FB-3708-BAF7-0BF1F3955747} +// *********************************************************************// + _SoapNmtokensDisp = dispinterface + ['{A5E385AE-27FB-3708-BAF7-0BF1F3955747}'] + end; + {$EXTERNALSYM _SoapNmtokensDisp} + +// *********************************************************************// +// Interface: _SoapNcName +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {725CDAF7-B739-35C1-8463-E2A923E1F618} +// *********************************************************************// + _SoapNcName = interface(IDispatch) + ['{725CDAF7-B739-35C1-8463-E2A923E1F618}'] + end; + +// *********************************************************************// +// DispIntf: _SoapNcNameDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {725CDAF7-B739-35C1-8463-E2A923E1F618} +// *********************************************************************// + _SoapNcNameDisp = dispinterface + ['{725CDAF7-B739-35C1-8463-E2A923E1F618}'] + end; + {$EXTERNALSYM _SoapNcNameDisp} + +// *********************************************************************// +// Interface: _SoapId +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6A46B6A2-2D2C-3C67-AF67-AAE0175F17AE} +// *********************************************************************// + _SoapId = interface(IDispatch) + ['{6A46B6A2-2D2C-3C67-AF67-AAE0175F17AE}'] + end; + +// *********************************************************************// +// DispIntf: _SoapIdDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6A46B6A2-2D2C-3C67-AF67-AAE0175F17AE} +// *********************************************************************// + _SoapIdDisp = dispinterface + ['{6A46B6A2-2D2C-3C67-AF67-AAE0175F17AE}'] + end; + {$EXTERNALSYM _SoapIdDisp} + +// *********************************************************************// +// Interface: _SoapIdref +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7DB7FD83-DE89-38E1-9645-D4CABDE694C0} +// *********************************************************************// + _SoapIdref = interface(IDispatch) + ['{7DB7FD83-DE89-38E1-9645-D4CABDE694C0}'] + end; + +// *********************************************************************// +// DispIntf: _SoapIdrefDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7DB7FD83-DE89-38E1-9645-D4CABDE694C0} +// *********************************************************************// + _SoapIdrefDisp = dispinterface + ['{7DB7FD83-DE89-38E1-9645-D4CABDE694C0}'] + end; + {$EXTERNALSYM _SoapIdrefDisp} + +// *********************************************************************// +// Interface: _SoapEntity +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {37171746-B784-3586-A7D5-692A7604A66B} +// *********************************************************************// + _SoapEntity = interface(IDispatch) + ['{37171746-B784-3586-A7D5-692A7604A66B}'] + end; + +// *********************************************************************// +// DispIntf: _SoapEntityDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {37171746-B784-3586-A7D5-692A7604A66B} +// *********************************************************************// + _SoapEntityDisp = dispinterface + ['{37171746-B784-3586-A7D5-692A7604A66B}'] + end; + {$EXTERNALSYM _SoapEntityDisp} + +// *********************************************************************// +// Interface: _SynchronizationAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {2D985674-231C-33D4-B14D-F3A6BD2EBE19} +// *********************************************************************// + _SynchronizationAttribute = interface(IDispatch) + ['{2D985674-231C-33D4-B14D-F3A6BD2EBE19}'] + end; + +// *********************************************************************// +// DispIntf: _SynchronizationAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {2D985674-231C-33D4-B14D-F3A6BD2EBE19} +// *********************************************************************// + _SynchronizationAttributeDisp = dispinterface + ['{2D985674-231C-33D4-B14D-F3A6BD2EBE19}'] + end; + {$EXTERNALSYM _SynchronizationAttributeDisp} + +// *********************************************************************// +// Interface: ITrackingHandler +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {03EC7D10-17A5-3585-9A2E-0596FCAC3870} +// *********************************************************************// + ITrackingHandler = interface(IDispatch) + ['{03EC7D10-17A5-3585-9A2E-0596FCAC3870}'] + procedure MarshaledObject(obj: OleVariant; const or_: _ObjRef); safecall; + procedure UnmarshaledObject(obj: OleVariant; const or_: _ObjRef); safecall; + procedure DisconnectedObject(obj: OleVariant); safecall; + end; + +// *********************************************************************// +// DispIntf: ITrackingHandlerDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {03EC7D10-17A5-3585-9A2E-0596FCAC3870} +// *********************************************************************// + ITrackingHandlerDisp = dispinterface + ['{03EC7D10-17A5-3585-9A2E-0596FCAC3870}'] + procedure MarshaledObject(obj: OleVariant; const or_: _ObjRef); dispid 1610743808; + procedure UnmarshaledObject(obj: OleVariant; const or_: _ObjRef); dispid 1610743809; + procedure DisconnectedObject(obj: OleVariant); dispid 1610743810; + end; + {$EXTERNALSYM ITrackingHandlerDisp} + +// *********************************************************************// +// Interface: _TrackingServices +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F51728F2-2DEF-308C-874A-CBB1BAA9CF9E} +// *********************************************************************// + _TrackingServices = interface(IDispatch) + ['{F51728F2-2DEF-308C-874A-CBB1BAA9CF9E}'] + end; + +// *********************************************************************// +// DispIntf: _TrackingServicesDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F51728F2-2DEF-308C-874A-CBB1BAA9CF9E} +// *********************************************************************// + _TrackingServicesDisp = dispinterface + ['{F51728F2-2DEF-308C-874A-CBB1BAA9CF9E}'] + end; + {$EXTERNALSYM _TrackingServicesDisp} + +// *********************************************************************// +// Interface: _UrlAttribute +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {717105A3-739B-3BC3-A2B7-AD215903FAD2} +// *********************************************************************// + _UrlAttribute = interface(IDispatch) + ['{717105A3-739B-3BC3-A2B7-AD215903FAD2}'] + end; + +// *********************************************************************// +// DispIntf: _UrlAttributeDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {717105A3-739B-3BC3-A2B7-AD215903FAD2} +// *********************************************************************// + _UrlAttributeDisp = dispinterface + ['{717105A3-739B-3BC3-A2B7-AD215903FAD2}'] + end; + {$EXTERNALSYM _UrlAttributeDisp} + +// *********************************************************************// +// Interface: _IsolatedStorage +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {34EC3BD7-F2F6-3C20-A639-804BFF89DF65} +// *********************************************************************// + _IsolatedStorage = interface(IDispatch) + ['{34EC3BD7-F2F6-3C20-A639-804BFF89DF65}'] + end; + +// *********************************************************************// +// DispIntf: _IsolatedStorageDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {34EC3BD7-F2F6-3C20-A639-804BFF89DF65} +// *********************************************************************// + _IsolatedStorageDisp = dispinterface + ['{34EC3BD7-F2F6-3C20-A639-804BFF89DF65}'] + end; + {$EXTERNALSYM _IsolatedStorageDisp} + +// *********************************************************************// +// Interface: _IsolatedStorageFile +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6BBB7DEE-186F-3D51-9486-BE0A71E915CE} +// *********************************************************************// + _IsolatedStorageFile = interface(IDispatch) + ['{6BBB7DEE-186F-3D51-9486-BE0A71E915CE}'] + end; + +// *********************************************************************// +// DispIntf: _IsolatedStorageFileDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {6BBB7DEE-186F-3D51-9486-BE0A71E915CE} +// *********************************************************************// + _IsolatedStorageFileDisp = dispinterface + ['{6BBB7DEE-186F-3D51-9486-BE0A71E915CE}'] + end; + {$EXTERNALSYM _IsolatedStorageFileDisp} + +// *********************************************************************// +// Interface: _IsolatedStorageFileStream +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {68D5592B-47C8-381A-8D51-3925C16CF025} +// *********************************************************************// + _IsolatedStorageFileStream = interface(IDispatch) + ['{68D5592B-47C8-381A-8D51-3925C16CF025}'] + end; + +// *********************************************************************// +// DispIntf: _IsolatedStorageFileStreamDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {68D5592B-47C8-381A-8D51-3925C16CF025} +// *********************************************************************// + _IsolatedStorageFileStreamDisp = dispinterface + ['{68D5592B-47C8-381A-8D51-3925C16CF025}'] + end; + {$EXTERNALSYM _IsolatedStorageFileStreamDisp} + +// *********************************************************************// +// Interface: _IsolatedStorageException +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AEC2B0DE-9898-3607-B845-63E2E307CB5F} +// *********************************************************************// + _IsolatedStorageException = interface(IDispatch) + ['{AEC2B0DE-9898-3607-B845-63E2E307CB5F}'] + end; + +// *********************************************************************// +// DispIntf: _IsolatedStorageExceptionDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AEC2B0DE-9898-3607-B845-63E2E307CB5F} +// *********************************************************************// + _IsolatedStorageExceptionDisp = dispinterface + ['{AEC2B0DE-9898-3607-B845-63E2E307CB5F}'] + end; + {$EXTERNALSYM _IsolatedStorageExceptionDisp} + +// *********************************************************************// +// Interface: INormalizeForIsolatedStorage +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {F5006531-D4D7-319E-9EDA-9B4B65AD8D4F} +// *********************************************************************// + INormalizeForIsolatedStorage = interface(IDispatch) + ['{F5006531-D4D7-319E-9EDA-9B4B65AD8D4F}'] + function Normalize: OleVariant; safecall; + end; + +// *********************************************************************// +// DispIntf: INormalizeForIsolatedStorageDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {F5006531-D4D7-319E-9EDA-9B4B65AD8D4F} +// *********************************************************************// + INormalizeForIsolatedStorageDisp = dispinterface + ['{F5006531-D4D7-319E-9EDA-9B4B65AD8D4F}'] + function Normalize: OleVariant; dispid 1610743808; + end; + {$EXTERNALSYM INormalizeForIsolatedStorageDisp} + +// *********************************************************************// +// Interface: ISoapMessage +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {E699146C-7793-3455-9BEF-964C90D8F995} +// *********************************************************************// + ISoapMessage = interface(IDispatch) + ['{E699146C-7793-3455-9BEF-964C90D8F995}'] + function Get_ParamNames: PSafeArray; safecall; + procedure Set_ParamNames(pRetVal: PSafeArray); safecall; + function Get_ParamValues: PSafeArray; safecall; + procedure Set_ParamValues(pRetVal: PSafeArray); safecall; + function Get_ParamTypes: PSafeArray; safecall; + procedure Set_ParamTypes(pRetVal: PSafeArray); safecall; + function Get_MethodName: WideString; safecall; + procedure Set_MethodName(const pRetVal: WideString); safecall; + function Get_XmlNameSpace: WideString; safecall; + procedure Set_XmlNameSpace(const pRetVal: WideString); safecall; + function Get_headers: PSafeArray; safecall; + procedure Set_headers(pRetVal: PSafeArray); safecall; + property ParamNames: PSafeArray read Get_ParamNames; + property ParamValues: PSafeArray read Get_ParamValues; + property ParamTypes: PSafeArray read Get_ParamTypes; + property MethodName: WideString read Get_MethodName; + property XmlNameSpace: WideString read Get_XmlNameSpace; + property headers: PSafeArray read Get_headers; + end; + +// *********************************************************************// +// DispIntf: ISoapMessageDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {E699146C-7793-3455-9BEF-964C90D8F995} +// *********************************************************************// + ISoapMessageDisp = dispinterface + ['{E699146C-7793-3455-9BEF-964C90D8F995}'] + property ParamNames: {??PSafeArray}OleVariant readonly dispid 1610743808; + property ParamValues: {??PSafeArray}OleVariant readonly dispid 1610743810; + property ParamTypes: {??PSafeArray}OleVariant readonly dispid 1610743812; + property MethodName: WideString readonly dispid 1610743814; + property XmlNameSpace: WideString readonly dispid 1610743816; + property headers: {??PSafeArray}OleVariant readonly dispid 1610743818; + end; + {$EXTERNALSYM ISoapMessageDisp} + +// *********************************************************************// +// Interface: _InternalRM +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {361A5049-1BC8-35A9-946A-53A877902F25} +// *********************************************************************// + _InternalRM = interface(IDispatch) + ['{361A5049-1BC8-35A9-946A-53A877902F25}'] + end; + +// *********************************************************************// +// DispIntf: _InternalRMDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {361A5049-1BC8-35A9-946A-53A877902F25} +// *********************************************************************// + _InternalRMDisp = dispinterface + ['{361A5049-1BC8-35A9-946A-53A877902F25}'] + end; + {$EXTERNALSYM _InternalRMDisp} + +// *********************************************************************// +// Interface: _InternalST +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A864FB13-F945-3DC0-A01C-B903F944FC97} +// *********************************************************************// + _InternalST = interface(IDispatch) + ['{A864FB13-F945-3DC0-A01C-B903F944FC97}'] + end; + +// *********************************************************************// +// DispIntf: _InternalSTDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A864FB13-F945-3DC0-A01C-B903F944FC97} +// *********************************************************************// + _InternalSTDisp = dispinterface + ['{A864FB13-F945-3DC0-A01C-B903F944FC97}'] + end; + {$EXTERNALSYM _InternalSTDisp} + +// *********************************************************************// +// Interface: _SoapMessage +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BC0847B2-BD5C-37B3-BA67-7D2D54B17238} +// *********************************************************************// + _SoapMessage = interface(IDispatch) + ['{BC0847B2-BD5C-37B3-BA67-7D2D54B17238}'] + end; + +// *********************************************************************// +// DispIntf: _SoapMessageDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BC0847B2-BD5C-37B3-BA67-7D2D54B17238} +// *********************************************************************// + _SoapMessageDisp = dispinterface + ['{BC0847B2-BD5C-37B3-BA67-7D2D54B17238}'] + end; + {$EXTERNALSYM _SoapMessageDisp} + +// *********************************************************************// +// Interface: _SoapFault +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A1C392FC-314C-39D5-8DE6-1F8EBCA0A1E2} +// *********************************************************************// + _SoapFault = interface(IDispatch) + ['{A1C392FC-314C-39D5-8DE6-1F8EBCA0A1E2}'] + end; + +// *********************************************************************// +// DispIntf: _SoapFaultDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A1C392FC-314C-39D5-8DE6-1F8EBCA0A1E2} +// *********************************************************************// + _SoapFaultDisp = dispinterface + ['{A1C392FC-314C-39D5-8DE6-1F8EBCA0A1E2}'] + end; + {$EXTERNALSYM _SoapFaultDisp} + +// *********************************************************************// +// Interface: _ServerFault +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {02D1BD78-3BB6-37AD-A9F8-F7D5DA273E4E} +// *********************************************************************// + _ServerFault = interface(IDispatch) + ['{02D1BD78-3BB6-37AD-A9F8-F7D5DA273E4E}'] + end; + +// *********************************************************************// +// DispIntf: _ServerFaultDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {02D1BD78-3BB6-37AD-A9F8-F7D5DA273E4E} +// *********************************************************************// + _ServerFaultDisp = dispinterface + ['{02D1BD78-3BB6-37AD-A9F8-F7D5DA273E4E}'] + end; + {$EXTERNALSYM _ServerFaultDisp} + +// *********************************************************************// +// Interface: _BinaryFormatter +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3BCF0CB2-A849-375E-8189-1BA5F1F4A9B0} +// *********************************************************************// + _BinaryFormatter = interface(IDispatch) + ['{3BCF0CB2-A849-375E-8189-1BA5F1F4A9B0}'] + end; + +// *********************************************************************// +// DispIntf: _BinaryFormatterDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {3BCF0CB2-A849-375E-8189-1BA5F1F4A9B0} +// *********************************************************************// + _BinaryFormatterDisp = dispinterface + ['{3BCF0CB2-A849-375E-8189-1BA5F1F4A9B0}'] + end; + {$EXTERNALSYM _BinaryFormatterDisp} + +// *********************************************************************// +// Interface: _AssemblyBuilder +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BEBB2505-8B54-3443-AEAD-142A16DD9CC7} +// *********************************************************************// + _AssemblyBuilder = interface(IDispatch) + ['{BEBB2505-8B54-3443-AEAD-142A16DD9CC7}'] + end; + +// *********************************************************************// +// DispIntf: _AssemblyBuilderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BEBB2505-8B54-3443-AEAD-142A16DD9CC7} +// *********************************************************************// + _AssemblyBuilderDisp = dispinterface + ['{BEBB2505-8B54-3443-AEAD-142A16DD9CC7}'] + end; + {$EXTERNALSYM _AssemblyBuilderDisp} + +// *********************************************************************// +// Interface: _ConstructorBuilder +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {ED3E4384-D7E2-3FA7-8FFD-8940D330519A} +// *********************************************************************// + _ConstructorBuilder = interface(IDispatch) + ['{ED3E4384-D7E2-3FA7-8FFD-8940D330519A}'] + end; + +// *********************************************************************// +// DispIntf: _ConstructorBuilderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {ED3E4384-D7E2-3FA7-8FFD-8940D330519A} +// *********************************************************************// + _ConstructorBuilderDisp = dispinterface + ['{ED3E4384-D7E2-3FA7-8FFD-8940D330519A}'] + end; + {$EXTERNALSYM _ConstructorBuilderDisp} + +// *********************************************************************// +// Interface: _EventBuilder +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AADABA99-895D-3D65-9760-B1F12621FAE8} +// *********************************************************************// + _EventBuilder = interface(IDispatch) + ['{AADABA99-895D-3D65-9760-B1F12621FAE8}'] + end; + +// *********************************************************************// +// DispIntf: _EventBuilderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AADABA99-895D-3D65-9760-B1F12621FAE8} +// *********************************************************************// + _EventBuilderDisp = dispinterface + ['{AADABA99-895D-3D65-9760-B1F12621FAE8}'] + end; + {$EXTERNALSYM _EventBuilderDisp} + +// *********************************************************************// +// Interface: _FieldBuilder +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {CE1A3BF5-975E-30CC-97C9-1EF70F8F3993} +// *********************************************************************// + _FieldBuilder = interface(IDispatch) + ['{CE1A3BF5-975E-30CC-97C9-1EF70F8F3993}'] + end; + +// *********************************************************************// +// DispIntf: _FieldBuilderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {CE1A3BF5-975E-30CC-97C9-1EF70F8F3993} +// *********************************************************************// + _FieldBuilderDisp = dispinterface + ['{CE1A3BF5-975E-30CC-97C9-1EF70F8F3993}'] + end; + {$EXTERNALSYM _FieldBuilderDisp} + +// *********************************************************************// +// Interface: _ILGenerator +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A4924B27-6E3B-37F7-9B83-A4501955E6A7} +// *********************************************************************// + _ILGenerator = interface(IDispatch) + ['{A4924B27-6E3B-37F7-9B83-A4501955E6A7}'] + end; + +// *********************************************************************// +// DispIntf: _ILGeneratorDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A4924B27-6E3B-37F7-9B83-A4501955E6A7} +// *********************************************************************// + _ILGeneratorDisp = dispinterface + ['{A4924B27-6E3B-37F7-9B83-A4501955E6A7}'] + end; + {$EXTERNALSYM _ILGeneratorDisp} + +// *********************************************************************// +// Interface: _LocalBuilder +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4E6350D1-A08B-3DEC-9A3E-C465F9AEEC0C} +// *********************************************************************// + _LocalBuilder = interface(IDispatch) + ['{4E6350D1-A08B-3DEC-9A3E-C465F9AEEC0C}'] + end; + +// *********************************************************************// +// DispIntf: _LocalBuilderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {4E6350D1-A08B-3DEC-9A3E-C465F9AEEC0C} +// *********************************************************************// + _LocalBuilderDisp = dispinterface + ['{4E6350D1-A08B-3DEC-9A3E-C465F9AEEC0C}'] + end; + {$EXTERNALSYM _LocalBuilderDisp} + +// *********************************************************************// +// Interface: _MethodBuilder +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {007D8A14-FDF3-363E-9A0B-FEC0618260A2} +// *********************************************************************// + _MethodBuilder = interface(IDispatch) + ['{007D8A14-FDF3-363E-9A0B-FEC0618260A2}'] + end; + +// *********************************************************************// +// DispIntf: _MethodBuilderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {007D8A14-FDF3-363E-9A0B-FEC0618260A2} +// *********************************************************************// + _MethodBuilderDisp = dispinterface + ['{007D8A14-FDF3-363E-9A0B-FEC0618260A2}'] + end; + {$EXTERNALSYM _MethodBuilderDisp} + +// *********************************************************************// +// Interface: _CustomAttributeBuilder +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BE9ACCE8-AAFF-3B91-81AE-8211663F5CAD} +// *********************************************************************// + _CustomAttributeBuilder = interface(IDispatch) + ['{BE9ACCE8-AAFF-3B91-81AE-8211663F5CAD}'] + end; + +// *********************************************************************// +// DispIntf: _CustomAttributeBuilderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BE9ACCE8-AAFF-3B91-81AE-8211663F5CAD} +// *********************************************************************// + _CustomAttributeBuilderDisp = dispinterface + ['{BE9ACCE8-AAFF-3B91-81AE-8211663F5CAD}'] + end; + {$EXTERNALSYM _CustomAttributeBuilderDisp} + +// *********************************************************************// +// Interface: _MethodRental +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C2323C25-F57F-3880-8A4D-12EBEA7A5852} +// *********************************************************************// + _MethodRental = interface(IDispatch) + ['{C2323C25-F57F-3880-8A4D-12EBEA7A5852}'] + end; + +// *********************************************************************// +// DispIntf: _MethodRentalDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C2323C25-F57F-3880-8A4D-12EBEA7A5852} +// *********************************************************************// + _MethodRentalDisp = dispinterface + ['{C2323C25-F57F-3880-8A4D-12EBEA7A5852}'] + end; + {$EXTERNALSYM _MethodRentalDisp} + +// *********************************************************************// +// Interface: _ModuleBuilder +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D05FFA9A-04AF-3519-8EE1-8D93AD73430B} +// *********************************************************************// + _ModuleBuilder = interface(IDispatch) + ['{D05FFA9A-04AF-3519-8EE1-8D93AD73430B}'] + end; + +// *********************************************************************// +// DispIntf: _ModuleBuilderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D05FFA9A-04AF-3519-8EE1-8D93AD73430B} +// *********************************************************************// + _ModuleBuilderDisp = dispinterface + ['{D05FFA9A-04AF-3519-8EE1-8D93AD73430B}'] + end; + {$EXTERNALSYM _ModuleBuilderDisp} + +// *********************************************************************// +// Interface: _OpCodes +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1DB1CC2A-DA73-389E-828B-5C616F4FAC49} +// *********************************************************************// + _OpCodes = interface(IDispatch) + ['{1DB1CC2A-DA73-389E-828B-5C616F4FAC49}'] + end; + +// *********************************************************************// +// DispIntf: _OpCodesDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {1DB1CC2A-DA73-389E-828B-5C616F4FAC49} +// *********************************************************************// + _OpCodesDisp = dispinterface + ['{1DB1CC2A-DA73-389E-828B-5C616F4FAC49}'] + end; + {$EXTERNALSYM _OpCodesDisp} + +// *********************************************************************// +// Interface: _ParameterBuilder +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {36329EBA-F97A-3565-BC07-0ED5C6EF19FC} +// *********************************************************************// + _ParameterBuilder = interface(IDispatch) + ['{36329EBA-F97A-3565-BC07-0ED5C6EF19FC}'] + end; + +// *********************************************************************// +// DispIntf: _ParameterBuilderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {36329EBA-F97A-3565-BC07-0ED5C6EF19FC} +// *********************************************************************// + _ParameterBuilderDisp = dispinterface + ['{36329EBA-F97A-3565-BC07-0ED5C6EF19FC}'] + end; + {$EXTERNALSYM _ParameterBuilderDisp} + +// *********************************************************************// +// Interface: _PropertyBuilder +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {15F9A479-9397-3A63-ACBD-F51977FB0F02} +// *********************************************************************// + _PropertyBuilder = interface(IDispatch) + ['{15F9A479-9397-3A63-ACBD-F51977FB0F02}'] + end; + +// *********************************************************************// +// DispIntf: _PropertyBuilderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {15F9A479-9397-3A63-ACBD-F51977FB0F02} +// *********************************************************************// + _PropertyBuilderDisp = dispinterface + ['{15F9A479-9397-3A63-ACBD-F51977FB0F02}'] + end; + {$EXTERNALSYM _PropertyBuilderDisp} + +// *********************************************************************// +// Interface: _SignatureHelper +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7D13DD37-5A04-393C-BBCA-A5FEA802893D} +// *********************************************************************// + _SignatureHelper = interface(IDispatch) + ['{7D13DD37-5A04-393C-BBCA-A5FEA802893D}'] + end; + +// *********************************************************************// +// DispIntf: _SignatureHelperDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7D13DD37-5A04-393C-BBCA-A5FEA802893D} +// *********************************************************************// + _SignatureHelperDisp = dispinterface + ['{7D13DD37-5A04-393C-BBCA-A5FEA802893D}'] + end; + {$EXTERNALSYM _SignatureHelperDisp} + +// *********************************************************************// +// Interface: _TypeBuilder +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7E5678EE-48B3-3F83-B076-C58543498A58} +// *********************************************************************// + _TypeBuilder = interface(IDispatch) + ['{7E5678EE-48B3-3F83-B076-C58543498A58}'] + end; + +// *********************************************************************// +// DispIntf: _TypeBuilderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {7E5678EE-48B3-3F83-B076-C58543498A58} +// *********************************************************************// + _TypeBuilderDisp = dispinterface + ['{7E5678EE-48B3-3F83-B076-C58543498A58}'] + end; + {$EXTERNALSYM _TypeBuilderDisp} + +// *********************************************************************// +// Interface: _EnumBuilder +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C7BD73DE-9F85-3290-88EE-090B8BDFE2DF} +// *********************************************************************// + _EnumBuilder = interface(IDispatch) + ['{C7BD73DE-9F85-3290-88EE-090B8BDFE2DF}'] + end; + +// *********************************************************************// +// DispIntf: _EnumBuilderDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C7BD73DE-9F85-3290-88EE-090B8BDFE2DF} +// *********************************************************************// + _EnumBuilderDisp = dispinterface + ['{C7BD73DE-9F85-3290-88EE-090B8BDFE2DF}'] + end; + {$EXTERNALSYM _EnumBuilderDisp} + +// *********************************************************************// +// The Class CoAppDomain provides a Create and CreateRemote method to +// create instances of the default interface _AppDomain exposed by +// the CoClass AppDomain. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAppDomain = class + class function Create: _AppDomain; + class function CreateRemote(const MachineName: string): _AppDomain; + end; + +// *********************************************************************// +// The Class CoRegistrationServices provides a Create and CreateRemote method to +// create instances of the default interface IRegistrationServices exposed by +// the CoClass RegistrationServices. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRegistrationServices = class + class function Create: IRegistrationServices; + class function CreateRemote(const MachineName: string): IRegistrationServices; + end; + +// *********************************************************************// +// The Class CoTypeLibConverter provides a Create and CreateRemote method to +// create instances of the default interface ITypeLibConverter exposed by +// the CoClass TypeLibConverter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTypeLibConverter = class + class function Create: ITypeLibConverter; + class function CreateRemote(const MachineName: string): ITypeLibConverter; + end; + +// *********************************************************************// +// The Class CoAppDomainSetup provides a Create and CreateRemote method to +// create instances of the default interface IAppDomainSetup exposed by +// the CoClass AppDomainSetup. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAppDomainSetup = class + class function Create: IAppDomainSetup; + class function CreateRemote(const MachineName: string): IAppDomainSetup; + end; + +// *********************************************************************// +// The Class CoObject_ provides a Create and CreateRemote method to +// create instances of the default interface _Object exposed by +// the CoClass Object_. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoObject_ = class + class function Create: _Object; + class function CreateRemote(const MachineName: string): _Object; + end; + +// *********************************************************************// +// The Class CoArray_ provides a Create and CreateRemote method to +// create instances of the default interface _Array exposed by +// the CoClass Array_. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoArray_ = class + class function Create: _Array; + class function CreateRemote(const MachineName: string): _Array; + end; + +// *********************************************************************// +// The Class CoString_ provides a Create and CreateRemote method to +// create instances of the default interface _String exposed by +// the CoClass String_. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoString_ = class + class function Create: _String; + class function CreateRemote(const MachineName: string): _String; + end; + +// *********************************************************************// +// The Class CoStringBuilder provides a Create and CreateRemote method to +// create instances of the default interface _StringBuilder exposed by +// the CoClass StringBuilder. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoStringBuilder = class + class function Create: _StringBuilder; + class function CreateRemote(const MachineName: string): _StringBuilder; + end; + +// *********************************************************************// +// The Class CoException provides a Create and CreateRemote method to +// create instances of the default interface _Exception exposed by +// the CoClass Exception. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoException = class + class function Create: _Exception; + class function CreateRemote(const MachineName: string): _Exception; + end; + +// *********************************************************************// +// The Class CoValueType provides a Create and CreateRemote method to +// create instances of the default interface _ValueType exposed by +// the CoClass ValueType. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoValueType = class + class function Create: _ValueType; + class function CreateRemote(const MachineName: string): _ValueType; + end; + +// *********************************************************************// +// The Class CoSystemException provides a Create and CreateRemote method to +// create instances of the default interface _SystemException exposed by +// the CoClass SystemException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSystemException = class + class function Create: _SystemException; + class function CreateRemote(const MachineName: string): _SystemException; + end; + +// *********************************************************************// +// The Class CoOutOfMemoryException provides a Create and CreateRemote method to +// create instances of the default interface _OutOfMemoryException exposed by +// the CoClass OutOfMemoryException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoOutOfMemoryException = class + class function Create: _OutOfMemoryException; + class function CreateRemote(const MachineName: string): _OutOfMemoryException; + end; + +// *********************************************************************// +// The Class CoStackOverflowException provides a Create and CreateRemote method to +// create instances of the default interface _StackOverflowException exposed by +// the CoClass StackOverflowException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoStackOverflowException = class + class function Create: _StackOverflowException; + class function CreateRemote(const MachineName: string): _StackOverflowException; + end; + +// *********************************************************************// +// The Class CoExecutionEngineException provides a Create and CreateRemote method to +// create instances of the default interface _ExecutionEngineException exposed by +// the CoClass ExecutionEngineException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoExecutionEngineException = class + class function Create: _ExecutionEngineException; + class function CreateRemote(const MachineName: string): _ExecutionEngineException; + end; + +// *********************************************************************// +// The Class CoDelegate provides a Create and CreateRemote method to +// create instances of the default interface _Delegate exposed by +// the CoClass Delegate. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDelegate = class + class function Create: _Delegate; + class function CreateRemote(const MachineName: string): _Delegate; + end; + +// *********************************************************************// +// The Class CoMulticastDelegate provides a Create and CreateRemote method to +// create instances of the default interface _MulticastDelegate exposed by +// the CoClass MulticastDelegate. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMulticastDelegate = class + class function Create: _MulticastDelegate; + class function CreateRemote(const MachineName: string): _MulticastDelegate; + end; + +// *********************************************************************// +// The Class CoEnum provides a Create and CreateRemote method to +// create instances of the default interface _Enum exposed by +// the CoClass Enum. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEnum = class + class function Create: _Enum; + class function CreateRemote(const MachineName: string): _Enum; + end; + +// *********************************************************************// +// The Class CoMemberAccessException provides a Create and CreateRemote method to +// create instances of the default interface _MemberAccessException exposed by +// the CoClass MemberAccessException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMemberAccessException = class + class function Create: _MemberAccessException; + class function CreateRemote(const MachineName: string): _MemberAccessException; + end; + +// *********************************************************************// +// The Class CoActivator provides a Create and CreateRemote method to +// create instances of the default interface _Activator exposed by +// the CoClass Activator. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoActivator = class + class function Create: _Activator; + class function CreateRemote(const MachineName: string): _Activator; + end; + +// *********************************************************************// +// The Class CoApplicationException provides a Create and CreateRemote method to +// create instances of the default interface _ApplicationException exposed by +// the CoClass ApplicationException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoApplicationException = class + class function Create: _ApplicationException; + class function CreateRemote(const MachineName: string): _ApplicationException; + end; + +// *********************************************************************// +// The Class CoEventArgs provides a Create and CreateRemote method to +// create instances of the default interface _EventArgs exposed by +// the CoClass EventArgs. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEventArgs = class + class function Create: _EventArgs; + class function CreateRemote(const MachineName: string): _EventArgs; + end; + +// *********************************************************************// +// The Class CoResolveEventArgs provides a Create and CreateRemote method to +// create instances of the default interface _ResolveEventArgs exposed by +// the CoClass ResolveEventArgs. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoResolveEventArgs = class + class function Create: _ResolveEventArgs; + class function CreateRemote(const MachineName: string): _ResolveEventArgs; + end; + +// *********************************************************************// +// The Class CoAssemblyLoadEventArgs provides a Create and CreateRemote method to +// create instances of the default interface _AssemblyLoadEventArgs exposed by +// the CoClass AssemblyLoadEventArgs. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAssemblyLoadEventArgs = class + class function Create: _AssemblyLoadEventArgs; + class function CreateRemote(const MachineName: string): _AssemblyLoadEventArgs; + end; + +// *********************************************************************// +// The Class CoResolveEventHandler provides a Create and CreateRemote method to +// create instances of the default interface _ResolveEventHandler exposed by +// the CoClass ResolveEventHandler. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoResolveEventHandler = class + class function Create: _ResolveEventHandler; + class function CreateRemote(const MachineName: string): _ResolveEventHandler; + end; + +// *********************************************************************// +// The Class CoAssemblyLoadEventHandler provides a Create and CreateRemote method to +// create instances of the default interface _AssemblyLoadEventHandler exposed by +// the CoClass AssemblyLoadEventHandler. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAssemblyLoadEventHandler = class + class function Create: _AssemblyLoadEventHandler; + class function CreateRemote(const MachineName: string): _AssemblyLoadEventHandler; + end; + +// *********************************************************************// +// The Class CoMarshalByRefObject provides a Create and CreateRemote method to +// create instances of the default interface _MarshalByRefObject exposed by +// the CoClass MarshalByRefObject. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMarshalByRefObject = class + class function Create: _MarshalByRefObject; + class function CreateRemote(const MachineName: string): _MarshalByRefObject; + end; + +// *********************************************************************// +// The Class CoCrossAppDomainDelegate provides a Create and CreateRemote method to +// create instances of the default interface _CrossAppDomainDelegate exposed by +// the CoClass CrossAppDomainDelegate. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCrossAppDomainDelegate = class + class function Create: _CrossAppDomainDelegate; + class function CreateRemote(const MachineName: string): _CrossAppDomainDelegate; + end; + +// *********************************************************************// +// The Class CoAttribute provides a Create and CreateRemote method to +// create instances of the default interface _Attribute exposed by +// the CoClass Attribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAttribute = class + class function Create: _Attribute; + class function CreateRemote(const MachineName: string): _Attribute; + end; + +// *********************************************************************// +// The Class CoLoaderOptimizationAttribute provides a Create and CreateRemote method to +// create instances of the default interface _LoaderOptimizationAttribute exposed by +// the CoClass LoaderOptimizationAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoLoaderOptimizationAttribute = class + class function Create: _LoaderOptimizationAttribute; + class function CreateRemote(const MachineName: string): _LoaderOptimizationAttribute; + end; + +// *********************************************************************// +// The Class CoAppDomainUnloadedException provides a Create and CreateRemote method to +// create instances of the default interface _AppDomainUnloadedException exposed by +// the CoClass AppDomainUnloadedException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAppDomainUnloadedException = class + class function Create: _AppDomainUnloadedException; + class function CreateRemote(const MachineName: string): _AppDomainUnloadedException; + end; + +// *********************************************************************// +// The Class CoArgumentException provides a Create and CreateRemote method to +// create instances of the default interface _ArgumentException exposed by +// the CoClass ArgumentException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoArgumentException = class + class function Create: _ArgumentException; + class function CreateRemote(const MachineName: string): _ArgumentException; + end; + +// *********************************************************************// +// The Class CoArgumentNullException provides a Create and CreateRemote method to +// create instances of the default interface _ArgumentNullException exposed by +// the CoClass ArgumentNullException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoArgumentNullException = class + class function Create: _ArgumentNullException; + class function CreateRemote(const MachineName: string): _ArgumentNullException; + end; + +// *********************************************************************// +// The Class CoArgumentOutOfRangeException provides a Create and CreateRemote method to +// create instances of the default interface _ArgumentOutOfRangeException exposed by +// the CoClass ArgumentOutOfRangeException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoArgumentOutOfRangeException = class + class function Create: _ArgumentOutOfRangeException; + class function CreateRemote(const MachineName: string): _ArgumentOutOfRangeException; + end; + +// *********************************************************************// +// The Class CoArithmeticException provides a Create and CreateRemote method to +// create instances of the default interface _ArithmeticException exposed by +// the CoClass ArithmeticException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoArithmeticException = class + class function Create: _ArithmeticException; + class function CreateRemote(const MachineName: string): _ArithmeticException; + end; + +// *********************************************************************// +// The Class CoArrayTypeMismatchException provides a Create and CreateRemote method to +// create instances of the default interface _ArrayTypeMismatchException exposed by +// the CoClass ArrayTypeMismatchException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoArrayTypeMismatchException = class + class function Create: _ArrayTypeMismatchException; + class function CreateRemote(const MachineName: string): _ArrayTypeMismatchException; + end; + +// *********************************************************************// +// The Class CoAsyncCallback provides a Create and CreateRemote method to +// create instances of the default interface _AsyncCallback exposed by +// the CoClass AsyncCallback. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAsyncCallback = class + class function Create: _AsyncCallback; + class function CreateRemote(const MachineName: string): _AsyncCallback; + end; + +// *********************************************************************// +// The Class CoAttributeUsageAttribute provides a Create and CreateRemote method to +// create instances of the default interface _AttributeUsageAttribute exposed by +// the CoClass AttributeUsageAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAttributeUsageAttribute = class + class function Create: _AttributeUsageAttribute; + class function CreateRemote(const MachineName: string): _AttributeUsageAttribute; + end; + +// *********************************************************************// +// The Class CoBadImageFormatException provides a Create and CreateRemote method to +// create instances of the default interface _BadImageFormatException exposed by +// the CoClass BadImageFormatException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoBadImageFormatException = class + class function Create: _BadImageFormatException; + class function CreateRemote(const MachineName: string): _BadImageFormatException; + end; + +// *********************************************************************// +// The Class CoBitConverter provides a Create and CreateRemote method to +// create instances of the default interface _BitConverter exposed by +// the CoClass BitConverter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoBitConverter = class + class function Create: _BitConverter; + class function CreateRemote(const MachineName: string): _BitConverter; + end; + +// *********************************************************************// +// The Class CoBuffer provides a Create and CreateRemote method to +// create instances of the default interface _Buffer exposed by +// the CoClass Buffer. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoBuffer = class + class function Create: _Buffer; + class function CreateRemote(const MachineName: string): _Buffer; + end; + +// *********************************************************************// +// The Class CoCannotUnloadAppDomainException provides a Create and CreateRemote method to +// create instances of the default interface _CannotUnloadAppDomainException exposed by +// the CoClass CannotUnloadAppDomainException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCannotUnloadAppDomainException = class + class function Create: _CannotUnloadAppDomainException; + class function CreateRemote(const MachineName: string): _CannotUnloadAppDomainException; + end; + +// *********************************************************************// +// The Class CoCharEnumerator provides a Create and CreateRemote method to +// create instances of the default interface _CharEnumerator exposed by +// the CoClass CharEnumerator. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCharEnumerator = class + class function Create: _CharEnumerator; + class function CreateRemote(const MachineName: string): _CharEnumerator; + end; + +// *********************************************************************// +// The Class CoCLSCompliantAttribute provides a Create and CreateRemote method to +// create instances of the default interface _CLSCompliantAttribute exposed by +// the CoClass CLSCompliantAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCLSCompliantAttribute = class + class function Create: _CLSCompliantAttribute; + class function CreateRemote(const MachineName: string): _CLSCompliantAttribute; + end; + +// *********************************************************************// +// The Class CoTypeUnloadedException provides a Create and CreateRemote method to +// create instances of the default interface _TypeUnloadedException exposed by +// the CoClass TypeUnloadedException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTypeUnloadedException = class + class function Create: _TypeUnloadedException; + class function CreateRemote(const MachineName: string): _TypeUnloadedException; + end; + +// *********************************************************************// +// The Class CoConsole provides a Create and CreateRemote method to +// create instances of the default interface _Console exposed by +// the CoClass Console. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoConsole = class + class function Create: _Console; + class function CreateRemote(const MachineName: string): _Console; + end; + +// *********************************************************************// +// The Class CoContextMarshalException provides a Create and CreateRemote method to +// create instances of the default interface _ContextMarshalException exposed by +// the CoClass ContextMarshalException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoContextMarshalException = class + class function Create: _ContextMarshalException; + class function CreateRemote(const MachineName: string): _ContextMarshalException; + end; + +// *********************************************************************// +// The Class CoConvert provides a Create and CreateRemote method to +// create instances of the default interface _Convert exposed by +// the CoClass Convert. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoConvert = class + class function Create: _Convert; + class function CreateRemote(const MachineName: string): _Convert; + end; + +// *********************************************************************// +// The Class CoContextBoundObject provides a Create and CreateRemote method to +// create instances of the default interface _ContextBoundObject exposed by +// the CoClass ContextBoundObject. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoContextBoundObject = class + class function Create: _ContextBoundObject; + class function CreateRemote(const MachineName: string): _ContextBoundObject; + end; + +// *********************************************************************// +// The Class CoContextStaticAttribute provides a Create and CreateRemote method to +// create instances of the default interface _ContextStaticAttribute exposed by +// the CoClass ContextStaticAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoContextStaticAttribute = class + class function Create: _ContextStaticAttribute; + class function CreateRemote(const MachineName: string): _ContextStaticAttribute; + end; + +// *********************************************************************// +// The Class CoTimeZone provides a Create and CreateRemote method to +// create instances of the default interface _TimeZone exposed by +// the CoClass TimeZone. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTimeZone = class + class function Create: _TimeZone; + class function CreateRemote(const MachineName: string): _TimeZone; + end; + +// *********************************************************************// +// The Class CoDBNull provides a Create and CreateRemote method to +// create instances of the default interface _DBNull exposed by +// the CoClass DBNull. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDBNull = class + class function Create: _DBNull; + class function CreateRemote(const MachineName: string): _DBNull; + end; + +// *********************************************************************// +// The Class CoBinder provides a Create and CreateRemote method to +// create instances of the default interface _Binder exposed by +// the CoClass Binder. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoBinder = class + class function Create: _Binder; + class function CreateRemote(const MachineName: string): _Binder; + end; + +// *********************************************************************// +// The Class CoDivideByZeroException provides a Create and CreateRemote method to +// create instances of the default interface _DivideByZeroException exposed by +// the CoClass DivideByZeroException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDivideByZeroException = class + class function Create: _DivideByZeroException; + class function CreateRemote(const MachineName: string): _DivideByZeroException; + end; + +// *********************************************************************// +// The Class CoDuplicateWaitObjectException provides a Create and CreateRemote method to +// create instances of the default interface _DuplicateWaitObjectException exposed by +// the CoClass DuplicateWaitObjectException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDuplicateWaitObjectException = class + class function Create: _DuplicateWaitObjectException; + class function CreateRemote(const MachineName: string): _DuplicateWaitObjectException; + end; + +// *********************************************************************// +// The Class CoTypeLoadException provides a Create and CreateRemote method to +// create instances of the default interface _TypeLoadException exposed by +// the CoClass TypeLoadException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTypeLoadException = class + class function Create: _TypeLoadException; + class function CreateRemote(const MachineName: string): _TypeLoadException; + end; + +// *********************************************************************// +// The Class CoEntryPointNotFoundException provides a Create and CreateRemote method to +// create instances of the default interface _EntryPointNotFoundException exposed by +// the CoClass EntryPointNotFoundException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEntryPointNotFoundException = class + class function Create: _EntryPointNotFoundException; + class function CreateRemote(const MachineName: string): _EntryPointNotFoundException; + end; + +// *********************************************************************// +// The Class CoDllNotFoundException provides a Create and CreateRemote method to +// create instances of the default interface _DllNotFoundException exposed by +// the CoClass DllNotFoundException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDllNotFoundException = class + class function Create: _DllNotFoundException; + class function CreateRemote(const MachineName: string): _DllNotFoundException; + end; + +// *********************************************************************// +// The Class CoEnvironment provides a Create and CreateRemote method to +// create instances of the default interface _Environment exposed by +// the CoClass Environment. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEnvironment = class + class function Create: _Environment; + class function CreateRemote(const MachineName: string): _Environment; + end; + +// *********************************************************************// +// The Class CoEventHandler provides a Create and CreateRemote method to +// create instances of the default interface _EventHandler exposed by +// the CoClass EventHandler. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEventHandler = class + class function Create: _EventHandler; + class function CreateRemote(const MachineName: string): _EventHandler; + end; + +// *********************************************************************// +// The Class CoFieldAccessException provides a Create and CreateRemote method to +// create instances of the default interface _FieldAccessException exposed by +// the CoClass FieldAccessException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFieldAccessException = class + class function Create: _FieldAccessException; + class function CreateRemote(const MachineName: string): _FieldAccessException; + end; + +// *********************************************************************// +// The Class CoFlagsAttribute provides a Create and CreateRemote method to +// create instances of the default interface _FlagsAttribute exposed by +// the CoClass FlagsAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFlagsAttribute = class + class function Create: _FlagsAttribute; + class function CreateRemote(const MachineName: string): _FlagsAttribute; + end; + +// *********************************************************************// +// The Class CoFormatException provides a Create and CreateRemote method to +// create instances of the default interface _FormatException exposed by +// the CoClass FormatException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFormatException = class + class function Create: _FormatException; + class function CreateRemote(const MachineName: string): _FormatException; + end; + +// *********************************************************************// +// The Class CoGC provides a Create and CreateRemote method to +// create instances of the default interface _GC exposed by +// the CoClass GC. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoGC = class + class function Create: _GC; + class function CreateRemote(const MachineName: string): _GC; + end; + +// *********************************************************************// +// The Class CoIndexOutOfRangeException provides a Create and CreateRemote method to +// create instances of the default interface _IndexOutOfRangeException exposed by +// the CoClass IndexOutOfRangeException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoIndexOutOfRangeException = class + class function Create: _IndexOutOfRangeException; + class function CreateRemote(const MachineName: string): _IndexOutOfRangeException; + end; + +// *********************************************************************// +// The Class CoInvalidCastException provides a Create and CreateRemote method to +// create instances of the default interface _InvalidCastException exposed by +// the CoClass InvalidCastException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoInvalidCastException = class + class function Create: _InvalidCastException; + class function CreateRemote(const MachineName: string): _InvalidCastException; + end; + +// *********************************************************************// +// The Class CoInvalidOperationException provides a Create and CreateRemote method to +// create instances of the default interface _InvalidOperationException exposed by +// the CoClass InvalidOperationException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoInvalidOperationException = class + class function Create: _InvalidOperationException; + class function CreateRemote(const MachineName: string): _InvalidOperationException; + end; + +// *********************************************************************// +// The Class CoInvalidProgramException provides a Create and CreateRemote method to +// create instances of the default interface _InvalidProgramException exposed by +// the CoClass InvalidProgramException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoInvalidProgramException = class + class function Create: _InvalidProgramException; + class function CreateRemote(const MachineName: string): _InvalidProgramException; + end; + +// *********************************************************************// +// The Class CoLocalDataStoreSlot provides a Create and CreateRemote method to +// create instances of the default interface _LocalDataStoreSlot exposed by +// the CoClass LocalDataStoreSlot. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoLocalDataStoreSlot = class + class function Create: _LocalDataStoreSlot; + class function CreateRemote(const MachineName: string): _LocalDataStoreSlot; + end; + +// *********************************************************************// +// The Class CoMath provides a Create and CreateRemote method to +// create instances of the default interface _Math exposed by +// the CoClass Math. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMath = class + class function Create: _Math; + class function CreateRemote(const MachineName: string): _Math; + end; + +// *********************************************************************// +// The Class CoMethodAccessException provides a Create and CreateRemote method to +// create instances of the default interface _MethodAccessException exposed by +// the CoClass MethodAccessException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMethodAccessException = class + class function Create: _MethodAccessException; + class function CreateRemote(const MachineName: string): _MethodAccessException; + end; + +// *********************************************************************// +// The Class CoMissingMemberException provides a Create and CreateRemote method to +// create instances of the default interface _MissingMemberException exposed by +// the CoClass MissingMemberException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMissingMemberException = class + class function Create: _MissingMemberException; + class function CreateRemote(const MachineName: string): _MissingMemberException; + end; + +// *********************************************************************// +// The Class CoMissingFieldException provides a Create and CreateRemote method to +// create instances of the default interface _MissingFieldException exposed by +// the CoClass MissingFieldException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMissingFieldException = class + class function Create: _MissingFieldException; + class function CreateRemote(const MachineName: string): _MissingFieldException; + end; + +// *********************************************************************// +// The Class CoMissingMethodException provides a Create and CreateRemote method to +// create instances of the default interface _MissingMethodException exposed by +// the CoClass MissingMethodException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMissingMethodException = class + class function Create: _MissingMethodException; + class function CreateRemote(const MachineName: string): _MissingMethodException; + end; + +// *********************************************************************// +// The Class CoMulticastNotSupportedException provides a Create and CreateRemote method to +// create instances of the default interface _MulticastNotSupportedException exposed by +// the CoClass MulticastNotSupportedException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMulticastNotSupportedException = class + class function Create: _MulticastNotSupportedException; + class function CreateRemote(const MachineName: string): _MulticastNotSupportedException; + end; + +// *********************************************************************// +// The Class CoNonSerializedAttribute provides a Create and CreateRemote method to +// create instances of the default interface _NonSerializedAttribute exposed by +// the CoClass NonSerializedAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoNonSerializedAttribute = class + class function Create: _NonSerializedAttribute; + class function CreateRemote(const MachineName: string): _NonSerializedAttribute; + end; + +// *********************************************************************// +// The Class CoNotFiniteNumberException provides a Create and CreateRemote method to +// create instances of the default interface _NotFiniteNumberException exposed by +// the CoClass NotFiniteNumberException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoNotFiniteNumberException = class + class function Create: _NotFiniteNumberException; + class function CreateRemote(const MachineName: string): _NotFiniteNumberException; + end; + +// *********************************************************************// +// The Class CoNotImplementedException provides a Create and CreateRemote method to +// create instances of the default interface _NotImplementedException exposed by +// the CoClass NotImplementedException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoNotImplementedException = class + class function Create: _NotImplementedException; + class function CreateRemote(const MachineName: string): _NotImplementedException; + end; + +// *********************************************************************// +// The Class CoNotSupportedException provides a Create and CreateRemote method to +// create instances of the default interface _NotSupportedException exposed by +// the CoClass NotSupportedException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoNotSupportedException = class + class function Create: _NotSupportedException; + class function CreateRemote(const MachineName: string): _NotSupportedException; + end; + +// *********************************************************************// +// The Class CoNullReferenceException provides a Create and CreateRemote method to +// create instances of the default interface _NullReferenceException exposed by +// the CoClass NullReferenceException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoNullReferenceException = class + class function Create: _NullReferenceException; + class function CreateRemote(const MachineName: string): _NullReferenceException; + end; + +// *********************************************************************// +// The Class CoObjectDisposedException provides a Create and CreateRemote method to +// create instances of the default interface _ObjectDisposedException exposed by +// the CoClass ObjectDisposedException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoObjectDisposedException = class + class function Create: _ObjectDisposedException; + class function CreateRemote(const MachineName: string): _ObjectDisposedException; + end; + +// *********************************************************************// +// The Class CoObsoleteAttribute provides a Create and CreateRemote method to +// create instances of the default interface _ObsoleteAttribute exposed by +// the CoClass ObsoleteAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoObsoleteAttribute = class + class function Create: _ObsoleteAttribute; + class function CreateRemote(const MachineName: string): _ObsoleteAttribute; + end; + +// *********************************************************************// +// The Class CoOperatingSystem provides a Create and CreateRemote method to +// create instances of the default interface _OperatingSystem exposed by +// the CoClass OperatingSystem. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoOperatingSystem = class + class function Create: _OperatingSystem; + class function CreateRemote(const MachineName: string): _OperatingSystem; + end; + +// *********************************************************************// +// The Class CoOverflowException provides a Create and CreateRemote method to +// create instances of the default interface _OverflowException exposed by +// the CoClass OverflowException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoOverflowException = class + class function Create: _OverflowException; + class function CreateRemote(const MachineName: string): _OverflowException; + end; + +// *********************************************************************// +// The Class CoParamArrayAttribute provides a Create and CreateRemote method to +// create instances of the default interface _ParamArrayAttribute exposed by +// the CoClass ParamArrayAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoParamArrayAttribute = class + class function Create: _ParamArrayAttribute; + class function CreateRemote(const MachineName: string): _ParamArrayAttribute; + end; + +// *********************************************************************// +// The Class CoPlatformNotSupportedException provides a Create and CreateRemote method to +// create instances of the default interface _PlatformNotSupportedException exposed by +// the CoClass PlatformNotSupportedException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoPlatformNotSupportedException = class + class function Create: _PlatformNotSupportedException; + class function CreateRemote(const MachineName: string): _PlatformNotSupportedException; + end; + +// *********************************************************************// +// The Class CoRandom provides a Create and CreateRemote method to +// create instances of the default interface _Random exposed by +// the CoClass Random. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRandom = class + class function Create: _Random; + class function CreateRemote(const MachineName: string): _Random; + end; + +// *********************************************************************// +// The Class CoRankException provides a Create and CreateRemote method to +// create instances of the default interface _RankException exposed by +// the CoClass RankException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRankException = class + class function Create: _RankException; + class function CreateRemote(const MachineName: string): _RankException; + end; + +// *********************************************************************// +// The Class CoMemberInfo provides a Create and CreateRemote method to +// create instances of the default interface _MemberInfo exposed by +// the CoClass MemberInfo. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMemberInfo = class + class function Create: _MemberInfo; + class function CreateRemote(const MachineName: string): _MemberInfo; + end; + +// *********************************************************************// +// The Class CoType_ provides a Create and CreateRemote method to +// create instances of the default interface _Type exposed by +// the CoClass Type_. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoType_ = class + class function Create: _Type; + class function CreateRemote(const MachineName: string): _Type; + end; + +// *********************************************************************// +// The Class CoSerializableAttribute provides a Create and CreateRemote method to +// create instances of the default interface _SerializableAttribute exposed by +// the CoClass SerializableAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSerializableAttribute = class + class function Create: _SerializableAttribute; + class function CreateRemote(const MachineName: string): _SerializableAttribute; + end; + +// *********************************************************************// +// The Class CoTypeInitializationException provides a Create and CreateRemote method to +// create instances of the default interface _TypeInitializationException exposed by +// the CoClass TypeInitializationException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTypeInitializationException = class + class function Create: _TypeInitializationException; + class function CreateRemote(const MachineName: string): _TypeInitializationException; + end; + +// *********************************************************************// +// The Class CoUnauthorizedAccessException provides a Create and CreateRemote method to +// create instances of the default interface _UnauthorizedAccessException exposed by +// the CoClass UnauthorizedAccessException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoUnauthorizedAccessException = class + class function Create: _UnauthorizedAccessException; + class function CreateRemote(const MachineName: string): _UnauthorizedAccessException; + end; + +// *********************************************************************// +// The Class CoUnhandledExceptionEventArgs provides a Create and CreateRemote method to +// create instances of the default interface _UnhandledExceptionEventArgs exposed by +// the CoClass UnhandledExceptionEventArgs. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoUnhandledExceptionEventArgs = class + class function Create: _UnhandledExceptionEventArgs; + class function CreateRemote(const MachineName: string): _UnhandledExceptionEventArgs; + end; + +// *********************************************************************// +// The Class CoUnhandledExceptionEventHandler provides a Create and CreateRemote method to +// create instances of the default interface _UnhandledExceptionEventHandler exposed by +// the CoClass UnhandledExceptionEventHandler. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoUnhandledExceptionEventHandler = class + class function Create: _UnhandledExceptionEventHandler; + class function CreateRemote(const MachineName: string): _UnhandledExceptionEventHandler; + end; + +// *********************************************************************// +// The Class CoVersion provides a Create and CreateRemote method to +// create instances of the default interface _Version exposed by +// the CoClass Version. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoVersion = class + class function Create: _Version; + class function CreateRemote(const MachineName: string): _Version; + end; + +// *********************************************************************// +// The Class CoWeakReference provides a Create and CreateRemote method to +// create instances of the default interface _WeakReference exposed by +// the CoClass WeakReference. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoWeakReference = class + class function Create: _WeakReference; + class function CreateRemote(const MachineName: string): _WeakReference; + end; + +// *********************************************************************// +// The Class CoWaitHandle provides a Create and CreateRemote method to +// create instances of the default interface _WaitHandle exposed by +// the CoClass WaitHandle. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoWaitHandle = class + class function Create: _WaitHandle; + class function CreateRemote(const MachineName: string): _WaitHandle; + end; + +// *********************************************************************// +// The Class CoAutoResetEvent provides a Create and CreateRemote method to +// create instances of the default interface _AutoResetEvent exposed by +// the CoClass AutoResetEvent. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAutoResetEvent = class + class function Create: _AutoResetEvent; + class function CreateRemote(const MachineName: string): _AutoResetEvent; + end; + +// *********************************************************************// +// The Class CoCompressedStack provides a Create and CreateRemote method to +// create instances of the default interface _CompressedStack exposed by +// the CoClass CompressedStack. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCompressedStack = class + class function Create: _CompressedStack; + class function CreateRemote(const MachineName: string): _CompressedStack; + end; + +// *********************************************************************// +// The Class CoInterlocked provides a Create and CreateRemote method to +// create instances of the default interface _Interlocked exposed by +// the CoClass Interlocked. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoInterlocked = class + class function Create: _Interlocked; + class function CreateRemote(const MachineName: string): _Interlocked; + end; + +// *********************************************************************// +// The Class CoManualResetEvent provides a Create and CreateRemote method to +// create instances of the default interface _ManualResetEvent exposed by +// the CoClass ManualResetEvent. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoManualResetEvent = class + class function Create: _ManualResetEvent; + class function CreateRemote(const MachineName: string): _ManualResetEvent; + end; + +// *********************************************************************// +// The Class CoMonitor provides a Create and CreateRemote method to +// create instances of the default interface _Monitor exposed by +// the CoClass Monitor. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMonitor = class + class function Create: _Monitor; + class function CreateRemote(const MachineName: string): _Monitor; + end; + +// *********************************************************************// +// The Class CoMutex provides a Create and CreateRemote method to +// create instances of the default interface _Mutex exposed by +// the CoClass Mutex. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMutex = class + class function Create: _Mutex; + class function CreateRemote(const MachineName: string): _Mutex; + end; + +// *********************************************************************// +// The Class CoOverlapped provides a Create and CreateRemote method to +// create instances of the default interface _Overlapped exposed by +// the CoClass Overlapped. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoOverlapped = class + class function Create: _Overlapped; + class function CreateRemote(const MachineName: string): _Overlapped; + end; + +// *********************************************************************// +// The Class CoReaderWriterLock provides a Create and CreateRemote method to +// create instances of the default interface _ReaderWriterLock exposed by +// the CoClass ReaderWriterLock. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoReaderWriterLock = class + class function Create: _ReaderWriterLock; + class function CreateRemote(const MachineName: string): _ReaderWriterLock; + end; + +// *********************************************************************// +// The Class CoSynchronizationLockException provides a Create and CreateRemote method to +// create instances of the default interface _SynchronizationLockException exposed by +// the CoClass SynchronizationLockException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSynchronizationLockException = class + class function Create: _SynchronizationLockException; + class function CreateRemote(const MachineName: string): _SynchronizationLockException; + end; + +// *********************************************************************// +// The Class CoThread provides a Create and CreateRemote method to +// create instances of the default interface _Thread exposed by +// the CoClass Thread. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoThread = class + class function Create: _Thread; + class function CreateRemote(const MachineName: string): _Thread; + end; + +// *********************************************************************// +// The Class CoThreadAbortException provides a Create and CreateRemote method to +// create instances of the default interface _ThreadAbortException exposed by +// the CoClass ThreadAbortException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoThreadAbortException = class + class function Create: _ThreadAbortException; + class function CreateRemote(const MachineName: string): _ThreadAbortException; + end; + +// *********************************************************************// +// The Class CoSTAThreadAttribute provides a Create and CreateRemote method to +// create instances of the default interface _STAThreadAttribute exposed by +// the CoClass STAThreadAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSTAThreadAttribute = class + class function Create: _STAThreadAttribute; + class function CreateRemote(const MachineName: string): _STAThreadAttribute; + end; + +// *********************************************************************// +// The Class CoMTAThreadAttribute provides a Create and CreateRemote method to +// create instances of the default interface _MTAThreadAttribute exposed by +// the CoClass MTAThreadAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMTAThreadAttribute = class + class function Create: _MTAThreadAttribute; + class function CreateRemote(const MachineName: string): _MTAThreadAttribute; + end; + +// *********************************************************************// +// The Class CoThreadInterruptedException provides a Create and CreateRemote method to +// create instances of the default interface _ThreadInterruptedException exposed by +// the CoClass ThreadInterruptedException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoThreadInterruptedException = class + class function Create: _ThreadInterruptedException; + class function CreateRemote(const MachineName: string): _ThreadInterruptedException; + end; + +// *********************************************************************// +// The Class CoRegisteredWaitHandle provides a Create and CreateRemote method to +// create instances of the default interface _RegisteredWaitHandle exposed by +// the CoClass RegisteredWaitHandle. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRegisteredWaitHandle = class + class function Create: _RegisteredWaitHandle; + class function CreateRemote(const MachineName: string): _RegisteredWaitHandle; + end; + +// *********************************************************************// +// The Class CoWaitCallback provides a Create and CreateRemote method to +// create instances of the default interface _WaitCallback exposed by +// the CoClass WaitCallback. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoWaitCallback = class + class function Create: _WaitCallback; + class function CreateRemote(const MachineName: string): _WaitCallback; + end; + +// *********************************************************************// +// The Class CoWaitOrTimerCallback provides a Create and CreateRemote method to +// create instances of the default interface _WaitOrTimerCallback exposed by +// the CoClass WaitOrTimerCallback. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoWaitOrTimerCallback = class + class function Create: _WaitOrTimerCallback; + class function CreateRemote(const MachineName: string): _WaitOrTimerCallback; + end; + +// *********************************************************************// +// The Class CoIOCompletionCallback provides a Create and CreateRemote method to +// create instances of the default interface _IOCompletionCallback exposed by +// the CoClass IOCompletionCallback. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoIOCompletionCallback = class + class function Create: _IOCompletionCallback; + class function CreateRemote(const MachineName: string): _IOCompletionCallback; + end; + +// *********************************************************************// +// The Class CoThreadPool provides a Create and CreateRemote method to +// create instances of the default interface _ThreadPool exposed by +// the CoClass ThreadPool. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoThreadPool = class + class function Create: _ThreadPool; + class function CreateRemote(const MachineName: string): _ThreadPool; + end; + +// *********************************************************************// +// The Class CoThreadStart provides a Create and CreateRemote method to +// create instances of the default interface _ThreadStart exposed by +// the CoClass ThreadStart. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoThreadStart = class + class function Create: _ThreadStart; + class function CreateRemote(const MachineName: string): _ThreadStart; + end; + +// *********************************************************************// +// The Class CoThreadStateException provides a Create and CreateRemote method to +// create instances of the default interface _ThreadStateException exposed by +// the CoClass ThreadStateException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoThreadStateException = class + class function Create: _ThreadStateException; + class function CreateRemote(const MachineName: string): _ThreadStateException; + end; + +// *********************************************************************// +// The Class CoThreadStaticAttribute provides a Create and CreateRemote method to +// create instances of the default interface _ThreadStaticAttribute exposed by +// the CoClass ThreadStaticAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoThreadStaticAttribute = class + class function Create: _ThreadStaticAttribute; + class function CreateRemote(const MachineName: string): _ThreadStaticAttribute; + end; + +// *********************************************************************// +// The Class CoTimeout provides a Create and CreateRemote method to +// create instances of the default interface _Timeout exposed by +// the CoClass Timeout. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTimeout = class + class function Create: _Timeout; + class function CreateRemote(const MachineName: string): _Timeout; + end; + +// *********************************************************************// +// The Class CoTimerCallback provides a Create and CreateRemote method to +// create instances of the default interface _TimerCallback exposed by +// the CoClass TimerCallback. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTimerCallback = class + class function Create: _TimerCallback; + class function CreateRemote(const MachineName: string): _TimerCallback; + end; + +// *********************************************************************// +// The Class CoTimer provides a Create and CreateRemote method to +// create instances of the default interface _Timer exposed by +// the CoClass Timer. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTimer = class + class function Create: _Timer; + class function CreateRemote(const MachineName: string): _Timer; + end; + +// *********************************************************************// +// The Class CoArrayList provides a Create and CreateRemote method to +// create instances of the default interface _ArrayList exposed by +// the CoClass ArrayList. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoArrayList = class + class function Create: _ArrayList; + class function CreateRemote(const MachineName: string): _ArrayList; + end; + +// *********************************************************************// +// The Class CoBitArray provides a Create and CreateRemote method to +// create instances of the default interface _BitArray exposed by +// the CoClass BitArray. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoBitArray = class + class function Create: _BitArray; + class function CreateRemote(const MachineName: string): _BitArray; + end; + +// *********************************************************************// +// The Class CoCaseInsensitiveComparer provides a Create and CreateRemote method to +// create instances of the default interface _CaseInsensitiveComparer exposed by +// the CoClass CaseInsensitiveComparer. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCaseInsensitiveComparer = class + class function Create: _CaseInsensitiveComparer; + class function CreateRemote(const MachineName: string): _CaseInsensitiveComparer; + end; + +// *********************************************************************// +// The Class CoCaseInsensitiveHashCodeProvider provides a Create and CreateRemote method to +// create instances of the default interface _CaseInsensitiveHashCodeProvider exposed by +// the CoClass CaseInsensitiveHashCodeProvider. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCaseInsensitiveHashCodeProvider = class + class function Create: _CaseInsensitiveHashCodeProvider; + class function CreateRemote(const MachineName: string): _CaseInsensitiveHashCodeProvider; + end; + +// *********************************************************************// +// The Class CoCollectionBase provides a Create and CreateRemote method to +// create instances of the default interface _CollectionBase exposed by +// the CoClass CollectionBase. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCollectionBase = class + class function Create: _CollectionBase; + class function CreateRemote(const MachineName: string): _CollectionBase; + end; + +// *********************************************************************// +// The Class CoComparer provides a Create and CreateRemote method to +// create instances of the default interface _Comparer exposed by +// the CoClass Comparer. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoComparer = class + class function Create: _Comparer; + class function CreateRemote(const MachineName: string): _Comparer; + end; + +// *********************************************************************// +// The Class CoDictionaryBase provides a Create and CreateRemote method to +// create instances of the default interface _DictionaryBase exposed by +// the CoClass DictionaryBase. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDictionaryBase = class + class function Create: _DictionaryBase; + class function CreateRemote(const MachineName: string): _DictionaryBase; + end; + +// *********************************************************************// +// The Class CoHashtable provides a Create and CreateRemote method to +// create instances of the default interface _Hashtable exposed by +// the CoClass Hashtable. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoHashtable = class + class function Create: _Hashtable; + class function CreateRemote(const MachineName: string): _Hashtable; + end; + +// *********************************************************************// +// The Class CoQueue provides a Create and CreateRemote method to +// create instances of the default interface _Queue exposed by +// the CoClass Queue. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoQueue = class + class function Create: _Queue; + class function CreateRemote(const MachineName: string): _Queue; + end; + +// *********************************************************************// +// The Class CoReadOnlyCollectionBase provides a Create and CreateRemote method to +// create instances of the default interface _ReadOnlyCollectionBase exposed by +// the CoClass ReadOnlyCollectionBase. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoReadOnlyCollectionBase = class + class function Create: _ReadOnlyCollectionBase; + class function CreateRemote(const MachineName: string): _ReadOnlyCollectionBase; + end; + +// *********************************************************************// +// The Class CoSortedList provides a Create and CreateRemote method to +// create instances of the default interface _SortedList exposed by +// the CoClass SortedList. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSortedList = class + class function Create: _SortedList; + class function CreateRemote(const MachineName: string): _SortedList; + end; + +// *********************************************************************// +// The Class CoStack provides a Create and CreateRemote method to +// create instances of the default interface _Stack exposed by +// the CoClass Stack. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoStack = class + class function Create: _Stack; + class function CreateRemote(const MachineName: string): _Stack; + end; + +// *********************************************************************// +// The Class CoConditionalAttribute provides a Create and CreateRemote method to +// create instances of the default interface _ConditionalAttribute exposed by +// the CoClass ConditionalAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoConditionalAttribute = class + class function Create: _ConditionalAttribute; + class function CreateRemote(const MachineName: string): _ConditionalAttribute; + end; + +// *********************************************************************// +// The Class CoDebugger provides a Create and CreateRemote method to +// create instances of the default interface _Debugger exposed by +// the CoClass Debugger. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDebugger = class + class function Create: _Debugger; + class function CreateRemote(const MachineName: string): _Debugger; + end; + +// *********************************************************************// +// The Class CoDebuggerStepThroughAttribute provides a Create and CreateRemote method to +// create instances of the default interface _DebuggerStepThroughAttribute exposed by +// the CoClass DebuggerStepThroughAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDebuggerStepThroughAttribute = class + class function Create: _DebuggerStepThroughAttribute; + class function CreateRemote(const MachineName: string): _DebuggerStepThroughAttribute; + end; + +// *********************************************************************// +// The Class CoDebuggerHiddenAttribute provides a Create and CreateRemote method to +// create instances of the default interface _DebuggerHiddenAttribute exposed by +// the CoClass DebuggerHiddenAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDebuggerHiddenAttribute = class + class function Create: _DebuggerHiddenAttribute; + class function CreateRemote(const MachineName: string): _DebuggerHiddenAttribute; + end; + +// *********************************************************************// +// The Class CoDebuggableAttribute provides a Create and CreateRemote method to +// create instances of the default interface _DebuggableAttribute exposed by +// the CoClass DebuggableAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDebuggableAttribute = class + class function Create: _DebuggableAttribute; + class function CreateRemote(const MachineName: string): _DebuggableAttribute; + end; + +// *********************************************************************// +// The Class CoStackTrace provides a Create and CreateRemote method to +// create instances of the default interface _StackTrace exposed by +// the CoClass StackTrace. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoStackTrace = class + class function Create: _StackTrace; + class function CreateRemote(const MachineName: string): _StackTrace; + end; + +// *********************************************************************// +// The Class CoStackFrame provides a Create and CreateRemote method to +// create instances of the default interface _StackFrame exposed by +// the CoClass StackFrame. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoStackFrame = class + class function Create: _StackFrame; + class function CreateRemote(const MachineName: string): _StackFrame; + end; + +// *********************************************************************// +// The Class CoSymDocumentType provides a Create and CreateRemote method to +// create instances of the default interface _SymDocumentType exposed by +// the CoClass SymDocumentType. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSymDocumentType = class + class function Create: _SymDocumentType; + class function CreateRemote(const MachineName: string): _SymDocumentType; + end; + +// *********************************************************************// +// The Class CoSymLanguageType provides a Create and CreateRemote method to +// create instances of the default interface _SymLanguageType exposed by +// the CoClass SymLanguageType. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSymLanguageType = class + class function Create: _SymLanguageType; + class function CreateRemote(const MachineName: string): _SymLanguageType; + end; + +// *********************************************************************// +// The Class CoSymLanguageVendor provides a Create and CreateRemote method to +// create instances of the default interface _SymLanguageVendor exposed by +// the CoClass SymLanguageVendor. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSymLanguageVendor = class + class function Create: _SymLanguageVendor; + class function CreateRemote(const MachineName: string): _SymLanguageVendor; + end; + +// *********************************************************************// +// The Class CoAmbiguousMatchException provides a Create and CreateRemote method to +// create instances of the default interface _AmbiguousMatchException exposed by +// the CoClass AmbiguousMatchException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAmbiguousMatchException = class + class function Create: _AmbiguousMatchException; + class function CreateRemote(const MachineName: string): _AmbiguousMatchException; + end; + +// *********************************************************************// +// The Class CoModuleResolveEventHandler provides a Create and CreateRemote method to +// create instances of the default interface _ModuleResolveEventHandler exposed by +// the CoClass ModuleResolveEventHandler. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoModuleResolveEventHandler = class + class function Create: _ModuleResolveEventHandler; + class function CreateRemote(const MachineName: string): _ModuleResolveEventHandler; + end; + +// *********************************************************************// +// The Class CoAssembly provides a Create and CreateRemote method to +// create instances of the default interface _Assembly exposed by +// the CoClass Assembly. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAssembly = class + class function Create: _Assembly; + class function CreateRemote(const MachineName: string): _Assembly; + end; + +// *********************************************************************// +// The Class CoAssemblyCultureAttribute provides a Create and CreateRemote method to +// create instances of the default interface _AssemblyCultureAttribute exposed by +// the CoClass AssemblyCultureAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAssemblyCultureAttribute = class + class function Create: _AssemblyCultureAttribute; + class function CreateRemote(const MachineName: string): _AssemblyCultureAttribute; + end; + +// *********************************************************************// +// The Class CoAssemblyVersionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _AssemblyVersionAttribute exposed by +// the CoClass AssemblyVersionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAssemblyVersionAttribute = class + class function Create: _AssemblyVersionAttribute; + class function CreateRemote(const MachineName: string): _AssemblyVersionAttribute; + end; + +// *********************************************************************// +// The Class CoAssemblyKeyFileAttribute provides a Create and CreateRemote method to +// create instances of the default interface _AssemblyKeyFileAttribute exposed by +// the CoClass AssemblyKeyFileAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAssemblyKeyFileAttribute = class + class function Create: _AssemblyKeyFileAttribute; + class function CreateRemote(const MachineName: string): _AssemblyKeyFileAttribute; + end; + +// *********************************************************************// +// The Class CoAssemblyKeyNameAttribute provides a Create and CreateRemote method to +// create instances of the default interface _AssemblyKeyNameAttribute exposed by +// the CoClass AssemblyKeyNameAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAssemblyKeyNameAttribute = class + class function Create: _AssemblyKeyNameAttribute; + class function CreateRemote(const MachineName: string): _AssemblyKeyNameAttribute; + end; + +// *********************************************************************// +// The Class CoAssemblyDelaySignAttribute provides a Create and CreateRemote method to +// create instances of the default interface _AssemblyDelaySignAttribute exposed by +// the CoClass AssemblyDelaySignAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAssemblyDelaySignAttribute = class + class function Create: _AssemblyDelaySignAttribute; + class function CreateRemote(const MachineName: string): _AssemblyDelaySignAttribute; + end; + +// *********************************************************************// +// The Class CoAssemblyAlgorithmIdAttribute provides a Create and CreateRemote method to +// create instances of the default interface _AssemblyAlgorithmIdAttribute exposed by +// the CoClass AssemblyAlgorithmIdAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAssemblyAlgorithmIdAttribute = class + class function Create: _AssemblyAlgorithmIdAttribute; + class function CreateRemote(const MachineName: string): _AssemblyAlgorithmIdAttribute; + end; + +// *********************************************************************// +// The Class CoAssemblyFlagsAttribute provides a Create and CreateRemote method to +// create instances of the default interface _AssemblyFlagsAttribute exposed by +// the CoClass AssemblyFlagsAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAssemblyFlagsAttribute = class + class function Create: _AssemblyFlagsAttribute; + class function CreateRemote(const MachineName: string): _AssemblyFlagsAttribute; + end; + +// *********************************************************************// +// The Class CoAssemblyFileVersionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _AssemblyFileVersionAttribute exposed by +// the CoClass AssemblyFileVersionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAssemblyFileVersionAttribute = class + class function Create: _AssemblyFileVersionAttribute; + class function CreateRemote(const MachineName: string): _AssemblyFileVersionAttribute; + end; + +// *********************************************************************// +// The Class CoAssemblyName provides a Create and CreateRemote method to +// create instances of the default interface _AssemblyName exposed by +// the CoClass AssemblyName. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAssemblyName = class + class function Create: _AssemblyName; + class function CreateRemote(const MachineName: string): _AssemblyName; + end; + +// *********************************************************************// +// The Class CoAssemblyNameProxy provides a Create and CreateRemote method to +// create instances of the default interface _AssemblyNameProxy exposed by +// the CoClass AssemblyNameProxy. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAssemblyNameProxy = class + class function Create: _AssemblyNameProxy; + class function CreateRemote(const MachineName: string): _AssemblyNameProxy; + end; + +// *********************************************************************// +// The Class CoAssemblyCopyrightAttribute provides a Create and CreateRemote method to +// create instances of the default interface _AssemblyCopyrightAttribute exposed by +// the CoClass AssemblyCopyrightAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAssemblyCopyrightAttribute = class + class function Create: _AssemblyCopyrightAttribute; + class function CreateRemote(const MachineName: string): _AssemblyCopyrightAttribute; + end; + +// *********************************************************************// +// The Class CoAssemblyTrademarkAttribute provides a Create and CreateRemote method to +// create instances of the default interface _AssemblyTrademarkAttribute exposed by +// the CoClass AssemblyTrademarkAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAssemblyTrademarkAttribute = class + class function Create: _AssemblyTrademarkAttribute; + class function CreateRemote(const MachineName: string): _AssemblyTrademarkAttribute; + end; + +// *********************************************************************// +// The Class CoAssemblyProductAttribute provides a Create and CreateRemote method to +// create instances of the default interface _AssemblyProductAttribute exposed by +// the CoClass AssemblyProductAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAssemblyProductAttribute = class + class function Create: _AssemblyProductAttribute; + class function CreateRemote(const MachineName: string): _AssemblyProductAttribute; + end; + +// *********************************************************************// +// The Class CoAssemblyCompanyAttribute provides a Create and CreateRemote method to +// create instances of the default interface _AssemblyCompanyAttribute exposed by +// the CoClass AssemblyCompanyAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAssemblyCompanyAttribute = class + class function Create: _AssemblyCompanyAttribute; + class function CreateRemote(const MachineName: string): _AssemblyCompanyAttribute; + end; + +// *********************************************************************// +// The Class CoAssemblyDescriptionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _AssemblyDescriptionAttribute exposed by +// the CoClass AssemblyDescriptionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAssemblyDescriptionAttribute = class + class function Create: _AssemblyDescriptionAttribute; + class function CreateRemote(const MachineName: string): _AssemblyDescriptionAttribute; + end; + +// *********************************************************************// +// The Class CoAssemblyTitleAttribute provides a Create and CreateRemote method to +// create instances of the default interface _AssemblyTitleAttribute exposed by +// the CoClass AssemblyTitleAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAssemblyTitleAttribute = class + class function Create: _AssemblyTitleAttribute; + class function CreateRemote(const MachineName: string): _AssemblyTitleAttribute; + end; + +// *********************************************************************// +// The Class CoAssemblyConfigurationAttribute provides a Create and CreateRemote method to +// create instances of the default interface _AssemblyConfigurationAttribute exposed by +// the CoClass AssemblyConfigurationAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAssemblyConfigurationAttribute = class + class function Create: _AssemblyConfigurationAttribute; + class function CreateRemote(const MachineName: string): _AssemblyConfigurationAttribute; + end; + +// *********************************************************************// +// The Class CoAssemblyDefaultAliasAttribute provides a Create and CreateRemote method to +// create instances of the default interface _AssemblyDefaultAliasAttribute exposed by +// the CoClass AssemblyDefaultAliasAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAssemblyDefaultAliasAttribute = class + class function Create: _AssemblyDefaultAliasAttribute; + class function CreateRemote(const MachineName: string): _AssemblyDefaultAliasAttribute; + end; + +// *********************************************************************// +// The Class CoAssemblyInformationalVersionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _AssemblyInformationalVersionAttribute exposed by +// the CoClass AssemblyInformationalVersionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAssemblyInformationalVersionAttribute = class + class function Create: _AssemblyInformationalVersionAttribute; + class function CreateRemote(const MachineName: string): _AssemblyInformationalVersionAttribute; + end; + +// *********************************************************************// +// The Class CoCustomAttributeFormatException provides a Create and CreateRemote method to +// create instances of the default interface _CustomAttributeFormatException exposed by +// the CoClass CustomAttributeFormatException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCustomAttributeFormatException = class + class function Create: _CustomAttributeFormatException; + class function CreateRemote(const MachineName: string): _CustomAttributeFormatException; + end; + +// *********************************************************************// +// The Class CoMethodBase provides a Create and CreateRemote method to +// create instances of the default interface _MethodBase exposed by +// the CoClass MethodBase. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMethodBase = class + class function Create: _MethodBase; + class function CreateRemote(const MachineName: string): _MethodBase; + end; + +// *********************************************************************// +// The Class CoConstructorInfo provides a Create and CreateRemote method to +// create instances of the default interface _ConstructorInfo exposed by +// the CoClass ConstructorInfo. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoConstructorInfo = class + class function Create: _ConstructorInfo; + class function CreateRemote(const MachineName: string): _ConstructorInfo; + end; + +// *********************************************************************// +// The Class CoDefaultMemberAttribute provides a Create and CreateRemote method to +// create instances of the default interface _DefaultMemberAttribute exposed by +// the CoClass DefaultMemberAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDefaultMemberAttribute = class + class function Create: _DefaultMemberAttribute; + class function CreateRemote(const MachineName: string): _DefaultMemberAttribute; + end; + +// *********************************************************************// +// The Class CoEventInfo provides a Create and CreateRemote method to +// create instances of the default interface _EventInfo exposed by +// the CoClass EventInfo. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEventInfo = class + class function Create: _EventInfo; + class function CreateRemote(const MachineName: string): _EventInfo; + end; + +// *********************************************************************// +// The Class CoFieldInfo provides a Create and CreateRemote method to +// create instances of the default interface _FieldInfo exposed by +// the CoClass FieldInfo. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFieldInfo = class + class function Create: _FieldInfo; + class function CreateRemote(const MachineName: string): _FieldInfo; + end; + +// *********************************************************************// +// The Class CoInvalidFilterCriteriaException provides a Create and CreateRemote method to +// create instances of the default interface _InvalidFilterCriteriaException exposed by +// the CoClass InvalidFilterCriteriaException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoInvalidFilterCriteriaException = class + class function Create: _InvalidFilterCriteriaException; + class function CreateRemote(const MachineName: string): _InvalidFilterCriteriaException; + end; + +// *********************************************************************// +// The Class CoManifestResourceInfo provides a Create and CreateRemote method to +// create instances of the default interface _ManifestResourceInfo exposed by +// the CoClass ManifestResourceInfo. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoManifestResourceInfo = class + class function Create: _ManifestResourceInfo; + class function CreateRemote(const MachineName: string): _ManifestResourceInfo; + end; + +// *********************************************************************// +// The Class CoMemberFilter provides a Create and CreateRemote method to +// create instances of the default interface _MemberFilter exposed by +// the CoClass MemberFilter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMemberFilter = class + class function Create: _MemberFilter; + class function CreateRemote(const MachineName: string): _MemberFilter; + end; + +// *********************************************************************// +// The Class CoMethodInfo provides a Create and CreateRemote method to +// create instances of the default interface _MethodInfo exposed by +// the CoClass MethodInfo. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMethodInfo = class + class function Create: _MethodInfo; + class function CreateRemote(const MachineName: string): _MethodInfo; + end; + +// *********************************************************************// +// The Class CoMissing provides a Create and CreateRemote method to +// create instances of the default interface _Missing exposed by +// the CoClass Missing. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMissing = class + class function Create: _Missing; + class function CreateRemote(const MachineName: string): _Missing; + end; + +// *********************************************************************// +// The Class CoModule provides a Create and CreateRemote method to +// create instances of the default interface _Module exposed by +// the CoClass Module. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoModule = class + class function Create: _Module; + class function CreateRemote(const MachineName: string): _Module; + end; + +// *********************************************************************// +// The Class CoParameterInfo provides a Create and CreateRemote method to +// create instances of the default interface _ParameterInfo exposed by +// the CoClass ParameterInfo. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoParameterInfo = class + class function Create: _ParameterInfo; + class function CreateRemote(const MachineName: string): _ParameterInfo; + end; + +// *********************************************************************// +// The Class CoPointer provides a Create and CreateRemote method to +// create instances of the default interface _Pointer exposed by +// the CoClass Pointer. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoPointer = class + class function Create: _Pointer; + class function CreateRemote(const MachineName: string): _Pointer; + end; + +// *********************************************************************// +// The Class CoPropertyInfo provides a Create and CreateRemote method to +// create instances of the default interface _PropertyInfo exposed by +// the CoClass PropertyInfo. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoPropertyInfo = class + class function Create: _PropertyInfo; + class function CreateRemote(const MachineName: string): _PropertyInfo; + end; + +// *********************************************************************// +// The Class CoReflectionTypeLoadException provides a Create and CreateRemote method to +// create instances of the default interface _ReflectionTypeLoadException exposed by +// the CoClass ReflectionTypeLoadException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoReflectionTypeLoadException = class + class function Create: _ReflectionTypeLoadException; + class function CreateRemote(const MachineName: string): _ReflectionTypeLoadException; + end; + +// *********************************************************************// +// The Class CoStrongNameKeyPair provides a Create and CreateRemote method to +// create instances of the default interface _StrongNameKeyPair exposed by +// the CoClass StrongNameKeyPair. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoStrongNameKeyPair = class + class function Create: _StrongNameKeyPair; + class function CreateRemote(const MachineName: string): _StrongNameKeyPair; + end; + +// *********************************************************************// +// The Class CoTargetException provides a Create and CreateRemote method to +// create instances of the default interface _TargetException exposed by +// the CoClass TargetException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTargetException = class + class function Create: _TargetException; + class function CreateRemote(const MachineName: string): _TargetException; + end; + +// *********************************************************************// +// The Class CoTargetInvocationException provides a Create and CreateRemote method to +// create instances of the default interface _TargetInvocationException exposed by +// the CoClass TargetInvocationException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTargetInvocationException = class + class function Create: _TargetInvocationException; + class function CreateRemote(const MachineName: string): _TargetInvocationException; + end; + +// *********************************************************************// +// The Class CoTargetParameterCountException provides a Create and CreateRemote method to +// create instances of the default interface _TargetParameterCountException exposed by +// the CoClass TargetParameterCountException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTargetParameterCountException = class + class function Create: _TargetParameterCountException; + class function CreateRemote(const MachineName: string): _TargetParameterCountException; + end; + +// *********************************************************************// +// The Class CoTypeDelegator provides a Create and CreateRemote method to +// create instances of the default interface _TypeDelegator exposed by +// the CoClass TypeDelegator. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTypeDelegator = class + class function Create: _TypeDelegator; + class function CreateRemote(const MachineName: string): _TypeDelegator; + end; + +// *********************************************************************// +// The Class CoTypeFilter provides a Create and CreateRemote method to +// create instances of the default interface _TypeFilter exposed by +// the CoClass TypeFilter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTypeFilter = class + class function Create: _TypeFilter; + class function CreateRemote(const MachineName: string): _TypeFilter; + end; + +// *********************************************************************// +// The Class CoUnmanagedMarshal provides a Create and CreateRemote method to +// create instances of the default interface _UnmanagedMarshal exposed by +// the CoClass UnmanagedMarshal. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoUnmanagedMarshal = class + class function Create: _UnmanagedMarshal; + class function CreateRemote(const MachineName: string): _UnmanagedMarshal; + end; + +// *********************************************************************// +// The Class CoFormatter provides a Create and CreateRemote method to +// create instances of the default interface _Formatter exposed by +// the CoClass Formatter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFormatter = class + class function Create: _Formatter; + class function CreateRemote(const MachineName: string): _Formatter; + end; + +// *********************************************************************// +// The Class CoFormatterConverter provides a Create and CreateRemote method to +// create instances of the default interface _FormatterConverter exposed by +// the CoClass FormatterConverter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFormatterConverter = class + class function Create: _FormatterConverter; + class function CreateRemote(const MachineName: string): _FormatterConverter; + end; + +// *********************************************************************// +// The Class CoFormatterServices provides a Create and CreateRemote method to +// create instances of the default interface _FormatterServices exposed by +// the CoClass FormatterServices. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFormatterServices = class + class function Create: _FormatterServices; + class function CreateRemote(const MachineName: string): _FormatterServices; + end; + +// *********************************************************************// +// The Class CoObjectIDGenerator provides a Create and CreateRemote method to +// create instances of the default interface _ObjectIDGenerator exposed by +// the CoClass ObjectIDGenerator. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoObjectIDGenerator = class + class function Create: _ObjectIDGenerator; + class function CreateRemote(const MachineName: string): _ObjectIDGenerator; + end; + +// *********************************************************************// +// The Class CoObjectManager provides a Create and CreateRemote method to +// create instances of the default interface _ObjectManager exposed by +// the CoClass ObjectManager. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoObjectManager = class + class function Create: _ObjectManager; + class function CreateRemote(const MachineName: string): _ObjectManager; + end; + +// *********************************************************************// +// The Class CoSerializationBinder provides a Create and CreateRemote method to +// create instances of the default interface _SerializationBinder exposed by +// the CoClass SerializationBinder. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSerializationBinder = class + class function Create: _SerializationBinder; + class function CreateRemote(const MachineName: string): _SerializationBinder; + end; + +// *********************************************************************// +// The Class CoSerializationInfo provides a Create and CreateRemote method to +// create instances of the default interface _SerializationInfo exposed by +// the CoClass SerializationInfo. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSerializationInfo = class + class function Create: _SerializationInfo; + class function CreateRemote(const MachineName: string): _SerializationInfo; + end; + +// *********************************************************************// +// The Class CoSerializationInfoEnumerator provides a Create and CreateRemote method to +// create instances of the default interface _SerializationInfoEnumerator exposed by +// the CoClass SerializationInfoEnumerator. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSerializationInfoEnumerator = class + class function Create: _SerializationInfoEnumerator; + class function CreateRemote(const MachineName: string): _SerializationInfoEnumerator; + end; + +// *********************************************************************// +// The Class CoSerializationException provides a Create and CreateRemote method to +// create instances of the default interface _SerializationException exposed by +// the CoClass SerializationException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSerializationException = class + class function Create: _SerializationException; + class function CreateRemote(const MachineName: string): _SerializationException; + end; + +// *********************************************************************// +// The Class CoSurrogateSelector provides a Create and CreateRemote method to +// create instances of the default interface _SurrogateSelector exposed by +// the CoClass SurrogateSelector. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSurrogateSelector = class + class function Create: _SurrogateSelector; + class function CreateRemote(const MachineName: string): _SurrogateSelector; + end; + +// *********************************************************************// +// The Class CoCalendar provides a Create and CreateRemote method to +// create instances of the default interface _Calendar exposed by +// the CoClass Calendar. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCalendar = class + class function Create: _Calendar; + class function CreateRemote(const MachineName: string): _Calendar; + end; + +// *********************************************************************// +// The Class CoCompareInfo provides a Create and CreateRemote method to +// create instances of the default interface _CompareInfo exposed by +// the CoClass CompareInfo. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCompareInfo = class + class function Create: _CompareInfo; + class function CreateRemote(const MachineName: string): _CompareInfo; + end; + +// *********************************************************************// +// The Class CoCultureInfo provides a Create and CreateRemote method to +// create instances of the default interface _CultureInfo exposed by +// the CoClass CultureInfo. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCultureInfo = class + class function Create: _CultureInfo; + class function CreateRemote(const MachineName: string): _CultureInfo; + end; + +// *********************************************************************// +// The Class CoDateTimeFormatInfo provides a Create and CreateRemote method to +// create instances of the default interface _DateTimeFormatInfo exposed by +// the CoClass DateTimeFormatInfo. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDateTimeFormatInfo = class + class function Create: _DateTimeFormatInfo; + class function CreateRemote(const MachineName: string): _DateTimeFormatInfo; + end; + +// *********************************************************************// +// The Class CoDaylightTime provides a Create and CreateRemote method to +// create instances of the default interface _DaylightTime exposed by +// the CoClass DaylightTime. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDaylightTime = class + class function Create: _DaylightTime; + class function CreateRemote(const MachineName: string): _DaylightTime; + end; + +// *********************************************************************// +// The Class CoGregorianCalendar provides a Create and CreateRemote method to +// create instances of the default interface _GregorianCalendar exposed by +// the CoClass GregorianCalendar. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoGregorianCalendar = class + class function Create: _GregorianCalendar; + class function CreateRemote(const MachineName: string): _GregorianCalendar; + end; + +// *********************************************************************// +// The Class CoHebrewCalendar provides a Create and CreateRemote method to +// create instances of the default interface _HebrewCalendar exposed by +// the CoClass HebrewCalendar. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoHebrewCalendar = class + class function Create: _HebrewCalendar; + class function CreateRemote(const MachineName: string): _HebrewCalendar; + end; + +// *********************************************************************// +// The Class CoHijriCalendar provides a Create and CreateRemote method to +// create instances of the default interface _HijriCalendar exposed by +// the CoClass HijriCalendar. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoHijriCalendar = class + class function Create: _HijriCalendar; + class function CreateRemote(const MachineName: string): _HijriCalendar; + end; + +// *********************************************************************// +// The Class CoJapaneseCalendar provides a Create and CreateRemote method to +// create instances of the default interface _JapaneseCalendar exposed by +// the CoClass JapaneseCalendar. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoJapaneseCalendar = class + class function Create: _JapaneseCalendar; + class function CreateRemote(const MachineName: string): _JapaneseCalendar; + end; + +// *********************************************************************// +// The Class CoJulianCalendar provides a Create and CreateRemote method to +// create instances of the default interface _JulianCalendar exposed by +// the CoClass JulianCalendar. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoJulianCalendar = class + class function Create: _JulianCalendar; + class function CreateRemote(const MachineName: string): _JulianCalendar; + end; + +// *********************************************************************// +// The Class CoKoreanCalendar provides a Create and CreateRemote method to +// create instances of the default interface _KoreanCalendar exposed by +// the CoClass KoreanCalendar. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoKoreanCalendar = class + class function Create: _KoreanCalendar; + class function CreateRemote(const MachineName: string): _KoreanCalendar; + end; + +// *********************************************************************// +// The Class CoRegionInfo provides a Create and CreateRemote method to +// create instances of the default interface _RegionInfo exposed by +// the CoClass RegionInfo. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRegionInfo = class + class function Create: _RegionInfo; + class function CreateRemote(const MachineName: string): _RegionInfo; + end; + +// *********************************************************************// +// The Class CoSortKey provides a Create and CreateRemote method to +// create instances of the default interface _SortKey exposed by +// the CoClass SortKey. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSortKey = class + class function Create: _SortKey; + class function CreateRemote(const MachineName: string): _SortKey; + end; + +// *********************************************************************// +// The Class CoStringInfo provides a Create and CreateRemote method to +// create instances of the default interface _StringInfo exposed by +// the CoClass StringInfo. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoStringInfo = class + class function Create: _StringInfo; + class function CreateRemote(const MachineName: string): _StringInfo; + end; + +// *********************************************************************// +// The Class CoTaiwanCalendar provides a Create and CreateRemote method to +// create instances of the default interface _TaiwanCalendar exposed by +// the CoClass TaiwanCalendar. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTaiwanCalendar = class + class function Create: _TaiwanCalendar; + class function CreateRemote(const MachineName: string): _TaiwanCalendar; + end; + +// *********************************************************************// +// The Class CoTextElementEnumerator provides a Create and CreateRemote method to +// create instances of the default interface _TextElementEnumerator exposed by +// the CoClass TextElementEnumerator. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTextElementEnumerator = class + class function Create: _TextElementEnumerator; + class function CreateRemote(const MachineName: string): _TextElementEnumerator; + end; + +// *********************************************************************// +// The Class CoTextInfo provides a Create and CreateRemote method to +// create instances of the default interface _TextInfo exposed by +// the CoClass TextInfo. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTextInfo = class + class function Create: _TextInfo; + class function CreateRemote(const MachineName: string): _TextInfo; + end; + +// *********************************************************************// +// The Class CoThaiBuddhistCalendar provides a Create and CreateRemote method to +// create instances of the default interface _ThaiBuddhistCalendar exposed by +// the CoClass ThaiBuddhistCalendar. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoThaiBuddhistCalendar = class + class function Create: _ThaiBuddhistCalendar; + class function CreateRemote(const MachineName: string): _ThaiBuddhistCalendar; + end; + +// *********************************************************************// +// The Class CoNumberFormatInfo provides a Create and CreateRemote method to +// create instances of the default interface _NumberFormatInfo exposed by +// the CoClass NumberFormatInfo. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoNumberFormatInfo = class + class function Create: _NumberFormatInfo; + class function CreateRemote(const MachineName: string): _NumberFormatInfo; + end; + +// *********************************************************************// +// The Class CoEncoding provides a Create and CreateRemote method to +// create instances of the default interface _Encoding exposed by +// the CoClass Encoding. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEncoding = class + class function Create: _Encoding; + class function CreateRemote(const MachineName: string): _Encoding; + end; + +// *********************************************************************// +// The Class CoSystem_Text_Decoder provides a Create and CreateRemote method to +// create instances of the default interface _System_Text_Decoder exposed by +// the CoClass System_Text_Decoder. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSystem_Text_Decoder = class + class function Create: _System_Text_Decoder; + class function CreateRemote(const MachineName: string): _System_Text_Decoder; + end; + +// *********************************************************************// +// The Class CoSystem_Text_Encoder provides a Create and CreateRemote method to +// create instances of the default interface _System_Text_Encoder exposed by +// the CoClass System_Text_Encoder. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSystem_Text_Encoder = class + class function Create: _System_Text_Encoder; + class function CreateRemote(const MachineName: string): _System_Text_Encoder; + end; + +// *********************************************************************// +// The Class CoASCIIEncoding provides a Create and CreateRemote method to +// create instances of the default interface _ASCIIEncoding exposed by +// the CoClass ASCIIEncoding. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoASCIIEncoding = class + class function Create: _ASCIIEncoding; + class function CreateRemote(const MachineName: string): _ASCIIEncoding; + end; + +// *********************************************************************// +// The Class CoUnicodeEncoding provides a Create and CreateRemote method to +// create instances of the default interface _UnicodeEncoding exposed by +// the CoClass UnicodeEncoding. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoUnicodeEncoding = class + class function Create: _UnicodeEncoding; + class function CreateRemote(const MachineName: string): _UnicodeEncoding; + end; + +// *********************************************************************// +// The Class CoUTF7Encoding provides a Create and CreateRemote method to +// create instances of the default interface _UTF7Encoding exposed by +// the CoClass UTF7Encoding. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoUTF7Encoding = class + class function Create: _UTF7Encoding; + class function CreateRemote(const MachineName: string): _UTF7Encoding; + end; + +// *********************************************************************// +// The Class CoUTF8Encoding provides a Create and CreateRemote method to +// create instances of the default interface _UTF8Encoding exposed by +// the CoClass UTF8Encoding. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoUTF8Encoding = class + class function Create: _UTF8Encoding; + class function CreateRemote(const MachineName: string): _UTF8Encoding; + end; + +// *********************************************************************// +// The Class CoMissingManifestResourceException provides a Create and CreateRemote method to +// create instances of the default interface _MissingManifestResourceException exposed by +// the CoClass MissingManifestResourceException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMissingManifestResourceException = class + class function Create: _MissingManifestResourceException; + class function CreateRemote(const MachineName: string): _MissingManifestResourceException; + end; + +// *********************************************************************// +// The Class CoNeutralResourcesLanguageAttribute provides a Create and CreateRemote method to +// create instances of the default interface _NeutralResourcesLanguageAttribute exposed by +// the CoClass NeutralResourcesLanguageAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoNeutralResourcesLanguageAttribute = class + class function Create: _NeutralResourcesLanguageAttribute; + class function CreateRemote(const MachineName: string): _NeutralResourcesLanguageAttribute; + end; + +// *********************************************************************// +// The Class CoResourceManager provides a Create and CreateRemote method to +// create instances of the default interface _ResourceManager exposed by +// the CoClass ResourceManager. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoResourceManager = class + class function Create: _ResourceManager; + class function CreateRemote(const MachineName: string): _ResourceManager; + end; + +// *********************************************************************// +// The Class CoResourceReader provides a Create and CreateRemote method to +// create instances of the default interface _ResourceReader exposed by +// the CoClass ResourceReader. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoResourceReader = class + class function Create: _ResourceReader; + class function CreateRemote(const MachineName: string): _ResourceReader; + end; + +// *********************************************************************// +// The Class CoResourceSet provides a Create and CreateRemote method to +// create instances of the default interface _ResourceSet exposed by +// the CoClass ResourceSet. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoResourceSet = class + class function Create: _ResourceSet; + class function CreateRemote(const MachineName: string): _ResourceSet; + end; + +// *********************************************************************// +// The Class CoResourceWriter provides a Create and CreateRemote method to +// create instances of the default interface _ResourceWriter exposed by +// the CoClass ResourceWriter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoResourceWriter = class + class function Create: _ResourceWriter; + class function CreateRemote(const MachineName: string): _ResourceWriter; + end; + +// *********************************************************************// +// The Class CoSatelliteContractVersionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _SatelliteContractVersionAttribute exposed by +// the CoClass SatelliteContractVersionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSatelliteContractVersionAttribute = class + class function Create: _SatelliteContractVersionAttribute; + class function CreateRemote(const MachineName: string): _SatelliteContractVersionAttribute; + end; + +// *********************************************************************// +// The Class CoRegistry provides a Create and CreateRemote method to +// create instances of the default interface _Registry exposed by +// the CoClass Registry. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRegistry = class + class function Create: _Registry; + class function CreateRemote(const MachineName: string): _Registry; + end; + +// *********************************************************************// +// The Class CoRegistryKey provides a Create and CreateRemote method to +// create instances of the default interface _RegistryKey exposed by +// the CoClass RegistryKey. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRegistryKey = class + class function Create: _RegistryKey; + class function CreateRemote(const MachineName: string): _RegistryKey; + end; + +// *********************************************************************// +// The Class CoX509Certificate provides a Create and CreateRemote method to +// create instances of the default interface _X509Certificate exposed by +// the CoClass X509Certificate. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoX509Certificate = class + class function Create: _X509Certificate; + class function CreateRemote(const MachineName: string): _X509Certificate; + end; + +// *********************************************************************// +// The Class CoAsymmetricAlgorithm provides a Create and CreateRemote method to +// create instances of the default interface _AsymmetricAlgorithm exposed by +// the CoClass AsymmetricAlgorithm. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAsymmetricAlgorithm = class + class function Create: _AsymmetricAlgorithm; + class function CreateRemote(const MachineName: string): _AsymmetricAlgorithm; + end; + +// *********************************************************************// +// The Class CoAsymmetricKeyExchangeDeformatter provides a Create and CreateRemote method to +// create instances of the default interface _AsymmetricKeyExchangeDeformatter exposed by +// the CoClass AsymmetricKeyExchangeDeformatter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAsymmetricKeyExchangeDeformatter = class + class function Create: _AsymmetricKeyExchangeDeformatter; + class function CreateRemote(const MachineName: string): _AsymmetricKeyExchangeDeformatter; + end; + +// *********************************************************************// +// The Class CoAsymmetricKeyExchangeFormatter provides a Create and CreateRemote method to +// create instances of the default interface _AsymmetricKeyExchangeFormatter exposed by +// the CoClass AsymmetricKeyExchangeFormatter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAsymmetricKeyExchangeFormatter = class + class function Create: _AsymmetricKeyExchangeFormatter; + class function CreateRemote(const MachineName: string): _AsymmetricKeyExchangeFormatter; + end; + +// *********************************************************************// +// The Class CoAsymmetricSignatureDeformatter provides a Create and CreateRemote method to +// create instances of the default interface _AsymmetricSignatureDeformatter exposed by +// the CoClass AsymmetricSignatureDeformatter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAsymmetricSignatureDeformatter = class + class function Create: _AsymmetricSignatureDeformatter; + class function CreateRemote(const MachineName: string): _AsymmetricSignatureDeformatter; + end; + +// *********************************************************************// +// The Class CoAsymmetricSignatureFormatter provides a Create and CreateRemote method to +// create instances of the default interface _AsymmetricSignatureFormatter exposed by +// the CoClass AsymmetricSignatureFormatter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAsymmetricSignatureFormatter = class + class function Create: _AsymmetricSignatureFormatter; + class function CreateRemote(const MachineName: string): _AsymmetricSignatureFormatter; + end; + +// *********************************************************************// +// The Class CoToBase64Transform provides a Create and CreateRemote method to +// create instances of the default interface _ToBase64Transform exposed by +// the CoClass ToBase64Transform. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoToBase64Transform = class + class function Create: _ToBase64Transform; + class function CreateRemote(const MachineName: string): _ToBase64Transform; + end; + +// *********************************************************************// +// The Class CoFromBase64Transform provides a Create and CreateRemote method to +// create instances of the default interface _FromBase64Transform exposed by +// the CoClass FromBase64Transform. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFromBase64Transform = class + class function Create: _FromBase64Transform; + class function CreateRemote(const MachineName: string): _FromBase64Transform; + end; + +// *********************************************************************// +// The Class CoKeySizes provides a Create and CreateRemote method to +// create instances of the default interface _KeySizes exposed by +// the CoClass KeySizes. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoKeySizes = class + class function Create: _KeySizes; + class function CreateRemote(const MachineName: string): _KeySizes; + end; + +// *********************************************************************// +// The Class CoCryptographicException provides a Create and CreateRemote method to +// create instances of the default interface _CryptographicException exposed by +// the CoClass CryptographicException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCryptographicException = class + class function Create: _CryptographicException; + class function CreateRemote(const MachineName: string): _CryptographicException; + end; + +// *********************************************************************// +// The Class CoCryptographicUnexpectedOperationException provides a Create and CreateRemote method to +// create instances of the default interface _CryptographicUnexpectedOperationException exposed by +// the CoClass CryptographicUnexpectedOperationException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCryptographicUnexpectedOperationException = class + class function Create: _CryptographicUnexpectedOperationException; + class function CreateRemote(const MachineName: string): _CryptographicUnexpectedOperationException; + end; + +// *********************************************************************// +// The Class CoCryptoAPITransform provides a Create and CreateRemote method to +// create instances of the default interface _CryptoAPITransform exposed by +// the CoClass CryptoAPITransform. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCryptoAPITransform = class + class function Create: _CryptoAPITransform; + class function CreateRemote(const MachineName: string): _CryptoAPITransform; + end; + +// *********************************************************************// +// The Class CoCspParameters provides a Create and CreateRemote method to +// create instances of the default interface _CspParameters exposed by +// the CoClass CspParameters. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCspParameters = class + class function Create: _CspParameters; + class function CreateRemote(const MachineName: string): _CspParameters; + end; + +// *********************************************************************// +// The Class CoCryptoConfig provides a Create and CreateRemote method to +// create instances of the default interface _CryptoConfig exposed by +// the CoClass CryptoConfig. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCryptoConfig = class + class function Create: _CryptoConfig; + class function CreateRemote(const MachineName: string): _CryptoConfig; + end; + +// *********************************************************************// +// The Class CoStream provides a Create and CreateRemote method to +// create instances of the default interface _Stream exposed by +// the CoClass Stream. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoStream = class + class function Create: _Stream; + class function CreateRemote(const MachineName: string): _Stream; + end; + +// *********************************************************************// +// The Class CoCryptoStream provides a Create and CreateRemote method to +// create instances of the default interface _CryptoStream exposed by +// the CoClass CryptoStream. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCryptoStream = class + class function Create: _CryptoStream; + class function CreateRemote(const MachineName: string): _CryptoStream; + end; + +// *********************************************************************// +// The Class CoSymmetricAlgorithm provides a Create and CreateRemote method to +// create instances of the default interface _SymmetricAlgorithm exposed by +// the CoClass SymmetricAlgorithm. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSymmetricAlgorithm = class + class function Create: _SymmetricAlgorithm; + class function CreateRemote(const MachineName: string): _SymmetricAlgorithm; + end; + +// *********************************************************************// +// The Class CoDES provides a Create and CreateRemote method to +// create instances of the default interface _DES exposed by +// the CoClass DES. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDES = class + class function Create: _DES; + class function CreateRemote(const MachineName: string): _DES; + end; + +// *********************************************************************// +// The Class CoDESCryptoServiceProvider provides a Create and CreateRemote method to +// create instances of the default interface _DESCryptoServiceProvider exposed by +// the CoClass DESCryptoServiceProvider. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDESCryptoServiceProvider = class + class function Create: _DESCryptoServiceProvider; + class function CreateRemote(const MachineName: string): _DESCryptoServiceProvider; + end; + +// *********************************************************************// +// The Class CoDeriveBytes provides a Create and CreateRemote method to +// create instances of the default interface _DeriveBytes exposed by +// the CoClass DeriveBytes. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDeriveBytes = class + class function Create: _DeriveBytes; + class function CreateRemote(const MachineName: string): _DeriveBytes; + end; + +// *********************************************************************// +// The Class CoDSA provides a Create and CreateRemote method to +// create instances of the default interface _DSA exposed by +// the CoClass DSA. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDSA = class + class function Create: _DSA; + class function CreateRemote(const MachineName: string): _DSA; + end; + +// *********************************************************************// +// The Class CoDSACryptoServiceProvider provides a Create and CreateRemote method to +// create instances of the default interface _DSACryptoServiceProvider exposed by +// the CoClass DSACryptoServiceProvider. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDSACryptoServiceProvider = class + class function Create: _DSACryptoServiceProvider; + class function CreateRemote(const MachineName: string): _DSACryptoServiceProvider; + end; + +// *********************************************************************// +// The Class CoDSASignatureDeformatter provides a Create and CreateRemote method to +// create instances of the default interface _DSASignatureDeformatter exposed by +// the CoClass DSASignatureDeformatter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDSASignatureDeformatter = class + class function Create: _DSASignatureDeformatter; + class function CreateRemote(const MachineName: string): _DSASignatureDeformatter; + end; + +// *********************************************************************// +// The Class CoDSASignatureFormatter provides a Create and CreateRemote method to +// create instances of the default interface _DSASignatureFormatter exposed by +// the CoClass DSASignatureFormatter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDSASignatureFormatter = class + class function Create: _DSASignatureFormatter; + class function CreateRemote(const MachineName: string): _DSASignatureFormatter; + end; + +// *********************************************************************// +// The Class CoHashAlgorithm provides a Create and CreateRemote method to +// create instances of the default interface _HashAlgorithm exposed by +// the CoClass HashAlgorithm. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoHashAlgorithm = class + class function Create: _HashAlgorithm; + class function CreateRemote(const MachineName: string): _HashAlgorithm; + end; + +// *********************************************************************// +// The Class CoKeyedHashAlgorithm provides a Create and CreateRemote method to +// create instances of the default interface _KeyedHashAlgorithm exposed by +// the CoClass KeyedHashAlgorithm. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoKeyedHashAlgorithm = class + class function Create: _KeyedHashAlgorithm; + class function CreateRemote(const MachineName: string): _KeyedHashAlgorithm; + end; + +// *********************************************************************// +// The Class CoHMACSHA1 provides a Create and CreateRemote method to +// create instances of the default interface _HMACSHA1 exposed by +// the CoClass HMACSHA1. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoHMACSHA1 = class + class function Create: _HMACSHA1; + class function CreateRemote(const MachineName: string): _HMACSHA1; + end; + +// *********************************************************************// +// The Class CoMACTripleDES provides a Create and CreateRemote method to +// create instances of the default interface _MACTripleDES exposed by +// the CoClass MACTripleDES. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMACTripleDES = class + class function Create: _MACTripleDES; + class function CreateRemote(const MachineName: string): _MACTripleDES; + end; + +// *********************************************************************// +// The Class CoMD5 provides a Create and CreateRemote method to +// create instances of the default interface _MD5 exposed by +// the CoClass MD5. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMD5 = class + class function Create: _MD5; + class function CreateRemote(const MachineName: string): _MD5; + end; + +// *********************************************************************// +// The Class CoMD5CryptoServiceProvider provides a Create and CreateRemote method to +// create instances of the default interface _MD5CryptoServiceProvider exposed by +// the CoClass MD5CryptoServiceProvider. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMD5CryptoServiceProvider = class + class function Create: _MD5CryptoServiceProvider; + class function CreateRemote(const MachineName: string): _MD5CryptoServiceProvider; + end; + +// *********************************************************************// +// The Class CoMaskGenerationMethod provides a Create and CreateRemote method to +// create instances of the default interface _MaskGenerationMethod exposed by +// the CoClass MaskGenerationMethod. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMaskGenerationMethod = class + class function Create: _MaskGenerationMethod; + class function CreateRemote(const MachineName: string): _MaskGenerationMethod; + end; + +// *********************************************************************// +// The Class CoPasswordDeriveBytes provides a Create and CreateRemote method to +// create instances of the default interface _PasswordDeriveBytes exposed by +// the CoClass PasswordDeriveBytes. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoPasswordDeriveBytes = class + class function Create: _PasswordDeriveBytes; + class function CreateRemote(const MachineName: string): _PasswordDeriveBytes; + end; + +// *********************************************************************// +// The Class CoPKCS1MaskGenerationMethod provides a Create and CreateRemote method to +// create instances of the default interface _PKCS1MaskGenerationMethod exposed by +// the CoClass PKCS1MaskGenerationMethod. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoPKCS1MaskGenerationMethod = class + class function Create: _PKCS1MaskGenerationMethod; + class function CreateRemote(const MachineName: string): _PKCS1MaskGenerationMethod; + end; + +// *********************************************************************// +// The Class CoRC2 provides a Create and CreateRemote method to +// create instances of the default interface _RC2 exposed by +// the CoClass RC2. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRC2 = class + class function Create: _RC2; + class function CreateRemote(const MachineName: string): _RC2; + end; + +// *********************************************************************// +// The Class CoRC2CryptoServiceProvider provides a Create and CreateRemote method to +// create instances of the default interface _RC2CryptoServiceProvider exposed by +// the CoClass RC2CryptoServiceProvider. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRC2CryptoServiceProvider = class + class function Create: _RC2CryptoServiceProvider; + class function CreateRemote(const MachineName: string): _RC2CryptoServiceProvider; + end; + +// *********************************************************************// +// The Class CoRandomNumberGenerator provides a Create and CreateRemote method to +// create instances of the default interface _RandomNumberGenerator exposed by +// the CoClass RandomNumberGenerator. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRandomNumberGenerator = class + class function Create: _RandomNumberGenerator; + class function CreateRemote(const MachineName: string): _RandomNumberGenerator; + end; + +// *********************************************************************// +// The Class CoRNGCryptoServiceProvider provides a Create and CreateRemote method to +// create instances of the default interface _RNGCryptoServiceProvider exposed by +// the CoClass RNGCryptoServiceProvider. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRNGCryptoServiceProvider = class + class function Create: _RNGCryptoServiceProvider; + class function CreateRemote(const MachineName: string): _RNGCryptoServiceProvider; + end; + +// *********************************************************************// +// The Class CoRSA provides a Create and CreateRemote method to +// create instances of the default interface _RSA exposed by +// the CoClass RSA. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRSA = class + class function Create: _RSA; + class function CreateRemote(const MachineName: string): _RSA; + end; + +// *********************************************************************// +// The Class CoRSACryptoServiceProvider provides a Create and CreateRemote method to +// create instances of the default interface _RSACryptoServiceProvider exposed by +// the CoClass RSACryptoServiceProvider. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRSACryptoServiceProvider = class + class function Create: _RSACryptoServiceProvider; + class function CreateRemote(const MachineName: string): _RSACryptoServiceProvider; + end; + +// *********************************************************************// +// The Class CoRSAOAEPKeyExchangeDeformatter provides a Create and CreateRemote method to +// create instances of the default interface _RSAOAEPKeyExchangeDeformatter exposed by +// the CoClass RSAOAEPKeyExchangeDeformatter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRSAOAEPKeyExchangeDeformatter = class + class function Create: _RSAOAEPKeyExchangeDeformatter; + class function CreateRemote(const MachineName: string): _RSAOAEPKeyExchangeDeformatter; + end; + +// *********************************************************************// +// The Class CoRSAOAEPKeyExchangeFormatter provides a Create and CreateRemote method to +// create instances of the default interface _RSAOAEPKeyExchangeFormatter exposed by +// the CoClass RSAOAEPKeyExchangeFormatter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRSAOAEPKeyExchangeFormatter = class + class function Create: _RSAOAEPKeyExchangeFormatter; + class function CreateRemote(const MachineName: string): _RSAOAEPKeyExchangeFormatter; + end; + +// *********************************************************************// +// The Class CoRSAPKCS1KeyExchangeDeformatter provides a Create and CreateRemote method to +// create instances of the default interface _RSAPKCS1KeyExchangeDeformatter exposed by +// the CoClass RSAPKCS1KeyExchangeDeformatter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRSAPKCS1KeyExchangeDeformatter = class + class function Create: _RSAPKCS1KeyExchangeDeformatter; + class function CreateRemote(const MachineName: string): _RSAPKCS1KeyExchangeDeformatter; + end; + +// *********************************************************************// +// The Class CoRSAPKCS1KeyExchangeFormatter provides a Create and CreateRemote method to +// create instances of the default interface _RSAPKCS1KeyExchangeFormatter exposed by +// the CoClass RSAPKCS1KeyExchangeFormatter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRSAPKCS1KeyExchangeFormatter = class + class function Create: _RSAPKCS1KeyExchangeFormatter; + class function CreateRemote(const MachineName: string): _RSAPKCS1KeyExchangeFormatter; + end; + +// *********************************************************************// +// The Class CoRSAPKCS1SignatureDeformatter provides a Create and CreateRemote method to +// create instances of the default interface _RSAPKCS1SignatureDeformatter exposed by +// the CoClass RSAPKCS1SignatureDeformatter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRSAPKCS1SignatureDeformatter = class + class function Create: _RSAPKCS1SignatureDeformatter; + class function CreateRemote(const MachineName: string): _RSAPKCS1SignatureDeformatter; + end; + +// *********************************************************************// +// The Class CoRSAPKCS1SignatureFormatter provides a Create and CreateRemote method to +// create instances of the default interface _RSAPKCS1SignatureFormatter exposed by +// the CoClass RSAPKCS1SignatureFormatter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRSAPKCS1SignatureFormatter = class + class function Create: _RSAPKCS1SignatureFormatter; + class function CreateRemote(const MachineName: string): _RSAPKCS1SignatureFormatter; + end; + +// *********************************************************************// +// The Class CoRijndael provides a Create and CreateRemote method to +// create instances of the default interface _Rijndael exposed by +// the CoClass Rijndael. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRijndael = class + class function Create: _Rijndael; + class function CreateRemote(const MachineName: string): _Rijndael; + end; + +// *********************************************************************// +// The Class CoRijndaelManaged provides a Create and CreateRemote method to +// create instances of the default interface _RijndaelManaged exposed by +// the CoClass RijndaelManaged. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRijndaelManaged = class + class function Create: _RijndaelManaged; + class function CreateRemote(const MachineName: string): _RijndaelManaged; + end; + +// *********************************************************************// +// The Class CoSHA1 provides a Create and CreateRemote method to +// create instances of the default interface _SHA1 exposed by +// the CoClass SHA1. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSHA1 = class + class function Create: _SHA1; + class function CreateRemote(const MachineName: string): _SHA1; + end; + +// *********************************************************************// +// The Class CoSHA1CryptoServiceProvider provides a Create and CreateRemote method to +// create instances of the default interface _SHA1CryptoServiceProvider exposed by +// the CoClass SHA1CryptoServiceProvider. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSHA1CryptoServiceProvider = class + class function Create: _SHA1CryptoServiceProvider; + class function CreateRemote(const MachineName: string): _SHA1CryptoServiceProvider; + end; + +// *********************************************************************// +// The Class CoSHA1Managed provides a Create and CreateRemote method to +// create instances of the default interface _SHA1Managed exposed by +// the CoClass SHA1Managed. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSHA1Managed = class + class function Create: _SHA1Managed; + class function CreateRemote(const MachineName: string): _SHA1Managed; + end; + +// *********************************************************************// +// The Class CoSHA256 provides a Create and CreateRemote method to +// create instances of the default interface _SHA256 exposed by +// the CoClass SHA256. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSHA256 = class + class function Create: _SHA256; + class function CreateRemote(const MachineName: string): _SHA256; + end; + +// *********************************************************************// +// The Class CoSHA256Managed provides a Create and CreateRemote method to +// create instances of the default interface _SHA256Managed exposed by +// the CoClass SHA256Managed. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSHA256Managed = class + class function Create: _SHA256Managed; + class function CreateRemote(const MachineName: string): _SHA256Managed; + end; + +// *********************************************************************// +// The Class CoSHA384 provides a Create and CreateRemote method to +// create instances of the default interface _SHA384 exposed by +// the CoClass SHA384. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSHA384 = class + class function Create: _SHA384; + class function CreateRemote(const MachineName: string): _SHA384; + end; + +// *********************************************************************// +// The Class CoSHA384Managed provides a Create and CreateRemote method to +// create instances of the default interface _SHA384Managed exposed by +// the CoClass SHA384Managed. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSHA384Managed = class + class function Create: _SHA384Managed; + class function CreateRemote(const MachineName: string): _SHA384Managed; + end; + +// *********************************************************************// +// The Class CoSHA512 provides a Create and CreateRemote method to +// create instances of the default interface _SHA512 exposed by +// the CoClass SHA512. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSHA512 = class + class function Create: _SHA512; + class function CreateRemote(const MachineName: string): _SHA512; + end; + +// *********************************************************************// +// The Class CoSHA512Managed provides a Create and CreateRemote method to +// create instances of the default interface _SHA512Managed exposed by +// the CoClass SHA512Managed. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSHA512Managed = class + class function Create: _SHA512Managed; + class function CreateRemote(const MachineName: string): _SHA512Managed; + end; + +// *********************************************************************// +// The Class CoSignatureDescription provides a Create and CreateRemote method to +// create instances of the default interface _SignatureDescription exposed by +// the CoClass SignatureDescription. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSignatureDescription = class + class function Create: _SignatureDescription; + class function CreateRemote(const MachineName: string): _SignatureDescription; + end; + +// *********************************************************************// +// The Class CoTripleDES provides a Create and CreateRemote method to +// create instances of the default interface _TripleDES exposed by +// the CoClass TripleDES. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTripleDES = class + class function Create: _TripleDES; + class function CreateRemote(const MachineName: string): _TripleDES; + end; + +// *********************************************************************// +// The Class CoTripleDESCryptoServiceProvider provides a Create and CreateRemote method to +// create instances of the default interface _TripleDESCryptoServiceProvider exposed by +// the CoClass TripleDESCryptoServiceProvider. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTripleDESCryptoServiceProvider = class + class function Create: _TripleDESCryptoServiceProvider; + class function CreateRemote(const MachineName: string): _TripleDESCryptoServiceProvider; + end; + +// *********************************************************************// +// The Class CoAllMembershipCondition provides a Create and CreateRemote method to +// create instances of the default interface _AllMembershipCondition exposed by +// the CoClass AllMembershipCondition. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAllMembershipCondition = class + class function Create: _AllMembershipCondition; + class function CreateRemote(const MachineName: string): _AllMembershipCondition; + end; + +// *********************************************************************// +// The Class CoApplicationDirectory provides a Create and CreateRemote method to +// create instances of the default interface _ApplicationDirectory exposed by +// the CoClass ApplicationDirectory. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoApplicationDirectory = class + class function Create: _ApplicationDirectory; + class function CreateRemote(const MachineName: string): _ApplicationDirectory; + end; + +// *********************************************************************// +// The Class CoApplicationDirectoryMembershipCondition provides a Create and CreateRemote method to +// create instances of the default interface _ApplicationDirectoryMembershipCondition exposed by +// the CoClass ApplicationDirectoryMembershipCondition. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoApplicationDirectoryMembershipCondition = class + class function Create: _ApplicationDirectoryMembershipCondition; + class function CreateRemote(const MachineName: string): _ApplicationDirectoryMembershipCondition; + end; + +// *********************************************************************// +// The Class CoCodeGroup provides a Create and CreateRemote method to +// create instances of the default interface _CodeGroup exposed by +// the CoClass CodeGroup. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCodeGroup = class + class function Create: _CodeGroup; + class function CreateRemote(const MachineName: string): _CodeGroup; + end; + +// *********************************************************************// +// The Class CoEvidence provides a Create and CreateRemote method to +// create instances of the default interface _Evidence exposed by +// the CoClass Evidence. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEvidence = class + class function Create: _Evidence; + class function CreateRemote(const MachineName: string): _Evidence; + end; + +// *********************************************************************// +// The Class CoFileCodeGroup provides a Create and CreateRemote method to +// create instances of the default interface _FileCodeGroup exposed by +// the CoClass FileCodeGroup. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFileCodeGroup = class + class function Create: _FileCodeGroup; + class function CreateRemote(const MachineName: string): _FileCodeGroup; + end; + +// *********************************************************************// +// The Class CoFirstMatchCodeGroup provides a Create and CreateRemote method to +// create instances of the default interface _FirstMatchCodeGroup exposed by +// the CoClass FirstMatchCodeGroup. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFirstMatchCodeGroup = class + class function Create: _FirstMatchCodeGroup; + class function CreateRemote(const MachineName: string): _FirstMatchCodeGroup; + end; + +// *********************************************************************// +// The Class CoHash provides a Create and CreateRemote method to +// create instances of the default interface _Hash exposed by +// the CoClass Hash. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoHash = class + class function Create: _Hash; + class function CreateRemote(const MachineName: string): _Hash; + end; + +// *********************************************************************// +// The Class CoHashMembershipCondition provides a Create and CreateRemote method to +// create instances of the default interface _HashMembershipCondition exposed by +// the CoClass HashMembershipCondition. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoHashMembershipCondition = class + class function Create: _HashMembershipCondition; + class function CreateRemote(const MachineName: string): _HashMembershipCondition; + end; + +// *********************************************************************// +// The Class CoNetCodeGroup provides a Create and CreateRemote method to +// create instances of the default interface _NetCodeGroup exposed by +// the CoClass NetCodeGroup. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoNetCodeGroup = class + class function Create: _NetCodeGroup; + class function CreateRemote(const MachineName: string): _NetCodeGroup; + end; + +// *********************************************************************// +// The Class CoPermissionRequestEvidence provides a Create and CreateRemote method to +// create instances of the default interface _PermissionRequestEvidence exposed by +// the CoClass PermissionRequestEvidence. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoPermissionRequestEvidence = class + class function Create: _PermissionRequestEvidence; + class function CreateRemote(const MachineName: string): _PermissionRequestEvidence; + end; + +// *********************************************************************// +// The Class CoPolicyException provides a Create and CreateRemote method to +// create instances of the default interface _PolicyException exposed by +// the CoClass PolicyException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoPolicyException = class + class function Create: _PolicyException; + class function CreateRemote(const MachineName: string): _PolicyException; + end; + +// *********************************************************************// +// The Class CoPolicyLevel provides a Create and CreateRemote method to +// create instances of the default interface _PolicyLevel exposed by +// the CoClass PolicyLevel. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoPolicyLevel = class + class function Create: _PolicyLevel; + class function CreateRemote(const MachineName: string): _PolicyLevel; + end; + +// *********************************************************************// +// The Class CoPolicyStatement provides a Create and CreateRemote method to +// create instances of the default interface _PolicyStatement exposed by +// the CoClass PolicyStatement. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoPolicyStatement = class + class function Create: _PolicyStatement; + class function CreateRemote(const MachineName: string): _PolicyStatement; + end; + +// *********************************************************************// +// The Class CoPublisher provides a Create and CreateRemote method to +// create instances of the default interface _Publisher exposed by +// the CoClass Publisher. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoPublisher = class + class function Create: _Publisher; + class function CreateRemote(const MachineName: string): _Publisher; + end; + +// *********************************************************************// +// The Class CoPublisherMembershipCondition provides a Create and CreateRemote method to +// create instances of the default interface _PublisherMembershipCondition exposed by +// the CoClass PublisherMembershipCondition. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoPublisherMembershipCondition = class + class function Create: _PublisherMembershipCondition; + class function CreateRemote(const MachineName: string): _PublisherMembershipCondition; + end; + +// *********************************************************************// +// The Class CoSite provides a Create and CreateRemote method to +// create instances of the default interface _Site exposed by +// the CoClass Site. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSite = class + class function Create: _Site; + class function CreateRemote(const MachineName: string): _Site; + end; + +// *********************************************************************// +// The Class CoSiteMembershipCondition provides a Create and CreateRemote method to +// create instances of the default interface _SiteMembershipCondition exposed by +// the CoClass SiteMembershipCondition. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSiteMembershipCondition = class + class function Create: _SiteMembershipCondition; + class function CreateRemote(const MachineName: string): _SiteMembershipCondition; + end; + +// *********************************************************************// +// The Class CoStrongName provides a Create and CreateRemote method to +// create instances of the default interface _StrongName exposed by +// the CoClass StrongName. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoStrongName = class + class function Create: _StrongName; + class function CreateRemote(const MachineName: string): _StrongName; + end; + +// *********************************************************************// +// The Class CoStrongNameMembershipCondition provides a Create and CreateRemote method to +// create instances of the default interface _StrongNameMembershipCondition exposed by +// the CoClass StrongNameMembershipCondition. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoStrongNameMembershipCondition = class + class function Create: _StrongNameMembershipCondition; + class function CreateRemote(const MachineName: string): _StrongNameMembershipCondition; + end; + +// *********************************************************************// +// The Class CoUnionCodeGroup provides a Create and CreateRemote method to +// create instances of the default interface _UnionCodeGroup exposed by +// the CoClass UnionCodeGroup. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoUnionCodeGroup = class + class function Create: _UnionCodeGroup; + class function CreateRemote(const MachineName: string): _UnionCodeGroup; + end; + +// *********************************************************************// +// The Class CoUrl provides a Create and CreateRemote method to +// create instances of the default interface _Url exposed by +// the CoClass Url. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoUrl = class + class function Create: _Url; + class function CreateRemote(const MachineName: string): _Url; + end; + +// *********************************************************************// +// The Class CoUrlMembershipCondition provides a Create and CreateRemote method to +// create instances of the default interface _UrlMembershipCondition exposed by +// the CoClass UrlMembershipCondition. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoUrlMembershipCondition = class + class function Create: _UrlMembershipCondition; + class function CreateRemote(const MachineName: string): _UrlMembershipCondition; + end; + +// *********************************************************************// +// The Class CoZone provides a Create and CreateRemote method to +// create instances of the default interface _Zone exposed by +// the CoClass Zone. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoZone = class + class function Create: _Zone; + class function CreateRemote(const MachineName: string): _Zone; + end; + +// *********************************************************************// +// The Class CoZoneMembershipCondition provides a Create and CreateRemote method to +// create instances of the default interface _ZoneMembershipCondition exposed by +// the CoClass ZoneMembershipCondition. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoZoneMembershipCondition = class + class function Create: _ZoneMembershipCondition; + class function CreateRemote(const MachineName: string): _ZoneMembershipCondition; + end; + +// *********************************************************************// +// The Class CoGenericIdentity provides a Create and CreateRemote method to +// create instances of the default interface _GenericIdentity exposed by +// the CoClass GenericIdentity. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoGenericIdentity = class + class function Create: _GenericIdentity; + class function CreateRemote(const MachineName: string): _GenericIdentity; + end; + +// *********************************************************************// +// The Class CoGenericPrincipal provides a Create and CreateRemote method to +// create instances of the default interface _GenericPrincipal exposed by +// the CoClass GenericPrincipal. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoGenericPrincipal = class + class function Create: _GenericPrincipal; + class function CreateRemote(const MachineName: string): _GenericPrincipal; + end; + +// *********************************************************************// +// The Class CoWindowsIdentity provides a Create and CreateRemote method to +// create instances of the default interface _WindowsIdentity exposed by +// the CoClass WindowsIdentity. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoWindowsIdentity = class + class function Create: _WindowsIdentity; + class function CreateRemote(const MachineName: string): _WindowsIdentity; + end; + +// *********************************************************************// +// The Class CoWindowsImpersonationContext provides a Create and CreateRemote method to +// create instances of the default interface _WindowsImpersonationContext exposed by +// the CoClass WindowsImpersonationContext. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoWindowsImpersonationContext = class + class function Create: _WindowsImpersonationContext; + class function CreateRemote(const MachineName: string): _WindowsImpersonationContext; + end; + +// *********************************************************************// +// The Class CoWindowsPrincipal provides a Create and CreateRemote method to +// create instances of the default interface _WindowsPrincipal exposed by +// the CoClass WindowsPrincipal. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoWindowsPrincipal = class + class function Create: _WindowsPrincipal; + class function CreateRemote(const MachineName: string): _WindowsPrincipal; + end; + +// *********************************************************************// +// The Class CoDispIdAttribute provides a Create and CreateRemote method to +// create instances of the default interface _DispIdAttribute exposed by +// the CoClass DispIdAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDispIdAttribute = class + class function Create: _DispIdAttribute; + class function CreateRemote(const MachineName: string): _DispIdAttribute; + end; + +// *********************************************************************// +// The Class CoInterfaceTypeAttribute provides a Create and CreateRemote method to +// create instances of the default interface _InterfaceTypeAttribute exposed by +// the CoClass InterfaceTypeAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoInterfaceTypeAttribute = class + class function Create: _InterfaceTypeAttribute; + class function CreateRemote(const MachineName: string): _InterfaceTypeAttribute; + end; + +// *********************************************************************// +// The Class CoClassInterfaceAttribute provides a Create and CreateRemote method to +// create instances of the default interface _ClassInterfaceAttribute exposed by +// the CoClass ClassInterfaceAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoClassInterfaceAttribute = class + class function Create: _ClassInterfaceAttribute; + class function CreateRemote(const MachineName: string): _ClassInterfaceAttribute; + end; + +// *********************************************************************// +// The Class CoComVisibleAttribute provides a Create and CreateRemote method to +// create instances of the default interface _ComVisibleAttribute exposed by +// the CoClass ComVisibleAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoComVisibleAttribute = class + class function Create: _ComVisibleAttribute; + class function CreateRemote(const MachineName: string): _ComVisibleAttribute; + end; + +// *********************************************************************// +// The Class CoLCIDConversionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _LCIDConversionAttribute exposed by +// the CoClass LCIDConversionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoLCIDConversionAttribute = class + class function Create: _LCIDConversionAttribute; + class function CreateRemote(const MachineName: string): _LCIDConversionAttribute; + end; + +// *********************************************************************// +// The Class CoComRegisterFunctionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _ComRegisterFunctionAttribute exposed by +// the CoClass ComRegisterFunctionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoComRegisterFunctionAttribute = class + class function Create: _ComRegisterFunctionAttribute; + class function CreateRemote(const MachineName: string): _ComRegisterFunctionAttribute; + end; + +// *********************************************************************// +// The Class CoComUnregisterFunctionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _ComUnregisterFunctionAttribute exposed by +// the CoClass ComUnregisterFunctionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoComUnregisterFunctionAttribute = class + class function Create: _ComUnregisterFunctionAttribute; + class function CreateRemote(const MachineName: string): _ComUnregisterFunctionAttribute; + end; + +// *********************************************************************// +// The Class CoProgIdAttribute provides a Create and CreateRemote method to +// create instances of the default interface _ProgIdAttribute exposed by +// the CoClass ProgIdAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoProgIdAttribute = class + class function Create: _ProgIdAttribute; + class function CreateRemote(const MachineName: string): _ProgIdAttribute; + end; + +// *********************************************************************// +// The Class CoImportedFromTypeLibAttribute provides a Create and CreateRemote method to +// create instances of the default interface _ImportedFromTypeLibAttribute exposed by +// the CoClass ImportedFromTypeLibAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoImportedFromTypeLibAttribute = class + class function Create: _ImportedFromTypeLibAttribute; + class function CreateRemote(const MachineName: string): _ImportedFromTypeLibAttribute; + end; + +// *********************************************************************// +// The Class CoIDispatchImplAttribute provides a Create and CreateRemote method to +// create instances of the default interface _IDispatchImplAttribute exposed by +// the CoClass IDispatchImplAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoIDispatchImplAttribute = class + class function Create: _IDispatchImplAttribute; + class function CreateRemote(const MachineName: string): _IDispatchImplAttribute; + end; + +// *********************************************************************// +// The Class CoComSourceInterfacesAttribute provides a Create and CreateRemote method to +// create instances of the default interface _ComSourceInterfacesAttribute exposed by +// the CoClass ComSourceInterfacesAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoComSourceInterfacesAttribute = class + class function Create: _ComSourceInterfacesAttribute; + class function CreateRemote(const MachineName: string): _ComSourceInterfacesAttribute; + end; + +// *********************************************************************// +// The Class CoComConversionLossAttribute provides a Create and CreateRemote method to +// create instances of the default interface _ComConversionLossAttribute exposed by +// the CoClass ComConversionLossAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoComConversionLossAttribute = class + class function Create: _ComConversionLossAttribute; + class function CreateRemote(const MachineName: string): _ComConversionLossAttribute; + end; + +// *********************************************************************// +// The Class CoTypeLibTypeAttribute provides a Create and CreateRemote method to +// create instances of the default interface _TypeLibTypeAttribute exposed by +// the CoClass TypeLibTypeAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTypeLibTypeAttribute = class + class function Create: _TypeLibTypeAttribute; + class function CreateRemote(const MachineName: string): _TypeLibTypeAttribute; + end; + +// *********************************************************************// +// The Class CoTypeLibFuncAttribute provides a Create and CreateRemote method to +// create instances of the default interface _TypeLibFuncAttribute exposed by +// the CoClass TypeLibFuncAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTypeLibFuncAttribute = class + class function Create: _TypeLibFuncAttribute; + class function CreateRemote(const MachineName: string): _TypeLibFuncAttribute; + end; + +// *********************************************************************// +// The Class CoTypeLibVarAttribute provides a Create and CreateRemote method to +// create instances of the default interface _TypeLibVarAttribute exposed by +// the CoClass TypeLibVarAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTypeLibVarAttribute = class + class function Create: _TypeLibVarAttribute; + class function CreateRemote(const MachineName: string): _TypeLibVarAttribute; + end; + +// *********************************************************************// +// The Class CoMarshalAsAttribute provides a Create and CreateRemote method to +// create instances of the default interface _MarshalAsAttribute exposed by +// the CoClass MarshalAsAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMarshalAsAttribute = class + class function Create: _MarshalAsAttribute; + class function CreateRemote(const MachineName: string): _MarshalAsAttribute; + end; + +// *********************************************************************// +// The Class CoComImportAttribute provides a Create and CreateRemote method to +// create instances of the default interface _ComImportAttribute exposed by +// the CoClass ComImportAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoComImportAttribute = class + class function Create: _ComImportAttribute; + class function CreateRemote(const MachineName: string): _ComImportAttribute; + end; + +// *********************************************************************// +// The Class CoGuidAttribute provides a Create and CreateRemote method to +// create instances of the default interface _GuidAttribute exposed by +// the CoClass GuidAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoGuidAttribute = class + class function Create: _GuidAttribute; + class function CreateRemote(const MachineName: string): _GuidAttribute; + end; + +// *********************************************************************// +// The Class CoPreserveSigAttribute provides a Create and CreateRemote method to +// create instances of the default interface _PreserveSigAttribute exposed by +// the CoClass PreserveSigAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoPreserveSigAttribute = class + class function Create: _PreserveSigAttribute; + class function CreateRemote(const MachineName: string): _PreserveSigAttribute; + end; + +// *********************************************************************// +// The Class CoInAttribute provides a Create and CreateRemote method to +// create instances of the default interface _InAttribute exposed by +// the CoClass InAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoInAttribute = class + class function Create: _InAttribute; + class function CreateRemote(const MachineName: string): _InAttribute; + end; + +// *********************************************************************// +// The Class CoOutAttribute provides a Create and CreateRemote method to +// create instances of the default interface _OutAttribute exposed by +// the CoClass OutAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoOutAttribute = class + class function Create: _OutAttribute; + class function CreateRemote(const MachineName: string): _OutAttribute; + end; + +// *********************************************************************// +// The Class CoOptionalAttribute provides a Create and CreateRemote method to +// create instances of the default interface _OptionalAttribute exposed by +// the CoClass OptionalAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoOptionalAttribute = class + class function Create: _OptionalAttribute; + class function CreateRemote(const MachineName: string): _OptionalAttribute; + end; + +// *********************************************************************// +// The Class CoDllImportAttribute provides a Create and CreateRemote method to +// create instances of the default interface _DllImportAttribute exposed by +// the CoClass DllImportAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDllImportAttribute = class + class function Create: _DllImportAttribute; + class function CreateRemote(const MachineName: string): _DllImportAttribute; + end; + +// *********************************************************************// +// The Class CoStructLayoutAttribute provides a Create and CreateRemote method to +// create instances of the default interface _StructLayoutAttribute exposed by +// the CoClass StructLayoutAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoStructLayoutAttribute = class + class function Create: _StructLayoutAttribute; + class function CreateRemote(const MachineName: string): _StructLayoutAttribute; + end; + +// *********************************************************************// +// The Class CoFieldOffsetAttribute provides a Create and CreateRemote method to +// create instances of the default interface _FieldOffsetAttribute exposed by +// the CoClass FieldOffsetAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFieldOffsetAttribute = class + class function Create: _FieldOffsetAttribute; + class function CreateRemote(const MachineName: string): _FieldOffsetAttribute; + end; + +// *********************************************************************// +// The Class CoComAliasNameAttribute provides a Create and CreateRemote method to +// create instances of the default interface _ComAliasNameAttribute exposed by +// the CoClass ComAliasNameAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoComAliasNameAttribute = class + class function Create: _ComAliasNameAttribute; + class function CreateRemote(const MachineName: string): _ComAliasNameAttribute; + end; + +// *********************************************************************// +// The Class CoAutomationProxyAttribute provides a Create and CreateRemote method to +// create instances of the default interface _AutomationProxyAttribute exposed by +// the CoClass AutomationProxyAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAutomationProxyAttribute = class + class function Create: _AutomationProxyAttribute; + class function CreateRemote(const MachineName: string): _AutomationProxyAttribute; + end; + +// *********************************************************************// +// The Class CoPrimaryInteropAssemblyAttribute provides a Create and CreateRemote method to +// create instances of the default interface _PrimaryInteropAssemblyAttribute exposed by +// the CoClass PrimaryInteropAssemblyAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoPrimaryInteropAssemblyAttribute = class + class function Create: _PrimaryInteropAssemblyAttribute; + class function CreateRemote(const MachineName: string): _PrimaryInteropAssemblyAttribute; + end; + +// *********************************************************************// +// The Class CoCoClassAttribute provides a Create and CreateRemote method to +// create instances of the default interface _CoClassAttribute exposed by +// the CoClass CoClassAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCoClassAttribute = class + class function Create: _CoClassAttribute; + class function CreateRemote(const MachineName: string): _CoClassAttribute; + end; + +// *********************************************************************// +// The Class CoComEventInterfaceAttribute provides a Create and CreateRemote method to +// create instances of the default interface _ComEventInterfaceAttribute exposed by +// the CoClass ComEventInterfaceAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoComEventInterfaceAttribute = class + class function Create: _ComEventInterfaceAttribute; + class function CreateRemote(const MachineName: string): _ComEventInterfaceAttribute; + end; + +// *********************************************************************// +// The Class CoTypeLibVersionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _TypeLibVersionAttribute exposed by +// the CoClass TypeLibVersionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTypeLibVersionAttribute = class + class function Create: _TypeLibVersionAttribute; + class function CreateRemote(const MachineName: string): _TypeLibVersionAttribute; + end; + +// *********************************************************************// +// The Class CoComCompatibleVersionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _ComCompatibleVersionAttribute exposed by +// the CoClass ComCompatibleVersionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoComCompatibleVersionAttribute = class + class function Create: _ComCompatibleVersionAttribute; + class function CreateRemote(const MachineName: string): _ComCompatibleVersionAttribute; + end; + +// *********************************************************************// +// The Class CoBestFitMappingAttribute provides a Create and CreateRemote method to +// create instances of the default interface _BestFitMappingAttribute exposed by +// the CoClass BestFitMappingAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoBestFitMappingAttribute = class + class function Create: _BestFitMappingAttribute; + class function CreateRemote(const MachineName: string): _BestFitMappingAttribute; + end; + +// *********************************************************************// +// The Class CoExternalException provides a Create and CreateRemote method to +// create instances of the default interface _ExternalException exposed by +// the CoClass ExternalException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoExternalException = class + class function Create: _ExternalException; + class function CreateRemote(const MachineName: string): _ExternalException; + end; + +// *********************************************************************// +// The Class CoCOMException provides a Create and CreateRemote method to +// create instances of the default interface _COMException exposed by +// the CoClass COMException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCOMException = class + class function Create: _COMException; + class function CreateRemote(const MachineName: string): _COMException; + end; + +// *********************************************************************// +// The Class CoCurrencyWrapper provides a Create and CreateRemote method to +// create instances of the default interface _CurrencyWrapper exposed by +// the CoClass CurrencyWrapper. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCurrencyWrapper = class + class function Create: _CurrencyWrapper; + class function CreateRemote(const MachineName: string): _CurrencyWrapper; + end; + +// *********************************************************************// +// The Class CoDispatchWrapper provides a Create and CreateRemote method to +// create instances of the default interface _DispatchWrapper exposed by +// the CoClass DispatchWrapper. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDispatchWrapper = class + class function Create: _DispatchWrapper; + class function CreateRemote(const MachineName: string): _DispatchWrapper; + end; + +// *********************************************************************// +// The Class CoErrorWrapper provides a Create and CreateRemote method to +// create instances of the default interface _ErrorWrapper exposed by +// the CoClass ErrorWrapper. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoErrorWrapper = class + class function Create: _ErrorWrapper; + class function CreateRemote(const MachineName: string): _ErrorWrapper; + end; + +// *********************************************************************// +// The Class CoExtensibleClassFactory provides a Create and CreateRemote method to +// create instances of the default interface _ExtensibleClassFactory exposed by +// the CoClass ExtensibleClassFactory. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoExtensibleClassFactory = class + class function Create: _ExtensibleClassFactory; + class function CreateRemote(const MachineName: string): _ExtensibleClassFactory; + end; + +// *********************************************************************// +// The Class CoInvalidComObjectException provides a Create and CreateRemote method to +// create instances of the default interface _InvalidComObjectException exposed by +// the CoClass InvalidComObjectException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoInvalidComObjectException = class + class function Create: _InvalidComObjectException; + class function CreateRemote(const MachineName: string): _InvalidComObjectException; + end; + +// *********************************************************************// +// The Class CoInvalidOleVariantTypeException provides a Create and CreateRemote method to +// create instances of the default interface _InvalidOleVariantTypeException exposed by +// the CoClass InvalidOleVariantTypeException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoInvalidOleVariantTypeException = class + class function Create: _InvalidOleVariantTypeException; + class function CreateRemote(const MachineName: string): _InvalidOleVariantTypeException; + end; + +// *********************************************************************// +// The Class CoMarshal provides a Create and CreateRemote method to +// create instances of the default interface _Marshal exposed by +// the CoClass Marshal. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMarshal = class + class function Create: _Marshal; + class function CreateRemote(const MachineName: string): _Marshal; + end; + +// *********************************************************************// +// The Class CoMarshalDirectiveException provides a Create and CreateRemote method to +// create instances of the default interface _MarshalDirectiveException exposed by +// the CoClass MarshalDirectiveException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMarshalDirectiveException = class + class function Create: _MarshalDirectiveException; + class function CreateRemote(const MachineName: string): _MarshalDirectiveException; + end; + +// *********************************************************************// +// The Class CoObjectCreationDelegate provides a Create and CreateRemote method to +// create instances of the default interface _ObjectCreationDelegate exposed by +// the CoClass ObjectCreationDelegate. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoObjectCreationDelegate = class + class function Create: _ObjectCreationDelegate; + class function CreateRemote(const MachineName: string): _ObjectCreationDelegate; + end; + +// *********************************************************************// +// The Class CoRuntimeEnvironment provides a Create and CreateRemote method to +// create instances of the default interface _RuntimeEnvironment exposed by +// the CoClass RuntimeEnvironment. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRuntimeEnvironment = class + class function Create: _RuntimeEnvironment; + class function CreateRemote(const MachineName: string): _RuntimeEnvironment; + end; + +// *********************************************************************// +// The Class CoSafeArrayRankMismatchException provides a Create and CreateRemote method to +// create instances of the default interface _SafeArrayRankMismatchException exposed by +// the CoClass SafeArrayRankMismatchException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSafeArrayRankMismatchException = class + class function Create: _SafeArrayRankMismatchException; + class function CreateRemote(const MachineName: string): _SafeArrayRankMismatchException; + end; + +// *********************************************************************// +// The Class CoSafeArrayTypeMismatchException provides a Create and CreateRemote method to +// create instances of the default interface _SafeArrayTypeMismatchException exposed by +// the CoClass SafeArrayTypeMismatchException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSafeArrayTypeMismatchException = class + class function Create: _SafeArrayTypeMismatchException; + class function CreateRemote(const MachineName: string): _SafeArrayTypeMismatchException; + end; + +// *********************************************************************// +// The Class CoSEHException provides a Create and CreateRemote method to +// create instances of the default interface _SEHException exposed by +// the CoClass SEHException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSEHException = class + class function Create: _SEHException; + class function CreateRemote(const MachineName: string): _SEHException; + end; + +// *********************************************************************// +// The Class CoUnknownWrapper provides a Create and CreateRemote method to +// create instances of the default interface _UnknownWrapper exposed by +// the CoClass UnknownWrapper. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoUnknownWrapper = class + class function Create: _UnknownWrapper; + class function CreateRemote(const MachineName: string): _UnknownWrapper; + end; + +// *********************************************************************// +// The Class CoBinaryReader provides a Create and CreateRemote method to +// create instances of the default interface _BinaryReader exposed by +// the CoClass BinaryReader. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoBinaryReader = class + class function Create: _BinaryReader; + class function CreateRemote(const MachineName: string): _BinaryReader; + end; + +// *********************************************************************// +// The Class CoBinaryWriter provides a Create and CreateRemote method to +// create instances of the default interface _BinaryWriter exposed by +// the CoClass BinaryWriter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoBinaryWriter = class + class function Create: _BinaryWriter; + class function CreateRemote(const MachineName: string): _BinaryWriter; + end; + +// *********************************************************************// +// The Class CoBufferedStream provides a Create and CreateRemote method to +// create instances of the default interface _BufferedStream exposed by +// the CoClass BufferedStream. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoBufferedStream = class + class function Create: _BufferedStream; + class function CreateRemote(const MachineName: string): _BufferedStream; + end; + +// *********************************************************************// +// The Class CoDirectory provides a Create and CreateRemote method to +// create instances of the default interface _Directory exposed by +// the CoClass Directory. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDirectory = class + class function Create: _Directory; + class function CreateRemote(const MachineName: string): _Directory; + end; + +// *********************************************************************// +// The Class CoFileSystemInfo provides a Create and CreateRemote method to +// create instances of the default interface _FileSystemInfo exposed by +// the CoClass FileSystemInfo. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFileSystemInfo = class + class function Create: _FileSystemInfo; + class function CreateRemote(const MachineName: string): _FileSystemInfo; + end; + +// *********************************************************************// +// The Class CoDirectoryInfo provides a Create and CreateRemote method to +// create instances of the default interface _DirectoryInfo exposed by +// the CoClass DirectoryInfo. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDirectoryInfo = class + class function Create: _DirectoryInfo; + class function CreateRemote(const MachineName: string): _DirectoryInfo; + end; + +// *********************************************************************// +// The Class CoIOException provides a Create and CreateRemote method to +// create instances of the default interface _IOException exposed by +// the CoClass IOException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoIOException = class + class function Create: _IOException; + class function CreateRemote(const MachineName: string): _IOException; + end; + +// *********************************************************************// +// The Class CoDirectoryNotFoundException provides a Create and CreateRemote method to +// create instances of the default interface _DirectoryNotFoundException exposed by +// the CoClass DirectoryNotFoundException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDirectoryNotFoundException = class + class function Create: _DirectoryNotFoundException; + class function CreateRemote(const MachineName: string): _DirectoryNotFoundException; + end; + +// *********************************************************************// +// The Class CoEndOfStreamException provides a Create and CreateRemote method to +// create instances of the default interface _EndOfStreamException exposed by +// the CoClass EndOfStreamException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEndOfStreamException = class + class function Create: _EndOfStreamException; + class function CreateRemote(const MachineName: string): _EndOfStreamException; + end; + +// *********************************************************************// +// The Class CoFile_ provides a Create and CreateRemote method to +// create instances of the default interface _File exposed by +// the CoClass File_. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFile_ = class + class function Create: _File; + class function CreateRemote(const MachineName: string): _File; + end; + +// *********************************************************************// +// The Class CoFileInfo provides a Create and CreateRemote method to +// create instances of the default interface _FileInfo exposed by +// the CoClass FileInfo. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFileInfo = class + class function Create: _FileInfo; + class function CreateRemote(const MachineName: string): _FileInfo; + end; + +// *********************************************************************// +// The Class CoFileLoadException provides a Create and CreateRemote method to +// create instances of the default interface _FileLoadException exposed by +// the CoClass FileLoadException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFileLoadException = class + class function Create: _FileLoadException; + class function CreateRemote(const MachineName: string): _FileLoadException; + end; + +// *********************************************************************// +// The Class CoFileNotFoundException provides a Create and CreateRemote method to +// create instances of the default interface _FileNotFoundException exposed by +// the CoClass FileNotFoundException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFileNotFoundException = class + class function Create: _FileNotFoundException; + class function CreateRemote(const MachineName: string): _FileNotFoundException; + end; + +// *********************************************************************// +// The Class CoFileStream provides a Create and CreateRemote method to +// create instances of the default interface _FileStream exposed by +// the CoClass FileStream. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFileStream = class + class function Create: _FileStream; + class function CreateRemote(const MachineName: string): _FileStream; + end; + +// *********************************************************************// +// The Class CoMemoryStream provides a Create and CreateRemote method to +// create instances of the default interface _MemoryStream exposed by +// the CoClass MemoryStream. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMemoryStream = class + class function Create: _MemoryStream; + class function CreateRemote(const MachineName: string): _MemoryStream; + end; + +// *********************************************************************// +// The Class CoPath provides a Create and CreateRemote method to +// create instances of the default interface _Path exposed by +// the CoClass Path. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoPath = class + class function Create: _Path; + class function CreateRemote(const MachineName: string): _Path; + end; + +// *********************************************************************// +// The Class CoPathTooLongException provides a Create and CreateRemote method to +// create instances of the default interface _PathTooLongException exposed by +// the CoClass PathTooLongException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoPathTooLongException = class + class function Create: _PathTooLongException; + class function CreateRemote(const MachineName: string): _PathTooLongException; + end; + +// *********************************************************************// +// The Class CoTextReader provides a Create and CreateRemote method to +// create instances of the default interface _TextReader exposed by +// the CoClass TextReader. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTextReader = class + class function Create: _TextReader; + class function CreateRemote(const MachineName: string): _TextReader; + end; + +// *********************************************************************// +// The Class CoStreamReader provides a Create and CreateRemote method to +// create instances of the default interface _StreamReader exposed by +// the CoClass StreamReader. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoStreamReader = class + class function Create: _StreamReader; + class function CreateRemote(const MachineName: string): _StreamReader; + end; + +// *********************************************************************// +// The Class CoTextWriter provides a Create and CreateRemote method to +// create instances of the default interface _TextWriter exposed by +// the CoClass TextWriter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTextWriter = class + class function Create: _TextWriter; + class function CreateRemote(const MachineName: string): _TextWriter; + end; + +// *********************************************************************// +// The Class CoStreamWriter provides a Create and CreateRemote method to +// create instances of the default interface _StreamWriter exposed by +// the CoClass StreamWriter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoStreamWriter = class + class function Create: _StreamWriter; + class function CreateRemote(const MachineName: string): _StreamWriter; + end; + +// *********************************************************************// +// The Class CoStringReader provides a Create and CreateRemote method to +// create instances of the default interface _StringReader exposed by +// the CoClass StringReader. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoStringReader = class + class function Create: _StringReader; + class function CreateRemote(const MachineName: string): _StringReader; + end; + +// *********************************************************************// +// The Class CoStringWriter provides a Create and CreateRemote method to +// create instances of the default interface _StringWriter exposed by +// the CoClass StringWriter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoStringWriter = class + class function Create: _StringWriter; + class function CreateRemote(const MachineName: string): _StringWriter; + end; + +// *********************************************************************// +// The Class CoAccessedThroughPropertyAttribute provides a Create and CreateRemote method to +// create instances of the default interface _AccessedThroughPropertyAttribute exposed by +// the CoClass AccessedThroughPropertyAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAccessedThroughPropertyAttribute = class + class function Create: _AccessedThroughPropertyAttribute; + class function CreateRemote(const MachineName: string): _AccessedThroughPropertyAttribute; + end; + +// *********************************************************************// +// The Class CoCallConvCdecl provides a Create and CreateRemote method to +// create instances of the default interface _CallConvCdecl exposed by +// the CoClass CallConvCdecl. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCallConvCdecl = class + class function Create: _CallConvCdecl; + class function CreateRemote(const MachineName: string): _CallConvCdecl; + end; + +// *********************************************************************// +// The Class CoCallConvStdcall provides a Create and CreateRemote method to +// create instances of the default interface _CallConvStdcall exposed by +// the CoClass CallConvStdcall. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCallConvStdcall = class + class function Create: _CallConvStdcall; + class function CreateRemote(const MachineName: string): _CallConvStdcall; + end; + +// *********************************************************************// +// The Class CoCallConvThiscall provides a Create and CreateRemote method to +// create instances of the default interface _CallConvThiscall exposed by +// the CoClass CallConvThiscall. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCallConvThiscall = class + class function Create: _CallConvThiscall; + class function CreateRemote(const MachineName: string): _CallConvThiscall; + end; + +// *********************************************************************// +// The Class CoCallConvFastcall provides a Create and CreateRemote method to +// create instances of the default interface _CallConvFastcall exposed by +// the CoClass CallConvFastcall. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCallConvFastcall = class + class function Create: _CallConvFastcall; + class function CreateRemote(const MachineName: string): _CallConvFastcall; + end; + +// *********************************************************************// +// The Class CoRuntimeHelpers provides a Create and CreateRemote method to +// create instances of the default interface _RuntimeHelpers exposed by +// the CoClass RuntimeHelpers. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRuntimeHelpers = class + class function Create: _RuntimeHelpers; + class function CreateRemote(const MachineName: string): _RuntimeHelpers; + end; + +// *********************************************************************// +// The Class CoCustomConstantAttribute provides a Create and CreateRemote method to +// create instances of the default interface _CustomConstantAttribute exposed by +// the CoClass CustomConstantAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCustomConstantAttribute = class + class function Create: _CustomConstantAttribute; + class function CreateRemote(const MachineName: string): _CustomConstantAttribute; + end; + +// *********************************************************************// +// The Class CoDateTimeConstantAttribute provides a Create and CreateRemote method to +// create instances of the default interface _DateTimeConstantAttribute exposed by +// the CoClass DateTimeConstantAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDateTimeConstantAttribute = class + class function Create: _DateTimeConstantAttribute; + class function CreateRemote(const MachineName: string): _DateTimeConstantAttribute; + end; + +// *********************************************************************// +// The Class CoDiscardableAttribute provides a Create and CreateRemote method to +// create instances of the default interface _DiscardableAttribute exposed by +// the CoClass DiscardableAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDiscardableAttribute = class + class function Create: _DiscardableAttribute; + class function CreateRemote(const MachineName: string): _DiscardableAttribute; + end; + +// *********************************************************************// +// The Class CoDecimalConstantAttribute provides a Create and CreateRemote method to +// create instances of the default interface _DecimalConstantAttribute exposed by +// the CoClass DecimalConstantAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDecimalConstantAttribute = class + class function Create: _DecimalConstantAttribute; + class function CreateRemote(const MachineName: string): _DecimalConstantAttribute; + end; + +// *********************************************************************// +// The Class CoCompilationRelaxationsAttribute provides a Create and CreateRemote method to +// create instances of the default interface _CompilationRelaxationsAttribute exposed by +// the CoClass CompilationRelaxationsAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCompilationRelaxationsAttribute = class + class function Create: _CompilationRelaxationsAttribute; + class function CreateRemote(const MachineName: string): _CompilationRelaxationsAttribute; + end; + +// *********************************************************************// +// The Class CoCompilerGlobalScopeAttribute provides a Create and CreateRemote method to +// create instances of the default interface _CompilerGlobalScopeAttribute exposed by +// the CoClass CompilerGlobalScopeAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCompilerGlobalScopeAttribute = class + class function Create: _CompilerGlobalScopeAttribute; + class function CreateRemote(const MachineName: string): _CompilerGlobalScopeAttribute; + end; + +// *********************************************************************// +// The Class CoIDispatchConstantAttribute provides a Create and CreateRemote method to +// create instances of the default interface _IDispatchConstantAttribute exposed by +// the CoClass IDispatchConstantAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoIDispatchConstantAttribute = class + class function Create: _IDispatchConstantAttribute; + class function CreateRemote(const MachineName: string): _IDispatchConstantAttribute; + end; + +// *********************************************************************// +// The Class CoIndexerNameAttribute provides a Create and CreateRemote method to +// create instances of the default interface _IndexerNameAttribute exposed by +// the CoClass IndexerNameAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoIndexerNameAttribute = class + class function Create: _IndexerNameAttribute; + class function CreateRemote(const MachineName: string): _IndexerNameAttribute; + end; + +// *********************************************************************// +// The Class CoIsVolatile provides a Create and CreateRemote method to +// create instances of the default interface _IsVolatile exposed by +// the CoClass IsVolatile. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoIsVolatile = class + class function Create: _IsVolatile; + class function CreateRemote(const MachineName: string): _IsVolatile; + end; + +// *********************************************************************// +// The Class CoIUnknownConstantAttribute provides a Create and CreateRemote method to +// create instances of the default interface _IUnknownConstantAttribute exposed by +// the CoClass IUnknownConstantAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoIUnknownConstantAttribute = class + class function Create: _IUnknownConstantAttribute; + class function CreateRemote(const MachineName: string): _IUnknownConstantAttribute; + end; + +// *********************************************************************// +// The Class CoMethodImplAttribute provides a Create and CreateRemote method to +// create instances of the default interface _MethodImplAttribute exposed by +// the CoClass MethodImplAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMethodImplAttribute = class + class function Create: _MethodImplAttribute; + class function CreateRemote(const MachineName: string): _MethodImplAttribute; + end; + +// *********************************************************************// +// The Class CoRequiredAttributeAttribute provides a Create and CreateRemote method to +// create instances of the default interface _RequiredAttributeAttribute exposed by +// the CoClass RequiredAttributeAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRequiredAttributeAttribute = class + class function Create: _RequiredAttributeAttribute; + class function CreateRemote(const MachineName: string): _RequiredAttributeAttribute; + end; + +// *********************************************************************// +// The Class CoPermissionSet provides a Create and CreateRemote method to +// create instances of the default interface _PermissionSet exposed by +// the CoClass PermissionSet. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoPermissionSet = class + class function Create: _PermissionSet; + class function CreateRemote(const MachineName: string): _PermissionSet; + end; + +// *********************************************************************// +// The Class CoNamedPermissionSet provides a Create and CreateRemote method to +// create instances of the default interface _NamedPermissionSet exposed by +// the CoClass NamedPermissionSet. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoNamedPermissionSet = class + class function Create: _NamedPermissionSet; + class function CreateRemote(const MachineName: string): _NamedPermissionSet; + end; + +// *********************************************************************// +// The Class CoSecurityElement provides a Create and CreateRemote method to +// create instances of the default interface _SecurityElement exposed by +// the CoClass SecurityElement. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSecurityElement = class + class function Create: _SecurityElement; + class function CreateRemote(const MachineName: string): _SecurityElement; + end; + +// *********************************************************************// +// The Class CoXmlSyntaxException provides a Create and CreateRemote method to +// create instances of the default interface _XmlSyntaxException exposed by +// the CoClass XmlSyntaxException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoXmlSyntaxException = class + class function Create: _XmlSyntaxException; + class function CreateRemote(const MachineName: string): _XmlSyntaxException; + end; + +// *********************************************************************// +// The Class CoCodeAccessPermission provides a Create and CreateRemote method to +// create instances of the default interface _CodeAccessPermission exposed by +// the CoClass CodeAccessPermission. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCodeAccessPermission = class + class function Create: _CodeAccessPermission; + class function CreateRemote(const MachineName: string): _CodeAccessPermission; + end; + +// *********************************************************************// +// The Class CoEnvironmentPermission provides a Create and CreateRemote method to +// create instances of the default interface _EnvironmentPermission exposed by +// the CoClass EnvironmentPermission. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEnvironmentPermission = class + class function Create: _EnvironmentPermission; + class function CreateRemote(const MachineName: string): _EnvironmentPermission; + end; + +// *********************************************************************// +// The Class CoFileDialogPermission provides a Create and CreateRemote method to +// create instances of the default interface _FileDialogPermission exposed by +// the CoClass FileDialogPermission. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFileDialogPermission = class + class function Create: _FileDialogPermission; + class function CreateRemote(const MachineName: string): _FileDialogPermission; + end; + +// *********************************************************************// +// The Class CoFileIOPermission provides a Create and CreateRemote method to +// create instances of the default interface _FileIOPermission exposed by +// the CoClass FileIOPermission. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFileIOPermission = class + class function Create: _FileIOPermission; + class function CreateRemote(const MachineName: string): _FileIOPermission; + end; + +// *********************************************************************// +// The Class CoIsolatedStoragePermission provides a Create and CreateRemote method to +// create instances of the default interface _IsolatedStoragePermission exposed by +// the CoClass IsolatedStoragePermission. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoIsolatedStoragePermission = class + class function Create: _IsolatedStoragePermission; + class function CreateRemote(const MachineName: string): _IsolatedStoragePermission; + end; + +// *********************************************************************// +// The Class CoIsolatedStorageFilePermission provides a Create and CreateRemote method to +// create instances of the default interface _IsolatedStorageFilePermission exposed by +// the CoClass IsolatedStorageFilePermission. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoIsolatedStorageFilePermission = class + class function Create: _IsolatedStorageFilePermission; + class function CreateRemote(const MachineName: string): _IsolatedStorageFilePermission; + end; + +// *********************************************************************// +// The Class CoSecurityAttribute provides a Create and CreateRemote method to +// create instances of the default interface _SecurityAttribute exposed by +// the CoClass SecurityAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSecurityAttribute = class + class function Create: _SecurityAttribute; + class function CreateRemote(const MachineName: string): _SecurityAttribute; + end; + +// *********************************************************************// +// The Class CoCodeAccessSecurityAttribute provides a Create and CreateRemote method to +// create instances of the default interface _CodeAccessSecurityAttribute exposed by +// the CoClass CodeAccessSecurityAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCodeAccessSecurityAttribute = class + class function Create: _CodeAccessSecurityAttribute; + class function CreateRemote(const MachineName: string): _CodeAccessSecurityAttribute; + end; + +// *********************************************************************// +// The Class CoEnvironmentPermissionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _EnvironmentPermissionAttribute exposed by +// the CoClass EnvironmentPermissionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEnvironmentPermissionAttribute = class + class function Create: _EnvironmentPermissionAttribute; + class function CreateRemote(const MachineName: string): _EnvironmentPermissionAttribute; + end; + +// *********************************************************************// +// The Class CoFileDialogPermissionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _FileDialogPermissionAttribute exposed by +// the CoClass FileDialogPermissionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFileDialogPermissionAttribute = class + class function Create: _FileDialogPermissionAttribute; + class function CreateRemote(const MachineName: string): _FileDialogPermissionAttribute; + end; + +// *********************************************************************// +// The Class CoFileIOPermissionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _FileIOPermissionAttribute exposed by +// the CoClass FileIOPermissionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFileIOPermissionAttribute = class + class function Create: _FileIOPermissionAttribute; + class function CreateRemote(const MachineName: string): _FileIOPermissionAttribute; + end; + +// *********************************************************************// +// The Class CoPrincipalPermissionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _PrincipalPermissionAttribute exposed by +// the CoClass PrincipalPermissionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoPrincipalPermissionAttribute = class + class function Create: _PrincipalPermissionAttribute; + class function CreateRemote(const MachineName: string): _PrincipalPermissionAttribute; + end; + +// *********************************************************************// +// The Class CoReflectionPermissionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _ReflectionPermissionAttribute exposed by +// the CoClass ReflectionPermissionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoReflectionPermissionAttribute = class + class function Create: _ReflectionPermissionAttribute; + class function CreateRemote(const MachineName: string): _ReflectionPermissionAttribute; + end; + +// *********************************************************************// +// The Class CoRegistryPermissionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _RegistryPermissionAttribute exposed by +// the CoClass RegistryPermissionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRegistryPermissionAttribute = class + class function Create: _RegistryPermissionAttribute; + class function CreateRemote(const MachineName: string): _RegistryPermissionAttribute; + end; + +// *********************************************************************// +// The Class CoSecurityPermissionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _SecurityPermissionAttribute exposed by +// the CoClass SecurityPermissionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSecurityPermissionAttribute = class + class function Create: _SecurityPermissionAttribute; + class function CreateRemote(const MachineName: string): _SecurityPermissionAttribute; + end; + +// *********************************************************************// +// The Class CoUIPermissionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _UIPermissionAttribute exposed by +// the CoClass UIPermissionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoUIPermissionAttribute = class + class function Create: _UIPermissionAttribute; + class function CreateRemote(const MachineName: string): _UIPermissionAttribute; + end; + +// *********************************************************************// +// The Class CoZoneIdentityPermissionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _ZoneIdentityPermissionAttribute exposed by +// the CoClass ZoneIdentityPermissionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoZoneIdentityPermissionAttribute = class + class function Create: _ZoneIdentityPermissionAttribute; + class function CreateRemote(const MachineName: string): _ZoneIdentityPermissionAttribute; + end; + +// *********************************************************************// +// The Class CoStrongNameIdentityPermissionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _StrongNameIdentityPermissionAttribute exposed by +// the CoClass StrongNameIdentityPermissionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoStrongNameIdentityPermissionAttribute = class + class function Create: _StrongNameIdentityPermissionAttribute; + class function CreateRemote(const MachineName: string): _StrongNameIdentityPermissionAttribute; + end; + +// *********************************************************************// +// The Class CoSiteIdentityPermissionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _SiteIdentityPermissionAttribute exposed by +// the CoClass SiteIdentityPermissionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSiteIdentityPermissionAttribute = class + class function Create: _SiteIdentityPermissionAttribute; + class function CreateRemote(const MachineName: string): _SiteIdentityPermissionAttribute; + end; + +// *********************************************************************// +// The Class CoUrlIdentityPermissionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _UrlIdentityPermissionAttribute exposed by +// the CoClass UrlIdentityPermissionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoUrlIdentityPermissionAttribute = class + class function Create: _UrlIdentityPermissionAttribute; + class function CreateRemote(const MachineName: string): _UrlIdentityPermissionAttribute; + end; + +// *********************************************************************// +// The Class CoPublisherIdentityPermissionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _PublisherIdentityPermissionAttribute exposed by +// the CoClass PublisherIdentityPermissionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoPublisherIdentityPermissionAttribute = class + class function Create: _PublisherIdentityPermissionAttribute; + class function CreateRemote(const MachineName: string): _PublisherIdentityPermissionAttribute; + end; + +// *********************************************************************// +// The Class CoIsolatedStoragePermissionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _IsolatedStoragePermissionAttribute exposed by +// the CoClass IsolatedStoragePermissionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoIsolatedStoragePermissionAttribute = class + class function Create: _IsolatedStoragePermissionAttribute; + class function CreateRemote(const MachineName: string): _IsolatedStoragePermissionAttribute; + end; + +// *********************************************************************// +// The Class CoIsolatedStorageFilePermissionAttribute provides a Create and CreateRemote method to +// create instances of the default interface _IsolatedStorageFilePermissionAttribute exposed by +// the CoClass IsolatedStorageFilePermissionAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoIsolatedStorageFilePermissionAttribute = class + class function Create: _IsolatedStorageFilePermissionAttribute; + class function CreateRemote(const MachineName: string): _IsolatedStorageFilePermissionAttribute; + end; + +// *********************************************************************// +// The Class CoPermissionSetAttribute provides a Create and CreateRemote method to +// create instances of the default interface _PermissionSetAttribute exposed by +// the CoClass PermissionSetAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoPermissionSetAttribute = class + class function Create: _PermissionSetAttribute; + class function CreateRemote(const MachineName: string): _PermissionSetAttribute; + end; + +// *********************************************************************// +// The Class CoPublisherIdentityPermission provides a Create and CreateRemote method to +// create instances of the default interface _PublisherIdentityPermission exposed by +// the CoClass PublisherIdentityPermission. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoPublisherIdentityPermission = class + class function Create: _PublisherIdentityPermission; + class function CreateRemote(const MachineName: string): _PublisherIdentityPermission; + end; + +// *********************************************************************// +// The Class CoReflectionPermission provides a Create and CreateRemote method to +// create instances of the default interface _ReflectionPermission exposed by +// the CoClass ReflectionPermission. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoReflectionPermission = class + class function Create: _ReflectionPermission; + class function CreateRemote(const MachineName: string): _ReflectionPermission; + end; + +// *********************************************************************// +// The Class CoRegistryPermission provides a Create and CreateRemote method to +// create instances of the default interface _RegistryPermission exposed by +// the CoClass RegistryPermission. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRegistryPermission = class + class function Create: _RegistryPermission; + class function CreateRemote(const MachineName: string): _RegistryPermission; + end; + +// *********************************************************************// +// The Class CoPrincipalPermission provides a Create and CreateRemote method to +// create instances of the default interface _PrincipalPermission exposed by +// the CoClass PrincipalPermission. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoPrincipalPermission = class + class function Create: _PrincipalPermission; + class function CreateRemote(const MachineName: string): _PrincipalPermission; + end; + +// *********************************************************************// +// The Class CoSecurityPermission provides a Create and CreateRemote method to +// create instances of the default interface _SecurityPermission exposed by +// the CoClass SecurityPermission. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSecurityPermission = class + class function Create: _SecurityPermission; + class function CreateRemote(const MachineName: string): _SecurityPermission; + end; + +// *********************************************************************// +// The Class CoSiteIdentityPermission provides a Create and CreateRemote method to +// create instances of the default interface _SiteIdentityPermission exposed by +// the CoClass SiteIdentityPermission. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSiteIdentityPermission = class + class function Create: _SiteIdentityPermission; + class function CreateRemote(const MachineName: string): _SiteIdentityPermission; + end; + +// *********************************************************************// +// The Class CoStrongNameIdentityPermission provides a Create and CreateRemote method to +// create instances of the default interface _StrongNameIdentityPermission exposed by +// the CoClass StrongNameIdentityPermission. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoStrongNameIdentityPermission = class + class function Create: _StrongNameIdentityPermission; + class function CreateRemote(const MachineName: string): _StrongNameIdentityPermission; + end; + +// *********************************************************************// +// The Class CoStrongNamePublicKeyBlob provides a Create and CreateRemote method to +// create instances of the default interface _StrongNamePublicKeyBlob exposed by +// the CoClass StrongNamePublicKeyBlob. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoStrongNamePublicKeyBlob = class + class function Create: _StrongNamePublicKeyBlob; + class function CreateRemote(const MachineName: string): _StrongNamePublicKeyBlob; + end; + +// *********************************************************************// +// The Class CoUIPermission provides a Create and CreateRemote method to +// create instances of the default interface _UIPermission exposed by +// the CoClass UIPermission. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoUIPermission = class + class function Create: _UIPermission; + class function CreateRemote(const MachineName: string): _UIPermission; + end; + +// *********************************************************************// +// The Class CoUrlIdentityPermission provides a Create and CreateRemote method to +// create instances of the default interface _UrlIdentityPermission exposed by +// the CoClass UrlIdentityPermission. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoUrlIdentityPermission = class + class function Create: _UrlIdentityPermission; + class function CreateRemote(const MachineName: string): _UrlIdentityPermission; + end; + +// *********************************************************************// +// The Class CoZoneIdentityPermission provides a Create and CreateRemote method to +// create instances of the default interface _ZoneIdentityPermission exposed by +// the CoClass ZoneIdentityPermission. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoZoneIdentityPermission = class + class function Create: _ZoneIdentityPermission; + class function CreateRemote(const MachineName: string): _ZoneIdentityPermission; + end; + +// *********************************************************************// +// The Class CoSuppressUnmanagedCodeSecurityAttribute provides a Create and CreateRemote method to +// create instances of the default interface _SuppressUnmanagedCodeSecurityAttribute exposed by +// the CoClass SuppressUnmanagedCodeSecurityAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSuppressUnmanagedCodeSecurityAttribute = class + class function Create: _SuppressUnmanagedCodeSecurityAttribute; + class function CreateRemote(const MachineName: string): _SuppressUnmanagedCodeSecurityAttribute; + end; + +// *********************************************************************// +// The Class CoUnverifiableCodeAttribute provides a Create and CreateRemote method to +// create instances of the default interface _UnverifiableCodeAttribute exposed by +// the CoClass UnverifiableCodeAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoUnverifiableCodeAttribute = class + class function Create: _UnverifiableCodeAttribute; + class function CreateRemote(const MachineName: string): _UnverifiableCodeAttribute; + end; + +// *********************************************************************// +// The Class CoAllowPartiallyTrustedCallersAttribute provides a Create and CreateRemote method to +// create instances of the default interface _AllowPartiallyTrustedCallersAttribute exposed by +// the CoClass AllowPartiallyTrustedCallersAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAllowPartiallyTrustedCallersAttribute = class + class function Create: _AllowPartiallyTrustedCallersAttribute; + class function CreateRemote(const MachineName: string): _AllowPartiallyTrustedCallersAttribute; + end; + +// *********************************************************************// +// The Class CoSecurityException provides a Create and CreateRemote method to +// create instances of the default interface _SecurityException exposed by +// the CoClass SecurityException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSecurityException = class + class function Create: _SecurityException; + class function CreateRemote(const MachineName: string): _SecurityException; + end; + +// *********************************************************************// +// The Class CoSecurityManager provides a Create and CreateRemote method to +// create instances of the default interface _SecurityManager exposed by +// the CoClass SecurityManager. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSecurityManager = class + class function Create: _SecurityManager; + class function CreateRemote(const MachineName: string): _SecurityManager; + end; + +// *********************************************************************// +// The Class CoVerificationException provides a Create and CreateRemote method to +// create instances of the default interface _VerificationException exposed by +// the CoClass VerificationException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoVerificationException = class + class function Create: _VerificationException; + class function CreateRemote(const MachineName: string): _VerificationException; + end; + +// *********************************************************************// +// The Class CoContextAttribute provides a Create and CreateRemote method to +// create instances of the default interface _ContextAttribute exposed by +// the CoClass ContextAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoContextAttribute = class + class function Create: _ContextAttribute; + class function CreateRemote(const MachineName: string): _ContextAttribute; + end; + +// *********************************************************************// +// The Class CoAsyncResult provides a Create and CreateRemote method to +// create instances of the default interface _AsyncResult exposed by +// the CoClass AsyncResult. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAsyncResult = class + class function Create: _AsyncResult; + class function CreateRemote(const MachineName: string): _AsyncResult; + end; + +// *********************************************************************// +// The Class CoCallContext provides a Create and CreateRemote method to +// create instances of the default interface _CallContext exposed by +// the CoClass CallContext. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCallContext = class + class function Create: _CallContext; + class function CreateRemote(const MachineName: string): _CallContext; + end; + +// *********************************************************************// +// The Class CoLogicalCallContext provides a Create and CreateRemote method to +// create instances of the default interface _LogicalCallContext exposed by +// the CoClass LogicalCallContext. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoLogicalCallContext = class + class function Create: _LogicalCallContext; + class function CreateRemote(const MachineName: string): _LogicalCallContext; + end; + +// *********************************************************************// +// The Class CoChannelServices provides a Create and CreateRemote method to +// create instances of the default interface _ChannelServices exposed by +// the CoClass ChannelServices. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoChannelServices = class + class function Create: _ChannelServices; + class function CreateRemote(const MachineName: string): _ChannelServices; + end; + +// *********************************************************************// +// The Class CoClientChannelSinkStack provides a Create and CreateRemote method to +// create instances of the default interface _ClientChannelSinkStack exposed by +// the CoClass ClientChannelSinkStack. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoClientChannelSinkStack = class + class function Create: _ClientChannelSinkStack; + class function CreateRemote(const MachineName: string): _ClientChannelSinkStack; + end; + +// *********************************************************************// +// The Class CoServerChannelSinkStack provides a Create and CreateRemote method to +// create instances of the default interface _ServerChannelSinkStack exposed by +// the CoClass ServerChannelSinkStack. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoServerChannelSinkStack = class + class function Create: _ServerChannelSinkStack; + class function CreateRemote(const MachineName: string): _ServerChannelSinkStack; + end; + +// *********************************************************************// +// The Class CoInternalMessageWrapper provides a Create and CreateRemote method to +// create instances of the default interface _InternalMessageWrapper exposed by +// the CoClass InternalMessageWrapper. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoInternalMessageWrapper = class + class function Create: _InternalMessageWrapper; + class function CreateRemote(const MachineName: string): _InternalMessageWrapper; + end; + +// *********************************************************************// +// The Class CoMethodCallMessageWrapper provides a Create and CreateRemote method to +// create instances of the default interface _MethodCallMessageWrapper exposed by +// the CoClass MethodCallMessageWrapper. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMethodCallMessageWrapper = class + class function Create: _MethodCallMessageWrapper; + class function CreateRemote(const MachineName: string): _MethodCallMessageWrapper; + end; + +// *********************************************************************// +// The Class CoClientSponsor provides a Create and CreateRemote method to +// create instances of the default interface _ClientSponsor exposed by +// the CoClass ClientSponsor. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoClientSponsor = class + class function Create: _ClientSponsor; + class function CreateRemote(const MachineName: string): _ClientSponsor; + end; + +// *********************************************************************// +// The Class CoCrossContextDelegate provides a Create and CreateRemote method to +// create instances of the default interface _CrossContextDelegate exposed by +// the CoClass CrossContextDelegate. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCrossContextDelegate = class + class function Create: _CrossContextDelegate; + class function CreateRemote(const MachineName: string): _CrossContextDelegate; + end; + +// *********************************************************************// +// The Class CoContext provides a Create and CreateRemote method to +// create instances of the default interface _Context exposed by +// the CoClass Context. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoContext = class + class function Create: _Context; + class function CreateRemote(const MachineName: string): _Context; + end; + +// *********************************************************************// +// The Class CoContextProperty provides a Create and CreateRemote method to +// create instances of the default interface _ContextProperty exposed by +// the CoClass ContextProperty. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoContextProperty = class + class function Create: _ContextProperty; + class function CreateRemote(const MachineName: string): _ContextProperty; + end; + +// *********************************************************************// +// The Class CoEnterpriseServicesHelper provides a Create and CreateRemote method to +// create instances of the default interface _EnterpriseServicesHelper exposed by +// the CoClass EnterpriseServicesHelper. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEnterpriseServicesHelper = class + class function Create: _EnterpriseServicesHelper; + class function CreateRemote(const MachineName: string): _EnterpriseServicesHelper; + end; + +// *********************************************************************// +// The Class CoHeader provides a Create and CreateRemote method to +// create instances of the default interface _Header exposed by +// the CoClass Header. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoHeader = class + class function Create: _Header; + class function CreateRemote(const MachineName: string): _Header; + end; + +// *********************************************************************// +// The Class CoHeaderHandler provides a Create and CreateRemote method to +// create instances of the default interface _HeaderHandler exposed by +// the CoClass HeaderHandler. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoHeaderHandler = class + class function Create: _HeaderHandler; + class function CreateRemote(const MachineName: string): _HeaderHandler; + end; + +// *********************************************************************// +// The Class CoChannelDataStore provides a Create and CreateRemote method to +// create instances of the default interface _ChannelDataStore exposed by +// the CoClass ChannelDataStore. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoChannelDataStore = class + class function Create: _ChannelDataStore; + class function CreateRemote(const MachineName: string): _ChannelDataStore; + end; + +// *********************************************************************// +// The Class CoTransportHeaders provides a Create and CreateRemote method to +// create instances of the default interface _TransportHeaders exposed by +// the CoClass TransportHeaders. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTransportHeaders = class + class function Create: _TransportHeaders; + class function CreateRemote(const MachineName: string): _TransportHeaders; + end; + +// *********************************************************************// +// The Class CoSinkProviderData provides a Create and CreateRemote method to +// create instances of the default interface _SinkProviderData exposed by +// the CoClass SinkProviderData. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSinkProviderData = class + class function Create: _SinkProviderData; + class function CreateRemote(const MachineName: string): _SinkProviderData; + end; + +// *********************************************************************// +// The Class CoBaseChannelObjectWithProperties provides a Create and CreateRemote method to +// create instances of the default interface _BaseChannelObjectWithProperties exposed by +// the CoClass BaseChannelObjectWithProperties. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoBaseChannelObjectWithProperties = class + class function Create: _BaseChannelObjectWithProperties; + class function CreateRemote(const MachineName: string): _BaseChannelObjectWithProperties; + end; + +// *********************************************************************// +// The Class CoBaseChannelSinkWithProperties provides a Create and CreateRemote method to +// create instances of the default interface _BaseChannelSinkWithProperties exposed by +// the CoClass BaseChannelSinkWithProperties. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoBaseChannelSinkWithProperties = class + class function Create: _BaseChannelSinkWithProperties; + class function CreateRemote(const MachineName: string): _BaseChannelSinkWithProperties; + end; + +// *********************************************************************// +// The Class CoBaseChannelWithProperties provides a Create and CreateRemote method to +// create instances of the default interface _BaseChannelWithProperties exposed by +// the CoClass BaseChannelWithProperties. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoBaseChannelWithProperties = class + class function Create: _BaseChannelWithProperties; + class function CreateRemote(const MachineName: string): _BaseChannelWithProperties; + end; + +// *********************************************************************// +// The Class CoLifetimeServices provides a Create and CreateRemote method to +// create instances of the default interface _LifetimeServices exposed by +// the CoClass LifetimeServices. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoLifetimeServices = class + class function Create: _LifetimeServices; + class function CreateRemote(const MachineName: string): _LifetimeServices; + end; + +// *********************************************************************// +// The Class CoReturnMessage provides a Create and CreateRemote method to +// create instances of the default interface _ReturnMessage exposed by +// the CoClass ReturnMessage. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoReturnMessage = class + class function Create: _ReturnMessage; + class function CreateRemote(const MachineName: string): _ReturnMessage; + end; + +// *********************************************************************// +// The Class CoMethodCall provides a Create and CreateRemote method to +// create instances of the default interface _MethodCall exposed by +// the CoClass MethodCall. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMethodCall = class + class function Create: _MethodCall; + class function CreateRemote(const MachineName: string): _MethodCall; + end; + +// *********************************************************************// +// The Class CoConstructionCall provides a Create and CreateRemote method to +// create instances of the default interface _ConstructionCall exposed by +// the CoClass ConstructionCall. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoConstructionCall = class + class function Create: _ConstructionCall; + class function CreateRemote(const MachineName: string): _ConstructionCall; + end; + +// *********************************************************************// +// The Class CoMethodResponse provides a Create and CreateRemote method to +// create instances of the default interface _MethodResponse exposed by +// the CoClass MethodResponse. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMethodResponse = class + class function Create: _MethodResponse; + class function CreateRemote(const MachineName: string): _MethodResponse; + end; + +// *********************************************************************// +// The Class CoConstructionResponse provides a Create and CreateRemote method to +// create instances of the default interface _ConstructionResponse exposed by +// the CoClass ConstructionResponse. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoConstructionResponse = class + class function Create: _ConstructionResponse; + class function CreateRemote(const MachineName: string): _ConstructionResponse; + end; + +// *********************************************************************// +// The Class CoMethodReturnMessageWrapper provides a Create and CreateRemote method to +// create instances of the default interface _MethodReturnMessageWrapper exposed by +// the CoClass MethodReturnMessageWrapper. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMethodReturnMessageWrapper = class + class function Create: _MethodReturnMessageWrapper; + class function CreateRemote(const MachineName: string): _MethodReturnMessageWrapper; + end; + +// *********************************************************************// +// The Class CoObjectHandle provides a Create and CreateRemote method to +// create instances of the default interface _ObjectHandle exposed by +// the CoClass ObjectHandle. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoObjectHandle = class + class function Create: _ObjectHandle; + class function CreateRemote(const MachineName: string): _ObjectHandle; + end; + +// *********************************************************************// +// The Class CoObjRef provides a Create and CreateRemote method to +// create instances of the default interface _ObjRef exposed by +// the CoClass ObjRef. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoObjRef = class + class function Create: _ObjRef; + class function CreateRemote(const MachineName: string): _ObjRef; + end; + +// *********************************************************************// +// The Class CoOneWayAttribute provides a Create and CreateRemote method to +// create instances of the default interface _OneWayAttribute exposed by +// the CoClass OneWayAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoOneWayAttribute = class + class function Create: _OneWayAttribute; + class function CreateRemote(const MachineName: string): _OneWayAttribute; + end; + +// *********************************************************************// +// The Class CoProxyAttribute provides a Create and CreateRemote method to +// create instances of the default interface _ProxyAttribute exposed by +// the CoClass ProxyAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoProxyAttribute = class + class function Create: _ProxyAttribute; + class function CreateRemote(const MachineName: string): _ProxyAttribute; + end; + +// *********************************************************************// +// The Class CoRealProxy provides a Create and CreateRemote method to +// create instances of the default interface _RealProxy exposed by +// the CoClass RealProxy. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRealProxy = class + class function Create: _RealProxy; + class function CreateRemote(const MachineName: string): _RealProxy; + end; + +// *********************************************************************// +// The Class CoSoapAttribute provides a Create and CreateRemote method to +// create instances of the default interface _SoapAttribute exposed by +// the CoClass SoapAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapAttribute = class + class function Create: _SoapAttribute; + class function CreateRemote(const MachineName: string): _SoapAttribute; + end; + +// *********************************************************************// +// The Class CoSoapTypeAttribute provides a Create and CreateRemote method to +// create instances of the default interface _SoapTypeAttribute exposed by +// the CoClass SoapTypeAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapTypeAttribute = class + class function Create: _SoapTypeAttribute; + class function CreateRemote(const MachineName: string): _SoapTypeAttribute; + end; + +// *********************************************************************// +// The Class CoSoapMethodAttribute provides a Create and CreateRemote method to +// create instances of the default interface _SoapMethodAttribute exposed by +// the CoClass SoapMethodAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapMethodAttribute = class + class function Create: _SoapMethodAttribute; + class function CreateRemote(const MachineName: string): _SoapMethodAttribute; + end; + +// *********************************************************************// +// The Class CoSoapFieldAttribute provides a Create and CreateRemote method to +// create instances of the default interface _SoapFieldAttribute exposed by +// the CoClass SoapFieldAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapFieldAttribute = class + class function Create: _SoapFieldAttribute; + class function CreateRemote(const MachineName: string): _SoapFieldAttribute; + end; + +// *********************************************************************// +// The Class CoSoapParameterAttribute provides a Create and CreateRemote method to +// create instances of the default interface _SoapParameterAttribute exposed by +// the CoClass SoapParameterAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapParameterAttribute = class + class function Create: _SoapParameterAttribute; + class function CreateRemote(const MachineName: string): _SoapParameterAttribute; + end; + +// *********************************************************************// +// The Class CoRemotingConfiguration provides a Create and CreateRemote method to +// create instances of the default interface _RemotingConfiguration exposed by +// the CoClass RemotingConfiguration. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRemotingConfiguration = class + class function Create: _RemotingConfiguration; + class function CreateRemote(const MachineName: string): _RemotingConfiguration; + end; + +// *********************************************************************// +// The Class CoSystem_Runtime_Remoting_TypeEntry provides a Create and CreateRemote method to +// create instances of the default interface _System_Runtime_Remoting_TypeEntry exposed by +// the CoClass System_Runtime_Remoting_TypeEntry. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSystem_Runtime_Remoting_TypeEntry = class + class function Create: _System_Runtime_Remoting_TypeEntry; + class function CreateRemote(const MachineName: string): _System_Runtime_Remoting_TypeEntry; + end; + +// *********************************************************************// +// The Class CoActivatedClientTypeEntry provides a Create and CreateRemote method to +// create instances of the default interface _ActivatedClientTypeEntry exposed by +// the CoClass ActivatedClientTypeEntry. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoActivatedClientTypeEntry = class + class function Create: _ActivatedClientTypeEntry; + class function CreateRemote(const MachineName: string): _ActivatedClientTypeEntry; + end; + +// *********************************************************************// +// The Class CoActivatedServiceTypeEntry provides a Create and CreateRemote method to +// create instances of the default interface _ActivatedServiceTypeEntry exposed by +// the CoClass ActivatedServiceTypeEntry. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoActivatedServiceTypeEntry = class + class function Create: _ActivatedServiceTypeEntry; + class function CreateRemote(const MachineName: string): _ActivatedServiceTypeEntry; + end; + +// *********************************************************************// +// The Class CoWellKnownClientTypeEntry provides a Create and CreateRemote method to +// create instances of the default interface _WellKnownClientTypeEntry exposed by +// the CoClass WellKnownClientTypeEntry. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoWellKnownClientTypeEntry = class + class function Create: _WellKnownClientTypeEntry; + class function CreateRemote(const MachineName: string): _WellKnownClientTypeEntry; + end; + +// *********************************************************************// +// The Class CoWellKnownServiceTypeEntry provides a Create and CreateRemote method to +// create instances of the default interface _WellKnownServiceTypeEntry exposed by +// the CoClass WellKnownServiceTypeEntry. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoWellKnownServiceTypeEntry = class + class function Create: _WellKnownServiceTypeEntry; + class function CreateRemote(const MachineName: string): _WellKnownServiceTypeEntry; + end; + +// *********************************************************************// +// The Class CoRemotingException provides a Create and CreateRemote method to +// create instances of the default interface _RemotingException exposed by +// the CoClass RemotingException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRemotingException = class + class function Create: _RemotingException; + class function CreateRemote(const MachineName: string): _RemotingException; + end; + +// *********************************************************************// +// The Class CoServerException provides a Create and CreateRemote method to +// create instances of the default interface _ServerException exposed by +// the CoClass ServerException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoServerException = class + class function Create: _ServerException; + class function CreateRemote(const MachineName: string): _ServerException; + end; + +// *********************************************************************// +// The Class CoRemotingTimeoutException provides a Create and CreateRemote method to +// create instances of the default interface _RemotingTimeoutException exposed by +// the CoClass RemotingTimeoutException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRemotingTimeoutException = class + class function Create: _RemotingTimeoutException; + class function CreateRemote(const MachineName: string): _RemotingTimeoutException; + end; + +// *********************************************************************// +// The Class CoRemotingServices provides a Create and CreateRemote method to +// create instances of the default interface _RemotingServices exposed by +// the CoClass RemotingServices. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRemotingServices = class + class function Create: _RemotingServices; + class function CreateRemote(const MachineName: string): _RemotingServices; + end; + +// *********************************************************************// +// The Class CoInternalRemotingServices provides a Create and CreateRemote method to +// create instances of the default interface _InternalRemotingServices exposed by +// the CoClass InternalRemotingServices. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoInternalRemotingServices = class + class function Create: _InternalRemotingServices; + class function CreateRemote(const MachineName: string): _InternalRemotingServices; + end; + +// *********************************************************************// +// The Class CoMessageSurrogateFilter provides a Create and CreateRemote method to +// create instances of the default interface _MessageSurrogateFilter exposed by +// the CoClass MessageSurrogateFilter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMessageSurrogateFilter = class + class function Create: _MessageSurrogateFilter; + class function CreateRemote(const MachineName: string): _MessageSurrogateFilter; + end; + +// *********************************************************************// +// The Class CoRemotingSurrogateSelector provides a Create and CreateRemote method to +// create instances of the default interface _RemotingSurrogateSelector exposed by +// the CoClass RemotingSurrogateSelector. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoRemotingSurrogateSelector = class + class function Create: _RemotingSurrogateSelector; + class function CreateRemote(const MachineName: string): _RemotingSurrogateSelector; + end; + +// *********************************************************************// +// The Class CoSoapServices provides a Create and CreateRemote method to +// create instances of the default interface _SoapServices exposed by +// the CoClass SoapServices. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapServices = class + class function Create: _SoapServices; + class function CreateRemote(const MachineName: string): _SoapServices; + end; + +// *********************************************************************// +// The Class CoSoapDateTime provides a Create and CreateRemote method to +// create instances of the default interface _SoapDateTime exposed by +// the CoClass SoapDateTime. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapDateTime = class + class function Create: _SoapDateTime; + class function CreateRemote(const MachineName: string): _SoapDateTime; + end; + +// *********************************************************************// +// The Class CoSoapDuration provides a Create and CreateRemote method to +// create instances of the default interface _SoapDuration exposed by +// the CoClass SoapDuration. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapDuration = class + class function Create: _SoapDuration; + class function CreateRemote(const MachineName: string): _SoapDuration; + end; + +// *********************************************************************// +// The Class CoSoapTime provides a Create and CreateRemote method to +// create instances of the default interface _SoapTime exposed by +// the CoClass SoapTime. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapTime = class + class function Create: _SoapTime; + class function CreateRemote(const MachineName: string): _SoapTime; + end; + +// *********************************************************************// +// The Class CoSoapDate provides a Create and CreateRemote method to +// create instances of the default interface _SoapDate exposed by +// the CoClass SoapDate. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapDate = class + class function Create: _SoapDate; + class function CreateRemote(const MachineName: string): _SoapDate; + end; + +// *********************************************************************// +// The Class CoSoapYearMonth provides a Create and CreateRemote method to +// create instances of the default interface _SoapYearMonth exposed by +// the CoClass SoapYearMonth. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapYearMonth = class + class function Create: _SoapYearMonth; + class function CreateRemote(const MachineName: string): _SoapYearMonth; + end; + +// *********************************************************************// +// The Class CoSoapYear provides a Create and CreateRemote method to +// create instances of the default interface _SoapYear exposed by +// the CoClass SoapYear. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapYear = class + class function Create: _SoapYear; + class function CreateRemote(const MachineName: string): _SoapYear; + end; + +// *********************************************************************// +// The Class CoSoapMonthDay provides a Create and CreateRemote method to +// create instances of the default interface _SoapMonthDay exposed by +// the CoClass SoapMonthDay. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapMonthDay = class + class function Create: _SoapMonthDay; + class function CreateRemote(const MachineName: string): _SoapMonthDay; + end; + +// *********************************************************************// +// The Class CoSoapDay provides a Create and CreateRemote method to +// create instances of the default interface _SoapDay exposed by +// the CoClass SoapDay. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapDay = class + class function Create: _SoapDay; + class function CreateRemote(const MachineName: string): _SoapDay; + end; + +// *********************************************************************// +// The Class CoSoapMonth provides a Create and CreateRemote method to +// create instances of the default interface _SoapMonth exposed by +// the CoClass SoapMonth. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapMonth = class + class function Create: _SoapMonth; + class function CreateRemote(const MachineName: string): _SoapMonth; + end; + +// *********************************************************************// +// The Class CoSoapHexBinary provides a Create and CreateRemote method to +// create instances of the default interface _SoapHexBinary exposed by +// the CoClass SoapHexBinary. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapHexBinary = class + class function Create: _SoapHexBinary; + class function CreateRemote(const MachineName: string): _SoapHexBinary; + end; + +// *********************************************************************// +// The Class CoSoapBase64Binary provides a Create and CreateRemote method to +// create instances of the default interface _SoapBase64Binary exposed by +// the CoClass SoapBase64Binary. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapBase64Binary = class + class function Create: _SoapBase64Binary; + class function CreateRemote(const MachineName: string): _SoapBase64Binary; + end; + +// *********************************************************************// +// The Class CoSoapInteger provides a Create and CreateRemote method to +// create instances of the default interface _SoapInteger exposed by +// the CoClass SoapInteger. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapInteger = class + class function Create: _SoapInteger; + class function CreateRemote(const MachineName: string): _SoapInteger; + end; + +// *********************************************************************// +// The Class CoSoapPositiveInteger provides a Create and CreateRemote method to +// create instances of the default interface _SoapPositiveInteger exposed by +// the CoClass SoapPositiveInteger. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapPositiveInteger = class + class function Create: _SoapPositiveInteger; + class function CreateRemote(const MachineName: string): _SoapPositiveInteger; + end; + +// *********************************************************************// +// The Class CoSoapNonPositiveInteger provides a Create and CreateRemote method to +// create instances of the default interface _SoapNonPositiveInteger exposed by +// the CoClass SoapNonPositiveInteger. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapNonPositiveInteger = class + class function Create: _SoapNonPositiveInteger; + class function CreateRemote(const MachineName: string): _SoapNonPositiveInteger; + end; + +// *********************************************************************// +// The Class CoSoapNonNegativeInteger provides a Create and CreateRemote method to +// create instances of the default interface _SoapNonNegativeInteger exposed by +// the CoClass SoapNonNegativeInteger. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapNonNegativeInteger = class + class function Create: _SoapNonNegativeInteger; + class function CreateRemote(const MachineName: string): _SoapNonNegativeInteger; + end; + +// *********************************************************************// +// The Class CoSoapNegativeInteger provides a Create and CreateRemote method to +// create instances of the default interface _SoapNegativeInteger exposed by +// the CoClass SoapNegativeInteger. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapNegativeInteger = class + class function Create: _SoapNegativeInteger; + class function CreateRemote(const MachineName: string): _SoapNegativeInteger; + end; + +// *********************************************************************// +// The Class CoSoapAnyUri provides a Create and CreateRemote method to +// create instances of the default interface _SoapAnyUri exposed by +// the CoClass SoapAnyUri. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapAnyUri = class + class function Create: _SoapAnyUri; + class function CreateRemote(const MachineName: string): _SoapAnyUri; + end; + +// *********************************************************************// +// The Class CoSoapQName provides a Create and CreateRemote method to +// create instances of the default interface _SoapQName exposed by +// the CoClass SoapQName. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapQName = class + class function Create: _SoapQName; + class function CreateRemote(const MachineName: string): _SoapQName; + end; + +// *********************************************************************// +// The Class CoSoapNotation provides a Create and CreateRemote method to +// create instances of the default interface _SoapNotation exposed by +// the CoClass SoapNotation. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapNotation = class + class function Create: _SoapNotation; + class function CreateRemote(const MachineName: string): _SoapNotation; + end; + +// *********************************************************************// +// The Class CoSoapNormalizedString provides a Create and CreateRemote method to +// create instances of the default interface _SoapNormalizedString exposed by +// the CoClass SoapNormalizedString. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapNormalizedString = class + class function Create: _SoapNormalizedString; + class function CreateRemote(const MachineName: string): _SoapNormalizedString; + end; + +// *********************************************************************// +// The Class CoSoapToken provides a Create and CreateRemote method to +// create instances of the default interface _SoapToken exposed by +// the CoClass SoapToken. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapToken = class + class function Create: _SoapToken; + class function CreateRemote(const MachineName: string): _SoapToken; + end; + +// *********************************************************************// +// The Class CoSoapLanguage provides a Create and CreateRemote method to +// create instances of the default interface _SoapLanguage exposed by +// the CoClass SoapLanguage. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapLanguage = class + class function Create: _SoapLanguage; + class function CreateRemote(const MachineName: string): _SoapLanguage; + end; + +// *********************************************************************// +// The Class CoSoapName provides a Create and CreateRemote method to +// create instances of the default interface _SoapName exposed by +// the CoClass SoapName. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapName = class + class function Create: _SoapName; + class function CreateRemote(const MachineName: string): _SoapName; + end; + +// *********************************************************************// +// The Class CoSoapIdrefs provides a Create and CreateRemote method to +// create instances of the default interface _SoapIdrefs exposed by +// the CoClass SoapIdrefs. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapIdrefs = class + class function Create: _SoapIdrefs; + class function CreateRemote(const MachineName: string): _SoapIdrefs; + end; + +// *********************************************************************// +// The Class CoSoapEntities provides a Create and CreateRemote method to +// create instances of the default interface _SoapEntities exposed by +// the CoClass SoapEntities. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapEntities = class + class function Create: _SoapEntities; + class function CreateRemote(const MachineName: string): _SoapEntities; + end; + +// *********************************************************************// +// The Class CoSoapNmtoken provides a Create and CreateRemote method to +// create instances of the default interface _SoapNmtoken exposed by +// the CoClass SoapNmtoken. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapNmtoken = class + class function Create: _SoapNmtoken; + class function CreateRemote(const MachineName: string): _SoapNmtoken; + end; + +// *********************************************************************// +// The Class CoSoapNmtokens provides a Create and CreateRemote method to +// create instances of the default interface _SoapNmtokens exposed by +// the CoClass SoapNmtokens. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapNmtokens = class + class function Create: _SoapNmtokens; + class function CreateRemote(const MachineName: string): _SoapNmtokens; + end; + +// *********************************************************************// +// The Class CoSoapNcName provides a Create and CreateRemote method to +// create instances of the default interface _SoapNcName exposed by +// the CoClass SoapNcName. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapNcName = class + class function Create: _SoapNcName; + class function CreateRemote(const MachineName: string): _SoapNcName; + end; + +// *********************************************************************// +// The Class CoSoapId provides a Create and CreateRemote method to +// create instances of the default interface _SoapId exposed by +// the CoClass SoapId. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapId = class + class function Create: _SoapId; + class function CreateRemote(const MachineName: string): _SoapId; + end; + +// *********************************************************************// +// The Class CoSoapIdref provides a Create and CreateRemote method to +// create instances of the default interface _SoapIdref exposed by +// the CoClass SoapIdref. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapIdref = class + class function Create: _SoapIdref; + class function CreateRemote(const MachineName: string): _SoapIdref; + end; + +// *********************************************************************// +// The Class CoSoapEntity provides a Create and CreateRemote method to +// create instances of the default interface _SoapEntity exposed by +// the CoClass SoapEntity. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapEntity = class + class function Create: _SoapEntity; + class function CreateRemote(const MachineName: string): _SoapEntity; + end; + +// *********************************************************************// +// The Class CoSynchronizationAttribute provides a Create and CreateRemote method to +// create instances of the default interface _SynchronizationAttribute exposed by +// the CoClass SynchronizationAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSynchronizationAttribute = class + class function Create: _SynchronizationAttribute; + class function CreateRemote(const MachineName: string): _SynchronizationAttribute; + end; + +// *********************************************************************// +// The Class CoTrackingServices provides a Create and CreateRemote method to +// create instances of the default interface _TrackingServices exposed by +// the CoClass TrackingServices. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTrackingServices = class + class function Create: _TrackingServices; + class function CreateRemote(const MachineName: string): _TrackingServices; + end; + +// *********************************************************************// +// The Class CoUrlAttribute provides a Create and CreateRemote method to +// create instances of the default interface _UrlAttribute exposed by +// the CoClass UrlAttribute. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoUrlAttribute = class + class function Create: _UrlAttribute; + class function CreateRemote(const MachineName: string): _UrlAttribute; + end; + +// *********************************************************************// +// The Class CoIsolatedStorage provides a Create and CreateRemote method to +// create instances of the default interface _IsolatedStorage exposed by +// the CoClass IsolatedStorage. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoIsolatedStorage = class + class function Create: _IsolatedStorage; + class function CreateRemote(const MachineName: string): _IsolatedStorage; + end; + +// *********************************************************************// +// The Class CoIsolatedStorageFile provides a Create and CreateRemote method to +// create instances of the default interface _IsolatedStorageFile exposed by +// the CoClass IsolatedStorageFile. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoIsolatedStorageFile = class + class function Create: _IsolatedStorageFile; + class function CreateRemote(const MachineName: string): _IsolatedStorageFile; + end; + +// *********************************************************************// +// The Class CoIsolatedStorageFileStream provides a Create and CreateRemote method to +// create instances of the default interface _IsolatedStorageFileStream exposed by +// the CoClass IsolatedStorageFileStream. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoIsolatedStorageFileStream = class + class function Create: _IsolatedStorageFileStream; + class function CreateRemote(const MachineName: string): _IsolatedStorageFileStream; + end; + +// *********************************************************************// +// The Class CoIsolatedStorageException provides a Create and CreateRemote method to +// create instances of the default interface _IsolatedStorageException exposed by +// the CoClass IsolatedStorageException. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoIsolatedStorageException = class + class function Create: _IsolatedStorageException; + class function CreateRemote(const MachineName: string): _IsolatedStorageException; + end; + +// *********************************************************************// +// The Class CoInternalRM provides a Create and CreateRemote method to +// create instances of the default interface _InternalRM exposed by +// the CoClass InternalRM. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoInternalRM = class + class function Create: _InternalRM; + class function CreateRemote(const MachineName: string): _InternalRM; + end; + +// *********************************************************************// +// The Class CoInternalST provides a Create and CreateRemote method to +// create instances of the default interface _InternalST exposed by +// the CoClass InternalST. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoInternalST = class + class function Create: _InternalST; + class function CreateRemote(const MachineName: string): _InternalST; + end; + +// *********************************************************************// +// The Class CoSoapMessage provides a Create and CreateRemote method to +// create instances of the default interface _SoapMessage exposed by +// the CoClass SoapMessage. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapMessage = class + class function Create: _SoapMessage; + class function CreateRemote(const MachineName: string): _SoapMessage; + end; + +// *********************************************************************// +// The Class CoSoapFault provides a Create and CreateRemote method to +// create instances of the default interface _SoapFault exposed by +// the CoClass SoapFault. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSoapFault = class + class function Create: _SoapFault; + class function CreateRemote(const MachineName: string): _SoapFault; + end; + +// *********************************************************************// +// The Class CoServerFault provides a Create and CreateRemote method to +// create instances of the default interface _ServerFault exposed by +// the CoClass ServerFault. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoServerFault = class + class function Create: _ServerFault; + class function CreateRemote(const MachineName: string): _ServerFault; + end; + +// *********************************************************************// +// The Class CoBinaryFormatter provides a Create and CreateRemote method to +// create instances of the default interface _BinaryFormatter exposed by +// the CoClass BinaryFormatter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoBinaryFormatter = class + class function Create: _BinaryFormatter; + class function CreateRemote(const MachineName: string): _BinaryFormatter; + end; + +// *********************************************************************// +// The Class CoAssemblyBuilder provides a Create and CreateRemote method to +// create instances of the default interface _AssemblyBuilder exposed by +// the CoClass AssemblyBuilder. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoAssemblyBuilder = class + class function Create: _AssemblyBuilder; + class function CreateRemote(const MachineName: string): _AssemblyBuilder; + end; + +// *********************************************************************// +// The Class CoConstructorBuilder provides a Create and CreateRemote method to +// create instances of the default interface _ConstructorBuilder exposed by +// the CoClass ConstructorBuilder. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoConstructorBuilder = class + class function Create: _ConstructorBuilder; + class function CreateRemote(const MachineName: string): _ConstructorBuilder; + end; + +// *********************************************************************// +// The Class CoEventBuilder provides a Create and CreateRemote method to +// create instances of the default interface _EventBuilder exposed by +// the CoClass EventBuilder. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEventBuilder = class + class function Create: _EventBuilder; + class function CreateRemote(const MachineName: string): _EventBuilder; + end; + +// *********************************************************************// +// The Class CoFieldBuilder provides a Create and CreateRemote method to +// create instances of the default interface _FieldBuilder exposed by +// the CoClass FieldBuilder. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFieldBuilder = class + class function Create: _FieldBuilder; + class function CreateRemote(const MachineName: string): _FieldBuilder; + end; + +// *********************************************************************// +// The Class CoILGenerator provides a Create and CreateRemote method to +// create instances of the default interface _ILGenerator exposed by +// the CoClass ILGenerator. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoILGenerator = class + class function Create: _ILGenerator; + class function CreateRemote(const MachineName: string): _ILGenerator; + end; + +// *********************************************************************// +// The Class CoLocalBuilder provides a Create and CreateRemote method to +// create instances of the default interface _LocalBuilder exposed by +// the CoClass LocalBuilder. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoLocalBuilder = class + class function Create: _LocalBuilder; + class function CreateRemote(const MachineName: string): _LocalBuilder; + end; + +// *********************************************************************// +// The Class CoMethodBuilder provides a Create and CreateRemote method to +// create instances of the default interface _MethodBuilder exposed by +// the CoClass MethodBuilder. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMethodBuilder = class + class function Create: _MethodBuilder; + class function CreateRemote(const MachineName: string): _MethodBuilder; + end; + +// *********************************************************************// +// The Class CoCustomAttributeBuilder provides a Create and CreateRemote method to +// create instances of the default interface _CustomAttributeBuilder exposed by +// the CoClass CustomAttributeBuilder. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCustomAttributeBuilder = class + class function Create: _CustomAttributeBuilder; + class function CreateRemote(const MachineName: string): _CustomAttributeBuilder; + end; + +// *********************************************************************// +// The Class CoMethodRental provides a Create and CreateRemote method to +// create instances of the default interface _MethodRental exposed by +// the CoClass MethodRental. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMethodRental = class + class function Create: _MethodRental; + class function CreateRemote(const MachineName: string): _MethodRental; + end; + +// *********************************************************************// +// The Class CoModuleBuilder provides a Create and CreateRemote method to +// create instances of the default interface _ModuleBuilder exposed by +// the CoClass ModuleBuilder. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoModuleBuilder = class + class function Create: _ModuleBuilder; + class function CreateRemote(const MachineName: string): _ModuleBuilder; + end; + +// *********************************************************************// +// The Class CoOpCodes provides a Create and CreateRemote method to +// create instances of the default interface _OpCodes exposed by +// the CoClass OpCodes. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoOpCodes = class + class function Create: _OpCodes; + class function CreateRemote(const MachineName: string): _OpCodes; + end; + +// *********************************************************************// +// The Class CoParameterBuilder provides a Create and CreateRemote method to +// create instances of the default interface _ParameterBuilder exposed by +// the CoClass ParameterBuilder. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoParameterBuilder = class + class function Create: _ParameterBuilder; + class function CreateRemote(const MachineName: string): _ParameterBuilder; + end; + +// *********************************************************************// +// The Class CoPropertyBuilder provides a Create and CreateRemote method to +// create instances of the default interface _PropertyBuilder exposed by +// the CoClass PropertyBuilder. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoPropertyBuilder = class + class function Create: _PropertyBuilder; + class function CreateRemote(const MachineName: string): _PropertyBuilder; + end; + +// *********************************************************************// +// The Class CoSignatureHelper provides a Create and CreateRemote method to +// create instances of the default interface _SignatureHelper exposed by +// the CoClass SignatureHelper. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSignatureHelper = class + class function Create: _SignatureHelper; + class function CreateRemote(const MachineName: string): _SignatureHelper; + end; + +// *********************************************************************// +// The Class CoTypeBuilder provides a Create and CreateRemote method to +// create instances of the default interface _TypeBuilder exposed by +// the CoClass TypeBuilder. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoTypeBuilder = class + class function Create: _TypeBuilder; + class function CreateRemote(const MachineName: string): _TypeBuilder; + end; + +// *********************************************************************// +// The Class CoEnumBuilder provides a Create and CreateRemote method to +// create instances of the default interface _EnumBuilder exposed by +// the CoClass EnumBuilder. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEnumBuilder = class + class function Create: _EnumBuilder; + class function CreateRemote(const MachineName: string): _EnumBuilder; + end; + +//DOM-IGNORE-END + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JCL\source\windows'; + Extra: ''; + Data: nil + ); +{$ENDIF UNITVERSIONING} + +implementation + +uses + {$IFDEF HAS_UNITSCOPE} + System.Win.ComObj; + {$ELSE ~HAS_UNITSCOPE} + ComObj; + {$ENDIF ~HAS_UNITSCOPE} + +class function CoAppDomain.Create: _AppDomain; +begin + Result := CreateComObject(CLASS_AppDomain) as _AppDomain; +end; + +class function CoAppDomain.CreateRemote(const MachineName: string): _AppDomain; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AppDomain) as _AppDomain; +end; + +class function CoRegistrationServices.Create: IRegistrationServices; +begin + Result := CreateComObject(CLASS_RegistrationServices) as IRegistrationServices; +end; + +class function CoRegistrationServices.CreateRemote(const MachineName: string): IRegistrationServices; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RegistrationServices) as IRegistrationServices; +end; + +class function CoTypeLibConverter.Create: ITypeLibConverter; +begin + Result := CreateComObject(CLASS_TypeLibConverter) as ITypeLibConverter; +end; + +class function CoTypeLibConverter.CreateRemote(const MachineName: string): ITypeLibConverter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TypeLibConverter) as ITypeLibConverter; +end; + +class function CoAppDomainSetup.Create: IAppDomainSetup; +begin + Result := CreateComObject(CLASS_AppDomainSetup) as IAppDomainSetup; +end; + +class function CoAppDomainSetup.CreateRemote(const MachineName: string): IAppDomainSetup; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AppDomainSetup) as IAppDomainSetup; +end; + +class function CoObject_.Create: _Object; +begin + Result := CreateComObject(CLASS_Object_) as _Object; +end; + +class function CoObject_.CreateRemote(const MachineName: string): _Object; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Object_) as _Object; +end; + +class function CoArray_.Create: _Array; +begin + Result := CreateComObject(CLASS_Array_) as _Array; +end; + +class function CoArray_.CreateRemote(const MachineName: string): _Array; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Array_) as _Array; +end; + +class function CoString_.Create: _String; +begin + Result := CreateComObject(CLASS_String_) as _String; +end; + +class function CoString_.CreateRemote(const MachineName: string): _String; +begin + Result := CreateRemoteComObject(MachineName, CLASS_String_) as _String; +end; + +class function CoStringBuilder.Create: _StringBuilder; +begin + Result := CreateComObject(CLASS_StringBuilder) as _StringBuilder; +end; + +class function CoStringBuilder.CreateRemote(const MachineName: string): _StringBuilder; +begin + Result := CreateRemoteComObject(MachineName, CLASS_StringBuilder) as _StringBuilder; +end; + +class function CoException.Create: _Exception; +begin + Result := CreateComObject(CLASS_Exception) as _Exception; +end; + +class function CoException.CreateRemote(const MachineName: string): _Exception; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Exception) as _Exception; +end; + +class function CoValueType.Create: _ValueType; +begin + Result := CreateComObject(CLASS_ValueType) as _ValueType; +end; + +class function CoValueType.CreateRemote(const MachineName: string): _ValueType; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ValueType) as _ValueType; +end; + +class function CoSystemException.Create: _SystemException; +begin + Result := CreateComObject(CLASS_SystemException) as _SystemException; +end; + +class function CoSystemException.CreateRemote(const MachineName: string): _SystemException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SystemException) as _SystemException; +end; + +class function CoOutOfMemoryException.Create: _OutOfMemoryException; +begin + Result := CreateComObject(CLASS_OutOfMemoryException) as _OutOfMemoryException; +end; + +class function CoOutOfMemoryException.CreateRemote(const MachineName: string): _OutOfMemoryException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_OutOfMemoryException) as _OutOfMemoryException; +end; + +class function CoStackOverflowException.Create: _StackOverflowException; +begin + Result := CreateComObject(CLASS_StackOverflowException) as _StackOverflowException; +end; + +class function CoStackOverflowException.CreateRemote(const MachineName: string): _StackOverflowException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_StackOverflowException) as _StackOverflowException; +end; + +class function CoExecutionEngineException.Create: _ExecutionEngineException; +begin + Result := CreateComObject(CLASS_ExecutionEngineException) as _ExecutionEngineException; +end; + +class function CoExecutionEngineException.CreateRemote(const MachineName: string): _ExecutionEngineException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ExecutionEngineException) as _ExecutionEngineException; +end; + +class function CoDelegate.Create: _Delegate; +begin + Result := CreateComObject(CLASS_Delegate) as _Delegate; +end; + +class function CoDelegate.CreateRemote(const MachineName: string): _Delegate; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Delegate) as _Delegate; +end; + +class function CoMulticastDelegate.Create: _MulticastDelegate; +begin + Result := CreateComObject(CLASS_MulticastDelegate) as _MulticastDelegate; +end; + +class function CoMulticastDelegate.CreateRemote(const MachineName: string): _MulticastDelegate; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MulticastDelegate) as _MulticastDelegate; +end; + +class function CoEnum.Create: _Enum; +begin + Result := CreateComObject(CLASS_Enum) as _Enum; +end; + +class function CoEnum.CreateRemote(const MachineName: string): _Enum; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Enum) as _Enum; +end; + +class function CoMemberAccessException.Create: _MemberAccessException; +begin + Result := CreateComObject(CLASS_MemberAccessException) as _MemberAccessException; +end; + +class function CoMemberAccessException.CreateRemote(const MachineName: string): _MemberAccessException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MemberAccessException) as _MemberAccessException; +end; + +class function CoActivator.Create: _Activator; +begin + Result := CreateComObject(CLASS_Activator) as _Activator; +end; + +class function CoActivator.CreateRemote(const MachineName: string): _Activator; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Activator) as _Activator; +end; + +class function CoApplicationException.Create: _ApplicationException; +begin + Result := CreateComObject(CLASS_ApplicationException) as _ApplicationException; +end; + +class function CoApplicationException.CreateRemote(const MachineName: string): _ApplicationException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ApplicationException) as _ApplicationException; +end; + +class function CoEventArgs.Create: _EventArgs; +begin + Result := CreateComObject(CLASS_EventArgs) as _EventArgs; +end; + +class function CoEventArgs.CreateRemote(const MachineName: string): _EventArgs; +begin + Result := CreateRemoteComObject(MachineName, CLASS_EventArgs) as _EventArgs; +end; + +class function CoResolveEventArgs.Create: _ResolveEventArgs; +begin + Result := CreateComObject(CLASS_ResolveEventArgs) as _ResolveEventArgs; +end; + +class function CoResolveEventArgs.CreateRemote(const MachineName: string): _ResolveEventArgs; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ResolveEventArgs) as _ResolveEventArgs; +end; + +class function CoAssemblyLoadEventArgs.Create: _AssemblyLoadEventArgs; +begin + Result := CreateComObject(CLASS_AssemblyLoadEventArgs) as _AssemblyLoadEventArgs; +end; + +class function CoAssemblyLoadEventArgs.CreateRemote(const MachineName: string): _AssemblyLoadEventArgs; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AssemblyLoadEventArgs) as _AssemblyLoadEventArgs; +end; + +class function CoResolveEventHandler.Create: _ResolveEventHandler; +begin + Result := CreateComObject(CLASS_ResolveEventHandler) as _ResolveEventHandler; +end; + +class function CoResolveEventHandler.CreateRemote(const MachineName: string): _ResolveEventHandler; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ResolveEventHandler) as _ResolveEventHandler; +end; + +class function CoAssemblyLoadEventHandler.Create: _AssemblyLoadEventHandler; +begin + Result := CreateComObject(CLASS_AssemblyLoadEventHandler) as _AssemblyLoadEventHandler; +end; + +class function CoAssemblyLoadEventHandler.CreateRemote(const MachineName: string): _AssemblyLoadEventHandler; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AssemblyLoadEventHandler) as _AssemblyLoadEventHandler; +end; + +class function CoMarshalByRefObject.Create: _MarshalByRefObject; +begin + Result := CreateComObject(CLASS_MarshalByRefObject) as _MarshalByRefObject; +end; + +class function CoMarshalByRefObject.CreateRemote(const MachineName: string): _MarshalByRefObject; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MarshalByRefObject) as _MarshalByRefObject; +end; + +class function CoCrossAppDomainDelegate.Create: _CrossAppDomainDelegate; +begin + Result := CreateComObject(CLASS_CrossAppDomainDelegate) as _CrossAppDomainDelegate; +end; + +class function CoCrossAppDomainDelegate.CreateRemote(const MachineName: string): _CrossAppDomainDelegate; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CrossAppDomainDelegate) as _CrossAppDomainDelegate; +end; + +class function CoAttribute.Create: _Attribute; +begin + Result := CreateComObject(CLASS_Attribute) as _Attribute; +end; + +class function CoAttribute.CreateRemote(const MachineName: string): _Attribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Attribute) as _Attribute; +end; + +class function CoLoaderOptimizationAttribute.Create: _LoaderOptimizationAttribute; +begin + Result := CreateComObject(CLASS_LoaderOptimizationAttribute) as _LoaderOptimizationAttribute; +end; + +class function CoLoaderOptimizationAttribute.CreateRemote(const MachineName: string): _LoaderOptimizationAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_LoaderOptimizationAttribute) as _LoaderOptimizationAttribute; +end; + +class function CoAppDomainUnloadedException.Create: _AppDomainUnloadedException; +begin + Result := CreateComObject(CLASS_AppDomainUnloadedException) as _AppDomainUnloadedException; +end; + +class function CoAppDomainUnloadedException.CreateRemote(const MachineName: string): _AppDomainUnloadedException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AppDomainUnloadedException) as _AppDomainUnloadedException; +end; + +class function CoArgumentException.Create: _ArgumentException; +begin + Result := CreateComObject(CLASS_ArgumentException) as _ArgumentException; +end; + +class function CoArgumentException.CreateRemote(const MachineName: string): _ArgumentException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ArgumentException) as _ArgumentException; +end; + +class function CoArgumentNullException.Create: _ArgumentNullException; +begin + Result := CreateComObject(CLASS_ArgumentNullException) as _ArgumentNullException; +end; + +class function CoArgumentNullException.CreateRemote(const MachineName: string): _ArgumentNullException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ArgumentNullException) as _ArgumentNullException; +end; + +class function CoArgumentOutOfRangeException.Create: _ArgumentOutOfRangeException; +begin + Result := CreateComObject(CLASS_ArgumentOutOfRangeException) as _ArgumentOutOfRangeException; +end; + +class function CoArgumentOutOfRangeException.CreateRemote(const MachineName: string): _ArgumentOutOfRangeException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ArgumentOutOfRangeException) as _ArgumentOutOfRangeException; +end; + +class function CoArithmeticException.Create: _ArithmeticException; +begin + Result := CreateComObject(CLASS_ArithmeticException) as _ArithmeticException; +end; + +class function CoArithmeticException.CreateRemote(const MachineName: string): _ArithmeticException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ArithmeticException) as _ArithmeticException; +end; + +class function CoArrayTypeMismatchException.Create: _ArrayTypeMismatchException; +begin + Result := CreateComObject(CLASS_ArrayTypeMismatchException) as _ArrayTypeMismatchException; +end; + +class function CoArrayTypeMismatchException.CreateRemote(const MachineName: string): _ArrayTypeMismatchException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ArrayTypeMismatchException) as _ArrayTypeMismatchException; +end; + +class function CoAsyncCallback.Create: _AsyncCallback; +begin + Result := CreateComObject(CLASS_AsyncCallback) as _AsyncCallback; +end; + +class function CoAsyncCallback.CreateRemote(const MachineName: string): _AsyncCallback; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AsyncCallback) as _AsyncCallback; +end; + +class function CoAttributeUsageAttribute.Create: _AttributeUsageAttribute; +begin + Result := CreateComObject(CLASS_AttributeUsageAttribute) as _AttributeUsageAttribute; +end; + +class function CoAttributeUsageAttribute.CreateRemote(const MachineName: string): _AttributeUsageAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AttributeUsageAttribute) as _AttributeUsageAttribute; +end; + +class function CoBadImageFormatException.Create: _BadImageFormatException; +begin + Result := CreateComObject(CLASS_BadImageFormatException) as _BadImageFormatException; +end; + +class function CoBadImageFormatException.CreateRemote(const MachineName: string): _BadImageFormatException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_BadImageFormatException) as _BadImageFormatException; +end; + +class function CoBitConverter.Create: _BitConverter; +begin + Result := CreateComObject(CLASS_BitConverter) as _BitConverter; +end; + +class function CoBitConverter.CreateRemote(const MachineName: string): _BitConverter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_BitConverter) as _BitConverter; +end; + +class function CoBuffer.Create: _Buffer; +begin + Result := CreateComObject(CLASS_Buffer) as _Buffer; +end; + +class function CoBuffer.CreateRemote(const MachineName: string): _Buffer; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Buffer) as _Buffer; +end; + +class function CoCannotUnloadAppDomainException.Create: _CannotUnloadAppDomainException; +begin + Result := CreateComObject(CLASS_CannotUnloadAppDomainException) as _CannotUnloadAppDomainException; +end; + +class function CoCannotUnloadAppDomainException.CreateRemote(const MachineName: string): _CannotUnloadAppDomainException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CannotUnloadAppDomainException) as _CannotUnloadAppDomainException; +end; + +class function CoCharEnumerator.Create: _CharEnumerator; +begin + Result := CreateComObject(CLASS_CharEnumerator) as _CharEnumerator; +end; + +class function CoCharEnumerator.CreateRemote(const MachineName: string): _CharEnumerator; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CharEnumerator) as _CharEnumerator; +end; + +class function CoCLSCompliantAttribute.Create: _CLSCompliantAttribute; +begin + Result := CreateComObject(CLASS_CLSCompliantAttribute) as _CLSCompliantAttribute; +end; + +class function CoCLSCompliantAttribute.CreateRemote(const MachineName: string): _CLSCompliantAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CLSCompliantAttribute) as _CLSCompliantAttribute; +end; + +class function CoTypeUnloadedException.Create: _TypeUnloadedException; +begin + Result := CreateComObject(CLASS_TypeUnloadedException) as _TypeUnloadedException; +end; + +class function CoTypeUnloadedException.CreateRemote(const MachineName: string): _TypeUnloadedException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TypeUnloadedException) as _TypeUnloadedException; +end; + +class function CoConsole.Create: _Console; +begin + Result := CreateComObject(CLASS_Console) as _Console; +end; + +class function CoConsole.CreateRemote(const MachineName: string): _Console; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Console) as _Console; +end; + +class function CoContextMarshalException.Create: _ContextMarshalException; +begin + Result := CreateComObject(CLASS_ContextMarshalException) as _ContextMarshalException; +end; + +class function CoContextMarshalException.CreateRemote(const MachineName: string): _ContextMarshalException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ContextMarshalException) as _ContextMarshalException; +end; + +class function CoConvert.Create: _Convert; +begin + Result := CreateComObject(CLASS_Convert) as _Convert; +end; + +class function CoConvert.CreateRemote(const MachineName: string): _Convert; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Convert) as _Convert; +end; + +class function CoContextBoundObject.Create: _ContextBoundObject; +begin + Result := CreateComObject(CLASS_ContextBoundObject) as _ContextBoundObject; +end; + +class function CoContextBoundObject.CreateRemote(const MachineName: string): _ContextBoundObject; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ContextBoundObject) as _ContextBoundObject; +end; + +class function CoContextStaticAttribute.Create: _ContextStaticAttribute; +begin + Result := CreateComObject(CLASS_ContextStaticAttribute) as _ContextStaticAttribute; +end; + +class function CoContextStaticAttribute.CreateRemote(const MachineName: string): _ContextStaticAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ContextStaticAttribute) as _ContextStaticAttribute; +end; + +class function CoTimeZone.Create: _TimeZone; +begin + Result := CreateComObject(CLASS_TimeZone) as _TimeZone; +end; + +class function CoTimeZone.CreateRemote(const MachineName: string): _TimeZone; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TimeZone) as _TimeZone; +end; + +class function CoDBNull.Create: _DBNull; +begin + Result := CreateComObject(CLASS_DBNull) as _DBNull; +end; + +class function CoDBNull.CreateRemote(const MachineName: string): _DBNull; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DBNull) as _DBNull; +end; + +class function CoBinder.Create: _Binder; +begin + Result := CreateComObject(CLASS_Binder) as _Binder; +end; + +class function CoBinder.CreateRemote(const MachineName: string): _Binder; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Binder) as _Binder; +end; + +class function CoDivideByZeroException.Create: _DivideByZeroException; +begin + Result := CreateComObject(CLASS_DivideByZeroException) as _DivideByZeroException; +end; + +class function CoDivideByZeroException.CreateRemote(const MachineName: string): _DivideByZeroException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DivideByZeroException) as _DivideByZeroException; +end; + +class function CoDuplicateWaitObjectException.Create: _DuplicateWaitObjectException; +begin + Result := CreateComObject(CLASS_DuplicateWaitObjectException) as _DuplicateWaitObjectException; +end; + +class function CoDuplicateWaitObjectException.CreateRemote(const MachineName: string): _DuplicateWaitObjectException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DuplicateWaitObjectException) as _DuplicateWaitObjectException; +end; + +class function CoTypeLoadException.Create: _TypeLoadException; +begin + Result := CreateComObject(CLASS_TypeLoadException) as _TypeLoadException; +end; + +class function CoTypeLoadException.CreateRemote(const MachineName: string): _TypeLoadException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TypeLoadException) as _TypeLoadException; +end; + +class function CoEntryPointNotFoundException.Create: _EntryPointNotFoundException; +begin + Result := CreateComObject(CLASS_EntryPointNotFoundException) as _EntryPointNotFoundException; +end; + +class function CoEntryPointNotFoundException.CreateRemote(const MachineName: string): _EntryPointNotFoundException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_EntryPointNotFoundException) as _EntryPointNotFoundException; +end; + +class function CoDllNotFoundException.Create: _DllNotFoundException; +begin + Result := CreateComObject(CLASS_DllNotFoundException) as _DllNotFoundException; +end; + +class function CoDllNotFoundException.CreateRemote(const MachineName: string): _DllNotFoundException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DllNotFoundException) as _DllNotFoundException; +end; + +class function CoEnvironment.Create: _Environment; +begin + Result := CreateComObject(CLASS_Environment) as _Environment; +end; + +class function CoEnvironment.CreateRemote(const MachineName: string): _Environment; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Environment) as _Environment; +end; + +class function CoEventHandler.Create: _EventHandler; +begin + Result := CreateComObject(CLASS_EventHandler) as _EventHandler; +end; + +class function CoEventHandler.CreateRemote(const MachineName: string): _EventHandler; +begin + Result := CreateRemoteComObject(MachineName, CLASS_EventHandler) as _EventHandler; +end; + +class function CoFieldAccessException.Create: _FieldAccessException; +begin + Result := CreateComObject(CLASS_FieldAccessException) as _FieldAccessException; +end; + +class function CoFieldAccessException.CreateRemote(const MachineName: string): _FieldAccessException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FieldAccessException) as _FieldAccessException; +end; + +class function CoFlagsAttribute.Create: _FlagsAttribute; +begin + Result := CreateComObject(CLASS_FlagsAttribute) as _FlagsAttribute; +end; + +class function CoFlagsAttribute.CreateRemote(const MachineName: string): _FlagsAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FlagsAttribute) as _FlagsAttribute; +end; + +class function CoFormatException.Create: _FormatException; +begin + Result := CreateComObject(CLASS_FormatException) as _FormatException; +end; + +class function CoFormatException.CreateRemote(const MachineName: string): _FormatException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FormatException) as _FormatException; +end; + +class function CoGC.Create: _GC; +begin + Result := CreateComObject(CLASS_GC) as _GC; +end; + +class function CoGC.CreateRemote(const MachineName: string): _GC; +begin + Result := CreateRemoteComObject(MachineName, CLASS_GC) as _GC; +end; + +class function CoIndexOutOfRangeException.Create: _IndexOutOfRangeException; +begin + Result := CreateComObject(CLASS_IndexOutOfRangeException) as _IndexOutOfRangeException; +end; + +class function CoIndexOutOfRangeException.CreateRemote(const MachineName: string): _IndexOutOfRangeException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_IndexOutOfRangeException) as _IndexOutOfRangeException; +end; + +class function CoInvalidCastException.Create: _InvalidCastException; +begin + Result := CreateComObject(CLASS_InvalidCastException) as _InvalidCastException; +end; + +class function CoInvalidCastException.CreateRemote(const MachineName: string): _InvalidCastException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_InvalidCastException) as _InvalidCastException; +end; + +class function CoInvalidOperationException.Create: _InvalidOperationException; +begin + Result := CreateComObject(CLASS_InvalidOperationException) as _InvalidOperationException; +end; + +class function CoInvalidOperationException.CreateRemote(const MachineName: string): _InvalidOperationException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_InvalidOperationException) as _InvalidOperationException; +end; + +class function CoInvalidProgramException.Create: _InvalidProgramException; +begin + Result := CreateComObject(CLASS_InvalidProgramException) as _InvalidProgramException; +end; + +class function CoInvalidProgramException.CreateRemote(const MachineName: string): _InvalidProgramException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_InvalidProgramException) as _InvalidProgramException; +end; + +class function CoLocalDataStoreSlot.Create: _LocalDataStoreSlot; +begin + Result := CreateComObject(CLASS_LocalDataStoreSlot) as _LocalDataStoreSlot; +end; + +class function CoLocalDataStoreSlot.CreateRemote(const MachineName: string): _LocalDataStoreSlot; +begin + Result := CreateRemoteComObject(MachineName, CLASS_LocalDataStoreSlot) as _LocalDataStoreSlot; +end; + +class function CoMath.Create: _Math; +begin + Result := CreateComObject(CLASS_Math) as _Math; +end; + +class function CoMath.CreateRemote(const MachineName: string): _Math; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Math) as _Math; +end; + +class function CoMethodAccessException.Create: _MethodAccessException; +begin + Result := CreateComObject(CLASS_MethodAccessException) as _MethodAccessException; +end; + +class function CoMethodAccessException.CreateRemote(const MachineName: string): _MethodAccessException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MethodAccessException) as _MethodAccessException; +end; + +class function CoMissingMemberException.Create: _MissingMemberException; +begin + Result := CreateComObject(CLASS_MissingMemberException) as _MissingMemberException; +end; + +class function CoMissingMemberException.CreateRemote(const MachineName: string): _MissingMemberException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MissingMemberException) as _MissingMemberException; +end; + +class function CoMissingFieldException.Create: _MissingFieldException; +begin + Result := CreateComObject(CLASS_MissingFieldException) as _MissingFieldException; +end; + +class function CoMissingFieldException.CreateRemote(const MachineName: string): _MissingFieldException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MissingFieldException) as _MissingFieldException; +end; + +class function CoMissingMethodException.Create: _MissingMethodException; +begin + Result := CreateComObject(CLASS_MissingMethodException) as _MissingMethodException; +end; + +class function CoMissingMethodException.CreateRemote(const MachineName: string): _MissingMethodException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MissingMethodException) as _MissingMethodException; +end; + +class function CoMulticastNotSupportedException.Create: _MulticastNotSupportedException; +begin + Result := CreateComObject(CLASS_MulticastNotSupportedException) as _MulticastNotSupportedException; +end; + +class function CoMulticastNotSupportedException.CreateRemote(const MachineName: string): _MulticastNotSupportedException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MulticastNotSupportedException) as _MulticastNotSupportedException; +end; + +class function CoNonSerializedAttribute.Create: _NonSerializedAttribute; +begin + Result := CreateComObject(CLASS_NonSerializedAttribute) as _NonSerializedAttribute; +end; + +class function CoNonSerializedAttribute.CreateRemote(const MachineName: string): _NonSerializedAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_NonSerializedAttribute) as _NonSerializedAttribute; +end; + +class function CoNotFiniteNumberException.Create: _NotFiniteNumberException; +begin + Result := CreateComObject(CLASS_NotFiniteNumberException) as _NotFiniteNumberException; +end; + +class function CoNotFiniteNumberException.CreateRemote(const MachineName: string): _NotFiniteNumberException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_NotFiniteNumberException) as _NotFiniteNumberException; +end; + +class function CoNotImplementedException.Create: _NotImplementedException; +begin + Result := CreateComObject(CLASS_NotImplementedException) as _NotImplementedException; +end; + +class function CoNotImplementedException.CreateRemote(const MachineName: string): _NotImplementedException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_NotImplementedException) as _NotImplementedException; +end; + +class function CoNotSupportedException.Create: _NotSupportedException; +begin + Result := CreateComObject(CLASS_NotSupportedException) as _NotSupportedException; +end; + +class function CoNotSupportedException.CreateRemote(const MachineName: string): _NotSupportedException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_NotSupportedException) as _NotSupportedException; +end; + +class function CoNullReferenceException.Create: _NullReferenceException; +begin + Result := CreateComObject(CLASS_NullReferenceException) as _NullReferenceException; +end; + +class function CoNullReferenceException.CreateRemote(const MachineName: string): _NullReferenceException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_NullReferenceException) as _NullReferenceException; +end; + +class function CoObjectDisposedException.Create: _ObjectDisposedException; +begin + Result := CreateComObject(CLASS_ObjectDisposedException) as _ObjectDisposedException; +end; + +class function CoObjectDisposedException.CreateRemote(const MachineName: string): _ObjectDisposedException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ObjectDisposedException) as _ObjectDisposedException; +end; + +class function CoObsoleteAttribute.Create: _ObsoleteAttribute; +begin + Result := CreateComObject(CLASS_ObsoleteAttribute) as _ObsoleteAttribute; +end; + +class function CoObsoleteAttribute.CreateRemote(const MachineName: string): _ObsoleteAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ObsoleteAttribute) as _ObsoleteAttribute; +end; + +class function CoOperatingSystem.Create: _OperatingSystem; +begin + Result := CreateComObject(CLASS_OperatingSystem) as _OperatingSystem; +end; + +class function CoOperatingSystem.CreateRemote(const MachineName: string): _OperatingSystem; +begin + Result := CreateRemoteComObject(MachineName, CLASS_OperatingSystem) as _OperatingSystem; +end; + +class function CoOverflowException.Create: _OverflowException; +begin + Result := CreateComObject(CLASS_OverflowException) as _OverflowException; +end; + +class function CoOverflowException.CreateRemote(const MachineName: string): _OverflowException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_OverflowException) as _OverflowException; +end; + +class function CoParamArrayAttribute.Create: _ParamArrayAttribute; +begin + Result := CreateComObject(CLASS_ParamArrayAttribute) as _ParamArrayAttribute; +end; + +class function CoParamArrayAttribute.CreateRemote(const MachineName: string): _ParamArrayAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ParamArrayAttribute) as _ParamArrayAttribute; +end; + +class function CoPlatformNotSupportedException.Create: _PlatformNotSupportedException; +begin + Result := CreateComObject(CLASS_PlatformNotSupportedException) as _PlatformNotSupportedException; +end; + +class function CoPlatformNotSupportedException.CreateRemote(const MachineName: string): _PlatformNotSupportedException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_PlatformNotSupportedException) as _PlatformNotSupportedException; +end; + +class function CoRandom.Create: _Random; +begin + Result := CreateComObject(CLASS_Random) as _Random; +end; + +class function CoRandom.CreateRemote(const MachineName: string): _Random; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Random) as _Random; +end; + +class function CoRankException.Create: _RankException; +begin + Result := CreateComObject(CLASS_RankException) as _RankException; +end; + +class function CoRankException.CreateRemote(const MachineName: string): _RankException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RankException) as _RankException; +end; + +class function CoMemberInfo.Create: _MemberInfo; +begin + Result := CreateComObject(CLASS_MemberInfo) as _MemberInfo; +end; + +class function CoMemberInfo.CreateRemote(const MachineName: string): _MemberInfo; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MemberInfo) as _MemberInfo; +end; + +class function CoType_.Create: _Type; +begin + Result := CreateComObject(CLASS_Type_) as _Type; +end; + +class function CoType_.CreateRemote(const MachineName: string): _Type; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Type_) as _Type; +end; + +class function CoSerializableAttribute.Create: _SerializableAttribute; +begin + Result := CreateComObject(CLASS_SerializableAttribute) as _SerializableAttribute; +end; + +class function CoSerializableAttribute.CreateRemote(const MachineName: string): _SerializableAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SerializableAttribute) as _SerializableAttribute; +end; + +class function CoTypeInitializationException.Create: _TypeInitializationException; +begin + Result := CreateComObject(CLASS_TypeInitializationException) as _TypeInitializationException; +end; + +class function CoTypeInitializationException.CreateRemote(const MachineName: string): _TypeInitializationException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TypeInitializationException) as _TypeInitializationException; +end; + +class function CoUnauthorizedAccessException.Create: _UnauthorizedAccessException; +begin + Result := CreateComObject(CLASS_UnauthorizedAccessException) as _UnauthorizedAccessException; +end; + +class function CoUnauthorizedAccessException.CreateRemote(const MachineName: string): _UnauthorizedAccessException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_UnauthorizedAccessException) as _UnauthorizedAccessException; +end; + +class function CoUnhandledExceptionEventArgs.Create: _UnhandledExceptionEventArgs; +begin + Result := CreateComObject(CLASS_UnhandledExceptionEventArgs) as _UnhandledExceptionEventArgs; +end; + +class function CoUnhandledExceptionEventArgs.CreateRemote(const MachineName: string): _UnhandledExceptionEventArgs; +begin + Result := CreateRemoteComObject(MachineName, CLASS_UnhandledExceptionEventArgs) as _UnhandledExceptionEventArgs; +end; + +class function CoUnhandledExceptionEventHandler.Create: _UnhandledExceptionEventHandler; +begin + Result := CreateComObject(CLASS_UnhandledExceptionEventHandler) as _UnhandledExceptionEventHandler; +end; + +class function CoUnhandledExceptionEventHandler.CreateRemote(const MachineName: string): _UnhandledExceptionEventHandler; +begin + Result := CreateRemoteComObject(MachineName, CLASS_UnhandledExceptionEventHandler) as _UnhandledExceptionEventHandler; +end; + +class function CoVersion.Create: _Version; +begin + Result := CreateComObject(CLASS_Version) as _Version; +end; + +class function CoVersion.CreateRemote(const MachineName: string): _Version; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Version) as _Version; +end; + +class function CoWeakReference.Create: _WeakReference; +begin + Result := CreateComObject(CLASS_WeakReference) as _WeakReference; +end; + +class function CoWeakReference.CreateRemote(const MachineName: string): _WeakReference; +begin + Result := CreateRemoteComObject(MachineName, CLASS_WeakReference) as _WeakReference; +end; + +class function CoWaitHandle.Create: _WaitHandle; +begin + Result := CreateComObject(CLASS_WaitHandle) as _WaitHandle; +end; + +class function CoWaitHandle.CreateRemote(const MachineName: string): _WaitHandle; +begin + Result := CreateRemoteComObject(MachineName, CLASS_WaitHandle) as _WaitHandle; +end; + +class function CoAutoResetEvent.Create: _AutoResetEvent; +begin + Result := CreateComObject(CLASS_AutoResetEvent) as _AutoResetEvent; +end; + +class function CoAutoResetEvent.CreateRemote(const MachineName: string): _AutoResetEvent; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AutoResetEvent) as _AutoResetEvent; +end; + +class function CoCompressedStack.Create: _CompressedStack; +begin + Result := CreateComObject(CLASS_CompressedStack) as _CompressedStack; +end; + +class function CoCompressedStack.CreateRemote(const MachineName: string): _CompressedStack; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CompressedStack) as _CompressedStack; +end; + +class function CoInterlocked.Create: _Interlocked; +begin + Result := CreateComObject(CLASS_Interlocked) as _Interlocked; +end; + +class function CoInterlocked.CreateRemote(const MachineName: string): _Interlocked; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Interlocked) as _Interlocked; +end; + +class function CoManualResetEvent.Create: _ManualResetEvent; +begin + Result := CreateComObject(CLASS_ManualResetEvent) as _ManualResetEvent; +end; + +class function CoManualResetEvent.CreateRemote(const MachineName: string): _ManualResetEvent; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ManualResetEvent) as _ManualResetEvent; +end; + +class function CoMonitor.Create: _Monitor; +begin + Result := CreateComObject(CLASS_Monitor) as _Monitor; +end; + +class function CoMonitor.CreateRemote(const MachineName: string): _Monitor; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Monitor) as _Monitor; +end; + +class function CoMutex.Create: _Mutex; +begin + Result := CreateComObject(CLASS_Mutex) as _Mutex; +end; + +class function CoMutex.CreateRemote(const MachineName: string): _Mutex; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Mutex) as _Mutex; +end; + +class function CoOverlapped.Create: _Overlapped; +begin + Result := CreateComObject(CLASS_Overlapped) as _Overlapped; +end; + +class function CoOverlapped.CreateRemote(const MachineName: string): _Overlapped; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Overlapped) as _Overlapped; +end; + +class function CoReaderWriterLock.Create: _ReaderWriterLock; +begin + Result := CreateComObject(CLASS_ReaderWriterLock) as _ReaderWriterLock; +end; + +class function CoReaderWriterLock.CreateRemote(const MachineName: string): _ReaderWriterLock; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ReaderWriterLock) as _ReaderWriterLock; +end; + +class function CoSynchronizationLockException.Create: _SynchronizationLockException; +begin + Result := CreateComObject(CLASS_SynchronizationLockException) as _SynchronizationLockException; +end; + +class function CoSynchronizationLockException.CreateRemote(const MachineName: string): _SynchronizationLockException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SynchronizationLockException) as _SynchronizationLockException; +end; + +class function CoThread.Create: _Thread; +begin + Result := CreateComObject(CLASS_Thread) as _Thread; +end; + +class function CoThread.CreateRemote(const MachineName: string): _Thread; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Thread) as _Thread; +end; + +class function CoThreadAbortException.Create: _ThreadAbortException; +begin + Result := CreateComObject(CLASS_ThreadAbortException) as _ThreadAbortException; +end; + +class function CoThreadAbortException.CreateRemote(const MachineName: string): _ThreadAbortException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ThreadAbortException) as _ThreadAbortException; +end; + +class function CoSTAThreadAttribute.Create: _STAThreadAttribute; +begin + Result := CreateComObject(CLASS_STAThreadAttribute) as _STAThreadAttribute; +end; + +class function CoSTAThreadAttribute.CreateRemote(const MachineName: string): _STAThreadAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_STAThreadAttribute) as _STAThreadAttribute; +end; + +class function CoMTAThreadAttribute.Create: _MTAThreadAttribute; +begin + Result := CreateComObject(CLASS_MTAThreadAttribute) as _MTAThreadAttribute; +end; + +class function CoMTAThreadAttribute.CreateRemote(const MachineName: string): _MTAThreadAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MTAThreadAttribute) as _MTAThreadAttribute; +end; + +class function CoThreadInterruptedException.Create: _ThreadInterruptedException; +begin + Result := CreateComObject(CLASS_ThreadInterruptedException) as _ThreadInterruptedException; +end; + +class function CoThreadInterruptedException.CreateRemote(const MachineName: string): _ThreadInterruptedException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ThreadInterruptedException) as _ThreadInterruptedException; +end; + +class function CoRegisteredWaitHandle.Create: _RegisteredWaitHandle; +begin + Result := CreateComObject(CLASS_RegisteredWaitHandle) as _RegisteredWaitHandle; +end; + +class function CoRegisteredWaitHandle.CreateRemote(const MachineName: string): _RegisteredWaitHandle; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RegisteredWaitHandle) as _RegisteredWaitHandle; +end; + +class function CoWaitCallback.Create: _WaitCallback; +begin + Result := CreateComObject(CLASS_WaitCallback) as _WaitCallback; +end; + +class function CoWaitCallback.CreateRemote(const MachineName: string): _WaitCallback; +begin + Result := CreateRemoteComObject(MachineName, CLASS_WaitCallback) as _WaitCallback; +end; + +class function CoWaitOrTimerCallback.Create: _WaitOrTimerCallback; +begin + Result := CreateComObject(CLASS_WaitOrTimerCallback) as _WaitOrTimerCallback; +end; + +class function CoWaitOrTimerCallback.CreateRemote(const MachineName: string): _WaitOrTimerCallback; +begin + Result := CreateRemoteComObject(MachineName, CLASS_WaitOrTimerCallback) as _WaitOrTimerCallback; +end; + +class function CoIOCompletionCallback.Create: _IOCompletionCallback; +begin + Result := CreateComObject(CLASS_IOCompletionCallback) as _IOCompletionCallback; +end; + +class function CoIOCompletionCallback.CreateRemote(const MachineName: string): _IOCompletionCallback; +begin + Result := CreateRemoteComObject(MachineName, CLASS_IOCompletionCallback) as _IOCompletionCallback; +end; + +class function CoThreadPool.Create: _ThreadPool; +begin + Result := CreateComObject(CLASS_ThreadPool) as _ThreadPool; +end; + +class function CoThreadPool.CreateRemote(const MachineName: string): _ThreadPool; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ThreadPool) as _ThreadPool; +end; + +class function CoThreadStart.Create: _ThreadStart; +begin + Result := CreateComObject(CLASS_ThreadStart) as _ThreadStart; +end; + +class function CoThreadStart.CreateRemote(const MachineName: string): _ThreadStart; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ThreadStart) as _ThreadStart; +end; + +class function CoThreadStateException.Create: _ThreadStateException; +begin + Result := CreateComObject(CLASS_ThreadStateException) as _ThreadStateException; +end; + +class function CoThreadStateException.CreateRemote(const MachineName: string): _ThreadStateException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ThreadStateException) as _ThreadStateException; +end; + +class function CoThreadStaticAttribute.Create: _ThreadStaticAttribute; +begin + Result := CreateComObject(CLASS_ThreadStaticAttribute) as _ThreadStaticAttribute; +end; + +class function CoThreadStaticAttribute.CreateRemote(const MachineName: string): _ThreadStaticAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ThreadStaticAttribute) as _ThreadStaticAttribute; +end; + +class function CoTimeout.Create: _Timeout; +begin + Result := CreateComObject(CLASS_Timeout) as _Timeout; +end; + +class function CoTimeout.CreateRemote(const MachineName: string): _Timeout; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Timeout) as _Timeout; +end; + +class function CoTimerCallback.Create: _TimerCallback; +begin + Result := CreateComObject(CLASS_TimerCallback) as _TimerCallback; +end; + +class function CoTimerCallback.CreateRemote(const MachineName: string): _TimerCallback; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TimerCallback) as _TimerCallback; +end; + +class function CoTimer.Create: _Timer; +begin + Result := CreateComObject(CLASS_Timer) as _Timer; +end; + +class function CoTimer.CreateRemote(const MachineName: string): _Timer; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Timer) as _Timer; +end; + +class function CoArrayList.Create: _ArrayList; +begin + Result := CreateComObject(CLASS_ArrayList) as _ArrayList; +end; + +class function CoArrayList.CreateRemote(const MachineName: string): _ArrayList; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ArrayList) as _ArrayList; +end; + +class function CoBitArray.Create: _BitArray; +begin + Result := CreateComObject(CLASS_BitArray) as _BitArray; +end; + +class function CoBitArray.CreateRemote(const MachineName: string): _BitArray; +begin + Result := CreateRemoteComObject(MachineName, CLASS_BitArray) as _BitArray; +end; + +class function CoCaseInsensitiveComparer.Create: _CaseInsensitiveComparer; +begin + Result := CreateComObject(CLASS_CaseInsensitiveComparer) as _CaseInsensitiveComparer; +end; + +class function CoCaseInsensitiveComparer.CreateRemote(const MachineName: string): _CaseInsensitiveComparer; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CaseInsensitiveComparer) as _CaseInsensitiveComparer; +end; + +class function CoCaseInsensitiveHashCodeProvider.Create: _CaseInsensitiveHashCodeProvider; +begin + Result := CreateComObject(CLASS_CaseInsensitiveHashCodeProvider) as _CaseInsensitiveHashCodeProvider; +end; + +class function CoCaseInsensitiveHashCodeProvider.CreateRemote(const MachineName: string): _CaseInsensitiveHashCodeProvider; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CaseInsensitiveHashCodeProvider) as _CaseInsensitiveHashCodeProvider; +end; + +class function CoCollectionBase.Create: _CollectionBase; +begin + Result := CreateComObject(CLASS_CollectionBase) as _CollectionBase; +end; + +class function CoCollectionBase.CreateRemote(const MachineName: string): _CollectionBase; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CollectionBase) as _CollectionBase; +end; + +class function CoComparer.Create: _Comparer; +begin + Result := CreateComObject(CLASS_Comparer) as _Comparer; +end; + +class function CoComparer.CreateRemote(const MachineName: string): _Comparer; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Comparer) as _Comparer; +end; + +class function CoDictionaryBase.Create: _DictionaryBase; +begin + Result := CreateComObject(CLASS_DictionaryBase) as _DictionaryBase; +end; + +class function CoDictionaryBase.CreateRemote(const MachineName: string): _DictionaryBase; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DictionaryBase) as _DictionaryBase; +end; + +class function CoHashtable.Create: _Hashtable; +begin + Result := CreateComObject(CLASS_Hashtable) as _Hashtable; +end; + +class function CoHashtable.CreateRemote(const MachineName: string): _Hashtable; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Hashtable) as _Hashtable; +end; + +class function CoQueue.Create: _Queue; +begin + Result := CreateComObject(CLASS_Queue) as _Queue; +end; + +class function CoQueue.CreateRemote(const MachineName: string): _Queue; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Queue) as _Queue; +end; + +class function CoReadOnlyCollectionBase.Create: _ReadOnlyCollectionBase; +begin + Result := CreateComObject(CLASS_ReadOnlyCollectionBase) as _ReadOnlyCollectionBase; +end; + +class function CoReadOnlyCollectionBase.CreateRemote(const MachineName: string): _ReadOnlyCollectionBase; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ReadOnlyCollectionBase) as _ReadOnlyCollectionBase; +end; + +class function CoSortedList.Create: _SortedList; +begin + Result := CreateComObject(CLASS_SortedList) as _SortedList; +end; + +class function CoSortedList.CreateRemote(const MachineName: string): _SortedList; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SortedList) as _SortedList; +end; + +class function CoStack.Create: _Stack; +begin + Result := CreateComObject(CLASS_Stack) as _Stack; +end; + +class function CoStack.CreateRemote(const MachineName: string): _Stack; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Stack) as _Stack; +end; + +class function CoConditionalAttribute.Create: _ConditionalAttribute; +begin + Result := CreateComObject(CLASS_ConditionalAttribute) as _ConditionalAttribute; +end; + +class function CoConditionalAttribute.CreateRemote(const MachineName: string): _ConditionalAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ConditionalAttribute) as _ConditionalAttribute; +end; + +class function CoDebugger.Create: _Debugger; +begin + Result := CreateComObject(CLASS_Debugger) as _Debugger; +end; + +class function CoDebugger.CreateRemote(const MachineName: string): _Debugger; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Debugger) as _Debugger; +end; + +class function CoDebuggerStepThroughAttribute.Create: _DebuggerStepThroughAttribute; +begin + Result := CreateComObject(CLASS_DebuggerStepThroughAttribute) as _DebuggerStepThroughAttribute; +end; + +class function CoDebuggerStepThroughAttribute.CreateRemote(const MachineName: string): _DebuggerStepThroughAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DebuggerStepThroughAttribute) as _DebuggerStepThroughAttribute; +end; + +class function CoDebuggerHiddenAttribute.Create: _DebuggerHiddenAttribute; +begin + Result := CreateComObject(CLASS_DebuggerHiddenAttribute) as _DebuggerHiddenAttribute; +end; + +class function CoDebuggerHiddenAttribute.CreateRemote(const MachineName: string): _DebuggerHiddenAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DebuggerHiddenAttribute) as _DebuggerHiddenAttribute; +end; + +class function CoDebuggableAttribute.Create: _DebuggableAttribute; +begin + Result := CreateComObject(CLASS_DebuggableAttribute) as _DebuggableAttribute; +end; + +class function CoDebuggableAttribute.CreateRemote(const MachineName: string): _DebuggableAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DebuggableAttribute) as _DebuggableAttribute; +end; + +class function CoStackTrace.Create: _StackTrace; +begin + Result := CreateComObject(CLASS_StackTrace) as _StackTrace; +end; + +class function CoStackTrace.CreateRemote(const MachineName: string): _StackTrace; +begin + Result := CreateRemoteComObject(MachineName, CLASS_StackTrace) as _StackTrace; +end; + +class function CoStackFrame.Create: _StackFrame; +begin + Result := CreateComObject(CLASS_StackFrame) as _StackFrame; +end; + +class function CoStackFrame.CreateRemote(const MachineName: string): _StackFrame; +begin + Result := CreateRemoteComObject(MachineName, CLASS_StackFrame) as _StackFrame; +end; + +class function CoSymDocumentType.Create: _SymDocumentType; +begin + Result := CreateComObject(CLASS_SymDocumentType) as _SymDocumentType; +end; + +class function CoSymDocumentType.CreateRemote(const MachineName: string): _SymDocumentType; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SymDocumentType) as _SymDocumentType; +end; + +class function CoSymLanguageType.Create: _SymLanguageType; +begin + Result := CreateComObject(CLASS_SymLanguageType) as _SymLanguageType; +end; + +class function CoSymLanguageType.CreateRemote(const MachineName: string): _SymLanguageType; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SymLanguageType) as _SymLanguageType; +end; + +class function CoSymLanguageVendor.Create: _SymLanguageVendor; +begin + Result := CreateComObject(CLASS_SymLanguageVendor) as _SymLanguageVendor; +end; + +class function CoSymLanguageVendor.CreateRemote(const MachineName: string): _SymLanguageVendor; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SymLanguageVendor) as _SymLanguageVendor; +end; + +class function CoAmbiguousMatchException.Create: _AmbiguousMatchException; +begin + Result := CreateComObject(CLASS_AmbiguousMatchException) as _AmbiguousMatchException; +end; + +class function CoAmbiguousMatchException.CreateRemote(const MachineName: string): _AmbiguousMatchException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AmbiguousMatchException) as _AmbiguousMatchException; +end; + +class function CoModuleResolveEventHandler.Create: _ModuleResolveEventHandler; +begin + Result := CreateComObject(CLASS_ModuleResolveEventHandler) as _ModuleResolveEventHandler; +end; + +class function CoModuleResolveEventHandler.CreateRemote(const MachineName: string): _ModuleResolveEventHandler; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ModuleResolveEventHandler) as _ModuleResolveEventHandler; +end; + +class function CoAssembly.Create: _Assembly; +begin + Result := CreateComObject(CLASS_Assembly) as _Assembly; +end; + +class function CoAssembly.CreateRemote(const MachineName: string): _Assembly; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Assembly) as _Assembly; +end; + +class function CoAssemblyCultureAttribute.Create: _AssemblyCultureAttribute; +begin + Result := CreateComObject(CLASS_AssemblyCultureAttribute) as _AssemblyCultureAttribute; +end; + +class function CoAssemblyCultureAttribute.CreateRemote(const MachineName: string): _AssemblyCultureAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AssemblyCultureAttribute) as _AssemblyCultureAttribute; +end; + +class function CoAssemblyVersionAttribute.Create: _AssemblyVersionAttribute; +begin + Result := CreateComObject(CLASS_AssemblyVersionAttribute) as _AssemblyVersionAttribute; +end; + +class function CoAssemblyVersionAttribute.CreateRemote(const MachineName: string): _AssemblyVersionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AssemblyVersionAttribute) as _AssemblyVersionAttribute; +end; + +class function CoAssemblyKeyFileAttribute.Create: _AssemblyKeyFileAttribute; +begin + Result := CreateComObject(CLASS_AssemblyKeyFileAttribute) as _AssemblyKeyFileAttribute; +end; + +class function CoAssemblyKeyFileAttribute.CreateRemote(const MachineName: string): _AssemblyKeyFileAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AssemblyKeyFileAttribute) as _AssemblyKeyFileAttribute; +end; + +class function CoAssemblyKeyNameAttribute.Create: _AssemblyKeyNameAttribute; +begin + Result := CreateComObject(CLASS_AssemblyKeyNameAttribute) as _AssemblyKeyNameAttribute; +end; + +class function CoAssemblyKeyNameAttribute.CreateRemote(const MachineName: string): _AssemblyKeyNameAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AssemblyKeyNameAttribute) as _AssemblyKeyNameAttribute; +end; + +class function CoAssemblyDelaySignAttribute.Create: _AssemblyDelaySignAttribute; +begin + Result := CreateComObject(CLASS_AssemblyDelaySignAttribute) as _AssemblyDelaySignAttribute; +end; + +class function CoAssemblyDelaySignAttribute.CreateRemote(const MachineName: string): _AssemblyDelaySignAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AssemblyDelaySignAttribute) as _AssemblyDelaySignAttribute; +end; + +class function CoAssemblyAlgorithmIdAttribute.Create: _AssemblyAlgorithmIdAttribute; +begin + Result := CreateComObject(CLASS_AssemblyAlgorithmIdAttribute) as _AssemblyAlgorithmIdAttribute; +end; + +class function CoAssemblyAlgorithmIdAttribute.CreateRemote(const MachineName: string): _AssemblyAlgorithmIdAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AssemblyAlgorithmIdAttribute) as _AssemblyAlgorithmIdAttribute; +end; + +class function CoAssemblyFlagsAttribute.Create: _AssemblyFlagsAttribute; +begin + Result := CreateComObject(CLASS_AssemblyFlagsAttribute) as _AssemblyFlagsAttribute; +end; + +class function CoAssemblyFlagsAttribute.CreateRemote(const MachineName: string): _AssemblyFlagsAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AssemblyFlagsAttribute) as _AssemblyFlagsAttribute; +end; + +class function CoAssemblyFileVersionAttribute.Create: _AssemblyFileVersionAttribute; +begin + Result := CreateComObject(CLASS_AssemblyFileVersionAttribute) as _AssemblyFileVersionAttribute; +end; + +class function CoAssemblyFileVersionAttribute.CreateRemote(const MachineName: string): _AssemblyFileVersionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AssemblyFileVersionAttribute) as _AssemblyFileVersionAttribute; +end; + +class function CoAssemblyName.Create: _AssemblyName; +begin + Result := CreateComObject(CLASS_AssemblyName) as _AssemblyName; +end; + +class function CoAssemblyName.CreateRemote(const MachineName: string): _AssemblyName; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AssemblyName) as _AssemblyName; +end; + +class function CoAssemblyNameProxy.Create: _AssemblyNameProxy; +begin + Result := CreateComObject(CLASS_AssemblyNameProxy) as _AssemblyNameProxy; +end; + +class function CoAssemblyNameProxy.CreateRemote(const MachineName: string): _AssemblyNameProxy; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AssemblyNameProxy) as _AssemblyNameProxy; +end; + +class function CoAssemblyCopyrightAttribute.Create: _AssemblyCopyrightAttribute; +begin + Result := CreateComObject(CLASS_AssemblyCopyrightAttribute) as _AssemblyCopyrightAttribute; +end; + +class function CoAssemblyCopyrightAttribute.CreateRemote(const MachineName: string): _AssemblyCopyrightAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AssemblyCopyrightAttribute) as _AssemblyCopyrightAttribute; +end; + +class function CoAssemblyTrademarkAttribute.Create: _AssemblyTrademarkAttribute; +begin + Result := CreateComObject(CLASS_AssemblyTrademarkAttribute) as _AssemblyTrademarkAttribute; +end; + +class function CoAssemblyTrademarkAttribute.CreateRemote(const MachineName: string): _AssemblyTrademarkAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AssemblyTrademarkAttribute) as _AssemblyTrademarkAttribute; +end; + +class function CoAssemblyProductAttribute.Create: _AssemblyProductAttribute; +begin + Result := CreateComObject(CLASS_AssemblyProductAttribute) as _AssemblyProductAttribute; +end; + +class function CoAssemblyProductAttribute.CreateRemote(const MachineName: string): _AssemblyProductAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AssemblyProductAttribute) as _AssemblyProductAttribute; +end; + +class function CoAssemblyCompanyAttribute.Create: _AssemblyCompanyAttribute; +begin + Result := CreateComObject(CLASS_AssemblyCompanyAttribute) as _AssemblyCompanyAttribute; +end; + +class function CoAssemblyCompanyAttribute.CreateRemote(const MachineName: string): _AssemblyCompanyAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AssemblyCompanyAttribute) as _AssemblyCompanyAttribute; +end; + +class function CoAssemblyDescriptionAttribute.Create: _AssemblyDescriptionAttribute; +begin + Result := CreateComObject(CLASS_AssemblyDescriptionAttribute) as _AssemblyDescriptionAttribute; +end; + +class function CoAssemblyDescriptionAttribute.CreateRemote(const MachineName: string): _AssemblyDescriptionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AssemblyDescriptionAttribute) as _AssemblyDescriptionAttribute; +end; + +class function CoAssemblyTitleAttribute.Create: _AssemblyTitleAttribute; +begin + Result := CreateComObject(CLASS_AssemblyTitleAttribute) as _AssemblyTitleAttribute; +end; + +class function CoAssemblyTitleAttribute.CreateRemote(const MachineName: string): _AssemblyTitleAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AssemblyTitleAttribute) as _AssemblyTitleAttribute; +end; + +class function CoAssemblyConfigurationAttribute.Create: _AssemblyConfigurationAttribute; +begin + Result := CreateComObject(CLASS_AssemblyConfigurationAttribute) as _AssemblyConfigurationAttribute; +end; + +class function CoAssemblyConfigurationAttribute.CreateRemote(const MachineName: string): _AssemblyConfigurationAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AssemblyConfigurationAttribute) as _AssemblyConfigurationAttribute; +end; + +class function CoAssemblyDefaultAliasAttribute.Create: _AssemblyDefaultAliasAttribute; +begin + Result := CreateComObject(CLASS_AssemblyDefaultAliasAttribute) as _AssemblyDefaultAliasAttribute; +end; + +class function CoAssemblyDefaultAliasAttribute.CreateRemote(const MachineName: string): _AssemblyDefaultAliasAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AssemblyDefaultAliasAttribute) as _AssemblyDefaultAliasAttribute; +end; + +class function CoAssemblyInformationalVersionAttribute.Create: _AssemblyInformationalVersionAttribute; +begin + Result := CreateComObject(CLASS_AssemblyInformationalVersionAttribute) as _AssemblyInformationalVersionAttribute; +end; + +class function CoAssemblyInformationalVersionAttribute.CreateRemote(const MachineName: string): _AssemblyInformationalVersionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AssemblyInformationalVersionAttribute) as _AssemblyInformationalVersionAttribute; +end; + +class function CoCustomAttributeFormatException.Create: _CustomAttributeFormatException; +begin + Result := CreateComObject(CLASS_CustomAttributeFormatException) as _CustomAttributeFormatException; +end; + +class function CoCustomAttributeFormatException.CreateRemote(const MachineName: string): _CustomAttributeFormatException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CustomAttributeFormatException) as _CustomAttributeFormatException; +end; + +class function CoMethodBase.Create: _MethodBase; +begin + Result := CreateComObject(CLASS_MethodBase) as _MethodBase; +end; + +class function CoMethodBase.CreateRemote(const MachineName: string): _MethodBase; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MethodBase) as _MethodBase; +end; + +class function CoConstructorInfo.Create: _ConstructorInfo; +begin + Result := CreateComObject(CLASS_ConstructorInfo) as _ConstructorInfo; +end; + +class function CoConstructorInfo.CreateRemote(const MachineName: string): _ConstructorInfo; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ConstructorInfo) as _ConstructorInfo; +end; + +class function CoDefaultMemberAttribute.Create: _DefaultMemberAttribute; +begin + Result := CreateComObject(CLASS_DefaultMemberAttribute) as _DefaultMemberAttribute; +end; + +class function CoDefaultMemberAttribute.CreateRemote(const MachineName: string): _DefaultMemberAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DefaultMemberAttribute) as _DefaultMemberAttribute; +end; + +class function CoEventInfo.Create: _EventInfo; +begin + Result := CreateComObject(CLASS_EventInfo) as _EventInfo; +end; + +class function CoEventInfo.CreateRemote(const MachineName: string): _EventInfo; +begin + Result := CreateRemoteComObject(MachineName, CLASS_EventInfo) as _EventInfo; +end; + +class function CoFieldInfo.Create: _FieldInfo; +begin + Result := CreateComObject(CLASS_FieldInfo) as _FieldInfo; +end; + +class function CoFieldInfo.CreateRemote(const MachineName: string): _FieldInfo; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FieldInfo) as _FieldInfo; +end; + +class function CoInvalidFilterCriteriaException.Create: _InvalidFilterCriteriaException; +begin + Result := CreateComObject(CLASS_InvalidFilterCriteriaException) as _InvalidFilterCriteriaException; +end; + +class function CoInvalidFilterCriteriaException.CreateRemote(const MachineName: string): _InvalidFilterCriteriaException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_InvalidFilterCriteriaException) as _InvalidFilterCriteriaException; +end; + +class function CoManifestResourceInfo.Create: _ManifestResourceInfo; +begin + Result := CreateComObject(CLASS_ManifestResourceInfo) as _ManifestResourceInfo; +end; + +class function CoManifestResourceInfo.CreateRemote(const MachineName: string): _ManifestResourceInfo; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ManifestResourceInfo) as _ManifestResourceInfo; +end; + +class function CoMemberFilter.Create: _MemberFilter; +begin + Result := CreateComObject(CLASS_MemberFilter) as _MemberFilter; +end; + +class function CoMemberFilter.CreateRemote(const MachineName: string): _MemberFilter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MemberFilter) as _MemberFilter; +end; + +class function CoMethodInfo.Create: _MethodInfo; +begin + Result := CreateComObject(CLASS_MethodInfo) as _MethodInfo; +end; + +class function CoMethodInfo.CreateRemote(const MachineName: string): _MethodInfo; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MethodInfo) as _MethodInfo; +end; + +class function CoMissing.Create: _Missing; +begin + Result := CreateComObject(CLASS_Missing) as _Missing; +end; + +class function CoMissing.CreateRemote(const MachineName: string): _Missing; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Missing) as _Missing; +end; + +class function CoModule.Create: _Module; +begin + Result := CreateComObject(CLASS_Module) as _Module; +end; + +class function CoModule.CreateRemote(const MachineName: string): _Module; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Module) as _Module; +end; + +class function CoParameterInfo.Create: _ParameterInfo; +begin + Result := CreateComObject(CLASS_ParameterInfo) as _ParameterInfo; +end; + +class function CoParameterInfo.CreateRemote(const MachineName: string): _ParameterInfo; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ParameterInfo) as _ParameterInfo; +end; + +class function CoPointer.Create: _Pointer; +begin + Result := CreateComObject(CLASS_Pointer) as _Pointer; +end; + +class function CoPointer.CreateRemote(const MachineName: string): _Pointer; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Pointer) as _Pointer; +end; + +class function CoPropertyInfo.Create: _PropertyInfo; +begin + Result := CreateComObject(CLASS_PropertyInfo) as _PropertyInfo; +end; + +class function CoPropertyInfo.CreateRemote(const MachineName: string): _PropertyInfo; +begin + Result := CreateRemoteComObject(MachineName, CLASS_PropertyInfo) as _PropertyInfo; +end; + +class function CoReflectionTypeLoadException.Create: _ReflectionTypeLoadException; +begin + Result := CreateComObject(CLASS_ReflectionTypeLoadException) as _ReflectionTypeLoadException; +end; + +class function CoReflectionTypeLoadException.CreateRemote(const MachineName: string): _ReflectionTypeLoadException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ReflectionTypeLoadException) as _ReflectionTypeLoadException; +end; + +class function CoStrongNameKeyPair.Create: _StrongNameKeyPair; +begin + Result := CreateComObject(CLASS_StrongNameKeyPair) as _StrongNameKeyPair; +end; + +class function CoStrongNameKeyPair.CreateRemote(const MachineName: string): _StrongNameKeyPair; +begin + Result := CreateRemoteComObject(MachineName, CLASS_StrongNameKeyPair) as _StrongNameKeyPair; +end; + +class function CoTargetException.Create: _TargetException; +begin + Result := CreateComObject(CLASS_TargetException) as _TargetException; +end; + +class function CoTargetException.CreateRemote(const MachineName: string): _TargetException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TargetException) as _TargetException; +end; + +class function CoTargetInvocationException.Create: _TargetInvocationException; +begin + Result := CreateComObject(CLASS_TargetInvocationException) as _TargetInvocationException; +end; + +class function CoTargetInvocationException.CreateRemote(const MachineName: string): _TargetInvocationException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TargetInvocationException) as _TargetInvocationException; +end; + +class function CoTargetParameterCountException.Create: _TargetParameterCountException; +begin + Result := CreateComObject(CLASS_TargetParameterCountException) as _TargetParameterCountException; +end; + +class function CoTargetParameterCountException.CreateRemote(const MachineName: string): _TargetParameterCountException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TargetParameterCountException) as _TargetParameterCountException; +end; + +class function CoTypeDelegator.Create: _TypeDelegator; +begin + Result := CreateComObject(CLASS_TypeDelegator) as _TypeDelegator; +end; + +class function CoTypeDelegator.CreateRemote(const MachineName: string): _TypeDelegator; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TypeDelegator) as _TypeDelegator; +end; + +class function CoTypeFilter.Create: _TypeFilter; +begin + Result := CreateComObject(CLASS_TypeFilter) as _TypeFilter; +end; + +class function CoTypeFilter.CreateRemote(const MachineName: string): _TypeFilter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TypeFilter) as _TypeFilter; +end; + +class function CoUnmanagedMarshal.Create: _UnmanagedMarshal; +begin + Result := CreateComObject(CLASS_UnmanagedMarshal) as _UnmanagedMarshal; +end; + +class function CoUnmanagedMarshal.CreateRemote(const MachineName: string): _UnmanagedMarshal; +begin + Result := CreateRemoteComObject(MachineName, CLASS_UnmanagedMarshal) as _UnmanagedMarshal; +end; + +class function CoFormatter.Create: _Formatter; +begin + Result := CreateComObject(CLASS_Formatter) as _Formatter; +end; + +class function CoFormatter.CreateRemote(const MachineName: string): _Formatter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Formatter) as _Formatter; +end; + +class function CoFormatterConverter.Create: _FormatterConverter; +begin + Result := CreateComObject(CLASS_FormatterConverter) as _FormatterConverter; +end; + +class function CoFormatterConverter.CreateRemote(const MachineName: string): _FormatterConverter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FormatterConverter) as _FormatterConverter; +end; + +class function CoFormatterServices.Create: _FormatterServices; +begin + Result := CreateComObject(CLASS_FormatterServices) as _FormatterServices; +end; + +class function CoFormatterServices.CreateRemote(const MachineName: string): _FormatterServices; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FormatterServices) as _FormatterServices; +end; + +class function CoObjectIDGenerator.Create: _ObjectIDGenerator; +begin + Result := CreateComObject(CLASS_ObjectIDGenerator) as _ObjectIDGenerator; +end; + +class function CoObjectIDGenerator.CreateRemote(const MachineName: string): _ObjectIDGenerator; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ObjectIDGenerator) as _ObjectIDGenerator; +end; + +class function CoObjectManager.Create: _ObjectManager; +begin + Result := CreateComObject(CLASS_ObjectManager) as _ObjectManager; +end; + +class function CoObjectManager.CreateRemote(const MachineName: string): _ObjectManager; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ObjectManager) as _ObjectManager; +end; + +class function CoSerializationBinder.Create: _SerializationBinder; +begin + Result := CreateComObject(CLASS_SerializationBinder) as _SerializationBinder; +end; + +class function CoSerializationBinder.CreateRemote(const MachineName: string): _SerializationBinder; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SerializationBinder) as _SerializationBinder; +end; + +class function CoSerializationInfo.Create: _SerializationInfo; +begin + Result := CreateComObject(CLASS_SerializationInfo) as _SerializationInfo; +end; + +class function CoSerializationInfo.CreateRemote(const MachineName: string): _SerializationInfo; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SerializationInfo) as _SerializationInfo; +end; + +class function CoSerializationInfoEnumerator.Create: _SerializationInfoEnumerator; +begin + Result := CreateComObject(CLASS_SerializationInfoEnumerator) as _SerializationInfoEnumerator; +end; + +class function CoSerializationInfoEnumerator.CreateRemote(const MachineName: string): _SerializationInfoEnumerator; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SerializationInfoEnumerator) as _SerializationInfoEnumerator; +end; + +class function CoSerializationException.Create: _SerializationException; +begin + Result := CreateComObject(CLASS_SerializationException) as _SerializationException; +end; + +class function CoSerializationException.CreateRemote(const MachineName: string): _SerializationException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SerializationException) as _SerializationException; +end; + +class function CoSurrogateSelector.Create: _SurrogateSelector; +begin + Result := CreateComObject(CLASS_SurrogateSelector) as _SurrogateSelector; +end; + +class function CoSurrogateSelector.CreateRemote(const MachineName: string): _SurrogateSelector; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SurrogateSelector) as _SurrogateSelector; +end; + +class function CoCalendar.Create: _Calendar; +begin + Result := CreateComObject(CLASS_Calendar) as _Calendar; +end; + +class function CoCalendar.CreateRemote(const MachineName: string): _Calendar; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Calendar) as _Calendar; +end; + +class function CoCompareInfo.Create: _CompareInfo; +begin + Result := CreateComObject(CLASS_CompareInfo) as _CompareInfo; +end; + +class function CoCompareInfo.CreateRemote(const MachineName: string): _CompareInfo; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CompareInfo) as _CompareInfo; +end; + +class function CoCultureInfo.Create: _CultureInfo; +begin + Result := CreateComObject(CLASS_CultureInfo) as _CultureInfo; +end; + +class function CoCultureInfo.CreateRemote(const MachineName: string): _CultureInfo; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CultureInfo) as _CultureInfo; +end; + +class function CoDateTimeFormatInfo.Create: _DateTimeFormatInfo; +begin + Result := CreateComObject(CLASS_DateTimeFormatInfo) as _DateTimeFormatInfo; +end; + +class function CoDateTimeFormatInfo.CreateRemote(const MachineName: string): _DateTimeFormatInfo; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DateTimeFormatInfo) as _DateTimeFormatInfo; +end; + +class function CoDaylightTime.Create: _DaylightTime; +begin + Result := CreateComObject(CLASS_DaylightTime) as _DaylightTime; +end; + +class function CoDaylightTime.CreateRemote(const MachineName: string): _DaylightTime; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DaylightTime) as _DaylightTime; +end; + +class function CoGregorianCalendar.Create: _GregorianCalendar; +begin + Result := CreateComObject(CLASS_GregorianCalendar) as _GregorianCalendar; +end; + +class function CoGregorianCalendar.CreateRemote(const MachineName: string): _GregorianCalendar; +begin + Result := CreateRemoteComObject(MachineName, CLASS_GregorianCalendar) as _GregorianCalendar; +end; + +class function CoHebrewCalendar.Create: _HebrewCalendar; +begin + Result := CreateComObject(CLASS_HebrewCalendar) as _HebrewCalendar; +end; + +class function CoHebrewCalendar.CreateRemote(const MachineName: string): _HebrewCalendar; +begin + Result := CreateRemoteComObject(MachineName, CLASS_HebrewCalendar) as _HebrewCalendar; +end; + +class function CoHijriCalendar.Create: _HijriCalendar; +begin + Result := CreateComObject(CLASS_HijriCalendar) as _HijriCalendar; +end; + +class function CoHijriCalendar.CreateRemote(const MachineName: string): _HijriCalendar; +begin + Result := CreateRemoteComObject(MachineName, CLASS_HijriCalendar) as _HijriCalendar; +end; + +class function CoJapaneseCalendar.Create: _JapaneseCalendar; +begin + Result := CreateComObject(CLASS_JapaneseCalendar) as _JapaneseCalendar; +end; + +class function CoJapaneseCalendar.CreateRemote(const MachineName: string): _JapaneseCalendar; +begin + Result := CreateRemoteComObject(MachineName, CLASS_JapaneseCalendar) as _JapaneseCalendar; +end; + +class function CoJulianCalendar.Create: _JulianCalendar; +begin + Result := CreateComObject(CLASS_JulianCalendar) as _JulianCalendar; +end; + +class function CoJulianCalendar.CreateRemote(const MachineName: string): _JulianCalendar; +begin + Result := CreateRemoteComObject(MachineName, CLASS_JulianCalendar) as _JulianCalendar; +end; + +class function CoKoreanCalendar.Create: _KoreanCalendar; +begin + Result := CreateComObject(CLASS_KoreanCalendar) as _KoreanCalendar; +end; + +class function CoKoreanCalendar.CreateRemote(const MachineName: string): _KoreanCalendar; +begin + Result := CreateRemoteComObject(MachineName, CLASS_KoreanCalendar) as _KoreanCalendar; +end; + +class function CoRegionInfo.Create: _RegionInfo; +begin + Result := CreateComObject(CLASS_RegionInfo) as _RegionInfo; +end; + +class function CoRegionInfo.CreateRemote(const MachineName: string): _RegionInfo; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RegionInfo) as _RegionInfo; +end; + +class function CoSortKey.Create: _SortKey; +begin + Result := CreateComObject(CLASS_SortKey) as _SortKey; +end; + +class function CoSortKey.CreateRemote(const MachineName: string): _SortKey; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SortKey) as _SortKey; +end; + +class function CoStringInfo.Create: _StringInfo; +begin + Result := CreateComObject(CLASS_StringInfo) as _StringInfo; +end; + +class function CoStringInfo.CreateRemote(const MachineName: string): _StringInfo; +begin + Result := CreateRemoteComObject(MachineName, CLASS_StringInfo) as _StringInfo; +end; + +class function CoTaiwanCalendar.Create: _TaiwanCalendar; +begin + Result := CreateComObject(CLASS_TaiwanCalendar) as _TaiwanCalendar; +end; + +class function CoTaiwanCalendar.CreateRemote(const MachineName: string): _TaiwanCalendar; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TaiwanCalendar) as _TaiwanCalendar; +end; + +class function CoTextElementEnumerator.Create: _TextElementEnumerator; +begin + Result := CreateComObject(CLASS_TextElementEnumerator) as _TextElementEnumerator; +end; + +class function CoTextElementEnumerator.CreateRemote(const MachineName: string): _TextElementEnumerator; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TextElementEnumerator) as _TextElementEnumerator; +end; + +class function CoTextInfo.Create: _TextInfo; +begin + Result := CreateComObject(CLASS_TextInfo) as _TextInfo; +end; + +class function CoTextInfo.CreateRemote(const MachineName: string): _TextInfo; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TextInfo) as _TextInfo; +end; + +class function CoThaiBuddhistCalendar.Create: _ThaiBuddhistCalendar; +begin + Result := CreateComObject(CLASS_ThaiBuddhistCalendar) as _ThaiBuddhistCalendar; +end; + +class function CoThaiBuddhistCalendar.CreateRemote(const MachineName: string): _ThaiBuddhistCalendar; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ThaiBuddhistCalendar) as _ThaiBuddhistCalendar; +end; + +class function CoNumberFormatInfo.Create: _NumberFormatInfo; +begin + Result := CreateComObject(CLASS_NumberFormatInfo) as _NumberFormatInfo; +end; + +class function CoNumberFormatInfo.CreateRemote(const MachineName: string): _NumberFormatInfo; +begin + Result := CreateRemoteComObject(MachineName, CLASS_NumberFormatInfo) as _NumberFormatInfo; +end; + +class function CoEncoding.Create: _Encoding; +begin + Result := CreateComObject(CLASS_Encoding) as _Encoding; +end; + +class function CoEncoding.CreateRemote(const MachineName: string): _Encoding; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Encoding) as _Encoding; +end; + +class function CoSystem_Text_Decoder.Create: _System_Text_Decoder; +begin + Result := CreateComObject(CLASS_System_Text_Decoder) as _System_Text_Decoder; +end; + +class function CoSystem_Text_Decoder.CreateRemote(const MachineName: string): _System_Text_Decoder; +begin + Result := CreateRemoteComObject(MachineName, CLASS_System_Text_Decoder) as _System_Text_Decoder; +end; + +class function CoSystem_Text_Encoder.Create: _System_Text_Encoder; +begin + Result := CreateComObject(CLASS_System_Text_Encoder) as _System_Text_Encoder; +end; + +class function CoSystem_Text_Encoder.CreateRemote(const MachineName: string): _System_Text_Encoder; +begin + Result := CreateRemoteComObject(MachineName, CLASS_System_Text_Encoder) as _System_Text_Encoder; +end; + +class function CoASCIIEncoding.Create: _ASCIIEncoding; +begin + Result := CreateComObject(CLASS_ASCIIEncoding) as _ASCIIEncoding; +end; + +class function CoASCIIEncoding.CreateRemote(const MachineName: string): _ASCIIEncoding; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ASCIIEncoding) as _ASCIIEncoding; +end; + +class function CoUnicodeEncoding.Create: _UnicodeEncoding; +begin + Result := CreateComObject(CLASS_UnicodeEncoding) as _UnicodeEncoding; +end; + +class function CoUnicodeEncoding.CreateRemote(const MachineName: string): _UnicodeEncoding; +begin + Result := CreateRemoteComObject(MachineName, CLASS_UnicodeEncoding) as _UnicodeEncoding; +end; + +class function CoUTF7Encoding.Create: _UTF7Encoding; +begin + Result := CreateComObject(CLASS_UTF7Encoding) as _UTF7Encoding; +end; + +class function CoUTF7Encoding.CreateRemote(const MachineName: string): _UTF7Encoding; +begin + Result := CreateRemoteComObject(MachineName, CLASS_UTF7Encoding) as _UTF7Encoding; +end; + +class function CoUTF8Encoding.Create: _UTF8Encoding; +begin + Result := CreateComObject(CLASS_UTF8Encoding) as _UTF8Encoding; +end; + +class function CoUTF8Encoding.CreateRemote(const MachineName: string): _UTF8Encoding; +begin + Result := CreateRemoteComObject(MachineName, CLASS_UTF8Encoding) as _UTF8Encoding; +end; + +class function CoMissingManifestResourceException.Create: _MissingManifestResourceException; +begin + Result := CreateComObject(CLASS_MissingManifestResourceException) as _MissingManifestResourceException; +end; + +class function CoMissingManifestResourceException.CreateRemote(const MachineName: string): _MissingManifestResourceException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MissingManifestResourceException) as _MissingManifestResourceException; +end; + +class function CoNeutralResourcesLanguageAttribute.Create: _NeutralResourcesLanguageAttribute; +begin + Result := CreateComObject(CLASS_NeutralResourcesLanguageAttribute) as _NeutralResourcesLanguageAttribute; +end; + +class function CoNeutralResourcesLanguageAttribute.CreateRemote(const MachineName: string): _NeutralResourcesLanguageAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_NeutralResourcesLanguageAttribute) as _NeutralResourcesLanguageAttribute; +end; + +class function CoResourceManager.Create: _ResourceManager; +begin + Result := CreateComObject(CLASS_ResourceManager) as _ResourceManager; +end; + +class function CoResourceManager.CreateRemote(const MachineName: string): _ResourceManager; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ResourceManager) as _ResourceManager; +end; + +class function CoResourceReader.Create: _ResourceReader; +begin + Result := CreateComObject(CLASS_ResourceReader) as _ResourceReader; +end; + +class function CoResourceReader.CreateRemote(const MachineName: string): _ResourceReader; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ResourceReader) as _ResourceReader; +end; + +class function CoResourceSet.Create: _ResourceSet; +begin + Result := CreateComObject(CLASS_ResourceSet) as _ResourceSet; +end; + +class function CoResourceSet.CreateRemote(const MachineName: string): _ResourceSet; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ResourceSet) as _ResourceSet; +end; + +class function CoResourceWriter.Create: _ResourceWriter; +begin + Result := CreateComObject(CLASS_ResourceWriter) as _ResourceWriter; +end; + +class function CoResourceWriter.CreateRemote(const MachineName: string): _ResourceWriter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ResourceWriter) as _ResourceWriter; +end; + +class function CoSatelliteContractVersionAttribute.Create: _SatelliteContractVersionAttribute; +begin + Result := CreateComObject(CLASS_SatelliteContractVersionAttribute) as _SatelliteContractVersionAttribute; +end; + +class function CoSatelliteContractVersionAttribute.CreateRemote(const MachineName: string): _SatelliteContractVersionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SatelliteContractVersionAttribute) as _SatelliteContractVersionAttribute; +end; + +class function CoRegistry.Create: _Registry; +begin + Result := CreateComObject(CLASS_Registry) as _Registry; +end; + +class function CoRegistry.CreateRemote(const MachineName: string): _Registry; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Registry) as _Registry; +end; + +class function CoRegistryKey.Create: _RegistryKey; +begin + Result := CreateComObject(CLASS_RegistryKey) as _RegistryKey; +end; + +class function CoRegistryKey.CreateRemote(const MachineName: string): _RegistryKey; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RegistryKey) as _RegistryKey; +end; + +class function CoX509Certificate.Create: _X509Certificate; +begin + Result := CreateComObject(CLASS_X509Certificate) as _X509Certificate; +end; + +class function CoX509Certificate.CreateRemote(const MachineName: string): _X509Certificate; +begin + Result := CreateRemoteComObject(MachineName, CLASS_X509Certificate) as _X509Certificate; +end; + +class function CoAsymmetricAlgorithm.Create: _AsymmetricAlgorithm; +begin + Result := CreateComObject(CLASS_AsymmetricAlgorithm) as _AsymmetricAlgorithm; +end; + +class function CoAsymmetricAlgorithm.CreateRemote(const MachineName: string): _AsymmetricAlgorithm; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AsymmetricAlgorithm) as _AsymmetricAlgorithm; +end; + +class function CoAsymmetricKeyExchangeDeformatter.Create: _AsymmetricKeyExchangeDeformatter; +begin + Result := CreateComObject(CLASS_AsymmetricKeyExchangeDeformatter) as _AsymmetricKeyExchangeDeformatter; +end; + +class function CoAsymmetricKeyExchangeDeformatter.CreateRemote(const MachineName: string): _AsymmetricKeyExchangeDeformatter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AsymmetricKeyExchangeDeformatter) as _AsymmetricKeyExchangeDeformatter; +end; + +class function CoAsymmetricKeyExchangeFormatter.Create: _AsymmetricKeyExchangeFormatter; +begin + Result := CreateComObject(CLASS_AsymmetricKeyExchangeFormatter) as _AsymmetricKeyExchangeFormatter; +end; + +class function CoAsymmetricKeyExchangeFormatter.CreateRemote(const MachineName: string): _AsymmetricKeyExchangeFormatter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AsymmetricKeyExchangeFormatter) as _AsymmetricKeyExchangeFormatter; +end; + +class function CoAsymmetricSignatureDeformatter.Create: _AsymmetricSignatureDeformatter; +begin + Result := CreateComObject(CLASS_AsymmetricSignatureDeformatter) as _AsymmetricSignatureDeformatter; +end; + +class function CoAsymmetricSignatureDeformatter.CreateRemote(const MachineName: string): _AsymmetricSignatureDeformatter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AsymmetricSignatureDeformatter) as _AsymmetricSignatureDeformatter; +end; + +class function CoAsymmetricSignatureFormatter.Create: _AsymmetricSignatureFormatter; +begin + Result := CreateComObject(CLASS_AsymmetricSignatureFormatter) as _AsymmetricSignatureFormatter; +end; + +class function CoAsymmetricSignatureFormatter.CreateRemote(const MachineName: string): _AsymmetricSignatureFormatter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AsymmetricSignatureFormatter) as _AsymmetricSignatureFormatter; +end; + +class function CoToBase64Transform.Create: _ToBase64Transform; +begin + Result := CreateComObject(CLASS_ToBase64Transform) as _ToBase64Transform; +end; + +class function CoToBase64Transform.CreateRemote(const MachineName: string): _ToBase64Transform; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ToBase64Transform) as _ToBase64Transform; +end; + +class function CoFromBase64Transform.Create: _FromBase64Transform; +begin + Result := CreateComObject(CLASS_FromBase64Transform) as _FromBase64Transform; +end; + +class function CoFromBase64Transform.CreateRemote(const MachineName: string): _FromBase64Transform; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FromBase64Transform) as _FromBase64Transform; +end; + +class function CoKeySizes.Create: _KeySizes; +begin + Result := CreateComObject(CLASS_KeySizes) as _KeySizes; +end; + +class function CoKeySizes.CreateRemote(const MachineName: string): _KeySizes; +begin + Result := CreateRemoteComObject(MachineName, CLASS_KeySizes) as _KeySizes; +end; + +class function CoCryptographicException.Create: _CryptographicException; +begin + Result := CreateComObject(CLASS_CryptographicException) as _CryptographicException; +end; + +class function CoCryptographicException.CreateRemote(const MachineName: string): _CryptographicException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CryptographicException) as _CryptographicException; +end; + +class function CoCryptographicUnexpectedOperationException.Create: _CryptographicUnexpectedOperationException; +begin + Result := CreateComObject(CLASS_CryptographicUnexpectedOperationException) as _CryptographicUnexpectedOperationException; +end; + +class function CoCryptographicUnexpectedOperationException.CreateRemote(const MachineName: string): _CryptographicUnexpectedOperationException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CryptographicUnexpectedOperationException) as _CryptographicUnexpectedOperationException; +end; + +class function CoCryptoAPITransform.Create: _CryptoAPITransform; +begin + Result := CreateComObject(CLASS_CryptoAPITransform) as _CryptoAPITransform; +end; + +class function CoCryptoAPITransform.CreateRemote(const MachineName: string): _CryptoAPITransform; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CryptoAPITransform) as _CryptoAPITransform; +end; + +class function CoCspParameters.Create: _CspParameters; +begin + Result := CreateComObject(CLASS_CspParameters) as _CspParameters; +end; + +class function CoCspParameters.CreateRemote(const MachineName: string): _CspParameters; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CspParameters) as _CspParameters; +end; + +class function CoCryptoConfig.Create: _CryptoConfig; +begin + Result := CreateComObject(CLASS_CryptoConfig) as _CryptoConfig; +end; + +class function CoCryptoConfig.CreateRemote(const MachineName: string): _CryptoConfig; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CryptoConfig) as _CryptoConfig; +end; + +class function CoStream.Create: _Stream; +begin + Result := CreateComObject(CLASS_Stream) as _Stream; +end; + +class function CoStream.CreateRemote(const MachineName: string): _Stream; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Stream) as _Stream; +end; + +class function CoCryptoStream.Create: _CryptoStream; +begin + Result := CreateComObject(CLASS_CryptoStream) as _CryptoStream; +end; + +class function CoCryptoStream.CreateRemote(const MachineName: string): _CryptoStream; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CryptoStream) as _CryptoStream; +end; + +class function CoSymmetricAlgorithm.Create: _SymmetricAlgorithm; +begin + Result := CreateComObject(CLASS_SymmetricAlgorithm) as _SymmetricAlgorithm; +end; + +class function CoSymmetricAlgorithm.CreateRemote(const MachineName: string): _SymmetricAlgorithm; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SymmetricAlgorithm) as _SymmetricAlgorithm; +end; + +class function CoDES.Create: _DES; +begin + Result := CreateComObject(CLASS_DES) as _DES; +end; + +class function CoDES.CreateRemote(const MachineName: string): _DES; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DES) as _DES; +end; + +class function CoDESCryptoServiceProvider.Create: _DESCryptoServiceProvider; +begin + Result := CreateComObject(CLASS_DESCryptoServiceProvider) as _DESCryptoServiceProvider; +end; + +class function CoDESCryptoServiceProvider.CreateRemote(const MachineName: string): _DESCryptoServiceProvider; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DESCryptoServiceProvider) as _DESCryptoServiceProvider; +end; + +class function CoDeriveBytes.Create: _DeriveBytes; +begin + Result := CreateComObject(CLASS_DeriveBytes) as _DeriveBytes; +end; + +class function CoDeriveBytes.CreateRemote(const MachineName: string): _DeriveBytes; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DeriveBytes) as _DeriveBytes; +end; + +class function CoDSA.Create: _DSA; +begin + Result := CreateComObject(CLASS_DSA) as _DSA; +end; + +class function CoDSA.CreateRemote(const MachineName: string): _DSA; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DSA) as _DSA; +end; + +class function CoDSACryptoServiceProvider.Create: _DSACryptoServiceProvider; +begin + Result := CreateComObject(CLASS_DSACryptoServiceProvider) as _DSACryptoServiceProvider; +end; + +class function CoDSACryptoServiceProvider.CreateRemote(const MachineName: string): _DSACryptoServiceProvider; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DSACryptoServiceProvider) as _DSACryptoServiceProvider; +end; + +class function CoDSASignatureDeformatter.Create: _DSASignatureDeformatter; +begin + Result := CreateComObject(CLASS_DSASignatureDeformatter) as _DSASignatureDeformatter; +end; + +class function CoDSASignatureDeformatter.CreateRemote(const MachineName: string): _DSASignatureDeformatter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DSASignatureDeformatter) as _DSASignatureDeformatter; +end; + +class function CoDSASignatureFormatter.Create: _DSASignatureFormatter; +begin + Result := CreateComObject(CLASS_DSASignatureFormatter) as _DSASignatureFormatter; +end; + +class function CoDSASignatureFormatter.CreateRemote(const MachineName: string): _DSASignatureFormatter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DSASignatureFormatter) as _DSASignatureFormatter; +end; + +class function CoHashAlgorithm.Create: _HashAlgorithm; +begin + Result := CreateComObject(CLASS_HashAlgorithm) as _HashAlgorithm; +end; + +class function CoHashAlgorithm.CreateRemote(const MachineName: string): _HashAlgorithm; +begin + Result := CreateRemoteComObject(MachineName, CLASS_HashAlgorithm) as _HashAlgorithm; +end; + +class function CoKeyedHashAlgorithm.Create: _KeyedHashAlgorithm; +begin + Result := CreateComObject(CLASS_KeyedHashAlgorithm) as _KeyedHashAlgorithm; +end; + +class function CoKeyedHashAlgorithm.CreateRemote(const MachineName: string): _KeyedHashAlgorithm; +begin + Result := CreateRemoteComObject(MachineName, CLASS_KeyedHashAlgorithm) as _KeyedHashAlgorithm; +end; + +class function CoHMACSHA1.Create: _HMACSHA1; +begin + Result := CreateComObject(CLASS_HMACSHA1) as _HMACSHA1; +end; + +class function CoHMACSHA1.CreateRemote(const MachineName: string): _HMACSHA1; +begin + Result := CreateRemoteComObject(MachineName, CLASS_HMACSHA1) as _HMACSHA1; +end; + +class function CoMACTripleDES.Create: _MACTripleDES; +begin + Result := CreateComObject(CLASS_MACTripleDES) as _MACTripleDES; +end; + +class function CoMACTripleDES.CreateRemote(const MachineName: string): _MACTripleDES; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MACTripleDES) as _MACTripleDES; +end; + +class function CoMD5.Create: _MD5; +begin + Result := CreateComObject(CLASS_MD5) as _MD5; +end; + +class function CoMD5.CreateRemote(const MachineName: string): _MD5; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MD5) as _MD5; +end; + +class function CoMD5CryptoServiceProvider.Create: _MD5CryptoServiceProvider; +begin + Result := CreateComObject(CLASS_MD5CryptoServiceProvider) as _MD5CryptoServiceProvider; +end; + +class function CoMD5CryptoServiceProvider.CreateRemote(const MachineName: string): _MD5CryptoServiceProvider; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MD5CryptoServiceProvider) as _MD5CryptoServiceProvider; +end; + +class function CoMaskGenerationMethod.Create: _MaskGenerationMethod; +begin + Result := CreateComObject(CLASS_MaskGenerationMethod) as _MaskGenerationMethod; +end; + +class function CoMaskGenerationMethod.CreateRemote(const MachineName: string): _MaskGenerationMethod; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MaskGenerationMethod) as _MaskGenerationMethod; +end; + +class function CoPasswordDeriveBytes.Create: _PasswordDeriveBytes; +begin + Result := CreateComObject(CLASS_PasswordDeriveBytes) as _PasswordDeriveBytes; +end; + +class function CoPasswordDeriveBytes.CreateRemote(const MachineName: string): _PasswordDeriveBytes; +begin + Result := CreateRemoteComObject(MachineName, CLASS_PasswordDeriveBytes) as _PasswordDeriveBytes; +end; + +class function CoPKCS1MaskGenerationMethod.Create: _PKCS1MaskGenerationMethod; +begin + Result := CreateComObject(CLASS_PKCS1MaskGenerationMethod) as _PKCS1MaskGenerationMethod; +end; + +class function CoPKCS1MaskGenerationMethod.CreateRemote(const MachineName: string): _PKCS1MaskGenerationMethod; +begin + Result := CreateRemoteComObject(MachineName, CLASS_PKCS1MaskGenerationMethod) as _PKCS1MaskGenerationMethod; +end; + +class function CoRC2.Create: _RC2; +begin + Result := CreateComObject(CLASS_RC2) as _RC2; +end; + +class function CoRC2.CreateRemote(const MachineName: string): _RC2; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RC2) as _RC2; +end; + +class function CoRC2CryptoServiceProvider.Create: _RC2CryptoServiceProvider; +begin + Result := CreateComObject(CLASS_RC2CryptoServiceProvider) as _RC2CryptoServiceProvider; +end; + +class function CoRC2CryptoServiceProvider.CreateRemote(const MachineName: string): _RC2CryptoServiceProvider; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RC2CryptoServiceProvider) as _RC2CryptoServiceProvider; +end; + +class function CoRandomNumberGenerator.Create: _RandomNumberGenerator; +begin + Result := CreateComObject(CLASS_RandomNumberGenerator) as _RandomNumberGenerator; +end; + +class function CoRandomNumberGenerator.CreateRemote(const MachineName: string): _RandomNumberGenerator; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RandomNumberGenerator) as _RandomNumberGenerator; +end; + +class function CoRNGCryptoServiceProvider.Create: _RNGCryptoServiceProvider; +begin + Result := CreateComObject(CLASS_RNGCryptoServiceProvider) as _RNGCryptoServiceProvider; +end; + +class function CoRNGCryptoServiceProvider.CreateRemote(const MachineName: string): _RNGCryptoServiceProvider; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RNGCryptoServiceProvider) as _RNGCryptoServiceProvider; +end; + +class function CoRSA.Create: _RSA; +begin + Result := CreateComObject(CLASS_RSA) as _RSA; +end; + +class function CoRSA.CreateRemote(const MachineName: string): _RSA; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RSA) as _RSA; +end; + +class function CoRSACryptoServiceProvider.Create: _RSACryptoServiceProvider; +begin + Result := CreateComObject(CLASS_RSACryptoServiceProvider) as _RSACryptoServiceProvider; +end; + +class function CoRSACryptoServiceProvider.CreateRemote(const MachineName: string): _RSACryptoServiceProvider; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RSACryptoServiceProvider) as _RSACryptoServiceProvider; +end; + +class function CoRSAOAEPKeyExchangeDeformatter.Create: _RSAOAEPKeyExchangeDeformatter; +begin + Result := CreateComObject(CLASS_RSAOAEPKeyExchangeDeformatter) as _RSAOAEPKeyExchangeDeformatter; +end; + +class function CoRSAOAEPKeyExchangeDeformatter.CreateRemote(const MachineName: string): _RSAOAEPKeyExchangeDeformatter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RSAOAEPKeyExchangeDeformatter) as _RSAOAEPKeyExchangeDeformatter; +end; + +class function CoRSAOAEPKeyExchangeFormatter.Create: _RSAOAEPKeyExchangeFormatter; +begin + Result := CreateComObject(CLASS_RSAOAEPKeyExchangeFormatter) as _RSAOAEPKeyExchangeFormatter; +end; + +class function CoRSAOAEPKeyExchangeFormatter.CreateRemote(const MachineName: string): _RSAOAEPKeyExchangeFormatter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RSAOAEPKeyExchangeFormatter) as _RSAOAEPKeyExchangeFormatter; +end; + +class function CoRSAPKCS1KeyExchangeDeformatter.Create: _RSAPKCS1KeyExchangeDeformatter; +begin + Result := CreateComObject(CLASS_RSAPKCS1KeyExchangeDeformatter) as _RSAPKCS1KeyExchangeDeformatter; +end; + +class function CoRSAPKCS1KeyExchangeDeformatter.CreateRemote(const MachineName: string): _RSAPKCS1KeyExchangeDeformatter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RSAPKCS1KeyExchangeDeformatter) as _RSAPKCS1KeyExchangeDeformatter; +end; + +class function CoRSAPKCS1KeyExchangeFormatter.Create: _RSAPKCS1KeyExchangeFormatter; +begin + Result := CreateComObject(CLASS_RSAPKCS1KeyExchangeFormatter) as _RSAPKCS1KeyExchangeFormatter; +end; + +class function CoRSAPKCS1KeyExchangeFormatter.CreateRemote(const MachineName: string): _RSAPKCS1KeyExchangeFormatter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RSAPKCS1KeyExchangeFormatter) as _RSAPKCS1KeyExchangeFormatter; +end; + +class function CoRSAPKCS1SignatureDeformatter.Create: _RSAPKCS1SignatureDeformatter; +begin + Result := CreateComObject(CLASS_RSAPKCS1SignatureDeformatter) as _RSAPKCS1SignatureDeformatter; +end; + +class function CoRSAPKCS1SignatureDeformatter.CreateRemote(const MachineName: string): _RSAPKCS1SignatureDeformatter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RSAPKCS1SignatureDeformatter) as _RSAPKCS1SignatureDeformatter; +end; + +class function CoRSAPKCS1SignatureFormatter.Create: _RSAPKCS1SignatureFormatter; +begin + Result := CreateComObject(CLASS_RSAPKCS1SignatureFormatter) as _RSAPKCS1SignatureFormatter; +end; + +class function CoRSAPKCS1SignatureFormatter.CreateRemote(const MachineName: string): _RSAPKCS1SignatureFormatter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RSAPKCS1SignatureFormatter) as _RSAPKCS1SignatureFormatter; +end; + +class function CoRijndael.Create: _Rijndael; +begin + Result := CreateComObject(CLASS_Rijndael) as _Rijndael; +end; + +class function CoRijndael.CreateRemote(const MachineName: string): _Rijndael; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Rijndael) as _Rijndael; +end; + +class function CoRijndaelManaged.Create: _RijndaelManaged; +begin + Result := CreateComObject(CLASS_RijndaelManaged) as _RijndaelManaged; +end; + +class function CoRijndaelManaged.CreateRemote(const MachineName: string): _RijndaelManaged; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RijndaelManaged) as _RijndaelManaged; +end; + +class function CoSHA1.Create: _SHA1; +begin + Result := CreateComObject(CLASS_SHA1) as _SHA1; +end; + +class function CoSHA1.CreateRemote(const MachineName: string): _SHA1; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SHA1) as _SHA1; +end; + +class function CoSHA1CryptoServiceProvider.Create: _SHA1CryptoServiceProvider; +begin + Result := CreateComObject(CLASS_SHA1CryptoServiceProvider) as _SHA1CryptoServiceProvider; +end; + +class function CoSHA1CryptoServiceProvider.CreateRemote(const MachineName: string): _SHA1CryptoServiceProvider; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SHA1CryptoServiceProvider) as _SHA1CryptoServiceProvider; +end; + +class function CoSHA1Managed.Create: _SHA1Managed; +begin + Result := CreateComObject(CLASS_SHA1Managed) as _SHA1Managed; +end; + +class function CoSHA1Managed.CreateRemote(const MachineName: string): _SHA1Managed; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SHA1Managed) as _SHA1Managed; +end; + +class function CoSHA256.Create: _SHA256; +begin + Result := CreateComObject(CLASS_SHA256) as _SHA256; +end; + +class function CoSHA256.CreateRemote(const MachineName: string): _SHA256; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SHA256) as _SHA256; +end; + +class function CoSHA256Managed.Create: _SHA256Managed; +begin + Result := CreateComObject(CLASS_SHA256Managed) as _SHA256Managed; +end; + +class function CoSHA256Managed.CreateRemote(const MachineName: string): _SHA256Managed; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SHA256Managed) as _SHA256Managed; +end; + +class function CoSHA384.Create: _SHA384; +begin + Result := CreateComObject(CLASS_SHA384) as _SHA384; +end; + +class function CoSHA384.CreateRemote(const MachineName: string): _SHA384; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SHA384) as _SHA384; +end; + +class function CoSHA384Managed.Create: _SHA384Managed; +begin + Result := CreateComObject(CLASS_SHA384Managed) as _SHA384Managed; +end; + +class function CoSHA384Managed.CreateRemote(const MachineName: string): _SHA384Managed; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SHA384Managed) as _SHA384Managed; +end; + +class function CoSHA512.Create: _SHA512; +begin + Result := CreateComObject(CLASS_SHA512) as _SHA512; +end; + +class function CoSHA512.CreateRemote(const MachineName: string): _SHA512; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SHA512) as _SHA512; +end; + +class function CoSHA512Managed.Create: _SHA512Managed; +begin + Result := CreateComObject(CLASS_SHA512Managed) as _SHA512Managed; +end; + +class function CoSHA512Managed.CreateRemote(const MachineName: string): _SHA512Managed; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SHA512Managed) as _SHA512Managed; +end; + +class function CoSignatureDescription.Create: _SignatureDescription; +begin + Result := CreateComObject(CLASS_SignatureDescription) as _SignatureDescription; +end; + +class function CoSignatureDescription.CreateRemote(const MachineName: string): _SignatureDescription; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SignatureDescription) as _SignatureDescription; +end; + +class function CoTripleDES.Create: _TripleDES; +begin + Result := CreateComObject(CLASS_TripleDES) as _TripleDES; +end; + +class function CoTripleDES.CreateRemote(const MachineName: string): _TripleDES; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TripleDES) as _TripleDES; +end; + +class function CoTripleDESCryptoServiceProvider.Create: _TripleDESCryptoServiceProvider; +begin + Result := CreateComObject(CLASS_TripleDESCryptoServiceProvider) as _TripleDESCryptoServiceProvider; +end; + +class function CoTripleDESCryptoServiceProvider.CreateRemote(const MachineName: string): _TripleDESCryptoServiceProvider; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TripleDESCryptoServiceProvider) as _TripleDESCryptoServiceProvider; +end; + +class function CoAllMembershipCondition.Create: _AllMembershipCondition; +begin + Result := CreateComObject(CLASS_AllMembershipCondition) as _AllMembershipCondition; +end; + +class function CoAllMembershipCondition.CreateRemote(const MachineName: string): _AllMembershipCondition; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AllMembershipCondition) as _AllMembershipCondition; +end; + +class function CoApplicationDirectory.Create: _ApplicationDirectory; +begin + Result := CreateComObject(CLASS_ApplicationDirectory) as _ApplicationDirectory; +end; + +class function CoApplicationDirectory.CreateRemote(const MachineName: string): _ApplicationDirectory; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ApplicationDirectory) as _ApplicationDirectory; +end; + +class function CoApplicationDirectoryMembershipCondition.Create: _ApplicationDirectoryMembershipCondition; +begin + Result := CreateComObject(CLASS_ApplicationDirectoryMembershipCondition) as _ApplicationDirectoryMembershipCondition; +end; + +class function CoApplicationDirectoryMembershipCondition.CreateRemote(const MachineName: string): _ApplicationDirectoryMembershipCondition; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ApplicationDirectoryMembershipCondition) as _ApplicationDirectoryMembershipCondition; +end; + +class function CoCodeGroup.Create: _CodeGroup; +begin + Result := CreateComObject(CLASS_CodeGroup) as _CodeGroup; +end; + +class function CoCodeGroup.CreateRemote(const MachineName: string): _CodeGroup; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CodeGroup) as _CodeGroup; +end; + +class function CoEvidence.Create: _Evidence; +begin + Result := CreateComObject(CLASS_Evidence) as _Evidence; +end; + +class function CoEvidence.CreateRemote(const MachineName: string): _Evidence; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Evidence) as _Evidence; +end; + +class function CoFileCodeGroup.Create: _FileCodeGroup; +begin + Result := CreateComObject(CLASS_FileCodeGroup) as _FileCodeGroup; +end; + +class function CoFileCodeGroup.CreateRemote(const MachineName: string): _FileCodeGroup; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FileCodeGroup) as _FileCodeGroup; +end; + +class function CoFirstMatchCodeGroup.Create: _FirstMatchCodeGroup; +begin + Result := CreateComObject(CLASS_FirstMatchCodeGroup) as _FirstMatchCodeGroup; +end; + +class function CoFirstMatchCodeGroup.CreateRemote(const MachineName: string): _FirstMatchCodeGroup; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FirstMatchCodeGroup) as _FirstMatchCodeGroup; +end; + +class function CoHash.Create: _Hash; +begin + Result := CreateComObject(CLASS_Hash) as _Hash; +end; + +class function CoHash.CreateRemote(const MachineName: string): _Hash; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Hash) as _Hash; +end; + +class function CoHashMembershipCondition.Create: _HashMembershipCondition; +begin + Result := CreateComObject(CLASS_HashMembershipCondition) as _HashMembershipCondition; +end; + +class function CoHashMembershipCondition.CreateRemote(const MachineName: string): _HashMembershipCondition; +begin + Result := CreateRemoteComObject(MachineName, CLASS_HashMembershipCondition) as _HashMembershipCondition; +end; + +class function CoNetCodeGroup.Create: _NetCodeGroup; +begin + Result := CreateComObject(CLASS_NetCodeGroup) as _NetCodeGroup; +end; + +class function CoNetCodeGroup.CreateRemote(const MachineName: string): _NetCodeGroup; +begin + Result := CreateRemoteComObject(MachineName, CLASS_NetCodeGroup) as _NetCodeGroup; +end; + +class function CoPermissionRequestEvidence.Create: _PermissionRequestEvidence; +begin + Result := CreateComObject(CLASS_PermissionRequestEvidence) as _PermissionRequestEvidence; +end; + +class function CoPermissionRequestEvidence.CreateRemote(const MachineName: string): _PermissionRequestEvidence; +begin + Result := CreateRemoteComObject(MachineName, CLASS_PermissionRequestEvidence) as _PermissionRequestEvidence; +end; + +class function CoPolicyException.Create: _PolicyException; +begin + Result := CreateComObject(CLASS_PolicyException) as _PolicyException; +end; + +class function CoPolicyException.CreateRemote(const MachineName: string): _PolicyException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_PolicyException) as _PolicyException; +end; + +class function CoPolicyLevel.Create: _PolicyLevel; +begin + Result := CreateComObject(CLASS_PolicyLevel) as _PolicyLevel; +end; + +class function CoPolicyLevel.CreateRemote(const MachineName: string): _PolicyLevel; +begin + Result := CreateRemoteComObject(MachineName, CLASS_PolicyLevel) as _PolicyLevel; +end; + +class function CoPolicyStatement.Create: _PolicyStatement; +begin + Result := CreateComObject(CLASS_PolicyStatement) as _PolicyStatement; +end; + +class function CoPolicyStatement.CreateRemote(const MachineName: string): _PolicyStatement; +begin + Result := CreateRemoteComObject(MachineName, CLASS_PolicyStatement) as _PolicyStatement; +end; + +class function CoPublisher.Create: _Publisher; +begin + Result := CreateComObject(CLASS_Publisher) as _Publisher; +end; + +class function CoPublisher.CreateRemote(const MachineName: string): _Publisher; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Publisher) as _Publisher; +end; + +class function CoPublisherMembershipCondition.Create: _PublisherMembershipCondition; +begin + Result := CreateComObject(CLASS_PublisherMembershipCondition) as _PublisherMembershipCondition; +end; + +class function CoPublisherMembershipCondition.CreateRemote(const MachineName: string): _PublisherMembershipCondition; +begin + Result := CreateRemoteComObject(MachineName, CLASS_PublisherMembershipCondition) as _PublisherMembershipCondition; +end; + +class function CoSite.Create: _Site; +begin + Result := CreateComObject(CLASS_Site) as _Site; +end; + +class function CoSite.CreateRemote(const MachineName: string): _Site; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Site) as _Site; +end; + +class function CoSiteMembershipCondition.Create: _SiteMembershipCondition; +begin + Result := CreateComObject(CLASS_SiteMembershipCondition) as _SiteMembershipCondition; +end; + +class function CoSiteMembershipCondition.CreateRemote(const MachineName: string): _SiteMembershipCondition; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SiteMembershipCondition) as _SiteMembershipCondition; +end; + +class function CoStrongName.Create: _StrongName; +begin + Result := CreateComObject(CLASS_StrongName) as _StrongName; +end; + +class function CoStrongName.CreateRemote(const MachineName: string): _StrongName; +begin + Result := CreateRemoteComObject(MachineName, CLASS_StrongName) as _StrongName; +end; + +class function CoStrongNameMembershipCondition.Create: _StrongNameMembershipCondition; +begin + Result := CreateComObject(CLASS_StrongNameMembershipCondition) as _StrongNameMembershipCondition; +end; + +class function CoStrongNameMembershipCondition.CreateRemote(const MachineName: string): _StrongNameMembershipCondition; +begin + Result := CreateRemoteComObject(MachineName, CLASS_StrongNameMembershipCondition) as _StrongNameMembershipCondition; +end; + +class function CoUnionCodeGroup.Create: _UnionCodeGroup; +begin + Result := CreateComObject(CLASS_UnionCodeGroup) as _UnionCodeGroup; +end; + +class function CoUnionCodeGroup.CreateRemote(const MachineName: string): _UnionCodeGroup; +begin + Result := CreateRemoteComObject(MachineName, CLASS_UnionCodeGroup) as _UnionCodeGroup; +end; + +class function CoUrl.Create: _Url; +begin + Result := CreateComObject(CLASS_Url) as _Url; +end; + +class function CoUrl.CreateRemote(const MachineName: string): _Url; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Url) as _Url; +end; + +class function CoUrlMembershipCondition.Create: _UrlMembershipCondition; +begin + Result := CreateComObject(CLASS_UrlMembershipCondition) as _UrlMembershipCondition; +end; + +class function CoUrlMembershipCondition.CreateRemote(const MachineName: string): _UrlMembershipCondition; +begin + Result := CreateRemoteComObject(MachineName, CLASS_UrlMembershipCondition) as _UrlMembershipCondition; +end; + +class function CoZone.Create: _Zone; +begin + Result := CreateComObject(CLASS_Zone) as _Zone; +end; + +class function CoZone.CreateRemote(const MachineName: string): _Zone; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Zone) as _Zone; +end; + +class function CoZoneMembershipCondition.Create: _ZoneMembershipCondition; +begin + Result := CreateComObject(CLASS_ZoneMembershipCondition) as _ZoneMembershipCondition; +end; + +class function CoZoneMembershipCondition.CreateRemote(const MachineName: string): _ZoneMembershipCondition; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ZoneMembershipCondition) as _ZoneMembershipCondition; +end; + +class function CoGenericIdentity.Create: _GenericIdentity; +begin + Result := CreateComObject(CLASS_GenericIdentity) as _GenericIdentity; +end; + +class function CoGenericIdentity.CreateRemote(const MachineName: string): _GenericIdentity; +begin + Result := CreateRemoteComObject(MachineName, CLASS_GenericIdentity) as _GenericIdentity; +end; + +class function CoGenericPrincipal.Create: _GenericPrincipal; +begin + Result := CreateComObject(CLASS_GenericPrincipal) as _GenericPrincipal; +end; + +class function CoGenericPrincipal.CreateRemote(const MachineName: string): _GenericPrincipal; +begin + Result := CreateRemoteComObject(MachineName, CLASS_GenericPrincipal) as _GenericPrincipal; +end; + +class function CoWindowsIdentity.Create: _WindowsIdentity; +begin + Result := CreateComObject(CLASS_WindowsIdentity) as _WindowsIdentity; +end; + +class function CoWindowsIdentity.CreateRemote(const MachineName: string): _WindowsIdentity; +begin + Result := CreateRemoteComObject(MachineName, CLASS_WindowsIdentity) as _WindowsIdentity; +end; + +class function CoWindowsImpersonationContext.Create: _WindowsImpersonationContext; +begin + Result := CreateComObject(CLASS_WindowsImpersonationContext) as _WindowsImpersonationContext; +end; + +class function CoWindowsImpersonationContext.CreateRemote(const MachineName: string): _WindowsImpersonationContext; +begin + Result := CreateRemoteComObject(MachineName, CLASS_WindowsImpersonationContext) as _WindowsImpersonationContext; +end; + +class function CoWindowsPrincipal.Create: _WindowsPrincipal; +begin + Result := CreateComObject(CLASS_WindowsPrincipal) as _WindowsPrincipal; +end; + +class function CoWindowsPrincipal.CreateRemote(const MachineName: string): _WindowsPrincipal; +begin + Result := CreateRemoteComObject(MachineName, CLASS_WindowsPrincipal) as _WindowsPrincipal; +end; + +class function CoDispIdAttribute.Create: _DispIdAttribute; +begin + Result := CreateComObject(CLASS_DispIdAttribute) as _DispIdAttribute; +end; + +class function CoDispIdAttribute.CreateRemote(const MachineName: string): _DispIdAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DispIdAttribute) as _DispIdAttribute; +end; + +class function CoInterfaceTypeAttribute.Create: _InterfaceTypeAttribute; +begin + Result := CreateComObject(CLASS_InterfaceTypeAttribute) as _InterfaceTypeAttribute; +end; + +class function CoInterfaceTypeAttribute.CreateRemote(const MachineName: string): _InterfaceTypeAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_InterfaceTypeAttribute) as _InterfaceTypeAttribute; +end; + +class function CoClassInterfaceAttribute.Create: _ClassInterfaceAttribute; +begin + Result := CreateComObject(CLASS_ClassInterfaceAttribute) as _ClassInterfaceAttribute; +end; + +class function CoClassInterfaceAttribute.CreateRemote(const MachineName: string): _ClassInterfaceAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ClassInterfaceAttribute) as _ClassInterfaceAttribute; +end; + +class function CoComVisibleAttribute.Create: _ComVisibleAttribute; +begin + Result := CreateComObject(CLASS_ComVisibleAttribute) as _ComVisibleAttribute; +end; + +class function CoComVisibleAttribute.CreateRemote(const MachineName: string): _ComVisibleAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ComVisibleAttribute) as _ComVisibleAttribute; +end; + +class function CoLCIDConversionAttribute.Create: _LCIDConversionAttribute; +begin + Result := CreateComObject(CLASS_LCIDConversionAttribute) as _LCIDConversionAttribute; +end; + +class function CoLCIDConversionAttribute.CreateRemote(const MachineName: string): _LCIDConversionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_LCIDConversionAttribute) as _LCIDConversionAttribute; +end; + +class function CoComRegisterFunctionAttribute.Create: _ComRegisterFunctionAttribute; +begin + Result := CreateComObject(CLASS_ComRegisterFunctionAttribute) as _ComRegisterFunctionAttribute; +end; + +class function CoComRegisterFunctionAttribute.CreateRemote(const MachineName: string): _ComRegisterFunctionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ComRegisterFunctionAttribute) as _ComRegisterFunctionAttribute; +end; + +class function CoComUnregisterFunctionAttribute.Create: _ComUnregisterFunctionAttribute; +begin + Result := CreateComObject(CLASS_ComUnregisterFunctionAttribute) as _ComUnregisterFunctionAttribute; +end; + +class function CoComUnregisterFunctionAttribute.CreateRemote(const MachineName: string): _ComUnregisterFunctionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ComUnregisterFunctionAttribute) as _ComUnregisterFunctionAttribute; +end; + +class function CoProgIdAttribute.Create: _ProgIdAttribute; +begin + Result := CreateComObject(CLASS_ProgIdAttribute) as _ProgIdAttribute; +end; + +class function CoProgIdAttribute.CreateRemote(const MachineName: string): _ProgIdAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ProgIdAttribute) as _ProgIdAttribute; +end; + +class function CoImportedFromTypeLibAttribute.Create: _ImportedFromTypeLibAttribute; +begin + Result := CreateComObject(CLASS_ImportedFromTypeLibAttribute) as _ImportedFromTypeLibAttribute; +end; + +class function CoImportedFromTypeLibAttribute.CreateRemote(const MachineName: string): _ImportedFromTypeLibAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ImportedFromTypeLibAttribute) as _ImportedFromTypeLibAttribute; +end; + +class function CoIDispatchImplAttribute.Create: _IDispatchImplAttribute; +begin + Result := CreateComObject(CLASS_IDispatchImplAttribute) as _IDispatchImplAttribute; +end; + +class function CoIDispatchImplAttribute.CreateRemote(const MachineName: string): _IDispatchImplAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_IDispatchImplAttribute) as _IDispatchImplAttribute; +end; + +class function CoComSourceInterfacesAttribute.Create: _ComSourceInterfacesAttribute; +begin + Result := CreateComObject(CLASS_ComSourceInterfacesAttribute) as _ComSourceInterfacesAttribute; +end; + +class function CoComSourceInterfacesAttribute.CreateRemote(const MachineName: string): _ComSourceInterfacesAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ComSourceInterfacesAttribute) as _ComSourceInterfacesAttribute; +end; + +class function CoComConversionLossAttribute.Create: _ComConversionLossAttribute; +begin + Result := CreateComObject(CLASS_ComConversionLossAttribute) as _ComConversionLossAttribute; +end; + +class function CoComConversionLossAttribute.CreateRemote(const MachineName: string): _ComConversionLossAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ComConversionLossAttribute) as _ComConversionLossAttribute; +end; + +class function CoTypeLibTypeAttribute.Create: _TypeLibTypeAttribute; +begin + Result := CreateComObject(CLASS_TypeLibTypeAttribute) as _TypeLibTypeAttribute; +end; + +class function CoTypeLibTypeAttribute.CreateRemote(const MachineName: string): _TypeLibTypeAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TypeLibTypeAttribute) as _TypeLibTypeAttribute; +end; + +class function CoTypeLibFuncAttribute.Create: _TypeLibFuncAttribute; +begin + Result := CreateComObject(CLASS_TypeLibFuncAttribute) as _TypeLibFuncAttribute; +end; + +class function CoTypeLibFuncAttribute.CreateRemote(const MachineName: string): _TypeLibFuncAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TypeLibFuncAttribute) as _TypeLibFuncAttribute; +end; + +class function CoTypeLibVarAttribute.Create: _TypeLibVarAttribute; +begin + Result := CreateComObject(CLASS_TypeLibVarAttribute) as _TypeLibVarAttribute; +end; + +class function CoTypeLibVarAttribute.CreateRemote(const MachineName: string): _TypeLibVarAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TypeLibVarAttribute) as _TypeLibVarAttribute; +end; + +class function CoMarshalAsAttribute.Create: _MarshalAsAttribute; +begin + Result := CreateComObject(CLASS_MarshalAsAttribute) as _MarshalAsAttribute; +end; + +class function CoMarshalAsAttribute.CreateRemote(const MachineName: string): _MarshalAsAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MarshalAsAttribute) as _MarshalAsAttribute; +end; + +class function CoComImportAttribute.Create: _ComImportAttribute; +begin + Result := CreateComObject(CLASS_ComImportAttribute) as _ComImportAttribute; +end; + +class function CoComImportAttribute.CreateRemote(const MachineName: string): _ComImportAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ComImportAttribute) as _ComImportAttribute; +end; + +class function CoGuidAttribute.Create: _GuidAttribute; +begin + Result := CreateComObject(CLASS_GuidAttribute) as _GuidAttribute; +end; + +class function CoGuidAttribute.CreateRemote(const MachineName: string): _GuidAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_GuidAttribute) as _GuidAttribute; +end; + +class function CoPreserveSigAttribute.Create: _PreserveSigAttribute; +begin + Result := CreateComObject(CLASS_PreserveSigAttribute) as _PreserveSigAttribute; +end; + +class function CoPreserveSigAttribute.CreateRemote(const MachineName: string): _PreserveSigAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_PreserveSigAttribute) as _PreserveSigAttribute; +end; + +class function CoInAttribute.Create: _InAttribute; +begin + Result := CreateComObject(CLASS_InAttribute) as _InAttribute; +end; + +class function CoInAttribute.CreateRemote(const MachineName: string): _InAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_InAttribute) as _InAttribute; +end; + +class function CoOutAttribute.Create: _OutAttribute; +begin + Result := CreateComObject(CLASS_OutAttribute) as _OutAttribute; +end; + +class function CoOutAttribute.CreateRemote(const MachineName: string): _OutAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_OutAttribute) as _OutAttribute; +end; + +class function CoOptionalAttribute.Create: _OptionalAttribute; +begin + Result := CreateComObject(CLASS_OptionalAttribute) as _OptionalAttribute; +end; + +class function CoOptionalAttribute.CreateRemote(const MachineName: string): _OptionalAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_OptionalAttribute) as _OptionalAttribute; +end; + +class function CoDllImportAttribute.Create: _DllImportAttribute; +begin + Result := CreateComObject(CLASS_DllImportAttribute) as _DllImportAttribute; +end; + +class function CoDllImportAttribute.CreateRemote(const MachineName: string): _DllImportAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DllImportAttribute) as _DllImportAttribute; +end; + +class function CoStructLayoutAttribute.Create: _StructLayoutAttribute; +begin + Result := CreateComObject(CLASS_StructLayoutAttribute) as _StructLayoutAttribute; +end; + +class function CoStructLayoutAttribute.CreateRemote(const MachineName: string): _StructLayoutAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_StructLayoutAttribute) as _StructLayoutAttribute; +end; + +class function CoFieldOffsetAttribute.Create: _FieldOffsetAttribute; +begin + Result := CreateComObject(CLASS_FieldOffsetAttribute) as _FieldOffsetAttribute; +end; + +class function CoFieldOffsetAttribute.CreateRemote(const MachineName: string): _FieldOffsetAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FieldOffsetAttribute) as _FieldOffsetAttribute; +end; + +class function CoComAliasNameAttribute.Create: _ComAliasNameAttribute; +begin + Result := CreateComObject(CLASS_ComAliasNameAttribute) as _ComAliasNameAttribute; +end; + +class function CoComAliasNameAttribute.CreateRemote(const MachineName: string): _ComAliasNameAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ComAliasNameAttribute) as _ComAliasNameAttribute; +end; + +class function CoAutomationProxyAttribute.Create: _AutomationProxyAttribute; +begin + Result := CreateComObject(CLASS_AutomationProxyAttribute) as _AutomationProxyAttribute; +end; + +class function CoAutomationProxyAttribute.CreateRemote(const MachineName: string): _AutomationProxyAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AutomationProxyAttribute) as _AutomationProxyAttribute; +end; + +class function CoPrimaryInteropAssemblyAttribute.Create: _PrimaryInteropAssemblyAttribute; +begin + Result := CreateComObject(CLASS_PrimaryInteropAssemblyAttribute) as _PrimaryInteropAssemblyAttribute; +end; + +class function CoPrimaryInteropAssemblyAttribute.CreateRemote(const MachineName: string): _PrimaryInteropAssemblyAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_PrimaryInteropAssemblyAttribute) as _PrimaryInteropAssemblyAttribute; +end; + +class function CoCoClassAttribute.Create: _CoClassAttribute; +begin + Result := CreateComObject(CLASS_CoClassAttribute) as _CoClassAttribute; +end; + +class function CoCoClassAttribute.CreateRemote(const MachineName: string): _CoClassAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CoClassAttribute) as _CoClassAttribute; +end; + +class function CoComEventInterfaceAttribute.Create: _ComEventInterfaceAttribute; +begin + Result := CreateComObject(CLASS_ComEventInterfaceAttribute) as _ComEventInterfaceAttribute; +end; + +class function CoComEventInterfaceAttribute.CreateRemote(const MachineName: string): _ComEventInterfaceAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ComEventInterfaceAttribute) as _ComEventInterfaceAttribute; +end; + +class function CoTypeLibVersionAttribute.Create: _TypeLibVersionAttribute; +begin + Result := CreateComObject(CLASS_TypeLibVersionAttribute) as _TypeLibVersionAttribute; +end; + +class function CoTypeLibVersionAttribute.CreateRemote(const MachineName: string): _TypeLibVersionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TypeLibVersionAttribute) as _TypeLibVersionAttribute; +end; + +class function CoComCompatibleVersionAttribute.Create: _ComCompatibleVersionAttribute; +begin + Result := CreateComObject(CLASS_ComCompatibleVersionAttribute) as _ComCompatibleVersionAttribute; +end; + +class function CoComCompatibleVersionAttribute.CreateRemote(const MachineName: string): _ComCompatibleVersionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ComCompatibleVersionAttribute) as _ComCompatibleVersionAttribute; +end; + +class function CoBestFitMappingAttribute.Create: _BestFitMappingAttribute; +begin + Result := CreateComObject(CLASS_BestFitMappingAttribute) as _BestFitMappingAttribute; +end; + +class function CoBestFitMappingAttribute.CreateRemote(const MachineName: string): _BestFitMappingAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_BestFitMappingAttribute) as _BestFitMappingAttribute; +end; + +class function CoExternalException.Create: _ExternalException; +begin + Result := CreateComObject(CLASS_ExternalException) as _ExternalException; +end; + +class function CoExternalException.CreateRemote(const MachineName: string): _ExternalException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ExternalException) as _ExternalException; +end; + +class function CoCOMException.Create: _COMException; +begin + Result := CreateComObject(CLASS_COMException) as _COMException; +end; + +class function CoCOMException.CreateRemote(const MachineName: string): _COMException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_COMException) as _COMException; +end; + +class function CoCurrencyWrapper.Create: _CurrencyWrapper; +begin + Result := CreateComObject(CLASS_CurrencyWrapper) as _CurrencyWrapper; +end; + +class function CoCurrencyWrapper.CreateRemote(const MachineName: string): _CurrencyWrapper; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CurrencyWrapper) as _CurrencyWrapper; +end; + +class function CoDispatchWrapper.Create: _DispatchWrapper; +begin + Result := CreateComObject(CLASS_DispatchWrapper) as _DispatchWrapper; +end; + +class function CoDispatchWrapper.CreateRemote(const MachineName: string): _DispatchWrapper; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DispatchWrapper) as _DispatchWrapper; +end; + +class function CoErrorWrapper.Create: _ErrorWrapper; +begin + Result := CreateComObject(CLASS_ErrorWrapper) as _ErrorWrapper; +end; + +class function CoErrorWrapper.CreateRemote(const MachineName: string): _ErrorWrapper; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ErrorWrapper) as _ErrorWrapper; +end; + +class function CoExtensibleClassFactory.Create: _ExtensibleClassFactory; +begin + Result := CreateComObject(CLASS_ExtensibleClassFactory) as _ExtensibleClassFactory; +end; + +class function CoExtensibleClassFactory.CreateRemote(const MachineName: string): _ExtensibleClassFactory; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ExtensibleClassFactory) as _ExtensibleClassFactory; +end; + +class function CoInvalidComObjectException.Create: _InvalidComObjectException; +begin + Result := CreateComObject(CLASS_InvalidComObjectException) as _InvalidComObjectException; +end; + +class function CoInvalidComObjectException.CreateRemote(const MachineName: string): _InvalidComObjectException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_InvalidComObjectException) as _InvalidComObjectException; +end; + +class function CoInvalidOleVariantTypeException.Create: _InvalidOleVariantTypeException; +begin + Result := CreateComObject(CLASS_InvalidOleVariantTypeException) as _InvalidOleVariantTypeException; +end; + +class function CoInvalidOleVariantTypeException.CreateRemote(const MachineName: string): _InvalidOleVariantTypeException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_InvalidOleVariantTypeException) as _InvalidOleVariantTypeException; +end; + +class function CoMarshal.Create: _Marshal; +begin + Result := CreateComObject(CLASS_Marshal) as _Marshal; +end; + +class function CoMarshal.CreateRemote(const MachineName: string): _Marshal; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Marshal) as _Marshal; +end; + +class function CoMarshalDirectiveException.Create: _MarshalDirectiveException; +begin + Result := CreateComObject(CLASS_MarshalDirectiveException) as _MarshalDirectiveException; +end; + +class function CoMarshalDirectiveException.CreateRemote(const MachineName: string): _MarshalDirectiveException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MarshalDirectiveException) as _MarshalDirectiveException; +end; + +class function CoObjectCreationDelegate.Create: _ObjectCreationDelegate; +begin + Result := CreateComObject(CLASS_ObjectCreationDelegate) as _ObjectCreationDelegate; +end; + +class function CoObjectCreationDelegate.CreateRemote(const MachineName: string): _ObjectCreationDelegate; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ObjectCreationDelegate) as _ObjectCreationDelegate; +end; + +class function CoRuntimeEnvironment.Create: _RuntimeEnvironment; +begin + Result := CreateComObject(CLASS_RuntimeEnvironment) as _RuntimeEnvironment; +end; + +class function CoRuntimeEnvironment.CreateRemote(const MachineName: string): _RuntimeEnvironment; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RuntimeEnvironment) as _RuntimeEnvironment; +end; + +class function CoSafeArrayRankMismatchException.Create: _SafeArrayRankMismatchException; +begin + Result := CreateComObject(CLASS_SafeArrayRankMismatchException) as _SafeArrayRankMismatchException; +end; + +class function CoSafeArrayRankMismatchException.CreateRemote(const MachineName: string): _SafeArrayRankMismatchException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SafeArrayRankMismatchException) as _SafeArrayRankMismatchException; +end; + +class function CoSafeArrayTypeMismatchException.Create: _SafeArrayTypeMismatchException; +begin + Result := CreateComObject(CLASS_SafeArrayTypeMismatchException) as _SafeArrayTypeMismatchException; +end; + +class function CoSafeArrayTypeMismatchException.CreateRemote(const MachineName: string): _SafeArrayTypeMismatchException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SafeArrayTypeMismatchException) as _SafeArrayTypeMismatchException; +end; + +class function CoSEHException.Create: _SEHException; +begin + Result := CreateComObject(CLASS_SEHException) as _SEHException; +end; + +class function CoSEHException.CreateRemote(const MachineName: string): _SEHException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SEHException) as _SEHException; +end; + +class function CoUnknownWrapper.Create: _UnknownWrapper; +begin + Result := CreateComObject(CLASS_UnknownWrapper) as _UnknownWrapper; +end; + +class function CoUnknownWrapper.CreateRemote(const MachineName: string): _UnknownWrapper; +begin + Result := CreateRemoteComObject(MachineName, CLASS_UnknownWrapper) as _UnknownWrapper; +end; + +class function CoBinaryReader.Create: _BinaryReader; +begin + Result := CreateComObject(CLASS_BinaryReader) as _BinaryReader; +end; + +class function CoBinaryReader.CreateRemote(const MachineName: string): _BinaryReader; +begin + Result := CreateRemoteComObject(MachineName, CLASS_BinaryReader) as _BinaryReader; +end; + +class function CoBinaryWriter.Create: _BinaryWriter; +begin + Result := CreateComObject(CLASS_BinaryWriter) as _BinaryWriter; +end; + +class function CoBinaryWriter.CreateRemote(const MachineName: string): _BinaryWriter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_BinaryWriter) as _BinaryWriter; +end; + +class function CoBufferedStream.Create: _BufferedStream; +begin + Result := CreateComObject(CLASS_BufferedStream) as _BufferedStream; +end; + +class function CoBufferedStream.CreateRemote(const MachineName: string): _BufferedStream; +begin + Result := CreateRemoteComObject(MachineName, CLASS_BufferedStream) as _BufferedStream; +end; + +class function CoDirectory.Create: _Directory; +begin + Result := CreateComObject(CLASS_Directory) as _Directory; +end; + +class function CoDirectory.CreateRemote(const MachineName: string): _Directory; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Directory) as _Directory; +end; + +class function CoFileSystemInfo.Create: _FileSystemInfo; +begin + Result := CreateComObject(CLASS_FileSystemInfo) as _FileSystemInfo; +end; + +class function CoFileSystemInfo.CreateRemote(const MachineName: string): _FileSystemInfo; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FileSystemInfo) as _FileSystemInfo; +end; + +class function CoDirectoryInfo.Create: _DirectoryInfo; +begin + Result := CreateComObject(CLASS_DirectoryInfo) as _DirectoryInfo; +end; + +class function CoDirectoryInfo.CreateRemote(const MachineName: string): _DirectoryInfo; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DirectoryInfo) as _DirectoryInfo; +end; + +class function CoIOException.Create: _IOException; +begin + Result := CreateComObject(CLASS_IOException) as _IOException; +end; + +class function CoIOException.CreateRemote(const MachineName: string): _IOException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_IOException) as _IOException; +end; + +class function CoDirectoryNotFoundException.Create: _DirectoryNotFoundException; +begin + Result := CreateComObject(CLASS_DirectoryNotFoundException) as _DirectoryNotFoundException; +end; + +class function CoDirectoryNotFoundException.CreateRemote(const MachineName: string): _DirectoryNotFoundException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DirectoryNotFoundException) as _DirectoryNotFoundException; +end; + +class function CoEndOfStreamException.Create: _EndOfStreamException; +begin + Result := CreateComObject(CLASS_EndOfStreamException) as _EndOfStreamException; +end; + +class function CoEndOfStreamException.CreateRemote(const MachineName: string): _EndOfStreamException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_EndOfStreamException) as _EndOfStreamException; +end; + +class function CoFile_.Create: _File; +begin + Result := CreateComObject(CLASS_File_) as _File; +end; + +class function CoFile_.CreateRemote(const MachineName: string): _File; +begin + Result := CreateRemoteComObject(MachineName, CLASS_File_) as _File; +end; + +class function CoFileInfo.Create: _FileInfo; +begin + Result := CreateComObject(CLASS_FileInfo) as _FileInfo; +end; + +class function CoFileInfo.CreateRemote(const MachineName: string): _FileInfo; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FileInfo) as _FileInfo; +end; + +class function CoFileLoadException.Create: _FileLoadException; +begin + Result := CreateComObject(CLASS_FileLoadException) as _FileLoadException; +end; + +class function CoFileLoadException.CreateRemote(const MachineName: string): _FileLoadException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FileLoadException) as _FileLoadException; +end; + +class function CoFileNotFoundException.Create: _FileNotFoundException; +begin + Result := CreateComObject(CLASS_FileNotFoundException) as _FileNotFoundException; +end; + +class function CoFileNotFoundException.CreateRemote(const MachineName: string): _FileNotFoundException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FileNotFoundException) as _FileNotFoundException; +end; + +class function CoFileStream.Create: _FileStream; +begin + Result := CreateComObject(CLASS_FileStream) as _FileStream; +end; + +class function CoFileStream.CreateRemote(const MachineName: string): _FileStream; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FileStream) as _FileStream; +end; + +class function CoMemoryStream.Create: _MemoryStream; +begin + Result := CreateComObject(CLASS_MemoryStream) as _MemoryStream; +end; + +class function CoMemoryStream.CreateRemote(const MachineName: string): _MemoryStream; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MemoryStream) as _MemoryStream; +end; + +class function CoPath.Create: _Path; +begin + Result := CreateComObject(CLASS_Path) as _Path; +end; + +class function CoPath.CreateRemote(const MachineName: string): _Path; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Path) as _Path; +end; + +class function CoPathTooLongException.Create: _PathTooLongException; +begin + Result := CreateComObject(CLASS_PathTooLongException) as _PathTooLongException; +end; + +class function CoPathTooLongException.CreateRemote(const MachineName: string): _PathTooLongException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_PathTooLongException) as _PathTooLongException; +end; + +class function CoTextReader.Create: _TextReader; +begin + Result := CreateComObject(CLASS_TextReader) as _TextReader; +end; + +class function CoTextReader.CreateRemote(const MachineName: string): _TextReader; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TextReader) as _TextReader; +end; + +class function CoStreamReader.Create: _StreamReader; +begin + Result := CreateComObject(CLASS_StreamReader) as _StreamReader; +end; + +class function CoStreamReader.CreateRemote(const MachineName: string): _StreamReader; +begin + Result := CreateRemoteComObject(MachineName, CLASS_StreamReader) as _StreamReader; +end; + +class function CoTextWriter.Create: _TextWriter; +begin + Result := CreateComObject(CLASS_TextWriter) as _TextWriter; +end; + +class function CoTextWriter.CreateRemote(const MachineName: string): _TextWriter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TextWriter) as _TextWriter; +end; + +class function CoStreamWriter.Create: _StreamWriter; +begin + Result := CreateComObject(CLASS_StreamWriter) as _StreamWriter; +end; + +class function CoStreamWriter.CreateRemote(const MachineName: string): _StreamWriter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_StreamWriter) as _StreamWriter; +end; + +class function CoStringReader.Create: _StringReader; +begin + Result := CreateComObject(CLASS_StringReader) as _StringReader; +end; + +class function CoStringReader.CreateRemote(const MachineName: string): _StringReader; +begin + Result := CreateRemoteComObject(MachineName, CLASS_StringReader) as _StringReader; +end; + +class function CoStringWriter.Create: _StringWriter; +begin + Result := CreateComObject(CLASS_StringWriter) as _StringWriter; +end; + +class function CoStringWriter.CreateRemote(const MachineName: string): _StringWriter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_StringWriter) as _StringWriter; +end; + +class function CoAccessedThroughPropertyAttribute.Create: _AccessedThroughPropertyAttribute; +begin + Result := CreateComObject(CLASS_AccessedThroughPropertyAttribute) as _AccessedThroughPropertyAttribute; +end; + +class function CoAccessedThroughPropertyAttribute.CreateRemote(const MachineName: string): _AccessedThroughPropertyAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AccessedThroughPropertyAttribute) as _AccessedThroughPropertyAttribute; +end; + +class function CoCallConvCdecl.Create: _CallConvCdecl; +begin + Result := CreateComObject(CLASS_CallConvCdecl) as _CallConvCdecl; +end; + +class function CoCallConvCdecl.CreateRemote(const MachineName: string): _CallConvCdecl; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CallConvCdecl) as _CallConvCdecl; +end; + +class function CoCallConvStdcall.Create: _CallConvStdcall; +begin + Result := CreateComObject(CLASS_CallConvStdcall) as _CallConvStdcall; +end; + +class function CoCallConvStdcall.CreateRemote(const MachineName: string): _CallConvStdcall; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CallConvStdcall) as _CallConvStdcall; +end; + +class function CoCallConvThiscall.Create: _CallConvThiscall; +begin + Result := CreateComObject(CLASS_CallConvThiscall) as _CallConvThiscall; +end; + +class function CoCallConvThiscall.CreateRemote(const MachineName: string): _CallConvThiscall; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CallConvThiscall) as _CallConvThiscall; +end; + +class function CoCallConvFastcall.Create: _CallConvFastcall; +begin + Result := CreateComObject(CLASS_CallConvFastcall) as _CallConvFastcall; +end; + +class function CoCallConvFastcall.CreateRemote(const MachineName: string): _CallConvFastcall; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CallConvFastcall) as _CallConvFastcall; +end; + +class function CoRuntimeHelpers.Create: _RuntimeHelpers; +begin + Result := CreateComObject(CLASS_RuntimeHelpers) as _RuntimeHelpers; +end; + +class function CoRuntimeHelpers.CreateRemote(const MachineName: string): _RuntimeHelpers; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RuntimeHelpers) as _RuntimeHelpers; +end; + +class function CoCustomConstantAttribute.Create: _CustomConstantAttribute; +begin + Result := CreateComObject(CLASS_CustomConstantAttribute) as _CustomConstantAttribute; +end; + +class function CoCustomConstantAttribute.CreateRemote(const MachineName: string): _CustomConstantAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CustomConstantAttribute) as _CustomConstantAttribute; +end; + +class function CoDateTimeConstantAttribute.Create: _DateTimeConstantAttribute; +begin + Result := CreateComObject(CLASS_DateTimeConstantAttribute) as _DateTimeConstantAttribute; +end; + +class function CoDateTimeConstantAttribute.CreateRemote(const MachineName: string): _DateTimeConstantAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DateTimeConstantAttribute) as _DateTimeConstantAttribute; +end; + +class function CoDiscardableAttribute.Create: _DiscardableAttribute; +begin + Result := CreateComObject(CLASS_DiscardableAttribute) as _DiscardableAttribute; +end; + +class function CoDiscardableAttribute.CreateRemote(const MachineName: string): _DiscardableAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DiscardableAttribute) as _DiscardableAttribute; +end; + +class function CoDecimalConstantAttribute.Create: _DecimalConstantAttribute; +begin + Result := CreateComObject(CLASS_DecimalConstantAttribute) as _DecimalConstantAttribute; +end; + +class function CoDecimalConstantAttribute.CreateRemote(const MachineName: string): _DecimalConstantAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DecimalConstantAttribute) as _DecimalConstantAttribute; +end; + +class function CoCompilationRelaxationsAttribute.Create: _CompilationRelaxationsAttribute; +begin + Result := CreateComObject(CLASS_CompilationRelaxationsAttribute) as _CompilationRelaxationsAttribute; +end; + +class function CoCompilationRelaxationsAttribute.CreateRemote(const MachineName: string): _CompilationRelaxationsAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CompilationRelaxationsAttribute) as _CompilationRelaxationsAttribute; +end; + +class function CoCompilerGlobalScopeAttribute.Create: _CompilerGlobalScopeAttribute; +begin + Result := CreateComObject(CLASS_CompilerGlobalScopeAttribute) as _CompilerGlobalScopeAttribute; +end; + +class function CoCompilerGlobalScopeAttribute.CreateRemote(const MachineName: string): _CompilerGlobalScopeAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CompilerGlobalScopeAttribute) as _CompilerGlobalScopeAttribute; +end; + +class function CoIDispatchConstantAttribute.Create: _IDispatchConstantAttribute; +begin + Result := CreateComObject(CLASS_IDispatchConstantAttribute) as _IDispatchConstantAttribute; +end; + +class function CoIDispatchConstantAttribute.CreateRemote(const MachineName: string): _IDispatchConstantAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_IDispatchConstantAttribute) as _IDispatchConstantAttribute; +end; + +class function CoIndexerNameAttribute.Create: _IndexerNameAttribute; +begin + Result := CreateComObject(CLASS_IndexerNameAttribute) as _IndexerNameAttribute; +end; + +class function CoIndexerNameAttribute.CreateRemote(const MachineName: string): _IndexerNameAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_IndexerNameAttribute) as _IndexerNameAttribute; +end; + +class function CoIsVolatile.Create: _IsVolatile; +begin + Result := CreateComObject(CLASS_IsVolatile) as _IsVolatile; +end; + +class function CoIsVolatile.CreateRemote(const MachineName: string): _IsVolatile; +begin + Result := CreateRemoteComObject(MachineName, CLASS_IsVolatile) as _IsVolatile; +end; + +class function CoIUnknownConstantAttribute.Create: _IUnknownConstantAttribute; +begin + Result := CreateComObject(CLASS_IUnknownConstantAttribute) as _IUnknownConstantAttribute; +end; + +class function CoIUnknownConstantAttribute.CreateRemote(const MachineName: string): _IUnknownConstantAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_IUnknownConstantAttribute) as _IUnknownConstantAttribute; +end; + +class function CoMethodImplAttribute.Create: _MethodImplAttribute; +begin + Result := CreateComObject(CLASS_MethodImplAttribute) as _MethodImplAttribute; +end; + +class function CoMethodImplAttribute.CreateRemote(const MachineName: string): _MethodImplAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MethodImplAttribute) as _MethodImplAttribute; +end; + +class function CoRequiredAttributeAttribute.Create: _RequiredAttributeAttribute; +begin + Result := CreateComObject(CLASS_RequiredAttributeAttribute) as _RequiredAttributeAttribute; +end; + +class function CoRequiredAttributeAttribute.CreateRemote(const MachineName: string): _RequiredAttributeAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RequiredAttributeAttribute) as _RequiredAttributeAttribute; +end; + +class function CoPermissionSet.Create: _PermissionSet; +begin + Result := CreateComObject(CLASS_PermissionSet) as _PermissionSet; +end; + +class function CoPermissionSet.CreateRemote(const MachineName: string): _PermissionSet; +begin + Result := CreateRemoteComObject(MachineName, CLASS_PermissionSet) as _PermissionSet; +end; + +class function CoNamedPermissionSet.Create: _NamedPermissionSet; +begin + Result := CreateComObject(CLASS_NamedPermissionSet) as _NamedPermissionSet; +end; + +class function CoNamedPermissionSet.CreateRemote(const MachineName: string): _NamedPermissionSet; +begin + Result := CreateRemoteComObject(MachineName, CLASS_NamedPermissionSet) as _NamedPermissionSet; +end; + +class function CoSecurityElement.Create: _SecurityElement; +begin + Result := CreateComObject(CLASS_SecurityElement) as _SecurityElement; +end; + +class function CoSecurityElement.CreateRemote(const MachineName: string): _SecurityElement; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SecurityElement) as _SecurityElement; +end; + +class function CoXmlSyntaxException.Create: _XmlSyntaxException; +begin + Result := CreateComObject(CLASS_XmlSyntaxException) as _XmlSyntaxException; +end; + +class function CoXmlSyntaxException.CreateRemote(const MachineName: string): _XmlSyntaxException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_XmlSyntaxException) as _XmlSyntaxException; +end; + +class function CoCodeAccessPermission.Create: _CodeAccessPermission; +begin + Result := CreateComObject(CLASS_CodeAccessPermission) as _CodeAccessPermission; +end; + +class function CoCodeAccessPermission.CreateRemote(const MachineName: string): _CodeAccessPermission; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CodeAccessPermission) as _CodeAccessPermission; +end; + +class function CoEnvironmentPermission.Create: _EnvironmentPermission; +begin + Result := CreateComObject(CLASS_EnvironmentPermission) as _EnvironmentPermission; +end; + +class function CoEnvironmentPermission.CreateRemote(const MachineName: string): _EnvironmentPermission; +begin + Result := CreateRemoteComObject(MachineName, CLASS_EnvironmentPermission) as _EnvironmentPermission; +end; + +class function CoFileDialogPermission.Create: _FileDialogPermission; +begin + Result := CreateComObject(CLASS_FileDialogPermission) as _FileDialogPermission; +end; + +class function CoFileDialogPermission.CreateRemote(const MachineName: string): _FileDialogPermission; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FileDialogPermission) as _FileDialogPermission; +end; + +class function CoFileIOPermission.Create: _FileIOPermission; +begin + Result := CreateComObject(CLASS_FileIOPermission) as _FileIOPermission; +end; + +class function CoFileIOPermission.CreateRemote(const MachineName: string): _FileIOPermission; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FileIOPermission) as _FileIOPermission; +end; + +class function CoIsolatedStoragePermission.Create: _IsolatedStoragePermission; +begin + Result := CreateComObject(CLASS_IsolatedStoragePermission) as _IsolatedStoragePermission; +end; + +class function CoIsolatedStoragePermission.CreateRemote(const MachineName: string): _IsolatedStoragePermission; +begin + Result := CreateRemoteComObject(MachineName, CLASS_IsolatedStoragePermission) as _IsolatedStoragePermission; +end; + +class function CoIsolatedStorageFilePermission.Create: _IsolatedStorageFilePermission; +begin + Result := CreateComObject(CLASS_IsolatedStorageFilePermission) as _IsolatedStorageFilePermission; +end; + +class function CoIsolatedStorageFilePermission.CreateRemote(const MachineName: string): _IsolatedStorageFilePermission; +begin + Result := CreateRemoteComObject(MachineName, CLASS_IsolatedStorageFilePermission) as _IsolatedStorageFilePermission; +end; + +class function CoSecurityAttribute.Create: _SecurityAttribute; +begin + Result := CreateComObject(CLASS_SecurityAttribute) as _SecurityAttribute; +end; + +class function CoSecurityAttribute.CreateRemote(const MachineName: string): _SecurityAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SecurityAttribute) as _SecurityAttribute; +end; + +class function CoCodeAccessSecurityAttribute.Create: _CodeAccessSecurityAttribute; +begin + Result := CreateComObject(CLASS_CodeAccessSecurityAttribute) as _CodeAccessSecurityAttribute; +end; + +class function CoCodeAccessSecurityAttribute.CreateRemote(const MachineName: string): _CodeAccessSecurityAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CodeAccessSecurityAttribute) as _CodeAccessSecurityAttribute; +end; + +class function CoEnvironmentPermissionAttribute.Create: _EnvironmentPermissionAttribute; +begin + Result := CreateComObject(CLASS_EnvironmentPermissionAttribute) as _EnvironmentPermissionAttribute; +end; + +class function CoEnvironmentPermissionAttribute.CreateRemote(const MachineName: string): _EnvironmentPermissionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_EnvironmentPermissionAttribute) as _EnvironmentPermissionAttribute; +end; + +class function CoFileDialogPermissionAttribute.Create: _FileDialogPermissionAttribute; +begin + Result := CreateComObject(CLASS_FileDialogPermissionAttribute) as _FileDialogPermissionAttribute; +end; + +class function CoFileDialogPermissionAttribute.CreateRemote(const MachineName: string): _FileDialogPermissionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FileDialogPermissionAttribute) as _FileDialogPermissionAttribute; +end; + +class function CoFileIOPermissionAttribute.Create: _FileIOPermissionAttribute; +begin + Result := CreateComObject(CLASS_FileIOPermissionAttribute) as _FileIOPermissionAttribute; +end; + +class function CoFileIOPermissionAttribute.CreateRemote(const MachineName: string): _FileIOPermissionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FileIOPermissionAttribute) as _FileIOPermissionAttribute; +end; + +class function CoPrincipalPermissionAttribute.Create: _PrincipalPermissionAttribute; +begin + Result := CreateComObject(CLASS_PrincipalPermissionAttribute) as _PrincipalPermissionAttribute; +end; + +class function CoPrincipalPermissionAttribute.CreateRemote(const MachineName: string): _PrincipalPermissionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_PrincipalPermissionAttribute) as _PrincipalPermissionAttribute; +end; + +class function CoReflectionPermissionAttribute.Create: _ReflectionPermissionAttribute; +begin + Result := CreateComObject(CLASS_ReflectionPermissionAttribute) as _ReflectionPermissionAttribute; +end; + +class function CoReflectionPermissionAttribute.CreateRemote(const MachineName: string): _ReflectionPermissionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ReflectionPermissionAttribute) as _ReflectionPermissionAttribute; +end; + +class function CoRegistryPermissionAttribute.Create: _RegistryPermissionAttribute; +begin + Result := CreateComObject(CLASS_RegistryPermissionAttribute) as _RegistryPermissionAttribute; +end; + +class function CoRegistryPermissionAttribute.CreateRemote(const MachineName: string): _RegistryPermissionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RegistryPermissionAttribute) as _RegistryPermissionAttribute; +end; + +class function CoSecurityPermissionAttribute.Create: _SecurityPermissionAttribute; +begin + Result := CreateComObject(CLASS_SecurityPermissionAttribute) as _SecurityPermissionAttribute; +end; + +class function CoSecurityPermissionAttribute.CreateRemote(const MachineName: string): _SecurityPermissionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SecurityPermissionAttribute) as _SecurityPermissionAttribute; +end; + +class function CoUIPermissionAttribute.Create: _UIPermissionAttribute; +begin + Result := CreateComObject(CLASS_UIPermissionAttribute) as _UIPermissionAttribute; +end; + +class function CoUIPermissionAttribute.CreateRemote(const MachineName: string): _UIPermissionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_UIPermissionAttribute) as _UIPermissionAttribute; +end; + +class function CoZoneIdentityPermissionAttribute.Create: _ZoneIdentityPermissionAttribute; +begin + Result := CreateComObject(CLASS_ZoneIdentityPermissionAttribute) as _ZoneIdentityPermissionAttribute; +end; + +class function CoZoneIdentityPermissionAttribute.CreateRemote(const MachineName: string): _ZoneIdentityPermissionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ZoneIdentityPermissionAttribute) as _ZoneIdentityPermissionAttribute; +end; + +class function CoStrongNameIdentityPermissionAttribute.Create: _StrongNameIdentityPermissionAttribute; +begin + Result := CreateComObject(CLASS_StrongNameIdentityPermissionAttribute) as _StrongNameIdentityPermissionAttribute; +end; + +class function CoStrongNameIdentityPermissionAttribute.CreateRemote(const MachineName: string): _StrongNameIdentityPermissionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_StrongNameIdentityPermissionAttribute) as _StrongNameIdentityPermissionAttribute; +end; + +class function CoSiteIdentityPermissionAttribute.Create: _SiteIdentityPermissionAttribute; +begin + Result := CreateComObject(CLASS_SiteIdentityPermissionAttribute) as _SiteIdentityPermissionAttribute; +end; + +class function CoSiteIdentityPermissionAttribute.CreateRemote(const MachineName: string): _SiteIdentityPermissionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SiteIdentityPermissionAttribute) as _SiteIdentityPermissionAttribute; +end; + +class function CoUrlIdentityPermissionAttribute.Create: _UrlIdentityPermissionAttribute; +begin + Result := CreateComObject(CLASS_UrlIdentityPermissionAttribute) as _UrlIdentityPermissionAttribute; +end; + +class function CoUrlIdentityPermissionAttribute.CreateRemote(const MachineName: string): _UrlIdentityPermissionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_UrlIdentityPermissionAttribute) as _UrlIdentityPermissionAttribute; +end; + +class function CoPublisherIdentityPermissionAttribute.Create: _PublisherIdentityPermissionAttribute; +begin + Result := CreateComObject(CLASS_PublisherIdentityPermissionAttribute) as _PublisherIdentityPermissionAttribute; +end; + +class function CoPublisherIdentityPermissionAttribute.CreateRemote(const MachineName: string): _PublisherIdentityPermissionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_PublisherIdentityPermissionAttribute) as _PublisherIdentityPermissionAttribute; +end; + +class function CoIsolatedStoragePermissionAttribute.Create: _IsolatedStoragePermissionAttribute; +begin + Result := CreateComObject(CLASS_IsolatedStoragePermissionAttribute) as _IsolatedStoragePermissionAttribute; +end; + +class function CoIsolatedStoragePermissionAttribute.CreateRemote(const MachineName: string): _IsolatedStoragePermissionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_IsolatedStoragePermissionAttribute) as _IsolatedStoragePermissionAttribute; +end; + +class function CoIsolatedStorageFilePermissionAttribute.Create: _IsolatedStorageFilePermissionAttribute; +begin + Result := CreateComObject(CLASS_IsolatedStorageFilePermissionAttribute) as _IsolatedStorageFilePermissionAttribute; +end; + +class function CoIsolatedStorageFilePermissionAttribute.CreateRemote(const MachineName: string): _IsolatedStorageFilePermissionAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_IsolatedStorageFilePermissionAttribute) as _IsolatedStorageFilePermissionAttribute; +end; + +class function CoPermissionSetAttribute.Create: _PermissionSetAttribute; +begin + Result := CreateComObject(CLASS_PermissionSetAttribute) as _PermissionSetAttribute; +end; + +class function CoPermissionSetAttribute.CreateRemote(const MachineName: string): _PermissionSetAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_PermissionSetAttribute) as _PermissionSetAttribute; +end; + +class function CoPublisherIdentityPermission.Create: _PublisherIdentityPermission; +begin + Result := CreateComObject(CLASS_PublisherIdentityPermission) as _PublisherIdentityPermission; +end; + +class function CoPublisherIdentityPermission.CreateRemote(const MachineName: string): _PublisherIdentityPermission; +begin + Result := CreateRemoteComObject(MachineName, CLASS_PublisherIdentityPermission) as _PublisherIdentityPermission; +end; + +class function CoReflectionPermission.Create: _ReflectionPermission; +begin + Result := CreateComObject(CLASS_ReflectionPermission) as _ReflectionPermission; +end; + +class function CoReflectionPermission.CreateRemote(const MachineName: string): _ReflectionPermission; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ReflectionPermission) as _ReflectionPermission; +end; + +class function CoRegistryPermission.Create: _RegistryPermission; +begin + Result := CreateComObject(CLASS_RegistryPermission) as _RegistryPermission; +end; + +class function CoRegistryPermission.CreateRemote(const MachineName: string): _RegistryPermission; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RegistryPermission) as _RegistryPermission; +end; + +class function CoPrincipalPermission.Create: _PrincipalPermission; +begin + Result := CreateComObject(CLASS_PrincipalPermission) as _PrincipalPermission; +end; + +class function CoPrincipalPermission.CreateRemote(const MachineName: string): _PrincipalPermission; +begin + Result := CreateRemoteComObject(MachineName, CLASS_PrincipalPermission) as _PrincipalPermission; +end; + +class function CoSecurityPermission.Create: _SecurityPermission; +begin + Result := CreateComObject(CLASS_SecurityPermission) as _SecurityPermission; +end; + +class function CoSecurityPermission.CreateRemote(const MachineName: string): _SecurityPermission; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SecurityPermission) as _SecurityPermission; +end; + +class function CoSiteIdentityPermission.Create: _SiteIdentityPermission; +begin + Result := CreateComObject(CLASS_SiteIdentityPermission) as _SiteIdentityPermission; +end; + +class function CoSiteIdentityPermission.CreateRemote(const MachineName: string): _SiteIdentityPermission; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SiteIdentityPermission) as _SiteIdentityPermission; +end; + +class function CoStrongNameIdentityPermission.Create: _StrongNameIdentityPermission; +begin + Result := CreateComObject(CLASS_StrongNameIdentityPermission) as _StrongNameIdentityPermission; +end; + +class function CoStrongNameIdentityPermission.CreateRemote(const MachineName: string): _StrongNameIdentityPermission; +begin + Result := CreateRemoteComObject(MachineName, CLASS_StrongNameIdentityPermission) as _StrongNameIdentityPermission; +end; + +class function CoStrongNamePublicKeyBlob.Create: _StrongNamePublicKeyBlob; +begin + Result := CreateComObject(CLASS_StrongNamePublicKeyBlob) as _StrongNamePublicKeyBlob; +end; + +class function CoStrongNamePublicKeyBlob.CreateRemote(const MachineName: string): _StrongNamePublicKeyBlob; +begin + Result := CreateRemoteComObject(MachineName, CLASS_StrongNamePublicKeyBlob) as _StrongNamePublicKeyBlob; +end; + +class function CoUIPermission.Create: _UIPermission; +begin + Result := CreateComObject(CLASS_UIPermission) as _UIPermission; +end; + +class function CoUIPermission.CreateRemote(const MachineName: string): _UIPermission; +begin + Result := CreateRemoteComObject(MachineName, CLASS_UIPermission) as _UIPermission; +end; + +class function CoUrlIdentityPermission.Create: _UrlIdentityPermission; +begin + Result := CreateComObject(CLASS_UrlIdentityPermission) as _UrlIdentityPermission; +end; + +class function CoUrlIdentityPermission.CreateRemote(const MachineName: string): _UrlIdentityPermission; +begin + Result := CreateRemoteComObject(MachineName, CLASS_UrlIdentityPermission) as _UrlIdentityPermission; +end; + +class function CoZoneIdentityPermission.Create: _ZoneIdentityPermission; +begin + Result := CreateComObject(CLASS_ZoneIdentityPermission) as _ZoneIdentityPermission; +end; + +class function CoZoneIdentityPermission.CreateRemote(const MachineName: string): _ZoneIdentityPermission; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ZoneIdentityPermission) as _ZoneIdentityPermission; +end; + +class function CoSuppressUnmanagedCodeSecurityAttribute.Create: _SuppressUnmanagedCodeSecurityAttribute; +begin + Result := CreateComObject(CLASS_SuppressUnmanagedCodeSecurityAttribute) as _SuppressUnmanagedCodeSecurityAttribute; +end; + +class function CoSuppressUnmanagedCodeSecurityAttribute.CreateRemote(const MachineName: string): _SuppressUnmanagedCodeSecurityAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SuppressUnmanagedCodeSecurityAttribute) as _SuppressUnmanagedCodeSecurityAttribute; +end; + +class function CoUnverifiableCodeAttribute.Create: _UnverifiableCodeAttribute; +begin + Result := CreateComObject(CLASS_UnverifiableCodeAttribute) as _UnverifiableCodeAttribute; +end; + +class function CoUnverifiableCodeAttribute.CreateRemote(const MachineName: string): _UnverifiableCodeAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_UnverifiableCodeAttribute) as _UnverifiableCodeAttribute; +end; + +class function CoAllowPartiallyTrustedCallersAttribute.Create: _AllowPartiallyTrustedCallersAttribute; +begin + Result := CreateComObject(CLASS_AllowPartiallyTrustedCallersAttribute) as _AllowPartiallyTrustedCallersAttribute; +end; + +class function CoAllowPartiallyTrustedCallersAttribute.CreateRemote(const MachineName: string): _AllowPartiallyTrustedCallersAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AllowPartiallyTrustedCallersAttribute) as _AllowPartiallyTrustedCallersAttribute; +end; + +class function CoSecurityException.Create: _SecurityException; +begin + Result := CreateComObject(CLASS_SecurityException) as _SecurityException; +end; + +class function CoSecurityException.CreateRemote(const MachineName: string): _SecurityException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SecurityException) as _SecurityException; +end; + +class function CoSecurityManager.Create: _SecurityManager; +begin + Result := CreateComObject(CLASS_SecurityManager) as _SecurityManager; +end; + +class function CoSecurityManager.CreateRemote(const MachineName: string): _SecurityManager; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SecurityManager) as _SecurityManager; +end; + +class function CoVerificationException.Create: _VerificationException; +begin + Result := CreateComObject(CLASS_VerificationException) as _VerificationException; +end; + +class function CoVerificationException.CreateRemote(const MachineName: string): _VerificationException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_VerificationException) as _VerificationException; +end; + +class function CoContextAttribute.Create: _ContextAttribute; +begin + Result := CreateComObject(CLASS_ContextAttribute) as _ContextAttribute; +end; + +class function CoContextAttribute.CreateRemote(const MachineName: string): _ContextAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ContextAttribute) as _ContextAttribute; +end; + +class function CoAsyncResult.Create: _AsyncResult; +begin + Result := CreateComObject(CLASS_AsyncResult) as _AsyncResult; +end; + +class function CoAsyncResult.CreateRemote(const MachineName: string): _AsyncResult; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AsyncResult) as _AsyncResult; +end; + +class function CoCallContext.Create: _CallContext; +begin + Result := CreateComObject(CLASS_CallContext) as _CallContext; +end; + +class function CoCallContext.CreateRemote(const MachineName: string): _CallContext; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CallContext) as _CallContext; +end; + +class function CoLogicalCallContext.Create: _LogicalCallContext; +begin + Result := CreateComObject(CLASS_LogicalCallContext) as _LogicalCallContext; +end; + +class function CoLogicalCallContext.CreateRemote(const MachineName: string): _LogicalCallContext; +begin + Result := CreateRemoteComObject(MachineName, CLASS_LogicalCallContext) as _LogicalCallContext; +end; + +class function CoChannelServices.Create: _ChannelServices; +begin + Result := CreateComObject(CLASS_ChannelServices) as _ChannelServices; +end; + +class function CoChannelServices.CreateRemote(const MachineName: string): _ChannelServices; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ChannelServices) as _ChannelServices; +end; + +class function CoClientChannelSinkStack.Create: _ClientChannelSinkStack; +begin + Result := CreateComObject(CLASS_ClientChannelSinkStack) as _ClientChannelSinkStack; +end; + +class function CoClientChannelSinkStack.CreateRemote(const MachineName: string): _ClientChannelSinkStack; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ClientChannelSinkStack) as _ClientChannelSinkStack; +end; + +class function CoServerChannelSinkStack.Create: _ServerChannelSinkStack; +begin + Result := CreateComObject(CLASS_ServerChannelSinkStack) as _ServerChannelSinkStack; +end; + +class function CoServerChannelSinkStack.CreateRemote(const MachineName: string): _ServerChannelSinkStack; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ServerChannelSinkStack) as _ServerChannelSinkStack; +end; + +class function CoInternalMessageWrapper.Create: _InternalMessageWrapper; +begin + Result := CreateComObject(CLASS_InternalMessageWrapper) as _InternalMessageWrapper; +end; + +class function CoInternalMessageWrapper.CreateRemote(const MachineName: string): _InternalMessageWrapper; +begin + Result := CreateRemoteComObject(MachineName, CLASS_InternalMessageWrapper) as _InternalMessageWrapper; +end; + +class function CoMethodCallMessageWrapper.Create: _MethodCallMessageWrapper; +begin + Result := CreateComObject(CLASS_MethodCallMessageWrapper) as _MethodCallMessageWrapper; +end; + +class function CoMethodCallMessageWrapper.CreateRemote(const MachineName: string): _MethodCallMessageWrapper; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MethodCallMessageWrapper) as _MethodCallMessageWrapper; +end; + +class function CoClientSponsor.Create: _ClientSponsor; +begin + Result := CreateComObject(CLASS_ClientSponsor) as _ClientSponsor; +end; + +class function CoClientSponsor.CreateRemote(const MachineName: string): _ClientSponsor; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ClientSponsor) as _ClientSponsor; +end; + +class function CoCrossContextDelegate.Create: _CrossContextDelegate; +begin + Result := CreateComObject(CLASS_CrossContextDelegate) as _CrossContextDelegate; +end; + +class function CoCrossContextDelegate.CreateRemote(const MachineName: string): _CrossContextDelegate; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CrossContextDelegate) as _CrossContextDelegate; +end; + +class function CoContext.Create: _Context; +begin + Result := CreateComObject(CLASS_Context) as _Context; +end; + +class function CoContext.CreateRemote(const MachineName: string): _Context; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Context) as _Context; +end; + +class function CoContextProperty.Create: _ContextProperty; +begin + Result := CreateComObject(CLASS_ContextProperty) as _ContextProperty; +end; + +class function CoContextProperty.CreateRemote(const MachineName: string): _ContextProperty; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ContextProperty) as _ContextProperty; +end; + +class function CoEnterpriseServicesHelper.Create: _EnterpriseServicesHelper; +begin + Result := CreateComObject(CLASS_EnterpriseServicesHelper) as _EnterpriseServicesHelper; +end; + +class function CoEnterpriseServicesHelper.CreateRemote(const MachineName: string): _EnterpriseServicesHelper; +begin + Result := CreateRemoteComObject(MachineName, CLASS_EnterpriseServicesHelper) as _EnterpriseServicesHelper; +end; + +class function CoHeader.Create: _Header; +begin + Result := CreateComObject(CLASS_Header) as _Header; +end; + +class function CoHeader.CreateRemote(const MachineName: string): _Header; +begin + Result := CreateRemoteComObject(MachineName, CLASS_Header) as _Header; +end; + +class function CoHeaderHandler.Create: _HeaderHandler; +begin + Result := CreateComObject(CLASS_HeaderHandler) as _HeaderHandler; +end; + +class function CoHeaderHandler.CreateRemote(const MachineName: string): _HeaderHandler; +begin + Result := CreateRemoteComObject(MachineName, CLASS_HeaderHandler) as _HeaderHandler; +end; + +class function CoChannelDataStore.Create: _ChannelDataStore; +begin + Result := CreateComObject(CLASS_ChannelDataStore) as _ChannelDataStore; +end; + +class function CoChannelDataStore.CreateRemote(const MachineName: string): _ChannelDataStore; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ChannelDataStore) as _ChannelDataStore; +end; + +class function CoTransportHeaders.Create: _TransportHeaders; +begin + Result := CreateComObject(CLASS_TransportHeaders) as _TransportHeaders; +end; + +class function CoTransportHeaders.CreateRemote(const MachineName: string): _TransportHeaders; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TransportHeaders) as _TransportHeaders; +end; + +class function CoSinkProviderData.Create: _SinkProviderData; +begin + Result := CreateComObject(CLASS_SinkProviderData) as _SinkProviderData; +end; + +class function CoSinkProviderData.CreateRemote(const MachineName: string): _SinkProviderData; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SinkProviderData) as _SinkProviderData; +end; + +class function CoBaseChannelObjectWithProperties.Create: _BaseChannelObjectWithProperties; +begin + Result := CreateComObject(CLASS_BaseChannelObjectWithProperties) as _BaseChannelObjectWithProperties; +end; + +class function CoBaseChannelObjectWithProperties.CreateRemote(const MachineName: string): _BaseChannelObjectWithProperties; +begin + Result := CreateRemoteComObject(MachineName, CLASS_BaseChannelObjectWithProperties) as _BaseChannelObjectWithProperties; +end; + +class function CoBaseChannelSinkWithProperties.Create: _BaseChannelSinkWithProperties; +begin + Result := CreateComObject(CLASS_BaseChannelSinkWithProperties) as _BaseChannelSinkWithProperties; +end; + +class function CoBaseChannelSinkWithProperties.CreateRemote(const MachineName: string): _BaseChannelSinkWithProperties; +begin + Result := CreateRemoteComObject(MachineName, CLASS_BaseChannelSinkWithProperties) as _BaseChannelSinkWithProperties; +end; + +class function CoBaseChannelWithProperties.Create: _BaseChannelWithProperties; +begin + Result := CreateComObject(CLASS_BaseChannelWithProperties) as _BaseChannelWithProperties; +end; + +class function CoBaseChannelWithProperties.CreateRemote(const MachineName: string): _BaseChannelWithProperties; +begin + Result := CreateRemoteComObject(MachineName, CLASS_BaseChannelWithProperties) as _BaseChannelWithProperties; +end; + +class function CoLifetimeServices.Create: _LifetimeServices; +begin + Result := CreateComObject(CLASS_LifetimeServices) as _LifetimeServices; +end; + +class function CoLifetimeServices.CreateRemote(const MachineName: string): _LifetimeServices; +begin + Result := CreateRemoteComObject(MachineName, CLASS_LifetimeServices) as _LifetimeServices; +end; + +class function CoReturnMessage.Create: _ReturnMessage; +begin + Result := CreateComObject(CLASS_ReturnMessage) as _ReturnMessage; +end; + +class function CoReturnMessage.CreateRemote(const MachineName: string): _ReturnMessage; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ReturnMessage) as _ReturnMessage; +end; + +class function CoMethodCall.Create: _MethodCall; +begin + Result := CreateComObject(CLASS_MethodCall) as _MethodCall; +end; + +class function CoMethodCall.CreateRemote(const MachineName: string): _MethodCall; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MethodCall) as _MethodCall; +end; + +class function CoConstructionCall.Create: _ConstructionCall; +begin + Result := CreateComObject(CLASS_ConstructionCall) as _ConstructionCall; +end; + +class function CoConstructionCall.CreateRemote(const MachineName: string): _ConstructionCall; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ConstructionCall) as _ConstructionCall; +end; + +class function CoMethodResponse.Create: _MethodResponse; +begin + Result := CreateComObject(CLASS_MethodResponse) as _MethodResponse; +end; + +class function CoMethodResponse.CreateRemote(const MachineName: string): _MethodResponse; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MethodResponse) as _MethodResponse; +end; + +class function CoConstructionResponse.Create: _ConstructionResponse; +begin + Result := CreateComObject(CLASS_ConstructionResponse) as _ConstructionResponse; +end; + +class function CoConstructionResponse.CreateRemote(const MachineName: string): _ConstructionResponse; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ConstructionResponse) as _ConstructionResponse; +end; + +class function CoMethodReturnMessageWrapper.Create: _MethodReturnMessageWrapper; +begin + Result := CreateComObject(CLASS_MethodReturnMessageWrapper) as _MethodReturnMessageWrapper; +end; + +class function CoMethodReturnMessageWrapper.CreateRemote(const MachineName: string): _MethodReturnMessageWrapper; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MethodReturnMessageWrapper) as _MethodReturnMessageWrapper; +end; + +class function CoObjectHandle.Create: _ObjectHandle; +begin + Result := CreateComObject(CLASS_ObjectHandle) as _ObjectHandle; +end; + +class function CoObjectHandle.CreateRemote(const MachineName: string): _ObjectHandle; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ObjectHandle) as _ObjectHandle; +end; + +class function CoObjRef.Create: _ObjRef; +begin + Result := CreateComObject(CLASS_ObjRef) as _ObjRef; +end; + +class function CoObjRef.CreateRemote(const MachineName: string): _ObjRef; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ObjRef) as _ObjRef; +end; + +class function CoOneWayAttribute.Create: _OneWayAttribute; +begin + Result := CreateComObject(CLASS_OneWayAttribute) as _OneWayAttribute; +end; + +class function CoOneWayAttribute.CreateRemote(const MachineName: string): _OneWayAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_OneWayAttribute) as _OneWayAttribute; +end; + +class function CoProxyAttribute.Create: _ProxyAttribute; +begin + Result := CreateComObject(CLASS_ProxyAttribute) as _ProxyAttribute; +end; + +class function CoProxyAttribute.CreateRemote(const MachineName: string): _ProxyAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ProxyAttribute) as _ProxyAttribute; +end; + +class function CoRealProxy.Create: _RealProxy; +begin + Result := CreateComObject(CLASS_RealProxy) as _RealProxy; +end; + +class function CoRealProxy.CreateRemote(const MachineName: string): _RealProxy; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RealProxy) as _RealProxy; +end; + +class function CoSoapAttribute.Create: _SoapAttribute; +begin + Result := CreateComObject(CLASS_SoapAttribute) as _SoapAttribute; +end; + +class function CoSoapAttribute.CreateRemote(const MachineName: string): _SoapAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapAttribute) as _SoapAttribute; +end; + +class function CoSoapTypeAttribute.Create: _SoapTypeAttribute; +begin + Result := CreateComObject(CLASS_SoapTypeAttribute) as _SoapTypeAttribute; +end; + +class function CoSoapTypeAttribute.CreateRemote(const MachineName: string): _SoapTypeAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapTypeAttribute) as _SoapTypeAttribute; +end; + +class function CoSoapMethodAttribute.Create: _SoapMethodAttribute; +begin + Result := CreateComObject(CLASS_SoapMethodAttribute) as _SoapMethodAttribute; +end; + +class function CoSoapMethodAttribute.CreateRemote(const MachineName: string): _SoapMethodAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapMethodAttribute) as _SoapMethodAttribute; +end; + +class function CoSoapFieldAttribute.Create: _SoapFieldAttribute; +begin + Result := CreateComObject(CLASS_SoapFieldAttribute) as _SoapFieldAttribute; +end; + +class function CoSoapFieldAttribute.CreateRemote(const MachineName: string): _SoapFieldAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapFieldAttribute) as _SoapFieldAttribute; +end; + +class function CoSoapParameterAttribute.Create: _SoapParameterAttribute; +begin + Result := CreateComObject(CLASS_SoapParameterAttribute) as _SoapParameterAttribute; +end; + +class function CoSoapParameterAttribute.CreateRemote(const MachineName: string): _SoapParameterAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapParameterAttribute) as _SoapParameterAttribute; +end; + +class function CoRemotingConfiguration.Create: _RemotingConfiguration; +begin + Result := CreateComObject(CLASS_RemotingConfiguration) as _RemotingConfiguration; +end; + +class function CoRemotingConfiguration.CreateRemote(const MachineName: string): _RemotingConfiguration; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RemotingConfiguration) as _RemotingConfiguration; +end; + +class function CoSystem_Runtime_Remoting_TypeEntry.Create: _System_Runtime_Remoting_TypeEntry; +begin + Result := CreateComObject(CLASS_System_Runtime_Remoting_TypeEntry) as _System_Runtime_Remoting_TypeEntry; +end; + +class function CoSystem_Runtime_Remoting_TypeEntry.CreateRemote(const MachineName: string): _System_Runtime_Remoting_TypeEntry; +begin + Result := CreateRemoteComObject(MachineName, CLASS_System_Runtime_Remoting_TypeEntry) as _System_Runtime_Remoting_TypeEntry; +end; + +class function CoActivatedClientTypeEntry.Create: _ActivatedClientTypeEntry; +begin + Result := CreateComObject(CLASS_ActivatedClientTypeEntry) as _ActivatedClientTypeEntry; +end; + +class function CoActivatedClientTypeEntry.CreateRemote(const MachineName: string): _ActivatedClientTypeEntry; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ActivatedClientTypeEntry) as _ActivatedClientTypeEntry; +end; + +class function CoActivatedServiceTypeEntry.Create: _ActivatedServiceTypeEntry; +begin + Result := CreateComObject(CLASS_ActivatedServiceTypeEntry) as _ActivatedServiceTypeEntry; +end; + +class function CoActivatedServiceTypeEntry.CreateRemote(const MachineName: string): _ActivatedServiceTypeEntry; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ActivatedServiceTypeEntry) as _ActivatedServiceTypeEntry; +end; + +class function CoWellKnownClientTypeEntry.Create: _WellKnownClientTypeEntry; +begin + Result := CreateComObject(CLASS_WellKnownClientTypeEntry) as _WellKnownClientTypeEntry; +end; + +class function CoWellKnownClientTypeEntry.CreateRemote(const MachineName: string): _WellKnownClientTypeEntry; +begin + Result := CreateRemoteComObject(MachineName, CLASS_WellKnownClientTypeEntry) as _WellKnownClientTypeEntry; +end; + +class function CoWellKnownServiceTypeEntry.Create: _WellKnownServiceTypeEntry; +begin + Result := CreateComObject(CLASS_WellKnownServiceTypeEntry) as _WellKnownServiceTypeEntry; +end; + +class function CoWellKnownServiceTypeEntry.CreateRemote(const MachineName: string): _WellKnownServiceTypeEntry; +begin + Result := CreateRemoteComObject(MachineName, CLASS_WellKnownServiceTypeEntry) as _WellKnownServiceTypeEntry; +end; + +class function CoRemotingException.Create: _RemotingException; +begin + Result := CreateComObject(CLASS_RemotingException) as _RemotingException; +end; + +class function CoRemotingException.CreateRemote(const MachineName: string): _RemotingException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RemotingException) as _RemotingException; +end; + +class function CoServerException.Create: _ServerException; +begin + Result := CreateComObject(CLASS_ServerException) as _ServerException; +end; + +class function CoServerException.CreateRemote(const MachineName: string): _ServerException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ServerException) as _ServerException; +end; + +class function CoRemotingTimeoutException.Create: _RemotingTimeoutException; +begin + Result := CreateComObject(CLASS_RemotingTimeoutException) as _RemotingTimeoutException; +end; + +class function CoRemotingTimeoutException.CreateRemote(const MachineName: string): _RemotingTimeoutException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RemotingTimeoutException) as _RemotingTimeoutException; +end; + +class function CoRemotingServices.Create: _RemotingServices; +begin + Result := CreateComObject(CLASS_RemotingServices) as _RemotingServices; +end; + +class function CoRemotingServices.CreateRemote(const MachineName: string): _RemotingServices; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RemotingServices) as _RemotingServices; +end; + +class function CoInternalRemotingServices.Create: _InternalRemotingServices; +begin + Result := CreateComObject(CLASS_InternalRemotingServices) as _InternalRemotingServices; +end; + +class function CoInternalRemotingServices.CreateRemote(const MachineName: string): _InternalRemotingServices; +begin + Result := CreateRemoteComObject(MachineName, CLASS_InternalRemotingServices) as _InternalRemotingServices; +end; + +class function CoMessageSurrogateFilter.Create: _MessageSurrogateFilter; +begin + Result := CreateComObject(CLASS_MessageSurrogateFilter) as _MessageSurrogateFilter; +end; + +class function CoMessageSurrogateFilter.CreateRemote(const MachineName: string): _MessageSurrogateFilter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MessageSurrogateFilter) as _MessageSurrogateFilter; +end; + +class function CoRemotingSurrogateSelector.Create: _RemotingSurrogateSelector; +begin + Result := CreateComObject(CLASS_RemotingSurrogateSelector) as _RemotingSurrogateSelector; +end; + +class function CoRemotingSurrogateSelector.CreateRemote(const MachineName: string): _RemotingSurrogateSelector; +begin + Result := CreateRemoteComObject(MachineName, CLASS_RemotingSurrogateSelector) as _RemotingSurrogateSelector; +end; + +class function CoSoapServices.Create: _SoapServices; +begin + Result := CreateComObject(CLASS_SoapServices) as _SoapServices; +end; + +class function CoSoapServices.CreateRemote(const MachineName: string): _SoapServices; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapServices) as _SoapServices; +end; + +class function CoSoapDateTime.Create: _SoapDateTime; +begin + Result := CreateComObject(CLASS_SoapDateTime) as _SoapDateTime; +end; + +class function CoSoapDateTime.CreateRemote(const MachineName: string): _SoapDateTime; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapDateTime) as _SoapDateTime; +end; + +class function CoSoapDuration.Create: _SoapDuration; +begin + Result := CreateComObject(CLASS_SoapDuration) as _SoapDuration; +end; + +class function CoSoapDuration.CreateRemote(const MachineName: string): _SoapDuration; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapDuration) as _SoapDuration; +end; + +class function CoSoapTime.Create: _SoapTime; +begin + Result := CreateComObject(CLASS_SoapTime) as _SoapTime; +end; + +class function CoSoapTime.CreateRemote(const MachineName: string): _SoapTime; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapTime) as _SoapTime; +end; + +class function CoSoapDate.Create: _SoapDate; +begin + Result := CreateComObject(CLASS_SoapDate) as _SoapDate; +end; + +class function CoSoapDate.CreateRemote(const MachineName: string): _SoapDate; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapDate) as _SoapDate; +end; + +class function CoSoapYearMonth.Create: _SoapYearMonth; +begin + Result := CreateComObject(CLASS_SoapYearMonth) as _SoapYearMonth; +end; + +class function CoSoapYearMonth.CreateRemote(const MachineName: string): _SoapYearMonth; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapYearMonth) as _SoapYearMonth; +end; + +class function CoSoapYear.Create: _SoapYear; +begin + Result := CreateComObject(CLASS_SoapYear) as _SoapYear; +end; + +class function CoSoapYear.CreateRemote(const MachineName: string): _SoapYear; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapYear) as _SoapYear; +end; + +class function CoSoapMonthDay.Create: _SoapMonthDay; +begin + Result := CreateComObject(CLASS_SoapMonthDay) as _SoapMonthDay; +end; + +class function CoSoapMonthDay.CreateRemote(const MachineName: string): _SoapMonthDay; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapMonthDay) as _SoapMonthDay; +end; + +class function CoSoapDay.Create: _SoapDay; +begin + Result := CreateComObject(CLASS_SoapDay) as _SoapDay; +end; + +class function CoSoapDay.CreateRemote(const MachineName: string): _SoapDay; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapDay) as _SoapDay; +end; + +class function CoSoapMonth.Create: _SoapMonth; +begin + Result := CreateComObject(CLASS_SoapMonth) as _SoapMonth; +end; + +class function CoSoapMonth.CreateRemote(const MachineName: string): _SoapMonth; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapMonth) as _SoapMonth; +end; + +class function CoSoapHexBinary.Create: _SoapHexBinary; +begin + Result := CreateComObject(CLASS_SoapHexBinary) as _SoapHexBinary; +end; + +class function CoSoapHexBinary.CreateRemote(const MachineName: string): _SoapHexBinary; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapHexBinary) as _SoapHexBinary; +end; + +class function CoSoapBase64Binary.Create: _SoapBase64Binary; +begin + Result := CreateComObject(CLASS_SoapBase64Binary) as _SoapBase64Binary; +end; + +class function CoSoapBase64Binary.CreateRemote(const MachineName: string): _SoapBase64Binary; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapBase64Binary) as _SoapBase64Binary; +end; + +class function CoSoapInteger.Create: _SoapInteger; +begin + Result := CreateComObject(CLASS_SoapInteger) as _SoapInteger; +end; + +class function CoSoapInteger.CreateRemote(const MachineName: string): _SoapInteger; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapInteger) as _SoapInteger; +end; + +class function CoSoapPositiveInteger.Create: _SoapPositiveInteger; +begin + Result := CreateComObject(CLASS_SoapPositiveInteger) as _SoapPositiveInteger; +end; + +class function CoSoapPositiveInteger.CreateRemote(const MachineName: string): _SoapPositiveInteger; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapPositiveInteger) as _SoapPositiveInteger; +end; + +class function CoSoapNonPositiveInteger.Create: _SoapNonPositiveInteger; +begin + Result := CreateComObject(CLASS_SoapNonPositiveInteger) as _SoapNonPositiveInteger; +end; + +class function CoSoapNonPositiveInteger.CreateRemote(const MachineName: string): _SoapNonPositiveInteger; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapNonPositiveInteger) as _SoapNonPositiveInteger; +end; + +class function CoSoapNonNegativeInteger.Create: _SoapNonNegativeInteger; +begin + Result := CreateComObject(CLASS_SoapNonNegativeInteger) as _SoapNonNegativeInteger; +end; + +class function CoSoapNonNegativeInteger.CreateRemote(const MachineName: string): _SoapNonNegativeInteger; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapNonNegativeInteger) as _SoapNonNegativeInteger; +end; + +class function CoSoapNegativeInteger.Create: _SoapNegativeInteger; +begin + Result := CreateComObject(CLASS_SoapNegativeInteger) as _SoapNegativeInteger; +end; + +class function CoSoapNegativeInteger.CreateRemote(const MachineName: string): _SoapNegativeInteger; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapNegativeInteger) as _SoapNegativeInteger; +end; + +class function CoSoapAnyUri.Create: _SoapAnyUri; +begin + Result := CreateComObject(CLASS_SoapAnyUri) as _SoapAnyUri; +end; + +class function CoSoapAnyUri.CreateRemote(const MachineName: string): _SoapAnyUri; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapAnyUri) as _SoapAnyUri; +end; + +class function CoSoapQName.Create: _SoapQName; +begin + Result := CreateComObject(CLASS_SoapQName) as _SoapQName; +end; + +class function CoSoapQName.CreateRemote(const MachineName: string): _SoapQName; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapQName) as _SoapQName; +end; + +class function CoSoapNotation.Create: _SoapNotation; +begin + Result := CreateComObject(CLASS_SoapNotation) as _SoapNotation; +end; + +class function CoSoapNotation.CreateRemote(const MachineName: string): _SoapNotation; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapNotation) as _SoapNotation; +end; + +class function CoSoapNormalizedString.Create: _SoapNormalizedString; +begin + Result := CreateComObject(CLASS_SoapNormalizedString) as _SoapNormalizedString; +end; + +class function CoSoapNormalizedString.CreateRemote(const MachineName: string): _SoapNormalizedString; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapNormalizedString) as _SoapNormalizedString; +end; + +class function CoSoapToken.Create: _SoapToken; +begin + Result := CreateComObject(CLASS_SoapToken) as _SoapToken; +end; + +class function CoSoapToken.CreateRemote(const MachineName: string): _SoapToken; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapToken) as _SoapToken; +end; + +class function CoSoapLanguage.Create: _SoapLanguage; +begin + Result := CreateComObject(CLASS_SoapLanguage) as _SoapLanguage; +end; + +class function CoSoapLanguage.CreateRemote(const MachineName: string): _SoapLanguage; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapLanguage) as _SoapLanguage; +end; + +class function CoSoapName.Create: _SoapName; +begin + Result := CreateComObject(CLASS_SoapName) as _SoapName; +end; + +class function CoSoapName.CreateRemote(const MachineName: string): _SoapName; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapName) as _SoapName; +end; + +class function CoSoapIdrefs.Create: _SoapIdrefs; +begin + Result := CreateComObject(CLASS_SoapIdrefs) as _SoapIdrefs; +end; + +class function CoSoapIdrefs.CreateRemote(const MachineName: string): _SoapIdrefs; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapIdrefs) as _SoapIdrefs; +end; + +class function CoSoapEntities.Create: _SoapEntities; +begin + Result := CreateComObject(CLASS_SoapEntities) as _SoapEntities; +end; + +class function CoSoapEntities.CreateRemote(const MachineName: string): _SoapEntities; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapEntities) as _SoapEntities; +end; + +class function CoSoapNmtoken.Create: _SoapNmtoken; +begin + Result := CreateComObject(CLASS_SoapNmtoken) as _SoapNmtoken; +end; + +class function CoSoapNmtoken.CreateRemote(const MachineName: string): _SoapNmtoken; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapNmtoken) as _SoapNmtoken; +end; + +class function CoSoapNmtokens.Create: _SoapNmtokens; +begin + Result := CreateComObject(CLASS_SoapNmtokens) as _SoapNmtokens; +end; + +class function CoSoapNmtokens.CreateRemote(const MachineName: string): _SoapNmtokens; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapNmtokens) as _SoapNmtokens; +end; + +class function CoSoapNcName.Create: _SoapNcName; +begin + Result := CreateComObject(CLASS_SoapNcName) as _SoapNcName; +end; + +class function CoSoapNcName.CreateRemote(const MachineName: string): _SoapNcName; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapNcName) as _SoapNcName; +end; + +class function CoSoapId.Create: _SoapId; +begin + Result := CreateComObject(CLASS_SoapId) as _SoapId; +end; + +class function CoSoapId.CreateRemote(const MachineName: string): _SoapId; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapId) as _SoapId; +end; + +class function CoSoapIdref.Create: _SoapIdref; +begin + Result := CreateComObject(CLASS_SoapIdref) as _SoapIdref; +end; + +class function CoSoapIdref.CreateRemote(const MachineName: string): _SoapIdref; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapIdref) as _SoapIdref; +end; + +class function CoSoapEntity.Create: _SoapEntity; +begin + Result := CreateComObject(CLASS_SoapEntity) as _SoapEntity; +end; + +class function CoSoapEntity.CreateRemote(const MachineName: string): _SoapEntity; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapEntity) as _SoapEntity; +end; + +class function CoSynchronizationAttribute.Create: _SynchronizationAttribute; +begin + Result := CreateComObject(CLASS_SynchronizationAttribute) as _SynchronizationAttribute; +end; + +class function CoSynchronizationAttribute.CreateRemote(const MachineName: string): _SynchronizationAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SynchronizationAttribute) as _SynchronizationAttribute; +end; + +class function CoTrackingServices.Create: _TrackingServices; +begin + Result := CreateComObject(CLASS_TrackingServices) as _TrackingServices; +end; + +class function CoTrackingServices.CreateRemote(const MachineName: string): _TrackingServices; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TrackingServices) as _TrackingServices; +end; + +class function CoUrlAttribute.Create: _UrlAttribute; +begin + Result := CreateComObject(CLASS_UrlAttribute) as _UrlAttribute; +end; + +class function CoUrlAttribute.CreateRemote(const MachineName: string): _UrlAttribute; +begin + Result := CreateRemoteComObject(MachineName, CLASS_UrlAttribute) as _UrlAttribute; +end; + +class function CoIsolatedStorage.Create: _IsolatedStorage; +begin + Result := CreateComObject(CLASS_IsolatedStorage) as _IsolatedStorage; +end; + +class function CoIsolatedStorage.CreateRemote(const MachineName: string): _IsolatedStorage; +begin + Result := CreateRemoteComObject(MachineName, CLASS_IsolatedStorage) as _IsolatedStorage; +end; + +class function CoIsolatedStorageFile.Create: _IsolatedStorageFile; +begin + Result := CreateComObject(CLASS_IsolatedStorageFile) as _IsolatedStorageFile; +end; + +class function CoIsolatedStorageFile.CreateRemote(const MachineName: string): _IsolatedStorageFile; +begin + Result := CreateRemoteComObject(MachineName, CLASS_IsolatedStorageFile) as _IsolatedStorageFile; +end; + +class function CoIsolatedStorageFileStream.Create: _IsolatedStorageFileStream; +begin + Result := CreateComObject(CLASS_IsolatedStorageFileStream) as _IsolatedStorageFileStream; +end; + +class function CoIsolatedStorageFileStream.CreateRemote(const MachineName: string): _IsolatedStorageFileStream; +begin + Result := CreateRemoteComObject(MachineName, CLASS_IsolatedStorageFileStream) as _IsolatedStorageFileStream; +end; + +class function CoIsolatedStorageException.Create: _IsolatedStorageException; +begin + Result := CreateComObject(CLASS_IsolatedStorageException) as _IsolatedStorageException; +end; + +class function CoIsolatedStorageException.CreateRemote(const MachineName: string): _IsolatedStorageException; +begin + Result := CreateRemoteComObject(MachineName, CLASS_IsolatedStorageException) as _IsolatedStorageException; +end; + +class function CoInternalRM.Create: _InternalRM; +begin + Result := CreateComObject(CLASS_InternalRM) as _InternalRM; +end; + +class function CoInternalRM.CreateRemote(const MachineName: string): _InternalRM; +begin + Result := CreateRemoteComObject(MachineName, CLASS_InternalRM) as _InternalRM; +end; + +class function CoInternalST.Create: _InternalST; +begin + Result := CreateComObject(CLASS_InternalST) as _InternalST; +end; + +class function CoInternalST.CreateRemote(const MachineName: string): _InternalST; +begin + Result := CreateRemoteComObject(MachineName, CLASS_InternalST) as _InternalST; +end; + +class function CoSoapMessage.Create: _SoapMessage; +begin + Result := CreateComObject(CLASS_SoapMessage) as _SoapMessage; +end; + +class function CoSoapMessage.CreateRemote(const MachineName: string): _SoapMessage; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapMessage) as _SoapMessage; +end; + +class function CoSoapFault.Create: _SoapFault; +begin + Result := CreateComObject(CLASS_SoapFault) as _SoapFault; +end; + +class function CoSoapFault.CreateRemote(const MachineName: string): _SoapFault; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SoapFault) as _SoapFault; +end; + +class function CoServerFault.Create: _ServerFault; +begin + Result := CreateComObject(CLASS_ServerFault) as _ServerFault; +end; + +class function CoServerFault.CreateRemote(const MachineName: string): _ServerFault; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ServerFault) as _ServerFault; +end; + +class function CoBinaryFormatter.Create: _BinaryFormatter; +begin + Result := CreateComObject(CLASS_BinaryFormatter) as _BinaryFormatter; +end; + +class function CoBinaryFormatter.CreateRemote(const MachineName: string): _BinaryFormatter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_BinaryFormatter) as _BinaryFormatter; +end; + +class function CoAssemblyBuilder.Create: _AssemblyBuilder; +begin + Result := CreateComObject(CLASS_AssemblyBuilder) as _AssemblyBuilder; +end; + +class function CoAssemblyBuilder.CreateRemote(const MachineName: string): _AssemblyBuilder; +begin + Result := CreateRemoteComObject(MachineName, CLASS_AssemblyBuilder) as _AssemblyBuilder; +end; + +class function CoConstructorBuilder.Create: _ConstructorBuilder; +begin + Result := CreateComObject(CLASS_ConstructorBuilder) as _ConstructorBuilder; +end; + +class function CoConstructorBuilder.CreateRemote(const MachineName: string): _ConstructorBuilder; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ConstructorBuilder) as _ConstructorBuilder; +end; + +class function CoEventBuilder.Create: _EventBuilder; +begin + Result := CreateComObject(CLASS_EventBuilder) as _EventBuilder; +end; + +class function CoEventBuilder.CreateRemote(const MachineName: string): _EventBuilder; +begin + Result := CreateRemoteComObject(MachineName, CLASS_EventBuilder) as _EventBuilder; +end; + +class function CoFieldBuilder.Create: _FieldBuilder; +begin + Result := CreateComObject(CLASS_FieldBuilder) as _FieldBuilder; +end; + +class function CoFieldBuilder.CreateRemote(const MachineName: string): _FieldBuilder; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FieldBuilder) as _FieldBuilder; +end; + +class function CoILGenerator.Create: _ILGenerator; +begin + Result := CreateComObject(CLASS_ILGenerator) as _ILGenerator; +end; + +class function CoILGenerator.CreateRemote(const MachineName: string): _ILGenerator; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ILGenerator) as _ILGenerator; +end; + +class function CoLocalBuilder.Create: _LocalBuilder; +begin + Result := CreateComObject(CLASS_LocalBuilder) as _LocalBuilder; +end; + +class function CoLocalBuilder.CreateRemote(const MachineName: string): _LocalBuilder; +begin + Result := CreateRemoteComObject(MachineName, CLASS_LocalBuilder) as _LocalBuilder; +end; + +class function CoMethodBuilder.Create: _MethodBuilder; +begin + Result := CreateComObject(CLASS_MethodBuilder) as _MethodBuilder; +end; + +class function CoMethodBuilder.CreateRemote(const MachineName: string): _MethodBuilder; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MethodBuilder) as _MethodBuilder; +end; + +class function CoCustomAttributeBuilder.Create: _CustomAttributeBuilder; +begin + Result := CreateComObject(CLASS_CustomAttributeBuilder) as _CustomAttributeBuilder; +end; + +class function CoCustomAttributeBuilder.CreateRemote(const MachineName: string): _CustomAttributeBuilder; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CustomAttributeBuilder) as _CustomAttributeBuilder; +end; + +class function CoMethodRental.Create: _MethodRental; +begin + Result := CreateComObject(CLASS_MethodRental) as _MethodRental; +end; + +class function CoMethodRental.CreateRemote(const MachineName: string): _MethodRental; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MethodRental) as _MethodRental; +end; + +class function CoModuleBuilder.Create: _ModuleBuilder; +begin + Result := CreateComObject(CLASS_ModuleBuilder) as _ModuleBuilder; +end; + +class function CoModuleBuilder.CreateRemote(const MachineName: string): _ModuleBuilder; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ModuleBuilder) as _ModuleBuilder; +end; + +class function CoOpCodes.Create: _OpCodes; +begin + Result := CreateComObject(CLASS_OpCodes) as _OpCodes; +end; + +class function CoOpCodes.CreateRemote(const MachineName: string): _OpCodes; +begin + Result := CreateRemoteComObject(MachineName, CLASS_OpCodes) as _OpCodes; +end; + +class function CoParameterBuilder.Create: _ParameterBuilder; +begin + Result := CreateComObject(CLASS_ParameterBuilder) as _ParameterBuilder; +end; + +class function CoParameterBuilder.CreateRemote(const MachineName: string): _ParameterBuilder; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ParameterBuilder) as _ParameterBuilder; +end; + +class function CoPropertyBuilder.Create: _PropertyBuilder; +begin + Result := CreateComObject(CLASS_PropertyBuilder) as _PropertyBuilder; +end; + +class function CoPropertyBuilder.CreateRemote(const MachineName: string): _PropertyBuilder; +begin + Result := CreateRemoteComObject(MachineName, CLASS_PropertyBuilder) as _PropertyBuilder; +end; + +class function CoSignatureHelper.Create: _SignatureHelper; +begin + Result := CreateComObject(CLASS_SignatureHelper) as _SignatureHelper; +end; + +class function CoSignatureHelper.CreateRemote(const MachineName: string): _SignatureHelper; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SignatureHelper) as _SignatureHelper; +end; + +class function CoTypeBuilder.Create: _TypeBuilder; +begin + Result := CreateComObject(CLASS_TypeBuilder) as _TypeBuilder; +end; + +class function CoTypeBuilder.CreateRemote(const MachineName: string): _TypeBuilder; +begin + Result := CreateRemoteComObject(MachineName, CLASS_TypeBuilder) as _TypeBuilder; +end; + +class function CoEnumBuilder.Create: _EnumBuilder; +begin + Result := CreateComObject(CLASS_EnumBuilder) as _EnumBuilder; +end; + +class function CoEnumBuilder.CreateRemote(const MachineName: string): _EnumBuilder; +begin + Result := CreateRemoteComObject(MachineName, CLASS_EnumBuilder) as _EnumBuilder; +end; + +{$IFDEF UNITVERSIONING} +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); +{$ENDIF UNITVERSIONING} + +end. diff --git a/3rdParty/JCL/source/windows/obj/bzip2/win32/blocksort.obj b/3rdParty/JCL/source/windows/obj/bzip2/win32/blocksort.obj new file mode 100644 index 0000000000000000000000000000000000000000..5430359a99ffb1361cc462b2b5950cfb4c321b94 GIT binary patch literal 12751 zcmb_h3shU@eZNANL@%0P%f%qvK; z;~c=F7rDNCT*qBZn&g};*}AsbIXhdsEDdSB6=76Q@j!J& za`Kixk+i&ZyX*EQ7mD@ePn4JWyd?40;~}x~hC`ypo10WDH8lFF{DhfsL{P>y)Ym5$ zPJ~?RY2@xnhI4hj$Im$@98ir79$y(pO}JJ7wa!=FkW@$!Zbf5KsC)hU8oa)wedH-K z%$%^L;3ID(=bJEUou_eM0}rc&QOoC0lZlHtccpH;r?5pzD)RZ+;CnYtKpvO8RYjiCYM7->XOh2TMMWa9&gfF z4_soKa6E!7;U(M&>dKutNjays*0;~+_wunX;nb^n+WS;PSskzE35$&Ri|1a#9loN% zYm74qTNjvQq=Y$oD&i5Cu!WFxbzcA8-NZKGqS)vy^BGf6!l>Ze=;iZmGN^mJ$>kfk zdXg8ot|qy7@b9S)@UD|^l0)8r&(Jkt&o=m~8p=GoS0&|HFn+uuxoQej1Yo|F?&{pGJdjZfMN_6`s3SNG;tV{lyNka7&Sd=c4=_`67MYRJ38+7P(j~E!e)@jF0gA&B8yt zcBd&t;7_XsG1Yhygqtmb@ZwFvO}bf65jvI&x0RMZU0O|hPhD9}DR1|JaCo^Om~JgC z_)cyqzbM|0i{h?31mR%1AiNx)OD|}A&97HP(If~mn^1Zux9?;nRwiXI+3xDGwTrc%rNyMDWW8Ovc0z2+L&`+I;e_q6)whbMJ+Op&Hyz$A*{=6?di zM;5Z1oMZPbCQmM8R}g0g(gkWmOz9S{VRe3vRgANmyvpidzWW&aeaSJ{p|$s4W4i9_ zb`EXd`E6AiRl&wR34zo$t>}ub6I-`k?dT*hUBbzvb|gqYRQWU@H3LkQMgSQcvK{(w zxD)S{%buq6stJTd1a=i3)$vL?4TVRb?Fh?I2bes{PKMqU9fP5F&GaRj2Q~W--UJJwp!HpSzaXgcsB?%( zqnAErJ;CmPoyoBE1QXktY-QH(sqV38t}<;3e2GaD;A-v}oF?Cjtyj-)Bcnke>tQBY znf;(DkAVca`E7`%N>i!?Gm;B6dpq~Q^YD@D?fv&bVmR6Qa~2qL3e^Vix6b*9@Q-~8z2XWPIPj)(+Kkp7daIn3yX)?F!XQ? zx_X+^@BpJY`l2_pw{Yy}BNGif23f$O*`K3t@j$S@o1oQ)unTg* z(Zk%}5p$e$g+LDP+*6KF6q&={_7Ja#qc2}|pJgC!VS%%n_%nk%C!EVxt7}wB9MCoh z!*|lO`7NRjl$Zmii#U2Vu|ZZc;TX59-pSe;5Wf4FMRe3_qz!AJKpYUX`-}cNspXqw(yi^*w zr0Yl{RssYokL*lkMsyBo!I4jqWc>xI1-iA)m{5b7CMi^5CA({|+3xIbx9DveffeNO zcTE$((}<#hjYwEkpoGXctuq1<`0$tb7UHLt0@Ft0j1&LJAl`?NXObPo<*Up+X8Xk| z*7iE_*r*zRdAPI|=#l}|^gEQG;Ltv^(sNg6CROQ4L7IZnF+>Zbv^o1#O92GnKbtK--JTE|X;7DpeZ@^CqoS=l`y ze+s*ZI>1ngVvbO-yV-1(>_{*5p;kp21s!{VE8KLi`zMJMY4|zdzUY zcEn00vo}^Uabu+`?7tOXaqql`60w8{dU1^Czdrttmd0=UB7D!%_(flYf6vnRG_o!! z|9dDSOX*L=c}e}3#&25`KYh;r(aO&;Pn*r0=p&!!JP-4J!pwB_HJTmnOeSZ#F5)SW zsno`hnprwVu^5I*?Hn4dv-`V`mK-~Ln9^72ouED|X8{>gK{LA2Op2}JA7LnGe;33R zFtJ5%!sJEW%HkT_j{%D6t|oT!Qw*~5G$?oMBip(s*(y*nALmghytGU>AKH;}{+%5u z0-q49G0plzm8KCCtSn4X&lGaB37TK0SV=7UXY82cIJ19WwZH86ALh<94{UP1-SQxl zSD>oew<4&G>WbMa+cAKF#vICJ5G4*UwUk}AHeOBjnn_ z-pbrGNnw^<)8n%olyw$vm-ID#J_`%sO$zHlMDQhM3hbQSe1*YekJTa*E6Zx$P4GKQ zJraBsD+}fp*dLosCd{DI4ltp0bkYyijRA84n+<`f@+m-KvmpYi6b2Y=He(`%%7k*c z9GlHJit_AcGoeU*aM>w*!thy`wi^s~rzkqcnA}H>8)fu}=~bDwH=(VKDwl6 z)^4XrL-LF&+r`uHAaN=WRX5Z+z>?r{N{O^)!E(yyA|iu*)eXkI_Ki z2jk?^P(LyLe=stib0XMxFzZe`LYSD1l_a{KIrkTJU&*KA3z<4T^Z=N7Fb`H9KLvZlRabXr3C3;VtVV3QQwvFpEamj3aXEe1~;% zKJr->q$7hZlh3N19Fp^=U5}%vK~9WLIctqX;-_4IApPXH^pj~EhLgqK*U9Ayl8lb9 z>tr)HbB5UY48aZ2q!E?FFwQ}xQ$kb?Vsy&sbaIAtN=m94XGo`u=xmsYlV7Ow>4iF< zUZ^upNr73NaXMdToX*!7r(6Vgm>G^UF;pMJdf1|&J~tJ%SE@4DYER)4Msol>H-iDs z85;1M`l9gM%?3O-jRDW?@Ok(NT5z+V$NUAi>!PvX;%Y_8!X*D|+`tLi0YMN26|%~G z*bvjUP&o|h%?N0#^9*aw+|r(j$IyEgMK^2q)vDZ!8mEc-nwl$5ptXfQMSbW+2}-lQ zfomO0`tNk{Zz@mZT``W_z0RTbt-9@vlc95#^tX+(*gUjHt}MixnUD9`JUm6}jVT{t zOP+=x%?e~Pp9rGB_o6*(;?qrExxP4Cba$`PeFa*baq7&N3hdOGGR-}7d2~{BgGz6E z+Ck`&Y5p%LSb0L+DhM0$bg5U-?`}F5w-^QofgNWV8%)J~U)RZmEgxZ*a(1_yLZg;S zRk}b%wdCe814nE7w>VwfGtZJ=5Si%J z5%vx$X=wCj&3;^!yQA53B{qgqbVTFeM_!^oj*>BSU>fuC&@|*RT!0O;4lZauOwYta zI7a0>(n-)T7_&Zyu3g{=%|3Ut+vv7z?<>@I+c?n;q>>?=?NBWl4J>TIwRplEEi5oO zX9~)hGbAqU(XJ6&o5nSWfx3B^ZW-LupA;QR$qv+^Q84=fT#@SUV73{htG=Q`;#cVB zMr`ybyy%6l!4}B~Q6^_^dm;rJKE{wyj3Jo|N0Pt$grqu)Ge;jr6S_SB21`S|=y-u| zYSXP&l!R=du=P{&jP1~4q=+1A?^sUWYwP!?S6!H!pPXl)66%U7b!nYlAg;MV;JW+ zaj7f1o`|MwG_HlPby(Z2DF@w`P-f&yb20|L#DB96E|cEI|6nG=b*-8L#z#fQ?+x;4 zDtIHsBxFim*fid5`Zx;$6niB(P3dF!47}JnrGYkOt zA0@{7e+I_1G#m+%q73>1^bu^z4j4182kxbB<6xPa2o3#%FR*M-USeS|5W5dHUs9OWd^xc)rjio80QneN|XBb5n1(wMJm8v}- zsLj7IC~gEvss=6TRUgc$v>>Pclhy#{nG3 z*PC-%uVj2p5SlZ;y%VEbG24z|y)dIVvf%?7qV3Uuw*Kx{O@3Ve$!8I zsVFIzD_Tq~4+E zDRHpP*e8i?c$~96QJ95@KzV@AqBhFIK&o1p6;02>RXW>T9YeSUpL_AyhffV&N_ZKz3c{0L6@(o=LHO)Z VlQ4aYD2(4{6^=HqfQ^7G{67*!r*Z%Q literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/bzip2/win32/bzlib.obj b/3rdParty/JCL/source/windows/obj/bzip2/win32/bzlib.obj new file mode 100644 index 0000000000000000000000000000000000000000..4680e04ed7808727d786cf7254b9927fc6cd4b68 GIT binary patch literal 13305 zcmc&*4RDiXo`2J(G_=t~2oSJpb?OWb9~Od|HRY})Z3!)bv}r?GDYZ?56xt-4yy3$I zgiE`ZH;+uca$84yt zsB||p?pdO^D@5uCAdAt;sNj6oxz&aMDgZN_5qJ{9R`&yL=zTidf$YEiq1d1= zlpW&mW?yG#Yp^3Ls^J8!;hp~M(mZ*P=nG}%LyGGX(HTn%pzU5?)?N=-LYuKY0xiL1 zoC*AGmeQ=0)72H;85VuK?915oI-mCK2)6opJkOY9)L-29GS2Yr?LMWP$ymC8Bq3#t z(c7+CV8#-H)A@bk_N|0AsAe1&TRHiDy(>;b82Ib(wki|wr;Zd@62>f7N}ZXz~SKbG6pPy5#P_N{6L z%-ArA+rW07$4Y>C*7OC-Z`I?=Mu~|2e%^h`T%PD6dN*ffIW7K3C%-;ttcezApUWd- zS;9NV14QPmitW@xg?tx64P|)?mY3YT)!Gsab!=-DxlfVSsCjxTt)VlUi*3S-^M$;Y zhN`9pt$l4}6`m_A8Y;B(HLY@G{n|#Cwq=Feor{m~Qoiu3w!1Ys0)H|I+C1e+5b||` z@K@7>X>zWdBRu<*P|&jC$4gs6Ya(4?!N8xrA+Kd=Lu*^7PsnfSYVAav2d+&apHG;f zYzTA(L%wi$1y;7IKYiA2D9t2_kTtU#xAXIHn+tr<`{2k&i z(Q@8D3u||Ndu?bM=FOPD>)Z2H{`PWku>Wo>nUtl<3Dk68AFa;Ds=^FKgB`2ageZrpL5vb{Kd zGIAJ;#}^8B1pFJoNvu#1ei5NQBIa)xy{y%01R*`m(ntRe<5@Vme}5yp$g1>Tbs1er zObF|nC+2$k#Qf`%*axr?=F~|Qm6krKZnae5>fiSy3`53$mXY3yrgsEkMftv~0*>DG zg}kp5Yjhmp0A!V}zkC_3NiJ*iQI1!~T+5XG;X+n!?djX2we&R~J*465b#Bi(wp-64 zx@0v_^z=mv4u6G*)VnyO=S#6DDreZMjbSc~BM~~^4-K5NL zf|VKb4KqEb#6q`%jW#H}Fk-#mGLkr*CmkR)_1ks$7J9XNEd%{_t@TpsH+iY*NBVKb<9=5nkr-Zd2)GW zDh{y86O*6Q!O5eWJ*R7MJkT@%&GmzC_t{YyZ?f(^dM#E|0CK?hxPQ1=Gt{|kIr&F8 z-<|vn<_iHGxrQIUNs$fPt+SkBE49(F97E3lF|)3ct##Oj4ZRYXdOmY$dqxc1yD)fN z!vw<{rEKLg+a+-oTW76_*yAgOgR_KJ@Al-rTI$iBD`?Q1GdF0?_j_^#9v-yI*k6)J zEdz-Q=J;{TF#8J{CeG-X=>;zHVTo^G>mchnkoDRUkPy?}C9kZMwl7OR%+W;(*;?zq zE2Oi?Je8+)$ui;zoBCH;L7tG#l~-C>zAUgga*dW5QhU>5<5Cs^&W&q zI8Z6`kgq?&TrQhy_3lOgs9{YDNYRJx0Q-hAn9$vzbTV zGZHa)lF_T!*4=05c@3+cWC;!Xt9f)_YqZfTxse&HT92Sv=t-_q_D1$Fk1l#OC-QSo zQY3j4oa9?`#8PGJL!P9S=9xzuy{a|*JP|#ksq^rBgQLk75SdbL5=?a^^EhlrcFoxW zJu708XeO_?t(0&T0NpFN-rV(%XBfE7qcF%@cX(to8C=7zw;fmJUc{UyIfsxkH#D|=mOD8-rjSs;YF*5}+ID<*{$cp6 zknU6?ITuKJBhZR@I5^!f=~O;p_au*ze!BZ2!ojoYdQI^k zp!m8$yh$TjG@!y5w~1G2>dReu(QmZl)x~p|V(t<+PJX{#sV8dZ^XkGrUQdXqMihdm zo}gNTXW;aD$&BpSU#=~{8I}nOt0{&qdhNwqpy2vR4W%dh7$Lp{jIom$4gZp%)55+^8`Tk(R!c3AHhE zAbg6eS-mmt(8UVa{wL|sQ*1Eaq)VjCmJ^AyI;QUhnSy0diqWd<(2vIa~(Jh(~664#i{KVNGndqINXxJtIT-#mr?^)05;f$>nB@QB}eRB6$#= z%Pc!g*jy9Q{*xx1V;NaGDDNf8Kp)6l!CvBIzHjJ01HZD2#D`f^neBa1C%MW}?_mnG zl0SV9mB;DCAA(BTcd4AOP)Y9hJybrBJ(a@2xx%?(R1Ayp`NorT{$-Em<7#{^dNfLi z&}Sy@7Z7u95ci*9>U%hdk`4a>F@j=N^rkWSD9j)sU4{NQZK;n*dcPcxJwsnglP1Vb4>9o zsqr#%lu6D@OmY9li|`nxW2=mkGfBTD$vFx}BzIg{~bIX0KQXE_De$1}YD{Dk+v$3BytV{%nec8;RrAn1s`ziNyeIrZoK zl<$S-z|47>HJ`Md*hAj^ItNrHA_a(M&au?vn2S3v#hfzReLC@RUT@jIPyVxg7$V4> z9P%P!mFYP)C|6xZI7nR3#Xqt&UlQ+B^a=T->M13wC=K0IT7qcuXxmjDUzRB6;1ry} z23hlEoPx7#%_j}rL*#9zzH{ckkjGVxk;kd0r18j{7pFcYKJ_VKOsn93KLI|@ioyU$ zA)9oLsr$Mo?E{Syo4_cjPu-6bN%>~U`2mB@n@1O%U}g;x2u-r)4{RsGc@(mXaCaiR za>_A>4(cbXcV3oaJTN*h!H~g>#Qh8*7xCShlxmC&x9L$BGfy+@oZ2jKTl(Iji%T!B z9+*dSZWcZtAwK?>Ei5xZQ~I zvl};Jf#o7>Q+7qFdNChkDtVBq9LBg^7t^pPPgMhKC|;|>eZ?}II6ZMs8Ilh0R8^~I zsJxA=P+n!CCo>&t#-Xps<&>%pC^;a?bHETswE(DWLp)U#Ch~ z)%G4YrAtVty$32md%Y+5ThfKw%HF1Q%|2&?!=IwgMO(n|#<;dT}6(@J*zl(bUcVRWk}=iFl+ z&3QdOXHYr(!+7OjViPX(E|fRH%12+zGK`h?x~%MV?np!I`0xepMW)&0MHf^rI%`Or zg%@cn3Wp?cPrb3oeavlUdfvG}w~oBXZeBi-fv-DJzH&#xWo3!IOmU>tLEujP38nf; zVQ4Xpf0!_I6t1a;A-d1qMi~03)%I&1hGN*?`#Oao&${FbxTQ~+!|(-GYlZM2QNtUi zIglUwsr5z?>US0nLxgHT;SmyH1*fe*+o1as3MeD-Ay!*v8=e$U{%cY|ahIS&I?)kT z9)QU9Atx_|TmizaUHSbI)^HQTsP8l$6s9E1ZnX_@!l*IefvoD2PyU{1qg&rpLVKA< zo~fiYLDbs_*a}f6aOM7vCb{F?OqXy-!<(c|=zBt=Fk&}zEp z)@&P&tVeGJG}SAm#8*QSFDaP2GlJFY-NR~2(MV$|@CHILEZ(o6n8$%~ zA~RAm0JZric%!61TKdpNK^tR=K1$$QeU#S8eUt|FGrBn6*h={s)g9lNr0{y<X2vJ-xPTAKW=V-a1)ZymZO9tF>wuolpyH&-x>$JiSb&FNt_s4lJQ?jkz_EO zY;a}YNqSa83u#H(v`i+s(3wt4XD*Q3(Vj#YWB!yghNH|JcL&7e)-k<8k0FBbMEAY7 zE1SGc2JgF@!Djc{-|v0zec$)qzV}=2{!8wg`T2Fqzs8*{-W5+R&o9V-y3XP0@cLYS zf4+kYe~sg~IVB#aYrU(%x3DBHZ{e!^XRKU!DaXkVq*u?(TgQc0aopIJ1CM^^sme8V z>6YrMib|zwd(ZN^Rrv*VjV*56jTX0~z0>KcYw767Z)V_iIJz)zwd${6y8gDexc%E4 zn7T%#u9z;>AMiD_w`_G|@-r%V`E*^as2QTzPu z>Gs*vz{>3KcXbe-`h)E9ZG%2+?4UFjIF$;2G=nc-YDblRF$fk{%Y% zEgnaJc-CD|KCi>yK&ZOc3ZT0EEncRQ!d$11iMl}qds@U}4Z8YV%5e}|jxHIHXdz~y6`L(0^}oz@*KpgJ8c=2;J1>{fR@f?Lef{U&fX zS__zx)6wDI;SadTwomueYv1YW@;121dak?6u>T@+Pxl+%>2xXE8QswZCJvHrj}E6= zfx06Elg{l5Y;VJEbuWrOSA$>K1?i@OU!RNYZ&|3@Tx|0VygJxB>~3ePhrl*ZCwc4W zp5)NqPQNl%-I?|Jo4pN=w&hHj1;<;RY^y0yp%^_RK`aAKZ#H!gxGm7Zz9mtkwVG*- zQps$uJ+H@$^Ynjlyb_ajFE$;@qN;mctZ(;_cYyAR3%rJQwu3}HoTixy8F*02n5w%L z@i|T12%cIh1bu@vvJQWbM$MUiCP!PIbSE!97#hIvO2# z8e*>g_ZTx1RvkCn&K{U*mUS1jKj3Wek>b)lQdgHlIf>ZR{8*=*A7`7>*`~e$br&Wc zt!F!Vk1YnzUjrF#!Ivt1jXT?08kv#^tG}D5Px|8tLZYLY$!Wd2vz;8Db!Va;vQOfn zJC-mz(+he%WGwQ2_ z+G=CT^Q8h@mljnQ8S$^o()Cr(+bfOr#gfFs54S&y`^8VbWys*j6~`H8q_46}9QS4> zmzm;I8Qj1oZf~S}=*ORwB_fUQDi!17z8^wk;7nX7>T<)!bW?YS89Op7=! zoXv4R@5E{vgp#^DU^E&y&W>(aN3182V2bRigMmfDweb7pkH9X0ar|4Tav3VGK>M*d zF+M-MU{(S7CFTYCfA7Gxc7@=1tgKt(bd1!Im0qDON16Ope1E zj|w@^G_sqj2VqSWRTmfb-oux{>$o-O zbMNud&r>O><^|ku|3XxWL< zfqeZsbTAsj-3-U@b?kj&5y!*gr&00KHRl3z%fj}t=tEI)EIgZ7I{!ONx}=P*3SHcs z2fe<5I+N($`liU*SHWqjZ!hiz4vsKtL>o&XXtq=4*XBYK5531Og=7vHB#zn=!B5IUpJxXDfQX0w_^#~c4`E8nkQZ*V zVq7-_*WEKu2p6DvZhRx!i#yYM4^L2HhDDAWUx^Sg-#uhh&G0`r{&mE?HG_NaaE*Z@ z%Yl*jS+`}T3WD{G8_$BaGvNY>7nH^$_91Jk|D^f*!`Lbez46)Ih;Tf%K833hYB4?z zm70Wrp?#!?4fZ$^V5rAosM$yuEl2jG?bxn=1B5NvU4ZNtY^MTGgzg#wi;-|4FY!1O zz!ElZs?2cX15s(50`~bz_hzyyA`}; zy`$KdrM*8knY`21laYb%ZTStysqJ4cBiP^t;D+vIcJ54bUbUXIjzkCeCHpuox{t>h zPh7QRpF+clYsSdHyges5&Uz96PyPrlM&KEsmcGt$Q;>aWNdEpQ$g&^b57`e8wT@oH zONESo-L|Hb!m%aIvA;2MTsu2xjc6vsg$uETq{iB#W{PFb!=ki^E(N z(nBny`7ESISx5_5NZ()~Eo31rVj(SNAuVAcEoC7+$wFGjLds_$6|j(2u#i@=ke=3% zlw}}i8jJL54R;!(H7umHETr$UkP2By#Vn*!7E&1tshowhfrV7@B_w#!!|Q(PMGtTN zFTU%a`x4RvHwcw1q$(CtH4CYRg;dKzdXa@xHw_Xw6j-!dvsb3U)$HfCu#g&ck(!Wj zwCV9wswpDuN8-`Mn58Kqz6sV3RO?UCF(i^3<=M{wc>u(MrilIR@!Ci?oUGx%orDAT zM%abIO%uwggf;)>zhPENeBE?`kZCX^XNO$ek>s;`D<_ zOR2_Erm>W3EE_bI3XSDCjipj!snS@gHI^EUrB-8kQDdpoSYFXswx||$jy0zG!g$t= zueyIVS&HmuK({j=$=!h9B%H+$#d1!k`hI|sc&SiVot{frkQm#3GX;lqq8BCk;GDGN zU@B7<7dVwGNAfl3EC`@ivs&lyXF<_OT*<0RT;=&e{xl!&P2jfqk7nStX;USUj6%mP zY7>Jg0VKT}p}R)&K;ECg8$QdMg4xagI3+LHWe_lTgA$aDM7j5FRT;aXolf{q@tLDf5b`vSqbejASxgR);rO@Y`ma_gnL(%G0hoa)I zLHwInRv5PbDr$*}zY3d(sq>Fv`yn(4(SbE^q(TW5ZW`JO{(~9?b8G@so)f~Ah43HN zvLp7(X`fhJ+mY61j2odLtg2XWNRV*ZHq`S-dL7RJwR-|InSBQQ5SsWZ))m`O_gAv6 z;9TPIj@pKTe~0XsL-*!D%#KdR42f5s?aprg?UX?nt;8d|4B93v-|!r=$Y10KH}Ubr zHD1jhf4=uv!5biQSE+f-Eh8d~dBBJzt9b0USZ)N>crc4YCnCZ-5F7ghXi2f0dC}74 zwSDnGCbGXXm|*}t(GvWa);u40jhD@4?W&zyXYG^e`a-B>B_3^)G z`)w&8LEx`{bB|x;XA|eh$^;Wj>l6>yJ z6#3sSSGAfY`IvJ1#S&a=y)!;r8Qj~-a}eoB=6PIUwm%22!C1k0pYk-FQ5iCNobo$a zf$u=+sg-0td{n|E^g`GQCHOZOR9;oHiLHxJZ7g&;&0mAm{@(l6bw z2Y%i306h?imv9Hk{3VkfmWcv)YvUr%uyNxLLJ@Cei{S19E}Ok7?9y;4E~z%?!ENagawr}1w=TSvW&)n z=0;;oGzKI#8Z-Ja6$(()XiS{OfPhA0eoA9NFQYMCGzN|YG^U!yfEq?)3TO<7Uo<9% z#(>sEW8`bp*g@K&F~?~PC|NY-0F5coVuCaVbSk=?S{ehg6pdL)V?c$XF%}vFY7>pQ zag`c7h)XnPh{k}HL}T8eF(4h$nB6o6lp-2aM`J)3qA{y!OsN)=OJhLxq1(B6g&I4k zJT&GEjR8@I#vG(EpyAM%J{kj(4UO4CVYmZ7=MCJ#u1YO*Ed}iYU50LMK8*nxhQ{3f zPbvhUy3m+m8UrE=jrk>w0ZoO*glP;&C^W`NV?ZjQF@-b+lo1-UfX09jLSvHup={0q z_@se182GE|R;&aF_@q(vg_pH@>M)*0`}W|sYSja98_kFJk&SYdB)_ION^dLR8)45I z_@I&!E{*-`XE*_u$euiq-Tco}n}PIRWAei|`MVJK+lP`;{6__!?cD;ObWzBOe-9_* zZ}KDA!;!t@7U4(B5xEYv!*zMj4A`Vf73mEO?1^B@1>e9+a*D@uwLUD#S5>Z0k}s;4f+U|-FIP))T)l(=sD7IFKu{$4J>>x+0fb(B iTfJA0ln}h$%is(CE`@t*Cim_w*w5G07&!#t;QklOiP3`q literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/bzip2/win32/crctable.obj b/3rdParty/JCL/source/windows/obj/bzip2/win32/crctable.obj new file mode 100644 index 0000000000000000000000000000000000000000..7b2fb2c5d92fe61c811c97aaaa566ee82c89cc8a GIT binary patch literal 6749 zcmbtYeK=(08$P>+wV|b=tew_oV{6tJW6kce#IjVA2&>K4e4KNb**P#w{(NecY~`2xNu9o3coSRIB+4 z2%H+tqj869_5_=?m#frJMwEtz*r3AALMgpYMkup2H2AO$9JpC9s#U8oA{z>;C2*NR zuZ6;rIxVTh2pW6P=5xSieb&lgk!mVW&DdlgWL#$iJ{xI=S(6I_W%HOd)Sx5OT83KI zVM4PFN(|0l`AKMhH7ZRmoD{Y4lX4k_(;ka#lHhMz5(F-U(h{ko6nYxTS`l={l3FdC zoM^Bb)iLzISXOFLJ!6@*pmZck$rvc>S^=OMN=ZUVipF9(C}^%epTsF>j!>C3%&a2? zIKs0SyR4xaRF_XOvSJOD{|$xF#ou7o4KGIvcT}ZDhQSg`2{AkinpiEWVsf6fjsdYG zu7fj7DR6?2kxD49K@!NQd<|Tir!z>8>)>+8n!2>ptfK{>7>Yw@J;2gtS?dv)rE#n~ zfkqxAfFeh&rt&F0&WwGmQ;#UX^GKP7spqU+2J;t_d#pP=hT+z6hIMoSk`5AUizsGO zAnOQ$q|@N~TorAWby3veGRisyv4#S>I-HqrVW37FF5iGv6y9MC0jCGOQEOnj4(lWb z{u(IjSy?knQVLRrssf>y1%|URxM~WZK#W?3AeaN6A2wMZSfy9Pk0iEe9fGP+HZWY< zBef*W(|<91fCjTJHfn28WnC8~gqG<6tP>aDWMFjw(>^5NHcbOr+XOfuWg5y_i}XFs zHVCoC(jwMVOy7yNU7C(;_R>U=IBIp9qK~aancBgcUfXpd%w|3q!aP*i)N+(gLmJDz zk3l0r)zQFB_5f*P8A4o`Ovi|e^-1wO)Or&Mweb_QX?`#jhN)~FkhL)B(`s{>KDHNF zcHhnm+x34peewcADTg8vRDTV#ePSO^ut-D|P(~#h1HoLMSu-I4>@)FT9ZQg%=L-b; zqv|nReD?zyj(~0G-hZY+Lh6)8nV!ihKkz!eJpK3mtQ~k0sosa!OOlVBNajSvM;`;v z(UHlK9Qwl{IyN!>cmhXqG%3jr{2`~eAuR~9Wh-KR;&AM3Pslb$1Uch?IBeK$Y(*+P zz&kr6M^l9ouni6pCe!<1unI;>oDihmKrgqz$^PfR1`Y>&Fa7f}x1Xa4E#Cf_Z*l(9tl+QpI!q<8CU;RN{#YK5V@g9xM&R!nfBfBqNDBbeJs@UE%>gf3H$dL24 z)|$Nb&Xik~mF_uTl#dxEr>j&%U!wMkU`9SsT3jw^g($gZM zBGNVBj#ZbXyH_$=9*&Ms)YWD2Dz7e_fABkQ$4mlZ_~ss8(Yf%@wZ%|X`^vq>oVDW# z!ry1(R{oSM_Y9t0G`$fx9R7iMd}H_ybJr&aYV$u_>SszgsO;$(` z4#s1`YR7`R%7#v*x0O;0?c&@N7f$?Ft^?vjB6G}ryx60qg-Ci>R{x1_B8rbEWklWd zXejr}t9+;SEF<;%W4W38j>dV4eo2@R?l;z6Q>#i1^&NM&yMK6W+qH`|7i=u2T=;u~ zn`>O}=p_%ym_;D*!*0NSIdHvgW`wIZof~r zG|zoJQPlK>whsIJMr^>^7hblK-aqaBsc(T>h{+K1?S@${1 z)9>|lJy|%N|M;L(RGVX3tA8r3$Os&Y^^3a}_uKWQo6?H|-qzNZ&}*9#e5)wKVFs_!va@Yg)f?-N~%D-XoT%5^!XD z{Ri-K;##-NlvMY-Nzcm!>WN*!Vf9;!y)zxs9Jo&3drj@Qsk!RlTz6v7HFa*`B}Jnl z<)bxwLq<}(zg}?nPhK6nD&Mzd;QdfV|D{~sdkx6^J532~;}^vd9}TMlzP#1AG}%Ag z__c9d`rUKOKJ%9?&Mt9#o0gw$z<#F8e!sm{JGZ`lz3ZOWX7bCk2SbWRCoOk=Qr2@u zUTu1`yFI+hxoxB7dDr&m99(i*zvKy<6{3~L)L9)ppBEas>@q|zbwsQ^kCf3x;4e&& BXgmM_ literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/bzip2/win32/decompress.obj b/3rdParty/JCL/source/windows/obj/bzip2/win32/decompress.obj new file mode 100644 index 0000000000000000000000000000000000000000..897f394244520de1b12ae7473967f0828d6d3780 GIT binary patch literal 17163 zcmc&)e{_`9nZC(PNC?4+HkPPyjT&t%h=HI+16zXm9N;ibfDA#!4f!#cNPd}205u{x zGqW>yZpL7nIJ5_pwXD@HJ*B&@a=NUYi7X_@RuVibXXWe$mfED@kF;xPl2T`%_kQ0@ zG7z%)2F~d@xtaUj@4oMS?)yIXy+6LY>t1&E!iAgEzlxV?8W%sfXkpI6M>bX2DjVt= zn{3U^3oDuDR>s)PPc&57%(n8T%qQm0&wO~{W4X-pZN>&?pr9sU{xaryn6aVF`)_~r z!Q#g^g>`LOS5UaV#JY3QriT~iY^tcKCnz=bm9;HZwoNs4bqlLwkgKcQL2`LodpR?0 zZ+lIB^R`M7eOwb=JX6tTdsBIB&2#l6{Fo-ZXr{ujbX`^Lb1}&_)Y{5h>PG!?4ugyhh~bop*&W}y5=2qvQ7O)wl!@7=4}L6w{u}A4Y6*~mZsXe2I*SeW~zLy zrKT!2ycN&KjJJMk{r1?X*ii9&MR~K05I>?(V&RM_QEOWq6PFsBnyc+3shbfrVjCM8 zVxtoY*Ht!2_r%h2O+%$!wyc{_O^ub!pFC~tnTKDKF|Mv&ds6x$e5hc1EEZ7qma zRoY@6^^m1zb@LI;lAP|DpuQqECno3A)iuA^Y`4i}pYEYo`;u)(V|l%d=ei+d{Uyhq z?is$S%BC)7bXymaWF*}!R#s^Y)NLUQx_X;^`&MdJcTjAyl{c%aAl;&9x5*~gx3P$B zv&A;v&}wDufa_~xO-1-Epz3wn5GT zx(6=g%4=iWNR(kW9TSlu2P%`OZZ6V3OYbs)LBBFo2 zJblt{PaGvyR>#z6S$#{b+&=5}L>asnbCTFw;)MamEvxKq|Wn+o)iK0RU`ND#d0wevKRcKyUWGyz9tysU_ zfW-DBviBaJ9~aMLjxl3GIG32j*bis1Ss_Cxp0!(8a@mTf7ne1Cx23L`-6r$Z6;EI} zXtx#Ol(@=PQeIJOYi1_-iU!z@RrU6UC)q7!6)%<5(1xkLytYiP6Byh5O~&HXsuO3- z%W=N!nZwvyEp%K4TV3(A-)M|u%qlLf7nY>l0B@^KVJtV`d%YIFyB=rudEy6Ds-dxKjSfkWS!+JmN7`Se(}t+AMb{I+tH(6heGQ&l!{l9L?Tzd5~W7Rc(TbA0D|0J z-jOy=in%+Te*3vUgMLw-sg-AG<=I;K0;FD5x+vB=avy6;dAApkodWEP{ByJl9Gzg8aFfMy@j#=MN&Z7 zKOh}WXRP`*#>Vet>?eQ4*qZwo`wyhe_cQieB>T4*n+f zZ=Tc5%^41JCTJUC!W3F%L}qysDy>d(^|ri8PbtHGR6Xq&Utv%F=ue?gXy_j30R(iG z33H}nG^zDY4MJ(g>EE`Uml&+=Du(uG3}2#4x-jfhF}$H-csh*XP3Qpz75cxT{RoH88%zy6s~iU*@WWc<}6qaWH5pZ#Go%gOkLjlq3XTwi_$E|_@dS% zQIzEvdu*phq;{xtG-Ty?&DqX?$=L=}&&Q!^@O*+V?R%5|4E^hb z98KZwVt60*i?V{}5_~Cq@?SyU*jj-=T)cqfLTgol5(o$><_g%8g`b`=Hr9UhXQK7j zSk4S9P-xBy4kY-DyC(ky2jZz|v3ddN4Hc^j*N{R#{fC-lRn3P`17>3AhfO@y=-8z) zb5}GoUxutM`$oHYp2@l3E}B}rpE$-A!RME$U-zqk5QD;i?!DUQU9G4pG3}#VG^`8v z>V)N2-M(8Lv;|=#d!YxWK_r|G$&LsT%0(l2`udPO6-IK4iUjd^IwbZ863Rs*Id#u< z+2sB(5)bsiCYTYXL(&*Qf}9!#lCA*s2OG@jN?8!^yet2Ba!Id3ef^&XAM6LX)dI)aRH(a7%6i)@cdM?8jm#LWbS*4cOiV|i%@Hh=i^h_Cqp{4J9?PZ( z7Rp6q*@*}i6ML>@7c8*IE-PDUs#_&!jp8^T$GbM7=}=Lo*F_nRITbJ_O?7|7T1*#= zy((3@K-AJDU@6vg)3CGzZK~mxa?uuOomtar7)Y5|u0_aNx@3Z>63gw=yQ4S)hH}wh zE@54&%MRheEUrRv$Mh)HL{LyJ8b#v`LLtmcT!B}#iSZ6nI@M(F2qXi2es{Ry?=vv= z16&z_Tal%O_iDN3T_qRYj)6GtS_#a=rhSx&2LDfx(PhH7R4VPE>2r0Q5i(WFUB&M_;FA2NOf(Vx6QS-}=%$1f=C|_;dj@&j z3a1a`_qFa)P3DEZp%>7Mm)?zdobzt7sdOfOpUv+vwSO0HkGU4&Kl63v;D>kh;0$K? zcHyI6uYBc+`&#~nTvUd^)I|bnQ=ea9g6~ncl@W{%YRe;QVjb-x39oZ5HQ{kRg#TeR zzV=(`k^AWEXZTLxqF*7Oys4hGabHW(kSxdzsDNC7S3mc5k(ft<#t86Ar5>m02q>!# zXw@n0_0$-gGAMA;Lgq2~0&$W{Sj4DYO3=vtCv8%@i+5#13gk`@F3NG`a5Rw~!epq+ zRbg^tRwKH={uf|>-+e$LtcO<<+YdX&(!y;26cay4gr%q&O}-(c39Zf$Btai>CYm~L zp}sCW@2QM_8`OCb4PhCtM&tjlp+{nGs3j?+93Hv}<_uX556!|4dE`X!e4?SxXDkIn zy_UnC_SDV)pn8y^@`e0vQ~MWSLcK+cK9+j*I{giUc;wtL4vh*LR;{>!SH!o_sMgNtrM`s zso+4Op*uKWFdR?V+sjz-gnaOvffUsK90~@}YvwpAVOcKocK_uuGA+!A!7xCkJw=19 zLmt@n7tk@IoW^r|CvVx2$Km2}PH@2J?V=a)-59g2*yM*~dB{hFLdsx)aZ>n5kLV(q6}+>9mUJPt zOlm`&H)%*66_!)3UX!a0I6^oi#h>+Tes`-jdAPCFIj)>qjJJ4&(9@Ynae`Y92+INC z>>#^vWxv3)%16!MWJPY>D{vG#+2rI0u5^;DN+`|f=~P<%=TrjWmgft0z5f$!rm zOc%5p#K5K0ZWLuFGth<8*q`B0R9H{0HaY*Ejz^V%kWq|g9~t<(dlTui7@j{C)<7JB zs<$ZH*=t`RlmO&kTOs8U;CisK)8g4Ngjn?eR#=bHG36GXQXEo_hVaRUq+b2i&>Sfi z03}~zl(ifcO3wrzol=85cU3j;l--jRd^&XEGPVT&hJR=xs_|7Mih;yk4E+&Z^q)3Q zj?3gZzua|q3m+95g48=icOmOKMh&LFeT{0JPzww_+;>^7_vk+i@-o$xMcT9=T=GqO z;!9EsJ$Tv^C#pf_#mO=g)x7PAJ0{CeHOEg0l~D!f7&DmMP1FSm&K20USj~wOh92?H zvUA;rW8QW`CBGP8|B1%c*-F0F1h@anvv(d95B;7xH_0x+L8IfmiFX;PnNGK~jgKA- zeO^^$*yL@WNB!}%OBJg{yR4Sq_v)7+r_8znJF`P-DRk_>#HH0)>Ft~+NVHQj34T8l zlH?Ln&ZF60Q_`~WxGM=w!+q=*^#3sBgpbNZyOi^#08JeAB#dSyX4td76>(}c?$l;r zDI>Mv{fD%_CO*$2B8LjW;L>bozx|Hfetd4kcG7!VC`U~nbjtTzcv``5I$pVneRySw zyy9sda8M|x!28HlenlYdhtOXpkmAGP3JO zj(&EYJFci69o=9b8Z1pYW=>+q-J3x$csYa>UA&}ij$1hGi^Ol zc9A2F0aI`w)%0Q7YJAGaX$k%`&^Sh$Bw@XX>N2Kv+Br9Bu zYsrpMNWG?hfovC}d;h>y^>DJMn&676sEBh^AsZ&ZG$KaeBNv_TVVJc z_L`i(g!6I(RG!95)A6-enDegw;G5sGJ^3(=g`w5(kWX@TohZsv_mbSa)NwQkf|_*( z@n({B!uBl63tLCp)0`KQgG89qu!6?MB3&4LXo3Ms$eb=p)3NvlO*5eWifyo6Fw$!v@1| z3OB_4_$M0-YFNlpzhJ`;pk#)3*Z*K=EvLATwV?|h;>O5q5{%F zlD;vgFVkFu;38d9l(woRQBnl12`n-%9bPl#RRi)%U)V2cGX{d&5pxp|kk%0(l2@cNJxhmrgmF#|SPI6acH z5hRq0M)D(Qh}kA>W)oW%`d}==v zfk?S%h$g)dBVRB5)b_*&O!){XIn$f#vj`T-MPqSL431@3iECh4G(8qNom7W7<)X3t zkwkAKmc`R!IT^u1x#1Pz3xUSmOT+cLfJE+cUBf6e`+kJ5!G^zC{dd@+4I;~)s(w3? z#XQ2@X*jRK`hok?DPtMr9T}8SE^v3Id^N!Rbej}kL3jt-7)#< z5cktfH4!TV$ly^aW`RV}o(``~=+0Q%ZHYxTi+)cMh#W5W0aX;NB6_!rkLH9|^ c{^l9+>t{b^`)0FuR&6l8Q?kLx1O@>6KWA^#{{R30 literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/bzip2/win32/dirinfo.txt b/3rdParty/JCL/source/windows/obj/bzip2/win32/dirinfo.txt new file mode 100644 index 00000000..21f05f96 --- /dev/null +++ b/3rdParty/JCL/source/windows/obj/bzip2/win32/dirinfo.txt @@ -0,0 +1 @@ +This is the directory where object files of bzip (http://www.bzip.org) for win32 reside. \ No newline at end of file diff --git a/3rdParty/JCL/source/windows/obj/bzip2/win32/huffman.obj b/3rdParty/JCL/source/windows/obj/bzip2/win32/huffman.obj new file mode 100644 index 0000000000000000000000000000000000000000..0d7a1fd798d9b0e90934d4c3308821ef0d58e64c GIT binary patch literal 7215 zcmcIoe`p)m9e=9MiJExW4R)7wUh$y&0bUf_s@tYlgDm?ftQE~_U)rorwbR|jQhhq9 zI?0ZWBhQfyzCK?Ym@~#mS^gPgu)zjd>5mNJxa3z&kvua@6GmE6mg2xl6R1bD-oEeM zIW%LVes9d!^6B3De1Cqv-}mDut?0pUc+mSzj;C{-yF0?|;YS8j#Y2ZOiWyeXY%@aW zzTT{+KdCGE*50vY10}}3G{Iv+PPV%Rmdww zddMW;y*{{OvtTuw$!Nw97dC6?O0kgT!shbXTv{^-_EF#FJ)5;TtMDQ-*5M4*$sS}q zKLR$75QCYM3xV=2W`-8?MkY&B%N!FH>`lJJZLc|Oj`C44n|vv$SUR!z5uXy_ zO;f_qJGr=&%Uh`eK{7LfRBSGr<)ae;XVg4R50B<_RxMD?%!JD4R7;^y=3W6%(@N*K zC`GVZo(no!7|ZDvcaBuW3o~=1AV>Nks+SpRs`;@Tr4=(Yc?ZhFi#uTE1@Gl7pQ~w8 z(RdSUb!z${?!;!*VOsOdJch*P^gN$pE2SHTl1p=04Mm_>VLD_vqV zbF=`esXBMn1D2>|<|C*jIOdhWOh($dl9S0;V^%?@+dk&fGsgA9ImM*?oY`d9f6>}w zUg0%O_qH?4(FG(460=5C^BKq-At*XiFN_WowaiU1uPc_f3u1rtw>;1hov+?N ztIBV%Y4Gu(Fp@3ORfoCA!QP_f`O2KxoR!Kc>Tm~FW z^;}`gBvn#|1k1jTaU-GYn0z~XK>Ar`CbU)1lsqLDv#0uD)jNrZetsgG&W|>%X~X^s z$V^P)ZFZEdV-JDm=6l<^TmIucUvk_?C%KXc-QT3QPwer8dqg$Gr8Hp{4SIZL&O`#T zPvgNHOQ_C`2Ep!XLG$DLeMrL-b#2`b{r5B^a{2U#QlK^U9hgooPrveZHV6~Z&%TH1 z5(Con148dJeG)wP^$hd~ztQRf_aOR&kWjbrv^9j# zFSej9ZqU64%{8MPiR5@9O-?xErqLGRO57#&cOhHgC%Q)ag#^vfc-IfJnM z+qaW~5I{)AH>TbdK6Ty5^1i8ePuzB0XXf`eUAKS#bGEdKtO@cA8JyqRGuHoV50G4az+W}|#I5Eg%O}~A~9B+~>UBmJdy9mB{pO(^!_3!_sXA|SxG$wzSE&g)xKAG$QE z)bgp1$QSWaX$J-&^HhTOZmki=Z{76<$1AbzXM61cmR8OasV?LQNU#LSru3TkVk%$7 z@vDv}Ywc@}N?8#6#|IaoHTZ&&d4HT@o-c2VUV~ zi_>xx0OC1k;HWV9AS8Ue*7kYuedlF2c+rkT!AB4S^Tczdk0`7@isK=Cuti*So}Q{X kO-Cnp;a#}1x4a+(FGt({YCk{#WW4k@2rdKzVc-S&7k5U9(*OVf literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/bzip2/win32/makefile.mak b/3rdParty/JCL/source/windows/obj/bzip2/win32/makefile.mak new file mode 100644 index 00000000..c1be9528 --- /dev/null +++ b/3rdParty/JCL/source/windows/obj/bzip2/win32/makefile.mak @@ -0,0 +1,106 @@ +# +# makefile to make bzip2 .obj files using Borland's C++ compiler bcc32 +# derived from a makefile generated by BCB6' bpr2mak +# +# if bzip2 source directory is different from ..\..\..\..\..\..\thirdparty\bzip2\bzip2-1.0.6, use +# "make -Dbzip2src=" to tell make where to find the +# source files +# +# Make.exe needs to reside in the same directory as bcc32.exe. +# For example, if you have Borlands free C++ v. 5.5 compiler (available from +# http://www.borland.com/products/downloads/download_cbuilder.html#) installed: +# +# >C:\Program Files\Borland\BCC55\Bin\make +# +# or, if you want to use C++ Builder 6: +# +# >C:\Program Files\Borland\CBuilder6\Bin\make +# +# or, if you want to use Borland Developer Studio 2006: +# +# >C:\Program files\Borland\BDS\4.0\bin\make +# +# To choose the target CPU, pass "-DCPU=n" as option to make, with n being a +# number between 3 and 6, with the following meanings: +# +# n Target CPU (or compatible) +# -------------------------------- +# 3 80386 +# 4 80486 +# 5 Pentium (default) +# 6 Pentium Pro +# +# Robert Rossmair, 2004-10-16 +# + +CallingConvention = -pc + +!if !$d(BCB) +BCB = $(MAKEDIR)\.. +!endif + +BCC = $(BCB) + +!if !$d(bzip2src) +bzip2src = ..\..\..\..\..\..\thirdparty\bzip2\bzip2-1.0.6 +!endif + +!if !$d(CPU) +CPU = 5 # Pentium +!endif + +# --------------------------------------------------------------------------- +# IDE SECTION +# --------------------------------------------------------------------------- +# The following section of the project makefile is managed by the BCB IDE. +# It is recommended to use the IDE to change any of the values in this +# section. +# --------------------------------------------------------------------------- + +VERSION = BCB.06.00 +# --------------------------------------------------------------------------- +OBJFILES = .\bzlib.obj .\randtable.obj .\crctable.obj .\compress.obj \ + .\decompress.obj .\huffman.obj .\blocksort.obj +# --------------------------------------------------------------------------- +DEBUGLIBPATH = $(BCB)\lib\debug +RELEASELIBPATH = $(BCB)\lib\release +USERDEFINES = +SYSDEFINES = BZ_EXPORT;BZ_NO_STDIO +INCLUDEPATH = $(bzip2src);$(BCC)\include;$(BCB)\include\vcl +# LIBPATH = $(bzip2src) +WARNINGS= -w-par -w-aus +PATHC = .;$(bzip2src) +# PATHOBJ = .;$(LIBPATH) +# --------------------------------------------------------------------------- +CFLAG1 = -O2 -Ve -X- -a8 -$(CPU) -b -d -k- -vi -tWM $(CallingConvention) + +# --------------------------------------------------------------------------- +# MAKE SECTION +# --------------------------------------------------------------------------- +# This section of the project file is not used by the BCB IDE. It is for +# the benefit of building from the command-line using the MAKE utility. +# --------------------------------------------------------------------------- + +.autodepend +# --------------------------------------------------------------------------- + +!if !$d(BCC32) +BCC32 = bcc32 +!endif + +# --------------------------------------------------------------------------- +!if $d(PATHC) +.PATH.C = $(PATHC) +!endif + +# --------------------------------------------------------------------------- +bzip2: $(OBJFILES) + +# --------------------------------------------------------------------------- +.c.obj: + $(BCC)\BIN\$(BCC32) -c $(CFLAG1) $(WARNINGS) -I$(INCLUDEPATH) -D$(USERDEFINES);$(SYSDEFINES) -n$(@D) {$< } +# --------------------------------------------------------------------------- + + + + diff --git a/3rdParty/JCL/source/windows/obj/bzip2/win32/randtable.obj b/3rdParty/JCL/source/windows/obj/bzip2/win32/randtable.obj new file mode 100644 index 0000000000000000000000000000000000000000..d0985d89dacae1a8c0e7fe30903fce00d022cebe GIT binary patch literal 7778 zcmbuDdvF!i9mkK5@UTp0uwq5~z={YHxy^$B@~{QMF#aK-Ar#b<%ii4$+1z_~m)(04 zh&2SQB~}#1R-kAhEm{#BLC1F$2W_1}lu?SsQnaYG*0EJf+RW6p$nu?%l`FUzTlJ4oN{yZuIPL=1 zipI^WsTtRpxwJv`Pg3d+|2uzubB5PD+bP+HhIyEw$qntYnjuuxOGWyU0Y+O zwk_xRG7-EuHgM2RrA$GR-W;tBc8)`ityFUCg;l zCahgt7Al>wc4|2)6oaI++RJ3GEPIaGd~=<~^Y!z7w^=I&xz3ywyE5acX-i}V-4X@2 z-l&(tDDEgprglfjjtzsrteqseXh%tTOh)zsyOfNq-B3|z$5xW6eO8d_$6jdEQj+UL zMycJUHK7|D*T}Xi%dEXp)W~g5#??;s?PyJyw3T*h?$cD0zW6j*`+>JAFuPUHw;a>L z#`TWdZd};F&L?|byN@Ys=tgD(#~p5=V1=I1tl0!syv8?s%*zfcxsll(s%%}EwDxL| z>e#OFt|wQ9)$T`zl|1byfuC!rH7ZWA7_W&-Zt~ivz4Zz`?&^@2R--BN{*~-K?I*nB zxRuu#?bRhyrm8)n?W7&3y+Uj{-z|0LWmxS)F>%D9o6yx*FncDZKzjZtm$ z3Ht@JekgSX<>aZOy~&wxIj-ERc4fo3Bed*%ol#{Oc%@@@nvzO021$WTZus=eruGfz zOGWcnl61AE%W7$loFR zYV$-@oo$`JthH)hbJKj}ra7&1s^s6WrUfm{OBPjS=Pq766sWDk)jdj`F+^3Q5mnWx zq=t`BYTGb1?9|XxL)50x#GIL(dsTflT39Z|d<_cwgMMn8i5BJy*@WzpY*-^TV4wujMw1;2)VHF7h)pCcE+ zW#Dprx4_51t1=FF2%G~x1U5N`iP?y}iW#k%|RZuRx6Tb}}7e=pxm&1GD ze-L{+Ep1}SJb{?^6 z2sv`U`;g1nCV;8v6Tu;DkAXeN=Yu|cYr%`)2jC>vT7bP997LW+Y$q)9eF1qhb`OjM zvKF=AQRD%9bCC~&X5{hMR=__b?*O*@&^N$8g`WpcW4{boKzeroUr79D!qEempw1@ z`!;r!90OHvph^oq1*8ps1Y`-m3m!qvlXimiN#GsyUDyvH?*-CMf5bKgo0R`Oa2OG}@Eq)4NA`e}>?C?G_Pde)!kCYtOIZVK&!Epj?gMgs$~<`}CG9KYJ`1*>A0THx z_#*yi(LWDo@I3&_btmDIBWo#`j_rWtfjh9vk@QV?IV|-mfSJezY~An?bUCiBN3O+o zIgmE8#14Oe{m<|WaFlCz!LmgMzy@Muo60dKTm1;O6LM|%b#%$E1JZ^=#E$$BJR5%t zwx#gn;7)8O(O2P@Ehopo``F}oo(bewJ_jC${dQQkY!C8L?6Z&;5jz&W5v~Ex0l9u3 zzOR7`(W~)~f)BwLftP{QM%Mc_?6QSk0>1^fqPy^oK#rMr!G7Wt`UK<^K#o6|!_ZDAj>#gh+B_73a$p% zU=yG8g@axCYajNzkUz%06?rf6ejq&{+j=DSgXs0(4s23?8RvC;lK%_ze-h&Y+5Roq QuL4r5U2rck>L&U3FFwO{*#H0l literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/bzip2/win64/blocksort.obj b/3rdParty/JCL/source/windows/obj/bzip2/win64/blocksort.obj new file mode 100644 index 0000000000000000000000000000000000000000..f361f77034025c7d49ee95d9224f326146ce56b3 GIT binary patch literal 61519 zcmd?S33!y%^~e8C5+H;n34-DtF)A)#Sc<4rGnttrBa@kNX2RkRJA@=aB%4_fDCj7t zAgEZW)mklW)mmHYTDMw%&|1YVzglap-PP7ginU^Ei`vTnbMEraJ0ZA4AOFwu|Ib7C z-h1x3_nv$1x#w>0%-eL?FsJMG!q_Rh9A~nlKa-ofnj3qTH=C$)E`gJLHfFG>#F^aG zyr_3cdD5m7rX6PkeAg`0lmt-elvGV_YUpXOOyErZe%R`f8B9>w`;ybfl8;Ma`K8?zFO$T-_Shvf5oTUk+QTG z{EjnsAHI^Rva+(1gQ04FeIykLSDiMYx3{Hfa%;C=m@srcF(kO{z&w zDw}l9DP@x`XqsLzVtbTSnT$8;<-FCI&zVC_Cteaa?PcYK5nD4SGAVc`jb z)JQlQh|~u|69y{6qt0Y-cDJjd<)=)Zvf!g;T(G2-N>hQdN%NfUu106_RD;bPZ{B)DfGe&j}Zo(&Zb2l&Vm*!Z=6z5!SG(B$HEkx$uy@#jRhGG@;N-u zaYlmUz;B6Z>rd4=Q`2eyBpCqCVa}M6^)@LNt9;IAr?hl4)a%F|^L0C8h_4`CHdNxO z6z3pl;)~=DT5r>m=ALkSOOI1ZLZ_Rsyt!+UGY-;HNJpvs=l3==bv3kW&V`VB6?t(_ z!y@MZIOn;Ub*YTY($cug*V)sh1QchbD{oQRf^NKBODIxTy2J|>H#GJ*c@A|s&Kvv{ zqC5K$oxP40<5_lXaer+P?Ak*>Sq2LMN(cnqo9B>kNE;toz1gC-Lfz!eB!5QEM z;3?p3;OXFZz**pLz)ypJ1%wuQ_p8mp>d_rXNIhk@~^?}EO z1>h8L2sjHI23CWN(M$v^0_TDwz}4VL@E&j!xEmY|GA^BBummgx4+Y17$ASldQ@{g3 zKX?#$4LBa$4jv4?1|9-d3}LK-mEhrEJ$M9oD|jUMORx;g!;>5Z20_MYCIyy*E#PtB z8gL@`74UfQ36Mo%=KsJ+;2Yp%uymN?oD6;jtN&k$`}uW;tM{7PN($<5H)UfZHbtuCpxC(@ycS?ZFOwx}W4i;2Oksk9h>t$TgR;}u3>r@`2KYJP;KEl541F$ojS@!ks!~QgkV;LlT zWai%Dvaej(t~9sVL+PBNNSnN*sr$4orHd0`uXj1KZIfBu+rD2?b(G;{B)G-RVkOw> zp%@9iGZhGgku7+CmJ$eq`K;Up@tb^t*f-@PjgzmV(EE=YdneWguav z4O{`Tp2%zh&j-H`c7e}<-QXS&W61m$yb#1kITwNW2nIWT9lRL)3U~?l1h@|TBX}wJ z4tO~@6uVgumVz6=W5FxH6u1!-yF!M{_rNQ`--B0yFM*rE*T8GQcfrqr`Ly*~a5T6D zJR1Bwcs6()D2De1@DcEO@HgNM;2*&o!Cl~&z<0o#KnKga859frGPoJs3Vt5^DtIG! z3wSqp8~A5zXrLD8I*kW!OSzN)#aLn(DD?7F*TQ=)tW6z?ucc0PAQ8(`=2kek`v`D}xv zyVbMU-Qg0|Vpn!ZPYVf$WcOXFKNq-s=czemo*QR*Eghb63Ck2ioOl^+iuqVniV;Oz zhVDgbe^=`g+I!p71kc*rgrtVw{y@E>uTbVMP}4WD%nD3(bASBY8CJG^Y@Z*8pD>4$lv5jv3$7_ zbD>LEy3ZWQah~&S#58$Zv#c$uu%#}cwPT;m%c!_{w8|{~vBKqDv?$rKs#%HN<0UE$ z2y3TH?OxilxTia3-nyC+55_$Ch~Z>h-iE2Ya-`R+=E~KOweruO)6lA9lc`7kWUP*t zfo(ow^D%Xd=e}KWo!)xSuZ<9 zAnR0T1h^0!39bi6fnNpj|CyhI#o$|D33veGvJ|WW$AIU72Y?;mSa2ga4*UvuAoyeO zAn+gHcyJGRD0n1oIt)yKhl9((BS2aGm4UKEVct=DgJZy9wEbA{An-VFCO8pn0@;6L zGT;f|7r_(3`@xgIKZBD%2fLjN9s-^W&HyXGCEyfrEjSgt37iH#0!{~afvlx7!x*eH zKyd@7fM!!@p;A`M7!Pmh*f^UE_=luhe@mq^cSM-}3FF_x&9u@sul{+_j_H_?o%>#Ux z9c7)rjnv%9a0itBli}0Q`b~!77N3W_&&>CNOU&*7U6R@XO1-bUq$c)+QrI4$Fj8`- zN0+Tl%?1MNteR;QdX0wRZ8b-BQlr@DovuuGuB|U?}>PyX53>FhN8_3u3xValhk?jSj*`laY zh;jPV!x~ftRzlPQGyQqz-2WlrPTVjb5pJQ|u;O^ z-*@2QBc{;fvfGVbr-x!TdaYj4z8k$ab#YSr3YRn6wt=>qf5+C01nb-^R)UO&VkB7Y zCG9K0beu9D)%7mt{v}}V=iH0`UN+Rr{=4gm)gk*6?nAKi+q7^0Ljsl)dX0!4~jF@XO$rKr!5#z(Qoa8DwsEwt~#T4r`7~ z82l<21-}L|=Q+24?cl8-KHs?w6pQ{k$l1ShJII;5a|g)Ty7Nsi3VsVrg4CH2lm0gN zC-5$CCwLDiXO8!Q?}GP(;$FT3o((<(UW#Qs3_gxYd>8x^_$WA>{(cOs0RI;}2iykA z{QZ5Q({Dcjp93EUS2Hg@0bT+=39bj90)GYm2t1a4W38p;$)A8S5BwCA`Jx`3_dg3{ z&Qp6{@nQYui+=mvd6Y1~$IKZENy?owmO|-2XLLdvV9rzzrJ4L{b!4y%cM6`m2P~g-aUJd`(;POj?@UVR5|?VZk&xvRQc=*NMiUg-*PoD z3CenX1^Trg(W{J~lOVJj`rkN{9Z!5WC`G&hO6~syMa(zBX7FEN2e=2k3}nrn;atVx zoG0@w@IT;#;9l@45E(MR0es*~U;#LbI){J@!J%L$I1IcTECe@!jJ?cFU=jFra1{73 zI2!yBSPVV`jsZ_%ys_rb$UVhaa3RQ@Q|1EjKyWp95O^gx9{d7$DEJNVFz^wOySWTD z?UaG6`JJP{N|3RiiGxRjOTcoFwWo6o$Qsf)7Q7ss2wn#s53=@iP5{MjPXxujIqTK#f!z70GML}!^4_zh6zf;+%Rz;A+YfZqbgFeh+kmN^r=3+x5&25$xL z0e=tP3;q|pA3T9M;yd6%@Bwf$_#h~Iu7|*#;3MET=8W%xv%yEf&w}3r?*ktLe*ta- z<>7?w;0*Bl;9~Fx;LRZCXUG z1`fqOp9T*Dp8<~pp9N(sV@qnxUyTi(*l)~tLM!EO8GqM!#ysnKeXS) zB*|aQ*P!AP-S{Hc`|EUl^GmYfH%}$VIExF_d_*1@XLPd@G_+cLmdJP(I1`)=R)Y~R z2G)U#!5Ap*!0)Q|wlX-6c7~Pykam?iRpDqbnewOVlj*8ZO*mQ~kHq}Jpg-luH)y5< zyiB2J(8FTO8S7<eK_hsdGY!aCJBo ztP9tLQuE^>{~Uif;;)K?I91l{2YK0bO;Oqri9})ne<~b{y48;Nat1@D+G9;Q2YXYc z>BuCt*7~EtNGQQ}XISZWG{t>r6G!(;dwY1Cter_&i*blIdmt7~g`zwpm5j%dVG+Wg zO8En|&T)qOupI6P$_eU1U;hB7Y${WfoYFqEPc>6kLZbCj3I9|(lvsf0gT6H2<(Oz?69 zVzJrbP&$bs7*<+KN9Qus#r=U)Iv$IJ1M|}e9SYA01>Lrn=Q8Wk>f`Z5D4B%K>hjou z*f8W!TFdA%9=Bh{MCdHq>M~B;FC&_%i>J6n(9N0bWsHXs$#7EoJ#Cuqw#aI*!pk4P zATYvcDiMpgB~HoV*vE{j!;z3Y`RE*PB$(>uSG^jVmx@RH;b>hrS?5n-bJoD8d0FH2 zRgrMAHk8QPk{wXfy?kQA5&wLtGs{_SD*u$1GntIk&r4&QRSdk@^p71GGjg~>35Imq z+F!Oz%Y8}?cQjmG9SWw61Icn9iUhw_gRwplIVTnkB|2NY#9}Oh~{&+}@DPbwJdBtHV7Q-Ok zR2YUEhPXdfo36${m0UKp$fP2xP82pycy!(oCRO@Fc{nL>q#-6%U%BK_mW$#C*}Fa;cF>C`fN4<}01v0|)2iA!fQnC>^Vkk&ht+YQ@!wzZ3?a%OJ*; z4n;z9^jsnW3qzjEAgW8NNkR&+>G`?oNik$em!Tv13*7X%`03bOyk9bv2;*>L(WDx( z!Zjqz6{?B_@RafTc%47$uL&vpI>eMV)a9#UzM2z`C6aDU!`w8+vdo<6y4h(vGrKhv zx?IvXkvgT1P+EpE(nX!aO-;jHK06Akm><<-ECLs~$+kT>;S^qdp6LmYz%g16Q7EOCvFLRf$jCNUUv$ArZYq=D3r6K} zg>SseH?J-tigpd-U^m5zmI_69Bt2`1wsD8JoYkQa0^1RDs7qH93`09!ud*{CC+Uh| zrS~C$&j|$50Ty==<%@)rC#1S$fUd@}*=B1_MK&~XGs2p$SpAk&yrhr|gv>MVWRIv$ z5aJLaR>!OT$&{j7=AnvtzSI@r%2$^#OcflTn=4tNp&BVg6YnO8v^|>`j?Q5MWup*sMMMYLbRDc_-HwrqmR_XZj?Ql^3jrpy^$6T&1GfB>P}oo z8jqi3T*^X6STH(R_}LcOBN7;!7>c ztw}25R3yV4QA`yJJT;b1CdKD4naD`5@&{yAW#$zNiN+Fj3>RtHPPoQ6^<6FE>DVHW zDoYC0_rFplNLsB}b~xSrwI< zpNxm_sVGs|o-DW}CEqbA?lwi5BPj(o1trvQ5+Ghi=tEpO`eRiiy|0A&C5e?z(x0wt z?pfN=q|_xerx04aLB7Y-!_z?1DCZ%_d5*N0jfz-KxF(JFjYh((+-MLd2>6XKJMu)t zAHZx&osp&Am9o^QrM1M;z3GXN z-j2)sZ8!A=UIum8VwXMYxW%5O4E3_H70F?;JL+Lxrkt{5B3DBrsb*o3ywJ;RR%8g~ z;k5h8;a*Np-5ypeW|5b*UdEu>*#-l#_>MjSW359qp-=oz0B?!qR_{6b}dMl3}w{N;6m1hu9w#mL7ol zMPf3gF?vTqI2uBdooG5mLkdgFh~jJ_A%B!9P{->7OB>{w!ot#j>Plt&$vQ#N-q5rl zyCg-EQtpQqiPz5+7g0+5b9rIuo^9n%t~4cXhRQ zq~+1Q!cv+1V9{rXGR~CbcS4QC1FFu0;1VC0#$5y>>9Baaii(OUicwnJ)y=bU6ep6% z?k!DuYX26CtJ6EtjNFmbhueFmiQ_9&o&zrJY?SJbG7M8@sB$HGK_jZ7+{4K566MCd zo?0KZF{Y)RVtW*44h!%Fh00|nnmbz?8k@TV9bL6eUD4jQ=B}2;VDsXZ_U3NYAxCj0 zA6JbOMT^TsRiS8oo$8F=>QbxO8o26vLgWbO&X7)&BMjLRm=g?Ds;F2uRb-n$48hH; zsu=R6+Bq@2=;1I-p$KowLeV+l1oQ74z5z(`|B<|CRl2*UtGS^Kw_8{$)0Q`bowStV z#3mVh$|S|+r23%jkJthfs)?yzKTcI!!60>RwnU@i4^e3LSf4qxP^~MW zvIUKHG&L(fB?C_mwjtY7ZP$POFLddEWVkNQ$$?$zs4kO@0C}=2eWsbh(nn2>fcUNY zc)BJL16O_Sy3r%yl@*({(g2MN zxAVQ5)>iFxL{-`TOb3)ziDA?-&GQX)HFRZrCoMw~ruR8a{Do>8EC#C95ll_y0Et7? zlyY5nNv))-gGFP)(n|4##ufgPYM$o4%?FnFcKoLEwSPSR%4cd{+I{c#FPud?{EGhQ z)`zb@ZPcBw9#eUQQ*-C(i#J!o~zw6fjB)&E4 zisx^==zioO=+ZQXA{`t%A&Rg<}#~x>y z$6acP@1e8C?zy5cb;YlK*}Lx8e^mVz`4#=0hE?}5tdE{pl%}pMm^}URi$c znaBV7D^L7!?pwqhQ9jj@-LiwZt)Q>qW=dJ{oa;#-^|m_|K@}zihq6V zyrlu2*;MphcOLV@tD7!A_tRVNeCXw8MqnpX@I)oPi$-04TKJAFH_ZRjsOugteF`J# zQ1p9m8TW(Tq2kP&tM*JC^N%O7hi@zT?YH0XMc?Y;`+v4!#>q1?HP`d3sG{$EHh;K!UVr$Vt$~FX z9mq2njExfCvTxnG>fuXHx$fW>{_lIcfAO=scy2(^H;rHN^cNCGj-N4R$c<+&e3E{- zP0{m;H~(hT&&n%*fAT3upZVkD%{&{c=s(Gu_wEt-U8#;2e0%S>sOKr3)#mQH#COg~ zN8VNNcH!RM^!Y!}+k4p0dEP+LZ~WI!E~~hC@$a7~dG5vU_s+jge-Qw?x?{@5TNhqD z>3bDF`Tn{uT}8j|Qv8b=?%Xlz#ryLc-s*aC?Q36V939J@cZtvW-IM>m?zy7xe4vrp=-VPigcQtsZpmE1GuVng%DRF*5rQ=eEz3@{N*u}ujmEeeRbta!<{vcKQz5)`6=f==QuAa`m&|9aVIt8j!o0X z{rkTA_WYaYTDV&;@%`rbv(7#Gx*w0d=Hlb7`Mcj?~3sCg?9~ye|E1w#2*io;&;cR|;2Ty{&t>`z5$$##;E1$UYKd-j>uKfH9Tu{&C zF22OKGCc8%S8kp1*=uL7?wt7D+gaMl7bQx3(|*@J@s3A-eEE52wHDlzSGt|?tLRUB z_Lr%4sv-qTlnlvoG=e{PhbresA#!CqMVihYvsXmN|X+A4R|SyQP14 z_Vu^Ee#KS0E6)7!jqtBi^i%)w!@qoO$I++vK02b}Z>L{)FV7b!dijtS|9IR1Q;&W) zHR=yX&p#d8c~{YYJMl{oTz1#xiJKRG_0dBYeJaC#v{>qmzH;cLx8yGiR~_=x`mb%6 z%p+YFD*7YG+&{kI`ln_cH>7pcE$_VjBc5|m^tkqr* z*>5n86g~A~r2M!~KlJQdpBj5_`?;53ZwE48miXoeGKo{SEIQ=!w?|y_`Fk(J&(Bfx z0}o#NmF5k@zqz?3aZh;I=#zMELeV3OFTD1K3m-4N;nDBCa^vUzau&~JDEh0*wtr?p z!!dVWKjEMw+TQur&p7X6g;nDF?$L9HzmodYNp+*I|9o)yPyfR5M$ylobI7d^omMu! z{bgs$x4*mPT%OBO^!3jTAM@aAH*P-Zr!Rm1$JeZ=;<*t;pEcyB&+fUPz3ZMgk39Tq zoxi>d{fw3J+m;vQJ%7dh*G$U)!=qzn@B9V*tLU$H?|x)^=fB?FcH`gwb>!j4<3HCZ z`pSbl&;Is7pZP}dwU@29`B%p!d7eelKXc;Ch5z@LAOG*upZUfwX8r3Hv42Isp{Zdv`{^oBbxm~aQ*K{-gu4?a`2 z>4L+*`l*9{_~u)u&*;5GeZSvXMVixi+Ja8=Gd7FmXKWUXq}cJ>T5KN5GgG_?*k`$wz1v7@c6sddR1ga3^oW-(e?Cy z@9N0Eq-mhZ;sbS?ag@^st-I!~aeY?du4Y|bK79^cXo9z9rU zm{(rK5C5h+u|4jsK0>YS-2*LSKD0k-LYe`j_>ko^cJ=IMPXCYveYB-vXLHv;TksDl zLnFr6(B9Cxvb&{wf&S^_hW7Rj?iqQm!C2`B@9F`R`(f6aQwE#ArESnl9EL>W;P)4e zvQinW)KuNx+;hR8UEu}ogWpxQFPc^{Sh;({95y1 z>z4j%9kk~rxBMXaU@Pa?aL{=!Hz8Wk+dX*mW%`~vSPNhsYbI~?yHR}kLLUF+7ot?C$dTVG*0gyhROHA{k#H>n z-+B`&a>jEXt7-D>VhI&Fo4MoU8UVg6CRF5{ zLPbt1_aOcE^V1h`=U#` z*`@Wlw7py){3vkgo>P3f_t|Kv9?kE zqrerl`8#SiZWj@ku3cST>049yB(;l@B-(VLiZ*{}HNyA~H_|gJ4+%{)Hm@(%OwF(N3g1uB4@s&ivIwr)|4*TkqRM<~eI- z2`$gkOi3TK^;R8ER#xogLtAQ**V*N5yXic7;#88?9PKJ2zIN8dPH(9#10icS)K=`u z+x2}*TDziRZ*S4V{Jxs}PCABg@#E`(AN*wBPY`=4i_rM-wHs39CDwf8=kcX9`PF+- z)x@=rmTx6oU>l6cv!rMx@+{R|voMBPKKf)$vB)~>$>6$5#q#@sm?>O-DWA5@S~F4c zi@GNkKTzP?NXEU}Y8xZvv!oxOjV#&_+*G-1`#=RrtukEJ9HdK;Y*NC8b(Cs#N8w&L0m{r&stnxx#N)S1!*4)i!EWZP@`ajw~*5 zlZtMLtfL~6v~g2;hJ3Vl)`qbc@4D7hal_h|j?Dl5_B}(^Zp)(|W)3I~bfw1wjVPPS zH&fJ;1s5yzKQ~YwS8EZi0NPC@wb!eLZ;WiJT>IjY{6>c3{NkmJKdRlhMU}X*;F1yB zU5@Q<4MAfzZ9~BoyS5Hg6XRr7S@D&RQkH3xX#2{7T2&v-7Bi4$UpeyZ{Z^XGwolF8 zf`hfbeM*j;?eiA>@1I+#Y0=T!y@kWMPw9Op>oHm(`k1zD?H*t8I{6*Wea3|Da#8v~ zitrds@s(Rd9T=t-6@_@^%aIP3I6^pG!y;UpwU&yF1s9+AePduqBzESkIoN7MTUx%j zz^n}_TcijX-E^(kD>m16wls5Hxx9!%J_HvM6bEG*%@2V}A1dlLQyy_C&Z=C(@70tt z!@u^0BWc(e6T^S#Vs_pAA9l z@sSsu@A^o|&EOHEQ3IjiV)B(S)XHF--V^vB!*j%Tac28?3@L=druVHtsJ_Skvv+TQ zUjawO&tHJ20^!U=SaDGiY-;%R=It8Ncg;Kd=3`LGa5atIX9~_1HfzmdJKd~(be+tE zj_Nzft%jQfcKy!sY+R>!_U@={+@u|Xo<8^0mYSrs(^x;&w`=Xik7|ix~^`qiH>WYTCN;ZQ^YCh=3BNmtG*1IkUn;;-_Vu4V%{S>q%lv z!l&9M0aU5VD8A}#7S|@$h={L}XQvcxbI4d0R=3>Xx(YD`H@;3)0M}BoO5Y-k1jS<4 z?kQSxoEWJPf|4i}`aBUatfxU$S6`bpPibMxwjZ*;*t>1oGY>l%mZ`fpivO0BY0n^& z1oZkPShJVkz$4H|k z%X_jZ`(9TrKVC--0@S@w$0Rc`egI3-1c-G)G?U2HI7kzGLwABCieCUO9MboDh$4hU z2NGh7YNVa@`28(Wj(}5qX=dQO2#}G|C{<(?6W670Q5_UPPU$HB#)1sX7?;f|YKzLv z3~Ab`Ow6=h%29C%^p(@eR+_6G=7b4d@h4D-sH-5_x`(Vy^&f;`~F>~*s@YfZY_0A z59}lL;{QsI$i9vw=~P6M=B*jh_Xz&ijCM&d^ONfMEvjEn{Q1TooxXj|_hoK3d#ED=N*fdu*%={{Bll68`l+es>pQ4);W4yCdE z_z?SU_>|^UhD|zy)|@1fM*v2CeO+SGyTrEYm?CEDRdRkQn*`%6#897rM}3k#SADk& z1@%d8QJ?16ulf{QR(+CNt55PNF^q)5=oL!@QR z#$6qQ&gy3TP?GlT`S;$v9DeLTCbJM3aQ(6NRT;vvhpy-y(#KC`iux+(fSIDZwR`f5 zui`5WLY%pFX8}ut0=2pdZ5!a0v#ZpUEQX;AGDYVXZ{kNpl@F2P zr>T#!kYP3CezhSxMHpO_x1P7|QQ37eA;ozSoGeg*aJa|k6O@7>0HON>pBFzOK|YgT;N#!Z`qg&EQ~G;tK- z&;Ro=ZPEmCN7iKjfq zamt)aw-sNyixLM&FMj0papYb~ZZs&FSN!qqK$c=M`N+5yPrntk$AU__O{xU5d#WYX zoJvd3*12}392Ce)PzG%3&T(Qp(nvea;f(vFi-ld(T>Jn-S8lx@<}Fy}F#7{`*F|l# zLi$d3i;7ZtRq zblY21{D3BqN6Fza|c1JQ!FHT0=A7O{-ewXyWfupHbwNUuA+hgb?V zN^kCc>Qp8t3dHRH{-Mo2khNmG(Ew(@a~$=kf$?HtzP5AEWFf1{tyUnJIDK9>dZoN5 z^Sw>IhZY!)flc8=&hSN{>&jOEc;8MyKID>M@dG;uN!l;=eEMBx@(blsO;VIsmcXuO z4aa+!6@x??=@f5Lm&w`}&~m9;28tfn;?@{i2$PYJR|3iXi#@WGSxrb(A}nGScZ0uuH3G?p|qb(Zjp~(A+t0dlN=*}4`hYWcMxP`7$H8b~AdPrO0fYDAHl7Z($ z;*jPc0S6(K2rjAm_-X8FxfhhA(HAa}nP(3{HQNyuGR4a^qU2B$9tGIh?s;f3+dVB= z80k9{G7LdA+u8E;Om-0MQ)?Ad90xX)(#iJXNU~u~GVUa_O-*mANOqb+8F___I0^AM zO{%<7>Xrom#<838x9F5-YBy{tzaF9_ia;URh>9Q*DSluq$7MP!wkV7|0aU1@Eq-7d zTB?O4S|S*ipax8nBZ>HB$d_MO4mp&S#=d;a8xdv6@q&QxNy~` z&B{cjAmUP!ic6sHFvg#i##}|^GQ7ho7y6#6D8b@m@*A$%JUqyfsOwTX_qH<-Sf$nf<19;$0|H2BAJFlpH+EwvSuu zE7uoX;%%fFv(%L!<|s0HF1Wl*Xksg=>Y7GzYfVUglSKW(K}?2&8LORAu%YDSXw4>& zqlXxlE8w}Ik<1=5gl~mVP>AFfKcqSKYeI@GYeJG+cZTHC6E6Ye6Gjy`Vu>KiVkBU1 zXq35Soiyd9BsYGI_IfV3`tc$5E$}JLsSNlx$)GhSNeCbS;{qM4(6Nk;DPp!>C8xZd zlWdYiwsn9Ee88hV$)2me^+G{?l3UcLIrghQ#gp)h*I5vdtmO>CCtl!A!; zIfv6+Ws0q;3Mw_P9L?_Heg$9;-Z zeYQ_=s(%J3uJ4_HvhTb2@rTfFzeV|g>+!X(&co_6I3SE|Jzz#IPsH&w@bo;6Oq$Rq zXEl{1;(Z9zUdf7|45{+zr;fdN%}5#Fj5Yq>^+y$!yVgo|>sZN{Bur72Y<>=*q?{7e zwd+js%%t`VWy%7U471E?=g+ME5KrXd(sCB-y=S0E5jaSWb1Hdg0(@%tL1z09uE9g{TE78L>=L;7UC#(z2jjor+NR!dh%;fB5FAWH)^Tj!8XHHBvAyr->-kByS9nQ*a?@Nr> z|39@?o-_OZc6(*RBz7mexV&9OeWffR`+m-Ir(B-T^A6eU{keSI!}Db!_ZcW{#+-*z zoH|tFkp*42tRGxzu-r##dGQ00a^LCOdye-+E-YeX^JAl|bL4wDB?KsmK;PFH<7PbR zd6X1WxQa^?OnOdbgA-w_D*``ys6`mtSN@5LFy0kmycJ=5-&gql)+eWh!(0*M`+ce- z4(mJO6BVJ%6`{-hxy!gN;))2#^8`$m4EBFuC}m}y0r*|(wa zle7i>oj7sO>RSZjpl9_B{a_;8jnHei6|x{1`SH2yN>?Y9RwtExy*#_`sp580iXSZS zFQ)23=rUo*OyQ*$6hBB}@q>}_0w$&tyfHO11>Jgrww_?$sBAr-fCbjNBGg(DYWuF> z0{3HXYQ(K4V(W?YO~}^s2{bkCiV(LV#QVOicW*M@`}f{pdo|_Old|=s`cBE#^9eL{ zo-4vUE5f|K`}yY0$K0z6+D!pC=M!k^3Ri>`R)iIOg;^0kE(2ce*0b8yv$}69L8H?5YUIT#-r(avWu#Ml zr-oQ#qK{?2G z_|<!-E$AKzpN5|4K`N zb1BPNO`FK_UWc|2;%7+UJM&1#DN~{UC8Sdym|#QSDz~BTV{B;BvHBN43Y^~(I$q^{ zv_k)4M}hOM8~Vx={RH4WbCKY2EZ}=<%9gC$?7&yjbHi7xqFmJ(6E&v|2ak&{;fhnX@*JH9b_&J4nFAPJFE_07R1-x>SOm-8AhM@!;;hgVjHLrqz>PvkXs z@+W;F_8{6h93JVDBMfiV!1bzEj_Vh_^8POMn%{c;9`YPww(c@hUiHA`dEX4@zBw>g ztCpNCb3(uN98J7`d*s|s+H;KIEpmp8nLtamjhV1d`bdY5$a`aVwUa+))VO@-IP&l? zLr43P>fZK7`E^ETx6mgldYs>OZQ+-m+k2#sg?_xI>!04l{$|it^qO~qqDxsa{$};I zxASh*rb)cY>}xp>vvBg-oL!m0Oegl zd3hqqfNv#C*M@6q9Z7%hSM9#BTX^yYE+Z0~>!@_R+(57EHE*zXcAw!48;1|d6Mr%p z`Ev%2`=Z3T(+8xZp4W18Ge`P>ZqfQbgz^fVxV&;u^~YhvOPm1jGHCDZtm*3L?bP%m zp^wj@2O8QNn_C0C!){SS<1*WyVoPOCqM@-l*xG99IEuUz9Y5B<@2gUEpo2FRtmskw zb1Z2UPBp(e+}g5Ar`i&gJd;SD>GUdIc^~2|$JQ9{YU$`|=~=1elYZyTyu7s2*)4vE zr9fT<{Pt6ut2NL24s%CLHUY&MKO{QRzCN!+^kc)K6C0Lx+px6PhNXQrEb>cu!hXhc zs7hQ>sEV4EA3N3X4`n`(b|{}iJ@Pr7G#R6_-12>6WC1arc-A-hoHGpHnTF5$G2xST zWqI=)zu~Piykn?WMu6~2yQRHZ{(L7$Tx1A=(k^e={e4P};jJBjSM-uCH_tiC@Xj{8 z%yFu1@=i^(#-jNCxx}T6d4|`{$3u(^=eYE|5*xPVEg(()yycxsT*~{5n@`K0Td&VqX!sgj zzPu7EuhrN8kd`gm=QNo-%_fhPL)Hkgh7ew@+dOB9;azHYMW(Divte6?w8NIMjIijY z)s)d@%CNjrht%n>sE65M?Rbx<_kRsWR{5gkgr2Ne0r z2+LdRuP}9OG<6+IUfEfQY&M^j(M3~+ZeyWyr77boQ-2{a*PBjlOMq zqB>XJJkvj4qAZbrGA=okgv@;YQUjHdgDj^(CA?qCYp+XT zzmiw%b88-bSKWo+x{e#6-9EItxfL^_w-ley-i}yWUC&~}dlU4$OypYWBq{G^6`yy5 z{J^_ypQf$9r)zPxj;)ICp{K}~miICUuj~ttqqwh-W?`KIBsbNO>Vy$|s@>J`rN%Ia7&%sZgN=Y&KDdVitQsuST*G#Ht0>G>v4G8Cv! zgj4h7o$fZRz@#N&u~aY?sILn}Q#NggN$XD^YUsQ*yEc~4dzWE`7K#R9!B9G!OxH(4 z$$&o|(&_9i{E1{J9SqrYlWJriZqnoaRBgIC5vx-|>UQy)$SN;l>m*^qj-<^aOj=#I z&eg+6LraDdyqR9tKg!YqwV^t{rj53=Ft1=YaugdHuORn_qnfY8&?2#b+M!$CQk&oE z)npR6#+Wp(4h}FhS2NT(l|3D2D{4>oZTh_bOS;+3<-WF?>F1ezyC*fT`A)~G&I$!m z7)78q%p2rQTYQd9KPMIqr9+X>oE-V{+;q`iy4H`;NOqAwKQ}EI4Ods&v;sG6Za5l@ z%}w)i@>C)mNQGn3r0JI-S)Nc;ERc@J;`Q-5f7D+SQYI#K40U;`Lbd)m;aDQ6>K^9O zdDFbViZ{F0%}&P?u~aM&iGHT`Rfi)Xks}iG2NlmKm&YFr#-eGD zDwG|McGGP`bK6qvrq`x8C8)=?qkcLq?oTG?#uCA_QI+lc5|=;euMVZF=%`don~9RA z)J?CC2GU9YoKR3?W^@E*+cL(uJT;+|v^I@_r-e<8Qp{Kl_MqiIz~xW*tExi5bX6iY zHz`)5$Ld%&J(-Nu&r@=Yb7{7(je4=AbTU>S4QiV>a38)%sKy_dpAN+8;;20dzm?-4 zm$y2W2!zsTJdvj7)5(-SRjRiN^l~qH!5K=C z9GuQU7oHgH_wG$kGxMe61j2C{9JABa^@t*}p$lmKKmfC0LW+h%dW@nI=+V&JP$JF5 zAtsf^A0+8Kb3P~Ou}E+~>F7rC%dkYg>IfcD)rWqdrxNwal$0B;X5JQGscaX|98IO` z!dNf^Mb$G@@rUMx(#cSy8t+fJdSolAga%ek4XeZC{MhXfzF#5Q znblL)w5d*lK4OWg`shLW=zTKNRqw-L#?PUYW!J{`-o?A0s57^!`0`ARfqNG9Jl| z8=W3wbT!%4Rk*3OIk~jAhd1o7N7X*5x}&SHxyhwcm#hu*OkLY_T{bzz+i`VmUJCVP z{a#e9!=q~1V(U;eIzTPKRK0nQqWM!S;Hv7g>)?D%SGQ9lUxAJXSONKQOKPoW?SF_) z!;i`4A`z+%C0H3)9qT$(nyXhuV*rZ>mhmrZu0*{q)cP*P!|a}wb-1p_nt@czP%xY@iKZ=J2(s{2%S-7I z-M>S;JT{pM6o)BisF#ObqGj{)4D<5j)Fq28HDM)fn+mG^h~H$4zxh0MZz4kKIk62=Bcd3j{} zBZiY@QnHNp@+dK6?JM3X%P3=`*vqH%m7LGYn7KmRmGG2!c@R05L+hy2%cIJvkIM$a z+c#spJUZF-u#))zZ#wmON>J%zz3FyMYjkA$bexw*t?{YC=6 z2jiU8o4b+L?H=#tQwIdu`VRJ{i84r%>hQ6_2osFx_7E=*<0^$GlG!en49mF2w_!p? z{zJXIbSLYoL@3Uh$+p4p9p>c=M6e(hE&3Wg6_yFajHkoBeBt`&>?p%BYaUAHM|gSk z$d3dBj`RB>X`=x1H$aGdinf`m=SN zl#@O!o~{j%Rom<&Z(36CU)c{Ro%YxJWG^pXB`MnhHVysRWh|WR<;^WOnP%v*`gHrV z!pp1tn+%?Wd&V*)Cw-rBWu2k2|>gjFJ528rnVM8 z>3U~r!*nl?S+?eSUF|nM<>gaH3UW51_TKIqZblA|IuK;b(%;?d@=nR&l@l*^PWzcZ zW_o#NOs@*7jlSBD@Qlf@ajcWoI^uD?j>t~#dexSVn>C`n6Sj9@a&Mk<{!Cn+Z+nvR zWS_eOly$nja}@smckMqiygxR)L)nkXS$n4{tDQ$LxISS#3Qg`33f;S)>|Mf0r-!$z zs{5hV4)z_EwNvtrV2M{(!L6P z*P_aKigwL(7Oi4G+R*YBxR-NXA*T%7jFS`2#R!23FDh?sUugi&np7x9nWna}loukEA%5ZT6#AN%yc-0tY zANHQ*`J?k4Ij6GEAU#7{*#Fc-VpaY~ES^e-YSU~tSchpNA0UC&an@zd1@ba`_a^;m zKMx2g-{5m3*4^FQwy1Tbk-I=>f!2oZZp~As;=Jp(r>ocA35w5fO5h7}^|VB8H}!Zf z5#A7YbtdlQNqo6Hb*Acbe8j6;np>MpypniLb9*zdZ;v;0@t|2xbC=CqKw6mRmAV%5 zOq1s4IU|3%uDNGvN0ZT?#5FsKt z)6lAIRN7Q1yh+tiU4F*NKuIlak>}WkjVm=a^(_4W-QUyGm1^i((%ggkbK+?IJlCe` zyIRtKD+^A(+#zPxLq3OdXq#3$J5pzKh^$_EpdPxM9by?uj^{;= zEQ^ScjZu5MTX(e_h|dWpQuX#+lzSAR#p@HH96I+WLgymRl68M_ccKo}Wm_rtuhN&? znFvj0Gc_5CY*t6V(c?%MQ z>pm+GdP0YXsPIh1GgQKX`6@h2!fZ6`{-{vmRqV=5*~3-3m0s6ZBsA8~_6~4_%EJS= zCeKKT&+#Y1{_J{ll+di@nLZsYG}is$y6m}4iO|ARlx(Fc4-vyZM#rbx_yIaT-NwhN zyt<9!blOatcA!ej%5#uTS7-3jPva#%ClvCx_LFkxPH{#m-Il$@QXV8NysE<~QT%}v z#wU7m%7}aP?^H^j`LY^U{CW6JD0HN(0nK?o^AEIeM6Qy|9f+#SQ0n~2*|4hoiY{ja zLPUQP7{AkvZ}}bL7c&n<>+2Z1Cd9bSGvijx(-?P6C|w=#*CeS?tqVkMHRpQMrcGrn zDW@5n0GYZu-;A+l_2y4U!c_@>LXTa}`E%1zRV-Sgj#0xkVr*KEJkOiU$JUtrU7Ec_ zVtzb^0qM3DWaLS-e!OfexmpcX)$8LVD|_~)q|SdN^yUT58;Tew{vti$&=ybIW2lL>8Z88Y6wgrPaK2pvsQVy{hbRgjIiS4BKMc zm}XBBi6}lfT}jGQ6sn(nj#jitQx~pH>pY1$ext*@e(9mwY+7Nzv?|ICsO^X?Tj@l# zA+7p3M^~Dz_7a*d{f-VbT|W~M)%V8Qe!V&|&rH~K3_Zo(EA5ZR%|i)h%!&=TWy(!j zx=z*tat|ZJLg}E)(~giobyhl6i^onYC8@Dip!6#TYpSQLo*hN!1Yx$As+ga%JIXj2 zZ^p?V7$=G5&Q=ys-GPp-+NQ2(Z<{Q(g3XJ0TB)1C^IpknjUam%B|~PfnZNOdo-=O8 zt^>HR4H;icN4j^z*>v^XfLw3#$b{a{yK4(^u$-cV%y@9u7Wxj)9Z#%<^qNEX)lIGK zH%sSkS8n~tAu_*`Z|Ppy^u2SytHkIOVj3|*o{pNwP|{KQFHIH*bUEBskPgmbo+E=x_LTG>%M60!RK)P%YAxi zUOa4WO4Vvc>drH1G8Lv{)oBcuc}U&TDB1E&x;Z+;AM%Wn96=iS3i_pc?-+)dG$tD6 z7JYs+)TQA=+3DN)cbF~5AC-d&^$>}zqtK+$!wjlWif209=P-twG#;wbhv7#5MOnHz zdB@_#mz(qv*>s(c3s(%DOHAD-BfWJh4sE}qvia0z*2+KHLua+4bXV*xqn3lISYm#) zx*~Vf{S{weRDJj|eJJ~0)l2LZvpZi8h5r0D&$3FNIciUV0dd~NrINoY8H;c|#iBi| z>g|`#j7Nvb10LLdOMb>OyNzuAdR)Ie`)2j6_cm_2Ib~ACt1+kdIoWjmIGDBXoU$1y zp{V!ylOefvyVp)4*U;QF*@!85hvm}kV?8RZuzwn}qLej!U%GnCMQPNvksMidlCkR% zx%oML&bEJKZdy_vo3lP$>K>Jwt{hW1S{<|c9X&w0cg*)oH~l9gQ`=y1Zhp04^^UuK z=|S}jl9+(E|1UlAM6-Pn4c zkucleDat30F?Q}V=ZMOD_4%-Sw`T7PRhm8)r*!Y#xIRWy=~!XHPyd;9ti3N(X%TJ& z>Sa-{?bqHDsx;|2kMFkkgDTCnLY>dv3+j9vV}$30BIc~X-UHe+p44Myr}NpnKb02K z&tKVlKFu%F9rCdN72C4+dn(Pe+xldCuVL@_6c0B&ICOP*Ztc(B?`6|vou|~N>acfv zy8i6*u=Xxb(Zftd?z+jNYgxssN9xi%ag)0zvUhm8UfHs+qenLVJx{Fa%RcZPl-=@!)?#P*s)$QMPy=2bn)D_b4hRH z)-<)cuI8yNBNyvSmEW~mQ!Z;vMGwT(rHyJMYfDAr;a$J=9m5Q*J}RpaZF7Z&CJmK- z;}+jm zR9_5My7M`amPK6+T`Ro_*n!lUXZr5ny6-$3+2?rr5vlQw-IaW8rgL&jQ^)c<9C=Gc zzB9S0i|?}VjT=7lt=fFwxf0CzOm1pk)VriSDMV_9r!dVvw;xYKPlKVz+BVncUgrRwmzQ z$@jJLzx+N&(~5~d1I$N#m6)*NaVD?G=3$xE3;LTQ_Pe@phGwsxU(@+aRU%$9s9v8@l(NZ6{X7S1Pi(o`q7*pKd7uz6r0((RH;ow6rJxpSI2z2Voe7qGjX=Yz!F?6Ho+< zl!X}q3kwW@)S;z{S|M>3F2NDF04HGRQTR?1>;yVBFaC~`dP|&MbXj9*S=DaQZlhFn zK)N6tVISm*iQmNH=pq6YmlDjhyJ=%U@%ryAoK-TMYkhSJRI|~+(zB8 zRMEXS8&CBBphLdAdFi~#Q3BAkb4aH(N+M8-L zTFgk9JX8U!@@twO1B$KJl(yDT{J%eGjoPuZE&i9Dd}bYa&^1;hi(LdE4V2c{S*_Eo zz~M|WgMU4Nk6)3?sYqE<2Dg*GsM&BZokaxwU?mYsYh;}K1Q=4G`yUu3j*QE+o6nV* J4Ec7N)(0Swd*=WE literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/bzip2/win64/bzlib.obj b/3rdParty/JCL/source/windows/obj/bzip2/win64/bzlib.obj new file mode 100644 index 0000000000000000000000000000000000000000..1f38d6602c76672686150a3efb413f612c0e67e6 GIT binary patch literal 64665 zcmeEv3wV^p_4n*1At79nAa@Z~3>p+LK*XS^yV>1jS2nxrULaU>3CThtn~R$b1d6%{ zDluB|QfswZwQ4Q(ek)pQ!CJ9Z>$O&`)=RCLVy$?oh*rMeIWzO_yCJB=_WS<-=lS*_ z{N_D#X6DS9GiT1s`|i7q=jMy{n+pOH{wYMGke?Zi$#_F*Wn5i~Q;?Wu(N_u!i^Yt_ z_|nehrD2^DTq;C2_+Dy|lr;dmD6X2(Sf8rbOuz&1cXgAAfTUg6x6Vk#yHX~yXO0ke zfN$3|l2`+&gRA$iRPt~zY!TloVAfYyaAuf@2GW$C);w- z&QAR8vI=p$u#`}<&SMrg##b&rts%jG9c`V-hWO%D&8>}Xt2!39Ej?}V(lyQPvxqXM z0%^!H15|O0m{$S~h^Iv{YH3?(F|f9|A=%c^wk%~U3r)2J+EdLf&1;%lm)o3eE$z*T zcv7sf9#uK>d{tX=1&XY! zm{C4scKPg?b8XWbY|~rY5^c-dY|~w_`Rg1R|5DQ0K-hjMv*98Ni2v|Gj^2av4x@~~Uw@t4_Mc&B+)P~pZ^hI6n$^BJfQf1gR zzr#?^%A;q@T>NbdE?%BMqYHDtNT zct?k~wK*jwh!Mq=IzJn$ETTk|l-NN%A9VyQ9jRoC7!Q&MB=S1}%hE(!!-{b8nm9yS zAx0xFXymPoCzrN$G^bWWl#-Gh~aNv``Ilw;vtAI}d{lKSzb--tUOM%Y<$#$Lt?nM6=;BS^F zDghXuDJpdc@CO(_^;x|zNc{aNBX47TS$$_Bg?Uk*fH8l~ zgg5{OYexk+kS<_pYp*}OGmcu#Q=&N)Z|UHf69l82CLNd|hH=ZXD^>To|K=G;a#H_k zeIpyE&vNvOWN!kJeK!NCAFyfeZyM=}KK&&<4#%Gje^>X{-(|^ooV!~Fj($EEA?j{9 zva-5MPJslL#QMg@q%lv4SAX<4qAQ|Q5nCZI$KO^BdnTvTUiL(7^tGoAkcrwo2S}3|{Y{e$=P6l#g>*%qHDv+($}rGR0{$U0 z9@%ROi|hecKOYRnNRg*~NGYvBtC~{{O~za?tukbIG$3-6uvj#=wTe+7lC9eC7qGNb z=!9i#uMsxsA!q@s`jGsjhr@8~QuHewp&mZvg%P z_*39Dz?*?sE5y%$PXm7rgzpr$0AB*$3hV{m2K)qgJ8(DfPT&{7yMQ^6ex)rz;coT3N5Os@(f#4Ot1wILU6!<1^ zJFpk{81Pfz?|}Kx&*Q*(z$btnAj+fzz^8yT?oR{BmK*U`-p7_{WXPrt#osL%`)KZn zx3s5L56qltUfS`eKhy?|A+Pi&v=L4heCrBCxOPvaC8~!qu8f)uJiLw0}ajd!ZtL%7} zsb!LxbT9$5_Z0m!j0^du6+rT@h>Ow(09$|u1KWVpfQVJn#{!eUD6j*V0Aj=nwD)TVVBrDd=SbKeQ zGL~u^&{|f6PUNCm8~y?ocv9*W(pife_31?-st?IReHx4FCln37iu?3u;AqfZ0n+?> z71#>=3$Pvd8W3xScpZ2<@J%4fh`$0s6Mq8^#kjoKJazmKY>F@K42vf^ETZGL?6Kp#oxp8`$( zsG+TWHD+6TXDZg&nrcqOI#O-zU$bnHT7#%c8w<^08?NckG`%s0M~NIB0Az@%5NaVM z1iJ|GNuBr$Sk^Q&HDz&L2J-p%!-s}6v&LaaX*Hw2zBN11eSFCIOap#J%_}7*)m#ov z8~)f>bj_yqau@RShxFIi&rF7mlTI<`+0RS?Qru7mB&iPv(z-bf7y?cQk_u)3(@@8e zz#js!mZh-%2a8^f_qM=YQd^uN}dm z_hU#jv-Y1 zJGxJdhqrz-xhj0X_W#QMQLW*G2BTo(ap9EyQ7UU%cK@7{*y!!Z2C@%QWO@xqB} zyvy5~YO7|W-S^xkPi#YZIV>pF#RmiA7E^=R1l#+LVgN{>W8NjoK&+YKcp%Ao0`Np2&g9Zb zpcD9gpbK~%&<*?vuo_6V>;;k{P6TcR&IfJ>`hd>@ai*7spA!Kf=CKF@F<-?=K+H=K z1`dZ_qQC=y3xTD;ML-(olYwLpCm?-7pY_lI=Suc45BQtRT6M zYUf4~4mD!KU%;|rW>(B}3Fg?%`IL>SQ4TL%QZfOx+3<&nV^R*{MLM4+CnY6mh_&(|S*)`o-pIis zjaa8_C6-EYT^LB!QKLgKuir}}Cr_AkU0I{Rxf#cWF{)pQV>xav7-XMi#4t^mfBHlA zL-Ubi5Jevc|3fx40XQBw5lHjZ1|+>540Ho01Eau0fC(UMHoX}*1^6HkwwwMF@Gu~) z(PhAV*!xrD*`z@N(eMK=@LDy-E6c z;4#40fyV-GL|<@rlKva;IAAVxgBUe^2+$5Z66gSa46FiH39JSljlrn_ zt^(o=CVei@3k<_}PXt~AoDcj7uog&09R&UYh%=h>Bft>wXwq@{&j#KFTo3#;@EqXpfae1L0Newr6f*8~3z{0VS4=FJVj@xU8_M*wdE9s~Rtko@sxAo=Zc@MrJiw|j?6 zzx@{Q>-=`O*5Q-K&rPVQpO4zh^!2_ru+krUU%4Ffc{J?D_>del|Gl8VF8T8t$c(Wa5Vbx7H~4~Z@?*- z*KY%t1K$Cj3w#&&Q{dl$cLR3-@54NQ54a2X58xQg@ArX~zz=}OVt(!fo&o$2cp>m3 z;ANN>9|Kw6E-0=x-m z1wI7K0n&WP1%3g{16p9`1;EL`A;5XSp+F~aI4}S#0xkg-1INH#OMr8LBY+EmBY_RT zQ9!a^=q^1MI0kq!a2#+Ma6IrJ1mXt*=K&`GPXXc{W_l#-W)iRzXal|mJQzs!TnZ$+ zPvdWHpZJyHFLXs%fL{^6eyd%njzGxd`|e4peX@6S&)Ad3ATP;O52W}L_gp#tYyeXH z*$9jPmjTnj<-l8jSVz+@0#5@{J1c;DfGt4kUn`LGK>MTP`{;q}ncC_GzC=-g{K&m| zRp+v0kv95YKOMkf+eXcmjhOx8P2rge_S&!&U6yEDg|I7gmnWV~%G2~DM<1I|k&JN~ z;~gp74=O3S0wfub5Xl#B<>2dDgHb-j!_OAnOsx3BPL`kSA!dqq?f^~3C>(tlVHfR` zw-|YuoiaU-u+^ZOo=2dqSG$pcaFm6%fpRT0rk;Q>`865~{UQC*IFAM42}OJ-SB~#L zf!_t~1K>Hp4}n(#KLY*)h?s!K_Y>f~xc(IQGH@60@4(%_Pl2BUbJ5Nhz#`zkfd>Ki z0Ly{6F_NAOv;Z+kA{U5r9+3xJ1{?&$y#g^9NdB%6h%^D==4 zxk`{UK1tBXj;NkLLo4dj*N*z^4EJqG=0LxXCB@p3v3T3E|GNf7$0!+tlE*0fGNk>r zmk+eIfTTyV7t-Zhias8Cr|W}(jljvkR$wV`6>thL4LlUs4Ll5Z6R-?;AMkMCZ-7St zp9W3?{uwwO*b6)oNOn{X6li}Ya4-Qjy$&OCOU*B^DEK~f!@+MyCYe#r6Z$UiSL3e%W2_?na z7a)?HjN}W;O}SJz=@$P)siH50ER?JRQk#pEY`2WVenRAze1cX=M3vX?3P&7~XgF5o zuJQV#L0`b(aycRnY#Sxh0cIw*-(_Oa^^7#L1Ve#Hz!~s4eU5P0>q3WQJ)_J_Zof0& z^7?D=h=9x;ZO&cb4tcA+Zda|h)*V?CbUPL}ygo;j&n?On`xrC3Y{`#)_$2#_mbTHh}RKuiz$lnATy&k>Ywiq zEc9oTFj28hG_$$9A-6L^<0&So{7L5gkYk}%r2wDpA&0-l9X6VoZ02wV0`tA@SQv`HtxDPNL$VoagAQjT77X~j&P6c@?e;EkyNte< zW;4s$qQPLu9S(y{>+;b4*kH)+n3U0AJZztgA@_;stHD^dPey2_HWT3r>}4XbIc?yx&8)#_mCqaYxI-CR(i5t}%tt2db1b4ZGn}QW@uSR~;jk}S7lUn9 zVdBll_~@B2CyUD+!jz6_`^(g+xsT4`_IsF{|^cH>!1nQ2v-)gdo@oNtj) zDo166-Ogyp8(9=X^+sl{$_xbp5m&$&ttGS9RpzNoBZE9D36ife*a^C0-f%4HcZZ#h zpqu9uu@vaC`Im~E}YsA9M#d*QaoNm3O>is%Z|!W0cX6f3gfn#q3=e~GR{t5y}%^^H*Z zs_P?BY&VKw9K%s#+-a84lbVI%q^LWzh_uNr)#r1&FdCsntkXA84(Cm7taKrFEKo%= zABN!ckgFqqNemW)fs8BW_PH0xwS)vF2CKn9s*CX=K^5ryob3EC88YS5)S>dZM*c$h z>A*sGzi=evg~JW_!#rh)D=)+4t_nEeDTC2qt;6rAakG7mSG5f?_^Pm8E${|HVWXvd zBM)<#R?b-M{Fq*ujg|@wE*cwOE$hP_qp1w({5a;7at}86^em{t`pAnh30!Do>;AwA zN8r`#)JPZ&4&9rRoEtSpi!a9s^M<~s#I@Rwx1ROZmC<|g`rI`REW=K$aJ0fwFPV?hpMDDq4G3JEO2>5MrM-1*oS5y?uV+OQKt4a>%@Ny*7%MI$#utU1i; z(5&PoiJVJhdveOWV_&+B5(%GK|Y^2(6tOl*d5{T4Y49A7oE(? z)r*pJaI{1c7y6vxs&Qk5h3?3^Q6~DH$@KacU;)KO!EJ~L9c1!lvKnzajGVMI3O?E* z7C1s|K3*q})JLcmx9@m~lNGWvJ^;K!RY(xR9DoZ9>-fqjXOZQg3S-r!>a3EC&^zR< zib6aZddkR=84-j^ynYicSJIrc;X%yGj+pyPnR%)K1m{@xL+)zC8-Ayo14fdt*eqeS z&r!qvA{Gg#^@Z(#DjH<2$dJE4wH>Hs`DrE)^I%EV<70?gm`#t-zKE4Yg@*LWtPVM9 zxK^^RF_1M!U~ZDCs2F^a3ROmnVI`lUy!_CaM$+Gj$N3KgeMc6(A=xl{R-}GuBF=N+ zZO(LhgXBWz$Eu?+ds>%>4pRl4!tihy%d{UGId<%n2O~wE-@OpwAVNa&H!&;|VN7O< zj)(=83Ko3vZEqIc0?d?ZAyQV*b+m2qRb!-UD54KZ4;sNrABfV;LCK6s4d$qy7YK~CqYB>)V_!&BVRDmX z@L{N?3Q-|Xz$1}k5mB3;emX+(uesSx%!SUy<h(PyE)gmUd7?1l>^ku+QJSk?Qo_9gE3hFU-H)J{9niyQR-{(cRhYsP`0nWyYZG6b*aKdc$0f)uB zKS4-G#{}qYAc}R7{RN$-Sj|kR-LH1idOMzD&JVfehMiV;z3tC6Gw^YY4vhFfMhi2@ z%!bWM7L(p{=bM?b>Y}Bd=Rug)X_CCa%&cNI2xj8cJI}#pPE*?^RxM_snKeoij`zMU zXCS!9IDr^qX2PL?R4gKSJV-GPBUXr!H+FP1GB|s1M+}V(GZ)uJmf0{;h(!GxZf0XC zwAp2N^@h2~%*%=kFG8$_`6!o4y$#mhpU=)9csAEKQBZO)WKY#EceJ-Bnj7lrD;<&5 z?Qu-?f|5zd3VL0&VXq3NVpvV1ZtS26O6Wm$Uw{@pOx0l^90EcZd(~J39VsZW;S!$3 z=XUt9NXqM|v#CCb*-%h&kZhDD8$}XKJ5bVG*hevqYIzH4@dcv`$sd&9dYt45FA6iu zXpm^#fc&&@Ak>fx4zbco4my@{qc*x5fm^2NO5+RDqzXEG!87^k6Y;;4=!q5WM9P4W&e5ajbc(hS`kiQ-|k*|S(tze4@4 zFg-d0r&qvU1BIlcVTOYh|I9hu3|+2jfacK51QZy8W`brfEzjmK#i`q5il|PVF2FSu zu)7S!+Y|K-@eXHO($h$*XFS>5;EFG6ZjE>F_#BKIok8w1>7CpqH0Sn5Yk6#PWv$iN zOBmYx7y1!&%CVs_r85uOL#QJUu9Y+{drq=V#uWrtD=IV4*VTdx0`Q;*fng@9H22Ky zU*HX4?OiaNRdp@0@l8g2<27F20+(A*LQ9spfL^dzab%*Hi)^7}g4Dc=HdNR%Uam5kIUm*aL5iS`Ak&})q^Q04GpaAR(doDE@wHOkx4Gh3lWiqn4PREY8Kx{s;Z(ksKF7)rumm? zy{#?5_CY#{^{W&zMw(G-LeZt3#t?xn$qIbZ4Cs<%PzF8`moz+CHGk#!9EuXOlzq)Y z#_fI|d~P`>s9n<(A!972$Sl3tx@u9fYbO~7!nlfX;Cn>Jb}I_Yigz*B1p>61uRnc4->Vq`G5Lj z=Y~T+s>01W2h%^VUvqb|>&b?a$IsY(+|2Wi=VzM0Z!f*;gsCrG_vmX2KU-06{rgmW z*N^$9Z(6e1a#zTH*uu*E4~lF*Uvlg_dlIKydGh={ZQE|#Fzq;g_7wE>&#(T) zkP*{Ad&_p+n@uNPvJ&50%^`V;UOlh*nwEDj5cdsv_wCacEX8*YnI1TO@!2124IMc9 z@tOx4zZfBy~YcF zu?XuI)2mBv%o}>>Z+A>R;fD50{`wA9oV%EQ=|3KGwg0}g^5VlL&RBixqr3PXIqIqS z@l{V3Ob-41PIu$T!HL76pILZrrr1)t`re&KPI|a{?6NiQ{^f$hoAE3e)BpX>^QYZ6 z=)LDx{@|2TiYC4R{olv*yP8`qmB*a^^U04Ey>w_@lN0yenZD!JDZjm_@w`)xyY|*C ze|vTa>|`b!Q?cc&VOJdE-F(>(7yWhE<&Tv74o1?(^t)~t^_!jUqVy+gcFh{`(RSFw zZA`!U<{w^ZSzC0^Q{8iptW4KjfoFP{zUTRz<)`0v>fL!SS8hDw+9x2-G~9eFwlr-S z|5D`oL+tlW4u*U?uBpefAx!^#P4P*0HlNgd)uBr-^)C4c{F|9R{!jiPhnK$a<@mt% zzokxi`8+&R#PolDQncue)9l`j2i=-*E;(y7?g3+N6kAr@a^sr&&p!I{aj*a3S3943 z>UKOk!t@KqE`Rz5p-E%sjL5s{q$S%iE;ljVTD0lqVNaFXUp?~ZLr!=+d<~vuV)_%- zx-Tc@BqMFFTlQ=|EA=}(BR!bvKY7}u+jDmp?CFf1{)~0cglF*V3Dd9o*AwTKU$gAh zM~h#0sZj+5YL>Pc$F?-PO-N_S5(7Lciine|y3^uUl?->tE0QdR6n#LB(tFtR2%! zKKQ{S@9f!i*C{{Pomx3)8{EaSOpm_bd-|hCb#A!lgMZvN&Oa4;8-eGLiY?*hx9?eb zLhSKLv&Nk~qd9#(RzRlDIrr(iJFnVwZTR1#UwrblKTbjYOwax0d#m3ZEY5gjOGV+z zqfdVU&x$d9MUy8eB6*uHm_6##yYJqGo9k2Xpii;o<*6s0a>(V6kGy!@VHf}5Z3mo5 z8`Ix7W5W|82QT=f_g6(Fn=cA=mST6kj>xd*O@H|wpWwp2L$_uZZ`Q1zBuWc{;<;@8EQcR!yN^9BX2OmH0 zv=bA#S6fTA;XA}kfAqW0rk^T&@uqWr`s~riRDOnW|B~s?d~jyZua+HtF*zuH*><-;;wgpI_Lb>f2Z!iGY%Mg_}kf&Z0mQeU3TnqyE;F4 za_u}kBgORNFF5r&$EoLkUeb|UJMHSuhvd`a#g@$rmmYlc31<%XU-(ph?w>w+5Bg#L z?_BhvbNchMzI^?abKcuL=Pzi}i7_a)d@}m^t1o@iZhh^k@f8iXzxV;3HD&t!5AE47 zan**;E^E2`iV2&a{~4YYWP0QcU+H1TZF&B)qekACoKEmX1Gf z_mGRff7iM2^C6~>9=HCwc=zC+Z)y(R>CGQL4bP%7-M8$_OMiIgBPBn4@K^6#b;;W& z;@L>1zqexBsf+8U+bXXYQMPd4>NBphe4{tyI>!(ls*>m&$bpzQy z)6ahXu@$f0GKKI|>sepWpe)!SLtgTZ=6_uDxydwp;E9Pq_MnVGkbk z@Hl)IpXq1($Z_nw?N{gj;?~*k`u_UvCwNwi>1#d=Uv|RF1(&V;MMeFst0r&8Gvs5a z9@n$B3sxO;{ZV6n`^jg=&gncG>yg0su#qPkj#Y2XtciEE<7?|Png&)LZ^UXyu5M2av^*qkZ*EKswD`Ac9N(vFX-q61 zXyYAC@kFA&y}6(A>XlrX5m+f-$<<+cCD+P^#d;JvQjOTh^;6F`8bf+dS$x?*OLw-e zXkFDh(9&qTqoF=IVEbwBXlk!-STSqB?Wb@Q)G^S~$@YfU#^kpt-O=3sEs8fb#0Olw zp%Di~18uvpF+R|uZHah&XR2+W#bGebZ4Idb&v+U#977Md=O|y_vAVV4TgczqpSRo3 z8Q(y5J5U)?EAhbVKnr64lJNoi8k}o&w0$dYfp5wURCFAx)hC*l54d@ZeMkL(EstDX zOT)lj9m+3n>~FF7MowNi%8CK&E}mS8#dhUD%P;*_%RK3B<$&khid4(K-28q{yOs4= zDF?hJO@&0cnBpu?Xf4^-1I zU>n3cbHByVn&s&HHX(0wE4_Vipz2VbxN@N78S7)`A-p1D@sxgujI`!%tD?2P!^#j?IHC z{mngctR1$8+q&PP)z*&wLYV#bM~(Cf?Y++&_OqUbWNIJl`F>XP?ZU!#e1Y*l&>0wG zeQSMUbw_i@V);eI`c}Ntf}eO$R{G6{x*vJ=C(fKX(DKbK0}gL6CGZO1fi~PgQOZCI zqv_UoYSn;U;i}ew?B)X}l5x z_S`5OVbPe2u z&;z`kX29l)<$KmZEdX(>TD);z7WcCYar{0+l&e%Be}`1kJ~n8Z^605l;=4?x3dPd~ z?RkS{$NgX2A_1RErNC#uc4JuVA-ZN+)7_4cf;Btr+(Tr!pVC<$+R#VzEJ6V$dE$ zY8vxxRjEQzj(c*FR-sa$;oe<2^Hr!+p}5hY(HmGPw@^G~(4I4Bdkh-A%2V=9RjDCj zx?)%b(7Iq~xTOcawJKF8J~e2c8#EhUVj%fSRjN>I z#Jw&Lm%Tux3dQ3{&1c$EDpe@{ij1x zb*U8i4B9;gtrA9h67$VdDcGbzyTPE@55awXS)WQ3inEbg#I$o&s!&{mR2|c7G4%dhvof;aR`7)Gkt!03OTQu>^z9Dgo4q zwT0^dyHVuK!YyA?fx#%iS)B#jU8Qy8QanAbQoCn;SEcAImgx)ehym!`o=Tl(-#gFl z*kS?K124X$tLX7~n14^O(gVTENU$;iQU6UX;~h-gRGFv8hxWP)h_}qM-409DIos_v z^9A&XcRIOBJor_Iwq|80BSDqHV)T1sec8r7G1x*cOt(6)Z-WX~1fh~1{T zlZyxU_gN=o=YDmK6{!h2Z4)Wh8~WQ-CW_9v5<=@d@Qs)0p5RzY*gY9hk(RZg27}AC zPp&c(7YmYI7b`n8+S3z3_xrXahhQiMjN9DKZ$~mzz1@zNZ|W?2K_;EPfYLe(iuH7F z#JjOfW3v9;186+Ux*hFYGt$BCjhn!uFYCHJb)05CPmk9I!-DA4bsnl7?^sYglCs?% zG}<#~D@)`8-JWt{wnJ>qi!|K7Y!qo)<5&Qs*@(C*o;#V;?5&>lk5vBV3Hh15^_;D# z+}T@qj5AV2MkXEG?m=(3aQrC!v?ZvE9Z5uqjzaRps^-_q&(m)*lu4;l~FmQmryMx zKB?U&o-lXUL!Kc>o`HSREM+Z0PmjHvJO{M3w$x_ik5KtGk|yYxTaZ!(=~dHGTzdhE zO+%?^megbdYibHXPSJ+DArB>Ui#E_}M0+2`e_Kc^y$>LToI252!8P-cZG>GG-G~2R z4ux=${Cb`pV2vR`{Vhd?&hm|L<$7E+2dtBGW_SjKE#R}GUEfHr9nzeOD?hfl6 zmdq5^^QrPtjJ3djQ(41y!v<$>UBAmxv>~BYzrJgzrRba=bMH+WExONFI(5inJ=<*};TxxtMiAqM$xdqO*JN22%5{VcFwmDBsj_NTyqi?{a+=tgyZ z$@+J5X%)s)%2KW8n|xGcp!Iz4V9wfD zFF~5>Md#ps`9k@&C)Chk;l;wLCTw2sy&1Bcn|Zz0gG3dvg@PRwVirw)d0?$|}VsVljRunP$)7m}%gc@XYEF=7X= zsc3D9oOEbS)-M(1QB+UQU{AN9K`h~W9^=k{-tFLdOPcMm56$p*JBD&Ypu?k!PWDcc ztJus{+&dM%vzG!QHMZ|(2GKmWf69>c*gm336fbn<_1=T){>OS6%Ob~m+SiVCx#Tvx z$Lz5#|4)o{`B#qhw7z3KZGXp_YWN>E)@l@rmHBi#ihJ|b%1QeSb5x|G@67r*_EBsG zl#RTsW~YtK3judt@AeD{PDciaYx8>V02u}40)_e3C4Ewl7q-Yg2{RysH7~bdqm{&i zXX=vnY3p`?85A~co0J(BFnRnh>4>?;s!2jQw0YNAJ$CF^RAVT@-Ud9d-BL9h=&HwF zX67pEJrGedq$$nzi5YEV^ifHB4IFQ%(EEASf4dO}X75GrG3&=}+KXIeWUQyt0p8C; zw0-RQF-~22*H2vd>*s8Mxb&`{xY&Ez`<@_x5ahYmPtJBb9fV@M`$S9q?O)l&Wsa84 zCby8Kn|4q@2#OS)E(K|K0<+uGTPNuru{IxcPp&>|vQrJ*uK^z}ZNk}AU)Av85>%tM zhx2QeOq+q=Mi2W* zn`e7^iK#NWrqgtzEnEl9*J`X-J_ruEEBYBXZNq$ipiTwHB1A5rdV#sLiGb2`QAI%x z_9f5k>c%`!`~0$=+;v#-Y-b#@e`6y9ik57i6JvUAiY7gheS|F?XE{o5`Yc9)adm`^C7tS6}v|+c7?$KFw8k zucHgaR*|!I5FHM6?$!ir7J*CjbT^^I+>KOD3xe;v$U1u1(4Ki+agx<->zy=Yn`(=$ zxoVY9b;u&K_hNxvOg<>;w>S$j`6sSx`z zTCczs8oGDz(ViLO_8z-hUfZ#}akmmV`UJ5He_kE z0k;9)=c11CF@cNNDFB!asv%yQ=DTi)C%+WiY{6Th;j)afy)(=#x2j)o&P6u7rKKm9zTPCE2c`sz=e z@5532Z&atxP^ZtNPT#=PxqbIns`F-Ke}xKvKIng^3WJ6U`7V)~;K8p@A+fCAnyY+L z@mJ{N2YLIa6P%{2TJ72z|DQU)h@qPZnU|EwR~qTD+hxoEf2kzh+Yk1x+J!KQerrpX z6x)IQsAig$fM#?yKy_xHqP>3<)S461g-UXNXu10ucaWADQ;Rp zaak$rwU;4XfiTC=f;8djegS@klc$xRssP`!3uvvnZeJ0Uw5KofQ_;d}-u?r9lqPjOL3A~Csg$0pg(Fbcj& z_r0rBEWBUsuwZ-Fj&^bpsE_5f96t-gAw3Z~xjh=;-h7ZL(6!Onpg@IO%E2X<@!!f~ zP`R(Pm{wb4fX!I5DGifV3sXe|%)nukm3GioQP`nDPv zNUNsmZG4ommk@(NrdDZj=%>|}FajX&UtdkFZdR*(pRQjDazCxD7)Wc%6+xwBfqm6B z_N%Iduc48k4(>Hzz5m3@N>+p@4U>q5tlYT7-DHGXLyvf-=l40D(jMMBfKQ*Ka1mc= z`CLzFhn&J(M|LpEmC+ExPabxGsI}?>)a? z|3=ZaH;Uzk`v1*tgnlSg?ncUxke(Xbk+Mv8_g;thH3V?GQ`keXs?>&L1UrA$5ba2E zzxj^jCwedaA0H4LeeFFU)Ba}+NVzc}d??D=!+?|za6m4@mL)R+w591YARXU)PcuUA zxc}n=f=65S9*~Ov83R&j3`nJUhExu4Kyr9b^c6GY&CkAaS9Bp(jQ@_C!Wy^tAk6!p zF$i=@FWr>gJP7u$8U!}`Z?>(f)VuZmEn9o90s4Pee~NYe&roci;}h9Koa=wH4cQz# z-`o2+_M~dB^Fb!rZ#Y9=W#A_Me>j71=3yfM-A6ccon{z7I1|@p`#0&##M$p~#@C-Y z`}S$hJ^K|v-2HU{#3kQ6fWQx5{+C>3us;<9|3fOcgAXCUVuiR!@1&oK&=}K=No#2}Gz5BTT`nKwaeIL&&JgV|-)Fbo#*ISK@^;>91E>Z`PKESt0Z_rVv z@r@3oDRcc6zJ;CPrAx}{mzQsUXL#wdUtSd6?mDJc_dTEaM&omQW_)I6#-|Kw zrSZXCbCt4mjzmh1578)PJZ8ereSVeBH*jsxH5JPU4@G6^T0Yvd-@5LnLbIB~-%!nS zF)nto@_;pAV^RNR8&y7f6lgR0@?%;nW=5I+CdXQl(7$wLyE=pj}6|^Evljq$J;$ zNXa(nWyg{hK&qVi&O(a5LYgaXM5>Ha&lss%+(ezmw1r4XnV&$4zDk!X_Q18s)FzxY zNxmI8;FGkqMVi(DRY-0886dUsDN<4!hvG?X`Wj=dn1hsuQy!?Inp1Zm<>piq*k#Qx zLA|w1D}$nBY8ARDQxD*-wM@NmkWO_@(q&&YQdK$8sWmfo>O%}E zjw+xbPlfz?ajrNUsX0vBWTdV$Ql}mzzxJ9dZbzz$`FfF}uYu-@FO5_Qs*tqFM#_m4 zOa^@PX@)iG52`mlWR3cBu1)|KkP}p&N8zmXhpbJ1wwrj!+V$siodAApO5b9t=QI=j z2va={*rNXQ!Upwckf|*F=(zsS4@&D#2@*NnUzvjW<30aGqe{tMbNE`OM&f!D(`c5H z4d>wZ9dycu6u!v|8qGACcR4((WQyhpj1n}`2MiD?(yB~VB6Tp+=HY+RaE`DWDHl?Q zF^%R3%nrFeBNapn#s*ph|5H2o(Jmvk7%3PVXiM-vwVfjxjZ_m-vzV5^|1dV>wi~Gw zQZN|My72#8POUXkX{1Q*9I*laAIGVUM(P5js4qEU6aIH_>M|pB1yXjV{RscpaOzqk zbpuk==Nxe}{--|Yh+B-*9Y~$Xw0rPB`Hvj2#YjDfRFG*~@jq!KM?7Mr9z!b3v?uWY z$((xHNIj3#LZ-cl|Cey;6(jXJQl~J@f^US3S&D#Wghh-X9BvWAtAO~8@WGRT!z^Oh z+3K3|iEhrPYn?yY#HZ_{@@6{mKdksPF2(hMR&k)E#K2rgS12sJld^~pcNPk3F`4gB zJflc-REZSPEyd)Obvk8AcN%F~wlFR0Y&X&KRh`430W0VQxF$Qs@6;3%(ob3q294S; zRJ_#Y>B!M?4ee9Muzuet?PIZlaG;^b3|B-cl;p7)r^+3_&vIG6Ya*m1<{u@=$Z(*lOOFZt zj1T?MnB;ITt>Pf?(3nhAyjA_T%fG=Yf5Z+yNW#B+7?nTFnnldCZBzAC_g|m+mv4+; zM#|QzCTHrL+^0W>;JR;rNg@Y>AyjFJpQTFRW|Et1DYmG{!`qD(UilVz9qC=qvPUJ)G&RV5}qa zI$K-uyK#-v@!KuOi)hxR?At`uKFNtlCsDt=Ls0!ka6KLH)q_S^@za9SaNW1QNI&(R zkNT`6Nx#3k6!Um%Jc9DS`ey_`+(|sv{_F4s77EVC3e(?D5vrf`6g!U>`J>>2tmIE- zK>n-PDfMJpPACLO*D5Lll%~( zJ1f10MSncmS~LBgQ}&F>WI%Ds50Q?fueTPHesr32qSMrGou>ZkH1$uXNq$OC-p71) zSCK1nSD|J0V{;Y%Agl+}5B51|hd#$5kLKt+qkdX7F-Ew~_$G@uUh$ov__QA*KI&J7 z*D4%}w@UGjK)W;ph?n|J{mt;_2p6tN1~-uUWv;ugPpMJ7o_=^qFPVC+;zY$eU-4p% zg&hTZerBOxK{aS!)`lC8% zF4D@l5Z6>ko#NH&ah{UlWP@%k)@fbeV&u`ExxQ0yP4%5>l#_kWZr37~D871w&swbI z)%yAl@-lT>M58JbS7o#u6eCa!LA+A8Rapnsk#;b+o8D zG%vM5ZJOI_Q@rhcc&RR}BVBJ&@pdR)ZKqW4A!u3GEypMa?|hLuU8(rBel#DIA$#aj ze5?EL>Gn0>cNO1S#i#p4_31jbeVnOy&r-a)ZK{j+-Sknqp_l2buXVQTd3Ec7ADOZ;nz#z4Jox=bz)4$iuz=7rYuX>HoBgb zxh@mSQuRwSb(ae)M$3b#q^XWd(QaJRZyMUg(ga>x&+U_~dPGZV*-BXl<7u+(4^WU{v{cDBCg^tqBn}9Khjpyrt2VDlSoE_ zZJD+bqE!l~;xgiCSF~D3ogq_7w05?foauL$Y7@UC5NkKpw^p=zTcaIu-DVHQCoP(p zMEbvgt}UId9r4p6ZQ=OonveRIwl3|c>Rh%=(@2&Lp!x8^V@)HzjaC-f8FH#|0qp`S zevM@*UP{ zwJQBf+QvJR%Q9_T%6waXhjKA`;WF{k-Uw$H*2|EmKi2e%FYV<4R4hYwCf91chGk-j zAD|A()Bcov5A~h?GQKKD{1AM!9$cyTwf`gjY=31HKT^C`E8amCIbYksiyv)67zi^~ zdZ95bFy>@tOoxgTUSG@eG|@)CEeo9yZ*hj+)U4=K?^szcOfpjk<}c56BI@#`syx{) zSFChTb>sW0+$QC5$wX3s>E-#B4}-EQ2n?DG|cri7&>D-shmf&wb!5C z$u#o8LoseY2Cx1EO~3itpAV+CXnaWb)P_z|-8xNvP^Zan>9ihqDoegc(q(M15oLIM zSrCi38P~-3GgDopS1Ln%wmy8fC_ZfmR3GtV>a>d6RGqgQb;`C$UUQvyD!#iEU;pcy z`c>hmM7_SYgW3 zwB#5%u!|Mt+TY!WfpCe=)-}AWX8g7*SFTGjyrWg?;uqlc4^u$EHE=fM3O^j<=-?gg!=h{Z)y0rFAervF*PttDr9XFwL zCTXv{fp?m>XxV;=HmvEPyIY!Deeu>z>|srp?(V2x8ILt*Y{Qx^leE*!v}uy2{5t8* znl6{L`b2wEz1;uPxX8Q;nb*n(868>*U=^u>Bnp;@M15lP1{nrCQrlIAy; zUo2@fZL{QABI#@7S}5gcR5TfrNLrJkt&HonP0|yJewwNMc1c?feP*?lQuNy9Rx%>3 zGt570x=ZEx=pEFuE~cjyy^4%h>VxSU6&>e@i1R7-v7?#?VORQNO>f%0*Xn>a_1Z-8 zr%)HIIh00m@es<>diQIfUN6a~nAgaAacy3w9#&<3qxdrQS%l8}ZJ#=*J>tvZb}eGN zs^c-mHyY<0bgzNdM3xh2T}H~9D}JxaJg&;^g8>r%F{8Q zt|zp7#YoKfwNkJeb+BiO0SQ!Juo=f2{a?iIa&a+A@&d|Xj1LH?N$*P1`O z&3y49%1lHVs$ySdGW{JSUIss17XayVERe=kpNqVJ*i)X_2I=>`>G#Y7elLC?+{6c9%Dn23*X?)t7HN8pko2(I84YwTDL!<^YT<)U-}?L z$4{zz0wH-0oUdqZzcb)+$GqWK)b9>E9YMFu$2l#_?Q-jUm8)bQtn!17h$mJZ3e>WY zvR{QN4`RzKV!}M7J`YiOwcc7o4?`6#><%q(EBS_Ln$zR1bx4_pYnnG=lr2&;{64+I z3x7my6f2r9;N-gcHqJLdMe7i7tAHS$S&F^>aAL&Zt{ zob0@?-&%ka3X0?t@45R3+E9eziRn@x<` z7-aBNxjl{r-ashKZRZ)&j%lHhr-hfdv)pxj-^r)j8Dj7)z+7`VBJP+UqSjD?rV;gHsKH~@Rqge; zNe*AY;bNX)29Lw#3ix9tRj`c>H}Z8yv-?tHzI7 ziw*v;quL#-!azj=(o9&M5+gtAcgDhw1#TC~jM?Fwuj?3L@YJ{?)Y}*gJVtChOJT-5 z*^{BYP8tz$Vx88kiCO1-e9SU3>%yQEEw-iy!Y zu5maQ#hiiKAk-cPzm{W+!CM^&Io&a6JQTyo$HEauBr5A0Yw*<7`becp#&HH+%M)?? z{OG3eQM9+%}1`ixT~{M)Ov{@9rp%la?FoaM&W za5`Z&F_+u#b;~&loq+ClFLZ}uSUAX}V(Hp}Zm2v>OUPI4gGc1{ zpdZj9p=dZl^?IwZZj-NM+l6QLM`E>JSTH6Ew=;%{J>0hQ@cy*Z9-gSudp0BG!I)?HhrV=v6NOr8s2NCYteXUnn1 zyvyW=-4U8W+FxSMW##EuR0cA#Jmy`7r^fBaR55%G=3XXGJ(Ym9o989wStd^=s~xm( zD|^D+%H-4T7UMkwdM{9V{|9tH9>`!)9?7^?I-R0)HN()Aw=oe9H+81)6HK_*A$?MH zTe2bEXi(7>#fDbZ)(5gJogKkXC(G8%6ttJ|dw!0?{T#OFHkgJ1;1G=4wF;&=A_(BB zqM0~2N7DI8ACfOuUON#1IpCH!*31l=?=%MFsM|zy=xj8=9IBo{W*+PkHJh0y-^`QM76n_p zV1;#`3e3DJbVidVMme5?&3vYIO^j@hg=W4e83%1@+%9JzXzXW)n0dme3|t}iNw{My z*W01ye5Vf)G6MGnnAxqkVVbG$GUu2 zU`V&)%{-V_5qKh6?E+yh&1?8Jn2?hHKr=6f6LD3@9YoBe`=IzHnE9MOSP+61`AA~K zOACmaPY0R#yixyrKc;2IJXq%w%{+2u(`0AaCziGIPdrNOpd05KnqyvyRx6Jh{{D#l}$gwKSVo)`gge zqA+lAU#IlP1OJNMveb>z@1gtTlbz6Q9=1=ukekjtG+)_1`JgoHzck;}ee&TM+OT{s z^6-7~khiP}Ib3pWJHpJTbmqbGr`wvAl|MTe^SDt|+U#_5URds5u^(Wa_SO3gGcUYK zn6?AhH1uVsxp1VJH@n_&3{wx$r!k)8W?uGhGie&Z%FXGZvLoB6-Rt50 zwTcll&)1pm{}yCF6Fy7Dj}{RON3n6Oc0_%8PiJMCKIh`Ynt&fiz$A-~AwPpGe3}@J z((~Mic+}~lzJ@GU8ZjzX<{DoWHo)XlXtyd|uA0Ay>HFs6SSt`wTsVG!qyJ{SY(Llo zd}VzO{~~;IDf2Ax=TfgVzCe}37YIgTZchxME@A+w;C?bVUaL}jQfqq8p0Fe4z=OVQ zmli=+9UbwOrHR!_?p&fd6ZN=}%se)}Zo>{Z*{PpvB6}6Z;B(}+-91}1e0yJuZbs#q@2PAS}30COtvnlPjtq$ z?3hK|ghSpCrY$}>;j(Gw& z2GNUw(!D`<;Q*OwR$ z65EA8BV))%$K^P6F{YSWi!B0YpgPYp-&d=22wBZ^XB2cgw}NHx{v2P&5i}!JQ4%3@ zh1Oe*wyWtdc7Zn(iRv>soZ%BK7!A3z=s3G4I&K1KvK&vG+w*}gZE5HkGO|yc*AtCA zDLZ14P3wq$s1tiwVxXniLBRo#O*UrR6BDT1Tm~14e}ufArLPZ=*A@DDB$t(a z93}HAb>3*s%g8fE=JWY4jni1VUJ&r=^M`SCjesIdZeF!No@j{i^!0&sO^1JuP{^Ui zW&+Wil0fwyMAvl3080jr-Hi2rBGG+8QZ(DiBze7%2vn|=t`Usjn2xWf&^3;q%%RI)F7il{!2r10E^C}w_V1ja{t z5;k0$^e^mGW)Ve#%x{J71O)?0@rOEV#`*)A*GIQ8)cHHNr6{$I@O-dxd8X6;l!(yZ zWX#_R5#P(n=EJrOdy5$2*wCV2 z00t!cnwzF4%KPwQOM}~b?y9If%FwcBPU&kMCkAjeOX(Zs`{c=S%BFk$YW%1VAvgg# zm~_eWdu;P-jC;&7e*tc4(O{_)e#JquScK{fjS+5`)Ww|q><#7Z;kvy(M4X-gYzteK z7~)}{kNIe4AErC_JkAy&6;0CAdOa~&CbYnzbZG69@AhQ!3i{+#pA|80`7%PeNDRNoAbg084rTw6!WA{3rOqI+}?DS)v;F(8W zgYz*@Lh<$l0;mpWThh~*^mn#Uu;q#`!xPsXm^@#V%`pN!|I0F@_o($7-q3WuDs&ux zn}u%WYcY_c(T%O_ z+*hPKPAEY#zmucsX4&MKHs!x-@q@lUG+4$Dib;kK>VkDf z_X;K>4x@VtHyLqGWD(u(!QRU7!T2tsq|v&8t)m`SeE(3=^`=eD1$^%?!_UJl{S4lx zA?eum*TBJ3-|`HaG!JH1HaSS=$>oLD-b2wpJnO@DGgS6ZRw}zE)9Brm${s8NXOFm- z>#hrW)m=J{W~gne%A=()7O0NFaIp^Y9RijuN9C(yEBHe^A4A7qO1|7a`R4QOJe7xq z25XBvyBK89;6t&?)a!4)uE*i0O)@{gpxY==c^F|#Dt83W6By3`3|4t~phq6WD*YE` z=<3uL7EiuhH7GleHexJqel}e{Qo?x!ee2ftWm>8vSgK6 z%C3iGm&eIxrvF2;^TPDVmiFn?_OR@Hc1&J>bwKNPct82(Io~H=jUUZSX@f=C<$1$u zo_BrnUHtrw9DeCDv&+-zGV81)n=bpMbTuM7kG6_jrVm}V#iG*p&GSd$jU#O1#bo2z z8(Z`JdA0qW$v%06vU7_%!(#K5XOqT#9euBg^W>2%YB%4Pl}A{d4=W5gFn%hI)%U76 z&xh0KCe)T;n&ZCht`EGr0it`LBl;!k2DOnE37~VR!Pn{L$dr&$LPl+M2ljZb% zC(aAVXMglPCdp6B9ppm*O17o%EpeXexAw{UOkLk!VjkROfJ5hlTWx>(-clx?;yhL# zx1sMV$@VkPV(R-yO!s0bGU6tat|^M=$GKv7+9P{Ur0*Zec4^Ck9X(`|?`x3y(D#p+ zrw-3W!874zBA@Bti`r~UBjlQwX;iLznQK^4$XLs<=b(p2Ex?3C@`d;oO1ABtlL z)eoEzfChP#-^t-?<5+^@3jMBtkx~W}$Q(x!HLUy|>BBq6fXYzk{;qfd~$|`5v>5Ek?^eQiFIN zLf*ROXPV3u^tS5%^mR5NZdFknzta>e2&ICEEky>+qN~vP>W2$$?R45m#~G(Her+p|priykwpbbXNX@_my==4?K; z&)Ir04zYCy8rx6O`leaFsw+CU&*bN+DJFM`YXXU3OXjy@DN`{)iU*nEJn{&g+k3HwKw!D&}r$xba}I z*}3T@9uPafEvB>U8CDEAznEXDeL89#FLO-AkId-<18pO7OT}0?de~n(wmEF+b(w|O zG54gyq@mJIQmW~BxZAc<;wC(P_Gyo3=Pv(y#LO3`XHORObX#HyH@6^nv$P#ND~M%B z-*WvG#(dXYsMovD;d(cJnP0IncULE9rcs- z_*IqMx|5kT*wL-2U6!2*LS0~?=l);4M`tJjgKB4l09pMMm2f=Tl1KI z=$12uYKQ%}>>8#>c8uJJWSWXgp<1i-PUR(i6=%Qb%vX$AkCY14a<}XdncL<@BrlSb z*Z$fm$>k{dlgAE>jZg8=N@|u@L9?95vCaLK8#zuUxMLiBwtVEi!um({d`Q{K?!7Ih z&<>Sxhnc$m;ICu}>wdrW72aHtJZVx?#}v*7E7>oR8@Z}dV{YGnO469QGUnb@$K+4Q zb&@BJGkQKK&l? zd;`M$g$&P4j`*?bcytdfN49vLyBzMo;o#w)AbDOk8luerP-ffGMyt^+F-^D@S?y#{ z+;NEYQ2yJ+-iYUAkWmoJ!w0hjvWJQ=1SN(OVqtl#o-uXd;Y%ubcot+iLOukMTyDYV ztHP|TGJd3d2V#q~z25AdTcsI$xx5AD+vpreDe(LXB0dG5AAqzYtN%b2BdhI%K!$Iy z+GB$PW?T>M2RTH?huUXBmXU|rPm2yn;JFMUtBQlwmmtl^>L!S^B3S(fvdlF=toTUz zhqv>*hq|^Arg;!+MPJB?;;bx620(O{nV1EheIOr2JPROiXL-itOtDs;CqZZQnJmvm zkdGstPeGQmJQ7f6<#}$1RmAfXh-B;w?YaxHn(_$8-ypX5XgrP(8HW=nSY}_>b_VI4 zXS0#t19Ba`P*)M84H6=M2Bh$USb3g{eEf<`p8@$oKDuIi=WCGB7qfN!4Dtgyp{@rY z(u1L{ClKx!w^o*C7s##1Y6|31YUO*`T6quOKxdQygkC-k@=L^X1>|zd!v}K%EmLsn+V{Ub73ay}CQb0oc*?I2pm9WYjyX0*$lTB%iAE9p*I z-<%-=$1o^~o9-F<(V@XWnceVfjqb{7{=nY-2M-uF=fBtPUXU-9Rd(w)YXr(|nRhK4 zfE{x`E)IBG-Fxmm^Ot**ca|wou2x9_(&&`BNgR$L0%toY(Rw>86XT2J3QHbV*gH=$ zj&`qG>b1J$#bGym+q<%X&~Xo!DoWymO&Etrvy_A4xU-J7s@}mN0>?Bcu}H{qFnD_O z%Oa{ip|ElG)XuZKB$>(jlSMNO8Mxn*taW8QRFsZ@0Rv9ZhAe9#fnKTB>5zLyRH`9= zL$9^K?!TnctIJ?<5tV&LzOGFaoYR|VbadHEsg-m)oEHbDCQSYu1BXRCn(~4j-=*5w zQqroal+|H4Cy$NJk?UcIU;0>YQ^%afW}aD<{zwgsl@MJOWjZJud68KvNlCPr$X|b1 z^^R^Vk4T3R&}H^=K={VS$0tqR^-#i(rg}43Q<#;3#I3R(7=rT~Ig!=az>Ta*?1=PZ apChHDQ>rC(@n?!vjp|RcQF+s)ll&jK=qk7X literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/bzip2/win64/compress.obj b/3rdParty/JCL/source/windows/obj/bzip2/win64/compress.obj new file mode 100644 index 0000000000000000000000000000000000000000..fb828264de6b35e364b31e3edc0767795a6ee5f1 GIT binary patch literal 66475 zcmdsg33!y%74|oi1VUJnARr)MfQYyd!y=++&1B|FW?(jF35i9=ECWQcIWu7^=pd*d zP*G8FEp4@0>xvdZX$zJLR;_ETZLL*n6^gZ@wRNfHf6ux1e)CNT8pb^T^XH$(cnAZYP*A27l$Ru;OA?9*@X0z&J2R|lUpyv|^8t!9|3xKj4Yi5d6rmGI z%T7&m;g3Fp@mHpmmX$0?rz-{iOG!g?^kF)oUr1o^|8h;6^a~@$3DU2qsOU6@USSKn zLvC03S>xK<8yiZR8tcY&3ymsvPpA{E&+YKqJbG|kQ8vUJ!k;Be(`=fhkfhqrn%fXv zH232ACjN`Jw#VwDa~C(ZG_)>`&uy){cy8UY#Nhq;V_MRBPN7!6xZ&vJ zYxPZ3!5?d#AFFLHssO8a(ZnS)rk^x7C9Y z?e_&jAdR2NpQ1?>t(n`uXp#rKT;nn{h|6nthaLL3u2`6?8Fb8!8x~r0M#<#4-?rl1 z`ArZSvKLLN*5a{xt)ygbr~eWQ8e3r;hlP04Rrl(xcuC+DP9i9KoT~t50 zv=n2zj$EI|LL=bmS^HZ9-xi&H%LhDkLDXmAM6{Kzv{(P3k zc%-Q|o`}>jCvFk7XCeZv`j8&fo^e2olKAghwIu0=vg9bh3jwDAMgZpmUIcgQasz}Eq<2mCkSCcpt`?+t*(fHwl3 z33wA=CE#X258%y!)GxOJQvc1z-&8F>&F3x!j{1B#{!Bhs7q4h+X^bz(*yE^ws_~~j zB!~KkT+=O)r%8W9$0v^gZZhC>z$t)Ez^Q<>fatU2GQiUTNl(yldsZNQQm6L(5x7D4 zdkufrrTnojKIbUM4UHqJpTM8b(!%3vIMVH$Ut}IvWk9J9$)|RbP082jGYk5XPO|~8 z07UzfzXbFElAc~b>K|e~xl?;+%#jaYj=!zu_W0WqVOL9H>Xf4#S=6o>U?$qpZf*zJ zTzyC`wS$7k*%BFoo}^0{@D#u*Ko{T~K=Q3>K+>}YklI70EA7-C#1d`~#h(W|x5vJq zHkM&?ionljspsa9@0H?DeMly?1^;o3C42-rQd=$pBwgTVtTTuVP$2dcqIVD`5toW$99OG3o>1au;K< zS6Envd=WaqXA!}VaMT}yW|=?Q(x4F|>QaGQ9K(93u#gPU&K27dF|81oiNK6yOmkx1 zA||4ii(0y`oaGl8m_}`=mSw~WiYr;7X~c`d8Ik%dO-+$>O01%_*`UUUC@(T7V~OTA zZc{a(SdrM$r4iB2^HOAoajXEVje;XJpVrq!K=~}haSC@i%?av{=Q`w!5A`4Q|2e== z{G`uP^f&eCjew&8Zvrd<+zfaw;4Od@r)~wj0PuFe8vuU*h_to^@Gig~0{#i`$ADxX z;FA3Se*$HT{z^#DK z0X_nF5b#mJe**p-urJ!W4e$iO?SLhKI{?1}_&A^)@CiWbmEC|eCp-yw5#X-@n*sL# zE(iP#AlZ5^;Ew_K0d56+8gLKbZvkHgdUgQQE~v4&)*fsew!( zl_0N zB{m!RmSD6AyXe+fTpNOdO{s#)SZjM*TssEXjRrOzZL%X&Q8Zg`Am_&!u_lFxvLZ`> z_*nr3f%?{XLK}ukFqhP|wyAAFZLo2fAcaM=dzo}zEq3%AzJM}?LJ~=XU9_|=(J2x) zvZB-@f}pu}i96cD$T9=jQob~SDS%j|;&WX+i<@CkVf`Ls?$Zp^B4$)-R5(!)i(bMwgdt@k#!<{POWIh35SZ-hAf@T!@?|!I(htw_@9u4NMn-K zS+SGR{F5j!3*r|5@8dpgYmKu}5O}mA{P`?ADUkMvNhuT)J!@cilIbjDJA`~-1C7QG z`x@Z=ETpj|9FI<(epnNxpu!8}7@}kL0}2i>| zLE^!O=ReF@JpbhYmY_TrkbE-_kW}pti1?%p09*$+5Rmpn1%Qb0S|Q-afP(>tph3p~ zo(_m~vI=l0Ai3^wfUSVonfX4$q0$2q2YrwI9zXKcxNb}ryz%K!d z0ViNMoB%ix5c{ko_Fo$OBY6wpDS-C^mH<8hh#pGr2Al@?S3u~N{0wk9-~`0uGXSdq z&jg$Yh&emC2yiCgHGpRWZURJnOg;kW0Q?BB0`T~3O{)Yv2ha)F1n31^2IvF44G;^Z zL5a3?G z9K@^N0#e+10q_FA7XdE^dxn z#4ErEV1K{_AkIgUO92N0UJW=1a3f$L;12+g0i?)11n@tALjenPO&bO{1@KtF4S>S| z_XCaq{1R{^ptS<=46rZYXu#osV*tkhjs=_qI1X?I;CMhgU@@Q<5Nq`0#ej%m$?pN4 z2>4S##IocofF}de9Dy}_a(X59v4G8hGXMv;5T^hi!hynBfFU>H6yT>G#3{hreAwdv zmYt_*SoeBP2Hg`T*|) z^aDN$cpl&mzyRROfFZzl0Kj;Kyp>Qx#u2;Ie zVZYmFb2w}vn>JPw9b+cay$%zJ;xoid;t%*jKD*CtciVzNmjiolA#A9bNcY-(4wtu5 zng98IM1tmB{9lm4UUu3C=PR@3YS}_n>w7O3P+k^rsrPOt3!Ub&E@sDf*xB4 zKBpXfs+rUuE_b_vPCbzFB{iU?nd!)d-L@K%nW8L~!cR9-27~T!bp*ayj)6BD{i8<4 z^fW3xfFT`G{+HsZsLx2F_PQ!6bVo!6kQDWC(BLf|jNyR$e4kej=#>$9DXI;Zg%-_J z=$!5LXjE-Gs#!F@EfCZr7<4|b%WiYK&eyRa7KK(>SP^g`#<^>ZT3NCnsN2HW+iu9EQ90c`JN@^#BhK_2Dz^c^gxA%+j?vU zi$MzQLfE1pNi6au(&6*K6%9KSNVE}}DSi=sp<<#;D=R8~gJrpF`Vdt6BdVbvgJGlJ zX_S2cY@T*rSP#^YH94fZ-MRz45vXCCJ`M`(33SYK0X^a?r;!gwusbQ#QM@Dqi$Orn z717;#m6%INVIr^^1Z27hPZGpHm1m`w2g#ACoQ4k7&o;{EAWr+{Ao>ME0T%+U&l}_+ zOH?^2D!triN2K(J{T`dwR;japjg;K_7Buc}<}M-`WRR$4rSv{c(&QU7&QQo73B$K3rbYZ%nauG891&?8 zo)C#?fl(o7tI#7fn}&SCTX@k#G=&CD*lUjjZJ4~M4HVXAYfAE9gQ!vu(a?;*w+lN3V?3J$v3$r3-*z^krCICfRC=SG6Q zFcx?`6O)u-htazAN*ktOJ7zeVVQJ+=QwI?rYYTd1?Lgo;% z!e3zvh8VAi`!I10$#UapN^t1QjQw-cHOrM)sRfO(r@$F6ZV*o@_1W+_GPOtdlw$!( z{z1iPVyf7I&=f*2Uy}!@_nH z-KY?4PZhenRhU4rQP2$)VS`k;NLFCo4ksro{Tm!CT9qxp?&Gp^Pdx)9j%0X>6AU>R ze+2XZxg-c+3?Kvs)%wb)XA$*a3S-tKc2X3_w!qnG z!-F*|2V!n773N3*Se#?p59k$GZ+PuGFBnO~0<(q{Zd)bCi%7^P=NI+^V${dX$k0Dm z%Jz9!e;Nry+)toY{}`&~rQ;*CFJfa+rT(1?D+0Dk=1Si69}r||7@K4&s)kr3mntOm zS15+_x%?CjXGbc+@L-x^2oJ9Vo>tVsAZA=I_GBERsSN&xGOs=dD?6<2D0D;+@q-wb zw9p|EI2}mv&g^g!B>^5sTqr7IRa}8RK?qmuqBPfVK2vebepXludq0*Q7OhL zX@+nFHsx60@mM+yB^C{n361n}o1JD=%)I0wUSGh2;X*C@5LAP;aIBFc9kvK4r6mRT z{a={_l{v|)9hmv48whRXDvWmdtEOR&>s$DD##eU5qID5eEH- z*#(P#>h<@yp52$~9FJ`l<)-k6pi0G53ELISgscLKO5(Vcu)Gd*ur=OiR-u}pUq?)Z z5!v@>!A&Junk+H4DbyS)$yOyWLM2WDD9R8%$H2pWSk+MPvr>OSVVM@RMLf~Og4PB$ z7vZ#A;Bak%hj(;6GZlPx18vo)#n`Bj=eQ~(h`wI83oAD?2qy@L8!qg~18$ogZmZ5J zEat5SR%f*1M{9jyOmRH)>0rcaCIWY_+!U*wb(Xn2po_gXP1b4$pKT`KlNGhb;j6Unh~s?C?W6e%Lv{s+zwN`s9S1sEZ@g`W$Y16v}-5tm;8=k|x^P&_C^{!>8{ ztO+v7Fra7(04tgUuxb!<2a(dG3_NCKgBx9sMPsp+)<^=;CAW}fI*^EiLK;-8`8HtP zeml!N7E~1QB8UwRcf>`Zt+W*PiKHC0I2OlEFW8YLv{j3MA8*!tem<%r%g~jjd@fah zEQJYBiO9mH8!HKL$wz!CySN_Dk-&Ep^8Y{uzd0<6b2W@X5O0z?BM~=>E0?=0F!Oi zR7?oDg|DKxZdoLrh(&9g5o2=;X^t{iP%{)8j(ie>k6n_QNa7u|8Nzx$muI0){Wyi) zfWk0>uq}~@g=%B-qX|~+&%na2m2O|T&5hoS=uYAOK`cq6f7f6QMvg>Vcj|d;-f4G; zjRp;oKLAVp=EpEF9ESCoK8zHE8bohM9}yUIRKk zn7|7*ZacXa#+>jivM9wv7&LW;j|nrE7m>hXzv;!DHODC$cyx*lv^v5z;@4i_sRM#8 zj~~YbYFWcwMyr0*NiFL!&EyvDku~fTx5EBNWx$93WA3%9j|VL+&y<(i(MVTIJW-1W0~~e8t5W?Lv9ni^V>mI*t9^6V+ZcDb}|0JyZ#rr@9e8zyX)R-3W~LT;PVyZYoB;~_Em4&rapA< zyB&@_Z{qRVIS^c6S@Q35hdnjuXV>)oiR&fTQqM-bWoGOcIxef5No%kk(7_fx=s zQM>Gs*plb!3!ho>`8kuX!hPyW#+MauJ@=$P{_v^4&iQO%t@R%#;r^BJlQv#-uVrhX z?8G@U`hJ*SbT{r18DBW_y^f{}ZaIH;N9*ppR-cOd-gB~u|EgD(KGuKmq|e?d`r+FP zW?hHJS<4xp|Cg&8?`Yn?Ufb4x|GSq|)#2S7<9(ORz5K&nf#aq=Q@OL@e*^D}MPayT{|Ge!pSEV>Oth7++C%SI&S5 zzd3l)xp%f*_qX@P;@+9@*Z*^$qwTjXGp;>xOv%#wpZXN{tBjxagIiz79T)h=!+OJz zeoZICK2vgtfAP|vA3E*$Co6`}Tekm=^(Qyt%^2gqeD9TuxAl4dl|?sQa6$fnW&GAVhyMDIo}c_=*{4$mf4mp|@BriQx##9vEX(sBeSYoq z(`FN?`8bRKY06}T>R=+BYk`So;deUS83Wm82_(N@@w9@ zxXiU?^!-iti!Q^vhLbTi3M>onyKC8w%g?xR#GAkS#i5sUQT|K7># z?z(8@q+gUi`{e4|zK?!C$oRV2`}Yle>(Q**&tiL5eeeT}qX~J$UweJ;e;;|a@#OC< zeQDp_?{7uBqKw~}J8PP+&*h&qTzBF3-`o5Z-fe7VeBp;T?Rl@`)2$cW^m$@YADRGu z&-m~M2QGQ)^!C+{e)!LABfKZUZbSPM|6t?0k1jel^33s5Mx0;Ln7kVAP8dJ^$`>AK zzjfo5;FrT*d+x8lKLPw1pZ&!9OW*FNt=O}DTHc~FE_oI2FB!jZfzz*ra_(I}b?AQ| zdF0do;vO4sP6{l4I%(Dg<8ORs$h9j^y!LnR+7L`)jDKsz>Su@atNP@?FY*iTy(X|0 z?_3%G==MH$ymxxesIeb>q;33s-*@p|fblmE&U*F64Nu+wzxSIg8*X?L%j7c#691*H ziMMRnGWmPg&tBd(@riq|x?9Znsjs(8ym#j_S6w`-Df@P7;cmQtW&Bg$dnx&R-fKU( z;_jEuIBUjd=y%H?;`8E%m#+K8ypvCR^=CUqpLu810qhSMzx9d2H(vShv%9bU{-M%y zpSczEs~CUg$G>^^$NR?5Y~R_x^q(^?-HLa#j4#f4>#rvsGiCga(7-pw*UW_Pe98Df zPrPm0l@DGOxZ|Q9?L4mT^d#=%^GUAvz2mO9Gi#x%eB^WCAFnN$hWN?&$4_{4cyUw!}EQ!|M1ECun%lqVEOJfuh}QPGUcl`U%%r0d#AqvnH7xxWY{aW zU;lQQ^{>y5oL2wfYaikr5aW0JvSam_#j8Kt)O_RSQTM*`Q@k@_eCREA@rmbbf912& zhiq-R;BxreP)wNxmKu99aOS4Ekym}*|Job2UWqs#X8f=bt9}?=+wW%^8v_r!`VKl3 z?}r%go_Fc>H($D^@aCPrc<PN4gl=a5W z!L#?jjQ(Z(hw(#??{53gSG#Wg*ME*5eG=m5a>g$m(RSVg$6ol;{Ohk=a>pM|3}Sv^ z{Dr6dJ@r|EfBDIyY{@$Qg>n*-iI^((%+wa&&t2tKWFGc z?TZr{AHqEHCFAFPuJ!%&+?PAv*#Fmi@4War%$YM0YYHs${hzMgd*jaz<~0?5@$lhk~PS|8U^W(NB)hv|llP#cj5kKX1Fe?_>8*-S7U}{!g%eVEnR= zf}76$Q|_kak4>w+fAP3`@owc<;_rB=X#L{RKRW%`-+c1f%<1iyV?NUG1`TCe{aJI{ z!SL(su$vk z2JGFs;M1)>r0@Pl=Ve;Ey=7s`;+9NnLw3BrHkPsfw8a;+)z&YZlCk^*&U@mS){eE+ zw=~4QP3?GN+qbCRP#?{>dVK>~YEV{3gP;}K6?hO_33 zTaNm*@ue;G-$MVEuA<#hj`(`=+e~#xENX4=%y_z>R$k8UnGh0@+)_#jcA-V|@L~F)VM7%9pk5Gf*nz5%K%tYetZ5dDQCKZmv z=O{g2G$>OKNYe+Vsn6IA@jEo%qHE21w11mbZ(~bsL*^?#8H{ISYR-mOM;Xwee^op790(b9$!AH#SEj_071Z$at7zE&MH< z8F7jlpQ-w2Ira~tcDI6Z-7@?xRiq8RhnuT!A+;sm)hgzw<52^&=|YR6ZX=vs&{*=sX23#q1Bj)GL?;0 zVROc-VaSc)=fpCVP5srBapXpA`n|kNh2zvPdrGDrfOV{#ym9nC19#fER>kXJng<5`Z@#AJtR|k+W!n39@BDZp0*q*T;qT)DN}jc zI|gpQfpbGST*rXUFH?|V;2tt?qo4?`A3#?mQ+e7F1Gn73(K`xUVSw%xnab1l;a*nY zo|UOQ?IQ#C9|PyeQ*=(5f(!$<+`w(YJtnScA>&S&f(;BD-r;a*o|ZuBc&1w-Q+b+> z`!<1d$yA>9pn-eDz#WG>JVAH7Oyy}#1Lrny_Zzr}4cr?B?rj4%0G%fI(eD#d3T-oR z%MF}!t-Cnaxz16XyEnNScSrP**`&<=`dQOwO{lm))LHfZL?SF*wWLYQ|NgDAUg^3d zehN?f?+ea#?&8w5D=EWd>yr2>Jnh9d8NY5VWp*DpzW;7XM|q}`s_ppo zJk4_H0IsmNETNPxUA289O03KKOx<(U{Gt(pWxFd? zWox-9eZDEZAeELa+YF(rc9rID6Rl23Oxb4Z&i+WAKnR{qEM;)ZI0p@SL{lBZ|kupnK4sZH>GEo(y*OkvUOuB zEp-%Kst6c)_CcNDFTcsHTep^4*MHwS9zKURHVZYR8Hj~yYN}}% z-(WWbCO)A9k{s)HJ&p(qd#N53r3GJGn)@}SM<{Zpxk6gJVNX3=5pxaUFDu{2Z=yie z)x}AMWiy=Uw^9?Lj1Xlegp&{xo$J(pe9n80=lWatqAL)Gwjl3`zmw83)56f@VHS6$m4CD+-uh{x)}U(HeKQ|KRVt z5}vBmM3wS4xFJ)lrn3cY8jJa5kIc>;v>z5Q5IeobUvi$R#BG?5Vp} zeQL>Hjdxj$T=k{}G3OkTIs-q%LcJ9#o;YvqfO1rs!ORe9q^8L`(JmUyqIcG=r2N4d zTzTr#Ut5!U!CaH_q@Q(#_25v_ZqXfP!##w2tx%a%zCC+lY8(^ z;?0#{dC~!)cRlOiJY}C#bRZf-QtI8sFdW-5dsfPpvUIbu;X2`<9lOW}I(9qjVa84D z`)gNUO-4F!!Y8jOik3?y|UN&?H*Y~n%4JUJS1owc^*2k&>T+B5tx`77TaF8!#8VHrm^_{{2J zLWpTNE454#XmDP&%ZhQ(ws&>$ZKN?i2MbV%GEiJ3R_)|`pB1w(Ql>Et#lvYlW~U+5 zhFCOh#mUZkLGNtbWo0eavvB8z)fV^lupKNs?WyeC{DV&(ye*{}nN_RI`|VQ zRI<7>hCDS3dD1sgCl$9Os!>8HFd>3dFk9S=*gf^hQ=UXTZ$IMdFpRs+r1k zot*J&eQL2%8xFSoEXk3)?XpQy&5nJ}&EMc~+QC!0Pn>_C9aDlqkG8NeOopevLpe8b zJ@>C{G>Q^Ec4% z>r$khrkGN|^P>9hH?h(|B%oMJ!mzB!qws*8A)^;Qjb*ARTDv-L`_o;p3EbE<8~+VQ zVzaX=HdULuW)r&UNNje2&4EF*WLRB{%KSlcODajuK_9vJSpq*$elJ1>1{~2W&p9v` zW$10nt=ctN#)89$$@t583C9DR!;U#}blVjQRcB9qdfr;MW68niQ{B0>$WR3?KqASd zJFtM8l7GbwC`2Q70!tsLOiAdwOXLV3w;g~)P$^5;L6ZJURJJwW6?CZKcSF7&Pn zRu<}A(K8QDDXX7cv79iwP2uhMs-0SeDNW36*uXU`iCO(^~4CLZzPN>+8r-=99 z9UNFv5kEbnMC$R#mqUz)6{y$g@yMGfB(`aWqRcnm-4`_|6H(@i>+Xxn&qS2@{<-_2@TT?X$CddSx%;B$xn`EIuRqK0H5%6!GzeNjU*5oNw9?Y^jCnTRr9cy?dZv6+Z6-&=NH z)bLD1nXezaFKR?4qRh95-4}(g4j%ouGG7LEU(|7#h%(>lbzcq&)2&zsx%W(=40~ii^2(OxBKb<9Y)L3$FDhuzU;#EGw5$rh6r$E z-My2-gX^FHoxAekES+f{Sh2UGLw%J{ec#q5e#_x#4x4jDm4mMxebt~kls@8jOTYFc z-L|6;?QqcdpPlPo*pIY!aKnN7_uv-_#FtQWm*?$xTzzGHtabs$z?0}4RDzu{c7KKlg{`05er(D^rCFKl=bDcQB^$b2;) zm*bZmo<$jqeJ22Y$R3o&_h6YjD4r8prleojpgevZI=`mW5OP&)smGAxC!|k-y<$oW#RSrA6Qj=l~#ixT(d@1UU0I z(AAB}Iga#G0qBbCT-Y=f_HI||`eJC$1j zQEFL{x8oNI@r?=?e&6}}qxxpVl2CCQev+rifv=}J$o)%|`yYsX#osJH%(BqHS+Js! zyY;En*{^XAr2LL=l+xS@BZ%?^E2h#&z&CQU1T|eMro1=_68ty?P6k0F`C1M>a_~wO zSJss!VDPf8I$NlOAG_cYC3FI>k+$vd7ES(il@KL{_R!QXTA9)JACYtovw-EM z@%A+S1IxPI(xaGd@;96T?>NHnA(iP@ z0`PruvJ;t!;N$dj9jaMuz%I>X#2yjI^ek3LA!N`XG|w+a^G=NuKA z&c9XQLm8S&H8TCJ0a(g7MNBT(+ z*z-eD;t0xgu~?y~Ouyu$N#`URr2Tlnr$ErJ5D2)QA^m~{$-zT_JW5k#$GYsx*S)Bk z&(11Mns#qZKbi3DS*G7m_Y_a_Rdi4BG~YS*6i@Tza!>Iz-y-)EPxEzgPw_P03-=UH z^968E@igD`_7qR^m2OY*G~eC!6i@RdZBOwu-^TV7PxG~FPw_P0ul5vA^F?Y;@igC< z_7qR^)o4%gG~a>t6i@SIXHW4o-)i<0PxJLy0$+2Zlz$C=r1GebF*@BUZQ=tN^`73Azim?i zoyg#wJsrv`JiW80qc=C5=DO);6D#Sb9n15#4YA@(V@=wL#sM!*q@ey9XlGnUA-_@O zDRJQHe=-prbmAzCP>H-9zf#9P>JX~)8S2VC^drZ={u{{YbTnHVhAjR85v0Z;MgMw8 zwpL=K&N5PABh_Z4mK&)xMrxCh+G3>cGg7;eI)-Juj1>LbC)wITBlQVVBN*3#6#e@f z+1d~s849h6jMS+{YKD<=7%9JziXtVXtwM?}!?LwAvX$Jhk%}9s?;ELIMrt_DM@Mnp zJMgcY6mx2uQ`5$C>P4gk?h_;Bo~>{f7^$BlHI8dsi&JCK@_UTbIUa=z8L3;1)X$C7 zNnS-)W~5#>Qk6bc`XeLtw2|84S6Zz-Ptm<@q)Gz{x7tX(W~5FHs?wy9dc{ah45`xP zM(PD4RUB5OON`XBMyjYvl_reTJ|i`1jw)?4QhSWl@M=}sWTbW(sUbD0bb*oDX`~9y zSEUU`YP*pd@Lg4Uk&$}TNafB|rE`tcLq;n50##aVr0z3P+J&k#WTfsfQvWkj{)nQx z(@1@4q}&&&(k({n-$u$=t4eP(Qs1ppxE~-TJQnV#&Be%2pQ}^?@FY`u5ypc0EK&); zk6>%{DL^6%;|q6UoXW-j2XSfu{!gPYi%Udm2=YT2Hyr;T#wi+OB2|PG;j>sziU?WS zMEqZ*PDScC#+Bm#R4YrHW~62yHHL9#%U~<;xyVzb8H5x;`T_TTz>)ksNlQE~L5b39KqnppyWlZM^2j&w zAib@!ZG|R0^_jvSW5TzY@IxhjmX?E#O_J)SPbB1z*lliixy?R1qI;`c0iQQgHB}2A zp`ffx`&iicSjqR~Bl7k8d~U&rQmDy&GeXw;&JpX`-MY;i_D3oMzOY|vVn(HOpnqqI z`dRf!7AAQ5qdp;jAnS|<4fV+wNn75vT$?@Qs z1`iyXrJaa6SnIU5%&%x~si%MZQaeQWiH!H-pU!Q>zoXrfpgt!2NdhnaWmEXybhH(A zwVup);zcv}+3hVYwaw9nNr~F|-_gQpS<$vJQaIDO7jT7YB2HJOQ=@WA*X3Scz+-cxJw#*en#S#$qj7mw z*X1s6mCfyPXotR|^&N`nYNdEm0{znlj#5dRGp$QJ%=1B-ZK|jb&@ICLBf&3M^W&dJ z7yUE}`2x+}gn!Jmy{$6V+TJGc^slT9Ps7`5Tk4}t_S&YVy4w1Msz1q>inKs&ebmv^ zBxQ_6-HDnF-hh9;7NYH~Es5xo1ozJbl$B}~_(z?a8kdPu#gYAE63S<2?M!6jc-G5l`0C~8GLBIVRc zE|{WAn@htIui90GJpB<58jBSB=O9l!swJ(Ok8`9B=Nouyfl4cWb5TZrW_}kSPy8-4 z>WQ|e%e811NxE8t&RU@KRrdNW%2K>7T7#?;m35RJv__yc1knoHTDAF-c7dc#w`a<> ziU+kr@mPp7*``VIXqG$_Ey*C6W_hiWwyhH_@lrNYd}ER}E@_pY65sKVtayt)%F@~; z{US-P?4#(Y4*A0pNw>5UoszHUz9;FHOFGpq;-`2j|F~4rUM6WLbUF6*ApW7~s1_Db zjsKOhPDz(_>Xt>~iCDC@SqmFU)Rb$dRkH3NEo*2ITF1Iuv_oCxNmnYzgSxbGJONG1 z<5Yw5Yr&i72lNs7t7N`(xX9C5m&$==`t`CL>zPAeS;abGHE^1S1~iNKO*-Ui^iR5{ z@&iy#W}$hUcot~2i)tI2B8@GP=#sW*eL~JJ?dbR6T5T*gS=6O`5#^_(@)NariQ2jp z?@|qu$9#VxX5ukJYcuji;8CX4HML@DBl+Z8POUjHZ;{|Z<$i5h9sUttE+_q~wZ*Nm zg%!2+iPo5!4@vL2q8+4n{Q@bE=r2m)o1$`^MEC|R<_)!0wkjTkTcE{4{??SNCapy% zC)ZI#( zTjJ46Lao8*C5n#Pm$cT!%iHJ8Q#jIPHE{06MFu~jTVrLF?E$;&7vR=g>sy=a@Xr}H z5L&EBsQyMP{+Z>v);LY@B%g4bM160oiEgvN(ZoNwv{dvJ(cWfl@r2;NRG0j7ixquW z5rg7F#v0)6=@XAO!Hv*cOh>rS-3sSP%#*ZN18+^bucuBTe(N}2eKY-=@2brLx8~v4 zyp)U$Ot<}M)QhyqH4^P*P6WH}qfC9Q$=CjPSOk#cnEZ_9OBLfTM?GpE*^}aD7Bk7x zt_7ZA^mTwlPia+`(ljO%o_txP#oR(XQ@kwNO_JAU6R(6($67$+U-7!tNDE%1o0-?` zlGhyuowb1aL)G76N>iLr_#esiFwFgQvOsMi9f*IrjBM>r&{7-kl66L+4n1rndafty zq}R*Q?w0lLk@YAx5)H*JoI!Bxq7wtk<0K<37J_wJ9xRX-`*yNt5$dGuVAURwvK};K zrD)Up(yBcyX}5Mk+nMj9l2*u#iIFbfuN3^x7X)&VgKzqUngG``w>xA5pd~V zhr34Mvt*s1ZV&S=Cme9AvTRuv@cBXxpFQl+y&+YWBg;DD`$#-CrcPf#>~;D|obI*z z9D2kRjD)><&~EeVq8xh>*4v@0a#<>M?f}I zyUI$`7lUP)*#^f*oM9QXeG2w~IE&#u;A80X2zJ8UB050ud1?2Tj=@skr7X3Ftg?x4#3kjddHE5_;+#YVZ9zkX{H1aZ^eg=*5{Bkr=^l6?^ zrj!>)HhMLmt++wTNc}JZ?nj5p5eG)gIIu&;0T&Jv1CT98vD+04$#~F3 z3B?8DY|CzsRM>(cI-ZsKS~TG7h`w&&|5nO-f_C^1s7yGC5HWygY-u#vR4*8EFl%Y= z9Ku!j4T)lG6I~54H|CnYEYm+nsG-I&$?(rH>(P(tu-FCvlVKNJfO33%0(L<#B$ha6 zt%5B~IkcbF3hHd&EID6ln%(86!7)2h5r!(H8*Blb&2ER=L>#);rHe5Nn*i_C=jee5 zCJu6`2;xByohQ%psNCmv9HAVxq53o|pBuvSVHBYQf&EsVP!g zS~{7W@d!oejgJnUZ}b7|?|0j3$SSVN2%N%;i3ZbF0H#E9UUX8|(16aog+=BYpR1>O{hRSP4qH5i0{2jFJaV%)X(0DY=O1aIeF8XvvOm zVj_ZB7`&!V(E{irtW~*>cA<~Hp)$Ja8z|)XIS#zkTK!m4dW=ldnKSto#ue5JmHKQ< zEEHfpx~E*NwJ^R?WezMmLYVWpSoAH%S*kp!hiJs8_?XqHOsze|!b{Z0I7`*9)V&xQ zMvTE&OO?r!cFfg04l%A$Wg=N&qlsGj55`ieoHpC&-xAmv_nvI$-@pbGaSS3EfsDMg z;R(`KC5EkB4NcMDg7!p1>tdV-h!|AS8mo^s7+A=nwV+kX+9zbG;?UBzsE}sHKwc`& zd3oKf?iPd$#-Rgv$;EQ58slssEZEA!sdaCb!1L`D)y)=pyTcZ;AqP*9%uB~bLN(Z7 zNWJ=ZDys!>Ov6Uk8}W?QX1yT@G6nMmFsoqz?`>)6jN@94AG@ zx(qVYuo|@1rRbC*q_L52rek{rYp@c=+#vjlXbQ|UP&u7K*r?DLyn09mk%+Qt2L~&k?PZ-W*T18Lxi;3Fmst$yy%W2*zZ^~t&l<2*KW75 zaTe_!Zl>b{ft0)v<}xw{ibxz{tiz27hHN|1OoMS1LL{Qu%@=ghxJGP)3rYQtGt;6w zv5pGpeyovH8zkK*Go9TH55givT(gHeYt-5IO%f4Wzv{g!c-jXb?`dmj8~U;6?e zt;^L}G|_jyi+@SdzAS0`VE;w;8g0z01y3_@RfX|LI69loHSXO~_cjBxL@PFUbf?wS zihYKnElA-PG)g@29j-B7Tsx(B;Es;(^9ZTx7t8u|KgEm@?^M}DQyDXtWz@b>aj(UE zUPQZQXm!i5|7@+7?RW(^+~+OB^-Pq;A@QVoPOY`A_L6qS(LF29`K`YPt@`*;=j-lS z)myVEat)7j_h1-@1r@fiTkWH*j8kWed_d;&;@F-1!7BaXHOS->++aBUL|5hE54RZm z1gwrK-Q_rRptw%Q4`SMrF%hgiG1f2EkA6@boxYrgq(lPtz_0nzHX7nOOGplMLDnKBA;T!GLuxtA8T!k#&F{)^wf%g3q%v`v6iaZCgG#hrd*;8azh3Gq?QCG zw4jmRx%C}dD1GX6^aJp=L?RZdjm?iHVE(i`tbVcKQ{h-+#OcG)lbVpF?G3!cE6=yA znt^lqtERCIS!uZGjLSCR9JnKy4&87s$MNqC@^^VCMBH#rGzIE)MzLRbQ#uCRbVY%a zE@Ozv^^irwxw9&B&USmG4WX+UZw~`cXNB+#*5ggmBSk_gq;innV#uzb18}@v4TaS? zDDF)N=f}-T8Xos0gvZ63LW};yT?rqe)3%cCx~VU5M?yH7&3G~--IR^q7UPHr==eko z9+iV`*BSRaRTyJf%+v_~vuMbB=@e7Quu|SNMfMY=MW1C8J|NOLoSwlneJE|O;dEb0 zW22$=N4b6Qjl297$7 zHP{%!yZvNn_LJj9ehwk1UNPmdAjHuq=TD$Kj{MB>ClHR#0U0UuE+ZVR(CBS}&gG`7BYEe+vLwc13(f{9*JnJP5fBpg8;9{bO~#gYFn;0Yx;N~>*p(@a zTdN$mJWs>9EA>c)+g2HbL|zw=-aO};%cf4jT9QsPZ~`P{<9ySHHLJOP#O*2%*aBkg z;#@zy9H#PlEBP4JRY}e!?1=Zi>2%l{V}FOo`nY-W``|#Lt=UO>CD(}-+e%!e>g8c^ zoTPM5-Hdo_vwX-+k@iOYPGzE>((x`lpk_R^A%Gx2hr zsz?gb#iGf^P#@uvsybpXSL3sTdArVj*ps;3Oh>0HL3%a8{cO>Mp-CH$ z%NY@M0#!C?Lu;pU-I*%O?Nn9{zINV@DBf%nZbO9oIn7oA&wB}hr+$YG1zx;?@QQn4 z;lE~^$Tt$I9F88s-Ya7B`{g49Bd(fw(#=`KLu&!LccEdyHYhT+0}l#jMM6$Q>n_$NOs8i8_`g{pJ%*U2jGHMm$4QdY1{>CMmfI|pzBOLkr4ZN zV{JhJ7N;n>91q6YLfqLI;|XgavF0FpzL{11rtrASrCUDKAl=@}Qh2j&;$DHu_Z#Ij zQLxtB9|b3>dIFCcytYwya{I;lK@y4OgUqnaXumiPG_+s*iLuTJ)zBRq_P0h1#&;Y9 zj^+*e+KTiUe6K;^)y7$l1$>_&MbF(W;!L)}*#aeuB?`(5&8lvgt(+bYXwDvbClB5+*HLwrla zx@F07d31<)h&M@e1S$2)?o@8RW5|(Zm}oG!i1VX91`aV4JAF0(_EmgrUOK4YMctj-*!=?T6Qh0gt4v(i;F3bC;%0)d~u)^VSX({?-fLSI} z2>%_Js>hpIrT-uk9;+R;UA~!z69-eiKurZ-iEDg+l`s47pXfu{_i`^`uSoYTSc9iy z(4P9ayyk{#zTkEgAUwwQ+^4&M!wCKK z)=k-4>}`y4dCJ7>dCZA@PO4ly|5E;)#v3C=_nP0EYKV0t+RCYQIu zr|dhZi*oar?^G`Pk4C2O!Tj|4ykRwuyH4c}e)A-{U&PGx`gFq2HY-fWi*`v{4Nfnk zT_)G*gcq_{Rr(%V-=W7!AO9Emc=}$~{3b$fe_k0v_s3;E@!m?^^9g#I?w}tQpyXTXeviv!yH!k9_ZsSs zk7;nzgMiM5=gR-o{a&h^)_H6`mZ9$Ug#6U|S9O=ico(K3IabvD9ph;g&rj$gcwv*i zCsKEKLN0Atu%oBvKYWue?4j=Pn5G(U(GZz%q047F_yQQud56TDm+D|K@1^qaqJS}% zW6wbkcEtS@E}VrNoDTp`chWe9knO-30dUYq#+@wA8^;p7u2AQD9}68&A$2SvGwj3L z4EcC7N3RNa?X8{{C>_jYYy=*kR?UpZJjoaHqE1#?nQ`6E^|I5;LTYc5lZN-ZRD1iR z;e8=oHt;>aT3dV~+DOXaO^SFv!0*V+7__$BXe%DEMexpbvN-#~nWf0%44iz|%6Y6R zWgldz^6AqwI`dJs{jZRV$|>8*4BPfPL!JXqhWS+u&Y9FY)xgmy5oM%o1CMTEG}{dC zkrWT=AsE}w^w}xA%j3tDpDTpL0sPsB6GlCH{ldP1qjdJq&xHPpKzOIhp#_f{`iEF~ z-W*FG#5$94@>oOqgTQ%wjxa9irQQO^tLqB9(vo^%eaZC=ua$hU#$>$R$CozTMyxFv zhllYt6+8M$T-Zyi5aDyV5=RZCe(ERN`GsgF*^T(9)u+gzog>wLMDx2Go}i0|TNq0? z@x@?n2kr{e%k(+2ztZv86}Vj<)%Nr=rKvYoA{nBs3(0=AQHD zUdsF_;qO5U46SXmEKk;H+I*z;Z>#uYijuwoL!T^suY`DM+7SGe;!j{o+8SyTwS=c{ zw-X=yAPxW0Oi6yp&j~9&6C`9Btz=267JXkP%R(IK^TSKl<9BD&=Uka!8cySSu9% zwdj|UihxPg@&NNfTCMK_L%&Lrsztx0G%>B#mB5IP>gCOcVID}sNFNJPEwVcFFBcqA z|KEig<>ya{)Wuybjfpw<%6ydbC}E~lIoKLY zpo8%x{>JzMA)qeqZ%>4AFNWz)vQ9%ure>T-+ZWWv(rXAzS_MYUrwch;>fvjCd^;9b z)w(E*j&5d-Mh~GnqL}M|0HSzxd>KOmT literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/bzip2/win64/crctable.obj b/3rdParty/JCL/source/windows/obj/bzip2/win64/crctable.obj new file mode 100644 index 0000000000000000000000000000000000000000..47d213992c7ae6547c6cc51ca1e07d776dae59b1 GIT binary patch literal 31876 zcmb_l34GH<_Mh~i&^y+{uziXtkmc%djB zEQ-5=3ZjTCqJS%|qAsGWBI_z%xS}h{a;%D?_Wylz{PIg_DTIGN>yqD_H*em&dGqG@ z&F?$@C2_3!$wbGFYZ+_D#9xL#6ez2$56DM06+bqs2la2eWR~F%%&42y->pd1S1^`h zVC=?mf)ay&Ca~n341Z~DsbZpk;~2YN@+k5I=6prU^C;TjG2k<*C-E=IOG`@|Znoqa zy*7`{nlq+vU0u+hQ68Mp_pHdsVk-1B;dR)|c4MK%-8T)ov19np5X+d68B(ZN)0ip# zK>d_!%F6kFHC1(?vcQyi!AgJCyqYOhGp?C3V?nSwlPK9)Q_4bRwWTx40~ttQW7rib zFaq1lk|C(7-k|+k7%U4_)l|)_O&jbQlIEzc4ORpf1S@BynW`$PgXMt`TNE=cg_X_o zpIiB?tei49Lshdvr4?zp5LJ^lc>d_@AydLd76ohSO3TySwRQerRociA86&0?nWp3f zE2orJ_^A%%8G-o$R#xF>=|(HW70b$MA~Nh2&y-x05SUjLnu9F$Ss5cTMvWLX^76Fw zvb6Nds`9E?RcYyFUxCGCx7bEy`qI+#-05lQlP^n4pXbjSkv$rzIg@>MhtKUXTOH!b zGRf(1dB9q8IsZ#b&#j8y{%PrjkY()~r9rHAlg(?k^leUr&YEs>L5*gi`pYs#PC4I< zQ)ZQ;P>(4seG;n)m9dPBDNX)YJ3AQiSC@ur8>I7b7fc_CM#v7kpovxcXPle=OsOv$ zIbuWx<)c693%_<{tRG8Ac?dq7!g8#3v)g0zc-_7nOPYE>pYcQ;RGvYp&H|F0>X} zJS9$xvB+q(8FOqFHdwM>q-Pf;*-;Oh&E_x}JywTZE4Hhi(`=E&4wQ1b=~Jod(1}XT zH`>iMi;Ja#?|$m-%<3->xM$bZB1}}WOJw%$`s^l$-D9!C``u25+e%6pJszVepAC}S zJtMenFpkM+x02p=kJae0umO^>m!8q;wHMeO#rCifdP}z6dN#AwWiffEJy{=_-bbJA zG8QXyvc8fbP0xUKn^a=9cp!xuCQb5OtmiSBOctldWwhs6+*&bx^&BRLqrhtMxnT%4 zOp53i$x!Gtnmj(I!)7&=_@K1KT4XV6b?+a^ETnmzPM5{)2Ai_wz~y|C_Sswn`5)O^DVBhFR2cd zrRO6Twi!#P%rIwvS@@-TPPg0Uo#caW=Ah#hpnX)&$d2H$xX`72%KySL758Nk+;(ej zuEp$=0VK@b0~)O1ozd&EO?KEVE=!(IP99iSnP_0T#QXwVA){dF7x5eajSv@5_h}RP1WTMOA@R%JYZy~w85*aTO zwFHW&q)38H;6c#hv$}m=yTxrXIxW0U5lf=VO96|sNCt|g#L!kUIE|isUoIS!>!niL z$yDen5{ZpnAoI4Dsni}k!jZrZlIZ4brIC{q8E#u>)I@YtWGliJ1xXUoNfOPDLb#%4 zhh$0CLNmoL;!jaRlxbx~C9ktgmsP(I*;XMN+R^RR+MRmYCQ#e4tGpIh30aeeRGZCW zMr*iAxJ_>X2V=PwjC3xG&yhntAC6$kr%*@nk{Apc138z^VzU&9v4j*Rh8T^3Oy}c+ z1PM^-v61O+a%4)Uu0#3bwDe-cX-6@lpWEZIBH%jgZr){yD?ZF+$#IwvDV<(tq0w&4 zvvB|FE~T~6_;N5_6(|k_MOo|;Yvrig_4~Qf*SoM9Vo09FjaDAjVaIKp|0tJZ~KUkcUbgyngAhQlKYa>3$zR# zV@?jDUyjRB>?Y^wA~`P9IC#)yLnS>`qpPMyIJV|-&-J+-UQF=#NKB=4IgQt5$unXY zHerOL5te37G;|R2MH+Li!)3z2YBsxkXm`x;X~M`OF7b8M_$C$F$k3W&bkkClY95OX zYmKlcs>*fOICCu)D6D!+4~@_$^0q}&P(49sNmnJ~Gt@mNHp7$OzA zO=xO(HtQ@oIa$&u%n)lVXEiETijqW*BQh2<$Zq3}K*V?=<~nnYZV#s`<~E$Ugvzop z3RJ|Lzy&*tBQ;BuRH+5^v3tRcl_}y$o}~ajN2V^c6y{(8O8!B~sA4$TjL_skFyI^% z^N9mh3v;+F9=-%&u_D2PsS+Q*i54elCR*@d&dLKZuP-IW%K|Vt z$FT3R@=J9yp^El-A!u@~*wb2XG^iPy!I|{k})DwugtstxR z(Nt|0N%zsZh#QMCwQrJ`>oVqXspMTRfgzTmZ<47f8)A{1s`OwsF)bj+AaV@P!pT-=Q5FWkgp{W^y~yLUX2KoCb0WiY4(1iy z|A?b4QP6%EdayDemsrp9nH=H9DKt)`r%c{mC{usRgtZKYNv;AfY7tw+seF=X=GNHA zMR`ixP74AqjL036X5*9+%VdhShN0?EN}Ni85%RE2Kp}|e@fscW!<2_wpDXnk5+^XX z(N`F#on7VU<{}zP1kG7WyH~Z?Xd4ANcYqwjsK!{ukmp$QdzS}QAPkEcyW7LMp~W^pJ8k7gErUGt(vuUZ&)((`h|xl1r7Lw^)QqFU~%D9`uEpm-!#HE#gUH3JrW<5&MSJjkvBi zf@*V`c$pW0i$a_a(ZFo;St*!}7%^fbXQVoYYJv*_5J#G9B1XvLYd43J@7$3s>cHo< zR@RQ9xR%HR1Gq#i;esv(!@RQDr6CCF365tV$f=LKVqXp2mMTW>h5T}70Np*2hd@`L zy1cY3P-ChJ<@-bSx{5$3SY{5)3|0neFab$Sxws9a@>-E)DFnhc7Q45QTmK0mH5cmu z&0Y_a9wuRZYPB_Zruo0zuHf4Ah3-&Qj*GmYSSqNpGx}sT$Z*4uTcQ7Ouc9hYVP;zFU_PJ72a+ZYlgZnaA}Qjiv9>nkDGkjE)N(~0 z1r>J7vpI5%HZ+gVk}o{ijVXt8(GtwD$TMhZPECo$Ij#P%kRUH#2`aUV6P~Pj0M{ow zi`RTE^ee_}(Z$)xKfHSN)5tJ6R0b8;8OhXVc$1SEe9hW{Jczo1>;?3wdK*fmM`~D` zXjyusVx?F1#v|E3Lb9#_1|prtmsUm>UK?@-bPM4PWFrbvFj08d9ivzxpZ0-@6{5Y$ zAK<}*`UdSggRC~4wV<*bbTX;iTIj^WUd=UlBhWk@dBPKM#QwyTWip3}f{EAZ%X2yK z{}>QW7F#$!xz=5ZQ%zuG%`wy`rrfC#^-i8C~@gkJdbKV(Xad+Oe_U_CBr|y37MGIrEaQd@resw*4#nKPgth+n8KYJ5$ ze&_VkZ3hc(J!l-YaowRt^J|~4V{9A>PBzT{-}o-OI|y+ z>6zsIXY0fZPcBXLEdA#P zbvF+@k@GS1=k!yh3!V?n-&2;dd*LtRM&5cQ^yl;m{Wpyt@~_8seOCPQoYI(YhcLF2 z)6Eo_SnJM6Ys5O>^e^G^vSKkM=HL#gKcU5&7rwPGZ@>(>5jQm79V}Z)nnA|yzTy9 zlP+iMB&Vm(+W5)N_HU$IpFFYg%Ji`fjE%xe+hjwxjW^u#@?TAbh2}}$`R{z81fvG0 z=ccTQ?=bN7!$ZbDUVZPEUti4FCQe`e{hQ|MzgLdFXHf5qh7G$;GIpHPvmRZ!H?gnl z+vhC)3)_|tg?%#PNq+x^zZ@Ih=hfVsRl!ho6i@WJxyM zko4df>$>|MD)};L#cL^V!AYt(ebeKqe>-OBwCINgCo?;rcmw|M45vT&Vacthvujdp`c7(SI1W`fccQNdn2Ay|w$lJb&spVM|}9%XavY zQpUD~WnZ$GsE{@=Sh-uS9^{71Jk_ARIX_lHg; zUtBZ6`iEW{%1zU6=)%}g^o?Z0oTt|;cyaM%E4qFD&W>a6zxym>vpM~auCw+&;Of&g zyL0@?tERt!c3I2mF`brul=N=@37-tVtl#+E?nf9q#OZIxO!~cdY{*mfxuJ304YhAE zmeH2vPrjtjvvI#9HrDy({v)Qb=RX*$;X>1H1SyQQ`#`R?GM&GqAbyZdBzo176`w3M+)oSwa8@AGvl zm#udH*5$)JpM5X@@;NkPZOv*|f7#sqjD61Ob7to|nJ0eT9ivizdj9#7 zKQT7A1Ihnr$i%7rR_wm;o*M_<^Ufh7f=P(ezgT$l+ZVPi`r$u2I;E_;+jSdb8##UR z);5oPeQA8pi;o;<%YJ$DYQ}!%^oKgf?q6}|t_{C_S8llT{?Bm&;<6-?-(Vg5@SUqi zUc0>Dy6VB(p2T!(9;c5wP&s(r_T9H$GqF5wRZPlG#$Mv|UDv+1=-qZ7uD#`n_bwYV z`e(Gep(Dxp$I~;C$MgPGPjng-6OZjx)(Vw4Kde^ZL<9DwF|4p2J z`H9yL{rSy)W9zoJAMyRz>o+m>DyR34|KhVj7i9K((UbIPzml==o!>b9X*MWww=?TowR(_m%lIg)%?tT|0((Qu3?P*!s$nP#gFW{m~HyziR`77ztwI;d_dbH zK9A~?cGJo0W{!RTWZe&YuESxNYEHlMj%kk>r!75|QWIBr$*Q`S8KXIKvSD5EjEkQf ze|<;$o$n^Z{qu+KU?12z*>LsUADYtlW&Zy8fm^;?m;EWq%;oeSy6juE{NRL`&))5x zRrc(MM;W_?(_ehK@#fz1ZvOeciWLv`T(|Ej#=hco&lk4-gT`&$_w%I}ZmOKR82*-u z@iN&^Vp`<7{Jt68Z~dkHJ@;=~f;jKx^e)|QdMt2T+x5$WuIH=?9WP;Q8K>K3UcdaI z>t9QGX#0+@SKfPQB4h7x`ge17PMcCXV8erbFX~-!>gji}rGyz%vSC}l;-QXDtbo(!7Ij~oeREsAMMNOM{AC~ zw6prh-(Okz-yi$*8iM$F9j7;RtG?=)i>5u*Y59`*kNk6x8{-S7PaF1C;yZ_S|8?)Q zr{2Hf$H&S4IeqcIH|Kn^wo7N%`~kl#N&k0u#zv=7x!?Wc;DXXw?HebJ`R_~HX3Rf; zsRpOVZ+zZ)uW96w6>DDGTRCIU1jhct>DPZS^vN4P*-)H%n4KCB+=y}HH%_1V3rjdT z{{6;Jzxiz4@?pO|oH@^W<%BtXO}zU3to>=MG$qc)pm^53hdamz_^lR}?VvIE)jg^g=QZ3I5&7|`}Q!2E>Nj3gCHQG@p zezql8Syo=>4@@av5SU+GTItW29bJB$mMRN1RM$qE9~xH&{pHbSKfl7uswyh{<+GwK zyk>Twyu7qJ*i3$TRx8{B_2R5njqa>gec2S%3N^KUti76%b5?CgXV?NWqs?7cIj3@7 zWwg0bc1>AnC~E(yu9;n3S~e#$>hf!`|Xm^f1zKr}f zS{-WZtLmE5;cTNtC=hk52?a`Ps?IA~RF%z%w%#?hq0;i;tf-4e+t-vv?RgaHD$1e{ zb;v)<-`rqvR?Q{@WmeR-3xw)1*w#mzf5v$Y^JKgFsQcWU+KQIK{5f{J`cjOPQ4beX zi|VSXs6D8nqNbsyHc%058&rpCW=GxcE6V0aTkb5J&DUla>Ja_eon0=AZdzGYdLENP zG!q7hs;GyEn(9CqLJhiW)SiMcENVBz_Y~*R zw0b@2&S%yetSt3MKl78pcyzSp^oN4=fe^1uv?6N!^}hcHG1XPoH2;oPi#dT%WuW}L zDl((ACQw@w^#TH8dbG+1D+0c<3cRC;x|?Gzd>+n>I7O9@R(;eQ>j#nhtb+241^B+o zR}J4Qtv#PoD{GpY#hi0I@VA%L%0jg*4C&`6==^4e)qzlREAVsFp$yJgT3K4& zP!p_~BEC>7t*or7<%bKTm!5r7H)Gs$nQD%VHh-`p>KP8YL|OF9i!z$1M5{H5t_;-9 zi#im}tBih8Svh0Wh-me$3zb(yZ!**xBT=+vV^&xZ^=ugBhVWTjv}IF!l}8=9k(<8z zjJ9y>8b+NLo3VcXoaU{5j`5-#pPSZ3tq5$;{9@=FwFt~Fi+%&RqGo>dE`%D?)kN>U z7``*3^#IIc<=~C2_aS&!gV(A!s*)~$wZju*FZ9|OS2=cZ+kXu-B^{`byI{_o*Du;s zxTJf$Gq3m7?-K`hI{H@M{ri^=FWp@*%)he3rSC7GFRRGhH>mo=-rtKheqt?{`!8FM z>^Dxe`RQ+c(>A|z|G2up4_-9p_@k>%{g}IL>#1XF8yf%jyo0$0bJ#TeLSpUHMja!PY3oc8Y`{|wg>OTHt`JD1sTvdNLlrkgc z)ZUqY&3$xQ;?>h8|6^gV;+fMAxXVVYEZmnq*_zb8oB5?KA5M5+*P5r(KK4KP^KXOJ z*grq?Si#1}{`%{N>Dva}-fzpjD-LcNK5WC%2eZrXGA0kd>Bpoax1N~#)I;V8vsbN} zIc(X`Yrnnk>t35bce1*F-!?G&KUa?Z>HD#BHlDbne(q0RXXY;l3s3y+JGy<>H{UOO zb>!|V-(9l5araG2wtkScvf&@!?-+An^6FC`9{IdOu;jNr6^lN;Yx-ro9RAD|i3@JI z{jKY#Y*<=zcw@o5qNF&-7s;;|jLu$?d-t%soTb;YDdT4Dob>Mri@oltrmG$q+iSp( zfd?)=${xKWuh+D}IfdP_e{g=7c}e}s@hj&{9y@SEo*!+dCT_APpn_K z@lU75Jd=9p)VjA{+4{t_pEUe=*Yxa_a~J;f=#y7(zPC?q-HPsAGXJol{fRqj(>LDu zw-Ix1d1%?vsTp?`l>D?l(KBJoTTaWNyX?nLIVKMKq(j~xU)f{2c;Vt}S4=nE;K*g6 zlUMJo|E>L!*%Q0ul`kI=SK2@Q^}v4$R;ElVnw)xTb+@h~Dn9Ia>9|K@7N<>Xb9I|u z?Z4}Bpwm@rmtS^hn`_kgRVi2gVbR_(ckX?l|Cl{RXqw7}t z|5vkQ(9f@}JoH=J-?rZN^5+eA&e}C*(cX_w-TcAr+aI2>V&Nm(HeR{B!-mEOo=e{N zY@4LH>pvToxpsE;i9c1$+`RpxYwNbgPR;(y<_SMNhhr%CK+2Ge<1RRJbo^L57L$xK zQ#ku(;Pk#4-H?n|v69D-T&w$Cr~MXr+bt3@t9A4QDYGLpbjE8)mWbzm_!kEklj&bN zx7-#qD!-lNCB5b%Md{U{iHxLXWOS4=I_YGP-Z8RnDLOh{{c7|Jbo6Q+Jyp^tvUt2v zT|}zu{#rVP=WQWj!UT3g*!UtTcW8@p`H@5}h<+g_Z<}s1-<2)qi#SEcgeLkEabX>L zNLi{)=#(e@M{Pp>K-TF69%_@`k~gRMa`^{!;!6dbhT|Wxc*R$C5yWuWX;NNp^YZlP zCbgrokycgYu*|+q>eCO;P3zMiG^)=4$=i;_ckYXt3Llfd4b(>Bckh_v$8uS0=cLqF zHVAoeVzR1oR&HHo8J(nN$A~_d)1BBV31Z*0vXH6}mdHIae&-|^(@nggj)4U9uqnPn@d|}bt_a^fDEOzWlmXL}V6hrYO z1NujF9PQ+AaaOZ*nCD1@ZHlN3&@96K-60QODq|~Lv{O$!Co>b?3|7`v=Y^{3ss+6d z=v^b|rqar?K)DGgLT6yxNwp{WQW|sNNVd7WT$XV$@(yN3cmuX8P_(HE@BQZ2^7a{s zv=J;9n|S5H1tL{R=?x%%-Ui` zfM5OPM_NsH8aT4YgcD#m8HdP5BG$(wlYP{0vWfal^;W;BzUnvCPyHtS>3822`m-g6 zLXjm0CG$9Tx#Vwy@qp^VV-Cupzp+T8K6-^F-_Y3rdRIJ$W0QehDfz}rJ{8A^kLnfX zjbTQ~nuDzKF5ZE9t6UMR=zF zNCx#qiv7iSCK;0?uNsfzr4ExddQ7tVt>jHX8vUo2Hx}*)IG9X1Dh`SN;STi zWTmgN*VRZ1%Qi5-%oC7#lpZukpg9Eb3fso8S(10QL(#vJ@6+muTg z6;g)cr81~YeR)-qm(J+veTif#8!5RV$y+0Nm7kK_ekfVV7Ht&E>Lh=?zUw5Psu#&qGL?T^FL`f}yktk!PWugFjA<6t0fTC2Wr27Q}Z}P!>{;){rbn-svb7 zLdVuIECgRu1PhXRX7mb?ucwA^!O?2)`MMVvLdTEgAP)4Bao}bd2b%lrNyLL@QYbEH z>kvY%P?!~>TpeZx_cxA=5eCc%()u#zk2Iq-@$&mJLijqNjBM>qqUnD?=(5neN z1}~#6hs-ceqB%9b^`%cRczj#}yXZd=E6&nAq5k@L#~3+Y0%rqX?uXF~NVn#Y42XUP z6a%i;86XUlZ3rbG0>6Odo&$CPmvdIY1!0>ugIl24wh3y1pu@hAbf4Gi!tM zvxmkVAA}HlnT3@4`qj8kCJlJ2Q}t;As}dMz&2$C^n>X%Lq0?F5*>KuR;-zfC`w3 z&y~2{?~(CHV}g|_B5BXkrfP32L$j6DuS1uVHp;C6GOb^I{!6|^bHf-})_tNZmCU~m z=B4Q=C@&oMB4Bo88JwmdbU5ua{2a}vIWOONBwIBLouk=U$Zd+8BW$coll?S7z}KJy z6P64>1vrG8%PT%37q)K#m&0{!ij_n1o5jhIdbJ3XBhxzwJ?stuT+s*YWN&=_#@lv< zu($prZEkKI0oFc#taGATmxaIb2JlxTl!z>^B_t85M~f&TGH)v&BHTXldW;JN9|H4o zm=P)Gj3^_L=d3_RByZ~&BceUe0%3&L;f(MivdlA~i;yi9mK4YEI1N@(=+g?s2-oFo z@I|P+*04p0=ghbwLZ>t0^UAt+*0-_1=2b1sbv^@pFHb)scCRd>dFWoD<5>dt^0Hb- z?G-Yc$Ltkpts(Z3ZO;ytSIFz3w;$kQfC=QX5Nx%AnUOK7Rq$SEt5&dkxgA;p?j_w@ z1nrgb&xF}a`CG>874>ZqtyjuFE3jV4+X_}Muj>H4eHA(|2kMo$#?rp60{Y4_TgCI0 ze67OyO1>d2>W6oFZtH0LcfMUdAkmDa~kit^uvqc~#e;D4fT(=L{8kl{Wm3}QF6${@vTbyDl_bf1qxqq|< zP)xE~2PYQ#of(=~@SGhmvEV&BSYp9DT5sp|E$0yrig`qMav6~4*+AJ;wpSr4ms+u1IL)kR&&NbqHMl;hv*iFUk1)Rpzz@?{fTGL(iZyf7bRe}lJdz9B4S-`mJ6`VpnDd`ep3z>y zXir4F%X~!Gu{mfWJ}+w~fzQu!q8||h2QlNFM?FEed$o59Kz_6UcDF?7g=ahAfhrr|88DQho#=O#Y#;n~ ziQn-YQ*tz?x1ryr68<}Zese5YAu9}FDV`$%ECsC{<-uG{y>Dty&xDsJ_31#*Kx?z& zas}nnNkmhgC)>0m(EuH6C3sFrOD39iB-bs4=fQ(a>nxr#)$;}7IZHiX$n%Oiri!%D zDy<7o3+r={Nay>#WVf#L%u(P(9lO!9!o-s0cPAP_2Fm9i^h_Y7MwiPd+omVcOoBji zd(ktYUjr;35SZF{-<#+*Cm{uLU+W{DIp7`T(_?_r^8iZ6c9XvRfn2sC3cV)~ji46^ zR8_Wzk!S#M&XLbK^o)`%#zJmqlX!Ljxz?iUW)AZJXjS5H%X(WBe>jELA(!Y>P80q- zqMLGgS^4}oUBDsgZKY=k#|LpzD^ZumP9zT`p*$~xC3Ak02hK-!VQF~Q*`H0IJS8;q zIR0)8YS><0|=)GQfWo<#pu zpoGO)@)!DTjO@33oQ8AfS$u?140L?pv|(OAdh;|iB6^$N zgcoq2fTXwNc*WL*(!Ck@T48VGZ;~e3DUxmlD6durm)wXni~V}sxRHk|6NK(mN5}&* zJ2jTv(U%;g3!tb)WjMMrHU@pB9Oc7}Jg?OTVBCBMe2Xp~z#Sbn8$j(RQP49I=BKE; zfeAxXX@%B&pUC4XGD;i^g_^;k3@&XE#4oCOk0tlbc>BR0BT?HZgEct*|76JSD3OUL#@OY_Pa6Qv> z^}uxv6Mde1L~MW^!boIm7RT*NmkaThQnCddSIZD+ut+&(M?dK*`^h@=lQZId7H6F) zna>g0sP`9(8s+$nXvkj!3*DKzdj!bNxP5}hS~R3q|8P3LZvh@a7f^_LX>*G(`mOY3 zRTRg%*7_6XLSmjm{B$dq>OUGC?-24O;o6^70(rKXJTJ!Rg2dR95 zjvRb$quvKSE#?oBNi1gM1GgEiU(~tLwc0#KqC%U(F&Jkd1%@<@8-&p=eFoINQRtYE0XERiGj7+1U(C5hY!ErGT@izjzU1DWAKh=w&Rl6BW>KE4}ox^L(w0N0@ zfd*rX*sExx(GWwis#N1|f|6sjqj!h{3(CfcG7T+^PG#``F1A3WwUueOS4H4D%UIO% zeJi3J+BeMy;B7cOUYH4g?4U1`OBQ`7DV&clW|jUOb#%;jxa~UWW#j_{)Zr@0<%sf( zzbgUU8gIkr(1x_`)uRlHm9LJ1_IxHry}P3I2wq1BbarEo+hN010+_U0dATeSy&WSS zy|ciz7(j@pHb-BM$nQnyClq*PQ?a(u86_U+hAI>(WhWj9He?MFRR_+Y2V{A4Eqk}dN$ zN#}6JviU{KjLc8F$=qfsk#tcnX{+XL1faS$p^LJ(s&w8xAr+8s+{d3MACFw?jy!#> zJCeub&eG2n+&y<+u@~u9HdODXc$&CV4bpL~rqoxxpW^B8LYEQkC)cd%-4su=;Z_qb zP3ndJs&`U6jarU3j7U@OqIjC-g(6M8gA)0$jbWW+vB|vx_0CD9;r2ny>_k5Go{6V9 z+`JvsJ0-zS!yWX)1eENp-X-xgS#K4SRo&J5B+jG1n?(ADdY2SVr+FSXA1_0_M-t`3 zYMNh(Z9q=9VknYy^{$B1o4aX5@~QVlqFh?C;JqVVox$JQ3VW#cMVx06ZuCK9!o`n# zPX`CZxi9@ijCo;Y#IPQIh8MZCu^ej-IxM0-7m;?4xa&pg7sKy=fj%ogP3P>n!MUX`h%bqI?P^da7(=fjnA%gaZ8BQ3-e2!U-Mci7jsNb zH#ztVW?o0kEjbN0B^g!hNRTwIolY1CpG%Z9swlNnTiFl)D(b0S`5Co&BSEA8Dv;|-B%qL&>%HU@T7Ym}X^ zV%?rINiI|H)?XM{>a4f+K50hJje+wO0o?Q|UBBRWlp zDDn8Q2|yvO&ItOe>esQxM!Gpie|0x~ofB&S%x;rE{k7dF89a1xH~k9#>96d@`WZZE lME+OT_i7;Dsy|6Y$s|F4fj6bZ8t4k|$UpkNv&p4V{|Dn{`ThU^ literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/bzip2/win64/decompress.obj b/3rdParty/JCL/source/windows/obj/bzip2/win64/decompress.obj new file mode 100644 index 0000000000000000000000000000000000000000..f5fbf9c279bbfe0a7e62adc52d1738aeac55fd37 GIT binary patch literal 71540 zcmeFa34D~*^*4Se3xpw%1VI52BLqYROhUk*sF}=6G6R#D=`10k=n#?t0@+9=2oy00 zDlu3$R9uVwskOMHMQzbSi-KG0R<+gzZL3hI6|JpX&HFufd!9)G3FG^|pZ}k}`H0{9 zoO|wi&OP_s<$0#&@_wxO-Zb9>Sr+DG;%{*4 z!|`v}ON>pzKl^-B{n$9BpZtj3{6f>`#1z-igOrdVx#?aJDQh1qtbudRzVvvo=5X0hsv zYL2c3th$a8_?sISHdobWmmsT_>8%blD%x7ucB~n;Y59md({!O!hiMb4yS{^rFV*B}lTYU~=x{DY;Yf zre{y8&YslJSl76)F?*6DGRqn8Iz3bJBiWNmgOjo+%{eQ3(nU1|xzh>}TRbP?^+kdq zhubHfoE3gwAOzNy>HIHyQc2_YkwEsOGUVnSlVF#)y>?I7;T+Rb7N-6TI%c)#K3aCx zstDhsfAs0p4u(vf^In%bjukX65p;Vd0pF%vEGFzfBMv}l)`R2-Rhh_ zwQJ7#1zp>fpVzfl^SkwPUSZeL^UmriG zux;1m7#j+q3q zoVMAZ`J>JCXk}K`Z94VJ7_amuP4IGtjrw_I1It2+YcydYD#A(YL0Tso9z(v=h&F?( zthS*p+Q2hg1!^|_`7Eu~?0B#(*KAdFO^d36wJW1MIdz-px(2v7!4;yiO_~~Qff2~c zT0{iVN)P7b7_Uu@=BjROZsz6A)1;M)q4rr>b2Y)~E9O~MXi9z6au4cD5)El$Ew8R$ zKR3*;Yph;UW~<NGHI+Cy>x;l6u`cYdSzkT^D`pJ#ZJK6%{Rpg7*MAPw ztZ((gx@nMReWw@JNg0}TZ!fIBfga+Ir1zIzSZ5E>towRlJ$RgEJ=hEDuZL;YPkUjl zK0&kovlrI>BQ)!my|CUlQnP-01lEO!^NrH1%yMLPdH*EMN=ud_Y1YLjYu2=0SWi4f zv!)+`bso4*8LL?{dtq%Jr&)&{ftB=i-l>{(_z_qafU9$YW*v0|)_LH1<#f%OeFWAF z#I2dgS;;6(z~eTkug}tisevftK*>hD&l0O|;yRt9Dcub~6*%`#;@R=(2&{(_(>!q9 zf2L+F=!LZ)PqP*tfpt5$TvItK%`FbF3M0OFF*n0SnowKI2{SZd$&zmNY&9|}J4+Yr zIzqt_aKR0tKWe$>2&|OrKW1oF{}EUz*VoU}tf3>Y{t+g+)5ck;%48l0LVgY8I%Cq(9E}SWaFz;9X=;j_3;H7>TCA%c(|jv=H+P*n zs8e2bY4+t{Kb+=Jr#wDWv#vSAO{D8Ak_1knMNSV71fC4+0Fqg_3TOxZ z7#Id#4Wzl{8sG}xwLtK)>wvcduLnK^+z8wWyaD(c@J8TYfj0sF4cr7Afbwq!o(Q}J zI0<+w@OFV1_y}+da4T>-@KNCJfR6$90)GMg z0=NxGdsdGFM**Jz<^i7s+JV0WhJn8VE(XG=wp{{z3V1#6Y2X&%uYo&(JAuyue+wLz z!q_vw>r)wf7Ptkt2RH$~-gCh7fiD1`N@MIr;OoHO0V}Mu?Zw*G0AB�)$N39t6G) z{0#UeaOyzD-U2QF{t>tc_%`qX;Gcjm0^bA9glo4KSPA?9*aZ9#_zCtV{tQgbVC*lz zwV3Vx3cLmQ5pXy>vX6mh0`~zQI1WYuxC{6?`1@z;A%}p2XOHfR6*e z15SnFcLKveW`W*j1Aw0clYmRdFqRCw7MKeB39ujVejrS8+e^SS;M>4~z^{Ptd)iuZ z7#jq<7&sWX5eVm??dL!^J8cgFhXDT!912VthYeid$-v`*Gl3@nca6u`1%3h?0sI^| z5}0}_V;DniV}YZ9g}{@6+a@rU4SW-L3UK!6jEw;{0LKEa2j&3p0Kyk(`#Eqta4ejb zQ-PC#6M*LdPXqoCcsg(%@C@K8;6xxfIeEZmfm477fCa$*lNg%{91WZXoCiD$*a$2H zb^xaXuK}J5+zC7nIO9ylU<2AN1Qr2nfi~beAhxR7zRSg4FfcujF$eJSe8!x>yMZOZ zEx=OX8$cKEPe3uA9x(F21rg*EiedN3|tLd0=yeo2Yd-w4}2Hc0DK?V z2K#B|zr z2e2LZAn;1y)*{9>0QUfY415)MH89l%I}bbqcpdN@;Pt>_AZEq3O5hE^WxyMOZNQs= zR{}8=wrv334E!ijG5@vg0p1RL6?g~m9pF!Z?*Z=w{u%f`z!(IbN0v`gN349nh8~6y2T%)bP)xbxAj{qM7?g#z?IK~b;4g4YSabO+r3E)!T zlfWMVe+hgI_$%NafZKtGfKLJc1^hK|kb|)u!12JHz*)fG02cy(3%mlj3-~%d2Ve*iuTd;|Cz@J--bz;}V8N@34|6M^poe+b+QyaM|UHz*B%r zfMbDcfH}bHf#ZNb1C9qi13VS@a1izt7z@F^0#^V}2iAmfcn7Qn<^nr_dBFRC@LAfD z%3)`L6M+T5Jm56o1;Dd_jle?STHtixoxrn!C9@ej2WYKeYz8m`crNfUU@>qf&;>ky z4(uhc95@sB`VSeK1v~)s0BbLR{RFlFy}<7-g#82#i@<&Yub&6|3A`T|1U?N60cXr- zEDW3vEC=qbW^6XFUkzgwz;#jBS>P7n9N>h7u(Lof@B-ikzzcy3f%AaNfz`lv;6mW7 zz(v4^fwjPAfQx}|0+#>}0_%X5MX+9m)Sf#(97fIi?-U=^?#*aB<;UIvT- zZvnOf?*}de?gU;0d;_=~xDU7j_%(1PFryas8JGiH1uO(!4DfQx}^fbenn z`ZAYgWFe^kE=6bn{#}fJ_hf2vebtg^SyfX@q=ujI4A&8H0Zg2$&2;V`R6aw^EdGEm zbUV-;BA;PqCa2f#bGW^wY?6#U-W*%*47f|&PDh!$%o(cmJ8k7Qx5rlO zak2@L{RA_+D9MX%oW=@Aw7CT<%Gr}B8O-G%mRF}=`@Hhil@b}Mp zflJw4Qx^>`YK`HTyMaxV$w!)#+kM`U(~Gm)px+mCQzdMnkj?I5r%LWoaoiqsj@{;U zQ@y<*w=Lvk<0RurW=40|JIm{v?KL`Kv}7A?W^=d$PJ4*t2~`k1ezG|}V4JPF6FMOn zvds*TTScYA8A2{3m~6>&ikZh|w>$lzfX!R#4C-RWm^th|-z>K?5=2L^Gh`NH;~C2Q zHhU=I_j%m*$_Og$beB6Fy6rjf%p$k2-yd)WgJ4sAIld=0D6%sm>Zln{JuG9uITLNw zj1vyah@L6)huCDv3^)q}ZaemfKbO6Uy*d>)-+UK~d^H7ap? zoOC0DohECLZ|3JxbykG@9-G@+<_?zGLeM#-;8V=3{&2C!9dtPZhAycARbb{L753OF zsZ4`2M;1QS%oz-N!W9wdW-$idEXYTVjA?OP&H#pVMCqTAr{X>2`2nUFyV47jQ;=#WeDv2zD2lI zw|<(h81q%R+ZPDxlKSg7jAfcRBW1H9YG&3YrD-mbji-$FhciM$8MX7WlVnK)G@lv; z#h4%YWK0#d>S)y-7~v4CdWDpPE-<}2CmA;?j3!_1b5M?hG#{K1pEqJ^Jy zW*PN9Q}SeJ9#<&jkA$JyWYZ#kcqX%b0Y^l34xbPy(@dQpXe)6>Xf_S`gtl;}iFmR! zPuOdZ1Z|kSs10P+XE9as5Y1HT4AIbxK(`~r#|JFNJ2^nGm!!Uw>v1|k$W~ko>sK7` z%?^_C94|SBY7TC6+3Au#Ow*O9VUFFUTyrBqUlq zKRdo=X_6{yL1SzWa>i~N>`AF}7Icofy3AQt3`nc^}QZIpsX-EFvAc zLeILCU6LTf^$xg;!>AsKo+6S(L01O3sRugrV6q^$;D}2s(M%!60U0FV z7APZFaL>3qiz)${NV$-;hPPaTwL*yH$>dN(#DxN3D1}%miZvg%Vwkz%i^C7*#*>yH zR3dZ}Nt_k5GVzo^n5E>j2ZWIfVKVoHLww0d%ow*|4tx0=0CC!iaR-;1JBr2lrJBJ^ zA)8`2ete9bi5LsRBtsUU*k-5M7Bezwj@K6`!!V+j9RSx57H+O33y7ryV#(FuI`KBo zf#O`G?GAVZq!UC=;z>B!?JqCD+}A&AFQ=D>B5u0TD4x?8o{Qm9aMdG@0YriPFzaAZ zK-%yjPiOZT!YQ-Oq^Ep7QYcXlCBiZWGbFD9FRBe&QAFkbp@a9v$2_Z0Wzg@0twkqt zog_z`Vv?DR(aRTV4#lLX7<57@b_mG&5It4X(SPuENcy}|Zy~aX1#OYCXlzkq4eu_Z zu{6;9Rdnq-h8yBjkk4;HPGZzzEMQ1;+@%p%Wv|B#j}8sO&I0U-8!PpI$7YAxsyz&g zc?klqjdlXiT3;AbA2$iKVUlEKLhfF#VH$9J zdF!zI{FQo>VW61_`vRh4;j9NkYy>3s7t~HK+DJ0kUT}tVj}0;>S4w8A3CRnh_6;_( z@meUgGkDdSIK#}#J1$rWcMRiE%!X>Es|-Bf9z(_Bxkj+GtZz_qtZJdHsj05Ex++%N z*brLL6va?a%lZmYez&76=$8Ic1QTZ1iA7Rc)^Si>kB{ax4Ans(j0GWx z;}Mp{Mw^=(8Y6UtHZ6;0KqM6#h%~5p&7T0( zOW)u?q73uwED=oI)FvO|Z zq>9K+ZXm!kq;Yc@h&I(#RYzOwjm@qanjoXiwbhR3g4%{?3zyF+{g5kfGxa-}OZ1%6 z8!qFrc~9h8g5`ql&6lYjb|D**={tC)WrEz*;JH$dics3bQ(MupZNULRbbr}`~L{bs}I3~+YRuCTfK+0<3V zR0b6|1kp79jM5t$>$rYUpG3^Ps5^y}kw%mpQ1qyVF{(h1qy-+K2J}dEkP1E;k0hSB zoR27<@kl{aSuYb=*D*m|MXH4%D0GW@l*}VK)Y$6B{F%mmO;E8c^)}W-x!Iy|NSoat ztDSCb&YlCE1Q2wW`LUazyc{kvS{xva;r(OQNy~axrm&M43;QFb0U!R4so3uH80kq7 zpHZC3b&_2JCnGIumx?rJ!!?=QLVp0*u(X8j&Wr zFwNujIX+ftjYmyEO)$NeW8zQaYhltz?lfR(lDkOQNeyw+MO#^1V`+C$>MSV$*+OXw zQOZB@@8vX_>gc}7p0}Gm`Fz*M7rH(?v~}lAGtm?qr*Gf<ct<9P;cvSLeU;&DBpniL>V&oc_?=-v;iVaphZgZ@D@%hwVW=xI=^dtA6$2 ztSdgWO?i0BN1cvcd$;hr9iT7&=lRD!JNUk<``_b!)xDzZ8h%#+^y{v!-7%*0wEBm> z`tybhKHK(JepXKW^#!H%x8yGR%TKm;4+PwUw>Z}(o{`%a!E6(F*Y2Yu)*?RtIf4uYA_h)~#q$=rer{S!g^G~{F z-WJQ&K+&nQ3;TbXk^M8={o(Yib3X2@yWo~NvpO4h-o0+(xu}0KmAm%!6^{=bGU=|Hn432_kFaqd_L|BaJp~l+)F>*5jb(m3#Hp@z8y3j zcaS)J(!z(|-8pb~*6Pfeo##zDX9do3Qz-ut4_|WG)4#Ttl{qR7)?D>?B_=6OFUh() zHGTXu2TnWxuBPk${4u7Lt(<=S-}gA0o^L3;_SDgnS3L0SmpF6h^n#z<`f}Qsz~3Hm z)(jm`cRKnfKb7*&S@DZQXP*3;={Rd_?>x6rR2GzA?{c{BeB6B0J9VIsL!`-Tc54e|>cz^dt|~C)0At zpiO7Hw`{z*^3Q{A+?Dkll%$c_6N1Mj-P+Md*0{Z-@@r5-}DYVJ?D+@M*4RDHFo~nSKy8rr~l)N zjLHud7rED;^gx|`-X+K5%pGGR)3W6LyH`GW=~*|9*!#Pu4!!pKhj5n6=^KVGeEFup z$-}1&Nxk(4^L9fn_i%br#x-vb`h8B(yJwy?_WT!uci?UWr@xp~@!ja;=1}8aOXrqL zV$b27Jsg&1TINhV`Jt4r(>hxtOJ7Oq9Q6v$o;m&2f4z8l?i~x>eKzxr4}Q~Hc_aFV z(=)c@b=*B~&7`MtU;NFw+kOnWAK>))RS)bL^uc4vRbMslUi-;UFpkDsDS!6P?tee} zV(sZaTJh?hpB>zac11b8eB~dLYgT>q$%ID-_Iuxd&J(zc!|7R{-n8rE&M&uKaMRbZ zW&Oy0y~*j}Pxdc;c53Uo$3Ff0wh`Xb&~GQ;-e0CASo_gq%g&FyaB}{LIg@MKuEZHV zr%${5$0U>>FSQB7My{m-7U=d^AgnEUs0R&T|fAWqLo{owsmkINtXWN6TPV=K>r z?sRhcpC;V4?ed4N2;4F6r`u1QKeY|^ErZJSethC(cO@@z7ms`?{6FoJ3mChE(|Qc6K z-_NF9+3=s(!?;5N*~8vWIXQdnm#Y?>^V*lKU%a$x2J8=~pSR({J8c(U`At?!O4-EQ zTc5_=C{Eupd;Tf+p1*pq_p0CbPkHl;gXkahb*ANqSHESS^m_hxd*8Y2;Ff9cp-dO2 ze{uZlw_pEZQPTUrA6ZcS&|9D4P8z2_`E=*H(HE`zYGeJ4n?`MU{pXB*%;}*IJUOSH z`^4*CO&z+m;etz{Zzo{N%(PV6+XB-!&L4Tj*8{J;Ve93v^Yo@qrsen%YwwJ<54i7| z+Q1|3{(~pt&KjqC7OcMh=GD8hZr=XX$G2Yh(M-&RoPKc0&I{*OjeB6zm=i|Ve{=uu zvGotHD%0|-v9kw!9GW_@Z1AQV9Lrw%2zOmLeQEi~yPr5adw9cNS>A)c+K9U^?VP^; zjR8X*|K!$dCcgC7-@I_`@?y+ioIWG<_8)zDQA6`1Uz~i>|1|yaA@t8s%D;Y@HR-J@ zAG>x^@_XBd%-Z)FFaxzynD~_LjudkeSP_)zu@lc z*~6&ZgRgwJvTEVL&Wf}D@ylP$U;Ym6u5fzl!;ku}v*&$s!OUNxvC^`Ipl#zRh;dFPd)e|M&w__Idui z?+ZrT{>W$LXTgoX3e6O;3|WpTs5&WkJGy7j0gK$#z+y z>F0m1X`cFSS;Av(Nv!^GX8tIL-LfjolnGB4)QTqTR3_So_4O?)T4K@qMAJ7lw=7C{ z+}BqxPqf^H_@ckw&#;Wh(7D7;%A{rB(BwCuH)i5>~unFr53{9k^ zwJG80-Bg9c<#Uv}FB+7n4#d?5T~nQ~BH}w_-$S(KdbEBYzqhubswQ#YPnzSxM7y)5 zxprB!nKvfUELv)oMgBKr)702R9(ba)SQ2e+h}M0thRnyudtxmKFCj3iCtCU1`e>xO z9tRZ(4|90K-$R*Ur>OCXRv#_L3PPmrlUbg>5?>~aG(q=pfcrg4ZD{Gqk2z|4RD;^| zP>Z9?r@A?Im`VL8Gx~nMVN#BM#hgw?S%Y z-$mU+=N^r-nU`q#+WLfj91Mx-#1|OV7=UzWb zdr?Q9giE+0=!2e@Lq}PQ=<@2sw}9(gmM5-4XhCaB;_8d(J3mnkfFCO-Z#DyG+BjCl zb(SI-va;m};n*BBIw7Z!m90exM@pbwAwyPn1420R0_|oQva-h!I)~Hf6rDm=M&Ca< zo6}yBAuIb6Len|zeHpT{zav!0X@_LU$~qCkkps#|#_2ePtZXPkXK~ta8M3nR2uSdr^k0>}`Z_^o91mCqq_t5Fs4@ zf%d5kS=o08oz7`VsUl=$nFyW6X+vem%Ellxfz!szkd+l6bSkG6$`D?|L1;Xu&6FW4 zt3YTRr_GfiD_e|E4yQH9kd>`MXe_6-$&i)(7$F>aqt4gKkd}!OEbJ}+@WMutfx8xa(;vhxtau^ec{GGt{wgm6R%T2O|pY#u^5 zmISRvhOBHULO2QqtyPAs>{5hq{0bVrK+Z!}_BWgzi!u0#3|ZN*0g5(4hODee(;S+% zMAI5I?M6+zMbma_+B2GVP}4ruv=gkV+!JL8H+40wMAPauZKJ(zHfRYtb~iuOQOip=r-(+H;!rsix6)Fh#j1;?99c zd$J5+ENI$HO=5mou<(jnMD0=(zIJO z?XQ})U(+&Sh(#GgWys3T(X{h5ZGomO*0gIi?FLOdB}3&mPKNMesHTN9?MIqMw;4p8 z@6og^n)aHey{T#6X<8D7gh+du3=L$HG%ciQ6`FR5rqNfbMA|Ky_MoQyLDT-IX*4KB zU!};9m7Sq!XKGqV(<(GA2S%ufkKYM0gn2>J)@j=QGw{t3&i8j2vNBh@CnwFd<{*8= z+tslyCzm70>vGnERgu;%PqSuRh7aFp%I>zDufbsA+1)mw8)afQN^UnwK{rZaH_D7| zl%j4FM>mSA8^zO&;_pTYb)!^tqs;9_nb(a{(~YvI8>OxrrKuYw)`jBQ-L||tsjWL{ zeHT&(7g@U_C#1yM!9@mH?=s1;qm85n;`TTq2@YwO8)->!V8iV%trZ<@Bs&lvizAZw zkan(-mc$3PhvV2tf*|gQBa#r2HfE$HA%fyJC?rHsiVO+~5tJr_LPA95xI<#9Ey)pV zH3l2W5p1``v5_c2+!#kBX(Fx5NK4WLWu8GHX(Hh@aS2JFAhwx^t`06!7g8@$sX-&5 z(onoNo|ObkfMw^P#C;>()Ml-?MeO5_WyPXpzWL!~SjRe&q-gOlWHgT`v z*(C4m+^cG^yC@BlA)B&e?U$B}bv4LL#jIVPleWs}wW6H0`_fz;8-)32-;je(XR(ZJ zdx)Ka9Yxu%?HkvLyik=r0F_TiT*`J^PR2IDu-=igYX4^@PFDwm5n`=_RD<_FKi`~B z_RhUV4LSz6ItFBH8!&LEs#Loz+g#=j&5JTs1d5>lI(Mi<$i&rdF-3P2rFEiFvYj0R z+HJ^38_kZQ^tiO`wsceM+U4o2b+n1lQIy$*J#+uH-*t9oY(v}EepwvjP5q{`vvdFZ zRYp@G6nF}W2nF9GQ$nF&oKRjgb#;$IA%;E(WvZ#BDBxHV${dqWX3mQf3S6s1gtEgB z3I*eY@^WuNA%;E(Wpl)+=`kpjMJA#A;zFaT7%61hr1@Hm-c_TIo3F*{DPG@QFkkqB zo*F3>j1$W1M-qz8azhUBwYw(tV#HES^*vTZ(*Yxld-L6;$=HB*8MWB-zU`W*o^N`x;D99*=r+f#yVc66vAnBxm38* zU#RkQwXdnbAXWLIK#@o1j#s|ydlvIdS-93dK{>M65S1w?#2}}s|B&q-I~TX?O;e>& z^PPK>`d+R-zFc}Vm+}Z(dW@3Cf5dVe(2_REIeQ!q~N-$ItEg!mC7r)^^BgE2bJ zRMTTc<4x1{39YI77tJE`!DsP2VVk}sO&Br9=t0N`E6qe?^p+tb3dYIko!(?b41JJM zW2I5kV^BsmlTg-G7)^yxG7}TZUPCApj1$V<-h@I7eGtmqvyGY_gF>k^3FRN~thDQuY}_p;T(+b2Yen1Lwusz1{Ao&2+E6?uAX0qXMJ-_{ z7$?$CO(pc`$`L~!MC$s1QPX2dq^kEjxID0jk+IE_v&yuYw1(uQxG?PKTrL3_;ltue zMih*b(LZ~W5i#^ZMtAv)n*LYIh|W_JkWr=~BMQdJ=*!+@L=1h95%c~(8DS^8D2-0U z6OhqxLq-&glhL=m$%q*GAfvgS|0g3Zqv3{(7Q$ChRuEfimQ@SY6J{0DMmcuWvJDYY zkc(*TUJH%`m?@LEWTu_@jBOh@-+I^3UiQ;|G1I8hv10CiY}!xTT~vtv*S(H0L-&so z7&8+Lflx4R%%sGN#B{bJw|a=74`XJ6+o5JMlNb7kp&y>w1YOge>zbSM}no%G(MLkxY8&OzsYw{+GnFJu?iWDB?K%*>#pxIIgoC7}gV+?VpCEJ;`(pWJ*57#oe=`#q@zc^pr>{0)9CP_aID_ z!1V)O3p#MZ&t0+I;%W@nqfA)!T?j#yL;&|G=ot$2bIQjs`nYkWrsShgD3_s76f`N+ zP*e6jDHO%`L7{H88MQnn6)KxX`jQ=)$?`(eCS@H+x1bD`{nMdD`@g`soQk0xMJ>9u zPvDM*I#%O`WI>S;iz_;aUArR*mPFrz!W2)}f_rwrlDk}yNmiwj{qP&&rl1sef9Tfm zcyX`Yr_;fJK+7l|Y)_!vUcBL-oo}lCF?1UPBad32w8|<&{Y=Jx>v=|_As)KFEyc6I z)UmMc8LJkkL5oqfc3*~BJQap`D9FV#uJaP!^P^1p#HSPjqId}CvEBvL&s5iAWk_C) zF$S?v>n)}k{KRv6o|B=_#5x^AH{+^L&~ql6E9HhCRMcY>63qs?j5!MPI?oU&1?707 z6==38`<~1z#rMIyo;|~;<*_15Jzry+I_W@u*BKDcG!CZ=d%MbT*CyjFoBiiO5xUH- z8~Kd6exqe{6b%1{A%1pUP7eB)9mt}qe-!*~$9fS^gmXkG7mrW`+72Mj^&3(q01iCU z(-a@4S9ha?E>&5_>(Herl)$qDc^q<91zxse^)wa6zQ!h10fRlADxz4v+at3*@HCMq zClH9EOC2_fxQ&(Z&UB#O+n8+0rdC1_lM?z&IHLBiEEmd^%z0C?1nxO)s<1DbtP094iB3 z<6*o}cp%G#DZ3b5FQs84DXhw=v8?J(Fw`_zrD8iri3TDZV~Fr5Ok0y7K?+Iz%VSXv=@>pWe5qc;m+dv3d$@gh49+;+S0}UQs@;*qdsE)RzG|JN={}IFJ#Zkl zg>q`v4^7*@1PS&(_4QHOQ~ba(Z5ueUQ4FvG(Bn3OG02|;N8c)zl6DSqTs^U`+-P@2 zUwM(USVlmqHcYnfBl$jABF(Y6*TYeK#=}= zawce#p%ZbJ#BVa}cC2ww5^OT8%b5Y~>BOZz1d9-)>wSC*rw8b&7oRZ1N2kuvt9h8FdP$}Bi zUAcjLj=9u!yg7q%sK6bB8JB&G|05~y9NO)m0G_#@E}l%jUU438$PV!2;~!}i@hcYt z9uRkLkj*tRnxhilIxaZGwwYsv)~GyOQftKfF(`oN(4B|tC9>LlHV2|!G>n- z0PtR?0G`_bh}{TKs)Q*a2aj?-U&lLAcvol!F-~{otXi$OB@KrD4E+KME&10&;pJN~ z6y)=RHi?0CNOxv@J@xT|{+aoGt6jJTl4u3j9l&1V`dIaa2Pr5NZ^9QYl3 z(p?gR*|pj-8Lft{2swIk7ImbofotZvBz6C7NC81p40o;ti$1g&2fEBVVv+;j5RPae zcRk{~#*i)rO|!qplu6gwAJw2}NO4{-Qha;Tu_whFAw|rlxWqpY9l%xjRI=b&Y#YQN zO<99E!F9%-j-8k7ST*Jd(dUwHU@}g3Pc$n*x7_gl00!V@$Q#Om;$v!rF2vDiQYOU7mQ<4t+k%_cc_Y(fqwn625)Uod1W+gyokRDvgO9R_g|FIv-- zjMkvYrUN5*o~=VrU=wOX@mHmgscVwluk3|IAaa5hdh;3o6&89tdPvC+!q5ZtC@l0Q zV+>R9NEX`Py@(zxG;wjYKJvSa-<@Wv?=iAb+q;EMqgLyoel!;PR72E9VWBr0(xsru zLWj)4G#hp?&r&p`*qeneoN(+(@&CAmPKGQECFtEkb3>Z3?m8^)ge_io1%hNdxu>t+ z_;yvdk%y~XNOD8TM~-{Oc_Xd5`MWwQq60pCGIHa0KDE2-xYD8QiFhF`7DVYyZ1qf( z?8h`wWSVqxVTnYZSd>Kc({+dLsgPYvL=e!HDlJebta?kWCvC`HFq4zaD> zm*m=nYVhRGxvHP*bGl@mZtec0qe+-zN|@ZYguGYxrJ%JG+W!$;8`(2#*&Or=@6ruC z@+wDKXU7h-i1+VC(Z8>BJm1lmmQfll#sjy}aH6aY$%JxNVbh(uasP*~d{bVPB6%_s zhVSxLKH-089%-a|36&nJ%>q+DpP7+Wr&S- z+GV$_-H{>m*<2=a;VbSw=&8t7%4B~zTufzpI`~*L?c#DVsMu~6&yc!eS^EUZ4J-V2 z@PF(+)KCk=p2Z>r^_~Si@Sddr`iTI07War$O=ebl;H(q?D*;h)!pEq z*>j$UG4Tf`_KCfl`9=@!KnEV}Cd^Yf=7u~e>9M>C0|)E-y7>3P{>e=k3LeSDU(WS2 zZl9+I7oWKL;NqXioe`PYe~pVj4tJr*6de5~4Aurp)JNgsKWs>sf+iP#m06hGU3`k} zgNq*?MP}sKlH&hy7e5>KYz-yo-NoO(>=U@HOYuL|)pQ$lRhD|f?n%*fSE0${ej4|z zkGOAtcHGJP+Ev)MUlqTXk5h!A>7g|a)8XtQUjZQeu^HvdD`ce<_;Ef6L*z zgrWAA6vcPR_BFhDt479=d9Q5bQKpXZ;iZEE_aCwL=l0SK8`e{C(>L(On6m!oaAf_E z?(-sYQ1ys=wkTbPcegcR=|lT(26GyQyk_X>4NLVgkp{7S7oyC~7laKdie8{YMb)d? z5$#yVH37ZsNmEknnh{!GB<=y^lie}jF?Dsc(>gF?TZ*mw;&a^^%5z*N4x8dc8ozi9 z;i55aQ_A%z zSqH*L$aU@BjKk!)^MjNlW*g@X!BM7WcJaYvhwk4-JHXn;7Q!lrdhEc*Q*4K8N5-~v zD-K+qpeZ1f6WaM<(%KJGGPXUBGfbkr_P37b*M5+(^8<7R{K{SEDzZ-;r7y3fM1^eN zF+KH{EN45FBknetiz0HDqS~Mh)W1@~B4?#xW+98(2sxAHQQeLtYU&9g+QZkDq&w@# zc|pK3Cn3-yW+t;D0U=0DQ=N%Nz91?pQ%LmXBhnN-M6u3W@D5 z>e8dbO{-0t&JV>~@F_m1B~nxW9vCPeL^n$DLwgY4QB*WVpM#=n_a6Y0D)2}$dv2(~ z_kT%ddr)89h4C_@sDxy;e-`!zdYX!jNrD#EU2PmK4RI>PKbzQXqJX*Lld@7A=qBgq z#x4!X2L2|_P}BB<*=>NP%B5#l!%SS=4Kq>q7n>$qs9a&!!c*4lG(H1qQsu*s?G681 z#`c{<3_Xb-uhd2@P8t!$@G6?Ydp2X+4%LkKQQvb@{{Jy5Uo?+OdZ0f&;x^7-(?za&|x3R8tgitbG=<+4M!4DSQ`A3k65di3sH_ zLnsuC6UzGDghC8`5K22Y4sxnG_Jraz357mFuf{CyGEGcOD0>Z|P%us?W=r1VNFjzk z2<4wRtWq^S21iPvNhkwMO@&Yx>V^O zgfclXp?qoxg@SQH+1Q&RC$%(bErypuDQT*-e>4#cOl%n?a^g}Hs zN>lrK`k@w05tpCa*VAvcXrd>lrhPsAP>ZH);6KmOzMg)o#YCht=JxgUTP>Q1OXKb9 z>4#cOlzHvz>4#c0WdnbkqahwS<|FIUijY``l zn~?#?^kXg9=<~SN?3#d4_uB>J+5CV0??w41ejjS>LG1iGaOy{p9| z+t(1^fxBF5cMbn-Dn`(GC@O`eBZQ9#zz4A4&S(**JzT)p7#_0X`?B;srxf-QLL+(T z>5!sT@kEU^3W3q(UwXw+l~`R2`D~`$RTZHJFo6z~i;+G4PSqef!IV}yL<9H|?A?)9RFB2i`Eh01&p-dja z|JZOmslQ8A0C+zBAx|B`%8fyvK!f&h{Xm{NMCBIqSW9{mOSeRsWq^eZfbvidR%W3& z5oZ~n9kMd~_8StW0R;|)I%PFWgZ!(JgDADvTa!=I>|uMk2BGmO!Q%r zK9i;5L$_^Ib<4W zSUh)aPY!6*o^g`b%2J1nK}&^>$*_fFB*LSUK08#xl7|c$mds8?8oa&R*s!pqwV|4R zMx7lZ`UFn*N1O3W>#=A{WGj^Q)?tD0z}DWwSt4b<|N;C(AemX(uonv;jg!(e}oM zSaf-e%V#{|a#=}jLsebvN)fAa_>-9f&r}B|klJO=yQ@tpmAtMVc&T5Ee3RHr$vaE(Vvgf& zqkS^sBP457Ci%PuAD;_Tpm$U+zd`5ee}HF7Pe|zlK;jD;d~tJWSkhIy%JEG9C=VKo zWcz31new1tc@=UN^Kq)I!yHXd%2Z*M-(1AeKXZN;;FZ|(ehln%swy+wRCMwgYdXSGmJ_PZKzD;5aCGR518{eNs->N*Q9V(9{2vgtG$vo<1 z9*URBpfb(nHA>#5F1(bN>LZnJv*c}&yh=|g-?1oJpz?`Bb|oKb5D_kJXa*63IKh$Fc7S#%THr3smEOjZ8DS$29X-Mp|Oc z(W-hD)BI2?kVihU}ik0$meVoZxQk88Ch_C^^7ixf6k20uc!-u zpd_9juU_-?S0Q7nPkO)j^l7p_SIhX^;qmcUK^(d~Rrnd}z{40ipkCO2YGWFnsT*nD z&&G4Qc#br-#v;{=48BYgy)N3I`G>Okb&b_a0#yw)jrFxH(Hc2_QQpH@vp3XO+NkC^ zqK#tBA%COrGswTsX7gK$TNf-a^W=c$sa+N|(=XtK)7&0V6)pU7J3G5I;7)s6K{ z&C!+?Q~9~9y0y8vnCjy#vS{=C#ul0gsohksLWYTPp+D9v`KWF)Sd6O5=Tzb; zVoP#Woi0OPI#_GN$_25i`KG)bDGj_sBCSSWTn=7WN;T)C^61%<#-HttO`;C;%klp7 znD+5#Tvnvl)#XhS<TBg-!(n;!}9b7cSE>E%jXKTXH|MFCs7&e>3I-;M)ify)DGH) zK`qgxp~i3nK-Kk1q7SZ*EvORh?4ak-c%EN{0z}#kpuIS{C0ZA)MtcPx(MCrVtt_@c z^8Og~q_(E}l#X7*pI1FnS6g2jlRScU|8u+u=~D~ZJ0CPfF*+peTAnuj>-yRTPqabk zEVVxgzxmu!wJaK`HFP5hzxvE+i_Nr&f)+E=as{obu4z$~@V%4{CbboaxCZV-wy1iD zG7Du~Q1*klJ~Kp|(^njyrby5il23{uAloJKbC}{t%|%~}IF~F79%pcc?hg^?k#Stj z%WM_qw)xF*dTb@Ng#_ zuaoq}raCnV+Cuba9B)k0%W4})iBz9q{3YS{q`8b2dbl=mxp8`%q!*LY3VXrn>m?m) zIM`fTlNTYI>!4TaFRAUCue;4;D3g2#8uP+GiVu?=C%T%$$#10g(?9YL=$UqGZUP_W zvq|!+IhW$Q`kJ>$-diPaKZ}?%ns{CfP=rXWTK|v@Nn=&Zs%q-zNl8xDc|9Y=ZmSv$Rk_kOGIU_a%6g%lX%8bCRFAGQykA+#!>rnO>^7L zXjdVdzY=prqtcDrKq~@mL332wGD_!SjZIZcTRDyV2<&_%-40&$=SP|&`4KVXq2xyG zRAI8|DopiJVJcIFX&w+^;lo}EJ}y&UxP{$~XOihXru5_+sPy;B@EG|2{gH<1qW+OS zDLv7;!t?FVw#a<%Gv!4-h06B<8CE*P^Fe-8HwvSR*h4aphfV2dt~0kMzFZ4?RHk`M z@{zBVjoirBLH6){RQ^WWmCybLbX4po_-%op6FX*JpVy6jGxr=Pja#vgAmT~_Zl~Ab zsZ{i2Cg?$@Jpnon`)wgtq$J=gi%=y+yR0$}6cI&CGH#%Z zD|46Wen^+JpfgbJl=T~=Xm*#g%qHqISkc@eoi;<#9KJG}8}^#|HB-_&K0Du@Q~i^r z(yM-zi73qw8E5W;<0MV@4BDQLy&LSI^1YiUp%)SCVDX-!jX$54c5UJ*aN%D~R(nq+ zPFpA(a7KK^GoAJjl)~xNJ}wN>24pj*km^ z-6bU|E=9-9c6%MZ*^z)V7z(&~g@aNqsRoa;*k_OUeg3e&%;vR~I=PBb8T~X*vD0NM z$JSYpm)&2}9qyp5*yD_p&5HN~zL3w3?OdS~X_|+m;wj@TcSi6q3pMicdsg zkImu04zH;zxQ-3h@v5QmZOPE_t`K${!_aN74MOwVg2CCofFmNiO35};^9OAu&PXu? z74iu+;q}SV@nNq$610^&9aLwG4*M*X#}Lg^>I_k9BT(=NvGGv~HRgleq4^9BmdLUFSvWm z`{gP03ydLUi35^y^o8jO?Kkg1oh|1}#_VoC4USonk}#@5bwgi(X0zL&HW7!@>voDU ziar6|>zwTjL@;rXN=0A~f)JkEho^X-$8nf=^bMt_VTt;ccwiBEdFUU|LxFHGMESZ) zFmKCao-#iyvo{neb3=nMPg(u82DePKOEqfe1{*vm(G z$QQ8{`vRm-)Xp?fALu9YD8>XY>F8gor$LW|-4VYtz$<}aRDwRI{c-YNc91TjdJa#- zZEviJx*M>EQdbwr&CSgtWjst2r19CIIa&tjf4|38NxkAOjX){9m}oF<1<;jfHr3zn zw4-An2~l?o>n#liWGNr`4B{bU@*!&u+!a3 z`;2m7)uCS9^I&bAy=5YdSr~a?T@iqc;4^X={RT4XB{4+R3x^y(Cn7K92dnc{8dvJ< zlFo`qw=k~YFO)iGVPYWzTjne)R=yU-ml5ZH+Y!Q?&!dHGG0u$mpff}xM%l;YE^*5D z6poijk8x(CFLin`G_;MuSTo|}2^r>UJ`ORij5rZ2vC%{=^#^0gh^N&)`YK_%2UW7HIut6n_&DGHwO+{Jc3nt03o)=}Q z=+KI$s3^@$L3xIq^K!pioe7FEI1K{eE*CF1iE)}O1c$9SZ1}y&g3eE!DQ${)wmWPg z8_bY!My0-|ia6LUI_eBKOPm3C0;-QinLJMSE2m+=lEtO*PCiy3EHYKLit}JLH|jb- zl%rID%g`E6i-an%!jSbE*d?wcU@JARXVOKy*9SL%+y&}y-1p$JeNpr`92_sKoYCDT z0($$iLqpQkI*eQ@;ZVRO@;cBgSR-E;4u`5w5;O6@_IarrwSR4j3pgF_fQ*!FNinA_ z#tcA?Hg_jUB0`5!%{(d^1#k|TPd_scR)vbq%+ue@6IT{FSA2pBsy3yWd8Mn2B2A1! zo&(H$rgBY;Tpz7wzAz~VEn=JwyU(xJuLI3IL1YH5fb$1otU9<(q?_aI9(crVhpikV zo7N6e2M3vXXt_g*V=(c$3^w!dYLKr>*2!R`v5{fsp;buO*Az+j@!W>7PfhZ~tHrC<61Vep0(#(T#6@n$A z+07Sp)3}Chg9^#|pJ?WVIN?VHoPPL7stuBFl$p=&fd;`z5!YivZkj;kcsj|<=MH;k zc`+;v_27Lz+RP(HHVt-O_mjq?{Mcu};vBvzS#rD6jfJ3UYfe0`$O}FYd0pV*Z5`JW59}*e z$D(g!|BgQ_pJ;?C^VGxg1)Q|Uq4*{omJgkV^_Jp0?XY~f&lMDRbWT4k4_V97fXyN1 zwlmCpvd>(Y{#02L9SqtFc^;CO;pdQ z%PrbR#mrplDaL}AYzi%Xg~^rU7e0O0cx+?&LXr#H4KVb5+B5LA~sw)<9caf^wiQ4t)E}F zLe@KlX!g1)9ISJmZ2sJc6>oDZKaG_(nq`8|fuqTV;!dKN??H1mwARbKSQ0%iqnnI8 zFJ{4WNo};QMm`texis1kZLY2MS2g4EVl3LM(xxEJjXQA73vf?P@Z;{9Em9VZEo!Wh z{YTG@HLZ0~{>;+wY-GgCY@;;(=0=?J;`CqWJj(_x5RJ7qHY$> zjkSRiT2xDSBl{1-y=t!CZ$b{B+hVciP*wB7XbjyS_l#a&taU2fTpMxuu+qn&l~zeTcf6>Gm+_v`>XqG4G>4Q9TS6s)F%^(i?QyCA9g9 z8_%Jz+JnQMJ<lh)<{Ia$CS{Gkl#vL{pk4 zWjdH>@HyRd{Z`U4iRRAZb<5&u@F3%ci06Fue4KbLP|rhoTG7T~BCb%y9na&8`kWx* z`F=0ijN$ZL?!y&c(S{N942L2}W?q&*l4$Vp)bok-Oq+eSK)@ztGm2<-L7;q3qGviG zz?6Y)Ha-83Cc4K@9nHt#$>Mo75hz^_J;NEnwj6&RN6*-9GM7J|XtW2#iK5;`L?iEj z_9kUpY(&GXG7yeSB z+e>&^E*>VIUbNdy&sfXQ1~0OcwGwUV%%J>05|!s=uuRTx4?+2;pIA1YP5sY`C`~1K zf}B4Iwi6TxlKc<3w~YA*G`EM2E#!VXFH2I&Y{6Mz<>@({)~7^7|Bb=;Es(b5eT-kI zxzigi!`PJ}jN2qRZuvY7YFSE_`;VEDCH_~^B6LN~DyK(8B)2R&s7y;Utbcp?WEb~kC znX-s4#~~I8OYZ1P4yucV$;Ob3a6nQKvGcn~6xYe~c6;D)x_r0&|h<($n$v>4@D2b?~mC0et7_{?W!qHI<<+EkuN}d{xmFjA7q=_ zfy3;Xk&p`(JHk7O`je&b{-sSFE-7UP1s$u`S){6@e(aDJ;{seKDFuvo!6<#^D(g*Y$L;|acy@HvQ|p9(6uDLT#(>4XU>sBRx8 zE4sOEVo#gm_vv_=D0r>8JTgyJ=>(nbypjK)&V&9e{0GS-+z0u<`;5*C)H_7?Xg?=Z zN#{FQTWK4N_hJN%<_&t)N$L#Vg%NbMXp>_B@4y)RT-?IWq$oO;{iQJQ)V5Sj6Y9a) zW&ZtCoS0tt+&doa!~G$yHy?@iiNZwlL>R5RMe2ivVeb)Vx6TT`Tb{~sZ-&ZFl5sQ@ zMtmg^C@$t9enP|ONJG}utAGS&Rs zU*%)-(ju8(SWso8$v8+DgUT7g{Q-UEKS0Le0*}~;mHlru=yKN=8c()d#t$^&MLHbr zLE&*=CS;OsE|YTz{T*bas~G;tQBdmU)-ZHQ6SF;lhj!jtrnm_*lWRohOId0^WbO%PP?0z%lMi@$79BW!00jo zPFhLk7|U_#!!Z4H&r0>TSlj6Ia)*Ow&&Qlt=NR$g>XFj#xV$k^oL=)?ht&A8^^phF zt6zK^EyQ?z`^VGO6%rno)-?{ZBIPxpJDp#t;618!B(AO^O6v8%`1IKMG}@mY9~Y!6 zTFRzV*@NQaxnXj9OMI$-2lo(f9`jw|rTl1Q3LVUdPtO;u=5g00-ofwN2=NP>8K0hZ zmwBIM#nVN*WM2)5kE2y4Pt%1i%Hma}cOUx?!@JR3$Nxq;9>3N#pU0CR=!l-%`p8P!CeY^~Ht|ZDg?p~^MBu;l@ zDw1PGogHyHdGY-ERs^>@;@3p#{795bOBSr?>FNnT#TEUb&W|`x1@1w?GT|_h@9E&B zL9R;&#hhmdSj>CIGqfn6=W?t$=(3178^K|xCLcw=GJn?F z65Ov)@2!3!>VO2swuF4(I=oGnkNaA5qRoA8b+oPOV2ez5U|oz7RIL`5CkFEj|@(q{`qvggCn9cbLo+w6<8c6&I)? zxMPVoOGsC-XDOa>|AU^B_%pmpDT8DcKdk^?b};r%KNIC5vC+5kf%olox;zK2tMVHi z*k@9Hs;1E{5k1JVH63E&WZq}E3#0NN38Az7oIk~&yUYAIZgPj<96+D7ozUs{dlpoG zb-(4GqW+3OXs3EY3x28VAL5ngi({#S@H070Zfi(=5VSI%Ba8!LS#Lq(-gOCX2+4ZE zzvSt)*2;Y0V{*FP#}5p68{u1W8ZKqql1PYTeVJy6lF)3p8sqs@3-&eqgaS6j_rHs^h3VV>Ig%~j1S z%n{H7DlRNh!0lMRVm2t)_4FgdCJ`p!3L39y|L<%k@ZQ7F8=8XlHL}q=m~xFtj`q)Z7g17RwkhK z8UBD;BClqj?PU((-e1|wY)MG%Z)`7g2r`@eV6dcy&3AMhOX^rC0Y5BhK!(Ii5+bKk z_vV^kOm7MsSSUwcN>Y!UCB_CB0rFBW5Q%-1_ihsEgA)UpQxUoG_;X0cj1ALM;f|!; zx`K|t@pa|NoxEV UyYXpy5cdZFy*Ao$j_5LVRf3NjIS->BR0%SlmEy zVR2l?b#$B=w?T112X#b892I=(xQx$n=IM+&qvGK6i9TmgXUz9Mr>bt>ZaO41U;hYo z?>VPVojP^uRMo9}Pera6Bog%#8@GJ)saNBHPsVUx8iJE6j}70O3TVcbtKx- z-B#t-nD=Z#gh6+jLqbL&nJ3C?t5eYxDNTfQY?%N1Zk33b>rL zb0&6o$0F73v6hJg0was9F_1;;aoOG0Mu&f5Wf4l>gTEh8%Xz|5LBiPPERIBb7N6JJ z&VR|y?nG;J@$y(a(z!gjxU=QF#VxC1UDF9NYv$sm-Ak5qgyYqKi#g)d3a}Axh;s1h z?6DYWW2`mNne1GWs+{6Gw$js;igm@syh4Pn+9{P&TPvr=JKHPYyM^qY z`oXQ}2XjR^_XC2_ud+mlBan_kdLx@KQ(Rf>GX;K_1Mwag+ z*Rt=gmbybl#T&p@4ids+X^+N51t9MNl48h`MD%=dC_o<&2rN97aC_I%us^mcDh>gB zmjUkxuRxh%IDl&n;CW&M?pGW4@#$PZ7o@%%e;&)yXt;~>L~tt$SSCgy&$-5Zyn$$_ zFmI_4YdITqAC0G&`8)t+#`rX*s)3l2YI!u)wlu};rvNCaVoXHNQsr_(TS+kr{3`*Z zKaVBV+3D(xw~5iB&`|viz)XU_#*Zqsag^q;Y8C78Dg%(}=n@5DP)6>-$T~1swiruvapf7f378>mCHi#9wy9|J0_Y(t&X1?>7KCH`Ncn zukg1*Dur{CZGH*4PQYEef@7RpP4?Bl}L8P0JHX(fy=^~`h zA#Fzb3ex{T`X$oENCkLfpj};#^cwV@QvL63#<<0@7tjPes~}l$6tf^dqEkq@N<~Li#<@1X9vQ66s{5 zDWo+>yOGXC+Jm$k>2jpkB3*&>9;7RgZbEti(qAF{5z=>%UW4>Aq}L+-0qJ!}E1=iw zksg8+jkTKk{*6er#Bld-lqc?szsh%mo{-qR6_lPjPuJDV~~p!5&qOy(KDv@;>Ufu5{8C3jl1 ziMo$*55ujx?}@f@4`cgVL~!-H1u5Adv2rQc9i%T@--UDn(w`wc4JmAHHEc@!0_i%W zcO!+a#XU$#Z}%c4{mz2zoSvoM`RK~T(}8qDwtj7iXgC$MM@e6Sa0{jY?1qUx#}8^I zhgS)dRC7D#A}Llq=~=>B!pSIuY79_UG|^$`c%RmoM|AkhXpM$6Fx?tn1DM$wLk+m} z;_24uk}i7y&BN_;KN#sB>5bZFBmh5Az(=8H(#_*YE0O*R>FG$fB1K;pPas8~5Kkd} z2I;SnjzXJkBRtY)k*-Jj8>H7E-H!BOq|YP$Bhud@-Hr4Gq+cU_5$QKbUqU(>^6WrL z?YI*uwfDCWW|AnW_yyXvLex6lc7MPc2>L^{j(Vp%=yiFlcDprT6-OzeL(D`Dx7|dd z`HV7?czvFL$L4X_Tvor|X@_yh!bY2k9B!M(?sV6SsS10j8N1NobJjT>_C{x;Bhc)1 zSQlEIE^DpJA*Lwu!_4HeBsc2ea=APQ`#M>*rOGn!_8Q#I%J|!8?0`- z%i+TyS5om)Xi5lYq&@0i+MU9*JdOcC)@iIcyUpVcINX?S`n?{%lZ3Da0#;jtI7U$) znL+J>a%@(&ljL>>oYsItOjd;B%!JOMdx6{2sk zB=kAvqpk+wls*ZenMQ9wRIBP#n+d%RpWo@Hb`Pnl8#U4ztTEHuU=T1ucfjXy862l& zQ0!wybxxOqR*>RYCBbwvJ-4c3QNZi6I^B&hd4kS%|1SEKvJ7du2I?LmB_#E{iwOGe^C6N|kLN+XLHDWbUQt=~Xvk0%%=XZqA z={#b&Hzm_!kfHzk6>iok0PG=%D4pe&ch zmMJV`l}IAPa4Pc-QCMmZ_He{-r~>-Atqkxm4Tjk^S`8M%HP{KaMNX1fj8H(krxB)T z=%HMJ4cAQmi|8vf6Rld6QS%$A@T%&gknKKXLp%C|M!Qol+XiTvI5X(*HIp{krMg@W zJ6gln%sRam6hhQFFw*%PAx|y!d>DeQfm|K=OCqos1Y}$xhs&{0jwK{85fm5%q`D9f z62w5`3p4S4GGxM2*P;AH2EGY?+S3H@=MVUtaJU|~pSvtk6{o2jwH_Nhr8nqpw7RYJ z4z{ncirXNAt`_6fLZ`>)H%cloaOlf4a)ufgg!IU4lvHX^QQNp0Ss#uNb!ABB7UNV& zgAF>}3u-Yw@?cB?mlgbP(}j263IoXT!j1xBEh9cRW&~2_t)4q8nq-EoyX;q7B11+`wqj0uC1* z?xihJS8l99S?6#-VBKSmFyK7Eplf@BoE-zQA5BqGaXlok2%9Zr!{pAzzKB2t1Zwo# z(A2PO%*Z7rgB6V243QQxsa2Dbmn3izf${VZ*-|%N($;@KLKYv35GwZcPxO-k*XUVjkTD7l6?>wRZOGpa7_U?1EwIK zPZX$Hn!@i0@H1ytBw46GiMq=Ta&lBiJUG*!I=BP?`B-i?r`dm8C%7eG)b&^Jj{lnuT}O;xDS9|H~Jb9%`eE(p~HVZk)S z5FAzqIL)a2evG(otjX9%6AtzUoZHcanH^?#@Yas0=^&`UoHvd+K#;yMrh2rG2dk;NlOhX5jKb{jzzQran+&G z>S=QBlg==JLE94y@Y0Zo(LX^PbhEEVvsr7gJ-}{_u;`~G8Qc-r)MA3ied$DCECPcG z_4Hb+jYd_ByksG6kFOEkg=+RJs78ulB1WDLO9WtPO2KWvnK=-yfvnn&k)N7@zy+Lz z!A|eOnHb|rDjs9_!a&G59Tq3=O9k$0F?C=QBZ|QULHl8J!Q`J>{a2jN=1DhBqjf&r zP3Im#nW`ugmMa(uSp+U>wOGwio(I}l8^2~&fo8wg0iOybvhC4?n=pk!VT@%8RfjM| z8UrQN<4FK{8G;uZaOe-S8ftwO>H#3<3BNVe7)>qhjIg>0CQ1SGhG|DAh0UuO;Bzy; z1%hgfg$h}Yvpxjx>vlOYb3=vj1Oa}-i50oeWwpU<^|K0#d8vWf8Ljv+@_B+7;<)S6 zgOLI=5xBe6qFAr23(a_+L$1APu+}U1A~OL$Satj z)aHKR=OLFQFEtaZ=@$euQR+qHU^AtuY!j&#v&>8yqz=c+Si8;RZ8jbz3^5a7{Vx@Z zNx45D4o8bU0qKmz8MO=^BRB$v#)g@*Ya>gq{b;sB^&4&`V=1)RrD^rrcZ8Xi73Xip zvNEQU%e4uR>qJT!ixs}2KT5&(WIJ3|3fq_m6mNMb_`>`0PrLGV2xU0j!A4g1qmpYKX8MML?j|{GQr*-{^hAPY`09ZKb0sA@V{$T&pjmu+)bFjOGN?d$ zkWL*aU3zC{J6i+kB$QJr)X%6(s2)MLx*tLWx}`RE$wt?mQd#JDV5u=OIGbAIXy9q& z>1W*Gs*#zp}{ra7a zUaac%EQDKxCh5qNo`qvnD6P0n<*<>P33@~IJ`euKP-%0x()r2GZq<}}YNKk7NkD1E zEgETNgBgi*YC*%zO#pE3ImzxVw$Pd()j;yH#te9ymp51zXI-Fr4&Q(h%@g3k{O4?q3Uf-66=&Uj?gC%yI; zKG=j8qEK+TWySxUap+6KAGoIEUgulRm5tX5aS_9>zb5wF#QI}99{%>P8_)h~>&Mv7 zk@Oui>pO0%S^Br1{;;U+_s?Rprx1HO<(4PskJ`JwG_d{;|JA+r=&x)48}c*!`|zsA z5-VP7t$5|4?@pU`B{rPaFnnIsmNSn1HO=l z349^LN4$S!?9Pr|8^zWkyFNL8VT%w?Gu(6j;!D4L&UeI&SL(M#{x$3rA@(wSYTG04 zZy&Ow;^Ol8y{Au|i%sJh*mx_q9RA29mp}U(TVtbr(dUt?pJ>J)!tlC^dy0o1{o?Lp z&$zqm`oDg9ln`4Oe#8Ilw0HeyeD-z6jIUm~`K7(syJz^!pWgmP=|tb(A9X}V4Q@XU z`k7u#{Hs>}YR`!ip069TWYw-eZ#)j0&7`?R|@Kl$-nLtrP<;9SZrmkhgQj&swE zw>JNE*iA1~ybL4hWcZf5NB?$@W5nujR_&cW^6MS2hldz`|NXb#X1Q?0i&R z^|uJ|1;cyaE^Ishp>rN9{?qKMj=$?w$a4br#>*{BpB($gz|SYm+d9$fbM3w}jD38D zf4{2y%tvEq#%@2l*4NWp|?>(h`&Gf$>Tj|gkG62{qVD@W2@I=Ok?=0E8cjl z`}S+^^8fqLcVGL+Z##9tV`Y-xj61d2CpoH6>J zk3F^*FFPEAo#}GRpN^e>_N1F$8Fk&7W3Kz%CssI<^BMl(MQdLjHF)7SpFK08V$(Ig zbwWJM@W-DVbmylh6(4!j7hj2MzuSq8|Gf;qb!6c?H(mYG=6`+OZn^r$A5>t!e;Dy! z>6~)g)pt$1;D!Ykc1?Nue!R@l!|)mJ#iwlA_R5v#&2KNdqo86t_N5vA(gkm=e!cA7 zdoRE5t&``>{ub>Hw+%jTetGeRXOb1&Wk|HJUA;t&6F%pub!Jrx-C=Sj_TVLSg~ z_Y4h|6%yACqF(W ze9OzH9#h;t?C$Ts`%m~EhCjUMhCBZH!>WJTAG-0g=D+{wcDh|?r&bZ@Kp3)hM&IioS#|GS^s@SvZ(QdJG!66 z{yoDtHMJad{}~q#cVGQ_Nzos^`5gLzuFEa|am~B7sc%pJ;e+=s|9sP|Kch?s!@oK7 z?K^JxXkNizULQNN_2GBF#7kWaf9l!Zwd0qs{r1L=n{GLB)7!rk;%^KOeCVn==Cmi@ z{`RC%TjFP53VR!cA+y}lY+LO+<;Iq=SAI9-x*u=30)9Tg@Iw#3>}Sz+gCDpy=6lpx zGW-O*cf)Ykl8bM+_2L&QZr%3Gr?+4K$$TMRWBBLGwx6>&JbCji6Av5T@%@9Z1%{tme8&ZQm&X&2elua*FS`EtF!VEu_;>V_6}-Ft@$04* z{(0NT1-pKa_GS2&$vwZ`-t~_kp1b{j|1n|QvCrW>B8IO#yz9(|4m;0LDEe}DaS%Zm5#eiOrsA9>7sy=~eTH{J8X8}XK7=Ha~!hF|<&$KAi? z{mo6IcZ=^Q#~#5r@-K!j`A(GVJ>&Pif8O<%O?RJnJ;uyA@HOR@Ht*hbJ8pVlcUgPI z_m94J6#V%bhVQ=Xq3^ao_=x|=JH8yYZQS#R3Nr*!tdus$wYw|5S5{c%UwX;1M?oM^)n;ixd>ugQs-Q%gr@GLm* znj?QWxia2*5c0=!dAkGb@vUUH`O1*$>FmxW!$7@7BAU0a!8@SI&V%w6ovq9At#>k& z2)E-M-+c3#{+5Fp=1F%w zdH1_MHe1K=BvYwj^xT@D%z26{;ouFY2N+5qjg2T<+kBl zIAeyPKUy2m*FvrN%_=*?2Qeo^D`9--%zK1Lc12s^Y0z8qHWYZ7P_nx#@3Gw^LSK9i z(C}r2@-=`Ad7zrsysZ%5FCIkGn&s#|m`QIe9**Qc@l(EdcE0M2Bw{_$1Xm_s7Rg9Y z=>G$ouFfu+e&;L2vS=b6Z9k}r&?g|NWZvrs4C(m_AM1#QT05{yk#{%8RQMo_8Gec? zpRf3+IhGGH_ketI%PM@%9O{DY;WM6tC^eqUHHkT3e-wc$L%9bs)0~!X{#Zxe6C8Aj z*8Eo&tu#-`S85a;kEWLA?FyI2^IucOTV~YcD|dIIy(52>q1G6Q@+}*a!j8Nr!zed_ z@6huto7$^AZ_ka~6lNjc!tu~B@4R>x8;LB-t@Q)+7yL{VkL)&;7{8*p3Nu;z1$varKmH3b~R?y?QI>U|DGQ#P!v z`T(d?aCwopp%qEPhK*GeW8tz>*NE<6JJwb`f*T8EJ1hggp=ixIi3AU#+5SQ41{e5l zZ)kmaoqc1??ptR(ciCRch_!356|TxbkyT)MF4Yb{Tz2V8dsU4BQ6z;QdV70GUM@Jd zyd$o81sPbT9c$N8CgkZwLBt)klNSxGG9}U0ZCp#mDH0G+m;@rAbi-Ok0!pzG2udlG zLC811MWq^AH*Vzou8lRPxYpKOGy|L%ySL#MAT!xWQca)=+kKx=+(zcFMEYzjL|?Ow zMW^sQ7nVKsCd^?MY2-2qwv6~u2`mmprcej)n}-@3wKIe#q}IVsP?0jAW{TiIx}*$r zovtl~a!?Jm0|dxR_%}a5UWx;uc%35eE-wD;=aPu{D&R$@frw~(pCdg;QAi&I+ec~T z2C*uEL?R*j%u%p=8qp|jnc{0L6B7JL^v|lHOQW6}nRmM7mGV||fyy-cQ{G)5*2<&n zwDKr$MW*ry&&s2y7is0u-9E}AAS;h9vXw`$oXV5LsH~(|TSY>U@^a=-%2T+i4Dq${ z2nl|KGnB`K8=1FO9{MgjjVe;^Y7nDORRKv|k3eLQxj^={HIsYU_BN_)8*A2lNRYYP zFCJ^;)MSw4aWLOK#waEWlaYfuJyl-HLyQShxE&prxb$ux0)Iqu!XuHdfcqJUub_Hm z`icj^jY_68Z2%N|grJn7NJ94QD;TSMMFtz)5Rw22pbP0Mm~JEUS0a73`+N9`3#+P% zuw4yD@s@TJFWIXq*~#zMXn_;c z+K;EdAUf79TzkN09 zmvg+l?DH`@imH@)YA|S(@|ao5=3k21&c=XQddWh_4VMfJ&7(-4Mjpr_iU>?s& zKCn{)&I7h6ON0gz;gT~!h4+Y*fJ0fpp%Bmu?9hwgRgsW@vz35F-A53tlwdU*0#!pv zLfp%G?|yps?YU}v*@aa_hh21tQMD;Miq>$U@8zOa#TQ+4ijjefXa7ga!o&jCXg=sJ zK%xyT<2eQ0O<7m8e)nU<*06DB1) z^Q1N9Y}Ohsh5H+f1Nyq!E(#1*Q;yHB=r*>f-$7+~DGQ(V{1dZJc}2}s3ICygc+ti9 zQ8X0&!;4S&P>5_@UXkhH#WKLiyzq(;uHZS;75W+80w&lP{7)~n6yl|CeN~Aoyc`3V z<%j}tgyq%(%NUCoGZAB~N~xSOVJXK%9OLd+d&)#XIk6v#JA#8$!7b%fj-;`ar%cz~ z#;G-3Mz9`09Osh@p1fo7)eh>EXR{Xqq;%lkn!xZ1+ z`sB->1u!GJLQZa*!&Sc1`^=Z|^16_cm|sLs%W#C^rQ3wQw4gs~6S4==&N$Fen~Ybq zwYkgXkJ#m>gLny@KO7CpFWWPK>9Q*ozq;J~%%3Y5AFpI;RfE$!CuY@W67I9>Qw12+ zXR@L#6U8GZqNdWu)U}1$NM4UG_-ap`C>%L#bfGu~dGMhE;=$E*$6M*sCb5U$QyA{W z{zMFWl?X?NHYWJ75-uMf!~SNWuFz}2aSSJ3qw}USulX*FRkZGj3(w#;fv4 zPDEyC54R-+@jssVBoP~B5QQ%qbOP?P`2}+DTMvE(BuUOsWkL{evA%8~4F}~hunwb+0^?Z?`n}yT{Xcnpe zvEYa3AoLv!x5tsVFBdkvjT7(gs!w!wcS-mJz{h03ZQ*!pwB3deFz-MzMVzbX!UkPIxt3S!>py@?^R@_DOcC#>%A@6=IReQ{ zv{JVPqD|2*RkV~Zt*-Gz!y*NgaRp4vVx zRmWK5LXToLIXH|PmD69SETY*@m@H+B zx}1GuWKsSB$H!7_yT9;Q#BaZ$u@sL1N5)e0eFw&py37uXMRE)zBo@&PC>)lOqrYfa z#Bbk7SW?FR<6ud;>?l~obN>;rWWFPfC|Mlw4)Jk8=6Tc{HC|?iOCs5Fg-Rm$ ze!?WNT>FWUq;*4Kh%y2s5#Iv{j>LQh6d5V4(;R`34BcjhMUrsnHxnKTIztGx!V#Jf z9HI_7r!^kUV{Rl{RMA5Ai4Oo{>;r|?_-fBtMjP}Kgn)5=K7RM*ZcXNJSh6 zZ=plwIiMgzN`D8ECxqCx4j-Z&yAVduhfoHJ2UcqX4sL|Vhls+pFAuT0w?8H_v>%1w zK(G=Y+6dD~ZljyfM*U>k7RiMeOkFw^prQ_@w=aC?T1CEx65ds4?Hoa&b)GUOdPECr`STp|wp z>I=$HG*b6jA@*3-?D%@bKWA(`C0C!J^%Q=nl*8>oP)rJfL;A+f2Dj~9Qs3s-F05`7 z0NVa)&&X1}4oe4zL9o!w*kr1_zCx2xJ^BnwrttV9JfsI*>Bh~ zMKhqNWs0`{pk=Z>2N1H1>#*N=Wva~mg)1Xn>iCl!6l|YR)KZ>)VwSNi0|{70<@Fb= zjA-^Bs7%VV-7G|0E6Y`(&`;GUn%E%q=U&=VZVE)U69f5m@50sa+jKk@y!u9MCB)h7yYaDR0cg3@olhXAND`#l3d(e--- zfTBCLPx-JX>6iOV$Ms1=PPN`=wL5q}>UcAqIurqsu{T*sR zy!t=TK+3oO;|wItzz#Ezv;#ZJK+?`O>v`79S|^9L<^>3y4KaGQnn(Ox&Lh&3135=b z->W&I-mjp!wcb;ouI7uGQS)W_IP?IK^mR;k4pZ)NtfON zh`OJL`}!!pbB(p8!{f@f6-B@y1|_~o!rrc=$9}63TbKGs0pE8EU}=o@^GiloD0|+7b^zQI ze6nd~#yzxto?%l)sATQ@mF^8Vg-~W#cKl?jV_`;2JZFE9 z>^(D*>2!3rY!KUpJ1wIT|I;{_Lit@IG}ALcq{K5S>TqhGAZub&&zbvw5P$@h2KAWx;cKKFffXFgDf3cpgtM zTHtd`X_8Ir=n>hEh=9YQa_7-^knMV7F9D&X9SGImtmVSJn*xk$9pD~utz|pW^-R@1 zxc15GVh&P0o8g1#+Sbh1C3Ma4=OwRnOl*0d84+8;$|w)!YI=WZ2;EZvUM0^^x<~w1 zCk|xNHa(1B+VWJJ4ks9n8*oy*Zv`tSm~$G-R>662qi`eT{d9eQh`gVv??-W7S;x^5 zH(TQlWn5aG!z7-c?~>le&^S(n}s#19}TJeMKLncfzF@sVCcCGJi77xO4j zGtK;%z5u=x5Il^e19|X%Ci2ku1DF$M+tlm6&Sfb`qt#DmFmZl{Q|xF0LVq|nW%Nwt zTehJ8>M+MmGu0LPZGq~yJWj*7>m4CF*8nH#AiOK)1uO%Nxn|sq>6o|p9A^e`0GTQq z&(bn!oURa#M)p~88V~Wn^Z86XRD~$Nd}4*Oo{UZE5$`o+(&0ok94iyzT@J4Y1|;iR zw3>G0vuF`t9LLx=YJ>98g_b=>JbbBd(_E;r)DwI~L9*cZ3RxLGkpT||L$+FN!@Zo>=|ZIa1`lkD4lBaBUM?37!dXO4 z&q_hWW!)`8HU^c}=xhkdJidiiB}YLP-qDc8m1f~;!Pka_;kHL?l zpX@h+c+<@Np?QulNbgsy?p5PAydiJ zsk!{}V{|?VM-HCb=>4Cqa{i!*K;rD*1}C z@O)l}!WAnV1{#bl@>#_o0|p<8Riz$(OEe#=8@)rmprCbJs&HswbSg&xA?Fup++c;n zS#0v42<40VKBG;x!;tKJILQMBj}0I2mJnqF>>-V^D{17JX zPA*qu9tVRFkM=BZl$I~Rc=Y9r{6V;WI#x#ORIY6d{%Yfm*>j(h>zp)RI#F%k8NAU` z9Bw}9%dm+Iym5LE+2Wu~xfBRNICl8?NHxZlX5%m_60gDg!udck)~I148L~)} zl5;9DWj?(p#W-p?ZWxKvdr^!ttWe_g9+b?7#~98<4wrgXp!b|K4ks34W+(IM zeI~|v{M-(DPf60#a0mG?0VRFwy(Gq|dTXDo>#p~cn8tjbnX(VPmz2iSJdf4KW$1k* zSw6I8*p*4AP7Fl~uJ?+VKG*4Ficaqr$#QAQf_+Cii;H({r9Sk25z{QfDS+@yI4qi< z>EK0owx!?5F)uBQ9M;qKup*x^mSfF9FNf&QU6kH4&WBU-74VsHkVpBQLcTX1OYpox zKi}IfWdQT^V+nP`HoVm+-+UUH-pZDBwPc)>#!BG+S&#w8ILYU$$vl0WuEzO_GV<92 zdTmpj0rxs}yA8^KdjdGEm-m$Q+~T*gju}V!@C?HYL2YY|y5b<95Y8K&CZB!bnWenP z`yOPwcm{}j%qopOs_-~0g`W9n-M%Qx1v0H$b;G*7-Y8EWPDIa{^gPvo(NiM2QDqx& zG!uhaXL$ET9dN`h6w3B8eNh@t$DcTD&HyF{n1mUA!pKK&TCi>C_gQvG`89#GPJM?O z{MwK|Ko!KC3TFT*8^k=5Vd|_jWe*b8=&=X!fLqBeVLZF8!?9yZF3c}EzhSkCFXosG zw|RJjnd^wTCBtyKqE-8j5(Nvo=?w#EbEOJK6{U7U01xhmFUxuwr$(vSr#wRn^&G3$ zBUz_bsnhGY9@s0$IME7+{HgZJgkx3UayII^XX5NWYaP9VNH&J|!87>b6i@Y@mCTEG z!ZYwVP|cXj(w+f2NZgpW!R4&Ay%Ua(^+AxJBx6|S`y*JN;3j>KxG!FwtG#sorxm-icS^~ zC4RMM9wL`_RmUQoJ)01;fWC;WjwGV3sh%iarNR>iKr9H&pY^MbL|eMss{8~-$)I`9 zCgZ@Q39I>gFL{skGib(=VsN$jfg|Up>FA3F`W50EvI0@v6$z)p5<-|lOBMcyWeVS~ zj>nk``iC(5{9_tXy&|29zI-UO&{x0ot9WGE2YkW*ovbdIhOdJLl1i^~xo6H$5Rw@^ zAHO#I)xdd52???ifArO{ES(_NI2yw zr(jlnU|Uv&Vzd>6kM=?w6jc>rO(qdXnF`5bpMl6=ZN^AZYzPLOirS+Twk{BE!I1-* NqUOS9u*^a5{{Uun-=hEk literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/bzip2/win64/makefile.mak b/3rdParty/JCL/source/windows/obj/bzip2/win64/makefile.mak new file mode 100644 index 00000000..282a774b --- /dev/null +++ b/3rdParty/JCL/source/windows/obj/bzip2/win64/makefile.mak @@ -0,0 +1,59 @@ +# +# makefile to make bzip2 .obj files using Microsoft C++ compiler (cl.exe) +# +# if bzip2 source directory is different from ..\..\..\..\..\..\thirdparty\bzip2\bzip2-1.0.6, use +# "make -Dbzip2src=" to tell make where to find the +# source files +# +# Make.exe needs to reside in the same directory as bcc32.exe. +# For example, if you have Borlands free C++ v. 5.5 compiler (available from +# http://www.borland.com/products/downloads/download_cbuilder.html#) installed: +# +# >C:\Program Files\Borland\BCC55\Bin\make +# +# or, if you want to use C++ Builder 6: +# +# >C:\Program Files\Borland\CBuilder6\Bin\make +# +# or, if you want to use Borland Developer Studio 2006: +# +# >C:\Program files\Borland\BDS\4.0\bin\make +# + +!if !$d(bzip2src) +bzip2src = ..\..\..\..\..\..\thirdparty\bzip2\bzip2-1.0.6 +!endif + +# --------------------------------------------------------------------------- +OBJFILES = .\bzlib.obj .\randtable.obj .\crctable.obj .\compress.obj \ + .\decompress.obj .\huffman.obj .\blocksort.obj +# --------------------------------------------------------------------------- +USERDEFINES = BZ_EXPORT +SYSDEFINES = BZ_NO_STDIO +PATHC = .;$(bzip2src) +# --------------------------------------------------------------------------- +# MAKE SECTION +# --------------------------------------------------------------------------- +# This section of the project file is not used by the BCB IDE. It is for +# the benefit of building from the command-line using the MAKE utility. +# --------------------------------------------------------------------------- + +.autodepend +# --------------------------------------------------------------------------- + +# --------------------------------------------------------------------------- +!if $d(PATHC) +.PATH.C = $(PATHC) +!endif + +# --------------------------------------------------------------------------- +bzip2: $(OBJFILES) + +# --------------------------------------------------------------------------- +.c.obj: + cl -c -nologo -D_KERNEL32_ -GS- -Z7 -wd4068 -D$(SYSDEFINES) -D$(USERDEFINES) -Gs999999 -Fo$@ $< +# --------------------------------------------------------------------------- + + + + diff --git a/3rdParty/JCL/source/windows/obj/bzip2/win64/randtable.obj b/3rdParty/JCL/source/windows/obj/bzip2/win64/randtable.obj new file mode 100644 index 0000000000000000000000000000000000000000..636144495fc0ede2149fa6cfb1897e5db1a5b1b0 GIT binary patch literal 32891 zcmb__34D`9`v3HzIa=zXF--zQ(u1Tehl+R~tBcoq zpX<3OqUd_-itD-F%Bt&nyNbKIuHfpT?oa;T=b4!|Z%Ru``1ivw?>x^l&&)jY%rnRP z=9%a@`J(mCBF`hI3DHl;zw&4@7HR8sj{6mh@@TBFed&0=1|{YSQIaFX zsYgplE~5FOxUxJNZVPK7ii?D}MA2yQeBpgc@e63! zXXWg%?d|bsc_Q98wpU zkpzcSOM5aBTf8#f9Bo;dTHMlj(&EN7@z&`CnOU(o8E%fYg&PyGa$v-4F}DO#5U-13 zaBAtuG2_~JB-xT`S<+TI**B%s)7lnqim!<`FD2=_2dmsrGQ9)Zf+~jklCen_50~ah-i}WxRQDxG9Q8 zL=xq(RWT81ii$Fu6YT0$YfTpAZX>X`3MIr=wj`G$OGicd)bbfqXG}Y)v@B9u*4&b4 zS=v%s<_Ik`d~U-vV|u8xtlD2zT6Wx#rDZFl6;o%<0=DwFklPdT2OLh1Oc{&39$x^Y zsiXL>w5+OSA3C74tQO3iW3!Zq(`|PJ9md$MSXjjAcPvbqBI-D@eA?oD&A51J0)+K0Yg-miMq9(lw$)1gSP9Ffp%-Ral+Z3(qm6r~L5n*g)22=>r+hpX zei$yqI8j(~6;!xHR65-bf4~+9`a_jQwbLE+x;!?A!xpfKgB8(!RwBdgu#jjz`&&u8 zK2N}7_qgmXo8Rwrh=UZLp;jWpZTC2w?rKq{u*0m_I>YCzavF|WXRQ%v@EW!{o6}{h zbQxl@B0s=NE=zKw9WIy4W48sI9=BQSa4V(5P{mGEd`4KY)O6H|O0BWE9WKKshJx;L z8tlRuO~m}m+S_0zn#Ex%`$%hcyT=_c+)#eM*W-6mC2WC!&0ZrWDe8kVs9g|_-R5>u zz1;z)EntWVig1*b&>3_ubbIREX(5bOWTUNQ4yVts2dF>A7=<5W#rtgaTAX66A}F;I zpx+iXIE(D=x z5R$3&21L1PPPvuPYxw+5KlOV^HQj8Hmf%z?y&VbxC3FXT9+$~+S_Z{#YE&o0S-N3(-G%WX#N*PLlmSUoABY;< z#)C2Fa~&Fru-A~OBYQ~%IVJ%qSIBS~b#gAD3KK!DNkF0t@gzYEG(ImA?-K(%Bb|%VJW>qZ>`O3t2S7_Mk;Q7Ou9-NA12Vm6~sh%(k9I!hj88<47CSP825XXTg9Tp=VcgWIun!AW(kV&GOm9F>Uie|7$ zQxgbyLqX^^*|d-sE0cPU&k<6>;R%tL7MmITwkjh;vuVI1wS^Z=L{nnY1l{(K--gMH z+CXM~q0l7{F^Q^;01eF$bUQ?JJYX^2X#oU#N$N{n_cJpDY?YO;ew98?y`Pk4n4;L< zq+p{f4pH!-CR}$l%(1hYH8sJ3Amwqu5)8J1Q~G<6X10VZ*k z$7jdH>Tvi%=yxpeX~D=Am*|F@bcNn#OQ2f69bFC07DE&zgB6U-43XwB zsZEoTl_YRJfw7lCb{BU70SgFN<*l;$0}R*1eVDj`%5n)ZR770JjJ@@lH7in3RSOzp zmw*^MQ`nPgV84`ax(kF^zV>GzDM`n1XCRQJ`sQ3cnHHJunNBuxMlk zR!>UOz|j;*RA_UWs@lK|3)zu%BP80MMmpVfm_V^nFw81K25G!}tirk-N={OG7#wm$ zoz2JU6T>+pFZl2;KLpH__0z5!1349m>FoAx(zB2RW$b1lmIqMR;TnWa~+vltd zqI%TzgvgVK0G3KTe-kWU!tAu+!J3r~F}IhH1*!ln&N1!#j4G@*+;)Q(j1K}|Y^`CH z%T~?yA{6kb`Gxg>81=C-GV5QY%J$T9{b?i+abF46{bN?OUnV?6`yv(=W$NDvS>>}; zGgs2CM?sJ$Fg8h4lnu5>EmekzfhE@fE&nQyn;uHK+nZ9X?iVoJ?(~wCTo|efLbGY= zAvm-Va9U~m{g{c}*sHPaCLHt-IJZ%c6(3f8WKu$y3H%tZv;ZO!C?iO4PP03SE&-ZI zT*z8uwOob0LO@JY*`bKQ1$;p$h1@F2Js(>!%-mRuV;#)KleQpKB6Jg3j779FaaEx+ zt7*~hlSVRt$=nkR@RpH?F>XN|bn_g5?zC0n5QEJfVKIKGW-wD=Q;CHikFmpn$q|@j z$O2T_>@?eAMkdX1dwjJRM%1zgKs7`JlX0?u*g619OAXeETbKjkYDn81SP_s;5IC2! zFxcs>tH9h>Sn_*@*9Ah(>Ci-(E)qyrVoAZOM-+Vtg8sv-gG~Wx!(E)u?n!q}t!)9N zrt?UlOyemNwlSC?xe8p=IqbvJ4foQ0mQPUn`}hYzwKbW0UL$~Xmm@tC|Hc3S#`$2VG9-7xMR0jeu4gf#4qoDvAQdClkBrJ=|u(_fCMI}$kVrY2L z@_=DaN|*ziBZg7F^8j;sgY{$qN|1hB()b(vOfn20nha25nhmgikh2Jp()0{C=4X>z z8)^|tCYxJAZLlXrB{b)OL>?K^FygwN4yem(=Q0lf6`8mYtbxN7a*{EdI(6zaCZskd zQ}H!1u%nvLrY!`1ylwM%`OvNyaIypdOXI;g4@SxAbqav-UBoue7i&#~Be9gdC0P@tSuU20M;x&w@#a_xi;bd^gZqFhH-kh;HV?uu z+`(EF_Z^aJ71sQwfUc%`*rm9sn{Gpz*81vbg1M3qoy~1CrgPoKB87^pX^{!?sMtCW z%-|@nmn$ z--j&(DfzX4QZIR-$fg2teP&j0%U7U&^;jqRn4HujXsv!J38s?DpaO>gO+$tifW#2$ zQVukjXcVYHKuJB=P%0&^~h67IT~1!e+Fku2TTN>rk5Tj7j6xy21bR{4U!Sr zD2OP1-i}GEh!=c-VsGefiN@G=(9ob0XMpu_vuRT<1)N0cch-8brPoUh?gUz)BTsq> z4%1&$vR>t|lPw8)L)AVH{>OZ1H(crbq*}kxlzRQ5T8^2%sN^Dzw6ejnLt3t&Y0Jg{ zLTe(%Clb;SkYc3!CuC>EpuVlaT#I*rJl1IML`^|WFvr$m_ATNKDd`x` z+?XHKQ4WqX18hy`Jc)IXj`)-oQvZ^9Qr1a`|Dd4P@xn3(adFNI@3nsO-80)xsQGmJ z<}Ft)fCAbW{`gIgTs3>(#;+&LA1$gkzJHexr!&0r)d_}w$aA-^pZ@;O>mPXpFEgKF z_@>+b=ev9E1@GRrVSVv<@dEh#!tn58pDsN2Q`?MtH+-?n@yy2?gg6=n7w4?{&%9yJ z4Z3T6;qA^hovUjv#!FU)U%Ed2)Y$4NO`CrF?84)BJovc~&r15Hit46orY`&YjlV2f z`qq=rU}=?0d>&q~|IQ1F0vEjVm-e$JepmT7)Sux$hu7SnT=hz%OZ9H$G?}}{OPgS8sf7rw}_BUUB2KuNRH={qsH}x_{rqA&}4X0^&b@^&hq$KIZAF;Y-$h z`Qe3!#PKGV;s3X7>q!sx`Fd-|mB$}Hc=RWb|AP$Q9B@a+2NxyK)U)5eECf3rXIWEyNsan5N2ubS=LaQW2@pAEd?nUWWwBrOczeCyCZ zZ8rw5`+m*N=|jGI9{O+(!|%NF>T7aN8T`O&=g&NR*1GDeg!qQxySC;nU2)F|_ZPf3 z>%2p6dKvXOtdRIGdwAqu1HT(L|G}|dpX;j|!a^h%{_~pRWABR}8^3m9<7LhhzXSaS zhL3#5-T#pBZ~rpV^Ze&+^WHmGh<`Ht-`@{z_~fMd&htiXOxRC6ZI}>;U~ClUEWi7< zHIJNeKuk?)>K66OHwa1?LJo@E!hUX5x_`QLzji3L) z;YW^}_mckxA--Vv%ejkw8J(95w0xYiYr|=6FA7oKm-rud*qBZEKNan253P73ch^C0 z2+_>&Ykzq8oT)b~`QW+Yw?BEhz2OSThv9=aO#Ah1C!SvR#MGCcKI^*Qpx?h@cw>0u z3j;rSATRu5^7%8rxe?=NBEEVk&JpiF|KIyxjvsRJ>Nj7w0P%ls%7Wv^UGdWX zmz+N7l2^a5!I-2N{>iCly}WwV`7aUa7Uc(~6E+m0wW=-_X5h>L%E z;a5WZ#PF+!{&me-*X2MpEtf;`|Br` z9CG;EcRe!ds9Wp)0sF)7&5xCQxb@o~@3`PM+o#TZ=~~dA#qguPd-jW4UKls0{qg=& z|21drW+DE>@bLwod^Bml>Ej*=4E%6h!yM?&FAV?Nb&9WyUz{=c?+VSmu~u+KBbl%BcslqGZC z+S&g7E2rQ?m=z2^=E4(hww-Xn&n2n++QY7Ie^Q7?7`~yt@!&h>tsUgP=(WQ9cfS7` z@`0?2bAGk{U3=Nq>A!sZ{@Gt|nE4^ftY-N4!?s?3*{Ab!KYDFsMP$>v-wJUK!ykEa z*IA=ip7rD9O;=oX(1xwQ$2ekm;1k#QNk>1t^~WRj-`srs8PK<3m@$iU8tm(QM_t}H z^4y>LU-H|{=fKX_F?`sFGjEQa-}kPImhc^s&Em?cn)oY(Ax%%-Zwq1Ma z7Yl@Vjp1J}-*Up@@Pv(5jXhv=)6aLmhO;-UnTm5B8&}_VTi}SpY6o5QTSvz$UtmSU z@D+6G0;y#k6}KyBuE>oyYL=-tIf(p>M9e_^?+#fBL0MR#gh|48!LZTz~S; zmCecfz8^E{me#*+f_(NT{!JbIa^Jn+flJErK74%0!Y|)K|1$jB)b>ZWwEpnRQ`i3c zhcTn3z}@YN$)kGD);L*K3x-D+JD!g+5dj@vBp*J3(?N-f_v}x zUTUBA%@wyj^LlgRr1`M_3}5?~L+(8NgN^k=zY;%Bh~JBOuP>iaB#GY)x^_Qt!_5pTFX+ulglQe!lPhgJI9lWcXJ%-Sg9yyYKZMbp5vjA0PGf z2&^9%e(H6$Ie%!qzVM-qGrn|v_T~4Oe;K}JhyU_4hst{qBeZp8fvEIWybOz<;$|mk1wSn$2Rh_uS}DtCS{;$ax))MyQS83D;M1!^aOR~+~-n_hdWplQPshh0Y)GiBD(1+}8Jr6p?(YHCWY zPPN6Fvh9P`WNKN~1qh~HA|L)TjC(Y`Os-gt93 zn*GvGS>svRiZhywcf^w1m~2_3q8*|C4{TanT4@2EZ7r6^lFhNiJ~gBp zQqQ*X@upZP(uCI(Sr2n8hWA04VW+6^*;XGd#|A>??v+(;T!SB1g<7F|;kJD#wK>(* zGG?#sQ53c5qV0RhCz5RIW=`KrM*FrjY>g$m+Jf(89U@T1aC11ZIu%bXmOoDmH#fJm z@#h6fOMBndT?lt?)|%6@%^z>ddWnM}5y^gk5uuezwzWpl&9SzXS)0O@&DrlNn;U0L z&9>g{$wX83B15Y&6J=XAmW54OFNaZX62FMcwruLJMAnuYx#>rr*%ppt!>se-G&UMt z-nG>C(q1I+Q`5GrD*_pGy&KxgTEtdGvOfWCO0CLXh0ucbRQBqN>3e#%8h~}In!NGu z4)1F4S`{Cwl&PnFVmaOkypDk1V~bC6gt!Ioy{96SA>ehHmOV@#lc;0PGJ)zm50(qzD0;2&zqoG zkLNo<^D*KXNH+ui2A&T^jMq&fhWHlXBM6UBjPx|bCm`O0_-D`_i0~=G>7btkxCd~m zR|~=wfPI572jOJU+znV0XjUL5{%0bNBgU%?5yEp3!mYr+gZO>W{{ivu5#Iy+xp<~_ ztwEsn4ng`+#6i$Mgy$ate*$Ux7UCkn4o3V(ge&oU62g1HB@zDzu@CSl0(}Q@FkpD) zBYuZ41JCaw)B>J^@NdwLLHcIk79;&6o`)j-0O^Z?I|G4avIww2h}R+=!1E1=?*dIe zo>$^|1LDsSuLsTkh#P^M0@y8x8|Q z_aIQY9|Qguz#WKlk%!ugSCOI}u!#sWk)Dk3Dqs&IY{K(_23AwVFc3Mn}BNteF>h=#xv>qID`{`|25!voyanZAg%!XLWD5r=r{b=05$}4 z4y37VRDKfA9SC0_T!b(Z_@5AyK9a5<3z{2|m*|EfJ{9R}LDLuM4M-n`=OYli0k6k1 zUQdd32tOf^p7sImWrY2J+lKfwjbfk66q zJp#4;9E1n)yd3l&Bi|H+ZAjk<_^Wun7lHKXYrrZ1qkjJi;S7Wak*4uT?OFty33z@V z;WOZNA-x`PInr)C(-@)gaXQlUEzVVV{tM#s5w8G_%6bWOry~A4()Z!nz%%LU06gD- zXS|*kOAyGu5G~ma(#0JJ6M^4}_+NluhHxXo1qhn}dmLdi@HZg77@-m2Q-t$?r#v*y zNcX7E-b8Ezd_JDz2-H_UAiWmwJMc{JHy=it`m+VFr;(nE=XD5VH>sYp03*Gna{q*I zC7xeIo-GKYfd3QH2Ous7?mooCcM5Q1tLhPE0rn#0L%0rbvPE@>Pe4rll|Yz-=LBFY z5pPAB?9`cfo(h-~f%GR#aK!%xd^_UV2=9P*2VxqVHz8aI8XBKu-)M|)1?*$ujrc>P zDgQJC(!X4S7p2ixD|8D>zyF3Sh?C~(frGQ_Hn8xZF zJii0@Ts(V0I|At=5Fd*090KuQ2i!b_aYz>cKLGKoh$kStfk1sj^8PL0GkC6G%_Q^N9##_oxn|5vU$-Aw3*n3&PPz-wT=%cs>j9dx%M|P6E6c zG4UmM8=j9u{3hbf2xLcSemfh_RL+&4!{<6;0OA6KlK~?f=|vQ9(yu20zYWhj0lx~* z_u_dA0_gya=e~fyg!FWT>j0zvr*b|7j`BZ?^e>=^A<($@0e&0;_0^q-*McS=H2p+Q zF_I!j?AYE<kjNQ=Vnq?s z;}GLR=3+U<;U^j^Q^Tl^k#s?_Ahjh!AKT2js^n{$;HzQQOW4g_k@g1#@ zHL-pZo36uwikI#a`p%mI^$F<%No^Eps82>K+RCoW&tMlH=ttJ<3*^ivA4o#2xh?!`%I9Pdq<+o+ETK1IUiK^F9HCfW+Q z<{rXu;zi?cZhLbxejOAo!>7Z?h+sxiwr#X3pX!NUh$q5JQ-b&(%6wAr(a?vMXMGMs zx--8(7yK>&zg((GmmlhfYMj+Ig7AC(vDl97M3dV!50|H2Fdjd#>goq)>bIF<`!S+$ zC~QzJ*^_eAKV#sSza6Nr=n@X`e3K!YI_d*-i3bP&?T!j3Nkn%i5e zlP&G75YFR((cl@>tze^F@ z$qw~{yrzO)|J7tl&GLJI%n_4DKyb?lRw2lD~7gKZAVp}#r6(HNa;^3S0qwHS_c+BW5gV-(#yMW^i; z(NVk7w7J5jXe$-%5R^+JfM}`R)ZR3Go^T*dbubW9yR5uB+mvcWThj$C$tBGKo(uEUJmyWqIsdUpQ+|pmzYj6h-=C(-m`j5SuG>|I zGzH>8W07osJ<`Nuk)qY}ae=DCaV9*sSU+oii-DtH<##;N#P0+%pKN<(xjEuQMHe>d za*K6+wY+`>T$*=|h^jm>l}Fcu)(EtQAX+KgT(MNqE>pBrr?foN&zc9dL-SaUXOc}q z@n}*!G%b}uWm?N?QM9d{Xo;7Wk>;CJv?)ca^_2LIL&=)A?4vxB+?n(d@y!jnYM3 z&hEZ#D1Wd0+Ni$WlUp0&w?~&Yibt+&9ok4)c6Mh&_2`W&8=~u#8yi)Rp1jx) zzui69$U64yzedt^_Fh9g_w2bw<~zvrZo{6c;J+dW|6x0}SHcdAQg+}hWe2+Y;iI$% zU0}#AnEMd&Sfl;b$Z{?Ia#-KkD^A*3P8z0s)KGgmdC6g#3>P^{-km+v@SWHbW#1bf486ZLK(Y3p*MDHKhErf9)3Sfj#uDNgdKn)pX{Ta z@{lJH_Fq+Js62b+1VqViZ}NoTlhW|POQ{R)zkK)=vf_c=O|PAgz+)M_e?tn80T1gVk*GSfmQNZ~t7TR*(R^UL=#hjdFrMzz{!a~S;o=1?o0a%K)EHdT5ZcvuF0hBs7W zAghn_mRWIr>2?*HKlXKQx(`=%?ya|R(uc#l=j#u_n+{f+4qd4a>8($4Dz_K@ z$XP#naz;+PdUixE>$hh&$OU?2hCl#YZtjZ!;41N%N%xq zmP*B%8WXEkz4HlXPlQt`NmI({7C5s?wny4pl6oA8V$eBaiP%#7phD#>CR(Gpy-B4- zE~Pu@?KPJta*(cy#}ZMMo{w~O48K^5N7C*rW#5W?;NU?Hzb(MKQAv;Ym8LID8Z)_^ zZi%)hVl2;2elfYsbwq=EWbh*ey!uqUO9Au6+S-%Nb>T#NOt-0sX#Lz!*+1*VIzR%; z;`BbeaA=9r@0-vMfLmP0)mLPsA@!3?oibgU>d8RK-h`9OQ-*c+cS>!{%kY6Zlk1gl zfjQg)-vAU2El_p)9qD_fAHwMvew{(A7w&W&P49iCgL!3#O&67P=>Xp=pvPX?;~(Jm zAY@DDRM-`>4Y-x+ktU%kq*Exp*({rU3x?qCFA&7wQLn(r3i`qhBT?FL;hq}}8Y zSjzxu_@R~kM9&qffAH*+&jsvMb{50?(6haPp9|@k{YXn*X&<&So$0|=!unAjtljkc zrv8*BhncEA11JsejZR#wqIG&8!L;V7J{?3bxD9ube_jPECYW;?*R6!}Afa$WWO}+z z?Jq5Z_UhCeQb{C<8ul&G~;c!ChW*70S9cMyA;TCgrm_0jBf>!sEEf zTK+`lt%0)M^9e@2SIMig>JJ;i;K037r7J0ok_}re%h@i|9(b)bblV(h8hBb(KKNC; z4NafMa2u)!PUUo>uO_&?ip#3uXS#exw%bW*<&YEXRIOxNb`2(e0LjX88KRi!?Exqs z$wibRZIQp2Pk9<>CCK!-u$_S5aFQ<8aBv=)e*kmhj*4nM*10SNskQm(E)~wtaPs_0 zK*$gG9}KNfw&hNYU+tu{zCt}=+~%rr%kwmpyV?kme{$T60Z)xs7f`)<&b8uZOvgIL zXB->EMMA1Bc!0Iv|49PNapd?*;GApJK>F*G_I%59a78~wPAtaKu$Y=S|#bVr3nzw}GS}F1xE-~BP z7$?KkIN5-4vPb{F^%Z+U^BSR#et)rUmzuv}4f!>&th>v=`?AQ(`;Y0B|E?&EB zlI>HjsCjiHpV7K&ls@FBdxvn&$Gs($&M@a$h-;R+NE6Ak7Td3Mpqgu#Ylm#OF9Le0nK#^{hAENB@QDI9tjgUSfN zVe~?c>#K0MQ%O2@SGK78yOv}>^zWPxp7){fcwr{>ae%c<<}An1z;r&|%cjichqUjtx*3-{Uke2Nc~7o>mqq&#yq=KPGuSHq z9v7|=!J^&CT`_cjQl~Ee!2!i%T(@d%>3#_9JA*!C-*sN zyfmU(zcYAaq!@0#vd7ek47_;@2-T}kX1!`)e7U}bnQ*-E=c|zzSJWAYS&?}4-5t&s z1F=L+9m%MRM5%iA&&-dj3DfN#kcsoty<^&@Q`rME@obo!?kbO#@1QR5e367IyAxjZ zAB{|@gM%~klbocNe3icwo*kO2?w2+*Ge4a!v&>2|;j&#yR$W~QLT&8?mt}EP>3jFW zp$8}(zn^qGbFVvX_r2~kw#h@3p6mNASbgQ$q+iQWzpG-LyiXC_aiy-RuYO;}cxa)| zhW=A~R{gGuaW33w6r@GH)L;FMigDC)+%XcT-%T;j)Iy2V@1$ft9Ah{a87_5Jpx;4h z9Bv-P%1-9f@0}Ru@pC`ucTAF=raROR3s91`ez(Lp)oyK*b=&p(C8n|7OQiHezgtS< zX`RR7<1+MnC0RbCX6ltZ7G$^+Q;~w}cSj8G>Xsozr{5pRa%szg_mFgV4!^~f^3d;( zm}U`f^MYlZ9yV9;eM?30_y|^Sy^;9l$(&ETIyt!w;I}TW>YeueN1db24r`Vj=MO%*}vfp5%Ly zWS(wrN#cC@8TlLmy|*dIfP0;~-}+?0JptUh$?ur;+JbxsV_M3%h=W%cRtQ>KX|@&D zc!Y3o;52#mg)>W;#`hnjyEp?x8mmfkj4C|tJ)komE!)Rrxj?36s}d~ROU?51)gpAx zq}Qn?j82Itp~^Pl=q3iU%#qr0k^8Rgz@US3fBaw zdSQLZ`Aw}=e6hx4xZT4qoVkryTQUr{q}jCXC{(bZo4z=ZI#;A%)KKcDzG@u)QMS{( z^F^&b2%ACx^0Tvfp-NNH_+fxF4bR|aO?_P&RX5}Oq|1KtDU#}cf1OE|CE=p(40Rj;w SFK6;>dba)zLLz-(-2VgC4+WM0 literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/dirinfo.txt b/3rdParty/JCL/source/windows/obj/pcre/win32/dirinfo.txt new file mode 100644 index 00000000..be82d14f --- /dev/null +++ b/3rdParty/JCL/source/windows/obj/pcre/win32/dirinfo.txt @@ -0,0 +1 @@ +This is the directory where object files of PCRE (http://www.pcre.org/) for win32 reside. \ No newline at end of file diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/makefile.mak b/3rdParty/JCL/source/windows/obj/pcre/win32/makefile.mak new file mode 100644 index 00000000..8d1070b8 --- /dev/null +++ b/3rdParty/JCL/source/windows/obj/pcre/win32/makefile.mak @@ -0,0 +1,141 @@ +# +# makefile to make pcre .obj files using Borland's C++ compiler bcc32 +# derived from a makefile generated by BCB6' bpr2mak +# +# if pcre source directory is different from ..\..\..\..\..\..\thirdparty\pcre\pcre-8.31, use +# "make -Dpcresrc=" to tell make where to find the +# source files +# +# Make.exe needs to reside in the same directory as bcc32.exe. +# For example, if you have Borlands free C++ v. 5.5 compiler (available from +# http://www.borland.com/products/downloads/download_cbuilder.html#) installed: +# +# >C:\Program Files\Borland\BCC55\Bin\make +# +# or, if you want to use C++ Builder 6: +# +# >C:\Program Files\Borland\CBuilder6\Bin\make +# +# or, if you want to use Borland Developer Studio 2006: +# +# >C:\Program files\Borland\BDS\4.0\bin\make +# +# To choose the target CPU, pass "-DCPU=n" as option to make, with n being a +# number between 3 and 6, with the following meanings: +# +# n Target CPU (or compatible) +# -------------------------------- +# 3 80386 +# 4 80486 +# 5 Pentium (default) +# 6 Pentium Pro +# +# Robert Rossmair, 2004-10-16 +# + +CallingConvention = -pr + +!if !$d(BCB) +BCB = $(MAKEDIR)\.. +!endif + +BCC = $(BCB) + +!if !$d(pcresrc) +pcresrc = ..\..\..\..\..\..\thirdparty\pcre\pcre-8.31 +!endif + +!if !$d(CPU) +CPU = 5 # Pentium +!endif + +# --------------------------------------------------------------------------- +# IDE SECTION +# --------------------------------------------------------------------------- +# The following section of the project makefile is managed by the BCB IDE. +# It is recommended to use the IDE to change any of the values in this +# section. +# --------------------------------------------------------------------------- + +VERSION = BCB.06.00 +# --------------------------------------------------------------------------- +OBJ32FILES = .\pcre_compile.obj .\pcre_config.obj .\pcre_dfa_exec.obj \ + .\pcre_exec.obj .\pcre_fullinfo.obj .\pcre_get.obj \ + .\pcre_jit_compile.obj .\pcre_maketables.obj \ + .\pcre_newline.obj .\pcre_ord2utf8.obj .\pcre_refcount.obj .\pcre_study.obj \ + .\pcre_tables.obj .\pcre_ucd.obj \ + .\pcre_valid_utf8.obj .\pcre_version.obj .\pcre_xclass.obj \ + .\pcre_chartables.obj + +OBJ64FILES = .\pcre16_compile.obj .\pcre16_config.obj .\pcre16_dfa_exec.obj \ + .\pcre16_exec.obj .\pcre16_fullinfo.obj .\pcre16_get.obj \ + .\pcre16_jit_compile.obj .\pcre16_maketables.obj \ + .\pcre16_newline.obj .\pcre16_ord2utf16.obj .\pcre16_refcount.obj \ + .\pcre16_study.obj .\pcre16_tables.obj .\pcre16_ucd.obj \ + .\pcre16_valid_utf16.obj .\pcre16_version.obj .\pcre16_xclass.obj \ + .\pcre16_chartables.obj .\pcre16_string_utils.obj + +OBJFILES = $(OBJ32FILES) $(OBJ64FILES) + +# --------------------------------------------------------------------------- +DEBUGLIBPATH = $(BCB)\lib\debug +RELEASELIBPATH = $(BCB)\lib\release +USERDEFINES = SUPPORT_UTF;SUPPORT_UCP;SUPPORT_JIT;SUPPORT_PCRE8;SUPPORT_PCRE16 +SYSDEFINES = NO_STRICT;_NO_VCL;_RTLDLL +INCLUDEPATH = $(pcresrc);$(BCC)\include;$(BCB)\include\vcl +LIBPATH = $(BCB)\lib\obj;$(BCB)\lib +# LIBPATH = $(pcresrc) +WARNINGS= -wpar -w-aus +PATHC = .;$(pcresrc) +# PATHOBJ = .;$(LIBPATH) +ALLLIB = import32.lib cw32i.lib +INCLUDES = $(pcresrc)\pcre.h $(pcresrc)\config.h +TABLES = $(pcresrc)\pcre_chartables.c +# --------------------------------------------------------------------------- +CFLAG1 = -O2 -Ve -X- -a8 -$(CPU) -b -d -k- -vi -tWM- -DHAVE_CONFIG_H + +LFLAGS = -D"" -ap -Tpe -x -Gn +# --------------------------------------------------------------------------- +# MAKE SECTION +# --------------------------------------------------------------------------- +# This section of the project file is not used by the BCB IDE. It is for +# the benefit of building from the command-line using the MAKE utility. +# --------------------------------------------------------------------------- + +.autodepend +# --------------------------------------------------------------------------- + +!if !$d(BCC32) +BCC32 = bcc32 +!endif + +!if !$d(LINKER) +LINKER = ilink32 +!endif + +# --------------------------------------------------------------------------- +!if $d(PATHC) +.PATH.C = $(PATHC) +!endif + +# --------------------------------------------------------------------------- +pcre: $(INCLUDES) $(TABLES) $(OBJFILES) + +# --------------------------------------------------------------------------- +.c.obj: + $(BCC)\BIN\$(BCC32) -c $(CFLAG1) $(CallingConvention) $(WARNINGS) -I$(INCLUDEPATH) -D$(USERDEFINES);$(SYSDEFINES) -n$(@D) {$< } + +$(pcresrc)\pcre.h: $(pcresrc)\pcre.h.generic + copy /Y $? $@ + +$(pcresrc)\config.h: $(pcresrc)\config.h.generic + copy /Y $? $@ + +$(pcresrc)\pcre_chartables.c: $(pcresrc)\pcre_chartables.c.dist + copy /Y $? $@ + +# --------------------------------------------------------------------------- + + + + diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_chartables.obj b/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_chartables.obj new file mode 100644 index 0000000000000000000000000000000000000000..6c71ff0399919f89258bba57cfe361fbb0105b9d GIT binary patch literal 3398 zcmZp0WU$xMi$Oyr8JR^X1&Ku^l`#d$MX6vy*Fw+O5X>?(i%-q~N+u@dq!#NXGjxbD zFfa%@=clB)rzRFDIBRPwnCY1rFm!k@Fub7H`0iF2M}`hd28Nf>8>Jl$(Oe4T;&yCl za)Dk3Lx&Ym@8`H@4o0Nt1^FAKIS8ov0h^?wm$Ow&Kv8~rQDUxwTPD!sF|N5uiABkY zDXB&IF+q+l3c)3%DVg~(h6Z{DF`0SEIi)G7G3A+gDf#8aG08`X?S(U8EM}C4$4y251VX7BeBml;nJ1_5&Aau0ZV$)92XRlA;|{38K~Y z?m%-uRWjwR24+{(>E|QGBz&lpTB(l_Wj4tU%&tS{r8{d{&#e8 zc5!uc_we-c_VM-e4+snj4hanlkBE#K9R9ZhCIL`#zzhB}*8$~07(4h6OvL!XzyJT) z@vC59z^&##Gf=J_mpo7$2I{fd0h0vMSmlAK;14hiegJU=x_*#eB(Vl0Hkb()U}R(f zA`Ac$0;y>L0uW0E4uFCn0VyyL!UBLA8U*mmgUz6fSm46I#K1zC89?3Lpt1x2TvuAM literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_compile.obj b/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_compile.obj new file mode 100644 index 0000000000000000000000000000000000000000..62f4d6cb4ae4548d3a93d66b2e6128f99b0f2ff8 GIT binary patch literal 42891 zcmdqKePC3@)jxjsCCTOm?g9ZpQC5ix1~eF7kboqFTarTm9&8pEnIS!Kmn7*+ z{^zQU376oA*KbDCpI?6SO6iG7$ou8}$J1~9SMpMgDf2>PJ{mnDV@~FzrP;o+6~4R@ z*9=s;VyV02!8~7nUO}O+Z0W*`>8>2bUrsf1jR(K3{3sca11|S^moJ8mLlGT=d{~40L&^mqf&OOH%4d-#JN@f`URX zA^M&6r6S%vze6cfTvSq|R1lsy29M7D_j$DB!F*+H`FGt+%S-*m#ouw$FGnMN*R@{` zelptrJM8xnie{pnXzWV+SI3{_7%mEZrFoo&lL3WBvD^L?DEVdReq5kUGmx0{uVkk| zuc7l zq)jo>uOF|qSS9ZJgVP=*e3BI7kffhQOVK^H9;;OMtYzSGLK&(_NnSAq9Vx+l_xcJ8 zrNPV1SHGexFU>0{tU!uBVbY+!Z_6u+9xarvhy;N}^8CfhawYFUjQ`S*NW?wa%Zm$3 zS12nhq{K*|KfhqPuQ0#NSI{>pg;pqeD+(v{$sY;4wO{`7wE zrkmJesLC%XU+&Leo0h-J{;+XMA8>kEH5owQ(RP9C^@K*lCsrCaTSG% z(7nk^prNNOjtMiJB3YJr<-Y}pE(g00KdU~WJS$Zqrg=)0? zL0?|}Lxsws!H6D)XgS?zKSQ;weiRW`Ai{Y`#I2hU^8~VNu}YU_LIkoP;%k`@YPVY? zX~&yj!9e4N;Tz+o)$a9oZj8fk^!7WQlC*PHps^~%ns?@~!@2jeirZ}MHQkcSCT)m% zlO8Pdwkh8Irer`naWK1%JnYlAJdai`j74cqY3H~fs;;7~g&Q5{rN+UaFZo?xHaIZmNGJZ&Vp zZ_a-JQBpf9Ww?`NPa(E?Xa(ZSI|FZM^BFvQFusF+6Nm3@;c3r7%4hNT44FU6l zg}s48ibHMy6Ic2V8}EbVhGwv(68HNyg7tmC;w%r^gsrKKazn0F?Hcco+d&K@0uQBr z7{0dV!hUJ%_&)<<#^+Mds~9{ckm>+vOUkHFQ#{dSR6hz$Gw{Ryk1 z)VF%V*8voJ%eEKH9Zb+{Z>deK?0qz^Rqdpn*?HH7gEbd`P}S;d(Ko3RP`xRt3v2@!Ld z`&{x)c39mx`uvCbD+pm8N8pfu4SP=wr|>F&=lIV?De8r|^)VcysyI=0DwTbfI{t-; z>*LUkQ$N&4QA(gO5LIpZ%qBMs1GnyMWqZ=qPOBW05G@)D-TO;4mLTSx8(Q^acq7(Q z%6og-L7rkyq`x%b-RxJ?rGa+n{kU*AB*6A~(FP zWt~!+Ni;bae4Q!E4F1epZ&yoBQ9s11?R_5hwcg0Pm=g1b=!bZqAHKhV^VBdeo8+xQ z$eIKcVpPrlRN%wPB=Ar(dcb9(PjKmY9q^MI;;3WXD0=z`(Sg?w0vn?9R>ktJN*$M- z)qjKs>T(0;x_>G_SZli4Wv$EueXT(5K58aI#QFaip2LA$18T(cBG8Uf_;&R|)rNS^ z$@AKzdVv%MBc1bKBYMg@|4>MS(DY7{ z>i*b>JOLlLlmY66t|~zL3UV)e1l1g>t8^+Y_02MaU`pfqazCp1U~et?YLmg&o0MZMy@n)_96i~DtwgcnnLvYA;>7X!J>AIkpmm~AcfaCkk~i*V^#M# zyY8nzHv+TK>!&Ko0MKIr(Lw%Us3ePH?!>e`{y6em^#_m|*{u5A5m zFwo*!B_ZOU0=jhECXL0%vSeu>vU@d^YK@*!@ipLjtK=}9w@5$Bd`ix3pv&FKwdEs+CX zqAIC95!P7hpTHw$qjB8+XcS=&f4W23e6`dzJ~yguMy|bWUaoEHqTB&(Uid3=?Js8K z4wSa^*erjKUyA7kAgPV^H$Vc|#qo!RzZOs&;hmT=ToEbfet$fn|G&gZ;a^39m-*MW zXXaS_6%-jRp_(uYF%NZk{R|(szzIwJ3n@XQqWckH)@gzN4ju>QQ71_tjL|cQFd|H@ zeHQ5r0KC_@6>E5(k&9D*nZH&qB%p35N!E9OCFcP&%xF2V3$K(~f0n{C3&5etY~4uI zBCTWfuwc&0g}Ll)mQ#QLlLq$Gz2WpX08t9x#pbTG?PZxGlbZlDt=TuqsAgJbv4055 zSvf};#6vQy-n7h8g|bHRtbx54RWeuF8r8;bi~C%7JRuQiR|Jd4)qKLIADz+>Og}^~ zK<85@N^;;{=xdSM{{mR(j}z*q(D09Cp2UUh9hT)>kc%#m9dw^VhY0-wVi2>%b%YMO zow6dF!tMJ*2rI z(}C;7py%8ImX)x89U%NsmmvDtM-aWhU&a`#x;w0#A*|tp=5WdlLZ1F&V;vStjMZjCm^B)IQBhGA`bU4fJUs1I z@ej$YmMJh~OoW>>NRkTC-CcOP@RT;+F11OEtXrMA^7Dzg&f}+YV@^nLlNVV|WWs$0 zcLFX9cN*?XxburFeDcvDW9BCP4DMrq`vUGaaO>da!@Ui+AMP+5SVrxrTHucnUCEld z7j5tsYXY-kP9ECZP3v$#_E916ANt8e|s7bd-T9C;&_evl|g2H_RnI!)(i@b^znlLmQu_c0vgs z=+Q<3L`K5*QEL4ZkU}L>8#mVQ)Tpz57-2I27i0+>l56+!By+nXGJFo`yD{N%DZYK$CfBRN22jQ>uW_R4-6N(2b~dpwyP2w3&`@NWn1J>gYEt<=36 z2dn~`$p@)c<{Q<+%V6sHg;xzl`yBYS`eMS@LIQ+Sy)2VNp&e!5H3`aq?JSjY?jq`_ ze~w=YPuLDmPdG~dE1sf@b4@BIS8f;%9X=|x5k@BULa{$iZdh!!eQ4VmKBit+?H`I6 zd>srolKeXLNQuY11vOt8UUQ)q0gAKcLNz_17Y6Y3kB}S6?P&+(+TD2To2#CES=0R# z0;`5A+3N0>)X$@R*QuY|d@1xZTp1glSM&J~2-K~ZIx6Go=hpBE=YmUGWI1+KZp^V%xY=;0;r^Z*b6kV_Ux=GYxiLbd43YgN)r__V)r2qg!;L@X zWCI5f*_II5nm$wYi6GZ}yr3&z(orT-5|AqePdynwOLiKgQ7$_SBOwWR^h<7ukzcRo z&>L+#L$_c6Vuvw2rM)k!q!h^wscQEc{}sKmN%VAfMqh(ywYy9XaIFFZ=_AhY4Z%#P z!45VjF}camCgp}J(wZTNAUGubAUk1t3&<0tD}80Kxm$<;b%b+0^bz zB}whxpo~(xtCTBix~nPoV6}T4CeGdK2?dgX{tB8W@l(5It2(5^(K*}x4HQEa0sbmK#fy~LyPKvz?1D(8@r}Z$B-X? z8Sfjb1F+urBn5`TR`2NjLjt_>UmhG6=WxWuVI+=o#Kp$NNfNzCaZ+3?WfO^wdeOvf$o?dkJnU zTsz!hIAe(Wfb9%ph}lB28>1?>yEj8xpR~%4{Q+U*^Iaj{UpC(dLL5Jb7tpE^51M|W z$302>gP`Bwp;rt4FYzEMM~0GzFqDM72UK1A~rxgJhsSkT!YqeHQcpu*Tap48xJ=D?smAl;HJQ3z`5ZTo8sgO z%np?s37hLlj85Su{wt^`h-Izk2-N$g;uxs%7MpbVtnG2xWq<* z$v%6Zb+I$ys{|(|u)nZOd*~Ccg_BSY4`x>dKEz5ujy>({>JLmHWEz563~T@aw#hWY z3xh30%ToV9!cXm5=8vM#1zZ_g#(`x++ez#4qXKg=J6`6G)vgh=y_2g!OZ*sVsX-)QB0oALfN&ctBA`U9yS-`q9d(xXrz=o-R`~53;gs+Ek zVoU4rCt_ms9{MD|HEMZy=9H{`6DXqyjk}P{HGm(+T z1a7F#ha{Bb zZAmA&)M%&GtG;m`XZr!vY_oMmwvTF2oq>Ow(sE>`cw^ zDoLtd8#P}&P(8!;5x_4KW!Y*-^O4jphx|BArZIE5`YK8K?MR3cJWJtz2=@xyTW~#a zlM%Nb4va7ZriWN%pxP0ozzXBQ4EGS$Z2*S!`?Q1dGqlX6&p-f%l3WWLSx<$fy(J=0 z5zG@sn(NFoY5R=TyJZeDogO73hg~jC2S5Sb&Vj2P7G+@SA+^JX0{cw4nF&wYTqw2O z4pEW{6X~Qy*5|Wx<>U9|#vb?P#vL!obsT>d{$Int4gOQPu_qk4aVG}lI=;22*^nE5 z;=|l{X^Yiv>9`8@e=UMyfpU8t3esDiWz=H)UP-5 z)sz_!;s`?gKY~E?4^M<{KHtI;X^=-tTa+O%E_c}wM&&O5dbvCo7N+iBB5askLpmZ% znCvXstCwM71w9Ei%rmO{q7`;>tR%JpJXz8@Xl_L29;`RgGC?bwo6v3_WbwBloSSK2 zdTAhBkW`pnatbg62-8c)rKT6t$_7z)dDBaWFum|1`*;~=hP4$8HKbj< z3uS5R^7l~k*BS?s^=ml%|EqB@*4?CB1uL{NY{vtzMsO=;uf3M5d{d#8 zfvnJC>dGKvvF4>Vb*Y_K%8%cN*Pf){>!T!T`E`%sEL=NWmtlEnAJrG7Oa0fmBxxmF^0kumFdVBy=bZ|s z8^>DuaN0Gn7}T8LdmK(cr=A0SjPqG%O$+fE^PfxW7F#FuVra5REjLX1m!V);xRbZQ z7{EYo*d5Q+bX9{`l?klEj%kYgx;;8P9-h>_thMQ6%*Ks~l;Hg&M*XzPwl6ZkCW-;J zl{Kfe7>K()Gf#aCkH&66O9KOLx8H_QG>=cpoEH zr2D^q>3ZQgIlP8Qy5E@T24db+b&ZlnTWRi4PhO!+s5x1Ux+!C8P97bK=e6M!NZF$p zCr-xu64jGQij1u~N?gs!U&@HKV#N}YqjRvK$1LK2&!}C44KB+RC8^Er>PfqAuzGTh zGN7h;83$_g4$iAHui0#*@&v1M2#hCyHsX1zl~I;J6d2y$u_*8VPXF6Psu zZ)tgH8v_f>Uvp#IPUpt8wdXpH>AA7TEz7uX1oCf#*v0rALJO4hH;v?n9zmL*4YI`_x!DD!E+(1srZpYl(+KU|7 z$TLvr6E^?>xW8U6NxSg;DW1QF^T4fv8w8gMN82C3HBR)BcKbxpMP9O*Eci?Kj1;jf z2Pr0r&Y?w8RQ0BCiWH(-tcawb#mxRNM2B!kQl#~!FkpzTFglWAL~jZM577xMkrd}a zf|{O44>(Od;57As)77XSdcbL;2iywzPYipSdcbMw0jH@4oHlyE5cJIR*wr<};MwN@ zHxeY|OC5sLmUi_tb%E2=1zLC)I89x^%su|UmIKuTs)i%Hw5kqSakja zyHui~6%EOig$TM4xOEuh`rIH_r$Mf-E=#UoN9yn#uLA)5%^(*UGbydW#A?Ui0F7waKTDFxay5_o%7E6% zp~Z?QOs*n^39+xGX4if!ukbmRu~9X(kyb@Rnx`#wFE-?49fdXoS?|Q0!?Rt>dR238 zOKpV8&#pweWiM;XexZcaX zbA)9bQNOTgS%=?%r4$A2*Rn7ZY1OjcZFg^nXxa|iIccM!=HA6To8*RDVKp7j+)u-* ziv2oI1H5OGmi08tLfiycbZDi0Hzzn~oWSNdSvGbS+xFEok@-FC{ngkm>uRywh9vrL zW}#uSUQT_$n1?tvuTpi z>Q@rdLHfng&^S^0_00XM>V6eTtF8nMu@$oqB3n?Bfyj1D@Z(67xHoxgCSqdm#I%>q z!T2`8A_qR=xL{g;0%YYiZ07U@*=S~;M!08;MD@@pqw%6Pt%T{X7M)6P$Vj9EWZo(U z()VDqO04w4vfM#0ewphOA|V+FNa0yVi}*LO?3K1dZ1%|HeQ5`LV*mi4Y0quif?_}R zVWG^Gv#5uHstBKhwZ~bs4a1}eFmsAj#!ie);hPD0=BY*0Fy3?)V}5i*Y{j6+O|<<$ z4oo0wX5j_fm;z_qkn`>6R_Txo0Z!sZ|KPr@mi9MlHEeV3np!neuKiCKGXD!TzenV&XH>$pe(f8`y!~IkD=JE`>U>#Yc~*_{)ow2a-nQiT3Uo37e94$5pV=4xz-4Q*rKh z)s9|3fD4I56@lnlMj7o&w0HXe%D6oN8DS8`>NREbB(zV%x>0R-8X*lCluo3aj41su zf{;7XUnkLS90)Ype0MVq7Vy)ayD9z&LC-V9tbpxnvkt@Gg zojX{Fg<1qS44FNcfJ9m#i5JZ)mQe4cprDI_cm!<`BH_pCDJ*bk{Y>o23J^FH z35I3$oZdkK5=@9gQ&3=lem6RS9-a>8j2`ak;lXORYyC&zK45r`OTlp1Jl70@LuuL% zxts!o07rn1n0Qr2pWn=}=D5%H$5uc8XCS!~%YZxt?ctB9e*P~As{%NxOQVubb)jx2 z>LSRb)pLZ5iVz+%HpaFebT}@p#F6mi-u#ru%+GNTiW*Qj@>6c|_G11K^E`vCm)K^@ z4q$5D8Rd_86IrD2{cQL7!&v$7Lydq^2X#o&_ahljq49)Q`Y}&3dgxOBP|;=hR#t3- z-elLG1e3P7w-8?XV*{nlBcx;4>VE8TxNTU|`BQGfvHycVWSoj=PX*`!qRbI;Z3S`% z+U4MTF+dC|2ykI@99Z_(f{CbO53jQ->Z^9Zn6MTJH&(l$?ytKWUQmVdr>eD z2Nq|%svGB6sy{jJ2*x7BloW!X)^CmZE&mjAwoeoNO#J>sdRB8>9QykhcZA znM-n+Y0O-4kq|RiFJv>4uHH0euH}(5X0F~eW-ckkC|y5*wX6Po+7fW0sy#%8 z_vR=G(1jJJdeW&RhDWHcQIs|86dp@B#_((mQUnV~n=_=g>99e}g)4?Dhg0Alfm;t( z4Oa{I1Y8~5({RtgZGw9i?j=){+(})*;lQv#9+LCFH5w!obGgr?o z{~SY$$r>!H77EDKjFV|Qol@hM|Sio6#ThHT1`tA$mRvxs+=Y`fzQGdQw(gIBfPBh1$i#As%2}3Um?ka?i#fJ%obM zkK<8lZ6O?UG<#xL1oaf{jshZ!}ke(+#B?h)Q}3Mqm-G{)THeT+z5S93PIQN$8e{ zLQb>5rG6NKpp%eY;`wKChrG~{J48%C(&*%rTlpBd)$RdWeG1T`J-~5(Osx}YW-p?B zg3P@I`fA_~JG|x$V7wf-0q;}{?VN!2Pg4qh`e$N9|8XnF!Z$@Q;YW%FN2VTP>SzyR z-zV3G=&T_?U}FxUYnHP>`CsIqeGJNA=Gg)(56mMX*)kY>IKoi&^q=zC4)w120u!zN zBKiai(r>@rd6NK}1t|D>n!Cvj3$0B@7l_=1 z=Y7nx9jvktS|r)PTx|Bl(7Bz&Fud?A7qbxM#zSRd93RYXt`|6|ofl{xOzA*kDLjw` zi1?a&lm2In{vvtWSvrP{i54Z%k3-us!{yo+DHTUc?HqtZMuwMK&Ye&*i?>{_<}30U z%bzd>gHo91VPK}&m0a5jpINOc`AItPYj#vJDap0hM3N@Lr@eM2LR>9)3V!`BG`Iyi z;7!}@OJw!uC;_itTC4p1Hz>BA$DUn1oE@0W0+b+a&zgAl8U^b=;rTh)c;2+;icz9Y z83x!rKD0OG5=|Rk$%2&AgoKTKrYwjI&f(-pPrpQB2$&%hitUj?`ikrVT)&85kV*{( zsLl(5qR@J(bm$_MZK#25Xt~Rj#7zk)2Hf5KV48(dh5JQ>Z#1f*-D(O4A*=*3y;?*% z@`efgFW8`_n^X(=DY|<>uoS)bPJp->LJm9=;h3~9m97D)q7nj4MA|@oV?O@Y3KMp$>r_Ibp!Eu$JO@J{^qrJQOQ}7B?s>?__JXlXh zT#WQuU?Lh^e<+1=yhaf%JOn*M(me+?qQN2WY30TxR&K`kS-IiyG#*UAxOc~Uju5h&QvYl88>NOW;)p@lHtA6BWLYZu*j9c7rk{TxHRon#q5V({~ z&|WeNSm*hwjR$N^87HkXLE-f`!n`h=(%yn&g42?7!6TT zf)$Rc+ytRXWMVpTY8CV+YPJOt^ntiu#&KK8$tl;yj|Zl1S2mWkX-!X zF=D!rC43W^HbX7$HstIHk2Fqwo9_v#!ikSE9%y6H5(kr!uobusCA`-=n$T zWuE<-rxiiW-3H=_wG^auX`V*Xm`;(wvzX|YRi|Zbji@Qf{-IRRnU(-WQdwLtz=2Y5 z9Y4xW%GF_{;Nj8CeS}}nQ^#$gI7_nySyn+ks>7O5o!V>{_Cl0`##MJZFt=St=+icC z=!+hBra64T9iEIhJA}kG;#|>o_nOO2Nm$i`nJaCdZ#wm)4D6H7?$+v$g7#$30`Mj) z%T7$*XD%|nMp4*{J=DtrJe4QG3nM6-lLYqZMh32VU9DUX3^?Z3(DELLQ zk^?T#fY4-dURA$Zk-a^8l|l3~lzv8VT82loxKF{(g2O!UTuB}*o}9XoD#DkjO0eU< z_ka^EQ7s8(c58tnRDpW>1riapjpAd}-%zj>+s=8agCEkE>^=q6joOrPE&}9+ z3I0^(X@fpEj?9o>gRcnq@+I(1z)m_9n(m><-E4{3qye0;mq>;k<(&`tSW!iuN z6yMsX`5Udu_7+Z~9ai)WX6-F}H%G^II2>&h&P&AN01D?#YnB(F_B87k8tcLK^tRc4 zr_m5-8(KFE55El6jFmJ}gT@-fxR$*qFi}5^K~L%J8dgVg0rmF@GEkDJ#=JwmVp#}G#v1mzh7dKG?&L?zM!e;^8D80QJ$!I(!uGzz z9w8#uD^CYhs!uHi$x#COMDiBU;q~U1A8l@X(NNXwI#40c@YU+n|wlU1W!2gBfBKz7>clYG`372OG;eZK`bk4r<#x>ziYY%W5I z#=QibSZn7ygPgX%*mgq&?=n>jvF8alE$&Nh5&NFZOJqFQLX^CRO-oAKsR0X3fW}+pL1^a1XDlQO&Fnj#<@>;0hP`ZUe{> z8tZQ3yR;ug+NL%}@m6a4HjPAi`Ztm@ zi5J5H6op25h&NK(98EMukQ#&xemN8lx|Jt!85>1?fCPf53)(at{Q%sFkY488iyhW) zu>dh^WFwar+=f?eGX+9~(u)vA{rYBPNI)xt2j=|4R&LvNX)8|}{oS_mMB15TG_gUF zUK^)H^4bn^Ui@0)@9Ee0Jf}%8IrtmcEO6h~)`7W$w*ESI=<~PdCcH2|cj${(k>-E{ zXzlkvUWtw_*S zCN1zR#njU;*Q(dShRegaF1jA;!-m!geU67i^j1O=d}9V&V+TRZ!9(4tfP~baS3s8nn&#t6U!asdho#ltpICho;3}l1$<`5jUjl73_q5s8xw7FODF!rWVVYcKP|G7c}9+?{9x5BziknT&gEi5Rp|l?TS*%nw~( zA=#Q?n{;mt<5DA}#RYL=N$rOhM)FMT!XgN9rgeuW6|*Z?(h-x<-Dk5BZ1h{LFnGDQ zMt0w5^-psm(Jz|!N!oJGGsdb-AFG{{n$p!5DiJhBA$*?vnKQNU}+i z-i?|GXwxPA3wq(u+>+i#FCHp%h9s=%ywI6Y#3IQSNctZm$reibHhSU7awPpfBgqy? z`i~>Y?w52el5DvYt`a3aAcg&+xI8KR&}F)&duwPatTHS}{K1vRtr(5A_UVxn0o`J2 zq&u#o?r4b70L4bSBfU^*=!<03siOhI-x&MwV*Tt$qQQ2A1{R^aY4x-4+u}Y7DIs<;Q8xjoCWJPKsp+!@sPHxYkwJm6$06hs?hoPwps1^gL z|0wK0jOUDO_|^h-0KiSx=%s>yOcB3A1n!J_5quZ4uV#q>zSAs7SV89s@cB1? zWA#J=7NClAC6`7vntulqR%0LAvj8@Q^7>Z`9H8ik^06IA(&?BzNZc}QDRNL-u?!am zm*L=np9ztiZ8yeIx`Pk(gTgwGR6XzZpYkoPn@lyz^RC*}EeGhHP-Bm+-cB%sRC5g6 z^Lr7(y;;JZJB@JoBWz2E^BUNK-@J@W1h~hzrt=x3kORLVKyJQ^;#(XtdwxDd&hSOn z z1oM5}JiM`?{Ozn<_udGi0#*_^haAM4J`Hl*AQrEjQ;p@-NmZ3{EwzZ+__5l7 zLvtRPZz4OtSdu=tUy|G_CFvLUi6{9V&zGeCc>oI?eZr~>MZEc>bmadw4nrJm5uX6- zry80p*ZuE`p$tAmo3-+nI}RQ4`B>eLpLdz`im4tE4Yy!Y}~~NiGglO z{mtADzhk&T8|3`tz%)EB0_jFGjtsDzC@Ex+Ab629<4Gey9jHFZbj>Qn z9+yp8Jz<7)-kP;^L-7!!NSY7Lf@B@!^bh8#Nd3lXz1Q z?z{o%p7udpNKX`vkldV(O$Q{kjQ|^_LPTN{jxdpDPZkXlImQI$#r5=n3!@|@_iA&a z^%|&w9M%|&)gU*q*CW*8x3YSA$65uHVrmD@2*zMTXVOr93a!9Xs-6Jl;Zxpm*a8oK z+McR6`@e4(Eg(Yk6&wcPDbUD__V#4j^>%D;#9}LsjL|7ESng{V7)93;Uw~~x+>nSV9~I@*as+_a_%=+zE(*9Ee8B5`<4{z56Gd`Bd_K2O4m5%uCbze6pd>N` z`j|UWC7LT0!IUBt*HCBBHzqLo;~4QwBJeI_zXvby^+dBQ7UYEC6~&6}99tuGjXk&* zU(moH9IpqK7^uwF^{|T(VK6U@YvDO*)mzAozD>6qB2y4Z?Tq%{yrTdD?hVLORDrNF znhFa?kT}ecSX4tjNEwYHHn@08P8RQJ&Ff)|?&XerO36`x9uTu*G;-sl3DptQ#YvMt z4*|HlkqCly4TWYU^kmGVUaF5lD3>9|s5I6;7^B}$NWb8Ur2Yi*BHJU8Z2DJZDaD>4 zmW^wnPF|~AgWr)j?>-L6)<%*6s9oQOqzHYKW0KI5PG#ElR|$ZrO|HRYs=p@blmi(c z0LO}$14D(R$59p532^HWK(YEmc*jYq7Wb<}FyM`QoPak(<5EzTl3@Bx0*hYha|cfP z+`&HHtY(T{If<*lA)iT3ZrF!hG^gZiE^p)xJiZ7gOA3thr{|V;nd%_Pd;R+u)>u8k z6Wf2lVsyUZ28vsSIJ6W+3JW+%b;#iK;gMdkj+0^99Y5k&9QK8U^?3PU+QS z@AltdVtlv!3_qt?UjQx?W7AkFGYTqqII@dtGE_<$Ie65Eq>>mdJsF%rV;MMwsv(9e zLG(?=a3Y5GZypVfa^hZYG$7NWT>BW{3QC$ofq~3TgeTqnN?bjATurAFD6AK9bpplR zN^u|+@82ZcW~D&2eliAB>Km+Orx;1PT=J7TxPX&Bg+QD}Khxhs5b?ueGyrAH9;0!2 zNnzCG^}iB|yhmf9Dk4j<-buBJEOcV-L;(0Ny4WI-P~`Kf>!;x+!aIyGKjuVnY{ta& zv^~nOcJ~g4agZUIa9RSK!q7Ab9b(xqBnLsJKNch(wA{ORS05*&W^yyc^Z8W};n|GK zaAB8DAsZNpbR3i65(M@dT4PuRZj>&a4DSrV<6=4PE$9c zNq9b_44$HZv{sBF;=NDR=t_AoRR&e+`w%qY=pG?LsXaLc1i=uS{V=Hd55n>_LJ$Wp zCuVpxSnNoma{3e1L41nElu=YoyoyBJEHyoY*uay}Gi@9f0}nu&_VRyAfcgVb*XTkT zZ%ac@H4mv`vm>4Tq_)b2k`?E~Oq1q^oSDs|!>~{R5uuyZz6yv!j$_OC0O|RYxrr}4 zg&i8J$e@Z3D4fgRi=8keu&7t*kCQ4x+7=CTCDjdYa@sI40V#uY7zr^`ifm&q94gH#iT&`ZA2?CT=!?{{x_>hDD2b|1NRNq5Y zxlC^e&xrH@V@U5eM8U{M4bzwH!5f$3Inp`|22N|P`meqWjhn#-i5A5?L0}wC`zQKD ze57(Xj4Y_g2k_CP6$PoeA#DOQP1b)OE84x6AB4Qqxc;wpB;)d3j0>PC7xgLYVeo?& zit=3>rgEO1O0BmSYDoAN#`Qn7bG$!^i!s`cf)BhD68ljuvW(m%KSiIhAfTj_Q41J@ z4tXybbSTK+N?s-vf9areiKx7q(3!+lCQ?QTnVF^rY497@M6aME)D{zkCXl=b_Iu6` z1`kwC?Nzl-V$?_V48=7W)iZS4z7YR}L;|9P$MQ3 zwVlmLv>nhmI4TYd_YKGJ*AP0PA8ew2+;^$&1at>}^=<-Nm>4mn6QBiHXu$|D_I&97HyH=iq5CGnS-CE)XHU#!UAMins3Ib)~| z11J!LD&sU2i2D+g4;UMWpygxx8dh92_p{6}*UUi<(_C{m{Hc3`0R_lt!E*k~{ehM6 z^P2?0NyJ;6uZwUyb(X4+#~lFJLzJxQ@yaUPdaqQ3*QIq;CigVEDOk32k4?TP@&aNX|byzU(_po}x@cg0CI5$N`OtZ_5 z_4_!3CaO(#T%|dRZ{kw;7fztY*@>Bvz)4%G`c|OI=B^ zo`_PR98biA$1V&IG#H`xU}@CWLvF7;$xSeF>L@jU|73SFn{RQ&;*^Fu19e#f%$a^tlf~I7J3SqHNbvHYdUKH8w(s%gjnEk+M2V2!E_|R4w&imz{gH# zofGMymGM=5ThP4?8w586JzGUJLl1aFBEz#dwZc7$ZsHxC3E&8gK;3DLy=b1qm+B$r__5jHZ%4f@)Du5p(=v zhZYe+<5V%(%+%pA;7WQ3Dg+QML2QIepy$4tcXV`wwe@*+3loWS&XKka;O6;^+ zu*DD;TET~>FwWCE7XuGbu&z-KYV@PV4wOfDX?&YCzoCGb>sj9F>(*n@fQ+^Nai|#4 zYw!BOAOT_Tez(Q_EN^G?qJ$Rr9z^tD171B(duaVtj5j&7$U!0(^ZX$mb_c4y870?s zz{UrPbD*vINqQqzTO$WPBEJDbu50a=u9>I9QPgMn!CtOGL=N^o_zVib4i@8J?{i2? z=VUn-BzG>o2%3yA&I-eF!eg(fG%0}u6oeZK z)DHAQy6`~`i1nic_Gl6xa}Du=dCwbS-t)$dXnKtsu82RWPtg$m0MW`E-jn6pmywE# zDKg!S$ERiR4)p@eMU4S=!d8qhK5mA)PgY}T5fdpyg(s5%j5-jR@a%qv8PPY`sSHD2 ze)xvI7$|ILX$Sqk!%-r}&4)PcBxaL$p(s6_sL4yl&_c(Zt@>@}Y3^45lnELAj<0|_ zVPuC*FY-}MTw9IB&AT@I4NpV8Ftt$*H-s4@hjyGUvF69DM?$m`!ARwqjKv?59yelm zH_e!|*iHi7O(kyy45}lc!pUu@Rgq~X&GWg^b0a36M0rd+Nsx+(r@sCiisr34TCV#Y z!g2Cz_g^(W++VVzTwLX0p*<3%{QN-));ahs)uyRR>>VLZLG5x?%0jc?GV-0Hk(+cA zVyDgGEi_$ZOWT8MCZR!bEn1s4o&3{WBoy~x9HTv-0uCA|9=nO7Et2?5A>^k26MZWw zg`9M<5-Td=^j8QmPzKo*4BiH|SQxCIhzHIzg?|1M^yxqf-dK=+p%vAY0SG_whANte z-YC5|^oDO=;?SGiTUp9xE&ep3WjpOE=qv`sFL~-K0xtmUa?L&IA{}~77uc)MNr5P)ZbQlMpeCj@njq!A~ zNEAEZJ^#LF7(Gat`Ei}AjT0Y3FLUA}T>Q1;9^w0XkA4`DVhui{<~aY_MK`~vJ(V-p z?B09gk6`S$#_0C6iHe^e@oLYw=`=|Xf9qwV9oO)E{8xjrLxKTHp@}2Bv;&EbqNKKC z47ir@!}K$}ELPM?<%zIqg_5M5S^u%zz)!KLT>})%EQ16{?d*48%n)P?49P7dl>jgc zm%e*;VNyQU$jaQi;&I*9y8?wd$~@ZBEi?zdp*oyKdyn~bT;UYH*=>(`c83s}4S4Qd zXcPK^4R)YopZ>1+R+h0i9s^G+@9y2NgZb#&N}Dunb1?258!3s;FySMFkx%2&4M4b; z-HBVBNn`1tE5xv&pZQNQe4CD6MTT3#c7OvRIi0wIj0bN=IT{4B+XZ< znohxsP1K&lxOESD(P1yHF=Lr7&3(k%;{Fs;A;*Q}*rHF}%I%_SnCuqZsGKtqS`&^G zFn1DUU^L5W)aGK_#~AD~xeh?FzhE^)*(pr$@Xb8z+eHXik3v-UE@<`Rf}Z`^3xipE z@O8ok(27Pb%;~2V?Sfi#hTqtHF?9QD;FLyMy#R^M5Q+335IUI?F{+9$T>XJ(#+Tn9 zu<$it`sM^=;(mS}Vh^exE`aO`?4^UDZExWEiK~s%Utd(L#|Z~IG=Z+2*nh*KxC9BD zg3arQ+7A@~n@0CwIuy+hS?ob_yk8Gue~f#0@eA7mbkJ6KdvJ=yvnQ4gVh~9l79^3R zoObu$4U0XRZFlIWKLcxa{2kwp%zS|4KzJs=r}Dd#b|lgJAhqKnkN9`Da2WY3^ ziaA^&$CjPZM(969zA&zsOy`uyOs7rbxHu~73>Wh2aXT6Hd46%23uq+oj(puD*Xq?~ zSQ);kWIL367E}6DqMhhe1{f+7S)WHEdNqu??o)QK2o{&Bz#?81>XTA}I7(_>bwlg9 zo)A>r5at3AlNesn{_Cjy?Z5#kdS`kb>|n>onmEt=qmsclb~YCqJT?5d|DaLpcOV<) zhz4IU_i(fp-H(;XmbKD-Sq|_ftZ|Mv_zu=9ld)rY7lxMs%rg!fBlt~q_}DhS`jWNF zBJTMOX9@Ka*KPqg_?^Yl`h%Um)(XajiU(S>SRW=5MJA1eyf({nWaw>X(uD?g76(`hljpZkxSpI zxSvGZLMSK${8541lIUzq_~tNbf{Xrf;*svKAHnZd#K)X+=o?;`SkQOEibDk_5EXQE1$LA1mq{_zuHK+bss1s@s= z7{k#g&4e{`Z*V%kvXWm95_ZT9x3E89UA%Ix+W48;F>s9!H}|Yui!bG1nQ9{3JMi~) z6i%*h82M!*jN(9#swugbswdY z8`fCEcgYPiu_auYK&htnPnC*P&`8!;jT2j#ZSb@l#IQ?y$A5tAZ1;WQ3oZPkj0>PX zz&RGA?hRo&Cei0;NK2^MWj_OZM9nUmI|W82i7!FmI}paVrZ8M|K|M%q$Ni+i&6J3b zjJW#=9}1<1c`}n+B$Vu*^`PL&H_>4qVI){)PPo(KSuj9w}*a9f*ud$1LT1OLf3@Sj$Y1Ybgdm zvDhT(RshvcBU|brAOOuJYd_nK(c9Lz;~|u4YvPNxP(wmg61sv@-R-D(o30MfNtQsM z8_9hlIVNk^+tW9BG?Gh_OV=p*cr*DLksP*ck$m%g(y&%ymC+>3B8!M(D`a^jBM=o3G{4y!HLVbzG|+jyQfc37RJ^;4<+CNC`;;9bf(T zAUhE_CXM4sB@2==cPoba0r)mT&r?vPTjRT6vVY!g+rCglUv)@c&tToVHCU;oR5!Lqx*2KLtjF1)DPyM zqWW%7hW!N>DN5CrnlAd~ePklV{g~q3#t~0^+^D8gl2W9q5z5`FZt*46=rF!X%IF%M z8dSM1Jc)eil5&F)GCDkFI}E_!QQVb@#|`3b)b=>MhKG}Y8L}Nh0$*eVD!jNGQ5>m{ zP$&z~sibfw*<+U8jeRa z<-toat~Z8yKV8e5g+AG+;og1vhgrm_1*@bSd`TCRhId(JHs&&+1-RTBYA3C63_%yd%xMZ;d9r~h zh5aUy{&!TK<%~mw{7O!W4LY#eJVx^zh5fGwJ75smf$u0&a(dGbAbCrSdtqia5@<8+ zEGJvL*WqPz7kRaN61*)l0TjQqU#Ml~@I>r3n45wa9BIrP=hbG8MCdh=w1We7JFpoG zdkmz_S<+T1S8lroJFLdzIS`8!eHs^K=z`MZ=-p>q1k_OoHg2I}tRUOFRANg2ofIoOJSzv$bRN z8IE>n(K5&2TZAL!hI_A+U%|&hL3>OX4>LEUGZX}tBRB+Fqg_!Vo~ru@<^fnrI2@UZV1|@-kj@W= zuul(7oy0PoX|1bEj5$9Pp9SheN%ZkDEY)aPyHE?v1MuaoIheZPQ?*Wf;22X^_u-K9 z2VibLW`5{a?$GUk79Iv8Yu4dp|6$k)jH75??Ka$AO<2aUxk(^e+P*cvV41f~A^zVG zi_#6g;%NqX**$~3Y4m%H}=*Zms;B;! z6W0-77sK52v?hE$Iuk83gTCBmV1>IxOr!!2QOi&-Q>L;OvwE;JTn5ZJon;rXkuJ!n%xz-c+-~(w7;R9*DTzoj>S;=x* zD_FM5vmobKu1@27g&drrcq_bic?O3S4CrRCBCQjBx~VV(GN z9_b=~<0;$tFActD;2R*F?}1J%g?ql@;UWHuZQ}TQ3gH-ZBYvzYNz^J7NB$ohe(H&I zkcz@7z3C?%>}j|kz)|=Q;fQa^{|p@Udn$ViTsj<$_tkh396W%3uYZf-C$b%db5Wtj zAEl>P3N!PjCRpxW!{sOg`ER4q!}5r=SkTMJ@egC z&fMAA(xO@J`BGkS`N}-0xNJ?KPx6q1l|Cfpmnyzusi0^@ zks__|<(03L%6&zpid60|%~zy~^1S>)X-%20Kzc-^!FTN=fA(mpw9HlL^OgCerLH{1 zRajc!D)YL^^Ax4fS1K*dzf7RN)K{2awxYD?(ZT{(KJddl?05oBsyN{i;po)LNH`Z9 z=2XXb!R>+D5BDzI5x7%uXW%;EF5*;+1ZRf>oD+a?A_;Dcn1@*E zg zU8Q*?)UH(R!U|WO548pBmH7x>S!wZF*P0?i-IXWONG1`-O1?sGp^uYADRY&Um5wib zq^LqEEL8yEL6fD3*}UG0LIq5Q5(->-6|VW7dGmneL#1VFN?m2;N>N!U8cZ2eF&30o zdP{H#jPuJ%N&r{9;Qx_B#mKU!DHY@zac|I42;VVQt17=YLPk_)B zg_1X~sF>$)tpGA5g(YRawLpRs8R30^e~rTVWd&&A)rCGU*zuoHcQX2K*+UN&f@W0N zib5Z+A8-K=xV%M=ps?b?(iO@|sU)u$%tz!mI2R2=&0*Ag%+xVbepzWj5dlDZuke-m z%fTC^N?uWEg$orZ1b5_>x|B6wcra5wXaiYc78zj+v*E``W2Pd0LNdU zxE?GtdK-{=aII@>qZDVR0d~j$j?CVuXDp@J)paWaEv2ZkwIC z&`phk1}*1}L99hx+OueenT;fvPiPtrFg_Pmy`2fY($9P0(nr?aeDlqfeR^i!wl=$O zgnHojF)3rErJ1}D@<^#dJ#>AZ2SrNwab*HI%?!si)B)LiN} zC67tyOseJGu3K-vUCJ*m<1%L~mosCgW)g$)-U^P*_k%X83tjoZ$msMys2qqD6ncwF zAripY|D-o(OBHLu5swI3QJs2wpWvo3W|uYPUYT#KL_8z9esA&$*UCI#LlUQg*pTAU z8H6ZA8;zf6${?eSd7YMKgA(QATqMkvE(Qoewg(FfAuNrS?!)R!vpLPmBTW}!wQ?WH zLe#buD;V@mQKDJt=oxKeNJ70(r@BNCM4l?s3bedtorn`J@@ z{z#UQPzF!*DW^{nQdz!&9%!&%1-c@o_KEJdH1*CqiS84}Lx^!fC}>pzu>tb+m)0ak z&{Yk}(2#(^`XMoFUz!$zY;{qYzoK~Ucy#Ujhk#y0=JvysOO`T!X@NA|J!AHK_cx1* zveH6BR2Wqz4Dww4vZ3At(C8(o0lHDe|Le?Lb`l1nFg!~aK15ffgE!n57it1n6O1WJ zL1Tg;mA0m_5u~C-AHkRKQG7K2bLQ3riI*-)r%>k1%=y3bPpZit23Kd)fueRPhA6X| zY+S4rK4R))oFkvSE3zpf0J+{7h$FI@0#WyqxP>z6^VC3)n|?-*h0RDi2k zN<=GX#;H}eW%!1;p@0ydQBo2=p_p37fdQY!&v7)K<Qz*$ZF0{xk zOj*gIb7=}wlvO0lMv2RKbq)PGnNX>wjYVFWua%spe=rJW8{iEdaxR8esu~339KWk0 z=%pF8I~_M%F}yeHqwL)uGiFIp&PQ-$m`#u~8F8Uib=C*?L({3PPFN1>X)Gv^DlhS@ zBC`@syEKVpMz5w|0=atr(V^E^B>RnqSF3pk+{m&_B20(P-95uiCYw$sMi+w6YeR|2 z`vFc-+7p-*rLBP!E@4~|oTCPATaeNanThOos@suYU9a0i|9p*))zAL){pu(G_|3;B z-bdk$!@rJzECek7g3t^DMws;cX_3Zd3Y?PDmEvL;h_}Y3#-{+kclV?iw9lmoyQ8Sz r?Da?8^S%`Ao)l*%^hxJtc+Dr(YDK*f?zqMv?6kYbfkfQzv{C#5XbHs4 literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_config.obj b/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_config.obj new file mode 100644 index 0000000000000000000000000000000000000000..fededf673ea14dc7fbf2d9d58e5eca0addf043f9 GIT binary patch literal 2584 zcmb`JO=uHA6vtn(X<95Aq)5;T4JcG7u8EP>ww88HYO8{cO)P~hT{gShbY-&}CKE~z zVnIq%BIv0WMeMf)ea!5e)iD^A zW%bxamuzB|bwXFvvOz4rxqMwtCj3!iP%}Jt(Jsmc)Xo6F>6B+$QE$RB&c?D|20EhYay-MPkh4}OTMplioyacroocn#@+r-sY<}!cTuf<-m_KpdrBU`W|c5*|`&n${xoUgR2eY=3(S{EDEWO)JdK zEMKE{+h3!lfWj{J2}kWd9SFF}Wvo1D*uQZwmE z9H*6>5@Jm_JvBS?AQRGVX0s9kTb=Ok0|bKLk3taYI2r+Tb^*K$L%1n5gYfhmL?<+6 zG5*^_n`%XiYE&oK0X)a!N#N83e|i)ZJh1r3mhB+?^JM!Y1OT%2FHe4SN7i5Ao6U=B zJ=kFgz(XD(>&P?Y4KjzkK$ejOxnA8&YF@ zPddR~7)pNL=xHSCC;j`~jedT=Z%?JvdCY~KI? literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_dfa_exec.obj b/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_dfa_exec.obj new file mode 100644 index 0000000000000000000000000000000000000000..255e0cc58e0bc14872778d69c365d1ef88f38e03 GIT binary patch literal 31387 zcmdsg4}4U`wg25eNj87r1_%)T2mylp2|_Ta=t@lpixAuzARF-&j0lNf`Dd~V`XoTS zduwhkTWRaIwl!5-YJIQzN?R&vOJ9>nNrI?>YKuzShyl4>T9MK~C}rRG%-p-VyZM7? z`up_r3!L4Vxie?ZoO9;PnLl@S#~s3)>C>0T{P(U|TfTbJ%5v|c%QvkmFJ&J$%$}Yz zlZ9s9T(Y`sWl8BHrK_f|5~_y^f-oq5j`6_j&Z?f$5^s%Ph|1Qt#^3rDa5Df9mMEwXA#gqZI+hwcZM%bE&SQi$1%Ku76;a_t8!LEvAwU zzIE&RS@b0kQh&F;1p1`Qz90L2groV86OCQYYaM?|FkFU$6m>@b$?;TuG5@S&=>e?s+bR=j9dU+36#G-knSC_7vJn z<}O`o0|-wi2>(^T)?yV{sK{cE;~_yva0tS;;)VFIEo>Ebb_!w%joffgFygG+=<^E0 zONGmZE-5cvwXuA)IV+`Bcvn7H zI@44>l6YfO`AsDcmTsVKB_xz!m|nH%QNclh^&2;r3Te3pSzA_Clx!&7vTp5$Qej9W zb!}Io7)g9&)w-1x6~f?1!seCh)~+t`dCLT0*Kk3wq~_|aH-uJqpCDA@$#Yhr+cTuv z?G{1ssAmf6;^Dzn9k8DbhYJ_@I;sxLLr8U9mPcnUExt!_pI1B=71w2?sD*aLQ>VHw zt9cH^wO93AR+AL>9z5yDz0M&98>JJLoEF9NlHz_b>~ct@X;-B6DOS~$@^h-=n-@Bb zU{)g{iYtX7O|5Fog;pq@;|z7G;yOmC3sS2Z1kk9s-)eI0593dDrAqav`D{+T>Pb=E zXB$pf18GZaM-Q(neai2xHxZOKN^&ps3)#*pg-chOxvDB(dJ191QXPYA< z;!F4i>JUQKoTIj*$YpDl8qvyT)!oc6Z5HLbkRj)&;@OR2iu{m1_a2fKrBpe5EcFK{fx_3Jpwl;^Rsjl5NU^$=Fs=Df&trde*7oo~( zJaX|-htw*BY{;Ru+Kx`~oF`r`29wS^k8DmPenOB1Dd39YIjp)t=wdYC8P)v^P%j4M zs(Vk?kt3HLwMj<>#)79+PkoqJn&LcCIZ^dIt-9MTysHe#X;H!J0=wFZ!dXXfJ`dBKkyh_rJ@Zae-KlDx zoh0i?Rg>fvQT|^@OLf&Zv{?i8+(OlJc8Tgfv-mVp1?fPF_AGl$!j>+P7BGdF!<1mO zp%Ocg$2-ta39bb{*R`NUYOpHqr%(g6-ID@=O@hQ#&mP8Q8@P<-tL~?44N!IHcAK)m zZf^auFX*k;6`{%X6l@nr2FsZ~K#fv!-cv?Ec8aSt=P31<9ZFy;Q}7p|X!0WnDxMdi z;EMaS>N=xq{AsAU>aJJZ2RJ{Z8!g116$g}i?W*elSizZMYgAnAV2a{yQ(dj9XRoud z;y;>PJE?_S7xRz~Y7~!98z;PQsMx{HfxTLFS698y^siGm2L1b->Vc|NPYk1fl4>`! zB~`sok>m!LVT+)+s>80Gq2UI;>QD-rQth&zH&Z4zJFExCO{9fgK>U@V>zYWURrFUaUy}+tAwb-r{+KKh^9SfAXQ3`jS z@CJ!%@=?)060s)Ni_}_eAi|;e3-76~DFdnhomCGhfwU{A(6bAY%~pA2kn>&NP(8fZ zu72L`JmQPfjx2*p$&?%2W>>DWaciskD!PfS-qxVVn~3ZH`*iJ;>&1Py`qFB?@eFG9 zAN3|RF(DESIW09$;!A+;ep$nJ9TS7+CHbiLUgMb>Bs}82lmf-=S3UlS4ImjTK!;<` zIUaG}T?JOk!{ktPf~3)KA}RS0tR*Cp3k;#5JtCIEo~;!qDK(yxE;+WW310}4OW&ian%2s4a<;nBdk z%$z*w`iYsSgZ)jIFhLN;kINW~KVc01uDfn@`l$4g?1SYPF(O^hD`4yth7G0ljsM^O z($acQ1oq&H9Sx#91aezd?0Kg!?P(T@= z0*b-B3&)_eA%h3$yh}|L#eo9{3>c6q4jiDTrKBV$CnY5&CZ;4OCF*GoM?yk;d|X_d zBOxBj$^Ptio6TyqSS)s%)$+~?Nac1xxF<&tzMdrr_u<<)M-XPu5`+!Y1mO;RzlwFA z#W%v^m?{X%@V#p`dUCcPyfqp6hwphe3BtoS2*PU<1>q5Ve*l~!sOrG#%o^zE7gJC# z<^y|^1)&h|Lzs~(c=jbw`EimU{0JjlOOYTvc9$Uh5*oE=j38_tjjog-2<_ugc99?y z-zf;g=L^D<3k2c7LO~dSv{gvUMA|b*JA$-A7rHFq-Os^*0WJ=~^TC4fJJ3=Mczd8A zj06W~=Yp<$LAX2@_F$eM97K3eo*?{mgdiMG6@-1FAnX_>2xkCAP}_}&PX}l#K%{P@ ze21NHc)b`W!ZcLSxHc@X$g29<6^w-KFvNuz#@Zu;_(v!yh09@135AE1VxGWw9iOLN z+?Qv~I;M=wf#1}w7uQ0VnsPVbWfatoBT8ckxglGov(bKpU6g;rk}r469hK^Z-vfs- zjU1agTO;Lc5T)Ie!L?tmuN$W&@ z)Ap^yrNd`Pml_>QPD4)QGN|q}snfc3ipiH^ zqr5v^v9R%z`&UL<9>!YuyCW^4Ka9CO=+IsTvD!I`=yse9{d{a-YmqTP!swlQL4A~ zTF3ra4hXd~E$yBnOZ&Zm6@Zn1QovfkdceZ~AK+0yC7=o*0~A02@D)H1@J&E1;CaCJ z0sjSf8SrDk&j3FM{0h(j_zj>1@H*fK;BCM=fIk4<2b=_GfWH7f2K*h+3HT>Wn*|UD zNCXT33<3-Vi~w8*7zdaLm;$%~FcWYS;8wsKKpwyaSO{f|wSe`2 zhXFpoqkzgH%L~sICvwx7!jvbp*xX$w>m6^!o~+l7biz+RBEVOruIEra?QpvaqB`)} zSZQ?E$LF<2VB~a(yHcFZm1+5eFTE#xBh2{hHu94#oXWvmlQAhGf1fECCzVa09`?4G z%|}*uweLx9wLfAhj%)sNM5Cd)|N4qcBNb1giph4>!FiS4NQb5B$V=ZL%DEIVnbP6i z`KFDIAfmQt1E`3O&4(E%$K?MRjF91_i~iFXWSBY3kn6opHVcNiX>~SNOh80x%*15p zC1}NEbpe?nwJ-xunIV(wefFHAp_P0#`yccWX0dai=y)G(4(E_L!auiPW67D#Ln_TQXMkX^xOl^8<{&mR11^6d~ zw1HHFn!gv!d|Y4%z=BZ@uh``)Yo|X?++c{=5Y-dn1IWV>e~A$PjEY30^aF}<6V@wb zQUrmE5O^7a(cqH1&US>j-73l@EV0Yn_C$y?g6E$IY13Gdo#4-x$59aMUzmZ3zmo~d z!4Pkb6(h-rWT-B5n8kRvP@5>ca6@s@56%}SbCZzDCA+{RSqGDB79?9fnOFc>sYzwd z1(SUvnCfIM^roq9%m9&|XDxHijgh0g)6MC0wNf8k>~J=g&jpr_T!`gXqXE7dtO1!A zgngNm=&8oYKiS#n8^-1`icC{iK5Nx(BaEi`8}Y4;3`(1BpxRQjVaUS;cnl#effZqV zy9|E{GhCW^N2C{9`WW)?(%+)eEmXvV(mwJdx+&CuGmJYi`SQQadK&Q?Q!ghqBoBtO z)!7K4xGzf$ndnz9!8u?nT?LNree3T2mw-Qs=%enOX=_nkd$SrCMWTET-s08t_zmRY zoY(~{+OMgI2R_vZizxqul}EdKX3N*;F`Ksfe?n}bVxu!e`4~lrGhOzFDQN=cmDWtuEv|66d1hmqN&>V5T$l`u)1f3+|k7!f0EKXmoLms7j_5^(Z5~K zL!DNXAEp?!kn~=ZA21N;x-ZIwJcVi8e0{yaylOOoH2=bTN_u3y%+=PE>%cr%pyeVh z73I0~jv}O4@WJ#;39|0QmNT>vCJCUTBNs9ylkok`#mO&x%PE}rtKMOujRoWj9GVIHF0MVdvGP><(h!@q|a`Z^}2SL1&<^6=KpLK8Ha%QC|& zet8)Mv2xf+tGlAKkVTJU-LNLjQuD-YB#v*bd2&9!Z#*LUr?P^Ek#A+Pjy3Y}$iwSu zMo7DWIkR5Z844P8Rg6{Lz1Gvn3iVyjcaVqIb3fJdBrBqOd|$eab*@&a;ffNtA443| zofK83u(NeD76mV>>;bK-vo-!P{2``$krlk-n6W2FFH;#S&ke6wabcB@Rse5S-B`#o zEx1lpgS;xgzUI1wt+}#QzT`$Mh|rp=pP7WQ8D61wgs^)7T%3IB`$g7MFBe%q z8~_+vWaVB%dIf5bI!k=;vetkGG)d5QvhMHCsc+B{Xg%=6_L?dr2@P!twnnT%VnqVW ze)To>*D1T2CR1DqE+-xY=yRc0RAmZC7i}ijPzh2Mp=@dt(}fCb@Ek`C9rn~zxTh_l zI5vq_0xX{c%fpN)U9`KYG8)6tvI=OAbdiz08aTVi_EhJzH2gV%9=C0;sUgZ5-cPV$ zvnCDh09$TNd7F`K4^Ui@m!Z5Gq|XA79iV{JNo3cD;&cawssP!ZYHYipEXZbR)nT^~ z*@ow<1X(@@JedH6R8BlgbvBAmHAwGUq_ACls$OcdIGaUz6_#rBxeweKuIVweEA0;C z;TlK_L0UE|!knRr6m(akr4SPuE54#ogQ8m7aKcvA$eI}}B#PLCjMinOiw^OLQP_A0 zXUYj91tAM?8(B0!6*)(1 z3N6y5ICz!;7O$_#!-kt9N(~5)_7dUf%A>21F;`rGHFohS+A&muEPExZauaI>M=b7J zVh3_!Epb#~CZiI{oXorkyplmNpvgK~8dtfmBsOAE0P*ex+u8Cdy`klVxn zl`E5UF&=#IR7;l@bHxj3%69CBo5ikTW954zn7BB%Y39z#`;lo707{EfnQ-F3rXK?~IJ)^-A z)``2RMo5&xsbY}&3l|qfnT%DY3y`?{-8^v3G!+;jy=v<|mDq}0y!U(#OQYI)Dzw>- z#l9QNYYuFo(^w~|SLQ~olf56if&FHM?l6M_~M+nq6$TKP39!K_& zieJ8;$}#r!w>0Ak^R-Iz2(9t|i=^pm#XJRz0Sg^i40r>J0a#GL(vF(SR(D2lMO^@e z(-#Q}uo$o)b}=BE5vaRUB+Y6=nn!A?4d*QxnWXUj5lQNEeKx$Ii?aQ2W42G;$@d>G zPCofJ>>yn!vi_j3IQhc{cqfMq?<9i@{2grHaDjgt=(R(Leqw>IC91i=ze?r)B?6yK zn6Fjfwg@@>-+lW<;16IIE#g1-Ch$4PB!%zmQQ+8`X;VgGhaSfn?&YE!i0oXHtq5sh zC#u+N*9G)3#r`D%`UYXXRslT_A*cTZRB7&!Z+^-i*>Kw@5YRKoG(WOFZgqaV^(ON& zM9<^qgDAwsGzCo1mQh8fRXdDK{M3cAiHr4?Nd8WQw8<=g*Xk%tG6rXTBO-QyZKBK( z9r(+w)Fxw$WhP<_OvIBg5#K7ZzVK_9h-{b$r(q&8`*Rrn8dZL+YI0wM;{I0?TA%;S ztGK_y?)FuO;iqW}JiIc}kLMe6g@vC`W$pn2t}-LQ5N!cf+Ly{qisaW2($Xn^kFFUu zGJ4URJ**Bkn7?xiihuIS&;mA%pveR#Lw56IXzBHWum$iXz#%{r&66Qs2$P}ssL2q^ z$0tLS!#o*^@0tv;TzoRb@DRb~$xv)!>|}_Q=aV6pm1cvVax%nF@ySs4T6>=i3AG+! z_p2}wvtT0bz#7Mh;%y26B7^M zAwUq&W=v8h_ceVZifOJDOD>yh#U>KxdYbSsB<2YZC1A9bE@I9@^Iw%|8f`i)y@|QX zVpUj$;+eW?U;S(h3h{o~hL9%Wqvw9swN)Hzp?^SSxDVAj>+1asy&!6d1v4Pg{|zeW z*~#}BTb1BEw31Hu<>DLeKic%HxlL+-GN_e%oo|Xba7z7cHWH}6sWLsHcoyRcKb%--ZFoP4ABQu}!YQn1m|^CbIEwEzU z!-pe|gr6kFvV^(lqb|q5!$n{CW3X5ljE@tG6U-%vy1H~??C)AOwDMR znu#zq(+ra_O$iVJ)`f=}U6@j+3%@$kV8?sW>@amhb;DOFnAP<)TWfzAej zsX=minxtiVMM=x{CRJ(Ai+IeqHqFE}B|tI8f*}SAD1}&1pKY+9>C>>F3dK1K@Cc7 z%f~$j%F&DGz;bcVf#Heu9AXn=JqK3)BM43nvaFxMb6}{r=g_^@-aUuDhIT?pLwhVf zHnhhk#tiL3?PB3%15CvmFcrUtskngSTmJxr;c4`>e7d7J;nY9jeGCT70aOFXGx>{Q zTC(*sHcF7uXZ9K>A=+!86zXq3gkDyKYtYxcj;b)7@{d?yvxA;)`x_Y?>~ffnVr)cN z-q~hCi?#a^{ap&^JvyG+TRowI*-G@`t7>~!Ue)$aN*li4KA!e z#oA6pubm6ysR4WdSp)>s`aT?r6uklDP$&V4MSBO7LS0n=s;cn2dLxfVHIg|9LhU%A z{kPbiX~XV}hTWO7@IrnJQ*#8S=3SVY_YG4qi@%pOzMEFiY3w$G7r&Td@M0^f)_#cS zweup67{Gb)5D}J=37lLcyh+33j z`M7IAIn1sFcF~L-T9%8u77S0UYZ03m>sqk#+_hj?KZ9$*P;u9yd##_&wIGz_TEyaG zu0?EOjB61Y{}~eV_)iH@<3IC4z7EsyJ(z}Xj?18D`k1vmyc4rl|k15N|Z0M5cg z!8*vPqks?Ld5|Zv0`M}R(J(EunU+z<``tw9cmZ>Vi(P6q*=8&?qvymP<@qXb@NQRx zr8Z4M)a;gYTWWqFl0TF3FJ&au_S8*#UvmC4RTAl@sTBJ(PRZ{xiPo+)jmvlykerf> z_^t{+Z)S@cpodY;$XO&H3!D*p#GH}ylqW!+vCar9tv~6*8KI(KnJ{xSy*MMRhHG+0 zs7Y#o5R)^)s9|KAoe`dlg@ESrRBU+T7~Ej@ZZzeJ9nJfH6&J>vO%9g#jgAHq*MQWgH0S(`ouHwlx$&9SJKbMt+K zv{WL=wEoZoH(6=^Qmyv>IOc_%fEV%+ypW6VLc;Ju>R@V)!PLADQ*+ud6_MROYPNQC z96nyhM^*S8G^g9R+IxpxO(aIRUjr1x^*%hV(>mk0$3?MdkBd^sg5ANW`2(nlOp2l{ z*d1mcdqQ_rjdG_x&M+AJQ{dH3AZli89}7GCA|)TCk}o1!75)v#x&|guTe_H3N|pDU zE7l&xPl`pmVw6Js{Aer@-U7n=gP+d>8&}j-XpQz&L_Z-vAB>coLM4~6l5D5QO+i?D zj~@<)d*|ouz(@T#yjGZ1q_bx(OB9&quum8#zLWc_+ zME~yvO2s?!e!L!jvzbti70Y;Z{sB_}ej|X^h_bwSe!}`wLPf`Wb^uYuVAcH=V&W?) zgOorU*c-}0lpSv5#~KmCSw9@kv>n2kOgGBlDCX;S`f^v}&Wj)wLNirX8orvmgjK*A z%U;#&g{-UyS${!D8_i0AtT0e-!JA3PutkbverXn5CxPa={Bzh79E!vfKM1A=!~{`p z6KV$tAKp_O_u)gu@gF{1Z0AS6a<2oCrW+JuPlj-&{{p!^ zZgrU9BF42eoKC2z22yZ<39xN@Pp4B;0+aUWDjBfIwtFLVWyZh=$^{|6#d}!|KgF9*VC)9$w*HRN-S(g!h+Cth6y; z4y8ShsBN9XPk?<|1p8kR(ypT-9Q$Ba+L-j;DEci(z*d6jzc_*d!$to`2=FZh(f8 z=--O~-;oggFH-h6?Rk8e^`<95RU!}P+a1)h4OE1;Y!xeQv}~L=k2Xkdrwx)@^bL|3 z`Uc4)?H1&XP**;j_DHa~l#R_LzDE+L4Q1H+mf^?PiQ%-+yZhP+M0HwzPeEhc^0%Ffpl+p^T5z0Wes!n|f@VteX_)1z5jSYS!NIANw9>OZER#`HJU%!>7xPgda%bh-Fzr;I2*`4?HF?1?Rb#@r#wuz7Zg*yT*liO zvcsU0{?q`W1y>&AZ*0Iw_~-0EE#QsEufJO0kAAg)20i`l0+qAJ)~o~wV`v=Xtub)E zg`AOr6U?D37zDsEXM=YTu}P*RXS3-+`JwcH_SLV*yUPJM;Xqvvj}Np@e$3m$h6PS9@Tf}#AnqwLTS>t z9#n{O#HbJ@^{zt8hL}!WF0ne#ZN;lx(RL1oDR!DM9;G-h+7Z%*;KQtT-8%NU!AAbQ zl>Y-nqj?w8vB?(p+_Ak>RfN;uVu<$lKc@+0-<+l#F`TBP-Z}l(L8Nmxkj~u+onz)A z3FcxX%*8mE3lZjGJj}%un2SeYE_T9Pe9bTycNy;+==Vo_VoCh~wQ@yrTl9U%{eNC*D1j|w9b1kU-y?9#w&q6!~uF|ciT2}J~p@7oGgXE$j?!PuE#jR zUQ3hS$IE%uzin&yvrXSMc%^8NbwVS*XOSZgIrSy>eG72yp!%y#7~E`c>UGfj-P=a; zqrte*4+9?RJ5456k%=lb$VutC_fHA#rF2GOnQD>hzf&fiww6zzPx0{@l;oickx(f{ zXl<^QxMN%g(OQWk;q59zH5Vf@2EO)~;dv;rlW~S_lW?XYW?Dz?;aGV(vT$*{i;$K` zC74ez)9e$B#J-IhpeE!gc)5_QZ}hu9wNx%r@2ev9VP0|1Z=%rQ7hdfus`jghM%U+Q zS7oX%7boCZ=c8lrU6&}`5LMq&D$c88Hvr+X4J>4uinkf3=%+;L4I!kBq=M+YOkQ;U z3WvO--hdxX4QC9O8f{pA!18Q+%ylr|B^;5aHxERNi5ascyApT_ZJ4jh^o8YHml~uH zyC%Ujog1sJXyfda8f-A|$uvdN7f`kUA?MVsMDZHJ-a}KEkdY+DUw?LAv1Z`-6*9__{DsG?y#Yo6uWMMDhvdkL!QMCSpz>?^Ve{=c+F`W>T@{? z>B0?u2afCV>775qv|E0Wum$N;x^&i;tg-}cEJ&8ZTfB)<_)(Lmq6R1<)|+Y#uW%~0 z#ANAlg$~gt)#JSi)2)=TS3hazQVf~wCB}S!XxDoJO5kat%Gi#?NvBPsOt%xza>+XK zlu-uWDAv8+!grH={taV0gEJ8~paw4@O~pM~fy)$d)hV*@CIX(l2xqnGmx(GtJ4-x| z`&A-0j4D9~C4yJT*{ok@gspQ*H17IwD1p%w*RRkjOj3dwh&Rcp_@tRZlbnVS{joQk zvK2WUacV#&z5|TpFx)FLc+@1^CI;qHNc%2h21`6DKG~d1%l$P2HX$qRe^3j%Sfj{K z5vzjqS#{|N6>>>3rkaFp2BWTZHv*B#erb+AH(4#tltF! zlOgcM(S49rh(73eiTdD9AXfvlTzT?_V#~?%#dw>w*v8F55j~VTS=XeX_H9NwNm9DB zgG*qIC675&*qGgE&zbB(g?H)uwIlrew z3WpHVMp9v;?+}Asdx*PRK?kWok}6XW@2AqNC`n}xa0@U*^9W_3D=B6vfgKcPpU@bW zDzi8)UX>}6v(*QGf+gXC9J-eZx_^pve=Vz=JxPj2;`=2ptH>#Y+Jm#XJ;w0 z1K~iBK0$#}IE!9UG}(zIfk4r(4bcYVy+6Vw)m+RT2kydxsb%ehm}mbtiP@{8W_Xpn zS!$3{@V0JJ-5H{@!9h&oY2ugfh84kz0CLcMX1L~o6=$C?d^?*H@R*}~N?rys^vF(` zXv)G|b`w>{rYDbZJgT43t6ydavqKp;T7Q60M4qf+PuO#r!norL)KXkxrL1&&wXqO= z9M&X09AMRPoIzHmvHUR10Ls9d{G55cb0UUJT<>_{9qtI>fHC~PHmC>k78v(6-^wk{ z%V=gO_6$tdalhEN1-2o(^fGbE8sTK%ZA7)F;|+G^iGGzLjCtB!D4{(@aZhVi_{*?e zxJ&{Cd_$V#W%wprE-@=_<@F^aLPQ0NxEY{YabW>INwlk3LHfj1Y$H?_r|a#gk}#u8 zTZ0hp^q?#)+Xt$wEp*q;H{u8@4I)Z#0ig-dCtb@x%lj;ar9;9}C;1jU%`}+fIxaZO8Q){UdJ6qm01y2AyT+}THX&14= z$NFI|RlvB0Hzg=6v(F%%re zy0U@{8{WR45=YA4FcX}Gw?L2#w-S1qtnakinU_gL7b=VR+YxtyU`~G`(LbBhA8jV& zSt!A@!n-R51VS@?1Ox zS6`3-gDfrT26ZdE5K~bMVin{zM2dNR8QqJiGJn3nnsp>(lMX?FG8ht~0@9yt9v!&X zPnD2c+^)Zb+n%BghbzkY^$tRsgFI8uuDKZgvHG?1d*nNiE{XEf6busXoEEyOJyxUe z<~THp)j)46L^R6Siuq5%%qYY_xD!7#0Jj~N^DA&gT?d+65Ck}B@?1H^)S?)QOHq_l zJc%eSW)sSnFadc;4Uix(nysj_K^mhGQDu@)#E_;_5`R!jVdrZwq%vic*eCQd`Z^wH zCKGB@85mL*Hv`L!Wt>Lb(HdYf>_I^ZgQ1`XJIa|VQS*o$Pt)LHn#I5;V6w!EK*tno z&U@f3UEEG{Ktg6*YOdXna-0|AflpgZXo94(b4C9=iZIpH;^^Tl#CvntbHRQ*?(!4K zq#zB~-@+_Wz+I;V?xFzwmP6OvMv)8I)AP~3c@Zni9QH2PeiHwKVuHau*X+q&2gBiRuNlgm zcevJOzdAIGbMhD}hm_6&y>=Mku<2U*of}~lc!zlMIXqK6jsj6;y(I7m3eXfNNa?Or z`~ZgP-hoc!_p=0cQ=*R_h8nTMTh4ACuKXfAEh<;<8_otV+OoZe{HsE&UAH=qR21O0 zV!SlBbsBTcQ=r&S?qMQbxtyT-M||h-IB7*8%p~$Uf@@;esoD zvdL%}f^KcD^;)X^Hj015yGX#P)o>aIXNp(=uuvX48r^-hw zlj=UEgq1A8AzeyC3j2+SyIIO;`RLXp)eWnj4BkoOyxd~ z0ata6R`S!xMl8jJnrBt~(o6p63;Ebj+hOsIC3FQ2xTT0e2}HtO=)h%Xh$k*h2iG_G z9K0AdXI$wM1z{8X0U=x1KHQrtowk%`+<<{p@Q%Mh5K;wiW@tVFxi|&I<1<1xL(d^n zA#@7@v;+~FZlp}40FpwZ5ddeyp&CTrKzyDrvAXu)ry{^3T>qL%ogEufX)v@{Cd9XU5B-3O zYmam>ZhLBn3kNBa>OQ0vd>*cHT?d8cA*6cHL$*z$9#WZst8&J(JIW!)l)|W~K~mk{ zsmLHIvK0N!m(Y}trANd_Ck9ybyOyvjOUjdE*O!nn^teyMyva?Jl^&&}ivDjQ(&Rc! z?S;6@)Pl4!{NxDWAkUHk2N%!EswxkLg)M``eV&7AeyaG&Q>g;VgzROi=U|!QIe;H7 zfq~d4?sFfMI=62tqd<@6RS82cZ{L=wc6Q>a%;o}4*MU$5RyNT-I3~xy+rg^qSVyj% z^}J)a(;YrBYjH|0H`z@tdRc&)R;CsX15x#WM&67a-py!2BbqQ6lr^f4rQ(%fzi70< z)rk7)nV`LH${-1~LxmTn77xJ2r1e9bZTN5#b{ZZrb{bZriSsC5Z%u5xdJ|cdWVuB7 zR_5a#$8RaYO`s8II2xi}VLas`3XPGPpi9S{mnzc4ePWb8*yzzBhqF_ZFmn{te7epx zOI_+f<`IEKbkpsbLS#^vW~fa}UD@@~EumZZCHvWGekS~@rH-st=cO$p%2ct;xo9#5 zx_sObJ+Mr@2lodprTc@7tImkR^-#gkCaO8#;k;N;2IR1iS&Rf)mb9xT=j%$Yy>&m#lE2B@-{s%FpfujEb3c5$bGtIZ#nt}66UttfKWgzb% zG}^#Y0S${cO^p~GklZ;@I!EGJL|1`MRUflEFKkW+qtrJG)q{*#OEb*U$>-9!U0p=C z1@mglC#p*`FT7i(rW7+74P!D&(-ZG1hNKq7N@_Jp>M^3ub=-Nj;$beS|7QevWpUs9 zE7HXQz6YS0(nSmQ_Hc=shm`qT#plI+1L^(p`JgY92Zsr~xs4N=12*#gvbZ`rI-oXV zkBnWm_S+K;r*S5+ReZ&6nb7J>qP7vX^4GEJrO;)L-BjfFK!CARpu2zNLxjz94Eiz& zmZc-lZuR0Y@A0fR^p$DY8MSb-^H7CDY7T2;R8&th4FO-Ff-Iv@d!5ie3`d@3;mFhN z#rEC5z`dN=xUP3uancL#6ekJK9k5u0HT>fKs!rN2sI0^faiMt$Y`+gLIM-uLhTz}A zozxFNZyTYv)Nj#}#)^DQW3VhhCI*|O4t&?suM}ZtE`;$2Im-VS!uU*C)5}!&IFP)% zk!Qe0B4s#D%8wt{m|_$ZzQD55HKW|5@43*U(Sc v;P2WZeN}MvXS~L!PhKc0sUIR&C#8oR_zgl!Dsxomp&er{dM|Z5C}6~AR-U}Ig=R<&FN&2rWjyX zf~er)ihwSKPAnvWa9j(Y18>nuK~T2`tnfUTP9CmJbh~KsnW8m zBuQ$SJa5|cyQWV`>ztgJ*!h;;xAc*g-6=^`mr*ctcN{7$yG@eR2jA>4w66g>+@2pn z=hXSVXGqHiBJVE`RSxObki0}IWgd^rN1C=9Ix2bK#Ib4f9!;Avr}OZcv!|y|w9I*A zO4`&Z)264*n>c>xu+AwC=d_vgCid;qyU)a#bEnRBPMbb)(agEi<}FH}I5o{Ndt$m{ z+RV8QD)b($(7P_b&^goRP>Ex;5=UHqiIZo~n|g&QM~PErb9P=yJkuR%R~S!}ICJi! zROmR3pCd1ypVQOQ=FYp)h@y*4opGfLbxfN*^N}lD=;XPn=q*>6rPPzII7=PVrcF;J zM6YBUojsFx&nu`!P~uESI^mh3wb9X+-$v&=GS#tU{*@Nf0WiQ|F=kafNn=hQzH6$xefy zZ+st$5@;~K92>!eGNiTLr6!XnSnit;k$lfE3&O*OP8b?NKTU_-HU1vk*oet@rlgnv z(z;0LmF-1g;SvwUN)b&&NRlF>BJ(Cwe~%@XYAzJ)8{_wn2|2U`y!oFr%g_q zK6PH&w7{eko9>wM==8n;`F)Z7g7VLw{OI(#)Y+t~hUhq8+?hIO{$%G={7I3MF{V$Q zzeI}nJzq2>ee&Gti)PQ9J6&q+i=F9@lzowlr_P>|o-W1tB7kZ?rz2G>cFugMmG9BQ zDYIuzn@kT|`r>BIba07F((2Zd6c#%~V=GyC>)(*1Wr*DvE(OISCM+UMl5FgRYuBk1 z`@M?wEVITcwrX~NEQ@fNirD>&O*`47v+gf4qg-Wm>dQ#YCPlfwkn?gWc>moLOy;p? zO<$M}E0a#MNvF*_W!G%}Jj48PT1?@&y1F`bCL-j5_R6GFu99#z=~V7_(pgE${Y^S7 zNzUu!f_@ZNS%;>U`yKrje;3p2>)f3nMnVQ;lM51DMd9q1+)AGD9M5>QT+m0P7kLA7 zA+ht6`D@2r>=*Z$B_`MI?Ba8g@>_4g;FXFiBiV1c$Fn6VXGxQLT>EqGGW{wS^mo!T z*8jf|xR|~c**WEZqj*l)lh+e99^8Aa?EU}(mmw-OcR-!AC>E%)1^wl>I(G7!QdvT3 z?m!XSk1auL|63`xUn)>*00A^|A%=jQAvA}4px;Cg^OO7Bt#_cbQfhcW#zwq?hR++xm&TGU`^|qGJAx%1j4SS%ma}Kg|jhH<^zcHQrz_vw{|_a;C3k`N;;_6Dim84P?Za!6zghcU7cI=Jf6r;?SD;@>biQ~g@R#iBy=mpYCWKYK z3n&JB0N4Zg2yg)K3E(rpSAcH;#{eqe2f$B&{{m_NzfTA|9tLOvhz2wVv;0$v8Z0(cGZCgA@7{{p-VC~!hSb}634hnk`xNwnJ7sFF941K!jP^b;AVgu`ujrA1T$rV>xW3v z=vxHb(_WGuXeUWKJ4#ad)xq#x0@AmYq*{P}?HMacy`v?Gt`EtQv?E56);5=<^tjM* zq44J-aqW;;E~(TrJ7=hn1Cj5C3)q!QhGoGp-z*F*Q-K1i5bdkrP&h6ikI4r1}R3Kt1l zGERAcVhTGUg}UQas`RwF9oM8H^)|P&cR*u=F z@prbbW)#`U&tGHdHCxfR0z|6fp4sOkQx~)=;zN;K5G@ys4_}_kg;-)L3bUM5ccXk} zi60vzYu+AdIQ2=~-x|4Ul_rE$L;#`yv4A*0JRkwk5zraX70?~f6VM0HA20wg2rvXN z3@`$4H()Ga0^mNtM8Lyq3z_|o3w_(Oo5fK&D+LbXPUj{ZrF-qwr~ z&pe%5=kGj^kc4e#3#pIuCY}Sis(16)OKV$?1=hqnWDBiKszu={L;Y>bmFq^eFrz}~ zunTr0j@LqgL}374Q$>_wD^n)z5=v09LMiE*btl)YU=Z{a*i)6I)ondJ(%FnHC1xp> zYVTaGov2)AAKvVjgqzSI&YG%)$~4z5OyKd+u9^joD7hfgRlUI3gzUJ}=#B0@LX&;6 znR7`l7!_{X6NV0FDOZ+~ZU6#uK@9TBc@M)Jq&`&;=c>(cv|^bEQfZDz=-f5N0(?(Z zwstikYl~+uqjZ4Db9Z!VWTW5a;BJ(gM5u-N5_br~BTOAqf}jpTW3cpS5>ODv%T5lgu@DDEfK=SLSs1;F0+;EHUPvAS)nnh1F2=$W2Ftvr3$EuiZZB$ zM|8E&jDeBXWke|WL*YE-?k6Ld9SV9~VmTXw$Q&i&Pc)!T=hd#xttEbBMqzT{s(Hd0 z>*tHN9~(0p#zG=*MPtMHC4Q`{c7a1{=1E1`0Ktcc_x}sbxXq&20y-C&Euyg{9TYZ8 zkWtVBxkNwDt-YMCl}1JciN*Oa8kdsqAU?fIzr5!>;pp#e#dxgN@jQkU3miuRpZ5^Y zmll#xcs_Fp`tlyddYZU*!%HMIh(+(j)^bId3|f~XS#7|)AN}>WzlzBm>@#E-8M@WK zgjP?QVh0kjEJxygz0q2?X&oSTHFX9O;Tkp}H$t)Hu`yh(Wh89sDmiQ^?+lg|ffC>tcBtK9DpAmY^}bnZ*#Yt-bvg-!>`_h9 z#H+=PQleX4Ja4B#nWRL)|1;n}v+RHgd!ybTE}?JOir^A}zT5$YE%fCbpc-;aLY*Wc zn)_S1oQ69R%L3$N(|S{ocJYle7wHI{e>SkT+l5%Gan#EK*=ap1ZD=V~q(Lpb2+QFf zsD@W{)ga3SjT^4++h}O%0S&wxmnRqnep!m#MH;_u1S#NGCx1=_t(Y4B&07CHFx&?`vF3-J9T};p&*DYpS@nA_8Jl^0!f7%wom!1_g#^Fgp~x-k#mtDH6lZ z@Wp;vcnT@@i0(z(_3WbX(rrLd zahFk8Ob_x8A?)Eu*KtCi!{8^P;rWKY5W`^BL#aYjB;XdB@2dGI!gMf<##U5ITHs4& z`Esy=Xot*fU*^^>M^JV@gPy`x!nmS|TI(cX28<2oS=A~N9`gK670-O)zMFmr*VUnv zwrnkBW1}KOthvk)kyPhx@;>!Fcb)9+OhuzkQBft?b1_0**AzX~)BVCa)=S9SLLA?mB04=H><1yPHcEy@rTs0y~9g11{c? z8g7?aPas*S#}WB2YKLB^01}ii($u+#Bi=oQN1D8rAt<~5LTnUm)@R6AV8~=PC!NEM z826scU_soY2||=Glq*iuRCC@r1l4 z3CP5DijC=PJ|KI30B($zqIf1EmG?er!&OqnpY5h&4+3)RO*SvL$87%D9wR0ct=aId zrlKBhO3U);my3*Q2oTvF;t>?A3GD^u#Tv{9&1HgA3`_A(qSXhIN^tUVGlt<5OO@*InF){0djNr zjN}(j=!$!k(;{>>=So(z&l=}FP?%9oO$RZ>fEw_karoPpZmBPDsNQa3vJg)e4Golz z7}6srpF^9BA$@=m7S{ zQc>b_F`>wUsk|n!6dgiW+rySe04Ee;F3FC@LsxOQVvXk&H=~NJ)tIdeCUc#H0B;f3 z5*V0!urU*%7(1}x4`aOPz}BwAb6Awa7jrk0`GAvja0zlLVhUu7SNNm|MJg+EkQjwR z`$WFYk#6!fxyERM1_rD^F8?%Q<$5F@>6E$fl8S^=-WyI5fDZ)Cz&LGO_q|{xrj1-= zgSpqOnV1}6QOSD`^IM6h2a_|4BYPE98`2N-8;H|nAf}4cVrU{D=Pja+s!bTvcrpJ* zVl?xZLLy8pI$u_YN?i6eO?5r6CZab)OPe~`V>YeRRRWx&m{*lEK2aLc06x5=YJBjS z#HUBV4@pi&&Jhw&e~unvxZkf0w_><6Q1~l3Z`x@S5C5o1q@#n}9GY84o-uGsw^Zc3 zap0DpHw8$@o7z8tDYKox4#L{sGj3h`nl7DPv>cU9^2V?@Oa$FyIu9%92C z%ytMftB9mMG~gcMmXT)yHSVQb!63zbABFSj7h<}TdHDU%2$oNYkh85G6=y!|j47-{ ztoomP;K1{+7)9jZzfc_SF*jxOcqU?Uptv8V-wm^AqQEtblF#G0{l)vq@HoXigC6J8 zudB9Gb_m3{5#kAthL4AK9LIR} zaaGg`T)Qx-1L<*MGA?f@c6}ShYN)~1SK*ohCsu_8&ZrORZuYKV0cmuOa4}UUs-jwb z)wwyDoWvE7V9bn zFF(cj$#!D=w^mnuRUtU-cXH*RNV(u%SnH-*xj-gA;3-#Wgpzqyoh1rGA#%Z8&=jU> zxu7jMQ((Wvd+v?EDv!^Lwv$TF)=K9i1D{GTG6_b``{pEwqZMU0zb(hD`t(nTBdtmE4FnP~i!Xyi4+dXu&67x%3H6LS=;0@v zt-%t^H5BVEEKjjG#TM)3{t?_F2^^P;GJL5Y&w~D^Vq7&D&TF-i*%GfTCFcPju&{Wq zd65TUob%F#n8 z6gC!y$2xPlvz@@gQ2G0RqRQ9l&bT!!E8e_6BUZC<)E7}N`Cn}D=8`NM1XuiRILnHK zF7u2<`^O_F0%&cxKiqdygou8Z!sh+y*D*IGE0yq5=i*@~GM>}JlN?C~C-X zfONp|LUOAqYYRcU`WHlzUR0k)YG&hZ$T)jAT#?}wZ`s3zTDS%+2$FXCcucM$mKm?S zN8(n~c(EdlLw3JUJoR}=j7HV!Z;gE{NnpjRc)~eE@143{)EvyBk_^=^QY_cB}BTq84a{aVjQ=hh2L~%*Ij?~OP45McYm=Q3m$*TErC73~$ z3SUt;f;+BQz6_PNL{BT{<&dn#WSBp5q_HsxaF8W(Lup|*oP$YGWC&0qJg%*MoAkzK`Y|Xq-su8Q%+Te`E%LzFHV5Koajhz=NaA+ zYwIU4D8sR2!2DK$c^?h)jKp&D=Zo5h)=wz%l1tu#)V$=Ec*&f_#i$ySiOnW^?B;jv&4o(14$VeuFBveb1KP`# zOY5))Le|Se%HRpe82=Bc7{|sUTzYpSa>0H@_ z)SN3DzXHE$ej(?zApa5XeleI!T6U<|)+c#V&MEmLAZO;GUkt3>XqGXUPckB1uTf+; z6DgK*8JDNWihG4mEcAT0u~IGPVN6fDh$Okk`8LAiF|v&!ji=!j{?uU{Z~7exhnSlJ zu4)td>_Kl6KDowXhWF~+IwCYZnvEHBCgQd@D1;(!6F%sI2_%xw(+2p&)RhS;5Bpm( zZ;GSzmOKisOYVYK2ZEn+fjNlo4st=V#EQ{{pu&IQTJc|lppZ^a5x=~xfq zSko`ZngT|wcX+#`=00%_+ccYli|5#IpdCkO2S}4^iH3;ld9+y}E+%cbS=!Xu-u&1$ zY_;2gt#%*Sn;zR|kFI>t9$EROJ*x6;Y`rVCM<2h>9(jC*J?i*;d(-2K?9oDf+yLf_ zHai_c*I2;fgnkH^u?5@)8^XZ=E`2YEguZZl0_gLMFFdqakc>a+?5FaS+LybPgHOMoXk3wZ3 zMj;a)hJ6D_aJOqkrSQIbb3k9MH|hirU0=Z)3Dx-@TwFWDg`1^=pg3MGXqNjecc|28 z4waqZTw}g=7|g*yc{uH6AKD?tx8R!6MNP9sO}w1xR8B)NP88*I#f4fKkhYwFan_4{ z>hu1Pdc~IOW}24aO11cSjILLaN9*`;Lg7VlDIA2#ddJ(zN^q#||@!WFNHP4nE zH@Hs5I2`x5PKKvF>}{QU5?w-a*mFxKVa`C2qft*k)FYHhA0O+6`i$;d4VL>2!gBvT z7bZI_lGd);7-wrJ28;`1X29wq`~3(Wa`M0YI28F8(X4+(ZWQu7E{!KYx2{D3-UR66 z80%84zJaI-eOKamg+11g~b+V5mHuvORmF~od=DpAP4acMj;!b-TwN7E3Z$xJleqS4e_qv?8>q&}M35l!(#ldRE1 z^o#;3TsXrIHbOYDf}SRqMUSiWjO%1X8cn}+&0est>EW1Y_ z8%URdHOr?mllCkh73Qjm#_Zh9?+-2?8|JEQ0v`vj6H|_%@X8h565s5W? z_vtWR<~x}v6RXYd@?wfGnTuF{R~XA&&BRR1yjSLSrmHSa?4H1$3^&cNfKPVFyyh~X zE$5fGjsinHQ@QMRiAfKjAEv&zDAGf!0qwi^VDk8g9^hiP=`W zYC$w10}I++hZHDpcLvJijFR6P8OFp!##PIL}cC>cY#W-5H>SD3jUDrH-g&QnV zWm`-rx?)1n3loY_co%03U_8JMcmVJa;1NJ7U>0C5;3rHxRsdcEe4$S|l4z+oNFr|v zp}UjdJ)$W}SABKY@2&`TyxsG-rl&{mLvCv6b4B-7tVew7ELfy~ zh$2F7rfJQ_jD^iW-UE|sPn}}jO7gAl{H%)7X-|)1% z)m)IsR|IZzmA*j3+OMTVtej69trSa@{2rF6p$Tp4<@Z)KrI2+avu?z!)%_3Lm0C7} z@@#c8!W?BR?99}OsM3f)X0ZZ}m6wgowh@ww)G|`*^UlWF))6e3ZNe&sWlhzVGV+UW zau;RZ#cZ2gwdb5B_E3h;S(+$pt&2|kep<}i$@jRR7%aJcu70-{e70_)DfeMLh&3zA zdUuhWw;M5~mQ$iNVJF*qb9r_q7WR(7bFE?4oG^3u1jRsZ6!|PFZnQ^NECH;vM;{vl z-^D}lT|5fk#a!GU#Qjm+dvX6Wd>K^}!YhBCpsj-3%JQk8Mw2&AkT;6R<0TP=+IFwZ z_2&IqE|36bLu=;U$ce2Yx{FCr*7exP5MpKIEIjkW_UNk;XjpvV;rJrrAkuF%muJuj z{vSjHGbRbI#47IY8e>>Kg&IxSA{38W=2Nx2B#kn46iQV;qBb~bpGE_bu@PI$76jw- z(r&`1tH9@WmQNwVXOypx4uPvdb0?N9Oww(1&98Btu+e{92phev$Q{Vtjac(r#Vq^K z$Ibo)Grn<()^>=C=ZGO#W%sZBzKFtjJ52nXS@&US;RDdPf=8akW;$$&M_;%W{Unuz zxr)$9tD2@o;Ws?(PVeJ<33^}yd#H1a*2%n&c`T-spMvO&5vVNCMs?MK<6N7n^b+_Ql&-1~TA>fOTP~N8RNqZ2PdNb!*60Df|?7?5z5%*hp*!DyMCQlskP7de&ozz_38?Yts8v*e{{&MGv;~ zFoeL)qalQnG}Oqu(nE-DUy(Xm56fiLUq~>t%mIhKz8W6FZVqn0 zJQO4vCo8Q22DBA{44bwnQ4^LJ9j2g>qTOgJ_V*&6iv7mlph7p-wn!Un0K7ey1QuXM zy+RQURWA-?0;Y3txw5o(K#8Pp$S762LWyvFBNV9CJw0!L>QZ+{q~J=1&vFLn3o&vY zHb-HDG+&7ROkN77uusWo^PY6kk=~etj`S!g7%sQIh6NPN*GB8>w8j;bI$pa$c2FlC zLdvwq^cjhdS{K>9EBMwa-`*kLmK{X(FEKDiP2QnYf6*O&>379g{yBLlM;T2gE z!e5?iZ?Sony~UOr?Jb0QNXC9)|BN!YXE=cqP@9X3wV3W#Xu!{t0DAl~5dzZ&@ z#5cJto3I5n`!m%7R-g|ieyF{xHZn7C8Sf$nk4e;c_Az1xY*$_p8|AC)J3Igu5$ZSZ zqLzlX_Lq?x^t`}J=dA7oCSRD8h z54DyH_L_@1!>$oDgoB4_0?0suj6qT1+DyY5FZWT;3F}Cm&`b48Uwm)cZBitO|jly|Fynq)23c#yE>;2w< zaFq-Zt?*LIda5JfsdrXjy?8*+QDnH6zj8wZa&Ng{U}hwpMRrBY{?**10{9qSoR-l43o~X&eyLy)WM8(BZY$`8SP_S0;4AEn_#S&BezG?es^YGzJo#hK zp-J$pe57O5^o~lsariZ`f};pMlvr#&yr?s8p0L3Vk4xbhu?ro%!OJ+H!}OVVuDdR) zH!Gzbdt%>P7q;Kyrpiov#*Gck62(5H$ust+UEDtwtj!KS%6tEZxCD*LDd2;DRDSbc z)aLob=Lb&31)Lin78}oFI~MfWhG)vZ6JolE#Vscxypp zT^IJL$HO^saC{K+qKIFn!{CIzgHCMmfT!>xTDB~ebD|g*8lyXb0qTut`axqfp9gxj z5)a7Vb*cEzk2`)7RK_5vjAUJ9jE*(TyFUCsqXgyx zo!~A*5e*&MyCV~ZtuDBPqB$Dzf@XCpwf1NA8L)1Va<|`oqFVnX?k?T_TsT;7iJDI7 zC0gQ}Q_&J(VG@_I^HFfw88Az;qIG6$WmeuYmw|ZU=)3hi{*!InIeTbo=J)m8jY|A8 zwcBy0eumzvHx$kJls&1z4ds_dIMYtx0t*HFAtR-RHFws+ArOQ>8_#N zNJJ)Zqbo0o+qHwkgdM{*R49P!fqs!Ui8_t1GS*EriVjtGoXcOF;)lovmY#=IC|frG0yd*SUOkyug}H3u!L zifIDZwm#hC>g>FU@u$8j#|&UR2`Tk3RGH7y*YW{o843m?Bh)-9 zT)0^REa6%peI66|PQM9!PY4sZ2sw3I)@TB6@;|F@0;@~?PkGgWR`49XNW9#nExLs( zmW@P#-$EV%3ppe5?GY#k7P1+aMq9`jUI+4K8hR!Vh6PN;qJwvti+r%yN60ItHlaR6 z!*V|wmU~^YQEUkum+b?n)eM9#rU6@9uh`4kWmvBuDHe(X+wN6~1Sd{z-G%M&} z=AnRZ!|Gw|0p*iG9^H*k0)-pn+n8o$w6O#y_F@vqA2VJE#-iqUH=envAafaScrt1U z(C6|>E1r3s`WT`uQ^44$r+Y49OTIOcQ}K6PjKd)Lz@9-o(4$F4#hutuX~T}niP$UA z6e|^R01x(0Jco(Li@L>-5`bl(U6S=W^+s-&ZzgVw1&LoEjSDVFcwRFOKz)Ew&;WD| zMbsnvA`24VKgh}c4i_#wNf#akLI{tdFCaX6jCWx1>k}To5yHzvEi|N&8$ivBB>XS1 z6!F|PBguo2KZxX>6wy$Ue|>hot*ayMfw&Qo~OjxTT5bHRbKfN;)EUcAS(Ah!6k8)W~d(e4H837xgZ&R zi{eAeLE+EpI6f?&(m@p6c|YPeW$+8;6S4tow|tJYVgLzG*Z_zBhG1wHp$U(I=N_By z2Y~@A4*Nh3Nbqg{{t{hZTX7&e1{N5tvukEYW(Z?d@2WmyRa=18jMZCEpKh$S*NxS{ zC50ekwKmkgr;-kRc)wk_*)}C z&i7s<#EyZBZp)a73ZP~l!G%lzGz7$zC{qC%aV_{~zZR^d z)^VX_*_B(3lIn{(f>c6hil|4#MYN#T&WWhNg>(ND7{|F!fe_rM=nHV49;wKXgddL_0HuSKS3<>&~FgCHEl=n zq4}-wJarrwmQU%R?Xd7cxYb+u7)c6FOkvM$MliH^zD*;94QE*#` z^gsnCCJqmlg_^ACUCTFF3*Klm5!GswHJ^6Vw5D&eHkjz3jWg$+tW9~@NKORG4bpDE zqyTB3vzj}et4Ofi!asz-d2IQKzAbG$<*P`k8`|Xmh6N6WXOlszuJk{vZ@YWb^=xFH z2O91V=nrTvz&*@ku_s6v?&9NYN+SOeg-v$*r4b4WAlS<6x&wH&8%Cosh2i( zZN=VIyy%K(+F(nsqS5yXw6ujHEzEmt0^CkFUbw~KJ%tc#>oIv=nb(ozUkLx*3QrV* zmO^Y-mY+&PxUQ=^@*zwr06PH1m_luR7~j~KB1tna*MAiLkVoO(nLV9^@dj*uvODh^ z?;mLN-8rkSp-LLMJlp~$p}M?rUB zU({dA#&Hz#a0x`AVXul^+PkNUrve&)x#`zc9qnk(@_7(@$?*m%57y8&a{mV7H*mTD zalCRYSB0c*#cKCekgmF|y`Krb0sk39*4M&%uMQqCHw>1JrB4VymWjziQ*54&0kiJV%)11$ zyrIp<>h3XcD~Y)ELAwy#dIOP{$}Jz6e?j>ma~&>!IGL91*fGZU)DwN>yfs{7q>uLE zsK*jQ&{vMg2GjTc7*1ayE`KC_qzhRn`tCr*0XCYvlGE2D6n&@KHiEuyuwVfB9meI4 zq>q~+`it8~sORU?FMnH^0>;-T^v*s6cm|I#)j%Uu;_UYHdNmSf5bKLL)-*E!~lfrpgv@%j|41+ zUZcOCF*VeyJ;rkiT(#$WXGDJ=->(6NfVLnOw&yGax9YR-s>ZNzv|u4FSA>O^O8*7k zN~zBTGq4L{0v|NOKyN)JoQQ7(6TTS5nQ#b~{}~gM{4c2^dFXc}-oSEGfDWsu_b!dD zEN=#SL0q7vdG)u}@NWD}p{wv*J%L+pUbT_kE6{HP7(^TNn?9<}!BjKc7PI}t^s*PA}CFiX; zPb1z#&*?i@&G<_;oJp>L4FudKyoecw?~6zkCa91&sE~G0A)TQ@aDNQ<$8diP_mxpl zBUeFY{yyrnJU?tj&I-wOL zDjc2PMI#6!yQr4l5qs(b+`=v%I0Ku(=i*yL^YHB-fOS4TK?QIukfg`)>>o2B-C2@U zjeCL#2oHKplCGUCNfC1->3x9Sj%Y6-UQ&@)eccjOHFS>r(OtY9?Z(A$+{BoU*z9m( zER5bOc;XSa@$aX~^t}&_K5n8lN+F*GQJfy~tOyc}Zo95LN`iSOE(G5;BeKDK%OB49 zwi1_1Mk4E3bs*JcTTe&PW+dW-tA%8Nk3=Cn67MFp3&0S#3k?xLxf-e=ez9;2PvD|y zh)ZAo3wY~&7=P=%kMFJb>;13sb^z`k6fZ=8x7eGxYU;nm{uokdU4*yOmHkLH_LYMq z!Dk+;IwDe^Wbt)eoU3usZNSY0oe_XTq07e3=fN=mD z;C{d)z!boAz)Zj#zyg31uw+8mrXTb(D$vJ$Z_K-g`4}fAX8nnAqg(hHr#J3Zw;-~9 z6AnEw^G!9np?pZN6D|#IAU?)j);shsB^xLtkGwjwc?b$8AhN*}CZl{%I0%;pQ+Sb= z>#OcGpgx&Ue?2w?>dzvw!Kl-R<$-!GE{#P!)LZv`jcD^FpI@7WK>H{n8;tgWp&aeK zxHK4TZ9i_%nK-#9C}@1;4%@pz;oGk<_;wNaw&(b^&aKUXy^)CzlQv^nIMGQKC*YhN z!j*gg9$9PEoiQPJ_BtXP%(D$B9->~0i(DYwr}K1Fu>Dv=MVxxGSfIk|xP(D(5jD!r z0hs!Xg=Qf!y~wgb?HwG`UvMFJu#sEhh?`IFRP(86E+uelJ?tLcVDV|Kr^q&{XRusE zYb_Kw%nQQ7&n9u6%{YNWgV{C|U;?#+&(9l%#I}I-x!j0VriLb)_i;BbOku!Hk?C z(3w&Xopv0Z)&b}ccWyJFvPw0DLgmNsMxgT50M42J;3D4D!8nJrK46)&6h{W`z>{D# zmi3(KLRA4hTD-=NFB9?o85lDf%#ld~4Z9Bw7)UxAe9>S~C^Sr=(D*T|5%qs{t6&2z zMm7kmXa}CuX9KFL&xXd-KS|VY_to#GUzj|DLe*~yRsWCB91Z6GSGNfIaWT>_%$*&0 zQlEZQWuQMht-*Cq5p_S{tJ_bzuw#aVsM{MOjF_%?hLI2l#o$$sybjCYUA6M#N8Tcr zr=<|*t*m&Pj6ho6WH^BQVdnOWb^PV(!3 z)X-Nde-rgWTVV#*!}>^n1J?T~qM=wnhfKiwXXP2KYPRpMV0uJAn5A zI{~Ho7uuf)BJ_`0ygm%ui@E7nTfF8$v3Sjc=UKe|Z<1gvUjn-jW81oo&Eaii4QdXr zP((u+>p&(jb`CCq&Eb#W(uJ0#f9NOpaE|zRAwI}?Mn3!lS%diSB1JTm53`X8e3*{Q zAI^tR>$)fU3I;TRZE`^d;6OOTZl^bqHHZNlDWahacnq1qfN8k=kqm%R552JM?Q@9? zX#S*;0dF8{5Ci@~5djRK6Rw6~1!V$OP$pr;WENIW9>?m53*qHhJxRmr$&*+;VOSkW z$4ZF{D+rF|v0xvIem?n<4_(drABmg-qa2GA@_HAK%LQr7jDHK1#9vitwww1%r-V zj6wUdjSQNHtU(NVh$0%wpdQEs23?EG|CB)uS~t(@CAf6a@oICHkxL_yHHb?CD59ZU zG9eSVbhhXJic8oBR^fo|$b;_iVD)tkR$rfm{@4ut@ptHtx1c}XhW;pp{wT-l>!(<4 zJpvu_19Zq4Z68=Ij6Lja%rB?5<)L4`K2L!QuFp>bm1K5(gM`8&9gP@uAb#`}c{=7$ z-@i%+MAduuZ(62N5Rp84fE{@zu@QnOMkWa2ZCoy=xi)M8-*;?gGO8_g?*m`BLZnUp zjXE}yN@&EfnUw8vkIl@vQ3!V!%2FT2jrOX-HROZ1(9Gb^PZ%Y7GtV6$(XJHH(5`i| z2bX9SF1&TcI_K!0v-!in;E;|=wPtkbtGu)cxVY9;1K0A$n5@@z^-O0f{Y z02L6n90wT#UdA&st^|EGh**aGyMQu)8EIz%^z9jP-ZJuekQY&YGLwSzO(WTzMnV2v zBiWsbuv{>_r@2~oKY(!Xwt0EwaK!Pg^U{VnQiTN7(HW|v4^+o(P#r^XzX|u-asMvv zciE#i|Ht0^_@mfL`WRpyARVv>@B|IadHw;$P6iw-7M#$`8oKQK>M zD@p0lG4FET7YHK5ja1Kmgtdj$E{@@JIQdXIoP3aWIC+2VaPpq&W=iNgpS&ZTPmaaD zJ~(1qoVgyO<{^ceEz17)4G5?E%kC%VO~)O|m-8m_KwCL4g`S_xftr=`?&4u`ZpwLP zguT6dmB~-iE0d^D&g;ShedN3Zo}8SWa$YRLL_bwY-)zuUQQOl2;8*#16r+BJn$)lH zgVen!^+AM1YWd0C6h65~&U+UDUoQE{*G2l@uSfd7(j)%aAlbDRVa7k96CvlJ2~wel zktq1{IuXtVh%fTTKO*vkIqpaNR)2i77VjL2_|^V+e3c8Xw}Ekv9*AG;kJr-2@ne-A zM!Xnn><%3@D<>{faWWqg7EAnTnV~qP>r~USKw6w0DahO5}CIhAd8mV4{ zN?{FABaZ@;2C0!-2=zZmjeLF`%KqP~kw>Y@OI9PdQR)V$k!VUU)JPq4hWu10HBxac zsS$dPui^+5!_~+>e|(S{+3t@IQX}jA@j+@N&mSM8MrI>ksF6nyA~n+XEY!$I-0)Y` z3Ne(f_%<5t!&>O7!5cSI5XJ~T3Ed?Z&}S7Edsj=+_&;HH;h!aG#M6@W$Qo>J$cG0I zgz6TOc1E73C$g8i%XEW~Z>+pSU#pb!no~{MSE}Wuby5DITJJwz#A#=%bOB$##4WnM zINGm`VQ*;DI$jg^kIL>hk(7C;>UuA*@!cMOqUV}Hr=y#RxKek~`OtlcviQ&)ONq5t zkactiAx@whPU!Z+tqmAVUc4)9U;4!>zTh_Yxavhvd2l-Tf&dwawQ z4jkzO4m87UBRN1wTp|Yyo>4h(4K0M{Qwag2i$iuh5$O(kuDyYb&9byk<9QfyrS9!I z=|)vBl(P7QpG1ib!oLP_g7jlogY-DuHj;Eg;^L&EiPrOp%6ZSyJTRY12u=DDdTtg7oh@g7m9!+ep$0i4deq8+u6<=P>DMfk{tWOnN%O zelJ?e1mGrr(f;`r9cQTsGOH=0`(rk ztDYjML!>&Ho*NX&XvCGex8iX~MbeY9_!!!W5*rvAgE+y^@(y6=Z{dw*C?Ro?^JE(N zT9BMK4QR1^sv)4Qi9;r6MMfP)&kY);58_JQn{?I~HB3v&;?ppEG2NhHPJ*R^HUHNh ztT}?)Mz%FVq7kgQRL`fJHw?J3e5$4%fA|>Gm7W{;6Nk7`_xkhk=O^m)KK^`%JH6?M zm&)ap`w=Jjliv>fDZ*_d`9nxFkUvWPM#|)&U+%1=!1-9^ zLGPL4#V79c@hMyMjB?rIhJeM3M8>xN7&QlN9bR5Ki5h~|_W9;HoSZt6@}8y+Y|F1&TsR!He$poz<@WFlsKIW?*5%JCp1VbMY zQTeE`RVgSa@Q8?+bnlnI?Ku8eJFSjdgb6Kz`d*-K65IUF{~c!f-m?EBPWs05g}%fj zi|cpOd8Uze>_afb}ooEP_pvbj!=| zcW#!XnCB%ae}g2=e?gMo!#%;r2!Hbz0Zm_&BmyuI$H(E!2ibEwH9F%=45*U%P$fA~B??r@YTWO`WTqT&2yhtiCEy640#F4w0XPLX z4X6g3#l%MfL;#`yu@l0!tkbr!);{0SRTJ*KE|oP)HIF&(2ifPw!-057?}pJwQ&xO| zPM|Iz;tgZaB#JX?rxBb>%b)?^*`5E2>~8!4FR_0rTi}h_!>>qFC@TA z;$9yh-B9i&QO&lExwWDP+9L|3$#x_W0QE`4(}d?saII&@9?+>^uA(&l1Yw zQzP3cvB7lSh&VyUWU7q(07e~r;cwzm-B|Z5B&w^O*5c-N?Up9OO zw(_}e!bAF?VHf)5V#nM%H}H1E=hk)ajB9LeT@PGkcQjJ5d@4J@+!3~Nb5h(YX3BnE z@CP0`ldjagn)6~q6KNAxdBns9`nY}veTz!)nTA^_ufcR)gE+yOlsK@)joXH?hEVan z1D8xoHMi4J&28FJOvhDHx|iwY8oS;q%Hrz?xs=$@g61Gju&F0jchrY)+b}j! z-RD~ZBHCBrInhp6AMNov?G#J2S7H{;JXBUa+OMV-vzwk9X#WS|O5J&SxklQbrYt_% z-IUls`vSxX+WWKs?T_HLVYE}-+5%K_?KAJPy93qhp-1&d8AGJ}hUu=6l;emib?2Oq zlrqZVBjs&MY#?Pb;shzvn}d{RaN96asBV3&?S86`wxHjJwYIzI#zT+mku!?O;q!Zg zWD=04)SYoYa%yPa>m$dDJ0m%tB2JLA7KR<|YOj4sQp*tAFscZJU;%~6?p&(gLyziF z#04~ko*O8#BCgcE_#4t^D>RH0s#_P(`^YT>6ej2W zgKj+ZxE?uNK;ke$@u>vex1NPOrEbUh$eBz<`p6kai4Ek?A=ZMNv#@+rI#91+YWho^NA|-2~Ame6`;hohm z8mLl@hCV_ZahT?ND7qg0_oJ`q)BHW$km3iE?|ksQ)BGRt?o;q;@t-JP!2Emx?&
p&4TROM!L-ZDI#5~Pa9phYw$=EqpZFA=;n!7JoxjE&S!%1twgRY9^2Yg8{@p4Owike3Cg$AxToOZ#Z6E%r4sC- zm+tr+kj~Xsuf+pDEyDI}L2<@8U=7($J`>X$U_0q^z)yX)({L1^mI>PlU;f4io)C7` zb(Zt~i9l}MM(7=UnvsWd;6{=2p66kD^AL+yJS=sVq%@e&F}TW0pWtyfQ8;fN4^QS{ zIzAmbrw_&7i?BwcHW`vv+)Omyjt82a)QR`pNO49QucAmFjgh$1<)zd3i_b=S1W(lp zVI$Gk%}0Vh$1p(~HZau@U5@_3Vs`WdjzmwCpl2bb3PcM{6^IU+DsURyWThEtun`T9 zlNlv+y^n@eiZjwMjv{?DB;(FV!%c`2ZSDnx)Xw<9Tlh4|xK5vB{0&VI+rHxQ2yIKw zYsLeya$YzOG{^TJW7#1 zEbhmhkyrEyAi=Bc2&uQ=hhrf>m55*fCV3rjZ@^@g+7yvSOn!!?QxB7`DAI=sZO$=b z@($tzCO4u`bsKJt{D5Vek7xrHPpdhIG-5HE;*9*bmm+;wko(+-#m$HlSZqQ_y&gXr zKRO`j;|Gk&X1F(CvPwN8)yL#0#ThaAh$4NMypKC0Ca@GVOxhDB>v3!32kb#Nq77I) z?M)A6M&?vez5mNVe2XSwa64>Ia$bkeBjwieV8Sd({70n+lZvWd#Ji8` zV{jwOXU5Y&afPP}B!{RCJV_UrZ+=kG@;69y()b9p#8DL>HC3@)=9Z z9NeINO8Amqk>bL(M3i#~+p_ovQ1QI8?0yQ79_uD%O8_^ka03o+#G(OSh#JJKQE+8v zfX-Nas7;9j*)T>M$c!?uG)N#V8FClz}LN{>iKzUYAo$}0UQ9M|WkL!#L zT8WD({4ZrWjcGrZm}4w`(YXXjaiyzBu zargpQEW%O9gTkx9MNR>$cGaD8M6yzK121+f%iN03J| zYw)j5wpT`XRV>>|lOuB0u9HfWqv)bMjoAQ(l&x%NXT?$^@WU6ns~OIkUVjGPe01RB zdev-Hgks%>+i=_xzEMg_1a9MSi?l=ImE}-^>+c}20)UdR!xkxWdj&8ZCB*jUN>%Ai=Gz55PF*kW{DYaB#_AYsEMF8zp z^7htax={d8-i`>M;yQ0@1W4WJn0$;@TROuIkrEvU1E)rxdu;M zMUd@Xzp0X2y0FexB6a%)R&+ZVS1nM`eva?bt;NG*uii0BWbsR zq!9RPWfm&7)%Y4Ly}HsCxUqB0atLcbd00%Byq#R7_%wZ?xt5M5lY>Sg6FnN8fltV} z;E9r0asnDlB1_3Y;&z_Vbk^vhu}HvD68s-yk4W0%z4c$j0&gFd+!0@yO`)&M)-Gz7 z%H&k@=$_6vM2~Q^NM-lpQ`0HEalpO)W-4Jg2hGVlpK4CdFjuFiqHylgAv{oPaz_kv zhsIyoS{rf^=IHG;xpt#b7n*;PU6r6S zl{HN@TlUI%^qt65)+W_#D|3FSeuz7N!gu`%ovQkG-0?;w=S`)cH6CYIB`-FWq0FV+ zy(^58mxzlU^-|JX$puY=HfR73NbYCZ^)rcQG~S*uK~*3MW!4>F&Oq@f349z( zihp5~Lb|Xr*SC>xOB=dL6%p7Y5sU3so3USF7sC7OOyQd z1kL}XkB=5tVW8VV-{HQl+!;f>Ac3TP#H_1@ePC=-UsHWg^PvOp)s@p7S1Z@!a%N~m zI6hu)DNNjbpc;Ct9F1ff8{gerk{+1^tD9P*WgqoiZjaas6aS-qlRme$3d4=;$>HUd zgH*qn3yTG<0EfvhoQ_7k8;y7uIx)~JNl%sw;#@`8M)QE z)J#9s(}%kQdt3;8_%rFl7Qyogaok$G-d67+Mi_Fue{pOz*4%GWV zU;Z@xM!BE`9q4;RGAKn><1afmx0;d8!dvY1&q zCgU+hn-024@Nu0SX3c?NWiHEtwSyrzM`R_F#S&{OQ>@FFEr(1R+`**DW42|?nrA+c z-j-RHX(o$h8B7+W%QKgxsbXT6Nod_9nhZ->oLHiFLu;%O##kOFYH?!Oftn>IKC$Rx zZ@wkc-t71d_Hb$Ads0~K`@ov)uTc@0=m76FnEsrRI^(maG|@?5!f+46M2r_kTSGDB z(HZ5gqjT#|J0e)A_fg Jj+_V@h~|li$16rna4<3v5+{){EQOH}#g$RS{{vM! BqlEwf literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_fullinfo.obj b/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_fullinfo.obj new file mode 100644 index 0000000000000000000000000000000000000000..4c58b30d2482c1337734975f53b43e289a2ea7d0 GIT binary patch literal 2992 zcmb_eZ)h837=P|^NyD5?S6rsEgMJV!6hmXBY*S~lH0yMfW=UEd%XXx>OM7zp!{rU@ zhOm_wOt=m9p_3sK`a#9PKn0;y1k)+V6cMVQ9LP4SES%s6AyDazzc;2LLqF6UxpZ`j|m{3CL@sOwrbo%5xr zvXh8*gmQ{HrY4R4(BNSIh;L+wDu;;fc1UiP`+`*2M^r!l!J|R{eJU~hZ=uCh-Zx8? z{mA|8CtvQpYOb$s$pbvb_>NZOU>F%$`oCjwwYAUrg2(q zE-61rwwIJCikjv^?cAff);gXxzD2;Ou>#i_Ywyt`o$t}ibc&tM+r3P37A?Z&rI)ct zcF$hMerm71jpzRFiiWUGymvjl)&3)+U8qJj*{b0)VBuZtsjaZ2ayWji7ux?9@y|XV zh6vt}JN;g8fQMcmAg3G;zZ9236Qg0+qrrGk;(xBuvFOBPM3N82Vh(^VchOa^D2UXu zh$QEx)#WC7!$q#9qbbsPKkbrb-n#L9f)z~`btbdqG}<-o3~V}H)|fn_GP$6gQHd_@ zA`*H6?WE1g;(LZF@GOe-FTTayqChlh{&F-n^7HK?M?(?TH@_YUMZ<{uk;i?8xaAFQeFUo!*e=4e#>ZDNHpe$g z>%E@W7GO6YyD$e`p99|ky|}dp7yym{SAh3`CE!!w2gH1Z>$kvd;8!3GoaHur_i!~M z?)f`s&ulzi_15?D@tjmWQ1`(quNI}@nkAZI)m7(@!CbrzM}X}xV}0dSw#^Ln-31F- z;&2Tizr*w_MS4KQ$vsPld#l~`HJF%E4|Boykk!)&JSZ?{>C2|&{Fqk>(JKf6Uw7l6 zBrvxbl1epqoAaH&To1q{GN&0GupCH5&IRtc$+mMnT@X^PLF^67$ty_JZYz&x2KY1Q zyh!<`Sv_E#@GJ#(S6$X5g!EOt);JVC?6~1r!M)%YF65E55AsCMLalU5z}-QNB+sSm zr8@%R_h97qTv{pJ7VrQMsJp@1wR{h=;Bw`Y$B&)3E)l(XjMi9OSepZ00nP!h0u|sq qa1mGlE(2G9Mc^&qUEmt z_c_mfpXYtgJ-6>}A{$Ce4YPjU-B!27WpaBv3@)=k7XJzHaU4pmNOu7pQ zAxkTr7Gbksau-*YloXejmaik-8bTufpBDl}8q&RyklW2)uh5ju$_+0cpPtX`D&0-G zH{slSJ8xFJJfFEtDVtn}ldoq#t=U?+$x!2V?sA*##no1u;4x_JttPkGWD(p>L!G9o zxZdltSe=Hlb*1YJR)^Wug&1`TC5H)Bi)`P-Mny8yI^OGHA%)T z3uiRioaPKGM@ExPvNMx;dc5uo=ZTC~$1X-%oAmRoh5ISE-417_6U7x~-koVuuf=9< z%`mCa(T1xf!MTb=$fwyPJHaL70Qkx`+g(PV8Gj_lh})^z)j>$lYC>dBrRL!W4)zG! z8yr4+tKh~D9n$k0B33_)@S0j}f>CfFT<~0Az?BGGo&uVkt`4Ke*E&Ua5ViHJ!FW+x z++nf{mKhX5<9eP!RACAwC6ppD+N>V$dWLxxF)LCSCVhrO0xhEmDnd{}3Y11v#KLJD zEIccjgA9}=Dg8m;W4s&PJ0d4@_}7i@A>zOMLn?d}0w3ca#?d{D&+Q-SM)wdkhkwX~ z$`Lb{e+WYN5cFvO9_Dz2e+Zf-DcwKhr&LBrJ>RJJpBaZ3JWve>tCaK<_B^S9fe7n9 z7!8EHInaOmGj`FSq=DhCMJMkk5{cU)-f1|MgGbfyztI%>qpo0sQgP}DjMY6HtXE9{ zK1UtfTLlIs<*r@)vxD=G5O`6E_Z4}^qug&?1O|h8xs*d7c@9ELQnEy-!RY6SDO$N2&HB1-`NV3v3tws5uAD@x59B%~m zaY@vy#F+`}T{cof4(2fDGXs)@Yg`ZzbtT@>{Z(H8^lIOt>QaNdVsF;L4m zXk*-HO1Cc#+OfRj_qYizhO+r-*;crQ5%uVvwZPcwV5F(!0u1`Y(}*QfpyUcZRDHSq zGUy`eJDxRo69)0=m(q~BICqY_1KNl>=KcxvlVTz4Rfw;GHXbcTXR|BCmROV%S#rs2 zKdQq*Oa7v_@M}w$lAd}V?!ehb|C#uNW|6|TctW$7`f?)Q{FO*VtAm|N+8BIWNh7|$ z6A3sQIM+p?FIoyz$(lzUZZFR3&4(-8RVX?fxY|h}99;?*G1c%?e9!f~Ub5qzsZz39 z*4Fc)b`pH~fr(D49_q@G(uuwaL)dNci}wf^CK&9KAKTb10#sVWdJ%w zE$Eg-To~Bd+!D?w$sWULjc{4i$1%Ut_%cFDE+lHlRS9&|AEKZeSKr^e3KZa)EE)2L z6dM1a94qjhzmLL2Dcbo9gcI!VED^OaY>>dPFR8!-dIjiWa8H#G7xmqgvwp!Yiu(s> zu!&-U)bYL5@FY}DmRu0^W1t_y_CUe9Nv^MkpH{1jiDiCm3@40nAuiT7m`#X(K#qy{ z`xV%$>Ia?V&@1Fp(>fVdG8*@2~1q?a}~@*cJ* umUgLBT7^{F{76%>thrd$WZvY^QgUNCFTb&ammTfmvu+IWass%6l79dfgHNUa literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_jit_compile.obj b/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_jit_compile.obj new file mode 100644 index 0000000000000000000000000000000000000000..23b98ab06c5ab00983f747b68768330ee30cf8f9 GIT binary patch literal 108828 zcmcG134B!5_5aJvB$*@wGeCeKTfm@EP=TODgBl14VF`w8SOL=*0wk;^GoY0vafmQ^ zq@s0gOVx^7f7SxEvbZG-P5@CrETB?(0oO|CaA?Uw#etfu@H}9T% z?%D3S=bn4to2qe2+O^lt?C{?{udHJBlHv;cy)&1TRFv|cYerw2GJ>y0+)z|rW-lsP zyl_d`g3@bCl(jt-Md_Blcy{T8(&CE5^r1r&Z@Bh`;mX>HilY5|{Ax|VvC7(PMe)wq z+;?n72U_v<(&Sby0HxRQ->Jp+vZbZBkG`QOWhBu&4fu{n^%*-c{ic~Y6^rLq6faE7 z1V5ECGZx-eTv1XyyR>5Q%-pf#6Z7nj*=37oju?LJ@R?LRcU<&;D7QSI(Y4vut5$QOQEsQYA^02qi6Lh5_%w@FHATat|R4j~x-`u&K(W zY)5&L>&ZWx>q>h?@q)6si^6A}L@624>;-efi*)gV(qe~wad?p~saU+EZ1w^|nj?jp z^|OV#xH#-67gpZ0kf{u#>Pst@g8ik$d-#kLT9V9%52vGI0r{n{>ZoL{qilAVS--11 z{H!mUzi3&QN9W?Z%I_+!EG6b|lQuu$=iB^((vjiS(2|PEd3Hh>K9eU8x@7U@+!x!G&y*SL`EL&7OJM0Ep zIdXRCobda+#U=CEIfrk|!$6mmR)m?<%6X*=78EZj3$Fm+Ns24)T@>cPnf#Nzv?9zN zO1M(uKYXeJ&e3 zv!r+t2N2=o9t$vbdEr~v%${8;79ru&IZ%>@!bf8X(lR_K!zajPi^A%Zun!|e>JkGqtU}cn-r*DKeEY)xgJq3W z)o2nx_-K__M}}9dOBOF7v-&?FbyRpsrKFRL@WW?TWK;G^jvfkSK4D~sr}g#B&! z;vkunnIQ?z3opTrB^>^TZyK#fm>XBa$%| zh5tkV?Y85%Mc5ptpc9i_*fm7cC?O5c>W}F}w7w{eTf>aA5{Fev=7pX6*$c|<3Nz9o zcqpOzFp88$QrJam*Tdhij-@hA$c1MbV%0AwTUci2X(&7~6C+)CR|&1u!fg3PiyRBW zxJk&A79q3=H}?peb=`;2Nc|E`mvdL@e>(pZVY=|o>|^9CHtIjYf*cV71XAmN6|>MJ z*zv$z7U-a3ZDBZjX9Ozcv1BE(C_m%&d{g>u<1=tQer*0&6a9%AKOy(Ff*e!PxV$_g zit=QP^3vGx5lVzXQJ#oaUdmETk>YBM5^YwLP5qUGG(Is`R8hKc@zTt!r~=GB@Q55$RK@{UKfMRS-eEheW_YOV5ha^j)hAYbG%|rL$I)*Xjz$kUJ=$C zVENul=%7rrf(`~L{Vt{lN|;@=w0MC7ss&7^QY)cuQQ0X`bM#uP5}QV9rT#!qf3l>6 zG!kDKL`Me+i*V$$cws5Np}u-MEU7<}k}~@H>nlp< z1TY1_7JxA7NJmpqTH+wX3_$EPD4Q-P-epH~ipv%h6_;R7%^n1GGrH@kbcJCP6BrjI zpcrJFz>w($c`qz3TeM&?Gz_DzxEB@1NI|~{GhickJ77$uvzZapzlUxIVJuaY+8tnw zRYhlR%dqxdSZpsL9$k<@Zy2ynnj{`IUzh|rBtMP}E6aWj6;=O6QGOStM70~+4a&MJ zBf1um`@xA_ah_DM=-+8jE4_>Kub2>u9Sgv3@m)9qtHk>&93`_sddcF7*_BF^y@8I1!y;#Jw=gB1Z}SE6PLt6(u6xUm0|~`RSwx9BzK-GSqhqsV~J5 z*eT;KQAyH$I-M&Apk<(2!b~b7ZS4~Pi2&#wf|>yA7`3JLreF}MNkReH!~ZgGUkQ+b zz|t%2A`l`Z5#Amw3<5-g4pCfLiBq9GEitZShFKe@C{H=);2dIDrNg(uO4WHK8MB6R z75%xI{tTr*!|2a7^ha3>Zl5;5)n7yi(+U6x8UUA|6!qW(^_Qd*wI&nTdB%j^YU&-` z%9Zkna-1^9zh~*5yS!cPNf)_%&%J*AdWOvrU-Js57dUqvRliryrk<&YbhbxSMyJ$! z|9}Q+Pt1Nw%?FP7x+zJfX$-H9PcmmcOZP>s@q4ukeLHjT^6$3UaM4aj-xc*}%_k01 zO1*D-xoMt~s3?V!Bvo?_ORD+WVNu-z5-=&MDM@|Tm2PsSo7Fs%@q1ULg+7mHw*pm7 zy**BSSBu9bV53o?x?Me-yOL)W-8sX(K2QBHYK<%*ha5^GzysO(#A8oG0y z0tR!07$NBagk^xQ_dF#HdOwgWI!6Vgk91Xp~pv@=t95vkr`p2oQb(v|YtxLNPz2LgfrhaSmxmK85_Ulc) zIMpo_dtb&~b%q(L*;MzIS&2|?t3CydwX6SIo;FVzt|)na zEkQ-3z7@`I%@H?~f>Str-rR-7J z1Y9|0SC&Ow*L+|%y2e?a1s+9hG`f9VB5o!Uas7^Kh0+L8K<_;!0WBm9f`x`jhe!WE zgjbi|s@kq%Q&(>{o%zIgRE?|IQVKOs(|EJ*Ek#Fb&Z3n zK%eXcwB}e`!j8G24P&5}nq`ZaY!fmLpi?KC(8tZH*?Bg?af8~0x#DqyK8GHtvrIhb zO+C1@-&K($L|sR2X|h5!!CVWQ-8Kclp(AOAyL?KylE?i!cUhp09^1$s1(YjY+0d*s zMdTYc+6t4KdgdFN2H-lW@T#V3@R?G0byER8OA3cJEks=<%6%xcg@ZOeTR5!g)xyEg zMHgOk!df`^#Hf73iLodX@(s_;FC6yVYTSPo*INpcPi)0!L*Z2?j^rDkH|5tyoa~x! zJlQMX@O;0*tDm1(IPBz1d|!l8hw>!Kb10ip8UgcO;ngRP&En? zcKmBhPZl4e=|k;efoh;~tMobKP;FN4?1vHCRduUY{f zc5>4r0LYK6U$0p&w725|R9Z1$;+(%S|KQ9rN5B}}xJTbF;JbmoV?>Zw>j$@eLCt}y ztUlLjRg`5``f|Xz(;R`pw9|KGkcq(a#5NjfQo^|Is^;|r!|DAn=$!Rt=}8%9Vld9= zPI3Ch-4SOZ;Yt)y$`PNVblHfbGwCg@o zOL~mW(FX(2UE9mKvn^LWqE1ONYb(LE+Uo0$Y2`>Q29>j+O`AmIwW@u6^J}}V-lJ^z zz0zbZ9Mp7q;ozp>D5Fsp!@I3S*?{XUC~v{DU0yio#4?lyc()JpBTgJeIfil^r3pnt z`3j{OWb~B%&mtB%=(=k9gtg{CdL+Bl7EwFFaLv zop4fS$6!QGHcXHhms4;7u@61qnr4RVZECCww|wc4SyYxI0d?`}5$BgC%vPw5=jwQ0 z66Dv_dDh@CZPI*(P2RQ96EXp|)1-DCy4PiOHkzCsVrLt; z6T+sUyIrw98>Tx7z|t+w2Gh_6mqG0d=e8M!!^WOH+?73wSaa@5kaIT;9`z%A;`*gJ zt4%#I3!@4~s-9IpR-1QVL@KIB+kd{j9qz=WM)|BBB{I#KIXrT0LYix|2%`M(&h}o8 z7<~{WI@^0M$2T#4y7NeB)NXI{4-_7;Q8Y$;U3jRP)TtJTD^4FWa)3K`wW0@CcB`wP z4eocT4ho%VA#_T zQZw3W>Q_diiSYxUA>{)^m>F%(R>R8Z?c{)QYmf1)>Yh+HJwiK-Q3%GPRipQpWYn&I^W>mfD`<=*G?*)H^Rk;6|6Reu$bD0!Z@%fG&)}z8*zQ z6So^aH&*SfukCU(Kw=L91!$Wj0T@riXU3{M^|d{b5L9CKqElk+tYPJ40tfZYIL4!` zM@d47--dZWais&Y)p^#qvWr^K>fHH5!{-L$0d=PFo1% znkK>f8xOb&;7-gpD~Om@-dNi+6}YN)Zd0?(kn*QLkWB0*)#%Hb*NSeoE0EicK7c{3 z9TTsty&B4KpmzsEtH}0Xy`mgtOKgyhlbA##@%W| zM@I9872T<9NL8LQ6b^rGcYeL;WJzcQpqaEL-a^GM|Fh>T_|pa73w-$3$eC5zI`^a?LueI@;6~t&n(4 ziz}lU!Tkrm;aKcBdN?mc*<+m-;_Q*m3l_egP_9f@Gn$cZ!g5DFtY)0ne%%eI4Ob>dI&%4=}6M`9-s{wAI?uXol$Q z5ffS(P53+EjECHvJ@1SMA(w*XUZcr3gd|&UA8^LgO!s>6?7nJM94yLtwraU?g3kyr z^?m1OR_EC`M^_0KRsH@Zz>9CxL&m=i_M8^C%|1ZQusK^-t?H&0*eI}wnNa;Mb?X~R z-Cfh-PPF%Mmf8lY*|v%H0eWT6mc|G>I_uKXXn;Z+4csl<4E&F_xdromMzfmTjQEwp zg3o~uMxW8V*4B>u1#J<(9u8*hF#z#Ie2;s?vG_KJAPA_{xD%Z_rVx?6m|h!oYTDxT z8MaiT<=Sp^7Y?o9G@^<~lK1$QMw`Q?W}mKo2;1i5NY>hX*VSg9hS$NgGlbDVX0}NV zGxvQE5o$rR$I#%5;_rumMTp&T8R0V5K1PUq2K8{&&U&*g&HE{fkrZNG4PZq*T>Uwz z0yb-@K1V{f)>PB|Yzj#eq<%1PSwE3g<}{zN%3LM&($#s=D!Kq}-{sKTNo&JdQW zrxs0HGL#M1C{1S(y~LpmL>UTSu?v2p3(69dT9oxDhf$8@8-&}i!K9K%MbWhdHpo4J zY$Ik43}=qZ?29F3Mnd#1o4Cqo_95bHPLrdt5IGjdhjR)ig64&mo%;W<`IXtfWzr2dnAwAV}ZbEsz+&0t1=JQ`RgrEQp}Vh zh2|Tw18X)C>ACNvLyhwF@+eW%S(HbahlmPhsQW)RT;H_3LRWShtC*%_3nIGfT6VFd zb8@%S`d0NYFLpe=Ryb{KQS)stcrxV6=x)ffZm!wnwg3_@BHyd@7#Uz7+#5wJSHF|4)O0 zjxpuE9)M(awjI?_hTrUliWr6LzXu>ZiU+nFgDb)pL&j%P-}ObZ-C!hRIbk19L*rIw zYuu`vQa-3%Pd4s6XIefaC!i~j_BcB+>*~2=KvCYUaEjg;xOQcr$@Vyu_GLd^3DQgST}Oz@9I8e`We<2 z)!vF)4>s;#`k2a0o8R&oHovyk%!4o#T{i(mDXc^9#XD|K}h^egRZhq zYn%V=Z$%-sM_I#;)~0%-qXkTzfFY-Nk4IUH@N1GIS?|^&x~0k)9s5)^3{slbAzAVW z$_4m{`6x*Bp4g2rq6P&ahj0}MAP?^IBJyqybPWf(#s?paX&{KYR_(F?2ps5I8nP68 zBfQ|~8_VxY4%>f#rOTwQwDT4~tE(y)!h zAoN|^!MT1jOj>P08zOBpq9-r5 zd6ZO-<0b@ssRtb?<&@RHPK`7kx3)ac`i+ZQzl2*zIV_)qW#Xy~L6mw}iwjV+1`rn^ zy;2WPjJ|Sm@d0{#cLa0hW*5Y({c#=H`a+LljJ_*^aS-!hhNoL+puIs(%mJBFXhSo! zF4Kj%ZX{9=<6PeBtol|vBR8#-#+u8oB%r-$Rgnx4Y@GBNy9Ay5vl-eAUTCrbh z|6t$5daT!_))u6S@5Gc(oj#3v>QsF{&?7cd(cwM;L5x9Eeai#kg5 zp+M90OLH_o0M#EI2ywTm%7#d#39Ag@4*F5B6CdbHmwq5gLBqO(QHLnt2zvz<##5ar z;IxPqNETJP0yq;i2$CTM3}nLG+PeWjioy^dKmpmfBEK;>STv=99&6&$U;V)Zc17xrH2`}%yrGeRpGD84J?V&8yNsz**3 zi8Nuf@+^Ycp_S$pEU0q>rrgLbg5~ibDmj-`ek+_nK`TW4lBgxM+NJGfw+avM)^>l( zQv_8`7vyG?4;0wNoXpdxTYEYHcOB-?;WC>6e?>k4X)xWpYfA%=@Kp&B zbq_+R&ek5*2Oq#i^(nsJ-eq|#v`jdi-$v7_JCE}E(e}7W_U@DH36tyte3v7V%Qm~R z&AvX?x5S0bx;4Y>$}sz)t#4!L566{#8Yzq3h)2yi!skJR8{l%hXV4jD7S!g_oRf`p zJHoBZ7Pr+t79Nk%FD>q7`}H&(Q)=^FWG{qzf#Gox62wAgs^Wc_=>EbAVpBfwD0TjB z`#9SvKiE$B!FCJqp`XaNXw*0x&nX+Cl;=n1*GCI~fOLG6bxi_rv?sl3OT+eMLN^=5wd6U1OzC|bRVRv6G^sMJ-Ib!(uB=*ceTikk&|9l?(Xf`2;z z@9$!)Xd)$i2byqB%szlJt$pMawu7vhSowrPnCs~aYjmO*q^bO~3;*|A3D7NjlBsKXGQl%?*k{*3L^8*h)BXdgS# zzQX$|TAXPl7u(U^-os??eVoLaZDW@+jTET9pF^b21f#wcXqbkE{dq)Z!4P{;9h!)2 zFlp6yyY35kK`7lpe``d=7h@B_J3tg|NuZ6&ZAh|}&T|BR4)EwkNOZ4&PYb|PB0xweJ=k_X|H?0(8v)Uo zc+Q{l6WU8h0`bJ+nkZdCl-?t7BAS0FfRKz#n&q|r!GOS19}9m9Abt~|QUa7?4;~K0 zy|yd>`Y?lnaqk1T3g)Gk=$b;8C9>bE{QU+G!m9)}0-PX6AXdv4kHClk+`!rbbSZpo z0xuU{WFN`P4dFKs(Np%H{aThXT!>de-A`O$d?=y)Ky?zo1nTh~>?>g zo7Yn>fs+q3TgD?on6w;QV>keS1PFGHv2RNeA2JA|gsnS<@g6bH|8m9j$QOP)&xXN@ zCCFdBgUEOKb_B^nMawgub>uv?5`mw&1tgq z;k;?)y#qHcLiJ1l71eu`vK=_LM(gv-1E|ut#zcv36Nq!!IKeNNvaa4p@HE*I$u#*h z$q1@!6k5sI7YgyLc028PM7SRS{D4Iq-f8qV70KLdeeKbfxjy;y^iZLNq; zsfWFFLlBKjSL`+{KNW8xXixpr(VcE)oAtZ;L>NPk0ekZ@bMMMNjgZH>ZZ%qB-Lq;H zr3oXkmxmLK=PiyKkyLMN_}tWm1QNFs66O>wLR}%@-yUa`$e{mu7G>Qwz$&z`xVv1b z-cKz_C^%Mhnj2A^JVUgL=9RPWZp7`}$agDse-mvbUN1+&HNe4V0rCiezvIh75Ma|q zAV3U-G{9-+Ig6u*m6jLR|A;ycOKR^^V2|1vtN=0B445Pa!0%QG`=+vp_5UU%wF> z(FjS2(LQYRA|&FtRE9*U0jPhnP*c&#A<_|InNg&|>k!~MurA7_)er0qxM(aI0u5=j zd6XN`@OQY9H04rUID|5-Xa?6ro=$s+9TQt{1>d2pMjN>27!Vtb0+tpB+B2Ur{bbOY zO#Ce!kc|%@L%4#7(i|Gc{wja~i5BoBHy8gyJ-h^F-{VotdMFcmxQq0Fpf`osyq29h z>5tB%Rjq*j+O|-;M+5Cfh;~;~JLs>7^mm7pRkE%>RKmH4fcTkz`t|p3+(uHd6ZI_* z08w1+QEH$C53Wdkd8EFntOwx+hSMm3*V;=_C-tSJ2insrlsZYgNYw)b5NX1}J@^)N zP(?jEAJ!|*@32i@LHeL8vEHNJAdo}H{7Svr&rwIky%GR|;=qwqoIZqb$jrY8kyBZ(p>Nk2UQ&P>(JK;sXM**3haYxGzTl^n3&y zx*nP^@7nZ0?LSf5iS+Ickn%bp{Gn))uf*LGub z-AjQl=K*mZ90B=$9rBPCi9Wrrkp#@;UGfOa<``KkwhNRkaatB~yWWTVI0j;g96ycI zh3L?N4)xAvpflfme}vOdqM)D=DKn4OE>f7ZXPJSJB_2&}pcVAK3x9=viQ-;Bg2|tN z5(!lwidN!vRQvf9!fTY{3&d~g=MZ7q3{W~ZXIhS0JEPKM10eW&{%B4k` zzHuPVwNk-&QhzW%gxkU%>JJ)9oi zHb@^IsCKqf+jeT(*w%0gXI9gUt*#Zex2Z?8ZKt;F)VA>qSC0==;~W(|*f5w62uH5E zj1LI6;eaq9*^PXEV}^y%Br`$`kdOU4hkP(mDs zdwm1(CC%PPO{bh|cQ`SUk_^Vk)dyPc^g7SQTG!C=miDAai+_R4Jc?Kzyl?|@g{NlaN1Q4~DMcwmS%`8s ziUZ|dlocq|C^aZ99Gl*+Cm7HFq6Ya`Zyowmi4c1qJusAF8U&gb6U_-sZU;IGP(zH{ z1xMw!@}88dqpYcI+U9Q1Gn=M4cS{egA9a)@8#spZXunR%i$?=kJ9CuaA+q0McU%`4 z?K}On$o2vX(>`+GL8sNTZQ64XzV|Pvq+{@sINBM&h_U4INq9O3PX|xDYXEg=DNw}N zxfE_gO|TRa%KHaNp-+$$`f8U^N0fvSBiJt>vYP}=L(bhx3n1ns8|z5;B_7`3qy(F@ z-Y=k+^2G8X7jbeqxvkBEw7(;n;iV)DdBBUH=*ac7%`w`81Vy1@`S9}VFM>*8s1aHj zpnUd=sxcbjA+y`6KchVpZP__MO}z+;qTwK@X#|yg5!C2VsG$TEI$PjrJ~?W!MQOKU zixN9-=VP$rc0QJ$CZ2)Q>a|V`L50q_@qtxryrLC7y)X)CjU%$XI7@HZ>z~ki^I3ZJ za75nl-09+RQ+j%owoBaWdGp&@Z*?ATeiq}OP88Z2(`ZtyYD}}W<6mQ1JpQht2X>}C zV?%|rwcT+UFHG~Sf0{uL7nzb8S}$`Rk9d}y~D$jWaCj$2>uqkpf77{bjdl zo`aIYD4&^f0BaM1V&|as=SA)DtRS_2;HTOwH zS&$6ieSKzPgW)Z;vx6N)DfNic@LbSx8`f|VP(+OJ)KTJJ85A9UtCd%3m7OReqgwEC?v`$9_KVsAYBx!=Q_s7yHBjWrZraW%uMCZ0n{v0u&-!8L(4*gVml?$6(H#HY~EX0LdzklGeamm?0?Z3OYiOJjp(8l6|Jn0ou3RK8%X6!o`2owI$TW#unr2FNtMcm9?Hgn z`So2+e1iwtWAlyA|2DtAE2k^Y-->}*E?SaB=@xK+EFi&Eu#YU@fX>oBvVbvw4zd7V zG~lchD;}W+9cWhbvTzKyJ5C??BRW};Zo}}3RddYhl zqaH$pXjUf;cV*$P4Z)Ae72(6H7)*Hefu8oh5v?$dh&IT`q@k!D5CC(Wrk`%-$A~{7 z`TGyJGkG}Wgi{2#?>yUUReUh5^nekWBL{*zXmS7_gNVXb9AoIBKZ@>MO*QYUjhJcy zq#klv@T4nY9``!`ylc@=Y;G8Vs@QTymbZH6=w06 z?X!HU^Sse92#2DvETt4B$arBt4@ElI+Jrl=(`|W*DvlF;eV6l7XMUO`>a7e%DKEz= zp&5_1W+y!yhO~PtP7T=_qfn`Aqd#7HBp>sVdYIJGm}aJ%P{>7k5pvFGb=_l8J@ojl z_P-4*@h(Bwe7BI$aT1iJP6um)pLOZ32QK`~N_!g1ruTBwW*ZLHCYte<4k(G9;-u%? z#lc~I3=#}NPv3bm&SSPYjZsANU$a^ii-JZ|F*XN(b*B4&SukS8gMml5U zHJcrN2830AuB0K>gmm@A8=c8=w&Se`QOu>`+`0%)$Rkp93{An^N;wZ;P0cpO#FS=mxjN;_1%QOkNZa9?_<7e@%InDWc=OW z8;rkC`TF7SAMtom#`*O=8~#4zi^bpH;VlOl=YP-2i?Y_x^DH#G{}NfWRr%uaB)8V` zHrocd^>+ZkPbj6+6H0izuHZa9!^w}=;hAJSKPR?{UP}{?A(gYg*0 z4Jhqovks;O7T{hEm?|Un<&c1xc&@9L-`h^1?2}66YAqoUZ>IHyY6*bo%oVp zr%B5<=ymveJgf7%nLc{F9z!3N*Q4ko^7UwZV7;>fQ-`Jcq|y!FD4~co6qae`xPKwD zxhi@a&6>V$WHh)29_*ef=!$o_WhR$4b`LoB_QA1lT1>v>ORB=UaA@N&k`3G^erOR|1Tyc2G>;RtkOG8jyXDdb;d zB);MgU>T6qDv2^gJUm%Z%qVkF9za=%azBa#y327#5eUD&iW`Mdh`s>S+zOklhkw82WZ}~ZZ+Iojn7p>afGpT*$S&uGum%(Y76Y; z-e+;&S?_XcQ5D0p?AJIogMGLcuf0?vS0Y(}uN8f=>;tm!z5p%8Ug%ran3)BADjO=5 zjcfAjdo=wGzG5rN>nLxdxKSEW-bLAuatP%J$|v~|&%K^sAAfQrUUYLK%10>wMEMNm z1d12sYn1O${*7`LSkuTI5#B2blSb7dw2057L;O~o;K5;J6K zJb(e`(O$x$o8Dm|-p>~c$*#E^^5HipVXZ@Nc%nDbWSUZ2tq;%!i*+l|yPW5&);07T za_z%!OyRuwK70uC#PBv4Bk(68BU@39;eIPhJg(KCH8Gg=0z!y{1Q9fI7UU32zyq7eEcLZZ+Oq1y1eJ zH`m|;i!^|esqkAnu#IC%(n<)+(bV(S2WYd-x-||*mtc)vqkWLmyTG39U5ne!hH9tR zP;n35i9(-CoZc9F58vH*sh}Az{GhY;iqmcIEdUV~C^ZiKSoo&LVBMMrPlR!0{Ma`I zi$HZEPgwqM`?Nu z9_3AxgDC$%fir1>GvVmu>}}`YBVzb@91vsOI@w^{<7|jBe&qclcp;7CPZK3&qH_qd z<@f4cai+AAF) z(|`$Z0)!?{ZlOH@I5vq8H7>#3fSj=HuJcT5A5`cg4MtvuheQyxu#w+?3;eAVJYFpj zWPt9Yr!vssN_4@#UFttQ?`^Fz17 z+A#&0@DeX|qQ$ruS$+UTd7oe{G!ca$j)8I+XspG!lQuD+F0iu1H1vIa%A+BQEMBcd zfhT{m!PQty$-qF7CeG>71b5Ev7~=2Wk44$gUpdtcF$10;Ifa+%of?iZ3S~6P7~M_e zb>5i?^F649LAGN<5$@V&@Ill~b@n=Bshe;d{x`QnsO{NJu+su@1ki;Hh7|%GlPcu;;EUMLQ86ITVew|AfGZnW zXY1R{7q) zU+lo{BIQ*l{*~MqG8aj(A(xR3>9o4=+CxnDlg-+GFKh}gl%77%g*OTp&7(z>Oi99t zsjYbVW~*8>PyGcDECRNt0FNjw-K-6H1y?=jjW7n^jjmBib$=zf?C33ejs6mN5tWI| z0z$2w0Eefus@V!&O-n%v zQaBU!qv|hc^-_JFmoI&-TXPLa+(Vr>RD!<^pT)-Qt!|)q*&?7@7Nh12v%VG|3xOY0 zKWg|g+WEyQ>uaQNOk1w$J${2NL7hZM`QFk_I z<}UP>(iv`1xuJ`4YH{I^Q_BmlIOQx%64AqSr7~LG>D;aOVr2`UK~zlYIa)AHO-X52 z(?`)$F^!-I^Fx2U4wpw)Zg~{uH!^Z4t_vQ>R9k(60Gs9L>j#lR74|wj+Ly?D;Z39j zFaU2H7C0n;m?k~iqIY1p+3Mt(h&p@e${V4P@@8sRy^PA?>NifeU9akeDn#tU4BpWW z0RmQFQRB!6;*($lM)(68dY_3WAYfUI+86)R-Y&Eb94)Xc;jJ-j5pB)D~JRkXw7)*5hd zAEdpbWq~xonOhq}^lAwEGX>flk~SW4AbD#~NwhP;tQ3=5i=`HYGc^OS_(r+<;ia=u zPHycRbP+OMUIGvrcTu|rhD#J^xn9uHsJ-!LV0%Z74?agBWOZ5*_vWoO^R6xT3ryhTx`Bpq{T;pDucnZe~B#C%I-@5v*?{2rRX9 z^v6Lb80kqv9&dl;v5%)PuyVon9cayROjM^Piuos42jDdVn_R?#F7iEiE=q0H5w8)5 z^99YLT~R(D3bISL_9VeW;19h7fe%y92g!RSRcQhhHZTRM7=bF;MS|Xkge;T}*OiOr z&RrJy5?EoA)6@Z&m7-Wks$0Zgl!4Q-vGt_>MkZSB0t^lIdE}=Akd))fuK?Dn`l>y& z)i1oJThq{I&}exM9oN(gH!uT(hE0J74G}m}5ZI_~f01HmGCv_dgBTv{iQU=@IJX)y zoGwZFli1<%lfL4Tr0?~0M*65w(!T>uJkWz^7Bq4Q!Q;0NI0qk5AP^rVc&>oQ|CcZ5 z1e1$vRtKmLh+LL+^>r+7DRyx>mxPYi|E&Kp89a+avAT4m9*6?8dyd-)C6T`uNNE~C zqc2z4!Qvm%Bo@ZjZM}ls!h!8~T95a+a*H579&r}2fz$ma` z(g!91JncugxojfIBQp)cSsoz}4ipIYi6&5dK&Vpdn^EQ605DJ^tTaSiue{B8FJUrv z#w&~|R9s8B-6h1e8FM(gyM(w>(G+Yh$1@8oF5~lhdIvv=kf2YVViwbhz7QB#XnGcV zJ;H_rY0}Q68NGd&YZ2)Ni65F%c1ZF6u_M5-VDVRp+E8}eVUy@l#|iN>LMi@i(S*cL z@pZ6Gk3=PQm4Ctw3=lA{90R_eB`C&HyJKROPtkfA&sVTw3g zbXxc<9IblvIXT3vK3vg8lCL! zHTp)I_Xu?M-^lz; z^AqXIbj`vUI##cmH3r*vX1JKZ+L@IDeuvXME2lTC0~QKA(z#=9lW{X|yTh9&fLuA? zPa;V5+Yih`s9U=1k7(v?4gfz%fi+%c@F_khZ+YXh+?Yq3A!M{oz@8HX)X^5Cdb@lW zBEESP!HSNh;eK@}1fV=N#0uXRwSKq5&1s_7?fx(R=IkZdg8P%Y@kj($>7$7oNyqcZ z>mhy4qgYyWE2*B2rU6;hL2x2f8!XPp5zGf0MzoMhqUgM*=$zaI(CfaEH?Hs^rqKS& zSA|IA;}00I&U3j$EXU;=q84K^z_6tH8LpBJ!r!Ol`RN^mbzTn;q&r$UyF9=(+lk7t z+*quX^)PX+Xh_eRl^X@2l8tQC1f(<<@(_`GfvV}ZXOSWnA}$8G2DlN{kEEz8BL*ZN zOQd7uU6hlDu|k-H6~c14LTD-Zlm-;ua(N6Nt>6Gjd<DZU?aUhmBYKVGtq+9} z7*-@Jyarn~lk!@Nqp3PV({@so&T}mxG>NXvAvH_5tANwAgxJjuz^KP_1Bl=wTJNWs z{HjmzK?5lo-{mOO$swVTm?%aF8iLnAY`C4Nw|wuZK+AT)zigSpErVDALY#qzN&6GNUz+Llz^wCj zk3euY8i=*HT$FvK4uEA!VYm^h0$mIgMiSRWI~#=PoJp}tgPcS)_&F_MkimTUg`011XrX|KG74&Kq|Q7WhrP?~)MRuDPr^ilLu%q(g`c&3p{=O%zYNVD{% zFwPVhHv}*a21f95=wJAF>}4RMyxk4xT{jXL>Pd0+1p>XMh&kb@eI`xqt-L~Lnd_RF zWUhPVRT94(zPr#LXtIcy0gEziCA!6=8A!ueI1LkQ36VljGE%8~kLBkNf#^Z9K4u;O z6{0FK#A3gLwFG06T9?>v?SKux9id}O3c)5PsAtLc+}eU8_@LatzkUzwCjThZ&CK+7 zM7w_k<5EQY%2mOJoY`+eXn{%^Vx5HYyIu_?+9cX00wa2_-4|Lbqd+-3FQ8fzn`^KY z-wl*#yXCN?{6csC)$h9#eTesKoa_itn(2B;0^ds5#jV zKczW91j#+oHsD?-BWQQ-ikB&f^?5jilb{E!w;{e2lBFL{Y?&_!l~JM`c<=4efdm`I zz`)xgszTK@0wXS1UH1{ZpzMADFKt#TB%%Yn93!&!w$R?^4TSgt2uFk>6uoSMc>+WZ z-(2vBGu**!7jd{9Fwd9(!sEM{_|Q>R1cbpHB?jO(g}_UiuM35r_cW|4(1dmifGt!A zZDO^f`^tG$NNxw3OzN!3o(@gACImO>-C2{zIy6xr%n+CTSz{=tydD!S+as!^t|g}# zp$N;b3()+SfDdJ}X9xJA0Q{WJ;7`EbgCx(tJQ-+`652#)e+!xbL~1|(PaHRgntjnT zAz1ZQk+k=JdO~Z1?0u)G3bpsKp){5U+55u+UYCI&uv-WCPECgHpLXL|m=HLmCA_M(bguZ!)*`?ID_$Z zH-uQxp9D(uCOk%Hwq-SH;mSUv2-LsiFl;B6sXrdEg3*iYlVLl==C3IU(8CSj`e>fr zNVB|LiRgW@BbJWGhCcPjU0bQ+BieVrWisxdZxnEUhVKwhN1|mow0{@Z(jtfZmE!r3 z7hl2yV|O!1a63>FFvAZK%_Dapj#ufo2Y~QTL@eEzVrGgi&8(P!MvA#h-pUBp$RxUL z;$>j)?G!;E#mef`;UZeyjsZn$){LW%!$cPbA#NZv**Q1nBHd?_Vv`yWEknG*jf zYB;^knNt?29I+q4Mev&D9-7vqxCsE=m7*a&o_`M?q_b-t<}Lz=SOXH#dL2=+K*V(t zQ9prbmX4_DA!e4$oN19}l`T;O=5U#vk!H1hXTYqUAzVka-vJXyH0qdZ1?Eeb)jdD} zqa(8-rRbw>#h;lkp4dYTt|X`iXP1K7Ohk=tSxAW^SSN!MkB9L41@4Gf$KgybHu}w} zd#%m}5@|+T>d}f=evXx&Dzk3w=4=orqgyJ~ok0gZ`&qX}h%M3~yifXhY}|qBoxD%l zfWvAyXJ$~Faa_2Ko+Q!tR#O-j4=Q0SHXM(Q^I++Nja9cHb*DXzp3uTUKF_L#3(?ls zUIRHw!^vp1wffX5MX95p4X-8u4-et?eXm z@GAG7IWu}dW=8opto)~F#4DNUa0?Dw(j}RBMxg45W`y#HfHMvU7(5zc=aIyL` zX67t2Ggw`r(JkV{x^ck>QB8uKL%?e_bN|3w5jV^cz8b=kqt+XN7u4v_%FJI`p$yYRb?>ENWV1Wsmd|=QDui&`L;H|>#IlwXp1SDFw?!~4&M_vI!rZFMf4LS`tDi4)^C}}`j z%bd78oB`fDjRd5VaUU{Mu8aecjHBAtI$puWDsZ;?(XT5qdqw?2671&G6g0jVEsqw@yXiQg1Bgo|9v zXmJ3y#Tem;s>3g*;>Wh=U%YUxJR6(djl-Q^}h#&w9+IZ1U1Q0SY%sW6+u_Zo6C~itp8jL4DX$*dpv{8E= z@ginQu%-=F{ZkFI&JhguuR$Rsn@IPZ?nESlu&IIGY~HVNryZ+&>(<>99oNyxL8wh1 z=sj^j^Fqi-rx}2LxJKcZXVZ+(YH&=WW_US*?p!->MsvsiA8y|az%p+0vTQsF^Xp&Z zDL<5_gUX-f^=5qP#Ya{|kKQQ0UVQA@XVq^o%|7sMnxh)$U@X=|(~Odz)DH(@%r#$I zSC^w59=RF_At&MxSnp1(s|CvpXl%U5p7l$@W4vz4m}q}T;0cvw=_(tqEv}Wx5;Hy-9Sh=4-nd*U6Mc1So|L#Fq}b0HD5jklGI} z7stf|z{JW^fK=^C$x|I^(k$oUjsoyeI)b4<05`)1Y)={nPTr@}N6z<$7nU0dP>Z21 zZb#oRTKp2<$tpbFuo`78$~u(wD372#f$|5Gr%^WIxT0Hk8~4d|fiYw>yeE?Xl+oaT zjtCO~9D_G%FEapd62li0$#Rta6-yqK4EJmH7^83qH9u*X_Z&j1cKVTF6zI)@PYZ-> zO5M#r?(|bc;X989Xb8F2T;gnkHH}=fbZz?Y*wp0(ud50yH zqc#dlrzME?)K(aw94kY=VSoZrEv;oG0Mu`S{mTEn9$|2hlL4YkEwvi`hEQQk*MuEGO`D34bw$}W`cPB>J2QgPxsFv9G^@BqsNJmJd2j?TV5 zIG_7TzkmV3Kj1l}FzM7LxP@0ywxPU%Qjf9=WjD$`lmjRq(kW-W1+Qfl4j`E4&MjRn4$Cl1eh4D{pnSVnIQn=ArcHo zU>=Br!R`Z?3$9-ZO!jK3quED5L4<%D?)*Mdqm&pKleZcR0)LA<19~1c^Z*{xAbAU5 zMSD~S&JP97Mb83k6kLtANC&$HVEkxRlp|H*)y+--ediW{dH_{HELH# zJkB3t?33}Q@(ST8x06kTfD6$zYE{?<@g)i<=hrcvxRpBr@g}twKn%gjci!1*)NVmN zs)AF5joO>ANy$fd(6#bSs8~d0#`{^@!<^^(;zx6*Bn@+(?OO@SZ^N&3cWQaKt?TI! z_7{9$sZ(`2wZ1ys{{RjV!!SZgRzgk%%7<0xGR3M=s}Z{udVW_JqX~oujIj`Ov##k4 zoPz)DML?>HGBA~m7RcoMEp@dOwk%kT1g{{-*&0c_a-5D{lJNsjEKi}05YtsQ#3(0X z3a>n|s_;sFcJe#tsm(viex%O++khkXX)JfnJ~p7VCjmuzV>Lx~KKaJ@8R()j(1jW3 z0@Odjz>PmnZ5N%|ZjxF;**UeOEZ?SJE0Z&OIjsTxGy5B_3uRFRJ|&4>Q}PQQW$>RX zqYwjHu;Q{~7dt;G9?{Yi4p6ncDjA&0qr+2ZCvT23Rk7BzwE#Qzff1sT4ZpVoU&)5e z8YoqqyK>|X6Y?+ByK>sv+xZCQ99O{w{Eicx{!*OAJZoKZ=sG;bQ?;#z=9QZ39zfGR z2}+K zQ;H9{6r~r+@7F3yBFb;qC`wP1$H5+Ks^iIqNsp8A^z$zmO8&gxaMZYF9p&?YNN=fb zyb4N;GhPa6^Jtb2TDEUo$?EDJvTWxyx!UNRe{H9|?|UrJyWFhi@rey*)VOBt6RXZ_ z>OFh69OVR|eMvKG#xAjx$=Ih|;qQI7Od9N>yv1%>d3wLThTia2U+sa6@G_b=^m7G6 z5X8GOwn-%Q+Gi_t7T%CZwh@vyTn5*yS2>rl3BN%_(>%r`$x5C~q}N6~=gP0|c>;06 z2|TKO@)neFD48geP^O~fq71R0K&eIf4a&nP zkD>ey<&P+Tl22THyXK#Wtz8)}OFmxJp7isvN%HYB@v(`8@hb>}^y$%B4r17NwAVZA z0nrvXFaF)y`oEACUIe(SV549?I%vIu-11%A_0zKJ7qtQYt~biApQf%ia@Qw@>0RF^ zx=!oRbwr@+p4{~xxa%iG*D;}8pF(Ks%6LR}{Ri#Y<+}EskX=7QT|dEHm;1X`MAz>e zVz1>-qSyjm{|vf{*xX`W_aMx>P*Xy-pf7k0|*K4Wkb=>v0Lv^nC430M(kK)gB7V$$KXjDSd;ZP;=~)zJGjdx)^HZaFJ9**pB!Bb*XpVvucl5Ng-j%` z(mOs)GKqom0fgkVNBdvwjks#)D+YTMI@MR|6g@zV?%xv2tLgQmP<54@`-n1rkyy$H zvhRPR-wPE+M*n6tkRf6|AswVcUz&`g0Hyuw~B?vL$rumk3)vxgdM>pj? zVn^$Vdp;``S{U$!qd~Uv4*)fK|8li1!F1Xod+bFJO_4VpibOysCcafKxnX$VC5BxHSm+mWHTqAJ ziI_3;QHy5;_$>gR)0lCL!rlTbpRA6kIe5Fb&ol?ClR2*JPv@x7b6gq6RnHuCx&f2x z=XC|g(4YyuWSh0$``X*G^7hC3G>cM&orUkV2QKw*Ng>_R%C)~RJL zV<5j}TlP_#OIvpHdbWAewZ6A5d%Knq-7XY;2}^kl`w#j7!j*`oT{SZS4^lrvQ0dpj z>}AvkTWuN`ob~~Oyd^=1Hf=0G(Cp9h9`&kSBknyW?-6FL58Z3@?z~bL+U?*EIJZM~ zt_{$6d$s2gNXzwiI}Ji!Jh`3A8&02 zWX%**OXSotW8r>0m z5TF+0?}}h$R|G^|(JdGDeEl9pw^q5yZFwH`8^!=ioTBEKsBSdAOJ`j!wo1Q!kcX5u zeH-9wMiIOqftqS{4qcSgQj$PGL;~Fcw{9(N6D~3|5Yus5iD0bKIbzHNZELu-b#*M7 zp3t;w!*C$eMKcW7x@c}C+%?H`N6K{yo7mAJLs ztw2_wX?rUPg7eetSLqM<{A3-fad6l(45-nloVts2%Yv zlO|6!NEK~@xd2cP)9{Ws)!lH;j6^pf#gC;^zFMO#4}uCxN@9j4OWP0+;)JTih_T_j zwu6Gp8VgkkBP1woNri5N1SE}+fXE2xmdl_kefuuLZN@z@I|$q+eAn(|+zM3*+yte? z`*9PH#7#hin{M&Id-!G4=@C-TyNN0N%nAunYg}yI=V$3wi%y-e{!>5;hXe4h#K`kaT;qt z`|NMji$)DZFVt4+&AnJxKZwz())4~P69H0BbPJ}lnCde})ArYBVMRf+Gs{5^g(&Q` z=n|5lmW*f3E@0Zw1bo4|KaTIh>I9iLF`35*N{~qnv?WW3_@lT~>*z1C71yYB)K-0z z?+V-J%NlA-w$Ihvh(z@v0dp+<=mA_xISEpxj*+qS8$8+VL%r;sT4~=errviGf;#$3 zqwh}S9n?C)q&~_uf&#v*Ap}GLS93#%a2Q&2E}3uE_~|JRjlPC4JtC3{96bwlK94-b z61-^aF2{ZSnB#0jtF9V~a9kU95zSaqJX((n{iVO@4Dbfs5n?AO?d&4m1_@SL1_6;} z&@Gw*^wB^eoIV=*1#u)!3$wGC#d9zPRjv)&2qVrz)V+!eJ)V05VXmuY6WtMH5R_Ko zCxc)m83aUR&@CRQ%`c)(AE=cJ@n!00EXAxfw66;jyM)0O{E?`68CZlYgxh!#--FHa z*-b>)MuHNAQ3LHG^x~>{8kcGv{S{_OZPiElt}qI|q{hMxJkGYkP~4WR^ABjl(@JUzM=--U<-eQPjfyJ}YBuB49|Xm2ji zO^D#7?g)rsmfg*hWb7r31XOqSD_xrw&AJ3C#=W^!EnKNh3oH;WyUW=N;Pgj&AG5fEPqGn0z zq`YlWlF3`4p|&Xfj7w%IN~1NCb`SN^%eQ-Y-3XfB0)Tc?js7Sct22*Hb2aQN7p60h z$8FfLE=(tx4-y8(9p=wWicx4PG25fPQ+BX%X7JlJ4ucN1IUNBnCDc_yO~%sbwF@+hSATs zWR`}}Xw9SzqbNlzvaD5$zH^PDR7rXbcAaq~zx~eWuGv$2RD3uQ4lBuHHeW4R4dc^G z%3HB|Lb7`+G_!a(31>i zjG|Y}rT%ir=M}jEa+);T*4SvtWEH5B2m*e!8d!1C~iP@)51gV7lez* z9~@B%`EB`H32mG9Z} zbm))AKU%EqsS^~pMbv3!ONdFdh6J=#j`n_;YIZ!1<)KR*dgbsDdZr+|PsP81y zOUm1#F5tWs8fsD3&$wh3)HPZ&iCEqti7gu2`E(rUqv0#f+TLY~gCUi}LGqdg#bK*} zNy-}>CZX2K?-d$qanR4WWELDWIxb;}+^%DhtmA%1`VR9s#wce(62s@IZGxQn!Grwq zXQl(M;>X6$_9L=(*2p5QgZ8=;Gvtga0w4c(e-b2Gw@`Ah^S#UO9-Z$zbQ|mUzGXY|-SSg#bdB|W!Bb=foJH5E4jC{Q5KxF?BF^SeTN(s{YS$_AR_X~`;iTG1Q zxSB~Gv;W%?`Z%9nQr?!{k{vZv-j?3_shNe|8m*ZUa%Kjb5}4upQt$nr2t*mzsnlqG zq@>=)Z}GzlAMtVs2%kaxq!m)?Z02m>$KTV+WHCjw-VVf|DdLx)Z0Ue0LWYY({855z z3xm)4Rf60@1UVu|2D1mm(1iK)lJXXXbCxQclG$6KF_sYesQ`o!8m$>oIM22cRN7U# zvwsS~6fIKPHPQN@fV0~01AO)n20dlcQJV995;|lhyQxuRmkXq%ylsmKIB$i9T153T zE|~>UjgCuL+PJVl=IE{WN=8u|m+|4Z;jyhm#g|Hm?FEv`yndyGw(#jC1SLr3(^`LmoQbZC7DHI9-lqX$dKf-6o)yaayZQA z)BK2fqInCLq`bkQ+Di&7G;euZ9P~3TnFR-p)=Y`qt|RGdJLziy5grw%gm&}6kND$@ z@T;!i$HvY>*hsLkx*N6(`HNYNxO|42gS$NP_H)0B?LsFYiLB$ovEddmi6owwDOfx= zLs67(->W&?vQD7JC5GcX6Duy2$fUe8pr3~2Tw>x9qdQ~d^g;H;SQpX(&trqhp_6KM zean^-sFDtlttDH6TT3=sXq-b>0}gC3(Q^n<<|!g?6Z>QAHj}F`>r2rVRP7L#>&fEW z5wE%=7iX`4u9Dtz!oSaNccvW56?`4$YfNQjSHoXHDIm%?`BZ0qc`tCMwH;z!zXzJO z)`6QfW!TwyEx&^U(Q*GH%rZ$**)Av<%=B+c=r}&Tq`Z}lrmq#(U@)~?453NL>?_Cb!>{xXB;Zx4px zy0$k3GY-}MHMXr3a}9^NILVidAZ$5W=N8&2TNwFK#C>*U4CWBa2yXEX3)cdZY?lkN*%^8 zC$vP2?VM_D9IxnjJ(NhtXp+nHnIY^kgikLiZ)LP61O#&(dE059ezrtzyJ%BPo< zwbaa|bxAyOWE*tmkssm*|b+^ifOe4g(Ov!>3^iNSt)3|zP z#cS(Kzq`cS|rz2U(m!Z}ZLt9^Af7J)mRI7K&+3`t~M-hrJLr+abDx)_+n4X;8I*!hiQQrtT-_UIYq0RPuDGlw|2TUjR|Nw z%*%;%oF!SzlIaqF7jJ=TT@usdGL5zwb=k z8bSZ#K7k57JUuP29;WWW{@hbweQ+npwr-c2h`=&@WC$#zU-ixb&sV%A((05S3Msad z#t}&JnJXG3bc=vU%3BB|`wP7%1RASL^0oxh&sG5-1WHFkpk3NX?-G^j?r-wLA6in4 zv`TD7@jnvfaF8tKoq7q~%qL4tytO|k1psSH^0rE_e#T`x=0^=|!MvI+nDY@A%Mlkp zLtOmI7ZHyMe9@B?g2EMD{bhk?Dhsso1qi?xeh}v=I<2 z4$0e6M?YI7vrs1;ot8HLV)ALFjU1XSoQFot|O>_`QFtmZMX_E8ndKlXUBs@?zNjU zQ$U0JK{=>_aF(z@D8*zC@x%O6l;`+LK3(l4iFtUMgg(e8i&nfXQ%MFEt>kT)Ny9VGX*TOHf)BAqWOomc^(Pxt`)up<1Uz}a_2Eii*2Ht<* ziT?~MZBj*NS`8mU<#ey`+B%G(l6K(NFnZ%Z`& z)XYLOjn+&Mt;5V=h^9bV)jHZa*9hI+hhGd!57yGjg@{5_d}Pj^!ZZR$bYz`hZ6r{t z+9T#FK;IH1(xN;I!*S2nPnOAS zBCAu@mS&!}7ngjdf(n7NEL18bgbO?ywG7J_%Yvk`TUC=<#HipA>Nep3R%u+GaUP#= zujDc>U4mwEBbE$7aDuq;MrV17yj>L4vc{C!bIC2Jl2n;~ww@>cxq^PcLWKMLBWhu) z%;}U#2k62j-tCBYXUEEp_?;Y4-Kq6V=mqi~H%~3d&4U2mMmsM+ZdqQ6j~b?@gY`MBf@0u+vc-L=55Zvi&vvS>yUJ-LpZ1;8H_#6E6 z!J{cR6jiG5m&=UO4SY!oHQ8n^1B76V*vHlHUO|D%^*ZEdAejgj=_>Z~XRH`l>lSG9 zB(_+)RQmdrcC-De{rl&vzX=y>@zZ@q_nUFZU_wA;JJ9G^(yMJOdP(B)cM}WWB$;~n zy7Q~F_q3Z&zAIS%(Gluhb4ra6D%|osh;c8FBi0{_5;!mGs#p*gp&1mrQuA+zdL8D7{|2wi*Qaj;Sbvuw+U9_-H%lyV zcT|3To9ui7#=#_`H&<^r-V=AhG%6xb+gryf=WI2E)C8wiN6@3BUI`iZnd^(CGJ0m>@@EqZpJLXZ zsCnGg=2`P=kfo<_|IbtQ=7jpkk=r#-C2|s%|B_ClR|{Ut;C$x;!0hUqyz@c+%7zwK z^r}0hjE5Y+Uz#gZ03US#9}<9%3c!_#g%75iPwMFliT4l~iRuR&l$GWfA4<)Gt_2^E z7JQIyGe$2WxtFH%4e!S*3frmh(ztDe9p;b;N)d5}k}*Qda?7&&Z%aj`mK|JWwrZ4R zSDQ(RKT5HaW5ZGuc8&UqtSel8KSu*G5smE@LfzvCb&nFNX1PzOCU8qs-|MP)zZnjO zO8J`Qu8Q|c6_=xlU%o7{aA|fzJ-JMvv^Xfs%sbyIi6EHOW_#o(?k`D{ta1$*A{Vxw?dQXH6ANO zgo_>_L5ZBML#fnnVzyE{&3RHt_1;)pe&7%pmHcHS*Gn|qO+|w$+SvTCeIbl%(D~?9 zT+ZAbTUXrGSN|5unLJ}=a^Q~FFpK-qX!Xep5}a`}ripEIiTX_{o^vjcJ!*}I*w${| zo#a>a5HOhS6|u!)d#rjdsxBAW=byI8zi6w$Ug?Elid=}7LlMp#lq$Era~40U@6N=8 zQZmim# z6pe4fE+Vz(?zKv+0mxLcW;{KK^zq~+xrrLY)8i z&6}c;49lv{wwosak)={Uk>G9>`@u2yE(xZ6C={ayY%`D%im^GAR6p-21~RafR*pa# zGm{B&!vcucmY6&%F{Y{FHD;wN%B903hw!HR>)mlTMCF95EIcxh!Wb2j>VKX{4i#~* zW@W<}Ry+6|Amj#fuS0YkE>pheJlNoHy3k;6;k$`NGr83-F=kdpn`|d-Sm4!cPE2m< zoGNxh=3Gm_V$3YM5t5F5W3v?T`2K~*`J}GjsmvJ9EEaQ z6qC1f+Ee{pP*^1P6zD^PxONbghB7aVqHkUnNGZJRn1L&mfX}YU8&{hhgM{jT5EfORw`-r(b zZ=sw@rVWyr<$kho>+LIZITS8e6IgxJPG{Q90^*e&)6r6xAN_Tr(>w^*`aD=kM4+$C zb>{-Qv9B*ucI?0xE#lU*RWemIRHM zuMc@y$e)kPAkBEXcLpU7j~y%s3ZR#MZzudXB7A^+z$9Dq}Q$@+z_-8BI>QT=kd zmW@~8w<~4UY)vFZLGY?ywp-+!Iw6tf&{1TI&ywgB@}-VOKNYOo9aL*STjuEWtBbW z0IzGl52I!$HVN(Tq9{mz7a^;l%#Q2RFfx^ne@qu_(+$Q=h9aN3`aGpjWbmiAEQf>5&0E?CwW5I3#Dl2Yw6e0u~+@5>fyVxBKx?;NnzED1Oqskt{Ho z;_r)CywphjyZSdQ^eG=!-tP%&vJPSZjD=PWz$=hFpR2kJGdP`R-4pCm`r z$mMBS2J@TACe)1WS;!9Etm1qcNjlF1O5%xH#a!P9C6bf)m4$6}+N66k&E9Lty3Z1k z!dnM~R(2r|*4&U13LAT=pu1Te@Nvx)Uhfg(*tYRXBn|336NJ%%Q(V49m{exs!}uGhwktx?1d5PE<}ixLIA(xgOIpRg^a+mMOdnfOoV>PttW4L(4o^W!7bd0~^2s7f%n=e3R zOpamPJ?-t}v|KAc+oE`{48ST)$;C@?JMevqn5F4CyQ=4nc>9)i`)i!{S6jlu3w>yL zL1^Xw23o;bMXc$0zy*w|N{bzq7GRPK6)Zt6rqVmTsT{JfgB%&v-RY`Js8qLGsv8ef z_iL2YySjrx5cPY+ChH9(hRB+|m}2^&R*ZP-mX{y|7mikHHKn|Bd?*>!EIR-cs#nuJ zVt3PvfC*GjPf=}NUnty7ExkR7!Uz+qL1JO$0H4B&7dS3AQp#MIlez41e$SLkRocxz z&ZBo=e^vFXUqxHz40OY}<(QetH&q*vNrzV$;def_Vk5ugip^V#JWl15Q(0>Z!lBlI zp;cFkrf_7#S*vF?oVBJ8&qSVg{3*ptYx~)mbU!i#ac- zn0YwraM;i~RJzWW*h#?m6MWD1 zYWE6Q?B$m*W6s-+!ve}-c)6^f0~}Zm_y7eSj?3UpRVcN8^X`O{!I3Nep}&(N5fCG; zsCkb#3q`M_e149~1y+&QFdrpDPLC|IxAR5|^q9#=*ZD+w6R;yk4ZPcNmC8 zx(0cZ=hLmdhWzl_N$lGt9)3y1hu8kTdAC$QTFly6tox?M0v65W67c-l&)vyjxFOcv zB;U8&@5PNMt8X;#k;!`WY;Yml_Nrb5FZKD z;pnz9ZJ}P30nx463CSj@b~`#!XIj3avOUw_Kmzj~zF>;V)4~qnW zLc;MU7@hqwGgG&E#U+K3jg6Bb%V>#U+gcrCV@wwF#J%^zO&A#d{GJc=^n_ncaDM+?b%8|%)bEbLlh01N8+B?ODKP#tSZ zy2yOrMDfnI5#UWM5&4uto+74YVMqi%v?#FpvgFljLCEJ>ETCd_e#Pq26_eA419r~Q zk$GkTMP#YiEc1FaU9n5e!)?Qf38G7OSHqkQKa2yjkZp2ie!CeZMfPs!F+d5BB4F_xBJg{gHjj{C3MG>j z1Fs8RO1%zmeAy`TQzmhpF^Y#ibCf=H{2f*19fp9LCp3|+>^f?#*AiI*rrPdGB=gfN zrN+Iuc7gfwrgY=ZGq0=nfR!=5WXNqSLKNh-pzDY`}txkgk=y9$4|EGGM|+5SyG!6X$)XDw@@o?S-&N+lpIEm@aaVa zODgj@_8!0YHky~P&!!oqIQuI2T;^h#iAE{oGdr?t<-#pyw4~}?+tVeuw;(t&17;5) zzI$v2NoD=cS<&AkX70{jB;7=CXN^iiCpsc<>i34cD!JMn}xKDChL8e;vfY^-Z4Y%R-ek`_&p$Q2zo zzw<_s-hLIN!-V6Hg9}7Ysq&WJU>0$7d5t+S{@?9WebfbOUAQ*CutRwH+(Hp)n#&)Q zMpO%*sOscRuCpVB&&Go#&R$IFO};cUE-#R8j2uZ{vhIC5(5y4L1Jb@J?_dMb6MB#t zqL4j;Z6Z}(t%E5&leou7J7>uYJzO}hnxi?S9egPw;~D7}lb#k8Zo(gwIYMk*8LLdo zBC@pY3Zc4W44Fr+)5dv_Z@MGB*py&$0=)14s;s+Tas%5uZiO zxWwPkPD{FKiDEvtA20rBe`dyV>|=;2n@-D^o*yRhs9MYA9v;cglx@s>iYoGI*;v7} zt*$m7OGYZ5P5>hTQjrQvN}cnMnGdvcEwsk|wi4SY%+5)p#T>|o9zfRVm`(EbbiPO& zbK#QCb$r;W*@r0f|vXG_}l)%MugHI5$&_2de0p58qQj)_Bn&yR8W~ zzbd5^S@#md%b9?-^P+G(-!?x6m$G=0^QPa&wc@XJzg$6PJF9M%qSFT2s|<-=r>0D%LKht?A*SkK*r2MXTY#w z+H)7(&NwRP0MZ0S2(hQ+v&DwUkoqjY14F9S1eQfM5u8Gj^qcu@W=t2h>^1sJTJ!kT z>9JMHFn2L?%tX4e98x&*!P^Wg;sUvMs#pOmxsSeRzuFGExPk(k1M4~efx%%bix6UP z5DtR^)s6xuW-H1~1H9#6F>wzjhYGkKR+8)*TYBYdEf|g7XDw zob433@tQO@Tlte7^2nV%EuOA^`M2kG*e zcHkDg>_L78+gGGXs(s}+OT?^jwp$Nd7I~Q;wtKXjdWt|+CI&cZtbpI7-+-nECZIA%j|FZfsf*d*J58dqo z@9~J_qHK-OjWaeDng|TG&a?!RB#OE)2>ZtEb7T8%XxtIon9prY>vxjeowY9)t2M80 z+7DOk0X0}4ksrZSi{-pT)u2MA*Cm9Ps=Trm+ab@C2`cU898mR)T&bsH)2|@G+_Jf$ zdcjn@kc3yg3EXHGN-Pv9l%Kd7ocdkBDfpr208}cyP)jWQ-nmlbpS^JbQ!)YLQr6^2 zSdwdsIkh-u7Bv?0&TTx3Hy6R+lk|NN2ci6&k3MWH(5L}jXCnX6_Ox z0KJS67(+qcW+Dr*beANj_tkWqOG)|M1~(LGov>1~C{ZJ0v0Ofr{3#tMytdUm?RtR3_6p{ z@l&#lDlubA z)tgXc=k8S3jXl2wf}fBgz`pEa8KOo7_7$k0Gxtf#-c$YCB)Iof|Jww29Yy+{bIb`u zP#NwY3&%y*6}sspbevYtH?ug?dJc?OLXOV=mZY@SC}^G03N%)1&mw6w$RO2rjU&xb zUFsD_U;w#crkISC6gE<==J-pbEQG!hpf)}3kB(ew;+JG?oLaL5+mGKkmF7t%gJ}Zx zuxVU=uEOw5SD+D52{ztqSEoW;3cq;EozN+}A4uT0a=@l`6i~E>M!;X#Z;-#@jbkTt zQNlr}&(5K%V>g8qvE7RrQI$F_P>P&Hvqm)O7uocWwJx8cCzCFeXTAte z>d4Nl8k9MaZ1s7&1#R?X*&Cu(!}tHT=1|zcSC@x@D@kOUmW)D&-pwFm8|D1vYl5BM zyZ+t;{df71ubI6` zZGhH+&Ws^Z*KpfJ0S%a%q?+^ul4R*bg#`Pp%W|EP`XV;l$YPLSAs}?6XM~K`tbEx) zh?@pYv{WZSheEg^a+@eC0*L~W43Wl^PI){;quyW9DTSnWv)2Uped)W*CS^Wi+jjzj zNJN56NHS&#KRX-V9O%oLOf%s<#Q7TOW%ZDl%bCoSqxoQj&A|>JyLtIMWIeO#kw_-lis^%w$&4~}WFd6flx z%ZY1ft&aHy3Dg1BxDJ| zd@L526-Ox+qUtsI79UB0#iuUPl*onp&Ff_>a7wegj(C~ZjTgUF$TKoq$&c+WU;MRjOMlodw(h;y?!Mu>rlW}Ok0jswG!**U zXQ9v-6n_8jFFy~3prycpjh{jY$K&jBq%@DeVhcH9F8vqL2Q&_UMIh zb!u*bN<^zwjpkm#X{;&`-*ZiQsQCrMzpqF|OpEv`^wt;8I)mVD$7dPpPN?7}D9m@kyXoxv>i?0(xkR9=tQXDFPL`_(6w4}?ivCiv%_hQBfm=BTt}Qs=o|1 zQroRqrDuvW>li9V(rgSWm5zRJnkW%}^_`dhBCgd`-12;-C}`gVIy^YqA4Nu*`zc1p zGMPjkYW3#PI)qf}_Tnt6$2t}cfRzhoi7~}G#c^FO(vy=;x{sv2x_~J2{>*W%NTL~L z3acPlxmc{4Bi58!)Gv(@C=A>Ym!niZdUn;Yfd8rv5D6=Sg zna`C=+xikH*dhOy7)Oq)qZiXkwYHV&e9pQ|@MIqDw?VBbE=sjQo!_Ra>diA>N1O2b>&K z9aHH2o~t@lVw>9UDg)#=v<#xem-;yw67UBAfm7ZbuQe`>brd$FrG9^)(5+-%*+az7 zBpWq5fQUay>eXA?o~D@&)UB?X0w&U}-aQ!McTRfbKeaJ6VrAm~&PfzgsPa}&^arx_ z1XHCxu1aV+L8)}kJy|n-mrSnbp58dZeVvvbD|0ibb|tBOW;va56z>Rls~E~cuc3l! zR(i>0ZGZVfHMw0EWF_0bPL#X{BHPz$UGa|=YPF9*N9`?*PK(NU7_(^J1a3|~E4WHQ zYEdM+?8raQ=lWUZL~2AokfmqVuN#l!?;NT+-?}~!NGBD2T0EvmrqW0&U#K$;zd_EY z0$tZ{^!0Rg=wB~e8`wwicEav! z;H_I5aFKs299vW%s_OubQ4D|gca#!tc^D-(wtL>M^uvaVYLr}5o+h$jDDZ10e$jgcFE+0$EqJ4{!eD5%MaSojZTH-edc zx3pj9ZYC?w6hkETiI~~_31gqfPEX8q@$JOPj^^oxcwI%9T#yJSt|&?@Vt!y};x&6M z(~h!ETeSk_c3F&AxHq6B_G7C`hFq5e4~CzwT|9HDLHKe8VJpiwnt4oAWmoO>@Ip3FU_MlI{;S>x+NapkEObUR!m1tovI{C9&?S7a#5?c-SVmSMu~mAr1SD zr3z?{0-Bf`UYkErfU$5oEjI(;r54~t0`RMlZLt84vY0W|?TMMI^)9p~HR1Nc&em|j z(~8(DqFlL3yPV=4Y<)_g`Y8n@OZSS$1S)gr?7adDxF!7W6!uL5NbL>)+R`rr&};#O z;UOEKWL2&?mVV&936=J;#i8+f8eAtYi5fW$)}OxUHG=`glZ~)XvjRb9>(Q@_5w~93 zuQ&l`JF~=IDiS!}KNwviE?gsfv$t}pg~;eF!Oj~r8B}jE6S5Y!#jIwScg1Zr3$-|_ zTL$fulz0*)GNlk}DKg6`C4?VBxO9feqZm`i;#?26?71y`PZ=7cBKNLW^R9Oum}Oo1 z-DrNrx&>z&aZ`HDyD8IC%^yt?fL^y9xvJkZ6Z*=~6>izYpx|G=ofytnBB%3l33IIR zkC&u5I{$~D@Y;#FvE8>VN_B-l*|<1yDYp4XA1Nj!OcxOMAFxepsqW-HYSrkvwvttg z>e`N8^+>}Rt9CY=vE~EkYVpqg7oJsAMh37u`$G*nMKJKi`S&w1kV~omV{u-t>xe4O zA2}A#J;nLvAV+XI$!0T0RzG^N-Da~MMZp*64={ZuP3GBwwDCBK$R_ZHN_Z$a&AP@p zyK?nTyT*CA;N_1$ezGT8V3If@59A;#!FGt$$g@;+y>8 zlT)lNDO~rV^SpV<8FAPSeGYiOdewTnL{(4rB3V@NPZyKkBAcd*NaYEPq5zDP(MD2y zdJHMFQ19)oLqx1>SH-O>w<{cfr*VMnPkbwU#~okn-yhhZD9#8F;^WwQgJCsVJB3$)7)Fa&_~4sck-R_I!Dk1@@J5_vRIHP}Wpo?T8@=df z^!a>D)xW@n&i}ifvlpJ}XMe|b4_R2MHqoDw0n6tv?4RZQ>6D<@x<9H;_kH>9JYTJ& zGbpDsPJr0)7-J3` zTjn4x-KlLlNOq})4G~M9Z+TsMS8?# z+JvI+zL3}2UP7(ILn|v03pen5udZ$2>NR3eeF=r*6`t35{><|Z&wD%{^85`Yqgt#e z|I;@==N$-c(Raoot!2CEJWFxNLXs|7FxqI^P{(?W8tvxy#QL+lAC9ynxGy9fO`3jA zRF3laI~%6cgePE&4WLryD$*X9;00z1cv)B{gyVk~`QL8-Cj(yRJB0d#&D@SR6y$Wy z^anR*>T7&VoxT|%M86hDDtaZLQnbnfcSCB~Ai;tv>54A=@D{n(0tb9>sQRm6)7I{6u zYjqp1H8Xfwd4Vv_P|w;;e}R-iCAA7nthD419`!jCxiN2Hx^fRmZK&LXd$n>0`IU1` z+HSr$H&xvxN%IxeopU;ti^CyNyUpWh-^FCL#5X-~$lO1sGnkDjn(bBQdxIa!iC#~R z`)rOeU)9@AJOWI0X7mhr^m4vbo3Fih9$=F|}`zRd#P;xh$qE&EOU!lT(&D z%t;o(UV~MKDI~@}X{PrGSztDwM*Kv7&Ytp)>M*afCgoL?t6Ed5bF&V$ADCx|=(<+1 zDYG{oW9cCgxgi!b1>z0sr zc>kFF90xAon#lh}Mb7Cmf40{zymqtO@7~8VxJb(0YjH(A&_Pq5u@>bul!&9#9YSVY zV^ED5`&$Es0NYSzX6}YL^6?at7RyG6iKik9HX{Lj zgv0SiNULWQxI^2%mA&xOvlZStIJENHNQ9LS$?I)itK#x%=e1@GFDoiU0oO`j^ zlaRv9V1U!!Gb@7atw&fMJKGFH}~1 zgl?+V?0hqqkl6a74F6)$;qfni!ST8EEN1(aH(gvW3n1zBa)3iAKkzV?Q%EAgQ%Hy! zu3G;{j#~?5oDfnt+p7=7Hs}!{I5kE?xV?z`VX+xV6ZxlnoWz+q%)RnD`HMl<9rMw= zubCDA_>jhe=6!ea%{n(z3+7HZRov2au)yJrI99-KTQtDC1lM@Z{AlB}Dq%Ls7u&a3 zvbIRpL;S3HFR-4JZ-GY-7mQ_(H>!AJw9o%ZDY1P`eBI8MOcYKcHrgcXToK#f!*TJM zOG_as%nFcp^R+O96ek$MWW5phrKKtb%T${2_gv`Q&V*5CG;Fo;zfdmyAEfhsfJAo)_ zk_Qz{#fbTXjJnfH%$Uy^pQ?k&1T#q{$;~AcK%~r|fv8!Tlc+qVc_L7w&^#My?#`|LnYFOtZG?L}@#zNbP?7m;J43Qzu8<-r8YraJ3!T!zG` z&G#W#-xlTlnWC8>XgE6@|0tMVI_M4I`1}0Gj_IEUkmIYyydR#RCJNmk3JUnhHkSEl zUI3a}oF3s*#tsJ%EbA)q~#a6lP^y%Z(y+(TKxqug=Z;M1)zM@usWW<)eoHoTFO9@$00ROJqlvOqYkD*&@fC z*4DFKM@ffN0eLaz?_0vl3J8$HPQS}CQOKKKhWsw4#By)EILs_-m(Y|9y@e7Kn^9zD zxLjrFt&&1EM6`Po+|>x$JWwN<#Zk9pw3~MhN{@nTP<+8+ zIFu{o6Utpu=8dvbimq}9!V1Z8zDT((omjR&3z^FdG!T+%S2+pG4MU%Dk)GOnNdZIV zC54Hx=oyT1dv1s>PSyzfurbWGwQHftw&yjD0hFxDL_{hMhMASPV%HJ5X)jC!*Al9L z<8Ia&>R#+@)4ksVs1%~)nMLeZzZxl?l66V%e9gQ>t4DhqCibiSt-P3143@vQ~ZQ7DRmNK z>h7C@dUCMTV}Mxk0u_Odg}OtO%>+6OyPc!hN9@i~IRuN25x(aa6iEgSB9dB%mo4G9 z$F7m(5&a?+I|D@taAFFHzg$l}2nc=4#r7D26vCu`fNbWP!7>2!SUa(26PR|aP}Y#` z4rcg1)3h$}c}=gsWGHZh0H!9tZ1tKN>%OruA{A4X2=3zWmqN^LmL|GR%$CL%B~RGMB>~osYPZnNSRhLkrum5;~c+LMNJ?{dJtP6iPR@Q|0{g@ zr>0XK*mM7M68Rl)cR66E(>vvK%5NbNRxV44g`;vpf8TDkiNT;*FG*Ku(k+^ZEIE+Z9Mi6}MzE2jvjVlD`ZN6wFy zt&Eh4KvG%y0zcCP8>%ht)p7=;?Q-TDth%t{Q1p^s0&|%?pri=Q@O@q`NpuXghjEzo z)Q|A{rNCwSht`o(H13s<`4$AtWOtuoD}AwQl&49+t`J*Qu;H6Lq%s>$Pf#H zmgTtvbJMQ8RHB}YiM7GsY_eHWP4ahX*~08$uGITC76bxgrBuwGWuXG&A$|v|=Faa? z1+_)@qMOT(Va|Fg3ZGTKQ`43!dKS0WuHbNEc&fNZZE^ZX z=?i(A{QdXKZLm9{dRfm+_;AD~vIRxxW`3KCz_p80wyp3NBy7=RWoC7fEM*ICQAnE< z+G76*9oF;P(gByxl~YtA^kK2$7^-XKT_$CuUz!h(rit54WrRN>CWe^}1}2sPze%L4 z+o5N52pOgnUm1r|`Adxpi^JCR>O# z)q-6LiS)u;yBP~ue^?I3ODNGVK6CYAu%=5*NtJefzZ7!Q3i^kI9DdQ1f8+GVzR{aj%1C1yBuGo{DF!o>U=^TK_H}`rs_|89$Kz+M=WN$4fK3dG zBp+K!s2%e=%vcIxMv`v_csAJOLN=_4=?l~H^};l-s*q6UN!?+J1UCbcx1c;i@c$Ia ztzwbyFr#d)4QA7aRCS`;2xq0=?QZtO-EbY#%_}UeeEl+Q!D$V#_3zSz97UX{!UmX_ z#tFoUiTRk%@slFeW3oGXTwUJ_W>xj?)wsX$8iLxXTV8(gj>##_!~4n z5!-!G_^zw?#sT51<8wmwCuBa~=C}X+(0$9_=5>qFv}3zV!grl)b6-#HY$+w|yOG|{ z4TP`Z5ok{wAdTcZn5QZ5`2AvUV6VnTGeFjdIs&pY$h~v(%`4dPJ#G=yIcIwG*=Szd zvu}UrEGUArT8Alk4+d}We@*>}U*r5=!?*G4eE(O&-}p7e|CRqSzXr*#i8Ru9b%{De zA%5IROunD4OmfNXx*GSVfALF2qm;emOMbmgT=p8C0;0hhwmuYESt}EU&v~u-G42na z^093i9uCuazQJ<^&$oHL!*dPK^*lH6+`@A^PfvHx{~>G@&%-=F=lK=S6Fg7zJjb(+ zX9Ld*Jiq68mFEqfw|M@-^FGf-~;`=IU&i86UcICo~ znyyp)9N!cjy?}JtZULc#`|~k&L~T2_}w-VmY(? zmNMz?^!3u@1FFd~O2v11dY*Lw#&v2F5+ACh)vs%{Q^(d9&Us4fIZc0ao*LeumkbO) z_G)VKF4+7*C^SFR zjHC6?(Bjg@+hZT++<0m;JQ@x)&S?HP6eve>_@nK>>688W^W^J?xc+MC>8`Jpgcew)yvjsOS>%$HY+MXv)Hk zRYk=Tj2XdE8%1cBsMjX`NqE^%E|)~P%g6Efm|bHFD;tlXzT~$T->?iPZQoADY z*%KQRX_%!<#Hun~z2X=o^ET(b;eFhUvwTh{{9SLLBI#G)wC7*#zBMnlS@f*^M^L$t zw=L3~%Z<;nx6#MWiE1Zy$yq|8R8B(?n(nm<7kbLhMD$sO@sEIL&cSlFEh12a)E zw@>}km=U?bvvp8tuwR-<@I#>Yvy3`XIY_BNJ59~VW zFh35&6h4h9C6%W+5aUkLayr|00x@NFY$~+1sIf75lA@urr_yIg$^t(A;eRB61?095Fu>we4Iih5ewrsD&2W z4WbKU*&RZf*h7JL@X^WM9ywzm-PP7ExJck3|btsG$j0FVgIf^vq?vWNf8!q zIm0E^y?9YQFe2XFA`|GT%+3jqx6x197O(5>SMl22_YxCY_W}M7#GJS|6k2j?pK-BG zODgj=Nq6FGdZ^P^X9F!7X`+_~J zhqaj!S7g_M3{aCI!?{=49u>C1ELJ#BJ8g}^mY|cvK=D8hWo-wwT$^iKTOANKm;yk6cEn4BT8|2?JgTnkm{l|D+DfExUo@Pw?a79S z6%nW9glubtTjYF5SLZn)X4jTOWEg=UH8Q%_VG3FQrb-5%c5^~Z+H6Y3J4yK%>kk2n zD5x|+?z6Eji}v0PrYMsjbKPF`!4}{*Z5Cva_G0B~SI;VrqEAms zivrbJYT-aRR{s>*q>lb`DZgrA|7;!k7dz4&c@jt0D*;ADwA5OVzK3`PHfp$>{4o{k zgXSb}!bt8GfgIs`E+Pm@^z7e1$3jN=Glqh-HD8;OPMyOka)B zS+3GsMjg-_YfG6KXkS1A*iBJ4m|ykN)_091?GE|K`9m9?mr;HRj0`B|(w2#HY^-bd z*=bNR+g3c(nzO-7BnqGpiQf$i+`yo~Y#rfv3!^8s7GpyrqbyRWG;~uSCk+q!OdCmK z_F0r%%x9l!j40AHOP$E!k=iS{JgND8X&|>feUKRGSZX&b-bm+wJ!}^qH`3eSCztjx zpJABN!tM&9!1r1FXB6LgW)%1m@-shVjycnY-0z3XFvr@E zJN=NEW`Kk^Zn+Nj%g!waQ?1TRh*sGbujUJ4vfVG-a-RF%H7XyecpATCB_9g13s6oH zYs}DY7LaYeYBviGpxykGB_f9ecrECq-P|EdNE=MMc)zfepM{y8k`b{bvV<1S-bfeO zRjBzX-Q+0SWLBM4DZIf9w0KDGo+EuZV*sqTMTkyB5k1m40B?P)hzlCez4)u#s|f7z)OJAmYE zmo*M)`DO*t_HXoy0y}y)nZ=tk$kkiFmksvamF< z7z#&p-k_6g4msh+5@s8-z3E4C{JaV^Sidyw{|vTv6|loZf#E|hvK#D`A3Mx96uS65 zGs$rd(sq<&PN=$vK^1cIpz&GeK{B$NYsKPcysFY#oe!qxB^_putj2Vh5u$ExhPj^q z1Gb;zsWM)bxlyK;&gUnUk;EP3N!pd)DKJP87J*+<3>JaPcEB70wnvbx0#NDsZ&VJ{ za;EZW*6(mCYFCHZY*m0VKA%7tgh(7CYknr5RkOTlO^|+oH*Jkfwe{62Fwg@8Ge9N*Cux}GmeDBI58zvKVw+cfz^8IV6PJF z7c`0~QR4}IZQMN;XcEqPr@h!bsBr9*+Iky5qm$qb=FXm=j_S21af7)skiEz@xl{d| z1{JXjBRbA!s(vS>;bUhAhgL1EYddyZOT+Q2f1eT!=jMcz#YPoXydY}pC)&XrYpLy6 zXJwORly#KcV1^dxulu1ZmAA7{)#z2_c6hB}-2?iigo-mKIDJ21V;P`rSvgi+KTeto zfhe*0s%eOc;F-g1@O&0Y0GV>Av8#9f4DB2;`SNfO7{ZQ%p*iejT5N;4T{KPU<-!i; z%a;hWei0MG_iPmSj(hC=C3$UD8}!c#-N3ZYY(~mDgh?&Hm3c;a8{E;6uWZ$#iYN+d zIr?bJxFsvG1cJ*N(q*fNjlGt|7h>58s2rpX@Ov5cU4=%0yUlHf7&m531*p1<$<t zMi+OEAjYy0ZZ?Ukncg%JWb~$)UeyBaO&J41hdJssl3Vwm!DOq{Y%{!RGrX!sO)pv7 z?N^66PNH!f!t`aY1u@tE4Q!934C()qUj$gn{&g=rB4TAibg?(lIt^PNq`CWjG5EeE zvxp}vt+4Tn{IYWH8dvRgt~+9sAW^X*pgc8xQ`97{wmh~c=jN$u<`lnWpWR7RVi)^H zl`HaOax`~DJuVSI(xIm`Nr;cfRbX4Op2$;-DeZ$dlNbPD9XaT=`Zj$dofYO6$q@P zJknu46HPl`HQ}I=a_@Utsd}phTfzj@#SU|Y&A@;W*yrD2#sxAI==d`yRK_epNuUE1 z%bx6ynIoPzPfMFTgVkOd<89T&{ozrlWk;M2GYLh-Gg;dFoxi5rJQKTh88O1lz6e?q zh{-g9CvA*SCBp>NVQwNOO~E7-1mD%Dy(;id-=J71e|?m}*CWX1^L0N__2KLN>oxZr z%^hkzJhZy3u5IwPb5I?wLPl)+m%oCE=ZzOz0_NI)e#Z%JH106F|B^0XgFvK!=cE8{ zDH)NZ$AD<5MKmTs3JbPrIf2CA6P1pUL=t_mpImT^1o?^jog|4w{d0+4bBQF#PxQ^x zB#{jKF450jBGm;57A`$yh$NCh+a+4+5~&v966K#Ei5^HN`nF3XL4I+sXrc$xi7s@B zB*;&6{!oD=3bQNjXqQNW{6q(rNg@&HF44|?mIM;yCmMbniTnW;GCfFJv!(UAVSE?0 zv)H@8afVkM*_B&~V8nOwhSK;h4x7l2c$b!TRXkM&D7WzSX8fJ#K`i(lNiMctm(2~? zC0N$C0Fby$Zb*n7R4J-KVx%XdPhwuIxOx2?*wMNB)IL=Jyyo@!JMf1d7u|)z6$<*V* zHtBI;I}_Z{&PieQoXb&EvH#&vC{*BqX0)KO-|wVHb@ku1eo14W-$_^XihqmmYX7HL zrrzHvzNPrF)Nl$%F>7fxJM&&m)W6LA-HCcGYA@lE^ZK26FD7dKD2cXEz^>d}E|FOB z{rf{*eWkn!1rIGr)EK*Zv}=8iT~bnH1EJ#MTT34U}EN||g zR>ET-g|oTaUWB>Zr}bfvG)AfzPzUG-bTwGZci+3`EA7& zujLh7%wlXT)LIo<*$=6(a+nwRS$m@1qA9)SOf3&gTxK&$N z=KPyz8`p+%-mc0C?a6EU+*>DGZ_S^c+D2c~>_!&bzAYs_SN5edTp!r&u-?{FpS*MUuI4G|#H0DTFX@%2x9y~SF#viX%HhT2+#uX+e6mqW#Kl*u<1&NCb+PO6)A@hMyyIhX4 zwX7~L^kCmm8(4u|X{Zf&(@>Le9v_(K@4e`~4)g9zj4S;H(S@P5{7{IFaQX9eH~9$; zsh>bWX|c(`Ps5pWK6r7cjnr)aw&P5@*$EKV>hrz4Z?t!W`c%fMhW6spC7uPUh6bK&R?cXZ0QQS7}!;zHas3=JAE(keY`vzyVCGmff+1gZ{ntL z6>TI@;2iR-bihtP4f=-Kz}!{^Vx_7=>FkY4l}@s-CR-G0D^fIYSd0DZn5KTuP(_?C z?doZVU*kSrU&@mN`M=KV%Kdfj(xOUDuAPvp(1bT~CJ&Xc!n=>SfL}|VuO(4O$g8x! z*L{$;Mhqls(j&tH5P!Gl5)-JJ7JJI&DO5fVLC zqX)a_ZTmZ4qxKp-PNM5Hy39qt<=<3CvGo#t<>JFE+?V%L2p)IKdCm3?ot-EmJiHcf z-gyiA{SI1%y7IznN9ZY*Rr`F@ztwa^Y|nQV7lGLC_A`XlC-bWkeY+;J>RXlTEi6iK z<$H0Jx3DmAlviKq9Y%jSLUEfD?K}IKlS5tkv!5vs0nMu~B9(WMci4zONBhj)m~%=9 zaD9`btMWOUvc2ni&2=(TV^293J?=S$ZNYm^k8&~10J4H=qW|pJ@KE&F+3YOYH9Jwj zl82t_Ryu)ktS<=waw;Gr$!WQXBN68*^DC?Gc_+$B>jh%%jONAqk`}r8^~;}!Z;=D5 zZj**QE3XYb6eftRXQ1xxZHq#vB8u>cN=DM$fdP+?@|W zKRL6kzeY{VMLJR-u1}O0j_;(s$98_Itd6?o*(w zO0^K+C4nb)J+zWk|&fcNgZS0wWfO3&gsA%Ml*K z+=L-`B^2k3c;02>zIcS~5mW&+sCc>xx_%Y=J9m^0niKx*^Z}n!!l@JcgsCcll0_h_>)O--jH`WPDpjZNMX;y4$?_HQKG-y8Ltap9)xSA=WA}2Y4i? z9S8GNziWM)IRo$k#wG^hLVHp|{kw8d!p7>CWvpe{y?Qfx3TILlOyN*SdPl5#kk=7j zu0A=BHd54^Uj3%{Ym48aPtkJ=NHvxF#k|AK(s(H36d2@T>(@eC|Jrck)*THeZT+Gl zvT8zI&PT5|ocPg44JUoHy&b-{)D&vyt!jDq_nh2>=;F^fz8D=xDiNM@|ikLVAjX5#7NLA(e+>(YH z(S&?)W+~W(`3R-4O}upq&<|tJ|73RTvzuzE9ToSzTi*KB4F1Mj6YG^zAzD zIXWx{1f&AWD?VXEs=cI55|mI5zVv1L?Y>7mip;PElJ!2bzZ+*9|M2kOL5}T4V*=#{ zH}SMZCD%E-P2SlIdjI)_5C^E&@Qiv5arN@&{i6B#DwI@! zLsfg=82d73aX+R>rQ;W+PTLMTg4v2Q>8z~ON)=Km2d0dwu78pl6CefvwiNsH*C^20 zzj~Y;?&z0Vb#!ac0fNwG#0H$uY}tTcbiA9e*IR>tG%P4di&Ac()iU6#ap8L&C(0$J zRuR>v+;N09gLD+AE)H-*t=-dYt+7sQSYRyiiImRTg{=tDr4{hU(JEPYq+>%&EY&Fc&_ESlV>^4BRt5W zHEld1k6sg5bVDApC?Efe1MubO0EIUEzoJi(rH|vlF~!~&cERyzxS+>T-|&RW{NMrK zLU-DHq!scTeHnkS9`Q|sj6}%y_3|T~%Yg@Dh|Qo)(VKVmWt9d+*o-8pR@V4J;sCN% zI`@rqIT2KIgVwl|!2K$L(ffQqD`k}4S!4w#naPBtOZ;B3zH@iXSKT?Hti=9Q41b3? zss%f2pbI+|{mPT)55$=6Dz)B>S?3rtw*FGJScO_!Lo4&>_Z+spvYZD!VdX@gIv#e6 ztenk5zg_uXJpaq{8y+qvT1B5;bsP`c}6fQhka}dvIJR^A~iA;DUw~ZxLtDkH|KS^mP81T;Z zu9zpguuugG?LoC2%0e(zfiA$yUF0#kpzN}MGmC=PoQo_j@WvM?dxcFH*bBR4+eh>ho{`TmR}pi#YC&&$ebMfupn(*mcRwD^{;-M{;-4fY z%EcpviK@cJK8eej)FrN%=S?3c-fb@lgiG*f2)DHH3A3v0f2@B}yz^=h&O>|@*)c_& z3{v9?H45k}lv92n@llo`K8mgQa0OoCFV@plq)N)_Jx^D6!96>M4etD*n0XE zZz6l`IWTKqtlgbzhO0#-C7T|id$2b^Zf7V@JKjAw0t{M?DIGnE!K{z;tO6O znXWXc%CMscz=JHnp@}?LODu)!OI?qv53M|vUNpYpjFpV4E8+ZAC-Pj#1IMqL!?TzN zZG9D^;wp~HUwtUgu{^_gNVEDfo+!^ko>m@u9QLieHr8ouPuYZaE_c3pgP8ME-FC~Y z-Km@1`lAQWEe{^Bj>34y8r>(#o~82t*lt02p41 z9=77ah1MWCRiHD3wuf#^uJ9{f1e#?CRZS$5ZZAA3S#^(wN9 zvvV<#>1J!4rl>@WeOa*ZtcqPDJ`LZqT6*`NI09XEY5za1oquT6RTRMA+gokaV2cJ? zEuHbK8KXq4CR?D*O+}qfa|T5%s1f@kRD8L}G+B!CoBrdUHL&=;_X-M(0)vXCYyP0- zFK82jC>!zC`e9}1Jr5!wYUQSLs4^!)676;#8DeM>4HTPZzP5RxYu z1M|J0IjL-mE zP%?V&@ux^4Qo|>SXEEEF1>O~-yBWLu!eQQH@;nWc!-(QgVN;pMjsuqa&m^^J4|#-> zDW%wjJ0aR7A;-eg6jfm8&gk*eCHixl8x=?HcP_(iwn3F$FoPVOtjb}Y7sMZ@Or0qz z?R}pPu+n61RH`7>1A4u`&0)}0ca8) z0jL}h;`32if06f}fnNbo9XouXs1J3eai1SihjJd;6^Y{UU#juSc|OJ>nCROhvSDaTdAs@^=Xf=k%bq!n5LtS4~E`avg-Cw_XGi2q2wV|Bh5&>p;w$7ExH zh$e0DB#e_IO;`PU%M;V07HQK6qf!%Yx`YoVi6}5TU+maD$>!Da@}ol%PFu>()rN|( zqF|EKz-7N`lbi$QwyV|!=k{D+uj=t#$F7wSH`>q5C`DD0w@vjF2N0~0hK`_N01~oI zb+V&=GQ~KRLFss%Y6@03j(_!V`CzzX;ZR4<#!DFYmxANLsg-+TL)9KJO;ss_>u@E^EZUSBg_5m^x z#Mn6p!2IbFf;FuKYdQ(mY$bSeh--rYZ5i4!_W{VC4Du&KKbdC%kyj~zrDEo70OxGx zL*NtOOPNdu<9)NlfFgWKt$QiOC<_(gZQs_h=zH^{j}7~CvQ5qmWqFS5LN3fi@GO@Qnv&xRX7b=s(q(HWO$Y^7@2H@oospcNJ7%2 z%!Yo{);Z>}RX>`PdNpM8MkA~{wW7e=Bm=b?wa~`(`!kye3;WCCJ7ZKy=1{D6X-vIr z!VK$xPCzu9SiouE3@~b#f!fgV^kM*Fr(qh2il=uAQ4_^|XnZ}wfOy@Jpm8%N8FZBe zjm3!@iShEIq#3+U`R~)@aL9ZhkLzUOtdyN7OXf-?JdgE^zAi=;Ge*84SIoYNV3;e< zAQL3(yj{#`66Nu%%_Lmbt2HykUQ=D4Dq8qEMK*|6RxX!=H@&RJ&O&DsGF2@tpPm2mXDno*@`3E$umnXNUsYh6= zb6A`2V{MVcTAgBTk@$0_Zbd*rpDQt-?9XJ7O%$=-y+)<1c(SiL#2yXb1wO-|4No8^ zihz57c>rGg^s4|X?DWR~3Mc(T+e4X0P!h|5?LZIk5rD$UT%?mM9b_eEF?&BB76A2t zoR5`#o)74zEML!lCE^Ir#q7z15tUBtk{S?Ya;uX!Li$P7j<_XuFv+e%@ruOwCU~wg z@tw>y@xDistUnmOS=~8%OJ#H4)nw;V;U-T@(P-w1si%ZD4ag+v3EWnbeZ`}AY})?FBVU5$|*1L*SNMCcnVk#v;&QDHr@hWZyl>8#Y*1Ea(JSM zLPy8Tj}q{c(;FtXrQ-TUNn@6Dtl(VzmF@d9#|jNp6C1e~o*7BXOP#zl$jcIW;Y`Kq N5#^|z3?Pt4{s$MRW0U{@ literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_maketables.obj b/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_maketables.obj new file mode 100644 index 0000000000000000000000000000000000000000..885806c6122dadf57e10cf115fa775773919e5b7 GIT binary patch literal 3298 zcmb_eO>7%g5FXnb+xejlsEvr|!3Q5oBdnyZqPG0R#!g+JQqnkiq0KhSW_O$2vff?R zy9%K>Br=f<+XE+rkdTaITYxygjbng_AaM)gluM9M)hY)Ly)_bM-r9|uG?o&1t@Uc& zn{U21Z)V=kTTa4AEXE#qELkx{gEy^3)(}j|eZ6uq79Vn@pS|zAQZ0xJZPKVSv`}4;w6BGGe5qR96I1B4qH2G3r0+a;$^gb zGljkkmS$+uIN*>O{!H~C!Tih>(wM{{$$De$6X>g+@^9m!g@sOap_ zU~G_8G(ojRiCs`MQD4Zjf@!I2-VznfqNHOD(oFlLIVndO#~X}S+h^odUGRA4$jGa1 zIKA{UZR!RKe8gPRJmUG4De+Tg0(=+5BI)<6C8Eiy{4$xdZ3HrR7+R&1<8akr{wEWebzP%oDFf< zNAr^9szqg9sY`VwHQ`mw&bivW!3z>};@pQ#AYKa$*;O0ZLF&eatqFBW&@5ARwY+M` zJg$a~MvzT_&-wv;FC_NdeR8Y93l$VmSMtN5+S2!aA3&B&PhI~h!2s0g6%0OMqRy%4 z>ZTovuRUDBKsgtp@hxX}`T^D6CjR(1gmmv-V?+4|(_n$^9B*y(h3rk(-+B`474 z4iHyUSnqk-xZnBX2Vddukn`u}_Uh(hpzurR=f{C?x-ZdOpe5$LCg#lHJRkQhqw7b2 zl@M0g$$K~ctJPM1 zqnV3u#cPG#ZmXwB;mb7TKw-nbZ^Y~yh4)5w2MsX7d$Th7jdy$e71qO8Lcx`dWgIvg zPu19`4imk3i<_PK6~4L!|MU=F`5f_=M@XQ2jWFeDls_OHgIluiLwJ9}p7lVt z+s&T(kp)Q=7DFmoVi$Q;G{db9cZA(amaq8eq#y?$4aXo3`FJx%T=R#JFb6GS#HDMBWt!LMU`32OTIK8WAIuIGQ64mQLj4C~tA*NDRrQomT3M5!GUyNR*U$3LVS& zdAD>wMO9UzRtv={;}@)k5%svS+F4nUfhHVZX)n-qTDy) z58&AEo$!{^VD}G+lOUJtjr0a3AHa{5;oy?X2yslv|PNu$(1@Avtxp$D7cBZuR%U?)S^=e(} zV`3W)022G~2|#mIuMRSaoh)XN*rxIQPUX4JiB05#VZ-UClc6Tq$J&txYo-Smjy!l=C{{p2W{nxjs2ir9wChHk^qx4< ZYV_uzgNOP)LjPuLLm~7mJ0L~n`~ej{-G%@F literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_ord2utf16.obj b/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_ord2utf16.obj new file mode 100644 index 0000000000000000000000000000000000000000..0e75840d4bff77e7925120b3d7e94f578d216793 GIT binary patch literal 2303 zcmb`Jzl#$=6vw~$tp|b@BBDhaK{#$nP6>K?k~PW2A4OskMR0N1?Cf3^HoIXmAzWt= zAx9c35i46uyKD6t{SU6N&_=x4MjPXsB`O?PgdNzOeGBtGeCNG+^X5qzH#E&S@`#?t z*}&pr#~9e$iH5Z++NEM-6-#Ew+4@Mh#gb-YdK$o~O30kLWAS`tbv0koN(D^oz_+;c z*|YOHrdNT(M{m#R#UncD_y1By_CV`lxcFXJm$EuCBB{5gA8zf;*TnmpX* zRzJVx`OeU&^}80gE#~mhXzA5_Ta1_&8pVQEFucI_N6azCUckcf(6G7ijiF#(ASAT0 zfY#$f`%YgHn+xKt_(anWZN)1mqUA^7RH<_)xMH0|^nz^(y|;+x?fCI@I1fVALaEN| zo@%IIzSmU@H3OHbMR7=FB`FW7V9ar)P?dYs_oDJtc#06w6GN%9z1X97;7*|UQD5MEqF#_ZG{cG8tbwMKST@91ecWUKX7<9;)3-fXv1^x|a>Z(2ws z5m`Vw^T)~^172m3ou}qWJU;^@PL@sCcmG{4=w5->50C(6A0}V$1DO280U&albmIWe z?ERVpn{yh*$KBoJ9?iu58llMH-QkKm`G^B|cjf8(qn2UqLt+x4kfqCJe>4l5-SG03(o3<2 z!b&clL_GEC(NpS8>B;yPc=I5l^e89=ah^fpn-oL0M1FSZd47G>M#uTv@9Z|7ejq}bCQME%kdGZ`m!kH%`TFwRoeK6JYZgf2jLL8Sj zQEW4<#~YODw$bhYvqC9KVw!-%0c#0sRMTd-MYg(iCqt|G^ ztI@3i?=&fnXWN`puV9jR?_R-rn&zHk-~Uxq!aT9rwKD7cQE*%s#8E>HZz2ktV%KIt z(Ohi5@Id>2636F!1xc`h9QD4CKpc2_8RnFBWv!i*>g5XBWw9+L*^(+(oArl{q;jX# zO5h96((qy(VsQv9faKgCD?JbJJO!yB5yaui1%TMu5}Vz}E+}|60UtekaX7`d*M%5B zYxlL6-v1c{LFZsJzjIV+N)4Lc{}KN9Ryq?$@5kTX$@lk}@mhA}-F9;6?cqXZT+1dV iJ4ZnPu$?kr1;Jt39M!UBVq!k7Wi#V9odXylbNB^ipiV{r literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_string_utils.obj b/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_string_utils.obj new file mode 100644 index 0000000000000000000000000000000000000000..f9e50fbe9ce99c6700d2db32afb49b1e41f23ef3 GIT binary patch literal 2655 zcmb_e%}W$v7=QM|)l*hr^m&pf=yVQ z%hI7FI&|&Wf3Ufypi3SqwMYn}*jskD=bc@}41;A~n0a}Jhu`n{z0b!y@1rE}94DT8 z$hzUEIoTl_Voq^1f4MWl#bf?1HZ0|dV_0jFOAIs5DNyPHfGbH`)zX^mM3epf(P3_Q z07`QJKNvXhHv4!e-39oWdELv$&Z))Eiv_z%j$4P)C}NLRzE2D`gQaJu;6(%AwuvEK{7Zrz? zVxFjmMJVZfgEZYbX;#Zp#)SssOzVu2X)BCRj*PPDhm)mFEJVgS>!nRe?>FK(+j=}T z$FXeILb279b=IUrHH}rqq>`m$w=fPV?Ih+QC910FR4B_DH4VQ#8U96((I9!MQ)txa zz1C|qyQ+|l9P2bmmTQ`fQ!inXSf3t8+DYyi_Wfx@lb9zuyAsXL9|^~W=2)^H!!cx` zQ*5Xi7RAQ)TcasRBYf=Hi}CSh;B*N7Gw)}Si4J8JcZU#i!PDE&CM``pTnZ=WQ&YH4 z@k@M|E|FAvasI(VSeg`s5WcY84zIpKAPD{rAl!DcYwrMf9)ZYl=r{=FK7c^ighch% zZ!AhSC%Fnfcv-pFtc(m%^9@8_JBzkX;p%_w%E&ggcO(AlS-h!P==vSnUVeiBfKclz zR)V_MQ``yai9K=&m(C}Z;$a|EnaNajuS4H_>weaYqu_psS2ERdxh&Lr5feYy>Y2P4 z@@1>%@qzo1LWJd7RQIm?eg=I%N2F6v9G&`E$yB|);+x~mg8~BZ3wCf!Dqs^;k!450mR$Kn zNDHwwXF=q{L#CzBfrh3-OWNtQ&|!+wbXxoq;<%kss?M~bOj`o6k&vMVQblo0)Nl7> z*-71*GVvwf?e5$6-oAbNcHf@ddmC9_S=n;Me`Sxy-`eH$EBjlzTz)ruec{$h>uOe8 zz1GpK1X}l3y2!y&LP%kauhqTP?etq}Zo0{`wsP$%aTN>aAkFRC*s>)R@9GydFm z_5O7G{a)W<8;U*V+Oyb7mDUc=?nPGW@U~&MEV4`KPFi%ADy^;VHfrc%#%PC!ZO=tK zMWE56bW=MUGBJAR)yHV(ZkMvZYq6Kf;SF?jEb`JjuthwO_=2pYCAVNegM7JbIcGIHwhT}L+2DH7XKMedE7y_K2A45>z z1KbC!1D4V{c!z)&(O-q~G2lHQ3A_s+W{Dj6CNHFgi*m%MroOI70}e6%yG!Y`W|Qi) z+LYEbqm9HoAcO|xM<0SxVM>lP@IqAhn;gkkFMM5@Qb)x2li*NKrQ^-u(3;MLq7N2m zwUeQ-Kpt8fK72?B2hK75n(bVCEtnu=O5Lg>ux){At#&FjCiihns^-%5WQLH9N`t zQEs6+)Rb8ZGgNj6*SpXqMU&pjI@ai-*by}uz zEy5QEXMGW0s&j~!amX+AG6w3vIg%DQB5F<2&dg>Qjs5FlI*pYa#1hPNTFE@uNvvL+SZC|YgfQC6-hZv(I`T5s`593sy9?M$oj4-677Vwd{VPv0#EvcsR4&-Khl_=3_rRw^u zU0;PBfo;aasLhWK7E*HG!)&02OTo8T z2%bddAz%%?q1d#O*0G_OQQr>Q$)Phw_01mPlpHbDLN5{4{DE%lj5P*kP1cs7_jOBd z(S{SZLD?6zT9a07N{Xv^0!v4X^gRx2u`DYL2ILK2P$`I#)vH zV*XT5#ImVSn;NxE(ZE3jSWvu7>jS$)Ig+EMdX&bml4moKArekorD=uc@O&zF>xmX?$h7hh9S zT2gE_7Z%bKS7a_U%NeEx3X=&*4_U9kgxm+C*prt_IVEEb9$rM^6WPPlx2{7#@|*W? zY1sEC+_Z9m$AL27L0~V?0w{prM96+1nMcS4U;=m_sL3Tn0{Va;@Ht=-{BD%HfxiRK z0>20E3&1ykW}phV9w3Jgld}=KaCXuzj0?bz?S}E=_MGt{yEt(gr^i1Vxp#U16?g>D zfX9Gu15W}^1K$Up1&#tg1)c|91R}t%ftP_1U=;X0@JHa!z+Ztk06NCoz&k(!_!saI zaK4dam!^wGGp0nZ03<$zSho(w<0$C1MzkRzXOFLu*bbbrCMb5JtVdxyxugwU8`#u?JPt%PHJD|!JZ%yNPbN>4oRYp3pbsk3l9A{=M$8(cBa3Yt2p1^bS`fgVh1;Ikh*bB z>G2~OQ!;*%7wD?hO*x0533NYsP@LfD}-KbD;*f z8`zHam3SmWYsi$ejV<&XlHU1$rUthxbggzCl@s%sZ79MMn z3PqJ-#*USt#1*~q7pN4~X12tC$h0vZX4j~D8rLUnfsVE4NCe<=a(Ej#OK>DC0SbXq zU>R^7@M++B;0E9ez-r)&z&cPr_E zTKfzyh3eoXR>2hvO=F@IdJ?#seUm2v1HE}k)^tJy2$EuG z9D~Y{E%Y-2Up3d@GeYkB0iB0!YTmU5`L`)};x1fyvEQ7L=*e*;#O>y$$^kW>SI8;e=nh#)9%xE>n+Do)MB@9-= z1b+EJI*rjqHTJPmbi2YQmX8{r(V6Kde^&B5H5W!l61^dsAJ6Epcpt{8O?z@5q=|%{3~n#d%2R2QIW$am3C%%wH^`QLMAgaQi65hOFXC0`-ut}1eO`;tZ^0jcIq@@At3~ly+TF0k-Rbl1hikC}bRGT!6VYA$ literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_tables.obj b/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_tables.obj new file mode 100644 index 0000000000000000000000000000000000000000..f281860ab5bbc73eb7ecec0863ba16d799ccdad1 GIT binary patch literal 4688 zcmb`KU2I%O703U(_r`X<<2Z5R*a7pAG!W{>ZX24kfvnfA?PP6lyqn-UOKxX($9t!H zKUQ<^wY!y&szOCXkw{eprKqUliqxLTEqW}xldqn>IV&o;hA7*WNM8E0X2kDlNB9`(zWxY=m;GC4uw zd2L>Lhl|wi**n}%t83rJbHA3+EZ520T^qh&9bOkw2cnh3M;OK2Vh?QO7OR9jeytZ; zW_1v!HqzW&g6r;hGZAwgZ+Iei{8F$O1z$UcElzQKzG!D>$Hu9TWr`Wwpkr)eZuVl{ zc18;Yi-H$B@hXr?qow_(%igl00i9jIOC9LAW!*~SS|97|bsRHh_Ls!569`{MKe2&p zJ@oBZ@B1Ntu3S4vYxjDq6RD@LU!Rr+SB+ZY2jP6Y{mD;ZFr5( zHhw_)6n;u>$1lho_%*o`zaw|yIysAfkh}37xd(R2MmKhod(lhwV1V3*BjkPzk-Zop z58xDe5E-%$ljI>>AoD1b{qV>Oc!r$AH^>6MO&0MgIe^#6!}u9FhBwF$;J4%l@q6y% z6#kGhEB!}W263JI5dK7t90gLqCCl*X-GK)6BY28Dif0(d!WU@Y zi7(P}4_+WYjjz+P3onto@iHyP@EvjzuaO_akI9eY4e~R1i=4;X_&XFi-nITqgT)g**g7dldnB9#4`d@GLouFOwtqDtSL%CLh3e$pw6$ zyo?`_5Lc%Ub`OUi(;mWM0#RjHCsPi!qEmRZY12`*g6tx)uBiLM6h6U! z!s=2YOK-@p?}tWf#2jEYLN*DcS`0O7HXB-nF-y&U=^f)pwTxLVvBw&Fz<906hU|J$ zF>K9iHrxo~{5Lafu)%~3bKfFkX{yA$~q>JCxjNUqN4qz?kY^OHl>z$ zrbvP?#H1{1xr|Ar*=Hay<@1VA!gH8aUoh5Gz&WW{R;fi5tvI5PIdJmA^~93;AFJjF z*v&b?X_(}n7m5}Z0rMzWaurNR=S5SvPL3W|=rD3ym0VwHZra>Y=z>){K$kW3ytq&NaPEjZ)mq^UiL(F)X z2{BtUdt%mevaYHtDphAH=H{!k)VySW3}noOFo|80^73sS#|@{7p3q84!-sD#}4t-0qF@*(mO=HwGxXv`&a@IokXF}aHDt{@UEm~Jglpohsf z%Ys+l7d$L9un_UB1w3bdulyIVEB;de literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_ucd.obj b/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_ucd.obj new file mode 100644 index 0000000000000000000000000000000000000000..910970cf398bdb04bf6037d5f16166f74f1aa083 GIT binary patch literal 65661 zcmeHQ2Y?ji_5Z%PML6l82T~OVPPjXjgywPBVhpiFVo5NT*u|)c z8lz||*rFzy7)xRgmLzJ7B{7Mbg$}%@bM$Yj&``w71f(-YDd(lt(}!p9j0!mt(#f5 zs=j>c(4plOBPvFzt(8i>mwDdv&hA;MwoXv${pEM`s2uI<4aCIlZLZlk;&`=nBE|ZcHPo(I-+)QyanhODCtX*! z4l~Z@jI*-OSiN>bP0S;QjH}i<(-~)>bz;wfuB~nsInM0CDUdun74R-arI#f7Z$-?UDjOPtdzEt!|nWcaWmqS zYTiPrD@s(!?xNk6+SUVn%BrieTY5H9U0+wTp}uw#JRworx`VZo$GWLu)p2#BcfOF= zIA&)DrM4FrL+MgX0=Lp$Oz~+B+)DRj+J$LHrrnrA2E3KFA=(!bm80C1j9Me;51eL~>t{@rLviq)-P#P=>U-QJ#Pl3O9SDC)T^fjcAZ#>H| zOw|{5HMHyW5A8bi4x})yYneX5^mL{}hfp6YSRRZrX<@ z&>!N*FdfUZg6TM>qnQrAk?KujI+FFnnSOEr*}q^ql=VZHzRUW7EI+_>5YzjZ4nSH0 z&BLvfX%Qb^JzA3<=^|h|!F=Iy(Fw)@VY@rYafp+QdX7gs?kDsg$aDbHDNH9L1wXu@ zUpZ2cU&XvYUt@~LHOg-?eT3p8{>k<7f$aL3Hxp z!gL2yJcTg-V=Qk+%I78OKSLQP9xttd!Xv&yT8&U-Zb z9nF46v)|EdU&;2BY+uRxwk)@8Nqx0tzqVYzt@v?1i~TM3x7goee~ahE;$_t0K09+< zXO8R4ah*A?jO}G?FJpU|*tw4~&Oem>hqC`r_8-drL%Hry?qeMLk7K`a95;^r$B7@u zjpI5M>{r2Y6`ZGn<0?3=g5!F!e^2)B$^Jdrzdzgiv%Npt`-`3P_2+ye*?%Pak7WOm zJRjp(Kc4mDc|VO8JLfHDzjF2~XTNf`Phk55t~-I_C$Rqn@#Fp`@Wb&0emI`MeGcS2 z14ZWefgC@O^A6-X?cuyVrl(TvIgXZr7VWvc{aD>jD5q=3Y1(l+?KoWv_G`|kb90f| ze=tA07|i;?JdD9SjNz;w-j+^>F)WYax?NfB%5n+IB`l9+c`VC)SneY-PfH)}rw@;_ z4_3V9Cvp9` z>_3#pWV6jE}%kAhrC0=R zrO+SVFwgZc4re@nBziwn48`%j4SD;**zt)u(hph2czky5>{{oag4QU$1Lk7h-5nr3 zKFW81H2A2FWlCQr+8v$-pxg~*u)p*Y(OpPE|2ESi_J5P*x0pT(6rb$ittHoM$%jKr z-n}jPG-wZg+hH0f@@}5UyLTe{P2{*PoTm%hyYRBIA0H;&IlepFd$HV$W^hvVjmo%@?6l>Mf$-!%4{&HCA_pUrt^vwb1! z7qWgK`!5tb&&xutGnMUAIc_S)O%*%G4dl4x?7y7-my4eLmau&Z=UKvjOT^CpOE`aN zF&&Sk@Gm{yy2-Op{-sPYAQe?KzWIa6_Xg`zHt5|&u)80aP z8hdk^-t51W?Mqp|l=Vlj{s@*Au)Ki%j%4{rmXBiD`HusJy@Ge&3a-0??JGFn3XWUB z)3AvB7IEAn_Fu&Qi+Gi-WqmEjRdZZ5>#I4wTI?KO!+tevuVMchv9o_2>+9IRj{WP{ zekj`y<=uQJ$IoN^YM~srn)9sY!?qL4-TCmtLpGb6R+fVzrp2lma3yeW?r2)Tf3|*L z1YEIlyezn?ls<|fLo?Mc+mqxv|sOqHv?svqn2SN+uhxEO>r2dOgP2de|r5J#3ihC0$v zu+kVv9;SvhdJT8DGB^-0rc8|hjxZ9QJB?QEtz=C^$24Y50HEhYb+9@lw6{s>P&HXiQI!yV7@$l|h5NL|T&O8i)8Rft z&4leNH5;~b;Eq6kt~%V|k8rlqLz${_#RFOfx@Mp3sF)h^c5<{@rtrR4EqAD` zY_&qIbYKB5SPs)x4Xg7p4s5upZ>!aS8daMTc8EuvI@UprIxZ!S5Aj%|z5@8FTC3Kn z^$s?ujp_tv3^FF6^=gw!bZ=0b)rl~Qlhn!Z3JFG>>TGM&*BqRtlH=z=!RxXtu{bo|yOfI*>}6@-9}fHn1V@0t-j;^u&$jFQ$Kzr@awP}$;o<;M-`26dzQp@SP-9sNi}$4!cGGgFa~icTo%aD=xcg{^*^ zHf~i2%>5H*OY^v=wwFN<;m2rxJMu0OQ6*d5=HPa5z~J zltHb=^@x{&n>_Wcs}iq7mx1du3V%hIy5#By8pPP#p0GhRw3jKY)k7Wo*|A ztb`d*`^ONxp$sVUP0w&q_ZGlbe~JLg5XIB&6P6own9c1+8e6^XSfsPJKt_-rdv$|4 zO1?$^KR4#|`@W-ci+7#;?hayky_dGu6|GxT52;K+1WXPWWRs9vR;T^Yb-klpQ zVin#kQwDDq^83Jv`#>4k4sU$P&sKkf4vg0aPDg)NK}e@m-`!>U{6Ex(4n9)J@F7^q z?_>2bb0q&$5oj40B_h&)h2TRc98-L({;mGcxqqTQQUCD4_Q`&GbXleZ8&8B!T$Ya< z-sBIDv0V}29#OTnXF73Gy%S7!vvb(B_)$k?){pQ>EoGxeGJoMAZBkRy8$Ced2735?#J{IT^m4X6b#Lgp zyECRfItceHm+K(h_P)BWvuAMI4|u}<8qpsr4A4Qi;|JmbIk$5=g9ADAV^>2y$`EA&AQu($Dgyq=IZOwKJt+(ZUuZcf*=({UXf%}%k*+h-P=sV$C6wt6|0T0kA(SU_0+$7wJ8`MuWT0^#=MfUZ2y*`!g6ldyh&>Qqd0OhygORB=qUY(#% z(Cy*F!p&X4t2^!BL&C+d6-rm3%(h-{a^f(yJ>)hP;V@G8R`5}2;!7YaendMA__1yA z^V+pjg=*nQ2_)0D1AM*_wfJFYK?!^en(8fT)QJtLvD>~+N4l4NswE$?re$Ehh*7At z8->cM9i$DKuv7^R`k*Fx6?`Rrv!++%g*#Dic5tFLoY+dhTOd)A<0Qy~xlY!nI6iF@ z#h(h&iToVpDB#dva?_OK7JUe9Kti9dfv0=-gz=~8F(10{zLRUeq0`3}oj%eTfAWr_ zTWJ|MDtf?|*)weM3Df0nj@-)!^0}+j6f&nCpS_RG06qvOx~H=|_u>3E^j7D8e7Q*bZGEmjPoK|MbLpC{ zxz>vpdoIuy=tSRIw72QMqrdBdbiYj_P%=l&g_`g^hhC)P1AK9d>$NE2FV^{m87Fd= z=u2H4d2J|tKh3w&2Q$c`4{s zBt~A+X`?QOYx!4bIhEZM{oOM1%^eM147~!PypUHcuGClR=B_WA#60AQwJeaZkE`_F z1DrJ+9e%;()%t4ayt%qY?|rafuUxCIh0f(Tu+?@QHz;@BKP?wyLAr7x*9q`=^+V>2 zmVvb*Mx$o({b@6mO-3)5>JYt7XM^x7)tQa~<7CQ(1~p`cR{XjfbX43J z*)wX!eaVlOfrfo)NHi8YI}F?T zFBkvQjRyGv2}3bXuFZ#0yfz=E&zEjd;PVAi`7Y1v3ZliIxu6l<4X-iKD-me(&zr~+ z=ce~WJ_#gC{wTgefHqiuums#GL!vjPFzk{6=EJ z&vg*L(3#;e?ZxBzasA7*@GBjLC-f5`vxEKrI*ZFeH2xbUWoHh5k???^&}T~hVu0$n@@k?8$`4g&QrYJ&Sq+QRsk zv|Ec`oA!nCi;r*QL3Phe{_tqZ~{);esm-bIOIn2~1;`Xlb z7P^f#1Ni=vM0;HH(K6-E3;T$YotA;~qqs)#k>STh6V<$gFV)CfeG*agjzHva$9ca| z&>I)*8h_xsIec2Yl@sfK6Ovmt`Kczx$fwNVUlj(uZAs!tTLKm6-RS5?KQS(ynDIy3 zoyLD(=WvGF!=2`E@BCqQIv#0jg}#w%ai})cyJ@1?@j|)$cS6g+HWAaKbg;T(P!mn2 zSp0s261cXF*IWX6QjGH|hoannR?WUr?$ zBzaF~3L5GAI@gGMM!os|qO$?~R*xolvl{6GoeF;oc>K+E7@ADE;r^~O2mG{-{xBxU z==}LU(jPZMeBz}4)bW6pfy*S>zjVC#x6Up8PiGF?9iQkR;@nNS&h@D_z*?WeDQGnD za+H}ygmqBgf1F8&KW<>D?K?^sFqy?-?%5j~IGi7z0Ueva-5Wa`i!|DllLZaSK z-^)rD-fX?CAlx2(EJS%splrD9>*O_ZA9#rAX9cmpMR50&Prkp^-x^>I%o?-|+>kuc z04Oy83i^Rsi5z4Rypu543c~A=opgYe3kF zGs21ov<%!7PqIw2Bp&Wai;&1;lvP0PW+2h5Hy!<+{0z*#RGXH8TcZ!D=^O&s$!M#o zAbeg%TVryF@R~+D)*>8eC4%wYJGpD%t5f#Q&g1Di`&Zm311$qP;!2mxJYf?TZ#}FK zZ^r1^;Fp>B_nRojkx>V5|9}PZ-Zwohb$a&dqSp<2N~WMCUQO8kOjnocHS~Pg$61JX z_sDV-*B+r|;I6pRCC?Mw$x+_q5sWgL&5b`k5}lKu6-kFi&u%=u`EBPXPQ1FHWTK;U z!7QmYo8h3v3OJLpHIyv=4kRm%#6KFpEWZ96QDlithk84vQF&|8c#SSm$H}Yu>$vmL z{KZ$tyWpnQ0l=DPj~Fo-nyKN?yND@{HkDe~u_}c&6mqD0%%p$uovq{W+q@ z;h9ov!%m*m^-3ZwZ{F(OnAA1=9^QCw?nII|#-A~@?2S)U#jE$mq^{xj@Wy*{Cz8A| z{)~xaS_U38W^bBA#k_iN4E~H49#Spx0D0$prti3?INV~#xRs1@#2FS zD3Uay_fztsc&bWKrUN5;IU^Zgsp-}PdFfp;2t`jfAB-f8iO(%}k-DgHp2I37fA*QV zRcd9Pp=m|Rc>Gklq-Ed{5xo?Hyc(~R%8s83@J9G0e_QFw;r~>aEdF}w$*Hc*e<@dcmy5hFtRQyuO)8!TRZHs46W3k0olsopjHg z6z(pBr;bHRMWc)_RgUC#_v|F97St!tiPm6@Ta!9ImmWA~_qcOetB@OKz|1xs1#!&^ zEdx(vk`5b@IQOCH=EWYBx?>A`q8W%foB8mQ9>Z&iHCHse>YmZ&YK+P9#x+t}2A+;9 zU9R#Znu@0P-7?8KN;Hbh^~tKmYYXo&-WvJM7CxfAO^e^TkU8X~Xj%rI6>)E)@)~!6 z?wd1^>Hz;Te+3=RjnY<8akG-|V?Zf+;k`)-@kzO7u@u=&K3PCogRQ@?iF*H8b(mT#U>b>>-Tf9sqo=eD)# z+vlEFb$-+XB*-Fe^r zf$+G_7+MB)#g%Ta&htR3?jKzFP+&*oSAiYw=^pYs;zG52%m6I|ujivwp+;c_3Nz3& zXMmQ0H=1U1g{}%SP?&*y%m6I|Z|9>_p+;c_3Nz3&XMmQ0_nKyNg{}%SP?&*y%m6I| zALOG{p+;c_3NsMz4E(I>;YZ@gNXx*7ail8b$o~wa{d!{|U|*VnN8=id+Ww%n)W70N QSICps8F*BkXDOxrACiS?jsO4v literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_valid_utf16.obj b/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_valid_utf16.obj new file mode 100644 index 0000000000000000000000000000000000000000..0039d097ebfd694dc43b47ba49e84a08f3698ed2 GIT binary patch literal 2429 zcmb`JO=uHA6o6lvH1$?22o`(DsR+R(F%q;DY?{RWh@>{H7P@xX>`%L}*$tCfOAdk| z1R{&*NyL*^kDlsLEQkjWw!P%w!HdPR2SLG#KUv=_QEI_M$-wULmYw&_`k_AXCrYNRaP}ODvKfSvr=3+wINOOt!&+s~Yu$Lx z^d3)*5X4Kj<_n8+ z5oxkm4C4!r2H@#y2=zfA0Yv)$NCU?J9!DYShy6ZyFbohHnvhuMJ$T8$+XXy%10jIo z^&5-L?b|2awij+}_UVmraQ5Au_}i`TwQyq_-1go*oUFU4!Htglsr~`J0n~p%8-R|~ z{f-adnDO@351hRNcZZ)xaJFZ9OZxsRh&Y#;+s@Fz-?$`rS8=7;!HraX7k(nG1MiSF pdT<HvRmk1ECpydhL|KQ~_b&98&^b>H_>FK$XJ%bVabmEY4jTXz5e literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_version.obj b/3rdParty/JCL/source/windows/obj/pcre/win32/pcre16_version.obj new file mode 100644 index 0000000000000000000000000000000000000000..c9549affccbba1a22d3cc4a48da4a9b8734672a8 GIT binary patch literal 2389 zcmb`J&x_MQ6vtnGiy*Rs3;sCt;9+5DNUKz>i)=Qj^~a&LjUXBfX=ZjikRN3-b=jK- zg~DDui3mck9=+{R@E`H8h~m*dV0{yVE-M~N1~SPE!~5hr@6DSxFK)wzra31bF=3oc zJudc~sn2QpYTVGSHq&0S?LMbGVR5ASFh36fD`re+k9xdruCLeIT3d&C7vNhy_WrBO z2Fz~)e1H1!lF>Y&5r_YmIrFF51m+#I{rT+cW@{N+xngNNMB^{j3&wr3;|zGb!@aP6 zhXpioy5ZR4zDFpJouOgXM`A`;>@;;vcUa^HGeVtR7Lj;2aeOWUClQ22LPGl)w3i{hvLj?)g zSTWR%wlP~2yHsY9a+eB1=(ZH9a*qZqO;3fV2ojk{q|Q;cM<3+hqv6;WdsEe6a-&%g zC=R`gK~lYX7xz;Zdxd%b$D=03N!G4g%hn$k%LV0;m-=u6DYA-PTZZDtn11Pjwv~zK zEMqQ<;PEPNAw<^WoR@_XV&KghR9w6J*e;uWtBZZhu#K{ORjuBz|7cKlw??B9Hh5cu z535ipLfX3m<;w3KKbvP^3y^-r0Zv2JtV-=@Q+eT(lsH4qbdxuFv_ zG`xkmJz@J$N7=Az*)8-DgHjiJy3eVSrGv^7oIe0b6Ud4Mvur5Rs6Jfq8)e^?LO3H1I8gj2;r8Iy=*6wB_(;bf8BhLxV=AN$>@|UV~FF zV3Lg9y@2N_oqGf8ekY=hm?wI79r%J3@Vbx{pIeV%J+jbS?Ce2qG0~6Zr@zqbX%RIC zai^Eyt~;J?gkHx7-bmJ$f(cpRljk8v=xTbii)(CkG-2Oi@3M2WF*}+&S}(S7!YiGf zCIsBDz}JNw!-C!e;BvNmmRx{O&0tQNk}Ql}f@6X}72|3_Q4$nc^ea*Tj%JMph`Ud& z+-vYmmj9s8C;Mnk0DOELfZ-dqxl`Xf__+hOIF146bY5!zprCA%W%%)^y3Cvh9Mt}P z_v|Lik{7jEb=mSgj=;m1HXEKBGO1BZbj!p~zF}pbT_8uadup6HHTBQ@`cD{{Ud^gb zvzt+te{TX!b-HwYoc?by!7EyQSvW~v;v;m5wh)TJ6M#?x<^h7w@sZ-tauTP8VziAe zTl4RSq9`0W*bQ^ascx1JU%;oCHCxbHufj&%V)^h*l&KYzh382Bo~xYx&sFdt6_yCC z>B5q_uyQ_9o01e-(}l&X`AeahZD9qebyBV<@1w6U&votl3iKD>w_ zoEeTLEd1nWGz-y~MT>{lh5<%~a$412N19Dbe5C%0{%p+@`h|Ar0*PGyeLHd_%O>t( zLVia)M%3VtA8`}$0C5bX;YNI`N5#a43vn@y}uslSIpB!fRNH?q1|41d)E%Dc9)EJZHHJ;@)LA}s}dhR*B zH*30YXZp)~&OVnly8$hI6I#gx)zdFeX|GIX-bBSR?3+Fe~iJ4JJL4Z+O4aF6z?|a{!o{&x2_m@UEh%zuR z2s-Ddq`Idj7AZJuYb%)PnHey2xG^xipwMuK>2vHEIxHC&UPf<}b~HqDC6J5Tp{2yZD>hKPG%C74UNxB1LhVg2Pr5gQ9VdYQc_aWKn|s58qLWBXHP1Y zB0v)}ONv4642GsrZ_3kXZc=hdWdXILDL$_>Cx^;W9}kQqYWqGOn4X|4^d}e zJb~&iYf|f9EH(zV|IGiH7$(R7)riK&gQ{In6epJEl*B{Y7r>?k!vYo-pb0=F%q*;I>>Qk2 z+&sK|`~reP!Xlz#;u4Zl(lWAg@(PMd$||aA>Kd9_+B&*=`UZwZ#wMm_<`$M#);6|w z_6~_j$w0HyGcvQXb8_?Y3kr*hOG?YiD=Mp^V`Agt6L8B{*VNY4H#9aix3spkcXW1j z_w@GlPnbAq@|3C5rq7r;YxbPE^X4yDxM=Z`rOTGDSh;HTnzifJZ`inL^OmjKw(r=v zYxkbL`}Q9=c-L?y_wGM<_~`MIr_Y|h zc=_t}o44=YfB5+6^OvvRzW@07>-V3(|Nhh5|Bg=1F0O9w9-dy_KE8hb0f9lmA)#U6 z5s^`Y!~b@`Bmhbdc)@?>I-ooVV+a3%NfzKs`1) zV3I%@t2{6j`~il+4v)0phS&f5-{`st-a68B#7Gk z)c1Yf_j&$-J?EUg*Is+=wfA0o?X|xurwLQ9y>`)g|9z_-C|$mOX{qngMeCQ9u3$eC zr(ByeiM=gZ_Tbv}53E^n?J}Wegdhk*3m#m)V$O=Cr5OcTSs6E8dtVTe+Bd1 zFJGE3)Z8ox8ofT99qHN?YYAhKfpPA?j&aGF2bX=vIS0n2 zs3qSqof~|m-!YxQ_`tgR3F!iZpY#58ey%7jUH9O3O(@#fvQ^(TQs44558U@1BVDp? zB?*Y{mZj8^zH^rPmM>qik_i1y+tLH9d47jdWX%I>AMkA;I!lZ?I{#m5b?p$asxP6uj@3Zn3=3D6}an_vT+dW0r zB{NG(EO5fsB;nVOZZVk!_Lk?gCh#{wNU{mSPZNd2h$UhcYHu|;mQaVgWbM*5=qrR2 z{zCZWVjZ<6A!!ME=Vj|36>NxDx^CIp^}^6RPUiy~maJRx@R|qKtw124);_q=fZwpf zCk!#5kpA_^w}A-Jla?%5vu3TdMsOMs8<(zmVEGabgEWv2L3r{KK`;$B09HZ+S#n?L z(q-RU;d^>G0@Dzfn#Z_pXm6E%ctd?N4H@Kp{Z{zb0DQYy7#soK0EhQ^5#VRFngrpE znW!lK`pxNql$q6grQSdaeiL{7Q51yTbN%%dA+>RLiF(+3hq__1rKhT2$V(J9C%i=u zwP5medX^`v?`E~ieap*}cFl!mso$On= zKl!9bJtgmHFY(@?xVsfkSaF@}ai!YCx<>i9Np+o5vuEeLAGmC`zfG*RgM_NH^`Jwn zjo`OucZM`V{%A~2eIT*nqeS`W4Ey2P+6flolrnSn${&e=AvyK(u^EBcriNn#(eRPO ze#CxQZZd0cGC-R&i2#!Z0y-GrF#D05y$web1Gkxh!G73&L~gQZKVY$}QZDd*WCoce}ij=*d)A|Sz|014b?L7G4U6jpsUMKukKn$DtL#-k34 zM|H%b64J!LY%5Um3?$s1c&Ts8y~`>lh}G8*%ZcR$$g9>-9jKw|R zy6Ulk62FdD;($pGPxB?n;cKLnKb}BwYi$US!jzE*IaOMS^ z)os3H@M<45@+0hXIPf*1k@`~p*iM*gfQc33Y~7qw4+LJ5+&59Oy+PHE{MvHf*E6cl z?%%)Pu`xk@JEC8qzCGKrm)dR6p;+FQ8(LK~B^0{cOTwo2=FJDI&H{DC#thwr*1*W8 zknqi$yI75$PRtOIFsf}jK_n7Eyd*Fbh9-b|%Id#6+-$-CSI~};Pn&PF>h8`xfS1~Jm1o}9cEU$>+x&Z_M--_`*0cW~A-@Qz$Y)c^k{Cr5DLn0| zl(y7G%#qJdDYM;{^S*X9L4u0Z*$p3AsN!0V$h%wB7RXt1d0LEfDaPAPoBvKl-v$1I zjmV<7r5*1q$2pYackxB_#^*b~`Mrq{R)Rf`84cz?;X}>uR}?a+`8`QKtSPkxE|U9} zmRaPJ)P^kY$$b}UJ?65%X^Rj?+_~8#M>dK6KZBOwZRVW!6?aI#TXl!Toym&3J>m+X z$t=Md5m355*j?#tZj#`KX7u;gFzeUA^O}|P$ zyR^(EpZ$J?Mb*a zo0JqOkC*m6QWEcmkkg>&5Nojn+5k{$xyd!=f|>H!F=Z#H_xJxNyqji?J|yT#HLgQV zuD_v3&gDduNlJOQN^KvNxjQ$!xl~=;ZTZK+vq9IPVA|c{YiS+|t7@d*fNg4ubW!zQ z->|@3)6_zflp@!gPBrsWg08`Yp4qX)ZRcLG@uZV6RRB@36c#6)%8-Rb{4f?3*pD04=Be<`9zXF%qT;qNh5(p+*yoVUyfD?|F*ya zd`t&p!qa&Ck4x#}YE(EhPE@kFvW;e_b5o|uK_0&fD>9vtAdSe?jH?9OUb-D$ZEqQ3`q z9Lz5&M$<25;{%KfNYwui1rRyfDZFV1=#v#}irl+M`Zr<_*kP&$&ia923q=1f@J-=h zJ!uXO&R?*1krV+9`nZImqoCiU&L5=~tjcOZYPtJL$FMvGO4dwml!mMGSIzScB|3{t zfr7PDTYVHUfkpK1^(Ct%s|ro1aTAcbzsHvzt$LJ=tLlM$dL@2*CxM!kuKyk=Zn11{ zM;PlOV?{ew8i!h5tiGeVoeR9E=|w@RPvOvZNIr~x%Zvi>tjMS&=fJ4bY?)4w~FYk^Hmb(q{jSi=$ z+0~8WhzQ$83Ola!4rzaXp?OEAcgV9Jd&SOXudVYvuZ@ccXYfu8$O9I&wW{xDNJf18 z0f>vhQ&+$`5Xr223lEE#{!)!UamWx8y_%S>*?~Wk@n?^|(DR@CNFi9tAN?gK+f1e; zv&8~Gb0Yo{5)w@GkN#MCcv{W;AHd9}&9K}&3O98aborrza5=f;3B`+KQr|3v&gE{}HqOukk9hjM64Y?sBrax`DpsA!nNeoTaFmn0j*C`X;|LV zj)N$1XKobsapv7(Iil@F0ObiJks>U>YbU&B%e#^4IX{H`^8`^JD2Pn2N4Qw~V;-X< zA|IbIAXX&<1F9%z<=s|f*nQ5@MOc=ehh@Qqu}nQ53(5xt7AQagIcfMSN*0g?+?ohb zyv{Dr67WXF7SSF9g&3{w4V0Jy^UV#%Z8`P!gWFfbH>=h19*7%3@0Rxh_R5BzS89o+ zNz|N^^cx{M^tpp7M$TS)V_?1orG#iDR{Or(2BZ(L%Zc>~+LPzNB`tto@^tLNOGHo5 z9>p`RJ)$8)8l+=jkd#xeU5Rp&&#sY%!S7B}!$&Cp^=A8rmfiY$^4X2jaPWzly~Lf= zfCczBVhrI+uR2?ePoJ~uY$ZLRV*2rvG7#O;&_T7xYCn@JYpIl303${E4MBn|{)LzpZt(AalQPB z**B4Xvh~Txh)M3J^6eL;tDy<#ms8$iUc#B8 z2Z&gE1BD(#MvV?f%Y=tE20wT2X69J*FzR6#WZ9smp4oW<7I9}KPayO{FQnOFwB6hz zqC6MMxVSS%?tfUid{7G+Bs$eDtsni3-2Wg~bw~q##Ho*GF_Hpzz8&No3KV3<&x zmWAddr7+`#c8cOPL)_TZd6~JrrTcU06(|Gs;?7Obr)?zII&Jo_T9{_(WddxDIdD6P zPdi2(9L2AJ0-(iQP^!(Li;!1n8_DQC(dY#I5*G1xQ(z94lEBm!xR?Za3lsLDKMyF- zMwj4G)nAJ^Xm|ZVdOEB6sXe0I^>4vb%0kp1;RSLeDo?*Ed%=%S&^uK1lSm>|GChHc zHD#b;P57G``dc87`^$Y}<^IjSE9L$Q-(^+(m4xRaxqp*ysN7%Xb5!+L!AJBzgWvOt zC(0dC*EyIpVUTpRA4Iir43~Q!^1&vEY(-@^6|L^d>GAhSmymvB@O5|SEr?q1HQ_Dd zYL2jNw9ua7wY68kz3#P~Snsu+_!XW9AvVrN#YFn~n31TR(rf{Gl8eJYA8MG!Y+Oxp zecyCyR^sD_kVv3%UOFi-{v&wU;(q|ZH~VGYDJeEvN(%Ij6kAGiN{S%RhmazqBvUjF zY=HAf_)SW(*^-hH6KzShq{OIiLIUbL%9j43eqVW-1^Q=lVje0PPJnxEq#z`~T>|$M z-1p%&z#WEr3GO_`Ti#Q5>&ZFwtaGwp+NHAb=anbT;$tvS33w?T!M+X}UqjHf{2A}y zRy#eYkAu2Dm-;ySL2=8kc~}b`+BW`90}kprF?MtMFk}@)Kh;5Wnfm6zJ?ewxx0<&k zn*D(K3kCHqBr)H_MM~MN>;p0dF{!=@s2@`}9A;P0Pa1HU9P`l`s7!|L0Z~SXEJq;9 zh#b;ez*MbNr6N{u&kXVB8{9?&cpnE|h>f~aE zsTd){bNfi>gK+XqRxV=*^_wV2?z>yMiseNPPxYn9;cH1VnJx`g-&J>qws6ryBqbLF zhF7;qK|UGxBr@Syp!O-&%(qAr&H4C`ui>GOC5m#x(#3ap)rFb10V8=>jQ*?-%V~23 zhR?KoRuHhm^wkD+$*ht%Nz*)T3obF)530ANS@z|= zjS;mwY}wb)YpbyZ++p*<%HxrmB9l($HPxG$+gSQ%{+I*|^$^`8G>_X5+ujOm5>T|1 z!rEb=fJ}9T&8>vv4zt{B!H^H~_Xv!Vn8$=I;vpKmED+jnfo9=?I|BDVaL3?Iz-e$F z!+i?(1za!OmkUiNOmL$iPFf*O!q7lQLh~37lj$W3&Ch3hhwwqqsHm<*Ce4y2VSS$Z zUXu{X%epJQ;jFDDU7eSnWn`}@&nz@S$jkLs^z|hawkyiq*x6dNtQF>Ym+7VP$z%EP<)RUH+OBabHBCLgGrZTS%B z7xT0%RZa9F_u0h9X&`~I;k?m;@Zn{Guolms!o3CeKHM3&Ecma2djSrWf$Yx7z9Dir zfkcW8riL~>fwg9I-?<0Hr|adTCT%wGqM>+A>L@aI2)S?b0AwV$(SW%k3X{9fm@Hmw zi^6FMJn*6mg=s*@ky{yZ%stYqmmIbr!2z}pbpXCsV{sfjPH&m^h z^3`-%EKJ7Tb2qc$^QVNy9E(Jtq{5Dco|1H!Ylm{K?m*=+ zxUFt-^jO78(XYVI-y>F+QW(z&j8LqUx}z%l8ie(@x-+B^Cz4PPv2;NNCK)CyvO#-fpSfz++iZE-Y~IGSM%$J5V4 z<1o;iht@IxtyTBMv6ucMI^I1J@1zfZ^z!+(5YV-&b6TjQjbCsYscaJOmha_rF2L>xs%#Qk*T4RHIP0nnT5k*C`i{}43)40ga^-8cSyaTrylL+)%g?a3kSH!(9${72G(uiExwP zZh*TPZaQ2(9K=*7#8fB5R42q#C&W}I#1tlrO`Q-^TnuHRo!k5D{Thw=&NP$0AYqoB z@{E4469f5&%wP@Z1=W<35tkvKa(l%(rV~8vplSyGPNkB~9Z<5@eM`xb^g7dgfs&nP z!hnQImI+BJ*s}N>i2QA0ygk}x10SMnnLKFhGU_g;ruPh&`4_)jh%9%ZOx*Wn<^*cIsPb zTBW;JWNz39Ie-w5XO!aq=i2B0zZwQtmNz92Wa&TEFobQXLdT8Xl#aPx zd&lkGWG)uQ8j|q;wwJGIFNU%3a>$17u*vXJ+@JK-Cc{HsK?rM|5wy+j?cvK&5FTI9RwH0XJYt9#o&ewf{WvGGJM^M zQTk5eEuN1!J}1MsKL*zrg&P8kUBzX-T=`_O??(CL#lA^ZCrLv2##Nm>Is(tj^=z#4 zISO0#NqcFUd@|D~$|tjZDOD$b2~`DCuR}>0=^bW_7$0DWyX3xMhA_I5rzAJ_$S19( z!{n0>`%F;=`o-VnuPwq<>A8*2E;He)%1;U{EKk=}qBu6ca z<^-z+#vb-(G8Ik|g!cgOR<Vuq*_Gen)3A?m~oQRll+ zEn~v@8rJ`nD;JV0XO1v+d6f9LALScR@+UH-`5ru2>7z~vRx9ku=6LbbEcokGv~UgA z3W67I8s3NDIT`K%B6qjzc&(1Q!-7V>lMYAq*T`Ow5WwOpQYrIJkhgA_kEjhcIw((ICViXu(odBqkS5 zlUz7Wa^Z9(@&~za+K>y^S2Z)aaGK=8X_5=4NiLi=sp)**dI^1Z80%ml+}5)9G!BaHa>#N&@Jq{V!AVY!GW6l9C!&KyxE2d6<1h4Ddx z&gj6Rm+)#KWNkC-03pK;KuZEJQjfU9LC?|Rpu0Wj`GA&|j5$I!ZY*4-A=f8BM8kg! zIQ4>D}~z#_kFm{aF4-}$QcSVtpqde=BSxAn`oE&dJW!AjS?3&i0Czl_<|8}X^e=W zQNS~xny4kJDHlXFVdPYwMCIXBAH^FB2pie{#K?B9k?k)onC)N35d0#F;A4ZyG02Ky`m0e`-?PhhN7OIuhEixM6Z?RosVqT)QA)c7bRs+?h?uG^5{bE)_ZfiN#aAh=`vA0XmWCDL%b-kE{ z<#RR@7R}behBH}p)vBHsavL{Jq`=y&mIbP(7Bk2%EC?YM40RNY1(mei@`bF!in~@v zaxZ{m`Z%J_?NE!HYW`%rSX$-AXVm=6+|~^|T}Gyzk+~gd-4AthncTlf8ilMfJDVJK zNw7{Rp6wCWR_(|75Avdl9>#G+KW9Pyjc(D|6D=P_ua5tM~ z&}S1)giBl1qE+g=QCLZEpmZ!?;U91Y^4CmlrIoutk7bc)vRm;UC|--<`_x9Xq$mR* zt{IxStLB;9TlGnx80i!L$sP#4Zzc0<)$w}df)A{HSS-DjEt>UDCf<3r^5v3QV0=yw z8b+RPl;t(S%kETNH|R6^>zSUz1bN333r*?jBOGup(VWQ$=G4V+A=`vbQQu%;A6o*Tq`Y+bY&gv4)d- zaA1qdn?s0R%)&Mfn`tDIOxlg`qY7P%wr}774+xj{>89Rx*R=uC0H<})=>y5uk~fH z;N>6J*bC0*m*JCZ=!7#z`<(&LVC6-bwzlt&cMt`unXM=CncvoSYlQDk03~? z^Wj$w(l1fiqXgIERjj@g12)xFO%nQE5LVS+59-8P3>LtC675l+neaK&lz~tQQ}tWr z4#Q5%tgrUZzzl7Sux+TYV?4~LJUXeeCU?N@xAm)bzYendeTuZm?)O>L?zffO z{koXlZ|gw2-=}2vBVrSHBORmqSxMDV@t})B$7WXj^r7$oH+4J{P#Z=6yLM_8v5p7( zw%`%#d`4kat@eBP$o*Kg?|`x%hn?!XjOD^;ELdeuVv#i#(NFvFj0V$$F*j8W+G#+w zZWQQXvfrlo9rPY+aZ|C!&y~?EP%F}g7a&!XArHp%iL|BDHRS|2*hP+J~6;<8g!5Jf6nt z3{IBnsIwuu$~a(YSrDuvO)WP4!l_fOK?i^oe;P}cWy(?KB(I>8yjTEuTe}sMs&(Y& zZ!4RV(-ZU)I>qmV@}<@>E(Zxo(2=49)5z0Lzpz>`5Sw#$guO(Vx7?pm_Mtui4U2I; z8it$2noW2Jrl&2#$x(20gy@4PUFC^qwlS(1?enDM%4ZLP$lX|+!+cN{Qc~r!@58S` zWd#jYFpu&=(undx3*9@Oz&5$(;SOMydH^v!|^3qW6@$w_F-%`-4N2-;V{fBh|j@ETkS{2qe)0B{-jJ_CMkRXk6sj#p_s zO^qlLTnJjUooI{ka$==YM^pw2^Nb43i@J^%waI2azo0+VN`WITH{#e>O^IV0Q1Gl0 z%?_A)S_$9aqW?g<;_GM%YzI&NX|mpj?(i*S83_Mr%4&d8Wu^EQ)x?0w#@bNO{~216 z%CZWnU3u(`E%>R?wxa&QLi0aO`Q_hAxw;RM3M~dLoPNKNpOuUjoAx#)1NpnTGT06B zOqD?^Vq^UQba1iyHwbTL3JKL}-qke;rd^d6p<*(-1lb~Jy+#0T3*1w1KZ5%y+|S{D z1@{~rOrIxU`aA*C=ZT$gFnylb8x39%uf@OQp8*ocIBXE{b(pjlsJoBJSgPX9egWi01Vnzf z(C5I=!snDvI(=#SNcmL?!UA;uV$ze0mq3sLcqd@9p)(;wB>i7eJ=L@(Js-&oC^SaZ zE;=IO8~9U!0{tp~s>t`-SeqIvq=Bpz$@kl$M#fwyRr>&je{F$YOF&;K(CmLE>OB{X zdhb6IHFDjBQe`s(-g zl2)R zY!{$=V2u>EEf#h-yu)@(g7dv_lbAd^F?qgy~FsRX4VA+!!;LT&#v+RRAsneiH=8Jp#%r(!r;k*V6Ynx zC?TP)-K1D`5u<|iOPh?=PZ`LUGaq834L5hHEOssoB`;erytH!3TLYbl#9N?_p<(Ye zPy)FhCB$1?%~0-V^yfGmixlxZL*vJnp!MJ=79K4BmMKwC1~7Qk?X(tNacz%}255MW zMcRh$10%W1_dfuZ`%{&=3=l(`g;KE7+U=;Cw~%%MsIKi$ll=t=c#RD=CW?M`1`hNj z-O7-2!wxMZ%#G_+F5gG`gm~I)oAmJbV25p21_o>=VQQ9+J@+)6V%wrqdVqI}u|<`$2{I($M<87`#)OLTT@f#t;DyVEAG9ON({*!sh|;nKF5K z41rCWI|xD200eBsAV&ZgK2GHbErStSv{n>5&w*9)3_@rbfRL>n9E{MQ&~jb^*1-u_ z_0mB|u_q#yO}2z^Fw$WLl~JTdB3LjpC>IHX6G?zd&8k$ih^VSb%MI3|D&2Jf)jtO( znJBF2RA%q6L8M#;R{(ccR5Z+WXQ(EswqclzIX;YLuToh}kbBRPEr?1S^;^(~sD4&~ zP|lA)=i}hHpV3h`7*P|5_HqnO?q_0kF+mxqQhoO5D>WOJqiQZ|Hu1rXAv9?Qi9=TP zl31=7Nuz18dK39GVzALx+(HXh<9z}LNr9j8>QSo1tVSwzAK+d43$Uoc5ME)bO;i1} z56>XJQT)O0;-Q~zOjn!cs&xdA+xW0ueU&0SEEq6&}oZgXOsUqef0&;RQ{Wj6&Og}{~-PN zKuwTBnwb|eAZWGZ&4(I)#5d<~1rFSyicYxzLUGG>yu_<`Y!rfX`Yx>P^XRniN`03X zKt)4e5+pTQ=>;sjQ=6`;V7oHr$}N?7mKL0MBW$}|c=l;%7Qcb}9NI$)G>7qU3*j2Q z!#X>>DO`)V)lFDb$KS|IX*r+-525t1HU0ZB!UmG1`YCuorP7Pl1Fx{^(bRT4UYY#$ zs3`SG4PlGz>4aECxtdL&SjC-=N$RKS0o03^OsE+>fNe@@=trfxfnZtDQvZ#4y)k@V zZ^D3iJql(vaZG=u!H$g+txlqVct3ptuZYIy%My_#ErS)xplJic`0r{}T>I6!N01^7 zG+rP+Fv~Vfb17uf6RV#lKUOSFsB-+pvZeq#+Xk4-O=Rh-v8&ANfun(LsgK+eqJ$cW3B{{1wxMm~q7HU~NO#R)e+kG>r()td`1S zk(xrYHixu!X4zMnDHDRo`pRm|b$k!imrwKE5^EG!3|5QzIJ#%pfN|ET)ftA>K1LI$ z(T-h9soYDv!N^&eh%Z-05nFi>LbsL|TJ%SBL{t<;SF;NdurZewH#EE25ig>TGEU}+ zeq-?|j`YG8wHD-xO-Ry&YBCkn!;~T&(ShA&t`^00NcHSjJgx9jUG0=fHp>Rc48>DV zYTYTa2`@)N;FaRuK^-=?B4LJ%)MfZ%U1B+^?~BT z`Ej*;GYhsFHz3Mts0g)~X0MeSE!?__WKdx8?!+b&w!+mm<(Z&j)i%vECnBUNKM^Ve zJd?PmEwS1466K4@RS993e9UB4Jg3}X&OKPV1g!xx=7pKmDvC1$`Tf|;OfyIkdxPR{ zB_WCcS8bkJn3mO`){zfR0UApda271rTTn&R1(`K7`{5a2o>og{gn6MwP=;`h)My{# z)N;l0GR!7MGdjlS1Pt44Yr@_Zn>TsKWQdEEUgxuqcvGKqcvGLhIy$*pMDvz%Uk3Uh z@Du0)rU|2cj{X*(2$u#ol8XM6KC;<$Dizt*op_;5tU4y^PF=$oK@*`%K}SL4s(N@# zuf&g36fD8~(0*i2PmBcVsj^?9HxA}&#|Ae)g=TemRR&%h43?pIV{NPI0MI%0tHqrg zSl$`ImsMa-VQ3zNJ^1h5V?Ur4-AVgiT2)qaP`CZ8jl0^>zXlaxP(8aaXN)6UFsBCH z1sn>6*gUsy-FcNtU(6;rh|esoi^brJ)Wy0^L0uvqsjU71@y(Z#dm~DaUU{&xt%ZOvRmpN# z{Wi)5+lx$|F5cAUVu??_lp1h#SudxF&pIkyPkW&>B;f9G<~|C6*?#5@1EdG9DV|2LATBlAUqmDtPLn8ON_7DqZa)`z--a zJM9|9c49gr*`rBC#W4~vM``&G1PsioSUUt_=&RY)&e*8bjJmrT zD_5d*?0b+GQ5mrY@`Ayz!N$)Z7G8!}xD@W^-c+tZEQDNG3sDk{zE1RS=N!aJ51hnQ zt370A^#kG_%adXi2rW( z(a|v`21pqqDO-r0>MBL7_NN#TNnCC!#{x6-XyOy=m^Xw>St2MZ+zg?}dqEcL|AH8X zTvptL!{#9Ni|;^r^9`_&KcD|O67eEotYfLoiydc1Z4n$sPgdJx`kCh72`hd^r>mB6 zvK9svSFN@M=m#PuT@ScIKaC+q*VbU=q7*rzra*mN4IPOC1T2YidhruCjHNR;jL`7N zYE|l9BKDvo4ibbKWS_2DwjCTv1z0#05Ty#qsk!u z&i#@Se39_DUiwLK5y_UHgg`UarwCH=bTsmchcD61B-?Gf*eb1|(3n_^+y>0r(!ezh z;M$6-ffz@Fupm>4b|XvZ8MGv<&}jA7m!mYWu%Wft|0YsHAaovjqqg5729pRJop52M z5_|#PUgRV$TA=$<2hCQL)lsmT=gjIQUhH5f9HGQt!_$+Yp!H^`$<)~#x(XPnE8@$% zoR&V7L0cLXKSO~4AkBBG#glQS6JA-ua{V(|e}xiIn3>y9s$gLzOE0%^!#pg;YYW(D z%i1xUeIFuN4uI#-Cu&ln-YNUkcg++80ZIXdm=AHt`I%9 zzn&1bE7$f?cHHg$y_=!w7@`ZkTJ4W$bm*~>Xn1x#w1&66&gbs;rakv*R5aWPsrev} zxe7&z5y6?Y?KDs5-_AHhKCFD(zqWYaV#RC9>Qd_{PVQ&Mq&zF$UuJ>;9Pq->nM~Tx zSb4Ppyy zGWaV7%i$a4uUP#u)tue@JF78IeJ6`fFDvAymzA3B7>7Pd5!f%f06KdRhE7%huTn@B zAn2>fQd*$4FfBr51El#T_K6-d6Qd;yL|_Zo!IDh_&*D!mCSgxLqz_{wljqM=9PL_`+QB$TUlJR0qczd!^(CC6&u zh8mmpJgc&_C~}#~l2d}!2uB4eLKmQNI{oAoTJ{EsUNX25{z_AVo~^PF5QFxQvo!b@ zojhSbXsTm)*e`esS|0NKI;N3U3zTk*(5l`lR0Q8e@yu2A{Qy2V-xi{euB5~EaB`qbUIC@%}o~U zJY^xgYp)}qc<;{A;7L%)&o%M)Kn$#icImK$`pvvVn@p0*dT@w-loa)mO~Mw{6QXmM zZ>H{@hKl-ioZ-~}ZKyHp8R*bhUr(nRh}C~*@($xw=re+LQwDM#9Ys|Ck-}U%c)eIG z-K@HIASO0m;+Pzmd3P`+LGBfC1p^>yaZo+?O+ggWI0Z|i$+bg=6d_pDwQ;2O6B5h^ z6iBy3p^cMr0L%5?tBjPmZNCgFIapeBQWxS=!nVEeS-mdk0Q* zkQ@FX_f8cbmrySP%1eteX3h-ic%%u#g<--_!UHuMN23oBpv2RkL$Kp0BpT!5&n6@Z zSj)jburY-WGD=^97;p)2efJ2$X}ET{BX9@ccEjz0`z_qB;C>8O3s(iV5$=0%_riJL z3gKqJAsbD?cN&Z8l%a$b_7^8U^*EN}^8OU`QLm^3ec(pU-e&)LJf{%VFls6OHTY8M zR?)A!maIbqmTi*;F&FF7hnl66lr08KZR!z#8#6g*LsALi!FqsIvha^0h@N|FOz@4P zbB}?7KnMj<1Ct?saXdGejM*1jdN?1i+PqPqE;=(fj&3u62%1JA*C7PQgwi3xLF+~} zjakOkAkl+UbNp+minA{WWXfj|td@9ia~4D`%_+>K$c~LzG58EnPAA*Cw2_m7exK{o zxs+JrrNHKKG|yaw7*to){0wwQW11{KEf8NTvT~hht~I6*sR9NH#~9$PFpFAW`3Y2r ztu+2+Yq3TD$G~H(QG8mn1gZxItb5T+D5FH+>SS#y*eN_-LOp|EWpEZ+F*si2py-~)&Vp&0SqhwKa~nu zB3SVh!$gel1+g)=WgCT~^%m$E@j{qssw0NaR#UCu7N$~a@5bjZ*+-XHyAG+xi*Xgc zv^@~9u~MEP`Zwd7DiWU|M7^pg7pqM`#w0cNh3*rXj6QOoAbh$?5S}T;9KbUEr1w|W zVx#A3L3nq7-)|q};n63-(fdE+8c>o53bbir^Dw#N8^#7n+|<@eVmLW}*4SOK|() z`mi$eBCHI(4J$+M$2+!~bvy?5H;9oVaQ_2$4DJM+2KO=Cr*L1u^}>CLEovsX1h{0l zRJi}eSsmP#vOGXX*IzDH-$gXX)?|X+bK%icV0paRPokJQh-UvRlE3(i8@7w3%Xu9l zG*?S$&1_Q%!O%23;w$>whx8&#Hn^bF(;Qvf;# z;{AZm!FL6VnQdYq5kJLaL{7js0`Ivk6>kjw-aJFCBXk@ol@-ozIY#CQ7~Oe>*e~fI z^Q{4vcZ|~t68Z})+KN=Rvd6f@i*MXA%7_RVA zrn349jUS6{Pza1!zrcS`#iIXha1!G}MiJ(XfQv*8PeJulO~Lj*iARFg zk8ez4q9$fT<7O3#g94w!NjDV@D4z+m$%XNjvrT0z5O=1TEqm#rBf6(UVf8)YXIt8; zqdQzzQ93*|gNBweHCiR4lxAMfp)XL&=4ijdS#31SEagD%OOz(APFxiNC)6PEG&XsH zo_aWts9d~I*0mED(LR781CmCvYf|1}^Qwl`e~RIoD;?@vlx)Z$-<~eDLIrmJfQyNkf_}KgNY7P))T@u%84m9*M=!T$B*j zMHQJUPhRdDU3qd8&UTmpm`7tUZ0*r#p4Rsn1&&DGt;{!xVxO;@Iz@jW@=iohg@JSu zv~t?Was-SvMC9MJPs%L3+hrLR@BryKktBTX2~b z8UTlgiLvZ54Dk%{cJpTJBQ?YuDS1Qy$zJUo`ay6TQDdqhgdSgIbxXsQ{-{7T~nX-7u&?!PT}R{y>&b$Cxup#4T)T7$4By!ncMi!9~a- z?=!|x`m{}7kFQ3XX3)*TW)a;{WYchjKJ_xVL4q>HdlJUysK{rEcCH7JaNb45wUPLEBCMITDUzoXs(PJBv5Yfx5{3PSX<81oj>tueeZCtC9HAMZAEhoA&a?3X8U2%o!0N+NLCuDOv%qZ=)0)L z^@h#Z1d>IR{~3COei3vBq(_xkhZLc-=`Tt}`Hh4CIVv&)eO9aZy9L?BT(;Bfs3GO^ zvn`FW`3S6jA|`x8Zy`RBK&dc>(Y_U#_+v0`8fb|1O^ekaee(?Fw)k#P>sUA}am-(G zP{)Fnug;!=?j;Y$=(o@w7Ie+|lu5e$g=UkP_(THpvP}%3(S?yEINF7^R{T5FlUG@< zRX8P|Q-jc*7x=ISgtx>$U4CEmprutYajh((t-X z%}eW`?w&U~^;Obrat{n@78J}YcwdGw#$*-xzoKfwD8)a8B}1}AnK=rpkG`oxer`K; z$V^iKpIKBTe^j)K5`$z!iE4P-2ShY6f2_jzM*&nsdLd`s0JeU$d%_AoRz{5az^&8- zpq~)7Y!ky~6fV`L3A{7TZLD~X)vwt1=F5$m%Sx9HgD=M6kj&i6bD`(*4Aa2`WPn}3 znQV05&_G`OMKr_wN*7c)rdOLlrnlL)H>>=a3})xQt;+=llQ|!Sd>WWrC2i9x5uhiE279&W%RE)nvrUuprPc?@B#2zen zL|v%g1~9Tu#I(!JOsjx6VJ)ICjTY1~lt>H}^Q$L2JWOy{LSnNaF1LeF-v+jn@OPOXFp%WSB(VPlSGqmrc9e+;$ z-U{4_R1H(219ChKW?=>yGQB`qF+{~!D$CzP$7!-WNM*%QmZoLV)FRe=5bNq#GIP_i z*g@DOm?*{#l#2VAsBLEr)0hrXRnqRodrn)>e=jIg>K3tI_U>PZckTB`4ow49j_lCA z58##$x2#R{T_J0ueOa<*_pQdIvAzv@nXIk#O_#MqUxAGKWasJM3;G#0hDTqg))Brc zq-LXjg;wxmnhPd%7B1UN`g{%|r<{0dzgt9 z2cx{fwF4h$r1MdrHt&JVr1-8~IE_rfDn-)yj@XzkYnV{<8*#=2PV$F#OFlYIIfXtx zh0-pX!qj`%m>q%qDWpJJ`S1X&q0)LTY|2aurhIL(6fW*H#7`c#7MllCy9#bC>CO1q7GEjaGOZOz}3=Z zDPutoLp3B4zh8lcfR4!ATVsTX{@;QQV~GDN%Ja5t6e*1oC*T=jzqA#Cd{saFVhYn3 z@S?$)f-Hdja!Fb$?SrT-u~hY`l+g?|NQmYcgT))+rxk!?lm&(Blhis2#}t(T0qZBO zO{Pq-fI^8c_aeq9LE=-a9!5tH=+*`8G!zh~H~8E%Tkd&@O{(L3ITiEjgJ;zD5GXEL zaleG~#|lg~h|DHju7K%Onq7#0Y5z`uD0|n@=|rno{TNGxt;l9)YZ%f1g}$jw!YT{7 zuV0#=GAe0R6m$im+I6Ve^$aWS=$RhPt`-DD^s7`>@-P8i3T+TRu-^{lu~g5Sc1($r zXEaExHBJS_C$ z@+dC=Kwda`Lk?fc4=WM<6TvQOXW!4HPC6=h1`M#c7C)51Wjx z&_#*=7qCz+i5lX0bjS{#zrhBz=`pWs;6;pw$%DkH!mNwhO+-B_+bhM|kKm8ZaZUfD za4li*kv9A=8r(SW@;Yo;Sj*O^kTPLR>Cx+eDLwkc@U&dyY6&|t=bfXm%LW|DGqJ!E za&K1DaD#JvQFWNYuFRap#C3)e%mm|A_6x12n$6+)$&aRWjF_#o+lBmAHqT5n;TRlr z0z3*%_TmUw6d00rYvmO9E}f+(Vz!-~OyI=ECRau}? zT!CMtUpoh}+3rE`BD#T)fY}B@^lUGS;7Wi+Vyh|%B`pg~qEz`Y2uPK&+e!=c&?V)e ztDxOU&3SpOQZw2{mtDcZuc#P_^8;x94`*?tu>%AOaWn&8pvDnyHcmgdxSX!rHKt4H z;2K=p+W(nE=jK?|13gDTnN~p!l)`+M&<>Ij7uZ3fufifxwy`9>eMDavf5!?=wz-6_ z`po60;FRU)m+~f$F(TV_QuA~|CTc*0eMBp7)vi2&bU z<5lc3FmrT`J?JMaI4lH=#55OeamndHzX0`zyaLI{m9b-hr<>bV)(#oKG9dS*`cl#U z7`<}upj}{wfGaU%I+tJ^#a!H}r_5&*-Agtx8Jl z$h%R-^~Qe~c-kGET_v&mjl1Zu*04%zM9NR$UQrb{9J6Eaa6;W1;0~mz6UW~%?_Eeo zfy{Pg$n}YIJe~U#Q)w%3NiDW3u6^wHG#QS`@tY~9(WF~RN)lQQT4VA=yfZb zUB@9fW@liTb`y?00* z#t5K1r*Kjq#RUdDz zpt~zbw^E!7UH*GiuX>sZ=~fqaDI;+TWIeUB*;CL9^D9)}G*qN7QM*uJ>=G_0ulv~+ zjux;)UydC&==8AzgEn=b9b@p)ivAoL7fP|!m;**_!3uc z+4qtJ&`W?khn)!aMkaj^mBZ&CyJypT!W)=x1luMkINdOsacwW+VMO4~W4WH4r=s?? zV?YGO82g3WX{(N_3;9QnR3=uF9hq;&!Lfd)vUan=kKP{%3mvUlL(KW6ngX-hm~|M| zgb%31%@`D5!^x5_7!iRB@^mAA~ve;hIXM=($b1O@I`w$iifrfKXSOjH)47v-Vn2z9!b;v zcu3Q5LgwDUObZU^B3o309L^}Wt1W}Ob9)o;KNY&0A(y@f#E&DcexDqE7?<{iH{rmI za2YUG5yp$6w9s$|?H4KNcjH3Ru!n9I^U}>?_eg2{9`aNv!9O_@8+hvVDLV3ni;u7k zldcdN$qos<^1QlB7ZkEqE><6g0Ay7D8(nn?0m_(%3)R3T+^AUzQgD|hm^T9bJZCAV zZw=WC*rjLdr4*n`T~Cll=mynCD{<|ynO&(u$Hh`c{*D&>3!V`==yo!^&!Y(!^S;L= z4_&tlk-aZO##py`t^egY6OiMp|3hnQqwYhX@JSmQAi`H zkS-ZeNM2LmHhy`ZeH7$@%uGc)3et8l5}eQ>p2 zhf8tl(_KK4h{`?@ZV%oEI`Sts(2w3Nh98B2YZaIHvN6Rkhj5=Ed;~dU^_Anxw+Y9} z)cfU7QYoJO@F`_i9sh=4zI<417N2gEkDEfHP|V7#Oe-Wm3#W0bzXzR=FVm_oRS}Zg z<-3dS-SyGMp=p`WPT1YND+o&5`LIdP1ykmj0Cqirxd(&Y0x&E#c-Um@L>m$XW=Jy5 ztFZ%G(NicOwdpS7{yla(98{PE=vEix?4{AGK=%#uV|lGz(4VXJkmBzjmC3K}!o^+2 zjil(V`kaT;I>+NV1y2v2%kZqka|@m?;JFjeRy;q% zGaNlxtLFS#k;1Ydn2-gi6VM4#t8gmr6VS<9?Y%f2(6t{b@_6#A=!fP>cLyCptF%s% z!(*jkC^~dKw_Xps$9S>YiB@=q9e5Evmzp+@0p~dQW}r{S(kh3%52K26tX`s>0Xemi z2`D%1v=s&X_p0OIsHv)tep&mOLSao5_SdRoIKPetW|%{+80ou3)=Z_DRT_rbg73;I z%#=9=-xc~)ddm}hR~tT8>SK4oqAlnXcVQk#(68oSV|Jy`v`{+9q2aqgI&KRGDJ;1= zkQ}MD$;}1J(G&%J8bls_pn_vQC8upVEiqL}mTw-(^w8#lRRo3w9Hf!1sVP{CS>b|J z1YJ|G2FqpZmHD%jg1L}j^-9S!rDTdyFabhiem4D#4f^MvhM*}(3)ZohlFVR`z07wu z7fhy=m|&SwkPaKPFB_HrGKV3`hr!u|*=IQr630o z*jB3Z7p_!pcdTrl1C;p10xbNdj};J-jgU)Lss$5PDsx7`_cB3vgCTa=a$ETb3j$NQ zBLi8VgHBeRKLz=nKaE&DQVBA(q#5i`JSOIHv>R0)GE*bc$EE}W^}WGV-%_&<#APQln& z0(<8i8@LAcg1t65tkCwqb&nPXzkfy{4MkX1U2?klYlS5T)3E8!>>Ins18Q z9L@V7Tq;9jI0sY(S17a^T!Mx{Gn-)mLMI5L%Fwu)o#fs#$L5qCR_8;sP~jAPPKvTG zQNG>gq(NU7>;bq?nSw^bf=j0~xVvB+xOOF;D`5!`P$ScNT%Y5NL9~}NwFHNYq?vPD zeF-b&+Z`Ae-|leg7sv2VfE||budKS=Az&Ky6mZ>4H24yGT&FX96M^?s6fc&}oQ4@2 zcrS|MWl<{yLY${I8B23-42bwhIHsm zyc2x%oz&7N;eH55{!hXEyYc=so^^1P_I9{DIO?J*@ualz0R8dz?Z!K??I>IZC2IT; zJbjX1G;SWgqwnQ~}efekI)e%`LSk8@AmmNhcu9V`VGA+%ktkEGwyv}>Q?ZW#k8lQ}kQx@g^Fg|%|b9d>FxIXfao8y*yx|RAv<#mO| zaZaN=%`HyHC!~fwso_9s7|N+Va;K!G4VOh>3Knrua;Xz;raTvADGSY__zgEJUC7wX zw0bEM9?wM~Vkq;eNf9K=BZlZqWMR3fN*WA)MJ~COFDj{HNmh3eh@EO7 z^h}=d{dFyE%DMB-@IvNNl*|BH!iT@osmfG|@cL&wHdUJNOqB7QmvhNwmY2uemH^od zwo$G`>ht&+ue4m`5;-L=Tv$rOwb9FRp=>F2i4i6ZqzG)&sg)%_h8YqrEFbM}ZNbO` zZH_cId8v#BCd$Buh;-S_z`ez>$uf+}au}x(4zg2A%#=7ZB~s?;F|3(YsVF#tQAj`u zV=C(uaCauzRH)Rw!DlcglbI=wVT21Z?)L^i6XDn-$nc>ora=7LqI(zIVGbq|F(YTK zES!I^1sLE{wZLSl)U$HVGLZt`6#lw6kQhow?RRiLV6oAOq5+WaSz)Ri*wCd=+HyD` zfexX0d4!q*m}0~RJk?Cu!lFrhz=HcbKKtKZTYl!a3FB0@n-X^RP{i2Z@7+ zv#mx=jOzC_DpN_>@z5a`Tlg^G#&U$sB?HVb9_$P$DM)DUl0ncS*4W?MXkH`sgkPSc zx++3BR<8V_#mUOb%4x48`$=x~zA2M>St3HpWpefmgT1^o$!i+EdPTlgkfHlN8 zmS9NFQ4F36k)!3chJ)%HJD;L4B9Sj~BD3fzhVWsVNC~p6Gu?xFG*oe!BlmU(2 zJiRHHiAz*qjY5l3B<;eNUv%rv9g6$fGDyr3p^sGt+CcbTWox1llxiIrS`yGG9Qc;u zbzKnIp)!?CkC#!}@d3 zT>Wae^B{CCca08OZ2I81RNGfW0gcNUAhzY~=(Mfwmcy^HXJi-5Y$_=cB^J}Rk%Gft zh(oa(7b-6uEJ(bkL;9caZ-PF=q;@>m!_H zh$fgbdF~ckzs?5W|4}n(yE-8qZBNq@1rT#2ie8ynbosWyQ{%l4fkCWOQD{k37gzDXavK zQi~h1FQXwlSzW4mlYzL`Lbg8`hitU{e0Oi1eg6=Dc)7f@_k4T27qY=l$hJ1>sk8i2(or literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/pcre_config.obj b/3rdParty/JCL/source/windows/obj/pcre/win32/pcre_config.obj new file mode 100644 index 0000000000000000000000000000000000000000..994bb0783e39d5f681ece6d8b0a1267de946b6fb GIT binary patch literal 2504 zcmb`JL1+^}6oy~2Ximz+~_ z#H|pm8op!MW?e~FOB&HN!z8YFc6JsbO0s!J;aD9!^s)Fr@4z2@feX471F3FY=7qmUle`enn8xqIKqHo}ba> z{?BN&q|?oscS8lHNp%{w%{&#UiAfT@dlkb+ zus;YNK7r2v8>RN40i!EBc*S7R8FI&83BN84K1GPTUMhqdx#cQxMJi;aa?{DUu&Dka4QMv!y z&p$9{XXecO<~P5Y`OWY5o5xvov)~#vYIeeZ-vf)v7c7}q?t5hRlKJHe*<<7lqw+>G z-`oZF&6~UM;f3=@%@@}65(J@p(c%RQCoP;;o>i2SlQnkK*j!=F1VL!}PN47lL%%{{ z&5eSfk#BSYh6r|!q<{XBQ4a`f@{#xNcQ+P{xs<$AU&=fKnd?*f6c!id&n_une1G}8 z2eT$FDqC1F+x_6Z^UCMXTd=Tv@$4Ce6S8Ld{0kN>o;^BuRPO9W56v(0FIYHx*`kLQ zEM8VIdw#jEY<7ij!J>zJ1az7XbkcVR`ryI`31W#3aq@SEIJa!^{L5T(K%7^`$ay*O ztnigzW;_9L(L?tW(CIoor+jyME-Wv9Xz}Gn6oYL31D6}9Z$a6jdoMH4xewik(Q=td zN+apAlhn6h!NU6p(aYIK%NDWWc^SC~ATIJ%5S}yjK05Wg_t6LMo$q^O$>naQxexiv z$}V%$&qX6$?%K~qf709jGLHKgMT^i*G4$Pv|w5htVwa{AIqm zzIpdz&K0`r(bG!imMwhfe%}KXLJvL4KYzj8@`dvkmoI2fMsXFsdG{|I9m^Su8e_`2 zWbXY7AEE&uq|U{JI)BL{f}K1ME?&A&=uyB?SvId??n4Wgl`VQ`q0n8ATht!aRgZdj ze%ZW=3L#w&E}d7lXu({+?><3T2N}uIt$@|jAnL5zQMlG}}?oF!q zjGCr+HsVc7!2r7$u8|H|@^&lU*A&kyZEm}?FypNBpfgEzJKvx(oi9%P`?757I3x;VWuA^=Cl^M0*+dmH{#ce+%KlAH6YRj*U^G)E34g)(MX z_bc9`inm^ISL21}WY8j=TY(Lj z86kh_AJK_~Xj0w*q_WmYHCDyDOZDuc6w=A1qP!S*xa!^J+OxEz&2v0z#UmEe3qBOuz4A~s(A8`5c>xs} zSza3*q`HxHLr#tA+2)E=q_N<(oSLXrb#EAkcWAijAlq@*{-s@r!f4uJC&;7#O;(-h zHvFPK;+84N4p8+4)%$|0W_dBy!?Q7Gzf_Z=c%M_f)opGN+UeTA;wlwkPyLBcl+NnzeK>NrME(L0XbQ&u6FPmJ{{-f_0+9j98Vwkqyt%%sVpUgF(I z&GC#iLbSn1sK@x2Y%^1(>3&X?j;dAbeg*@Bh-P$`U!ZpAi0RaJp1Qnh_}#0N@Nya* zo>%g!mC(cRD(+WQZ?ocUQawi%PcvG^-K4mW0z1XKL-AD8K+3hK-gKcVS$O%sOYNK; zp!Ii91G;x0cceZkWGk@NDDDOZrCxQ{soqVl8d3TQny1#i7EeL-ye97!13uPZbu_>f zZ$R|~Do<78t+=`zFIwDzEdQ0Nw@!5jr20XqO0gwUpCWxR&Jj`Efj0MAZ7NTe?jM6> zgf0?_NQN|shIWu()6tB9)4|&kz$cr) zCr5juO~fq%h!}MedsilgbCgz<6L*>wX2TC}?Bhk7k@;AXSb@6~oa%ys=r`qlBDifu46A zO20|vf$lt|Yrnsr8fLH2e|dFg*j#)3$=cuMW0cGE3aoEk0XXFjb;U+rN$W|~y*BSt zxjHz=pAmfe1)vc);7hBO2|q##Jx;}sfIj}j6b$uR_Zo`Ud;Od6gSAVPLfmp)YUSB# z@~!>@;!o_%g5N)chA2-VH4ch2rUYlDTBJkc93Ql~*QnoWkFlibl=Mb6Pq5;Q3}W5^ zamy_t4FlxE^pS$Bkw&LupJR{YUX!FA)7%UI63E$;yEeHvbYW1UwmHKvMNX7x@A zP5_WYMDqxK?W&-#vsTPhGDuM~~iyn@B z;+EGLq7$x961VtzTY;L?I1aew9dOXR%ZLhkIrgFEHli5S*oGRfM!vk=QlrJFWTbH* zPj1jE??B{>Od^%QE;+)3`0!s z4QOjoYV|Jvk-Af={#H6^Uv__6w%ntOAdH18(A{MG-mbfQ@Jp@)ZX3j_HtpJbF@wK7 z0<9MvUitPc`W;;Pb^-nNt$h0d`t4Eq_Hz17i`w%JNc-9p?;7>(n?FO8`1q)KXyjEt z0l2H$Ko1nZ*n!{TDZ=E*lP1zX_XMG+XnbM8xbNS5lPmwm8?GPwz3cKukIv1#_S#XS z#*EIrcGQRwIXT0J4;waeM9%PGoxi!}nyatA>Z5c&=mgg*G)3YZO|Abd1i5axjaPlx~D9Kh-(2=~E-pjy=9-Fl}W z^h5Z`MS}2K^gW^Ku+Y$dR#L+#xN&fE;40zP!o3Q&4eouo!Voehjw~PJ(+JPKA3C?rFH6!u=fXmvFy^`wiTG z!2KTXb-1l?e}a1p4nyonE!U)q3BJS;_mZ>$DgM02K&wZII&pPS?H_{Z(%RpY9-|=Cwcy^)x6y zf(+UalgxjD+)`_~7^p+jLujD9OuQcKoNkhu?zw=6vRF@QT`E&KGQP3U%KxKrtD=v*ReuEKJJQ$(hPd- z-Y!?KxI*=2NT-vQr@jGhM~WE)n(fhk?B$~wZSL)=ce@qkXSnJfO(w}_yXx64@AfAn zDvHN;D+Kbhiu?d@Rm1d@4?H?R4UrEr5aj>N64je2)!1hkYJlp=kWM8nM;WAlk<^~4 zSeVSK2MQq=qaJ-NV&GMb2o$2-0fe;|5MVR!ZI<9PuF_afi(9Uj&i=@E1hO;{lSxed zR6j)NjX9@)@b^u$y9)p~?Yc1fw38o7>qhki+ApVB+G)-ER2f5UcSl^?{q;P>zpl02 zMVPkZFhHHNQGE}E=j@dt$%>tnwg$-j=H4K61TpGX{S1uT>1tjv0QFEmBrwnkt!SO} zbHUuy5g45=uWR=uAl6r%)4*l9LXgMNP98&h{2CcJnUjLktW0wpZ#^ANH}_CSv-K<{ z_}%N`5;Twa@M}sIPWjf>8C6&>+mRG}z$ma89^% zxD2>Vxc+ciaM^G};YPsa!d(Y<1Kdq;1#lDKCd1tVR{}Q+?smA@aQDD1fO`P03~mXW z5AI>O<#4Ou0&r{K*21lWdj{?~xEE$wUOHIXg|jO$He~-9g8Vo}kYUtDP}^Wm*e}ZS z5zj_I<|)VcO99RjjT)!As)*Jc>)mPM^Q#opeu2cn)o zvMFIA0YL{Sw5!G0IWVuFca#sMtg-iUxT);XiL7B`42=sHe7(GE(#Qv54}o8I-jU z95PYYbB17mrKRQw{Ei4iwCkTG%AZgmo;}%F2LzQmWKZ@4_T=I0X(9nZ)j(rZjk728 zVQ*b92`C1OhvrB8eON)+#l8$;Nr)|kAt{j=`KD4T?u9=e;DX!u z1i9_SSq62cp|aXj2ogr#y73rU81t)FQH=M@iSe1jD#0!Wmgp&H{EG6u{4ItcMusTQ zq@a0ph;jjsVzj+QH}#mu#xOoGFhVeKocM^Q4jLV>l-3s5X=IVDR67lMnm6JrfTu+f zWW$$RJ{4w9(*BBAlnzl7O}ia=RZpi)`zocSAt44{FgNY4f4Qc;F`j#O#&JJ_w!ta% z7^oBKBpwp=)IkR&yXc|)T8vZwYS^;Hb{qKqIF&MCz z(_)t>UCn}6#Rvp5EJ5i8L=LVCsuS@$2BJ|a%gE*hV`$gM4effSl3~nz2HlaDs3MQH z4?(@ex5-O3dMdGEkm~8QwC7o-iz#h!th51C+C40zE`&Tb52jPFuPI9Cc2dZQbvjj< z{I0sCSb;jDvKO=(Me7N^tY}IbPs$QuwoQ*)^E$-Sv!yd}%V;sM2o*7`uXEtnt*@{N zQz5Xt!gPm4heo#Oa7@c*NzyUa{i8T2n3(mXA~-C}i}mBM*1%UO$l%)SIHu8p>4}|o z%2mj*hgq&Ml>>lm0dwo2alt~UfKFtGbv19d<690EfE>-iVz%gTO#2f+=+@Hd1|SYa zYP7}y>cIeIngIb90OHwTPK8aFgb|zL7?~=+joxe22L@7Jc3gcjDNEx(7+ISc2%)N% zu;EateE=##r#6EMJ*)cCH^1?LBA#P)=ZmTlIs;SE)!HM1&CeB2{W!Y27DowZXRmA7 z9ZIS?!xUCRv#7hs^qh>Pw=j96(^iupu7n6YOsHpBU+$v154PBH)1d?y5}p!fDWK`{ zv|Q48;@4CR$pOH$0)s(1#gLs1Xbf4h!($BQ9f&j$zUv4dgd>MirTUfDI&o_T=1bUM zoqy#BhbW|kN|0Zb>B$f#Pa?upMD$v~x|yMj?oY$7#g-J0HA}{@CZEdcsmkPc?Gm4% zrFN;+CO%Uw)mun5?*RdJ7b?u! zC~^queq{}-ZFn-U2~M*}r|jb6$r$5p*`d(`VF-g;0QU;q0k~su;vhko2KO_#ui$Fs zTacNN`V%}=nP5>*wn(SD__Eay3snTYg-MG3K#WwFvo9hj7qU&pDbgxPBky=H|6yU<&m*81CPV{c&*E3~K? zveAFB zgW;}+yBF@arKwCyIf;Hj)Ett42O^1@m>g)Bp40eIEXJhs-6xzj6l4QKWo?QMAm3XI zYMIojK{1t#jH1k95mU;>A}yad8{pHfp{#sKvDl_C6CyVxVnsC1ES&X+(Tba}q(~A> zYt>{E8y{y{dzxVJX}=C;VCk&WKV4nHRnJN1s-9CI=|J_Q`7#^kP^g}sGt}{*BLrME z9jTsVT*k}F)5KfKdrD_hechz9U3^`nvkp<-Lw&}W_(jRXQ4r;)S$u+04xN7&6dLat zsU{nnCSHTh<%~Mn&alaXLfx5Cj#MkicmlmWXOHVWu9QRhP6yukbx>$9-50~mVkk5- zhG8V-*O+=ZDdm5d3{>3*fo;%f4?f1kpk2XdnHaQ33_L}zSzDkLoKovte`=d&hxA~B zvyB^lO)J$vRu_?I-vkz|$qH;};8OsIH}(nmw0weVvTI#Lo4&=eFs1zrR%0%Io4yRF z7u}|ha1{O}+w`-E=WWyf#OtanVP`E(ZRk~+`qFPp9gTe;j$An_={J?7jw4@V@%bMl znqW!hYV!6Fyyx6m`wZ_ir}q%9q6PjBZMxkwa>6DthH~1_wu*) zmsr8O=+@qX#6aO+vbFnCMLHkBtrLKH>)jnTVSn@966~2eVCXbEk%_mT574!(2qv;- zX2^P?il8&@YO-d0XT#nkD(_;sYhR9n-ZsR;+pXFEyXGQMezb_UjW-aqr3as7+_fh7 z1mms|F)$ae6c ztU!6Z3t_@?*A=KU>@YDGG4;l<4PW{MeGRL{MNZJC3;&0Pw>~?gS}=E$#Syg%ropD2 zzXuaEhRhT;LA&c9Bh#zN!}9khOwe}&w|2_`pP=jXE(ANpI6}R3UTk<{>5kTrgST0D zSHc1wpT8YglRgR#D!B zmNz7dPUX5zdQlf52AAt564*;oq6#35VBy%TL~R}}2p_{W!Hvifgi<&^+|zJ>fg3nN z5FUc7l_wyxML=!15=F4gN)!v5lqeP^Q%Ir`MR0T_Dwc+nDC;>&6idmKC`!qcC~LbC z#a?qIioJ#sWo=iY*juhdv0@UHsKm%bC5q+eN)$^<`eNrwlu$KYcu4?@CPBRphobxJE49g8@ z6*Y8jh5kAHj6jlpmI#k2ONo)4DN789Sy`e8=`55b(vMZvnP6OyKfjqq21&`-H6d2E zs_0>{f!vXNO+s}Ul4B<*iP}uQri~%6LOumpd;%!=KDw#IK-0EPEZTlYW$GJ(#RuI8 z@?K!j!FZq>Yq(uNI+-K}{(cj|0Q*~Oty97`0WSy};Ts4)gBO4Rzcdp-l_{CN75c6u z8il!tpi!uX7zCUeP~__pT!T>BQ1w6ORr|46lpK?zX;>5D;Njzt#Q-&v1+ zhzg5sV_-EUmMa}*N4)?JSUN<;N@U^Du*1PR=fJLT7$FG|YQ(@ZKuOxT7$mzNU5TS= zKuV2=}kr_EO@Z2)=I+@GRi?y9wZ1Oq9CUa`Z2Obfs1_%w;K~V|7JrBFcuV5GX zJ?tXeU>AAIU=!C`rJ9wI(`JLGTE)7=mn#Kf)g#GMrM;_)tb02%fYNgFkT#ihN8ZVJ z-(ww>@0D2n(to1|oul)@tW5(Fs?dp#X*W&#sAQrwK~(Nwr!%zP`Njx+2R_Y?$0bjT zotQg(1dET*KimlWE=;f^2rIJVbY0oQcfF*g`DRU#w50L@+LK68smbU^KAilSQ;%_h z_+)Jv;+fFZ7yC|rfIt*GHLyPE-sGyQ=nb!K6-@JE<2HfkBayMM-Ne3LN5py9*QnSE zq`v$ZGY~Mc5k#eglj`UV2C04qJhaacyj-N3Lbc?idW^t=M3ELrvz7Odv}L}o?F31R zI&0;jdNr{#7&N7jbheja^P(WxyuMFxOkC{K^V4B?938N`&txhAB@7xgU2o9fS-{sm zM(}dcz)c8q8muO;WU1zVxw7NPMIq^IPlH?(Byx#Vq={U$mw{Zgv9rMe6KW1jsMo=S z>M~eEo>O~ctU<~9QMC5&2-dQJY(xEM&$q&6Qhj|9qVX;$G{!5i~c7-wSa zN7dj&yd4lPG%Lp0^ZSDo38Lt)uLD+aAHenfo*+zsn-5nB7lCu4jM)tHES<=@C`z!* zq9_ZSL{S#*NE9VFx+oe;)3GSZQgTt0QYMO`>@^of+3R>wl)dGmC@UsW6itjw6h&En zE{d|G=NCoKD=#uoTwXl4)PGK1B#e+pUg6~N)LVkvr?_B?`oKtRa4hyj74 zO&tx0G{Dja#3Vqx(17SrOzcJ(V`5?^>P@3F1HYB6ztHQwKCa#&N`y^IuDzmkCleB# zh(Hpo|FHZ*)jXkLDOiI9*6;*a19q=BVE1|hcCR;J_j&_%uQy=#dINT^H(>XA19q=B zVE6jr??Kx5DcoytA7TXtD=CfTaF0VldAv0F$TOuWN2*F~M>ZI&=6X7n7fvU9LiE(n z=IQb%#gIH2W(dm^loAi=vDh}5YM{%bl#Jw2mJ6GR^?b&eJr)gd7AI@;b8fUW98q{O z2FQ>{2@=Vp36P9ad^#laK|U5m>(~ir`AonKd6a;YJemO9INGNJH=pin2Oc}%*B+&x z9kiWO8Ing6$}rCR>1CLY{Ivs&o%(B!iXHrGkJ5|P&;FUJnat@fS3hEvs#iu%;;`2$ z^e`b(pQ^G3uRO%%%wlQJs`1tuajO$%QwUNke#d0c3qE&TNmpDc7JfQ&Uvcp!L&lzDxwF}4rGrwzs9GK}r#0Y)F& zA6&}?OgmMgLjiLWQgkF>zJU0cfcYc>=MyjqJW;N)_5a|9_}wP_#>7kWLc|zd250L{ z*1aGMWO26Ro*k1WnVg^*f>ke+teZ;V(^Bv_4~14ZUGK#m?MTXNxGEq#(&qWq?!JO13DX%)!nm zV`wKGQ%3JYT;%Qxh@2|B;L{v#b^*2V8DvHUpkd&t zh6olJHn1Ipb~c1rn2V3JJw#?`BS(c2D+pR4g-YH?ZiY)5+K!(vGekDV?NUOznG=SoUvF zT~kd>TRO5CN2A>#d`kz8O<|V^?G9m_4xrli!!S@xn(Uxdk|rrD(U7tVRa1mU7g)os zU=6o{HQ>-mBMzN3;?PMW4xKdO&`Bc>oiyUmNh1!OG~&=nBMzN3o`tkA7tROwOSrEL zmNJeuoDi0@;pF^SLO?wS#mU(HaZV&r3;U#iH|_q2Z(Du$2knDWSf^nED(#O_S&%kI z4TT-OvNeR(i7{$+lxSM~dIVFx9Q$2$vGoXc2+q8|m6EW&wQra)@Rp+t?JWc^dOhN) zSl$B4DGUQK+VfN5?NHKdThZJWIr6|}2&#{NL12^PP ziedK9c;GR6CrEV;5>g=!V$uDm2$ zD0M(}GwWcibD4V|vxTZ5!kcMc<>^eU!(wf!e)8b_qkf8c=#Gq;!=!4gYR4T-P{V|V zA-H{gmB9mkel^DN=LnhsUBJF*hV<(gr0E3d83Zd^={AW=<_O)9zhjOt4nUzO%MC;& zVyWB^`xOka#nM+~h#f%1ekG%gV2G_@hFHWWYsrYm+HgxD8DdXnGdY>o#pzNQ7-H!< z8a6*OLo9(O7Esx`*~~1?zYJ_N09yuzN?L|d4^0BLE_T6?S+^kghHg;?T)6bp7bt3T z5WIv2V32eJ@8B4uI{37n^yr31Wh+S`m)r^}vUc1GZw$d3%#zhDQj@K`yVSJI=S*g# zZb~X=Hp_aQfZPyBAtrD0l{yNN<)s{8DqHDF2=l~to`rU|P8devVP*=Wi_;}e?KC#1 z+YM!K>TZWmYa1L--HS9E??N^XWhtPLSyX`SBMY{VVX%GV8mwWGpuK^Vm94Z7{F3QC z7N9$(_X5HiTdtWoxjz;jn!5PLNKL(cBS)^Hj(+t>W=tLw9hS^&$xRMyo@~m-=E+Nl~je@|D(+n z3R4NkkQXN$kBRa%n+D`yC z-h7pccYe`K|kvFlAETq^IkIC|^t9FCIAo$$5+X4nFPJAgcFA zC?IG{gD2=5lOMt1L5em3J>Pc4-ytoBIGZ5;l0jsx^9*@Cs4I5r6Bj?UGFU0#50;%B;?V%K|J zqh|(7OEezhN-73Nqf2d&INk5!i4*SmVx>oDVYP8C6p}J1Buin&gmQ9ZGEAD&;lJHr z6I0JMEuv&rOpAgMDCg=6%0I=Mj_iFaDF?gC19D6`gTxpRQ}#MPXFVAy`Cx2e zd9Vacw-uBZn@2OQv8dSA4nZtRi-EE5#1^K- z)z=^xP1dp~wTZ#u%8`yqqP6rj@ZEqs+7SfxMmX_i8{m=EQm z49Z1?!5XGf){83ssaWv^RJ_z){KLF>-6l9j4BU?htU!x_yP2oA81TZwSE9wh6y_%Z zLJZstfAqT8inO?T1j~^v28J+Ct{CXcl9Naw2D(x5WGxjx7l-s`eGHnZ$fNB;P^a13 zI*KeOrmtn%hAaFl2_)%`wZvW#3MOko{Cnc#vOvN#xN13p$z z`z~i}I$5JLD^I<(rT`0o*cxjLZ_SP59OJ*kr;WvsAF{i&fPc;fu5Cy_!snblT5#ke!^5Tok+ zE2GdpB}AY=Alv-Wl3&tVD0-zJyIM`ik&G98m zt?rm=qHj|&Z5_`71-TN^!O@&=uP{iu9&oiU5sW9P>Ewoqa-d?$E^bpV zy4k2?bF)#{+-wx?yxC>~d#QCK_1a0XUVGkiIG5IrfA4Oz?KnnhjL6Nr3;dk|8$ z(ZooX(^~#gKcvPuzDvNOW7rk4lh}27^>#(5)eM!5xT@# z_H)Rg9J95^ti6ZeB_U86hrl|@ZXyWRIZX77owB|!R&EBBdmCjmC<6Y&o6t8ZTW6BL_U6jR=Z`3 z+j$sr5xTOHHf0;f8vVe7x4{tLr_sf$7d28jcPscn@zq z+pzJFp&7OzOgDlrOU9L~!AZDMM%kQ!xZrK6!D)7OC8iS2WQl5JJAR49*2+%!=uh>Z zQ74YT9z29Y3^yg*pWZR7c@1#)Drih~(Vj!q)i8Ncp(hVGP|e-Ju1f&YdWveVY+g%k zBh&L{QoHa`jW7i&Pp?79pSJBA0yCX~;qfZP7nv_ig58j)X((0=)|#035xZOVHWbZA zM>1e(lMyruQmEJ-YKVb96+}psH_>y;GMj#FEv}_eHm{*F!t|^>-G*t&rz5wCV9|X9 zxqP^`-{y$n8oSH^H|&^iB-M7N83_64TCK+PQcL4bxMQVO&KBkZthN=Y%$)RMsw%}G zk0ua41aV&}ihpwzqY`_D=!wnF20K()grklO*vs)MdZo&K!Oh0gP}D=%ER*DjSY%3~ zvM1Sd>8ez^c}|_PEoW~?uKpaOvLqDFLcd@`at0rm9{Y4k6lMsx&omABB@NC114U2i zBpaOM)s|AlSx=BoFT=GxtaYSQG*FFQDr%TgqF?cW8u1sH)!=M3#E`@wowE^AV9s8? z!Vnvzv%44#kcP4}4}zCU={_+KweV?l3wPW&$Az(u{d6YGM|DIOsbZcq*IwK$RE?{M z*$X1Em64dh%Bh0Y+J^Cvs?|6!z9twmt#Ir-WxAgTHI7T!LTX|C9KJO$y@j z@6EU4*XRtP&}4+rB{naW0J>?c(Z(LmkpG78+Z8Bk@`QgJQVwB*(%5G|iP^61>sl} znLR`FL`$}_JV%`+%wDl4#vS{XQk|Zjv;a_9k#8axo^^%loE@&c%RMkaqW@0BJz@k8 zAF8TTJZsHXNq+AHu#v6D&kkh_I5G2PzQ7V9u31>FRFS93$CryOv z%x!VwRhcCYQv&Rlz~*2I<8U9IU?Y~Rs?k_Cufl`+D9fmWXF2wl?=xeXgX4+>o1gEC zt=f~Now80*rtCwfw=Z?JixE4OK<=6$zodba>YL)hYM`kjl2sK=# zbc1=8VcJ3!6-bTUpf`4dQ%i;<${YK2__P+LBCf+~&kopD*1m`qVjW48pCxaYVCU_& zoYR?bj{;`{_v3W5QA~ZTPZ=5sWCj2sG%+2nT}OrCi%r!E4tBYB)Vk3$phz4e!L-QI zlL+6Si||0(i>w@NE1^A+p-twe`$&eYqE@2M{$$`6vZorR#v|66P7yr1iu{~~QZk$f zz_TM3%A1;j(({0Yn#}t{aq@`3cF;X3tI<6T8q6SEV>F-xL}sN0T$r_@mrfWY<$a1B zL3Bebv0wsbuwacoqQVJ~1bFPrIBJ->?RYUjH=L-fCu@h{)rR7MreNZ&3PB%IJ2=nV z_^p+10L}55-GHKOz6l|GE4vx!MeN@y~V#%BX^@EsjRz6D`i{WS+S zXV>NIMe~G8C}uai{DNc!2WWl|qM#B4=O)u9;m|4zSejaS7JjMhTKRVP=#S0lBSH)- zFjd52vZQw%OYN!1ZAk5Yw^`I446KaPgX@_XPxxXD!w|HiS8(d>K>28yW|X0AgTIYF zB(+ZO{yi}p@b3R4%{QvoUM$K_l8=3PjHp;iA@&hA)w9aA-{(UW=zdr~^enn~d6n;8 z_O*r;cR>tAA>he$jF+#bPGa@NzGhqtQjw3(IpCQ7@_{6Pxig8V#ZHn2DL{(RCQLLX zHhdoNIN(GbFh*k>YBQfB9JkNC`!4nHoSIDf%3?^LB@- zD52unwbNZI>~!yhdk1cZaKfFr_)g~`XbyDXT6=-yGjB777x>6=h<3g3Z9|xRVYAJ^ zMcY^{NrxFMZ5z5@8z~8gUxb2i8{E@|lJG-qF@uqg2{mooF#>uwi?BXa;HYPwQ{ZRICH3@<*As9F^F_7?Yci?0hJRowI7`3S)zknX=I z@58Lz?deAN0UoyL$(_p75lC)F5U>gXI~^La>h5oCR=vknPnLCm=vI6T=^#D~i7K}g zbkRROiLXGSk?5-c%cIwZZg>0+k}{V9!)$qOUdMI&7t=|A`{3y{)qN2N9@Zd*v4tLgR}B zx5Qp~h{9cFW`e9s{1E6V8-0E;6Z;aE2)LvoS6JEGS0FW6%Cknoh#>d|j}(M-!IvGS zLm>qM_M@@zwb8M)?rJDELiBogh(kq388KIp2T{@f@PMLi(Vp;7`(fB>MB-i~Z+oky z(`Wr%YKyYK4uxnjc&fa61%-*jMDx+Wj8DQ-?*n;w|M0x~ta|;liM!WaRh>B3j&ivPAiD_(C)w0q=Md0{A8!tQwoRR-H~` z80!|ehJPE*DB;($iG62q6Yln0ncm{Y4&AhEM+ouR5G1#?kZ%SPYti!`9Z5ZZMHbFG z;S&M)I7@#pQ)hbR7u6`H^3*Ck(WC!Cc?MFRnHW(1)Y>9g6( znoT!1V+!#!K`yw1MLW}dxwY?IC9(*R9ZdY96 z-3jxTrvdpf)qjMl_E6m)wG`M`zyAo|mVtoD`k}MHhqj}0KH!VZ!ICT1cz3MvzC*Y4 zzx;7&*CY3o>X+KVYL5QwT;;>n!9mYE>W|Zd0g;vE-a#W(l&@w2+(E^=5wjpM+jKxx z&*FQQbbWsqB}4~IidrV&Qd!sO3IZdV3FT{4r`lboMCk*D@qHwe?g@HogYKQcba>PTf}WlE`~9D5biXe? zHgOOeAtl<;8B9Sh$glB7wLc-m+FuOZMcyLFB>k;5u4eJE_3YJAqQH9ACKIVF_d!=P z+T=j+3bRUzHsR2Z#@b}K`eU2x#L`SqNPVwF-N~pF|Amu6-X!@d_*GH1b(iZ{`Bi8M ze6hrN1#g%uSi@wfQ?pNe9GuY25}Y}V-Lh$Jo`uvr%XG{Z^XB<~RJc!pelQV+qpp5G zdZKjFf_1NxN&W{|lT^$@*X<^qO7q`7F^Wm04#VqKPQXdXm!j^%64D<*W#KP}B28Ei z!gnxjmLYZiVQ5k?CtqJ8IMKBtozh=bjigMw@?jc4o0q=<1F%9jpP$oLsLNm?5$Jmd z@@53Ec@q#Z)<0?~v?W28#RrN#2XpqRB|}|%D(up(Hf<|4xOW$EMTv6I>&jDP(_XO@ z-_!;6e8CH!vZ}VCJ>PfLES-ZP9`x?W-{Tujm_{nTpGPYV8`hROHk>VWygUdW@OYs# zO;}%Pv7D@+Z#$+JAPXd_F2o+7jrgsTqgcH?hsh4 z%3g`mFkq>;-&ZPdhqqFc3%&}gUIvDJItHQ>m%Q4i|3FapsXf)Vo1Rh0s@EpUCm02q zP&JwLPCj5w|M4pYX{83|0wz;*qX1uF-{pj>z2UJ zXizPii9uD0o3^`(@;5N>Qmrvu8{nnJ$0f+3{2|4AApmtntL~w|)GWG$mbzXNPM6Kh z#wln~-iS97wSUJG&8ka~*b|5Ehyf8$!36^d1YZm&5QazM5F|`+6+{FS5CM}Jz?DbBWPqMd z0F@}Zpsb6J-9;}x7SYRflZYgsive90pBr8Y%^(6IB#|ZG|5SDN%ydG?#O(d~eIGwK znd<7QQ;&1%)TvXas&noTZtK%$qT#=D#>}i~^QL4upO`prYSwi2r}yoBlKZjH?nwKSO~&vDJ3-NK}w3?j93 z>nDSsRNA-TxYv6$1$3gh%NpwZGa1vx^sG5kSRW1o7MjHdgo0)2Tns-Z(C$(z(frxn z3=G1vJ%sSd<8Akjx1^*Gw;?=y==h-)`V%pHXJiX))hO50X_K?2Po0}J&7X|o zvYk^Nnch#&sYmq>$T@HFBh%;5zz`xQW1^ip?+Kyp5MF@=Q?e(|nZ985%sJDAHfr2V ze^e_qYT?w`Q?j##*6Jf_(ck5KSVi~PJRx3vF@MVJnbRiID^ZP^HPguyD?wP(Mi5Lf zLs$=ys^zQ`gq4Wf7$yY7;@M&`34%jD;oec5kvTzfT#zTl$@j;}7B>qx%^!JoEsk=R z)hVq(OnFk2=W8+VN05iT9z{>@ZJNEI!;;PZ;MY?h&`nGa)8+kGm*Ld4na3 zawTcWB8v~UEv}5ylWAGP)GTJ-;&a6o*KJyQbMe8%;>xxG>3LpCujMtXc`d%7S~gSh z!Oq2%i2>O-3Z9Llpllini;5!L`iXO>eA;vF3A20W(&CGe;?}Kbf>2x;Dc9syEfs{E zC&JU+pXH1+pBLX7;G%c(fS)Y*G4HW{=?n);`j&8xTej-ob#=a3zGTLe3$34LMKZ4Q zJs`W{z;%i8;y8JJUwLU?Z>P@U*8T%K-Ny6ZIb@jprMtM!^YzjlzMFhqjQKlz6Nd~N zcwZe)9j~Q5AeYFF3rQuDAGrUwznxSPMdK%TM-D1ML&#oDqv(LVI9|40@D#ajmmN`_ zeXb6(1oqEVV2euLmAvm*DUFNcKMMjPl0NbjEs2oJ&wu3$lgs52Wgp^`i;{Oqws$4_ z7CC*CWIrKC)*8=Qzu zF2Z<}3g#hL!2U{jTtSJF_eqW;lCYtbP`M&Avht6aQI&trjNoFy;y8vD5SL2!m9l+h zZq4tJLtHTwMbvdGxE{3dbr6LA>MjV6+$abh!1p~k4CpHeTl)#Z?a6}h!2m%RbgLkI zc$*;X?;{8+ZWe?e0Dl?EVF=b~J*|Rp5VKX`oq}-v5JC964QYOZ_kb6G|6{)Ecz~2F*01c(5xW@8Km@5bkLE#+K8}K;bJ3tMf zJ<|5MM0&!}Se{Yd zcM^ovT?L`&x?q@#_$eI);jwG{zhAe)6cQr{^t%94$>2ET6$Rn>whhNMRG)1qs};(U z08d8;yHJt=cp*<%gm>PkfibS`dApo#y`xM6Q%$Z8 zh{UXvx65_J)k>PYXj^AwP_C<{3Y=9s;5WHQX-kiegmDuv9+UUogONM*9ztoa_L8&^ zw?0iZW|jQg&srrt`<%(Fme&HKvj@-(Cfv@>dcBqr&Yh)@$t zvVvd%4bQ@<(j?L8m~RyGzW+RzgXmX~uqb zv@2E~xk$2AD|sLf6WfH;HIS%BQ<}K-aZ_<+ly_`c>>0$FPs{0xtf%L9WG}t(?%Kzl z(NM%%yK5eIg(nyB$qNKx^&G|PCA%;XK+9BLY8ADE zs+#4Dl)FM- zZ2*w78cxM4ss+<^Q_acy(0Sgmme}2reT{5iW8Nj%^W~8VvLoMGBCeWeLR-@z4)W!M zT*;B6hR5exq{2niv+0=0*T@s%lFH;buT-#*;y#gAkS-$G@?@s7NRD!Oq*I;{k3_aL zNqC5p;?~HHmASRh=7dEtrA#}=qFGgM^!8w^V?m6behTlnZUc5h0|%eedM~%O6PQcP zTg7riyHR4^d%45~u??~Y z-0KQgx==qXVEyLEkrI|uzfH=QJ=AB?@aHY)40LwVUUY@bI*mF6s!RbZQSF$;SnRBH z*F5Qp^LLQ%PC0!Bl(yT{W|@i)u@>&~jtYz2%c_^aMo@dOA;thWkqJo>ku!cmrF4pD ziX&J>4S1Sj>BlNJRpcQO=V?kG2bvXEt?OA^jz)qv6gB-*xg| z1ER4;^o}rjQ^SfYqGF3pJO@jljp=fZK;FR7AQ}=v9nw7u7^>&qr2<*lx>pl0==(OO zh}svLC|N+{3>bSLLcaWguPlq$;AXSaIE#0vnd(>~VRYEmm?6aS<@5yEm2cf6uG)%G zMRILB(72+=F1pKrq>{9rlU7YIoD%%vHloph*yIdY_@YJtWa2i&u6OAsb}%Hg?kpJ}eD*0i*uy3b1Zsfcq7zj5t(%D$QU1r#2pEh*%4f1L>1KAURKe)5iKK88& z?BJG|Yulq~ml_fN$q^mfhEW$?gC4RKd5Y8?nt?{3hdw)T2{h;=jwaRYu9+u#F4Dln zf}575V%|~wmU`ZWp^425Y{ngnd1o79Kr*RdI|W8MB~K9#$P*SOl}m*?=*dwnr#m5E zKamQ{_*>AV;8O%yiI6wm)Npn3i-_Hg(OB>e%Lj1|xj8P%J2a9HU{3|b+YMeTtO1Dh8q93?*L3~1Dl?hrcf;1N>y zs(DCcBISVQ7qevlMz(!3SVE*zlpWvX)_M^XJ?+sG^6E_pqpQ215lElBFZrBztSPw& zGl5swaFuYx4sGEBh=m=Q=Bl-T_cig5Ff=T-9Hl6=ux14k*5Vxz&Xg#rU1-8+fG@_mX^vBSg2fFl|X128maI>r1H&_ z)4TO7prFk1$t;?iC78LQJR!fd{RC@qh& zSoex+OWcP{@)@cR_0Y(!vg4GsWU1si=Zt(GdliB&fkY2iul))N~5|ELJzbhSj!f-qG^W|z-3_CVA8*(lAh!HBRx6t z_tr{<6NxVAJ*0wrscno4`pO>mpf!}g;SKdrdTTk@U_v)jA-xG?gPp_%_EYGERYRx< zhEysTk5s-V!8koV6y)gTLJBv54KjF2nW53xfH44{tkGb5g0&c}*VJD_>s@UaV^DG6 zmt{`;5_7yrBnzk^F~?HI9L=cYc$qa#XAVLE6^NL_3|n?SdYfoe&S?aK#d)!T6-Xmj zn*eqZxqTsVbvCQ)WjW_7Y723Wj6j3(MiVGokbol|% zIG@yLjW|hOLGu}sT1%Eh`zJS5rZMS)bqN=1L&IasvB-qz@+JB?)}(T5SnO^-&+|2( z^IKmxh*r!(SLusSXABA3*_9Y4QOW0I+a~D47)x3BMuESwCbe7TZIB*QGl`z`PfoxH3C%IdP`MWYB|<$3fk95Y%U?~(3TIO7hO7X z5Ot!@N{a-xUIGVVosjU9Y|kepjx;-PC6qf`KGRn~cy#05rO`;>E)J9I39NjP%C}Wp z54Z*~UF3OcTR(mN_>DaBUhLR(kS9#U;<^LoOL@gwBr%s^_O$MH(QGvkld!~Byp9Cv zIYu#T`J^wBZ7Y#C@&i`W@DIqOEIH0nCr2WS-(Ikq_FYE1L`F}{vTUX23nLn!KfxhJ zJHp0eI*%}-4QAHrDA=JTN44+%fW_9?!DRDg)qLg%aZ*EOswdbRZMl01juG?bU_db8 z$=37?=UvDN=^C?*nyBe>@Y>;HdfAMJMwleS=3$&Lng+GGFl=#PJquw(TJecCMMo6Y*TP03qtbx zG_bYxKz0-wwfm4Dq(SPn%RN+t&daUM!C&Y1m;~ImQ+1wQOFzdDZvaoy0gi(@W;t-k z&*dSb^{ea%=_LxWy3|#oF1nV95eqGowlgssLST{YW~fQ>Nr7~yRFF@B zkqhMs&ZH9gbIG%YJv$-WNVQyxColr7xxnUy>*ysL`&g}dM_|7hCMwc0U+3x6R{@IG zW|kviZ!Of!eS%cDo}N`Tb0Z6LHFFb%RW)-9!Ue4IMm2NgL3KoMHS-BPqVW+*7&V?1 z9%Md~C(Mg2Gs6b-1=gdo>kI217eucQ0`v>?$1qyUQV<>qme^v+b2kkarZPzdV=3&R zzmT}Yy+QJ3bBNT!p1?k-UIy-iu)eCRZ|BV{*b!#NYlS2K&NLt0lWDFzooRZlduB}4jLh)Y*5bE3 zGmMLguGnVl)@YFs`a}MOo&7>an&&p5$H-Xr1^O(|SY|>D?-Z=Y#k@+?8G1GTN-Rrb zMPN98_Z_70qv*N@xR)7!1EsJsj1syat@xxpVw}7mv$p&Zv=Mvtu~~;W1^njG9AL*n zs>qwk?8%3sV$02EK)d#2jIMO=G)t}v%J;|yq$A*}u#e18nPi4a-W6M7KE;gH&PtR^(4;j$>zvL8o6WKicQ$+5E3RzwpMQ(AHm5c7_GkLr=*f`>hR ziAQDo4~XL{XHEEXsgKAc7^g7RmyrULTeA$A;5cH3kRo%*lP*jEadN6fvhTolvm7ru z;(T!8VUJ}r6x_877WvcvZV7ZLhRR*D$kj#F8Egp>)AHCH3ax_nIN}v%{;d>PF28^7f=OS_%IdKLF)ilLUCo7d5=^u3e+H-%#n`)Y%Y;J z!zqGC|CPelJ=r(N9!gd!;7^^Kg)MR+%UQsZ?9KW%(9{HUaj-MxlPUNUQt_Bo9V*`4 z%Pdgrj4GbW3ISUX_o}_+u6@##Vq`@&T{10v_P;ncy3Rs=vAKQO*Q{H&kv&#o=22xX zqS$O%{V!odv~Z+TX4sLXnn>t|wrVPa%hf^cSh5MCha|RBq6}p?Rqfg-dWxwtb(^zM z>+^kQ93duNC$618=^CO9Wlg%OI~{MU8U2kZ!>R>564;o(@+d!}FS^lR74o7W!OS*J zrmE;5(sFnvY{w{XAXa%$UEmh+?FQKsDqEL!e}}hQfl`meip4DZ>P(^((gB^%p#m+_|Np zq^tC#OXT#0a66kPrzgVPnZ%T;`5g)-bV5&^xQA8>6B4ltgB}sE3a}*a@(q2Tq>*nR z z4!zA#DQ(9A!ye60_|rB!bcfZ9#(*@#7mL zPZ$omQ3pifS!O8_(M?{>G}tfa>qu4;lF=HHul~t9WZE~>T^f!Zh?OUd2ZG^@lG%j# zzbLZFh;voMu?#Wm-v6Oyv+gC4@M>gc?5iJS#&Ip72bg3bwD$leX}KPUibHxgqmk1t zvmO9n4k}17!R8CITz^(A^!&(9?rQ4!2}H(nm)>c?J-=-~>-o3v)ASB;BQ^0`tFO`1 zw3HF^ZnjW|&`67cYH!=FSh0pE$bi~91O)a))D_UL%>L4}+Pw%pI5-D?oJaW5MD|b$ zYx(>*ndOn#f`#W0xAx1uNIAr16Tv>`cXmbCbq&wruIz$I7%RHU2=}48V$Udduq5%6 zq&Ls6B@}7LeKdIzW5*qixkyj0vZs-W+@a6!jG|0KwQ9QIlgjFXWe^+^D(+(2ZE@t( zTiG^wU+gK4mppt=d&io2>HiHB=Xatz1Q#@CY7_j^7#4S>IS5f(hA1%*5$Xa&JR4Q+ zPy{+_s3rCc3XeVIdx#@KT`EnyZ0za5F-~nyB5P0QMy5{1wT!7U!3fU)^<~}gwE1c;hv>ga${wnKsox!`wE7<5i;2-_LjQqprq_#?qBBh-fe6lrJV;D0dY*$na zKIdSSB8V|!73xrhmb~Y8GFG`B{a7h_Gls0=XzSTqBwxW))b zNLItP-Zb(=_oi4-Q^rd`jEbTr;c87d*=G{j<5YcGQP6WCQl4xcasmBil&64^@%-#K?7AR^ozrNw#jSCiUo8dber#h6 zpjsEw-&F8x0R`MO#IHp@ogsZ4!T%Z1biu6g#H<0l%qEsln03ltjai8Sc;8P4&#H}J z%NgvWG&bt$HKH$T1pQ@=pn$OvMZOMbM7xICPy}-iL^?AYhhxsS6=8RnHh*Y&@54@s z`dmoQv?ba1A0*h6=gP4b?S?R$@Sz|5=adbm68r|`=@ZqUf;6UYl-1WaM)vZygQlg= zdcmr~!Ow`lNW$FGbP2N=nb6`_@RPy~c%6Kv6y9Jugc6&3un5%5t;xY(XC+OLv0tEL zNEtvmy1F53xJ5X!H8b+a&djJIpJhfI*`FDG^s&syql+`6j(Rd9j^<}ZSN4bK7zWXi z3ej;-X7sB+Y1&2K`f3nUzeZ_l&~RSO!BkDE!_Lo%IL5Zt)1`uu)a_wyt;P@7GDWtX z@Dz!8SF?djjTD!~BCO8COss;hv6~ zY1zcvkC_w9kiigSBv-k_!(6)yVhLt@|LZKq0omyF(82Xe$_+4#D>Dw-JB3ZK5GUco{g)IF1nh5c0 zra<6OFtMR9U>B#rhktJd17_qgDIvvEbG4OUNr@)|3n?V5=GGh$P z!4IbZ7X!CnnU_PE72?@Y=)02>;)C7IAjFR!GeVre&y}Ijl%e3h*lMZh{Eho$j5B+T z`(#+wWM8}7leF$}I&ybTs=zV@k*Q$rbvrbz97^s=B!D4eh`#Q>)nGcjk(&;uA`@Gi zwR6|TxZ0#(t&%1$Uo>;r3trA6ojRnorB#c zqn)?APhRaz&OMn!^iIk>SpgqV=MBCdxjO|$`Pi)X?vve|ZQLjOI^%Lr{z1fRi!a(o zlX7c@-Rxm2vh7jGXM7LX2y7f`%b|Z{-I^8-D z-4cjyqDnWS+1Ev!X45}z2F+eXX5e@ZKUZkhB-y(2ocp9DE5XgRfgvXsfEc<=)yC17 zzj2xz_^25)X@kt5Neq6j&?E$!TgX3dt8<9XuFKGrLRw6TSA;(T`h{9VaNsw{R=xlGQ$Z&7p|?TiN@Y#0hK{} zIdCWm$JTG)`=|g*GrUvXwIcU%hxyfW5@t5wlnE!C+C2;nZDNIC$4eeiNDV+99HlCR zo4&B&4xy@jW@J^5%&4k-HG8QcWpek`r=9-&)dBCbSfUMa(|`b`LVNsa6MTm7LqT%y9PPvkbt#Z^yKgy z*9PT?z{c67GNkhiCq4-3H93yi=0`iR$;aDF?TusY4K`~VdyJO8=&|*LkM%n3_{rSV z@2-w;Cb}<1JKMQ0#yDHMFUG;a`C_Ypohg-;%d(T@O+n5Gx=dOuxUQ6hJGlp=+ z2I16p4}xpxnu6M0e7}L(jdFGk;0wLVW~$@lOV-iV2Ke3tzHK;!Ri|u1h`B)Y{;(k- za~Zqu!^jPElksy!$TUsJgs?M;n|VY}KIiuf?~$`@50DJc7+lyzcSWJkl>vChueN>J z9go_6w{iQjj^$UvSQ560*|X72OgBp(reOC8IGM@)R^wi#u%V}L#G4s??ty5zR}&edg10|ucav=;pTbTfE6}Vw!wR(EuWLvM+nm_sj3q2= ztAL@h_|h8P?ZieWwmZqnPurtGyPdSx8CI0L=8a=U4;n!G5k|EzKo#>@eue zJ;&^dRI#GX;l3HT;HP4&jJkgg_rqgP|COA;)_aN;kCYwj-L)58W_j{L-Tx?wuM!*Z z6bjzmdIuh9kaC;xW1h5Lx%GV_#d>mMNur>AJx&hc%)naO=j?!(QrjuU2smx#Sc{`( zPvBmS3b@azwYu;wYUP0^Al$wer^pwx@{m#bZE(O3bnEBU9ti{vTdEU zOw7yOMwLEBm4-$LBCf^x!UjA8FTgqN_wRAvIlq(dTknv}LHc#p@NbUtW{n0R#B+oRh`)BqJ3 zh#&I?Dhv%*#^6W!m>6%;r|5f$I^vY5QWc#PqFSBsf0QaH}aJ{4sp0w52 z!P!8RG-KmZ{*4ypA9NAN$VWE3c@IxAh zHtiX=my5h+&1olidznvo0o%6$PCNCsm+6|6Sa`}{Zm8$B1IHQv{9xQ(X0AE0s%H-F zywE&z!mueB zu9@Y!2|d%xH3Q-8esKP4zfM~`#qy$xBCRKvGBym$#*wL|?NEqv{*OI4YVytyo@8nfr z7|Zr!Bza#VcCw$K;32RZ(nwTee$Pzoo@1Bi&gE}hmOG~+3CZ}LU`pjrW+FD5!*tJh-5s4M-0CeOg>OLqAPTpoh)^l~ zEsi9D!u#=aSyp}viKxcE#pIxz2Yb@2#5r^TV^%%~gGq^(3ra~ydJ>VCX%FNXm35b< ztcZE96H}|F^2FsYP-4|Nnrn>Ws^y5|^U`f7Sy_Nb)KL?Wjjs%-*icpml)mwmL1St@ z1rG`Z!x+Ps0XknAKewGO6`{5!y= z4IGsq-dy;mkvCWU8MOV}{Si(aeG02c9$Xg$pQ(X!oW9KpWQ)%FOd~5>{19hj|2Eh? z`Zm}|jY(AZ*V{OQT#EvIxC6MJFxK1D8s1=fa~8eG6`ETvq0qeghOtH4{{-U~S7$!K zczFYlP-k!w9STiD_d#jb%~)RS6_FL)OIL6lP;mPHiWMAfa#U4rakWgtl#Sh6w6P0& zo;q&*tGwV9#;VtuR9S%^nm4Za&t1}ci!_7ER^!7euhuk!d%1&OI3z1{8+qq3j1M|n zL(7!WuW^k=qs}T98JkxX?2fR=H;rpywYI-==3bT zVWy>1v?(U6KpOUYrQ-ss-z&>)m}!~sYoPnT=KRV|qy#&^;wTB~z?@$hDw<-M18m^A zhaeAFoY%){2O3{}|4TYN5LhqckfnK)=tC0^87Ihakw2P7Y{Oc7%4=*$(uHoD;xk*l zQk~iAwU07eaZO<&j%vfNgB=_E?H@r~eR`z}k?B5#BAQ|0XB^~*{k`u`7>zwB17Es+ z1ZF9wN?F&>B-`=;BPn< zzDYRBx!zi`c)V_M;O_9SeO$&_L3)|VjAi)owa2uIih0c`-WVLWBdIqF@nr9^t;ae2 zrTJ)`53Ke(@T2ze zC}{Hy_p!Ka7sUaU?o2 z=)6_n!7UhA15a%Mhgrd74IIo$J(}Sl1*efSTZBVBuw}oX9?c0jtp%JGA8cwk_)EvN z$liI0vs!jod;JHs92el`tew(A)9W440%9n$IjC)RH{y4BWM6MW6#b3sJ8&-}=Q6w}pp9e+h8jxMmZ;A|X(L|KZ&GAP&S zDdSyz={y@{@ZuKLp+WS_Q6lm86>E;O|c4ZusIR9O<`L{I-^>cDwn39msPoh z_DJ>vXdmpY+B|J`iNnaWo^rM=aJ(+F2et%|Ptj#rrNV~p!jTWL+fa_( zhJWICRC_EQx{eR4D#hmH7ucM{4#aCeWwz$xVp{Oljkuaw*|8B|Tc1>B{c=G^j8+)) z58RW%%E0wD;F@sk3i&2`&MoOevn;+kv!H!uf$jCNfoUw}?{HLIJJi+GiGKeJY^wYW zKcp1t%a~bcv43x8*h@5o+1}26@O7ihn29eMmoZsD9<+>^LJ<=df-Xt8JOE9$uZQ{c zKu~i6nvAPM_ahmaY=1qdTX>V%LKj<(P2Fre{5)&&H~2x5m0QqKr40sp(2fpM4GW&4 z#x|v*_c7WuTG89|#rmCGp}9?449xGXEdEAJ!2Gu=T?htq1Xx*0A;G4IeJ5g9z#ep{5GFd|J-P69&-!bAMcq zrx_$jfnJMC@ut<+&n}}~PC@yYBJQIfr~=kAPAm|hHrUqS0#lkihTsje4ypXOWWApk zx1w<>FOq)LC@+@(-q;b9&rwGNEUEuN5uqxW8<7dse4c(9Y`{{yp#~^ZiM!T7=;+)< zo0FSv$`m(^$rN9?7BCdB6L36Jy#sQFwl-OOFRz*3>^4&8nZX90>CJhjCkpmmr&cOf z?^PE!wyAuy=ylo7c&GsVLk2-Q4%+Yv=&cu652gjIb#_8x`R#7o@TBYmhiGh}l5FYy zA={`P11j|D!}y`&kKWxW*3*m~#v>*`IxTs{&kdiTekwP-bUAJ~`n-`Feun#25H}pB zh)}uVugHXYzlopVdap+eF~MwN0{f^{Sfus1u71bvB?@ ztFEI~i!vLEV(SEd8R29c)D+JvyWK&%-E4=Zi>o7NT!+~3Mr9X?%liqh6uxTMkouJ^UWJgcVInt&xMMRI%) zg{@_l2unE6*M+S3VO0EQ2y2TmsX#yuX6E%!2udpyN~pVCahGg5P*WsiM}o}G8Fh~sfq&S1BEVPz++=ox63oAmBp6{6l4T5p+IV!R(s8~ zOP3ds=x$3F4$&nENRNuLOAm&csZ;1&C9ayGYfhP!ms%Un$tdPei=x?!jIRCN7njcO z-Q=~MZH+HBK)F?o?Z-it0EGs6Zn?NRmDY}-&WRruusQKP`eA0T3otjs>_tDpW-p3i zW-kiVH+xa6YWAX_YWAYwWz1eIBP}M+c_^rwy|j!?HG45EFY8!Tdl$pfTzeN~=JqZP z%`dli5hl5i{$f?p3g7XOS)*~+Ev+m13}a*p)MsRhRT-IrDkD?yGK|bJaz>`0%E(&A zrZO_a!Wo%@DkC#2&1GcD%o$lj^UE2TFv*4VS7&7Qz!`Zd6bf2dRR0@&IWd;#%Y9Ml z3#37JV3IpX&jKS$+=cu>EYXJ|LS>1Xm5e3M&`*P0e*ka%%iwoo)D;k08nkAt&K<1S zdb~_5c$UPj=PVkHfLfosw9P9qkNl0aohxzqOiCPdd!x9@fjGWQnuMa25qKoaw7S%| z3XiXMbzS4GpbPr2Ws12IxABzJu_BdoDD(ArS5KOpM7sBk-D8LA%lN%~xNN65w#3cS zhAF!!ag+fgXf;I9*Dj}soMZ>pAE3icyke|(^eDScbqBBR+){lnnJW|n6 z0TDQWK+V@16>i;0AAVeeZ@yrkl&C<9Zn6rJ_gMZc;z-*O+`Hs?UPh3uEbH;w4zH2d zzFH2d>3gGM-X~~(!^Wr03Vb9ri;lXeZO8_qnU{1Mi0XQz+CXNaK-~t?0gYBIOAXsV z{*DSaZUZ?j8JiS|5(0dWsy*PfZzEB4zN7msai(hLRp%6OHFL-db%ebL%n-WI(GL^4 zr$7Vg$YmQiX1_~`g#Hv1B=G8>yv2`=)c0q#iLME&?Imh zMbvA_WsXUNArn~i=Vcm;oG)MJa}{CzcWf?h(Qcz`4 zEn`zzlwsj4Ns-gMiEJ~Q7#$b|cvEw$neC8F}mbC7@xz)L#UeUTW&!MDz~g zhQ$pS$2GC48^=|#sv5@^p+L{YrTQX(CQHd;gk3@HRXqzCouyH| zC}5-uaA0^ui{C}(I@dOE4pMTgqZ<40U1YLnxp)2rh1K(Gz)lQ?aJ}P~e!m8O;7f9B zB!ifJBaY&ehulWoM}RB99UIwQ0>!wpRkCkkmL)H~Ua^g(g?Y$}GoJ6_!3Q^qZD=p1 zyS3QRSoP>l#2eeN?U~;JrZU;K&0URa5iW|5E!{i^G4+IF7AgU}15Ii93PBi$^-O0h zRij~d`3cS#m1~G(TVNle)wp93bs;}PsqR;at0Sn8Q2nZ7fe8pL_|ctfor6{Py<1e% zpE<>Mlj^(|4o@WCwW@gz4`yGy>fwb43y#cw1Yf^^efUSw3CirA{_5)bLdD=Cu6Q5))b>K&D z>6IH;8@YkC(c6;2>->&#$#aB+Ya#u0*G9u!U%-Mj;dE0u3s%#89NO*9vTcjCoN0=m zJQ1WRimTYUr6+&W0IxiZ$R_iOM({_0AFMqMKUWA&_JT_u8PLuLGrDN-x{q zg-w}%I@G=eAG;>GRK37J(vjc_<@N3jkn|ZuhD_3Rz>i{{!cUV)N?)QnIt*sUaWFI9 zk6nmlxHYA~t?6!rGqgJwR{no|*>cl{y6kutb`*A#3yorK$?G-WK=Ls}@^5ZvfaIl! z44LGgx){kn#!r(;eub78?ob#m@o5Qq(I71!bT&lG`0E>><(X@#*|C?V*P>(`{!WK=sV@>0Yb#n~7!SwV|of_bc zWJHF{8@B^Lc%vVF{_o|DUopX@f^RUGWe@!wMK>i_;9wZGi zJHj%_uEbl8_sU2-GJ{Ba(et=Dh#C0pH8)ZMhh%f~Z&nQSlr^#SDmw-$7L5LR75OM8(?wy-%uyq$;qh_2w|^vr;?@lqZuQ+aKh& z>UF_0D5N=x#p6-67PaRm5d9~5hbU)|S2ZAY$96H?!|Lr$^RLFai^ACLRH}igKP7Hp zce)Z@R)M?IbOg7^tiWETxqS^Hx3LCxrz;a<&*;0;bbFn?JFVV|S7h;xq`VF6Ojma1 zdD)gU&#M}wDR1DGG`@f5E>ds9+vg>(zxp3}gA*hFXjU8?qG4^tR~=iK@r`kO+(=xu zibkwL5P7RdljJnD}wMb-qpe-|93dhuoce)g$O^46EL@~7lg1E1>rR~u4~3f z-MTlPO0BmEa|!F7X0iG03^w@3;m7dxtMpDdU~^(D%$qItsZC}`t$GASX=jd_{q?Iq z080vex{4Z{&CY@Z9ht_btGFKm?z$6K9VKBp;3~b-Hp~=`WJ6TAAu94ADxSe*Z-=oE z`4J0|3lJ4%h>l#CH9Y_cPyl!ePzZP)umSJ~z$<`10p0+-1^6rAeZcVvZ{;_5D_N62*QhW0{8U)z*st0gUYL3uZU6@`M6%B^3`C$;nIhjB)8(pu$t zywX@mw`b>3`cUoJ5-<3fS~UnGGu~oo5l$G7JjY}w2=$LLit7n-x*oo z*ry^!P1VUt7iEg8Qi-h9@qV)EBIGb4Llz;&9%5uYh@UHDy*yce(I+GpO)=1tnP_`q z_Sa;tPRpxFLkM-+?gac06<6Ws3N0^5OSkrEiH5%^@z2QyBGE-m%8FJE5Gf0hArol< z@PkP6@S_uned=Z-BIAO%LfttFm+>Y9HYbp1q~GF%hMA zU)J2(94y-ww_^Ue3-A%+))r<;y$bJxPD(thltugNpo`jf5E(LeY`dS;;Vt^{*CD}Q z2mW=)r||x=3lgm+TpQT5YCgGYbPK2|x{Gz>YO%qpUdFF7fmgLva8(1ki+@J(`}^v3 z*T$#@x=Ti6$lbLD$U!oRej4m9{vpAcRENv0-?Z-H{d6JHUq`*4st{Sfj+g1D6TfA3 zJW41WhRvl52cb?a#C6`7LRq^3ctpR{eeFV!hXP* zzX-xkz@3}nXau~qPIArKdXpl0Fg#2UDRa|_9m^OH;fjJ{&T$P=+}UM0S*JI06xGEfFA+p z0Y3xkU{f#yA_1`g5zr2B^?1{(vSw!h2MPLDwD0A0y$3(ub}2c>W1P37(kBzHbH?Qy zU+AQ@<}G-~hR>zenh8h{wAN%IYlo$QX8#u=o7U`rI=-992=fMhSRJFCt#giF?TpSj zo}+(5Zw+1sc(}o?F+8ArO-QW1naU4UksiRy@9i(Y4V8}$%3;>31Vh;`DrLcjcd#dH zI`1Gd-+V1z*tX&9TK=#$lxCZ|77oO} zK^SxVbj;ln;E^{4;fXDR@YvgeaNoOvFmkIPWNZ_J2R{&mtnJ9w*!8{7I*i`$oA05L zpag2)H2FP6)ML2I=r<1|6NLL@{Lq4i9Z>&;9>#u0=xAVtOj3GqUu*U`lLn8FZX0iG z-JY?A*8LAfgxb25$b{DA;zw`Y6|dr8uVVTF*3l`@8m0qg0v-cA4sZdU04xSzhvO)A zIQU{@i+V)@?dyFM-n4y7$#VefJ-Lwns*cDk$Q_Yc@Dh&5=f`j+I*Y@|jUGOFb)1oj zwj*oM5cvy5gvvzokqJyR7e7~+2;%vF!Bg36=QM9iJk!{Lv$w|@Xf#&Z~M5r`h zhD@OOllZwp^LjKVr|l#7?&gsju_<~pHbHy9cLMiBR1QUWl;%6}E&OIR{{cT&h}}$LGcnN#Vxkws#4QjF(GU|IASSNI*^YCW zkzAYDX5NoGaj}M^4p)yYsi#<^!Y^pB7tmkk5KVzgIYeJOlCw ztC0!Juo6F4n4xiIU}7QyB0_|FReQKoSs*5G&ZF{Lh>UKUHnCk>ZG_A-A-Pju9L5>v zva5|ZMi?3ABV-L)ZM;npp)$^5WCG*N$IlhUX`FGI#Sv0LIn5~^`pf*SDbT3DwQmS# zi60?LxFP6E#3*I>qj^|AM^;t!b^$VQ*y3=df7CGCv|ddo`9C_gbhwdQ3R(65^GzN_ zgvu@H$OLW~g`fY|xrI4xw}Ccs14PA55EcC(DsF(NxCNqO5JW|aCMt@!hj740QnhO! zi(=2XvZJ78Sb)(b3H1jC*mVe`c~}7PLL}n#$oHMWgV@PQ6$Na z|3@5h**7!NAu1+ARLp>=mu8qRc zf?xXe;s7W9&%?lD-3lJwAqX$*6od}|`vAuQVWoo55%4PB4Z<%$e-$D=#x?<97hn+5 z&H`v3co6ee0x4rIaoJ)D5|4lxAWTRdp@7-^qcwIPn* zWAw;C%w@OYk-U!EIg{KcW5m20@ytAr2kM^3ef^%t-NB@Nk&V~EU4soL)%#fVoWMhh zQb~JI>C@<2#$VIhB1NELK0`S7BJ+j4&N;$;GTJ%Ree!DOpxl!=f*?2tEKY@2)X5AcC>#wdA6p)BRNH{F47wjXzYF>gAafM3j; z$O2c3d9*FY%MtTNvM`k;=2;Q;_0|g$m)*p2bQAOFBTy(*%u8g+sbDcL4q-H>9~CK3 z0`521(G9=BtNdLQqZ~$yl<)8dsm+vnAHqDfxD4b3>IM8;_IfUH*_%B5=eHyM%LwOQ zq%uVJvk1!*;KkJ6BIZdv(VIxb-)Bdw?_7_guxI`8_^vADF*$#W_$B^$HND9-6!8!H z9#F zafaiRCQ`}-Umtkj$P+pxl~@lf=-^H7g;0D06csCfo1j#C#L)<8& zn+JFS@IL^}+eXZL9!Qx31`ac^AQK^O3aTQ6ZbQ{Y$Sgb|*F!Haak)MNS zjC>kX%9r?qbpO5u;lCry#ySKk0vPN6jes`R|BI*moKpUg67T^l(twR&SH3IxJjoVH zlH*UZkdkDhl;`lmhdpLC{+v?~<3Wrz=I+6>OMf;wX-rM`KfC(j*`YtjJFmmD&Hv2C z)Gc`CV=4(D8dEV?Y$$EdscsuyYoGiTm)}N- z4c`*I0dbu8zZ-yFOTZ)8mhT>qQ}3rrRZkp7)v=O%1JyHz(Qft}=Ig1RBUB^IzC`u1 zDmB95i{wee*_N{Cc_SWtzk#Yvo-X9?w$8do%2SOJi=joDAJIT!GyR%&=CUuvcF&Hqv>JsTW0qITeiYu)7UbYKd1(w@CT)DK7UZ|7UB;=)nfcX$ePF>m$+O@ z%#-7Y0|=8UnE1DUuSSG27w^^j&CDG&9N&s5P+7=_X| zpHV1x3o#0zYB5G3WKCrh!=9#?wl(ML){MkiHw@IO(5E z0_m^9V=(F2ZCb-2CdNZdOoC{*3t}Q2V&Y!yHmxr-OHg;zLDl1~G2R?e$0`{LcTl66 z&mEMzg}8%IwHS90vLe-C+tT=YG;4Z)Es263?b&JlF*uXq7h~vyNr6-u@XBb0+nWt%-K{W`4GbnxY zIfHVy5N8mo7UK*;2F?h1%d!dE++yB?7Ge!5B1q}DNUTAp9{h5Je{Qxf;z~WQBRyjc zqtelavgk?&?Y0~p2oaGA5s?9t>3x~eRhbYIGax4BLS)R>w21>|!fVh^e!zwp=b{n6 z0T)%^u{m5sl?{c9D1Gy}h;p|O7ZIu!<03-V94>0=#f;Xth&>Z5sNV zYQkhhF&rJ956(O7Evr>$EEZOOc*we)o>_c#e@X1nq z8a2&Ad)O%2H=J)_r_kr+@C8?VUalgM?$N94ObL^V@abv(%{Xt01y%9ihe9<8S8F2g z!Iy>6_*_&)D6WWfS1vX0#7Bi~^bAoO_YXGyECuw;Hk^Np*&$6?gTD&9zUEmv5ywAQ zw&*GZ{ny%klfZT^4j&W*(+NS?{k^6^F>8gZvIEkG99g!=O3RaKUXy(ab6lYu?^ky~8Lk)2S;_@zdGIm`o;&|7+ zb`84j0_|5d`zirp!zAIT2U?XFs6Eou z-C5DImYVa6DRj1D$P~JU3U;i^t>wHffda-=e>L{s_<8z(wf

^PXV7L4KSKpA-Cc6>X9sRh|5yUPXyI3}fC;t@ z*m4558Q{{8uOoylqK0%J!;SD`Ac``f1Px)2!+LH`ec@ViwTmYv6ZB&zWH5ZQBj-pX z(i9t5@)RIytV2sS-)HLs39EI`oFf){5 z#$XPKtX+8dQQg~2dQ^K@9~Y-8)}O2#Vrk$wR)l&L9Qh`fno=2#Q0U0}ev;hh9sU6g z#i8sb;?RQYmfSypw4cj|;kR5OR$=^+3GYI9`VeKuAE{!5Z=X_Fm7d;U84A8^ReK8` z@049aJg#AA!;bO!CDM5ED}8Z=4?2n%I-7AevdKpduU&D7T9f&SHeGE$R+|U0>fG{2 zOhvL!u76@32aT`ohwaFUic0;BiN&f2RtdIZEPn0~|2PNmIm$paY2*4EKR&3cs(~c{ zSHUAH6DCZk;(z=}et1r-u>XOqqN>P$%YJ8yyYA9`?0kVEVstV3W1(GLRJ5@-lwJa8`_2qlmLT?f*% zxHRIkIx}x7gp-VKk3Wh(>yT7t=SZ895+swHXt6@i&oP#3#!M=)dvt!#n@ZYAR~KT@ z;a2*rEA7$`@z!-}F_lAKat(NLpbZ2c2<^iI4tp}P#|Z+L7e=v+=uNFb92Wsh`uhG` z@Sywd!c*sZ1koU6(LrD^mM6;C8WmEOC?qCAjpo{dpy&(vEMq=)MeYzF{_+!2d#Fta zN)*MDCz8lWM)ZO}5)lnZ4iKFN>kLq1Y7eGvOojkD8(DLLOJk={4dSJU-o@xWd+WR8 zxx4;FJdfZXH(_M;#afn5IAmJ2tI7((yupcjoSRx>r-y>`TIT#r3Kj1etIm79c4DWX z?AuT(wH!)`5X~vvhd)Tj7}MTJI?O;BN}mBVNleE?l$R(?1EXXJHpyA0r0h6Zd~^G; zK#;rXsL?DLLUJ;Sf91s~C;~C@ul!~TypwEPAxKvF6F?@^yM?-jgAJPyOvNhV-7}$u zqKZZuDlt0!e;Q$s>HHf2f2;+niw6_-){}%@a=j=YxjY60a^d5@?amH~?Q$b|$xKcO zOh;NFyA1Fw;_LBGmI27YE(1IV$S(shpvwRRkt0*lz^cI>vN32+1q?L-4uJ9(lGs)_ z*9e$T#0Yi^Le>b-6u7rT0xVrH6|GJTp*`N+N6Uct*7|Q|w*dcSTbW-9fOt8ikw|u2 z2tQc}@0Lg|K7cpzjvR|T~c~?&}U}0GZ3&ZIwLQpNlx(T>bVg|G@U3```F;X>J zGh}17G;=JX-y)pFq%n}_7UTJHesHjJdUfA{iy>Rbu|%^j4&plqY@(rUVwSegjGC{ufyu)m`kw>l8_oxi^SW|l_lRjR0*9Tx~9Hbi^0 zW)ElubL}Fph-neG%i^S~Ask-*2MmCAK6wOinJH%BJd=zU>?ysSFC2==f;N@N9~|dH z79#ktg3Rt|5caVlv9=H=?#_Z-)#8t2y!BTH9)}bqPb8#fN#er$5D!M;2`zXx9{iE& zaDh>dC{WS@`17L^B3F2%9ifl_$th*j<=zVqMM_!nWPm@=5rk~K8pfxp^y{?yqp29s zR0NTV7KBuMWM8ZRf};k=6vIOYL!zL(bPxPdOxWBMyNT2X_iOwh84uprcH|{j-*Dc|9qQ(8SDagu^XeHnEt3618E0O^pMx zh;bmy+ z*NwS#oZe1B_K`d0&#kw-i*2x#RK*OQIV|pYxs44Ay=12F;EuJAz1GkmCaJ8>A`KXH zw$Ub~`CY)woCcVn93#eCMyl2D{pcCBXlJJvD>OYlSD}UJa}?U1nOszy!cjmD`5w}? zF3pbt2*Bn?5Lt0u3w-!6nYR@R{w5X{NLB?NgWu}4Ku@mowdf>!xSAt|C6(67a>y0U z+b&?%b7zq4JJJv*a~Ht+lB)2Bm=|lA&xrR_MR-K3(dhzwnbp^Yp{=v>Mmxf<0W-ObF}%Xd|PGRHwQA5&Z!B$d?2&H@yhm-RYm$# zA}qOGpCen)bMgs#+Q(y2F&W?wsR*i=&^e_w=?2HYPedI&WZhW~aVc5Pvzg_ua@j`f z1zf00lb-HkQ3gG0{bLwk**+kgh2AGZ58YOU-^K6%lG9Z9gRs%&w$PjNpVsiej+{~U z910C)e6+{!sN9B9a@dWaU;UGI0||Cg5Iq-HGlq!yl1d>37w7#%2Qz8oG$|2fzar4rr7b9k+W%sy1u^_X8OCk+Y zq+*w~usG>FyXzh;*;5Fdip)sJkq``rsNU*u?N%8q?gv}`94A-txd;wz9vWr?LnZLh zoLT4ST}O?je_O05gShY;D=$sFbg076GrkDWCnE+*z8csK9DVsCWGvpBGOs*cv5+dNr z2@|e`<%j&lhw^xPyytUh1CG`;z%z>xv(hqIFXXf!-XnX9GD5S$)+YK2W!)7+j2_Wr@prb0P3DlD&Od--?G#PQqKnpz zOjttM7ds$F+Q29W{^80gA{_I$F*im_%S4i^vR@tBNu@|liB;ORnS!p+IG;vZ(G{|1 zDtQsertFLDWJW-093^w7RBYrSL_!m!!Rd?V@fRT?P5Vty3tK9G`AOiw0CozCd~Kqm ziQ+N}B1%?!B{b$4OhH$Fiz{;!oZFP~N4jH_w&nm=h?rzocP$b5zsip?v&%=F*-Ov3 z?9LdH-9A^w4i<~0ed#$AOLf6VMWznP>z@IbJ^aKj3*}GNbd{N782e8W+lg3#oITwz zI=x-sisFcfH$;R*XU z;pZ?ggECl$&GDW9rxG!$OOUFGmWn5t(a+#05Y{pGN~5K@<`CzaHj}#sot?v@>YFx; ztuo@J=duG;a-N)_Y9tHq#2>Xo#@1%U6xABGn~n2+oczI7$gWAZpTe#cc960%;2)%il{Jb?wHTW_>ksUnX| z@y$L};)0xfhmeT!h5s;FYMm+hJ4(x+?`#ZJPV(%5q_%h#+_m`f#&%!0&gQcV37OUC z%=(fMvpibs*&qG}CzwZ<)54ORb{^OVDMwwt&xW_#tX^ID7L6v?qZRSf;Y8$1L$q~( zYOv!s?#IDXu{H{^Ni2lCM2a5)trP@RMX1H2)&E6KSm(jm&PT5L2g4h2CLLM4I@QcQ zT5d;E$>-^-S*q-zYG{B^7~uV$$lNgyM7zNE}WIpH5#OED;!DRsk@CUTuqPNQ|t} zX(Q8wf5g~yls@f?R?IpWMX^siVtpDP6=@#WCp0OY%D)9ZisacBV{lu9JfgZ3F{u=h zP(+@d&T?_6GMQ&7Re~&PLc9m#XN4A zs^P($=CYM5Qe>~@8omL2p`w%|b0(`3W@tA$h8gzcuNqBP=7w6}MKPuLJWPdvDD|ndi|E%xZe!9pr*}p@VTQ(IVcI}pVCE|S(OK03z%=IwtWm=jlv_NKf zl!yS#up$ho2t!gaLPZE)fo+5fttSz$Aj|cHWHnX#VY~{Aa7Dal8y?Qv+D;DJt^8=0 zLq=UN1ZJa!_|!9MYd;>?sr(oGMQEfQ)FS2Z_`u7MI)St@%3;j`Bj*>}`c?*lw(^!H>{HtnGDLG{D1FsvG!$`qOcb#jYAZS=4xa}i;(ZE2kJgdIii#RZ#fVq! zNKn#OFGBTjA}~TlDCYqjt}tv@yEK`%@R&d&q`@WGBqQjCj72A{5tpM*b-!0&#SLYf z=H?-d0&eNoKan#b(tzSUKeZvonM`DZ8;#Y3*DoKfM=Ew`a!e!M%^?o*MRgTT)dJMz-QrWg1wE+Mo>LAQ|A# zrD78%4sHvH=oRp0$cKsuu!tfr1CK@qh}y-({!mBclyUX|PF?1lZ#@Ds+$fSDHT>Um zd}=`@Dx!`AEr7Y()5u*URm?Caq5E*sneW?$AG}5kn{|MeOr6N6dlE{_*G5Gp4BSYb zsz|DYxM4iGKgg2V?A3fFnzGmsc@Do_e}?PJ-H_m=r%RSp@=uJQ5~=|f;#Cs<&DB!f zG&Y05|MWN6g5)fnyjSg(ARZzPy6)#wj}`mIg~AsmEUUpZe>n<8QvLukHO9Du`B{o* zj#2z^L+MFk&#*@u*LYw||lf=Kl;q9Dw(LL=b4lmtI(FCa+)!3xg-X@@M+Gc%B;UI_s*4MUF1HB2VS z;)NORAWQ~1c$0^VE=t6g0iQ-{PlMx!@K)J@&GDY!NKQZ?1ulbS0aJZ)l;2(jt8Z3` zVOMChTDiU}Wkc0PaRKE}o2hn<24#By?CIkQ#*Ax~?V1KQ&=VpxTB96R!m<4=82S5H zT>g}N1w}}ri=#oylPwM}guzklwW+3G*4Z{#W|CotN|W$ z6-%PQoP~c#dopW2-u)%~bt+`B3kRIzJy9>|4i=@T6O@-v)NFy=o`;rbUaJMcqomIB zdB2Hx`V(;C15WgAb)Aw5li*zt>oW|9L`WGg&c?@pmWVi*GznWA-wv{)pf zn<&%D!ViE~I8FAZTx}m8-_rvt)oPl}%+wOJRR05Vxg2@d`Gi6sp26W01SdeR31tyPlqJOn60?#l!Bul!{nrSQiUD9bOvtP0-u-|H;Pt|GfIc4`64y;QHUiM~r!`-fFXRr+c4$k9;@31G)#hqv7C{@&zuX1gAI9EQ&awmt1 zvK(*_^r+4${0D1K#WGYxx)Z$EadZy5!NIp?Oy7@69c@y~a~SX7b-^R$GoB8UY$kuv_?I~~f&8y$mfgxlh>Lkk@reuP^ctTrHgxWT2p|AIac zqQmKXT{QFU9o$C|wYYA2o+0 zYM*zfV1jK2?Yy3hK2a8-3&Ss9StRxsg5-$Zy)%3S?7U{(w1s&%K{JVdp1P8Rk}oY- zydQw@o=I9<8Z~vKmQY2j7$(gLknmNM1%0jMB%+on%h=({BJU2dEF%l0w~5PSN?trE zl#!Dqu>_fep3Es4e)%ahN8+tY-O>ltKoZ39fzUP~q0$hr^a!v^VT{-?Bb`Q(khUOu z<^;n30+m`tMf}chksE?`&!U@yb)=wy4IYX=XlHoHryXP-k6Op!f6o0epU@qpv^_ zfhM#bgp87<5(Z>Xfq;sN?wz6do__@yvy_P_?j5G;c3C=S$ga*^`}KA#X@4`3a{-y^V8IHKM6`Zdo9R2}2IAklt$h`|ldou$e z*T4k^mBq@R*yEn){KuHBFhsUaR>y>`Fclep zhJV0o`mhz6xY@yrjA+BijfkN`9lR*>V>G9T<=+E3mp*D!98er1t1mrjzv`KFe+n%9w-KoJVa5){ZY=@r@|TARJ2z!B zjCPEqLNp%`@gWsk>K5UaNSOYO@x%1dVDe{c$kfzpZpaU->{I*MkV`5E*ev)ks50ZiOVJqfk-b?Q9W~*B z3#DlbGrZ-l?UlPaV*S@=woq;xPRfO~a$kM{5f_)(h=lx!OJslrD5Qj)ai;*UBE>4; z7D-@N(a6WyAmOm9I9+yNnr(kJLm1}bOiOvb)Ke)tD9o;C;V6nPh1-014qB1hRV0;6 z7c7mVB}cI%=RsjQFQ8!H$_F-he~pKuhQ1I#8%0A_d}NQDrU)b;VqW|XUiwat$)MLs zH;_!VlMlHqrT=U~S|GZJ+mTWK^b+LFM9wHdHWN9s1bGFK7nLB-BXUj&ate`iOOVw> z&MQIw7E<>&l^}mYbg?8w9h#gP&6S4A=z9htk{a+HpYJdWbX$d&%ilHqF~2jNv%1`5Y<4Xl*=#C=`e z_*>(re7&;o6*iwIr5!*V8pAd)gX_8n5B>l?j7KN_Id0fBmB}ebK8W6@l#I@iOq;2| ziW5hL4~2dW!ZndO#|PhG z+7ao8-T;}xxs64cGM5MmhW{o!4kXa9480MS`5yx^td$KU)R=5(Fc9Cf6MyMz8A{!l zt95Ui$0{(ar*h&w)9{x|d{$L^wPs-sz)M4gA@oq@GJJNnSH$i{e(|1@V5D&Iq%%>e zFGe_QImZ@^7G}RDMw6zhtj*aAuqPv}?VAbd{h9)TF`p)Vb^k{tq3x4K7@^RJm<%_| zR1ed*^Y3#)WVdZIJ9q?i4tgb8i1gwNuzaMVE1?r0ZWwlubLf%Nke|hIs)_f=vggnm z$wHGwYXX-dyYQ@8$a^TUJNJb9#4BR!dT|uOi3drwzvlS~T+BzQ7wpBKGB29cx@Kly zGzq6b&@#C}wCWq{_%2~Ri~*`W+MWF-!LVZ7(_Clzo`6vjvBkkx!}LP9?5h)WygDbSg}{yK5g&F8BoD8_7%n{XK6$a3eH(oN8XkMW4*V-8MR+gH z)hNx*2#xLH7G@%S2M6d2if%gt;flWNKNG%vFOwagkF3Q5Og;B!TsFVUmhZI|Jpu$-$ zmK9La;^72N85G_@E9Gq)0<7PJ7fchyr;!JLj%jI%9OEEMqx2LmV>^_B2&L4GEHHQ_@!upsj$I zAflM2Tmix>)ugQSLk9{oP%22rS~WXx@ZFaWxf4kzn`0TXkHg7Z7FmkYUfF@zWFT#}kS`04pISa>KAP(yt^S!U)uTx!Tq;1b*(p!*J zNoQtGr93nPh)rGK2BGN(WTetWrO95GL?_oMg`P-aG?Mb6YIGUykjbh|v>rnkvWp35YFG_DDb^r$6wqFV{LQXwwYvMis zhP+Tu)CGT9Weg3iG9+b-aEidgBFP$nd23C3pTFY3psMfBRo;;%1&R0Is{ zl>R=&x{8Nh*ni=Fli%osus)=?)pW|*C6h&)NS+5qM8~o(y%ff923c{jjRDq?t1%c0 zQMlx@3p8N`&YggY-S}3evN>+ErpZ9>qHRo_V|-)|7k&c+gK`lLCq^(Wb6)?4g|q9f zW$TbdaLfdDv(E7GPstdA5^a-o>Wz}c5`|Ypa%aZ~3txtUK@)tOmZmQxv;ZHW%V-gA zJqkl7HKg(bfRN*UO?%s`Oq*ZjI8r)$BepE1=D>(3+BMaS?H--IvxBP&*TV_8q)tUl zL!51M7#L#x^ECXq6vs$ZzU@jPq|s_RMUJ89dJMF*0%nFZlhok)xh6tctTC3Y9gwGB z*!&GASq^bh;f?K)ahCMN7ea6*FWVC{q8!iseGY5QC^|jmpea0%ka;=NqmdT%C+JB` z_$kDbg=;J%9A*YWGFuZ#>@}41?AUyYXeT<`u;0Z{OZMyaewis8_(Wk0T3V4gh$sbH zU{{HK_>xSjsNk1KlU@!(7Vp3&%>aLpnjosQ-Bu}`Ge%-2+zxa;GPXlC%#SKih`LTK zXkJ8_FIlZXS`KB!doVz4BP)W)ig`Ez%N1(4@!i(QXdev9nZEe89CC~DwJSwO8*}+V zPrN(2NQ5Hc7z@RXmYmDe;q9l`GO*5fZd)-4C2Wt3iOwa>D$t!Ows7&H<{jq^ zMfWahhPNSYBH9aK*$4AOFbe+~Z5lPV6cqeL4DL@I&cyf3K+#kbw;XFnH+rJ$8EV-N zZ0H`5JDnnh$fPx?n+4l}OKcJPCpq4$0~uFSeM{C19>7PZ_!>NiC+P624QL~GKyr~k zoQ^A1ZNGzDAfOE}OOCQ#?j4c^)ejLH5Q$;bbiV)_e{fN=E0HwI)k`o6!^Nf`Ozo+? zQdbEWJc1ldUhbN(l;y{3;RD!OMdqS^thXXjX%(yhH`EY?;cw{h#3hJ~_@rADsW50E zgY>ziA_VIzQC)OKy$Cskyz;z|%^_3}Gk4jzp(mN8bm&PqT%*$v(Oz`8wYwqhC;k!m>Su>@qwV`yWap*+MG`Be#&wna;8aoW4| zrshDW#RL6jcvz}W+7AQ#fhs!CCwioTK1YHqh|5p}K!%W728pr>D-igHR~Jzy|5Sg} z@h)abJEV~mL>w}`ngTL<$}*0pauh9jOOg5e$(PJ9nLF$WI%nzfw;`uu4Yx!!%m9C& zifWkXg81d9Qe^M68J$hbWT*kdGeoj6nDn@CkfKzDH|QuV2W+$%q1m_=6fr&&ffIMI z;bVGciHnOSbvP86^P)*b;iBo#LS!1=g$059Wy*49=Hdc5cbppAUssHni&M({W{AT^ zbB55)eq6K)QEu!<(z0VeM!57*_C;gAGVKt3490(07Vw4PTWKOu)XUBz*+(O*2k2}_ zR9Mkq$fX=ok1a@<=N0p|3g$V&Az54$&7yQw#FbHoiI}dpvcT#d8t5L@OOx?uXnqKh zqJvBxosg2H8)%gxzk8?7F-kRvTaR)hS8VW{$>Nr_f;G`rzyNSKv#a6fhKr2*zgBY>mX9`$6LbN-Y@g$1PuW{ z$V(6gSC2<(k3JDjGK}aPsH7E7i+6t-{EBe%;@$5n#?f?9CypxGeyK`U7fyEKfe;_r zBQq5Nd5L&K{ElPD5_ZGj(Y81sErq9nQ`)dXMPZ^NcbCM)3hDA~QHIr#2)TL9i#a|LlZ+-oz{zhf zl(7^2TFo-Yr@l2zID8VlNq7YYwI~Pc6RFwL@%3GR31D7&<_x|g#&ZjgomokclW#zE=DIFi_D0i098&m;D;^Hmf;IEZD?J#709b z&M+|3o%kp7{4U_Y%2pHu{Gn-*=+-p9sYB>Csnl-AmCFwdFd;-`G8CSUlA8cDVrIoJ zc(yRWqA-97#BS>@5m=VO+v|6O17lJQ?A1ULTH>(y9)tll0^Dc827t_$E;xFpW)5=j zLJR7Snd5N;D9%i)!cR{01=?=6Swyus^A9q72fA}oe>>A7A*%%*Sqr_j{d8CS&dI(? zumE|;6$(qD5q-vcen~z^qX%K16SjpVw{2*UY#Vs+hr$q)%?bj{f+TKLkZ?-pd;g&)Q7MP$vo_E*0ZnFM`5pnb|N_<`bDAoSsY3 z$4VvXo~DYIseAiYg)6`7bEu1cxFDqSRaus1%P43@!6!_rjM8MG7Yd;EKqbTWP5}jq zJ>Tjrh6h6Ir9r(PBvdaR{6Xieo$c}6ciNEc%ohMpeVg`^kdzRTGD?#&N@j}0v6_G< zXM*{eJ~2O&#o99+e6xn`1Ue!&_7&jBI7iaX>q)e#DS6&CgRL39%q46}X~Nkxw!U)6 zgTAH#3E_Mb2x0{JT0TeeFIZqewsXJ`hoT0@i4Ga!=SNPAu9I>CQ+!)0_V-8iZIR`@ zV&9G{zbvu{C}c~uzLMen7%s9(UQTkM<7FD{ln*k3TDu4p*St$~QoQF{7#NLHd}HLy zAaOaA)ETwFij%fxmuGju3v#(as-6K|o+XIfIhTYX(1Y>^kRFsj$Dd9HX9nWkNkkMQ zXU4my+w{BWOCpJ!P+h?5D`fOhy3If=Iq?Zmc?Qv*obV_&iOWRDWZCBycK6JUzxg<3V`B8~^bb()hTZZNkA#{R7mV4(S=WtWC*qX3TpTGn;pj`n8hu6O- zZLA%7p=!e8epR%*FBiKLo@!!+We!!)fj;TR!f_QQ}tD#j){8bD9z%lKz-w&QNF zjz4k;SVG@Fj8fbKKtv%xGK!*O7NYu+>BuqVMQI;av=z3Q4Mn>>&)x>tw=b{f*71v2=Ix;{%{ri8K_}UE2@kbE}OA|xwolHUfM>+pP>ggfGV_<0aJFLv8ZepX_Wq3HX-M>?MWnrHF zGu@v0AxH#Y(F%bnbLmB^t}N-BRUK2!%Q#P9FuKp&aDFa3P?3HM#m`CFWTi&`7|{zI z-c<%^xYEJA*t6L*ZfXGvTo_|#1VU15^~G-MVdx3Fiq@JL;DTsWk;Dz7NR*fQ z=TA1D7?5lUs2FHD40W7Ki3z!JH8dpR4s(V({~%S!@?-}lq$d;tqqut<%C1AgSK>V! zK|{*@cyKHWndTz`=E6}l$fUaDF8*pDOlGmmr^c=ffRda%RwlOOx^46dQB>rSTS*8<(SySiB%bA8^uHtjs*m!kD8yA(SC1)#EEL0|O2D!FJMJm{ah(UBKYsx`yiN7V zzGTZYhcOy!*x6p+U=m}@j%rL71(Nuk+ggb2ko$B)G(yXh@>Yg$eYK!#M`vIOsHNgSao5|Bi!Ho>)fj4_Zx&XmgywI9Ow*eJ8^f3YBcG^z|D?y`sYj7e|!X$ixcI=pT8c$N%`{FHZlO; z*?RJzAHp1zaYuL^7djBr*glSr+pzO`DNxKUd!!NX8|ypBUym&UlLTlI7}g>>LCM48 zloo+BkZGhL2(ol4e#bN8QRvkOJ1&oOQ$tYQPCn$VT`I@QGZm=t8%W|ci`ObRq5mur zslJl#eMGw>Bsxr1diJpjIlCP1-V#X?(^nX8h~kDOSr~~Pt4X*d;c^~3G)ZkFx>}QP zxa5*l4^8qTM8iI2HNx`d>Wu+-*DcH!(0;uz-cW+}Z#Ho-W&JhlmnvYUYR7J{{pnVHF; zP7XtzBsB}oC-XzQ=ZZ;VJ2r=XXm01ltP^AlNA&oKMOZv|M_ zep*c8b5fnSjq4Un9X!j%_ERDub@T;h`DY7NzW}0zwK#PSLuoSUS>>~ZU$?6~wzbRB z*AJ_#_bKvAa(066C4*hkq%VLq=8%KfrmUS=2D1DAA&^1l*@K64V#D5=r6Mw$I|HBh z1`uv0H#M?&&(EDIX(V%mQrwnx#Q&G-_W=ycp^(`@`-F%>I*%zX=V;RS(E@ zGE6(C{Uog$?Gv0~g;yb6L=gZJ9DxiTVE>mLsO(58FKc_}MM4*KVli(xJKNKA$Qs$_ z!#oxyNOkRP3Wh$^fqpp>?L7OZqqw0-Zb!5$DV_-gO{veV?7%UMa;1PC zS3q|wtj}FxeXd{@b#MW>3(Umra_NtOV$Zu`y2a8A^Si@eV8tq;J9w?zT_1vWDqgF_ ziAuT_co)^nx53+?hL+Kdv6ujPtrtqy^jlc@CNmz7^^I7X{xktwp!K#u>xr=i>P9}k zKnxTYXgvx)I7xbYJKdC z;)V#kj?4@0QbM+BHbTCQR{0yP@&#j+zZ*=w@)>Z-zcDun{rE;GpI9nCT+YtMOXhSl zq|uv9q(g`Knfw|mzcbp;Hxd0tqF1&b!^dr%9ARJx$PtEhrY|N5=D91y{yZyRPCS8B zSf98Hm_n7HrHilnT?U7ep$6+xw`cHLfK>|4uh^?C`>9}&Kp%SorTMQ;5$g9c z?150nQxazPkYtO&FcvQ;36?MR1N8*O8TnV?ell?^`hz*9{T0tN{WR0ZW4h@lo9KR* z(qArxc*XMtHUr9Q)g;T6ww}t>+BOt<8#i*lF0KJ9%1C`sio+QA3@(~R6njGkV-`n- zG&at&9?s>Rs!rV#Doa|Im*HaYW3C-=8?WP79`nSd_1o6;iK;r}o9_<@_tm(!GKllm5Cex6dEQ&aXG^<9E)lms>_;^<&OK z9x)V4N`#!W6td{Z)PgJY5DP!!BAg8+B4qLII}l9~@ra~vY?pzSm3MCES&%(eDkD(B z$@9&B9rY12?Ewa>D6-vd!Z;@)X8r<*1p|t4*Fd6}v9QU@P`#nAwjRf`5Z4IHidhhP z@U#7=o+>-v&%Pi_4J}xnY2>(y2fXMpv6lpZ7#$I*mJ6tXrlElMQA-grP4yn zOgYO;qA*Fr+i$@Q-2zudQufVj0J42tng0|blaOvj#56>{QTdl7Eiwn0`Y6>h@LGl^ zMPCY}s3nPSs-B8LQvd@I~>Ff>Vvnxl*kk@TVwh#hGDB3eJRwV&0P=+*=9B#&hrxX*O zk-5xCYYFYFufSQEa*+n-%)v>DJq-@6GXI0H29ku|0pm#C4Vg8Lr3}fSOG!rMEKDzU zOu$eUnv|g(q!jYa|1d%*Gtoj^_*R!A%2$*JYGfHF$yWa|Z*xEX-QY;pXxMhBZ%MC3&7GfhoCar}^xfn4+ zwDL1=Bb|aq(Ot^MQ1v;cX~@N;InKx}b>u zPp+`mTW?bZKmso43*?t+orm_BA zVz_Nrc~sS2s(807p311R4`U!pzLa*ZaNk{a(1|SuZ8);{CtLcm9<>o{*mgFe<+g@< zME#oU>MrJ?SH7}Fu}LvUUlU+6+Io$v6Z#es#2@YD19yvD2TN zR(6vZQZB8Z6K&6p(t2cM4{>bC=eXA4m`ch27G-V3)wbAn`x3llxD&>YL3M)b3h7e_ z(FdgK2z`tYhujIC56)aWY&AvoJ8HFuV>Rn{`>eA*>u#TQ53|MzLaDsbGyfdDF(mIu zbDb)&BR!Lk&h(iqP8YeKOvLu|v3#_rClbFC_;}AD{Pp=sCq(UrS@Z^uDAVW(r0VSr zF*o!4W?4D&>rnSeaN%q^X);sGRA`HZdi3rXU4$j%z(?M=R&mfN5!TOcVXrD@0?8-JwgUEo*L+8Rip zi_ZkHTeS+*vRgH7>xr}^ynrDG1ESl3`IAtP6QOQR&UPSs(qn-OUqUX3|1Zf*#p1W| z#G#9#vIBAJ-doUQWgyfN9*B@*q!b}XXejynL2fs$2|>N+e`MuKGKlQS+FYG$XvsI1 z(8i8JTVg)0rMBdc7sa|JT&VN#NAS)fmP`r%^z$wOe@6ad^A~1IICDOe|)`;4F{BR#lB9IF3Ju8}h6U_#ZZTkN$IuAcakL zEP7Bg33~cieP67epVWxe@0?%HRfhN-`|&rmI#z!aOGfoH;CzO#3F%*yq4g;VR|g4~ zkMAd#sppGDCpg~%HEuu>zT+fW{v4Nj_ykH>C8I`JeqfJV@*DF%_N&mGDl03adCKCb zs|WWiyZ(@U0Sn!-SJ%YCC#j#t)ZA3{mf7@j%jkPB)>v*kH$D|dO`jrE*AIc+5KM~%^Ng~&Z*=)-H z;4%?W5qmYi${7C}qYkcQX;&{u!x=_7_T0p?j8+~@%#anUa%dEl4CCO1VoPym&E0P9 zhB(qjWmN92%CHdpzq*xg^S#AwQ+@P{0F&tRzMYl`)#l430a+zavNnJ~3ABFvl zs3kWrb)zg)SIfqHwYZ6DVCSHrbuipfVlW zu`O1uj#`T?Z9PS;*gC~(>;Jyry6m-+VCg(F&oj^e{QHrdcfISot?S-O}d>*#_Nqu#+j8BsiZ3?XlstDs*G64b-pb7WU!8Dw0##;$%nfm(6YsS*XV^}=nH_-=^v>d|Z+5B@xjDGAY z+Iq@p$6Wr^5%yf>Si6wc1RZZ7jT&|#jo2=vZIcq(TeT55kuE{5Ub$KVz?G{dsIsLg zzT@G%gx1n@G{IV$j%iJkR~lPe!HU`}Ys;>voe_xh5?0qP(h}o%rp8)iu_Z;?6lOhx+#x*l@+8XD2w#s;5xp5E^fk~ajgKE@vS4)$ZB9C>Q&wzq~!trwzbW>Ywqon%w^#Ic)y zj9gxD+fCvA>JPovp^h*{p~0`l>1k#r8nMJ1Rp(3E8&z6qL3;lk@!Z{+$CX-n=&{yS z|5{W1Yg1*2`+v@@RL#p{f;nXDrib7fD{y&z_`PY8x%F^o#ti=7zEJkkBQd!^$os%+ zp7miFUPP?_I~Ngh6GI26nNq14yNgjO$L?a3`q`AjAXBF!{v$1nnb(|arm#-E2~&r> zNp=Mu;kL0nYzX7>3L29?&dC-eoD(K^K!`B)9V`X@54Hmf$rWzrp9voDPneqdKkMHt zNGautV_vzJhHfZ_RR{!_^fNJWyAJ zsnICK33LcP_;MYB3F!03IoXMXbHW4<2oa|48L2CWeeRa?`;Qaz+3F~+AlbCLAjCtz zj154uu(S(5scZicOS_G-SYm<)ED@&0oron~)iS1gMAgK^go%kT^&_mU+7Wf!(pgLQ z8fA%z2_A@vFx7V=miT#Z#diDZv?OglW;ZcuhIW(0OYBUx_}edCd+Jkn{BDjTn%G@HZ-ByK+6BrZlG zIoTv)OpLWUc}S!mxezC*!jq+sKdQX$#{>@)fiQJGiXfs=Z~H*8s-(0`@POz({G|St z;Yzz7X_SONBi3JQ&}fN{+(+k<9rBap|* z|2=!g4}WD1kDD}sia3Z^vc_&cC})4o+MDrB8yK&98|=UT0swD;Y|42CK2Rt8;d3y9 z9u;Ep*v-F>A_QzlV!m5m7`WJlFZ7+6`hQX!kdf#;D_un~`inW+W!`j6|eoB%)pTCo>Wg zW=85ZmQ*%oq_|1A8Hs{!MqVX9S&v()b)jbX^25$l&3q-Q2_Zf0UaW~R9)3=`*P%gp4WJXNBk zPv=$;MB$b&^*SC8+9*$zD5JhO6FeYJnEF1%ao<)YoUV)hpA10(mO`}u;y@+VGO;Eg zU-DxS?WEojeWP)iZ5~l9LA1eO&_%TkV zJPy%kf@$azrY^@H?O00uhA#0t+S=QLlsKE(IK&zgOv4&siuF%xuSLhrJw)QCHsJS%JXe7VQdf{$)}CC zb+f!9%~I%#GhxIDkECM|ZrEQ1c!KZUpiuu$9%=Y^#t`gy7&;W2ATlz{-iP6Gn5Q7J z-d=$jDvRswSZ&7Bm)DvwMwfnO$i_pZI#CwT>0WFETi5(K!k=JHEir={%_cML*@SOuA4TnLCh6cG-vF$OVc(U z8_ut^*~E|}9zEMchODM!Qb*R7IRkK7T8lfo%w8^ubD-sx!`ufH51pK5vi9d{Ijr0U;qhupt8>Q?P-M~n&8Txo7V*ZhO zDl{g?@aOU*KR=RvEx(nl!^h5<(Y={s0YROOps<9&y)IQp_)chcT9WUCW~V1d@@Il% zU1S=EH@Wh$XFTvlQR)oM{gPuheF#sX_OifuDmq|)g`1jfd!sc_h=J|B^zXDc?(VW# zN<6uwD;5e@pRys*^^1+i6206znGgx?m5~oGQ&d-iEQ0esaWf>=pF(sS5Y`EJ4VpqB zSj7o+nzjLrWM64wSCHx$Xx;5^3qoTLwyn*o^CLOIK0J6hoNrPi@Q1DS_xdnOqdURz z`tWSshi6M4E)C5&{P0nm--j8`z&?C0>hZ`;3}%h)fj8)(N_^P7FFLdX{b-=})ZjrMAOKXT2FuN^NKL-vhLBRq)gvml3=> z!d3uzm4RJ$zkK#Nd*iE92vKjd+ty^$44&Z1w%@UXd<{sy?ZeORKw;_{ znbzfOqT3iTD>P>*197kU=0Y@A;rm=Hd+HAmVIzTn`&{_WJ~EC7=lATS5&98?QlG&e ziCW(l>bu4^Y!KCkzTynY8(k=y?CZ)tf*lJ|)Y5b@IZVXSH>w9SW^%bT7$M1aLa~JZ zImBd%ZE$ONaYLHz13Sk!%w!P59wnUMmTyPAgCA-9lABWen?6K-(u9f(kstE^wId2O zv)75>I=G*Ye^K=lhsK~OFBNV)P$f`A@qZi7%YcY_7)Wd6;A*a1xLlxlf~EqM3CaU1 z6;udxiJW$Bu=>gCx~QrK()P9k%@A&f<9aic zY7%Zbo;X|~sB07kte|IrE*JC&29hrMb9juYb9dtZ&%r?)RTHo&pi$69AkBT%p{3X? z5tH0Y$62{vpe4dR1+*Tm6IH`cRq9qjzXz(9+*~ZjUnXceP@SOnfNl}FDOpzTY9KAQ z97xM8oS;;WXlw&ISJ2prwwIg+)B`S}P6z51v>ZrB`hEQ00yN6Sjlg`-y~3dl4jq_c zb6;_28$MggGi^j|2kH=X2ha*ZJAjr8+6mMqXcth6pxr<#1>FP0ejZWx0<{a;1Jo+$ zA)vURy+B=p9tG+Yv=8WdLHmJL2|56@Owdbb>i_F(R9$(tEoJ*T`u~j^Re!y}qI`64 zo=v0b1|Z%WMAZ{OhhZhED$&(-?re1ML&E(L-CE0?n`i5J8qhDr?+l=q1^uBwDc<}< z)i=>`;SlIyAl*;*7b^9faLFPoHv^w1;ba|EF90EIpeQ<;Ml*rXLBTZx{ajFwkzB z-=QV7miwqf<>=Ph-UAM8TWq-(fj}dIlN)S*o&r=S+>Jn5cLxUQ8sQ!U(&ha@lSLCz zjenKgC$6$`FD|jUTd%>aCo!LStwrxHwYjIGi)eeFLxhVg<#b}ejq$+19uci_q9Pay*`l!(NJo`+yHa-x z_Y#mU(dbWDzp3rW65Y+8wDuN$%5sPAuru(&J1zG;AYJ#X?!pK1ME7fOpd-B>2*wd9 z|0mWT7xV|bkca9=U47vTwzq#7g?L-IQD3zqnC-;6`sb7fhqd+eT+6M#ySl$ox zgrEaJj|+Md=mkLsfgTg|4AAp}o(Dp8LH8w~{}6Nt=p{jif%Xe}73da09p6yuXMz$y zPYX%{{Y21Opq~m_4|GsaAJ9{RHUXiT;BAXT+Z@^sbURBZ~(Ux=(B=$0b!tl+YR(( zLH7V*!T^_n;$YwcjRM*xC=+P2pm9JL>d4Ikx=qkzppOa42HGkp2WX3+T%a2T{Tk?U zps1RR%KN#X7NAB!`%%fm1dTw&>(PBO(4W9X)C8bE3Tg+!2_IH=I`mVA($Rc6w;WBc z(Q1dTLdVeDEOZu)jyN#A3(EPP;v4pez6t1EK`lUk5wsfU9YLRTxqBSS+=rTw`L7Yv(Jqnu1SXR6 z1l3zdZ+}H7bE%PAI zBv^^4M}YV$Y6K7Lt;U%@wsN^Zyr+q%B|lN>6hTXY#tLc$;=NBqwE^*eHW*PIKqm=G z0CBxLqLM%p1g!<)LOR9=&}cz@K%)e00vahO3)3aPw-r&79m)pc;tEEnL%A+@szZ4| zT$+!lLWg>Rbjfc5;v#uOZ35zZK@s(1AYE5~b0`<3*sEf_k2{ zkv;>&74L|89;jH*OF%_}4gt*&bQp;1?Gbg=bM^{v3(#c})u(~#1P#ZjuU=3wkj|Y4 zq;p^R58Ee~ylBtK?Z2?x&t68!MfaCLx@>3Q!dsW)T%b;gpyrVEu^veK*bJn7T=^@T zdpnTM-2tR?zwuk#YrslWz35Q(@2rpWfMVj~JC1t{=o;Y;04))835NT4MJov)&_F)` zdRx$h*RT^n(78am9G?Kve&2ip_e^5tPeAR0jsYzf^d8U(L7Yfh1x114f-->S3mWB6 zrbFX^mP&3GP_v-PK+6PW1GNasaVXd2PIV{`Nc$*ssKlY!4wX7o;ZT)B)j+GnTOCk` zpa!6of|`J?6SM@VPS8@I%LKIo)d*?>suk1$#HScIUji)Z zRl@BDx?0cype8|20$nNSAP}F%N7OSwR|t9@s9w-ZK#hV90W}CZ48-Rk5%nrirJ#~G z?WkA|q({Z|KzdYs2}qB!uL0dC8k3IV9vdjC{^(G~Tb65Z=uwAqacb5Ya~#?Rbc5L2 z4zy0t9YAXY?EqRWXeUswpj|*oLA!x^1lyM%9lT z8ik>#xgP^*jl)1%w!Kds1N8Pf>2boE}eh%!B(=z)#EL~3>84N zcSw*pJtM%+edSJ8wv0$p3LXH_;2@c6~rUxEtpXRu?TYovGCP`G94NR z#3*pBi@#S3n(RKe;kM(iLR;W2#GxHP>B8*<;uUE`u3t6U4Q_~V_W%tObgx5u zfQAeA5D>>H?)4pd6zFu}_5qzEXum@TfX)-{NuXRo2OW9_h$8@3KtLA?ddZH{$m{lEm4T$>^B626dE3b&$sc3WzxzmMv4`{X^)`><@pt-_vEOHGF_gW6|>b6Wc zUW3jPl;sf1Um;vJ{_?s4SF;YWgx3o<6@S+YVw4*3D(+_CO7NF+Uqm9(s1)f9!qGnG zuZWy?HR2g_lW=LcOh5T7H1TO^>a=C}otTd6|4Y)-P?!wMKW_OcDs56a?i4@W0o17zl`TrPYyR5r<`T@dH9t$ z&sS-<9U1>6q*)Hi^OtGb$8QuZHbSLkUXR~2_14i5Dm|0`Yr0WL5hpO$5zkdaPF1Qe z9b(?m(bdx25pVBY-WBUfcK5aI%o{Zw(fXyYv9%fGB}TDq>LHH=DZKExoTMpixxH*B7?GxF!nA` zk&{QC8d1ZM#`R#ASU|m!8woB$83W*0r>M~MQ6fuu{$BxulKlNTP0LI`$F|!T*kN0Z zLH)w68jCdRmvzctxKf$mSf?lTlVuz9mp#SEj&rh+QxmX4xpQ#aUodFhwREjYw0Fc~ ztVv z7^+fjYgQRwOxLN-=2h`nvUypD^TjdMBz#Y7c~@^|tC1(aM9arJlillLJ?%HxxS6+9 zxzgw?Q(oq^s%72HEijf;QU~PP)bjSu=8l-l@#H(ys^+z^j;^ki%i?YA2*Jz4_q4ha zv1QFIE4$;%O>DiemsEy}t!hqqF|Sq4Jw0($c56J5YzzFaSMjy1NQBUpNVa!%_5^u- zLEiF?<`u5(822XC9lt)dy19ED)I2|1R9kavthuEHZv1$+sg|~Q%SyjAt`4@V&JK1C zU;Yko9dX^hXP_N-AkBRC>B$(F+2HK4OZlT_urb70JQ%P1A}>eLS+K#eeKvme{GFB= zksLk$o@4lvF+Y%}-nrm79ymv6I}vrBv6JiUq-U~EYMbeq>|@5h#6dmLhaJW-)#zX3 zbkZ_Uk{rgNW2e1fu1`~WMkn9XVY_f{u=5#pIHv`A>8jA^&G7X6xue+d{@5?Y*tc~+ zoBYSV7TArbS>RZgA2RyBJY(oDKgY<=HS+YAfKApd&ap@BIgh?rF8M{h5eI&Us4`<` zp0UFilBT}TLfs96{DsKN!ar+^Hsqga2Vz`Vs!C()Qe$g8^m)E#`&k{@3H(P@mC;#X zbo{!f4rS?==aPj+w%W*A`^>ko^|xPRbZU*x;Bz`=kIt61SW8=Td#7sjQ+7_j%;>Xz zES_f0y^E2DtHoZ-12Uhoycu{3+1-sPjx!T%+p(99f;5Ocb$I^uy$$Z0_WkoL%X$I+ z1@)M&u0WcxH5pl+>sWvGTz8e>rww`z?QLm|b;nz}x?5FafOXl^GM7Nt+PTKqnPc`UGHq^>oGeff;iJvkC9FGljZzE z|Gw;MBfG}P+Pdq79OdOVq!U%^jLr@HbR-tWZ~oB_InGw=jm}L*$F{AF-~QS`oKlS|K>?qOaZ*>jY=<|{Je;$z6e zx;icnbpPi$B13idu3Cmk!d!=t8=-hT+(d*IviJ)}$YQJg^M5zHA)? zZ8}7K9Qhm%pD=p{C3J5TXE&40G9={k?7PZ|AB8-3f)eV;+wM%0}~{w^c$w=H$* z@sGB{bw5PyFnXUcdb4mY84Wqg@_gjRqTy^=ZU3TO+6<4=(dwVTvHUyntLN0<8hsSX z&-%!QO_m$Kl4d(G4V9zQ5XT5$+6~2F`n6x4uNsiI(noevxYQ5}4W12U!naGy3&u`rd?b;0Z(XiuRV6>8&z< zlaDI7Sa<0R^iO@stM3?He9jND<@O|ta z!=H}6iEgOwLt4fI65k@m@BR2?|M@z8l^UuZz%Ok+h+jJn63Agc$6AT>dz&89FAZ~{ z{Ner57^iL?aq|L{g8qx=+Q$EPo&StX-S>iP^Y59w|E{tBFUIFSW7qHh_8h=^W1OsO zw!#xeXTQug)+gV*;E^>5I>FA_O9omV`nvc5h~9VJd9&eu4dxIp6w z@pO%`qq4rfP~#!QGc+DbT%<9szU%9YHO?R|(ReuVOpQkn=jSQ<9Vs|p@F>9rf=3IU zE_jUKLcwDN&k&p`xJd9xf{O*8EVxAQDS~GT9!FfD{hlgV`yDS>`#nvt_M0VG`<)EUL;uiohDfOy;!jJn-ccx(Nca~u7_d|lU-`T`P+V32}+V5P!+V3TT zwck>~+HaX)?RTDF?YCU8_FExX`>hnL{a#93to_axto>FA)_xZV)_y-MSo>WlSo^IO zto<$`F0XB@Y2dkj*r_#`zd0xT5aV}tZzmVJS}#gAub8W@C=8`>O8xdoJHBh{VwE)& zJjd!Wj`ZSMmrhrbUS#tllCErkjN_u@YHAx|SJc*5#O5KOin97E^*A2Fyg~S(R;OaY z`~`@gzK4Lxx@JPxKWfXtGUva zX|$xPt4UF3jLDyOWkaQv8Efp<)z{WpE|Z)P+Sf@&uclg;=VYT3s|sR2g`AfjXJsxA zWKJdLrN=W}+0@Wjvq0iIP13a$HKvSNCT-)Iz;yY7`f`&$(WV#axF#`OQCnSY@+aH0 z$)6(fK^>lM(+jlz8BC+St-oxOUSRB<$@Jm|*9K=Xy=Xy=P^O=qO|GuGak0_KF)~6K znRCcp)>vu#(z!-PQ@YO2BiC5hP;2bu8X2LCo%6|6HkFl|es%%Vb+wEAcrG-Y?|-V{ ze18`i&bL2}9F3X!xtM8FURx)5qKEPtnS3Kde^#b|oH*0%Jl)6`O8RplIXX9XW*8Yw z={hMQC*{?4ikUX$wZ2LW=lh>&IN#qa!}<0PUi-4LR0P% z!};}G8pvtdv}Kv${raC5$O=uH<%ZMEuIr`3aJK0wR~c|Fo=XERU=J3m#1)6K8_ zEHIqw0w(qkTYaz17Y4GrDU58j;r+H)6v!G{`>Qd$-$u28tfr0KI>VdpA${sH!?`YE zWa|Sy6x-r}55>_C@FAa#}t zmE|C-X>H?b%S+2?Zi(d}E3~nDjpe;L<66tv&SPX_9`DDt)Z_g)nmyk4xr}^yz0?r< zWs6SR+L5xgYEIlxChlZ}5}Dx8Q=TfA7$ z{VSQSDHnqI9ZWX`=~YbES6*t*4V@-!=bbK{E^n+~?EEIkm6ugl*EYIy%Jt;Rs$II9 z>4lXp-DA@Ai^`g;ucYG^)L5?9a%eZpttMArd3mK5!y0lZWo3PXoMYDpX*t!gtm^`9 zURn7QMfbJ!HjT=&aoj|1UVWKO-)zzhmHuvFx|{;qMxRZ4W!WHH zEiT}+%&kl>4sCUVY)^L$=}L!eUSe# z$rnQMZ)3V5=oj0VMwnMs*4Ntd-)=Z`dZAedA2%E#bKED$Eh?*DXkyvUbX|R8O{I?Y zlP(=AtDmpAPmx=^a6z5X`Ls=oh%VC|KtFEk>-%y3v zd7b|`bDjV1Cvct5bpyMfgX;lj;r@W@0a;l0xM0xdE4X2(E{`p!P>mMx*$Q=k3V+ni zfo{E7JLbL=*~@{wE^J3xw*r@;*67U|h?yMMbuzgw6Xo)4;v0*^( z*a)XtFRb668yjCT>yo?&Q~k=S*Cb($n;a6&E9^c3@)_7)0luT7IT??&BxLRHCt?$P zTXSbCs+M(l5L^yr+gm05G}2X~3&j;(-Ro>!(`FiNcC@ebo@tFrTeU2PM}62Xu-3Mf zvWCtFtnI;O_Ez9I%jWx(NZB6}blfSB~b3p#Hh%r~^OU#tdOOyQ}`GIiI zZ%Ry_jgM4MkMjv|~dG=VE zHu!!hjDSJ+PqE#9fVSrN$C}vU@>rS71y~aUo-Y_zmcaTPfi*GUdBS5&40xGftcd|v z2*#QiaI0Xfi2>_#0M^8SdxXcD81NN>u_gw*MljaIfNKO}O$@lTmwR3qAJ)Z?E|)y4 ziviaO#=01ALNM0Ffa?WgT@1KNFxJI@+XQ1>4ES=vSQi6cEg0)!z)ga&E(Uy+V62M) z-yj(4V!-;|9qVGimkEz`G2j(~u`UL@QZUxVfGZl=wk!kI#*l99wP~!6A-&k;V~q^y z9+!`GGNi9?`B*DMdX3A+dKuFCT*dhmbDFH1ynsFtnqCH3H{o2vJy)Cu?OL-&xRAR@)jF&nocjb>2#g$wCRXWciD7Qr)9mKbudKI)v_;!>7hEk%E}MZX{XO; z(}`Gh(&i7>X;%j$B)!PRH&Ul%4yXN5I_=^cE$JHBm&E)rI_=^atJBVZrljkf{gZUs z>7T6A&fh6I?doToPPg0mPt|E>f4ok+`Z-O~i=DqLonC46C+M`RuZcSC>`jvNRjxdf zbz0^ZmUoIyi$C_6(@mdw`2_pSbkk?hZRC8#{e0|0HeK8=ZTl3T^9_EUULEhot~>7Q zvq+zh(lQUj7N5zmul~l^?SLKoyjP!}xZ}#q@dyI@9o$^Xd_FIWHFvLI{n38}<^3IO z*<+NlUc>(BbByuX0H2rRI)U|P#)FJ+Jr=43>v6D1upR??9@G6_&sDnb>-kXk`>XIZ zl3}Of8L*7o-^1UDj9VMmg@|jexqjjE5xj{~-Q2mNmuF?UegTuN)|7Mi9!{$6IbD=o zYrKwfwoYF6>SQRMu^sQ)>0(nScyB`5#kMbKNnc~~;ri%2Gl!)2z5o8=vRGM1hrUKk zQ%qrN->PLDJlC^cqvXmvu;EY3WJ?-b`((>;mpprv`p<-1MZ6=v0@n&gH!`8Qrce> zPquaG^IE#3yIOm3JtHw?AU`l9I(?L>>&9jRY{;>;v%%HJlfB)Ymp6Cxx;Z0*vWxZJ zYT8ThQ+;3>+S+@he_&so^pCetx8Tc?$?gVpX*^xMqA--kz+u0&V-n9n<+?5cJ^Q@T z_MLSjb$jtyA;)i?X+N9K_VaCFAd0OK#@681nVhS+|H$l1#l9v#ZO8Syuwlpbd&WQg z%?kBp+23lOBAe?f2&JoFe-rzBRIQe(WIP<(e}g@H=rQ)e@vw|`PQ$wzQf6BxhmbDi zHqB}6tzE0XuHMJ%AQ3gK6}z^QtK;;NhJTSXJrCgx`A<#kCX06~TI0)lSL7@vPRGAU zS`;sM4CVCUj%nR;EiP$hMA8nS!FZgxd&C}%;yo?R+@m{|q-SboT9RAC^uc#iB5AMV-NYzbc*2ji z%`qAH;X6k>hNx_e-f4-TYvRfnT6M_BHGwKUb4v^5^fAY1iHw@IHqhdJUW{%dckSY@ z-(etr_+Bgzkx@C-HTi`|-3OKt4kc5>{JVXI!&KgTax&Oqpx>emnCW27^|hwwgW>nq zr0lee=k(~AjzL1+VC63lWZ>Z2Quas}tpbzOzL>ZZGJRr)HO6B%7+mwA1ngrx9sz?l zGJ=vaK%=GQ@bwqS91PjvJCIo8@$4J}lj-cxMy7U2XuPwO_Rz3+0P|rmtH#-SrgS@) z4~Lk|1GGLpfcc_hY}p?i!2Ig~=0(RaX0|&9iYdFTjkh3EIzjhCU5DxT$w8z+txf>L z`qBM|rN{@fC!{qG3|l(Tx(ZA-n4s4oq1NGM!1W(#>JUR;qJkc zkTU1_%nUO8lAIemGwAC{#~`74P^*bED3fja{01^jf4^Ib4J69;yl0>c_{EjW{@Jv+Qo3D5!ZTMNrRVVqiAhVJ(wc4d$LtS%%}i0G2-&VmKXdbquxchSv3;@U;rz{c6Xc z|Fo=1P?87x4=op?f+pQ&wV3k&>;#O+z|Q)QSs5}V(28sgF{svGZt)p5&kLJF478Sn z8E9oYhTiwXyFN^W1=y&iZo0*@Q&0%YSB4ohd`*}^6TW=2r&Y{&_|2)HbvO*}^_hZV zlyufwtHn58Ks>`7gR&QtKN~#gR*}$%%CHFD$Eq2>|q8S zu`SFX=EY$Ky=88QVM)&qGl+Rym_f|%V`)B^MQ0-B--j8*{A`#(%=^Mj5$YlsOLK`@fmC_RHuX)v{zzoNCq{3Y>v+qA)edA z3@m4b7;NHGdvJ0JN>Pk*E%%w?nef%&+KaPIVx34@j^h`?DcVtaLm z8Kiy%f1V6#Y;%}F9~%{7SQ~Tk&uJCUM7j8_Lo&Dns;()XiCTTlF$`@fGv#1}JbJ+N z$sBIa)SJLGASXD(?gWE^m@_Q39tN}hKKim+{|06$assVGU`oO0^D=iH~?C%|}J3xX-ZDDSUYwmQ6pLj-so3zwI&XQ0lgaJ%-J$ z&VA5lXeZ(`JQb)J_j@uW=m_d8pUKaM5Wgx%?^5$}1-sKRSf7ev{YSkijIFUelyogL zg0f!%SO+Gkv07$+-+BjD%gD%KTX2nIlxfqg1DHDpF#KL~saUr0dRu!1Gkk(Q#_aE@fo&a-5 z80-C`VD1Uo`7)SFF!?@H#Qw}L;ptw7gnA5RfA>khTrAjcLktV{ zgwGT)Xnw!X_1+?S-{Ke~)C;g&D!y#Z9|iLea)Ndro1yzNGR!ET=JMHF%8}i3S%Rj17;s`f(RFb=>wx91W?z3se6hM zTCJPFpn5#5yTNP;X*~d@?`OW&6JVYXX}t($dr0d~VDg^!wIX=euZ!>l*NwQ|7lyIX;;d0?J*TC7zT zBk!I5_4BUJNd3I-GjertUx;C2>i9()f-o;THDABusA z0M<42BpmJGx~4UOxZvJpJ<0YYzJcK^CaRq#_Sjh4)x8cjHFpNsi^S>G1$uRXUY(~` z*91LXq#iGVcz1VKcZ`o%dX#zpIfm~9waRCL__A@1JV?nIJg>KN4P*z;jKvn<<>>f4 ze!{|PV@Ij0U3u3U8xQ51RMw4t13O@igMM^4SunUV=s~p$Tr|P=GlH^{!?&VV#KU4j z<*S@J>^Y8Amep5Z8N=Iewe{G?)zDa9Q;<`Vk2~1oWixlCGEpz@j>j!t)!c!7sxBb3 zJgNuxUyi|J^7htPZ*sX~Ak&G}LkPuMN*vo7U*6o?kzQAwt@!Grh@wO zl3w1vHjcfY919`+5bqoCGwf%Qy5lS2Ypr@e(&&a+n=;>mF}<%p+fUUBb0>6VMNV-Z zPOv$(HI*^Gc9&B;9Vg(Nnp$kuuQp5`R<(1g%4#aGxfwh0D(fq;S3ak>7%Pf7HI0kr zfvAYhudi*a139Az#;`HFUX){Hmo@;(y9~(0LU&+@?-eYltpSbYOH0FEW&HxYU;s~n z0B+55YRVSD4gANXBgtC{&@F&T>{VZY_$dJpqPvWFEP|L z;{C`4HS?uxCaVN}*U4cu8r9L@Y6p4MtSzI&O2gY~m8iJ_ysMg1UR7DXFeWc$T)L{UtEHAH(%R`8t^8Y)=Z2ddjm)A$A&ZX@BJB6cylsjja*1&cLzRn@pOMj1>dp zRG2Fti{Q5sO;L5pdu+sm<(Rk!$&$gFXvPUg=X82m)W0OfG>wl4a!gT`yVJZH|b>pGLz>28ZH9W0zo! z`eZOGnjgf5WHh&4*Nf6&(^GFZPQWIL{;bjNM@zf+(+qP)FGM!?CcE&#DxA=Ilk%Co z4s6hKgsldg?!&w-K>rMmHu(rv3oamH_%ax_JsKl}W*Iw!<>}g#_)w)i@t&S`JiWCM zN$n5Fv|$aJs}1rqDzOAM3x-X3bjV1+yJ-OX>{ejEBR~Cxxr-k^>*|iTT5}=FnDRMb l`KqN%xTZ8=E>H>trOjky=+899Tjg^wM*n!Z#?o=J|1SxpX43!w literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_config.obj b/3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_config.obj new file mode 100644 index 0000000000000000000000000000000000000000..b280704b376cc6bdcfd28adf06677a1e5ac530ec GIT binary patch literal 7534 zcmbtZ4RBP|6+Uk_gmnpIgG8euK0*XUcF7NhfQliTghY}MlMP|Y;`;LTWwWqF21lp1Rq5FAZjA-1j#711gw1 z``$U{yXT&J?>YCrJ?}pM)``^k!L^;+E+(2qMsfM$nyRNXQ=~Ou=1XbGq;?0n{90c! zP|=;PIXIc zCNg#2hk|`-EUcI3qNsAWd-A}QZH*nv+MBuoH?8hm+2vUhQ{!4ytxt_c z`hx+PT{418#n_uj5)*bW@%putcbys%S0b8>tD1K(81Y936W(awIxpK`pmw2P$IQ7< zNlWOO5=@W&OzgL4N*bf>K{XytMEiAlZr2s^%9tJu2R8*H0off5$ATd(PVZT+Eg^N# zPv>TtjtgNk*ooqPmS$!ZF_s5jDzR~a|yVP0ds;PpJ zj+MS{PgkqkbF~lbDtFt}zAjH&V_O^Qx_de~jJ_UEGc0CAcW0J#eX9pj%d%BXKKIIw z=GNuD77Qn`SQOdW9L*XChxr^sEIZp_zqS0Fo!;8vZtH1mD*v9w-Hj^}V-ZL#a#eZ9 z+t3>bp;M1rcCMyGTqT#woA>+Hc;u~cH^uyY=d?V%DYdGy63>o4bFbZi$4d=4%!dm= z6n^C3DJJM8nMYL4W~J#g)lnzZPrEfpXkL_UvX~~M#fr9$sv61zs`G)We4vu1k5m zFr)e4K{UjEZUbdkc7nP=ZvbrvRX|sR;y-9;E$BMX0ni9&7&H#L0W<}= z2^81RU7)vtZUfy6`Vi>tpgTeD27Mg#9?&O1cYy8#y$^Ih=>4ECfj$8G3h2Y2Z-Jui z&_U2gK#zd_9P}N~$3Wi)-2?h>&?iAZ27MazBUfC9WwUUnm$^?@I(XX;enGlF6_WimFOT3r6~*zJwl6 zsyeLMN~%#4(+AMTAMR7R7GboN%!H{ybwG*xbSi@Ef?Au~*V>41*h=O@GTLN}nl>G% zu0plXs6lf!7ej(XX&Pjn7iO?b*W(@~9?*0we_P2cbjm|Uqhg5Mr>+EyZh5TJ z0hnWjbum`7;I(la{=$zO(oN2H_pc3Z9646B^_zDNZ9_1Y3;d0t&AspJ{@qt^?W#&H z?kfKcdJ_0;Z_j&X^SjUXmJZXGmk0M9BYIxoj@Rm*zP|Ou&8x0_`Ke#lK0Jr$Gedt> z?7d>)6T0hXzNuCLN@2x5Q?78PYhw>(YAGECgW`;HHi5{0m z_x?nGljsiuAAYHFQ~gKfN1xdKb!>k#osa)w+ejc?E2PYd#{_i zcI!~#-yD?{MEeE)^?wepd!g{e;nc3RYl~<6^8=z!1irVoZ{{=C-8Q9T$DxS@NB(z$ zs1`YeLt69Gqi*Nn>Tiz!{mv76Yu`hPmK6AlFOS|aWAKhI9t!W=J$>)tUlSb?_|kiC ze0a(jnb3SnBoV|QcH{YJ$K!1hJ!*1x`YX5@0y|=Ic6tvS=R}j}UnXa#li;Qc>=ToN zB|IxH5m3GH#s}S!Qn3s{iaOLPPc=bDzL34XQv0iaoRhHcAA`>4udoN!cTwZ>{N_= zVxrJH-{kB_BZ*qJc`6*++A3@*@_)>t8Lxurs$RD9QKT(3fI*)bU`ZNFnP zlNReAM~}Bax8-#f>9=2xj*fn`hieQFf6MgI&+_D!t7vK2CJp<|wmjP5 z-Yo0G*9&307{NB%@YUIhE>jrVxtoS(W((6yfyXjDQ4Dd|QgfhX%b)6A<&Mv#%!Tr0 zxC&?i?!3CJ^kdx11hyA<_H2R3t9YGR>2ut9HCX8@+&SJ@WEcuZ*-8cAIJQ=@f#c{| zsR$geJuCkCjVN1b8aQ4*Rw@I>YtKs4!STAak_?VlAuOYC?w>9)81#a>!P&qe5dz;4wPBV469oytS z3eg8!WZR5!xzN-vGj-DA;CS*&YbLf9y4ciB$6*RtOUt3hW58}2nRn*6q+e-z(l0lN zzzDaU0ejrG0&Tm@81Q;Zzq|1o1;)u2qWe&IESql-2r5=e4X#eM-| zp+PtA3&gOc%h2d3pJIeUG{UkZ&NLDU zE!-F4*fUnZm^-8-5{8Z}WTd|02qqe5f3Y4ppx3B{v;fwQ+1A0jO^C87lZEA!#`{~e zksvn*wUFPG>me`KB3eACW)6o;`vs_L<#&>PMa3HA_Sq*(EL*t0_NYIJ^)2k@o-&Cx zL#%_d`k02Z@ASB2U|pJ?j7L@}p`@0clZ|z|jk6|Ue~5;Fcm{$Aa?!+6Y;4}w>Hl8l)BjcVDn35Ag8pb~FO80JR*?M}iqij7h!1o)2jQ~)jq^B7GD{j2I+Xn}ifgPA=Q6ygMt7aW@m{)c#>Axny;>;y z(-dbFR;h^ZxXJ=6j)9nErb&ekWq+u`HbyJXjkpXX%l=_-e6KZGp+h)Mu4aJGBYA{{ zjMOl~CzfN#LPq#Za}2qPk^R|-F#JR|vWRtdW+Qcs@Y$+ihov^YiNbS7?~7U3glnv? zs!B-V9Ha^opXp|FcpB|F2v37M%;>Q6sfn;ZaeO51#!d8ICAtS-v@+L*hc!48wo3eA yFSkS?<{h)0s(@c1_+o)fCvFm(GZdV!H~q{hDBK}1`uR% zueeoQTCLjFx*%Fx!Mfm%RqJliuePM9#ab&?TmJ9QnKN@I_a+df*#2Jsc`5JbJZFE- zGUuF`J1JRypfmF0Q}S;=Kgqe@aj!ll)uqLeIi=R=oQH5?lIOAvr8<2|N~hJ%=sv;o z`Fo+`tR&pRB3E-ia+Z@iyiavWQN-%xLsrg()m|)@Sx$adpGfJvNI+fkYsY!H#&Pg3K8iq?nKf#7UG?xkI)}z4J9pgB~ z3E@(Qr=_Kxls$6Pu!(sEdAY++KDxYYT5;9v$k7e8c#RlS5T_iMmpyjan2{4ukDQ!8 zZhXPXRmIh%=>rQ(rWX~K&MPfWYf0{(^M6?j$2r|eYOlhKIC)A*>6|IEip$OaHI=p1 z#idi`mQ|Eg&aIhJIc?Syr6R?^3?l{-?1Q&+vNND)#O_vsUQr}aK(P+IS~B^iAOW~TL4!k%p-Gs~(=s*0*3^Idz&sJ%1$^iL;| zvEvFS6pYUuQ81(sangvqA%)`$^0M>t@S89(Urkv!v0xM_#+)Pa1Fkc23vlHOn>4a; z#JI7ea!)VJp*S^z&6U=BRArzbYUuCW$Z5UDkVEd#-`VWBV@Kpo%pQ64ULsG(9$n+N z!JI*T(x>ce#3?h%$+TcZTJOnDO?9!;r_YqQ|C(%(gkCvq#N+TJr;F3R{Wg3j zlEAp6qUss7vr8)?h1I1_XMDEfQ)GOY_o|Bu&1}^HkDYjoG9ERx(`GRjJBOg%g;vw! zxTNyZiW!la&Y>usWKUTWp$8XMPM=;=8gZ0Litkm)@UE<=G1^pVnIXp|xj}18A-lxF zngog~Ybzp7CsIlC!)vhBR23DMnsj>lG3M5|p*s?~gI~s?isG4-)ukmSkyKwjy{x(> zQeIY3>V#E9^pj0RF-aKRz<2!o4kqF;Wk;>b6Q!%wa{yLxM`az*pjFj zw>IKqj9P_9nn`PRQKWcg;k5F~;tPz=Onlq|lvb1!dW|e|m*C?zvT09aDK+L)Utdu= z*J!(W+t?t#fv0C%%-F&o2EQc8ku)=xEZ&8d zs6`%^G`+lNMh!jhfCj5AlO$`KeYlDDwG)*y#pS)p7{t+Nr9_Bq_TF|970f5hL2l zBy9fC+@y~BbN-K5eNI~^s`)Ax_JX5fCL9a1;h9ivJ|3#uOn_5i0h|RVLKR~YTm;X8 zE8rA(8$2I=2n*pq;8Yl*=tWQqvzhQzI15(83*hCj3f=;1;CnCv{|x8D-S8q9rjspz z>THYPNpLYd1xDeSa0x7fm%zEO4laR9;pK1{yb~^m55Y^}i*Pmk6I=s#!?iG#=D!M_ z0oTE+;LY$2_+z*O-U7dc>)}D%A8v(Oq}>Jw!aLy^@MrLRcsE=DAB4x#CL3UX_%J*L zZiJ`9N8y?9*YI5U7%YXqft7F*oCBYLm%%6DmGEh}9&UlR!RO$w;Pdd;@J09>d0ToSQbiM`;h3`U*)<44Y;WjuEeh91KN3afl46lXT;j3^5Y?O>?278)ifLq%#uI=bY2w3YZIbwsV{_;J@Gmn06532KIty!_(loum(Lzl zz^U*dSPGwlGvIbO3;qMnhS}UiD&cr|A&kOmxC}<%WpECBlc{?y+ySGo5A)U%I22w2 zhrvr>9$X1EudRYJ;2O9XUJf_FE8&yy2Dk;@2%m$u!Z+Yu@E~Tf``~E!D>xBuf|>-M zfDglG;EV8C_yK$#YW8~(cIrTXg=68%Fdx1G$HP})5qurq2LAx>fbYVM@I$x-{sq1T zcffl14>+cy<9q{WL+2pkcXFI0cpq#5AB6|N?XWfc2kZ!^Ft2ukvtSok2@iu>10D`P zC%Me7jx)#!`!`8c&TF^3Yen%?+QMFC6_L{FilTCVlV?_o+iN`k24uC^&S@J=_6Kuz zby|7(b{{)(azWv+5e2#IS0)q;D;UYLEasaxHnZQr1Px2)xG)(Bn*IrzehHfNcujgj zUg`094H}#o7i-Yq_>>1_#-}rA(BSx3gA!s5926gBV0@#pc zd|M10kdXU;gjx)Ux5mJXguMDE#Ojw&i@x!(1|(Q)z@YfH7%(Wl?gIwK*L}digp?Ed z&wzpPbsvym`2hptYcU|9*9{mL-|hnvtU4eggGGC6@%9+dFQL>4BWyt5 ze$1h+cYDy zZ(Ob7ZJLoVM`X~V4K0yS16nxI>Io?ih|fE|%`-9*>ePQ=T;2&5?w_FPmymNp>t>`U zStAu$bBR!#A(&NWSM&E=wB#gd{zVYqSe{h0^mP)i~d>Q*E%uoFjX4(D;Gid(= z3-#|CKSui{l&IgJgfI!Czh6Rm`VEM0jeZ&NE!Hn1-md);X0?6^cZPob;%(nAJ>K^H z5-i;>p{D5xV>CTsjHYMCmoT07X?XunPng5f6Yc})3HQl#W~{h$`p1vs^nUT}o}SQx z>Gbh%V7_9_60cxJZ5X2e;5Y?6UVHPMtkpWRpc|JoyM)CXr%ou`^97D5YYN>nH*v-}vJgojRr9%YP)6a8#EnFE&?khjM-d_wXceDCdWdJCyTdc!zR2IPB|dtIJF0 zl$K*=_pHo4=$c+!>>fu_Hn;SFYUzM$8y?+_6*zlRog<|+&XIWN48rr67bz?%j+Ale zVgi^G%dPmkc@#(HR}o34KU+{zAnK~r+&Za1oBY7#6iCN;8_~E0(m9T?@?og&^VM!S zy(2Frau|t=j4uN@pAEi;*Dg*|xD+~e%xklYrTZg-9K|^bm-?B>?}jWiS{`-xR^W~!l(kH+m%{`91=Y|_;!q@B8S9IN?C=a+72jOD#Y z3+gjNeJ_p5IYs4+2^|sZbkvRFb-VWMGh(`;no^zz)-)(}C)#>-cT;N3HBS-dVEKwp1FjG)fHRE14mU(^}<3=Z(BVR-G^i%!lS0qMXv8U)? z;<q~70~%d)xpNNm;l2@ znKYE&eX;Ove(@F_Nr2OHOn9aLpdY>w>s*Ux=QI4U8}}6UaxB?D&xBP&Y$9x2Lp-*p z=sWRzR1=*$Yi-3DXUQ#o^d>BM{CE>xmV7rB*0>EE8wRPxci32JRGXr~1*UYP=

4P;FygOG>_KoMFg=cqsy+uSti7A@YX#sUfDUZOlOpV>P zj-vL(ZuTl_RXUGAO+|{QB^31=N;!9}DXLm&6Jgy9-IYvy%`}|nUT%WRcyAIs!FbAZ ztDg?$(L?(!en`*8jg7UtSQlS&rEj?P!x|dLGn^8<0zWrvTC}{1^@_~7lWZC{r%JUQ z-y@ABs>{sU<0BMqbt$Imzb&RHEv~3+VAh{v*7;YP!l|QYo$1BZn;40UhZ_j_D>u0E z&L_BAUY>1hg_{#om{w`b9+R-guxovL%=EJ~8yc3{Zni4UR6jYlk86P={S-e=te9%L z$-W-*Rn9HEsIK8D zH#lfmJvlOa>@Ik^t+nUrVmFDcyUwI3%lGxuw3hD~Q#5J$T5j?;tutw82H95CbnUZ9 zuIbum`h}+U!BM)6wmp=c7nf?jiyRuQc^aNO@wEN4w5qfyZmQH&`iUPR(KhM^+kO97 zHwc#IQi}1T8%=3svy=e-VP@~24r*%ya%eOeh%+~zkrXx``~l%e)uJ1eH;x_ zMwTbCk8 zoCe>9mq1pz(W@XU&**yiC#d%@SY1Xxfc5Z8_!roZdhdXG9fuV`bSV5gycx2KiT)O{ zuZzA0zk%B!D~+g55|WdhXdC)#3#jt~${HO34}cFr)`QX4VF=d4L*QqyBm6f!6sB>@ zIvnQ1u5cPW0_r^s-bIOC0gr(?S76Z^;cbw2R-zkVfA}OE40XP6 z8hjUK!9T-c@Jl!xI=lyQI@J3VEIFcw!CZI(JOd7ZqhS^t1J8nE;dFQ&yab*PFNY=Y z7C0T=4QIj*oCeH-$G~#f16IJkuo4b|yh{_+slj}>0$v2Kh6~^wa232Cu7OX&E8#%i zub_>iqv6#sA6^T`!|PxTyanogjN9NJ;ZNX4kau*Ve}ebGWZt*97j}TZf&<|FFbh5o z&xM=eboe`%+=hM$d%~yTK)3}igwMfC;S2C4NS}-T3cduNhFjq~@b~aD_y*hw--6%3 zx8VW2*Rc&whM&UoAny!Cd3VW4YT-nAr^ZQ!Z^4#ucst%_fxHvqw1vDA;T#0thhg|{ z$h$^S-ZgOA!y)isI2#@U=faNg2G|My8Xg8;hDX6S;W6+%*bBA`)9>Is*c&c{8SoQ0 z0Jcr#-2|8hGhq*S3cLoM3Lk{0!7XqY9MqnE2+x8e;1rk*i(oE%4DyatbQ>HE4`vCL z2baJxa5+2^-VMjYci{x6_dyC^KAa3|;Mwpccn*9O7Q&p4y#E4khehx%SPCD6GvF3D z6TS|4FFxA06YrJ50k9I@0;}L1Fai(j%w7r}1*3367v2Yhzl1B`7I+za4z7krAIkeK z@HluiOo!LNmGD})7G4kUg*U**;Ek{yFWTJ%XF}$x=xlf^Tn2B4x5GQ&FW^t$1CUi- z^vEN4UkuKNcf&>S7w|K9A57*Ra6fDZAAmLRA-EQ9gjd7I;60GJG5Rcg9KHrO!MEUM zcvKqi-@uFD@8Dwi4E!s67PjcddpPhQ_yUZ;m*C~_Wq1vI1#UQ+@dDc)!}~a}6MP5G zf$zeX;Ct{@_z^s*JMW9ZOW~iO&hamXVEj$D6hIuflr4zj#wtzo{t>A+&1-<}7P=|GG;aSJ=J{i0croyY?!EhVw06&GC zKSodQ$&nJg4IT>bgx#Ue@Q#CBk7xdelVLAd3{QkJVPCizro*RU224GH@d!J@On4R? z45z@M@Md@lybX?k|Ag6aH_U<4doljt1#m2U7mkA;zydhpMBdkgBjGu)7V-{a)alK5 zf~{Z$> z=kOc&04&O2Jiv?K!*DTt6!Kixc?=GPzlEdVy_FhYX^> z!vgp!JRAN2rVeJE19{WMc?+(EZ^J9#JFp(U4?lw+!81;#|HCQpPjD9e1a5_&!Fsq8 zeg?mQKN(8@hrfhh!AIaO_#*r#{2TlRjy{EP0LQ?8!Jk5>74raW3x5OK!DCM4{sVP* z+#arj2gBE3NBBqB34R0*gQuLv`Ueh&N5a+cD0n428ommTfp5ZN;h|ZK2Y4jx4d=i< z@M72xeh7KzHTq|m2`3Mu-^26Zsqk@l8r%%C;pZ?19ygr(3_KO)!5laSPJ!cKIb@9% zeF{#1&%v|dyYL)1d<5@V!p-nJ_%=KrehdrYx3CBvknK3E@uG*p64)EgfSGV6ya|@U zHX~U#!NcJNa1bnqLm|f;(L7iIH^3_RYd9Ca2k9j=9a;N@^QoX- zf~UhL;2H24m=Avs&xEhRN$`*G9601m`a9IKiSyvAkaxJF@58BZ7n}x@$8#nIJHb+@ zhY`Hv9nFAca2=cl51c?hhn-j7^F;0!up3+l2f!QPo$yw8FT4{z4DW)Ez@Nh> z;e9Y|68#(M!N-GeKKu<_3V#ci!_DwY_#}J=J_A31&%zz>Ik+3X04vVoz5r|B>u?eL z1B}9V;41h&{4@L`)I*dH;T4ma$Kj1|7rYsM1Mh;n;rlT8K-vekgvn>qk6|ZxAY2AR z@G^KXybc}$zknTJt8?hTP!D3dz>DCaa0BcLH^U>~)36&n>Rje=*d6wO74TSC1CNIf zLH3%_M`3UH4eSG*DXe4QWXK*gdLHB*|LBwOWcVyR4W4`+`&xJ!90_lQqu}juG<+3~ zgRRe}AHz;?0!)JiFau74XG8Y3(fi?K_#iwRwkzbld3Z1^hDX5?crh%6Yan~!Xxpju zYuE#p!M<=7JO!4+)8TA*F06zVuo}*XHSj$cfq6yjAK(-?2hM|Y;X*hMu7~sCJ@6v9 z6!4G@ zJ_ELc?D3T!#)$1!!O{k;NRgZ@JrZlF7q@T z1fABbvtSaO0Qv1vv=p|1uR?x<6xEZ>gWxAH4F3rah8^cIAH(Ia3tRyYgD=9aaL9c6 z6FeJsgT?S@I2U$@m%<)!8|(=`hUsu8><5!BV!nl?a0t{B(^KFgcq&{Chrv4`zm1A^ zxtRV04}-a|5OPKreG!gN2jt8yx*Kw47oEC*{Uj`f=ff&k2$#Sa@MAa=>Iv*D z_-}XtY`c*D0*`|i!gVkLZ-8^)AK^SWW)b}b7QqGZ0=N(^hKu3r@DlhoycB*6SHOS3 z)i7l-{R!%c?&Yu>yaJvCuZCy9AHiS4>)~(UjW9XNya}t|E$~{%nPl`I@K(4B-UiQH z!h8uQ!C$~4_)Ay~ABKN`8{u~N2>b{9HB7pM^)d{@$KeU^33wxX3f>H#fgi$WVSXL+ zCoF+4!V35jyaaBAcfwa-%2MV}7=o|DV)zF*6K;bw@Xv4wtcTaazrfq!r*P~t`Z>&p zU%@K43*G^D!zW=GNzrJ&d~}u11^Cx;gzr)-U=(=Z(${TA6CI{;Dzv@HO!l^8?1pR!U!A$YvE`(2c8Az z!b{+McqP0D-U}DP$KewA7Q6)hA6yQ1!b@SnTE+#`v+T>^W$+4kE4&ik2d{!{FK3*< zYPb&SVfKx16}$=F1Ah$PgFl0LSC}7FN2kG`+J&^tk z-VS#{J#qdUd>wuPzlDE?xz{ib;Ar?2oCv>$o8dR`cko~EsB0M)uscj@!#WPOfO-nu z4vvMX@LYH>oDL6xYhg!tJv*>ExPiiCZcvuUE!+CHToDZwv#qdY44mvk*|A!&C8WzKA z;7a%-cniD^-VN75=SJpb7=pLL&hR#P6ucdt0Plcx@J_e_-VOE4_Fi~D{5gCH{sJC; z6a5n&0eSWlT@LSuSHK70*YH934cq|R-^{!YJHf|cH@FGvdG7Dv$?!=y20jJPgU`a* z@OgL{d;#7KUxd%Vm*Cs*W%w!F3U|R*V2d9!ufxvpRd@`14UUC>fRo`H@G}p&*}Spr zdbg5yL$8k3>i{oicJAr91-$m`#yC)FS9O?GrFbFF%E>JlIU#@8h>^Tk;s$SRGKlHB zSbfNkL%Bxe3>(iYKyHjSCWfb#aa51C((qDfsI_E^6uyI74MmQ-x_X*epd(B? z8QrV>k)9^k&;KZ?u$!NBnpMOK-Ax*P_dMP=_R-Re$sKEyp0SUSGCyzP1V31J8_X!Z zGW3x0%!woEo?c%#)`oMnUV6t#J2AgtoS$A#8_p=b^p2NuTR_R^64X`Qq1+seUenx47t9M`&*22|d;e&6mVt;so; z_kr9V+uw$?YOj(RQmZ(zGzZv_uGZ_c1En?Ah=m*^oi#^Hn`yOfnY{c5TdmFCv(w2| z?PliLX^6D+9b;#2hzzw#uX}ibPqBJqe=qQ*1w6%zBsx z^U@w33vKjXT}D{F+h@Gc*;eay8&5wnrZ*+@$}%dZcgx~MI6dakAln?Pce{|6Os>`X zy~r!&8D27`%Xq;@$AUL(w>;}%+s&JQ$Hc;0A20o}*2is8Fa2?`@UDl~FY>L2?OI;= zGp*Y1U7pAIn1@?XuS64K9=1eYl!BO#o3~fgiSj5oJAb6uQ*dYE#Zxam;QO4huh!0@aKDKufusB zg#iy!P_IN&10HUPyeLHhACtE?8%&eOi1Eg5UU`aLoo6*KXo;(CV46}ts8M^PZMv&= z%iwkU8Gcw-?**Re>cBf&7F>(Ba*rK4yq&F-tZ`{NJ|BiQ|l*963ifSoFkBr?vYOG@Xm|>Isn@Yr2=8pB1 zwVskz^p$g@96xf>NEOAi?_4RV#K`dl{>o!sOlNMvo-OCc^uvdZ7|rk0+?&Hi4fPFf z+ZW4k+*sCRo<$aT8qDWcexa1Z#}D(%wa6+|0q@ScSh^7k<)sz%G{Im?jB?!AY(L^9 z(o6_Otn)OA=r!|FqcjOF`k!899EO-$rY!lJU|&zt-w0uF-p0Unl*jVYzw!D&a)0RpAUix5tl~ zSW^FnpI_St^Y)~3aJ(Y-dpZ&p*Fe zr{iNIm`_nQt~{8K-N;rU3v2nh5#Q(Oi0&%Ij?AnsEh?EktypP0ZBR!DI(*!?JQF63 zF#6W5`=ey@rAtL^MBN_sAVSC5k^QBc@m#&eT^PYADecc92sxJ9&eN!_E#X!ZE^kC( zZZ@A+a$~s_H4$oqwdvoFJ!VS#ONiiBCT1&ZDitj)7$p;)3EnsI1kC;LP7%8Ei`&pmj_I6Rzp<`fl{m(@g=D}t>gi!nS?Oednd42wjn z3-}Nz-w5r5_Iz7(Is+fkbiY8_lwJv|O-=LD`q)b*JqA@x*+r#PAdFM?W^B18Z=@}y zI+ifzH^uH3F&j~-Z_H8I{FX3gAgjOg|F$HZO>iccG`078_n%ib|MPd+F8}viFRy%# z=O0GDCA#FSx7I!S?Q_?q*A56Z&q0ko_36wz z&&d7c!b!b;`_o$nUV9wpg>LvsRabw!YsO!bM=!hn=eJEr=Dj8|PEERCW=_6S(CY5h z{X2g3zyrGoe38+=kUaU{N4BUgsN9yc`|ib&XL&wg^eKlvHUGoEY-s=Cs1sircfr59 zb53dWCx3ckc=vr@zjDkYC;cSlqrrdU9ELnnlWx1=*Eu6Q?|kUc(HoxVb#e4tp6eO? zg)?p|>vz(9Cmy$?`2NzqQ*PsY*yw+BY*y|&cb|6fdCQ{*{2{e3>2EOlfBpHjSsM=c z_q zeM#z zt+X#G%;z_v`&5bAn$p6eikdPCv7R}!9aCHz{aV0CA-xA@bvIfmFFhfwJ6crI7PW zqfR$?q5@i>`qr&%fFj6vejG&=osRZ_?)M7qN0imeoKE<{>ubb3%DDdf~4@pzxO z+PF#zIoBfbY5_VuHIo!_?nL4>1a$XUDdaqYw9@E)W2KPuJQA-*5bk9wg`D@0E;YIj ztQ2zoinQG5zOYirNovpUFpN&0Wt0?h4nbOKbe*jfa(W=u8Qt+#3OV}C*Cj?b#7ZG2 z7io#njj>Y5ITtBvbcI$5IkS-#8{LIgVjLkYGP*h|g`6vq78u>NRth<{BVBBCcUmdr zJcM+S(LG|Nkn;@Ee4~5bN+IVhqBS@kn=C3IYyUsuq%a}Fp{=; zZJa}_6mq&DX(!Xh>0zai(;tcDD7ryb3OOT@s*Nt!N+IVgqzjGiTq}i~3y`XeuF^^& zXCYFh(dpN6l0weqNEJqRwUt87tw`lY_Y*6HoL?c$HoAwb6moutG|T9ou~Nu+9jVOd z-m+52`7_c?quXJnkn=Ut45Ry(m6)Fo;T;#F3tK7V9D!77blt2Ja!x`jF}nU%3OU1& zij8ihl|s%0q-jQXmX(-`k&2A2%t|3=E>fYbaz^bv4u3o=pL~WV+$$I=$^L{V+(1t(YtUskGXQCn(G9i|_j9C?MmO3@A?IwQY@<8R zN{lU}5k^;OCB_!gaHCsdCB_!gFr&NLN{lU}ETj90l|s$~NT(Uy!&VA8Pa&OZbkABT zT7gQS&4NHQg5Ss!%D1kkWMtZdMmNcLF#36-&l!tPG{cZ zGrD$GVx5C@ywT}byOLPvAoVo5bStsWK|0RpMp%h;4pMicn`otwGY#n&qnmD}kW+(n zw9(DAQpj0~)XnHtSSjRG9OkWKtF07r9`tn^ecgw??oYn1?crYBR4av?Y+sk->mt5x zp069#)r)(El|s(9zK&B#v$`fdE46WQd|idFtM+xb_`2JD-Bw@sny(8V>E(Nfl|s%~ zUpL;@t?_kN`np$q-Rr(C=_oI~R#u`deOF-8f%2*VkR_>u&dTclx>yechjYT{k)g=GXebO5DqQU74@D*4JI{>o)tkr+nR~ zzV35hmqv$l^XP6R)}p?y*wwe_xp73=~`?|mRx_|h(qZtTp9>-cKJ$5R-;m=7X&iaxU|AYkl2LU-x%km(3*P#?7%($XVg* zR{OfY_`1)0-8`l;H|_!}g`CHH-6mi6iLcw~>%J`D{b|$xzP1v3=ZXAQ!03*&5_=pZ zCRh6DX;un3=OJ}5x*{uuoJB}Xa)i6YN+IVKq|1%&b}KR8BOPdTPgyDCyor=zbnjY; zJqc24qx-^2A?LtJnz@xn8!LsJGmvNqbYrcg5PP_i{3|&*8Cm}e-^sCu^qcAB=Gx$2 zH)aFXf56eq@+1ap*)l09mHnW1wRH5S9g~u>SLSt3%UhY*xRbz6Bu!!(5u8Xz ziK!B6J0R)XYtEw3#(yjRRmAsn3qu<}mu``(>q)o{=suNhmaB6VcR?y;*+njcmv)ze zw6-hED3wLU#A`|B$nhicBN;JwKF`=|+hK@2y#J5zJK9*sw>XFbCuxpuIgs-Mp4b3y#89^{CsPeElOWDEn7m z=d4<7A`BkZl7fGzbk~rsqM2sH+qC7X+_apPIcdKBnXDY*8)I*$q)vG0FXdD;oU0rf zv5N#3b=#6CT?fxQXH`~;I)*xgAA*|EjGw6lZQPnEfx2y}G5r@E0^wVt@8Xw-aw_AT zRk?IbV+J>NN)w^n+7!D@CL^eyA|U{>1vNsRcuP8(x!LlGnu+fI&#QOK#8Q&0eJD~ zADCmcI|Nk`+jQZFbGzoOy2hj(et7(0;a@(NQ~WGd#Yz~B^m0}v1?^}ou`(wmrpxO- z6Qibj3Zki_ugvKg(5Nmeb58U$Uhb=MQm^|Y(9PUIF7r8Cr?DxGgRql=snuk%W{ zD)+=TTUKrMoGXW&=vhzaBBW-zmQ4-2OvWxd4zgja8<*7NUnSE`L0 zcEd%+;BF%Nda6TDp1OHgN)LH@hMm50*ih-?m8b4VizS<>d^~6P;k@osr?1QzipA8c znFusd`^}T4ArW5oF1oxm%uNKLF9ye!ilheViWi9pPUHeR3nwo)MmcG^rq?O_oos1Wg0- zl6f>L!Vk9`*2DQ$`*teCJp85F={(Z#%#l+!FU_ev#CP&X&$zsqQyo;(cn=4`7Ow=6 z|J)HShb{^tk*TOeNyUaqOE22YU^F>wG>I596<`(34^DX5D&VE#-bR>I!%K&vrqgLI z33_+X9a#6>@WU>>J95J$(v-wkHrQ5pih9!A9)8_dWu=85UTyB>;SEbuR7(;r2Rp(_ zT5+sGPI-7aQ*_&zeiX={Zr9@Q+GPO+v8#yX<+5t?^>rUEZt=wCT?gi@%W+K~-q13s zY*Wcx^0VlJwf}*uZ89qKPHWB6QRc{pB4q1TdsP-E8~t#Mqr6ko38bQS=vO7 zRo%@^EvseVmM2Y4-6nI(dsDJ)Qnx9x0!@)mELGwCN^UQ|GhRww2{DGW5{n0jiG#EjUl_p zq6}0fcddiM%Z^~`)xDbg7E2xiPzj9*rl&zHeB9eOUVU9J+u82K73jXHIm`qK5w2Si z@Tr@ZK{9nD)>zn@alW>0QzjitX`4m!sx6*R-m0wF%`~4?;cAnOnF;N*u#{N*=S~Z9 z=%SVqDYwc~ud(4JnNysVne)mvZz5+Ml$z6v3^#jqm^)rUO>G_~mV4)CZ7_7m=GsAC zDs}TRlOn7ZyntEBfsm&XQfr&lnN$F`VXSRy zdU-*@57U1Bt~uYyag(z^qXmHz~={PrYp#h|6E(hp$l6`#1_|p z|5h`tBX1SRG?N^xjrW`3mV6jUF(ty*dj6vtH z7!NPIyCvgn0sFb|QY}!tIbPGVZYM)FM@HGEXAxbKX$B#U?oHqLcMs}p97c*+bF2R# z?09Sk%Sjbxuu^FdW2>7>e2lI2e49@tE1_fyH2eeibqzX3ONv?hE6MQk0)oUQJy|H0 zVYqIwal5@weJrw2W^t2YTcafAia5qll|C2jq319Gn1dA{+j5n@bYY!vpbBR5R!K! z@3=%&=t(fmDtnvRULqX9-6cj;TZ`~AWf5EY4OMbl=&jPyPiGknAk(|Gd3Nu_uk2D` z6==w?o;9J3Y#w&k>(kOqP5DesGnHZ^kxtQPsl#jZ*Wb&l@^6Psi+ z#LbL`J+q9$9#?Rylsmlq8-i=(7uo7bizR)&`8?0uks%0WPtUi-tlQK!#`?Bln zCPeBA5^3+PSFNJ9lb4QncA{9c!j(H%mYB)hW;nttlT76%-CCy?ZjMiI4{+rnTbfMs z7Y$OZZdL!V*}}OQXg#=1mZDyo-CRqp%<1AQp2^BbuZ>ZbNVuNFr;}tVNSe~Z(HB`q zhlo9;*M?O3v~0?)J!78RkX|lyL3hbz=6DLx9Rn~Fgx$3vqz*{@@p{sduKqyMK$|LU zcsj-{RMzT?cX3CI57vUvR=Ep$&8dP2ydsuZ+qPdjF zOd*7Cu-@cu=S?51H(7j`P>n7&H<6{vVM-*2E@DfxCBjN7m=kGL{~|D{`F9sQTN=+k zwpYkf&A89RLeELwG2bhpnF^=J{A$jzK5U0VwPRGR6moO-_{>nuJ*L;F(P=ijwzjV1 z;53?E28|UuD=nv0mR5B5X!X~?2i>N4T`Sc=p*8O@ z#`84^D^?m=(QDYGXLp~cc~p7lT(GIFW{7z?Ew*ScMZ9e`MMJ_)rqWx`=~6oS1D>p4 z*d9mBJ=3~RS&DxoJrLrQs5Iu-*9)Vw4KulySo0cN%OS(7P?F6}L~Xbxdss^qm%A7L zm`vw{m%YivL78-$(dFf+vTw9*kv@6=Dy6JaqhYR=Ymv@PCEzQy60i}Hm9^v?b5I_i zAeFu_atk9)eSt~qCjO-)Z0XFkLk~*iFr7j|EMvJA&QeyUm#Qe3e{S-QNzzI7ZX8CA z3pdB?A?4F>?P&Ip@saE2=(c+a8OorhhVH)E1a$AzL)>y`qOc{R;sO6xc43^Ew1qij zRvOk#aH(;rM#{i2Ap-)KTecC|KBdwWthX`&f5$B~vYBN@5Emp3>b z@EXoviPUXsNg*^_5l4T@KrByw8VW^2&4jkjR! z^==LK)Pf9qm5iy#7{d*!`60Y?Y+%BD27fn%84dK4Dq?n5Ex8c8T9NWc(NN(uGcW@xeZTiCArf+ ztVV7IZ`u^LiR$Gl&QvYOs={^4QIeBZaH@qjFGi*+P!)ZHf}MyD1rzMq7fIF*^;G;# z0%!BKkVX^{a+8;QAWfUit(0Uey0S2ns)QZkxb$~)vZbI9Dv&ax4R#}TLDXfYW;skM z5-4H;Gl|6Tnlh#m^?bP+u|hs-63YO(WKyZjL*Og~YA%q_=74wIyc8$AR`0&smT9{G znq#BM_$wJb05X)bC=`yQ3Q^ zDVwj}#J&>zq`mBk(pTZRjNRmL*EtBpmX$D_)C)(+Y?6Gl*}cr*4oU2r<2|+0$yX}l zTMjNrYFXQ={-bNi>YL8YtX#x*J*qN%*X=oLu z(GcOa*WyPg?MW2M>$~BlYOhA(XymwsXgLhK^&}F-5(3?Nf~WGjHIt89I-d7afemfx z>DSnF^3F);?KV{v%Gg`Nj$@lw8fu`dCWcpQF0uuoq*ctMxP-dx2U!JyrAP^1s-Ij~ zZ|_;q(j_V^6Xx!18+Yo)R7w*OM#;C**dh_hJH~s;f`IZAPni`^_Vko91Ij}@<${1x zLs`|%Yq&Hucw@DodjTs2{$-gkn9!<~&IRz-+~`iElI&_hDaz?C3tZV-860u7>1eVY zf4RD;T$l^I{+^X=rv!J^@jbGOp0PQL zdTIzsle2l7X}VMr$*J3%VpcfUbeB`B2gPtppRG!pic(=?H-ABaLgC$(cY|>AYH$K( z{MovYM$DK=7&+2fC9dyqC9Sf9M+gdG`rX6s*?{CGrao;wwi3J1o|&VBy!DSsBv{<< z+)*P}P`=TWuc`cECox!~VSe9taOfvw-_0E1rRQmOx}6#OdzG`r_Zq~LzjL#Nmt8~G z`d&r+e)G&jSY&Uete-5~&ETx7se)zFr8L{|WQ0ck&V8tF!$P!lAF$ZoVt3c3=lDZF zt7q=$zPs@uvE!wt3cMdW43z5s&6?HI`m)+-^~0$HV5Xq*pCf7x$T@QPr9E z67Hfpf%g*R!+QxVu5FFoXOdNB;%92s4J*q1gPhzOmK?eWFOj>EwV^j}mQaIQI2|jI$Z^bb@Kg{-56!3eYutwDOyr6 zQJQSc>PX{je`Wo9a;^W_rDnxqwnE{xU+!s$m?tPz?h_RCFP5izb>}X+M&b}LPf$!R zY-EV64t6>@bYX6Zbh;~m{{+S46nk&SI0NtPXeDZ%py;eXwo?E*F3b}Yxy`sRPf!Tu z-V$suZx~z?ERh_xL=tU@7zQes6JGW*|C-|iEMV@grcgtMrB+XEq}Q5Tid%{d$9<#M zmMOWmuNR(T4P_~;ol))KOd?%vH^(RvDS|rwj>)*UkURA>PXiKh z&jjKR8=vD0rvBDtv3{^7wigh=%Sz!X@{G@58OG|2TLS}Es;c9BCMo>IT3%}^q)HN>aq8d+y0zQ zmh$YT{@l7)6PW{MnoQfm)*Q%r4Y~Jbe}@xMFEk7EK(q6-t!`VIQuN+J^ahsuf{_`B zdT&rS^Z&$5bw|+ja#+(##PoN8AGkBz8!V9=wnP$biLjjt#!18y{`H1TQypUJep;&4 z@bsu&L$}eXGJMIGfwGyt5;d=kEPXGa*Dwz+d%l4tGdaBMk$@&Jb%vL%4|upwILxe4 zqjecxltx2&&r_)0aCfKBMxW)FN%Wbl6s6VpggPIy?>Mx{S-gG#Me$lCI7;dR{eJJG zM4y(6jS_P*;ZLXDDAAvi_j1~gQ|5j2HkrdbfssQOg^@^~d=UJ=qhw>SL~_^?Nwg)x zb}E9FJ19!_OgC&x~mPn#45#3S+ z+kd;QcNS3X`!5bm9&7I=KhD3k`qVfM*YWUD<5vo;skh?PtAja-&mxZ5+=#OOW>#|h zWf6I#3jgIr!NUKvVc~0r{ZAIW6oc0frQn*5{cUA<`M1WztX8~NH)a}zyDsJ@pyrJS z=^DQAU_$Z6gKqWIUq9m|U1`|{*{4bGvX?NgNtnPKY3m8Fkz+y8^dyp>%y7J<2t1HF z$y0d`r05VzrLjk?it62O%$re;qt)6{J;Ejrc^B4di9ZF2|D5`J_{Y4jD!)gfxXk;i zYuX{1KIi`~X$zwwA*9}al81f=!8$O8W)Ei6uyoBh6-lvUW|ZF^&G;I*8#4w&%8c@8z8NFrLxBa?jFMb4zGMaL8s<%Yytuh-kssQpcW|X6GGrnt6Fv-cGi{vDF$;pgL*Lq20H!Z`OALDEbCLxC| zNy{&VWvDJW?v z&G3e-q`F{z_L z0_?~Abr;M?PVV57Ll+g3NX5E>A9y2^7A%n*wnP$bi7=uH#`(?r{7Y%$Z}H5zvUiR? zrJ{RA+t4wa6Ls24gqQL@Y^=NXBxw!B!rCL%ae0M@f7J}`OEcSfm)4b0se_yMpd{el z%K$S6Iut^q%)Ud1OL5Knb9$vN{`h=VCDxx-LF!GsSh25z=mavL#&!@r7U+QgtwE$u zV+2OUcOFE$u%{hkZGW&q)IHc`<&34Y)~bYieXa@Z0{v?Y?2B>z&{ zeHlbcNWu=Csm&NVdl@PeMx(?$0&C{IXlgk&9(2L}8!Ed=J2q4v`X3l7>ECUr=pDnr z$O_ke{@)lXeS;lS4qddjL^@^$_<@H?X0SwZ*b+&!C8FI`Fow!+_;;U%N@S58Cg<<- zFmZq2+VGCzzvkK4?PO>f#ywkNS1 zi2N3ui>|qMfadQ;&Y#XIwiz3p@39VRLDKbamr%RCuEW0HTbs9)?s-rS{T~>V8~1Tg z&iii+%ADX3kVBWcq&o!izz;kq^MfUl!c+L1(^2Pf0-g-^5&t3~?|3=SV<*~Q3*DI(~ zVBXaaDJQ$#N(h|2%GvnYt8S^XjDPm3G#i|~#uWDKHKuUSUZ;?_E_040htgx{Nu)%| z!9RQT;wGNG9^jq5PPHkR!2{TL;&+?l2qTQD6kt>XXh zIvwwQ+4McuHpiXEIQ;jy`#L>-zn_BKJta6jPG^OXFzGe=Xlg0;O$ez+Q}SqPdJI0W zWfUfdmzsByc?OkAW0>FgdOvPjkAj2VbwF1_>)q0f)>B*X`vCV-Vd1*4o8-MfscL>! zF7B^J??OT$1Rjr{=BWaY$K5!IzeKhvD0y=xDZxhH%SSm^V6p}wy^lc3L$++}i=6Sc zj3n4i{r7NI1yn{zx(D9N;ESL;xF&hZ?k zEt7ZX^^gZiQE8jom>jxDswZMcbK|;(r2G(a=%Nr3nX(ioyzE|d2~GMAUjOkX9YWT7 z9oW1Wt5TYKT*9N0sgr2WK@#!)zB^=a+PwJc!a71c|C7;%j zGApG;3T=S()HO2RI-;F$jNFlLolY9R(H>zPAsnWED5aBdMARkZD3l}Y#p#Q~?H?N{ zA^*AkLk?XOK>gzo(?4z^wjV+cT~taU{X=n@=pWDE^*`7@vI^)QohO+2R&x|PF}M11 z=-T_y&iC5^K0}_dzHxc8cYy1$bfZfgc{H`e@!r1KM5W?(fOim$atMJPpq!2G03Ra> zna1A%D$NEvz?j1B0AmVw2Y45W>oU`j97>N)B$1n(a`1P6UfezG0PnRanB?TpMRF3o z)G7`OHyd9vMj9J0NrSf1f6*+7w61`Ns9iU&B_#I%P zhr0vZXwx$_mBSiNqL;Y0158ZgyX^oU3+5$<%}b(}m$w6KEU)jk1KbqMRSui0L@!rw z2bh?v-2ot3SlmQ_GBA|3Ct86u*!XQl!2)Uv&}G}{$2k2) zTaROJjppzDl%Bu$dlv`)nVH#mm`_l>iHar^;`V+<71;Z^aT51_HU%Yb_EHjTihJ4n zy@u5qg!J})^7xK>KiSM=FG0ptG0c0nqWz?Ts^IPY_S~)Y(Ys7S2fB5`ZC~(FCxMh} zldJvVd1QO&=pVkHKTDpmey%y2-n9+rqK03*;GV{4B~CYw>q!9{dD%nF zNRj{C8CworB-#_v-R5m0f*(Q-T@*qhcPGW+_pa#dME5odza=$(_qioUkXy5d@g8@0 zi*jhjiKqYY&De^JW6gL4R*5y^M;H>@3I6WRbC}(o9PaK;lDoT;v>v0I-JKkP-JP6H zn%&*W;qUI`@OO7|_`5q3C$_uWP6_$X?G|$AvfaYn-EAj!ECdc+R7!ffh2k{m7Ehz_ zyTuk9|3lqk#wfbQsU!U^yi#Rt##_g&zSr}-ugOR=XFjle6*t-6tfWGW+{GrP*MA7gN~%T}V&E}Mc$P7YlpC(%pJ+u!-g#rAh8_6gs&!DQsH z$w>5)@%DFaGG>*Mqv}7L>!srGp17)G3L}S2MWUCAx4-iX6TiPp^lS2=9161`l#{as?Nc7K=X5x>7n z4Q3;U%|@clCT@S%!3Hv>m&3NJL>t3SmG1toOEA0~HoQcpO7-#ZvX=a7@1ScCn=w1; zmgqnC2#nCdjGs5^~Wqm`-aneL)=Uan==o8zZa%1B)2`y!)R1|B;Vw5q{ zOI|`_!>*h_d)}IOPoMaq)E@Vvsz8%llKW3#9L{QXUJWzC8Y+I^dFLMU8bx09M-275 z-mi$e{|4rpWVEM&`8RT>P4wqlbYTL!1@2B~VdfRwEwGWy7Fbej3+%d<|BQrecx{1i zz{%K>=Q7eYk38jYx4;WxzGnZ_s(uz4l{3~~qV6M4{VA(vY=Kn)LVDx*A>_S{XL3`! z?Qz=w&-FhQu*v?{Z^(bN|Lrlar%$H;-8|Sg)mzwL|MkDg&J0?U~eTMzb^8<4m^4j24qo{iH#@k)Fax z`>z|dC$~Lyqt>)ptQ+;EA!$3oKLzj{<`h5<_Y^>qdkP?FJsrWE0>}|K1(4H8v!?)Z z_@@AJ_@@AJ_@@9SPV5w*OR!tYq04ql_Y@$5*cj36mU8H#QWEKwiqoK5KKuVrw>)#; z57aHU51?Bmn-FlMVh`}i}X6#*S8^8hJ-8-r5H6`$x;rj<#wuEd})IHR#!UN zjtdjk-;J)+GwGKJA+=JMM^h{HRoVQ_=+!1`1+iID80Ab8sipRF6Ft=*d%QuNtv$@2 z=?>asQ_LPisfziVMs`&sH_=o|KbjmeV<1|V7fpWDQEuueP)8;5ojw7;GreYZzxsaE zZBu%z`-j(##jpv@)M$fdQ?7)NYEXGJ)u4%6FWoL1-Fo$;B&;>lfG&TxAickz>WhN} z%xrHw_V9OMw4YML^a$*y+&GE*DTO1rk~b?p2?>>L)GRqonMEGWHH&>AQ*}4lOOTON z40RqA+uKh`Zn&S4raAkmJ+ChGw>C7d?cUVzwjcN8PDN{SrMiMUT7BV3!45Wt@U|i7 z>UkK2+nV6+8;lfQ`XX&=^`XdgPYN#&6WhA9Z*Xujz!b^fH^|}c8$P7;*4M1~TGekw z)9Ak8VYj{aY?1Hr3EfMnd;K{k*Wg>2)eA7ee>}6p$gE-Q5_Zw`FWI4FzIUuQKxgi? zB>Vi?%S-w&E$)}EzV#&K`rRi6``1sXV61=TyZuWDRqIt;N$wUwlD|ce!)y`S(_!Q= z9Y%lYcE6OnsyF36y+OJ494}Vx0*XLsg;4mCRqkkz%PqSkzwC0Dvd^IGa@ex(my&Ow z(DiG21ugz%gOX3C0F*=USJR%utfu8~SJRT*)wHDbBx6?7a@f`MNSl(A#*CI}9sX)s z0sYmq9R6xr4#!{?E+vCYes*^f(QZX*&%J-m{3sT# zzw$V~E8Q9?MdP;nNv#*EF0TGeUIO39@?M_>?TDP zkeS#=f8~qbphD9dUgh6??i({{lt%l8JeuD(RJvyMjdGF=_6@l)n}Fq&46b0`I0CoS zUf2FasP5$wM-dg>~{Ru-ts{r0XdctoC+8#@9{lD&e?ydW~M_$^)SjwC&gx7vb zd9m@({nI1o(Ke0tNO?5BN2+wq>X8dbHrONOrX>Z<1&#Mese?T-N@!iCzsZ4#8urMg zR%t@Wp^JPZl9J+tmtBp{_P!JSemJTb{cz9yZePxJRv$zED?a+a+y4%v5ZJ}`KW&KU ze_6D_ewYzg&=QUIKY292|EYA%>VKfQ8JBm5vhY+WIdsEnGPUFLKnHiDoqGE zbdj<|Qc|4ovj4BWYk{t^y3*$+0RjRE2p9n|NK_QWB;>`@+&th0LUPT6SJlhq=H?+c z$@S)59*T;BPf)Sd7F*j=TOB*KQ`(^|ZS5*Eb=I(E>_}Uui&@i|($?uBgO1X6W|)qx z^L_iA^FK&}XlrM!S@XN(|MqwG+2@>n_Idn|-2bPVd)J4EF=TwNv(km%^81fjXvhci z4#_8AdN6g_`D5?G7u@&vrwP+giSxyGFFF_T9m44Yi0|jo)5FF$6D~ZyS-T60?-yX! z8{d=>K0G15X=a%CChd*yL(t|S(Mw@Sd>=NXXi(q*%Y?ARJbCwBjBI8Kyv~^dS6;vr z_`f_NUYqfOjfjU}dT`TpiMaLfIuGNbMBbiPATd-!a2$58SA@`IVQ9JQ^%tOl%SPUe z=4InnyVc$zf8}|^+ba}!z#bt?y@=E4TO=B3;2XI}l?z>LoLMAp#Rsy0nYjC>W4?)# z`r*&^{>>cxuB!Z$@lmgR3Orz+(AbB>Vj!`3r{%X+#r80tob@*CE-Y+L!*l9@pNH+x z-s7e|r&yG+N=?eV?@b%d$8eF}NEzwm^=~n}gzA9cY4@qkP!aT^oW|rmkdHTfc_W?d zFmKk5G&@znB+GiApDVrRQt4F*f%IC~I)?V3IU{_k?LDvhvtfVmNxU>CzCcI%UT)Tx zY3Kb|;P274XA3-S<2wt!;ry;`eLq)rr6_XnIdsPd)LlQg#M7h;yJ2P>c!3Yzk|<%2 zf4?!b!`yIoe{%1}aayFHhY>FAwcg(wO+! z)jQ)bK$#z=dAG>s@02_By+B{pp^hKWj%9EvOmDIdcrPQ9jW9n0?R_3LfZ=I+4?3_J_fbIzJ44dfbsWurC~ZsHlv!@Q?6%iafEi`olP8hdoI@rNjza^ny0(@Hy>%xr1(L1uKnAM zEd2+0msiFkefzb>@1I5DgTBObJ|mCxeZF*WFd%WiNi+@11@*k28VBkHP-xZ@II;GC z2LQQiX06{sXW%nLA=dmLGb8;F&O9WzsEg>=>o^Q>n9jh2arSlz=^_x5HjPAyvbf1>+0+!J!0&5Za}k#@ea@X zyZShQCJa_!c$u0##G3JuB5U?AguMIc%X0#OZ(u-&r+2W=OPkuShB3#}ySIl``j(Lv zJolI6-`~$%oXp1ny^!1Uzn6DzM=65^m?docFRa(n{ts+R-`8mt`^W{DKqDezfECmyk+56mWoT zki`_jK@t2l*ze`A3XA+uD9jQLNt$;GA7MRz3xy4d;e&M9x$C+1qd$gUV{XSWZWZ7H zCUH`IoozcjUSd|byhl$4#JQ9nsZ+m0^9WB*f*}HYT+UF|Oy0gPxLM>Q^!RolRrl`O z$GYy_vxld7eA%!1Mk(rfl#bQ(NES<<5BAl=ZZO0nMy&T_7$SmZB2pnYbw5;a*5jyA!hAF-M;P_xRndq2> z2Xc2Cc$&_pAbV$m_cSPy%y8}|H$SRLJ+bTBkF?KCzyLhJle&}N0wU7BAR7D}+;Ez| zcR{1@^c0-t>6cY+(ph;@nXJ>Z8NC$PA#_;CL@n{)Gz>0SmuBD1FAa$=^7gz5-$-Qg z3||$(K4qTm94VYJ=1=E^L;5)NWgbPrl0NTP2tN&p%`v(JHVa@2Dg`Lwoul}fz_y)t zq5_O!l^I}WsV%;ylSIeJlLDlGK7X7$_c3VxLavrJaRj>^fyl`Z{N?%jU>^8PtU>(8b)gf zpVx3Q;eCqskwOI?A=b1=+-DeYd2GX+3>M|gwUpUX73Sl)YZeC$UEG{iW%<2?r>)Z$Z#jPz~N4Bk2Ku1z4H(EP7F4u7vB9( zzBt3s&A(5Pzd}IDqR#QI7c!#3f8_m}ub?-$bmPQh$i0kwc#LWEwO+sF>!4FWld|_R z3XFV+s)(vWuYB&kjJdwVq4zT8`_jD|VOTCUiKa5#@Q3^q@3l07LbJ+nV(kH|06BxO z*5+D3?qyUnGt$F2^WePL=Kcl(n|m`p5qw{pvtne%t*WDFSL@k=j&{+afth! z#mpQZw+rtcAI;mtJ1V<(7KK&bBVbt6Od8MN54r33)7hB6Qn%WS`h(S=wyuL>0gBDq zS??yAan7$=&y#Hl9K=x4_v|Eyd_hB}NqR5`_b$V~h96GP;IzTL2?v}zhYk*Q%Ip;m z-Sg5Z%>3U)9smFMLwX>vDl02HhyRTly=u&u+_B>>8b4uTUjC%X7f+cw?UI6mOD~;1 zea4KL1(!~raoJ_FW?g=HVd3n{W?f!5a>^A~%$ZYEbmf&-T`{NV%2npL`s%A!t(tqy zwexVSnvdhU>lR#Je0_=hBRZv}*IVU<0A=OnR{TGFuBfQ2tg2eHXi-IF)gsf*#fz6L zS-N!DvSo{xEL~=}<;!olp}IO43@*Q+I%v3>n%dgBy88P1n%cU0!>w4ca%Cvg(9p1A zWvC(V@;_vx{84PRV(*Mc?kY!>U@MI$qd+g@Dperp7eILU2JQ?H9xVYa!qu!!9RSj) zcLC|tn{k=V``9@u2X}Qex&?RkrU>`Te2Z$3G*h@A0%^UOcpK(R!hK`5QYa8s{t*Zj z1IoL?qIC}Xq=SA7^k<@%Ge@Z}0%fb?K$<%N^qg=%0eV)@e_g56Gm_(%^K7lAUT^F2 zl@g1-v(Tb{sjz4#{={F``R9xAcL`$UED+p)nm&zR9MIgCfizc#rySaAcK~Ux-4CR_ z_FL`R#QU{m4Pn z*IVv>2fgi}sT*wSzi+hV&i{}tw-QK~TMMMi2;OA%wgc(j+6|=j9s|;PCt_AFufyt1 z2hw_Lfpj}=2HGO+_&Jcy`<=K&Cmb}h({c|w=ywjfq|2uMTemIu${t&8F_12o-%`|N zEW6d}rGa!i?gr9&dx5mx5o`eqP`@1YCXm+q4UpEWNZEEQ1473lI=>5~^L~23BEFiV zxwjqEjeU;h{@FqQ>7eRuw%lz%y4-t#bh(cL>Ad%Dw|d_I(t0leX}#k>TJK-)wR*F6 zTfO-}TJKwXZ0aw8w3Xii>D00JSt~yPDiCjsz2E9h0n&PfK)SR~VW4WgzX#IxP6BDY zZ$e3@o&nOSZv*Mn#t+-n-9S3^Q6QcA@)I^S`$?NR5lE-L`B9sC)yHgV36M^G4=9Bm{Drwt(ARV0_16m-x`d81`S^m^#mAVStD0Sv@8s(^>XZbV0jFRvF ziPd}ZPc8c57cJV4E$vLvJABw$`Sw?>m7K3xE8LL3Amu&?^aVlt9JC(@#t~~z06j10 zfPLM)rfBG$1VYyVy#|Di06GQqw4m34J|XBW zAapxYe+~2zL1%&L1icMZD@YwtYN?x!9u{;I=pjKb0X-<_7|;WPUIxO11}n#b?i2JX&>lf2fOZP{G0+`? zP6FL7=ry1nf=&T#7xX&NHbHLzZ58xupp2liKxsj517Z0=x$0X=^$5xV>K2p>)Fo&< zP^X}LptztZKplb#fMSAX0&Nyl2-G5|2PpNM%tKbY}TB|X7A=0o8~v@ zBi*)*Gxn}k*^?(s%~oR}D}`Fo0{lwuB5=9N7yw6~!l7B?MVI>cHXrj`uulW|N#wEp zHW7B%Zxi8P*j0Iu>0kPkXB4IK!O^Fa&e3HboU41W(Vb#+D~9z|M`twB8%@W$BOTFn zRJHqM>+fmC24ju$yRCD9hcEQ-(+xjSWlyC(>xLK?pAC&emYIsjGO2-{{=SH~TT zh$Pb~YikB<6{>V}b0R)qImY>1qu<}zIS@}PDVO|w)!Uy;qcsCASFDmlxH8q3Nbg8G zb!OfwaEW-I)O9AxT?*NjnT;_PQi!lbeQRO|3=QsL+ z^^r4liM{jNe3S1wlaDsi(6hed{HU>a%mie9$3lOqL$$kD`!tZh5M|l1 zS7yqsG5#$?{V)zM+?IFY%rQ-pdY)0tE}lI~A>^2~MkM0CK+ zg=}}R(+)kZIR~@sDwT|;)A3Z_FlAuQi*HXydeZS;TWg73wy|3EMpIkV8TL8nxK-fn z5mLkTu4*5SwSCUH)Ao&BTUMAcwMJ|wQ}L}Blb*Kbs;*RjCK*A`c-9o_XV+)kBXACD z^3<_F=3)QZrsrZmXY0p0uzp-i={L?_2lLb!ugtZzbl5o>yQ@S*H(#}T1X!1ST_C>| z_U$-sGi9}y*yO$**Hh81o*3K8D3pF6pQ8qPZZ~rZWyGXe^7MMjb$`6-Ohmf|#7C4T z!q)akqQ8I3=6H8cUx$rFrsXTdQ)F{08ry=U)U`2L^Pp4lP7gmtb@rqNu;ycS^V*q) zb?`RLN?mEYK=nm?5wKjqBW4L=95QXXPD8M#c0{B}ZrL++nqHvHn#DY`P(~+q8+P3q zZht^-uIkGq63J)>>dpSiLoBQXZ;xWwIe-6TN&m3_7Z2ON>{{&JGaWn32JRff?dJ`i ze%@&MnK4v|$}pyIKGS64UiZ7de{(#2c@y&6z18NPw6iB-zPYNmr_W3^tTV1rvTpXY zdA^L%cdzsC@oYviW``7Zt6oWumq32R)6Pw%o!qygeNLQjcKED(yH0=8wEYU`;i}Y$ zTh3u@tK(u52h__)Jag}y=;`gTF-!e|VdlIT$}Bu*4@n#Fmuth_2g{i0K%QcxbG~D| z(sq@KZ^vd?$MUTx7WJX8Fb8DCp>L0BI~ShES1jL-{VtDBFlVXpIrzZ5YA~ntJO?APR z4NB~dV%jkLXq%_5VP!*`)*VC6Bj;M3b)kl~`qpr;wqCK0W5uSQ8|Ubv4z;0R3+52& zUL?AHZaleQ(+1n72_iQ(l472TCcS1uTfNoEBZoGITbjd`%O@v*VL%nGuh;c zgxtDcOwJ=uu{vvAovGwJ@-)iz>)YC!8l--gh}>M)WZGC@WLvLGDc3f%)SC3^R$im) zHG^_pb7P}PpJ`>2ewpaIKAdIc2A%(M%J79Puh7U1#@=kot!+*pTtRtFLz7S@&gPH{ zH@3H$JVi!FD5G;Fxf|Q-Z7f}7bTp-Xel@xFa9gvnGuP+{W$au-u6}*6*2LMhl*7%f z-ulcloVWb>hVzzpo#DLp7m%Yd(UkT{1vzQ2wo^&jwAYqZWjJs7iwx&2Z?WOL_Lq=D|9kzn)Nr<&IgXYY z&g;|VuAb1;yTNc?KUceYnl^nIG`!dUHLkAEv{`F7-R;^hb%wKDPrZ7VbLz9g<$PtY zba|(okl}Rq>v9?l=Y)W%`zo8?)90&QUELK%x6$z4zF6bx8d{gvWO#2MHM_c+Hg>~? zH{l^Mb)(^&5HY$fF7K;btIPZ9(dP2LGTX_wZ3x#(!00-!wVVwYQ|3C$OK)i1^_GLK z&_;KI<#jJfTQ*t_x|-HDK4f|6InCWetqL>adL*T3O%HCTr|= zSC*xYZQbE=HNo1|qIbKWb9C<@-`s>9i;lIOR)+IzJ?D~0YpI}Z z?6R__E%yl5j18RDxtDUQn`gI`J$d#BCx#_v?sH@+X*>68j)q0&0m`-PSe^bLnm%~caHyHXJw|R#uw}KW%YMq? zmiDH4UDwAQITCDHsksl6YhB$CHhDf`Wl_;>dV*YAsNU|Yp0u(@=cD9mo7b$trj_;k z808hg2D_I!Ksi`jTOZcxPl+sXWohxp$Hh)#Ge&{PpPVW0o-`jyu(ynZdf_3O36 zUL(U$V{N3NPPJPEGjjiAJIZ6;BIIo`*MEGDCC`5F9EbfV_X)t|s%`q=4(crTu)yW> zK7hUr;BW!vR!wWx*bK`t{S#oiCBN%Ry?!g2`xfC zUT58je7s*U{PUhjBoT|GdvG&EKkxC&^b2j=ZEQT_yGQ9XOWMk7xEuv*eCU#lcEycf z$meQ4k-*LRNGvJWvfIQa^t+>d9dIpuxC2}fb$dEQ-U&G*d6BWJKefa9nl=M0E77yX zb02$rpm%cww<_@nYrE|$-XG0}E}VjAN$CVGsZAHT{Z?SoaZk%lHhsnHax14+qXIo=xxflKs8lU^t4>CY-GelHYzhqj{1hW#*ypY6_n)D!IsO&y`zIr{G1h}}K+Bz0&eC$9 zm9w?nZ{-{<%RM3HA0=|5Jj0?qTFbpwe~gx${Cw_^j5MZg`dBSztUONSHBS95(z1+I z+8?iFr+yPeZjyVAOrNM_r#^XFcFNBeIqcY9=h z3^Uhq9^$iH&XIVdN#>ipkrqvo=1+EI>xl)p$lloax=H{-Ywo>X^i%DWjJHW+zuv7ZL8(YTueB6z6X~> zt|K0%9@iDLB5Nd)RQb@Wiznh;m?ur%eCpQoiG;SLvM6uGeQj+^ z1t72Ji6=UYTn%|;yf2>WiG`ynEV+0XWAo-9t)UM@XEcWSmUXG7{WbA)cYlZJJIehX z8O-I<$GMPQLy~6~^Mq6V$v7TBTHA%-TH<(u)VDU8$T;IDm%6R`Jrvr@+NE}ZY3uG8 zkp7-z`ukD%7JM+BPPIi-U3gZouFNN6GUFPS4L$qZ#K!1E^as=I`ySP?{@&z*o{s*l ze=0v;lC2hW;3-TRkI-=h@PBrIZ-4oZ1s(CtnJ&Hq&B&q7uOmwFug~0LK}yzFAsGMJ zfm=*^alC}D|KNz>feD{T5Q~nyAwcG!!vG*E@YD;rwGJ7yLxmk?K^nJsN#meycAx`q zAuT}q#K)idu+Z`kc1UvMs6y0xLDH=u-{;8=Fdd7TdZ6p+FN>o5GuJ@TQ46-axu}~R zutVad+h6&Go9hMxMMp5-gwqF0=dneL_}4OgU(X&|$5VZi>shOSv(`B>gn7kbXt}7d zsidMxQ}hq(q|{IG|9-rmMQ_lvO8pA|^ZhH`QZnNM+{@@3*|fu#Dpk|hw4b$|tDv*q zVOUlvbe=nGb-*m-JDc+ld6x z%ap+Nk3a5ZN>O^o$1FryKY!G#vk+zdwT~&IHy-iol)>{S_j#Fec>afYLDTV1X$8vq z+lPG&J?~>G(TWXth11Qo2(9?9`#sD;w)DUrFH?%LF1^>sKd42av0+*PE*hEp6~I4uocPI)m(Z}KxJJ?LXNAI^??bCsf{ zH)4IJ<uyD21PAul6#W5C3DOmnlQ8C+oaSIlOUOt&c&j|E}>d@Wx|)2Hq(3GpO_H zL0>ME^{k(PH`e+X&TMC^y}2sTic?+&{;86;=^g)6RG>bUjt)XY{Vig{9|rXo37CVnIT2M^3hB3CU54w7eRG}4Lz1qtxLaqsZ2L080 zmDTBu_xASd4K*BVb_G=&r*F)$I*8S(5?DUvWw5s?R{UEZdPC-L^xz`(>Jbl9#aP|q z%~i#DeyyKD+k<`v{Wagupgx!Q8PsQjmqC3>)E=ikjFO-Dq6ICDC3leL!IqjUg*M8# zUd3*?8W#P>Y1qJ5D7N^$exlcRdFjHF9|0wkuvblqzwkj(BG@lSu2AtK7_6qluo5NG9E>a1#!1 z`QbGux6ZmL!z7r-43pA?*9CCDxvgPsJ)cas)fZJ1W9hR^!hL1^&e4E%oOyfF(byi7 z>*^xB6VcRIys)UEqI97uy0NvqsG=OB45$pKv|JgDQb>qW@X#$U77cJ^Rb}K#fH2C8 dE+xdTtqgBqb>YIB@7zWr4S0VpUc)zS{|88!XnX(w literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_exec.obj b/3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_exec.obj new file mode 100644 index 0000000000000000000000000000000000000000..af44533fa173165be487a81c9bf34fcda8883edf GIT binary patch literal 164627 zcmdSib$ry={`mhCXVBtKac!x$z#^rzP^i%sFOX)jx!?Wk$K&pOp1yN(lAPq6WF{w>sNp#!@B0k`H^gO;@>@yDKf5S{ zJ~BB~Z~RM=+LNfQPBX6>MT>hzd^* zH|3I~{3LsC%=lZR8cX(#?UMDqlD`Yz=w~I3AfLVt1@TW{BL#M`OUzteWv12l$|8mF zpZJ%X|CI82WzJWE_zpFX$S3|O`Hb5UVvI=At!k2V#v)(ACN?%Ub((s4d$jfq@%3p^ zuVQRWL}X%Ia>dM1CVBdWm<0oToBDhBc?A>pY8My~6jCoS(x7*64b%71N7`g#$*=gY zQ&vgxl&q}9ig?xwjnb!vc8`oz{!2t26Y`iHcDKukQZDNvA!eecMlT)H%5^Nmo?d(I_c!oBK zi4X1N?iv;z7sWP2#@bOCQe<3|Wb5HWVQtlI)rzt6_X-L1rhI)`f}uxfs6u@wcI>NUAr zj3Fv9+>qScSeK$gZQbph94N#;AS^f}$j39Jei+F%p1$?NfLk@w{@K`iCw#XeVkiGkJJ`n7kJ5cA z{?AqJn;lo%E9KOLH(sgVx$_VgJMqFE{JY(aKOa*zrt?Mw;se{u98rBRO)MXNFX`>vTv zWu!s{OVC7r@UMxLR7lEhDzLJbe^cLpfIz8)WNmH395ECaU=?nNPKndUCx;pIQgNnK zXG)?ng?`Tv9;WnGMVMgEgu2Rvq?Cy6^u2{iMB_#`D7D55z;DaNcx%1XA&$g30(nUE5nEET1chji%1rH02x zc1tkmqom4&?`h$bB)X5VWPMy>f+5_{TU~=BsTjF#X}P+_7?P4>W8(G7;w}>}Zrng+ zt>eOzBfCijnBz24;*=>=Qb7VIv?5ZHyDEkLN~D5P4+eeDu*h!V21liS_7g9o%$gh? zLI0zy{&tJZ>?mvN^@NA1E07Y^TUn`~^R10!&s8tsh7v4)*ip<0c%7$jFkg}$U z1S=ZXM^s!`L~KH24`oUhrWlv6kBMS)(|$Ny6ED>6&Ssb zR%&9V3hd1ExyEc_Z`+g2cx)slDn*J4H?Q<`<|$WEl&l=M&9!+9dU_+{;V$a3v6x`2 zOH=i_XM{}ED@vDMQ`Y`mN|DO{iT?RAsiJJfW;OnM2}u@fdIqcFMYO|9=!%!IFmIRTP_f9edzSOv76^1@GWoyo>Ac0q)1Q_z6E^4c6l;dg3>XN4fyH7h2(1%z~n) z$&I3S%7fy7%!}4+cMUfQ2dHrun=u30!7=3LPykNW9*6{7>yCw z4SQh>4#(~|7kgkj#^Pa&!#^<@t=Q+iunG3YKG+90<3Rj^gRn?WNg9kba0mwDP>jam zxCBSwZ5)Z^IaWrY1CGZYI02X8M7)WUuq2-vreJlPivBnq!*K>K!CANsXX6>1gHLb) z*3n7QV)Vo%I24!Sa9oKqF&$^)T3mzca2;;I{kRbi;$}R7yD%<~B<;a8+>3*7ACAET zI1LZt0{jJ6;UV0FM{y?}!{6~YynrY19-hJncn06%S^S3QF@Ii3x`0*jBG$*t*Z}`P zU%ZN)@GcI)dpHiC;Cg(Dzv6SuO(**jE8;8k#Mc;#e_;&1!~XaIC*Vh1jep}#{Ddbk zYbo{{X2)-s1FP__aK!eV$6i(^*$?-E!FOJNL_!I4-N^KqW7 zfCaD;I$>pOhBdJ>*2b=Ai=)vFm!LhqMn~k_A~~TrS2PyW(Fa98-x3d?AD+ShtXWu+ zT46&B!d@7R{joI;#cbthma5l!`evHG5Xut=U zj0K8GQW}=U-Z;9rB=yDl*dH(B0KASe-oe2bz{zL`(g#Rmkz-jJhri-@uKH`ouel%~JMteB43 za64wlIT_ z8tri`y5LlF#aUP%=c5NM$7cAxJjW&Gw2`Dhtb$!|D~987q)z4Q7=?GRAHK%{n7snW z1s1>|*dB-DKpcsaZ~{KW*(fd_=AjGD$6#E5skjg)<0AYOSK>8HM_naJT8(vaJ+{UT zn1oxgAMVECxDRLIAzY5f@n<}R+wd$N$8&fdFW?)zh(#;Y|6y6Yj^*(dR>S+~i4QOw zAEWpj`2=4{tOs>jODaIi&iGfRwUxx7B?)WNN2vdd7lY!HW-d-(KlsNd&3sbc?~D5X z#h=B$`*a-Q;o}bhCxa&?f(ez)0y0l~pu!NES_t0IrUkk&!wwc=3M*^N(v z85Q;29R30R|8XuS^D1$0cQdaN2X|MCb#`}kHQQJRcNYhXkdtLDNAtRLaCda#i<691 zH|}>I*4ob_#Iw0qQ;TBl%`4x*-QM0jms?$nZF8$@nakZ`72Vt|YQW9KeBU~_xmcFv zY_TKVoGn(>&DpXnXN#(Hb8@8dXH<#@2LN9v`um0j1ciA81Y2yaqs2aQbF{1g2a7dy zb+=fytDD6>a&@!J`@nYi}iAGv#2i@SBv^`u{`o!TrJCTwOk2Tivz~R#jaH9FBX zm>p0~jutiRrWJYpQ`S}fS1uEl~KEGyW-vdedH zx2SV_r@B9=&5-ti7G1r)(+_60Xp8oieXqUc@nG*{QRkNDR|k8`J!9`+afsO4yYhW( zMg{x&*RAVj9$~}H^0?Kth}fG)=vU0?2VPO{GiXn5v&0-D3STOrO?W^-|| zWfr0RnMG)8W)aTDnIo<=9vQe5oK=W?!VUa~X2P3DrFxp*;;SmbfD$m3?d zmz^z+aAz+0%u2S{QfE$kW_dWXn@23R%i6l%qw>J6hDdql5YJ!zVDaWr>qs=A}DuRcRKnIK~{fMl#D|(W^UHv~CBB z{>Q<=q8xiSZWU%a6FHj&xctkUgU%;&fa5)LfUd_ZU~d*+M`g}I@0mHki8OP7+O_7k zM?pTyt9RwZZI42PN@RqT+gOE(*=Vsi<<5}tCNV+d{TJhnu(0HWM3%yh8762qB}I|$ z1j_MELV%T?r9>z<9UBu%;ah|ND?=2~Zp!Vx?N+AMi42d8O$<+FM_F5MCTd)exc?|3 z;?{*RV&G0+Ng`{sNTNZX8Wxij#z>4PWl7@hsWEeWN?ZivNW?lW)qT86}gq$GV(QVhe6#C^1x850Z%iD6yCV`8~&o|F=6ytgfGriyP|xr-es?f@rA z<(Ns_Fg312lDPR68J?J&V$g@hh9?>468C0|`$5cOx&xJ{MU@-y#V9CND=0D{J}O4s zJy&X^n-&*0ql=TXi#D@ZWK@`_dSya8Eo-9KfYk8V6ut4bJQM7cRp%C* zSfX-Bh$F{cD?VO~jS@$RvzAl6Gb(nBy%toq+&INaxm~`V-LF@c$3Yd@Lrj;%4dIc* zo0!&vx{XXRD77!PUuK%IB9)a-?wzPt_Gd5R#tP(Spjf}ei~t9Oa{IQMHZLV=hln_y zqO>V-G4aar)J2PYx7v=%krJv+is8!Hc>mhCO3W+j|&!;|z3CNSRKZ>)vCTVDrOB;#hbA6dHdAOFNQ@7Hz= zrCZ!LokOni#_#e(3;tEx+etsXx7~;7-|jqG+2e zraj7@j!($6%JrDWSInlY;>K_V?zRP3CB-Hrdt}NgI*B1(~U%%}e`vnaWTXg|hd{ro>>&dZJ7#Lh})QA?M}+(xNo(ZyKQX$h(%k6tVK zmR9tSn$ZjLIU5_DsK0w!<|MUAo9{8vzqjw9lrCm?_+Mw(Ltd*mZHA}+b%s_fVX-(c zj8*eeo8d?6FUAt24b(Ef`Nz!V$ZQyb;pXuTGoR9khLW1e|VXeRScg{t0z+{Do=@zjoCyi62tn8t;n>0 z%(u*z8G5bK$}RI~mYDOa2hYil!z3m@gwXTH*6jveAK=Ul)XVhEzvt>~i@481M(^)}{+|3#a_ z`M=L08ujZV${b=dG7V_7D843DBR$uO|0$#R|Fj8Wjsx$sIT~lo5uW_xO>kz8&0n-R zn*R4W#3oeC!v7iDb;cM=({c0tZYxZ_Sn+?x%)VOjKgzt7eCvv6nL{#VR<3EZ$ba04 z;(B{ZF|CY@QJp_p;B4}B729K6yHKt8A7!3JzB;9}%w7I5v)GjPrM1l6GG!K<5~W2r zY5jQD9AWlrWwkP5wK;yYcH&CtjA+uvO-cO6%;J*lbOkMQuS}W6+9hj||G0MIU|(NZ zE2Ez_$B))dG?e0wT4wnlGv6fN7bh+A$V{2V+6~nr(Fw^(iQ$o!efR`s&*Q3TIQ7&nMDt29EZ42d~Q(xiTm|p9O5L#eN9#4_pFTL5c_0d+z!+Fp)>Z! zZa4tN<%x`ga1d_88F&z9;z?YCH*qtTWX-mq*ag2}b7YL5+zyYR_$Yc5dm-0=@@PDT z3z4ffc_W_1H+TUH(A8bUipaH>ycqw$2Y467H4qn0avAD@nCyg%MU)%hBlJNod*ncT zjr;K}e#LjF<0AS!7Qrt#6u;sM{DvDaOIF5jVOG3}*)c3T<6m$I=E5VG8&6{aY|Kt5 zh*4;biC73nU}2nurEoE_?(#J(i?`7R!}$iJ0uIB9I0(ay*P|P5z}C1C2jM21j+=2UZpXiHHx^>N-d-Gx`*13rz(x2w9>CN1H=e=ljNiM6 zrSTHl<7EuQD;SM`U~jyN1MmjU!kf4aZ{c0Mhc7T+Hc8IGXO{d}3OUy0=2#33SRB)^ z435Wg_!TQ*9zNz*!CF`iqp&(AU@h#AwkW<1sDty-9@n8G-a;qLUWnroYoHstU|npD z^)MFe;{f~#hhRe-jV*98`r$J4$1T_vPhxw#j2-YZhGKEX8FoS!?2O^am|{5<8B;9p z#zee|25eb`;|$wj3dUh74#hNFioI|L_Qpfl2alnQ7jZC(ag9T@g?rVH^`WI=^Zj=U3!nz@dJu+ zoF6d)|Hc&jgd_1Y&ciP##&>>2#uiK8@D)ng88^uI%Pd$Cv!e^C#vaC@7bakP?1`(;fLkybcVG(c#ol-V`{Fh1hdFJyj=^d;5L@CP z48tM#GY-XF$e4e5ACAC7I3C3~&`DSZr(iXlip_8i`rbQE7$=Ht z@f5blGZ=^G(13s7FuaP>@D8TqT|A2qus~(5r?3S+#2)w<2jUYPieK;xe#LB6Xg@hP ze_>X%$86XPb7LCna0r&f*;oo!V;S6vW$`$c#|u~qYgJ|ZIyS+o*dD84XRLuKXosWF z3D=-AoF}Hi!%D*Bn-g07>MgJ2zOx{w64zi z2&-c|^v3oWhaGVqhT;N@z=IfxcTkV-FdB6=Xb)HpyJICxLI+Gi4@|{i?1jN76<6R1T!ptV9mN;h2QhDLj&lsg<2V|B z!_9aC_u^^%9natmJd1Df9Okvj=p#U{qZ*Tz&j}8eO!r8@fNVAunw+3Zq3S< z&;g&IBfdlz%;rElLhdF@Za5yfb1N^!y0{(d;T~*&XRsk!IdY!CqR3rcxfFV1V{C@a zu{lPg55{6E9FJ`=9oyqx?11Mm6mMb_=5XTMAS{bKOC>YpKf|D=}7hx~l zfP?S`4#BrL6!SWB-G;?*G}gi~7>qMe+%TDiLvS`O!8v#Z7hy3Mj(co{Jkuo`a6Qh% zjkpRoV^&u_Cu2$Evz%;;+mL}V(hh8iJ24OsU>E!a)9?_E#ltuqf5&t@joI922UrTv zVl6z6eenWL!i%^JFX7L41^41r%j* zJc4=fBj&|?Khb`$5EjCUSQuTg2-e3^*bd9!>;`J zw8c4C2Y*I;+>EYx4BhY=HpI`^2m>3@4loKmFb13ByT)8!VMhBZ?FS?#BP|g3D-?1?#IPrQ%t}FOvDA)6aT^_%EPhfv6 z+mz2W=!!#eG!DbbI09$jD13r^#~^>faVYNGO~7F|5qIMh+>6sNuQ#7x&>9zEJzRqE z$TNbJbVJ+N+_P7U|;64n&{V47O z9>i<-3l{d_dnzo7$1oO8VU`xOFU*Z+F+X0$;Fg?6a69r$rhF7{;T?R4pYSmT_;UPX z8+?Y{@da+jS9k(n;~D&bkMVD8=tp}%FZ_b-@hisRH#A_D+3!=SX1bSc$Ho^YriG$G_=U{Vufj;;S zTVmf}+7T|tAY6;VcmPB22)4zW*dCoiXjfPdLvbHQ;A4!$R~UuaTXWrpI_!p(usfz< z4;+ATn6(Y<5&K~x4#6axiz)aT)38`u+8>s{zE}zeqazMOZyb&-aTG@37~GCyaUYJy zrtN5Vcpdq!SH6kM@ByyCzi}mg!_`=#J)b);7S~}CuE!6!0Vj3f`vjbc$8ZfE#|?NA zkK-vU*OB&tRq!mP<2n2bFW_6ej-T-+77V4GU{Sn_c6c8L;{zOp4>5ly&Lh|spI~Qv ziw1m$Y4{ZyrCr+uIfD_{YvhGVcgPR1HI1MRS41nmQBpgr25EB=CRcpTmF z6gI%tk(^I36dPe@Y>M5m8TLaT9E1Tl8(ZOX48pe4UG4zFT7zQhE~7R`AC?Qj5w;Xn*W8D}BSoXhucEavOR z`2!o`cnrY_7>5&aFiye|I1P8=bUcnT@H+C$y8IevVU8HC(=ZRtLr+|Q;kXcg$3=Jn zm*8_;ihto+{DwU1E*I*~bsLKD8r#r-J8%l_M5zbo8O(`$uoCXY>i7%R!=vbh$50I8 z;8}Tj4W7h<_&Z+2Q&=RH>o|15v$z<~;VQg(3I2q^*brM|BbHPUCSr6l*LRqV zNjMBsa0I5}VdPy5@^S2qr?5ZX#ewLWLVHAC9E4qPF!siwcoK);Y93&GcW>YVFJ#@{x}~O<3e1Ei|`08!BT0oLoAQWaR{!!iO9Pm zjKV|M6OUkj{1pcx_oC$O_#2+U6La1lPh zr}!L;_NBd|H@?JBe1$3a8b{+_I04_|LHvMc@gv^HzwvMUg!%jNISUIS@6eE|V)ndz zF2|f0j=6CQ>ToyaMUVcpd+dh1b3=~9!Z;91;Akv`^RW!R!m^li0N0aP8q1?IR=|;1 z5hq|}EHaSxj`fjudB}~iHhQ5Q24Ni(4E9boMXJN}BEcnsU( zaSX-ZF&a-{0-nY`cm~JgS)76waXwzc<#-u4;1xWKf8cR^h$TmH9f~dRF?PWx*c+eX zczlg>@eMA;x40SKVWH8qN34aP(G{)ou^h~TH!&;zi8(O$7}_1iVIDMKKD>?v@FrTL z?^v!^F&K+rJ1mCXu>_`IDIA5|!tF|Tz-V;DvFL&?k$dIxTda#+CUAcjBd`IU!iIPT8{x#) z6t=)#*b9u4Az(j>CF59)ocruE0sS4yWLCoQkh-8otAs_z7oY zuBo&;w8eSojSFx#F2uRG7?0o*`~#QbOauG z0k`1>+=0h&7nYmOxCX3(d$A4f!;W|Wkg@tsZE55~Jn0p586)Pg|Mv_zU zB=*NsxDHR_COn7R@d6&ki})BXW7e6pQ*4V@u{~bL1iXPmkasT0Bk>l_z&n_Z_wWne zN9$RfXR#XoiM8<|I^k>d#W%PR-{K1VfLri09>Xu#bT*$yaUb$Ph|O;`<&Vs$)$ zc6c7^;GbxZHRsWOu^~F5C%U3Px?vl1$8fBRDOeBtU_%^+jc^<`#+m4WYp@A!KyTcQ z&F~O5$5ZHocd-RNM1TAX1Mm|DV*dGDPh&+4!fMzBQ!yM@UZ`{7N6iae2o(@ZV~Mnr{W}>g;Q`o&cOXR z3$NfDv|Y?~FFNCVjKl?)h6}MDF2V7*3}@j=6vM|?<1So_`Ipd6u`>RQ?zkRX;YM7B zn{W+o!D>tSUKIUt8wTSJY=?U=7Wd&k+>aNKF-h_xJcwDAalMOe@Gy45qc|3S#f5kb zm*Htl$FsN%FW_OkjF0gTe2Z5x|8m+XM&J#M##{Is-o|Hm2Xn9BdKmNLJuHiVVj@1o z;rIyG;bXjlPw)ml!@KwjbFJjM7%SjgOu=`Uh97Vde#9-vSS)!be!^q;8L#12th0*i zWb{IwW|G^Z6?VpKsK-3m9rL3YdvA@iu`q7JqL?$C_Kf+l1dhUzxDa`#o4gFmU^?31 z39N|su`MLNo8vz8!E@LGpQ0}|UdQKUY=!~Y3mMxc_s6z4 z7~A6n48?gEh6gbmPhtcn1(xXH15LrxEq(? zAv}SH@e3Zo!kg(|ur~gR9(W3)@GKheJTAZsco;9@GrWu+@HS@MLVtnQ_yC*ZBW#b4 zu`fQwsrVcp;tPC%uP}Kl=Y8yrf8hXphvMm!kGKOrVZLqj4_E}h;w=1z(ss`K1-V|s ztmuc?FbK0_Tg-*MQHPT;FFrut-6%gp-rXo0cJO@~=G#d>f<>?pmc+tX4vS%9EP?Hj zF`n{TERCD7EY{t{^*$cQ@^}V$T2Q`-74Rxn#xGbEi|wXA!R}ZCdtxnohqZC|9{Lv? zhddT6PsTbp107L3ljDMC(G9EarGG(NtcM%1K33Yt=W-0g2G|vO;!*B_jW7{;+*h8A zO>s4P<2U48mU52$^fNdHeX;og`WFm9e+z?M7ejC=@*JQ15ZmGlY>&wY>36XH zFMM9dCfFI9VHo;i1jZweC(9!+8n0qEyo22_`VjpMUdA{qcbI+$t6&1w#6+x(Dd>v* z&>II}HO1h3&R3_n6YBH}m#U*jnJf}?TZQTh{nj$={xE7vbr0LNoLoPdLH zG7iU?cm?O+C!B{xj?u4RH(ZDbxEMDdr~kl`zwvn=t7AHP;u>s=YjF;)!-e=WF2jv@ z6gT57+=|X8xIV%9xB~-lCr-g#I1_i{Jlu!B;eNb_2k;Rd!aOJGN3b&fioNg{4#eN^ zZ#;p~zws;eE_|it7>Vf)6noALAW-f_+bO z9fJMQ%9`(=kf*NYQJ4+KV@_O;x$zh>=2|X$hW-F6V}4wKyophEKTAJ=jj$Rv#p>vT zjM0{Rpe+u?I(QlF@g_QAhjUy9;1YDfWylX_$ZN0>ZotO46+Q7Xdf_WesNoiG%`a6NXxZ5V-$7rB1NPRJN@ISTa{gIzHmV{jt& zz*QKBUoalCU7|gqJNCpzXux1h#&(#3ov;@U#6CC^`{7e$EW7*{4#aAgX@6*kgRlt> z#^E>w$KX($h$C<#j>6w?43@t_yThu;*m$`EPQY-Sh$%Q3``{EDh|_Tq&cvNK8}t7` zd&HtR4}Fj^_HrODz$jdZD{&F7#l^T0m*II_fzNOidR(QQVsl)B{ctS~LB{OMGjKi5 zMc(l%&&SQU61U-6+=H)iKNh*h=LEFHLpTTz<48P;C$H1q(D4TC4L$G_hT<7a#Iu-! z=dcf6#6@@+-{KYgj90PfP1+@v!kg%Uw{aTY!MS)3x8Qx;i4XA_KE}8B6n$>dE-?^a z;9Y!$kMRvwyUphWtbre}7FreJIL2()9C@Ze_QPD5fI1wBdGQ+N!@F1j7vG`X;!>=J ztC43Rq+x1cRv!aDd89kA(L+AX$3XVl%}x*e_2AB$lCmc}4#fFalh+h97j#SPdV zZSK<^u_EfR21cVDc0(uZfvqtP<1qmbVj>kidTfOoaT#vHHOMn5@-5tof8sX$ zgxgVi%y|v7<8G{md$BR@$EkP#=io1R3J>8$JdBU=2)@9h_y&(-u_v@Itb@Pf5IlvW z@eJ<8vv?TK;T1fOH}C@9LY|$GAL9-DjQ23-Q_gEx6d$24KE*Eh95>+$JccjvI=;ep z_!qW#Mmxe*_zo}Pd;AkW;8WyT9a(zL^)dz{?}?FP&X=84P*N^)q(Fa@Ykc zVlr07qgVy6V^w^G)ll~r?HfBI??jjNSQ{UsE%trGbu$jeIyeHIa1Qd!lKdQ9G22_N zpRokGqXX8%VOSr>Vgs~($8|FnCg3ydi5{Qnm#{e|<4H`zsb4tX;~eab3$Z_n$LD3t z`IUYP%i>^kz#-TIhv9r2j>~W)*8E04hI4Qn-p29x5GUX>oQCglF6NZ1r1@AH7h*gv z!lAerXW|mvfXgtum6fy{^WsXJgsViHhxgM_JjA~SZE-FBjO(ymRx9aetcUBd5pKXW zxDhwtX55O~@euCB%eWhBWwVm@pa<^7*0>Mj@cKPNOHD!OnONBk>Y;!$0r>Uc+m6154(zl5S#Yyp3h?A-dobtcTC>9KOU0n5_u& zV-CEHxv@`fD=7~S!U{MXE8{7wif7OcFQYwPM<=YRvyxoU78{`>Ho;EliBZ@TW3U-c z#pXB%eQ+WA;&14OXVD)oVJpm%$4Uyq+!%~`unoFmTWo+lgD5w`j@TVTu_t!IB)r;SOR&bQFg!t9EOQF77chIpOut^*Dx8g@Fo_-+gKQ%U{QRD4r1Q3(rT6>Nsp zQM_-XCZ=I6oQSq~5AE;~+GAT@wc&t~=!gT+35TLHjzTvSujHtQJFq^U#RgclsFlHuw{^MGx$N;*B1m*b_V9Xbi&}*ah!m1h(P@1Ce+Sqfp}I9(v4%} z1M6Wd24g&~zyw@_J+V}2j(_ntCgHD`j3+S#&tfkW?*-|LS<28Jurv<91RRLTI0)|` zzgZ#&^A3<9I01*^BpiloaX4?*kyqd>T!V8_yk2BJUc&|W78jw94d);9$ECO%SKyEeoOf^-uEIr_j>~a1 zuEupJ-bAtiui{30gPXB=MJs6w`r$U*h1;=qCC)c!z+IS(yKy4!!D+Y`XW#)`ghy~a z9>c7at)$~v5`RMvJb|fr68qvg9D^57yyfH)?!wD>9{<4VRp>9!7O&&acmpd`<-CIp z@D_H!JE+II_$S`OHr427(0~sx4gbV@_z)lAQ~ZE0v1N5D=@o|KYaEMjF&*FI1^j?D zYFJ5s<4pX7Yw$B}z%RHJc`u^83$x)d%z^o9a=ydz$TQ+R$HxzCU?(hq8?Yd5#X|V8 zmX%Z-JJ+_7N@5(A!jV`8=OVwIBj3Vucpod_W2}M&Y^|hfSRHF%Kdgy^ur?mDqkqC0 zb?BGS9i1^4T`?Nna5cK)daQ?AumK*yM)(9hFq=K+U2KOu+b(xNZ;Z!gxDlJhF~LXje2a0{jeRL#SZukJK}5XjN%12U9cjCV||Ro2^fV_u`7PS zXw2e7|AWrh9ou0ncEFyv9u2q=c{X4E9aHcers8GngW_E}{V|s_{R~z>8B=f&_Q4@| z1BYUo3;hZX#o0Ik=iz>wkJoSk-o}Oa0GFb8-_8mwhAXiSrsEJ?jU#a_KE-wD!i!zj zV-wttez*$<;BK6advF2n#ie)v#XEU^!Si?spWzYoaOb)az3~{P<8i!%zu{ka0zcqM z{DP-Zytd~o+TuC%#tS$bFX95cj9Ke(oq+cE2m0bwY=zgb4cOj`Okz-?F>4* zSgehg&=#*@9lVWBSk;4m0$ZXxMqxeNj`eX5HbBXf>vGg%Q%puLoPf=62{y--=!0v~ z4}U>_e1w50HRXB*+h8#E#1Krywm1jd<7VuLxxBbe!F<>m%VQYUz;Nt{5jYT|a1ini z4fzVj;xmlL*O-9s(ST*Vx$Zz0OvO={hU2j}F2sRYt{MFRI^rO7!@>9y4#RL9fqifk z{*I&Z9FE2NI2j|GTS-$e4X0v1oQ8vtcYMgpaW?M5xmehT{sfES0<4Bhu@^4GvA7&3 z;R>9N>9`Bm;CWn!)m!j66>H)K{0X<>INXMda62x?9k?2I<7wQBk8nRWXi2|ZDqZpYv744%X)zI;x_YIqtu;Ti0SXE7DeVPCw63-L1Uz&|jbAN>dx z!0YIRH?Te4#LjpNBk?Yd#QV4i|HQZW5Z~itwDqU|Ko5M1-uMh#;!8}#*EkB_;B|b9 zH}O3d4WR$P8u$_I@Naa&FW3&hVNbLw!S{if1&?Aj{DRrhI*|SYi(yVIfjX>+h0y_v zU{frHGq5HC)}#(m0#)|DrB0lPb-B z_tf}wzWx&RI|D1=Ol*efD7Jk)M&f1^tGgG6;yx6sbP&lS{et;e%|jT4hw%y?!5jE1 z-bHSQ${+Cz7R$nS(l`ar;Q~C5Yw-eZ#B0d=3*<5e zlC?l?V<1Hda2uU}0fAxsjJg)!>N7AbI3OdC#Tf8o@8`4@vt(5QULoZ2;~nzGU^Wrt zXMn=m1_U(?YZB1fzo|!1dtN?noSa=u&OE88Iw^-~&Za)id_p+pjdSD_VPmM28p>tL z*|xb)h*xl+ho={xFpSxAD+|bomr&z6Z64N3`BkMN>Xban9HywKLa}jqMbyK;y;MjI zf8lIP>Gnf%UYe+-&b4rLh77h&5he+ zT6AF%S7WB_EMm&rCUf4RB5oEdCSqRgLR$O#Xe(4)i3K$E*LHXbHKJuHDFU88L7v*a zC}oQHX_-okP}2ZkUoBG^QzRo(S!F)sPgxnOx11^BqbZzU@HZIImPxVEVV@IiHQxo|~ z4Vn%QQ|1P0T&aIk=7t%WGwqi~YTUSAimR2=I3u@lf~jl|b%L_POl3F8$gRXp+v2Il zjmL~BcT+WLI&4gFuZ*~|hNgA#&WIb=#WX{+j0u?*+gyzs4fM z$e6OX%*dX3zxk>Y)ct1afBiD@t5Zzn`>Ruod(>2ZKt_J!1k-U5s7_E1EmQthYFInE zOcR1KCKy-Lv_`=h6Vx>_%@UF^#kg$KsEvBQ~8}t6O6~3DSu~E*mS^| zCWL)AL0M7L8g=<@f^m&ZvxI*)MOn6~H;51uJcE>aGp$dgF=nbYQ`RVBI8)W=wX90m z)Y`fl!^U+m9rn>$USr&pxtlQ_-u5{wb!5AvGUFHr4g)^GBb|@l0p-zG7N{KbLK$jqhiQP{Z2B_ZPt?K_1$A4NwDO15799 zfgmD9j_MnO1$1ML4*nPoQ=YGQ||h zly9nthBWu`*YZs>MU;G|V{W>LdItFUaqVwfzZoLt&97H$N5D)G@$mHY3JlRcQ_NCg z#$WVRCz+~ywo<5X0LQjz=gkozvEE8eRFd*pFI7JNh>t*FiIE1qgKJonzH2zYd=-`) z9>Gr$N#%c-iDHZ&yOSgvGBAc%{bwpAB{E9<%o9J@^`D9mIrx#NXuX57jAcJ8LdoE$ zEMv(JG9-pY>*JMQm?*-yTShpm{|x%XF!8fbKZx>50a5FWc9t4T!5(3L`s8j2QOXV% zF)0_Zz;Hu&oIY7^ph4%eZl)Eh)=(TjWR?&qm0((c`LwPEy`GQk`K;Z{r$mamQj(c1 zmvufSQbc&HJ|@0v0@Ywhi4;G$mCKq@<&wG>euK*p{^MXFa#mnvMb5C4nD}G|@!M~? ztSd6N@yizF*TsGiDoQR!c1!#`n?WBQ6&DdH)Tjhb#D^(6>OX`FkXzIk7u)L_JH_;Vbv5tsuUAfuI?fn1CH|{CsO^=R zJ3k+v;gC`{sNx#7MTrl%P;=#=>ucK3m9L8}MLd{V}JzB0Vhx3rFa(pFZ!r4sKMy*S3P&idNb21Rbv+lMY@Oqvp( zUbV5$)$~S%It`a|Tr6l`nX#ry{L7!`yKl|$^nB`!PMr#ryUmwfFO+zC+lUG)8x6?s zKkih{Y?t0L=F*YxzzSM*oN(FG_PpcQTi1p?O?SOffU$8(e8=8zL(8QN{Wvvl`ph!v z=U4G8gc5H!w(}y7&Z9qBCuQ@iJuihX`SN8G<@7mKv+c-BTk`au@n)&*Fa4HFQh*X4 zSFGE(h2f3!Ki-t%#MbW9*sh66+_3*BH{Kt5UYL8l8{t{hw!=6j?8nU&@N6 z8?@;f!)YKiE+*2Dkd)9h*(Nn6DJ4ACMjYfZ2{sP)cJ`sEk)bj1k+CUJ`p~4bL<7fj zSG$<_SW!xpJ~gy^WNc`1w-`fIqWC$WP;tyF|7YuN=j5QI?7IEGFEN(i=SxodHzgz` zM{&~omnFm`{JR3Ewdj9SLTWhMpjN~GtwD=V?IQng`-yL5jqCS+EB${eo1dZV z8l!Ih|FL)uGQA-_JoewzS){mh_*VrOk~3=k|FOaR%T3@HC&Q_R-bpb@p-BlThDiR5 zPe=|IKO_2YTSaV4#J{N>+7)~0-;~gsUo!ny8Mn$n4P%BnF>E!JI& z#cQ!iT8y`^Ds$+h!&;0tovN`ixlQHSs41Oz-h~Tm5$8!4C8d+xNVzJp`f5rid6V)~ zVlC8^PHIicPl@sLiIUPuQKUL5F`hV4QaUM#RE!c!Q&T!=Fe!1~&m#?2Q#xr9sliHY znwrvy=R2fHN^Gf`(n&v)nxn)vsVSX!-azPO3^uT=3)(PXZ_@om7_;L&S+O zdS6ND#Q1xOVdlgbaj&FwVywKxP<3LFYDy=@xl0UhCnkQ)M5J_Lth)3`i7`4|N$I4S zq!?aLK1QM|DV?;M6hrTcF`#P~_+x)NjLq>|E!F^=M1EcqU*DV_9@)DKwN+C(=_gX+UUVL*v6|9}@p;lkB^IovbW#MV3rdX9bxKMn z#>t8M#LU}UP3feOq|Pa^v1&>u%^`JGi810$N$JGcHF58mc{i#lofwxUomOIp)s#*; zPl|ihy=nBHKmiP zkXoa}YN#ol7qa7_lk}w0l~|0L(n-BYtx{tB)RaydLu#cG zo1mt2(tJ`Yl-Oc5rIR+0;$t5BZHt=HNry-+Q)0iWDV=nQ)Dk6jRZZ!n$E4;evFB<^ zCs~!^c}pdhT}|nvBBT~6u@Y)ZCsiZ0P>I!2Q#z?0sRc@`p_Fd25=%p zMMRAn1Ozn-Dhg`AsDnn02$i-dAP+%##AE`o@(50%#DG#u6)Ux|wMtv9wAV_s)CQy# zE!U!@6=V!^;PnMs zCA9t;p?v_|Bec^rLf;8=x6leT!uSESQfT8ef?R-B2yMDX7(;>TgtkDVfL9H4m(Z4L z6!7i?sukKdH41p^fR+pGag74rvp{zW?KzDC-Zr2+gtlEH^cz4mLVH`IfVUT@T4?(; z!noQW@7)RQ5RG6jK+A;IS0l`&fU1OcibiNNKud)-N~3^x8PF1;U8zyPn*_92Xj3!_ zc=Lc339U>cTxtw-o6xE?LVpVMRiWLdQNViy=vJYv(0CbH41pY2bw9gKWG&2b_2~2+8&KC{sK)G+9w(Xyq?ElyGdxd z8U?)LfNl`li5dmG0-&iv8?I5n8v`^&XqRXd@Wum87TQFO0^UrZ>xFicM(B5et`piK zjRM|XK$C=aw?-IyfW9oWdW|qI0s4~AexecPW#~{@HPUC65PC;JpNNuFziA2k_X)jn>_8^mAjz$6R3`;x9(r&P{nU;2srG4GfHdnksj&M(8IkZM>x|w6xnSZJnh(ZfU=@wAU={6HDs?Q)g*d zLuk~)8*FJ`w6rf<+Hy-gf)q!U1e#DEp3^lJ!xtG zWod6%T9c)9M(5!RfRHrvwbE$tCY>wUL+ z*Pw@Yq(;~;2I?whjMNBY0MJp=A578+{XNjpLR+E{_H%&x3hmn(VJ-mln$Q|G!de69 zP@%o85!PTpIYMjJDBzuS51!Ks?Ocrl-qk?8g*HK>fOj*{dqSJ9Q2;*f?y6r_R#9zn zeqM2HQGVZ0?fCrM5WG2|WqbN|#YS^={w^K!g`#{;DLlA^bcZ$0tgX(kLa0LPENZZ5 zD^O@$dRFI$kaWQOF9+YQX$%J%{&)ZW{m~Nb~2 z5SAbT?w|mgNVFu-@Cg(B{Y0!3HEnUA;XTq`S2S{mTNF_knLbwu3F&q-&QB4C^=G}8 zjktK+MJ3_kzP|*A$trq5#>HK*`HJ|l9@>Md??*DyqqjJD1UD4+j5KwrX{-n|>|z1q zoxr-noB^~u)Rmc*ATf&dBvX3$W8u^+lt@x-XgUajs`Iyzu4RU(IXa*5h{x2ivu$9N zEo34>Y$5dUhj@h0H`6*r(p$T{5m6va7Uu=4Y3w%RJZ2oMc@wnamDTxs$9Xh~mPRF_f=peT;}96RHk7TCWi36+d zL2sQGX$nP}3xhRxIMh(2a)cLNXoR%%%lqGj0o({bZ4@2B2vf%pJOw%);2=P<3Yb>} zfsol^(4_f7t}K#rrFAN~7UhQ`i}FLCguB-PM!9TZ-i!d#>uVxQ+ebp_BWgz%IC1(j z4(YX{2RY<^K6xm6mGy|hAEPk#3x(NL_pNcfIj%SKLe*Z0?z0oBE6ih$(ul;4G=HV@ zRMJHFK7^wTI+3OJ)YP%a@>Cs6EVME0xopdx_wn;Y2O-7GSMu-xd;!8|2 zBE`vA7|v?V)wq7aCtnIpdl6<9GIkTHUA7AOx*`=buH{D-EEysZgI~UlM2uK8d7DLD zt;FTPrHvH1);q~Vbyea;Wv4imjWp$H3C(eEX{w zO;T-WPC{y$Bo!NWQ`3`>nxxv$ER)|0Rm)WrDxY>TpbCDSSEZX5J^Y!Js0T^4p-CpC zVD#yG}@nFN>-yw4@a%00RddFFX)4BSBsjM$u&;S%Q}ptR@>#J_sZ!RrK>0J2RdpIoToBi5F;yavXdB zQ*OV4rC_2$Izs8%3Ug53)hI7^n2w|U@R5vWRm#p~4KV6WhkH8 z*9)IzJ$YXE%-BThE%d_YSWk%;9v&NoiDn5W;0pDUYFgSLK_JGCBSNM2$NCU)&KT3x z{7GLZZ4qdyb`<3cg?Z#RiV401;Syjgy23n>+d_wcSl%+^upjP{3;ck5W`c3LWK(m_ z00tVJqBky8j5|jNLHYG?bp*GYvsd}cM+R+%&%P729CvOC)?OL9YMhLuVEiCz%)V=uY6VGb8pClsxsp&9N**op1=#+t~H=B2^AYa9YnKY~=j4J)MZx=jy6-d@^u^QPuQ zLu*1S*=2Yvb#`MF5G#}-a-?bL5H=l#bw$(hQ(_6BGr{zT<#ZjtDZ6g7;W0J>eM_-d zaR%qW>nXqR$&?OZU17E}IEqm5brbXz@i=Ov6u}6{mjsqW*OZ&A2u6-mgigI)Qm+v1T2;hTDIyz1Fsubd zupD0zlt~C3?i9A0Tm*sPCeSc0k7K_9N$+G7g!WaT+OGaf5}Ni{RgWZWsEibhe9Z}r zROTVGT87)^8yCHNoDGOH=EIU$f@~Dkp<7TT6zkco_STi;v1PC@nfd6+Rs;MT z@P{OXsK7=z(FZ^>xrU|{=7(Ns@*7!gJwsJ*q${&fxMNAd4M?c0Ah==dh>@Er&M_H9 zD)Y0#(q*cMh3LC&%<~YFli)_=VY#D+KX6B=xr6Y@B=?jMz`S7gvKu8>^rZPJA7Y|_ zFK4ALU4LTA=r|1P(XgWxvs|z$yVeQJpvtzOj#eo2@Q1n+LMU6|bfU_(x!lpCxg*rv zL1kppt2o-|!&O;y1q5#c64qug5iV|epwk?H9I);V)?Cz0=2f`=r1}S-nVy?HG)I$> zo5B-RbA{sAFw2XWI}yyl^y7$iY64j&mi+-~(AutuV^73J#b=tBx=IzDI`x+5-Pyu) zF_?arorbgBT91?=XYs1p4&K38m)|-5QlhaNG7%zA2uU^nlm;maVjX=!+xiem0(p@u z-G@*BZXdGURXIKUAqgQ=z5`D5ryx{%Q-##(Kvk0A#hee_b-Wd5N`w0zbH40iA``0QYG$kIj2W+PN+GD5?KM=<0Pr#tGdTgsw?~? z(%h@!Dr1CbNLk^-9AB4;Vex8*G28wm(i~7LzobHB=NF8ufqv2I)%wTLeEAY58}OY6 zhOs=Q!wK#JJ}fYvVXvY@dY;Ka&7-3qZ>R2y zy2QFg%k|=fvl;FxPa!LuE@B%2xg~YEyl%@%M0V3L+kcrvRFG3oFFc0fgfcJXu2zAm zU#PAaC8#OGE6wDb@kWjwRNf2Af)G-B(RWp+UI{`ay(*SVqE0O z&e?8M0t7Xsp@%3F+rqgM_9ZU7=^BKX?ZpBXS&R5O;-4gE2zfV)f2wNy&5tV`@`F?7+|LP#pV$neBksI0ql zA62E@j9HJuBe$l_^G9(xmiYo-fB}h8mb_4#Rj4}s(qW@GvFF<5>nO`)a)U#Df%3MI zUZ~nGewVUEQ=shvi3>1DfXNv)m^bQ+8^E?GZG(&lZe$S>KF{i(WHlouN--lQ*-XrcW4&$b91Cx>2!9L(`8Tl=!Rm|P zn98M`gVeK{dJgjG*D;i(=w7d5_JSEQAe))=@CTU_LRS0Wv};n#{M9;!s7>n_6*1*H zrrG6=9?c!0<_;1hlU}%6GzNzv6a^rd86$W%>xaifrb{4sLAU778QYmY%5xI-Zd%5{ zJ0dzi&7cf#WpUY*Pcue?nsNw}#ng7GId{c#xY)0-n~^dk+U+j*y0`;mewWlEps@<< zy*Gm+{-RIq-M=4AHG~lsd!8Xa_Yc<8Kn|!cx8`6_EASV-YWT7jT?Vlb@xZ|vvmd6~ z1@_G%n{wD4%I;lcGamP?&i61t6mxidg~ii{EkZFI!w&j3=6LRM_DV}2Ue)KlP&kq0 z8*ivClxubt&D?CF7nY%)<;Uf+h-=pzl*L~R4?|Uox+)g&z>v+aG_(04907FP{>zEP zUS8>7Z0^WS!F!%TY7Vfh9|Xh24zt#3%3WFHbwR!%NDowQ%fbTaTf$9s`gN$`Cp1kM zVlg5zz3o_tBs3@{O$-|$G(2ddi|iSOq>R>Qo;$WK&2@56E3@R{Ge|bH>LWolQv%LP9TmI#UwzfjhPj!^ar{_DeA< zv4zttL$x^^Afi!VxFaa?9Hf;NA%l=Z=HneO@UzGR!w&Y)$^G7*2 z1w{$>-_gjV9wEh0-xj6Pk0n~ARot%Th$ z+acIig9~eIL@vmdj<=*Yq(=0?PJ}!TcI9CaDcX;4lA|{wJ2XIPzeotUh8f@|f=AYM zh0~E{7O0jYre46XvDxfI1oqy)Sx!)ZJh~Qbuq@Ef3~5KZp#+<#CQDgt~6p-(>Q{=nq-o0GRN(%tJ&| zFQ*end8|E_+lZ=I=^nxdMp)w0Jp&XbsiBoUFEco}VO$sZuSNxARUj3HXOPVv9y!D^ z2q~$8Jm$boe1+JC*bQq4mS7-svckPsS0Fh(CXHSgk2J_|Q*msXYB4l6L8s+ZutFx2 z!m}%Yy05K6Of!67JUqd2tGU8y4@PO=oG|*<6Q_6aNfYla5T`Fbx6(J!eTJTYDMP)rP1=|%6MfX zE6#Z3bWxH?)-I#*>IUGY(cMJcN3X*|BnA7yzfB6Zccg!iwZlkdtfx>!a+B)OJ>dtO2E;(o=R6&5>HRJe+}~Vmf(b z1#rqr9`s3N^d8)ZxH{nAD*bBXLqD>Ugjkr~63%5tj35iuTPnCK%7KhO+YegVUU!M# zUQ(4TTp&YLg%u(;4C1m5une=@VD*p8Qz^sCqVQ3ErG&RbF~r9%Zd-{;7Lshc(VtrS zL4=(27$TlJ%JK$e(Yec3nOc~L4PXw+aQ#e;8R+E~ONw3<#}AK4J{Iv5i; zqVq}<{KEl^F6s*VL(HTESN@hOU`(Y|xSk{9@J?O!GSs6GSun&rgHi@&LZ{da)g#Kf z!oFC&$`Iv7gk8FY%P}HwROJw19b&8?v&ox$L0$vx8tKF>F1 z)s4%o&Atl_mkWs7k;5Wc`7()GhoI8QHWS>CZoc1Mji#L6>wcs^291ht(Z7L%gP>>W ziZ8$zX~PDoliKB5Mds-{x;A$=VLp_pV2_i^!p7$p*7jMJ&cep$PeG`|n`k=+iTZtxAArXQ@~5}slaD?)?c3f0h0S4P9z z!q>+6Z>c!Z_bZi18a?b1$6k($p$_&)BzwM4d?<#hrqsoM?(!U@jvIXuMXV@_&$}_x zL`!g0%y5&R^joRMTxkSz@D>+_)z!!pn@O{1Xinzs>9FTx&jXW%$HBMBMX^w|N-|Y@ z7q+WJ*Hx0T^<}z$|9`F{KZcD7k5ZKhv}w{ajmm)SDTURF!n74jYp{8-2i8NR)-}}~ zeF9zSK`>~%j4w3WdbfAb(48kcQ;rUQK*K=)EaqG>Bc-Kw^f-a7?O8ZKZAw)SB}M-3 zRC552EOaQoY3lT^ zNlP`;+7gWMGPEya78QqzousjjUt#SA>(~OvEk}A=f6&N|G?xZzzKgaSik#2h8jrhp zeKsVv9S&!qPU=ITh8>J+M-`lc2W@8@P0ffwZi*w@PDS;zRrSnUo+Tmb?zpISPA!|! z=KKnx?MWRimm{VVZLf}|geUL3$Rl3A-T`FR6SV_{c4ZzF?sM|5Gs}Qxhlp9yUh<9P z6pk;5Dvz;1&LtTST_`^F923O#@IY;Jyd_+{o{CTA8p2|`a61ar;M3hoSpqs?v4Mo% zS67MSaUpVpCDY*v=J4U#a~C|pnoIfQ!RRT{up30Lq5yiGLniQZ^qSK8qUss0onKJ- zd8iypp|c-nrNaJWgt{u0fKyCZw=q}_2t5TJ_>;2&^ss2~M2OtT34|aF1#5V#dRz_8 z1HsmS&kvDg5NPP^CP}UVtZ^spZ-hzvy+z@mbKzY)f(aQJ^RT42z}rPlc;X?)0wh~?uv?GE3?4Z;M~-YaXnBfo>EREI5he&1<5+hbbLtko2%VoV z@z;?cv1-0ZW9h{kT=|er>Ize;riIyY)!gV-lOFz1O~STRQw*^Yks)v|_662gw;?{m zX8?zEaZ@z8XcmsgX{)>w8Q4a)9G+m!wM_2kc!=G|0FC{M-o#iuFx9jnGHRJ82N<>> z7q$%1Bt85g2f~CZ25TNbJv2j#hvgt3GB-iwxI-Z=3j}2{s@d=qL7STmBdcb^tWq@_ zIh3F^O`M|H{7W|*iHb^u5G{@?h=#P_9h*^E8{#(`Nno3eNiME#Hj;IGv%z5-o$UsH zQwgND>td^`3wroN4ulE1u&pXTu2nT70oibC-o{oXCybEPZBt$^`p8?QqK?Hji64BK6FFgf>-N6kE=L{Ielr{OS2zB?l@(`aUFhDBmCWT@>aRV>*E*3^T4WX{bi zUagU4F8Yr*{e7kuwl_O$OWf4(g;P;O_0kb*w@J`n%MNq!7~dX*PQVQsSlEd=5=pEgg3;%4N(e@NOsewMW-xuQDa4+hK;0vCH4T zi5EJ=Z!04+2BC+g87@6s`(azCB}t~@aT58)P$dzWb0cjoB38`P%H^AB;i;Ab% z;}aS$llZ5Hq%4`!qG05H0K1*|gE(oQ5#H{IkkTqewe`a{-7)aMi74S4r}*oVG^ZTO z5QVaDsrT{2rJJb!cj7a>GAV7KDouoix8JF$=oi|ZeOR9BNuTAkaAO{Ey>9e`KlnXS z!j88|aL{PkFqEJ&-K!^@!eR^BIY=HW(46JCQ9rF+IS69TY>BGR^cCbkL2!F~Kb#5- zZ;xGT2b0tXCMKb5KT%sU4OahBZDz!&zmJnoT=#V2PFcFlqLBovYqUulBjg&8lPtXO zGHL&dctLkkP2&>juX5St@DwxJyI`2EZsW2Mp?kV=3h@4csuGNc8F1p8tBF~~R>m%l ztFv10Ni;ii6<-Two}|kxAfI*Wk5?{o=FP#F-TrHSH$OoYc`oP|hY!sg9;q%pH&A@g(j@ ztN;lW;izUdal%gib`z)4Av&8lRq9I$5V zKvpSvfq1w%1MiqI6CijDx*+HP;uRMl3B_GqQ$B~FpDLs}2uV|EI zYQL(iY!s0dE?;d$A#Cy2E*DObI&Ftu*cXZGkr*7)Ic{lhp6Qi|0z%lTac2(J7YvNQ zt3(I0u8d~yD0%24=*&qWFEW_sQIg9ZnDNP)u&ku+oqs$0vV?yFLWd^QM1vmwPzgd5 z$}SFNs-CX3C;ck(#3%iv@?ch1?SuO6Q) zd8#HlDMf(r0`BO3CQ0o-E_JDtlr{{giz^;J1B7Fi<5hsNK42K9OE}UqqzS$CPTYv< zr^ZZ8&056T^sGgWKH?ANK+?r6?iIr1irz@`Z54w>OYD9yK(KvGK?y!h8t@1N$9nQc zN(S=h=df^*ligRBIG#lnS1=#brf86#Vg=a15~II9mVz@}FAbkzJm>QeP54CXt)dtE z!n(c`Rj}qQsgjUdJ**betKqQPv=_msry*+He{LwJLY_yoP%qlAvxrqy$dM{2c_4fp zcxw9w1dP&5jL;o(KVZoMcKd4mZ{~6S9as$*yBW@y;hp%Tilp`+ZBk-#i(un*Q z(j*_<)``_!R?JOTA;lTIPTmF)yDn4rlZq|t`Ax8<0mfh~1EwFW!M)RdS4%NTv+3aD zzD}pp?HJYkl{Sibg|r+9YT!ww=)3*mItO_PkPJm%bONMy6%{h8Yrz6h7n+9JTWR1k z_~`P)TyU24PGweUHZ|De(f&W}yd-(Z$rc_=GlmA@4%4=Guxs-{)|E%MB=`9esymF^ zVG@gYrRS#`f77tUmIhHrvrSR#XhpXVZ-r`#T{U!&6!erzj(<9DT+!%KoI*=h)tCCZ zJ#Hs7mYqknq_k&ssA{q5jadTw^mJmIEnw3vRWFe~+VWV>Udjf3*$Irl7a&EI)ZIi95Rv=MIE8TT zH)9CyH{)#H2u0sbl#39VE$Vv#n%or-J^VqAgfQJ*aO|}NO1fmOw3x{O~gRw zZXyQooU0k1+`EYw)xVp_CN$^5QzSKa6YX|6r$=*6s5ytRvjS?P`j#W&dRF zL^qH$wy?*QC_Vfk2_Yo97f##*66dZvDZVb@t~&}r-4Q{A0WHA*2G);894$uOj z#{AZD2&Su6e9)eMGh~YB9oJf#U3;X5KeQG?*yG1=IZ=%Kg1uoiH%{;RKX`VvH9;H+e?76A;F}WyaAX2ym%Hj)aYdX4Zy*ti#BDM z+ko-b0Z#jXX|O^kD}0njUFB3u4l?3T+59d^Crh|IU)jj>w^zeuL2$^5>D`+c@&Sm~>Rv~dc0VfMiL}{ry;zGH~z;+Rk zhqU+FWu`gPtD4>)P`t0`!cVlOtyWBttadwEV}Dd9rD7P+cExO0ilL(vL!=awr)4LC zq(>`;(6mN59IVW-@Dp`)wmd;Gr1T9lUuP(})59OsM40J@`JWu8VUBXNt~4lD+=De$ zDbrM~0zXZ&8iZP=)E)!cuDu;fdvuich?Mq*YLSY3>CxIFlx8Kb+36}N&B^PHnvz~| z1v)Rum>#V-LS{@`=UA+l5^7k+0qk0}p%-cHR&f@hurtST@>%lSb-0@+JvvW97{drS zv0+Xk87)S+iRjUZ2z4Uph-uXf{)j{IV5kTFm^Phq1z(ToW(erGd1#@_D?R+7LWJP8 z2u>%?Lqjfi^l0t~HFuCCnN*VebvH+ddT{K-h1)2Hoy0->D^}SZG>HEuTV}Fb;h0`s zma32wn-1h86V7mvDL8>6bs2lHJ^xN7B4Dq>CC4Kb=a&venQ82)7=+kTcmDV@S>~O>!ReEq~vKjAR{vTPnIZo9~>jGgF%M!NtEMSlA-JxpRd_YlHu_>AR{u| zfB_Z?T@UAAk|Brv^7M9?rS0%T$U0?P{-X}ahz!e77-Tp{m&vB}Ij}>>Q0(xhpQMrD z{W>5cGCUoHL572LnFosuTd~7jZHKq~ZyFh1qXRM`!`R0n!(DI=rnZb`;Vn$xA3}y= zho@?`llsG;4#jrgkx1M_f|HD45F=wNt)cRYkpG{y%%QbI^2_%BjA4Ctu+ z(9=*@EZ>p2{hC8=!t65EFV@#Dy$Zal>HVG$(=@`DbwH|mbok73CJKY>ChIcEe5Vcu zz5$g$zfd!s!}_90p6__Vp`M;#56nB9G z5vk?Uftif^IvcNaM#t*Rc*2!ngP!i;c^c(~r$ff1)q9Zfwb~;(yG(S(Fsn0qL}#bz zh@!I-v`2K-M|<$aPu0rqct4HCX6b;8Xv{-lFrN?q?d#_tX=M{3Q)q)upzI8ddP%Dw zjoq)b3VNjLt&*jM?ur;v<%H(a%!>Q3zR8o~1vG&F9T9nY zIVe-ckKV)n^(ZgR{iHqDA^zerg2~i@`NQpHp@uhe* zI(6-?3#@Xpqldq^0;}B^^zerQ2~i-^NP&G=;FolPMu*xoaA8K4`V4DwfO?>?TxTpQ zq$f$qD>PAJ(4+Yv1RqQze608<_;>}$U2F6CI3#=)s#lNj?%^RC1;Qt2)Ki`rGqjiJ zW0fvP3Z*BBt<{<+G3e235rQqI5w`w~&mTq4Yk@7U1Qc6_!GLA3M_LBg=n|!PdXgAi ztBDeW9?c*j7-Sk@a6B1&0D-CHmZd*Vrkk%X(5_ZwlSO3px(F$co+OSQ(L{+skLHLF z95Ib>wE6F7^nr$d@%Yr!z@|gO6z>pwsCJDG$jC@gfWj~m4Ay0SPDX-t5NOJgfC1@7 z0{3VInr|1;NWmVZg%rXLMvjG|(S&&dh?cG<2 z&sjd}p`}{f0PHjt|H$dh2tYT(k#nAmU+YmvDodIoJ-R6p;&E${$%S)(xT`hvjLg2c z0NL{;1T5nMpw z@+0sm?%)_**Jl;(;TW=+DShtwps@k@q4IQY2(B2147KmZCG7r5zcF|>yJ+p39lV=I zS)zE)+lmuY>&WgKoHb|S)D*nZjMaC>Iiznyz91+O)59NP5rWByI)Uy`gU{h}>_z$0 zQ&1rh#Ty-Uu`CgUwKO^hz^QGddA6vx(Jh-E{*W~x%l4CCiic7iKi}F;Tb_v**Awq% z-mn>Dlvk|JtQ3I&HLR8f0oriz$#|kzei#bZgx?D<;U^W&3AUl^s1eFuTWj{B=f>?k;F^5ik4(DtGKgBEE~5W;lGspLKp<3wz8 z-UTYf1Iw8dC$dlbYL5P#lGdIwxOA_^PI^b0gywA0BCb0_q_x?U)n`+olihI|qVFKk z(4t+Up$a(E5V=aJp&Do?`b}tpjaynB)KQs6Ek;_wm7CjX%zIEiL`BD2e4|F6R3vTi z;zL;G0HF zL7we_l|>nZC}TQ=Ec4%B^{t?^JR)#1LY~yjMvZ-#O0gA|CAEytIy=0%Njik-a9Ab_ zX?epCkvOGsX67Atl7&wl7kmM-;+*s*S!DeB&oG(`{K!+9r7Hjk1<0Wb_#F_$)HI5$U6`q%nEp-F8f_ z#b%Xn!n?snnxWv+y*%5V5&GFTZNuUON=E2MLCaW+ITwY&u+G$F9&|0{fj2&zHGB!_ zqXXGu?(R%Izxu~yJwFFp#`JtO3WJ_6(`B}<=kyKq5ajV$8tAWZus^zpD(QhS%XAlf zJ)e&g^}sS3Q<^lb(x0Gxk)5FW$~RD2VSdR-*(|a?>oAke8oaJcj2C6{fbuD}diJ97 zveiT2D&jCZnskXxik@7(l>YCfUqx|)@nNZe96nNq1`Ms_U_M1(kXcS zr&sXNrWE(cK=cDBHeoezI|KleJ@C4I<@b)RotqD%H>)+kk9D}a`R1+x%zZ@?p875- z?5J!6T58E}Jk@>w%Uh zq5~ir(*q}N2Y2`iVD=6f=Wc*w+JN8E48?5~X2=O2n1eJ$Far*0?AmD0*tg-lSN3i6 zvBRf-i_zqH)#>W4iJM40s_lgJXH3{xn@C52JygPUnleT03R=cgdf%&}(tF?-1s?1w z{mUy*>3B|Y&XiHMJ-bf00G*SXeMktDR?HnfsX3iI|5%q8KdG^8WE>2E=IgANKgINh zRg>urK`RYJPgWQ+8CAcsgdw89F{d11gjU) z8nB6GOu^kF6AX>e^;<-;iq178=V7BtljdO~%9AhHgzS@o0u*6qXXYl9mqM?6i0Rpq zu;~iS{Q7`B{i}Ofx`Jvr=ntuekX)=B!o|v$JF=#!s2X;+Tt_zhb4ql^B0Nna9=TQC zD;kWfW8aN#jca-ONr`*2a46E8wYbAauOI%m)b9~EDQhzpH@oO*u~Qw*`aGRV)y%z1 zN(U$<9^fsw-P@!JZ^7}c_%bx#&a+}Y!LEW%gORoIJ)C-h7p7!)3u!w_Qez9bABSn> z8<Z@Z8+hq5wXI#4btc(5YaU<$hvBdK>rTov-L)4@kU>&Rp3-AL zy3+@BMVqqq9Enj-B)Jt)-u)5=C`*P zS;B5+lwb*@p?ErAm$?eNe}2)=-qo^U6*POqAo_%kZ0Z1>IpIRKbhzi9GFc3Pm@BM> zgMVyd)8WJkNatjdqoR@KLE&TL{AbDOraj=CKUu}l!z{r8p}UfZV|;dM4)k*ajA*jp z6@${|OB_8jIhj;I)i-Uj|A3@2U9O2aVc#J0?-+8AO5t(Jh-qIRXPDgsVY6E zIY}X+Au0-FM}tq5C*;B)|188l*jqpVAEUR>xQK`Mv*bI@cC$3f0VS<3ET)>%bV+>bm)S zOc!D&n?c$i^$f+G3Yb|yaK(?aWt`&PoEKgUI*0S63(Awmpp>K4$4H$NlcN;_+CEyX zLz%I$&I5pjd3x}2Cb1#C3h}xjGC!0@PBGNc4<8-)m{rTe*hbXUSla>LhkffgY4d-8 z!!orlF;0^C@G;f%g zl3s|y@MO1Cm)S;1k9MNRN&4sPpznc1jf&*KY#Q;JkutdQCoLFPhd)W<%i}S5h?`K` zBMsB&1z>ApS6yPMpN0*CNjV+i+BuneIA(ZspIL&D^^m!9$$tIMVD|dq*lOZOaB8LH z2L6K?S%oy_&)jgOQU)+u+gA$4sl2f$m?~{s7mnr1J zO`qc{`lDuy1Y0AUGWWdTX(;aRkQ!o;5i+2PpmxCnYMt|5osQiuseE{?2hJwHU4DFkRBvsv4m-N zM`co;yg%F8?&vMZJ7JrXrL~rf?{_66BgZ-!b1?OUNbQq|C@ug@mCVF-q-;oW8rgz; zwHbuuvx9vgkr0R?DSAdaB}2kPa78hN=37}}XQd6o-(2mB_~c)*q=!GmBJ8NmRZ}_D zLz)JV$Qo)YJ#AZ$i=^o*TgaXrRw%e)Pj|mtZ~ywVKLnF(hnWcfv%aA5nix*416t5X7Pv2g~88zk)^? zWW;iBMPZl(mgzEm%gs%1WDH8MTp_h?xvgYs)J@A}R9Ds8ABW{$Ps_ccGZi)#Y=FBs zg`EXj#uT;{-;IF6Ho<8}L%G+99@kK0yXI%EuDPG?w~pg5@k!GU1a)$QJ*L>eMlvd82wf~Sjw+dRdj*M>YeSaM$5vjKJQVk*L zb_^1>_BKt-)Q$lRBw-uxb(ptl=kA7|+1h&s;n62^+yPC_Mzr`qx(C#ju@37faEJ~o z*Qtn_BKMc3qGn5OpM-|SAgAf_Y?6?Ynr_lczLiXM>y^3Cl1CxBH#wqgYjrM^(XG*U zz9$m<6C9&@NUX)JQK`@qNRVP{w96Om%;%rz&HcXp;q|pV#bq7&W**X199SWl*AVFB#sc*`h9N2EF|WkWW4?EFhUPKb>m6OTe15+D z^OzgcH#E~h1y^SDDaTvi#ylp)Qx3e#nEG*K!c&f3C7m~C835jGvrF-=UN;@C_O@gP znNrrB4fkNNF)`7!IK6}BZ{bD}f(X;mKBSn0Y*?})VJ~))-1U^-&Ds8=hdMqaxo zv}ad!kSkVt_=8vp55%r&QGT(hm@5Q4_ASm0A4(@!ahq~@NO!2q9zB{pLR51Ngle)= z6VfU~Fch}{LsPM6n12O%4Kat`_u%Q@9G1SaJ+qws?a!i`)r^`P2H_n|J4r@(FKhf-EL`a8!Q-lLypB5~&-EM<65q zr1j84qlOjH+A$>|Mbj^@2Sq=@dm_I2p)8tU%b7=c^XT}B7S=6gkV z@4@*T>25sano@TRNUyuZPjVNiA(D>zj4YA5^?jn&r8G)?p5^vP_& zZ^B4gR`j+^D*9|N#`!;-&yk|1L#`1t7DyJu2<)nzp-&hHi_ovGL zh8QiYd}Ah6ei0ah%16QZ9I1Q`O(#p%HAIP@dMHJfR>kzh ztC$o~@rQL#@ldGPe9d7u2~VDkr4#lujttfmw%XW_Mht2pBg>t!U=Nxf1Lt$3`7p$t zQu7RGi{|ZT9>(64R@nA44-u#bplya<&;tDzIweTXJNWh4ZH zcQ*A#J+L81uUYd}FJqII4Y`&(c;ZO)HdF+)<|Luxjg(AmKfD;Vu^o6*L$Y%9z0oV@KdF$8!vOk;?q6aDVz##6sL{ zV`H9&nB;CbinrX+!yl3mYVM$NGO4y!Z@R-5nR%mji76w*Q_qI)k<03lsBEgwPM%kB zjql6vQgN|Km|TlfOvD!o7m+{XRb^%^2{i1(E^_pbH7bZTl+wYoV6Bscw~5;IiTmh9 z|BDj3Vo$ndTYkl1FQL4SzkvI1)ndzkfn$W%;q^X>lI)FNR*UPh8t8ULs+Rm9^7S$c% z@Qk^Ls_x(xtDB`YxwkTPb<=39eM_A;Xd!*OwkEQSTFCx|BC=*Uj)0WNTDA~~Of2N* zPSRux8H_!MmK#JyEhJY}x4Xl08!aSPTgb}`d`Y?0?Klg0AFZ=xk!93E-mDM{`8}L= zS_niY7V@Bz)D@ZZA!f&U0U|}u=h-y1F; zuP%3l*wDz>;ZEEb+gzsDN!%EV-pNg^(q0Ia?HcvzzyfZcrMdufL5E*!G#HFwAUu)$ zrQI;vj*Wy);;;4=;qP`h>G>;Yb)&<4R98v1svhQGE*0(gO~K!l3ePXYar!}6>3W!_ zp}5@}S{Z{7<0&|>V>-Q-a_>oy>^%|rdr#t9!o4S=o=eo;6LAeqoqJF8a7w>~dr$Om zO234APs255DWvh)_MZMYADx7J>grp8)`q6hnVj#90b{86NH|6TYVWB5axs(yl`se@ z*$4*$q{E$trRO^y*(PF$+9o1W+eAe5R0Ow)=yA4*==GqAMZD!G!0Cl;^@RGF4LEinQh(HR=`66+(a zhO*@53q7{;phr3nWqtp?8FJyrwW1qZ-4Xa_Cgm~-j6rV`;20?=xok%T3?<~OO`$Lb zK`uMsKpJ$ET!?xtp|udzP%hjjp~uRF9+8Xe|J?+sd`PK04DvxVEx!beK`Ix*F*1Nu z)b;-@uXW9?MYfaF6`xw#|D@HWeMVOy*UpyemcU7>Zp-UbR999ZM>t87tNZ-HwJe`C zOR75+PEvJS)~?yfIN3>>T-_b5F3U5j-CJ*z>XyMts&32LHM-Ej`t_@_ zyj}V3BkY|6|2SDjf-3a*cn9uX9>A&2rw^mV&TbM$2k*dbL>PA#=uNS+kmhym1AkS) zgz0Ye)Sa%QL8C}BGC$cdP1N|`a2z#4e)W1Tnv40As~wEI?Yd=->4O{E{DvK}_uoc5 z2V6yO!Z_V&`uXV%$@+O1w2bLzI10mz;8b0vk|yoDll0TJV}Ea;nI*;K%Y6)J@z@_~ zHVUIQ%z%!1xsOP_+()Ed?rTCu{K?rcdSI?>{rcrTQe=X#ZwgH41?=2(nhBMG1HT7T zP5gS$GG;>WO%@aS8=Qlpi667<%~g4Tcmk znCGvD!Mxs?1~VEQBpS@Apk>Tp8m|+Bc?Qns$YAzBgDDM$0WBJg`_kK9L}phaW7B!2I~yWE1)pXc;r10u%-l8m!CwoS0BH zG?>za7|<3IYWM4&ImnnlF)4cDO^OsTsip}qsSTakD_su`634E~K+Bj(y*XY?>i2Ly zM`Kq{XfUNoF`&&R_32(L%|#K`xaf&DE>gs}BGD$^r+8#`X7c88ogc6o&rl zR$b=jq`&F|4W=|M2DHVv)GMq-YRIFbUSTCle1)|yvb4rTPrNaaBF1#~)i9=?!D|{G+XLza)+dp5r>*P1S(0pKcYv0$KI~`|1~coe%lw>}S%2s@rI|6HEoNrl zmp%Hbw8FOU%Z6x%ur#x4nbG%US-89}OORCOl)D~z>7>Jewo1pmFUw+6zEzgd_hrkj zK%Jp@P)>Qdpbv$3wYc3YH;IN=)518j2?kMT2PSoaMov|IO=Un5_-vrHzNPUoA~5y zOCs~OC2s%JfTV2mE;z!<$AY9j9y(i4D3-YcZX9vGu%GD76Qn4~FyM;+N2 zLpIlTaoHS&=qQVhWz%@%ycIp_ycLl;Z$(t^AzPleqQ^OJMXzO(9$}LwXy~!$t>_Up zdEQFWkWHST`PQXi@&mLVUzUZ44C|nyUSA?o?}`zL=6PI+o`I;lyk|>~XkOL*5@uT; zmu(SZAX_>rTO##V6p>`h(?0YJG}+Q4*^<}yE^NQD z^zYV0nCwlI;wDS~wvjp6QOsnICL~K=nmHkH1d_$d+E$b~X7JXKT%^1*Ucjge@4{Sgi`ecB5u677$Y5I&fyBJO<4&fy(cl2oP2sL+T-(*sCEn_ZHI&8xbu14GONQ&ChQKPM(jY4onTT&0k z(RSPzs3*l}JCXI-m`_KIwt{4|CGtmG@yTdQWJX)!8p@QTEjjk7KzkoOC*}-XiLw)Jgs?poY8jYg~+x(%N@jLAqKLg zqp~GZqb-qS%h8sefhJpe>}VTdrp{=)A9Y`te*DYUZ{QU(nKRl-vh?E;lF0_q5lrTc zwyl(AM%zDKfMkz?GgO5FXr(kW+CGM4cC>A!C^OoYGmRN-TPeqkwihyu9&Lw_)rUFS z9t*_5jUA);*FLzg-S`hXJY;ON`UxrmOVZ}g_<|I#eM&9E9=*%$J` zbw|aRI0K~}UOW6tCFh-wia)4Jj2{eWq2whz4&tExoK+mZSt6u1e6xh{5S>+%eHsGf ztq!2+ua%INauY>9b=enN8m&t3XD9{|9G__kHjjh^FF@hOYSamP*1Cfw$f}713EH;P zRSI)Vipldm3}|tu3l?62Vo(J->WCPTIwD4-j);Yk5r49?K@aLpb?YNyq~Mb$C$Mdh z?UYJBg)a#V>(vG&e_ttiB64Cm>1LrF-b}u59+W&3MILY^vudJbf+W?Y+|I0ojFVzg z$qZ;w$)=}@Kg6|2Yf)564}ZQ&NiixVlPOg?iYlGbqYWzkwo>V&OslkT1XOxrCREC* ziAo8Q6qQn?RgiH~OsbRtEvnQ#W>t;IY$l>edie7dNs3VOGvC>10`;CBSeSm%%tl#{W6^rbVQ`l+nO6VrPlNhHnNUBgCh8|hQff-|uY-(}Vp9DKXp8#Qft)Z3M8{4? z9mpX{JdpD^vb5@^Ctls87v_#ivT4Yne^BTl5e37BU8m1OGl2jQKGr)4Z=k;Rv)*wZ$3BY(k?tOf>ZvnG1#KDA&V|fi-;1aNNF-xp z+WSLb-y88P(bUzil)o2n!0wA@b;afhk}Nr;&98@{CB>x8GoURtFQ_@sqPl2hmXeRPiR=t7QTKD4gMA+u4N7m>z>F9(z(J!5DNNwEVOlnUlTV6vt3t~V! zEXetU@a`@lRDv~+{*hCGG5mAQKwn(J>b^(G?0_Fl*obmaGdk)qo*-Pw0|Fl7Z8<`< zXnM`&Q1vp7S#oFw8~NO_M(4aVxboLLJ%KCL@uk>FabGd@9~TE#K8#3dx`DC|-=&*- zGK6rtQ(^{Bcr`*|5RID2)59MmO$fPffzyePhqt=i(WAK|)ZC$Ukx5P@_P{YpI|x3a za9_S+M;^&Im(>^+6VETTKGSIQ+e{J8Jx70a(3$dgPU<{U-sTz$J^aCx31KYT;dG)Y z?{K-JM{`H0xq~T_$%D|8e|^G%Hszjp5E<7^{|^MwYB#+Nk zOo)?@Y?}+(c=GXAdFUpuVLb8w|Ko>$O^{SZI z4m&OD7X7xCh~_W-$4bJwgh2R8qy9)k6;gW@BXv-ZFt4*D8$H9k4Uwn@5#&BPdIsge z!;far!?Ph~ZNVC(T98Etb8;AM%VW7+$P!v!o@p(Azdy8mBMLWi?_e#nLZW2?Z8vDF zJ275BkaX;EB;yG$fg0%P9;Via^1?Ui*!5J%b=o7xkxF8twbz465F#{9M;*{2>a~E{ zBa%i)?a?zZPoMjuM-FIFdn=G1f1*8ls4Hr(k7#cf;#%#|!yn2gg!Y)gXpfww)ZW$9 z-my7I*V-cNbfvx3nvINU@6Eo@-cL}o1JssTA<-TI)KO27;(vLbRwd=e(LNOS-3fgh zg^5xM_Gt>1YoWFZc1@-QTa5+%ffOt&B!VSy1>5pjK`mG&N-x-(yR}`gYcnm_Ax9oq z!LmXkSOQnD=`EJ0DYamkD7|2N^EIM2b_MmB7VN8i4y<5VArUNrE7I` z%L<8L30%RZw^#_)SS%Bz6|8wacpVNbV;W=j^`G68p?&>#co-T(Fc(3sJRiKx#B0M- zK~A3zuP6$^WGd~R!&y!STx|{T{e_=IntS=r;^H1K?&BDLD)>ZZ+!x=?;a)jvUz`NU zjt=(4d*K8!pLEfiVqd&fBfierls@2-=9yqN8bjNnC^-Ge;5PUk2#B*VnfKDeAJ`y- znD@fz#J$6PE_d{3?g%w^&^ejp-r+hpR)h_WjN6%?Ot}Y}Gsd{xyJDluxrJTPQ}v|> z`5x3uV6){tsK?u~J8`XJ-3Poq9SNSJ?`UJt8#}NTt~OvTblSa5bbowq>9>jI=n^`5 zo5*>9=sXO$o4w+YfU=|(pX(iyNdA|!f3Bq5|9@&|> zQhT_=6Xqrjb?4<_lZIb}p+`1pxU#25HfgvoLyv6Im}nk0X)qF}7UD}3;$PdcF3+eC zOR&$=nh?#Vq}twMwMB^B-l9isZ)uMR@gnWF z*7NYx^=w(6YVW3ndj6sY_(C8w_9i@hAJ^R_DRnU!p(`;F;v^$b3Dk zDEBwXhC{?Z5!aDB1}CBa9o87@+3+8pFX$GXvmTXQwj~F1l;>xzLN)*I*AWuP>e4kk zyW1g$=5!DA=-KPA!-Bbo_x?hkBaS?(@6r8^>3{68$I0*b^xc>zS|87Uk!%u-wqO+4;c;uLz+Rg;muv|8v1dS)c(6iT%-A zb!H*1V~Xag`pR;^-M1%5FfSxC$+SIVGCRp<*(zv8FH@9P|{b8xOmVY{q$7g1SCXGCh6r zM{W%tD&`wIBK8nd<&gDIXvo$Og#Su&D6(b5^LdaB4yAe7-hSBPv4XC}L>p&-K>IhA zP{#=3-4Hkl0@{<<+df)Q6bSn`pzQ;~196}cc;KNz%YanqVjvYd9#3@ed>8Q!#nVWI z*1*A;chIgwbcOQ3h~lb092IZE37&^1ZHTuL2pIvbKFOdz=bIFhPWHS*QLAikI?y3N zUA>!ux(Rv)sH=n?HPED34b(+w?*ggNvj&;a9|9@bhnBWru%Yb$Qk>p+ilO}!NYM(0 z7+R%8zXwvGR}3|w4+1ILiKiM`6_BFUo@US!*sxKwfoB->{WDF94}etY@9`qH;(5SX z29*P;(6SMR)(E6%gK>w7O0f_~(YoMfn)e{*Zr+3o6w3DQ0#fnrC^S-=JKCV1Uu4kp zMFtJN#N^j_sX_IZ8FWXnK`&s0SEcpCI8T)A{rPHRb@}6r_P-9KICu+4ahi*((3Ndm z57b-IzGl&k@rHKD1e2oc7Y(Y!w@Xwmw|>Q-y%t3#8QS|6eeXI$8$Q`sY~fU6r}L&8 z^wf=}EyRFSTX-KxwS_LTJnuE(^!u|-ye1$OF9xLIeE_85jk(#xyA?>qs|Hf>RspGa z-dq#!93T~M43LUsYba4ItW z6Htzz^(%2~P+IrvcN=s9Rtrk!w*jfpN55v!L-(4{#;=?Feh;Mbd;WeC`ojkdYFum3 z;}03M{o5w(Ux8HG*B|yg4prIS%kYd4$EMsDfmG;<|IDDWpBq&D3zN&wfK)EO0#do0@w}<;r9i5_ z1GktI*8`~(vw>8K2+UQLHvC0{-ubmbkNmemi?=!@}LZ)54)7~&#%>Ytdl>#ZQ4*in}y#Ppsjs;So6M$Y5&Aj|)6R%s7iI)qc z;?=!nLN^1cT>cwKg6S@RQh1LS8&~E^}CS~NkW8z&4q~hHGq~gs3Qt`UKYvL6G zsd$$Isd(1{sdyjnHt~iB5x!`leeIBS>LI)k5r7dS` zZ-aXD$fNTnzmXyV-lq~hHHq~hHRq~g^NGC6M?Y_vaih|zut z&}`BEv;q@v=@};8hBHmP=YTLpfQ4;1$I^hV5ZYu$9`3zSDS85_ z6ia{(mEOAs=pxbJLsuD{&mL#cn&~Fz`(~IF-vT;YQhaZwiPy8j#9IgSPYHb-2pu!* zWj)ZJ1w93XjvllIpq+v?0{vD{BM=56gl++PMbK6t3{#+O1Nx1i?LaRJ+5v=N3ZXlJ zekbS+APi!lH34lEv6#@NFPzdPzf{KCG2`T}4Owf3sM+Hp; z`j((cK$xf@mnlHs6*L{_VL`Ki>IKaK`nI4_poav7fiS^A+Df2j1uX*FD5weu10X`H zfiTzsEeFEj3A6$T12oVoAPjLptAQ|_0j&YT5C^mt=mSCZKpzTv1Zbb2bwJI69tV0~ z(0ZVM33>_$gEn$$0Q#$-jX=8uH3DU$Rlxp$_6uz*&?kbn0sXI_?LZ$3+5z+*K|6sy z67&WThFj#)1e7Ic7tme_-3^541w!`#4HC3sVV3tRL92j%DQGniCUl6m2IzS~Yk@Wk zst4L6=n`lg_#fF2Ok0JKKXMxgrzH3HoyXbaFc1Z@RcEod9i z*9C0{x>wK+pyh&g0^KR-4WK&&H38KK+67cCXg5$q&>o;wg7yO4BWNGc-GZ8d1`7Jv zBCj&bTPd_`pcR60fa(PG1iDL5E>NwYK0vn$>I+mUs6Ws`L3uz61my!&2pR+w7Bm!S znVMeQ%Xr|EC0nHHfIM8%K>w%^TdJ5f)>H~DKpuRvwg8BoE5|jrt zQcyn7d4dK3ohxW4&8I4pu>gM6Mv5vlxtBRpc90~^0;f#RrZM$$^)&3(6Wx{;vJJU%~S4MUe;0I z3kJ_}0$x@wTR29c_X1v*To2jzgpauN5QQ)Bx*g$pRb3Fx`OTR>ZR(sEv**p6Ke;?y zRxvH?O-LdY7JC1q^6jeg?dN6n?uJ}WK;E>9EYP#@pJg59<>a!L;|^yx(8$9fI^88H zc?i!cn=y5|U#wvyH67eY9dmS^V_L{_?hVsewfGFx+u!a z1&uO2JRvT1kQnz1I&L2wmv%y1Gvytr>8GWX;oPa=X|pCzpBkR(P4Kaie_x&UFt6(o z%#&rq(xIEI+&rg@V_Ga@MrpY01_*g!I4)c1^+fQ7b}V&+p5{!RHoszC*c1ISEL(@onLT%QSnHj1=v~qXeX=dfqg{ky z_qpEunKR30geNbUF)cj5Owp09uc6Pt9yZ#M#0R~C*GOd2_Vl zFUzj9w8>M$<>9GiTK5cF)|CcU2ZnQW-44AR%> z_{tj5e4H}YOBz3fw#GCKIt`>YeKM0cHq+>pLI$&^&T;CoMe@=19G+k5#^35qn_3#K zKqcp({=Qtd=`vI*pT1qUo0%2!riIy9#kf^{jstHyJvRJlv!>4W?Yl{6%AbcgyFK0B z7R(U&bcH?d1s`+f%&!Qm9!lC3>-zsScIH8H755$Qon52_gjfUufq|@Hk!6t9JNFC$ zytA_-Y0>P=Xm(Z?h|wOi2b$d-W@jZqID|P3HpDVu4x7qRzKxSIRjHIi5)+(qD4a_E zGR9@Q2*io0vRw#QFec@Y@3*hlJuGovMc(;+-mib%{p;>u_j}!syo3CjhgJTRMaSZj z@`%s7JC+uwYE^WA*&4?=V<6Thp${{SzIr-T$`6Wxv~T8F#sKx(jj(?Sb+A{yx7te=G|M1x%m{Zq^kAgA&Uyi>fZxbgYdhXhadjdY3tTvjpBY`iv zC0m|2f^I;svt3#55bDj3#>~|t{r|ynnf95tnWs#-gK~z%0CZT+u-09Do^DJvYvDxI zG^NgRH9Dy0{iwEwc?NHgg@{28^2Hia=bH%hyg4srd8jAt{AQmr{xoT?=}>b9+XMeK zgqoafoN>}+`{3fr!elKNSFqJ>Vxlu2Fuxw*k7?T8WLOnZezrB|j<*Zl@$Tf^D=_;t z5$darrR8~!tYFOb*)ht&8^otAmIq^(^&YVGkUibbQ7OcRR;$)rTqTdI#A5AOtBQEJ zU`j31v5td!46@D7K;OC=%v?LgYOO2ASEHuQ83Rn)nEAY^`}&}?&3=v;;ncNT%r=)+ z8dbE6nm18TJ4bT}IJ)q^921<1P0Z}IZ4&sG>kzDaLm8(&TTE>FJ?jw8!KMx@v-++2 zuvxdUEx0<%;XcRC_CT+vQ{GYQ@SU1(z!)HBx)CtnPN%q5+u0S^kzrwR1;L1$IoV z9M?97bUXLLF8&i3a!Fvu2N|CK=P-eB#bopMUa1c zSxo(H-I0j#xV`@S!Prg*bXiS%xak6ab&Bh?{z0v8;wNJ~`$wP~5>>5xsLeLp*==j) z#b?Gztv{vpxi05D_K9Oym%Hn9Jcpi)z$fp29>kMay{d+yz=GNeXd%oMY~NYfH*GYh z^D65&$$D^YJv%?eamR=#+l0JJ$OWmD5g!|jTFZJI@)=^Cn5j?9F3T}Uc|B|$tJas6 z4o}wR=7aS!@AU}8w(4YaV(PG*zd3HnHz*F=teN#1`8i@{zPXImBzlYKKji0P{NALf zEF0M-XRTb-3mRkpf)83_Bi)7So_eCtYb@Hk7m>-Jf_t#!mj6mQ}Q&y~!0Tts@))=Sz}`}5sRmWO&w zjQh48vzN$%2W`r@(~bFTW%_2dYSTWVUJu%u&ztUZ7xg!-GB-7mXS@GsV~cB}?HO$u zX$ElLtPN>9C2Gg;5Gfm?dLth9P#*dU&#|Ev^vyMB=B)q2SM1})S4SM5T&91U*kEER z*Nee;?-VyfkFn$yo3^8ebuu<@wLB!__Bw1NQ2%z#H)Af~o2CWG4g9nDfH4j*KmHB! z>=wtNM;mu)8&|Fx6WBBGcE~oG>?#fzw6WnX*fHh3TiayZ=|#SbL->2Lp! z2_8HC??rm{6~y-H75%woSAS6znUuyv;R@X zd+AbjtZ3zsl1I(`PATUq(6OwGtWc~}_ZG{;)uG~eVK`IXFQmOwcyATH#-te@*)dX4 zx@*ZCx!dUM-8oXpjg>OloM0JGl{S5Ln$<-avO6s3NhYPxno3w1obw1_nNI9$TUtr`>RjvGR*7q-x`hgEG zHu8u{{|A)e3zJ{3mPfR`4^tki*fzL?^5{rGBHhm}B`f8}$8?%Lts{}vxr}W0c+T{t z&00qx<@1k_jh8A#ZD)(tkx1M5C|Pb_Cae3|<&;asF}FNdXy)d>RWmogZJN3E`^jib z`{!enb$yLb24p(aSL=ke4)ZfQ5i*&XYUild(Ma~^7#TCycH&w`A?1?Ic50@YU*$8Rne76)?AMy~PMhxv zbX8Mm-Mr>*TZ{&}8ms&Yn!9aO40ILNc1xP;?jifsZp~~L(Yob;du1C7xL1x!z`Z=j z$t(LyIoV-UnfDlGI*iV9ui>&aljcy>gR?67m(ywy{fdN)dz&y0P+O0;0^GrEz zBO5AbjC{M6SybkC2jwgkl#Sy?cItAcWJN6Cl+Gt8j|FM&GP0BAZpox!*=O#tGL@8_ zdljQ$sdFFYEE`tczn^kJ0(t+Fl*_^W2jqPTKc19!@=Ayy%S?^tRT->@{L<%#-n` z!RHCHU(M$sKG*Si2s{2KFJJYU3x@L9>d3GdH@{#;zQcJG`7tdHBAhJiXDRNx%e`vs zJF^|-y9%&waa3(aqs(M#pAzpPoIOvnP2#A9e8sm~!FbM>~>aJ;>O$dmPYT$k-T zDBI>$>s6mxT0DX?2K*B|gFT6Kd>^{{K5w;JpQ^UzvEixqVSJf>p?^QGZTy+{&fZqb zzIW=v{-)f7YfQ|Vcffq6>{h&9pJ-ucwISa@JtA#Fe{N!N8m^@e9|P;7?)hp)4ca!Tn7AC8BbzgP&ebELz(1la5m))x4)rD@Npxrj<`*^Pw z+}3T)Htf~+7w{h1CfE0$LK(NH`?Ac`ALx+#xZyxK=r<{S&-5ie&klApWCFwZ4rV7< zePP1x50aI@Rvh*Puzko|wIKH_#7Uk5*?>OwH13(}P{-=$Jum`RJs-k$e+_NT@h|W$ zw^7YbnHYu>ca&$098&V4kvo;VWaKU-%XbX4cZ!tra?hIb8YM3n{k2NA>G>|XQO&o^ z{Zo~^V&v1LJZj5#x{~EsrTukEw&goR$_05|fcMuc*_P)_CENUaq+GK0&r-5Yzd^}1 zzq6HW{d10z=S_JxD%sjUSIO2t=Sg|Y=C?`7hfVtPm2CZWfs(Dg4@voettJ zy-3M2KgL>|sFJbvPtaey(6dUcWgOx;8pcR;a~YS$v^qt*|q?;OCnx3wFw&nxTkCFJ+}>T!*Z?RtT$J^ivmE7W;|IN~c%Kc&{&yli?r?VvzJ_5A=p> z_1Y}rq@MqKsGH*soz@9aK7vh6WlMBG-acQePiuJ)@{ZbKtvNqcnrLFm#pa|*+l6~0 zivTkdQ;4_BbCC8&YpuDZY29{|m!?+`%Vn9mAqR$Jn&V7UYA!Wu*ifj_**s|)XeL!!SCRh^bYH0>`i}*v zFuIY7rzUyz&Hcxa`o;g%J(&?emQu)5uI7G7EYudJ8a%!&FP4W_7XM!BRV8IgAh3^w21qnxScs4ohkl4Tg+BE5s z1akj1{u|*oRU(EX#)t5|pC!o@bS_3uwM3Tq1ipF+NCLS&yX=q%JK#%Ahp;%}^_v_L zqoMz9I3$h&inBeE0=Z(z(Md3`a~Bqv|ZNjk=8$j;==#enJ;S<=|>l4`N z^+*J%UW&VxBhYDigst;0F;^!Foh=@Tp|kFZx;ioF?Dh%D{Jn^ygStlqznuu`o`9Xd zcSm=OgXck?pe^=#ggvv@C$RHIzmr!i2|M5N2z&2ApFn4gN7B%l*yh?vL+9ID9TI2j z{QL@!K<9Ozpv?PSg1Se=F}LpVIPCP|8(Z6d;;j1%_+mF8>|+gl>l=_1yt)nF3kM{P zyw;xYkOce2tLM5Tf_nYMIWFP2sN<}TwUc0!_`VxgQRbMaxMfbnk$dY*Hx<#jGeBlo{P-62Uv{ufVkNf>2*79T0t5+)hzp6Yf9Lv|cfO`yY``Ol}g zBo6;v+2xW1Qa#z}5%~GtkW1+Krf>+n5f|sU-bga~MX+KDa%Wq-_dAEAIC6VD5{BiU z;FCL>DiwhbfAy|QIO6{Fw=Q8kOuXX~*6YQ$UBYp({=Zy8&+q=VOIX7BlMYD_Ak{@a zfzD-bx;l&-`+w;Wcq1YB1s!W4<5-$=%J=`%(Mfaee&uH_VGMusb&nvg^Imfad-!#) zx+IOdKmAjOga-x^;^iNEBpet2^COR7hX1Em9D*_@1-~a$Wk$ipMyyhv|DmH39zd76 zw2j2XzrXD3#KkjhBq5Hpk)-%|8%c>D{=m1B7Ef5h^5DaGargySCk%Id`5%0e7IQv9 zM+~=-uz2@*FBOK|3vDDS@@*t0HhLt2LHO+78arImE;Lw9US`FJDNtXA;PY>>{+lM1 zTf@Zt7j9zlDBj`}1e{%*x1n44~Cc?97m zvFwwici#!}JUg+7IMGI8VtX4&iRl}>R9Mtr(MBTTcLzNkOb@@<SkvzjJna2st50Gg(MFQuEPT>x zOBfjlr$q^$wmJlU4&xJ7m&C;*TYQof|N0T1q{NGsu%>TWkC`~XHbky2IWF+@7Zt6| zuAL~N7XOPH%w4V%5N*=p%_D{|^#z_ClFcBaml-=GX^_8^&w9PE!z&B234c$)KSe4a zJ&@K&qTf)V&tZK`((x+l<6nGVWzVJJbbp_GXVmARmBpht8SF8Af2LWhi9Q^w%NL8K zzElDoNFQyk9-UaOF4m6L=ND_1&A%T7C&ZVn8W~O{&ekIDM`2Ui1%8?|Wfi7tGZQQI z7Ctt@$9I7#oH(uW0IJnHGEtwOuJSuLT~m1^R`lsQYN?zn<>*5YONc%Na2AM1 z?)s7gsi2}bXdjXGl#WzLq_GM&o;WroU)>s!`xvu$|H|X^eQGDZTF6(6M{o52mN z5luPp_84m!eBy`yvk)7x>d+@#SRKJJ^V$#(`1e(?^NXVd@;F0ZB8=6rI!cUfFwc?P K>hhf_$^Qa)3fu_* literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_fullinfo.obj b/3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_fullinfo.obj new file mode 100644 index 0000000000000000000000000000000000000000..ea216b4de3c88f65f6cfed5218c246b3b26c036a GIT binary patch literal 10616 zcmb_i4|G)3ng3=cKstnE68;4Q972GIWJpK|Aw`}1Wg_|4`~i*~d`#ZFBm_<+Pc)OmerOctyS0cVC|~wvTM82YL9gfZS^RH?jE!r^;FINzWeT* zc^P8GX5Y!=`|j_4_q*Ts-M{bN7rb>gHNA07N9h`(5;7i7Fs`ZkkS3F~8%&nXOiAi= zkteA2Ci{!K%$%(*q5$OX%{LGah?iV-9$g#JO(D=TSwx}vMAsA=;9?Lrb?ouPf&o2{ z7R&*=Y6;N>{P=O;=cO{QXJo2eHt<#{!*cuxIm5ng10i|^3VSY*bJe-s?hOr%O|?BO z-7U>^HAUf2uNoWFi>9K;s&DPi0NYy{+G<-Hy8t)t>S*umu8FB}t-MO^!wG-1cdwtdFi=$~Sc^grvZ;o) z=EFt$IU(c}9kQipYe^bgZi1$SKV8?3P$C%!ySwycFcfu{mwC$kJL>&)p@@H^x=INQ2H}Sq z_Glv-se?f(t!;*~ozmZw8c$nex4#Mcwc%)dpMR**Q|75Ct0>>%E>+#7k!U#DA9a^D zDBBx5+ZtOcHY)DYZC$1A(i=9rONWD%WmVPgQdVrnRv!q(gRwwdA2s61K`pKJRFp$W zTf5TL-Pv5<{dooKj{26*E1lgf4J|Fm>+0#?rc`>mo1ihBtnaX-u5a!}%2&IiQK@fl zYii!6_+U+|Zx7k=>=OsG+&&Gl#vot-htFp|R*w3U@VZPo&ylXtSr> zKhuK#{xB--u6LL2qC{LJkH??!_lYfXNiVObSg`jqby5G2T3%L$Iiwdu!WeT!cA`z> zlGBlZ#pJ{D4o^bY@aQp~jA2X5sK7O1W=^GbHkwB{R;76~%S;xxv~4V-sX+ObOrSaw z*qjMeWdfTrfyzvvA`{q{36y67Wt2O`^eq|b>WuW}jC55-dQ(QaG9z7)k={s!l%GF_ z_!gom+HHY&e{xWZ=t^9p#mKo0Icr4@R*-l=5%YdNGVVYIFDdP|;emio1%Qqs>6mRm z8p`JZ;}va%C=Y;z+yGVzAc47RljaPtG;CH{oTZzWF-?V|Q25krB z1?~%=+d;7kj`f3LwHf1%^F`1@pjbS|9tOp_HufB-3i>W+A7~DAqs&-7=w8rb(0!m+ zfkr@kK%<~HfDVKH2=q&!kAvO}dK&Z=&|iRl1@v{$anN(12;Ep6`u}0jZJ=KV{VM34 zpm%}Z1Nxt!2;108p!b5Vz#8>!&{d$vKzD(D7j!r1_dsKy4}c~?kAvO@`cI%oKz{&w z9Q22vKLmXQ^l8wOpwEIn4*EXm6QCb~{tM^^#Q7=Ea?qziRnVV;YM}oLIs*DE=zh@W zK@WibJLov*Y0!&^V-9RzMf37o(W=Iy$gv#M`U1(YuIPbYtX63LIr(3Jke9k@l~zq3 zhz4n)#3&nBM}U_e9ZO^(W#`X>XgI0{!Wu8*NjQBu5FG4PSvSUnAv&xM1mX(!=Is1s5Q9uuIx{Vn1G#p{wbU!k z4VaURQif@wK+;-&#YS2Vkros%s!w|-oy$kI+ghX=+luV`PLxm#VHn58#xQ7x0!lcP z(1{DB{bUbl0U(YvVp^-~@otQ2O{Yabi-C%Oh|y;Z=TE}fpH;9X5!$bz-aI7PSv}Bi z_{+h(mi48)5yAWuikwCN#~-WOr!v;;T8ge*Ehf55K^BFvg!BJFxTDN1yoc zg?q}ATRMv#LNx-v`IqY+Jn-7XI~Sg(Kd%m*c$MhK0(U)I{lN9j7jD{d^;6&bPSrQp z61`{0?}**?#{2#MYu|q8?;k$ag}zvgie0vS1HKOGo^|~8iiPi;Jo!F^_Y3^Aeb>h; z9P#exS=;3CTl9Y;dQ#v=cK_i&zQ5>$(VxD#f3WhQE77^%5qQlX*XK>1_}~|-9^def z*{^TGM708SxNLWNhSfR#(OVz;+TQjJceE-9w!m-dKNi}!;l%p22h>NjGXF860|LK$ zjko#LZ-}n!;H~!t9^AlOE>+elsurI{eb=mg6xNhfdFaLP%-`w-3`%9nsGA5Uu z0za~7;K+ReZ|)yX&OZI<-fyB&jtV?}>bZ$x+gtU&{MHLgzFPP7X2b{a{|)j;t?|d? zwzN-dO9xY1;2~pM%AL*JmJX@@P(%$UgPK1v9E)RI_IW~)Fl+hLZKK$vcn1FZ8pGI( z>xr3YNa#UKYctdkiq1>{qSikX4MPF=Aj5EZLASpDsF&APNi}BJczHFXUf4XBsb7so z`a&`cmstfmn--4*!ZV4Ts*lFB87YYC>FEEJ180UVM1xuYVHiz>67sbu5Q#+ffF6oQ zW;#0X?mm;~V0@vKW};zqC=i~J6Ul_81R{wLjJOYT=p0OObLoD`Iq5ZUs|5C2$vNpQ za76;UAUP*}0B)tgc(=uzlbo0@-2%&%oRh8qccs9tl$?{+gIg}JGRZmV8gR=5Rx3Ft zwSl`rV4ae4k^*k2z<4*uoRebU_}pbK>5_92@8x(uJ(mti&PjKITP(1?e|Q(lg)|2<$n@Iq4;E^9A;@jedA9SV~0+ZbUya+?pz*V|L#On76Yx!VvstCvHvzo|svA4&JM@py1eJto5`HjyhVioJKBKo8tu@)tqd=@r+C?1ZvBatV(;PX zb2Y48M28*Yn0T{{X16$oW*sUHcKwGv<1IhoA@#d&MyciUdZt%@g2#kH3hgA{+Go(*{L~X z|7%%a=ibP+fQ-41T0;O+p&Ym9@w0ghJ|huG`$dg7pO0pqp9LHB{pNBJLpMpJi|Na6gZyO9rQDByec{9d2qZI zIp{PvUJV`eb8tM@!wEcmB4j?R!8qU*k-?#L@bb-=t!J(oaUFTG>vbx6HS$yP86YF0w`Do`8nEd01G zytBJ>QN=8p1&nQ&Ez31cYeVXtTAqK%6M~-UaabdK%$7Rq{(??<=rL8{6fo@@?wCZJ z){&!N-a-d`4ry^JBi{7izR1{IVA*6IrM!KSV~T*X8I+huEYBU+qt+uW} z9es)cv!11hn;R!h;@nW$!dMAKaIF^$1fi4L4fBZo3gG5bHs#3f)7x#iY@eEG`#|PF zSx*L#?h98!kJ;vKsWX=x3*9h``yc4VHaUijJ|F^PY5R1$7NLALC3IYyDZMzYFyqAK zN@x&gC0e9kAHWslEI!JyuY$b!tiR-NZ+e@j@AJmNrDB|^ih_9U7b$p(`Nig1ZSixB z^fR;1m!xpJi|0ZfyH7~pi-e(RU-`O#eZ@_HaTY1tn&n*R+qyb{Lr$F8$UemKg@iNV za5SkKB}5FbLY@iaX&t!JP?PZlhLq^5>rkc)`SE?mm}A}5gd0*dDLS6A7uCWZ zjuloI`_+&)AMe!j=V@cb^_zX7)Dja1@SH4T9omq>Z7yzKQ@-4S^SC$hiZote1I{+5 z*A^RXLO#!fRVg{Ui^q+z?%7;cU0YJP-Bly`MVMoG?c~cKzV_iYYib=?#2*=O9p+lY z{hWQ}evUQ#;<{yeO$H}Wjkd*;Wg7d{WtqR_oZwaHWm`uA9P?Y zo;!@GL-Ym43TZe6R>^TvhkDG%O?|hceB)SOs*-$z9QwWWln)M z6-Pa>K)*Q$b05nlfrrBZT~pMU7z@`4oxleIkziO8SS_$(mJJ0(x&djQD2syq(fFv@ z2CUP@I>VuTnlYBxrX1T~uYv)mV2Lu@P_!3h5iAAAJYft;*>uMGB-&2qV|`3#%XxwG z-7M~7sP7h%pVdx?o(oG>P9F%D<(%ZC%77wZEn?tET3wh0a+S?aU(I>f1>$M}N?Ob1L zG?+wx7dB13f)r)OSO(wR#58=vV%p^f)~V^qcw|Q)oYYL8vRSsvxTO^O$7l>l_dqB? z9-6Zd??HAR7afQ>aLdKq&dMoi40Imn=6eP6=04o3;v*tYC>R|&PLq@T#$)|dOsojD z-P|RnJl4;|?8tH0cnm8)shu5#20`o{}Xj>5`jj_C?$JcH|Jxj zMJw~?e^Z|?At`sA=J$G3EIvXkz64H2`1`y|@K5;Iz=W}hQ*ilhyoe}DGv2+lxe+5+5k^Xn@*b}tiRsZgmdnu$enLouBdI~+ok z$>K(t2TnXs;guDhR$W_NG4Xl zB-9_vg|fL!JlUVj5BA0~r!UWidlRuxED7dVwwNuFO799~^Sw$`$72 zC_*29690N?*Ft#P+)r%rwskG-n_5@R{g}!dTd&EQ<{!GeuD<(hD|YuM&}e6ir?yLE zGZ9f&*Io2?T4z{eyG5j=znC9*>nCx(+LsX0E>K;&MLeP3gBo&Q`^FbN_sZNsgG>AAB=b^xlf;kh( z%Sl7dei*LR)ts2QO00L}QfW!?nUvmCPS*9B6wa5svhnLJ^}=b|bRYCNn=6j|!)lC?D}Q$dBML5^eYzGSl#USre}jVuW_> z24pw40&-Ek4)AKg9>4@(7%&eACym?#7y-N=un&-J^aE1sIN%F_+W=1hqVCB1fP;XO z(S8!}V!#xj4{!${eVPHJ?~em-E%N;WCtQUxFW^%6N2hVVw=GLD1nAKcNrylhMMWVn z4AQs|m;sZIpkNN#Uhn9OXR^6;E+ftbd9O)MgcX(XLVuKsmqyU-@j{a;iV-h`n6k%< z&*VhBun`Xksu4D=g2Ng|%VEiX2M-eCCkwbvr1bh+jQNZJXj{(vGj|08~co=XB+CrR;TmtwcAUpLPz!iW`0j>u8 zF5m{hrvY~Z{xjfRfX@Ja3Gn-X2LX=)J_q3c6;(z2M;4#4W0Dl5F2KW-- zEc6@39Qich%YcmOR{$CNAK+PD6#HmX#y)fst#15NNyol@uO&mCu~#A?Nh%!v!M`>iEvzbK}os0S5PWc23y z`mkAHxC|5|ar$F8dQ8%;cr2kNEyf60jl{k)MqGHhHF1$c#YjCM_u}y1NCRL4;1z(4 zfMLMP0IA{-t(&hZVRsv4-7ehF+k9?EQXn`Cav<=hd< z#&Z9MD>zNfF4&D)YHj7Z+yqWPlv?k|6c&GFvBHGRp!R{WXb$w4BsB+GXVCd5`vx8) z8lAzSq$;Cxnq>SBlR+oii8iXllhCxcFjvrazXQAo@GpP?K+GL-j{Ga&4&=uGZvYhV z1DkaMVxALafd2xBm*bIF04D&ljfsHt*GBm3s-p35A80dC#yN0P!C%((*Y>vdF}|Ze zdLV9m=*u7;z8n`FaW5kC1M5FO5YwPk505H?M`1lplP?m z2ek7YfF8g*0T%+^4cG>VwMVXd_X2(qdB_-H-LC+C8}NR>=K&7_Qlkd|xwbwC$lbt0 zfSUmy28;tf0(cYPHvn%1{3hTR0UrgVuO9HbhjNGNUfW|S0ZVx11K6F%0W==6VBhXq;jLz15wH>DxMkV zq|=xxAkEX3(=M%NHn+fLw9D@S7XbbNumSKC;1z&x1BLd;{W?nOIHj-`(hWBTw0|c0^l|h`%fE9 zz|*LSmpGLle1MF5?3JbcYXN(ZUj#^d@_np$zi1topB-mU`?x&AA*q7fJ|ty7sGE^W zjmb68lVdUn$T8Wb_5K~kDYv3}9!j(%9Q0zZnlRdzETp|4fPc-Lpna*$q^P<#m9;9=Tgq$icQTbfBU+GWdbc3Lcg9fE> zP~#muC*XJd3AdxC_Lom=jqf`3M&+#^zW(w)ydbTS^kXA8ZF&9Pr$6|~J@xse8|FTW zmL&a#pD%pmre8j`WyYxZ%l!D^H{?4TXN%J5#rB^e{=dD ze*JF$@157&a^GVIH#+6MAN<<~f*qoB!lBz5X8ifdC*KA0^-##|c*)uI;q0793d`PNTO-mvJ-*XRCb@E^Z*hYC1jsQ#E$@z2oz~x9Gu&|6Ga% z>H@Ukb}U-_j`xju$D$oy$W=b+eE%*P^PunOKNw%U=y1&?H$|R^`MVDau~YJY>Eb}! z8;7o%w)NJLiT~>MV=;SF(*OFKSGPSi@vT>f?%BGvYWA;wjs2daAKKD8=aH*!n7Z!3 z%ah7~@h5Bs{a6Iuj?e!6Yb~{}F8=Vuo434mXvx1-;e18XzxRW&n`iI5`MtXazjW_~ zhhF`L5HCvlmA75@wdU)-@R#ar`P!O)%Kt!!$>o%D{mTot?ES@eCV%dpcOIzy(e8(Y zSS#rV&Ko#ze>gDpzn+}<(o@^+hEr~r^vuy0_In+_ZTb0^e{#X?EAMQ>+5r3i3}qs+ ztUImGn)~Eg^PqXIJ*3W>vzD{wp-6W;8A;@$vF_~7G`>OP`s(7z1f_iJS+G2QtQ+{- zTTI}DJ(oQj3E5mU8tXet3Gvj~3E-ETvym_qMjx~p&dligdq(8U+?0=`m3n6;oZqAB z&QNqDmF$b_&Yz)lxxq|^6K7+wNN!g;c2)v1xq{9A#^G|7UBKaY7-qo1bXI@i2q%-N zTsRj`CC_$D;H%`>SO=pDUOF2IyN1Gvv+6`X8w-V#**KKIdl}}=Nr02ZT^e(VB<4Cr z%V^9co-t`hP1dB%@*bZ zC5^en0F1Xt@+CCp5*^bFTBpWb;s`Ll+e{YEXv`&MPB&;5YRo0}0P{+|ztfmYd==ON zN&C9S(6@b^UUzU`ySE~^=dG^x1MS|L<|FWoX!u!hf4jHmw?M_dR zL&Tt2P1&*i&)#?G50AeK?V3RJRy__RcrVrV2M?4t2T>3Rq9hR9bJQ8!{|ZY6j1H|p z2Udu@OEOe_SB%b;gc~YRp=siR}2hy$w`9g+PE?s=~3M=#k@J51+k2hU8KB?oAY zMyn;$M#Da|<5QOOo%|KHWym+0mV5;S?S+CROV`Emh-7WDTCy}NcZ=vtgkTK(z zF%y6mjVGV@aBR#7n*k$iS{W~`Jj?cI7{-HaAN>pFe{Rl10c9fj2+ z?9Kj8Z?GMtVDtXUz5B~Qf9bQ}@qpkNI|>;CpPO{#eGJag7Ls63OSNF6@(ZjV2p*`s zx_$rA;Qr$@w;Js7Qx8Qo$*|fVsF;sSOX8NJ z`HLl?>brr;`2s5(DCe>bG-UMsBn{5-=W9Q}Zre*C)7F7&DbFM4nbGMqo1ctiV_rFk|UJt8l82slm8$RG@av=y&u`IX1@i z8jA;w43{=xB9*~*@((0K&@lVf#Bl?&$QZyh(fVu!t8lLIv3^O_st$YwMIWag#Bd%8 z7;&w-V8nHgJ+3_}e!!2A!1$BHS*m_iD%3#rK4Xy>DVwm{fQuTrLKH&6e21z&KdS#pDTU z%Uv!O0OMx4Tr9-~+AFc&08@2)u<&!6RxVBeQ>F7Nj8bl(mE>oDaT^IfV5$bP#(f8( z^16aV@Q#*5oT!!V6~Fgga3;q7B#T}VD*xgz<=JzEfZ-I z%K^Jg(i~GAV(LL0DdJwq%pYpltKsJXr#r-Sqnz*@hd5_t2|i7y#a+VT-T~+kZ=Z4r zr<;bZM2_1SMx3|X)Eht|0YYuu#Llg9_kx9p8t`u z)F*(D`Z}@6nu9d>&EdYlB5RhGbsqZ5IOa{0PvK$wl-XjbTwDk``+bqFLs=g18G3!% zq&waGzDPSht$jHce7Nk92=`|N{Ycprf+xAVLh^tENCErTpOW_VfZ4E#SKDNRL&bDn3K|Ue$0H$q`$_6Rdb#{OqI6=u zLZons8>ea726I5GwAhgOsp!WrKG3AL_r?ZrtJ<&u%iIFDOGCYxaAZ3^!6@61K26a< z&cymG^mB!}MI*oCXj_v1JbaAW5t3A?D`_(YKd*+Ay;6OBym>?0vuu_sleb<%@>)cp z?F&_zxa68)AuSUXMPF4lI9c1d?Jw!N1-?UgPnr&VvB$Lwhw2e#}aik{NvO9 zF~<7>bi&g-(AOZPr`pRyhrtZs@|XSck`|%Vo$@ z7hYxN__B^$@-nvh6zY_VCgfR%S72F(`j=VsS+42RFb9y%vAF^?V=iN!Yv~nQ&Xq;{ zhMv5(P-wSI1T=rM=ARAu6h%GB%Q=P*=L*6?-HD<_*X7kkt@AVocq|KWT_=e3x*o5Du&uf1C(n+oc47ad zf5!E7lGuQHh99kM@rF{NopRAB+flk3IvBcdMwwyXQtcZ2)B~5cM3+St+hjY2tZQYN z(`~HpQ$^Vf&dant_KK$#mR!TkZ@HTcjOz{SUI%%s>qXrSdOhGi#rVc<&RL*Uh@EQj z*7FkM#Lc-u%@}h2A#JAEX%d$}AFN%@9<*a5k64jU${QfHQ0Gdq$(Ds?n0u&OSnGBa zx?NndUkQ988p8g8K-FVhMNp5vX4~WUbfHip62k9qVrr$@WY5zslo8W14(hc*`Nr&) zWnF+Y{@5TL?vH7^sP#e86NzvRSJKjQ{@p5Nf<6#VMiVhf3xVbppy6&d=hj~2gUm-z zu|JjBW!M_Vt8kE>h;NUnb%;7uItF_~SU^KqY7AdVzknA;3E^8y0!yrRk(%qJk90ZK zxk9m?^I7iE<%6l@xbi4;^r>>GGx_}v`Q5C(z^vC5lr`xxLqEoJz>$^}44Q}i1}!ld zPFrampye&JKJay+ZRJ69JR?qV-;DEqXFtk})Z-|q{WNVd*Q+D7rV zudC<#JQI6?A&oSGCjhG`ok{sB9-d|>eMos84>~L_!j%ci;rWBAWypC8lr+Q^#)z?8ejBKHGT(J~9bt%+37lGrm)mp+((nA)tYAekp`LGTqM-vkP47W8?bSaJiKQF08)hryG!Nq!!bPMhRkfkH1T z$)@FHEkn+S;OT+m3mRSk!}ZwYEC(fEl_M>$Y8i5_1J5fqIXO^xf>h|~ouIJqrarP? zsutzwamr4}$Srg5_t*CHIArLzad}hN@`GvNmA?k}p0+rj^PPZ!i#z6 zl)|q_w9q1=7GtMc4Qu~7gIzP}^&$qlUL`oRaD8i4=j^v})m2P;TO~Q{jg?}t$T#B0 urcTjpGHh+iR_Me4 literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_jit_compile.obj b/3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_jit_compile.obj new file mode 100644 index 0000000000000000000000000000000000000000..30941337c86e7cc6a52b8e5363110dc970d291f2 GIT binary patch literal 367149 zcmeF)2Y3`!gzx`?JOB#>qb%{BreDkv%$7P@7R?5d~X|>8T}&kZ^y(H#ik_}BuBm1oPVe7EdIrD+Agp7hNrUKwI#QUi!BIF zEr|NO?}n5y53t?hGuSbf^Nu$rV1_2e<`)0F%nHVAxU-yTdyl)_?d(FFX&VLNX#!tPMwsP zoSB)Edi1x)=LLiQca!t;GbUt5J|mzb{EjuRtT6*kObs1>pYG$*f|JKhOwF`weokRt zYH-|?jO?_WDf#1aQYMbmt|*{$NBhsvUZv(_4VhkdRxDk(Dt$BYQ%ikNf9&W?z{zYnaq2Y5!(oH&?3~P;2|0n* zeG>=u8#bih;12B*1Fg>)-a62FY?namDQO+scJ3Nztq=C1w;(+uFD*AYuV9)RrHa?q zU1K}6<3oldBn}@jY(Sq8Jreons6K;xBn}%fxbNV>yf=L0P-Th4kt6!^iIJCmhDN;_ zIA8>?;(Lwim)Iv^NdE!nB*wEl`Q7XiXx%?2YDbjT|0bOSt}YJp!{$$OzslfZrp$RhvOz>@}(pC1X_DY7mx7m}=gHn5>+%plM7{b%N?q zeiLGXS-Az%60?#EQqvPtsC)RM)Jf(Pwy9L=Hsf;&v(xOy8s2YUKVxEHR<8Z_pQ)Q0 zQC}y-q^1Vh>|{RXAYtxidBKZQrWFJevvUgEPpQq@`*`~#`zfKL&NC+xyo=zm#9Km4 zL2?QO-hTWJ0-M-_%crzYvm0(BY>eHIzt76aCT?rgc$q-=h^a@DGxIa12W@x};r;9f zj4#YiEy&2p&Np@0em=3267?a8wrOd|I}Y!ZwMRq+l3HkYCQ*NEwDVJW*Nw)kRUu^#Tlk@yAX;6A(=zr=^|D_oCXV>uem zZ?PX9#MyWV7vW*NAAiP2@Cd$+zu*r16?ftvShYM6)xbDSF$U?RdABCLlCus$xs26!Jf#CP#z+>NK; zmv}1Ht4RL~&%?%e5jMdLY=)O$b9Ar;-i)nq4aVY!*apAEw%CX~*&ffu4mb@v;=R}j z-^9-NJ9fdA#~ITVM`Aa;61(F{?1`)KO#B|>uu^4XdgBc2i;J;8K91*LXZn-zI0y&e zd>n}Da1hq4V$2Y1iV64#4#Pb-0&ARL%t$;HN8xB3gFzgN_u>V(6UX6ico9~pN@b2` zVKQEbDVU9EcnJn^9*)PGFaux4iMSIp@d#$&@zspU##p=<2Vovgz-58ZXCda4ycpEjSNp3(WP{6>q>? zoR9Nx0j|Y`_#Q681GpGFQxD&P4&I5+;a&JVF2x`4Zajkb;GcLe_CL{>`*A+5z*q4B z+>Z}pn_9*^gv0P*%*IDC7azmN@hMz`PviUeEPjrwuzhV~R^vtZJYJ12-~xOJAH^d4 z0M}v#D%^G08`ontZovC-BfgEBu-Zw~i`Wid!32C2lW{9%OnjUKgNmp2`4smD7BHwAsA)jF?;BgI&sf4YOe>>grcpQu;U@lh0%dk4$fHm<+JQ0hq zHok=?;bE+cWlyHQ#M*c=cEeM!Keog%*a|PjGw>R0i??GtT#4;*9d^Jsup@qeo$wRv zihp7^Jdt*seRpbOPi%o_Vh8Mnao8JsV_zJN{csZY#~C;Pm*7BDzj6?MNAoj{^(<43 z5*JyhrVLGpp_((zBk$yAYWO)JSdi%T!xDpec{zEu6B_yJ=zj(1gsK-r1@7;{*&d7A zX9-08iN1Rko6{vQ6gRt^8sqNk<-F?S+gGYCyRTG*rZ?q3v_$rGLNGg+ms}7`W3SVK ziMF?-UbDAlasP6Mzi0bE)Zgg){rlT9w7)O&URU4#*5SakuQhN}WGCGHb%*wO!SGIY zjryjje-f+e$;T1&IG>RaWB<_hU*idD!kQ419h{Pw$@sd!cGX*i!;>?a1t2X|2ly!87{txMikE||-lFf#CI39HADvLg z*#mW){egbFGZxEYHkQZPSOIUsint6b;Ujn)uEEN<8IQ-;Q1SF35_irwSRIL5DO!FFYTK7bg|_U@rE>ORyhah67P?G6)rSnXH|B zaaWfx?F-!$v!3G%Eyd!F(Yb0bML{VGd!gZcTi$Yqq^k35bSR%H*jw~nii@(?G!!_F zebe_}h}wsXLi?(8_V4TaO8 z8C5pVL&~3XJ*td8ges#?qsr(Ts4}TIu8qn!7qa@xTu*%;YZun-#8GImQ^d&yIeCf9 zil!vm7(062QOg%qZlV)SpRc-Jg-ZX{!uyWCb08`{2ch!OU~G=(qV{J9YQK|Md;0P_ z-D9KA&@Pv{-+95zU~+!&@9w%kkL&Zb-_d#eJoZQ5ISlo^!%_REvf9?Sf6WNfu?1N7 zMB>%0#nKD2Cmo|GDmv9hx8-j`MbZ9+il_2h6IR-7O*`3G_wT#DTX{Ho-)ReMT#v&5 z?~@nozN=n4)3@*GgfYxD6Iefs?7Lf+WMt%%~%0rYlrz75sy>J1NzsxOo0WL%x*R80uo6hP# z{#3%$hfQYv$bbBK!K|Fg!T-YXNBRIse2=&2yZy(yn0?j$+>SNy4m=H)UQmBR&rD7UX4=f^z2}q6s-#pJ`{rvE zb?*G7`yo1F<<&5a2NNuynemy*4ty7>TOV5j!iu{hfrT%LWi70aMU4d%P|B6I2NX;HDXY+^yY~HaMC1*7s)T7bG(NaXX&w zcKSTcm`Czl3+gs+QCt=AqBm>9P`LVaia(8?R6+x&G-!lpBJGhw{b!otWNeOCBlES+ zjo1>&e@YwYNo<81Q2oKTkUpYAyK35EInq!4L-i-=Gdg^>>4@~JjQUtZunP{yu9$@C zb7iCYTr*I8t_M(kF13Z~b8SWSxjw--{2JBgI)bFEQ&P)UpI|b6jmq=Cqw;*& zvTmMlgUa*0P$Z5?+bKfin~H@EXj=l~{;R;8fgz({LwVieKSncmN&z5wFCu z({{;BKAGsj0-j)%#Ojw1~XmEjk|6z50^5q44{OA|2x+ zsP_C(tb>oC`uZ!e9X^377vyzY7e9sSZ#|8Z@EKG;VHM8D=aBl_tVWfO=W#8r!4L37 z{0Lvdy;y_?k!{>_BuE)Glqn~G8QA7UqDpPhmDG3xq|T^PhqQRU|| zyc&1o&A11bA;;+4hhL!b(>_$bOJ{B8%XiHQQ<^kljmmd!hO_zNFFIGsac%kIs2u0D zO$zoFeUHB%HIn_(caK7S|LD+uF6ZC={R|SOZIf7|#G)F0EJb|$CtjDuP#Z78@kPB3f)=IN& zDT}(xiYY~aFQy{xU39wYyZz(W7t6SPtc|FBqK>xv{yG2l_YbF$KkE`+fE8^l^MdYj zXtpphJD8l8sI%6Q{zbgqqQw8$bFcRM>yCuBOyVP=ntlZ-H49idmpv^vXa~G4c-h1T z*^XCYa#~tsBC1HZvP@i>mhkRMOQvZy+XeR6tYc^rTha1d6+WMp5R z9Mrg4X{~X!@-uC?>EO%H)Wb#@Q2wF9=`Nb_E}jz6pD!xTqhNRIS+RgX6tM7Fe-|No4*PVQ?JNjOC@V##Dd)?0F{s7St zm4PE=c12V?DPD_MYqH+Ks%0tZsyJVUs+aCTm2>{ijsYJ=)l)06C#p@3!&TT9)#k>d z+SC+`yh^1+wA%3(@e^LOe=VqpqvN#|$D@5FPVM-s zHTLFpEUJ9BL-lRiV;*+EtFa^Af}Qbx?1C>KN953tVeZK|+pq^xmuNo7IfQ2-^U$12 zaA;B!%VZ3sSr38?rTid*qK{0xWTPdFS^zpBro_#zE$ zys9ql?5oG-RiF{&Z{}c|n*76E+!i^=86n1z1If4@+)@?pdJwUER>AuT4_{3 zjtqTSZee~p8NyDQ6;H_G^Ju%u@F$@~aiKIjpV#k%!p9PKil2+H112KzYm$+Fn-rXc zsW=5W0_O^xh&NykE<_H(&IOas_WTRw$XP{rK5oRxxC8kNhj!LXMcO%?bG6q-U4kmR zm*OD23^gZwIgUrZ)0u@=;&nI!Z^W5+AI`!JI2&KX>+nsShX;^-bq?bK{0-S>r#^A8 z2sK{54Nt?x*bm8%w!gmwhw=I@oPbO5DtsE};xnlJ{+n6Chop^jH@=UL;fMGUeuTO<>l3VnyYN)}6g%K&crJd9Q*k%W z!##L6?!{;E3*3h4L%oaYLw$)~qvnLa!C2gneehcxg9k7R58_n(4rk*Js51Q{5@zma z_0L&z40J;5v6}Cz^AC3kX6F~?MTRR~z3}3ON_`xmzD~G`o2rTe*3kG~m2L}Ox+55! zEgqkjJi$(t1qgQQ;=Eu%WXv*^U~kcWs{dXEGed#X>6>ZaFUQmI3LJIaAzw6m0tvV4IRl%#1R& z8BnxnuZG0<59)hD+eZDNzO#sx;%}O=YGH2B(SE#x+84$RcAxL#-~Ksr%9!mR?L)V{ z=O0YXsWr^ZNlr`5$ja*6(eARos+8sEg+uLDJb&RPPhQY11WFMdTS5#U?JE{)+ahU~ z#8%#-{ZxB(9F7PDo*dINrWH9T9N!8)mNYh7v^REyO_}h=#iM=+GjU4!rSC)}taWQyI0eU9n} zXrn;n&%$TT-1AIJY1_O-$D{aD9$pX%uS&kqF*07Y`Gh$)JJ-RO*q*bmgE_o^5~@#D z50_(od;%NbCTxhi@MKiK>l6&&sn`kmx5IgUJHO7{v1!8VL~M%r$lRVY51S+NEao)S z{I=%XKSTO=_F8Dow^u0R&a>CT_Po}Zm;R^I0XyPZ$amT?Zx>ABbyu8@-SI&@6Q4%L zEhV{rQ65KP6Pn2nl0*F5zwT!tg?VH}BTaTI=n znm_*mi33OZ>H<{$(-^=%4^xXUCB4=fSLm=YYH zLjxUkn59=k-eJb+^EfD-EV6fA+k z6Vs7Cv_s$C%*I>sYJ3Ri;6}U_>HC@MkUGh5ZpxwVG1p@oya5N`jaYy;A$=Re9K6H) zu33Oj;6i)}7oo-lx8YB?7^`v|+%MrYLC$$OivK03bXvyR%Qu!(`&u=$);&h~^raSm zQOe?FUdoR@^D4C>Wz(~twUv!I+Obni(lt@7LBaR zWH+oIIW}7+b!Q-#NfhK2+M9rE^QSZ{WuZD%UpSYyd?ixN)>MMsENBO*RS9y!LGImG zb9n6@B|U{?qT9XQ$o;Dnn{5|GZ<1nL$gTuMvaQY)7t6@ubI*#Y0IO~Qn@X9hQA7PF z_ru3$CNqB5{ZQJ%4bxG(V{ApY`e8}s_+MyIoT(gK!|M^DaOQJu`+5bcPIQpIhwY!Y zM)k`(p!(z8@LD_@X$zfxI3I^1V_Q2{cQfjM7vPh43o^De3sLRxt@sWu!Y}YP{1O-A zFUWkdots{Q0n+_0Y=ujaw$dy|+B|a)(#DzlkT%NPk3oD8bMPUYi4UX3-H#xjX&yyB z%br_VgOojcp6zk`oYzm{5qt{EQ@)MGN131C-3aX zYRFuL(;N?C4?KjE@JF1Ahf(A8pK&n~w|2b#3$EhzulOeZhI{c({1IuSo$BP(80>*% zaU_;Qdv6tH@|v`9uE9!p9de$*xdW@=6697$=TWSI&tXkmizniGBu$;yur_YRI;inJ z_p>=Wu|Dp{hB&x_F#*&)SdH*1Y>e}fI@#WX)f89pn!4Fpjm>c@w#1!CTjbQL$n_Xl z2hYGx*cu&di`QX0T!!uO1tiZoFJVXAik$1U_hfa$oxJXjzhMs?Q;B{fj>WT4_h!Z6 z_1FvVz~1;E_QTakUUoL)Ik*GkaSw7{#`y^cVj1cW&d)g2aR{pJO+d9j>L2?1O}ZXJ z{e)R~jDA8?zbT%rOIbp-wCWjOEnU2$;PnQR*wC$%!()d86d%C*@Ih2uJc1kWQQV1-q2h^aQ|$PIy1-sb z`XpY+chT2(Qjj@0XEHvE)UD<@q^>cmk-ETepQP;%tU=0*p)PSwpuQ-=dbk!zQ?m{e zaXl8`2AqwXkiLZ3j8Eaq_%XhUpW|!zC2mF4L$6~k;$<72jhc%Xfz(}2BEF4TxE*KU zd#Lo@fjZv1S$q51?tj!TiOL;(R4L2f?wEMFqb?s3l{+GNLFw)-rS(hNhWaIOp?(Q< zAm?0)_e;*8OsJnJf2!_%TId>j+dIk0ZD)HVbHZ;H`v-a5cOugFviLd0F8;HQUHoSq zyD-gI?5tyFu0bvyz>O}&1DI(j7SPGRMJNB+&yM~rI{LTh;NPNye~b2AZD(vg@!>1x z8Xl=v;r4Puqrj!%0I$orf)F=l!vlns;f=iHUlrcSRu0~!PVPq+>hUB&+ii=~7~u=? z`AhYwT2L;$Md@6`i{7lX5q3F=v6J!u^W08jY=nKWF*?`;mtj*}hb>WaKRhbMDNCMe zjdidMHpBL)K2QhjgdOor?1btAbw$-3-SBp#9k$ot^+ftT<}9RtV$MeTC8iguF6oVL zVP90=rytVJn|S;I2O#aY8H5!$wvm{Oqi`vX#ut!zduJn_kCb~e7I$MB(w8?AaRSmW za56Cq_h2^aTDV-jPn&!`-_PaugC=WKwpt*L6BP- zydtBb;HxoJ4ixMyIv$PVNKVr<6v*|Gj{b~!C_8UmfQpY9to}LPLxfS3bRH%8zC~MO zY9>9=9q#C~XIC~Uxp+|#$6LPIL!E>G!2$9_LQG_$K*!*)dW-g~bZBb^X8 z;lmYbZg?XvcT5d$WGhsSQk6vEPfE=Di~5wg%kZLORv)Z6Aw5IkpV604JnY3LxDS;E z^i!O(@M}!KZ!n1aQEBomYL4arZp4GAdGzn_9Xy0eiy!f4Jd9`Xoj+lJxWVvD3;TQw z#(VZ!P0qX8Yc;Fl<-A`FAI9oPf6g%P>(Ea#HIe?7sg24bj1O&I+Qcr!`tp*lNmd-{ zc^D^0a+#Nx{#`yQ-uw14O%h+@%QVVIq0AOKZJ=!AZe%l!a%5YA+#(v);Hr$K6NlcS z<0#^V&M}S)g?~mF(y`HY*}2UxuobWO;aL0<_3dAw`s&}{O#BvaM2%r}?one{wZq@x zr}#bYL)t>;2x?4QjqlVLwmxbM+ZHv3RUZBw2jU+{ePPOwKek|5R6AM@n~_fCk#U)! zO?4P=*)c5RDN~u(SK#q@8&*NaABO(D!#Kl^X&E2bF|FEHjcNZtjcLhKc1){t_T(+6 zC)Pz>vtAD`!1{PCHo#@5G3^6*GAdu3f~tp}W2J8v$tAp2e?xKH6$6oXZ2n2h(HXc7 z?QJG1y>>RC$|#PH@Kr|2M5@68tnNIQx@4-g+>o4Hn;pEo=4P5>otCqGv_<^Aw`kv0 zr&K3Eb+i`xOE%90QSH@u)UHp!VMv~{*ZySSLS9eA$8Zv^#w=We*|-gJ@C(evntb2I zs6JaBcE$o!+!dnYSozu?$E1UeW74hE`d*J$vT;0yKQ3hn#c>jE`Qli`E2<276@D&T zhO22?NlzujS9YE7MqY(KC%n-=ukdx;yI8$N$6Uk<^@CI=Yta~3dF@4Pf*R9y$932X zH{eL5&*`M%E2z2oE%*d#?79UtcGYLTfx2cvV^;OA-@&H%5w=0q*Bw#ywCWnw(=$-@ zH1n0Vo?e4IbI5rGyWvmB`8GQz-vjG#9E^|cHTmB7@ZY3ydUB?FRr>$qY21&vQW_6L zrSZ9_G#-Mza40H`&qJj#&v&wEJO-7<+=FA&cq}T7so!iGGbd`(I0==;$*43=L8YP6b|+pVU>1YL5`GmuOLTC`!O3~$H#%ktyX{e3;>}xhOhvp1uvQ6$-$5McIPb#7xD=Jf^d)Q> z-;GM+<)}2i2i5Ps7Z2fmcmkir`3I*quE2))Aht*PAhv9BU4pZK*N-6MB=ab)$H(wp zqz~xOw=$2T=3Kbm&}oWKqSE?lOu=Vx9zKir<0@Q(&mnDtS&hHp^LQf1y9OKJ3rPKA zUPPtoOQ^K}n$_R0-oyKflU?X9>#3R3|6Oyfv3n#fL(^T6;_KyrNbx1aJs<9{D{eON z%J>{YqH@4L8J(%zw;;Z~MaNpii^i-8pAm+hx~7vo=%qNOZU4ab}WE;$?Pzgwk)e^$7CJKwz^ ze|7K4e}1ot+AoKr^Yu-Y*_BD%Y#Yk#^TPpNW?w{zn~!Z~SC4jScq1}8Ex0|hs-mLu;2ImzBQGVY+`gx1etB4m}Sv8K+l3vlx?>slro)4dh^9Y}W zI`5N-Z(tT4#C)vC-!iZ0sD7P-DpOOj8&1Q~I2|v;%TVWgu0YNa^T+Oaohz{g`E@3q zj=8%e2>7-;Hydr;?F z??uh&-j9Pwj0f;GdjfOoYhBB63F=yo`KW6+?!|Seu|ItgTgErwZeDN1gSZJ551Uc(HJI}2 zpXXjz#cc~-z%zXDm0FmUn3D1D2MB80$MC%Y)`Xax+{C;rTiYc?hh@1BYD$j|(`<@j zIyX8nm^@X}I(B?9l{efZ@baodh%c|s32zk6tBO5$t4Lm56up_7SC>X_MqWM2Y@p(H zD0P~*C@zb5aSm(WQ218bVYRi}urYFNiS3WPh55XG8?Po^-o3n=p7~o78&@JVu_tnGjT4V`P|pB9 z39rSvxCZOtcC3$|VMF{91NbL4!XDJijWGe6U}|Nqo53J9$J_8Ud=i1Oze!$V>eV8?2am{>T~+XbtBj>Kw`isPZ}vRbDSbl~=AUv*k4j`%(Uq zQRS7gX3J|Ds=NkK<#jx&yr!edYX+*kQYLMAorEf{oVT{+H5*l4^HAkAAGcxweu{xO~ZaT9rXD zcrIRt%HMNQQtVzm(-aoYe5mTYJ5HwNw6PCDKGG zPuh0RiQbHC`cKEc^T{XPqBtnxh0Zh13WeW9oGD%w;@Nl`j>5%wHQtWPkn0icx!^l- zJ+JBi+Gorx#Y)8YGHi@@qsGF^u`k|>Bk?{=!TV9=W(D4Z58z6C7+=OmkaJV!Q9O}- zd<;3)V^(4td>jYh6PS-rqK>5q@5Z&r^;~8hat_t3N6w9!4R{=7V_f*P6f)w>lnZ{uoH5BrE?~}iM{b19FFfH*MgWG$h8&b zeS8i-z_s`x(tewdkapB?ou*Tdvhy+0E|{;8dcb^xln=8XNgMMm64&McK8**FeKFtR zFZexHqRjn(C*Y6R4-aDk{)D>b^JjblkKh*MZ=Fx^SJZVUf8w_oQ-Lub`KAm8ko!h$ znJtG`^SV4TPBInnNvw#^V`W^2$Ky}PzBnp-RZ(SB^Ctd&f^5QD=mr)+X7~QW_ z7qOHjR8*6A%Qr$-Upt-P;yu7fAq)@5iHq8(>pxg3VCp09zpE7fnmN9l3AVJ}0ydGUhP+wu8eM!nDIzu>++V>+G1n7pff7zq8kz_d%{VHGT0(?2pP9=b-Y>o2>r)b2H^g zadAER=de?GlFolJE>SJ6Oy}kwjReBO5`Wf+WV3MAh~zT`9d&TP=WBeR`qW!=Ohvpn zh4r^kAlGo)G#`p-gpEMW+l<7gk$br9{N(xg5wFMMdwk|Nd>=2wio_+?fZO}<6R{<) zld&zP;UEm+G#rmN;{?1N(@}NpBvjh)`)BsN1NV$OKk+&nxvs?IAlHSMi?KY%k&l(J z0J)ye6k--m##uN8xxURzL#5$#R9e5q>c0ng4RxK;`dRd+bpd1c{~HopX&pURr(-H2 zOy$>`tGj|Y&~eVhG`t#>*4&40(|RtJAx*h{-_cn8MjVd(wu+O1x8QWV6;*B*q2}an z!#%hd_v0OS0PjSuwJ=Li*LB>5$+#4C&S?cs!Uym+*V$a2#^Kfo*@EL(NsMM$Ubh=W!dZ!5z2(nO8R(u@ZS?6E?=pcsjm< z?T|LjNyn`?4c|bneKgzfReTe7<6FqM*1Ut?;=5Rvbl8sl@jbi{cOd;`vkNESr%0d4 ze1?zU=cx904=PXYMdjUE#Hs(@!#jx&rRgH*nOp5n0;4#Y7y2p`6wsOu9MOW6CbMqq#9 zdo*e+JO)0@O837vdPcFA*~_2^V5ADos*QX{R>Ue_p&xB{%KbW6RRg?%$mk z_nMagUmHp=B}@`8i}zU432~!5oG?m%U$dmN_a}@Ky_uUZbD}ppdb6Z@>L799EsBF8 zUi4ty9SYx1epgx@#7_7f4#My8N<4(O;}7^G{)n1~WPIps#Gg^^+YxNXXa0hN@K;R5 z-%#hw|G=5}C$2_ATJ6IaEJNCrL9P)qW$`>Lhe~U%p|)e_ig*vNE8+Wi93H~Tcs%vW z@mLeN*4i0>)sXZ1raCUd8pyd@Qxo^$iFg3H56a^t6Oe6dp8)KjX{W2VaO_BE3aP7C_U~_yHTOf6$VVvy{*QPa| zPJg>SPQVVxc@V?3;?85(2{&UG{1tm(ThjF`RNg)tRR%`0`mgaCLYS6wS+i=|f9ii3 z**wc4d^fnRat^;${2$a?_GFdv)zGN7^tnZ>?2hTns)czwM}CEM@M~;>-(Wl3j~cgr zi`t(9sQtc`)!%10k$l25fu415E{l}isB@U^Gp3Jzf%acq0@#8NS7N!7`5LMR2#J0~ zbNINU>ptyQ5gRJLyt?oGO71n=J261`$9Ot24{6KS=Qxbl+}~!OoxB%k@p>QXvze!~ zzl--3>YVjAxD~m!-}wZ&w%_>y58`orKl3Y&;^h!3{#LO1pGEp1VLIoqowek%eUf!i z`oD@gRete&W~dU=(=~LSRk8WE9`2)jq#Dm#w4b_;pQ+LCvwh}rK12IH9~F-`;y}C! zGx283$6IhFF2tpHD?W~k@Flzr6_1Ni@j#!-#@FTiyN&O>QW{}Q^O{uFeo^`DZ#)rQ zC*qWUIErHVNAaR;;%o0C=YErT(_8fYiU;NS5urex7t%iIypYOM5h|i}eyAg^!+y9P z&%q5i5_Nt^$D#8>${$l${r5_e^9@y&U1K80TjCsKq?EC7Da$d=LWawa_SswXy*f^+ zaWbI0=$Z)aOWAUf{Olhuk_T*lCU2OLk^POT55mv>iw}LQk5CUxm6$I@yawIP)Ap&V z3es*zJ$kY9Gl0s^tD?S1`&q>6TCD2#XgN$dRet^jo8qt79{H_8`wZznQ0*`0DeSnP zOyFo=%HkX>hbyo=uEz?v4J+Y$$ULia7^`7(zP~1R#}iTK`k8-qGO-S7Zu=xuJk~|! zkNK?rIoO~+k5&0HJ}SOL&o{M|2XB?KC`TyzD)C-a^c|%%sNmFPOE>P_Zmu$p;x&oY zTeLs^^6?7!Tl>fyhSLBUE7{-S*@EiVY{mZgI>zH0I10C+j_Xa-@n6I0@AscXn95>p z*2a*EHP~bC8uek?7ae;!JR=ldfwH3g({(_KgA-Bv zS~paN7VvNXbwSCbx$@ySj5>Fo%7e7sYXJB z&keaW6wcg}EidV)p7BKNgN$YEvtk$r*!rEhDQ6SmoFBE<;^yE%Ugu(UJ~t1WVLqxn z6yR8#jEaLPsPun>)!+ZnwVI0e8!+k_JW=&cMmXumuw5xjsKQC&tx_tSbb_OjUa^%M z4r1oXcX>P^?o^aAMpUsy8YI-Vk4Xx_10D7*pXU&nYVcEA9t z9%_VYKbm1SHpfCd4R6I3xEx#IgV-G(N6xQ0Utmu>fM=unOI#1*G{QdE3H#z0?1$Xf zVEW@FI2cuba(>9U7l)$GGYrF>I2?aQe$&NW!y;*klan(G z-FrZ$>KjTfWb$KPD%hTe+?4mefCpQ*_g^a5o*_%|E&R8bbM2sS3;!+V?fkcxxAWip z-OhiDc{@scv9E3C-_yVK2=4#Eiwtc?MD>E|7q@(?+pdtIgt*yAPY~2}Q9L1Tp3z)G zqHbZe9rM2WTUPr+F+2}9SYU(W2y#Dw&E2it#z*b$LCTi5D1Q|3q6h2lPoS z>cfr4({KWI#7tB>n}t_l4&H#dxDfO3S>$?0JD*U9M|eF2bsl3nw!lm9bi4v}PX!I0 zoo|?hoq2r~cExM(OuQD)#_O>!-hi58x*0V;u>jA-TX7gJ!V!2oo{x9n1$Y-G;ZjV& zyz-)W~bMX-@#7A)oK8}~-6L>j3jhYAHH>d5j1Z(hJUcZ3fA)g0EsGzJ{0J7F>g`BiERlw=jluJ*6_& zGUKVJdT}GG|CwG&SLLf_tb@E_%rGhHcN^?nsIRtQ>r$3uRF41d_HnP99#y4A^`YXT zc0tFX`jV~&{UUeC2-TOI`?d9D9;$uJM;-4KsCZ%gRiZDYc1C4D&WXfJbp6S%a;Ptr z&Q_%?e^qh*m+B{99p|q}+m-x@0M%%@>~JZ47PSFUQLWf_!a=lE?s>L31cjTg&^6KX zqc?LWG#5p0#)PJ7u}Hn9{FG6Uk&|tI*=lh3&-tyBM75I|H>l2YcgGz!XwT!qpBmaS zs{M>39lb^Aru?9E?idQ!wQ@>RT^kpRhcFFwZQRAEYvXQ1T@&{j{(^6#u8DgWe@8ug z=MU7p4VlgMhhlV|o|k1&`KcTp!V35+R>a@&I4sY;RK|)}1*_o+SOcqJJ*b;Cj7{1+fdyJEXfq5Rh(dNViw zwT<2^bf$x}C$uZ8x9GV1W3Q7*UwuI{R6naZ>bUis6va=F)qgHx0AZ?olxH()@IQA+ z$xBY16fDqhwW+S~f_+j~sD4zea1DUk@>I81=T`G>nq&^%cVBgy>S$AWzk1^T6_bt}fLqm!AtCHTQM0IL6vJcK;cyJAib;wJP$GFh zJ?3tdoXJlkWG5G7(Am=U%mKD`^Ji3CMEX_g(|C*GPwCW{fQF&)yBLouZkM9^_sg*r z-ix`o0yRc{0Ix;vFS7lrXYdYQKZ_cVtwN1)xcAK7GtRXr&a1rE{mpM6=X{;L$aRU1 z;k!5B38?#<8{j4k;H%gQw_p$4ibL@Yya=~p626U-@Lkk6ZadD$9r!SE?#A9%_Ytn+ z^-d(u>3JjeHwZq(?Y#aBKfupX`R_vh?Vs1afOxCQdonFjj_i-Xh3?!}K~l9)%JNS$ z-(Qar{DT*=XYt(kzyCLPl)D2Qe2LuMg1~U@j_N1992HZFSLMq(gslmMe@K0xIA;uQ z&)ZZdeJhMhOK6=(2zG0ws}Q28c?fBVmay+fF)E7>YiZ!sQn>n(n{ zGv8Lhf4kcHr^#GurK849l}=Qxq2CbwXH}1Ct^gnMS81zb_owY%;!M%;1?n@t#J2b~ zPDHK|vd=8}8JF<-2x?yY7knK5z#YgnM9v;$Lc;cKV(@2PmPhqrDqu_G8Y5eWaDAtJ z4k71pZQW4?vv|K6UWwK5YUDmyJ6Bx`mA2Da{pW7ZBux3UE9)JRIzefxIXX98mHA69 z8j*NYXi5AjKf0R1)1MXp`m_?K18x5xI*aJL6{q~ioRYh|Mn6FNvjtU-bZ>~h{!Q$R zZ=pW@ZPYQTPwB7cR9-Z{yNz{W#O3jB^^(f+FMtYcQ+Sz|8sojaiJCmDk3JEx%f%=1uvJz}T)cs39B=vJLb*W+ zJUJW}HiHZ$C~Df(i?K+aiHfoB*;d&hcvBbsv!8X$PuLru%^6@IyQo z`HdO-Od;J5^c}Bfv-zz^@p)Wo$GbSqVBI`X7MZ5q31v-{YzOW2&#VG^ zqG)vMsL0PJ*|HFQoZ1idm7|Z7@r0erzY81j{@vIfm!rzUJ*a-_gQ)#~2z8vw3;sI% zPU-_4=OWw|NpEiZqongA-KpIDcZ?yo5?!StmyamcHY!m0J5&h=vnLd!+sM$tl@b}s z9-*2chx>>14DPt_pJ%wGMtNWktG8(1l?PNWs1K*533*$`(-iAtOB{h3Z>fDf1E*nY zdJ$3MZR*Eq%&YmYYa?;$=ACe_ zJ~1UZ|F3%W$~~n-m^XpxMlQ3Bwm2p6mCF7JG4|3Zr9gT(C};e5%~RSQisI2>^%m`K z5ib;P`baH}nZMF8G{Fwo6m=e>8K&atn1iix7PiI3*bX;fXFP&EP<@A<*ago-#miZ! z_2PO(^>;Nr1Zmk?hp2EswnvFMHy zTkxK@Xunlf>F!Zv++_xJj6UwBP+hZ$fBT;icz-!J?(fE^GMJi^JMBLyf*L(VieN!b zZfIZ}o)vQIUVdmbb6Rj}hC7KJ&;FHCJmUzCDxQ(?m&P>SqT^6`Y(zk7lQ#p+@8y3z>@C0@`whY?4ZFP+16!%E)s7VV?bRC)NG zP+%6vr2W=?a1AgQ8{x&Mc31bqsn#k$)wP9qH%`VKI1N=NOh=uIxCE!+rT8RXj{A`b z7JDuB3>?mW%tD=eoQ;gn?fq|xyK8u@IKGwDKexho$@clq#;86YkGm@@7@rqRPD@Qs zb{n|TBi4i(xFkNiSj2jLny3zpYU?<*J6gOh;yrKCekop60nH5s>bVi>?>VUc-b_^e zG7CrHY*bq6`4Cs&wYUPW!_QF9htRx-o)0k!^?V4;8R+>Cnj4sphww&h&G+AgiWlxZ zwDG6U^p687@V@pb28+iZRd8XdJH_@7qwcTbX+GcQE&6`NQ#Ar+g#wqczuKpJQ1Nsh zs=i%;v8d-xD4rg~1^5uYj(Yw?C650QRGY5nQ0SZ!*Mr*Uhpj~B_3U#g4&W2K)^T%R zmm5EX`SVu;cBD3+&2>SheWVO$C1+%3(vi^*=!E)+(W%cLgch&hF6DKx{H5No64z~= z(v$O3^K$Ys$J@$V1=I~6pOKeekeQJkwBd8Y;mX;CHft-g9m0K?vL3-x33lrRemzhh z;$E1hDkGP-+?<_XKow+9kSa<;O$M`e8XzZyL$WhD%O5@L4t=6+v%~#9_shJvvD16; z;g87A$exfHwEL_dQ;FjZcO(${s7T+XEotH{iht#gJ_Ixkg+EJrDNR;k3)J&O+Tj}P zj(V<$wqJ{Ci`L-?T#p)8Y{I3;^})7$y@G0+w%{7viu>?&RQtCL&%w7)eVey&A-;o~ zk$doMx!aDXvXAd!2JXO>_&zcRU_L~~{$?ktP5Kyn;V$G^Z01v(jh~^~q|fm)+>P~V zYxW@X za{r>!nz;T2`{M673S+p&E)UD%EG&=LV+G_s7E=k=BG2D;Dlw2b9(5md9pv5wQx~bj zOg(%V>tmTpWHxMu4KW2z#=Gzod=4Ao+t>s@K(=*$z~)$$e9;nBE>B0b4>z&;>$l$s zV-x!fl&Jbm2%qAtN} z@jko`HD5?N*xxU{0Tl}ZZ&4?kd z>KMynQ!I}<4^UBg7|EA*{8Ab3<#iSO2v0zzM^)^==T^hvSRJ``+TI7T0BiAjG1f-K z<4LIa?#RFWzqxlWWl8-e?j<*!B5j8K2`_$yZc1`qTB5DkBRNo!QgZPc4;_55#zPUT z_NEbQLQK?WsWn(ipc}!dj6gGk`R*@Jtq2E48WjzZ(g=4yCxtPBSM9qYIqpegwf}C* zz-`K$x6!u@CCryvYFOe4cAEjWVNqCI_|M1Z6wJ>hf;MMcGm58Q`r#)`S@MQa3L>+eZC~zDMcF zVVb6)@J)=7_1&9M-~V!G%zP$s@1J9Nk#?dw+dPA7BKuja40#;~oxGY8`i|lpwE(I2 zr2^!ZlSqN^#?)?Z=fR*h$I|;L-f4;y1I4kg80fQ;2zEciezt9CG@?*R3JujX4dxZ3 zP~qYi8N>afc(yFwKk|A_q0d!OO3ib7P3~O9KH||^6n~0;^@lzRg-<14C{FpUDJOuJ zV@o7a?EK;k?8)m{sN=c{HP1c=i;!mr+2_ArhbQrw{H}%*hx1U^cwLXT;(X*fadRV9 zqI}$hdM@4qOu>c7c_*_7AHv&k4=zTH*>A_5cn1dYPJ9@b;6Yr96)6|X@D#ioJK;Te zHr|Wrcpqlr1Go?$#Fy|P+>Z|<*Q1z6@i@xOV^{}QBJ&pJaZJJ|@H%`FAHt__H9mtM z;40*~6^1^GQ=T|qjUDiL9EUt>$+;O{z$ft~nZLq+?7pn4^t{l~v>TU|(kU z%D%%}-lBa_-qXC03YeBp=$~l6K1KC!bRT64)cup^A@}q-*P-s4+=z!!?XvEl)Ri$W!&%dLNRrgIQPBf?FZ;#87HYf5P=Sxi2n*76Eiq$2ywc@7w0{0xz zRBxkVdewcC4uMTrxr9bTD)+Ng7tANnU(cv6NFv-V%l4{x)iA0aLUqA^tD)r+ zzh`Yrym*V^L+PWvZ5j&SN}f_2y^adsj;f<~;Q9DI>iUU~P<6si+>9UNLEMF!^Z67t z=d&BtzVE>+aW5{yefSoBiB%}`U!mslzDDjju=nwCjfTCC??pUFxZ2q7kn^eb{=N3p z0l)M59Mt_kJf~Wj-gy>d@LS|}@SLiocUg?ba>!h*sfbHZ_W?bPx(|qRj^=pe{F14H z$|onF^3!GPtN%Li`oy35C0tWxdPMS5J~OSU>HNg-#f3beAs98jP)k#C@p98r-YS-x zRMb`w*oalXws5iAPgL+qf_#0u`UI~E2Q!i2_APBg;>`lMc`7+m!=7nwCrn*GeUken zUe_--975MmU#ND#SL79(M6mmzUK?qzIgI3A`z3saGWt+9j%xJOj>U)nz91(jGbek3 zZD8ZVp^=UvLCU|;eMQB;@^1^my}ly9cWC>HHBfy;-M7^d>!aF0<`L{~xi`dnd3`dz zji;dUZ2*r)-N(@n8>7bjO)wXm;T5R+IvzpY&#@g_;^%leeurn^ndH-0OvN^+wyixL z#tztw{MixJSL}>uVHec%n)tm&=NjyeYq2M;M}8O9KKo4fhp5fd{UKwp4;ElQybg6= z$jx{TK8W%72@XK6#WVwvYa`7dRQ?@|%I7-I<-dQhknL4x^V?t1Z3%O$dBMrSJmy!E zvx07Ysccfpa)Pw`hNrFB%cxouANsF**j_ z7o&EE=iAwKNB6_1-5G`B@qARDb}Z_ejSFxKjze94qx)jo;6-==>i!t+rM36RJdP>6 z<{Ckhiia_X>ibMU%?YLBxi}Fg<0RDFP$qH>m%Z*^b3?lBzc%Tu>;9XfuKOQ``KasC zb^ZU-sO$f~z{yyaH7q${~Y*o`VxwpB^Wg~;?4_9$;nGg zQ6JO$ErkDG61%CcE{Wph4&u{Ww9iW8t^}yv*K#GtsNC>+k{2$K7}%ev3EZ&$tjP^Bub9L30DQq0Xf)#%u6)T#t9) zFL)=`Ck>b22-H0h*WprBKX)0f!@KcY)V&dha0NCZEg!=KT#2d!bWeoJ{u6irpTY{H z>1yP9TC)cG;|n+vU&KUQhg_d;?|oQ|y7yrt>fVQgxEVQLZeGS@)IAVa;;Z;P>K=&i zaSPTYuD2r3#WHVTEWU%I@m;(MKSK3uccS{WAEWxUyHNewy{LZeKAekRqVn8VsJwY6 ztAG4gKzu4qbuD&@yy)}Fe`2shwuxC?K`1IXCjUemV()!yBO zI{sy-c-qM7zrI6bJALPSxTFUEaF@`z^nyH2P^29rf{xnV|N9Z7K88x88Z)NACGr{B*Ya5^H%y^5AL-DCT=slr8Jxfi;re~-rKK1OhMyO|}C15|i4Ey6; zKfeh@Om7E8e0s<=W!&eugV;_eZClZ-ll`n z&_B;?*iQTUD{EAK%?$=8MP~U*&!qo_G>FudNqm2JVV@MI+OH9zz?(P*y}kt%r;AbZ z%y-~`+rx3;^0Y)iUT(G$9K$V|{$aT=>WUNg) zr+epg50UPj9* zlmF-9+F@V3rL_FlhJ99C>-s6hbq7>jcfu6Z^;F7#T~PV2D=Po#Ix6MAvr+jk4we7< zq4M83sQed?iW8Mte;cuxIMsKn?-7;%=*Q~>!T7>V?*^lEHY#QL&wKG|2;%tU&?qoD zC72m%2vl}gMSZ9CRr$0QVGoDGhj47#{{&Rr4M)Y@2vppSM9m$I!l!UFsvkE7b^pj% z)U|0BU=of)_1`YUXYnG`*ewxH;QNzN=bBUSBIKFp&efQP>azz?aXB6p=MS;^=i!={ zbK|@bmW*?ql=(jw>56l;SKgw1Rh*wpzz?CoNgSKvJQEe?xu`h57*jAG73T%0I4{Iq zI2o(**;6ncr{WBpjyK{ZxEe1-jhin={RS8h?Qy!}4AgVYX5tli6><-cxf)->Yj8ha zi>FZ+T!(#d9*)K9aRJ_d{6>_Sk9+Y(=@0@=b^qu%|m^Mz3>pu!4vDa_j=UApLu-}W>F66;u5TfE3rQA!3J29&u)myt0!YC zY=oLOZH$Yt3F@3mQ>;jSZ-!Mc9ou0BcE&6mgW0Hg(;U14bMY&@7&X=`#Fmtk$*5~h zrr=PViqGRTEW*q2GrR)1Cs&n)J(qGNa^0Yrfm|PGuENDQ8yVM_xmb(1n}^--dOQnn zM2#hHLY`@AZpK}B3v#Z&EJU6qXcl23T#Oy?c1*%MQ0GdP;8MH`AIGKmA}+)A_z-d( zjd>XN<74;-uEZvl7<*$2d=feTWS&CK)0k&)GroY|;ETxIv{{SesW8_eb2?@{G9O?z zAme(o5qIDwEMJ*1IMU{umyx>Gyn?sltGEVV!?pN2c0Qi5Hx9&YI2hl>i*Y;VRX<+C>i^9Rjk!1!`%Jp%wk?>- zd`^ClUIhd^d{U41)ljEnj-?TgAFS&BB;UCJ|F*8WvMwOy5P zC~}U^nTnNB$5z_)r0Rod+^~Q(>RN4kM@Vu(klTokeg5pIhou2^Iv-lV$|)l6A%Jnb zEUmIp8?E=eMf>GHPUdkP?W^u_ua7nGe5{Asf9A>Uac<+^{`-KI6Q=8BG}k#h(#GjN zAl)ft8#h&ur7WTDU>t81tBt)WgQ>Qn4L=f2G4CF9T5>_Mo#$7M2u%Xos}GgrEeP{P zgevI(!KK||rTEEZ^%fnE;)kqj(n5isa(#i0k^0GLil3v7X%EKX7dQy_q2>p_#2|i! z$|qbqXYaTA1{F`=qVi2k>PP=Mq0`TB`wa4>NPK#I2Az#*SFGo-gAXcY`G-A+F8+=} z7doOQ`q@EU7!4E;@VD4q{LOC{e@CIS|4~7m{U6%d{~0AaEdI|Z*cSjU z5P8==qd-@n{7k@PTZ+OxlYD!L?h4*;ue{L-JDo_IPso#YQ=a}&5S&_I&$y{%ylg}5 zsb$@5l^OoiRC|$^>LT}}LTCDt2=Em^@04`(uuTUxlug|tof*0DD~`a;_B(U)a&m21 zkDBXat{}XqjHs-}(Z6BN!7fi%ar;frU@JoS-7tH-<3_xP*PC!FZbqG_dl~EEYuF37 z;6&VtEAVxE8s9>VGu}pB+w~6iz#TXg-^UB_1LPiQ^C5nMAK^E+3u7qnpJG+~4Ey2d zI3IW8owyI5z%TJ7{0a}_*Vv2x(Ko1m)B#MzgQ)W}-{Gxz2)E-8xEp^&ou505weTlw zjz^GtV9YPbJhJ%}m*Q`z=d%Bfuj8M%4Qb4r!x)2QiSu$;7b~Ey^{s@u#`id!kJa%- ztbtr}VQOL<`b8&V0@lK7ur{h6RTn?NdiVu4#733qr(!Gyun#uE%djzW9g%5)Tpwgw zBGU_ja#q}?!~@%2;;F5jm-emZ<`IoJ~#-k z$H90z4n_69&chdQ7=Dezv2zvXFt87f!7+F~25~Ijj29qz+Kj{FY3wh;`k099gGs`R zF&Qt%6nq#{aWAG}!>Y_xU_YFI<1ig3;zV48nfM@P;abeW*RcS9!$NFQjd1{8h*NPk zPQwK_9pA!B@IAZ?%T#B4fZgy4JRcoghF9WRoPm3ACjNx8umQEmRjA*{xf(CPIrt!6 zgTLZ+ctTCa4|onzj(V3_$sP}@ApFw z2tsHA0tQ5?C{0AMr0tME8Ywi(P6z=akc5y(5pknP5d@APMGz1hs0b=5=ur`nqSz}c zDk>^s0W0?V`>!dxB%Jd+?|bjvALEz3X7LostGEMS!@u!$>_n#Y4a~$haV@@u$M7Be7T?3) z@gUZr(&c^ZiXUPe9>R3|1SjKRT!)|HNBB8@gGaCdjlRVBKtucr)9@%>iN~-Azr*GD zJ?_Bccoa`yCn~^xz`pn+4#b}@AAiBQcoKKwZ+HxU$KUV|ys$0lFkXUx<2A?wfPw8; z4PV0Q_&wIZ+Gmjt*d&H@8e_02cE;v70$bo_Y=z(A znb@rz=`r@hwwQo1n2zmnBX+=N@f>^!JK=}e1v|7SUB-^s9WTK1@CxjKE3qeT#@@Ia z`{28H0UpB(vGdua&o~J$!g<&qci<)X30{gFJCH785?+pDFcz=JM7#}2%K~@c0DKVh z@h=>S_0FM=7VG0!Y>7qK8OLKfPQZCsj0>?8@5YJv1eW28SdMi%lKx=^PR7AF6&K(% z+>6)aA)JXn;EnhX&cdipq*vG%7hnP|#1Xg%3vdbEiA(Wayd7(HCY{2|a5+{WX?0*3 z-hpdy6+Vu4;vT#UzsB`grwi#2Hplz14Q{~ma3c=I2XQ=Z!rSp-d=59`E4T&gccnfA zTjHabjgMgoK91$M4e!M5_yInJExVB(VMlxh``~kUG48;4d>&6&q|^LG_D{*LW1x7Er+-IdLo4 zraD%^&PUs%ylXwaU+IM1LphsUqxD~ zFzwO*Mjeam`HO5%*i0C=bJM=_Ld3BMKMo|;Reapz5W}>vOvYtC;nb64?k zY9lh46t-VFzrzUh&aXN=26t3T)vl9dc)PBj#CYE+7KM~wUL)N7XxnuxxSd+NoxoSw zSMATc7=s6KB)*SD_yNwq4>5orVkOvUzH$q^zLOlvZ^aMs&o{co%+*-^#07=r!yZ`#&IfP$?oiG+V<5Z-tQ(zW$MXl>x+=Y~vOurKPK$&Om zdZ79S_QWpO3%g-&RA2SJsQzLXqK;)h)G>d8zsUYhYQt6hc^IDvUJs)f=dhsMUwN2- z|K-)7S_NGVm1-4KY4^W9{_9wf`!Q|L9Di-{QYUZ(`>B1o0?C@0_waSZJig~+K90sh z)Ne-PdpHI^!y;_PakvKiqTavP4~tQKa!XKU{Zbr{6LC3CLLI+y)Nx+HAC)`7qp9yT z?7Hh7xGXrudmgl(-&D(-x=WemBsh62EG)rst3M-RaxC*z5tDx)cprc6N86=%Ojh0- zLv9oMQJ3$VQQ?oHQm`j+FmA*7xD&VHF8maCqxuZIfSqtJ>b|uPSKxkBAB7k32Yd<7 ztxlZ@_Qcn51ipc)6L}jM57E3c?ijwu_m*t$`>5miA?kSdWLc5*qD^Yq>E!9SGkCm5 zPE}pHdde3U&|pw9LG5xTO&QCAs`xlZy_88|M_pCNQwS{QkGr<}z@w7#06|{rue!3i z1U$qxX!uIIu1uH3VnQoj7V1==>HXfj87b>w+6a@G7I9Y94=#~l`$p>hL^m2$WXCee z-beW7vOfx!lzM(kTxXq z9)ew{{oakY;|q8%?!o(UFDmX(#}U|r@8g^J0V-|#5To!T?2m_WARfUiq)x<)-~A=d z#2Gzi+e6NXH@icrM z>*McuI;tMN5vtE@6TAwW;zLNCOrUm6t|vSVTcVz|Y=zh0nYagA<38+!uV7a^gw*8( z7@y7Z;U72vX-~3fg9|7w57KmPF6)ZS+w5pzU&nHLFwVPe0aFUb=TDmS|3PCwzsTC~ zev!4|{UU3_`$bl5S8Cwz71<}Casz+lLMzvoN7ntHqJjSt4rtibt;_f;0=>&v7wmBY zDqXO;#FXCKmsnA;o=;E@8>Py+!b4JJW&0KoWM8NSW_(&*BKA*<3kyflIj5|s)E+P? zz?6t9UF!--b4U~P>VQ#R&AYvEW>7>WJGva*9T-_Srl{DY2cyE*=sh=|N4ULZ3UUUd zQre=@hO>zk6GrM;UG{I1NsWeilbn>)e&RdF3%2)1?>*1~RKn)$JlpQ9LR*^Z{Xpvu zeN95hu`y|&+o3DZB&Q)y>*&5l`NsR`8ci)MHFUC7@Ag)EdYyB=BS_qc|FAuMdnv+Ure!{_S`(-=D&NBlXFFXK@!QE!&Ms%l6`%xDVgP zmr-fjD|iH7McO{CH}G408>?|{-b1BvAL5z#5q80kF&96HpXz}=OE8GSRL^+DhxVd6YPS`up17;b1@IQVYw!Z(K4x8r+`p`gFb*$9J&14#M&o6;0Aq0>#^Y9`ogqNGmF2^(6p)gz z7zZHr^;QZ}&u$Gu>T|7Bq(0P2!zN_t(~i=e_11t zdM)b;r2fge524s*Pa+o`c0W z8cT2apk-6){BS!i!XI%lHg86sC%h1E!%OgXydIa~I=lm8NibL8 zG+d4JAF}SmF=PtY;9a;DRmZ;$kKo<-8{UsKNryM!0NjYF_#o!sLs*QP@C50o@_Ui_ zc;)w1mW#%^?6dQ6^EA3C6o+ML=DM?l=~hE6CbZI>eg%QUCc5f`;KWmC>^UTe4A^|`MB|@tZ?-I zAQri0@c$l*6l2!0j!H4cjY{_Eo?KKu)>LoV8K*7$!k$n#p|pJJ==`GbCUciZct}Q4 z`9Q@wJE*wCtr|N;yi?B!#XEb+A=$22ZyD|qf^}W*aSYv$j-BG3iCa$iB^+xV&r4Bp zk95<#AMYVEwY>T-# z0Eb{M4#g!%x^3PyJ_6t5`xRJ?xN#*mLeld$WGiAaAqYZ7+Ha!kZ)k#Q)k$*BD56#NXQVttPBG^BpY zx(@Hg>G%|0kJO)7Gw@ry0c&zzZbHVCvTnxaNZWXzJI+D%pO}lvv)qD;`}0xP$RYkB z+dXvLxouc_-n=B3*4krQnrAjbpC9PVoK<{C2$ZDtV3M7tns>b@NYUpmF1?Iu=G~QU z!e`G#GOOZTbaYeZvSVt2N|B*M=@#@fi;iNByUlX=Q7;ojh!e!xdWF`XPthdjqy1An zCM#l%cfwXv{?|UQ#TZNxM^ z-|-Q3fy%3?93txnk8@~R#E|Y~`3#XAmME>@H_Tsjxm~*5v5s`?MdcXAgo0)RuSi&Q2o+|j|5gghj z%)R@%TNAvYW-@0x{+!NkN_3O?YOj78Wmu;oOk0}B1ZPVrA}bAz4Gk%ppf0l}Vf=yc z(0=$je~M2d2zUG8FXZ~txm|=Ekv=Mc^YM1P1eak3uEagK3g5-msCutEQSB^uVGgcG zKi-X#@E)9k_hSGz;C$SOYw-cR3pe3Ld>FUlX55Ec@I`zK-^Z=^Ek2GKlk^F!f!nYy z{u`U(v#9X|cA)BN$p@Qfly;(?HQ$Xd;0vgJY4pzJ%TJ0P1;}mr>6FyoL+$ zb$kln#Qpdd{($db9n#hJum>K*Yw&$sh9BUa_#wW9hfvQ2e2nV9_6e&0+F{h#WuIaR zeulI0OH`TiYg~`VkTx~z8$5>JV|C8)acqV^V0-)#&&OXd4u3`339OSi1%JbP@eh0m z|H3`^H~xtKAY%kt)f#b}k@7^~T&#(gV=YX<+PDOx@HwoD-{5J;_?cD%j3Grl9YbidC^5=fs zXTK>DdgJ`p=DcX%>R=2;p|0P0I2unwrDP3o7B<4&7>%D}W9+WugK5|l)fU$rb$zx# z9k-UK`-86e$Z?|{B;IQq?!zkY4+RxvJnj(sJeZDH<&RtH(c!CDVLkFOh??s_s;k_cELBXD=H7v4Zp^7 z@f$o3Pht>#sipwAK*Y#-C!E>z8xzaHFjMFYFwX8R9#>es-JK+ zDn8|);$2sk5!rq)qcPV#)2>DJb#y-Nbxq>|mD^#_PDiSW4>=M=D2x576zx>V_oAI* zlUfW9v$l+C!Pul%x3wVLjyB%=CG+j#&}*zRBqyPCU>`yD%;s%w8l6L1u!CSb-Qal- zx_6ka>)X7a^Wp;2PhCscLTE(fRqeOZimgSoZHkEJo(Xoe4QjSK4M;Ed^r}H{CU9PbN+Q%%Udfn7Vtl)m=eiT=9ZR)Tw z{)qVuC2lGH3`6Ciuf~4p$2iQxo3Q{_;wapNh4?&Dhi2YAHWm-_{TkFbs^d{*#tC>P z7UTI?iX(9%>RKzqSvU!oU^(8475F$_i%;WZ`~#=pXu&&9ry*VLf+wIt;WA`4XTZBEnbXw;XquEyd%N78|UD?$k;E| zeYhF#N7bWmK>86`8}TE25P!#qP-W9is65XWq>qX92-1hbdKAauV>l0=K-%!FZTJ>G zg(|B)js5UB%*36jx`kb+ak_WoD%^wXaW66!y0s7A#22w<6nRPPhX-&xzJiRkX}yZ7 zCx0D3#kWx7xW9|a;~YfgZQjSR_#sZmL&#W6)<>wm`yb;r`~;uFPm!^Ptk3ZqJc8fh zm&mvr)>qh;dh(-qHXg$Z@EaVC-yzShTPJW1{(!WjTR-7b_$$&bZkk>SImm~RkD;`f^BDQHnT@-f0BpiwZa5yI8I2?$iDOM_SO<8G3+_N(94IGS|b1Mta zAeGKRj)j$r?1MD~3vf7=;0U}0d5$2k46j1tdrsgB?1taqx%eZVhkxVwsB#9+PvMI zUWENI7s*!!M&RW*9^-H_#^Vi`i2uSQT#WokV)Yt@hcn0R9;=kJ5iGRUZPS_F7MGMETf>Vl$ zi<}GKzjXeJi0u(y!=G^N71<%Bsu3r`Uq#x_ME+7Xuu|loLZBDU`KxQFgUT= z)K<+659WPb=2BVg1&3cMy3XCj>Qd1a5$nwxenn`l%D|n`NV!R;9AM|H`*=SI=_=C0 z3uHOLtH*86is4+jADtInCvgO*eo3EEoJXB2#@;sL*NsN4XAEABV{sr(z)UPbT_>fu z2q)s*ScV&M5~>e4_50>Jn2a@vBU7*;PD70We;pR%bX0t%Udpsn&A{jRegp2unW(Zm zW9tW0cW^U)inH-soQr3&FY_=JZ^5f@J}$%sxE624`*9KO!o|1`m!R6SZb!9MEJLm} zYdLbQSSwKDP_4wJcn7XV{sK?n8vGpBVl(oC>#!rWsN6z|0ucpu(`^j{0` zJ~?X>zK##0>e4o&+A_9a4nBf6f=rgSW_zUO#byFK75tfIb$Qk>p9A6D>wk407S;cl&4)hA4< zl%9M=pnKt)xsDU?B1xh*IE`9l))5#|wmy@f6HAAs939Vky^h@)$;husOA)%HJeFWO(5sX z9EVuGwQQu>%4i3%3;JGL0`E8QK8gd1OQ(~LOn1VYHMZLlnqwC&2>T#;L(`Vf7L)ki z0W-inJ}B^-wD;c)y3N8sOh1vcU$y%NvHtI>z~Sb-z) zIxN6jaTMy=_(FUVi*P5B=Qio#IQ)U{<5A`A38->6ZKi=1$n(H~bFmCB#7Q_5EAVzC z&mOoJ>Dv={1g9a--B{D{AG`s(5f=h@0p5rM@FrB-!p(R+&cWq459v#9-Gaa30_43y z)~(nL7hwY4hEs4UPQ&HMyX>qL_%+^vDqpY0+PDUJ$BnfXN8>uY3GYSTyoD^Cuk|VRpj`VI z=HchK7?0o%`~rW%FR=^d*Q4meZ?FQt#X0yLK8@eww|D}7!k@4-z{9q~2ngnDMaGk%3#@N4Xbzhieitr_Je?1nwCJNCqju@7F3ebI;g zFc&YvS$HvS!~Xa^UV?En249L3@iLr;mm}kNS+V#b#$nVMl&3Hg6Yy$G!U9ajA{>YT z9EAVER9t~+_yDHkHq5~N$an*RW0->tT98g+TO5Mt;4tisBhZIeVg+7}H=rLkVIDq- z1$Ycc<8d5|JzJ7KqMpUS1{dQ5{5O{2UYvvG>Fo3vf6t#!+}1F2yBy5SL=B z)})Kr8CPOFuEG>tjU#alj>mPl3D@Ixyc=J_d+}wwA8WUvJ{6KRR~G)5Q>=wnTjps7F2pu$%VJdC?_YQ&ExxI~bensMn9Mkk}NAdOgBswxgcTeaOraQ7?w6 zZqzfy2I~hx)P(AObnFzzxQwkooxle;)>`I+s5r*6hbE3aj2G~IGb)a4!NExH<-kOI z9B;%Y@OFF>m*aN49~oaR@Cfd}9k>(U!(I3bzJRJv+=HEwk-!4y;(k0251{H5UqO{W zUPZ;V*KrEIfy?kMR6XI_xDVgO14y1D@Ctr_iYp(Y;?z$59UBp+=r>9MjC&^552jmg zTeefCrVcHvSiON?RPk|&)mxZUsaU;@K)1NbnY7!S!-~}^-_B(&`$UEnlV^Fs!D6yX z;Q=pPg>6%koI+4!$yv?hTB^O|0(Ppjtms;m!QHFDo?;e$s-AUjIoO^xq#!+vCA)hT z-nGsy(ds?aCP7SQ#*%2I;-=fO{Z4r;Hc?C9&nqPBQi>(OURSUIA{e&=l&9Q}&Y|M= zt@?!%{yO(6o!2+8Bff*@;X&++?_(T(fCKRmX5&Yw^z;*a6A$AN{0xud=cu~DFR>|p zh3eOF6w~l)R62PKSK;^g5FW>e@h5y1e@4|2{(^_`SJbo4C-Eoz1AoVVusP`>JrV-# zu^M*A8aNJXqS~Hop~}#;aVge8m7$~XAlAd5u|87IZ#6*bN3GM5`a!E9?nV05ntpYS z@fW@~MO9oi!%LBTbRZsiUL=r#tx)}&&%`2ZjW=K$R2y|$T!Uxfqu37hzNhxsjWX=n zcqMkgQFsm(V<%MGb7xc;xGO%5=OSZGSl#h2JReo|?SVXRZ}rBx*ax4$zW4%OhzIc^ z`~ojV^{?xXO(@e|ioNhMjK#}w0LG#ELnq)3=tH$VQ;rC{fXP@Vin14tAmpI|O^;P%Osb$UBv+D{v8Bg}l$kx*GpMKgLmJ&BGGR z$4yv(8W*k*KgQA6jxy^Q?2cpcYAnJfI39V<&zgWdFK3k?&%s#}@h2?9o|IuHA`GV zXIpvVh^C~7ui-6Al?D&(89AD0<))^{KHWVdAIk0-IhyDN=Ki&gJ*;$>+d!auFEDfI zUKnYiCe&M8FH1p*S{#2)*KpmYV!a@zF4w*tnY`9I(n|NE^RD~R zL;}?QqEDS>_WdXdJMz6g>OOQjs?Dk)4#LK`6Psck;ug=}nYPu|IDzkNaVEy#5^RS% zusy16sRMqG9Z~(XJE6uE?Sk>x6^rp)ydJ5yFwYjBhfnjp2Y!w{u`S!)3w6KfjkL2_ zeQ+jTfVAgWeeq+w2u~pOAEwVzf4rDl zdXs=f`ksUhaR8o&$#?~(p!zBe!mXH!8c#GG^=xk@{*8lCZAV#Hh}pOnsgE)D2gX7S z?BM%QMWSb@LdwOEhze=;`2Y1kjH!+|&*OOfX@ z1H2E;nt^ZP4XFD@059UcFcUAs*~q(DtU1WLGOW4Cvn|#<+>E#2D>xs2#|2oE`@%wG zj01v8Qp-40ct&jvv3p6!-rAnwaT`U?P|XhZ(9)lGu954 z0o3=!ORIVEjYD4Es5$;F(uk`97 z0^V}MALRa~WAZR|#?2UykDxaEQ5=a|aXLPMx8Regvfwt{j8EZy{5QUf&*10yEUFy3 z1DmtXo!9|)q578W#uVIx1-K6<;(nZkFXBQxfJz5nLA6D_ih7=fdR+7FoY(PFzQ2L$ z%lRg%zTs``jPGC%d>51OAP&M0Q15y95R32-&cKgxE*?g;)qjdl;pg}w9>I6E~koh*#mysC@Y^Sb@JH{Q<0#sC@cwsJ5*?aU=eXPoYKp zK8`g|@wlcF-(O`?TtxolLekeJg!jTK@+W$n)aj2LR_Ij(uKaQ1ydp)VI3JA71qCKM zkjGqM*#SjVT}+WhR^9u15FT;wH+NjsZG_gJX@3-dV+eQa&mLj_wU3XY!XL+l_$1zm z+wlc_3RTW~29-YSK#O?tJZh}8o!A|BVJ7ZIJ*Tl3bwA#RPvU;ujxVC(*-O}g^L_v| zZqUoP2w%Z%_$sPx^EIr?`Fb5s!#B`}Z=(7HzlHQOvEIg=_zv#Icd;7#{T}K)Cf}b8MCGM)ZtcV=^vN6g zyb@mOZW(Hub#A$JSfiZqL+qpW<0DkP)yJqb>QlTBKSLiLL8VP!;B5R7b(TZ{X{bV3-cn5MlJU^bVyB)e6xUEHmH;sxQ}4I#80^&Rg{^x9Q}ujT=5{l`EWlv z{)z|P32^&M-rmxV2g^|LUpaF5ZRJSjT!)zsIjpO$ z1H6mxO;O_=G($aq&;oa3OWcpGQFTLYP!8@@d?m))7 zHt&Ty7Z35hJL(?Q1CL;D`~mymuSnaPxh_<9oEUKrDI_ncXdtV&F1&nGd{26iAkDl1nuh0u^KMpOd z>es^vvkR;0M`Z@=(t2_Tjwr3_f@{ZL$Xh#<5QXJ8W4(Doim$rPws5Z9kItvAvupzH zal(J+T}wLGf1pehpz>mE@i3l+|6mNN|4=*B zb2#m>7oLrocn;=b7o=~e)fJWZ>V`^(&PBb8tUKx+d>%Hz^HF0z^uYeu6JzlL9Eca< zaO{UAcrmWP{RIGuWGq-~ASU7< z9D=FHn5R|-&O-VS1RlY`_#I|pb;_*S7=t;eXNz<3S{#BaaVT!VVYm~A<6gWHk0ayy z2iinYSBWa?`f(KIp`JO;$2B+-A4mEwn6mCD+|T#1_$AVpA#fCnQSaKAhIlbb?=*sU2r-o4|F{az#DKR25>&k z#5?dtd<$>FgE$+jvz|G43C_i#I1hC!Z$TaNjr=7<9CNk3XtE=JYO-G)lfmg4nzJKl%O@Nry@ zU*ZaE%X06)ez+R*@lI6R_!`u)S%*4?hxv;f>*Fob6K%t*Sj91Po~f;T2*>i9Dn8C3 zEM-!q7^~Yc=zB2)- zPWas%6YcjssAGRGDjwg5%ER4{m*7T>NBS?Bw&;iOYQAs6@wf%GV~^qtd<^f$C-4c} zhOgsOcnJTE_1K1IFcF`{Y}|p`=3O`zU%(r2FRDMoK0J#1@g%;8Y6Ccc>euixs&DIS zn2T@VP5350jBla(u)c#eIUes}Z9ItW@B{3LAEElRevI_zw?4sbco-E&K10PN)m=nh zkB!f;^Jew1inzonGyTLXN2ae>U=<%HG9719rO0%W!0^bVlyV!PZfr0Q?(3PUEd++= zW=M%AP;n6*{ScGv98FlW_XaOG*zB#@*AX5OE7c2pwKsc}y}(y^lS3M>7Zd1isoi+3 z?Vn3%SbuL_AprutE5x+7Yg-iQ!uQHjN?+>DtUgGlK5i^QZXfTW;^4#Fd4#v)&wdVD z<5~<;2p0+^CA-=rlK}hpI9WI47*oAKyX#2!g{hw9+K^c0vbVZ~p{z{>pwdL$-`$Vm zi>}MV1T=NRzaV}^^ZiTgfJgCs{2Jr%Tg<}acm^ zKwX!A;V%3eb$wQAVPBuT1IUcGPy;LZlyM;1G7g&#^PAeZ4E5#BSJ@ykB=zJ$_dH+?kLAuf)=AvhK%;5Dc*Q^%v);Y(0srIzByI1#NV+E1_rUW@TK1(g?_ zidW(^T#D0iA6}1t;tY(fOMVIU4ERi(fj8l;crz}++4um?!Iy9zzKpk^+FNeL!?*~K z;%)dFF2TCAqb$Xicsq8*<=7urU>2^#(YOkESGlzs@5eilF~qDj_%^P?U-2$f-}Uv_ z0Pn{ZxDmVJgE#^=;V66<89&(CjEoO#J&Jm-?&HXKyB7U;1B?r6ZNnb;G%`M_wF4RN z)OsEn&(zw9j6-VeLdFNRcH?^7gN)m0?ZxMDAHI$I@m)NChwx=o`~T~xKJstirT7*O zz_;;cd;c;XPE9(UA!yl0`rmUZkF{G?tkTIdGlc;COf5Tdhs3XEl@h_Z+ zeVt1^M!?6M0jHe_0Vr38U!)Dmx)5m#vic!yHr7R0zZqpu5T4hZ^a?M)G~^xPRytmX8OS@mt-;7U zxvgx}ShYF$E#{)~O+)bn_oKJ?ONuD(j3nJBDp`7F^VIn(^%<<3#nP?4ijR}U%41Tc zEY?^8!?Rf7_jNC`-j5k0vPGw?YX56z!z z^D&3-1vmyr;bJVr?Km2L!ZFyJdvFn^<29Iv<52xMi&1TNC8$1e6Y)iygdbr!{)X40 z#$TC??QtsV*iS>9qfPupo}+z)Y1?=4SM@n^o=~jf9O-~p@o~;kDU&LlqbUT2pCh*g z_A@S4a&~07%a!jo88Bwn@t@0|`_cC5_-mWpa_RN#pS}lB$A2bv#vAbhya@*&&r}5b zI0wsc9+u;LoQ(@`Dc*|faS=X)|3V#~+fc`G0mnM>eKbp=NQ0O*A2l|G^KsjZ>}SU9 zH>14gP7Kp+AN+*Su*0TEyp6z+8dK$Jw-Ds!ebth!e)k&)(+<%BKAtA{;{0+3bnsqL zzK$so(O$(3osyT$!LKwTlTM+#4m;DYvo)4bdo89AVwSJ9=Miq_+s)8QAww}~yvSip zwe$bMsg@>WdW$o!Y%rZzO;I_S3GUiW!64R~GrXs(;>Z-@x%<(%P#j4mV7wFFk2-pt zpNsG;yciWH`r}P_3EqyE;$wIjzKZeq87APbn1p}f0PI9ONJh1Jq+nkhh?6iCr(zna zy*(Y(R>3_eK^MA6{u&}uf#&U3a8-J zI3NAE2J`Si%ty70j>MO76duGvJc48JCmf40E||z7E?V&mWn7N;9wr-+8z@5Qj5y7~Y6i;Ve{s{AOH&bCCDd zS#$9q-h%4iIv;s|m$d*d!G(AW@_duYPcKG|>w6n&%%r8LeoD9FYFviT;&Rlpn=7z6 z@n|Kc;~iLlt8p^kiMrO;pwa~O&4?T;M(uB80Zcobp6hcy>Ms*|<(z7)7^MjRu@_^{ zN^Lt;bV&^F_}H_DsiD<17naCWDowjhE$#)VBu3riJM&9BEF_7E=tdLVxnMnQXria% zqU*B-%R1m3l--O~pkws{Dh=O<-S9;$#CNa+-$j*|-@_a6LtKEA8BKldN4S>npW*}f z8E!+$l7Xl2D|{V~;xVLsBJeXF!y0VYH&_e5$CgN65z_|qBX;0B*GQl%(s#sM_moY| z`LD^fN~3Tvi54uOQGp*``(s){vlHYK z>O|}JG#(%KCepr*T8ARb2tcx?T9;!{EKI%-I zj!$Dld>?c@Wiin0*bj!H2N}Zb99PAHlIm z8?ULudIHP&z76li?YIr8&og5;KZ9yVeHLqQo$W-u_h%QL;5vAaIM~-}WUhX`nonQO zo6_X-up*cy`%4ST3VZhTU&Am~g;NR(Ov0=*tcni_vu>9=n8ZjTWVU%+RT*TAse%8>n^aO- zUQ|*%$t?T0LOHfP5;l6YMu{@%sZs%Z*>{ zz2sLFHceqjROSvkL(^PB_nto3yh4&nJ8wUWgNL02bq5EWvy% z#Ud<2v$_!q9hS{%2v*c{hkS6q*Z^LOJ3_Un88BF8IUNEqkEn$4e|v+sO#O-#ry7+X~A z3=I{$LWTw0nZo1>(fv4&sdq)3XcZL460UTH=Nq}yLgSvvVKVixMw)8!k$%&pWhw5) zFlFd}jJvuFV=PjBGnf5)UPziB62F-0ezd=eUsN|+IZj|Y$4AFt2rx#AW3;-T(6mS6Z<(~GpF1^Nj;vbnVhOGC z2-@$x>CEKF%U4g{#}IB`sYUh?vFlfc5$t}njXEY#nCb-H&pv6pH=^?B51@|8LwGqd zW`k+tdKh(VHly}&3+h-r$KS;f>9D42nIrgP{2uocdMs2(Et1GV1go$br#-;vLP=$PrF{U06NzDeViTIkG`j?XXW)!-BS z8ZW{`X)}N2|8WZKVq&Fj)H-(X7rKqDNpcC|Dxlp9xkk+~T*$v8kKs7N>hm|6zp24( z47t^tw1sidNGZ%Fp86OnJ=5{CFCTMrHgQw;cU`M?I5$8O8Z7tbG0pvGdm_`D7dgh- zM#ecYyjK|kd*VyZ*{dxlxhj#K8`7ZJV?n64ymmyr5oP>RoE06A8Hxws1#;T~jJ)?VC-`%r1teqkOfPnfQ?uKew9#Q*G%eU2hVW7I*c;^Um3 z9!v^7#KAZidN0xXbUbyPpX)4)eKObk5j=~qqp0oq8nxY%`0F2$KD8iB+pYV-b-}n* z>DuycX#aiV8NN;t#>5Y^@rn!DEBB*yMy6RG5dXCuAELJ9kaIn#TzqN7Hs=$jd9LK| z`byhO*Ri58#ij%hyd<>BDn8C3k6}`4v(+ZYZ)!NSp94);0hgHCGfc4d!@fgR@YV-Y zG*FU4Xr()~x9`cC>U^~A+IRjVowGk*IQ#rHs-5E-jK^;=1HVJ<>v7b1jN{}tv+75` z;O#rF2KJAikY8$@MTN)hCOF9#my?_2^Jl~l^d;o@6XFt*Q_=@`GgPzO8AfEJ`~1FC z-;lVRl#Fx|VtWbIy&2L{(tQ5pxb(zSEx?^#BYb*xdP-7~rgw0DU(=gDG$lPTW2isN zmz|T9lAx7jTOFObY6a)=#b+e=Gcz)CGt=VI;|BQBeCat>D`&pi-hA=Cv9{;!}P8v_byNtc;wDgp5>gO;O%lsTm1zscGhT`22hs#MY&ABeM6qt~Xz{ zFCjN8C1-d%yG|cIdvZN*vb#V2IQD6XZ&*rtc1~PsaE0|N&zY2x>eI?nGvX5I0%b3; zfj3`VVq!+RKVaJ$cU=4t57lbn;2>CesfWu?b);xgm1vxjD6CHkF% zW4Q}$q-W-upQmN!WK&g9CweAVb}g%-pwyo_-V2Db1IoRCx^_T? z7f{axq!oAp_3eOSFQ9=5NFU_|G_(Usynr)Jz=+^#+t>lhdDn?v&W2U95)%9giN1tX z5+^&Tx`NWO6NrOca%3Pvf}JpT)*5EkICs`2&a5>RoSl=%&r{6-)S7B3Fex)BE<4AB zyEE4|GY{9gQmIt2S60U?ICE(DmPI+C&Q|E+zsn?>2_$p_e1o_c6bI6LY4N@+6LB?} zT?|f6B+bkrl`?a*b{4=M2j|H4<>(T$&#->aPKHfQ%t**pGH0i}XFAJZpM!G^@TL2* zICe^QwFve-I58!CNL*@4VqA{T+eD5*aJv1^q&Ouz9KHI{jKJx982P`KU9;7KaMe87 z9}_;ZV)W=jjb~mb`XjU3L*lZ`m5`D^2D5&&Zh-d3$$j!d#t9YWg;T7SVN=J9FBzFX z-kH>fNxEy>A3I}Inm>kD0gdN=ZQ{&*X7kcXEQtJO*UbIueS+&-N}zNHNgu#nBAYu} zM#i8NpZB|JmiZkg#oRc~VB590>UMBk4!?}g8{ zC;9hoi26Y-X9ejw+!MH)CHb;Q*nCzeeylBQ6uN~;sc{2LlIqXNaBjgSMruK|Ll@+2 zf0VQCj5M?TN(nV{T|3x~Dc+{m3lI0_4A1nLgQXvx7BMj?D{g>Us^a-4%uvH3`O=}% z&q%KAXlO3>8<6+ zVa*lBHItj3;_cuWCM+W{-HR_RoDgr8mI_En$x1LMivgASB&6u%W)Jcw<&s|O1S_00 zmhiZQ1n$uOL|=LeNtb)vTDeO}Gr1?tPJ+wq>As=9EdLN+mTu~7UP?B1O!xSosb3{# zunu=Qt=*8|a!8t4PDX0tsh88ntX_kT#vh1ZQT{5m`sdzkK~-C_=fpNj#86Ibq26&+z^y9 z`E$saXXNI1NBu1Qp4dkkZEpkjK7O5>ZZdczL~-#MSvlTuiE(BRp2&6zA;*(t@;h2T z_et#``4rY2pTV--sNP=lrkPA{mbb{W6_}YyhRL0+gEN~6ba(U|1rE;jkvQl!t$5zi zna>V&PhBU4=4R$(c+2bT%x41K<#kb@Zx|VIZ@#Vy;yz*a#@(21PN3Nscg^QIf%cl+ zS-U%-Ve2_hfm&jUx83I}$Ty3(g#N_AYnA?X#!5z7An*aBh2oyX-h;f;p}3vg3nun{anu5}a^5X1Q}GI-zdl za>ISWaI=N(wj>3^?QL;?Fd#S~Y_-WwxE;~l#iTf)UR-mxa-h2y6S3Uc2L)#jKX0kd z1n0cD_sF#1{LU12`RUFS`;5BF&j`+MPjKT!rZd5bfbRT*onS8xx)ZX36YLFjw_PX6o&D8{DX-qtGXCLB*x)IHteW*Jj?0gM#Lz&%7aQAGuJHbAU?skrF zgPGr+;x7LRcZxZ^?&e(ShBCjI;4c3vcY+D*kSGwRq*p{QZ=(l z$;zH5Qp@8mVU#_$*$~Bk&00M;Yf9#jK3?iq=q=gI?q0Z~?O=P8-79E}H?JM;&OFu* z&r(s&%N-VZGuz>Ax_XTXPo2z28?Ufoc9@${oS-mD0^~+0LwWfx_k~b? zy-ll#;?1aP~LHy5)3n$3-{np4TkIXVKPNp#lGNE73ZCh8BTz9z+Ki23QN#j?y>@INa$=cO<)F9 zc`-?p(_irrHB!c_{&9+Z-4 zwnx4Cc>4&6!H^t(iUxMGzenkNJf(f}JIzs7A(R%VQcOrTB~IQ>qTGK*FyEgRH&EYt zna$OYI_O7PKIT#NhqI~xjkgLVl2e^&R!u+DK*?Fs#H~R!|aWw)O4p%z8sK}XsQPkUds#T(xfuo{OD|}LG(r@+8?)xepKP; z{EG3sMoaG#m_+WgPBbsNVQX}>Q{#rKWRo($Ppw)y4FEJKWKl*^Elf%}C6QDL;PyeB zVj4kAlZ(?58^ih@ue833f>C}RqbMmGHHiv~sQ+cMPR1aMW`<1RL9tvP;HPQ4Mq0_T`i7CV#Gedi} zleh6yT0^N{qZXFs7mq2l&T$q}Gjt*G6xh`IVXFL9t>o=d?avbT26e42^pEg zO;dtqIxTdjY!+zF4)^42JDK3cLCP9rrJA-T;th9T?qu!}YY_T#H}b~~A>mPLj;Z|D zT22q0&1{8xIRxibeZJ;x7&@;xaM{CYg~)V@&ZY#U`P@o76R+6t@VVTB5M60$xtVIi zF(*{*I9gPb(3x0N$Sm%1nugBewhNdn1(&W0?OIN=(3woriK1wCXKM4%sdl}BFR}75 zQ*)ITc1Gyz_L}TwDm8+c>P>gGEkfs{7C%EL(X@|fIW0q{YS)>lwNlrdm`V+~GJtyg zk_Tu;jW5g|TTwo$WOA`dh@T@k*2<3arxliuEg3~?wY_PrLKn%!m_wC_lAMg}6m1wa zwnQ{jyQ&Rn9X5Arb_z`b=_Zm>AFB#*ZGl#0MX{<(cl1&(jeM)ZnpmeUcV7yWF zx>nORbT<3?SHk0^5NCx>&x#xB9(nIlhzXs6Q#@>VBCP~=Dx&r;t)yM(JoeqxWJ$BV z)wB;J20*LldH(@wCe1Cjn@!c6aopQ!3pBkIJC3ZgLj2szSwXE};Ri76+BNu75YPqN(b9UX^ zBligQ2%X;~1&TmfH21no>=`ykrP$@B9P~-GcfMEX{N}7u$;s_6C7oKjG?VFY)0W<$ zvu5VTr>0~lldgE_m3!^=37yZmnd&|qoKyJ&9r+7F=QJ&zR4NWJt$>^#_k!sgHkWcQ zSzcBlxJ-BM3&ZAC>pXRMPFfS3TP+`Z*#f#++Nm=&jLL4tKI*KW2M2VD89ib~#AFr@O(lka&w|=mgR>Poy># z1)8^!6YSj&loDz}w7U?e7la!1^+Tnzn%>x%?(Dkq_j>NWnw6QI>&2i}glVySn_twkOyOOJ(aE&t$r6J( zO!CQ5(Id&2dPQ>nF`=aRl;I7Tza3YD-8@+_mK$GG^w%tt>}XsmLlPG7EN)404!J%G zyiw6#F)1@8F)cgAw2zWGrP(sqXEvo1n{F@1Jh84ttNk-ILoJvTZ5j}umekbDAsO8N zwe@fDlVH0J2OuiC0YRn%bYW5PXx=VXURF_{2M^dz*6kcpyW3Kgfm(~2hO)Ud{W-*q zsOT8JQkS3Vi%aJci;Cu4S`3m@=>hToJW>0jB{_#`BulZ6owmteQB+*cfUH{lM)p9h zsirfH-)o6gbxTzA7xuALaYv2rX2;ay(4Re=TR<97A}Pbn$jcyg5-2bwm>IPryr7e# zmpfDiMIAm~AgOuyshLG5{}Ve%&7CyW+s&k!Rqfi$O2f99^$ddazHe`1u;H7lH7c4npYaS_ z#YnnoPAab=q#5(@=1r@#d@McYM@<-6pon8m{J-q&GsjCirdmWl_mIR?e~Ri7d-Uj` zcVE~Mrc7;t?3j+Cu2Tw#W6YJBk?CX{qoTiM5AE|mp>RS;*;GGi>KHup`# z3}S{it9vb)$dSg9Bc2|xA5&4xIpsthhlx6p3=`Q*ghDisr4fR%(Kulu1k3&o{O_ ziGE<-<@X?AnF;pgr+M_WhrKIy$4iA(uzOyD&|6hAQ6^8JJEBU1WGPGx<6Ubek>)86 zKTkB#m&A^FRfX%!sU0_}5Y58S4W*ReD!FcDX8pSm{RzWS7ys8T;7G3jMafi4j{ z3g|j98>WI9#k9Ec^0FLKLWXX0Z-#b((wviLn29JiAT=XCE|o;b?@PAtuGuDa(PFi? z_QvqV-rSL9VhrC+&kP*~mFtuy%?Q(vrS6cYO*wEV8XD0bIgf9-$z)VLMT>BAEbOB$1l{q>LF4w$)vP&`+N9da zjlOEXojZpPgHjO=y`7LK$Fzk2Ex~z6v%u|K-Ii&(9>Vq}ieMe0xh1Kq6rp5n(|M-RXO2(H0Z)DPT@YeOPsGLom9 zpctZ~Wyi`QlUrQRk`;xrQ_?c&rtG%7n@i#@d#%CVd(`ViMXz;!k)X_4Zl-@gRtEp4 zxRu~b4gTJZZ}z$>CYwmaTgt=lM9#r9C;U!#V(4?DY;&T^(;0>okHBJ zJb|N@LJG<$w6hM{j$oYgCz#8GA6UuM)v83Plw~;q9ChtHh4vv-xkQ;R>$*Zsl`>U> zPTzD&)@p}}G6fEE1*^2_T*HcN%Ftvcm|LCl7&r3O$@Y+pn{1EH&j1Anqnv$nVyk}Q zFHlcq7Ro`@9xW=a*6-qp54PXa@LP&4h2*u=0*- z(;IGmbza}|`vnH9UcjRrqbG`MJ0$B|1?@_uAF8aupEwN~$@pVqa*JAb#z*n6b>^7rSk{U-eT zpBoN8d`)c1+%}uWC*v+UMAoBsS}e6?F||AfTl zP7^*grSl!PuIqW-l0nl;J3qaF4AdbL{`&D5^Pd^r_561p+}`G*dxr3EPwP5b&TaRd z{PMa5@3n3=s>#yWwu!7a$Ar%qQo7{G$uZwoA9VA|P3!fn^6e(PL#@LfcWTn>?Cm)X zK014N|0tf*GT}GAwQt;^`p!e|hH3_tY4d65s0O+`H$U*M~8BOn9v=k7eGL(DS=x_wIhJcx0zomT$tJI%jK( z{1y8z=~QccgM0q?o%5pic{QpwCiCRHy~`dvR&RXtACG+4j_V@Rgl`_Un4G?HbQfNpkMXI2H z76nBVDTt+1)D&tPq$+6Dil_wv8&A=yC%@4IHr?7hz|rz!rw-}gQLK2LMrz4n@! zHEY(aS##NYPuTa(Z-0Bon^*_&ng7ON4euO0e9q+ATVgvOT+sRq@)!C)_S7i{i^%d9ll`Ul6hAh`@`SY zRJ`#NmTJnF|0mDxyx`R3mmYBQ+hw8Zusw>-1|dYe~x}9^fC8VedH&%FI@b@#m|oY zX!RFw#q)VW-#+)RYu2{>^PRrC{_@X54mzq2&!!9gnsF^3{nq{$e?5NtP3>R&)q6jN zcQ)Xmzw+3{$Glqllh>a8!E+aX{pXYZdEck7%pr8|#SL$Md*k$@ue;`F{a@SmDE!Yi zgud|AMcK}V)BdvNyO*}Vh<92F{qncHQ9I83`Oe>M{r!XYUHKW6SmgGYb9cE51Daq!U&i``(33k6u3Da5(Eszt zO;@fOxoy+DJ1)8?e(+1MXZo7**jYb0;+&7|z5c7Wp7i3sZhhj3bMQ_~jFaWDhwuOQ z1>c->%jWwZytTZ->xY~d3H@W!UwdrcnU_3!$Vub==lJRT_}L1fKX~D#hdyxT4SRlg z=}$+M{OTXu@UAAIPyO!8AG-PFnh7f(d~Ij#x-HP>VF)J6W2fBo+_&5ATDIb2|JiTz zkAMG*BOt%fKXvQovyaJG&2_-~HC|nV-9J{DYgmj<97P=HLFtnftBZ^BcF0`s%qqJNKINm*IUYLVw|? z^Da94bIxm&zn(l&#=AL%D4PLUwz&_J8mhRe9NzX z(bj$B-_OFhfNxZRzW%zOb^g@f{MAKY``PAzN;`RrZb|Gdyo{reAJ`%3@er?)*>R`vSnH#~}W zX9@l8Zy)f=7hb=A%~wWFef>9|cpLoq-U#yF^z3JUKegjG@BdEO2bQisec&Y6r_f(p zarU{VzW(ExKb}76{;SXb$-VOJ1MvTA>b2jV)BfY8y`H`P?K4ii8Ga1!eg{2S@#vXH z{rcYZzrXOUtELY7(@|Le#?zGLvE!CCJ{WuSg5-NItRA&Jp78iPq}e>-vtLwc=m%&PW$(m zQ_;VKe%uu+f4jD9!(KO(pSSb<$DMu+;u)b|`_rQ@T>Pu=lwE(v8}}XebjMfmJr|)b z-LHA+imAyx|McyV8&_TV*}3x0K$JUf<$^`u|H0YkpI_UsZQ9buKZ$q`V_|u0PTz*! zirCh(e{uJZ#(ny%+s^g8KB0eLulq-gKJtg@qt3jqHW zbR5Q*GIM&fg>BWjQ|7(z_!Fm0pVc&@ZQ5m1TIbDfYdyYs zXo-;{o*f-(YAh?wojq%)sZsV^JiRc~d$PNGtH!*cGDl-#vu6+4cxKL=d(B*YO=76!x6GN_JY?0)Y-%rD zZsAThcYezpEFWEdJU$9BG`pQWb^5d+s}8Eip3UqzrV4}iJ9fj}sjj?DWA5(cFt>FY z4(S!nA-|WJed(3Ep{?n&rcRrty4v-zNnJ$sP-SnK-9i^*k`LZgAs5-!I(^36!hUfO zD{aMqF;uxRG7L2-%#&mMP?JxeiT#tASeP4f4zp)mwj1^WJDfJ{D!hREFK8Bq%hkFaL?tU)5O!a2;tCeGzUZhq(=Ct3&b zHiZR%zrv=DX~DreZD?gycZLgh+x*H`Z*yW{+sU7vU2o`qcKXaAkH#n%TaiN*yXlIy z=^91ux`#&5vo33$KjbKU{;XL;c6GBZolrH@O1I6Kfpa`VO^sSR7d5zrhK7|O@;+ta zP|XyB`OG0lFA#gq+&M#5Ihz~f;t*$xG_>95A=74DG325l_-;70nRDBRu5uL3cRdYN zX&6sW8gkl8uM7sm!3`B}hA|}#&PuN<@5tIspF88)%i3F}&MJBq3qN=H^g)KVf*v|F z=_|69m}~GG8bj`K>@$PRl?soCO`IwY)db+uTXrKJn-$X6u8$6LTP|xd0m&d8cMt{4 zY2BTWgj?2rn}qg(}#dD)EJsyzp;*11Iw3>k7u zgtAMu4Ua5CNcb*{5_6lT+U4AQUM7Dh(#gw^LxuUfwI0cN>(G~Z%&d112b;g@X3AZ3 z=n}FNo*dS<9brLlh^ydDIP*B<=nnC4VfQe|xPn!t-3ug>9dJ_7L9fCE&63cIiU`rUs;J&HI_co8P zv=QB!ur+MZUMh(Uv*dCLnGHmU){M`Q9Y#Ya3cpk?(Z_9VUE>75UyooB=Sj zYDK=c4d}hXw_TC%)nPB+(CQWW@?D6dg|8Vq@kGAI2UQGho1?A3KKgOOcb_8Pd&ANA z)l1$*8Bj`<@YO5wz2_WllcR0Me)q}3$1hb9`Lfq-XcgG4Hne3xrwQM3MbNXOz36CF z*nh@0H1s!7kSOVgs)nW@AWy_I!CLA0bL+`lNI^iV~)1k(MBJR)7ZjS zt_V7Cv=<#MaRkmN2w#OF-}@BM6+*j2k?&m&bh*&3ROEZ}fi4r;b&7m%G0-%jEm7oq zp9g9Z+C7SV??IqTh4w8)zV}_AsY3gKBHw!!s8MJ?RpfiW0pdIU%e>z!^1U?B#X|dw zA|FTjaLz?&I~Dm}*^%ZQ(`8; z{$?ohy=rvc>B2Wj5!%wx);Zd;N}P`pzU7MGhj13d(2iAvehxHS__is64WZ*3+7?B= z_X@i99O2ul$oE>0x3qReu-y~zJe}~3RfN9pXqy}@1qU%t`05n--hGbtfTR5z=vv{! zoALy~cPc9LmO0u!C*j@Rrd&nnGmiG0qb;9^vlGI1ry}1w7H-DSsucNN2hc*{>r{lg zonmQY6+srDZsA*|$oDGVXK9s+;Ge7U-6r9yR)ltQv~`YFeyaKIX_>c=BFJ}|rBx|H zzkENwF(dh{Rs_F$rlr*@f)0{62Pu5dDe}FB8cUm^$oC!qx>fkTsR(Tj^m(CeRpfhr z2U;PtHx>EbJ3wC&+OV?>^1V3F7lrm7MeyxF_Xw>*k?)-dbhpq>R)jZ50No|D4=D1z zj{$u_XcsDi&jz|vXw8c7=3<~bgm#T0-@6Iub3(gCk?-9B^jV?Zr3g9zS}wG2D)PN2 zfNmGs_Z0cwkAOZSw4W&Q<-=`8f8A#rO~UTaG2eqJ^EN4h5Bq?nEm7oqTY$bS`MshD zZTUeeB9;FutMUAH3G?)jEh zsR(ue^ey4rstC6GVM|-5$oKj`BHv&@ej62`PuE-81B!g_n;$jbP%iUUDuOS$z|z_k z`QF_aWFD7tS15w*PPViuihS?RkDIgfW!~M2d~e1lEUiV6?>%{;=Y3D|>r>==JAj@Q z+P@X~-tY!|e^O|p6rt|}JtMTSihS<~pnjnprO5YA0oow6(-isM2Z7cL?L&%u??Rv- z3hh&heD4aNbwayJ5ynBFr-gQ%BHz0i=qaJ~DuO)&trgl`ihS>DKz%~{h9cjafTD#F-!nWfE81X-GKhEn({6k*JpZfVCV^1a3@ z@!bgFo2JP3#$RP=2}S6GGjLX4`05q;Ug=Cr8?6Ym+4%0L@QqgFdnGNFR;mcG9?+}8 z*RKdM;nkM*m?G$JF1}YPd>a*^j8;n4-^;LNs4^$OrSl5 zcD5qO3^Yb)lNI^iRG`s9yG)Vq%>m+fKg+y%ihQpN$QRnpiZB-f+Cyk}D)PPifl7t; zbw$3n3TTwj)+qA54L~D>_N*er{6Hgw_M#%+8vrU1+UtsZ?`@#rLVHIMV&#Q6w=1-` zBG@00(cc@2VD|{F_7c9)iqJ-m_N1dF7U2~W!dIaPehug#p*1Rkj|Cbpw5t@s)_@Ka zT8ARv>jC07e#*S1ihS=2K;wk=MMb{%4WO|?dsq?18KC`z)~Cq#ehkEKMVEQcEAqYH z0qrZamldJ!-(>5tQIYReEyjz6gm0oE=*rRFaJ2d!oXHoy$%=e$g`?f)Xk%}|dW7(e zSLAz>fsPScgCgH+0yl9%;T7qvG3E$m{eD8UnGlcdFMd+76lZ5t) zBFyQ4P8Zr=6k&`4I!$QaQiFVN4A7}U+e?w}9Sl@0w8Iqn-U&eO6WRnt=+i*_Hhh_P zwj$sA2++ww`Q7>rd&lB_m^8*LJ|BV&;`PGry|U|KWk}|6k+ZR^l{cwv5L^o9c`ndjlC0V0Kzw35%?T!qob970qYFHw~r#k%8s_e(OU1qT88koE5aPY z(RMi6V|Qb{MEF)Kf?n>iw1gtx+XU1se47++U&A{% zgs)x^;)n+O|<@NH9s z`aW!FlNF&~uEaA)!na8g;@w9qZH6Mmj*sG-t-|-1BE+oUwzPUhpnV6=5(;0vBDAHW zZFaQQRrp@5@U<&~o*%cgN=5LKK(`8?x7r|#p^D194oCBzz&u&_N)-8Ci=(wV+SoOi ziwoa)MbN#YEe>ek#e84*7Arz~INBSIcIT5=KM=mV6=4nKdzMzE$oEEnA8QoCSFQ-- zrK8>FX#GFHoL%@fD)PM%efXZ9(DqP-IU>;GLK~~d_YMJCCA7m8VLS)=j?gA5^1T|M z$Aor{BHz0J=-Wd3gd&W|K#vOT3PrG8phtw(uE_Tm0j(5Tk0Rgu9MHo;`+_3O5rMuX zv~MUvd z?WG9gD$v)2c9M`~doa@U2vYHK+}i)~pEi1$s*OxI93FSO92?(9TwbFY*BW zUT7C6^1V+2{Z42XDe}E5fqpBrS&Dq`I-nPYwm=cqB7uG*v}KBX?;fBRgm$kY-}@HO zuZ8xgBH#M~&}N}Mtq6Vy=vPA9q{#PP0{W%UURC6Ke*^l3(Eh0iYbein-X@`qQiT2i z^mCz&RfIJZpq~ltC`E`PfSwoHX^OCh0`#2FKBNe9Q=p#;ZHgk_n-267q0Lm}d)ET} zSZFsW^1WW5jY7Ls5ynuUXN9&xk?%bO^dq4?qR98Y5A=-Co>Js{KLzR++Rqgs<^tLv zv{w|tUjeNb+8c^6Ha=_ZWgkTt7k=S+FA3jdMOe#qwC5ac$}c_d72#`C1bcS0en&g@ zS9tze_^K44eI0F+qxEmb_dkViqayT~Ut3zEB8>Yl;JIVrODe*?fun74wEKR8?@$Wg z1Bx)Fyl82aieMYR#kzp-ja39c`8!LSs0gvZ7OWKr-)Kb`-++bVPxql9*e zBJ48(jTG9Iim<*0G(u?CDZ<6k(qUXt>bsQG|UapqS9Ur3m{>KzNfSWch(2 zv>VV)k@-1AzV}<8{|N0RMZWiEpnnVPZ;E_xC(yryHvA=nU@tvC}ozIQ0lTS7ZR z5&Y20R#)C13_=@i#e84n+oA~a4OrT9iqJ-B)IspJ%z7M5#;-e zrR}2#u?o;$!uOaWtP22*71}$BFs^RL+*xRQD8l>$Xg{GHpvd>$3$(A$j!}dd9cUk+ zO;UulzQ5XXrzt`V@&@Md!q=+E_Y(iGv=)+vGxc3|Eue07S@ zXWq87Mn#CJy_k2H@Ff&s9T?~sp?yjb>=fu|p*(8ODMv+0MN-oYfyw31Zbkru26(^0iX#& zo1+NxRiKlE)};t>G0=%ZTdoM}0zg$lyI&D}afy{>g(B=jjEs4w2;WvkXx~wmHcb)Q z2-@(1B-y23X@5yoVo3xxKlBH#NS&_{)~RuSfdK=ne~sL1zz4fGMA z{Z^6h{R!y9Li@8K>{$byFSMPC5Cb0^^Xi0FuE_Te0{W294poFTOQ7?Fc9J5DQHR)i zOjhK3V-Jsce0NNlH(rr1i#di?Qep1Gj~^NHJ|TRg6+u^yw$9PGu=GjcD^Ud7aI_VU zHu0#KH%0iW6~VUy%@o>oim(?5G(%{&DDu7AfUXkSXBGM0mw~Pn+E*3%-nW6K3+-`5 z7;Ax=h1Rdg_kIC%h0uPj$oF0Yx?E^~QsjGY0$nDwe<^}qj*fZLgf?1{?~Ma$652tE zeD7$WONDm4BHud=XsXcOugLe#18Nl7hZVse02y69pa^5=u`zF!@YO5A{2Ykye!{+* zBFq=51ezzb&5C^QRiHMZ4Jh)xe*m=#?JY$Z z7mka0bA`5tBH!B=XpYdvDS|y8Z|hO62z?ccVb=-YRz;ZSooH$IDMCDXQp~$S_@*er zSs_Q;?r3*Uh4}y$LlNd5C&#>Q;oGJNeWBXYN)%!II5XzmEPQo}u+EjV zv{FTo1?U#x+pY-ne(C38q6-5~1fj%p=#}r{L7ihWAey9lLe$bVx2((np`@HbgDe}FA zK=%r5ks{1-fK~`?nIg<_fW9QOdlkW-0)0_vk1E0(2k0K5J*^13I?t9{tq3vF`7!Uy z!nZ{cVg@W68d|F&>>by~ysrx1zZD^7_^73AQUtrYAm)8t_@*d=O*-0EN1OJsnD>zI zH7kNWPqwsjMQC%NM}%*&BE)cx_MD?td_3lTNBAlgp&pLb>S+BytAuZ(BHv4X!qRFL zVeA3oJKwOsuLyC(g_hQ?2z&1hG4K1r*P;l1($V@ItpbakYmI!0F#bAPx1((a`l0Z> zs0e$)|6^&Lir`;>_VOs-W<|a?a%#-`lhAxcSZ4r2pbNgk6#3ryK%<2AQANIY6;P?r zW-G$@0kntEZczliOvC49gtk$U@4XB(QE0Cz^1b~pLyRP}0~Pt+rL$sK9iS|iE5aBs zH-@(yk~Ufq*4KcL2(%7G*pC9bLTF!9ggGbBa4^ui8efJ zg0C}QHti^+85S!WGkoNzJ>w;QDRnk1HhcuGM~=eeDpuQ5TQN4(Gr6KX)l*kdnp(K6 z0Zp7*+Fh{>tf`*visvA5s<*p>!&j;|nILToX&Y)Q+Q9?RU9lYm{+rOZsITp9vU4;B zdnwsBlfCOnN#?c1Q%gsX*Jf0+x{@h>mRed@k-}^U=RQ|gAq6PCOQd)qS{dSxC&%)J z$g{Mh#^U(n=Z;VHE*E)OaZk2oS?uS8ggoF|XMng2op& z!KIPmh=7n&h7kih&`Zb^sJ#;luC03o2`7uR6QfLCEQ3j^9I6sLcO>JkEeWI;1EnUA zpKzDy1sFvHDi5Z?`#q@!mS;>WIh^;66~nX|tt7dOSgfRAuCBei_0On%~(tqo>nv9oYqyA7a19l)U$Y>%nUrwYKxOtmjN#_ zG9amE@mR?KoznDj^qU=;rLoBIl}Kj%N*(lSZcb*04mk&;>PIS=IDfqBM-2RCoLsWA zdTr7os?*V3Tau`um|sY3C2(9PQWMe)ns@KH<9kvGM{PobboIe=n38*H#-l(fp>>91 z3MZ{})VxV!c}hLDKvLccL@!~3mNhj)bl%1 zYqtzb_4e=F*VvWoDdn!%uJ&@TZN$J&_b-%1U2h+U8r$-zayQ&)MRSX8jj{JRTVYA( ztavM}81}(muWkQu0Y>71Y7xtpyF@rsJ*AL@)yJTfsCj}TWzA~-UBi4>6f<-ps!^9O zt@VawNMcLuYEO8r)%GgYgdrS5cO`Q3@S9+^b-n#HtIL4ajLa$|%*(syOn9bdHRFh4 zd09Xn-csBW8Neg?vVc6iFoP&BCee36d?G>;6I z!U3-ex2TUa2RvTzpXJ2>HTnpK<~m?-G14*fg8yofF%u#(BPr5X7?`!&+)Uu)!4Jn5 zwIdr#XDLR|?nTJYk`24~J_=eLE}IwpXL(H)c37GeX5|I{)uLlD8O0?nNLs&7MCO4P z!5!SC1|V$qfZ`-ehKu6`|3Mps(VTC@jT||*&7>RIOwG1l%KL=9$&#)u3}otUiVTI+ zhKuC||Jl?W#aL6)Qw7{cyt_wJ(KcL5NGy~J7r+btv%-jJbb_F!Q5RO-DRPAM=~?*%>1?@nU_9Gg&Y>~CA(BW-BL{1 z>_C|6&5X(-m4PKxLRn7LC-<}geb7x}$jyn{lr-IBC;qYZX|sWu7uQX)EGM@jLuDGv&s`?X zE~*Y|K2}yRxFI}{HAlLTvefmuE*TOgkLhPy0@KhW;r?|ve?eNwQIFua7G;=+2CUu0 z7k!^K!ljHWX32qB@v^JEG8Vt-9;tFT8#6ZBLD-B!l@fUNv7=U_sj66)EEg3RG9um# zJt9#hh@v}2bOG;(EM7PmgbV#*b?H+h#ki!@I9EqAiU}tjSdB`W=}e%HCeT9q;2J)cQ%B2-drHzXI)cxm5Q_z=U@fO7T&YKLk-it25lyG6}Fv7zU;yQFIAnP=;b;Pn2soE&)(f~ zvaDvgj^Lp}VDULBlcn@XWz?9pN93%Gi4;sZxf(2^y4HZ5b@Z&Dih345z#n_JYc(&u z);8PVrv1W7FJ`FR7fqFsgIzD^H05bf(+dd}k}_}&Y%`<5utH%|Eq)F>A`6{}^!>0* z5#6zW*E~_mzj)uKT|ombyAt70=8rxUf!a*oF^9F zp4GK-+f2lOGG-ZKA+LtwxB?z4SLd_lo#icq@Si0*^X^AQw&K4T(ssP-1#3ZFt2eU{ zF1tpYdsq~57*W6zik4j#TL#U790jwGn+2sHN5L$%4=M#Y3TClm&@9MNFbi2YDp(P6 z6wIQOU9w;n9ZiEQy%yj8v}-E~z)4PaVFN@pi(dFHa3u<_r#O7-8gN z?g@qt7SB7?VC0=h$@WLh6O8pSZo$iIh*)VfkA18?RIc<{=_)2fxpm0ZBwXz!U6O<( z38%1CWF>l1}wT+t4H-H0(5Q_I{5Rg_1uve$VrjxKN2y?{+U93&B}2E8_7(&(a6(^t zz9vjor;Jdc>trdVw1i{^1Fl018@uS^1>MDya`FqS9G} zy`M6-AWD6zYby?uh?MdN)izdc_U(Gq^5q`RhrGGjSm*G5?&{g9!lk>aSoCZ#i)<)RHlZrcoraX zpli9xgItMC29-nqobnKYdwpu0R^8H6x_AtKPKy*8m$|%>*|-zf~q*G(Z|?u z5w`!fGZKKVJ=l9IJ^65qFCyVUb%4^%#=D5M*WCB^P#II!e zTYC%j7JpaI%2cs~HiT|Lbd0(o0(4Yc(HJ5?*Xn2BbzsW4N-`_t2hRd^Cj-YIW{`}p z@)l#Ml1%X1eUc)+3Y0~CH+(=qZEqiUGLTPQg{hU06`nOvcDj*x*HBkxg;eQQZ=Z-1RA0_8&ybrp?Hs}1SHB8(zqCXW{8iJAuP zh1P8v6m$wPw24~5{-7Q4D7-R$88=eaR=_5iq|%qz9J+SI+79JK1N^(_wi4WuO{E={ z(wGiGuc*5yQ5vIOtS~SS$V@tq(b(2<4Z&Lp20zL8jURqz=gy#qpg~0-G;>D zb+-+ZWwi#${zP4ay%8tlO0-?j6zm#XN_g7kB%8=I%2?4jdT?n9=Tm4v$KVHzK+@va zz_(PNHV-*5b2VkQlo)fZ%A0G~+LFv{dt&M1qWq;$4cJVvV}rI4DZqYAxWIB2IL=Z+ z6`=G8t&MDI58Iu}Y!BMt(V5#T+qF?$S_lf1&b+QY?2)X$(D9zFQ8^d!Ci+~Z>W5u% zf9QAzTL2AbyecrpbOws??*Axfg7vIVotjF-Z^R>#ki-sO;I85o^Gebps^(2K*GN&N zTCq%$4ZMf(^hn2{*@Y9;Oou;Ar*;pa>Oe9qfc3nQK3Ec(9w&kze@TpVQW5!M##PPT zRL$m(Y)W17YDiu_(4lq*5sgJA2Hr$7n5vA3L;vsu9tfr`kkR#cWYAH8;DgTiWMm^| zl4i;(8)1ox@F$;4p)fU2Wc;RX*HC#=8l_0@7G-6sJfcC!j{3J$HE8NCYpguAJ?O<7gYT+GN9| zI9i;EFN{YB57RD$s>LboL>*Lsq0dD=UE5O3v|gQ?xS>NV1zrKBhqh=8D}T@6w$&$- z)BE5|otrJDx^{GSh_>_GU9iAM->;${NtY5)E0Cqi8ih%Rkv5d+83-2_EN~LS-$rjE zi_YuE)gqf_HcbQ5)=R?mTW6+ zOGJ;YDIMVSk9qFj@jkAB;!4^TnQkp2HRE?9%4ra@S;UO5>fGbN|2W3 zLwPcpb-XUS!Wn6cNnMN}Smkln&@Y1tZ$ci9-X`d2NQ-5%bzqqNrJ~}1iDM925Sr(o zP$!ay1iH431wGMIQqeW3V&C~6Nj1UF%}RQ2_d?O%@U=U)tn5yovT{-Sq?I?Ok6+o9 zK6>TN=_6O(ls;_blJvnVm!=O`d24#Vm7h-Uy|OdC=gNg?f8{Odkt=)C!%pf$iDRE$ z#*F?O|6FGRsLkq1)zD%6e%GIY8rFAhkLh-E(4r~RqA69RG#y?}F@~yg#9&Ovt#c!{ z4j0Hb~hq3Re=TNM}YLmS9TSO6)4hwo311GC?}9bLN3|q!b!mS=nl`%7Rof z2swdS>HRy{mlMxJ=hBxGF9Au?_$qjv#hSS>Ad@#5D!e+BOP?Y;hW@@0te>tzrFvj7 z3nx{GBRHQ3MRj(Z4Kb>QwNVTiNkxp(0Tm-bF-naX2~~fB^5Ks--GQ%xGf;g(RUhS5 z)kld&G^0MsDjwV9z1|b`Mfp{Iju^;2+Np1}RiDT`I;Y&U^RPL>9-(P5%53+}shKQ; z)%SV>pTg#hRP_}opoQMHmi~fHvoY#3siAt@Ym|pp3~ug8)d_t=at3rpkKK$ss`!ic zy%R^PhvRx8>eXD*Q4Vqyb6;9p`X91^+&H3xPM`|jhm=$kxT!d%0=?m?zTrqwHM}3k zx=o5IFaGKKuw=nh=J1sD>U1?W+;J7W7QvNN5ED?`X4_X89ad}GSF_M6=r}bnglcU=moUC+gghJ52mgmi(DZ0`*Hn6t^xWC&%AbCCM};XLMU@t29Ts98 zRhTsvV&&#segV)tgH(XAYyR{N-VM+V^u8X?g!0$v+z@*sL{yUEz-Y$wF5M!$-GaTQ^vW(?apABlBaCrl za*pxX7-hb{8M8K7FZnnooQc%Z8Lad ziFNH5C6l{KWM%@w${HXlxT{~3m@orpkZ)!VTSkpojU+50i&q4~4S2WGtZhc8|GJ#< zkg+@$53$P6*u~{n>X2yz1W0UM4Mgh^>9%Sp|Z|J1?^)^*0s-gn}xWjN_A0{I>y3&O}}y@fN39UUWeldD~K`z zWD?ggpD0lpJHG1N`o*OZEIZFsK-k%l;R=O`XNu&D4kp8uc&0&x70(n&k4*Ck+k0-k zcH&-auJ$?4(bZm8(t$^Fpefv-fi10#F*rpZ1Ffq)HKL;oC}9HB1fh*O3sm;T$ly^K zn)n0)!^%+zdyPh&uEwU=38Ht6IbAZuNG9Zh!ND7uuH){i&~>qngEg4y>MO`NOc+hP zSdekJFmePMB*&7Dyn>rxw_q_N@~1YTcHY!z{HH}@*8KB(gN++=_ygxF=`?cOhx6r} zKIOHQV4OG|us+sSM#@N`9L2)1;*GunP)`$bht#4TB*!q3<)7hjkco3moT~lD+7w(< z*6a*ksUh%6jn*qQLcRvCjZ10`d=`9QMi<;A${()dy?@9GJ7 z8;`MaRU9|5FXsX?zMmo(B&ybXF^XQLtxzTPkbZ4e=S&ouS)eh}Dr3zq?Z9U#1Du?= zezSC!Q-+tp5|IHBeoh%ei(D`yuxR&kMP{iYw`A$7k+{J=vo}pDxgpsMRX|kkjdh8+Td%g5QQi%bT>{j`;ii`wPQG1D)u8euP?YDV7jFTg8JK_XLrgKX( z{$&3(jBzlw6S6AU-Q{|kRy^MQXdyig^SsAD|%F=prNF%1gYj>0&yS!C6OO$=0(Q3K0 zLj}*`vFQrc8s&C^

7lc;u-2@3>$l@?=u$`&r$^AT3yMxP_gviey^@tnoElOHt{H zv<}{)fq@5HMhP?}9(q$-Y2{L3@(|pWrNZQyK-685o0%*sb$GuVE9y2^DnP7tzmQ78 zrJiN#3^PDEqXVY&QRaqJ42RCtD!BHQ$Y`$g`%I5C2}0WIq&&H8rj`m9gU)5C=7f&v zadc3asJX4d5(E`eo@{`~GMTQ_MrP~@IT5-&j0R=vvE)|*9dutu~IVmh3$=QR{3AbGmmS$Xz{)MJap&yu3yg-7~ zh(2T?LdI9^QHJGJ6<7+fW6r?EFjP$_UO3*(SK3+uwj&E@d;jqD87o1IFKPgrbxU6B z85VN8PF-533A?L!#DxcWjk?|=<%5O}EYkq!Fq}Pn>8XK05zjMNWztvLyt~Y9R%W=7 zCttV#s(bBQC0#F}$KqX3@}`jZs?q-1mxh<+RGh7(hX?Dmz6%x{WnpIr4hf(w}~Vi0rCunOhU^_yu6!Y;F@QkA~$zf_Go>FiiyYVAuSQ@QJv#^R9(jy5aFWifJl zy(e3Tu0lf0QynP16J@HeZ~cTZX46w;UrMw@AH29UU2X0f@42@T<#FSoFYhT$kK=7| z2xf9l6*6T{X>dd0)@r)HdN^Frt(%gXp|#dEXNOam4`8c2ynd1+KA&P|%~l4yU8d6S5Z9?|Pu0R9S6i|hU+99uZb$EzW2lwZy62p5_a zNU+33jZcP7lo_#pl$J3MwZeH*oqnpz>?WnqohTk*m! zZi@dka}BZ#9_AyVc%Vp*16QL&(?kFaMeO;a`k_brt~$qLR!8}GJYlzEcBou!P7Xe`_YxPyG`t^?YjIg6FsfsL6SPPlY7 z@3aw_{$%vW><*i2{Gahn^jq?)b0<-K#5XngWen;YJa-#270&`#k zOw_@vJOIr1jjX^g9yAfJ2{Oltt@zLP>8-$z%*e62)GZ0jq}*UIFu#C7N|LoiQ!3Ih zR~h8#n3;7?O|vEM?8Nf{J4VKrycauWQQ~{zx9*)m#N5b;XsQX@MQ)~=Z|m?hrehpc z1CzAbb!{D`>5xB#b@BLp0TUE52_0k-nfcREF=<5nW=271}XWQE@$i$rbu`j@BXLXMvZqr z7Tnet=gXjQtY%(b+dj7X+i}ITtew(0`$6NFLa`hN%wo9OjKv=uU)3G0kZI7I>>^6o z@T$>fVt9X0`(J9yjYDSCkr{J#EK(T}?qpe9y5v&j){%s$b8=+-=8G^Gu?3PjS|DuL z*zPwXb7oGfhBdFik2N{5W{fsrNk47p3abYGiDAKtsiRmtXkf;j7-Mat;F49t*_6T^ z$~*+N3{vDOz1)_5^FVuc>E$6~(jh)5UWfQWiqCGc%=%-fl9uWk_$QhstNzY*G2TY& zFKbS^Mws8B3{rnvI_jTYI_mHG3D%*a#Wzy@x;B-+_`&OM10B?#78CIft$T*ryE$6E z`2XhJYyQ1#;fvE986_h)58ApVT67Dmj`?a~%Nw-nx7#qNTYbyDMgc4E;}*r11~hRf ztqbT(*txv6a>%>_K$me^r|Gpi5;AeGkB)?FLvbX3fmK8u36|Dg01-veVI1MTU#4xY zOWVUcdYeNF^wf?Tw(rw=Ab<9acXKJ0aKCu>800l@b2vk21$_jM1_b&q%CQVEL=C5^ zL=NIWbBwd@bu7*^4DdX@t5s5jn8@tN(bYb~Ydf-#AH!7IDC&ixMS$@|UE{z)P%=co z;|n1X4$l+;@t=)0(jSn9k_TDL7*g0ibA=k|VF-;Du3HQ_hIZD`ZIXsSj`&F=eLG`c z+9r|xY3`7?_%YZV%i31{p4GdA@z_?D5Hi^Qq#8zKdg+(4-T^ zyZ1&J|52CwxJ zmeg)W1#{PgZQv?Kb-x$+uq0(w*TnqXlqLOPTM<-1)FwsA3CkAj2tl{ifo{W7`kQRV zKe9Q1z&g6RU1o3CtaVs5iYcZRZaOz!ly9eVJvL*O7@c(4&W_*U`GLryh-kI#G6>pi z8{wnOPX}IeI@D~7veAms@fmi!w>s{HMO1=_vYKNZ7xQQIf(u!SMmC7L(9Bi^&BYY5 zIkOM+ppd6QG&KQW-2bq#LvEmc3DUE&*g#zlC_0l(rz$Sov;=E7Ex6lx{aE&;7PL14 zK-ZV}5g1HKddJ`>qDaTD%#-;ezKCT555oJiaPoN(1IyMChiJDZc1# zX5i$C3k0b%zVt@P1+uN-!#{y=VPpI*sx2n+%bZHCS&;8!qIM^<0M5dd|< z@O2n}MlU#!6Lbc7@FJMZV5FDY4}1ZMS-t2e#x*K3YZqE5Og2qc7iz@17rt8)weIz> z?lV9%QgGyj6dZXuh~^%7ZD7+{f%#4+ijQ?1pr~vCXFjAMb@c#cV;C&Ipi~Aot>dnC ztDUB%Ii;p&lcu&V1(TZ42n?Z{J+ryX7gd_gT^;}yF1B_O8-A#g9j)Z}cT|CXp zt)$DPL@_%kF&*uEi^X0VvR5bboiF;|V=q{X3T!N==CkaDF8BXO_QC~1V=s>n(Owo} zp(eKy^Vkc9L(D98!CvU~@L2kyM^(aTcv)b}h~IOPZu5-1SPjYLwQU?@VD5zvE4e|J zAC8Oky*DF$58bN4ZhA+zm}w|T%YKJPvK!-zj5nYU!*z382lL5_XN#2T51D>!7o_@{ zad(`0agIvuV(OJ!yU~eJI9{4+C6M5KsP#C|=3+hDF4Tkb66&yMdvFK6hhPt4%s8Kz zo)L_>m_-&VE)6gNdGU%!njZt@<}BU1GH}Ej(ap12QB9%wNPH2#*(&;w*iWWk&9o+# zmpkO$X-#_w`f&Y&<5z+HA)Q4IKa^7lZi+$`m5?di7Y7aeTygxyXQa3?^s`eygc)Rwx25L0V+ee9C(<&}zEPm!>>KKo2Q>uON6;Lh89-T%4wms`Cz{$N&eOs2#J8}g z7K}f~i&}$dPS$=qQR{FoGf|v1D~6mm+o}E2xhy|yRRtozvuq~CS`{6PjlOvlY|@z! zG+jz`2$0#f%WvGs-vs4d$GE%USXS(e#x0dc#$B!DjDnQuQC=@ z6GP!{{&F%)Ngz86r_{S$!wtWwZRUDi3XQcbmDR={_`*eZv|&1n7|&UAbwX) zTd-L13*4{i#DzI+A!Kvf;=qo}Af@3mTWC0-W)z}ZXlYi%FeHQBC}tMyM)7JZ{$oke z?5dLh9X^YbH=@HAY#zE1*N6sg?Ap3N)YXW7*67D?z6ZSQAB{P7_ibvk%h!e_?qE}{ z3RqhN4k>66aXBj>hdrNyJ67sef4F`aojr zrUVivfmfhdC{xN6MUC~Q4WR{%py z8SQh7mG2knQ&32_mPbZ1&q(+85w>0~RcQaU6SAu6-py+7Tk}YH&C0zV#c|qDjRvlO zEKw=iX5*SBVTYoNoEUhcCKW0}A^dMx`$MvqKVd%nF51go_8i0uSYl$6dwe%tVCy0y zYnJ0=ODD);(*qxuNqUfKckS)Cnnx;YRvz`}F;T_;8Bq#_W5IL^AE5|*0V6@tAs@<$csbWlOZ0w!8Y)=FH>h|um_4EvBcDJpM zsCgt&v+~eKWrv@NH6}IeT`p!!%_F5XEBAP`EUMePH0ZXv-QC)pT=Pg(&B_xW#nYQ% zm%--)(Q3xs!Ey1fDH4mP!0cg&X5fU)sYq@_^W60cLq{{~p>l>iJZ#3Uii2^FCZgqR z1o^*Gj!4jn+@*EWSNvBBk?IG9@JL1%-gqc(2}Kw6FSNay>-kd|8}psN2=BuF*UwD7`)wz$~4TVMC(t(W*BF>1F-usLybCv#~fFH1^+s)M^DwgSA5Vndn#!6qW5xB zHXk$X=2l809?-xebw&iLxl+{zn2^jlLoH^fHH}BTO@*mQoPp;H@Gw^y_!({>Q#Kt| zireFhX6d*pEqkgNU-9q}s9LsbvhSnGXb!RXA|9*ZiM$o~U9h0c!p`eu;aT>~+r~$l zx5-{1MQ6vyUGvIhuQ~;)%v-Ag5N??E#lAcyW*Iy4Ve{gQn$`5MtAPc!^*XL%BbF_|>8{*{ zMpbk|Zcg#ri!rtvvP*=q4UA!l=Hc5|$1FvoO}WfJr~WzpqoXLM+>zPkvZg#|8Lpd* znas1WuUc(qk5A`sgJQei44YS^Z=?Ht3^%lf(eAf`LT7fr#UK{ye(bZ_{Rp$WAF1M9 zrTg&;|FXK@q!g%T{f_t9{$vfh-y}NBZ0~-PozDf`&lM<7t=j^_?mU0@BX{xLZx35| zG2M?@7jWs{8=+n1UFd#S+q@!8pQrm#F6-yn*wzzu0vFx=cG_uNP-3Y2F~h21&(=-4AImP>{Z6&Hy$jv%bvuCzGy=)c{Wjr-8N!zEJ5b^X zYu@u(TZHt=HRtUt@u@&PqY;q3bbPJdu(+g;XpV%4XwOWR@Sr=zgb-{W2>z{ zYcHGg!2im8=AWhiJFI1vmE&EomcwjbL7yLzwY-os=6RRqGuLNlZss%7OhCo)B^pqP zGtUgDB2&=+ee;<+Y)lgbR4Y)i!t>+&0Tt60KaLz=3om3-i;!gz9_S}F2znO+svB)y z5igV{pkkG6K*h$kLuw~*@gq!jiJ^ds*#`5OLIKqZDYW?c%$+s_iq>?9^O^H(Ztp@s z^^S`%oWC{!)vG~3^%6!f4XAzzsH3}d%I^OgVab9A_9*{vgcZzahY}~-p=sCGYyNM9 zg+~IYK6oW}RIt0E6IVltunL?PG{;yP%H*s&kDcW{>)s6CP~CPdCm1?)YMaT>k`hHG zrwCf*o*=kj0Dp(|yXTB^` z#fyBlYU&4beGye4qd5^=jJa}gQD*-%R~ZHP;scw5d_AS0tzK)>|7f>tb%M>tcGNtc z`p2jsq=REd0&G7W!3(@?;&k>ievzf!yu_2&@}A&ou3qd)h4|`4Q3y_l2fenESx3Av zS}Tv8yCspSp=FhPy$>Tn_2{an*wh!sDT3K1|na0*q#q znKb8QSq&&H2?}2{jh)IRC!oy;ab~}Q(7g9F*1?xjvb3@rEE?T*1r^TMp6cHA+Luc3 z4nNeO5{xpHbgmFtNlP?t<*h7_gOi~HUjdIahBdFH)CCi2McsPwO_CYUCi11bvTw?& z%d~$c9R;uOue0M4`)*45^Z1&9QkGmv&F_k2d*qdDfKTXJ9mSX2A6!9yci@T|DkOI& zcmlb3g?}n{C!lI}S49^qJIK!!Gu@~O69ln`Z;s~W-oj{7pW|m;-Zue zd9dFw@W^x4E;z!0nw4i1*#Cab4o|DFxAALS80nVixB2*>%4KNlh@k(WpzcX_c@>7l zOyNDcMrZU$$^bqQeww_9^A_h@!R$%~k6TyMu~aRtiKVZVhxrQxG-GV~UuH=HLofb} z#Sh^yB7N{w^ZL!4;eAmL#mvpj@pP!3?|6mk;g`6#4!<;wdb1OX3uy<9(o?NEwYL`a zW`$U0iTIqQ(ZxowsyN{ zED2k9ZezJ_Fk{&QDW#Ej_w5RFa8YX+xRDyL%~wE^ZkYUpWU!HGvW%?w&5`I+&@eH0 zsfz(sJfd2bz3JE@3!hTjURfYZ|Hnr zMBNMqWw2`0jgKPK%|p$RZm;TYEHFTwY|}*4Ev4_$0QEZLiL(S0~q3)YN zEXIvF6a2W%X2$4~$uwiG@Br%OVs1Xv&KcB7wnW#KGx4q& z%osS@aPrWKms+`dhwz*9@?4}aBWpfR#@qlgx6gn2kMj+C5{T|yPQbLtR7WBYU6}FO zaMC@<1;e8`sLl;SX5pShLm+Ds^Zifsj`g_9XS7pXa}DQ_L{iBpui;)JB z%R@<_6a6l8zE8tR_O93a4U}$YMxoi``&pd??qNxtm9d+n?mdH6JbP}n1ye(|ff(9T ztmC`bI(EX2LiELmUvx50R8+R$=o~WVY%h5+Vpq=Bxrffzhu?q1`gEdpHul|98)SHV z5#NzcJH@oWu}$8{ZP4kVutlu@@9TECUiRDb$lDJl$_xGd0rCdg z{Kc+He}gS9TYB-3Xq}?ee2UE{uh=2$;(`ok9?U#wKHC-eNv=PR&{lf}t@8pdSX->y zJd6~ChzjnL#F-6+34LSkESK9XgXKXqb0cg9k-@Ip)j2l1ycLGz2{7%FG5y5`pV`eZ z6d_mG?D7hk(JCBJv)>Zp#{YVo9}ZUyoQ(@L!g3jYGTWlS`MOayqi5(E*r(ZfWvJ-H zMPcLk5$r~~bk5fs)T}PnW^c6l6sw)WVok8wJu`45pjxbb^$jfcZfHq87rkA)yEh=% zRpeuo!7L<$=Zb*GttW$APcky$YN=T!k2Qcy6E@}k!fQ{4|d}q+m*OPc{UDGOW`u1Jbr_hANB4r zm%Z|{fw!PobCHA(@jBgAIaUJjoe#aY57z~P$Jp%h?MC-LWj1z_uUp`|f*Hk0B?j1P z$*rasGVqb&gZSQfOU5Y06i?X{e~^q)UF`|4^+4ryH*=EM-A%{` zLDq~#;vh%yd|VvHdlvZx%qvBbKc~=zkp_$SB97ZVSLqn?G7-MC%tR;KM2v))J8zr) zIy|SDhnR>y>qjL;o_Dm>Nf!Ekw8)4*=kkA!??*=yQ;)*?ZhSvFiBA)&jCe^i9$!RR zm_1NwxGL)V(W#)q&=O9yN5`zgG7o`Z14A4m+_l^!Fz zvrghP7DX}jmFnXCq|%V?fm#a6kA0!$xxRLd?v%Nj%J(s2>Yc|(U~6NU8QQ!C&20>% z(ra}FQmJ<{4MdsMTq;B65cEH($J^#_=-u!Udog#Z%mc6IRuSLcY?N7vaGdc$rTwIG zw&L8#KEfKwYe7!Ox}1(>POMylM{JJGcz)F=`^lZMTy zDhsbcNUX!{>2pN}#1^oI=d<8(ynMF0q;39by z4TDmrXaki1Nz?!EA`gx}$y_~8mu}miW+wlQe_>xkoWtK3{}lck@>Mzb;h&mW&lVdQ zyI~L>HE>gvLC?ur(8Dl;Vb-p>Bd>M|o7ttbBeKN-K1ySDPX z(v#8XlSj?Joc(2Tj`zi(jksRsrE7^s5S>QEkuc4-f7LUxNgqj6N;IB`Jv_ZP5yL34 z>w2s()2?yE3Wsb^jruaYpac@MtMGt!a|NHX>onYTfb_D|5xpg?B;?nXh-@*7GFqe& z$E2&v226S!2_uvM2}PKchdLous;hq-L}_3663;)fBLuG_ss@&k1fv$|rg-!5ElQ^+ z(=d95znl%D=S=o+v5b36eanOThFKA*HxK>}piEmV!X87GXj033&Dbh!ur&U75+7(~ z%)hjxhAI_r1~TSgSGT?x;zWE`5-`{pU%q!6nonTXhqg{YDbkl4`J(QIc-J?eQk* z!@yaZ95boDQcx21zKGp0a9F9$^jZP{_t`wcjZAIv2FIwBiP~Ln6 zKB6*Wc3a`K9l><<)OCIDx#N3M73R7rIiB(gy{AU@I5GYiRX3!s7N)NDiP`D#{W9j4 zD?J;vt8X|ydX3UtEgI5?Gd{&w8J;QI!FJSYt~aIk7&zyhojZ{;*HTi0*yPCnbN^ym z)G+xsa@fe>CByJ%n3Z6Jc8-WCj-`s&ZapOxy(JYp`|-PQQpFe0F7cZui#e233}S4U zMfVLGI7)3J(Y1OXK(oq5Bqa#T$k3HooLG%Z0Nsl$$#;(M{_S~Zc$*O~%FIbhpa~i? z8~C1@4e4TqF}@)$_&41BD=8@f=70VSc42ZDF@i%D|Ks1tk)uYHju^4W z=shC;d>@zi172Y)8!i8sVuY8={URR7I0~MkQqawlSVdtk!j(9|M7)bmi`R*W6PypW zDvV53@%YVh>>=aVi~gHP9n+ucU7LD-hxBHw>Xox=_w2Kf4v7wg9uQrfBB(b> z4DgfBfq1)~jaXx1;8x8B^)QYyF}R~tZ$-82dbwh>iSz+-E-5B#f!lM(N~4 z)0hnkN_g?^rIIxw4K3t3)1tkppwvXKjHpJkVd-Pm?4OYa>PjtK`y8lsTiuYWs<+=&3WOvU3}HtDSICA0t$Tw=io~Ai+*S_1+3`U28U#JikKJ$x)vxs! ztqwx`RPP>ksToC5X0sNK8#H%ZbcNsJXNwH4ABq~Q7*#XwdY@RvHt40=yTM14QQZkS zZs4u)Xsqh4zENFUcA#R_rZExQnMy}mE}VZerEN*|N)tf|NJ{^N-zqua15nAjG63Re zAX|a>_128TAE}g-0Fl~DuWtlf5_B)kZzUyn_Cb^+5FczyUVnxui=#W{X!tmDNk0p$ zWCG^TY~@|^Tw`z_x-zSx>4yh?i`zjCU0X}R%f%ha8wf&QVb*|{CF>CEUdo~;+d(bC zA&42gqTGs7^F%3f#v&M{851o8Jo2@0{04dgi`0WthM>@K5FrrHEk#)wCeuvRG#N2l zBMAMmzo%Arn}ipHAV8#Gmzk+adDTUr|rWzSH%^>{1WL@F{W7Y#O3E|$P$42lx7 z6<}9$&7E1ov60TqJZqj{lh>?f`W*RJbLNfwgC3MHgrGo?%zBzo-K|Se+jP%OtDm7I;{0q~6X+azVg3$w2gK8bPGexONRL?MOl0 zh!;x9vT~+mQIb;1JQPgc#N|$Ah!|`Ik~n&v0zeW@D{`>Toc@mie8|h$BsxX=Fjk zXh&(d%I$DsP)UY~S@&Lywlnk)5iep2Y-v##tvF&;5%q){$mPviXVfNrl;qAktbnU{ z4pum}&`1)A_auI9)B!(fB2Du*BD-@c(%81^B#qCa#BZn`bBhsTv`&P>sMCgXA|XbW z6seeWep1=|$_ULNWa$s&u%5tWFTE#+zzNOXG3KfnN6fDF)G#xPZR|}}!f;Y)-9bzq z%PU40W<8hEI_ECZW|!+ch1{a%Acxd5+H0+o3lx&SCq`2qiu^(v$}Gb6cL`(6dbHCf zc=OB03Iz?eEAmBC7Ld;|<`B*W^0`{REBxfAoqt44o1q~+U8ZWVA_b=vPwt^z+R>ok=gNPy!?L*W};M{-69Cjj06qTKl4nR^8tQn6# z(K=V-UCYI!$|}>T(zTEjk+WyTim8^JI~rBy zXx4}^AqLECPsT~+NX|~g9$C0;q!Ni}ZI_O~wamOKkvPE-Ip}cAGNUyXfK<4Yd=`*b zK8h8TnZp8bznFH6D%qY8L_d<64c3$l0$57oJrNaTbRSiho|q%M%U9~1Z6b2mhKwiL ze1$Qp+8j+9wFo(16a@VXx7`V8xn;9Le$jy46`h1AsU5!pnk{IwAV~n02KhC6JA~Mb ze1N}gX9BGhbh6F8tGzDPdPwMMSgU+?X$9C8w%6~(&kd!_ll8L6?)sl+Ac*tJIXNVqGF5RpwMAM>+_L11B4iw-s1LjDPxZA%@eyH1aGrpeAAqPFezW zh~XSEB@CP=joR*(o0_4tW~maE)Fk|KewvEQv1K35-0?~uHbxm1MAg=ttY5pMR5mSh z#ivpb|3oE2K!XW}1~frVd9x82ipvHQQEA8Q6&*<7R2(#{8RA1V8#o08Wm&?Yde(Ca zPV=ar_LWS-V#@~Q^D09*=4%3yQw?7m<<%`^AaC_lk2U@fO94^M03WIwmpii*Z#CvD zzX$<4A(g4BncdiMB~q4z3(bZtY+5dQ6dTV{fW|=KtYFD4m^w9JA@u>aPNuT)<}i#$ zyA)-FvkwbLH#ulyhZDGt!j{U>scf?)>qF*UjU4jEH1y48rWq0v2@)tE6!T;$PLx0? z3T2Lk32>}2gI*|qNz4M6m@E;yVp)M!%(xdyoV&>yv)ajZ3cLGOreCjQfzrUO5sG=| zjn^7oWf?@{CZ7+w{xZ0S;xsi>8}^cR=boUCp<9+VzE(HheF-XR6ua3tqv&9s-C<$* zvPfIay~ZNi)dZ#C%20mpQ5H)4|2>P#XfSa#x{eWTO1aY_PRJMrHn76#G5$-vRE|51 z>gG6dFI;yg>@>10>Q=0C$IsDDgvOUnL~B=1;igG43D-U8mO)L#C8K?0&YLhvYs5wo zw-$npBI}`DN>g#w*)AKo%O)B%I(6WDI(B=q*6$-bFG(~=d#r7C4*6RkKNX)Tzn)?9 zT75{Iq8|0^4-k4S)}pOol5%-PCvF790iH}@sl(!n{=z$~_ZWcUI)}|0+zBKyjVZB- z@x}JOWINdWGw5?RS$4Ju!65|FM=D?EDqlxYPJ;1ZVUh74X?!%F}<_Ru+)vON1 z@@_v1zIGXIN;qSsccBIoyQM|D4ds$rFIx#N+Cm~%6cFZah)9-eK(gHN$IThG%TY!n zYPNz!#JhjPzk2Ho&S>TzY%l4bq$0iNR>xPB#E`H#J=)&oRs3=Mkqj-hYsZ54r*B3! z9QByk4zTkq2hz=mKW>h~^{)MV*UJlrKecwpC+ zt7SO9K<3gsj$>6OIV@ww@X2dSdY_8O6@MJQ==8O16RjAz?aHhZYqOyI~3zohn0(alY>>Mn0&4KF!{Re3UkR4lH#d$DQ>oQondJ4?$gm?rdJdQZGzO{EnsM5 z*Ww$Ojif9(xUtD1EkM7P=^2G;hXrAGp3o3rQ>2_+?Si24Z-GNWjl(yjbz>zL83 zpM#(b0hTQBOfZ;7$PL2n+^5+(p~GZ_3%bIE>lTA89NA#_#z~EBV-c4mcJ`y|Ck{u~ z$0KZeY$)NIDZTV40Q`ErB{*}tZfrO)-2Na=UKS>jOim4@2p~7ZtD@b$joFHJ`_Tku z;pQoHacjzM;pQO{Ayy^Dq3&`I2bv%Hku2&sZnupTF)ih0wxyb_+sKW?5Ftj}c8)P$ zj#f}+6j;~@TrnsJ1Z@-pY2ZQ#_|qwx;T2P$Mx>{l5#W#YM8sTC@}8+0|iN5o7$t zufn+^;9szH)W4O|+YW$iLTeP2Y&thTmD0td1;6|#T zh?cBo))8t~sw<0ll~(7uV`?oD*$%qD7Y>k2GO=gdlzBX9epkcQeJ8 z-z7S;zALbeV!f_)-=UPdv>s+>tQ4-=d$I877d9MIV1C013B)Rbaj-$v8crxB5=zQJ z3@56D^l4I=B4hVxT7+xShjr1uGBuAJn!yricSR>;vj=5iPxKi@2WZwfH5cxKz#Uam zn+1bWbO}ug_UIAS+<{oYUHrVbasYNIc5iyoU)5qpaBA}z}BEE z3grP!Tzdm=%LXG#uT_#MnD6H&p@@N@&NxuWqW8zCeuivdN7 zVR2Gp?G3@m#5=m{;PjI-rDkQDfW7hmVeeZ2Elk9MRUQUOA-tnh4UfVU zB22Mp)T&W&2^2A4#Q-x9ptPxzNV{pFx`@SReXU(ZK}87_G!>Mx;tKd!e687++u5m# zFQ|(4|NEVD@A>Zc%{P-tTXfg|M(O;%`#AU9bI&>V`Q7he$Tcc3bsp%h>S{&!@197u+4zgQ8hA*bfuN< zAB^>S(fy{e^-9iA={h#buULpoWqa}LPapW`rMPaX%HfF}cohtWGusdW(N!C&jUFgW zTPlxocCcjRjOHJb(7Pg+u*#E?53vc-x7P`x)PwN$VdmVtb8`(%6G>IrgsNTFI?-=8f zbZq<6&j(^Vda?7PE^EjUol+zi?*KF*!r9leuVzJk!G@qbxp?(ZKOrVc6DJl+7}H_f zcXb7TtT-DR!UzK)({bhWtr^s=#mn0m0&|!yq_lD^a9q@Y#W-E;)A=Z-5lC!bG(gQBaB)yPO!O zCK|u9d2p=4Y};xRQR(f9Ffkp*#pd(Tr943?QH}gu_+E_d-+twR23pTAyNlWz?qNHc; z&LxD6$r*+L=XU+gFsz9Wql%5qC7JASnYE;r@e#j?`Bn1GU@<;}Y@1oPh?_?&KScYKE$@U`Hmd}Q3h}x3XWO>!TKazIs7tUDSs7+HCVjoqn zDvdDYM=+7}JW9Gq6ejIPM^s0H$~+@34V}J};C-?yMmjb6BE0k6XG0nr7*htD{VYBZ z+GK6vwmjRAJ!%eVe^RU`G?&vaP()>#QIbL(0R-jg*vEAvsI4>z5BNDMCfho9u;|u zGCMK^5?V`FlN!XIPM)fk`2Bn>UH+Nk@zT41bMcwB;zDuQ=P*Tw}EW5gXx+TEOwP|*=5GMl(Ev-5Q!J& z*)TTJn!fz#I~nU|`ncW2U)d5STD64>QdJ|YNN+>6W2s$L?aaM8{?%yjn1!GnBMb2h zWu70ln4U+@4u6uYOV-B{eX3YtN{c5g6IG~rCK-fn_ASjGV-iIRlcI@<@mdYRq-<~1 zkOw_i!mpE?$m=97`D4VhGS1h==|E}*KVunF(!ApHh z&S1@=p7+v+GTs3tchwj?*C+e8f&HM5i6R*27Yw3QCFLyZGSO;8e2cB zv3@_*-Z^CwZbL*4dTn_uB_V{Wl8UXPMG0%~)yHM*`{qV+($!awFZ7q*A_L4a9_asXd!q5{j7O2}5_}vc~3^eths}(r5H1%IakL zY>Hn)pUp+E&Z!GvuC{JDFK5enwys59QcUWv(^9I|KSinh7(QVsCfq@-h+iQAx?fAU3+_Vi|4&|W zx@!AsQ4Kxv>=vo8?%>Y*oTRVvWlL*tdm}?PAhq5B%nLtrxR)CL;-<))-b|fmGF+U6 zTR+`9c4_yZ>k$lm!mBk?z#hMQ9L?dYUbs%2%O@4N{$vwbD~-z?u2@mg(h)G7->c5c zqJihAHGb&aU87$f$2e>=yRPTbZ)@p+}I!&dq2Na>5fh0)I|?YM9`8sF<2 z11?#4WJ9zXs$ySt75jW~UhVrDsp5lhBtE0wbgc@T#p|oAM0f4TJzAmu>Iz}B5^poy zUpwx@vUk<6;~h}kC{eCC*%An7nDIB0&?cyQ9S1Z}&G-OK54kX8p{epF+kw1&L_D-x zZ%Jo@>4ub}{A{G$oCDR!FQvJunMk&9jOq52n?j$>ia@FB*}=6K@@?*%l)bkg*}^fV z+f(fMCa3cIg=Fujd>r)qsnU)@VWB%E9kxX13?aL^&akq~oe8Z)fTPd4-ZZ5&UPD^L z_4*EoO^%LZVMkD*>7^aluE5ti0#?eug*R_Zo4$dRNn%GgmX*DD1B$o`CHy56@t0_V z#wzjvQZ~@>k0IHf?fBh&Y;ZB_X)sH3lU>AIv-=O#Dg6M??sfV4Jq__{kb;cfIbg7P zm7^ZkBxH$c8y6KaK3veT^(=qqv8mhbp|Jb*s|M80^ z`q`4*_;-Kz*W5extM%16j zm+Pcc2ZPn?SdeWnf%Z#FuE5ajT4D+Pyj&B)9I`6tulpAMh6&pc91gcn$S;VY@p|h&K|%y;Li~yra!g_`cWFY=wwv2`AcjJ9 zxlyCX5mG*y{7;EF>I*VNE4NP{bL);mZM^Dw#@A{?t=cjHMj}(vXy0z79nHmkaWUQ< zNJIWAyc3TP{KL?cFp@@n5$z2w=yz3uTD&SVhEo$Dqz{luLnkr)n|Miv_ZEil1U>!< z!+aq3D4eiShF{asFvFw{#;e^2BcM@SGOoq&KEm)A67o+N=7VFHuu+CTeq_T8w}R}h zGCWHdz6TWeCk*q!F-+Jf!@oJAA%3byM)A=!H$u5?#$y(=%6E$lwhEsfX7 z$--Uao*pKr(Tn`PLn3kaz0jrLzd?(-S2j3HsoqU zoU$)mu`&TyB+GF8)^s3lTl%@xIT0c`Ng*z51k@B+(1QiKKpS`**~)J?T#4;sgLpD? zNG8?gv(CHL*q-*-^I#I=e8({t^;TJNP2;En2Vmlw_&}3oB4Xw^!&ek5=6sfAH&&c$ zatt_2DPt+y8O1tzeJQkY#|Ne#&E;dkOL{$HZUL3`3w3ZvdLjMeiP;- zIu@x8MsY((Cl<9!jcF$joq>ViY7&f!&}}gFR8VGX4@iFkDMx#j#652^XR7O4+dhQ6 z&a1_IrM|Tq_jfOEYou{&kFTg#wZ~Wci^krMG!(9AEFbs>!y$~Mk?!@qL3{$vVR9v` z&F2o3Rh!Q_!sk|`F+TagKk!M|D4#nI-90|zZ~g?X+3D~`%jT)pU>YxB=Xx72aV9|*lBJ?7)8}KhA7~WBhY4z4^tV*m0VpXCZ zC|M_yTxjFrD6II}7`3=O>2D&96OU=@%oB)HZj$am9f|k;<-)-Uj^kyp+enlV@yBm1 z{0v<95F3j=#y~V_?OBYqH48|#C%rF%RVko{B0$kc&UXWLoC}n#K>6yuWwTlceddj_ zrK)lH4M>zOY?25^o-*E*>LEe~9xN@Ems!9y=RE#(IW-~bIonODB)lbc!g=-NJ?ZJM z>a$|L9BBxzQ7p$r`s-F>@rmv>RV3BQl<2Hdb47A?cg(r|hmFdblQWwOhy>Cbb?S4N z8tj-r8@o-fj;kw|Fr@Ozu2Zq?sFA3Gt6H_^-7}g_>7gi*-jsFQvy2u08dpg-q7LN| zv{p>Ztr@9l$tfKL@bq zO?1S!JGNzha51h@mshtS{RSo%Vt#2e$y7~aog?c`w>GwVYLy$(Fn?WFO=xSKWNC1&0k-TM#WyjCM3inBhN>7(;|?RPWC#0~?HVJpFY}xF|PAPv~OM-9w7; z4oljQ5^g}a6G*0g>~b`R@4{?|`DO;91sm-(Ql>m8Ag*H4_6?YWG6ou#d&)A~Z?f8sX7H1m&q7c|!$&Se z4_fZp{Aon0NjDehJakqa67GFfQ`> zA0Ws?zcCg65e;cD$$TA*vdRN=GjIwXpw2kQOp}g3Igm9@aNe}uB(s6Osr-+ipRO#T z#9S>13-W{hc^6F;OzM0WW1NKNvOOz1aN z(ialgGt0nDy68Hl68Aw3=)9JVW$pDS0$b-d<40}_(DOxj3Tk+$EU`X>FiKCBg89Hd z3Wjc&j;?L-Iz4{K-iP9VRG2O%mGZ6dfRnEVo50=YzRn4n2t_Re|I31=I!d1TQQ|EV zGg%&s&)&6Y`l^3r;H)jM;c5J8&$3E3K`Cs=XV+-2;u6wl9Xr^^*|1a`lWLS7Z>0}Q zahwM_q-^DJO0E2Nn1x_@a#>6^px=*z`q5!7I}u+JLGx^)81;Pu>9|M6v%?=`m^+Y+ zEa|F4u0(Z&NB=gZ4uD){7BdUQ;579ftl8brMK7(otjRK*bRk}LB3sY5xL)dgbHt zgwgC_*Yd;>#JdJEC>Pw)x0H5VT5PkI6vU~=M(##>s#mQ?v#v?6{&1%W+E|IG zaMzufIOE6W*!KmAVRBsvVQ1e-A0h)g)?K^{{Ec`;@h)`^Em%%R$}ihjpO>1vIdS@B zAno)^e9s5_^=;+lZb;4Ui|2=dzK^| zjfD6VHFScuW}HoSR`&$^&oHz+;$>S5SL~bkT~M+ee$*gW;w; zTK9~%ajJ)!&F!UA+gDySc;chTdiM~hJ^4!vSNuz^!G|Q9V@dc0$!6Y89wiRGAlZ$t zN6v0%^hwR_@_|>{qJEsT1%M;3mhuomb2}}h)8EN{ic3G+($9A3XIEZTnH5xZ)v4|5 zJFb3yEfTyeP>ZDAv&hyp-R*NKEieTvJxjHdG0np1G^ATs$=C< zZ-6LZPIbi9+#XNzRVR*`(!$|#imP%QUOARm)vtaQi=b@UyllXIbESpBMEGq6_sNg- zf&ZAk$U@i8gqm^2P%Vf)w7d!h@pL@a44;ZQGk8lw5@W!RK313 z9UD(WZ92BDHZ5)!bwb74xTY9Y0P<2jpuDQM=@fajBU>k;JDFWQ37&Y)zg^}pkf_$^ z8EoIS;>@u&h^f4RI^s|L<8z67pEzC~cJlKQExcS9fF@q`5;h&r&0VoCsCR7HHWS5l zRF0Qm=;D?8F*v(<+dc@NUuo4uE&K9x9YgRuzjCCd=Cqy--BroDl*rn`06g-txV+cf zP+zsV?R9skx{NZs`=l!H)#n-IQ^65xi#5uVL_@H>D_1pIS4*cIy#~e3M+{XvD&gyN zRV`fkSj3mOIT-XbQZMw=5lCl5ASHVv_W>$}%K2Jk^;LbY1hgFVves37VWQ+!eJ&2t z>2l*CpBkeZcu}oE)Bq{=W(`2Gh{SW!14D{35{WN_#Dy#41os&?Ex4RVW7WxzQBtyT z;_cy!t=Fd2#YXM(YEQ25_Oaz!twJ^Rr@sNwR`nasz2j8leJeCwbZz23$&sk7`m*tC z)i#(;B#lvp?AOVC3A?}~RV zutRZk`w$+f*#lxcSdYH2Iuu&mZ9RAQmTmiBB!$_6WR=%xK^En8&*R!JNbD~UY^*I4 z>@>S8?3BCZ6c-;kSzL|S(qQw>?1=X2E~Kk@`3rsYXy(bsg0G2NTZ`3jWJjd-=_L^xBad)Qh zTE;Sa{v^n#2w$L&pf*bcp~>@07qw9A6ber8pEKJNMW>DkO_aTBNqaY5T3py#LFexd zn+Nf}-LiM>&r~rQCq5XFUwlTZ&pw)K**Wg%uUUwqe8aR%zg|`Yq?x*~pK&>Tu#ZM7 zo#G$TTgk_EkLH>;C)(;PA6e>}z8nJ}EwceS>CFc%npT{N*6U>}$_%4d+tCrmOQiBf zse8;(CC@|qoHs2yycJmpr{lh!Ymm!xBbU;=+&`fia7_>T6_gV9p*{twiTE~nE*~N_ z_iO6zJ}uvBu0?VA&uDIT+P9cuM6@zq)ul7PS?>Wb{V(4~9dqRI9!M*!(75OG9^@Y6 zpj%!i7q#vQ{wsU=L9#Z|1GyGdNNP01U*6P#oepAn5_drq+AWvK-gF(#bFk`+#K^qg zkIZ#|QGGQP7cZE8LVmF;<+9TL5hQWj@CzF)O-#eoBb#4`D5l$p;EGs}EQGia5@QTy zjC1k2UxsITl#Aq7E9HXn?sw4rE@t~8=@M<{lwCqfdjg5bRh&I>I1J90wm?E_<$Y!D z|LmI_GLg9St1|%H@>_Uh4GdJ@(#A~gyk(dc_2$|SyOXJ{^M*v2nFfpBxJeuPV9o`s<-DU5}Zb-r=HfM~0ZG49)%lV(Oz$xI?BIa>1# za@v;t5E4n_xsf<}<{(+(;bA^gzS`X66c17u+b*i64#)yRNIFPhwZj~v&4*&WDQX0;}-i`<#hD>{=#DJjq6EBzv6t;U+;H~$O3vRZ{d#I2CC;>RN~`C zK?*JHI^m=c|8N#7C2GytQ?+jbLyH;Xxi7RJWC=MFGsbTt#!-2;7QKHp86T1zop zY{|6ZoAT>ef;jaKio{I_yI~+ps(EB6mxxMR_3dlA5;q{w992H4ER7DzwY?yTh+Jwo zrijDpfeBfT=hwMZ&>}JExjAVKW;rItR;3y}NXsk&zvodz`0eAbw=U;R{;Ab@ldTX$ zFQkg)E^ImLu@8=i2MWBM;Wp$Ht>*0veBd8a5u(5i_zC;epb&Va?8quNE_G@jGr0-m z^=5s2kP&3pl5FJAEE|Ft6}YZ5e2^{7YA>6;YoGYRk=jJ{P9Aco4xm=ykkNTf*>ztI zcoTOxtziCBp5Y#Or54(x2VDiJ9iy885OlgGI17uW`GFd+)Qp_oxdW8gsmSRaK5+O- zMZ!;{h?u7^F4k*-mGh+6IIql25h0nq@!f!Xh{-B0HtT_mpdM%^Dog3{X^3qhMLMzvS2Wl$nSC3fv=6xeg@~!hbSYDcTF>Hc7x)V$P8V(W>%njuOnF=YONf|2%%6C1JynAGi~( zY<_?b-Vd-xvIK^?pwcpP!N?+21h(htPA*d0H>MXR{>!qUZu{Bi~-b15DH zH+BU&oAfN@8|2_(Fm7%xJ|pr=zB@xmT6Yz75Mz{`emA@&d&8k5icum%Q$~r@a0*+y z)E9fd!x1=dK-wFP(3@F_y;RQ@!<&k;B^;YkFTqW|l>_6^%?LjZ;cg=#rOM^iXqqvu z$Q*<29}9x1eGdf833wZnCbjRWcI#D>nlU!_o-IRHWr9kLp)Py63>lXMWkhOFqkAg9 z2xG*c8K%og5Iqbq+PumQS|HIrbH^VB+d;rp?AZFCppy*=kjys=2Yib+S9{|{;Fo0J zjr;0(<0?{hoN-@RyLH`}X;|HL^}AUMYhHECS4YQdTcL0}nr?*UC!i@|3CEaXhK8&p z>h$d8&m`z1U4e{|>x~V{%VHETecr2hQEaqryGtCRSI;KKa1fpP*rRq8vaekpw{rvC z@_q;=-Lp@2_$K5Qc;#8%LLH^Lqr;j#^BHL5o{}v4r&>9!*o`o2^~gxlBg?k{wO{-S zhp8~hSRGjiU4ivK)nbbpUqp_R^`VT^>^KmlqosiQ4$2O%^YF@-j2#3VDNVJkAco1z zW+Bq_m9`z!fJ0Qvt1=hVvyY5WU()w612)8|PA;jbkCn^+0RJ_1z6zuf<=IvD&Ssbq zHNy-v16z5|G{cPDYX&kR&A`WkXqkaK zWqgjwzx>=^V3z@ea+$(&VlnRJ$ecKp{2o6W>5fU*Pqg0~oP0_B-iAzlWc~`L&GzX< zrBExkS%E>pfwVr(vhGRbQU%(HoEXCFEF9w?d$SCsOxt4xn%L6{^nQ;AHuc?MHa6>SV|QtN z86y~dXH6TCG-|N&=lK|lFGeC1Uuu5InqE3Xqk<^>UY#1S#kb+V=o`&-HOe=)>&$v3 zYm8-<6!{P~K~!#e6#C%RG7po9>ltd^MON_JDGYt{wR`&3FkwAJF~cH4{GNxG>q7E%A+bKDXrYUdk0S$Ed~SV_je;><1apwIi(z zBJjl523mtbCSQ4NooD-SIAL7130FlTKib@`w6TW<_T(fH-qpctC;?@bG$*1w8(9*& zdx%fwN3~iDZ(`0{OaHdA>8o3I>}?BL*)Ilf@63(TlqObUg==y9T)uD-rB1xQv$%Z@ zaZb|Sgj=76R}Es=Ju+a0tI+ew&~sUNnZPEyqd?8A0z z$S;#%DAvp?jC-3ta%rfB}1F zZ+H|xTuJAnUwIr}g$F%vks=Sz81!Z@j?gzDZTX$}hiS=CAiK1*mHq@#=1EN`XF5q9 zGS~}sl2fwoxdkN;#WT+I-1xH}GPB5z9MmjRh;AI&dr)%?unqskJu>}e`q!si z`-A%q=EAQGe2_Th>r+wUt`&d`1sej_(^kX}(Xba=cy}ve z7LIYKV`ExRe{s7*sA(TP-vHEXu810$(8s2htcCI{&k#~g%ig#Ww53mEQOs@QDk@vD zR3xZQ!0VCfY7=qsS4YV8%S)DEFenH8t8TGiZ!^^7x-@K6wt z|AvUS-G|vOYNTNcNwBw{6l1}lm*c4W)|0P#f3`5|Kyo~m_-Yq)5Hmtsamw+rFYi{F za_P%5R37uJ13KE~K>9B*nQS2F$Aq}NhqdNPHh$ZrqQcAb=;i?0FVwjZ(y z4muTSO?oQd(hS*=5(?VfhJRQ>#Bfja=olVBccL^NKx)Iemhge27EMJS_!T$s)tM>C zehpZ_q#GZHeqsuc;8axl@(!L)(&c~x%)+fnnS*S_8abqg2{M!u~;an#5 zGn+AMbd^VwniD7S^e!|dF^R=Jns=+3xcu>`VmPF!TUez*)^Rk9DeNcG8OcS4v_wM1!3gDsij(YAi#YAj7y+R`fKC>^CnRN7Kgj=rMB z_YE`_lPpIW*3GGzM+M~Z229Ws`v?pTFs9~R4T<-Hyx*>|U$8?YG2AYTcr*b0a@^SU z2$u;eIqSy*&uPu2+zN7piXIsSVku;}{V{}ALcf)W$n^R(-#vZ?3k^2EM`2igHA}Rffw84#L`xfSK>1EyIDB#$+jVqv-ibhh$4cX zEMAj`$-Bq3@@bYe`S}6Iz|YNs-$jiD^J7W7Z-@c-X@C4sUy@N8h_DvU0Pf0lCIXw zt&4zn0BJ(7#)gDPT%5W7I*w7d;xU#VRuSA4q5h-s(wRQZT?G`%uVmYxouCK0I~!HR zGX!~dP!zGQxLOpXvUB{&$JRA}jl%Qq_sXz==3P}Wv3K#;{)k#68(((lBbYS0IHO7! zG5QTuJ(eC)NOjhMsI-0*1kz%H%(m&q=?ZKc3<1V8-+JM@)Y2g_@0PBLQnc3=rFpOhXvwmS%FTyC1Fsu(@ z;|Rkl<%Zde3d-@)&#ze(BUKt>j!XelNbgG5#}bSRNogN7#21<&R_Q%kyjt(e-$bzU zQiFw=4qaR1(vkKaJh}+Y(=(|*1AKg@B8`#;7+nAK4Q=p)lm5Zjzo$G}I8YZe$ zTOI@FzT*y3SY`I}mC25L0~TTxdVb7yY>G;wOOeldWF?^<>7%kEIg%2mH#Iu9f;88&-|ITSGTfX;gc4~uKTSQ7=C5tauS~rm0UcXg5G6c zP`O4)$yoHQyG3fMnp1uS1TUqRc3fY)Hs(45|1#xXE5^qpa+KcGsmdPcFs0}Q2R%U( z^5s=pI{OFNmlU%P2eD8thM`Akn`DR`ki`o;G3T;YrbhVWeHVu(GLszb0bVPLD`l1s z_H81wlk5mDa7-}(n?gHBp%OPdYh?R5f4w0X$oG=etK6=%){Oc4bJh%N;|9P%BQ0{{gO%*A3<>i`8 zT-up?KzW561@dCQx)C!gXnI0PEZ~9MTr^Z{TCpdlB&0864?R<}14X2)D0joauuilD zM`1ADZ^@Uo%Q|kaS}P(up+Ifq55LFq7mlzG;XKm9-wx<`U#56GmjHRu=z<}n(Zy7G z9KmC;l|(pKCK2|eZu{L1IDt^Fmm3#?aTKLDTRIm>Jzb=b%P>pZnh0^Cxr@t7*&Fs@ zB8)k^+zE^97l&B_j%%#qkKAmbq`_%>rua-S+J;UaRNBB!I}=MGy6%L6%j}{pOGj0f z4$H#j^wM|}It9!bd-Jk*LjrswiZpQ@@J9_V?G>iJA2f}Zy@qUW91n%fKxwA!h=5>#S0$hLb<{m}>5MF*7wzj6#mCYc;1 zB{DeaVB616a6$?wK!&L-sbLBzveVla*V3^R3>lS=z&Rr`$y}m#^O>fD%-S$vvf9BI z{zA3mQiHS$T08I_gWh`#mQRMKl!nvIrmrDAZ1k_ANwI;(-6U71zmkUZzIm`LXQR|3 z>Ty7hp5_qlUTvZlE8ZxnJdY(>Q?f2Q>jONES(c^~0UOHjr z9E=OUbPI@{x>2W6U`Y+T1#z>GvvhQW+R>#u*78TVhLXmzig|0|EsiefDV4t$Eoyt;mEC*Lh7@V0O%|F{jy{*7yU+>wmF4*%K+INe#t;8c`Vp|AZPJNE*}#NzHQn zEdsJ5-^RZ#2&Y^8TeVIjOJl-LVc%6cWZQ{*f>8*lAXldR9?9#qcZg|AgL5;*6Z{BI z&V%29V5=S<_y>jv$x!806#oRCaP)>WMssti0UIcO4PMle#i@I|1-l;6LX@}J7*Rg( z4`c}AGAqg}soM|^F_m^)SwOS;Cc<+8A2FafMY}}0r5(!=c3mQDrB@;zV=s!g7=Qva zqcFHq$N$pYT)u(G;mB6Vk~WO?8I- zCT!zhSvb(4LQyvKb*sJ53PCU_t`}3lRJu)6tcvqWvSJQ)T$w9Ye*HpUuY~DG3NLeo z+B5^26FTa&o-6Q^byz-a63Tm__+%#>P>y)ajtrxh5U%PkCk=rjRn-f+P{`Zj|AddL zs-1L0WJbODkR?PbY`{Z#FO*Jh7MFHhS8zUrnw4GqHu{jHw2YpW9V59BIVDfkau<29 zy$8!<3q%$|{|plfWaVBZ-v|O$e{x&IVJYo+XTzT}g%P z$aWB@-9{YjR=1HIkDoxa$TlWfwodv={!nUq7LsTo4~Ic6q2)5N}&howxrgR+AtN2EG2TI9~Y{I{0 ziB(Lq#?`Hm;w5*t8cwwJnxe8u9s3z6#V4gVNiU_sScS^Pg>frhr?<)64I&@TW~1@` z1fE23OSr$pX*IrHf_t5Dc|rEBS5ANA-||Zz&99sNNKB*clu>dt2@cxr<{8?YH`>u0HWJ;Ck5dR46sLE@X6U0ioP7-PEWEp=PEja{(;j?x2O~^yJBEj_ zohbh;LLvX;FBu^TW^LsG?ywZ$EZqemimwc@+9WW9U)Na9HI3$Q-a6n|Xr&v{;*`5u zLXuQ#N|p}UI&_v?ZIiJ!G2yZbQ`NbU0qy-Zf=Ze~UMfS-V6~)xt3KSLE`^Mv-oF3H zKak6TkXPYqO?68n*qx1L$7Svsg-azqk~J&K(G1hBXtm@8ej+T(H{(dkxql82fIpm16dn@}736 z;^?_#rKHMa*|gPm_E&HIq1KgGLk6lNn{$A1hX;xE#X{Utcn^Bfg=0)l*Av~TBFS-v z&@Xk9xWpqMxA1Pt+g;QmHvxrXMk*{XLt_>mS`@`+pUd(m5XgWydybj=&}m9{kChJ{ zl2V6AM<>mnVm?25@j5Vxul3V2oHB`73TjZt*;h_;`3m@CsV^~^zs|6){1906BnpRm zCJH<-v0N9bw<3jkBtFo1QC&jwNLqUg=9`@6+nIZ=ZPIk2-I@Al?uU?m8~*cLU0LfO zZ+h<+xOrEZD~j@NKo8F?RWEMJwEj6vs*7%@SZrm~`_4vJKd&hCI1)BBORRI+Ks?w8 z4SYwEfl4o#6Ylr$3aXBL-(q#2Y#DWu1zIQWD+@K3tayxS5F6uPMC+QeR+&e-i!>*V zp=W%O7HYf6c9H>LY?>GnP=A5#({uv9j=HI1l8Y_XejT+_(bg7(<-EY;5ONW(26>9P zL{1EH{C$~6I)FZbEMi2JlVaY4gd=ZKpK#^5DGS13$qAm~E0bzyrR_^ca3pW?7XZSU*|8m5mp1E-CHfQeB~YNA69?@GS<6uVS51Y`i9Sv$C!{ zWy6HT;Vx$7pICJXmF-sF$+=&5vu<#-Oki^VyR^L@+Svoz5V$)g0omm_n#6XQxOeEI zJYcg6QJs7m$jjGB*&A~`MkYf@&WJ5LB-ubLQ=2z|ihL?uzJ1fd(_kI>Q?RCe{Si!^ z$554z19+<*7Xu0xxU>xP^DH=Dxj)L0U3WHAToWO#%b3TBw63dGFrqWxG)@M)-0qwv zV_I(aA%gEf13WAmg%1}lWG*OgM!qBQ$^4m*>!TA2TH_#hiIqMVkkoARhO~w4yOp6ks^o^>&1DXoJ%NzoO!|~ zjA&zC?(dzX?e{|4Pp_0*!}CKOFATMjA8Dc4vnW5^7nMe<#J1UNjgyNO|E7zef5U{?$kt&5H+-fgx`1tsBGWwRl9|#-A01qp&zZ zG=%>OC%A_aAF}RYgbxQ)UPqTEMZ429y%jlXqg9hr4}DA`%(znzeK3)&s6qka>ysl7 zlEhJQhpgSVW8Dn{5(l11MnsS7IWbup#+v-G(CHjD3lBgC${wv-56C}TvGB?_d)6bn zxEp?!jt_1oK?o5H;|C%b!VgZZ|^$K{EAzb$Y@|qp_4*m_qCf8Mq*r=WzpdKxpu|96d;Hic=A)mg+_7g03$ULd1 zEjyQp?Aq1)yr!pr5pjr9DbJ zR_JJ`djVB`_cWoA_NuPl)VC~sZBtc{4O2@6A-(}bM~eSq(cVz9^%@C+9gzNUAXRq! z%FIBr)mR)`&1M((&`6KjI=aQdoezq>Ah3IMYd03iVaHY8 zB``}F3aeRSVFW{fLd>|W3c+;ES0U;}Xth1wQ^J9lb`-P2SGjGOK`bG+f**A-c$ljX z-reiKT6lE#mJlz7VGnZANST)xQbJFZ?7^B^WKu{cc^K@$)TBy3>8=v~BoIf;OZ|XM zi%6=duwfEZYI`NLhu^ zg9+Y2@l)L`)>P|7Sj9IVGPmDB}v|cCXmVQh#F`

)Ytm|z>`KW%?qR$ zahzb2P%Y(cJYJT2XomwIY+STPaTET@3$;EG^Rg&HFOcmq8jK5L^#V_HK!HOkgKHh# zId}^Emh`#x%=}?ND7yrqY=b9b8~&|t(LGNnPvX)1ol=D#KUZ^;>gR|n^{fZeGwEeC zslH2Dbi3NCl-N-FrxC}ys}B|B#$&+TVYHM5&K-5E*r1h4qcez`r8lfp=wncqoJcgS z3*YHJ!*d%}DovkH=qsLtg?UA>iqJ}hc}87gTEUEhd4*<6numg>6`E8?8}!#J9F9h= z#1!s*;J#C&jeLB9uR6wcSBh_t`(li10nIumj) z_UMY=xZI09@hf^RVE404Q^P3$0l`WnFk2}fN z;||r=qo3*z*3);b?w{3=Gg$I2sbC#&`C>{v^vi~~4Ic$-t9}88#bUc9@1NKwGjE`B z)uk-osU>HB<-hUHC|6%YT&X8t!)dgpuB0rw!22B~Hi(Re5yzP%3~G=v0gp{)5-K(n zCZY7rXA;WYLQF!aT8v2uS@@;A?1=KDbQ0z1SEqb}MtO=Q%72UfFY^XM7DV|jh)|00 zj@^ZEq8B@Bs?~m0jSte7=Y3@p8+U$ z3o!tpYB2^NWRMc%2$|hVy-`l|Bt#QE=^fEiRZ7JCv4~KrvGOvGihC)nAU!Ry<44iH1YKxGx5KReHi_w&j83t#(=%KF%n>WzA zAbPUF`6=ER=}ETsQjZhq8>A=mB-iOFQ)0v5Bu{cq&vwv$6uPvm$@HXRL!l?7uTRgW z5|VPa5FrUwixHBLX@u;>2WC9&$x(a|5yvBf?a86nUL}==Z?yGpbx9-oy>Uh(`W(s^ zu+cUK&kcT6n{BPNalOhucRl|lZ59749oofKVk=jEnom+hLgzRCK8>jx2cjmQ7lf-X z;AV;cao-H zv|9G0NZqP)4Ji&Pduls*k%;5$=|o6j$^*Ar3L9)f)&2Nf@npbM0GzR_;EY`bXY49C zV^_f$y9&}qE5$nH?^AGl9d^sFJB=NDTi zi-ASIY>zoH*Mg&zWJ2Dkovsa~(4~MGPg*x?w#FayDS9H_DiwHyo$gEg_zg7NPWLgz z8Le|$C{m~6%Xl&tunKXUj^wkXEX5y)8P(WC=tTFUhy!=FbJxbWZc6d}hKx zbi5;DQyVfi!MNlh9nfQdvPPxDDO3dS&cM9tgNg>lq$8gY8K>B zoUt~KQlxIwnuI4~ZAK%G*Jdk1%0T>Kofu91(v|v!)xvWfUIf+R8KpI%jJ2qx$=+Ct zqZFyv;-7dj*5V_?@mi42lJYJdSuJof@pXhjCNb|N7Kjt`o@IenaKlGHrCS~;A%XQ1 z^Ib%@S%@~)F_YqqbsS2OdL5JTWUONs#PK@jBc#OR53i&18e*gN#75||R(@U*HiQeC z61AO&3*Wa9i`uigcOlpOpa&S#TH8;j_f ziwIV_$}x+6uS`Ugk*P;foU!y|iquQ*jwfU3Z4k#xUxJVlhChL&=aGYuq4e(%Wh{L+ z#TiTgD@E$1zlJAc>CYgJmo8B0bX3$|I+iDNRMb%VgNQPgemBJ#OTUdG_0oId$yoYT zh~uR%Lr96hpTN@de!?&|lzs?N#?tptoU!!xDN--}FL*MR{v6_X=@u$|B_92y$Ge^k zD)}Yfqrt^4zMmJ_SO2C21RfD(M&0?Ke+9aP4fzDRbm&9^{RMlM=N z8Tr)uWtM|G|J1uI<9ejfH}=D2+gYDAjoq}-#&r!>HWD;tBNhd7Wy6%lUS*pzWLSIoA< zl;&-u*@mj)>+n4FxnXf8ygWitg<4c}lvr5oK4_BCMoIQB&e_^UIU~1W#0fs}oUIKm z#b$0gzA$vEn;21ce1UD9ytN48eOJ-rMX133y6i{D5Z6iY+FiGEIH4v6G~H}=tp|yb#w@l$V0nIwjGSOoS9TRlVsa?&bHCy zjHW_UEs}i;9>efRwT+T8EO?B^Bhn5{kW!-XXmO$&kvLA02`yrx)b#O^V~1?t0iKF1 zwe27x5JQZOl5O#^<>yM`#ljNzA(P~&Kvm8SZDmqvZvO_!&JBsNXzvezO_4-=Z)hj+ zy>T7SA7>BuB;v=s*IXi{%mWRi6enmR$!n5T}%+1Gaqs(XG|6uow~WoTniQC^*CzUv@!GN$=DmZnS-Hnb96 ziOP(BXwW2qTuYFs|Z58;Jnc{ib6wBK{e)P->s##W56f)ZbJZr8i&@k znC=unl&=#4D7eno4gr!iT1{Su0bX_-bJt#UMVF=|vSFXf?!#V8&#dkPL8O#Kq=N4P z&@Z{RG^G3F5RK&N3KwzU>7y#r{) z_eQlXu#CpHNjZYzim*ED(t)xmadJi+M0w0Ma=K8qgNmiLBdkpkvLjB)h{Ne)DJ?#@ z)D*}UDQ!@xdkt_PU!9y12XCH9@PR8n6ovS>kwajFic*&KB-1pybf>NMIb2L zD&{B1X>so2D9OIghw;0Ba6_$l&)a!2hnd z;l2eiZyvhVH+v*9TC20C0Wsu!5~~ABOrfiGz8Ke%B|6tii%H07!u5O!S^-_0yy;~} zIZC&KK3>~y)bu8wX#@#|qpnQTYuCVKsQ?QHrZGgBka#;Tc5#yy?QQL~eKN32%p>mf zw)fh158UhePT7yA5wd-|^|a_FE!rF5b$l|g#N|`A<4LxEL*$uAK?r0=g1N+cN?iU2 z_Ua3IwGlP*T{{AmkZs$or$DTI-uAhNiV)4etOR0l>?aV#iFK3wq|U~{%owg zlXYK4Vj!)Ca#{_P)0}cjCv%zgbXIo|?fh5Xxb~c4?eUn3&tRu@I{&42cx!y;xA(x3 zpnEcKxeL*4fm*YyK#ZSoga@5|h!gb`9K3FC$s*tP?y9)#eR!jAVOP z%3dVBlZWcC8QLs8vyQ^MC@fd$N|8Ns*#RYIS0#yR;966f zGMi}R8zZMIvYrBsGZsmXHNLx&cNL6)wmVz0t>NVA?K9UQY+pk(F3avLJJz82F+o!8 zJ0G=eFSVggwjDr414Yg0dctjI;DD(o+)hEbwI;!^>CMd8SCTSgU;7schI_+ILYzqm zmU?3vkb16ZvJ17XfbhJJdj8CU3{qYfCzwC8o}P~hTjg%3Jb0Pi6U}K&pOx*(CYV-H zuB$QFN1?AX5^?1nu|IQ6HR0+ku0|=nFlD;yOt5>@(UM2>3`AeDwV%@_+fTS_EQ`A0 zq7Zk{Ma;KjF^9QJqDYa(talG?TUXf!JEIB(n7X%-IGM8^Br;Qag7C+W?D7 z!ESJB0GecdqK3uz|7+gv-5^aD|5q|MUkBBH5Cs>10-M_cK(UJq))#Biz`duEc%U>$ znE6ukA*RmImTun`U_-+CL>;hp=K%4+W`n9|S03gQoxVNYp)H^)9LNJ!;T_$fJ>9+? z))$M#yM240RkUjlu!;t%>i{PBmypg&Ey!7Nz%9G z*}Vp2t}lmYoiy+!lJ3wiKnsBu0G+%C7{A&FK^!NR{h%EyubG?A15@G;U`hlQ2|vCu zf$Rl#6+D6Vf}6uYd!e0X5e9HlI~d0GS@Ypmah6MtkK^0)X6%;2Bx*H?_08RWx APyhe` literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/pcre_fullinfo.obj b/3rdParty/JCL/source/windows/obj/pcre/win32/pcre_fullinfo.obj new file mode 100644 index 0000000000000000000000000000000000000000..966b70854bb09934677952cfecf886954243413b GIT binary patch literal 2906 zcmb_eVQ3pw9DjGYq+!mat6Q0_gMJV!)P>ecaZ^XKB(_>cvm~pIo;%XJOM7y;l*ELh8&KyhkCL|1Gj8&xU45SBQ^nn4-qc#CwTebStoV~mLw<7oSglAf1co;esZ zx|2>fbrz`UvQ98+#xx^6(#q$v?dMZ9O(XBNP#iLO#%)rn=-QOaq>_=vX>mEF>?FCK zQmQCwmI-xpkLsFpJYD>XfKj6brZd&rqhsyw(cF|wPtLl%Op<{D;quZ;SR}V+FJV8m z*51W)|93{CSSMDywq9USE>zRVI5~U@EUbz>zLhE_=W+a;58D41@y{ynfe7+OAMr}* z_zP(vIv$I|jz!WDf!%zuk>vQ%gdiPCr91$+*g@Xg$#Xn$EJ6hDU8}=S$eTXmYkHbI zIlGVSk|b7g+45$JI+bW<3PqMY5Wds>l18Ozl}ZKeluF1s{B3Z7uoG}s9{xX^zmNr< z{A*-kH_s7r)cW~IYU26o;Z5rstLPtEDc7h_ZWOmI{n>0b>vg!4SE;|@;i$(-36_6; zBc6;VXwUpcBASfD?+50$48NsKW-Y>Mgtv1TS!eBc(6$b5mNvSAuf7hu`S5FVQ1vPB zHPD5wy+9u@23!I@02s|R;9L0I!1F8MJK#2u1x^FMVC;81t%QGm?ewY5N2=ZRVb-1# zst4z(Q<(s0NqcUFI!wat&f{*xswqNvZ+cz&pe2opap?`LbC(Xio+g!w*$` zb_zmzs@?WjaB+0EXBj<_&wPj?_I`-tgXe3dn;d%k(Gr3eu9wz0c<)8aAH1+!`kn)Q z5X1p+b}apYIWV!(@yTN^UKa>?>lj(5X>NTEco{eYyaH5!v%opvJa7@X1S|lTfp>xT cfe(Qzz!LBYP)l=fdnWiFznI{Ng?&%{0?}&&pa1{> literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/pcre_get.obj b/3rdParty/JCL/source/windows/obj/pcre/win32/pcre_get.obj new file mode 100644 index 0000000000000000000000000000000000000000..265df0fca78717ff924095e9ff2ce86ea4bc7c86 GIT binary patch literal 4220 zcmb_fZERCj7(VSi+peR!0fX=vN76*%;$)N{tVS4H0fB~n^^T90+O>C3?b@ZimoYOw zlG0>%uhspLAPI&aGsa&;eu4h!x@BX|EHV-^BpNh;#m=O_LJCgndu}`S;lKb*c5lzU z?{l8}KF|A}d+ttbAnQv@t+W25LvFvT#o?FQtSwHzsGi=~P--YsNA`oFRO%!hiwGg} zD}63;o9OTtSC*6%uPFrpgY^%3pKV@p4#dZJK(Mqfn+q;aVI6TPdJo43> zIT|fdM}*Lv$x$9p$eCP{o8nSh^3gh?v$M_C-t6$;K0)%+S51CVB(H2%BTd*wZf}#1 z zqBP9uYiY9w24tnJ_KQN zx`k2n3ZqYP3o+;wVxH(0B2X(Lp6nJv&?|(@<<{)^bGU_&88T+Nh0K&{2&oeqEWy5U zNWde*NVrN*FJa4)YUq#Q4}sB8M9PESJALe;UQa_K$MY{fOr=tHF5sQ|OL=%UjLb%# z!n@&mJ%8yX9MsN?Q|OJi8U6%(lreVneX!~&_w$v%+PL6V0_*g6pD#FnpG&|%SkQLz z<@xgBlY`QN&h47=9U3`57|{l!+LMFw&4N#(%Om;GP(&^?L<}RHxt)Th=LSD78ebNQ z9LouRpovoj+0##IKc%J}?9fS}-N!#aNQuO2w9la|#odQToYZY$dfY zSQNNri&E0n)m10JUAWv3>`OkV$mivkA5^?d<-AzU->Fo5U$|XQ8^XKvG`8`dR0=MK z29HzdiEja_XANqMw!UTzEE8O`8qB&HwS}NuE9MR0!v|RKF&jH7FAMHJJxA%*@1BNWWz#)n5& z01qt_CBwl8UlAP8a^D4eC|prv?KdHsV*j=h#gxEC3ysK_H#xhCbT1RQ?(KLS61XoG zLAnO%`XD+TYv=rlVYiqSGLKMoaF6w`$S^kPM}mVkTpifb9&rGhmzG zhH4rnbL*#X5is$}2I$8G_F}>KwEa^h)5R2QLoC^RwPd_nvclMVnR4k6pUIb;T|~M! a3H0WNg7)UOf~NbrKySS+XbIql0{IsaZ$d@@ literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/pcre_jit_compile.obj b/3rdParty/JCL/source/windows/obj/pcre/win32/pcre_jit_compile.obj new file mode 100644 index 0000000000000000000000000000000000000000..4e40b53b2e1c7b6c1bc87a85e714d41e98478027 GIT binary patch literal 111318 zcmdSC34D~*)j$5sl4M8*W`F=;4-hp9A{eyTpaeofSb~8psDLqsAcWOq2DGxpClMx( zso2HZg{l=5`?eOTRX|%41}7j^5G~+R3liWN#|4o>SY&?RbMAd+2|?e!&inuWetfu@ zXP$fRx#ygF?z!ilyUgk=<(8pCXSVt8nmey*_L8zH*Znh>lvh>opKC`B%^1#4rIqts zrR9qkE}6HWVraRtwwt0TowFCut{7iYR+XAPcyQ{CLvI|WtR1f?`uD{?nx06MSZzf;Ow^OjcJHuA>OjO&TwslazAzUP<;**~0FP__7;s-`#o;hvIxYR*s`D@w~3LX)aVqC_aQQf>_JE{rY0h2{4V!r15$aSolT zUdnn@D7l{Wy}7P-Rh2E6ch92OX(v%iiZpw{J+Vc)ctJ&(+qF2hNS9PCUNUd?0zz6K zg_`%hg}S&b<|r3d-?xydjA7GPR4oPjONsZ`DJfb>G9Npf?y3c3mtxvR<@dPf&5kka zcUQ)q^+od+EsJsQTzq%s-DTAk#Qd#N=f{74onKIKeQaB3Nmcb+7om)u%990MvUqWf zI}%}CSYE~26jNH~EiQL4t+DG$RZGgN%NS>Dd=awtz`3Y;-jdjMCPF&9Dz-S6x$a*g z+=iGoQ+0WnX#ChU6I7~V4m&up!?~!u>i#9%p<;*g?hwwHN;HHucJAH1i(@R#d5g+s z$6P_Hub*8pC-ydPart~U&avzBP|zh6RWT;DdTzyn1!YU-#Z~~YBxTk2FN(3_O!moD zQ59ngB}^&tAG@Xk&e`P^u{X~^N`%I)i-J%>7(1V2(cKxtVyjCF7gpb2?W*9JV(cv5 zf*)1fx1?+lI}ows9uqJ&d9j<<%${8#CLytFbD*RaiXDyR2+MG%jGZ8tEsC}Afc0Ed z;aWDISdZOcTvbt4Ev8Aa!wE{ODq=j5Uy2s0uHwEPQ$m3^wgLt7<^Kx;U9=#^{nE8` zv6~&c*bN$B-CZr@89O_-qvhw-EW8O;l%#N|o0QRAz2wkFs##E@r#5;CEo$p%s zzc8(lO*N7P5Ib5W*6U*{)+LLVkXrq(kUAo^q*BmHdib$ZE7B=fHG2;wGM+Q#d&hI; zS5z&kSWvyBqMVJ@9TM@h?~S;6_R`YXRak1N3L%dj)ol>Zl2jLef2v6kuBv&9?x`-N z&vLf6vGapuP-ccCxG=T^yO*&0AG?kWa!acv*4VWkD})d-b-UO(g)rxfVjTGZO4*TP zv$Vwvg>$NAR=Z}GRk6brJN7H?D;I&EBB@@JzrT9ToGtO#kRVkkv zbM9v^n0I%Kk(Rc-dnw&6ExvfkFs|=1nZvncH^rI7l~tD! zFAK`zGCfiVe-mz0*ffp8&%^j5lG3NmN$5<&Onas`3y=2p5FE@8~ciX#gn{DRVD^IUUF zF-ZW+_g|(B=7~~hg8@pPOX)!)%r0G8w!n?11x&kAE2nCa*)CCYjND$3Y5Cl;s?xb- z)uoGFb1SehvKm-x?t;oVl*BA*b0P-B_9Zn-$s*a#gIsBAU@10`mMyHnH{{neqfB3t zpV&8AN{APgy0C0r=9-KAmyw^Q^bO@#Rm=%v3WKc%)l`vzrmCXcOj}4{3>3F4_bm|<>Brodnp?fu|HHv6yK<~D_u&(7q@H9$Wm9? z-3uy4DBa{c82mE#0&q{StHYq>v%yCB;;PxzN@t@u-c`HG?x`4l>8tCNTGU1O4fWE+xoYe+^2zX26_eXwrkzZC_jcuGfjxe707-DUb zqCDZIoo;YCl{Vi7Dyz>c*I>j@2GgG*^ygaoGnD>ZM}L&H;PFW_>~tFln5`d@U@Q zUaamosGZc#W}c~vQ-h}Jgp5Z2Z%{z%hA~g6+viShn4D&v%JAB_G+W-&^j_pzPHG+L z+nIL;eYM4jhal}ySG0q5AG)m>je+Tv*11ZmqLfIIG~F{Kt?qNTUGoY^z+`CFG;Oyh z+v>@-X@yqHNl&$%J`d=lfvT?2m89*~lko`H1Y~GlPgiwE`mEABXL#2YYVXfgRx3)S zqGekJPX=n_uA}^t=~}j3JDGW68I{gFSskbD3sy()|cazd(<m@&B|C|U=1W`UeQ1S?TqOLYHyEQ;VK2{h8&y!4|uE1u%T%-HT=z{ zn3P*;W+D;KZ+KQH z%^(Hz-e(oiLc$twv1v1lsLCo2K11$K|nV=m}KALy>-IZczCLdIcq+9WILxLLEQ zXHD)KwT{dc_Z!qXcyEJ!!aM%Vcb4|KI*x>Bw2@b;tZ14@u7%ESnGE3Qo;1T-Ik{3P zAqA!*g26;FfFgnNc#Nr5K;(CD*nr zL|!%014#8H12;TfGPLETl0nZTlw5bzQ8MW0h$8dRF-YT!%+Jg(8Tw2u-an1!%_Y|y zeFdLQC4-M1D6%|jEow9!>r`Yp*1gF5Y@d=L&rT>AdTb`XFG6ZS`X$mcNG~Ea1Lp4~ zLyjH7=a(hd96N>2izS1PcPO$PABmKMG_A<;+*}|%z6M`_;P_K`u@Ntxd!^*M<9{tO zKj$qOa{RrLfzRnB!;YUT87M5Dwa*p>vNhz8s%7_q$v{s}MXL?MW4sh(c51|zkoB42 zMS+ZcPzR?c&ziAM%TATg&Dm)|{AKIpNXG_TfM)QtXiQoA#?otHiVKz3~1I^A(G7{mjpbfCi|sdw4FQS)pjD5Dqe z==(){H`90Y2(oH@V74!61u&I0=UN?#vdlqW_Nv=$CUmClfvX}^1ePbU*+Rn+`gJF* zun!o{?t@OJHrk{mWt^#zI1}2%84`C}oT-E}H3Fw*tJ~$WWHfr~_N|Ol&t;CIw>tCxexRV%F-!9d*W ztQ9#nwY9suYhBP4@3RE516H5KpB>D#21aScHuYSO`;&SD(d^O>aNKTf9?qt!4lws8ej#>;Qe(R4>LvwBfAnR)utsMs!`%wHz8eX*9=_ zK+)b{+hKg<4AV=`1%sY(X;!T$&5FL#sX0f%j2Y_T{{_Jp_wgjBY0HtHV+EK~n`P5- z?08D1@p?p>>a&ry?e`R=+3GvxuAQ7_&)8LuzjeD-UYXHYKQ7H)P%=Giuta8kQJURy z&hnN2k6cxKyxMAAKGO4m^>lUzr@JRQptruey8Xg5?SM8p&8Dve*IH|!3x<^g_2^V; z(*=DZk=LsA4$QCbRJ%)A|7)eiRx+?reg|{70HHVM{*)1Bc&kqK}tnRLrO;) zQe=AWnxaPYbHj@oEzdnsGF%ubn|mNUCnp9-^vlV3fY=A`^-Q%v_D(I)gI9rU$Sgk3 zor1h%?ST5J6{8ihlQ}y%kOuj6QqP**)=hfAyve^dVSFyYwp+DMgWvQx)Ml&dv*eP@ zGQV;>=piXy z+eVw~>WwB>H{{}_+Gy1#TH!Vg-swpUI5FIj1D0)9o2-MIJZ7yojN6M)99H)HVV?XE z#G1MzMULInd9?S9f$Mf{)&=e8Ec7ZUsdiTTKs&JwJyOwp`kwQ_Ak2wXiw`(_N?ewj zJ1lN(N|tA&aH2x+YOuSzgVBjn)nJe1_$K;K7w##|`fV3N9ff;rJoS-4NA9XtZHgV@ zN;0~P?BME-R@C6hZ}k*kfPVn@)Kb^zsM`s)O3+cKY5A=ha-@ru-wJnOQkthaUCY0q zUbJ{7jr3&at+Hwt(e0@VX*n0_8doNuh-F{EoUsocX3hn*)x0ucD;Z$C+GRPbdB-sAS(m_y3h-I`xGrpyl(o$vii-&`i?gPB=H@f0BsW`0OM&oY+1dlvA!E(cS_=$ zsFYYcYhKw);Gnu0$2gSrDQQT_TQCkNo@_w2s%I@LJ8H$P>h^D%J~3PNYTG^8;~<%p ziK_3LrekKy3C-upW}CO&IuX|2ve#1#b7H$$fycD+ruuG~z_oh&7A@ZfDS!M8$;4&V zEP=eat*BoE6Q` zI22UR5$k|z`ljiy*|Jk>YRhQhkkUJq^_j{u=9255*;&+RJ(f{qJ~j>sKH0Gfq~%C! zk=7$UkJMOXK0W{`6V~L9MU8R7h}dD^K|YU2>W&kU3d`C$gw&_FwdPzB9^CQTq*11P z8=RR*d7fFPH1`Eu!w~-zfj#ST?S9bI%+o7~pBqd<+DHzvZ+ga-3@G zs#Tq}VkbEk9mdz}rfLJ%Q+3y#_NKbJsuj-uTE26FtDlkC?R2xrg~~dfZZ@Mqo6TG; z%na<0{^Dtj_c*VpyTBsE?(RjnZ1s;3qJUZ3zj}M4 z&6(x@n8ip9;;03%qV2Ewgqi|6Yp*#+LUz>E(EEIHNmFF|pyP7;#I3ev1uUy=t7W@% zQja-A6~G-BgmydTXgX_MZL^{Qvji9QKbE{mdul^fGZ^2hRZhmgdbzDW-v%8FWaGQX ziNQ2*(|6%QiKfHxj5Ai}fDD}K`c@On`+^R0xlq}VIq3MX(vinua4)jvbcUay{J)a0+ zOc|$o&xG^T^QPq)>iMKqL$|?J)99anihF;Y7LU0Qx>r^(cUb*TNxrM8lV>#Ibs(LX z7zAHp>NZq>Vi~*i`!LqSf*S=NVMqh(nXjWV1=eo4QCMM4L%xMz5rOG2iz_2pTxqa) z{!$iK8Z3%DV)1%n@!D;K}>=c?^jWSPcf5^V>Y;?VLdRHIJ^ZMPS4mSdDI^Z zJ4RD{N-%4+ZJ5Dd4}p?=rVJ^xz!lptXCslGJ1Grne4x8eiKoiqeac*TR8T|1{&`{g zrWTfX@-J``(~xY3M|a)n9W3dBXbDBZ^0mHqC_wV8|9+Y_ zF#t|0gz;i@1)7f?0sTRNlo(&;Q<^cMT|$_yBuoP;5u?*~8#GT3gHDDk1JE1-h~g_F z43iER;=u3fouInbk zpRdaIUk?z`dS3nZucUTb44uy&=2PDCcZz_yprQuG3^UK^c_K9D`k>{HIbrM1FZa_0=h z3pW%FtNMj`t<#k>#no|&%Q3~(Igq^CmKt!ZwxtIW(Gdc$+am**v4Q~U7M((iyiZ;{ zhAOGec4#w?cXy&IlG+t~i`oUzr~Eenkkrn(tp<$|QoF&zMef8@|$JKMzgOf zivAgR_T;qs3-JjYj)!~lLz3eWCmt{tT+6u5S{)AuSs8>O0rC}vnO;{)QV1D*PeS&`FyPM#Fwc|< z@z>)qFr525=4d`-(mIUKS5zvZ6B0jD(N_7V^cVjfDn%}}Pg%o;)~WfVp#@BXfFYxJpHEo}_iLg% z-Kf?ss-?^sZR=Fl4^UbjMzG{(NEcxv<|850dvqtIG5E#(4)Md%}hI_%@H>Tg0?Y92_$KTa$t6^7oeM5HJ_=s-%gm5lM z#p_vk7%=>+@pSoa>!5C%NZmFLoiH%8jebdYg`}Aosa&t4$Go!EMx!{3fD8!cw=f`> zBkMf`9aJhbhF}nZ2uKDPhPAIm_(2%1)9(C&X$X6H*`(|1+4%6RicA4aww-MVsUOCi zZH9Yc@t)dU*|o@9np?V=ZMNFyBo5pezxtb|Eq0I zK`exSa~SY57GDx%{)v>@9FkgDNNWFJ+r;hIXh`isL{oevhJ32@N#s+d+S}n8v5<-i z-x5F+AX({CP+MSGBwzQ6Iw-retwbLU7tOvrNAtr_eNllB_XSN^AE&fnmLbeRA98k* z!*vRDf}UchG4@`iUhJ@Zpn5TJRbK`?!+_&10i?-l8ckLiA5T^Z-@81SLpZWI=LEOh zRWx%QNHbT)$1_*0VB95uTJsg`e7D9s9)1Lks497PKLc!iahk2b6iBB~dA^P1KUKsOy!w?kMjFVwhz&r;zWO79n4jsl|T`;QqakP5}l* zusV&UD}=j24+)pn_@!{41~3VCFbVfc$Y<&_^i4SL08#WM;W8SRA<0&&=Lr5B;8Bf` z=$isQD-2J803o65NZtM9vygah0z`Y_Ie$DvXm`m!+SPZ$)8`yawnBrn}X)#SP?k@a33syDI| zUM;W@;CR^sF^5xJe2KQ4Tt+!s1>M(NV3~C923K!(-;(#qrq}XpM7D&@y>r@I9@nR)rSnnIW+#a z7>=E6W_U4rFRKh$x$ia{kA{o=l8cdg8-{~z%_WB8&QK9y2Gad=xMX{#;2ZAeYzoEz zs6Acp9zy5uXW)V8y5JeQ?s&KcDo6UhJoBRKzR+B3Lm2UQ>HJ^VK(J)KOXusupwT)X zsX|was=r(3M+t1-sq@KUxJz~ZRkkOW=)4hn3GaNM(J~nx!o=lR8p8$v1VFHIjCEV` z_z*!DA#~k6gx839{FgJPpB)M5c|H_YOhNwSA3(}`(LEdi94b_R0i4V!-YOVzO2dUx zA_{$mW$Ai{yXsE5>!uxQBl56nYRu5)@Xh{D2ytL zbF38Twt_g1lLP#MDM#%Ff~UcrNT$J`NrqG9B-cug9yf*SISKd(l3#s4MDjt-;dpy} zu?<%CIlLf&BT7P}yBJu$U~|A~O!*NcFA1Y+;2eWwtUd6{hQ-^`P4p&aB_f$IIBTA$2@jMZ%%NexZ*wrq2+K3|YP3VoH-67q+I85knnV!7QW zF^nj@g~J)z1A$;asjhZX%t1-FRwQRMLf<;WiAJO=aSNuOia!;!XMXJNLND`e##>_` z>_CPAYx6R4@5w&}m&fsNElOhEvuYKE3FEMqhaHUP?e3cpRBvwj#M+SrlC&KX<`6Ah zT_NG09^xjEPXDtk%7!g~RcK;yZ>3VRhf0!Au&wA67a~7-hA5Z7Gv~m)@Y}giU^G?# zLt09_LH2}efrIw~6cU0^#l4~sV9`Y&fDeT*z$x{d-Q86TgRQiu>LPv2d zB)Q&8!WAwwMb2m|6ucDojhKv}f4YXk=O^dMa8Ua}cQ@aR7BBvgxaQ6{8r;G3j>HE! zICqhQGeedq7ZTbi+$p(OpqKqCq{J2!LQrC40L#2^iP$fdE>UI}>YpssOjPnNwGn)o z5!8g&!NGH5UNntnKhQVeqP}Pj7o^_iQ*J`RU*Sp8G>!biD=5;6VlYi)>GVh0FtG+# z@f(V2Tmbj%17d+uz|!PEf9hkVpAK8|{Zo7#HCXKlRU0`~4fQ5maoa`Id))$glP(b*RIKCu+VzYQ8Dl4#Er!qh0{3 z^(J|pRF|F|E>E*iswDN2rtT+zs3qK7Lts&xrf6j2!|jUwJFL@JQhU&onD0?-5Xie9 zg&Osm5Jznr?u9TA8V(%EhBLYlHkpMcq3lbF9_;R*1}%=dXHgY~)EnUX!&Fh%()NVr z8v}^xDFQ$FnU7<}2UnJ(`48h6bJ@H|f8sdzes1`M$R?A!M=(T~s2hZFO^(2og=cJV zbI%7!?m3Yde;&rz8$cr9xD`*zHi`02-068RISctQd1PX+3Qb_BbZQvK0YIS1_u_+^ zd;&H3xR5879tL~?5Q2Pad|B1Fa8*AxssgqL@f=C>VeacJg?mD1cm^TyTnG=$cr!PX@n zwndyQ^MorUB=|qE?O};g?5WZcUYPdkKM7}2RId$-u5d0bIl;2QB1G!PBVm_#AM$jvADtUkSeP}9~9P&=&mSVC1C$tqQ+N?gOb2^$` z3r^?Q`nv{Vi)At`3?k%+-J?@sSf^^cQN6wsi|c-Jd^rw?{oruO_ZX1x>T#&k|1wFy zR@t$Tu)Nqo=8EM4Wpk3AhuE(F(GZUQm?9@nFhAts^pPmYX++4( zrw2s{lh!PA;Ibs6s1vk;-rcZQsFx`24kQ@-2`H6N^(1d4*+8|2cOkq?F}|=5m%{75 zSo4I56pNlKlEt3uU!hSEbD0K`WldNzKuul@xim>L77oPz)|8qcH5PWeX44u1n2X;2 zN^1zcXbqv8TtLXqvYha^Q+N#_(3e&YQfTF%tLo!rgY0qPY&A$_gH*QpLep{VS5P%7 z50~8TSI;Fn*3kBrVA{{iet^h4l69n_EJRAYNl~hi9z}W&=^RpD>@vwlnukPny04lJ zJ886xXqWsHeK~^Z;1{Q!EdKXlFavSCJ4q5YDGwV?+Yt6=K%pP2i- zrPkJ!^;ycZ&Z5Q+&)tYv;qh5TrsHKu6-e`t79!n?bM~?T6g+xk-Z5h4EuMUNIZ%_n;;mMC2gEKy>`?R*EUxSdbr)5J5dTfJUI z7gT7U8*f;}!YfMA>4gypYaEc}#a?>ro1p=%2k)iV_L~ZaO`9%`o6_k~aWI(|ztu*E zdg#Q{=>N2%(Ak_tgX-$$EN2k^nzNGecNHDjnfjCy8ER|L-HRutg^u6NpuLJt9lzj)&7oNAAz}z^;u6@7*lno((6zE_61>N_Kq%b~UqZq*2lnCEBV*Ytad7Krb z@(+Did3DF*p|M3-KT6q|ysd*STq6-as5`gD)n>u^4kh3%-DKz4*Wd|-yrDrIO=$k z@NdvJTm*&(8H0Vo^6Porv97wtOFfP36qfEbal;+F`~mZ`GDODLiDAfz;F zBo@XJ3pe9LYmOa0>RivPL!K2MF);_ZuJ^S3gRmCwA*S^a@p4E%_zhQeGfemJQBut4O|BIAdkCIa{U@{-Dq(A8gV@U&}|nj z)g5nzG*;@`b|MACBRg+2=E4&)h8siYcrNfF3()F#WFsC(e#x099JTMzmts32bXZ4( zvRsL^U;0c(bSx*?gMLYkV)N7XE@%OwdLx8xa_$Mv{S3!1Ao9;3a;csb7g*%WAo78r zFR(}|wa%qlxYQvCIll$cK4h@1>(`2Mqfw4_F9&Xv<|U+M1dNrs2DOpTxau4nZH5g z--70x9T+JyZCL?(QK!1zFKnRzE=D(kx{8~PVDc0Bq84zwp0S)ToAQDY|#SDYV> zj#(*6l13RCu$MF-#Z&wiX~15CrME}}MgclP19;May;9upa5WG}zKpm$VyW9B~@%tqI&<1xV54)VOivaJ{v)xxEN770M zj7S~X5!^Z9S6r8&?&lNJ5aSd~K3!hmDX0dE~EVsVs#KziG8*b@9Bhe{NI_EChijP5pLA29XzMS(IZBC&V(fD^l z%qK_i49Jc-29483UpmbP0#cAC_o2mWg`-S3&Ds8Z(f;l8MZ2>8YGuP+~Stp9He-_osm$;_oj4Bk=dJz)<}CO&}eA*9QjT?-PMO`1@NNFUmQ;F5tx9M+1rY z`zzdXkaPam+<5VhIy%onqxDO5|$gIBs06w9VO(&Faysr2>o#Eu; zbvToZ^K)XE=;bVNBu{%&99E`d%KnE?m@YgrdWBct@s{ir7XN%?8Wq-sD=ccaLZ8wY zstAW-adr(6N~b*K$ETxlRIwkRs5*=}Y<#ANE4zqBlF?7#Cu{dZ&UDm%LSHR@TDI`- z#~+f$bdtt2M9jj3Cxvm*NVm;O#jw}+Zy`zj8gG1xh1L>rgtZ+>1!hFcV#{up1r17f zZ?g$}%LP7qhXZ8^ge)P9EK&;eY#gOsw-(L=xdNx)O`hP$GF$@Dqq<;D7crO_N31os zO-sRb1Gtr2}}Q)nA#S8;j~);pXnr0LTi{Hw5=v}cd6Ou8pzD|y_- z^$97$RHld_%$FT88uh(kdhsX$_Kw`zr?G7{`rBbgFzZ5WHJ3c1=+5#8J1FRaR~7u&e^N!feh{6z2qyKEU%~ zBpvBXq|->>AX$;0g!C%)p1^gl((ELV{wfVxfdQ|=-s7y!t2X-R`f3OIu)i8lA91fH z-~;oW6&O0~HOG|B_(lOm%%Lz%vn73v$mXhqEi`HdI+N1i8F;XIs-P-f<(83LTG-vI zzS$GozG*U%v==J_;B>)fqAx;>T_A-Vg!9PbNqSe$MQoG?w#c&}Sl6cIS5RAWFcBT*L-jvRJax1NuAIw;!sME0g;{*3W65| z*x=2LfLPuIqL~;}50A#X8oW>}xcmap*8c#yVXTENMMAlTv2jQP5bgomv8MWo=B7io zq$UgHSU8ueHd(e)vw$+1F`m^JhV&`Y7f2_OP9vQ|x`-I887Uqq5vdbW7o_e;MI~v+A1p}|Mre|2xT>37 zBmAUUaVrtpz}Kq2d9HzZt{$r1!8MzwaLu`S&^cu+ZydzUEs#}UC4a^RmbMWUZdTb| zkNq^&h@PEwxh)d>RxLLLlN^VZ>-6NNXj7cHz{Z2Wz%)Y3P3NpBPS2Ed0H}>tPp*^N z)uc9AEbpMZ`t((pveOM1;N$a_sU(98EOQFx4Rh@u;9a;=%Ij)(q0Z9#o#yGK3e zaIDerz5XZvp3H&wxO}6}z&@BQCj2o~<6SqTYmi1GX*+RW&EPk+5}T(_Ju%T}2~4~6 zWnAFqHhmWY*jt|%5`a_Nt4)D{)}{c_qY_aEy!7dRz>FNUt|;=yRd!?|>7( zi*Oa84cCOw4t*s%FdszN(OgNW#!j!01wj{@(3F-B0+TUs)Fx1v-yT^GL}&%+7>c^$ zf+So}6;)jIS^~+qJW2J&1?+<0M=?ETg4f(ijXXJxE{(v+AB$*yJMPZ;j>nw&7-v+lB86|XG!hnKR~90+ zS7A)PpeHgJn3H9G;81sC!BM)F0Cg$RFBE1XMInl1$Ng{crG;#Q2U7o$kg z|9%-#_8>!^;Q=WS)g#0yy7hU8MiwL~+RaJgE(zyu-8Ak@}RM~E|aL477!aFtinVO!Ep3pOf! zCa5RxJm<5fLuSN&EIYO4sbM+lzXL8q5kPM7XSlbCNFU>5A}!mQObS)q*A{XtKmiv9 z;YEMF0C21t;aX6d=0LzJ6$gv<2KxguCc0_n`zr=QUPMV@L^I}`&~F1lfI)O5{}3=` z9*h7aUqmnr!0W<*2znmG{YQ>kDBsV%#COyWTUgke#(V@F83& z#bhyCP55KFy+~0O;e9jG&yhOedql0I8m(FuF00eV*tFzzph3mKMV`hQU_=Lw{$Zc6 zz|6VW9ve;`|#xAxaRTgwhQ%p|=w)^|_?CP}QWJwCG)Bx4aDn zrZxmro)t$<`zpuB!E?ZL=s2c7$1(lEvW)3Cra#9q{SjuOFy{isI7B&<9~C6V1!fTf zx~k3b@-%b(7!#h!nSyI;X(H#AJcM&DcRzy-)Cf+N;PRUbgWsm$s=Z#&Zh->;RM5~J zSf7L?510e6r7aDv1_ZrZu)F@pw?WLo{1&q4#hCFpYJUkfaZBR_gur16dliz&j8J1} zL*6b{8>0_)Vl|m6EHbjMMm8iAgi`sxB$?%Wgi#NOXx~e?KL9egGYV06?v28p<2;~# z2-z9CxG#9}Kk`2<2)k8_-%9%r3c|J=urC1?^9GDI>zmZWxWM9&pucbXnqMbs#%-4c zA#|Z04s;c5(S3x48;B!}E~S^!8pM5oOoBFC-r9>E`M!)hhPX-$73 z!-hym8kERmp-n%n9$cdcS74G&UxSkX9$Zj8eXa*L6qnAWNtq0Bl6&6@pR83YovZx- z2o?d`bil)Z%eLwN{3D*a(hW1_z)hYJX$^lO!EEaxYJHvX!ebMW3V2~ZdVwdP4lQ57 zRk!58;kwowWm|Uv{|MnNwCigK>kKDi6hDFEH-7Hzcd&Z{4_D5A9JRMVbI8inoNYu| z$Af3^_jFULyPJBrf5wOPcbIU4m3m}!(r%7GS55oI3aGFJCZ>R}iiVFsqBgo}2GEGqF((GVUh;|Yv| zrZ*k#7cQ6*Sx{mT1tk_L7{U_ASm4ht>!95>#PM>UB+Mw@*S>1P-K@t}IbNozjnZ@^ z!Sb==l|HlRi`M6#h!`lA_X9~JL|H21eZtXEJ)i2fZAnEwEdhN!rS4;6ImnoirUP#2 zAjivH)K6&ANn%g});wI5cG^4Ib%tylwi8fkuey`4@P2`V#Z$G6jG&f1f=&Z9qYTEj zzPJXM&A_zEc#O={8=+tw5zfk!~Rjy-)x23j$$)ez<8_;E(`fyz}Xc zu+|gE*Cx$`>)hQ?vf;-`$!6+T{}(ccX= z$*cDeEaigd=~~GpVnM|EbJVJ9xv2$)gG>fgaO>4qV|59>eiP0ifwVXDJdh?h^Xj9B zUOlit%N1w~NZL5uLGsq0kZ5OuSt%y3PUjx9l9{?0SOOzFeQ?>Xl#^Hg0#!uy>*oQ4 z!X33v;cgudT5b@uH0!TD4{UG9e$4wvaGfz^bxISm($2X@Yq&Q)QYx$qUfo309W>fx zG}q*)?Fq)YHcyHt-cMqPEGh-+`;6PuLpKQL_R#{8Yt|LP`UZl)Y|%h}2y}vxZe*Hp z>n+}+ppFQY_3FPQc(lc%8_^a+wDS>7v68ZMfeLH70#yfr zD&0eE@D{fILmyy$r=hsI!!GZ|<#++QWIv3o@hm^hE8I#7L+bfhIn#bD!%cSshQf|> z8<8b|q=;7r0M@DnYJ8iJB@Dk;*HLFgM|uVob4OzJ;EqI;T`wqW*0(-KGXYXbAybp+ zGCYcS_2;lTHmZwVmgZkJM$o+CvNXT>X?rw}h^F}~(A1V@K_mM=+^2hjW$+OX0`XCf zGg535K7H08*pTrJhp&H|6rMW3vn4v7qLobMHkf8CEIq{~ zBU*@^8rec0`3-JgifEx+5F61#mUg%WOY3k}fm!MSmI6iX(>>^0>Gtmr(>-M}Q!HIf zukOb>kZf6wU!@o^Pe<)TLbMJd09&wxh6cm>3F7_>rQ6XO*(mpNz2sX)$OXbvw)GLH z3j|@T)~oS~ar5?p-|MJ!zdq<0TG8=dzKTx3K!aPvIhz5k^x>~QhG&p($e^+#R{DBEEr9Cwf3Wc6Zh6vXygUe{h=flJ!(SZ* z-&Y{nNE+WBpKS(?6tg6SkkkB|L~lcn*#KtV>~waC1+mX zk=6}%Upl|M6pyZ!0&>Z%LCKF_h~^{}S$zc2rSD-_Bt-z&c%n0;UZ$w-Som7I>Lr`9 zC$L0{s=rW8saxmYjn0i1x&1}0{}j2HrwDU5TGT7cz8)&ehK5zPuPC^IvqT|DtZcbw zU!^IQ!F?mR2Y2uP6CV_2z3X?;xkkvDMYg%&K||@ z=li(qW%%9GCO2M4L(1w!kqZ^RL>iBAmaq)wsHS^-8&?<_Ps~x{$(?N~j23^^T5avsSo5fk}33sd@_A(XP+Ef_bnxF19Sh=LaJ)9*f zv_!S$J6pI=s5LE7t@#Uq@-pPyfB6dU6cuu7$_iy`-h~Rot@$I&0)&+pqdAsR`xzZ= zCA?9gnL_U)%uH}kxMLmv0GiNhsDN~!WZQrJN;G%TzRy-*iL9W%kc>1HziyKoE$kH{ zH)Q=sM`=}Qs4NGD*kh1pW*lcRM|=&Ys8d?jUt>fDC+vq{Dl!>M!vZgRjaPu1u;|EH zM@P5~hp=FW-q8QGp3Abxr4*#dKYuy0T!JWw5cg)h>;yb{)KD=^Wz+pCU$+U%-DActtZO2#KVk4%FODpeKpU z#Tz-K%H~ZLWQ7`GRk#t9^&OPs!?76oUddI$Gq?xXKKMJ=71C!}mo$g3iQFi2C`Y8H zI7_rzm<%c3C;!4C=n5Ju<;X!>4^ZDjoU@fmjN!t$@LhzUWswhG zifl*LSjj|BIgXQ6!LI_yVp1?`5$1=+GD7QCY9@oZdO~OwIku>rC0te5bCLs^#CRhx z8gsdRMDPK<$FG_E)%)>5Lv8}Tqf)8rOe=9u^59X{5Rq5E7V^RCT%+XQe-$nn6#UDQ z8OHc*umXezE3f~VN`(ow31Lfu>vp3K+?qv#oXVz`X3VH{Es7bO6cGgn^nBEhoR|NB z58~uz`ktRoK~M5!4W=$ek@h&X9ywC&ke2qXq<#7(qra52&o_rj+e*Y7&^P}QA6~t; zLE7)|{qjt&17?G_`vih}QNRc#a{S>ltsh!K3d0Nk66iX#(bU->#NbSdRVw5}%E7M- zl0%?~sDjKH#%02mNGkcga0xK$f>f{j8mwH@uG7XNrZ6AqnFcZmEqRC={HWwg20Z|H-l0$L+~L%X$)lqtawcKwAHQRf@_m+#_Z zuLdaH^*E+=1={oxbZu}R6(KxR$%=9jK)>_hw_uzpFs=_{90-hH@7*u)@fdAEprwc# zQM;ix(SB=hATV-DnG>Gq%tWPHt7m4Kt>J|&Kw?<(9jFNG*~QceaT|Rl>ciY298tD& zL^)C`;)I0cys%*>3oc}k>5Oep8+V2(krfwZbiRV-L}HT~AhC^ZgAG5cV_-{*!X}5- zr%4aJ`htDj{&YT>;6+GVdR|srKF7SqKpCMeL&;Cz7*wRL zJPt~rD^4TKRs?z=#!!qB_uzP>w;=jfw4PM>q6HJ7Clf_hw4UsOYF=JXdbGh7p(hvK z;DQpH)RPCON8!)~%@kS}kAthqLf-u|=ml+HF{BVZK)#2G$A3#>EC)$qKw@YN4NxJC zX#g6q5^_N>Xd-)CD*k|`LP2jRS9WNrF*hJrs>YA^NUFPmYEm`v9jal)3t0iF6`ynO zCuZmW-oai4TSKot7&9kzM{>w1!xkrF;OqyCL!OA1d7@BW**AX=RFN%W3HQxML{@YQ zc0#9&gnxkGWy}EZpnI9lzde#INoH}IA_@c?r3p`pQX!kq zaV=r<>qJ&`@3TfDth_Evb8&kFya&yWZ2!_Q{1xrNZ-|EHU-b{ zy(kGtIT!1Sc@Y$&ty=W?O*A>t-QrgQeMlG)-C~u;O}9AJ*j5POz8VO_+;;<;vRlw?8!3iV`m*cIGeHc>n*B7Gxg z{!x4fg0@7^0wY9Dy2#-&GN+dymJ~6v z;b*`eQNy!0u-Wm^tW7->Cf`$M?&(|3g3^+n=OobPo*+4G=F$ z+#pQ0|Gg18*kBh?W;${V6@b}-mrj}yI-M~#S(}Cv-q@>T%Y4(JE<#Z(T4ZjoO58#U z%s&%@?GQc3)SPd`ckv4|^y^^V)Fb_|*|sw_KVb7g(g$PwN0EJff(?Lq$V)aK$0x!R;UQ&a9eq zLLQ$JGuu<$$&QzYsh{*$k8y$hS^oDp1KV9F40ub^Cn-(GxvIK9GwaBv8 zz!;;Lsp*q`O~+CqiU|~=m_R|r3=~$0A};e?SC)3N?)3fm!Nyfh7ZV&W(~cdb=~#kx zuIBhETo`eG+^y=K)#EK^9IuRUQ=T^B-@MCZf93~#oG3|X+k-#(hP5&35a&+X=!AQK z_@@`e2F{Umo98Lo8hHZS^00;ET0S$Q6Ka}|iEsO8ew>3%)u)>LHrhCNqNd_hkZPY~ z9phf0S?CfT+HOWB0#~mH$Ar$wV){4ycbI>VAsF+eFdW-z);ki6fk5ku^6R@O$2*i< zb^MBw^y5QHu6%BFQDZmdNd+^72Y~j>2XbAwS^wfG?AFbu4W8KdNH>~d&)@~kvk?zq zr!Thd#NXVAFE~Q74?lT~%{;s6>Gx?AQ~qZ`oZmeKHdC>I80YtU)`Q2r^_>#m(I(l} z7A4uWLfhJLU7dl>*alYLeQl8iztwB=jk7qFU^Y&Ljl9?KG{U`&G5B z6CHI9dSJoy4hshI5~qrr^&3HVV5|^J8we?sWP(T~2;B7)je|{TvwrePn7l&kM7Ic_ z;$}_a--BNd&bH+_Y7_AdAGLT#=Re~7OYuT0q_bk!wu7G?E&x^v?9hpa=56F@>gpCW z^$J}Kv3&D{gwZB}d1n&sZw43o9*nl0oI`SbSJ#u)(#+FQOVL+s+SEGJ&no91!U^-@ z7LVC~0l4R&>N%*pzvGoRu?>nH+b|7Ni3Z)u)nfxAw(lR5HP68hAiA; z@?_g`gV=GK{~4l;k35L(srfKmhz-`XcMLm)HiZv`Ab>`F6XBoJ7Lz-^0l)r@AB?2U zg!pA|&Pc{q=*ek)GCt2Z&EHdTR3nXKgHIZE72e;2ndm7BG~u)8pTS^#*X+~Vu_2ny z=3*3t+ZW*^HtSDevPDNbjP5f)ilA*grdi*E(H7Jt3naojlwo|HB{%Cgz03n`$g`A@ z^;Dv)S?|rcJU5pcy`@g~D|{4!3q+-!7eRm)$DItUVDF|U6& z>u=#bc0`R7ZH2QaS~FxdO5X^N6;x-5HXD~VQop;7BPQLj`)QPDwaIB&XttuXQ64j- zX6(kqPsTUv@57OUivhOvJ8MI31j$;s5zYGI^{__c(o*T2>P{#zbm!AV0f+H|xd=co=6XvlezoSai;!ngS|99@wAFp?sI5dPoIdW4#z>|8!0l*g zCrpUYvg1Uwv`-ptwD3|yO#eIlSTt>((X`|AH7Yl4N3pfBC@qioHlB7(Mg#T{!A9-? zG=3WG_b1G&Ky4bmtNYw#!*e>#qNK-2Tp6IX01YIA)IPBPI0h94CRUyRq~=OXpW@Ck z`VihI03Tr>$OZyfBi4IY+7NK^wt@=Ow}+KfS_n`dKvmp^xxLmDJ3<#7wSB>dL(nv0Df$?;%kd_Ut$#WS4S zV|u*+Cj+CSwy#i?((gGZ6T7u+4x({hN(rP3ayrXN89!6S+vy*=;x$?M!)*ldi zJf$|)C)H=0P?LHL`=afj3tnHwzNSO*^@V0s4CnMj(n&fAL_ZgG#z)%W&IFOiEcN(R zFcd^_+EBd@ZXb#eV_!8LvZEk4ppI!_1c&h&XIKK0QRbMb-U4n9jmDw6rb8(NdJO9{ zNhj(j;dC%}U<>hn7`y{YQe%yvCN5wl8KZqhsI8V2(?w^+?*@^1m>~Mj;D56vErDs| z33RjGx`_=JjSi#G?-E!WaZZPZW7Zwmxw+^|uvH`cjc`RsZSecxQ!a<_If+n43(4(i z)~^Hx)G$nIR!^Gr`(EX~DMqXj{z_o2R1DIH5cXTtlT`981e0iBVGSGMzXh;@F*sL0 z#Zd77kD~oQts$9TxNP$H56baA|y#QO&UpDd=3{Whxr7d|K z0NNKcB(CEj2WwvcUv=~UZRra$u;%}cZVKauZg87epNRXmZn|@u?53#*Rb0NC3WNy~ zVN^GL2pGcM^dLFE;jZ^42EKN?X&mSq0#_&k_P2l)-PDS+yRNihrfj$#UDb0o$C_2h z!#$`a9!2>P(gCDrFayiOVeO?ziy9Q=xA>$q63^i=$2F9_B3xv`BN3fRdc-9vf^*Yq zarXi3d=BhRybW|>4+wKIN9`1R7t7+!x><7NKLfK}sceBkp*qqH=bt1zcsrX%^a%VU z(m$~o3jH8*S)o~zH!#IVV-OB(^P0rj}FA-K@51i(WwPcFS0z6HnlB6)oqK%)lpByKXi-;=*br^jXa z!kdZ&BrqT30eVO3y8-5bixM$iqH3)TG!P0f2oa#e)RS>~=f6r4AA-3yitM9d3PauC zy*QmrA{Wq#e&jU?eOnZCGhhw45f~ZtR}HvffCJ+=+aB-El<3+a2Zl|-a|)4??ff2yw(MsI5eW&LpF=$-Ho?nat}REe|*sS0T+(vOf2jE&pWhZR(}tOzmiT0Aco+@LSC?M*6Wdv ztjP6>X1xP++K>TFOm_VlIwB?}Q|@DR8KR!+?V1504^hwdu13pk>5V$@{Sv*$Yond} z5w#FUyXv6oy$!h28`(=9LMTbg$ie_~ctTx?wO@TNpu&{%cIsyRR_Je7o1X&Rtj&+X zK@oXdtW=QO(IB@YliLxvzk^&A6?_Z19Sw4401lIu zA%wDha;a%H z-%jRfm%e_foN~!CQj=-_ftc$JJ;lt^4G*NTJzm6D(pZ}gN)>fS0WW~#a)+87w_OMZ zDO7m^ce-Ox$q8!x)YhfiS;v~RVVHZaUH~r~6VfB(jQ31Ydi3bty<4~Bs)M1y5cIH-2Q#SPl!(tw)Q?0;=&yS1l8)GjyT$fcBv zSefz6+AE?m`BZy8f^0kqCkXvUu00%4s|wZLHll{wZ$a&zSvzWc52GmVfi?C|-TNnE z;WZhS+o4|@LeeP1a<5TXuF+%m%-Vue8J?V%&};L9a2(KWNm%kEN;)IjBoS@VTdECN zyd)8AB1A7CPSot*bS=6t1nSer?1Eym~3u{Uq1@8(DXU z=(>k--H*$&W_OQ%0y~&9oiulEbY(VW61+3Uov>U*)4R z^cCpE5koO+;y{a6PpT)LmG!ff76liuSdnZ<-|_36Ekgh^3~2b#mlCJ}x`i^>P>)9;DDAP0 zXb0LY`4`b1?Fej)hjkb0=%U|5pA|^JnuyGq+Xx&&)?}GM(VgT?aQndpz$;+^Ynrk! zO~TI{h1*5{XsuC6$oLrM;~830@#^MC?&=mZGa1*gy}Jx)3#eeTzY~Da2oS*&Zy1%d z$H~nC{9jkorJ#rC7OUbQ?yz!OU$o*DR?FJ_!}SSkb3VaOe@r*6Ek4pve8`v6f`tv6 z{H=wAfi8iF6!p9(DLu?%dw`9)1%{Us&g=Uw~KG=3OyFUYkH2Wp&T>3W6 zetb>1Ho5yo*0vvGyQl6h?h}=lk=89wgf}it zY3;g1k1*FV_PNNH*r|+u1e6NwR8nFmAi_?s*!VqrmBGjl&`@B6mPU@+<&1qRRly;(JK$OpHSBqJu`aq*yi6*g;{_S=Qh|;X&8m? z2E3U&m;Mb6lyxHsP}EIj^o&s5R7BQIKvXxq0-Ij_MeKs{CWQI(J;n|SMQNmp}gx(0c2vGm^d_yJ#E9oL2qKjUAn@oPoYZXFT zf_vjkOY0wjtXS8VR5HP|uZny*vB=@oYgA-=_3h96AJ*OlKFZ>1{NG%FK%yHoYSaKx zS4Bak#a0xoUfDo(&r50P{M=k1Zr8Nj~v&!aS)mG?hThmfsP~O(J^@7)WNeBtx zrA2F7ywswCoo%S{wuk`{e&2Iup1p*{xBm+to+r=F<;0NI@Ubx37$&m$;{bUZ?I{2bXIQP#nh~e^<>YYm6YO|U?E?LblEd!j)N-#SArWad7b z)h)_%d!$d5PS{co>KUqiqKw~W-dd??sYF>`lvL)#>wI36M2;6Fk?^7f#q<5Pzxr8$ zT|$^O=-J*_#BWomunQ&1!j@F#nFT&ay0V+OLrW14sw+kEn&+sAEW@}9bA^`>0InoSC?!b{tn(d-A2))e zu@RPwGREo5uJF)*q)FqnEk~MPF9TAG0bV9)cJe!eCyg975|8bWRJM&IgEwG#oSyZNua_a6iTKYEPUFnj` z-1|)_{bd1=khk={tFRP!34!FT))eduK3$yjG*VaqP zcD9h#j9fodKMTj1|41o#M5jHSaDVx4Kh$8WVZ~dv2+nBzt2goC-@=ewBMDj$IWh2a zzy6Zg{QO$Khe#I3Af#0Wksuif{58A6js70)jZ4!Nvty>poC2+tXj$==X9XgwcM?zW z;qOelMzPr-A(jawl_^i5A!!{Nl1TVeg0!Rl=;y@w9rfh-{Fpj|xmhqKOAO$&qwwvg zs|1^efnrHw#l}PY&g9OCBDiAfC6z@?GMHtQ5|6Fr(@V(Pa;N0=R%@u`4gJ*2!W$Z` znS?vnkXV%jQPA7ttMB8tW6_2Elu6AiI!fP5gezO}m;x<(6`x*0-ol%|pr&3zKzOS) z#+I+2F##auYjjM)q*zYG$dfMr$T1Ff7TW4=m?TT z@>*@+KW#9_c1|y3h9&7%3k(i_N=PcNMZ)4ID?WQSC_dMK4<(C^FP4smx|@@yo|2P{H!nFF8Ru$D+C0H%BdXia?iXC_ z2x8auWLNbpvN1CNiOi}F<9Cm$&Qd@_iEvewJjT0Pzz^orOUT*`l*=(J&o2(3@Fw*_&1TLY3ty2;o^*;#0|)9hs2Y23c_U+ zk~x%=^4l`B658}qgi9oqm2Hy2jJ!$^F5=Tm$lD?;dC^7XZ4uVbm}C}&HCi*J2jW9% z>lM@;ji1FIqTT*^$LePh6K^RL&{jDL@adW!xi0ISc0VXhbfn%oNk{2}pQUObP|WhV zQiE#DT$$SyM(rz zOVM+MMO7xZevKcSlh?z`G;vSS_hMM}E2;Ijy&BOZH*Ac&x1;8#NZnB+6}gCBY@pI$=VqIJ#}8JQ3m-fE4p^w3X*BlOT{ z&4||dMJq<7c~w;qmpLWx$980!H{P;Vz}ew<4WB(kLC=}=3!3vj61s+y?B?Su1m3*@ zDIss$a01R-t)UiC{ftRwK~$qPQ`)ppDYlZ9RgzJ3$GiFPo3i5`DPyIC*v=rS%q?2- z3dxX=w=G%nd8;+lmaLzeSxVOEn1tzk=B*!++Mmx{H9OtD*@lNjiv_nP0c|Dcaz6hT za^0a^KuXBlA}!!hujOr#*3Xz^7Nj*=GpTwl$t)U+`Rsv4mRX`i zaacquheMc8bGhQMK)@vA4Gz^_LSUhH%iH3hpE1cSIB0ZC!s7W|C(_sMLyBZb?lWZx zLAz=G0e^hSeM~(+HYa~uD!YNY;m3gQbK*Lgt znfuPYq>9avRF=&ogDImD$Pqr#*LiD;#U!u&?d$Inuv#*!{w}{-Bstor92Czy2T7Dj z$a`~a5pVg&6p1f6jd1vDftG%OzxA#UJ$SZmt`gPYH??}#y!ZR)fq}tQ8>8>#nQ?gX zlD7t-qOL-Y zNwcJuvzm*y3~y!8b@TWFqKaQE<`($9NpXOXwJ>rSo2X~)ZJx%CNm*S@(sz$*9?yd7 za!LK_@U5)cZk|?9yiJ#0_l7^l7Z$%Naof06q-$n6yDS%%?B$w$U@H4@>Fn&&@v{ry z-p$i`k*RoF@v8!>4=%rx_(*Y^WiT*h=bgQii)j??X>D3!Q>o>b>wMO@AlJmPSl~y( zFH4ohZ0zdiO&tmg1fM9(lM5r| zdX_!IA%g6Nn#kQ5XKV?^{+pz9jg>Rql%genRElna zqV+>*gWwY-{igei5l8D4&i%k_0c}z`(jj zuygUUD$&W0PN% zF~*8asNs(>L;W#kpo*mEyMq`-9d;ed$LoA#4??*+O(D#Yk{tnl2vfEM18e_F01>Vw|E*59n;{qMKg2Y$>qMt1X2@nC2j*gcm z`$&%e|KupU+7Y$v1RsuWk~uQ5Rx`8LGR$O;Oa~f3u4S*_EF;q%KCpd>eFmlM-5=1{+1b`4E9SuSDfhgt&qEfB3 zgCA)T;u_^SF=)l!Cd%O;SypgM zu5Em}f(4m9uIS6P=$DCfMN1a5M2p@cxfAlXgNcCfR%@uOx_-7uW~q8Q+8<0#5vQgq zslURM1%sDh<3tf&eT6`BoDytm(e_lof6sl*?dBH=p@L*^0y4D zLrqf8hxl~0mn3GxLrCUu^&aJMu)@%867HPiOlZR(26L-Ho%ZOJGg zuzASal2Jc3vyf4vH4|j)H0!WXQy|T6*SusOtTY+Nft_izo8cfUYkG!^XX^J@R<)^o zs@fOMQ-Hn)R_4HBGEdEcyKe^RmQ|paX?MJv-=KjeZ0(NYuyJ8(kyOsq!l!AV=y+@e zpO{*BYlUNy*Zy{MU`?=EG9v^M8r>pc@ss0^H%a1{zDwh)mupu2b;E^IgE85%10}?p zXA^0U@oFowPa%y-K65@b0cUDz`<1qpjk*Jc1)nCVEH@;yh%uR0(Ab2%uNHI^Tva2V zC^?eLbXGGQ-{`H@e3N9|ab&)y$lHUuw5)Lz_Ffm8|M*myezu96*WDQua=(B*gkmq}@3qEDLcu4#pV#)cqUOu%&V6y1jM|-!ebT%ID@g1IXty@(onF>sy?{VD}+-LqmR(>;1EK zNPhVaS}=7#jvN`=8}hJxFzC$+$T22ULPc@52?TshwBnhVyk=Ga!@qV$_pmHN_l2Hv z{1a-$L9P$3Ifxh?$o0=CjqepTkI66IR=~MCVyT(6*RP`z6VWuTRB!e3S1p@ubD-|5 z62#yPpU9C3@wq0xbf;gVsY28?E|_pb?Z;w)$~d9r3uCoXY~|>AI*Wh&YOqPJK?Kp@ z6MdumuMfulD5B2w5wVb!j@E&LD;!g|Qns5f32HUm_8OM+8f0)089`m!&5eozl{?}z zvjCY07J(~H0AG+M@ir_h(|(q|e6QWSM(~0SOIYqL+T}BNq-D5U!HmIS*8|M`q*vp3 zWEz`Y;!FLLWH_8oaPyZg{vjq5N^f=vRtbfIO&bON5hutb#a_W&c|htPubh4*kM!Z)jSo?i_d+Su7qC3!Asv};J#hv z(_Ot2x3A%Ey!s)3nMpHrh*z(75Fa+1;n|9>~S3?{;;(*Hn!5xptMSgDEE3zud0lF+R^ zk`zE+EkRnq!SC4ucAMKM0IL9!=_-^%{)}U#kR*E!nxfC|wQKV&-nz)&oO+p}em>p@ zNusx-*){j57ZMcD<1{d=i>{EpW`Gn@eUOX8)2BJf5rB=GDoL)_X}F6jxzE0{`opDY zf#`oo@*)(bXj@rVZ~a>mM=p<>7q5QXtDn!VJX(3`l6cMQ-nfQ%HOA*HGJv!;=Upn> z-DGIe=55@c;Aez$%nmk}u9)@VVYy!QAh)9r;bL=pw<@Md5+hcIAdNXfy1F~Qgv*<_ zv~_QMQU$4-^Hx-UgvLDUqv(N~!~JC5^HFsF_aeO#)uyX}D?%AXfWQ%P-~{k$xqucM z3m4Gl7r&SXTIBf9VR98LBBFcY!7Rx$NL(6`O_twlHhK0K$+*=DHdnX8$Fk;7#QQ?7 zhHW)(d|P^i&-TLF%JyGoKQTs3 zCai@ll!G}b*qt?A{gm0Z?C{}Qj+c4OtA5se#Efv^!6U|`I!Z})lPezCkeHSquR%6# zKr5Z~P)0Ehhld%=xfNOvu71cILN_2yk5V5pSEftdV7@1%x}n#vqz+zG@QpgOw`nNQ zpS%I!h56C8gYvD!vhxmKuG~XWX&Q;hR(-eK{0I;^Dz!|4yLAZ29Df%`FzrL3*hgTc zvl*=zrvr(EF!^*t&Dg>#=aP+^hdxukL~b39Pn{nh*D(AwPI6g2m}K$9P~P->c#VsJ zZ-|_dn^z9txL{03*hTM&VPvY+V!3-B{xe@02_27@gXFxWZ^v()$0g74ar4Dc_c|qe zHQVA-8O+nZ-ab-W)J)SHG?Yc zk}BDbDiS0Zdzd$b;3PoXVYBl@$kSEt{eEFUswd1~)kD?bj1`qTl$P+^MZIP=H6#V=9(R{>G)oATUdy_$`SiM^OcKzV&ChCy-J9EFC&Wb zE+$p0u9Rh1u-!d3QGF(O!tly*snPg`$Qkf3eFP8KR*~AZdAwypFd@JA z)x22;lYcx&-ufjln+!A)Eu?Wv6iiA=%ULHXrGv3M(6n@Ti-^Cm`a>Ncj@Gvxt)-ra zmwqjS6C#6hQ}+&%Ci~Fv@yOjyZr`1fr7N@A(5qf)MlB%uc6iF?r*5ljJBGLzXqkmh zk4IKu+DC0bG4T3n0r8sU8DO2fY@%6fJx2exzI8M{_{%i-V0`>>Q2|60+g*9ORS$u@ znx@WVIa?P^1Mj+SX-EGh6p@o_Z=nQVwHtq~-9*_(A@K zK`F`bdm#H#=(8GH{std<&0cI8Dg{K35GkOex*%+x%z&P)nmi4Rg}x4>lOOvt;2bpuL-?-W2zl3bcrqKgS*_NDB(4R<}prkA0I`^_;Vw8dolTzB51H2MM#>AA|#P{ z{Tg!kx}xfEZp{5Nj)@F$6$#Q>#os2evTWCvGB`9c*yqmg+XUW>O7opBkd~WM7x72A z^C|*Tw5cHKIUAL3bU>r_O)AOM&@%Ni#=P{53ELwRrs$^K!&|M%EYA8RnN)d^B1ph; zkypLB2kk~ggh!yIII!+lA{5r7gu)->G>57}EDa2yB-U^7yN&E#Isg^4wfV&6aY&w` z;%y^e3>Ozf_Kb&T+ABv6KA56R=edHZ{JR`S%_p3wZ?n#WxPt443F1n;&>2OfUJAm<@GlN`i{PL>c1qvpQk}~8X+CNE3eLoB9>g)XWgL)H#>%c+K^&HWnp z$EC=^;jN66$Yw!JYULuEHAB>8px))fTZ2!`$ZsCQ5KA*6mT}m+o9l`=q`$};Cx*obR@D!) zvxh$~_9jSz;1g4dSic8VN=I&UeX=gIc9Alw5{&M@Dco0DBHA5}SUG`{fC<)J98m(P+8 zg?~%<*h_B%Ubv4^H*ygP%e<+DLtgc!7I|eqfcNAaYU_WP6pD7=BG_u8PV;0KZWR`~ zyi%ExV|JRSga$}Wqyh9Z9O+L<@UC)JxKNLuhGd}%rxI$2rSGlZh=)TXgiz3U6p%-t zl#Av>Ekl8=9hO`PfjMX+%9BLAE)A1msY^u1Oew1utydlrO zs&v@m#AaJeFeXzJfB4T-OFGPEKP@B;ho?fEu>c>-aKu5<8T80fImU+Om>cmu08%Yk zRv|~0beP{WoI=?PljA57q+g2ezr}Se;ep`FoxHR2StnM9S!J^#R;+T|oncw)Fatr< zj@cdN?{^$MDz8 zSq{;z%l&xzpHn=gmjnA(xF3krd)0*B$5d+m(X^C!)H=+2r~^`2J~uOWQ9Op4Dd5pH ziHsSv@$2}o&2f}EUP6Juy2Xbz*aU2y9P=DY9YXluih;LmkBAH>zM6P&8b+EB z(z?=bgOlW=albUe(qiaUNP=PUT9FIVM#0z{*xWU|wvq+n2|1~dINQO3u}<4;DME^Y z9ug?QOdOX1oHNDhFG*`=}j_mY`J4Yi_Eo@kwZkxH?0fPHM_#Rvm|HDswgY@u2?yw z9>S?w55EE-iQY)GUx9G=q_l_;=}UVDn@*!fH9Tmad5*tV&|j<-TVyHeL=U_ z3A!cb=WJrgQH#aq02V60edd{RsfFuWM|7Q=FH;ykeL$wnP8#S#!aAc>-XZF^MFlbs zl_GoEo;%DJfRaIslwG&OoFwpj8gM&IK!PchOhS+fuM-(C#yrg&F?k2&LYM_gm^%KB zsq~IR$}JLNNS}5+w$^J3EeAzya;1(*VAan-ktN1p{O~EV$n@6L6IR$9L6K|mpJb5z z2#RDAo8j+ z+uk0u?J$oJoSbImp%bB5+TyQ4&@YXHLlt3XXYVj!GQ)ODdm{ zY>W~)$g8AZhB3+~Z-WshU+#(=9tn(tM+iwna8fi}a)mI7+#25yS}s3r>oMrB3JFtW z;g!VzVumxZnK?03?Ek`eY%y$7P^KHzJV)1_3o62mjr$t`nMKZ@Bcx$Qr(fSebTIZ5 z@AyN?f2f9xUeVUdcvDEUAxTO|dGn+^HWoNT{6ok@cn8%&fBr{~+Q#RTpW) zU~D6tq(~nzS5Pehaa~G%N@eX)D`Kgjt=3k6g)bc}e3`D*Fkw5+4_;Uz0#C!9v0~tT z89ETEc{o;_O!KDJ*#X7p^j-J?+-=w1)GM;%wo07UULYf^QVvyZmo)js>5lsgO~VaSuD?c?i?&tb zOjsGRTMK;Eii`ns112Y$at+^pQ!1OTtJLtd0%K)J{cv*szV z42Bw=SnAxcu9R7ujd6@v|#PEEDyMnT(DhmdR+ipRH(_3>`Xcydg3m zF`HXPDOIZJ&#h%5=Z~a9XtkZ*4FOfKVG5Zm$ zI#A+@lpBNs^%x(-W&j1Kz7V0-&W@D=*5ll6HfgW2*#37&d0x0`aEr=kJk4gn$K@`a{E>Tk_I z!PsvEN#6t%T)Bpyne8kRCe_ZL4pV_FJtA@Y3f?FaFZ0KCl@9Y5We_Ai#23Pn)_jWs z34fh$v}`G@z0LLzYmUWjr<{QC@y776R+cm#P_z4SKBc7<&_#Ju$PWHI-H(@NzjdXoH;{7r zK{mBx<>CH%d^|P2FSJtM7$82zlU4G`Z!9gB124tjDw`%QkiEe1*J}N`-$W;UT;QP85&=L zKnp7u24)F5vJ6ak*PFx*o`LvMQP~UQ3-B^DpVWBZP7*}=qPpq*fa9A7Nr`{t0%tz3#sg_=I7q5|7lBkV|2f22(SKz_Rd~xuR9hMsp zEC+4h=@OGF^m$5pO4{#HMwR6jLm8ArfR@E;D!h^qr4Ivm8D(8aieYI>(})aK)xnfx zW1XdGiV0VXlGJ0oA%Xe*Y=5wkp8XHzY7};aO{~*QJ5Qx6vq(kVx^M*ZU`+a<-{r-@ zKuF);ju6axO0m&@2SrZlzqzth?v-W^KHo;HY1^P&Xzv_W*5#|Z8^ z>4>Rsr}+sHREO&ngR$R<7=vmi(zhO_c~gYrn=w{*(j*J-W= zifS9e`BL?P{wf2O*vfFB6UR<-Dd}KNb?im=-x}uHLcDrPle1{rkS4auNoTflQs8nb zf&xvk^E$!LZWfSY%wNt`45a}|hiviw%JKD0fBb`FoC8~+0 z)gc=8E`io*woTD~IyiZ-P`V=ZWaC^7GZ~Qgr&zO?c_U&9_De0i-oja1Al`g zIXaa%T~bYrr%|bX8HP7;Vu|h|Fz`@yn(xbSj^ECXPTZtwHk9gYsy`GQYWG1+VIP$E zms~GB3+hqv&*`N?+pUA?rJqtx1`A|Lq(`#ITk3V%9eB!b;(<(cJ@XAr{eDA;0YCH3?iB}YlBoDFe$I{(od;L@`H2iK|KqzRuMG8nu7q!!G z>DI0mB435y%ug@#`-65sS&J;^4hauwd!!hN(|AlX0KwQ6Gsf!_a%js*7PE-hob4+P zrmXh;$#iYsI=_8u&FjbZY~Q-f_Ki#eAqK{!GJCOYJPFw(6Bv;YSu=`VXThMS_@XD% z1W)@DXSLQ&vw9+xVG3WJiansfOWzV*Z%3p>Ae$QPgti|za6NqNbkzGngPP+2a zndzSD82WU-IRsJRid6TULgC2`w!uVDW$jDoH0Me5YNC$-SuGk%^gtxSwe&5$0}sYh zYmGiR!nxy`e$Sb?*i+DnlEUWqf%aatj>`p^cYeF z&8BI}CG&hPxxzeOq9OAk{(R>C-v{g*`L^o&6h7vJ=An+_{FY!8(b?iovL!Bh+A+2( zQB)kqI23l0Eo`x0*a9=1!cZ$u0Ma76`v&g|o3*Bd7GZycAI2#^AcIudq`#|5&iEa+ zdU`k%K2kp)DZYj|p(QBiBur`MQ$h`5i--Om*TqAF&~b|xapf*Hs-zT@d(z6EDJPrPZWd4kJ3|Yc z4&A>P)+}Ebs88w8sIsWg$HuQOrIPU*iV|Z(y=oJ(t|)=%o6gUQTKV$+$l4xY20Wuv zn8N7(!OOlBY&s6Ui?;ohTM~nJd>sw_a450K4vQV(; zQ`WFYljj7R#_%yQn#>R0X7~y=J=B+DSWW;|G`S#LGBMcn>s|yD5GZ3X7upsg2*{!Vq@N|G6KqM8UmF%V^jMxB2~?Kz@Sp)Z~|DV zHe^-WcJmB=4DX{1zNwZaXv2E8;aC$Hp|vU^zcLxhq?9zuY@6isQis`dg*1c?nQ6Vb z-OQp8J9xF5(?koG`jk^2FfW&5TE+_6?IvwbLA!IWJr&ld~!2NwMYUnhYM7!d}>FSZ@4R4OLc9D*Oc4OlAiTOI^DluQ` zMUVV03}EwV^ZQNw=Yd-Hqwr%3;Eq`A&~EP6OqQQyoRu~oliErDwrCX6h%+fy>W@yT z4Oga8)UVxwNF5`_DB6v&WwfJUdiWHWquF6#nt3#N~Df?T!d902c zqg9dkxhfL*9JZ(@ZrN&QE9`P&o3^s_73PF^4y5A_Z=JLW+qtyA0a)mZZ z9e&Jq)AZ-lclv*xqE#AxsjU(^PljMRS?Y9Tp6AKq)AGFVDF1UvddSSrBHNv$_qpXt z3R29c=Q&BF-pOo=%_YOpDRu_lj2sjjteK8RvA{2S7v}vP{rH-(4uLlUTJy_C@khpz zY>_l1G9O-_PZNuN?X!ccmk1>I_#{BV2a9~ppKqj6ge-=maixb(hpxF@_%8#|X%a|{^m=BEOAyRG?V^Hpex81AcQWW>ukAOqbZ zx+&~mGaTKtN%lgpW#vuT5W!9p-n!YOrhDWY!RVSI!0I*Q%Yt{wZnj|4^QgPg{fm}; zHQ4k4^p5Tyuyl~sk57kvgH2Vu`F(Qmw&VCpUIm0`+xx0O=SzCgq`QF>O^ylPHbFw# zx;1bb-^mL!`90D7{eyR$!8ZzfAC9>Ekkbq0xd_Mb8OP>+UL)Nk;xnH*8qt4V;XB&4 zoSVRdcWgnG2lO>$k>JcE^6iJ^D(YLr-$OByW(QBMG!jDac&s@HH6Yh;eMUY+C zMJzVzDiA$2F*&dKcqnfst&qk`o(gu)ltCl*$Cw`-I-~~{?DfQe7dw_X*>pbJ5U+lQ zsYUT%{OZ#9t*CZ(El|xt%dlhYYO`7a^DA*zEIpW^DE48WP?lVm<0uxKuRT0lOC)>~ zqp+3bo6XLtfMSEuBxm$V$u23UigFP1*(-1fA3}IlatzA4oSrZSH(lgxXuw>$h=u;F zTne=OKCt#w)Pl9$ygoRYIl};+(|FG0Ifv&wo-goxiRWUTOL@ldRP#*aso|NSpS@iH zB?OSzkzv3p^_OvObaP>`z&%?`&CN6OnkRG6XA#FgXBIQc7E>d|d`=Z+*<#Le_!by6P5tl29j1-J-xash>|nB)YcfuWVGELRIZXN`p*KLQh>g{I!fkTXE!KT+4 zD?E;ck(ot&1YhyIWUGWZ=GgM0w&{Np1QSori|+sat*JipD;s$?ktxn82Cy6pRL}(cU%3ibuZNqd+=Ei z6KFt5Mv~v`&%)ts!QtPP^n=w2sgizEe^BTt>9=Ka1!v1_GmYXZIf56qnZKYw_>%rJ z4ArE`J`s|3{yIhE67mxzJiwMw)%KkExq7d4kPa2R{Gn;$;ORO>P;DLMf|9dbgJegI z9lt2)6TC0B1=|V=-bfZooKM$f-C6Ydgr0CTdQ~M~lzx&eI-ZoEr3d44U&bZQXo&3d zX1(mqeVIjxzBr6?OwVidM<4f=Y=u|!B3})B*SWtfT+D*0! z9AGxBw5sj>{DPM<9A2avNGh*-leerCYp`nN1@_F$*(wKR_j^$2C53u#bR8>V=78#U zUHM(X*jwRZ*~9r}@V0rM96p@2i4!*ddvuebGLceGOt8%Q)C8-hShQev@nM85!)}^4 zomY{VQA_cZ@XaM%-k_~5QFN=nyrDpGvpFyb(Die!RJy|bpYgq|os9tJ~G`4JK zgmQOl?K{)vZy6C-doqGyBF}Yot*1T^7pv;8(I_6}d4lH|p67Ws@^tdNh^BFlm{L@R z1oHwpXwofCrp=~5ZiXX9k#_SYvHl$J0hvrdgP-j^B%MxLe?dgfU-|3;B2uI$V7CpR zR^|p0AD!eyW-gU;z|IK9{wV_jmo;PoOukL1PulDT9SM3mvHG2zSoJdBzBOk(j?1XW zI|7}0{OMny)^0BIk+n0)qa#~r9uB3D4FzM>7TLq-#Oc~6FCdf=t}GNia9!ji;Qy6) z=~g)Cm_S-5UGCa^yM)?^y8SgPIfK}qJD=Lk z$Hl2?T^BjqXH{CyIa=v;taxiTXJSj#D%|%^H~>wM4scy$AWU7z%JLI^KDkv00)4+r zs;_wcqGSye2#o5>BT|2kJ|=1@I4LPh3U z5Mmr}zk8;)y?(Yg+&h4$cZ1D7-qzHcIYAbY-XkN{NMRl zvARz{xD$zvEW6Om)3PT3pqE!w%DIbGgKJZIqSdH6&1`@urToL1_jvz&Y-yaOll;H6 z)Elg40TedN-9p>kCjSC&yDkm?oO8iC%%R?3S6?pcq@qIO4s#(&GNRu#AMjX`ZP&(r zS(-kF%d*2f1(aO8(P8$<_*!3SuKx$TQOIgDX|G&l`07B!!0QMY*SdxBQc;msEl$eIjp>^Mz;qUv zer|m>kSd!bdK^H15JK9p|4FKKa~Q|$_kyv^g+=uhN~F|&k2`QHv4o?@dLKrGypG1r z(g)1A!3wIxH~AKs07S;nc8nL46U7*pIUl%>H_o0BZg+fmQ_J0k44HW*FBxOslwVax%z96mmOMbeKB@GAwa>7j4pEK0-f*-=K*J z6B6B2nz2$@^mtY(Z*`o`7As3UZ?-JqWO1?g9XYq6f*+NfvdTI~dtA#_JUAB;F+z?2 zB63u7bs+1sm7?ZZf$9~k91K1Y2|!*w*24^;bvPu#^I=uPuy2Kse?vAm?YGpNAv8o|j^yhZ^|0g)d^qhR!59 zvXthcYJR`nPfMp|6F*WOmmvj^SC-NcMqNgOz-ZregKsmdrD-8{>ZctWjG+QbE$}0) zN-->XCqdwb&6W>p&muUthoOl@)fre|2uxwI4#!dBq1y;q+BbTLlNTQ5lMe*zv`Q8- ziT0+GX3^dxBWjis(X`9JJGmWJ51rR)aV-FEE8D@eyWuKAn$HWt;dwUlhklnXey- zmMxgBrwGQ#{`{nbQC&CtL=q7Yxh{7z{S;RY%|wZ{v_h>eR<6rxoD8`-HnhM@rEEaC zv07-Mm8RhJ=n)h=OzAA^-;~4+-^-+($mkU928kPK4lY%7<+IGPy|GQi56H|hZ=$gR zEo0HxD(Xkbd^l-7Lz;MjguM>?00mMaLy+F?O(i>QvM+v!6-Fi4Z9_1VkSDvKy3*G4o4y=t2 zSNeDk15YjQa`Et2vWo%?E4#}5_|lAeDDJL41EoGa>Y*#+%2^;@ZddQH6FepgfXLIW z_Qct|<{A!HEGlj*kcDP7xW8@)HZ2gr%%mpx#DcuGUE=i@6Da3G{~c`03X&E|}n@M*rZsY@q*+9n=f zX`n%>6J3h62Q!(n7wtSvHd;@UW1Pp!*;;m-i%B<6)D#fPk|%&J$PMj627S3(QB5t<#3WSl)R%j}AQcGo>C9?8R#)Vd? zfefTe7x+c=*dE(%8Ud3Y2{R5kPV40DW{%(ykwH{W`EbYFSTk2@R2m^^*v(*v9j~E99i=r?f@0#XUeYJj4Eapy9*b~@U2t@f|lr>RXMp=2W@|gD;5^J z#Z^xfgSYRL!!*dk2~JY;;L7Df1a`2j3h5V+*aRm!gcE6u4y!`abQ$u_^0hsnA%!#P zWmmr$4(g=M_K?_98;pk~%UZ_W=@kz!*XxpfaA~Jbh6)I89w&5=`sJ+I4B3Def?4c_ z2)m;MO0uKG_pq23@Jn=^nJbMypver++)Fa#R*7(&Y)r_2DDZ4MA=lJxBLYr()HlTE zp{AX1iiJe00APB^`-&v8XZPjWP+-rPHs$G5ZSSd~@O>o0+O;YcSml*G15-oBrYW60 zy1f6w?cw*;7f_nL*=6R*9ai}m1e&KxnCQe6Ucmf}2<;VDl+%_Uh%Oi>1mb6|!5Er+iIp zm^M4tCdoyQ+PMc(DKxkw=)3e^nCWnvYyc%UgZeo~;2A z(o1|j!XAl{#s5@dgH$5FR4I(vFxd1C0ckNO+@&<4)b39XiE8GI6q(ZD9bz2Y<=BVf zIOpkfqMp2o*#bL*PV4TGR8#zIW417Rd@mS$*MdN5td)w{Lp@Y#tXHhlUE7^?q$+Kb zZk#s*f=qrdMMJa-dusA?bVCfda>PE)5-U-q9YwYy zRyfAdogJ{so*m$hDqq?2009_e3)wQo>Nb9>lCXBEuO#f^RH=U*gY2A}8YRHY&gX83 zOi1G>{71>Hf=QG8BedGY@1xU7da79kc$k$Z6dVFh74ee zvhqs=4^UTwk6Ab(Cu=(n&E(ywB(vyAjX_WU2zoE~K+ieh9p~&2^gb@p?%{7`^cQu5 z@h9SY@h7jr*eMk0m!It!`JE)pnA(OjJF5_#w$MNBmJz!bJ&SB0Z3LTdfenS^ux7Sl zh?1Gw#cw&RLe3g>3S95wm3b6nyZJJB`QkiZ$UnQn9C#C2G2qA=B$4F9jFAv+TotVL zJOS-@|Hc;fCo%CS@0E@qv+FTgB+6`}U*Z3e5iyf8LVhTte^Qj$NnlUPbQ5N3C@D=D zg)J}Y@*pNH2BJ}BAT<${WRb@_*%DNF$IbP7^sXk|w~nM1!uu!w+db_W2-xAIDRhuT zs{S^G#Pe;Q$I74lIe~t|%dY)kOx~85d*!Psq<@4Jr4ku%dz|4=A}|*M)15B>$}7nb z8SS@hHpk7uiQ~8I;1g`iR=%Mv8!t<>?6HJ2ZW7F`315x0-kVRl8} zY*+iit|3Cr0H$6lRO)XrZ#)nqFc`Z{-cKwj2tF~o5ZSgcP;6{RJm_^6{6p0gJJ`OA zSH(xUTNfMH0jASDD*l#NyxDS*9GPBKIXpwO51aFc#8=~?Z`yXYezP~TLLC2efq<7uUM}(@$ef1jAt`&$z)5FWRqPw&C;J#}sTF{YUl>aK zW(A>EJ?J!lr4VLTg;p0}C*V)Es{u2}5joa^S%?L*8e)}T)^w}9JI#8*&46U^{~3}E z;sxk5Z=j-5wGK1y&s24?+f8c4;w^6e#chL~v(2|~=6v-^XO4_+dYdNQ!)&MuyJLJN zyOHCQ3vD~r%F>@(Px4*@Zl{^Io&sjdrKCUXg3->GRW%9ZZ|b@nGEwbPZ>H=FtJKIs z&AIVjxlJ&HON1q=-X3M2H@&aK-U>GDf}Gy}DUAIi%z_1Tf?o%y8SrM7()~D>xse}B zmqqvAy!5i@{)J0Vi6#qJu}WaH?Y*e1J^doQm;3>cqHRBt$lFdMKvyK3#YeE|e2Kq7 z#g%Qp)jenQ0a7i2##^V@&&huLrW+t{`Y+dy=GdGHQd&O`3)@`tK6AE93F|!@+bvfmHW@C=8vUT4b{C!b0;+@qkSAeLtyTX|uVG zjLG>>gf(;QOn(OsulIlbg~@4hg8!?17r!p?f4%zwzvOyyn=i?)f%0o|sa&5W*5E+P z`oP-%Mm1PBLtgvYOeX$_4<2E8!{a{W6)T&~9b`=2X5s4SeK@PN7YN*`^Kjjdh>r>-u3uuM_hxf8+Ig0&dGB?VHJ9{| zHC^ZUIX*_!_3G!DfBXUE=y*7(P6ARgk!9+q(lKMFQc)))?zY~!#!dG!HI-eVaXDb6 zOb(U5xl(#O-Mu1lpFN_iBoy1{O_V8J5e9rJ6wr&c>;$7$=qO8_7d$HwftmU{_~h)0 z;FHr%3I68Q;FIIai7wb&uq|;X+d2b`eCtWd5-9r-pII26JT!ijcqRC{FkUr+nPcO7 zfxzNGBYQrF1(sEWZ;Adr@5XZ*|9<#zFc6;8`1e4dG!UMfeBu=Jdwz@#gs*Xd3zNSf zP}eU;lZV15Obq9DRc@{t)eoEE=Bg1O5a_B)|EA*yy2i?H`54)CF`uLibPe;v&UT5r z2D%R)%CYI+0%hO$e#^ssH&=~TkSFdNU!12uwZuMz%g4U)MV0oT_{PrB%&Fp4W8*hX z5gHY2j#t$R-QqLrgmm%AR{$bExLWTY@MH$GZ+zb(cglQJNJu=u^cshI+>}Lv%>Xnz z8nI+^RcRT&p=*hwHM-GL*pWRG`$ur)_ZSe-_X=_MoVss($>{J204(J0jhUtKnPo@; z7JkPk%g$zIis3V5EU2m=lBMzSnHoHi#1dMW3WW%T97#C2G(I^*6bq;0Ri*o?N({r4k$SF-{T0pzMhE)lrw{t&EtWr;9SmX_J`J zRNZ{Ueo3&f&O|(hRh3%pS~rXFRjoTnLWd{~#%`eZ3F}yH_uBW3KL$=0&Q?N-L=xT% z#wKXOlG0$)yL2-w;i2YfWh*cb!N9I#k$9+ur9DHe=s5R0IjwFO%GpKO59LBqk7|`4C#VuqXs}qm0i0%m#GGQVmOgLjpqy}_hJPYkL)xasE z&g+=*%m6@`UAPonv=jumDgCwp>Qzn3iMv$bORmta?`HzrsvDiiGy?3n?E0q)iMpqa zMIGi8oxi3rNM)L0Gkr5F(*UYWdApd}Sw~=pxfqRIDr|d;WuZJveD(Bom@@#OZ5$Wz z2XW`S`YdSWw`~a#$^Z_u93NQQuYTChi|fx=JHM{AVjbGe0M#9KT$C4BB$lx{4z7Ct zWg*H_WD4{ejh3igk8|hJ&1xVVNu&oW?<+SrgdRz`LpsclMVA+lcLNd(_On2Su~~NR z-)ckt=7)?hizEb&758C-Y$mcy$sYK0&+ahSQ*v@HA#{_xVAFpWYEPJw?m#-8*V1xw zp#M1#uMVcTf?u@|Cszlk(7N~z1bd9DHzuT|QfqT?r&4%|H)aHu{g|wv2hAzoq*2_8 z0*!)qo<K`ElrqmYg=G=D_S;V2=(_kwh;@y{@vtW&!pPajh8JX&e>)uK63YrJElCYT9p=xn z_k^WKsNxg|p9#oZJo#%965Ep=#THXB>8qSLlx8Tvu6|!hqA`apN=|~@Vq-)iKzKSY zq}L9@tx}EeN)uSGsQIPX);Q$Eoc5x^(i|{=?M)L#u_(tS7mAx({N(@Ksula1XtTnd z3(O81GSLs2XMSfxF7iX>m}e!V4z_|{Uxp2H^Xv2P!LP!l5Tqv;+)rF?E?A*4N3``; z_1SqQ9WV2(V8vTD6rxsRsSyeMeMfitr51hTr$K_Q|hxkBts99C!V zF!xxL7l3_tfunhyS-K@B*L;9Dq|Pi1$ThkwepfU3GJYY(W4i+t*@>qES~wXfj7)iU z4V>Q>vLtC=(v#wwK1Pd7*Jcf=^FtPxH*Cn|e#jiN*@g`BL*|*sCB*SXhe`&OEj{Fz zIFgbN5Up}7cAqdelMHc7$o?Ps-Z!QY33nU6#On=x*^4I!e1)?{_$4G=tRwuAqm1xV zD9SM>cr7_%gdZxds}A#R*53eKj`#1`bFY!XzbUjF8s=_>q;<_K_L|)&bP`ZR;}ap} zYZ{wKWP`2H=wo|%1xYBr84pBeY=M;yl{R*f#@fX}c<-MP(cn%pVPTvCc9KXtjY`x( zHtQEsfF%n4s1W*gn3DcfehdD)fi}cRD5dJ?mmwgCrn_0g^iYIH29jxrI-)flYqkatLI4 zOCW54wk{5F(E}Z;23q&vr9^69viHXeW^Dj&@+CW=u=u=qRUN&$J8UM6K*JA&`SIm3;OE z3qH&EJcK$IubS`8Y@j`gy_xg9ss>BM`*gX0%pb?#d0I*R@D{9)Kj%33Iy1q@ezyeH zmdY{Kh0g1HwfLB9a@T$wg2)s%z4gnCA_?5ybBsDOozojL7zuNRUmNGtWi)mMAnnd( zFCH0^sA^*u$v&eKtPb-gF+R=;>ZBt!)}hX1WG}T%?i3`ag)G5$;=|8YkiMUWZ!0+l zi>qjGV;FD9BI*Eaz+2Wsc9{Da%jxt=t`5`mnR>TZ5ldP-k~0svC)M{+H&r+D;Kw(IQmQSQ|T}ByqO}u=r8lUswLWA zC`yQG8KKj}Wl*-poIzxJRI|<0j}1mVI{RXoC? z)^Yd5;OK$8@7Ah0Y*GfVlc?OzD8>v{}yl6vSSEb?CJC)yy1WaTjkV37;P#L#My3N}6JzL7rB?!4gb_w(D@L+<4(6G6`J za984<~424h?QXNw~Y}(Z(+5x)Mw33YKawaefdOFQ%l3nH= z73KknQGN>b;HT8USs+km&M~);)b(tbEyYp5i~q@23Oda!fjx7csS&{KW}Fzv8DhI# ziIwI;1=B@46PVomfbm68{o<^r3u%sh~hGrRdVXigonRRMHmek_AL z3sub`a#~FZ_n%Z>5SdM&SG6c!wYcjGz69_)`X|4YIN$hb07{Cpn8tcD<}|2l9&kI&M|eDZs%OivKWdDO zBTq}4_;8-j$WWw%+=4(QrXMANj!d2A*4>8=FDNIIy~qeBfiy-fG)PmL*inG~da9Fw#L7E)cvGWJJe16<9xX zup~%f!50T);l(|om@!O9qHnuI667aZS}BP{<#356xI_}+ByB>I(*MoWTI!j*S zWPNb4yjIKW8F~GcSKt@r1$l2x7B)>4xKU26x<_VCjtJGRKne1(ipye4zZcUk|0Av0 z?OlH%-(PnUYG5$w<2aM|m=u#TP}(8aFKfX}9QPX6;i&0Bqb;xQ9i%6C(Ri z?E=fii?}CN5lTqTm7zicyf;{;StK7XHMU6#!b|L*QvM`tDo%vvDB3ND%R-Ht$_Qqg z=H2!-@hy6O)?O|-mjkr8>b$yi_+iuEo&?L zQ8~QAhX`QtM9mg%V)tsw3SNzK1jQ`iZR1XMZ&rE1i}9M*CBY7W@5|4R^m%&ukM0e0 z^_H?G6|G+$uQAq*v2RnJof58?wR_(t{2bz&5KNdfwyvo82RBErnDya`>W{n{)(Pjw zYqp0^K|vDv_2WBph2$`# z>E&L{j(9(Jctu%2mU(m!-{<{R4+QRI7Cdq2@VIDuVf0Wz!)|Z0We&ITla=GGtko?j zx*Y#s^guzw$6lMXi5c?bp~HNj!!-0l!&=IU{q~XDz<*<}!&oXBH_H3Wzz%jU7>7WV01VbT~ZOisW`eKURx5MP}&}7IW@4hkUp|jHb#nle`lor z^tE@^5BuPU48m)s$VlDuAB}u?$%rpk4*%jc*M%zwFS;%qUUY5cwb#$T?(5fA4ylY> z|Mf-Jee3#b=buAHS!P(!8%0;nL%RRi0Bti07o{)_&zf@st^Dz7<j*V#5uwI>k#OThze4Y?bA)R+xAsnSUn z)MU2?T1yoT7Cc2iJ+-0FGgOglPxNSBWSgsTFRwS{NrJ*h3%c?j&0kSET9a#^;+inw zjl8MDB&?+QgiHCgd}A$%Is@Kl`@8MEg5@u^HXk#RxPGs$;Er&uLI1$oQ|j_|*4E|k zoX4}ME?-I2-ysV&(pty4pRVzk6lc~9dZvC}o7akWd#1NyJ>`fc6eBb;NES`C5)!=a zpS<_ARYus*G$Swi?x5&Ic@k`(RYK*SLVrG_R;q*lLYVgZhN<+ z_$5+3rm2b|=S!+Sq#{Mz`&f`^SM1W2zeAkqEHzB|He8~#?C>C-Hud%$aJ zd%sU~$FhR$!6(b+YDmQ&rSS{i82OT2CGoZPu0kOl4pypG(JvhyXgMaZYf$~!yS`9A zc-M&fvjS^Q4=}nqe&zt5QtwY*f!PK;?`wsOczb+yWwlaZ&C7YMD3!F?bPLM8z<{LeVz9yIHxPHpvJ!#^F3ux!mCN(qNVcb9W=YJ~iCLcaawqHIWISo^zoN7%_yntO7cK4c!fAwb z9TR+FWZU10Sh!r3SKKW}U=|$q@w}$txafgzEjwm;-U|%)^9$PJy}Pagqq>584wef( z(NIuO{AX`zY5XJt%L-gro`jXePx5A!c*h~8T%{L83Lib2-Zgkde{WVPDZIhLb+j54`1=|$i~+wFv+{>WQWu1mq>{O@{WWK{72d-ScU`J&X{+{y=#I-M>TU&jpzHLk ztYukQdy_SP_~FF(yn^j{OSi`k-x~C0ZMQ3XgLk5EANJ<%^{TgHez@~LfalBrGH}*r zxQVK}&D&q1W6ZK^%j2{5sL=J6V%rh}gGYke3A9c1Zo6KVBP#D>yrL>4cEkUy-Ll_* zbM@OY{^G2z-jS%;KD?Dv7&-5X;|_%;UZ=hB)J$N@xVIfdW3MgSPGgsH83&1Gc%9A1 zn^AWK0!~MvuX5`B&Uy8rwVZr^!decF-1!(k+T_RY>+;rB@^B*MI!>Wn$LW%sqCi*f zRoIGMlWxos*7dRyZumdkS~zcz+M`(%C;Rft`BC9tjUctjxEkTh47%A@BVf8f|BD}s zE*$6bUr~Y=b8}dTP4+C*DB6dS34O2?t&gP`Mawt-Z28~wZ|pCxQ{;7)yuQ%&_2K`} z)4(dCg`vW(na?3c;3|-@0sptO^N+2&ssi|XeJy*^M_O2g63W)$BYDJvg;pqAF=gHQ zW9!;&r7J2EjG)kY{U5|?7eTgsEJWyszkr22npmvxsKj++gU%#)vLSmEi-s|_r{c-L&=bn4cx#zBKIK$3JJ*P|`xPb~9#wvb6 zI_;{s>^E6g#*gwzh;-cra_Kb~dh?R<-_b!SAv(p7R1Ce2;z2l=ZlWTwwCpLV^`bmO zFz}4QHkhnXlDP{7a9_-sGItsZkj(=!@@69*0WK4}xA559ob}U0p19Q6!E}Y}I+8nq zdV`zQN3~XTB(ZWGo%s4w>Q||p=W(R7tPiD;Dr`RZX$lMUtEs48b+%sxb2=mAbS&wB zkjq7hh`;*4~^^#`2-sK9fS+sfNUVJI761&%r+nmka0Fcz;osV3-${E0+h4Y z13Z`Ixoi^PxhxrKv*dltP5=Zt=g5-Fiawm{2AE@V-vx32dE#P6 zeh%-h&DTFy=nS11Tsc>?%rClv#3qD3b;(?gcf1TH;n|@V_VyCN&|!`N=(5c)s}%T0 z&VJCn!a8pfQex03tYK%)4}-5RcP_w2Jr|&hOz7c(u<fi3NnMaQ6f7+&p{bti)YR zV$4liXI@f-&m$~Iu_dbWl*C+O-RJO>#m?Lip+xV*jed#6T99J{JZx!n(WL8IS}^Il zrA&LO*j&oI%~EFa(CuoU3XP0}{7aDqA`jSb;BN*#1AGDa60i$^m;DSt-bbHYkHi~? zGw^w)5rEfm42H?-7S8+t_zCb70KaF>As1LeWLE;{Az9>0_5eUxS!6<%va;_W4?+OT z?%XAS$PhL?tokzL4JpU-fUP_kRS>lmTo2%5(vr0=@za17w2F{0)A&09X!u6j%-LO!i(t z=420m|FXXlzF8B=U*Y)X82Y=Mgyt=KG9lwLYKV2ZaNb!AwRj*AOe=2AJF7^2S)16}%O5(@&*JgjlL%iY0>K%eGnhu5`q0Ga%n$7n;*j=ekwR9U59S z+#|;tLHdrE7!K>2D>SplHM7b!Q)bC(*UTDiX0@Idq7K}kkJT#Nis~LJtTmXC4h3Ag zP;a5OgsZLA)pjGb#a(R)tt}2xmM>6-SHOqqc+hbhY)&i9sblQHn}lr5)A4%Olseax z>ztldFSD66VcvIL6R4qaL2_+$g%*)(@=%jy&+Q?<8usK61tRFf{tf`u*dGP{0-S;^ zYk=#3dw?$jG8KLw;F%2j0<%#-)aO=U5ZD8J8~6?I2Vk11PNu-6z(<62-wfr6kyIx{ zpZBIGDAw>KlR%ASyz$1WOiZ4O?zz6<->crLIFRKA=DhYw*%vHi?-GJbLIDlQTyrc|k5qx#XXY-@K1$Y2JhWXzFkYhd@EPW8@bDBly@zPSZ zE?7Na0(rI!O9h9d=b7C}+bDCqeoD3^HqhuN8l zI<_~8MWIsUwoJTXWQQdrL0fQz>vh`=G8*=xQ?nysN!&7YPO#M0e2WxXaX{l*EV8Ce zi4H4*PBWbttZ;V;sMO0s`7``i>c-qgd0=#L1L5viW+}cS?CfsVbaZ7-6Ho_Wq|iz^vvM5XPAr9UOT$q`;$q#urK$ebIW9hGU3cw}P#9h4Eq z7h36UX+rP#RVb+ze*9BGvR>2tvMffNNpHJ(ZC5yDR!Yw2JP=M91UY^jm5MP%R=u~Hw|2gnrDwDZ5r#)$hD#I5O(5a z;Ou6g1?U7=Zuy@CP$hkqbN)lXkaT5NNq(7i5sd4Mgo^;@`Ayiny;m46m4^LQDnx8@ zT)RM+VUv3$kjix3>e6bO3q%nz<{F=b@h!FXT}WEAcO~hfJH!G=I=k9p78KHRO1cz0 zB|-cm7W9U4w`mfnY-y1iL@Y0H52)ZJHcIQBpi8Pg1*NNbd;iwcoHYfbT!e|`8Lz!A zT@~HmcRIb{^vajJk?uQv!;Aa-PT{`jJLMhpj&%+_ zE%{9fv*u>SA#sCDbB^b=y!3`s4fzXS*4yb(VJ_2J@8s0Vg{!r!gi?2ssyW3y*d|7g znw`uU2-;1LsJJoW!!COIrVSYx^kJ@G9v5ffhJP>^7h9}ynG=HaI^-Z^F_YbdM|6Q# zC;%skJ~?yYU2|dWM8LsupD|MkZHhT!9{?}=966z?!RzobdQ+weKy}D`1NbTMd*BRk z7M2YIqJLcs$g=4gK$cC=e6|;mxv55n$wa^x?x>PoV(utGTY*-Xiq%pTH54D1j;K!WRL<8B<-G33^FjQjh&w*I3_f5 zbI7k@u#l@NUeO0wi-}@OZu?DYoo3}IOwU$Pv z;UUg~-$UZ&F&oYhdCoh^`826md?G5IQiLIsl=y}qR(c^XFDg3b@LwUXpWPu7Q zyseov*vf4(@Cc@f>`xwwrF!p{EIvC?;#*07#vt;Gos8+8aJthYgjmU zP<haT^A=bYP`W{E;jt~Udj&f|AY?)6 z+O0;286DGJvU2if(KJr)Q1vPvk?jLW1?W>N;c|^ih6s783Q6{qMnPWvu*S}UKYOUQ znMlB2lfz$q5Pyvhe@%+NMzLa;szM`=%9gaS&siZW{C<9j)`yq-QuT6|BQ;RpRB~+P z8*MD}J>W^;W#BY9eA*H5s5aRYz`g8Kz+ZtkDI|v;luO7DCI$6dQAO^va$yfYm`!qH zz^gJtl!o)Qp;8$)?EH$T$YEts&5LHHO*cP;=M2FN(s6Jyd9oPa4d0!ku*%4EKh#$h z`IE4pSe*-eH|m{OEWejgqs$x;G_Y9qn!T0L@@#>bMGyp-88IcSLrZIk=%OhBf=wRU zXxHo4XbhN-?O*)`YxuqoK+*Pdz;6NkhW;CZvTP{7!Wc5%@uq(*w6*G=6^}l~H|E5W zWImOgu6S@D{ncx^ay~wE3twUV3xy-(YULv=5iFa4tw29;573%C7@2D3vux@{0%qj< zI;6)~dUZIxPULj?(+y*hgK4~Al9d1Kj=`|LB9XiaW(V&$&3J5=u#yDEFi|B!<5xjo d<3v-g7{5h6Zj}!qy75l=*uaPMG2}@v{s&;J5u*SA literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/pcre_maketables.obj b/3rdParty/JCL/source/windows/obj/pcre/win32/pcre_maketables.obj new file mode 100644 index 0000000000000000000000000000000000000000..b900991487b0054f42f18f8088133908603c0173 GIT binary patch literal 3214 zcmb_ePfXip6n{xf5+GZd)X`PjA%`5gqD9bD)!MBiSpw`&B`AT9wYYf3cCk0db{$)k zl>;b4%H|$+nx;vUGAW5#sfX^iBkjVe-T&Pr4tvKw^TalK%&&fz>i3Exx$9muQ ze((3a@4ff=eM^IIJ|1UZcq~~lMT0l31=bKu$$h=^ZagvIN?eZrQnL72Rm#T&D83E= zucdWS8j*N2n(ph1o{697hvG26<2K2se|a+n#j^lUs5J0`mpE+gs4WejsHb_U>C(TJY$~e|w{HT3KPSpjEcaDs_>W0%x zKl7I9v7gAOXmgbGVk4d(w;xZ*G&S98NAZ{mve%@Rs4BA_lXBWsJS`rFl%6EdLu!el zbd@^lWsRzedpte-iXfw6<*A?9MvZ>jevRg41#7|ZI!&BrtE$JT=P*fL@1DbYYUJL- zbH5wWH0Fu+uJ;bxe>iLxlBw}-4Btl<+Qm*EhDFfv__-gnp@tLfcKQJF!1pJhgPR!o zY=TLTW`UnoySn%`#P2%d3XW<7(I(1la`m?ihftC)sfJ z|634VfS`z)k{|ZbmG1a`09i6MdGXgI15l$ECisSlIY(nF8+ItM`eYeHE%Lnaap%vwzQTi$ z^Vi1K%Em&Va6feKSshXoYhf&*;PUzs4xIJpYV2EwiCwwUs36w7oraXo6HPTUDB*Aitgvx6;zfHoG1nI00(pCA2bXR^Rk;)(BmC8Tl z)#@qIS^a<SfYZl}Y%~jR}8siS$6}C}6d-C;J9(%*11hC*Gc>u7QJ-@E@tL BZDard literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/pcre_newline.obj b/3rdParty/JCL/source/windows/obj/pcre/win32/pcre_newline.obj new file mode 100644 index 0000000000000000000000000000000000000000..57d023046c0e49766f3143cd5552d4f78362dd70 GIT binary patch literal 3281 zcmeH}L1^1n7{{M&Mb6p`Ct)2fgVyX+R^}!18rryQah)t~O6Dw%yJb}?97$~ivK-{6 zI^AJ3ycL{yhn&XPsfS&5++~z9Xq*&Et~+*@62WMA+i6hTF2noYlVY1Lg9Yn2u%Dm! z-v8%M-}irdx_usv#^cgUAH1kr>QceNx1=S-()jT9*?3}@&ty}p7`my&6;wTj5E@9A zRBci#Sh4i!)3K5G$PlWg5qjDU`N|J(q)_!7Lc44>{8D~!`R^&(%2Iq0RYyVl$F*O_ z-aU+#-7OQ(g7}GeJT;Xbm1eBc4XaR$eW)8+S(+#=6fC8nYF0^_O^wHL*jDwDG&~d^ zl5|rsY*mvgx~Y~bWl6EHA(gSJo0vhf9(1yMXi+ON;*3YkbWfCxlH&871F>N6a{8HP z8CyQ*2}Iqz!Jr>|^}N`9JvGZROMWK`drVpM8;Vs!U+@_!o7Z8t_*_!9lYB2JR#ojf zOVm$~8am&eK0ZZ&sN*urGv|5qQuiJ$E-3iclHYBTP1`VhZoLdm^84;(@RQejANPH$ zqHqH8vnzSn^GAl`LbJ>Qui<&1uv6^4!%&nGY(M@$yWl0!)fpcG2>SXI>XGLrKAjWN z+3^XOkEiBR0vp8f$=PgvMvyP$av}JlZ^G#NJ|Pf9e1?$Fvp);>BJ{0@#Ac`&MC(z6 z0s~_*J9A~dy#H1KFBE9~ID`hhP^Hj{?FA6JD+n;=Yrm0)jojr=R;L@Q`Muh7Z_Vzz zvmN>J6$mDNS&OdxxdEWaSAW6yY%69TBhJah&ucS*x+9XE4~{$ny3@yl z5UKBoM<26`pu6lRzO2`NhdAN7GuU3%*Iw4rgj`LPYXtioaYA(`+SUwqYCHhbv;YDJ z&?(|Tq9@wIXs6JlxI&M@ge^*sOA%NhYWY3#B4}p_J%Yo8hVURAc_c!W&^=t5j%Vjnull)U$H9kANoaNgMLnz$<{NVSg+xegf8RM%GT8<%_gBi zD@#A?;L>a@-3e-7~`6qo#Hsg1>MlNhaFViJSWrNd@-lPqp_!|a4o@h3$J z!L{H?L=e1s^d@+cTogg@)}vyPiVBKQ^kSS@SCOiRn1S8l%`orddw=s@X9`k+AZ_|c zL&s`M#$-`yDOhutgA+nB?n=nQYNAbQ6M_QWodB>cZK+yLlW{aXHWnQh#$(XU0IUxM zJ@;U*2;Cz9ZyRjdGfRg=FF2K>SmpRp7H#7a(I7g7@HPvqO{1A z25(TJ8hVv8C^BobS~$CuRT6iX5>?e|j400>HFUQ;IldwkQ71OzS@Lr9)bKgltSV%& z#XC&MY#RpW&?6co-qs_UPhRXf*8MM!rfHm5?;5x6${DdN2H6tM+Kl>+pK+Yz{52cI8Y z2_P8yDMhvb+zCUtAL#qx#tdvnh_zhA<_SdPs-eYU*Pmy|)-P&*xtsvFNkvZ?bK3)%>Uf#I+;rhN6c59^9^{9qz5s0@F0bdqflHDD@9v{#7#`pLt+x4kfqCJcD7mAA7L^}>803% z5Xr@ph^JmXdP==1JsJN3ZyrRH9tEW!u5Z>@q~alFV0U=C!~6K=d+*JA4{pG^qG+cc z-m{t6HyGd1`h?MFxpY-oDMXges73t1;|hV{c>p-4`X;SXgXPra<=m>WnulQ-;L}{t zofk_b7+wSTEUdyQhWPn!k^$)}Js7T`@0ZPw#mlq!it`HRCOW@QT`1jA*R%%nx0vDP zZrKhUXcf0>Fk+aL`C7A7&b4@8+P+rED|yZKh!dDp+qON^-yUd$aYq|)(?+onv_1u` z&JXHRS0FZ~h_(30aPCl0&a!kYt};$9$T`USi#!D5_$dMDLot!D73h%rhbluOo`+VpnGAV#LSti!QYP zC-G;OPap|+auF8vc4ecTRO{sm+T~KaloU&u-0HD{qdLGUHk{G1)r~LxA0s^)d{P($=V! TwGtESQ7xMpzwR8u2wB5VF`+cm literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/pcre_study.obj b/3rdParty/JCL/source/windows/obj/pcre/win32/pcre_study.obj new file mode 100644 index 0000000000000000000000000000000000000000..433a8d7c5340bae9921170ad4338d68976414b0e GIT binary patch literal 8018 zcmb_h4^&&%dB0EZNqQieCqTqFC601N7w6BY9rB?%lQ`a%NZ`aMTO3zuavaCq!5nP!EV|K-VHvB@ ze)l~Yu#@IAGY@|6-uK<_`|fwY``vrL_tdkRtg5JJyy;)u;|;WQH3h`|ja|(Fk9zx) zRTcIXYR%m(23z)5G?Ts(LP(**-{RTeX$sgJ_uXfEu;Rhxq;EYTq*~N z2~lWm#Z9*1@%Nh-Z0@SqL;6-j_J4L=tbE{$$kLHg;T;ejF)UfX*|EB@HsEgyG;Civ0zUsj8;TXyyl0`6iY*=9-3zSL?Q6wqSzwpam9*e467gYbnhB!}veJ;w9*eT_aOmn&AP7%< z1(O(!bfKOt?>D2rJiT70*O%n3(#4B!Q>%LQD#le*L{U^^EmDg==s^%H7C|T|C=@J0 z0s2y}MT^WPQ@%crUV0vvQN0ZGZcw{p7>3hne>#@cG2el)e~S2%P@aOVohZxk+=cqL zfqc|IMEUO=AtvBQ2=RXbz6mq|Pov$4ayjJMP>%y^@mvM02DSjgtAE49FY)k_LuX2} z*X+sYVrgct$oIQhCH6@+D?9mGxh5?)WaOdoT_A*G!r>`MvX}#VB3j2px9H-dyy+MA z1ba4WlCJI*FG@qKB7s*L&ML#;l^dqQ$pZy)!$de4%$IAX*8JuhY$P}(rO}h@oKl_z z6NK#3_E^L@p=^Nc@7GSJ6m||!x3XuI+bMG*Y63Z=lFmRhMh$bQhMi{5g1eZGN;T~A z@3PryM21{58BPejAL9|?Te6|6F^CI?-=PHfBP)%po7c@NRE*LYDQyw;Qd$TakHhOE zr9TeGQcDI@NhouuP8s2)AKdjo*-s_6jY8^Gv=VY`lD~+y$P!viC`;oF)(~_iG z>U8lD-ZThbqhoen$F#?k&YqM8Idr@jA{bG%Ls^6x3Iht+IT?5Zqiyp#=Aw9`&B1$2fWKFt0`8qzD<(Lj#$lQB;{GuBbhTrdL` zzzUQCWq=JR2bKZ%1IvMxz$)M&pc1G8HUe9LTA&_y3}^)Y5@-ST0O;f5{Vwj}I^b_z z?8S_Wy|mB8UHW_A=fImTPTQ8aYGn(IQ>t;Bc3#s3+iw_v+%RbxmYtb#>LxiI&Ia?3 zAt$F)p!qqa)eLHG%~7J_ljwQga}&|jHOIw!zK?6FjdT*GhAt+tcnPh87p zF~>11jA(Js;L|;qb%Da!n~~Op)Lr(ZBX!qts=$$2a?_%LR}r1GO?c@v`&;E(&}fg% z3s5X;Q=A=?)1PZ4w`OP`mMJf#^AG0btW8;A>-srk&(37C>?B?IchOE}V@i!eq1Q}_ zG}c2iF>21?Yv2dhmaKGs9fBzYB4N)cW0ag*+v;Ltv3!+N^Qd@y6OYFb;n|d4c?EU% zuATCQ#|JqwpdKGnb*@NFMm{UkRfEl6I&b_ZCOIk(#}$^hVi)4WNuhTS+#;n93Ey&~ zLKz*}vi#;XSn?BFutXZU6P6UmM+{h>ra^}?N*gS}a(hA=5wPDRVLG;%_<70@A2FNa zra`Pia{Qx;(}|Sbp+E5+0k`aV)4-; zFvUkoO^BQLc{6qd@T0p?1N9z@9-#voxKuS2W#)^Ps-jCZ(V{s~^PDJEYKYcxP^p=( zmuoWNgt$pQ4I?ibwOvU*9Y1fBMh~&?^fyciubFFLEMd8K>Gr1vJ^bgKn)P%zwx5+^ z#&{a;HpoM%hc%rm_<6AfX7(0Pyoiw706ky=cB9|BfoFlEKs8_jdVvtYnh6<1c^Tz(#W0=ZQ0uh1Z+S)uorsB8=x?OEj+ z)UZv@WdQaBa)2}QlB+}Dz+BTT0Q`ILbd1)O0o0@+gW{$dJ~usE3l5swIpiVDr16)q zqf&#mQXSMF2URlvptdJ*RDU!tl}cj+aC|VeH~{njy+9vu7#IM)3p@$@5I71v2mA#1DeyAz&%iO@Ux65K0vHDV z12_%*5;z0UK1P5sU>ukLCV?p+UC(G+l9^`W>X*3>%JWKU9&Z-bsQ0FoOts}SwAOa$Ao zngLB{obS`wtjR>zGv!yJ4O97p5bJw{y0>sn>G7jEQ@*P8H;t8`y|qltHbu30{}@dU zJ-4gv<(rYxmhKa@yc)MSZIrtQ7+OtZDzD^!+fdwZk(@Tl{hB+UXowG$?O<|I{UOgB$b z>fW0t;rp}$nl`H49@Xp||L?T=?xL*2>etrT9h!$G+l_m&>Hsp*;F2Bc=`5WvJ0g#d zt9(N5Pti(W7^mO@`JG73i0mAX!aE~;VHRHvoFkQZ@x-glfy?-a(4+P@HJ4n-HRDk; z)0+?r@j{CHK+O}7BE*86J()|J!%1;9T3=@3R}G;=3@RcuV>135#vqZLpHI|ec&-rd zvR|fLQfwW}f)OwvG^3vXQfe8#T+~cqaPsL$!#Q*>$EmgFa@L;HthF7uEDhPBEcf*N zcz5DH!QBApQ+GI0OK;d~O~XMw&G319HpKx1=XUsGxKlkls+p*3_U$ndEx?O8IkJgd z_+xAd_W~8b1Hgm8YT#ku5uh5_4E!0e18@O<0qg>H1FiMU3vamc$%u-c3zB0&V1}V=-SwV&UB3s1+BTM53WCn7grH zrX6M`2vUVcvVwHwEp(8jd^8d$V3vbB6A2xdKukI4_~R`(s>4trBG%afA|XG zJIx5+rQfb_u0j=0hqzxG%?k9@PUI~-IbcPW6`*lytr?@)3FvQnpYi{ZigY;KI+x3sdtxfpY+hP;_wl)te@pSqFG%|@y H=i&bV$)~mc literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/pcre_tables.obj b/3rdParty/JCL/source/windows/obj/pcre/win32/pcre_tables.obj new file mode 100644 index 0000000000000000000000000000000000000000..77ad7126082f393c22ced0f8a1b83b5d0cb7539e GIT binary patch literal 4887 zcmb`KU2I%O703U(_xdBwhwXgWahx;`kTekL#!edIq=l^4uI*%PZ@in}I!kV6cgK6D zz8|amVY8J`s{$edBvKVYDJrV?c&Jo_`T_#+0F)PaKnPJJ9wJ3Tihu`*hy+xvF#lQG ziIX-Dk@xzZ-^@K{=FFKhGxx5aKaHXO{=z+XWUHWD6+u)hR7-)Z0@$vov#-(b% zjVq_v_txbbX9gdnub!*!Jj2e{n|o4c)29mAz^??t?R!#j%7sz4D1wqG%fK(pq(=I3 zQCwDjVc=;0(Sq_yPF$9SCFPaGZ18v5h-*rK>$=S3Qnz+@t0A zr3TNO9)(j+XCvbbqoBcY(xdV!+Ufb#d`@gUpE3wMztMs6h?VR{JB`YYDmK`u<<0Z7 zG&rUDBsDyxQMoMVb)b#hqmHT{&j!9l=ut(Xjx)EqN6&41kGjQDRI4_6nJh1MoCYtw z#YJlL>@Du6)wOTnxxby!G}lRgyG}po_s8PrLI$3w=kRfQ(O4s;fS_$($aRv@}Bn8MP2(HT|Kn2NyBa$I#&(TS<8`L zC9*?Xo9>FbRJAJ7(+4o4{q?fj&NY9uX+t2qiu^ULubC$E`5bG@EtF*~`zg%i^73=d z)a&aPlbt6oNS8yly(Zcf~$!H<%2G*zgIXc)7sN~_E35$`zR}yS?{}{D5r3 z8+Mee{}awiUwyUByxCG<-FnVLRaBM;y&Uq19e9sz&Y;OKkwS-Ia4mL_yU;~;p@;ej^pTI?kdb6I4zvCg2FbH{ zf^E8ShV>H0$$n(XM=?wNZd@XJaGBf#L46q>c@Cc?kK&8u0KQ5N;_KuwyhC-8gnB;F>6aE&~L8{}#Hlg!|jp%2=B41M(9HS{4| zHux5XVVZax&3vmgqt!IHnKqMqv5nNn?L|uB?#nRNKPPWrCf`lTq!wK~(8G$urltc2 zU>HU-W!=@(#D_XoMm7>Ff9!NuBj)zaWW;ijBUU&9Mk_UT|RCE|)j;Q#K(nE~- zw6X}KT)Lk8xQH>oQ6*RIiaXw;W3YbC09WYbWYTSZDnY& zMc{{ay^-z8fV(|&2pQp1BIO|?t0h|?qugRldi>|f8fGQrlY@+l3|mIX@Ud3XLuYDw zz4%R;6b=V*xGs~zE9=Qj@|L`1B$YKOYRu9kQ>$}lrQ;w}i`u%XSfBMt#ds#^)c16* zwfmazToGUjQ)NuaB`YtKm5C*$7JN)OnDQ}Q(R*UrvC_6$P^^@#iHMu8RIg_7T7j?d zR>@)MPg`?-9N9Ya#WhVn4imwUtMn1#!#!O5DzbiSeDHoH&v}aKhcGBs7o17GsQ>NGu7)61x~R zQDYR11zXfa6Jts2!IDIcu_Pu@ll(0y{NJ1R-hI<{cXoGnIdJ!PJFl1To0)I-X4@GP zROQH#w(qa;__Ymnn^re8o?>sRZK!uPBPNU-H^$*=w$#>*tW{gPDy2G2+gMjWtA2Gu z`Lv3P^2(8wqt(_aO1+n9))ja3s#04gD)l~cV|;yqn7FkqwVOsBueMHt*ng~gXX@B= zVsVrhybyxlDCto(ciJR-LBq!58dk3_pSgBj{bqZ{`ZcQ?YFF3QH*B;QR!uKo)VQT? z?M8dd=#iuCwHs>JZK+9EJ#s!>l zcJ>)-)@`hfdE}6B^*U!dDu!@_f$8em?6P8a8Z4;S?f z8&*4WcnD;{N3jFb$x^!!PCsWsJCvKq__4hR5~xdusuneiXB@S-c-s8wGk~97wYaJn zHzm_&Eu6n(L2=Dtixw5ZU0v2v-K>ZsVhoU$?l@vmfF?>d^*?E z;NvYmji_m;uie;Cw;7&EsBPWB*2!ht+_?I<`Y}6SNMstjvy)QWi;JOXDJFnhX&sfw@P9eM{+7}vE- zpI~}A(~4o#$4Zumq6~SbuzoV@XK)Z#w7a$HxA>&kImIj)TDWo$2Fdzsj| zk220*!TuHOU%~zr>|eokE4YvG>_49U#&g_w_8%{P955$X8(a~AISEBY#%6g&Nq_3YANAY}2VEqKvPvHGDLF}Bjoc+q# zublnL**=l&6S?k0j-SZ>6UC4Fo5&Bx6ZzqIBKJ9%^9&Z5;|Fv6V9q<3>vV+k_L$yE zb>ui&23mFG_V#0S2cev<1E=Z0?R4ODt=O+6pUy2sX8)o5>|!YEhw?Cn@-RlQenfjZ z9mcXemg{zBxjV}xESIo6j^%MI_hY%A$UH6mxSxJJ&VGEj_2X&k$Kx8reuH>CgE-G1 z9>*Z|AH;PAalQd84`BZRTz3G^(*Vvpfa4Ej{~_3^~C$s-#_Mgo4=du4h_MgZ8^Vr{J*=9eR{cO%N zgY7d|KZE^dh@JDy7Rvs!x!>9BH;-v4=P6}Be0aiJTlU9iH^t}Dvyyk<7(@ASczD8R zSygY*qpb624Kh9odqh)24VX&uuum~LWvI#LLhI7s0rEnd+m?(sO&tN zgVR;02fB^v8BEUv+KV5qN_#;vxRt`Ginm_;FkFg7;8qI#;SKX#594sg^9Q2$GsRFG z@7s{KKa3rpm?Qm=WsJvX=gzKm{wZjS;yYk2=H1;1(&M9iCrE>j>R6`qWuiUdX#mPS zPzL);FA?2^6!dR1En@#SS$>P@qd@V=4&GXGz1Dm&AJyvAr8FEBoeONAHc|Xq6NAj`$5TWdU2-}yiehKTBa9@YB z{&3bGE_yz^+p@ha>#JF==Dw?WT-9vHdHv58n%`Z^i9QH)G{=o*|Is|&(cIruwom0e zbJ;$Z^>aCHuGqQ1=|b6WI{Qs$zd5X*!}>X#cMjVZv3?Qj7qR~$vGcqv;yTmVK8@q1 zaojYqbKGE#TfzP-*nfrS*>5S^mvWw^?6*|x?7x)rmlo6USPK8li?aX$R-QE;tWIvfpr_ z+#Ia&`z+Sevw@DYSiPFn$1v?Hl&7&Tr|HZ7%h5q&EoT44?7x^-**ezO zaa;|@)v&&X<7>pu@wMz%%l2CKuN6D{*R#H!{p;Dkp6!RS{ZQV`hjRRU)~^xDacelw z8a`~hu-uamKRjf!xoKrNC}LWyS^!r9_m+;P75r!G2S&iPD#y!$t4isk7&5d_tyLSi zx6J^>P`d@(v%lf^ix};IZw>!VwughT1RguvIZ}!01Zb@~gB9(az~05tbpkoPv6uM# z%hDWsiO;{Q>IVNM$8o1+pe#|U?(omK+g9e0+!oaPZ{ZhtjU4T6h7SaXOf1AeGFKn-(b>7&AtD!@u(AbGeN-sCmH;mY7Zz?d>M z5;(#rc-{p$iJ;Qy;vl%hIT3)K zlhncLkkH;Ht3%ZkHC0tX^kIN9H4X05n{uJ1OwEA%Of?I(v(+5f&V@Sy`FZMahd;vE zN)KhK+L7nGwrHCV7s8GNEOdD<0=~UVHaSvri{Zkf7fX~MtzmIM`1K--J&c;%#<~># z9a-Y!GrC0FG8GSK8R(vUvZG>Z$lJ-$YPrJu61BpiwzAbqwaS47ykG@PTMewv$2hRz zs=lq(0BTiTO4uPD_3Bs$wd%N(I6lNinj~;R4{koils~ zGH-LTo2{8Q;x1H~z+|E5ZBWPP+}wASz*ZMIxL94RE`eFNSX~PEUMOe*y%@YM%MwdM z+F`wY9hA_UYu?%m7O zl}TW$tJKx%8n~whEd%9=9It^i=>rc`%9!g3zgESE?J5k{CO842sbko8L8-mq7FxROH$bCM``0$g}~fDcD6K+dun?b^bmfG z=C>p75)oCh)ol)LS39x`ThgK)xgE}vHDe8{gI2u!az_a6 zR6p?y(Dq0>U?<+C?grTE9v^TwqE4vao=Em*LYWQ;i9qQt&|=-Yfg_-nIw6W46lb>B zCxJSnj2MsFdqaR8I|28(a6ibB$5syj9t8Oz7sQG>D@ZyCC2dXyl$(lo&h}NY$*%M&p-~MPXR}D$ckIECdRK-5Wi7~XI*#>cz2HH6~b08 z_#hggetRN0+~2LG>My7l9Z-GjfMlUBdb%VnWpQ_pU0@vQUJ8NR7x|Yx_^lJSOYH*s ziVva@>bED7!~NY_?Bi9awhOjcn}9m%1h=mOyuFjnt$T&L7T?!Y5LDM4735!6uS2Ha z`5+phe!EwuWnj2hnM%S|eh0-7zh~Gi3;jKK_*=$yy}(MC0kwY!!5hkeBH#237j9JQgsH5at^#4;+PQULvDz|vo$^Wi$ zLwYFk)PB$7gZ}TUKZoFb&`XBw>0i`eARFFs>*n3L(IQsi-7;nHW+A^1oVX8^f$i|d zm;7w?SLncaec*KTHx-0*O7-1crqBOfedypLl?)$(mHa+dA2UbtKNNwMfzcu&{bvY1 zbiy&k$Le3||D5|L>J#;MA8eoOw?~&{O0e-n_{3%T$l*=?@EF?_5$+LHYkQ^>C)GQ_ zWH&pf9lQ>WK#hzod-|!$1wK=ssm~dPLk&q{|5W`u1piS6?(R$!X{o}ekQ0GA;$-Xg z`aH=vu`AP;L}SEfA>I9(t9-8h3;17*upyV(qr~r4xd41XLQ`HH(~Xva17pgT_cWGn zZh+S+xF^>FrS9ep-%6JjP?&*za0XiI))7Y4Mz_rX?R0y1I6`#L1X>0T z5wUqtdV_06jWDNt7}rTBf~~~TStG)tZPi7mMwv!nPr)2rb!v3e-4ax{)qXk=#Ad7R zx_iR-9y&khse9^PaCf5@Xxu;#zmNF$)`&jNwzuvJUH5dx)K3TDp5<~KgxlU<_jmRT zZU+EQ*k2%8>%w} z~)~VpFkKPiCbc_yS zEPIU8~s1sZAi>TVLkuFdf7+?Z$K+gpA72 zpbu4;p=aosdR7*g2^k18Ars}poRoF84#Hh+j*bs=^*lWnFwcQVB+GmXJzNux(D9&J zdof>ofmYN|{RLWZqz;07sIP@Oh($VcEY=1~^b*gKD|3?xrDb4tCZQO!RD0piLvJLt zoHr54n@W9Dd*!1vVVP>;^fK^4$)DZM@B<^^A1SGY_wEyp*5)H0x#CvBXCnwwLFAQ5 zMzvh8(A2%nG<+<{wNf!#x-!{*&A=Aizlk(*%=kY7Rge>Z;?NuuE1hF!6>Md`Xc;(M z#J!EyXfKY@UbwAzNV%;jyY0xk?Z~HN56fQ*72J31z!ohOC-+8TELg|3iV~UBi#0Nnt*l$*2kq4dqs-z>jAc7 zHTGKP15{++pf~7K*-mk${zkn~Zvs$$8@{9}3?0=8`UKq(J}lhQ1-!b`0X`&L3|pae z70PTI^kydxV>?1_V-XG`g>M5Nl_tIfvf@Xy!+;;#7C*0DJ5{I_j+8($Z9Bo|8&QiN zb{3St$Dpa+;wGKgkQ%$~`*fsx*{53aA!}L&7Kj*yO1n|0tlB}^s0quI(4Y@$l2^f3 z;f|_GBXIF1?sWLJH}{O0{>*4mClYb)typ9fMoyQLI+)#5 zOg9Vpn{gC4_YC-FQ*3^HA{qVBM$5or{CTN?AB3-3F*_G>zQoT1Z4I^$2?aday!14l&<_#%6TEk0qo+|7}D z`9MB*m6}85)Z?@Fu^GSz;Y9azmIuFYs=Z0efSt-Mk=-1Y*u0T4;lhTWD$m#T7aKG` zVKbLVmug0HYnQIFt%7+lN2230E`9Vqv7+0Xo)Lxh5&gMR{yb?JI3|AuDf|^aVQ6w-)Vf`fuy+ zxFFqc(+HHzQFEateAl5D>G%L&+~RsIiuj9leqqLm+$H)_S4UnOO5aQKt@ObR@@8aO z2I@#O@4wEMj9(v>4e-hT_^H_l)K; zoj%};HZq9XvoVQgch7dU?^LH{;P`wDDABG=rVo2kg*u6mmvq{x%i&u76T98MISy>KUB?Z|o%c`6#aNK8oXB+oJYM~fIiqD@oruw>nS6iROl6bN%cVL* zuhZEe{7QAEW576>a-l(uScqoR{dEamkj$q4V63-azZCTMYQC>?30vhddoFT&XD55< zdL0jF8Q2t0vVA*?cYz`)`yH8GhUPotVY3y#?gkwdH%9i1nsHz9qh+9RUm6mPg$}tN z=zJo0nEz16i<`8;&H842O97!X@FRVzgH-eLV;uy>1ovdPM!wNI7xXqwU$}m@x*fP6 zZr96ox^=yyI7{u&1X>187I9C~J9H3t>O1vMT<{LVcK*x7|8%24en7%djFW5gVHB^; zhw1aBTO9a&fmFWB^SXj)@ncuaMx6j|lG7 z_v)Q+cT=Mwed_If`aa0A6Sns=WJKhoAJRXK0kjO9 zmMRsNONNI-4xLBzBl^)0xQAlCvp6y5{x;(~6#~DJnD8?l#LsnRcuafoxPDy!A}#z< zhv5nRM9A!5|G&!OauALGNsV|)Kb=!xg{PcKR1JC5Af8DGTm4%9CIqtYFjDwT>9aa+ zJf{tw*UvkW&|sHT{kcFF&p{-5zo3Ia{fnC5{*tyZ{w3|!;@77A*ZFca>EvY{4`>-U zBT=&7LYdz>Ko8`MCrPN0rlL~Ju}i-Kcr_HS>DK|T0e%N~RsSA_Yz_Do#COLeU|2zK~CW~sCh#fa)~mYrv%31LioKc^NU)v z3~V)ux3uB?ob3uko@Dpd9})hGFngEwk2*Qb)F$HguJIPSjWz@L{*y#|T=da0<<1NH zh?1R_f%BudM)8s1$3+v>yo4{+$Xk69QS**KwgoH zTQ>QrCdSC8%;8@Z2EA=b;z(Np73kgQ=tn;>E}fY1N86poe_!WthC0HX=5X))VRkwm zX={bPk!wk)Hr2anqS^66x%_uR%fL1f)1!2-x?@liO{Q4^pfi@5nNdlI7obZDyuu5fIsZT|Zu)Dg@u- z@h6=xyrT*4>Qs2gbqy`pF==GRgwir_v50ZgL~UfRr!ORVPiG1m>H9j@hwe#e+_v2)pZz}Ou6CyrZWfpw2uBTCdlag`99JgH$i;jr2o+IfR=&F zB-uZ8y!e;SE&fku4%{7|=pf?UO}WnXsW!k`pTa3_IqP6~(a~ydFum?g94!Oe_f*TBtZZPb&Q=$zvsIQibb)$_(baN8=Cqp? z4f|O^NRC9byVc$5VfD-zdO-FbP=g?RFRPc;8}5Wey`jF3l`g#5`dUG_J^ERQ@|Zx` zaNFO>Yvg|L5Hr9EVtr{t$E^WM{%(g`LHK=gDUYxU*mq|j^^r5uiU+g|+!Rl;OtT~&?kJ0p z$YZosK<;KB(X2Ng{hs^`%)V5cmVsNN52^Va0@%qItGOV2UdC8sbBOSoMmx?T9B3ti z@!dPQYv8L>_Rh}Z={oyY+$aMr13ThMm&-h16BlnitPpR;=-J?xnfUjcD8`Xd2XOy@ z1@hiEJuP#3_UfY74SGtZpe0^S*#1mcm+Ce2eAvfZh2YteX(E>XwHtNQD>^U?gpSI6Xz#wG7O+$x!A8Q3Xe z6dIl|xi(5(zfbav;Z}c+C~|nFfV^t zHT)jlcyI1Rk~hYmF}3WCPgKRL_r|2I;rH;ydvhm}yfOZaiDX&^9yDfenncCCdT$K= zj29kKt?~eQ=X|E`xTiSWV#m0ZjBaYQ;)C7-iZ$`#gBd82G@|!Y@}hXEN>Qc*BYQa` z8DFXC)&zO!T`~woPd6WoB#nvBEq9T+sA-mRJx>P;1LnM z6ob4PuawG;p9=6s_$7Z^>B`~%RG2LOdg;ljx=$}#I^HsZbYi0WO7`YOqxWw-D=p*` zkHdJz$(ee=tj301^6tF8nMlF<>1wDdEd!4wYQdd!&z%(RE`+C!MM_1Zj4xG=kIA-^_b6Km98)v}GHXQ|V%?d38Ph^q~8<9Boq3Pzu9+kRd z3w)v(h&r43@RJ_HYl$^iG`#Ab(dKH5$@0cEQd$O{jw@ZR@+6vy=J(w)$vR3jip=%N zs>N#y?=jvQ`OOwSqP=WcY*GkGmz>4{~~_{9nOu?R#9<_ zl9sJXTeoT3u6>7&ojP|Z>)LIfNVrzw-VA2JAm@(BL6MhYmepSjF%WBS(!M zGj`m8<0}uEFmckshfF?n%G9c=!=}+P@Z$6tGiS}7IcM&?c~ys3RUJ`1f5DLp7cE}0 zblFiyFJED=oVhCfTTS{Qd5<_|^%}m_*45P?d))DBzx3sG>o;uNG$1#(6B>NC&1v6O zt!mtI;z=i;e9Ea`Iqj>bf9;H~pILp@+28o)In~Z>YxTFzJ+J!w>I*>nHr&6n?ZWRm z2HafK#5FM&JGV=!FKyCzneXxKGOs#k(&ccwqAB~8S2eMFh`Bn;x-+l2cKdbJ-><&@ zh8utI!<%ltC7pCXy0yCc$G6?SxY9JKWPfHM?Zc7G^g4~x(T;c9HRGV5C1vb5{mkakTrWxLxYx%alc<0dIL z_d14d_7cOIr8=KP1ZDUpGKL5>AYy68_9~M}o}>@88iFEIwyABezjKWlPD3fVknf!D z-}#;2`OY~xcWNI!9|{Q%{fr4!mnY-8aZZ?&bj4|&?hWnkb~N$TxTeaYX^i!TB%0n% zMD3BZtPCk}Js9En;GWQ)E}A|_^kb9YCqLa0rs?O1DopEsh$YO%L``WjG(ppQG4|Kf zOZ#`NXDnMY8$61^3;sa(aAdDAqNm68crtiU)s&1dm`ucVDK0B|S{Mxv1fzy2t7)OT zE7T>ZDM>SBML4Ub`qEiJjcav;Vv zr<`u`%ow`MJb|dD#u@0*T0LKEzMhJ%r_yc{#Wj;A+y*sdO-;BADyGJ8TU;(FyGgE> z)R1Lmj1hJ7jB2WLJze}40itST7|&?!j2>zJj3yJ3acZ4y(arn$WJA~wnG)r&Y! zwY_)o-q$M{!9KCKt8cyUkBH|&(Nl4!hW$WcuUOA|P^2`jpYw+{SR>KwOYa2^z567! zh_S&}V!p`mz##O2a4hU&jelThbokhaPdpHfdLi^)D}5|^JsZf;hbrAc6JO2;3OD%q$`aPXe;eUu`TSFz*7tLWTPss&4Gsu?C`SM> zhpfWS*_9UV;zg)-=hbV7Fitno{{T4w`u8DkA$;%V3-E9`fnk@691I5X8qCTeG;Fqi zP1TO9R%B&MtH_HY#j+P*n;mz3ok5d@+v?#SC;Ss^F82p!EcAC;_7!H%RAC}_b3Jz> zoANfiYfQP&C^SU-FYyUWac`z4rQ zx2Znn3>=kb(X7GlK%~=OvdBmA*84Fm3X4&@{mE1g9l(v`46`_ID7IfJXOS=uN z@)4RfNL_7|@_^K(|4U&9vrejd=0CHr_@fw@E&Z7fR1aG=<85vO+kTV9w$@{z?5g)d zfG_jkWmkRqfZ1An46$lQ@p0C*MGAMa^LFkoclr9VZSS5taY{UWvP2&|L5qpwp2bgM Yp2cgB&mf;ezJPoMDaAZgz_Fpf0D_J`P5=M^ literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/pcre_version.obj b/3rdParty/JCL/source/windows/obj/pcre/win32/pcre_version.obj new file mode 100644 index 0000000000000000000000000000000000000000..84d64abead2bebf77aa365961409cb502c6a202f GIT binary patch literal 2310 zcmb`J&5P4O6u@88FA?^zqJnzK!NbDRkXET$_psTt){jGL8$mP}(qwi!kdHE%xa`e? zhkzGPB7)GXM{j!+{6{=2qImQVSl`4bQt(hRkV)QTct75}k9qTA2YQ-juRMHCnZIxu zKe87dBl)X!Q@hsACFeO|35_GogX{tTY?`r8hQwv6xxKA+wXP1C3Gl59`RT_i24uGY zz6+_nVjoWbZ(`~#v^iuw)cyJF>uzTqU9nrCJVE6zjZ4OTvuBT4e8AjLy+Z?%*n@E9 zGSBr1i|vWgSEoGnX>7N3O}A;}1*uQ$LmK(DNlr*(;`P7l+V#{=JBJ2>@Yb|8U&IHq)$ literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win32/pcre_xclass.obj b/3rdParty/JCL/source/windows/obj/pcre/win32/pcre_xclass.obj new file mode 100644 index 0000000000000000000000000000000000000000..65afca1c8a1a88744386620f90a7929fa8dd1ae3 GIT binary patch literal 4077 zcmb_eTWlLe6rJ_1?L6FWnl>Ud&{`0rN>#0-p@qgNt(_MkM0vZAxLrBxZDPr>qxG&z zkWdnB4QU-zK2n5$NR@bq3WUT@_~4;z{Xs%2@c|#H@)0bjHJ16|6_N%i+*z;Pbx8!l zEBWlsow?`u&Ye3mJ8nlOY&Q1;KVitndq+IHFzOy*c}{s8dD>P}t+bezSidI}vax8g z3?a0qKIr9|IS+5GKYZAF+;+SQO*#?!DG%ZP&ng^f@&rOj+^T*cIxx2nP-I7JLuj%V zxWApdd-~{3xOlFZ+y&$xO%FSstFLu;@WDaeGi+`0`MHq0ad^PPvmP(U2i;wc25Yw< zdVN86b(O8k?F+De(aX6n_yXSGg^-)&1;0Baczpo@i?*wx&H0NCbHiA%Lsfh>e?`V0 zWObf7D0=)#I`xb*B=9=N35veJAQtUZ^VyPrJ~^Hb1oaLSwir94x2WLt`v!CtWdi46 zx9FTwypwcKso?c;=W(EV)~Mg7Y)>6e5m59AAslD7TBEJ`*XZy7D~yily-Z9%^!s&Q zdIlCr@7Xg@PwLw1xbL$Wt%r5Ocb9#q_YVWt1;+a&%?nH$R!uC@RG=~~Q zJ~uoG8tBbK$jJ0GzR*L}w>LCGyTQ@ppzy=g(A?GD+d(nT?rsu*-ZG=>AD9ROQd$U6 z#!SmxfY93}WZEP*4QQ$zl`;&za2b*HGCaoyd2a~q(e#A`&mdR*&#t2y<_I&$1#lH3 z^u|7fh+U`Cn&~eT_&7n=D2hO++jXWh^2@4$ps&hOjJRZ}{2F@ENd(VVj;$IDLRDm5 zikZK_z2CB8TY%?KrxyZRH8|aHipe^07 zCZE9Xb%GAtK_k3MUo3@p%>uYhtj~ceJ!OK9RoN<*NwI@9OPBY{F_RQOReaN#{29hq zhvJ5JVOunwLDA6v( zNI6!XWtD1Kssv_bB}i3*O0_}ODhN+7D$epBWn|hF@(lPjqTERju z!hl-@8GSO7p~@9rb#H5)(VBa(pr(QTUxUS zh0@xt?bJTZRr_=cwMVfUNETtq;(wDA&)g3#HK2{GRoJgJ@f0C4X6wkr5{*nn&0Ojs z*n0S4h~eWbyg-M)UEkaUpFZYXe-zDhq7{qFuyV*nt{ig_D~&zGN(-P3&?yvwJ@Co3ai@Mtc=yg#j0)>bE2G&vP`Tzg` literal 0 HcmV?d00001 diff --git a/3rdParty/JCL/source/windows/obj/pcre/win64/dirinfo.txt b/3rdParty/JCL/source/windows/obj/pcre/win64/dirinfo.txt new file mode 100644 index 00000000..11d5a1b1 --- /dev/null +++ b/3rdParty/JCL/source/windows/obj/pcre/win64/dirinfo.txt @@ -0,0 +1 @@ +This is the directory where object files of PCRE (http://www.pcre.org/) for win64 reside. \ No newline at end of file diff --git a/3rdParty/JCL/source/windows/obj/pcre/win64/makefile.mak b/3rdParty/JCL/source/windows/obj/pcre/win64/makefile.mak new file mode 100644 index 00000000..91219892 --- /dev/null +++ b/3rdParty/JCL/source/windows/obj/pcre/win64/makefile.mak @@ -0,0 +1,107 @@ +# +# makefile to make pcre .obj files using Microsoft C++ compiler (cl.exe) +# +# if pcre source directory is different from ..\..\..\..\..\..\thirdparty\pcre\pcre-8.31, use +# "make -Dpcresrc=" to tell make where to find the +# source files +# +# Make.exe needs to reside in the same directory as bcc32.exe. +# For example, if you have Borlands free C++ v. 5.5 compiler (available from +# http://www.borland.com/products/downloads/download_cbuilder.html#) installed: +# +# >C:\Program Files\Borland\BCC55\Bin\make +# +# or, if you want to use C++ Builder 6: +# +# >C:\Program Files\Borland\CBuilder6\Bin\make +# +# or, if you want to use Borland Developer Studio 2006: +# +# >C:\Program files\Borland\BDS\4.0\bin\make + +!if !$d(BCB) +BCB = $(MAKEDIR)\.. +!endif + +BCC = $(BCB) + +!if !$d(pcresrc) +pcresrc = ..\..\..\..\..\..\thirdparty\pcre\pcre-8.31 +!endif + +# --------------------------------------------------------------------------- +OBJ32FILES = .\pcre_compile.obj .\pcre_config.obj .\pcre_dfa_exec.obj \ + .\pcre_exec.obj .\pcre_fullinfo.obj .\pcre_get.obj \ + .\pcre_jit_compile.obj .\pcre_maketables.obj \ + .\pcre_newline.obj .\pcre_ord2utf8.obj .\pcre_refcount.obj .\pcre_study.obj \ + .\pcre_tables.obj .\pcre_ucd.obj \ + .\pcre_valid_utf8.obj .\pcre_version.obj .\pcre_xclass.obj \ + .\pcre_chartables.obj + +OBJ64FILES = .\pcre16_compile.obj .\pcre16_config.obj .\pcre16_dfa_exec.obj \ + .\pcre16_exec.obj .\pcre16_fullinfo.obj .\pcre16_get.obj \ + .\pcre16_jit_compile.obj .\pcre16_maketables.obj \ + .\pcre16_newline.obj .\pcre16_ord2utf16.obj .\pcre16_refcount.obj \ + .\pcre16_study.obj .\pcre16_tables.obj .\pcre16_ucd.obj \ + .\pcre16_valid_utf16.obj .\pcre16_version.obj .\pcre16_xclass.obj \ + .\pcre16_chartables.obj .\pcre16_string_utils.obj + +OBJFILES = $(OBJ32FILES) $(OBJ64FILES) + +# --------------------------------------------------------------------------- +USERDEFINES = SUPPORT_UTF;SUPPORT_UCP;SUPPORT_JIT;SUPPORT_PCRE8;SUPPORT_PCRE16 +SYSDEFINES = NO_STRICT;_NO_VCL;_RTLDLL +INCLUDEPATH = $(pcresrc);$(BCC)\include;$(BCB)\include\vcl +LIBPATH = $(BCB)\lib\obj;$(BCB)\lib +PATHC = .;$(pcresrc) +ALLLIB = import32.lib cw32i.lib +INCLUDES = $(pcresrc)\pcre.h $(pcresrc)\config.h +TABLES = $(pcresrc)\pcre_chartables.c +# --------------------------------------------------------------------------- +CFLAG1 = -O2 -Ve -X- -a8 -5 -b -d -k- -vi -tWM- -DHAVE_CONFIG_H + +LFLAGS = -D"" -ap -Tpe -x -Gn +# --------------------------------------------------------------------------- +# MAKE SECTION +# --------------------------------------------------------------------------- +# This section of the project file is not used by the BCB IDE. It is for +# the benefit of building from the command-line using the MAKE utility. +# --------------------------------------------------------------------------- + +.autodepend +# --------------------------------------------------------------------------- + +!if !$d(BCC32) +BCC32 = bcc32 +!endif + +!if !$d(LINKER) +LINKER = ilink32 +!endif + +# --------------------------------------------------------------------------- +!if $d(PATHC) +.PATH.C = $(PATHC) +!endif + +# --------------------------------------------------------------------------- +pcre: $(INCLUDES) $(TABLES) $(OBJFILES) + +# --------------------------------------------------------------------------- +.c.obj: + cl -c -nologo -D_KERNEL32_ -GS- -Z7 -wd4068 -I$(pcresrc) -D$(SYSDEFINES) -DSUPPORT_UTF8 -DSUPPORT_UCP -DSUPPORT_JIT -DHAVE_CONFIG_H -Gs999999 -Fo$@ $< + +$(pcresrc)\pcre.h: $(pcresrc)\pcre.h.generic + copy /Y $? $@ + +$(pcresrc)\config.h: $(pcresrc)\config.h.generic + copy /Y $? $@ + +$(pcresrc)\pcre_chartables.c: $(pcresrc)\pcre_chartables.c.dist + copy /Y $? $@ + +# --------------------------------------------------------------------------- + + + + diff --git a/3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_chartables.obj b/3rdParty/JCL/source/windows/obj/pcre/win64/pcre16_chartables.obj new file mode 100644 index 0000000000000000000000000000000000000000..6af2e36839a5d59590899cdb147490c139e97fb5 GIT binary patch literal 6520 zcmd5>3w#vC8UOY!ga{#AqESG^O^CejNPx!h5H7hSaBvA}a!F7R*Uj$cvaol1?CxC% zRSYfQ3w%@&ZM6#ZnPN-9N3lw6ZGBK%)S_tdfvu=jtPN@fQPOW_cXJm=5Y4Z@c7D0+ zeE<1g^UXK2Gqd8_G+1!pf|>`00Sp4OctlMSjD%#7P=S?)Y{GsHa)C#bn&RPtIvcuq zFu)Nc)@PcC10P;+m3cIgH+Y*1u{3~97LSd3p~h?J3)MU4EOC^q@3g2#ai1Lf7FRTXvlEcyVQ_*0z#eqgeRdf$wYC?!Hm z1cm-|HLeL#s8x=NYO5Yno0f!Pf<}SjX|!5Y%n2>LX7Ejlq@>Up#Bnvj zbU&+PK~r_L*!m;kTb#B&u z(fO>qRh(8>T*A7EVmrD!$;3|yNTQ4&^niDzmNDyd$`)dg$)zTiv_s|~)uOs+N< zC=Ud%t**YNW?^lRs}EM9#w6*hNulQZgGkLQZK&XU3#%*rbGdowjy|0h)?KNlI6{W{ zTMRSnu0k9B{BIn1f3+`AUtW>_HNth}3-s<$NSyB}3iVeo6jsn^(8szLfvySQ@q~{1 z>vK$c$#fsY#HMeQrlEvTR9NUCV&=T_G617tNcOny3C@u$z!@b<&3s%jICEA(4h+nm zgiKzjE9I&rqeT@V*TNtJu^OHvrhyY^7-VD*K~_Z-ctw(<%_^rGT3j$tAS2s@Eit1- zlXx-GB#>6fLO2f{Y9+InGawV`3CI@kasF~R2dObgnKDVGmdJ{9&Bf)YQG#bpwXjG-kDpu>V9L}V!5qzU*_6lukF5i7rbSyq4&ZT$J0JDD$cv+QOui@Mo#}@FShV3{ z?$|VC*35_2-uF&GOT6{PzBK@i6kitJEKixdb<)^X!ZxWev>9Lx#cvto_3!JLle2hj zd-^M`!UBNDDE`%ZdzL(sesE7>tFS`_e?pq|MfKoJBr^N3UE2ackJw1J*su}k((p8+&Z#j&jSE^DL#AMC7Vhw zx#noLo>n#Kj`&W1;rNnqF)MaYXuN9g!-Fs1`03s5r!Kn};9`oeKeJ{1UA#BzgYD_h zKeA*44$AEm*PeXl+5+Z%-^;h}8h%~bjedYnF#h|o4TKq?n6=P1(}h0L{ZdJo3%#DQ z&?khD92JzfD24Ran1&hJ?2)4i(ekwmF`e|DmTzxS!PlFi_eX2d8I$`6O6W) z)Gq~^ksN_(*w2k49C4H)J*1-x-2?-~L1g=NOJse>Aiuc%@&R zi0cx^M|ByUScmH&+W}G%?aORM#p|0$l)6d8~^Q>XRN1Q$K zoKfepdHJIY&Kom!-1rF-C%HY73yY>qo%WsL^Gl}Bm^tf$*>k*nlYj{jZjqNPRU%O} zwoJn{GSRxcZNI;79-b_+OoeKKb;se}8`X$QMVy{OVZOf4%>uWj;Ji&7J3;zaUUmy|CuHwROSz zhQ>t~UiAOb|JmmL2GimsrOUYzTgk8Y(uMhS@^Y-Ji=^I3OW!_&X{+KyT9C2o-p<8S%#@@kl1P&KDlV>7D>SS|H>a$@$E_N4pgsCOD>9(fDK#Pb1rRr13!DGN_3GFaR;)L%Jnb*{ctI96#!N$I%Jv2@ez?m~7*9oT~O;1|%Byy;eV1p6M0Q+!tsFTDL z1M0}6ytLC8`V#^OeaDn>#Zb&1w=C2{#wrWri+W)w(j>klrsRpHz=arzY4&lvWDJhy zJ>B9x!{Q}!cHFYSnVXLqi45M2bx!C#j`j(y-ae~g#5#%WFw0&6%GO#jBjazMPD##? zn2{XGfL1don4bhQ5OaYhH4ADyYCtzO3|hOvV)O@d+c5&|*oB2z@n{qe!=fAAnGN+l zNc0SC65r0Ye0vgo8`EpQ6x{A5a9qg4lq0b@r#nuJD-Vs@<8p2a&Zgjb7EXLUac*&( zB5-&MCUNw7u)Zfv;z(?cwsdS}%)B$_PInk+Y~pA$4N#kaTdf!$maI4uJj28lg*PNl zhyjW3SyU(TxA0L>ktjACu>!&?ivlUi&cm$sXgrc^wsM2WvsQaVjh@gx3Vj@Bwo{)8e<4G+ z%tcA&WS*5+ZMJ_b%6pj@6|k{<(r?6+2p>zuY7mR3U^l&X%LVrp1O!CW1OXLAKtM%9uPhfq*=|Vf+9#W_s(Uo; zAnD%UYecHwrfCtH&wzm9tn|`!GnJ;Dt*>d`r<}v`uLvzMBEUVF_9FATa9-1%{N700 z#7OsgK&ic4@??H~`a{#E{h(>t-x-;#T1C_Rw8ZfNMeZ|9Wc0G%y|gd>Fw&(kg9t4! zBB0zo-C5!t|1#2;%TVcz^_9ugr*98UtNyoVI-dc4ettcoV+KZ!h)ao!9nhz3UT#Ka zQGRJ#_b8*HhNXA}6XK%dBZtK#6OKtuOh`)UQ99`xw zn=&7$dHG5Pqxz&}*{7sU%*<1NC52_hnfA1)xdmB;Q%lkcGbX0V%q0*OqWjCSYE=hAPYh-RoS$dvda%ovsZlPaLU_fBn$f&ddxdmzE z;bFG){47=@GcUkiZr3vNvo!z6SY|fLvAWi50^(y*(grer`_#hXNoi9;0s;ei2KEf< z?dPBA=U-5mS2&^2&p+BWG$tuNCa!0&&Ch>OvcI4Im|lMVQ?o(>!@~XiWyWUFmgeLZ zXBDLvmrgT^Q_9poJfLR~Gl@^IC8s3CMy1?olh!KV^_|mM%prp z(=#X8OSKkS1D|GQ3U>#1X?3+au5F`*_yXweMwV~wBVRJ z(=FLu#GjRsMlxx!jD-|vRkZ5XpQc@5%mqp2_(*xm;o^4wK6k{f*U)q+<3F$^-oma} z#aq+kusSB8H)di@)Uh5e!1^ee@x`6k0N=%i_$}Una@c8!9ofd6QH~#7FbM;3CI;bb z48w=97e0c0a4SaOVH||l(T=yXK6%(0^YJpvImBOxM?D%ytSNty{2g@GBljbMszKqT zsN_QpYQzSKVANK%g^SWlOYOx4Dms{`QT~Or--QJwY%E{jM55bNT6=MEVR2DuvDS=m zswA#1HA008v$IR6yizm9Gv);~L1}sh?X}vD#x@LOl=+c$k!{G~No(&2zS>gLW&Pen zS;x0g%Hjx#LOsgjZVvvk{gZJgi*tP3%OY46#to}tnyHi&Mmv|?Au%c`#ugKq6gS!y zla!Q@WJ`)k8IcqpthN2miB$Q?E?%)zy@|S)YI6$7N21Q+lO0V;RtmfsqbezIKldqI z3cNF8+zPxYbJ3|<2h>)`l%rZnQF^9b<+6woMt+LzlQVPDi)kc$eRGJusgf7l)%G24 zB`cYfOD!oW<$y+k`})34;k7a5Y#iHd8F_`7lTMd3zJGZ!`R4q{A z8?CsiKdPmX#%CSzcKjuHmE=yhtM+I$gKbnoeS#G5-Dz;Ctae7@)sJ8whMi^^0p}4TD$fy*~mh~WW7;DT% zvc1}xjiWwD{#IH+W42~n>YAOSWalByy7@@ytz!~L5xY0hQKYL*vGS2>yUUt&c5b;n z%jPI7$;x(Xl%1nlVUe2eMr*zqcB?&?{21+lcMUaX^*`C4r9Jq9zgv=k&xh>)vX39b zws->l@g#=h8I)G*2Ta9Fn2A?#CjN@^@EWeb>$n+j;%@vC-@w1{0D863^y63!f5z(Q zMG4fvJJ1_Lu_h*9U9@3+oQOVHh)q!{Omln*Z^t*W4PL^w*pjxsJr2bVScV<(Y3ziD zu?zl=UGa7*VK*F%-7y#a@evHbJ=g=!VIbDva2kZ67>pw^1m|NYuE#L^5PRW8?2Xs3 z4>qW#X?J1^?2BR85BuO<*dHUY42R%8Ou%<=I3B_rJcASQ0#3r8uo%%&Ic~)taU0&m?Z|nA_5!xU9mw%t+ld2l7mmRfaSrar zhwvp_k9+V1+>3AFK0JXh<9GNLde!8(h`#s^w!wGtX*`HK@B@4WkK()dA-<2N@DKbH zeQIgiX}kl^U`PA{yWx54jTdkzevj$+1J1-B@jkqWtMMm%4u8fs@E80PFX4H-j9qK9 zUt%A;iHUd%ZTKe^;9ock|HdV#wbu0Q=!IWn75o)%!`gK;ttz&}YS;s-V@je0lifZZ_&{ZU%! zK%9m__y7ju2JDG1VJM!$Fg%Ch_!suZ4z$jFuq*b*J23)>VGPd31e8{MIIhDncm>l? zT5TJ4!tvM}({UhX;^UZwa>kO4doUO4(qvD>`k05In2)hoh-0w`Gq4Qva4Js6Y4{}0 zKsi**#1C;6euDSmPq+kYa@MjG+u}0pgv&7qAH--}fl0U;C*tEc8`t6zdqmXV`gob@K8?RnO-kPR8OuM}^))%Z zz0Edqd{m!NojTdn#jk(gZIoV^A5)g{m*7=k^~&lqL(a4ur|7DmCCf2Cvg}j*$@1eI z!3V2ox(u&Cicot9JL1DA9lBMRgpXhfu11;XqbTb*j^kOF$2#uem>}oy_EAfvhQ(fEoXt< ztwdb3D9FrlIScG;jdBEK27Ux9J-d9IbB$0&@{x4WXk>@eN2#(AR=~(fIKz$^+0_(* z&VW&go#&Q*)HCxV^-Ah-B!7(@@txI;zUD4$O?)?Y!k19;^g2rVH*qQ+!B_Dp9>EV$ z&Q(9cDxA|DLpjO+7#rhRlm0a^9j(!i#th{)8LwXO!y%zu-@J z37e4j%h(aGU>N?2(RdYOk@FrsAOFN<_!qK|YSpV#_ zi2-s>i9InK<=nG3j>J1r$9}i~Bk(bd#J6z(9>Xa71Y_|#OvPVtH2#TWunP5HJk~+Z z$MgWq!ze7ke4K)%$oZN6AkM&NaVGA!ZFn|K`G!_QF8bvbX-Pv93Q?U9^6 zv#Yzcxvgm6q~Fm5Uw5`gj!W+J)+X4?)s=+{B&y^?VbhcK zSwX4l{`y%XrB|OZt(40%GPllFJhPDAn_P^@Q8@^d5u8aUcv;xYD5JelJ$>sMt7PCAYcgxi)a8wJR=lt{cY0G8*ApCnIdaOTqUpCiG_YC(gzCT;y33dWLQk<`#kx{oUzBH_^7Z4_s z>;k(HAM>J+F_p0z=9K~0NrsTN8Z9v&$^YAEOrkDHOjv#_)N#y{{GtVa<(hb?du_QkE3hP$vF_uyRIhtJ~6xD#K&cfr6Z{ZA#nbp1eve<{&v*f=QAR&tOZ*W#<7JG(D;SU0FbA(=8Qws- z;B{LI&V8{uK8N0T6>H&NSO*(Z0qS9E^u?*z0Pn+wDD8A(dh!5RS$$%*9@~48w6f-i6O&1j;puDEt$nu`VrI49Y$_ z5C`HQ9EpQ*2FBt8I0PTVID8R@l<2OeM3Vk%sGU+Ebdd$4f2dsSbA`f=I1(9 zLVS!ZIW~S!9QUXx_{gY~m?REN&eD%hNHI2vYfz@DWIKhBC)bUf6q6Venc|VDkPy#I zg@kw(ZAeI<*4iZ#2_sSxN2Hh;bl1o!r=Ou@Z9 zi#xctXK@Gj_S|g2y*)QTaBt6b4esr^uED)Mt5I-xg*=B>$a8pwJcn1vb9jY3hgZmR zc!fNNSIBdCg*=B>$aAj>Ijm4+gDY(L;0jwlm@V&KiGwPXb5MnH4x&_DcViyliKU9l z(>R`Ut55<#6-pq8b#bkIG8?I018wR~W7LSGD<3(K`Nc<7Sa8n@rip-@gs)C@GuJvtaCYS zT#_ZE430@sJGCuxAdP@+_=uRK(R2u$`HYKa*YODS@(g%hBw@etn1myo`%FEr-muen zr0~3q65303Yow28bW9v~!Ofn@DMnQ6x1A+gq2DIwF_rY&V`GS zqeG=}+Tz-wlEmJ`9Q_Grk4<`7K8$edX*H9SoR}ndIeS_yNtnvXrqM}}^Y7fkvJzWn zdR|^(nbB304w^AqbuZMdSGhecJvk#z|EI_bOQ+8Wm!waz+j6GntL~hf2^-loyKHh@ zM|B-Jt)L66Qb{k<=s^{5Pu47O>698#S&~Gh+tA)+jz#wLQd{Y?BIA~|vvVuyS>BZN z;%V$AzP@r^ZsbC)bG0VY%!*7Xw%fC&*$N5^==Nr(m*p9&-^fZ}Z6~b_6Z%;3^lYA- zu;r&0@Cce!a?+KrVN_zugL(>C?+K zsheA@5k{T0NflK$#8q!|qcvKJ%(;PNo!2qW$f)YStK7CCzS^2b&4)`P?$a$|{2EnO z)DfFJr%=Kfuv=eVHm0piMyba`r8<;bOH(E69Ba#96RUMEvXYqlnOjG?-W>XBQ~^Gc z&FxlgFlJc7LzH=R`{h9mX+Pw)vazA1l2e+-1pyhg(Hd1?pTOl?n^F7PGU^#?R8e6` ziM^yGmwj|{S$aWfZgwsYZ^`CgXQip+!qF4fNcRgztDW((472V^W>&h6aF(>xlI7MY zb|7jGEm%{f!;*XrP6Wr8PiXqAk5ppt*cD5EJTQpsg;2d(5hsbw}tZ(BjCN^ZHM63L$R zx-~|U8xMTBW^ge%yUN{1K5`)9rjnzk7G?5p<9R;U^wn9JL5);;Ss{67&~=4eldd9F zAGsoHJSpg7&AMF8*)^#&9o+9Vlgj0OV}Gfbv=u9K+D|2w4ER||i_|eiVlA98wa-gi z+suj?<(pOM+HK^Jd%dldkM`C?S#DcZs_q{htUQE}tc;-qFKNB9)X^)@8OzL6Mcdtq z5Kzx&T7kk$BRj4|A~W>sqLv{WCY;1Zk(5=wVdQdGN4d$v6>!q`bk3%OzTiVErNP0WGZ@YhZ^ZpG|Vx?9JKifA?3*k+LecCjN)Ax`(7gB2{{+mNTvNS@t}>N#VH~ zUoiVN15|P;+C^4gcoe!sot#NU(5-Ne`z7HQnDSX;ayjK%Njjs#sL35!lrhV#G3u<( zCG(y+lExt^+FF6t)`XR>z_*O|iLq8-BZEfWa9e?OR@h?&o?^9k+W3iLzYcg z)!E4^AF`V?V@|Eqk+!h%_Hr}VQcp_jXB@>NWXY<-MROrfMN4_fZ46^mm*f>1p+G_& z>nArg+}BUKOLE!Xh#ITX-Wry)Lc@ZPur&+{w%aTS<+r=9*NVJv^VK zl1lxFvyx_&6&1)fa82Ba`QB+)iDlC!T8T6H5{BpQzn^qv*($N*HS7hShVZPI={OQn@UUS}=Dc|Id|bc|Ipz6vLsd9@YuJfD#a$vwEi zUDZt0|Ky&56x={|*1nGTq`EvuNGu@tn2TF*4emm@$F>JA;8B#X{2j;oY`~K! z-@W(*yWuJ9hhJbEev4D^9L~q{xEL?tX1t1@<2C#Nuj4QH2ezPetJKqU*=ehyJWEj> z)3FB17WKv_u_ms?+PDpU@HK3LZ(viDXD6DYJUhX&hw9mh*4T<2pbhrMb{LKAF%@|> zQ6Gz)Fax__K6b-$?2ZqkKR$&$@CD>qM*R&8#&Z~gKVm-|&i0SMIXD29U=%)w(fA_9 z;=4E$<=$Hy)~02Q$JWw9VlWQJr@4ofgfC$VUc`}j8Ao9?Z=MxF9~_TeF$4Ktjh2Zv z%*HjChubh8U&jLc7z^ZLd1E*si&c!mEhx2d&uEvGlE)#*ug& z$KVOH;TfERU*aL8o2q|_U*S*qHD1B*@lU*j-kfP)#)fzUJL664iMMbN{)s7AwLaSe zYa(rdRvXy|wZ?b_n<8~yYleZ?3j3fRj=;7^ozdDM+gfXn@?365oQ*+9p0%F%BZlJN z7>+*lX!{`Z)OZG0XCB&J*bDpPAdJK$9Drjn3Mb=0T!*C5H(@O9!6CRGhvNxkTKz1h zqV%B0U=PkX?#38op89AUhvjI)S(t;%FdyGRmZ^V*#rPMNqI_R)3O2#1I0wsd9!|qc zcn{X%xmg|M+eC9vp1)m)@pvz8!bP|R7h`oE{=6S=$EDZ-AHYCdj-mJjM&TNqfopLo zK82fcJ?_P4@Ll{D9>ERxIX;Jf;bv^qi05{(HEzX@xE*`r4wNeiyYOz@jgyeF)@R~A zJb-WENqie`;yYNoF<+EIAAAo>@DP^c2RILp-~~L2KjATy=XO8FR6L29_z51yQ}`i% zi9aLTR`=ln*RQYuzs3^$4rk*z`~uJ8CA@&Y;g49O8P5h{bNmUr;V&45mv9VT#@ToU z*W<5v0I5s*5BM9_YtHcrgYi0!#2Yvrf5$cW2fm3n@f_a5T3mMV@u6y9LzK%fjWGtB zUw@i(8!tM~YshUGJrBF%a`eYt7=WjceM!HCf#}zg{T-t*7;~^EF2NAo zj$ybDd*Rm@j^AP*^lrs*3F{*Jq~03GU=ZGoQJ97!a4b$h8}gkOZ9J~RbmY4oS_bl+ z3oQ@7!9tX4SCg?h7Gpmw#ds`3p6S=7AkW}yQ*jQ`Cg}5U8m`2dxDRO~^w&_wLpTS2 z#<|$QkK-AJ;d~r}3vf2xi;Hj(ZpX#A1MkO^xEfF6I;_!#{TZ7e&ywhE@EKf%|HA$F zEPjg{@G5S^-*G$EXv_YKjgjwh>bK*I*cEreLOLEhq^55WGIff1O6QMeFea3v1JRmgWg^gTEf z4`3V~#soZ#!|`uSMz2mh8-*QkBqm@gPQ%eS8^_~%%)~8d$CH?iT4#=HSOq6y7o3EN zI19(%J!r#~I2l*rOk9Ka;(B}qpTP!QsD~&QKsR82It3DDFqT`=Y;w$M76}j6dRMSfv{mpRpx=j;--a z?15*o4}OjP@d8fA%eVlq;B$Blcj9&Y3~%7)_y<<+&UsS<8$JJ<$&%k>|j)fj9^U<2@LQJ8%f@!ZN{bQ_& zBe5x_VjCQdLvRenVH&34Se%68a3$LC70kvrFb99YT=ebD`31JdQsh}SZ3^0OD&B+B za1PGIjW`Q;;63;$>c~q@w0RhS_u&BK++I(^2XHPf$Mv`ZpTU)Q7$3$H_z2#@)!6P% z>OJPwa*f*d6oG zAD3bPK7~DSGX~)S493IAcOmst7>a*j1j^m2D6A8~^&Jey7#xiQF(2uJ=?~yw+=RpM zCyd8GFaeuI(!OJ7OhbPhhj*eK#UgwU%kcl1tkPvJ}WDIUSk@GPE2Z4mVw{qPKSz%OwueuW$G zYkUj8!GriMp2F|&DxSmN@kf+%l?3M(6=$| z7B<8V*a(Lp-?`Q2V=H_HTjO4AkFR29lv`X~@eKN7^&!-IY>k1~27@sYLvT3uMjJ+; z-18cM8!!rYVKjb&F<5IT^&eZ|AnbvIu|LLQCJw>-a44?9L|lhSxCfK*Adbdwa17o+ z8`h7bzlgq=iybf@J7FP)ViESi1t@ph7Go+d!9%zVf57F~Xc+Ys!|)*-f{)-tT#fJJ zWB3(5j@R%BtR2sJ2>Rh#48?Ug1fN11uE$b*1{dSMa1B0-J8=UZ#OLq~Zo(_L8EYhP zK7%cAD+b{<9EjWTZhQfYkndRQvv3b?!M*q~?!)u=GTy*f&^wXy9qf*;Vluvl6YxDO z!bA8l9>&M;IBrC~yRGlUllUrrg2(U_p25%YGJb(6!`VO3hF@a=euH!ITU>_U;Ujns zH{*Hy4Y{_YH%?+d!7g|Shv8+Mi&t*Ff)!N;)yK93FYD{PF_QaE42Kx~S^*bMK%J8&iX;RbArZ(w^oiXHGc zcEan}8T*akxP$}HAJec0PQ*Yg#9&;3J@FKV;NKXEZAa3-z`L*)+OQ9%V?TTl@4{6W zftxTA_uv4069=Q*uuZ_bMzJ4a5^_yXzZX+*6^_Jba1=g=qj4*a!@bBgKmBdY!c%C+ zGdK}1;B4%k%JB$;a6S&e1vm^BVk+K;({Twdz@_*oF2ilO5?{wvco-kSZ}Cz54If8s zH2Wzw!Zp|g*I^rc3Ul#UT#FlVCq9R7;3hnP+wddYj=$jx=s$-31NOpQxB_3qXK^=f z#+UFg?!$I>v)^Ga+>bH%Dh|Q7a16eOImoqAy%;}09gpAw{0KkAV|X2pW3@E)N34aP zU@JU@?eHt?gz46os0ypGQy z&jjf^u?oI{x8Y%|iCjFl#rLo! zUdGl~#m0Vy^|2%RV`q#+e~iK&I0XZ71_q;!z3_ev$EUG3zJz`773_~6Vg#PW0a$fB z$2+Wx(bxb7VoMx^p*R@(;4sX@L@dDJxDb=@F-*p_I1)GED0~xB@g$DMQ<#SJ(&^7& zLmY>l(1xKn9{XSh_Qwf01aoj4=3*vtja@InLY$37D33rCfvJFdhR@KM}} z+wnzw2Y2I9+=FLuFMf@O@jQNjSMUf{w{v|9(Z6g+_s;wjvZpW$IVjmPi| zp208i2Rx5g@du2^=DZOH;3dq!%QykAp*%%$0~h1(xDRjQ`}ikbz`yYt@_fC16TR?H zybbG4p#OyaSPg^G8;4*`oQ$>bKJ>-)*Z_B9Lwp&V;Q{2HjQ$a}!{4wy_RrzChc*mA zd4wex%P|BOVkq8^y>Kn|#^Br<1rST2-jg_vVS9W4!*MyL;tI^hhj0?E#C%+ZQ*kvuijU$Nd<=Ksleiz(;2B(t4f8m@ zVJCbVL-85xgBvg!pTl_EjA^(9({U@##%;I=U%*wk10Tno_$0oF8}KE30r%o-xDVgP zSMV!*3xCG9u}VJs3;Nh=hu>nO0*+(Y4bNjg z{2u4wZ@2)j;R(Ef-{9|f0lk`YK8#hcO(FXMhGJEWz?wJ$YvCC5!4mYvdDsv)V`FSn z#PJEk@OF&HJFoy-U>SJ*fW}pr8aXik!9DE2T;uZV5mvFv^eyC$G&cS}T5=WKNu45WLhSTwJybqtmHMj?hV;kIoLHH6z<6ex%moW`r!E}5T^Y9%kz<046-@}D?2=B-DaVs9f zSMfN$k0vreIUd!DcuITjHbG8TVrs zd=ta)81}+i<(w~J3*?@+-WB^|INpV0us;@I1kS)n)G-<#!dTpkL-1{k$77g)XE7D8 z;N4h#8s|Njh*@|y+A$k*aXC)H$1x8tVgc5kPCdnNEW$LLjOkd6Wmt;yunZUBR9u16 z@L8OWn{g)Y###6>&c&lR539|f|ANhtd;NMRycfIUVvNB1Fb0?7D0~R-!-sJ-uEHmA zHEzVmvE@wqE!Y;HMtRurSsaAVVH$42T-=PiaSNWo=dt%J+HthuE_?`g<3`+rdvPzm zj4$JUd;{e{$#<~cY_6waOMDl*;z3-C@8JPFgg@aIcm;WeL2q#n^&Y$7H#i8t!@Kbu z>UaSc;LrFz{(|jw`t#TY|G)^miFe~I9E*G(OV39yEXUh$7S_c@SPxgDFTRKku;Coe zN6-&%$9%j44`XZm4*js&T-sM`h+VK1cE#@410yg9M`AF}!4P}```{Yvi(9ZC?!&wA z2=>Qo7>zfPXFBwH^JtgR2jlUw#`fpW^Br*BUL1#r--Zi)_=oYamlvh;Mk41sjO870 z;pSL(c`JoHuN^_O8FS#Or1F5d>wr9AedlpCi!8efj~1?$t5@sgJg800KBo-0-lEc23H3n1Lserb^>0 z3i{*tDQ-jFS)+e|JU6SK#xq!r`G1MBE@x5Jx$$k(LyvXtKnCt$oS5lc=gb^?<|G^6 zluhRw!Lqs=NmI#(dh+jISK|InalYN}5%BzSc`wf|m-q5~@n4ANSJ-=ceucfK=RA1N zpZe|!E6~;0D9#sy?IBpn7tEzvzb>QrOYpM394ZfaAGE^eHyI`Rp%u+7F}^J-^&rHG z8s9Dpw1(yD)AF#t>`{)IQd+E;b;nq2uG@p}O={6CVsrA5wTVV&?(D|?8DRy@2hb&{ zR3c*;m3$d8m67FD_@D7u{9rU@n_2O@2WuF)om#|4a+-*)wcPay`gF$0gU5WNC6T54 z<7^kQR@vTG+VT9$EE2a8*uaSAo#}EIbepH=Hwq*VeJC|Pk_Xw(Dx{Zb_*~&{PgVJs z@sa)E6#rbw-xf#wZ}ubESG;cH*o;+hH1b|SPVzmLVa)r_QhwgAIcY#1|V&R#`jV5-;ghx=<>cQ z-btn2J2)Hz8BW5xFd5~&RijXzoliyiZJRtS!+d-Y3-M7b!ZpY^UABHXp2unEL)lEn zZa5Qr;w%iudoTiZOvJgEit{lW7h(b4i?eYtF2p6c442|2d;oVLdD36O75FNy#BcCn z{0>*)FSr_OSEJ91ci>~#1s}%%WL@+`T!-WEDa^!Ya3Vg7<+uT7;U=7qTkt{LifeHj zK7%jdUfhKT@I^d~2k=uoh~MBL{232pEo$8d*a(ke3;YmU;W3QDk1+<1V*;MUN%#rM zd$msCV*C`B;b~ltXK)*SfxGZ5zKU!!op)?%-{Y6~1D?kpk#}Zlzu|Sfh8@{;uj3HB zi3wPxD&>SV@I9=FA7L$&U7dGM>ebmj>tQpjkHfGLCSVgx!R9Et`yE({EpaCDy$fA- zZ$Eq&+u$eI9>2#9*op&W4@|*e9E~A39>efa?1dY!5AMRgcn15Se5c?pyoiJFDh@_z zCWc}P4#RAW$Hy@l*I^3&3)Ap5e?;oK{uAb4_1g47&=;xu zdPAIw-Elg~JH6Ql^ens=i}8M3j!W=yT#lRZLEMHbP>%2N%_x75(i%%Hm*+M8 zs%rJ6%^ysenI9=DY4bbs*Vhr>Oxa5LJ&)aRJI3G(I2?DP4LNq`6LBBP8qiMZ3voZL z#Me;H)%XsO{vN)GC-5!&0^i1;@E!aG58zFF7i*B0_pv4(!G?GgZ^vUO=aMHe7(YSD z`=>YrPh%Q>j?3^2K8#=DEQ&wQF;Ch{D$`6;%in`hL<3AVf?K5n> zrI#0JQr*I>kXv<=dcyI-QN4KQsj4{y%n0vXaXCMDUB);*vQAQ08uPcy5#vQdx~ykS zY>l8P`}YMn3^dtfpKqP!nD2&L?UQMS?d{PD^rw{5hFnB@II{vL2{BlT`{et^whU~HUJ zMpyD->2iWKo>5kJQMOJF0pm=sHHRH0br}*>cFOEO?461HyyTK^?e=G)IGRj({ z;QcrPm*OatvPwlMQ`uKM-#0&-1xVX51?9H_93Pi5wUv}*{D(HUkxLsqkhe10Vp3yM ztOnS4ixveUWg_dpnuWM+f^`HuHo-@HZJyuLMffV@b5~;45X6xO#iB>A( z#lXgI(o>NUA885_^kCbl?y45e2 z_Mw?EbCp)Mz0|Ss{MB*9IoDLj5*x~~WIXo9bd1CdjKv8!1}EVREX2h)8P{SlzKhcBrd66psH5I zE?6B$pf`@enm7sRd+0@2AEj#h;sI=cC$S-Zi%sxXY=&|^-yB;YeHA?r>8t4R$oG%+ zG-Th^)3H5H#ttZLUq_TSau#*qPLJab?Wa2KhzZU%l2(M*Q)Sp~yr7_Tn!Gw(-pDPd z2dT`ck`G6qe}5s$W32mSsNkNwE6sVXYrJMQDlRfP*?euONBRm^n0nJXIA_2wMtZ(^ zG05{ORgmYkFs@R$|E6TP$FS#bOon=l@98ldY&Dif%V@pLB!>btLi{j=ic0faMAT^7 zq`jBMuAGQ28Wj;u<&!|#-WU2`KhpA*rmv-85B#{Z__^sOMDE{5vn3>kHrg1LN24$@}-~-qd z<=mk=?n8e(fB`6(2}fDA{wUX+BT!xmAB}RJ7K8HpmIG1R-#C;@U-2mC<_WkQhok&% zMKa1c`UrdzN8-DfhQHuAtV^D47=-kJ)w>qbaR9?PI1wkJy!U((K8Ab`Utf!*CIlxyWl;@wJB{5_Qd(fH6v{S+HfIG!9_R^7o%J^T7pmFQe2NKP}=Dyuqrj> zNvw|Rk!t|jMjVb?k-oOJ6UX37NFQ0-hb8zK(nr?5!)NduK8HW!$M_4L!W&3`Mypke zXESIQYhyiZh~d}>`(R5Pj;$~m+n`+k>4F?{HGaQKFU9UC?bm1g_4R1KbhblX;$ob$ z{Zg;#v&oD1cq?EgF9+l_C(F2!-i*|heEwqt=H51V{xD5QrTe}g3v$`_<*ZEhO=CAv zzedR`42w%0JBOSn%PwzzWSveiz@<>@9z_vtxvXyq4#RRBhtqH_PRFN_>r?u_@E+WW zi|{ydy-GicOYjVG-Aex&`HebN#(Vg;=R4MU+(I2Aa`91T8M_}N)WJbku96RBE2oXp zuDFzjT(u9kLS{=S?N*;H zVCqschGS9k!*9Z=>j-f;g5hD9f$^Ay2`KBGh*Afi;Lo#vE!ULm5tnPssbt&nG4A0Q zuO2L!R!~a!Rt})D%9VU5Bl8^GC?n}n$R!Q0mQ2T#CE! z5quFJ#oZ|D{1Qsp)T5j{_d8!=a! z{W{~lvr?;4i5V+y%uZFl@mA2>$D|mneN6g!MFfm_SuaPHqV}`GQbS$OH{NAT1b=*F zxq)ab*YP?ybF&yT&2he#%(!l_Tuo{GPs+oyE`Lt>Nf~jySC#*l7{M^V)u^rqeveZa z{sC9vMcjm357xKfFSr%2;;VQK594+G9sfYN{&y2)JKRFqUe)u;)HpY}2fa|X;}ZTnx8pQo z(q5MHSK!0{j8A%5X`%IYY}xC~5gs~@cHV@IN^PCt%M{MWU247*g|&Z~?RTQf3?(m8 zmUIKPXh)oT7rNxH0d__1Vdyc~2(z#;7Ge{Wb!dvRt}pQC+5QeCCfjKse|gR|lHX6s zv&)N@9q&<>^_9$4@?m}DMc00eGS=68IkYvgS;yShJ&*~kb(gk5=516%+H3jcYL`Ak zxQujsB+pVNRr%}gi21XQvK|508+)LvQ=ntrzv18X5!EvIr~1sG9!T3U1*bdLUGB{k zny-ho(es^PoH)u}Qpv}$xn*t2s>`88owCT@B6*hU%?VyvsvVB7k`$^m(l!rv#?--G zrjwduOqZ$lSXobFxWHa+ywjbCBV^^&dF)ywV;vt^M=2{g-p_QzhEOK5-osGx7>{y{ z<9BTJU6_Qj&n2TY-y`rm@?I`=Pa_pmnD1yDjdx=@2yUo1~bD-KL4@N^tkTeG3ef;_VT=F(983pL73++JcM~Z z4HN2lB_h;wl2Fg3gjSe`=VC)WuT_M4HvS==OW`F5?kgAKdCjD!=OjHnm%=aRxX+`) zlRZ5>e|n;)=i@@bp5+njxmYg#xGyEhGewYR0dc9uV-n9}pJ)H}eTM)nd3F(d7j8zA9=@l3%;)YfUfjBDL<$sm8>0vK^$G zDhDABD@+!FMw8^;{G(em3!;rK`!CT*-7bLTta zduaQlecOlq@KsE}H}O$?3!le#@C`hG$MGPxWAnU+z3?#R;RiSwk75~qh|}>T%H}+U z@@&$lDA)QwLwP3YH2#QZumgEJi|degChBkDxA;C@K%Q68E@Efe>z}YM{(|!C&?U^o zE4YJeGW>SAde-JQyvgu&q=dBJk?Y^uAISA?xp<*-Z%^~Wc&v^OU@iO#>tS{3RTJd* zRJGeN7h9mzx7PRsw!xdob76WH4v?L&8+O5E=#OWScRuR%sC2yRQ9YB=8@bM=-HB2e z??QPtB?9Zvp^HX&_GBRT#lg51jA{?#P+W`4@fqY@liEfM;$&|#&cLns z4!(fWlih`*@g;m3_u)_YDlXt`=VRQ3C-58m47;(be1l`~JCr@{Dn5w6;WoU6r|>$; z?~va>*~O~VrF=Qjx(x%cD)z-{n22?78P-MKjiUMD4QzscV;kgM8d`hgofldsd;z;6 z?@-VJuzzE=BTmFHd>VV>G3NQE!PlIMtHja;R zt|4#d=Qmk+v_(#FrRk{TQ}Har{b=$3{n5pJd2*-1^)_s#YWH%;c`1Kf-LQW3p~xAt ze)XZ;ikXd@95V=N<0u`bmeO!(>vS3A_()kwTSpaE%aU*z`?{3x6wJq|xE^Ps#`d@e z<^JbfT!{)%{7HvC@lK&XZV*Yf!eWTvPIVZsIFqR7>r1o=D9bo|G)K7WICoDZ>e3~a_vTAQDC5s~_Lx`E^YchWTm>~s-7zLTa}q!A zqQYyTIvVzGyDWkqioO5 zQMS9x+p~|phWaAw@F==(cl8(qzc*lX+GIOc@^NhV@r?4=@UjzCzTu0UWBy^o%K`d- z+3@$WqI~|}Z1^iOp)tAqOOx`E?cS2Vs}kUIgYuN@-9*{$yhl`R_uE<;*IcThop^P; z7i-{iSP!?OFCM`LD9dYzvdku^u2rJ!qb;#Nwno|h?J)y8psZpil%@}8_xEgU!F2rMLXVy*|-XMhpql0PC~igHx=c&YdOlZG}G`-oQ@GV3*&J< z+He8Nv-}J3e!Lf#;(hoyK8VlZ3VaJ6Lb+b~2wuWR(Tn^)hSl(KlsdJYllgjD4c{NB zJ6;-(?%Lw4;oH=3yfs{14UeI~YWRLh`f5h{JS*UB1WK(yO(RgIW^r0AA|^S?7HJJv z(PVg#HGG>I9%>C&Rl@_U;c99)!y2xxhNG?F8frMp8unJh$<}a9HC$p1*HXiytl`>f zc&asAM-3ZAAo;JShNGj z8>`_d)^HOwoN5g>Rl{Sf;bv-hx;5Nf4aZo+x2xgd*6A}qXMIxDcY*Q)H1Fi7^T!s1^A^^HP`o9E+;67Hh$gL z3V2B%Il&pIVg!b9mA8hkOmdqF#PD;$3B$;@5v(df`7Ps72}#km0SP1Gqa*ow)8>xR z)nv5$sK$;_)y*lRV+ZkIq^~1fL&8Src1OtDOgU$dyPB+A9f?N9kEVq)0(Dg&E>2=*3Dk2W8ZbH~#tPP#ASIBP zlpsGyYfSAUK@~CA%hxe&e4Lf{297ChgN=1E7u`_ej+nWgjm)$o-P1OfxJRss#9~rY zM#RTj8EUFx3DNP^25;twSV@{oASyN~%GwsUn~`BwqB|rMoe&piC2CE!pu z&9!f3Mq;hyx0Vp)X3g5q5pZU@jYN`Dn2)&y+Dc?tY`hAZh22hqiE$&6tz_*T$yCtH zLk9^OzrJhMg^rGNM%0{NCy9nfqdgk-locXI?) zX3QmbcLa?ko2%#Vh`KE&K!P&ISkB~)>eWL+j$(+l3OP_sO*uFd200SSvSY2f9V}6` zd}QaZxsN`^>Svg4d*s3WBjH7jkHL{(`xQ}&XWqd1(=a7Wb0lezrfj;Le# z=9>0#gpGxn<#eY+sXMBi&0VCgBWP9+GjTshT$R6>_%3H+x9!s35jVC=Q%B)MI8z%V z%y~yTMyL&D&U=6}wTheT66J^+b;e8`?TDJy#*D`}<0^+{UIsejMqbPb202H#Eq1UY zZd4(2HnEPVRg27A4l!q=s*IU@s580yc8hb2aBMfT{T=2^?-*mwKi)CM*rMkA6P)Rd z5oWzebc}FREi?UaN7$-e=7=Qc2qU9rj*^`t962&4NpX%bmThKrgp5cTofxC)nVEc~ z88s`KnS7Kv!fkt{no*Lg5$2kWHb)qn(ah%&`4W>;EA#MC;0VN8hlN5TV*J3pnZF_l^1JbI2_sUhgW_ZfM#eb< z#S$1A<2=NaI08w-B2%pelv=^qcq>?D2HDV7aEb(zVn)U!CC6B+HC2MFdrVS_b#hYf zjH#ovS=`f{@d1%hL%H2z96zSJ$K8(XGh|#sJg05u%Fi?-l(4n(vm`hmDbmWETJUVME9vgDr8ow`y~|3jLel>A^|c#CMGGt+D1zqL3Sy( z_%cVF?5eoA=m#V|EHY`RmA~Z@NlY3MA7h;eJZOb%kx7HB;#(o%i+Px*g!7q7=vCKgF)6Ho#v#ZU~7;*b5c@I zYmhE;Qc{RDNRK%wDbyOI!<>{9W)0F`PD<)!4bojsN(#3I=`ANE$sK1S8+4AzhFqgJ zhUpwL9Bd8ORl{-z*%(h}nelRm*%+p?%&^>nHiqdeGc1>djA1&<49nA9#xR{_hUFfF zF-+%}^_Dy0#xR{@hMoDLbIhuycLyQp3*t^jE{q{6wf>XMQ5p zuycD1P{YprMXOdIKcIIcW8g}LVtY`St*o@vCXW=CaDB3_FTY>p__&PcvPfOuo|TQ^D+SZ- zT02JbLrWeLX4$jT%koNX{G@yyb8lT~B3d!y;kFXZj|7)1%%v<-JuF&Sob^w$kQChH zm|zc5%ix!uJThV>2v*BDTSug;Na$#K)uvQZh4jP&|V$i z&#mc8N{e#~CfE|=vnn4^#0bgDr3zD|mdGu=O2!oZ>Qz*r?`@in2*$a>V0HsX>kfamToWQOq_BcDo;4)=GkrPsfbF0 zk`F0km36iTIhU1dM@WtWj!a0wGcqiMVJTB72^wdkFe=#&vZy7bDJ-%V@PKrYD*H-< zvgtn{rDM~x>T1(V+7X0}@8sH8Ro;?OY49ppJL_fK7WVNP?|){;*xYHCPuE%a*QZAp zAL5xA#`}03)aQ))boIVlhaL$k>z&kg3u~w1vrly0IOojsqZCqZhKl$w<>%}uEK3;b}a4O3Gc<^6mKVNWh zQ`i?glQmVv_rCh~{8m%v|GqMR)#?_Tj&lS3BNe}E$+)K?$K7|+x1{Q@?oXESfOW&F zGN0*3yN+7)$&0mTJ#zIK|F>p7%k$PMzO+fs(sk((^?uk{{r%k&A7-PhQt{%~-@U)R z*M+DPPaJB#Y`}xDJc~#9f5td1vrih&?o6PK_sgbkm!#$AW)>Hg6lRzDP01}OOV9Hw zDJ{#&E%XZt3--AW!C!WuKBZF*7fXcR3Vi@#cuq zX=$<-sQ>wg2lNb5{|d5Q?7;H%wbpIzdo7Y$bypp^UYPhv+LtAs(=FFDW2yWV( zUYXvodDClc8yh#QdM(;P>q0HP77n-GvU1~VDnzDjEe`RuZGaH=?B*OiYj|rQ-oWMC zm^`n1nc#k=P+)!qs7Y|YQ7AA2fEEkxWrYIXoo6l;+ysRJb0VNcg2PRC0tM!5KuN*P zQV1^q0+`}Q^FCWQiX8z7#ItT8(j3QQlMcL@$(i4-W{_a4m#!R=Eh;5QxRec~GP zMTG+McYxk0bdM_(nC}8wC%Eq`6!1HYX071x_LCQ7AB50DV(%w3d{+BzAm^a3c(Hl z?HAl73I*nBKs>WuW3E#OZ4l5`1@}&c0+Rvs6~W!AP+;x=^ku>IDHNEG0O}Xq#}x|9 z{eT`7+=B`Q=4*f+5!?ZV;F|#bt>C_|P+)!v=wZSAT%o}H7SP`a?j?l+Q*}D-LlE3} zg#vRtpf3vUB!$qw0eVPqGZhNV#eg0Z+(Lx{^F}~l5Zu)Y1?C-qJ}%Grchw|0o^UQ#}o?8 zw*mDC?jIBi%+CSwJa3H&6$;EtfZiv#KPrU&yx!hiRbwVA6qs`X?G?HU6bj5@Kpzm? z6$%CBIzaCi+*=h2Ogo^v1lOfdU_J?GkKq1Vp};%@Xt&@VRwytB0QCv(8wv&Hdw|{} zxPMd#Z68pt;C`tP{2!oQf*Vi>c0U#8j|DegA@mD?ZWr8%3I*mYK;43yt`Pk5G}m7~ zq!9eobcg%ALV@{#$Nk9TZkgfeZc`{QpYgc+Jnk8f`+>*3>~XltSZ+Xodei0njgn z?nQ+HbLMLME>4X(TcN;Q0O+?uH&-F#3+O)t*Q5}}0)T!axa$-O%ql=H3T~Z3@a=$p zEx4@;1*RL&zYA`cLg@1V{Yr2jQ3yT)&@_bP-jp~wBg z<0h_kbjK(Zn7JOez~iumqPp7PaeF-OeIEBUk2~OTFL>OG9`_U`Wxp4hpH?U^{FdK< z;3{sk5XSd_EZy@81%}_U`){FJu25iVH#yuSh2ZZ2;YASiZ~Ph^p}-v4>~K#h6qr;i zPTULKQiTGu6VO<}^(cfn&drYQJqlrL;c?&fIDQMx@~cuPFf%-^(c}1Sv~iM0t3rW! z5D?#?sWE?}5XQTJP7>VX3I*ox0r7708pAK75em$6fcUN-=JpB&CIoc6;C`i0V5)Dy zdq0A!RS4r1?GA{eBZ3btW+p4 zn*dD`+!lobvjb3EaPL+qFn0ptU0XHg{R#!<6M!ZN?ynRI%ohOhy`viQC56y_w>q7k ztq|I!$6e=fAM?0Rdfc-f_ngPgxD9V$Ngj;~VNM5#ced4-v_gUD1ayYrvI+&}J%COZ z+?@(xo(JeO!F@uZz}yEYA-FFngta9=Hs9YV6qviV7hIJ>Xw!h^2yT)>ftdn`_k`A%(-aEKEI=0u?mUG8 za|xge1b3-Is3SmDmaIZpfAP2nJg)2AxQn2Id2}lTU*d5C9=9=TzkyI=S`~t>x*e`o zA*`VQ;=7hLW}`x=j~<7cqflU;2Xv{>9Z?A5It)blekR6s3Sr$0P_y9XDTG(Q0P)?r z8nZ+pj6ncx65I-fFb4y~3&U#6YK36WfcQQp>{%iBKR`DMu1BH3ydTiJ1ot6@0`u2^ zcu#AM`K&^Lc^D9{N~tmZ3I*mHfZi#%Zz&X*e+0BnaQ{o8!2A->TEXQNLVpfujo@BZ z21?Crk_zi;^^KS}a{s!n8!TnJo*d!)BR|~FIA^3Yh%LF$?A^3Yh zyaNDhJPKjW1JG51yF?+ZH3NF1;I2|AFmD62RB$&a6qt7bdV}CLDTFmzKvxQGheGg^ zfOscFjk!}H_(?!1!F@s@_;F0=Z2P!Qp}_3&xZNK2Rge3+$Njs<{fEa*#iY^lo2C%f z`91C)k6U&p)~Q97!5!rHpWebM7WkNcI!&G>*z+o%wH z*j}vG3cnQ!LC=783+^6;uoeV}?-JLT`xOezmjJy-aE~Yym?r@B3htmnfq53tF2Oyg z5Y|Qj-66P8A*>w&x?OO8P$)2O_@I;TO$wpTJ?;UIOWue3b`0ffQV8p!fc_}BH4349 z0D4()I~2m2AfUGi?&At!ObF--!9A`}VEzTrGQs_;Lg-iThd&Tpl|q3z9njT+J5wR7 z-2mDqWxGP5z^nx{PUto$6qxORss-1n5caJAjThX96+(Rg3Iun*LV@`@pc=tFp-^Cc z1gKVU|Ev)9nE*`?+$##fUp>GVmYIHvLV-CCP+V{qDuns~G)Zu8QV8V$^g6+9PzYlI zK*tC!s}S@I==Fm8xI*yHfQ}Q~qY7c{4d{5mJ);op1<+){g$iNM0niD8tNgr$&>sOh zQE=xd6qsf}Ckd`aAkr=72M+r1?Go< z5`z0Dg|J5j=rqCoULp96FJR0nxLSo^FM!Sv+?fgm=2AfQg1cNHlmpOI!L=xab$&o^ z7ThfgVSEqhI>EhPAzI4N-#pw%INvNVmzaenX$A*h9{i8N{~G+|AinM}`0x0O8K3<9 z9sd4i@E3!>9vqPH3xoeT_-}y1!M9^y^LlfGd539%CI1n)KMbBE_Vz2Gd|v)C_ZI<8 zFfR?#j`M@R7yJ?am3KJwwFrHO;&LM|PS|%j;|a~}62J%hx# zv`K^=oQuGRBe03k1MTVeMc_mPw(?(v9a&0G`CCz*(r~nVw!B+4g{5C%io;8lo8z|> zd(%<=OL1LIG`zyB#4fkhAM;-UDcUs5{G$A9xWLbb3;Y<4^0Q&bPYQ`Yn>HupXsu~Z ztV}0xOL=1RxBG!OZh=GA48nN7G4c{48OzisWB1P^PjTn*yHy3IIgyR|LRY+zoi z)^2G_Y|f;~42FZ~4Vx0%I}$f%aGgJH^@kZ+sziG8=ESNE?;IL`(}uP-9MDRDH@;4W zV>N)UM=o0;dD?HqZrFs=DjU`$?D_XZ+uEBmYd5W4OO^%kEU8=wJ4CQjDjefkFIjI+ z=tqlj;1fwjH8q+&r6*?{46*9*>vtbg7({vPzzp$ly-L z*0oTWOKyfy=gM_dYQsXP4}WJGyhpZVMS@50q4bTsF{UknPm3km(5N@_?wiEsO&f1b zY~4W76Duu^aY~$qgTU+7;!9*uOL}u+)8wb)FvpR!J0G5L^Np+4LT4;2ZxK>iU;{XZxeb}=ea1LR4&$Tx z)pAiWtPU-A!@>p}OWw3*0~xH`n2_7rVH@~#z=ln22^0XDU%zrwBE1y`FQ4RD+XgS} zvh-%*D!#!qEWF0n{@bU|yk0yn_~7>V#HzL0+91rTTNBfK^;jbj^AOq8YF49Z+6J_C z<672^H60ewn-30jqXwWhsSGsRWq4zfm7)h0*NADcNnf}8a+i#K1IlF`NTC&>IcB8! zHE-KKYu2oeNRy0KvTL_qZ7}qP#%ZQ`F$^@F;K}{1C?U+bTqPM1aLs1gSD_$@=A|KL zvNpl%w6(QEpjHTmGl&~D;Se}1dW2@Y%-F9;SY5G9g=S~XsKK>W=kPXfnPzA#w#^sF z+Y;+nLK?c7HrgNK(F&{&MCHt!Lawslwf6|C>hEfX(ccKG$Wiv6_ITh91){~aZi?c;Ro%9B z%Vq;z!m(%Qe4Hq*eX~n%INOe-r_BJ!K{NnC+mZD&({MIkm%ntH6uB_`a4lMG0ON=u z7UwR8lZdn#`3eZ&`Wm>Ma{u(_#>CrK>h<+<+z^wzFo# zI_X+rRM1tMw6=nMVi>e8(pF_?Bpr9O@*2+OY+{;Ko3!qTzJ~S8I-I z=i8`y01o8J^&H4$(Y1@0EGZP%G~ejz=T9;f*kS2_$Bi6BGH6q;?L*gUd)5Yc{Ht81 zzCWVg-6+O;2$;&&m0Ke1s|~Z3HfKn#^i~C%AxWa)k_CyzZENN(;HC z1~Ci%^4trZ!(;_g5@yJEu_%Pr4GmK!c4DHO+&L5F9B-N_*ZXDA`OWek)H9Y5jvIf! z+Gnl*Y07H(4bNtz_~BFj|Cs*+8n_HYaP(Ms&ry8cI`$Wd27J$BW!qZxD;(=jqgYor zUuL#9&X9kEZQp?PljWD6dm$*UTf9u@u6mQ)TebWhZ(6pTh{e}TGfOX@hA02xr2JKH z6*@c}itNp$*IvWB*gTG5TxPcTO-+{xy)3#_$dVtI+V}x1yTDc<%UxVnt1t=tTsXehpDR4-H|6nO@ z$()~UuWvLRfe?m|0i9YMt55BjfQ(K2kyu4Z!VlVno#~Ty&adwVP5KxBT?EDhzz(3v zEOxoZkXH=yHO|E|qj_+D>F9ZIx3e!+kHpnTT%A2~9YF|Mos8eHA33B}BkX1D200RR z@8lyj=D^@#mw#n;U{ZQwBoxosP%4{?i6ZjNE;d#~i_lQoMn_ws&HVAhL>#r4C{Ke) zr))uM5vrZiK97%6c1+?Uv10}w^LA9`&v5)-naXAM1w5NwC`qNQ(%=5~;9x5I1F&YT15P_D$;+9=@ey(qMeTqhu zJVK!$;hZOw86M^M?R;SX4fJ4BeJiCs*j>*m=MP|u)HT@b>8{TKmFn%T-^FKNcRia3 z!(4bwWgn}b%*LHb5S&Dime4KWL3yD84dv-$ZBmk^4uZy}9766Q62fwl%0#CU{t$o3 zmr(@{4MG@C?cqwONJR|kthBr9CEQz0lz>%ihmY{c0GzLqLk(fz^G|4eVF_Xcp z8u?7^>KXG~PcH2QrN0YnDCladLUN;;;*Z7_Wd|DKJ^TnW5>vf{xzydo@n^?-K7e?X zx|^Kv1K6ctDa+KJrbV$u{ahtZ?SXnJ;328{o?K?8=8?@+qoSCbN*w>nks4qqeE1fu zo`zUrA0n-?<|6V?)@OUxV~4Pw;#j|oh2H#|hY^`BZz$ge&o@4V?}?7@z2G|xS17Iw z*V8=LD&^|6JIRFKqbZbBl@|V0vrCvTJ3Kp@=g=}2q#IW%U84zS56`ZA)fCvds_}(Q zn(*fop?qPhN02Tkm2Q~{xiv8iyV|nsPVrSSvB1t+cbCau`KoxGJUlN`0Y4<|Crv78 zrr2m1tg)>MSre6S0F`7OrRsbIRKz-}%6wJW`10VOW5kgT+WQ3PwI5`tAd|1r0ARK< z;*tCzgpdUvCjADVKEd>viiAS4M)dX7g=iUtx0_ z2bLj_zX}p|fdTi)@>gqsZ9Lx;jk(AL5S2e$11x@iiUznjlrJhw4m?>;VD?G|oxkvL6=_ny!<%HN__q~Bl2L!dzg$K8wcD%8`mOEx-i+sB9I51E>l_ai9 zSl7GrZUi;9H0q;>%1d+klNd-|>}65!`BC}~o{L%bV@;W|*kK*pB7yPo>* z?+^yNC9tlyBDDwOAdaV6JXZu(q%b_PT10w|lSq={s0h3F5=eq#4s*w|QJ)R^Oz^oB zI^Hi&C&^yP)aBEcYCl3c*fGgWx+*+`a}_(=>tPucW`}DLb%+bUfEbt1*=1jHMf|}< z%^3Q%jycqK0HcaMO{S3r--jfm;&afB5rF04I}X^ao}7#*u&Tzz9mQZhF`ugpo12OjWU&RZz|z&2a{5b4DUkfLUGsh zrq(;`!BXQbX`n^6d@#9!a=0Agk0w!EtC^DK;?)is6y4IqA6;^C{6W^Q>L%5T1%aSE`lsErq>6Ttg+eo(#;?F3>G4|ee{e~#I~uH6>lG3DACJ1;ATT6iDjfsV^I zG_;eJXdY})f9ZB67M!X+;_@xF)Fo?RNn#u&_*USLanFCv@02z+ZsLKoRFMk#%%V;3zjYw2b7PLnMX3pEz^~SCY z$59DjN#S>HlP+(E)W4LbFO{%P)afPz#@1V*nS#zY(@BvU;F^`=neCV66z~2n6mNxs zvU)1V13DBwgjjI5LtzH^TS|4~xu~B}C>bMMrXo1< zd{}TU&)xORab0gUO2Qb^@fL+%kqUhZxO$-Tjf#F*&`$$>IngwF2Dpfbf)GR=Oob31 zEF}rAbrsT=+z4A^UWIyw+(h)IHj>J!(4x@lVcQmGSGFu1z5_#7h(z8deWNo3?QxMn z93=R%tryG>2+jd|D*!O5D20h-l?2TmEbR)(>zFG+rR=T7no4`j)|XaD_V6TD^J-bc zuqNEpmrS4ky+Wfwb)7;^F2y1EJZrO91_`GjC357r#&ojskUefEFnqLKv2LEJ98MSZ3XVE}%P>Mp0z83s|_RYP&G%+g07g2ht}+ zXlt{F5|O-X!-plEZpSp~?9V#KJbqwc97jqMkV4j9H{`kiA;ELQ zB*-4_oc=guW4s$@+0^h~$_Qr8{KhOl5bJw9n(GLH=ie47Row#4I<{UBMZE^4MA$%I zzRFQowfQ-Wq_WGH3f8o}B5Sd3RPD;cl&DcU857_At4NLZC9A~@)3gG{W0q1an@pF)@T%BHJi`SOD+7 zaWpWQ<3==@!^0$SCd2rnm<;n9VlpF2o_~8(Y-=;p-Tpb$5@8LaNjhz?>RnW7=aT~v zJhI4KSZ;pG@0z%U*;su(KrfsaJcQw10t@a5vtw4OFIFG_JLtN$J~enC)mvK+7gd=* zqIj&7jMou;er)~#v9j~y=wGn`g4v!riJ==HC`VIgCIEZB-D2|9gd`&*gjd5NehPa*t}o